summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorKen Raeburn <raeburn@raeburn.org>2015-11-01 01:42:21 -0400
committerKen Raeburn <raeburn@raeburn.org>2015-11-01 01:42:21 -0400
commit39372e1a1032521be74575bb06f95a3898fbae30 (patch)
tree754bd242a23d2358ea116126fcb0a629947bd9ec /lisp
parent6a3121904d76e3b2f63007341d48c5c1af55de80 (diff)
parente11aaee266da52937a3a031cb108fe13f68958c3 (diff)
downloademacs-39372e1a1032521be74575bb06f95a3898fbae30.tar.gz
merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/.gitignore6
-rw-r--r--lisp/ChangeLog6768
-rw-r--r--lisp/ChangeLog.18
-rw-r--r--lisp/ChangeLog.10923
-rw-r--r--lisp/ChangeLog.11227
-rw-r--r--lisp/ChangeLog.12434
-rw-r--r--lisp/ChangeLog.1312
-rw-r--r--lisp/ChangeLog.1442
-rw-r--r--lisp/ChangeLog.1564
-rw-r--r--lisp/ChangeLog.1670
-rw-r--r--lisp/ChangeLog.1726311
-rw-r--r--lisp/ChangeLog.26
-rw-r--r--lisp/ChangeLog.3861
-rw-r--r--lisp/ChangeLog.412
-rw-r--r--lisp/ChangeLog.514
-rw-r--r--lisp/ChangeLog.66
-rw-r--r--lisp/ChangeLog.72418
-rw-r--r--lisp/ChangeLog.81221
-rw-r--r--lisp/ChangeLog.92067
-rw-r--r--lisp/Makefile.in436
-rw-r--r--lisp/README3
-rw-r--r--lisp/abbrev.el55
-rw-r--r--lisp/align.el27
-rw-r--r--lisp/allout-widgets.el31
-rw-r--r--lisp/allout.el94
-rw-r--r--lisp/ansi-color.el17
-rw-r--r--lisp/apropos.el66
-rw-r--r--lisp/arc-mode.el158
-rw-r--r--lisp/array.el15
-rw-r--r--lisp/autoarg.el3
-rw-r--r--lisp/autoinsert.el32
-rw-r--r--lisp/autorevert.el315
-rw-r--r--lisp/avoid.el69
-rw-r--r--lisp/battery.el132
-rw-r--r--lisp/bindings.el123
-rw-r--r--lisp/bookmark.el67
-rw-r--r--lisp/bs.el8
-rw-r--r--lisp/buff-menu.el18
-rw-r--r--lisp/button.el24
-rw-r--r--lisp/calc/.gitignore2
-rw-r--r--lisp/calc/calc-aent.el20
-rw-r--r--lisp/calc/calc-alg.el6
-rw-r--r--lisp/calc/calc-arith.el6
-rw-r--r--lisp/calc/calc-bin.el2
-rw-r--r--lisp/calc/calc-comb.el12
-rw-r--r--lisp/calc/calc-cplx.el2
-rw-r--r--lisp/calc/calc-embed.el15
-rw-r--r--lisp/calc/calc-ext.el42
-rw-r--r--lisp/calc/calc-fin.el2
-rw-r--r--lisp/calc/calc-forms.el77
-rw-r--r--lisp/calc/calc-frac.el2
-rw-r--r--lisp/calc/calc-funcs.el2
-rw-r--r--lisp/calc/calc-graph.el2
-rw-r--r--lisp/calc/calc-help.el65
-rw-r--r--lisp/calc/calc-incom.el2
-rw-r--r--lisp/calc/calc-keypd.el2
-rw-r--r--lisp/calc/calc-lang.el24
-rw-r--r--lisp/calc/calc-macs.el2
-rw-r--r--lisp/calc/calc-map.el3
-rw-r--r--lisp/calc/calc-math.el2
-rw-r--r--lisp/calc/calc-menu.el22
-rw-r--r--lisp/calc/calc-misc.el13
-rw-r--r--lisp/calc/calc-mode.el18
-rw-r--r--lisp/calc/calc-mtx.el2
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calc/calc-poly.el2
-rw-r--r--lisp/calc/calc-prog.el39
-rw-r--r--lisp/calc/calc-rewr.el2
-rw-r--r--lisp/calc/calc-rules.el2
-rw-r--r--lisp/calc/calc-sel.el2
-rw-r--r--lisp/calc/calc-stat.el13
-rw-r--r--lisp/calc/calc-store.el24
-rw-r--r--lisp/calc/calc-stuff.el2
-rw-r--r--lisp/calc/calc-trail.el2
-rw-r--r--lisp/calc/calc-undo.el2
-rw-r--r--lisp/calc/calc-units.el77
-rw-r--r--lisp/calc/calc-vec.el10
-rw-r--r--lisp/calc/calc-yank.el181
-rw-r--r--lisp/calc/calc.el333
-rw-r--r--lisp/calc/calcalg2.el2
-rw-r--r--lisp/calc/calcalg3.el2
-rw-r--r--lisp/calc/calccomp.el6
-rw-r--r--lisp/calc/calcsel2.el2
-rw-r--r--lisp/calculator.el1032
-rw-r--r--lisp/calendar/.gitignore4
-rw-r--r--lisp/calendar/appt.el8
-rw-r--r--lisp/calendar/cal-bahai.el120
-rw-r--r--lisp/calendar/cal-china.el205
-rw-r--r--lisp/calendar/cal-coptic.el22
-rw-r--r--lisp/calendar/cal-dst.el5
-rw-r--r--lisp/calendar/cal-french.el15
-rw-r--r--lisp/calendar/cal-hebrew.el74
-rw-r--r--lisp/calendar/cal-html.el2
-rw-r--r--lisp/calendar/cal-islam.el28
-rw-r--r--lisp/calendar/cal-iso.el17
-rw-r--r--lisp/calendar/cal-julian.el19
-rw-r--r--lisp/calendar/cal-mayan.el29
-rw-r--r--lisp/calendar/cal-menu.el23
-rw-r--r--lisp/calendar/cal-move.el14
-rw-r--r--lisp/calendar/cal-persia.el13
-rw-r--r--lisp/calendar/cal-tex.el8
-rw-r--r--lisp/calendar/cal-x.el43
-rw-r--r--lisp/calendar/calendar.el246
-rw-r--r--lisp/calendar/diary-lib.el201
-rw-r--r--lisp/calendar/holidays.el183
-rw-r--r--lisp/calendar/icalendar.el406
-rw-r--r--lisp/calendar/lunar.el13
-rw-r--r--lisp/calendar/parse-time.el112
-rw-r--r--lisp/calendar/solar.el26
-rw-r--r--lisp/calendar/time-date.el252
-rw-r--r--lisp/calendar/timeclock.el32
-rw-r--r--lisp/calendar/todo-mode.el1970
-rw-r--r--lisp/case-table.el4
-rw-r--r--lisp/cdl.el4
-rw-r--r--lisp/cedet/ChangeLog.1 (renamed from lisp/cedet/ChangeLog)823
-rw-r--r--lisp/cedet/cedet-cscope.el2
-rw-r--r--lisp/cedet/cedet-files.el2
-rw-r--r--lisp/cedet/cedet-global.el23
-rw-r--r--lisp/cedet/cedet-idutils.el2
-rw-r--r--lisp/cedet/cedet.el2
-rw-r--r--lisp/cedet/data-debug.el24
-rw-r--r--lisp/cedet/ede.el443
-rw-r--r--lisp/cedet/ede/auto.el225
-rw-r--r--lisp/cedet/ede/autoconf-edit.el3
-rw-r--r--lisp/cedet/ede/base.el64
-rw-r--r--lisp/cedet/ede/config.el424
-rw-r--r--lisp/cedet/ede/cpp-root.el152
-rw-r--r--lisp/cedet/ede/custom.el16
-rw-r--r--lisp/cedet/ede/detect.el210
-rw-r--r--lisp/cedet/ede/dired.el10
-rw-r--r--lisp/cedet/ede/emacs.el125
-rw-r--r--lisp/cedet/ede/files.el342
-rw-r--r--lisp/cedet/ede/generic.el325
-rw-r--r--lisp/cedet/ede/linux.el265
-rw-r--r--lisp/cedet/ede/locate.el64
-rw-r--r--lisp/cedet/ede/make.el2
-rw-r--r--lisp/cedet/ede/makefile-edit.el2
-rw-r--r--lisp/cedet/ede/pconf.el31
-rw-r--r--lisp/cedet/ede/pmake.el65
-rw-r--r--lisp/cedet/ede/proj-archive.el10
-rw-r--r--lisp/cedet/ede/proj-aux.el4
-rw-r--r--lisp/cedet/ede/proj-comp.el26
-rw-r--r--lisp/cedet/ede/proj-elisp.el57
-rw-r--r--lisp/cedet/ede/proj-info.el22
-rw-r--r--lisp/cedet/ede/proj-misc.el8
-rw-r--r--lisp/cedet/ede/proj-obj.el20
-rw-r--r--lisp/cedet/ede/proj-prog.el20
-rw-r--r--lisp/cedet/ede/proj-scheme.el4
-rw-r--r--lisp/cedet/ede/proj-shared.el16
-rw-r--r--lisp/cedet/ede/proj.el77
-rw-r--r--lisp/cedet/ede/project-am.el122
-rw-r--r--lisp/cedet/ede/shell.el19
-rw-r--r--lisp/cedet/ede/simple.el6
-rw-r--r--lisp/cedet/ede/source.el18
-rw-r--r--lisp/cedet/ede/speedbar.el30
-rw-r--r--lisp/cedet/ede/srecode.el2
-rw-r--r--lisp/cedet/ede/system.el2
-rw-r--r--lisp/cedet/ede/util.el8
-rw-r--r--lisp/cedet/inversion.el6
-rw-r--r--lisp/cedet/mode-local.el143
-rw-r--r--lisp/cedet/pulse.el137
-rw-r--r--lisp/cedet/semantic.el175
-rw-r--r--lisp/cedet/semantic/analyze.el172
-rw-r--r--lisp/cedet/semantic/analyze/complete.el14
-rw-r--r--lisp/cedet/semantic/analyze/debug.el13
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el2
-rw-r--r--lisp/cedet/semantic/analyze/refs.el14
-rw-r--r--lisp/cedet/semantic/bovine.el2
-rw-r--r--lisp/cedet/semantic/bovine/c-by.el2224
-rw-r--r--lisp/cedet/semantic/bovine/c.el277
-rw-r--r--lisp/cedet/semantic/bovine/debug.el10
-rw-r--r--lisp/cedet/semantic/bovine/el.el2
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el26
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el132
-rw-r--r--lisp/cedet/semantic/bovine/make-by.el391
-rw-r--r--lisp/cedet/semantic/bovine/make.el7
-rw-r--r--lisp/cedet/semantic/bovine/scm-by.el196
-rw-r--r--lisp/cedet/semantic/bovine/scm.el6
-rw-r--r--lisp/cedet/semantic/chart.el2
-rw-r--r--lisp/cedet/semantic/complete.el149
-rw-r--r--lisp/cedet/semantic/ctxt.el7
-rw-r--r--lisp/cedet/semantic/db-debug.el2
-rw-r--r--lisp/cedet/semantic/db-ebrowse.el54
-rw-r--r--lisp/cedet/semantic/db-el.el58
-rw-r--r--lisp/cedet/semantic/db-file.el39
-rw-r--r--lisp/cedet/semantic/db-find.el34
-rw-r--r--lisp/cedet/semantic/db-global.el30
-rw-r--r--lisp/cedet/semantic/db-javascript.el38
-rw-r--r--lisp/cedet/semantic/db-mode.el10
-rw-r--r--lisp/cedet/semantic/db-ref.el17
-rw-r--r--lisp/cedet/semantic/db-typecache.el34
-rw-r--r--lisp/cedet/semantic/db.el124
-rw-r--r--lisp/cedet/semantic/debug.el52
-rw-r--r--lisp/cedet/semantic/decorate.el16
-rw-r--r--lisp/cedet/semantic/decorate/include.el44
-rw-r--r--lisp/cedet/semantic/decorate/mode.el12
-rw-r--r--lisp/cedet/semantic/dep.el2
-rw-r--r--lisp/cedet/semantic/doc.el14
-rw-r--r--lisp/cedet/semantic/ede-grammar.el22
-rw-r--r--lisp/cedet/semantic/edit.el10
-rw-r--r--lisp/cedet/semantic/find.el14
-rw-r--r--lisp/cedet/semantic/format.el12
-rw-r--r--lisp/cedet/semantic/fw.el57
-rw-r--r--lisp/cedet/semantic/grammar-wy.el6
-rw-r--r--lisp/cedet/semantic/grammar.el149
-rw-r--r--lisp/cedet/semantic/html.el2
-rw-r--r--lisp/cedet/semantic/ia-sb.el16
-rw-r--r--lisp/cedet/semantic/ia.el37
-rw-r--r--lisp/cedet/semantic/idle.el15
-rw-r--r--lisp/cedet/semantic/imenu.el4
-rw-r--r--lisp/cedet/semantic/java.el4
-rw-r--r--lisp/cedet/semantic/lex-spp.el163
-rw-r--r--lisp/cedet/semantic/lex.el116
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el14
-rw-r--r--lisp/cedet/semantic/sb.el2
-rw-r--r--lisp/cedet/semantic/scope.el66
-rw-r--r--lisp/cedet/semantic/senator.el20
-rw-r--r--lisp/cedet/semantic/sort.el2
-rw-r--r--lisp/cedet/semantic/symref.el222
-rw-r--r--lisp/cedet/semantic/symref/cscope.el6
-rw-r--r--lisp/cedet/semantic/symref/filter.el2
-rw-r--r--lisp/cedet/semantic/symref/global.el6
-rw-r--r--lisp/cedet/semantic/symref/grep.el70
-rw-r--r--lisp/cedet/semantic/symref/idutils.el8
-rw-r--r--lisp/cedet/semantic/symref/list.el95
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el12
-rw-r--r--lisp/cedet/semantic/tag-write.el2
-rw-r--r--lisp/cedet/semantic/tag.el12
-rw-r--r--lisp/cedet/semantic/texi.el6
-rw-r--r--lisp/cedet/semantic/util-modes.el12
-rw-r--r--lisp/cedet/semantic/util.el5
-rw-r--r--lisp/cedet/semantic/wisent.el8
-rw-r--r--lisp/cedet/semantic/wisent/comp.el36
-rw-r--r--lisp/cedet/semantic/wisent/grammar.el116
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el2
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el14
-rw-r--r--lisp/cedet/semantic/wisent/javat-wy.el688
-rw-r--r--lisp/cedet/semantic/wisent/js-wy.el530
-rw-r--r--lisp/cedet/semantic/wisent/python-wy.el847
-rw-r--r--lisp/cedet/semantic/wisent/python.el9
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el12
-rw-r--r--lisp/cedet/srecode.el2
-rw-r--r--lisp/cedet/srecode/args.el60
-rw-r--r--lisp/cedet/srecode/compile.el38
-rw-r--r--lisp/cedet/srecode/cpp.el4
-rw-r--r--lisp/cedet/srecode/ctxt.el2
-rw-r--r--lisp/cedet/srecode/dictionary.el43
-rw-r--r--lisp/cedet/srecode/document.el6
-rw-r--r--lisp/cedet/srecode/el.el4
-rw-r--r--lisp/cedet/srecode/expandproto.el2
-rw-r--r--lisp/cedet/srecode/extract.el26
-rw-r--r--lisp/cedet/srecode/fields.el47
-rw-r--r--lisp/cedet/srecode/filters.el2
-rw-r--r--lisp/cedet/srecode/find.el12
-rw-r--r--lisp/cedet/srecode/getset.el2
-rw-r--r--lisp/cedet/srecode/insert.el138
-rw-r--r--lisp/cedet/srecode/java.el11
-rw-r--r--lisp/cedet/srecode/map.el26
-rw-r--r--lisp/cedet/srecode/mode.el2
-rw-r--r--lisp/cedet/srecode/semantic.el4
-rw-r--r--lisp/cedet/srecode/srt-mode.el11
-rw-r--r--lisp/cedet/srecode/srt-wy.el306
-rw-r--r--lisp/cedet/srecode/srt.el2
-rw-r--r--lisp/cedet/srecode/table.el9
-rw-r--r--lisp/cedet/srecode/template.el2
-rw-r--r--lisp/cedet/srecode/texi.el14
-rw-r--r--lisp/character-fold.el162
-rw-r--r--lisp/chistory.el22
-rw-r--r--lisp/cmuscheme.el10
-rw-r--r--lisp/color.el22
-rw-r--r--lisp/comint.el192
-rw-r--r--lisp/completion.el250
-rw-r--r--lisp/composite.el104
-rw-r--r--lisp/cus-dep.el7
-rw-r--r--lisp/cus-edit.el144
-rw-r--r--lisp/cus-face.el61
-rw-r--r--lisp/cus-start.el116
-rw-r--r--lisp/cus-theme.el16
-rw-r--r--lisp/custom.el117
-rw-r--r--lisp/dabbrev.el7
-rw-r--r--lisp/delim-col.el6
-rw-r--r--lisp/delsel.el154
-rw-r--r--lisp/descr-text.el193
-rw-r--r--lisp/desktop.el378
-rw-r--r--lisp/dframe.el63
-rw-r--r--lisp/dired-aux.el312
-rw-r--r--lisp/dired-x.el255
-rw-r--r--lisp/dired.el239
-rw-r--r--lisp/dirtrack.el6
-rw-r--r--lisp/disp-table.el7
-rw-r--r--lisp/dnd.el38
-rw-r--r--lisp/doc-view.el227
-rw-r--r--lisp/dom.el241
-rw-r--r--lisp/dos-fns.el2
-rw-r--r--lisp/dos-vars.el4
-rw-r--r--lisp/dos-w32.el128
-rw-r--r--lisp/double.el10
-rw-r--r--lisp/dynamic-setting.el4
-rw-r--r--lisp/ebuff-menu.el10
-rw-r--r--lisp/echistory.el5
-rw-r--r--lisp/edmacro.el4
-rw-r--r--lisp/ehelp.el14
-rw-r--r--lisp/elec-pair.el591
-rw-r--r--lisp/electric.el452
-rw-r--r--lisp/elide-head.el2
-rw-r--r--lisp/emacs-lisp/advice.el136
-rw-r--r--lisp/emacs-lisp/authors.el1097
-rw-r--r--lisp/emacs-lisp/autoload.el332
-rw-r--r--lisp/emacs-lisp/avl-tree.el64
-rw-r--r--lisp/emacs-lisp/backquote.el32
-rw-r--r--lisp/emacs-lisp/benchmark.el2
-rw-r--r--lisp/emacs-lisp/bindat.el2
-rw-r--r--lisp/emacs-lisp/byte-opt.el208
-rw-r--r--lisp/emacs-lisp/byte-run.el133
-rw-r--r--lisp/emacs-lisp/bytecomp.el550
-rw-r--r--lisp/emacs-lisp/cconv.el203
-rw-r--r--lisp/emacs-lisp/chart.el22
-rw-r--r--lisp/emacs-lisp/check-declare.el62
-rw-r--r--lisp/emacs-lisp/checkdoc.el152
-rw-r--r--lisp/emacs-lisp/cl-extra.el369
-rw-r--r--lisp/emacs-lisp/cl-generic.el1159
-rw-r--r--lisp/emacs-lisp/cl-indent.el124
-rw-r--r--lisp/emacs-lisp/cl-lib.el132
-rw-r--r--lisp/emacs-lisp/cl-macs.el1249
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el265
-rw-r--r--lisp/emacs-lisp/cl-seq.el10
-rw-r--r--lisp/emacs-lisp/cl.el32
-rw-r--r--lisp/emacs-lisp/copyright.el30
-rw-r--r--lisp/emacs-lisp/crm.el134
-rw-r--r--lisp/emacs-lisp/cursor-sensor.el180
-rw-r--r--lisp/emacs-lisp/debug.el128
-rw-r--r--lisp/emacs-lisp/derived.el14
-rw-r--r--lisp/emacs-lisp/disass.el67
-rw-r--r--lisp/emacs-lisp/easy-mmode.el86
-rw-r--r--lisp/emacs-lisp/easymenu.el29
-rw-r--r--lisp/emacs-lisp/edebug.el529
-rw-r--r--lisp/emacs-lisp/eieio-base.el244
-rw-r--r--lisp/emacs-lisp/eieio-compat.el272
-rw-r--r--lisp/emacs-lisp/eieio-core.el2563
-rw-r--r--lisp/emacs-lisp/eieio-custom.el221
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el92
-rw-r--r--lisp/emacs-lisp/eieio-opt.el567
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el26
-rw-r--r--lisp/emacs-lisp/eieio.el873
-rw-r--r--lisp/emacs-lisp/eldoc.el443
-rw-r--r--lisp/emacs-lisp/elint.el24
-rw-r--r--lisp/emacs-lisp/elp.el6
-rw-r--r--lisp/emacs-lisp/ert-x.el10
-rw-r--r--lisp/emacs-lisp/ert.el240
-rw-r--r--lisp/emacs-lisp/ewoc.el2
-rw-r--r--lisp/emacs-lisp/find-func.el203
-rw-r--r--lisp/emacs-lisp/find-gc.el161
-rw-r--r--lisp/emacs-lisp/float-sup.el4
-rw-r--r--lisp/emacs-lisp/generator.el796
-rw-r--r--lisp/emacs-lisp/generic.el6
-rw-r--r--lisp/emacs-lisp/gv.el173
-rw-r--r--lisp/emacs-lisp/helper.el4
-rw-r--r--lisp/emacs-lisp/inline.el262
-rw-r--r--lisp/emacs-lisp/let-alist.el142
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el53
-rw-r--r--lisp/emacs-lisp/lisp-mode.el1146
-rw-r--r--lisp/emacs-lisp/lisp.el372
-rw-r--r--lisp/emacs-lisp/macroexp.el275
-rw-r--r--lisp/emacs-lisp/map-ynp.el13
-rw-r--r--lisp/emacs-lisp/map.el377
-rw-r--r--lisp/emacs-lisp/nadvice.el180
-rw-r--r--lisp/emacs-lisp/package-x.el30
-rw-r--r--lisp/emacs-lisp/package.el3387
-rw-r--r--lisp/emacs-lisp/pcase.el570
-rw-r--r--lisp/emacs-lisp/pp.el10
-rw-r--r--lisp/emacs-lisp/re-builder.el2
-rw-r--r--lisp/emacs-lisp/regexp-opt.el19
-rw-r--r--lisp/emacs-lisp/regi.el2
-rw-r--r--lisp/emacs-lisp/ring.el4
-rw-r--r--lisp/emacs-lisp/rx.el35
-rw-r--r--lisp/emacs-lisp/seq.el487
-rw-r--r--lisp/emacs-lisp/shadow.el14
-rw-r--r--lisp/emacs-lisp/smie.el531
-rw-r--r--lisp/emacs-lisp/subr-x.el203
-rw-r--r--lisp/emacs-lisp/syntax.el120
-rw-r--r--lisp/emacs-lisp/tabulated-list.el157
-rw-r--r--lisp/emacs-lisp/tcover-ses.el2
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el2
-rw-r--r--lisp/emacs-lisp/testcover.el32
-rw-r--r--lisp/emacs-lisp/thunk.el74
-rw-r--r--lisp/emacs-lisp/timer.el129
-rw-r--r--lisp/emacs-lisp/tq.el9
-rw-r--r--lisp/emacs-lisp/trace.el54
-rw-r--r--lisp/emacs-lisp/unsafep.el2
-rw-r--r--lisp/emacs-lisp/warnings.el185
-rw-r--r--lisp/emacs-lock.el7
-rw-r--r--lisp/emulation/.gitignore1
-rw-r--r--lisp/emulation/cua-base.el390
-rw-r--r--lisp/emulation/cua-gmrk.el5
-rw-r--r--lisp/emulation/cua-rect.el114
-rw-r--r--lisp/emulation/edt-lk201.el2
-rw-r--r--lisp/emulation/edt-mapper.el74
-rw-r--r--lisp/emulation/edt-pc.el2
-rw-r--r--lisp/emulation/edt-vt100.el2
-rw-r--r--lisp/emulation/edt.el36
-rw-r--r--lisp/emulation/keypad.el2
-rw-r--r--lisp/emulation/viper-cmd.el84
-rw-r--r--lisp/emulation/viper-ex.el40
-rw-r--r--lisp/emulation/viper-init.el16
-rw-r--r--lisp/emulation/viper-keym.el16
-rw-r--r--lisp/emulation/viper-macs.el50
-rw-r--r--lisp/emulation/viper-mous.el8
-rw-r--r--lisp/emulation/viper-util.el14
-rw-r--r--lisp/emulation/viper.el42
-rw-r--r--lisp/env.el34
-rw-r--r--lisp/epa-dired.el2
-rw-r--r--lisp/epa-file.el90
-rw-r--r--lisp/epa-hook.el20
-rw-r--r--lisp/epa-mail.el22
-rw-r--r--lisp/epa.el337
-rw-r--r--lisp/epg-config.el13
-rw-r--r--lisp/epg.el1429
-rw-r--r--lisp/erc/.gitignore3
-rw-r--r--lisp/erc/ChangeLog.011056
-rw-r--r--lisp/erc/ChangeLog.022618
-rw-r--r--lisp/erc/ChangeLog.032163
-rw-r--r--lisp/erc/ChangeLog.042094
-rw-r--r--lisp/erc/ChangeLog.051240
-rw-r--r--lisp/erc/ChangeLog.061454
-rw-r--r--lisp/erc/ChangeLog.07836
-rw-r--r--lisp/erc/ChangeLog.08429
-rw-r--r--lisp/erc/ChangeLog.111729
-rw-r--r--lisp/erc/ChangeLog.2 (renamed from lisp/erc/ChangeLog)235
-rw-r--r--lisp/erc/erc-autoaway.el6
-rw-r--r--lisp/erc/erc-backend.el63
-rw-r--r--lisp/erc/erc-button.el24
-rw-r--r--lisp/erc/erc-capab.el4
-rw-r--r--lisp/erc/erc-compat.el4
-rw-r--r--lisp/erc/erc-dcc.el34
-rw-r--r--lisp/erc/erc-desktop-notifications.el13
-rw-r--r--lisp/erc/erc-ezbounce.el6
-rw-r--r--lisp/erc/erc-fill.el7
-rw-r--r--lisp/erc/erc-goodies.el4
-rw-r--r--lisp/erc/erc-ibuffer.el4
-rw-r--r--lisp/erc/erc-identd.el4
-rw-r--r--lisp/erc/erc-imenu.el4
-rw-r--r--lisp/erc/erc-join.el4
-rw-r--r--lisp/erc/erc-lang.el11
-rw-r--r--lisp/erc/erc-list.el9
-rw-r--r--lisp/erc/erc-log.el5
-rw-r--r--lisp/erc/erc-match.el40
-rw-r--r--lisp/erc/erc-menu.el4
-rw-r--r--lisp/erc/erc-netsplit.el4
-rw-r--r--lisp/erc/erc-networks.el34
-rw-r--r--lisp/erc/erc-notify.el4
-rw-r--r--lisp/erc/erc-page.el4
-rw-r--r--lisp/erc/erc-pcomplete.el16
-rw-r--r--lisp/erc/erc-replace.el4
-rw-r--r--lisp/erc/erc-ring.el7
-rw-r--r--lisp/erc/erc-services.el19
-rw-r--r--lisp/erc/erc-sound.el4
-rw-r--r--lisp/erc/erc-speedbar.el11
-rw-r--r--lisp/erc/erc-spelling.el7
-rw-r--r--lisp/erc/erc-stamp.el61
-rw-r--r--lisp/erc/erc-track.el97
-rw-r--r--lisp/erc/erc-truncate.el4
-rw-r--r--lisp/erc/erc-xdcc.el4
-rw-r--r--lisp/erc/erc.el4189
-rw-r--r--lisp/eshell/.gitignore2
-rw-r--r--lisp/eshell/em-alias.el21
-rw-r--r--lisp/eshell/em-banner.el4
-rw-r--r--lisp/eshell/em-basic.el4
-rw-r--r--lisp/eshell/em-cmpl.el16
-rw-r--r--lisp/eshell/em-dirs.el37
-rw-r--r--lisp/eshell/em-glob.el19
-rw-r--r--lisp/eshell/em-hist.el33
-rw-r--r--lisp/eshell/em-ls.el204
-rw-r--r--lisp/eshell/em-pred.el48
-rw-r--r--lisp/eshell/em-prompt.el12
-rw-r--r--lisp/eshell/em-rebind.el6
-rw-r--r--lisp/eshell/em-script.el8
-rw-r--r--lisp/eshell/em-smart.el20
-rw-r--r--lisp/eshell/em-term.el46
-rw-r--r--lisp/eshell/em-tramp.el4
-rw-r--r--lisp/eshell/em-unix.el99
-rw-r--r--lisp/eshell/em-xtra.el4
-rw-r--r--lisp/eshell/esh-arg.el98
-rw-r--r--lisp/eshell/esh-cmd.el118
-rw-r--r--lisp/eshell/esh-ext.el30
-rw-r--r--lisp/eshell/esh-io.el85
-rw-r--r--lisp/eshell/esh-mode.el253
-rw-r--r--lisp/eshell/esh-module.el4
-rw-r--r--lisp/eshell/esh-opt.el147
-rw-r--r--lisp/eshell/esh-proc.el23
-rw-r--r--lisp/eshell/esh-util.el52
-rw-r--r--lisp/eshell/esh-var.el147
-rw-r--r--lisp/eshell/eshell.el57
-rw-r--r--lisp/expand.el8
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/face-remap.el35
-rw-r--r--lisp/facemenu.el8
-rw-r--r--lisp/faces.el489
-rw-r--r--lisp/ffap.el213
-rw-r--r--lisp/filecache.el9
-rw-r--r--lisp/filenotify.el481
-rw-r--r--lisp/files-x.el11
-rw-r--r--lisp/files.el1071
-rw-r--r--lisp/filesets.el109
-rw-r--r--lisp/find-cmd.el62
-rw-r--r--lisp/find-dired.el23
-rw-r--r--lisp/find-file.el8
-rw-r--r--lisp/find-lisp.el2
-rw-r--r--lisp/finder.el80
-rw-r--r--lisp/flow-ctrl.el4
-rw-r--r--lisp/foldout.el30
-rw-r--r--lisp/follow.el204
-rw-r--r--lisp/font-core.el21
-rw-r--r--lisp/font-lock.el363
-rw-r--r--lisp/format-spec.el2
-rw-r--r--lisp/format.el22
-rw-r--r--lisp/forms.el34
-rw-r--r--lisp/frame.el784
-rw-r--r--lisp/frameset.el308
-rw-r--r--lisp/fringe.el21
-rw-r--r--lisp/generic-x.el28
-rw-r--r--lisp/gnus/.gitignore1
-rw-r--r--lisp/gnus/ChangeLog.158
-rw-r--r--lisp/gnus/ChangeLog.22315
-rw-r--r--lisp/gnus/ChangeLog.3 (renamed from lisp/gnus/ChangeLog)1373
-rw-r--r--lisp/gnus/auth-source.el430
-rw-r--r--lisp/gnus/canlock.el7
-rw-r--r--lisp/gnus/compface.el2
-rw-r--r--lisp/gnus/deuglify.el14
-rw-r--r--lisp/gnus/ecomplete.el2
-rw-r--r--lisp/gnus/flow-fill.el2
-rw-r--r--lisp/gnus/gmm-utils.el39
-rw-r--r--lisp/gnus/gnus-agent.el215
-rw-r--r--lisp/gnus/gnus-art.el867
-rw-r--r--lisp/gnus/gnus-async.el5
-rw-r--r--lisp/gnus/gnus-bcklg.el6
-rw-r--r--lisp/gnus/gnus-bookmark.el41
-rw-r--r--lisp/gnus/gnus-cache.el6
-rw-r--r--lisp/gnus/gnus-cite.el25
-rw-r--r--lisp/gnus/gnus-cloud.el343
-rw-r--r--lisp/gnus/gnus-cus.el14
-rw-r--r--lisp/gnus/gnus-delay.el6
-rw-r--r--lisp/gnus/gnus-demon.el2
-rw-r--r--lisp/gnus/gnus-diary.el2
-rw-r--r--lisp/gnus/gnus-dired.el2
-rw-r--r--lisp/gnus/gnus-draft.el2
-rw-r--r--lisp/gnus/gnus-dup.el2
-rw-r--r--lisp/gnus/gnus-eform.el15
-rw-r--r--lisp/gnus/gnus-ems.el2
-rw-r--r--lisp/gnus/gnus-fun.el110
-rw-r--r--lisp/gnus/gnus-gravatar.el2
-rw-r--r--lisp/gnus/gnus-group.el166
-rw-r--r--lisp/gnus/gnus-html.el26
-rw-r--r--lisp/gnus/gnus-icalendar.el282
-rw-r--r--lisp/gnus/gnus-int.el25
-rw-r--r--lisp/gnus/gnus-kill.el48
-rw-r--r--lisp/gnus/gnus-logic.el2
-rw-r--r--lisp/gnus/gnus-mh.el2
-rw-r--r--lisp/gnus/gnus-ml.el2
-rw-r--r--lisp/gnus/gnus-mlspl.el39
-rw-r--r--lisp/gnus/gnus-msg.el76
-rw-r--r--lisp/gnus/gnus-notifications.el32
-rw-r--r--lisp/gnus/gnus-picon.el6
-rw-r--r--lisp/gnus/gnus-range.el2
-rw-r--r--lisp/gnus/gnus-registry.el172
-rw-r--r--lisp/gnus/gnus-salt.el129
-rw-r--r--lisp/gnus/gnus-score.el4
-rw-r--r--lisp/gnus/gnus-setup.el191
-rw-r--r--lisp/gnus/gnus-sieve.el31
-rw-r--r--lisp/gnus/gnus-spec.el9
-rw-r--r--lisp/gnus/gnus-srvr.el70
-rw-r--r--lisp/gnus/gnus-start.el43
-rw-r--r--lisp/gnus/gnus-sum.el212
-rw-r--r--lisp/gnus/gnus-sync.el16
-rw-r--r--lisp/gnus/gnus-topic.el75
-rw-r--r--lisp/gnus/gnus-undo.el2
-rw-r--r--lisp/gnus/gnus-util.el86
-rw-r--r--lisp/gnus/gnus-uu.el27
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/gnus.el50
-rw-r--r--lisp/gnus/gravatar.el14
-rw-r--r--lisp/gnus/gssapi.el2
-rw-r--r--lisp/gnus/html2text.el82
-rw-r--r--lisp/gnus/ietf-drums.el6
-rw-r--r--lisp/gnus/legacy-gnus-agent.el13
-rw-r--r--lisp/gnus/mail-parse.el2
-rw-r--r--lisp/gnus/mail-prsvr.el2
-rw-r--r--lisp/gnus/mail-source.el36
-rw-r--r--lisp/gnus/mailcap.el68
-rw-r--r--lisp/gnus/message.el391
-rw-r--r--lisp/gnus/messcompat.el2
-rw-r--r--lisp/gnus/mm-archive.el7
-rw-r--r--lisp/gnus/mm-bodies.el6
-rw-r--r--lisp/gnus/mm-decode.el95
-rw-r--r--lisp/gnus/mm-encode.el2
-rw-r--r--lisp/gnus/mm-extern.el6
-rw-r--r--lisp/gnus/mm-partial.el2
-rw-r--r--lisp/gnus/mm-url.el48
-rw-r--r--lisp/gnus/mm-util.el66
-rw-r--r--lisp/gnus/mm-uu.el43
-rw-r--r--lisp/gnus/mm-view.el133
-rw-r--r--lisp/gnus/mml-sec.el2
-rw-r--r--lisp/gnus/mml-smime.el53
-rw-r--r--lisp/gnus/mml.el72
-rw-r--r--lisp/gnus/mml1991.el5
-rw-r--r--lisp/gnus/mml2015.el26
-rw-r--r--lisp/gnus/nnagent.el2
-rw-r--r--lisp/gnus/nnbabyl.el4
-rw-r--r--lisp/gnus/nndiary.el16
-rw-r--r--lisp/gnus/nndir.el2
-rw-r--r--lisp/gnus/nndoc.el14
-rw-r--r--lisp/gnus/nndraft.el6
-rw-r--r--lisp/gnus/nneething.el4
-rw-r--r--lisp/gnus/nnfolder.el6
-rw-r--r--lisp/gnus/nngateway.el2
-rw-r--r--lisp/gnus/nnheader.el9
-rw-r--r--lisp/gnus/nnimap.el334
-rw-r--r--lisp/gnus/nnir.el54
-rw-r--r--lisp/gnus/nnmail.el59
-rw-r--r--lisp/gnus/nnmaildir.el132
-rw-r--r--lisp/gnus/nnmairix.el20
-rw-r--r--lisp/gnus/nnmbox.el4
-rw-r--r--lisp/gnus/nnmh.el8
-rw-r--r--lisp/gnus/nnml.el31
-rw-r--r--lisp/gnus/nnoo.el2
-rw-r--r--lisp/gnus/nnregistry.el2
-rw-r--r--lisp/gnus/nnrss.el29
-rw-r--r--lisp/gnus/nnspool.el4
-rw-r--r--lisp/gnus/nntp.el35
-rw-r--r--lisp/gnus/nnvirtual.el10
-rw-r--r--lisp/gnus/nnweb.el9
-rw-r--r--lisp/gnus/plstore.el15
-rw-r--r--lisp/gnus/pop3.el9
-rw-r--r--lisp/gnus/qp.el2
-rw-r--r--lisp/gnus/registry.el211
-rw-r--r--lisp/gnus/rfc1843.el10
-rw-r--r--lisp/gnus/rfc2045.el2
-rw-r--r--lisp/gnus/rfc2047.el8
-rw-r--r--lisp/gnus/rfc2231.el13
-rw-r--r--lisp/gnus/rtree.el9
-rw-r--r--lisp/gnus/score-mode.el28
-rw-r--r--lisp/gnus/sieve-manage.el12
-rw-r--r--lisp/gnus/sieve-mode.el5
-rw-r--r--lisp/gnus/sieve.el26
-rw-r--r--lisp/gnus/smiley.el2
-rw-r--r--lisp/gnus/smime.el7
-rw-r--r--lisp/gnus/spam-report.el6
-rw-r--r--lisp/gnus/spam-stat.el2
-rw-r--r--lisp/gnus/spam-wash.el2
-rw-r--r--lisp/gnus/spam.el59
-rw-r--r--lisp/gnus/starttls.el2
-rw-r--r--lisp/gnus/utf7.el2
-rw-r--r--lisp/gnus/yenc.el2
-rw-r--r--lisp/gs.el4
-rw-r--r--lisp/help-at-pt.el29
-rw-r--r--lisp/help-fns.el544
-rw-r--r--lisp/help-macro.el4
-rw-r--r--lisp/help-mode.el136
-rw-r--r--lisp/help.el504
-rw-r--r--lisp/hex-util.el2
-rw-r--r--lisp/hexl.el59
-rw-r--r--lisp/hfy-cmap.el6
-rw-r--r--lisp/hi-lock.el118
-rw-r--r--lisp/hilit-chg.el20
-rw-r--r--lisp/hippie-exp.el160
-rw-r--r--lisp/hl-line.el49
-rw-r--r--lisp/htmlfontify.el98
-rw-r--r--lisp/ibuf-ext.el23
-rw-r--r--lisp/ibuf-macs.el11
-rw-r--r--lisp/ibuffer.el320
-rw-r--r--lisp/icomplete.el355
-rw-r--r--lisp/ido.el700
-rw-r--r--lisp/ielm.el387
-rw-r--r--lisp/iimage.el5
-rw-r--r--lisp/image-dired.el10
-rw-r--r--lisp/image-file.el2
-rw-r--r--lisp/image-mode.el83
-rw-r--r--lisp/image.el93
-rw-r--r--lisp/imenu.el104
-rw-r--r--lisp/indent.el273
-rw-r--r--lisp/info-look.el76
-rw-r--r--lisp/info-xref.el8
-rw-r--r--lisp/info.el493
-rw-r--r--lisp/informat.el4
-rw-r--r--lisp/international/.gitignore1
-rw-r--r--lisp/international/README48
-rw-r--r--lisp/international/ccl.el114
-rw-r--r--lisp/international/characters.el402
-rw-r--r--lisp/international/charprop.el87
-rw-r--r--lisp/international/cp51932.el470
-rw-r--r--lisp/international/eucjp-ms.el2087
-rw-r--r--lisp/international/fontset.el207
-rw-r--r--lisp/international/isearch-x.el3
-rw-r--r--lisp/international/iso-ascii.el4
-rw-r--r--lisp/international/iso-cvt.el4
-rw-r--r--lisp/international/iso-transl.el35
-rw-r--r--lisp/international/ja-dic-cnv.el19
-rw-r--r--lisp/international/ja-dic-utl.el5
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el4
-rw-r--r--lisp/international/latexenc.el2
-rw-r--r--lisp/international/latin1-disp.el4
-rw-r--r--lisp/international/mule-cmds.el202
-rw-r--r--lisp/international/mule-conf.el28
-rw-r--r--lisp/international/mule-diag.el48
-rw-r--r--lisp/international/mule-util.el272
-rw-r--r--lisp/international/mule.el171
-rw-r--r--lisp/international/ogonek.el40
-rw-r--r--lisp/international/quail.el65
-rw-r--r--lisp/international/robin.el4
-rw-r--r--lisp/international/titdic-cnv.el42
-rw-r--r--lisp/international/ucs-normalize.el4
-rw-r--r--lisp/international/uni-bidi.el23
-rw-r--r--lisp/international/uni-category.el35
-rw-r--r--lisp/international/uni-combining.el23
-rw-r--r--lisp/international/uni-comment.elbin2386 -> 0 bytes
-rw-r--r--lisp/international/uni-decimal.elbin2770 -> 0 bytes
-rw-r--r--lisp/international/uni-decomposition.elbin29332 -> 0 bytes
-rw-r--r--lisp/international/uni-digit.elbin3088 -> 0 bytes
-rw-r--r--lisp/international/uni-lowercase.elbin6445 -> 0 bytes
-rw-r--r--lisp/international/uni-mirrored.elbin9423 -> 0 bytes
-rw-r--r--lisp/international/uni-name.elbin162318 -> 0 bytes
-rw-r--r--lisp/international/uni-numeric.elbin4609 -> 0 bytes
-rw-r--r--lisp/international/uni-old-name.elbin19760 -> 0 bytes
-rw-r--r--lisp/international/uni-titlecase.elbin6485 -> 0 bytes
-rw-r--r--lisp/international/uni-uppercase.elbin6481 -> 0 bytes
-rw-r--r--lisp/international/utf-7.el2
-rw-r--r--lisp/isearch.el871
-rw-r--r--lisp/isearchb.el13
-rw-r--r--lisp/jit-lock.el299
-rw-r--r--lisp/jka-cmpr-hook.el6
-rw-r--r--lisp/jka-compr.el6
-rw-r--r--lisp/json.el85
-rw-r--r--lisp/kermit.el6
-rw-r--r--lisp/kmacro.el89
-rw-r--r--lisp/language/.gitignore1
-rw-r--r--lisp/language/china-util.el14
-rw-r--r--lisp/language/chinese.el2
-rw-r--r--lisp/language/cyril-util.el4
-rw-r--r--lisp/language/cyrillic.el4
-rw-r--r--lisp/language/czech.el2
-rw-r--r--lisp/language/english.el2
-rw-r--r--lisp/language/ethio-util.el10
-rw-r--r--lisp/language/ethiopic.el2
-rw-r--r--lisp/language/european.el2
-rw-r--r--lisp/language/georgian.el2
-rw-r--r--lisp/language/greek.el2
-rw-r--r--lisp/language/hanja-util.el6
-rw-r--r--lisp/language/hebrew.el2
-rw-r--r--lisp/language/ind-util.el2
-rw-r--r--lisp/language/indian.el2
-rw-r--r--lisp/language/japan-util.el10
-rw-r--r--lisp/language/japanese.el6
-rw-r--r--lisp/language/korea-util.el2
-rw-r--r--lisp/language/korean.el2
-rw-r--r--lisp/language/lao-util.el2
-rw-r--r--lisp/language/lao.el2
-rw-r--r--lisp/language/misc-lang.el6
-rw-r--r--lisp/language/romanian.el2
-rw-r--r--lisp/language/slovak.el2
-rw-r--r--lisp/language/tai-viet.el2
-rw-r--r--lisp/language/thai-util.el2
-rw-r--r--lisp/language/thai.el2
-rw-r--r--lisp/language/tibet-util.el2
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/language/tv-util.el2
-rw-r--r--lisp/language/utf-8-lang.el2
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/language/vietnamese.el2
-rw-r--r--lisp/ldefs-boot.el6309
-rw-r--r--lisp/leim/quail/arabic.el115
-rw-r--r--lisp/leim/quail/croatian.el199
-rw-r--r--lisp/leim/quail/cyril-jis.el145
-rw-r--r--lisp/leim/quail/cyrillic.el1480
-rw-r--r--lisp/leim/quail/czech.el568
-rw-r--r--lisp/leim/quail/ethiopic.el1149
-rw-r--r--lisp/leim/quail/georgian.el83
-rw-r--r--lisp/leim/quail/greek.el1431
-rw-r--r--lisp/leim/quail/hangul.el556
-rw-r--r--lisp/leim/quail/hanja-jis.el527
-rw-r--r--lisp/leim/quail/hanja.el516
-rw-r--r--lisp/leim/quail/hanja3.el614
-rw-r--r--lisp/leim/quail/hebrew.el882
-rw-r--r--lisp/leim/quail/indian.el473
-rw-r--r--lisp/leim/quail/ipa-praat.el346
-rw-r--r--lisp/leim/quail/ipa.el519
-rw-r--r--lisp/leim/quail/japanese.el553
-rw-r--r--lisp/leim/quail/lao.el214
-rw-r--r--lisp/leim/quail/latin-alt.el1722
-rw-r--r--lisp/leim/quail/latin-ltx.el738
-rw-r--r--lisp/leim/quail/latin-post.el2497
-rw-r--r--lisp/leim/quail/latin-pre.el1194
-rw-r--r--lisp/leim/quail/lrt.el81
-rw-r--r--lisp/leim/quail/persian.el526
-rw-r--r--lisp/leim/quail/py-punct.el77
-rw-r--r--lisp/leim/quail/pypunct-b5.el56
-rw-r--r--lisp/leim/quail/rfc1345.el2064
-rw-r--r--lisp/leim/quail/sgml-input.el1061
-rw-r--r--lisp/leim/quail/sisheng.el290
-rw-r--r--lisp/leim/quail/slovak.el479
-rw-r--r--lisp/leim/quail/symbol-ksc.el202
-rw-r--r--lisp/leim/quail/thai.el112
-rw-r--r--lisp/leim/quail/tibetan.el457
-rw-r--r--lisp/leim/quail/uni-input.el138
-rw-r--r--lisp/leim/quail/viqr.el71
-rw-r--r--lisp/leim/quail/vntelex.el428
-rw-r--r--lisp/leim/quail/vnvni.el305
-rw-r--r--lisp/leim/quail/welsh.el201
-rw-r--r--lisp/linum.el23
-rw-r--r--lisp/loadhist.el22
-rw-r--r--lisp/loadup.el177
-rw-r--r--lisp/locate.el46
-rw-r--r--lisp/lpr.el16
-rw-r--r--lisp/ls-lisp.el208
-rw-r--r--lisp/macros.el17
-rw-r--r--lisp/mail/.gitignore1
-rw-r--r--lisp/mail/binhex.el2
-rw-r--r--lisp/mail/blessmail.el4
-rw-r--r--lisp/mail/emacsbug.el86
-rw-r--r--lisp/mail/feedmail.el96
-rw-r--r--lisp/mail/footnote.el13
-rw-r--r--lisp/mail/hashcash.el31
-rw-r--r--lisp/mail/mail-extr.el36
-rw-r--r--lisp/mail/mail-hist.el2
-rw-r--r--lisp/mail/mail-utils.el11
-rw-r--r--lisp/mail/mailabbrev.el6
-rw-r--r--lisp/mail/mailalias.el12
-rw-r--r--lisp/mail/mailclient.el65
-rw-r--r--lisp/mail/mailheader.el2
-rw-r--r--lisp/mail/metamail.el4
-rw-r--r--lisp/mail/mspools.el14
-rw-r--r--lisp/mail/reporter.el11
-rw-r--r--lisp/mail/rfc2368.el12
-rw-r--r--lisp/mail/rfc822.el4
-rw-r--r--lisp/mail/rmail-spam-filter.el2
-rw-r--r--lisp/mail/rmail.el478
-rw-r--r--lisp/mail/rmailedit.el6
-rw-r--r--lisp/mail/rmailkwd.el4
-rw-r--r--lisp/mail/rmailmm.el182
-rw-r--r--lisp/mail/rmailmsc.el4
-rw-r--r--lisp/mail/rmailout.el51
-rw-r--r--lisp/mail/rmailsort.el4
-rw-r--r--lisp/mail/rmailsum.el169
-rw-r--r--lisp/mail/sendmail.el119
-rw-r--r--lisp/mail/smtpmail.el5
-rw-r--r--lisp/mail/supercite.el16
-rw-r--r--lisp/mail/uce.el6
-rw-r--r--lisp/mail/undigest.el6
-rw-r--r--lisp/mail/unrmail.el8
-rw-r--r--lisp/mail/uudecode.el4
-rw-r--r--lisp/makefile.w32-in728
-rw-r--r--lisp/makesum.el4
-rw-r--r--lisp/man.el442
-rw-r--r--lisp/master.el2
-rw-r--r--lisp/mb-depth.el2
-rw-r--r--lisp/md4.el2
-rw-r--r--lisp/menu-bar.el621
-rw-r--r--lisp/mh-e/.gitignore3
-rw-r--r--lisp/mh-e/ChangeLog.125
-rw-r--r--lisp/mh-e/ChangeLog.2 (renamed from lisp/mh-e/ChangeLog)91
-rw-r--r--lisp/mh-e/mh-acros.el6
-rw-r--r--lisp/mh-e/mh-alias.el4
-rw-r--r--lisp/mh-e/mh-buffers.el2
-rw-r--r--lisp/mh-e/mh-comp.el59
-rw-r--r--lisp/mh-e/mh-compat.el22
-rw-r--r--lisp/mh-e/mh-e.el22
-rw-r--r--lisp/mh-e/mh-folder.el18
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-gnus.el2
-rw-r--r--lisp/mh-e/mh-identity.el2
-rw-r--r--lisp/mh-e/mh-inc.el2
-rw-r--r--lisp/mh-e/mh-junk.el2
-rw-r--r--lisp/mh-e/mh-letter.el6
-rw-r--r--lisp/mh-e/mh-limit.el2
-rw-r--r--lisp/mh-e/mh-mime.el32
-rw-r--r--lisp/mh-e/mh-print.el8
-rw-r--r--lisp/mh-e/mh-scan.el2
-rw-r--r--lisp/mh-e/mh-search.el6
-rw-r--r--lisp/mh-e/mh-seq.el6
-rw-r--r--lisp/mh-e/mh-show.el2
-rw-r--r--lisp/mh-e/mh-speed.el2
-rw-r--r--lisp/mh-e/mh-thread.el10
-rw-r--r--lisp/mh-e/mh-tool-bar.el2
-rw-r--r--lisp/mh-e/mh-utils.el16
-rw-r--r--lisp/mh-e/mh-xface.el4
-rw-r--r--lisp/midnight.el99
-rw-r--r--lisp/minibuf-eldef.el2
-rw-r--r--lisp/minibuffer.el542
-rw-r--r--lisp/misc.el4
-rw-r--r--lisp/misearch.el72
-rw-r--r--lisp/mouse-copy.el12
-rw-r--r--lisp/mouse-drag.el10
-rw-r--r--lisp/mouse.el685
-rw-r--r--lisp/mpc.el228
-rw-r--r--lisp/msb.el17
-rw-r--r--lisp/mwheel.el2
-rw-r--r--lisp/net/.gitignore1
-rw-r--r--lisp/net/ange-ftp.el68
-rw-r--r--lisp/net/browse-url.el396
-rw-r--r--lisp/net/dbus.el300
-rw-r--r--lisp/net/dig.el2
-rw-r--r--lisp/net/dns.el25
-rw-r--r--lisp/net/eudc-bob.el7
-rw-r--r--lisp/net/eudc-export.el9
-rw-r--r--lisp/net/eudc-hotlist.el44
-rw-r--r--lisp/net/eudc-vars.el106
-rw-r--r--lisp/net/eudc.el138
-rw-r--r--lisp/net/eudcb-bbdb.el31
-rw-r--r--lisp/net/eudcb-ldap.el83
-rw-r--r--lisp/net/eudcb-mab.el4
-rw-r--r--lisp/net/eudcb-ph.el15
-rw-r--r--lisp/net/eww.el1610
-rw-r--r--lisp/net/gnutls.el88
-rw-r--r--lisp/net/goto-addr.el4
-rw-r--r--lisp/net/hmac-def.el2
-rw-r--r--lisp/net/hmac-md5.el2
-rw-r--r--lisp/net/imap.el43
-rw-r--r--lisp/net/ldap.el158
-rw-r--r--lisp/net/mairix.el99
-rw-r--r--lisp/net/net-utils.el26
-rw-r--r--lisp/net/netrc.el2
-rw-r--r--lisp/net/network-stream.el44
-rw-r--r--lisp/net/newst-backend.el506
-rw-r--r--lisp/net/newst-plainview.el7
-rw-r--r--lisp/net/newst-reader.el104
-rw-r--r--lisp/net/newst-ticker.el11
-rw-r--r--lisp/net/newst-treeview.el475
-rw-r--r--lisp/net/newsticker.el7
-rw-r--r--lisp/net/nsm.el508
-rw-r--r--lisp/net/ntlm.el151
-rw-r--r--lisp/net/pinentry.el452
-rw-r--r--lisp/net/quickurl.el11
-rw-r--r--lisp/net/rcirc.el362
-rw-r--r--lisp/net/rfc2104.el (renamed from lisp/gnus/rfc2104.el)2
-rw-r--r--lisp/net/rlogin.el10
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el2
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl-scram-rfc.el163
-rw-r--r--lisp/net/sasl.el8
-rw-r--r--lisp/net/secrets.el37
-rw-r--r--lisp/net/shr-color.el12
-rw-r--r--lisp/net/shr.el1663
-rw-r--r--lisp/net/snmp-mode.el2
-rw-r--r--lisp/net/soap-client.el3202
-rw-r--r--lisp/net/soap-inspect.el423
-rw-r--r--lisp/net/socks.el8
-rw-r--r--lisp/net/telnet.el6
-rw-r--r--lisp/net/tls.el20
-rw-r--r--lisp/net/tramp-adb.el570
-rw-r--r--lisp/net/tramp-cache.el117
-rw-r--r--lisp/net/tramp-cmds.el47
-rw-r--r--lisp/net/tramp-compat.el142
-rw-r--r--lisp/net/tramp-ftp.el22
-rw-r--r--lisp/net/tramp-gvfs.el864
-rw-r--r--lisp/net/tramp-gw.el28
-rw-r--r--lisp/net/tramp-sh.el2054
-rw-r--r--lisp/net/tramp-smb.el716
-rw-r--r--lisp/net/tramp-uu.el2
-rw-r--r--lisp/net/tramp.el1304
-rw-r--r--lisp/net/trampver.el26
-rw-r--r--lisp/net/webjump.el2
-rw-r--r--lisp/net/zeroconf.el12
-rw-r--r--lisp/newcomment.el243
-rw-r--r--lisp/notifications.el4
-rw-r--r--lisp/novice.el11
-rw-r--r--lisp/nxml/.gitignore2
-rw-r--r--lisp/nxml/nxml-enc.el4
-rw-r--r--lisp/nxml/nxml-glyph.el4
-rw-r--r--lisp/nxml/nxml-maint.el4
-rw-r--r--lisp/nxml/nxml-mode.el118
-rw-r--r--lisp/nxml/nxml-ns.el21
-rw-r--r--lisp/nxml/nxml-outln.el6
-rw-r--r--lisp/nxml/nxml-parse.el6
-rw-r--r--lisp/nxml/nxml-rap.el12
-rw-r--r--lisp/nxml/nxml-uchnm.el4
-rw-r--r--lisp/nxml/nxml-util.el13
-rw-r--r--lisp/nxml/rng-cmpct.el9
-rw-r--r--lisp/nxml/rng-dt.el4
-rw-r--r--lisp/nxml/rng-loc.el4
-rw-r--r--lisp/nxml/rng-maint.el4
-rw-r--r--lisp/nxml/rng-match.el497
-rw-r--r--lisp/nxml/rng-nxml.el4
-rw-r--r--lisp/nxml/rng-parse.el4
-rw-r--r--lisp/nxml/rng-pttrn.el4
-rw-r--r--lisp/nxml/rng-uri.el8
-rw-r--r--lisp/nxml/rng-util.el4
-rw-r--r--lisp/nxml/rng-valid.el20
-rw-r--r--lisp/nxml/rng-xsd.el4
-rw-r--r--lisp/nxml/xmltok.el45
-rw-r--r--lisp/nxml/xsd-regexp.el4
-rw-r--r--lisp/obsolete/.gitignore0
-rw-r--r--lisp/obsolete/abbrevlist.el4
-rw-r--r--lisp/obsolete/assoc.el14
-rw-r--r--lisp/obsolete/awk-mode.el4
-rw-r--r--lisp/obsolete/bruce.el6
-rw-r--r--lisp/obsolete/cc-compat.el (renamed from lisp/progmodes/cc-compat.el)3
-rw-r--r--lisp/obsolete/cl-compat.el10
-rw-r--r--lisp/obsolete/complete.el4
-rw-r--r--lisp/obsolete/crisp.el (renamed from lisp/emulation/crisp.el)5
-rw-r--r--lisp/obsolete/cust-print.el2
-rw-r--r--lisp/obsolete/erc-hecomplete.el2
-rw-r--r--lisp/obsolete/fast-lock.el10
-rw-r--r--lisp/obsolete/gulp.el (renamed from lisp/emacs-lisp/gulp.el)12
-rw-r--r--lisp/obsolete/iso-acc.el10
-rw-r--r--lisp/obsolete/iso-insert.el6
-rw-r--r--lisp/obsolete/iso-swed.el4
-rw-r--r--lisp/obsolete/iswitchb.el (renamed from lisp/iswitchb.el)17
-rw-r--r--lisp/obsolete/keyswap.el4
-rw-r--r--lisp/obsolete/landmark.el (renamed from lisp/play/landmark.el)191
-rw-r--r--lisp/obsolete/lazy-lock.el9
-rw-r--r--lisp/obsolete/ledit.el4
-rw-r--r--lisp/obsolete/levents.el4
-rw-r--r--lisp/obsolete/lmenu.el10
-rw-r--r--lisp/obsolete/longlines.el17
-rw-r--r--lisp/obsolete/lucid.el35
-rw-r--r--lisp/obsolete/mailpost.el9
-rw-r--r--lisp/obsolete/meese.el (renamed from lisp/play/meese.el)5
-rw-r--r--lisp/obsolete/mouse-sel.el48
-rw-r--r--lisp/obsolete/old-emacs-lock.el2
-rw-r--r--lisp/obsolete/old-whitespace.el4
-rw-r--r--lisp/obsolete/options.el20
-rw-r--r--lisp/obsolete/otodo-mode.el13
-rw-r--r--lisp/obsolete/patcomp.el2
-rw-r--r--lisp/obsolete/pc-mode.el4
-rw-r--r--lisp/obsolete/pc-select.el16
-rw-r--r--lisp/obsolete/pgg-def.el2
-rw-r--r--lisp/obsolete/pgg-gpg.el4
-rw-r--r--lisp/obsolete/pgg-parse.el2
-rw-r--r--lisp/obsolete/pgg-pgp.el18
-rw-r--r--lisp/obsolete/pgg-pgp5.el26
-rw-r--r--lisp/obsolete/pgg.el2
-rw-r--r--lisp/obsolete/rcompile.el (renamed from lisp/net/rcompile.el)5
-rw-r--r--lisp/obsolete/resume.el2
-rw-r--r--lisp/obsolete/s-region.el2
-rw-r--r--lisp/obsolete/scribe.el12
-rw-r--r--lisp/obsolete/spell.el4
-rw-r--r--lisp/obsolete/sregex.el24
-rw-r--r--lisp/obsolete/sup-mouse.el4
-rw-r--r--lisp/obsolete/swedish.el4
-rw-r--r--lisp/obsolete/sym-comp.el8
-rw-r--r--lisp/obsolete/terminal.el8
-rw-r--r--lisp/obsolete/tpu-edt.el (renamed from lisp/emulation/tpu-edt.el)19
-rw-r--r--lisp/obsolete/tpu-extras.el (renamed from lisp/emulation/tpu-extras.el)3
-rw-r--r--lisp/obsolete/tpu-mapper.el (renamed from lisp/emulation/tpu-mapper.el)5
-rw-r--r--lisp/obsolete/vc-arch.el (renamed from lisp/vc/vc-arch.el)34
-rw-r--r--lisp/obsolete/vc-mcvs.el2
-rw-r--r--lisp/obsolete/vi.el (renamed from lisp/emulation/vi.el)21
-rw-r--r--lisp/obsolete/vip.el (renamed from lisp/emulation/vip.el)12
-rw-r--r--lisp/obsolete/ws-mode.el (renamed from lisp/emulation/ws-mode.el)117
-rw-r--r--lisp/obsolete/xesam.el6
-rw-r--r--lisp/obsolete/yow.el4
-rw-r--r--lisp/org/ChangeLog.1 (renamed from lisp/org/ChangeLog)6920
-rw-r--r--lisp/org/ob-C.el132
-rw-r--r--lisp/org/ob-R.el120
-rw-r--r--lisp/org/ob-asymptote.el2
-rw-r--r--lisp/org/ob-awk.el40
-rw-r--r--lisp/org/ob-calc.el46
-rw-r--r--lisp/org/ob-clojure.el37
-rw-r--r--lisp/org/ob-comint.el6
-rw-r--r--lisp/org/ob-core.el2775
-rw-r--r--lisp/org/ob-css.el2
-rw-r--r--lisp/org/ob-ditaa.el58
-rw-r--r--lisp/org/ob-dot.el5
-rw-r--r--lisp/org/ob-emacs-lisp.el40
-rw-r--r--lisp/org/ob-eval.el198
-rw-r--r--lisp/org/ob-exp.el275
-rw-r--r--lisp/org/ob-fortran.el43
-rw-r--r--lisp/org/ob-gnuplot.el113
-rw-r--r--lisp/org/ob-haskell.el30
-rw-r--r--lisp/org/ob-io.el16
-rw-r--r--lisp/org/ob-java.el28
-rw-r--r--lisp/org/ob-js.el55
-rw-r--r--lisp/org/ob-keys.el4
-rw-r--r--lisp/org/ob-latex.el158
-rw-r--r--lisp/org/ob-ledger.el2
-rw-r--r--lisp/org/ob-lilypond.el244
-rw-r--r--lisp/org/ob-lisp.el37
-rw-r--r--lisp/org/ob-lob.el69
-rw-r--r--lisp/org/ob-makefile.el48
-rw-r--r--lisp/org/ob-matlab.el2
-rw-r--r--lisp/org/ob-maxima.el38
-rw-r--r--lisp/org/ob-mscgen.el3
-rw-r--r--lisp/org/ob-ocaml.el30
-rw-r--r--lisp/org/ob-octave.el12
-rw-r--r--lisp/org/ob-org.el18
-rw-r--r--lisp/org/ob-perl.el94
-rw-r--r--lisp/org/ob-picolisp.el116
-rw-r--r--lisp/org/ob-plantuml.el7
-rw-r--r--lisp/org/ob-python.el206
-rw-r--r--lisp/org/ob-ref.el19
-rw-r--r--lisp/org/ob-ruby.el91
-rw-r--r--lisp/org/ob-sass.el3
-rw-r--r--lisp/org/ob-scala.el16
-rw-r--r--lisp/org/ob-scheme.el209
-rw-r--r--lisp/org/ob-screen.el7
-rw-r--r--lisp/org/ob-sh.el148
-rw-r--r--lisp/org/ob-shen.el20
-rw-r--r--lisp/org/ob-sql.el126
-rw-r--r--lisp/org/ob-sqlite.el63
-rw-r--r--lisp/org/ob-table.el75
-rw-r--r--lisp/org/ob-tangle.el363
-rw-r--r--lisp/org/ob.el2568
-rw-r--r--lisp/org/org-agenda.el2171
-rw-r--r--lisp/org/org-archive.el22
-rw-r--r--lisp/org/org-ascii.el730
-rw-r--r--lisp/org/org-attach.el56
-rw-r--r--lisp/org/org-bbdb.el22
-rw-r--r--lisp/org/org-beamer.el657
-rw-r--r--lisp/org/org-bibtex.el118
-rw-r--r--lisp/org/org-capture.el247
-rw-r--r--lisp/org/org-clock.el547
-rw-r--r--lisp/org/org-colview.el66
-rw-r--r--lisp/org/org-compat.el124
-rw-r--r--lisp/org/org-crypt.el31
-rw-r--r--lisp/org/org-ctags.el28
-rw-r--r--lisp/org/org-datetree.el7
-rw-r--r--lisp/org/org-docbook.el1453
-rw-r--r--lisp/org/org-docview.el25
-rw-r--r--lisp/org/org-element.el2969
-rw-r--r--lisp/org/org-entities.el77
-rw-r--r--lisp/org/org-eshell.el2
-rw-r--r--lisp/org/org-exp-blocks.el402
-rw-r--r--lisp/org/org-exp.el3354
-rw-r--r--lisp/org/org-faces.el72
-rw-r--r--lisp/org/org-feed.el5
-rw-r--r--lisp/org/org-footnote.el169
-rw-r--r--lisp/org/org-freemind.el1227
-rw-r--r--lisp/org/org-gnus.el17
-rw-r--r--lisp/org/org-habit.el32
-rw-r--r--lisp/org/org-html.el2761
-rw-r--r--lisp/org/org-icalendar.el692
-rw-r--r--lisp/org/org-id.el20
-rw-r--r--lisp/org/org-indent.el111
-rw-r--r--lisp/org/org-info.el2
-rw-r--r--lisp/org/org-inlinetask.el193
-rw-r--r--lisp/org/org-irc.el10
-rw-r--r--lisp/org/org-jsinfo.el262
-rw-r--r--lisp/org/org-latex.el2901
-rw-r--r--lisp/org/org-list.el437
-rw-r--r--lisp/org/org-lparse.el2303
-rw-r--r--lisp/org/org-mac-message.el216
-rw-r--r--lisp/org/org-macro.el193
-rw-r--r--lisp/org/org-macs.el145
-rw-r--r--lisp/org/org-mew.el136
-rw-r--r--lisp/org/org-mhe.el3
-rw-r--r--lisp/org/org-mks.el134
-rw-r--r--lisp/org/org-mobile.el58
-rw-r--r--lisp/org/org-mouse.el39
-rw-r--r--lisp/org/org-odt.el2859
-rw-r--r--lisp/org/org-pcomplete.el177
-rw-r--r--lisp/org/org-plot.el5
-rw-r--r--lisp/org/org-protocol.el106
-rw-r--r--lisp/org/org-publish.el1198
-rw-r--r--lisp/org/org-remember.el1156
-rw-r--r--lisp/org/org-rmail.el10
-rw-r--r--lisp/org/org-special-blocks.el104
-rw-r--r--lisp/org/org-src.el143
-rw-r--r--lisp/org/org-table.el547
-rw-r--r--lisp/org/org-taskjuggler.el699
-rw-r--r--lisp/org/org-timer.el20
-rw-r--r--lisp/org/org-version.el7
-rw-r--r--lisp/org/org-vm.el180
-rw-r--r--lisp/org/org-w3m.el19
-rw-r--r--lisp/org/org-wl.el316
-rw-r--r--lisp/org/org-xoxo.el129
-rw-r--r--lisp/org/org.el7208
-rw-r--r--lisp/org/ox-ascii.el1971
-rw-r--r--lisp/org/ox-beamer.el1183
-rw-r--r--lisp/org/ox-html.el3437
-rw-r--r--lisp/org/ox-icalendar.el984
-rw-r--r--lisp/org/ox-latex.el2951
-rw-r--r--lisp/org/ox-man.el1254
-rw-r--r--lisp/org/ox-md.el515
-rw-r--r--lisp/org/ox-odt.el4387
-rw-r--r--lisp/org/ox-org.el284
-rw-r--r--lisp/org/ox-publish.el1247
-rw-r--r--lisp/org/ox-texinfo.el1595
-rw-r--r--lisp/org/ox.el6241
-rw-r--r--lisp/outline.el377
-rw-r--r--lisp/paren.el222
-rw-r--r--lisp/password-cache.el2
-rw-r--r--lisp/pcmpl-cvs.el41
-rw-r--r--lisp/pcmpl-gnu.el6
-rw-r--r--lisp/pcmpl-linux.el2
-rw-r--r--lisp/pcmpl-rpm.el2
-rw-r--r--lisp/pcmpl-unix.el4
-rw-r--r--lisp/pcmpl-x.el43
-rw-r--r--lisp/pcomplete.el13
-rw-r--r--lisp/play/.gitignore1
-rw-r--r--lisp/play/5x5.el19
-rw-r--r--lisp/play/animate.el2
-rw-r--r--lisp/play/blackbox.el13
-rw-r--r--lisp/play/bubbles.el125
-rw-r--r--lisp/play/cookie1.el5
-rw-r--r--lisp/play/decipher.el6
-rw-r--r--lisp/play/dissociate.el4
-rw-r--r--lisp/play/doctor.el6
-rw-r--r--lisp/play/dunnet.el128
-rw-r--r--lisp/play/fortune.el2
-rw-r--r--lisp/play/gamegrid.el26
-rw-r--r--lisp/play/gametree.el90
-rw-r--r--lisp/play/gomoku.el120
-rw-r--r--lisp/play/handwrite.el14
-rw-r--r--lisp/play/hanoi.el4
-rw-r--r--lisp/play/life.el65
-rw-r--r--lisp/play/morse.el8
-rw-r--r--lisp/play/mpuz.el14
-rw-r--r--lisp/play/pong.el2
-rw-r--r--lisp/play/snake.el18
-rw-r--r--lisp/play/solitaire.el2
-rw-r--r--lisp/play/spook.el8
-rw-r--r--lisp/play/studly.el2
-rw-r--r--lisp/play/tetris.el14
-rw-r--r--lisp/play/zone.el2
-rw-r--r--lisp/printing.el281
-rw-r--r--lisp/proced.el23
-rw-r--r--lisp/profiler.el171
-rw-r--r--lisp/progmodes/.gitignore1
-rw-r--r--lisp/progmodes/ada-mode.el51
-rw-r--r--lisp/progmodes/ada-prj.el8
-rw-r--r--lisp/progmodes/ada-stmt.el2
-rw-r--r--lisp/progmodes/ada-xref.el166
-rw-r--r--lisp/progmodes/antlr-mode.el42
-rw-r--r--lisp/progmodes/asm-mode.el6
-rw-r--r--lisp/progmodes/autoconf.el5
-rw-r--r--lisp/progmodes/bat-mode.el7
-rw-r--r--lisp/progmodes/bug-reference.el4
-rw-r--r--lisp/progmodes/cap-words.el98
-rw-r--r--lisp/progmodes/cc-align.el40
-rw-r--r--lisp/progmodes/cc-awk.el15
-rw-r--r--lisp/progmodes/cc-bytecomp.el118
-rw-r--r--lisp/progmodes/cc-cmds.el122
-rw-r--r--lisp/progmodes/cc-defs.el588
-rw-r--r--lisp/progmodes/cc-engine.el1955
-rw-r--r--lisp/progmodes/cc-fonts.el252
-rw-r--r--lisp/progmodes/cc-guess.el18
-rw-r--r--lisp/progmodes/cc-langs.el521
-rw-r--r--lisp/progmodes/cc-menus.el10
-rw-r--r--lisp/progmodes/cc-mode.el740
-rw-r--r--lisp/progmodes/cc-styles.el24
-rw-r--r--lisp/progmodes/cc-vars.el37
-rw-r--r--lisp/progmodes/cfengine.el933
-rw-r--r--lisp/progmodes/cmacexp.el15
-rw-r--r--lisp/progmodes/compile.el230
-rw-r--r--lisp/progmodes/cperl-mode.el89
-rw-r--r--lisp/progmodes/cpp.el12
-rw-r--r--lisp/progmodes/cwarn.el4
-rw-r--r--lisp/progmodes/dcl-mode.el26
-rw-r--r--lisp/progmodes/ebnf-abn.el2
-rw-r--r--lisp/progmodes/ebnf-bnf.el2
-rw-r--r--lisp/progmodes/ebnf-dtd.el2
-rw-r--r--lisp/progmodes/ebnf-ebx.el2
-rw-r--r--lisp/progmodes/ebnf-iso.el2
-rw-r--r--lisp/progmodes/ebnf-otz.el2
-rw-r--r--lisp/progmodes/ebnf-yac.el2
-rw-r--r--lisp/progmodes/ebnf2ps.el10
-rw-r--r--lisp/progmodes/ebrowse.el11
-rw-r--r--lisp/progmodes/elisp-mode.el1580
-rw-r--r--lisp/progmodes/etags.el224
-rw-r--r--lisp/progmodes/executable.el34
-rw-r--r--lisp/progmodes/f90.el79
-rw-r--r--lisp/progmodes/flymake.el733
-rw-r--r--lisp/progmodes/fortran.el32
-rw-r--r--lisp/progmodes/gdb-mi.el160
-rw-r--r--lisp/progmodes/glasses.el6
-rw-r--r--lisp/progmodes/grep.el267
-rw-r--r--lisp/progmodes/gud.el156
-rw-r--r--lisp/progmodes/hideif.el1595
-rw-r--r--lisp/progmodes/hideshow.el30
-rw-r--r--lisp/progmodes/icon.el2
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el6
-rw-r--r--lisp/progmodes/idlw-help.el24
-rw-r--r--lisp/progmodes/idlw-shell.el117
-rw-r--r--lisp/progmodes/idlw-toolbar.el4
-rw-r--r--lisp/progmodes/idlwave.el68
-rw-r--r--lisp/progmodes/inf-lisp.el41
-rw-r--r--lisp/progmodes/js.el299
-rw-r--r--lisp/progmodes/ld-script.el2
-rw-r--r--lisp/progmodes/m4-mode.el45
-rw-r--r--lisp/progmodes/make-mode.el11
-rw-r--r--lisp/progmodes/mantemp.el4
-rw-r--r--lisp/progmodes/meta-mode.el2
-rw-r--r--lisp/progmodes/mixal-mode.el2
-rw-r--r--lisp/progmodes/modula2.el4
-rw-r--r--lisp/progmodes/octave.el622
-rw-r--r--lisp/progmodes/opascal.el35
-rw-r--r--lisp/progmodes/pascal.el69
-rw-r--r--lisp/progmodes/perl-mode.el417
-rw-r--r--lisp/progmodes/prog-mode.el193
-rw-r--r--lisp/progmodes/project.el176
-rw-r--r--lisp/progmodes/prolog.el1752
-rw-r--r--lisp/progmodes/ps-mode.el343
-rw-r--r--lisp/progmodes/python.el3853
-rw-r--r--lisp/progmodes/ruby-mode.el1760
-rw-r--r--lisp/progmodes/scheme.el97
-rw-r--r--lisp/progmodes/sh-script.el1107
-rw-r--r--lisp/progmodes/simula.el2
-rw-r--r--lisp/progmodes/sql.el411
-rw-r--r--lisp/progmodes/subword.el167
-rw-r--r--lisp/progmodes/tcl.el9
-rw-r--r--lisp/progmodes/vera-mode.el10
-rw-r--r--lisp/progmodes/verilog-mode.el4059
-rw-r--r--lisp/progmodes/vhdl-mode.el1326
-rw-r--r--lisp/progmodes/which-func.el38
-rw-r--r--lisp/progmodes/xref.el1001
-rw-r--r--lisp/progmodes/xscheme.el47
-rw-r--r--lisp/ps-bdf.el2
-rw-r--r--lisp/ps-def.el50
-rw-r--r--lisp/ps-mule.el2
-rw-r--r--lisp/ps-print.el51
-rw-r--r--lisp/ps-samp.el182
-rw-r--r--lisp/recentf.el13
-rw-r--r--lisp/rect.el539
-rw-r--r--lisp/register.el238
-rw-r--r--lisp/repeat.el12
-rw-r--r--lisp/replace.el465
-rw-r--r--lisp/reposition.el4
-rw-r--r--lisp/reveal.el49
-rw-r--r--lisp/rfn-eshadow.el2
-rw-r--r--lisp/rot13.el4
-rw-r--r--lisp/ruler-mode.el20
-rw-r--r--lisp/savehist.el47
-rw-r--r--lisp/saveplace.el160
-rw-r--r--lisp/sb-image.el2
-rw-r--r--lisp/scroll-all.el4
-rw-r--r--lisp/scroll-bar.el243
-rw-r--r--lisp/scroll-lock.el4
-rw-r--r--lisp/select.el286
-rw-r--r--lisp/server.el146
-rw-r--r--lisp/ses.el1223
-rw-r--r--lisp/shadowfile.el30
-rw-r--r--lisp/shell.el67
-rw-r--r--lisp/simple.el2066
-rw-r--r--lisp/skeleton.el93
-rw-r--r--lisp/sort.el44
-rw-r--r--lisp/soundex.el4
-rw-r--r--lisp/speedbar.el51
-rw-r--r--lisp/startup.el1079
-rw-r--r--lisp/strokes.el78
-rw-r--r--lisp/subr.el923
-rw-r--r--lisp/t-mouse.el4
-rw-r--r--lisp/tabify.el4
-rw-r--r--lisp/talk.el4
-rw-r--r--lisp/tar-mode.el128
-rw-r--r--lisp/tempo.el22
-rw-r--r--lisp/term.el182
-rw-r--r--lisp/term/.gitignore1
-rw-r--r--lisp/term/AT386.el4
-rw-r--r--lisp/term/README42
-rw-r--r--lisp/term/apollo.el5
-rw-r--r--lisp/term/common-win.el62
-rw-r--r--lisp/term/internal.el2
-rw-r--r--lisp/term/iris-ansi.el2
-rw-r--r--lisp/term/news.el4
-rw-r--r--lisp/term/ns-win.el244
-rw-r--r--lisp/term/pc-win.el277
-rw-r--r--lisp/term/rxvt.el144
-rw-r--r--lisp/term/screen.el22
-rw-r--r--lisp/term/sun.el13
-rw-r--r--lisp/term/tty-colors.el26
-rw-r--r--lisp/term/tvi970.el8
-rw-r--r--lisp/term/vt100.el4
-rw-r--r--lisp/term/vt102.el6
-rw-r--r--lisp/term/vt125.el6
-rw-r--r--lisp/term/vt201.el10
-rw-r--r--lisp/term/vt220.el10
-rw-r--r--lisp/term/vt240.el10
-rw-r--r--lisp/term/vt300.el8
-rw-r--r--lisp/term/vt320.el8
-rw-r--r--lisp/term/vt400.el8
-rw-r--r--lisp/term/vt420.el8
-rw-r--r--lisp/term/w32-win.el155
-rw-r--r--lisp/term/w32console.el7
-rw-r--r--lisp/term/wyse50.el5
-rw-r--r--lisp/term/x-win.el1859
-rw-r--r--lisp/term/xterm.el525
-rw-r--r--lisp/textmodes/.gitignore1
-rw-r--r--lisp/textmodes/artist.el128
-rw-r--r--lisp/textmodes/bib-mode.el8
-rw-r--r--lisp/textmodes/bibtex-style.el2
-rw-r--r--lisp/textmodes/bibtex.el78
-rw-r--r--lisp/textmodes/conf-mode.el19
-rw-r--r--lisp/textmodes/css-mode.el594
-rw-r--r--lisp/textmodes/dns-mode.el2
-rw-r--r--lisp/textmodes/enriched.el9
-rw-r--r--lisp/textmodes/fill.el19
-rw-r--r--lisp/textmodes/flyspell.el163
-rw-r--r--lisp/textmodes/ispell.el533
-rw-r--r--lisp/textmodes/makeinfo.el19
-rw-r--r--lisp/textmodes/nroff-mode.el4
-rw-r--r--lisp/textmodes/page-ext.el37
-rw-r--r--lisp/textmodes/page.el4
-rw-r--r--lisp/textmodes/paragraphs.el14
-rw-r--r--lisp/textmodes/picture.el22
-rw-r--r--lisp/textmodes/po.el4
-rw-r--r--lisp/textmodes/refbib.el4
-rw-r--r--lisp/textmodes/refer.el12
-rw-r--r--lisp/textmodes/refill.el2
-rw-r--r--lisp/textmodes/reftex-auc.el16
-rw-r--r--lisp/textmodes/reftex-cite.el100
-rw-r--r--lisp/textmodes/reftex-dcr.el10
-rw-r--r--lisp/textmodes/reftex-global.el15
-rw-r--r--lisp/textmodes/reftex-index.el47
-rw-r--r--lisp/textmodes/reftex-parse.el88
-rw-r--r--lisp/textmodes/reftex-ref.el26
-rw-r--r--lisp/textmodes/reftex-sel.el28
-rw-r--r--lisp/textmodes/reftex-toc.el187
-rw-r--r--lisp/textmodes/reftex-vars.el59
-rw-r--r--lisp/textmodes/reftex.el897
-rw-r--r--lisp/textmodes/remember.el132
-rw-r--r--lisp/textmodes/rst.el261
-rw-r--r--lisp/textmodes/sgml-mode.el268
-rw-r--r--lisp/textmodes/table.el95
-rw-r--r--lisp/textmodes/tex-mode.el633
-rw-r--r--lisp/textmodes/texinfmt.el52
-rw-r--r--lisp/textmodes/texinfo.el27
-rw-r--r--lisp/textmodes/texnfo-upd.el74
-rw-r--r--lisp/textmodes/text-mode.el58
-rw-r--r--lisp/textmodes/tildify.el522
-rw-r--r--lisp/textmodes/two-column.el10
-rw-r--r--lisp/textmodes/underline.el4
-rw-r--r--lisp/thingatpt.el73
-rw-r--r--lisp/thumbs.el8
-rw-r--r--lisp/time-stamp.el16
-rw-r--r--lisp/time.el43
-rw-r--r--lisp/timezone.el12
-rw-r--r--lisp/tmm.el37
-rw-r--r--lisp/tool-bar.el8
-rw-r--r--lisp/tooltip.el34
-rw-r--r--lisp/tree-widget.el8
-rw-r--r--lisp/tutorial.el47
-rw-r--r--lisp/type-break.el29
-rw-r--r--lisp/uniquify.el65
-rw-r--r--lisp/url/.gitignore4
-rw-r--r--lisp/url/ChangeLog.1 (renamed from lisp/url/ChangeLog)594
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el18
-rw-r--r--lisp/url/url-cache.el6
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-cookie.el19
-rw-r--r--lisp/url/url-dav.el16
-rw-r--r--lisp/url/url-dired.el2
-rw-r--r--lisp/url/url-domsuf.el23
-rw-r--r--lisp/url/url-expand.el2
-rw-r--r--lisp/url/url-file.el2
-rw-r--r--lisp/url/url-ftp.el2
-rw-r--r--lisp/url/url-future.el18
-rw-r--r--lisp/url/url-gw.el29
-rw-r--r--lisp/url/url-handlers.el92
-rw-r--r--lisp/url/url-history.el4
-rw-r--r--lisp/url/url-http.el105
-rw-r--r--lisp/url/url-imap.el2
-rw-r--r--lisp/url/url-irc.el2
-rw-r--r--lisp/url/url-ldap.el2
-rw-r--r--lisp/url/url-mailto.el2
-rw-r--r--lisp/url/url-methods.el2
-rw-r--r--lisp/url/url-misc.el10
-rw-r--r--lisp/url/url-news.el5
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/url/url-ns.el2
-rw-r--r--lisp/url/url-parse.el4
-rw-r--r--lisp/url/url-privacy.el2
-rw-r--r--lisp/url/url-proxy.el2
-rw-r--r--lisp/url/url-queue.el13
-rw-r--r--lisp/url/url-tramp.el79
-rw-r--r--lisp/url/url-util.el31
-rw-r--r--lisp/url/url-vars.el21
-rw-r--r--lisp/url/url.el12
-rw-r--r--lisp/userlock.el8
-rw-r--r--lisp/vc/add-log.el59
-rw-r--r--lisp/vc/compare-w.el91
-rw-r--r--lisp/vc/cvs-status.el4
-rw-r--r--lisp/vc/diff-mode.el45
-rw-r--r--lisp/vc/diff.el6
-rw-r--r--lisp/vc/ediff-diff.el32
-rw-r--r--lisp/vc/ediff-help.el84
-rw-r--r--lisp/vc/ediff-hook.el2
-rw-r--r--lisp/vc/ediff-init.el91
-rw-r--r--lisp/vc/ediff-merg.el10
-rw-r--r--lisp/vc/ediff-mult.el15
-rw-r--r--lisp/vc/ediff-ptch.el16
-rw-r--r--lisp/vc/ediff-util.el67
-rw-r--r--lisp/vc/ediff-vers.el2
-rw-r--r--lisp/vc/ediff-wind.el16
-rw-r--r--lisp/vc/ediff.el24
-rw-r--r--lisp/vc/emerge.el37
-rw-r--r--lisp/vc/log-edit.el348
-rw-r--r--lisp/vc/log-view.el71
-rw-r--r--lisp/vc/pcvs-defs.el42
-rw-r--r--lisp/vc/pcvs-info.el12
-rw-r--r--lisp/vc/pcvs-parse.el10
-rw-r--r--lisp/vc/pcvs-util.el8
-rw-r--r--lisp/vc/pcvs.el172
-rw-r--r--lisp/vc/smerge-mode.el68
-rw-r--r--lisp/vc/vc-annotate.el179
-rw-r--r--lisp/vc/vc-bzr.el199
-rw-r--r--lisp/vc/vc-cvs.el181
-rw-r--r--lisp/vc/vc-dav.el32
-rw-r--r--lisp/vc/vc-dir.el56
-rw-r--r--lisp/vc/vc-dispatcher.el99
-rw-r--r--lisp/vc/vc-filewise.el84
-rw-r--r--lisp/vc/vc-git.el407
-rw-r--r--lisp/vc/vc-hg.el308
-rw-r--r--lisp/vc/vc-hooks.el306
-rw-r--r--lisp/vc/vc-mtn.el82
-rw-r--r--lisp/vc/vc-rcs.el517
-rw-r--r--lisp/vc/vc-sccs.el166
-rw-r--r--lisp/vc/vc-src.el313
-rw-r--r--lisp/vc/vc-svn.el209
-rw-r--r--lisp/vc/vc.el860
-rw-r--r--lisp/vcursor.el8
-rw-r--r--lisp/version.el158
-rw-r--r--lisp/view.el8
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el4
-rw-r--r--lisp/w32-common-fns.el130
-rw-r--r--lisp/w32-fns.el10
-rw-r--r--lisp/w32-vars.el21
-rw-r--r--lisp/wdired.el24
-rw-r--r--lisp/whitespace.el336
-rw-r--r--lisp/wid-browse.el2
-rw-r--r--lisp/wid-edit.el138
-rw-r--r--lisp/widget.el8
-rw-r--r--lisp/windmove.el33
-rw-r--r--lisp/window.el3593
-rw-r--r--lisp/winner.el15
-rw-r--r--lisp/woman.el81
-rw-r--r--lisp/x-dnd.el14
-rw-r--r--lisp/xml.el10
-rw-r--r--lisp/xt-mouse.el444
1532 files changed, 213600 insertions, 131612 deletions
diff --git a/lisp/.gitignore b/lisp/.gitignore
deleted file mode 100644
index 6d5166e1349..00000000000
--- a/lisp/.gitignore
+++ /dev/null
@@ -1,6 +0,0 @@
-*.elc
-*-loaddefs.el
-loaddefs.el
-subdirs.el
-finder-inf.el
-cus-load.el
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
deleted file mode 100644
index cbeea784579..00000000000
--- a/lisp/ChangeLog
+++ /dev/null
@@ -1,6768 +0,0 @@
-2013-08-25 Alan Mackenzie <acm@muc.de>
-
- Parse C++ inher-intro when there's a template split over 2 lines.
-
- * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5C): Code more
- rigorously the search for "class" etc. followed by ":".
-
- * progmodes/cc-langs.el (c-opt-<>-sexp-key): Make the value for
- random languages a regexp which never matches rather than nil.
-
- Handle "/"s more accurately in test for virtual semicolons (AWK Mode).
-
- * progmodes/cc-awk.el (c-awk-one-line-possibly-open-string-re)
- (c-awk-regexp-one-line-possibly-open-char-list-re)
- (c-awk-one-line-possibly-open-regexp-re)
- (c-awk-one-line-non-syn-ws*-re): Remove.
- (c-awk-possibly-open-string-re, c-awk-non-/-syn-ws*-re)
- (c-awk-space*-/-re, c-awk-space*-regexp-/-re)
- (c-awk-space*-unclosed-regexp-/-re): New constants.
- (c-awk-at-vsemi-p): Reformulate better to recognize "/"s which
- aren't regexp delimiters.
-
- * progmodes/cc-engine.el (c-crosses-statement-barrier-p): Add in
- handling for a rare situation in AWK Mode involving unterminated
- strings/regexps.
-
-2013-08-23 Glenn Morris <rgm@gnu.org>
-
- * files.el (auto-mode-alist): Use sh-mode for .bash_history.
-
- * files.el (interpreter-mode-alist): Use tcl-mode for expect scripts.
-
- * files.el (create-file-buffer): If the result would begin with
- spaces, prepend a "|" instead of removing them. (Bug#15162)
-
-2013-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * textmodes/fill.el (fill-match-adaptive-prefix): Don't throw away
- text-properties (bug#15155).
-
- * calc/calc-keypd.el (calc-keypad-execute): `x-flush-mouse-queue' doesn't
- exist any more.
- (calc-keypad-redraw): Remove unused var `pad'.
- (calc-keypad-press): Remove unused var `menu'.
-
-2013-08-23 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (display-buffer-pop-up-frame):
- Call pop-up-frame-function with BUFFER current so `make-frame' will
- use it as the new frame's buffer (Bug#15133).
-
-2013-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * calendar/timeclock.el: Minor cleanups.
- (timeclock-ask-before-exiting, timeclock-use-display-time):
- Use `symbol'.
- (timeclock-modeline-display): Define as alias before the
- actual definition.
- (timeclock-mode-line-display): Use define-minor-mode.
- (timeclock-day-list-template): Make it a function, add an argument.
- (timeclock-day-list-required, timeclock-day-list-length)
- (timeclock-day-list-debt, timeclock-day-list-span)
- (timeclock-day-list-break): Adjust calls accordingly.
-
-2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/pp.el (pp-eval-expression, pp-macroexpand-expression):
- Use read--expression so that completion works again.
-
-2013-08-21 Sam Steingold <sds@gnu.org>
-
- Add rudimentary inferior shell interaction
- * progmodes/sh-script.el (sh-shell-process): New buffer-local variable.
- (sh-set-shell): Reset it.
- (sh-show-shell, sh-cd-here, sh-send-line-or-region-and-step):
- New commands (bound to C-c C-z, C-c C-d, and C-c C-n).
-
-2013-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * align.el: Use lexical-binding.
- (align-region): Simplify accordingly.
-
-2013-08-20 Michael Albinus <michael.albinus@gmx.de>
-
- * minibuffer.el (completion--sifn-requote): Bind `non-essential'.
-
- * rfn-eshadow.el (rfn-eshadow-update-overlay): Move binding of
- `non-essential' up.
-
-2013-08-17 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp.el:
- * net/tramp-adb.el:
- * net/tramp-cmds.el:
- * net/tramp-ftp.el:
- * net/tramp-gvfs.el:
- * net/tramp-gw.el:
- * net/tramp-sh.el: Don't wrap external variable declarations by
- `eval-when-compile'.
-
-2013-08-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-rescale-image): Use ImageMagick even for GIFs
- now that Emacs supports ImageMagick animations.
-
-2013-08-16 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-cmds.el (top): Don't declare `buffer-name'.
- (tramp-append-tramp-buffers): Rewrite buffer local variables part.
-
-2013-08-16 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (mouse-autoselect-window-select): Do autoselect when
- mouse pointer is on margin.
-
-2013-08-16 William Parsons <wbparsons@alum.mit.edu> (tiny change)
-
- * net/ange-ftp.el (ange-ftp-skip-msgs): Add 500 EPSV. (Bug#1972)
-
-2013-08-16 Glenn Morris <rgm@gnu.org>
-
- * net/ange-ftp.el (ange-ftp-good-msgs, ange-ftp-get-pwd):
- Handle "Remote Directory" response of some clients. (Bug#15058)
-
- * emacs-lisp/bytecomp.el (byte-compile-make-variable-buffer-local):
- Tweak warning. (Bug#14926)
-
- * menu-bar.el (send-mail-item-name, read-mail-item-name): Remove.
- (menu-bar-tools-menu): Simplify news and mail items. (Bug#15095)
-
- * image-mode.el (image-mode-map): Add menu items to reverse,
- increase, decrease, reset animation speed.
- (image--set-speed, image-increase-speed, image-decrease-speed)
- (image-reverse-speed, image-reset-speed): New functions.
- (image-mode-map): Add bindings for speed commands.
-
- * image.el (image-animate-get-speed, image-animate-set-speed):
- New functions.
- (image-animate-timeout): Respect image :speed property.
-
-2013-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/debug.el (debugger-setup-buffer): Put point on the
- previous line (bug#15101).
- (debugger-eval-expression, debugger-record-expression):
- Use read--expression (bug#15102).
-
-2013-08-15 Michael Albinus <michael.albinus@gmx.de>
-
- Remove byte compiler warnings, visible when compiling with
- `byte-compile-force-lexical-warnings' set to t.
-
- * net/tramp.el (tramp-debug-message, tramp-message, tramp-error)
- (tramp-error-with-buffer): Rename ARGS to ARGUMENTS and BUFFER to BUF.
- (tramp-handle-unhandled-file-name-directory)
- (tramp-handle-file-notify-add-watch, tramp-action-login)
- (tramp-action-succeed, tramp-action-permission-denied)
- (tramp-action-terminal, tramp-action-process-alive): Prefix unused
- arguments with "_".
-
- * net/tramp-adb.el (tramp-adb-parse-device-names)
- (tramp-adb-handle-insert-directory, tramp-adb-handle-delete-file)
- (tramp-adb-handle-copy-file): Prefix unused arguments with "_".
- (tramp-adb-handle-file-truename): Remove unused arguments.
-
- * net/tramp-cache.el (tramp-flush-directory-property)
- (tramp-flush-connection-property, tramp-list-connections)
- (tramp-parse-connection-properties): Prefix unused arguments with "_".
-
- * net/tramp-compat.el (tramp-compat-make-temp-file):
- Rename FILENAME to F.
-
- * net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch)
- (tramp-gvfs-handle-write-region, tramp-bluez-parse-device-names)
- (tramp-zeroconf-parse-workstation-device-names)
- (tramp-zeroconf-parse-webdav-device-names)
- (tramp-synce-parse-device-names): Prefix unused arguments with "_".
-
- * net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
- (tramp-gw-aux-proc-sentinel): Prefix unused arguments with "_".
-
- * net/tramp-sh.el (tramp-sh-handle-file-truename): Remove unused
- arguments.
- (tramp-sh-handle-copy-file, tramp-sh-handle-dired-compress-file)
- (tramp-sh-handle-insert-file-contents-literally)
- (tramp-sh-handle-file-notify-add-watch): Prefix unused arguments
- with "_".
- (tramp-do-copy-or-rename-file, tramp-barf-if-no-shell-prompt):
- Remove unused variables.
-
- * net/tramp-smb.el (tramp-smb-handle-copy-directory)
- (tramp-smb-handle-copy-file, tramp-smb-handle-delete-file)
- (tramp-smb-read-file-entry): Prefix unused arguments with "_".
-
- * net/tramp-uu.el (tramp-uu-b64-alphabet, tramp-uu-b64-char-to-byte):
- Make them a defconst.
- (tramp-uuencode-region): Remove unused variable.
-
-2013-08-14 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset--prop-setter): New function.
- (frameset-prop): Add gv-setter declaration.
- (frameset-filter-minibuffer): Deal with the case that the minibuffer
- parameter was already set in FILTERED. Doc fix.
- (frameset--record-minibuffer-relationships): Allow saving a
- minibufferless frame without its corresponding minibuffer frame.
- (frameset--reuse-frame): Accept a match from an orphaned minibufferless
- frame, if the frame id matches.
- (frameset--minibufferless-last-p): Sort non-orphaned minibufferless
- frames before orphaned ones.
- (frameset-restore): Warn about orphaned windows, instead of error out.
-
-2013-08-14 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (window-make-atom): Don't overwrite parameter
- already present.
- (display-buffer-in-atom-window): Handle special case where we
- split an already atomic window.
- (window--major-non-side-window, display-buffer-in-side-window)
- (window--side-check): Ignore minibuffer window when walking
- window tree.
- (window-deletable-p): Return 'frame only if no other frame uses
- our minibuffer window.
- (record-window-buffer): Run buffer-list-update-hook.
- (split-window): Make sure window--check-frame won't destroy an
- existing atomic window in case the new window gets nested
- inside.
- (display-buffer-at-bottom): Ignore minibuffer window when
- walking window tree. Don't split a side window.
- (pop-to-buffer): Don't set-buffer here, the select-window call
- should do that.
- (mouse-autoselect-window-select): Autoselect only if we are in the
- text portion of the window.
-
-2013-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-parse-image-data): New function to grab both the
- data itself and the Content-Type.
- (shr-put-image): Use it.
-
- * net/eww.el (eww-display-image): Ditto.
-
- * image.el (image-content-type-suffixes): New variable.
-
-2013-08-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- * progmodes/python.el (python-imenu--build-tree)
- (python-imenu--put-parent): Simplify and Fix (GH bug 146).
-
-2013-08-13 Xue Fuqiao <xfq.free@gmail.com>
-
- * simple.el (backward-word): Mention the optional argument.
-
-2013-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * frameset.el (frameset--make): Rename constructor from make-frameset.
- (frameset-p, frameset-valid-p): Don't autoload.
- (frameset-valid-p): Use normal accessors.
-
-2013-08-13 Glenn Morris <rgm@gnu.org>
-
- * progmodes/compile.el (compile-command): Tweak example in doc.
- * obsolete/scribe.el (scribe-mode):
- * progmodes/mixal-mode.el (mixal-mode): Quote buffer name. (Bug#15053)
-
- * mail/feedmail.el (feedmail-confirm-outgoing)
- (feedmail-display-full-frame, feedmail-deduce-bcc-where): Fix types.
-
- * cus-start.el (truncate-partial-width-windows): Fix type.
-
- * emulation/viper-init.el (viper-search-scroll-threshold): Fix type.
-
- * net/shr.el (shr-table-horizontal-line): Fix custom type.
-
-2013-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/timer.el (timer--time-setter): New function.
- (timer--time): Use it as gv-setter.
-
- * emacs-lisp/gv.el (gv-define-simple-setter): Output warning when
- setter is not a symbol.
-
-2013-08-12 Grégoire Jadi <daimrod@gmail.com>
-
- * mail/sendmail.el (sendmail-send-it): Don't kill the error buffer
- if sending fails. This makes debugging easier.
-
-2013-08-12 Juanma Barranquero <lekktu@gmail.com>
-
- * xml.el (xml-parse-tag-1): Use looking-at (this reverts change in
- 2013-08-11T00:07:48Z!lekktu@gmail.com, which breaks the test suite).
- https://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00263.html
-
-2013-08-12 Eli Zaretskii <eliz@gnu.org>
-
- * term/w32-win.el (dynamic-library-alist): Add DLLs for zlib.
-
-2013-08-12 Glenn Morris <rgm@gnu.org>
-
- * format.el (format-annotate-function):
- Handle read-only text properties in the source. (Bug#14887)
-
-2013-08-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-display-html): Ignore coding system errors.
- One web site uses "utf-8lias" as the coding system.
-
-2013-08-11 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-valid-p): Fix check; STATES can indeed be nil.
-
-2013-08-10 Juanma Barranquero <lekktu@gmail.com>
-
- * tutorial.el (tutorial--describe-nonstandard-key): Use string-match-p.
- (tutorial--detailed-help): Remove unused local variables.
- (tutorial--save-tutorial-to): Use ignore-errors.
- (help-with-tutorial): Use looking-at-p.
-
- * view.el (view-buffer-other-window, view-buffer-other-frame):
- Mark unused arguments.
-
- * woman.el (woman-parse-colon-path, woman-parse-colon-path)
- (woman-select-symbol-fonts, woman, woman-find-file)
- (woman-insert-file-contents, woman-non-underline-faces):
- Use string-match-p.
- (woman1-unquote): Move declaration.
-
- * xml.el (xml-parse-tag-1, xml-parse-string): Use looking-at-p.
- (xml-parse-dtd): Use looking-at-p, string-match-p. Mark unused
- argument. Remove unused local variable.
- (xml-parse-elem-type): Use string-match-p.
- (xml-substitute-numeric-entities): Use ignore-errors.
-
- * calculator.el (calculator): Mark unused argument.
- (calculator-paste, calculator-quit, calculator-integer-p):
- Use ignore-errors.
- (calculator-string-to-number, calculator-decimal, calculator-exp)
- (calculator-op-or-exp): Use string-match-p.
-
- * dired.el (dired-buffer-more-recently-used-p): Declare.
- (dired-insert-set-properties, dired-insert-old-subdirs):
- Use ignore-errors.
-
- * dired-aux.el (dired-compress): Use ignore-errors.
- (dired-do-chxxx, dired-do-chmod, dired-trample-file-versions)
- (dired-do-async-shell-command, dired-do-shell-command)
- (dired-shell-stuff-it, dired-compress-file, dired-insert-subdir)
- (dired-insert-subdir-validate): Use string-match-p.
- (dired-map-dired-file-lines, dired-subdir-hidden-p): Use looking-at-p.
- (dired-add-entry): Use string-match-p, looking-at-p.
- (dired-insert-subdir-newpos): Remove unused local variable.
-
- * filenotify.el (file-notify-callback): Remove unused local variable.
-
- * filesets.el (filesets-error): Mark unused argument.
- (filesets-which-command-p, filesets-filter-dir-names)
- (filesets-directory-files, filesets-get-external-viewer)
- (filesets-ingroup-get-data): Use string-match-p.
-
- * find-file.el (ff-other-file-name, ff-other-file-name)
- (ff-find-the-other-file, ff-cc-hh-converter):
- Remove unused local variables.
- (ff-get-file-name): Use string-match-p.
- (ff-all-dirs-under): Use ignore-errors.
-
- * follow.el (follow-comint-scroll-to-bottom): Mark unused argument.
- (follow-select-if-visible): Remove unused local variable.
-
- * forms.el (read-file-filter): Move declaration.
- (forms--make-format, forms--make-parser, forms-insert-record):
- Quote function with #'.
- (forms--update): Use string-match-p. Quote function with #'.
-
- * help-mode.el (help-dir-local-var-def): Mark unused argument.
- (help-make-xrefs): Use looking-at-p.
- (help-xref-on-pp): Use looking-at-p, ignore-errors.
-
- * ibuffer.el (ibuffer-ext-visible-p): Declare.
- (ibuffer-confirm-operation-on): Use string-match-p.
-
- * msb.el (msb-item-handler, msb-dired-item-handler):
- Mark unused arguments.
-
- * ses.el (ses-decode-cell-symbol)
- (ses-kill-override): Remove unused local variable.
- (ses-create-cell-variable, ses-relocate-formula): Use string-match-p.
- (ses-load): Use ignore-errors, looking-at-p.
- (ses-jump-safe): Use ignore-errors.
- (ses-export-tsv, ses-export-tsf, ses-unsafe): Mark unused arguments.
-
- * tabify.el (untabify, tabify): Mark unused arguments.
-
- * thingatpt.el (thing-at-point--bounds-of-well-formed-url):
- Mark unused argument.
- (bounds-of-thing-at-point, thing-at-point-bounds-of-list-at-point)
- (thing-at-point-newsgroup-p, form-at-point): Use ignore-errors.
-
- * emacs-lisp/timer.el (timer--time): Define setter with
- gv-define-setter to avoid deprecation warning.
-
- * completion.el: Remove stuff unused since revno:3176 (1993-05-27).
- (*record-cmpl-statistics-p*): Remove (was commented out).
- (cmpl-statistics-block): Remove (body was commented out).
- All callers changed.
- (add-completions-from-buffer, load-completions-from-file):
- Remove unused variables.
-
-2013-08-09 Juanma Barranquero <lekktu@gmail.com>
-
- * filecache.el (file-cache-delete-file-list):
- Print message only when told so.
- (file-cache-files-matching): Use #' in mapconcat argument.
-
- * ffap.el (ffap-url-at-point): Fix reference to variable
- thing-at-point-default-mail-uri-scheme.
-
-2013-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (define-error): New function.
- * progmodes/ada-xref.el (ada-error-file-not-found): Rename from
- error-file-not-found and define with define-error.
- * emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
- and define with define-error.
- * userlock.el (file-locked, file-supersession):
- * simple.el (mark-inactive):
- * progmodes/js.el (js-moz-bad-rpc, js-js-error):
- * progmodes/ada-mode.el (ada-mode-errors):
- * play/life.el (life-extinct):
- * nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
- * nxml/xmltok.el (xmltok-markup-declaration-parse-error):
- * nxml/rng-util.el (rng-error):
- * nxml/rng-uri.el (rng-uri-error):
- * nxml/rng-match.el (rng-compile-error):
- * nxml/rng-cmpct.el (rng-c-incorrect-schema):
- * nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
- * nxml/nxml-rap.el (nxml-scan-error):
- * nxml/nxml-outln.el (nxml-outline-error):
- * net/soap-client.el (soap-error):
- * net/gnutls.el (gnutls-error):
- * net/ange-ftp.el (ftp-error):
- * mpc.el (mpc-proc-error):
- * json.el (json-error, json-readtable-error, json-unknown-keyword)
- (json-number-format, json-string-escape, json-string-format)
- (json-key-format, json-object-format):
- * jka-compr.el (compression-error):
- * international/quail.el (quail-error):
- * international/kkc.el (kkc-error):
- * emacs-lisp/ert.el (ert-test-failed):
- * calc/calc.el (calc-error, inexact-result, math-overflow)
- (math-underflow):
- * bookmark.el (bookmark-error-no-filename):
- * epg.el (epg-error): Define with define-error.
-
- * time.el (display-time-event-handler)
- (display-time-next-load-average): Don't call sit-for since it seems
- unnecessary (bug#15045).
-
- * emacs-lisp/checkdoc.el: Remove redundant :group keywords.
- Use #' instead of ' to quote functions.
- (checkdoc-output-mode): Use setq-local.
- (checkdoc-spellcheck-documentation-flag, checkdoc-ispell-lisp-words)
- (checkdoc-verb-check-experimental-flag, checkdoc-proper-noun-regexp)
- (checkdoc-common-verbs-regexp): Mark safe-local-variable (bug#15010).
- (checkdoc-ispell, checkdoc-ispell-current-buffer)
- (checkdoc-ispell-interactive, checkdoc-ispell-message-interactive)
- (checkdoc-ispell-message-text, checkdoc-ispell-start)
- (checkdoc-ispell-continue, checkdoc-ispell-comments)
- (checkdoc-ispell-defun): Remove unused arg `take-notes'.
-
- * ido.el (ido-completion-help): Fix up compiler warning.
-
-2013-08-09 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-p): Add autoload cookie.
- (frameset--jump-to-register): New function, based on code moved from
- register.el.
- (frameset-to-register): Move from register.el. Adapt to `registerv'.
-
- * register.el (frameset-frame-id, frameset-frame-with-id, frameset-p)
- (frameset-restore, frameset-save, frameset-session-filter-alist):
- Remove declarations.
- (register-alist): Doc fix.
- (frameset-to-register): Move to frameset.el.
- (jump-to-register, describe-register-1): Remove frameset-specific code.
-
-2013-08-08 Juanma Barranquero <lekktu@gmail.com>
-
- * allout-widgets.el (allout-widgets-pre-command-business)
- (allout-widgets-post-command-business)
- (allout-widgets-after-change-handler)
- (allout-decorate-item-and-context, allout-set-boundary-marker)
- (allout-body-modification-handler)
- (allout-graphics-modification-handler): Mark ignored arguments.
- (allout-widgets-post-command-business)
- (allout-widgets-exposure-change-processor)
- (allout-widgets-exposure-undo-processor)
- (allout-decorate-item-and-context, allout-redecorate-visible-subtree)
- (allout-parse-item-at-point, allout-decorate-item-guides)
- (allout-decorate-item-cue, allout-item-span): Remove unused variables.
- * allout.el (epa-passphrase-callback-function): Declare.
- (allout-overlay-insert-in-front-handler)
- (allout-overlay-interior-modification-handler)
- (allout-isearch-end-handler, allout-chart-siblings)
- (allout-up-current-level, allout-end-of-level, allout-reindent-body)
- (allout-yank-processing, allout-process-exposed)
- (allout-latex-verb-quote, allout-latexify-one-item, outlineify-sticky)
- (allout-latex-verbatim-quote-curr-line): Remove unused variables.
- * emacs-lisp/lisp-mode.el (lisp-eval-defun, last-sexp-toggle-display)
- (lisp-indent-defform): Mark ignored arguments.
- (lisp-indent-line): Mark ignored arguments. Remove unused variables.
- (calculate-lisp-indent): Remove unused variables.
- * international/characters.el (indian-2-column, arabic-2-column)
- (tibetan): Mark ignored arguments.
- (use-cjk-char-width-table): Mark ignored arguments.
- Remove unused variables.
- * international/fontset.el (build-default-fontset-data)
- (x-compose-font-name, create-fontset-from-fontset-spec):
- Mark ignored arguments.
- (fontset-plain-name): Remove unused variables.
- * international/mule.el (charset-id, charset-bytes, generic-char-p)
- (keyboard-coding-system): Mark ignored arguments.
- (find-auto-coding): Remove unused variables. Use `ignore-errors'.
- * help.el (resize-temp-buffer-window):
- * window.el (display-buffer-in-major-side-window)
- (display-buffer-in-side-window, display-buffer-in-previous-window):
- Remove unused variables.
- * isearch.el (isearch-forward-symbol):
- * version.el (emacs-bzr-version-bzr):
- * international/mule-cmds.el (current-language-environment):
- * term/common-win.el (x-handle-iconic, x-handle-geometry)
- (x-handle-display):
- * term/pc-win.el (x-list-fonts, x-display-planes)
- (x-display-color-cells, x-server-max-request-size, x-server-vendor)
- (x-server-version, x-display-screens, x-display-mm-height)
- (x-display-mm-width, x-display-backing-store, x-display-visual-class)
- (x-selection-owner-p, x-own-selection-internal)
- (x-disown-selection-internal, x-get-selection-internal)
- (msdos-initialize-window-system):
- * term/tty-colors.el (tty-color-alist, tty-color-clear):
- * term/x-win.el (x-handle-no-bitmap-icon):
- * vc/vc-hooks.el (vc-mode, vc-default-make-version-backups-p)
- (vc-default-find-file-hook, vc-default-extra-menu):
- Mark ignored arguments.
-
-2013-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/edebug.el (edebug-debugger): Use edebug-eval to run the
- break-condition in the context of the debugged code (bug#12685).
-
-2013-08-08 Christopher Schmidt <christopher@ch.ristopher.com>
-
- * comint.el:
- Do not use an overlay to highlight the last prompt. (Bug#14744)
- (comint-mode): Make comint-last-prompt buffer local.
- (comint-last-prompt): New variable.
- (comint-last-prompt-overlay): Remove. Superseded by
- comint-last-prompt.
- (comint-snapshot-last-prompt, comint-output-filter):
- Use comint-last-prompt.
-
-2013-08-08 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-valid-p): Check vector length. Doc fix.
- (frameset-save): Check validity of the resulting frameset.
-
-2013-08-08 Xue Fuqiao <xfq.free@gmail.com>
-
- * ido.el (ido-record-command): Add doc string.
-
-2013-08-08 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset): Do not disable creation of the default
- frameset-p predicate. Doc fix.
- (frameset-valid-p): New function, copied from the old predicate-p.
- Add additional checks.
- (frameset-restore): Check with frameset-valid-p.
- (frameset-p, frameset-version, frameset-timestamp, frameset-app)
- (frameset-name, frameset-description, frameset-properties)
- (frameset-states): Add docstring.
- (frameset-session-filter-alist, frameset-persistent-filter-alist)
- (frameset-filter-alist): Doc fixes.
-
-2013-08-08 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-p, frameset-prop): Doc fixes.
-
-2013-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/bytecomp.el (byte-compile-function-warn): New function,
- extracted from byte-compile-callargs-warn and byte-compile-normal-call.
- (byte-compile-callargs-warn, byte-compile-function-form): Use it.
- (byte-compile-normal-call): Remove obsolescence check.
-
-2013-08-08 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-restore): Doc fix.
-
- * register.el (frameset-frame-id, frameset-frame-with-id)
- (frameset-p, frameset-restore, frameset-save): Declare.
- (register-alist): Document framesets.
- (frameset-session-filter-alist): Declare.
- (frameset-to-register): New function.
- (jump-to-register): Implement jumping to framesets. Doc fix.
- (describe-register-1): Describe framesets.
-
- * bindings.el (ctl-x-r-map): Bind ?f to frameset-to-register.
-
-2013-08-07 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-save-frameset): Use new frameset-save args.
- Use lexical-binding.
-
- * frameset.el (frameset): Use type vector, not list (incompatible
- change). Do not declare a new constructor, use the default one.
- Upgrade suggested properties `app', `name' and `desc' to slots `app',
- `name' and `description', respectively, and add read-only slot
- `timestamp'. Doc fixes.
- (frameset-copy, frameset-persistent-filter-alist)
- (frameset-filter-alist, frameset-switch-to-gui-p)
- (frameset-switch-to-tty-p, frameset-filter-tty-to-GUI)
- (frameset-filter-sanitize-color, frameset-filter-minibuffer)
- (frameset-filter-iconified, frameset-keep-original-display-p):
- Doc fixes.
- (frameset-filter-shelve-param, frameset-filter-unshelve-param):
- Rename from frameset-filter-(save|restore)-param. All callers changed.
- Doc fix.
- (frameset-p): Adapt to change to vector and be more thorough.
- Change arg name to OBJECT. Doc fix.
- (frameset-prop): Rename arg PROP to PROPERTY. Doc fix.
- (frameset-session-filter-alist): Rename from frameset-live-filter-alist.
- All callers changed.
- (frameset-frame-with-id): Rename from frameset-locate-frame-id.
- All callers changed.
- (frameset--record-minibuffer-relationships): Rename from
- frameset--process-minibuffer-frames. All callers changed.
- (frameset-save): Add new keyword arguments APP, NAME and DESCRIPTION.
- Use new default constructor (again). Doc fix.
- (frameset--find-frame-if): Rename from `frameset--find-frame.
- All callers changed.
- (frameset--reuse-frame): Rename arg FRAME-CFG to PARAMETERS.
- (frameset--initial-params): Rename arg FRAME-CFG to PARAMETERS.
- Doc fix.
- (frameset--restore-frame): Rename args FRAME-CFG and WINDOW-CFG to
- PARAMETERS and WINDOW-STATE, respectively.
- (frameset-restore): Add new keyword argument PREDICATE.
- Reset frameset--target-display to nil. Doc fix.
-
-2013-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/bat-mode.el (bat--syntax-propertize): New var.
- (bat-mode): Use it.
- (bat-mode-syntax-table): Mark \n as end-of-comment.
- (bat-font-lock-keywords): Remove comment rule.
-
- * progmodes/bat-mode.el: Rename from dos.el. Use "bat-" prefix.
- (dos-mode-help): Remove. Use describe-mode (C-h m) instead.
-
- * emacs-lisp/bytecomp.el: Check existence of f in #'f.
- (byte-compile-callargs-warn): Use `push'.
- (byte-compile-arglist-warn): Ignore higher-order "calls".
- (byte-compile-file-form-autoload): Use `pcase'.
- (byte-compile-function-form): If quoting a symbol, check that it exists.
-
-2013-08-07 Eli Zaretskii <eliz@gnu.org>
-
- * progmodes/dos.el (dos-font-lock-keywords): Rename LINUX to UNIX
- and add a few popular commands found in batch files.
- (dos, dos-label-face, dos-cmd-help, dos-run, dos-run-args)
- (dos-mode): Doc fixes.
-
-2013-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/dos.el (auto-mode-alist): Add entries for dos-mode.
- (dos-mode): Use setq-local. Add space after "rem".
- (dos-mode-syntax-table): Don't use "w" for symbol chars.
- (dos-font-lock-keywords): Try to adjust font-lock rules accordingly.
-
-2013-08-07 Arni Magnusson <arnima@hafro.is>
-
- * progmodes/dos.el: New file.
- * generic-x.el (bat-generic-mode): Redefine as an obsolete alias to
- dos-mode.
-
-2013-08-06 Glenn Morris <rgm@gnu.org>
-
- * calendar/calendar.el: Add new faces, and day-header-array.
- (calendar-weekday-header, calendar-weekend-header)
- (calendar-month-header): New faces.
- (calendar-day-header-construct): New function.
- (calendar-day-header-width): Also :set calendar-day-header-array.
- (calendar-american-month-header, calendar-european-month-header)
- (calendar-iso-month-header): Use calendar- faces.
- (calendar-generate-month):
- Use calendar-day-header-array for day headers; apply faces to them.
- (calendar-mode): Check calendar-font-lock-keywords non-nil.
- (calendar-abbrev-construct): Add optional maxlen argument.
- (calendar-day-name-array): Doc fix.
- (calendar-day-name-array, calendar-abbrev-length)
- (calendar-day-abbrev-array):
- Also :set calendar-day-header-array, and maybe redraw.
- (calendar-day-header-array): New option. (Bug#15007)
- (calendar-font-lock-keywords): Set to nil and make obsolete.
- (calendar-day-name): Add option to use header array.
-
-2013-08-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-render-td): Remove debugging.
- (shr-render-td): Make width computation consistent by defaulting
- all zero-width columns to 10 characters. This may not be optimal,
- but it's at least consistent.
- (shr-make-table-1): Redo last change to fix the real problem in
- colspan handling.
-
-2013-08-06 Dmitry Antipov <dmantipov@yandex.ru>
-
- * files.el (cache-long-line-scans):
- Make obsolete alias to `cache-long-scans'.
-
-2013-08-06 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset, frameset-filter-alist)
- (frameset-filter-params, frameset-save, frameset--reuse-frame)
- (frameset--minibufferless-last-p, frameset-restore): Doc fixes.
- (frameset-compute-pos): Rename from frameset--compute-pos,
- and add docstring.
- (frameset-move-onscreen): Use frameset-compute-pos.
- Most changes suggested by Drew Adams <drew.adams@oracle.com>.
-
- * find-lisp.el (find-lisp-line-indent, find-lisp-find-dired-filter):
- Fix typos in docstrings.
-
-2013-08-06 Dmitry Antipov <dmantipov@yandex.ru>
-
- * frame.el (get-other-frame): Tiny cleanup.
-
-2013-08-06 Juanma Barranquero <lekktu@gmail.com>
-
- * vc/vc.el (vc-default-ignore-completion-table):
- Silence byte-compiler warning.
-
- * frameset.el (frameset-p): Don't check non-nullness of the `properties'
- slot , which can indeed be nil.
- (frameset-live-filter-alist, frameset-persistent-filter-alist):
- Move entry for `left' from persistent to live filter alist.
- (frameset-filter-alist, frameset--minibufferless-last-p, frameset-save):
- Doc fixes.
- (frameset-filter-params): When restoring a frame, copy items added to
- `filtered', to avoid unwittingly modifying the original parameters.
- (frameset-move-onscreen): Rename from frameset--move-onscreen. Doc fix.
- (frameset--restore-frame): Fix reference to frameset-move-onscreen.
-
- * dired.el (dired-insert-directory): Revert change in 2013-06-21T12:24:37Z!lekktu@gmail.com
- to use looking-at-p instead of looking-at. (Bug#15028)
-
-2013-08-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- Revert introduction of isearch-filter-predicates (bug#14714).
- Rely on add-function instead.
- * isearch.el (isearch-filter-predicates): Rename it back to
- isearch-filter-predicate.
- (isearch-message-prefix): Use advice-function-mapc and advice
- properties to get the isearch-message-prefix.
- (isearch-search, isearch-lazy-highlight-search): Revert to funcall
- instead of run-hook-with-args-until-failure.
- (isearch-filter-visible): Not obsolete any more.
- * loadup.el: Preload nadvice.
- * replace.el (perform-replace): Revert to funcall
- instead of run-hook-with-args-until-failure.
- * wdired.el (wdired-change-to-wdired-mode): Use add-function.
- * dired-aux.el (dired-isearch-filenames-mode): Rename from
- dired-isearch-filenames-toggle; make it into a proper minor mode.
- Use add/remove-function.
- (dired-isearch-filenames-setup, dired-isearch-filenames-end):
- Call the minor-mode rather than add/remove-hook.
- (dired-isearch-filter-filenames):
- Remove isearch-message-prefix property.
- * info.el (Info--search-loop): New function, extracted from Info-search.
- Funcall isearch-filter-predicate instead of
- run-hook-with-args-until-failure isearch-filter-predicates.
- (Info-search): Use it.
- (Info-mode): Use isearch-filter-predicate instead of
- isearch-filter-predicates.
-
-2013-08-05 Dmitry Antipov <dmantipov@yandex.ru>
-
- Do not call to `selected-window' where it is assumed by default.
- Affected functions are `window-minibuffer-p', `window-dedicated-p',
- `window-hscroll', `window-width', `window-height', `window-buffer',
- `window-frame', `window-start', `window-point', `next-window'
- and `window-display-table'.
- * abbrev.el (abbrev--default-expand):
- * bs.el (bs--show-with-configuration):
- * buff-menu.el (Buffer-menu-mouse-select):
- * calc/calc.el (calc):
- * calendar/calendar.el (calendar-generate-window):
- * calendar/diary-lib.el (diary-simple-display, diary-show-all-entries)
- (diary-make-entry):
- * comint.el (send-invisible, comint-dynamic-complete-filename)
- (comint-dynamic-simple-complete, comint-dynamic-list-completions):
- * completion.el (complete):
- * dabbrev.el (dabbrev-expand, dabbrev--make-friend-buffer-list):
- * disp-table.el (describe-current-display-table):
- * doc-view.el (doc-view-insert-image):
- * ebuff-menu.el (Electric-buffer-menu-mouse-select):
- * ehelp.el (with-electric-help):
- * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
- * emacs-lisp/edebug.el (edebug-two-window-p, edebug-pop-to-buffer):
- * emacs-lisp/helper.el (Helper-help-scroller):
- * emulation/cua-base.el (cua--post-command-handler-1):
- * eshell/esh-mode.el (eshell-output-filter):
- * ffap.el (ffap-gnus-wrapper):
- * help-macro.el (make-help-screen):
- * hilit-chg.el (highlight-compare-buffers):
- * hippie-exp.el (hippie-expand, try-expand-dabbrev-visible):
- * hl-line.el (global-hl-line-highlight):
- * icomplete.el (icomplete-simple-completing-p):
- * isearch.el (isearch-done):
- * jit-lock.el (jit-lock-stealth-fontify):
- * mail/rmailsum.el (rmail-summary-scroll-msg-up):
- * lisp/mouse-drag.el (mouse-drag-should-do-col-scrolling):
- * mpc.el (mpc-tagbrowser, mpc):
- * net/rcirc.el (rcirc-any-buffer):
- * play/gomoku.el (gomoku-max-width, gomoku-max-height):
- * play/landmark.el (landmark-max-width, landmark-max-height):
- * play/zone.el (zone):
- * progmodes/compile.el (compilation-goto-locus):
- * progmodes/ebrowse.el (ebrowse-view/find-file-and-search-pattern):
- * progmodes/etags.el (find-tag-other-window):
- * progmodes/fortran.el (fortran-column-ruler):
- * progmodes/gdb-mi.el (gdb-mouse-toggle-breakpoint-fringe):
- * progmodes/verilog-mode.el (verilog-point-text):
- * reposition.el (reposition-window):
- * rot13.el (toggle-rot13-mode):
- * server.el (server-switch-buffer):
- * shell.el (shell-dynamic-complete-command)
- (shell-dynamic-complete-environment-variable):
- * simple.el (insert-buffer, set-selective-display)
- (delete-completion-window):
- * speedbar.el (speedbar-timer-fn, speedbar-center-buffer-smartly)
- (speedbar-recenter):
- * startup.el (fancy-splash-head):
- * textmodes/ispell.el (ispell-command-loop):
- * textmodes/makeinfo.el (makeinfo-compilation-sentinel-region):
- * tutorial.el (help-with-tutorial):
- * vc/add-log.el (add-change-log-entry):
- * vc/compare-w.el (compare-windows):
- * vc/ediff-help.el (ediff-indent-help-message):
- * vc/ediff-util.el (ediff-setup-control-buffer, ediff-position-region):
- * vc/ediff-wind.el (ediff-skip-unsuitable-frames)
- (ediff-setup-control-frame):
- * vc/emerge.el (emerge-position-region):
- * vc/pcvs-util.el (cvs-bury-buffer):
- * window.el (walk-windows, mouse-autoselect-window-select):
- * winner.el (winner-set-conf, winner-undo): Related users changed.
-
-2013-08-05 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset--set-id): Doc fix.
- (frameset-frame-id, frameset-frame-id-equal-p)
- (frameset-locate-frame-id): New functions.
- (frameset--process-minibuffer-frames, frameset--reuse-frame)
- (frameset-restore): Use them.
-
-2013-08-05 Dmitry Antipov <dmantipov@yandex.ru>
-
- Do not call to `selected-frame' where it is assumed by default.
- Affected functions are `raise-frame', `redraw-frame',
- `frame-first-window', `frame-terminal' and `delete-frame'.
- * calendar/appt.el (appt-disp-window):
- * epg.el (epg-wait-for-completion):
- * follow.el (follow-delete-other-windows-and-split)
- (follow-avoid-tail-recenter):
- * international/mule.el (set-terminal-coding-system):
- * mail/rmail.el (rmail-mail-return):
- * net/newst-plainview.el (newsticker--buffer-set-uptodate):
- * progmodes/f90.el (f90-add-imenu-menu):
- * progmodes/idlw-toolbar.el (idlwave-toolbar-toggle):
- * server.el (server-switch-buffer):
- * simple.el (delete-completion-window):
- * talk.el (talk):
- * term/xterm.el (terminal-init-xterm-modify-other-keys)
- (xterm-turn-on-modify-other-keys, xterm-remove-modify-other-keys):
- * vc/ediff-util.el (ediff-status-info, ediff-show-diff-output):
- * vc/ediff.el (ediff-documentation): Related users changed.
- * frame.el (selected-terminal): Remove the leftover.
-
-2013-08-05 Glenn Morris <rgm@gnu.org>
-
- * calendar/calendar.el (calendar-generate-month):
- Fix for calendar-column-width != 1 + calendar-day-digit-width.
- (calendar-generate-month, calendar-font-lock-keywords):
- Fix for calendar-day-header-width > length of any day name.
-
-2013-08-05 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-clear): Use new name of sort predicate.
-
- * frameset.el (frameset): Add docstring. Move :version property to its
- own `version' slot.
- (frameset-copy): Rename from copy-frameset.
- (frameset-p): Check more thoroughly.
- (frameset-prop): Do not check for :version, which is no longer a prop.
- (frameset-live-filter-alist, frameset-persistent-filter-alist):
- Use new :never value instead of t.
- (frameset-filter-alist): Expand and clarify docstring.
- (frameset-filter-tty-to-GUI, frameset-filter-sanitize-color)
- (frameset-filter-minibuffer, frameset-filter-save-param)
- (frameset-filter-restore-param, frameset-filter-iconified):
- Add pointer to docstring of frameset-filter-alist.
- (frameset-filter-params): Rename filter values to be more meaningful:
- :never instead of t, and reverse the meanings of :save and :restore.
- (frameset--process-minibuffer-frames): Clarify error message.
- (frameset-save): Avoid unnecessary and confusing call to framep.
- Use new BOA constructor for framesets.
- (frameset--reuse-list): Doc fix.
- (frameset--restore-frame): Rename from frameset--get-frame. Doc fix.
- (frameset--minibufferless-last-p): Rename from frameset--sort-states.
- (frameset-minibufferless-first-p): Doc fix.
- Rename from frameset-sort-frames-for-deletion.
- (frameset-restore): Doc fixes. Use new function names.
- Most changes suggested by Drew Adams <drew.adams@oracle.com>.
-
-2013-08-04 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-restore-forces-onscreen)
- (desktop-restore-reuses-frames): Document :keyword constant values.
- (desktop-filter-parameters-alist): Remove, now identical to
- frameset-filter-alist.
- (desktop--filter-tty*): Remove, moved to frameset.el.
- (desktop-save-frameset, desktop-restore-frameset):
- Do not pass :filters argument.
-
- * frameset.el (frameset-live-filter-alist)
- (frameset-persistent-filter-alist): New variables.
- (frameset-filter-alist): Use them. Add autoload cookie.
- (frameset-filter-tty-to-GUI): Move from desktop.el and rename.
- (frameset--set-id, frameset--reuse-frame): Rename `frame-id' to
- `frameset--id' (it's supposed to be internal to frameset.el).
- (frameset--process-minibuffer-frames): Ditto. Doc fix.
- (frameset--initial-params): New function.
- (frameset--get-frame): Use it. Doc fix.
- (frameset--move-onscreen): Accept new PRED value for FORCE-ONSCREEN.
- Accept :all, not 'all.
- (frameset-restore): Add new predicate values for FORCE-ONSCREEN and
- FORCE-DISPLAY. Use :keywords for constant arguments to avoid collision
- with fbound symbols. Fix frame id matching, and remove matching ids if
- the frame being restored is deleted. Obey :delete.
-
-2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (macrop): New function.
- (text-clone--maintaining): New var.
- (text-clone--maintain): Rename from text-clone-maintain. Use it
- instead of inhibit-modification-hooks.
-
- * emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
- a proxy, so as handle autoloads and redefinitions of the target.
- (advice--defalias-fset, advice-remove): Use advice--symbol-function.
-
- * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
- Remove bogus (arrayp . stringp) pair. Add entries for `vectorp'.
- (pcase--mutually-exclusive-p): New function.
- (pcase--split-consp): Use it.
- (pcase--split-pred): Use it. Optimize the case where `pat' is a qpat
- mutually exclusive with the current predicate.
-
- * emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
- (edebug-macrop): Remove. Use `macrop' instead.
- * emacs-lisp/advice.el (ad-subr-p): Remove. Use `subrp' instead.
- (ad-macro-p):
- * eshell/esh-cmd.el (eshell-macrop):
- * apropos.el (apropos-macrop): Remove. Use `macrop' instead.
-
-2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.
- (advice-mapc): New function, using it.
- (advice-function-member-p): New function.
- (advice--normalize): Store the cdr in advice--saved-rewrite since
- that's the part that will be changed.
- (advice--symbol-function): New function.
- (advice-remove): Handle removal before the function is defined.
- Adjust to new advice--saved-rewrite.
- (advice-member-p): Use advice-function-member-p and
- advice--symbol-function.
-
-2013-08-04 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-p, frameset-save): Fix autoload cookies.
- (frameset-filter-minibuffer): Doc fix.
- (frameset-restore): Fix autoload cookie. Fix typo in docstring.
- (frameset--set-id, frameset--process-minibuffer-frames)
- (frameset-restore): Rename parameter `frameset-id' to `frame-id'.
- (frameset--reuse-frame): Pass correct frame-id to frameset--find-frame.
-
- * desktop.el (desktop-clear): Only delete frames when called
- interactively and desktop-restore-frames is non-nil. Doc fix.
- (desktop-read): Set desktop-saved-frameset to nil.
-
-2013-08-04 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc.el (vc-ignore): Rewrite.
- (vc-default-ignore-completion-table):
- (vc--read-lines):
- (vc--add-line, vc--remove-regexp): New functions.
-
- * vc/vc-svn.el (vc-svn-ignore): Doc fix.
- (vc-svn-ignore-completion-table): New function.
-
- * vc/vc-hg.el (vc-hg-ignore): Rewrite.
- (vc-hg-ignore-completion-table):
- (vc-hg-find-ignore-file): New functions.
-
- * vc/vc-git.el (vc-git-ignore): Rewrite.
- (vc-git-ignore-completion-table):
- (vc-git-find-ignore-file): New functions.
-
- * vc/vc-dir.el (vc-dir-menu-map): Add menu for vc-dir-ignore.
-
- * vc/vc-bzr.el (vc-bzr-ignore): Rewrite.
- (vc-bzr-ignore-completion-table):
- (vc-bzr-find-ignore-file): New functions.
-
-2013-08-03 Juanma Barranquero <lekktu@gmail.com>
-
- * frameset.el (frameset-prop): New function and setter.
- (frameset-save): Do not modify frame list passed by the caller.
-
-2013-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-desc-from-define): Ignore unknown keys.
-
-2013-08-02 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/easy-mmode.el (define-globalized-minor-mode)
- (easy-mmode-define-navigation): Avoid ((lambda (..) ..) ...).
-
- * custom.el (custom-initialize-default, custom-initialize-set)
- (custom-initialize-reset, custom-initialize-changed): Affect the
- toplevel-default-value (bug#6275, bug#14586).
- * emacs-lisp/advice.el (ad-compile-function): Undo previous workaround
- for bug#6275.
-
-2013-08-02 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
- Add cl-def* expressions.
-
- * frameset.el (frameset-filter-params): Fix order of arguments.
-
-2013-08-02 Juanma Barranquero <lekktu@gmail.com>
-
- Move code related to saving frames to frameset.el.
- * desktop.el: Require frameset.
- (desktop-restore-frames): Doc fix.
- (desktop-restore-reuses-frames): Rename from
- desktop-restoring-reuses-frames.
- (desktop-saved-frameset): Rename from desktop-saved-frame-states.
- (desktop-clear): Clear frames too.
- (desktop-filter-parameters-alist): Set from frameset-filter-alist.
- (desktop--filter-tty*, desktop-save, desktop-read):
- Use frameset functions.
- (desktop-before-saving-frames-functions, desktop--filter-*-color)
- (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
- (desktop--filter-save-desktop-parm, desktop--filter-iconified-position)
- (desktop-restore-in-original-display-p, desktop--filter-frame-parms)
- (desktop--process-minibuffer-frames, desktop-save-frames)
- (desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen)
- (desktop--find-frame, desktop--select-frame, desktop--make-frame)
- (desktop--sort-states, desktop-restoring-frames-p)
- (desktop-restore-frames): Remove. Most code moved to frameset.el.
- (desktop-restoring-frameset-p, desktop-restore-frameset)
- (desktop--check-dont-save, desktop-save-frameset): New functions.
- (desktop--app-id): New constant.
- (desktop-first-buffer, desktop-buffer-ok-count)
- (desktop-buffer-fail-count): Move before first use.
- * frameset.el: New file.
-
-2013-08-01 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * files.el: Use lexical-binding.
- (dir-locals-read-from-file): Remove unused `err' variable.
- (hack-dir-local-variables--warned-coding): New var.
- (hack-dir-local-variables): Use it to avoid repeated warnings.
- (make-backup-file-name--default-function): New function.
- (make-backup-file-name-function): Use it as default.
- (buffer-stale--default-function): New function.
- (buffer-stale-function): Use it as default.
- (revert-buffer-insert-file-contents--default-function): New function.
- (revert-buffer-insert-file-contents-function): Use it as default.
- (insert-directory): Avoid add-to-list.
-
- * autorevert.el (auto-revert-handler): Simplify.
- Use buffer-stale--default-function.
-
-2013-08-01 Tassilo Horn <tsdh@gnu.org>
-
- * speedbar.el (speedbar-query-confirmation-method): Doc fix.
-
- * whitespace.el (whitespace-ensure-local-variables): New function.
- (whitespace-cleanup-region): Call it.
- (whitespace-turn-on): Call it.
-
-2013-08-01 Michael Albinus <michael.albinus@gmx.de>
-
- Complete file name handlers.
-
- * net/tramp.el (tramp-handle-set-visited-file-modtime)
- (tramp-handle-verify-visited-file-modtime)
- (tramp-handle-file-notify-rm-watch): New functions.
- (tramp-call-process): Do not bind `default-directory'.
-
- * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
- Order alphabetically.
- [access-file, add-name-to-file, dired-call-process]:
- [dired-compress-file, file-acl, file-notify-rm-watch]:
- [file-ownership-preserved-p, file-selinux-context]:
- [make-directory-internal, make-symbolic-link, set-file-acl]:
- [set-file-selinux-context, set-visited-file-modtime]:
- [verify-visited-file-modtime]: Add handler.
- (tramp-adb-handle-write-region): Apply `set-visited-file-modtime'.
-
- * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
- [file-notify-add-watch, file-notify-rm-watch]:
- [set-file-times, set-visited-file-modtime]:
- [verify-visited-file-modtime]: Add handler.
- (with-tramp-gvfs-error-message)
- (tramp-gvfs-handle-set-visited-file-modtime)
- (tramp-gvfs-fuse-file-name): Remove.
- (tramp-gvfs-handle-file-notify-add-watch)
- (tramp-gvfs-file-gvfs-monitor-file-process-filter): New defuns.
- (tramp-gvfs-handle-write-region): Fix error in moving tmpfile.
-
- * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
- Order alphabetically.
- [file-notify-rm-watch ]: Use default Tramp handler.
- [executable-find]: Remove private handler.
- (tramp-do-copy-or-rename-file-out-of-band): Do not bind
- `default-directory'.
- (tramp-sh-handle-executable-find)
- (tramp-sh-handle-file-notify-rm-watch): Remove functions.
- (tramp-sh-file-gvfs-monitor-dir-process-filter)
- (tramp-sh-file-inotifywait-process-filter, tramp-set-remote-path):
- Do not use `format' in `tramp-message'.
-
- * net/tramp-smb.el (tramp-smb-file-name-handler-alist)
- [file-notify-rm-watch, set-visited-file-modtime]:
- [verify-visited-file-modtime]: Add handler.
- (tramp-smb-call-winexe): Do not bind `default-directory'.
-
-2013-08-01 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc-hooks.el (vc-menu-map): Fix menu entry for vc-ignore.
-
-2013-07-31 Dmitry Gutov <dgutov@yandex.ru>
-
- * vc/log-view.el (log-view-diff): Extract `log-view-diff-common',
- use it.
- (log-view-diff-changeset): Same.
- (log-view-diff-common): Call backend command `previous-revision'
- to find out the previous revision, in both cases. Swap the
- variables `to' and `fr', so that `fr' usually refers to the
- earlier revision (Bug#14989).
-
-2013-07-31 Kan-Ru Chen <kanru@kanru.info>
-
- * ibuf-ext.el (ibuffer-filter-by-filename):
- Make it work with dired buffers too.
-
-2013-07-31 Dmitry Antipov <dmantipov@yandex.ru>
-
- * emacs-lisp/re-builder.el (reb-color-display-p):
- * files.el (save-buffers-kill-terminal):
- * net/browse-url.el (browse-url):
- * server.el (server-save-buffers-kill-terminal):
- * textmodes/reftex-toc.el (reftex-toc, reftex-toc-revert):
- Prefer nil to selected-frame for the first arg of frame-parameter.
-
-2013-07-31 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc-hooks.el (vc-menu-map): Add menu entry for vc-ignore.
-
-2013-07-30 Stephen Berman <stephen.berman@gmx.net>
-
- * minibuffer.el (completion--twq-all): Try and preserve each
- completion's case choice (bug#14907).
-
-2013-07-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/network-stream.el (open-network-stream): Mention the new
- :nogreeting parameter.
- (network-stream-open-starttls): Use the :nogreeting parameter
- (bug#14938).
-
- * net/shr.el (shr-mouse-browse-url): Remove and use `shr-browse-url'.
-
- * net/eww.el (eww-setup-buffer): Switching to the buffer seems
- more natural than popping.
-
- * net/shr.el (shr-urlify): Put `follow-link' on URLs (bug#14815).
- (shr-urlify): Highlight under mouse.
-
-2013-07-30 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc-hooks.el (vc-prefix-map): Add key binding for vc-ignore.
-
- * vc/vc-dir.el (vc-dir-mode-map): Change key binding for vc-dir-ignore.
-
- * vc/vc-svn.el (vc-svn-ignore): Remove `interactive'. Use `*vc*'
- buffer for output.
-
- * vc/vc-hg.el (vc-hg-ignore): Remove `interactive'. Do not assume
- point-min==1. Fix search string. Fix parentheses missing.
-
- * vc/vc-git.el (vc-git-ignore): Remove `interactive'. Do not
- assume point-min==1. Fix search string. Fix parentheses missing.
-
- * vc/vc-cvs.el (vc-cvs-ignore): Remove `interactive'.
-
- * vc/vc-bzr.el (vc-bzr-ignore): Remove `interactive'. Use `*vc*'
- buffer for output.
-
-2013-07-29 Eli Zaretskii <eliz@gnu.org>
-
- * frame.el (frame-notice-user-settings): Avoid inflooping when the
- initial frame is minibuffer-less. (Bug#14841)
-
-2013-07-29 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp.el (tramp-use-ssh-controlmaster-options): New customer
- option.
-
- * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
- (tramp-maybe-open-connection): Use it.
-
-2013-07-28 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop--make-frame): Include `minibuffer' in the
- minimal set of parameters passed when creating a frame, because
- the minibuffer status of a frame cannot be changed later.
-
-2013-07-28 Stephen Berman <stephen.berman@gmx.net>
-
- * calendar/todo-mode.el (todo-rename-file): Fix incorrect use of
- replace-regexp-in-string and inadvertent omissions in previous change.
- (todo-filter-items): Ensure only file names are comma-separated in
- name of filtered items buffer.
-
-2013-07-28 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el: Optionally force offscreen frames back onscreen.
- (desktop-restoring-reuses-frames): New option.
- (desktop--compute-pos, desktop--move-onscreen): New functions.
- (desktop--make-frame): Use desktop--move-onscreen.
-
-2013-07-27 Alan Mackenzie <acm@muc.de>
-
- Fontify a Java generic method as a function.
- * progmodes/cc-langs.el (c-recognize-<>-arglists): Set the Java
- value to t.
-
-2013-07-27 Stephen Berman <stephen.berman@gmx.net>
-
- * calendar/todo-mode.el: Add command to rename todo files.
- (todo-rename-file): New command.
- (todo-key-bindings-t): Add key binding for it. Change the
- bindings of todo-filter-regexp-items(-multifile) to use `x'
- instead of `r', since the latter is better suited to the new
- renaming command.
-
-2013-07-27 Alan Mackenzie <acm@muc.de>
-
- Make Java try-with-resources statement parse properly.
- * progmodes/cc-langs.el (c-block-stmt-1-2-kwds)
- (c-block-stmt-1-2-key): New language constants/variables.
- * progmodes/cc-engine.el (c-beginning-of-statement-1)
- (c-after-conditional): Adapt to deal with c-block-stmt-1-2-key.
- * progmodes/cc-fonts.el (c-font-lock-declarations): Adapt to deal
- with c-block-stmt-1-2-key.
-
-2013-07-27 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop--make-frame): Apply most frame parameters after
- creating the frame to force (partially or totally) offscreen frames to
- be restored as such.
-
-2013-07-26 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc-dir.el (vc-dir-mode-map): Add binding for vc-root-diff.
- (Bug#14948)
-
-2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el (advice--called-interactively-skip): Use the new
- `base' arg of backtrace-frame.
-
-2013-07-26 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (list-processes): Doc fix.
-
-2013-07-26 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop--select-frame):
- Try harder to reuse existing frames.
-
-2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/edebug.el: Use backtrace-eval to handle lexical variables.
- (edebug-eval): Use backtrace-eval.
- (edebug--display, edebug--recursive-edit): Don't let-bind the
- edebug-outer-* vars that keep track of variables we locally let-bind.
- (edebug-outside-excursion): Don't restore outside values of locally
- let-bound vars.
- (edebug--display): Use user-error.
- (cl-lexical-debug, cl-debug-env): Remove.
-
-2013-07-26 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-restore-frames): Call `sit-for' once all frames
- are restored to be sure that they are visible before deleting any
- remaining ones.
-
-2013-07-26 Matthias Meulien <orontee@gmail.com>
-
- * vc/vc-dir.el (vc-dir-mode-map): Add binding for
- vc-print-root-log. (Bug#14948)
-
-2013-07-26 Richard Stallman <rms@gnu.org>
-
- Add aliases for encrypting mail.
- * epa.el (epa-mail-aliases): New option.
- * epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs.
- Bind inhibit-read-only so read-only text doesn't ruin everything.
- (epa-mail-default-recipients): New subroutine broken out.
- Handle epa-mail-aliases.
-
-2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- Add support for lexical variables to the debugger's `e' command.
- * emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-*
- vars, except for debugger-outer-match-data.
- (debugger-frame-number): Move check for "on a function call" from
- callers into it. Add `skip-base' argument.
- (debugger-frame, debugger-frame-clear): Simplify accordingly.
- (debugger-env-macro): Only reset the state stored in non-variables,
- i.e. current-buffer and match-data.
- (debugger-eval-expression): Rewrite using backtrace-eval.
- * subr.el (internal--called-interactively-p--get-frame): Remove.
- (called-interactively-p):
- * emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new
- `base' arg of backtrace-frame instead.
-
-2013-07-26 Glenn Morris <rgm@gnu.org>
-
- * align.el (align-regexp): Doc fix. (Bug#14857)
- (align-region): Explicit error if subexpression missing/does not match.
-
- * simple.el (global-visual-line-mode):
- Do not duplicate the mode lighter. (Bug#14858)
-
-2013-07-25 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (display-buffer): In display-buffer bind
- split-window-keep-point to t, bug#14829.
-
-2013-07-25 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el: Rename internal "desktop-X" frame params to "desktop--X".
- (desktop-filter-parameters-alist, desktop--filter-restore-desktop-parm)
- (desktop--filter-save-desktop-parm, desktop--process-minibuffer-frames)
- (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
- Change accordingly.
- (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
- Use pcase-let, pcase-let* to deobfuscate access to desktop--mini values.
-
-2013-07-25 Glenn Morris <rgm@gnu.org>
-
- * dired-x.el (dired-mark-extension): Convert comment to doc string.
-
-2013-07-25 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop--make-frame): Do not pass the `fullscreen'
- parameter to modify-frame-parameters if the value has not changed;
- this is a workaround for bug#14949.
- (desktop--make-frame): On cl-delete-if call, check parameter name,
- not full parameter.
-
-2013-07-30 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc.el (vc-ignore): New function.
-
- * vc/vc-svn.el (vc-svn-ignore): New function.
-
- * vc/vc-hg.el (vc-hg-ignore): New function.
-
- * vc/vc-git.el (vc-git-ignore): New function.
-
- * vc/vc-dir.el (vc-dir-mode-map): Add key binding for vc-dir-ignore
- (vc-dir-ignore): New function.
-
- * vc/vc-cvs.el (vc-cvs-ignore): New function.
- (cvs-append-to-ignore): Move here from pcvs.el.
-
- * vc/vc-bzr.el (vc-bzr-ignore): New function.
-
- * vc/pcvs.el (vc-cvs): Require 'vc-cvs.
-
-2013-07-24 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-restoring-frames-p): Return a true boolean.
- (desktop-restore-frames): Warn when deleting an existing frame failed.
-
-2013-07-24 Glenn Morris <rgm@gnu.org>
-
- * ffap.el (ffap-machine-p): Handle "not known" response. (Bug#14929)
-
-2013-07-24 Michael Albinus <michael.albinus@gmx.de>
-
- * filenotify.el (file-notify-supported-p):
- * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
- Remove functions.
-
- * autorevert.el (auto-revert-use-notify):
- (auto-revert-notify-add-watch):
- * net/tramp.el (tramp-file-name-for-operation):
- * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
- * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
- * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
- * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
- Remove `file-notify-supported-p' entry.
-
-2013-07-24 Glenn Morris <rgm@gnu.org>
-
- * printing.el: Replace all uses of deleted ps-windows-system,
- ps-lp-system, ps-flatten-list with lpr- versions.
-
-2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/pcase.el (pcase--u1): Verify if self-quoting values can be
- checked with memq (bug#14935).
-
- * files.el (revert-buffer-function): Use a non-nil default.
- (revert-buffer-preserve-modes): Declare var to
- provide access to the `preserve-modes' argument.
- (revert-buffer): Let-bind it.
- (revert-buffer--default): New function, extracted from revert-buffer.
-
-2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * lpr.el: Signal print errors more prominently.
- (print-region-function): Don't default to nil.
- (lpr-print-region): New function, extracted from print-region-1.
- Check lpr's return value and signal an error in case of problem.
- (print-region-1): Use it.
- * ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-*
- versions instead.
- (ps-printer-name): Default to nil.
- (ps-printer-name-option): Default to lpr-printer-switch.
- (ps-print-region-function): Don't default to nil.
- (ps-postscript-code-directory): Simplify default.
- (ps-do-despool): Use lpr-print-region to properly check the outcome.
- (ps-string-list, ps-eval-switch, ps-flatten-list)
- (ps-flatten-list-1): Remove.
- (ps-multibyte-buffer): Avoid setq.
- * dos-w32.el (direct-print-region-helper): Use proper regexp operators.
- (print-region-function, ps-print-region-function): Don't set them here.
-
-2013-07-24 Xue Fuqiao <xfq.free@gmail.com>
-
- * ido.el (ido-fractionp):
- (ido-cache-ftp-work-directory-time, ido-max-prospects, ido-mode)
- (ido-max-file-prompt-width, ido-unc-hosts-cache)
- (ido-max-directory-size, ido-max-dir-file-cache)
- (ido-decorations): Doc fix.
-
- * ansi-color.el: Fix old URL.
-
-2013-07-23 Michael R. Mauger <michael@mauger.com>
-
- * progmodes/sql.el Version 3.3
- (sql-product-alist): Improve oracle :prompt-cont-regexp.
- (sql-starts-with-prompt-re, sql-ends-with-prompt-re): New functions.
- (sql-interactive-remove-continuation-prompt): Rewrite, use
- functions above. Fix continuation prompt and complete output line
- handling.
- (sql-redirect-one, sql-execute): Use `read-only-mode' on
- redirected output buffer.
- (sql-mode): Restore deleted code (Bug#13591).
-
-2013-07-23 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-clear, desktop-list*): Fix previous change.
-
-2013-07-23 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp.el (tramp-handle-file-notify-add-watch): New defun.
-
- * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
- * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
- * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use it.
-
-2013-07-23 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-clear): Simplify; remove useless checks
- against invalid buffer names.
- (desktop-list*): Use cl-list*.
- (desktop-buffer-info, desktop-create-buffer): Simplify.
-
-2013-07-23 Leo Liu <sdl.web@gmail.com>
-
- * bookmark.el (bookmark-make-record): Restore NAME as a default
- value. (Bug#14933)
-
-2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/autoload.el (autoload--setup-output): New function,
- extracted from autoload--insert-text.
- (autoload--insert-text): Remove.
- (autoload--print-cookie-text): New function, extracted from
- autoload--insert-cookie-text.
- (autoload--insert-cookie-text): Remove.
- (autoload-generate-file-autoloads): Adjust calls accordingly.
-
- * winner.el (winner-hook-installed-p): Remove.
- (winner-mode): Simplify accordingly.
-
- * subr.el (add-to-list): Fix compiler-macro when `append' is
- not constant. Don't use `cl-member' for the base case.
-
- * progmodes/subword.el: Fix boundary case (bug#13758).
- (subword-forward-regexp): Make it a constant. Wrap optional \\W in its
- own group.
- (subword-backward-regexp): Make it a constant.
- (subword-forward-internal): Don't treat a trailing capital as the
- beginning of a word.
-
-2013-07-22 Ari Roponen <ari.roponen@gmail.com> (tiny change)
-
- * emacs-lisp/package.el (package-menu-mode): Don't modify the
- global value of tabulated-list-revert-hook (bug#14930).
-
-2013-07-22 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el: Require 'cl-lib.
- (desktop-before-saving-frames-functions): New hook.
- (desktop--process-minibuffer-frames): Set desktop-mini parameter only
- for frames being saved. Rename from desktop--save-minibuffer-frames.
- (desktop-save-frames): Run hook desktop-before-saving-frames-functions.
- Do not save frames with non-nil `desktop-dont-save' parameter.
- Filter out deleted frames.
- (desktop--find-frame): Use cl-find-if.
- (desktop--select-frame): Use cl-(first|second|third) to access values
- of desktop-mini.
- (desktop--make-frame): Use cl-delete-if.
- (desktop--sort-states): Fix sorting of minibuffer-owning frames.
- (desktop-restore-frames): Use cl-(first|second|third) to access values
- of desktop-mini. Look for visible frame at the end, not while
- restoring frames.
-
- * dired-x.el (dired-mark-unmarked-files, dired-virtual)
- (dired-guess-default, dired-mark-sexp, dired-filename-at-point):
- Use string-match-p, looking-at-p (bug#14927).
-
-2013-07-21 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-saved-frame-states):
- Rename from desktop--saved-states; all users changed.
- (desktop-save-frames): Rename from desktop--save-frames.
- Do not save state to desktop file.
- (desktop-save): Save desktop-saved-frame-states to desktop file
- and reset to nil.
- (desktop-restoring-frames-p): New function.
- (desktop-restore-frames): Use it. Rename from desktop--restore-frames.
- (desktop-read): Use desktop-restoring-frames-p. Do not try to fix
- buffer-lists when restoring frames. Suggested by Martin Rudalics.
-
- * desktop.el: Correctly restore iconified frames.
- (desktop--filter-iconified-position): New function.
- (desktop-filter-parameters-alist): Add entries for `top' and `left'.
-
-2013-07-20 Glenn Morris <rgm@gnu.org>
-
- * progmodes/gdb-mi.el (gdb-delete-handler, gdb-stopped):
- Let `message' do the formatting.
- (def-gdb-preempt-display-buffer): Add explicit format.
-
- * image-dired.el (image-dired-track-original-file):
- Use with-current-buffer.
- (image-dired-track-thumbnail): Use with-current-buffer.
- Avoid changing point of wrong window.
-
- * image-dired.el (image-dired-track-original-file):
- Avoid changing point of wrong window. (Bug#14909)
-
-2013-07-20 Richard Copley <rcopley@gmail.com> (tiny change)
-
- * progmodes/gdb-mi.el (gdb-done-or-error):
- Guard against "%" in gdb output. (Bug#14127)
-
-2013-07-20 Andreas Schwab <schwab@linux-m68k.org>
-
- * progmodes/sh-script.el (sh-read-variable): Remove interactive spec.
- (Bug#14826)
-
- * international/mule.el (coding-system-iso-2022-flags): Fix last
- change.
-
-2013-07-20 Kenichi Handa <handa@gnu.org>
-
- * international/mule.el (coding-system-iso-2022-flags):
- Add `8-bit-level-4'. (Bug#8522)
-
-2013-07-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-mouse-browse-url): New command and keystroke
- (bug#14815).
-
- * net/eww.el (eww-process-text-input): Allow inputting when the
- point is at the start of the line, as the properties aren't
- front-sticky.
-
- * net/shr.el (shr-make-table-1): Ensure that we don't infloop on
- degenerate widths.
-
-2013-07-19 Richard Stallman <rms@gnu.org>
-
- * epa.el (epa-popup-info-window): Doc fix.
-
- * subr.el (split-string): New arg TRIM.
-
-2013-07-18 Juanma Barranquero <lekktu@gmail.com>
-
- * frame.el (blink-cursor-timer-function, blink-cursor-suspend):
- Add check for W32 (followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se).
-
-2013-07-18 Michael Albinus <michael.albinus@gmx.de>
-
- * filenotify.el (file-notify--library): Rename from
- `file-notify-support'. Do not autoload. Adapt all uses.
- (file-notify-supported-p): New defun.
-
- * autorevert.el (auto-revert-use-notify):
- Use `file-notify-supported-p' instead of `file-notify-support'.
- Adapt docstring.
- (auto-revert-notify-add-watch): Use `file-notify-supported-p'.
-
- * net/tramp.el (tramp-file-name-for-operation):
- Add `file-notify-supported-p'.
-
- * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
- New defun.
- (tramp-sh-file-name-handler-alist): Add it as handler for
- `file-notify-supported-p '.
-
- * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
- * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
- * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
- Add `ignore' as handler for `file-notify-*' functions.
-
-2013-07-17 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (line-move-partial, line-move): Don't start vscroll or
- scroll-up if the current line is not taller than the window.
- (Bug#14881)
-
-2013-07-16 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords): Do not
- highlight question marks in the method names as strings.
- (ruby-block-beg-keywords): Inline.
- (ruby-font-lock-keyword-beg-re): Extract from
- `ruby-font-lock-keywords'.
-
-2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
-
- * frame.el (blink-cursor-blinks): New defcustom.
- (blink-cursor-blinks-done): New defvar.
- (blink-cursor-start): Set blink-cursor-blinks-done to 1.
- (blink-cursor-timer-function): Check if number of blinks has been
- done on X and NS.
- (blink-cursor-suspend, blink-cursor-check): New defuns.
-
-2013-07-15 Glenn Morris <rgm@gnu.org>
-
- * edmacro.el (edmacro-format-keys): Fix previous change.
-
-2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
-
- * shell.el (explicit-bash-args): Remove obsolete hack for Bash 1.x.
- The hack didn't work outside English locales anyway.
-
-2013-07-15 Juanma Barranquero <lekktu@gmail.com>
-
- * simple.el (define-alternatives): Rename from alternatives-define,
- per RMS' suggestion.
-
-2013-07-14 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-restore-frames): Change default to t.
- (desktop-restore-in-current-display): Now offer more options.
- (desktop-restoring-reuses-frames): New customization option.
- (desktop--saved-states): Doc fix.
- (desktop-filter-parameters-alist): New variable, renamed and expanded
- from desktop--excluded-frame-parameters.
- (desktop--target-display): New variable.
- (desktop-switch-to-gui-p, desktop-switch-to-tty-p)
- (desktop--filter-tty*, desktop--filter-*-color)
- (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
- (desktop--filter-save-desktop-parm)
- (desktop-restore-in-original-display-p): New functions.
- (desktop--filter-frame-parms): Use new desktop-filter-parameters-alist.
- (desktop--save-minibuffer-frames): New function, inspired by a similar
- function from Martin Rudalics.
- (desktop--save-frames): Call it; play nice with desktop-globals-to-save.
- (desktop--restore-in-this-display-p): Remove.
- (desktop--find-frame): Rename from desktop--find-frame-in-display
- and add predicate argument.
- (desktop--make-full-frame): Remove, integrated into desktop--make-frame.
- (desktop--reuse-list): New variable.
- (desktop--select-frame, desktop--make-frame, desktop--sort-states):
- New functions.
- (desktop--restore-frames): Add support for "minibuffer-special" frames.
-
-2013-07-14 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-sh.el (tramp-sh-handle-vc-registered): Use `ignore-error'.
-
-2013-07-13 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords):
- Highlight conversion methods on Kernel.
-
-2013-07-13 Alan Mackenzie <acm@muc.de>
-
- * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Label CASE 13
- and comment it out. This out-commenting enables certain C++
- declarations to be parsed correctly.
-
-2013-07-13 Eli Zaretskii <eliz@gnu.org>
-
- * international/mule.el (define-coding-system): Doc fix.
-
- * simple.el (default-font-height): Don't call font-info if the
- frame's default font didn't change since the frame was created.
- (Bug#14838)
-
-2013-07-13 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-read-file-name): Guard against non-symbol value.
-
-2013-07-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- * progmodes/python.el (python-imenu--build-tree): Fix corner case
- in nested defuns.
-
-2013-07-13 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-exhibit): Handle ido-enter-matching-directory before
- ido-set-matches call. (Bug#6852)
-
-2013-07-12 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-percent-literals-beg-re):
- (ruby-syntax-expansion-allowed-p): Support array of symbols, for
- Ruby 2.0.
- (ruby-font-lock-keywords): Distinguish calls to functions with
- module-like names from module references. Highlight character
- literals.
-
-2013-07-12 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change)
-
- * progmodes/gdb-mi.el (gdb-strip-string-backslash): New function.
- (gdb-send): Handle continued commands. (Bug#14847)
-
-2013-07-12 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop--v2s): Remove unused local variable.
- (desktop-save-buffer): Make defvar-local; adjust docstring.
- (desktop-auto-save-timeout, desktop-owner): Use ignore-errors.
- (desktop-clear, desktop-save-buffer-p): Use string-match-p.
-
-2013-07-12 Andreas Schwab <schwab@linux-m68k.org>
-
- * emacs-lisp/map-ynp.el (map-y-or-n-p): Fix last change.
-
-2013-07-12 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (next-line, previous-line): Document TRY-VSCROLL and ARG.
- (Bug#14842)
-
-2013-07-12 Glenn Morris <rgm@gnu.org>
-
- * doc-view.el: Require cl-lib at runtime too.
- (doc-view-remove-if): Remove.
- (doc-view-search-next-match, doc-view-search-previous-match):
- Use cl-remove-if.
-
- * edmacro.el: Require cl-lib at runtime too.
- (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq.
- (edmacro-mismatch, edmacro-subseq): Remove.
-
- * shadowfile.el: Require cl-lib.
- (shadow-remove-if): Remove.
- (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo):
- Use cl-remove-if.
-
- * wid-edit.el: Require cl-lib.
- (widget-choose): Use cl-remove-if.
- (widget-remove-if): Remove.
-
- * progmodes/ebrowse.el: Require cl-lib at runtime too.
- (ebrowse-delete-if-not): Remove.
- (ebrowse-browser-buffer-list, ebrowse-member-buffer-list)
- (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list):
- Use cl-delete-if-not.
-
-2013-07-12 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq)
- (cl-the, cl-declare, cl-defstruct): Fix typos in docstrings.
-
-2013-07-12 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (dired-do-copy, dired): Set 'ido property. (Bug#11954)
-
-2013-07-11 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/edebug.el: Require cl-lib at run-time too.
- (edebug-gensym-index, edebug-gensym):
- Remove reimplementation of cl-gensym.
- (edebug-make-enter-wrapper, edebug-make-form-wrapper): Use cl-gensym.
-
- * thumbs.el: Require cl-lib at run-time too.
- (thumbs-gensym-counter, thumbs-gensym):
- Remove reimplementation of cl-gensym.
- (thumbs-temp-file): Use cl-gensym.
-
- * emacs-lisp/ert.el: Require cl-lib at runtime too.
- (ert--cl-do-remf, ert--remprop, ert--remove-if-not)
- (ert--intersection, ert--set-difference, ert--set-difference-eq)
- (ert--union, ert--gensym-counter, ert--gensym-counter)
- (ert--coerce-to-vector, ert--remove*, ert--string-position)
- (ert--mismatch, ert--subseq): Remove reimplementations of cl funcs.
- (ert-make-test-unbound, ert--expand-should-1)
- (ert--expand-should, ert--should-error-handle-error)
- (should-error, ert--explain-equal-rec)
- (ert--plist-difference-explanation, ert-select-tests)
- (ert--make-stats, ert--remove-from-list, ert--string-first-line):
- Use cl-lib functions rather than reimplementations.
-
-2013-07-11 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp.el (tramp-methods): Extend docstring.
- (tramp-connection-timeout): New defcustom.
- (tramp-error-with-buffer): Reset timestamp only when appropriate.
- (with-tramp-progress-reporter): Simplify.
- (tramp-process-actions): Improve messages.
-
- * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
- * net/tramp-sh.el (tramp-maybe-open-connection):
- Use `tramp-connection-timeout'.
- (tramp-methods) [su, sudo, ksu]: Add method specific timeouts.
- (Bug#14808)
-
-2013-07-11 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-read-file-name): Conform to the requirements of
- read-file-name. (Bug#11861)
- (ido-read-directory-name): Conform to the requirements of
- read-directory-name.
-
-2013-07-11 Juanma Barranquero <lekktu@gmail.com>
-
- * subr.el (delay-warning): New function.
-
-2013-07-10 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (default-line-height): New function.
- (line-move-partial, line-move): Use it instead of computing the
- line height inline.
- (line-move-partial): Always compute ROWH. If the last line is
- partially-visible, but its text is completely visible, allow
- cursor to enter such a partially-visible line.
-
-2013-07-10 Michael Albinus <michael.albinus@gmx.de>
-
- Improve error messages. (Bug#14808)
-
- * net/tramp.el (tramp-current-connection): New defvar, moved from
- tramp-sh.el.
- (tramp-message-show-progress-reporter-message): Remove, not
- needed anymore.
- (tramp-error-with-buffer): Show message in minibuffer.
- Discard input before waiting. Reset connection timestamp.
- (with-tramp-progress-reporter): Improve messages.
- (tramp-process-actions): Use progress reporter. Delete process in
- case of error. Improve messages.
-
- * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case.
- Call `tramp-error-with-buffer' with vector and buffer.
- (tramp-current-connection): Remove.
- (tramp-maybe-open-connection): The car of
- `tramp-current-connection' are the first 3 slots of the vector.
-
-2013-07-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/cfengine.el (cfengine3-indent-line): Do not indent
- inside continued strings.
-
-2013-07-10 Paul Eggert <eggert@cs.ucla.edu>
-
- Timestamp fixes for undo (Bug#14824).
- * files.el (clear-visited-file-modtime): Move here from fileio.c.
-
-2013-07-10 Leo Liu <sdl.web@gmail.com>
-
- * files.el (require-final-newline): Allow safe local value.
- (Bug#14834)
-
-2013-07-09 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-read-directory-name): Handle fallback.
- (ido-read-file-name): Update DIR to ido-current-directory.
- (Bug#1516)
- (ido-add-virtual-buffers-to-list): Robustify. (Bug#14552)
-
-2013-07-09 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove extra
- "autoload". Remove "warn lower camel case" section, previously
- commented out. Highlight negation char. Do not highlight the
- target in singleton method definitions.
-
-2013-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * faces.el (tty-setup-hook): Declare the hook.
-
- * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try
- and detect when a guard/pred depends on local vars (bug#14773).
- (pcase--u1): Adjust caller.
-
-2013-07-08 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (line-move-partial, line-move): Account for
- line-spacing.
- (line-move-partial): Avoid setting vscroll when the last
- partially-visible line in window is of default height.
-
-2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-map): Reinstate the `u' key binding, since it's
- been used a while.
-
-2013-07-07 Juanma Barranquero <lekktu@gmail.com>
-
- * subr.el (read-quoted-char): Remove unused local variable `char'.
-
-2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu>
-
- * ediff.el (ediff-version): Version update.
- (ediff-files-command, ediff3-files-command, ediff-merge-command)
- (ediff-merge-with-ancestor-command, ediff-directories-command)
- (ediff-directories3-command, ediff-merge-directories-command)
- (ediff-merge-directories-with-ancestor-command): New functions.
- All are command-line interfaces to ediff: to facilitate calling
- Emacs with the appropriate ediff functions invoked.
-
- * viper-cmd.el (viper-del-forward-char-in-insert): New function.
- (viper-save-kill-buffer): Check if buffer is modified.
-
- * viper.el (viper-version): Version update.
- (viper-emacs-state-mode-list): Add egg-status-buffer-mode.
-
-2013-07-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook.
- * viper-cmd.el (viper-envelop-ESC-key): Remove function.
- (viper-intercept-ESC-key): Simplify.
- * viper-keym.el (viper-ESC-key): Make it a constant, don't use kbd.
- * viper.el (viper--tty-ESC-filter, viper--lookup-key)
- (viper-catch-tty-ESC, viper-uncatch-tty-ESC)
- (viper-setup-ESC-to-escape): New functions.
- (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape.
- (viper-set-hooks): Do not modify flyspell-mode-hook. (Bug#13793)
-
-2013-07-07 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (default-font-height, window-screen-lines):
- New functions.
- (line-move, line-move-partial): Use them instead of
- frame-char-height and window-text-height. This makes scrolling
- text smoother when the buffer's default face uses a font that is
- different from the frame's default font.
-
-2013-07-06 Jan Djärv <jan.h.d@swipnet.se>
-
- * files.el (write-file): Do not display confirm dialog for NS,
- it does its own dialog, which can't be cancelled (Bug#14578).
-
-2013-07-06 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (line-move-partial): Adjust the row returned by
- posn-at-point for the current window-vscroll. (Bug#14567)
-
-2013-07-06 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-sh.el (tramp-sh-file-gvfs-monitor-dir-process-filter):
- (tramp-sh-file-inotifywait-process-filter): Handle file names with
- spaces.
-
-2013-07-06 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (window-state-put-stale-windows): New variable.
- (window--state-put-2): Save list of windows without matching buffer.
- (window-state-put): Remove "bufferless" windows if possible.
-
-2013-07-06 Juanma Barranquero <lekktu@gmail.com>
-
- * simple.el (alternatives-define): Remove leftover :group keyword.
- Tweak docstring.
-
-2013-07-06 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-use-virtual-buffers): Allow new value 'auto.
- (ido-enable-virtual-buffers): New variable.
- (ido-buffer-internal, ido-toggle-virtual-buffers)
- (ido-make-buffer-list): Use it.
- (ido-exhibit): Support turning on and off virtual buffers
- automatically.
-
-2013-07-06 Juanma Barranquero <lekktu@gmail.com>
-
- * simple.el (alternatives-define): New macro.
-
-2013-07-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (read-quoted-char): Use read-key.
- (sit-for): Let read-event decode tty input (bug#14782).
-
-2013-07-05 Stephen Berman <stephen.berman@gmx.net>
-
- * calendar/todo-mode.el: Add handling of file deletion, both by
- mode command and externally. Fix various related bugs.
- Clarify Commentary and improve some documentation strings and code.
- (todo-delete-file): New command.
- (todo-check-file): New function.
- (todo-show): Handle external deletion of the file we're trying to
- show (bug#14688). Replace called-interactively-p by an optional
- prefix argument to avoid problematic interaction with catch form
- when byte compiled (bug#14702).
- (todo-quit): Handle external deletion of the archive's todo file.
- Make sure the buffer that was visiting the archive file is still
- live before trying to bury it.
- (todo-category-completions): Handle external deletion of any
- category completion files.
- (todo-jump-to-category, todo-basic-insert-item): Recalculate list
- of todo files, in case of external deletion.
- (todo-add-file): Replace unnecessary setq by let-binding.
- (todo-find-archive): Check whether there are any archives.
- Replace unnecessary setq by let-binding.
- (todo-archive-done-item): Use find-file-noselect to get the
- archive buffer whether or not the archive already exists.
- Remove superfluous code. Use file size instead of buffer-file-name to
- check if the archive is new; if it is, update list of archives.
- (todo-default-todo-file): Allow nil to be a valid value for when
- there are no todo files.
- (todo-reevaluate-default-file-defcustom): Use corrected definition
- of todo-default-todo-file.
- (todo-key-bindings-t+a+f): Add key binding for todo-delete-file.
- (todo-delete-category, todo-show-categories-table)
- (todo-category-number): Clarify comment.
- (todo-filter-items): Clarify documentation string.
- (todo-show-current-file, todo-display-as-todo-file)
- (todo-reset-and-enable-done-separator): Tweak documentation string.
- (todo-done-separator): Make separator length window-width, since
- bug#2749 is now fixed.
-
-2013-07-05 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
- Support both "gvfs-monitor-dir" and "inotifywait".
- (tramp-sh-file-inotifywait-process-filter): Rename from
- `tramp-sh-file-notify-process-filter'.
- (tramp-sh-file-gvfs-monitor-dir-process-filter)
- (tramp-get-remote-gvfs-monitor-dir): New defuns.
-
-2013-07-05 Leo Liu <sdl.web@gmail.com>
-
- * autoinsert.el (auto-insert-alist): Default to lexical-binding.
-
-2013-07-04 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
-
- * frame.el (display-pixel-height, display-pixel-width)
- (display-mm-height, display-mm-width): Mention behavior on
- multi-monitor setups in docstrings.
- (w32-display-monitor-attributes-list): Declare function.
- (display-monitor-attributes-list): Use it.
-
-2013-07-04 Michael Albinus <michael.albinus@gmx.de>
-
- * filenotify.el: New package.
-
- * autorevert.el (top): Require filenotify.el.
- (auto-revert-notify-enabled): Remove. Use `file-notify-support'
- instead.
- (auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
- (auto-revert-notify-handler): Use `file-notify-*' functions.
-
- * subr.el (file-notify-handle-event): Move function to filenotify.el.
-
- * net/tramp.el (tramp-file-name-for-operation):
- Handle `file-notify-add-watch' and `file-notify-rm-watch'.
-
- * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add handler
- for `file-notify-add-watch' and `file-notify-rm-watch'.
- (tramp-process-sentinel): Improve trace.
- (tramp-sh-handle-file-notify-add-watch)
- (tramp-sh-file-notify-process-filter)
- (tramp-sh-handle-file-notify-rm-watch)
- (tramp-get-remote-inotifywait): New defuns.
-
-2013-07-03 Juri Linkov <juri@jurta.org>
-
- * buff-menu.el (Buffer-menu-multi-occur): Add args and move the
- call of `occur-read-primary-args' to interactive spec.
-
- * ibuffer.el (ibuffer-mode-map): Bind "M-s a C-o" to
- `ibuffer-do-occur' like in buff-menu.el. (Bug#14673)
-
-2013-07-03 Matthias Meulien <orontee@gmail.com>
-
- * buff-menu.el (Buffer-menu-mode-map): Bind "M-s a C-o" to
- `Buffer-menu-multi-occur'. Add it to the menu.
- (Buffer-menu-mode): Document it in docstring.
- (Buffer-menu-multi-occur): New command. (Bug#14673)
-
-2013-07-03 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more
- keywords and built-ins.
-
-2013-07-03 Glenn Morris <rgm@gnu.org>
-
- * subr.el (y-or-n-p): Handle empty prompts. (Bug#14770)
-
- Make info-xref checks case-sensitive by default
- * info.el (Info-find-node, Info-find-in-tag-table)
- (Info-find-node-in-buffer, Info-find-node-2, Info-goto-node):
- Add option for exact case matching of nodes.
- * info-xref.el (info-xref): New custom group.
- (info-xref-case-fold): New option.
- (info-xref-goto-node-p): Pass info-xref-case-fold to Info-goto-node.
-
-2013-07-03 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-delete-file-at-head): Respect delete-by-moving-to-trash.
-
-2013-07-03 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-move-to-block): When we're at a
- middle of block statement initially, lower the depth. Remove
- FIXME comment, not longer valid. Remove middle of block statement
- detection, no need to do that anymore since we've been using
- `ruby-parse-region' here.
-
-2013-07-02 Jan Djärv <jan.h.d@swipnet.se>
-
- * term/ns-win.el (display-format-alist): Use .* (Bug#14765).
-
-2013-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * wid-edit.el (widget-default-get): Don't modify widget (Bug#14738).
-
-2013-07-01 Juanma Barranquero <lekktu@gmail.com>
-
- * desktop.el (desktop-restore-frames): Rename from desktop-save-windows.
- (desktop-restore-in-current-display): New customization option.
- (desktop--excluded-frame-parameters): Add `font'.
- (desktop--save-frames): Rename from desktop--save-windows.
- (desktop--restore-in-this-display-p): New function.
- (desktop--make-full-frame): Remove unwanted width/height from
- full(width|height) frames.
- (desktop--restore-frames): Rename from desktop--restore-windows.
- Obey desktop-restore-current-display. Do not delete old frames or
- select a new frame unless we were able to restore at least one frame.
-
-2013-06-30 Michal Nazarewicz <mina86@mina86.com>
-
- * files.el (find-file-noselect): Simplify conditional expression.
-
- * remember.el (remember-append-to-file):
- Don't mix `find-buffer-visiting' and `get-file-buffer'.
-
- Add `remember-notes' function to store random notes across Emacs
- restarts.
- * remember.el (remember-data-file): Add :set callback to affect
- notes buffer (if any).
- (remember-notes): New command.
- (remember-notes-buffer-name, bury-remember-notes-on-kill):
- New defcustoms for the `remember-notes' function.
- (remember-notes-save-and-bury-buffer): New command.
- (remember-notes-mode-map): New variable.
- (remember-mode): New minor mode.
- (remember-notes--kill-buffer-query): New function.
- * startup.el (initial-buffer-choice): Add notes to custom type.
-
-2013-06-30 Eli Zaretskii <eliz@gnu.org>
-
- * bindings.el (right-char, left-char): Don't call sit-for, this is
- no longer needed. Use arithmetic comparison only for numerical
- arguments.
-
- * international/mule-cmds.el (select-safe-coding-system):
- Handle the case of FROM being a string correctly. (Bug#14755)
-
-2013-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-make-table-1): Add a sanity check that allows
- progression on degenerate tables.
- (shr-rescale-image): ImageMagick animated images currently don't work.
-
-2013-06-30 Juanma Barranquero <lekktu@gmail.com>
-
- Some fixes and improvements for desktop frame restoration.
- It is still experimental and disabled by default.
- * desktop.el (desktop--save-windows): Put the selected frame at
- the head of the list.
- (desktop--make-full-frame): New function.
- (desktop--restore-windows): Try to re-select the frame that was
- selected upon saving. Do not abort if some frames fail to restore,
- just show an error message and continue. Set up maximized frames
- so they have default non-maximized dimensions.
-
-2013-06-30 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
- Don't start heredoc inside a string or comment.
-
-2013-06-29 Eli Zaretskii <eliz@gnu.org>
-
- * bindings.el (visual-order-cursor-movement): New defcustom.
- (right-char, left-char): Provide visual-order cursor motion by
- calling move-point-visually. Update the doc strings.
-
-2013-06-28 Kenichi Handa <handa@gnu.org>
-
- * international/mule.el (define-coding-system): New coding system
- properties :inhibit-null-byte-detection,
- :inhibit-iso-escape-detection, and :prefer-utf-8.
- (set-buffer-file-coding-system): If :charset-list property of
- CODING-SYSTEM is `emacs', do not check if CODING-SYSTEM is
- appropriate for setting.
-
- * international/mule-cmds.el (select-safe-coding-system):
- If DEFAULT-CODING-SYSTEM is prefer-utf-8 and the buffer contains
- multibyte characters, return utf-8 (or one of its siblings).
-
- * international/mule-conf.el (prefer-utf-8): New coding system.
- (file-coding-system-alist): Use prefer-utf-8 as default for Elisp
- files.
-
-2013-06-28 Ivan Kanis <ivan@kanis.fr>
-
- * net/shr.el (shr-render-region): New function.
-
- * net/eww.el: Autoload `eww-browse-url'.
-
-2013-06-27 Dmitry Gutov <dgutov@yandex.ru>
-
- * emacs-lisp/package-x.el (package-upload-buffer-internal):
- Adapt to `package-desc-version' being a list.
- Use `package--ac-desc-version' to retrieve version from a package
- archive element.
-
-2013-06-27 Juanma Barranquero <lekktu@gmail.com>
-
- New experimental feature to save&restore window and frame setup.
- * desktop.el (desktop-save-windows): New defcustom.
- (desktop--saved-states): New var.
- (desktop--excluded-frame-parameters): New defconst.
- (desktop--filter-frame-parms, desktop--find-frame-in-display)
- (desktop--restore-windows, desktop--save-windows): New functions.
- (desktop-save): Call `desktop--save-windows'.
- (desktop-read): Call `desktop--restore-windows'.
-
-2013-06-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (add-face-text-property): Remove compat definition.
-
-2013-06-27 Stephen Berman <stephen.berman@gmx.net>
-
- * info.el (Info-try-follow-nearest-node): Move search for footnote
- above search for node name to prevent missing a footnote (bug#14717).
-
-2013-06-27 Stephen Berman <stephen.berman@gmx.net>
-
- * obsolete/otodo-mode.el: Add obsolescence info to file header.
-
-2013-06-27 Leo Liu <sdl.web@gmail.com>
-
- * net/eww.el (eww-read-bookmarks): Check file size.
-
-2013-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el (advice--defalias-fset): Move advice back to
- advice--pending if newdef is nil or an autoload (bug#13820).
- (advice-mapc): New function.
-
-2013-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-mode): Undo isn't necessary in eww buffers,
- probably.
- (eww-mode-map): Add a menu bar.
- (eww-add-bookmark): New command.
- (eww-bookmark-mode): New mode and commands.
- (eww-add-bookmark): Remove newlines from the title.
- (eww-bookmark-browse): Don't bug out if it's the only window.
-
-2013-06-26 Glenn Morris <rgm@gnu.org>
-
- * htmlfontify.el (hfy-triplet): Handle unspecified-fg, bg.
- (hfy-size): Handle ttys. (Bug#14668)
-
- * info-xref.el: Update for Texinfo 5 change in *note format.
- (info-xref-node-re, info-xref-note-re): New constants.
- (info-xref-check-buffer): Use info-xref-note-re.
-
-2013-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * simple.el (set-variable): Use read-from-minibuffer (bug#14710).
-
- * emacs-lisp/package.el (package--add-to-archive-contents): Add missing
- nil terminate the loop (bug#14718).
-
-2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el: Rework history traversal. When going forward/back,
- put these actions into the history, too, so that they can be
- replayed.
- (eww-render): Move the history reset to the correct buffer.
-
-2013-06-25 Juri Linkov <juri@jurta.org>
-
- * files-x.el (modify-dir-local-variable): Change the header comment
- in the file with directory local variables. (Bug#14692)
-
- * files-x.el (read-file-local-variable-value): Add `default'.
- (Bug#14710)
-
-2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-make-unique-file-name): Create a unique file
- name before saving to entering `y' accidentally asynchronously.
-
-2013-06-25 Ivan Kanis <ivan@kanis.fr>
-
- * net/eww.el (eww-download): New command and keystroke.
-
-2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-copy-page-url): Change name of command.
-
- * net/shr.el (shr-map): Change `shr-copy-url' from `u' to `w' to
- be more consistent with Info and dired.
-
- * net/eww.el (eww-mode-map): Ditto.
-
-2013-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el: Use lexical-binding. Include obsolete
- packages from archives.
- (package-archive-contents): Change format; include obsolete packages.
- (package-desc): Use `dir' to mark builtin packages.
- (package--from-builtin): Set the `dir' field to `builtin'.
- (generated-autoload-file, version-control): Declare.
- (package-compute-transaction): Change first arg and return value to be
- lists of package-descs. Adjust to new package-archive-contents format.
- (package--add-to-archive-contents): Adjust to new
- package-archive-contents format.
- (package-download-transaction): Arg is now a list of package-descs.
- (package-install): If `pkg' is a package name, pass it as
- a requirement, so it is subject to the usual (e.g. disabled) checks.
- (describe-package): Accept package-desc as well.
- (describe-package-1): Describe a specific package-desc. Add links to
- other package-descs for the same package name.
- (package-menu-describe-package): Pass the actual package-desc.
- (package-menu-mode): Add to tabulated-list-revert-hook so revert-buffer
- works correctly.
- (package-desc-status): New function.
- (package-menu--refresh): New function, extracted
- from package-menu--generate.
- (package-menu--generate): Use it.
- (package-delete): Update package-alist.
- (package-menu-execute): Don't call package-initialize.
-
- * progmodes/idlw-toolbar.el, progmodes/idlw-shell.el,
- progmodes/idlw-help.el, progmodes/idlw-complete-structtag.el,
- progmodes/ebnf-yac.el, progmodes/ebnf-otz.el, progmodes/ebnf-iso.el,
- progmodes/ebnf-ebx.el, progmodes/ebnf-dtd.el, progmodes/ebnf-bnf.el,
- progmodes/ebnf-abn.el, emacs-lisp/package-x.el, emacs-lisp/cl-seq.el,
- emacs-lisp/cl-macs.el: Neuter the "Version:" header.
-
-2013-06-25 Martin Rudalics <rudalics@gmx.at>
-
- * window.el (window--state-get-1): Workaround for bug#14527.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00941.html
-
-2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-back-url): Implement the history by stashing all
- the data into a list.
- (eww-forward-url): Allow going forward in the history, too.
-
-2013-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * files-x.el (read-file-local-variable-value): Use read-from-minibuffer
- for values and use read--expression for expressions (bug#14710).
- (read-file-local-variable): Avoid setq.
- (read-file-local-variable-mode): Use minor-mode-list.
-
-2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * textmodes/bibtex.el (bibtex-generate-url-list): Add support
- for DOI URLs.
-
-2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect):
- Update imenu-support when dialect changes.
-
-2013-06-25 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-read-internal): Allow forward slash on windows.
-
-2013-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww): Start of strings is \\`, not ^.
-
-2013-06-24 Ivan Kanis <ivan@kanis.fr>
-
- * net/shr.el (shr-browse-url): Fix interactive spec.
-
- * net/eww.el (eww): Add a trailing slash to domain names.
-
-2013-06-24 Juanma Barranquero <lekktu@gmail.com>
-
- * faces.el (face-spec-recalc): Revert part of 2013-06-23T20:29:18Z!lekktu@gmail.com (bug#14705).
-
-2013-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-browse-url): Use an external browser if given a
- prefix.
-
- * net/eww.el (eww-external-browser): Move to shr.
-
-2013-06-24 Ivan Kanis <ivan@kanis.fr>
-
- * net/eww.el (eww): Work more correctly for file: URLs.
- (eww-detect-charset): Allow quoted charsets.
- (eww-yank-page-url): New command and keystroke.
-
-2013-06-24 Daiki Ueno <ueno@gnu.org>
-
- * epg.el (epg-make-context): Check if PROTOCOL is valid; embed the
- file name of gpg executable.
- (epg-context-program): New function.
- (epg-context-home-directory): New function.
- (epg-context-set-program): New function.
- (epg-context-set-home-directory): New function.
- (epg--start): Use `epg-context-program' instead of
- 'epg-gpg-program'.
- (epg--list-keys-1): Likewise.
-
-2013-06-24 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-read-internal): Fix bug#14620.
-
-2013-06-23 Juanma Barranquero <lekktu@gmail.com>
-
- * faces.el (face-documentation): Simplify.
- (read-face-attribute, tty-find-type, x-resolve-font-name):
- Use `string-match-p'.
- (list-faces-display): Use `string-match-p'. Simplify.
- (face-spec-recalc): Check face to avoid face alias loops.
- (read-color): Use `string-match-p' and non-capturing parenthesis.
-
-2013-06-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-rescale-image): Use the new
- :max-width/:max-height functionality.
-
-2013-06-23 Ivan Kanis <ivan@kanis.fr>
-
- * net/eww.el (eww-search-prefix): New variable.
- (eww): Use it.
- (eww-external-browser): New variable.
- (eww-mode-map): New keystroke.
- (eww-browse-with-external-browser): New command.
-
- * net/eww.el: Bind `C-c C-c' to "submit" in all form keymaps.
-
-2013-06-23 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/tabulated-list.el (tabulated-list-init-header):
- Don't skip aligning the next header field when padding is 0;
- otherwise, field width is not respected unless the title is as
- wide as the field.
-
-2013-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-el-version): Remove.
- (package-process-define-package): Fix inf-loop.
- (package-install): Allow symbols as arguments again.
-
-2013-06-22 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `catch',
- add some more keyword-like methods.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00911.html
-
-2013-06-22 Juanma Barranquero <lekktu@gmail.com>
-
- * bs.el (bs-buffer-show-mark): Make defvar-local.
- (bs-mode): Use setq-local.
-
- * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode)
- (emacs-lock--try-unlocking): Make defvar-local.
-
-2013-06-22 Glenn Morris <rgm@gnu.org>
-
- * play/cookie1.el (cookie-apropos): Minor simplification.
-
- * progmodes/gdb-mi.el (gdb-mapcar*): Remove, replace with cl-mapcar.
-
-2013-06-22 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (auto-mode-alist): Do not use
- `regexp-opt', it breaks the build during dumping.
-
-2013-06-21 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-font-lock-keywords):
- Highlight keyword-like methods on Kernel and Module with
- font-lock-builtin-face.
- (auto-mode-alist): Consolidate different entries into one regexp
- and add more *file-s.
-
-2013-06-21 Stephen Berman <stephen.berman@gmx.net>
-
- * obsolete/otodo-mode.el: Move and rename from calendar/todo-mode.el.
-
- * calendar/diary-lib.el (diary-goto-entry-function): New variable.
- (diary-entry): Use it in the action of this button type instead of
- diary-goto-entry.
-
- * calendar/todo-mode.el: New version.
- (todo-add-category): Append new category to end of file and give
- it the highest number, instead of putting it at the beginning and
- giving it 0. Incorporate noninteractive functionality.
- (todo-forward-category): Adapt to 1-based category numbering.
- Allow skipping over archived categories.
- (todo-backward-category): Derive from todo-forward-category.
- (todo-backward-item, todo-forward-item): Make noninteractive and
- delegate interactive part to new commands. Make sensitive to done items.
- (todo-categories): Make value an alist of category names and
- vectors of item counts.
- (todo-category-beg): Make a defconst.
- (todo-category-number): Use 1 instead of 0 as initial value.
- (todo-category-select): Make sensitive to overlays, optional item
- highlighting and done items.
- (todo-delete-item): Make sensitive to overlays and marked and done items.
- (todo-edit-item): Make sensitive to overlays and editing of
- date/time header optional. Add format checks.
- (todo-edit-multiline): Rename to todo-edit-multiline-item. Make a
- no-op if point is not on an item. Advertise using todo-edit-quit.
- (todo-edit-mode): Make sensitive to new format, font-locking, and
- multiple todo files.
- (todo-insert-item, todo-insert-item-here): Derive from
- todo-basic-insert-item and extend functionality.
- (todo-item-end, todo-item-start): Make sensitive to done items.
- (todo-item-string): Don't return text properties. Restore point.
- (todo-jump-to-category): Make sensitive to multiple todo files and
- todo archives. Use extended category completion.
- (todo-lower-item, todo-raise-item): Rename to *-priority and
- derive from todo-set-item-priority.
- (todo-mode): Derive from special-mode. Make sensitive to new
- format, font-locking and multiple todo files. Make read-only.
- (todo-mode-map): Don't suppress digit keys, so they can supply
- prefix arguments. Add many new key bindings.
- (todo-prefix): Insert as an overlay instead of file text.
- Change semantics from diary date expression to purely visual mark.
- (todo-print): Rename to todo-print-buffer. Make buffer display
- features printable. Remove option to restrict number of items
- printed. Add option to print to file.
- (todo-print-function): Rename to todo-print-buffer-function.
- (todo-quit): Extend to handle exiting new todo modes.
- (todo-remove-item): Make sensitive to overlays.
- (todo-save): Extend to buffers of filtered items.
- (todo-show): Make sensitive to done items, multiple todo files and
- new todo modes. Offer to convert legacy todo file before creating
- first new todo file.
- (todo-show-priorities): Rename to todo-top-priorities.
- Change semantics of value 0.
- (todo-top-priorities): Rename to todo-filter-top-priorities,
- derive from todo-filter-items and extend functionality.
- (todo-save-top-priorities): Rename to todo-save-filtered-items-buffer
- and extend functionality to other types of filtered items.
- (todo-add-item-non-interactively, todo-ask-p, todo-cat-slct)
- (todo-category-end, todo-category-sep, todo-cats, todo-cmd-back)
- (todo-cmd-done, todo-cmd-edit, todo-cmd-forw, todo-cmd-inst)
- (todo-cmd-kill, todo-cmd-lowr, todo-cmd-next, todo-cmd-prev)
- (todo-cmd-rais, todo-cmd-save, todo-completing-read, todo-cp)
- (todo-edit-mode-hook, todo-entry-prefix-function)
- (todo-entry-timestamp-initials, todo-file-do, todo-file-done)
- (todo-file-item, todo-file-top, todo-header, todo-initial-setup)
- (todo-initials, todo-insert-threshold, todo-item-string-start)
- (todo-line-string, todo-menu, todo-mode-hook)
- (todo-more-important-p, todo-previous-answer, todo-previous-line)
- (todo-print-priorities, todo-remove-separator)
- (todo-save-top-priorities-too, todo-string-count-lines)
- (todo-string-multiline-p, todo-time-string-format)
- (todo-tmp-buffer-name): Remove.
- (todo-add-file, todo-archive-done-item, todo-choose-archive)
- (todo-convert-legacy-files, todo-copy-item, todo-delete-category)
- (todo-edit-category-diary-inclusion)
- (todo-edit-category-diary-nonmarking, todo-edit-done-item-comment)
- (todo-edit-file, todo-edit-item-date-day)
- (todo-edit-item-date-day-name, todo-edit-item-date-from-calendar)
- (todo-edit-item-date-month, todo-edit-item-date-to-today)
- (todo-edit-item-date-year, todo-edit-item-diary-inclusion)
- (todo-edit-item-diary-nonmarking, todo-edit-item-header)
- (todo-edit-item-time, todo-edit-quit, todo-filter-diary-items)
- (todo-filter-diary-items-multifile, todo-filter-regexp-items)
- (todo-filter-regexp-items-multifile, todo-filter-top-priorities)
- (todo-filter-top-priorities-multifile, todo-find-archive)
- (todo-find-filtered-items-file, todo-go-to-source-item)
- (todo-insert-item-from-calendar, todo-item-done, todo-item-undone)
- (todo-jump-to-archive-category, todo-lower-category)
- (todo-mark-category, todo-marked-item-p, todo-merge-category)
- (todo-move-category, todo-move-item, todo-next-button)
- (todo-next-item, todo-padded-string, todo-powerset)
- (todo-previous-button, todo-previous-item)
- (todo-print-buffer-to-file, todo-raise-category)
- (todo-rename-category, todo-repair-categories-sexp, todo-search)
- (todo-set-category-number, todo-set-item-priority)
- (todo-set-top-priorities-in-category)
- (todo-set-top-priorities-in-file, todo-show-categories-table)
- (todo-sort-categories-alphabetically-or-numerically)
- (todo-sort-categories-by-archived, todo-sort-categories-by-diary)
- (todo-sort-categories-by-done, todo-sort-categories-by-todo)
- (todo-toggle-item-header, todo-toggle-item-highlighting)
- (todo-toggle-mark-item, todo-toggle-prefix-numbers)
- (todo-toggle-view-done-items, todo-toggle-view-done-only)
- (todo-unarchive-items, todo-unmark-category): New commands.
- (todo-absolute-file-name, todo-add-to-buffer-list)
- (todo-adjusted-category-label-length, todo-basic-edit-item-header)
- (todo-basic-insert-item, todo-category-completions)
- (todo-category-number, todo-category-string-matcher-1)
- (todo-category-string-matcher-2, todo-check-filtered-items-file)
- (todo-check-format, todo-clear-matches)
- (todo-comment-string-matcher, todo-convert-legacy-date-time)
- (todo-current-category, todo-date-string-matcher)
- (todo-define-insertion-command, todo-diary-expired-matcher)
- (todo-diary-goto-entry, todo-diary-item-p)
- (todo-diary-nonmarking-matcher, todo-display-as-todo-file)
- (todo-display-categories, todo-display-sorted, todo-done-item-p)
- (todo-done-item-section-p, todo-done-separator)
- (todo-done-string-matcher, todo-files, todo-filter-items)
- (todo-filter-items-1, todo-filter-items-filename, todo-find-item)
- (todo-gen-arglists, todo-get-count, todo-get-overlay, todo-indent)
- (todo-insert-category-line, todo-insert-item-from-calendar)
- (todo-insert-sort-button, todo-insert-with-overlays)
- (todo-insertion-command-name, todo-insertion-key-bindings)
- (todo-label-to-key, todo-longest-category-name-length)
- (todo-make-categories-list, todo-mode-external-set)
- (todo-mode-line-control, todo-modes-set-1, todo-modes-set-2)
- (todo-modes-set-3, todo-multiple-filter-files)
- (todo-nondiary-marker-matcher, todo-prefix-overlays)
- (todo-read-category, todo-read-date, todo-read-dayname)
- (todo-read-file-name, todo-read-time)
- (todo-reevaluate-category-completions-files-defcustom)
- (todo-reevaluate-default-file-defcustom)
- (todo-reevaluate-filelist-defcustoms)
- (todo-reevaluate-filter-files-defcustom)
- (todo-reset-and-enable-done-separator, todo-reset-comment-string)
- (todo-reset-done-separator, todo-reset-done-separator-string)
- (todo-reset-done-string, todo-reset-global-current-todo-file)
- (todo-reset-highlight-item, todo-reset-nondiary-marker)
- (todo-reset-prefix, todo-set-categories)
- (todo-set-date-from-calendar, todo-set-show-current-file)
- (todo-set-top-priorities, todo-short-file-name)
- (todo-show-current-file, todo-sort, todo-time-string-matcher)
- (todo-total-item-counts, todo-update-buffer-list)
- (todo-update-categories-display, todo-update-categories-sexp)
- (todo-update-count, todo-validate-name, todo-y-or-n-p):
- New functions.
- (todo-archive-mode, todo-categories-mode, todo-filtered-items-mode):
- New major modes.
- (todo-categories, todo-display, todo-edit, todo-faces)
- (todo-filtered): New defgroups.
- (todo-archived-only, todo-button, todo-category-string, todo-date)
- (todo-diary-expired, todo-done, todo-done-sep, todo-comment)
- (todo-mark, todo-nondiary, todo-prefix-string, todo-search)
- (todo-sorted-column, todo-time, todo-top-priority): New deffaces.
- (todo-add-item-if-new-category, todo-always-add-time-string)
- (todo-categories-align, todo-categories-archived-label)
- (todo-categories-category-label, todo-categories-diary-label)
- (todo-categories-done-label, todo-categories-number-separator)
- (todo-categories-todo-label, todo-categories-totals-label)
- (todo-category-completions-files, todo-completion-ignore-case)
- (todo-default-todo-file, todo-diary-nonmarking, todo-directory)
- (todo-done-separator-string, todo-done-string)
- (todo-files-function, todo-filter-done-items, todo-filter-files)
- (todo-highlight-item, todo-include-in-diary, todo-indent-to-here)
- (todo-initial-category, todo-initial-file, todo-item-mark)
- (todo-legacy-date-time-regexp, todo-mode-line-function)
- (todo-nondiary-marker, todo-number-prefix)
- (todo-print-buffer-function, todo-show-current-file)
- (todo-show-done-only, todo-show-first, todo-show-with-done)
- (todo-skip-archived-categories, todo-top-priorities-overrides)
- (todo-undo-item-omit-comment, todo-use-only-highlighted-region)
- (todo-visit-files-commands, todo-wrap-lines, todo-y-with-space):
- New defcustoms.
- (todo-category-done, todo-date-pattern, todo-date-string-start)
- (todo-diary-items-buffer, todo-done-string-start)
- (todo-filtered-items-buffer, todo-item-start)
- (todo-month-abbrev-array, todo-month-name-array)
- (todo-nondiary-end, todo-nondiary-start, todo-regexp-items-buffer)
- (todo-top-priorities-buffer): New defconsts.
- (todo-archive-mode-map, todo-archives, todo-categories-mode-map)
- (todo-categories-with-marks, todo-category-string-face)
- (todo-comment-face, todo-comment-string, todo-current-todo-file)
- (todo-date-face, todo-date-from-calendar, todo-descending-counts)
- (todo-diary-expired-face, todo-done-face, todo-done-sep-face)
- (todo-done-separator, todo-edit-buffer, todo-edit-mode-map)
- (todo-file-buffers, todo-files, todo-filtered-items-mode-map)
- (todo-font-lock-keywords, todo-global-current-todo-file)
- (todo-insertion-commands, todo-insertion-commands-arg-key-list)
- (todo-insertion-commands-args)
- (todo-insertion-commands-args-genlist)
- (todo-insertion-commands-names, todo-insertion-map)
- (todo-key-bindings-t, todo-key-bindings-t+a)
- (todo-key-bindings-t+a+f, todo-key-bindings-t+f, todo-mode-map)
- (todo-multiple-filter-files, todo-multiple-filter-files-widget)
- (todo-nondiary-face, todo-print-buffer, todo-time-face)
- (todo-visited): New variables.
-
-2013-06-21 Glenn Morris <rgm@gnu.org>
-
- * play/cookie1.el (cookie-apropos): Add optional display argument.
- * obsolete/yow.el (apropos-zippy): Use cookie-apropos.
- (psychoanalyze-pinhead): Use cookie-doctor.
-
-2013-06-21 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/package.el (tar-get-file-descriptor)
- (tar--extract): Declare.
-
-2013-06-21 Eduard Wiebe <usenet@pusto.de>
-
- Extend flymake's warning predicate to be a function (bug#14217).
- * progmodes/flymake.el (flymake-warning-predicate): New.
- (flymake-parse-line): Use it.
- (flymake-warning-re): Make obsolete alias to
- `flymake-warning-predicate'.
-
-2013-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-alist): Include obsolete packages.
- (package-obsolete-list): Remove.
- (package-activate): Remove min-version argument. Add `force' argument.
- Adjust to new package-alist format.
- (package-mark-obsolete): Remove.
- (package-unpack): Force reload of the package's autoloads.
- (package-installed-p): Check builtins if the installed package is not
- recent enough.
- (package-initialize): Don't reset package-obsolete-list.
- Don't specify which package version to activate.
- (package-process-define-package, describe-package-1)
- (package-menu--generate): Adjust to new package-alist format.
-
-2013-06-21 Juanma Barranquero <lekktu@gmail.com>
-
- * allout-widgets.el (allout-widgets-mode-off)
- (allout-widgets-mode-on, allout-widgets-pre-command-business)
- (allout-widgets-post-command-business)
- (allout-widgets-after-copy-or-kill-function)
- (allout-widgets-after-undo-function, allout-test-range-overlaps)
- (allout-decorate-item-and-context)
- (allout-graphics-modification-handler): Fix typos in docstrings.
- (allout-get-or-create-parent-widget): Use `looking-at-p'.
-
- * cmuscheme.el (scheme-start-file): Doc fix.
- (inferior-scheme-mode, switch-to-scheme): Fix typos in docstrings.
- (scheme-input-filter): Use `string-match-p'.
-
- * composite.el (compose-gstring-for-terminal): Fix typo in docstring.
-
- * dired-x.el: Use Dired consistently in docstrings.
-
- * dired.el: Use Dired consistently in docstrings.
- (dired-readin, dired-mode): Use `setq-local'.
- (dired-switches-alist): Make defvar-local.
- (dired-buffers-for-dir): Use `zerop'.
- (dired-safe-switches-p, dired-switches-escape-p)
- (dired-insert-old-subdirs, dired-move-to-end-of-filename)
- (dired-glob-regexp, dired-in-this-tree, dired-goto-file-1)
- (dired-sort-set-mode-line, dired-sort-toggle, dired-sort-R-check):
- (dired-goto-next-nontrivial-file): Use `string-match-p'.
- (dired-align-file, dired-insert-directory, dired-mark-files-in-region)
- (dired-toggle-marks, dired-mark-files-containing-regexp)
- (dired-mark-symlinks, dired-mark-directories, dired-mark-executables)
- (dired-flag-auto-save-files, dired-flag-backup-files):
- Use `looking-at-p'.
- (dired-mark-files-regexp, dired-build-subdir-alist):
- Use `string-match-p', `looking-at-p'.
-
- * dos-w32.el (untranslated-canonical-name, untranslated-file-p)
- (direct-print-region-helper): Use `string-match-p'.
-
-2013-06-21 Leo Liu <sdl.web@gmail.com>
-
- * comint.el (comint-redirect-results-list-from-process):
- Fix infinite loop.
-
-2013-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-update-header-line-format): Quote % characters.
-
-2013-06-21 Glenn Morris <rgm@gnu.org>
-
- * play/cookie1.el (cookie): New custom group.
- (cookie-file): New option.
- (cookie-check-file): New function.
- (cookie): Make it interactive. Make start and end messages optional.
- Interactively, display the result. Default to cookie-file.
- (cookie-insert): Default to cookie-file.
- (cookie-snarf): Make start and end messages optional.
- Default to cookie-file. Use with-temp-buffer.
- (cookie-read): Rename from read-cookie.
- Make start and end messages optional. Default to cookie-file.
- (cookie-shuffle-vector): Rename from shuffle-vector. Use dotimes.
- Do not autoload it.
- (cookie-apropos, cookie-doctor): New functions, copied from yow.el
- * obsolete/yow.el (read-zippyism): Use new name for read-cookie.
-
-2013-06-21 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-mode): Backward compatibility fix.
-
-2013-06-21 Glenn Morris <rgm@gnu.org>
-
- * font-lock.el (lisp-font-lock-keywords-2): Add with-eval-after-load.
-
-2013-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
- Daniel Hackney <dan@haxney.org>
-
- * emacs-lisp/package.el: Use tar-mode rather than tar executable.
- Consolidate the single-file vs tarball code.
- (package-desc-suffix): New function.
- (package-desc-full-name): Don't bother inlining it.
- (package-load-descriptor): Return the new package-desc.
- (package-mark-obsolete): Remove unused arg `package'.
- (package-unpack): Make it work for single files as well.
- Make it update package-alist.
- (package--make-autoloads-and-stuff): Rename from
- package--make-autoloads-and-compile. Don't compile any more.
- (package--compile): New function.
- (package-generate-description-file): New function, extracted from
- package-unpack-single.
- (package-unpack-single): Remove.
- (package--with-work-buffer): Add indentation and debugging info.
- (package-download-single): Remove.
- (package-install-from-archive): Rename from package-download-tar, make
- it take a pkg-desc, and make it work for single files as well.
- (package-download-transaction): Simplify.
- (package-tar-file-info): Remove `file' arg. Rewrite not to use an
- external tar program.
- (package-install-from-buffer): Remove `pkg-desc' argument.
- Use package-tar-file-info for tar-mode buffers.
- (package-install-file): Simplify accordingly.
- (package-archive-base): Change to take a pkg-desc.
- * tar-mode.el (tar--check-descriptor): New function, extracted from
- tar-get-descriptor.
- (tar-get-descriptor): Use it.
- (tar-get-file-descriptor): New function.
- (tar--extract): New function, extracted from tar-extract.
- (tar--extract): Use it.
- * emacs-lisp/package-x.el (package-upload-file): Decode the file, in
- case the summary uses non-ascii. Adjust to new calling convention of
- package-tar-file-info.
-
-2013-06-21 Leo Liu <sdl.web@gmail.com>
-
- * comint.el (comint-redirect-results-list-from-process):
- Fix random delay. (Bug#14681)
-
-2013-06-21 Juanma Barranquero <lekktu@gmail.com>
-
- * profiler.el (profiler-format-number): Use log, not log10.
-
-2013-06-20 Juanma Barranquero <lekktu@gmail.com>
-
- * term/x-win.el (emacs-session-filename): Use `locate-user-emacs-file'.
-
-2013-06-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/cl-loaddefs.el: Don't version-control any more.
- * emacs-lisp/cl-lib.el: Load cl-macs when cl-loaddefs is not
- yet available.
- * Makefile.in (AUTOGEN_VCS): Move cl-loaddefs.el...
- (AUTOGENEL): ... here.
- * emacs-lisp/cl-macs.el (cl--sublis): New function.
- (cl--defsubst-expand): Use it.
-
-2013-06-20 Paul Eggert <eggert@cs.ucla.edu>
-
- * subr.el (log10): Move here from C code, and declare as obsolete.
- All uses of (log10 X) replaced with (log X 10).
-
-2013-06-20 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/tabulated-list.el (tabulated-list-format): Fix typo.
- Declare with `defvar-local'.
- (tabulated-list-use-header-line, tabulated-list-entries)
- (tabulated-list-padding, tabulated-list-printer)
- (tabulated-list-sort-key): Declare with `defvar-local'.
- (tabulated-list-init-header, tabulated-list-print-fake-header):
- Use `setq-local'.
-
-2013-06-20 Michael Albinus <michael.albinus@gmx.de>
-
- * arc-mode.el (archive-mode): Add `archive-write-file' to
- `write-contents-functions' also for remote files. (Bug#14652)
-
-2013-06-20 Juanma Barranquero <lekktu@gmail.com>
-
- * cus-edit.el (custom-commands): Fix typos.
- (custom-display): Fix tooltip text.
- (custom-magic-alist, custom-filter-face-spec, custom-group-members):
- Fix typos in docstrings.
- (custom--initialize-widget-variables, Custom-mode): Use `setq-local'.
- (custom-unlispify-menu-entry, custom-magic-value-create)
- (custom-add-see-also, custom-group-value-create): Use ?\s.
- (custom-guess-type, customize-apropos, editable-field)
- (custom-face-value-create): Use `string-match-p'.
- (custom-save-variables, custom-save-faces): Use `looking-at-p'.
-
- * custom.el (custom-load-symbol): Use `string-match-p'.
-
- * ansi-color.el: Convert to lexical binding.
- (ansi-colors): Fix URL.
- (ansi-color-context, ansi-color-context-region): Use defvar-local.
- (ansi-color-apply-sequence, ansi-color-map): Fix typos in docstrings.
- (ansi-color-make-color-map): Rename local var ansi-color-map to map.
-
-2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el (eww-process-text-input): Display passwords as asterisks.
-
- * net/shr.el (shr-make-table-1): Protect against invalid column-spans.
-
-2013-06-19 Tom Tromey <tromey@redhat.com>
-
- * net/eww.el (eww-top-url): Remove.
- (eww-home-url, eww-start-url, eww-contents-url): New defvars.
- (eww-render): Set new variables. Don't set eww-top-url.
- (eww-handle-link): Handle "prev", "home", and "contents".
- Downcase the rel text.
- (eww-top-url): Choose best top URL.
-
-2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/eww.el: Rewrite to implement form elements "by hand" instead of
- relying in widget.el. Using widget.el leads to too many
- user interface inconsistencies.
- (eww-self-insert): Implement entering commands in text fields.
- (eww-process-text-input): New function to make text input field editing
- work.
- (eww-submit): Rewrite to use the new-style form methods.
- (eww-select-display): Display the correct selected item.
- (eww-change-select): Implement changing the select value.
- (eww-toggle-checkbox): Implement radio/checkboxes.
- (eww-update-field): Fix compilation error.
- (eww-tag-textarea): Implement <textarea>.
-
- * net/shr.el (shr-urlify): Use `keymap' instead of `local-map' so that
- we don't shadow mode-specific bindings.
-
- * net/eww.el (eww-browse-url): Don't push stuff onto history if there's
- nothing to push.
-
- * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs.
-
-2013-06-19 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more.
-
-2013-06-19 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-adb.el (tramp-adb-get-toolbox): Remove function, it is
- not needed.
-
- * net/tramp-sh.el (tramp-find-shell): Don't set "busybox" property.
-
-2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/browse-url.el (browse-url-browser-function):
- `eww-browse-url' has the right calling signature, `eww' does not.
-
-2013-06-19 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/bytecomp.el (byte-compile-file-form-autoload):
- Only eval autoloaded macros.
- (byte-compile-autoload): Only give the macro warning for macros.
-
- * progmodes/cperl-mode.el (ps-bold-faces, ps-italic-faces)
- (ps-underlined-faces): Declare.
-
- * progmodes/idlwave.el (func-menu): Only set it up on XEmacs.
- (speedbar-add-supported-extension): Declare.
-
- * international/titdic-cnv.el (tit-process-header, miscdic-convert):
- Don't include a date stamp in the header of the generated file;
- it leads to needless differences between output files.
-
-2013-06-19 Michael Albinus <michael.albinus@gmx.de>
-
- * net/secrets.el (secrets-struct-secret-content-type):
- Replace check of introspection data by a test call of "CreateItem".
- Some servers do not offer introspection.
-
-2013-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * electric.el (electric-pair-mode): Improve interaction with
- electric-layout-mode.
- (electric-pair-default-inhibit): Don't assume (eq char (char-before)).
- (electric-pair-syntax): Use text-mode-syntax-table in comments
- and strings.
- (electric-pair--insert): New function.
- (electric-pair-post-self-insert-function): Use it and
- electric--after-char-pos.
-
-2013-06-19 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-help): Fix regexp.
-
-2013-06-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/shr.el (shr-make-table-1): Implement <td rowspan>.
- (shr-table-horizontal-line): Allow nil as a value, and change the
- default.
- (shr-insert-table-ruler): Respect the nil value.
-
-2013-06-18 Tom Tromey <tromey@barimba>
-
- * net/eww.el (eww-next-url, eww-previous-url, eww-up-url, eww-top-url):
- New defvars.
- (eww-open-file): New defun.
- (eww-render): Initialize new variables.
- (eww-display-html): Handle "link" and "a".
- (eww-handle-link, eww-tag-link, eww-tag-a): New defuns.
- (eww-mode-map): Move "p" to "l". Bind "p", "n", "t", and "u".
- (eww-back-url): Rename from eww-previous-url.
- (eww-next-url, eww-previous-url, eww-up-url, eww-top-url):
- New defuns.
-
-2013-06-18 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
- Distinguish ternary operator tokens from slash symbol and slash
- char literal.
-
-2013-06-18 Juanma Barranquero <lekktu@gmail.com>
-
- Convert symbol prettification into minor mode and global minor mode.
-
- * progmodes/prog-mode.el (prettify-symbols-alist): Rename from
- `prog-prettify-symbols', and make a local defvar instead of defcustom.
- (prettify-symbols--keywords): Rename from
- `prog-prettify-symbols-alist' and make a local defvar.
- (prettify-symbols--compose-symbol): Rename from
- `prog--prettify-font-lock-compose-symbol'.
- (prettify-symbols--make-keywords): Rename from
- `prog-prettify-font-lock-symbols-keywords' and simplify.
- (prog-prettify-install): Remove.
- (prettify-symbols-mode): New minor mode, based on
- `prog-prettify-install'.
- (turn-on-prettify-symbols-mode): New function.
- (global-prettify-symbols-mode): New globalized minor mode.
-
- * emacs-lisp/lisp-mode.el (lisp-mode-variables):
- * progmodes/cfengine.el (cfengine3-mode):
- * progmodes/perl-mode.el (perl-mode): Don't call
- `prog-prettify-install'; set `prettify-symbols-alist' instead.
-
-2013-06-18 Juri Linkov <juri@jurta.org>
-
- * files-x.el (modify-file-local-variable-message): New function.
- (modify-file-local-variable)
- (modify-file-local-variable-prop-line): Add arg INTERACTIVE
- and call `modify-file-local-variable-message' when it's non-nil.
- (add-file-local-variable, delete-file-local-variable)
- (add-file-local-variable-prop-line)
- (delete-file-local-variable-prop-line): Add arg INTERACTIVE
- and use it. (Bug#9820)
-
-2013-06-18 Juri Linkov <juri@jurta.org>
-
- * emulation/vi.el (vi-shell-op):
- * emulation/vip.el (vip-execute-com, ex-command):
- * emulation/viper-cmd.el (viper-exec-bang):
- * emulation/viper-ex.el (ex-command): Add non-nil arg REPLACE to
- the call of `shell-command-on-region'. (Bug#14637)
-
- * simple.el (shell-command-on-region): Doc fix.
-
-2013-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/eieio-custom.el: Remove misleading Version: header
- (bug#14633).
-
-2013-06-18 Glenn Morris <rgm@gnu.org>
-
- * net/eww.el, net/shr.el, net/shr-color.el: Move here from gnus/.
-
- * newcomment.el (comment-search-forward, comment-search-backward):
- Doc fix. (Bug#14376)
-
-2013-06-18 Juanma Barranquero <lekktu@gmail.com>
-
- * face-remap.el (buffer-face-toggle): Fix typo in docstring.
- (buffer-face-mode-invoke): Doc fix.
-
-2013-06-18 Matthias Meulien <orontee@gmail.com>
-
- * tabify.el (untabify, tabify): With prefix, apply to entire buffer.
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00545.html>
-
-2013-06-18 Glenn Morris <rgm@gnu.org>
-
- * generic-x.el (bat-generic-mode, rc-generic-mode, rul-generic-mode):
- Replace obsolete function generic-make-keywords with its expansion.
-
- * progmodes/python.el (ffap-alist): Declare.
-
- * textmodes/reftex.el (bibtex-mode-map): Declare.
-
-2013-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el: Update package-alist after install (bug#14632).
- (package-unpack, package-unpack-single): Return the pkg-dir.
- (package-download-transaction): Use it to update package-alist.
-
-2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * net/browse-url.el (browse-url-browser-function): Add `eww' as a
- possible choice.
-
-2013-06-17 Juri Linkov <juri@jurta.org>
-
- * net/webjump.el (webjump-sample-sites): Add DuckDuckGo.
-
-2013-06-17 Dmitry Gutov <dgutov@yandex.ru>
-
- * emacs-lisp/package.el (package-load-descriptor):
- Remove `with-syntax-table' call, `read' doesn't need it.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00539.html
-
-2013-06-17 Juanma Barranquero <lekktu@gmail.com>
-
- * startup.el (command-line): Expand package name returned by
- `package--description-file' (bug#14639).
-
-2013-06-17 Dmitry Gutov <dgutov@yandex.ru>
-
- * emacs-lisp/package.el (package-load-descriptor): Do not call
- `emacs-lisp-mode', just use its syntax table.
-
-2013-06-17 Juanma Barranquero <lekktu@gmail.com>
-
- * progmodes/prog-mode.el (prog-prettify-install): Add `composition' to
- `font-lock-extra-managed-props' if any prettifying keyword is added.
- (prog--prettify-font-lock-compose-symbol): Use ?\s instead of ?\ .
- (prog-mode): Use `setq-local'.
-
-2013-06-17 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * international/characters.el (standard-case-table): Set syntax of ?»
- and ?« to punctuation.
-
-2013-06-16 Juanma Barranquero <lekktu@gmail.com>
-
- * progmodes/prog-mode.el (prog--prettify-font-lock-compose-symbol):
- Save relevant match data before calling `syntax-ppss' (bug#14595).
-
-2013-06-15 Juri Linkov <juri@jurta.org>
-
- * files-x.el (modify-file-local-variable-prop-line): Add local
- variables to the end of the existing comment on the first line.
- Use `file-auto-mode-skip' to skip interpreter magic line,
- and also skip XML declaration.
-
-2013-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * startup.el (package--builtin-versions): New var.
- (package-subdirectory-regexp): Remove.
- (package--description-file): Hard code its value instead.
-
- * emacs-lisp/package.el: Don't activate packages older than builtin.
- (package-obsolete-list): Rename from package-obsolete-alist, and make
- it into a simple list of package-desc.
- (package-strip-version): Remove.
- (package-built-in-p): Use package--builtin-versions.
- (package-mark-obsolete): Simplify.
- (package-process-define-package): Mark it obsolete if older than the
- builtin version.
- (package-handle-response): Use line-end-position.
- (package-read-archive-contents, package--download-one-archive):
- Simplify.
- (package--add-to-archive-contents): Skip if older than the builtin or
- installed version.
- (package-menu-describe-package): Fix last change.
- (package-list-unversioned): New var.
- (package-menu--generate): Use it.
-
- * emacs-lisp/autoload.el: Manage package--builtin-versions.
- (autoload--insert-text, autoload--insert-cookie-text): New functions.
- (autoload-builtin-package-versions): New variable.
- (autoload-generate-file-autoloads): Use them.
- Remove the list of autoloaded functions/macros from the
- (autoload...) comments.
-
- * Makefile.in (autoloads): Set autoload-builtin-package-versions.
-
-2013-06-15 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (line-move-partial): Don't jump to the next screen
- line as soon as it becomes visible. Instead, continue enlarging
- the vscroll until the portion of a tall screen line that's left on
- display is about the height of the frame's default font.
- (Bug#14567)
-
-2013-06-15 Glenn Morris <rgm@gnu.org>
-
- * vc/vc-dispatcher.el (vc-compilation-mode): Avoid making
- compilation-error-regexp-alist void, or local while let-bound.
-
- * progmodes/make-mode.el (makefile-mode-syntax-table):
- Treat "=" as punctuation. (Bug#14614)
-
-2013-06-15 Juanma Barranquero <lekktu@gmail.com>
-
- * help-fns.el (describe-variable):
- Add extra line for permanent-local variables.
-
-2013-06-15 Simen Heggestøyl <simenheg@ifi.uio.no> (tiny change)
-
- * progmodes/scheme.el (scheme-font-lock-keywords-2):
- Add export, import, library. (Bug#9164)
- (library): Set indent function.
-
-2013-06-14 Glenn Morris <rgm@gnu.org>
-
- * term/xterm.el (xterm--query):
- Stop after first matching handler. (Bug#14615)
-
-2013-06-14 Ivan Kanis <ivan@kanis.fr>
-
- Add support for dired in saveplace.
- * dired.el (dired-initial-position-hook): New variable.
- (dired-initial-position): Call hook to place cursor position.
- * saveplace.el (save-place-to-alist): Add dired position.
- (save-place-dired-hook): New function.
-
-2013-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (eval-after-load, set-temporary-overlay-map): Use indirection
- through a symbol rather than letrec.
-
- * emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more.
- (package-desc): Add `dir' field.
- (package-desc-full-name): New function.
- (package-load-descriptor): Combine the two arguments. Don't use `load'.
- (package-maybe-load-descriptor): Remove.
- (package-load-all-descriptors): Just call package-load-descriptor.
- (package--disabled-p): New function.
- (package-desc-vers, package-desc-doc): Remove aliases.
- (package--dir): Remove function.
- (package-activate): Check if a package is disabled.
- (package-process-define-package): New function, extracted from
- define-package.
- (define-package): Turn into a place holder.
- (package-unpack-single, package-tar-file-info):
- Use package--description-file.
- (package-compute-transaction): Use package--disabled-p.
- (package-download-transaction): Don't call
- package-maybe-load-descriptor since they're all loaded anyway.
- (package-install): Change argument to be a pkg-desc.
- (package-delete): Use a single pkg-desc argument.
- (describe-package-1): Use package-desc-dir instead of package--dir.
- Use package-desc property instead of package-symbol.
- (package-install-button-action): Adjust accordingly.
- (package--push): Rewrite.
- (package-menu--print-info): Adjust accordingly. Change the ID format
- to be a pkg-desc.
- (package-menu-describe-package, package-menu-get-status)
- (package-menu--find-upgrades, package-menu-mark-upgrades)
- (package-menu-execute, package-menu--name-predicate):
- Adjust accordingly.
- * startup.el (package--description-file): New function.
- (command-line): Use it.
- * emacs-lisp/package-x.el (package-upload-buffer-internal):
- Use package-desc-version.
-
- * emacs-lisp/bytecomp.el (byte-compile-force-lexical-warnings): New var.
- (byte-compile-preprocess): Use it.
- (byte-compile-file-form-defalias): Try a bit harder to use macros we
- can't quite recognize.
- (byte-compile-add-to-list): Remove.
- * emacs-lisp/cconv.el (cconv-warnings-only): New function.
- (cconv-closure-convert): Add assertion.
-
- * emacs-lisp/map-ynp.el: Use lexical-binding.
- (map-y-or-n-p): Remove unused vars `tail' and `object'.
- Factor out some repeated code.
-
-2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (with-eval-after-load): New macro.
- (eval-after-load): Allow form to be a function.
- take advantage of lexical-binding.
- (do-after-load-evaluation): Use dolist and adjust to new format.
- * simple.el (bad-packages-alist): Use dolist and with-eval-after-load.
-
-2013-06-13 Juri Linkov <juri@jurta.org>
-
- * replace.el (perform-replace): Display "symbol " and other search
- modes from `isearch-message-prefix' in the *Help* buffer.
-
- * isearch.el (isearch-query-replace): Add " symbol" and other
- possible search modes from `isearch-message-prefix' to the prompt.
- (isearch-occur): Use `with-isearch-suspended' to not exit Isearch
- when reading a regexp to collect.
-
-2013-06-13 Juri Linkov <juri@jurta.org>
-
- * isearch.el (word-search-regexp): Match whitespace if the search
- string begins or ends in whitespace. The LAX arg is applied to
- both ends of the search string. Use `regexp-quote' and explicit
- \< and \> instead of \b. Use \` and \' instead of ^ and $.
- (isearch-symbol-regexp): Sync with `word-search-regexp' where word
- boundaries are replaced with symbol boundaries, and characters
- between symbols match non-word non-symbol syntax. (Bug#14602)
-
-2013-06-13 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-del-char): Don't exceed the length of
- `isearch-string' by the prefix arg. (Bug#14563)
-
-2013-06-13 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-yank-word, isearch-yank-line)
- (isearch-char-by-name, isearch-quote-char)
- (isearch-printing-char, isearch-process-search-char):
- Add optional count prefix arg. (Bug#14563)
-
- * international/isearch-x.el
- (isearch-process-search-multibyte-characters):
- Add optional count prefix arg.
-
-2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (internal-push-keymap, internal-pop-keymap): New functions.
- (set-temporary-overlay-map): Use them (bug#14095); and take advantage of
- lexical-binding.
-
-2013-06-13 Vitalie Spinu <spinuvit@gmail.com>
-
- * subr.el (set-temporary-overlay-map): Add on-exit argument.
-
-2013-06-13 Glenn Morris <rgm@gnu.org>
-
- * startup.el (tty-handle-args):
- Don't just discard "--" and anything after. (Bug#14608)
-
- * emacs-lisp/lisp.el (forward-sexp, backward-sexp): Doc fixes.
-
-2013-06-13 Michael Albinus <michael.albinus@gmx.de>
-
- Implement changes in Secret Service API. Make it backward compatible.
- * net/secrets.el (secrets-struct-secret-content-type): New defonst.
- (secrets-create-item): Use it. Prefix properties with interface.
-
-2013-06-13 Michael Hoffman <9qobl2n02@sneakemail.com> (tiny change)
-
- * term.el (term-suppress-hard-newline): New option. (Bug#12017)
- (term-emulate-terminal): Respect term-suppress-hard-newline.
-
-2013-06-13 E Sabof <esabof@gmail.com> (tiny change)
-
- * image-dired.el (image-dired-dired-toggle-marked-thumbs):
- Only remove a `thumb-file' overlay. (Bug#14548)
-
-2013-06-12 Grégoire Jadi <daimrod@gmail.com>
-
- * mail/reporter.el (reporter-submit-bug-report):
- Handle missing package-name. (Bug#14600)
-
-2013-06-12 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * textmodes/reftex-cite.el (reftex-cite-regexp-hist)
- (reftex-citation-prompt, reftex-default-bibliography)
- (reftex-bib-or-thebib, reftex-get-bibfile-list)
- (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries)
- (reftex-bib-sort-author, reftex-bib-sort-year)
- (reftex-bib-sort-year-reverse, reftex-get-crossref-alist)
- (reftex-extract-bib-entries-from-thebibliography)
- (reftex-get-bibkey-default, reftex-get-bib-names)
- (reftex-parse-bibtex-entry, reftex-get-bib-field)
- (reftex-format-bib-entry, reftex-parse-bibitem)
- (reftex-format-bibitem, reftex-do-citation)
- (reftex-figure-out-cite-format, reftex-offer-bib-menu)
- (reftex-restrict-bib-matches, reftex-extract-bib-file)
- (reftex-insert-bib-matches, reftex-format-citation)
- (reftex-make-cite-echo-string, reftex-bibtex-selection-callback)
- (reftex-create-bibtex-file): Add docstrings, mostly by converting
- existing comments into docstrings.
-
-2013-06-12 Xue Fuqiao <xfq.free@gmail.com>
-
- * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix.
-
-2013-06-12 Andreas Schwab <schwab@suse.de>
-
- * international/mule.el (auto-coding-alist): Use utf-8-emacs-unix
- for auto-save files.
-
-2013-06-12 Glenn Morris <rgm@gnu.org>
-
- * ido.el (ido-delete-ignored-files): Remove.
- (ido-wide-find-dirs-or-files, ido-make-file-list-1):
- Go back to calling ido-ignore-item-p directly.
-
-2013-06-12 Eyal Lotem <eyal.lotem@gmail.com> (tiny change)
-
- * ido.el (ido-wide-find-dirs-or-files): Respect ido-case-fold.
-
- * ido.el (ido-delete-ignored-files): New function,
- split from ido-make-file-list-1.
- (ido-wide-find-dirs-or-files): Maybe ignore files. (Bug#13003)
- (ido-make-file-list-1): Use ido-delete-ignored-files.
-
-2013-06-12 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup)
- (inferior-octave-completion-table)
- (inferior-octave-track-window-width-change)
- (octave-eldoc-function-signatures, octave-help)
- (octave-find-definition): Use single quoted strings.
- (inferior-octave-startup-args): Change default value.
- (inferior-octave-startup): Do not hard code "-i" and
- "--no-line-editing".
- (inferior-octave-resync-dirs): Add optional arg NOERROR.
- (inferior-octave-directory-tracker): Use it.
- (octave-goto-function-definition): Robustify.
- (octave-help): Support highlighting operators in 'See also'.
- (octave-find-definition): Find subfunctions only in Octave mode.
-
-2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * help-fns.el (help-fns--compiler-macro): If the handler function is
- named, then put a link to it.
- * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names.
- * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function.
- (cl-typep): Use it.
- (cl-eval-when): Simplify debug spec.
- (cl-define-compiler-macro): Use eval-and-compile. Give a name to the
- compiler-macro function instead of setting `compiler-macro-file'.
-
-2013-06-12 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix.
- * vc/vc-hooks.el (vc-stay-local): Doc fix.
-
-2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
- Daniel Hackney <dan@haxney.org>
-
- First part of Daniel Hackney's patch to package.el.
- * emacs-lisp/package.el: Use defstruct.
- (package-desc): New, main struct.
- (package--bi-desc, package--ac-desc): New structs, used to describe the
- format in external files.
- (package-desc-vers): Replace with package-desc-version accessor.
- (package-desc-doc): Replace with package-desc-summary accessor.
- (package-activate-1): Remove `package' arg since the pkg-vec now
- includes the name.
- (define-package): Use package-desc-from-define.
- (package-unpack-single): Change file-name arg to be a symbol.
- (package--add-to-archive-contents): Use package-desc-create and new
- accessor functions to package--ac-desc.
- (package-buffer-info, package-tar-file-info): Return a package-desc.
- (package-install-from-buffer): Remove `type' argument. Change pkg-info
- arg to be a package-desc.
- (package-install-file): Adjust accordingly. Use \' to match EOS.
- (package--from-builtin): New function.
- (describe-package-1, package-menu--generate): Use it.
- (package--make-autoloads-and-compile): Change name arg to be a symbol.
- (package-generate-autoloads): Idem and return the name of the file.
- * emacs-lisp/package-x.el (package-upload-buffer-internal):
- Change pkg-info arg to be a package-desc.
- Use package-make-ac-desc.
- (package-upload-file): Use \' to match EOS.
- * finder.el (finder-compile-keywords): Use package-make-builtin.
-
-2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * vc/vc.el (vc-deduce-fileset): Change error message.
- (vc-read-backend): New function.
- (vc-next-action): Use it.
-
- * subr.el (function-arity): Remove (mistakenly added) (bug#14590).
-
- * progmodes/prolog.el (prolog-make-keywords-regexp): Remove.
- (prolog-font-lock-keywords): Use regexp-opt instead.
- Don't manually highlight strings.
- (prolog-mode-variables): Simplify comment-start-skip.
- (prolog-consult-compile): Use display-buffer. Remove unused old-filter.
-
- * emacs-lisp/generic.el (generic--normalise-comments)
- (generic-set-comment-syntax, generic-set-comment-vars): New functions.
- (generic-mode-set-comments): Use them.
- (generic-bracket-support): Use setq-local.
- (generic-make-keywords-list): Declare obsolete.
-
-2013-06-11 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/lisp-mode.el (lisp-mode-variables):
- Prettify after setting font-lock-defaults. (Bug#14574)
-
-2013-06-11 Juanma Barranquero <lekktu@gmail.com>
-
- * replace.el (query-replace, occur-read-regexp-defaults-function)
- (replace-search):
- * subr.el (declare-function, number-sequence, local-set-key)
- (substitute-key-definition, locate-user-emacs-file)
- (with-silent-modifications, split-string, eval-after-load):
- Fix typos, remove unneeded backslashes and reflow some docstrings.
-
-2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * international/mule-conf.el (file-coding-system-alist): Use utf-8 as
- default for Elisp files.
-
-2013-06-11 Glenn Morris <rgm@gnu.org>
-
- * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map,
- although define-derived-mode was doing this anyway. (Bug#14583)
-
-2013-06-10 Juanma Barranquero <lekktu@gmail.com>
-
- * allout.el (allout-encryption-plaintext-sanitization-regexps):
- Fix make-variable-buffer-local call to refer to the correct variable.
-
-2013-06-10 Aidan Gauland <aidalgol@amuri.net>
-
- * eshell/em-term.el (eshell-visual-commands)
- (eshell-visual-subcommands, eshell-visual-options):
- Add summary line to docstrings. Add cross-references.
-
-2013-06-10 Glenn Morris <rgm@gnu.org>
-
- * epa.el (epa-read-file-name): New function. (Bug#14510)
- (epa-decrypt-file): Make plain-file optional. Use epa-read-file-name.
-
-2013-06-09 Aidan Gauland <aidalgol@amuri.net>
-
- * eshell/em-term.el (eshell-visual-command-p): Fix bug that caused
- output redirection to be ignored with visual commands.
-
-2013-06-09 Aidan Gauland <aidalgol@amuri.net>
-
- * eshell/em-term.el (eshell-visual-command-p): New function.
- (eshell-term-initialize): Move long lambda to separate function
- eshell-visual-command-p.
- * eshell/em-dirs.el (eshell-dirs-initialise):
- * eshell/em-script.el (eshell-script-initialize):
- Add missing #' to lambda.
-
-2013-06-08 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-add-log-current-defun): New function.
- (octave-mode): Set add-log-current-defun-function.
- (octave-goto-function-definition): Do not move point if not found.
- (octave-find-definition): Enhance to try subfunctions first.
-
-2013-06-08 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/bytecomp.el (byte-compile-char-before)
- (byte-compile-backward-char, byte-compile-backward-word):
- Improve previous change, to handle non-explicit nil.
-
-2013-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/smie.el: Improve show-paren-mode behavior.
- (smie--opener/closer-at-point): New function.
- (smie--matching-block-data): Use it. Don't match from right after an
- opener or right before a closer. Obey smie-blink-matching-inners.
- Don't signal a mismatch for repeated inners like "switch..case..case".
-
-2013-06-07 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-mode): Set comment-use-global-state
- to t. (Bug#14303)
- (octave-function-header-regexp): Fix. (Bug#14570)
- (octave-help-mode-finish-hook, octave-help-mode-finish):
- Remove. Just use temp-buffer-show-hook.
-
- * newcomment.el (comment-search-backward): Revert last change.
- (Bug#14434)
-
- * emacs-lisp/smie.el (smie--matching-block-data): Minor simplification.
-
-2013-06-07 Eli Zaretskii <eliz@gnu.org>
-
- * Makefile.in (TAGS TAGS-LISP): Pass the (long) list of *.el files
- through xargs, to avoid failure due to MS-Windows limitations on
- command-line length.
-
-2013-06-06 Glenn Morris <rgm@gnu.org>
-
- * font-lock.el (lisp-font-lock-keywords-2):
- Treat user-error like error.
-
- * emacs-lisp/bytecomp.el (byte-compile-char-before)
- (byte-compile-backward-char, byte-compile-backward-word):
- Handle explicit nil arguments. (Bug#14565)
-
-2013-06-05 Alan Mackenzie <acm@muc.de>
-
- * isearch.el (isearch-allow-prefix): New user option.
- (isearch-other-meta-char): Don't exit isearch when a prefix
- argument is typed whilst `isearch-allow-prefix' is non-nil.
- (Bug#9706)
-
-2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * autorevert.el (auto-revert-notify-handler): Use memq.
- Hide assertion failure.
-
- * skeleton.el: Use cl-lib.
- (skeleton-further-elements): Use defvar-local.
- (skeleton-insert): Use cl-progv.
-
-2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/prog-mode.el (prog-prettify-symbols)
- (prog-prettify-install): Update docstrings.
-
-2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * simple.el: Move all the prog-mode code to prog-mode.el.
- * progmodes/prog-mode.el: New file.
- * loadup.el: Add prog-mode.el.
-
-2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * simple.el (prog-prettify-symbols): Add version.
- (prog-prettify-install): Add convenience function to prettify symbols.
-
- * progmodes/perl-mode.el (perl--augmented-font-lock-keywords)
- (perl--augmented-font-lock-keywords-1)
- (perl--augmented-font-lock-keywords-2, perl-mode): Remove unneeded
- variables and use it.
-
- * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
- (cfengine3-mode): Remove unneeded variable and use it.
-
- * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
- (lisp--augmented-font-lock-keywords-1)
- (lisp--augmented-font-lock-keywords-2, lisp-mode-variables):
- Remove unneeded variables and use it.
-
-2013-06-05 João Távora <joaotavora@gmail.com>
-
- * net/tls.el (open-tls-stream): Remove unneeded buffer contents up
- to point when opening the connection. (Bug#14380)
-
-2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (load-history-regexp, load-history-filename-element)
- (eval-after-load, after-load-functions, do-after-load-evaluation)
- (eval-next-after-load, display-delayed-warnings)
- (collapse-delayed-warnings, delayed-warnings-hook): Move after the
- definition of save-match-data.
- (overriding-local-map): Remove accidental obsolescence declaration.
-
- * emacs-lisp/edebug.el (edebug-result): Move before first use.
-
-2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- Generalize symbol prettify support to prog-mode and implement it
- for perl-mode, cfengine3-mode, and emacs-lisp-mode.
- * simple.el (prog-prettify-symbols-alist, prog-prettify-symbols)
- (prog--prettify-font-lock-compose-symbol)
- (prog-prettify-font-lock-symbols-keywords): New variables and
- functions to support symbol prettification.
- * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
- (lisp--augmented-font-lock-keywords-1)
- (lisp--augmented-font-lock-keywords-2, lisp-mode-variables)
- (lisp--prettify-symbols-alist): Implement prettify of lambda.
- * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
- (cfengine3--prettify-symbols-alist, cfengine3-mode):
- Implement prettify of -> => :: strings.
- * progmodes/perl-mode.el (perl-prettify-symbols)
- (perl--font-lock-compose-symbol)
- (perl--font-lock-symbols-keywords): Move to prog-mode.
- (perl--prettify-symbols-alist): Prettify -> => :: strings.
- (perl-font-lock-keywords-1)
- (perl-font-lock-keywords-2): Remove explicit prettify support.
- (perl--augmented-font-lock-keywords)
- (perl--augmented-font-lock-keywords-1)
- (perl--augmented-font-lock-keywords-2, perl-mode):
- Implement prettify support.
-
-2013-06-05 Leo Liu <sdl.web@gmail.com>
-
- Re-implement smie matching block highlight using
- show-paren-data-function. (Bug#14395)
- * emacs-lisp/smie.el (smie-matching-block-highlight)
- (smie--highlight-matching-block-overlay)
- (smie--highlight-matching-block-lastpos)
- (smie-highlight-matching-block)
- (smie-highlight-matching-block-mode): Remove.
- (smie--matching-block-data-cache): New variable.
- (smie--matching-block-data): New function.
- (smie-setup): Use smie--matching-block-data for
- show-paren-data-function.
-
- * progmodes/octave.el (octave-mode-menu): Fix.
- (octave-find-definition): Skip garbage lines.
-
-2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- Fix compilation error with simultaneous dynamic+lexical scoping.
- Add warning when a defvar appears after the first let-binding.
- * emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var.
- (byte-compile-close-variables): Initialize it.
- (byte-compile--declare-var): New function.
- (byte-compile-file-form-defvar)
- (byte-compile-file-form-define-abbrev-table)
- (byte-compile-file-form-custom-declare-variable): Use it.
- (byte-compile-make-lambda-lexenv): Change the argument. Simplify.
- (byte-compile-lambda): Share call to byte-compile-arglist-vars.
- (byte-compile-bind): Handle dynamic bindings that shadow
- lexical bindings.
- (byte-compile-unbind): Make arg non-optional.
- (byte-compile-let): Simplify.
- * emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var.
- (cconv--analyse-function, cconv-analyse-form): Populate it.
- Protect byte-compile-bound-variables to limit the scope of defvars.
- (cconv-analyse-form): Add missing rule for (defvar <foo>).
- Remove unneeded rule for `declare'.
-
- * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2
- so as to avoid depending on cl-adjoin at run-time.
- * emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes.
-
- * emacs-lisp/macroexp.el (macroexp--compiling-p): New function.
- (macroexp--warn-and-return): Use it.
-
-2013-06-05 Leo Liu <sdl.web@gmail.com>
-
- * eshell/esh-mode.el (eshell-mode): Fix key bindings.
-
-2013-06-04 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/compile.el (compile-goto-error): Add optional arg NOMSG.
- (compilation-auto-jump): Suppress the "Mark set" message to give
- way to exit message.
-
-2013-06-04 Alan Mackenzie <acm@muc.de>
-
- Remove faulty optimisation from indentation calculation.
- * progmodes/cc-engine.el (c-guess-basic-syntax): Don't calculate
- search limit based on 2000 characters back from indent-point.
-
-2013-06-03 Tassilo Horn <tsdh@gnu.org>
-
- * eshell/em-term.el (cl-lib): Require `cl-lib'.
-
-2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/lisp.el: Use lexical-binding.
- (lisp--local-variables-1, lisp--local-variables): New functions.
- (lisp--local-variables-completion-table): New var.
- (lisp-completion-at-point): Use it complete let-bound vars.
-
- * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros
- eagerly (bug#14422).
-
-2013-06-03 Michael Albinus <michael.albinus@gmx.de>
-
- * autorevert.el (auto-revert-notify-enabled)
- (auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
- (auto-revert-notify-event-p, auto-revert-notify-event-file-name)
- (auto-revert-notify-handler): Handle also gfilenotify.
-
- * subr.el (file-notify-handle-event): New defun. Replacing ...
- (inotify-event-p, inotify-handle-event, w32notify-handle-event):
- Remove.
-
-2013-06-03 Juri Linkov <juri@jurta.org>
-
- * bindings.el (search-map): Bind `highlight-symbol-at-point' to
- `M-s h .'. (Bug#14427)
-
- * hi-lock.el (highlight-symbol-at-point): New alias for the new
- command `hi-lock-face-symbol-at-point'.
- (hi-lock-face-symbol-at-point): New command.
- (hi-lock-map): Bind `highlight-symbol-at-point' to `C-x w .'.
- (hi-lock-menu): Add `highlight-symbol-at-point'.
- (hi-lock-mode): Doc fix.
-
- * isearch.el (isearch-forward-symbol-at-point): New command.
- (search-map): Bind `isearch-forward-symbol-at-point' to `M-s .'.
- (isearch-highlight-regexp): Add a regexp which matches
- words/symbols for word/symbol mode.
-
- * subr.el (find-tag-default-bounds): New function with the body
- mostly moved from `find-tag-default'.
- (find-tag-default): Move most code to `find-tag-default-bounds',
- call it and apply `buffer-substring-no-properties' afterwards.
-
-2013-06-03 Tassilo Horn <tsdh@gnu.org>
-
- * eshell/em-term.el (eshell-term-initialize):
- Use `cl-intersection' rather than `intersection'.
-
-2013-06-02 Xue Fuqiao <xfq.free@gmail.com>
-
- * vc/log-view.el: Doc fix.
- (log-view-mode-map): Copy keymap from `special-mode-map'.
-
-2013-06-02 Eric Ludlam <zappo@gnu.org>
-
- * emacs-lisp/eieio.el (eieio--defalias, eieio-hook)
- (eieio-error-unsupported-class-tags, eieio-skip-typecheck)
- (eieio-optimize-primary-methods-flag, eieio-initializing-object)
- (eieio-unbound, eieio-default-superclass)
- (eieio--define-field-accessors, method-static, method-before)
- (method-primary, method-after, method-num-lists)
- (method-generic-before, method-generic-primary)
- (method-generic-after, method-num-slots)
- (eieio-specialized-key-to-generic-key)
- (eieio--check-type, class-v, class-p)
- (eieio-class-name, define-obsolete-function-alias)
- (eieio-class-parents-fast, eieio-class-children-fast)
- (same-class-fast-p, class-constructor, generic-p)
- (generic-primary-only-p, generic-primary-only-one-p)
- (class-option-assoc, class-option, eieio-object-p)
- (class-abstract-p, class-method-invocation-order)
- (eieio-defclass-autoload-map, eieio-defclass-autoload)
- (eieio-class-un-autoload, eieio-defclass)
- (eieio-eval-default-p, eieio-perform-slot-validation-for-default)
- (eieio-add-new-slot, eieio-copy-parents-into-subclass)
- (eieio--defgeneric-init-form, eieio-defgeneric-form)
- (eieio-defgeneric-reset-generic-form)
- (eieio-defgeneric-form-primary-only)
- (eieio-defgeneric-reset-generic-form-primary-only)
- (eieio-defgeneric-form-primary-only-one)
- (eieio-defgeneric-reset-generic-form-primary-only-one)
- (eieio-unbind-method-implementations)
- (eieio--defmethod, eieio--typep)
- (eieio-perform-slot-validation, eieio-validate-slot-value)
- (eieio-validate-class-slot-value, eieio-barf-if-slot-unbound)
- (eieio-oref, eieio-oref-default, eieio-default-eval-maybe)
- (eieio-oset, eieio-oset-default, eieio-slot-originating-class-p)
- (eieio-slot-name-index, eieio-class-slot-name-index)
- (eieio-set-defaults, eieio-initarg-to-attribute)
- (eieio-attribute-to-initarg, eieio-c3-candidate)
- (eieio-c3-merge-lists, eieio-class-precedence-c3)
- (eieio-class-precedence-dfs, eieio-class-precedence-bfs)
- (eieio-class-precedence-list, eieio-generic-call-methodname)
- (eieio-generic-call-arglst, eieio-generic-call-key)
- (eieio-generic-call-next-method-list)
- (eieio-pre-method-execution-functions, eieio-generic-call)
- (eieio-generic-call-primary-only, eieiomt-method-list)
- (eieiomt-optimizing-obarray, eieiomt-install)
- (eieiomt-add, eieiomt-next, eieiomt-sym-optimize)
- (eieio-generic-form, eieio-defmethod, make-obsolete)
- (eieio-defgeneric, make-obsolete): Move to eieio-core.el.
- (defclass): Remove `eval-and-compile' from macro.
- (call-next-method, shared-initialize): Instead of using
- `scoped-class' variable, use new eieio--scoped-class, and
- eieio--with-scoped-class.
- (initialize-instance): Rename local variable 'scoped-class' to
- 'this-class' to remove ambiguitity from old global.
-
- * emacs-lisp/eieio-core.el: New file. Derived from key parts of
- eieio.el.
- (eieio--scoped-class-stack): New variable.
- (eieio--scoped-class): New fcn.
- (eieio--with-scoped-class): New scoping macro.
- (eieio-defclass): Use pushnew instead of add-to-list.
- (eieio-defgeneric-form-primary-only-one, eieio-oset-default)
- (eieio-slot-name-index, eieio-set-defaults, eieio-generic-call)
- (eieio-generic-call-primary-only, eieiomt-add): Instead of using
- `scoped-class' variable, use new eieio--scoped-class, and
- eieio--with-scoped-class.
-
- * emacs-lisp/eieio-base.el (cl-lib): Require during compile.
-
-2013-06-02 Tassilo Horn <tsdh@gnu.org>
-
- * eshell/esh-ext.el (eshell-external-command): Pass args to
- `eshell-find-interpreter'.
- (eshell-find-interpreter): Add new second parameter ARGS.
-
- * eshell/em-script.el (eshell-script-initialize): Add second arg
- to the function added as MATCH to `eshell-interpreter-alist'.
-
- * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to
- the function added as MATCH to `eshell-interpreter-alist'.
-
- * eshell/em-term.el (eshell-visual-subcommands): New defcustom.
- (eshell-visual-options): New defcustom.
- (eshell-escape-control-x): Adapt docstring.
- (eshell-term-initialize): Test `eshell-visual-subcommands' and
- `eshell-visual-options' in addition to `eshell-visual-commands'.
- (eshell-exec-visual): Pass args to `eshell-find-interpreter'.
-
-2013-06-01 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- * progmodes/python.el (python-indent-block-enders): Add break,
- continue and raise keywords.
-
-2013-06-01 Glenn Morris <rgm@gnu.org>
-
- * pcmpl-gnu.el (pcomplete/tar): Check obsolete variable is bound.
-
- Plain (f)boundp silences compilation warnings since Emacs 22.1.
- * progmodes/cc-cmds.el (delete-forward-p):
- * progmodes/cc-defs.el (buffer-syntactic-context-depth):
- * progmodes/cc-engine.el (buffer-syntactic-context):
- * progmodes/cc-fonts.el (face-property-instance):
- * progmodes/cc-mode.el (set-keymap-parents):
- * progmodes/cc-vars.el (get-char-table): No need for cc-bytecomp-defun.
- * 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.
-
- * progmodes/cc-vars.el (other): Emacs has this widget since
- at least 21.1, so don't (re)define it.
-
- * eshell/em-cmpl.el (eshell-cmpl-initialize):
- Replace the obsolete alias pcomplete-arg-quote-list.
-
-2013-06-01 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-mode-syntax-table): Give `.'
- punctuation syntax.
- (inferior-octave-minimal-columns)
- (inferior-octave-last-column-width): New variables.
- (inferior-octave-track-window-width-change): New function.
- (inferior-octave-mode): Adjust column width so that Octave output,
- for example from 'ls', can fit into the window nicely.
-
-2013-05-31 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p):
- Highlight expansions inside regexp literals.
-
-2013-05-31 Glenn Morris <rgm@gnu.org>
-
- * obsolete/sym-comp.el (symbol-complete):
- Replace obsolete completion-annotate-function.
-
- * progmodes/cc-vars.el (c-make-macro-with-semi-re): Silence compiler.
-
-2013-05-31 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p):
- New function, checks if point is inside a literal that allows
- expression expansion.
- (ruby-syntax-propertize-expansion): Use it.
- (ruby-syntax-propertize-function): Bind `case-fold-search' to nil
- around the body.
-
-2013-05-30 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-mode-map): Bind `isearch-toggle-invisible'
- to "\M-si".
- (isearch-invisible): New variable.
- (isearch-forward): Doc fix.
- (isearch-mode): Set `isearch-invisible'
- to the value of `search-invisible'.
- (isearch-toggle-case-fold): Doc fix.
- (isearch-toggle-invisible): New command.
- (isearch-query-replace): Let-bind `search-invisible'
- to the value of `isearch-invisible'.
- (isearch-search): Use `isearch-invisible' instead of
- `search-invisible'. Let-bind `search-invisible'
- to the value of `isearch-invisible'. (Bug#11378)
-
-2013-05-30 Juri Linkov <juri@jurta.org>
-
- * replace.el (perform-replace): Avoid `isearch-range-invisible'
- call when `query-flag' is nil and `search-invisible' is non-nil.
- (Bug#11746)
-
-2013-05-30 Glenn Morris <rgm@gnu.org>
-
- * progmodes/gdb-mi.el (gdb-wait-for-pending): Fix typo.
-
- * progmodes/cc-bytecomp.el (cc-bytecomp-noruntime-functions): New.
- (cc-require): Suppress spurious "noruntime" warnings.
- (cc-require-when-compile): Use fboundp, for sake of compiler.
-
- * progmodes/cc-mode.el: Move load of cc-vars before that of
- cc-langs (which in turn loads cc-vars), to quieten compiler.
-
-2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * paren.el: Simplify the code.
- (show-paren-mode): Always start the timer.
- (show-paren--idle-timer): Rename from show-paren-idle-timer.
- (show-paren--overlay, show-paren--overlay-1): Rename from
- show-paren-overlay and show-paren-overlay-1, and initialize to an
- overlay rather than to nil.
- (show-paren-function): Misc cleanup and simplifications.
-
-2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * paren.el (show-paren-data-function): New hook.
- (show-paren--default): New function, extracted from show-paren-function.
- (show-paren-function): Use show-paren-data-function.
-
-2013-05-30 Glenn Morris <rgm@gnu.org>
-
- * ielm.el (ielm-map, ielm-complete-symbol):
- Use completion-at-point rather than obsolete functions.
- (inferior-emacs-lisp-mode): Doc fix.
- Set completion-at-point-functions, rather than
- comint-dynamic-complete-functions.
-
- * eshell/em-cmpl.el (eshell-complete-lisp-symbol): New function.
- (eshell-cmpl-initialize, eshell-complete-parse-arguments):
- Replace obsolete lisp-complete-symbol with eshell-complete-lisp-symbol.
-
- * image.el (image-animated-p): Tweak definition.
-
- * net/rlogin.el (rlogin-program, rlogin-explicit-args): Default to ssh.
- (rlogin-process-connection-type): Tweak default. Add set-after.
- (rlogin-host): Doc fix.
- (rlogin): Tweak prompt.
- (rlogin-tab-or-complete): Use completion-at-point rather than alias.
-
- * net/net-utils.el (nslookup-mode-map, ftp-mode-map):
- * progmodes/tcl.el (inferior-tcl-mode-map):
- Use completion-at-point rather than obsolete alias.
-
- * emacs-lisp/eieio.el (eieio-eval-default-p): Move before use.
-
- * minibuffer.el (read-file-name-completion-ignore-case):
- Move before completion--in-region, for eager macro expansion.
-
-2013-05-29 Juri Linkov <juri@jurta.org>
-
- * replace.el (occur-engine): Rename `globalcount' to `global-lines'
- for total count of matching lines. Add `global-matches' for total
- count of matches. Rename `matches' to `lines' for count of
- matching lines. Add `matches' for count of matches.
- Rename `lines' to `curr-line' for line count. Rename `prev-lines'
- to `prev-line' for line number of prev match endpt.
- Increment `matches' for every match. Print the number of
- matching lines in the header.
- (occur-context-lines): Rename `lines' to `curr-line'.
- Rename `prev-lines' to `prev-line'. (Bug#14017)
-
-2013-05-29 Juri Linkov <juri@jurta.org>
-
- * replace.el (perform-replace): Add `skip-read-only-count',
- `skip-filtered-count', `skip-invisible-count' let-bound to 0.
- Increment them for corresponding conditions and report the number
- of skipped occurrences in the final message. (Bug#11746)
- (query-replace, query-replace-regexp, query-replace-regexp-eval)
- (replace-string, replace-regexp): Doc fix.
-
-2013-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/trace.el (trace--read-args): Provide a default.
-
- * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from
- prog-mode-map (bug#14504).
-
-2013-05-29 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-indent-comment): Tweak regexps.
- (octave-help): Small simplification.
-
- * emacs-lisp/smie.el (smie-highlight-matching-block): Always turn
- off the highlight first.
-
-2013-05-29 Glenn Morris <rgm@gnu.org>
-
- * progmodes/idlwave.el (idlwave-concatenate-rinfo-lists):
- Handle idlwave-last-system-routine-info-cons-cell being nil.
-
- * progmodes/idlwave.el (idlwave-scan-user-lib-files)
- (idlwave-write-paths): Simplify via with-temp-buffer.
-
- * emulation/cua-gmrk.el: Also load cua-base, cua-rect at run time.
- * emulation/cua-rect.el: Also load cua-base at run time.
-
- * progmodes/cperl-mode.el (imenu-choose-buffer-index)
- (file-of-tag, etags-snarf-tag, etags-goto-tag-location): Declare.
- (cperl-imenu-on-info): Require imenu.
-
-2013-05-28 Alan Mackenzie <acm@muc.de>
-
- Handle "capitalised keywords" correctly.
- * progmodes/cc-mode.el (c-after-change): Bind case-fold-search to nil.
-
-2013-05-28 Aidan Gauland <aidalgol@amuri.net>
-
- * eshell/em-unix.el: Add -r option to cp.
-
-2013-05-28 Glenn Morris <rgm@gnu.org>
-
- * vc/vc-arch.el (vc-exec-after): Declare.
- (vc-switches): Autoload.
- * vc/vc-bzr.el: No need to require vc when compiling.
- (vc-exec-after, vc-set-async-update, vc-default-dir-printer)
- (vc-resynch-buffer, vc-dir-refresh): Declare.
- (vc-setup-buffer, vc-switches): Autoload.
- * vc/vc-cvs.el (vc-exec-after, vc-coding-system-for-diff)
- (vc-resynch-buffer): Declare.
- (vc-switches, vc-default-revert, vc-version-backup-file): Autoload.
- * vc/vc-dir.el (desktop-missing-file-warning): Declare.
- * vc/vc-git.el (vc-exec-after, vc-set-async-update)
- (grep-read-regexp, grep-read-files, grep-expand-template)
- (vc-dir-refresh): Declare.
- (vc-setup-buffer, vc-switches, vc-resynch-buffer): Autoload.
- * vc/vc-hg.el (vc-exec-after, vc-set-async-update): Declare.
- (vc-setup-buffer, vc-switches, vc-do-async-command): Autoload.
- * vc/vc-mtn.el (vc-exec-after): Declare.
- (vc-switches): Autoload.
- * vc/vc-rcs.el (vc-expand-dirs, vc-switches)
- (vc-tag-precondition, vc-buffer-sync, vc-rename-master): Autoload.
- (vc-file-tree-walk): Declare.
- * vc/vc-sccs.el (vc-file-tree-walk): Declare.
- (vc-expand-dirs, vc-switches, vc-setup-buffer, vc-delistify)
- (vc-tag-precondition, vc-rename-master): Autoload.
- * vc/vc-svn.el (vc-exec-after): Declare.
- (vc-switches, vc-setup-buffer): Autoload.
- * obsolete/vc-mcvs.el (vc-checkout, vc-switches, vc-default-revert):
- Autoload.
- (vc-resynch-buffer): Declare.
-
- * obsolete/fast-lock.el (byte-compile-warnings):
- Don't warn about obsolete features in this obsolete file.
-
- * progmodes/cc-vars.el (c-macro-names-with-semicolon):
- Move definition before use.
-
- * play/dunnet.el (byte-compile-warnings): Don't disable them all.
- (dun-unix-verbs): Remove dun-zippy.
- (dun-zippy): Remove function.
-
- * emacs-lisp/bytecomp.el (byte-compile-warnings): Doc fix.
-
-2013-05-27 Juri Linkov <juri@jurta.org>
-
- * replace.el (replace-search): New function with code moved out
- from `perform-replace'.
- (replace-highlight, replace-dehighlight): Move function definitions
- up closer to `replace-search'. (Bug#11746)
-
-2013-05-27 Juri Linkov <juri@jurta.org>
-
- * replace.el (perform-replace): Ignore invisible matches.
- In addition to checking `query-replace-skip-read-only', also
- filter out matches by calling `run-hook-with-args-until-failure'
- on `isearch-filter-predicates', and also check `search-invisible'
- for t or call `isearch-range-invisible'.
- (replace-dehighlight): Call `isearch-clean-overlays'. (Bug#11746)
-
-2013-05-27 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-filter-predicates): Rename from
- `isearch-filter-predicate'. Doc fix. (Bug#11378)
- (isearch-message-prefix): Display text from the property
- `isearch-message-prefix' of the currently active filters.
- (isearch-search): Don't compare `isearch-filter-predicate' with
- `isearch-filter-visible'. Call `run-hook-with-args-until-failure'
- on `isearch-filter-predicates'. Also check `search-invisible' for t
- or call `isearch-range-invisible'.
- (isearch-filter-visible): Make obsolete.
- (isearch-lazy-highlight-search):
- Call `run-hook-with-args-until-failure' on
- `isearch-filter-predicates' and use `isearch-range-invisible'.
-
- * info.el (Info-search): Call `run-hook-with-args-until-failure' on
- `isearch-filter-predicates' instead of `funcall'ing
- `isearch-filter-predicate'.
- (Info-mode): Set `Info-isearch-filter' to
- `isearch-filter-predicates' instead of `isearch-filter-predicate'.
-
- * dired-aux.el (dired-isearch-filter-predicate-orig):
- Remove variable.
- (dired-isearch-filenames-toggle, dired-isearch-filenames-setup)
- (dired-isearch-filenames-end): Add and remove
- `dired-isearch-filter-filenames' in `isearch-filter-predicates'
- instead of changing the value of `isearch-filter-predicate'.
- Rebind `dired-isearch-filenames-toggle' from "\M-sf" to "\M-sff".
- (dired-isearch-filter-filenames): Don't use `isearch-filter-visible'.
- Put property `isearch-message-prefix' to "filename " on
- `dired-isearch-filter-filenames'.
-
- * wdired.el (wdired-change-to-wdired-mode):
- Add `isearch-filter-predicates' to `wdired-isearch-filter-read-only'
- locally instead of changing `isearch-filter-predicate'.
- (wdired-isearch-filter-read-only): Don't use `isearch-filter-visible'.
-
-2013-05-27 Dmitry Gutov <dgutov@yandex.ru>
-
- * vc/vc-git.el (vc-git-working-revision): When in detached mode,
- return the commit hash (Bug#14459). Also set the
- `vc-git-detached' property.
- (vc-git--rev-parse): Extract from `vc-git-previous-revision'.
- (vc-git-mode-line-string): Use the same help-echo format whether
- in detached mode or not, because we know the actual revision now.
- When in detached mode, shorten the revision to 7 chars.
-
-2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/easy-mmode.el (define-minor-mode):
- * emacs-lisp/derived.el (define-derived-mode): Always defvar the
- mode hook and provide a docstring.
-
-2013-05-27 Alan Mackenzie <acm@muc.de>
-
- Remove spurious syntax-table text properties inserted by C-y.
- * progmodes/cc-mode.el (c-after-change): Also clear hard
- syntax-table property with value nil.
-
-2013-05-27 Michael Albinus <michael.albinus@gmx.de>
-
- * net/dbus.el (dbus-call-method): Let-bind `inhibit-redisplay'
- when reading the events; the buffer layout shall not be changed.
-
-2013-05-27 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-directory-tracker-resync):
- New variable.
- (inferior-octave-directory-tracker): Automatically re-sync
- default-directory.
- (octave-help): Improve handling of 'See also'.
-
-2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * doc-view.el: Minor naming convention tweaks.
- (desktop-buffer-mode-handlers): Don't add to it repeatedly.
-
- * image-mode.el (image-mode-reapply-winprops): Call image-mode-winprops
- even if there's no `display' property yet (bug#14435).
-
-2013-05-25 Eli Zaretskii <eliz@gnu.org>
-
- * subr.el (unmsys--file-name): Rename from reveal-filename.
-
- * Makefile.in (custom-deps, finder-data, autoloads)
- ($(MH_E_DIR)/mh-loaddefs.el, $(TRAMP_DIR)/tramp-loaddefs.el)
- ($(CAL_DIR)/cal-loaddefs.el, $(CAL_DIR)/diary-loaddefs.el)
- ($(CAL_DIR)/hol-loaddefs.el): All users changed.
-
-2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/lisp.el (lisp-completion-at-point): Don't use
- error-completion on the first 2 args of condition-case (bug#14446).
- Don't burp at EOB.
-
-2013-05-25 Leo Liu <sdl.web@gmail.com>
-
- * comint.el (comint-previous-matching-input): Do not flood the
- *Messages* buffer with trivial messages.
-
-2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/flymake.el (flymake-nop): Don't return a string.
- (flymake-set-at): Fix typo.
-
- * simple.el (read--expression): New function, extracted from
- eval-expression. Set completion-at-point-functions (bug#14465).
- (eval-expression, eval-minibuffer): Use it.
-
-2013-05-25 Xue Fuqiao <xfq.free@gmail.com>
-
- * progmodes/flymake.el (flymake-save-buffer-in-file)
- (flymake-makehash, flymake-posn-at-point-as-event, flymake-nop)
- (flymake-selected-frame, flymake-log, flymake-ins-after)
- (flymake-set-at, flymake-get-buildfile-from-cache)
- (flymake-add-buildfile-to-cache, flymake-clear-buildfile-cache)
- (flymake-find-possible-master-files, flymake-save-buffer-in-file):
- Refine the doc string.
- (flymake-get-file-name-mode-and-masks): Reformat.
- (flymake-get-real-file-name-function): Fix a minor bug.
-
-2013-05-24 Juri Linkov <juri@jurta.org>
-
- * progmodes/grep.el (grep-mode-font-lock-keywords):
- Support =linenumber= format used by git-grep for lines with
- function names. (Bug#13549)
-
-2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/octave.el (octave-smie-rules): Return nil rather than
- 0 after a semi-colon; it works better for smie-auto-fill.
- (octave--indent-new-comment-line): New function.
- (octave-indent-new-comment-line): Use it (indirectly).
- (octave-mode): Don't disable smie-auto-fill. Use add-function to
- modify comment-line-break-function.
-
- * emacs-lisp/smie.el (smie-auto-fill): Rework to be more robust.
- (smie-setup): Use add-function to set it.
-
-2013-05-24 Sam Steingold <sds@gnu.org>
-
- * sort.el (delete-duplicate-lines): Accept an optional `keep-blanks'
- argument (before the `interactive' argument).
-
-2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * image-mode.el (image-mode-winprops): Add winprops to
- image-mode-winprops-alist before running
- image-mode-new-window-functions.
- * doc-view.el (doc-view-new-window-function): Don't delay
- doc-view-goto-page via timers (bug#14435).
-
-2013-05-24 Tassilo Horn <tsdh@gnu.org>
-
- * doc-view.el: Integrate with desktop.el. (Bug#14435)
- (doc-view-desktop-save-buffer): New function.
- (doc-view-restore-desktop-buffer): New function.
- (desktop-buffer-mode-handlers):
- Add `doc-view-restore-desktop-buffer' as desktop.el buffer mode
- handler.
- (doc-view-mode): Set `doc-view-desktop-save-buffer' as custom
- `desktop-save-buffer' function.
-
-2013-05-24 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-gvfs.el (tramp-gvfs-enabled): New defconst.
- (tramp-gvfs-file-name-handler): Raise a user error when
- `tramp-gvfs-enabled' is nil.
- (top): Register signals only when `tramp-gvfs-enabled' is non-nil.
- Do not raise a user error when loading package. (Bug#14447)
-
- * net/xesam.el: Move to obsolete/.
-
-2013-05-24 Glenn Morris <rgm@gnu.org>
-
- * font-lock.el (lisp-font-lock-keywords-2): Add with-coding-priority.
-
- * emacs-lisp/chart.el (chart-sort): Replace obsolete `object-name'.
-
- * progmodes/cperl-mode.el (cperl-mode): Use fboundp.
- (Info-find-node, Man-getpage-in-background): Declare.
-
- * mail/unrmail.el (unrmail):
- Replace obsolete detect-coding-with-priority.
-
- * net/socks.el (socks-split-string): Use this rather than split-string.
- (socks-nslookup-host): Update for above change.
- (dynamic-choice, s5-dynamic-choice-match)
- (s5-dynamic-choice-match-inline, s5-widget-value-create):
- Comment out unused code.
-
- * tooltip.el (tooltip-use-echo-area): Warn only on 'set.
- * progmodes/gud.el (gud-gdb-completion-function): Move before use.
- (gud-tooltip-echo-area): Make obsolete.
- (gud-tooltip-process-output, gud-tooltip-tips): Also check tooltip-mode.
-
- * progmodes/js.el (js--optimize-arglist): Declare.
-
- * progmodes/ruby-mode.el (ruby-syntax-propertize-expansion): Declare.
-
- * progmodes/which-func.el (ediff-window-A, ediff-window-B)
- (ediff-window-C): Declare.
-
- * obsolete/pgg-gpg.el, obsolete/pgg-pgp.el, obsolete/pgg-pgp5.el:
- Tweak requires to silence compiler.
-
- * obsolete/sym-comp.el: No need to load hipper-exp when compiling.
- (he-search-string, he-tried-table, he-expand-list)
- (he-init-string, he-string-member, he-substitute-string)
- (he-reset-string): Declare.
-
- * obsolete/options.el (list-options): Use custom-variable-p,
- rather than obsolete alias.
-
-2013-05-23 Sam Steingold <sds@gnu.org>
-
- * 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>
-
-2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/smie.el (smie-indent-forward-token)
- (smie-indent-backward-token): Handle string tokens (bug#14381).
-
-2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * ielm.el (ielm-menu): New menu.
- (inferior-emacs-lisp-mode): Set comment-start.
-
-2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * lisp/textmodes/reftex.el (reftex-ref-style-toggle):
- Fix deactivate action.
-
- * lisp/textmodes/reftex-vars.el (reftex-ref-style-alist):
- Add cleveref macros.
-
- * lisp/textmodes/reftex-parse.el
- (reftex-locate-bibliography-files): Accept options for
- bibliography commands.
- * lisp/textmodes/reftex-vars.el (reftex-bibliography-commands):
- Add addbibresource. Basic Biblatex support.
-
-2013-05-23 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-gvfs.el (top):
- * net/xesam.el (xesam-dbus-unique-names): Suppress D-Bus errors
- when loading package. (Bug#14447)
-
-2013-05-23 Glenn Morris <rgm@gnu.org>
-
- * progmodes/js.el: No need to load comint when compiling.
- (ring-insert, comint-send-string, comint-send-input)
- (comint-last-input-end, ido-chop): Declare.
-
- * vc/ediff-diff.el, vc/ediff-merg.el: Require ediff-util at run-time.
- * vc/ediff-mult.el: Adjust requires.
- (ediff-directories-internal, ediff-directory-revisions-internal)
- (ediff-patch-file-internal): Declare.
- * vc/ediff-ptch.el: Adjust requires.
- (ediff-use-last-dir, ediff-buffers-internal): Declare.
- (ediff-find-file): Autoload.
- * vc/ediff-util.el: No need to load ediff when compiling.
- (ediff-regions-internal): Declare.
- * vc/ediff-wind.el: Adjust requires.
- (ediff-compute-toolbar-width): Define when compiling.
- (ediff-setup-control-buffer, ediff-make-bottom-toolbar): Declare.
- * vc/ediff.el: No need to load dired, ediff-ptch when compiling.
- (dired-get-filename, dired-get-marked-files)
- (ediff-last-dir-patch, ediff-patch-default-directory)
- (ediff-get-patch-buffer, ediff-dispatch-file-patching-job)
- (ediff-patch-buffer-internal): Declare.
-
- * emacs-lisp/checkdoc.el: No need to load ispell when compiling.
- (ispell-process, ispell-buffer-local-words, lm-summary)
- (lm-section-start, lm-section-end): Declare.
- (checkdoc-ispell-init): Simplify.
-
- * progmodes/vera-mode.el (he-init-string, he-dabbrev-beg)
- (he-string-member, he-reset-string, he-substitute-string): Declare.
-
- * eshell/em-ls.el: Adjust requires.
- (eshell-glob-regexp): Declare.
- * eshell/em-tramp.el: Adjust requires.
- (eshell-parse-command): Autoload.
- * eshell/em-xtra.el: Adjust requires.
- (eshell-parse-command): Autoload.
- * eshell/esh-ext.el: Adjust requires.
- (eshell-parse-command, eshell-close-handles): Autoload.
- * eshell/esh-io.el: Adjust requires.
- (eshell-output-filter): Autoload.
- * eshell/esh-util.el: No need to load tramp when compiling.
- (tramp-file-name-structure, ange-ftp-ls, ange-ftp-file-modtime):
- Declare.
- (eshell-parse-ange-ls): Require ange-ftp and tramp.
- * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el:
- * eshell/em-cmpl.el, eshell/em-glob.el, eshell/em-pred.el:
- * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-smart.el:
- * eshell/em-term.el, eshell/esh-arg.el, eshell/esh-mode.el:
- * eshell/esh-opt.el, eshell/esh-proc.el:
- * eshell/esh-var.el: Adjust requires.
- * eshell/eshell.el: Do not require esh-util twice.
- (eshell-add-input-to-history): Declare.
- (eshell-command): Check history module is active before using it.
-
- * eshell/em-ls.el (eshell-ls-dir): Fix -A handling.
-
-2013-05-22 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup): Fix bug#14433.
-
-2013-05-22 Michael Albinus <michael.albinus@gmx.de>
-
- * autorevert.el (auto-revert-notify-add-watch)
- (auto-revert-notify-handler): Add `attrib' for the inotify case,
- it indicates changes in file modification time.
-
-2013-05-22 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/bytecomp.el (byte-compile-file-form-autoload):
- Always delete the autoloaded function from the noruntime and
- unresolved functions lists.
-
- * allout.el: No need to load epa, epg, overlay when compiling.
- (epg-context-set-passphrase-callback, epg-list-keys)
- (epg-decrypt-string, epg-encrypt-string, epg-user-id-string)
- (epg-key-user-id-list): Declare.
-
- * emulation/viper-cmd.el (viper-set-searchstyle-toggling-macros)
- (viper-set-parsing-style-toggling-macro)
- (viper-set-emacs-state-searchstyle-macros):
- Use called-interactively-p on Emacs.
- (viper-looking-back): Make it an obsolete alias. Update callers.
- * emulation/viper-ex.el: Load viper-keym, not viper-cmd.
- Use looking-back rather than viper-looking-back.
- (viper-tmp-insert-at-eob, viper-enlarge-region)
- (viper-read-string-with-history, viper-register-to-point)
- (viper-append-to-register, viper-change-state-to-vi)
- (viper-backward-char-carefully, viper-forward-char-carefully)
- (viper-Put-back, viper-put-back, viper-add-newline-at-eob-if-necessary)
- (viper-change-state-to-emacs): Declare.
- * emulation/viper-macs.el: Load viper-mous, viper-ex, not viper-cmd.
- (viper-change-state-to-insert, viper-change-state-to-vi): Declare.
- * emulation/viper-mous.el: Do not load viper-cmd.
- (viper-backward-char-carefully, viper-forward-char-carefully)
- (viper-forward-word, viper-adjust-window): Declare.
-
- * vc/ediff.el (ediff-version): Use called-interactively-p on Emacs.
-
- * progmodes/idlw-help.el (idlwave-help-fontify):
- Use called-interactively-p.
-
- * term/w32console.el (w32-get-console-codepage)
- (w32-get-console-output-codepage): Declare.
-
- * dframe.el (x-sensitive-text-pointer-shape, x-pointer-shape):
- Remove unnecessary declarations.
- (dframe-message): Doc fix.
-
- * info.el (dframe-select-attached-frame, dframe-current-frame):
- Declare.
-
- * speedbar.el (speedbar-message): Make it an obsolete alias.
- Update all callers.
- (speedbar-with-attached-buffer)
- (speedbar-maybee-jump-to-attached-frame): Make these aliases obsolete.
- (speedbar-with-writable): Use backquote.
- * emacs-lisp/eieio-opt.el (eieio-describe-class-sb):
- * emacs-lisp/eieio-speedbar.el (eieio-speedbar-handle-click):
- Use dframe-with-attached-buffer, dframe-maybee-jump-to-attached-frame
- rather than speedbar- aliases.
- * mail/rmail.el: Load dframe rather than speedbar when compiling.
- (speedbar-make-specialized-keymap, speedbar-insert-button)
- (dframe-select-attached-frame, dframe-maybee-jump-to-attached-frame)
- (speedbar-do-function-pointer): Declare.
- (rmail-speedbar-button, rmail-speedbar-find-file)
- (rmail-speedbar-move-message):
- Use dframe-with-attached-buffer rather than speedbar- alias.
- * progmodes/gud.el: Load dframe rather than speedbar when compiling.
- (dframe-message, speedbar-make-specialized-keymap)
- (speedbar-add-expansion-list, speedbar-mode-functions-list)
- (speedbar-make-tag-line, speedbar-remove-localized-speedbar-support)
- (speedbar-insert-button, dframe-select-attached-frame)
- (dframe-maybee-jump-to-attached-frame)
- (speedbar-change-initial-expansion-list)
- (speedbar-previously-used-expansion-list-name): Declare.
- (gud-speedbar-item-info, gud-gdb-goto-stackframe):
- Use dframe-message, dframe-with-attached-buffer rather than
- speedbar- aliases.
- (gud-sentinel): Silence compiler.
- * progmodes/vhdl-mode.el (speedbar-refresh)
- (speedbar-do-function-pointer, speedbar-add-supported-extension)
- (speedbar-add-mode-functions-list, speedbar-make-specialized-keymap)
- (speedbar-change-initial-expansion-list, speedbar-add-expansion-list)
- (speedbar-extension-list-to-regex, speedbar-directory-buttons)
- (speedbar-file-lists, speedbar-make-tag-line)
- (speedbar-line-directory, speedbar-goto-this-file)
- (speedbar-center-buffer-smartly, speedbar-change-expand-button-char)
- (speedbar-delete-subblock, speedbar-position-cursor-on-line)
- (speedbar-make-button, speedbar-reset-scanners)
- (speedbar-files-item-info, speedbar-line-text)
- (speedbar-find-file-in-frame, speedbar-set-timer)
- (dframe-maybee-jump-to-attached-frame, speedbar-line-file): Declare.
- (speedbar-with-writable): Do not (re)define it.
- (vhdl-speedbar-find-file): Use dframe-maybee-jump-to-attached-frame
- rather than speedbar- alias.
-
-2013-05-21 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-mode-menu): Update and re-organize
- menu items.
- (octave-mode): Tweak fill-nobreak-predicate.
- (inferior-octave-startup): Check process to avoid infinite loop.
- (inferior-octave): Pop to buffer first to show abornmal process
- exit information.
-
-2013-05-21 Glenn Morris <rgm@gnu.org>
-
- * printing.el (pr-menu-bar): Define when compiling.
-
-2013-05-21 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-auto-fill): Remove.
- (octave-indent-new-comment-line): Improve.
- (octave-mode): Use auto fill mode through
- comment-line-break-function and fill-nobreak-predicate.
- (octave-goto-function-definition): Support DEFUN_DLD.
- (octave-beginning-of-defun): Small tweak.
- (octave-help): Show parent directory.
-
-2013-05-21 Glenn Morris <rgm@gnu.org>
-
- * files.el (dired-unmark):
- * progmodes/gud.el (gdb-input): Update declarations.
-
- * calculator.el (electric, ehelp): No need to load when compiling.
- (Electric-command-loop, electric-describe-mode): Declare.
-
- * doc-view.el (doc-view-current-converter-processes): Move before use.
-
- * emacs-lisp/easy-mmode.el (define-globalized-minor-mode):
- Move MODE-set-explicitly definition before use.
-
- * international/mule-diag.el (mule-diag):
- Don't use obsolete window-system-version.
-
- * mail/feedmail.el (smtpmail): No need to load when compiling.
- (smtpmail-via-smtp, smtpmail-smtp-server): Declare.
-
- * mail/mail-utils.el (rfc822): No need to load when compiling.
- (rfc822-addresses): Autoload it.
- (mail-strip-quoted-names): Trivial simplification.
-
- * mail/rmail.el (rmail-mime-message-p, rmail-mime-toggle-raw): Declare.
- (rmail-retry-failure): Don't assume that rmail-mime-feature == rmailmm.
-
- * net/snmp-mode.el (tempo): Don't duplicate requires.
-
- * progmodes/prolog.el (info): No need to load when compiling.
- (comint): Require before shell requires it.
- (Info-goto-node): Autoload it.
- (Info-follow-nearest-node): Declare.
- (prolog-help-info, prolog-goto-predicate-info): No need to require info.
-
- * textmodes/artist.el (picture-mode-exit): Declare.
-
- * textmodes/reftex-parse.el (reftex-parse-from-file):
- Trivial rewrite so the compiler can parse it better.
-
-2013-05-20 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-help-mode-map)
- (octave-help-mode-finish-hook): New variables.
- (octave-help-mode, octave-help-mode-finish): New functions.
- (octave-help): Use octave-help-mode.
-
-2013-05-20 Glenn Morris <rgm@gnu.org>
-
- * format-spec.el (format-spec): Allow spec chars with nil. (Bug#14420)
-
-2013-05-19 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-expression-expansion-re): Allow to
- start at point, so that expansion starting right after opening
- slash in a regexp is recognized.
- (ruby-syntax-before-regexp-re): New defvar, extracted from
- ruby-syntax-propertize-function. Since the value of this regexp
- is looked up at runtime now, we should be able to turn
- `ruby-syntax-methods-before-regexp' into a defcustom later.
- (ruby-syntax-propertize-function): Split regexp matching into two
- parts, for opening and closing slashes. That allows us to skip
- over string interpolations and support multiline regexps.
- Don't call `ruby-syntax-propertize-expansions', instead use another rule
- for them, which calls `ruby-syntax-propertize-expansion'.
- (ruby-syntax-propertize-expansions): Move `remove-text-properties'
- call to `ruby-syntax-propertize-function'.
- (ruby-syntax-propertize-expansion): Extracted from
- `ruby-syntax-propertize-expansions'. Handles one expansion.
- (ruby-syntax-propertize-percent-literal): Leave point right after
- the percent symbol, so that the expression expansion rule can
- propertize the contents.
- (ruby-syntax-propertize-heredoc): Leave point at bol following the
- heredoc openers.
- (ruby-syntax-propertize-expansions): Remove.
-
-2013-05-18 Juri Linkov <juri@jurta.org>
-
- * man.el (Man-default-man-entry): Remove `-' from the end
- of the default value. (Bug#14400)
-
-2013-05-18 Glenn Morris <rgm@gnu.org>
-
- * comint.el (comint-password-prompt-regexp):
- Allow "password for XXX" where XXX contains colons (eg https://...).
-
-2013-05-18 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup): Use OCTAVE_SRCDIR
- instead. Include "--no-gui" to prevent hangs for Octave > 3.7.
- (octave-source-directories): Don't check process.
- (octave-source-directories, octave-find-definition): Doc fix.
-
-2013-05-18 Glenn Morris <rgm@gnu.org>
-
- * progmodes/vhdl-mode.el (vhdl-mode-map-init):
- Remove backspace/delete bindings. (Bug#14392)
-
- * cus-dep.el (custom-make-dependencies): Sort the output.
- (custom-versions-load-alist): Convert comment to doc.
-
-2013-05-17 Leo Liu <sdl.web@gmail.com>
-
- * newcomment.el (comment-search-backward): Stricter in finding
- comment start. (Bug#14303)
-
- * progmodes/octave.el (octave-comment-start): Remove the SPC char.
- (octave-comment-start-skip): Properly anchored.
-
-2013-05-17 Leo Liu <sdl.web@gmail.com>
-
- * emacs-lisp/smie.el (smie-highlight-matching-block-mode):
- Clean up when turned off. (Bug#14395)
- (smie--highlight-matching-block-overlay): No longer buffer-local.
- (smie-highlight-matching-block): Adjust.
-
-2013-05-17 Paul Eggert <eggert@cs.ucla.edu>
-
- Doc string fix for "nanoseconds" (Bug#14406).
- * emacs-lisp/timer.el (timer-relative-time, timer-inc-time):
- Fix doc string typo that had "nanoseconds" instead of "microseconds".
-
-2013-05-17 Jay Belanger <jay.p.belanger@gmail.com>
-
- * calc/calc-units.el (math-extract-units): Preserve powers
- of units.
-
-2013-05-17 Leo Liu <sdl.web@gmail.com>
-
- * subr.el (delete-consecutive-dups): New function.
- * ido.el (ido-set-matches-1): Use it.
- * progmodes/octave.el (inferior-octave-completion-table): Use it.
- * ido.el (ido-remove-consecutive-dups): Remove.
-
-2013-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re)
- (f90-hpf-keywords-re, f90-constants-re): Use \\_< rather than
- regexp-opt's `words'.
-
-2013-05-16 Leo Liu <sdl.web@gmail.com>
-
- * emacs-lisp/smie.el (smie-matching-block-highlight): New face.
- (smie--highlight-matching-block-overlay)
- (smie--highlight-matching-block-lastpos)
- (smie--highlight-matching-block-timer): New variables.
- (smie-highlight-matching-block): New function.
- (smie-highlight-matching-block-mode): New minor mode. (Bug#14395)
- (smie-setup): Conditionally enable smie-blink-matching-open.
-
-2013-05-16 Wilson Snyder <wsnyder@wsnyder.org>
-
- Sync with upstream verilog-mode r840.
- * progmodes/verilog-mode.el (verilog-mode-version)
- (verilog-mode-release-date): Update.
- (verilog-auto-lineup, verilog-auto-reset): Doc fixes.
- (verilog-sig-tieoff): Fix string error on
- AUTORESET with colon define, bug594. Reported by Andrew Hou.
- (verilog-read-decls): Fix parameters confusing
- AUTOINST interfaces, bug565. Reported by Leith Johnson.
-
-2013-05-16 Eli Zaretskii <eliz@gnu.org>
-
- * subr.el (reveal-filename): New function.
-
- * loadup.el: Compute Emacs executable versions on MS-Windows,
- where executables have the .exe extension. Add a hard link
- emacs-XX.YY.ZZ.exe on MS-Windows.
-
- * Makefile.in (XARGS_LIMIT): New variable.
- (custom-deps, finder-data, autoloads)
- ($(MH_E_DIR)/mh-loaddefs.el, $(TRAMP_DIR)/tramp-loaddefs.el)
- ($(CAL_DIR)/cal-loaddefs.el, $(CAL_DIR)/diary-loaddefs.el)
- ($(CAL_DIR)/hol-loaddefs.el): Use reveal-filename.
- (compile-main): Limit xargs according to $(XARGS_LIMIT).
-
-2013-05-16 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-indent-defun): Mark obsolete.
- (octave-mode-menu, octave-mode-map): Remove its uses.
-
-2013-05-16 Reto Zimmermann <reto@gnu.org>
-
- Sync with upstream vhdl mode v3.34.2.
- * progmodes/vhdl-mode.el: Use `push' throughout.
- (vhdl-version, vhdl-time-stamp, vhdl-doc-release-notes): Update.
- (vhdl-compiler-alist): Replace "\t\n" by "\\t\\n".
- Add IBM & Quartus compiler. Enhance entry for ADVance MS compiler.
- (vhdl-actual-generic-name): New option to derive actual generic name.
- (vhdl-port-paste-signals): Replace formal by actual generics.
- (vhdl-beautify): New name for old group vhdl-align. Update users.
- (vhdl-beautify-options): New option.
- (vhdl-last-input-event): New compat alias. Use throughout.
- (vhdl-goto-line): Replace user level function `goto-line'.
- (vhdl-mode-map): Add bindings for vhdl-fix-statement-region,
- vhdl-fix-statement-buffer.
- (vhdl-create-mode-menu): Add some entries.
- (vhdl-align-region-groups): Respect vhdl-beautify-options.
- (vhdl-align-inline-comment-region-1): Handle "--" inside string.
- (vhdl-fixup-whitespace-region): Handle symbols at EOL.
- (vhdl-fix-statement-region, vhdl-fix-statement-buffer): New commands,
- to force statements on one line.
- (vhdl-remove-trailing-spaces-region):
- New, split from vhdl-remove-trailing-spaces.
- (vhdl-beautify-region): Fix statements, trailing spaces, ^M character.
- Respect vhdl-beautify-options.
- (vhdl-update-sensitivity-list-buffer): If non-interactive save buffer.
- (vhdl-update-sensitivity-list): Not add with index if exists without.
- Not include array index with signal. Ignore keywords in comments.
- (vhdl-get-visible-signals): Regexp tweaks.
- (vhdl-template-component-inst): Handle empty library.
- (vhdl-template-type): Add template for 'enum' type.
- (vhdl-port-paste-generic-map, vhdl-port-paste-constants):
- Use vhdl-replace-string.
- (vhdl-port-paste-signals): Use vhdl-prepare-search-1.
- (vhdl-speedbar-mode-map): Rename from vhdl-speedbar-key-map.
- (vhdl-speedbar-initialize): Update for above name change.
- (vhdl-compose-wire-components): Fix in handling of constants.
- (vhdl-error-regexp-emacs-alist): New variable.
- (vhdl-error-regexp-add-emacs): New function;
- adds support for new compile.el (Emacs 22+)
- (vhdl-generate-makefile-1): Change target order for single lib. units.
- Allow use of absolute file names.
-
-2013-05-16 Leo Liu <sdl.web@gmail.com>
-
- * simple.el (prog-indent-sexp): Indent enclosing defun.
-
-2013-05-15 Glenn Morris <rgm@gnu.org>
-
- * cus-start.el (show-trailing-whitespace): Move to editing basics.
- * faces.el (trailing-whitespace): Don't use whitespace-faces group.
- * obsolete/old-whitespace.el (whitespace-faces): Remove group.
- (whitespace-highlight): Move to whitespace group.
-
- * comint.el (comint-source):
- * pcmpl-linux.el (pcmpl-linux):
- * shell.el (shell-faces):
- * eshell/esh-opt.el (eshell-opt):
- * international/ccl.el (ccl): Remove empty custom groups.
-
- * completion.el (dynamic-completion-mode):
- * jit-lock.el (jit-lock-debug-mode):
- * minibuffer.el (completion-in-region-mode):
- * type-break.el (type-break-mode-line-message-mode)
- (type-break-query-mode):
- * emulation/tpu-edt.el (tpu-edt-mode):
- * progmodes/subword.el (global-subword-mode, global-superword-mode):
- * progmodes/vhdl-mode.el (vhdl-electric-mode, vhdl-stutter-mode):
- * term/vt100.el (vt100-wide-mode): Specify explicit :group.
-
- * term/xterm.el (xterm): Change parent group to terminals.
-
- * master.el (master): Remove empty custom group.
- (master-mode): Remove unused :group argument.
- * textmodes/refill.el (refill): Remove empty custom group.
- (refill-mode): Remove unused :group argument.
-
- * textmodes/rst.el (rst-compile-toolsets): Use rst-compile group.
-
- * cus-dep.el: Provide a feature.
- (custom-make-dependencies): Ignore dotfiles (dir-locals).
- Don't mistakenly ignore files whose basenames match a basename
- from preloaded-file-list (eg cedet/ede/simple.el).
- Add a fallback method for getting :group.
-
-2013-05-15 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-char-by-name): Rename from
- `isearch-insert-char-by-name'. Doc fix.
- (isearch-forward): Mention `isearch-char-by-name' in
- the docstring. (Bug#13348)
-
- * isearch.el (minibuffer-local-isearch-map): Bind "\r" to
- `exit-minibuffer' instead of
- `isearch-nonincremental-exit-minibuffer'.
- (isearch-edit-string): Remove mention of
- `isearch-nonincremental-exit-minibuffer' from docstring.
- (isearch-nonincremental-exit-minibuffer): Mark as obsolete.
- (isearch-forward-exit-minibuffer)
- (isearch-reverse-exit-minibuffer): Add docstring. (Bug#13348)
-
-2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * loadup.el: Just use unversioned DOC.
-
- * nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other
- literals as extending to EOB.
- (nxml-last-fontify-end): Remove unused variable.
- (nxml-after-change1): Use with-silent-modifications.
- (nxml-extend-after-change-region): Simplify.
- (nxml-extend-after-change-region1): Remove function.
- (nxml-after-change1): Don't adjust for dependent regions.
- (nxml-fontify-matcher): Simplify.
- * nxml/xmltok.el (xmltok-dependent-regions): Remove variable.
- (xmltok-add-dependent): Remove function.
- (xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open)
- (xmltok-scan-after-comment-open, xmltok-scan-prolog-literal)
- (xmltok-scan-prolog-after-processing-instruction-open): Treat
- unclosed <[[, <?, comment, and other literals as extending to EOB.
- * nxml/rng-valid.el (rng-mark-xmltok-dependent-regions)
- (rng-mark-xmltok-dependent-region, rng-dependent-region-changed):
- Remove functions.
- (rng-do-some-validation-1): Don't mark dependent regions.
- * nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions)
- (nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region)
- (nxml-clear-dependent-regions): Remove functions.
- (nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward)
- (nxml-ensure-scan-up-to-date):
- Don't clear&mark dependent regions.
-
-2013-05-15 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-goto-function-definition):
- Improve and fix callers.
-
-2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/cl-extra.el (cl-getf): Return the proper value in
- the setter (bug#14387).
-
- * progmodes/f90.el (f90-blocks-re): Include the terminating \> in the
- surrounding group (bug#14402).
-
-2013-05-14 Juri Linkov <juri@jurta.org>
-
- * subr.el (find-tag-default-as-regexp): Return nil if `tag' is nil.
- (Bug#14390)
-
-2013-05-14 Glenn Morris <rgm@gnu.org>
-
- * progmodes/f90.el (f90-imenu-generic-expression):
- Fix typo in 2013-05-08 change. (Bug#14402)
-
-2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
-
- * progmodes/gdb-mi.el (gdb-running, gdb-starting):
- Remove signals for which replies are never received.
-
-2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
-
- * progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845)
- (gdb-handler-alist, gdb-handler-number): Remove variables.
- (gdb-handler-list): New variable.
- (gdb-add-handler, gdb-delete-handler, gdb-get-handler-function)
- (gdb-pending-handler-p, gdb-handle-reply)
- (gdb-remove-all-pending-triggers): New functions.
- (gdb-discard-unordered-replies): New defcustom.
- (gdb-handler): New defstruct.
- (gdb-wait-for-pending): Fix invalid backquote. Use gdb-handler-list.
- instead of gdb-pending-triggers. Update docstring.
- (gdb-init-1): Remove dead variables. Initialize gdb-handler-list.
- (gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update)
- (gdb-var-update-handler, def-gdb-auto-update-trigger)
- (def-gdb-auto-update-handler, gdb-get-changed-registers)
- (gdb-changed-registers-handler, gdb-get-main-selected-frame)
- (gdb-frame-handler): Pending triggers are now automatically managed.
- (def-gdb-trigger-and-handler, def-gdb-auto-update-handler):
- Remove argument.
- (gdb-input): Automatically handles pending triggers. Update docstring.
- (gdb-resync): Replace gdb-pending-triggers by gdb-handler-list.
- (gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler):
- Update comments.
- (gdb-done-or-error): Now use gdb-handle-reply.
-
-2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
-
- * progmodes/gdb-mi.el (gdb-input): Include token numbers in
- gdb-debug-log.
-
-2013-05-14 Glenn Morris <rgm@gnu.org>
-
- * subr.el (user-emacs-directory-warning): New option.
- (locate-user-emacs-file): Handle non-accessible .emacs.d. (Bug#13930)
-
-2013-05-14 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-font-lock-keywords): Fix error
- during redisplay.
- (octave-goto-function-definition, octave-find-definition): Minor tweaks.
- (octave-font-lock-texinfo-comment): Fix invalid search bound
- error: wrong side of point.
-
-2013-05-14 Glenn Morris <rgm@gnu.org>
-
- * progmodes/flymake.el (flymake-xml-program): New option.
- (flymake-xml-init): Use it.
-
- * term/xterm.el: Provide a feature.
-
- * term/sup-mouse.el: Move to obsolete/. Provide a feature.
-
-2013-05-13 Glenn Morris <rgm@gnu.org>
-
- * cus-dep.el (defcustom-mh, defgroup-mh, defface-mh):
- Add compat aliases as a hack workaround. (Bug#14384)
-
-2013-05-13 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-indent-comment): Fix indentation for
- ###, and %!.
- (octave-mode-map): Bind octave-indent-defun to C-c C-q instead of
- C-M-q.
- (octave-comment-start-skip): Include %!.
- (octave-mode): Set comment-start-skip to octave-comment-start-skip.
-
-2013-05-12 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup): Store the value
- of __octave_srcdir__ for octave-source-directories.
- (inferior-octave-check-process): New function refactored out of
- inferior-octave-send-list-and-digest.
- (octave-source-directories)
- (octave-find-definition-filename-function): New variables.
- (octave-source-directories)
- (octave-find-definition-default-filename): New functions.
- (octave-find-definition): Improve to find functions implemented in C++.
-
-2013-05-12 Glenn Morris <rgm@gnu.org>
-
- * calendar/diary-lib.el (diary-outlook-format-1):
- Don't include dayname in the output. (Bug#14349)
-
-2013-05-11 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/autoload.el (generated-autoload-load-name): Doc fix.
-
- * cus-dep.el (custom-make-dependencies): Only use safe local variables.
- Treat cc-provide like provide.
-
-2013-05-11 Kevin Ryde <user42@zip.com.au>
-
- * cus-dep.el (custom-make-dependencies):
- Use generated-autoload-load-name for the sake of files such
- such cedet/semantic/bovine/c.el, where the base file name
- is not in load-path. (Bug#5277)
-
-2013-05-11 Glenn Morris <rgm@gnu.org>
-
- * dos-vars.el, emacs-lisp/cl-indent.el, emulation/tpu-extras.el:
- Provide features.
-
-2013-05-11 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-indent-comment): Improve.
- (octave-eldoc-message-style, octave-eldoc-cache): New variables.
- (octave-eldoc-function-signatures, octave-eldoc-function):
- New functions.
- (octave-mode, inferior-octave-mode): Add eldoc support.
-
-2013-05-11 Richard Stallman <rms@gnu.org>
-
- * epa.el (epa-decrypt-file): Take output file name as argument
- and read it using `interactive'.
-
-2013-05-11 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-beginning-of-line)
- (octave-end-of-line): Check before using up-list because it jumps
- out of more syntactic contructs since moving to smie.
- (octave-indent-comment): New function.
- (octave-mode): Use it in smie-indent-functions. (Bug#14350)
- (octave-begin-keywords, octave-end-keywords)
- (octave-reserved-words, octave-smie-bnf-table)
- (octave-smie-rules): Add new keywords from Octave 3.6.4.
-
-2013-05-11 Glenn Morris <rgm@gnu.org>
-
- * faces.el (internal-face-x-get-resource):
- * frame.el (ns-display-monitor-attributes-list):
- * calc/calc-aent.el (math-to-radians-2):
- * emacs-lisp/package.el (tar-header-name, tar-header-link-type):
- Fix declarations.
-
- * calc/calc-menu.el: Make it loadable in isolation.
-
- * net/eudcb-bbdb.el: Make it loadable without bbdb.
- (eudc-bbdb-filter-non-matching-record, eudc-bbdb-extract-phones)
- (eudc-bbdb-extract-addresses, eudc-bbdb-format-record-as-result)
- (eudc-bbdb-query-internal): Require 'bbdb.
-
- * lpr.el (lpr-headers-switches):
- * emacs-lisp/testcover.el (testcover-compose-functions): Fix :type.
-
- * progmodes/sql.el (sql-login-params): Fix and improve :type.
-
- * emulation/edt-mapper.el: In batch mode, error rather than hang.
-
- * term.el (term-set-escape-char): Make it idempotent.
-
-2013-05-10 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-completion-table):
- No longer a function and all uses changed. Use cache to speed up
- completion due to bug#11906.
- (octave-beginning-of-defun): Re-write to be more general.
-
-2013-05-10 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/cl-macs.el (cl-loop): Doc fix.
-
-2013-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * comint.el (comint-redirect-send-command-to-process): Use :around
- rather than :override for comint-redirect-filter.
- (comint-redirect-filter): Add the corresponding `orig-filter' argument.
- Call it instead of comint-redirect-original-filter-function (which
- is gone). Reported by Juanma Barranquero <lekktu@gmail.com>.
-
-2013-05-09 Jan Djärv <jan.h.d@swipnet.se>
-
- * frame.el (display-monitor-attributes-list): Add NS case.
- (ns-display-monitor-attributes-list): Declare.
-
-2013-05-09 Ulrich Mueller <ulm@gentoo.org>
-
- * descr-text.el (describe-char): Fix %d/%x typo. (Bug#14360)
-
-2013-05-09 Glenn Morris <rgm@gnu.org>
-
- * international/fontset.el (vertical-centering-font-regexp):
- Set standard-value.
-
- * tar-mode.el (tar-superior-buffer, tar-superior-descriptor): Add doc.
-
- * bookmark.el (bookmark-search-delay):
- * cus-start.el (vertical-centering-font-regexp):
- * ps-mule.el (ps-mule-font-info-database-default):
- * ps-print.el (ps-default-fg, ps-default-bg):
- * type-break.el (type-break-good-break-interval):
- * whitespace.el (whitespace-indentation-regexp)
- (whitespace-space-after-tab-regexp):
- * emacs-lisp/testcover.el (testcover-1value-functions)
- (testcover-noreturn-functions, testcover-progn-functions)
- (testcover-prog1-functions):
- * emulation/viper-init.el (viper-emacs-state-cursor-color):
- * eshell/em-glob.el (eshell-glob-translate-alist):
- * play/tetris.el (tetris-tty-colors):
- * progmodes/cpp.el (cpp-face-default-list):
- * progmodes/flymake.el (flymake-allowed-file-name-masks):
- * progmodes/idlw-help.el (idlwave-help-browser-generic-program)
- (idlwave-help-browser-generic-args):
- * progmodes/make-mode.el (makefile-special-targets-list):
- * progmodes/python.el (python-shell-virtualenv-path):
- * progmodes/verilog-mode.el (verilog-active-low-regexp)
- (verilog-auto-input-ignore-regexp, verilog-auto-inout-ignore-regexp)
- (verilog-auto-output-ignore-regexp, verilog-auto-tieoff-ignore-regexp)
- (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp):
- * textmodes/reftex-vars.el (reftex-format-label-function):
- * textmodes/remember.el (remember-diary-file): Fix custom types.
-
- * jka-cmpr-hook.el (jka-compr-mode-alist-additions): Fix typo.
- Add :version.
-
-2013-05-09 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-completion-at-point):
- Restore file completion. (Bug#14300)
- (inferior-octave-startup): Fix incorrect highlighting for the
- first prompt.
-
-2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/ruby-mode.el: First cut at SMIE support.
- (ruby-use-smie): New var.
- (ruby-smie-grammar): New constant.
- (ruby-smie--bosp, ruby-smie--implicit-semi-p)
- (ruby-smie--forward-token, ruby-smie--backward-token)
- (ruby-smie-rules): New functions.
- (ruby-mode-variables): Setup SMIE if applicable.
-
-2013-05-08 Eli Zaretskii <eliz@gnu.org>
-
- * simple.el (line-move-visual): Signal beginning/end of buffer
- only if vertical-motion moved less than it was requested. Avoids
- silly incorrect error messages when there are display strings with
- multiple newlines at EOL.
-
-2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/vera-mode.el (vera-underscore-is-part-of-word):
- * progmodes/prolog.el (prolog-underscore-wordchar-flag)
- (prolog-char-quote-workaround):
- * progmodes/cperl-mode.el (cperl-under-as-char):
- * progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word):
- Mark as obsolete.
- (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
- their declaration.
- (vhdl-mode-syntax-table-init): Remove.
-
- * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on
- last change.
-
- * progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol
- syntax for "_".
- (ld-script-font-lock-keywords):
- Change regexps to use things like \_< and \_>.
-
- * progmodes/f90.el (f90-mode-syntax-table): Use symbol syntax for "_".
- Change all regexps to use things like \_< and \_>.
-
- * progmodes/autoconf.el (autoconf-definition-regexp)
- (autoconf-font-lock-keywords, autoconf-current-defun-function):
- Handle a _ with symbol syntax.
- (autoconf-mode): Don't change the syntax-table for imenu and font-lock.
-
- * progmodes/ada-mode.el (ada-mode-abbrev-table):
- Consolidate declaration.
- (ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in
- the declaration.
- (ada-create-syntax-table): Remove.
- (ada-capitalize-word): Don't mess with the syntax of "_" since it
- already has the right syntax nowadays.
- (ada-goto-next-word): Don't change the syntax of "_".
-
- * font-lock.el (lisp-font-lock-keywords-2): Don't highlight obsolete
- with-wrapper-hook.
-
-2013-05-08 Sam Steingold <sds@gnu.org>
-
- * thingatpt.el (thing-at-point): Accept optional second argument
- NO-PROPERTIES to strip the text properties from the return value.
- * net/browse-url.el (browse-url-url-at-point): Pass NO-PROPERTIES
- to `thing-at-point' instead of stripping the properties ourselves.
- Also, when `thing-at-point' fails to find a url, prepend "http://"
- to the filename at point on the assumption that the user is
- pointing at something like gnu.org/gnu.
-
-2013-05-08 Juanma Barranquero <lekktu@gmail.com>
-
- * emacs-lisp/bytecomp.el (byte-compile-insert-header):
- * faces.el (crm-separator):
- Silence byte-compiler.
-
- * progmodes/gud.el (gdb-speedbar-auto-raise, gud-tooltip-mode)
- (tool-bar-map): Remove unneeded defvars.
-
-2013-05-08 Leo Liu <sdl.web@gmail.com>
-
- Re-work a fix for bug#10994 based on Le Wang's patch.
- * ido.el (ido-remove-consecutive-dups): New helper.
- (ido-completing-read): Use it.
- (ido-chop): Revert fix for bug#10994.
-
-2013-05-08 Adam Spiers <emacs@adamspiers.org>
-
- * cus-edit.el (custom-save-variables):
- Pretty-print long values. (Bug#14187)
-
-2013-05-08 Glenn Morris <rgm@gnu.org>
-
- * progmodes/m4-mode.el (m4-program): Assume it is in PATH.
- (m4-mode-syntax-table): Init in the defvar.
- (m4-mode-abbrev-table): Let define-derived-mode define it.
-
-2013-05-08 Tom Tromey <tromey@redhat.com>
-
- * progmodes/m4-mode.el (m4-mode-syntax-table):
- Do not treat "_" as word constituent. (Bug#14167)
-
-2013-05-07 Glenn Morris <rgm@gnu.org>
-
- * eshell/em-hist.el (eshell-isearch-map): Initialize in the defvar.
- Remove explicit eshell-isearch-cancel-map.
-
- * progmodes/f90.el (f90-smart-end-names): New option.
- (f90-smart-end): Doc fix.
- (f90-end-block-optional-name): New constant.
- (f90-block-match): Respect f90-smart-end-names.
-
-2013-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/octave.el (octave-smie-forward-token): Be more careful
- about implicit semi-colons (bug#14218).
-
-2013-05-07 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
-
- * frame.el (display-monitor-attributes-list)
- (frame-monitor-attributes): New functions.
-
-2013-05-06 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-syntax-propertize-function): Change
- \'s syntax to escape when inside double-quoted strings. (Bug#14332)
- (octave-font-lock-keywords): Use octave-operator-regexp.
- (octave-completion-at-point): Rename from
- octave-completion-at-point-function.
- (inferior-octave-directory-tracker): Robustify.
- (octave-text-functions): Remove and fix its uses. No such things
- any more.
-
-2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/trace.el (trace--display-buffer): New function.
- (trace-make-advice): Use it.
-
-2013-05-06 Juri Linkov <juri@jurta.org>
-
- * emacs-lisp/lisp-mode.el (eval-defun-2): Doc fix. (Bug#14344)
- (eval-defun-2, eval-defun, eval-last-sexp, eval-last-sexp-1):
- Doc fix.
- (emacs-lisp-mode-map): Replace "minibuffer" with "echo area"
- in the help string. (Bug#12985)
-
-2013-05-06 Kelly Dean <kellydeanch@yahoo.com> (tiny change)
-
- * simple.el (shell-command-on-region): Doc fix. (Bug#14279)
-
-2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/perl-mode.el: Add support for here documents.
- (perl-syntax-propertize-function): Match here-doc markers.
- (perl-syntax-propertize-special-constructs): Find their end.
- (perl-imenu-generic-expression): Use [:alnum:].
-
- * emacs-lisp/nadvice.el (advice--member-p): Return the advice if found.
- (advice--add-function): Refresh the advice if already present
- (bug#14317).
-
-2013-05-06 Ivan Andrus <darthandrus@gmail.com>
-
- * find-file.el (cc-other-file-alist): Add ".m" for ObjC. (Bug#14339)
-
-2013-05-06 Glenn Morris <rgm@gnu.org>
-
- * w32-fns.el (w32-charset-info-alist): Declare.
-
- * eshell/em-cmpl.el: Simply require pcomplete; eg we use a bunch
- of its defcustom properties.
- (eshell-cmpl-initialize): No need to load pcomplete.
-
- * generic-x.el: No need to require comint when compiling.
-
- * net/eudc-export.el: Make it loadable without bbdb.
- (top-level): Use require rather than load-library.
- (eudc-create-bbdb-record, eudc-bbdbify-phone)
- (eudc-batch-export-records-to-bbdb)
- (eudc-insert-record-at-point-into-bbdb, eudc-try-bbdb-insert):
- Require bbdb.
-
-2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/octave.el (octave-texinfo-font-lock-keywords): Remove.
- (octave-font-lock-texinfo-comment): Use texinfo-font-lock-keywords with
- some tweaks, instead.
-
-2013-05-05 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-font-lock-keywords)
- (octave-font-lock-texinfo-comment): Adjust for the byte-compiler.
- (inferior-octave-send-list-and-digest): Improve error message.
- (octave-mode, inferior-octave-mode): Use setq-local.
- (octave-help): Set info-lookup-mode.
-
-2013-05-05 Richard Stallman <rms@gnu.org>
-
- * vc/compare-w.el (compare-windows-whitespace):
- Treat no-break space as whitespace.
-
- * mail/rmailsum.el (rmail-summary-rmail-update):
- Detect empty summary and don't change selected message.
- (rmail-summary-goto-msg): Likewise.
-
- * mail/rmailsum.el (rmail-new-summary, rmail-new-summary-1):
- Doc fixes, rename args.
-
-2013-05-05 Alan Mackenzie <acm@muc.de>
-
- * progmodes/cc-defs.el (c-version): Increment to 5.32.5.
-
-2013-05-05 Juri Linkov <juri@jurta.org>
-
- * info.el (Info-read-subfile): Use (point-min) instead of (point)
- to not add the length of the summary segment to the return value.
- (Bug#14125)
-
-2013-05-05 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-strip-ctrl-g)
- (inferior-octave-output-filter): Remove.
- (octave-send-region, inferior-octave-startup): Fix callers.
- (inferior-octave-mode-map): Don't use comint-dynamic-complete.
- (octave-binary-file-extensions): New user variable.
- (octave-find-definition): Confirm if opening binary files.
- (octave-help-file): Use octave-find-definition to get the binary
- confirmation.
- (octave-help): Adjust for octave-help-file change.
-
-2013-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/pascal.el (pascal-font-lock-keywords): Use backquotes.
- Merge the two entries that handle function definitions.
- (pascal--syntax-propertize): New const.
- (pascal-mode): Use it. Use setq-local.
-
-2013-05-04 Glenn Morris <rgm@gnu.org>
-
- * calendar/diary-lib.el (diary-from-outlook-function): New variable.
- (diary-from-outlook): Respect diary-from-outlook-function.
-
-2013-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * simple.el (read-expression-map): Use completion-at-point (bug#14255).
- Move the declaration from C.
- (read-minibuffer, eval-minibuffer): Move from C.
- (completion-setup-function): Avoid minibuffer-completion-contents.
-
-2013-05-03 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-font-lock-keywords): Do not
- dehighlight 'end' in comments or strings.
- (octave-completing-read, octave-goto-function-definition):
- New helpers.
- (octave-help-buffer): New user variable.
- (octave-help-file, octave-help-function): New button types.
- (octave-help): New command and bind it to C-h ;.
- (octave-find-definition): New command and bind it to M-.
- (user-error): Alias to error if not defined.
-
-2013-05-02 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-mode-syntax-table): Correct syntax
- for \. (bug#14332)
- (octave-font-lock-keywords): Include [ and {.
-
-2013-05-02 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup-file): Change default.
- (inferior-octave): Remove calling comint-mode and return the buffer.
- (inferior-octave-startup): Cosmetic changes.
-
-2013-05-02 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-syntax-propertize-function):
- Include the case when ' is at line beginning. (Bug#14336)
-
-2013-05-02 Glenn Morris <rgm@gnu.org>
-
- * vc/vc-dir.el (vc-dir-mode): Don't autoload it for everyone.
- * desktop.el (vc-dir-mode): Just autoload it here.
-
-2013-05-02 Alan Mackenzie <acm@muc.de>
-
- Eliminate variable c-standard-font-lock-fontify-region-function.
- * progmodes/cc-mode.el
- (c-standard-font-lock-fontify-region-function): Remove.
- (c-font-lock-fontify-region, c-after-font-lock-init): Adapt.
-
-2013-05-01 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el: Compatible with older emacs-24 releases.
- (inferior-octave-has-built-in-variables): Remove. Built-in
- variables were removed from Octave in 2007.
- (inferior-octave-startup): Fix uses.
- (comint-line-beginning-position): Remove compatibility code for
- emacs 21.
-
-2013-05-01 Juri Linkov <juri@jurta.org>
-
- * isearch.el (isearch-forward, isearch-mode): Doc fix. (Bug#13923)
-
-2013-05-01 Juri Linkov <juri@jurta.org>
-
- * comint.el (comint-previous-matching-input): Don't print message
- "History item: %d" when `isearch-mode' is active.
- (comint-history-isearch-message): Print message "History item: %d"
- when `comint-input-ring-index' is not empty and this function is
- called from `isearch-update' with a nil `ellipsis'. (Bug#13223)
-
-2013-05-01 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-abbrev-table): Remove abbrev
- definitions. Use completion-at-point to insert keywords.
- (octave-abbrev-start): Remove.
- (inferior-octave-mode, octave-mode): Use :abbrev-table instead.
-
-2013-04-30 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-prompt-read-only): Fix last
- change.
-
-2013-04-30 Alan Mackenzie <acm@muc.de>
-
- Handle arbitrarily long C++ member initialisation lists.
- * progmodes/cc-engine.el (c-back-over-member-initializers):
- new function.
- (c-guess-basic-syntax): New CASE 5R (extracted from 5B) to handle
- (most) member init lists.
-
-2013-04-30 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
-
- * progmodes/octave.el (inferior-octave-prompt-read-only): New user
- variable.
-
-2013-04-30 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-variables): Remove. No builtin
- variables any more. All converted to functions.
- (octave-font-lock-keywords, octave-completion-at-point-function):
- Fix uses.
- (octave-font-lock-texinfo-comment): New user variable.
- (octave-texinfo-font-lock-keywords): New variable for texinfo
- comment block.
- (octave-function-comment-block): New face.
- (octave-font-lock-texinfo-comment): New function.
- (octave-mode): Font lock texinfo comment block.
-
-2013-04-29 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-font-lock-keywords): Handle 'end' in
- indexing expression.
- (octave-continuation-string): Do not use \.
- (inferior-octave-complete-impossible): Remove.
- (inferior-octave-completion-table)
- (inferior-octave-completion-at-point): Remove its uses.
- (inferior-octave-startup): completion_matches was introduced to
- Octave in 1996 so safe to assume it.
- (octave-function-file-comment): Improve to follow how Octave does it.
- (octave-update-function-file-comment): Tweak.
-
-2013-04-29 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (inferior-octave-startup-hook): Obsolete.
- (inferior-octave-startup): Remove inferior-octave-startup-hook.
- (octave-function-file-comment): Fix typo.
- (octave-sync-function-file-names): Use read-char-choice.
-
-2013-04-28 Jay Belanger <jay.p.belanger@gmail.com>
-
- * calc/calc.el (math-normalize): Don't set `math-normalize-error'
- to t for the less important warnings.
-
-2013-04-27 Darren Hoo <darren.hoo@gmail.com> (tiny change)
-
- * isearch.el (isearch-fail-pos): Check for empty `cmds'. (Bug#14268)
-
-2013-04-27 Glenn Morris <rgm@gnu.org>
-
- * vc/log-view.el (log-view-current-entry):
- Treat "---" separator lines as part of the following rev. (Bug#14169)
-
-2013-04-27 Juri Linkov <juri@jurta.org>
-
- * subr.el (read-number): Doc fix about using it by interactive
- code letter `n'. (Bug#14254)
-
-2013-04-27 Juri Linkov <juri@jurta.org>
-
- * desktop.el (desktop-auto-save-timeout): New option.
- (desktop-file-checksum): New variable.
- (desktop-save): Add optional arg `auto-save' and don't auto-save
- if nothing changed.
- (desktop-auto-save-timer): New variable.
- (desktop-auto-save, desktop-auto-save-set-timer): New functions.
- (after-init-hook): Call `desktop-auto-save-set-timer'.
- Suggested by Reuben Thomas <rrt@sc3d.org> in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00327.html>.
-
-2013-04-27 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-function-file-p)
- (octave-skip-comment-forward, octave-function-file-comment)
- (octave-update-function-file-comment): New functions.
- (octave-mode-map): Bind C-c ; to
- octave-update-function-file-comment.
- (octave-mode-menu): Add octave-update-function-file-comment.
- (octave-mode, inferior-octave-mode): Fix doc-string.
- (octave-insert-defun): Conform to Octave's coding convention.
- (Bug#14285)
-
- * files.el (basic-save-buffer): Don't let errors in
- before-save-hook prevent saving buffer.
-
-2013-04-20 Roland Winkler <winkler@gnu.org>
-
- * faces.el (read-face-name): Use completing-read if arg multiple
- is nil.
-
-2013-04-27 Ingo Lohmar <i.lohmar@gmail.com> (tiny change)
-
- * ls-lisp.el (ls-lisp-insert-directory): If no files are
- displayed, move point to after the totals line.
- See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00677.html
- for the details.
-
-2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-autoload-ensure-default-file):
- Add current dir to the load-path.
- (package-generate-autoloads): Don't rely on
- autoload-ensure-default-file.
-
-2013-04-26 Reuben Thomas <rrt@sc3d.org>
-
- * textmodes/remember.el (remember-store-in-files): Document that
- the file name format is passed to `format-time-string'.
-
-2013-04-26 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-sync-function-file-names): New function.
- (octave-mode): Use it in before-save-hook.
-
-2013-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/tabulated-list.el (tabulated-list-mode): Disable undo
- (bug#14274).
-
- * progmodes/octave.el (octave-smie-forward-token): Properly skip
- \n and comment, even if it's not an implicit ; (bug#14218).
-
-2013-04-26 Glenn Morris <rgm@gnu.org>
-
- * subr.el (read-number): Once more use `read' rather than
- `string-to-number', to trap non-numeric input. (Bug#14254)
-
-2013-04-26 Erik Charlebois <erikcharlebois@gmail.com>
-
- * emacs-lisp/syntax.el (syntax-propertize-multiline):
- Use `syntax-multiline' text property consistently instead of
- `font-lock-multiline'. (Bug#14237)
-
-2013-04-26 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/shadow.el (list-load-path-shadows):
- No longer necessary to check for duplicate simple.el, since
- 2012-07-07 change to init_lread to not include installation lisp
- directories in load-path when running uninstalled. (Bug#14270)
-
-2013-04-26 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-submit-bug-report): Obsolete.
- (octave-mode, inferior-octave-mode): Use setq-local.
- (octave-not-in-string-or-comment-p): Rename to
- octave-in-string-or-comment-p.
- (octave-in-comment-p, octave-in-string-p)
- (octave-in-string-or-comment-p): Replace defsubst with defun.
-
-2013-04-25 Paul Eggert <eggert@cs.ucla.edu>
-
- * Makefile.in (distclean): Remove $(lisp)/loaddefs.el~.
-
-2013-04-25 Bastien Guerry <bzg@gnu.org>
-
- * textmodes/remember.el (remember-data-directory)
- (remember-directory-file-name-format): Fix custom types.
-
-2013-04-25 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave.el (octave-completion-at-point-function):
- Make use of inferior octave process.
- (octave-initialize-completions): Remove.
- (inferior-octave-completion-table): New function.
- (inferior-octave-completion-at-point): Use it.
- (octave-completion-alist): Remove.
-
-2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/opascal.el: Use font-lock and syntax-propertize.
- (opascal-mode-syntax-table): New var.
- (opascal-literal-kind, opascal-is-literal-end)
- (opascal-literal-token-at): Rewrite.
- (opascal--literal-start-re, opascal-font-lock-keywords)
- (opascal--syntax-propertize): New constants.
- (opascal-font-lock-defaults): Adjust.
- (opascal-mode): Use them. Set comment-<foo> variables as well.
- (delphi-comment-face, opascal-comment-face, delphi-string-face)
- (opascal-string-face, delphi-keyword-face, opascal-keyword-face)
- (delphi-other-face, opascal-other-face): Remove face variables.
- (opascal-save-state): Remove macro.
- (opascal-fontifying-progress-step): Remove constant.
- (opascal--ignore-changes): Remove var.
- (opascal-set-token-property, opascal-parse-next-literal)
- (opascal-is-stable-literal, opascal-complete-literal)
- (opascal-is-literal-start, opascal-face-of)
- (opascal-parse-region, opascal-parse-region-until-stable)
- (opascal-fontify-region, opascal-after-change)
- (opascal-debug-show-is-stable, opascal-debug-unparse-buffer)
- (opascal-debug-parse-region, opascal-debug-parse-window)
- (opascal-debug-parse-buffer, opascal-debug-fontify-window)
- (opascal-debug-fontify-buffer): Remove.
- (opascal-debug-mode-map): Adjust accordingly.
-
-2013-04-25 Leo Liu <sdl.web@gmail.com>
-
- Merge octave-mod.el and octave-inf.el into octave.el with some
- cleanups.
- * progmodes/octave.el: New file renamed from octave-mod.el.
- * progmodes/octave-inf.el: Merged into octave.el.
- * progmodes/octave-mod.el: Renamed to octave.el.
-
-2013-04-25 Tassilo Horn <tsdh@gnu.org>
-
- * textmodes/reftex-vars.el
- (reftex-label-ignored-macros-and-environments): New defcustom.
-
- * textmodes/reftex-parse.el (reftex-parse-from-file): Use it.
-
-2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/smie.el (smie-indent--hanging-p): Don't burp at EOB.
- (smie-indent-keyword): Improve the check to ensure that the next
- comment is really on the same line.
- (smie-indent-comment): Don't align with a subsequent closer (or eob).
-
- * progmodes/octave-mod.el (octave-smie-forward-token): Only emit
- semi-colons if the line is not otherwise empty (bug#14218).
-
-2013-04-25 Glenn Morris <rgm@gnu.org>
-
- * vc/vc-bzr.el (vc-bzr-print-log): Tweak LIMIT = 1 case.
-
-2013-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/opascal.el (opascal-set-token-property): Rename from
- opascal-set-text-properties and only set `token' (bug#14134).
- Suggested by Erik Knowles <eknowles@geosystemsoftware.com>.
- (opascal-literal-text-properties): Remove.
- (opascal-parse-next-literal, opascal-debug-unparse-buffer):
- Adjust callers.
-
-2013-04-24 Reuben Thomas <rrt@sc3d.org>
-
- * textmodes/remember.el (remember-handler-functions): Add an
- option for a new handler `remember-store-in-files'.
- (remember-data-directory, remember-directory-file-name-format):
- New options.
- (remember-store-in-files): New function to store remember notes
- as separate files within a directory.
-
-2013-04-24 Magnus Henoch <magnus.henoch@gmail.com>
-
- * progmodes/compile.el (compilation-next-error-function):
- Pass "formats" to compilation-find-file (bug#11777).
-
-2013-04-24 Glenn Morris <rgm@gnu.org>
-
- * vc/vc-bzr.el (vc-bzr-print-log):
- * vc/vc-hg.el (vc-hg-print-log):
- * vc/vc-svn.el (vc-svn-print-log):
- Fix START-REVISION with LIMIT != 1. (Bug#14168)
-
- * vc/vc-bzr.el (vc-bzr-print-log):
- * vc/vc-cvs.el (vc-cvs-print-log):
- * vc/vc-git.el (vc-git-print-log):
- * vc/vc-hg.el (vc-hg-print-log):
- * vc/vc-mtn.el (vc-mtn-print-log):
- * vc/vc-rcs.el (vc-rcs-print-log):
- * vc/vc-sccs.el (vc-sccs-print-log):
- * vc/vc-svn.el (vc-svn-print-log):
- * vc/vc.el (vc-print-log-internal): Doc fixes.
-
-2013-04-23 Glenn Morris <rgm@gnu.org>
-
- * startup.el (normal-no-mouse-startup-screen, normal-about-screen):
- Remove venerable code attempting to avoid substitute-command-keys.
-
-2013-04-23 Tassilo Horn <tsdh@gnu.org>
-
- * textmodes/reftex-vars.el (reftex-label-regexps):
- Call `reftex-compile-variables' after changes to this variable.
-
-2013-04-23 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * jit-lock.el: Fix signals in jit-lock-force-redisplay (bug#13542).
- Use lexical-binding.
- (jit-lock-force-redisplay): Use markers, check buffer's continued
- existence and beware narrowed buffers.
- (jit-lock-fontify-now): Adjust call accordingly.
-
-2013-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * minibuffer.el (minibuffer-completion-contents): Fix obsolescence info
- to avoid misleading the user.
-
-2013-04-22 Leo Liu <sdl.web@gmail.com>
-
- * info-look.el: Prefer latex2e.info. (Bug#14240)
-
-2013-04-22 Michael Albinus <michael.albinus@gmx.de>
-
- Fix pack/unpack coding. Reported by David Smith <davidsmith@acm.org>.
-
- * net/tramp-compat.el (tramp-compat-call-process): Move function ...
- * net/tramp.el (tramp-call-process): ... here.
- (tramp-set-completion-function, tramp-parse-putty):
- * net/tramp-adb.el (tramp-adb-execute-adb-command):
- * net/tramp-gvfs.el (tramp-gvfs-send-command):
- * net/tramp-sh.el (tramp-sh-handle-set-file-times)
- (tramp-set-file-uid-gid, tramp-sh-handle-write-region)
- (tramp-call-local-coding-command): Use `tramp-call-process'
- instead of `tramp-compat-call-process'.
-
- * net/tramp-sh.el (tramp-perl-pack, tramp-perl-unpack): New defconst.
- (tramp-local-coding-commands, tramp-remote-coding-commands): Use them.
- (tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region):
- (tramp-find-inline-compress): Improve traces.
- (tramp-maybe-send-script): Check for Perl binary.
- (tramp-get-inline-coding): Do not redirect STDOUT for local decoding.
-
-2013-04-22 Daiki Ueno <ueno@gnu.org>
-
- * epg.el (epg-context-pinentry-mode): New function.
- (epg-context-set-pinentry-mode): New function.
- (epg--start): Pass --pinentry-mode option to gpg command.
-
-2013-04-21 Xue Fuqiao <xfq.free@gmail.com>
-
- * comint.el (comint-dynamic-complete-functions, comint-mode-map):
- `comint-dynamic-complete' is obsolete since 24.1, replaced by
- `completion-at-point'. (Bug#13774)
-
- * startup.el (normal-no-mouse-startup-screen): Bug fix, the
- default key binding for `describe-distribution' has been moved to
- `C-h C-o'. (Bug#13970)
-
-2013-04-21 Glenn Morris <rgm@gnu.org>
-
- * vc/vc.el (vc-print-log-setup-buttons, vc-print-log-internal):
- Add doc strings.
- (vc-print-log): Clarify interactive prompt.
-
-2013-04-20 Glenn Morris <rgm@gnu.org>
-
- * emacs-lisp/bytecomp.el (byte-compile-insert-header):
- No longer include timestamp etc information.
-
-2013-04-20 Roland Winkler <winkler@gnu.org>
-
- * faces.el (read-face-name): Bug fix, return just one face if arg
- multiple is nil. (Bug#14209)
-
-2013-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el (advice--where-alist): Add :override.
- (remove-function): Autoload.
-
- * comint.el (comint-redirect-original-filter-function): Remove.
- (comint-redirect-cleanup, comint-redirect-send-command-to-process):
- * vc/vc-cvs.el (vc-cvs-annotate-process-filter)
- (vc-cvs-annotate-command):
- * progmodes/octave-inf.el (inferior-octave-send-list-and-digest):
- * progmodes/prolog.el (prolog-consult-compile):
- * progmodes/gdb-mi.el (gdb, gdb--check-interpreter):
- Use add/remove-function instead.
- * progmodes/gud.el (gud-tooltip-original-filter): Remove.
- (gud-tooltip-process-output, gud-tooltip-tips):
- Use add/remove-function instead.
- * progmodes/xscheme.el (xscheme-previous-process-state): Remove.
- (scheme-interaction-mode, exit-scheme-interaction-mode):
- Use add/remove-function instead.
-
- * vc/vc-dispatcher.el: Use lexical-binding.
- (vc--process-sentinel): Rename from vc-process-sentinel.
- Change last arg to be the code to run. Don't use vc-previous-sentinel
- and vc-sentinel-commands any more.
- (vc-exec-after): Allow code to be a function. Use add/remove-function.
- (compilation-error-regexp-alist, view-old-buffer-read-only): Declare.
-
-2013-04-19 Masatake YAMATO <yamato@redhat.com>
-
- * progmodes/sh-script.el (sh-imenu-generic-expression):
- Handle function names with a single character. (Bug#14111)
-
-2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change)
-
- * progmodes/gud.el (gud-perldb-marker-filter): Understand position info
- for subroutines defined in an eval (bug#14182).
-
-2013-04-19 Thierry Volpiatto <thierry.volpiatto@gmail.com>
-
- * bookmark.el (bookmark-completing-read): Improve handling of empty
- string (bug#14176).
-
-2013-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * vc/vc-dispatcher.el (vc-do-command): Get rid of default sentinel msg.
-
-2013-04-19 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- New faster Imenu implementation (bug#14058).
- * progmodes/python.el:
- (python-imenu-prev-index-position):
- (python-imenu-format-item-label-function)
- (python-imenu-format-parent-item-label-function)
- (python-imenu-format-parent-item-jump-label-function):
- New vars.
- (python-imenu-format-item-label)
- (python-imenu-format-parent-item-label)
- (python-imenu-format-parent-item-jump-label)
- (python-imenu--put-parent, python-imenu--build-tree)
- (python-imenu-create-index, python-imenu-create-flat-index)
- (python-util-popn): New functions.
- (python-mode): Set imenu-create-index-function to
- python-imenu-create-index.
-
-2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * winner.el (winner-active-region): Use region-active-p, activate-mark
- and deactivate-mark (bug#14225).
-
- * simple.el (deactivate-mark): Don't inline it.
-
-2013-04-18 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-sh.el (tramp-remote-process-environment): Add "TMOUT=0".
-
-2013-04-18 Tassilo Horn <tsdh@gnu.org>
-
- * files.el (auto-mode-alist): Delete OpenDocument and StarOffice
- file extensions from the archive-mode entry in order to prefer
- doc-view-mode-maybe with archive-mode as fallback (bug#14188).
-
-2013-04-18 Leo Liu <sdl.web@gmail.com>
-
- * bindings.el (help-event-list): Add ?\?.
-
-2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (with-wrapper-hook): Declare obsolete.
- * simple.el (filter-buffer-substring-function): New hook.
- (filter-buffer-substring): Use it.
- (filter-buffer-substring-functions): Mark obsolete.
- * minibuffer.el (completion-in-region-function): New hook.
- (completion-in-region): Use it.
- (completion-in-region-functions): Mark obsolete.
- * mail/mailabbrev.el (mail-abbrevs-setup): Use abbrev-expand-function.
- * abbrev.el (abbrev-expand-function): New hook.
- (expand-abbrev): Use it.
- (abbrev-expand-functions): Mark obsolete.
- * emacs-lisp/nadvice.el (advice--where-alist): Add :filter-args
- and :filter-return.
-
-2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- * progmodes/python.el (python-nav--syntactically): Fix cornercases
- and do not care about match data.
-
-2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/lisp.el (lisp-completion-at-point): Provide specialized
- completion tables when completing error conditions and
- `declare' arguments.
- (lisp-complete-symbol, field-complete): Mark as obsolete.
- (check-parens): Unmatched parens are user errors.
- * minibuffer.el (minibuffer-completion-contents): Mark as obsolete.
-
-2013-04-17 Michal Nazarewicz <mina86@mina86.com>
-
- * textmodes/flyspell.el (flyspell-check-pre-word-p): Return nil if
- command changed buffer (ie. `flyspell-pre-buffer' is not current
- buffer), which prevents making decisions based on invalid value of
- `flyspell-pre-point' in the wrong buffer. Most notably, this used to
- cause an error when `flyspell-pre-point' was nil after switching
- buffers.
- (flyspell-post-command-hook): No longer needs to change buffers when
- checking pre-word. While at it remove unnecessary progn.
-
-2013-04-17 Nicolas Richard <theonewiththeevillook@yahoo.fr> (tiny change)
-
- * textmodes/ispell.el (ispell-add-per-file-word-list):
- Fix `flyspell-correct-word-before-point' error when accepting
- words and `coment-padding' is an integer by using
- `comment-normalize-vars' (Bug #14214).
-
-2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- New defun movement commands.
- * progmodes/python.el (python-nav--syntactically)
- (python-nav--forward-defun, python-nav-backward-defun)
- (python-nav-forward-defun): New functions.
-
-2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
-
- * progmodes/python.el (python-syntax--context-compiler-macro): New defun.
- (python-syntax-context): Use named compiler-macro for backwards
- compatibility with Emacs 24.x.
-
-2013-04-17 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave-mod.el (octave-mode-map): Fix key binding to
- octave-hide-process-buffer.
-
-2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * vc/vc-hg.el (vc-hg-annotate-re): Disallow ": " in file names
- (bug#14216).
-
-2013-04-17 Jean-Philippe Gravel <jpgravel@gmail.com>
-
- * progmodes/gdb-mi.el (gdbmi-bnf-incomplete-record-result):
- Fix adjustment of offset when receiving incomplete responses from GDB
- (bug#14129).
-
-2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * progmodes/python.el (python-mode-skeleton-abbrev-table): Rename from
- python-mode-abbrev-table.
- (python-skeleton-define): Adjust accordingly.
- (python-mode-abbrev-table): New table that inherits from it so that
- python-skeleton-autoinsert does not affect non-skeleton abbrevs.
-
- * abbrev.el (abbrev--symbol): New function, extracted from abbrev-symbol.
- (abbrev-symbol): Use it.
- (abbrev--before-point): Use it since we already handle inheritance.
-
-2013-04-16 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/octave-mod.el (octave-mode-map): Remove redundant key
- binding to info-lookup-symbol.
-
-2013-04-16 Juanma Barranquero <lekktu@gmail.com>
-
- * minibuffer.el (completion--twq-all):
- * term/ns-win.el (ns-initialize-window-system):
- * term/w32-win.el (w32-initialize-window-system): Silence byte-compiler.
-
-2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el (add-function): Default simple vars to their
- global bindings.
-
- * doc-view.el (doc-view-start-process): Handle url-handler directories.
-
-2013-04-15 Dmitry Gutov <dgutov@yandex.ru>
-
- * progmodes/ruby-mode.el (ruby-beginning-of-defun)
- (ruby-end-of-defun, ruby-move-to-block): Bind `case-fold-search'
- to nil.
- (ruby-end-of-defun): Remove the unused arg, change the docstring
- to reflect that this function is only used as the value of
- `end-of-defun-function'.
- (ruby-beginning-of-defun): Remove "top-level" from the docstring,
- to reflect an earlier change that beginning/end-of-defun functions
- jump between methods in a class definition, as well as top-level
- functions.
-
-2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * minibuffer.el (minibuffer-complete): Don't just scroll
- a *Completions* that's been iconified.
- (minibuffer-force-complete): Make sure repetitions do cycle when going
- through completion-in-region -> minibuffer-complete.
-
-2013-04-15 Alan Mackenzie <acm@muc.de>
-
- Correct the placement of c-cpp-delimiters when there're #s not at
- col 0.
-
- * progmodes/cc-langs.el (c-anchored-cpp-prefix): Reformulate and
- place a submatch around the #.
- * progmodes/cc-mode.el(c-neutralize-syntax-in-and-mark-CPP):
- Start a search at BOL. Put the c-cpp-delimiter category text propertiy
- on the #, not BOL.
-
-2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/nadvice.el: Properly test names when adding advice.
- (advice--member-p): New arg `name'.
- (advice--add-function, advice-member-p): Use it (bug#14202).
-
-2013-04-15 Filipp Gunbin <fgunbin@fastmail.fm>
-
- Reformulate java imenu-generic-expression.
- The old expression contained ill formed regexps.
-
- * progmodes/cc-menus.el (cc-imenu-java-ellipsis-regexp)
- (cc-imenu-java-type-spec-regexp, cc-imenu-java-comment-regexp)
- (cc-imenu-java-method-arg-regexp): New defconsts.
- (cc-imenu-java-build-type-args-regex): New defun.
- (cc-imenu-java-generic-expression): Fix, to remove "ambiguous"
- handling of spaces in the regexp.
-
-2013-03-15 Agustín Martín Domingo <agustin.martin@hispalinux.es>
-
- * textmodes/ispell.el (ispell-command-loop): Remove
- flyspell highlight of a word when ispell accepts it (bug #14178).
-
-2013-04-15 Michael Albinus <michael.albinus@gmx.de>
-
- * net/ange-ftp.el (ange-ftp-run-real-handler-orig): New defun,
- uses code from the previous `ange-ftp-run-real-handler'.
- (ange-ftp-run-real-handler): Set it to `tramp-run-real-handler'
- only in case that function exist. This is needed for proper
- unloading of Tramp.
-
-2013-04-15 Tassilo Horn <tsdh@gnu.org>
-
- * textmodes/reftex-vars.el (reftex-label-regexps): New defcustom.
-
- * textmodes/reftex.el (reftex-compile-variables): Use it.
-
-2013-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * files.el (normal-mode): Only use default major-mode if no other mode
- was specified.
-
- * emacs-lisp/trace.el (trace-values): New function.
-
- * files.el: Allow : in local variables (bug#14089).
- (hack-local-variable-regexp): New var.
- (hack-local-variables-prop-line, hack-local-variables): Use it.
-
-2013-04-13 Roland Winkler <winkler@gnu.org>
-
- * textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match
- data before it gets modified by bibtex-beginning-of-entry.
-
-2013-04-13 Roland Winkler <winkler@gnu.org>
-
- * textmodes/bibtex.el (bibtex-url): Doc fix.
-
-2013-04-13 Roland Winkler <winkler@gnu.org>
-
- * textmodes/bibtex.el (bibtex-initialize): If the current buffer
- does not visit a BibTeX file, exclude it from the list of buffers
- returned by bibtex-initialize.
-
-2013-04-13 Stephen Berman <stephen.berman@gmx.net>
-
- * window.el (split-window): Remove interactive form, since as a
- command this function is a special case of split-window-below.
- Correct doc string.
-
-2013-04-12 Roland Winkler <winkler@gnu.org>
-
- * faces.el (read-face-name): Do not override value of arg default.
- Allow single faces and strings as default values. Remove those
- elements from return value that are not faces.
- (describe-face): Simplify.
- (face-at-point): New optional args thing and multiple so that this
- function can provide the same functionality previously provided by
- read-face-name.
- (make-face-bold, make-face-unbold, make-face-italic)
- (make-face-unitalic, make-face-bold-italic, invert-face)
- (modify-face, read-face-and-attribute): Use face-at-point.
-
- * cus-edit.el (customize-face, customize-face-other-window)
- * cus-theme.el (custom-theme-add-face)
- * face-remap.el (buffer-face-set)
- * facemenu.el (facemenu-set-face): Use face-at-point.
-
-2013-04-12 Michael Albinus <michael.albinus@gmx.de>
-
- * info.el (Info-file-list-for-emacs): Add "tramp" and "dbus".
-
-2013-04-10 Tassilo Horn <tsdh@gnu.org>
-
- * textmodes/reftex-cite.el (reftex-parse-bibtex-entry): Don't cut
- off leading { and trailing } from field values.
-
-2013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/timer.el (timer--check): New function.
- (timer--time, timer-set-function, timer-event-handler): Use it.
- (timer-set-idle-time): Simplify.
- (timer--activate): CSE.
- (timer-event-handler): Give more info in error message.
- (internal-timer-start-idle): New function, moved from C.
-
- * mpc.el (mpc-proc): Add `restart' argument.
- (mpc-proc-cmd): Use it.
- (mpc--status-timer-run): Also catch signals from `mpc-proc'.
- (mpc-status-buffer-show, mpc-tagbrowser-dir-toggle): Call `mpc-proc'
- less often.
-
-2013-04-10 Masatake YAMATO <yamato@redhat.com>
-
- * progmodes/sh-script.el: Implement `sh-mode' own
- `add-log-current-defun-function' (bug#14112).
- (sh-current-defun-name): New function.
- (sh-mode): Use the function.
-
-2013-04-09 Bastien Guerry <bzg@gnu.org>
-
- * simple.el (choose-completion-string): Fix docstring (bug#14163).
-
-2013-04-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/edebug.el (edebug-mode): Fix typo (bug#14144).
-
- * emacs-lisp/timer.el (timer-event-handler): Don't retrigger a canceled
- timer (bug#14156).
-
-2013-04-07 Nic Ferrier <nferrier@ferrier.me.uk>
-
- * emacs-lisp/ert.el (should, should-not, should-error): Add edebug
- declaration.
-
-2013-04-07 Leo Liu <sdl.web@gmail.com>
-
- * pcmpl-x.el: New file.
-
-2013-04-06 Dmitry Antipov <dmantipov@yandex.ru>
-
- Do not set x-display-name until X connection is established.
- This is needed to prevent from weird situation described at
- <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00212.html>.
- * frame.el (make-frame): Set x-display-name after call to
- window system initialization function, not before.
- * term/x-win.el (x-initialize-window-system): Add optional
- display argument and use it.
- * term/w32-win.el (w32-initialize-window-system):
- * term/ns-win.el (ns-initialize-window-system):
- * term/pc-win.el (msdos-initialize-window-system):
- Add compatible optional display argument.
-
-2013-04-06 Eli Zaretskii <eliz@gnu.org>
-
- * files.el (normal-backup-enable-predicate): On MS-Windows and
- MS-DOS compare truenames of temporary-file-directory and of the
- file, so that 8+3 aliases (usually found in $TEMP on Windows)
- don't fail comparison by compare-strings. Also, compare file
- names case-insensitively on MS-Windows and MS-DOS.
-
-2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-compute-transaction): Fix last fix.
- Suggested by Donald Curtis <dcurtis@coe.edu> (bug#14082).
-
-2013-04-05 Dmitry Gutov <dgutov@yandex.ru>
-
- * whitespace.el (whitespace-color-on, whitespace-color-off):
- Only call `font-lock-fontify-buffer' when `font-lock-mode' is on.
-
-2013-04-05 Jacek Chrząszcz <chrzaszcz@mimuw.edu.pl> (tiny change)
-
- * ispell.el (ispell-set-spellchecker-params):
- Really set `ispell-args' for all equivs.
-
-2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * ido.el (ido-completions): Use extra elements of ido-decorations
- (bug#14143).
- (ido-decorations): Update docstring.
-
-2013-04-05 Michael Albinus <michael.albinus@gmx.de>
-
- * autorevert.el (auto-revert-mode, auto-revert-tail-mode)
- (global-auto-revert-mode): Let-bind `auto-revert-use-notify' to
- nil during initialization, in order not to miss changes since the
- file was opened. (Bug#14140)
-
-2013-04-05 Leo Liu <sdl.web@gmail.com>
-
- * kmacro.el (kmacro-call-macro): Fix bug#14135.
-
-2013-04-05 Jay Belanger <jay.p.belanger@gmail.com>
-
- * calc/calc-units.el (calc-convert-units): Rewrite conditional.
-
-2013-04-04 Glenn Morris <rgm@gnu.org>
-
- * electric.el (electric-pair-inhibit-predicate): Add :version.
-
-2013-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/package.el (package-compute-transaction): Fix ordering
- when a package is required several times (bug#14082).
-
-2013-04-04 Roland Winkler <winkler@gnu.org>
-
- * faces.el (read-face-name): Behave as promised by the docstring.
- Assume that arg default is a list of faces.
- (describe-face): Call read-face-name with list of default faces.
-
-2013-04-04 Thierry Volpiatto <thierry.volpiatto@gmail.com>
-
- * bookmark.el: Fix deletion of bookmarks (bug#13972).
- (bookmark-bmenu-list): Don't toggle filenames if alist is empty.
- (bookmark-bmenu-execute-deletions): Only skip first line if it's
- the header.
- (bookmark-exit-hook-internal): Save even if list is empty.
-
-2013-04-04 Yann Hodique <yann.hodique@gmail.com> (tiny change)
-
- * emacs-lisp/package.el (package-pinned-packages): New var.
- (package--add-to-archive-contents): Obey it (bug#14118).
-
-2013-04-03 Alan Mackenzie <acm@muc.de>
-
- Handle `parse-partial-sexp' landing inside a comment opener (Bug#13244).
- Also adapt to the new values of element 7 of a parse state.
-
- * progmodes/cc-engine.el (c-state-pp-to-literal): New optional
- parameter `not-in-delimiter'. Handle being inside comment opener.
- (c-invalidate-state-cache-1): Reckon with an extra "invalid"
- character in case we're typing a '*' after a '/'.
- (c-literal-limits): Handle the awkward "not-in-delimiter" cond arm
- instead by passing the parameter to c-state-pp-to-literal.
-
- * progmodes/cc-fonts.el (c-font-lock-doc-comments): New handling
- for elt. 7 of a parse state.
-
-2013-04-01 Paul Eggert <eggert@cs.ucla.edu>
-
- Use UTF-8 for most files with non-ASCII characters (Bug#13936).
- * international/latin1-disp.el, international/mule-util.el:
- * language/cyril-util.el, language/european.el, language/ind-util.el:
- * language/lao-util.el, language/thai.el, language/tibet-util.el:
- * language/tibetan.el, language/viet-util.el:
- Switch from iso-2022-7bit to utf-8 or (if needed) utf-8-emacs.
-
-2013-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * electric.el (electric-pair-inhibit-predicate): New var (bug#14000).
- (electric-pair-post-self-insert-function): Use it.
- (electric-pair-default-inhibit): New function, extracted from
- electric-pair-post-self-insert-function.
-
-2013-03-31 Roland Winkler <winkler@gnu.org>
-
- * emacs-lisp/crm.el (completing-read-multiple): Doc fix.
-
-2013-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * hi-lock.el (hi-lock-mode): Cleanup after revert-buffer (bug#13891).
-
-2013-03-30 Fabián Ezequiel Gallina <fabian@anue.biz>
-
- Un-indent after "pass" and "return" statements (Bug#13888)
- * progmodes/python.el (python-indent-block-enders): New var.
- (python-indent-calculate-indentation): Use it.
-
-2013-03-30 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp.el (tramp-drop-volume-letter): Make it an ordinary
- defun. Defining it as defalias could introduce too eager
- byte-compiler optimization. (Bug#14030)
-
-2013-03-30 Chong Yidong <cyd@gnu.org>
-
- * iswitchb.el (iswitchb-read-buffer): Fix typo.
-
-2013-03-30 Leo Liu <sdl.web@gmail.com>
-
- * kmacro.el (kmacro-call-macro): Add optional arg MACRO.
- (kmacro-execute-from-register): Pass the keyboard macro to
- kmacro-call-macro or repeating won't work correctly.
-
-2013-03-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/subword.el: Back to using `forward-symbol'.
-
- * subr.el (forward-whitespace, forward-symbol)
- (forward-same-syntax): Move from thingatpt.el.
-
-2013-03-29 Leo Liu <sdl.web@gmail.com>
-
- * kmacro.el (kmacro-to-register): New command.
- (kmacro-execute-from-register): New function.
- (kmacro-keymap): Bind to 'x'. (Bug#14071)
-
-2013-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mpc.el: Use defvar-local and setq-local.
- (mpc--proc-connect): Connection failures are not bugs.
- (mpc-mode-map): `follow-link' only applies to the buffer's content.
- (mpc-volume-map): Bind to the up-events.
-
-2013-03-29 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/subword.el (superword-mode): Use `forward-sexp'
- instead of `forward-symbol'.
-
-2013-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/edebug.el (edebug-mode): Make it a minor mode.
- (edebug--recursive-edit): Use it.
- (edebug-kill-buffer): Don't let-bind kill-buffer-hook.
- (edebug-temp-display-freq-count): Don't let-bind buffer-read-only.
-
-2013-03-28 Leo Liu <sdl.web@gmail.com>
-
- * vc/vc-bzr.el (vc-bzr-revert): Don't backup. (Bug#14066)
-
-2013-03-27 Eli Zaretskii <eliz@gnu.org>
-
- * facemenu.el (list-colors-callback): New defvar.
- (list-colors-redisplay): New function.
- (list-colors-display): Install list-colors-redisplay as the
- revert-buffer-function. (Bug#14063)
-
-2013-03-27 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * minibuffer.el (completion-pcm--merge-completions): Make sure prefixes
- and suffixes don't overlap (bug#14061).
-
- * case-table.el: Use lexical-binding.
- (case-table-get-table): New function.
- (get-upcase-table): Use it. Mark as obsolete. Adjust callers.
-
-2013-03-27 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/subword.el: Add `superword-mode' to do word motion
- over symbol_words (parallels and leverages `subword-mode' which
- does word motion inside MixedCaseWords).
-
-2013-03-27 Aidan Gauland <aidalgol@no8wireless.co.nz>
-
- * eshell/em-unix.el: Move su and sudo to...
- * eshell/em-tramp.el: ...Eshell tramp module.
-
-2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * desktop.el (desktop--v2s): Rename from desktop-internal-v2s.
- Change return value to be a sexp. Delay `get-buffer' to after
- restoring the desktop (bug#13951).
-
-2013-03-26 Leo Liu <sdl.web@gmail.com>
-
- * register.el: Move semantic tag handling back to
- cedet/semantic/senator.el. (Bug#14052)
-
-2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert
- into the prompt either (bug#13963).
-
-2013-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error"
- part of "(error-foo)".
-
-2013-03-24 Juri Linkov <juri@jurta.org>
-
- * replace.el (list-matching-lines-prefix-face): New defcustom.
- (occur-1): Pass `list-matching-lines-prefix-face' to the function
- `occur-engine' if `face-differs-from-default-p' returns t.
- (occur-engine): Add `,' inside backquote construct to evaluate
- `prefix-face'. Propertize the prefix with the `prefix-face' face.
- Pass `prefix-face' to the functions `occur-context-lines' and
- `occur-engine-add-prefix'.
- (occur-engine-add-prefix, occur-context-lines): Add optional arg
- `prefix-face' and propertize the prefix with `prefix-face'.
- (Bug#14017)
-
-2013-03-24 Leo Liu <sdl.web@gmail.com>
-
- * nxml/rng-valid.el (rng-validate-while-idle)
- (rng-validate-quick-while-idle): Guard against deleted buffer.
- (Bug#13999)
-
- * emacs-lisp/edebug.el (edebug-mode): Make sure edebug-kill-buffer
- is the last entry in kill-buffer-hook.
-
- * files.el (kill-buffer-hook): Doc fix.
-
-2013-03-23 Dmitry Gutov <dgutov@yandex.ru>
-
- * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column):
- Make it safe-local.
-
- * vc/diff-mode.el (diff-mode-shared-map): Unbind "/" (Bug#14034).
-
-2013-03-23 Leo Liu <sdl.web@gmail.com>
-
- * nxml/nxml-util.el (nxml-with-unmodifying-text-property-changes):
- Remove.
-
- * nxml/rng-valid.el (rng-validate-mode)
- (rng-after-change-function, rng-do-some-validation):
- * nxml/rng-maint.el (rng-validate-buffer):
- * nxml/nxml-rap.el (nxml-tokenize-forward, nxml-ensure-scan-up-to-date):
- * nxml/nxml-outln.el (nxml-show-all, nxml-set-outline-state):
- * nxml/nxml-mode.el (nxml-mode, nxml-degrade, nxml-after-change)
- (nxml-extend-after-change-region): Use with-silent-modifications.
-
- * nxml/rng-nxml.el (rng-set-state-after): Do not let-bind
- timer-idle-list.
-
- * nxml/rng-valid.el (rng-validate-while-idle-continue-p)
- (rng-next-error-1, rng-previous-error-1): Do not let-bind
- timer-idle-list. (Bug#13999)
-
-2013-03-23 Juri Linkov <juri@jurta.org>
-
- * info.el (info-index-match): New face.
- (Info-index, Info-apropos-matches): Add a nested subgroup to the
- main pattern and add text properties with the new face to matches
- in index entries relative to the beginning of the index entry.
- (Bug#14015)
-
-2013-03-21 Eric Ludlam <zappo@gnu.org>
-
- * eieio/eieio-datadebug.el (data-debug/eieio-insert-slots):
- Inhibit read only while inserting objects.
-
-2013-03-22 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/cfengine.el: Update docs to mention
- `cfengine-auto-mode'. Use \_> and \_< instead of \> and \< for
- symbol motion. Remove "_" from the word syntax.
-
-2013-03-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/cfengine.el (cfengine-common-syntax): Add "_" to word
- syntax for both `cfengine2-mode' and `cfengine3-mode'.
-
-2013-03-20 Juri Linkov <juri@jurta.org>
-
- * info.el (Info-next-reference-or-link)
- (Info-prev-reference-or-link): New functions.
- (Info-next-reference, Info-prev-reference): Use them.
- (Info-try-follow-nearest-node): Handle footnote navigation.
- (Info-fontify-node): Fontify footnotes. (Bug#13989)
-
-2013-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * subr.el (posn-point, posn-string): Fix it here instead (bug#13979).
- * mouse.el (mouse-on-link-p): Undo scroll-bar fix.
-
-2013-03-20 Paul Eggert <eggert@cs.ucla.edu>
-
- Suppress unnecessary non-ASCII chatter during build process.
- * international/ja-dic-cnv.el (skkdic-collect-okuri-nasi)
- (batch-skkdic-convert): Suppress most of the chatter.
- It's not needed so much now that machines are faster,
- and its non-ASCII component was confusing; see Dmitry Gutov in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00508.html>.
-
-2013-03-20 Leo Liu <sdl.web@gmail.com>
-
- * ido.el (ido-chop): Fix bug#10994.
-
-2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
-
- * whitespace.el (whitespace-font-lock, whitespace-font-lock-mode):
- Remove vars.
- (whitespace-color-on, whitespace-color-off):
- Use `font-lock-fontify-buffer' (Bug#13817).
-
-2013-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mouse.el (mouse--down-1-maybe-follows-link): Fix follow-link
- remapping in mode-line.
- (mouse-on-link-p): Also check [mode-line follow-link] bindings.
-
-2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
-
- * whitespace.el (whitespace-color-on): Use `prepend' OVERRIDE
- value for `whitespace-line' face (Bug#13875).
- (whitespace-font-lock-keywords): Change description.
- (whitespace-color-on): Don't save `font-lock-keywords' value, save
- the constructed keywords instead.
- (whitespace-color-off): Use `font-lock-remove-keywords' (Bug#13817).
-
-2013-03-19 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/compile.el (compilation-display-error): New command.
- (compilation-mode-map, compilation-minor-mode-map): Bind it to
- C-o. (Bug#13992)
-
-2013-03-18 Paul Eggert <eggert@cs.ucla.edu>
-
- * term/x-win.el (x-keysym-pair): Add a Fixme (Bug#13936).
-
-2013-03-18 Jan Djärv <jan.h.d@swipnet.se>
-
- * mouse.el (mouse-on-link-p): Check for scroll bar (Bug#13979).
-
-2013-03-18 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-compat.el (tramp-compat-user-error): New defun.
-
- * net/tramp-adb.el (tramp-adb-handle-shell-command):
- * net/tramp-gvfs.el (top):
- * net/tramp.el (tramp-find-method, tramp-dissect-file-name)
- (tramp-handle-shell-command): Use it.
- (tramp-dissect-file-name): Raise an error when hostname is a
- method name, and neither method nor user is specified.
-
- * net/trampver.el: Update release number.
-
-2013-03-18 Leo Liu <sdl.web@gmail.com>
-
- Make sure eldoc can be turned off properly.
- * emacs-lisp/eldoc.el (eldoc-schedule-timer): Conditionalize on
- eldoc-mode.
- (eldoc-display-message-p): Revert last change.
- (eldoc-display-message-no-interference-p)
- (eldoc-print-current-symbol-info): Tweak.
-
-2013-03-18 Tassilo Horn <tsdh@gnu.org>
-
- * doc-view.el (doc-view-new-window-function): Check the new window
- overlay's display property instead the char property of the
- buffer's first char. Use `with-selected-window' instead of
- `save-window-excursion' with `select-window'.
- (doc-view-document->bitmap): Check the current doc-view overlay's
- display property instead the char property of the buffer's first char.
-
-2013-03-18 Paul Eggert <eggert@cs.ucla.edu>
-
- Automate the build of ja-dic.el (Bug#13984).
- * international/ja-dic-cnv.el (skkdic-convert): Remove the annotations
- from the input, rather than assume that it's been done for us by the
- SKK script unannotate.awk. Switch ja-dic.el to UTF-8. Don't put
- the current date into a ja-dic.el comment, as that complicates
- regression testing.
-
-2013-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * whitespace.el: Fix double evaluation.
- (whitespace-space, whitespace-hspace, whitespace-tab)
- (whitespace-newline, whitespace-trailing, whitespace-line)
- (whitespace-space-before-tab, whitespace-indentation)
- (whitespace-empty, whitespace-space-after-tab): Turn defcustoms into
- obsolete defvars.
- (whitespace-hspace-regexp): Fix regexp for emacs-unicode.
- (whitespace-color-on): Use a single font-lock-add-keywords call.
- Fix double-evaluation of face variables.
-
-2013-03-17 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-adb.el (tramp-adb-parse-device-names):
- Use `start-process' instead of `call-process'. Otherwise, the
- function might be blocked under MS Windows. (Bug#13299)
-
-2013-03-17 Leo Liu <sdl.web@gmail.com>
-
- Extend eldoc to display info in the mode-line. (Bug#13978)
- * emacs-lisp/eldoc.el (eldoc-post-insert-mode): New minor mode.
- (eldoc-mode-line-string): New variable.
- (eldoc-minibuffer-message): New function.
- (eldoc-message-function): New variable.
- (eldoc-message): Use it.
- (eldoc-display-message-p)
- (eldoc-display-message-no-interference-p):
- Support eldoc-post-insert-mode.
-
- * simple.el (eval-expression-minibuffer-setup-hook): New hook.
- (eval-expression): Run it.
-
-2013-03-17 Roland Winkler <winkler@gnu.org>
-
- * emacs-lisp/crm.el (completing-read-multiple): Ignore empty
- strings in the list of return values.
-
-2013-03-17 Jay Belanger <jay.p.belanger@gmail.com>
-
- * calc/calc-ext.el (math-read-number-fancy): Check for an explicit
- radix before checking for HMS forms.
-
-2013-03-16 Leo Liu <sdl.web@gmail.com>
-
- * progmodes/scheme.el: Add indentation and font-locking for λ.
- (Bug#13975)
-
-2013-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/smie.el (smie-auto-fill): Don't inf-loop if there's no
- token before point (bug#13942).
-
-2013-03-16 Leo Liu <sdl.web@gmail.com>
-
- * thingatpt.el (end-of-sexp): Fix bug#13952. Use syntax-after.
-
-2013-03-16 Eli Zaretskii <eliz@gnu.org>
-
- * startup.el (command-line-normalize-file-name): Fix handling of
- backslashes in DOS and Windows file names. Reported by Xue Fuqiao
- <xfq.free@gmail.com> in
- http://lists.gnu.org/archive/html/help-gnu-emacs/2013-03/msg00245.html.
-
-2013-03-15 Michael Albinus <michael.albinus@gmx.de>
-
- Sync with Tramp 2.2.7.
-
- * net/trampver.el: Update release number.
-
-2013-03-14 Tassilo Horn <tsdh@gnu.org>
-
- * doc-view.el Fix bug#13887.
- (doc-view-insert-image): Don't modify overlay associated to
- non-live windows, and implement horizontal centering of image in
- case it's smaller than the window.
- (doc-view-new-window-function): Force redisplay of new windows on
- doc-view buffers.
-
-2013-03-13 Karl Fogel <kfogel@red-bean.com>
-
- * saveplace.el (save-place-alist-to-file): Don't sort
- `save-place-alist', just pretty-print it (bug#13882).
-
-2013-03-13 Michael Albinus <michael.albinus@gmx.de>
-
- * net/tramp-sh.el (tramp-sh-handle-insert-directory):
- Check whether `default-file-name-coding-system' is bound.
- It isn't in XEmacs.
-
-2013-03-13 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * emacs-lisp/byte-run.el (defun-declarations-alist): Don't use
- backquotes for `obsolete' (bug#13929).
-
- * international/mule.el (find-auto-coding): Include file name in
- obsolescence warning (bug#13922).
-
-2013-03-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * progmodes/cfengine.el (cfengine-parameters-indent): New variable
- for CFEngine 3-specific indentation.
- (cfengine3-indent-line): Use it. Fix up category regex.
- (cfengine3-font-lock-keywords): Add bundle and namespace characters.
-
-2013-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * type-break.el (type-break-file-name):
- * textmodes/remember.el (remember-data-file):
- * strokes.el (strokes-file):
- * shadowfile.el (shadow-initialize):
- * saveplace.el (save-place-file):
- * ps-bdf.el (bdf-cache-file):
- * progmodes/idlwave.el (idlwave-config-directory):
- * net/quickurl.el (quickurl-url-file):
- * international/kkc.el (kkc-init-file-name):
- * ido.el (ido-save-directory-list-file):
- * emulation/viper.el (viper-custom-file-name):
- * emulation/vip.el (vip-startup-file):
- * calendar/todo-mode.el (todo-file-do, todo-file-done, todo-file-top):
- * calendar/timeclock.el (timeclock-file): Use locate-user-emacs-file.
-
-2013-03-12 Paul Eggert <eggert@cs.ucla.edu>
-
- Switch encodings of tutorials, thai-word to UTF-8 (Bug#13880).
- * language/thai-word.el: Switch to UTF-8.
-
-See ChangeLog.16 for earlier changes.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1
index df832a3c662..582b7faaf95 100644
--- a/lisp/ChangeLog.1
+++ b/lisp/ChangeLog.1
@@ -777,7 +777,7 @@
1985-12-14 Richard M. Stallman (rms@prep)
- * various:
+ * Various:
Change uses of copy-sequence on keymaps to copy-alist.
Use run-hooks for all hooks.
@@ -1777,7 +1777,7 @@
* debug.el (debug):
Bind debug-on-error to nil over entire invocation of debugger.
- * everywhere:
+ * Everywhere:
Change dot to point.
* Many major mode commands:
@@ -2551,7 +2551,7 @@
1985-06-12 Richard Mlynarik (mly@mit-prep)
- * rmail (rmail-insert-inbox-text):
+ * rmail.el (rmail-insert-inbox-text):
file-name-directory includes a trailing "/".
1985-06-12 K. Shane Hartman (shane@mit-prep)
@@ -3244,7 +3244,7 @@
Set current buffer variables from defaults
in case user's init file has changed them.
- Copyright (C) 1985-1986, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1985-1986, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 30afe9ce970..82d9bf24012 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -1,4 +1,4 @@
-2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-menus.el (cc-imenu-init): Do not set
`imenu-create-index-function' if the second argument is left
@@ -9,7 +9,7 @@
(c-lineup-arglist-close-under-paren): Fixes to cope with
special brace lists in Pike.
-2003-07-03 Alan Mackenzie <bug-cc-mode@gnu.org>
+2003-07-03 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el (awk-mode): Call c-awk-after-change to
ensure syntax-table props at loading.
@@ -21,7 +21,7 @@
analyze AWK top-level forms properly (c-guess-basic-syntax
CASE 5P), c-awk-backward-syntactic-ws.
-2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fix.el: cc-mode-19.el has been renamed to
progmodes/cc-fix.el since it now contains compatibility stuff
@@ -59,7 +59,7 @@
* progmodes/cc-langs.el (comment-end): Put a space in front of
the comment ender in C, as it was before the move from cc-mode.el.
-2003-07-03 Alan Mackenzie <bug-cc-mode@gnu.org>
+2003-07-03 Alan Mackenzie <acm@muc.de>
* progmodes/cc-fonts.el: Do not load progmodes/cc-awk.elc or
awk-font-lock-keywords unless there is an AWK Mode buffer.
@@ -67,12 +67,12 @@
* progmodes/cc-awk.el: New file that implements AWK support,
superseding the old separate derived mode in awk-mode.el.
- * progmodes/cc-vars.el, cc-mode-19.el, progmodes/cc-langs.el,
- * progmodes/cc-mode.el, progmodes/cc-defs.el,
+ * progmodes/cc-vars.el, progmodes/cc-mode-19.el, progmodes/cc-langs.el:
+ * progmodes/cc-mode.el, progmodes/cc-defs.el:
* progmodes/cc-engine.el, progmodes/cc-fonts.el:
Changes for the new AWK support.
-2003-07-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el, progmodes/cc-langs.el
(c-decl-block-key, c-search-uplist-for-classkey): Check that
@@ -940,8 +940,8 @@
This change is slightly incompatible. Although the calling
convention for line-up functions is strictly extended, the format
- of the `c-syntactic-context' variable has changed slightly. It's
- believed that this incompatibility is minor, though; not a single
+ of the `c-syntactic-context' variable has changed slightly.
+ It's believed that this incompatibility is minor, though; not a single
line-up function distributed with CC Mode needed to be changed,
for instance.
@@ -1248,8 +1248,7 @@
sequences (each with optional trailing space).
* net/tramp-uu.el:
- * net/tramp-util.el:
- * net/tramp-efs.el: Use iso-2022-7bit encoding with coding cookie
+ * net/tramp-util.el: Use iso-2022-7bit encoding with coding cookie
for XEmacs compatibility.
2003-06-17 Kenichi Handa <handa@m17n.org>
@@ -1613,7 +1612,7 @@
* dabbrev.el (dabbrev--goto-start-of-abbrev):
Use minibuffer-prompt-end.
- * comint.el (comint-move-point-for-output): Renamed from
+ * comint.el (comint-move-point-for-output): Rename from
comint-scroll-to-bottom-on-output. Old name is alias.
All uses changed. Doc fix.
(comint-scroll-show-maximum-output): Doc fix.
@@ -1730,7 +1729,7 @@
(bibtex-pop): Simplify.
(bibtex-mode): Move setting of bibtex-string to bibtex-parse-strings.
Set choose-completion-string-functions.
- (bibtex-print-help-message,bibtex-make-field, bibtex-end-of-entry)
+ (bibtex-print-help-message, bibtex-make-field, bibtex-end-of-entry)
(bibtex-count-entries): Simplify.
(bibtex-entry-index, bibtex-lessp): New funs for generalized sorting
scheme of indices, see bibtex-maintain-sorted-entries.
@@ -2243,8 +2242,6 @@
end of prompt. (ANSI escapes elsewhere in the prompt are
recognized properly already.)
- * net/tramp-efs.el: New file.
-
2003-05-24 Michael Albinus <Michael.Albinus@alcatel.de>
* net/tramp.el (tramp-handle-file-truename): `sym' shouldn't be
@@ -2567,9 +2564,9 @@
* ediff-util.el (ediff-maybe-save-and-delete-merge): Change in a
message.
- * ediff.el (ediff-directories,ediff-directory-revisions)
- (ediff-directories3,ediff-merge-directories)
- (ediff-merge-directories-with-ancestor,ediff-merge-directory-revisions)
+ * ediff.el (ediff-directories, ediff-directory-revisions)
+ (ediff-directories3, ediff-merge-directories)
+ (ediff-merge-directories-with-ancestor, ediff-merge-directory-revisions)
(ediff-merge-directory-revisions-with-ancestor): Make use of the new
ediff-default-filtering-regexp variable.
@@ -2921,7 +2918,7 @@
2003-05-09 Sam Steingold <sds@gnu.org>
- * pcvs.el (cvs-mode-find-file): Fixed the last patch's logic.
+ * pcvs.el (cvs-mode-find-file): Fix the last patch's logic.
2003-05-09 Stefan Monnier <monnier@cs.yale.edu>
@@ -3256,7 +3253,7 @@
2003-05-03 Richard M. Stallman <rms@gnu.org>
- * emacs-lisp/autoload.el (update-directory-autoloads): Renamed from
+ * emacs-lisp/autoload.el (update-directory-autoloads): Rename from
update-autoloads-from-directories.
* progmodes/cperl-mode.el (cperl-nonoverridable-face): Doc fix.
@@ -3795,7 +3792,7 @@
for both the argument and the value.
* desktop.el (desktop-base-file-name):
- Renamed from desktop-basefilename. Add defvaralias.
+ Rename from desktop-basefilename. Add defvaralias.
2003-04-14 John Paul Wallington <jpw@gnu.org>
@@ -3862,7 +3859,7 @@
(describe-minor-mode-completion-table-for-symbol): New functions.
minor-mode-list is used here.
(describe-minor-mode-from-symbol):
- Renamed from (old) describe-minor-mode.
+ Rename from (old) describe-minor-mode.
Use describe-minor-mode-completion-table-for-symbol.
Don't use eval. Just use symbol-name.
(describe-minor-mode-from-indicator): Document is updated.
@@ -3932,7 +3929,7 @@
* international/mule.el:
Don't set after-insert-file-adjust-coding-function.
(after-insert-file-set-coding):
- Renamed from after-insert-file-set-buffer-file-coding-system.
+ Rename from after-insert-file-set-buffer-file-coding-system.
2003-04-11 Kenichi Handa <handa@m17n.org>
@@ -3955,13 +3952,13 @@
(quail-make-guidance-frame): Delete the arg BUF. Fix position
calculation. Don't set the window buffer, just return the new frame.
(quail-minibuffer-message): New function.
- (quail-show-guidance): Renamed from quail-show-guidance-buf.
+ (quail-show-guidance): Rename from quail-show-guidance-buf.
Use message and quail-minibuffer-message to display the guidance.
- (quail-hide-guidance): Renamed from quail-hide-guidance-buf.
+ (quail-hide-guidance): Rename from quail-hide-guidance-buf.
Only delete quail-guidance-frame.
(quail-update-guidance): Just update quail-guidance-str, not
display it.
- (quail-get-translations): Renamed from quail-show-translations.
+ (quail-get-translations): Rename from quail-show-translations.
Return a string instead of inserting it in quail-guidance-buf.
2003-04-11 Kenichi Handa <handa@m17n.org>
@@ -3972,7 +3969,7 @@
2003-04-10 Juanma Barranquero <lektu@terra.es>
- * frame.el (modify-all-frames-parameters): Deleted.
+ * frame.el (modify-all-frames-parameters): Delete.
2003-04-10 Sebastian Tennant <seb@albert.vcisp.net> (tiny change)
@@ -4074,7 +4071,7 @@
(utf-16-le-with-signature, utf-16-be-with-signature)
(utf-16): Aliases of the above coding systems.
-2003-04-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-04-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el (c-symbol-key): Use POSIX char classes
to match symbols. This makes CC Mode cope with the full range
@@ -4149,7 +4146,7 @@
2003-04-06 Masatake YAMATO <jet@gyve.org>
- * progmodes/etags.el (tag-find-file-of-tag): Renamed from
+ * progmodes/etags.el (tag-find-file-of-tag): Rename from
find-file-of-tag to avoid name space pollution.
(tag-find-file-of-tag-noselect): Likewise.
(etags-list-tags, etags-tags-apropos):
@@ -4273,10 +4270,10 @@
2003-04-02 Masatake YAMATO <jet@gyve.org>
- * woman.el (woman-xref): Removed.
+ * woman.el (woman-xref): Remove.
(woman-mode): Use `Man-highlight-references' instead of
`WoMan-highlight-references'.
- (WoMan-highlight-references): Removed.
+ (WoMan-highlight-references): Remove.
* man.el (toplevel): Require button.
(Man-header-file-path): New option.
@@ -4288,7 +4285,7 @@
`button-buffer-map'.
(Man-xref-man-page, Man-xref-header-file, Man-xref-normal-file):
New buttons. `Man-xref-man-page' comes from woman.el.
- (man-follow-mouse): Removed.
+ (man-follow-mouse): Remove.
(Man-fontify-manpage): Use `Man-highlight-references' instead of
calling `add-text-properties' directly.
(Man-highlight-references, Man-highlight-references0): New functions.
@@ -4486,7 +4483,7 @@
2003-03-26 Steve Youngs <youngs@xemacs.org>
- * em-unix.el (eshell-plain-locate-behavior): Make the default
+ * eshell/em-unix.el (eshell-plain-locate-behavior): Make the default
nil on Emacs, t on XEmacs.
2003-03-25 Stefan Monnier <monnier@cs.yale.edu>
@@ -4528,7 +4525,7 @@
* net/net-utils.el (dns-lookup-host): New function.
-2003-03-23 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-03-23 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el (c-parse-state): Add kludge to avoid
an infinite loop when Emacs' open-paren-in-column-zero rule
@@ -5474,8 +5471,8 @@
* ffap.el: Many doc fixes.
(ffap-replace-file-component):
- Renamed from ffap-replace-path-component. Callers changed.
- (ffap-host-to-filename): Renamed from ffap-host-to-path. Callers chgd.
+ Rename from ffap-replace-path-component. Callers changed.
+ (ffap-host-to-filename): Rename from ffap-host-to-path. Callers chgd.
* international/iso-ascii.el (iso-ascii-display-table): New variable.
(iso-ascii-standard-display-table): New variable.
@@ -5639,7 +5636,7 @@
add handling of entry attributes using diary-pull-attrs.
(mark-calendar-days-named, mark-calendar-days-named)
(mark-calendar-date-pattern, mark-calendar-month)
- (add-to-diary-list): Add optional paramater `color' for passing
+ (add-to-diary-list): Add optional parameter `color' for passing
face attribute info through the callchain. Pass this parameter around.
2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
@@ -5804,13 +5801,13 @@
* language/ind-util.el (indian-itrans-v5-table): Add entries for
"E" and "O".
-2003-02-10 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-02-10 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-styles.el (c-set-offset): Don't find a default
syntactic element through syntactic analysis if called outside
a CC Mode buffer.
-2003-02-09 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-02-09 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el (c-basic-common-init):
Install `c-fill-paragraph' on `fill-paragraph-function'.
@@ -5977,7 +5974,7 @@
* term.el (term-raw-map): Set it up at load time.
(term-char-mode): Don't set up term-raw-map here.
(term-set-escape-char): Don't set up C-x subcommand.
- (term-ansi-face-already-done): Renamed from
+ (term-ansi-face-already-done): Rename from
term-ansi-face-alredy-done.
(term-command-hook): Avoid error if STRING is empty.
(term, term-mode): Doc fixes.
@@ -6076,7 +6073,7 @@
2003-01-31 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Bug fixes, miscellaneous.
+ * progmodes/antlr-mode.el: Bug fixes, miscellaneous.
(antlr-mode): Make major mode work with cc-mode-5.29 or higher,
make it more robust against changes in cc-mode's style variables
by using `boundp' and function `c-init-language-vars' if defined.
@@ -6085,7 +6082,7 @@
(antlr-run-tool-interactive): New function.
(antlr-run-tool): Use it for `interactive' specification.
- * antlr-mode.el: Simplify Emacs/XEmacs compatibility.
+ * progmodes/antlr-mode.el: Simplify Emacs/XEmacs compatibility.
(cond-emacs-xemacs): New compile-time macro.
(defunx): New compile-time macro.
(ignore-errors-x): New compile-time macro.
@@ -6116,7 +6113,8 @@
(antlr-hide-actions): Ditto.
(antlr-option-kind): Ditto.
- * antlr-mode.el: In Emacs, use face attribute :weight, not :bold.
+ * progmodes/antlr-mode.el: In Emacs, use face attribute
+ :weight, not :bold.
(antlr-font-lock-keyword-face): Use new macros.
(antlr-font-lock-syntax-face): Ditto.
(antlr-font-lock-ruledef-face): Ditto.
@@ -6125,23 +6123,23 @@
Changes from 2002-05-24:
- * antlr-mode.el: Version 2.2a.
+ * progmodes/antlr-mode.el: Version 2.2a.
Changes from 2002-05-03:
- * antlr-mode.el: Make context parsing faster on Emacs, for faster
- syntax highlighting, indentation and imenu support.
+ * progmodes/antlr-mode.el: Make context parsing faster on Emacs,
+ for faster syntax highlighting, indentation and imenu support.
Suggested by Aaron Davies <adavies42@users.sourceforge.net>.
(antlr-slow-context-cache): New variable.
(antlr-slow-syntactic-context): Use cache.
(antlr-slow-cache-enabling-symbol): New internal variable.
(antlr-slow-cache-diff-threshold): New variable.
- (antlr-fast-invalidate-context-cache): Renamed from
+ (antlr-fast-invalidate-context-cache): Rename from
antlr-xemacs-bug-workaround.
(antlr-imenu-create-index-function): Search from beginning.
- * antlr-mode.el: More sophisticated indentation, i.e., use the
- indentation engine of cc-mode for most actions.
+ * progmodes/antlr-mode.el: More sophisticated indentation, i.e.,
+ use the indentation engine of cc-mode for most actions.
(antlr-c-common-init): Allow nil for `antlr-indent-style'.
(antlr-indent-line): Use indentation engine of cc-mode more often.
(antlr-indent-at-bol-alist): Only used for header actions.
@@ -6150,19 +6148,20 @@
(antlr-indent-at-bol-alist): With language "Java", indent
"package" and "import" at column 0 in header part.
- * antlr-mode.el (antlr-simple-default-directory): Define.
+ * progmodes/antlr-mode.el (antlr-simple-default-directory): Define.
(antlr-simple-read-shell-command): Define.
(antlr-simple-with-displaying-help-buffer): Define.
(antlr-simple-scan-sexps, antlr-simple-scan-lists):
- Renamed from antlr-scan-{sexps,lists}-internal.
+ Rename from antlr-scan-{sexps,lists}-internal.
Changes from 2002-02-28:
- * antlr-mode.el: Version 2.2 is released.
+ * progmodes/antlr-mode.el: Version 2.2 is released.
- * antlr-mode.el (antlr): Moved to SourceForge.net
+ * progmodes/antlr-mode.el (antlr): Move to SourceForge.net
- * antlr-mode.el: Minor bug fixes: insert options and indentation.
+ * progmodes/antlr-mode.el: Minor bug fixes: insert options
+ and indentation.
(antlr-option-location): Don't use point as position where to
insert options if point is in comment.
(antlr-mode): Don't set style here.
@@ -6173,7 +6172,7 @@
Changes from 2002-01-31:
- * antlr-mode.el (antlr-font-lock-additional-keywords):
+ * progmodes/antlr-mode.el (antlr-font-lock-additional-keywords):
Also highlight `~' with `antlr-font-lock-syntax-face'.
Suggested by Helmut Neukirchen <neukirchen@itm.mu-luebeck.de>.
@@ -6285,7 +6284,7 @@
* ibuf-ext.el (ibuffer-yank-filter-group): Move check for empty
`ibuffer-filter-group-kill-ring' out of `interactive' declaration.
-2003-01-28 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-01-28 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-vars.el, progmodes/cc-mode.el
(c-require-final-newline): Made this variable an alist to
@@ -6326,7 +6325,7 @@
* progmodes/ebrowse.el (ebrowse-draw-tree-fn): Likewise.
-2003-01-26 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-01-26 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-vars.el, progmodes/cc-mode.el
(c-require-final-newline): Add a variable to make the
@@ -6354,11 +6353,11 @@
* mh-e: Created directory. ChangeLog will appear in a week when we
release version 7.2.
- * mail/mh-alias.el, mail/mh-comp.el, mail/mh-customize.el, mail/mh-e.el,
- mail/mh-funcs.el, mail/mh-identity.el, mail/mh-index.el,
- mail/mh-loaddefs.el, mail/mh-mime.el, mail/mh-pick.el,
- mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el,
- mail/mh-xemacs-compat.el: Moved to mh-e directory.
+ * mail/mh-alias.el, mail/mh-comp.el, mail/mh-customize.el, mail/mh-e.el:
+ * mail/mh-funcs.el, mail/mh-identity.el, mail/mh-index.el:
+ * mail/mh-loaddefs.el, mail/mh-mime.el, mail/mh-pick.el:
+ * mail/mh-seq.el, mail/mh-speed.el, mail/mh-utils.el:
+ * mail/mh-xemacs-compat.el: Move to mh-e directory.
Note that reply2.pbm and reply2.xpm, which were created by the
MH-E package, were left in mail since they can probably be used by
other mail packages.
@@ -6931,7 +6930,7 @@
2003-01-08 Francesco Potortì <pot@gnu.org>
- * mail/undigest.el (unforward-rmail-message): Simplified.
+ * mail/undigest.el (unforward-rmail-message): Simplify.
No functional change.
2003-01-07 Markus Rost <rost@math.ohio-state.edu>
@@ -7355,7 +7354,7 @@
(makeinfo-compilation-sentinel-buffer, makeinfo-current-node):
New functions.
(makeinfo-compile): Add a sentinel parameter.
- (makeinfo-compilation-sentinel-region): Renamed from
+ (makeinfo-compilation-sentinel-region): Rename from
makeinfo-compilation-sentinel, and makeinfo-temp-file now never nil.
(makeinfo-region): Use this.
* info.el (Info-revert-find-node): New function.
@@ -7413,7 +7412,7 @@
2002-12-20 Francesco Potortì <pot@gnu.org>
- * mail/undigest.el (rmail-mail-separator): Renamed from
+ * mail/undigest.el (rmail-mail-separator): Rename from
rmail-digest-mail-separator. All users changed.
(unforward-rmail-message): Rewritten to be more robust and to
additionally account for the common style of forwarding messages
@@ -7619,7 +7618,7 @@
2002-12-10 Steven Tamm <steventamm@mac.com>
- * generic-x.el (javascript-generic-mode): Added C style block
+ * generic-x.el (javascript-generic-mode): Add C style block
comments as used in ECMA-262 standard.
2002-12-10 Kenichi Handa <handa@m17n.org>
@@ -7681,7 +7680,7 @@
2002-12-08 Nick Roberts <nick@nick.uklinux.net>
- * gdb-ui.el : Remove inappropriate key-bindings.
+ * gdb-ui.el: Remove inappropriate key-bindings.
(gdb-info-breakpoints-custom, gdb-goto-bp-this-line):
Parse correctly when breakpoint has no line number.
(def-gdb-auto-update-handler, gdb-info-locals-handler)
@@ -8036,7 +8035,7 @@
scroll event where a click on the mouse wheel button is ignored.
(mouse-wheel-click-event, mouse-wheel-inhibit-click-time): New customs.
(mouse-wheel-click-button, mwheel-inhibit-click-event-timer): New vars.
- (mwheel-inhibit-click-timeout,mwheel-filter-click-events): New defuns.
+ (mwheel-inhibit-click-timeout, mwheel-filter-click-events): New defuns.
(mwheel-scroll): Add mwheel-filter-click-events as pre-command-hook.
Start mwheel-inhibit-click-event-timer with timeout handler
mwheel-inhibit-click-timeout.
@@ -8117,7 +8116,7 @@
2002-11-21 Nick Roberts <nick@nick.uklinux.net>
- * gdb-ui.el : General tidying. Patches from Stefan Monnier.
+ * gdb-ui.el: General tidying. Patches from Stefan Monnier.
2002-11-20 Simon Josefsson <jas@extundo.com>
@@ -8137,7 +8136,7 @@
* progmodes/sql.el: Added LINTER support.
(sql-linter-program): New variable.
(sql-linter-options): New variable.
- (sql-mode-menu): Added Linter keywords.
+ (sql-mode-menu): Add Linter keywords.
(sql-mode-linter-font-lock-keywords): New variable.
(sql-highlight-linter-keywords): New function.
(sql-linter): New function.
@@ -8166,7 +8165,7 @@
2002-11-20 Markus Rost <rost@math.ohio-state.edu>
- * Makefile.in (setwins_almost): Renamed from finder_setwins.
+ * Makefile.in (setwins_almost): Rename from finder_setwins.
(custom-deps): Use it.
(finder-data): Adjust to that name change.
@@ -8318,10 +8317,10 @@
diary-entries-list.
(diary-mode, fancy-diary-display-mode): New derived modes, for
diary file and fancy diary buffer respectively.
- (fancy-diary-font-lock-keywords, diary-font-lock-keywords): New
- variables.
- (font-lock-diary-sexps, font-lock-diary-date-forms): New
- functions, used in diary-font-lock-keywords.
+ (fancy-diary-font-lock-keywords, diary-font-lock-keywords):
+ New variables.
+ (font-lock-diary-sexps, font-lock-diary-date-forms):
+ New functions, used in diary-font-lock-keywords.
* calendar/calendar.el (diary-face): New.
(european-calendar-display-form, describe-calendar-mode)
@@ -8336,9 +8335,9 @@
* international/codepage.el (cp866-decode-table): Fix the
translation table.
-2002-11-16 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-11-16 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-bytecomp.el (cc-bytecomp-defun): Fixed bug that
+ * progmodes/cc-bytecomp.el (cc-bytecomp-defun): Fix bug that
caused existing function definitions to be overridden by
phonies when the bytecomp environment is restored.
@@ -8391,7 +8390,7 @@
* files.el (mode-name): Mark it as risky-local-variable like the
other mode-line elements (moved from bindings.el).
- * bindings.el (mode-name): Moved mark as risky-local-variable to
+ * bindings.el (mode-name): Move mark as risky-local-variable to
files.el.
2002-11-14 Juanma Barranquero <lektu@terra.es>
@@ -8453,7 +8452,7 @@
* vc-sccs.el (vc-sccs-registered): Improve comment.
-2002-11-13 Tim Van Holder <tim.vanholder@anubex.com> (tiny change)
+2002-11-13 Tim Van Holder <tim.vanholder@anubex.com>
* progmodes/compile.el (compilation-error-regexp-alist):
Don't include colon and space after a file name as part of the name.
@@ -8656,13 +8655,13 @@
don't defvar, and make permanent-local.
(ucs-unify-8859, ucs-unify-8859, ucs-fragment-8859): Add/remove
set-buffer-major-mode-hook, not quail-activate-hook.
- (ucs-set-table-for-input): Renamed from ucs-quail-activate.
+ (ucs-set-table-for-input): Rename from ucs-quail-activate.
(ucs-unify-8859, ucs-unify-8859, ucs-fragment-8859):
Setup keyboard-translate-table, not translation-table-for-input.
Modify set-buffer-major-mode-hook, not quail-activate-hook.
(ucs-fragment-8859): Don't use translation-table-for-input coding
system property.
- (ucs-quail-activate): Deleted.
+ (ucs-quail-activate): Delete.
(ucs-set-table-for-input): New.
(ucs-minibuffer-setup): Use it.
@@ -8692,7 +8691,7 @@
2002-11-06 Kim F. Storm <storm@cua.dk>
- * info.el (Info-fontify-node): Fixed hiding of *note references
+ * info.el (Info-fontify-node): Fix hiding of *note references
with embedded file names like (xxx.yyy).
Avoid making any lines visibly longer if hiding newlines inside
note references by wrapping line after references if it contained
@@ -8853,7 +8852,7 @@
2002-10-29 Kim F. Storm <storm@cua.dk>
- * ido.el (ido-wide-find-dirs-or-files): Fixed problem that caused
+ * ido.el (ido-wide-find-dirs-or-files): Fix problem that caused
incomplete list of matches to be returned.
2002-10-29 Masayuki Ataka <ataka@milk.freemail.ne.jp> (tiny change)
@@ -9120,21 +9119,21 @@
* international/mule-diag.el (non-iso-charset-alist): Add koi8-u.
- * international/code-pages.el (cp-make-translation-table): Use
- ucs-mule-to-mule-unicode.
+ * international/code-pages.el (cp-make-translation-table):
+ Use ucs-mule-to-mule-unicode.
(cp-fix-safe-chars): Fix typo.
(non-iso-charset-alist): Don't define.
(cp-make-coding-system): Use utf-8-translation-table-for-decode.
Define translation-table-for-input.
(cp866): Reinstate.
(alternativnj): Don't define alias.
- (koi8-u): Deleted.
+ (koi8-u): Delete.
* language/european.el ("Slovenian"): Use slovenian input-method.
(encode-mac-roman): Use ucs-mule-to-mule-unicode.
- * language/cyrillic.el (cyrillic-alternativnyj-decode-table): Fix
- the table.
+ * language/cyrillic.el (cyrillic-alternativnyj-decode-table):
+ Fix the table.
(cyrillic-alternativnyj): Don't give it `mime-charset' property.
(cp866): Delete this alias.
("Bulgarian"): Fix the value of `input-method'.
@@ -9163,8 +9162,8 @@
2002-10-15 Kenichi Handa <handa@m17n.org>
- * mail/sendmail.el (sendmail-send-it): Call
- select-message-coding-system before changing the current buffer to
+ * mail/sendmail.el (sendmail-send-it):
+ Call select-message-coding-system before changing the current buffer to
" sendmail temp".
2002-10-14 Andre Spiegel <spiegel@gnu.org>
@@ -9172,7 +9171,7 @@
* files.el (insert-directory): Handle //SUBDIRED// lines in
recursive listings from ls --dired.
- * vc.el (vc-dired-reformat-line): Simplified. Handles text
+ * vc.el (vc-dired-reformat-line): Simplify. Handles text
properties correctly now.
2002-10-14 Juanma Barranquero <lektu@terra.es>
@@ -9209,7 +9208,7 @@
* ediff-init.el (ediff-frame-char-height): Use frame-selected-window.
- * ediff-util.el (ediff-file-checked-in-p): Changed progn with and.
+ * ediff-util.el (ediff-file-checked-in-p): Change progn with and.
* ediff-wind.el (ediff-skip-unsuitable-frames): Distinguish selected
frame from frame of selected window.
@@ -9342,7 +9341,7 @@
2002-10-07 Kim F. Storm <storm@cua.dk>
* emulation/cua-base.el (cua-normal-cursor-color):
- Fixed initialization to make "Erase Customization" work.
+ Fix initialization to make "Erase Customization" work.
2002-10-07 Stefan Monnier <monnier@cs.yale.edu>
@@ -9470,7 +9469,7 @@
(widget-editable-list-entry-create): Update caller.
* wid-edit.el (widget-types-copy): New function.
- (default): Added :copy keyword.
+ (default): Add :copy keyword.
(menu-choice): Ditto.
(checklist): Ditto.
(radio-button-choice): Ditto.
@@ -9581,17 +9580,17 @@
* international/utf-8.el (ucs-mule-to-mule-unicode): Don't define
this translation-table name here.
(utf-translation-table-for-encode): New translation-table name.
- (utf-fragmentation-table): Renamed from utf-8-fragmentation-table.
+ (utf-fragmentation-table): Rename from utf-8-fragmentation-table.
(utf-defragmentation-table): New variable.
- (ucs-mule-cjk-to-unicode): Renamed from utf-8-subst-rev-table.
+ (ucs-mule-cjk-to-unicode): Rename from utf-8-subst-rev-table.
(utf-subst-table-for-encode): New translation-table name.
- (ucs-unicode-to-mule-cjk): Renamed from utf-8-subst-table.
+ (ucs-unicode-to-mule-cjk): Rename from utf-8-subst-table.
(utf-subst-table-for-decode): New translation-table name.
- (utf-fragment-on-decoding): Renamed from
+ (utf-fragment-on-decoding): Rename from
utf-8-fragment-on-decoding. Correctly handle the case that
unify-8859-on-encoding-mode is off. Handle mule-utf-16-le and
mule-utf-16-be too.
- (utf-translate-cjk): Renamed from utf-8-translate-cjk.
+ (utf-translate-cjk): Rename from utf-8-translate-cjk.
Handle mule-utf-16-le and mule-utf-16-be too.
(ccl-decode-mule-utf-8): Refer to utf-translation-table-for-decode
and utf-subst-table-for-decode.
@@ -10045,7 +10044,7 @@
(gamegrid-display-type): Use Emacs' standard `display-.*-p'
functions to check for display capabilities. Fix the recognition
of image-support in Emacs 21 by this way.
- (gamegrid-hide-cursor): Removed.
+ (gamegrid-hide-cursor): Remove.
(gamegrid-setup-default-font): Ported the code from XEmacs to
Emacs: create a new face and assign the variable `gamegrid-face'
to it. Make sure that the face is not higher than the smallest
@@ -10235,7 +10234,7 @@
2002-09-10 Michael Albinus <Michael.Albinus@alcatel.de>
- * net/tramp.el (tramp-handle-write-region): Added missing
+ * net/tramp.el (tramp-handle-write-region): Add missing
`)'. Hope it's the right place.
2002-09-09 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -10247,7 +10246,7 @@
something harmless, but the /bin/sh will display a dollar sign
which confused the subsequent prompt recognition.
(tramp-multi-action-password): More debugging output.
- (tramp-encoding-shell): Renamed from tramp-sh-program.
+ (tramp-encoding-shell): Rename from tramp-sh-program.
More documentation. Default to cmd.exe on Windows NT.
(tramp-encoding-command-switch): New variable. Use instead of
hard-wired "-c" which is only good for /bin/sh.
@@ -10287,7 +10286,7 @@
(tramp-completion-handle-file-name-all-completions):
Change function call for user/host completion according to definition
in `tramp-completion-function-alist'.
- (tramp-parse-passwd): Added exception handling for "root", because
+ (tramp-parse-passwd): Add exception handling for "root", because
`tramp-get-completion-su' (the previous place for this stuff)
doesn't exist any longer.
@@ -10376,7 +10375,7 @@
(tramp-multi-file-name-hop-structure-unified)
(tramp-multi-file-name-hop-structure-separate)
(tramp-make-multi-tramp-file-format-unified)
- (tramp-make-multi-tramp-file-format-separate): Removed.
+ (tramp-make-multi-tramp-file-format-separate): Remove.
(tramp-make-tramp-file-name): Allow partial tramp file
names. Generate tramp file format on-the-fly depending on
parameters. Apply atomar format strings resp expressions.
@@ -10403,7 +10402,7 @@
(tramp-completion-file-name-handler-alist): Add handler for
`file-exists-p.
(tramp-completion-handle-file-exists-p): New function.
- (tramp-completion-handle-file-name-completion): Simplified.
+ (tramp-completion-handle-file-name-completion): Simplify.
(tramp-completion-dissect-file-name): Regexp's reorganized.
(tramp-completion-handle-file-name-all-completions):
Call completion-function only if `user' or `host' is given.
@@ -10676,7 +10675,7 @@
2002-09-18 Michael Kifer <kifer@cs.stonybrook.edu>
- * ediff-hooks.el: Put back the autoloads (for XEmacs compatibility).
+ * ediff-hook.el: Put back the autoloads (for XEmacs compatibility).
* ediff-init.el: Use defalias instead of fset.
@@ -10684,7 +10683,7 @@
* viper-util.el (viper-chars-in-region): Simplification.
- * viper.el (viper-emacs-state-mode-list): Added modes.
+ * viper.el (viper-emacs-state-mode-list): Add modes.
2002-09-18 Jonathan Yavner <jyavner@engineer.com>
@@ -10767,13 +10766,13 @@
(nonincremental-search-forward, nonincremental-re-search-forward)
(nonincremental-search-backward, nonincremental-re-search-backward):
Set menu-bar-last-search-type to string or regexp.
- (nonincremental-repeat-re-search-forward): Removed.
- (nonincremental-repeat-re-search-backward): Removed.
+ (nonincremental-repeat-re-search-forward): Remove.
+ (nonincremental-repeat-re-search-backward): Remove.
(menu-bar-replace-menu): New keymap for "Edit->Replace" submenu.
(menu-bar-i-search-menu): New keymap for "Incremental Search" submenu.
- (menu-bar-adv-search-menu): Removed.
+ (menu-bar-adv-search-menu): Remove.
(menu-bar-search-menu): Reorganized.
- (menu-bar-edit-menu): Added "Replace" submenu.
+ (menu-bar-edit-menu): Add "Replace" submenu.
2002-09-15 Richard M. Stallman <rms@gnu.org>
@@ -10918,7 +10917,7 @@
2002-09-13 Kim F. Storm <storm@cua.dk>
- * kmacro.el (kmacro-keymap): Changed bindings:
+ * kmacro.el (kmacro-keymap): Change bindings:
C-x C-k s to kmacro-start-macro, C-x C-k b to kmacro-bind-to-key.
2002-09-12 Richard M. Stallman <rms@gnu.org>
@@ -11034,7 +11033,7 @@
* loadup.el ("simple.el"): Move to after loaddefs.el.
- * subr.el (define-mail-user-agent): Moved from simple.el.
+ * subr.el (define-mail-user-agent): Move from simple.el.
2002-09-10 Richard M. Stallman <rms@gnu.org>
@@ -11052,11 +11051,11 @@
* international/ucs-tables.el: Bind utf-8-translation-table-for-decode
when setting up tables and remove useless optimize-char-table.
- (ucs-mule-to-mule-unicode): Deleted.
+ (ucs-mule-to-mule-unicode): Delete.
(ucs-unify-8859): Maybe optimize ucs-mule-to-mule-unicode.
* international/utf-16.el (utf-16-le-pre-write-conversion)
- (utf-16-be-pre-write-conversion): Deleted.
+ (utf-16-be-pre-write-conversion): Delete.
(mule-utf-16-le, mule-utf-16-be): Register encoding translation table.
2002-09-10 Richard M. Stallman <rms@gnu.org>
@@ -11385,10 +11384,10 @@
* vc-hooks.el: Require vc.el at compile-time.
(vc-workfile-unchanged-p, vc-default-workfile-unchanged-p):
- Moved here from vc.el.
+ Move here from vc.el.
* vc.el (vc-workfile-unchanged-p, vc-default-workfile-unchanged-p):
- Moved to vc-hooks.el.
+ Move to vc-hooks.el.
* vc-rcs.el (vc-rcs-state): Don't require vc.el.
@@ -11541,7 +11540,7 @@
2002-08-30 ARISAWA Akihiro <ari@mbf.sphere.ne.jp> (tiny change)
- * ps-print.el (ps-lp-system): Fixed typo in `usg-unix-v'.
+ * ps-print.el (ps-lp-system): Fix typo in `usg-unix-v'.
2002-08-30 Markus Rost <rost@math.ohio-state.edu>
@@ -11661,7 +11660,7 @@
2002-08-28 Juanma Barranquero <lektu@terra.es>
- * replace.el (occur-hook): Renamed from `occur-mode-hook'.
+ * replace.el (occur-hook): Rename from `occur-mode-hook'.
(occur-mode): Remove call to `occur-mode-hook'.
(occur-rename-buffer): Fix reference to `occur-mode-hook' in docstring.
(occur-1): Add call to `occur-hook'.
@@ -11693,32 +11692,32 @@
2002-08-27 Carsten Dominik <dominik@sand.science.uva.nl>
- * textfile/reftex-ref.el (reftex-goto-label): New command.
+ * textmodes/reftex-ref.el (reftex-goto-label): New command.
- * textfile/reftex-vars.el (reftex-part-resets-chapter): New option.
+ * textmodes/reftex-vars.el (reftex-part-resets-chapter): New option.
- * textfile/reftex-parse.el (reftex-roman-number): New function.
+ * textmodes/reftex-parse.el (reftex-roman-number): New function.
(reftex-section-number): Better handling of parts: No chapter
counter resets.
- * textfile/reftex.el (reftex-highlight-overlays): Added a third
+ * textmodes/reftex.el (reftex-highlight-overlays): Add a third
overlay.
- (reftex-mode-menu): Added entry for `reftex-toc-recenter.
+ (reftex-mode-menu): Add entry for `reftex-toc-recenter.
Also moved `reftex-reset-mode' to top level.
- * textfile/reftex-toc.el (reftex-toc-recenter): New command.
+ * textmodes/reftex-toc.el (reftex-toc-recenter): New command.
(reftex-toc-pre-command-hook): Don't remove highlight overlay.
(reftex-toc-post-command-hook): Use overlay no 2 for highlighting.
- * textfile/reftex-sel.el (reftex-get-offset): Get offset of
+ * textmodes/reftex-sel.el (reftex-get-offset): Get offset of
document pointer *before* position, not after.
(reftex-insert-docstruct): Get offset of document pointer *before*
position, not after.
- * textfiles/reftex-parse.el (reftex-where-am-I): Prefer marker
+ * textmodes/reftex-parse.el (reftex-where-am-I): Prefer marker
match over section title match.
- * textfiles/reftex-cite.el (reftex-bib-or-thebib): New function
+ * textmodes/reftex-cite.el (reftex-bib-or-thebib): New function
which determines on a per-file-basis if BibTeX is being used
locally for citations.
(reftex-offer-bib-menu): Use `reftex-bib-or-thebib' for better
@@ -11726,7 +11725,7 @@
(reftex-bibtex-selection-callback): Use `reftex-bib-or-thebib' for
better cooperation with chapterbib.
- * textfiles/reftex-dcr.el (reftex-view-cr-cite):
+ * textmodes/reftex-dcr.el (reftex-view-cr-cite):
Use `reftex-bib-or-thebib' for better cooperation with chapterbib.
2002-08-26 Kim F. Storm <storm@cua.dk>
@@ -11746,15 +11745,15 @@
2002-08-25 Miles Bader <miles@gnu.org>
* rfn-eshadow.el (file-name-shadow-properties-custom-type):
- Renamed from `read-file-name-electric-shadow-properties-custom-type'.
+ Rename from `read-file-name-electric-shadow-properties-custom-type'.
Change name of face.
- (file-name-shadow-properties): Renamed from
+ (file-name-shadow-properties): Rename from
`read-file-name-electric-shadow-properties'.
- (file-name-shadow-tty-properties): Renamed from
+ (file-name-shadow-tty-properties): Rename from
`read-file-name-electric-shadow-tty-properties'.
- (file-name-shadow): Renamed from `read-file-name-electric-shadow'.
+ (file-name-shadow): Rename from `read-file-name-electric-shadow'.
(rfn-eshadow-setup-minibuffer): Update references to renamed variables.
- (file-name-shadow-mode): Renamed from
+ (file-name-shadow-mode): Rename from
`read-file-name-electric-shadow-mode'. Update references to
renamed variables.
@@ -11798,7 +11797,7 @@
* files.el (ange-ftp-completion-hook-function): Add safe-magic prop.
* subr.el (symbol-file-load-history-loaded)
- (load-symbol-file-load-history): Deleted.
+ (load-symbol-file-load-history): Delete.
(symbol-file): Don't call load-symbol-file-load-history.
2002-08-23 Andre Spiegel <spiegel@gnu.org>
@@ -11860,18 +11859,18 @@
2002-08-21 Kim F. Storm <storm@cua.dk>
- * bindings.el (mode-line-format): Moved global-mode-string last.
- (mode-line-position): Moved %p first. Added padding to %l/%c to
+ * bindings.el (mode-line-format): Move global-mode-string last.
+ (mode-line-position): Move %p first. Added padding to %l/%c to
eliminate jumpiness in modeline. Use (%l,%c) format if both
line-number-mode and column-number-mode are enabled.
-2002-08-20 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-08-20 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el (c-forward-syntactic-ws): Fixed a bug
+ * progmodes/cc-engine.el (c-forward-syntactic-ws): Fix a bug
that could cause an infinite loop if something that looks like
a macro begins in the middle of a line.
- * progmodes/cc-engine.el (c-parse-state): Fixed a bug that
+ * progmodes/cc-engine.el (c-parse-state): Fix a bug that
could cause `c-state-cache' to contain two conses in sequence
when there's an unbalanced open paren in a macro.
@@ -11891,7 +11890,7 @@
2002-08-20 Carsten Dominik <dominik@astro.uva.nl>
- * textfiles/reftex-cite.el (reftex-bib-or-thebib): New function
+ * textmodes/reftex-cite.el (reftex-bib-or-thebib): New function
which determines on a per-file-basis if BibTeX is being used
locally for citations.
(reftex-offer-bib-menu): Use `reftex-bib-or-thebib' for better
@@ -11899,7 +11898,7 @@
(reftex-bibtex-selection-callback): Use `reftex-bib-or-thebib' for
better cooperation with chapterbib.
- * textfiles/reftex-dcr.el (reftex-view-cr-cite):
+ * textmodes/reftex-dcr.el (reftex-view-cr-cite):
Use `reftex-bib-or-thebib' for better cooperation with chapterbib.
2002-08-20 Kim F. Storm <storm@cua.dk>
@@ -11909,7 +11908,7 @@
with keyboard macro related commands. The original binding on
C-x C-k is moved to C-x C-k e.
- * binding.el: Remove macro related bindings (now in kmacro.el).
+ * bindings.el: Remove macro related bindings (now in kmacro.el).
* edmacro.el: Remove C-x C-k binding (now in kmacro.el).
@@ -11991,7 +11990,7 @@
2002-08-15 Carsten Dominik <dominik@sand.science.uva.nl>
- * textmodes/reftex.el (reftex-mode): Moved the creation of special
+ * textmodes/reftex.el (reftex-mode): Move the creation of special
syntax tables to top-level.
2002-08-15 David Kastrup <David.Kastrup@t-online.de>
@@ -12095,16 +12094,16 @@
* international/mule-cmds.el (search-unencodable-char): New function.
(select-safe-coding-system): Show unencodable characters.
- (unencodable-char-position): Deleted, and implemented in C in coding.c.
+ (unencodable-char-position): Delete, and implemented in C in coding.c.
2002-04-09 John Wiegley <johnw@gnu.org>
- * esh-util.el: Removed eshell-under-cygwin-p, and all uses of it.
- * em-cmpl.el (eshell-cmpl-ignore-case): Ditto.
- * em-dirs.el (eshell/cd): Ditto.
- * em-glob.el (eshell-glob-case-insensitive): Ditto.
- * em-hist.el (eshell-previous-matching-input-string-position): Ditto.
- * esh-ext.el (eshell-binary-suffixes): Ditto.
+ * eshell/em-cmpl.el (eshell-cmpl-ignore-case):
+ * eshell/em-dirs.el (eshell/cd):
+ * eshell/em-glob.el (eshell-glob-case-insensitive):
+ * eshell/em-hist.el (eshell-previous-matching-input-string-position):
+ * eshell/esh-ext.el (eshell-binary-suffixes):
+ * eshell/esh-util.el: Remove eshell-under-cygwin-p, and all uses of it.
2002-08-09 Richard M. Stallman <rms@gnu.org>
@@ -12178,9 +12177,9 @@
2002-08-05 Alan Shutko <ats@acm.org>
- * ibuffer.el (ibuffer-mode-map): Added ibuffer-filter-by-used-mode.
- (ibuffer-mode-map): Added ibuffer-filter-by-used-mode.
- (ibuffer-mode): Added ibuffer-filter-by-used-mode to doc string.
+ * ibuffer.el (ibuffer-mode-map): Add ibuffer-filter-by-used-mode.
+ (ibuffer-mode-map): Add ibuffer-filter-by-used-mode.
+ (ibuffer-mode): Add ibuffer-filter-by-used-mode to doc string.
* ibuf-ext.el (ibuffer-list-buffer-modes): New.
(ibuffer-filter-by-used-mode): New.
@@ -12197,12 +12196,12 @@
2002-04-09 John Paul Wallington <jpw@shootybangbang.com>
- * esh-util.el (eshell-under-cygwin-p): New function.
- * em-cmpl.el (eshell-cmpl-ignore-case): Use it.
- * em-dirs.el (eshell/cd): Ditto.
- * em-glob.el (eshell-glob-case-insensitive): Ditto.
- * em-hist.el (eshell-previous-matching-input-string-position): Ditto.
- * esh-ext.el (eshell-binary-suffixes): Ditto.
+ * eshell/esh-util.el (eshell-under-cygwin-p): New function.
+ * eshell/em-cmpl.el (eshell-cmpl-ignore-case):
+ * eshell/em-dirs.el (eshell/cd):
+ * eshell/em-glob.el (eshell-glob-case-insensitive):
+ * eshell/em-hist.el (eshell-previous-matching-input-string-position):
+ * eshell/esh-ext.el (eshell-binary-suffixes): Use it.
2002-08-05 Richard M. Stallman <rms@gnu.org>
@@ -12360,11 +12359,11 @@
2002-07-31 Richard M. Stallman <rms@gnu.org>
- * makefile.w32-in (compile-after-backup): Renamed from `compile'.
+ * makefile.w32-in (compile-after-backup): Rename from `compile'.
Use `compile-always'.
(bootstrap): Use `compile', not `compile-files'. Use `update-subdirs'.
- (compile): Renamed from `compile-files'.
- (compile-CMD, compile-SH): Renamed from `compile-files-*'.
+ (compile): Rename from `compile-files'.
+ (compile-CMD, compile-SH): Rename from `compile-files-*'.
* emacs-lisp/bytecomp.el (byte-compile-find-cl-functions):
Check that (car elt) is a string.
@@ -12575,10 +12574,10 @@
2002-07-25 Carsten Dominik <dominik@astro.uva.nl>
* textmodes/reftex.el (reftex-compile-variables):
- Simplified regular expression.
+ Simplify regular expression.
* textmodes/reftex-parse.el (reftex-locate-bibliography-files):
- Simplified the regexp.
+ Simplify the regexp.
* textmodes/reftex-cite.el (reftex-get-bibkey-default): New function.
(reftex-extract-bib-entries-from-thebibliography):
@@ -12640,8 +12639,8 @@
* warnings.el (warning-levels): Add %s to the strings.
(warning-group-format): New variable.
- (warning-suppress-log-types): Renamed from warning-suppress-log.
- (warning-suppress-types): Renamed from warning-suppress.
+ (warning-suppress-log-types): Rename from warning-suppress-log.
+ (warning-suppress-types): Rename from warning-suppress.
(display-warning): Implement those changes.
2002-07-23 Richard M. Stallman <rms@gnu.org>
@@ -12678,7 +12677,7 @@
(finder-inf.el): Remove.
(update-authors): New target.
(TAGS-LISP): Remove $(lispsource).
- (compile-always): Renamed from `compile-files'.
+ (compile-always): Rename from `compile-files'.
(compile): New target, adapted from `compile-files'.
(compile-calc): New target.
(recompile): Change `.' to $(lisp).
@@ -12699,7 +12698,7 @@
* net/browse-url.el (browse-url-lynx-input-attempts): Use defcustom.
(browse-url-lynx-input-delay): Add custom type and group.
- * cus-start.el (double-click-fuzz): Added.
+ * cus-start.el (double-click-fuzz): Add.
2002-07-22 Alan Shutko <ats@acm.org>
@@ -12748,7 +12747,7 @@
(reftex-toc-split-windows-horizontally): New option.
(reftex-toc-split-windows-horizontally-fraction): New option.
(reftex-include-file-commands): New option.
- (reftex-cite-format-builtin): Added ?n for nocite.
+ (reftex-cite-format-builtin): Add ?n for nocite.
* textmodes/reftex-index.el (reftex-query-index-phrase):
Use `reftex-index-verify-function'.
@@ -12765,7 +12764,7 @@
* textmodes/reftex.el (reftex-compile-variables):
Use `reftex-include-file-commands'.
- (reftex-type-query-prompt): Changed defconst to defvar.
+ (reftex-type-query-prompt): Change defconst to defvar.
(reftex-type-query-help, reftex-typekey-to-format-alist)
(reftex-typekey-to-prefix-alist, reftex-env-or-mac-alist)
(reftex-special-env-parsers, reftex-label-mac-list)
@@ -12930,7 +12929,7 @@
(ucs-mule-to-mule-unicode): New.
(ucs-unify-8859): Use utf-8-fragment-on-decoding, set up Quail
translation.
- (ucs-fragment-8859): Modified consistent with ucs-unify-8859.
+ (ucs-fragment-8859): Modify consistent with ucs-unify-8859.
(unify-8859-on-encoding-mode): Doc mod. Fix custom version.
(unify-8859-on-decoding-mode): Doc mod. Change code. Fix custom
version. Add custom dependencies.
@@ -13185,7 +13184,7 @@
2002-07-13 Kim F. Storm <storm@cua.dk>
- * progmodes/compile.el (grep-tree): Fixed autoload.
+ * progmodes/compile.el (grep-tree): Fix autoload.
Corrected use of undefined variable `match-files-aliases'.
2002-07-12 Glenn Morris <gmorris@ast.cam.ac.uk>
@@ -13264,7 +13263,7 @@
(tramp-handle-file-name-directory): Don't return "/" when
completing a remote root directory (where the filename looks like
"/method:user@host:/").
- (tramp-handle-ange-ftp): Deleted.
+ (tramp-handle-ange-ftp): Delete.
(tramp-disable-ange-ftp): New function, called at toplevel,
deletes Ange-FTP from file-name-handler-alist.
(tramp-handle-make-symbolic-link): Implement.
@@ -13358,7 +13357,7 @@
* files.el (after-find-file): Don't check for read-only status
of files just created (and not yet saved on disk).
- * ido.el (ido-completion-help): Changed XEmacs specific code to
+ * ido.el (ido-completion-help): Change XEmacs specific code to
avoid byte compiler warning in GNU Emacs.
(ido-set-matches1): Use regexp-quote instead of identity.
(ido-complete-space): New function.
@@ -13550,7 +13549,7 @@
(define-stroke, strokes-fix-button2-command, strokes-insinuated)
(strokes-insinuate, global-set-stroke, describe-stroke)
(load-user-strokes, save-strokes, strokes-bug-address)
- (strokes-click-command): Deleted.
+ (strokes-click-command): Delete.
(strokes-execute-stroke): Remove strokes-click-p case.
(strokes-describe-stroke): Remove strokes-click-p stuff.
(strokes-help): Fix.
@@ -13752,8 +13751,8 @@
(cvs-addto-collection): Use it to preserve point.
(cvs-vc-command-advice): Ad-hoc workaround for `cvs -q add'.
- * mwheel.el (mouse-wheel-scroll-amount,mwheel-scroll,mouse-wheel-mode):
- Don't require the first element to be modifier-free.
+ * mwheel.el (mouse-wheel-scroll-amount, mwheel-scroll)
+ (mouse-wheel-mode): Don't require the first element to be modifier-free.
* pcvs-parse.el (cvs-parse-table):
Handle `nothing known about' with more care.
@@ -13869,7 +13868,7 @@
end-statement, specially with regards to nested subprograms.
(comment-region advice): Initially disabled, for better compatibility
with other modes.
- (ada-fill-comment-paragraph): Fixed (no longer worked with Emacs 21).
+ (ada-fill-comment-paragraph): Fix (no longer worked with Emacs 21).
* progmodes/ada-xref.el: Update copyright notice.
(ada-xref-create-ali): The default is now not to create automatically
@@ -13890,7 +13889,7 @@
(ada-find-references): New parameters arg and local-only.
(ada-find-any-references): New parameters local-only and append.
(ada-goto-declaration): Fix handling of predefined entities in xref.
- (ada-get-all-references): Updated to the new xref format in GNAT 3.15,
+ (ada-get-all-references): Update to the new xref format in GNAT 3.15,
still compatible with GNAT 3.14 of course. Fix various calls to
count-lines, that didn't work correctly when the buffer was narrowed.
@@ -13959,17 +13958,17 @@
* simple.el (what-cursor-position): Use describe-char.
- * descr-text.el (describe-char): Moved from mule-diag.el, renamed
+ * descr-text.el (describe-char): Move from mule-diag.el, renamed
from describe-char-after. Now calls describe-text-properties.
- (describe-property-list): Renamed from describe-text-properties.
- (describe-text-properties): Renamed from describe-text-at.
+ (describe-property-list): Rename from describe-text-properties.
+ (describe-text-properties): Rename from describe-text-at.
New arg OUTPUT-BUFFER.
(describe-text-properties-1):
New subroutine, broken out from describe-text-properties.
Output a newline before each section of the output.
* international/mule-diag.el (describe-char-after):
- Moved to descr-text.el.
+ Move to descr-text.el.
2002-06-17 Eli Zaretskii <eliz@is.elta.co.il>
@@ -14144,9 +14143,9 @@
(eshell-sublist): Use copy-sequence.
(eshell-copy-tree): Make it an alias for copy-tree.
- * emacs-lisp/cl.el (copy-list): Moved back from subr.el.
+ * emacs-lisp/cl.el (copy-list): Move back from subr.el.
- * subr.el (copy-list): Moved to cl.el.
+ * subr.el (copy-list): Move to cl.el.
(copy-tree): Don't use copy-list or cl-pop.
2002-06-10 Miles Bader <miles@gnu.org>
@@ -14190,9 +14189,9 @@
`tty-color-translate' and `tty-color-by-index'; this is now the
main place to do it.
-2002-06-09 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-06-09 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-style.el (c-set-style, c-set-style-1):
+ * progmodes/cc-styles.el (c-set-style, c-set-style-1):
Add another state for the `dont-override' flag where it only keeps
globally set variables.
@@ -14219,13 +14218,13 @@
2002-06-08 Colin Walters <walters@verbum.org>
- * subr.el (copy-list): Moved here from cl.el.
- (copy-tree): Renamed here from `cl-copy-tree' in cl-extra.el.
+ * subr.el (copy-list): Move here from cl.el.
+ (copy-tree): Rename here from `cl-copy-tree' in cl-extra.el.
- * emacs-lisp/cl-extra.el (cl-copy-tree): Moved to `copy-tree' in
+ * emacs-lisp/cl-extra.el (cl-copy-tree): Move to `copy-tree' in
subr.el. Add a defalias with the old name.
- * emacs-lisp/cl.el (copy-list): Moved to subr.el.
+ * emacs-lisp/cl.el (copy-list): Move to subr.el.
* replace.el (occur-mode): Don't set up categories. Do set
`font-lock-defaults', and be sure to set `font-lock-core-only'.
@@ -14246,7 +14245,7 @@
(ibuffer-compile-format): Don't treat `name' category specially.
(ibuffer-column name): Use `font-lock-face'.
(filename-and-process): Ditto.
- (ibuffer-buffer-name-category): Renamed to
+ (ibuffer-buffer-name-category): Rename to
`ibuffer-buffer-name-face'. Don't use categories.
(ibuffer-update-title-and-summary): Use `font-lock-face'.
(ibuffer-insert-filter-group): Ditto.
@@ -14375,15 +14374,15 @@
* subr.el (open-network-stream, open-network-stream-nowait)
(open-network-stream-server, process-kill-without-query):
- Moved from simple.el.
+ Move from simple.el.
* simple.el (open-network-stream, open-network-stream-nowait)
(open-network-stream-server, process-kill-without-query):
- Moved to subr.el.
+ Move to subr.el.
* simple.el (byte-compiling-files-p): Function deleted.
- * textmodes/ispell.el (ispell-library-directory): Renamed from
+ * textmodes/ispell.el (ispell-library-directory): Rename from
ispell-library-path. If Ispell is not installed, init to nil.
(check-ispell-version): Doc fix.
(ispell-menu-map): Get rid of byte-compiling-files-p hackery;
@@ -14433,7 +14432,7 @@
* textmodes/sgml-mode.el (xml-mode): New alias for `sgml-mode'.
- * emacs-lisp/bytecomp.el (byte-compile-last-line): Deleted.
+ * emacs-lisp/bytecomp.el (byte-compile-last-line): Delete.
(byte-compile-delete-first): New function.
(byte-compile-read-position): New variable.
(byte-compile-last-position): New variable.
@@ -14461,7 +14460,7 @@
2002-05-27 Kim F. Storm <storm@cua.dk>
- * simple.el (push-mark-command): Added optional NOMSG arg.
+ * simple.el (push-mark-command): Add optional NOMSG arg.
* emulation/cua-base.el (cua-set-mark): Align pop to mark
behavior with standard set-mark-command.
@@ -14507,7 +14506,7 @@
* rot13.el (rot13-translate-table): New variable.
(rot13, rot13-string, rot13-region): New functions.
-2002-05-25 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-05-25 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-add-stmt-syntax): Fix some cases
of wrong anchoring, e.g. for else-if compounds.
@@ -14576,7 +14575,7 @@
(apropos-command, apropos, apropos-value, apropos-documentation):
Allow keywords in addition to regexp. Added scoring.
(apropos-documentation-check-doc-file)
- (apropos-documentation-check-elc-file): Added scoring.
+ (apropos-documentation-check-elc-file): Add scoring.
(apropos-print): Sort according to score.
2002-05-22 Colin Walters <walters@cis.ohio-state.edu>
@@ -14661,8 +14660,8 @@
(ibuffer-compile-format): If the current column is a `name'
column, figure out the appropriate category to put on it.
(filename-and-process): Use category property.
- (ibuffer-fontify-region-function): Deleted.
- (ibuffer-unfontify-region-function): Deleted.
+ (ibuffer-fontify-region-function): Delete.
+ (ibuffer-unfontify-region-function): Delete.
(ibuffer-update-title-and-summary): Use category properties.
(ibuffer-insert-filter-group): Ditto.
(ibuffer-mode): Set up category properties.
@@ -14678,7 +14677,7 @@
* ibuffer.el (toplevel): Require font-lock, to get the face
definitions.
- (ibuffer-use-fontification): Deleted.
+ (ibuffer-use-fontification): Delete.
(column filename-and-process): New column.
(ibuffer-formats): Use it by default.
(ibuffer-name-map, ibuffer-mode-name-map)
@@ -15097,8 +15096,8 @@
* emacs-lisp/find-func.el (find-function-search-for-symbol):
Add autoload cookie.
- (find-function-regexp): Include
- "\(quote " to match the defaliases in loaddefs.el.
+ (find-function-regexp):
+ Include "\(quote " to match the defaliases in loaddefs.el.
* filesets.el (filesets-conditional-sort): Use copy-sequence,
not copy-list.
@@ -15288,7 +15287,7 @@
2002-05-03 John Wiegley <johnw@gnu.org>
- * eshell/esh-var.el (eshell-modify-global-environment): Added this
+ * eshell/esh-var.el (eshell-modify-global-environment): Add this
customization variable, which will cause any "export" commands
within any eshell buffer to modify the global Emacs environment.
It defaults to nil, which means that such commands will only
@@ -15376,7 +15375,7 @@
* align.el (align-region): Fix the fix to align-region, because
the "name" argument was appearing twice.
-2002-05-01 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-05-01 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-decl-1): Better way
to handle protection labels, one which doesn't get confused by
@@ -15466,7 +15465,7 @@
* subr.el (remove-yank-excluded-properties): New helper function.
(insert-for-yank, insert-buffer-substring-as-yank): Use it.
- * simple.el (yank-excluded-properties): Added help-echo to list.
+ * simple.el (yank-excluded-properties): Add help-echo to list.
2002-04-29 Glenn Morris <gmorris@ast.cam.ac.uk>
@@ -15557,7 +15556,7 @@
not a list.
* replace.el (occur-revert-arguments):
- Renamed from occur-revert-properties. All uses changed.
+ Rename from occur-revert-properties. All uses changed.
2002-04-28 Pavel Janík <Pavel@Janik.cz>
@@ -15640,7 +15639,7 @@
2002-04-25 Michael Kifer <kifer@cs.stonybrook.edu>
- * ediff-hooks.el: Put back the autoloads.
+ * ediff-hook.el: Put back the autoloads.
2002-04-25 Colin Walters <walters@verbum.org>
@@ -15839,7 +15838,7 @@
(buffers-menu-show-status): New variables.
(menu-bar-update-buffers-1): Use them.
-2002-04-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-mask-comment): More fixes when used
from `c-do-auto-fill' and point is at or near the limit of the
@@ -15864,19 +15863,19 @@
(occur-mode-display-occurrence): Handle buffer property.
(list-matching-lines-face): Use defcustom.
(list-matching-lines-buffer-name-face): New variable.
- (occur-accumulate-lines): Renamed from `ibuffer-accumulate-lines',
+ (occur-accumulate-lines): Rename from `ibuffer-accumulate-lines',
in ibuffer.el.
(occur-read-primary-args): Move out of `occur'.
(occur): Delete. Now simply call `occur-1'.
(multi-occur, multi-occur-by-filename-regexp): New functions.
(occur-1): New function.
- (occur-engine): Renamed from `ibuffer-occur-engine' to replace the
+ (occur-engine): Rename from `ibuffer-occur-engine' to replace the
previous implementation of `occur'; taken from ibuf-ext.el.
(occur-fontify-on-property): New function.
(occur-fontify-region-function, occur-unfontify-region-function):
New functions.
- * ibuffer.el (ibuffer-accumulate-lines): Moved to replace.el.
+ * ibuffer.el (ibuffer-accumulate-lines): Move to replace.el.
* ibuf-ext.el (ibuffer-depropertize-string): Delete.
(ibuffer-occur-match-face): Delete.
@@ -15884,7 +15883,7 @@
(ibuffer-occur-mouse-display-occurence): Delete.
(ibuffer-occur-goto-occurence, ibuffer-occur-display-occurence)
(ibuffer-do-occur-1, ibuffer-occur-revert-buffer-function): Delete.
- (ibuffer-occur-engine): Moved to replace.el.
+ (ibuffer-occur-engine): Move to replace.el.
(ibuffer-do-occur): Simply call `occur-1'.
* play/gamegrid.el (gamegrid-add-score-with-update-game-score):
@@ -15922,9 +15921,9 @@
* dired.el (dired-mouse-find-file-other-window):
Handle events that move out of the window.
-2002-04-23 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-23 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-cmds.el (c-mask-comment): Fixed bug where point
+ * progmodes/cc-cmds.el (c-mask-comment): Fix bug where point
was moved to the following line when it was at the first line
of a block comment where comment-start-skip matched to eol.
@@ -15949,13 +15948,13 @@
* diary-lib.el (include-other-diary-files): Allow modifying
included buffer, to turn off selective display.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el (c-define-abbrev-table): New function to
pass the SYSTEM-FLAG to `define-abbrev' in a way that works in
emacsen that doesn't support it.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el, progmodes/cc-engine.el,
* progmodes/cc-styles.el, progmodes/cc-vars.el
@@ -15977,27 +15976,27 @@
(c-opt-asm-stmt-key): New language variable to recognize the
beginning of asm statements.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-guess-basic-syntax):
Detect variable declarations after class and struct declarations
correctly. Fixed limit error when finding the anchor for
template-args-cont and topmost-intro-cont.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-beginning-of-defun)
(c-declaration-limits): Find the "line oriented" declaration
start too, just like the "line oriented" end is found.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* 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
this case. Besides, `inexpr-statement' is not very common.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-delete-forward):
Fix silly bug that caused it to delete backwards in hungry delete
@@ -16014,7 +16013,7 @@
list initializers correctly (but costly; it ought to be
integrated into `c-beginning-of-statement-1').
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el, progmodes/cc-engine.el
(c-beginning-of-defun, c-end-of-defun, c-mark-function):
@@ -16029,7 +16028,7 @@
handles declarations that continue after the block.
* progmodes/cc-engine.el (c-syntactic-re-search-forward):
- Added an option to restrict matching to the top level of the
+ Add an option to restrict matching to the top level of the
current paren sexp.
* progmodes/cc-langs.el (c-opt-block-decls-with-vars-key):
@@ -16037,9 +16036,9 @@
(c-syntactic-eol): New regexp to match a "syntactic" eol.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a bug
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a bug
that often caused the backward limit to be lost at the top
level. This improves performance a bit.
@@ -16053,12 +16052,12 @@
(c-beginning-of-decl-1): New function that put point at the
beginning of the declaration. It handles K&R argdecl blocks.
- (c-guess-basic-syntax): Replaced the `knr-argdecl' recognition
+ (c-guess-basic-syntax): Replace the `knr-argdecl' recognition
code with one that doesn't depend on the current indentation.
The anchor position for `knr-argdecl' has also changed, but in
a way that is unlikely to cause compatibility problems.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-defs.el, progmodes/cc-engine.el
(c-forward-comment): `forward-comment' in XEmacs skips over
@@ -16070,19 +16069,19 @@
setup of the language specific variables. The regexp-opt
mangling is also done at compile time now.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-indent-line-or-region):
Call `c-indent-line' directly instead of through
`indent-according-to-mode' so that this function always
indents syntactically.
- * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a bug
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a bug
where a class beginning with a nested class could cause an
infinite loop (the state outside the narrowed out class is
never used now).
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el, progmodes/cc-cmds.el,
progmodes/cc-engine.el, progmodes/cc-vars.el: Fixes so that
@@ -16103,7 +16102,7 @@
* progmodes/cc-align.el: Use the vector form in the return
value in all cases where lineup functions return absolute columns.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-add-stmt-syntax)
(c-guess-basic-syntax): Anchor `brace-list-intro' and
@@ -16123,7 +16122,7 @@
(c-major-mode-is): Compare against the buffer local variable
`c-buffer-is-cc-mode', which is faster than using `derived-mode-class'.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-forward-syntactic-ws)
(c-backward-syntactic-ws, c-forward-token-1)
@@ -16134,19 +16133,19 @@
That's signified by making their documentation into docstrings.
(c-whack-state, c-hack-state, c-skip-case-statement-forward):
- Removed these internal functions since they aren't used.
+ Remove these internal functions since they aren't used.
(c-forward-to-cpp-expression): Classified this function as internal.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el (c-ObjC-class-key, c-Java-class-key):
- Simplified these regexps; the class keywords they contain
+ Simplify these regexps; the class keywords they contain
ought to be enough to avoid false matches, so checking for
following identifiers etc is just unnecessary (and might also
fail for oddly formatted code).
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el, progmodes/cc-cmds.el
(c-forward-comment-lc): New function that behaves like
@@ -16161,7 +16160,7 @@
normal label in a switch block as a case label, to get
consistent lineup with the case labels.
- * progmodes/cc-engine.el (c-backward-syntactic-ws): Fixed bug
+ * progmodes/cc-engine.el (c-backward-syntactic-ws): Fix bug
in skipping over a macro that ends with an empty line.
* progmodes/cc-styles.el: Require cc-align since styles added
@@ -16169,10 +16168,10 @@
defined there, and so the `c-valid-offset' check might
otherwise complain on them.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-align.el, progmodes/cc-mode.texi,
- progmodes/cc-vars.el: Added two new lineup functions:
+ * progmodes/cc-align.el, progmodes/cc-mode.el:
+ * progmodes/cc-vars.el: Added two new lineup functions:
(c-lineup-knr-region-comment): A new lineup function to get
(what most people think is) better indentation of comments in
@@ -16196,7 +16195,7 @@
* progmodes/cc-langs.el (c-symbol-key): Made this variable
mode specific, to handle Pike special symbols like `== better.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el, progmodes/cc-engine.el,
progmodes/cc-vars.el (c-report-syntactic-errors): A new
@@ -16204,13 +16203,13 @@
to off; since CC Mode ignores most syntactic errors it might
as well ignore them all for the sake of consistency.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-looking-at-inexpr-block):
Optimization. Can give a noticeable speedup if there's a
large preceding function or class body.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el, progmodes/cc-cmds.el: Use more
efficient and correct insertion functions in many places.
@@ -16222,21 +16221,21 @@
* progmodes/cc-styles.el (c-read-offset): Unbind SPC in the
completion to make it easier to enter lists.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-cmds.el (c-beginning-of-defun): Fixed bug where
+ * progmodes/cc-cmds.el (c-beginning-of-defun): Fix bug where
c-state-cache was clobbered.
* progmodes/cc-cmds.el, progmodes/cc-engine.el
- (c-calculate-state): Moved from cc-cmds.el to cc-engine.el due
+ (c-calculate-state): Move from cc-cmds.el to cc-engine.el due
to dependency.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-parse-state): Ignore unbalanced
open parens in macros (if point isn't in the same one).
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-context-open-line): New function
that is the `open-line' equivalent to `c-context-line-break'.
@@ -16245,7 +16244,7 @@
for Emacs 21 since `indent-new-comment-line' has been changed
to `comment-indent-new-line' there.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el, progmodes/cc-langs.el
(c-stmt-delim-chars, c-stmt-delim-chars-with-comma):
@@ -16258,7 +16257,7 @@
the set of statement delimiting characters, to allow it to be
changed dynamically and per-mode.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-looking-at-bos)
(c-looking-at-inexpr-block, c-add-stmt-syntax)
@@ -16271,21 +16270,21 @@
Made arglist-cont anchor correctly in arglists that contain statements.
* progmodes/cc-engine.el (c-guess-basic-syntax):
- Fixed consistent anchoring of defun-block-intro in defuns in code
+ Fix consistent anchoring of defun-block-intro in defuns in code
blocks (can only occur in Pike).
* progmodes/cc-engine.el (c-looking-at-inexpr-block)
- (c-looking-at-inexpr-block-backward): Changed the arguments to
+ (c-looking-at-inexpr-block-backward): Change the arguments to
require containing sexps and paren state, for better efficiency.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el, progmodes/cc-engine.el,
progmodes/cc-vars.el: Improved anchoring of statement and
handling of labels in front of substatements.
(c-guess-continued-construct, c-guess-basic-syntax):
- Improved and unified anchoring at statements. Statements beginning
+ Improve and unified anchoring at statements. Statements beginning
with comments or labels are now avoided, by going out of
blocks and containing statements if necessary. This nesting
handling also fixes the case when there's a statement after a
@@ -16294,7 +16293,7 @@
(c-electric-colon): Map the new `substatement-label' to
`label' when consulting `c-hanging-colons-alist'.
- (c-offsets-alist): Added substatement-label. Updated the
+ (c-offsets-alist): Add substatement-label. Updated the
comments for the new anchoring positions at statements.
* progmodes/cc-engine.el (c-guess-basic-syntax): Use more sane
@@ -16303,7 +16302,7 @@
neutralized by a kludge in `c-get-syntactic-indentation' which
ignored such anchor points.
- (c-get-syntactic-indentation): Removed the kludge that was
+ (c-get-syntactic-indentation): Remove the kludge that was
necessary due to buggy anchor points.
* progmodes/cc-engine.el (c-guess-basic-syntax): Do not check
@@ -16313,7 +16312,7 @@
recognized as normal arglist-cont if we're directly in a macro
arglist, for consistency with other "bare" statements.
- * progmodes/cc-engine.el (c-looking-at-bos): Added optional
+ * progmodes/cc-engine.el (c-looking-at-bos): Add optional
limit arg for backward searches.
* progmodes/cc-engine.el (c-looking-at-inexpr-block):
@@ -16326,7 +16325,7 @@
in the list of syntactic symbols. Only the first is used as
the base for the offset calculation.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-indent-defun): Indent the current
macro if inside one at the top level. Do not throw an error
@@ -16341,7 +16340,7 @@
* progmodes/cc-engine.el (c-least-enclosing-brace):
Rewritten to not be destructive.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-context-line-break): Only do a macro
line break when point is inside the content of it; if it's in
@@ -16350,21 +16349,21 @@
* progmodes/cc-engine.el (c-guess-basic-syntax): Do not add
cpp-macro-cont inside the argument list to a #define.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-defs.el (c-forward-comment): Implemented a
kludge to avoid the problem most forward-comment incarnations
have with `\' together with comment parsing.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el (c-check-state-cache): Fixed bug
+ * progmodes/cc-engine.el (c-check-state-cache): Fix bug
which could cause the state returned by `c-parse-state' to
lack a closed paren element. That in turn could result in
very long searches, since it's common that they start from the
last preceding close brace.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-statement-1): Do not
treat else-if as a single continuation, since that'd make it
@@ -16374,7 +16373,7 @@
the starting if, but that doesn't affect the indentation for
any reasonably sane style. Also introduced a noerror flag.
- (c-beginning-of-closest-statement): Removed;
+ (c-beginning-of-closest-statement): Remove;
c-beginning-of-statement-1 now avoids the problem this one solved.
* progmodes/cc-engine.el (c-guess-continued-construct)
@@ -16385,7 +16384,7 @@
before the start of the statement.
* progmodes/cc-engine.el (c-looking-at-inexpr-block):
- Added flag to disable looking at the type of the surrounding paren
+ Add flag to disable looking at the type of the surrounding paren
since that confuses c-beginning-of-statement-1 and a couple of
other places.
@@ -16393,7 +16392,7 @@
Avoid stepping to the previous statement in case 18.
Improvements in recognition of statement blocks on the top level.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-statement-1)
(c-crosses-statement-barrier-p): Rewritten to get a well
@@ -16401,7 +16400,7 @@
in recognition of do-while constructs.
(c-backward-to-start-of-do, c-backward-to-start-of-if):
- Removed; use c-beginning-of-statement-1 instead.
+ Remove; use c-beginning-of-statement-1 instead.
(c-guess-continued-construct, c-guess-basic-syntax):
Various fixes to not depend on the bugs previously in
@@ -16409,20 +16408,20 @@
use the new behavior of c-beginning-of-statement-1 better.
Fixed recognition of catch blocks inside macros.
- * progmodes/cc-engine.el (c-backward-syntactic-ws): Fixed bug
+ * progmodes/cc-engine.el (c-backward-syntactic-ws): Fix bug
in skipping over a macro.
* progmodes/cc-langs.el (c-label-kwds): New variable to
contain the appropriate c-*-label-kwds value.
- * progmodes/cc-vars.el (defcustom-c-stylevar): Fixed value
+ * progmodes/cc-vars.el (defcustom-c-stylevar): Fix value
evaluation bug that caused the widget for
c-block-comment-prefix to bug out.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-guess-basic-syntax):
- Improved recognition of statements: They are now recognized in
+ Improve recognition of statements: They are now recognized in
contexts where they normally can't occur, e.g. on the top level or
in function call arguments. This is mainly useful to recognize
statements in macros at the top level, and in arguments to
@@ -16445,7 +16444,7 @@
analysis in ObjC mode.
* progmodes/cc-engine.el (c-beginning-of-statement-1):
- Fixed bug in do-while statements where the body is not a block.
+ Fix bug in do-while statements where the body is not a block.
* progmodes/cc-styles.el (c-set-style):
Reset c-special-indent-hook to its global value if in override mode.
@@ -16455,10 +16454,10 @@
* progmodes/cc-engine.el (c-evaluate-offset, c-get-offset):
Use c-benign-error to report the c-strict-syntax-p error.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-align.el, progmodes/cc-defs.el,
- progmodes/cc-cmds.el, progmodes/cc-engine.el, cc-vars.el:
+ * progmodes/cc-align.el, progmodes/cc-defs.el:
+ * progmodes/cc-cmds.el, progmodes/cc-engine.el, progmodes/cc-vars.el:
Several fixes to treat macros as code and not literals and to
handle line continuations transparently.
@@ -16470,7 +16469,7 @@
default. An extra flag argument is required to do that.
(c-macro-start, c-query-macro-start)
- (c-query-and-set-macro-start): Added a cache for the macro
+ (c-query-and-set-macro-start): Add a cache for the macro
start position.
(c-forward-syntactic-ws, c-backward-syntactic-ws): Fixes for
@@ -16478,7 +16477,7 @@
in forward-comment in some emacsen when it hits a buffer limit
with a large repeat count.
- (c-lineup-macro-cont): Improved behavior when
+ (c-lineup-macro-cont): Improve behavior when
c-syntactic-indentation-in-macros is nil.
(c-syntactic-indentation-in-macros, c-backslash-max-column)
@@ -16496,15 +16495,15 @@
(c-benign-error): New macro to report errors that doesn't need
to interrupt the operation.
- * progmodes/cc-defs.el (c-point): Added eonl and eopl positions.
+ * progmodes/cc-defs.el (c-point): Add eonl and eopl positions.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace, c-indent-region):
- Removed most of the c-state-cache fiddling, since the global
+ Remove most of the c-state-cache fiddling, since the global
state cache now handles this.
- * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug
when there's an open paren at the very first char of the
visible buffer region.
@@ -16516,7 +16515,7 @@
* progmodes/cc-engine.el (c-whack-state-after): Slight optimization.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el, progmodes/cc-langs.el,
progmodes/cc-align.el: Improvements to syntactic analysis
@@ -16525,7 +16524,7 @@
(c-block-stmt-1-kwds, c-block-stmt-2-kwds): New variables used
by `c-guess-basic-syntax'.
- (c-parse-state): Fixed bug with braces inside macros when
+ (c-parse-state): Fix bug with braces inside macros when
using cached state info.
(c-forward-to-cpp-expression): New function to aid in
@@ -16543,7 +16542,7 @@
(c-offsets-alist): Made `c-lineup-macro-cont' the default for
cpp-macro-cont.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-statement-1)
(c-forward-syntactic-ws): Fixes to handle continued lines.
@@ -16551,7 +16550,7 @@
(c-backward-to-start-of-if, c-guess-basic-syntax):
Do syntactic analysis inside macros.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-indent-region): Did a speedup made
possible by the more flexible state cache.
@@ -16559,22 +16558,22 @@
* progmodes/cc-engine.el (c-parse-state, c-whack-state-before)
(c-whack-state-after, c-hack-state)
(c-narrow-out-enclosing-class, c-guess-basic-syntax):
- Improved the state cache system. It now can use partial info from
+ Improve the state cache system. It now can use partial info from
an old cached state to calculate a new one at a different
position. Removed some kludges to avoid the state cache.
The new functions `c-whack-state-before' and `c-whack-state-after'
replace the now obsolete `c-whack-state'.
* progmodes/cc-engine.el (c-beginning-of-statement-1):
- Optimized backing through a macro. This can speed things up
+ Optimize backing through a macro. This can speed things up
quite a bit when there are long macros before point.
(c-beginning-of-macro): Do not ignore the limit.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-continued-statement):
- Fixed a bug where the keyword wasn't reindented correctly if
+ Fix a bug where the keyword wasn't reindented correctly if
followed by another keyword or identifier.
* progmodes/cc-engine.el (c-parse-state): Ignore closed brace
@@ -16582,7 +16581,7 @@
second of two "do { } while (0)" macros after each other
indented differently.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-macro)
(c-forward-syntactic-ws): Recognize "#!" as a preprocessor
@@ -16590,13 +16589,13 @@
interpreter lines like "#!/usr/bin/pike" at the beginning of
the file.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-looking-at-inexpr-block):
Recognize brace blocks inside a parenthesis expression as
inexpr-statement. Useful when writing statements as macro arguments.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-fill-paragraph, c-do-auto-fill)
(c-mask-comment): Broke out the comment masking code from
@@ -16604,14 +16603,14 @@
able to do the same thing in `c-do-auto-fill'. This should
make auto-fill-mode behave better.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace, c-electric-paren):
Check `executing-macro' to avoid blinking parens when macros
are executed.
* progmodes/cc-mode.el, progmodes/cc-styles.el
- (c-setup-filladapt): Moved from cc-mode.el to cc-styles.el for
+ (c-setup-filladapt): Move from cc-mode.el to cc-styles.el for
consistency with `c-setup-paragraph-variables' (which was
placed there due to the dependency from `c-set-style').
@@ -16620,14 +16619,14 @@
there already is a style called "user" defined when CC Mode
starts up for the first time.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el, progmodes/cc-vars.el
- (c-comment-indent, c-indent-comment-alist): Added new variable
+ (c-comment-indent, c-indent-comment-alist): Add new variable
`c-indent-comment-alist' to allow better control over
`c-comment-indent'.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el (c-lineup-C-comments): Try to match
both `comment-start-skip' and the comment prefix on the
@@ -16637,29 +16636,29 @@
`comment-start-skip' match whatever `c-comment-prefix-regexp' matches.
* progmodes/cc-mode.el, progmodes/cc-styles.el (c-common-init)
- (c-set-style-1, c-setup-paragraph-variables): Moved the
+ (c-set-style-1, c-setup-paragraph-variables): Move the
variable initialization based on `c-comment-prefix-regexp' to
a new function `c-setup-paragraph-variables', which is now
used both at mode init and when a style that sets
`c-comment-prefix-regexp' is activated.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-member-init-list):
Better handling of C++ template args to avoid confusion with
`<' and `>' used as operators in member init expressions.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-most-enclosing-brace)
- (c-least-enclosing-brace): Added optional second arg to limit
+ (c-least-enclosing-brace): Add optional second arg to limit
the search to before a certain point.
- * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed bug which
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug which
could cause incorrect analysis if a cached state is used (usually
only happens when an electric key reindents a line).
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-defs.el (c-forward-comment): More idiosyncrasy
insulation. This time for XEmacs 21.
@@ -16677,25 +16676,25 @@
the indentation of the current line. Switched places on cases
5D.3 and 5D.4 and made them use more syntactically correct methods.
- (c-inher-key): Removed since the code in
+ (c-inher-key): Remove since the code in
`c-guess-basic-syntax' now uses token-based search.
* progmodes/cc-cmds.el, progmodes/cc-mode.el (c-mode-menu):
- Added a submenu to access some toggles.
+ Add a submenu to access some toggles.
(c-toggle-syntactic-indentation): New function to toggle the
variable `c-syntactic-indentation'.
- * progmodes/cc-styles.el (c-set-style): Improved the error
+ * progmodes/cc-styles.el (c-set-style): Improve the error
message for incorrect offsets a bit.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-indent-exp): Don't require that the
sexp follows point immediately, instead find the closest
following open paren that ends on another line.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el (c-lineup-cascaded-calls):
New indentation function.
@@ -16703,26 +16702,26 @@
* progmodes/cc-engine.el (c-beginning-of-macro): Bugfix for
directives with whitespace between the '#' and the name.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-forward-syntactic-ws)
(c-backward-syntactic-ws): Handle line continuations as
whitespace. Don't move past a macro if that'd take us past
the limit.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-macro)
(c-forward-syntactic-ws): Multiline strings begin with `#"' in
Pike, and that shouldn't be confused with a preprocessor directive.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el: Extended the kludge to interoperate
with the delsel and pending-del packages wrt to the new
function `c-electric-delete-forward'.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-indent-exp): Keep the indentation of
the block itself, i.e. only indent the contents in it.
@@ -16731,38 +16730,38 @@
argument to completing-read instead of initial-contents, if
the function is recent enough to support it.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el (c-mode-help-address):
- Removed bug-gnu-emacs@gnu.org from the receiver list for bug reports.
+ Remove bug-gnu-emacs@gnu.org from the receiver list for bug reports.
I've almost never seen a bug reported this way that should go
to that list, but it's rather common that the reports concern
the combination CC Mode and XEmacs instead.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-cmds.el (c-electric-paren): Fixed bug when both
+ * progmodes/cc-cmds.el (c-electric-paren): Fix bug when both
brace-elseif-brace and brace-catch-brace are active and
there's a "else if"-block before the catch block.
* progmodes/cc-menus.el (cc-imenu-c++-generic-expression):
Detect function headers that span lines.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace)
(c-electric-semi&comma, c-electric-colon, c-electric-paren):
Check for last on line only for doing the auto-newline-mode
stuff, not for the reindentation.
- * progmodes/cc-cmds.el (c-electric-brace): Fixed bugs in the
+ * progmodes/cc-cmds.el (c-electric-brace): Fix bugs in the
handling of c-syntactic-indentation: When it's nil, indent the
new lines but don't reindent the current one. Reindent the
line only when the inserted brace comes first on it, instead
of last.
* progmodes/cc-cmds.el (c-electric-brace)
- (c-electric-semi&comma): Fixed two places where
+ (c-electric-semi&comma): Fix two places where
c-syntactic-indentation wasn't heeded.
* progmodes/cc-cmds.el (c-electric-pound): Don't be electric
@@ -16773,7 +16772,7 @@
is found. Fixed case where an else following a do-while
statement could be associated with an if inside the do-while.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-guess-fill-prefix): Tuned the dwim
for the fallback to add a single space after the comment prefix.
@@ -16782,15 +16781,15 @@
behavior in some special cases, especially for single-line comments.
Avoid breaking up a comment starter or ender.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-outline-level): Applied patch from
the Emacs sources to make this work in invisible text.
- * progmodes/cc-langs.el (c-switch-label-key): Fixed regexp to
+ * progmodes/cc-langs.el (c-switch-label-key): Fix regexp to
not be confused by a later ':' on the same line as the label.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el, progmodes/cc-mode.el
(c-electric-delete, c-electric-delete-forward):
@@ -16801,20 +16800,20 @@
`c-electric-delete-forward' is now bound to C-d to get the
electric behavior on that key too.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-cmds.el (c-fill-paragraph): Fixed bogus direct
+ * progmodes/cc-cmds.el (c-fill-paragraph): Fix bogus direct
use of c-comment-prefix-regexp, which caused an error when
it's a list.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el, progmodes/cc-vars.el (c-common-init)
- (c-default-style): Removed the hardcoded switch to "java" style
+ (c-default-style): Remove the hardcoded switch to "java" style
in Java mode. It's instead taken care of by the default value
for c-default-style.
-2002-04-22 Martin Stjernholm <bug-cc-mode@gnu.org>
+2002-04-22 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-align.el (c-lineup-math): Fix bug where lineup
was triggered by equal signs in string literals.
@@ -16865,9 +16864,9 @@
2002-04-19 Miles Bader <miles@gnu.org>
* custom.el (customize-mark-to-save, customize-mark-as-set)
- (custom-quote): Moved here from `cus-edit.el'.
+ (custom-quote): Move here from `cus-edit.el'.
* cus-edit.el (customize-mark-to-save, customize-mark-as-set)
- (custom-quote): Moved to `custom.el'.
+ (custom-quote): Move to `custom.el'.
2002-04-18 Richard M. Stallman <rms@gnu.org>
@@ -16959,7 +16958,7 @@
(ediff-clone-buffer-for-region-comparison): More robust window
arrangement while prompting for regions to compare.
(ediff-make-cloned-buffer): Use generate-new-buffer-name.
- (ediff-inferior-compare-regions): Deleted unused vars
+ (ediff-inferior-compare-regions): Delete unused vars
ctl-buf and quit-now.
2002-04-15 Richard M. Stallman <rms@gnu.org>
@@ -17040,7 +17039,7 @@
call `math-group-float'.
* play/gamegrid.el (gamegrid-add-score-with-update-game-score):
- Renamed from `gamegrid-add-score'.
+ Rename from `gamegrid-add-score'.
(gamegrid-add-score-insecure): Restored from the old
`gamegrid-add-score'.
(gamegrid-add-score): Just dispatch on `system-type' to one of the
@@ -17454,7 +17453,7 @@
(sgml-insert-end-tag): New funs taken from xml-lite.el.
(sgml-calculate-indent): Use them.
(sgml-slash-matching): Rename from sgml-slash.
- (sgml-slash): Copied from xml-lite and changed to use
+ (sgml-slash): Copy from xml-lite and changed to use
sgml-slash-matching and sgml-quick-keys.
* international/mule-cmds.el (standard-keyboard-coding-systems):
@@ -17484,7 +17483,7 @@
2002-04-01 Ville Skyttä <ville.skytta@xemacs.org>
- * tcl.el (tcl-imenu-generic-expression): New value.
+ * progmodes/tcl.el (tcl-imenu-generic-expression): New value.
(tcl-imenu-create-index-function): Function deleted.
(tcl-mode): Check for filladapt-mode.
Use tcl-imenu-generic-expression instead of
@@ -17503,10 +17502,10 @@
* info.el (info-tool-bar-map): Use tool-bar-local-item-from-menu.
- * toolbar/tool-bar.el (tool-bar-local-item): Renamed from
+ * toolbar/tool-bar.el (tool-bar-local-item): Rename from
tool-bar-add-item, and new arg MAP.
(tool-bar-add-item): Now calls tool-bar-local-item.
- (tool-bar-local-item-from-menu): Renamed from
+ (tool-bar-local-item-from-menu): Rename from
tool-bar-add-item-from-menu, and new arg IN-MAP.
(tool-bar-add-item-from-menu): Now calls tool-bar-local-item-from-menu.
@@ -17543,9 +17542,9 @@
2002-03-29 Richard M. Stallman <rms@gnu.org>
- * subr.el (play-sound-file): Moved to simple.el.
+ * subr.el (play-sound-file): Move to simple.el.
- * simple.el (play-sound-file): Moved from subr.el, made unconditional.
+ * simple.el (play-sound-file): Move from subr.el, made unconditional.
2002-03-29 Colin Walters <walters@verbum.org>
@@ -17627,7 +17626,7 @@
2002-03-28 Richard M. Stallman <rms@gnu.org>
- * dired.el (dired-toggle-marks): Renamed from dired-do-toggle.
+ * dired.el (dired-toggle-marks): Rename from dired-do-toggle.
Bindings changed.
* progmodes/compile.el (compilation-handle-exit):
@@ -17715,7 +17714,7 @@
* gud.el (gud-jdb-sourcepath): New variable, saves jdb -sourcepath
parameter value.
(gud-jdb-build-source-files-list): Comment clarification.
- (gud-jdb-massage-args): Reworked into loop-based argument list
+ (gud-jdb-massage-args): Rework into loop-based argument list
processing in order to support -classpath and -sourcepath argument
processing.
(gud-jdb-find-source-using-classpath): Prepend gud-jdb-sourcepath
@@ -17880,8 +17879,8 @@
* ediff-diff.el (ediff-install-fine-diff-if-necessary):
Take the current highlighting style into account.
- (ediff-forward-word-function,ediff-whitespace,ediff-word-1)
- (ediff-word-2,ediff-word-3,ediff-word-4): Make them buffer local.
+ (ediff-forward-word-function, ediff-whitespace, ediff-word-1)
+ (ediff-word-2, ediff-word-3, ediff-word-4): Make them buffer local.
* ediff-init.el (ediff-patch-job): New macro.
@@ -17895,11 +17894,11 @@
* ediff-util.el (ediff-toggle-hilit): Fix toggling of highlighting.
(ediff-select-difference): Take highlighting style into account.
(ediff-clone-buffer-for-region-comparison): New function.
- (ediff-inferior-compare-regions): Added comparison of current diff
+ (ediff-inferior-compare-regions): Add comparison of current diff
regions.
* ediff.el (ediff-clone-buffer-for-region-comparison)
- (ediff-clone-buffer-for-window-comparison): Moved to ediff-util.el.
+ (ediff-clone-buffer-for-window-comparison): Move to ediff-util.el.
2002-03-19 Paul Reilly <pmr-sav@hamm.pajato.com>
@@ -17978,7 +17977,7 @@
2002-03-17 Stefan Monnier <monnier@cs.yale.edu>
- * textmodes/sgml-mode.el (sgml-xml-mode): Renamed from sgml-xml.
+ * textmodes/sgml-mode.el (sgml-xml-mode): Rename from sgml-xml.
(sgml-xml-guess): Simplify.
(sgml-mode-common): Remove (move into sgml-mode).
(sgml-mode): Add code from sgml-mode-common.
@@ -18021,7 +18020,7 @@
2002-03-16 Simon Marshall <simon.marshall@misys.com>
- * imenu.el (imenu-menubar-modified-tick): Renamed from
+ * imenu.el (imenu-menubar-modified-tick): Rename from
imenu-update-menubar-modified-tick.
(imenu-update-menubar): Update imenu-menubar-modified-tick
whenever outer condition succeeds.
@@ -18099,7 +18098,7 @@
(dired-internal-do-deletions): Use dired-fun-in-all-buffers
and dired-delete-entry, to update this buffer (and others).
- * dired-aux.el (dired-fun-in-all-buffers): Moved to dired.el.
+ * dired-aux.el (dired-fun-in-all-buffers): Move to dired.el.
* facemenu.el (facemenu-add-new-face):
Pass region args to facemenu-set-face, when there is a region.
@@ -18168,7 +18167,7 @@
(lisp-loop-forms-indentation, lisp-simple-loop-indentation):
New user options.
(extended-loop-p, common-lisp-loop-part-indentation): New functions.
- (common-lisp-indent-function-1): Renamed from
+ (common-lisp-indent-function-1): Rename from
common-lisp-indent-function.
(common-lisp-indent-function): Handle loop forms specially.
(lisp-indent-defmethod): Use car/cdr instead of first/rest.
@@ -18279,7 +18278,7 @@
(ibuffer-insert-buffer-line): Ditto.
(ibuffer-map-lines): Ditto.
(ibuffer-insert-buffers-and-marks): Ditto.
- (ibuffer-update-title-and-summary): Renamed from
+ (ibuffer-update-title-and-summary): Rename from
`ibuffer-update-title'. Handle "summarizer" columns.
(ibuffer-clear-summary-columns): New function.
@@ -18322,7 +18321,7 @@
(hif-tokenize): Handle `?' and ':' as tokens.
(hif-expr): Parse conditional expressions.
(hif-or-expr): Parse `||' expressions.
- (hif-and-expr): Renamed from hif-term.
+ (hif-and-expr): Rename from hif-term.
(hif-conditional): New function to evaluate a conditional
expression.
@@ -18359,7 +18358,7 @@
is loaded.
* ediff-mult.el (ediff-intersect-directories)
- (ediff-prepare-meta-buffer,ediff-get-directory-files-under-revision):
+ (ediff-prepare-meta-buffer, ediff-get-directory-files-under-revision):
Cleanup.
(ediff-draw-dir-diffs): Now supports the "C" command in directory
difference buffer.
@@ -18442,14 +18441,14 @@
* cus-start.el: Rename automatic-hscroll-step and
automatic-hscroll-margin into hscroll-step and hscroll-margin.
- * frame.el (auto-hscroll-mode): Renamed from automatic-hscrolling.
+ * frame.el (auto-hscroll-mode): Rename from automatic-hscrolling.
(automatic-hscrolling): Now a defvaralias for auto-hscroll-mode.
* mouse.el (mouse-region-delete-keys): Add deletechar.
2002-03-03 Sam Steingold <sds@gnu.org>
- * play/snake.el (snake-score-file): Fixed parens (broken by the
+ * play/snake.el (snake-score-file): Fix parens (broken by the
last patch).
* play/tetris.el (tetris-score-file): Ditto.
@@ -18575,14 +18574,14 @@
`winner-boring-buffers', will no longer be restored by `winner-undo'.
(winner-sorted-window-list): Used to improve comparison between
window configurations.
- (winner-win-data): Simplified and moved.
- (winner-conf): Simplified (now uses `winner-win-data').
+ (winner-win-data): Simplify and moved.
+ (winner-conf): Simplify (now uses `winner-win-data').
(winner-change-fun, winner-save-old-configurations)
(winner-save-(un)conditionally, winner-redo): Changes made while in
the minibuffer will be ignored. (Such changes are undone upon
exit for the minibuffer, anyway.)
(winner-set-conf): Preserve selected window whenever possible.
- (winner-make-point-alist): Simplified.
+ (winner-make-point-alist): Simplify.
(winner-mode, winner-save-unconditionally): Save current window
configuration on entering minibuffer.
(minor-mode-alist): Don't add winner-mode to `minor-mode-alist',
@@ -18590,11 +18589,11 @@
2002-02-26 Eli Zaretskii <eliz@is.elta.co.il>
- * international/mule-conf.el (compound-text): Renamed back from
+ * international/mule-conf.el (compound-text): Rename back from
compound-text-no-extensions.
(ctext-no-compositions): Remove the mime-charset property.
- (compound-text-with-extensions): Renamed from compound-text.
- (x-ctext-with-extensions, ctext-with-extensions): Renamed aliases.
+ (compound-text-with-extensions): Rename from compound-text.
+ (x-ctext-with-extensions, ctext-with-extensions): Rename aliases.
2002-02-26 Juanma Barranquero <lektu@terra.es>
@@ -18637,7 +18636,7 @@
2002-02-25 Per Abrahamsen <abraham@dina.kvl.dk>
- * ps-print.el (ps-print-printer): Added `lpr' customize group member.
+ * ps-print.el (ps-print-printer): Add `lpr' customize group member.
2002-02-25 Juanma Barranquero <lektu@terra.es>
@@ -18716,7 +18715,7 @@
(snake-update-game, snake-move-left)
(snake-move-right, snake-move-up, snake-move-down, snake-active-p)
(snake-start-game): Use that queue.
- (snake-use-glyphs-flag): Renamed from snake-use-glyphs.
+ (snake-use-glyphs-flag): Rename from snake-use-glyphs.
(snake-use-color-flag): Likewise.
(snake-mode): Rename uses of those variables.
@@ -18726,7 +18725,7 @@
* international/mule-conf.el (ctext-no-compositions): New coding
system.
- (compound-text-no-extensions): Renamed from compound-text.
+ (compound-text-no-extensions): Rename from compound-text.
(x-ctext-no-extensions, ctext-no-extensions): Aliases for
compound-text-no-extensions.
(compound-text): Redefined using post-read and pre-write conversions.
@@ -18814,7 +18813,7 @@
2002-02-19 Per Abrahamsen <abraham@dina.kvl.dk>
- * facemenu.el (describe-text-mode-map): Removed bootstrap kludge.
+ * facemenu.el (describe-text-mode-map): Remove bootstrap kludge.
* toolbar/tool-bar.el (tool-bar-mode): Made the standard value t.
* menu-bar.el (menu-bar-mode): Ditto.
@@ -18861,10 +18860,10 @@
2002-02-17 Per Abrahamsen <abraham@dina.kvl.dk>
- * menu-bar.el (menu-bar-showhide-menu): Added speedbar.
- (menu-bar-tools-menu): Removed speedbar.
+ * menu-bar.el (menu-bar-showhide-menu): Add speedbar.
+ (menu-bar-tools-menu): Remove speedbar.
- * textmodes/ispell.el (ispell-menu-map): Added `customize-ispell'
+ * textmodes/ispell.el (ispell-menu-map): Add `customize-ispell'
and `flyspell-mode' entries.
* textmodes/flyspell.el (flyspell): Add to ispell group.
@@ -18963,13 +18962,13 @@
2002-02-16 John Wiegley <johnw@gnu.org>
- * eshell/esh-ext.el (eshell-external-command): Added a fix for
+ * eshell/esh-ext.el (eshell-external-command): Add a fix for
XEmacs' new dired.el, which adds a global entry in the
`file-name-handler-alist'.
2002-02-16 John Wiegley <johnw@gnu.org>
- * align.el (align-region): Added a missing name argument.
+ * align.el (align-region): Add a missing name argument.
2002-02-16 John Wiegley <johnw@gnu.org>
@@ -19038,7 +19037,7 @@
2002-02-12 Per Abrahamsen <abraham@dina.kvl.dk>
- * menu-bar.el (menu-bar-options-save): Removed `truncate-lines'.
+ * menu-bar.el (menu-bar-options-save): Remove `truncate-lines'.
(menu-bar-options-menu): Don't set default value for `truncate-lines'.
2002-02-12 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -19064,7 +19063,7 @@
2002-02-11 Per Abrahamsen <abraham@dina.kvl.dk>
- * toolbar/tool-bar.el (tool-bar-mode): Removed standard value.
+ * toolbar/tool-bar.el (tool-bar-mode): Remove standard value.
* menu-bar.el (menu-bar-mode): Ditto.
* cus-edit.el (customize-mark-to-save): Always save variables
without a standard value.
@@ -19112,7 +19111,7 @@
table information. Maybe report char-code-property-table info.
Maybe report character's unicode. Tweak printing of list info.
(list-input-methods): Add xref buttons.
- (dump-charsets, dump-codings): Deleted (obsolete).
+ (dump-charsets, dump-codings): Delete (obsolete).
From Dave Love <fx@gnu.org>.
2002-02-10 Pavel Janík <Pavel@Janik.cz>
@@ -19456,8 +19455,8 @@
(batch-byte-compile-if-not-done): New function.
* Makefile.in (compile): New target.
- (compile-always): Renamed from compile-files.
- (compile-after-backup): Renamed from compile.
+ (compile-always): Rename from compile-files.
+ (compile-after-backup): Rename from compile.
(bootstrap): Depend on compile-always, not compile-files.
* emulation/pc-select.el (pc-select-save-and-set-mode):
@@ -19770,7 +19769,7 @@
2002-01-16 Richard M. Stallman <rms@gnu.org>
- * mouse.el (mouse-drag-region-1): Renamed from mouse-drag-region,
+ * mouse.el (mouse-drag-region-1): Rename from mouse-drag-region,
more or less.
(mouse-drag-region): New function. For a click in the echo area,
show *Messages*.
@@ -19813,7 +19812,7 @@
(eudc-pre-select-window-configuration, eudc-insertion-marker):
Variables removed.
(eudc-insert-selected): Function removed.
- (eudc-select): Reimplemented.
+ (eudc-select): Reimplement.
(eudc-expand-inline): Delete the strings only after its expansion
is chosen not before.
@@ -20046,7 +20045,7 @@
* viper-util.el: Use viper-cond-compile-for-xemacs-or-emacs.
(viper-read-key-sequence, viper-set-unread-command-events)
- (viper-char-symbol-sequence-p, viper-char-array-p): Moved here.
+ (viper-char-symbol-sequence-p, viper-char-array-p): Move here.
* viper-ex.el: Use viper-cond-compile-for-xemacs-or-emacs.
@@ -20073,7 +20072,7 @@
(ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p)
(ediff-whitespace-diff-region-p, ediff-get-region-contents):
Move to ediff-util.el.
- (ediff-event-key): Moved here.
+ (ediff-event-key): Move here.
* ediff-merge.el: Got rid of unreferenced variables.
@@ -20092,7 +20091,7 @@
(ediff-unhighlight-diff, ediff-unhighlight-diffs-totally)
(ediff-empty-diff-region-p, ediff-whitespace-diff-region-p)
(ediff-get-region-contents, ediff-make-current-diff-overlay):
- Moved here.
+ Move here.
(ediff-format-bindings-of): New function by Hannu Koivisto
<azure@iki.fi>.
(ediff-setup): Make sure the merge buffer is always widened and
@@ -20117,7 +20116,7 @@
(ediff-regions-internal): Get rid of the warning about comparing
regions of the same buffer.
- * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): Moved here.
+ * ediff-diff.el (ediff-convert-fine-diffs-to-overlays): Move here.
Plus the following fixes courtesy of Dave Love: Doc fixes.
(ediff-word-1): Use word class and move - to the
front per regexp documentation.
@@ -20178,19 +20177,19 @@
2002-01-05 Andre Spiegel <spiegel@gnu.org>
* vc.el (vc-branch-part): Return nil if there's no `.'.
- (vc-default-previous-version): Renamed from vc-previous-version.
+ (vc-default-previous-version): Rename from vc-previous-version.
New args BACKEND and FILE. Return nil for revision numbers
without a `.'.
(vc-version-diff): Call vc-BACKEND-previous-version.
(vc-steal-lock): Steal lock before composing mail, so that no mail
is sent when the stealing goes wrong. And we'll actually see the
error in that case now.
- (vc-finish-steal): Removed.
+ (vc-finish-steal): Remove.
* vc-rcs.el (vc-rcs-steal-lock): Do a real checkout after stealing
the lock, so that we see expanded headers.
(vc-rcs-trunk-p, vc-rcs-branch-part, vc-rcs-branch-p)
- (vc-rcs-minor-part, vc-rcs-previous-version): Removed. These are
+ (vc-rcs-minor-part, vc-rcs-previous-version): Remove. These are
available from vc.el. Updated all callers.
2002-01-05 Richard M. Stallman <rms@gnu.org>
@@ -20236,7 +20235,7 @@
2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk>
- * custom.el (defcustom): Documented :tag, :link and :load.
+ * custom.el (defcustom): Document :tag, :link and :load.
2002-01-03 Eli Zaretskii <eliz@is.elta.co.il>
@@ -20322,7 +20321,7 @@
(xscheme-send-string-1): Call xscheme-insert-expression to save
expression in ring.
(xscheme-yank-previous-send): Now an alias for xscheme-yank.
- (xscheme-previous-send): Deleted variable.
+ (xscheme-previous-send): Delete variable.
(xscheme-send-string-2, xscheme-send-char, xscheme-send-proceed)
(xscheme-send-control-g-interrupt): Use process-send-string rather
@@ -20592,15 +20591,15 @@
* viper-cmd.el (viper-change-state): Got rid of make-local-hook.
(viper-special-read-and-insert-char): Make C-m work right in the r
command.
- (viper-buffer-search-enable): Fixed format string.
+ (viper-buffer-search-enable): Fix format string.
* viper-ex.el (ex-token-alist): Use ex-set-visited-file-name
instead of viper-info-on-file.
(ex-set-visited-file-name): New function.
- * viper.el (viper-emacs-state-mode-list): Added mail-mode.
+ * viper.el (viper-emacs-state-mode-list): Add mail-mode.
- * ediff-mult.el (ediff-meta-mark-equal-files): Added optional
+ * ediff-mult.el (ediff-meta-mark-equal-files): Add optional
action argument.
* ediff-init.el: Fixed some doc strings.
@@ -20627,7 +20626,7 @@
* emacs-lisp/elint.el (elint-unknown-builtin-args):
Remove mocklisp entries.
- * subr.el (insert-string): Moved from mocklisp.c, reimplemented in
+ * subr.el (insert-string): Move from mocklisp.c, reimplemented in
Lisp. Obsoleted.
* emulation/mlconvert.el: File removed.
@@ -20703,20 +20702,21 @@
2001-12-21 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: More sophisticated indentation of cpp directive.
+ * progmodes/antlr-mode.el: More sophisticated indentation
+ of cpp directive.
(antlr-indent-at-bol-alist): New user option.
(antlr-indent-line): Use it.
(antlr-indent-style): New user option.
(antlr-mode): Use it.
(antlr-indent-item-regexp): Customize.
- * antlr-mode.el: Syntax highlighting changes.
+ * progmodes/antlr-mode.el: Syntax highlighting changes.
(antlr-font-lock-literal-regexp): New user option.
(antlr-font-lock-syntax-face): New face used for :, |, ....
(antlr-font-lock-default-face): New face.
(antlr-font-lock-additional-keywords): Use them.
- * antlr-mode.el: New command to insert options -- variables.
+ * progmodes/antlr-mode.el: New command to insert options -- variables.
(antlr-mode-map): New binding [C-c C-o].
(antlr-mode-menu): New submenus.
(antlr-options-use-submenus): New user option.
@@ -20727,7 +20727,7 @@
(antlr-options-assign-string): New user option.
(antlr-options-headings): New variable.
- * antlr-mode.el: New command to insert options -- specific.
+ * progmodes/antlr-mode.el: New command to insert options -- specific.
(antlr-options-alists): New variable.
(antlr-read-value): New function.
(antlr-read-boolean): New function.
@@ -20737,7 +20737,7 @@
(antlr-grammar-tokens): New function.
(antlr-imenu-create-index-function): New optional argument.
- * antlr-mode.el: New command to insert options -- functions.
+ * progmodes/antlr-mode.el: New command to insert options -- functions.
(antlr-insert-option): New command.
(antlr-insert-option-interactive): New function.
(antlr-options-menu-filter): New function.
@@ -20755,7 +20755,7 @@
(antlr-insert-option-space): New function.
(antlr-insert-option-area): New function.
- * antlr-mode.el: New electric keys ":;|&(){}", TAB works better
+ * progmodes/antlr-mode.el: New electric keys ":;|&(){}", TAB works better
with narrowing. Menu change. Miscellaneous.
(antlr-mode-menu): Include "Indent Region" and "Customize Antlr".
(antlr-mode-map): New bindings for characters in ":;|&(){}".
@@ -20887,8 +20887,8 @@
(lm-crack-copyright): Cope with multi-line copyright `lines'.
* simple.el (newline): Doc fix.
- (eval-expression-print-level, eval-expression-print-length): Doc
- fix. Amend :type.
+ (eval-expression-print-level, eval-expression-print-length):
+ Doc fix. Amend :type.
(next-line, previous-line): Make arg optional.
(newline): Doc fix.
@@ -20914,10 +20914,10 @@
2001-12-16 Richard M. Stallman <rms@gnu.org>
- * dired.el (dired-copy-filename-as-kill): Moved from dired-x.el.
+ * dired.el (dired-copy-filename-as-kill): Move from dired-x.el.
(dired-mode-map): Bind w to dired-copy-filename-as-kill.
- * dired-x.el (dired-copy-filename-as-kill): Moved to dired.el.
+ * dired-x.el (dired-copy-filename-as-kill): Move to dired.el.
* autoinsert.el (auto-insert-alist): Redo finding C and C++ headers.
Add a DESCRIPTION for the makefile item.
@@ -20977,26 +20977,26 @@
2001-12-15 Richard M. Stallman <rms@gnu.org>
* language/ind-util.el (range): Function deleted.
- (indian-regexp-of-hashtbl-keys): Renamed from `regexp-of-hashtbl-keys'.
+ (indian-regexp-of-hashtbl-keys): Rename from `regexp-of-hashtbl-keys'.
All calls changed.
- * language/devan-util.el (devanagari-range): Renamed from `range'.
+ * language/devan-util.el (devanagari-range): Rename from `range'.
All calls changed.
(devanagari-regexp-of-hashtbl-keys):
- Renamed from `regexp-of-hashtbl-keys'. All calls changed.
+ Rename from `regexp-of-hashtbl-keys'. All calls changed.
2001-12-15 Dave Love <fx@gnu.org>
* language/ind-util.el: Don't require cl.
(indian-glyph-char, indian-glyph-max-char)
- (indian-char-glyph): Moved from indian.el.
+ (indian-char-glyph): Move from indian.el.
(indian--puthash-char, mapthread): Don't quote lambda.
(indian--map): New function.
(indian--puthash-v, indian--puthash-c, indian--puthash-m)
(indian--puthash-cv): Use it.
* language/indian.el (indian-glyph-char, indian-glyph-max-char)
- (indian-char-glyph): Moved to ind-util.el
+ (indian-char-glyph): Move to ind-util.el
* language/devan-util.el (devanagari-post-read-conversion):
New function.
@@ -21132,7 +21132,7 @@
* derived.el (derived-mode-p): Function moved to subr.el.
- * subr.el (derived-mode-p): Moved here from derived.el.
+ * subr.el (derived-mode-p): Move here from derived.el.
* international/mule.el (set-auto-coding): Use set-auto-mode-1.
@@ -21282,7 +21282,7 @@
2001-12-07 Miles Bader <miles@gnu.org>
* progmodes/compile.el (compilation-error-regexp-alist):
- Added regexps for RXP.
+ Add regexps for RXP.
2001-12-05 Eli Zaretskii <eliz@is.elta.co.il>
@@ -21792,7 +21792,7 @@
* menu-bar.el (menu-bar-apropos-menu): New variable.
Moved all `apropos' bindings to this menu.
- (menu-bar-help-menu): Added `menu-bar-apropos-menu'.
+ (menu-bar-help-menu): Add `menu-bar-apropos-menu'.
2001-11-24 KAWABATA, Taichi <batta@beige.ocn.ne.jp>
@@ -22048,7 +22048,7 @@
(browse-url-galeon, browse-url-galeon-sentinel): New functions.
(browse-url-default-browser): New function.
(browse-url-process-environment): Use browse-url-browser-display.
- (browse-url-browser-display): Renamed from browse-url-netscape-display.
+ (browse-url-browser-display): Rename from browse-url-netscape-display.
(browse-url-mozilla-startup-arguments, browse-url-galeon-program)
(browse-url-galeon-arguments, browse-url-galeon-startup-arguments)
(browse-url-mozilla-program, browse-url-mozilla-arguments): New vars.
@@ -22077,7 +22077,7 @@
(Math-integer-neg, Math-equal, Math-lessp, Math-primp)
(Math-num-integerp, Math-bignum-test, Math-equal-int)
(Math-natnum-lessp, math-format-radix-digit): Change to `defsubst'.
- (calc-record-compilation-date-macro): Deleted. Callers updated.
+ (calc-record-compilation-date-macro): Delete. Callers updated.
(math-format-radix-digit): Move to calc-bin.el.
* calc/calc.el (calc-record-compilation-date): Remove.
@@ -22092,25 +22092,29 @@
(calc-do-keypad): Use it.
(calc-keypad-map): Move into `calc-keypad-mode'.
- * calc-math.el (calcFunc-sqrt, calcFunc-hypot): Add missing quote
+ * calc/calc-math.el (calcFunc-sqrt, calcFunc-hypot): Add missing quote
to defalias argument.
- * calc-misc.el (math-fixnump, math-fixnatnump, calcFunc-trunc)
+ * calc/calc-misc.el (math-fixnump, math-fixnatnump, calcFunc-trunc)
(calcFunc-floor): Ditto.
- * calc-units.el (calcFunc-usimplify): Ditto.
-
- * calc-aent.el, calc-ext.el, calc-incom.el, calc-misc.el
- * calc-sel.el, calc-vec.el, calc-alg.el, calc-fin.el
- * calc-keypd.el, calc-mode.el, calc-stat.el, calc-yank.el
- * calc-arith.el, calc-forms.el, calc-lang.el, calc-mtx.el
- * calc-store.el, calc.el, calc-bin.el, calc-frac.el, calc-macs.el
- * calc-poly.el, calc-stuff.el, calcalg2.el, calc-comb.el
- * calc-funcs.el, calc-maint.el, calc-prog.el, calc-trail.el
- * calcalg3.el, calc-cplx.el, calc-graph.el, calc-map.el
- * calc-rewr.el, calc-undo.el, calccomp.el, calc-embed.el
- * calc-help.el, calc-math.el, calc-rules.el, calc-units.el
- * calcsel2.el: Change all toplevel `setq' forms to `defvar' forms,
+ * calc/calc-units.el (calcFunc-usimplify): Ditto.
+
+ * calc/calc-aent.el, calc/calc-ext.el, calc/calc-incom.el:
+ * calc/calc-misc.el, calc/calc-sel.el, calc/calc-vec.el:
+ * calc/calc-alg.el, calc/calc-fin.el, calc/calc-keypd.el:
+ * calc/calc-mode.el, calc/calc-stat.el, calc/calc-yank.el:
+ * calc/calc-arith.el, calc/calc-forms.el, calc/calc-lang.el:
+ * calc/calc-mtx.el, calc/calc-store.el, calc/calc.el:
+ * calc/calc-bin.el, calc/calc-frac.el, calc/calc-macs.el:
+ * calc/calc-poly.el, calc/calc-stuff.el, calc/calcalg2.el:
+ * calc/calc-comb.el, calc/calc-funcs.el, calc/calc-maint.el:
+ * calc/calc-prog.el, calc/calc-trail.el, calc/calcalg3.el:
+ * calc/calc-cplx.el, calc/calc-graph.el, calc/calc-map.el:
+ * calc/calc-rewr.el, calc/calc-undo.el, calc/calccomp.el:
+ * calc/calc-embed.el, calc/calc-help.el, calc/calc-math.el:
+ * calc/calc-rules.el, calc/calc-units.el, calc/calcsel2.el:
+ Change all toplevel `setq' forms to `defvar' forms,
and move them before their first use. Use `when', `unless'.
Remove trailing periods from error forms. Add description and
headers suggested by Emacs Lisp coding conventions.
@@ -22360,21 +22364,24 @@
* calc/calc-units.el (calcFunc-unsimplify): Ditto.
- * calc-aent.el, calc-ext.el, calc-incom.el, calc-misc.el
- * calc-sel.el, calc-vec.el, calc-alg.el, calc-fin.el
- * calc-keypd.el, calc-mode.el, calc-stat.el, calc-yank.el
- * calc-arith.el, calc-forms.el, calc-lang.el, calc-mtx.el
- * calc-store.el, calc.el, calc-bin.el, calc-frac.el, calc-macs.el
- * calc-poly.el, calc-stuff.el, calcalg2.el, calc-comb.el
- * calc-funcs.el, calc-maint.el, calc-prog.el, calc-trail.el
- * calcalg3.el, calc-cplx.el, calc-graph.el, calc-map.el
- * calc-rewr.el, calc-undo.el, calccomp.el, calc-embed.el
- * calc-help.el, calc-math.el, calc-rules.el, calc-units.el
- * calcsel2.el: Style cleanup; don't put closing parens on their
- own line, add "foo.el ends here" to each file, and update
- copyright date.
-
- * README: Update maintainer.
+ * calc/calc-aent.el, calc/calc-ext.el, calc/calc-incom.el:
+ * calc/calc-misc.el, calc/calc-sel.el, calc/calc-vec.el:
+ * calc/calc-alg.el, calc/calc-fin.el, calc/calc-keypd.el:
+ * calc/calc-mode.el, calc/calc-stat.el, calc/calc-yank.el:
+ * calc/calc-arith.el, calc/calc-forms.el, calc/calc-lang.el:
+ * calc/calc-mtx.el, calc/calc-store.el, calc/calc.el, calc/calc-bin.el:
+ * calc/calc-frac.el, calc/calc-macs.el, calc/calc-poly.el:
+ * calc/calc-stuff.el, calc/calcalg2.el, calc/calc-comb.el:
+ * calc/calc-funcs.el, calc/calc-maint.el, calc/calc-prog.el:
+ * calc/calc-trail.el, calc/calcalg3.el, calc/calc-cplx.el:
+ * calc/calc-graph.el, calc/calc-map.el, calc/calc-rewr.el:
+ * calc/calc-undo.el, calc/calccomp.el, calc/calc-embed.el:
+ * calc/calc-help.el, calc/calc-math.el, calc/calc-rules.el:
+ * calc/calc-units.el, calc/calcsel2.el: Style cleanup;
+ don't put closing parens on their own line,
+ add "foo.el ends here" to each file, and update copyright date.
+
+ * calc/README: Update maintainer.
2001-11-13 Richard M. Stallman <rms@gnu.org>
@@ -22516,7 +22523,7 @@
* calc/calc-keypd.el (toplevel): Bind mouse buttons.
(calc-do-keypad): Don't attempt to use nonexistent global
mouse-map, use calc-keypad-map.
- (calc-keypad-x-left-click): Renamed to calc-keypad-left-click.
+ (calc-keypad-x-left-click): Rename to calc-keypad-left-click.
(calc-keypad-left-click): Don't use mouse-map; update to new event
interface.
(calc-keypad-x-middle-click, calc-keypad-x-right-click): Ditto.
@@ -22625,7 +22632,7 @@
* textmodes/flyspell.el (flyspell-correct-word/local-keymap):
Function deleted.
(flyspell-correct-word): Old definition deleted.
- (flyspell-correct-word/mouse-keymap): Renamed to flyspell-correct-word.
+ (flyspell-correct-word/mouse-keymap): Rename to flyspell-correct-word.
All references renamed too.
2001-11-10 Gerd Moellmann <gerd@gnu.org>
@@ -22634,7 +22641,7 @@
2001-11-09 Per Abrahamsen <abraham@dina.kvl.dk>
- * wid-edit.el (checklist): Removed `:menu-tag'.
+ * wid-edit.el (checklist): Remove `:menu-tag'.
(radio-button-choice): Ditto.
(editable-list): Ditto.
@@ -23095,7 +23102,7 @@
2001-10-28 Per Abrahamsen <abraham@dina.kvl.dk>
- * cus-start.el (recursive-load-depth-limit): Added.
+ * cus-start.el (recursive-load-depth-limit): Add.
2001-10-28 Richard M. Stallman <rms@gnu.org>
@@ -23156,7 +23163,7 @@
* textmodes/texnfo-upd.el: Use `when', `dolist', `push', ...
(texinfo-update-node, texinfo-sequential-node-update):
Don't bind the obsolete `auto-fill-hook'.
- (texinfo-multi-file-included-list,texinfo-multi-file-master-menu-list):
+ (texinfo-multi-file-included-list, texinfo-multi-file-master-menu-list):
Use `set-buffer' rather than `switch-to-buffer'.
(texinfo-multi-file-update): Use "Top" rather than `up-node-name'.
Use `set-buffer' rather than `switch-to-buffer'.
@@ -23169,7 +23176,7 @@
2001-10-27 Sam Steingold <sds@gnu.org>
- * textmodes/sgml-mode.el (sgml-xml): Renamed from `html-xhtml'.
+ * textmodes/sgml-mode.el (sgml-xml): Rename from `html-xhtml'.
(sgml-xml-guess): Extracted from `html-mode' and generalized.
(sgml-mode-common): Call it.
(sgml-mode, html-mode): Set `mode-name' based on `sgml-xml'.
@@ -23362,10 +23369,10 @@
2001-10-24 Sam Steingold <sds@gnu.org>
- * mouse.el (mouse-buffer-menu-mode-groups): Added "Version
+ * mouse.el (mouse-buffer-menu-mode-groups): Add "Version
Control" and "SGML" groups.
-2001-10-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2001-10-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-beginning-of-member-init-list):
Better handling of C++ template args to avoid confusion with `<'
@@ -23448,25 +23455,25 @@
* vc.el (vc-annotate-display-default): Accept colormap scaling
ratio (now deprecated).
- (vc-annotate-display-autoscale): Added.
+ (vc-annotate-display-autoscale): Add.
(vc-annotate-add-menu): New autoscaling menu options "Span to
Oldest" and "Span Oldest->Newest". Easymenu support added for
toggle menus driven by customize variable `vc-annotate-display-mode'.
- (vc-annotate-display-select): Added.
- (vc-annotate): Changed temp-buffer-show-function to
+ (vc-annotate-display-select): Add.
+ (vc-annotate): Change temp-buffer-show-function to
`vc-annotate-display-select'.
- (vc-annotate-display): Removed arguments BUFFER and BACKEND.
+ (vc-annotate-display): Remove arguments BUFFER and BACKEND.
Added argument OFFSET. Instead of backend function, calls now
generic `vc-annotate-difference'.
- (vc-annotate-difference): Added as generic function instead of
+ (vc-annotate-difference): Add as generic function instead of
backend-specific function. No longer takes argument POINT, but
instead accepts a time OFFSET.
- (vc-default-annotate-current-time): Added.
+ (vc-default-annotate-current-time): Add.
- * vc-cvs.el (vc-cvs-annotate-difference): Removed to generic
+ * vc-cvs.el (vc-cvs-annotate-difference): Remove to generic
version in vc.el.
- (vc-cvs-annotate-current-time): Added, as override of default.
- (vc-cvs-annotate-time): Added. Taken mostly from the (now removed)
+ (vc-cvs-annotate-current-time): Add, as override of default.
+ (vc-cvs-annotate-time): Add. Taken mostly from the (now removed)
`vc-cvs-annotate-difference'.
2001-10-22 Gerd Moellmann <gerd@gnu.org>
@@ -23534,7 +23541,7 @@ See ChangeLog.9 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index 4bd688b9224..b3cdfa034e2 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -40,8 +40,8 @@
* progmodes/fortran.el (fortran-mode): Use mode-require-final-newline.
* progmodes/f90.el (f90-mode): Use mode-require-final-newline.
* progmodes/cperl-mode.el (cperl-mode): Use mode-require-final-newline.
- * progmodes/cfengine.el (cfengine-mode): Use
- mode-require-final-newline.
+ * progmodes/cfengine.el (cfengine-mode):
+ Use mode-require-final-newline.
* progmodes/ada-mode.el (ada-mode): Use mode-require-final-newline.
* textmodes/text-mode.el (text-mode): Use mode-require-final-newline.
* textmodes/texinfo.el (texinfo-mode): Use mode-require-final-newline.
@@ -438,8 +438,8 @@
* net/tramp-smb.el (tramp-smb-advice-PC-do-completion): Make the
advice less fragile. Surround temporary redefinition of
- `substitute-in-file-name' with `unwind-protect'. Suggested by
- Matt Hodges <MPHodges@member.fsf.org>.
+ `substitute-in-file-name' with `unwind-protect'.
+ Suggested by Matt Hodges <MPHodges@member.fsf.org>.
2004-12-17 Juri Linkov <juri@jurta.org>
@@ -1293,9 +1293,9 @@
2004-11-26 Jay Belanger <belanger@truman.edu>
- * calc-misc.el (calc-last-why-command): Declare it.
+ * calc/calc-misc.el (calc-last-why-command): Declare it.
- * calc-vec.el (math-grade-vec): New variable.
+ * calc/calc-vec.el (math-grade-vec): New variable.
(calcFunc-grade, calcFunc-rgrade, math-grade-beforep):
Replace variable grade-vec by declared variable.
(math-rb-close): New variable.
@@ -1424,7 +1424,8 @@
2004-11-26 Lars Hansen <larsh@math.ku.dk>
- * tramp.el (tramp-handle-directory-files-and-attributes): New function.
+ * net/tramp.el (tramp-handle-directory-files-and-attributes):
+ New function.
(tramp-perl-directory-files-and-attributes): New constant.
(tramp-file-name-handler-alist): Delete file-directory-files, add
directory-files-and-attributes.
@@ -1607,9 +1608,9 @@
2004-11-24 Jay Belanger <belanger@truman.edu>
- * calc/calc.el (calc-embedded-active): Removed unnecessary
+ * calc/calc.el (calc-embedded-active): Remove unnecessary
declaration.
- (calc-show-banner): Removed redundant declaration.
+ (calc-show-banner): Remove redundant declaration.
* calc/calc-graph.el (calc-gnuplot-default-device)
(calc-gnuplot-default-output, calc-gnuplot-print-device)
@@ -1661,7 +1662,7 @@
(math-nri-n): New variable.
(math-nth-root-integer, math-nth-root-int-iter): Replace variable
n by declared variable.
- (calcFunc-log): Removed misplaced condition.
+ (calcFunc-log): Remove misplaced condition.
2004-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -2482,7 +2483,7 @@
string to kill-ring.
* calc/calc-aent.el (calc-alg-exp, math-toks)
- (math-exp-pos,math-exp-old-pos, math-exp-token)
+ (math-exp-pos, math-exp-old-pos, math-exp-token)
(math-exp-keep-spaces, math-exp-str): New variables.
(calc-do-alg-entry, calcAlg-equals, calcAlg-edit)
(calcAlg-enter): Use declared variable calc-alg-exp.
@@ -3141,7 +3142,7 @@
* subr.el (read-passwd): Move back from password.el.
- * password.el: Remove, not ready yet.
+ * net/password.el: Remove, not ready yet.
2004-10-29 Andreas Schwab <schwab@suse.de>
@@ -3286,7 +3287,7 @@
2004-10-26 Jay Belanger <belanger@truman.edu>
- * calc/calc.el (calc,full-calc, calc-quit, calc-keypad)
+ * calc/calc.el (calc, full-calc, calc-quit, calc-keypad)
(full-calc-keypad, calc-trail-display): Use an extra argument
instead of `interactive-p'.
@@ -3365,8 +3366,8 @@
2004-10-24 Kai Grossjohann <kai.grossjohann@gmx.net>
- * simple.el (process-file): Accept nil for INFILE. Reported by
- Luc Teirlinck.
+ * simple.el (process-file): Accept nil for INFILE.
+ Reported by Luc Teirlinck.
2004-10-24 Masatake YAMATO <jet@gyve.org>
@@ -3968,7 +3969,7 @@
* indent.el (set-left-margin, set-right-margin): Rename `lm' arg
to `width' for consistency with docstring. Doc fix.
-2004-10-01 Martin Stjernholm <bug-cc-mode@gnu.org>
+2004-10-01 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el: Load cl here since cc-defs doesn't do it.
This is necessary for derived modes.
@@ -4329,8 +4330,8 @@
(calc-mode): Compare `calc-settings-file' to `user-init-file' rather
than "\\.emacs" to determine if it is the user-init-file.
- * calc/calc-embed.el (calc-embedded-set-modes): Use
- `calc-mode-var-list' correctly.
+ * calc/calc-embed.el (calc-embedded-set-modes):
+ Use `calc-mode-var-list' correctly.
2004-09-15 Thien-Thi Nguyen <ttn@gnu.org>
@@ -5098,7 +5099,7 @@
(isearch-*-char, isearch-|-char): Now just call `isearch-fallback'
appropriately.
(isearch-mode-map): Bind `}' to `isearch-}-char'.
- (isearch-string, isearch-message,string, isearch-point)
+ (isearch-string, isearch-message-string, isearch-point)
(isearch-success, isearch-forward-flag, isearch-other-end)
(isearch-word, isearch-invalid-regexp, isearch-wrapped)
(isearch-barrier, isearch-within-brackets, isearch-case-fold-search):
@@ -5128,7 +5129,7 @@
(speedbar-directory): New image (unused pixmap already existed).
(speedbar-expand-image-button-alist): Use it.
-2004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org>
+2004-08-11 Martin Stjernholm <mast@lysator.liu.se>
CC Mode update to 5.30.9:
@@ -5211,7 +5212,7 @@
Fix bug that could cause an error from `after-change-functions' when
the changed region is at bob.
-2004-08-11 Alan Mackenzie <bug-cc-mode@gnu.org>
+2004-08-11 Alan Mackenzie <acm@muc.de>
CC Mode update to 5.30.9:
@@ -5502,8 +5503,8 @@
since Emacs 22.1 only (XEmacs has it). Implementation rewritten
in order to avoid this function.
(tramp-handle-write-region): Set current buffer. If connection
- wasn't open, `file-modes' has changed it accidentally. Reported by
- David Kastrup <dak@gnu.org>.
+ wasn't open, `file-modes' has changed it accidentally.
+ Reported by David Kastrup <dak@gnu.org>.
(tramp-enter-password, tramp-read-passwd): New arguments USER and
HOST.
(tramp-action-password, tramp-multi-action-password): Apply it.
@@ -6641,7 +6642,7 @@
2004-05-29 Pavel Kobiakov <pk_at_work@yahoo.com>
- * flymake.el: New file.
+ * progmodes/flymake.el: New file.
2004-05-28 Luc Teirlinck <teirllm@auburn.edu>
@@ -6730,17 +6731,6 @@
* mail/smtpmail.el (smtpmail-open-stream):
Bind starttls-extra-arguments too, if starttls.el uses GnuTLS.
-2004-05-26 Simon Josefsson <jas@extundo.com>
-
- * starttls.el: Merge with my GnuTLS based starttls.el.
- (starttls-gnutls-program, starttls-use-gnutls)
- (starttls-extra-arguments, starttls-process-connection-type)
- (starttls-connect, starttls-failure, starttls-success): New variables.
- (starttls-program, starttls-extra-args): Doc fix.
- (starttls-negotiate-gnutls, starttls-open-stream-gnutls): New funs.
- (starttls-negotiate, starttls-open-stream): Check `starttls-use-gnutls'
- and pass on to corresponding *-gnutls function if it is set.
-
2004-05-27 Luc Teirlinck <teirllm@auburn.edu>
* autorevert.el (auto-revert-handler): Disable auto-reverting of
@@ -8081,8 +8071,6 @@
* mail/rmail.el (rmail-variables): Bind desktop-save-buffer to t.
- * mh-e/mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t.
-
2004-04-26 Eli Zaretskii <eliz@gnu.org>
* progmodes/gud.el (gud-pdb-command-name): Change default to "pydb".
@@ -8228,7 +8216,6 @@
2004-04-22 Lars Hansen <larsh@math.ku.dk>
* info.el (Info-restore-desktop-buffer): Delete with-no-warnings.
- * mh-e/mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings.
2004-04-22 Kim F. Storm <storm@cua.dk>
@@ -8339,9 +8326,6 @@
* mail/rmail.el (rmail-restore-desktop-buffer): Move from desktop.el.
Add Parameters.
- * mh-e/mh-e.el (mh-restore-desktop-buffer): Move from desktop.el.
- Add Parameters.
-
2003-04-21 Paul Pogonyshev <pogonyshev@gmx.net>
* dabbrev.el (dabbrev--substitute-expansion): Don't lose
@@ -8548,8 +8532,8 @@
2004-04-16 Dave Love <fx@gnu.org>
- * progmodes/python.el (python-compilation-line-number): Fix
- braindamage.
+ * progmodes/python.el (python-compilation-line-number):
+ Fix braindamage.
(python-load-file): Fix python-orig-start setting.
* progmodes/compile.el: Doc fixes.
@@ -9498,8 +9482,8 @@
2004-03-22 Luc Teirlinck <teirllm@auburn.edu>
- * autorevert.el (global-auto-revert-non-file-buffers): Expand
- docstring.
+ * autorevert.el (global-auto-revert-non-file-buffers):
+ Expand docstring.
(buffer-stale-function): New variable.
(auto-revert-list-diff, auto-revert-dired-file-list)
(auto-revert-dired-changed-p, auto-revert-buffer-p): Delete.
@@ -10246,8 +10230,8 @@
* progmodes/ebnf-abn.el: New file, implements an ABNF parser.
- * progmodes/ebnf2ps.el: Doc fix. Accept ABNF (Augmented BNF). New
- arrow shapes: semi-up-hollow, semi-up-full, semi-down-hollow and
+ * progmodes/ebnf2ps.el: Doc fix. Accept ABNF (Augmented BNF).
+ New arrow shapes: semi-up-hollow, semi-up-full, semi-down-hollow and
semi-down-full. Fix a bug on productions like test = {"test"}* | (
"tt" ["test"] ). Reported by Markus Dreyer
<mdreyer@ix.urz.uni-heidelberg.de>.
@@ -10584,7 +10568,7 @@
(ses-mode-map): Use them.
(ses-read-number) New fun. Duplicates code from interactive "N" spec.
-2004-02-14 Martin Stjernholm <bug-cc-mode@gnu.org>
+2004-02-14 Martin Stjernholm <mast@lysator.liu.se>
* Makefile.in: Fix the CC Mode recompile kludge so it works
when building in a different directory.
@@ -10658,7 +10642,7 @@
* tar-mode.el (tar-extract): Fix for the case that a file doesn't
have end-of-line.
-2004-02-09 Martin Stjernholm <bug-cc-mode@gnu.org>
+2004-02-09 Martin Stjernholm <mast@lysator.liu.se>
* Makefile.in: Added extra dependencies in the recompile target
needed to cope with the compile time macro expansions in CC Mode.
@@ -11050,8 +11034,8 @@
2004-01-21 Jan Djärv <jan.h.d@swipnet.se>
- * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): Call
- menu-bar-enable-clipboard and make Paste use clipboard first.
+ * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu):
+ Call menu-bar-enable-clipboard and make Paste use clipboard first.
2004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -11331,7 +11315,7 @@
* emacs-lisp/shadow.el (shadow-same-file-or-nonexistent):
* man.el (Man-init-defvars):
* jka-compr.el (jka-compr-call-process):
- * files.el (get-free-disk-space,insert-directory):
+ * files.el (get-free-disk-space, insert-directory):
* ediff-ptch.el (ediff-test-patch-utility):
* ediff-diff.el (ediff-test-utility):
* dired-aux.el (dired-check-process):
@@ -11730,8 +11714,8 @@
2003-11-30 Kai Grossjohann <kai.grossjohann@gmx.net>
Version 2.0.38 of Tramp released.
- * net/tramp.el (tramp-chunksize): Extend docstring. Suggested by
- Charles Curley <charlescurley@charlescurley.com>.
+ * net/tramp.el (tramp-chunksize): Extend docstring.
+ Suggested by Charles Curley <charlescurley@charlescurley.com>.
(tramp-multi-connection-function-alist): Add ssht entry which adds
"-e none -t -t" to the list of ssh args. Suggested by Adrian
Aichner.
@@ -11846,7 +11830,7 @@
2003-11-25 Stephen Eglen <stephen@gnu.org>
- * iswitchb.el (iswitchb-read-buffer,iswitchb-exit-minibuffer):
+ * iswitchb.el (iswitchb-read-buffer, iswitchb-exit-minibuffer):
iswitchb-exit is set to 'usefirst when user selects buffer at head
of list using RET. (Selecting buffers at the head of the list was
broken if the substring was also a complete buffer name.)
@@ -11948,9 +11932,9 @@
by returning the original value of 8 in all cases, but 99% of the
time this is a waste of whitespace).
-2003-11-16 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-11-16 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-guess-continued-construct)
+ * progmodes/cc-engine.el (c-guess-continued-construct)
(c-guess-basic-syntax): Check a little more carefully if it's a
function declaration when an unknown construct followed by a block
is found inside a statement context. This avoids macros followed
@@ -11964,7 +11948,8 @@
start is in a position so that `c-beginning-of-statement-1' jumped
to the beginning of the same statement.
- * cc-fonts.el, cc-engine.el (c-forward-<>-arglist-recur):
+ * progmodes/cc-fonts.el, progmodes/cc-engine.el
+ (c-forward-<>-arglist-recur):
Don't accept binary operators in the arglist if we're in a function
call context, i.e. if `c-restricted-<>-arglists' is set. That avoids
template recognition in cases like "if (a < b || c > d)".
@@ -11974,38 +11959,39 @@
Accessing functions updated for the variable name change.
- * cc-engine.el (c-syntactic-re-search-forward): Fix bug where the
- match data could get clobbered if NOT-INSIDE-TOKEN is used.
+ * progmodes/cc-engine.el (c-syntactic-re-search-forward): Fix bug
+ where the match data could get clobbered if NOT-INSIDE-TOKEN is used.
- * cc-engine.el (c-beginning-of-statement-1): Don't allow parens in
- labels.
+ * progmodes/cc-engine.el (c-beginning-of-statement-1):
+ Don't allow parens in labels.
(c-backward-to-decl-anchor): Use `c-beginning-of-statement-1'
instead of duplicating parts of it. This fixes bogus label
recognition.
- * cc-align.el (c-gnu-impose-minimum): Revert to the old method
+ * progmodes/cc-align.el (c-gnu-impose-minimum): Revert to the old method
of checking the context in which to apply the minimum indentation,
so that it isn't enforced in e.g. namespace blocks.
- * cc-vars.el (c-inside-block-syms): New constant used by
+ * progmodes/cc-vars.el (c-inside-block-syms): New constant used by
`c-gnu-impose-minimum'. It's defined close to `c-offsets-alist'
to somewhat reduce the risk of becoming stale.
- * cc-cmds.el, cc-engine.el (c-shift-line-indentation): Move from
- cc-cmds to cc-engine to allow use from cc-align.
+ * progmodes/cc-cmds.el, progmodes/cc-engine.el
+ (c-shift-line-indentation): Move from cc-cmds to cc-engine
+ to allow use from cc-align.
- * cc-engine.el (c-beginning-of-inheritance-list): Cope with fully
- qualified identifiers containing "::".
+ * progmodes/cc-engine.el (c-beginning-of-inheritance-list):
+ Cope with fully qualified identifiers containing "::".
- * cc-defs.el (c-make-keywords-re): Add kludge for bug in
+ * progmodes/cc-defs.el (c-make-keywords-re): Add kludge for bug in
`regexp-opt' in Emacs 20 and XEmacs when strings contain newlines.
- * cc-vars.el (c-emacs-features): Use a space in front of the name
- of the temporary buffer. That also avoids dumping problems in
+ * progmodes/cc-vars.el (c-emacs-features): Use a space in front of
+ the name of the temporary buffer. That also avoids dumping problems in
XEmacs due to undo info being left around after the buffer is killed.
- * cc-engine.el (c-in-knr-argdecl): Look closer at the function
+ * progmodes/cc-engine.el (c-in-knr-argdecl): Look closer at the function
arglist to see if it's a K&R style declaration.
(c-guess-basic-syntax): CASE 5B.2: Check with `c-in-knr-argdecl'
@@ -12399,8 +12385,8 @@
(ediff-select-difference): Set current difference.
(ediff-unselect-and-select-difference): Add comment.
- * ediff.el (ediff-directories,ediff-directory-revisions)
- (ediff-directories3,ediff-merge-directories)
+ * ediff.el (ediff-directories, ediff-directory-revisions)
+ (ediff-directories3, ediff-merge-directories)
(ediff-merge-directories-with-ancestor)
(ediff-merge-directory-revisions)
(ediff-merge-directory-revisions-with-ancestor):
@@ -12532,9 +12518,9 @@
* gdb-ui.el (gdb-var-list, gdb-var-changed, gdb-update-flag)
(gdb-update-flag): New variables.
- (gdb-var-update, gdb-var-update-handler,gdb-var-delete)
+ (gdb-var-update, gdb-var-update-handler, gdb-var-delete)
(gdb-speedbar-expand-node, gdb-var-evaluate-expression-handler)
- (gud-watch, gdb-var-create-handler) : New functions.
+ (gud-watch, gdb-var-create-handler): New functions.
(gdb-var-list-children, gdb-var-list-children-handler)
(gdb-var-create-regexp, gdb-var-update-regexp)
(gdb-var-list-children-regexp): New constants.
@@ -12551,9 +12537,9 @@
(gdb-array-size, gdb-display-mode-map, gdb-expressions-mode-map):
(gdb-expressions-mode-menu, gdb-dive): Remove variables.
(gud-display, gud-display1)
- (gdb-display-begin,gdb-display-number-end, gdb-delete-line)
+ (gdb-display-begin, gdb-display-number-end, gdb-delete-line)
(gdb-display-end, gdb-display-go-back, gdb-array-section-end)
- (gdb-field-begin, gdb-field-end, gdb-elt,gdb-field-format-begin)
+ (gdb-field-begin, gdb-field-end, gdb-elt, gdb-field-format-begin)
(gdb-field-format-end, gdb-dive, gdb-dive-new-frame)
(gdb-insert-field, gdb-array-format, gdb-mouse-array-slice)
(gdb-array-slice, gdb-array-format1, gdb-info-display-custom)
@@ -12710,13 +12696,13 @@
* window.el (window-current-scroll-bars): New defun.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-parse-state): Fix bug that could
cause errors when the state cache contains info on parts that have
been narrowed out.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-vars.el (c-comment-prefix-regexp): Document that
`c-setup-paragraph-variables' has to be used when this variable is
@@ -12726,7 +12712,7 @@
* progmodes/cc-styles.el (c-setup-paragraph-variables):
Make it interactive.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-font-lock-declarations):
Fix recognition of constructors and destructors for classes whose
@@ -12735,14 +12721,14 @@
* progmodes/cc-langs.el (c-type-list-kwds): If "operator" is
followed by an identifier in C++ then it's a type.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-font-lock-invalid-string): Fix eob
problem that primarily affected XEmacs. Don't use faces to find
unterminated strings since Emacs and XEmacs fontify strings
differently - this function should now work better in XEmacs.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace): Fix a bug in the
`expand-abbrev' workaround which caused braces to misbehave inside
@@ -12751,7 +12737,7 @@
* progmodes/cc-engine.el (c-forward-keyword-clause): Fix error
handling. This bug could cause interactive font locking to bail out.
-2003-09-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-09-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-just-after-func-arglist-p):
Handle paren-style types in Pike. Also fixed some cases of
@@ -12949,7 +12935,7 @@
2003-09-08 David Ponce <david@dponce.com>
Ensure that recentf correctly updates the menu bar.
- * recentf.el (recentf-menu-path,recentf-menu-before): Doc fix.
+ * recentf.el (recentf-menu-path, recentf-menu-before): Doc fix.
(recentf-menu-bar): New function.
(recentf-clear-data): Use it.
(recentf-update-menu): Likewise. Use easy-menu-add-item instead
@@ -12980,7 +12966,7 @@
* gdb-ui.el (gud-display1): Use gud-call to prevent extra prompt
being displayed in GUD buffer.
(gdb-idle-input-queue): Remove var. Use just one queue.
- (gdb-enqueue-idle-input,gdb-dequeue-idle-input):
+ (gdb-enqueue-idle-input, gdb-dequeue-idle-input):
Remove functions. Use just one queue.
(gdb-prompt, gdb-subprompt, def-gdb-auto-update-trigger)
(gdb-invalidate-assembler, gdb-get-current-frame):
@@ -13103,10 +13089,10 @@
2003-08-29 Thierry Emery <thierry.emery@club-internet.fr> (tiny change)
- * kinsoku.el (kinsoku-longer, kinsoku-shorter): Do not choose a
- line break position in the middle of a non-kinsoku (e.g. latin)
- word, making it skip until either a space or a character with
- category "|".
+ * international/kinsoku.el (kinsoku-longer, kinsoku-shorter):
+ Do not choose a line break position in the middle of a
+ non-kinsoku (e.g. latin) word, making it skip until either
+ a space or a character with category "|".
(kinsoku-longer): Test for end of buffer.
2003-08-28 Eli Zaretskii <eliz@gnu.org>
@@ -13127,13 +13113,13 @@
* image.el (image-jpeg-p): Don't search beyond length of data.
-2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-08-26 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace): Work around for a
misfeature in `expand-abbrev' which caused electric keywords like
"else" to disappear if an open brace was typed directly afterwards.
-2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-08-26 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-vars.el (c-extra-types-widget): The doc string is
mandatory in `define-widget'.
@@ -13146,7 +13132,7 @@
(c-assignment-op-regexp): New language var used by `c-lineup-math'.
-2003-08-26 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-08-26 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-just-after-func-arglist-p):
Safeguard against unbalanced sexps.
@@ -13476,27 +13462,27 @@
2003-08-11 Carsten Dominik <dominik@sand.science.uva.nl>
- * reftex-toc.el (reftex-toc-rename-label): New function.
+ * textmodes/reftex-toc.el (reftex-toc-rename-label): New function.
(reftex-toc-check-docstruct): New function.
- * reftex.el (reftex-region-active-p): New function.
+ * textmodes/reftex.el (reftex-region-active-p): New function.
- * reftex-parse.el (reftex-locate-bibliography-files): Improved the
+ * textmodes/reftex-parse.el (reftex-locate-bibliography-files): Improve the
regexp to find the \bibliography macro.
- * reftex-vars.el (reftex-section-levels): Removed subsubparagraph,
+ * textmodes/reftex-vars.el (reftex-section-levels): Remove subsubparagraph,
which does not exist in LaTeX.
- (reftex-cite-format-builtin): Added amsrefs support.
+ (reftex-cite-format-builtin): Add amsrefs support.
(reftex-toc-confirm-promotion): New option
- * reftex-toc.el
+ * textmodes/reftex-toc.el
(reftex-toc): Use `reftex-toc-split-windows-fraction'.
(reftex-toc-demote, reftex-toc-promote)
(reftex-toc-do-promote, reftex-toc-promote-prepare)
(reftex-toc-promote-action, reftex-toc-extract-section-number)
(reftex-toc-newhead-from-alist)
(reftex-toc-load-all-files-for-promotion): New functions.
- (reftex-toc-help): Added description of new keys.
+ (reftex-toc-help): Add description of new keys.
(reftex-toc-split-windows-fraction): New option.
(reftex-recenter-toc-when-idle): Search *toc* window on all
visible frames.
@@ -13512,9 +13498,8 @@
(reftex-toc-quit): Adapted to delete frame when called in
dedicated frame.
- * reftex-index.el (reftex-index-phrase-match-is-indexed): Check
- all enclosing macros.
-
+ * textmodes/reftex-index.el (reftex-index-phrase-match-is-indexed):
+ Check all enclosing macros.
2003-08-08 Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -13628,12 +13613,12 @@
* calendar/cal-tex.el (cal-tex-day-name-format): Doc fix.
(cal-tex-LaTeX-hourbox): Move definition before use.
- * calendar/cal-china.el, cal-hebrew.el, cal-islam.el
- * cal-julian.el, cal-menu.el, cal-move.el, holidays.el
- * lunar.el, solar.el (displayed-month, displayed-year):
- Define for compiler.
+ * calendar/cal-china.el, calendar/cal-hebrew.el, calendar/cal-islam.el:
+ * calendar/cal-julian.el, calendar/cal-menu.el, calendar/cal-move.el:
+ * calendar/holidays.el, calendar/lunar.el, calendar/solar.el:
+ (displayed-month, displayed-year): Define for compiler.
-2003-08-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-08-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el (c-init-language-vars-for): Add argument
MODE. Renamed from c-init-c-language-vars'.
@@ -13647,7 +13632,7 @@
(pike-mode): Ditto.
(awk-mode): Ditto.
-2003-08-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-08-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-end-of-current-token): Return whether
or not the point moved.
@@ -13865,7 +13850,7 @@
* simple.el (current-word): Don't include punctuation char when
`really-word' arg is non-nil.
-2003-07-17 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-17 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/awk-mode.el: Obsoleted by the AWK support in CC Mode -
moved to the directory obsolete.
@@ -13880,12 +13865,12 @@
(syntax-ppss-after-change-function): New alias. Update uses.
(syntax-ppss): Catch the case where the buffer is narrowed.
-2003-07-16 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-16 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-defs.el (c-langelem-sym, c-langelem-pos)
(c-langelem-2nd-pos): Add accessor functions for syntactic elements.
-2003-07-16 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-16 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-literal-faces): Declare as a variable
since it might be modified.
@@ -13979,8 +13964,8 @@
2003-07-10 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * ps-print.el: Print line number correctly in a region. Reported by
- Tim Allen <timallen@ls83.fsnet.co.uk>.
+ * ps-print.el: Print line number correctly in a region.
+ Reported by Tim Allen <timallen@ls83.fsnet.co.uk>.
(ps-print-version): New version number (6.6.2).
(ps-printing-region): Code fix.
@@ -14019,24 +14004,24 @@
* dired.el (dired-move-to-filename-regexp): Allow quote in months.
-2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-guess-basic-syntax): Do not do hidden
buffer changes; there's third party code that calls this function
directly.
-2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (javadoc-font-lock-keywords)
(autodoc-font-lock-keywords): Don't byte compile on font lock
initialization when running from byte compiled files.
-2003-07-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2003-07-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-engine.el: Fix AWK mode indentation when previous
statement ends with auto-increment "++".
-2003-07-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el, progmodes/cc-styles.el (c-style-alist)
(c-lang-variable-inits, c-lang-variable-inits-tail): The values of
@@ -14125,13 +14110,13 @@
* info.el (Info-menu-entry-name-re): Add `:' to second [] part.
This should fix the infinite loop when extracting menu names.
-2003-07-05 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-05 Martin Stjernholm <mast@lysator.liu.se>
* files.el (auto-mode-alist, interpreter-mode-alist):
Remove entries to CC Mode modes to avoid duplicates; they are now added
with autoload directives in cc-mode.el.
-2003-07-05 Martin Stjernholm <bug-cc-mode@gnu.org>
+2003-07-05 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el, progmodes/cc-styles.el (c-style-alist)
(c-lang-variable-inits, c-lang-variable-inits-tail): The values of
@@ -14336,7 +14321,7 @@ See ChangeLog.10 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2003-2011, 2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2011, 2013-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index 6b34ef55783..968658cb69c 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -932,7 +932,7 @@
* international/quail.el (quail-setup-completion-buf): Make the
completion buffer read-only.
- (quail-completion): Adjusted for the above change. Leave the
+ (quail-completion): Adjust for the above change. Leave the
modified flag nil.
2007-03-20 David Kastrup <dak@gnu.org>
@@ -1092,9 +1092,9 @@
North American rule. Replace "daylight savings" with "daylight
saving" in doc.
- * calendar/cal-china.el, cal-dst.el, calendar.el, diary-lib.el:
- * calendar/lunar.el, solar.el: Replace "daylight savings" with
- "daylight saving" in text.
+ * calendar/cal-china.el, calendar/cal-dst.el, calendar/calendar.el:
+ * calendar/diary-lib.el, calendar/lunar.el, calendar/solar.el:
+ Replace "daylight savings" with "daylight saving" in text.
* woman.el (woman-change-fonts): Tweak previous change by using
woman-request-regexp rather than "^\\.".
@@ -2371,8 +2371,8 @@
2007-01-27 Eli Zaretskii <eliz@gnu.org>
* ls-lisp.el (ls-lisp-use-localized-time-format): New defcustom.
- (ls-lisp-format-time-list): Doc fix. Mention
- ls-lisp-use-localized-time-format.
+ (ls-lisp-format-time-list): Doc fix.
+ Mention ls-lisp-use-localized-time-format.
(ls-lisp-format-time): Use ls-lisp-format-time-list if
ls-lisp-use-localized-time-format is non-nil, even if a valid
locale is defined.
@@ -3410,8 +3410,8 @@
* wdired.el (wdired-change-to-wdired-mode, wdired-finish-edit)
(wdired-search-and-rename): Simplify code.
- (wdired-preprocess-files, wdired-preprocess-perms): Make
- read-only property of preceding character rear-nonsticky to
+ (wdired-preprocess-files, wdired-preprocess-perms):
+ Make read-only property of preceding character rear-nonsticky to
avoid that it can be modified. Put old-name and old-link
properties on character preceding name and replace
put-text-property by add-text-properties.
@@ -3560,8 +3560,8 @@
2006-12-04 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-methods): Add "ControlPath" and
- "ControlMaster" to scp, scp1 and scp2 methods. Suggested by
- Andreas Schwab <schwab@suse.de>.
+ "ControlMaster" to scp, scp1 and scp2 methods.
+ Suggested by Andreas Schwab <schwab@suse.de>.
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-open-connection-rsh): Compute format spec for ?t.
(tramp-process-actions): Trace command parameters.
@@ -5113,7 +5113,7 @@
* version.el (emacs-version): Use mac-carbon-version-string.
- * term/macterm.el (res-geometry): Apply 2006-10-18 change for x-win.el.
+ * term/mac-win.el (res-geometry): Apply 2006-10-18 change for x-win.el.
2006-10-19 Jan Djärv <jan.h.d@swipnet.se>
@@ -6782,9 +6782,9 @@
* mail/feedmail.el (feedmail-buffer-to-sendmail): Look for
sendmail in several common directories.
- * mail/sendmail.el (sendmail-program): Moved here from paths.el.
+ * mail/sendmail.el (sendmail-program): Move here from paths.el.
- * paths.el (sendmail-program): Removed.
+ * paths.el (sendmail-program): Remove.
2006-09-04 Daiki Ueno <ueno@unixuser.org>
@@ -6822,8 +6822,8 @@
* net/rcirc.el (rcirc-keywords): New variable.
(rcirc-bright-nicks, rcirc-dim-nicks): New variables.
- (rcirc-bright-nick-regexp, rcirc-dim-nick-regexp): Remove
- variables.
+ (rcirc-bright-nick-regexp, rcirc-dim-nick-regexp):
+ Remove variables.
(rcirc-responses-no-activity): New function.
(rcirc-handler-generic): Check for responses in above.
(rcirc-process-command): Add ?: character to arguments of raw
@@ -6870,8 +6870,8 @@
2006-08-31 Richard Stallman <rms@gnu.org>
* cus-edit.el (custom-save-variables): Slight cleanup.
- (Custom-no-edit): Renamed from custom-no-edit.
- (Custom-newline): Renamed from custom-newline.
+ (Custom-no-edit): Rename from custom-no-edit.
+ (Custom-newline): Rename from custom-newline.
(custom-mode-map): Use new names.
* emacs-lisp/easy-mmode.el (define-minor-mode): Reference manual
@@ -7465,7 +7465,7 @@
2006-08-09 John Wiegley <johnw@newartisans.com>
- * calendar/timeclock.el (timeclock-use-elapsed): Added a new
+ * calendar/timeclock.el (timeclock-use-elapsed): Add a new
variable, which causes timeclock to report elapsed time worked,
instead of just work remaining.
@@ -8041,8 +8041,8 @@
instead of retired `allout-resumptions'. For hook functions, use
`local' parameter so hook settings are created and removed as
buffer-local settings. Revise (resumptions) setting
- auto-fill-function so it is set only if already active. The
- related fill-function settings are all made in either case, so
+ auto-fill-function so it is set only if already active.
+ The related fill-function settings are all made in either case, so
that activating auto-fill-mode activity will have the custom
allout-mode behaviors (hanging indent on topics, if configured for it).
Remove all allout-exposure-category overlays on mode deactivation.
@@ -8191,8 +8191,9 @@
2006-07-10 Alan Mackenzie <acm@muc.de>
- * progmodes/cc-awk.el, cc-defs.el, cc-fonts.el, cc-langs.el:
- * cc-mode.el: Changes to eradicate eval-after-load.
+ * progmodes/cc-awk.el, progmodes/cc-defs.el, progmodes/cc-fonts.el:
+ * progmodes/cc-langs.el, progmodes/cc-mode.el:
+ Changes to eradicate eval-after-load.
2006-07-09 Chong Yidong <cyd@stupidchicken.com>
@@ -9913,7 +9914,7 @@
* progmodes/idlw-shell.el (idlwave-shell-move-or-history):
Remove spurious move to point-max (new comint behavior fixes).
- * progmodes/idlwave.el (idlwave-push-mark): Removed obsolete
+ * progmodes/idlwave.el (idlwave-push-mark): Remove obsolete
compatibility function (Emacs 18/19).
(idlwave-is-continuation-line): Always return point at start of
previous non-blank continuation line.
@@ -9977,12 +9978,12 @@
`point'.
(diff-hunk-text, diff-goto-source): Doc fix.
- * startup.el (fancy-splash-screens, normal-splash-screen): Use
- face `mode-line-buffer-id' for mode-line buffer face instead of
+ * startup.el (fancy-splash-screens, normal-splash-screen):
+ Use face `mode-line-buffer-id' for mode-line buffer face instead of
hard-coded `(:weight bold)'.
- * arc-mode.el (archive-set-buffer-as-visiting-file): Bind
- buffer-undo-list to t (undo-ask is reproducible by visiting
+ * arc-mode.el (archive-set-buffer-as-visiting-file):
+ Bind buffer-undo-list to t (undo-ask is reproducible by visiting
nested archives).
2006-05-09 Kim F. Storm <storm@cua.dk>
@@ -9998,9 +9999,9 @@
2006-05-09 Masatake YAMATO <jet@gyve.org>
- * font-lock.el (cpp-font-lock-keywords-source-directives): Added
- "warning" and "import".
- (cpp-font-lock-keywords): Added "warning".
+ * font-lock.el (cpp-font-lock-keywords-source-directives):
+ Add "warning" and "import".
+ (cpp-font-lock-keywords): Add "warning".
2006-05-08 Dan Nicolaescu <dann@ics.uci.edu>
@@ -12212,41 +12213,41 @@
* progmodes/etags.el (tags-completion-table): Do completion from
all the tables in the current list, as documented in the manual.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* CC Mode Update to 5.31.3.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el (c-postprocess-file-styles):
Bind inhibit-read-only to t, around the call to
c-remove-any-local-eval-or-mode-variables, so that it works on a
RO file.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-awk.el: Correct a typo.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
- * progmodes/cc-cmds.el, cc-mode.el: Rename c-hungry-backspace to
+ * progmodes/cc-cmds.el, progmodes/cc-mode.el: Rename c-hungry-backspace to
c-hungry-delete-backwards, at the request of RMS. Leave the old
name as an alias.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el: Correct a typo.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-defs.el: Update the version number to 5.31.3.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el (c-electric-brace): Fix clean-up
brace-else-brace (error due to mbeg, mend being undefined).
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el: File Local variables: Solve the problem
where both `mode' and c-file-offsets are specified: `mode' will
@@ -12256,7 +12257,7 @@
c-tentative-buffer-change, to splat `mode' and `eval' before the
second hack-local-variables.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el:
[Supersedes patch to cc-engine.el 2005-12-16T20:07:49Z!monnier@iro.umontreal.ca]
@@ -12271,7 +12272,7 @@
with save-match-data. It was being corrupted when Font Lock was
not enabled.
-2006-02-24 Alan Mackenzie <bug-cc-mode@gnu.org>
+2006-02-24 Alan Mackenzie <acm@muc.de>
* progmodes/cc-langs.el (c-mode-menu): Add menu items for Electric
Mode and Subword Mode.
@@ -12283,7 +12284,7 @@
* progmodes/cc-defs.el (c-version): Update version number to 5.31.2.
- * progmodes/cc-cmds.el, cc-mode.el, cc-engine.el
+ * progmodes/cc-cmds.el, progmodes/cc-mode.el, progmodes/cc-engine.el
(c-update-modeline): Concatenate the minor mode indicators
directly onto mode-name, removing c-submode-indicators.
Sometimes, c-s-i got separated from the mode name on the mode line.
@@ -12291,7 +12292,7 @@
* progmodes/cc-cmds.el (c-electric-brace, c-electric-semi&comma)
(c-electric-colon): Correct doc-strings: "/ln" -> "/la".
-2006-02-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2006-02-24 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el (c-make-init-lang-vars-fun): Improve the
error message when there's an evaluation error to show whether
@@ -12629,8 +12630,8 @@
(Info-isearch-push-state): Add quote before Info-current-file and
Info-current-node.
(Info-isearch-pop-state): Use `equal' instead of `string='.
- (Info-extract-pointer, Info-following-node-name): Use
- `match-string-no-properties' instead of `match-string'.
+ (Info-extract-pointer, Info-following-node-name):
+ Use `match-string-no-properties' instead of `match-string'.
(Info-up): Check `old-file' for `stringp'.
(Info-history): Use `equal' instead of `string-equal'.
Check `file' for `stringp'.
@@ -12680,8 +12681,8 @@
(rcirc-get-buffer-create): Fix bug with setting the target.
(rcirc-any-buffer): Rename from rcirc-get-any-buffer, and include
test for rcirc-always-use-server-buffer-flag here.
- (rcirc-response-formats): Add %N, which is a facified nick. %n
- uses the default face. Change the ACTION format string. If the
+ (rcirc-response-formats): Add %N, which is a facified nick.
+ %n uses the default face. Change the ACTION format string. If the
"nick" is the server, don't print anything for that field.
Comment fixes.
(rcirc-target-buffer): Don't test
@@ -12706,7 +12707,7 @@
(allout-version): Incremented, corrected, revised, and refined
module commentary.
- (provide 'allout): Moved to the bottom, added a require of overlay.
+ (provide 'allout): Move to the bottom, added a require of overlay.
(allout-encrypt-unencrypted-on-saves): Defaults to t instead of
`except-current'.
@@ -12729,19 +12730,19 @@
Clarify provision for various write-file hook var names.
Adjusted for invisible-text overlays instead of selective-display.
- (allout-depth): Really return 0 if not within any topic. This
- rectifies `allout-beginning-of-level' and sequence numbering
+ (allout-depth): Really return 0 if not within any topic.
+ This rectifies `allout-beginning-of-level' and sequence numbering
errors that occur when cutting and pasting numbered topics.
Changed from a in-line subst to a regular function, as well.
- (allout-pre-next-prefix): Renamed from allout-pre-next-preface.
+ (allout-pre-next-prefix): Rename from allout-pre-next-preface.
(allout-end-of-subtree, allout-end-of-subtree)
(allout-end-of-entry, allout-end-of-current-heading)
(allout-next-visible-heading, allout-open-topic, allout-show-entry)
(allout-show-children, allout-show-to-offshoot)
- (allout-hide-current-entry, allout-show-current-entry): Rectified
- handling of trailing blank lines between items.
+ (allout-hide-current-entry, allout-show-current-entry):
+ Rectified handling of trailing blank lines between items.
(allout-line-boundary-regexp, set-allout-regexp, allout-depth)
(allout-current-depth, allout-unprotected, allout-hidden-p)
@@ -12752,11 +12753,11 @@
(allout-hide-region-body, allout-toggle-subtree-encryption)
(allout-encrypt-string, allout-encrypted-key-info)
(allout-next-topic-pending-encryption, allout-encrypt-decrypted)
- (allout-file-vars-section-data): Adjusted for use with
+ (allout-file-vars-section-data): Adjust for use with
invisible-text overlays instead of selective-display.
(allout-kill-line, allout-kill-topic, allout-yank-processing):
- Reworked for use with invisible text overlays.
+ Rework for use with invisible text overlays.
(allout-current-topic-collapsed-p): New function.
@@ -12776,8 +12777,8 @@
(allout-overlay-insert-in-front-handler)
(allout-overlay-interior-modification-handler)
- (allout-before-change-handler, allout-isearch-end-handler): New
- functions to handle extraordinary actions affecting concealed
+ (allout-before-change-handler, allout-isearch-end-handler):
+ New functions to handle extraordinary actions affecting concealed
text.
(allout-flag-region): Use overlays instead of selective-display
@@ -12809,8 +12810,8 @@
2006-02-17 Agustín Martín <agustin.martin@hispalinux.es>
- * textmodes/ispell.el (ispell-change-dictionary): Call
- ispell-buffer-local-dict instead of
+ * textmodes/ispell.el (ispell-change-dictionary):
+ Call ispell-buffer-local-dict instead of
ispell-accept-buffer-local-defs.
(ispell-local-dictionary-alist): Accept as valid any coding-system
supported by Emacs.
@@ -12917,8 +12918,8 @@
(hack-local-variables): Construct list of variable-value pairs,
and apply or reject them in one go. Ask for confirmation if
variables are not known safe.
- (hack-local-variables-confirm): Complete rewrite. Support
- `safe-local-variable-values'.
+ (hack-local-variables-confirm): Complete rewrite.
+ Support `safe-local-variable-values'.
(enable-local-variables): Update docstring to reflect new
behavior.
(ignored-local-variables): Ignore ignored-local-variables and
@@ -13017,8 +13018,8 @@
2006-02-12 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-remote-path): Add "/usr/xpg4/bin" on top,
- because on Solaris a POSIX compatible "id" is needed. Reported by
- Magnus Henoch <mange@freemail.hu>.
+ because on Solaris a POSIX compatible "id" is needed.
+ Reported by Magnus Henoch <mange@freemail.hu>.
2006-02-12 Juri Linkov <juri@jurta.org>
@@ -13102,10 +13103,10 @@
* help.el (describe-key-briefly): Now a wrapper for
describe-key-briefly-internal. Bind enable-disabled-menus-and-buttons
to t. Populate yank-menu if empty.
- (describe-key-briefly-internal): Renamed from describe-key-briefly.
+ (describe-key-briefly-internal): Rename from describe-key-briefly.
(describe-key): Now a wrapper for describe-key-internal. Bind
enable-disabled-menus-and-buttons to t. Populate yank-menu if empty.
- (describe-key-internal): Renamed from describe-key.
+ (describe-key-internal): Rename from describe-key.
2006-02-11 Milan Zamazal <pdm@zamazal.org>
@@ -13528,7 +13529,7 @@
(last-arg): Add defvar.
* makefile.w32-in (WINS): Add erc.
- (MH_E_SRC): Update (copied from lisp/Makefile.in).
+ (MH_E_SRC): Update (copied from Makefile.in).
2006-01-29 Bill Wohler <wohler@newt.com>
@@ -13640,8 +13641,8 @@
2006-01-22 Kenichi Handa <handa@m17n.org>
- * international/mule.el (make-subsidiary-coding-system): Reset
- `coding-system-define-form' property of subsidiaries to nil.
+ * international/mule.el (make-subsidiary-coding-system):
+ Reset `coding-system-define-form' property of subsidiaries to nil.
Avoid duplicated entry in coding-system-alist.
(make-coding-system): Avoid duplicated entry in
coding-system-alist.
@@ -13789,8 +13790,8 @@
(tramp-unload-file-name-handler-alist)
(tramp-unload-tramp): New defuns.
(tramp-advice-PC-expand-many-files): New defadvice.
- (tramp-save-PC-expand-many-files, tramp-setup-complete): Defuns
- removed.
+ (tramp-save-PC-expand-many-files, tramp-setup-complete):
+ Defuns removed.
(tramp-handle-expand-file-name): Remove double slash.
(tramp-handle-file-attributes-with-ls): Return t as 9th attribute.
It doesn't matter, because it will be converted later on.
@@ -13868,7 +13869,7 @@
2006-01-20 Carsten Dominik <dominik@science.uva.nl>
- * textmodes/org.el (org-open-at-point): Fixed bug with matching a
+ * textmodes/org.el (org-open-at-point): Fix bug with matching a
link. Fixed buggy argument sequence in call to `org-view-tags'.
(org-compile-prefix-format): Set `org-prefix-has-tag'.
(org-prefix-has-tag): New variable.
@@ -13885,8 +13886,8 @@
images remain visible.
(thumbs-file-alist): Construct list in thumbs-buffer and reverse
order.
- (thumbs-show-image-num): Get image from thumbs-file-alist. Set
- mode name.
+ (thumbs-show-image-num): Get image from thumbs-file-alist.
+ Set mode name.
(thumbs-next-image, thumbs-previous-image): Make them work.
2006-01-19 Luc Teirlinck <teirllm@auburn.edu>
@@ -14196,8 +14197,8 @@
2006-01-12 Masatake YAMATO <jet@gyve.org>
- * progmodes/ld-script.el (auto-mode-alist): Support
- suffix conventions used in netbsd and eCos.
+ * progmodes/ld-script.el (auto-mode-alist):
+ Support suffix conventions used in netbsd and eCos.
2006-01-11 Luc Teirlinck <teirllm@auburn.edu>
@@ -15572,7 +15573,7 @@
* hi-lock.el (hi-lock-mode): Rename from hi-lock-buffer-mode;
react if global-hi-lock-mode seems intended.
- (global-hi-lock-mode): Renamed from hi-lock-mode.
+ (global-hi-lock-mode): Rename from hi-lock-mode.
(hi-lock-archaic-interface-message-used)
(hi-lock-archaic-interface-deduce): New variables.
(turn-on-hi-lock-if-enabled, hi-lock-line-face-buffer)
@@ -15722,7 +15723,7 @@
No need to check gud-comint-buffer is bound.
(gdb): Prevent multiple debugging when first session uses gdba.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
CC Mode update to 5.31.
@@ -15730,11 +15731,12 @@
Emacsen which lack `define-minor-mode'. (Currently Emacs <21.
We might do this function properly in the future).
- * progmodes/cc-cmds.el, cc-defs.el, cc-styles.el, cc-vars.el:
+ * progmodes/cc-cmds.el, progmodes/cc-defs.el:
+ * progmodes/cc-styles.el, progmodes/cc-vars.el:
New macros c-sentence-end and c-default-value-sentence end, to cope
with Emacs 22's new function `sentence-end'.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-show-syntactic-information): Solve the
compat issue using `c-put-overlay' and `c-delete-overlay'.
@@ -15742,7 +15744,7 @@
* progmodes/cc-defs.el (c-put-overlay, c-delete-overlay):
New compat macros to handle overlays/extents.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-fix.el: Add definitions of the macros push and pop
(for GNU Emacs 20.4).
@@ -15759,7 +15761,7 @@
call to the new macro c-int-to-char. This solves XEmacs's
regarding characters as different from integers.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-make-syntactic-matcher):
New internal helper.
@@ -15775,22 +15777,22 @@
* progmodes/cc-fonts.el (c-negation-char-face-name): New variable
to map to `font-lock-negation-char-face' in emacsen where it exists.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el: Bind c-subword-mode to C-c C-w.
- * progmodes/cc-subword.el, cc-cmds.el, cc-mode.el:
+ * progmodes/cc-subword.el, progmodes/cc-cmds.el, progmodes/cc-mode.el:
Rename "c-subword-move-mode" as "c-subword-mode".
* progmodes/cc-mode.el: Added tty suitable bindings for C-c
<delete> and C-c C-<delete>. (To the c-hungry- delete functions).
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-mode.el: Added autoload directive for
`c-subword-move-mode' for use in older emacsen.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el:
(i): Insert a binding for C-c C-backspace into
@@ -15808,9 +15810,9 @@
* progmodes/cc-awk.el: Apply a tidy-up patch (from Stefan Monnier).
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-fonts.el, cc-vars.el
+ * progmodes/cc-fonts.el, progmodes/cc-vars.el
(gtkdoc-font-lock-doc-comments, gtkdoc-font-lock-doc-protection)
(gtkdoc-font-lock-keywords): GtkDoc patterns contributed by
Masatake YAMATO.
@@ -15827,7 +15829,7 @@
<delete> key behavior in XEmacs according to `delete-forward-p'.
C.f. `c-electric-delete'.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-mode.el: Give c-hungry-backspace and
c-hungry-delete-forward permanent key bindings.
@@ -15845,7 +15847,7 @@
response to a report from Joseph Kiniry <kiniry@acm.org> that it
was difficult to understand.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-on-identifier): Fix bug when at the
first char of an identifier.
@@ -15853,7 +15855,7 @@
* progmodes/cc-engine.el (c-on-identifier): Handle the "operator
+" syntax in C++.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el (c-mask-paragraph): Correct, so that
auto-fill doesn't split a c-comment's last word from a hanging
@@ -15869,7 +15871,7 @@
with blank comment-prefix, and a blank line as the comment's
second line.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-cpp-matchers, c-basic-matchers-before):
Incorporate the patterns added in the Emacs development branch
@@ -15881,16 +15883,16 @@
* progmodes/cc-engine.el (c-literal-faces):
Add `font-lock-comment-delimiter-face' which is new in Emacs 22.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el: Make C-c C-a (`c-toggle-auto-newline')
forcibly enable c-electric-flag.
- * progmodes/cc-vars.el, cc-cmds.el: New clean-up
+ * progmodes/cc-vars.el, progmodes/cc-cmds.el: New clean-up
`comment-close-slash' on c-electric-slash: if enabled, typing `/' just
after the comment-prefix of a C-style comment will close that comment.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-basic-matchers-before)
(c-complex-decl-matchers): Fix the "not-arrow-prefix" regexp used
@@ -15899,7 +15901,7 @@
* progmodes/cc-langs.el (c-other-op-syntax-tokens): Only C++ has
digraphs.
- * progmodes/cc-fonts.el, cc-langs.el, cc-engine.el
+ * progmodes/cc-fonts.el, progmodes/cc-langs.el, progmodes/cc-engine.el
(c-cpp-message-directives, c-cpp-include-directives)
(c-opt-cpp-macro-define, c-opt-cpp-macro-define-start)
(c-cpp-expr-directives): Introduce new language constants to
@@ -15909,7 +15911,7 @@
(c-cpp-matchers, c-forward-to-cpp-define-body): Use them.
- * progmodes/cc-langs.el, cc-fonts.el (c-string-escaped-newlines)
+ * progmodes/cc-langs.el, progmodes/cc-fonts.el (c-string-escaped-newlines)
(c-multiline-string-start-char): New language constants and
variables to specify how newlines in string literals work.
@@ -15923,13 +15925,13 @@
(c-electric-brace): Indent syntactically after the cleanups since
lineup functions might do it differently then.
- * progmodes/cc-engine.el, cc-langs.el
+ * progmodes/cc-engine.el, progmodes/cc-langs.el
(c-opt-op-identifier-prefix): New language constant and variable.
(c-just-after-func-arglist-p, c-after-special-operator-id)
(c-search-decl-header-end, c-inside-bracelist-p): Use it.
- * progmodes/cc-align.el, cc-engine.el
+ * progmodes/cc-align.el, progmodes/cc-engine.el
(c-after-special-operator-id): New helper to handle C++ operator
identifiers.
@@ -15954,11 +15956,11 @@
Enable heuristics below the point to cope with classes inside special
brace lists in Pike.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el: Amend c-point-syntax to handle macros.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-guess.el (cc-guess-install): New function to
install an already guessed style in another buffer.
@@ -15967,7 +15969,7 @@
sets `inhibit-read-only' - `c-save-buffer-state' should be used
anyway if the change always is undone.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
Implement togglable electricity:
@@ -16007,13 +16009,14 @@
(c-electric-semi&comma, c-electric-colon, c-electric-paren):
restructure a bit.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-show-syntactic-information): Show the
anchor position(s) using faces. Thanks to Masatake YAMATO for the idea.
- * progmodes/cc-mode.el, cc-cmds.el, cc-defs.el, cc-engine.el
- (c-submode-indicators): Change name from `c-auto-hungry-string'
+ * progmodes/cc-mode.el, progmodes/cc-cmds.el, progmodes/cc-defs.el:
+ * progmodes/cc-engine.el (c-submode-indicators):
+ Change name from `c-auto-hungry-string'
since it's now used to track another submode.
(c-update-modeline): Convert to function and extended to check
@@ -16034,7 +16037,7 @@
(c-subword-move-mode): Minor mode that replaces all the standard
word handling functions with their subword equivalences.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-vars.el (c-cleanup-list): Insert a customization
entry for one-liner-defun.
@@ -16061,7 +16064,7 @@
c-max-one-liner-length. In c-default-style, set the default style
for AWK to "awk".
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-engine.el (c-forward-label): Fix fontification of
macros inside labels.
@@ -16084,7 +16087,7 @@
to avoid heuristics that doesn't work for unclosed blocks.
(c-at-statement-start-p): New function.
- * progmodes/cc-engine.el, cc-fonts.el: Fixes in handling of
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el: Fixes in handling of
Objective-C directives, e.g. directives spanning lines should work
reasonably well now.
@@ -16136,7 +16139,7 @@
* progmodes/cc-engine.el (c-beginning-of-statement-1): Fix a
macro related issue.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-awk.el: Change the terminology of regexps: A char
list is now [asdf], a char class [:alpha:].
@@ -16168,18 +16171,18 @@
(c-forward-single-comment, c-backward-single-comment): Comment out
the (now redundant) "special" AWK stuff.
- * progmodes/cc-styles.el, cc-vars.el: Change the settings of
+ * progmodes/cc-styles.el, progmodes/cc-vars.el: Change the settings of
c-string-par-start, c-string-par-separate to be more like Text
Mode than Fundamental Mode.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-fonts.el (c-font-lock-declarations): Always narrow
to the fontified region so that fontification doesn't occur
outside it (could happen e.g. when fontifying a line with an
unfinished declaration).
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-awk.el: Move regexps for analyzing AWK code to near the
start of the file. ^L now separate sections of the file.
@@ -16217,7 +16220,7 @@
* progmodes/cc-mode.el: Fix what's almost a semantic ambiguity in
a comment.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-electric-brace): Clean up using
`c-tentative-buffer-changes'.
@@ -16237,8 +16240,8 @@
the checks for paren sexps between the point and the keyword, to
avoid some false alarms.
- * progmodes/cc-engine.el, cc-langs.el (c-looking-at-inexpr-block):
- Fixed a situation where an error could be thrown for unbalanced
+ * progmodes/cc-engine.el, progmodes/cc-langs.el (c-looking-at-inexpr-block):
+ Fix a situation where an error could be thrown for unbalanced
parens. Changed to make use of c-keyword-member' to avoid some
repeated regexp matches.
@@ -16276,9 +16279,10 @@
* progmodes/cc-defs.el (c-point): Add `bosws' and `eosws'.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
- * progmodes/cc-cmds.el, cc-styles.el, cc-vars.el: New variables
+ * progmodes/cc-cmds.el, progmodes/cc-styles.el:
+ * progmodes/cc-vars.el: New variables
c-string-par-start/separate c-sentence-end-with-esc-eol,
initialized in c-setup-paragraph-variables, used in string
scanning subroutines of c-beginning-of-statement.
@@ -16286,9 +16290,9 @@
* progmodes/cc-cmds.el (c-electric-brace): Don't delete a comment
which precedes the newly inserted `{'.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el, cc-langs.el: Rewrote the recognition
+ * progmodes/cc-engine.el, progmodes/cc-langs.el: Rewrote the recognition
function for declaration level blocks. It should now cope with
templates better and also be a lot more comprehensible.
@@ -16340,7 +16344,7 @@
the point could be left directly after an open paren when finding
the beginning of the first decl in the block.
- * progmodes/cc-engine.el, cc-fonts.el (c-forward-keyword-clause):
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el (c-forward-keyword-clause):
Specify which submatch to use.
* progmodes/cc-langs.el (c-symbol-start): Include `@' in ObjC.
@@ -16405,7 +16409,7 @@
(c-specifier-key, c-not-decl-init-keywords): Some cleanup using new
language constants `c-type-start-kwds' and `c-prefix-spec-kwds'.
- * progmodes/cc-fonts.el, cc-langs.el, cc-engine.el:
+ * progmodes/cc-fonts.el, progmodes/cc-langs.el, progmodes/cc-engine.el:
Internal cleanups to properly detect the declared identifiers in
various declarations.
@@ -16446,11 +16450,12 @@
* progmodes/cc-engine.el (c-maybe-labelp): Provide no default
value - this variable is always dynamically bound.
- * progmodes/cc-engine.el, cc-fonts.el, cc-langs.el, cc-menus.el
- * cc-mode.el, cc-styles.el, cc-vars.el, cc-align.el, cc-awk.el
- * cc-cmds.el, cc-defs.el: Change the policy for marking up
- functions that might do hidden buffer changes: All such internal
- functions are now marked instead of those that don't.
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el, progmodes/cc-langs.el:
+ * progmodes/cc-menus.el, progmodes/cc-mode.el, progmodes/cc-styles.el:
+ * progmodes/cc-vars.el, progmodes/cc-align.el, progmodes/cc-awk.el:
+ * progmodes/cc-cmds.el, progmodes/cc-defs.el: Change the policy
+ for marking up functions that might do hidden buffer changes:
+ All such internal functions are now marked instead of those that don't.
(c-beginning-of-macro, c-end-of-macro, c-(forward|backward)-comments)
(c-(forward|backward)-single-comment, c-parse-state, c-on-identifier)
@@ -16470,7 +16475,7 @@
when macros occur in obscure places. Optimized the sexp movement
a bit.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
Enhancements for c-beginning-of-statement to work in AWK Mode:
@@ -16493,9 +16498,10 @@
* progmodes/cc-mode.el: Put M-a and M-e into awk-mode-map.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el, cc-fonts.el, cc-langs.el: Cleaned up the
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el:
+ * progmodes/cc-langs.el: Cleaned up the
label handling. Labels are now recognized in a uniform and more
robust way, regardless of context. Text properties are put on all
labels to recognize the following declarations better.
@@ -16552,7 +16558,7 @@
* progmodes/cc-align.el (c-lineup-arglist): Fix bug when the
first argument starts with a special brace list.
- * progmodes/cc-engine.el, cc-fonts.el (c-forward-decl-or-cast-1)
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el (c-forward-decl-or-cast-1)
(c-font-lock-declarations): Break out the declaration and cast
recognition from `c-font-lock-declarations' to a new function, so
that it can be used in the indentation engine.
@@ -16644,15 +16650,15 @@
(c-lineup-math): Change to use `c-lineup-assignments'.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el: Fix some bugs in subfunctions of
c-beginning-of-statement. New subfunctions
c-in-comment-line-prefix-p, c-narrow-to-comment-innards.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-fonts.el, cc-langs.el: Use `c-simple-ws' instead of
+ * progmodes/cc-fonts.el, progmodes/cc-langs.el: Use `c-simple-ws' instead of
hardcoded char classes wherever possible. Changed a couple of
places to use skip by syntax instead of skip by char class.
@@ -16682,7 +16688,7 @@
in `regexp-opt' in Emacs 20 and XEmacs when strings contain
newlines. Allow and ignore nil elements in the list.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el: Comment out a (n almost certainly
superfluous) check, (eq here (point-max)) in c-beginning-of-statement.
@@ -16702,11 +16708,11 @@
* progmodes/cc-cmds.el: Tidy c-beginning-of-sentence (and
subfunctions) so that it works at BOB and EOB.
- * progmodes/cc-cmds.el, cc-vars.el: More updating of
+ * progmodes/cc-cmds.el, progmodes/cc-vars.el: More updating of
c-beginning-of-statement, including new variable
c-block-comment-start-regexp.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-langs.el (c-known-type-key): Optimize simple
symbols from `*-font-lock-extra-types' so that there's no need to
@@ -16725,7 +16731,7 @@
* progmodes/cc-vars.el (c-emacs-features): Remove compatibility
with older emacsen: We now require `pps-extended-state'.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el: New function c-beginning-of-sentence,
which obviates the need to hack sentence-end. This now handles
@@ -16740,9 +16746,9 @@
* progmodes/cc-cmds.el: Restructure c-beginning-of-statement:
Improve its doc-string. Improve the handling of certain specific cases.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-engine.el, cc-fonts.el, cc-langs.el
+ * progmodes/cc-engine.el, progmodes/cc-fonts.el, progmodes/cc-langs.el
(c-guess-basic-syntax): Change the way class-level labels are
recognized; they can now contain essentially any symbols.
@@ -16765,7 +16771,7 @@
Remove some cruft and fixed a bug that could cause it to go to a
position further down.
- * progmodes/cc-langs.el, cc-engine.el
+ * progmodes/cc-langs.el, progmodes/cc-engine.el
(c-beginning-of-statement-1): Improve detection of labels in
declaration contexts.
@@ -16780,7 +16786,7 @@
* progmodes/cc-defs.el (c-forward-sexp, c-backward-sexp):
Make these behave as documented when used at the buffer limits.
- * progmodes/cc-mode.el, cc-engine.el, cc-langs.el
+ * progmodes/cc-mode.el, progmodes/cc-engine.el, progmodes/cc-langs.el
(c-type-decl-end-used): Made this a language variable.
* progmodes/cc-mode.el (c-after-change): Widen the buffer to work
@@ -16807,7 +16813,8 @@
* progmodes/cc-mode.el (c-basic-common-init): Turn on syntax-table
text property lookup only when it's needed.
- * progmodes/cc-langs.el, cc-engine.el, cc-fonts.el, cc-mode.el:
+ * progmodes/cc-langs.el, progmodes/cc-engine.el:
+ * progmodes/cc-fonts.el, progmodes/cc-mode.el:
Change the policy for paren marked angle brackets to be more
persistent; once marked they remain marked even when they're found
to be unbalanced in the searched region. This should keep the
@@ -16850,29 +16857,31 @@
`template-args-cont' in nested template arglists. There's still
much to be desired in this area, though.
-2005-12-08 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-12-08 Alan Mackenzie <acm@muc.de>
- * progmodes/cc-cmds.el, cc-engine.el, cc-langs.el, cc-vars.el:
+ * progmodes/cc-cmds.el, progmodes/cc-engine.el:
+ * progmodes/cc-langs.el, progmodes/cc-vars.el:
Make the "Text Filling and Line Breaking" commands work for AWK buffers.
-2005-12-08 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-12-08 Martin Stjernholm <mast@lysator.liu.se>
- * progmodes/cc-defs.el, cc-engine.el (c-mode-is-new-awk-p):
- Removed; (c-major-mode-is 'awk-mode) can be used instead now.
+ * progmodes/cc-defs.el, progmodes/cc-engine.el (c-mode-is-new-awk-p):
+ Remove; (c-major-mode-is 'awk-mode) can be used instead now.
* progmodes/cc-mode.el: Always set up AWK mode since emacsen where
it doesn't work no longer are supported.
- * progmodes/cc-mode.el, cc-styles.el, cc-vars.el, cc-defs.el
- * cc-engine.el, cc-fonts.el, cc-langs.el, cc-cmds.el: CC Mode now
+ * progmodes/cc-mode.el, progmodes/cc-styles.el, progmodes/cc-vars.el:
+ * progmodes/cc-defs.el, progmodes/cc-engine.el, progmodes/cc-fonts.el:
+ * progmodes/cc-langs.el, progmodes/cc-cmds.el: CC Mode now
requires support for the syntax-table' text property, which rules
out Emacs 19 and XEmacs < 21.4. Removed various compatibility
cruft associated with those versions.
- * progmodes/cc-defs.el, cc-fix.el: CC Mode now requires support
- for the `syntax-table' text property, which rules out Emacs 19 and
- XEmacs < 21.4. Removed various compatibility cruft associated
- with those versions.
+ * progmodes/cc-defs.el, progmodes/cc-fix.el: CC Mode now requires
+ support for the `syntax-table' text property, which rules out
+ Emacs 19 and XEmacs < 21.4. Remove various compatibility cruft
+ associated with those versions.
* progmodes/cc-vars.el (c-emacs-features): CC Mode now requires
support for the `syntax-table' text property.
@@ -17355,7 +17364,7 @@
* calc/calc-embed.el (calc-do-embedded): Update help message.
- * calc/calc-prog.el (calc-user-define-invokation): Update help message.
+ * calc/calc-prog.el (calc-user-define-invocation): Update help message.
2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -17604,7 +17613,7 @@
2005-11-24 Chong Yidong <cyd@stupidchicken.com>
- * hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'.
+ * hi-lock.el (hi-lock-buffer-mode): Rename from `hi-lock-mode'.
Use define-minor-mode, and make it a local mode. Turn on font-lock.
(hi-lock-mode): New global minor mode.
(turn-on-hi-lock-if-enabled): New function.
@@ -17650,8 +17659,8 @@
New functions.
(org-move-item-down, org-move-item-up): New commands.
(org-export-as-html): New classes for CSS support. Bug fix in
- regular expression detecting fixed-width regions. Respect
- `org-local-list-ordered-item-terminator'.
+ regular expression detecting fixed-width regions.
+ Respect `org-local-list-ordered-item-terminator'.
(org-set-autofill-regexps, org-adaptive-fill-function): "1)" is
also a list item.
(org-metaup, org-metadown, org-shiftmetaup, org-shiftmetadown):
@@ -17676,8 +17685,8 @@
(gdb-var-update-handler): Find values for all variable objects.
(gdb-info-frames-custom): Identify frames by leading "#".
- * progmodes/gud.el (gud-speedbar-menu-items): Add
- gdb-speedbar-auto-raise as radio button.
+ * progmodes/gud.el (gud-speedbar-menu-items):
+ Add gdb-speedbar-auto-raise as radio button.
(gud-speedbar-buttons): Raise speedbar if requested.
Don't match on "char **...".
(gud-speedbar-buttons): Add (pointer) value for non-leaves.
@@ -20080,8 +20089,8 @@
2005-10-17 Bill Wohler <wohler@newt.com>
Move all remaining images from lisp/toolbar to etc/images, move
- lisp/toolbar/tool-bar to lisp and "delete" lisp/toolbar. Place
- the low resolution images in their own directory (low-color).
+ lisp/toolbar/tool-bar to lisp and "delete" lisp/toolbar.
+ Place the low resolution images in their own directory (low-color).
* toolbar/attach.*, toolbar/cancel.*, toolbar/close.*
* toolbar/copy.*, toolbar/cut.*, toolbar/diropen.*, toolbar/exit.*
@@ -20348,8 +20357,8 @@
2005-10-13 Jan Djärv <jan.h.d@swipnet.se>
* toolbar/diropen.xpm, toolbar/diropen.pbm: New versions made from
- Gnome file-manager.png. Suggested by
- Joachim Nilsson <joachim.nilsson@vmlinux.org>.
+ Gnome file-manager.png.
+ Suggested by Joachim Nilsson <joachim.nilsson@vmlinux.org>.
* toolbar/README: Add diropen.xpm.
@@ -20627,8 +20636,8 @@
trailing ":". Reported by Kurt Steinkraus <kurt@steinkraus.us>.
(tramp-chunksize): Improve docstring.
(tramp-set-auto-save-file-modes): Octal integer code #o600 breaks
- Emacs 20. Use `tramp-octal-to-decimal' therefore. Reported by
- Christian Joergensen <bugs@razor.dk>.
+ Emacs 20. Use `tramp-octal-to-decimal' therefore.
+ Reported by Christian Joergensen <bugs@razor.dk>.
2005-10-07 Glenn Morris <rgm@gnu.org>
@@ -20672,8 +20681,6 @@
2005-10-06 Bill Wohler <wohler@newt.com>
- * mh-e/mh-loaddefs.el: Remove. Now generated automatically.
-
* Makefile.in (AUTOGENEL): Add mh-e/mh-loaddefs.el.
(MH-E-SRC): New. Used by mh-autoloads.
(mh-autoloads): New. Builds mh-e/mh-loaddefs.el. Rebuilds if any
@@ -20785,8 +20792,8 @@
* emulation/viper-cmd.el (viper-normalize-minor-mode-map-alist)
(viper-refresh-mode-line): Use make-local-variable to localize
- some vars instead of make-variable-buffer-local. Suggested by
- Stefan Monnier.
+ some vars instead of make-variable-buffer-local.
+ Suggested by Stefan Monnier.
* emulation/viper-init.el (viper-make-variable-buffer-local):
Delete alias.
@@ -21028,23 +21035,23 @@
Frame management code (including timer, and mouse click specifics)
moved to dframe.el:
- (speedbar-attached-frame): Removed. Use dframe-attached-frame.
- (speedbar-timer): Removed. Use dframe-timer.
- (speedbar-close-frame): Removed. Use dframe-close-frame.
- (speedbar-activity-change-focus-flag): Removed. Use
- dframe-activity-change-focus-flag.
- (speedbar-update-speed, speedbar-navigating-speed): Obsolete. Use
- dframe-update-speed.
+ (speedbar-attached-frame): Remove. Use dframe-attached-frame.
+ (speedbar-timer): Remove. Use dframe-timer.
+ (speedbar-close-frame): Remove. Use dframe-close-frame.
+ (speedbar-activity-change-focus-flag): Remove.
+ Use dframe-activity-change-focus-flag.
+ (speedbar-update-speed, speedbar-navigating-speed): Obsolete.
+ Use dframe-update-speed.
(speedbar-current-frame): New macro. Use this instead of the
variable speedbar-frame.
(speedbar-use-images, speedbar-expand-image-button-alist)
- (speedbar-insert-image-button-maybe): Moved to sb-image.el.
+ (speedbar-insert-image-button-maybe): Move to sb-image.el.
- (speedbar-find-image-on-load-path): Removed. Replaced by
+ (speedbar-find-image-on-load-path): Remove. Replaced by
defezimage in ezimage.el.
- (speedbar-expand-image-button-alist): Removed. Replaced by
+ (speedbar-expand-image-button-alist): Remove. Replaced by
ezimage-expand-image-button-alist in ezimage.el.
(speedbar-ignored-directory-regexp)
@@ -21052,7 +21059,7 @@
(speedbar-ignored-directory-expressions)
(speedbar-line-directory, speedbar-buffers-line-directory)
(speedbar-directory-line, speedbar-buffers-line-directory):
- Renamed, replacing `path' with `directory'.
+ Rename, replacing `path' with `directory'.
(speedbar-create-directory, speedbar-expand-line-descendants)
(speedbar-toggle-line-expansion)
@@ -21610,8 +21617,8 @@
2005-09-17 Milan Zamazal <pdm@zamazal.org>
- * progmodes/glasses.el (glasses-make-readable): If
- glasses-separator differs from underscore, put appropriate
+ * progmodes/glasses.el (glasses-make-readable):
+ If glasses-separator differs from underscore, put appropriate
overlays over underscore characters.
(glasses-convert-to-unreadable): If glasses-separator differs from
underscore, try to convert glasses-separator characters to
@@ -21968,7 +21975,7 @@
* custom.el (custom-known-themes): Clarify meaning of "standard".
(custom-push-theme): Save old values in the standard theme.
(disable-theme): Correct typo.
- (custom-face-theme-value): Deleted unused function.
+ (custom-face-theme-value): Delete unused function.
(custom-theme-recalc-face): Rewritten to treat enable/disable properly.
2005-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -22920,10 +22927,6 @@
(Info-restore-desktop-buffer): Remove autoload cookie.
(Info-mode): Add autoload cookie.
- * mh-e/mh-e.el: Add handler to desktop-buffer-mode-handlers.
- (mh-restore-desktop-buffer): Remove autoload cookie.
- (mh-folder-mode): Add autoload cookie.
-
* mail/rmail.el: Add handler to desktop-buffer-mode-handlers.
(rmail-restore-desktop-buffer): Remove autoload cookie.
@@ -25825,14 +25828,14 @@
(antlr-font-lock-default-face, antlr-font-lock-keyword-face)
(antlr-font-lock-syntax-face, antlr-font-lock-ruledef-face)
(antlr-font-lock-tokendef-face, antlr-font-lock-ruleref-face)
- (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face): New
- backward-compatibility aliases for renamed faces.
+ (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face):
+ New backward-compatibility aliases for renamed faces.
(antlr-default-face, antlr-keyword-face, antlr-syntax-face)
(antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face)
(antlr-tokenref-face, antlr-literal-face): Variables renamed to
remove "font-lock-". Use renamed antlr-mode faces.
- (antlr-font-lock-additional-keywords): Use renamed faces. Replace
- literal face-names with face variable references.
+ (antlr-font-lock-additional-keywords): Use renamed faces.
+ Replace literal face-names with face variable references.
* buff-menu.el (Buffer-menu-buffer): Remove "-face" suffix from
face name.
@@ -26775,16 +26778,6 @@
(iswitchb-common-match-inserted): New variable.
(iswitchb-complete, iswitchb-completion-help): Use it.
-2005-06-04 David Reitter <david.reitter@gmail.com> (tiny change)
-
- * url/url-http.el (url-http-chunked-encoding-after-change-function):
- Use `url-http-debug' instead of `message'.
-
-2005-06-04 Thierry Emery <thierry.emery@free.fr> (tiny change)
-
- * url/url-http.el (url-http-parse-headers): Pass redirected URL
- as a callback argument.
-
2005-06-04 Kim F. Storm <storm@cua.dk>
* simple.el (line-move): Only call sit-for when moving backwards.
@@ -27394,7 +27387,7 @@
* emacs-lisp/cl.el (acons, pairlis): Add docstring.
-2005-05-23 Martin Stjernholm <bug-cc-mode@gnu.org>
+2005-05-23 Martin Stjernholm <mast@lysator.liu.se>
CC Mode update to 5.30.10:
@@ -27408,14 +27401,14 @@
* progmodes/cc-engine.el (c-guess-basic-syntax): Handle operator
declarations somewhat better in C++.
- * progmodes/cc-styles.el, cc-mode.el (c-run-mode-hooks):
+ * progmodes/cc-styles.el, progmodes/cc-mode.el (c-run-mode-hooks):
New helper macro to make use of `run-mode-hooks'
which has been added in Emacs 21.1.
(c-mode, c++-mode, objc-mode, java-mode, idl-mode, pike-mode)
(awk-mode): Use it.
(make-local-hook): Suppress warning about obsolescence.
- * progmodes/cc-engine.el, cc-align.el, cc-cmds.el
+ * progmodes/cc-engine.el, progmodes/cc-align.el, progmodes/cc-cmds.el
(c-append-backslashes-forward, c-delete-backslashes-forward)
(c-find-decl-spots, c-semi&comma-no-newlines-before-nonblanks):
Compensate for return value from `forward-line' when it has moved
@@ -27424,13 +27417,13 @@
* progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchoring in
`objc-method-intro' and `objc-method-args-cont'.
-2005-05-23 Alan Mackenzie <bug-cc-mode@gnu.org>
+2005-05-23 Alan Mackenzie <acm@muc.de>
CC Mode update to 5.30.10:
- * progmodes/cc-mode.el, cc-engine.el, cc-align.el: Change the FSF's
- address in the copyright statement. Incidentally, change "along with
- GNU Emacs" to "along with this program" where it occurs.
+ * progmodes/cc-mode.el, progmodes/cc-engine.el, progmodes/cc-align.el:
+ Change the FSF's address in the copyright statement. Incidentally,
+ change "along with GNU Emacs" to "along with this program" where it occurs.
* progmodes/cc-mode.el: Add a fourth parameter `t' to the awk-mode
autoload, so that it is interactive, hence can be found by M-x awk-mode
@@ -28301,8 +28294,8 @@
2005-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
- * files.el (executable-find): Move from executable.el. Use
- locate-file.
+ * files.el (executable-find): Move from executable.el.
+ Use locate-file.
* progmodes/executable.el (executable-find): Move to files.el.
* font-lock.el (font-lock-fontify-keywords-region): Use a marker
@@ -28531,8 +28524,8 @@
* term/mac-win.el: Don't define or bind scroll bar functions if
x-toolkit-scroll-bars is t.
- (x-select-text, x-get-selection-value): Clear
- x-last-selected-text-clipboard if x-select-enable-clipboard is
+ (x-select-text, x-get-selection-value):
+ Clear x-last-selected-text-clipboard if x-select-enable-clipboard is
nil.
(PRIMARY): Put mac-scrap-name property.
(mac-select-convert-to-file-url): New function.
@@ -29694,11 +29687,6 @@
* emacs-lisp/map-ynp.el (map-y-or-n-p): Clarify RET/q in help message.
-2005-04-10 Chong Yidong <cyd@stupidchicken.com>
-
- * url/url-ldap.el (url-ldap): Add docstring. Fix call to
- `ldap-search-internal'.
-
2005-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
* files.el (set-auto-mode-1): Use line-end-position.
@@ -30866,8 +30854,8 @@
Catch `dont-send' signal.
(tramp-set-auto-save-file-modes): Set always permissions, because
there might be an old auto-saved file belonging to another
- original file. This could be a security threat. Reported by
- Kjetil Kjernsmo <kjetil@kjernsmo.net>.
+ original file. This could be a security threat.
+ Reported by Kjetil Kjernsmo <kjetil@kjernsmo.net>.
Check for Emacs 21.3.50 removed.
* net/tramp-smb.el (all): Remove debug construct for
@@ -31395,7 +31383,7 @@
2005-03-07 Karl Chen <quarl@cs.berkeley.edu>
- * align.el (align-rules-list): Added an alignment rule for CSS
+ * align.el (align-rules-list): Add an alignment rule for CSS
declarations (applies to css-mode and html-mode buffers).
2005-03-07 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -32506,7 +32494,7 @@
(bibtex-field-list, bibtex-find-crossref): Fix typos in error messages.
2005-01-24 Dan Nicolaescu <dann@ics.uci.edu>
- Juri Linkov <juri@jurta.org>
+ Juri Linkov <juri@jurta.org>
* textmodes/reftex-global.el (reftex-isearch-push-state-function)
(reftex-isearch-pop-state-function, reftex-isearch-isearch-search)
@@ -32743,8 +32731,8 @@
* net/tramp-vc.el (tramp-vc-do-command, tramp-vc-do-command-new)
(tramp-vc-simple-command): Call `tramp-handle-shell-command' but
- `shell-command', because it isn't magic in XEmacs. Reported by
- Adrian Aichner <adrian@xemacs.org>.
+ `shell-command', because it isn't magic in XEmacs.
+ Reported by Adrian Aichner <adrian@xemacs.org>.
* net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add entry for
`substitute-in-file-name'.
@@ -33346,7 +33334,7 @@ See ChangeLog.11 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index bca8ce361bc..e88b8a993db 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -541,7 +541,7 @@
2008-02-01 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * ps-print.ps: Fix background height.
+ * ps-print.el: Fix background height.
(ps-print-version): New version 7.2.1.
2008-02-01 Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -636,7 +636,7 @@
2008-02-01 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * ps-print.el : Fix doc.
+ * ps-print.el: Fix doc.
(ps-print-version): New version 7.0.
2008-02-01 Kenichi Handa <handa@m17n.org>
@@ -3984,7 +3984,7 @@
* ibuffer.el (ibuffer-mode): Fix typo in previous change.
2008-01-17 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- Miles Bader <miles@gnu.org>
+ Miles Bader <miles@gnu.org>
* blank-mode.el: New file. Minor mode to visualize (HARD) SPACE,
TAB, NEWLINE. Miles Bader <miles@gnu.org> wrote the original code
@@ -5480,7 +5480,7 @@
(verilog-insert-indices): Escape braces in doc strings.
2007-12-08 Michael McNamara <mac@verilog.com>
- Wilson Snyder <wsnyder@wsnyder.org>
+ Wilson Snyder <wsnyder@wsnyder.org>
* progmodes/verilog-mode.el: New file.
@@ -13486,7 +13486,7 @@
Use native Emacs functions, when appropriate.
2007-08-01 Dan Nicolaescu <dann@ics.uci.edu>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* vc.el: Document new VC operation `extra-menu'.
@@ -16697,7 +16697,7 @@ See ChangeLog.12 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
+ Copyright (C) 2007-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index af7be079f46..a4f3f2fb87b 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -3016,12 +3016,12 @@
Don't activate node nil. (Bug#1569)
2009-01-22 Paul Reilly <pmr@pajato.com>
- Henrik Enberg <enberg@printf.se>
- Alex Schroeder <alex@gnu.org>
- Chong Yidong <cyd@stupidchicken.com>
- Richard M Stallman <rms@gnu.org>
- Glenn Morris <rgm@gnu.org>
- Juanma Barranquero <lekktu@gmail.com>
+ Henrik Enberg <enberg@printf.se>
+ Alex Schroeder <alex@gnu.org>
+ Chong Yidong <cyd@stupidchicken.com>
+ Richard M Stallman <rms@gnu.org>
+ Glenn Morris <rgm@gnu.org>
+ Juanma Barranquero <lekktu@gmail.com>
* mail/rmail.el: Code implementing Rmail-mbox functionality.
(rmail-attribute-header, rmail-keyword-header)
@@ -4314,7 +4314,7 @@
was orderly adjusted, nil otherwise.
2008-12-12 Juanma Barranquero <lekktu@gmail.com>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* server.el (server-sentinel): Uncomment code to delete connection file.
(server-start): Save the connection file in the server property list.
@@ -4373,7 +4373,7 @@
terminal variable assignment.
2008-12-10 Yukihiro Matsumoto <matz@ruby-lang.org>
- Nobuyoshi Nakada <nobu@ruby-lang.org>
+ Nobuyoshi Nakada <nobu@ruby-lang.org>
* progmodes/ruby-mode.el: New file.
@@ -5178,7 +5178,7 @@
* kmacro.el (kmacro-insert-counter): Doc fix.
-2008-11-21 Ivan Shmakov <oneingray@gmail.com> (tiny change)
+2008-11-21 Ivan Shmakov <oneingray@gmail.com>
* progmodes/tcl.el (tcl-filter): Don't forcibly move point.
@@ -5603,7 +5603,7 @@
New aliases, to satisfy `define-derived-mode' expectations.
2008-11-15 Glenn Morris <rgm@gnu.org>
- Martin Rudalics <rudalics@gmx.at>
+ Martin Rudalics <rudalics@gmx.at>
* emacs-lisp/find-func.el (find-function-advised-original): New.
(find-function-C-source, find-function-noselect):
@@ -7565,7 +7565,7 @@
2008-09-05 Wilson Snyder <wsnyder@wsnyder.org>
- * verilog-mode.el (verilog-library-extensions): Enable .sv
+ * progmodes/verilog-mode.el (verilog-library-extensions): Enable .sv
filename extensions to call verilog-mode.
(verilog-auto, verilog-auto-inst, verilog-faq)
(verilog-submit-bug-report): Update author support URLs.
@@ -7592,7 +7592,7 @@
2008-09-05 Michael McNamara <mac@mail.brushroad.com>
- * verilog-mode.el (verilog-beg-block-re-ordered, verilog-calc-1):
+ * progmodes/verilog-mode.el (verilog-beg-block-re-ordered, verilog-calc-1):
Better support for the property statement. Sometimes this keyword
introduces a statement which requires an endproperty keyword, and
sometimes it doesn't, depending on the work before the property
@@ -10312,8 +10312,8 @@
(newsticker--treeview-propertize-tag): Show item title in tooltip.
2008-06-20 Martin Blais <blais@furius.ca>
- Stefan Merten <smerten@oekonux.de>
- David Goodger <goodger@python.org>
+ Stefan Merten <smerten@oekonux.de>
+ David Goodger <goodger@python.org>
* textmodes/rst.el: New file.
@@ -10631,7 +10631,7 @@
* term/linux.el (terminal-init-linux): Load t-mouse.
2008-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
- Drew Adams <drew.adams@oracle.com>
+ Drew Adams <drew.adams@oracle.com>
* info.el (Info-breadcrumbs-depth): New var.
(Info-insert-breadcrumbs): New function.
@@ -11807,7 +11807,7 @@
2008-05-24 Ulf Jasper <ulf.jasper@web.de>
- * icalendar.el (icalendar-version): Increase to "0.19".
+ * calendar/icalendar.el (icalendar-version): Increase to "0.19".
(icalendar--date-style): New function.
(icalendar--datetime-to-diary-date): Doc fix.
Use icalendar--date-style.
@@ -13390,10 +13390,6 @@
(orgtbl-send-table): Use the previous two functions and implement
multiple destinations for each table.
- * doc/org.texi (A LaTeX example): Note that fmt may be a
- one-argument function, and efmt may be a two-argument function.
- (Radio tables): Document multiple destinations.
-
2008-04-27 Carsten Dominik <dominik@science.uva.nl>
* org/org-agenda.el (org-add-to-diary-list): New function.
@@ -13508,7 +13504,7 @@
2008-04-27 Andreas Schwab <schwab@suse.de>
- * Makefile.el: Unbreak bootstrap.
+ * Makefile.in: Unbreak bootstrap.
2008-04-27 Michael Albinus <michael.albinus@gmx.de>
@@ -18802,7 +18798,7 @@
for useful options.
2008-03-01 Dan Nicolaescu <dann@ics.uci.edu>
- Glenn Morris <rgm@gnu.org>
+ Glenn Morris <rgm@gnu.org>
* emacs-lisp/bytecomp.el (byte-recompile-directory)
(byte-compile-file, batch-byte-compile, batch-byte-compile-file):
@@ -20551,7 +20547,7 @@ See ChangeLog.13 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index afa2bce104e..9adac3ccb0c 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -578,6 +578,10 @@
* net/tramp.el (tramp-rfn-eshadow-setup-minibuffer): Do not use
`field' property of `rfn-eshadow-overlay'.
+2011-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-lisp/find-gc.el (find-gc-source-files): Remove filemode.c.
+
2011-02-21 Lars Ingebrigtsen <larsi@gnus.org>
* net/netrc.el (netrc-parse): Comment fix.
@@ -624,7 +628,7 @@
(global-auto-revert-ignore-buffer): Remove leading "*" from docs.
2011-02-19 Dmitry Bolshakov <dmitry.bolshakov@bridge-quest.com>
- Dima Kogan <dkogan@cds.caltech.edu> (tiny change)
+ Dima Kogan <dkogan@cds.caltech.edu> (tiny change)
* progmodes/hideshow.el (hs-find-block-beginning)
(hs-hide-level-recursive): Ignore comments when parsing braces
@@ -1416,7 +1420,6 @@
`special-mode-map'.
(package-menu-mode): Define using `define-derived-mode'
inheriting from `special-mode'.
- * erc/erc-list.el (erc-list-menu-mode): Inherit from `special-mode'.
* net/xesam.el (xesam-mode): Inherit from `special-mode'.
(xesam-mode-map): Define separately.
* play/solitaire.el (solitaire-mode): Inherit from `special-mode'.
@@ -2034,6 +2037,10 @@
Don't auto-indent for indent-to-left-margin, it's too often
counter-productive.
+2011-01-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * dired.el: Regenerate.
+
2011-01-16 Tassilo Horn <tassilo@member.fsf.org>
* strokes.el (strokes-read-stroke): Re-fill strokes buffer with
@@ -2963,7 +2970,7 @@
* loadup.el (symbol-file-load-history-loaded): Remove; unused.
2010-12-15 Jari Aalto <jari.aalto@cante.net>
- Scott Evans <gse@antisleep.com>
+ Scott Evans <gse@antisleep.com>
* rect.el (rectange--default-line-number-format)
(rectangle-number-line-callback): New functions.
@@ -5755,7 +5762,6 @@
* emacs-lisp/edebug.el (edebug-eval-mode-map):
* emacs-lisp/chart.el (chart-map):
* edmacro.el (edmacro-mode-map):
- * erc/erc-list.el (erc-list-menu-mode-map):
* array.el (array-mode-map): Declare and define in one step.
* vc/log-view.el (log-view-mode-map): Bind revert-buffer.
@@ -5790,18 +5796,18 @@
Enhance fontification of declarators to take account of the
presence/absence of "typedef".
- * cc-engine.el (c-forward-type): New &optional param
+ * progmodes/cc-engine.el (c-forward-type): New &optional param
"brace-block-too".
(c-forward-decl-or-cast-1): cdr of return value now indicates the
presence of either or both of a "struct"-like keyword and "typedef".
- * cc-fonts.el (c-complex-decl-matchers): Remove the heuristic
+ * progmodes/cc-fonts.el (c-complex-decl-matchers): Remove the heuristic
fontification of declarators which follow a "}".
(c-font-lock-declarations): Fontify declarators according to the
presence/absence of "typedef".
- * cc-langs.el (c-typedef-kwds c-typedef-key): New lang variable
- for "typedef".
+ * progmodes/cc-langs.el (c-typedef-kwds c-typedef-key):
+ New lang variable for "typedef".
(c-typedef-decl-key): New lang variable built from
c-typedef-decl-kwds.
@@ -7980,7 +7986,7 @@
* iswitchb.el (iswitchb-kill-buffer): Re-make the list.
2010-08-22 Kirk Kelsey <kirk.kelsey@0x4b.net>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/make-mode.el (makefile-fill-paragraph): Account for the
extra backslash added to each line (bug#6890).
@@ -8496,7 +8502,7 @@
* tutorial.el (help-with-tutorial): Hack safe file-local variables
after reading the tutorial.
-2010-08-06 Alan Mackenzie <bug-cc-mode@gnu.org>
+2010-08-06 Alan Mackenzie <acm@muc.de>
* progmodes/cc-cmds.el (c-mask-paragraph, c-fill-paragraph):
Fix for the case that a C style comment has its delimiters alone on
@@ -8838,9 +8844,9 @@
(sql-mode-menu): Add submenu to select connections.
(sql-interactive-mode-menu): Add "Save Connection" item.
(sql-add-product): Fix menu item.
- (sql-get-product-feature): Improved error handling.
+ (sql-get-product-feature): Improve error handling.
(sql--alt-buffer-part, sql--alt-if-not-empty): Remove.
- (sql-make-alternate-buffer-name): Simplified.
+ (sql-make-alternate-buffer-name): Simplify.
(sql-product-interactive): Handle missing product.
(sql-connect): Support string keys, minor improvements.
(sql-save-connection): New function.
@@ -8902,7 +8908,7 @@
(sql-connection-alist): New variable.
(sql-connect): New function.
(sql--alt-buffer-part, sql--alt-if-not-empty)
- (sql-make-alternate-buffer-name): Improved alternative buffer name.
+ (sql-make-alternate-buffer-name): Improve alternative buffer name.
2010-07-17 Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -8996,7 +9002,7 @@
another buffer (e.g gnus-art).
2010-07-13 Karl Fogel <kfogel@red-bean.com>
- Thierry Volpiatto <thierry.volpiatto@gmail.com>
+ Thierry Volpiatto <thierry.volpiatto@gmail.com>
Preparation for setting bookmarks in Gnus article buffers (Bug#5975).
@@ -9377,7 +9383,7 @@
`compose-mail-user-agent-warnings', instead of to the
nonexistent `compose-mail-check-user-agent'.
-2010-06-21 Alan Mackenzie <bug-cc-mode@gnu.org>
+2010-06-21 Alan Mackenzie <acm@muc.de>
Fix an indentation bug:
@@ -9386,7 +9392,7 @@
of existing values.
* progmodes/cc-engine.el (c-clear-<-pair-props-if-match-after)
- (c-clear->-pair-props-if-match-before): now return t when they've
+ (c-clear->-pair-props-if-match-before): Now return t when they've
cleared properties, nil otherwise.
(c-before-change-check-<>-operators): Set c-new-beg/end correctly
by taking account of the existing value.
@@ -10295,7 +10301,7 @@
(rcirc-user-name-history): Add variable.
2010-05-25 Ryan Yeske <rcyeske@gmail.com>
- Jonathan Rockway <jon@jrock.us>
+ Jonathan Rockway <jon@jrock.us>
* net/rcirc.el (rcirc-server-alist): Add :pass.
(rcirc): When prompting for connection parameters, also prompt for
@@ -10963,7 +10969,7 @@
* Version 23.2 released.
2010-05-07 Deniz Dogan <deniz.a.m.dogan@gmail.com>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
Highlight vendor specific properties.
* textmodes/css-mode.el (css-proprietary-nmstart-re): New var.
@@ -11156,7 +11162,7 @@
(filter-buffer-substring): Use it. Remove unused arg `noprops'.
2010-05-01 Toru TSUNEYOSHI <t_tuneyosi@hotmail.com>
- Michael Albinus <michael.albinus@gmx.de>
+ Michael Albinus <michael.albinus@gmx.de>
Implement compression for inline methods.
@@ -12145,7 +12151,7 @@
(version-list-not-zero, version<, version<=, version=): Doc fix.
(Bug#5744).
-2010-02-31 Dan Nicolaescu <dann@ics.uci.edu>
+2010-03-31 Dan Nicolaescu <dann@ics.uci.edu>
* vc.el (vc-root-diff): Doc fix.
@@ -12203,7 +12209,7 @@
values.
2010-03-29 Phil Hagelberg <phil@evri.com>
- Chong Yidong <cyd@stupidchicken.com>
+ Chong Yidong <cyd@stupidchicken.com>
* subr.el: Extend progress reporters to perform "spinning".
(progress-reporter-update, progress-reporter-do-update):
@@ -15597,7 +15603,7 @@
* Makefile.in (ELCFILES): Adapt to subword.el move.
2009-11-21 Thierry Volpiatto <thierry.volpiatto@gmail.com>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* bookmark.el (bookmark-bmenu-bookmark-column): Remove var.
(bookmark-bmenu-list): Save name on `bookmark-name-prop' text-prop.
@@ -18135,6 +18141,10 @@
* window.el (window-full-height-p): New function. (Bug#4543)
+2009-10-03 Chong Yidong <cyd@stupidchicken.com>
+
+ * files.el (auto-mode-alist): Add .srt and Project.ede.
+
2009-10-03 Dan Nicolaescu <dann@ics.uci.edu>
* vc.el: Remove commented out code.
@@ -19060,7 +19070,7 @@
indent buffer only if called interactively (Bug#4452).
2009-09-19 Juanma Barranquero <lekktu@gmail.com>
- Eli Zaretskii <eliz@gnu.org>
+ Eli Zaretskii <eliz@gnu.org>
This fixes bug#4197 (merged to bug#865, though not identical).
* server.el (server-auth-dir): Add docstring note about FAT32.
@@ -19877,7 +19887,7 @@
Don't call substitute-in-file-name on diary-file.
2009-09-03 Eduard Wiebe <usenet@pusto.de>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* mail/footnote.el (footnote-prefix): Make it a defcustom.
(footnote-mode-map): Move initialization into the declaration.
@@ -20988,7 +20998,7 @@
* progmodes/hideshow.el (hs-special-modes-alist): Add js-mode entry.
2009-08-14 Daniel Colascione <dan.colascione@gmail.com>
- Karl Landstrom <karl.landstrom@brgeight.se>
+ Karl Landstrom <karl.landstrom@brgeight.se>
* progmodes/js.el: New file.
@@ -22755,7 +22765,7 @@
XZ is the successor to LZMA: <http://tukaani.org/xz/>
2009-06-22 Dmitry Dzhus <dima@sphinx.net.ru>
- Nick Roberts <nickrob@snap.net.nz>
+ Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-mi.el: Pull further modified changes from Dmitry's
repository (http://sphinx.net.ru/hg/gdb-mi/).
@@ -22792,7 +22802,7 @@ See ChangeLog.14 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index 7692a0fffa8..bc5267aadba 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -1,6 +1,6 @@
2013-03-11 Glenn Morris <rgm@gnu.org>
- * Version 24.3 released.
+ * Merge in all changes up to version 24.3 release.
2013-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -63,7 +63,7 @@
2013-03-11 Michael R. Mauger <michael@mauger.com>
- * progmodes/sql.el Version 3.2
+ * progmodes/sql.el: Version 3.2
Please note that my address changed to <michael@mauger.com>;
the <mmaug@yahoo.com> address remains active.
(sql-connection-alist): Updates documentation to fix bug#13715.
@@ -902,7 +902,7 @@
(tmm-prompt): Use it to fix the menu order.
(tmm-get-keybind): Use current-active-maps.
-2013-02-12 Christopher Schmidt <christopher@ch.ristopher.com>
+2013-02-13 Christopher Schmidt <christopher@ch.ristopher.com>
Add dired-hide-details-mode. (Bug#6799)
@@ -965,7 +965,7 @@
2013-02-13 Yves Baumes <ybaumes@gmail.com> (tiny change)
- * lisp/emacs-lisp/package.el (package-menu-execute):
+ * emacs-lisp/package.el (package-menu-execute):
Add optional noquery argument. (Bug#13625)
2013-02-13 Michael Albinus <michael.albinus@gmx.de>
@@ -1408,7 +1408,7 @@
2013-01-30 Jay Belanger <jay.p.belanger@gmail.com>
- * calc-units.el (math-default-units-table): Remove initial value.
+ * calc/calc-units.el (math-default-units-table): Remove initial value.
(calc-convert-units): Treat expressions where all the units cancel as
if they didn't have units.
@@ -1437,9 +1437,9 @@
2013-01-29 Alan Mackenzie <acm@muc.de>
Amend to fontify /regexp/s in actions correctly.
- * cc-awk.el (c-awk-harmless-char-re, c-awk-harmless-string*-re):
- (c-awk-harmless-string*-here-re): Braces, parens and semicolons
- are no longer included.
+ * progmodes/cc-awk.el (c-awk-harmless-char-re)
+ (c-awk-harmless-string*-re, c-awk-harmless-string*-here-re):
+ Braces, parens and semicolons are no longer included.
(c-awk-harmless-line-char-re, c-awk-harmless-line-string*-re):
What used to be these variables without "-line" in the name.
(c-awk-neutral-re): { is no longer neutral. Escaped newlines now are.
@@ -2813,7 +2813,7 @@
2012-12-12 Jonas Bernoulli <jonas@bernoul.li>
- * lisp/emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115).
+ * emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115).
(eieio-override-prin1): Don't quote kewords and booleans.
(object-write) <eieio-default-superclass>: Don't put closing parens
on new line, avoid needless empty lines, align values that are objects
@@ -3340,7 +3340,7 @@
already registered with a different backend (Bug#10589).
2012-11-29 Jambunathan K <kjambunathan@gmail.com>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* icomplete.el: Change separator; add ido-style commands.
(icomplete-show-key-bindings): Remove custom var.
@@ -3730,7 +3730,8 @@
2012-11-19 Daniel Colascione <dancol@dancol.org>
* term/w32-win.el (cygwin-convert-path-from-windows):
- Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*.
+ Accommodate rename of cygwin_convert_path* to
+ cygwin_convert_file_name*.
2012-11-18 Chong Yidong <cyd@gnu.org>
@@ -4570,7 +4571,7 @@
to `bookmark' (bug#11131).
2012-10-26 Bastien Guerry <bzg@altern.org>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* face-remap.el: Use lexical-binding.
(text-scale-adjust): Improve docstring. Use itself for the temporary
@@ -5029,8 +5030,7 @@
* mouse.el (mouse-yank-primarY): Look for frame-type w32, not
system-type windows-nt.
- * server.el (server-create-window-system-frame): Look for window
- type.
+ * server.el (server-create-window-system-frame): Look for window type.
(server-proces-filter): Only force a window system when windows-nt
_and_ w32. Explain why.
@@ -5040,21 +5040,21 @@
* startup.el (command-line): Mark window system is initialized
after we've done it.
- * common-win.el (x-select-text): Look for w32, not windows-nt.
+ * term/common-win.el (x-select-text): Look for w32, not windows-nt.
- * ns-win.el: Require cl-lib. Add ourselves to
+ * term/ns-win.el: Require cl-lib. Add ourselves to
display-format-alist.
(ns-initialize-window-system): Assert we're not initialized twice.
- * w32-win.el: Enable lexical binding; require cl-lib; add
+ * term/w32-win.el: Enable lexical binding; require cl-lib; add
ourselves to display-format-alist.
(w32-handle-dropped-file): Convert incoming dropped files from
Windows paths to Cygwin ones before passing them on to the rest of
Emacs.
- (w32-drag-n-drop): New paramter new-frame. Simplify logic.
+ (w32-drag-n-drop): New parameter new-frame. Simplify logic.
(w32-initialize-window-system): Assert we're not initialized twice.
- * x-win.el: Require cl-lib; add ourselves to display-format-alist.
+ * term/x-win.el: Require cl-lib; add ourselves to display-format-alist.
(x-initialize-window-system): Assert we're not initialized twice.
* w32-common-fns.el: New File.
@@ -5878,7 +5878,7 @@
* international/uni-numeric.el: Regenerate.
2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org>
- Stefan Monnier <monnier@iro.umontreal.ca>
+ Stefan Monnier <monnier@iro.umontreal.ca>
* profiler.el: New file.
@@ -5893,8 +5893,8 @@
2012-09-25 Wilson Snyder <wsnyder@wsnyder.org>
- * verilog-mode.el (verilog-auto-ascii-enum, verilog-auto-inout)
- (verilog-auto-input, verilog-auto-insert-lisp)
+ * progmodes/verilog-mode.el (verilog-auto-ascii-enum)
+ (verilog-auto-inout, verilog-auto-input, verilog-auto-insert-lisp)
(verilog-auto-output, verilog-auto-output-every, verilog-auto-reg)
(verilog-auto-reg-input, verilog-auto-tieoff, verilog-auto-undef)
(verilog-auto-unused, verilog-auto-wire)
@@ -6750,7 +6750,7 @@
2012-09-09 Alan Mackenzie <acm@muc.de>
* progmodes/cc-engine.el (c-state-cache-init):
- Initialise c-state-semi-nonlit-pos-cache\(-limit\)? properly.
+ Initialize c-state-semi-nonlit-pos-cache\(-limit\)? properly.
(c-record-parse-state-state):
Record c-state-semi-nonlit-pos-cache\(-limit\)?.
@@ -7533,7 +7533,7 @@
In doc-strings state whether the argument window has to denote a
live, valid or any window.
-2012-08-16 Phil Sainty <psainty@orcon.net.nz> (tiny change)
+2012-08-16 Phil Sainty <psainty@orcon.net.nz>
* progmodes/subword.el (subword-forward-function)
(subword-backward-function, subword-forward-regexp)
@@ -7788,7 +7788,7 @@
(ruby-syntax-propertize-function): Adjust for changes in
`ruby-syntax-propertize-heredoc'.
-2012-08-09 Nobuyoshi Nakada <nobu@ruby-lang.org>
+2012-08-09 Nobuyoshi Nakada <nobu@ruby-lang.org>
* progmodes/ruby-mode.el (ruby-mode-map): Remove deprecated
binding (use `M-;' instead).
@@ -8100,7 +8100,7 @@
2012-08-04 Michal Nazarewicz <mina86@mina86.com>
- * lisp/mpc.el: Support password in host argument.
+ * mpc.el: Support password in host argument.
(mpc--proc-connect): Parse and use new password element.
Set mpc-proc variable instead of returning process.
(mpc-proc): Adjust accordingly.
@@ -8203,17 +8203,17 @@
2012-07-31 Jay Belanger <jay.p.belanger@gmail.com>
- * calc-mode.el (calc-basic-simplification-mode): Rename from
+ * calc/calc-mode.el (calc-basic-simplification-mode): Rename from
`calc-limited-simplification-mode'.
(calc-alg-simplification-mode): New function.
(calc-set-simplify-mode): Adjust message.
- * calc.el (calc-set-mode-line): Adjust mode line display for
+ * calc/calc.el (calc-set-mode-line): Adjust mode line display for
basic simplification mode.
- * calc-help.el (calc-m-prefix-help): Update help message.
+ * calc/calc-help.el (calc-m-prefix-help): Update help message.
- * calc-ext.el (calc-init-extensions): Add bindings and autoloads
+ * calc/calc-ext.el (calc-init-extensions): Add bindings and autoloads
for `calc-basic-simplify-mode' and `calc-alg-simplify-mode'.
2012-07-31 Bastien Guerry <bzg@gnu.org>
@@ -8500,7 +8500,7 @@
2012-07-25 Jay Belanger <jay.p.belanger@gmail.com>
- * calc-alg.el (math-simplify-divide): Don't cross multiply
+ * calc/calc-alg.el (math-simplify-divide): Don't cross multiply
in an equation when the lhs is a variable.
2012-07-24 Julien Danjou <julien@danjou.info>
@@ -15546,7 +15546,7 @@
c-set-fl-decl-start.
* progmodes/cc-mode.el (c-common-init, c-after-change):
- Changes due to pluralisation of c-before-font-lock-functions.
+ Changes due to pluralization of c-before-font-lock-functions.
(c-set-fl-decl-start): New function, extracted from
c-font-lock-enclosing-decls and enhanced.
@@ -15661,7 +15661,7 @@
(c-nonlabel-token-key): Allow string literals for AWK.
Refactor for the other modes.
- Large brace-block initialisation makes CC Mode slow: Fix.
+ Large brace-block initialization makes CC Mode slow: Fix.
Tidy up and accelerate c-in-literal, etc. by using the c-parse-state
routines. Limit backward searching in c-font-lock-enclosing.decl.
@@ -17099,7 +17099,7 @@
* vc/ediff-init.el (ediff-toggle-read-only-function):
Use toggle-read-only.
-2011-10-22 Alan Mackenzie <bug-cc-mode@gnu.org>
+2011-10-22 Alan Mackenzie <acm@muc.de>
Fix bug #9560, sporadic wrong indentation; improve instrumentation
of c-parse-state.
@@ -25223,7 +25223,7 @@ See ChangeLog.15 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2011-2013 Free Software Foundation, Inc.
+ Copyright (C) 2011-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
new file mode 100644
index 00000000000..8a255d756f1
--- /dev/null
+++ b/lisp/ChangeLog.17
@@ -0,0 +1,26311 @@
+2015-04-06 Alan Mackenzie <acm@muc.de>
+
+ Fix miscellaneous glitches in cc-mode.el. (Bug#20245)
+ * progmodes/cc-mode.el (c-common-init): bind
+ \(before\|after\)-change-functions to nil around invocations of
+ c-get-state-before-change-functions and
+ c-before-font-lock-functions to prevent recursive invocations.
+ (c-neutralize-syntax-in-and-mark-CPP): On c-beginning-of-macro,
+ check that point has actually moved back.
+ (c-fl-decl-start): Check whether c-beginning-of-decl-1 has
+ actually found a boundary (as contrasted with hitting a search
+ limit).
+
+2015-02-01 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Stop Font Lock forcing fontification from BOL.
+ * progmodes/cc-mode.el (c-font-lock-init): Setq
+ font-lock-extend-region-functions to nil. (Bug#19669)
+
+2015-04-06 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Do not break IPython magic completions. (Bug#19736)
+ * progmodes/python.el (python-shell-completion-setup-code):
+ Cleaner setup; import rlcompleter as last resource.
+
+2015-04-06 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Fix lack of "new" packages.
+ (package-menu--new-package-list)
+ (package-menu--old-archive-contents): No longer local.
+ (package-menu--list-to-prompt): New function.
+ (package-menu--prompt-transaction-p): Use "Upgrade" to make the
+ package-menu-execute prompt less verbose.
+
+2015-04-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fix for 'hfy-optimizations'
+ * htmlfontify.el (hfy-optimizations): Rename from hfy-optimisations,
+ with an obsolete alias. All uses changed.
+
+2015-04-06 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Enhance docstring detection following PEP-257.
+ * progmodes/python.el (python-docstring-at-p): Remove function.
+ (python-info-assignment-statement-p): New function.
+ (python-info-assignment-continuation-line-p): Use it.
+ (python-info-docstring-p): New function.
+ (python-font-lock-syntactic-face-function)
+ (python-fill-string): Use it.
+
+2015-04-05 Eli Zaretskii <eliz@gnu.org>
+
+ * ses.el (ses-sym-rowcol): Move up, before the first use, to avoid
+ byte-compiler warnings.
+
+2015-04-05 Alan Mackenzie <acm@muc.de>
+
+ * jit-lock.el (jit-lock-after-change): Widen the buffer only
+ whilst putting the 'fontified text properties.
+
+2015-04-05 Alan Mackenzie <acm@muc.de>
+
+ Rationalize use of c[ad]+r, expunging cl-c[ad]\{3,4\}r.
+ Also expunge eudc-c[ad]+r.
+ * subr.el (internal--compiler-macro-cXXr): "New" function,
+ copied from cl--compiler-macro-cXXr.
+ (caar, cadr, cdar, cddr): Change from defsubsts to defuns with
+ the above compiler-macro.
+ * net/eudc.el (eudc-cadr, eudc-cdar, eudc-caar, eudc-cdaar): Remove.
+ * emacs-lisp/cl.el (Top level dolist doing defaliases):
+ Remove caaar, etc., from list of new alias functions.
+ * emacs-lisp/cl-lib.el (cl-caaar, etc): Rename to caaar, etc.
+ (gen-cXXr--rawname, gen-cXXr-all-cl-aliases): New function/macro
+ which generate obsolete cl- aliases for caaar, etc. Invoke them.
+ * desktop.el, edmacro.el, emacs-lisp/cl-macs.el, frameset.el:
+ * ibuffer.el, mail/footnote.el, net/dbus.el, net/eudc-export.el:
+ * net/eudc.el, net/eudcb-ph.el, net/rcirc.el, net/secrets.el:
+ * play/5x5.el, play/decipher.el, play/hanoi.el, progmodes/hideif.el:
+ * ses.el: Replace cl-caaar, eudc-cadr, etc. with caaar and cadr, etc.
+
+2015-04-05 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-show-message-1): When displaying a mime message,
+ indicate start and finish in the echo area.
+
+ * mail/rmail.el (rmail-epa-decrypt): Disregard <pre> before armor.
+ Ignore more kinds of whitespace in mime headers.
+ Modify the decrypted mime part's mime type so it will be displayed
+ by default when visiting this message again.
+
+ * net/browse-url.el (browse-url-firefox-program): Prefer IceCat, doc.
+ (browse-url-firefox-arguments)
+ (browse-url-firefox-startup-arguments): Doc fix.
+
+2015-04-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Add package-initialize to user-init-file.
+ (package--ensure-init-file): New function.
+ (package-install, package-install-from-buffer): Use it.
+ (package-download-transaction, package-install-from-archive): Add
+ ASYNC and CALLBACK arguments.
+ (package-menu--prompt-transaction-p): New function.
+ (package-menu-execute): Use it to prompt the user about operations
+ to be executed.
+ (package-install): Add ASYNC and CALLBACK arguments.
+ (package-menu--perform-transaction): New function.
+ (package-menu-execute): Use it to install and delete packages.
+
+2015-04-05 Pete Williamson <petewil@chromium.org> (tiny-change)
+
+ Fix .emacs and .emacs.d/init file recursion problem for NaCl
+ * files.el (file-truename): Add NaCl to the exception list ms-dos uses.
+
+2015-04-04 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-mode.el (c-font-lock-init): Revert 2015-03-03 change
+ "Stop Font Lock forcing fontification from BOL." (Bug#20245)
+
+2015-04-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--download-and-read-archives): Add
+ `package-archives' to `package--downloads-in-progress' instead of
+ overwriting it.
+ (package--with-work-buffer-async): Protect macro arguments.
+ (package--download-one-archive)
+ (package--download-and-read-archives): Prevent
+ downloads-in-progress list from becoming outdated.
+
+2015-04-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-directory-property): Quote directory
+ name when used in regexp.
+
+2015-04-04 Alan Mackenzie <acm@muc.de>
+
+ * jit-lock.el (jit-lock-after-change): Widen the buffer before
+ putting 'fontified text properties. (Bug#20240)
+
+2015-04-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-file-property)
+ (tramp-flush-directory-property): Use `directory-file-name' of the
+ truename. (Bug#20249)
+
+2015-04-03 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * pcmpl-unix.el (pcmpl-ssh-known-hosts): Use `char-before' instead
+ of `looking-back' (bug#17284).
+
+2015-04-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-indent-line): Do nothing when bol is inside
+ a string (https://github.com/mooz/js2-mode/issues/227).
+
+2015-04-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * abbrev.el (define-abbrev-table): Treat a non-string "docstring" as
+ part of the "props" arguments rather than silently ignoring it.
+
+ * emacs-lisp/lisp-mnt.el (lm-version): Don't burp in a non-file buffer.
+
+2015-04-01 Alan Mackenzie <acm@muc.de>
+
+ Fix the CC Mode fixes from 2015-03-30. (Bug#20240)
+ * progmodes/cc-mode.el (c-extend-after-change-region):
+ Widen before applying text properties.
+ * progmodes/cc-langs.el (c-before-font-lock-functions):
+ Update an entry to a new function name.
+
+2015-04-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-lisp/package.el: Spelling fixes and use active voice.
+
+2015-04-01 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Implement asynchronous refreshing.
+ (package--with-work-buffer-async)
+ (package--check-signature-content)
+ (package--update-downloads-in-progress): New functions.
+ (package--check-signature, package--download-one-archive)
+ (package--download-and-read-archives, package-refresh-contents):
+ Optional arguments for async usage.
+ (package--post-download-archives-hook): New variable. Hook run
+ after every refresh.
+
+ * emacs-lisp/package.el: Make package-menu asynchronous.
+ (package-menu-async): New variable. Controls whether
+ `list-packages' is asynchronous.
+ (list-packages): Now asynchronous by default.
+ (package-menu--new-package-list): Always buffer-local.
+ (package-menu--post-refresh)
+ (package-menu--find-and-notify-upgrades)
+ (package-menu--populate-new-package-list): New functions.
+
+2015-03-31 Simen Heggestøyl <simenheg@gmail.com>
+
+ * textmodes/css-mode.el (css-mode): Derive from `prog-mode'.
+
+2015-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * jit-lock.el (jit-lock--run-functions): Fix min/max copy&paste error.
+
+ Let jit-lock know the result of font-lock-extend-region-functions.
+ * jit-lock.el (jit-lock--run-functions): New function.
+ (jit-lock-fontify-now): Use it. Handle fontification bounds more
+ precisely in case the backend functions fontify more than requested.
+ Don't round up to whole lines since that shouldn't be needed
+ any more.
+ * font-lock.el (font-lock-fontify-region-function): Adjust docstring.
+ (font-lock-inhibit-thing-lock): Make obsolete.
+ (font-lock-default-fontify-region): Return the bounds actually used.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
+ Fix compilation error.
+
+2015-03-30 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el: Reorganize package.el and divide it with
+ page-breaks and comments.
+
+2015-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-base.el (make-instance) <eieio-named>: New instance
+ which stores the old-style object name argument into the
+ object-name field.
+
+2015-03-30 Alan Mackenzie <acm@muc.de>
+
+ Correct calculation of CC Mode's font-lock region.
+ * progmodes/cc-mode.el (c-fl-decl-start): Rename from
+ c-set-fl-decl-start. Change signature such that nil is returned
+ when no declaration is found.
+ (c-change-expand-fl-region): Rename from
+ c-change-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-context-expand-fl-region): Rename from
+ c-context-set-fl-decl-start. This now also handles expanding the
+ font lock region to whole lines.
+ (c-font-lock-fontify-region): When a change font lock region is
+ spuriously enlarged to the beginning-of-line by jit-lock, fontify
+ the extra bit separately from the region calculated by CC Mode.
+ (c-extend-after-change-region): Explicitly apply 'fontified
+ properties to the extended bits of the font lock region.
+ * progmodes/cc-langs.el (c-before-font-lock-functions)
+ (c-before-context-fontification-functions): Use new names for
+ existing functions (see above).
+
+2015-03-30 Richard Ryniker <ryniker@alum.mit.edu> (tiny change)
+
+ * mail/sendmail.el (sendmail-send-it): Do not attempt to switch
+ to non-existent buffer (errbuf is not created when customization
+ variable mail-interactive is nil). (Bug#20211)
+
+2015-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-backward-sexp-command)
+ (smie-forward-sexp-command): Don't pretend the arg is optional
+ (bug#20205).
+
+2015-03-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Detect regexps after `!'. (Bug#19285)
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Use `font-lock-constant-face' for nil, true and false.
+ Highlight `self' as a keyword. (Bug#17733)
+
+2015-03-29 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Expect beginning of regexp also after open brace or vertical bar.
+ (Bug#20026)
+
+2015-03-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacs-lisp/package.el (package-refresh-contents): Fix spelling
+ error in previous change.
+
+2015-03-28 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * elec-pair.el (electric-pair-local-mode): New command.
+ (electric-pair-mode): Mention `electric-pair-local-mode' in the
+ docstring.
+
+2015-03-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * emacs-lisp/package.el (package-refresh-contents): Add a message at
+ the end so it does not appear to have hanged (Bug#17879).
+
+2015-03-27 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * font-lock.el (font-lock--remove-face-from-text-property):
+ New function. Adapted from the previously commented out
+ remove-single-text-property.
+ Remove previously unused and commented out auxiliary function
+ remove-text-property and obsolete comment.
+ * comint.el (comint-output-filter): Use it to remove
+ comint-highlight-prompt.
+ (comint-snapshot-last-prompt, comint-output-filter):
+ Use font-lock-prepend-text-property for comint-highlight-prompt.
+ (Bug#20084)
+
+2015-03-26 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/python.el
+ (python-indent-guess-indent-offset-verbose): New defcustom.
+ (python-indent-guess-indent-offset): Use it.
+
+2015-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Change internal name so as to make
+ sure only EIEIO files should have "eieio--" prefixes in their .elc.
+
+ * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Silence byte-compiler.
+
+2015-03-26 Boruch Baum <boruch_baum@gmx.com> (tiny change)
+
+ * bookmark.el (bookmark-show-all-annotations): Sort them (bug#20177).
+
+2015-03-25 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-special-chars): Don't treat `/' specially, there's
+ no need to.
+ (json-encode-string): Only escape quotation mark, backslash and
+ the control characters U+0000 to U+001F.
+
+2015-03-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
+ Don't complain about args starting with _.
+
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-cmds.el (mule--ucs-names-annotation): New func.
+ (read-char-by-name): Use it.
+
+ * xt-mouse.el (xterm-mouse--read-number-from-terminal): Fix last commit.
+
+2015-03-25 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el: Documentation improvements.
+
+2015-03-25 Glenn Morris <rgm@gnu.org>
+
+ * net/browse-url.el (browse-url-browser-function)
+ (browse-url-default-browser):
+ Remove obsolete items from the explicit listing.
+ (browse-url-new-window-flag, browse-url-of-file-hook): Doc fixes.
+ (browse-url-netscape-program, browse-url-netscape-arguments)
+ (browse-url-netscape-startup-arguments)
+ (browse-url-galeon-program, browse-url-galeon-arguments)
+ (browse-url-galeon-startup-arguments)
+ (browse-url-gnome-moz-program, browse-url-gnome-moz-arguments)
+ (browse-url-galeon-new-window-is-tab)
+ (browse-url-netscape-new-window-is-tab)
+ (browse-url-mosaic-program, browse-url-mosaic-arguments)
+ (browse-url-mosaic-pidfile, browse-url-CCI-port)
+ (browse-url-CCI-host, browse-url-netscape-version)
+ (browse-url-netscape, browse-url-netscape-sentinel)
+ (browse-url-netscape-reload, browse-url-netscape-send)
+ (browse-url-galeon, browse-url-galeon-sentinel)
+ (browse-url-gnome-moz, browse-url-mosaic, browse-url-cci)
+ (browse-url-w3-gnudoit): Make obsolete.
+ * ffap.el (ffap-url-fetcher): Simplify default and doc.
+
+2015-03-25 Olaf Rogalsky <olaf.rogalsky@gmail.com>
+
+ * xt-mouse.el: Add mouse-tracking support (bug#19416).
+ (xterm-mouse-translate-1): Handle mouse-movement events.
+ (xterm-mouse--read-event-sequence-1000)
+ (xterm-mouse--read-event-sequence-1006): Delete functions.
+ (xterm-mouse--read-event-sequence): New function that handles both at
+ the same time. Handle mouse-movements.
+ (xterm-mouse--read-utf8-char, xterm-mouse--read-number-from-terminal):
+ New functions.
+ (xterm-mouse-event): Simplify.
+ (xterm-mouse-tracking-enable-sequence)
+ (xterm-mouse-tracking-disable-sequence): Enable mouse tracking.
+
+ * mouse.el (mouse-drag-line): Also ignore `vertical-line' prefix events.
+
+2015-03-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-file-attributes-with-ls)
+ (tramp-do-file-attributes-with-stat): Quote file names in output.
+ (tramp-do-directory-files-and-attributes-with-stat): Use "//" as marker.
+
+2015-03-24 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-start-generate-key): Fix typo in "gpg --gen-key"
+ invocation; make the PARAMETERS documentation clearer.
+
+2015-03-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add cl-struct specific optimizations to pcase.
+ * emacs-lisp/cl-macs.el (cl--struct-all-parents)
+ (cl--pcase-mutually-exclusive-p): New functions.
+ (pcase--mutually-exclusive-p): Advise to optimize cl-struct patterns.
+
+ * emacs-lisp/pcase.el (pcase--split-pred): Handle quoted string.
+
+2015-03-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add new `cl-struct' and `eieio' pcase patterns.
+ * emacs-lisp/cl-macs.el (cl-struct): New pcase pattern.
+ * emacs-lisp/eieio.el (eieio-pcase-slot-index-table)
+ (eieio-pcase-slot-index-from-index-table): New functions.
+ (eieio): New pcase pattern.
+ * emacs-lisp/pcase.el (pcase--make-docstring): New function.
+ (pcase): Use it to build the docstring.
+ (pcase-defmacro): Make sure the macro is lazy-loaded.
+ (\`): Move its docstring from `pcase'.
+
+2015-03-23 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases)
+ (authors-obsolete-files-regexps): Additions.
+
+2015-03-23 Jan Djärv <jan.h.d@swipnet.se>
+
+ * simple.el (deactivate-mark): Only modify PRIMARY if we own
+ PRIMARY (Bug#18939).
+
+2015-03-23 Martin Rudalics <rudalics@gmx.at>
+
+ * emacs-lisp/debug.el (debug): Don't try using "previous" window
+ when its not live or on an invisible frame (Bug#17170).
+
+2015-03-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-decode-char0): Delete this alias as well.
+ (json-read-escaped-char): Don't call it (bug#20154).
+
+2015-03-23 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/lisp-mode.el (lisp--el-non-funcall-position-p): New function.
+ (lisp--el-match-keyword): Use it.
+
+2015-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * subr.el (start-process): New function, ported from the C
+ implementation.
+
+2015-03-23 Daniel Colascione <dancol@dancol.org>
+
+ Automatically adjust process window sizes.
+
+ * window.el (window-adjust-process-window-size-function):
+ New customizable variable.
+ (window-adjust-process-window-size)
+ (window-adjust-process-window-size-smallest)
+ (window-adjust-process-window-size-largest)
+ (window--process-window-list, window--adjust-process-windows):
+ New functions.
+ (window-configuration-change-hook):
+ Add `window--adjust-process-windows'.
+ * term.el (term-mode): Observe result of
+ `window-adjust-process-window-size-function'.
+ (term-check-size): Delete.
+
+2015-03-22 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * textmodes/sgml-mode.el (sgml-attribute-offset): New defcustom.
+ (sgml-calculate-indent): Use `sgml-attribute-offset' for attribute
+ indentation (bug#20161).
+
+2015-03-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * json.el (json-encode-char0): Delete this alias.
+ (json-encode-string): Rewrite to improve performance (bug#20154).
+ (json-encode-char): Fold into `json-encode-string'.
+
+2015-03-22 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * menu-bar.el (menu-bar-update-buffers): Count displayed buffers
+ for `buffers-menu-max-size', not total buffers.
+
+2015-03-21 Titus von der Malsburg <malsburg@posteo.de>
+
+ * window.el (window-font-width, window-font-height)
+ (window-max-chars-per-line): New functions.
+
+ * simple.el (default-font-height): Doc fix.
+ (default-font-width): New function.
+
+2015-03-21 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Also recognize (cl-)defmethod with (setf method) name.
+
+2015-03-20 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-1):
+ Fix false positive in function name font-locking.
+ (lisp-cl-font-lock-keywords-1): Ditto.
+
+2015-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defsubst): Ignore false-positive
+ occurrences of args via &cl-defs (bug#20149).
+
+2015-03-20 Alan Mackenzie <acm@muc.de>
+
+ Fix Bug#20146
+
+ * font-lock.el (font-lock-extend-jit-lock-region-after-change):
+ Return the calculated values, as per spec.
+
+2015-03-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `at_exit'
+ and `callcc' to the "methods with required arguments" section,
+ they need a block argument. Remove a `throw' duplicate.
+
+2015-03-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * progmodes/cperl-mode.el (cperl-electric-backspace):
+ Call delete-backward-space interactively instead of delete-char.
+
+2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase-lambda): Rewrite.
+
+ * emacs-lisp/eieio.el (object-slots): Return slot names as before
+ (bug#20141).
+
+2015-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ EIEIO: Change class's representation to unify instance and class slots
+ * emacs-lisp/eieio-core.el (eieio--class): Change field names and order
+ to match those of cl--class; use cl--slot for both instance slots and
+ class slots.
+ (eieio--object-num-slots): Use cl-struct-slot-info.
+ (eieio--object-class): Rename from eieio--object-class-object.
+ (eieio--object-class-name): Remove.
+ (eieio-defclass-internal): Adjust to new slot representation.
+ Store doc in class rather than in `variable-documentation'.
+ (eieio--perform-slot-validation-for-default): Change API to take
+ a slot object.
+ (eieio--slot-override): New function.
+ (eieio--add-new-slot): Rewrite.
+ (eieio-copy-parents-into-subclass): Rewrite.
+ (eieio--validate-slot-value, eieio--validate-class-slot-value)
+ (eieio-oref-default, eieio-oset-default)
+ (eieio--class-slot-name-index, eieio-set-defaults): Adjust to new
+ slot representation.
+ (eieio--c3-merge-lists): Simplify.
+ (eieio--class/struct-parents): New function.
+ (eieio--class-precedence-bfs): Use it.
+
+ * emacs-lisp/eieio.el (with-slots): Use macroexp-let2.
+ (object-class-fast): Change recommend replacement.
+ (eieio-object-class): Rewrite.
+ (slot-exists-p): Adjust to new slot representation.
+ (initialize-instance): Adjust to new slot representation.
+ (object-write): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-opt.el (eieio--help-print-slot): New function
+ extracted from eieio-help-class-slots.
+ (eieio-help-class-slots): Use it. Adjust to new slot representation.
+
+ * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots):
+ Declare to silence warnings.
+ (data-debug-insert-object-button): Avoid `object-slots'.
+ (data-debug/eieio-insert-slots): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-custom.el (eieio-object-value-create)
+ (eieio-object-value-get): Adjust to new slot representation.
+
+ * emacs-lisp/eieio-compat.el
+ (eieio--generic-static-symbol-specializers):
+ Extract from eieio--generic-static-symbol-generalizer.
+ (eieio--generic-static-symbol-generalizer): Use it.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object):
+ Manually map initargs to slot names.
+ (eieio-persistent-validate/fix-slot-value): Adjust to new
+ slot representation.
+
+ * emacs-lisp/cl-preloaded.el (cl--class): Fix type of `parents'.
+
+2015-03-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * leim/quail/hangul.el (hangul-delete-backward-char)
+ (hangul-to-hanja-conversion):
+ * progmodes/cperl-mode.el (cperl-electric-keyword)
+ (cperl-electric-backspace): Use delete-char instead of
+ delete-backward-char, fixes compilation warnings.
+
+2015-03-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat):
+ Mark apostrophs with ?/ instead of \037. (Bug#20117)
+
+2015-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add classes as run-time descriptors of cl-structs.
+ * emacs-lisp/cl-preloaded.el (cl--struct-get-class): New function.
+ (cl--make-slot-desc): New constructor.
+ (cl--plist-remove, cl--struct-register-child): New functions.
+ (cl-struct-define): Rewrite.
+ (cl-structure-class, cl-structure-object, cl-slot-descriptor)
+ (cl--class): New structs.
+ (cl--struct-default-parent): Initialize it here.
+ * emacs-lisp/cl-macs.el (cl--find-class): New macro.
+ (cl-defsubst, cl--defsubst-expand, cl--sublis): Move before first use.
+ (cl--struct-default-parent): New var.
+ (cl-defstruct): Adjust to new representation of classes; add
+ default parent. In accessors, signal `wrong-type-argument' rather than
+ a generic error.
+ (cl-struct-sequence-type, cl-struct-slot-info)
+ (cl-struct-slot-offset): Rewrite.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-specializers)
+ (cl-generic-generalizers): Rewrite.
+
+ * emacs-lisp/macroexp.el (macroexp--debug-eager): New var.
+ (internal-macroexpand-for-load): Use it.
+
+ * emacs-lisp/debug.el (debug--implement-debug-on-entry):
+ Bind inhibit-debug-on-entry here...
+ (debug): Instead of here.
+
+2015-03-18 Dima Kogan <dima@secretsauce.net>
+
+ Have gud-display-line not display source buffer in gud window.
+ * progmodes/gud.el (gud-display-line): Make display-buffer
+ not reuse selected window. (Bug#17675, Bug#19901, Bug#20034)
+
+2015-03-17 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/byte-run.el (macro-declarations-alist):
+ New declaration no-font-lock-keyword.
+ (defmacro): Flush font-lock in existing elisp buffers.
+
+ * emacs-lisp/lisp-mode.el (lisp--el-update-after-load)
+ (lisp--el-update-macro-regexp, lisp--el-macro-regexp):
+ Delete functions and defconst.
+ (lisp--el-match-keyword): Rename from lisp--el-match-macro.
+ (lisp--el-font-lock-flush-elisp-buffers): New function.
+ (lisp-mode-variables): Remove code for updating
+ lisp--el-macro-regexp, and add
+ lisp--el-font-lock-flush-elisp-buffers to after-load-functions.
+
+2015-03-17 Simen Heggestøyl <simenheg@gmail.com>
+
+ * textmodes/css-mode.el (css--font-lock-keywords):
+ Discriminate between pseudo-classes and pseudo-elements.
+ (css-pseudo-ids): Remove.
+ (css-pseudo-class-ids, css-pseudo-element-ids): New variables.
+ (css--complete-property): New function for completing CSS properties.
+ (css--complete-pseudo-element-or-class): New function
+ completing CSS pseudo-elements and pseudo-classes.
+ (css--complete-at-rule): New function for completing CSS at-rules.
+ (css-completion-at-point): New function.
+ (css-mode): Add support for completion.
+ (css-extract-keyword-list, css-extract-parse-val-grammar)
+ (css-extract-props-and-vals): Remove function in favor of manual
+ extraction.
+ (css-at-ids): Update list of CSS at-rule ids.
+ (css-property-ids): Update list of CSS properties.
+
+2015-03-17 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Font-lock
+ more Kernel methods.
+
+2015-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-maybe-send-script): Avoid leading tabs in
+ shell scripts. (Bug#20118)
+
+2015-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ * mouse.el (mouse-appearance-menu): If w32-use-w32-font-dialog is
+ nil, construct a menu of fixed fonts. This resurrects a feature
+ lost in Emacs 23.
+
+ * w32-vars.el (w32-use-w32-font-dialog): Add a ':set' function to
+ reset mouse-appearance-menu-map, so the font dialog is recomputed
+ the next time the menu is requested.
+ (w32-fixed-font-alist): Fix to use correct names of Courier fonts.
+
+2015-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Refine last change
+ (bug#20125).
+
+2015-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-ssh-controlmaster-options): Change test
+ for ControlPath in order to avoid DNS timeouts. (Bug#20015)
+
+2015-03-16 Alan Mackenzie <acm@muc.de>
+
+ Edebug: Allow "S" to work during trace mode. Fixes Bug#20074.
+ Also display the overlay arrow in go and go-nonstop modes.
+
+ * emacs-lisp/edebug.el (edebug--display-1): Move the
+ `input-pending' test to after trace mode's `sit-for'.
+ (edebug--recursive-edit): Insert "(sit-for 0)" after
+ "(edebug-overlay-arrow)".
+
+2015-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Rework to avoid
+ cl--do-arglist in more cases; add comments to explain what's going on.
+ (cl--do-&aux): New function extracted from cl--do-arglist.
+ (cl--do-arglist): Use it.
+
+ * emacs-lisp/cl-generic.el: Add Version: header, for ELPA purposes.
+
+ * obsolete/iswitchb.el (iswitchb-read-buffer): Add `predicate' arg.
+ * isearchb.el (isearchb-iswitchb): Adjust accordingly.
+ * ido.el (ido-read-buffer): Add `predicate' argument.
+ * misearch.el (unload-function-defs-list): Declare before use.
+
+2015-03-16 Vibhav Pant <vibhavp@gmail.com>
+
+ * net/browse-url.el (browse-url-browser-function): Add "Conkeror".
+ (browse-url-conkeror-program, browse-url-conkeror-arguments)
+ (browse-url-conkeror-new-window-is-buffer): New defcustoms.
+ (browse-url-default-browser): Check for `browse-url-conkeror'
+ and call `browse-url-conkeror-program'.
+ (browse-url-conkeror): New command.
+ (bug#19863)
+
+2015-03-16 Vibhav Pant <vibhavp@gmail.com>
+
+ * eshell/esh-mode.el (eshell/clear): New function.
+
+2015-03-16 Alan Mackenzie <acm@muc.de>
+
+ Make Edebug work with Follow Mode.
+
+ * emacs-lisp/edebug.el (edebug--display-1): Remove call to
+ edebug-adjust-window.
+ (edebug--recursive-edit): Don't bind pre/post-command-hooks to nil
+ over the recursive edit.
+ (edebug-adjust-window): Remove.
+
+2015-03-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el:
+ * net/tramp-gvfs.el:
+ * net/tramp-sh.el:
+ * net/tramp-smb.el: Set tramp-autoload cookie for all defcustoms.
+
+ * net/tramp.el (tramp-ssh-controlmaster-options)
+ (tramp-use-ssh-controlmaster-options): Move them to tramp-sh.el.
+ (tramp-default-method): Do not check for
+ `tramp-ssh-controlmaster-options'.
+
+ * net/tramp-sh.el (tramp-use-ssh-controlmaster-options):
+ New defcustom, moved from tramp.el.
+ (tramp-ssh-controlmaster-options): New defvar, moved from tramp.el
+ but with a nil initial value.
+ (tramp-ssh-controlmaster-options): New defun.
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection): Use it. (Bug#20015)
+
+2015-03-15 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp--el-macro-regexp): New defconst.
+ (lisp--el-update-macro-regexp, lisp--el-update-after-load)
+ (lisp--el-match-macro): New functions.
+ (lisp-mode-variables): Update lisp--el-macro-regexp and add
+ lisp--el-update-after-load to after-load-functions.
+
+2015-03-15 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-indent.el
+ (lisp-indent-backquote-substitution-mode): New user option.
+ (common-lisp-indent-function-1, common-lisp-loop-part-indentation)
+ (common-lisp-indent-function): Support normally indenting
+ backquote substitutions.
+ (extended-loop-p): Rename to `lisp-extended-loop-p'.
+
+2015-03-14 Michael R. Mauger <michael@mauger.com>
+
+ * progmodes/sql.el: Version 3.5
+ (sql-starts-with-prompt-re, sql-ends-with-prompt-re): Match password prompts.
+ (sql-interactive-remove-continuation-prompt): Fix regression. (Bug#6686)
+
+2015-03-14 Daniel Colascione <dancol@dancol.org>
+
+ * widget.el (define-widget): Check that documentation is a string
+ or nil; prevent wailing and gnashing of teeth when users forget to
+ pass a docstring and wonder why their properties don't work.
+
+ * startup.el (command-line): Process "--no-x-resources".
+
+2015-03-13 Kevin Ryde <user42_kevin@yahoo.com.au>
+
+ info-look fixes for Texinfo 5
+ * info-look.el (c-mode, bison-mode, makefile-mode)
+ (makefile-automake-mode, texinfo-mode, autoconf-mode, awk-mode)
+ (latex-mode, emacs-lisp-mode, sh-mode, cfengine-mode):
+ Match `foo' and 'foo' and ‘foo’ for @item and similar.
+ (latex-mode): Match multi-arg \frac{num}{den} or \sqrt[root]{n} in
+ suffix regexp.
+
+2015-03-12 Juri Linkov <juri@linkov.net>
+
+ * simple.el (next-line-or-history-element)
+ (previous-line-or-history-element): Remember the goal column of
+ possibly multi-line input, and restore it afterwards. (Bug#19824)
+
+2015-03-12 Rasmus Pank Roulund <emacs@pank.eu>
+
+ * ido.el (ido-add-virtual-buffers-to-list): Include bookmark-alist
+ files (bug#19335).
+
+2015-03-12 Eli Zaretskii <eliz@gnu.org>
+
+ * international/fontset.el (script-representative-chars): Add a
+ representative character for 'vai'.
+
+2015-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/quail.el (quail-input-method):
+ Use with-silent-modifications.
+
+ * simple.el (goto-history-element): Don't burp on t history.
+
+2015-03-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer "initialize" to "initialise"
+ * progmodes/js.el (js-indent-first-init):
+ Rename from js-indent-first-initialiser, to avoid worrying about
+ American vs British spelling. All uses changed.
+
+2015-03-10 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/js.el (js-indent-first-initialiser):
+ Fix doc, type, version.
+
+2015-03-10 Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+
+ * progmodes/js.el (js-indent-first-initialiser): New option.
+ (js--maybe-goto-declaration-keyword-end): New function.
+ (js--proper-indentation): Use js--maybe-goto-declaration-keyword-end.
+
+2015-03-10 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-attribute-syntaxes-alist): Add LDAP attributes
+ from RFC2798 Section 9.1.1. (Bug#8983)
+
+2015-03-09 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-into): New function.
+ Bump seq.el version to 1.3.
+
+2015-03-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Don't consider
+ `=' a part of symbol when followed by `>'. (Bug#18644)
+ (ruby-syntax-before-regexp-re): Detect regexps after `!'.
+ (Bug#19285)
+
+2015-03-09 Eli Zaretskii <eliz@gnu.org>
+
+ * dired.el (dired-delete-file): Doc fix. (Bug#20021)
+
+2015-03-06 Sergio Durigan Junior <sergiodj@sergiodj.net>
+ Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-bbdb.el (eudc-bbdb-field): New function.
+ (eudc-bbdb-filter-non-matching-record): Call eudc-bbdb-field.
+ (eudc-bbdb-format-record-as-result): Likewise.
+
+2015-03-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Use `font-lock-constant-face' for nil, true and false.
+ Highlight `self' as a keyword. (Bug#17733)
+
+2015-03-08 Nobuyoshi Nakada <nobu@ruby-lang.org>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Expect beginning of regexp also after open brace or vertical bar.
+ (Bug#20026)
+
+2015-03-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * battery.el (battery-echo-area-format): Simplify default.
+ (battery-linux-sysfs): Standardize on energy&power. Accept ADP1
+ for AC adapter.
+
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't try to
+ unfold `closure's since byte-compile-unfold-lambda doesn't know how to
+ do it.
+
+2015-03-06 Oscar Fuentes <ofv@wanadoo.es>
+
+ * net/browse-url.el (browse-url-firefox): Remove outdated
+ MS-Windows limitations.
+
+2015-03-06 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple): Mark as
+ obsolete.
+ (eudc-ldap-cleanup-record-filtering-addresses): Add docstring.
+ Don't clean up postal addresses if ldap-ignore-attribute-codings
+ is set. Combine mail addresses into one field. (Bug#17720)
+ (eudc-ldap-simple-query-internal):
+ Call eudc-ldap-cleanup-record-filtering-addresses instead of
+ eudc-ldap-cleanup-record-simple.
+ (eudc-ldap-get-field-list): Likewise.
+
+2015-03-05 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-html-p): New function (bug#20009).
+ (eww-render): Use it.
+
+2015-03-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * desktop.el (desktop-buffer-info): Write docstring.
+ (desktop-buffer-info): Use `pushnew' instead of `add-to-list' and
+ unquote lamda.
+
+ * emacs-lisp/package.el (package-refresh-contents): Update doc.
+
+2015-03-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-mode-syntax-table): Add an entry for `.
+
+2015-03-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Replace *-function vars with generic functions in cl-generic.
+ * emacs-lisp/cl-generic.el (cl--generic-generalizer): New struct.
+ (cl-generic-tagcode-function, cl-generic-tag-types-function): Remove.
+ (cl--generic-t-generalizer): New const.
+ (cl--generic-make-method): Rename from `cl--generic-method-make'.
+ (cl--generic-make): Change calling convention.
+ (cl--generic): Add `options' field.
+ (cl-generic-function-options): New function.
+ (cl-defgeneric): Rewrite handling of options. Add support for :method
+ options and allow the use of a default body.
+ (cl-generic-define): Save options in the corresponding new field.
+ (cl-defmethod): Fix ordering of qualifiers.
+ (cl-generic-define-method): Use cl-generic-generalizers.
+ (cl--generic-get-dispatcher): Change calling convention, and change
+ calling convention of the returned function as well so as to take the
+ list of methods separately from the generic function object, so that it
+ can receive the original generic function object.
+ (cl--generic-make-next-function): New function, extracted from
+ cl--generic-make-function.
+ (cl--generic-make-function): Use it.
+ (cl-generic-method-combination-function): Remove.
+ (cl--generic-cyclic-definition): New error.
+ (cl-generic-call-method): Take a generic function object rather than
+ its name.
+ (cl-method-qualifiers): New alias.
+ (cl--generic-build-combined-method): Use cl-generic-combine-methods,
+ don't segregate by qualifiers here any more.
+ (cl--generic-standard-method-combination): Segregate by qualifiers
+ here instead. Add support for the `:extra' qualifier.
+ (cl--generic-cache-miss): Move earlier, adjust to new calling convention.
+ (cl-generic-generalizers, cl-generic-combine-methods):
+ New generic functions.
+ (cl-no-next-method, cl-no-applicable-method, cl-no-primary-method):
+ Use the new "default method in defgeneric" functionality, change
+ calling convention to receive a generic function object.
+ (cl--generic-head-used): New var.
+ (cl--generic-head-generalizer, cl--generic-eql-generalizer)
+ (cl--generic-struct-generalizer, cl--generic-typeof-generalizer):
+ New consts.
+ * emacs-lisp/eieio-core.el (eieio--generic-generalizer)
+ (eieio--generic-subclass-generalizer): New consts.
+ (cl-generic-generalizers): New methods.
+ * emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-generalizer)
+ (eieio--generic-static-object-generalizer): New consts.
+ (cl-generic-generalizers) <(head eieio--static)>: New method.
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
+ Unfold closures like lambdas.
+
+2015-03-04 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ * autorevert.el (auto-revert-notify-add-watch):
+ Fix handler installation. (Bug#20000)
+
+2015-03-04 Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * net/eww.el (eww-search-prefix, eww-open-file, eww-search-words)
+ (eww-same-page-p,eww-set-character-encoding): Fix docstring.
+ (eww): Do not end error messages with a period.
+
+2015-03-04 Zhongwei Yao <ashi08104@gmail.com>
+
+ * net/tramp-adb.el (tramp-adb-connect-if-not-connected):
+ New user option.
+ (tramp-adb-ls-toolbox-regexp): Fix regexp in order to support file
+ names starting with a space.
+ (tramp-methods): Add `tramp-default-port' for "adb".
+ (tramp-adb-parse-device-names): Add traces. Return device names
+ with port, if present.
+ (tramp-adb-handle-directory-files-and-attributes): Quote all
+ remote file names.
+ (tramp-adb-get-device): New defun.
+ (tramp-adb-execute-adb-command, tramp-adb-maybe-open-connection):
+ Use it.
+ (tramp-adb-maybe-open-connection): Set `tramp-current-*'
+ variables. Remove checks for listed devices.
+
+2015-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp): Add :link property.
+ (tramp-login-prompt-regexp): Allow also "user", as required by
+ Fritz!Box telnet.
+ (tramp-autoload-file-name-handler): Use "/".
+ (tramp-handle-unhandled-file-name-directory): Return nil when
+ required by the spec.
+
+ * net/tramp-cache.el (tramp-dump-connection-properties):
+ Use `with-temp-file'.
+
+ * net/tramp-sh.el (tramp-perl-file-attributes)
+ (tramp-perl-directory-files-and-attributes): Escape apostrophes in
+ file names.
+ (tramp-do-file-attributes-with-stat): Quote file name.
+ (tramp-sh-handle-directory-files-and-attributes): Fall back to
+ `tramp-handle-directory-files-and-attributes' in case of problems.
+ (tramp-do-directory-files-and-attributes-with-stat)
+ (tramp-sh-handle-file-name-all-completions)
+ (tramp-sh-handle-delete-directory)
+ (tramp-sh-handle-expand-file-name, tramp-sh-handle-process-file):
+ Normalize use of "cd".
+ (tramp-do-directory-files-and-attributes-with-stat): Use the
+ `quoting-style' arg of `ls' if possible. Make it also working for
+ file names with apostrophes.
+ (tramp-sh-handle-file-name-all-completions): Use arguments of `ls'
+ in proper order.
+ (tramp-do-copy-or-rename-file-via-buffer)
+ (tramp-sh-handle-file-local-copy): Use `with-temp-file'.
+ (tramp-get-remote-locale): Accept also \r in output.
+ (tramp-get-ls-command-with-quoting-style): New defun.
+ (tramp-get-inline-coding): Set `default-directory' to a local
+ directory. Sporadically, `call-process-region' does not handle a
+ remote default directory properly.
+
+ * net/trampver.el: Update release number.
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ * textmodes/ispell.el (ispell-aspell-find-dictionary): Make sure
+ .dat files for aspell dicts are also searched for in location
+ described by `ispell-aspell-dict-dir', matching aspell's dict-dir
+ variable.
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ * textmodes/ispell.el (ispell-dicts-name2locale-equivs-alist)
+ (ispell-hunspell-fill-dictionary-entry)
+ (ispell-find-hunspell-dictionaries)
+ (ispell-set-spellchecker-params): New generic name for
+ `ispell-hunspell-dictionary-equivs-alist'.
+ (ispell-aspell-add-aliases): Also use
+ `ispell-dicts-name2locale-equivs-alist' to get aspell aliases for
+ standard dict names.
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * net/browse-url.el (browse-url-firefox-startup-arguments):
+ Make obsolete.
+ (browse-url-firefox): Doc fix. Remove -remote, which no longer
+ exists in Firefox 36. (Bug#19921)
+ (browse-url-firefox-sentinel): Remove function.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (blink-cursor-timer-function): Don't increment
+ blink-cursor-blinks-done counter when a menu is active on a w32
+ frame. (Bug#19925)
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ * comint.el (comint-line-beginning-position): Revert searching for
+ the prompt when comint-use-prompt-regexp is non-nil because it
+ doesn't distinguish input from output. Check the field property
+ `output' for the case when comint-use-prompt-regexp is nil.
+ (Bug#19710)
+
+2015-03-03 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Disable paging
+ with PAGER=cat. (Bug#19870)
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/flyspell.el (flyspell-duplicate-distance):
+ Bump :version.
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/text-mode.el (text-mode-syntax-table): Make some
+ punctuation character behave as word-constituent, for more
+ compatibility with Unicode.
+
+ * simple.el (transient-mark-mode): Doc fix. (Bug#19841)
+
+2015-03-03 Agustín Martín Domingo <agustin6martin@gmail.com>
+
+ Improve string search in `flyspell-word-search-*`. (Bug#16800)
+ * textmodes/flyspell.el (flyspell-duplicate-distance):
+ Limit default search distance for duplicated words to 40000.
+ (flyspell-word-search-backward, flyspell-word-search-forward):
+ Search as full word with defined casechars, not as substring.
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ Better support for the case of typing RET on the prompt in comint.
+ * comint.el (comint-get-old-input-default): Go to the field end
+ when comint-use-prompt-regexp is nil.
+ (comint-line-beginning-position): Check if point is already
+ on the prompt before searching for the prompt when
+ comint-use-prompt-regexp is non-nil. (Bug#19710)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (frame-notice-user-settings): Refresh the value of
+ frame parameters after calling tty-handle-reverse-video.
+ Call face-set-after-frame-default with the actual parameters, to avoid
+ resetting colors back to unspecified.
+ (set-background-color, set-foreground-color): Pass the foreground
+ and background colors to face-set-after-frame-default. (Bug#19802)
+
+2015-03-03 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * net/network-stream.el (network-stream-open-tls): Respect the
+ :end-of-capability setting.
+
+2015-03-03 Juri Linkov <juri@linkov.net>
+
+ Revert the previous change of comint-line-beginning-position callers,
+ and modify comint-line-beginning-position instead.
+
+ * comint.el (comint-history-isearch-search)
+ (comint-history-isearch-message, comint-history-isearch-wrap):
+ Use comint-line-beginning-position instead of field-beginning.
+ (comint-send-input): Use either end-of-line or field-end
+ depending on comint-use-prompt-regexp.
+ (comint-line-beginning-position): Search backward
+ for comint-prompt-regexp if comint-use-prompt-regexp is non-nil.
+ Use field-beginning instead of line-beginning-position
+ if comint-use-prompt-regexp is nil. (Bug#19710)
+
+2015-03-03 Robert Pluim <rpluim@gmail.com> (tiny change)
+
+ * calendar/todo-mode.el (todo-item-done): When done items are
+ hidden, restore point to its location prior to invoking this
+ command. (Bug#19727)
+
+2015-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/artist.el (artist-ellipse-compute-fill-info):
+ Use mapcar, not mapc, to create the other half of fill-info.
+ (Bug#19763)
+
+2015-03-03 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/authors.el (authors-ignored-files)
+ (authors-renamed-files-alist): Additions.
+
+2015-03-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-ssh-controlmaster-options): Don't use a
+ tempfile for ControlPath. (Bug#19702)
+
+2015-03-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-ssh-controlmaster-options): Use "%C" for
+ ControlPath if possible. (Bug#19702)
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-obsolete-files-regexps)
+ (authors-valid-file-names, authors-renamed-files-alist): Additions.
+
+2015-03-03 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Stop Font Lock forcing fontification from BOL. (Bug#19669)
+ * progmodes/cc-mode.el (c-font-lock-init):
+ Set font-lock-extend-region-functions to nil.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: Make globals conform to elisp
+ style throughout. Use more efficient font-lock patterns.
+ (cps-inhibit-atomic-optimization): Rename from
+ `cps-disable-atomic-optimization'.
+ (cps--gensym): New macro; replaces `cl-gensym' throughout.
+ (cps-generate-evaluator): Move the `iter-yield' local macro
+ definition here
+ (iter-defun, iter-lambda): from here.
+
+ (iter-defun): Use `macroexp-parse-body'.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+2015-03-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gud.el: Use lexical-binding (bug#19966).
+
+ * emacs-lisp/gv.el (gv-ref): Warn about likely problematic cases.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: Make globals conform to elisp
+ style throughout. Use more efficient font-lock patterns.
+ (cps-inhibit-atomic-optimization): Rename from
+ `cps-disable-atomic-optimization'.
+ (cps--gensym): New macro; replaces `cl-gensym' throughout.
+ (cps-generate-evaluator): Move the `iter-yield' local macro
+ definition here...
+ (iter-defun, iter-lambda): ...from here.
+
+2015-03-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-autoremove): Fix if logic.
+
+2015-03-03 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--dump-frame): For pixel height return total
+ number of frame's lines.
+
+2015-03-03 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl-iter-defun): Add cl-iter-defun.
+
+ * emacs-lisp/generator.el (iter-defun): Correctly propagate
+ docstrings and declarations to underlying function.
+
+2015-03-02 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/generator.el: New file.
+
+ * vc/vc.el (vc-responsible-backend): Add autoload cookie for
+ `vc-responsible-backend'.
+
+2015-03-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-hooks.el (vc-state, vc-working-revision):
+ Use `vc-responsible-backend' in order to support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-unregister): Support unregistered files.
+
+ * vc/vc-rcs.el (vc-rcs-fetch-master-state):
+ * vc/vc-sccs.el (vc-sccs-working-revision): Handle undefined
+ master name.
+
+ * vc/vc-src.el (vc-src-working-revision): Do not return an empty string.
+
+2015-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Remove soft hyphens.
+ (shr-insert): Also remove soft hypens from non-folded text.
+
+2015-02-28 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-insert-html): Decode HTML payload
+ when the charset is only given by the HTML <head>, and allow to
+ specify the encoding with "C-x RET c".
+
+2015-02-27 Mark Laws <mdl@60hz.org>
+
+ Support daemon mode on MS-Windows (bug#19688)
+ * server.el (server-process-filter): Force GUI frames on
+ MS-Windows in daemon mode, even if a TTY frame was requested.
+
+ * frameset.el (frameset-keep-original-display-p): Don't assume
+ windows-nt cannot be in daemon mode.
+
+ * frame.el (window-system-for-display): Don't assume windows-nt
+ cannot be in daemon mode.
+
+2015-02-26 Ivan Shmakov <ivan@siamics.net>
+
+ * faces.el (face-list-p): Split from face-at-point.
+ (face-at-point): Use it.
+ * facemenu.el (facemenu-add-face): Likewise. (Bug#19912)
+
+2015-02-26 Oscar Fuentes <ofv@wanadoo.es>
+
+ * vc/vc.el (vc-annotate-switches): New defcustom.
+ * vc/vc-bzr.el (vc-bzr-annotate-switches): New defcustom.
+ (vc-bzr-annotate-command): Use vc-switches.
+ * vc/vc-cvs.el (vc-cvs-annotate-switches): New defcustom.
+ (vc-cvs-annotate-command): Use vc-switches.
+ * vc/vc-git.el (vc-git-annotate-switches): New defcustom.
+ (vc-git-annotate-command): Use vc-switches.
+ * vc/vc-hg.el (vc-hg-annotate-switches): New defcustom.
+ (vc-hg-annotate-command): Use vc-switches.
+ * vc/vc-mtn.el (vc-mtn-annotate-switches): New defcustom.
+ (vc-mtn-annotate-command): Use vc-switches.
+ * vc/vc-svn.el (vc-svn-annotate-switches): New defcustom.
+ (vc-svn-annotate-command): Use vc-switches.
+
+2015-02-26 Alan Mackenzie <acm@muc.de>
+
+ Handle "#" operator properly inside macro. Fix coding bug.
+
+ * progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP):
+ On finding a "#" which looks like the start of a macro, check it
+ isn't already inside a macro.
+
+ * progmodes/cc-engine.el (c-state-safe-place): Don't record a new
+ "safe" position into the list of them when this is beyond our
+ current position.
+
+2015-02-26 Martin Rudalics <rudalics@gmx.at>
+
+ * menu-bar.el (menu-bar-non-minibuffer-window-p): Return nil when
+ the menu frame is dead. (Bug#19728)
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Handle tabs in python-indent-dedent-line.
+ * progmodes/python.el (python-indent-dedent-line): Fixes for
+ indentation with tabs. Thanks to <dale@codefu.org> (Bug#19730).
+
+2015-02-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-context): Respect user
+ indentation after comment.
+
+2015-02-26 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (featurep): Conditionalize value of
+ reftex-label-regexps in order to stay compatible with XEmacs 21.5
+ which has no explicitly numbered groups in regexps (bug#19714).
+
+2015-02-26 Daiki Ueno <ueno@gnu.org>
+
+ * net/dbus.el (dbus-register-signal): Convert "N" of ":argN" to
+ integer before comparison.
+
+2015-02-25 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * progmodes/elisp-mode.el (elisp--eval-last-sexp): Document argument.
+
+2015-02-25 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/check-declare.el (check-declare-warn):
+ Use compilation-style warnings.
+ (check-declare-files): Make sure that
+ `check-declare-warning-buffer' is in `compilation-mode'.
+
+2015-02-25 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/check-declare.el (check-declare-ext-errors):
+ New defcustom.
+ (check-declare): New defgroup.
+ (check-declare-verify): When `check-declare-ext-errors' is
+ non-nil, warn about an unfound function, instead of saying
+ "skipping external file".
+
+2015-02-25 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-include-file-commands):
+ Call reftex-set-dirty on changes.
+
+2015-02-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug--display): Save-excursion (bug#19611).
+ * emacs-lisp/debug.el (debugger-env-macro): Remove redundant
+ save-excursion.
+
+2015-02-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailsum.el (rmail-summary-previous-all)
+ (rmail-summary-previous-msg): Simplify.
+
+2015-02-25 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * simple.el (region-active-p): Fix doc to say non-nil.
+
+2015-02-24 Samer Masterson <nosefrog@gmail.com>
+
+ * eshell/em-hist.el (eshell-hist-parse-word-designator):
+ Return args joined with " ".
+ * eshell/em-pred.el (eshell-parse-modifiers): Correct docstring.
+ (eshell-hist-parse-modifier): Pass mod a list instead of a string
+ (bug#18960).
+
+2015-02-24 Karl Fogel <kfogel@red-bean.com> (tiny change)
+
+ * comint.el (comint-mode-map): Fix obvious typo.
+
+2015-02-24 Johan Claesson <johanclaesson@bredband.net> (tiny change)
+
+ * filecache.el (file-cache-filter-regexps):
+ Add lock files. (Bug#19516)
+
+2015-02-24 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmailsum.el (rmail-summary-next-all)
+ (rmail-summary-previous-all, rmail-summary-next-msg):
+ Fix handling of optional argument. (Bug#19916)
+
+ * progmodes/f90.el (f90-beginning-of-subprogram)
+ (f90-end-of-subprogram, f90-match-end):
+ Handle continued strings where the continuation does not start
+ with "&" and happens to match our regexp. (Bug#19809)
+
+2015-02-24 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * comint.el (comint-clear-buffer): New command.
+ (comint-mode-map): Bind `comint-clear-buffer' to 'C-c M-o'.
+
+2015-02-23 Pete Williamson <petewil0@googlemail.com> (tiny change)
+
+ Use ${EXEEXT} more uniformly in makefiles
+ * Makefile.in (EMACS): Append ${EXEEXT}.
+
+2015-02-23 Sam Steingold <sds@gnu.org>
+
+ * files.el (recover-session): Handle `auto-save-list-file-prefix'
+ being a directory (empty non-directory part).
+
+2015-02-23 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/sasl.el (sasl-mechanism-alist): Refer to sasl-scram-rfc
+ instead of sasl-scram-sha-1, as the former is the name that can be
+ required.
+
+ * net/sasl-scram-rfc.el (sasl-scram-sha-1-steps)
+ (sasl-scram-sha-1-client-final-message)
+ (sasl-scram-sha-1-authenticate-server): Move to end of file.
+
+2015-02-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bindings.el (ctl-x-map): Use [?\C-\;] to get the desired binding.
+ (Bug#19826)
+
+2015-02-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexp-parse-body): Handle cl-declare
+ and :documentation. Change return value format accordingly.
+ * emacs-lisp/cl-generic.el (cl--generic-lambda):
+ * emacs-lisp/pcase.el (pcase-lambda): Adjust accordingly.
+ * emacs-lisp/cl-macs.el (cl--transform-lambda): Use macroexp-parse-body.
+
+2015-02-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ Introduce `xref-etags-mode'.
+ * progmodes/xref.el (xref-etags-mode--saved): New variable.
+ (xref-etags-mode): New minor mode. (Bug#19466)
+
+2015-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dom.el (dom-previous-sibling): New function.
+
+2015-02-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ * bindings.el (ctl-x-map): There is no 'C-;'.
+ For now, make do with 'M-;'; this allows 'make bootstrap' to work.
+ Perhaps some other binding should be chosen. (Bug#19826)
+
+2015-02-21 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * bindings.el (ctl-x-map): Fix `comment-line' binding. (Bug#19826)
+
+2015-02-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-notify-add-watch)
+ (auto-revert-notify-handler, auto-revert-buffers): Handle also
+ buffers without an associated file, like dired buffers. (Bug#16112)
+
+2015-02-21 Dima Kogan <dima@secretsauce.net>
+
+ * autorevert.el (auto-revert-mode, auto-revert-tail-mode)
+ (global-auto-revert-mode): Remove (let (auto-revert-use-notify) ... )
+ wrappers. Call (auto-revert-buffers) consequently in order to
+ install handlers.
+
+2015-02-21 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision 0d6420b.
+ * progmodes/verilog-mode.el (verilog-mode-version): Update.
+ (vector-skip-list): Remove.
+ (verilog-auto-inst-port, verilog-auto-inst-port-list)
+ (verilog-auto-inst, verilog-auto-inst-param):
+ Use arguments rather than vector-skip.
+ (verilog-auto-inst-port): Fix AUTOINST interfaces to not show
+ modport if signal attachment is itself a modport.
+ Reported by Matthew Lovell.
+
+2015-02-21 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.37.1. Add VHDL'08 support.
+ * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp)
+ (vhdl-doc-release-notes): Update.
+ (vhdl-standard): Add VHDL'08 option.
+ (vhdl-sensitivity-list-all): New option.
+ (vhdl-directive-keywords): Add psl.
+ (vhdl-offsets-alist-default, vhdl-mode-abbrev-table-init)
+ (vhdl-template-construct-alist-init, vhdl-create-mode-menu):
+ (vhdl-imenu-generic-expression): Add context, directive.
+ (vhdl-offsets-alist, vhdl-mode, vhdl-doc-keywords): Doc fixes.
+ (vhdl-template-map-init): Add vhdl-template-context.
+ (vhdl-mode-syntax-table): Support VHDL'08 block comments.
+ (vhdl-create-mode-menu): Add some entries.
+ (vhdl-08-keywords, vhdl-08-types, vhdl-08-attributes)
+ (vhdl-08-functions, vhdl-08-packages, vhdl-08-directives):
+ New constants.
+ (vhdl-directives): New variable.
+ (vhdl-words-init, vhdl-template-process)
+ (vhdl-template-replace-header-keywords): Support VHDL'08.
+ (vhdl-abbrev-list-init): Add vhdl-directives.
+ (vhdl-in-comment-p, vhdl-in-literal, vhdl-win-il)
+ (vhdl-forward-syntactic-ws, vhdl-get-syntactic-context)
+ (vhdl-lineup-comment): Handle block comments and directives.
+ (vhdl-beginning-of-directive, vhdl-template-context)
+ (vhdl-template-context-hook): New functions.
+ (vhdl-libunit-re, vhdl-defun-re, vhdl-begin-p)
+ (vhdl-corresponding-begin, vhdl-get-library-unit, vhdl-regress-line)
+ (vhdl-align-declarations, vhdl-beginning-of-block, vhdl-end-of-block)
+ (vhdl-font-lock-keywords-2, vhdl-get-end-of-unit)
+ (vhdl-scan-context-clause): Add context.
+
+2015-02-20 Glenn Morris <rgm@gnu.org>
+
+ * calendar/solar.el (solar-sunrise-sunset-string):
+ Shorten message a little.
+ (sunrise-sunset): Use message rather than a window. (Bug#19859)
+
+ * progmodes/f90.el (f90-keywords-re, f90-procedures-re)
+ (f90-font-lock-keywords-2): Some F2008 additions.
+
+2015-02-19 Dima Kogan <dima@secretsauce.net>
+
+ * autorevert.el (auto-revert-buffers-counter)
+ (auto-revert-buffers-counter-lockedout): New variables.
+ (auto-revert-buffers): Increase `auto-revert-buffers-counter'.
+ (auto-revert-notify-handler): Apply `auto-revert-handler' if not
+ suppressed by lockout. (Bug#18958)
+
+2015-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-opt.el (eieio-help-class): `eieio-class-parents'
+ returns classes, not class names (bug#19891).
+
+ * emacs-lisp/cl-macs.el (cl-struct-slot-value): Handle a nil type.
+
+ * emacs-lisp/smie.el (smie-prec2->grammar): Fix corner case problem.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * register.el (jump-to-register):
+ * emacs-lisp/lisp.el (check-parens):
+ Push mark before goto-char so user doesn't lose his previous place.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * rect.el (rectangle-mark-mode):
+ Suppress superfluous "Mark set" message from push-mark.
+
+2015-02-18 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-go-back, help-go-forward, help-follow):
+ * simple.el (yank-pop, pop-to-mark-command, exchange-point-and-mark):
+ * winner.el (winner-redo):
+ * windmove.el (windmove-do-window-select):
+ * register.el (jump-to-register, increment-register, insert-register)
+ (append-to-register, prepend-to-register):
+ * files.el (find-alternate-file, abort-if-file-too-large, write-file)
+ (set-visited-file-name):
+ * emacs-lisp/lisp.el (kill-backward-up-list):
+ Use user-error instead of error. (Bug#14480)
+
+2015-02-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/checkdoc.el (checkdoc-show-diagnostics): Don't make bogus
+ assumptions about window ordering.
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * files.el (insert-file-contents-literally): Fix docstring typo.
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Process macro
+ arguments correctly. (Bug#19685)
+ (define-minor-mode): Clarify docstring.
+ Clarify mode switch messages for minor modes. (Bug#19690)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Create valid tar files. (Bug#19536)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * desktop.el (desktop-read): Conditionally re-enable desktop autosave.
+ (Bug#19059)
+
+2015-02-16 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-do-xref): Prevent duplicated display of Info
+ buffer, and prevent interference with existing buffer. (Bug#13190)
+
+2015-02-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Do not deactivate mark on shell fontification. (Bug#19871)
+
+ * progmodes/python.el (python-shell-font-lock-post-command-hook):
+ Do not deactivate mark on fontification.
+
+2015-02-16 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el: Fix desktop support. (Bug#19226)
+ (eww-mode): Add autoload cookie.
+ (eww-restore-desktop): Use inhibit-read-only.
+
+ * net/eww.el (eww-suggest-uris): Add autoload cookie, so that
+ add-hook works correctly even if the file is not yet loaded.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Use make-instance rather than
+ eieio-constructor.
+ (set-slot-value): Mark as obsolete.
+ (eieio-object-class-name): Improve call to eieio-class-name.
+ (eieio-slot-descriptor-name, eieio-class-slots): New functions.
+ (object-slots): Use it. Declare obsolete.
+ (eieio-constructor): Merge it with `make-instance'.
+ (initialize-instance): Use `dolist'.
+ (eieio-override-prin1, eieio-edebug-prin1-to-string):
+ Use eieio--class-print-name.
+
+ * emacs-lisp/eieio-core.el (eieio--class-print-name): New function.
+ (eieio-class-name): Make it do what the docstring claims.
+ (eieio-defclass-internal): Simplify since `prots' isn't used any more.
+ (eieio--slot-name-index): Simplify accordingly.
+ (eieio-barf-if-slot-unbound): Pass the class object rather than its
+ name to `slot-unbound'.
+
+ * emacs-lisp/eieio-base.el (make-instance): Add a method here rather
+ than on eieio-constructor.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Keep type=nil by default.
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Add sanity checks
+ about relationship between `type', `named', and `slots'.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-tagcode): Adjust to new
+ value of `cl-struct-type' property.
+
+2015-02-15 Jérémy Compostella <jeremy.compostella@gmail.com>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Disable paging
+ with PAGER=cat. (Bug#19870)
+
+2015-02-14 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-read-all-archive-contents):
+ Don't build the compatibility table.
+ (package-refresh-contents, package-initialize): Do build the
+ compatibility table.
+ (package--build-compatibility-table): New function.
+ (describe-package-1): Describe why a package is incompatible.
+
+2015-02-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-preloaded.el (cl-struct-define): Register as children
+ of the parent.
+ (cl--assertion-failed): New function.
+ (cl-assertion-failed): Move in from cl-lib.el.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Don't generate code to register
+ as children of its parents.
+ (cl--make-type-test, cl--compiler-macro-typep): Remove functions.
+ (cl-typep): Reimplement using define-inline.
+ (cl-assert): Use cl--assertion-failed.
+ (cl-struct-slot-value): Use define-inline.
+
+ * emacs-lisp/cl-lib.el: Move autoloaded code to cl-preload.
+
+ * textmodes/flyspell.el (flyspell-word): Defvar (bug#19844).
+ (flyspell-generic-check-word-p): Mark as obsolete.
+
+2015-02-13 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--compatibility-table): New var.
+ (package--add-to-compatibility-table): New function.
+ (package-read-all-archive-contents): Populate compatibility table.
+ (package--incompatible-p): Also look in dependencies.
+ (describe-package-1): Fix "incompat" handling.
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/rfc2104.el: Moved here from lisp/gnus.
+
+2015-02-13 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/sasl-scram-rfc.el: New file.
+
+ * net/sasl.el (sasl-mechanisms): Remove SCRAM-MD5.
+ Add SCRAM-SHA-1 first.
+ (sasl-mechanism-alist): Remove SCRAM-MD5 entry. Add SCRAM-SHA-1
+ entry (bug#17636).
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-tag-li): Speed up rendering pages with lots of
+ <ul>.
+
+2015-02-12 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * progmodes/gdb-mi.el (gdb-display-io-nopopup): New defcustom.
+ (gdb-inferior-filter): Don't pop up the buried output buffer when
+ `gdb-display-io-nopopup' is non-nil.
+
+2015-02-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Allow killing shell buffer if process is dead. (Bug#19823)
+
+ * progmodes/python.el (python-shell-font-lock-kill-buffer):
+ Don't require a running process.
+ (python-shell-font-lock-post-command-hook): Fontify only if the
+ shell process is running.
+
+2015-02-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hi-lock.el (hi-lock-unface-buffer): Don't call
+ font-lock-remove-keywords if not needed (bug#19796).
+
+2015-02-11 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-install): Invert the second
+ argument, for better backwards compatibility.
+ (package-install-button-action, package-reinstall)
+ (package-menu-execute): Account for the change.
+
+2015-02-11 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-reverse): Add a backward-compatible
+ version of seq-reverse that works on sequences in Emacs 24.
+ Bump seq.el version to 1.2.
+
+2015-02-11 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--incompatible-p): New function.
+ Return non-nil if PKG has no chance of being installable.
+ (package--emacs-version-list): New variable.
+ (describe-package-1, package-desc-status)
+ (package-menu--print-info, package-menu--status-predicate):
+ Account for the "incompat" status.
+
+2015-02-11 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (toggle-frame-maximized, toggle-frame-fullscreen):
+ Rename frame parameter `maximized' to `fullscreen-restore'.
+ Restore fullwidth/-height after fullboth state. Update doc-strings.
+
+2015-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Make sure the space inserted has the
+ right font (for width).
+ (shr-fill-line): Preserve background colours when indenting/folding.
+ (shr-ensure-paragraph): Don't insert a new paragraph as the first
+ item in a <li>.
+
+2015-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-use-fonts): New variable.
+ (shr-fill-text): Rename from "fold".
+ (shr-pixel-column, shr-pixel-region, shr-string-pixel-width):
+ New functions.
+ (shr-insert): Just insert, don't fill the text. Filling is now
+ done afterwards per display unit.
+ (shr-fill-lines, shr-fill-line): New functions to fill text on a
+ per-unit base.
+ (shr-find-fill-point): Take a "beginning" parameter.
+ (shr-indent): Indent using the :width display parameter when using
+ fonts.
+ (shr-parse-style): Ignore "inherit" values, since we already do that.
+ (shr-tag-img): Remove the insertion states.
+ (shr-tag-blockquote): New-style filling.
+ (shr-tag-dd): Ditto.
+ (shr-tag-li): Ditto.
+ (shr-mark-fill): New function to mark lines that need filling.
+ (shr-tag-h1): Use a larger font.
+ (shr-tag-table-1): Get the natural and suggested widths in one
+ rendering.
+ (shr-tag-table): Create the "fixed" version of the table only once
+ so that we can cache data in the table.
+ (shr-insert-table): Get colspan calculations right by having
+ zero-width columns after colspan ones.
+ (shr-expand-alignments): New function to make :align-to specs work
+ right when rendered in one buffer and displayed in another one.
+ (shr-insert-table-ruler): Use :align-to to get the widths right.
+ (shr-make-table): Cache more.
+ (shr-make-table-1): Use the new <td> data layout.
+ (shr-pixel-buffer-width): New function.
+ (shr-render-td): Add a caching layer.
+ (shr-dom-max-natural-width): New function.
+ (shr-tag-h1): Don't use variable-pitch fonts on fontless rendering.
+ (shr-tag-tt): New function.
+ (shr-tag-hr): Compute the right length when using fonts.
+ (shr-table-widths): Off-by-one error in width computation.
+ (shr-expand-newlines): Remove dead code.
+ (shr-insert-table): Extend background colors to the end of the column.
+ (shr-insert-table): Only copy the background, not underline and
+ the like.
+ (shr-face-background): New function.
+
+2015-02-10 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Improved shell font lock respecting markers. (Bug#19650)
+
+ * progmodes/python.el
+ (python-shell-font-lock-get-or-create-buffer): Use special buffer name.
+ (python-shell-font-lock-with-font-lock-buffer): Enable font lock.
+ (python-shell-font-lock-post-command-hook): Fontify by copying text
+ properties from fontified buffer to shell, keeping markers unchanged.
+ (python-shell-font-lock-turn-off): Fix typo.
+ (python-util-text-properties-replace-name): Delete function.
+
+2015-02-09 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-group-by): Improves seq-group-by to
+ return sequence elements in correct order.
+
+2015-02-09 Simen Heggestøyl <simenheg@gmail.com> (tiny change)
+
+ * textmodes/css-mode.el (css-smie-rules): Fix paren indent (bug#19815).
+
+2015-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-lambda): Use macroexp-parse-body.
+
+ * emacs-lisp/eieio-core.el (eieio-oset-default): Catch the unexpected
+ case where the default value would be re-interpreted as a form!
+
+2015-02-09 Christopher Genovese <genovese@cmu.edu> (tiny change)
+
+ * help-fns.el (help-fns--signature): Keep doc for keymap.
+
+2015-02-09 Kelly Dean <kelly@prtime.org>
+
+ * desktop.el: Save mark-ring less verbosely.
+ (desktop-var-serdes-funs): New var.
+ (desktop-buffer-info, desktop-create-buffer): Use it.
+ (desktop-file-version): Update to 208.
+
+2015-02-09 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/pcase.el (pcase-lambda): New Macro. (Bug#19814)
+
+ * emacs-lisp/lisp-mode.el (el-kws-re): Include `pcase-lambda'.
+
+ * emacs-lisp/macroexp.el (macroexp-parse-body): New function.
+
+2015-02-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to platforms lacking test -a and -o
+ * Makefile.in (compile-clean):
+ * net/tramp-sh.el (tramp-find-executable):
+ Prefer '&&' and '||' to 'test -a' and 'test -o'.
+
+2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * newcomment.el (comment-line): Fix missing paren.
+
+2015-02-08 Ulrich Müller <ulm@gentoo.org>
+
+ * play/gamegrid.el: Update comment to reflect that the
+ 'update-game-score' helper program is now setgid by default.
+
+2015-02-08 David Kastrup <dak@gnu.org>
+
+ * subr.el (apply-partially): Use lexical binding here.
+
+2015-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * newcomment.el (comment-line): New command.
+
+ * bindings.el (ctl-x-map): Bind to `C-x C-;'.
+
+2015-02-08 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * outline.el (outline-show-entry): Fix one invisible char for the
+ file's last outline. (Bug#19493)
+
+2015-02-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (indirect-function): Change advertised calling convention.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Fix completion-at-point. (Bug#19667)
+
+ * progmodes/python.el
+ (python-shell-completion-native-get-completions): Force process buffer.
+ (python-shell-completion-at-point): Handle case where call is not
+ in a shell buffer.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Fix shell font-lock multiline input. (Bug#19744)
+
+ * progmodes/python.el
+ (python-shell-font-lock-post-command-hook): Handle multiline input.
+
+2015-02-08 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Make shell font-lock respect markers. (Bug#19650)
+
+ * progmodes/python.el (python-shell-font-lock-cleanup-buffer):
+ Use `erase-buffer`.
+ (python-shell-font-lock-comint-output-filter-function):
+ Handle newlines.
+ (python-shell-font-lock-post-command-hook): Respect markers on
+ text fontification.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Keep eldoc visible while typing args. (Bug#19637)
+ * progmodes/python.el (python-eldoc--get-symbol-at-point):
+ New function based on Carlos Pita <carlosjosepita@gmail.com> patch.
+ (python-eldoc--get-doc-at-point, python-eldoc-at-point): Use it.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix hideshow integration. (Bug#19761)
+ * progmodes/python.el
+ (python-hideshow-forward-sexp-function): New function based on
+ Carlos Pita <carlosjosepita@gmail.com> patch.
+ (python-mode): Make `hs-special-modes-alist` use it and initialize
+ the end regexp with the empty string to avoid skipping parens.
+
+2015-02-07 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-check-custom-command): Do not use
+ defvar-local for compat with Emacs<24.3.
+
+2015-02-07 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (frame-notice-user-settings):
+ Update `frame-size-history'.
+ (make-frame): Update `frame-size-history'.
+ Call `frame-after-make-frame'.
+ * faces.el (face-set-after-frame-default): Remove call to
+ frame-can-run-window-configuration-change-hook.
+
+2015-02-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-cvs.el (vc-cvs-dir-status-files): Don't pass DIR to
+ `vc-cvs-command' (bug#19732).
+
+2015-02-06 Nicolas Petton <nicolas@petton.fr>
+
+ * emacs-lisp/seq.el (seq-mapcat, seq-partition, seq-group-by):
+ New functions.
+ * emacs-lisp/seq.el (seq-drop-while, seq-take-while, seq-count)
+ (seq--drop-list, seq--take-list, seq--take-while-list):
+ Better docstring.
+
+2015-02-06 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * doc-view.el (doc-view-kill-proc-and-buffer): Obsolete. Use
+ `image-kill-buffer' instead.
+
+2015-02-06 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-search-internal): Fix docstring.
+
+2015-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * subr.el (define-error): The error conditions may be constant
+ lists, so use `append' to concatenate them.
+
+2015-02-06 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * net/network-stream.el (network-stream-open-tls): Respect the
+ :end-of-capability setting.
+
+2015-02-05 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--sort-by-dependence):
+ New function. Return PACKAGE-LIST sorted by dependencies.
+ (package-menu-execute): Use it to delete packages in order.
+ (package--sort-deps-in-alist): New function.
+ (package-menu-mark-install): Can mark dependencies.
+ (package--newest-p): New function.
+ (package-delete): Don't deselect when deleting an older version of
+ an upgraded package.
+
+ * emacs-lisp/package.el: Add missing (require 'subr-x)
+
+2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el (scss-smie--not-interpolation-p): Vars can be
+ hyphenated (bug#19263).
+
+ * textmodes/css-mode.el (css-fill-paragraph): Fix filling in presence
+ of variable interpolation (bug#19751).
+
+2015-02-05 Era Eriksson <era+emacs@iki.fi>
+
+ * json.el (json-end-of-file): New error (bug#19768).
+ (json-pop, json-read): Use it.
+
+2015-02-05 Kelly Dean <kelly@prtime.org>
+
+ * help-mode.el (help-xref-interned): Pass BUFFER and FRAME to
+ `describe-variable'.
+
+ * help-fns.el (describe-function-or-variable): New function.
+
+ * help.el (help-map): Bind `describe-function-or-variable' to o.
+ (help-for-help-internal): Document o key.
+
+2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use new
+ special (:documentation ...) feature.
+ * emacs-lisp/eieio-core.el (eieio-make-class-predicate)
+ (eieio-make-child-predicate): Same.
+ (eieio-copy-parents-into-subclass): Remove unused arg.
+ (eieio-defclass-internal): Adjust call accordingly and remove redundant
+ `pname' var.
+ (eieio--slot-name-index): Remove unused arg `obj' and adjust all
+ callers accordingly.
+
+ * emacs-lisp/cconv.el (cconv--convert-function):
+ Add `docstring' argument.
+ (cconv-convert): Use it to handle the new (:documentation ...) form.
+ (cconv-analyze-form): Handle the new (:documentation ...) form.
+
+ * emacs-lisp/bytecomp.el:
+ (byte-compile-initial-macro-environment): Use macroexp-progn.
+ (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all.
+ (byte-compile-file-form-defvar-function): Rename from
+ byte-compile-file-form-define-abbrev-table.
+ (defvaralias, byte-compile-file-form-custom-declare-variable): Use it.
+ (byte-compile): Use byte-compile-top-level rather than
+ byte-compile-lambda so we can compile non-values.
+ (byte-compile-form): Add warnings for failed uses of lexical vars via
+ quoted symbols.
+ (byte-compile-unfold-bcf): Improve message for failed inlining.
+ (byte-compile-make-closure): Handle new format of internal-make-closure
+ for dynamically-generated docstrings.
+
+ * delsel.el: Deprecate the `kill' option. Use lexical-binding.
+ (open-line): Delete like all other commands, instead of killing.
+ (delete-active-region): Don't define any return any value.
+
+ * progmodes/python.el: Try to preserve compatibility with Emacs-24.
+ (python-mode): Don't assume eldoc-documentation-function has a non-nil
+ default.
+
+2015-02-04 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-indent-calculate-indentation):
+ Avoid the error when computing top-level indentation.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-member-method): Fix paren typo.
+
+ * textmodes/flyspell.el: Use lexical-binding and cl-lib.
+ (mail-mode-flyspell-verify): Fix last change.
+ (flyspell-external-point-words, flyspell-large-region):
+ Avoid add-to-list on local vars.
+
+2015-02-04 Tassilo Horn <tsdh@gnu.org>
+
+ * emacs-lisp/package.el (package-installed-p): Fix typo causing
+ void-variable error.
+
+2015-02-04 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * image-mode.el (image-kill-buffer): New command.
+ (image-mode-map): Bind it to k.
+
+ * emacs-lisp/package.el (package-delete): Remove package from
+ `package-selected-packages' even if it can't be deleted.
+ (package-installed-p): Accept package-desc objects.
+ (package-install): Can be used to mark dependencies as
+ selected. When given a package-desc object which is already
+ installed, the package is not downloaded again, but it is marked
+ as selected (if it wasn't already).
+ (package-reinstall): Accept package-desc objects.
+
+2015-02-03 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-delete): Document NOSAVE.
+ (package--get-deps): delete-dups when ONLY is nil.
+ (package-autoremove): Warn the user if `package-selected-packages'
+ is empty.
+
+ (package--user-selected-p): New function.
+ (package-delete, package-install, package-install-from-buffer):
+ Use it
+ (package-selected-packages): Mention it.
+
+ (package-initialize): Don't populate `package-selected-packages'.
+ (package-install-user-selected-packages, package-autoremove):
+ Special handling for empty `package-selected-packages'.
+ (package-install): Fix when PKG is a package-desc.
+
+ (package-desc-status): Add "dependency" status to the Package
+ Menu.
+ (package-menu--status-predicate, package-menu--print-info)
+ (package-menu-mark-delete, package-menu--find-upgrades)
+ (package-menu--status-predicate, describe-package-1): Use it
+
+ (package--removable-packages): New function.
+ (package-autoremove): Use it.
+ (package-menu-execute): Offer to remove unneeded packages.
+
+ (package--read-pkg-desc, package-tar-file-info): Fix reference to
+ tar-desc.
+
+2015-02-03 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el (package-reinstall): Don't change package's selected status.
+ (package-delete): New NOSAVE argument.
+
+2015-02-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-histfile-override): Fix docstring.
+ (tramp-open-shell, tramp-maybe-open-connection): Set also
+ HISTFILESIZE and HISTSIZE when needed. (Bug#19731)
+
+2015-02-02 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--find-non-dependencies):
+ New function.
+ (package-initialize): Use it to populate `package-selected-packages'.
+ (package-menu-execute): Clean unnecessary `and'.
+ (package--get-deps): Fix returning duplicates.
+
+2015-02-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-histfile-override): Add another choice t.
+ Use it as default.
+ (tramp-open-shell, tramp-maybe-open-connection): Support it.
+ (Bug#19731)
+
+2015-02-02 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el (package-delete): Remove package from
+ package-selected-packages.
+ (package-autoremove): Remove unneeded variable.
+
+2015-02-01 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-selected-packages): Fix :type
+ (package-install): Rename ARG to MARK-SELECTED.
+ (package--get-deps): Fix for indirect dependencies.
+ (package-used-elsewhere-p): Rename to
+ (package--used-elsewhere-p): New function.
+ (package-reinstall, package-user-selected-packages-install)
+ (package-autoremove): Use sharp-quote.
+ (package-user-selected-packages-install): Reindent and rename to
+ (package-install-user-selected-packages): New function.
+
+2015-02-01 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/package.el: Don't allow deleting dependencies.
+
+ (package-used-elsewhere-p): New function.
+ (package-delete): Use it, return now an error when trying to
+ delete a package used as dependency by another package.
+
+ Add a reinstall package command.
+ (package-reinstall): New function.
+
+ Add a package-autoremove command.
+ (package-selected-packages): New user var.
+ (package-install): Add an optional arg to notify interactive use.
+ Fix docstring. Save installed package to
+ packages-installed-directly.
+ (package-install-from-buffer): Same.
+ (package-user-selected-packages-install): Allow installing all
+ packages in packages-installed-directly at once.
+ (package--get-deps): New function.
+ (package-autoremove): New function.
+ (package-install-button-action): Call package-install with
+ interactive arg.
+ (package-menu-execute): Same but only for only for not installed
+ packages.
+
+2015-01-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Use new eieio-make-class-predicate
+ and eieio-make-child-predicate.
+ (eieio-class-parents): Use eieio--class-object.
+ (slot-boundp, find-class, eieio-override-prin1): Avoid class-p.
+ (slot-exists-p): Use find-class.
+
+ * emacs-lisp/eieio-opt.el (eieio-help-class, eieio-help-constructor):
+ Use find-lisp-object-file-name, help-fns-short-filename and new calling
+ convention for eieio-class-def.
+ (eieio-build-class-list): Remove function, unused.
+ (eieio-method-def): Remove button type, unused.
+ (eieio-class-def): Inherit from help-function-def.
+ (eieio--defclass-regexp): New constant.
+ (find-function-regexp-alist): Use it.
+ (eieio--specializers-apply-to-class-p): Handle eieio--static as well.
+ (eieio-help-find-method-definition, eieio-help-find-class-definition):
+ Remove functions.
+
+ * emacs-lisp/eieio-core.el (eieio--check-type): Remove.
+ Use cl-check-type everywhere instead.
+ (eieio-class-object): Remove, use find-class instead when needed.
+ (class-p): Don't inline.
+ (eieio-object-p): Check more thoroughly, so we don't treat cl-structs,
+ such as eieio classes, as objects. Don't inline.
+ (object-p): Mark as obsolete.
+ (eieio-defclass-autoload, eieio-defclass-internal, eieio-oref)
+ (eieio--generic-tagcode): Avoid `class-p'.
+ (eieio-make-class-predicate, eieio-make-child-predicate): New functions.
+ (eieio-defclass-internal): Use current-load-list rather than
+ `class-location'.
+
+ * emacs-lisp/cl-generic.el (cl--generic-search-method): Fix regexp.
+
+2015-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/backquote.el (backquote-delay-process): Don't reuse `s'
+ since it may be "equivalent" in some sense, yet different (bug#19734).
+
+2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * outline.el (outline-font-lock-face): Add docstring.
+ (outline-invisible-p): Improve docstring.
+ (outline-invent-heading): Add docstring.
+ (outline-promote): Improve docstring.
+ (outline-demote): Improve docstring.
+ (outline-head-from-level): Improve docstring.
+ (outline-end-of-heading): Add docstring.
+ (outline-next-visible-heading): Improve docstring.
+ (outline-previous-visible-heading): Improve docstring.
+ (outline-hide-region-body): Improve docstring.
+ (outline-flag-subtree): Add docstring.
+ (outline-end-of-subtree): Add docstring.
+ (outline-headers-as-kill): Improve docstring.
+
+2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * outline.el (outline-hide-entry): Rename from `hide-entry'.
+ (hide-entry): Declare as obsolete.
+ (outline-show-entry): Rename from `show-entry'.
+ (show-entry): Declare as obsolete.
+ (outline-hide-body): Rename from `hide-body'.
+ (hide-body): Declare as obsolete.
+ (outline-hide-region-body): Rename from `hide-region-body'.
+ (hide-region-body): Declare as obsolete.
+ (outline-show-all): Rename from `show-all'.
+ (show-all): Declare as obsolete.
+ (outline-hide-subtree): Rename from `hide-subtree'.
+ (hide-subtree): Declare as obsolete.
+ (outline-hide-leaves): Rename from `hide-leaves'.
+ (hide-leaves): Declare as obsolete.
+ (outline-show-subtree): Rename from `show-subtree'.
+ (show-subtree): Declare as obsolete.
+ (outline-hide-sublevels): Rename from `hide-sublevels'.
+ (hide-sublevels): Declare as obsolete.
+ (outline-hide-other): Rename from `hide-other'.
+ (hide-other): Declare as obsolete.
+ (outline-show-children): Rename from `show-children'.
+ (show-children): Declare as obsolete.
+ (outline-show-branches): Rename from `show-branches'.
+ (show-branches): Declare as obsolete.
+
+2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * outline.el (outline-mode): Clean up docstring.
+ (font-lock-warning-face): Remove obsolete declaration.
+ (outline-font-lock-face): Remove obsolete comment.
+
+2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * custom.el (defface): Set `indent' to 1.
+
+2015-01-30 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Set `indent' to 1.
+
+2015-01-30 Michal Nazarewicz <mina86@mina86.com>
+
+ * files.el (save-buffers-kill-emacs): If `confirm-kill-emacs'
+ is set, but user has just been asked whether they really want to
+ kill Emacs (for example with a ‘Modified buffers exist; exit
+ anyway?’ prompt), do not ask them for another confirmation.
+
+2015-01-29 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (calc-convert-exact-units): New function.
+ (calc-convert-units): Check for missing units.
+ (math-consistent-units-p): Strengthen the test for consistent units.
+
+ * calc/calc-ext.el (calc-init-extensions): Autoload
+ `calc-convert-exact-units' and assign it a keybinding.
+
+ * calc/calc-help.el (calc-u-prefix-help): Add help for the
+ "un" keybinding.
+
+2015-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl.el (cl--function-convert): Simplify.
+
+2015-01-28 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex.el (reftex-syntax-table-for-bib): Give ( and )
+ punctuation syntax since to allow bibtex fields with values such
+ as {Test 1) and 2)} (bug#19205, bug#19707).
+ (reftex--prepare-syntax-tables): New function.
+ (reftex-mode): Use it.
+
+2015-01-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: New non-global state dependent indentation engine.
+ (Bug#18319, Bug#19595)
+ * progmodes/python.el (python-syntax-comment-or-string-p):
+ Accept PPSS as argument.
+ (python-syntax-closing-paren-p): New function.
+ (python-indent-current-level)
+ (python-indent-levels): Mark obsolete.
+ (python-indent-context): Return more context cases.
+ (python-indent--calculate-indentation)
+ (python-indent--calculate-levels): New functions.
+ (python-indent-calculate-levels): Use them.
+ (python-indent-calculate-indentation, python-indent-line):
+ (python-indent-line-function): Rewritten to use new API.
+ (python-indent-dedent-line): Simplify logic.
+ (python-indent-dedent-line-backspace): Use `unless`.
+ (python-indent-toggle-levels): Delete function.
+
+2015-01-28 Daniel Koning <dk@danielkoning.com> (tiny change)
+
+ * subr.el (posnp): Correct docstring of `posnp'.
+ (posn-col-row): Make it work with all mouse position objects.
+ * textmodes/artist.el (artist-mouse-draw-continously):
+ Cancel timers if an error occurs during continuous drawing. (Bug#6130)
+
+2015-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ * button.el (button-activate, push-button): Doc fix. (Bug#19628)
+
+2015-01-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el (file-notify-descriptors, file-notify-handle-event):
+ Adapt docstring.
+ (file-notify--descriptor): New defun.
+ (file-notify-callback, file-notify-add-watch, file-notify-rm-watch):
+ Adapt docstring. Handle multiple values for
+ `file-notify-descriptors' entries. (Bug#18880)
+
+ * net/tramp.el (tramp-handle-file-notify-rm-watch): Do not check
+ `file-notify-descriptors', the implementation has been changed.
+
+2015-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ * net/net-utils.el (net-utils-run-program, net-utils-run-simple):
+ On MS-Windows, bind coding-system-for-read to the console output
+ codepage. (Bug#19458)
+
+2015-01-28 Dmitry Gutov <dgutov@yandex.ru>
+
+ Unbreak `mouse-action' property in text buttons.
+ * button.el (push-button): Fix regression from 2012-12-06.
+
+2015-01-28 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/sh-script.el (sh-mode): Doc fix.
+ (sh-basic-indent-line): Handle electric newline. (Bug#18756)
+
+2015-01-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix dired quoting bug with "Hit`N`Hide".
+ * files.el (shell-quote-wildcard-pattern): Also quote "`". (Bug#19498)
+
+2015-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Tighten up the tagcode used for eieio and cl-struct objects.
+ * loadup.el: Load cl-preloaded.
+ * emacs-lisp/eieio-core.el (eieio-defclass-internal): Set the function
+ slot of the tag symbol to :quick-object-witness-check.
+ (eieio-object-p): Use :quick-object-witness-check.
+ (eieio--generic-tagcode): Use cl--generic-struct-tag.
+ * emacs-lisp/cl-preloaded.el: New file.
+ * emacs-lisp/cl-macs.el (cl--bind-inits): Remove, unused.
+ (cl--transform-lambda, cl-destructuring-bind): Remove cl--bind-inits.
+ (cl--make-usage-args): Strip away &aux args.
+ (cl-case, cl-typecase, cl--parse-loop-clause): Use macroexp-let2.
+ (cl-the, cl-check-type): Use macroexp-let2 and cl-typep.
+ (cl-defstruct): Use `declare' and cl-struct-define.
+ * emacs-lisp/cl-generic.el (cl--generic-struct-tag): New function.
+ (cl--generic-struct-tagcode): Use it to tighten the tagcode.
+
+2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/cl.el (cl--function-convert):
+ Merge cache that cl--labels-convert adds (bug#19699).
+
+2015-01-27 Ivan Shmakov <ivan@siamics.net>
+
+ * tar-mode.el: Allow for adding new archive members. (Bug#19274)
+ (tar-new-regular-file-header, tar--pad-to, tar--put-at)
+ (tar-header-serialize): New functions.
+ (tar-current-position): Split from tar-current-descriptor.
+ (tar-current-descriptor): Use it.
+ (tar-new-entry): New command.
+ (tar-mode-map): Bind it.
+
+2015-01-27 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-check-custom-command): Buffer local
+ because it usually includes the buffer name.
+ (python-check-command): Set to epylint when pyflakes is not available.
+
+2015-01-27 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * isearch.el (isearch-process-search-char): Add docstring.
+
+2015-01-27 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * emacs-lisp/derived.el (define-derived-mode): Declare indent 3.
+
+2015-01-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/cl.el (cl--function-convert): Run cl--labels-convert
+ for the case cl-flet or cl-labels form is wrapped with lexical-let
+ (bug#19613).
+
+2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-method): New struct.
+ (cl--generic): The method-table is now a (list-of cl--generic-method).
+ (cl--generic-member-method): New function.
+ (cl-generic-define-method): Use it.
+ (cl--generic-build-combined-method, cl--generic-cache-miss):
+ Adapt to new method-table.
+ (cl--generic-no-next-method-function): Add `method' argument.
+ (cl-generic-call-method): Adapt to new method representation.
+ (cl--generic-cnm-sample, cl--generic-nnm-sample): Adjust.
+ (cl-find-method, cl-method-qualifiers): New functions.
+ (cl--generic-method-info): Adapt to new method representation.
+ Return a string for the qualifiers.
+ (cl--generic-describe):
+ * emacs-lisp/eieio-opt.el (eieio-help-class): Adjust accordingly.
+ (eieio-all-generic-functions, eieio-method-documentation):
+ Adjust to new method representation.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use cl-find-method.
+
+2015-01-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el: Add a method-combination hook.
+ (cl-generic-method-combination-function): New var.
+ (cl--generic-lambda): Remove `with-cnm' arg.
+ (cl-defmethod): Change accordingly.
+ (cl-generic-define-method): Don't check qualifiers validity.
+ Preserve all qualifiers in `method-table'.
+ (cl-generic-call-method): New function.
+ (cl--generic-nest): Remove (morph into cl-generic-call-method).
+ (cl--generic-build-combined-method): Adjust to new format of method-table
+ and use cl-generic-method-combination-function.
+ (cl--generic-standard-method-combination): New function, extracted from
+ cl--generic-build-combined-method.
+ (cl--generic-cnm-sample): Adjust to new format of method-table.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Use () qualifiers
+ instead of :primary.
+
+ * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke):
+ Remove obsolete function.
+
+2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-make-table-1): Fix colspan typo.
+ (shr-make-table-1): Add comments.
+ (shr-make-table-1): Make colspan display more sensibly.
+
+ * net/eww.el (eww-add-bookmark): Fix prompt and clean up the code
+ slightly.
+
+2015-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl--generic-no-next-method-function): New fun.
+ (cl--generic-build-combined-method, cl--generic-nnm-sample): Use it
+ (bug#19672).
+ (cl--generic-typeof-types): Add support for `sequence'.
+ (cl-defmethod): Add non-keywords in the qualifiers.
+
+2015-01-25 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/find-func.el (find-function-regexp): Don't match
+ `defgroup' (regression from the previous change here).
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-search-internal): Mention binddn in invalid
+ credentials error message.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-password-read): Validate password before
+ caching it.
+ (ldap-search-internal): Handle ldapsearch error conditions.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-password-read): Handle password-cache being nil.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc.el (eudc-expand-inline): Always restore former server
+ and protocol.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-ldap.el: Don't nag the user in case a default base is
+ provided by the LDAP system configuration file.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc.el (eudc-format-query): Preserve the
+ eudc-inline-query-format ordering of attributes in the returned list.
+ * net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558):
+ Append the LDAP wildcard character to the last attribute value.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudcb-ldap.el (eudc-ldap-cleanup-record-simple):
+ Downcase field names of LDAP results.
+ (eudc-ldap-cleanup-record-filtering-addresses): Likewise.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-ldapsearch-password-prompt): New defcustom.
+ (ldap-search-internal): Send password to ldapsearch through a pipe
+ instead of via the command line.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el: Require password-cache.
+ (ldap-password-read): New function.
+ (ldap-search-internal): Call ldap-password-read when it is
+ configured to be called.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc-vars.el (eudc-expansion-overwrites-query):
+ Change default to nil.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc.el (eudc-expand-inline): Ignore text properties of
+ string-to-expand.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc-vars.el (eudc-inline-expansion-format): Default to a
+ format that includes first name and surname.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc-vars.el (eudc-inline-query-format): Change default to
+ query email and first name instead of surname.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ldap.el (ldap-search-internal): Support new-style LDAP URIs.
+
+2015-01-23 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/eudc-vars.el (eudc-server): Adjust docstring to mention
+ eudc-server-hotlist.
+ (eudc-server-hotlist): Move from eudc.el and make defcustom.
+ * net/eudc.el (eudc-server-hotlist): Move to eudc-vars.el.
+ (eudc-set-server): Allow setting protocol to nil.
+ (eudc-expand-inline): Support hotlist-only expansions when server
+ is not set.
+
+2015-01-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el (cl-no-primary-method): New fun and error.
+ (cl--generic-build-combined-method): Use it.
+
+2015-01-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't downcase system diagnostics' first letters
+ * emacs-lisp/bytecomp.el (byte-compile-file):
+ * ffap.el (find-file-at-point):
+ * files.el (insert-file-1):
+ * net/ange-ftp.el (ange-ftp-barf-if-not-directory)
+ (ange-ftp-copy-file-internal):
+ * progmodes/etags.el (visit-tags-table):
+ Keep diagnostics consistent with system's.
+ * ffap.el (ffap-machine-p):
+ Ignore case while comparing diagnostics.
+
+2015-01-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help.el (help-make-usage): Don't turn a "_" arg into an empty-string
+ arg (bug#19645).
+ * emacs-lisp/cl-generic.el (cl--generic-lambda): Don't confuse a string
+ body with a docstring.
+
+2015-01-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref-location-marker, xref-location-group):
+ Use `cl-defgeneric' and `cl-defmethod' instead of the EIEIO
+ counterparts.
+
+ * progmodes/etags.el (xref-location-marker): Same.
+
+ * progmodes/xref.el (xref--current): Rename from `xref--selected'.
+ (xref--inhibit-mark-current): Rename from
+ `xref--inhibit-mark-selected'. Update the usages.
+ (xref-quit): Reword the docstring. Kill buffers after quitting
+ windows instead of before.
+ (xref--insert-xrefs): Tweak help-echo.
+ (xref--read-identifier-history, xref--read-pattern-history):
+ New variables.
+ (xref--read-identifier, xref-find-apropos): Use them.
+
+2015-01-21 Ulrich Müller <ulm@gentoo.org>
+
+ * play/gamegrid.el (gamegrid-add-score-with-update-game-score):
+ Allow the 'update-game-score' helper program to run suid or sgid.
+
+2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el: Use cl-defmethod.
+ (defclass): Generate cl-defmethod calls; use setf methods for :accessor.
+ (eieio-object-name-string): Declare as obsolete.
+
+ * emacs-lisp/eieio-opt.el: Adapt to cl-generic.
+ (eieio--specializers-apply-to-class-p): New function.
+ (eieio-all-generic-functions): Use it.
+ (eieio-method-documentation): Use it as well as cl--generic-method-info.
+ Change format of return value.
+ (eieio-help-class): Adapt accordingly.
+
+ * emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
+ errors when there's a `before' but no `primary' (bug#19645).
+ (next-method-p): Return nil rather than signal an error.
+ (eieio-defgeneric): Remove bogus (fboundp 'method).
+
+ * emacs-lisp/eieio-speedbar.el:
+ * emacs-lisp/eieio-datadebug.el:
+ * emacs-lisp/eieio-custom.el:
+ * emacs-lisp/eieio-base.el: Use cl-defmethod.
+
+ * emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
+ (cl--generic-setf-rewrite): Setup the setf expander right away.
+ (cl-defmethod): Make sure the setf expander is setup before we expand
+ the body.
+ (cl-defmethod): Silence byte-compiler warnings.
+ (cl-generic-define-method): Shuffle code to change return value.
+ (cl--generic-method-info): New function, extracted from
+ cl--generic-describe.
+ (cl--generic-describe): Use it.
+
+2015-01-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref--xref-buffer-mode-map): Define before
+ the major mode. Remap `quit-window' to `xref-quit'.
+ (xref--xref-buffer-mode): Inherit from special-mode.
+
+ xref: Keep track of temporary buffers (bug#19466).
+ * progmodes/xref.el (xref--temporary-buffers, xref--selected)
+ (xref--inhibit-mark-selected): New variables.
+ (xref--mark-selected): New function.
+ (xref--show-location): Maybe add the buffer to
+ `xref--temporary-buffers', add `xref--mark-selected' to
+ `buffer-list-update-hook' there.
+ (xref--window): Add docstring.
+ (xref-quit): Rename from `xref--quit'. Update both references.
+ Add KILL argument. When it's non-nil, kill the temporary buffers
+ that haven't been selected by the user.
+ (xref--show-xref-buffer): Change the second argument to alist,
+ extract the values for `xref--window' and
+ `xref--temporary-buffers' from it. Add `xref--mark-selected' to
+ `buffer-list-update-hook' to each buffer in the list.
+ (xref--show-xrefs): Move the logic of calling `xref-find-function'
+ here. Save the difference between buffer lists before and after
+ it's called as "temporary buffers", and `pass it to
+ `xref-show-xrefs-function'.
+ (xref--find-definitions, xref-find-references)
+ (xref-find-apropos): Update accordingly.
+
+2015-01-20 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package-dir-info): Fix `while' logic.
+
+2015-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-generic.el: Remove.
+ (defgeneric, defmethod): Move to eieio-compat.el. Mark obsolete.
+ * emacs-lisp/eieio-compat.el: New file.
+ * emacs-lisp/eieio.el: Don't require eieio-generic any more.
+ * emacs-lisp/eieio-core.el (eieio--slot-originating-class-p):
+ Remove unused function.
+ (eieio-defclass): Move to eieio-compat.el.
+ * emacs-lisp/macroexp.el (macroexp-macroexpand): New function.
+ (macroexp--expand-all): Use it.
+ * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): Here too.
+
+2015-01-20 Michal Nazarewicz <mina86@mina86.com>
+
+ * emacs-lisp/eldoc.el (eldoc-documentation-function): Describe how
+ major modes should use `add-function' to alter value of the variable.
+ * hexl.el (hexl-mode):
+ * ielm.el (inferior-emacs-lisp-mode):
+ * progmodes/cfengine.el (cfengine3-mode):
+ * progmodes/elisp-mode.el (emacs-lisp-mode):
+ * progmodes/octave.el (octave-mode):
+ * progmodes/python.el (python-mode):
+ * simple.el (read--expression): Set `eldoc-documentation-function'
+ using `add-function' so the default value is always used.
+
+ * descr-text.el (describe-char-eldoc): New function returning
+ basic Unicode codepoint information (e.g. name) about character
+ at point. It is meant to be used as a default value of the
+ `eldoc-documentation-function' variable.
+ (describe-char-eldoc--format, describe-char-eldoc--truncate):
+ New helper functions for `describe-char-eldoc' function.
+
+2015-01-20 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/paragraphs.el (sentence-end-base): Include an
+ ellipsis (…) and interrobang (‽) characters as end of a sentence,
+ and a closing single quote (’) as an end of a quote.
+
+2015-01-20 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/tildify.el (tildify-double-space-undos): A new
+ variable specifying whether pressing space in `tildify-mode' after
+ a space has been replaced with hard space undos the substitution.
+ (tildify-space): Add code branch for handling `tildify-doule-space'.
+
+ * textmodes/tildify.el (tildify-space): A new function
+ which can be used as a `post-self-insert-hook' to automatically
+ convert spaces into hard spaces.
+ (tildify-space-pattern): A new variable specifying pattern where
+ `tildify-space' should take effect.
+ (tildify-space-predicates): A new variable specifying list of
+ predicate functions that all must return non-nil for
+ `tildify-space' to take effect.
+ (tildify-space-region-predicate): A new functions meant to be
+ used as a predicate in `tildify-space-predicates' list.
+ (tildify-mode): A new minor mode enabling `tildify-space' as a
+ `post-self-insert-hook'
+
+2015-01-20 Daniel Colascione <dancol@dancol.org>
+
+ * vc/vc-dir.el (vc-dir): Default to repository root, not
+ default-directory.
+
+2015-01-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/etags.el (xref-etags-location): New class.
+ (xref-make-etags-location): New function.
+ (etags--xref-find-definitions): Use it.
+ (xref-location-marker): New method implementation.
+
+ * progmodes/xref.el: Mention that xref-location is an EIEIO class.
+ (xref--insert-xrefs): Expand help-echo string.
+
+2015-01-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * ido.el: Update Customization instructions.
+
+2015-01-19 Jonas Bernoulli <jonas@bernoul.li>
+
+ Define Ido keymaps once (bug#17000).
+ * ido.el (ido-common-completion-map)
+ (ido-file-dir-completion-map)
+ (ido-file-completion-map, ido-buffer-completion-map): Set up key
+ bindings when each variable is defined.
+ (ido-completion-map): Move definition.
+ (ido-init-completion-maps): Noop.
+ (ido-common-initialization): Don't call it.
+ (ido-setup-completion-map): Improve doc-string, cleanup.
+
+2015-01-19 Ivan Shmakov <ivan@siamics.net>
+
+ * cus-dep.el (custom-make-dependencies): Ensure that
+ default-directory is interpreted as a directory (see bug#19140.)
+
+2015-01-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref--display-position):
+ Set `other-window-scroll-buffer'.
+ (xref-goto-xref): Use `user-error'.
+
+2015-01-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref--display-history): New variable.
+ (xref--window-configuration): Remove.
+ (xref--save-to-history): New function.
+ (xref--display-position): Use it. Add new argument.
+ (xref--restore-window-configuration): Remove.
+ (xref--show-location, xref-show-location-at-point):
+ Update accordingly.
+ (xref--xref-buffer-mode): Don't use `pre-command-hook'.
+ (xref--quit): New command.
+ (xref-goto-xref): Use it.
+ (xref--xref-buffer-mode-map): Bind `q' to it.
+
+2015-01-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref-goto-xref): Perform the jump even inside
+ indentation or at eol.
+
+2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic.
+ (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types):
+ New functions.
+ (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them.
+
+ * emacs-lisp/eieio.el (defclass): Add obsolescence warning for the
+ `newname' argument.
+
+ * emacs-lisp/cl-generic.el (cl-generic-define-method): Correctly handle
+ introduction of a new dispatch argument.
+ (cl--generic-cache-miss): Handle dispatch on an argument which was not
+ considered as dispatchable for this method.
+ (cl-defmethod): Warn when adding a method to an obsolete generic function.
+ (cl--generic-lambda): Make sure it works if cl-lib is not yet loaded.
+
+ * emacs-lisp/eieio-generic.el (eieio--defgeneric-init-form): Use autoloadp.
+
+2015-01-18 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--append-to-alist): Rename from
+ `package--add-to-alist'
+ Updated docstring due to new name.
+
+2015-01-18 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-extra.el (cl-subseq): Use seq-subseq and fix
+ multiple evaluation. (Bug#19519)
+
+ * emacs-lisp/seq.el (seq-subseq): Throw bad bounding indices
+ error. (Bug#19434)
+
+2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-core.el: Add `subclass' specializer for cl-generic.
+ (eieio--generic-subclass-tagcode, eieio--generic-subclass-tag-types):
+ New functions.
+ (cl-generic-tagcode-function, cl-generic-tag-types-function): Use them.
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Minor optimization when include
+ or print is nil.
+ (cl-struct-type-p): New function.
+
+ * emacs-lisp/cl-generic.el: Add support for cl-next-method-p.
+ (cl-defmethod): Add edebug spec.
+ (cl--generic-build-combined-method): Fix call to
+ cl-no-applicable-method.
+ (cl--generic-nnm-sample, cl--generic-cnm-sample): New constant.
+ (cl--generic-isnot-nnm-p): New function.
+ (cl--generic-lambda): Use it to add support for cl-next-method-p.
+ (cl-no-next-method, cl-no-applicable-method): Simplify arg list.
+ (cl-next-method-p): New function.
+
+2015-01-17 Ulrich Müller <ulm@gentoo.org>
+
+ * version.el (emacs-repository-get-version): Update docstring.
+
+2015-01-17 Ivan Shmakov <ivan@siamics.net>
+
+ * files.el (find-file-other-window, find-file-other-frame):
+ Use mapc instead of mapcar. (Bug#18175)
+
+ * files.el (dir-locals-collect-variables): Use default-directory
+ in place of the file name while working on non-file buffers, just
+ like hack-dir-local-variables already does. (Bug#19140)
+
+ * textmodes/enriched.el (enriched-encode):
+ Use inhibit-point-motion-hooks in addition to inhibit-read-only.
+ (Bug#18246)
+
+ * desktop.el (desktop-read): Do not call desktop-clear when no
+ desktop file is found. (Bug#18371)
+
+ * misearch.el (multi-isearch-unload-function): New function.
+ (misearch-unload-function): New alias. (Bug#19566)
+
+2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-core.el (eieio--class-constructor): Rename from
+ class-constructor, and make it an alias for `identity'.
+ Update all callers.
+
+ * emacs-lisp/eieio.el (eieio-constructor): Handle obsolete object name
+ argument here (bug#19620)...
+ (defclass): ...instead of in the constructor here.
+
+2015-01-16 Jorgen Schaefer <contact@jorgenschaefer.de>
+
+ * emacs-lisp/package.el (package-archive-priorities):
+ Specify correct type.
+
+2015-01-17 Ulrich Müller <ulm@gentoo.org>
+
+ * version.el (emacs-bzr-version-dirstate, emacs-bzr-version-bzr):
+ Remove.
+ (emacs-repository-get-version): Discard the Bazaar case.
+ * vc/vc-bzr.el (vc-bzr-version-dirstate): Rename from
+ emacs-bzr-version-dirstate and move from version.el to here.
+ (vc-bzr-working-revision): Use it.
+
+2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-generic.el (call-next-method): Don't bother checking
+ eieio--scoped-class any more.
+
+ * emacs-lisp/eieio-core.el (eieio--scoped-class-stack): Remove var.
+ (eieio--scoped-class): Remove function.
+ (eieio--with-scoped-class): Remove macro. Replace uses with `progn'.
+ (eieio--slot-name-index): Don't check the :protection anymore.
+ (eieio-initializing-object): Remove var.
+ (eieio-set-defaults): Don't let-bind eieio-initializing-object.
+
+2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Improve handling of doc-strings and describe-function for cl-generic.
+
+ * help-mode.el (help-function-def): Add optional arg `type'.
+
+ * help-fns.el (find-lisp-object-file-name): Accept any `type' as long
+ as it's a symbol.
+ (help-fns-short-filename): New function.
+ (describe-function-1): Use it. Use autoload-do-load.
+
+ * emacs-lisp/find-func.el: Use lexical-binding.
+ (find-function-regexp): Don't rule out `defgeneric'.
+ (find-function-regexp-alist): Document new possibility of including
+ a function instead of a regexp.
+ (find-function-search-for-symbol): Implement that new possibility.
+ (find-function-library): Don't assume that `function' is a symbol.
+ (find-function-do-it): Remove unused var `orig-buf'.
+
+ * emacs-lisp/eieio-generic.el (eieio--defalias): Move from eieio-core.
+ (eieio--defgeneric-init-form): Don't throw away a previous docstring.
+ (eieio--method-optimize-primary): Don't mess with the docstring.
+ (defgeneric): Keep the `args' in the docstring.
+ (defmethod): Don't use the method's docstring for the generic
+ function's docstring.
+
+ * emacs-lisp/eieio-core.el (eieio--defalias): Move to eieio-generic.el.
+ (eieio-defclass-autoload): Don't record the superclasses any more.
+ (eieio-defclass-internal): Reuse the old class object if it was just an
+ autoload stub.
+ (eieio--class-precedence-list): Load the class if it's autoloaded.
+
+ * emacs-lisp/cl-generic.el (cl-generic-ensure-function): It's OK to
+ override an autoload.
+ (cl-generic-current-method-specializers): Replace dyn-bind variable
+ with a lexically-scoped macro.
+ (cl--generic-lambda): Update accordingly.
+ (cl-generic-define-method): Record manually in the load-history with
+ type `cl-defmethod'.
+ (cl--generic-get-dispatcher): Minor optimization.
+ (cl--generic-search-method): New function.
+ (find-function-regexp-alist): Add entry for `cl-defmethod' type.
+ (cl--generic-search-method): Add hyperlinks for methods. Merge the
+ specializers and the function's arguments.
+
+2015-01-16 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--read-pkg-desc):
+ New function. Read a `define-package' form in current buffer.
+ Return the pkg-desc, with desc-kind set to KIND.
+ (package-dir-info): New function. Find package information for a
+ directory. The return result is a `package-desc'.
+ (package-install-from-buffer): Install packages from dired buffer.
+ (package-install-file): Install packages from directory.
+ (package-desc-suffix)
+ (package-install-from-archive)
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Ensure all remaining instances of `package-desc-kind' handle the 'dir
+ value.
+
+2015-01-16 Jorgen Schaefer <contact@jorgenschaefer.de>
+
+ * emacs-lisp/package.el: Provide repository priorities.
+ (package-archive-priorities): New variable.
+ (package--add-to-alist): New function.
+ (package--add-to-archive-contents): Use it.
+ (package-menu--find-upgrades): Use it as well. Small clean up to
+ make the use of the package name here explicit.
+ (package-archive-priority): New function.
+ (package-desc-priority-version): New function.
+
+2015-01-16 Daniel Colascione <dancol@dancol.org>
+
+ * cus-start.el (all): Make `ring-bell-function' customizable.
+
+2015-01-16 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-svn.el (vc-svn-dir-status-files): Pass t as
+ vc-svn-after-dir-status's second argument. (Bug#19429)
+
+2015-01-16 Samer Masterson <samer@samertm.com>
+
+ * pcomplete.el (pcomplete-parse-arguments): Parse arguments
+ regardless of pcomplete-cycle-completions's value. (Bug#18950)
+
+2015-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dom.el (dom-strings): New function.
+
+ * files.el (directory-files-recursively): Don't use the word
+ "path" for a file name.
+
+2015-01-15 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * calc/calc-units.el (math-units-in-expr-p)
+ (math-single-units-in-expr-p, math-find-compatible-unit-rec)
+ (math-extract-units): Handle the `neg' operator. (Bug#19582)
+
+2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--labels-magic): New constant.
+ (cl--labels-convert): Use it to ask the macro what is its replacement
+ in the #'f case.
+
+ * emacs-lisp/cl-generic.el (cl--generic-build-combined-method):
+ Return the value of the primary rather than the after method.
+
+ * emacs-lisp/eieio-core.el: Provide support for cl-generic.
+ (eieio--generic-tagcode): New function.
+ (cl-generic-tagcode-function): Use it.
+ (eieio--generic-tag-types): New function.
+ (cl-generic-tag-types-function): Use it.
+ (eieio-object-p): Tighten up the test.
+
+ * emacs-lisp/cl-generic.el (cl-generic-define-method): Fix paren typo.
+
+2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-generic.el: New file.
+
+ * emacs-lisp/cl-macs.el (cl-flet): Allow (FUN EXP) forms.
+ (cl-load-time-value, cl-labels): Use closures rather than
+ backquoted lambdas.
+ (cl-macrolet): Use `eval' to create the function value, and support CL
+ style arguments in for the defined macros.
+
+2015-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/eww.el: Use lexical-binding.
+ (eww-links-at-point): Remove unused arg.
+ (eww-mode-map): Inherit from special-mode-map.
+ (eww-mode): Derive from special-mode. Don't use `setq' on a hook.
+
+2015-01-13 Alan Mackenzie <acm@muc.de>
+
+ Allow compilation during loading of CC Mode-derived modes (bug#19206).
+ * progmodes/cc-bytecomp.el (cc-bytecomp-compiling-or-loading):
+ New function which walks the stack to discover whether we're compiling
+ or loading.
+ (cc-bytecomp-is-compiling): Reformulate, and move towards beginning.
+ (cc-bytecomp-is-loading): New defsubst.
+ (cc-bytecomp-setup-environment, cc-bytecomp-restore-environment):
+ Use the above defsubsts.
+ (cc-require-when-compile, cc-bytecomp-defvar)
+ (cc-bytecomp-defun): Simplify conditionals.
+ * progmodes/cc-defs.el (cc-bytecomp-compiling-or-loading):
+ "Borrow" this function from cc-bytecomp.el.
+ (c-get-current-file): Reformulate using the above.
+ (c-lang-defconst): Prevent duplicate entries of file names in a
+ symbol's 'source property.
+ (c-lang-const): Use cc-bytecomp-is-compiling.
+ * progmodes/cc-langs.el (c-make-init-lang-vars-fun):
+ Use cc-bytecomp-is-compiling.
+
+2015-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-core.el (eieio-defclass): Fix call to `defclass'
+ (bug#19552).
+
+2015-01-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * menu-bar.el (menu-bar-goto-menu): Before calling
+ `xref-marker-stack-empty-p', first check that `xref' is loaded.
+ (Bug#19554)
+
+2015-01-12 Martin Rudalics <rudalics@gmx.at>
+
+ * progmodes/xref.el (xref-marker-stack-empty-p): Add autoload
+ cookie (Bug#19554).
+
+ * frame.el (frame-notice-user-settings): Remove code dealing with
+ frame-initial-frame-tool-bar-height. Turn off `tool-bar-mode'
+ only if `window-system-frame-alist' or `default-frame-alist' ask
+ for it.
+ (make-frame): Update frame-adjust-size-history if needed.
+
+2015-01-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Have 'make' output better GEN names
+ * Makefile.in (PHONY_EXTRAS): New macro.
+ (.PHONY): Depend on it, and on $(lisp)/loaddefs.el, so that the
+ relevant files' time stamps are ignored.
+ (custom-deps, $(lisp)/cus-load.el, finder-data)
+ ($(lisp)/finder-inf.el): Use PHONY_EXTRAS.
+ (custom-deps, $(lisp)/cus-load.el, finder-data)
+ ($(lisp)/finder-inf.el, autoloads, $(lisp)/loaddefs.el)
+ ($(lisp)/subdirs.el, update-subdirs):
+ Output more-accurate destination names with GEN.
+
+ Say "ELC foo.elc" instead of "GEN foo.elc"
+ * Makefile.in (AM_V_ELC, am__v_ELC_, am__v_ELC_0, am__v_ELC_1):
+ New macros.
+ ($(THEFILE)c, .el.elc): Use them.
+
+2015-01-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (directory-files-recursively): Do not include
+ superfluous remote file names.
+
+2015-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww): Interpret anything that looks like a protocol
+ designator as a full URL.
+
+2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-urlify): Don't bother the user about
+ invalidly-encoded display strings.
+
+2015-01-10 Ivan Shmakov <ivan@siamics.net>
+
+ * net/shr.el (shr-urlify): Decode URLs before using them as titles
+ (bug#19555).
+
+2015-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww): Always interpret URLs that start with https?:
+ as plain URLs, even if they have spaces in them (bug#19556).
+ (eww): Also interpret things like "en.wikipedia.org/wiki/Free
+ software" as an URL.
+ (eww): Don't interpret "org/foo" as an URL.
+ (eww): Clear the title when loading so that we don't display
+ misleading information.
+
+2015-01-10 Daniel Colascione <dancol@dancol.org>
+
+ * vc/vc-hooks.el (vc-prefix-map): Bind vc-delete-file to C-x v x,
+ by analogy with dired.
+
+2015-01-09 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/js.el (js--function-heading-1-re)
+ (js--function-prologue-beginning): Parse ES6 generator function
+ declarations. (That is, "function* name()").
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (defclass): Move from eieio-defclass all the code
+ that creates functions, and most of the sanity checks.
+ Mark as obsolete the <class>-child-p function.
+ * emacs-lisp/eieio-core.el (eieio--define-field-accessors): Remove.
+ (eieio--class, eieio--object): Use cl-defstruct.
+ (eieio--object-num-slots): Define manually.
+ (eieio-defclass-autoload): Use eieio--class-make.
+ (eieio-defclass-internal): Rename from eieio-defclass. Move all the
+ `(lambda...) definitions and most of the sanity checks to `defclass'.
+ Mark as obsolete the <class>-list-p function, the <class> variable and
+ the <initarg> variables. Use pcase-dolist.
+ (eieio-defclass): New compatibility function.
+ * emacs-lisp/eieio-opt.el (eieio-build-class-alist)
+ (eieio-class-speedbar): Don't use eieio-default-superclass var.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-generic.el: New file.
+ * emacs-lisp/eieio-core.el: Move all generic function code to
+ eieio-generic.el.
+ (eieio--defmethod): Declare.
+
+ * emacs-lisp/eieio.el: Require eieio-generic. Move all generic
+ function code to eieio-generic.el.
+ * emacs-lisp/eieio-opt.el (eieio-help-generic): Move to
+ eieio-generic.el.
+ * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): Update call
+ to eieio--generic-call.
+ * emacs-lisp/eieio-base.el (eieio-instance-inheritor): Don't use
+ <class>-child type.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/chart.el (chart-add-sequence, chart-bar-quickie):
+ Don't use <class> as a variable.
+
+ * emacs-lisp/eieio.el (same-class-p): Accept class object as well.
+ (call-next-method): Simplify.
+ (clone): Obey eieio-backward-compatibility.
+
+ * emacs-lisp/eieio-opt.el (eieio-read-generic-p): Remove.
+ (eieio-read-generic): Use `generic-p' instead.
+
+ * emacs-lisp/eieio-core.el (eieio-backward-compatibility): New var.
+ (eieio-defclass-autoload): Obey it.
+ (eieio--class-object): Improve error behavior.
+ (eieio-class-children-fast, same-class-fast-p): Remove. Inline at
+ every use site.
+ (eieio--defgeneric-form-primary-only): Rename from
+ eieio-defgeneric-form-primary-only; update all callers.
+ (eieio--defgeneric-form-primary-only-one): Rename from
+ eieio-defgeneric-form-primary-only-one; update all callers.
+ (eieio-defgeneric-reset-generic-form)
+ (eieio-defgeneric-reset-generic-form-primary-only)
+ (eieio-defgeneric-reset-generic-form-primary-only-one): Remove.
+ (eieio--method-optimize-primary): New function to replace them.
+ (eieio--defmethod, eieio-defmethod): Use it.
+ (eieio--perform-slot-validation): Rename from
+ eieio-perform-slot-validation; update all callers.
+ (eieio--validate-slot-value): Rename from eieio-validate-slot-value.
+ Change `class' to be a class object. Update all callers.
+ (eieio--validate-class-slot-value): Rename from
+ eieio-validate-class-slot-value. Change `class' to be a class object.
+ Update all callers.
+ (eieio-oset-default): Accept class object as well.
+ (eieio--generic-call-primary-only): Rename from
+ eieio-generic-call-primary-only. Update all callers.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
+ Improve error messages.
+ (eieio-persistent-slot-type-is-class-p): Handle `list-of' types, as
+ well as user-defined types. Emit errors for legacy types like
+ <class>-child and <class>-list, if not eieio-backward-compatibility.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (eieio-class-parents): Accept class objects.
+ (eieio--class-slot-initarg): Rename from class-slot-initarg.
+ Change `class' arg to be a class object. Update all callers.
+ (call-next-method): Adjust to new return value of `eieio-generic-form'.
+ (eieio-default-superclass): Set var to the class object.
+ (eieio-edebug-prin1-to-string): Fix recursive call for lists.
+ Change print behavior to affect class objects rather than
+ class symbols.
+
+ * emacs-lisp/eieio-core.el (eieio-class-object): New function.
+ (eieio-class-parents-fast): Remove macro.
+ (eieio--class-option-assoc): Rename from class-option-assoc.
+ Update all callers.
+ (eieio--class-option): Rename from class-option. Change `class' arg to
+ be a class object. Update all callers.
+ (eieio--class-method-invocation-order): Rename from
+ class-method-invocation-order. Change `class' arg to be a class
+ object. Update all callers.
+ (eieio-defclass-autoload, eieio-defclass): Set the `parent' field to
+ a list of class objects rather than names.
+ (eieio-defclass): Remove redundant quotes. Use `eieio-oref-default'
+ for accessors to class allocated slots.
+ (eieio--perform-slot-validation-for-default): Rename from
+ eieio-perform-slot-validation-for-default. Update all callers.
+ (eieio--add-new-slot): Rename from eieio-add-new-slot.
+ Update all callers. Use push.
+ (eieio-copy-parents-into-subclass): Adjust to new content of
+ `parent' field. Use dolist.
+ (eieio-oref): Remove support for providing a class rather than
+ an object.
+ (eieio-oref-default): Prefer class objects over class names.
+ (eieio--slot-originating-class-p): Rename from
+ eieio-slot-originating-class-p. Update all callers. Use `or'.
+ (eieio--slot-name-index): Turn check into assertion.
+ (eieio--class-slot-name-index): Rename from
+ eieio-class-slot-name-index. Change `class' arg to be a class object.
+ Update all callers.
+ (eieio-attribute-to-initarg): Move to eieio-test-persist.el.
+ (eieio--c3-candidate): Rename from eieio-c3-candidate.
+ Update all callers.
+ (eieio--c3-merge-lists): Rename from eieio-c3-merge-lists.
+ Update all callers.
+ (eieio--class-precedence-c3): Rename from eieio-class-precedence-c3.
+ Update all callers.
+ (eieio--class-precedence-dfs): Rename from eieio-class-precedence-dfs.
+ Update all callers.
+ (eieio--class-precedence-bfs): Rename from eieio-class-precedence-bfs.
+ Update all callers. Adjust to new `parent' content.
+ (eieio--class-precedence-list): Rename from -class-precedence-list.
+ Update all callers.
+ (eieio-generic-call): Use autoloadp and autoload-do-load.
+ Slight simplification.
+ (eieio-generic-call, eieio-generic-call-primary-only): Adjust to new
+ return value of `eieio-generic-form'.
+ (eieiomt-add): Index the hashtable with class objects rather than
+ class names.
+ (eieio-generic-form): Accept class objects as well.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object):
+ Adjust to new convention for eieio-persistent-validate/fix-slot-value.
+ (eieio-persistent-validate/fix-slot-value):
+ Change `class' arg to be a class object. Update all callers.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects
+ additionally to class names.
+
+ * emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding.
+ (object): Remove first (constant) slot; rename second to `class-tag'.
+ (eieio--object-class-object, eieio--object-class-name): New funs
+ to replace eieio--object-class.
+ (eieio--class-object, eieio--class-p): New functions.
+ (same-class-fast-p): Make it a defsubst, change its implementation
+ to check the class objects rather than their names.
+ (eieio-object-p): Rewrite.
+ (eieio-defclass): Adjust the object initialization according to the new
+ object layout.
+ (eieio--scoped-class): Declare it returns a class object (not a class
+ name any more). Adjust calls accordingly (along with calls to
+ eieio--with-scoped-class).
+ (eieio--slot-name-index): Rename from eieio-slot-name-index and change
+ its class arg to be a class object. Adjust callers accordingly.
+ (eieio-slot-originating-class-p): Make its start-class arg a class
+ object. Adjust all callers.
+ (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute.
+ Make its `class' arg a class object. Adjust all callers.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value):
+ Use eieio--slot-name-index rather than eieio-slot-name-index.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object
+ name argument.
+ (eieio-object-name): Use eieio-object-name-string.
+ (eieio--object-names): New const.
+ (eieio-object-name-string, eieio-object-set-name-string): Re-implement
+ using a hashtable rather than a built-in slot.
+ (eieio-constructor): Rename from `constructor'. Remove `newname' arg.
+ (clone): Don't mess with the object's "name".
+
+ * emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg.
+ (eieio-object-value-get): Use eieio-object-set-name-string.
+
+ * emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases.
+ (eieio--object): Remove `name' field.
+ (eieio-defclass): Adjust to new convention where constructors don't
+ take an "object name" any more.
+ (eieio--defgeneric-init-form, eieio--defmethod): Follow aliases.
+ (eieio-validate-slot-value, eieio-oset-default)
+ (eieio-slot-name-index): Don't hardcode eieio--object-num-slots.
+ (eieio-generic-call-primary-only): Simplify.
+
+ * emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>:
+ Use call-next-method.
+ (eieio-constructor): Rename from `constructor'.
+ (eieio-persistent-convert-list-to-object): Drop objname.
+ (eieio-persistent-validate/fix-slot-value): Don't hardcode
+ eieio--object-num-slots.
+ (eieio-named): Use a normal slot.
+ (slot-missing) <eieio-named>: Remove.
+ (eieio-object-name-string, eieio-object-set-name-string, clone)
+ <eieio-named>: New methods.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v.
+ (method-*): Add a "eieio--" prefix to those constants.
+
+ * emacs-lisp/eieio.el: Move edebug specs to the corresponding macro.
+
+ * emacs-lisp/eieio-speedbar.el: Use lexical-binding.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el (child-of-class-p): Fix case where `class' is
+ `eieio-default-superclass'.
+
+ * emacs-lisp/eieio-datadebug.el: Use lexical-binding.
+
+ * emacs-lisp/eieio-custom.el: Use lexical-binding.
+ (eieio-object-value-to-abstract): Simplify.
+
+ * emacs-lisp/eieio-opt.el (eieio-build-class-list): Use cl-mapcan.
+ (eieio-build-class-alist): Use dolist.
+ (eieio-all-generic-functions): Adjust to use of hashtables.
+
+ * emacs-lisp/eieio-core.el (class): Rename field symbol-obarray to
+ symbol-hashtable. It contains a hashtable instead of an obarray.
+ (generic-p): Use symbol property `eieio-method-hashtable' instead of
+ `eieio-method-obarray'.
+ (generic-primary-only-p, generic-primary-only-one-p):
+ Slight optimization.
+ (eieio-defclass-autoload-map): Use a hashtable instead of an obarray.
+ (eieio-defclass-autoload, eieio-defclass): Adjust/simplify accordingly.
+ (eieio-class-un-autoload): Use autoload-do-load.
+ (eieio-defclass): Use dolist, cl-pushnew, cl-callf.
+ Use new cl-deftype-satisfies. Adjust to use of hashtables.
+ Don't hardcode the value of eieio--object-num-slots.
+ (eieio-defgeneric-form-primary-only-one): Remove `doc-string' arg.
+ Use a closure rather than a backquoted lambda.
+ (eieio--defmethod): Adjust call accordingly. Set doc-string via the
+ function-documentation property.
+ (eieio-slot-originating-class-p, eieio-slot-name-index)
+ (eieiomt--optimizing-hashtable, eieiomt-install, eieiomt-add)
+ (eieio-generic-form): Adjust to use of hashtables.
+ (eieiomt--sym-optimize): Rename from eieiomt-sym-optimize; take
+ additional class argument.
+ (eieio-generic-call-methodname): Remove, unused.
+
+ * emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
+ Prefer \' to $.
+
+2015-01-08 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-visual): When converting X pixel coordinate
+ to temporary-goal-column, adjust the value for right-to-left
+ screen lines. This fixes vertical-motion, next/prev-line, etc.
+
+2015-01-08 Glenn Morris <rgm@gnu.org>
+
+ * files.el (file-tree-walk): Remove; of unknown authorship. (Bug#19325)
+
+2015-01-07 K. Handa <handa@gnu.org>
+
+ * international/ccl.el (define-ccl-program): Improve the docstring.
+
+2015-01-06 Sam Steingold <sds@gnu.org>
+
+ * shell.el (shell-display-buffer-actions): Remove,
+ use `display-buffer-alist' instead.
+
+2015-01-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref--insert-xrefs): Add `help-echo' property
+ to the references.
+
+2015-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-category-defaults): New var.
+ Set unicode-name to use substring completion.
+ (completion-category-defaults): Set it to nil.
+
+2015-01-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ Add mouse interaction to xref.
+ * progmodes/xref.el (xref--button-map): New variable.
+ (xref--mouse-2): New command.
+ (xref--insert-xrefs): Add `mouse-face' and `keymap' properties to
+ the inserted references.
+
+2015-01-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Less 'make' chatter for lisp dir
+ * Makefile.in (THEFILE): Define to be 'no-such-file' by default,
+ to make it clearer that the caller must specify it.
+ (compile-onefile): Remove, replacing by ...
+ ($(THEFILE)c): ... new rule. This lets us use AM_V_GEN here.
+ ($(THEFILE)c, .el.elc, $(MH_E_DIR)/mh-loaddefs.el)
+ ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el)
+ ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el):
+ Use AM_V_GEN to lessen 'make' chatter.
+ (.el.elc): Omit duplicate comment.
+
+ Less 'make' chatter in batch mode
+ * emacs-lisp/autoload.el (autoload-generate-file-autoloads):
+ * emacs-lisp/bytecomp.el (byte-compile-file):
+ * files.el (save-buffer, basic-save-buffer):
+ * international/quail.el (quail-update-leim-list-file):
+ Don't output messages like "Generating ..." in batch mode.
+
+2015-01-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ Unbreak `mouse-action' property in text buttons.
+ * button.el (push-button): Fix regression from 2012-12-06.
+
+2015-01-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref-marker-stack-empty-p): New function.
+
+ * menu-bar.el (menu-bar-goto-menu): Use it.
+
+2015-01-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref--window-configuration): New variable.
+ (xref-show-location-at-point): New command.
+ (xref--restore-window-configuration): New function.
+ (xref-next-line, xref-prev-line): Delegate to
+ `xref-show-location-at-point'.
+ (xref--location-at-point): Don't signal the error.
+ (xref-goto-xref): Do that here instead.
+ (xref--xref-buffer-mode): Add `xref--restore-window-configuration'
+ to `pre-command-hook'.
+ (xref--xref-buffer-mode-map): Don't remap `next-line' and
+ `previous-line'. Additionally bind `xref-next-line' and
+ `xref-prev-line' to `n' and `p' respectively.
+ Bind `xref-show-location-at-point' to `C-o'.
+
+2015-01-01 Eli Zaretskii <eliz@gnu.org>
+
+ * tool-bar.el (tool-bar-local-item)
+ (tool-bar-local-item-from-menu): Call force-mode-line-update to
+ make sure the tool-bar changes show on display.
+
+2015-01-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.11.
+
+ * net/tramp-compat.el (top): Require cl-macs for Emacs 22.
+ Make an alias for `default-toplevel-value' if it doesn't exist.
+
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory):
+ Use `tramp-compat-delete-directory'.
+
+ * net/trampver.el: Update release number.
+
+2015-01-01 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ * autorevert.el (auto-revert-handler): Fix auto-revert-tail-mode
+ for remote files. (Bug#19449)
+
+2015-01-01 Simen Heggestøyl <simenheg@gmail.com> (tiny change)
+
+ * textmodes/css-mode.el (scss-mode): Fix typo (bug#19446).
+
+2014-12-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Less 'make' chatter in lisp directory
+ * Makefile.in (AM_DEFAULT_VERBOSITY, AM_V_GEN, am__v_GEN_)
+ (am__v_GEN_0, am__v_GEN_1): New macros, from ../src/Makefile.in.
+ (custom-deps, finder-data, autoloads, update-subdirs): Use them.
+
+2014-12-31 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ * info.el (info-display-manual): Limit the completion alternatives
+ to currently visited manuals if prefix argument is non-nil.
+
+2014-12-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (semantic): Simplify.
+
+2014-12-30 Juri Linkov <juri@linkov.net>
+
+ * net/eww.el (eww-isearch-next-buffer): New function.
+ (eww-mode): Set multi-isearch-next-buffer-function to it.
+
+2014-12-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/xref.el (xref-find-definitions): Mention "no
+ identifier at point" case in the docstring.
+
+ * menu-bar.el (menu-bar-goto-uses-etags-p): New function.
+ (menu-bar-goto-menu): Use it to show or hide the `set-tags-name'
+ and `separator-tag-file' items.
+
+2014-12-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * obsolete/pc-select.el (pc-selection-mode): Use system-type.
+ This is instead of system-name, which is both wrong here and obsolete.
+ * desktop.el (desktop-save-frameset):
+ * dnd.el (dnd-get-local-file-uri):
+ * nxml/rng-uri.el (rng-uri-file-name-1):
+ Prefer (system-name) to system-name, and avoid naming
+ locals 'system-name'.
+ * startup.el (system-name): Now an obsolete variable. (Bug#19438)
+
+2014-12-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * menu-bar.el (menu-bar-next-tag-other-window)
+ (menu-bar-next-tag): Remove.
+
+2014-12-29 K. Handa <handa@gnu.org>
+
+ * international/mule.el (make-translation-table-from-alist):
+ Accept nil or zero-length vector for FROM and TO.
+
+2014-12-29 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-mode): Truncate overlong lines for prettier
+ display when resizing.
+
+ * net/shr.el (shr-width): Default to using the window width when
+ rendering.
+
+2014-12-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ Unbreak jumping to an alias's definition.
+ * emacs-lisp/find-func.el (find-function-library): Return a pair
+ (ORIG-FUNCTION . LIBRARY) instead of just its second element.
+ (find-function-noselect): Use it.
+ * progmodes/elisp-mode.el (elisp--xref-identifier-file): Rename to
+ `elisp--xref-identifier-location', incorporate logic from
+ `elisp--xref-find-definitions', use the changed
+ `find-function-library' return value.
+
+2014-12-29 Juri Linkov <juri@linkov.net>
+
+ * comint.el (comint-history-isearch-message): Use field-beginning
+ instead of comint-line-beginning-position - that's more fixes for
+ http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html
+ (comint-history-isearch-message): Fix args of isearch-message-prefix.
+
+2014-12-29 Juri Linkov <juri@linkov.net>
+
+ * vc/vc-dir.el (vc-dir-display-file): New command (bug#19450).
+ (vc-dir-mode-map): Bind it to "\C-o".
+ (vc-dir-menu-map): Add it to menu.
+
+2014-12-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/etags.el (find-tag-other-window)
+ (find-tag-other-frame, find-tag-regexp, tags-loop-continue)
+ (tags-apropos): Declare obsolete.
+
+ * menu-bar.el (menu-bar-goto-menu): Replace all but one etags item
+ with xref ones.
+
+2014-12-28 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule.el (define-coding-system): Fix typos in the
+ doc string.
+
+2014-12-28 Kenichi Handa <handa@gnu.org>
+
+ * international/mule.el (define-coding-system): Improve the doc
+ string.
+
+2014-12-28 Ivan Shmakov <ivan@siamics.net>
+
+ * net/shr.el (shr-tag-table): Fix handling of tbody/header/footer
+ elements in tables (bug#19444).
+
+ * net/eww.el (eww-handle-link): Fix typo in "up" rel handling
+ (bug#19445).
+
+2014-12-28 Juri Linkov <juri@linkov.net>
+
+ * vc/compare-w.el: Require diff-mode for diff faces.
+ (compare-windows-removed, compare-windows-added): New faces
+ inheriting from diff faces.
+ (compare-windows): Define obsolete face alias.
+ (compare-windows-highlight): Replace face `compare-windows' with
+ new faces `compare-windows-added' and `compare-windows-removed'
+ (bug#19451).
+ (compare-windows-get-recent-window): Signal an error when
+ no other window is found (bug#19170).
+
+2014-12-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/elisp-mode.el (elisp--xref-identifier-file):
+ Skip features that have no sources.
+
+ * simple.el (execute-extended-command):
+ When `suggest-key-bindings' is nil, don't.
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Native readline completion.
+ * progmodes/python.el (python-shell-completion-native-disabled-interpreters)
+ (python-shell-completion-native-enable)
+ (python-shell-completion-native-output-timeout): New defcustoms.
+ (python-shell-completion-native-interpreter-disabled-p)
+ (python-shell-completion-native-try)
+ (python-shell-completion-native-setup)
+ (python-shell-completion-native-turn-off)
+ (python-shell-completion-native-turn-on)
+ (python-shell-completion-native-turn-on-maybe)
+ (python-shell-completion-native-turn-on-maybe-with-msg)
+ (python-shell-completion-native-toggle): New functions.
+ (python-shell-completion-native-get-completions): New function.
+ (python-shell-completion-at-point): Use it.
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Enhance shell user interaction and deprecate
+ python-shell-get-or-create-process.
+ * progmodes/python.el (python-shell-get-process-or-error):
+ New function.
+ (python-shell-with-shell-buffer): Use it.
+ (python-shell-send-string, python-shell-send-region)
+ (python-shell-send-buffer, python-shell-send-defun)
+ (python-shell-send-file, python-shell-switch-to-shell): Use it.
+ Add argument MSG to display user-friendly message when no process
+ is running.
+ (python-shell-switch-to-shell): Call pop-to-buffer with NORECORD.
+ (python-shell-make-comint): Rename argument SHOW from POP.
+ Use display-buffer instead of pop-to-buffer.
+ (run-python): Doc fix. Return process.
+ (python-shell-get-or-create-process): Make obsolete.
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-buffer-substring):
+ Handle cornercase when region sent starts at point-min.
+
+2014-12-27 Eli Zaretskii <eliz@gnu.org>
+
+ * language/misc-lang.el (composition-function-table): Add Syriac
+ characters and also ZWJ/ZWNJ.
+ See http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html
+ for the details.
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Fix message when sending region.
+ * progmodes/python.el (python-shell-send-region): Rename argument
+ send-main from nomain. Fix message.
+ (python-shell-send-buffer): Rename argument send-main from arg.
+
+ python.el: Cleanup temp files even with eval errors.
+ * progmodes/python.el (python-shell-send-file): Make file-name
+ mandatory. Fix temp file removal in the majority of cases.
+
+ python.el: Handle file encoding for shell.
+ * progmodes/python.el (python-rx-constituents): Add coding-cookie.
+ (python-shell--save-temp-file): Write file with proper encoding.
+ (python-shell-buffer-substring): Add coding cookie for detected
+ encoding to generated content. Fix blank lines when removing
+ if-name-main block.
+ (python-shell-send-file): Handle file encoding.
+ (python-info-encoding-from-cookie)
+ (python-info-encoding): New functions.
+
+2014-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
+ Use `tramp-rsh-end-of-line', it ought to be more robust.
+
+2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/js.el (js-syntax-propertize): "return" can't be divided
+ (bug#19397).
+
+2014-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-read-passwd): Ignore errors from `auth-source-*'.
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): Use "\n"
+ as end-of-line delimeter for passwords, when running on MS Windows.
+
+2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-set-shell): Don't change the global value
+ of indent-line-function (bug#19433).
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix line numbers on Python shell.
+ * progmodes/python.el (python-shell--save-temp-file): Do not
+ append coding cookie.
+ (python-shell-send-string): Generalize for
+ python-shell-send-region.
+ (python--use-fake-loc): Delete var.
+ (python-shell-buffer-substring): Cleanup fake-loc logic.
+ (python-shell-send-region): Remove fake-loc logic, simplify.
+
+2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-post-self-insert-function):
+ Make colon to re-indent only for dedenters, handling
+ multiline-statements gracefully.
+
+2014-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-insert-file-contents):
+ Set `find-file-not-found-functions' in case of errors. (Bug#18623)
+
+2014-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-send-command-and-read): New optional
+ arg MARKER.
+ (tramp-get-remote-path): Use it.
+
+2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (redisplay-dont-pause): Mark as obsolete.
+
+2014-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-error-with-buffer): Call `message' properly.
+ (tramp-accept-process-output): Use nil as argument for
+ `accept-process-output', when there is a gateway prepended.
+
+ * net/tramp-gw.el (tramp-gw-open-connection): Suppress traces in
+ wrong debug buffer.
+ (tramp-gw-open-connection): Set process coding system 'binary.
+ (tramp-gw-open-network-stream): Handle HTTP error 403.
+
+ * net/tramp-sh.el (tramp-compute-multi-hops): Suppress traces in
+ wrong debug buffer.
+ (tramp-maybe-open-connection): Set connection property "gateway".
+
+2014-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (sit-for): Tweak docstring (bug#19381).
+
+2014-12-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-after-dir-status-stage): Move `up-to-date'
+ stage to after `diff-index' (bug#19386).
+
+2014-12-27 João Távora <joaotavora@gmail.com>
+
+ * textmodes/tex-mode.el (tex-insert-quote): Consider and respect
+ `electric-pair-mode' (bug#19356).
+
+2014-12-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ elisp-xref-find: Don't create buffers eagerly.
+
+ * progmodes/elisp-mode.el (elisp--identifier-location): Fold back
+ into `elisp--company-location'.
+ (elisp--identifier-completion-table): Rename to
+ `elisp--identifier-completion-table', and do not include just any
+ symbols with a property list.
+ (elisp-completion-at-point): Revert the 2014-12-25 change.
+ (elisp--xref-identifier-file): New function.
+ (elisp--xref-find-definitions): Use it.
+
+ * emacs-lisp/find-func.el (find-function-library): New function,
+ extracted from `find-function-noselect'.
+
+ * progmodes/xref.el (xref-elisp-location): New class.
+ (xref-make-elisp-location): New function.
+ (xref-location-marker): New implementation.
+
+2014-12-27 Juri Linkov <juri@linkov.net>
+
+ * minibuffer.el (minibuffer-completion-help):
+ Use shrink-window-if-larger-than-buffer in window-height
+ when temp-buffer-resize-mode is nil.
+
+ * window.el (with-displayed-buffer-window): Remove window-height
+ from the action alist in the temp-buffer-window-show call
+ when window-height is handled explicitly afterwards (bug#19355).
+
+2014-12-27 Juri Linkov <juri@linkov.net>
+
+ Support subdirectories when saving places in dired.
+ * saveplace.el (toggle-save-place, save-place-to-alist)
+ (save-places-to-alist, save-place-dired-hook):
+ Use dired-current-directory instead of dired-directory (bug#19436).
+ (save-place-dired-hook): Add check for alist to make the new
+ format future-proof to allow other possible formats.
+
+2014-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ python.el: Generate clearer shell buffer names.
+ * progmodes/python.el (python-shell-get-process-name)
+ (python-shell-internal-get-process-name): Use `buffer-name`.
+ (python-shell-internal-get-or-create-process): Simplify.
+
+2014-12-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ Add basic xref apropos implementation to elisp-mode.
+
+ * progmodes/elisp-mode.el (elisp--xref-find-definitions):
+ Filter out nil results.
+ (elisp--xref-find-apropos): New function.
+ (elisp-xref-find): Use it.
+
+ * progmodes/xref.el (xref--show-xrefs): Use `user-error'.
+
+2014-12-25 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ * dired-aux.el (dired-maybe-insert-subdir):
+ Make dired-maybe-insert-subdir always skip trivial files.
+
+2014-12-25 Helmut Eller <eller.helmut@gmail.com>
+ Dmitry Gutov <dgutov@yandex.ru>
+
+ Consolidate cross-referencing commands.
+
+ Move autoloaded bindings for `M-.', `M-,', `C-x 4 .' and
+ `C-x 5 .' from etags.el to xref.el.
+
+ * progmodes/xref.el: New file.
+
+ * progmodes/elisp-mode.el (elisp--identifier-types): New variable.
+ (elisp--identifier-location): New function, extracted from
+ `elisp--company-location'.
+ (elisp--company-location): Use it.
+ (elisp--identifier-completion-table): New variable.
+ (elisp-completion-at-point): Use it.
+ (emacs-lisp-mode): Set the local values of `xref-find-function'
+ and `xref-identifier-completion-table-function'.
+ (elisp-xref-find, elisp--xref-find-definitions)
+ (elisp--xref-identifier-completion-table): New functions.
+
+ * progmodes/etags.el (find-tag-marker-ring): Mark obsolete in
+ favor of `xref--marker-ring'.
+ (tags-lazy-completion-table): Autoload.
+ (tags-reset-tags-tables): Use `xref-clear-marker-stack'.
+ (find-tag-noselect): Use `xref-push-marker-stack'.
+ (pop-tag-mark): Make an alias for `xref-pop-marker-stack'.
+ (etags--xref-limit): New constant.
+ (etags-xref-find, etags--xref-find-definitions): New functions.
+
+2014-12-25 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-start.el (resize-mini-windows): Make it customizable.
+
+2014-12-24 Stephen Leake <stephen_leake@stephe-leake.org>
+
+ * startup.el (fancy-about-text): Change buttons for etc/CONTRIBUTE
+ to (info "(emacs)Contributing"). (Bug#19299)
+
+2014-12-24 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (mouse-autoselect-window-position-1): New variable.
+ (mouse-autoselect-window-cancel)
+ (mouse-autoselect-window-select, handle-select-window):
+ With delayed autoselection select window only if mouse moves after
+ selecting its frame.
+
+2014-12-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-ext.el (eshell-find-interpreter): Expand relative
+ remote file names. (Bug#18782)
+
+2014-12-23 Sam Steingold <sds@gnu.org>
+
+ * shell.el (shell-display-buffer-actions): New user option.
+ (shell): Pass it to `pop-to-buffer' instead of hard-coding
+ `pop-to-buffer-same-window'.
+
+2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/js.el (js--syntax-propertize-regexp-syntax-table): New var.
+ (js-syntax-propertize-regexp): Use it to recognize "slash in
+ a character class" (bug#19397).
+
+2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * completion.el: Use post-self-insert-hook (bug#19400).
+ (completion-separator-self-insert-command)
+ (completion-separator-self-insert-autofilling): Remove.
+ (completion-separator-chars): New var.
+ (completion-c-mode-hook, completion-setup-fortran-mode): Use it instead
+ of changing the keymap.
+ (completion--post-self-insert): New function.
+ (dynamic-completion-mode): Use it instead of rebinding keys.
+ (cmpl--completion-string): Rename from completion-string.
+ (add-completion-to-head, delete-completion): Let-bind it explicitly.
+
+2014-12-22 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby--string-region): Simplify code
+ by leveraging `syntax-ppss'.
+
+2014-12-22 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * let-alist.el (let-alist): Use `make-symbol' instead of `gensym'.
+
+2014-12-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-histfile-override): Add :version.
+
+2014-12-20 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/tramp-sh.el (tramp-histfile-override): Clarify docstring.
+
+2014-12-19 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * let-alist.el (let-alist): Enable access to deeper alists by
+ using dots inside the dotted symbols.
+
+2014-12-19 Alan Mackenzie <acm@muc.de>
+
+ Make C++11 uniform init syntax work.
+ New keywords "final" and "override".
+ * progmodes/cc-engine.el (c-back-over-member-initializer-braces):
+ New function.
+ (c-guess-basic-syntax): Set `containing-sex' and `lim' using the
+ new function.
+ * progmodes/cc-fonts.el (c-font-lock-declarations): Check more
+ carefully for "are we at a declarator?" using
+ c-back-over-member-initializers.
+ * progmodes/cc-langs.el (c-type-modifier-kwds): Include "final"
+ and "override" in the C++ value.
+
+2014-12-19 Martin Rudalics <rudalics@gmx.at>
+
+ * textmodes/ispell.el (ispell-command-loop): Don't use `next-window'.
+
+2014-12-21 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (nsm-save-host): Don't save the host name twice
+ (bug#19269).
+
+2014-12-18 Sam Steingold <sds@gnu.org>
+
+ Keyboard interface (C-f10) to `mouse-buffer-menu' (C-down-mouse-1).
+ * mouse.el (mouse-buffer-menu-map): Extract from `mouse-buffer-menu'.
+ (mouse-buffer-menu): Use `mouse-buffer-menu-map'.
+ * menu-bar.el (menu-bar-buffer-vector): Extract from
+ `menu-bar-update-buffers'.
+ (menu-bar-update-buffers): Use `menu-bar-buffer-vector'.
+ (buffer-menu-open): New user command, bound globally to C-f10,
+ provides a keyboard interface to `mouse-buffer-menu' (C-down-mouse-1).
+ (mouse-buffer-menu-keymap): Use `menu-bar-buffer-vector' to
+ convert the value returned by `mouse-buffer-menu-map' to a list
+ acceptable to `popup-menu' for `buffer-menu-open'.
+
+2014-12-18 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * let-alist.el (let-alist): Evaluate the `alist' argument only once.
+
+2014-12-18 Sam Steingold <sds@gnu.org>
+
+ * emacs-lisp/package.el: Avoid compilation warning by declaring
+ the `find-library-name' function.
+ (package-activate-1): Fix the `with-demoted-errors' calls:
+ the first argument must be a string literal.
+
+2014-12-18 Martin Rudalics <rudalics@gmx.at>
+
+ Add code for "preserving" window sizes.
+ * dired.el (dired-pop-to-buffer): Call fit-window-to-buffer with
+ `preserve-size' t.
+ (dired-mark-pop-up): Preserve size of window showing marked files.
+ * electric.el (Electric-pop-up-window):
+ * help.el (resize-temp-buffer-window): Call fit-window-to-buffer
+ with `preserve-size' t.
+ * minibuffer.el (minibuffer-completion-help):
+ Use `resize-temp-buffer-window' instead of `fit-window-to-buffer'
+ (Bug#19355). Preserve size of completions window.
+ * register.el (register-preview): Preserve size of register
+ preview window.
+ * tmm.el (tmm-add-prompt): Call fit-window-to-buffer
+ with `preserve-size' t (Bug#1291).
+ * window.el (with-displayed-buffer-window): Add calls to
+ `window-preserve-size'.
+ (window-min-pixel-size, window--preservable-size)
+ (window-preserve-size, window-preserved-size)
+ (window--preserve-size, window--min-size-ignore-p): New functions.
+ (window-min-size, window-min-delta, window--resizable)
+ (window--resize-this-window, split-window-below)
+ (split-window-right): Amend doc-string.
+ (window--min-size-1, window-sizable, window--size-fixed-1)
+ (window-size-fixed-p, window--min-delta-1)
+ (frame-windows-min-size, window--max-delta-1, window-resize)
+ (window--resize-child-windows, window--resize-siblings)
+ (enlarge-window, shrink-window, split-window): Handle preserving
+ window sizes.
+ (adjust-window-trailing-edge): Handle preserving window
+ sizes. Signal user-error instead of an error when there's no
+ window above or below.
+ (window--state-put-2): Handle horizontal scroll bars.
+ (window--display-buffer): Call `preserve-size' if asked for.
+ (display-buffer): Mention `preserve-size' alist member in doc-string.
+ (fit-window-to-buffer): New argument PRESERVE-SIZE.
+ * textmodes/ispell.el (ispell-command-loop): Suppress horizontal
+ scroll bar on ispell's windows. Don't count window lines and
+ don't deal with dedicated windows.
+ (ispell-show-choices, ispell-help): Let `ispell-display-buffer'
+ do the window handling.
+ (ispell-adjusted-window-height, ispell-overlay-window): Remove.
+ (ispell-display-buffer): New function to reuse, create and fit
+ window to ispell's buffers. (Bug#3413)
+
+2014-12-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-activate): Do not re-activate or
+ reload the dependencies (bug#19390).
+
+2014-12-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-cmds.el (c-subword-mode): Alias to subword-mode.
+ (c-update-modeline):
+ * progmodes/cc-langs.el (c-mode-menu): Use c-subword-mode.
+ * progmodes/cc-mode.el (subword-mode): Move autoload to cc-cmds.el.
+ (c-mode-base-map): Use c-subword-mode.
+
+2014-12-18 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-diag.el (describe-font-internal):
+ Display additional info returned by font-info.
+
+ * linum.el (linum--face-width): Rename from linum--face-height,
+ and use the new functionality of font-info.
+ (linum-update-window): Use linum--face-width and frame-char-width,
+ instead of approximating with height.
+
+2014-12-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-svn.el (vc-svn-dir-status-files): Revert the 2014-12-02
+ change (bug#19387). Use `apply' on `vc-dir-command' (bug#19405).
+
+ * emacs-lisp/package.el (package-activate-1): Add RELOAD argument
+ and a docstring.
+ (package-activate): Call itself on dependencies on PACKAGE with
+ the same FORCE argument. Pass FORCE as RELOAD into
+ `package-activate-1' (bug#19390).
+
+2014-12-17 Sam Steingold <sds@gnu.org>
+
+ * emacs-lisp/package.el (package--list-loaded-files):
+ Handle `(nil ...)' elements in `load-history'.
+
+2014-12-17 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/tramp-sh.el (tramp-histfile-override): New variable.
+ (tramp-open-shell, tramp-maybe-open-connection): Use it.
+
+2014-12-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc.el: Improve `dir-status-files' description.
+
+ * emacs-lisp/package.el (package--list-loaded-files): Don't call
+ file-truename on load-history elements (bug#19390).
+
+2014-12-16 Nicolas Petton <petton.nicolas@gmail.com>
+
+ * emacs-lisp/seq.el: New file.
+
+2014-12-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * jit-lock.el (jit-lock-function): Don't defer if jit-lock-defer-time
+ is 0 and there is no input pending.
+
+2014-12-15 Juri Linkov <juri@linkov.net>
+
+ * replace.el (query-replace-read-from): Use query-replace-compile-replacement
+ only on the return value (bug#19383).
+
+2014-12-15 Juri Linkov <juri@linkov.net>
+
+ * isearch.el (isearch-lazy-highlight-search): Extend the bound of
+ the wrapped search by the length of the search string to be able
+ to lazy-highlight the whole search string at point (bug#19353).
+
+2014-12-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-fold-text): Don't bug out on zero-length text.
+
+2014-12-14 Alan Mackenzie <acm@muc.de>
+
+ * cus-start.el (all): Add fast-but-imprecise-scrolling.
+
+2014-12-14 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * let-alist.el: Add lexical binding.
+
+2014-12-14 Steve Purcell <steve@sanityinc.com> (tiny change)
+
+ * emacs-lisp/package.el (package-menu-mode): Use an extra column
+ for the "Version" column, to accomodate date-and-time-based versions.
+
+2014-12-14 Cameron Desautels <camdez@gmail.com>
+
+ * cus-edit.el (custom-unsaved-options): New function, extracted
+ from `customize-unsaved'.
+ (custom-unsaved): Use it.
+ (custom-prompt-customize-unsaved-options): New function.
+ (Bug#19328)
+
+2014-12-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * fringe.el (fringe-bitmap-p): Fix 2014-12-05 breakage.
+
+2014-12-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ Move ASYNC argument to the `diff' VC command to the fifth
+ position, for better compatibility with existing third-party code,
+ and document it.
+
+ * vc/vc.el (vc-diff-internal): Pass `async' argument to the
+ backend `diff' command in the last position.
+
+ * vc/vc-svn.el (vc-svn-diff):
+ * vc/vc-src.el (vc-src-diff):
+ * vc/vc-sccs.el (vc-sccs-diff):
+ * vc/vc-rcs.el (vc-rcs-diff):
+ * vc/vc-mtn.el (vc-mtn-diff):
+ * vc/vc-hg.el (vc-hg-diff):
+ * vc/vc-git.el (vc-git-diff):
+ * vc/vc-dav.el (vc-dav-diff):
+ * vc/vc-cvs.el (vc-cvs-diff):
+ * vc/vc-bzr.el (vc-bzr-diff):
+ * obsolete/vc-arch.el (vc-arch-diff): Move ASYNC argument to the end.
+
+2014-12-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * emacs-lisp/cconv.el (cconv--analyze-use):
+ Rename from cconv--analyse-use.
+ (cconv--analyze-function): Rename from cconv--analyse-function.
+ (cconv-analyze-form): Rename from cconv-analyse-form.
+
+2014-12-13 Andreas Schwab <schwab@linux-m68k.org>
+
+ * net/shr.el (shr-next-link): Don't error out at eob.
+
+2014-12-05 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * isearch.el (isearch-open-necessary-overlays): Open overlay
+ ending at point (bug#19333).
+
+2014-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-fold-text): New function.
+ (shr-show-alt-text, shr-urlify, shr-tag-img): Use it to fold long
+ alt/title texts.
+ (shr-fold-text): Inhibit state from being altered.
+
+ * files.el (directory-files-recursively): Really check whether
+ files are symlinks.
+ (directory-name-p): New function.
+ (directory-files-recursively): Use it.
+
+2014-12-13 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * emacs-lisp/package.el (package--list-loaded-files): New function
+ to list files in a given directory which correspond to already
+ loaded files.
+ (package-activate-1): Reload files given by `package--list-loaded-files'.
+ Fix bug#10125, bug#18443, and bug#18448.
+
+2014-12-13 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-svn.el (vc-svn-diff): Fix bug #19312.
+
+2014-12-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * simple.el (password-word-equivalents): Add "passcode", used for
+ numeric secrets like PINs or RSA tokens.
+
+2014-12-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-get-remote-path): Use a login shell in
+ order to determine `tramp-own-remote-path'.
+
+2014-12-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-parse-command):
+ Quote `python-shell-interpreter`. (Bug#19289)
+
+2014-12-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-indent-line): Use `noindent' in strings.
+ (python-indent-levels): Document extra value.
+ (python-indent-calculate-indentation): Return `noindent' in strings.
+ (python-indent-post-self-insert-function)
+ (python-indent-calculate-levels): Handle new value.
+
+2014-12-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (network-stream-open-starttls): No need to
+ check for the availability of `gnutls-available-p'.
+
+ * files.el (directory-files-recursively): Don't follow symlinks to
+ other directories.
+
+2014-12-12 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-dav.el, vc/vc-git.el, vc/vc-hg.el, vc/vc-src.el:
+ * vc/vc.el: latest-on-branch-p is no longer a public method.
+
+ * vc/vc.el, vc/vc-hg.el, vc/vc-git.el, vc/vc-hooks.el:
+ * vc/vc-mtn.el, vc/vc-rcs.el, vc/vc-sccs.el, vc/vc-src.el:
+ Remove `rollback' method, to be replaced in the future by uncommit.
+
+2014-12-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-hg.el (vc-hg-state): Make FILE absolute. Handle the case
+ that there is empty output.
+
+2014-12-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el (eldoc-documentation-function): Change default.
+ (eldoc-mode, eldoc-schedule-timer): Adjust to new default.
+
+2014-12-10 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * let-alist.el: Add new package and macro.
+
+2014-12-10 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-dispatcher.el, vc/vc-hooks.el, vc/vc-rcs.el:
+ * vc/vc-sccs.el, vc/vc.el: Righteous featurectomy of vc-keep-workfiles,
+ it's a shoot-self-in-foot archaism. Workfiles are always kept.
+
+2014-12-10 Rasmus Pank Roulund <emacs@pank.eu>
+
+ * net/ange-ftp.el (ange-ftp-switches-ok): Disallow flags causing
+ trouble with ls over ftp. These flags result in ls returning no
+ output, causing Tramp-breakage. (bug#19192)
+
+2014-12-10 Andreas Schwab <schwab@suse.de>
+
+ * files.el (file-tree-walk): Use file-name-as-directory unconditionally.
+
+2014-12-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * files.el (directory-files-recursively):
+ Use `file-name-all-completions' instead of `directory-files' for
+ greater speed.
+
+ * net/shr.el (shr-tag-object): Don't bug out on text elements in
+ <object>.
+
+2014-12-09 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Add .rabl, Berksfile
+ and Puppetfile.
+ (ruby-toggle-string-quotes): New command that allows you to quickly
+ toggle between single-quoted and double-quoted string literals.
+
+2014-12-09 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-src.el (vc-src-do-comand): Prepend -- to file argument
+ list, avoids problems witt names containing hyphens.
+
+2014-12-09 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision aa4b777.
+ * progmodes/verilog-mode.el (verilog-mode-version): Update.
+ (verilog-auto-end-comment-lines-re, verilog-end-block-ordered-re)
+ (verilog-set-auto-endcomments): Automatically comment property/
+ endproperty blocks to match other similar blocks like sequence/
+ endsequence, function/endfunction, etc. Reported by Alex Reed.
+ (verilog-set-auto-endcomments): Fix end comments for functions of
+ type void, etc. Detect the function- or task-name when
+ auto-commenting blocks that lack an explicit portlist.
+ Reported by Alex Reed.
+ (verilog-nameable-item-re): Fix nameable items that can have an
+ end-identifier to include endchecker, endgroup, endprogram,
+ endproperty, and endsequence. Reported by Alex Reed.
+ (verilog-preprocessor-re, verilog-beg-of-statement):
+ Fix indentation of property/endproperty around pre-processor
+ directives. Reported by Alex Reed.
+ (verilog-label-be): When auto-commenting a buffer, consider
+ auto-comments on all known keywords (not just a subset thereof).
+ Reported by Alex Reed.
+ (verilog-beg-of-statement): Fix labeling do-while blocks, bug842.
+ Reported by Alex Reed.
+ (verilog-beg-of-statement-1, verilog-at-constraint-p):
+ Fix hanging with many curly-bracket pairs, bug663.
+ (verilog-do-indent): Fix electric tab deleting form-feeds.
+ Note caused by indent-line-to deleting tabls pre 24.5.
+ (verilog-auto-output, verilog-auto-input, verilog-auto-inout)
+ (verilog-auto-inout-module, verilog-auto-inout-in): Doc fixes.
+ (verilog-read-always-signals, verilog-auto-sense-sigs)
+ (verilog-auto-reset): Fix AUTORESET with always_comb and always_latch,
+ bug844. Reported by Greg Hilton.
+
+2014-12-09 Alex Reed <acreed4@gmail.com> (tiny change)
+
+ * progmodes/verilog-mode.el (verilog-no-indent-begin-re):
+ Fix `verilog-indent-begin-after-if' nil not honoring 'forever',
+ 'foreach', and 'do' keywords.
+ (verilog-endcomment-reason-re, verilog-beg-of-statement):
+ Fix labeling do-while blocks, bug842.
+ (verilog-backward-token): Fix indenting sensitivity lists with
+ named events, bug840.
+
+2014-12-09 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.36.1.
+ * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update.
+ (vhdl-compiler-alist): Anchor all error regexps.
+ (vhdl-compile-use-local-error-regexp): Change default to nil.
+ (vhdl-asort, vhdl-anot-head-p): Remove.
+ (vhdl-aput, vhdl-adelete, vhdl-aget): Simplify.
+ Remove optional argument of vhdl-aget and update all callers.
+ (vhdl-import-project): Also set `vhdl-compiler'.
+
+2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * files.el (find-files): New function.
+
+ * net/shr.el (shr-dom-print): Don't print comments.
+ (shr-tag-svg): Give inline SVG images the right type.
+
+ * net/eww.el (eww-update-header-line-format): Mark valid/invalid
+ certificates in the header line.
+ (eww-invalid-certificate, eww-valid-certificate): New faces.
+
+2014-12-09 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (inferior-python-mode):
+ Set `comint-prompt-read-only` to `t` only locally.
+
+2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (nsm-check-protocol): Test for RC4 on `high'.
+ (nsm-format-certificate): Include more data about the connection.
+ (nsm-query): Fill the text to that it looks nicer.
+ (nsm-check-protocol): Also warn if using SSL3 or older.
+
+2014-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gud.el (gud-gdb-completions): Remove unused var `start'.
+
+ * obsolete/gulp.el (gulp-create-m-p-alist): Remove unused var `mnt-tm'.
+
+ * net/tramp.el (tramp-handle-make-symbolic-link): Mark unused arg.
+
+ * info.el (Info-mode-map): Remove left-over binding.
+
+ * emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib.
+ (avl-tree--root): Remove redundant defsetf.
+
+2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (network-security-level): Remove the detailed
+ description, which was already outdated, and refer the users to
+ the manual.
+ (nsm-check-protocol): Check for weak Diffie-Hellman prime bits
+ (bug#19153).
+
+2014-12-06 Andrey Kotlarski <m00naticus@gmail.com>
+
+ * net/eww.el (eww-buffers-mode): New major mode.
+ (eww-list-buffers, eww-buffer-select, eww-buffer-show-next)
+ (eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show):
+ New commands/functions (bug#19131).
+
+2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/gnutls.el (gnutls-negotiate): Ignore files found via
+ 'file-name-handler-alist' since the gnutls library can't use those
+ (bug#15866).
+
+2014-12-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-hg.el (vc-hg-dir-status-files): Only include ignores files
+ when FILES is non-nil (bug#19304).
+
+2014-12-08 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-arch.el: Move to obsolete directory so a test framework
+ won't trip over bit-rot in it. There has been no Arch snapshot
+ for nine years.
+
+2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-follow-link): Revert prefix behaviour to
+ previous behavior.
+ (eww-copy-page-url): Add doc string.
+
+2014-12-07 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww): Move history recording here...
+ (eww-browse-url): ... from here (bug#19253).
+
+ * net/eww.el (eww-browse-url): Use generate-new-buffer (was:
+ iterating over possible buffer names.)
+
+2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-reload): Take a prefix to work locally (bug#19086).
+ (eww-current-buffer): Compilation fix for bug#18550 patch.
+
+2014-12-07 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-list-histories): Restore the history in the
+ correct buffer (bug#18550).
+
+2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-bookmark-prepare): Display URLs in first by
+ displaying shortened titles first (bug#16398).
+
+2014-12-07 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * progmodes/python.el: Recognize docstrings.
+ (python-docstring-at-p, python-font-lock-syntactic-face-function):
+ New functions.
+ (python-mode): Use them.
+
+2014-12-06 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker--treeview-list-add-item)
+ (newsticker--treeview-propertize-tag): Bind tree menu to mouse-3.
+ (newsticker--treeview-create-groups-menu)
+ (newsticker--treeview-create-tree-menu): Remove.
+ (newsticker--treeview-tree-open-menu): New.
+ (newsticker-treeview-tree-click): Pass event to
+ `newsticker-treeview-tree-do-click'.
+ (newsticker-treeview-tree-do-click): Open treemenu on mouse-3.
+
+2014-12-05 Juri Linkov <juri@linkov.net>
+
+ * comint.el (comint-history-isearch-search)
+ (comint-history-isearch-wrap): Use field-beginning instead of
+ comint-line-beginning-position.
+ (comint-send-input): Go to the end of the field instead of the end
+ of the line to accept whole multi-line input.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html
+
+2014-12-05 Juri Linkov <juri@linkov.net>
+
+ * minibuffer.el (minibuffer-completion-help):
+ Compare selected-window with minibuffer-window to check whether
+ completions should be displayed near the minibuffer. (Bug#17809)
+ http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00311.html
+
+2014-12-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-mtn.el (vc-mtn-root):
+ * vc/vc-svn.el (vc-svn-registered): Make FILE absolute.
+
+2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie-sh-rules): Go back to the beginning
+ of the whole pipe when indenting an opening keyword after a |.
+ Generalize this treatment to opening keywords like "while" (bug#18031).
+
+2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (newline): Place the hook buffer-locally,
+ to make sure it's first.
+
+ * progmodes/prog-mode.el (prettify-symbols--compose-symbol):
+ Fix handling of symbols with different syntax at beginning/end or with
+ symbol rather than word syntax.
+
+2014-12-05 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move): If noninteractive, call line-move-1, not
+ forward-line, since the former is compatible with line-move-visual
+ both in terms of the column to which it moves and the return
+ value. (Bug#19211)
+
+2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/ediff-init.el (ediff-odd-p): Remove.
+ (ediff-background-face): Use cl-oddp instead.
+ (ediff-buffer-live-p): Make it a defsubst.
+
+ * tooltip.el (tooltip-region-active-p): Remove.
+
+ * net/shr.el (shr-char-breakable-p, shr-char-kinsoku-bol-p)
+ (shr-char-kinsoku-eol-p, shr-char-nospace-p): Use define-inline.
+
+ * fringe.el (fringe-bitmap-p): Make it a plain function.
+
+ * emacs-lisp/eieio-core.el: Prefer inlinable functions over macros.
+ (class-p, generic-p, eieio-object-p, class-abstract-p):
+ Make them defsubst, so as to avoid corner case problems where
+ the arg might be evaluated in the condition-case, or it can't be passed
+ to higher-order functions like `cl-some'.
+
+2014-12-05 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * wid-edit.el (widget-choose): Let numeric keypad work (bug#19268)
+ and remove old menu-related code.
+
+2014-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-display-pdf): Let mailcap determine how to
+ display PDF files (bug#19270).
+
+2014-12-05 Juri Linkov <juri@linkov.net>
+
+ Compare with the most recent window by default.
+ * vc/compare-w.el (compare-windows-get-window-function): New defcustom.
+ (compare-windows-get-recent-window)
+ (compare-windows-get-next-window): New functions.
+ (compare-windows, compare-windows-sync-default-function):
+ Use `compare-windows-get-window-function' instead of `next-window'.
+ (compare-windows): Add diff/match messages with region boundaries.
+ (Bug#19170)
+
+2014-12-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (filter): Remove. Use `cl-remove-if-not' or `seq-filter'.
+
+2014-12-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr--extract-best-source): Ignore non-text children.
+
+2014-12-04 Eli Zaretskii <eliz@gnu.org>
+
+ Implement copying of a buffer portion while preserving visual order.
+ * simple.el (bidi-directional-controls-chars)
+ (bidi-directional-non-controls-chars): New variables.
+ (squeeze-bidi-context-1, squeeze-bidi-context)
+ (line-substring-with-bidi-context)
+ (buffer-substring-with-bidi-context): New functions.
+
+ * files.el (file-tree-walk): Doc fix.
+
+2014-12-04 Rupert Swarbrick <ruperts@broadcom.com> (tiny change)
+ Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * autoinsert.el (auto-insert-alist): Update C/C++ header and
+ program support to match more extensions. Replace non-alnum
+ characters when generating include guards (headers) and check for
+ more extensions when generating includes (programs)
+ (bug#19254).
+
+2014-12-03 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * files.el (file-tree-walk): Fix docstring.
+
+2014-12-03 Karl Fogel <kfogel@red-bean.com>
+
+ Fix bug whereby saving files hung in VC hook.
+
+ Saving a buffer visiting a file under SVN control would hang if
+ the remote repository were unreachable, because the VC hooks tried
+ to run "svn status -u" on the file, where the "-u" tells svn to
+ get update information from the remote repository.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00174.html
+
+ * vc/vc-svn.el (vc-svn-state): Remove optional `localp'
+ argument and always pass "-v" to "svn status", never "-u".
+
+2014-12-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/inline.el: Fix up copyright header.
+ (inline-quote, inline-const-p, inline-const-val, inline-error):
+ Silence compiler warnings.
+ (inline-letevals): Fix edebug spec.
+ (inline--testconst-p): Consider lambda expressions as const-p.
+ (inline--getconst-val): Use inline--testconst-p.
+
+ * minibuffer.el (completion-table-dynamic): Add arg `switch-buffer'
+ and change default to stay in the minibuffer when called from
+ the minibuffer (bug#19250).
+ (lazy-completion-table): Use this new argument to preserve the
+ old behavior.
+
+ * progmodes/elisp-mode.el (elisp--local-variables): Don't burp on
+ incorrect lexical elements (bug#19250).
+
+2014-12-03 A. N. Other <none@example.com>
+
+ * files.el (file-tree-walk): Lisp translation of ANSI ftw(3).
+
+2014-12-02 Glenn Morris <rgm@gnu.org>
+
+ * whitespace.el (whitespace-big-indent-regexp): Add :version.
+
+2014-12-02 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * subr.el (filter): New macro. Because it's just silly for a Lisp
+ not to have this in 2014. And VC needs it.
+
+ * vc.el: All backends: API simplification: Abolish dir-status.
+ It's replaced by dir-status-files.
+
+ * vc.el: All backends: API simplification: Remove 4th
+ 'default-state' argument from vc-dir-status files and its backend
+ methods - no backend method ever set it. It was used only in the
+ fallback method to to set a default of 'up-to-date, though a
+ convoluted call chain obscured this.
+
+ * vc-hooks.el: Bind vc-delete-file to Ctrl-x v delete.
+
+ * vc.el (vc-expand-dirs): Now takes a second BACKEND argument,
+ improving behavior on directories using multiple file-oriented VCSes.
+
+ * vc/vc.el: All backends: API simplification; clear-headers
+ is no longer a public method. It is now local to the one place
+ it's used, in the RCS steal-lock method.
+
+2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc.el: In all backends: API simplification; could-register
+ is no longer a public method. (vc-cvs.el still has a private
+ implementation.)
+
+ * vc/vc.el: In all backends: API cleanup; the backend diff method
+ takes an explicit async flag. This eliminates a particularly ugly
+ global.
+
+ * vc-bzr.el: Restore vc-bzr-state-heuristic as a private method.
+ VC randomly/unpredictably fails without it; cause not yet established.
+
+2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Merge some of the differences from the standalone CC-mode.
+ The main change is to only use the `category' text-property only when
+ available. For that many calls are changed to use c-get-char-property,
+ c-next-single-property-change, c-sc-scan-lists,
+ c-sc-parse-partial-sexp, c-unmark-<->-as-paren.
+
+ * progmodes/cc-mode.el (c-just-done-before-change): New var.
+ (c-basic-common-init): Initialize it.
+ (c-common-init): Only use mode-require-final-newline when available.
+ (c-before-change): Check and set c-just-done-before-change.
+ (c-after-change): Re-set c-just-done-before-change.
+ (c-advise-fl-for-region): New macro.
+ (lazy-lock-defer-rest-after-change, lazy-lock-defer-line-after-change)
+ (font-lock-after-change-function, jit-lock-after-change):
+ Advise if needed.
+
+ * progmodes/cc-langs.el (c-modified-constant): New lang var.
+ (c-known-type-key): Don't make a list just to throw it away.
+
+ * progmodes/cc-engine.el (c-invalidate-state-cache, c-parse-state):
+ Handle the case where categories are not available.
+ (c-record-parse-state-state, c-replay-parse-state-state):
+ Handle marker values.
+ (c-before-change-check-<>-operators): Look for the `syntax-table'
+ property rather than for the corresponding `category'.
+ (c-looking-at-decl-block): Remove unused var
+ `c-disallow-comma-in-<>-arglists'.
+ (c-forward-<>-arglist-recur): Remove unused var
+ `orig-record-found-types'.
+
+ * progmodes/cc-defs.el (c-version): Bump up to 5.33.
+ (c-use-category): New const.
+ (c-next-single-property-change): New macro.
+ (c-region-is-active-p): Prefer region-active-p when available.
+ (c-search-backward-char-property): Fix old min/max typo; probably
+ a copy/paste error.
+ (c-mark-<-as-paren, c-mark->-as-paren, c-unmark-<->-as-paren):
+ Turn them into macros that obey c-use-category.
+ (c-sc-scan-lists-no-category+1+1, c-sc-scan-lists-no-category+1-1)
+ (c-sc-scan-lists-no-category-1+1, c-sc-scan-lists-no-category-1-1)
+ (c-sc-scan-lists, c-sc-parse-partial-sexp)
+ (c-looking-at-non-alphnumspace): New macros.
+ (c-sc-parse-partial-sexp-no-category): New function.
+ (c-emacs-features): Add `category-properties' element.
+
+ * progmodes/cc-cmds.el (c-forward-into-nomenclature)
+ (c-backward-into-nomenclature): Use cc-subword if subword-mode is
+ not available.
+ (c-beginning-of-defun, c-end-of-defun, c-mark-function)
+ (c-indent-line-or-region): Use c-region-is-active-p.
+
+ * progmodes/cc-bytecomp.el (cc-bytecomp-unbound-variables)
+ (cc-bytecomp-original-functions, cc-bytecomp-original-properties)
+ (cc-bytecomp-loaded-files): Re-set each time the file is loaded.
+ (cc-bytecomp-obsolete-var, cc-bytecomp-ignore-obsolete)
+ (cc-bytecomp-obsolete-fun): Delete unused functions.
+
+ * progmodes/cc-align.el (c-lineup-respect-col-0): New function.
+
+2014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-dom-print): Fix up `shr-dom-print' after the
+ dom.el changes.
+
+2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc.el (vc-find-conflicted-file): Look for conflicted files in the
+ current "project" rather than just the current directory.
+ * vc/vc-git.el (vc-git-conflicted-files): Clarify in which directory
+ the file names make sense.
+
+ * vc/smerge-mode.el (smerge-swap): New command.
+
+ * vc/diff-mode.el (diff-kill-applied-hunks): New command.
+
+2014-12-01 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker--treeview-item-show):
+ Check window liveliness before measuring its width.
+
+ * net/newst-backend.el (newsticker--get-news-by-url-callback):
+ Pass correct status to `newsticker--sentinel-work'.
+ (newsticker--sentinel-work): Use "newsticker--download-error" as
+ guid in order to prevent multiple "Could not download..."
+ messages. (Bug#19166)
+
+2014-12-01 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-render): Call `eww-after-render-hook' in the
+ correct buffer (bug#19225).
+
+2014-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (network-security-level): Change the default to `medium'.
+
+ * net/eww.el (eww): Leave point in a place that doesn't cause
+ scrolling when displaying "Loading...".
+
+2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc.el, vc/vc-cvs.el, vc/vc-rcs.el, vc/vc-svn.el: The 'merge'
+ backend method of RCS/CVS/SVN is now 'merge-file', to contrast with
+ 'merge-branch'. Prompting for merge revisions is pushed down to
+ the back ends; this fixes a layering violation that caused bad
+ behavior with SVN.
+
+ * vc/vc.el, vc-hooks.el: All backends: API simplification;
+ vc-stay-local-p and repository-hostname are no longer public
+ methods. Only the CVS and SVN backends used these, and the SVN
+ support was conditioned out because svn status -v is too slow.
+ The CVS back end retains this machinery and the vc-stay-local
+ configuration variable now only affects it.
+
+2014-12-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/inline.el: New file.
+
+2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc.el, vc-hooks.el: All backends: API simplification;
+ vc-state-heuristic is no longer a public method, having been
+ removed where it is redundant, unnecessary, or known buggy.
+ This eliminated all backends except CVS. Eliminates bug#7850.
+
+ * vc/vc-cvs.el, vc/vc-hooks.el, vc/vc-rcs.el, vc/vc-sccs.el:
+ Eliminate vc-mistrust-permissions. It was only relevant to the
+ RCS and SCCS back ends and defaulted to t. Code now always
+ mistrusts permissions - by actual measurement the effect on
+ performance is negligible. As a side effect bug#11490 is now
+ irrelevant.
+
+ * vc/vc.el, vc-hooks.el: All backends: API simplification;
+ vc-workfile-unchanged-p is no longer a public method (but the RCS
+ and SCCS back ends retain it as a private method used in state
+ computation). This method was redundant with vc-state and usually
+ implemented as a trivial call to same. Fixes the failure mode
+ described in bug#694.
+
+ * vc/vc.el: All backends: API simplification; init-revision is
+ gone, and vc-registered functions no longer take an
+ initial-revision argument.
+
+2014-11-29 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-src.el (vc-src, vc-src-diff-switches)
+ (vc-src-master-templates): Fix :version tags.
+
+2014-11-29 Paul Rankin <paul@tilk.co> (tiny change)
+
+ * outline.el (outline-move-subtree-down): Refactor and improve code.
+
+2014-11-29 Stephen Berman <stephen.berman@gmx.net>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * outline.el (outline-move-subtree-down): Make sure we can move
+ forward to find the end of the subtree and the insertion point
+ (bug#19102).
+
+2014-11-29 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-completion-setup-code):
+ Use __builtin__ module (or builtins in Python 3) and catch all errors
+ when importing readline and rlcompleter.
+
+2014-11-29 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Handle calling revert-buffer (bug#19187).
+ (todo-revert-buffer): New function.
+ (todo-modes-set-1): Use it as the buffer-local value of
+ revert-buffer-function.
+
+2014-11-29 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-mode): If called interactively, just
+ display a message saying to call todo-show to enter Todo mode
+ (Bug#19112).
+
+2014-11-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-hg.el (vc-hg-dir-status-files): Include ignored files.
+ (Bug#18579)
+
+ * vc/vc-bzr.el (vc-bzr-after-dir-status): Don't skip ignored
+ files. (Bug#18579)
+
+2014-11-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * textmodes/makeinfo.el (makeinfo-buffer): Make it work also for
+ remote `buffer-file-name'.
+
+2014-11-29 Leo Liu <sdl.web@gmail.com>
+
+ * calendar/diary-lib.el (calendar-mark-1): Fix thinko.
+
+2014-11-29 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Set PYTHONUNBUFFERED on shell startup.
+
+ * progmodes/python.el (python-shell-unbuffered): New var.
+ (python-shell-calculate-process-environment): Use it.
+
+2014-11-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-action-password): Clean password on subsequent
+ attempts even if there was no wrong password indication. (Bug#19047)
+
+ * net/tramp-sh.el (tramp-get-remote-locale): Return "LC_ALL=C" as
+ fallback.
+ (tramp-open-connection-setup-interactive-shell): No need to check
+ for nil as `tramp-get-remote-locale' return value.
+
+2014-11-29 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc-git.el (vc-git-command, vc-git--call):
+ Bind coding-system-for-read and coding-system-for-write to
+ vc-git-commits-coding-system.
+ (vc-git-previous-revision): Use "~1" instead of "^", since the
+ latter is a special character for MS-Windows system shells.
+
+2014-11-29 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve XEmacs compatibility.
+
+ * net/tramp.el (tramp-autoload-file-name-handler):
+ Wrap `temporary-file-directory' by `symbol-value', it doesn't
+ exist in XEmacs.
+ (tramp-read-passwd): Don't use `with-timeout-suspend' and
+ `with-timeout-unsuspend' if they don't exist, like in XEmacs.
+ (tramp-time-less-p, tramp-time-subtract): Remove functions.
+ (tramp-handle-file-newer-than-file-p, tramp-time-diff):
+ * net/tramp-adb.el (tramp-adb-ls-output-time-less-p):
+ * net/tramp-cache.el (tramp-get-file-property):
+ * net/tramp-smb.el (tramp-smb-handle-insert-directory):
+ Use `time-less-p' and `time-subtract, respectively.
+
+ * net/tramp-adb.el (top): Do not require time-date.el.
+
+ * net/tramp-compat.el (top): Require time-date.el for XEmacs.
+
+ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
+ Check, whether `utf-8' is a valid coding system.
+
+2014-11-29 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc.el (vc-retrieve-tag): Doc fix.
+
+2014-11-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (execute-extended-command--shorter): Fix the "M-p" case
+ (bug#19152).
+
+2014-11-28 Martin Rudalics <rudalics@gmx.at>
+
+ Fix two issues around help-window-select. (Bug#11039) (Bug#19012)
+ * help.el (help-window-old-frame): New variable.
+ (help-window-select): Default to nil (Bug#11039).
+ Rewrite doc-string.
+ (help-window-setup): When the help window appears on another
+ frame and `help-window-select' is non-nil, give that frame input
+ focus too (Bug#19012).
+ (with-help-window): Store selected frame in
+ help-window-old-frame.
+
+2014-11-28 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker--treeview-load): Take care of
+ nil value for `newsticker-groups-filename'.
+
+2014-11-28 Daiki Ueno <ueno@gnu.org>
+
+ * epa.el (epa-sign-file, epa-encrypt-file, epa-decrypt-region)
+ (epa-sign-region, epa-encrypt-region):
+ Use `epg-context-set-{passphrase,progress}-callback', instead of
+ `setf'. This partially reverts commit 9e48a95c (bug#19150).
+ Reported by José A. Romero L.
+
+2014-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-restore-history):
+ Bind `inhibit-modification-hooks' instead of `after-change-functions'.
+
+2014-11-27 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el (newsticker--parse-atom-1.0):
+ Handle embedded (x)html in summary node.
+
+2014-11-27 Sam Steingold <sds@gnu.org>
+
+ * menu-bar.el (menu-bar-open): When everything else fails,
+ use (mouse-menu-bar-map).
+
+2014-11-27 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker-groups-filename):
+ Change default value to nil. Point out that variable is obsolete in doc
+ string.
+ (newsticker--treeview-load): Change wording of the questions the
+ user is asked when `newsticker-groups-filename' is found to be
+ used and we offer to read and remove the groups file. (Bug#19165)
+
+2014-11-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww): Record the new URL immediately, so that if the
+ HTTP fetch fails, we have the right URL in the buffer.
+ (eww-process-text-input): Don't shorten the input field if
+ deleting at the last character (bug#19085).
+ (eww-restore-history): Inhibit change functions while restoring
+ the history.
+ (eww-process-text-input): Fix deletion at the start of the field, too.
+ (eww-mode): Revert mistanken removal of `buffer-disable-undo'.
+ (eww-process-text-input): Try to keep track of the size more reliably.
+
+ * dom.el (dom-pp): New function.
+
+2014-11-27 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-print-log, vc-bzr-expanded-log-entry):
+ Don't assume --long is the default for "bzr log", always specify
+ it explicitly, in case the user defined an alias for 'log' that
+ uses some other format.
+
+2014-11-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-eldoc--get-doc-at-point):
+ Strip shell output before returning. (bug#18794)
+
+2014-11-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix indentation before `!=' and after `+='. Originally reported
+ in https://github.com/mooz/js2-mode/issues/174.
+ * progmodes/js.el (js--indent-operator-re): Make assignments and
+ (in)equality operator a separate case.
+ (js--continued-expression-p): Escape the second `+' in the regexp.
+
+2014-11-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (handle-select-window): Deactivate shift-region (bug#19003).
+
+2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (nsm-new-fingerprint-ok-p): Display the certificate
+ when querying about new certificates.
+
+ * net/shr.el (shr-make-table-1): dom.el changes for table rendering.
+
+ * dom.el (dom-by-tag): Use `equal' for comparisons so that tags
+ can be strings.
+ (dom-elements): Protect against non-text nodes.
+ (dom-non-text-children): New function.
+
+ * net/eww.el (eww-tag-title): Use `dom-text'.
+
+2014-11-26 Sam Steingold <sds@gnu.org>
+
+ * textmodes/sgml-mode.el (sgml-validate-command): Pass -utf8 to tidy.
+
+2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-highest-readability): More dom.el fixes.
+
+2014-11-26 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el (newsticker--parse-generic-items):
+ Take care of UIDs when adding elements to cache.
+
+2014-11-26 Alan Mackenzie <acm@muc.de>
+
+ Remove spurious reference to symbol category_properties.
+ * progmodes/cc-engine.el (c-state-pp-to-literal): Fix here.
+
+2014-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el: Use the new dom.el accessors throughout.
+
+ * net/shr.el: Ditto.
+
+ * dom.el: New file.
+
+2014-11-26 Glenn Morris <rgm@gnu.org>
+
+ * arc-mode.el (archive-visit-single-files): Add :version.
+
+2014-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (nsm-format-certificate): Don't bug out on missing
+ elements.
+ (nsm-warnings-ok-p): The new version of this function always
+ returned nil when everything was OK.
+
+2014-11-25 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls): Set :group to 'comm so it's near NSM.
+
+ * net/nsm.el (nsm-check-tls-connection, nsm-save-host)
+ (nsm-warnings-ok-p): Use `gnutls-peer-status-warning-describe'.
+
+2014-11-20 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * emacs-lisp/byte-run.el (function-put): Match argument names to
+ docstring.
+
+2014-11-24 Sam Steingold <sds@gnu.org>
+
+ * vc/vc-hooks.el (vc-directory-exclusion-list):
+ Fix a trivial typo (bug#19171).
+
+2014-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-hooks.el (vc-state-base-face): Don't override
+ mode-line-inactive.
+
+2014-11-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-set-character-encoding): Use `read-coding-system'.
+ (eww-process-text-input): Inhibit read only so that input fields
+ don't get shortened (bug#19085).
+
+2014-11-24 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/macroexp.el (macroexp-let2*): New macro.
+
+ * window.el (with-temp-buffer-window)
+ (with-current-buffer-window, with-displayed-buffer-window):
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin):
+ * emacs-lisp/cl-lib.el (substring):
+ * emacs-lisp/cl-extra.el (cl-getf): Use it.
+
+2014-11-24 Eli Zaretskii <eliz@gnu.org>
+
+ * isearch.el (isearch-update): Don't assume
+ pos-visible-in-window-p will return nil when point is hscrolled
+ out of view. (Bug#19157)
+
+2014-11-20 Andrey Kotlarski <m00naticus@gmail.com>
+
+ * net/eww.el (eww-browse-url): Optionally create new eww buffer.
+ (eww-follow-link): Follow in new buffer in case of prefix
+ argument, open externally with double prefix (bug#19130).
+
+2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-display-html): Decode the document-defined charset.
+ (eww): Pop to the *eww* buffer immediately after executing the
+ `M-x eww' command to avoid having buffers pop up later.
+ (eww-display-html): Don't pop the *eww* buffer.
+ (eww-display-raw): Ditto.
+ (eww-display-image): Ditto.
+ (eww-follow-link): Make going to #targets in the page work again.
+
+2014-11-23 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-suggest-uris): New variable.
+ (eww-suggested-uris): New function.
+ (eww): Default to URL under point.
+ (eww-links-at-point): New function.
+
+2014-11-20 Mark Oteiza <mvoteiza@udel.edu> (tiny change)
+
+ * net/eww.el (eww-add-bookmark): Fix bookmark titles.
+
+2014-11-17 Mark Oteiza <mvoteiza@udel.edu> (tiny change)
+
+ * net/eww.el (eww-mode-map): Bind backtab to shr-previous-link.
+
+2014-11-23 Kenjiro Nakayama <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-set-character-encoding): New command and keystroke.
+ (eww-display-raw): Use it (bug#16225).
+
+2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/nsm.el (network-security-level): Rename from
+ `nsm-security-level' and documented.
+
+ * mail/smtpmail.el (smtpmail-via-smtp): Warn unless encrypted and
+ we're sending a password.
+
+ * net/nsm.el: New file that implements a Network Security Manager.
+
+ * net/network-stream.el (open-network-stream): Add a new
+ :warn-unless-encrypted parameter.
+ (network-stream-open-plain): Allow warning unless encrypted.
+ (network-stream-open-starttls): Call the Network Security Manager.
+ (network-stream-open-tls): Ditto.
+
+2014-11-23 Leo Liu <sdl.web@gmail.com>
+
+ * calendar/cal-china.el (calendar-chinese-from-absolute-for-diary)
+ (calendar-chinese-to-absolute-for-diary)
+ (calendar-chinese-mark-date-pattern, diary-chinese-anniversary):
+ Handle leap months in Chinese calendar. (Bug#18953)
+
+2014-11-22 Alan Mackenzie <acm@muc.de>
+
+ Fix error with `mark-defun' and "protected:" in C++ Mode.
+ * progmodes/cc-cmds.el (c-where-wrt-brace-construct): Handle a
+ return code of (label) from c-beginning-of-decl-1. (Bug#19134)
+
+2014-11-22 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el (newsticker--sentinel-work):
+ Tell `libxml-parse-xml-region' to discard comments. (Bug#18787)
+
+2014-11-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process)
+ (tramp-sh-handle-process-file): Propagate `process-environment'.
+
+ * vc/vc-hg.el (vc-hg-state): No special handling for remote files;
+ Tramp propagates environment variables now.
+
+2014-11-22 Eric S. Raymond <esr@snark>
+
+ * vc/vc-filewise.el: New file to isolate code used only by the
+ file-oriented back ends (SCCS/RCS/CVS/SRC) which should not
+ live in vc.el and certainly not in vc-hooks.el.
+
+ * vc/vc-hooks.el, vc-rcs.el, vc-sccs.el: vc-name -> vc-master-name.
+ This is preparatory to isolating all the 'master' functions
+ used only by the file-oriented back ends. With this done first,
+ the substantive diffs will be easier to read.
+
+2014-11-21 Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * play/morse.el (nato-alphabet): Mark URL in docstring in a way
+ that is recognized by `help-mode'.
+
+2014-11-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * desktop.el (desktop-create-buffer): Use activate-mark to set
+ `mark-active' (bug#19058).
+
+2014-11-21 Eric S. Raymond <esr@snark>
+
+ * vc/vc-src.el (vc-src-state): Fix bug that produced spurious
+ nil state.
+
+2014-11-21 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc.el (vc-deduce-fileset): Support invocation from
+ *vc-change-log* buffer. (Bug#19084)
+
+2014-11-13 Matthew Leach <matthew@mattleach.net>
+
+ * arc-mode.el (archive-visit-single-files): New.
+ (archive-mode): Visit file if archive contains a single file.
+ (Bug#1702)
+
+2014-11-21 Ulrich Müller <ulm@gentoo.org>
+
+ * vc/vc.el: Fix a typo in the commentary.
+
+2014-11-20 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * vc/vc-src.el, vc/vc.el: Added support for SRC. Needs more
+ testing and a real log-view mode.
+
+ * vc/vc-bzr.el, vc/vc-cvs.el, vc/vc-dav.el, vc/vc-git.el:
+ * vc/vc-hg.el, vc/vc-mtn.el, vc/vc-rcs.el, vc/vc-sccs.el:
+ * vc/vc-svn.el, vc/vc.el: Remove editable argument from the backend
+ checkout methods; where it matters (which is only in SCCS and RCS)
+ files are always checked out editable. This may actually have
+ been dynamically true already - it looks like the vc-next-action
+ code evolved past visiting the other case. Tested with RCS.
+
+ * vc/vc-arch.el, vc/vc-bzr.el, vc/vc-cvs.el, vc/vc-dav.el:
+ * vc/vc-git.el, vc/vc-hg.el, vc/vc-mtn.el, vc/vc-rcs.el:
+ * vc/vc-sccs.el, vc/vc-svn.el, vc/vc.el: Remove never-used rev
+ argument from the backend checkin methods. Only the RCS, SCCS,
+ and CVS back ends tried to do anything with it, and that code was
+ never exercised. Chiseling away the cruft of decades...
+
+2014-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-render): Remove a no-op :title setting.
+
+2014-11-19 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-history-limit): New variable.
+ (eww-save-history): Use it (bug#19105).
+ (eww-reload): Reload the page in the right buffer.
+
+2014-11-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-desktop-misc-data): Use `cl-remove-duplicates'.
+
+2014-11-19 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-desktop-remove-duplicates)
+ (eww-restore-desktop, eww-restore-reload-prompt): New variables.
+ (eww-mode): Set up desktop mode (bug#18010).
+ (eww-desktop-data-save, eww-desktop-data-1)
+ (eww-desktop-history-duplicate, eww-desktop-misc-data)
+ (eww-restore-desktop): New functions.
+
+2014-11-19 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc.el (vc-log-internal-common): Turn on log-view-mode in the
+ correct buffer. (Bug#19101)
+
+2014-11-19 Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * vc/vc-git.el (vc-git-diff): Use "difftool -x diff" with
+ `diff-switches' if `vc-git-diff-switches' is nil. (Bug#19099)
+
+2014-11-19 Artur Malabarba <bruce.connor.am@gmail.com>
+
+ * ido.el (ido-bury-buffer-at-head): New command.
+ (ido-buffer-completion-map): Bind it to C-S-b.
+
+2014-11-18 Juri Linkov <juri@linkov.net>
+
+ * simple.el (next-line-or-history-element): Wrap next-line
+ in with-no-warnings.
+ (previous-line-or-history-element): Wrap previous-line
+ in with-no-warnings.
+
+2014-11-18 Juri Linkov <juri@linkov.net>
+
+ * progmodes/grep.el (grep-compute-defaults):
+ Compute grep-highlight-matches before its use.
+
+2014-11-18 Juri Linkov <juri@linkov.net>
+
+ * replace.el (query-replace-from-to-separator): Turn defvar into
+ defcustom. Wrap char-displayable-p in ignore-errors because an
+ attempt to autoload char-displayable-p fails during pre-loading.
+ Move (propertize "\0" ... 'separator t) out of customizable part
+ to query-replace-read-from.
+ (query-replace-read-from): Call custom-reevaluate-setting on
+ query-replace-from-to-separator to reevaluate the separator
+ depending on the return value of char-displayable-p.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00466.html
+
+2014-11-18 Juri Linkov <juri@linkov.net>
+
+ * bindings.el (minibuffer-local-map): Rebind [down] from
+ next-history-element to next-line-or-history-element, and [up]
+ from previous-history-element to previous-line-or-history-element.
+
+ * simple.el (next-line-or-history-element)
+ (previous-line-or-history-element): New commands.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00822.html
+
+2014-11-18 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/nadvice.el (define-advice): New macro.
+ * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
+ Add define-advice.
+ (lisp-font-lock-keywords-1): Add define-advice.
+
+2014-11-18 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-context): New slot EDIT-CALLBACK.
+ (epg--process-filter): Call EDIT-CALLBACK when editing a key.
+ (epg-reset): Reset EDIT-CALLBACK of the context.
+ (epg-start-edit-key): New function.
+ (epg-edit-key): New function.
+
+2014-11-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port new time stamp handling to Emacs 23.2.
+ This fix is for Gnus. Reported by Katsumi Yamaoka.
+ * calendar/time-date.el (time-add, time-subtract, time-less-p):
+ Use eval-and-compile, not eval-when-compile.
+
+2014-11-18 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-context-set-passphrase-callback)
+ (epg-context-set-progress-callback): Check if the CALLBACK
+ argument is a function, instead of a cons.
+
+2014-11-18 Daiki Ueno <ueno@gnu.org>
+
+ * epa-file.el (epa-file-insert-file-contents)
+ (epa-file-write-region): Remove redundant check of
+ epa-pinentry-mode.
+ * epa.el (epa-sign-file, epa-encrypt-file, epa-decrypt-region)
+ (epa-sign-region, epa-encrypt-region): Remove redundant check of
+ epa-pinentry-mode.
+
+2014-11-18 Daiki Ueno <ueno@gnu.org>
+
+ * epa-file.el (epa-file-insert-file-contents): Don't show
+ "*Error*" buffer if input file does not exist.
+ Reported by Herbert J. Skuhra.
+
+2014-11-18 Paul Pogonyshev <pogonyshev@gmail.com>
+ Rüdiger Sonderfeld <ruediger@c-plusplus.net>
+
+ * progmodes/cc-langs.el: Support some of the new keywords in C++11.
+ An alternative version of the patch from bug#13871.
+ (c-operators): Add "alignof".
+ (c-primitive-type-kwds): Add "char16_t", "char32_t".
+ (c-type-modifier-kwds): Add "constexpr", "noexcept".
+ (c-modifier-kwds): Add "thread_local".
+ (c-constant-kwds): Add "nullptr".
+
+2014-11-17 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/tildify.el (tildify-pattern, tildify-space-string):
+ New variables for specifying tildify pattern and representation of
+ a hard space -- a no-break space by default -- respectively.
+ Being buffer-local they are much easier to handle than
+ `tildify-string-alist' and `tildify-pattern-alist' respectively
+ that have been used so far. They also works better with derived
+ modes.
+ (tildify-foreach-region-function): New variable specifying
+ a function determining portions of buffer that should be
+ tildified. It allows major modes to create a filtering function
+ more elaborate than a set of regular expressions. Initialized to
+ `tildify--deprecated-ignore-evironments' by default to handle now
+ deprecated `tildify-ignored-environments-alist' variable.
+ (tildify--foreach-region): A new function that takes
+ `tildify-foreach-region-function' into account and calls callback
+ for regions of the buffer that should be tildified.
+ (tildify-foreach-ignore-environments): A new function which can be
+ partially applied and used as `tildify-foreach-region-function'.
+ (tildify-ignored-environments-alist, tildify-pattern)
+ (tildify-string-alist, tildify--pick-alist-entry): Mark as obsolete.
+ (tildify--find-env): Rename from `tildify-find-env' and mark as
+ obsolete.
+ (tildify--deprecated-ignore-evironments): New function,
+ immediately marked as obsolete, used to handle deprecated
+ `tildify-ignored-environments-alist'.
+
+ * textmodes/tex-mode.el (tex-common-initialization):
+ Set `tildify-space-string' and `tildify-foreach-region-function'
+ variables in all variants of TeX mode since `tildify-string-alist'
+ and `tildify-ignored-environments-alist' are now empty by default.
+
+ * nxml/nxml-mode.el (nxml-mode): Ditto in `nxml-mode'.
+ If encoding supports it use no-break space instead of character
+ entity; this changes previous default which used a numeric
+ reference.
+
+ * textmodes/sgml-mode.el (sgml-mode): ditto in `sgml-mode'.
+ If encoding does not support no-break space, use numeric reference;
+ this changes previous default which used named entity (“&nbsp;”)
+ in HTML mode.
+
+2014-11-17 Ulf Jasper <ulf.jasper@web.de>
+
+ * calendar/icalendar.el (icalendar-export-alarms):
+ New customizable variable. (Bug#5433)
+ (icalendar-export-region): Export alarms as specified in
+ `icalendar-export-alarms'.
+ (icalendar--create-ical-alarm, icalendar--do-create-ical-alarm):
+ New functions for exporting alarms.
+
+2014-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * bindings.el (search-map): Move `eww-search-words' to `M-s M-w'.
+
+2014-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port new time stamp handling to old Emacs and to XEmacs.
+ This is needed for Gnus, which copies time-date.el and which
+ runs on older Emacs implementations.
+ * calendar/time-date.el (with-decoded-time-value):
+ Handle 'nil' and floating-point arg more compatibly with new Emacs.
+ (encode-time-value, with-decoded-time-value):
+ Obsolete only if new Emacs.
+ (time-add, time-subtract, time-less-p): Define if not new Emacs.
+
+ Improve time stamp handling, and be more consistent about it.
+ This implements a suggestion made in:
+ http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00587.html
+ Among other things, this means timer.el no longer needs to
+ autoload the time-date module.
+ * allout-widgets.el (allout-elapsed-time-seconds): Doc fix.
+ * arc-mode.el (archive-ar-summarize):
+ * calendar/time-date.el (seconds-to-time, days-to-time, time-since):
+ * emacs-lisp/timer.el (timer-relative-time, timer-event-handler)
+ (run-at-time, with-timeout-suspend, with-timeout-unsuspend):
+ * net/tramp.el (tramp-time-less-p, tramp-time-subtract):
+ * proced.el (proced-time-lessp):
+ * timezone.el (timezone-time-from-absolute):
+ * type-break.el (type-break-schedule, type-break-time-sum):
+ Simplify by using new functionality.
+ * calendar/cal-dst.el (calendar-next-time-zone-transition):
+ Do not return time values in obsolete and undocumented (HI . LO)
+ format; use (HI LO) instead.
+ * calendar/time-date.el (with-decoded-time-value):
+ Treat 'nil' as current time. This is mostly for XEmacs.
+ (encode-time-value, with-decoded-time-value): Obsolete.
+ (time-add, time-subtract, time-less-p): Use no-op autoloads, for
+ XEmacs. Define only if XEmacs, as they're now C builtins in Emacs.
+ * ldefs-boot.el: Update to match new time-date.el
+ * proced.el: Do not require time-date.
+
+2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-mode): Make the buffer read-only.
+ (eww-form-text): Inhibit read-only-ness in text input fields
+ (bug#16476).
+
+2014-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (execute-extended-command--shorter): Cut search here.
+ (execute-extended-command): Instead of here.
+
+2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-mode): Avoid use of set-local to
+ keep Emacs 24.x compatibility.
+
+2014-11-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr): Move to the new defgroup `web'.
+
+ * net/eww.el (eww): Ditto.
+
+ * simple.el (execute-extended-command): Don't show the help
+ message if the binding isn't significantly shorter than the
+ M-x command the user typed (bug#19013).
+
+2014-11-16 Ulf Jasper <ulf.jasper@web.de>
+
+ * calendar/icalendar.el (icalendar--convert-tz-offset):
+ Return complete cons when offsets of standard time and daylight saving
+ time are equal.
+ (icalendar-export-region): Fix unbound variable warning.
+
+2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (run-python): Allow CMD to be optional and
+ default it to a safe command, even for Windows. (bug#18596)
+
+2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-calculate-command):
+ Rename from python-shell-parse-command. Cleanup.
+ (run-python, run-python-internal): Use it.
+ (python-shell-calculate-pythonpath): Rename from
+ python-new-pythonpath.
+ (python-shell-calculate-process-environment): Use it.
+ (python-shell-calculate-exec-path): Add comment.
+
+2014-11-16 Thierry Banel <tbanelwebmin@free.fr> (tiny change)
+
+ * calc/calc-arith.el (math-max-list, math-min-list): Fix bug
+ for date handling.
+
+2014-11-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * version.el (emacs-repository-get-version): Use git rev-parse
+ instead of git log.
+
+2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-calculate-levels):
+ Fix indentation behavior multiline dedenter statement. (Bug#18432)
+
+2014-11-16 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-region):
+ Use python-indent-line and skip special cases. (Bug#18843)
+
+2014-11-16 Peder O. Klingenberg <peder@klingenberg.no>
+
+ * mail/emacsbug.el (report-emacs-bug): Make a better guess at
+ envelope-from when reporting through sendmail (bug#19054).
+
+2014-11-16 Oscar Fuentes <ofv@wanadoo.es>
+
+ Add faces for the VC modeline state indicator.
+ * vc/vc-hooks.el:
+ (vc-state-faces, vc-state-base-face)
+ (vc-up-to-date-state, vc-needs-update-state)
+ (vc-locked-state, vc-locally-added-state)
+ (vc-conflict-state, vc-removed-state)
+ (vc-missing-state, vc-edited-state):
+ New faces.
+ (vc-default-mode-line-string): Use them
+
+2014-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/backquote.el (backquote-process): Optimize away ",'".
+
+2014-11-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-search-words): Mention `eww-search-prefix'.
+
+2014-11-15 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-eldoc-setup-code): Enhance string
+ type checks, simplify printing. (Bug#18962)
+
+2014-11-14 Ivan Andrus <darthandrus@gmail.com>
+
+ * progmodes/python.el (python-shell-font-lock-kill-buffer):
+ (python-shell-font-lock-with-font-lock-buffer)
+ (python-shell-get-buffer, python-ffap-module-path):
+ Use `derived-mode-p' instead of equality test on `major-mode'.
+
+2014-11-14 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-virtualenv-root): Rename from
+ python-shell-virtualenv-path.
+ (python-shell-internal-get-process-name)
+ (python-shell-calculate-process-environment)
+ (python-shell-calculate-exec-path): Use it.
+
+2014-11-14 Eli Zaretskii <eliz@gnu.org>
+
+ * bindings.el (search-map): Fix last change: don't use 'kbd' in
+ bindings.el, since it is not yet loaded when bindings.el is
+ preloaded.
+
+2014-11-14 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-completion-get-completions):
+ Fix previous merge.
+
+2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-render): Don't set the title to the URL.
+
+2014-11-13 Ulrich Müller <ulm@gentoo.org>
+
+ * version.el (emacs-repository-get-version): Call `git log'
+ command with proper format argument (bug#19049).
+
+2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * bindings.el (search-map): Bind M-s M-s to `eww-search-words'.
+
+2014-11-14 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-search-words): New command (bug#16258).
+
+2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-inhibit-images): Add a doc string.
+
+ * net/eww.el (eww-after-render-hook): New variable.
+ (eww-render): Use it.
+
+ * net/shr.el (shr-descend): Don't descend further than
+ `max-specpdl-size' allows (bug#16587).
+ (shr-depth): New variable.
+ (shr-warning): New variable.
+
+2014-11-13 Ivan Shmakov <ivan@siamics.net>
+
+ * net/shr.el (shr-parse-base): Handle <base href=""> correctly.
+ (shr-expand-url): Expand absolute URLs correctly (bug#17958).
+
+2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww): Add comment to clarify.
+
+ * net/shr.el (shr-parse-image-data): Remove blocked bits from
+ external SVG images.
+ (shr-tag-object): Display images in <object> forms (bug#16244).
+ (shr-tag-table): Also insert <objects> after the tables.
+
+2014-11-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc/vc-hg.el (vc-hg-state): Disable pager. (Bug#18940)
+
+2014-11-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-form-file): Fix version number.
+
+2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-form-file): :type isn't a valid `defface' keyword.
+
+2014-11-10 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el(eww-form-file(defface)): New defface of file upload form.
+ (eww-submit-file): New key map of file upload.
+ (eww-form-file): New file upload button and file name context.
+ (eww-select-file): Select file and display selected file name.
+ (eww-tag-input): Handle input tag of file type.
+ (eww-update-field): Add point offset.
+ (eww-submit): Add submit with multipart/form-data.
+
+2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-render, eww-display-html, eww-setup-buffer):
+ Allow taking a buffer to render data in. This allows using several
+ eww buffers (bug#16211).
+
+2014-11-10 Charles Rendleman <carendle@gmail.com> (tiny change)
+
+ * net/eww.el (eww-download-callback): Save only the file contents,
+ not the headers.
+
+2014-11-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-data): New plist to store all the data relevant
+ to a single page, used throughout the file instead of the
+ variables `eww-current-url', `eww-current-dom',
+ `eww-current-source', and `eww-current-title'.
+ (eww-readable): Copy over pertinent data from the parent page.
+ (eww-save-history): Don't let the history grow infinitely.
+
+ * net/eww.el: Remove `eww-next-url', `eww-previous-url',
+ `eww-up-url', `eww-home-url', `eww-start-url' and
+ `eww-contents-url' and put the data into the `eww-data' plist.
+ This allow restoring these values after going back in the history.
+
+2014-11-10 Sylvain Chouleur <sylvain.chouleur@gmail.com> (tiny change)
+
+ Allow VTIMEZONE where daylight and standard time zones are equal.
+ See: http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00494.html
+ * calendar/icalendar.el (icalendar--convert-tz-offset):
+ Support timezone without daylight saving time.
+
+2014-11-10 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line): Handle nil elements in load-path.
+
+2014-11-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help.el (view-lossage): Include the actual commands run.
+
+2014-11-10 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-dir.el (vc-dir-hide-state): Also hide `ignored' items when
+ no state is specified. (Bug#18964)
+
+2014-11-09 Eric Ludlam <zappo@gnu.org>
+
+ * emacs-lisp/eieio-custom.el (eieio-customize-object):
+ Set eieio-cog (current group) to g, which is an improved form of input
+ group.
+
+2014-11-09 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-message-prefix): Show "Multi-file" and
+ "Multi-buffer" instead of "Multi". (Bug#13592)
+
+ * misearch.el (multi-isearch-file-list):
+ Autoload multi-isearch-buffer-list and multi-isearch-file-list.
+ (multi-isearch-end): Reset multi-isearch-buffer-list and
+ multi-isearch-file-list to nil.
+
+2014-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+ Don't call byte-compile-preprocess since the result will go through
+ cconv.
+ (byte-compile-output-docform): Handle uninterned `name' correctly.
+ * emacs-lisp/cl-macs.el (cl-define-compiler-macro): Use interned name
+ to circumvent byte-compiler bug.
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Fix typo.
+ (macroexp--compiler-macro): Remove left-over debug code.
+
+ * emacs-lisp/cl-extra.el (cl-get): Silence compiler warning.
+
+2014-11-08 Juri Linkov <juri@jurta.org>
+
+ * simple.el (shell-command): Use buffer-name when output-buffer is
+ a buffer. (Bug#18096)
+
+2014-11-08 Juri Linkov <juri@jurta.org>
+
+ * minibuffer.el (minibuffer-completion-help): Compare this-command
+ with completion-at-point. (Bug#17809)
+
+2014-11-08 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-report-error):
+ Allow the argument to be a string. Due to the vague doc,
+ it was already being used this way.
+
+2014-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-check-cached-permissions): Include hop in
+ the constructed Tramp file name. (Bug#18943)
+
+2014-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-base.el (cua--select-keymaps): Use region-active-p
+ (bug#18952).
+ (cua-set-mark, cua--post-command-handler-1):
+ * emulation/cua-gmrk.el (cua-cancel-global-mark): Same.
+
+2014-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * files.el (file-name-non-special): Wrap the call of
+ `insert-file-contents' by `unwind-protect', in order to set the
+ buffer's file name anyway. (Bug#18891)
+
+2014-11-08 Alan Mackenzie <acm@muc.de>
+
+ Fix wrong bound to c-font-lock-declarators.
+ * progmodes/cc-fonts.el (c-font-lock-declarations):
+ Pass "(point-max)" as bound to c-font-lock-declarators, not "limit", as
+ the buffer is sometimes narrowed to less than "limit" (e.g., in
+ the presence of macros). (Bug#18948)
+
+2014-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-error-with-buffer): Show connection buffer
+ only when message appeared in minibuffer. (Bug#18891)
+
+ * net/tramp-adb.el (tramp-adb-handle-file-attributes):
+ * net/tramp-gvfs.el (tramp-gvfs-handle-file-attributes):
+ * net/tramp-sh.el (tramp-sh-handle-file-attributes): Return nil in
+ case of errors.
+
+2014-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+ Don't compile before eval in `eval-and-compile'.
+ (byte-compile-arglist-warn): Add check for defining macros after their
+ first use. Check call use even if the function is fboundp.
+
+2014-11-08 Richard Stallman <rms@gnu.org>
+
+ * mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes.
+ Check more carefully for mime-part specified character set.
+ Check for mime-part Content Transfer Encoding.
+ Notify if no armor found.
+
+2014-11-08 Martin Rudalics <rudalics@gmx.at>
+
+ * faces.el (face-set-after-frame-default): Enable running
+ `window-configuration-change-hook'.
+
+2014-11-07 Juri Linkov <juri@jurta.org>
+
+ * replace.el: History for query replace pairs.
+ (query-replace-defaults): Promote to a list of cons cell. Doc fix.
+ (query-replace-from-to-separator): New variable.
+ (query-replace-read-from): Let-bind query-replace-from-to-history
+ to a list of FROM-TO strings created from query-replace-defaults
+ and separated by query-replace-from-to-separator. Use it as
+ the history while reading from the minibuffer. Split the returned
+ string by the separator to get FROM and TO parts, and add them
+ to the history variables.
+ (query-replace-read-to): Add FROM-TO pairs to query-replace-defaults.
+ (query-replace-regexp-eval): Let-bind query-replace-defaults to nil.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00253.html
+
+ * isearch.el (isearch-text-char-description): Keep characters
+ intact and put formatted strings with the `display' property.
+
+2014-11-07 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-start.el (frame-resize-pixelwise): Fix group.
+ (frame-inhibit-implied-resize): Add entry.
+
+2014-11-07 Daiki Ueno <ueno@gnu.org>
+
+ * epa.el (epa-pinentry-mode): New user option.
+ (epa-sign-file, epa-encrypt-file, epa-decrypt-region)
+ (epa-sign-region, epa-encrypt-region): Respect epa-pinentry-mode.
+ * epa-file.el (epa-file-insert-file-contents)
+ (epa-file-write-region): Respect epa-pinentry-mode.
+
+2014-11-07 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg--list-keys-1): Ignore fields after the 15th field
+ (bug#18979). Reported by Hideki Saito.
+
+2014-11-06 Daiki Ueno <ueno@gnu.org>
+
+ * emacs-lisp/package.el (package--display-verify-error): New function.
+ (package--check-signature): Use it to display output sent to stderr.
+
+2014-11-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (pop): Don't call the getter twice (bug#18968).
+
+ * emacs-lisp/macroexp.el (macroexp--expand-all): Optimize away trivial
+ uses of `funcall'.
+
+2014-11-06 Daiki Ueno <ueno@gnu.org>
+
+ * epa.el (epa-error-buffer): New variable.
+ (epa-display-error): New function.
+ (epa-decrypt-file, epa-verify-file, epa-verify-region)
+ (epa-delete-keys, epa-import-keys): Display output sent to stderr.
+ (epa-sign-file, epa-sign-region, epa-encrypt-region)
+ (epa-export-keys, epa-insert-keys): Display output sent to stderr.
+ Use setf instead of epg-context-set-*.
+ * epa-file.el (epa-file-insert-file-contents):
+ Use epa-display-error instead of epa-display-info. Mimic the behavior
+ of jka-compr when decryption program is not found.
+ (epa-file-write-region): Use epa-display-error instead of
+ epa-display-info.
+
+2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc.el (vc-region-history): New command.
+ (vc-print-log-internal): Use cl-some.
+
+ * vc/vc-git.el (vc-git-region-history): New function.
+ (vc-git-region-history-mode-map)
+ (vc-git--log-view-long-font-lock-keywords)
+ (vc-git-region-history-font-lock-keywords): New vars.
+ (vc-git-region-history-font-lock): New function.
+ (vc-git-region-history-mode): New major mode.
+
+2014-11-05 Tassilo Horn <tsdh@gnu.org>
+
+ * net/eww.el (subr-x): Require subr-x at compile-time because eww
+ uses string-trim.
+
+2014-11-05 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-context): Add new slot ERROR-OUTPUT.
+ (epg-error-output): New buffer-local variable.
+ (epg--start): Initialize epg-error-output.
+ (epg--process-filter): Record output lines sent to stderr, in
+ epg-error-output.
+ (epg-wait-for-completion): Copy epg-error-output to ERROR-OUTPUT
+ slot of context.
+ * epa-file.el (epa-file-insert-file-contents): On error, display
+ output sent to stderr.
+ (epa-file-write-region): Likewise.
+
+2014-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * jit-lock.el (jit-lock-stealth-fontify): Be tolerant to nil being
+ returned by load-average.
+
+2014-11-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Don't use
+ a local copy; setting `inhibit-file-name-handlers' proper might be
+ more performant. (Bug#18751)
+
+2014-11-05 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug): No longer include
+ recent-keys in the report. (Bug#18900)
+
+2014-11-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * mouse.el (mouse-drag-line): Fix misspelling of "right-fringe".
+
+2014-11-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/eww.el (eww): Trim URL with `string-trim'.
+ Suggested by Vibhav Pant <vibhavp@gmail.com>.
+
+2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-score-readability): Don't count comments positively.
+
+ * net/shr.el (shr-retransform-dom): Typo fix.
+
+ * net/eww.el (eww-score-readability): Parse SVC images correctly.
+ (eww-display-html): Don't leave point inside forms.
+
+ * net/shr.el: Ditto.
+
+2014-11-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-safe-prin1-to-string): Assume that
+ edebug-prin1-to-string already handles circularity.
+
+ * emacs-lisp/byte-run.el (defun-declarations-alist): Fix compiler-macro
+ autoloading when specified as a lambda.
+
+ * simple.el (execute-extended-command--last-typed): New var.
+ (read-extended-command): Set it.
+ Don't complete obsolete commands.
+ (execute-extended-command--shorter-1)
+ (execute-extended-command--shorter): New functions.
+ (execute-extended-command): Use them to suggest shorter names.
+ (indicate-copied-region, deactivate-mark): Use region-active-p.
+
+2014-11-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer): Use a
+ local copy of FILENAME, when it is remote. (Bug#18751)
+
+ * net/tramp-adb.el (tramp-adb-handle-process-file): Do not raise
+ an error when the command fails; the return code must indicate.
+ (tramp-adb-send-command-and-check): Fix docstring.
+
+2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-retransform-dom): Don't ignore elements that
+ have no children like <br />.
+
+ * net/eww.el (eww-display-html): Clear `url-queue'.
+ (eww-display-pdf): New function.
+ (eww-render): Display PDFs with `doc-view'.
+ (url-queue): Require `url-queue' to avoid compilation warning.
+ (eww-colorize-region): Remove duplicate function.
+ (eww-tag-body): Use `shr-colorize-region'.
+
+2014-11-03 Yoni Rabkin <yrk@gnu.org>
+
+ * net/eww.el (eww-list-bookmarks): Autoload.
+
+2014-11-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-retransform-dom): Allow several text sub-nodes.
+
+ * net/eww.el (eww-display-html): The charset is called `utf-8',
+ not `utf8'.
+ (eww-readable): Decode the saved text correctly.
+ (eww-readable): Save the history before displaying so that we can
+ go back to the non-readable version.
+ (eww-display-html): Don't try to decode the text if we've been
+ passed in a pre-parsed DOM.
+ (eww-tag-title): Remove newlines and extra whitespace from the
+ displayed title.
+
+2014-11-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-readable): New command and keystroke.
+
+ * net/shr.el (shr-retransform-dom): New function.
+
+ * net/eww.el (eww-display-html): Set `eww-current-source' in the
+ correct buffer.
+ (eww-view-source): Use it.
+
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww): Recognize colon-delimited IPv6 addresses.
+ (Bug#18603).
+
+2014-11-02 Brian McKenna <brian@brianmckenna.org> (tiny change)
+
+ * net/eww.el (eww-submit): Encode empty form values as "". (Bug#17785).
+
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww): Allow "file:/file/name" URLs. (Bug#18825).
+
+2014-11-02 Ivan Shmakov <ivan@siamics.net>
+
+ * net/eww.el (eww-mode-map): Remove mentions of `eww-quit'.
+ (Bug#18834).
+
+2014-11-02 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * emacs-lisp/eieio.el (eieio-edebug-prin1-to-string): Adjust for
+ use as advice.
+ (edebug-setup-hook): Advise `edebug-prin1-to-string'. (Bug#18897)
+
+2014-11-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pp.el (pp-macroexpand-expression): Use macroexpand-1
+ (bug#18821).
+ * progmodes/elisp-mode.el (emacs-lisp-macroexpand): Idem.
+
+2014-11-01 Michael R. Mauger <michael@mauger.com>
+
+ * sql.el (sql-mode-oracle-font-lock-keywords): Correct regexp
+ syntax, add new keywords, and parse longer keywords first.
+ (sql-redirect-one): Protect against empty command.
+ (sql-mode, sql-interactive-mode): Set `custom-mode-group' property
+ to SQL. (Bug#14759)
+
+2014-11-01 Michael R. Mauger <michael@mauger.com>
+
+ * sql.el (sql-interactive-mode, sql-stop): Correct fix for
+ Bug#16814 with let-bind of comint-input-ring variables around read
+ and save functions.
+
+2014-11-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-get-file-property)
+ (tramp-set-file-property): Check that `tramp-cache-get-count-*'
+ and `tramp-cache-set-count-*' are bound. Otherwise, there might
+ be compiler warnings.
+
+ * net/tramp-sh.el (tramp-get-remote-uid, tramp-get-remote-gid):
+ Return -1 respective "UNKNOWN", if uid or gid cannot be determined.
+
+2014-11-01 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/compile.el (compilation-mode): Turn off deferred
+ fontifications locally. (Bug#18856)
+
+2014-11-01 Wolfgang Jenkner <wjenkner@inode.at>
+
+ * net/tramp-sh.el (tramp-send-command): Fix the case where the
+ remote-echo connection property is non-nil (bug#18858).
+
+2014-11-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (newline): Add assertions to try and help catch bug#18913.
+
+ * emulation/cua-base.el (cua-delete-region): Use delete-active-region
+ (bug#18886).
+ (cua--last-deleted-region-pos, cua--last-deleted-region-text): Remove.
+
+2014-11-01 Kim F. Storm <storm@cua.dk>
+
+ Restore cua-delete-copy-to-register-0 and M-v command (bug#18886).
+ * delsel.el (delete-selection-save-to-register)
+ (delsel--replace-text-or-position): New vars.
+ (delete-active-region): Use them.
+ (delete-selection-repeat-replace-region): New command, moved from
+ cua-base.el.
+ * emulation/cua-base.el (cua--repeat-replace-text): Remove var.
+ (cua-repeat-replace-region): Move command to delsel.el.
+ (cua--init-keymaps): Update binding accordingly.
+ (cua-mode): Set delete-selection-save-to-register.
+
+2014-11-01 Alan Mackenzie <acm@muc.de>
+
+ Make blink-parens work with a closing template delimiter.
+ * progmodes/cc-cmds.el (c-electric-lt-gt): Cause a redisplay
+ before calling blink-paren-function, so as to apply syntax-table
+ properties to the ">".
+
+2014-11-01 Jan Djärv <jan.h.d@swipnet.se>
+
+ * select.el (gui-get-selection): Comment: data-type ignored on NS.
+
+2014-10-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/macroexp.el (macroexpand-1): New function (bug#18821).
+ (macroexp--expand-all): Unrelated tweaks.
+
+ * emacs-lisp/gv.el (gv-get): Use macroexpand-1.
+
+2014-10-30 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line): Remove pointless attempt to avoid
+ statting the file-system (which expand-file-name doesn't do).
+
+2014-10-30 Daniel Colascione <dancol@dancol.org>
+
+ Add "enum class" support to C++ mode.
+ * progmodes/cc-langs.el (c-after-brace-list-decl-kwds)
+ (c-after-brace-list-key): New language consts/variables.
+ * progmodes/cc-engine.el (c-looking-at-decl-block):
+ Exclude spurious match of "enum struct" from decl-block recognition.
+ (c-backward-colon-prefixed-type): New function.
+ (c-backward-over-enum-header): Call above function to extend
+ recognition of enum structure.
+
+2014-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-defs.el (c--macroexpand-all): New function (bug#18845).
+ (c-lang-defconst):
+ * progmodes/cc-langs.el (c-make-init-lang-vars-fun): Use it.
+
+2014-10-30 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/compile.el (compilation-start):
+ If compilation-scroll-output is non-nil, don't force window-start of
+ the compilation buffer to be at beginning of buffer. (Bug#18874)
+
+ * startup.el (fancy-about-text): Read the entire tutorial, not
+ just its first 256 bytes. (Bug#18760)
+
+2014-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el: Require cl-extra (bug#18804).
+ * emacs-lisp/cl-extra.el: Add missing provide.
+
+ * emacs-lisp/bytecomp.el (byte-compile-and-folded): Optimize case where
+ all args are copyable (bug#18767).
+ (=, <, >, <=, >=): Re-enable the optimization.
+
+2014-10-29 Glenn Morris <rgm@gnu.org>
+
+ * net/rcirc.el (rcirc-fill-column): Unbump :version. Mark :risky.
+
+ * version.el (emacs-bzr-version, emacs-bzr-get-version):
+ Revert 2014-10-26 change.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * allout-widgets.el (allout-widgets-hook-error-handler):
+ * calendar/appt.el (appt-display-message):
+ * calendar/icalendar.el (icalendar--convert-float-to-ical):
+ * calendar/timeclock.el (timeclock-in, timeclock-when-to-leave)
+ (timeclock-last-period, timeclock-day-base):
+ * eshell/em-ls.el (eshell-ls-file):
+ * eshell/esh-util.el (eshell-parse-ange-ls):
+ * generic-x.el (named-database-print-serial):
+ * net/newst-backend.el (newsticker--get-news-by-url-callback)
+ (newsticker-get-news, newsticker--sentinel-work)
+ (newsticker--image-get, newsticker--image-sentinel):
+ * net/tramp-sh.el (tramp-get-remote-touch):
+ * progmodes/opascal.el (opascal-debug-log):
+ * textmodes/remember.el (remember-mail-date)
+ (remember-store-in-files):
+ * vc/vc-annotate.el (vc-annotate-display-autoscale)
+ (vc-default-annotate-current-time):
+ * vc/vc-bzr.el (vc-bzr-shelve-snapshot):
+ * vc/vc-cvs.el (vc-cvs-annotate-current-time):
+ * vc/vc-rcs.el (vc-rcs-annotate-current-time):
+ Omit unnecessary call to current-time.
+ * calendar/time-date.el (time-to-seconds) [!float-time]:
+ * vc/vc-annotate.el (vc-annotate-convert-time):
+ Use current time if arg is nil, to be compatible with float-time.
+ (time-date--day-in-year): New function, with most of the guts of
+ the old time-to-day-in-year.
+ (time-to-day-in-year): Use it.
+ (time-to-days): Use it, to avoid decoding the same time stamp twice.
+ * calendar/timeclock.el (timeclock-time-to-date):
+ Arg is now optional, like current-time-string.
+ (timeclock-update-mode-line):
+ Don't call current-time twice to get the current time stamp,
+ as this can lead to inconsistent results.
+ * completion.el (cmpl-hours-since-origin):
+ * ido.el (ido-time-stamp):
+ * vc/vc-annotate.el (vc-annotate-convert-time):
+ Simplify by using float-time.
+ * completion.el (save-completions-to-file):
+ Rename local var to avoid confusion.
+ * net/rcirc.el (rcirc-float-time): Simplify to an alias because
+ time-to-seconds now behaves like float-time with respect to nil arg.
+ * subr.el (progress-reporter-do-update):
+ Don't call float-time unless needed.
+
+2014-10-29 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-fill-column): Use function.
+ (rcirc-markup-fill): Remove adjustment.
+
+2014-10-28 Christopher Schmidt <ch@ristopher.com>
+
+ * calc/calc.el (quick-calc):
+ * calc/calc-aent.el (calc-do-quick-calc): New argument INSERT.
+
+2014-10-28 Sam Steingold <sds@gnu.org>
+
+ * net/rcirc.el (rcirc-fill-column): Allow any symbolic value for
+ the sake of `window-body-width' (in addition to `frame-width').
+
+2014-10-26 Eric S. Raymond <esr@thyrsus.com>
+
+ * version.el: Fix some fallback values to conform to the actual
+ release number.
+
+2014-10-25 Eric S. Raymond <esr@thyrsus.com>
+
+ * Makefile.in: Change some production names so they're neutral
+ about the repository type.
+
+2014-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-gvfs.el (tramp-gvfs-methods-mounttracker)
+ (tramp-gvfs-mountlocation-signature): Check `tramp-gvfs-enabled'
+ during initialization. (Bug#18774)
+
+2014-10-25 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (macroexp): Add require for this package, so that
+ function `ses--cell' gets macroexp-quote --- this change was
+ supposed to be in my previous commit, but left out by mistake.
+ (ses--cell): Do not make formula a macroexp-quote of value when
+ value, not formula, is *skip*.
+
+2014-10-24 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (macroexp): Add require for this package, so that function
+ `ses--cell gets macroexp-quote.
+ (ses--cell): Makes formula a macroexp-quote of value when formula
+ is nil. The rationale of this changr is to allow in the future
+ shorter SES files, e.g. we could have only `(ses-cell A1 1.0)'
+ instead of `(ses-cell A1 1.0 1.0 nil REFLIST)'. In such a case
+ reference list REFLIST would be re-computed after load --- thus
+ trading off load time against file size.
+
+ * emacs-lisp/package.el (package--alist-to-plist-args):
+ Use macroexp-quote instead of a lambda expression which has the same
+ content as macroexp-quote.
+ (macroexp): Add require for this package, so that function
+ `package--alist-to-plist-args' gets macroexp-quote.
+
+ * emacs-lisp/macroexp.el (macroexp-quote): New defun.
+
+2014-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/ns-win.el (ns-store-cut-buffer-internal)
+ (ns-copy-including-secondary): Use gui-set-selection (bug#18816).
+
+2014-10-24 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (mouse-drag-line): Don't use mouse-pixel-position.
+ Calculate increment from last position instead of window edge.
+ Add right- and bottom-divider bindings to transient map.
+
+2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defstruct): Define an internal predicate
+ even if :predicate was nil, for the benefit of typep.
+ Record the name of the predicate for typep's use.
+ (cl--make-type-test): Use pcase. Obey new
+ cl-deftype-satisfies property.
+
+ * epg.el: Use cl-defstruct.
+ (epg-make-data-from-file, epg-make-data-from-string, epg-data-file)
+ (epg-data-string): Define via cl-defstruct.
+ (epg--gv-nreverse): New macro.
+ (epg-context--make): New constructor (provided vi cl-defstruct).
+ (epg-make-context): Rewrite using it.
+ (epg-context-protocol, epg-context-program)
+ (epg-context-home-directory, epg-context-armor, epg-context-textmode)
+ (epg-context-include-certs, epg-context-cipher-algorithm)
+ (epg-context-digest-algorithm, epg-context-compress-algorithm)
+ (epg-context-passphrase-callback, epg-context-progress-callback)
+ (epg-context-signers, epg-context-sig-notations, epg-context-process)
+ (epg-context-output-file, epg-context-result, epg-context-operation)
+ (epg-context-pinentry-mode): Define using cl-defstruct.
+ (epg-context-set-protocol, epg-context-set-program)
+ (epg-context-set-include-certs, epg-context-set-cipher-algorithm)
+ (epg-context-set-digest-algorithm)
+ (epg-context-set-sig-notations, epg-context-set-process)
+ (epg-context-set-output-file, epg-context-set-result)
+ (epg-context-set-operation, epg-context-set-pinentry-mode)
+ (epg-context-set-compress-algorithm): Remove. Use setf instead.
+ (epg-context-set-armor, epg-context-set-textmode)
+ (epg-context-set-signers): Redefine using setf
+ and declare as obsolete.
+ (epg-context-set-passphrase-callback)
+ (epg-context-set-progress-callback): Use setf.
+ (epg-signature-notations): Rename from epg-sig-notations.
+ (epg-make-signature, epg-signature-status, epg-signature-key-id)
+ (epg-signature-validity, epg-signature-fingerprint)
+ (epg-signature-creation-time, epg-signature-expiration-time)
+ (epg-signature-pubkey-algorithm, epg-signature-digest-algorithm)
+ (epg-signature-class, epg-signature-version): Define vi cl-defstruct.
+ (epg-signature-set-status, epg-signature-set-key-id)
+ (epg-signature-set-validity, epg-signature-set-fingerprint)
+ (epg-signature-set-creation-time, epg-signature-set-expiration-time)
+ (epg-signature-set-pubkey-algorithm)
+ (epg-signature-set-digest-algorithm, epg-signature-set-class)
+ (epg-signature-set-version, epg-signature-set-notations): Remove.
+ Use setf instead.
+ (epg-make-new-signature, epg-new-signature-type)
+ (epg-new-signature-pubkey-algorithm)
+ (epg-new-signature-digest-algorithm, epg-new-signature-class)
+ (epg-new-signature-creation-time, epg-new-signature-fingerprint):
+ Define using cl-defstruct.
+ (epg-make-key, epg-key-owner-trust, epg-key-sub-key-list)
+ (epg-key-user-id-list): Define using cl-defstruct.
+ (epg-key-set-sub-key-list, epg-key-set-user-id-list): Remove.
+ Use setf instead.
+ (epg-make-sub-key, epg-sub-key-validity, epg-sub-key-capability)
+ (epg-sub-key-secret-p, epg-sub-key-algorithm, epg-sub-key-length)
+ (epg-sub-key-id, epg-sub-key-creation-time)
+ (epg-sub-key-expiration-time, epg-sub-key-fingerprint): Define using
+ cl-defstruct.
+ (epg-sub-key-set-fingerprint): Remove. Use setf instead.
+ (epg-make-user-id, epg-user-id-validity, epg-user-id-string)
+ (epg-user-id-signature-list): Define using cl-defstruct.
+ (epg-user-id-set-signature-list): Remove. Use setf instead.
+ (epg-make-key-signature, epg-key-signature-validity)
+ (epg-key-signature-pubkey-algorithm, epg-key-signature-key-id)
+ (epg-key-signature-creation-time, epg-key-signature-expiration-time)
+ (epg-key-signature-user-id, epg-key-signature-class)
+ (epg-key-signature-exportable-p): Define using cl-defstruct.
+ (epg-make-sig-notation, epg-sig-notation-name)
+ (epg-sig-notation-value, epg-sig-notation-human-readable)
+ (epg-sig-notation-critical): Define using cl-defstruct.
+ (epg-sig-notation-set-value): Remove. Use setf instead.
+ (epg-make-import-status, epg-import-status-fingerprint)
+ (epg-import-status-reason, epg-import-status-new)
+ (epg-import-status-user-id, epg-import-status-signature)
+ (epg-import-status-sub-key, epg-import-status-secret): Define using
+ cl-defstruct.
+ (epg-make-import-result, epg-import-result-considered)
+ (epg-import-result-no-user-id, epg-import-result-imported)
+ (epg-import-result-imported-rsa, epg-import-result-unchanged)
+ (epg-import-result-new-user-ids, epg-import-result-new-sub-keys)
+ (epg-import-result-new-signatures, epg-import-result-new-revocations)
+ (epg-import-result-secret-read, epg-import-result-secret-imported)
+ (epg-import-result-secret-unchanged, epg-import-result-not-imported)
+ (epg-import-result-imports): Define using cl-defstruct.
+
+ * emacs-lisp/package.el: Require EPG during macroexpansion.
+ (package--check-signature, package-import-keyring): Use setf instead of
+ epg-context-set-home-directory.
+
+2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile--use-old-handlers): Change default.
+
+2014-10-23 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cfengine.el (cfengine3-defun-full-re): New var.
+ (cfengine3-create-imenu-index): Use it and use ` ' for separation.
+ (cfengine3-current-defun): New function.
+ (cfengine3-mode): Set add-log-current-defun-function.
+
+2014-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * select.el: Use lexical-binding.
+ (gui-set-selection): Provide an implementation for non-GUI frames
+ (bug#18791).
+ * term/x-win.el: Use lexical-binding.
+ (x-clipboard-yank): Fix up missed renamings.
+ * term/w32-win.el (libgif-version, libjpeg-version): Silence compiler.
+ (w32--set-selection): Fix up var names.
+ * term/pc-win.el: Use lexical-binding.
+ (w16-selection-exists-p): Silence compiler warning.
+ (w16-selection-owner-p): Fix up missed renamings.
+
+ * emacs-lisp/bytecomp.el (byte-compile-form): Remove left-over debug.
+
+ * frame.el (frame-notice-user-settings): Fix excessive quoting.
+
+2014-10-22 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-open-text): View the document's plain text
+ in the current buffer instead of a new one.
+ (doc-view-toggle-display): Handle the case where the current
+ buffer contains the plain text contents of the document.
+ (doc-view-initiate-display): Don't switch to fallback mode if the
+ user wants to view the doc's plain text.
+ (doc-view-set-doc-type): Use assoc-string instead of
+ assoc-ignore-case.
+
+2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-key): Fix clicks on the mode-line.
+ (set-transient-map): Return exit function.
+
+ * mouse.el (mouse-drag-line): Use set-transient-map (bug#18015).
+ (mouse--down-1-maybe-follows-link): Remove unused var `this-event'.
+ (mouse-yank-secondary): Use gui-get-selection.
+ (mouse--down-1-maybe-follows-link): Use read-key.
+
+ * xt-mouse.el: Add `event-kind' property on the fly from
+ xterm-mouse-translate-1 rather than statically at the outset.
+
+2014-10-21 Daniel Colascione <dancol@dancol.org>
+
+ * vc/vc-dispatcher.el (vc-resynch-window): Tell view-mode not to
+ change window configuration when we turn it off.
+
+2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Get rid of backend-dependent selection-handling functions for kill/yank
+ and make it generic instead by relying on the lower-level selection
+ management functions.
+
+ * select.el (select-enable-clipboard): Rename from
+ gui-select-enable-clipboard.
+ (select-enable-primary): Move from x-win.el and rename from
+ x-select-enable-primary.
+ (gui-last-selected-text): Remove.
+ (gui--last-selected-text-clipboard, gui--last-selected-text-primary):
+ New vars.
+ (gui-select-text): Rewrite, based on x-win.el's old x-select-text.
+ (gui-select-text-alist, gui-selection-value-alist): Remove.
+ (x-select-request-type): Move from x-win.el.
+ (gui--selection-value-internal): New function, taken from x-win's
+ x-selection-value-internal.
+ (gui-selection-value): Rewrite, based on x-win.el's old x-selection-value.
+ (gui-set-selection-alist): Rename from gui-own-selection-alist and
+ extend it to handle a nil value as a "disown" request.
+ (gui-disown-selection-alist): Remove.
+ (xselect-convert-to-delete): Adjust accordingly.
+ (gui-set-selection): Simplify accordingly as well. Use dotimes.
+
+ * term/x-win.el (x-last-selected-text-primary)
+ (x-select-enable-primary): Remove (moved to select.el).
+ (x-select-request-type): Move to select.el.
+ (x-selection-value-internal, x--selection-value): Remove functions.
+ (gui-selection-value, gui-select-text): Remove moethods.
+ (gui-set-selection): Merge own and disown methods.
+
+ * term/w32-win.el (w32--select-text, w32--get-selection-value):
+ Delete function (move functionality into w32--set-selection and
+ w32--get-selection).
+ (gui-select-text, gui-selection-value): Don't define methods.
+ (w32--set-selection, w32--get-selection, w32--selection-owner-p):
+ New functions.
+ (gui-get-selection, gui-selection-owner-p, gui-selection-exists-p):
+ Use them.
+ (gui-selection-exists-p): Adjust to new name of C primitive.
+
+ * term/pc-win.el (w16-get-selection-value): Add dummy argument and drop
+ test of gui-select-enable-clipboard, to make it usable as
+ a gui-get-selection method.
+ (gui-selection-exists-p): Adjust to new name of C primitive.
+ (gui-set-selection): Merge own and disown methods.
+ (gui-select-text, gui-selection-value): Delete methods.
+ (w16--select-text): Delete function.
+
+ * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard)
+ (ns-selection-value): Remove functions.
+ (gui-select-text, gui-selection-value): Don't define method any more.
+ (gui-set-selection): Merge the old own and disown methods.
+ (gui-selection-exists-p, gui-get-selection): Adjust to new name of
+ underlying C primitive.
+
+ * startup.el (command-line): Adjust now that `gui-method' expects nil
+ for ttys.
+
+ * frame.el (gui-method): Use window-system rather than framep.
+ (gui-method-declare): The tty case is now nil rather than t.
+ (make-frame): Adjust accordingly.
+
+2014-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/newst-reader.el (newsticker--image-read): Simplify.
+ (newsticker--icon-read): Use dolist and fix free var error.
+
+ * imenu.el (imenu--menubar-keymap): New var.
+ (imenu-add-to-menubar): Set it to remember the keymap we used.
+ (imenu-update-menubar): Use it instead of asking lookup-key.
+
+ * obsolete/cc-compat.el: Make obsolete (bug#18561).
+
+ * epg-config.el (epg-gpg-program): Don't use absolute names by default.
+
+ * emacs-lisp/bytecomp.el (=, <, >, <=, >=): Don't optimize multi-arg
+ case (bug#18767).
+
+2014-10-21 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to version 24.4 release.
+
+2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (=, <, >, <=, >=): Don't optimize multi-arg
+ case (bug#18767).
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-20 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el
+ (newsticker--image-download-by-url-callback): Make this function
+ actually work: Check status properly, then save image.
+
+2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse--down-1-maybe-follows-link): Remove unused var
+ `this-event'.
+ (mouse-drag-line): Unless there's no actual mouse, use the event's
+ position info.
+
+2014-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el (scss-mode): New major-mode.
+ (css-mode-syntax-table): Use d style comment, to ease the scss case.
+ (css-ident-re): Allow things like @-moz-keyframes.
+ (scss--hash-re): New const.
+ (css--font-lock-keywords): New function, extracted from
+ css-font-lock-keywords.
+
+2014-10-19 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el: Require url-parse.
+ (newsticker--get-news-by-wget): Store feed name as process property.
+ (newsticker--sentinel): Read feed name from process property.
+ (newsticker--sentinel-work): Rename argument name to feed-name.
+ Rename variable imageurl to image-url. Pick icon url from Atom
+ 1.0 data. Launch download of feed icon.
+ (newsticker--get-icon-url-atom-1.0): New.
+ (newsticker--unxml)
+ (newsticker--unxml-node)
+ (newsticker--unxml-attribute): Documentation.
+ (newsticker--icons-dir): New.
+ (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.
+ (newsticker--image-save)
+ (newsticker--image-remove)
+ (newsticker--image-download-by-url)
+ (newsticker--image-download-by-url-callback): New.
+ (newsticker-opml-export): Handle url list entries containing a
+ function instead of an url string.
+
+ * net/newst-reader.el (newsticker-html-renderer): Whitespace.
+ (newsticker--print-extra-elements)
+ (newsticker--do-print-extra-element):
+ Documentation (newsticker--image-read): Optionally limit image height.
+ Use imagemagick if possible.
+ (newsticker--icon-read): New.
+
+ * net/newst-treeview.el (newsticker--treeview-item-show): Limit height of feed logo.
+ (newsticker--treeview-tree-expand): Use feed icons in treeview.
+ (newsticker--tree-widget-icon-create): New. Set the tree widget icon.
+ (newsticker--tree-widget-leaf-icon): Use feed icon.
+
+2014-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-opt.el (eieio-lambda-arglist): Remove.
+ Use help-function-arglist instead.
+
+ * emacs-lisp/eieio-core.el (eieio-compiled-function-arglist): Remove.
+ (eieio--with-scoped-class): Use `declare'.
+ (eieio-defclass): Remove compatibility code.
+ (no-method-definition, no-next-method, inconsistent-class-hierarchy)
+ (invalid-slot-type, unbound-slot, invalid-slot-name): Use define-error.
+
+2014-10-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * cus-start.el (x-gtk-whole-detached-tool-bar): Remove.
+
+ * term/x-win.el (x-gtk-stock-map): Add icon names suggested as
+ replacements to stock names before stock names in a list.
+ Cdr may be a list, each name is tried in turn until one is found.
+
+2014-10-18 Alan Mackenzie <acm@muc.de>
+
+ Check that a "macro" found near point-min isn't a ## operator.
+ * progmodes/cc-engine.el (c-macro-is-genuine-p): New function.
+ (c-beginning-of-macro): Use the above new function. (Bug#18749)
+
+2014-10-18 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-negotiate): Don't use cl-mapcan; pass
+ correct data to `gnutls-boot' (Bug#18664).
+ Reported by Toke Høiland-Jørgensen <toke@toke.dk>.
+
+2014-10-18 Michal Nazarewicz <mina86@mina86.com>
+
+ * whitespace.el (whitespace-style, whitespace-big-indent)
+ (whitespace-big-indent-regexp, whitespace-style-value-list)
+ (whitespace-toggle-option-alist, whitespace-interactive-char)
+ (whitespace-toggle-options)
+ (global-whitespace-toggle-options, whitespace-help-text)
+ (whitespace-style-face-p, whitespace-color-on): Add a 'big-indent
+ style to `whitespace-mode' to indicate that the line indentation
+ is too deep. By default, 32 SPACEs or four TABs are considered
+ too many but `whitespace-big-indent-regexp' can be configured.
+
+2014-10-17 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/tildify.el (tildify--pick-alist-entry): Rename from
+ tildify-mode-alist.
+
+2014-10-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio.el: Use lexical-binding drop non-GV fallback.
+ (defclass, defgeneric, defmethod): Add doc-string position.
+ (with-slots): Require cl-lib.
+
+ * emacs-lisp/eieio-core.el: Use lexical-binding and cl-lib.
+ (list-of): New type.
+ (eieio--typep): Remove.
+ (eieio-perform-slot-validation): Use cl-typep instead.
+
+ * emacs-lisp/eieio-base.el: Use lexical-binding and cl-lib.
+
+ * emacs-lisp/cl-macs.el (cl--make-type-test): Avoid ((lambda ..) ..).
+
+2014-10-16 Alan Mackenzie <acm@muc.de>
+
+ Trigger showing when point is in the "periphery" of a line or just
+ inside a paren.
+ * paren.el (show-paren-style, show-paren-delay)
+ (show-paren-priority, show-paren-ring-bell-on-mismatch):
+ Remove superfluous :group specifications.
+ (show-paren-when-point-inside-paren)
+ (show-paren-when-point-in-periphery): New customizable variables.
+ (show-paren-highlight-openparen): Make into a defcustom.
+ (show-paren--unescaped-p, show-paren--categorize-paren)
+ (show-paren--locate-near-paren): New defuns.
+ (show-paren--default): Refaactor and trigger on more paren
+ positions.
+ (show-paren-function): Small consequential changes.
+
+2014-10-16 Tom Tromey <tom@tromey.com>
+
+ * files.el (auto-mode-alist): Use javascript-mode for .jsm
+ (bug #18719).
+
+2014-10-16 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el (bracket-type): Force pre-loading of
+ uni-brackets.el.
+
+2014-10-16 Alan Mackenzie <acm@muc.de>
+
+ * cus-edit.el (custom-command-apply): Specify the return value in
+ the doc string.
+ (Custom-reset-standard): Save custom-file (e.g. .emacs) only when
+ custom-command-apply has returned non-nil.
+
+2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el (global-eldoc-mode): Enable by default.
+ Remove incorrect handling of eldoc-print-after-edit.
+ (eldoc-message-commands, eldoc-last-data): Use defvar.
+ * loadup.el (emacs-lisp/eldoc): Load it.
+
+ * progmodes/m4-mode.el (m4-syntax-propertize): New var.
+ (m4-mode): Use it.
+ (m4--quoted-p): New function.
+ (m4-font-lock-keywords): Don't handle #..\n comments any more.
+ (m4-mode-syntax-table): Use punctuation syntax (according to m4 manual)
+ for most special characters.
+
+ * progmodes/compile.el (compilation--previous-directory): Simplify.
+ (compilation-next-error): Ensure the parse before we look at
+ compilation-message property.
+
+2014-10-15 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (what-cursor-position):
+ * descr-text.el (describe-char): Update to support the new bidi
+ characters.
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-mode):
+ Force bidi-paragraph-direction to 'left-to-right'. This fixes
+ buffer-menu display when the first buffer happens to start with
+ R2L letter.
+
+2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/elisp-mode.el (elisp--local-variables-1):
+ Handle quoted expressions (bug#18688).
+
+2014-10-14 Jérémy Compostella <jeremy.compostella@intel.com>
+ Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
+ Reduce the amount of set environment variable commands.
+
+2014-10-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix import completion. (Bug#18582)
+ * progmodes/python.el (python-shell-completion-get-completions):
+ Fix import case regexp.
+
+2014-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/bat-mode.el (bat-font-lock-keywords): Fix \\<_ typo
+ (bug#18622). Reported by Arni Magnusson <arnima@hafro.is>.
+ * progmodes/prolog.el (prolog-electric--underscore): Same.
+
+2014-10-12 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-get-remote-id): Check also for "gid".
+
+2014-10-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * cus-start.el (all): Add missing ns and boolean to
+ ns-use-fullscreen-animation.
+
+2014-10-11 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cfengine.el (cfengine3-defuns, cfengine3-vartypes):
+ Use strings.
+ (cfengine3-create-imenu-index): New function.
+ (cfengine3-mode): Use it for `imenu-create-index-function'.
+ (cfengine-auto-mode): Improve and prefer cfengine3-mode when
+ buffer is empty.
+
+2014-10-11 Jan Djärv <jan.h.d@swipnet.se>
+
+ * cus-start.el (all): Add ns-use-fullscreen-animation.
+
+2014-10-11 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-display-function):
+ Drop support for deprecated nil and list forms.
+ (diary-list-entries): Update for the above.
+ * calendar/cal-x.el (calendar-dedicate-diary): Simplify accordingly.
+
+2014-10-10 Leo Liu <sdl.web@gmail.com>
+
+ * window.el (temp-buffer-window-show): Make BUFFER a required arg.
+ (Bug#18656)
+
+2014-10-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * select.el (gui-selection-exists-p-alist): New method.
+ * menu-bar.el (menu-bar-edit-menu, clipboard-yank):
+ * simple.el (deactivate-mark): Use it.
+ * term/x-win.el (gui-selection-exists-p):
+ * term/w32-win.el (gui-selection-exists-p):
+ * term/pc-win.el (gui-selection-exists-p):
+ * term/ns-win.el (gui-selection-exists-p): Provide a backend instance.
+
+2014-10-10 Glenn Morris <rgm@gnu.org>
+
+ * info.el (Info-fontify-maximum-menu-size): Bump to 400k. (Bug#16227)
+ Fix :type. Allow t to mean no limit.
+ (Info-fontify-node): Handle Info-fontify-maximum-menu-size = t.
+
+2014-10-09 Glenn Morris <rgm@gnu.org>
+
+ * frame.el (display-monitor-attributes-list): Doc tweaks.
+
+2014-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ * faces.el (display-grayscale-p): Mention in the doc string that
+ the argument can be either a display name or a frame.
+
+ * frame.el (display-pixel-height, display-pixel-width)
+ (display-mm-height, display-mm-width, display-backing-store)
+ (display-save-under, display-planes, display-color-cells)
+ (display-visual-class, display-monitor-attributes-list)
+ (display-screens): Mention in the doc string that the argument can
+ be either a display name or a frame. Improve the docs of the
+ monitor attributes. (Bug#18636)
+
+2014-10-09 Martin Rudalics <rudalics@gmx.at>
+
+ * term.el (term-window-width): Subtract 1 from the width when
+ any fringe has zero width, not just the right fringe. (Bug#18601)
+
+2014-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frame.el (make-frame): Use t rather than nil for `w' (bug#18653).
+
+2014-10-08 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-extra.el (cl-fresh-line): New function.
+
+2014-10-08 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-x.el (calendar-dedicate-diary):
+ Drop support for recently deleted aliases.
+
+2014-10-08 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/cfengine.el (cfengine3-make-syntax-cache):
+ Always return a syntax. Replace call-process-shell-command with
+ process-file. Ensure cfengine-mode-syntax-functions-regex is
+ always set. Ensure cache when cfengine-cf-promises fails.
+ (Bug#18620)
+
+2014-10-07 Glenn Morris <rgm@gnu.org>
+
+ * font-lock.el (font-lock-fontify-buffer): Fix interactive-only markup.
+
+2014-10-07 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision c075a492.
+ * progmodes/verilog-mode.el (verilog-mode-version): Bump.
+ (verilog-menu): Add AUTOINSERTLAST.
+ (verilog-no-indent-begin-re): When `verilog-indent-begin-after-if'
+ is nil, fix indenting initial/final to match always statements, bug825.
+ Reported by Tim Clapp.
+ (verilog-extended-complete-re): Fix indentation of DPI-C imports,
+ bug557. Reported by ZeDong Mao and Jason Forkey.
+ (verilog-read-decls): Fix parsing typed interfaces.
+ Fix AUTOINOUTMODPORT missing types. Reported by Stephan Bourduas.
+ (verilog-auto-arg-ports): Fix verilog-auto-arg-format single.
+ (verilog-auto-output-every): Add regexp to AUTOOUTPUTEVERY, bug793.
+ Reported by Pierre-David Pfister.
+ (verilog-auto-insert-lisp): Doc fix.
+ (verilog-auto-insert-last, verilog-auto): Add AUTOINSERTLAST to
+ allow post-AUTO user fixups, bug826. Reported by Dennis Muhlestein.
+ (verilog-sk-ovm-class, verilog-sk-uvm-object)
+ (verilog-sk-uvm-component): Fix missing string keyword in class
+ skeletons, bug824. Reported by eldad faruhi.
+
+2014-10-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/w32-win.el: Move all code from 32-common-fns.el here.
+ (gui-select-text, gui-selection-value): Use w32 handlers in the w32
+ console as well (bug#18629).
+ * w32-common-fns.el: Remove.
+ * loadup.el: Don't load w32-common-fns.el.
+ * w32-fns.elc: Don't require w32-common-fns.
+
+ * icomplete.el: Move Iswitchb autoload here. Much simpler.
+ * obsolete/iswitchb.el (iswitchb-mode): Use normal autoload cookie.
+ Remove redundant obsolescence thingy.
+ * loadup.el: Don't load obsolete/loaddefs.el.
+ * Makefile.in (obsolete-autoloads): Remove.
+ (AUTOGENEL): Remove obsolete/loaddefs.el.
+
+2014-10-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (obsolete-autoloads): Write to a separate file,
+ to workaround autoloads bug. (Bug#17407)
+ (AUTOGENEL): Add obsolete/loaddefs.el.
+ * loadup.el: Load obsolete/loaddefs.el if present.
+ * subr.el (do-after-load-evaluation):
+ Don't warn about obsolete/loaddefs.el.
+
+ * menu-bar.el (menu-bar-games-menu): Remove landmark.
+ It has zero relationship to a game.
+
+2014-10-06 Leo Liu <sdl.web@gmail.com>
+
+ * imenu.el (imenu): Re-write for clarity.
+
+2014-10-06 Glenn Morris <rgm@gnu.org>
+
+ Remove calendar code obsolete since at least version 23.1.
+ * calendar/cal-bahai.el (calendar-absolute-from-bahai)
+ (calendar-print-bahai-date, calendar-bahai-prompt-for-date)
+ (calendar-goto-bahai-date, list-bahai-diary-entries)
+ (mark-bahai-calendar-date-pattern, mark-bahai-diary-entries)
+ (insert-bahai-diary-entry, insert-monthly-bahai-diary-entry)
+ (insert-yearly-bahai-diary-entry):
+ * calendar/cal-china.el (chinese-calendar-time-zone)
+ (chinese-calendar-location-name)
+ (chinese-calendar-daylight-time-offset)
+ (chinese-calendar-standard-time-zone-name)
+ (chinese-calendar-daylight-time-zone-name)
+ (chinese-calendar-daylight-savings-starts)
+ (chinese-calendar-daylight-savings-ends)
+ (chinese-calendar-daylight-savings-starts-time)
+ (chinese-calendar-daylight-savings-ends-time)
+ (chinese-calendar-celestial-stem)
+ (chinese-calendar-terrestrial-branch)
+ (calendar-absolute-from-chinese, calendar-print-chinese-date)
+ (calendar-goto-chinese-date):
+ * calendar/cal-coptic.el (calendar-absolute-from-coptic)
+ (calendar-print-coptic-date, coptic-prompt-for-date)
+ (calendar-goto-coptic-date, calendar-absolute-from-ethiopic)
+ (calendar-print-ethiopic-date, calendar-goto-ethiopic-date):
+ * calendar/cal-french.el (calendar-absolute-from-french)
+ (calendar-print-french-date, calendar-goto-french-date):
+ * calendar/cal-hebrew.el (diary-sabbath-candles-minutes)
+ (calendar-absolute-from-hebrew, calendar-print-hebrew-date)
+ (hebrew-calendar-yahrzeit, calendar-goto-hebrew-date)
+ (holiday-rosh-hashanah-etc, holiday-hanukkah)
+ (holiday-passover-etc, holiday-tisha-b-av-etc)
+ (list-hebrew-diary-entries, mark-hebrew-calendar-date-pattern)
+ (mark-hebrew-diary-entries, insert-hebrew-diary-entry)
+ (insert-monthly-hebrew-diary-entry)
+ (insert-yearly-hebrew-diary-entry, list-yahrzeit-dates)
+ (diary-omer, diary-yahrzeit, diary-rosh-hodesh, diary-parasha)
+ (diary-sabbath-candles):
+ * calendar/cal-islam.el (calendar-absolute-from-islamic)
+ (calendar-print-islamic-date, calendar-goto-islamic-date)
+ (list-islamic-diary-entries, mark-islamic-calendar-date-pattern)
+ (mark-islamic-diary-entries, insert-islamic-diary-entry)
+ (insert-monthly-islamic-diary-entry)
+ (insert-yearly-islamic-diary-entry):
+ * calendar/cal-iso.el (calendar-absolute-from-iso)
+ (calendar-print-iso-date, calendar-iso-read-args)
+ (calendar-goto-iso-date, calendar-goto-iso-week):
+ * calendar/cal-julian.el (calendar-absolute-from-julian)
+ (calendar-print-julian-date, calendar-goto-julian-date)
+ (calendar-absolute-from-astro, calendar-print-astro-day-number)
+ (calendar-goto-astro-day-number):
+ * calendar/cal-mayan.el (calendar-print-mayan-date)
+ (calendar-next-haab-date, calendar-previous-haab-date)
+ (calendar-next-tzolkin-date, calendar-previous-tzolkin-date)
+ (calendar-next-calendar-round-date)
+ (calendar-previous-calendar-round-date)
+ (calendar-absolute-from-mayan-long-count)
+ (calendar-goto-mayan-long-count-date):
+ * calendar/cal-move.el (scroll-calendar-left)
+ (scroll-calendar-right, scroll-calendar-left-three-months)
+ (scroll-calendar-right-three-months):
+ * calendar/cal-persia.el (calendar-absolute-from-persian)
+ (calendar-print-persian-date, persian-prompt-for-date)
+ (calendar-goto-persian-date):
+ * calendar/cal-x.el (calendar-after-frame-setup-hooks):
+ * calendar/calendar.el (view-diary-entries-initially)
+ (mark-diary-entries-in-calendar, calendar-today-face)
+ (diary-face, holiday-face, view-calendar-holidays-initially)
+ (mark-holidays-in-calendar, initial-calendar-window-hook)
+ (today-visible-calendar-hook, today-invisible-calendar-hook)
+ (hebrew-diary-entry-symbol, islamic-diary-entry-symbol)
+ (bahai-diary-entry-symbol, american-date-diary-pattern)
+ (european-date-diary-pattern, european-calendar-display-form)
+ (american-calendar-display-form, holidays-in-diary-buffer)
+ (all-hebrew-calendar-holidays, all-christian-calendar-holidays)
+ (all-islamic-calendar-holidays, all-bahai-calendar-holidays)
+ (fancy-diary-buffer, increment-calendar-month)
+ (extract-calendar-month, extract-calendar-day)
+ (extract-calendar-year, exit-calendar, calendar-date-is-legal-p)
+ (mark-visible-calendar-date, calendar-version):
+ * calendar/diary-lib.el (diary-button-face, sexp-diary-entry-symbol)
+ (diary-display-hook, list-diary-entries-hook)
+ (mark-diary-entries-hook, nongregorian-diary-listing-hook)
+ (nongregorian-diary-marking-hook, print-diary-entries-hook)
+ (abbreviated-calendar-year, number-of-diary-entries)
+ (view-other-diary-entries, add-to-diary-list)
+ (include-other-diary-files, simple-diary-display)
+ (fancy-diary-display, print-diary-entries, mark-diary-entries)
+ (mark-sexp-diary-entries, mark-included-diary-files)
+ (mark-calendar-days-named, mark-calendar-month)
+ (mark-calendar-date-pattern, sort-diary-entries)
+ (list-sexp-diary-entries, make-diary-entry, insert-diary-entry)
+ (insert-weekly-diary-entry, insert-monthly-diary-entry)
+ (insert-yearly-diary-entry, insert-anniversary-diary-entry)
+ (insert-block-diary-entry, insert-cyclic-diary-entry)
+ (fancy-diary-font-lock-keywords, fancy-diary-display-mode):
+ * calendar/holidays.el (general-holidays, oriental-holidays)
+ (local-holidays, other-holidays, hebrew-holidays)
+ (christian-holidays, islamic-holidays, bahai-holidays)
+ (solar-holidays, list-calendar-holidays)
+ (check-calendar-holidays, mark-calendar-holidays)
+ (filter-visible-calendar-holidays):
+ * calendar/lunar.el (calendar-phases-of-moon, phases-of-moon)
+ (diary-phases-of-moon): Remove obsolete aliases.
+ * calendar/cal-menu.el (cal-menu-load-hook): Remove obsolete hook.
+ * calendar/cal-x.el (calendar-one-frame-setup)
+ (calendar-only-one-frame-setup, calendar-two-frame-setup):
+ Remove obsolete functions.
+ (cal-x-load-hook): Remove obsolete hook.
+ * calendar/calendar.el (european-calendar-style):
+ Remove obsolete variable.
+ (calendar-date-style): No longer consult european-calendar-style.
+ * calendar/calendar.el (european-calendar, american-calendar):
+ Remove obsolete commands.
+ * calendar/calendar.el (calendar-for-loop): Remove obsolete macro.
+ * calendar/diary-lib.el (diary-face): Remove obsolete variable.
+ (diary-font-lock-date-forms, diary-fancy-font-lock-keywords):
+ Use the face `diary' instead of the variable `diary-face'.
+ * calendar/holidays.el (hebrew-holidays-1, hebrew-holidays-2)
+ (hebrew-holidays-3, hebrew-holidays-4): Remove obsolete variables.
+ * calendar/icalendar.el (icalendar--date-style): Remove function.
+ Replace all uses with calendar-date-style.
+ * textmodes/remember.el (calendar-date-style): Declare.
+ (remember-diary-convert-entry):
+ No longer consult european-calendar-style.
+
+2014-10-05 Leo Liu <sdl.web@gmail.com>
+
+ * imenu.el (imenu-default-goto-function): Fix typo.
+
+2014-10-04 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ * net/ntlm.el (ntlm-build-auth-request):
+ Add NTLM2 Session support. (Bug#15603)
+
+2014-10-04 Glenn Morris <rgm@gnu.org>
+
+ * apropos.el (apropos-symbols-internal):
+ Avoid error with non-symbol properties. (Bug#18337#16)
+
+ * startup.el (command-line):
+ Handle altered user-emacs-directory in load-path warning. (Bug#18512)
+
+2014-10-04 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-full-height-p): Make it behave correctly for
+ minibuffer window.
+ (window-current-scroll-bars): Fix code.
+ (fit-frame-to-buffer): Use window-scroll-bar-height instead of
+ window-scroll-bars.
+ * frame.el (frame-current-scroll-bars): Fix doc-string.
+ * scroll-bar.el (toggle-horizontal-scroll-bar): New command.
+
+2014-10-04 Mark Oteiza <mvoteiza@udel.edu> (tiny change)
+
+ * files.el (auto-mode-alist): Use sh-mode for .zsh files. (Bug#18488)
+
+2014-10-04 Glenn Morris <rgm@gnu.org>
+
+ * frame.el (frame-monitor-attributes)
+ (display-monitor-attributes-list): Doc fixes.
+
+2014-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Merge trivially safe differences from standalone CC-mode.
+ * progmodes/cc-mode.el (c-initialize-cc-mode): Don't quote a symbol
+ just to then pass it to `symbol-value'.
+ (prog-mode): Provide fallback definition, if needed.
+ * progmodes/cc-langs.el: Always load `cl'. Don't load `cl-lib'.
+ Remove "cl-" prefix accordingly.
+ * progmodes/cc-fonts.el (c-font-lock-invalid-string): Use integerp or
+ characterp depending on the type of characters.
+ (c-font-lock-enum-tail): Remove unused var `start'.
+ * progmodes/cc-engine.el: Load CL at compile-time.
+ (c-declare-lang-variables): Use mapcan.
+ (c-append-to-state-cache): Remove unused var `ce+1'.
+ (c-parse-state-state): Make buffer-local.
+ (c-ssb-lit-begin): Remove unused var `pps-end-pos'.
+ (c-just-after-func-arglist-p): Remove unused var `end'.
+ * progmodes/cc-defs.el: Load cc-fix if delete-dups is undefined.
+ (c-<-as-paren-syntax, c->-as-paren-syntax): Move definition earlier.
+ (c-make-keywords-re): Use delete-dups.
+ (c-get-current-file): Avoid file-name-base.
+ * progmodes/cc-cmds.el (c-electric-lt-gt): Remove unused var
+ `close-paren-inserted'.
+ * progmodes/cc-awk.el (c-forward-sws): Remove unused declaration.
+
+ * progmodes/python.el: Avoid building unneeded markers.
+ (python-font-lock-keywords, python-indent-dedent-line)
+ (python-fill-paren, python-shell-completion-complete-or-indent):
+ Prefer point over point-marker.
+ (inferior-python-mode): Remove redundant completion settings.
+
+2014-10-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-svn.el (vc-svn-ignore-completion-table): Implement.
+ (vc-svn-ignore): Use it. (Bug#18619)
+
+2014-10-03 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (toggle-frame-maximized, toggle-frame-fullscreen):
+ In doc-string mention need to set `frame-resize-pixelwise'.
+
+2014-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-svn.el (vc-svn-after-dir-status): Fix the non-remote regexp,
+ similarly to Rogers's 2010-06-16 change for the remote case
+ (bug#18605).
+
+2014-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ New gui-selection-value consolidating x-selection-value.
+ * select.el (gui-selection-value-alist): New method.
+ (gui-selection-value): New function.
+ (x-selection-value): Make it an obsolete alias.
+ * simple.el (interprogram-paste-function): Default to
+ gui-selection-value.
+ * w32-common-fns.el (w32-get-selection-value): Simplify.
+ (x-selection-value): Remove alias.
+ (interprogram-paste-function): Don't set.
+ (gui-selection-value): Define for w32.
+ * term/x-win.el (gui-selection-value): Define for x.
+ (x--selection-value): Rename from x--selection-value.
+ (interprogram-paste-function): Don't set.
+ * term/pc-win.el (w16-get-selection-value): Simplify.
+ (msdos-initialize-window-system): Don't set
+ interprogram-paste-function.
+ (gui-selection-value): Define for pc.
+ * term/ns-win.el (x-selection-value): Remove.
+ (gui-selection-value): Define for ns, instead.
+ * term/common-win.el (x-setup-function-keys): Don't set
+ interprogram-paste-function.
+ * obsolete/mouse-sel.el (mouse-sel-get-selection-function):
+ Use gui-selection-value.
+
+2014-10-02 David Raynes <rayners@gmail.com> (tiny change)
+
+ * term/ns-win.el: Add functions to ns frame, not x frame (bug#18614).
+
+2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * obsolete/lucid.el (read-number): Remove, redundant.
+ * obsolete/cl-compat.el (cl-floor, cl-ceiling, cl-round, cl-truncate):
+ Remove, broken.
+
+2014-10-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (package-import-keyring):
+ Create gnupg directory private. (Bug#17625#155)
+
+2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-shell-completion-get-completions):
+ Use python-shell--prompt-calculated-input-regexp from the
+ process buffer (bug#18582).
+ Don't assume that `line' comes from the process buffer.
+
+2014-10-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frame.el: Use lexical-binding (bug#18598).
+ (make-frame): Use t rather than nil for tty's window-system.
+ * startup.el (command-line): Use gui-method.
+
+ Consolidate management/ownership of selections.
+ * select.el (gui-get-selection-alist): New method.
+ (gui-get-selection): Use it. Rename from x-get-selection.
+ (x-get-selection): Define as obsolete alias.
+ (x-get-clipboard): Mark obsolete.
+ (gui-get-primary-selection): New function.
+ (x-get-selection-value): Mark obsolete.
+ (gui-own-selection-alist, gui-disown-selection-alist)
+ (gui-selection-owner-p-alist): New methods.
+ (gui-set-selection): Use them. Rename from x-set-selection.
+ (x-set-selection): Define as obsolete alias.
+ (gui--valid-simple-selection-p): Rename from
+ x-valid-simple-selection-p.
+ * w32-common-fns.el (gui-own-selection, gui-disown-selection)
+ (gui-selection-owner-p, gui-get-selection): Define for w32.
+ (w32-get-selection-value): Rename from x-get-selection-value.
+ Use the new gui-last-selected-text.
+ * term/x-win.el (x-get-selection-value): Remove.
+ (x-clipboard-yank): Declare obsolete.
+ (gui-own-selection, gui-disown-selection, gui-get-selection)
+ (gui-selection-owner-p): Define for x.
+ * term/w32-win.el (w32-win-suspend-error): Rename from
+ x-win-suspend-error.
+ * term/pc-win.el (w16-get-selection-value): Rename from
+ x-get-selection-value.
+ (w16-selection-owner-p): Rename from x-selection-owner-p.
+ (gui-own-selection, gui-disown-selection, gui-get-selection)
+ (gui-selection-owner-p): Define for pc.
+ (w16--select-text): New function.
+ * term/ns-win.el (gui-own-selection, gui-disown-selection)
+ (gui-get-selection, gui-selection-owner-p): Define for ns.
+ * term.el (term-mouse-paste):
+ * mouse.el (mouse-yank-primary): Use gui-get-primary-selection.
+
+2014-10-02 H. Dieter Wilhelm <dieter@duenenhof-wilhelm.de>
+
+ * calc/calc-help.el (calc-describe-thing): Quote strings
+ which could look like regexps.
+
+2014-10-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Consolidate x-select-text.
+ * frame.el (gui-method, gui-method-define, gui-method-declare)
+ (gui-call): New macros.
+ (gui-method--name): New function.
+ (frame-creation-function-alist): Use gui-method-declare.
+ (make-frame): Use gui-method.
+ * select.el (gui-select-enable-clipboard): Rename from
+ x-select-enable-clipboard and move here.
+ (x-select-enable-clipboard): Define as obsolete alias.
+ (gui-last-selected-text): New var, to replace x-last-selected-text.
+ (gui-select-text): New GUI method.
+ (gui-select-text): New function.
+ (x-select-text): Define as obsolete alias.
+ * term/common-win.el (x-select-enable-clipboard, x-select-text):
+ Move to select.el.
+ * simple.el (interprogram-cut-function): Change default to
+ x-select-text.
+ (interprogram-paste-function): Change default to `ignore'.
+ * w32-common-fns.el (interprogram-cut-function): Don't modify.
+ * term/x-win.el (interprogram-cut-function): Don't modify.
+ (gui-select-text): Add method for x.
+ * term/w32-win.el (gui-select-text): Add method for w32.
+ * term/pc-win.el (x-last-selected-text): Remove, use
+ gui-last-selected-text instead.
+ (msdos-initialize-window-system): Don't set interprogram-cut-function.
+ (gui-select-text): Add method for pc.
+ * term/ns-win.el (ns-last-selected-text): Remove, use
+ gui-last-selected-text instead.
+ (gui-select-text): Add method for ns.
+ (x-setup-function-keys): Don't change interprogram-cut-function.
+ * loadup.el ("startup"): Load after "frame".
+ * subr.el (package--builtin-versions, package--description-file):
+ Move from startup.el.
+ * startup.el (package--builtin-versions, package--description-file):
+ Move to subr.el.
+ (handle-args-function-alist, window-system-initialization-alist):
+ Use gui-method-declare.
+ (command-line): Use gui-method.
+
+2014-10-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (alist-get): New accessor.
+ * emacs-lisp/gv.el (alist-get): Provide expander.
+ * winner.el (winner-remember):
+ * tempo.el (tempo-use-tag-list):
+ * progmodes/gud.el (minor-mode-map-alist):
+ * international/mule-cmds.el (define-char-code-property):
+ * frameset.el (frameset-filter-params):
+ * files.el (dir-locals-set-class-variables):
+ * register.el (get-register, set-register):
+ * calc/calc-yank.el (calc-set-register): Use it.
+ * ps-print.el (ps-get, ps-put, ps-del): Mark as obsolete.
+ * tooltip.el (tooltip-set-param): Mark as obsolete.
+ (tooltip-show): Use alist-get instead.
+ * ses.el (ses--alist-get): Remove. Use alist-get instead.
+
+2014-10-01 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-backend.el: Remove Time-stamp. Rename variable
+ `newsticker--download-logos' to `newsticker-download-logos' and
+ make it customizable.
+ (newsticker--sentinel-work): Move xml-workarounds to function
+ `newsticker--do-xml-workarounds', call unless libxml-parser is
+ used. Allow single quote in regexp for encoding.
+ Use libxml-parser if available, else fall back to `xml-parse-region'.
+ Take care of possibly missing namespace prefixes (like "RDF"
+ instead of "rdf:RDF") when checking xml nodes and attributes (as
+ libxml correctly removes the prefixes). Always use Atom 1.0 as
+ fallback feed type. Rename `newsticker--download-logos' to
+ `newsticker-download-logos'
+ (newsticker--unxml, newsticker--unxml-node)
+ (newsticker--unxml-attribute): New.
+ (newsticker--parse-atom-1.0): Call `unxml' in case that embedded
+ HTML code has become part of the xml parse tree.
+ (newsticker--parse-rss-1.0, newsticker--parse-rss-2.0): Take care
+ of possibly missing namespace prefixes.
+ (newsticker--parse-generic-items): Code formatting. Typo.
+ (newsticker--images-dir): Add trailing slash.
+ (newsticker--image-get): Fix error message.
+
+ * net/newst-plainview.el: Remove Time-stamp.
+
+ * net/newst-reader.el: Remove Time-stamp.
+ (newsticker-download-logos): Rename variable
+ `newsticker--download-logos' to `newsticker-download-logos' and
+ make it customizable.
+ (newsticker--print-extra-elements): Add optional parameter
+ 'htmlish for using html markup. Amend list of ignored elements.
+ (newsticker--do-print-extra-element): Add parameter 'htmlish for
+ using html markup.
+
+ * net/newst-ticker.el: Remove Time-stamp.
+
+ * net/newst-treeview.el (newsticker--treeview-item-show): Use html
+ for formatting extra elements.
+
+ * net/newsticker.el: Remove Time-stamp, Version.
+ (newsticker-version): Make obsolete.
+
+2014-09-30 Leonardo Nobrega <leonobr@gmail.com> (tiny change)
+
+ * progmodes/python.el (python-fill-paren): Don't inf-loop at EOB
+ (bug#18462).
+
+2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-check-signature): Default to nil if
+ GPG is not available.
+ (package-refresh-contents): Don't mess with the keyring if we won't
+ check the signatures anyway.
+
+2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ses.el (ses--row, ses--col): New dyn-scoped vars, to replace row&col.
+ (ses-center, ses-center-span): Use them.
+ (ses-print-cell): Bind them while calling the printer.
+ (row, col, maxrow, maxcol): Don't declare as dynamically scoped.
+ (ses-dorange): Revert last change.
+ (ses-calculate-cell): Don't bind row&col dynamically while evaluating
+ the formula.
+ (ses-set-cell): Avoid `eval'.
+ (ses--time-check): Rename it from ses-time-check and turn it into
+ a macro.
+
+ * ses.el (ses-setup): Don't assume modifying the iteration var of
+ dotimes affects the iteration (bug#18191).
+
+2014-09-30 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-calculate-cell): Bind row and col dynamically to
+ their values with 'cl-progv'.
+ (ses-dorange): Bind row, col, maxrow and maxcol dynamically to
+ their values with 'cl-progv', also use non-interned symbols for
+ row, minrow, maxrow, mincol and maxcol.
+ (maxrow maxcol): New defvar, to make the compiler happy.
+
+2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-at-point): Emit warning for ill-behaved
+ completion functions.
+
+2014-09-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ses.el (ses--letref): Quote value before it gets re-evaluated.
+
+2014-09-28 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Font-lock `cl-flet*', too.
+ * emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2):
+ Add "flet*" to intermediate var `cl-lib-kw'.
+
+2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * epg-config.el (epg-gpg-program): Use the plain program names rather
+ than their absolute file name.
+
+ * subr.el (track-mouse): New macro.
+ * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form):
+ Remove track-mouse case.
+ * emacs-lisp/bytecomp.el (byte-compile-track-mouse): Remove.
+
+2014-09-27 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/elisp-mode.el (elisp--eldoc-last-data): Use defvar.
+
+ * emacs-lisp/eldoc.el (eldoc-mode): Fix thinko.
+
+2014-09-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--split-match, pcase--app-subst-match):
+ Handle the case where `match' is :pcase--succeed or :pcase--fail
+ (bug#18554).
+
+ Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el.
+ * emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode.
+ (eldoc-schedule-timer): Obey it.
+ (eldoc-documentation-function): Default to nil.
+ (eldoc-mode): Don't enable if eldoc-documentation-function is not set.
+ (eldoc-documentation-function-default, eldoc-get-fnsym-args-string)
+ (eldoc-highlight-function-argument, eldoc-get-var-docstring)
+ (eldoc-last-data-store, eldoc-docstring-first-line)
+ (eldoc-docstring-format-sym-doc, eldoc-fnsym-in-current-sexp)
+ (eldoc-beginning-of-sexp, eldoc-current-symbol)
+ (eldoc-function-argstring): Move to elisp-mode.el.
+ (eldoc-symbol-function): Remove, unused.
+ * progmodes/elisp-mode.el: New file. Rename all "eldoc-*" to "elisp--*".
+ (elisp-completion-at-point): Rename from lisp-completion-at-point.
+ (elisp--preceding-sexp): Rename from preceding-sexp.
+ * loadup.el: Load new file progmodes/elisp-mode.
+ * ielm.el (inferior-emacs-lisp-mode): Set eldoc-documentation-function.
+ * emacs-lisp/lisp.el (lisp--local-variables-1, lisp--local-variables)
+ (lisp--local-variables-completion-table, lisp--expect-function-p)
+ (lisp--form-quoted-p, lisp--company-doc-buffer)
+ (lisp--company-doc-string, lisp--company-location)
+ (lisp-completion-at-point): Move to elisp-mode.el.
+ * emacs-lisp/lisp-mode.el (lisp--mode-syntax-table): New syntax-table,
+ extracted from emacs-lisp-mode-syntax-table.
+ (emacs-lisp-mode-abbrev-table, emacs-lisp-mode-syntax-table): Move to
+ elisp-mode.el.
+ (lisp-imenu-generic-expression): Add comments to document what comes
+ from which Lisp dialect.
+ (emacs-lisp-mode-map, emacs-lisp-byte-compile)
+ (emacs-lisp-byte-compile-and-load, emacs-lisp-mode-hook)
+ (emacs-lisp-mode, emacs-list-byte-code-comment-re)
+ (emacs-lisp-byte-code-comment)
+ (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode)
+ (lisp-interaction-mode-map, lisp-interaction-mode)
+ (eval-print-last-sexp, last-sexp-setup-props)
+ (last-sexp-toggle-display, prin1-char, preceding-sexp)
+ (eval-last-sexp-1, eval-last-sexp-print-value)
+ (eval-last-sexp-fake-value, eval-sexp-add-defvars, eval-last-sexp)
+ (eval-defun-1, eval-defun-2, eval-defun): Move to elisp-mode.el.
+
+2014-09-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * progmodes/grep.el (grep-regexp-alist): Use more-accurate regexp.
+ Do not match file names that end in '/', as they cannot be 'grep'
+ hits nowadays. This prevents confusion when 'grep -r' reports a
+ match in a file whose basename is ':12345:'. Conversely, do not
+ require exactly the same sequence of spaces and tabs after both
+ colons, and allow spaces or tabs before the second colon, as per
+ the POSIX spec for 'grep' output.
+
+2014-09-26 Leo Liu <sdl.web@gmail.com>
+
+ Add cl-parse-integer based on parse-integer (Bug#18557)
+ * calendar/parse-time.el (parse-time-digits): Remove.
+ (digit-char-p, parse-integer) Moved to cl-lib.el.
+ (parse-time-tokenize, parse-time-rules, parse-time-string):
+ Use cl-parse-integer.
+
+ * emacs-lisp/cl-extra.el (cl-parse-integer): New function.
+
+ * emacs-lisp/cl-lib.el (cl-digit-char-table): New var.
+ (cl-digit-char-p): New function.
+
+2014-09-25 Juri Linkov <juri@jurta.org>
+
+ * vc/add-log.el (change-log-next-buffer): Don't create an empty
+ buffer "ChangeLog" when the current buffer doesn't match ChangeLog.[0-9].
+ Return the current buffer if no files match the default pattern
+ ChangeLog.[0-9]. Signal "end of multi" when file is nil. (Bug#18547)
+
+2014-09-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Don't modify
+ the global vc-handled-backends (bug#18535).
+
+2014-09-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * find-cmd.el (find-cmd): Use grep's `find-program' (bug#18518).
+ Suggested by <lompik@voila.fr>.
+
+2014-09-24 Ulf Jasper <ulf.jasper@web.de>
+
+ * net/newst-treeview.el (newsticker--treeview-do-get-node-by-id):
+ Rename from `newsticker--treeview-do-get-node'.
+ (newsticker--treeview-get-node-by-id):
+ Rename from `newsticker--treeview-get-node'.
+ (newsticker--treeview-buffer-init)
+ (newsticker--treeview-buffer-init): Disable buffer undo.
+ (newsticker--treeview-unfold-node): Adapt to modified
+ `newsticker--group-find-parent-group'.
+ (newsticker--group-do-find-group):
+ Rename from `newsticker--group-do-find-group-for-feed'.
+ Now works for both, groups and feeds.
+ (newsticker--group-find-parent-group):
+ Rename from `newsticker--group-find-group-for-feed'.
+ Now works for both, groups and feeds.
+ (newsticker--group-do-get-parent-group)
+ (newsticker--group-get-parent-group): Remove.
+ (newsticker-group-add-group): Change interactive prompts.
+ (newsticker-group-add-group): Finally jump to added group.
+ (newsticker-group-delete-group): Finally jump to current feed.
+ (newsticker--group-do-rename-group, newsticker-group-rename-group)
+ (newsticker--get-group-names, newsticker--group-names): New.
+ (newsticker-group-move-feed): Finally jump to moved feed.
+ (newsticker-group-shift-feed-down, newsticker-group-shift-feed-up)
+ (newsticker-group-shift-group-down)
+ (newsticker-group-shift-group-up, newsticker--group-shift): New.
+ (newsticker-treeview-mode-map): New keybindings for new shift commands.
+
+ * net/newst-backend.el (newsticker--item-list)
+ (newsticker--item-position, newsticker--prev-message)
+ (newsticker--scrollable-text): Move to newst-ticker.el.
+
+ * net/newst-ticker.el (newsticker--item-list)
+ (newsticker--item-position, newsticker--prev-message)
+ (newsticker--scrollable-text): Move from newst-backend.el.
+
+2014-09-22 Kan-Ru Chen <kanru@kanru.info>
+
+ * window.el (fit-window-to-buffer): When counting buffer width,
+ count the whole visible buffer. Correctly convert the body-height
+ to pixel size for window-text-pixel-size (Bug#18498).
+
+2014-09-22 Sam Steingold <sds@gnu.org>
+
+ * progmodes/sql.el (sql-product-alist): Improve the Vertica entry.
+ (sql-execute): Use `special-mode'.
+
+2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add pcase-defmacro, as well as `quote' and `app' patterns.
+ * loadup.el: Increase max-lisp-eval-depth when macroexpanding macroexp.
+ * emacs-lisp/pcase.el: Allow (F . ARGS) in `app' patterns.
+ (pcase--funcall, pcase--eval): New functions.
+ (pcase--u1): Use them for guard, pred, let, and app.
+ (\`): Use the new feature to generate better code for vector patterns.
+ * emacs-lisp/pcase.el: Use pcase-defmacro to handle backquote.
+ (pcase--upat): Remove.
+ (pcase--macroexpand): Don't hardcode handling of `.
+ (pcase--split-consp, pcase--split-vector): Remove.
+ (pcase--split-equal): Disregard ` since it's expanded away.
+ (pcase--split-member): Optimize for quote rather than for `.
+ (pcase--split-pred): Optimize for quote rather than for `.
+ (pcase--u1): Remove handling of ` (and of `or' and `and').
+ Quote non-selfquoting values when passing them to `eq'.
+ Drop `app's let-binding if the variable is not used.
+ (pcase--q1): Remove.
+ (`): Define as a pattern macro.
+ * emacs-lisp/pcase.el (pcase--match): New smart-constructor function.
+ (pcase--expand pcase--q1, pcase--app-subst-match): Use it.
+ (pcase--macroexpand): Handle self-quoting patterns here, expand them to
+ quote patterns.
+ (pcase--split-match): Don't hoist or/and here any more.
+ (pcase--split-equal): Optimize quote patterns as well as ` patterns.
+ (pcase--flip): New helper macro.
+ (pcase--u1): Optimize the memq case directly.
+ Don't handle neither self-quoting nor and/or patterns any more.
+ * emacs-lisp/pcase.el (pcase-defmacro): New macro.
+ (pcase--macroexpand): New function.
+ (pcase--expand): Use it.
+ * emacs-lisp/pcase.el (pcase--app-subst-match, pcase--app-subst-rest):
+ New optimization functions.
+ (pcase--u1): Add support for `quote' and `app'.
+ (pcase): Document them in the docstring.
+
+2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use lexical-bindin in Ibuffer.
+ * ibuffer.el (ibuffer-do-toggle-read-only): `arg' is unused.
+ (ibuffer-compile-format): Simplify.
+ (ibuffer-clear-summary-columns): Simplify.
+ * ibuf-ext.el (ibuffer-generate-filter-groups): Don't use the third
+ elem of dotimes when we don't refer to the iteration var from it.
+ (ibuffer-toggle-sorting-mode): Avoid add-to-list.
+ * ibuf-macs.el (define-ibuffer-column, define-ibuffer-op):
+ Silence byte-compiler.
+
+2014-09-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * font-lock.el (font-lock-compile-keyword): Don't confuse a lambda
+ expression for a list.
+
+ * emacs-lisp/bytecomp.el (byte-compile-lambda): Don't add fundoc usage
+ for functions with no arguments.
+
+ * mpc.el (mpc-data-directory): Use locate-user-emacs-file.
+ (mpc-volume-refresh): Make sure the corresponding header-line is updated.
+
+2014-09-17 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * simple.el (clone-indirect-buffer): Mention the return value
+ (bug#18478).
+
+ * progmodes/prog-mode.el (prog-mode-hook): Replace reference to
+ Text mode in docstring (bug#18464).
+
+2014-09-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-syntax-propertize-function):
+ Accept underscores in identifiers after "sub" (bug#18502).
+
+2014-09-21 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-sel.el (reftex-select-label-mode)
+ (reftex-select-bib-mode, reftex-insert-docstruct): Derive modes
+ from special-mode (instead of fundamental-mode) and propertize
+ with font-lock-face instead of just face. (Bug#18496)
+
+ * textmodes/reftex-toc.el (reftex-toc-mode, reftex-toc): Ditto.
+
+2014-09-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point): Only calculate
+ `table-etc' when `end' is non-nil.
+ (lisp-completion-at-point): Move `end' back if it's after quote.
+ If in comment or string, only complete when after backquote.
+ (Bug#18265)
+ (lisp-completion-at-point): Don't use
+ `lisp--local-variables-completion-table' in the
+ `lisp--form-quoted-p' case.
+
+2014-09-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp.el (lisp--expect-function-p)
+ (lisp--form-quoted-p): New functions.
+ (lisp-completion-at-point): Use them to see if we're completing a
+ variable reference, a function name, or just any symbol.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html
+
+2014-09-18 Ivan Kanis <ivan@kanis.fr>
+
+ * net/shr.el, net/eww.el: Don't override `shr-width', but
+ introduce a new variable `shr-internal-width'. This allows users
+ to specify a width themselves.
+
+2014-09-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * image-mode.el (image-toggle-display-image): If we have a
+ `fit-width' or a `fit-height', don't limit the size of the image
+ to the window size, because that doesn't preserve the aspect ratio.
+ * image-mode.el: Move defvars earlier to avoid a byte-compilation
+ warning.
+
+2014-09-17 Reuben Thomas <rrt@sc3d.org>
+
+ * progmodes/js.el: Add interpreter-mode-alist support for various
+ JavaScript interpreters.
+
+2014-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't assume 'grep' supports GREP_OPTIONS.
+ The GREP_OPTIONS environment variable is planned to be marked
+ obsolescent in GNU grep, due to problems in its use, so stop
+ relying on it.
+ * progmodes/grep.el (grep-highlight-matches): Document this.
+ (grep-process-setup): Do not set GREP_OPTIONS.
+ (grep-compute-defaults): Use an explicit --color option if supported.
+
+2014-09-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * msb.el (msb--make-keymap-menu, msb-menu-bar-update-buffers):
+ Don't add outdated key-shortcut cache (bug#18482).
+
+2014-09-15 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-multi-frame-p): Fix thinko - do not force
+ a delay if none was specified. (Bug#18334)
+
+2014-09-15 Kan-Ru Chen <kanru@kanru.info>
+
+ * window.el (fit-window-to-buffer): Doc fix.
+
+2014-09-15 Ivan Shmakov <ivan@siamics.net>
+
+ * desktop.el (desktop-create-buffer): Check that buffers are still live
+ before burying them (bug#18373).
+
+2014-09-15 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-list-entries):
+ Restore 24.3 display behavior. (Bug#18381)
+
+2014-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ * mouse.el (mouse-drag-line): On text-mode frames, count the mode
+ line and header line as 1 pixel. This fixes the 1-"pixel" (row)
+ discrepancy between window-pixel-edges and mouse events, and
+ avoids moving mode line up when the mouse click is on the modeline
+ and no drag is attempted.
+
+2014-09-14 Daniel Colascione <dancol@dancol.org>
+
+ * register.el (insert-register): Change default interactive
+ insertion mode.
+
+2014-09-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-file-function): Simplify check.
+ Suppress debug messages.
+
+ * net/tramp.el (tramp-file-name-handler):
+ * net/tramp-gvfs.el (tramp-gvfs-url-file-name): Apply `cons' where
+ appropriate.
+
+2014-09-13 Christopher Schmidt <ch@ristopher.com>
+
+ * calendar/calendar.el (calendar-update-mode-line):
+ Do not overwrite mode-line-format if calendar-mode-line-format is
+ nil. (Bug#18467)
+
+2014-09-13 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/pcase.el (pcase--dontwarn-upats): New var.
+ (pcase--expand): Use it.
+ (pcase-exhaustive): New macro. (Bug#16567)
+
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
+ Add pcase-exhaustive.
+
+2014-09-13 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmailmm.el (rmail-mime-insert-html): Decode the HTML part
+ using the specified transfer-encoding, if any, or 'undecided'.
+ (rmail-mime-render-html-shr): Bind shr-width to nil, so lines are
+ broken at the window margin.
+
+2013-12-27 Ken Olum <kdo@cosmos.phy.tufts.edu>
+
+ Support rendering of HTML parts in Rmail (bug#4258).
+ * mail/rmailmm.el (rmail-mime-process): Handle text/html
+ separately from other text/ types. Suppress tagline for
+ multipart body.
+ (rmail-mime-parse): Don't change visibility of tagline here.
+ (rmail-mime-set-bulk-data, rmail-mime-insert-bulk):
+ Handle text/html specially.
+ (rmail-mime-render-html-function,rmail-mime-prefer-html): New variables.
+ (rmail-mime-insert-html, rmail-mime-render-html-shr)
+ (rmail-mime-render-html-lynx): New functions.
+ (rmail-mime-fix-inserted-faces): New function.
+ (rmail-mime-process-multipart): Find the best part to show
+ following rmail-mime-prefer-html if set.
+ (rmail-mime-searching): New variable.
+ (rmail-search-mime-message): Bind rmail-mime-searching to
+ suppress rendering while searching.
+
+2014-09-12 Sam Steingold <sds@gnu.org>
+
+ * progmodes/sql.el (sql-product-alist): Add vertica.
+ (sql-vertica-program, sql-vertica-options)
+ (sql-vertica-login-params, sql-comint-vertica, sql-vertica):
+ New functions and variables to support Vertica.
+ Inspired by code by Roman Scherer <roman@burningswell.com>.
+
+2014-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * ses.el (ses-file-format-extend-parameter-list): Rename from
+ ses-file-format-extend-paramter-list, to correct a misspelling.
+ All uses changed.
+
+2014-09-10 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: revert recent changes and fix bug 17463 (cc-langs.elc
+ gets loaded at run-time).
+ * progmodes/cc-langs.el (c-no-parens-syntax-table): Rename the
+ c-lang-const to c-make-no-parens-syntax-table and correct the
+ logic.
+ (c-no-parens-syntax-table): Correct the logic of the
+ c-lang-defvar.
+
+2014-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ CC-mode: Set open-paren-in-column-0-is-defun-start to nil;
+ plus misc cleanup.
+ * progmodes/cc-mode.el (c-basic-common-init):
+ Set open-paren-in-column-0-is-defun-start.
+ (adaptive-fill-first-line-regexp, font-lock-syntactic-keywords):
+ Remove declarations, unused.
+ (run-mode-hooks): Remove declaration.
+ (font-lock-defaults): Use plain `defvar' to declare.
+ (c-run-mode-hooks): Test existence of run-mode-hooks with fboundp.
+ * progmodes/cc-langs.el (c-filter-ops): Avoid `setq'.
+ (c-make-mode-syntax-table): Don't micro-optimize.
+ (c-keywords, c-keyword-member-alist): Simplify.
+ (c-kwds-lang-consts): Don't eval at compile-time.
+ (c-primary-expr-regexp): Comment out unused vars.
+ * progmodes/cc-fonts.el (c-font-lock-context): Declare at top-level.
+ (c-font-byte-compile): New var.
+ (c--compile): New function. Use it instead of `byte-compile'.
+ (c-cpp-matchers): Quote the value returned by
+ `c-make-syntactic-matcher' in case it's not self-evaluating.
+ (c-basic-matchers-before): Avoid a plain MATCHER as keyword, wrap it in
+ parentheses instead (in case MATCHER happens to be a list).
+ (c-font-lock-enum-tail): Remove unused var `start'.
+ (c-font-lock-objc-methods): Silence byte-compiler warnings.
+ * progmodes/cc-engine.el (c-syntactic-re-search-forward): Sink an `if'
+ test into an argument.
+ * progmodes/cc-defs.el (c-point, c-major-mode-is, c-put-char-property)
+ (c-get-char-property): Don't use `eval' just to unquote a constant.
+ (c-use-extents): Remove. Use (featurep 'xemacs), compiled
+ more efficiently.
+ (c-put-char-property-fun): Don't call `byte-compile' by hand.
+ (c-clear-char-property, c-clear-char-properties): Check that `property'
+ is a quoted constant.
+ (c-emacs-features): Remove `infodock', `syntax-properties', and
+ `pps-extended-state' (never used), `8-bit' and `1-bit' (use (featurep
+ 'xemacs) instead). Use `with-temp-buffer' and let-bind vars after
+ changing buffer, so we don't have to setq them again afterwards.
+ (c-lang-const): Remove redundant symbolp assertions.
+ (c-find-assignment-for-mode): Use `or'.
+ * Makefile.in (compile-one-process): Remove cc-mode dependency.
+
+2014-09-09 Sam Steingold <sds@gnu.org>
+
+ * progmodes/sql.el (sql-default-directory): Fix type annotation.
+
+2014-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-awk.el: Remove unneeded cc-bytecomp use.
+ Change doc comments into docstrings.
+ * Makefile.in: Remove cc-awk dependency.
+
+2014-09-08 Sam Steingold <sds@gnu.org>
+
+ * progmodes/sql.el (sql-send-line-and-next): New command,
+ bound to C-c C-n.
+ (sql-show-sqli-buffer): Display the buffer instead of its name and
+ bind the command to C-c C-z.
+ (sql-default-directory): New user option.
+ (sql-product-interactive): Bind `default-directory' to it to
+ enable remote connections using Tramp.
+ (sql-set-sqli-buffer): Call `sql-product-interactive' when no
+ suitable buffer is available.
+
+2014-09-08 Glenn Morris <rgm@gnu.org>
+
+ * calendar/calendar.el (calendar-basic-setup):
+ Fix calendar-view-holidays-initially-flag and fancy display.
+ * calendar/diary-lib.el (diary-live-p): Doc fix.
+
+ * calendar/calendar.el (calendar-basic-setup):
+ Avoid clobbering calendar with diary. (Bug#18381)
+
+2014-09-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-dir.el (vc-dir-update): Don't burp in corner case.
+
+2014-09-08 Lars Ljung <lars@matholka.se> (tiny change)
+
+ * isearch.el (isearch-yank-word-or-char): Obey superword-mode
+ as well (bug#18400).
+
+2014-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (posn-actual-col-row): Doc fix. (Bug#18385)
+
+2014-09-06 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/pcase.el (pcase): Doc fix.
+ (pcase--split-vector): New function.
+ (pcase--q1): Support vector qpattern. (Bug#18327)
+
+2014-09-05 Sam Steingold <sds@gnu.org>
+
+ * textmodes/tex-mode.el (tex-print-file-extension): New user
+ option.
+ (tex-print): Use it instead of the hard-coded string.
+
+2014-09-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Expand `default-directory'.
+
+2014-09-05 Martin Rudalics <rudalics@gmx.at>
+
+ * scroll-bar.el (horizontal-scroll-bars-available-p):
+ New function.
+ (horizontal-scroll-bar-mode): Rewrite using
+ horizontal-scroll-bars-available-p.
+ * menu-bar.el (menu-bar-showhide-scroll-bar-menu): Rewrite using
+ horizontal-scroll-bars-available-p.
+
+2014-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (call-process-shell-command, process-file-shell-command):
+ Make the `args' obsolete (bug#18409).
+ (start-process-shell-command, start-file-process-shell-command):
+ Use `declare'.
+
+2014-09-05 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-forms.el (math-normalize-hms): Do a better check for
+ "negative" hms forms.
+
+2014-09-04 Rasmus Pank Roulund <emacs@pank.eu>
+
+ * vc/vc-git.el (vc-git-conflicted-files): Fix bug when git status
+ returns nil (bug#18391).
+
+2014-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el (eldoc-function-argstring): Don't strip
+ terminating paren (bug#18352).
+ (eldoc-last-data-store): Return cached data.
+ (eldoc-get-var-docstring): Avoid setq.
+ (eldoc-get-fnsym-args-string): Clarify data flow.
+
+2014-09-04 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/eldoc.el (eldoc-highlight-function-argument): Handle the
+ case where we're currently providing part of the &rest arg after some
+ &key args, as in define-ibuffer-op (bug#18048).
+
+2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/which-func.el (which-func-ff-hook): Obey pre-existing
+ buffer-local setting of which-func-mode.
+ (which-func-mode): Use defvar-local.
+ (which-function-mode): Don't reset which-func-mode in each buffer since
+ it might have been set by someone else.
+ (which-func-update-ediff-windows): Check which-function-mode.
+
+2014-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (frame-initialize): Remove horizontal-scroll-bars
+ from frame-initial-frame-alist.
+ * scroll-bar.el (previous-horizontal-scroll-bar-mode)
+ (horizontal-scroll-bar-mode-explicit)
+ (set-horizontal-scroll-bar-mode, get-horizontal-scroll-bar-mode)
+ (toggle-horizontal-scroll-bar): Remove.
+ (horizontal-scroll-bar-mode): Remove defcustom.
+ (horizontal-scroll-bar-mode): Fix doc-string.
+ (scroll-bar-toolkit-scroll)
+ (scroll-bar-toolkit-horizontal-scroll): Add doc-strings stubs.
+
+2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-generate-description-file):
+ Properly quote the arguments (bug#18332). Change second arg.
+ (package--alist-to-plist-args): Rename from package--alist-to-plist and
+ quote the elements.
+ (package--make-autoloads-and-stuff): Fix the test for pre-existence of
+ the *-pkg.el file. Adjust to new calling convention of
+ package-generate-description-file.
+
+ * progmodes/gud.el (gud-gdb-completion-at-point): Add hack (bug#18282).
+ (gud-gdb-completions): Remove obsolete workaround.
+
+2014-09-03 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (posn-col-row): Revert the change from commit
+ 2010-11-13T21:07:58Z!eliz@gnu.org, which
+ was inadvertently merged from emacs-23 release branch in 2010-11-18T03:54:14Z!monnier@iro.umontreal.ca
+ monnier@iro.umontreal.ca-20101118035414-yvlg7k7dk4k4l3q, and
+ introduced an off-by-one error in the reported row when there is a
+ header line. (Bug#18384)
+
+2014-09-03 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-post-self-insert-function):
+ Avoid electric colon at beginning-of-defun. (Bug#18228)
+
+2014-09-03 Glenn Morris <rgm@gnu.org>
+
+ * tutorial.el (tutorial--display-changes):
+ Fix 2014-08-01 change. (Bug#18382)
+
+2014-09-03 Ken Brown <kbrown@cornell.edu>
+
+ * startup.el (fancy-splash-frame): Extend the fix for Bug#16014 to
+ the Cygwin-w32 build. (Bug#18347)
+
+2014-09-03 Glenn Morris <rgm@gnu.org>
+
+ * tar-mode.el (tar--extract, tar-extract):
+ Avoid permanently disabling undo in extracted buffers. (Bug#18344)
+
+2014-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-font-lock-quoted-subshell): Try to better
+ handle multiline elements (bug#18380).
+
+2014-09-01 Eli Zaretskii <eliz@gnu.org>
+
+ * ls-lisp.el (ls-lisp-use-string-collate)
+ (ls-lisp-UCA-like-collation): New defcustoms.
+ (ls-lisp-string-lessp): Use them to control sorting by file
+ names. (Bug#18051)
+ (ls-lisp-version-lessp): New function.
+ (ls-lisp-handle-switches): Use it to implement the -v switch of
+ GNU ls.
+ (ls-lisp--insert-directory): Mention the -v switch in the doc string.
+
+2014-08-31 Christoph Scholtes <cschol2112@gmail.com>
+
+ * ibuffer.el: Replace mode-specific quit function with
+ `quit-window' via `special-mode'.
+ (ibuffer-mode-map): Use keybindings from special-mode-map instead
+ of local overrides.
+ (ibuffer): Don't store previous windows configuration.
+ Let `quit-window' handle restoring.
+ (ibuffer-quit): Remove function. Use `quit-window' instead.
+ (ibuffer-restore-window-config-on-quit): Remove variable.
+ (ibuffer-prev-window-config): Remove variable.
+
+2014-08-29 Michael Heerdegen <michael_heerdegen@web.de>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Use mode function
+ name instead of variable name in hook docstring. (Bug#18349)
+
+2014-08-29 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-at-bottom): Prefer bottom-left
+ window to other bottom windows. Reuse a bottom window if it
+ shows the buffer already. Suggested by Juri Linkov
+ <juri@jurta.org> in discussion of (Bug#18181).
+
+2014-08-29 Leo Liu <sdl.web@gmail.com>
+
+ * files.el (minibuffer-with-setup-hook): Allow (:append FUN) to
+ append to minibuffer-setup-hook. (Bug#18341)
+
+2014-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-defs.el: Expose c-lanf-defconst's expressions to the
+ byte-compiler.
+ (lookup-syntax-properties): Silence byte-compiler.
+ (c-lang-defconst): Quote the code with `lambda' rather than with
+ `quote'.
+ (c-lang-const): Avoid unneeded setq.
+ (c-lang-constants-under-evaluation): Add docstring.
+ (c-lang--novalue): New constant.
+ (c-find-assignment-for-mode): Use it instead of c-lang-constants.
+ (c-get-lang-constant): Same here.
+ Get the mode's value using `funcall' now that the code is quoted
+ with `lambda'.
+
+2014-08-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-shell-command): Use `display-buffer'.
+ (Bug#18326)
+
+2014-08-28 Martin Rudalics <rudalics@gmx.at>
+
+ * scroll-bar.el (scroll-bar-horizontal-drag-1): Handle new
+ interpretation of `portion-whole'.
+
+2014-08-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el: Spell author name correctly.
+
+2014-08-28 João Távora <joaotavora@gmail.com>
+
+ * net/shr.el (shr-expand-url): Plain expand-file-name is not enough;
+ use url-expand-file-name. (Bug#18310)
+
+2014-08-28 Glenn Morris <rgm@gnu.org>
+
+ * emulation/cua-rect.el (cua--highlight-rectangle):
+ Avoid error at point-min. (Bug#18309)
+
+2014-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-shell-prompt-detect): Remove redundant
+ executable-find (bug#18244).
+
+ * simple.el (self-insert-uses-region-functions): Defvar.
+
+2014-08-28 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (remq): Revert 2014-08-25 doc change (not always true).
+
+2014-08-27 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * startup.el (normal-top-level): Now use internal--top-level-message.
+
+2014-08-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * startup.el (normal-top-level): Use top-level-message.
+
+2014-08-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-copy-url): Encode copied URL to avoid getting
+ URLs containing spaces and the like.
+
+2014-08-25 Christoph Scholtes <cschol2112@gmail.com>
+
+ * subr.el (remq): Fix docstring (Bug#18253).
+
+2014-08-25 Christoph Scholtes <cschol2112@gmail.com>
+
+ * replace.el (query-replace): Fix typo in docstring (Bug#18320).
+
+2014-08-24 Alan Mackenzie <acm@muc.de>
+
+ Handle C++11's "auto" and "decltype" constructions.
+ * progmodes/cc-engine.el (c-forward-type): Enhance to recognise
+ and return 'decltype.
+ (c-forward-decl-or-cast-1): New let variables backup-kwd-sym,
+ prev-kwd-sym, new-style-auto. Enhance to handle the new "auto"
+ keyword.
+ * progmodes/cc-fonts.el (c-font-lock-declarations): Handle the
+ "decltype" keyword.
+ (c-font-lock-c++-new): Handle "decltype" constructions.
+ * progmodes/cc-langs.el (c-auto-ops, c-auto-ops-re):
+ New c-lang-defconsts/defvars.
+ (c-haskell-op, c-haskell-op-re): New c-lang-defconsts/defvars.
+ (c-typeof-kwds, c-typeof-key): New c-lang-defconsts/defvars.
+ (c-typeless-decl-kwds): Append "auto" onto the C++ value.
+ (c-not-decl-init-keywords): Also exclude c-typeof-kwds from value.
+
+ Make ">>" act as double template ender in C++ Mode. (Bug#11386)
+ * progmodes/cc-langs.el (c->-op-cont-tokens): New lang-const split
+ off from c->-op-cont-re.
+ (c->-op-cont-tokens): Change to use the above.
+ (c->-op-without->-cont-regexp): New lang-const.
+ * progmodes/cc-engine.el (c-forward-<>-arglist-recur):
+ Use c->-op-without->-cont-regexp in place of c->-op-cont-tokens.
+
+
+2014-08-23 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-fonts.el (c-font-lock-declarators): Fix infinite
+ loop, bug #18306. The bug was introduced on 2014-08-02.
+
+2014-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/texnfo-upd.el (texinfo-specific-section-type):
+ Don't recognize a Top node if there are other sectioning commands
+ earlier in the Texinfo file. This fixes a bug in
+ texinfo-make-menu and avoids inflooping in
+ texinfo-all-menus-update when they are invoked on texinfo.texi.
+
+2014-08-21 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--side-window-p): New function.
+ (split-window, window-splittable-p): Use window--side-window-p to
+ determine whether WINDOW can be split (Bug#18304).
+ * calendar/calendar.el (calendar-basic-setup): Fix one call of
+ `window-splittable-p' and add another (Bug#18304).
+
+2014-08-20 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-new-pythonpath): Extract from
+ `python-shell-calculate-process-environment'.
+
+2014-08-18 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * emacs-lisp/eldoc.el (eldoc-highlight-function-argument): Add support
+ for &key args (bug#18048).
+
+2014-08-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el (eldoc-argument-case): Obsolete and change default.
+ (eldoc-function-argstring-format): Remove.
+ (eldoc-function-argstring): Always return upcase args.
+ Use help-make-usage. Don't add parens.
+ (eldoc-get-fnsym-args-string): Don't obey eldoc-argument-case since
+ it's too late to do it right (bug#18048).
+
+2014-08-18 Eli Zaretskii <eliz@gnu.org>
+
+ * scroll-bar.el (scroll-bar-horizontal-drag-1)
+ (scroll-bar-toolkit-horizontal-scroll): When determining the
+ paragraph direction, use the buffer of the window designated in
+ the event.
+
+2014-08-16 Andreas Schwab <schwab@linux-m68k.org>
+
+ * vc/diff-mode.el (diff-fixup-modifs): Handle empty line in
+ context of unified diff.
+
+2014-08-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add dependencies to fix loaddefs race during parallel builds.
+ Without this, for example, 'make -j bootstrap' can fail and report
+ "Opening input file: no such file or directory,
+ .../lisp/calendar/diary-loaddefs.el ... recipe for target
+ 'calendar/hol-loaddefs.el' failed", where the hol-loaddefs.el rule
+ got confused because diary-loaddefs.el was being built in parallel.
+ * Makefile.in ($(CAL_DIR)/diary-loaddefs.el):
+ Depend on $(CAL_DIR)/cal-loaddefs.el.
+ ($(CAL_DIR)/hol-loaddefs.el): Depend on $(CAL_DIR)/diary-loaddefs.el.
+
+2014-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ * scroll-bar.el (scroll-bar-horizontal-drag-1): Use cdr of
+ portion-whole for scrolling right-to-left text.
+
+2014-08-15 Leo Liu <sdl.web@gmail.com>
+
+ * speedbar.el (speedbar-generic-list-tag-p): Allow special
+ elements from imenu.
+
+2014-08-15 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (with-output-to-temp-buffer): Doc fix; from elisp manual.
+
+2014-08-13 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Add Guile regexpses.
+
+2014-08-13 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * progmodes/gud.el (guiler): New function. Starts the Guile REPL;
+ add Guile debugger support for GUD.
+
+2014-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * obsolete/mouse-sel.el (mouse-sel-mode): Use add/remove-function.
+ (mouse-sel--ignore): New function.
+ (mouse-sel-has-been-enabled, mouse-sel-original-bindings)
+ (mouse-sel-original-interprogram-cut-function)
+ (mouse-sel-original-interprogram-paste-function): Remove.
+
+2014-08-13 Eric S. Raymond <esr@thyrsus.com>
+
+ * vc/vc-git.el (vc-git-resolve-when-done): New function.
+ Call "git add" when there are no longer conflict markers.
+
+2014-08-13 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * vc/vc-git.el (vc-git-find-file-hook): New function.
+ Adds support for calling smerge (and resolve) on a conflicted file.
+ (vc-git-conflicted-files): New function.
+ Useful in itself and a step towards better smerge support.
+
+2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el (mpc-reorder): Don't bother splitting the "active" elements
+ to the first part if they're the same as the selection.
+
+2014-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * image-mode.el (image-transform-reset): New command and menu item.
+ (image-mode-map): Rearrange the menu items to put presumably more
+ obscure items at the end.
+
+2014-08-12 Juri Linkov <juri@jurta.org>
+
+ * vc/vc-annotate.el (vc-annotate-background-mode):
+ Use `with-demoted-errors' instead of `ignore-errors'. (Bug#18189)
+
+2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (out-of-memory-warning-percentage): Turn it off by default.
+
+2014-08-11 Sam Steingold <sds@gnu.org>
+
+ * textmodes/sgml-mode.el (sgml-validate-command): Set depending on
+ the presence of known validators (tidy, (o)nsgmls).
+
+2014-08-11 Ulf Jasper <ulf.jasper@web.de>
+
+ Newsticker: introduce `newsticker-treeview-date-format'. (Bug#17227)
+ * net/newst-treeview.el (newsticker-treeview-date-format): New.
+ (newsticker--treeview-list-add-item):
+ Use `newsticker-treeview-date-format'.
+
+2014-08-11 Glenn Morris <rgm@gnu.org>
+
+ * files.el (basic-save-buffer-2): Revert 2013-01-31 change, which
+ chose coding system for writing before backing up, since it causes
+ a more serious problem than the one it solves. (Closes Bug#18141,
+ reopens Bug#13522.)
+
+2014-08-11 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-total-size): Make doc-string more self-contained.
+
+ * window.el (display-buffer-below-selected): Restore original
+ behavior if buffer is already displayed in the window below the
+ selected one (Bug#18181).
+
+2014-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse--down-1-maybe-follows-link): Don't convert the down
+ event (bug#18212).
+
+2014-08-11 Eli Zaretskii <eliz@gnu.org>
+
+ * info.el (info): Doc fix.
+
+2014-08-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * info.el (Info-mode-map): Override a global down-mouse-2 binding
+ (bug#18212).
+
+2014-08-11 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (default-line-height): A floating-point value of
+ line-spacing means a fraction of the default frame font's height,
+ not of the font currently used by the 'default' face.
+ Truncate the pixel value, like the display engine does.
+ (window-screen-lines): Use window-inside-pixel-edges for
+ determining the window height in pixels. (Bug#18195)
+
+2014-08-11 Grégoire Jadi <daimrod@gmail.com>
+
+ * leim/quail/latin-post.el: Transform " __" into " _". (Bug#18023)
+
+2014-08-10 Ulf Jasper <ulf.jasper@web.de>
+
+ Enumerate evaluated sexp diary entries (Bug#7911).
+ * calendar/icalendar.el (icalendar-export-sexp-enumerate-all)
+ (icalendar-export-sexp-enumeration-days): New.
+ (icalendar-export-region): Now `icalendar--convert-to-ical'
+ returns a cons cell or a list of cons cells.
+ (icalendar--convert-to-ical): Take care of
+ `icalendar-export-sexp-enumerate-all'. Return (a list of) cons cells.
+ (icalendar--convert-ordinary-to-ical)
+ (icalendar--convert-weekly-to-ical, icalendar--convert-yearly-to-ical)
+ (icalendar--convert-block-to-ical, icalendar--convert-block-to-ical)
+ (icalendar--convert-float-to-ical, icalendar--convert-cyclic-to-ical)
+ (icalendar--convert-anniversary-to-ical): Return cons cell.
+ (icalendar--convert-sexp-to-ical): Enumerate evaluated sexp
+ entries. Return (list of) cons cells.
+
+2014-08-09 Juri Linkov <juri@jurta.org>
+
+ * vc/vc-annotate.el (vc-annotate-background-mode): Add :set
+ to reevaluate `vc-annotate-color-map'. (Bug#18189)
+
+2014-08-09 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-fonts.el (c-font-lock-declarators): Remove check
+ for top-level that can cause unacceptable slow-down in scrolling.
+ See email Subject: Huge {...} blocks in C/C++ again, from Dmitry
+ Antipov from 2013-10-14 in emacs-devel.
+
+2014-08-08 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * ibuffer.el (ibuffer-mode-map): Use toggle button for
+ `ibuffer-auto-mode' menu entry.
+ (ibuffer-mode-hook): Add `ibuffer-auto-mode' customization option.
+
+2014-08-08 Matthias Meulien <orontee@gmail.com>
+
+ * progmodes/prog-mode.el (prog-mode-hook): Make customizable.
+ (Bug#16394)
+
+2014-08-07 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--min-size-1): Explicitly set WINDOW arg in
+ calls of window-min-pixel-height and window-min-pixel-width.
+
+2014-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ * progmodes/ada-mode.el:
+ * net/tramp.el (tramp-handle-file-symlink-p):
+ * net/tramp-ftp.el (tramp-ftp-file-name-handler): Remove a comment
+ about VMS, which we no longer support.
+ * progmodes/ada-xref.el (ada-xref-current): Remove mention of VMS,
+ and fix a FIXME, using convert-standard-filename in place of
+ removed ada-convert-file-name.
+
+2014-08-07 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (auto-mode-alist): Remove support for VMS from a pattern.
+
+2014-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Refer to MS-DOS using the same name everywhere.
+ * arc-mode.el, files.el, frame.el: ``MS-DOG'', ``MSDOG'' and
+ ``msdog'' become ``MS-DOS''.
+
+2014-08-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
+ Use cached "remote-copy-args" value, if available. (Bug#18199)
+
+2014-08-07 Leo Liu <sdl.web@gmail.com>
+
+ * help.el (temp-buffer-setup-hook,temp-buffer-show-hook):
+ Revert change on 2014-03-22.
+
+2014-08-06 Ulf Jasper <ulf.jasper@web.de>
+
+ * calendar/icalendar.el (icalendar--diarytime-to-isotime)
+ (icalendar--convert-ordinary-to-ical): Allow for missing minutes
+ (Bug#13750).
+
+
+2014-08-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * image-mode.el (image-toggle-display-image): Always rescale images
+ to not be bigger than the current window.
+
+2014-08-05 Eric Brown <brown@fastmail.fm> (tiny change)
+
+ * net/eww.el (eww-bookmarks-directory): New variable.
+ (eww-write-bookmarks): Use it.
+ (eww-read-bookmarks): Ditto.
+
+2014-08-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-copy-url): Also copy the image URL.
+
+2014-08-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-file-function): Suppress function
+ also for Tramp working buffers.
+
+2014-08-04 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el: Fix completions inside (i)pdb.
+ (python-shell-completion-pdb-string-code): Make obsolete.
+ (python-shell-completion-get-completions):
+ Use python-shell-completion-string-code resending setup code
+ continuously for (i)pdb.
+
+2014-08-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ * rect.el (rectangle--default-line-number-format): Rename
+ from misspelled rectange--default-line-number-format (Bug#18045).
+ All uses changed.
+
+2014-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't mishandle year-9999 dates (Bug#18176).
+ * calendar/parse-time.el (parse-time-rules):
+ Allow years up to most-positive-fixnum.
+ * calendar/time-date.el (date-to-time):
+ Pass "Specified time is not representable" errors through.
+
+2014-08-02 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el: Completion code cleanups.
+ (python-shell-completion-get-completions): Detect and send import
+ statements directly to completion function.
+ (python-shell-completion-at-point): Simplify prompt calculation
+ and import vs input completion logic.
+
+2014-08-02 Alan Mackenzie <acm@muc.de>
+
+ Fix confusion in C++ file caused by comma in "= {1,2},".
+ Bug #17756.
+ * progmodes/cc-engine.el (c-beginning-of-statement-1): In checking
+ for a statement boundary marked by "}", check there's no "="
+ before the "{".
+ (c-guess-basic-syntax CASE 9B): Call c-beginning-of-statement with
+ non-nil `comma-delim' argument.
+ * progmodes/cc-fonts.el (c-font-lock-declarators): Parse an
+ initializer expression more accurately.
+
+ Correct loop termination condition in c-syntactic-skip-backward.
+ * progmodes/cc-engine.el (c-syntactic-skip-backward): Correct for
+ the situation where, after moving back out of a literal,
+ skip-chars-backward doesn't move further, yet checks have still to
+ be done.
+
+2014-08-01 Eli Zaretskii <eliz@gnu.org>
+
+ * tutorial.el (tutorial--display-changes): Accept punctuation
+ characters before the key binding. (Bug#18146)
+
+2014-07-31 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el: Shell output capture enhancements.
+ (python-shell-accept-process-output): New function.
+ (inferior-python-mode)
+ (python-shell-send-setup-code): Use it.
+
+2014-07-30 Christophe Deleuze <christophe.deleuze@free.fr> (tiny change)
+
+ * calendar/icalendar.el (icalendar--decode-isodatetime):
+ Use actual current-time-zone when converting to local time. (Bug#15408)
+
+2014-07-29 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--state-put-2): Handle horizontal scroll
+ bars, if present.
+
+2014-07-29 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * menu-bar.el (menu-bar-update-buffers): Update item list format
+ in `buffers-menu' to confirm with changes to `get_keyelt'
+ (r117463). (Bug#18016)
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (inferior-python-mode): Make input prompts
+ read-only.
+
+2014-07-28 Emilio C. Lopes <eclig@gmx.net>
+
+ * net/tramp-sh.el (tramp-get-remote-python): Also search for
+ executables named "python2" or "python3".
+ (tramp-get-remote-uid-with-python): Use parentheses around
+ arguments to `print' to make it compatible with Python 3.
+ (tramp-get-remote-gid-with-python): Ditto. (Bug#18118)
+
+2014-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ * window.el (window--pixel-to-total): Use FRAME's root window, not
+ that of the selected frame. (Bug#18112, Bug#16674)
+
+2014-07-28 Andreas Schwab <schwab@linux-m68k.org>
+
+ * textmodes/tex-mode.el (tex-font-lock-verb): Doc fix.
+ (Bug#18117)
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (inferior-python-mode): Doc fix.
+
+2014-07-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-edit-item--next-key): If next key is
+ not a character, ignore it instead of raising an error.
+
+ * calendar/todo-mode.el: Fix handling of marked items and make
+ minor code improvements.
+ (todo-edit-item): If there are marked items, ensure user can only
+ invoke editing commands that work with marked items.
+ (todo-edit-item--text): When there are marked items, make it a
+ noop if invoked with point not on an item; otherwise, ensure it
+ applies only to item at point.
+ (todo-item-undone): If there are marked not-done items, return
+ point to its original position before signaling user error.
+ (todo--user-error-if-marked-done-item): New function.
+ (todo-edit-item--header, todo-edit-item--diary-inclusion)
+ (todo-item-done): Use it.
+
+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.
+
+ * progmodes/prolog.el (prolog-mode-keybindings-edit):
+ Replace missing `switch-to-prolog' with `run-prolog'.
+ (switch-to-prolog): Define as (obsolete) alias, as in 23.4.
+
+2014-07-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-set-top-priorities): Fix overwriting
+ of file-wide setting when changing category-wide setting.
+
+2014-07-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * doc-view.el (doc-view-open-text): Don't require that the
+ document is saved in a file (e.g., email attachment).
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Parse completion input in a iPython friendly way. (Bug#18084)
+ * progmodes/python.el
+ (python-shell-completion-at-point): Rename from
+ python-shell-completion-complete-at-point.
+ (inferior-python-mode): Use it.
+ (python-completion-at-point): Rename from
+ python-completion-complete-at-point. Parse input up to first
+ backward occurrence of whitespace, open-paren, close-paren or
+ string delimiter.
+ (python-mode): Use it.
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el
+ (python-shell-with-shell-buffer): New macro.
+ (python-shell-font-lock-get-or-create-buffer)
+ (python-shell-font-lock-kill-buffer)
+ (python-shell-font-lock-with-font-lock-buffer)
+ (python-shell-font-lock-cleanup-buffer)
+ (python-shell-font-lock-toggle): Use it.
+ (python-shell-font-lock-turn-on)
+ (python-shell-font-lock-turn-off): Use it. Make command.
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Grab all Python process output before inferior-python-mode hooks.
+ * progmodes/python.el (inferior-python-mode):
+ Call accept-process-output and sit-for to ensure all output for process
+ has been received before running hooks.
+ (python-shell-internal-get-or-create-process):
+ Cleanup accept-process-output and sit-for calls.
+
+2014-07-28 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ More robust shell startup and code setup.
+ * progmodes/python.el (python-shell-make-comint):
+ Remove accept-process-output call.
+ (python-shell-get-buffer): Return current buffer if major-mode is
+ inferior-python-mode.
+ (python-shell-get-or-create-process): Use it.
+ (python-shell-send-setup-code): Send all setup code in one string,
+ output success message and accept-process-output.
+
+2014-07-27 Eli Zaretskii <eliz@gnu.org>
+
+ * scroll-bar.el (scroll-bar-toolkit-horizontal-scroll):
+ Add rudimentary support for bidirectional text.
+
+2014-07-27 Martin Rudalics <rudalics@gmx.at>
+
+ * frame.el (frame-notice-user-settings): Rewrite using
+ frame-initial-frame-tool-bar-height.
+ * menu-bar.el (menu-bar-horizontal-scroll-bar)
+ (menu-bar-no-horizontal-scroll-bar): New functions.
+ (menu-bar-showhide-scroll-bar-menu): Add bindings for horizontal
+ scroll bars.
+ * scroll-bar.el (scroll-bar-lines)
+ (set-horizontal-scroll-bar-mode)
+ (get-horizontal-scroll-bar-mode, horizontal-scroll-bar-mode)
+ (scroll-bar-horizontal-drag-1, scroll-bar-horizontal-drag)
+ (scroll-bar-toolkit-horizontal-scroll): New functions.
+ (horizontal-scroll-bar-mode)
+ (previous-horizontal-scroll-bar-mode)
+ (horizontal-scroll-bar-mode-explicit): New variables.
+ (horizontal-scroll-bar-mode): New option.
+ (toggle-horizontal-scroll-bar): Do something.
+ (top-level): Bind horizontal-scroll-bar mouse-1.
+ * startup.el (tool-bar-originally-present): Remove variable.
+ (command-line): Don't set tool-bar-originally-present.
+ * window.el (window-min-height): Update doc-string.
+ (window--dump-frame): Dump horizontal scroll bar values.
+ (window--min-size-1): Handle minibuffer window separately.
+ Count in margins and horizontal scroll bar. Return safe value
+ iff IGNORE equals 'safe.
+ (frame-windows-min-size): New function (used by frame resizing
+ routines).
+ (fit-frame-to-buffer, fit-window-to-buffer): Count in horizontal
+ scroll bars.
+ (window--sanitize-window-sizes): New function.
+ (window-split-min-size): Remove.
+ (split-window): Count divider-width. Don't use
+ `window-split-min-size' any more. Reword error messages.
+ Sanitize windows sizes after splitting.
+
+2014-07-27 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Use `defvar-local' more.
+ * progmodes/hideshow.el
+ (hs-c-start-regexp, hs-block-start-regexp)
+ (hs-block-start-mdata-select, hs-block-end-regexp)
+ (hs-forward-sexp-func, hs-adjust-block-beginning): ...here;
+ remove corresponding `make-variable-buffer-local' top-level calls.
+
+2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Cleanup error signals. (Bug#18067)
+ * progmodes/python.el
+ (python-indent-shift-left): Use user-error instead.
+ (python-shell-prompt-detect): Use lwarn with python group.
+ (python-completion-complete-at-point)
+ (python-eldoc--get-doc-at-point): Don't signal error.
+
+2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Support for packages in Python shell. (Bug#13570)
+ * progmodes/python.el (python-shell--package-depth): New var.
+ (python-shell-package-enable): New command.
+ (python-util-list-directories, python-util-list-files)
+ (python-util-list-packages): New functions.
+
+2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Faster comint output. (Bug#16875)
+ * progmodes/python.el:
+ (python-comint-output-filter-function): Make obsolete.
+ (python-comint-postoutput-scroll-to-bottom): New function.
+ (inferior-python-mode): Set comint-output-filter-functions to a
+ minimum.
+
+2014-07-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-font-lock-post-command-hook):
+ Safeguard current point and undo history.
+
+2014-07-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Robust shell syntax highlighting. (Bug#18084, Bug#16875)
+ * progmodes/python.el:
+ (python-shell-prompt-input-regexps): Add iPython block prompt.
+ (python-shell-output-syntax-table): Delete var.
+ (python-shell-font-lock-with-font-lock-buffer): New macro.
+ (python-shell-font-lock-get-or-create-buffer)
+ (python-shell-font-lock-kill-buffer)
+ (python-shell-font-lock-cleanup-buffer)
+ (python-shell-font-lock-post-command-hook)
+ (python-shell-font-lock-turn-off): New functions.
+ (python-shell-font-lock-turn-on): New function.
+ (inferior-python-mode): Use it.
+ (python-shell-font-lock-toggle): New command.
+ (python-shell-font-lock-enable): Rename from
+ python-shell-enable-font-lock.
+ (run-python-internal): Use it.
+ (python-shell-font-lock-comint-output-filter-function): New function.
+ (python-shell-comint-end-of-output-p): New function.
+ (python-shell-output-filter): Use it.
+ (python-util-comint-last-prompt): New function.
+ (python-util-text-properties-replace-name): New function.
+
+2014-07-25 Glenn Morris <rgm@gnu.org>
+
+ * vc/ediff-init.el (ediff-toggle-read-only-function):
+ * vc/ediff-util.el (ediff-toggle-read-only):
+ Replace obsolete toggle-read-only with read-only-mode.
+
+2014-07-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cache.el (tramp-flush-file-function): Wrap the code
+ with `save-match-data'. (Bug#18095)
+
+2014-07-21 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-truncate-cell): Use cl-progv instead of eval in
+ order to ensure that row and col are lexically bound inside the
+ evaluated sexp.
+
+2014-07-21 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/hideif.el (hide-ifdef-mode-submap):
+ Also substitute read-only-mode.
+ * bindings.el (mode-line-toggle-read-only):
+ * bs.el (bs-toggle-readonly):
+ * buff-menu.el (Buffer-menu-toggle-read-only):
+ * dired.el (dired-toggle-read-only):
+ * files.el (view-read-only, find-file-read-only)
+ (find-file-read-only-other-window)
+ (find-file-read-only-other-frame):
+ * progmodes/hideif.el (hide-ifdef-toggle-outside-read-only):
+ Doc fixes re toggle-read-only.
+
+2014-07-21 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el: Add comment about pipe buffering and
+ solutions for missing/delayed output in inferior Python shells.
+ (Bug#17304)
+
+ * progmodes/python.el (python-mode): Don't set
+ mode-require-final-newline. (Bug#17990)
+
+ Make python.el work with IPython automatically. (Bug#15510)
+ * progmodes/python.el:
+ (python-shell-completion-setup-code): New value supporting iPython.
+ (python-shell-completion-string-code): New value supporting iPython.
+ (python-shell-completion-get-completions): Use them.
+ (python-shell-completion-module-string-code): Make obsolete.
+ (python-shell-prompt-input-regexps)
+ (python-shell-prompt-output-regexps): Add safeguard for ipdb.
+ (python-shell-output-filter): Fix comment typo.
+
+ Fix Python shell prompts detection for remote hosts.
+ * progmodes/python.el (python-shell-prompt-detect):
+ Replace call-process with process-file and make it more robust.
+
+ Autodetect Python shell prompts. (Bug#17370)
+ * progmodes/python.el:
+ (python-shell-interpreter-interactive-arg)
+ (python-shell-prompt-detect-enabled)
+ (python-shell-prompt-detect-failure-warning)
+ (python-shell-prompt-input-regexps)
+ (python-shell-prompt-output-regexps): New vars.
+ (python-shell-prompt-calculated-input-regexp)
+ (python-shell-prompt-calculated-output-regexp): New vars.
+ (python-shell-get-process-name)
+ (python-shell-internal-get-process-name)
+ (python-shell-output-filter)
+ (python-shell-completion-get-completions): Use them.
+ (python-shell-prompt-detect)
+ (python-shell-prompt-validate-regexps): New functions.
+ (python-shell-prompt-set-calculated-regexps): New function.
+ (inferior-python-mode): Use it. Also honor overriden
+ python-shell-interpreter and python-shell-interpreter-args.
+ (python-shell-make-comint): Honor overriden
+ python-shell-interpreter and python-shell-interpreter-args.
+ (python-shell-get-or-create-process): Make it testable by allowing
+ to call run-python non-interactively.
+ (python-util-valid-regexp-p): New function.
+ (python-shell-prompt-regexp, python-shell-prompt-block-regexp)
+ (python-shell-prompt-output-regexp)
+ (python-shell-prompt-pdb-regexp): Use it as defcustom :safe.
+
+2014-07-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-config--guess-1): Split from
+ smie-config--guess.
+ (smie-config--guess): Use it.
+
+ * emacs-lisp/edebug.el: Use nadvice.
+ (edebug-original-read): Remove.
+ (edebug--read): Rename from edebug-read and add `orig' arg.
+ (edebug-uninstall-read-eval-functions)
+ (edebug-install-read-eval-functions): Use nadvice.
+ (edebug-read-sexp, edebug-read-storing-offsets, edebug-read-symbol)
+ (edebug-read-and-maybe-wrap-form1, edebug-instrument-callee)
+ (edebug-read-string, edebug-read-function): Use just `read'.
+ (edebug-original-debug-on-entry): Remove.
+ (edebug--debug-on-entry): Rename from edebug-debug-on-entry and add
+ `orig' arg.
+ (debug-on-entry): Override with nadvice.
+
+ * mouse.el (tear-off-window): Rename from mouse-tear-off-window since
+ it also makes sense to bind it to a non-mouse event.
+
+ * vc/vc-bzr.el (vc-bzr-shelve): Make it operate on fileset.
+
+2014-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xt-mouse.el (xterm-mouse-event): Don't assume last-click is non-nil
+ (bug#18015).
+
+ * rect.el (rectangle--string-preview): Don't assume there
+ a non-nil default (bug#17984).
+
+2014-07-16 Glenn Morris <rgm@gnu.org>
+
+ * desktop.el (after-init-hook): Disable startup frame restoration
+ in non-graphical situations. (Bug#17693)
+
+ * vc/vc-dispatcher.el (vc-log-edit): Do set up the log buffer
+ if it was "empty", or used for a different set of files. (Bug#17884)
+
+2014-07-16 Eli Zaretskii <eliz@gnu.org>
+
+ * bindings.el (mode-line-remote): If default-directory is not a
+ string, don't call file-remote-p on it; instead state in the
+ help-echo that it is nil. (Bug#17986)
+
+2014-07-14 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/cc-langs.el: Change comments from `cl-macroexpand-all'
+ to `macroexpand-all'
+
+ * progmodes/cc-defs.el (c-lang-defconst-eval-immediately):
+ Use `macroexpand-all' instead of `cl-macroexpand-all'.
+
+2014-07-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug: C-x v v discarded existing log message (Bug#17884).
+ * vc/vc-dispatcher.el (vc-log-edit):
+ Don't clobber an already-existing log message.
+
+2014-07-12 Glenn Morris <rgm@gnu.org>
+
+ * vc/log-edit.el (log-edit-changelog-entries):
+ Check for a visited-but-never-saved ChangeLog.
+
+2014-07-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/log-edit.el (log-edit-changelog-entries): Don't both visiting
+ a non-existing file (bug#17970).
+
+ * faces.el (face-name): Undo last change.
+ (x-resolve-font-name): Don't call face-name (bug#17956).
+
+2014-07-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix dedenters and electric colon handling. (Bug#15163)
+ * progmodes/python.el
+ (python-rx-constituents): Add dedenter and block-ender.
+ (python-indent-dedenters, python-indent-block-enders): Delete.
+ (python-indent-context): Return new case for dedenter-statement.
+ (python-indent-calculate-indentation): Handle new case.
+ (python-indent-calculate-levels): Fix levels calculation for
+ dedenter statements.
+ (python-indent-post-self-insert-function): Fix colon handling.
+ (python-info-dedenter-opening-block-message): New function.
+ (python-indent-line): Use it.
+ (python-info-closing-block)
+ (python-info-closing-block-message): Remove.
+ (python-info-dedenter-opening-block-position)
+ (python-info-dedenter-opening-block-positions)
+ (python-info-dedenter-statement-p): New functions.
+
+2014-07-11 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * files.el (out-of-memory-warning-percentage): New defcustom.
+ (warn-maybe-out-of-memory): Use it.
+
+2014-07-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * subr.el (read-passwd): Use `read-hide-char' if non-nil. Bind it
+ when calling `read-string'. (Bug#17839)
+
+2014-07-10 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (warn-maybe-out-of-memory): Fix the wording of the
+ warning.
+
+2014-07-10 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * files.el (warn-maybe-out-of-memory): New function.
+ (find-file-noselect): Use it.
+
+2014-07-09 Sam Steingold <sds@gnu.org>
+
+ * progmodes/cperl-mode.el (cperl-block-p): Treat the perl keyword
+ `constant' like `bless', `return' &c
+
+2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (apply-on-rectangle): Check forward-line really moved to the
+ next line.
+
+2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie-sh-rules): Don't align with a && in
+ the middle of a line (bug#17896).
+
+2014-07-09 Juri Linkov <juri@jurta.org>
+
+ * startup.el (command-line): Append displaying the warning about
+ the errors in the init file to the end of `after-init-hook'.
+ (Bug#17927)
+
+ * faces.el (face-name): Return input arg `face' as-is
+ when it's not a symbol.
+ (x-resolve-font-name): Don't check if the face is a symbol.
+ (Bug#17956)
+
+ * facemenu.el (list-colors-print): In help-echo format use %.2f
+ instead of %d because now HSV values are floating-point components
+ between 0.0 and 1.0.
+
+2014-07-09 Glenn Morris <rgm@gnu.org>
+
+ * emulation/cua-rect.el (cua--activate-rectangle):
+ Avoid setting cua--rectangle to nil. (Bug#17877)
+
+2014-07-09 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Fix wrong-type-argument error when
+ marking multiple consecutive items.
+ (todo-toggle-mark-item): Don't try to mark the empty lines at the
+ end of the todo and done items sections. Note in doc string that
+ items marked by passing a numeric prefix argument can include the
+ last todo and first done items.
+ (todo-mark-category): Don't try to mark the empty line between the
+ todo and done items sections.
+
+2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-eval-defun): Print result using
+ proper Lisp quoting (bug#17934).
+
+ * progmodes/ruby-mode.el (ruby-mode-variables): Don't meddle with
+ require-final-newline since prog-mode already took care of it (bug#17947).
+
+2014-07-09 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Fix two bugs. Shorten Commentary and
+ refer to the Todo mode Info manual. Update the comment on
+ requiring cl-lib.
+ (todo-find-filtered-items-file): Add todo-prefix overlays.
+ (todo-filter-items): Reorder a let-bound variable to avoid a
+ wrong-type-argument error on canceling the file choice dialog.
+
+2014-07-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/octave.el (inferior-octave-mode):
+ Set comint-input-ring-size to a number (bug#17912).
+
+2014-07-09 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-minor-mode-table): Add `defining-kbd-macro'
+ and `isearch-mode' associated with nil. (Bug#17849)
+
+2014-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * linum.el (linum--face-height): New function (bug#17813).
+ (linum-update-window): Use it to adjust margin to linum's width.
+
+ * leim/quail/sisheng.el (sisheng-list): Don't bother with-case-table.
+ * eshell/em-smart.el (eshell-smart-scroll-window):
+ Use with-selected-window.
+
+ * xt-mouse.el (xterm-mouse-translate-1): Intern drag event (bug#17894).
+ Remove also pointless window&mark manipulation.
+
+ * progmodes/perl-mode.el: Use syntax-ppss; fix one indentation case.
+ (perl-indent-line): Use syntax-ppss to detect we're in a doc-section.
+ (perl-continuation-line-p): Don't skip over anything else than labels.
+ Return the previous char.
+ (perl-calculate-indent): Use syntax-ppss instead of parse-start
+ and update callers accordingly. For continuation lines, check the
+ the case of array hashes.
+ (perl-backward-to-noncomment): Make it non-interactive.
+ (perl-backward-to-start-of-continued-exp): Rewrite.
+
+2014-07-08 Sam Steingold <sds@gnu.org>
+
+ * progmodes/inf-lisp.el (lisp-eval-paragraph, lisp-eval-form-and-next):
+ New user commands.
+
+2014-07-08 Juri Linkov <juri@jurta.org>
+
+ * vc/vc-annotate.el (vc-annotate-background-mode): New defcustom.
+ (vc-annotate-color-map): Use less saturated colors (20%) for
+ background-mode.
+ (vc-annotate-very-old-color): Add default value for background-mode.
+ (vc-annotate-background): Set default value to nil since now text on
+ the default backgrounds should be legible in light and dark modes.
+ (vc-annotate-lines): Use `vc-annotate-background-mode'. Doc fix.
+ (Bug#17808)
+
+2014-07-08 Juri Linkov <juri@jurta.org>
+
+ * simple.el (transpose-chars): Don't move point into read-only area.
+ (Bug#17829)
+
+2014-07-08 Juri Linkov <juri@jurta.org>
+
+ * window.el (with-displayed-buffer-window): New macro.
+ (with-temp-buffer-window, with-current-buffer-window):
+ Use `macroexp-let2' to evaluate and bind variables
+ in the same order as macro arguments.
+ (display-buffer--action-function-custom-type):
+ Add `display-buffer-below-selected' and `display-buffer-at-bottom'.
+
+ * minibuffer.el (minibuffer-completion-help): Replace
+ `with-output-to-temp-buffer' with `with-displayed-buffer-window'
+ with actions that display *Completions* at-bottom when called
+ from the minibuffer, or below-selected in a normal buffer.
+ Associate `window-height' with `fit-window-to-buffer'.
+ Let-bind `pop-up-windows' to nil.
+
+ * dired.el (dired-mark-pop-up): Use `with-displayed-buffer-window'
+ instead of `with-current-buffer-window'. (Bug#17809)
+
+2014-07-07 Luke Lee <luke.yx.lee@gmail.com>
+
+ * progmodes/hideif.el (hide-ifdef-env): Change to global.
+ (hide-ifdef-env-backup): New variable.
+ (hide-ifdef-expand-reinclusion-protection, hide-ifdef-header-regexp):
+ New customizable variables.
+ (hif-clear-all-ifdef-defined): New defun.
+ (hif-merge-ifdef-region, hide-ifdef-region-internal, hide-ifdef-region)
+ (hif-show-ifdef-region): Merge hidden regions to prevent continuous "...".
+ (hif-tokenize): Fix for MS-DOS/Win EOL style.
+ (hif-endif-to-ifdef, hif-make-range, hif-find-range, hif-possibly-hide):
+ Fix bug to hide the correct #elif region(s).
+ (hif-range-elif): New defun.
+ (hif-recurse-level): New var.
+ (hif-evaluate-region, hif-evaluate-macro): New defun.
+ (hide-ifdef-guts): Prevent reinclusion protected C/C++ headers from
+ fully hidden.
+ (hide-ifdef-define, hide-ifdefs, hide-ifdef-block, show-ifdef-block):
+ Better interaction.
+
+2014-07-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-peer-handler): New defun.
+ (dbus-register-service): Register it. (Bug#17858)
+ (dbus-managed-objects-handler): Fix docstring.
+
+2014-07-04 Phil Sainty <psainty@orcon.net.nz>
+
+ * emacs-lisp/lisp.el (narrow-to-defun-include-comments): New var.
+ (narrow-to-defun): New arg include-comments, defaulting to it
+ (bug#16328).
+
+2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (rectangle--highlight-for-redisplay): Don't pass `orig' with
+ different calling convention to rectangle--unhighlight-for-redisplay.
+
+2014-07-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-call-process): Handle error strings.
+
+ * net/tramp-adb.el (tramp-adb-sh-fix-ls-output): Use `bolp'.
+
+ * net/tramp-sh.el (tramp-sh-handle-set-visited-file-modtime)
+ (tramp-sh-handle-verify-visited-file-modtime): Use `point-at-eol'.
+
+ * net/trampver.el: Update release number.
+
+2014-07-03 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-save): Rename arg `auto-save' to
+ `only-if-changed'. Doc fix. (Bug#17873)
+
+2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse-yank-primary, mouse-yank-secondary):
+ Use insert-for-yank (bug#17271).
+
+2014-07-03 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/pp.el (pp-eval-expression, pp-eval-last-sexp):
+ Support lexical-binding.
+
+2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/log-edit.el (log-edit-goto-eoh): New function.
+ (log-edit--match-first-line): Use it (bug#17861).
+
+2014-07-03 Glenn Morris <rgm@gnu.org>
+
+ * vc/log-edit.el (log-edit-hook): Add missing :version.
+
+2014-07-03 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-post-self-insert-function):
+ Enhancements to electric indentation behavior inside
+ parens. (Bug#17658)
+
+2014-07-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ps-def.el (ps-generate-postscript-with-faces1): Don't mess with
+ buffer-invisibility-spec (bug#17867).
+
+2014-07-03 Andreas Schwab <schwab@linux-m68k.org>
+
+ * vc/vc-git.el (vc-git-checkin): When operating on the whole tree
+ pass "-a".
+
+2014-07-03 Glenn Morris <rgm@gnu.org>
+
+ * cus-edit.el (help):
+ * finder.el (finder-known-keywords):
+ * help.el (help-for-help-internal):
+ * vc/ediff-mult.el (ediff-meta-buffer-verbose-message)
+ (ediff-redraw-registry-buffer):
+ * vc/ediff-ptch.el (ediff-patch-file-internal):
+ Doc fixes re "online" help. (Bug#17803)
+
+ * progmodes/idlwave.el (idlwave): Update url-link for custom group.
+ (idlwave-mode): Doc URL update.
+
+2014-07-01 Juri Linkov <juri@jurta.org>
+
+ * man.el: Display man pages immediately and use process-filter
+ to format them asynchronously.
+ (Man-width): Doc fix.
+ (man): Doc fix.
+ (Man-start-calling): Use `with-selected-window' to get
+ `frame-width' and `window-width'.
+ (Man-getpage-in-background): Call `Man-notify-when-ready'
+ immediately after creating a new buffer. Call `Man-mode' and set
+ `mode-line-process' in the created buffer. Set process-filter to
+ `Man-bgproc-filter' in start-process branch. In call-process branch
+ call either `Man-fontify-manpage' or `Man-cleanup-manpage'.
+ Use `Man-start-calling' inside `with-current-buffer'.
+ (Man-fontify-manpage): Don't print messages. Fix boundary condition.
+ (Man-cleanup-manpage): Don't print messages.
+ (Man-bgproc-filter): New function.
+ (Man-bgproc-sentinel): Add `save-excursion' to keep point when
+ user moved it during asynchronous formatting. Move calls of
+ `Man-fontify-manpage' and `Man-cleanup-manpage' to
+ `Man-bgproc-filter'. Move the call of `Man-mode' to
+ `Man-getpage-in-background'. Use `quit-restore-window'
+ instead of `kill-buffer'. Use `message' instead of `error'
+ because errors are caught by process sentinel.
+ (Man-mode): Move calls of `Man-build-page-list',
+ `Man-strip-page-headers', `Man-unindent', `Man-goto-page' to
+ `Man-bgproc-sentinel'. Doc fix. (Bug#2588, bug#5054, bug#9084, bug#17831)
+
+ * man.el (Man-bgproc-sentinel): Use `Man-page-from-arguments'
+ for the message about the man page cleaned up.
+
+2014-07-01 Mario Lang <mlang@delysid.org>
+
+ * net/gnutls.el (gnutls-negotiate): Prevent destructive modification of
+ cosutomization option `gnutls-verify-error'.
+
+2014-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (deactivate-mark, set-mark-command, handle-shift-selection):
+ Don't keep transient-mark-mode buffer-local when not needed (bug#6316).
+
+ * xt-mouse.el (turn-on-xterm-mouse-tracking-on-terminal)
+ (turn-off-xterm-mouse-tracking-on-terminal): Don't burp if the terminal
+ is suspended (bug#17857).
+
+2014-07-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
+ Prefer utf-8 coding. (Bug#17859)
+
+2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * emacs-lisp/subr-x.el (string-reverse): Define as obsolete alias
+ for `reverse'.
+
+2014-06-30 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/autoload.el (autoload-ensure-writable): New variable.
+ (autoload-ensure-default-file): Maybe make existing output writable.
+ * Makefile.in (AUTOGEN_VCS): Remove.
+ (autoloads): Use autoload-ensure-writable rather than AUTOGEN_VCS.
+
+2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * emacs-lisp/subr-x.el (string-reverse): Use `reverse'.
+
+2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ New if-let, when-let, thread-first and thread-last macros.
+
+ * emacs-lisp/subr-x.el
+ (internal--listify, internal--check-binding)
+ (internal--build-binding-value-form, internal--build-binding)
+ (internal--build-bindings): New functions.
+ (internal--thread-argument, thread-first, thread-last)
+ (if-let, when-let): New macros.
+
+2014-06-30 Grégoire Jadi <daimrod@gmail.com>
+
+ * net/rcirc.el (rcirc-buffer-process): Restore previous
+ behaviour. (Bug#17772)
+
+2014-06-29 Alan Mackenzie <acm@muc.de>
+
+ Don't call c-parse-state when c++-template-syntax-table is active.
+ * progmodes/cc-engine.el (c-guess-continued-construct CASE G)
+ (c-guess-basic-syntax CASE 5D.3): Rearrange so that
+ c-syntactic-skip-backwards isn't called with the pertinent syntax table.
+
+2014-06-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-set-top-priorities): Fix logic to
+ account for file-wide setting of todo-top-priorities-overrides.
+ Make code a bit cleaner.
+
+2014-06-28 Glenn Morris <rgm@gnu.org>
+
+ * net/eww.el (eww-mode) <eww-current-title>: Make local. (Bug#17860)
+
+2014-06-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-prefix-overlays): If there is no
+ category-wide setting of todo-top-priorities-overrides, check for
+ a file-wide setting and fontify accordingly.
+
+2014-06-28 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (read-passwd): Warn about batch mode. (Bug#17839)
+
+2014-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/hideif.el: Use lexical-binding. Fix up cl-lib usage.
+
+2014-06-28 K. Handa <handa@gnu.org>
+
+ Fix Bug#17739.
+
+ * composite.el: Setup composition-function-table for dotted circle.
+ (compose-gstring-for-dotted-circle): New function.
+
+ * international/characters.el: Add category "^" to all
+ non-spacing characters.
+
+2014-06-28 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (doit): Remove force rule.
+ (custom-deps, finder-data, autoloads, update-subdirs)
+ (compile-one-process): PHONY targets do not need force rules.
+
+ * Makefile.in (compile-main, compile, compile-always):
+ No need to explicitly pass variables to ourself in recursive calls.
+
+2014-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (minibuffer-with-setup-hook): Evaluate the first arg eagerly.
+
+2014-06-26 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (update-authors): Update for moved authors.el.
+
+2014-06-26 Leo Liu <sdl.web@gmail.com>
+
+ * skeleton.el (skeleton-end-hook): Default to nil and move the
+ work to skeleton-insert. (Bug#17850)
+
+2014-06-26 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * calc/calc-alg.el (math-beforep):
+ * progmodes/cc-guess.el (c-guess-view-reorder-offsets-alist-in-style):
+ Simplify because string-lessp can accept symbols as args.
+
+2014-06-26 Daiki Ueno <ueno@gnu.org>
+
+ * emacs-lisp/package.el (package--check-signature):
+ If package-check-signature is allow-unsigned, don't signal error when
+ we can't verify signature because of missing public key
+ (bug#17625).
+
+2014-06-26 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-macs.el (help-add-fundoc-usage):
+ Remove outdated declaration.
+
+ * emacs-lisp/authors.el (authors-valid-file-names)
+ (authors-renamed-files-alist): Additions.
+
+2014-06-26 Leo Liu <sdl.web@gmail.com>
+
+ * textmodes/picture.el (picture-set-tab-stops):
+ * ruler-mode.el (ruler-mode-mouse-add-tab-stop)
+ (ruler-mode-ruler): Fix to work with nil tab-stop-list.
+
+ * progmodes/asm-mode.el (asm-calculate-indentation):
+ Use indent-next-tab-stop.
+
+ * indent.el (indent-accumulate-tab-stops): New function.
+
+2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-list-unsigned): New var (bug#17625).
+ (package-desc-status): Obey it.
+
+2014-06-26 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Fix two bugs.
+ (todo-insert-item--basic): If user cancels item insertion to
+ another category before setting priority, show original category
+ whether it is in the same or a different file.
+ (todo-set-item-priority): After selecting category, instead of
+ moving point to top, which extends an active region, restore it.
+
+2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (describe-function-1): Check file-name is a string before
+ calling help-fns--autoloaded-p (bug#17564).
+
+2014-06-26 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-auto-save-enable)
+ (desktop-auto-save-disable): New functions.
+ (desktop-save-mode, desktop-auto-save-timeout): Use them.
+ (desktop-read): Disable the autosave before loading the desktop,
+ and enable afterwards. (Bug#17351)
+
+2014-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Fix some indentation problem with \; and pipes (bug#17842).
+ * progmodes/sh-script.el (sh-mode-syntax-table): Set syntax of ;|&.
+ (sh-smie--default-forward-token, sh-smie--default-backward-token):
+ New functions.
+ (sh-smie-sh-forward-token, sh-smie-sh-backward-token)
+ (sh-smie-rc-forward-token, sh-smie-rc-backward-token): Use them.
+ (sh-smie-sh-rules): Fix indentation of a pipe at BOL.
+
+2014-06-26 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/find-func.el (find-function-C-source-directory):
+ Use file-accessible-directory-p.
+
+ * ps-samp.el: Make it slightly less awful.
+ (ps-rmail-mode-hook, ps-gnus-article-prepare-hook, ps-vm-mode-hook):
+ (ps-gnus-summary-setup, ps-info-mode-hook): Use [print] key.
+ Only set local values.
+ (ps-article-subject, ps-article-author): Use standard functions
+ like mail-fetch-field.
+ (ps-info-file, ps-info-node): Use match-string.
+ (ps-jts-ps-setup, ps-jack-setup): Remove, merging into...
+ (ps-samp-ps-setup): ... new function.
+
+ * progmodes/idlw-shell.el (idlwave-shell-make-temp-file):
+ Optimize away code unneeded on any modern Emacs.
+
+ * emacs-lisp/authors.el: Move to ../admin.
+
+ * emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): New.
+
+2014-06-26 Luke Lee <luke.yx.lee@gmail.com>
+
+ * progmodes/hideif.el (hif-string-to-number): Fix return value bug.
+ (hif-simple-token-only, hif-tokenize): Comment in detail mainly for
+ performance enhancements.
+ (hif-parse-if-exp): Rename to `hif-parse-exp'. Enhance for macro
+ expansion.
+ (hif-factor, hif-string-concatenation, intern-safe): Support string
+ concatenation and argumented macro expansion.
+ (hif-if-valid-identifier-p, hif-define-operator, hif-flatten)
+ (hif-expand-token-list, hif-get-argument-list, hif-define-macro)
+ (hif-delimit, hif-macro-supply-arguments, hif-invoke, hif-canonicalize)
+ (hif-canonicalize-tokens, hif-place-macro-invocation)
+ (hif-parse-macro-arglist): Mostly new functions for supporting
+ argumented macro expansion.
+ (hif-string-concatenation, hif-stringify, hif-token-concat)
+ (hif-token-stringification, hif-token-concatenation):
+ Stringification and concatenation.
+ (hif-find-next-relevant): Fix comments.
+ (hif-ifdef-to-endif, hif-looking-at-elif, hif-hide-line): Bug fix for
+ some cases involving #elif.
+ (hif-find-define, hif-add-new-defines): New functions for automatically
+ scanning of defined symbols.
+ (hide-ifdef-guts): Fix for defined symbol auto scanning.
+ (hide-ifdef-undef): Fix behavior to match CPP.
+
+2014-06-25 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in ($(lisp)/progmodes/cc-defs.elc)
+ ($(lisp)/progmodes/cc-fonts.elc, $(lisp)/progmodes/cc-langs.elc)
+ ($(lisp)/progmodes/cc-vars.elc): Drop hand-written deps on non-cc
+ files. They are not relevant to the original issue (bug#1004),
+ and cause unnecessary recompilation (bug#2151).
+
+2014-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * play/landmark.el: Use lexical-binding and avoid `intangible'.
+ (landmark--last-pos): New var.
+ (landmark--intangible-chars): New const.
+ (landmark--intangible): New function.
+ (landmark-mode, landmark-move): Use it.
+ (landmark-mode): Remove properties.
+ (landmark-plot-square, landmark-point-square, landmark-goto-xy)
+ (landmark-cross-qtuple):
+ Don't worry about `intangible' any more.
+ (landmark-click, landmark-point-y): Same; and don't assume point-min==1.
+ (landmark-init-display): Don't set `intangible' and `point-entered'.
+ (square): Remove. Inline it instead.
+ (landmark--distance): Rename from `distance'.
+ (landmark-calc-distance-of-robot-from): Rename from
+ calc-distance-of-robot-from.
+ (landmark-calc-smell-internal): Rename from calc-smell-internal.
+
+2014-06-25 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * files.el (dir-locals-find-file, file-relative-name):
+ * info.el (Info-complete-menu-item):
+ * minibuffer.el (completion-table-subvert): Prefer string-prefix-p
+ to compare-strings to avoid out-of-range errors.
+ * subr.el (string-prefix-p): Adjust to match strict range
+ checking in compare-strings.
+
+2014-06-24 Leonard Randall <leonard.a.randall@gmail.com> (tiny change)
+
+ * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search
+ for comment lines non-greedy and stopping at newlines to fix stack
+ overflows with large files.
+
+2014-06-24 Eli Barzilay <eli@barzilay.org>
+
+ * calculator.el (calculator-last-input): Drop 'ascii-character property
+ lookup.
+
+2014-06-24 Leo Liu <sdl.web@gmail.com>
+
+ * align.el (align-adjust-col-for-rule): Unbreak due to defaulting
+ tab-stop-list to nil. (Bug#16381)
+
+ * indent.el (indent-next-tab-stop): Rename from indent--next-tab-stop.
+ (indent-rigidly-left-to-tab-stop)
+ (indent-rigidly-right-to-tab-stop, tab-to-tab-stop)
+ (move-to-tab-stop): Change callers.
+
+2014-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ * skeleton.el (skeleton-insert): Yet another fix of the doc string
+ wrt behavior of \n as the first/last element of a skeleton.
+
+2014-06-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el (tramp-adb-handle-process-file):
+ * net/tramp-sh.el (tramp-sh-handle-process-file):
+ * net/tramp-smb.el (tramp-smb-handle-process-file): Do not raise
+ the output buffer when DISPLAY is non-nil. (Bug#17815)
+
+2014-06-24 Glenn Morris <rgm@gnu.org>
+
+ * play/landmark.el (landmark-move-down, landmark-move-up):
+ Fix 2007-10-20 change - preserve horizontal position.
+
+2014-06-23 Sam Steingold <sds@gnu.org>
+
+ * simple.el (kill-append): Remove undo boundary depending on ...
+ (kill-append-merge-undo): New user option.
+
+2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (handle-shift-selection, exchange-point-and-mark)
+ (activate-mark): Set transient-mark-mode buffer-locally (bug#6316).
+ (transient-mark-mode): Use&set the global value.
+ * mouse.el (mouse-set-region-1, mouse-drag-track): Idem.
+ * emulation/edt.el (edt-emulation-off): Save&restore the global
+ transient-mark-mode setting.
+ * obsolete/pc-select.el (pc-selection-mode): Use the
+ transient-mark-mode function.
+
+2014-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ * international/fontset.el (script-representative-chars):
+ Add representative characters for scripts added in Unicode 7.0.
+ (otf-script-alist): Synchronize with the latest registry of OTF
+ script tags.
+
+ * international/characters.el (char-script-table): Update for
+ scripts added and codepoint ranges changed in Unicode 7.0.
+
+2014-06-23 Eli Barzilay <eli@barzilay.org>
+
+ * calculator.el (calculator-standard-displayer): Fix bug in use of
+ `calculator-groupize-number'.
+ (calculator-funcall): Fix broken `cl-flet' use by moving it into the
+ `eval' code, so it works in v24.3.1 too.
+ (calculator-last-input): Comment to clarify purpose.
+
+2014-06-22 Mario Lang <mlang@delysid.org>
+
+ * textmodes/rst.el (rst-comment-region): From from -> from.
+
+ * net/tramp-adb.el (tramp-adb-send-command-and-check): And and -> and.
+
+2013-06-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * electric.el (electric-layout-post-self-insert-function):
+ * emacs-lisp/ert.el (ert--insert-infos):
+ * obsolete/vi.el (vi-set-mark):
+ * term.el (term-handle-scroll):
+ * textmodes/bibtex.el (bibtex-fill-field, bibtex-fill-entry):
+ * wid-edit.el (widget-editable-list-value-create):
+ Prefer point-marker to copy-marker of point.
+
+2014-06-21 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Fix completion retrieval parsing (bug#17209).
+ * progmodes/python.el (python-mode):
+ (python-util-strip-string): New function.
+ (python-shell-completion-get-completions): Use it.
+
+2014-06-21 Eli Zaretskii <eliz@gnu.org>
+
+ * skeleton.el (skeleton-insert): Fix last change.
+
+2014-06-21 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Enhancements for outline integration (bug#17796).
+ * progmodes/python.el (python-mode): Properly set
+ outline-heading-end-regexp so that comments after colons for
+ defuns are supported.
+
+2014-06-21 Eli Zaretskii <eliz@gnu.org>
+
+ * skeleton.el (skeleton-insert): Doc fix.
+
+2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-config--guess): Fix typo.
+ (smie-config-guess): Use smie-config-local so the rules are obeyed
+ (bug#17818).
+
+ * mouse.el (mouse-drag-line): Don't re-add to unread-comment-events,
+ since it's already done inside the loop (bug#17819).
+
+2014-06-21 Martin Rudalics <rudalics@gmx.at>
+
+ * mouse.el (mouse-drag-line): Re-remove code initially removed
+ on 2013-03-09 and inadvertently reintroduced on 2013-11-30
+ (Bug#17819).
+
+2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie-sh-rules): For { after &&, don't
+ align with the surrounding parent (bug#17721).
+
+2014-06-21 Eli Zaretskii <eliz@gnu.org>
+
+ * textmodes/texinfo.el (texinfo-mode): Set skeleton-end-newline
+ locally to nil.
+ (texinfo-insert-block, texinfo-insert-@end)
+ (texinfo-insert-@example, texinfo-insert-@quotation): Adjust to
+ local setting of skeleton-end-newline by adding an explicit \n to
+ the skeletons where appropriate. (Bug#17801)
+
+2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie--hanging-eolp-function): New var.
+ (smie-indent--hanging-p): Use it.
+ * progmodes/sh-script.el (sh-set-shell): Set it (bug#17621).
+
+2014-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * simple.el (read-quoted-char): Don't let help chars pop up help
+ buffer. (Bug#16617)
+
+2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie-sh-rules): Use same rule for && as
+ for | (bug#17621).
+
+ * xt-mouse.el (xterm-mouse--read-event-sequence-1000):
+ Drop unknown events instead of burping.
+
+2014-06-21 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist): Support giflib 5.1.0
+ and later. (Bug#17790)
+
+2014-06-21 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-mark-pop-up): Let-bind display-buffer-mark-dedicated
+ to `soft'. (Bug#17554)
+
+2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * delsel.el (electric-newline-and-maybe-indent): Mark it as well
+ (bug#17737).
+
+2014-06-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Don't fontify
+ `!' in `!~' with `font-lock-negation-char-face'. (Bug#17732)
+
+2014-06-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Push only non D-Bus events into
+ `unread-command-events'.
+
+2014-06-19 William Xu <william.xwl@gmail.com>
+
+ * progmodes/hideif.el (hif-string-to-number): Don't return float for
+ hex integer constants (bug#17807).
+
+2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-util.el (truncate-string-ellipsis): New var.
+ (truncate-string-to-width): Use it.
+
+2014-06-19 Robert Brown <robert.brown@gmail.com> (tiny change)
+
+ * emacs-lisp/lisp-mode.el (lisp-string-after-doc-keyword-p): New fun.
+ (lisp-string-in-doc-position-p): New function, extracted from
+ lisp-font-lock-syntactic-face-function.
+ (lisp-font-lock-syntactic-face-function): Use them (bug#9130).
+
+2014-06-19 Grégoire Jadi <daimrod@gmail.com>
+
+ * net/rcirc.el (rcirc-omit-mode): Fix recenter error. (Bug#17769)
+
+2014-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * play/bubbles.el (bubbles--initialize, bubbles--show-scores)
+ (bubbles--game-over): Don't add `intangible' properties since they
+ didn't work anyway.
+
+2014-06-18 Juri Linkov <juri@jurta.org>
+
+ * vc/ediff-init.el (ediff-current-diff-Ancestor)
+ (ediff-fine-diff-Ancestor, ediff-even-diff-A, ediff-even-diff-B)
+ (ediff-even-diff-C, ediff-even-diff-Ancestor, ediff-odd-diff-A)
+ (ediff-odd-diff-B, ediff-odd-diff-C, ediff-odd-diff-Ancestor):
+ Add `min-colors 88' version with removed black/white foregrounds.
+ (Bug#10181)
+
+2014-06-18 Juri Linkov <juri@jurta.org>
+
+ * vc/diff-mode.el (diff-changed): Empty face definition to use
+ `diff-removed' and `diff-added' on tty as well. (Bug#10181)
+ (diff-context): Use darker color on light background and
+ lighter color on dark background.
+
+2014-06-18 Juri Linkov <juri@jurta.org>
+
+ * vc/diff-mode.el (diff-refine-changed): Rename from
+ `diff-refine-change' for consistency with `diff-changed'.
+ (diff-refine-change): Add obsolete face alias. (Bug#10181)
+
+ * vc/smerge-mode.el (smerge-refined-changed): Rename from
+ `smerge-refined-change'.
+ (smerge-refined-change): Add obsolete face alias.
+
+2014-06-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (rectangle-preview): New custom.
+ (rectangle): New group.
+ (rectangle--pos-cols): Add `window' argument.
+ (rectangle--string-preview-state, rectangle--string-preview-window):
+ New vars.
+ (rectangle--string-flush-preview, rectangle--string-erase-preview)
+ (rectangle--space-to, rectangle--string-preview): New functions.
+ (string-rectangle): Use them.
+ (rectangle--inhibit-region-highlight): New var.
+ (rectangle--highlight-for-redisplay): Obey it. Make sure
+ `apply-on-region' uses the point-crutches of the right window.
+ Use :align-to rather than multiple spaces.
+
+2014-06-16 Andrea Rossetti <andrea.rossetti@gmail.com> (tiny change)
+
+ * ruler-mode.el (ruler-mode-window-col)
+ (ruler-mode-mouse-set-left-margin)
+ (ruler-mode-mouse-set-right-margin): Fix calculation of column
+ from mouse position (Bug#17768).
+
+2014-06-16 Ron Schnell <ronnie@driver-aces.com>
+
+ * play/dunnet.el (dun-doassign): Fix bug where UNIX variable assignment
+ without varname or rhs causes crash.
+ (dun-ftp): Fix bug where blank ftp password is allowed, making it
+ impossible to win endgame.
+ (dun-unix-verbs): Add ssh as alias to rlogin, because nobody knows what
+ rlogin is anymore.
+ (dun-help): Bump version number; update contact info.
+
+2014-06-15 Eli Barzilay <eli@barzilay.org>
+
+ * calculator.el (calculator-prompt, calculator-remove-zeros)
+ (calculator-mode-hook, calculator-operators, calculator-stack)
+ (calculator-mode): Tweak docstring.
+ (calculator-user-operators): Tweak docstring, fix a bug in the last
+ example.
+ (calculator-displayer): `std' case has an optional boolean.
+ (calculator-displayers): Use the new boolean to group in decimal mode.
+ (calculator-mode-map, calculator, calculator-message)
+ (calculator-op-arity, calculator-add-operators)
+ (calculator-string-to-number, calculator-displayer-prev)
+ (calculator-displayer-next, calculator-remove-zeros)
+ (calculator-eng-display, calculator-number-to-string)
+ (calculator-update-display, calculator-last-input)
+ (calculator-clear-fragile, calculator-digit, calculator-decimal)
+ (calculator-exp, calculator-saved-move, calculator-clear)
+ (calculator-copy, calculator-put-value, calculator-help)
+ (calculator-expt, calculator-truncate): Minor code improvements.
+ (calculator-need-3-lines): New function pulling out code from
+ `calculator'.
+ (calculator-get-display): Rename from `calculator-get-prompt', and
+ improved.
+ (calculator-push-curnum): Rename from `calculator-curnum-value', and
+ extended for all uses of it. All callers changed.
+ (calculator-groupize-number): New utility for splitting a number into
+ groups.
+ (calculator-standard-displayer): Improve code, new optional argument to
+ use comma-split groups, make second argument optional too to use with
+ 'left/'right inputs. All callers changed.
+ (calculator-reduce-stack-once): New utility, doing the meat of what
+ `calculator-reduce-stack' used to do, much improved (mostly using
+ `pcase' for conciseness and clarity).
+ (calculator-reduce-stack): Now doing just the reduction loop using
+ `calculator-reduce-stack-once'.
+ (calculator-funcall): Improve code, make it work in v24.3.1 too.
+ (calculator-last-input): Improve code, remove some old cruft.
+ (calculator-quit): Kill `calculator-buffer' in electric mode too.
+ (calculator-integer-p): Remove.
+ (calculator-fact): Improve code, make it work on non-integer values
+ too (using truncated numbers).
+
+2014-06-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.10.
+
+ * net/tramp.el (tramp-methods): Tweak docstring.
+ (tramp-handle-file-accessible-directory-p): Check for
+ `file-readable-p' instead of `file-executable-p'.
+ (tramp-check-cached-permissions):
+ Use `tramp-compat-file-attributes'.
+ (tramp-call-process): Add new argument VEC. Adapt callees in all
+ tramp*.el files.
+
+ * net/tramp-adb.el (tramp-adb-handle-write-region): Improve messages.
+ (tramp-adb-maybe-open-connection): Don't set
+ `tramp-current-*' variables.
+
+ * net/tramp-cache.el (tramp-flush-file-function): Do not flush
+ file properties of temporary buffers.
+
+ * net/tramp-ftp.el (top): Remove special handling for URL syntax.
+
+ * net/tramp-gvfs.el (tramp-gvfs-methods) <sftp>: Add.
+ (tramp-gvfs-handle-delete-file): Flush file
+ properties, not directory properties.
+ (tramp-gvfs-handle-file-attributes): Use `string-to-number' when
+ reading "unix::mode".
+ (tramp-gvfs-handle-file-name-all-completions):
+ Use "-h" option for "gvfs-ls".
+ (tramp-gvfs-url-file-name): `user' and `localname' could be nil.
+ (tramp-gvfs-send-command): Simplify traces.
+
+ * net/tramp-sh.el (vc-handled-backends, vc-bzr-program)
+ (vc-git-program, vc-hg-program): Declare.
+ (tramp-methods) <sftp>: Remove. It has never worked satisfactorily.
+ (tramp-methods) <nc>: Add new method.
+ (tramp-methods) <telnet>: Redirect stderr to "/dev/null".
+ (tramp-methods) <plink, plinkx, pscp, psftp>: Improve
+ `tramp-login-args'.
+ (tramp-default-user-alist): Add "nc".
+ (top): Remove completion function for "sftp". Add completion
+ functions for "nc" and "psftp".
+ (tramp-do-copy-or-rename-file-out-of-band): Tweak docstring.
+ Implement support for "nc" method.
+ (tramp-sh-handle-expand-file-name, tramp-local-coding-commands)
+ (tramp-remote-coding-commands, tramp-call-local-coding-command):
+ Tweak docstring.
+ (tramp-sh-handle-write-region): Tweak error message.
+ (tramp-sh-handle-vc-registered): Remove backends when the remote
+ binary does not exist.
+ (tramp-find-inline-encoding): Do not raise an error.
+ (tramp-make-copy-program-file-name): Tweak docstring. Handle also
+ the "nc" case. Quote result also locally.
+
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-set-file-acl): Use `start-process'.
+ (tramp-smb-handle-insert-directory): Use progress reporter.
+ (tramp-smb-handle-rename-file): Flush also file properties of
+ FILENAME.
+
+ * net/trampver.el: Update release number.
+
+2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ses.el: Miscellaneous cleanups; use lexical-binding; avoid
+ add-to-list.
+ (ses-localvars): Remove ses--local-printer-list, unused.
+ (ses--metaprogramming): New macro. Use it to defvar variables.
+ (ses-set-localvars): Simplify.
+ (ses--locprn, ses-cell): Use defstruct. Change ses-cell's
+ property-list into an alist.
+ (ses-locprn-get-compiled, ses-locprn-compiled-aset)
+ (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number):
+ Remove; use defstruct accessors/setters instead.
+ (ses-cell-formula-aset, ses-cell-printer-aset)
+ (ses-cell-references-aset): Remove, use setf instead.
+ (ses--alist-get): New function.
+ (ses-cell-property): Rename from ses-cell-property-get and rewrite.
+ Use an alist instead of a plist and don't do move-to-front since the
+ list is always short.
+ (ses-cell-property-get-fun, ses-cell-property-delq-fun)
+ (ses-cell-property-set-fun, ses-cell-property-set)
+ (ses-cell-property-pop-fun, ses-cell-property-get-handle)
+ (ses-cell-property-handle-car, ses-cell-property-handle-setcar): Remove.
+ (ses--letref): New macro.
+ (ses-cell-property-pop): Rewrite.
+ (ses--cell): Rename from ses-cell and make it into a function.
+ Make `formula' fallback on `value' if nil.
+ (ses--local-printer): Rename from ses-local-printer and make it into
+ a function.
+ (ses-set-cell): Turn it into a macro so finding the accessor from the
+ field name is done at compile time.
+ (ses-repair-cell-reference-all): Test presence of `sym' rather than
+ `ref' before adding `sym' to :ses-repair-reference.
+ (ses-calculate-cell): Use ses--letref rather than
+ ses-cell-property-get-handle.
+ (ses-write-cells): Use a single prin1-to-string.
+ (ses-setter-with-undo): New function.
+ (ses-aset-with-undo, ses-set-with-undo): Rewrite using it.
+ (ses-unset-with-undo): Remove.
+ (ses-load): Prefer apply' over `eval'.
+ (ses-read-printer, ses-set-column-width): Use standard "(default
+ foo)" format.
+
+2014-06-15 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (leim, semantic): Use `make -C' rather than `cd && make'.
+
+ * progmodes/cc-langs.el: Require cl-lib. (Bug#17463)
+ Replace delete-duplicates and mapcan by cl- versions throughout.
+ And cl-macroexpand-all by macroexpand-all.
+ (delete-duplicates, mapcan, cl-macroexpand-all): No need to declare.
+
+2014-06-15 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (posn-col-row): Doc fix. (Bug#17768)
+
+2014-06-15 Juri Linkov <juri@jurta.org>
+
+ * bindings.el: Put `ascii-character' property on keypad keys
+ mapped to characters. (Bug#17759)
+
+2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-next-sexp): Fix up "other-end" info when
+ bumping forward into a closing paren (bug#17761).
+
+ * term/xterm.el (xterm--version-handler): Work around for OSX
+ Terminal.app (bug#17607).
+
+2014-06-14 Ron Schnell <ronnie@driver-aces.com>
+
+ * play/dunnet.el (dun-describe-room, dun-mode):
+ If a lamp is in the room, you won't be eaten by a grue.
+
+2014-06-13 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in ($(lisp)/cus-load.el, $(lisp)/finder-inf.el)
+ (autoloads, $(lisp)/subdirs.el, compile-main, leim, semantic, compile)
+ (compile-always): GNU make automatically passes
+ command-line arguments to sub-makes.
+
+ * calendar/calendar.el (calendar-generate-window):
+ Remove pointless call to font-lock-fontify-buffer.
+
+2014-06-13 Matthias Meulien <orontee@gmail.com>
+
+ * simple.el (completion-list-mode-map): Navigate with tab and backtab
+ (bug#17767).
+
+2014-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (set-mark-command): Simplify a bit.
+
+2014-06-12 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * help.el (help--key-binding-keymap): New function.
+ (help--binding-locus): New function.
+ (describe-key): Mention the keymap in which the binding was
+ found. (bug#13948)
+
+2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hippie-exp.el (he--all-buffers): New function.
+ (try-expand-line-all-buffers, try-expand-list-all-buffers)
+ (try-expand-dabbrev-all-buffers): Use it.
+
+2014-06-12 Emilio C. Lopes <eclig@gmx.net>
+
+ * hippie-exp.el (try-expand-line-all-buffers)
+ (try-expand-list-all-buffers, try-expand-dabbrev-all-buffers):
+ Read hippie-expand-only-buffers and hippie-expand-ignore-buffers in the
+ original buffer, in case they're buffer-local.
+
+2014-06-12 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ * ses.el (ses-initial-global-parameters-re): New defconst, a
+ specific regexp is needed now that ses.el can handle both
+ file-format 2 --- ie. no local printers --- and 3 --- i.e. may have
+ local printers.
+ (ses-localvars): Add local variables needed for local printer handling.
+ (ses-set-localvars): Handle hashmap initialization.
+ (ses-paramlines-plist): Add param-line for number of local printers.
+ (ses-paramfmt-plist): New defconst, needed for code factorization
+ between functions `ses-set-parameter' and
+ `ses-file-format-extend-paramter-list'
+ (ses-make-local-printer-info): New defsubst.
+ (ses-locprn-get-compiled, ses-locprn-compiled-aset)
+ (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number)
+ (ses-cell-printer-aset): New defmacro.
+ (ses-local-printer-compile): New defun.
+ (ses-local-printer): New defmacro.
+ (ses-printer-validate, ses-call-printer): Add support for local
+ printer functions.
+ (ses-file-format-extend-paramter-list): New defun.
+ (ses-set-parameter): Use const `ses-paramfmt-plist' for code
+ factorization.
+ (ses-load): Add support for local printer functions.
+ (ses-read-printer): Update docstring and add support for local printer
+ functions.
+ (ses-refresh-local-printer, ses-define-local-printer): New defun.
+ (ses-safe-printer): Add support for local printer functions.
+
+2014-06-12 Ivan Andrus <darthandrus@gmail.com>
+
+ * ffap.el (ffap-lax-url): New var (bug#17723).
+ (ffap-url-at-point): Use it.
+ (ffap-file-at-point): Avoid returning just "/".
+
+2014-06-12 Matthias Meulien <orontee@gmail.com>
+
+ * progmodes/python.el (import skeleton): New skeleton (bug#17672).
+ (python-mode-map): Bind it.
+
+ * progmodes/python.el (class skeleton): Don't erase last char of class
+ name (bug#17683).
+
+2014-06-12 Cameron Desautels <camdez@gmail.com> (tiny change)
+
+ * help.el (where-is): Use `default' arg of completing-read (bug#17705).
+
+2014-06-12 Kevin Ryde <user42_kevin@yahoo.com.au>
+
+ * files.el (auto-mode-alist): Map .ad files to xdefaults-mode
+ (bug#17745).
+
+2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-cmds.el: Use lexical-binding.
+ (ucs-names): Simplify.
+
+2014-05-18 Eric Hanchrow <eric.hanchrow@gmail.com>
+
+ * progmodes/python.el (run-python): Use read-shell-command.
+
+2014-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el: Make it possible to move bounds past EOL or into TABs.
+ (operate-on-rectangle): Use apply-on-rectangle.
+ (rectangle--mark-crutches): New var.
+ (rectangle--pos-cols, rectangle--col-pos, rectangle--point-col)
+ (rectangle--crutches, rectangle--reset-crutches): New functions.
+ (apply-on-rectangle): Obey crutches. Avoid setq.
+ Fix missing final iteration if end is at EOB&BOL.
+ (rectangle-mark-mode-map): Add remap bindings for
+ exchange-point-and-mark and char/line movements.
+ (rectangle--*-char): New function.
+ (rectangle-exchange-point-and-mark, rectangle-right-char)
+ (rectangle-left-char, rectangle-forward-char)
+ (rectangle-backward-char, rectangle-next-line)
+ (rectangle-previous-line): New commands.
+ (rectangle--place-cursor): New function.
+ (rectangle--highlight-for-redisplay): Use it. Use apply-on-rectangle.
+
+2014-06-08 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (initial-buffer-choice): Doc fix.
+ Reset :version (adding an option does not merit a :version bump).
+
+ * bookmark.el (bookmark-load):
+ * uniquify.el (uniquify-buffer-name-style): Doc fixes.
+
+2014-06-08 Juri Linkov <juri@jurta.org>
+
+ * desktop.el: Activate auto-saving on window configuration changes.
+ (desktop-save-mode, desktop-auto-save-timeout): Add/remove
+ `desktop-auto-save-set-timer' to/from
+ `window-configuration-change-hook'.
+ (desktop-auto-save-set-timer): Change REPEAT arg of
+ `run-with-idle-timer' from t to nil.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00147.html
+
+2014-06-08 Santiago Payà i Miralta <santiagopim@gmail.com>
+
+ * vc/vc-hg.el (vc-hg-working-revision): Use "hg parent" and
+ vc-hg-command (bug#17570).
+
+2014-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-cmds.el (ucs-names): Add special entry for BEL
+ (bug#17702).
+
+2014-06-08 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (window-setup-hook): Doc fix.
+
+ * emacs-lisp/package.el (package-check-signature)
+ (package-unsigned-archives): Doc fixes.
+
+2014-06-08 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-use-some-window): Don't make window
+ used smaller than it was before (Bug#17671).
+
+2014-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (menu-bar-open): Fix last change: use the PC
+ 'redisplay' instead of '(sit-for 0)'.
+
+2014-06-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-ssh-controlmaster-options):
+ Improve search regexp. (Bug#17653)
+
+2014-06-08 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (package-pinned-packages): Doc fix.
+
+2014-06-08 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (menu-bar-open): Fix invocation via M-x.
+
+2014-06-06 Santiago Payà i Miralta <santiagopim@gmail.com>
+
+ * vc/vc-hg.el (vc-hg-create-tag, vc-hg-retrieve-tag): New functions
+ (bug#17586).
+
+ * vc/vc-hg.el (vc-hg-log-graph): New var.
+ (vc-hg-print-log): Use it.
+ (vc-hg-root-log-format): Include branch name and bookmarks; ignore
+ graph output (bug#17515).
+
+2014-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse-posn-property): Ignore buffer position info when the
+ even happened elsewhere.
+
+2014-06-06 Mario Lang <mlang@delysid.org>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-print): Only call
+ `recenter' if `current-buffer' is equal to `window-buffer'.
+
+2014-06-05 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-macs.el (cl-macrolet): Avoid excessive progn's.
+
+2014-06-05 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/tildify.el (tildify-foreach-region-outside-env):
+ New function which calls a callback on portions of the buffer that are
+ outside of ignored environments.
+ (tildify-build-regexp): Remove function since it is now
+ incorporated in `tildify-foreach-region-outside-env' where it is
+ optimized and simplified by the use of `mapconcat'.
+ (tildify-tildify): Return number of substitutions made so that…
+ (tildify-count): …can be removed.
+ (tildify-find-env): Accept a new PAIRS argument which was
+ previously looked up in `tildify-ignored-environments-alist' each
+ time the function was called. With this change, the lookup is
+ performed only once in `tildify-foreach-region-outside-env'.
+ (tildify-region): Greatly simplify the function since now most of
+ the work is done by `tildify-foreach-region-outside-env'.
+ (tildify-mode-alist): Simplify slightly by avoiding if and setq
+ and instead using or.
+
+ * textmodes/tildify.el (tildify-ignored-environments-alist):
+ Optimize environments regexes
+
+ Each time beginning of an environment to ignore is found,
+ `tildify-find-env' needs to identify regexp for the ending
+ of the environment. This is done by trying all the opening
+ regexes on matched text in a loop, so to speed that up, this
+ loop should have fewer things to match, which can be done by
+ using alternatives in the opening regexes.
+
+ Coincidentally, this should make matching of the opening
+ regexp faster as well thanks to the use of `regexp-opt' and
+ having common prefix pulled from many regexes.
+
+ * textmodes/tildify.el (tildify-string-alist)
+ (tildify-ignored-environments-alist): Add `nxml-mode' to the list
+ of supported modes since `xml-mode' is no longer a thing but just
+ an alias to the former. Also include comments and insides of tags
+ in `tildify-ignored-environments-alist' for XML modes. Finally,
+ since XML does not define “&nbsp;”[1], use a numeric reference for
+ a no-break space (namely “&#160;”)
+
+ [1] XML specification defines only a handful of predefined entities.
+ The list is at <http://www.w3.org/TR/REC-xml/#sec-predefined-ent>
+ and includes only &lt;, &gt;, &amp;, &apos; and &quot; (meaning <,
+ >, &, ' and " respectively). This is in contrast to HTML and even
+ XHTML which defined a whole bunch of entities including “&nbsp;”.
+
+ * textmodes/tildify.el (tildify-pattern-alist)
+ (tildify-string-alist, tildify-ignored-environments-alist):
+ Improve defcustom's types by adding more tags explaining what each
+ value means and replace “sexp” used in
+ `tildify-ignored-environments-alist' with a full type declaration.
+
+ * textmodes/tildify.el (tildify-find-env): Fix matched group
+ indexes in end-regex building
+
+ When looking for a start of an ignore-environment, the regex is built
+ by concatenating regexes of all the environments configured in
+ `tildify-ignored-environments-alist'. So for example, the following
+ list could be used to match TeX's \verb and \verb* commands:
+
+ (("\\\\verb\\(.\\)" . (1))
+ ("\\\\verb\\*\\(.\\)" . (1)))
+
+ This would result in the following regex being used to find the start
+ of any of the variants of the \verb command:
+
+ \\\\verb\\(.\\)\\|\\\\verb\\*\\(.\\)
+
+ But now, if “\\\\verb\\*\\(.\\)” matches, the first capture group
+ won't match anything, and thus (match-string 1) will be nil, which
+ will cause building of the end-matching regex to fail.
+
+ Fix this by using capture groups from the time when the opening
+ regexes are matched individually.
+
+ * textmodes/tildify.el (tildify-find-env): Fix end-regex building
+ in `tildify-find-env'
+
+ The `tildify-ignored-environments-alist' allows the end-regex to
+ be provided not as a static string but mix of strings and indexes
+ of groups matched the begin-regex. For example, the “\verb!…!”
+ TeX-command (where “!” is an arbitrary character) is handled
+ using:
+
+ ("\\\\verb\\*?\\(.\\)" . (1))
+
+ In the same way, the following should be supported as well:
+
+ ("open-\\(.\\)" . ("end-" 1))
+
+ However the tildify-find-env function fails at
+
+ (concat result
+ (if (stringp (setq aux (car expression)))
+ expression ; BUG: expression is a list
+ (regexp-quote (match-string aux))))
+
+ where the string part is handled incorrectly.
+
+ The most trivial fix would be to replace `expression' in the
+ true-part of the if-statement with `aux', but instead, this commit
+ optimizes `tildify-find-env' by changing it to use `mapconcat'
+ rather than open-coded while-loop.
+
+2014-06-05 Mario Lang <mlang@delysid.org>
+
+ * woman.el (woman-mapcan): Remove.
+ (woman-parse-colon-path): Use cl-mapcan instead.
+
+2014-06-03 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * register.el: Add link to Emacs manual in Commentary.
+
+2014-06-02 Sam Steingold <sds@gnu.org>
+
+ * menu-bar.el (lookup-key-ignore-too-long): Extract from...
+ (popup-menu): ...here.
+ (menu-bar-open): Use it to avoid an error when `lookup-key'
+ returns a number.
+
+2014-06-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-call-process): Add traces.
+ (tramp-handle-unhandled-file-name-directory): Return "/".
+
+2014-06-02 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision 3cd8144.
+ * progmodes/verilog-mode.el (verilog-mode-version): Bump.
+ (verilog-auto-arg-format): New option, to support newlines in AUTOARG.
+ (verilog-type-font-keywords): Add nor.
+ (verilog-batch-execute-func): Force reading of Local Variables.
+ Fix printing "no changes to be saved" with verilog-batch.
+ (verilog-auto-arg-ports): Doc fix.
+ Add verilog-auto-arg-format to support newlines in AUTOARG.
+ (verilog-auto-arg): Doc fix.
+
+2014-06-02 Glenn Morris <rgm@gnu.org>
+
+ * emulation/crisp.el, emulation/tpu-edt.el, emulation/tpu-extras.el:
+ * emulation/tpu-mapper.el, emulation/vi.el, emulation/vip.el:
+ * emulation/ws-mode.el: Move to obsolete/.
+ * Makefile.in (AUTOGEN_VCS): Update for moved tpu-edu.el.
+
+2014-06-02 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (keyboard-quit): Force update of mode lines, to remove
+ the "Def" indicator, if we were defining a macro. (Bug#17615)
+
+2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-force-complete-and-exit):
+ Obey minibuffer-default (bug#17545).
+
+ * progmodes/js.el (js-indent-line): Don't mix columns and chars
+ (bug#17619).
+
+ * subr.el (set-transient-map): Don't wait for some "nested"
+ transient-map to finish if we're only supposed to be active for
+ the next command (bug#17642).
+
+2014-06-02 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/gv.el (window-buffer, window-display-table)
+ (window-dedicated-p, window-hscroll, window-point, window-start):
+ Fix gv-expander. (Bug#17630)
+
+2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse-posn-property): Ignore posn-point for mode-line
+ clicks (bug#17633).
+
+ * leim/quail/latin-pre.el ("latin-2-prefix"): Use ",," rather than ", "
+ for the single comma, since ", " is *very* common in normal French text
+ (bug#17643).
+
+2014-06-02 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (package-check-signature)
+ (package-unsigned-archives): Fix :version.
+
+2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (sit-for): Don't run input-methods (bug#15614).
+
+2014-06-02 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el: Fix some :version numbers.
+
+2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (deactivate-mark): Set mark-active to nil even if
+ deactivation is done via setting transient-mark-mode to nil,
+ since one is buffer-local and the other is global.
+
+ * emacs-lisp/byte-opt.el (byte-optimize-binary-predicate): Don't assume
+ there can't be more than 2 arguments (bug#17584).
+
+2014-06-02 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (filter-buffer-substring-functions)
+ (filter-buffer-substring-function, buffer-substring-filters)
+ (filter-buffer-substring, buffer-substring--filter): Doc fixes.
+
+ * minibuffer.el (completion-in-region-functions, completion-in-region)
+ (completion--in-region): Doc fixes.
+
+ * abbrev.el (abbrev-expand-functions, abbrev-expand-function)
+ (expand-abbrev, abbrev--default-expand): Doc fixes.
+
+2014-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Include sources used to create macuvs.h.
+ * international/README: Refer to the Unicode Terms of Use rather
+ than copying it bodily here, as that simplifies maintenance.
+
+2014-06-01 Glenn Morris <rgm@gnu.org>
+
+ * loadup.el (load-prefer-newer): Set non-nil when dumping. (Bug#17629)
+
+2014-05-31 Glenn Morris <rgm@gnu.org>
+
+ * files.el (locate-dominating-file): Expand file argument. (Bug#17641)
+
+2014-05-30 Glenn Morris <rgm@gnu.org>
+
+ * loadup.el: Treat `command-line-args' more flexibly.
+
+2014-05-30 Alan Mackenzie <acm@muc.de>
+
+ Guard (looking-at "\\s!") from XEmacs.
+ * progmodes/cc-engine.el (c-state-pp-to-literal): Add guard form.
+
+2014-05-30 Ken Olum <kdo@cosmos.phy.tufts.edu>
+
+ * mail/rmail.el (rmail-delete-forward, rmail-delete-backward):
+ The argument COUNT is now optional, to be more backward-compatible.
+ Doc fix. (Bug#17560)
+
+2014-05-29 Reuben Thomas <rrt@sc3d.org>
+
+ * whitespace.el (whitespace-report-region):
+ Simplify documentation.
+ (whitespace-report-region): Allow report-if-bogus to take the
+ value `never', for non-interactive use.
+ (whitespace-report): Refer to whitespace-report-region's
+ documentation.
+
+2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * whitespace.el: Use font-lock-flush. Minimize refontifications.
+ Side benefit: it works without jit-lock.
+ (whitespace-point--used): New buffer-local var.
+ (whitespace-color-on): Initialize it and flush it. Use font-lock-flush.
+ (whitespace-color-off): Use font-lock-flush.
+ (whitespace-point--used, whitespace-point--flush-used): New functions.
+ (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp)
+ (whitespace-empty-at-eob-regexp): Use them.
+ (whitespace-post-command-hook): Rewrite.
+
+ * font-lock.el (font-lock-flush, font-lock-ensure): New functions.
+ (font-lock-fontify-buffer): Mark interactive-only.
+ (font-lock-multiline, font-lock-fontified, font-lock-set-defaults):
+ Make buffer-local.
+ (font-lock-specified-p): Remove redundant boundp check.
+ (font-lock-flush-function, font-lock-ensure-function): New vars.
+ (font-lock-turn-on-thing-lock): Set them.
+ (font-lock-default-fontify-buffer): Obey font-lock-dont-widen.
+ (font-lock-after-change-function): Make `old-len' optional.
+ (font-lock-set-defaults): Remove redundant `set' of font-lock-defaults.
+ Call font-lock-flush, just in case.
+ * progmodes/verilog-mode.el (verilog-preprocess): Disable workaround in
+ recent Emacsen.
+ * progmodes/vera-mode.el (vera-fontify-buffer): Declare obsolete.
+ (vera-mode-map, vera-mode-menu): Remove bindings to it.
+ * progmodes/idlw-help.el (idlwave-help-fontify): Use font-lock-ensure
+ and with-syntax-table.
+ * textmodes/conf-mode.el (conf-quote-normal):
+ * progmodes/sh-script.el (sh-set-shell):
+ * progmodes/prog-mode.el (prettify-symbols-mode):
+ * progmodes/f90.el (f90-font-lock-n):
+ * progmodes/cwarn.el (cwarn-mode):
+ * nxml/nxml-mode.el (nxml-toggle-char-ref-extra-display):
+ * progmodes/compile.el (compilation-setup, compilation--unsetup):
+ * hi-lock.el (hi-lock-mode, hi-lock-unface-buffer)
+ (hi-lock-set-pattern, hi-lock-set-file-patterns): Use font-lock-flush.
+ * mail/rmail.el (rmail-variables): Set font-lock-dont-widen instead of
+ font-lock-fontify-buffer-function and
+ font-lock-unfontify-buffer-function.
+ (rmail-unfontify-buffer-function, rmail-fontify-message):
+ Use with-silent-modifications.
+ * htmlfontify.el (hfy-force-fontification): Use jit-lock-fontify-now
+ and font-lock-ensure.
+ * bs.el (bs-show-in-buffer): Use font-lock-ensure.
+
+2014-05-28 Thien-Thi Nguyen <ttn@gnu.org>
+
+ * emacs-lisp/package.el (package-generate-autoloads):
+ Inhibit backup files.
+
+2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/hideshow.el (hs-hide-all): Call syntax-propertize
+ (bug#17608).
+
+2014-05-21 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/tildify.el (tildify-buffer, tildify-region):
+ Add dont-ask option.
+
+2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (zerop): Move from C. Add compiler-macro (bug#17475).
+ * emacs-lisp/byte-opt.el (byte-optimize-zerop): Remove.
+
+ * subr.el (internal--funcall-interactively): New.
+ (internal--call-interactively): Remove.
+ (called-interactively-p): Detect funcall-interactively instead of
+ call-interactively.
+ * simple.el (repeat-complex-command): Use funcall-interactively.
+ (repeat-complex-command--called-interactively-skip): Remove.
+
+2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * register.el (register-read-with-preview): Don't burp on
+ frame switches (e.g. due to the frame we just popped).
+
+ * mouse.el (mouse-set-region): Handle spurious drag events (bug#17562).
+ (mouse-drag-track): Annotate `mouse-drag-start' so we know we moved.
+
+2014-05-26 Andreas Schwab <schwab@linux-m68k.org>
+
+ * cus-face.el (custom-face-attributes): Add :distant-foreground.
+
+2014-05-26 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--dump-frame): Remove interactive specification.
+
+2014-05-26 Glenn Morris <rgm@gnu.org>
+
+ * hippie-exp.el (he-line-search-regexp):
+ Handle comint-prompt-regexp containing subgroups. (Bug#17529)
+
+2014-05-26 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Remove dependence on auto-mode-alist,
+ to avoid errors when trying to create or visit a file foo.todo
+ located outside to todo-directory, and to allow having such files
+ without them being tied to Todo mode (bug#17482).
+ (todo-show, todo-move-category, todo-merge-category, todo-find-archive)
+ (todo-archive-done-item, todo-find-filtered-items-file)
+ (todo-filter-items, todo-find-item, todo-diary-goto-entry)
+ (todo-category-completions, todo-read-category): When visiting a
+ Todo file, make sure we're in the right mode and the buffer local
+ variables are set.
+ (todo-make-categories-list, todo-reset-nondiary-marker)
+ (todo-reset-done-string, todo-reset-comment-string):
+ After processing all Todo files, kill the buffers of those files that
+ weren't being visited before the processing.
+ (todo-display-as-todo-file, todo-add-to-buffer-list)
+ (todo-visit-files-commands): Comment out.
+ (todo-modes-set-3, todo-mode): Comment out additions to find-file-hook.
+ (auto-mode-alist): Remove add-to-list calls making Todo file
+ extensions unrestrictedly tied to Todo modes.
+
+2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--member-p): Change second arg.
+ (advice-function-member-p): Tell it to check both names and functions
+ (bug#17531).
+ (advice--add-function): Adjust call accordingly.
+
+2014-05-26 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Miscellaneous bug fixes.
+ (todo-delete-file): When deleting an archive but not its todo
+ file, make sure to update the todo file's category sexp.
+ (todo-move-category): Keep the moved category's name unless the
+ file moved to already has a category with that name. If the
+ numerically last category of the source file was moved, make the
+ first category current to avoid selecting a nonexistent category.
+ (todo-merge-category): Fix implementation to make merging to a
+ category in another file work as documented. Eliminate now
+ insufficient and unnecessary renaming of archive category, correct
+ document string accordingly, and clarify it. If the numerically
+ last category of the source file was merged, make the first
+ category current to avoid selecting a nonexistent category.
+ (todo-archive-done-item): When there are marked items and point
+ happens to be on an unmarked item, ignore the latter. Don't leave
+ point below last item after archiving marked items.
+ (todo-unarchive-items): Fix logic to ensure unarchiving an item
+ from an archive with only one category deletes the archive only
+ when the category is empty after unarchiving. Make sure the todo
+ file's category sexp is updated.
+ (todo-read-file-name): Allow an existing file name even when it is
+ not required (todo-move-category needs this to work as documented).
+ (todo-add-file): Call todo-validate-name to reject the name of an
+ existing todo file (needed due to fix in todo-read-file-name).
+ (todo-reset-nondiary-marker): Also reset in filtered items files.
+ (todo-reset-done-string, todo-reset-comment-string): Also reset in
+ regexp filtered items files.
+ (todo-reset-highlight-item): Also reset in filtered items files.
+ Fix incorrect variable reference in document string.
+
+2014-05-26 Glenn Morris <rgm@gnu.org>
+
+ * window.el (window--dump-frame): Avoid error in --without-x builds.
+
+2014-05-26 Glenn Morris <rgm@gnu.org>
+
+ * nxml/nxml-mode.el (xml-mode): Only define this alias once.
+
+2014-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (set-frame-font): Doc fix.
+
+ * menu-bar.el (menu-set-font): Doc fix. (Bug#17532)
+
+2014-05-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package--download-one-archive):
+ Use `write-region' instead of `save-buffer' to avoid running various
+ hooks. (Bug#17155)
+ (describe-package-1): Same. Insert newline at the end of the
+ buffer if appropriate.
+
+2014-05-26 Juri Linkov <juri@jurta.org>
+
+ * avoid.el (mouse-avoidance-set-mouse-position): Don't raise frame.
+ (mouse-avoidance-ignore-p): Remove `switch-frame', add `focus-out'.
+ Add more modifiers: meta, control, shift, hyper, super, alt.
+ (Bug#17439)
+
+ * avoid.el (mouse-avoidance-banish-position): Fix defcustom :options
+ to allow changing its value with `set-variable'.
+
+2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/scheme.el (scheme-mode-syntax-table): Remove hack for
+ #; comments.
+ (scheme-syntax-propertize, scheme-syntax-propertize-sexp-comment):
+ New functions.
+ (scheme-mode-variables): Set syntax-propertize-function instead of
+ font-lock-syntactic-face-function.
+ (scheme-font-lock-syntactic-face-function): Delete.
+
+ * emacs-lisp/lisp.el (end-of-defun): Ensure we move (bug#17274).
+
+ * emacs-lisp/timer.el (timer-event-handler): Don't run if canceled
+ (bug#17392).
+
+2014-05-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-find-inline-encoding): Do not match "%%t"
+ for a temporary file name.
+
+2014-05-26 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-ignore-invisible): Doc fix. (Bug#17511)
+
+2014-05-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-init-bus, dbus-call-method)
+ (dbus-call-method-asynchronously, dbus-send-signal)
+ (dbus-method-return-internal, dbus-method-error-internal):
+ Check, whether Emacs has been compiled with D-Bus support. (Bug#17508)
+
+2014-05-26 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * emacs-lisp/eieio-opt.el (eieio-help-class): Correctly deal with
+ methods which do not have a doc string. (Bug#17490)
+
+2014-05-25 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-ref.el (reftex-format-special): Make it work
+ also for AMS Math's \eqref macro.
+
+2014-05-25 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Arrange to never byte-compile the generated -pkg.el file.
+
+ * emacs-lisp/package.el (package-generate-description-file):
+ Output first-line comment to set buffer-local var `no-byte-compile'.
+ Suggested by Dmitry Gutov:
+ <http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00401.html>.
+
+2014-05-25 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Fix bug: Properly quote args to generated -pkg.el `define-package'.
+
+ * emacs-lisp/package.el (package-generate-description-file):
+ Inline `package--alist-to-plist'; rewrite to selectively
+ quote alist values that are not self-quoting.
+ (package--alist-to-plist): Delete func.
+
+2014-05-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ * term/xterm.el (xterm-function-map): Add mapping for shifted
+ keypad keys.
+
+2014-05-24 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/subword.el (subword-find-word-boundary): Move point to
+ correct spot before search. (Bug#17580)
+
+ * emacs-lisp/nadvice.el (defun): Write in eval-and-compile to avoid
+ breaking the build.
+
+2014-05-24 Leo Liu <sdl.web@gmail.com>
+
+ * calc/calc.el (math-bignum): Handle most-negative-fixnum. (Bug#17556)
+
+2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--sreverse): Remove.
+ (completion--common-suffix): Use `reverse' instead.
+ * emacs-lisp/regexp-opt.el (regexp-opt-group): Use `reverse' on strings.
+
+2014-05-22 Glenn Morris <rgm@gnu.org>
+
+ * shell.el (shell-mode) <shell-dirstack-query>: Bypass bash aliases.
+
+2014-05-21 Daniel Colascione <dancol@dancol.org>
+
+ * files.el (interpreter-mode-alist): Add mksh.
+
+ * progmodes/sh-script.el (sh-ancestor-alist): Add mksh, a pdksh
+ derivative.
+ (sh-alias-alist): Alias /system/bin/sh (Android's system shell) to
+ mksh. Improve custom spec; allow regular expressions.
+ (sh-shell): Delegate name splitting to `sh-canonicalize-shell'.
+ (sh-after-hack-local-variables): New function.
+ (sh-mode): Use it; respect file-local `sh-shell' variable. (Bug#17333)
+ (sh-set-shell): Use `sh-canonicalize-shell' instead of open-coding
+ the normalization.
+ (sh-canonicalize-shell): Rewrite to support regexes.
+
+2014-05-21 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-lib.el (cl-endp): Fix last change.
+
+2014-05-19 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-lib.el (cl-endp): Conform to CL's semantics.
+
+2014-05-18 Glenn Morris <rgm@gnu.org>
+
+ * loadup.el:
+ * play/gametree.el: `track-mouse' is always defined since 2012-11-24.
+
+2014-05-14 Sam Steingold <sds@gnu.org>
+
+ * progmodes/python.el (python-shell-get-or-create-process):
+ Do not bind `current-prefix-arg' so that C-c C-z does not talk
+ back unless requested.
+
+2014-05-14 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (with-file-modes): New macro.
+ * printing.el (pr-save-file-modes): Make obsolete.
+ * eshell/esh-util.el (eshell-with-file-modes): Make obsolete.
+ * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
+ Add with-file-modes.
+ * doc-view.el (doc-view-make-safe-dir):
+ * epg.el (epg--start):
+ * files.el (locate-user-emacs-file, make-temp-file)
+ (backup-buffer-copy, move-file-to-trash):
+ * printing.el (pr-despool-print, pr-call-process, pr-text2ps):
+ * eshell/esh-util.el (eshell-with-private-file-modes)
+ (eshell-make-private-directory):
+ * net/browse-url.el (browse-url-mosaic):
+ * obsolete/mailpost.el (post-mail-send-it):
+ * obsolete/pgg-pgp.el (pgg-pgp-verify-region):
+ * obsolete/pgg-pgp5.el (pgg-pgp5-verify-region):
+ Use with-file-modes.
+
+ * vc/emerge.el (emerge-make-temp-file): Simplify.
+
+2014-05-14 Stephen Berman <stephen.berman@gmx.net>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-pcm--merge-try): Merge trailing / with
+ suffix (bug#15419).
+
+2014-05-14 Glenn Morris <rgm@gnu.org>
+
+ * vc/emerge.el (emerge-temp-file-prefix):
+ Make pointless option obsolete.
+ (emerge-temp-file-mode): Make non-functional option obsolete.
+
+2014-05-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/browse-url.el (browse-url):
+ Use `unhandled-file-name-directory' when setting `default-directory',
+ in order to circumvent stalled remote connections. (Bug#17425)
+
+2014-05-14 Glenn Morris <rgm@gnu.org>
+
+ * printing.el (subst-char-in-string, make-temp-file, pr-get-symbol):
+ Optimize on Emacs, which has the relevant functions for ages.
+
+2014-05-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (undo-make-selective-list): Obey undo-no-redo.
+
+2014-05-12 Sam Steingold <sds@gnu.org>
+
+ * calendar/time-date.el (seconds-to-string): New function to
+ pretty print time delay in seconds.
+
+2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el (mpc-format): Trim Date to the year.
+ (mpc-songs-hashcons): Shorten the Date field.
+
+ * emacs-lisp/nadvice.el (advice--interactive-form): Don't get fooled
+ into autoloading just because of a silly indirection.
+
+2014-05-12 Santiago Payà i Miralta <santiagopim@gmail.com>
+
+ * vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454)
+
+2014-05-12 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/find-gc.el: Move to ../admin.
+
+ * printing.el (pr-version):
+ * ps-print.el (ps-print-version): Also mention bug-gnu-emacs.
+
+ * net/browse-url.el (browse-url-mosaic):
+ Create /tmp/Mosaic.PID as a private file.
+
+2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Support adding a given function multiple times.
+ (advice--member-p): If name is given, only compare the name.
+ (advice--remove-function): Don't stop at the first match.
+ (advice--normalize-place): New function.
+ (add-function, remove-function): Use it.
+ (advice--add-function): Pass the name, if any, to
+ advice--remove-function.
+
+2014-05-12 Philipp Rumpf <prumpf@gmail.com> (tiny change)
+
+ * electric.el (electric-indent-post-self-insert-function): Don't use
+ `pos' after modifying the buffer (bug#17449).
+
+2014-05-12 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-insert-item-from-calendar):
+ Correct argument list to conform to todo-insert-item--basic.
+
+2014-05-12 Glenn Morris <rgm@gnu.org>
+
+ * files.el (cd-absolute): Test if directory is accessible
+ rather than executable. (Bug#17330)
+
+ * progmodes/compile.el (recompile):
+ Handle C-u M-x recompile from a non-compilation buffer. (Bug#17444)
+
+ * net/browse-url.el (browse-url-mosaic):
+ Be careful when writing /tmp/Mosaic.PID. (Bug#17428)
+ This is CVE-2014-3423.
+
+2014-05-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el: Use the normal toplevel loop while dragging.
+ (mouse-set-point): Handle multi-clicks.
+ (mouse-set-region): Handle multi-clicks for drags.
+ (mouse-drag-region): Update call accordingly.
+ (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack.
+ Use the normal event loop instead of a local while/read-event loop.
+ (global-map): Remove redundant bindings for double/triple-mouse-1.
+ * xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time.
+ Generate synthetic down events when the protocol only sends up events.
+ (xterm-mouse-last): Remove.
+ (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down
+ terminal parameter instead.
+ (xterm-mouse--set-click-count): New function.
+ (xterm-mouse-event): Detect/generate double/triple clicks.
+ * reveal.el (reveal-close-old-overlays): Don't close while dragging.
+
+ * info.el (Info-quoted): New face.
+ (Info-mode-font-lock-keywords): New var.
+ (Info-mode): Use it.
+
+ * emacs-lisp/lisp-mode.el (preceding-sexp): Exclude leading "," which
+ are a hindrance for C-x C-e.
+
+2014-05-11 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-sentinel): Fix last change.
+
+2014-05-08 Sam Steingold <sds@gnu.org>
+
+ * net/rcirc.el (rcirc-reconnect-delay): New user option.
+ (rcirc-sentinel): Auto-reconnect to the server if
+ `rcirc-reconnect-delay' is non-0 (but not more often than its
+ value in case the host is off-line).
+
+2014-05-09 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/grep.el (lgrep): Fix a typo in last commit.
+
+2014-05-09 Glenn Morris <rgm@gnu.org>
+
+ * files.el (file-expand-wildcards):
+ * man.el (Man-support-local-filenames):
+ * printing.el (pr-i-directory, pr-interface-directory):
+ * progmodes/grep.el (lgrep, rgrep):
+ * textmodes/ispell.el (ispell-call-process)
+ (ispell-call-process-region, ispell-start-process)
+ (ispell-init-process): Use file-accessible-directory-p.
+
+2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * xt-mouse.el: Drop spurious/oddly shaped events (bug#17378).
+ (xterm-mouse--read-event-sequence-1000): Return nil if something
+ looks fishy.
+ (xterm-mouse-event): Propagate it.
+ (xterm-mouse-translate-1): Handle it.
+
+2014-05-08 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-insert-item--apply-args): When all
+ four slots of the parameter list are filled, make sure to pass it
+ to the argument list of todo-insert-item--basic.
+
+2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-compute-transaction): Topological sort.
+ Add optional `seen' argument to detect and break infinite loops.
+
+2014-05-08 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/find-gc.el (find-gc-unsafe, find-unsafe-funcs)
+ (trace-unsafe, trace-use-tree): Make parentheses style be
+ according to Emacs style.
+
+2014-05-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-remote-process-environment):
+ Remove HISTFILE and HISTSIZE; it's too late to set them here.
+ Add :version entry.
+ (tramp-open-shell): Do not let-bind `tramp-end-of-output'.
+ Add "HISTFILE=/dev/null" to the shell's env arguments. Do not send
+ extra "PSx=..." commands.
+ (tramp-maybe-open-connection): Setenv HISTFILE to /dev/null.
+ (Bug#17295)
+
+ (tramp-uudecode): Replace the hard-coded temporary file name by a
+ format specifier.
+ (tramp-remote-coding-commands): Enhance docstring.
+ (tramp-find-inline-encoding): Replace "%t" by a temporary file
+ name. (Bug#17415)
+ This is CVE-2014-3424.
+
+2014-05-08 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value.
+ (find-gc-source-files): Update some names.
+ (trace-call-tree): Simplify and update.
+ Avoid predictable temp-file names. (http://bugs.debian.org/747100)
+ This is CVE-2014-3422.
+
+2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion--try-word-completion): Revert fix for
+ Bug#15980 (bug#17375).
+
+ * xt-mouse.el (xterm-mouse--read-event-sequence-1000): (bug#17378)
+ Always store button numbers in the same way in xterm-mouse-last;
+ Don't burp is xterm-mouse-last is not set as expected.
+ Never return negative indices.
+
+2014-05-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
+ Backtrack one char if the global/char-literal var matcher hits
+ inside a string. The next char could be the beginning of an
+ expression expansion.
+
+2014-05-08 Glenn Morris <rgm@gnu.org>
+
+ * help-fns.el (describe-function-1): Test for an autoload before a
+ macro, since `macrop' works on autoloads. (Bug#17410)
+
+2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-functions-without-reindent): Add yaml.
+
+ * minibuffer.el (completion-table-with-quoting) <completion--unquote>:
+ Make sure the new point we return is within the new string (bug#17239).
+
+2014-05-05 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Port `gnu' pattern to rx.
+
+2014-05-05 Jarek Czekalski <jarekczek@poczta.onet.pl>
+
+ Remove unneeded prompt when closing a buffer with active
+ emacsclient ("Buffer ... still has clients"), #16548.
+ * server.el (server-start): Remove the only call to:
+ (server-kill-buffer-query-function): Remove.
+
+2014-05-04 Leo Liu <sdl.web@gmail.com>
+
+ * calendar/diary-lib.el (calendar-chinese-month-name-array):
+ Defvar to pacify compiler.
+
+2014-05-04 Eli Zaretskii <eliz@gnu.org>
+
+ * mail/rmailsum.el (rmail-new-summary-1): Fix a typo in a comment.
+
+2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer):
+ Use nil rather than `default' for the "default" appearance (bug#17388).
+ * vc/ediff-util.el (ediff-inferior-compare-regions)
+ (ediff-toggle-autorefine, ediff-unselect-difference): Don't use
+ a misleading `default' value when it's really a boolean.
+ * vc/ediff-init.el (ediff-set-overlay-face): Don't set help-echo if the
+ overlay is not visible.
+
+2014-05-04 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-edit-file): Use display-warning.
+ (todo-menu): Uncomment and update.
+
+2014-05-04 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Reimplement item editing to have the same
+ basic user interface as item insertion, and make small UI and
+ larger internal improvements to the latter.
+ (todo-insert-item): Add reference to the Todo mode user manual to
+ the documentation string.
+ (todo-insert-item--basic): Rename from todo-basic-insert-item and
+ adjust all callers. Change signature to combine diary and
+ nonmarking arguments. Incorporate functionality of deleted item
+ copying command and add error checking. Remove detailed
+ descriptions of the arguments from the documentation string, since
+ this is treated in the Todo mode user manual.
+ (todo-copy-item, todo-edit-multiline-item)
+ (todo-edit-done-item-comment, todo-edit-item-header)
+ (todo-edit-item-time, todo-edit-item-date-from-calendar)
+ (todo-edit-item-date-to-today, todo-edit-item-date-day-name)
+ (todo-edit-item-date-year, todo-edit-item-date-month)
+ (todo-edit-item-date-day, todo-edit-item-diary-nonmarking):
+ Remove.
+ (todo-edit-item): Reimplement as wrapper command for
+ todo-edit-item--next-key and make it distinguish done and not done
+ todo items.
+ (todo-edit-item--text): New function, replacing old command
+ todo-edit-item and incorporating deleted commands
+ todo-edit-multiline-item and todo-edit-done-item-comment.
+ (todo-edit-item--header): Rename from todo-basic-edit-item-header.
+ Use only numeric value of prefix argument. Remove detailed
+ descriptions of the arguments from the documentation string, since
+ this is treated in the Todo mode user manual.
+ (todo-edit-item--diary-inclusion): New function, replacing old
+ command todo-edit-item-diary-inclusion and incorporating and fixing
+ functionality of deleted command todo-edit-item-diary-nonmarking,
+ making sure to remove todo-nondiary-marker when adding
+ diary-nonmarking-symbol.
+ (todo-edit-category-diary-inclusion): Make sure to delete
+ diary-nonmarking-symbol when adding todo-nondiary-marker.
+ (todo-edit-category-diary-nonmarking): Fix indentation.
+ (todo-insert-item--parameters): Group diary and nonmarking
+ parameters together.
+ (todo-insert-item--apply-args): Adjust to signature of
+ todo-insert-item--basic and incorporate copy parameter.
+ Make small code improvements.
+ (todo-insert-item--next-param): Improve prompt and adjust it to
+ new parameter grouping. Remove obsolete code.
+ (todo-edit-item--param-key-alist)
+ (todo-edit-item--date-param-key-alist)
+ (todo-edit-done-item--param-key-alist): New defconsts.
+ (todo-edit-item--prompt): New variable.
+ (todo-edit-item--next-key): New function.
+ (todo-key-bindings-t): Bind "e" to todo-edit-item.
+ Remove bindings of deleted commands.
+
+2014-05-04 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/cl-macs.el (cl-deftype): Fix indentation.
+
+2014-05-04 Glenn Morris <rgm@gnu.org>
+
+ * allout-widgets.el (allout-widgets-tally)
+ (allout-decorate-item-guides):
+ * menu-bar.el (menu-bar-positive-p):
+ * minibuffer.el (completion-pcm-complete-word-inserts-delimiters):
+ * progmodes/gdb-mi.el (gdbmi-same-start, gdbmi-is-number):
+ * progmodes/js.el (js--inside-param-list-p)
+ (js--inside-dojo-class-list-p, js--forward-destructuring-spec):
+ * progmodes/prolog.el (region-exists-p):
+ * progmodes/verilog-mode.el (verilog-scan-cache-ok-p):
+ * textmodes/reftex-parse.el (reftex-using-biblatex-p):
+ Doc fixes (replace `iff').
+
+2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el (mpc-volume-mouse-set): Don't burp at the boundaries.
+
+2014-05-04 Leo Liu <sdl.web@gmail.com>
+
+ Support Chinese diary entries in calendar and diary. (Bug#17393)
+ * calendar/cal-china.el (calendar-chinese-month-name-array): New var.
+ (calendar-chinese-from-absolute-for-diary)
+ (calendar-chinese-to-absolute-for-diary)
+ (calendar-chinese-mark-date-pattern, diary-chinese-mark-entries)
+ (diary-chinese-list-entries): New functions to list and mark
+ Chinese diary entries in the calendar window.
+ (diary-chinese-anniversary)
+ (diary-chinese-insert-anniversary-entry)
+ (diary-chinese-insert-entry, diary-chinese-insert-monthly-entry)
+ (diary-chinese-insert-yearly-entry): New commands to insert
+ Chinese diary entries.
+
+ * calendar/diary-lib.el (diary-font-lock-keywords):
+ Support font-locking Chinese dates.
+
+ * calendar/cal-menu.el (cal-menu-diary-menu): Add entries for
+ inserting Chinese diary entries.
+
+ * calendar/calendar.el (diary-chinese-entry-symbol):
+ New customizable variable.
+ (calendar-mode-map): Add bindings for inserting Chinese diary
+ entries.
+
+2014-05-03 Juri Linkov <juri@jurta.org>
+
+ * dired.el (dired-check-switches, dired-switches-recursive-p):
+ New functions. (Bug#17218)
+ (dired-switches-escape-p, dired-move-to-end-of-filename):
+ Use `dired-check-switches'.
+ (dired-insert-old-subdirs, dired-build-subdir-alist)
+ (dired-sort-R-check): Use `dired-switches-recursive-p'.
+
+2014-05-01 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * simple.el (undo-make-selective-list): New algorithm fixes
+ incorrectness of position adjustments when undoing in region.
+ (Bug#17235)
+ (undo-elt-crosses-region): Make obsolete.
+ (undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos):
+ New functions to adjust positions using undo-deltas.
+
+2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past
+ the last consecutive closing paren (bug#17345).
+
+2014-04-30 Reuben Thomas <rrt@sc3d.org>
+
+ * dired.el (dired-mode): make terminology for eXpunge command
+ consistent. (Bug#17276)
+
+2014-04-30 Eli Zaretskii <eliz@gnu.org>
+
+ * dired.el (dired-initial-position-hook, dired-initial-position):
+ Doc string fixes.
+
+2014-04-30 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmail.el (rmail-quit): Handle killed summaries. (Bug#17283)
+
+2014-04-30 Matthias Dahl <matthias.dahl@binary-island.eu>
+
+ * faces.el (face-spec-recalc): Apply X resources only after the
+ defface spec has been applied. Thus, X resources are no longer
+ overriden by the defface spec which also fixes issues on win32 where
+ the toolbar coloring was wrong because it is set through X resources
+ and was (wrongfully) overriden. (Bug#16694)
+
+2014-04-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/rst.el (electric-pair-pairs): Declare.
+ (rst-mode): Set it (bug#17131).
+
+2014-04-30 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-value-to-string): Let-bind `print-length'
+ and `print-level' to nil. (Bug#17351)
+
+2014-04-30 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * battery.el (battery-update): Handle the case where battery
+ status is "N/A" (bug#17319).
+
+2014-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ps-mode.el: Use SMIE. Move string and comment recognition
+ to syntax-propertize.
+ (ps-mode-auto-indent): Mark as obsolete.
+ (ps-mode-font-lock-keywords-1): Remove string-or-comment handling.
+ (ps-mode-font-lock-keywords-3): Use symbol regexp operators instead of
+ word regexp operators.
+ (ps-mode-map): Move initialization into declaration. Remove binding
+ for TAB, RET, >, ], and }.
+ (ps-mode-syntax-table): Move initialization into declaration.
+ Don't give word syntax to non-word chars.
+ (ps-run-mode-map): Move initialization into declaration.
+ (ps-mode-menu-main): Remove auto-indent entry.
+ (ps-mode-smie-rules): New function.
+ (ps-mode): Setup smie, syntax-propertize, and electric-indent-mode.
+ (ps-mode-looking-at-nested, ps-mode-match-string-or-comment): Remove.
+ (ps-mode--string-syntax-table): New const.
+ (ps-mode--syntax-propertize-special, ps-mode-syntax-propertize):
+ New functions.
+ (ps-mode-newline, ps-mode-tabkey, ps-mode-r-brace, ps-mode-r-angle)
+ (ps-mode-r-gt, ps-mode-r-balance): Remove functions.
+
+2014-04-27 Daniel Colascione <dancol@dancol.org>
+
+ * term/xterm.el (xterm-paste): Use large finite timeout when
+ reading event to avoid putting keys in this-command-keys.
+
+2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl--syntax-exp-intro-regexp): New var.
+ (perl-syntax-propertize-function): Use it. Extend handling of
+ here-docs to the unquoted case.
+
+2014-04-25 Eli Zaretskii <eliz@gnu.org>
+
+ * tooltip.el (tooltip-show-help-non-mode, tooltip-show-help):
+ Use equal-including-properties to compare help-echo strings (bug#17331).
+
+2014-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table):
+ Fix syntax for @. (Bug#17325)
+
+2014-04-25 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl.el (gv): Require gv early to break eager
+ macro-expansion cycles.
+
+2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (region-active-p): Check there's a mark (bug#17324).
+
+ * simple.el (completion-list-mode-map): Use choose-completion for the
+ mouse binding as well (bug#17302).
+ (completion-list-mode, completion-setup-function): Adjust docstring and
+ echo area message accordingly.
+ * progmodes/idlwave.el (idlwave-choose-completion): Adjust to new
+ calling convention of choose-completion.
+ * comint.el (comint-dynamic-list-completions):
+ * term.el (term-dynamic-list-completions): Accept choose-completion.
+
+ * progmodes/perl-mode.el (perl-syntax-propertize-function): Slash after
+ &, |, +, - and * can't be a division (bug#17317).
+
+ * term/xterm.el (xterm--version-handler): Don't use modern xterm
+ features on gnome-terminal (bug#16988).
+
+2014-04-25 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Improve Scheme font-locking for (define ((foo ...) ...) ...).
+
+ * progmodes/scheme.el (scheme-font-lock-keywords-1): To find
+ the declared object, ignore zero or more parens, not zero or one.
+
+2014-04-24 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/xscheme.el (xscheme-expressions-ring)
+ (xscheme-expressions-ring-yank-pointer, xscheme-running-p)
+ (xscheme-control-g-disabled-p, xscheme-process-filter-state)
+ (xscheme-allow-output-p, xscheme-prompt)
+ (xscheme-string-accumulator, xscheme-mode-string): Use defvar-local.
+
+ * progmodes/scheme.el (would-be-symbol, next-sexp-as-string):
+ Comment out unused functions.
+
+2014-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * info.el: Use lexical-binding and cl-lib.
+ Use defvar-local and setq-local instead of make-local-variable.
+ (Info-apropos-matches): Avoid add-to-list.
+ (Info-edit-mode-map): Fix obsolescence call to Info-edit-map.
+
+2014-04-24 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/sh-script.el (sh-builtins): Add coproc to list of bash builtins.
+
+2014-04-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--loop-let): Fix last merge.
+
+2014-04-22 Michael Heerdegen <michael_heerdegen@web.de>
+
+ * dired.el (dired-insert-set-properties): Do not consider
+ subdirectory headings and empty lines to be information that
+ `dired-hide-details-mode' should hide. (Bug#17228)
+
+2014-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-name-all-completions):
+ Remove test messages.
+ (tramp-do-copy-or-rename-file-out-of-band): Do not quote `source'
+ and `target' twice.
+
+2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dframe.el (dframe-get-focus): Remove `hook' argument (bug#17311).
+ * speedbar.el (speedbar-get-focus): Run the "hook" afterwards instead.
+
+ * emacs-lisp/cl-macs.el (cl--loop-let): Avoid `nil' as var name.
+
+2014-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-name-all-completions):
+ Set "IFS=" when using read builtin, in order to preserve spaces in
+ the file name. Add test messages for hunting a bug on hydra.
+ (tramp-get-ls-command): Undo using "-b" argument. It doesn't help.
+
+2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/prog-mode.el (prettify-symbols--compose-symbol):
+ Don't prettify a word within a symbol.
+
+2014-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-get-ls-command): Use "-b" argument if
+ possible.
+
+2014-04-22 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/byte-run.el (function-put): Unbreak build: don't
+ use defun to define `function-put'.
+
+2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): New function.
+ (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords-2): Use it.
+ (lisp-mode-variables): Set font-lock-extra-managed-props.
+
+ * emacs-lisp/byte-run.el (function-put): New function.
+ (defun-declarations-alist): Use it. Add `pure' and `side-effect-free'.
+ * emacs-lisp/cl-macs.el (cl-defstruct, cl-struct-sequence-type)
+ (cl-struct-slot-info, cl-struct-slot-offset, cl-struct-slot-value):
+ Use them.
+
+2014-04-22 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/macroexp.el (internal-macroexpand-for-load):
+ Add `full-p' parameter; when nil, call `macroexpand' instead of
+ `macroexpand-all'.
+
+ * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile):
+ Improve docstrings.
+
+ * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
+ Use lambda function values, not quoted lambdas.
+ (byte-compile-recurse-toplevel): Remove extraneous &optional.
+
+ * emacs-lisp/cl-macs.el
+ (cl-struct-sequence-type, cl-struct-slot-info): Declare pure.
+ (cl-struct-slot-value): Conditionally use aref or nth so that the
+ compiler produces optimal code.
+
+2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure.
+ (inline): Don't inline cl--set-elt.
+ (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro.
+ Define as inlinable instead.
+ (cl-struct-set-slot-value): Remove.
+
+ * emacs-lisp/cl-lib.el (cl--set-elt): Remove.
+ * emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute):
+ Use setf instead.
+
+2014-04-21 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the
+ last two parameters after all.
+ (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member)
+ (cl--compiler-macro-assoc,cl-struct-slot-value)
+ (cl-struct-set-slot-value): Stop using them.
+
+(2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * image-mode.el (image-mode-window-put): Don't assume there's a `t'
+ entry in image-mode-winprops-alist.
+
+2014-04-21 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New function.
+ (byte-compile-recurse-toplevel, byte-compile-initial-macro-environment)
+ (byte-compile-toplevel-file-form): Use it.
+
+ * emacs-lisp/cl-macs.el:
+ (cl--loop-let): Properly destructure `while' clauses.
+
+2014-04-20 Daniel Colascione <dancol@dancol.org>
+
+ * vc/vc.el (vc-root-dir): New public autoloaded function for
+ generically finding the current VC root.
+ * vc/vc-hooks.el (vc-not-supported): New error.
+ (vc-call-backend): Signal `vc-not-supported' instead of generic error.
+
+2014-04-20 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type
+ argument.
+ (cl--const-expr-val): cl--const-expr-val should macroexpand its
+ argument in case we're inside a symbol-macrolet.
+ (cl--do-arglist, cl--compiler-macro-typep)
+ (cl--compiler-macro-member, cl--compiler-macro-assoc): Pass macro
+ environment to `cl--const-expr-val'.
+ (cl-struct-sequence-type,cl-struct-slot-info)
+ (cl-struct-slot-offset, cl-struct-slot-value)
+ (cl-struct-set-slot-value): New functions.
+
+2014-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable
+ assignments such as "case=hello" (bug#17297).
+
+2014-04-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-run-real-handler, tramp-file-name-handler):
+ Do not autoload.
+ (tramp-file-name-handler, tramp-completion-file-name-handler):
+ Revert patch from 2014-04-10, it isn't necessary anymore.
+ (tramp-autoload-file-name-handler)
+ (tramp-register-autoload-file-name-handlers): New defuns.
+ (top): Autoload call of `tramp-register-autoload-file-name-handlers'.
+ (tramp-register-file-name-handlers): Remove also
+ `tramp-autoload-file-name-handler' from `file-name-handler-list'.
+ Do not autoload its invocation, but eval it after loading of 'tramp.
+
+ * net/tramp-adb.el (tramp-unload-hook): Unload `tramp-adb'.
+
+ * net/tramp-compat.el (tramp-unload-hook): Unload `tramp-loaddefs'.
+
+2014-04-17 Daniel Colascione <dancol@dancol.org>
+
+ Add support for bracketed paste mode; add infrastructure for
+ managing terminal mode enabling and disabling automatically.
+
+ * xt-mouse.el:
+ (xterm-mouse-mode): Simplify.
+ (xterm-mouse-tracking-enable-sequence)
+ (xterm-mouse-tracking-disable-sequence): New constants.
+ (turn-on-xterm-mouse-tracking-on-terminal)
+ (turn-off-xterm-mouse-tracking-on-terminal):
+ Use tty-mode-set-strings and tty-mode-reset-strings terminal
+ parameters instead of random hooks.
+ (turn-on-xterm-mouse-tracking)
+ (turn-off-xterm-mouse-tracking): Delete.
+
+ * term/xterm.el (xterm-extra-capabilities): Fix bitrotted comment.
+ (xterm-paste-ending-sequence): New constant.
+ (xterm-paste): New command used for bracketed paste support.
+
+ (xterm-modify-other-keys-terminal-list): Delete obsolete variable.
+ (terminal-init-xterm-bracketed-paste-mode): New function.
+ (terminal-init-xterm): Call it.
+ (terminal-init-xterm-modify-other-keys): Use tty-mode-set-strings
+ and tty-mode-reset-strings instead of random hooks.
+ (xterm-turn-on-modify-other-keys)
+ (xterm-turn-off-modify-other-keys)
+ (xterm-remove-modify-other-keys): Delete obsolete functions.
+
+ * term/screen.el: Rewrite to just use the xterm code.
+ Add copyright notice. Mention tmux.
+
+2014-04-17 Ian D <dunni@gnu.org> (tiny change)
+
+ * image-mode.el (image-mode-window-put): Also update the property of
+ the "default window".
+ * doc-view.el (doc-view-new-window-function): If no window
+ exists, move to the last known page.
+
+2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-calculate-indent): Don't auto-indent in
+ here-documents (bug#17262).
+
+2014-04-16 Eli Zaretskii <eliz@gnu.org>
+
+ * term/pc-win.el (x-list-fonts, x-get-selection-value):
+ Provide doc strings, as required by snarf-documentation.
+
+2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ps-def.el (ps-generate-postscript-with-faces1): Use the new `sorted'
+ arg of overlays-at. Use `invisible-p'.
+
+ * obsolete/lucid.el (extent-at):
+ * htmlfontify.el (hfy-overlay-props-at): Use the new `sorted' arg of
+ overlays-at.
+ (hfy-fontify-buffer): Remove unused var `orig-ovls'.
+
+2014-04-16 João Távora <joaotavora@gmail.com>
+
+ * net/shr.el (shr-expand-url): Use `expand-file-name' for relative
+ links. (Bug#17217).
+
+2014-04-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer):
+ Use mapc to loop over a vector. (Bug#17257).
+
+2014-04-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-truename): Revert previous
+ patch, there are new problems with file names containing spaces.
+ Get rid of backticks. (Bug#17238)
+
+2014-04-16 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair--syntax-ppss): Simplify and fix
+ possible bug.
+
+2014-04-16 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (blink-cursor-blinks, blink-cursor-blinks-done): Doc fixes.
+ (blink-cursor-mode): Mention customization variables and the
+ effect of 'blink-cursor-blinks'.
+
+2014-04-16 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * simple.el (undo): Prevent insertion of identity mapping into
+ undo-equiv-table so as undo-only does not inf loop in the presence
+ of consecutive nils in undo list.
+
+2014-04-16 Matthias Dahl <matthias.dahl@binary-island.eu>
+
+ * faces.el (make-face): Deprecate optional argument as it is no
+ longer needed/used since the conditional X resources handling
+ has been pushed down to make-face-x-resource-internal itself.
+ (make-empty-face): Don't pass optional argument to make-face.
+
+2014-04-16 Karl Fogel <kfogel@red-bean.com>
+
+ * savehist.el (savehist-save): Remove workaround for a read-passwd
+ bug that was fixed before 24.3. Thanks to Juanma Barranquero for
+ noticing that the shim was still present.
+
+2014-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc-view.el (doc-view-set-doc-type): Ignore file name case; add .pps.
+
+2014-04-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * faces.el (face-set-after-frame-default): Remove unused local variable.
+
+2014-04-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/grep.el: Use lexical-binding.
+ (grep-expand-template): Pass explicit lexical env to `eval'.
+ (zrgrep): Let-bind grep-find-template explicitly.
+
+ * emacs-lisp/cl-lib.el (current-case-table): Remove setter.
+ * leim/quail/sisheng.el (sisheng-list): Use with-case-table.
+
+2014-04-12 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el <standard-case-table>: Add entries
+ for letters from the Coptic block u+2C80-u+2CFF. (Bug#17243)
+ Set category of Coptic characters be 'g' (Greek).
+
+2014-04-12 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (completion-table-with-cache):
+ Define if not available.
+ (octave-goto-function-definition, octave-sync-function-file-names)
+ (octave-find-definition-default-filename):
+ Backquote upattern for compatibility.
+
+2014-04-12 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-truename): Quote the file
+ name twice due to backticks. (Bug#17238)
+
+2014-04-12 Glenn Morris <rgm@gnu.org>
+
+ * term/w32-win.el (x-win-suspend-error):
+ * term/x-win.el (x-win-suspend-error): Sync docs.
+
+2014-04-12 Matthias Dahl <matthias.dahl@binary-island.eu>
+
+ * faces.el (make-face): Remove deprecated optional argument.
+ The conditional application of X resources is handled directly by
+ make-face-x-resource-internal since Emacs 24.4.
+ (make-empty-face): Don't pass optional argument to make-face.
+
+2014-04-11 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport. (Bug#16429)
+
+2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Ediff's overlay priorities cause more trouble than they solve.
+ * vc/ediff-init.el (ediff-shadow-overlay-priority): Remove variable.
+ (ediff-highest-priority): Remove function (bug#17234).
+ * vc/ediff-util.el (ediff-highlight-diff-in-one-buffer):
+ * vc/ediff-diff.el (ediff-set-diff-overlays-in-one-buffer)
+ (ediff-set-fine-diff-properties-in-one-buffer): Don't mess with
+ overlay priorities.
+
+2014-04-11 Feng Li <fengli@gmail.com> (tiny change)
+
+ * progmodes/pascal.el (pascal-font-lock-keywords): Fix incorrect format
+ entry; use symbol boundaries to avoid mis-matches.
+
+2014-04-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-file-name-handler)
+ (tramp-completion-file-name-handler): Avoid recursive loading.
+
+ * net/tramp-sh.el (tramp-make-copy-program-file-name):
+ Quote result also locally.
+
+2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-base.el (<toplevel>, cua--pre-command-handler-1):
+ Remove left-over code.
+
+ * newcomment.el (comment-indent-new-line): Sink code where it's used.
+ Reuse the previous comment's indentation unconditionally if it's on its
+ own line.
+
+2014-04-09 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/lisp.el (backward-up-list): Add `escape-strings',
+ `no-syntax-crossing' arguments. Forward to `up-list'.
+ (up-list): Add `escape-strings', `no-syntax-crossing' arguments.
+ Implement logic for escaping from strings. Use narrowing to deal
+ with corner cases.
+
+2014-04-09 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-connection-info): New variable.
+ (rcirc-connect): Use it to store connection info.
+ (rcirc-buffer-process): Avoid get-buffer-process which returns nil
+ for killed process.
+ (rcirc-cmd-reconnect): New command. (Bug#17045)
+ (rcirc-mode, set-rcirc-encode-coding-system)
+ (set-rcirc-decode-coding-system, rcirc-connect): Use setq-local.
+
+2014-04-09 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-indent.el: Add comment claiming
+ facility is also good for elisp.
+ (lisp-indent-find-method): New function.
+ (common-lisp-indent-function): Recognize cl-loop.
+ (common-lisp-indent-function-1): Recognize cl constructs; use
+ `lisp-indent-find-method' instead of `get' directly.
+ (if): Use else-body style for elisp.
+
+2014-04-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more
+ Module methods. (Bug#17216)
+
+2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help.el (describe-bindings): Fix buffer handling (bug#17210).
+ (describe-bindings-internal): Mark obsolete.
+
+2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (with-silent-modifications): Don't bind deactivate-mark,
+ buffer-file-name, and buffer-file-truename any more.
+
+2014-04-08 Leo Liu <sdl.web@gmail.com>
+
+ Use lexical-binding and require cl-lib.
+ * net/rcirc.el (rcirc, rcirc-handler-ctcp-KEEPALIVE)
+ (rcirc-handler-generic, rcirc-fill-paragraph)
+ (rcirc-format-response-string, rcirc-target-buffer)
+ (rcirc-last-line, rcirc-record-activity, rcirc-split-activity)
+ (rcirc-activity-string, rcirc-make-trees, rcirc-cmd-ctcp)
+ (rcirc-ctcp-sender-PING, rcirc-browse-url)
+ (rcirc-markup-timestamp, rcirc-markup-attributes)
+ (rcirc-markup-my-nick, rcirc-markup-urls)
+ (rcirc-markup-bright-nicks, rcirc-markup-fill)
+ (rcirc-check-auth-status, rcirc-handler-WALLOPS)
+ (rcirc-handler-JOIN, rcirc-handler-PART-or-KICK)
+ (rcirc-handler-PART, rcirc-handler-KICK, rcirc-handler-QUIT)
+ (rcirc-handler-NICK, rcirc-handler-PING, rcirc-handler-PONG)
+ (rcirc-handler-TOPIC, rcirc-handler-301, rcirc-handler-317)
+ (rcirc-handler-332, rcirc-handler-333, rcirc-handler-477)
+ (rcirc-handler-MODE, rcirc-handler-353, rcirc-handler-366)
+ (rcirc-authenticate, rcirc-handler-INVITE, rcirc-handler-ERROR)
+ (rcirc-handler-ctcp-VERSION, rcirc-handler-ctcp-TIME)
+ (rcirc-handler-CTCP-response): Fix unused arguments warnings and
+ use cl-lib.
+
+2014-04-07 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair--syntax-ppss):
+ When inside comments parse from comment beginning.
+ (electric-pair--balance-info): Fix typo in comment.
+ (electric-pair--in-unterminated-string-p): Delete.
+ (electric-pair--unbalanced-strings-p): New function.
+ (electric-pair-string-bound-function): New var.
+ (electric-pair-inhibit-if-helps-balance): Decide quote pairing
+ according to `electric-pair--in-unterminated-string-p'
+
+ * elec-pair.el (electric-pair-inhibit-if-helps-balance):
+ Inhibit quote pairing if point-max is inside an unterminated string.
+ (electric-pair--looking-at-unterminated-string-p): Delete.
+ (electric-pair--in-unterminated-string-p): New function.
+
+2014-04-07 Glenn Morris <rgm@gnu.org>
+
+ * shell.el (shell-directory-tracker):
+ Go back to just ignoring failures. (Bug#17159)
+
+2014-04-07 João Távora <joaotavora@gmail.com>
+
+ Fix `electric-pair-delete-adjacent-pairs' in modes binding
+ backspace. (Bug#16981)
+ * elec-pair.el (electric-pair-backward-delete-char): Delete.
+ (electric-pair-backward-delete-char-untabify): Delete.
+ (electric-pair-mode-map): Bind backspace to a menu item filtering
+ a new `electric-pair-delete-pair' command.
+ (electric-pair-delete-pair): New command.
+
+ * progmodes/python.el (python-electric-pair-string-delimiter):
+ Fix triple-quoting electricity. (Bug#17192)
+
+ * elec-pair.el (electric-pair-post-self-insert-function):
+ Don't skip whitespace when `electric-pair-text-pairs' and
+ `electric-pair-pairs' were used. syntax to
+ electric-pair--skip-whitespace. (Bug#17183)
+
+2014-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * leim/quail/ipa.el (ipa-x-sampa): Fix the character produced for
+ "<F>". (Bug#17199)
+
+2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el (mpc--status-timer-run): Disable timer if not displayed.
+ (mpc--status-idle-timer-run): Use mpc--status-timer-run.
+
+2014-04-07 Glenn Morris <rgm@gnu.org>
+
+ * help.el (view-lossage): Doc tweak.
+
+2014-04-07 Matthias Dahl <ml_emacs-lists@binary-island.eu>
+
+ * faces.el (face-spec-recalc): Call make-face-x-resource-internal
+ only when inhibit-x-resources is nil, and do that earlier in the
+ function. Doc fix. (Bug#16694)
+ (face-spec-choose): Accept additional optional argument, whose
+ value is returned if no matching attributes are found.
+ (face-spec-recalc): Use the new optional argument when calling
+ face-spec-choose. (Bug#16378)
+ (make-face-x-resource-internal): Do nothing when
+ inhibit-x-resources is non-nil. Don't touch the default face if
+ reversed video is given--as was done in previous versions of Emacs.
+ (face-set-after-frame-default): Don't call
+ make-face-x-resource-internal here. (Bug#16434)
+
+2014-04-07 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-bookmark-jump):
+ Use `bookmark-after-jump-hook' to jump to the right page after the
+ buffer is shown in a window. (bug#16090)
+
+2014-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el (mirroring): Fix last change:
+ instead of loading uni-mirrored.el explicitly, do that implicitly
+ by creating the 'mirroring' uniprop table. This avoids announcing
+ the loading of uni-mirrored.el.
+
+2014-04-07 Glenn Morris <rgm@gnu.org>
+
+ * files.el (buffer-stale--default-function)
+ (buffer-stale-function, revert-buffer--default):
+ * autorevert.el (auto-revert-buffers): Doc tweaks.
+
+2014-04-07 Eli Zaretskii <eliz@gnu.org>
+
+ * international/characters.el: Preload uni-mirrored.el. (Bug#17169)
+
+2014-04-07 Glenn Morris <rgm@gnu.org>
+
+ * files.el (make-backup-file-name-function)
+ (make-backup-file-name, make-backup-file-name--default-function)
+ (make-backup-file-name-1, find-backup-file-name)
+ (revert-buffer-function, revert-buffer-insert-file-contents-function)
+ (buffer-stale--default-function, buffer-stale-function)
+ (before-revert-hook, after-revert-hook, revert-buffer-in-progress-p)
+ (revert-buffer, revert-buffer--default)
+ (revert-buffer-insert-file-contents--default-function):
+ Doc fixes related to defaults no longer being nil.
+ (make-backup-file-name-function): Bump :version.
+ Restore nil as a valid but deprecated custom type.
+
+2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el (perl-syntax-propertize-function):
+ Handle $' used as a variable (bug#17174).
+
+ * progmodes/perl-mode.el (perl-indent-new-calculate):
+ Handle forward-sexp failure (bug#16985).
+ (perl-syntax-propertize-function): Add "foreach" and "for" statement
+ modifiers introducing expressions (bug#17116).
+
+2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dired-aux.el (dired-file-set-difference): Use lexical-scoping.
+
+2014-04-05 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
+ Add define-compilation-mode.
+
+2014-04-04 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair--syntax-ppss): When inside comments
+ parse from comment beginning.
+ (electric-pair--balance-info): Fix typo in comment.
+ (electric-pair--in-unterminated-string-p): Delete.
+ (electric-pair--unbalanced-strings-p): New function.
+ (electric-pair-string-bound-function): New var.
+ (electric-pair-inhibit-if-helps-balance): Decide quote pairing
+ according to `electric-pair--in-unterminated-string-p'.
+
+2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/reftex-parse.el (reftex--index-tags): Rename `index-tags'.
+ Move declaration before first use.
+ (reftex-move-to-next-arg): Silence compiler warning.
+
+2014-04-04 Joost Kremers <joostkremers@fastmail.fm> (tiny change)
+
+ * textmodes/reftex-toc.el (reftex-toc, reftex-re-enlarge):
+ Use `window-total-width' instead of `window-width'.
+
+2014-04-03 Daniel Colascione <dancol@dancol.org>
+
+ * subr.el (set-transient-map): Remove rms's workaround entirely;
+ use new `suspicious-object' subr to mark our lambda for closer
+ scrutiny during gc.
+
+2014-04-02 Richard Stallman <rms@gnu.org>
+
+ * subr.el (set-transient-map): Comment out previous change.
+
+2014-04-02 Glenn Morris <rgm@gnu.org>
+
+ * menu-bar.el (menu-bar-file-menu):
+ * vc/ediff.el (ediff-current-file):
+ Update for revert-buffer-function no longer being nil by default.
+
+ * simple.el (command-execute): Respect nil disabled-command-function.
+
+2014-04-02 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * simple.el (command-execute): Do not execute the command when it
+ is disabled; fixes thinko in 2013-02-20 conversion from C. (Bug#17151)
+
+2014-04-02 Juri Linkov <juri@jurta.org>
+
+ * dired-aux.el (dired-compress-file): Don't use string-match-p
+ because its match data is used afterwards.
+
+2014-04-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-built-in-p): Treat a min-version of
+ 0 like nil.
+
+2014-04-02 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair-inhibit-if-helps-balance):
+ Inhibit quote pairing if point-max is inside an unterminated string.
+ (electric-pair--looking-at-unterminated-string-p):
+ Delete.
+ (electric-pair--in-unterminated-string-p): New function.
+
+2014-04-01 Daniel Colascione <dancol@dancol.org>
+
+ * minibuffer.el (minibuffer-complete): Prevent assertion failure
+ when trying to complete the prompt.
+
+2014-03-31 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info):
+ Refactor out eldoc-documentation-function-default.
+ (eldoc-documentation-function-default): New function.
+ (eldoc-documentation-function): Change value.
+
+2014-03-31 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (cycle-spacing--context, cycle-spacing): Doc tweaks.
+
+ * progmodes/vhdl-mode.el (vhdl-speedbar-select-mra)
+ (vhdl-compose-components-package, vhdl-compose-configuration):
+ Abbreviate default-directory (missing from some previous upstream sync).
+
+2014-03-31 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.35.2.
+ * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update.
+ (top-level): No longer require assoc.
+ (vhdl-asort, vhdl-anot-head-p, vhdl-aput, vhdl-adelete, vhdl-aget):
+ New functions. Use throughout to replace aget etc.
+ (vhdl-aput-delete-if-nil): Rename from vhdl-aput.
+ (vhdl-update-file-contents): Update for vhdl-aput-delete-if-nil rename.
+ (vhdl-template-replace-header-keywords): Fix bug for "<title string>".
+ (vhdl-compile-init): Do not initialize regexps for Emacs 22+.
+ (vhdl-error-regexp-emacs-alist): Remove regexps from all compilers
+ except `vhdl-compiler'.
+ (vhdl-error-regexp-add-emacs): Remove all other compilers,
+ when appropriate.
+
+2014-03-31 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/vhdl-mode.el (vhdl-expand-abbrev, vhdl-expand-paren):
+ Revert 2014-03-26 merge goof; go back to using defalias.
+
+2014-03-30 Daniel Colascione <dancol@dancol.org>
+
+ * comint.el (comint-send-input):
+ Deactivate completion-in-region-mode before we send comint input.
+ (Bug#17139).
+
+ * simple.el (keyboard-quit): Deactivate completion-in-region-mode
+ on keyboard-quit.
+
+2014-03-29 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/reftex.el: Manage most autoloads automatically.
+ * textmodes/reftex-auc.el, textmodes/reftex-cite.el:
+ * textmodes/reftex-dcr.el, textmodes/reftex-global.el:
+ * textmodes/reftex-index.el, textmodes/reftex-parse.el:
+ * textmodes/reftex-ref.el, textmodes/reftex-sel.el:
+ * textmodes/reftex-toc.el: Set generated-autoload-file,
+ and add autoload cookies for reftex.el.
+ * Makefile.in (AUTOGEN_VCS): Add textmodes/reftex.el.
+
+2014-03-28 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (report-emacs-bug-address): Set custom properties.
+ * mail/emacsbug.el (report-emacs-bug-address):
+ Variable is now defined in emacs.c.
+
+ * mail/emacsbug.el (report-emacs-bug):
+ Include system-configuration-features.
+
+2014-03-28 Michal Nazarewicz <mina86@mina86.com>
+
+ * simple.el (cycle-spacing): Never delete spaces on first run by
+ default, but do so in a new 'fast mode and if there are already
+ N spaces (the previous behavior).
+ Compare N with its value in previous invocation so that changing
+ prefix argument restarts `cycle-spacing' sequence.
+ The idea is that with this change, binding M-SPC to
+ `cycle-spacing' should not introduce any changes in behavior of
+ the binding so long as users do not type M-SPC twice in a raw with
+ the same prefix argument or lack thereof.
+
+2014-03-28 Glenn Morris <rgm@gnu.org>
+
+ * faces.el (term-file-aliases): New variable.
+ (tty-run-terminal-initialization): Respect term-file-aliases.
+ * term/apollo.el, term/vt102.el, term/vt125.el, term/vt201.el:
+ * term/vt220.el, term/vt240.el, term/vt300.el, term/vt320.el:
+ * term/vt400.el, term/vt420.el: Remove files, replaced by aliases.
+
+2014-03-27 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (inhibit-startup-hooks): Doc tweak.
+ (normal-top-level): Simplify running of hooks.
+ For window-setup-hook, respect inhibit-startup-hooks.
+ (command-line-1): Don't set window-setup-hook to nil.
+
+ Allow selective autoloading from obsolete/ directory.
+ * Makefile.in (obsolete-autoloads): New rule.
+ (autoloads): Run obsolete-autoloads.
+ * obsolete/iswitchb.el (iswitchb-mode): Use obsolete-autoload.
+ * simple.el (iswitchb-mode): Remove hand-written autoloads.
+
+2014-03-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Highlight special globals with font-lock-builtin-face. (Bug#17057)
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
+ Don't propertize `?' or `!' as symbol constituent when after
+ colon. (Bug#17097)
+
+2014-03-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--restore-frame): Remove workaround for bug#14795
+ which is no longer needed and causes trouble in GTK builds (bug#17046).
+
+ * emacs-lisp/package-x.el (package--archive-contents-from-url):
+ Use url-insert-file-contents; package-handle-response no longer exists.
+
+2014-03-26 Daniel Colascione <dancol@dancol.org>
+
+ * simple.el (process-menu-mode-map): New variable.
+ (process-menu-delete-process): New command.
+
+2014-03-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/package.el: Fix bug#16733 (again).
+ (url-http-parse-response, url-http-end-of-headers, url-recreate-url)
+ (url-http-target-url): Remove unused declarations.
+ (package-handle-response): Remove.
+ (package--with-work-buffer): Use url-insert-file-contents and simplify.
+ (package--download-one-archive): Use current-buffer instead of
+ dynamic binding of `buffer'.
+ (describe-package-1): Do not decode readme-string.
+
+2014-03-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-methods, tramp-connection-timeout): Fix docstring.
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Revert change
+ from 2014-03-07, it decreases performance unnecessarily. Let-bind
+ `remote-file-name-inhibit-cache' to nil in the second pass.
+ (tramp-find-executable): Do not call "which" on SunOS.
+ (tramp-send-command-and-check): Fix docstring.
+ (tramp-do-copy-or-rename-file-directly): In the `rename' case,
+ check whether source directory has set the sticky bit.
+
+2014-03-26 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * simple.el (primitive-undo): Only process marker adjustments
+ validated against their corresponding (TEXT . POS). Issue warning
+ for lone marker adjustments in undo history. (Bug#16818)
+ (undo-make-selective-list): Add marker adjustments to selective
+ undo list based on whether their corresponding (TEXT . POS) is in
+ the region. Remove variable adjusted-markers, which was unused
+ and only non nil during undo-make-selective-list.
+ (undo-elt-in-region): Return nil when passed a marker adjustment
+ and explain in function doc.
+
+2014-03-26 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * align.el (align-region): Do not fail when end-mark is nil (bug#17088).
+
+2014-03-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-expression-expansion-re):
+ Match special global variables without curlies, too.
+ (ruby-font-lock-keywords): Simplify the matcher for special global
+ variables. Don't require a non-word character after the variable.
+ (Bug#17057)
+
+2014-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (redisplay-highlight-region-function): Increase priority of
+ overlay to make sure boundaries are visible (bug#15899).
+
+2014-03-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--initial-params): Fix typo in parameter name.
+ (frameset-restore): Compare display strings with equal.
+
+ * frame.el (make-frame): Don't quote display name in error message,
+ it is already a string.
+
+2014-03-26 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * net/tramp.el (tramp-read-passwd): Suspend the timers while reading
+ the password.
+
+2014-03-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package--add-to-archive-contents):
+ Include already installed and built-in packages in
+ `package-archive-contents'.
+ (package-install): Don't include already installed packages in the
+ options during interactive invocation. (Bug#16762)
+ (package-show-package-list): If the buffer is already displayed in
+ another window, switch to that window.
+
+2014-03-26 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.35.1.
+ * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update.
+ (vhdl-compiler-alist): Doc fix.
+ (vhdl-goto-line): Remove.
+ (vhdl-mode-abbrev-table-init): Add XEmacs compat.
+ (vhdl-mode) <paragraph-start>: Fix value.
+ (vhdl-fix-statement-region): Not `for' in wait-statement.
+ (vhdl-beautify-region): Also (un)tabify.
+ (vhdl-get-visible-signals):
+ Scan declarative part of generate statements.
+ (vhdl-template-record): Fix indentation for record type declaration.
+ (vhdl-expand-abbrev, vhdl-expand-paren):
+ Revert to using fset again rather than defalias.
+ (vhdl-scan-directory-contents): Tweak.
+ (vhdl-speedbar-find-file, vhdl-speedbar-port-copy)
+ (vhdl-compose-components-package):
+ Replace vhdl-goto-line with forward-line.
+ (top-level): Tweak speedbar frame selection.
+ (vhdl-generate-makefile-1): Support for compilers with no
+ unit-to-file name mapping (create directory with dummy files).
+
+2014-03-26 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision 702457d.
+ * progmodes/verilog-mode.el (verilog-mode-version): Update.
+ (create-lockfiles): Declare.
+ (verilog-read-decls): Fix module header imports, bug709.
+ Reported by Victor Lau.
+ Fix parsing 'var' in AUTOs, msg1294. Reported by Dominique Chen.
+ (verilog-auto-inout-module): Fix AUTOINOUTMODULE not inserting
+ interface-only modules, bug721. Reported by Dean Hoyt.
+
+2014-03-26 Glenn Morris <rgm@gnu.org>
+
+ * obsolete/gulp.el: Move here from emacs-lisp/.
+
+ * files.el (lock-buffer, unlock-buffer, file-locked-p):
+ Remove fallback aliases, since they are always defined now.
+
+2014-03-24 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl--do-arglist): Use `plist-member'
+ instead of cl-loop search function.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * calendar/parse-time.el (parse-time-iso8601-regexp)
+ (parse-iso8601-time-string): Copy from `url-dav' so that we can use
+ it more generally.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/dns.el (network-interface-list): Define for XEmacs.
+
+2014-03-23 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * net/dns.el (dns-servers-up-to-date-p): New function to see whether
+ the network interfaces changed.
+ (dns-query): Use it to flush the data.
+
+2014-03-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * vc/vc.el (vc-rollback): Use set-buffer-modified-p.
+
+2014-03-23 Daniel Colascione <dancol@dancol.org>
+
+ Change subword-mode to use `find-word-boundary-function-table' and
+ replace `capitalized-words-mode'. Also, convert to lexical binding.
+ * progmodes/cap-words.el: Delete now-obsolete file.
+ * progmodes/subword.el: Reimplement using
+ `find-word-boundary-function-table'.
+ (subword-mode-map): Hollow out.
+ (capitalized-words-mode): Define as obsolete alias for
+ `subword-mode'.
+ (subword-mode, superword-mode): Tweak documentation to reflect new
+ implementation; call `subword-setup-buffer'.
+ (subword-forward, subword-capitalize): Add underscore to indicate
+ unused variable.
+ (subword-find-word-boundary-function-table): New constant.
+ (subword-empty-char-table): New constant.
+ (subword-setup-buffer): New function.
+ (subword-find-word-boundary): New function.
+
+2014-03-23 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl--do-arglist): Use a little `cl-loop'
+ list to look for keyword arguments instead of `memq', fixing
+ (Bug#3647) --- unfortunately, only for freshly-compiled code.
+ Please make bootstrap.
+
+2014-03-22 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-read-regexp): Make obsolete.
+ (dired-mark-files-regexp, dired-mark-files-containing-regexp)
+ (dired-flag-files-regexp):
+ * dired-aux.el (dired-mark-read-regexp):
+ * dired-x.el (dired-mark-unmarked-files): Use read-regexp directly.
+
+ * startup.el (fancy-startup-text):
+ * help.el (describe-gnu-project): Visit online info about GNU project.
+
+ * help-fns.el (help-fns--interactive-only): New function.
+ (help-fns-describe-function-functions): Add the above function.
+ * simple.el (beginning-of-buffer, end-of-buffer, insert-buffer)
+ (next-line, previous-line): Remove hand-written interactive-only
+ information from doc strings, it is auto-generated now.
+ * bookmark.el (bookmark-write):
+ * epa-mail.el (epa-mail-decrypt, epa-mail-verify, epa-mail-sign)
+ (epa-mail-import-keys): Mark interactive-only,
+ and remove hand-written interactive-only information from doc strings.
+ * epa.el (epa-decrypt-armor-in-region, epa-verify-region)
+ (epa-verify-cleartext-in-region, epa-sign-region, epa-encrypt-region):
+ * files.el (not-modified):
+ * simple.el (mark-whole-buffer): Mark interactive-only.
+
+ * emacs-lisp/byte-run.el (defun-declarations-alist):
+ Add interactive-only. Doc tweak.
+ (macro-declarations-alist): Doc tweak.
+ * subr.el (declare): Doc tweak (add xref to manual).
+ * comint.el (comint-run):
+ * files.el (insert-file-literally, insert-file):
+ * replace.el (replace-string, replace-regexp):
+ * simple.el (beginning-of-buffer, end-of-buffer, delete-backward-char)
+ (delete-forward-char, goto-line, insert-buffer, next-line)
+ (previous-line): Set interactive-only via declare.
+
+2014-03-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-desc): Use the contents of the
+ quoted form, not its cdr. (Bug#16873)
+
+2014-03-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32-common-fns.el (x-selection-owner-p): Add empty docstring for the
+ benefit of doc.c; change parameter profile to match the X function.
+
+2014-03-22 Leo Liu <sdl.web@gmail.com>
+
+ * help.el (temp-buffer-setup-hook): Remove help-mode-setup.
+ (temp-buffer-show-hook): Remove help-mode-finish. (Bug#16038)
+
+2014-03-21 Richard Stallman <rms@gnu.org>
+
+ * battery.el (battery-linux-sysfs): Search for each field
+ from the beginning of the buffer.
+
+ * subr.el (set-transient-map): Clear out function and value
+ of the temporary symbol when we're done with it.
+
+ * mail/rmailsum.el (rmail-summary-delete-forward):
+ Optimize case of reaching end and handling count.
+ (rmail-summary-mark-deleted): Optimize when N is current msg.
+ Don't create new summary line.
+ (rmail-summary-undelete): Pass arg to rmail-undelete-previous-message.
+ (rmail-summary-undelete-many): Rewrite for speed.
+ (rmail-summary-msg-number): New function.
+
+ * mail/rmail.el (rmail-delete-message): Update summary.
+ (rmail-undelete-previous-message): Handle repeat count arg.
+ (rmail-delete-backward, rmail-delete-forward): Likewise.
+
+2014-03-21 Daniel Colascione <dancol@dancol.org>
+
+ * mail/emacsbug.el (report-emacs-bug): Include memory usage
+ information in bug reports.
+
+2014-03-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-methods): Add docstring for `tramp-login-env'
+ and `tramp-copy-env'.
+
+ * net/tramp-sh.el (tramp-methods) <sudo>: Add `tramp-login-env'.
+ (tramp-maybe-open-connection): Handle `tramp-login-env'.
+
+2014-03-21 Glenn Morris <rgm@gnu.org>
+
+ * electric.el (electric-indent-post-self-insert-function): Add doc.
+
+2014-03-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-compute-transaction):
+ Use `version-list-<=' to compare the requirement version against
+ the version of package already to be installed. Update the error
+ message. (Bug#16826)
+
+ * progmodes/ruby-mode.el (ruby-smie-rules):
+ Add indentation rule for ` @ '. (Bug#17050)
+
+2014-03-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * align.el (align-regexp): Remove superfluous backslash.
+
+ * ffap.el (ffap-ftp-default-user, ffap-url-regexp)
+ (ffap-pass-wildcards-to-dired, dired-at-point-require-prefix)
+ (ffap-rfc-path, ffap-ftp-sans-slash-regexp, ffap-menu-regexp):
+ Fix docstring typos.
+ (ffap-next): Use C-u in docstring.
+ (ffap-machine-p, ffap-list-env, ffap-alist, ffap-alist)
+ (ffap-string-at-point-mode-alist, ffap-menu, ffap-menu-ask):
+ Remove superfluous backslashes.
+ (ffap-string-at-point): Reflow docstring.
+
+ * server.el (server-host): Reflow docstring.
+ (server-unload-function): Fix docstring typo.
+ (server-eval-at): Remove superfluous backslash.
+
+ * skeleton.el (skeleton-insert): Remove superfluous backslash.
+ (skeleton-insert): Doc fix.
+ (skeleton-insert): Reflow docstring.
+
+ * term/tty-colors.el (tty-color-alist, tty-modify-color-alist)
+ (tty-color-approximate, tty-color-by-index, tty-color-values)
+ (tty-color-desc): Remove superfluous backslashes.
+
+2014-03-21 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (history-length): Bump :version.
+
+ * Makefile.in ($(MH_E_DIR)/mh-loaddefs.el)
+ ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el)
+ ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el):
+ Don't set `make-backup-files'.
+
+ * info.el (info--prettify-description): New function,
+ to give info-finder descriptions consistent case, punctuation.
+ (Info-finder-find-node): Use it. Sort packages.
+ Refer to "description" rather than "commentary".
+
+2014-03-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--print-register): New function.
+ (frameset-to-register): Use it.
+
+2014-03-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/hideif.el (hif-string-to-number): New function.
+ (hif-tokenize): Use it to understand non-decimal floats.
+
+ * emacs-lisp/cl-extra.el (cl--map-overlays): Remove obsolete code.
+
+ * skeleton.el (skeleton-autowrap): Mark as obsolete. Doc fix.
+
+2014-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-newline-and-maybe-indent): New command.
+ Bind it globally to C-j.
+ (electric-indent-mode): Don't mess with the global map any more.
+ Don't drop the post-self-insert-hook is some buffer is still using it
+ (bug#16770).
+
+ * bindings.el (global-map): Remove C-j binding.
+
+ * emacs-lisp/nadvice.el (advice--make-docstring): Try harder to find
+ the docstring of functions advised before dumping (bug#16993).
+
+2014-03-19 Stefan-W. Hahn <stefan.hahn@s-hahn.de> (tiny change)
+
+ * ps-print.el (ps-generate-postscript-with-faces):
+ Explicitly deactivate the mark (bug#16866).
+ * simple.el (deactivate-mark): Update region highlight.
+
+2014-03-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/package.el (describe-package-1):
+ Decode commentary (bug#16733).
+
+2014-03-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * custom.el (defcustom): Doc fix: recommend avoiding destructive
+ modification of the value argument of :set (bug#16755).
+
+2014-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (newline-and-indent): Do autofill (bug#17031).
+
+2014-03-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * newcomment.el (comment-normalize-vars): Only add escaping check
+ to `comment-start-skip' if not `comment-use-syntax'. (Bug#16971)
+ (comment-beginning): Use `narrow-to-region' instead of moving back
+ one character.
+ (http://lists.gnu.org/archive/html/emacs-devel/2014-03/msg00488.html)
+ (comment-start-skip): Update the docstring.
+
+2014-03-18 Richard Stallman <rms@gnu.org>
+
+ * dired.el (dired-display-file): Force use of other window.
+
+2014-03-18 Daniel Colascione <dancol@dancol.org>
+
+ * startup.el (tty-handle-args): Remove debug message from 2007.
+
+2014-03-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--interactive-form): New function.
+ (advice--make-interactive-form): Use it to avoid (auto)loading function.
+ (advice--make-1, advice-add, advice-remove):
+ Remove braindead :advice-pending hack.
+
+2014-03-17 Glenn Morris <rgm@gnu.org>
+
+ * calendar/calendar.el (calendar-generate-month): Apply weekend
+ face to the right days; fixes 2013-08-06 change. (Bug#17028)
+
+2014-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-action-out-of-band): Read pending output.
+ (tramp-call-process): Trace also DESTINATION.
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band):
+ Quote file names when they are local. Remove superfluous trace.
+
+2014-03-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * newcomment.el (comment-beginning): If `comment-start-skip'
+ doesn't match, move back one char and try again. (Bug#16971)
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ Set `comment-use-syntax' to t to avoid the unnecessary runtime check.
+ Set `comment-start-skip' to a simpler value that doesn't try to
+ check if the semicolon is escaped (this is handled by
+ `syntax-ppss' now). (Bug#16971)
+
+ * progmodes/scheme.el (scheme-mode-variables): Same.
+
+2014-03-16 Martin Rudalics <rudalics@gmx.at>
+
+ Fix behavior of with-temp-buffer-window (Bug#16816, Bug#17007).
+ * window.el (with-temp-buffer-window): Don't make BUFFER-OR-NAME
+ current (Bug#16816, Bug#17007).
+ (with-current-buffer-window): New macro doing the same as
+ `with-temp-buffer-window' but with BUFFER-OR-NAME current.
+ * help.el (help-print-return-message): Warn in doc-string to not
+ use this in `with-help-window'.
+ (describe-bindings-internal): Call `describe-buffer-bindings'
+ from within help buffer. See Juanma's scenario in (Bug#16816).
+ (with-help-window): Update doc-string.
+ * dired.el (dired-mark-pop-up):
+ * files.el (save-buffers-kill-emacs):
+ * register.el (register-preview): Use `with-current-buffer-window'
+ instead of `with-temp-buffer-window'.
+
+2014-03-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * textmodes/rst.el (rst-arabic-to-roman, rst-roman-to-arabic):
+ Implement inserting into current buffer, documented in their docstrings.
+ (rst-define-key, rst-compare-adornments, rst-insert-list-new-item)
+ (rst-section-tree-point, rst-forward-section, rst-indent)
+ (rst-compute-tabs, rst-font-lock-find-unindented-line-end)
+ (rst-font-lock-find-unindented-line-limit, rst-adornment-level)
+ (rst-font-lock-handle-adornment-pre-match-form)
+ (rst-repeat-last-character): Reflow docstrings.
+ (rst-preferred-adornments, rst-update-section, rst-find-title-line)
+ (rst-adjust-adornment-work, rst-initial-items, rst-insert-list)
+ (rst-toc-insert-style, rst-toc-insert-node, rst-goto-section)
+ (rst-compile, rst-imenu-convert-cell, rst-imenu-create-index):
+ Fix docstring typos.
+ (rst-all-sections, rst-section-hierarchy, rst-adjust): Doc fixes.
+ (rst-uncomment-region, rst-font-lock-find-unindented-line-match)
+ (rst-font-lock-handle-adornment-matcher): Mark unused arguments.
+
+2014-03-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * term/ns-win.el (x-command-line-resources): Rename from ns-... version,
+ for compatibility with other ports.
+ (ns-initialize-window-system): Use it. It is set in term/common-win.el
+ from the -xrm command line argument, but in the Nextstep port its value
+ is irrelevant because nsfns.m:Fx_open_connection ignores it for now.
+
+ * progmodes/python.el (defconst, python-syntax-count-quotes)
+ (python-indent-region, python-indent-shift-right)
+ (python-indent-dedent-line-backspace, python-nav-backward-sexp)
+ (python-nav-backward-sexp-safe, python-nav-backward-up-list)
+ (python-shell-prompt-block-regexp, python-shell-prompt-output-regexp)
+ (python-shell-prompt-pdb-regexp, python-shell-enable-font-lock)
+ (inferior-python-mode, python-shell-make-comint, run-python-internal)
+ (python-shell-buffer-substring, python-shell-send-buffer)
+ (python-pdbtrack-activate, python-pdbtrack-stacktrace-info-regexp)
+ (python-completion-complete-at-point, python-fill-docstring-style)
+ (python-eldoc-function, python-imenu-format-item-label)
+ (python-imenu-format-parent-item-label)
+ (python-imenu-format-parent-item-jump-label)
+ (python-imenu--build-tree, python-imenu-create-index)
+ (python-imenu-create-flat-index): Fix docstring typos.
+ (python-indent-context, python-shell-prompt-regexp, run-python):
+ Remove superfluous backslashes.
+ (python-indent-line, python-nav-beginning-of-defun)
+ (python-shell-get-buffer, python-shell-get-process)
+ (python-info-current-defun, python-info-current-line-comment-p)
+ (python-info-current-line-empty-p, python-util-popn): Doc fixes.
+ (python-indent-post-self-insert-function, python-shell-send-file)
+ (python-shell-completion-get-completions)
+ (python-shell-completion-complete-or-indent)
+ (python-eldoc--get-doc-at-point): Reflow docstrings.
+
+2014-03-14 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (package-menu-mode-map):
+ Replace use of obsolete function alias. Tweak menu item text.
+
+ * info.el (Info-finder-find-node):
+ Ignore the `emacs' metapackage. (Bug#10813)
+
+ * finder.el (finder-list-matches): Include unversioned packages
+ in the result of a keyword search.
+
+ * finder.el (finder--builtins-descriptions): New constant.
+ (finder-compile-keywords): Use finder--builtins-descriptions.
+
+2014-03-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * simple.el (blink-matching-paren): Describe the new value,
+ `jump', enabling the old behavior.
+ (blink-matching-open): Use that value. (Bug#17008)
+
+2014-03-14 Glenn Morris <rgm@gnu.org>
+
+ * finder.el (finder-no-scan-regexp): Add leim-list.
+ (finder-compile-keywords):
+ Don't skip files with same basename. (Bug#14010)
+ * Makefile.in (setwins_finder): New, excluding leim.
+ (finder-data): Use setwins_finder.
+
+ * help-fns.el (help-split-fundoc, help-add-fundoc-usage)
+ (help-function-arglist, help-make-usage): Move from here...
+ * help.el (help-split-fundoc, help-add-fundoc-usage)
+ (help-function-arglist, help-make-usage): ... to here. (Bug#17001)
+ * emacs-lisp/bytecomp.el (byte-compile-lambda): Do not load help-fns.
+
+2014-03-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * net/socks.el (socks, socks-override-functions)
+ (socks-find-services-entry):
+ * progmodes/hideif.el (hif-set-var, hif-nexttoken, hif-comma)
+ (hif-find-ifdef-block):
+ * progmodes/modula2.el (m2-indent): Fix docstring typos.
+
+ * net/tls.el (tls-program): Reflow docstring.
+
+ * progmodes/pascal.el (pascal-mode-abbrev-table)
+ (pascal-imenu-generic-expression, pascal-auto-endcomments)
+ (pascal-mark-defun, pascal-comment-area, pascal-indent-level)
+ (pascal-outline-mode): Fix docstring typos.
+ (pascal-mode): Let define-derived-mode document mode hook.
+ (pascal-uncomment-area): Reflow.
+ (pascal-exclude-str-start, pascal-exclude-str-end): Add docstring.
+
+ * progmodes/opascal.el (opascal-compound-block-indent)
+ (opascal-case-label-indent): Fix docstring typos.
+ (opascal-mode): Fix typos; let defined-derived-mode document mode hook.
+
+2014-03-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Fontify multiple adjacent negation chars. (Bug#17004)
+
+2014-03-13 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * emacs-lisp/package.el (package--prepare-dependencies):
+ Accept requirements without explicit version (bug#14941).
+
+2014-03-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * register.el (register-separator, copy-to-register): Doc fixes.
+ (register-preview-default): Remove unnecessary call to concat.
+
+ * frameset.el (frameset-restore): When checking for a visible frame,
+ use the action map instead of calling visible-frame-list.
+
+2014-03-12 Jonas Bernoulli <jonas@bernoul.li>
+
+ * emacs-lisp/eieio.el (with-slots): Use cl-symbol-macrolet (bug#16998).
+
+2014-03-12 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (fit-frame-to-buffer): Get maximum width from
+ display's width instead of height.
+
+2014-03-12 Glenn Morris <rgm@gnu.org>
+
+ * desktop.el (desktop-restore-frames)
+ (desktop-restore-in-current-display, desktop-restore-forces-onscreen)
+ (desktop-restore-reuses-frames): Doc tweaks.
+
+ * electric.el (electric-indent-mode): Doc fix.
+
+2014-03-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * vc/pcvs.el (cvs-temp-buffer, defun-cvs-mode, cvs-get-cvsroot)
+ (cvs-checkout, cvs-mode-checkout, cvs-update-filter, cvs-mode-mark)
+ (cvs-mode-diff-head, cvs-mode-diff-repository, cvs-mode-diff-yesterday)
+ (cvs-mode-diff-vendor, cvs-mode-do, cvs-change-cvsroot)
+ (cvs-dired-use-hook): Fix docstring typos.
+ (cvs-mode-view-file-other-window, cvs-mode-byte-compile-files):
+ Doc fixes.
+
+ * vc/pcvs-defs.el (cvs-auto-remove-handled)
+ (cvs-auto-remove-directories, cvs-default-ignore-marks)
+ (cvs-idiff-imerge-handlers, cvs-reuse-cvs-buffer)
+ (cvs-execute-single-dir): Fix docstring typos.
+
+ * vc/pcvs-info.el (cvs-status-map, cvs-states): Fix docstring typos.
+ (cvs-fileinfo-pp, cvs-fileinfo-from-entries): Doc fixes.
+
+ * vc/pcvs-parse.el (cvs-parsed-fileinfo): Reflow docstring.
+
+ * vc/pcvs-util.el (cvs-flags-query, cvs-flags-set, cvs-prefix-set):
+ Fix docstring typos.
+
+2014-03-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--jump-to-register): Add autoload; it could be
+ called from jump-to-register after unloading the frameset package.
+
+2014-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (set-mark): Ensure mark-active is nil if the mark is nil
+ (bug#16975). Deactivate the mark before setting it to nil.
+ (activate-mark): Do nothing if region is already active.
+
+2014-03-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--target-display): Remove definition; declare.
+ (frameset-save, frameset-restore): Let-bind frameset--target-display.
+
+2014-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--make-1): Fix autoloading avoidance.
+ (advice-add): Add a :advice--pending marker, so advice--make-1 knows
+ when the advice is pending.
+ (advice-remove): Remove this marker when not needed any more.
+
+2014-03-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el: Separate options for reusing frames and cleaning up.
+ (frameset--reuse-list): Remove definition; declare.
+ (frameset--action-map): Declare.
+ (frameset--find-frame-if): Doc fix.
+ (frameset--restore-frame): Cache frame action.
+ (frameset-restore): New keyword arg CLEANUP-FRAMES, allows to select
+ how to clean up the frame list after restoring. Remove cleaning
+ options from REUSE-FRAMES. Change all keyword values to symbols.
+ (frameset--jump-to-register): Simplify by using CLEANUP-FRAMES.
+
+ * desktop.el (desktop-restore-forces-onscreen)
+ (desktop-restore-reuses-frames): Use non-keyword values.
+ (desktop-restore-frameset): Use CLEANUP-FRAMES arg of frameset-restore.
+
+2014-03-10 Glenn Morris <rgm@gnu.org>
+
+ * files.el (find-file): Doc fix: update info node name.
+
+ * emacs-lisp/advice.el (ad-add-advice, defadvice):
+ Doc fix: remove references to deleted info nodes.
+
+2014-03-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
+ Do not add nil to the environment, when there's no remote `locale'.
+ (tramp-find-inline-encoding): Check, that the remote host has
+ installed perl, before sending scripts.
+
+2014-03-10 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/eldoc.el (eldoc-minibuffer-message):
+ Clear eldoc-last-message. (Bug#16920)
+
+2014-03-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * desktop.el (desktop-create-buffer): Don't run activate-mark-hook
+ (bug#14430).
+
+2014-03-09 Juri Linkov <juri@jurta.org>
+
+ * ansi-color.el (ansi-color-names-vector): Copy default colors
+ from `xterm-standard-colors' that look well on the default white
+ background (and also on the black background) to avoid illegible
+ color combinations like yellow-on-white and white-on-white.
+ http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00157.html
+
+2014-03-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-restore): When no frame is visible, do not
+ generate a list of frames, just make visible the selected one.
+
+2014-03-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-command): Turn FILE-OR-LIST into nil when
+ it only contains the repository root. (Bug#16897)
+
+2014-03-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Run first pass
+ only when `remote-file-name-inhibit-cache' is nil.
+ (tramp-sh-file-name-handler): Use `tramp-error'. Simplify code.
+
+2014-03-06 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (fit-frame-to-buffer, fit-frame-to-buffer-margins):
+ Fix doc-strings.
+ (fit-frame-to-buffer): New argument ONLY. Remove dependency on
+ fit-frame-to-buffer variable. Fix doc-string.
+ (fit-window-to-buffer): Set ONLY argument in call of
+ fit-frame-to-buffer. Fix doc-string.
+
+2014-03-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-error): VEC-OR-PROC can be nil.
+ (tramp-action-password): Clear password cache if needed.
+ (tramp-read-passwd): Do not clear password cache.
+
+ * net/tramp-gvfs.el (tramp-gvfs-handler-askpassword): Clear password
+ cache unless it is the first password request.
+
+2014-03-06 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (newline): Doc tweak.
+
+ * emacs-lisp/shadow.el (load-path-shadows-find):
+ Ignore dir-locals. (Bug#12357)
+
+2014-03-05 Glenn Morris <rgm@gnu.org>
+
+ * files.el (interpreter-mode-alist):
+ * progmodes/sh-script.el (sh-ancestor-alist): Add dash. (Bug#16938)
+
+2014-03-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--initial-params): Filter out null entries.
+
+2014-03-05 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-min-height, window-min-width):
+ Rewrite doc-strings.
+ (window-body-size): Add PIXELWISE argument to make it consistent
+ with its callees.
+
+2014-03-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * finder.el (finder-mode-map, finder-mode-syntax-table):
+ Revert part of 2014-02-28 change.
+
+2014-03-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-mode-map): [tab] doesn't work on tty.
+ (eww-setup-buffer): Clear next/prev/etc more reliably.
+ (eww-textarea-map): [tab] doesn't work on tty.
+ Reported by Mario Lang.
+
+ * net/shr.el (shr-map): Ditto.
+
+2014-03-04 Glenn Morris <rgm@gnu.org>
+
+ * minibuffer.el (completion-hilit-commonality):
+ Revert 2014-03-01 short-cut, which changed the return value. (Bug#16933)
+
+2014-03-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * hilit-chg.el (hilit-chg-unload-function): New function.
+ (highlight-changes-mode, highlight-changes-visible-mode): Fix typos.
+ (hilit-chg-map-changes): Prefer cardinal number to digit.
+ (hilit-chg-display-changes): Reflow docstring.
+ (highlight-changes-rotate-faces): Remove superfluous backslash.
+
+2014-03-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Do not call
+ `tramp-send-command-and-check'.
+
+2014-03-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * hexl.el (hexl-address-region, hexl-ascii-region)
+ (hexl-goto-hex-address, hexl-backward-char, hexl-forward-char)
+ (hexl-backward-short, hexl-forward-short, hexl-backward-word)
+ (hexl-forward-word, hexl-previous-line, hexl-next-line):
+ Use "Hexl mode" for non-hyperlinked hexl-mode references in docstrings.
+ (hexl-mode): Doc fix.
+ (hexl-ascii-start-column, hexl-beginning-of-line, hexl-end-of-line)
+ (hexl-mode-ruler): Fix typos in docstrings.
+
+ * strokes.el (strokes-xpm-header, strokes-rate-stroke): Fix typos.
+ (strokes-character, strokes-get-grid-position, strokes-list-strokes):
+ Remove superfluous backslashes.
+ (strokes-last-stroke, strokes-global-map, strokes-mode):
+ Reflow docstrings.
+ (strokes-xpm-for-stroke, strokes-xpm-to-compressed-string)
+ (strokes-xpm-for-compressed-string): Use quotes with buffer name.
+ (strokes-distance-squared, strokes-global-set-stroke)
+ (strokes-global-set-stroke-string): Doc fixes.
+ (strokes-help): Fix typos; reflow docstring.
+
+2014-03-04 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-in-direction): Fix doc-string.
+
+2014-03-04 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/smie.el (smie-config-guess): Doc fix.
+ Explicit error if no grammar.
+ (smie-config-save): Doc fix. Fix quote typo.
+
+2014-03-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/cc-mode.el (c-initialize-cc-mode): Only hook into
+ electric-indent-mode-hook if we obey electric-indent-mode.
+ (c-basic-common-init): Use (fboundp 'electric-indent-local-mode) to
+ decide whether we obey electric-indent-mode.
+ (c-change-set-fl-decl-start, c-extend-after-change-region):
+ Silence warnings.
+ (c-electric-indent-mode-hook): Assume we do want to obey
+ electric-indent-mode.
+
+ * electric.el (electric-indent-mode-has-been-called): Remove.
+ (electric-indent-mode): Fix accordingly.
+
+ * files.el (hack-local-variables): Mention file name in warning.
+
+ * htmlfontify.el (hfy-fontify-buffer): Drop `invis-range' message.
+
+2014-03-04 Michal Nazarewicz <mina86@mina86.com>
+
+ * bindings.el: Add comment describing why C-d binds to `delete-char'.
+ * simple.el (delete-forward-char): Mark as interactive-only.
+
+2014-03-03 Juanma Barranquero <lekktu@gmail.com>
+
+ * icomplete.el (icomplete-completions):
+ Follow-up to 2014-03-01 change.
+
+ * icomplete.el: Miscellaneous doc fixes.
+ Use Icomplete everywhere instead of icomplete for consistency.
+ (icomplete-max-delay-chars): Fix typo.
+ (icomplete-mode): Use \[].
+ (icomplete-tidy, icomplete-exhibit): Reflow.
+ (icomplete-minibuffer-setup-hook, icomplete-completions):
+ Remove superfluous backlashes.
+
+ * ido.el: Miscellaneous doc fixes.
+ Use Ido everywhere instead of ido or `ido' for consistency.
+ (ido-record-ftp-work-directories, ido-merge-ftp-work-directories)
+ (ido-cache-ftp-work-directory-time, ido-slow-ftp-hosts)
+ (ido-slow-ftp-host-regexps, ido-reread-directory): Upcase "ftp".
+ (ido-separator): Extract obsolescence info from docstring and declare
+ with make-obsolete-variable.
+ (ido-minibuffer-setup-hook): Simplify example.
+ (ido-text, ido-text-init, ido-input-stack, ido-report-no-match)
+ (ido-wide-find-file, ido-wide-find-dir, ido-wide-find-dir-or-delete-dir)
+ (ido-completion-help, ido-completing-read): Fix typos in docstrings.
+ (ido-everywhere): Reflow docstring.
+ (ido-toggle-vc): Doc fix.
+ (ido-switch-buffer, ido-find-file): Use tabs to improve legibility
+ of long list of keybindings.
+
+2014-03-03 Glenn Morris <rgm@gnu.org>
+
+ * frame.el (display-pixel-height, display-pixel-width)
+ (display-mm-dimensions-alist, display-mm-height)
+ (display-mm-width): Doc tweaks.
+
+2014-03-02 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * simple.el (undo-elt-in-region): Fix buffer corruption for edge
+ case of undo in region.
+
+2014-03-02 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (fit-window-to-buffer): Fix argument in window-size
+ call when window is horizontally combined.
+
+2014-03-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * icomplete.el (icomplete-completions): Use string-width.
+ Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
+
+2014-03-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Highlight regexp options. (Bug#16914)
+
+2014-03-01 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--max-delta-1): Round down when calculating
+ how many lines/columns we can get from a window.
+
+2014-03-01 Glenn Morris <rgm@gnu.org>
+
+ * isearch.el (search-invisible): Doc fix.
+
+ * minibuffer.el (completion-hilit-commonality):
+ Make `base-size' argument optional. Short-cut if `prefix-len' is 0.
+ * comint.el (comint-dynamic-list-completions): Doc fix.
+ * comint.el (comint-dynamic-list-completions):
+ * filecache.el (file-cache-minibuffer-complete):
+ * tempo.el (tempo-display-completions):
+ * eshell/em-hist.el (eshell-list-history):
+ Replace use of obsolete argument of display-completion-list.
+
+2014-03-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * icomplete.el (icomplete-completions):
+ Revert back to using "..." when ?… cannot be displayed.
+
+2014-02-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * finder.el (finder-unload-function): New function.
+
+2014-02-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * dframe.el (dframe-detach):
+ * find-dired.el (find-dired, find-name-dired):
+ * finder.el (finder-mode-map, finder-mode-syntax-table)
+ (finder-headmark, finder-select, finder-mouse-select):
+ Fix docstring typos.
+
+2014-02-28 Martin Rudalics <rudalics@gmx.at>
+
+ Revert recent with-temp-buffer-window change (Bug#16816, Bug#16882).
+ * window.el (with-temp-buffer-window): Revert change from 2014-02-21.
+ Suggested by Thierry Volpiatto <thierry.volpiatto@gmail.com>.
+ Fix doc-string based on a suggestion by Nicolas Richard
+ <theonewiththeevillook@yahoo.fr>.
+ * help.el (with-help-window): Fix doc-string.
+
+2014-02-28 Ivan Kanis <ivan@kanis.fr>
+
+ * net/shr.el (shr-image-animate): New option.
+ (shr-put-image): Respect shr-image-animate.
+
+2014-02-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el (tramp-adb-parse-device-names):
+ Use `accept-process-output'.
+ (tramp-adb-handle-file-truename): Cache the localname only.
+ (tramp-adb-handle-make-directory)
+ (tramp-adb-handle-delete-directory): Flush file properties correctly.
+ (tramp-adb-handle-set-file-modes): Do not raise an error when file
+ modes cannot be changed.
+
+ * net/tramp-cache.el (tramp-flush-directory-property): Remove also
+ file properties of symlinks.
+
+2014-02-28 Per Starbäck <starback@stp.lingfil.uu.se>
+
+ * textmodes/bibtex.el (bibtex-biblatex-entry-alist): Update
+ required/optional fields to match development biblatex. (Bug#16781)
+
+2014-02-28 Andy Sawyer <andy.sawyer@gmail.com> (tiny change)
+
+ * saveplace.el (toggle-save-place):
+ Fix argument handling. (Bug#16673)
+
+2014-02-28 Glenn Morris <rgm@gnu.org>
+
+ * minibuffer.el (completions-first-difference)
+ (completions-common-part, completion-hilit-commonality): Doc fixes.
+
+2014-02-28 Karl Berry <karl@gnu.org>
+
+ * info.el (Info-mode-map): Add H for describe-mode,
+ to synchronize with standalone Info.
+
+2014-02-28 Emilio C. Lopes <eclig@gmx.net>
+
+ * progmodes/sql.el (sql-interactive-mode):
+ Avoid setting global comint-input-ring-separator. (Bug#16814)
+
+2014-02-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus--init-bus): Declare function.
+ (dbus-path-local, dbus-interface-local): New defconst.
+ (dbus-init-bus): Use them.
+ (dbus-return-values-table): Extend doc.
+ (dbus-handle-bus-disconnect): Extend error message.
+
+2014-02-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * subr.el (y-or-n-p): Fix double space issue in message.
+
+2014-02-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-call-process): Improve trace message.
+ (tramp-handle-insert-file-contents): Trace error case.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist)
+ <insert-directory>: Use `tramp-handle-insert-directory'.
+ (tramp-adb-handle-insert-directory): Remove function.
+ (tramp-adb-send-command-and-check): New defun, replacing
+ `tramp-adb-command-exit-status'. Change all callees.
+ (tramp-adb-handle-file-attributes)
+ (tramp-adb-handle-directory-files-and-attributes): Use it.
+ (tramp-adb-ls-output-name-less-p):
+ Use `directory-listing-before-filename-regexp'.
+ (tramp-adb-handle-delete-directory): Flush also file properties of
+ the truename of directory.
+ (tramp-adb-handle-file-name-all-completions): Add "./" and "../".
+ (tramp-adb-handle-file-local-copy): Make the local copy readable.
+ (tramp-adb-handle-write-region): Implement APPEND.
+ (tramp-adb-handle-rename-file): Make it more robust. Flush file
+ properties correctly.
+ (tramp-adb-maybe-open-connection): Set `tramp-current-*'
+ variables. Check for connected devices only when needed.
+
+2014-02-27 Glenn Morris <rgm@gnu.org>
+
+ * minibuffer.el (completion-table-dynamic)
+ (completion-table-with-cache): Doc fixes.
+
+ * emacs-lisp/crm.el (crm-default-separator, crm-separator)
+ (completing-read-multiple): Doc fixes.
+
+2014-02-27 Daniel Colascione <dancol@dancol.org>
+
+ * minibuffer.el (completion--nth-completion): Fix indentation.
+
+ * net/tramp-sh.el (tramp-get-remote-path): Don't signal error when
+ explicit tramp path is empty.
+
+2014-02-27 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/crm.el (completing-read-multiple):
+ Empower help-enable-auto-load.
+
+2014-02-26 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line): Don't init the tty in daemon mode.
+
+ Avoid calling tty-setup-hook twice, eg if a term file
+ explicitly calls tty-run-terminal-initialization. (Bug#16859)
+ * faces.el (tty-run-terminal-initialization): Add run-hook argument.
+ (tty-create-frame-with-faces): Use it.
+ * startup.el (command-line): Pass run-hook argument
+ to tty-run-terminal-initialization.
+
+ * dired.el (dired-restore-desktop-buffer): Demote errors;
+ eg in case a glob match fails. (Bug#16884)
+
+2014-02-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp.el (lisp--local-variables): Catch `end-of-file'
+ error from `read-from-string'. (Bug#16850)
+
+ * emacs-lisp/ert.el (ert-run-tests-interactively): `read' the
+ result of `completing-read' in the interactive form. (Bug#16854)
+
+2014-02-25 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-animate, image-animate-timeout):
+ Stop animating images in dead buffers. (Bug#16878)
+
+ * emacs-lisp/edebug.el (defmacro): Fix debug spec. (Bug#16868)
+
+ * faces.el (tty-setup-hook, tty-run-terminal-initialization):
+ Doc fixes.
+ * startup.el (term-setup-hook): Doc fix. Make obsolete.
+ * term/sun.el (sun-raw-prefix-hooks):
+ Use tty-setup-hook instead of term-setup-hook.
+ (terminal-init-sun): Construct message from bytecomp plist.
+ * term/wyse50.el (enable-arrow-keys): Doc fix.
+
+2014-02-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * term/sun.el (kill-region-and-unmark, sun-raw-prefix-hooks):
+ Fix docstring typos.
+
+2014-02-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-truename): Improve last fix.
+
+2014-02-24 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * minibuffer.el (completion--try-word-completion):
+ Fix error when completing M-x commands (bug#16808).
+
+2014-02-24 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Fix debug spec.
+
+2014-02-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * apropos.el (apropos-print): Avoid formatting error when
+ apropos-do-all and apropos-compact-layout are both t.
+
+2014-02-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * apropos.el (apropos-property, apropos-all-words-regexp)
+ (apropos-true-hit, apropos-variable, apropos-print):
+ Fix docstring typos, and remove obsolete comment.
+
+2014-02-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-truename):
+ Preserve trailing "/". (Bug#16851)
+
+2014-02-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Don't indent specially
+ after `=>' (bug#16811).
+ (ruby-smie-rules): Handle the inconsistent second element of the
+ list returned by `smie-indent--parent'.
+ (ruby-font-lock-keywords): Disqualify any identifier before `=' as
+ method call.
+
+2014-02-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * elec-pair.el (electric-pair-text-syntax-table)
+ (electric-pair-syntax-info, electric-pair--syntax-ppss)
+ (electric-pair--balance-info, electric-pair-mode): Fix docstring typos.
+ (electric-pair--looking-at-unterminated-string-p): Doc fix.
+ (electric-pair--inside-string-p): Doc fix. Use `let', not `let*'.
+
+2014-02-22 Glenn Morris <rgm@gnu.org>
+
+ * imenu.el (imenu--generic-function): Doc fix.
+
+ * register.el (frame-configuration-to-register): Make obsolete.
+
+2014-02-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-save-buffer-p): Do not fail when
+ desktop-files-not-to-save is nil. Return t for true result
+ as the doc says.
+
+2014-02-22 Daniel Colascione <dancol@dancol.org>
+
+ * net/secrets.el (secrets-create-item, secrets-search-items):
+ Check that attribute values are strings, avoiding the construction
+ of invalid dbus messages.
+
+2014-02-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/gv.el: Avoid duplicating gv-expander and gv-setter in
+ defun-declarations-alist.
+
+2014-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-define-compiler-macro): Add indent rule
+ (bug#16829).
+
+2014-02-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * whitespace.el (whitespace-space, whitespace-hspace, whitespace-tab)
+ (whitespace-newline, whitespace-trailing, whitespace-line)
+ (whitespace-space-before-tab, whitespace-indentation, whitespace-empty)
+ (whitespace-space-after-tab): Fix typo in docstrings.
+
+2014-02-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Add missing "or".
+
+ * electric.el (electric-indent-functions-without-reindent):
+ Add `yaml-indent-line'.
+
+2014-02-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32-vars.el (w32-enable-synthesized-fonts): Mark as obsolete.
+ It has done nothing for years; should be removed after the release.
+
+ * simple.el (choose-completion): Fix docstring typo.
+ (read-quoted-char-radix): Remove unneeded * in docstring.
+ (process-file, kill-whole-line, pop-to-mark-command, set-mark-command):
+ Don't escape parentheses unnecessarily in docstrings.
+
+2014-02-21 Martin Rudalics <rudalics@gmx.at>
+
+ Fix handling of window-min-height/-width (Bug#16738).
+ * window.el (window--dump-window, window--dump-frame):
+ New functions.
+ (window--min-size-1): Account for window dividers.
+ When window-resize-pixelwise is nil, delay rounding till after the
+ sum of the window components has been calculated.
+ (window--min-delta-1, window--max-delta-1): When PIXELWISE is
+ nil make sure at least one text line and two text columns remain
+ fully visible.
+ (window-resize): Signal an error when window-resize-apply fails.
+ (window--resize-child-windows): Fix calculation of by how many
+ pixels a window can still be shrunk via window-new-normal.
+ (adjust-window-trailing-edge): Call window--resizable with
+ correct TRAIL argument.
+
+ (with-temp-buffer-window): Don't evaluate BODY within
+ with-current-buffer (Bug#16816).
+
+2014-02-21 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-check-cached-permissions):
+ Call `file-attributes' with `suffix' being a symbol but a string.
+
+2014-02-21 Daniel Colascione <dancol@dancol.org>
+
+ * net/dbus.el (dbus-init-bus-1): Declare new subr.
+ (dbus-init-bus): New function: call into dbus-init-bus-1
+ and installs a handler for the disconnect signal.
+ (dbus-call-method): Rewrite to look for result in cons.
+ (dbus-call-method-handler): Store result in cons.
+ (dbus-check-event): Recognize events with nil sender as valid.
+ (dbus-handle-bus-disconnect): New function. React to bus
+ disconnection signal by synthesizing dbus error for each
+ pending synchronous or asynchronous call.
+ (dbus-notice-synchronous-call-errors): New function.
+ (dbus-handle-event): Raise errors directly only when `dbus-debug'
+ is true, not all the time.
+
+2014-02-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * w32-fns.el (w32-enable-italics, w32-charset-to-codepage-alist):
+ Remove obsolescence declarations, these variables do not exist anymore.
+
+ * savehist.el (savehist-save-minibuffer-history)
+ (savehist-additional-variables, savehist-file, savehist-mode-hook)
+ (savehist-save-hook, savehist-coding-system, savehist-loaded)
+ (savehist-load, savehist-install, savehist-autosave): Fix typos;
+ mostly, refer to "Savehist mode" when talking about the mode,
+ and not the function.
+
+ * saveplace.el (save-place): Remove redundant info in docstring.
+ (save-place-forget-unreadable-files, toggle-save-place)
+ (save-place-forget-unreadable-files, save-place-dired-hook):
+ Fix typos and remove unneeded backslashes.
+
+2014-02-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (ls-lisp-use-insert-directory-program): Declare.
+ (tramp-handle-insert-directory): New defun, taken from tramp-gvfs.el.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
+ <insert-directory>: Use `tramp-handle-insert-directory'.
+ (tramp-gvfs-handle-insert-directory): Remove function.
+
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory):
+ Call `tramp-handle-insert-directory'.
+
+2014-02-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * elec-pair.el (electric-pair-syntax-info): Do not check syntax
+ before the start of buffer/region (bug#16799).
+
+2014-02-20 Glenn Morris <rgm@gnu.org>
+
+ * isearch.el (search-invisible): Doc fix.
+
+2014-02-20 W. Trevor King <wking@tremily.us> (tiny change)
+
+ * term/xterm.el (xterm--version-handler): Adapt to xterm-280's output
+ (bug#16657).
+
+2014-02-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-restore): Delay removing an old frame's
+ duplicate id until the new frame has been correctly created.
+
+2014-02-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-make-symbolic-link): New defun.
+ (tramp-check-cached-permissions): Call `file-attributes' if the
+ cache is empty.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist)
+ <make-symbolic-link>: Use `tramp-handle-make-symbolic-link'.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
+ <make-symbolic-link>: Use `tramp-handle-make-symbolic-link'.
+ (tramp-gvfs-maybe-open-connection): Set always connection
+ properties, even if target is mounted already.
+
+ * net/tramp-sh.el (tramp-color-escape-sequence-regexp):
+ Set tramp-autoload cookie.
+ (tramp-get-remote-touch): New defun.
+ (tramp-sh-handle-set-file-times): Use it.
+ (tramp-sh-handle-directory-files-and-attributes):
+ Use `tramp-handle-directory-files-and-attributes' if neither stat
+ nor perl are available on the remote host.
+
+ * net/tramp-smb.el (tramp-smb-handle-insert-directory): Mark trailing
+ "/". Write long listing only when "l" belongs to the switches.
+
+ * net/trampver.el: Update release number.
+
+2014-02-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--reuse-frame): Remove workaround for bug#16793.
+
+2014-02-19 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-state-put): Allow WINDOW to refer to an
+ internal window (Bug#16793).
+
+2014-02-19 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/remember.el: Move provide statement to end.
+ (remember-mode-map, remember-notes-mode-map, remember-notes-mode)
+ (remember-notes): Doc fixes.
+
+2014-02-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * delsel.el (delete-char): Restore incorrectly erased property
+ (bug#16795).
+
+2014-02-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--restore-frame): When a frame is being reused
+ and its root window is not alive, delete all the frame's windows before
+ restoring the window state. This works around the issue in bug#16793.
+
+2014-02-18 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/remember.el (remember-data-directory)
+ (remember-directory-file-name-format, remember-store-in-files)
+ (remember-notes-initial-major-mode, remember-notes-bury-on-kill)
+ (remember-notes-save-and-bury-buffer)
+ (remember-notes--kill-buffer-query): Doc fixes.
+
+ * desktop.el (desktop-save-mode, desktop-auto-save-timeout): Doc fixes.
+
+2014-02-17 Alan Mackenzie <acm@muc.de>
+
+ Connect electric-indent-mode up with CC Mode. Bug #15478.
+ * progmodes/cc-mode.el (c-initialize-cc-mode): Add CC Mode hooks
+ to electric-indent-{,local-}-mode.
+ (c-basic-common-init): Set electric-indent-inhibit.
+ Initialize c-electric-flag from electric-indent-mode.
+ (c-electric-indent-mode-hook, c-electric-indent-local-mode-hook):
+ New hook functions which propagate electric-indent-mode to CC mode.
+
+ * progmodes/cc-cmds.el (c-toggle-electric-state): When C-c C-l is
+ hit, toggle electric-indent-local-mode.
+
+ * electric.el (electric-indent-mode-has-been-called):
+ New variable.
+
+2014-02-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-cfg-id): New function.
+ (frameset--reuse-frame, frameset-restore): Use it.
+ (frameset--jump-to-register): Try harder to reuse frames (bug#16748).
+
+2014-02-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ido.el (ido-file-internal): Remove unused var `d'.
+ Use \` for to match BoS. Fit within 80n columns.
+
+2014-02-17 Daniel Colascione <dancol@dancol.org>
+
+ * net/dbus.el (dbus-call-method): Work around bug#16775 by having
+ dbus-call-method check for completion using a busy-wait loop with
+ gradual backoff.
+
+2014-02-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.9.
+
+ * net/trampver.el: Update release number.
+
+2014-02-16 Dmitry Gutov <dgutov@yandex.ru>
+
+ * ido.el (ido-file-internal): Don't add the name of an existing
+ directory twice. (Bug#16747)
+
+2014-02-16 Glenn Morris <rgm@gnu.org>
+
+ * vc/ediff-init.el (ediff-use-faces, ediff-highlight-all-diffs):
+ Do not use ediff-defvar-local on pre-defined variables. (Bug#16744)
+
+2014-02-15 Michael R. Mauger <michael@mauger.com>
+
+ * progmodes/sql.el: Version 3.4
+ (sql-oracle-options): New default value ("-L").
+ (sql-mode-oracle-font-lock-keywords): Add placeholder highlighting.
+ (sql-placeholders-filter): Correct placeholder pattern.
+ (sql-read-table-name): Bug fix. Detect absence of SQLi process.
+ (sql-login-delay): New variable.
+ (sql-product-interactive): Use it.
+
+2014-02-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--jump-to-register): Check that buffer is live
+ (bug#16749).
+
+2014-02-15 Glenn Morris <rgm@gnu.org>
+
+ * info.el (info-initialize): Revert 2014-01-10 change.
+
+2014-02-14 Glenn Morris <rgm@gnu.org>
+
+ * replace.el (map-query-replace-regexp)
+ (read-regexp-defaults-function, read-regexp): Doc fixes.
+
+ * dired.el (dired-read-regexp):
+ * faces.el (list-faces-display):
+ * misearch.el (multi-isearch-read-matching-buffers)
+ (multi-isearch-read-matching-files):
+ * play/cookie1.el (cookie-apropos):
+ * progmodes/grep.el (grep-read-regexp): Doc fixes.
+
+ * textmodes/remember.el (remember): Use frameset-to-register
+ rather than frame-configuration-to-register.
+
+2014-02-14 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-menu.el (calc-vectors-menu): Remove menu item for
+ incorrect keybinding.
+
+2014-02-13 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/flymake.el (flymake-post-syntax-check): Widen buffer
+ when adding overlays so that line numbers from compiler match line
+ numbers we use.
+
+2014-02-13 Glenn Morris <rgm@gnu.org>
+
+ * mail/rmail.el (rmail-probe): Be less strict. (Bug#16743)
+
+ * jit-lock.el (jit-lock-mode): Doc fix.
+
+2014-02-13 Juanma Barranquero <lekktu@gmail.com>
+
+ * apropos.el (apropos-read-pattern): When the user passes an empty
+ string, give a more helpful error message than "Wrong type
+ argument: stringp, nil".
+
+2014-02-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * jit-lock.el (jit-lock-mode): Keep it disabled in indirect buffers.
+
+2014-02-13 Glenn Morris <rgm@gnu.org>
+
+ * finder.el (finder-known-keywords, finder-mode-map): Doc fixes.
+
+2014-02-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-base.el (cua-scroll-up, cua-scroll-down): Mark them as
+ shift-select commands.
+
+2014-02-12 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-indent-line): Don't widen.
+ http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00276.html
+
+2014-02-12 Glenn Morris <rgm@gnu.org>
+
+ * icomplete.el (icomplete): Add info-link to defgroup.
+ (icomplete-with-completion-tables, icomplete-minibuffer-setup-hook)
+ (icomplete-minibuffer-map, icomplete-mode)
+ (icomplete-simple-completing-p, icomplete-completions): Doc fixes.
+
+ * emacs-lisp/package.el (package-menu-mode-map): Tweak menu.
+ (package-menu-filter): Rename from package-menu-filter-interactive.
+ Doc fix.
+
+2014-02-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--jump-to-register): Select the required
+ window and buffer before restoring position (bug#16696).
+
+2014-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * dired.el (dired-get-marked-files): Clarify doc (bug#11534).
+
+2014-02-10 Glenn Morris <rgm@gnu.org>
+
+ * jit-lock.el (jit-lock-force-redisplay): Doc fix. (Bug#14394)
+
+2014-02-10 Eli Zaretskii <eliz@gnu.org>
+
+ * w32-common-fns.el (x-get-selection): Doc fix.
+ * select.el (x-get-selection): Doc fix. (Bug#15109)
+
+ * face-remap.el (face-remap-add-relative)
+ (face-remap-remove-relative, face-remap-reset-base)
+ (face-remap-set-base): Call force-mode-line-update to redisplay
+ the current buffer due to potential change in faces. (Bug#16709)
+
+2014-02-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Apply heredoc
+ script more robustly.
+
+2014-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * dired.el (dired-get-marked-files): Doc fix (bug#11534).
+
+ * simple.el (choose-completion): Doc fix (bug#14160).
+
+ * subr.el (event-start): Say what a nil EVENT value means.
+
+ * kmacro.el (kmacro-bind-to-key): Say that the parameter is unused
+ (bug#14197).
+
+ * progmodes/grep.el (find-program): Doc fix (bug#14289).
+
+ * files.el (confirm-kill-emacs): Clarify doc (bug#15455).
+
+ * emacs-lisp/lisp.el (up-list): Doc fix (bug#15832).
+
+ * files.el (confirm-kill-emacs): Allow specifying an arbitrary
+ predicate function (bug#15455).
+
+2014-02-10 Dmitry Gutov <dgutov@yandex.ru>
+
+ * ielm.el (inferior-emacs-lisp-mode): Instead of
+ `comment-use-global-state', set `comment-use-syntax'.
+
+2014-02-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/gulp.el (gulp-discard): Add emacs-devel.
+
+2014-02-09 Alan Mackenzie <acm@muc.de>
+
+ Fix c-invalidate-state-cache on narrowed buffers.
+ * progmodes/cc-defs.el (c-with-all-but-one-cpps-commented-out):
+ Widen when setting and clearing the CPP delimiter properties.
+
+2014-02-09 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * help.el (describe-bindings): Doc fix (bug#9888).
+
+ * files.el (save-buffer): Use ARG as the parameter name for
+ consistency (bug#10346).
+ (save-buffer): Clarify the 0 argument (bug#10346).
+
+ * cus-edit.el (customize-apropos): Fix error string.
+ (custom-buffer-create): Doc fix (bug#11122).
+ (custom-sort-items): Doc fix (bug#11121).
+
+ * repeat.el (repeat-message-function): Reword doc slightly (bug#11619).
+
+ * icomplete.el (icomplete-with-completion-tables): Doc fix (bug#11654).
+ (icomplete-simple-completing-p): Mention the previous variable.
+
+ * font-lock.el (font-lock-value-in-major-mode): Clarify the
+ meaning of the parameter (bug#12282).
+
+ * files.el (find-file-noselect): Clarify prompt when changing
+ readedness (bug#13261).
+ (locate-file): Suffixes aren't returned, so don't say that they
+ are (bug#12674).
+ (backup-inhibited): Doc clarification (bug#12525).
+
+ * dired.el (dired-internal-do-deletions): Don't say "Deleting..."
+ before we actually start to delete things (bug#16331).
+
+ * subr.el (event-start): Doc fix (bug#14228).
+ (event-end): Ditto.
+
+2014-02-09 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/warnings.el (lwarn):
+ Empower help-enable-auto-load. (Bug#15940)
+
+2014-02-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * vc/log-edit.el (log-edit-comment-to-change-log): Doc fix.
+ (Bug#16690)
+
+2014-02-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Insert output at end of buffer. (Bug#16120)
+
+2014-02-08 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * simple.el (choose-completion-string-functions): Document new
+ calling convention (bug#14153).
+ (execute-extended-command): Clarify doc string (bug#13373).
+
+ * kmacro.el (kmacro-exec-ring-item): Doc fix (bug#14198).
+
+ * find-dired.el (find-name-dired): Doc fix (bug#14290).
+ (find-grep-dired): Doc fix (bug#14288).
+
+2014-02-08 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-quote-char): Check character validity
+ like in `quoted-insert' (bug#16677).
+
+2014-02-08 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * files.el (find-file-visit-truename): Doc clarification (bug#14697).
+
+ * isearch.el (isearch-hide-immediately): Doc clarification
+ (bug#14723).
+
+ * simple.el (line-move): Document utility function used many
+ places in the Emacs sources (bug#14843).
+
+ * dired.el (dired-mode-map): Make :help text more accurate (bug#14893).
+ (dired-prev-marked-file): Doc fix (bug#14855).
+ (dired-up-directory): Doc fix (bug#14848).
+
+ * minibuffer.el (read-file-name): Doc clarification (bug#15096).
+
+ * files.el (file-relative-name): Doc fix (bug#15159).
+
+ * fringe.el (fringe-styles): Doc fix (bug#15239).
+
+ * isearch.el (isearch-filter-predicate): Documentation typo fix
+ (bug#15474).
+
+ * info-look.el (info-lookup-symbol): Document MODE (bug#15498).
+
+ * isearch.el (isearch-cmds): Doc clarification (bug#15547).
+
+ * replace.el (replace-match-maybe-edit): Doc clarification
+ (bug#15632).
+
+ * subr.el (add-to-list): Refill the paragraphs (bug#15791).
+
+ * macros.el (insert-kbd-macro): Doc fix (bug#16025).
+
+2014-02-08 Glenn Morris <rgm@gnu.org>
+
+ * help-fns.el (describe-variable):
+ Check {file,dir}-local-variables-alist, and buffer-file-name,
+ in the correct buffer.
+
+2014-02-08 Ingo Lohmar <i.lohmar@gmail.com>
+
+ * help-fns.el (describe-variable): Fix the case where
+ a value is directory-local with no dir-locals file. (Bug#16635)
+
+2014-02-08 Glenn Morris <rgm@gnu.org>
+
+ * abbrev.el (edit-abbrevs-mode):
+ Derive from fundamental-mode. (Bug#16682)
+
+2014-02-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * simple.el (quoted-insert): Check character validity (bug#16677).
+
+2014-02-07 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-read): Claim the lock when the owner is not
+ the current process. (Bug#16157)
+
+2014-02-07 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-buffers-not-to-save): Change default from nil
+ to "\\` ". (Bug#16651)
+
+2014-02-07 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-save-mode): Call `desktop-auto-save-set-timer'
+ when enabling, and `desktop-auto-save-cancel-timer' when disabling.
+ (desktop-auto-save-cancel-timer): New function with some code from
+ `desktop-auto-save-set-timer'.
+ (after-init-hook): Don't call `desktop-auto-save-set-timer'.
+ Instead of setting `desktop-save-mode' to nil, call
+ `desktop-save-mode' with arg 0. (Bug#16630)
+
+2014-02-07 Glenn Morris <rgm@gnu.org>
+
+ * hi-lock.el (hi-lock-auto-select-face, hi-lock-line-face-buffer)
+ (hi-lock-face-buffer, hi-lock-face-phrase-buffer)
+ (hi-lock-face-symbol-at-point, hi-lock-read-face-name): Doc tweaks.
+
+ * obsolete/iswitchb.el: Move to obsolete/.
+ * simple.el (iswitchb-mode): Add manual autoloads to ease transition,
+ since obsolete/ is not scanned for autoloads.
+ * emacs-lisp/authors.el (authors-valid-file-names):
+ Add iswitchb.el.
+
+ * obsolete/meese.el: Restore as obsolete (deleted 2014-01-11).
+ Disable now non-functional find-file-hook.
+
+2014-02-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process): Use "&&"
+ instead of ";" in order to avoid additional prompts. Let heredoc
+ scripts read from tty. (Bug#16582)
+ (tramp-send-command): No special handling of heredocs, it isn't
+ necessary anymore.
+
+2014-02-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point): Symbols don't start
+ with a space (bug#16664). Limit the symbols considered to the ones
+ that are bound or fbound (bug#16646).
+
+2014-02-06 Glenn Morris <rgm@gnu.org>
+
+ * epa.el (epa-mail-aliases): Doc fix.
+
+2014-02-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point):
+ Use `completion-table-merge' instead of `completion-table-in-turn'
+ (bug#16604).
+
+ * minibuffer.el (completion-table-merge): New function.
+
+2014-02-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-end-of-heredoc): New defconst.
+ (tramp-sh-handle-set-file-acl)
+ (tramp-sh-handle-start-file-process)
+ (tramp-sh-handle-write-region, tramp-sh-handle-vc-registered)
+ (tramp-find-executable, tramp-send-command): Use it.
+
+2014-02-05 Glenn Morris <rgm@gnu.org>
+
+ * epa.el (epa-mail-aliases): Fix custom type. Doc tweak.
+
+2014-02-04 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-send-string)
+ (python-shell-send-string-no-output): Fix docstring (Bug#16547).
+
+2014-02-04 Anders Lindgren <andlind@gmail.com>
+
+ * emacs-lisp/ert.el (ert--activate-font-lock-keywords): Allow dashes in
+ the names (bug#16620).
+
+2014-02-03 Martin Rudalics <rudalics@gmx.at>
+
+ * faces.el (window-divider): New default value. Rewrite doc-string.
+ (window-divider-first-pixel, window-divider-last-pixel): New faces.
+
+2014-02-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): `private',
+ `protected' and `public' can also be called without arguments.
+
+2014-02-03 Glenn Morris <rgm@gnu.org>
+
+ * register.el (window-configuration-to-register)
+ (frame-configuration-to-register): Unadvertise unused argument.
+ * frameset.el (frameset-to-register): Remove unused argument.
+
+ * frameset.el (frameset-to-register):
+ * kmacro.el (kmacro-to-register):
+ * register.el (increment-register):
+ * calc/calc-yank.el (calc-copy-to-register, calc-insert-register)
+ (calc-append-to-register, calc-prepend-to-register):
+ * play/gametree.el (gametree-layout-to-register)
+ (gametree-apply-register-layout):
+ * textmodes/picture.el (picture-clear-rectangle-to-register)
+ (picture-yank-rectangle-from-register):
+ * vc/emerge.el (emerge-combine-versions-register):
+ Use register-read-with-preview to read registers.
+
+2014-02-03 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair-backward-delete-char): Don't error
+ when at beginning of (possibly narrowed) buffer.
+
+2014-02-02 Daniel Colascione <dancol@dancol.org>
+
+ * help-at-pt.el (help-at-pt-string, help-at-pt-maybe-display):
+ Also try to display local help from just before point.
+
+2014-02-02 Alan Mackenzie <acm@muc.de>
+
+ c-parse-state. Don't "append-lower-brace-pair" in certain
+ circumstances. Also fix an obscure bug where "\\s!" shouldn't be
+ recognised as a comment.
+
+ * progmodes/cc-engine.el (c-state-pp-to-literal): Check for "\\s!"
+ as well as normal comment starter.
+ (c-parse-state-get-strategy): Extra return possibility
+ 'back-and-forward.
+ (c-remove-stale-state-cache): Extra element CONS-SEPARATED in
+ return value list to indicate replacement of a brace-pair cons
+ with its car.
+ (c-parse-state-1): With 'back-and-forward, only call
+ c-append-lower-brace-pair-to state-cache when cons-separated.
+
+2014-02-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (ns-suspend-error): New function.
+ (ns-initialize-window-system): Add ns-suspend-error to
+ suspend-hook (Bug#16612).
+
+2014-02-02 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/cc-defs.el (c-find-assignment-for-mode):
+ Make loading cc-mode silent.
+
+2014-02-02 Daniel Colascione <dancol@dancol.org>
+
+ * comint.el (comint-prompt-read-only): Change doc to suggest
+ remap keybinding.
+
+2014-02-02 Glenn Morris <rgm@gnu.org>
+
+ * register.el (register-read-with-preview, point-to-register)
+ (window-configuration-to-register, frame-configuration-to-register)
+ (jump-to-register, number-to-register, view-register, insert-register)
+ (copy-to-register, append-to-register, prepend-to-register)
+ (copy-rectangle-to-register): Doc fixes.
+
+2014-02-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (help-C-file-name): Handle advised functions (bug#16478).
+ * emacs-lisp/find-func.el (find-function-C-source): Idem.
+ * emacs-lisp/nadvice.el (advice--cd*r): New function.
+ * help-fns.el (describe-function-1): Use it.
+
+2014-02-02 Glenn Morris <rgm@gnu.org>
+
+ * register.el (register-preview-default): New function,
+ split from register-preview.
+ (register-preview-function): Rename from register-preview-functions,
+ make it not a hook.
+ (register-preview): Use register-preview-function.
+ (register-read-with-preview): Error on non-character event. (Bug#16595)
+
+2014-02-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Check for
+ `:' before binary operators (bug#16609). Don't check for `:'
+ before `[' and `(', or their syntax status. A percent literal
+ can't end with either.
+ (ruby-font-lock-keywords): For built-ins that require arguments,
+ check that they're followed by something that looks like argument
+ (bug#16610).
+
+2014-02-01 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * subr.el (butlast): Document what an omitted N means (bug#13437).
+ (nbutlast): Ditto.
+
+2014-01-31 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-generic): Make into a defsubst to make the stack
+ depth shallower (bug#16587).
+ (shr-tag-svg): Respect `shr-inhibit-images'.
+ (shr-dom-to-xml): Respect `shr-blocked-images' (bug#15882).
+
+2014-01-31 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-align-chained-calls): New option.
+ (ruby-smie-grammar): Make "." right-associative. Make its priority
+ lower than the ternary and all binary operators.
+ (ruby-smie-rules): Indent "(" relative to the first non-"."
+ parent, or the first "." parent at indentation.
+ Use `ruby-align-chained-calls' for indentation of "." tokens.
+ (Bug#16593)
+
+2014-01-31 Juri Linkov <juri@jurta.org>
+
+ * sort.el (delete-duplicate-lines): Remove `:weakness 'key'
+ from `make-hash-table'.
+
+ * textmodes/ispell.el (ispell-init-process): Change message format
+ to be consistent with other messages.
+
+2014-01-31 Glenn Morris <rgm@gnu.org>
+
+ * delsel.el (delete-selection-mode): Doc fix.
+
+ * emacs-lisp/trace.el (trace--read-args, trace-function-foreground)
+ (trace-function-background): Doc fixes.
+
+ * ido.el (ido-use-virtual-buffers): Doc fix.
+ Reset :version, since the default value has not changed.
+
+ * register.el (register-preview-delay, register-read-with-preview):
+ Doc fixes.
+
+ * mail/reporter.el (reporter-dump-variable): In case of void-variable,
+ do not mess with mail-buffer position (fixes 2009-11-03 change).
+ * progmodes/cc-mode.el (c-submit-bug-report):
+ Check auto-fill-mode is bound. (Bug#16592)
+
+2014-01-31 Darren Hoo <darren.hoo@gmail.com>
+
+ * startup.el (fancy-splash-image-file): New function,
+ split from fancy-splash-head.
+ (fancy-splash-head, use-fancy-splash-screens-p): Use it,
+ so that we are both using the same image. (Bug#16574)
+
+2014-01-30 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (eval-expression): Doc fix.
+
+ * hexl.el (hexl-mode-hook):
+ * ielm.el (ielm-mode-hook):
+ * emacs-lisp/lisp-mode.el (emacs-lisp-mode-hook)
+ (lisp-interaction-mode-hook):
+ * progmodes/cfengine.el (cfengine3-documentation-function):
+ Replace obsolete alias `turn-on-eldoc-mode' with `eldoc-mode'.
+
+2014-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-opt.el (eieio-help-generic): Don't assume `generic'
+ is a symbol (bug#16584).
+
+2014-01-30 Glenn Morris <rgm@gnu.org>
+
+ * help.el (help-for-help-internal): Add "P" to text.
+
+2014-01-29 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (just-one-space, cycle-spacing): Doc fixes.
+
+2014-01-28 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (fit-frame-to-buffer): Fix calculations for margins and
+ height constraints.
+
+2014-01-28 Luke Lee <luke.yx.lee@gmail.com>
+
+ * progmodes/hideif.el: Extend to full CPP expression syntax.
+ (hif-token-alist): Add missing tokens.
+ (hif-token-regexp): Add support for float/octal/hex immediates.
+ (hif-string-literal-regexp): New const.
+ (hif-tokenize): Recognize strings and float/octal/hex immediates.
+ (hif-exprlist): New function.
+ (hif-parse-if-exp): Use it.
+ (hif-logior-expr, hif-logxor-expr, hif-logand-expr, hif-comp-expr)
+ (hif-logshift-expr, hif-muldiv-expr, hif-lognot, hif-shiftleft)
+ (hif-shiftright, hif-multiply, hif-divide, hif-modulo, hif-equal)
+ (hif-logxor, hif-comma): New functions.
+
+2014-01-28 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/fill.el (fill-single-char-nobreak-p): Doc tweak.
+
+ * indent.el (tab-stop-list): Doc fix. Add :version.
+
+ * vc/pcvs.el (vc-editable-p, vc-checkout): Remove unused declarations.
+ (cvs-append-to-ignore): Add compatibility alias.
+
+2014-01-27 Glenn Morris <rgm@gnu.org>
+
+ * dired.el (dired-hide-details-mode): Don't autoload it,
+ since it cannot be used outside Dired buffers anyway.
+
+ * emulation/cua-base.el (cua-mode): Doc fix.
+
+ * dired.el (dired-hide-details-hide-symlink-targets)
+ (dired-hide-details-hide-information-lines)
+ (dired-hide-details-mode): Doc fixes.
+
+ * shadowfile.el (shadow-info-file, shadow-todo-file): Doc fix.
+ * strokes.el (strokes-file): Doc fix. Bump :version.
+ (strokes-help): Doc fix.
+ * emulation/viper-init.el (viper-vi-style-in-minibuffer): Doc fix.
+ * emulation/viper.el (viper): Doc fix for custom group.
+ (top-level): Remove oh-so-no-longer-relevant text about vip.
+ * obsolete/otodo-mode.el (todo-prefix): Doc fix.
+
+ * ido.el (ido-save-directory-list-file):
+ * saveplace.el (save-place-file):
+ * calendar/timeclock.el (timeclock-file):
+ * net/quickurl.el (quickurl-url-file):
+ * obsolete/otodo-mode.el (todo-file-do, todo-file-done, todo-file-top):
+ * progmodes/idlwave.el (idlwave-config-directory):
+ * textmodes/remember.el (remember-data-file):
+ Bump :version.
+
+2014-01-26 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/opascal.el (opascal-tab-always-indents, opascal-tab):
+ Doc fix. Make obsolete.
+ (opascal-mode): No longer mention opascal-tab-always-indents in doc.
+
+ * sort.el (delete-duplicate-lines): Doc fix.
+
+2014-01-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/ada-mode.el (ada):
+ * woman.el (woman): Link to info manual and Commentary section.
+
+ * progmodes/flymake.el (flymake):
+ * nxml/nxml-mode.el (nxml):
+ * net/eww.el (eww):
+ * speedbar.el (speedbar, speedbar-faces, speedbar-vc):
+ * htmlfontify.el (htmlfontify):
+ * ses.el (ses):
+ * epa.el (epa):
+ * ido.el (ido): Link to info manual.
+
+2014-01-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake-make-overlay): No rear advance.
+
+2014-01-25 Adam Sjøgren <asjo@koldfront.dk>
+
+ * net/shr.el (shr-tag-img): Prefer the title over the alt text
+ (bug#16537).
+
+2014-01-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * net/eww.el (eww-download-callback):
+ Fix reference to eww-download-directory.
+
+ * emacs-lisp/bytecomp.el (byte-compile-file):
+ Remove unused local variable `file-name'.
+
+2014-01-24 Glenn Morris <rgm@gnu.org>
+
+ * woman.el (woman-default-faces, woman-monochrome-faces):
+ Fix obsolescence specification.
+
+ * subr.el (with-demoted-errors): Doc fix.
+
+2014-01-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el: Improve type->predicate mapping (bug#16520).
+ (cl--macroexp-fboundp): New function.
+ (cl--make-type-test): Use it.
+
+2014-01-23 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (eval-print-last-sexp, eval-last-sexp):
+ * simple.el (eval-expression): Doc fixes.
+
+2014-01-22 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries): Addition.
+
+2014-01-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el: Write files silently.
+ (package-autoload-ensure-default-file, package--write-file-no-coding)
+ (package-generate-description-file, package--download-one-archive)
+ (package-install-from-archive): Tell `write-region' to stay quiet.
+ (package-menu-mode, package-menu--print-info): Omit the Archive column
+ if there's only one archive.
+ (package-all-keywords, package--has-keyword-p): Remove dead code.
+
+2014-01-22 Glenn Morris <rgm@gnu.org>
+
+ * version.el (emacs-bzr-version-bzr): Fix typo.
+
+ * version.el (emacs-repository-get-version):
+ Check either .bzr or .git, but not both.
+ Make the git case actually use the DIR argument, and return nil
+ rather than the empty string.
+ Avoid error if .git exists but the git executable is not found.
+
+2014-01-22 Martin Rudalics <rudalics@gmx.at>
+
+ Fixes in window size functions around Bug#16430 and Bug#16470.
+ * window.el (window-total-size, window-size): New argument ROUND.
+ (window--min-delta-1, window-min-delta, window--max-delta-1):
+ Be more conservative when calculating the numbers of lines or
+ columns a window can shrink (Bug#16430).
+ (fit-window-to-buffer): Simplify code.
+ * term.el (term-window-width): Call window-body-width again.
+
+2014-01-22 Glenn Morris <rgm@gnu.org>
+
+ * image.el (image-format-suffixes): Doc fix.
+
+ * international/quail.el (quail-define-package): Doc fix.
+
+ * emacs-lisp/authors.el (authors-valid-file-names)
+ (authors-renamed-files-alist): Additions.
+
+ * vc/vc-git.el (vc-git-print-log): Remove --follow;
+ reverts 2014-01-09 change. (Bug#16422)
+
+ * calc/calc-embed.el (thing-at-point-looking-at):
+ * emacs-lisp/map-ynp.el (x-popup-dialog):
+ * obsolete/lmenu.el (x-popup-dialog):
+ * emacs-lisp/package.el (url-recreate-url):
+ * mail/mailclient.el (clipboard-kill-ring-save):
+ * subr.el (x-popup-dialog): Update declaration.
+ * mail/rmail.el (rmail-mime-message-p):
+ * window.el (tool-bar-lines-needed): Remove unnecessary declaration.
+
+2014-01-21 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/sh-script.el (sh--inside-noncommand-expression):
+ Correctly detect when we're inside an arithmetic expansion form
+ containing nested parenthesis.
+ (sh--maybe-here-document): Use `sh--inside-noncommand-expression'
+ to detect cases where we shouldn't expand "<<" to a heredoc
+ skeleton.
+
+2014-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el: Properly remove message in minibuffer case.
+ (eldoc--message-command-p): New function.
+ (eldoc-display-message-p): Use it.
+ (eldoc-pre-command-refresh-echo-area): In the minibuffer case, the
+ message is not automatically erased for us.
+ (eldoc-print-current-symbol-info): Erase previous message, if any.
+
+2014-01-21 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex.el (reftex-create-bibtex-file): Fix autoload to
+ specify it's an interactive function.
+
+ * textmodes/reftex-cite.el (reftex-all-used-citation-keys):
+ Fix regex used for scanning for citation keys which failed for
+ citations with optional arguments.
+
+2014-01-21 Leo Liu <sdl.web@gmail.com>
+
+ * simple.el (read--expression): Don't enable eldoc-mode.
+
+2014-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (move-beginning-of-line): Make sure we don't move forward
+ (bug#16497).
+
+2014-01-20 Juri Linkov <juri@jurta.org>
+
+ * saveplace.el (toggle-save-place, save-place-to-alist)
+ (save-places-to-alist, save-place-dired-hook): Add (derived-mode-p
+ 'dired-mode) before checking for dired-directory. (Bug#16477)
+
+2014-01-20 Juri Linkov <juri@jurta.org>
+
+ * indent.el (indent-line-to): Use backward-to-indentation
+ instead of back-to-indentation. (Bug#16461)
+
+2014-01-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert some of the CANNOT_DUMP fix (Bug#16494).
+ Because of this, "make bootstrap" won't work if CANNOT_DUMP=yes,
+ but fixing this can wait until after the next release.
+ * Makefile.in (emacs): Keep EMACSLOADPATH empty.
+
+2014-01-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * eshell/esh-mode.el (eshell-password-prompt-regexp):
+ Use `password-word-equivalents'.
+ (eshell-watch-for-password-prompt): Let-bind `case-fold-search'
+ to t. (Bug#5664, Bug#13124)
+
+2014-01-19 Alan Mackenzie <acm@muc.de>
+
+ Bind open-paren-in-column-0-is-defun-start to nil at some entry
+ points.
+ * progmodes/cc-engine.el (c-invalidate-state-cache-1)
+ (c-parse-state-1, c-guess-basic-syntax): Bind it here.
+ * progmodes/cc-mode.el (c-before-change, c-after-change)
+ (c-font-lock-fontify-region): Bind it here.
+
+2014-01-19 Martin Rudalics <rudalics@gmx.at>
+
+ * term.el (term-window-width): Call window-text-width instead of
+ window-width (Bug#16470).
+
+2014-01-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * simple.el (password-word-equivalents): Remove duplicates.
+ Sort, to make this easier next time.
+ Downcase. Omit ": " after "jelszó".
+
+2014-01-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/common-win.el (saved-region-selection): Defvar it.
+ (x-select-text): Set saved-region-selection (Bug#16382).
+
+2014-01-18 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases)
+ (authors-renamed-files-alist): Add some entries.
+
+2014-01-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-password-prompt-regexp):
+ Use `password-word-equivalents' if available.
+ (tramp-action-password, tramp-process-one-action)
+ (tramp-read-passwd): Let-bind `case-fold-search' to t. (Bug#13124)
+
+2014-01-17 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (password-word-equivalents): New defcustom.
+ * comint.el (comint-password-prompt-regexp): Use it. Bump version
+ to 24.4.
+ (comint-watch-for-password-prompt): Let-bind `case-fold-search'
+ to t. (Bug#13124)
+
+2014-01-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-alignable-keywords): New constant.
+ (ruby-align-to-stmt-keywords): Change the default value.
+ Use `ruby-alignable-keywords' to generate the possible customization
+ choices.
+ (ruby-smie-rules): Instead of using a hardcoded list of alignable
+ keywords, check against the value of `ruby-alignable-keywords'
+ (http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01439.html).
+
+2014-01-17 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-aliases): Remove unnecessary entries.
+
+ Make M-x authors return zero *Authors Errors* from current logs.
+ * emacs-lisp/authors.el (authors-obsolete-files-regexps)
+ (authors-ignored-files): Add some entries, remove others.
+ (authors-ambiguous-files, authors-valid-file-names):
+ Add some entries.
+ (authors-renamed-files-alist): Add, remove, and adjust entries.
+ (authors-renamed-files-regexps): Add some entries.
+ Remove some very broad ones. Make some entries `lax'.
+ (authors-lax-changelogs): New constant.
+ (authors-disambiguate-file-name): Treat top-level specially.
+ (authors-lax-changelog-p): New function.
+ (authors-canonical-file-name): Check file as written against
+ authors-valid-file-names. Do not special-case etc/.
+ Handle `lax' logs and authors-renamed-files-regexps elements.
+
+2014-01-16 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-desc--keywords): Use `cdr' with
+ `assoc'. Use `nth' instead of `cdr'. Make private. Update all
+ callers.
+
+2014-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * follow.el (follow-adjust-window): Remove `dest' argument (bug#16426).
+ Assume we're already in the proper buffer.
+ Inspired by Anders Lindgren <andlind@gmail.com>.
+ (follow-post-command-hook): Call it from the right buffer.
+ (follow-comint-scroll-to-bottom): Adjust call.
+ (follow-all-followers): Use get-buffer-window-list.
+
+2014-01-15 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file): Use whole
+ `buffer-file-name' in interactive-form so that we don't leave
+ pathless file names in `file-name-history'.
+
+2014-01-15 Juri Linkov <juri@jurta.org>
+
+ * indent.el (indent-rigidly): Set deactivate-mark to nil
+ in transient indentation mode. (Bug#16438)
+
+2014-01-15 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-desc-keywords): New function
+ (Bug#16222).
+ (describe-package-1, package-all-keywords)
+ (package--has-keyword-p): Use it.
+
+2014-01-14 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * simple.el (define-alternatives): When creating the
+ COMMAND-alternatives variable, assign COMMAND as its definition
+ name so that `describe-variable' can relocate it.
+
+2014-01-14 Matthew Leach <matthew@mattleach.net>
+
+ * font-lock.el (font-lock-keywords): Fix typo in docstring
+ (bug#16307).
+
+2014-01-14 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-region): Reset `in-comment' for new
+ line instead of wrongly reset `add-coment' (bug#13577).
+
+2014-01-14 Daiki Ueno <ueno@gnu.org>
+
+ * epa-file.el (epa-file-write-region): Encode the region according
+ to `buffer-file-format'. Problem reported at:
+ <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>.
+
+2014-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug--display): Move protective let-binding
+ so it applies in the right buffer (bug#16410).
+
+2014-01-13 Daniel Colascione <dancol@dancol.org>
+
+ * textmodes/rst.el (rst-define-key): Provide deprecated
+ keybindings through named functions instead of anonymous ones so
+ that "??" doesn't appear in describe-mode output.
+
+2014-01-13 Bastien Guerry <bzg@gnu.org>
+
+ * simple.el (define-alternatives): Call the selected command
+ interactively. When setting `COMMAND--implementation' for the
+ first time, tell the user how to chose another implementation.
+ Enhance the docstring.
+
+2014-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/log-edit.el: Fix highlighting of summary when it's the first line.
+ (log-edit--match-first-line): New function.
+ (log-edit-font-lock-keywords): Use it.
+ (log-edit-mode): Make jit-lock-defer-multiline work.
+
+2014-01-13 Bastien Guerry <bzg@gnu.org>
+
+ * rect.el (rectangle-mark-mode): When the region is not active,
+ display a message saying that the mark as been set and that
+ rectangle mode is in use.
+ (rectangle--highlight-for-redisplay): Only put an overlay with a
+ visible vertical bar when (display-graphic-p) is non-nil.
+ This partially fixes Bug#16403.
+
+2014-01-13 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-find-file): Go to DIR before displaying the error
+ about a nonexistent file if no previous Info file is visited.
+ Use `user-error' instead of `error' for "Info file %s does not exist".
+ (Info-find-node-2): In case of a nonexistent node in unwind forms
+ go to the Top node if there is no previous node to revert to.
+ (Bug#16405)
+
+2014-01-13 Martin Rudalics <rudalics@gmx.at>
+
+ fit-frame/window-to-buffer code fixes including one for Bug#14096.
+ * window.el (fit-frame-to-buffer): Fix doc-string.
+ Respect window-min-height/-width. Fit pixelwise when
+ frame-resize-pixelwise is non-nil. Adjust right/bottom edge
+ when avoiding that frame goes partially off-screen.
+ (fit-window-to-buffer): Respect window-min-height/-width
+ (Bug#14096).
+
+2014-01-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * indent.el (indent-according-to-mode): Flush to column 0 in text-mode
+ after an empty line.
+
+2014-01-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/shr.el (shr-render-region): Autoload.
+
+2014-01-12 Xue Fuqiao <xfq.free@gmail.com>
+
+ * net/eww.el (eww-download-directory): Rename from
+ `eww-download-path' (Bug#16419).
+
+2014-01-12 Leo Liu <sdl.web@gmail.com>
+
+ * dired-x.el (dired-mode-map): Fix last change.
+
+ * emacs-lisp/eldoc.el (eldoc-mode): Add hook locally.
+
+2014-01-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * emacs-lisp/generic.el (generic--normalize-comments):
+ Rename from generic--normalise-comments. All uses changed.
+ * play/bubbles.el (bubbles--neighborhood-score)
+ (bubbles--mark-direct-neighbors, bubbles--mark-neighborhood)
+ (bubbles--neighborhood-available)
+ (bubbles--update-neighborhood-score):
+ Rename from names with 'neighbourhood'. All uses changed.
+
+2014-01-12 Leo Liu <sdl.web@gmail.com>
+
+ Re-implement the feature of showing eldoc info after editing.
+ * emacs-lisp/eldoc.el (eldoc-post-insert-mode): Remove.
+ (eldoc-edit-message-commands): New function.
+ (eldoc-print-after-edit): New variable.
+ (eldoc-pre-command-refresh-echo-area): Emit message only by
+ eldoc-message-commands.
+ (eldoc-mode): Restrict eldoc-message-commands to editing commands
+ if eldoc-print-after-edit is set. (Bug#16346)
+ * simple.el (read--expression): Enable eldoc-mode.
+ * progmodes/octave.el (octave-mode-menu): Adapt to change in eldoc.
+
+2014-01-11 Dani Moncayo <dmoncayo@gmail.com>
+ Eric S. Raymond <esr@thyrsus.com>
+
+ * version.el (emacs-repository-get-version): Enhance so the
+ function works correctly in either a Bazaar or Git repo.
+
+2014-01-11 Eric S. Raymond <esr@thyrsus.com>
+
+ * play/meese.el: It's 2014 and Ed Meese is justly forgotten.
+ Goes with removal of the joke manpages from /etc.
+
+2014-01-10 Kenichi Handa <handa@gnu.org>
+
+ * mail/rmail.el (rmail-get-coding-system):
+ Check rmail-get-coding-function before "funcall"ing it.
+
+2014-01-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries):
+ Update for files that no longer exist.
+
+2014-01-10 Eric S. Raymond <esr@thyrsus.com>
+
+ * version.el (emacs-bzr-get-version): Restore compatibilty with
+ 24.3 (Tested).
+
+2014-01-10 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Add .podspec
+ and Podfile.
+
+2014-01-10 Eli Zaretskii <eliz@gnu.org>
+
+ * emacs-lisp/authors.el (authors-fixed-entries): Update my entry.
+
+2014-01-10 Chong Yidong <cyd@gnu.org>
+
+ * progmodes/octave.el (octave-mode-menu): Don't assume eldoc is loaded.
+
+2014-01-10 Anders Lindgren <andlind@gmail.com>
+
+ * follow.el (follow-cache-command-list): Include right-char and
+ left-char.
+
+2014-01-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * mail/unrmail.el (unrmail-mbox-format): Choice is mboxo, not mboxro.
+ * woman.el (woman-mark-horizontal-position):
+ Rename from woman-mark-horizonal-position. Use changed.
+
+2014-01-10 Glenn Morris <rgm@gnu.org>
+
+ * info.el (info-initialize): If running uninstalled, ensure our
+ own info files are always found first, even if INFOPATH is set.
+
+ * help.el (view-order-manuals): Open emacs.info rather than ORDERS.
+
+2014-01-09 David Engster <deng@randomsample.de>
+
+ * emacs-lisp/eieio-custom.el:
+ * emacs-lisp/eieio-opt.el: Set generated autoload file to
+ 'eieio.el'. This was accidentally removed in 2012-10-01T18:10:29Z!cyd@gnu.org.
+ * emacs-lisp/eieio.el: Regenerate autoloads.
+
+2014-01-09 Eric S. Raymond <esr@thyrsus.com>
+
+ * vc/vc-git.el (vc-git-print-log): Add --follow option to command,
+ following renames. (Bug#8756)
+
+2014-01-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (deactivate-mark, activate-mark): Force-mode-line-update
+ (bug#16382).
+ (activate-mark): Add `no-tmm' argument.
+ (set-mark, push-mark-command): Use it instead of running
+ activate-mark-hook by hand.
+
+2014-01-08 Eric S. Raymond <esr@thyrsus.com>
+
+ In preparation for the move to git, sanitize out some
+ Bazaar-specific names.
+
+ * emacs-lisp/authors.el: INSTALL.BZR renamed to INSTALL.REPO.
+
+ * version.el (emacs-bzr-version): Name changed to
+ emacs-repository-version. Obsolete-variable alias made.
+ * loadup.el: Follow through on this name change.
+ * mail/emacsbug.el (report-emacs-bug): Factor out any
+ assumption about the version control system in use.
+
+2014-01-08 David Engster <deng@randomsample.de>
+
+ * help-fns.el (help-fns-describe-function-functions):
+ New variable to call functions for augmenting help buffers.
+ (describe-function-1): Remove explicit calls to
+ `help-fns--compiler-macro', `help-fns--parent-mode' and
+ `help-fns--obsolete'. Put them in above new variable instead, and
+ call them through `run-hook-with-args'.
+ * emacs-lisp/eieio-opt.el (eieio-help-class): Rename from
+ `eieio-describe-class'. Not meant for interactive use anymore,
+ but to augment existing help buffers. Remove optional second
+ argument. Create proper button for file location.
+ Rewrite function to use `insert' instead of `princ' and `prin1' where
+ possible.
+ (eieio-help-class-slots): Rename from `eieio-describe-class-slots'.
+ (eieio-method-def, eieio-class-def): Move further up.
+ (describe-method, describe-generic, eieio-describe-method):
+ Remove aliases.
+ (eieio-help-constructor, eieio-help-generic): Rename from
+ `eieio-describe-constructor' and `eieio-describe-generic', resp.
+ Rewrite to use `insert' in the current buffer and use proper help
+ buttons.
+ (eieio-help-find-method-definition)
+ (eieio-help-find-class-definition): Also accept symbols as
+ arguments.
+ (eieio-help-mode-augmentation-maybee): Remove.
+ (eieio-describe-class-sb): Use `describe-function'.
+ * emacs-lisp/eieio.el (help-fns-describe-function-functions):
+ Add `eieio-help-generic' and `eieio-help-constructor'.
+
+2014-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * language/china-util.el (hz-ascii-designation):
+ Rename from hz-ascii-designnation.
+ (hz-ascii-designation): Rename from hz-ascii-designnation.
+ All uses changed.
+
+2014-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-delete): Only remove pkg-desc from
+ package-alist.
+
+2014-01-08 Bastien Guerry <bzg@gnu.org>
+
+ * emacs-lisp/package.el (package-delete):
+ Correctly delete the package from package-alist.
+
+2014-01-08 Daiki Ueno <ueno@gnu.org>
+
+ * emacs-lisp/package.el (url-recreate-url): Declare.
+ (url-http-target-url): Declare.
+ (package-handle-response): Include requested URL in the error message.
+ (package--check-signature): Don't re-signal errors from
+ package--with-work-buffer. Suggested by Stefan Monnier.
+
+2014-01-07 Bastien Guerry <bzg@gnu.org>
+
+ * minibuffer.el (completion--try-word-completion): When both a
+ hyphen and a space are possible candidates for the character
+ following a word, display both candidates. (Bug#15980)
+
+2014-01-07 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (balance-windows-2): While rounding don't give a
+ window more than the remainder. Bug#16351, bug#16383.
+
+2014-01-07 Glenn Morris <rgm@gnu.org>
+
+ * menu-bar.el (menu-bar-help-extra-packages): Remove.
+ (menu-bar-help-menu): Use view-external-packages instead.
+
+2014-01-07 Bastien Guerry <bzg@gnu.org>
+
+ * emacs-lisp/package.el (package-delete): Also delete the package
+ name from `package-alist', not its description only.
+
+2014-01-07 Glenn Morris <rgm@gnu.org>
+
+ * help.el (view-external-packages):
+ * menu-bar.el (menu-bar-help-extra-packages):
+ Visit efaq.info rather than etc/MORE.STUFF.
+
+2014-01-07 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Bind [return] and [backspace] to
+ isearch-exit and isearch-delete-char resp. (Bug#16342, bug#16035)
+
+ * progmodes/ps-mode.el (ps-mode-map): Remove [return] key binding
+ that shadows RET. (Bug#16342)
+
+2014-01-07 Chong Yidong <cyd@gnu.org>
+
+ * isearch.el (isearch-yank-char, isearch-yank-word)
+ (isearch-yank-line): Doc fix.
+
+2014-01-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * abbrev.el (define-abbrev): Beware new meaning of fboundp.
+ * emacs-lisp/elint.el (elint-find-builtins):
+ * emacs-lisp/eldoc.el (eldoc-symbol-function):
+ * emacs-lisp/bytecomp.el (byte-compile-callargs-warn)
+ (byte-compile-file-form-defmumble, byte-compile, byte-compile-form):
+ * emacs-lisp/byte-opt.el (byte-compile-inline-expand):
+ * apropos.el (apropos-safe-documentation):
+ * subr.el (symbol-file): Remove redundant fboundp.
+ * progmodes/idlw-shell.el (idlwave-shell-comint-filter): Use defalias.
+
+2014-01-06 Bastien Guerry <bzg@gnu.org>
+
+ * hl-line.el (global-hl-line-overlay): Make a local variable.
+ (global-hl-line-overlays): New variable to store all overlays.
+ (global-hl-line-mode): Don't delete overlays from the current
+ buffer when `global-hl-line-sticky-flag' is non-nil.
+ (global-hl-line-highlight): Add new overlays to
+ `global-hl-line-overlays'.
+ (global-hl-line-unhighlight-all): New function to delete all
+ overlays when turning off `global-hl-line-mode'.
+ This fixes Bug#16183.
+
+2014-01-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (set-transient-map): Fix nested case and docstring.
+
+2014-01-06 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-label-alist-builtin): Add a
+ `Texinfo' entry.
+
+2014-01-06 Daniel Colascione <dancol@dancol.org>
+
+ Fix defun navigation in vc log view.
+
+ * vc/log-view.el (log-view-beginning-of-defun): Rewrite to behave
+ like `beginning-of-defun'.
+ (log-view-end-of-defun, log-view-end-of-defun-1): Rename old
+ log-view-end-of-defun to log-view-end-of-defun-1. Replace
+ log-view-end-of-defun with wrapper that behaves like `end-of-defun'.
+ (log-view-extract-comment): Call `log-view-current-entry' directly
+ instead of relying on broken `log-view-beginning-of-defun' behavior.
+
+2014-01-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * calc/calc-yank.el (calc-edit-mode, calc-edit-cancel):
+ * emacs-lisp/debug.el (cancel-debug-on-entry):
+ * epg.el (epg-error-to-string):
+ * files.el (recover-file):
+ * lpr.el (lpr-buffer, print-buffer, lpr-region, print-region):
+ * mail/emacsbug.el (report-emacs-bug-hook):
+ * mail/sendmail.el (mail-recover):
+ * ses.el (ses-yank-resize):
+ * term/ns-win.el (ns-print-buffer):
+ Spelling fixes in diagnostics, mostly for "canceled" with one L.
+ * epg.el (epg-key-capability-alist): Rename from misspelled version.
+ All uses changed.
+ * obsolete/xesam.el (xesam-all-fields): Fix misspelled field name.
+
+2014-01-06 Leo Liu <sdl.web@gmail.com>
+
+ * dired-x.el (dired-mode-map): Rebind dired-omit-mode to C-x M-o
+ to avoid shadowing global key. (Bug#16354)
+
+2014-01-06 Daniel Colascione <dancol@dancol.org>
+
+ * textmodes/rst.el (rst-mode): Set electric-indent-inhibit for
+ rst-mode.
+
+2014-01-05 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (balance-windows): Add mising t to fix Bug#16351.
+
+2014-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-descend): Don't bug out if the anchor is empty
+ (bug#16285).
+ (shr-insert): If we have a word that's longer than `shr-width',
+ break after it anyway. Otherwise we'll do no breaking once we get
+ such a long word.
+
+2014-01-05 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww): Support single/double quote for search.
+ * net/eww.el (eww-list-histories, eww-history-browse): Fixup.
+ (eww-history-quit): Delete and use quit-window.
+ (eww-history-kill): Delete, because it doesn't work well and
+ not necessary.
+ (eww-history-mode-map): Delete some keys and add easy-menu.
+
+2014-01-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix misspelling of 'chinese' in rx (Bug#16237).
+ * emacs-lisp/rx.el (rx-categories): Correct spelling of
+ chinese-two-byte.
+
+ Change subword regexps back to vars (Bug#16296).
+ * progmodes/subword.el (subword-forward-regexp)
+ (subword-backward-regexp): Change these back to variables.
+
+2014-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables): Don't bother with
+ syntax-begin-function (bug#16247).
+
+2014-01-03 Chong Yidong <cyd@gnu.org>
+
+ * emacs-lisp/nadvice.el (advice--make-docstring): Change args.
+ (advice--docstring): Delete variable.
+ (advice--make-1): Leave the docstring empty.
+ (advice-add): Use function-documentation for advised docstring.
+
+ * emacs-lisp/advice.el (ad--make-advised-docstring): Change args.
+ Ignore function-documentation property when getting documentation.
+ (ad-activate-advised-definition): Use function-documentation
+ generate the docstring.
+ (ad-make-advised-definition): Don't call
+ ad-make-advised-definition-docstring.
+ (ad-make-advised-definition-docstring, ad-advised-definition-p):
+ Delete functions.
+
+ * progmodes/sql.el (sql-help): Use function-documentation instead
+ of dynamic-docstring-function property. No need to autoload now.
+ (sql--help-docstring): New variable.
+ (sql--make-help-docstring): Use it.
+
+2014-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ielm.el (ielm-tab): Retarget.
+ (ielm-map): Use ielm-tab for tab.
+ (ielm-complete-filename): Use comint-filename-completion.
+ (ielm-complete-symbol): Remove.
+ (inferior-emacs-lisp-mode): Use lisp-completion-at-point instead and
+ remove ielm-tab from completion-at-point-functions (bug#16224).
+
+ * emacs-lisp/pcase.el (pcase--split-equal, pcase--split-member):
+ Beware signals raised by predicates (bug#16201).
+
+2014-01-02 Richard Stallman <rms@gnu.org>
+
+ * dired-aux.el (dired-do-print): Handle printer-name.
+
+ * mail/rmailmm.el (rmail-mime-message-p): Move to rmail.el.
+ * mail/rmail.el (rmail-mime-message-p): Move from rmailmm.el.
+ (rmail-epa-decrypt): Turn off mime processing.
+
+ * mail/rmail.el (rmail-make-in-reply-to-field):
+ Add parens in message-id.
+
+ * mail/rmail.el (rmail-get-coding-function): Variable.
+ (rmail-get-coding-system): Use it.
+
+2013-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule-conf.el: Unify the charset indian-is13194.
+ (indian-is13194): Specify unify-map.
+
+2013-12-31 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (set-temporary-overlay-map): Obsolete alias. (Bug#16305)
+
+2013-12-30 Daniel Colascione <dancol@dancol.org>
+
+ * term/x-win.el ([XF86WakeUp]): Ignore the XF86WakeUp key instead
+ of printing a useless when we resume from sleep.
+
+ * progmodes/sh-script.el
+ (sh-smie-sh-forward-token, sh-smie-rc-forward-token): Fix infloop
+ in indentation code. (Bug#16233)
+
+2013-12-28 João Távora <joaotavora@gmail.com>
+
+ * elec-pair.el (electric-pair-post-self-insert-function):
+ Don't open extra newlines at beginning of buffer. (Bug#16272)
+
+2013-12-28 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (window-system-for-display): Don't allow to create a
+ GUI frame from a -nw session on MS-Windows. (Bug#14739)
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * mail/hashcash.el (hashcash-program): Rename from hashcash-path.
+ Update callers.
+
+ * apropos.el (apropos-match-face):
+ * calculator.el (calculator-displayer):
+ * dabbrev.el (dabbrev-search-these-buffers-only):
+ * face-remap.el (buffer-face-mode-face):
+ * simple.el (yank-handled-properties):
+ * emacs-lisp/testcover.el (testcover-potentially-1value-functions):
+ * mail/footnote.el (footnote-mode-line-string, footnote-prefix):
+ * mail/hashcash.el (hashcash-accept-resources, hashcash-program)
+ (hashcash-double-spend-database):
+ * progmodes/ruby-mode.el (ruby-deep-indent-paren)
+ (ruby-deep-indent-paren-style):
+ * textmodes/flyspell.el (flyspell-auto-correct-binding):
+ * textmodes/rst.el (rst-toc-indent, rst-toc-insert-style)
+ (rst-toc-insert-number-separator, rst-toc-insert-max-level):
+ * vc/pcvs-defs.el (cvs-minor-mode-prefix):
+ Specify custom types.
+
+ * emacs-lisp/smie.el (smie-config): Add type, version, initialize.
+ * bookmark.el (bookmark-bmenu-use-header-line):
+ * doc-view.el (doc-view-scale-internally):
+ * pcmpl-x.el (pcmpl-x-tlmgr-program, pcmpl-x-ack-program):
+ * register.el (register-preview-delay):
+ * net/shr.el (shr-bullet):
+ * progmodes/cfengine.el (cfengine-cf-promises)
+ (cfengine-parameters-indent):
+ * progmodes/octave.el (inferior-octave-error-regexp-alist):
+ * textmodes/reftex-vars.el (reftex-label-regexps):
+ * vc/log-edit.el (log-edit-setup-add-author): Add version.
+
+ * net/tls.el (tls-certtool-program): Fix default value.
+
+ * desktop.el (desktop-restore-in-current-display):
+ * newcomment.el (comment-empty-lines):
+ * progmodes/idlwave.el (idlwave-scan-all-buffers-for-routine-info)
+ (idlwave-pad-keyword):
+ * progmodes/tcl.el (tcl-tab-always-indent):
+ * textmodes/reftex-vars.el (reftex-index-default-tag):
+ * elec-pair.el (electric-pair-skip-whitespace):
+ * progmodes/cfengine.el (cfengine-cf-promises): Fix custom types.
+
+ * emacs-lisp/authors.el (authors-ignored-files)
+ (authors-valid-file-names, authors-renamed-files-alist): Additions.
+
+2013-12-27 Jarek Czekalski <jarekczek@poczta.onet.pl>
+
+ * shell.el (shell-dynamic-complete-command): Doc fix.
+ (shell--command-completion-data): Shell completion now matches
+ executable filenames from the current buffer's directory, on
+ systems in which this behavior is the default (windows-nt, ms-dos).
+
+2013-12-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Don't infloop if the width is zero.
+
+2013-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * icomplete.el (icomplete-show-matches-on-no-input): Default to nil
+ (bug#16251).
+
+ * electric.el: Move all electric-pair-* to elec-pair.el.
+ * elec-pair.el: New file, split from electric.el.
+
+2013-12-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-find-fill-point): Don't try to fill if the
+ indentation level is larger than the width, because that will
+ infloop.
+ (shr-insert): Fill repeatedly long texts, so that Japanese is
+ formatted correctly (bug#16263).
+ (shr-find-fill-point): Off by one error in comparison with the
+ indentation.
+
+2013-12-26 João Távora <joaotavora@gmail.com>
+
+ * electric.el (electric-pair-mode): More flexible engine for skip-
+ and inhibit predicates, new options for pairing-related functionality.
+ (electric-pair-preserve-balance): Pair/skip parentheses and quotes
+ if that keeps or improves their balance in buffers.
+ (electric-pair-delete-adjacent-pairs): Delete the pair when
+ backspacing over adjacent matched delimiters.
+ (electric-pair-open-extra-newline): Open extra newline when
+ inserting newlines between adjacent matched delimiters.
+ (electric--sort-post-self-insertion-hook):
+ Sort post-self-insert-hook according to priority values when
+ minor-modes are activated.
+ * simple.el (newline-and-indent): Call newline with interactive
+ set to t.
+ (blink-paren-post-self-insert-function): Set priority to 100.
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ Use electric-pair-text-pairs to pair backtick-and-quote in strings and
+ comments. Locally set electric-pair-skip-whitespace to 'chomp and
+ electric-pair-open-newline-between-pairs to nil.
+
+2013-12-26 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el: Use lexical-binding.
+ (python-nav-beginning-of-defun): Stop searching ASAP.
+
+2013-12-25 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc.el (vc-ignore): Use `vc-responsible-backend'.
+ Fix interactive spec. Doc fix. (Bug#15754)
+
+2013-12-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * emacs-lisp/byte-run.el (eval-when-compile):
+ * progmodes/cc-defs.el (cc-eval-when-compile):
+ Fix edebug spec (bug#16184).
+
+2013-12-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-visit-file): Remove debugging function.
+ (shr-insert): Don't infloop if we can't find a good place to break
+ the line (bug#16256).
+
+2013-12-25 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-nav--lisp-forward-sexp): New function.
+ (python-nav--lisp-forward-sexp-safe): Use it. Rename from
+ python-nav-lisp-forward-sexp-safe.
+ (python-nav--forward-sexp): New argument SAFE allows switching
+ forward sexp movement behavior for parens.
+ (python-nav-forward-sexp): Throw errors on unterminated parens
+ (Bug#16191).
+ (python-nav-backward-sexp, python-nav-forward-sexp-safe)
+ (python-nav-backward-sexp-safe): New functions.
+ (python-shell-buffer-substring):
+ Use `python-nav-forward-sexp-safe'.
+
+2013-12-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-find-fill-point): Don't break lines before a
+ quotation mark.
+ (shr-char-kinsoku-bol-p): The quotation mark isn't a kinsoky BOL char.
+ (shr-find-fill-point): Remove the special checks for the quotation
+ mark, since `shr-char-kinsoku-bol-p' should now return the right thing.
+
+2013-12-25 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-form-textarea): Use a different face for
+ textareas than text input since they have different keymaps
+ (bug#16142).
+
+2013-12-24 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-nav-beginning-of-statement):
+ Speed up (Bug#15295).
+
+2013-12-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-bookmark-browse): Use `quit-window' to restore
+ the window configuration.
+
+2013-12-24 Eli Zaretskii <eliz@gnu.org>
+
+ * net/eww.el (eww-open-file): Ensure 3 slashes after "file:" when
+ we run on MS-Windows or MS-DOS.
+
+2013-12-24 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (balance-windows-area): Call window-size instead of
+ window-height and window-width. Bug#16241.
+
+2013-12-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-bookmark-quit): Remove.
+ (eww-bookmark-browse): Restore the window configuration when you
+ choose a bookmark (bug#16144).
+
+2013-12-24 Daniel Colascione <dancol@dancol.org>
+
+ * icomplete.el: Remove redundant :group arguments to `defcustom'
+ throughout.
+ (icomplete-show-matches-on-no-input): New customizable variable.
+ (icomplete-minibuffer-setup): Call `icomplete-exhibit' on setup if
+ we have something to show.
+ (icomplete-exhibit): Compute completions even if we have no user input.
+
+2013-12-23 Daniel Colascione <dancol@dancol.org>
+
+ * icomplete.el: Move `provide' to end of file.
+
+2013-12-23 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-verify-error): Add version tag.
+
+2013-12-23 Chong Yidong <cyd@gnu.org>
+
+ * subr.el (set-transient-map): Rename from
+ set-temporary-overlay-map. Doc fix.
+
+ * face-remap.el (text-scale-adjust):
+ * indent.el (indent-rigidly):
+ * kmacro.el (kmacro-call-macro):
+ * minibuffer.el (minibuffer-force-complete):
+ * repeat.el (repeat):
+ * simple.el (universal-argument--mode):
+ * calendar/todo-mode.el (todo-insert-item--next-param):
+ * progmodes/f90.el (f90-abbrev-start): Callers changed.
+
+ * indent.el (indent-rigidly): Use substitute-command-keys.
+
+2013-12-22 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-tag-select): Add text-property to jump to next
+ select field.
+ (eww): Add non-supported ftp error.
+
+2013-12-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby--electric-indent-p): Improve the
+ comments. Handle electric indent after typing `?' and `!'.
+
+2013-12-22 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (face-spec-recalc): If the theme specs are not
+ applicable to a frame, fall back on the defface spec.
+ This prevents themes from obliterating faces on low-color terminals.
+
+2013-12-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Return t
+ after `{'. We need it after block openers, and it doesn't seem
+ to hurt after hash openers.
+
+2013-12-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby--at-indentation-p): New function,
+ extracted from `ruby-smie-rules'.
+ (ruby--electric-indent-chars): New variable.
+ (ruby--electric-indent-p): New function.
+ (ruby-mode): Use `electric-indent-functions' instead of
+ `electric-indent-chars'.
+
+2013-12-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-align-to-stmt-keywords): Tweak the
+ docstring.
+ (ruby-smie-rules): Indent plus one level after `=>'.
+
+2013-12-21 Richard Stallman <rms@gnu.org>
+
+ * simple.el (newline): Doc fix.
+
+2013-12-21 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-list-histories, eww-list-histories)
+ (eww-history-browse, eww-history-quit, eww-history-kill)
+ (eww-history-mode-map, eww-history-mode): New command and
+ functions to list browser histories.
+ (eww-form-text): Support text form with disabled
+ and readonly attributes.
+ (eww-checkbox-map): Fix wrong key bind to `eww-toggle-checkbox'.
+
+2013-12-21 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * net/eww.el (eww-back-url, eww-forward-url, eww-next-url)
+ (eww-previous-url, eww-up-url, eww-top-url, eww-add-bookmark)
+ (eww-bookmark-prepare, eww-bookmark-kill, eww-bookmark-yank)
+ (eww-bookmark-browse, eww-next-bookmark, eww-previous-bookmark):
+ Use `user-error'.
+ (eww-bookmark-mode-map): Add menu.
+ (eww-render, eww-mode): Use `setq-local'.
+ (eww-tool-bar-map): New variable.
+ (eww-mode): Set `tool-bar-map'.
+ (eww-view-source): Check for `html-mode' with `fboundp'.
+
+2013-12-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr--extract-best-source): Don't bug out on audio
+ elements with text inside. Also remove debugging.
+
+2013-12-21 Jan Djärv <jan.h.d@swipnet.se>
+
+ * cus-start.el (all): Add ns-use-srgb-colorspace.
+
+2013-12-21 Chong Yidong <cyd@gnu.org>
+
+ * custom.el (custom-theme-recalc-face): Do nothing if the face is
+ undefined. Thus, theme settings for undefined faces do not take
+ effect until the faces are defined with defface, the same as with
+ theme variables.
+
+ * faces.el (face-spec-set): Use face-spec-recalc in all cases.
+ (face-spec-reset-face): Don't assign extra properties in temacs.
+ (face-spec-recalc): Apply X resources too.
+
+2013-12-21 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (face-spec-set):
+ * cus-face.el (custom-theme-set-faces, custom-set-faces):
+ * custom.el (defface): Doc fixes (Bug#16203).
+
+ * indent.el (indent-rigidly-map): Add docstring, and move commands
+ into named functions.
+ (indent-rigidly-left, indent-rigidly-right)
+ (indent-rigidly-left-to-tab-stop)
+ (indent-rigidly-right-to-tab-stop): New functions. Decide on
+ indentation direction based on bidi direction, and accumulate
+ sequential commands in a single undo boundary.
+ (indent-rigidly--pop-undo): New utility function.
+
+2013-12-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * faces.el (read-face-name): Require crm.el when using crm-separator.
+
+2013-12-20 Daniel Colascione <dancol@dancol.org>
+
+ * progmodes/sh-script.el (sh-mode): Tweak paragraph-separate
+ so that we don't reflow comments into the shebang line.
+
+2013-12-20 Juri Linkov <juri@jurta.org>
+
+ * saveplace.el (save-place-to-alist): Add `dired-filename' as
+ a position when `dired-directory' is non-nil. Check integer
+ positions with `integerp'.
+ (toggle-save-place, save-places-to-alist): Add check for
+ `dired-directory'.
+ (save-place-find-file-hook): Check integer positions with
+ `integerp'.
+ (save-place-dired-hook): Use `dired-goto-file' when
+ `dired-filename' is found in the assoc list. Check integer
+ positions with `integerp'.
+ (dired-initial-position-hook): Rename from `dired-initial-point-hook'.
+
+ * dired.el (dired-initial-position-hook): Rename back from
+ `dired-initial-point-hook'.
+ (dired-initial-position): Rename `dired-initial-point-hook' to
+ `dired-initial-position-hook'.
+ (dired-file-name-at-point): Doc fix. (Bug#15329)
+
+2013-12-20 Juri Linkov <juri@jurta.org>
+
+ * replace.el (read-regexp-defaults-function): New defcustom (bug#14405).
+ (read-regexp-suggestions): New function.
+ (read-regexp): Use `read-regexp-defaults-function' to get default values.
+ Use `read-regexp-suggestions'. Add non-empty default to history
+ for empty input.
+ (occur-read-regexp-defaults-function): Remove function.
+ (occur-read-primary-args): Use `regexp-history-last' instead of
+ `occur-read-regexp-defaults-function'.
+
+ * hi-lock.el (hi-lock-read-regexp-defaults-function): Remove function.
+ (hi-lock-line-face-buffer, hi-lock-face-buffer)
+ (hi-lock-face-phrase-buffer): Use `regexp-history-last' instead of
+ `hi-lock-read-regexp-defaults-function'. Doc fix.
+ (hi-lock-face-symbol-at-point): Replace `find-tag-default-as-regexp'
+ with `find-tag-default-as-symbol-regexp'. Doc fix.
+ (hi-lock-read-regexp-defaults): Remove function.
+ (hi-lock-regexp-okay): Add check for null.
+
+ * progmodes/grep.el (grep-read-regexp): Use `grep-tag-default' for
+ the arg DEFAULTS. Move formatting of the prompt to `read-regexp'.
+
+ * subr.el (find-tag-default-as-symbol-regexp): New function.
+ (find-tag-default-as-regexp): Move symbol regexp formatting to
+ `find-tag-default-as-symbol-regexp'.
+
+2013-12-20 E Sabof <esabof@gmail.com> (tiny change)
+
+ * hi-lock.el (hi-lock-set-pattern): Check for `font-lock-specified-p'.
+ (Bug#14179)
+
+2013-12-20 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: New implementation of item insertion
+ commands and key bindings.
+ (todo-key-prompt): New face.
+ (todo-insert-item): New command.
+ (todo-insert-item--parameters): New defconst, replacing defvar
+ todo-insertion-commands-args-genlist.
+ (todo-insert-item--param-key-alist): New defconst, replacing
+ defvar todo-insertion-commands-arg-key-list.
+ (todo-insert-item--keyof, todo-insert-item--this-key): New defsubsts.
+ (todo-insert-item--argsleft, todo-insert-item--apply-args)
+ (todo-insert-item--next-param): New functions.
+ (todo-insert-item--args, todo-insert-item--argleft)
+ (todo-insert-item--argsleft, todo-insert-item--newargsleft):
+ New variables.
+ (todo-key-bindings-t): Change binding of "i" from
+ todo-insertion-map to todo-insert-item.
+ (todo-powerset, todo-gen-arglists, todo-insertion-commands-args)
+ (todo-insertion-command-name, todo-insertion-commands-names)
+ (todo-define-insertion-command, todo-insertion-commands)
+ (todo-insertion-key-bindings, todo-insertion-map): Remove.
+
+2013-12-20 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Bug fixes and new features (bug#15225).
+ (todo-toggle-item-highlighting): Use eval-and-compile instead of
+ eval-when-compile.
+ (todo-move-category): Allow choosing a non-existing todo file to
+ move the category to, and create that file.
+ (todo-default-priority): New user option.
+ (todo-set-item-priority): Use it.
+ (todo-desktop-save-buffer, todo-restore-desktop-buffer): New functions.
+ (desktop-restore-file-buffer): Declare.
+ (desktop-buffer-mode-handlers): Add todo-restore-desktop-buffer.
+ (todo-modes-set-2): Locally set desktop-save-buffer to
+ todo-desktop-save-buffer.
+ (todo-mode, todo-archive-mode, todo-filtered-items-mode)
+ (auto-mode-alist): Add autoload cookie.
+
+2013-12-20 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/subr-x.el: Renamed from helpers.el.
+ helpers.el was a poor choice of name.
+ (string-remove-prefix): New function.
+ (string-remove-suffix): New function.
+
+2013-12-20 Martin Rudalics <rudalics@gmx.at>
+
+ Fix assignment for new window total sizes.
+ * window.el (window--pixel-to-size): Remove function.
+ (window--pixel-to-total-1, window--pixel-to-total):
+ Fix calculation of new total sizes.
+
+2013-12-20 Vitalie Spinu <spinuvit@gmail.com>
+
+ * comint.el (comint-output-filter): Fix rear-nonsticky property
+ placement (Bug#16010).
+
+2013-12-20 Chong Yidong <cyd@gnu.org>
+
+ * faces.el (read-color): Minor fix for completion function.
+
+2013-12-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-align-to-stmt-keywords):
+ New option. (Bug#16182)
+ (ruby-smie--indent-to-stmt-p): Use it.
+ (ruby-smie-rules): Revert the logic in the handling of `when'.
+ Expand the begin clause to handle `ruby-align-to-stmt-keywords'.
+ (ruby-deep-arglist, ruby-deep-indent-paren)
+ (ruby-deep-indent-paren-style): Update docstrings to note that the
+ vars don't have any effect with SMIE.
+
+2013-12-20 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-enter, calc-pop): Use the variable
+ `calc-context-sensitive-enter'.
+
+2013-12-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-insert): Protect against infloops in degenerate
+ tables.
+
+2013-12-20 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave): Add link to manual and octave
+ homepage.
+ (octave-mode-menu): Link to octave-mode manual.
+
+2013-12-20 Leo Liu <sdl.web@gmail.com>
+
+ * skeleton.el (skeleton-pair-insert-maybe): Disable newline
+ insertion using skeleton-end-newline. (Bug#16138)
+
+2013-12-20 Juri Linkov <juri@jurta.org>
+
+ * replace.el (occur-engine): Use `add-face-text-property'
+ to add the face property to matches and titles. (Bug#14645)
+
+ * hi-lock.el (hi-green): Use lighter color "light green" closer to
+ the palette of other hi-lock colors.
+ (hi-lock-set-pattern): Prepend hi-lock face to the existing face.
+
+2013-12-19 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Bind `M-s e' to `isearch-edit-string'.
+ Put :advertised-binding on `M-s c', `M-s r', `M-s e'. (Bug#16035)
+ (minibuffer-history-symbol): Move variable declaration closer to
+ its usage.
+
+ * isearchb.el (isearchb): Add `event-basic-type' on `last-command-event'.
+ (Bug#14785)
+
+2013-12-19 Juri Linkov <juri@jurta.org>
+
+ * vc/log-edit.el (log-edit-insert-filenames-without-changelog):
+ New function.
+ (log-edit-hook): Add it to :options. (Bug#16170)
+
+2013-12-19 Juri Linkov <juri@jurta.org>
+
+ * simple.el (eval-expression-print-format): Don't check for
+ command names and the last command. Always display additional
+ formats of the integer result in the echo area, and insert them
+ to the current buffer only with a zero prefix arg.
+ Display character when char-displayable-p is non-nil.
+ (eval-expression): With a zero prefix arg, set `print-length' and
+ `print-level' to nil, and insert the integer values from
+ `eval-expression-print-format' at the end. Doc fix. (Bug#12985)
+
+ * emacs-lisp/lisp-mode.el (eval-print-last-sexp): Add arg
+ `eval-last-sexp-arg-internal'. Doc fix.
+ (eval-last-sexp-1): Pass arg `eval-last-sexp-arg-internal' to
+ `eval-last-sexp-print-value'. Doc fix.
+ (eval-last-sexp-print-value): Add arg `eval-last-sexp-arg-internal'.
+ Set `print-length' and `print-level' to nil when arg is zero.
+ (eval-last-sexp): Doc fix.
+ (eval-defun-2): Print the integer values from
+ `eval-expression-print-format' at the end.
+
+ * emacs-lisp/edebug.el (edebug-eval-defun): Print the integer
+ values from `eval-expression-print-format' at the end.
+
+ * ielm.el (ielm-eval-input): Print the integer
+ values from `eval-expression-print-format' at the end.
+
+2013-12-19 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/eww.el (eww-exit, eww-close, eww-mode-map): Revert change of
+ 2013-12-11T19:01:44Z!tzz@lifelogs.com.
+
+2013-12-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hl-line.el (hl-line-make-overlay): New fun. Set priority (bug#16192).
+ (hl-line-highlight, global-hl-line-highlight): Use it.
+ (hl-line-overlay): Use defvar-local.
+
+2013-12-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el: Require dnd.
+ (global-map): Remove drag items.
+ (ns-insert-text, ns-set-foreground-at-mouse)
+ (ns-set-background-at-mouse):
+ Remove (ns-drag-n-drop, ns-drag-n-drop-other-frame)
+ (ns-drag-n-drop-as-text, ns-drag-n-drop-as-text-other-frame):
+ New functions.
+
+2013-12-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/ert.el (ert-select-tests):
+ Fix string/symbol mixup. (Bug#16121)
+
+2013-12-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Indent middle-of-block
+ keywords to their parent.
+
+2013-12-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--args-separator-p): Allow the
+ first arg to be a string (fixed dead code), or an operator symbol.
+ (ruby-smie--forward-token): Tokenize ` @ ' before strings and
+ operator symbols.
+ (ruby-smie-rules): Remove parent token check in the `.' clause, it
+ did nothing. Don't respond to `(:after ".")', it will be called
+ with :before anyway. Remove the ` @ ' rule, it didn't seem to
+ change anything. Only return indentation for binary operators
+ when they are hanging. De-dent opening paren when its parent is
+ `.', otherwise it looks bad when the dot is not at bol or eol
+ (bug#16182).
+
+2013-12-19 Juri Linkov <juri@jurta.org>
+
+ * replace.el (query-replace-read-args): Split a non-negative arg
+ and a negative arg into separate elements.
+ (query-replace, query-replace-regexp, replace-string)
+ (replace-regexp): Add arg `backward'. Doc fix.
+ (replace-match-maybe-edit): When new arg `backward' is non-nil,
+ move point to the beginning of the match.
+ (replace-search, replace-highlight): Use new arg `backward'
+ to set the value of `isearch-forward'.
+ (perform-replace): Add arg `backward' and use it to perform
+ replacement backward. (Bug#14979)
+
+ * isearch.el (isearch-query-replace): Use a negative prefix arg
+ to call `perform-replace' with a non-nil arg `backward'.
+
+2013-12-18 Juri Linkov <juri@jurta.org>
+
+ * vc/log-edit.el (log-edit-hook): Add `log-edit-insert-message-template'
+ to the default list. Move `log-edit-show-files' to the end.
+ Add more available functions to options.
+ (log-edit): Move default specific settings to
+ `log-edit-insert-message-template'. Don't move point.
+ (log-edit-insert-message-template): New function.
+ (log-edit-insert-changelog): Add `save-excursion' and don't move point.
+ (Bug#16170)
+
+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)
+
+2013-12-18 Leo Liu <sdl.web@gmail.com>
+
+ * eshell/em-prompt.el (eshell-emit-prompt): Fix last change.
+ (Bug#16186)
+
+2013-12-18 Eli Zaretskii <eliz@gnu.org>
+
+ * ls-lisp.el (ls-lisp-insert-directory): Don't modify %d and %f
+ formats for displaying file sizes when the -s switch is given.
+ Instead, compute a separate format for displaying the size in
+ blocks, which is displayed in addition to the "regular" size.
+ When -h is given in addition to -s, produce size in blocks in
+ human-readable form as well. (Bug#16179)
+
+2013-12-18 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-label-alist-builtin):
+ Reference tables with ~\ref{...} instead of only \ref{...}.
+
+2013-12-18 Chong Yidong <cyd@gnu.org>
+
+ * cus-edit.el (custom-magic-alist): Fix "themed" description
+ (Bug#14348).
+
+ * custom.el (custom-push-theme): If custom--inhibit-theme-enable
+ is non-nil, do not create a new entry in the symbol's theme-value
+ or theme-face property; update theme-settings only (Bug#14664).
+ (custom-available-themes): Doc fix.
+
+ * cus-theme.el (custom-new-theme-mode-map): Add bindings
+ (Bug#15674).
+
+ * replace.el (occur-engine): Avoid infloop (Bug#7593).
+
+2013-12-18 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
+
+ * progmodes/make-mode.el (makefile-fill-paragraph): Fix infloop
+ (Bug#13914).
+
+2013-12-18 Shigeru Fukaya <shigeru.fukaya@gmail.com>
+
+ * apropos.el (apropos-words-to-regexp): Fix algorithm (Bug#13946).
+
+2013-12-18 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (BYTE_COMPILE_FLAGS): Set load-prefer-newer to t.
+ * cus-start.el (load-prefer-newer): New option.
+
+2013-12-18 Le Wang <l26wang@gmail.com>
+
+ * comint.el (comint-previous-matching-input-from-input):
+ Retain point (Bug#13404).
+
+2013-12-18 Chong Yidong <cyd@gnu.org>
+
+ * simple.el (append-next-kill): Doc fix (Bug#15995, Bug#16016).
+
+2013-12-18 Glenn Morris <rgm@gnu.org>
+
+ * mail/emacsbug.el (report-emacs-bug):
+ Only mention enable-multibyte-characters if non-standard.
+
+2013-12-17 Juri Linkov <juri@jurta.org>
+
+ * arc-mode.el (archive-extract-by-file): Check if directory exists
+ before deletion to not show irrelevant errors if it doesn't exist.
+
+2013-12-17 Juri Linkov <juri@jurta.org>
+
+ * menu-bar.el (menu-bar-tools-menu): Add `browse-web'.
+ (Bug#14751)
+
+ * net/eww.el (browse-web): Add alias to `eww'.
+ (eww-mode-map): Bind "r" to `eww-forward-url' like in Info.
+ Bind "S-SPC" to `scroll-down-command'. (Bug#16178)
+
+ * net/browse-url.el (browse-url-browser-function): Move `eww'
+ closer to similar functions.
+
+ * startup.el (fancy-startup-screen, fancy-about-screen):
+ Set browse-url-browser-function to eww-browse-url locally.
+ (Bug#14751)
+
+2013-12-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * window.el (window--pixel-to-total): Remove unused `mini' var.
+ (maximize-window, minimize-window): Remove unused `pixelwise' arg.
+ (split-window): Remove unused `new' var.
+ (window--display-buffer): Remove unused `frame' and `delta' vars.
+ (fit-window-to-buffer): Remove unused vars `frame', `display-height',
+ and display-width'.
+
+2013-12-17 Martin Rudalics <rudalics@gmx.at>
+
+ * dired.el (dired-mark-pop-up):
+ * register.el (register-preview): Don't bind
+ split-height-threshold here since it's now done in
+ display-buffer-below-selected.
+
+2013-12-17 oblique <psyberbits@gmail.com> (tiny change)
+
+ * term/rxvt.el (rxvt-rgb-convert-to-16bit): Standardize with
+ xterm-rgb-convert-to-16bit.
+ (rxvt-register-default-colors): Standardize with
+ xterm-register-default-colors (Bug#14078).
+
+2013-12-17 Dima Kogan <dima@secretsauce.net> (tiny change)
+
+ * simple.el (kill-region): Pass mark first, then point, so that
+ kill-append works right (Bug#12819).
+ (copy-region-as-kill, kill-ring-save): Likewise.
+
+2013-12-17 Leo Liu <sdl.web@gmail.com>
+
+ * net/rcirc.el (rcirc-add-face):
+ * eshell/em-prompt.el (eshell-emit-prompt):
+ * eshell/em-ls.el (eshell-ls-decorated-name): Use font-lock-face.
+ (Bug#16167)
+
+2013-12-17 Chong Yidong <cyd@gnu.org>
+
+ * files.el (break-hardlink-on-save): Doc fix (Bug#13801).
+ Suggested by Xue Fuqiao.
+
+2013-12-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Indent ternary if.
+
+2013-12-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/shr.el (shr-insert-document): Remove unused var
+ `shr-preliminary-table-render'.
+ (shr-rescale-image): Remove unused arg `force'.
+ (shr-put-image): Update calls accordingly.
+ (shr-tag-a): Use `cont' rather than dyn-bound `dom'.
+
+2013-12-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/smie.el (smie-indent--rule): Extract `smie-indent--rule-1'.
+ (smie-indent-close): Call `smie-indent--rule-1' with METHOD
+ :close-all, to see which indentation method to use (Bug#16116).
+ (smie-rules-function): Document the method :close-all.
+
+2013-12-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-tag-a): Support zero-length <a name="foo"> elements.
+
+ * net/eww.el (eww-display-html): If we can't find the anchor we're
+ looking for, then go to point-min.
+
+2013-12-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix problems with CANNOT_DUMP and EMACSLOADPATH.
+ * Makefile.in (emacs): Add lisp src to EMACSLOADPATH.
+ * loadup.el: Check for src/bootstrap-emacs only when Emacs can dump.
+ Expand dir too, in case it's relative.
+
+2013-12-16 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-auto-save-timeout): Change default to
+ `auto-save-timeout'. Doc fix.
+ (desktop-save): Skip the timestamp in desktop-saved-frameset
+ when checking for auto-save changes.
+ (desktop-auto-save): Don't call desktop-auto-save-set-timer since
+ `desktop-auto-save' is called repeatedly by the idle timer.
+ (desktop-auto-save-set-timer): Replace `run-with-timer' with
+ `run-with-idle-timer' and a non-nil arg REPEAT. Doc fix.
+ (Bug#15331)
+
+2013-12-16 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Remove [escape] key bindinds.
+ (Bug#16035)
+ (isearch-pre-command-hook): Check `this-command' for symbolp.
+
+2013-12-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/gv.el (gv-ref): Mention lexbind restriction (bug#16153).
+
+2013-12-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el (cfengine3--current-word): Remove.
+ (cfengine3--current-function): Bring in the current-function
+ functionality from `cfengine3--current-word'.
+ (cfengine3-completion-function): Bring in the
+ bounds-of-current-word functionality from
+ `cfengine3--current-word'.
+
+2013-12-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-below-selected):
+ Bind split-height-threshold to 0 as suggested by Juri Linkov.
+
+2013-12-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/compile.el (compile-goto-error): Do not push-mark.
+ Remove NOMSG arg and all uses changed.
+
+2013-12-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-rect.el (cua-rectangle-mark-mode): New minor mode.
+ (cua--deactivate-rectangle): Don't deactivate the mark.
+ (cua-set-rectangle-mark): Don't set mark-active since
+ cua--activate-rectangle already does it for us.
+ (cua--rectangle-highlight-for-redisplay): Unhighlight a previous
+ non-rectangular region.
+
+ * emulation/cua-base.el (cua-repeat-replace-region):
+ Use with-current-buffer.
+
+ * net/gnutls.el: Use cl-lib.
+ (gnutls-negotiate): `mapcan' -> cl-mapcan.
+
+2013-12-14 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/package.el (package-built-in-p): Support both
+ built-in and the package.el converted package descriptions.
+ (package-show-package-list): Allow keywords.
+ (package-keyword-button-action): Use it instead of
+ `finder-list-matches'.
+ (package-menu-filter-interactive): Interactive filtering (by
+ keyword) function.
+ (package-menu--generate): Support keywords and change keymappings
+ and headers when they are given.
+ (package--has-keyword-p): Helper function.
+ (package-menu--refresh): Use it.
+ (package--mapc): Helper function.
+ (package-all-keywords): Use it.
+ (package-menu-mode-map): Set up menu items and keybindings to
+ provide a filtering UI.
+
+2013-12-14 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/gnutls.el (gnutls-verify-error): New defcustom to control
+ the behavior when a certificate fails validation. Defaults to
+ old behavior: never abort, just warn.
+ (gnutls-negotiate): Use it.
+
+2013-12-14 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-below-selected): Never split window
+ horizontally. Suggested by Juri Linkov <juri@jurta.org>.
+
+2013-12-14 Tom Willemse <tom@ryuslash.org> (tiny change)
+
+ * emacs-lisp/package.el (package--prepare-dependencies): New function.
+ (package-buffer-info): Use it (bug#15108).
+
+2013-12-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * icomplete.el (icomplete-completions): Make sure the prefix is already
+ displayed elsewhere before hiding it (bug#16219).
+
+2013-12-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Return nil before
+ open-paren tokens when preceded by a open-paren, too.
+ (ruby-smie-rules): Handle virtual indentation after open-paren
+ tokens specially. If there is code between it and eol, return the
+ column where is starts (Bug#16118).
+
+2013-12-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el: Fix `add-hook' doc.
+ (cfengine-mode-syntax-functions-regex): Initialize sensibly.
+ (cfengine3--current-word): Fix parameters.
+ (cfengine3-make-syntax-cache): Simplify further.
+ (cfengine3-completion-function, cfengine3--current-function):
+ Use `assq' for symbols.
+ (cfengine3--current-function): Fix `cfengine3--current-word' call.
+
+2013-12-13 Glenn Morris <rgm@gnu.org>
+
+ * loadup.el (load-path): Warn if site-load or site-init changes it.
+ No more need to reset it when bootstrapping.
+
+2013-12-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el (cfengine-cf-promises): Add more default
+ locations for cf-promises.
+ (cfengine-mode-syntax-functions-regex): New caching variable.
+ (cfengine3-fallback-syntax): Fallback syntax for cases where
+ cf-promises doesn't run.
+ (cfengine3--current-word): Reimplement using
+ `cfengine-mode-syntax-functions-regex'.
+ (cfengine3-completion-function, cfengine3--current-function):
+ Use `cfengine3-make-syntax-cache' directly.
+ (cfengine3-clear-syntax-cache): New function.
+ (cfengine3-make-syntax-cache): Simplify and create
+ `cfengine-mode-syntax-functions-regex' on demand.
+ (cfengine3-format-function-docstring): Don't call
+ `cfengine3-make-syntax-cache' explicitly.
+
+2013-12-13 Martin Rudalics <rudalics@gmx.at>
+
+ Fix windmove-find-other-window broken after pixelwise resizing
+ (Bug#16017).
+ * windmove.el (windmove-other-window-loc): Revert change from
+ 2013-12-04.
+ (windmove-find-other-window): Call window-in-direction.
+ * window.el (window-in-direction): New arguments SIGN, WRAP and
+ MINI to emulate original windmove-find-other-window behavior.
+
+2013-12-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * simple.el (blink-matching--overlay): New variable.
+ (blink-matching-open): Instead of moving point, highlight the
+ matching paren with an overlay
+ (http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00333.html).
+
+ * faces.el (paren-showing-faces, show-paren-match)
+ (show-paren-mismatch): Move from paren.el.
+
+2013-12-13 Leo Liu <sdl.web@gmail.com>
+
+ * indent.el (indent-region): Disable progress reporter in
+ minibuffer. (Bug#16108)
+
+ * bindings.el (visual-order-cursor-movement): Fix version.
+
+2013-12-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-pdbtrack-stacktrace-info-regexp):
+ Also match after beginning of line.
+ (python-pdbtrack-set-tracked-buffer): Fix logic for remote
+ files. Thanks to Russell Sim. (Bug#15378)
+
+2013-12-13 Juri Linkov <juri@jurta.org>
+
+ * simple.el <Keypad support>: Remove key bindings duplicated
+ with bindings.el. (Bug#14397)
+
+2013-12-13 Juri Linkov <juri@jurta.org>
+
+ * comint.el (comint-mode-map): Replace `delete-char' with
+ `delete-forward-char'. (Bug#16109)
+
+2013-12-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-calculate-indentation):
+ Fix de-denters cornercase. (Bug#15731)
+
+2013-12-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Add `depth' property to manage ordering.
+ (advice--make): Pay attention to `depth'.
+ (advice--make-1): Don't autoload commands eagerly.
+ * emacs-lisp/elp.el (elp-instrument-function):
+ * emacs-lisp/trace.el (trace-function-internal):
+ * emacs-lisp/debug.el (debug-on-entry): Keep them "first".
+
+ * iswitchb.el (iswitchb-mode): Don't belittle ido.
+
+2013-12-12 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (w32-handle-dropped-file):
+ * startup.el (normal-top-level):
+ * net/browse-url.el (browse-url-file-url):
+ * dnd.el (dnd-get-local-file-name): On MS-Windows, encode and
+ decode file names using 'utf-8' rather than
+ file-name-coding-system.
+
+2013-12-12 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-context)
+ (python-indent-calculate-indentation): Fix auto-identation
+ behavior for comment blocks. (Bug#15916)
+
+2013-12-12 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * progmodes/python.el (python-indent-calculate-indentation):
+ When determining indentation, don't treat "return", "pass", etc., as
+ operators when they are just string constituents. (Bug#15812)
+
+2013-12-12 Juri Linkov <juri@jurta.org>
+
+ * uniquify.el (uniquify-buffer-name-style): Change default to
+ `post-forward-angle-brackets'.
+
+ * menu-bar.el (menu-bar-options-menu): Don't require preloaded
+ `uniquify'. Change default to `post-forward-angle-brackets'.
+
+2013-12-11 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (finder-list-matches):
+ Autoload rather than falsely declaring.
+
+2013-12-11 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/eww.el (eww-exit, eww-close): Add UI convenience wrappers.
+ (eww-mode-map): Use them.
+
+2013-12-11 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-in-side-window): Fix doc-string
+ (Bug#16115).
+
+2013-12-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * vc/vc-git.el: Silence byte-compiler warnings.
+ (vc-git-dir-extra-headers): Rename arg _dir which is no longer ignored.
+ (log-edit-set-header): Declare.
+
+2013-12-11 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (custom-deps, finder-data): Run output file names
+ through unmsys--file-name. (Bug#16099)
+
+2013-12-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-indent--hanging-p): Don't bother matching
+ comment-start-skip, which fails when that uses submatch 1 (bug#16041).
+
+ * emulation/cua-base.el (cua-paste): Add `delete-selection' property
+ instead of deleting the selection "by hand" (bug#16098).
+ Rely on insert-for-yank to yank rectangles.
+ (cua-highlight-region-shift-only): Mark obsolete.
+ (cua-mode): Don't enable/disable transient-mark-mode,
+ shift-select-mode (cua-mode works both with and without them), and
+ pc-selection-mode (obsolete).
+ * emulation/cua-rect.el (cua--activate-rectangle): Activate the mark.
+ (cua--deactivate-rectangle): Deactivate it.
+
+ * delsel.el (delete-selection-mode): Don't enable transient-mark-mode.
+ (delete-selection-helper): Make sure yank starts at the top of the
+ deleted region.
+ (minibuffer-keyboard-quit): Use region-active-p.
+
+ * emacs-lisp/trace.el (trace-make-advice): Don't deactivate the mark.
+
+ * simple.el (normal-erase-is-backspace-mode): Map kp-delete identically
+ to `delete' (bug#16109).
+
+2013-12-11 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave-mode, inferior-octave-mode): Link to
+ info manual and show keybindings and set `:group' keyword.
+
+2013-12-11 Juri Linkov <juri@jurta.org>
+
+ * delsel.el (delete-active-region): Let-bind `this-command'
+ to prevent `kill-region' from changing its original value.
+ (delete-selection-helper): Handle `overwrite-mode' for the type
+ `kill' exactly the same way as for the type `t'.
+ (insert-char, quoted-insert, reindent-then-newline-and-indent):
+ Support more commands. (Bug#13312)
+
+2013-12-11 Juri Linkov <juri@jurta.org>
+
+ * bindings.el: Map kp keys to non-kp keys systematically
+ with basic modifiers control, meta and shift. (Bug#14397)
+
+2013-12-11 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-mode-map): Instead of "Quit" show "Exit" and
+ "Close browser" menu items. Fix wrong function of "List
+ bookmarks".
+
+2013-12-11 Juri Linkov <juri@jurta.org>
+
+ * misearch.el (multi-isearch-buffers): Set the value of
+ `multi-isearch-buffer-list' globally. Set NO-RECURSIVE-EDIT
+ arg of isearch-forward to t.
+ (multi-isearch-buffers-regexp): Set the value of
+ `multi-isearch-buffer-list' globally. Set NO-RECURSIVE-EDIT
+ arg of isearch-forward-regexp to t.
+ (multi-isearch-files): Set the value of
+ `multi-isearch-file-list' globally. Set NO-RECURSIVE-EDIT
+ arg of isearch-forward to t.
+ (multi-isearch-files-regexp): Set the value of
+ `multi-isearch-file-list' globally. Set NO-RECURSIVE-EDIT
+ arg of isearch-forward-regexp to t. (Bug#16035)
+
+ * dired-aux.el (dired-isearch-filenames): Set NO-RECURSIVE-EDIT
+ arg of isearch-forward to t.
+ (dired-isearch-filenames-regexp): Set NO-RECURSIVE-EDIT
+ arg of isearch-forward-regexp to t.
+ (dired-isearch-filter-filenames): Remove unnecessary check for
+ `dired-isearch-filenames'.
+
+ * comint.el (comint-history-isearch-backward):
+ Set NO-RECURSIVE-EDIT arg of isearch-backward to t.
+ (comint-history-isearch-backward-regexp):
+ Set NO-RECURSIVE-EDIT arg of isearch-backward-regexp to t.
+
+2013-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (autoloads): Run $(srcdir)/loaddefs.el through
+ unmsys--file-name. (Bug#16099)
+
+2013-12-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/package.el (package-keyword-button-action):
+ Remove finder.el require dependency.
+
+2013-12-09 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/package.el: Require finder.el.
+ (describe-package-1): Add keyword buttons.
+ (package-make-button): New convenience function.
+ (package-keyword-button-action): Keyword button action using
+ `finder-list-matches'.
+
+2013-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ * autorevert.el (auto-revert-notify-add-watch): Fix a thinko in
+ last commit.
+
+2013-12-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-notify-add-watch): Do not handle
+ symlinked files.
+
+2013-12-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Return t
+ after the end of a percent literal.
+
+2013-12-09 Cameron Desautels <camdez@gmail.com> (tiny change)
+
+ * progmodes/ruby-mode.el (ruby-forward-string): Document.
+ Handle caret-delimited strings (Bug#16079).
+
+2013-12-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-accurate-end-of-block):
+ When `ruby-use-smie' is t, use `smie-forward-sexp' instead of
+ `ruby-parse-partial' (Bug#16078).
+
+2013-12-09 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (read-passwd): Disable show-paren-mode. (Bug#16091)
+
+2013-12-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/js.el (js-auto-indent-flag): Remove, was unused.
+ (js-switch-indent-offset): New option.
+ (js--proper-indentation): Use it. And handle the case when
+ "default" is actually a key in an object literal.
+ (js--same-line): New function.
+ (js--multi-line-declaration-indentation): Use it.
+ (js--indent-in-array-comp, js--array-comp-indentation):
+ New functions.
+ (js--proper-indentation): Use them, to handle array comprehension
+ continuations.
+
+2013-12-08 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake-highlight-line): Re-write.
+ (flymake-make-overlay): Remove arg MOUSE-FACE.
+ (flymake-save-string-to-file, flymake-read-file-to-string): Remove.
+
+2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emulation/cua-rect.el (cua--rectangle-highlight-for-redisplay):
+ New function.
+ (redisplay-highlight-region-function): Use it.
+
+ * emulation/cua-base.el (cua--explicit-region-start)
+ (cua--last-region-shifted): Remove.
+ (cua--deactivate): Use deactivate-mark.
+ (cua--pre-command-handler-1): Don't handle shift-selection.
+ (cua--post-command-handler-1): Don't change transient-mark-mode.
+ (cua--select-keymaps): Use region-active-p rather than
+ cua--explicit-region-start or cua--last-region-shifted.
+ (cua-mode): Enable shift-select-mode.
+
+2013-12-08 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake-popup-current-error-menu):
+ Rename from flymake-display-err-menu-for-current-line. Reimplement.
+ (flymake-posn-at-point-as-event, flymake-popup-menu)
+ (flymake-make-emacs-menu): Remove. (Bug#16077)
+
+2013-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (rectangle-mark-mode): Activate mark even if
+ transient-mark-mode is off (bug#16066).
+ (rectangle--highlight-for-redisplay): Fix boundary condition when point
+ is > mark and at bolp.
+
+ * emulation/cua-rect.el (cua--rectangle-region-extract): New function.
+ (region-extract-function): Use it.
+ (cua-mouse-save-then-kill-rectangle): Use cua-copy-region.
+ (cua-copy-rectangle, cua-cut-rectangle, cua-delete-rectangle):
+ Delete functions.
+ (cua--init-rectangles): Don't re-remap copy-region-as-kill,
+ kill-ring-save, kill-region, delete-char, delete-forward-char.
+ Ignore self-insert-iso.
+
+ * emulation/cua-gmrk.el (cua--init-global-mark):
+ Ignore `self-insert-iso'.
+
+ * emulation/cua-base.el (cua--prefix-copy-handler)
+ (cua--prefix-cut-handler): Rely on region-extract-function rather than
+ checking cua--rectangle.
+ (cua-delete-region): Use region-extract-function.
+ (cua-replace-region): Delete function.
+ (cua-copy-region, cua-cut-region): Obey region-extract-function.
+ (cua--pre-command-handler-1): Don't do the delete-selection thing.
+ (cua--self-insert-char-p): Ignore `self-insert-iso'.
+ (cua--init-keymaps): Don't remap delete-selection commands.
+ (cua-mode): Use delete-selection-mode instead of rolling our own
+ (bug#16085).
+
+ * menu-bar.el (clipboard-kill-ring-save, clipboard-kill-region):
+ Obey region-extract-function.
+
+ Make registers and delete-selection-mode work on rectangles.
+ * register.el (describe-register-1): Don't modify the register's value.
+ (copy-to-register): Obey region-extract-function.
+ * delsel.el (delete-active-region): Obey region-extract-function.
+
+2013-12-08 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/flymake.el (flymake, flymake-error-bitmap)
+ (flymake-warning-bitmap, flymake-fringe-indicator-position)
+ (flymake-compilation-prevents-syntax-check)
+ (flymake-start-syntax-check-on-newline)
+ (flymake-no-changes-timeout, flymake-gui-warnings-enabled)
+ (flymake-start-syntax-check-on-find-file, flymake-log-level)
+ (flymake-xml-program, flymake-master-file-dirs)
+ (flymake-master-file-count-limit)
+ (flymake-allowed-file-name-masks): Relocate.
+ (flymake-makehash, flymake-float-time)
+ (flymake-replace-regexp-in-string, flymake-split-string)
+ (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
+ related functions. (Bug#16077)
+
+2013-12-07 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/helpers.el (string-blank-p): Use `string-match-p'.
+
+2013-12-07 Tassilo Horn <tsdh@gnu.org>
+
+ * help-fns.el (describe-function-1): Use new advice-* functions
+ rather than old ad-* functions. Fix function type description and
+ source links for advised functions and subrs.
+
+2013-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-tag-img): Don't bug out on <img src=""> data.
+
+2013-12-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * progmodes/compile.el (compilation-start):
+ * progmodes/grep.el (rgrep): Revert change 2012-12-20T11:15:38Z!michael.albinus@gmx.de.
+
+ * net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Handle long command lines, lasting from "sh -c ...". (Bug#16045)
+
+2013-12-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
+ Touch up the last change.
+
+2013-12-06 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-prompt): Use shy groups.
+ (inferior-octave-startup): Always use "octave> " for prompt.
+ (octave-goto-function-definition)
+ (octave-sync-function-file-names)
+ (octave-find-definition-default-filename): Remove redundant backquotes.
+
+2013-12-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-mode-syntax-table): Don't modify
+ syntax for `?'.
+ (ruby-expr-beg): Expect that `!' will have syntax class "symbol"
+ where appropriate already.
+ (ruby-syntax-propertize-function): Propertize `?' and `!' at the
+ end of method names (Bug#15874).
+
+2013-12-06 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch--saved-overriding-local-map):
+ New internal variable.
+ (isearch-mode): Set it to the initial value of
+ `overriding-terminal-local-map'.
+ (isearch-pre-command-hook): Compare `overriding-terminal-local-map'
+ with `isearch--saved-overriding-local-map'. (Bug#16035)
+
+2013-12-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/octave.el (inferior-octave-completion-table):
+ Turn back into function, use `completion-table-with-cache'
+ (Bug#11906). Update all references.
+
+ * minibuffer.el (completion-table-with-cache): New function.
+
+2013-12-05 Cameron Desautels <camdez@gmail.com> (tiny change)
+
+ * emacs-lisp/regexp-opt.el (regexp-opt-charset): Fix ^ (bug#16046).
+
+2013-12-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * net/eww.el (eww-current-source): New variable to store page
+ source.
+ (eww-display-html, eww-mode, eww-save-history)
+ (eww-restore-history): Use it.
+ (eww-view-source): New command to view page source.
+ Opportunistically uses `html-mode' to highlight the buffer.
+ (eww-mode-map): Install it.
+
+2013-12-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-unregister-service)
+ (dbus-escape-as-identifier, dbus-unescape-from-identifier):
+ Fix docstring.
+ (dbus-unregister-service): Skip :serial entries in
+ `dbus-registered-objects-table'.
+ (dbus-byte-array-to-string): New optional arg MULTIBYTE.
+
+2013-12-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/lisp-mnt.el (lm-keywords-list): Trim whitespace
+ around keywords with extra `split-string' argument.
+
+2013-12-04 Martin Rudalics <rudalics@gmx.at>
+
+ * windmove.el (windmove-other-window-loc): Handle navigation
+ between windows (excluding the minibuffer window - Bug#16017).
+
+2013-12-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-byte-array-to-string): Accept also byte arrays
+ in D-Bus type syntax.
+ (dbus-unescape-from-identifier): Use `byte-to-string' in order to
+ preserve unibyte strings. (Bug#16048)
+
+2013-12-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eldoc.el (eldoc-minibuffer-message):
+ Call force-mode-line-update is the proper buffer (bug#16042).
+
+2013-12-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-edit.el (log-edit-add-new-comment): Rename to
+ `log-edit-remember-comment', make argument optional. Adjust all
+ callers.
+ (log-edit-mode): Add `log-edit-remember-comment' to
+ `kill-buffer-hook' locally.
+ (log-edit-kill-buffer): Don't remember comment explicitly since
+ the buffer is killed anyway.
+
+2013-12-04 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode, isearch-done): Don't set arg LOCAL in
+ add-hook and remove-hook for multi-buffer search. (Bug#16035)
+
+2013-12-03 Tom Regner <tom@goochesa.de> (tiny change)
+
+ * notifications.el (notifications-close-notification): Call the
+ D-Bus method with ID being a `:uint32'. (Bug#16030)
+
+2013-12-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * net/eww.el (eww-render): Don't pass arg to eww-display-image.
+
+2013-12-03 Juri Linkov <juri@jurta.org>
+
+ * progmodes/compile.el (compilation-start): Rename window alist
+ entry `no-display-ok' to `allow-no-window'.
+
+ * simple.el (shell-command): Add window alist entry
+ `allow-no-window' to `display-buffer'.
+ (async-shell-command): Doc fix.
+
+ * window.el (display-buffer-no-window): New action function.
+ (display-buffer-alist, display-buffer): Doc fix. (Bug#13594)
+
+2013-12-02 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-edit.el (log-edit-set-header): Extract from
+ `log-edit-toggle-header'.
+ (log-edit-extract-headers): Separate the summary, when extracted
+ from header, from the rest of the message with an empty line.
+
+ * vc/vc-git.el (vc-git-log-edit-toggle-amend): Move the summary
+ line, if present, to the Summary header.
+
+2013-12-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * epa-file.el (epa-file-insert-file-contents): Ensure we insert text
+ in current-buffer (bug#16029).
+
+2013-12-02 Helmut Eller <eller.helmut@gmail.com>
+
+ * emacs-lisp/debug.el (debugger-toggle-locals): New command.
+ (debugger-mode-map): Bind it.
+ (debugger--backtrace-base): New function.
+ (debugger-eval-expression): Use it.
+ (debugger-frame-number): Skip local vars when present.
+ (debugger--locals-visible-p, debugger--insert-locals)
+ (debugger--show-locals, debugger--hide-locals): New functions.
+
+2013-12-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Do not set
+ "LC_ALL".
+ (tramp-get-remote-locale): New defun.
+ (tramp-open-connection-setup-interactive-shell): Use it.
+
+2013-12-02 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (process-live-p): Return nil for non-process. (Bug#16023)
+
+ * progmodes/sh-script.el (sh-shell-process):
+ * progmodes/octave.el (inferior-octave-process-live-p):
+ * progmodes/gdb-mi.el (gdb-delchar-or-quit)
+ (gdb-inferior-io-sentinel):
+ * emacs-lock.el (emacs-lock-live-process-p): All uses changed.
+
+2013-12-02 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-edit.el (log-edit-kill-buffer): Move the use of
+ `save-selected-window' to `log-edit-hide-buf'. This makes
+ `log-edit-show-files' idempotent.
+ (log-edit-show-files): Mark the new window as dedicated.
+
+2013-12-02 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-edit.el (log-edit-mode-map): Add binding for
+ `log-edit-kill-biffer'.
+ (log-edit-hide-buf): Add a FIXME comment.
+ (log-edit-add-new-comment): New function, extracted from
+ `log-edit-done'.
+ (log-edit-done, log-edit-add-to-changelog): Use it.
+ (log-edit-kill-buffer): New command.
+
+2013-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-mode-map): Have `q' do a normal `quit-window'
+ instead of killing the buffer.
+
+2013-12-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (newline): Mention `electric-indent-mode' (bug#16015).
+
+2013-12-01 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * net/eww.el (eww-form-checkbox-selected-symbol)
+ (eww-form-checkbox-symbol): New customizable variable.
+ (eww-form-checkbox, eww-toggle-checkbox):
+ Use `eww-form-checkbox-selected-symbol' and `eww-form-checkbox-symbol'.
+
+ * net/shr.el (shr-prefer-media-type-alist): New customizable variable.
+ (shr--get-media-pref, shr--extract-best-source): New function.
+ (shr-tag-video, shr-tag-audio): Use `shr--extract-best-source' when
+ no :src tag was specified.
+
+ * net/eww.el (eww-use-external-browser-for-content-type): New variable.
+ (eww-render): Handle `eww-use-external-browser-for-content-type'.
+ Use \\` to match beginning of string instead of ^.
+ (eww-browse-with-external-browser): Provide optional URL parameter.
+ (eww-render): Set `eww-current-title' back to "".
+
+ * net/shr.el (shr-tag-video): Display content for video if no
+ poster is available.
+ (shr-tag-audio): Add support for <audio> tag.
+
+ * net/eww.el (eww-text-input-types): New const.
+ (eww-process-text-input): Treat input types in
+ `eww-text-input-types' as text.
+
+ * net/shr.el (shr-tag-table): Fix comment typo.
+
+2013-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-follow-link): New command to avoid reloading
+ pages when we follow #target links (bug#15243).
+ (eww-quit): Special mode buffers shouldn't query before exiting.
+
+2013-12-01 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-tag-select): Support <optgroup> tags in <select>
+ forms.
+
+2013-12-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-restore-history): Update the window title after
+ moving in the history.
+ (eww-current-dom): New variable used to save the current DOM.
+
+2013-12-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-edit.el (log-edit-mode-map): Add binding for
+ `log-edit-beginning-of-line'.
+ (log-edit-setup-add-author): New user option.
+ (log-edit-beginning-of-line): New command.
+ (log-edit): Move major mode call above the contents setup so that
+ the local variable values are already applied.
+ (log-edit): Only insert "Author: " when
+ `log-edit-setup-add-author' is non-nil.
+ (log-edit): When SETUP is non-nil, position point after ": "
+ instead of point-min.
+
+2013-12-01 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line): Warn if ~/emacs.d is in load-path.
+
+2013-11-30 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (fancy-splash-frame): On MS-Windows, trigger
+ redisplay to make sure the initial frame gets a chance to become
+ visible. (Bug#16014)
+
+2013-11-30 Martin Rudalics <rudalics@gmx.at>
+
+ Support resizing frames and windows pixelwise.
+ * cus-start.el (frame-resize-pixelwise)
+ (window-resize-pixelwise): New entries.
+ * emacs-lisp/debug.el (debug): Use window-total-height instead
+ of window-total-size.
+ * frame.el (tool-bar-lines-needed): Defalias to tool-bar-height.
+ * help.el (describe-bindings-internal): Use help-buffer as
+ argument for with-help-window.
+ (temp-buffer-max-width): New option.
+ (resize-temp-buffer-window, help-window-setup)
+ (with-help-window): Rewrite.
+ * mouse.el (mouse-drag-line): Rewrite. Add key bindings for
+ dragging dividers.
+ * window.el (frame-char-size, window-min-pixel-height)
+ (window-safe-min-pixel-height, window-safe-min-pixel-width)
+ (window-min-pixel-width, window-safe-min-pixel-size)
+ (window-combination-p, window-safe-min-size)
+ (window-resizable-p, window--size-to-pixel)
+ (window--pixel-to-size, window--resize-apply-p): New functions.
+ (window-safe-min-height): Fix doc-string.
+ (window-size, window-min-size, window--min-size-1)
+ (window-sizable, window-sizable-p, window--min-delta-1)
+ (window-min-delta, window--max-delta-1, window-max-delta)
+ (window--resizable, window--resizable-p, window-resizable)
+ (window-full-height-p, window-full-width-p, window-at-side-p)
+ (window--in-direction-2, window-in-direction)
+ (window--resize-reset-1, window--resize-mini-window)
+ (window-resize, window-resize-no-error)
+ (window--resize-child-windows-normal)
+ (window--resize-child-windows, window--resize-siblings)
+ (window--resize-this-window, window--resize-root-window)
+ (window--resize-root-window-vertically)
+ (adjust-window-trailing-edge, enlarge-window, shrink-window)
+ (maximize-window, minimize-window, delete-window)
+ (quit-restore-window, window-split-min-size, split-window)
+ (balance-windows-2, balance-windows)
+ (balance-windows-area-adjust, balance-windows-area)
+ (window--state-get-1, window-state-get, window--state-put-1)
+ (window--state-put-2, window-state-put)
+ (display-buffer-record-window, window--display-buffer):
+ Make functions handle pixelwise sizing of windows.
+ (display-buffer--action-function-custom-type)
+ (display-buffer-fallback-action):
+ Add display-buffer-in-previous-window.
+ (display-buffer-use-some-window): Resize window to height it had
+ before.
+ (fit-window-to-buffer-horizontally): New option.
+ (fit-frame-to-buffer): Describe new values.
+ (fit-frame-to-buffer-bottom-margin): Replace with
+ fit-frame-to-buffer-margins.
+ (window--sanitize-margin): New function.
+ (fit-frame-to-buffer, fit-window-to-buffer): Rewrite completely
+ using window-text-pixel-size.
+
+2013-11-30 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-form):
+ Make the `interactive-only' warning like the `obsolete' one.
+ * comint.el (comint-run):
+ * files.el (insert-file-literally, insert-file):
+ * replace.el (replace-string, replace-regexp):
+ * simple.el (beginning-of-buffer, end-of-buffer, delete-backward-char)
+ (goto-line, insert-buffer, next-line, previous-line):
+ Tweak `interactive-only' spec.
+
+ Stop keeping (most) generated cedet grammar files in the repository.
+ * Makefile.in (semantic): New.
+ (compile-main): Depend on semantic.
+
+2013-11-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/newst-reader.el (newsticker-html-renderer): Default to SHR if
+ available. Suggested by Clément B. <barthele1u@etu.univ-lorraine.fr>.
+
+ * uniquify.el (uniquify-buffer-name-style): Change default.
+
+ * loadup.el: Preload "uniquify".
+
+ * time.el (display-time-update): Update all mode lines (bug#15999).
+
+ * electric.el (electric-indent-mode): Enable by default.
+ * loadup.el: Preload "electric".
+
+2013-11-29 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/helpers.el (string-empty-p): New function.
+ (string-blank-p): New function.
+
+2013-11-29 Andreas Politz <politza@hochschule-trier.de>
+
+ * imenu.el (imenu--index-alist): Add missing dot to the docstring
+ (Bug#14029).
+
+2013-11-29 Andreas Politz <politza@fh-trier.de>
+ * imenu.el (imenu--subalist-p): Don't error on non-conses and
+ allow non-lambda lists as functions.
+ (imenu--in-alist): Don't recurse into non-subalists.
+ (imenu): Don't pass function itself as an argument (Bug#14029).
+
+2013-11-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-mode-map): Remove binding for ":".
+ (python-indent-electric-colon): Remove command.
+ (python-indent-post-self-insert-function): Integrate the previous code
+ of python-indent-electric-colon. Make it conditional on
+ electric-indent-mode.
+ (python-mode): Add ?: to electric-indent-chars.
+ Move python-indent-post-self-insert-function to the end of
+ post-self-insert-hook.
+
+2013-11-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc-view.el (doc-view-goto-page): Update mode-line.
+
+ * vc/vc-dispatcher.el (vc-log-edit): Setup the Summary&Author headers.
+
+2013-11-27 Glenn Morris <rgm@gnu.org>
+
+ * international/charprop.el, international/uni-bidi.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-titlecase.el:
+ * international/uni-uppercase.el:
+ Remove generated files from VCS repository.
+
+2013-11-27 Eli Zaretskii <eliz@gnu.org>
+
+ * filenotify.el (file-notify-add-watch): Don't special-case
+ w32notify when computing the directory to watch.
+
+2013-11-27 Glenn Morris <rgm@gnu.org>
+
+ Make bootstrap without generated uni-*.el files possible again.
+ * loadup.el: Update command-line-args checking for unidata-gen.
+ Add vc to load-path to allow loading vc-bzr when writing uni-*.el.
+ * composite.el, international/characters.el:
+ Handle unicode tables being undefined.
+
+ Move ja-dic, quail, leim-list.el from ../leim to a leim subdirectory.
+ * Makefile.in (setwins_for_subdirs): Skip leim/ directory.
+ (compile-main): Depend on leim rule.
+ (leim): New rule.
+ * loadup.el: Move leim-list.el to leim/ subdirectory.
+ * startup.el (normal-top-level): No more leim directory.
+ * international/ja-dic-cnv.el (skkdic-convert):
+ Disable version-control and autoloads in output files.
+ * international/titdic-cnv.el (titdic-convert, miscdic-convert):
+ Disable version-control and autoloads in output files.
+ * leim/quail: Move here from ../leim.
+ * leim/quail/hangul.el (hangul-input-method-activate):
+ Add autoload cookie.
+ (generated-autoload-load-name): Set file-local value.
+ * leim/quail/uni-input.el (ucs-input-activate): Add autoload cookie.
+ (generated-autoload-load-name): Set file-local value.
+
+2013-11-26 Kenjiro NAKAYAMA <knakayam@redhat.com>
+
+ * net/eww.el (eww-bookmark-browse): Use 'eww-browse-url'.
+ (eww-add-bookmark): Ask confirmation when add to bookmarks.
+ (eww-quit): Ask confirmation before quitting eww.
+
+2013-11-26 Eli Zaretskii <eliz@gnu.org>
+
+ * vc/vc.el (vc-diff-internal): Use *-dos coding-system when
+ reading output from Diff on MS-Windows and MS-DOS.
+
+2013-11-26 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/helpers.el (string-reverse): New function.
+
+2013-11-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-file-name-regexp-unified): Support IPv6 host
+ names on MS Windows, like "/[::1]:".
+
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory): Accept nil
+ SWITCHES.
+
+2013-11-26 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-indent-guess-indent-offset):
+ Avoid corner-case error. (Bug#15975)
+
+ Preload leim-list.el. (Bug#4789)
+ * loadup.el: Load leim-list.el when found.
+ * startup.el (normal-top-level): Skip re-loading leim/leim-list.el.
+
+2013-11-25 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/bytecomp.el (byte-compile-form): Fix a typo.
+
+ * emacs-lisp/helpers.el (string-join): New function.
+
+2013-11-25 Sebastian Wiesner <lunaryorn@gmail.com> (tiny change)
+
+ * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions):
+ Mark as obsolete and replace it with a symbol property.
+ (byte-compile-form): Use new 'interactive-only property.
+ * comint.el, files.el, replace.el, simple.el:
+ Apply new 'interactive-only properly.
+
+2013-11-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-at-bottom): Make sure that
+ split-window-sensibly creates the new window on bottom
+ (Bug#15961).
+
+2013-11-23 David Kastrup <dak@gnu.org>
+
+ * vc/smerge-mode.el (smerge-ediff): Choose default buffer names based
+ on the conflict markers when available.
+ (smerge--get-marker): New function.
+ (smerge-end-re, smerge-base-re): Add subgroup.
+
+2013-11-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frame.el (handle-focus-in, handle-focus-out): Add missing
+ interactive spec.
+
+2013-11-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cmds.el (tramp-cleanup-connection): Clean up
+ `tramp-current-connection' only when KEEP-PASSWORD is non-nil.
+
+2013-11-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * play/gomoku.el: Don't use intangible property. Use lexical-binding.
+ (gomoku--last-pos): New var.
+ (gomoku--intangible-chars): New const.
+ (gomoku--intangible): New function.
+ (gomoku-mode): Use it. Derive from special-mode.
+ (gomoku-move-up): Adjust line count.
+ (gomoku-click, gomoku-point-y, gomoku-point-square, gomoku-goto-xy)
+ (gomoku-plot-square, gomoku-init-display, gomoku-cross-qtuple):
+ Simplify accordingly.
+
+ * frame.el (handle-focus-in, handle-focus-out): Move from frame.c.
+ Remove blink-cursor code.
+ (blink-cursor-timer-function, blink-cursor-suspend):
+ Don't special-case GUIs.
+ (blink-cursor-mode): Use focus-in/out-hook.
+
+2013-11-25 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-annotate-extract-revision-at-line): Make it
+ work when annotation is invisible (Bug#13886).
+
+2013-11-24 Simon Schubert <2@0x2c.org> (tiny change)
+
+ * json.el (json-alist-p): Only return non-nil if the alist has
+ simple keys (Bug#13518).
+
+2013-11-24 Mihir Rege <mihirrege@gmail.com> (tiny change)
+
+ * progmodes/js.el (js--ctrl-statement-indentation): Fix indent
+ when control-statement is the first statement in a buffer (Bug#15956).
+
+2013-11-24 Dmitry Gutov <dgutov@yandex.ru>
+
+ * imenu.el (imenu-generic-skip-comments-and-strings):
+ New option (Bug#15560).
+ (imenu--generic-function): Use it.
+
+2013-11-24 Jorgen Schaefer <contact@jorgenschaefer.de>
+
+ * minibuffer.el (completion--in-region-1): Scroll the correct window.
+ (Bug#13898)
+
+2013-11-24 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/helpers.el: Add some string helpers.
+ (string-trim-left): Removes leading whitespace.
+ (string-trim-right): Removes trailing whitespace.
+ (string-trim): Removes leading and trailing whitespace.
+
+ * subr.el (string-suffix-p): New function.
+
+2013-11-23 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/python.el (python-shell-send-file):
+ Add option to delete file when done. (Bug#15647)
+ (python-shell-send-string, python-shell-send-region): Use it.
+
+2013-11-23 Ivan Shmakov <ivan@siamics.net>
+
+ * vc/diff-mode.el (diff-mode): Only allow diff-default-read-only
+ to set buffer-read-only to t, never to nil. (Bug#15938)
+
+ * textmodes/tex-mode.el (latex-noindent-environments):
+ Add safe-local-variable property. (Bug#15936)
+
+2013-11-23 Glenn Morris <rgm@gnu.org>
+
+ * textmodes/enriched.el (enriched-mode): Doc fix.
+ * emacs-lisp/authors.el (authors-renamed-files-alist):
+ Add enriched.doc -> enriched.txt.
+
+ * Makefile.in (emacs): Empty EMACSLOADPATH rather than unsetting.
+
+2013-11-22 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup): Spit out error
+ message.
+
+2013-11-22 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-custom-encoding-magic-comment-template):
+ Improve docstring.
+ Add :version.
+ (ruby-encoding-magic-comment-style): Add :version.
+
+2013-11-22 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-operator-regexp): Exclude newline.
+ (Bug#15076)
+ (octave-help-mode): Adapt to change to help-mode-finish to use
+ derived-mode-p on 2013-09-17.
+ (inferior-octave-prompt): Also match octave-gui.
+ (octave-kill-process): Don't ask twice. (Bug#10564)
+
+2013-11-22 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-process-live-p): New helper.
+ (inferior-octave-startup, inferior-octave-check-process)
+ (inferior-octave-track-window-width-change)
+ (octave-completion-at-point, octave-eldoc-function): Use it.
+ (octave-kill-process): Provide confirmation. (Bug#10564)
+
+2013-11-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode, inferior-octave-mode):
+ Fix obsolete variable comment-use-global-state.
+
+2013-11-21 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave-mode-map, octave-mode-menu):
+ Add `octave-source-file'.
+ (octave-source-file): New function. (Bug#15935)
+
+2013-11-21 Kenjiro Nakayama <nakayamakenjiro@gmail.com>
+
+ * net/eww.el (eww-local-regex): New variable.
+ (eww): Use it to detect localhost and similar.
+
+2013-11-21 Leo Liu <sdl.web@gmail.com>
+
+ Add completion for command `ag'.
+ * pcmpl-x.el (pcmpl-x-ag-options): New variable.
+ (pcomplete/ag): New function.
+ (pcmpl-x-ag-options): New function. Handle `[no]' in long options.
+
+2013-11-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (eval-when-compile): Fix edebug spec
+ (bug#14646).
+ (make-obsolete): Remove interactive spec.
+
+2013-11-21 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line-1): Use path-separator with -L.
+
+2013-11-20 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/package.el (describe-package-1): Add package archive
+ to shown fields.
+
+2013-11-20 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-custom-encoding-magic-comment-template):
+ Change default to "# encoding: %s" to differentiate it from the
+ default Ruby encoding comment template.
+
+2013-11-20 Era Eriksson <era+emacsbugs@iki.fi>
+
+ * ses.el (ses-mode): Doc fix. (Bug#14748)
+
+2013-11-20 Leo Liu <sdl.web@gmail.com>
+
+ * window.el (display-buffer-alist): Doc fix. (Bug#13594)
+
+2013-11-19 Dan Nicolaescu <dann@gnu.org>
+
+ * vc/vc-git.el (vc-git-dir-extra-headers): Add headers
+ when rebase or bisect are in progress.
+
+2013-11-19 Xue Fuqiao <xfq.free@gmail.com>
+
+ * filenotify.el (file-notify-add-watch): Doc fix.
+
+2013-11-19 Leo Liu <sdl.web@gmail.com>
+
+ * obsolete/rcompile.el: Mark obsolete.
+
+ * progmodes/compile.el (compilation-start)
+ (compilation-goto-locus, compilation-find-file):
+ Pass no-display-ok and handle nil value from display-buffer.
+ (Bug#13594)
+
+ * window.el (display-buffer-alist, display-buffer): Document the
+ new parameter no-display-ok. Return either a window or nil
+ but never a non-window value.
+
+2013-11-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-mode-map): Remove.
+ (electric-indent-mode): Change the global-map instead (bug#15915).
+
+ * textmodes/text-mode.el (paragraph-indent-minor-mode):
+ Use add-function.
+
+2013-11-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (remove-function): Align with
+ add-function's behavior.
+
+ * progmodes/gdb-mi.el: Avoid backtracking in regexp matcher.
+ (gdb--string-regexp): New constant.
+ (gdb-tooltip-print, gdb-var-evaluate-expression-handler)
+ (gdbmi-bnf-stream-record, gdb-jsonify-buffer): Use it.
+ (gdb-source-file-regexp, gdb-prompt-name-regexp): Use it and change
+ submatch 1.
+ (gdb-get-source-file-list, gdb-get-prompt, gdb-get-source-file):
+ Adjust use accordingly.
+ (gdb-breakpoints-list-handler-custom): Pre-build the y/n string.
+
+2013-11-17 Adam Sokolnicki <adam.sokolnicki@gmail.com> (tiny change)
+
+ * progmodes/ruby-mode.el (ruby-toggle-block): Don't stop at
+ interpolation curlies (Bug#15914).
+
+2013-11-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (calc-context-sensitive-enter): New variable.
+ (calc-enter): Use `calc-context-sensitive-enter'.
+
+2013-11-16 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el: Version bump.
+ (cfengine-cf-promises): New defcustom to locate cf-promises.
+ (cfengine3-vartypes): Add new "data" type.
+ (cfengine3--current-word): New function to get current name-like
+ word or its bounds.
+ (cfengine3--current-function): New function to look up a CFEngine
+ function's definition.
+ (cfengine3-format-function-docstring): New function.
+ (cfengine3-make-syntax-cache): New function.
+ (cfengine3-documentation-function): New function: ElDoc glue.
+ (cfengine3-completion-function): New function: completion glue.
+ (cfengine3-mode): Set `compile-command',
+ `eldoc-documentation-function', and add to
+ `completion-at-point-functions'.
+
+2013-11-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cmds.el (tramp-cleanup-connection): Clean up
+ `tramp-current-connection'.
+
+2013-11-15 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): End regexp for
+ nil/self/true/false with "end of symbol".
+
+2013-11-15 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * subr.el (version-regexp-alist): Fix a typo.
+
+2013-11-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Set "LC_ALL" to
+ "en_US.utf8" and "LC_CTYPE" to "".
+ (tramp-maybe-open-connection): Set "LC_ALL" to "en_US.utf8".
+ (tramp-sh-handle-insert-directory): Don't set "LC_ALL" and "LC_CTYPE".
+
+2013-11-15 Leo Liu <sdl.web@gmail.com>
+
+ * loadhist.el (read-feature): Get rid of fake feature nil. (Bug#15889)
+
+2013-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/gud.el (ctl-x-map):
+ Remove C-x SPC binding. (Bug#12342)
+ (gud-jdb-find-source-using-classpath): Remove ((lambda (..)..)..).
+
+2013-11-14 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * subr.el (version-regexp-alist):
+ Recognize hg, svn and darcs versions as snapshot versions.
+
+ * progmodes/ruby-mode.el (ruby--detect-encoding): Make aware of
+ 'always-utf8 value of `ruby-insert-encoding-magic-comment'.
+ (ruby--encoding-comment-required-p): Extract from
+ `ruby-mode-set-encoding'.
+ (ruby-mode-set-encoding): Add the ability to always insert an
+ utf-8 encoding comment. Fix and simplify coding comment update
+ logic.
+
+2013-11-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-gvfs.el (top): Run init code only when
+ `tramp-gvfs-enabled' is not nil.
+ (tramp-gvfs-enabled): Check also :system bus.
+
+2013-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Sync with upstream verilog-mode revision 78e66ba.
+ * progmodes/verilog-mode.el (verilog-end-of-defun)
+ (verilog-type-completion, verilog-get-list): Remove unused funcs.
+ (verilog-get-end-of-defun): Remove unused argument.
+ (verilog-comment-depth): Remove unused local `e'.
+ (verilog-read-decls, verilog-read-sub-decls, verilog-read-instants):
+ Don't pass arg to verilog-get-end-of-defun.
+
+2013-11-14 Glenn Morris <rgm@gnu.org>
+
+ * obsolete/assoc.el (aget): Prefix dynamic variable.
+
+ * allout-widgets.el (allout-widgets): No need to autoload defgroup.
+
+2013-11-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * widget.el, hfy-cmap.el: Remove bogus package version number.
+
+2013-11-13 Glenn Morris <rgm@gnu.org>
+
+ * replace.el (replace-eval-replacement):
+ Try to give more helpful error message. (Bug#15836)
+
+ * arc-mode.el (archive-7z-extract, archive-7z-expunge)
+ (archive-7z-update): Avoid custom type mismatches.
+
+ * vc/vc.el (vc-diff-knows-L): Remove; unused since 2007-10-10.
+
+2013-11-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-remote-file-name-spec-regexp): An IPv6
+ address can be empty.
+
+ * net/tramp-gvfs.el (tramp-gvfs-handle-insert-directory):
+ Accept nil SWITCHES.
+ (tramp-gvfs-handle-write-region): Implement APPEND.
+
+2013-11-12 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Disambiguate between
+ binary "|" operator and closing block args delimiter.
+ Remove FIXME comment referring to Ruby 1.8-only syntax.
+ (ruby-smie--implicit-semi-p): Not after "|" operator.
+ (ruby-smie--closing-pipe-p): New function.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Use it.
+ (ruby-smie-rules): Indent after "|".
+
+2013-11-12 Glenn Morris <rgm@gnu.org>
+
+ * ps-print.el (ps-face-attribute-list):
+ Handle anonymous faces. (Bug#15827)
+
+2013-11-12 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-other-frame): Fix doc-string.
+ (Bug#15868)
+
+2013-11-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (force-mode-line-update): Delete, move to buffer.c.
+
+2013-11-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer)
+ (tramp-sh-handle-file-local-copy): Don't write a message when
+ saving temporary files.
+
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory): Fix bug when
+ both directories are remote.
+ (tramp-smb-handle-directory-files): Do not return double entries.
+ Do not expand full file names.
+ (tramp-smb-handle-insert-directory): Accept nil SWITCHES.
+ (tramp-smb-handle-write-region): Implement APPEND.
+ (tramp-smb-get-stat-capability): Fix a stupid bug.
+
+2013-11-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bindings.el (ctl-x-map): Bind C-x SPC to rectangle-mark-mode.
+
+2013-11-11 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * emacs-lisp/cconv.el (cconv-convert): Print warning instead of
+ throwing error over malformed let/let* (bug#15814).
+
+2013-11-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * iswitchb.el (iswitchb-mode): Mark obsolete.
+
+2013-11-11 Glenn Morris <rgm@gnu.org>
+
+ * international/uni-bidi.el, international/uni-category.el:
+ * international/uni-name.el, international/uni-numeric.el:
+ Regenerate for Unicode 6.3.0.
+
+2013-11-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-methods):
+ * net/tramp-sh.el (tramp-compute-multi-hops): Revert change of
+ 2013-10-29 (2013-10-29T02:50:24Z!dancol@dancol.org).
+
+2013-11-09 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/sh-script.el (sh-font-lock-keywords-var):
+ Force highlighting text after Summary keyword in doc face for rpm.
+
+2013-11-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * textmodes/ispell.el (ispell-lookup-words): When `look' is not
+ available and the word has no wildcards, append one to the grep pattern.
+ http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00258.html
+ (ispell-complete-word): Call `ispell-lookup-words' with the value
+ independent of `ispell-look-p'.
+
+2013-11-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p):
+ Not after "||".
+ (ruby-smie-rules): Indent non-hanging "begin" blocks as part of
+ their parent.
+
+2013-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el: Don't require cl any more. Use pcase instead.
+ (ruby-font-lock-keywords): Use backquote.
+
+2013-11-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--forward-token)
+ (ruby-smie--backward-token): Only consider full-string matches.
+
+2013-11-08 Jan Djärv <jan.h.d@swipnet.se>
+
+ * faces.el (describe-face): Add distant-foreground.
+
+2013-11-08 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el: Improve encoding comment handling.
+ (ruby-encoding-magic-comment-style): New option.
+ (ruby-custom-encoding-magic-comment-template): New option.
+ (ruby--insert-coding-comment, ruby--detect-encoding):
+ New functions extracted from `ruby-mode-set-encoding'.
+ (ruby-mode-set-encoding): Use `ruby-encoding-magic-comment-style'
+ to control the style of the auto-inserted encoding comment.
+
+2013-11-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--indent-to-stmt):
+ Use `smie-backward-sexp' with token argument.
+
+2013-11-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-set-remote-path, tramp-get-ls-command):
+ Remove instrumentation code.
+
+2013-11-08 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/autoconf.el (autoconf-mode):
+ Tweak comment-start-skip. (Bug#15822)
+
+2013-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el (sh-smie--sh-keyword-in-p): Don't inf-loop
+ at bobp (bug#15826).
+ (sh-smie--sh-keyword-in-p): Recognize keywords at bobp.
+
+2013-11-08 Darren Hoo <darren.hoo@gmail.com>
+
+ * man.el (Man-start-calling): New macro, extracted from
+ Man-getpage-in-background.
+ (Man-getpage-in-background): Use it.
+ (Man-update-manpage): New command.
+ (Man-mode-map): Bind it.
+
+2013-11-08 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Improve precedences
+ of "and", "or", "&&" and "||".
+ (ruby-smie--args-separator-p): Prohibit keyword "do" as the first
+ argument. Prohibit opening curly brace because it could only be a
+ block opener in that position.
+ (ruby-smie--forward-token, ruby-smie--backward-token):
+ Separate "|" from "&" or "*" going after it. That can happen in block
+ arguments.
+ (ruby-smie--indent-to-stmt): New function, seeks the end of
+ previous statement or beginning of buffer.
+ (ruby-smie-rules): Use it.
+ (ruby-smie-rules): Check if there's a ":" before a curly block
+ opener candidate; if there is, it's a hash.
+
+2013-11-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-symbol-macrolet): Use macroexp-progn.
+ (cl--block-wrapper): Fix last accidental change.
+
+2013-11-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-set-remote-path, tramp-get-ls-command):
+ Instrument, in order to hunt failure on hydra.
+
+2013-11-05 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * emacs-lisp/cl-macs.el (cl-symbol-macrolet): Print warning for
+ malformed bindings form (bug#15814).
+
+2013-11-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Lower priority of
+ "." compared to " @ ". This incidentally fixes some indentation
+ examples with "do".
+ (ruby-smie--implicit-semi-p): No implicit semi after "^", "and" or "or".
+ (ruby-smie-grammar): New tokens: "and" and "or".
+ (ruby-smie--args-separator-p): Fix the check for tokens at POS.
+ Exclude "and" and "or". Remove "do" in order to work around token
+ priorities.
+ (ruby-smie-rules): Add all infix tokens. Handle the case of
+ beginning-of-buffer.
+
+2013-11-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (setwins_almost, setwins_for_subdirs):
+ Avoid accidental matches.
+
+2013-11-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * menu-bar.el (popup-menu): Use key-binding.
+
+2013-11-06 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (popup-menu, menu-bar-open): When displaying TTY
+ menus, support also the menus produced by minor modes.
+ (Bug#15817)
+
+2013-11-06 Leo Liu <sdl.web@gmail.com>
+
+ * thingatpt.el (thing-at-point-looking-at): Add optional arg
+ DISTANCE to bound the search. All uses changed. (Bug#15808)
+
+2013-11-06 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (setwins, setwins_almost, setwins_for_subdirs): Simplify.
+ (setwins_almost, setwins_for_subdirs): Don't assume called from srcdir.
+ (custom-deps, finder-data, autoloads, update-subdirs): No need to cd.
+
+2013-11-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-just-newline): New command.
+ (electric-indent-mode-map): New keymap.
+ (electric-indent-mode, electric-pair-mode, electric-layout-mode):
+ Re-add :group which weren't redundant.
+
+ * electric.el (electric-indent-local-mode): New minor mode.
+ (electric-indent-functions-without-reindent): New var.
+ (electric-indent-post-self-insert-function): Use it.
+ * emacs-lisp/gv.el (buffer-local-value): Add setter.
+
+2013-11-05 Eli Zaretskii <eliz@gnu.org>
+
+ * international/quail.el (quail-help): Be more explicit about the
+ meaning of the labels shown on the keys. (Bug#15800)
+
+ * startup.el (normal-top-level): Load the subdirs.el files before
+ setting the locale environment. (Bug#15805)
+
+2013-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-rcs.el (vc-rcs-parse): Make `gather' get e, b, and @-holes
+ via arguments so as to get the right ones (bug#15418).
+
+ * net/rcirc.el (rcirc-record-activity): Don't abuse add-to-list.
+
+2013-11-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix problems found while writing a test suite.
+
+ * net/tramp-compat.el (tramp-compat-load): New defun.
+ * net/tramp.el (tramp-handle-load): Use it.
+
+ * net/tramp-sh.el (tramp-sh-handle-add-name-to-file): Handle the case
+ "(numberp ok-if-already-exists)" correctly.
+
+2013-11-05 Xue Fuqiao <xfq.free@gmail.com>
+
+ * international/characters.el (glyphless-char-display-control):
+ Add usage note.
+
+2013-11-05 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/python.el (python-mode):
+ * progmodes/scheme.el (scheme-mode):
+ * progmodes/prolog.el (prolog-mode):
+ * progmodes/ruby-mode.el (ruby-mode):
+ * emacs-lisp/lisp-mode.el (lisp-mode, lisp-interaction-mode)
+ (emacs-lisp-mode): Remove incorrect and redundant text from docstring.
+
+2013-11-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (rectangle--highlight-for-redisplay):
+ * emacs-lisp/smie.el (smie--next-indent-change):
+ Use buffer-chars-modified-tick.
+
+ * 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).
+
+2013-11-04 Helmut Eller <eller.helmut@gmail.com>
+
+ * emacs-lisp/cl-indent.el (with-compilation-unit): Add rule (bug#15782).
+
+2013-11-04 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * emacs-lisp/cconv.el (cconv-convert): Check form of let binding
+ (bug#15786).
+
+2013-11-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/helpers.el: Move from helpers.el. Use lexical-binding.
+
+ * progmodes/python.el: Fix up last change.
+ (python-shell--save-temp-file): New function.
+ (python-shell-send-string): Use it. Remove `msg' arg. Don't assume
+ `string' comes from the current buffer.
+ (python-shell-send-string-no-output): Remove `msg' arg.
+ (python--use-fake-loc): New var.
+ (python-shell-buffer-substring): Obey it. Try to compensate for the
+ extra coding line added by python-shell--save-temp-file.
+ (python-shell-send-region): Use python-shell--save-temp-file and
+ python-shell-send-file directly. Add `nomain' argument.
+ (python-shell-send-buffer): Use python-shell-send-region.
+ (python-electric-pair-string-delimiter): New function.
+ (python-mode): Use it.
+
+2013-11-04 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (normal-top-level): Move setting eol-mnemonic-unix,
+ eol-mnemonic-mac, eol-mnemonic-dos, and also setup of the locale
+ environment and decoding all of the default-directory's to here
+ from command-line.
+ (command-line): Decode also argv[0].
+
+ * loadup.el: Error out if default-directory is a multibyte string
+ when we are dumping.
+
+ * Makefile.in (emacs): Don't set LC_ALL=C. (Bug#15260)
+
+2013-11-04 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * emacs-lisp/package.el (package-menu-mode)
+ (package-menu--print-info, package-menu--archive-predicate):
+ Add Archive column to package list.
+
+2013-11-04 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix problems found while writing a test suite.
+
+ * net/tramp.el (tramp-file-name-regexp-unified): Simplify.
+ (tramp-file-name-for-operation): Use `tramp-tramp-file-p'.
+ (tramp-handle-substitute-in-file-name): Let-bind `process-environment'
+ to nil when running original file name handler. Otherwise,
+ there are problems with constructs like "$$FOO".
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file): Use correct prefix
+ for `localname'.
+
+2013-11-04 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-mode): Clean up docstring.
+
+ * subr.el (version<, version<=, version=):
+ Update docstrings with information for snapshot versions.
+
+ * helpers.el: New library for misc helper functions.
+ (hash-table-keys): New function returning a list of hash keys.
+ (hash-table-values): New function returning a list of hash values.
+
+2013-11-04 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--forward-token)
+ (ruby-smie--backward-token): Tokenize heredocs as semicolons.
+
+2013-11-04 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/fill.el (fill-single-char-nobreak-p): New function
+ checking whether point is after a 1-letter word.
+
+2013-11-04 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * progmodes/cperl-mode.el (cperl-font-lock-fontify-region-function):
+ Don't infloop when expanding region over `multiline' syntax-type that
+ begins a line (bug#15778).
+
+2013-11-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * rect.el (rectangle-mark-mode): Rename from rectangle-mark.
+ Make it into a proper minor mode.
+ (rectangle--region): (Implicitly) rename to rectangle-mark-mode.
+ (rectangle-mark-mode-map): New keymap.
+ (rectangle--highlight-for-redisplay): Fix some corner cases (bug#15796).
+
+2013-11-04 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (command-line-1): Allow `-L :...' to append to load-path.
+
+2013-11-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el (ruby-smie--rule-parent-skip-assign): Remove.
+ (ruby-smie-rules): Use smie-rule-parent instead.
+
+ * emacs-lisp/smie.el (smie-rule-parent): Always call
+ smie-indent-virtual rather than only for hanging tokens.
+ (smie--next-indent-change): New helper command.
+
+2013-11-03 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (abs_srcdir): Remove.
+ (emacs): Unset EMACSLOADPATH.
+
+2013-11-02 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (EMACS): Use a relative filename.
+ (abs_top_builddir): Remove.
+ (custom-deps, finder-data, autoloads): Use --chdir.
+
+ * Makefile.in (abs_lisp): Remove, replace by abs_srcdir.
+
+ Use relative filenames in TAGS files.
+ * Makefile.in (lisptagsfiles1, lisptagsfiles2, lisptagsfiles3)
+ (lisptagsfiles4, TAGS): Use relative file names.
+ (TAGS-LISP): Remove.
+ (maintainer-clean): No more TAGS-LISP file.
+
+ * Makefile.in (lisptagsfiles1, lisptagsfiles2, lisptagsfiles3)
+ (lisptagsfiles4): Use absolute filenames again.
+ (TAGS, TAGS-LISP): Not everything needs to run in one line.
+ Remove all *loaddefs files, not just the first. Remove esh-groups.
+ (maintainer-clean): Delete TAGS, TAGS-LISP.
+
+2013-11-02 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * emacs-lisp/package.el (package-version-join):
+ Recognize snapshot versions.
+
+2013-11-02 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * subr.el (version-regexp-alist): Add support for snapshot versions.
+
+2013-11-02 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--rule-parent-skip-assign):
+ New function, replacement for `smie-rule-parent' for when we want to
+ skip over our direct parent if it's an assignment token..
+ (ruby-smie-rules): Use it.
+
+2013-11-02 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el: Use `syntax-propertize-function'
+ unconditionally. Remove now unnecessary forward declarations.
+ Remove XEmacs-specific setup.
+ (ruby-here-doc-end-re, ruby-here-doc-beg-match)
+ (ruby-font-lock-syntactic-keywords)
+ (ruby-comment-beg-syntax, ruby-in-here-doc-p)
+ (ruby-here-doc-find-end, ruby-here-doc-beg-syntax)
+ (ruby-here-doc-end-syntax): Remove.
+ (ruby-mode): Don't check whether `syntax-propertize-rules' is
+ defined as function.
+
+2013-11-02 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-mode-variables, ruby-mode): Use `setq-local'.
+
+2013-11-01 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-mode-variables): Don't set syntax
+ table and abbrev table, `define-derived-mode' does that for us
+ anyway.
+
+2013-11-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in: Remove manual mh-e dependencies (writing .elc
+ files is atomic for some time, so no parallel compilation issues).
+
+2013-11-01 Jan Djärv <jan.h.d@swipnet.se>
+
+ * faces.el (face-x-resources): Add :distant-foreground.
+ (region): Use :distant-foreground for gtk and ns.
+
+2013-11-01 Tassilo Horn <tsdh@gnu.org>
+
+ Allow multiple bibliographies when BibLaTeX is used rather than
+ BibTeX.
+ * textmodes/reftex-parse.el (reftex-using-biblatex-p): New function.
+ (reftex-locate-bibliography-files): Us it.
+
+2013-11-01 Claudio Bley <claudio.bley@googlemail.com>
+
+ * image.el (image-type-header-regexps): Fix the 'pbm' part to
+ allow comments in pbm files.
+
+ * term/w32-win.el (dynamic-library-alist): Support newer versions
+ of libjpeg starting with v7: look only for the DLL from the
+ version against which Emacs was built.
+ Support versions of libpng beyond 1.4.x.
+ Support libtiff v4.x.
+
+2013-11-01 Bozhidar Batsov <bozhidar@batsov.com>
+
+ * progmodes/ruby-mode.el (ruby-indent-tabs-mode)
+ (ruby-indent-level, ruby-comment-column, ruby-deep-arglist):
+ Add property :safe.
+ (ruby-deep-arglist): Add property :type.
+
+2013-10-31 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (custom-deps, finder-data): No need to setq the target
+ variables, we are in the right directory and the defaults work fine.
+
+2013-10-30 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (autoloads): Do not use abs_lisp.
+
+ * emacs-lisp/autoload.el (autoload-generate-file-autoloads):
+ `newline' does not respect `standard-output', so use `princ'.
+
+2013-10-30 Alp Aker <alp.tekin.aker@gmail.com>
+
+ Ensure unmarking in buffer menu clears 'S' marks. (Bug#15761)
+ * buff-menu.el (Buffer-menu--unmark): New function.
+ (Buffer-menu-unmark, Buffer-menu-backup-unmark): Use it.
+
+2013-10-30 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (AUTOGENEL): Add org/org-loaddefs.el.
+
+ * emacs-lisp/package.el (lm-homepage): Declare.
+
+ * eshell/em-ls.el (eshell-ls-directory, eshell-ls-symlink):
+ Fix doc typos.
+
+ * vc/pcvs.el (cvs-status-cvstrees): Autoload to silence compiler.
+
+ * Makefile.in (finder-data, autoloads, update-subdirs)
+ (compile-main, compile-clean, compile-always, bootstrap-clean):
+ Check return value of cd.
+ (compile-calc): Remove.
+
+2013-10-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (copy-region-as-kill): Fix call to region-extract-function.
+
+ * emacs-lisp/bytecomp.el (byte-defop-compiler): Add new `2-and' handler.
+ (byte-compile-and-folded): New function.
+ (=, <, >, <=, >=): Use it.
+
+ * dos-w32.el (minibuffer-history-case-insensitive-variables)
+ (path-separator, null-device, buffer-file-coding-system)
+ (lpr-headers-switches): Check system-type before modifying them.
+ (find-buffer-file-type-coding-system): Mark obsolete.
+ (w32-find-file-not-found-set-buffer-file-coding-system): Rename from
+ find-file-not-found-set-buffer-file-coding-system.
+ (w32-untranslated-filesystem-list, w32-untranslated-canonical-name)
+ (w32-add-untranslated-filesystem, w32-remove-untranslated-filesystem)
+ (w32-direct-print-region-use-command-dot-com, w32-untranslated-file-p)
+ (w32-direct-print-region-helper, w32-direct-print-region-function)
+ (w32-direct-ps-print-region-function): Rename by adding a "w32-" prefix.
+ * startup.el (normal-top-level-add-subdirs-to-load-path):
+ * ps-print.el (ps-print-region-function):
+ * lpr.el (print-region-function): Use new name.
+
+ * subr.el (custom-declare-variable-early): Remove function.
+ (custom-declare-variable-list): Remove var.
+ (error, user-error): Remove `while' loop.
+ (read-quoted-char-radix, read-quoted-char): Move to simple.el.
+ (user-emacs-directory-warning, locate-user-emacs-file):
+ Move to files.el.
+ * simple.el (read-quoted-char-radix, read-quoted-char):
+ * files.el (user-emacs-directory-warning, locate-user-emacs-file):
+ Move from subr.el.
+ * custom.el (custom-declare-variable-list): Don't process
+ custom-declare-variable-list.
+
+ * progmodes/python.el (python-shell-get-buffer): New function.
+ (python-shell-get-process): Use it.
+ (python-shell-send-string): Always use utf-8 and add a cookie to tell
+ Python which encoding was used. Don't split-string since we only care
+ about the first line. Return the temp-file, if applicable.
+ (python-shell-send-region): Tell compile.el how to turn locations in
+ the temp-file into locations in the source buffer.
+
+2013-10-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (undefined): Add missing behavior from the C code for
+ unbound keys.
+
+ * rect.el: Use lexical-binding. Add new rectangular region support.
+ (rectangle-mark): New command.
+ (rectangle--region): New var.
+ (deactivate-mark-hook): Reset rectangle--region.
+ (rectangle--extract-region, rectangle--insert-for-yank)
+ (rectangle--highlight-for-redisplay)
+ (rectangle--unhighlight-for-redisplay): New functions.
+ (region-extract-function, redisplay-unhighlight-region-function)
+ (redisplay-highlight-region-function): Use them to handle
+ rectangular region.
+ * simple.el (region-extract-function): New var.
+ (delete-backward-char, delete-forward-char, deactivate-mark): Use it.
+ (kill-new, kill-append): Remove obsolete `yank-handler' argument.
+ (kill-region): Replace obsolete `yank-handler' arg with `region'.
+ (copy-region-as-kill, kill-ring-save): Add `region' argument.
+ (redisplay-unhighlight-region-function)
+ (redisplay-highlight-region-function): New vars.
+ (redisplay--update-region-highlight): New function.
+ (pre-redisplay-function): Use it.
+ (exchange-point-and-mark): Don't deactivate the mark before
+ reactivate-it anyway.
+ * comint.el (comint-kill-region): Remove yank-handler argument.
+ * delsel.el (delete-backward-char, backward-delete-char-untabify)
+ (delete-char): Remove property, since it's now part of their
+ default behavior.
+ (self-insert-iso): Remove property since this command doesn't exist.
+
+ * emacs-lisp/package.el (package--download-one-archive)
+ (describe-package-1): Don't query the user about final newline.
+
+2013-10-29 Daniel Colascione <dancol@dancol.org>
+
+ * net/tramp.el (tramp-methods): Document new functionality.
+ * net/tramp-sh.el (tramp-compute-multi-hops): Punt to
+ tramp-hostname-checker if method provides one instead of scanning
+ argument list for "%h" to decide hostname acceptability.
+
+2013-10-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-copy-directory):
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory):
+ Handle COPY-CONTENTS. (Bug#15737)
+
+2013-10-28 Daiki Ueno <ueno@gnu.org>
+
+ * epa-file.el (epa-file-cache-passphrase-for-symmetric-encryption):
+ Document that this option has no effect with GnuPG 2.0 (bug#15552).
+
+2013-10-27 Xue Fuqiao <xfq.free@gmail.com>
+
+ * image.el (defimage, image-load-path): Doc fixes.
+
+2013-10-27 Alan Mackenzie <acm@muc.de>
+
+ Indent statements in macros following "##" correctly.
+ * progmodes/cc-engine.el (c-crosses-statement-barrier-p):
+ Modify the "#" arm of a cond form to handle "#" and "##" operators.
+
+2013-10-27 Nathan Trapuzzano <nbtrap@nbtrap.com> (tiny change)
+
+ * linum.el (linum-update-window): Fix boundary test (bug#13446).
+
+2013-10-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--bosp): Anything that goes
+ after `=' is probably a new expression.
+
+2013-10-27 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * man.el (man-imenu-title): New option.
+ (Man-mode-map): Add menu. (Bug#15722)
+ (Man-mode): Add imenu to menu.
+
+2013-10-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--args-separator-p): Be more
+ specific in what the first arg can be: a non-keyword word,
+ string/regexp/percent literal opener, opening paren, or unary
+ operator followed directly by word.
+
+2013-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/prolog.el: Remove old indent; use post-self-insert-hook.
+ (prolog-align-comments-flag, prolog-indent-mline-comments-flag)
+ (prolog-object-end-to-0-flag, prolog-electric-newline-flag)
+ (prolog-electric-tab-flag, prolog-use-prolog-tokenizer-flag):
+ Remove vars, they do not apply any more.
+ (prolog-mode-abbrev-table): Remove redundant declaration.
+ (prolog-upper-case-string, prolog-lower-case-string): Remove.
+ (prolog-use-smie): Remove.
+ (prolog-smie-rules): Add indentation rule for the if-then-else layout
+ supported by prolog-electric-if-then-else-flag.
+ (prolog-mode-variables, prolog-menu): Use setq-local.
+ (prolog-mode-keybindings-edit): Don't rebind M-C-p and M-C-n.
+ Remove binding to `Backspace' since this key doesn't exist anyway.
+ Remove bindings for electric self-inserting keys.
+ (prog-mode): Assume it's defined.
+ (prolog-post-self-insert): New function.
+ (prolog-mode): Use it.
+ (prolog-indent-line, prolog-indent-level)
+ (prolog-find-indent-of-matching-paren)
+ (prolog-indentation-level-of-line, prolog-goto-comment-column)
+ (prolog-paren-is-the-first-on-line-p, prolog-region-paren-balance)
+ (prolog-goto-next-paren, prolog-in-string-or-comment)
+ (prolog-tokenize, prolog-inside-mline-comment)
+ (prolog-find-start-of-mline-comment): Remove functions.
+ (prolog-find-unmatched-paren, prolog-clause-end)
+ (prolog-guess-fill-prefix, prolog-get-predspec): Use syntax-ppss.
+ (prolog-electric--if-then-else): Rename from
+ prolog-insert-spaces-after-paren; use prolog-electric-if-then-else-flag.
+ (prolog-tokenize-searchkey): Remove const.
+ (prolog-clause-info): Use forward-sexp.
+ (prolog-forward-list, prolog-backward-list, prolog-electric-delete)
+ (prolog-electric-if-then-else): Remove commands.
+ (prolog-electric--colon): Rename from prolog-electric-colon; adapt it
+ for use in post-self-insert-hook.
+ (prolog-electric--dash): Rename from prolog-electric-dash; adapt it
+ for use in post-self-insert-hook.
+ (prolog-electric--dot): Rename from prolog-electric-dot; adapt it
+ for use in post-self-insert-hook.
+ (prolog-electric--underscore): Rename from prolog-electric--underscore;
+ adapt it for use in post-self-insert-hook.
+
+2013-10-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * emacs-lisp/ert.el (ert-run-tests-interactively):
+ Use `completing-read'. (Bug#9756)
+
+2013-10-25 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move): Call line-move-1 instead of
+ line-move-visual when the current window hscroll is zero, but
+ temporary-goal-column indicates we will need to hscroll as result
+ of the movement. (Bug#15712)
+
+2013-10-25 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-mode-menu): Use proper
+ capitalization. Use :visible instead of :active.
+ Fix `ruby-indent-exp' reference. Add menu items for the generic
+ commands that are used with SMIE.
+ (ruby-do-end-to-brace): Insert space after `{'.
+
+2013-10-25 John Anthony <john@jo.hnanthony.com>
+
+ * progmodes/ruby-mode.el (ruby-mode-menu): Add a menu. (Bug#15600)
+
+ * progmodes/inf-lisp.el (inferior-lisp-menu): Add a menu. (Bug#15599)
+
+2013-10-25 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc.el (vc-print-log): Don't use a working revision unless
+ one was explicitly specified. (Bug#15322)
+
+2013-10-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (add-to-list): Preserve return value in compiler-macro
+ (bug#15692).
+
+2013-10-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave-lookfor): Handle empty lookfor
+ result. Ask user to retry using '-all' flag. (Bug#15701)
+
+2013-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el: New smie-config system.
+ (smie-config): New defcustom.
+ (smie-edebug, smie-config-show-indent, smie-config-set-indent)
+ (smie-config-guess, smie-config-save): New commands.
+ (smie-config--mode-local, smie-config--buffer-local)
+ (smie-config--trace, smie-config--modefuns): New vars.
+ (smie-config--advice, smie-config--mode-hook)
+ (smie-config--setter, smie-config-local, smie-config--get-trace)
+ (smie-config--guess-value, smie-config--guess): New functions.
+ (smie-indent-forward-token, smie-indent-backward-token): Don't copy
+ text properties. Treat "string fence" syntax like string syntax.
+
+ * progmodes/sh-script.el (sh-use-smie): Change default.
+ (sh-smie-sh-rules, sh-smie-rc-rules): Obey legacy sh-indent-* vars.
+ (sh-var-value): Simplify by CSE.
+ (sh-show-indent, sh-set-indent, sh-learn-line-indent)
+ (sh-learn-buffer-indent): Redirect to their SMIE equivalent when SMIE
+ is used.
+ (sh-guess-basic-offset): Use cl-incf.
+ (sh-guess-basic-offset): Use push+nreverse to avoid O(n^2).
+
+2013-10-24 Helmut Eller <eller.helmut@gmail.com>
+
+ * emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2): Fix cut&paste
+ (bug#15699).
+
+2013-10-24 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (abs_top_srcdir): Remove.
+ (update-subdirs): Use relative path to update-subdirs.
+
+2013-10-24 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in ($(MH_E_DIR)/mh-loaddefs.el)
+ ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el)
+ ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el):
+ Call unmsys--file-name before expand-file-name, not after it.
+
+2013-10-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * emacs-lisp/ert.el (ert-deftest): Bind macro `skip-unless'.
+ (ert-test-skipped): New error.
+ (ert-skip, ert-stats-skipped): New defuns.
+ (ert--skip-unless): New macro.
+ (ert-test-skipped): New struct.
+ (ert--run-test-debugger, ert-test-result-type-p)
+ (ert-test-result-expected-p, ert--stats, ert-stats-completed)
+ (ert--stats-set-test-and-result, ert-char-for-test-result)
+ (ert-string-for-test-result, ert-run-tests-batch)
+ (ert--results-update-ewoc-hf, ert-run-tests-interactively):
+ Handle skipped tests. (Bug#9803)
+
+2013-10-24 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (check-declare): Remove unnecessary path in -l argument.
+
+ * Makefile.in (abs_top_srcdir): New, set by configure.
+ (update-subdirs): Correct build-aux location.
+
+2013-10-24 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc.el (vc-print-root-log): Always set `default-directory'
+ value, whether we could auto-deduce `backend', or not.
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Fix the "curly block
+ with parameters" example. Simplify the "is it block or is it
+ hash" check, but also make it more thorough.
+
+2013-10-23 Masashi Fujimoto <masfj.dev@gmail.com> (tiny change)
+
+ * battery.el (battery-pmset): Handle OS X Mavericks. (Bug#15694)
+
+2013-10-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Only align with parent of
+ { if it is hanging.
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Don't return 0 for
+ :before ";".
+
+2013-10-23 Jed Brown <jed@59A2.org> (tiny change)
+
+ * progmodes/compile.el (compilation-directory-matcher)
+ (compilation-page-delimiter):
+ Support GNU Make-4.0 directory quoting. (Bug#15678)
+
+2013-10-23 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-tidy): Handle read-only text.
+
+2013-10-23 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (abs_srcdir, abs_lisp): New, set by configure.
+ (emacs, compile, compile-always):
+ Quote entities that might contain whitespace.
+ (custom-deps, finder-data, autoloads): Use abs_lisp.
+ ($(MH_E_DIR)/mh-loaddefs.el, $(TRAMP_DIR)/tramp-loaddefs.el)
+ ($(CAL_DIR)/cal-loaddefs.el, $(CAL_DIR)/diary-loaddefs.el)
+ ($(CAL_DIR)/hol-loaddefs.el): Manually expand target file name.
+
+2013-10-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--at-dot-call):
+ Use `following-char'.
+
+2013-10-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-rule-parent): Fix opener-test.
+ * progmodes/ruby-mode.el (ruby-smie-rules):
+ Remove corresponding workaround. Fix indentation rule of ";" so it
+ also applies when ";" is the parent.
+
+2013-10-22 Xue Fuqiao <xfq.free@gmail.com>
+
+ * frame.el (display-screens, display-pixel-height)
+ (display-pixel-width, display-mm-width, display-backing-store)
+ (display-save-under, display-planes, display-color-cells)
+ (display-visual-class, display-monitor-attributes-list):
+ Mention the optional ‘display’ argument in doc strings.
+
+2013-10-22 Michael Gauland <mikelygee@amuri.net>
+
+ * progmodes/ebnf2ps.el (ebnf-prologue): Avoid PS error with some
+ viewers such as evince when ebnf-production-name-p is nil. (Bug#15625)
+
+2013-10-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Remove outdated
+ TODO. Add "." after " @ ".
+ (ruby-smie--at-dot-call): New function. Checks if point at method
+ call with explicit target.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Prepend "."
+ to the method name tokens when it precedes them.
+ (ruby-smie--backward-id, ruby-smie--forward-id): Remove.
+ (ruby-smie-rules): Add rule for indentation before and after "."
+ token.
+
+2013-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/remember.el (remember-diary-extract-entries):
+ Avoid add-to-list.
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Indent after + used as
+ an instruction.
+
+2013-10-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar):
+ Add (almost) all infix operators.
+ (ruby-smie--implicit-semi-p): Add new operator chars.
+
+ * progmodes/ruby-mode.el (ruby-mode-map): Add binding for
+ `smie-down-list'.
+ (ruby-smie--args-separator-p): Check that there's no newline
+ between method call and its arguments.
+
+2013-10-20 Alan Mackenzie <acm@muc.de>
+
+ Allow comma separated lists after Java "implements".
+
+ * progmodes/cc-engine.el (c-backward-over-enum-header):
+ Parse commas.
+ * progmodes/cc-fonts.el (c-basic-matchers-after): Remove comma
+ from a "disallowed" list in enum fontification.
+
+2013-10-20 Johan Bockgård <bojohan@gnu.org>
+
+ * startup.el (default-frame-background-mode): Remove unused defvar.
+
+ * progmodes/verilog-mode.el (verilog-mode): Don't set
+ comment-indent-function globally.
+
+2013-10-20 Jan Djärv <jan.h.d@swipnet.se>
+
+ * menu-bar.el: Put help-menu in menu-bar-final-items unconditionally.
+ Move Info menu item creation to ns-win.el.
+
+ * term/ns-win.el (ns-initialize-window-system): Rename Help to Info
+ in menu bar.
+
+ * menu-bar.el: Move GNUstep specific menus...
+
+ * term/ns-win.el (ns-initialize-window-system): ... to here.
+
+2013-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (newline): Only run post-self-insert-hook when
+ called interactively.
+
+2013-10-19 Johan Bockgård <bojohan@gnu.org>
+
+ * icomplete.el (icomplete-with-completion-tables): Add :version.
+
+2013-10-19 Alan Mackenzie <acm@muc.de>
+
+ Fix fontification bugs with constructors and const.
+
+ * progmodes/cc-engine.el (c-forward-decl-or-cast-1): (Just after
+ CASE 2) Remove the check for the absence of a suffix construct
+ after a function declaration with only types (no identifiers) in
+ the parentheses. Also, accept a function declaration with just a
+ type inside the parentheses, if this type can be positively
+ recognised as such, or if a prefix keyword like "explicit" nails
+ down the construct as a declaration.
+
+2013-10-19 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (tty-menu-navigation-map): Bind mouse-N to perform
+ TTY menu actions and down-mouse-N to tty-menu-ignore. This solves
+ the problem whereby selecting a menu item that leads to a
+ minibuffer prompt moves the cursor out of the minibuffer window,
+ making it hard to type at the prompt. Suggested by Stefan Monnier
+ <monnier@iro.umontreal.ca>.
+
+2013-10-19 Jan Djärv <jan.h.d@swipnet.se>
+
+ * menu-bar.el: Don't make Services menu.
+
+2013-10-19 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * ffap.el: Handle "/usr/include/c++/<version>" directories.
+ (ffap-alist): Use ffap-c++-mode for c++-mode.
+ (ffap-c++-path): New variable.
+ (ffap-c++-mode): New function.
+
+2013-10-19 Joe Vornehm Jr. <joe.vornehm@gmail.com> (tiny change)
+
+ * ido.el (dired-other-frame): Only list directories. (Bug#15638)
+
+2013-10-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection): Fix an error
+ introduced on 2013-09-08, which results in an infinite loop
+ requesting a password.
+
+2013-10-18 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/verilog-mode.el (verilog-case-fold): Add :version.
+
+2013-10-18 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode revision 1a6ecec7.
+ * progmodes/verilog-mode.el (verilog-mode-version): Update.
+ (verilog-mode-release-date): Remove.
+ (verilog-highlight-grouping-keywords, verilog-active-low-regexp)
+ (verilog-auto-inst-param-value, verilog-auto-input-ignore-regexp)
+ (verilog-auto-inout-ignore-regexp, verilog-auto-output-ignore-regexp)
+ (verilog-auto-tieoff-ignore-regexp)
+ (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp)
+ (verilog-scan-cache-preserving, verilog-mode, verilog-at-struct-p)
+ (verilog-signals-with, verilog-dir-cache-preserving)
+ (verilog-auto-inst, verilog-auto-inout-param, verilog-auto):
+ Doc fixes.
+ (verilog-case-fold): New option, to control case folding in
+ regexp searches, bug597.
+ (verilog-menu): Add verilog-sk-uvm-component, minor tweaks.
+ (verilog-string-match-fold, verilog-in-paren-count)
+ (verilog-in-struct-nested-p, verilog-at-struct-mv-p)
+ (verilog-at-close-struct-p): New functions.
+ (verilog-beg-block-re-ordered, verilog-extended-case-re)
+ (verilog-forward-sexp, verilog-set-auto-endcomments)
+ (verilog-leap-to-case-head): Handle "unique0" case.
+ (verilog-in-constraint-re): New constant.
+ (verilog-keywords, verilog-type-font-keywords):
+ Add some SystemVerilog 1800-2012 keywords.
+ (verilog-label-be): Remove unimplemented argument, bug669.
+ (verilog-batch-execute-func): When batch expanding clear
+ create-lockfiles to prevent spurious user locks when a file ends
+ up not changing.
+ (verilog-calculate-indent, verilog-calc-1)
+ (verilog-at-close-constraint-p, verilog-at-constraint-p)
+ (verilog-do-indent): Fix indentation of nested constraints
+ and structures.
+ (verilog-sig-tieoff, verilog-typedef-name-p, verilog-auto-inst)
+ (verilog-auto-inst-param): Use verilog-string-match-fold.
+ (verilog-read-inst-module-matcher):
+ Fix AUTOINST on gate primitives with #1.
+ (verilog-read-decls): Fix double-declaring user-defined typed signals.
+ Reads all user-defined typed variables.
+ (verilog-read-defines): Fix reading definitions inside comments, bug647.
+ (verilog-signals-matching-regexp)
+ (verilog-signals-not-matching-regexp, verilog-auto):
+ Respect verilog-case-fold.
+ (verilog-diff-report): Fix line count.
+ (verilog-auto-assign-modport): Remove unused local `modi'.
+ (verilog-auto-inst-port): Support [][] in AUTO_TEMPLATE to
+ better handle multidimensional arrays.
+ Fix packed array ports misadding bit index in AUTOINST, bug637.
+ (verilog-auto-output, verilog-auto-input): Fix AUTOINPUT and AUTOOUTPUT
+ to not double-declare existing outputs and inputs, respectively.
+ (verilog-template-map): Bind U to verilog-sk-uvm-component.
+ (verilog-sk-uvm-object): Rename from verilog-sk-uvm-class.
+ (verilog-sk-uvm-component): New skeleton.
+ (verilog-submit-bug-report): Add verilog-case-fold,
+ remove verilog-mode-release-date.
+
+2013-10-17 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * subr.el (sit-for): Call (input-pending-p t) so as to behave
+ as before.
+
+2013-10-18 Reuben Thomas <rrt@sc3d.org>
+
+ * textmodes/remember.el (remember): Set buffer-offer-save in
+ remember buffers (bug#13566).
+
+2013-10-18 Daniel Colascione <dancol@dancol.org>
+
+ When evaluating forms in ielm, direct standard output to ielm
+ buffer. Add new ielm-return-for-effect command. Remove trailing
+ whitespace throughout.
+
+ * ielm.el (ielm-map): Bind M-RET to ielm-return-for-effect.
+ (ielm-return-for-effect): New command.
+ (ielm-send-input): Accept optional `for-effect' parameter.
+ (ielm-eval-input): Accept optional `for-effect' parameter.
+ Bind `standard-output' to stream we create using
+ `ielm-standard-output-impl'. Suppress printing result when
+ `for-effect'.
+ (ielm-standard-output-impl): New function.
+ (inferior-emacs-lisp-mode): Explain new features in documentation.
+
+2013-10-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Code cleanup.
+
+ * net/tramp.el (tramp-debug-message): Do not check for connection
+ buffer.
+ (tramp-message): Use "vector" connection property.
+
+ * net/tramp.el (tramp-rfn-eshadow-update-overlay)
+ (tramp-equal-remote, tramp-eshell-directory-change)
+ * net/tramp-adb.el (tramp-adb-handle-copy-file)
+ (tramp-adb-handle-rename-file)
+ * net/tramp-cmds.el (tramp-list-remote-buffers)
+ (tramp-cleanup-connection, tramp-cleanup-this-connection)
+ * net/tramp-compat.el (tramp-compat-process-running-p)
+ * net/tramp-ftp.el (tramp-ftp-file-name-handler)
+ * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file)
+ (tramp-gvfs-handle-rename-file)
+ * net/tramp-sh.el (tramp-sh-handle-set-file-times)
+ (tramp-set-file-uid-gid)
+ * net/tramp-smb.el (tramp-smb-handle-copy-file)
+ (tramp-smb-handle-rename-file): Use `tramp-tramp-file-p' instead
+ of `file-remote-p'.
+
+ * net/tramp.el (tramp-connectable-p, tramp-handle-file-remote-p)
+ * net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
+ (tramp-gw-aux-proc-sentinel, tramp-gw-process-filter)
+ (tramp-gw-open-network-stream): Suppress unrelated traces.
+
+ * net/tramp-adb.el (tramp-adb-maybe-open-connection)
+ * net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch)
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection): Set "vector"
+ connection property.
+
+ * net/tramp-cache.el (top): Suppress traces when reading
+ persistency file.
+
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
+ Refactor common code. Improve debug message.
+ (tramp-maybe-open-connection)
+ * net/tramp-smb.el (tramp-smb-call-winexe): Do not request
+ connection buffer too early.
+
+ * net/tramp-smb.el (tramp-smb-actions-get-acl): New defconst, renamed
+ from `tramp-smb-actions-with-acl'.
+ (tramp-smb-actions-set-acl): New defconst.
+ (tramp-smb-handle-copy-directory)
+ (tramp-smb-action-get-acl): New defun, renamed from
+ `tramp-smb-action-with-acl'.
+ (tramp-smb-action-set-acl): New defun.
+ (tramp-smb-handle-set-file-acl): Rewrite.
+
+2013-10-17 Glenn Morris <rgm@gnu.org>
+
+ * indent.el (indent-rigidly): Fix 2013-10-08 change. (Bug#15635)
+
+2013-10-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * skeleton.el (skeleton-newline): Remove.
+ (skeleton-internal-1): Use (insert "\n") instead.
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point): Complete var names for
+ let-bindings.
+
+ * progmodes/sh-script.el (sh-find-prev-matching): Disable SMIE's
+ forward-sexp-function while we redo its job (bug#15613).
+
+2013-10-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-comb.el (math-prime-test): Don't assume large integers are
+ represented by lists.
+
+2013-10-16 Glenn Morris <rgm@gnu.org>
+
+ * tmm.el (tmm--history): New dynamic variable.
+ (tmm-prompt): Use tmm--history in place of `history'. (Bug#15623)
+
+2013-10-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-smb.el (tramp-smb-acl-program): New customer option.
+ (tramp-smb-errors): Add error messages.
+ (tramp-smb-actions-with-acl): New defconst.
+ (tramp-smb-file-name-handler-alist) <set-file-acl>: Add handler.
+ (tramp-smb-action-with-acl, tramp-smb-handle-set-file-acl): New defuns.
+ (tramp-smb-handle-file-acl): Rewrite, using "smbcacls".
+ (tramp-smb-handle-file-attributes): Simplify test for "stat" capability.
+ (tramp-smb-get-stat-capability): Fix tests.
+
+2013-10-16 Dima Kogan <dima@secretsauce.net> (tiny change)
+
+ * progmodes/subword.el (subword-capitalize): Fix Stefan's mess
+ (bug#15580).
+
+2013-10-16 Glenn Morris <rgm@gnu.org>
+
+ * ansi-color.el (ansi-color-drop-regexp):
+ Add 1J, 1K, 2K. (Bug#15617)
+
+ * files.el (hack-local-variables--warned-lexical): New.
+ (hack-local-variables):
+ Warn about misplaced lexical-binding. (Bug#15616)
+
+ * net/eww.el (eww-render): Always set eww-current-url,
+ and update header line. (Bug#15622)
+ (eww-display-html): ... Rather than just doing it here.
+
+2013-10-15 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (tty-menu-navigation-map): Bind mouse wheels to TTY
+ menu navigations commands.
+
+2013-10-14 Dima Kogan <dima@secretsauce.net> (tiny change)
+
+ * progmodes/subword.el (subword-capitalize): Be careful when
+ the search for [[:alpha:]] fails (bug#15580).
+
+2013-10-14 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (tty-menu-navigation-map): Bind shifted mouse clicks
+ to commands that scroll the menu.
+
+2013-10-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--args-separator-p):
+ Handle methods ending with `?' and `!'.
+
+2013-10-14 Akinori MUSHA <knu@iDaemons.org>
+
+ * progmodes/ruby-mode.el (ruby-encoding-map): Add a mapping from
+ `japanese-cp932' to `cp932' to fix the problem where saving a
+ source file written in Shift_JIS twice would end up having
+ `coding: japanese-cp932' which Ruby could not recognize.
+ (ruby-mode-set-encoding): Add support for encodings mapped to nil
+ in `ruby-encoding-map'.
+ (ruby-encoding-map): Map `us-ascii' to nil by default, meaning it
+ doesn't need to be explicitly declared in magic comment.
+ (ruby-encoding-map): Add type declaration for better customize UI.
+
+2013-10-13 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/sh-script.el (sh-mark-line, sh-learn-buffer-indent):
+ Occur buffers are read-only. http://bugs.debian.org/720775
+
+ * emacs-lisp/authors.el (authors-fixed-entries):
+ Comment out old alpha stuff.
+
+2013-10-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-mode): Add `ruby-mode-set-encoding'
+ to `after-save-hook' instead of `before-save-hook'.
+ (ruby-mode-set-encoding): Use the value of coding system used to
+ write the file. Call `basic-save-buffer-1' after modifying the
+ buffer.
+
+2013-10-13 Alan Mackenzie <acm@muc.de>
+
+ Fix indentation/fontification of Java enum with
+ "implements"/generic.
+
+ * progmodes/cc-engine.el (c-backward-over-enum-header):
+ Extracted from the three other places and enhanced to handle generics.
+ (c-inside-bracelist-p): Uses new function above.
+ * progmodes/cc-fonts.el (c-font-lock-declarations): Uses new
+ function above.
+ (c-font-lock-enum-tail): Uses new function above.
+
+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
+ or not.
+
+2013-10-13 Oleh Krehel <ohwoeowho@gmail.com>
+
+ * replace.el (how-many): Fix rstart and !rend case. (Bug#15589)
+
+2013-10-13 Andreas Politz <politza@hochschule-trier.de>
+
+ * progmodes/sql.el (sql-add-product): Fix paren typo. (Bug#15435)
+
+2013-10-13 Glenn Morris <rgm@gnu.org>
+
+ * menu-bar.el (menu-bar-update-buffers):
+ Unify Buffers menu prompt string. (Bug#15576)
+
+ * face-remap.el (text-scale-adjust): Doc fix. (Bug#15434)
+
+ * emacs-lisp/authors.el (authors-aliases, authors-ignored-files):
+ Add some entries.
+ (authors-fixed-entries): Use accented form of name.
+
+2013-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for paren-free
+ method calls (bug#15594).
+ (ruby-smie--args-separator-p): New function.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Use it to
+ recognize paren-free method calls.
+
+ * isearch.el (isearch-pre-command-hook): Don't build in knowledge about
+ internals of universal-argument.
+
+2013-10-11 Eli Zaretskii <eliz@gnu.org>
+
+ * menu-bar.el (tty-menu-navigation-map): Remap F10 to tty-menu-exit.
+ Bind all menu-bar sequences to tty-menu-exit -- this pops down a
+ dropped menu on second mouse click on the menu bar.
+
+2013-10-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/sh-script.el: Provide simpl(e|istic) completion.
+ (explicit-shell-file-name): Declare.
+ (sh--vars-before-point, sh--cmd-completion-table): New functions.
+ (sh-completion-at-point-function): New function.
+ (sh-mode): Use it.
+ (sh-smie--keyword-p): Remove unused argument.
+ (sh-smie-sh-backward-token, sh-smie-rc-backward-token): Remove unused
+ vars.
+ (sh-set-shell): Always setup SMIE, even if we use the
+ old indentation code.
+
+2013-10-11 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Split the
+ cases of ? and =.
+ (ruby-smie-rules): Simplify the "do" rule. The cases when the
+ predicate would return nil are almost non-existent.
+ (ruby-smie--redundant-do-p): Include "until" and "for" statements.
+
+ * emacs-lisp/smie.el (smie--matching-block-data): Invalidate the
+ cache also after commands that modify the buffer but don't move
+ point.
+
+2013-10-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * env.el (substitute-env-in-file-name): New function.
+ (substitute-env-vars): Extend the meaning of the optional arg.
+
+2013-10-10 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist): Define separate lists
+ of GIF DLLs for versions before and after 5.0.0 of giflib.
+ (Bug#15531)
+
+2013-10-10 João Távora <joaotavora@gmail.com>
+
+ * vc/vc.el (vc-diff-build-argument-list-internal): If the file is
+ not locked, use last revision and current source as
+ defaults. (Bug#15569)
+
+2013-10-10 Masatake YAMATO <yamato@redhat.com>
+
+ * menu-bar.el (menu-bar-open): Don't use popup-menu if
+ menu-bar is hidden.
+
+2013-10-10 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (pop-to-buffer-same-window): Fix doc-string.
+ (Bug#15492)
+
+2013-10-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * menu-bar.el (tty-menu-navigation-map): Reduce redundancy.
+
+2013-10-10 Andrei Chițu <andrei.chitu1@gmail.com> (tiny change)
+
+ * calendar/icalendar.el (icalendar-import-file):
+ Fix interactive spec. (Bug#15482)
+
+2013-10-10 Glenn Morris <rgm@gnu.org>
+
+ * desktop.el (desktop-save): Default to saving in .emacs.d,
+ since PWD is no longer in desktop-path by default. (Bug#15319)
+
+ * menu-bar.el (menu-bar-options-menu): Remove text-mode auto-fill,
+ now that text mode has a menu with the same entry.
+ (menu-bar-text-mode-auto-fill): Remove now unused func.
+ * textmodes/text-mode.el (text-mode-map):
+ Use auto-fill help text from menu-bar.el.
+
+2013-10-10 John Anthony <john@jo.hnanthony.com>
+
+ * textmodes/text-mode.el (text-mode-map): Add a menu. (Bug#15562)
+
+2013-10-09 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-pre-command-hook): Use this-single-command-keys
+ instead of this-command-keys. Add universal-argument-more and
+ universal-argument-minus to the list of prefix commands. (Bug#15568)
+
+2013-10-09 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-svn.el (vc-svn-create-repo):
+ Expand paths in file://... url. (Bug#15446)
+
+ * emacs-lisp/authors.el (authors-aliases, authors-fixed-case):
+ Add some entries.
+ (authors): Remove unused local variables.
+
+2013-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * profiler.el: Create a more coherent calltree from partial backtraces.
+ (profiler-format): Hide the tail with `invisible' so that C-s can still
+ find the hidden elements.
+ (profiler-calltree-depth): Don't recurse so enthusiastically.
+ (profiler-function-equal): New hash-table-test.
+ (profiler-calltree-build-unified): New function.
+ (profiler-calltree-build): Use it.
+ (profiler-report-make-name-part): Indent the calltree less.
+ (profiler-report-mode): Add visibility specs for profiler-format.
+ (profiler-report-expand-entry, profiler-report-toggle-entry):
+ Expand the whole subtree when provided with a prefix arg.
+
+2013-10-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Indent after hanging
+ iuwu-mod token.
+ (ruby-smie--implicit-semi-p): Prohibit implicit semicolon after
+ hanging iuwu-mod token.
+ (ruby-smie--forward-token): Do not include a dot after a token in
+ that token.
+ (ruby-smie--backward-token): Likewise.
+
+2013-10-08 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-help-map, isearch-mode-map): Don't bind [t]
+ to isearch-other-control-char.
+ (isearch-mode): Add isearch-pre-command-hook to pre-command-hook
+ and isearch-post-command-hook to post-command-hook.
+ (isearch-done): Remove isearch-pre-command-hook from pre-command-hook
+ and isearch-post-command-hook from post-command-hook.
+ (isearch-unread-key-sequence)
+ (isearch-reread-key-sequence-naturally)
+ (isearch-lookup-scroll-key, isearch-other-control-char)
+ (isearch-other-meta-char): Remove functions.
+ (isearch-pre-command-hook, isearch-post-command-hook):
+ New functions based on isearch-other-meta-char rewritten
+ relying on the new behavior of overriding-terminal-local-map
+ that does not replace the local keymaps any more. (Bug#15200)
+
+2013-10-08 Eli Zaretskii <eliz@gnu.org>
+
+ Support menus on text-mode terminals.
+ * tmm.el (tmm-menubar): Adapt doc string to TTY menus
+ functionality.
+
+ * tooltip.el (tooltip-mode): Don't error out on TTYs.
+
+ * menu-bar.el (popup-menu, popup-menu-normalize-position):
+ Move here from mouse.el.
+ (popup-menu): Support menu-bar navigation on TTYs using C-f/C-b
+ and arrow keys.
+ (tty-menu-navigation-map): New map for TTY menu navigation.
+
+ * loadup.el ("tooltip"): Load even if x-show-tip is not available.
+
+ * frame.el (display-mouse-p): Report text-mode mouse as available
+ on w32.
+ (display-popup-menus-p): Report availability if mouse is
+ available; don't condition on window-system.
+
+ * faces.el (tty-menu-enabled-face, tty-menu-disabled-face)
+ (tty-menu-selected-face): New faces.
+
+2013-10-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp-mode.el: Font-lock cl-lib constructs.
+ (lisp-el-font-lock-keywords, lisp-el-font-lock-keywords-1)
+ (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords)
+ (lisp-cl-font-lock-keywords-1, lisp-cl-font-lock-keywords-2):
+ New constants.
+ (lisp-mode-variables): New `elisp' argument.
+ (emacs-lisp-mode): Use it.
+ * font-lock.el (lisp-font-lock-keywords, lisp-font-lock-keywords-1)
+ (lisp-font-lock-keywords-2): Move to lisp-mode.el.
+
+ * indent.el: Use lexical-binding.
+ (indent-region): Add progress reporter.
+ (tab-stop-list): Make it implicitly extend to infinity by repeating the
+ last step.
+ (indent--next-tab-stop): New function to implement this behavior.
+ (tab-to-tab-stop, move-to-tab-stop): Use it.
+
+2013-10-08 Teemu Likonen <tlikonen@iki.fi>
+
+ * indent.el (indent-rigidly--current-indentation): New function.
+ (indent-rigidly-map): New var.
+ (indent-rigidly): Use it to provide interactive mode (bug#8196).
+
+2013-10-08 Bastien Guerry <bzg@gnu.org>
+
+ * register.el (insert-register): Fix 2013-10-07 change.
+
+2013-10-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el: Use lexical-binding.
+ Remove redundant :group args.
+ (perl-nochange): Change default to be closer to other major modes's
+ standard behavior.
+ (perl-indent-line): Don't consider text on current line as a
+ valid beginning of function from which to indent.
+
+ * emacs-lisp/backquote.el (backquote-process): Catch uses of , and ,@
+ with more than one argument (bug#15538).
+
+ * mpc.el (mpc-songs-jump-to): Adjust to different playlist format.
+
+ * vc/pcvs.el: Use lexical-binding.
+ (cvs-temp-buffer, cvs-make-cvs-buffer): Pass some vars in the lexical
+ environment of `eval'.
+ (cvs-mode-run, cvs-mode-do): Change `postproc' to be a function rather
+ than a list of expressions. Adjust callers.
+ * vc/pcvs-defs.el (cvs-postprocess): Remove, unused.
+
+2013-10-07 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie--implicit-semi-p): Handle the
+ case of the dot in a chained method call being on the following line.
+
+2013-10-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-indent-inhibit): New var.
+ (electric-indent-post-self-insert-function): Use it.
+ * progmodes/python.el (python-mode): Set it.
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Tweak handling of
+ open braces.
+
+ * emacs-lisp/smie.el (smie-next-sexp): Refine last fix.
+
+ * textmodes/css-mode.el (css-smie-rules): Fix indentation (bug#15467).
+ (css-mode): Use electric-indent-chars.
+
+ * nxml/nxml-mode.el: Use lexical-binding and syntax-propertize.
+ (font-lock-beg, font-lock-end): Move before first use.
+ (nxml-mode): Use syntax-propertize-function.
+ (nxml-after-change, nxml-after-change1): Adjust accordingly.
+ (nxml-extend-after-change-region): Remove.
+ * nxml/xmltok.el: Use lexical-binding.
+ (xmltok-save): Use `declare'.
+ (xmltok-unclosed-reparse-p, xmltok-semi-closed-reparse-p): Remove.
+ * nxml/nxml-util.el: Use lexical-binding.
+ (nxml-with-degradation-on-error, nxml-with-invisible-motion):
+ Use `declare'.
+ * nxml/nxml-ns.el: Use lexical-binding.
+ (nxml-ns-save): Use `declare'.
+ (nxml-ns-prefixes-for): Avoid add-to-list.
+ * nxml/rng-match.el: Use lexical-binding.
+ (rng--ipattern): Use cl-defstruct.
+ (rng-compute-start-tag-open-deriv, rng-compute-start-attribute-deriv)
+ (rng-cons-group-after, rng-subst-group-after)
+ (rng-subst-interleave-after, rng-apply-after, rng-compute-data-deriv):
+ Use closures instead of `(lambda...).
+
+2013-10-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-insert-file-contents): Improve handling
+ of BEG and END.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ Use `tramp-handle-insert-file-contents'.
+ (tramp-gvfs-handle-insert-file-contents): Remove function.
+
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory):
+ Use `save-restriction' in order to keep markers.
+
+ * net/trampver.el: Update release number.
+
+2013-10-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/compile.el (compilation-parse-errors):
+ Use compilation--put-prop.
+ (compilation--ensure-parse): Check compilation-multiline.
+
+ * emacs-lisp/easymenu.el (easy-menu-create-menu): Use closures.
+
+ * emacs-lisp/lisp-mode.el (eval-defun-2): Simplify, using
+ lexical-binding.
+
+ * emacs-lisp/tq.el (tq-create): Use a closure instead of `(lambda...).
+
+ * progmodes/ruby-mode.el: Fix recently added tests.
+ (ruby-smie-grammar): Add - and +.
+ (ruby-smie--redundant-do-p, ruby-smie--forward-id)
+ (ruby-smie--backward-id): New functions.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Use them.
+ (ruby-smie-rules): Handle hanging do. Get rid of hack, not needed
+ any more.
+
+2013-10-07 Leo Liu <sdl.web@gmail.com>
+
+ * register.el (register-preview-delay)
+ (register-preview-functions): New variables.
+ (register-read-with-preview, register-preview)
+ (register-describe-oneline): New functions.
+ (point-to-register, window-configuration-to-register)
+ (frame-configuration-to-register, jump-to-register)
+ (number-to-register, view-register, insert-register)
+ (copy-to-register, append-to-register, prepend-to-register)
+ (copy-rectangle-to-register): Use register-read-with-preview to
+ read register. (Bug#15525)
+
+2013-10-06 Dato Simó <dato@net.com.org.es> (tiny change)
+
+ * net/network-stream.el (network-stream-open-starttls): Don't add
+ --insecure if it's already present, because that gnutls-cli
+ rejects getting that parameter twice.
+
+2013-10-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-smie-rules): Dedent `ensure'
+ keyword, too.
+
+2013-10-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * newcomment.el (comment-use-global-state): Change default value
+ to t, mark obsolete (Bug#15251).
+ (comment-beginning): In addition to `comment-to-syntax', check the
+ value of `comment-use-global-state'.
+
+2013-10-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el (ruby-use-smie): Change default.
+ (ruby-comment-column): Follow the global default, by default.
+ (ruby-smie-grammar): Add assignment syntax.
+ (ruby-smie--implicit-semi-p): No implicit semi-colon after an
+ open-paren, a comma, or a \.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Handle heredocs,
+ and line continuations.
+ (ruby-smie-rules): Adjust handling of open-paren, now that it's never
+ followed by implicit semi-colons. Add rule for string concatenation
+ and for indentation at BOB.
+ (ruby-forward-sexp, ruby-backward-sexp): Adjust for when SMIE is in use.
+
+ * emacs-lisp/smie.el (smie-next-sexp): Don't go back to pos before
+ calling next-sexp, since next-token may have skipped chars which
+ next-sexp doesn't know should be skipped!
+
+2013-10-05 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-send-region):
+ Call compilation-forget-errors.
+
+2013-10-04 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-svn.el (vc-svn-find-admin-dir):
+ * vc/vc-rcs.el (vc-rcs-find-admin-dir):
+ * vc/vc-mtn.el (vc-mtn-find-admin-dir):
+ * vc/vc-cvs.el (vc-cvs-find-admin-dir):
+ * vc/vc-arch.el (vc-arch-find-admin-dir): New functions.
+
+2013-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el (css-smie-rules): Toplevel's a list (bug#15467).
+
+2013-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-passwd): Hide chars even when called within a context
+ where after-change-functions is disabled (bug#15501).
+ (set-temporary-overlay-map): Don't remove oneself from pre-command-hook
+ until we removed ourself from overriding-terminal-local-map.
+
+2013-10-04 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-mode):
+ Call compilation-forget-errors.
+
+2013-10-04 Xue Fuqiao <xfq.free@gmail.com>
+
+ * emacs-lisp/syntax.el (syntax-ppss): Doc fix.
+
+2013-10-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/secrets.el (secrets-create-collection): Add optional
+ argument ALIAS. Use proper Label keyword. Append ALIAS as
+ dbus-call-method argument. (Bug#15516)
+
+2013-10-04 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-error-regexp-alist)
+ (inferior-octave-compilation-font-lock-keywords): New variables.
+ (compilation-error-regexp-alist)
+ (compilation-mode-font-lock-keywords): Defvar to pacify compiler.
+ (inferior-octave-mode): Use compilation-shell-minor-mode.
+
+2013-10-04 Jorgen Schaefer <forcer@forcix.cx>
+
+ * minibuffer.el (completion--replace): Be careful that `end' might be
+ a marker.
+
+2013-10-03 Daiki Ueno <ueno@gnu.org>
+
+ Add support for package signature checking.
+ * emacs-lisp/package.el (url-http-file-exists-p)
+ (epg-make-context, epg-context-set-home-directory)
+ (epg-verify-string, epg-context-result-for)
+ (epg-signature-status, epg-signature-to-string)
+ (epg-check-configuration, epg-configuration)
+ (epg-import-keys-from-file): Declare.
+ (package-check-signature): New user option.
+ (package-unsigned-archives): New user option.
+ (package-desc): Add `signed' field.
+ (package-load-descriptor): Set `signed' field if .signed file exists.
+ (package--archive-file-exists-p): New function.
+ (package--check-signature): New function.
+ (package-install-from-archive): Check package signature.
+ (package--download-one-archive): Check archive signature.
+ (package-delete): Remove .signed file.
+ (package-import-keyring): New command.
+ (package-refresh-contents): Import default keyring.
+ (package-desc-status): Add "unsigned" status.
+ (describe-package-1, package-menu--print-info)
+ (package-menu-mark-delete, package-menu--find-upgrades)
+ (package-menu--status-predicate): Support "unsigned" status.
+
+2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for
+ the new compilation scheme using the new byte-codes.
+
+ * emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase)
+ (byte-pophandler): New byte codes.
+ (byte-goto-ops): Adjust accordingly.
+ (byte-compile--use-old-handlers): New var.
+ (byte-compile-catch): Use new byte codes depending on
+ byte-compile--use-old-handlers.
+ (byte-compile-condition-case--old): Rename from
+ byte-compile-condition-case.
+ (byte-compile-condition-case--new): New function.
+ (byte-compile-condition-case): New function that dispatches depending
+ on byte-compile--use-old-handlers.
+ (byte-compile-unwind-protect): Pass a function to byte-unwind-protect
+ when we can.
+
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
+ Optimize under `condition-case' and `catch' if
+ byte-compile--use-old-handlers is nil.
+ (disassemble-offset): Handle new bytecodes.
+
+2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (error): Use `declare'.
+ (decode-char, encode-char): Use advertised-calling-convention instead
+ of the docstring to discourage use of the `restriction' arg.
+
+2013-10-03 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-verify-file): Add a comment saying that it does not
+ notify verification error as a return value nor a signal.
+ (epg-verify-string): Ditto.
+
+2013-10-02 Kevin Rodgers <kevin.d.rodgers@gmail.com>
+
+ * progmodes/compile.el (compilation-start): Try globbing the arg to
+ `cd' (bug#15417).
+
+2013-10-02 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.8.
+
+ * net/tramp-cmds.el (tramp-bug, tramp-append-tramp-buffers):
+ * net/tramp-cache.el (tramp-cache-print): Use `tramp-compat-funcall'.
+ * net/trampver.el: Update release number.
+
+2013-10-01 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (ns-initialize-window-system): Set locale-coding-system
+ and default-process-coding-system for darwin only.
+
+2013-10-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-desc): Simplify (bug#15495).
+
+2013-10-01 Mitchel Humpherys <mitch.special@gmail.com> (tiny change)
+
+ * vc/vc-git.el (vc-git-grep): Disable pager.
+
+2013-10-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-buffer-info, describe-package-1):
+ Use :url instead of :homepage, as per
+ http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00622.html
+
+ * newcomment.el (comment-beginning): When `comment-use-syntax' is
+ non-nil, use `syntax-ppss' (Bug#15251).
+
+2013-09-30 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (inferior-octave-startup-file):
+ Prefer ~/.emacs.d/init_octave.m.
+
+2013-09-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-desc-from-define):
+ Accept additional arguments as plist, convert them to an alist and store
+ them in the `extras' slot.
+ (package-generate-description-file): Convert extras alist back to
+ plist and append to the `define-package' form arguments.
+ (package--alist-to-plist): New function.
+ (package--ac-desc): Add `extras' slot.
+ (package--add-to-archive-contents): Check if the archive-contents
+ vector is long enough, and if it is, pass its `extras' slot value
+ to `package-desc-create'.
+ (package-buffer-info): Call `lm-homepage', pass the returned value
+ to `package-desc-from-define'.
+ (describe-package-1): Render the homepage button (Bug#13291).
+
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Pass `extras' slot from `package-desc' to `package-make-ac-desc'.
+
+2013-09-29 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (ns-initialize-window-system): Set locale-coding-system
+ and default-process-coding-system to utf-8-unix (Bug#15402).
+
+2013-09-29 Xue Fuqiao <xfq.free@gmail.com>
+
+ * subr.el (looking-back): Do not recommend using looking-back.
+
+2013-09-28 Alan Mackenzie <acm@muc.de>
+
+ Fix indentation/fontification of Java enum with "implements".
+
+ * progmodes/cc-langs.el (c-postfix-decl-spec-key): New variable, a
+ regexp which matches "implements", etc., in Java.
+ * progmodes/cc-engine.el (c-inside-bracelist-p): Check for extra
+ specifier clauses coming after "enum".
+ * progmodes/cc-fonts.el (c-font-lock-declarations)
+ (c-font-lock-enum-tail): Check for extra specifier clauses coming
+ after "enum".
+
+2013-09-28 Jan Djärv <jan.h.d@swipnet.se>
+
+ * faces.el (region): Change ns_selection_color to
+ ns_selection_fg_color, add ns_selection_bg_color.
+
+2013-09-28 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-completion-table)
+ (inferior-octave-completion-at-point): Minor tweaks.
+
+ * textmodes/ispell.el (ispell-lookup-words): Rename from
+ lookup-words. (Bug#15460)
+ (lookup-words): Obsolete.
+ (ispell-complete-word, ispell-command-loop): All uses changed.
+
+2013-09-28 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave-mode-map): Bind octave-send-buffer.
+ (octave-mode-menu): Add octave-send-buffer.
+ (octave-send-buffer): New function.
+
+2013-09-28 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (octave-mode-map): Add key binding for
+ octave-lookfor.
+ (octave-mode-menu): Add octave-lookfor.
+ (inferior-octave-mode-map, octave-help-mode-map): Bind C-ha to
+ octave-lookfor.
+ (octave-lookfor): New function.
+
+2013-09-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl--loop-destr-temps): Remove.
+ (cl--loop-iterator-function): Rename from cl--loop-map-form and change
+ its convention.
+ (cl--loop-set-iterator-function): New function.
+ (cl-loop): Adjust accordingly, so as not to use cl-subst.
+ (cl--parse-loop-clause): Adjust all uses of cl--loop-map-form.
+ Bind `it' with `let' instead of substituting it with `cl-subst'.
+ (cl--unused-var-p): New function.
+ (cl--loop-let): Don't use the cl--loop-destr-temps hack any more.
+ Eliminate some unused variable warnings (bug#15326).
+
+2013-09-27 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-scale-reset): Rename from
+ `doc-view-reset-zoom-level'.
+ (doc-view-scale-adjust): New command.
+ (doc-view-mode-map): Remap `text-scale-adjust' bindings to
+ `doc-view-scale-adjust'.
+
+2013-09-26 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-reset-zoom-level): New command.
+ (doc-view-mode-map): Remap text-scale-adjust bindings to doc-view
+ zoom commands (bug#15466).
+
+2013-09-26 Kenichi Handa <handa@gnu.org>
+
+ * international/quail.el (quail-help): Make it not a command.
+
+2013-09-26 Leo Liu <sdl.web@gmail.com>
+
+ * minibuffer.el (completion-all-sorted-completions): Make args
+ optional as they are.
+
+2013-09-25 Daniel Colascione <dancol@dancol.org>
+
+ * emacs-lisp/cl-macs.el (cl-type-spec): Tell edebug what type
+ specs are and that they're not evaluated.
+
+2013-09-24 Sam Steingold <sds@gnu.org>
+
+ * midnight.el (clean-buffer-list-kill-regexps)
+ (clean-buffer-list-kill-buffer-names): Update for the new Man
+ buffer naming which includes the object name.
+
+2013-09-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/esh-cmd.el (eshell--sep-terms): New var.
+ (eshell-parse-command, eshell-parse-pipeline): Use it since
+ eshell-separate-commands requires a dynamic scoped var.
+ Reported by Jan Moringen <jmoringe@techfak.uni-bielefeld.de>.
+
+2013-09-23 Leo Liu <sdl.web@gmail.com>
+
+ * autoinsert.el (auto-insert-alist): Make the value of
+ lexical-binding match its file setting.
+
+2013-09-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * vc/vc-sccs.el (vc-sccs-search-project-dir): Mark unused argument.
+
+ * autoarg.el (autoarg-kp-digit-argument):
+ * electric.el (Electric-command-loop):
+ * kmacro.el (kmacro-step-edit-insert):
+ Do not set universal-argument-num-events.
+
+2013-09-22 Leo Liu <sdl.web@gmail.com>
+
+ * files.el (interpreter-mode-alist): Add octave.
+
+2013-09-21 Alan Mackenzie <acm@muc.de>
+
+ C++: fontify identifier in declaration following "public:" correctly.
+ * progmodes/cc-langs.el (c-decl-start-colon-kwd-re): New lang var
+ to match "public", etc.
+ (c-decl-prefix-re): Add ":" into the C++ value.
+ * progmodes/cc-engine.el (c-find-decl-prefix-search): Refactor a
+ bit. Add a check for a ":" preceded by "public", etc.
+
+2013-09-21 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (auto-mode-alist): Support OBJFILE-gdb.gdb script files
+ recognized by GDB 7.5 and later.
+
+2013-09-21 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-dir.el (vc-dir-mode-map): Add keybinding for vc-log-incoming.
+
+2013-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (internal--call-interactively): New const.
+ (called-interactively-p): Use it (bug#3984).
+
+2013-09-20 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/pcvs.el (cvs-mode-ignore):
+ * vc/vc-cvs.el (vc-cvs-ignore, vc-cvs-append-to-ignore):
+ Rename cvs-append-to-ignore to vc-cvs-append-to-ignore.
+
+2013-09-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/em-ls.el: Use advice. Remove redundant :group keywords.
+ (eshell-ls-orig-insert-directory): Remove.
+ (eshell-ls-unload-hook): Not a defcustom any more. Use advice-remove.
+ (eshell-ls-use-in-dired): Use advice-add/remove.
+ (eshell-ls--insert-directory): Rename from eshell-ls-insert-directory.
+ Add `orig-fun' arg for use in :around advice.
+ Make it check (redundantly) eshell-ls-use-in-dired.
+
+2013-09-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-macs.el (cl-defsubst): Remove unused local `pbody'.
+
+ * simple.el (x-selection-owner-p, x-selection-exists-p): Declare.
+
+ * emacs-lisp/eieio.el (class-parent): Undo previous change.
+
+2013-09-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-get-remote-id): Do not raise an error.
+ (tramp-get-remote-uid-with-id, tramp-get-remote-gid-with-id)
+ (tramp-get-remote-python): New defuns.
+ (tramp-get-remote-uid-with-perl)
+ (tramp-get-remote-gid-with-perl): New defuns. Perl code
+ contributed by yary <not.com@gmail.com> (tiny change).
+ (tramp-get-remote-uid-with-python)
+ (tramp-get-remote-gid-with-python): New defuns. Python code
+ contributed by Andrey Tykhonov <atykhonov@gmail.com> (tiny change).
+ (tramp-get-remote-uid, tramp-get-remote-gid): Use new defuns.
+
+2013-09-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/eieio.el (class-parent): Don't use defalias with macros.
+
+ * eshell/em-unix.el (eshell-remove-entries):
+ Rename argument to avoid name-clash with global `top-level'.
+
+ * eshell/esh-proc.el (eshell-kill-process-function):
+ Remove eshell-reset-after-proc from eshell-kill-hook if present.
+ (eshell-reset-after-proc): Remove unused arg `proc'.
+
+ * eshell/esh-util.el (eshell-read-hosts-file): Use `filename' arg.
+ (directory-files-and-attributes): Mark unused arg.
+
+ * eshell/em-unix.el (eshell-remove-entries):
+ Remove unused arg `path'. Update callers.
+
+ * eshell/em-hist.el (eshell-hist-parse-arguments):
+ Remove unused arg `silent'. Update callers.
+
+ * eshell/em-ls.el (eshell-ls-use-in-dired): Use `symbol' arg.
+ Fix (f)boundp mix-up.
+
+ * eshell/em-smart.el (eshell-smart-scroll-window)
+ (eshell-disable-after-change):
+ * eshell/em-term.el (eshell-term-sentinel): Mark unused arg.
+
+2013-09-18 Alan Mackenzie <acm@muc.de>
+
+ Fix fontification of type when followed by "const".
+ * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Don't exclude
+ "known" types from fontification.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/chart.el (x-display-color-cells): Declare.
+ (chart-face-list): Drop Emacsen without display-color-p.
+
+ * net/eww.el (libxml-parse-html-region): Declare.
+ (eww-display-html): Explicit error if no libxml2 support.
+
+ * doc-view.el (doc-view-mode): Silence --without-x compilation.
+
+ * image.el (image-type-from-buffer, image-multi-frame-p):
+ Remove --without-x warning/error.
+
+ * mouse.el (mouse-yank-primary):
+ * term.el (term-mouse-paste):
+ Reorder to silence --without-x compilation.
+
+ * mpc.el (doc-view-mode): Silence --without-x compilation.
+
+ * mail/rmailmm.el (rmail-mime-set-bulk-data):
+ Silence --without-x compilation.
+
+ * progmodes/gud.el (gud-find-file, gud-mode):
+ Silence --without-x compilation.
+ (tooltip-mode): Declare.
+
+ * wdired.el (dired-backup-overwrite): Remove declaration.
+ (wdired-mode-map): Add doc string.
+
+ * custom.el (x-get-resource): Declare.
+
+ * eshell/em-glob.el (ange-cache):
+ * eshell/em-unix.el (ange-cache): Declare.
+
+ * faces.el (x-display-list, x-open-connection, x-get-resource):
+ Declare.
+
+ * follow.el (scroll-bar-toolkit-scroll, scroll-bar-drag)
+ (scroll-bar-scroll-up, scroll-bar-scroll-down, mwheel-scroll):
+ Declare.
+
+ * frame.el (x-display-grayscale-p, x-display-name): Declare.
+
+ * net/gnutls.el (gnutls-log-level): Declare.
+
+ * net/shr.el (image-size, image-animate): Declare.
+
+ * simple.el (font-info): Declare.
+
+ * subr.el (x-popup-dialog): Declare.
+
+ * term/common-win.el (x-select-enable-primary)
+ (x-last-selected-text-primary, x-last-selected-text-clipboard):
+ Declare.
+
+ * term/ns-win.el (x-handle-args): Declare.
+
+ * term/x-win.el (x-select-enable-clipboard): Declare.
+
+ * term/w32-win.el (create-default-fontset): Declare.
+
+ * w32-common-fns.el (x-server-version, x-select-enable-clipboard):
+ Declare.
+
+ * window.el (x-display-pixel-height, tool-bar-lines-needed): Declare.
+ (fit-frame-to-buffer): Explicit error if --without-x.
+ (mouse-autoselect-window-select): Silence compiler.
+
+ * dframe.el (x-sensitive-text-pointer-shape, x-pointer-shape): Declare.
+
+ * eshell/em-cmpl.el (eshell-complete-parse-arguments):
+ * eshell/em-hist.el (eshell/history, eshell-isearch-backward):
+ * eshell/em-pred.el (eshell-parse-modifiers, eshell-pred-file-time):
+ * eshell/esh-util.el (eshell-sublist):
+ Remove unused local variables.
+
+ * eshell/esh-io.el (x-select-enable-clipboard): Declare.
+
+ * textmodes/two-column.el: Make 2C-split work for --without-x.
+ (scroll-bar-columns): Autoload.
+ (top-level): Require fringe when compiling.
+
+2013-09-18 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (add-hook): Robustify to handle closure as well.
+
+2013-09-17 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (messages-buffer-mode-map): Unbind "g".
+
+2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-mode.el (help-mode-finish): Use derived-mode-p.
+ Remove obsolete highlighting.
+
+ * play/life.el (life-mode): Use define-derived-mode. Derive from
+ special-mode.
+ (life): Let-bind inhibit-read-only.
+ (life-setup): Avoid `setq'. Use `life-mode'.
+
+ * emacs-lisp/package.el (package-generate-autoloads): Remove `require'
+ which should not be needed any more.
+ (package-menu-refresh, package-menu-describe-package): Use user-error.
+
+ * eshell/esh-cmd.el (eshell-post-rewrite-command-function): New var.
+ (eshell-post-rewrite-command-hook): Make obsolete.
+ (eshell-parse-command): Simplify.
+ (eshell-structure-basic-command): Remove unused arg `vocal-test'.
+ (eshell--cmd): Declare.
+ (eshell-parse-pipeline): Remove unused var `final-p'.
+ Pass a dynvar to eshell-post-rewrite-command-hook.
+ Implement the new eshell-post-rewrite-command-function.
+ (eshell-invoke-directly): Remove unused arg `input'.
+ * eshell/esh-io.el (eshell-io-initialize):
+ Use eshell-post-rewrite-command-function (bug#15399).
+ (eshell--apply-redirections): Rename from eshell-apply-redirections;
+ adjust to new calling convention.
+ (eshell-create-handles): Rename args to avoid clashing with dynvar
+ `standard-output'.
+
+2013-09-17 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (messages-buffer-mode): New major mode.
+ (messages-buffer): New function.
+ * startup.el (normal-top-level): Switch mode of *Messages* buffer.
+ * emacs-lisp/ert.el (ert--force-message-log-buffer-truncation)
+ (ert-run-test): Use `messages-buffer' function.
+ (ert--force-message-log-buffer-truncation): Ignore read-only.
+ * help.el (view-echo-area-messages): Use `messages-buffer' function.
+ * mail/emacsbug.el (report-emacs-bug): Use `messages-buffer' function.
+
+2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (eval-after-load): Preserve evaluation order (bug#15389).
+
+ * abbrev.el (abbrev--check-chars): Fix thinko (bug#15360).
+
+2013-09-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * icomplete.el (icomplete-in-buffer): New var.
+ (icomplete-pre-command-hook, icomplete-post-command-hook): Remove those
+ vars and replace them with functions.
+ (icomplete-minibuffer-setup): Adjust accordingly.
+ (icomplete--completion-table, icomplete--completion-predicate)
+ (icomplete--field-string, icomplete--field-beg, icomplete--field-end):
+ New functions.
+ (icomplete-forward-completions, icomplete-backward-completions)
+ (icomplete-simple-completing-p, icomplete-exhibit)
+ (icomplete-completions): Use them.
+ (icomplete--in-region-buffer): New var.
+ (icomplete--in-region-setup): New function.
+ (icomplete-mode): Use it.
+
+ * eshell/esh-opt.el: Fix last change to set lexical-vars properly
+ (bug#15379).
+ (eshell--do-opts): Rename from eshell-do-opt, remove arg `body-fun',
+ return args and options.
+ (eshell-eval-using-options): Use the new return value of
+ eshell--do-opts to set the options's vars in their scope.
+ (eshell--set-option): Rename from eshell-set-option.
+ Add arg `opt-vals'.
+ (eshell--process-option): Rename from eshell-process-option.
+ Add arg `opt-vals'.
+ (eshell--process-args): Use an `opt-vals' alist to store the options's
+ values during their processing and return them additionally to the
+ remaining args.
+
+2013-09-15 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-operator-re): Consider line
+ continuation character an operator, as far as indentation is
+ concerned (Bug#15369).
+
+2013-09-15 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--state-put-2): Don't process buffer state
+ when buffer doesn't exist any more (Bug#15382).
+
+2013-09-15 Glenn Morris <rgm@gnu.org>
+
+ * eshell/em-unix.el (eshell/rm):
+ Make -f ignore missing files. (Bug#15373)
+
+ * eshell/esh-cmd.el (eshell--local-vars): New variable. (Bug#15372)
+ (eshell-rewrite-for-command): Add for loop vars to eshell--local-vars.
+ * eshell/esh-var.el (eshell-get-variable): Respect eshell--local-vars.
+
+2013-09-14 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-var.el (eshell-variable-aliases-list): Fix doc typo.
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.el (dired-guess-shell-alist-user): Doc fix.
+ (dired-guess-default): Make `file' available in the env. (Bug#15363)
+
+2013-09-13 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.el (x-focus-frame): Mark as declared in frame.c.
+
+2013-09-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ls-lisp.el: Use advice-add.
+ (original-insert-directory): Remove.
+ (ls-lisp--insert-directory): Rename from insert-directory; add
+ `orig-fun' argument.
+ (insert-directory): Advise.
+
+2013-09-13 Eli Zaretskii <eliz@gnu.org>
+
+ * term.el (term-emulate-terminal): Decode the command string
+ before passing it to term-command-hook. (Bug#15337)
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * eshell/esh-util.el (ange-cache): Move declaration earlier.
+
+ * eshell/esh-ext.el (eshell-search-path): Declare.
+
+ * eshell/em-prompt.el (eshell/pwd): Autoload it.
+ Otherwise an error occurs if eshell-dirs module not loaded.
+
+ * progmodes/gdb-mi.el (gud-cont, gud-step): Declare.
+
+2013-09-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-check-proper-method-and-host): Rename it from
+ `tramp-check-proper-host'. Check for a valid method name.
+
+ * net/tramp-adb.el (tramp-adb-maybe-open-connection):
+ * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection): Call it.
+
+ * net/tramp-cache.el (tramp-cache-print): Don't print text properties
+ also for hash values.
+
+2013-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * term/ns-win.el (parameters): Don't declare as dynamic.
+ (before-make-frame-hook): Don't add ineffective function.
+
+ * eshell/*.el: Use lexical-binding (bug#15231).
+
+2013-09-12 Kenichi Handa <handa@gnu.org>
+
+ * composite.el (compose-gstring-for-graphic): Handle enclosing mark.
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-svn.el (vc-svn-dir-status-files, vc-svn-dir-extra-headers)
+ (vc-svn-ignore, vc-svn-retrieve-tag): Mark unused arguments.
+
+ * subr.el (do-after-load-evaluation): Also give compiler warnings
+ when obsolete files are used (except by obsolete files).
+
+ * vc/vc-svn.el (vc-svn-parse-status): If there are multiple files
+ in the status output, assume `filename' is the first. (Bug#15322)
+
+ * vc/vc.el (vc-deduce-fileset): Doc fix.
+
+ * calc/calc-help.el (Info-goto-node):
+ * progmodes/cperl-mode.el (Info-find-node):
+ * vc/ediff.el (Info-goto-node): Update declarations.
+
+ * vc/vc-dispatcher.el (vc-dir-refresh): Declare.
+
+ * vc/vc-bzr.el (vc-compilation-mode): Declare.
+ (vc-bzr-pull): Require vc-dispatcher.
+ * vc/vc-git.el (vc-compilation-mode): Declare.
+ (vc-git-pull): Require vc-dispatcher.
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Declare.
+
+ * progmodes/octave.el (help-button-action): Declare.
+
+ * shell.el (shell-directory-tracker): Output error as a message
+ rather than just returning it as a string.
+ (shell-process-pushd): Remove useless use of message.
+
+ * dframe.el (dframe-timer-fn):
+ * files.el (dir-locals-read-from-file):
+ * mpc.el (mpc--status-timer-run, mpc--status-idle-timer-run)
+ (mpc-format):
+ * reveal.el (reveal-post-command):
+ * saveplace.el (load-save-place-alist-from-file):
+ * shell.el (shell-resync-dirs):
+ * w32-common-fns.el (x-get-selection-value):
+ * emacs-lisp/copyright.el (copyright-find-copyright):
+ * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info):
+ * emulation/tpu-edt.el (tpu-copy-keyfile):
+ * play/bubbles.el (bubbles--mark-neighbourhood):
+ * progmodes/executable.el
+ (executable-make-buffer-file-executable-if-script-p):
+ * term/pc-win.el (x-get-selection-value): Use with-demoted-errors.
+
+2013-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Cleanup Eshell to rely less on dynamic scoping.
+ * eshell/esh-opt.el (eshell-eval-using-options): Don't bind usage-msg,
+ last-value, and ext-command here. Bind `args' closer to `body'.
+ (temp-args, last-value, usage-msg, ext-command, args): Don't defvar.
+ (eshell--args): Declare new dynamic var.
+ (eshell-do-opt): Add argument `args'. Bind our own usage-msg,
+ last-value, and ext-command. Pass `args' to `body'.
+ (eshell-process-args): Bind eshell--args.
+ (eshell-set-option): Use eshell--args.
+ * eshell/eshell.el (eshell): Use derived-mode-p.
+ * eshell/esh-var.el (eshell-parse-variable): Use backquote.
+ (eshell-parse-variable-ref): Remove unused vars `end' and `err'.
+ (eshell-glob-function): Declare.
+ * eshell/esh-util.el: Require cl-lib.
+ (eshell-read-hosts-file): Avoid add-to-list.
+ * eshell/esh-cmd.el (eshell-parse-lisp-argument): Remove unused var
+ `err'.
+ * eshell/em-unix.el (compilation-scroll-output, locate-history-list):
+ Declare.
+ (eshell/diff): Remove unused var `err'.
+ * eshell/em-rebind.el (eshell-delete-backward-char): Remove unused arg
+ `killflag'.
+ * eshell/em-pred.el (eshell-parse-modifiers): Remove unused var `err'.
+ * eshell/em-ls.el (eshell-ls-highlight-alist): Move defvars before
+ first use.
+ * eshell/em-glob.el (eshell-glob-matches, message-shown):
+ Move declaration before first use.
+ * eshell/em-alias.el (eshell-maybe-replace-by-alias): Use backquotes.
+ * autorevert.el (auto-revert-notify-handler): Use `cl-dolist' since we
+ rely on cl-return.
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * term/ns-win.el (global-map): Remove binding for ispell-next,
+ deleted 1999-05-29. (Bug#15357)
+
+2013-09-11 Glenn Morris <rgm@gnu.org>
+
+ * echistory.el (electric-command-history): Remove call to deleted func.
+
+ * play/landmark.el (landmark-mode): Fix typos.
+
+ * vc/vc-cvs.el (cvs-append-to-ignore): Fix arg spec.
+ Check cvs-sort-ignore-file is bound.
+
+ * savehist.el: No need for cl when compiling on Emacs.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/esh-mode.el (eshell-mode-syntax-table): Fix up initialization
+ (bug#15338).
+ (eshell-self-insert-command, eshell-send-invisible):
+ Remove unused argument.
+ (eshell-handle-control-codes): Remove unused var `orig'.
+ Avoid delete-backward-char.
+
+ * files.el (set-auto-mode): Simplify a bit further.
+
+2013-09-11 Glenn Morris <rgm@gnu.org>
+
+ * files.el (interpreter-mode-alist): Remove \\` \\' parts.
+ (set-auto-mode): Don't regexp-quote elements.
+ * progmodes/python.el (interpreter-mode-alist): Remove \\` \\'.
+ * progmodes/cc-mode.el (interpreter-mode-alist):
+ * progmodes/ruby-mode.el (interpreter-mode-alist):
+ Revert previous change.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * play/snake.el (snake-mode):
+ * play/mpuz.el (mpuz-mode):
+ * play/landmark.el (lm-mode):
+ * play/blackbox.el (blackbox-mode):
+ * play/5x5.el (5x5-mode):
+ * obsolete/options.el (Edit-options-mode):
+ * net/quickurl.el (quickurl-list-mode):
+ * net/newst-treeview.el (newsticker-treeview-mode):
+ * mail/rmailsum.el (rmail-summary-mode):
+ * mail/mspools.el (mspools-mode):
+ * locate.el (locate-mode):
+ * ibuffer.el (ibuffer-mode):
+ * emulation/ws-mode.el (wordstar-mode):
+ * emacs-lisp/debug.el (debugger-mode):
+ * array.el (array-mode):
+ * net/eudc.el (eudc-mode): Use define-derived-mode.
+ * net/mairix.el (mairix-searches-mode-font-lock-keywords):
+ Move initialization into declaration.
+ (mairix-searches-mode): Use define-derived-mode.
+ * net/eudc-hotlist.el (eudc-hotlist-mode): Use define-derived-mode.
+ (eudc-edit-hotlist): Use dolist.
+ * man.el (Man-mode-syntax-table): Rename from man-mode-syntax-table.
+ (Man-mode): Use define-derived-mode.
+ * info.el (Info-edit-mode-map): Rename from Info-edit-map.
+ (Info-edit-mode): Use define-derived-mode.
+ (Info-cease-edit): Use Info-mode.
+ * eshell/esh-mode.el (eshell-mode-syntax-table): Move initialization
+ into declaration.
+ (eshell-mode): Use define-derived-mode.
+ * chistory.el (command-history-mode-map): Rename from
+ command-history-map.
+ (command-history-mode): Use define-derived-mode.
+ (Command-history-setup): Remove function.
+ * calc/calc.el (calc-trail-mode-map): New var.
+ (calc-trail-mode): Use define-derived-mode.
+ (calc-trail-buffer): Set calc-main-buffer manually.
+ * bookmark.el (bookmark-insert-annotation): New function.
+ (bookmark-edit-annotation): Use it.
+ (bookmark-edit-annotation-mode): Make it a proper major mode.
+ (bookmark-send-edited-annotation): Use derived-mode-p.
+ * arc-mode.el (archive-mode): Move kill-all-local-variables a tiny bit
+ closer to its ideal place. Use \' to match EOS.
+
+ * profiler.el (profiler-calltree-find): Use function-equal.
+
+2013-09-10 Glenn Morris <rgm@gnu.org>
+
+ * files.el (interpreter-mode-alist): Convert to regexps.
+ (set-auto-mode): Adapt for this. (Bug#15306)
+ * progmodes/cperl-mode.el (cperl-clobber-mode-lists):
+ Comment out unused variable.
+ * progmodes/cc-mode.el (interpreter-mode-alist):
+ * progmodes/python.el (interpreter-mode-alist):
+ * progmodes/ruby-mode.el (interpreter-mode-alist): Convert to regexps.
+ * progmodes/sh-script.el (sh-set-shell):
+ No longer use interpreter-mode-alist to get list of shells.
+
+ * progmodes/cc-mode.el (awk-mode): Remove duplicate autoload.
+
+2013-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el: Use set-temporary-overlay-map for universal-argument.
+ (universal-argument-map): Don't use default-bindings (bug#15317).
+ Bind switch-frame explicitly. Replace universal-argument-minus with
+ a conditional binding.
+ (universal-argument-num-events, saved-overriding-map): Remove.
+ (restore-overriding-map): Remove.
+ (universal-argument--mode): Rename from save&set-overriding-map,
+ and rewrite.
+ (universal-argument, universal-argument-more, negative-argument)
+ (digit-argument): Adjust accordingly.
+ (universal-argument-minus): Remove.
+ (universal-argument-other-key): Remove.
+
+ * subr.el (with-demoted-errors): Add `format' argument.
+
+2013-09-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-cleanup): Remove. Functionality added to
+ `tramp-cleanup-connection'.
+
+ * net/tramp-cmds.el (tramp-cleanup-connection): Add optional
+ parameters KEEP-DEBUG and KEEP-PASSWORD.
+
+ * net/tramp.el (tramp-file-name-handler):
+ * net/tramp-adb.el (tramp-adb-maybe-open-connection):
+ * net/tramp-sh.el (tramp-open-connection-setup-interactive-shell)
+ (tramp-maybe-open-connection):
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection):
+ Use `tramp-cleanup-connection'.
+
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ Catch 'uname-changed inside the progress reporter.
+
+2013-09-10 Glenn Morris <rgm@gnu.org>
+
+ * simple.el (read-minibuffer): Unbreak it. (Bug#15318)
+
+ * dired-x.el (dired-mark-sexp): Unbreak for systems where ls
+ returns "alternate access method" in mode (eg "-rw-r--r--.").
+
+2013-09-08 Glenn Morris <rgm@gnu.org>
+
+ * saveplace.el (load-save-place-alist-from-file):
+ Demote errors. (Bug#15305)
+
+2013-09-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve compatibility with older Emacsen, and XEmacs.
+
+ * net/tramp.el (tramp-find-method, tramp-find-user): Call `propertize'
+ only if it is bound. It isn't for XEmacs.
+ (with-tramp-progress-reporter): Do not let-bind `result'.
+ This yields to scoping errors in XEmacs.
+ (tramp-handle-make-auto-save-file-name): New function, moved from
+ tramp-sh.el.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-adb--gnu-switches-to-ash):
+ Use `tramp-compat-replace-regexp-in-string'.
+
+ * net/tramp-cache.el (tramp-cache-print): Call
+ `substring-no-properties' only if it is bound. It isn't for XEmacs.
+
+ * net/tramp-cmds.el (tramp-bug): Call `propertize' only if it is
+ bound. It isn't for XEmacs.
+
+ * net/tramp-compat.el (tramp-compat-copy-file):
+ Catch `wrong-number-of-arguments' error.
+ (tramp-compat-replace-regexp-in-string): New defun.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-gvfs-handle-copy-file): Use `tramp-compat-funcall' for
+ `copy-file'.
+ (tramp-gvfs-file-gvfs-monitor-file-process-filter)
+ (tramp-gvfs-file-name): Use `tramp-compat-replace-regexp-in-string'.
+ (tramp-synce-list-devices): Use `push' instead of `pushnew'.
+
+ * net/tramp-gw.el (tramp-gw-open-network-stream):
+ Use `tramp-compat-replace-regexp-in-string'.
+
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+ Call `tramp-handle-make-auto-save-file-name'.
+ (tramp-sh-handle-make-auto-save-file-name): Move to tramp.el.
+ (tramp-sh-file-gvfs-monitor-dir-process-filter)
+ (tramp-sh-file-inotifywait-process-filter):
+ Use `tramp-compat-replace-regexp-in-string'.
+ (tramp-compute-multi-hops): Use `push' instead of `pushnew'.
+
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Add handler
+ for `make-auto-save-file-name'.
+ (tramp-smb-handle-copy-directory):
+ Call `tramp-compat-replace-regexp-in-string'.
+ (tramp-smb-get-file-entries): Use `push' instead of `pushnew'.
+ (tramp-smb-handle-copy-file): Improve error message.
+ (tramp-smb-handle-rename-file): Rename directly only in case
+ `newname' does not exist yet. This is a restriction of smbclient.
+ (tramp-smb-maybe-open-connection): Rerun the function only when
+ `auth-sources' is non-nil.
+
+2013-09-08 Kenichi Handa <handa@gnu.org>
+
+ * international/characters.el: Set category "^" (Combining) for
+ more characters.
+
+2013-09-07 Alan Mackenzie <acm@muc.de>
+
+ Correctly fontify Java class constructors.
+ * progmodes/cc-langs.el (c-type-decl-suffix-key): Now matches ")"
+ in Java Mode.
+ (c-recognize-typeless-decls): Set the Java value to t.
+ * progmodes/cc-engine.el (c-forward-decl-or-cast-1):
+ While handling a "(", add a check for, effectively, Java, and handle a
+ "typeless" declaration there.
+
+2013-09-07 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-biblatex-entry-alist): Add optional
+ field subtitle for entry type book.
+
+2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el: Make minibuffer-complete call completion-in-region
+ rather than other way around.
+ (completion--some, completion-pcm--find-all-completions):
+ Don't delay signals when debugging.
+ (minibuffer-completion-contents): Beware fields within the
+ minibuffer contents.
+ (completion-all-sorted-completions): Use defvar-local.
+ (completion--do-completion, completion--cache-all-sorted-completions)
+ (completion-all-sorted-completions, minibuffer-force-complete):
+ Add args `beg' and `end'.
+ (completion--in-region-1): New fun, extracted from minibuffer-complete.
+ (minibuffer-complete): Use completion-in-region.
+ (completion-complete-and-exit): New fun, extracted from
+ minibuffer-complete-and-exit.
+ (minibuffer-complete-and-exit): Use it.
+ (completion--complete-and-exit): Rename from
+ minibuffer--complete-and-exit.
+ (completion-in-region--single-word): New function, extracted from
+ minibuffer-complete-word.
+ (minibuffer-complete-word): Use it.
+ (display-completion-list): Make `common-substring' argument obsolete.
+ (completion--in-region): Call completion--in-region-1 instead of
+ minibuffer-complete.
+ (completion-help-at-point): Pass boundaries to
+ minibuffer-completion-help as args rather than via an overlay.
+ (completion-pcm--string->pattern): Use `any-delim'.
+ (completion-pcm--optimize-pattern): New function.
+ (completion-pcm--pattern->regex): Handle `any-delim'.
+ * icomplete.el (icomplete-forward-completions)
+ (icomplete-backward-completions, icomplete-completions):
+ Adjust calls to completion-all-sorted-completions and
+ completion--cache-all-sorted-completions.
+ (icomplete-with-completion-tables): Default to t.
+ * emacs-lisp/crm.el (crm--current-element): Rename from
+ crm--select-current-element. Don't put an overlay but return the
+ boundaries instead.
+ (crm--completion-command): Take two new args to bind to the boundaries.
+ (crm-completion-help): Adjust accordingly.
+ (crm-complete): Use completion-in-region.
+ (crm-complete-word): Use completion-in-region--single-word.
+ (crm-complete-and-exit): Use completion-complete-and-exit.
+
+2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * dired-x.el (dired-mark-sexp): Bind the vars lexically rather
+ than dynamically.
+
+2013-09-06 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-display-images-node): When image file doesn't exist
+ display text version of the image if it's provided in the Info file.
+ Otherwise, display the location of missing image from SRC attribute.
+ Add help-echo text property from ALT attribute. (Bug#15279)
+
+2013-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * abbrev.el (edit-abbrevs-mode-map): Rename from edit-abbrevs-map.
+ (edit-abbrevs-mode): Use define-derived-mode.
+
+ * epa.el (epa--encode-coding-string, epa--decode-coding-string)
+ (epa--select-safe-coding-system, epa--derived-mode-p): Make it obvious
+ that it's defined.
+ (epa-key-list-mode, epa-key-mode, epa-info-mode):
+ Use define-derived-mode.
+
+ * epg.el (epg-start-encrypt): Minor CSE simplification.
+
+2013-09-06 William Xu <william.xwl@gmail.com>
+
+ * arc-mode.el: Add support for 7za (bug#15264).
+ (archive-7z-program): New var.
+ (archive-zip-extract, archive-zip-expunge, archive-zip-update)
+ (archive-zip-update-case, archive-7z-extract, archive-7z-expunge)
+ (archive-7z-update, archive-zip-extract, archive-7z-summarize): Use it.
+
+2013-09-06 Michael Albinus <michael.albinus@gmx.de>
+
+ Remove URL syntax.
+
+ * net/tramp.el (tramp-syntax, tramp-prefix-format)
+ (tramp-postfix-method-format, tramp-prefix-ipv6-format)
+ (tramp-postfix-ipv6-format, tramp-prefix-port-format)
+ (tramp-postfix-host-format, tramp-file-name-regexp)
+ (tramp-completion-file-name-regexp)
+ (tramp-completion-dissect-file-name)
+ (tramp-handle-substitute-in-file-name): Remove 'url case.
+ (tramp-file-name-regexp-url)
+ (tramp-completion-file-name-regexp-url): Remove constants.
+
+2013-09-06 Glenn Morris <rgm@gnu.org>
+
+ * replace.el (replace-string): Doc fix re start/end. (Bug#15275)
+
+2013-09-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move "Perl-ish
+ keywords" below "here-doc beginnings" (Bug#15270).
+
+2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (pop): Use `car-safe'.
+ * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove hack
+ to detect unused `pop' return value.
+
+ * progmodes/python.el (python-nav-beginning-of-block): Remove unused
+ var `block-regexp'.
+ (python-nav--forward-sexp): Remove unused var `re-search-fn'.
+ (python-fill-string): Remove unused var `marker'.
+ (python-skeleton-add-menu-items): Remove unused var `items'.
+
+ * international/mule-cmds.el: Require CL.
+ (find-coding-systems-for-charsets): Avoid add-to-list.
+ (sanitize-coding-system-list): New function, extracted from
+ select-safe-coding-system-interactively.
+ (select-safe-coding-system-interactively): Use it.
+ (read-input-method-name): Accept symbols for `default'.
+
+ * emacs-lisp/advice.el (defadvice): Add indent rule.
+
+2013-09-05 Daniel Hackney <dan@haxney.org>
+
+ * dired-x.el:
+ * net/ange-ftp.el:
+ * net/browse-url.el:
+ * net/dbus.el:
+ * net/eudc.el:
+ * net/eudcb-ldap.el:
+ * net/eww.el:
+ * net/imap.el:
+ * printing.el:
+ * vc/ediff-diff.el:
+ * vc/ediff-init.el:
+ * vc/ediff-merg.el:
+ * vc/ediff-mult.el:
+ * vc/ediff-util.el:
+ * vc/ediff-wind.el:
+ * vc/ediff.el:
+ * vc/emerge.el:
+ * vc/pcvs.el:
+ * vc/vc-annotate.el: Prefix unused arguments with `_' to silence
+ byte compiler. Remove some unused let-bound variables.
+
+2013-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cconv.el: Use `car-safe' rather than `car' to access
+ a "ref-cell", since it gets better optimized (bug#14883).
+
+2013-09-05 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/cc-awk.el (c-forward-sws): Declare.
+
+2013-09-04 Glenn Morris <rgm@gnu.org>
+
+ * generic-x.el [rul-generic-mode]: Require cc-mode.
+ (c++-mode-syntax-table): Declare.
+ (rul-generic-mode-syntax-table): Init in the defvar.
+
+2013-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-dispatcher.el (vc-run-delayed): New macro.
+ (vc-do-command, vc-set-async-update):
+ * vc/vc-mtn.el (vc-mtn-dir-status):
+ * vc/vc-hg.el (vc-hg-dir-status, vc-hg-dir-status-files)
+ (vc-hg-pull, vc-hg-merge-branch):
+ * vc/vc-git.el (vc-git-dir-status-goto-stage, vc-git-pull)
+ (vc-git-merge-branch):
+ * vc/vc-cvs.el (vc-cvs-print-log, vc-cvs-dir-status)
+ (vc-cvs-dir-status-files):
+ * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch, vc-bzr-dir-status)
+ (vc-bzr-dir-status-files):
+ * vc/vc-arch.el (vc-arch-dir-status): Use vc-run-delayed.
+ * vc/vc-annotate.el: Use lexical-binding.
+ (vc-annotate-display-select, vc-annotate): Use vc-run-delayed.
+ (vc-sentinel-movepoint): Declare.
+ (vc-annotate): Don't use `goto-line'.
+ * vc/vc.el (vc-diff-internal): Prefer a closure to `(lambda...).
+ (vc-diff-internal, vc-log-internal-common): Use vc-run-delayed.
+ (vc-sentinel-movepoint): Declare.
+ * vc/vc-svn.el: Use lexical-binding.
+ (vc-svn-dir-status, vc-svn-dir-status-files): Use vc-run-delayed.
+ * vc/vc-sccs.el:
+ * vc/vc-rcs.el: Use lexical-binding.
+
+ * autorevert.el (auto-revert-notify-handler): Explicitly ignore
+ `deleted'. Don't drop errors silently.
+
+ * emacs-lisp/gv.el (gv-get): Warn about CL-compiled places.
+
+2013-09-04 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc.el (vc-ignore): Rewrite.
+ (vc-default-ignore): New function.
+ (vc-default-ignore-completion-table): Use find-ignore-file.
+
+ * vc/vc-bzr.el (vc-bzr-ignore, vc-bzr-ignore-completion-table):
+ * vc/vc-git.el (vc-git-ignore, vc-git-ignore-completion-table):
+ * vc/vc-hg.el (vc-hg-ignore, vc-hg-ignore-completion-table):
+ Remove. Most code moved to vc.el.
+
+2013-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * net/tramp-gvfs.el (tramp-gvfs-mount-spec, tramp-synce-list-devices):
+ * net/tramp-smb.el (tramp-smb-get-file-entries):
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory)
+ (tramp-compute-multi-hops): Fix misuses of `add-to-list'.
+
+ * net/eww.el (eww-display-raw): Remove unused argument `charset'.
+ Update call to it.
+ (eww-change-select): Remove unused var `properties'.
+ (eww-make-unique-file-name): Remove unused var `base'.
+
+ * finder.el (finder-compile-keywords): Don't mess with windows.
+
+ * calculator.el (calculator-funcall): Fix typo in last change.
+
+ * vc/vc-git.el (vc-git-checkin): Make it possible to commit a merge.
+
+ * emacs-lisp/package.el (package-activate-1): Don't let a missing
+ <pkg>-autoloads.el file stop us.
+
+ * net/tramp.el (with-parsed-tramp-file-name): Silence compiler
+ warnings, and factor out common code.
+
+2013-09-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-calculate-indent): Consider
+ two-character operators and whether the character preceding them
+ changes their meaning (Bug#15208).
+
+2013-09-02 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ Format code sent to Python shell for robustness.
+ * progmodes/python.el (python-shell-buffer-substring):
+ New function.
+ (python-shell-send-region, python-shell-send-buffer): Use it.
+
+2013-09-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-compat.el (tramp-compat-user-error): Move it ...
+ * net/tramp.el (tramp-user-error): ... here.
+ (tramp-find-method, tramp-check-proper-host)
+ (tramp-dissect-file-name, tramp-debug-message)
+ (tramp-handle-shell-command):
+ * net/tramp-adb.el (tramp-adb-handle-shell-command):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler): Adapt callees.
+
+ * net/tramp-cache.el (tramp-cache-print): Don't print text properties.
+
+2013-09-02 Martin Rudalics <rudalics@gmx.at>
+
+ * avoid.el (mouse-avoidance-point-position)
+ (mouse-avoidance-too-close-p): Handle case where posn-at-point
+ returns nil.
+
+2013-09-02 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-shell-completion-get-completions):
+ Drop use of deleted `comint-last-prompt-overlay'.
+ (python-nav-if-name-main): New command.
+
+2013-09-01 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (setwins, setwins_almost, setwins_for_subdirs):
+ Avoid leading space in $wins. Otherwise the sed command used by
+ eg compile-main ends up containing "/*.el". (Bug#15170)
+
+ * frame.el (frame-background-mode): Doc fix. (Bug#15226)
+
+2013-08-30 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-recompile-directory):
+ Fix is-this-a-directory logic. (Bug#15220)
+
+2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/css-mode.el: Use SMIE.
+ (css-smie-grammar): New var.
+ (css-smie--forward-token, css-smie--backward-token)
+ (css-smie-rules): New functions.
+ (css-mode): Use them.
+ (css-navigation-syntax-table): Remove var.
+ (css-backward-sexp, css-forward-sexp, css-indent-calculate-virtual)
+ (css-indent-calculate, css-indent-line): Remove functions.
+
+ Misc changes to reduce use of `(lambda...); and other cleanups.
+ * cus-edit.el: Use lexical-binding.
+ (customize-push-and-save, customize-apropos)
+ (custom-buffer-create-internal): Use closures.
+ * progmodes/bat-mode.el (bat-mode-syntax-table): "..." are strings.
+ * progmodes/ada-xref.el: Use setq.
+ * net/tramp.el (with-tramp-progress-reporter): Avoid setq.
+ * dframe.el: Use lexical-binding.
+ (dframe-frame-mode): Fix calling convention for hooks. Use a closure.
+ * speedbar.el (speedbar-frame-mode): Adjust call accordingly.
+ * descr-text.el: Use lexical-binding.
+ (describe-text-widget, describe-text-sexp, describe-property-list):
+ Use closures.
+ * comint.el (comint-history-isearch-push-state): Use a closure.
+ * calculator.el: Use lexical-binding.
+ (calculator-number-to-string): Make it work with lexical-binding.
+ (calculator-funcall): Same and use cl-letf.
+
+ * emacs-lisp/lisp.el (lisp--company-doc-buffer)
+ (lisp--company-doc-string, lisp--company-location): New functions.
+ (lisp-completion-at-point): Use them to improve Company support.
+
+ * progmodes/ruby-mode.el (ruby-smie-grammar): Add rule for formal
+ params of lambda expressions.
+ (ruby-smie--implicit-semi-p): Refine rule (bug#15208).
+ (ruby-smie--opening-pipe-p): New function.
+ (ruby-smie--forward-token, ruby-smie--backward-token): Handle Ruby
+ symbols and matched |...| for formal params.
+ (ruby-smie-rules): Don't let the formal params of a "do" prevent it
+ from being treated as hanging. Handle "rescue".
+
+2013-08-29 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/cc-engine.el (c-pull-open-brace):
+ Move definition before use.
+
+2013-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-macs.el (cl-defsubst): Make it clear that args
+ are immutable. Don't use `unsafe' any more.
+ (cl--defsubst-expand): Don't substitute at the same time as keeping
+ a residual unused let-binding. Don't use `unsafe' any more.
+
+2013-08-29 Glenn Morris <rgm@gnu.org>
+
+ * calendar/cal-china.el (calendar-chinese-year-cache):
+ Recenter on 2015.
+
+ * nxml/nxml-util.el (nxml-debug-clear-inside):
+ Use cl-loop rather than loop.
+
+ * net/eww.el (eww-mode-map): Lower-case menu bar entries look bad.
+
+ * progmodes/sh-script.el (sh-builtins) <bash>: Add some bash4-isms.
+
+2013-08-28 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/antlr-mode.el: No need to require cc-mode twice.
+
+ * progmodes/cc-bytecomp.el (cc-require): Handle uncompiled case.
+
+ * progmodes/cc-mode.el (c-define-abbrev-table): Handle NAME unbound.
+
+2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (repeat-complex-command--called-interactively-skip):
+ New function.
+ (repeat-complex-command): Use it (bug#14136).
+
+ * progmodes/cc-mode.el: Minor cleanup of var declarations.
+ (c-define-abbrev-table): Add `doc' argument.
+ (c-mode-abbrev-table, c++-mode-abbrev-table)
+ (objc-mode-abbrev-table, java-mode-abbrev-table)
+ (idl-mode-abbrev-table, pike-mode-abbrev-table)
+ (awk-mode-abbrev-table): Use it.
+ (c-mode-syntax-table, c-mode-map, c++-mode-syntax-table)
+ (c++-mode-map, objc-mode-syntax-table, objc-mode-map)
+ (java-mode-syntax-table, java-mode-map, idl-mode-syntax-table)
+ (idl-mode-map, pike-mode-syntax-table, pike-mode-map, awk-mode-map):
+ Move initialization into the declaration; and remove any
+ autoload cookie.
+
+ * epg.el (epg--process-filter): Use with-current-buffer, save-excursion
+ and dynamic let binding.
+
+ * vc/smerge-mode.el: Remove redundant :group args.
+
+ * emacs-lisp/package.el (package-activate-1): Don't add unnecessarily
+ to load-path.
+
+2013-08-28 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-reread-key-sequence-naturally): Use non-nil
+ arg DONT-DOWNCASE-LAST of `read-key-sequence'.
+ (isearch-other-meta-char): Handle an undefined shifted printing
+ character by downshifting it. (Bug#15200)
+
+2013-08-28 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-search): Change regexp error message for
+ non-regexp searches. (Bug#15166)
+
+2013-08-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (SHELL): Now @SHELL@, not /bin/sh,
+ for portability to hosts where /bin/sh has problems.
+
+2013-08-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cconv.el (cconv--analyse-function): Improve warning.
+
+2013-08-27 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-other-meta-char): Don't store kmacro commands
+ in the keyboard macro. (Bug#15126)
+
+2013-08-27 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-quote-char): Comment out converting unibyte
+ to multibyte, thus syncing with its `quoted-insert' counterpart.
+ (Bug#15166)
+
+2013-08-27 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-use-some-window): Add missing
+ argument in call of get-largest-window (Bug#15185).
+ Reported by Stephen Leake.
+
+2013-08-27 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/package.el (package-buffer-info): Fix message typo.
+
+2013-08-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-font-lock-keywords): Don't return nil
+ from a matcher-function unless there's no more matches (bug#15161).
+
+2013-08-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el: Revert change from 2013-08-20.
+
+ * net/tramp.el (tramp-find-method, tramp-find-user): Mark result
+ with text property `tramp-default', if appropriate.
+ (tramp-check-proper-host): New defun.
+ (tramp-dissect-file-name): Do not check hostname. Revert change
+ of 2013-03-18.
+ (tramp-backtrace): Make VEC-OR-PROC optional.
+
+ * net/tramp-adb.el (tramp-adb-maybe-open-connection):
+ * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ * net/tramp-smb.el (tramp-smb-maybe-open-connection):
+ Apply `tramp-check-proper-host'.
+
+2013-08-26 Tassilo Horn <tsdh@gnu.org>
+
+ * epa-hook.el (epa-file-encrypt-to): Quote `safe-local-variable'
+ lambda expression in order to have `describe-variable' display it.
+
+2013-08-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-verify-visited-file-modtime):
+ BUF can be optional. (Bug#15186)
+
+2013-08-25 Xue Fuqiao <xfq.free@gmail.com>
+
+ * progmodes/flymake.el (flymake-get-real-file-name-function):
+ Fix broken customization. (Bug#15184)
+
+2013-08-25 Alan Mackenzie <acm@muc.de>
+
+ Improve indentation of bracelists defined by macros (without "=").
+
+ * progmodes/cc-engine.el (c-inside-bracelist-p): When a macro
+ expansion begins with "{", regard it as bracelist when it doesn't
+ contain a ";".
+
+ Parse C++ inher-intro when there's a template split over 2 lines.
+
+ * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5C): Code more
+ rigorously the search for "class" etc. followed by ":".
+
+ * progmodes/cc-langs.el (c-opt-<>-sexp-key): Make the value for
+ random languages a regexp which never matches rather than nil.
+
+ Handle "/"s more accurately in test for virtual semicolons (AWK Mode).
+
+ * progmodes/cc-awk.el (c-awk-one-line-possibly-open-string-re)
+ (c-awk-regexp-one-line-possibly-open-char-list-re)
+ (c-awk-one-line-possibly-open-regexp-re)
+ (c-awk-one-line-non-syn-ws*-re): Remove.
+ (c-awk-possibly-open-string-re, c-awk-non-/-syn-ws*-re)
+ (c-awk-space*-/-re, c-awk-space*-regexp-/-re)
+ (c-awk-space*-unclosed-regexp-/-re): New constants.
+ (c-awk-at-vsemi-p): Reformulate better to recognize "/"s which
+ aren't regexp delimiters.
+
+ * progmodes/cc-engine.el (c-crosses-statement-barrier-p): Add in
+ handling for a rare situation in AWK Mode involving unterminated
+ strings/regexps.
+
+2013-08-23 Glenn Morris <rgm@gnu.org>
+
+ * files.el (auto-mode-alist): Use sh-mode for .bash_history.
+
+ * files.el (interpreter-mode-alist): Use tcl-mode for expect scripts.
+
+ * files.el (create-file-buffer): If the result would begin with
+ spaces, prepend a "|" instead of removing them. (Bug#15162)
+
+2013-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * textmodes/fill.el (fill-match-adaptive-prefix): Don't throw away
+ text-properties (bug#15155).
+
+ * calc/calc-keypd.el (calc-keypad-execute): `x-flush-mouse-queue' doesn't
+ exist any more.
+ (calc-keypad-redraw): Remove unused var `pad'.
+ (calc-keypad-press): Remove unused var `menu'.
+
+2013-08-23 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer-pop-up-frame):
+ Call pop-up-frame-function with BUFFER current so `make-frame' will
+ use it as the new frame's buffer (Bug#15133).
+
+2013-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * calendar/timeclock.el: Minor cleanups.
+ (timeclock-ask-before-exiting, timeclock-use-display-time):
+ Use `symbol'.
+ (timeclock-modeline-display): Define as alias before the
+ actual definition.
+ (timeclock-mode-line-display): Use define-minor-mode.
+ (timeclock-day-list-template): Make it a function, add an argument.
+ (timeclock-day-list-required, timeclock-day-list-length)
+ (timeclock-day-list-debt, timeclock-day-list-span)
+ (timeclock-day-list-break): Adjust calls accordingly.
+
+2013-08-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pp.el (pp-eval-expression, pp-macroexpand-expression):
+ Use read--expression so that completion works again.
+
+2013-08-21 Sam Steingold <sds@gnu.org>
+
+ Add rudimentary inferior shell interaction
+ * progmodes/sh-script.el (sh-shell-process): New buffer-local variable.
+ (sh-set-shell): Reset it.
+ (sh-show-shell, sh-cd-here, sh-send-line-or-region-and-step):
+ New commands (bound to C-c C-z, C-c C-d, and C-c C-n).
+
+2013-08-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * align.el: Use lexical-binding.
+ (align-region): Simplify accordingly.
+
+2013-08-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * minibuffer.el (completion--sifn-requote): Bind `non-essential'.
+
+ * rfn-eshadow.el (rfn-eshadow-update-overlay): Move binding of
+ `non-essential' up.
+
+2013-08-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el:
+ * net/tramp-adb.el:
+ * net/tramp-cmds.el:
+ * net/tramp-ftp.el:
+ * net/tramp-gvfs.el:
+ * net/tramp-gw.el:
+ * net/tramp-sh.el: Don't wrap external variable declarations by
+ `eval-when-compile'.
+
+2013-08-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-rescale-image): Use ImageMagick even for GIFs
+ now that Emacs supports ImageMagick animations.
+
+2013-08-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-cmds.el (top): Don't declare `buffer-name'.
+ (tramp-append-tramp-buffers): Rewrite buffer local variables part.
+
+2013-08-16 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (mouse-autoselect-window-select): Do autoselect when
+ mouse pointer is on margin.
+
+2013-08-16 William Parsons <wbparsons@alum.mit.edu> (tiny change)
+
+ * net/ange-ftp.el (ange-ftp-skip-msgs): Add 500 EPSV. (Bug#1972)
+
+2013-08-16 Glenn Morris <rgm@gnu.org>
+
+ * net/ange-ftp.el (ange-ftp-good-msgs, ange-ftp-get-pwd):
+ Handle "Remote Directory" response of some clients. (Bug#15058)
+
+ * emacs-lisp/bytecomp.el (byte-compile-make-variable-buffer-local):
+ Tweak warning. (Bug#14926)
+
+ * menu-bar.el (send-mail-item-name, read-mail-item-name): Remove.
+ (menu-bar-tools-menu): Simplify news and mail items. (Bug#15095)
+
+ * image-mode.el (image-mode-map): Add menu items to reverse,
+ increase, decrease, reset animation speed.
+ (image--set-speed, image-increase-speed, image-decrease-speed)
+ (image-reverse-speed, image-reset-speed): New functions.
+ (image-mode-map): Add bindings for speed commands.
+
+ * image.el (image-animate-get-speed, image-animate-set-speed):
+ New functions.
+ (image-animate-timeout): Respect image :speed property.
+
+2013-08-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/debug.el (debugger-setup-buffer): Put point on the
+ previous line (bug#15101).
+ (debugger-eval-expression, debugger-record-expression):
+ Use read--expression (bug#15102).
+
+2013-08-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Remove byte compiler warnings, visible when compiling with
+ `byte-compile-force-lexical-warnings' set to t.
+
+ * net/tramp.el (tramp-debug-message, tramp-message, tramp-error)
+ (tramp-error-with-buffer): Rename ARGS to ARGUMENTS and BUFFER to BUF.
+ (tramp-handle-unhandled-file-name-directory)
+ (tramp-handle-file-notify-add-watch, tramp-action-login)
+ (tramp-action-succeed, tramp-action-permission-denied)
+ (tramp-action-terminal, tramp-action-process-alive): Prefix unused
+ arguments with "_".
+
+ * net/tramp-adb.el (tramp-adb-parse-device-names)
+ (tramp-adb-handle-insert-directory, tramp-adb-handle-delete-file)
+ (tramp-adb-handle-copy-file): Prefix unused arguments with "_".
+ (tramp-adb-handle-file-truename): Remove unused arguments.
+
+ * net/tramp-cache.el (tramp-flush-directory-property)
+ (tramp-flush-connection-property, tramp-list-connections)
+ (tramp-parse-connection-properties): Prefix unused arguments with "_".
+
+ * net/tramp-compat.el (tramp-compat-make-temp-file):
+ Rename FILENAME to F.
+
+ * net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch)
+ (tramp-gvfs-handle-write-region, tramp-bluez-parse-device-names)
+ (tramp-zeroconf-parse-workstation-device-names)
+ (tramp-zeroconf-parse-webdav-device-names)
+ (tramp-synce-parse-device-names): Prefix unused arguments with "_".
+
+ * net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
+ (tramp-gw-aux-proc-sentinel): Prefix unused arguments with "_".
+
+ * net/tramp-sh.el (tramp-sh-handle-file-truename): Remove unused
+ arguments.
+ (tramp-sh-handle-copy-file, tramp-sh-handle-dired-compress-file)
+ (tramp-sh-handle-insert-file-contents-literally)
+ (tramp-sh-handle-file-notify-add-watch): Prefix unused arguments
+ with "_".
+ (tramp-do-copy-or-rename-file, tramp-barf-if-no-shell-prompt):
+ Remove unused variables.
+
+ * net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-copy-file, tramp-smb-handle-delete-file)
+ (tramp-smb-read-file-entry): Prefix unused arguments with "_".
+
+ * net/tramp-uu.el (tramp-uu-b64-alphabet, tramp-uu-b64-char-to-byte):
+ Make them a defconst.
+ (tramp-uuencode-region): Remove unused variable.
+
+2013-08-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--prop-setter): New function.
+ (frameset-prop): Add gv-setter declaration.
+ (frameset-filter-minibuffer): Deal with the case that the minibuffer
+ parameter was already set in FILTERED. Doc fix.
+ (frameset--record-minibuffer-relationships): Allow saving a
+ minibufferless frame without its corresponding minibuffer frame.
+ (frameset--reuse-frame): Accept a match from an orphaned minibufferless
+ frame, if the frame id matches.
+ (frameset--minibufferless-last-p): Sort non-orphaned minibufferless
+ frames before orphaned ones.
+ (frameset-restore): Warn about orphaned windows, instead of error out.
+
+2013-08-14 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-make-atom): Don't overwrite parameter
+ already present.
+ (display-buffer-in-atom-window): Handle special case where we
+ split an already atomic window.
+ (window--major-non-side-window, display-buffer-in-side-window)
+ (window--side-check): Ignore minibuffer window when walking
+ window tree.
+ (window-deletable-p): Return 'frame only if no other frame uses
+ our minibuffer window.
+ (record-window-buffer): Run buffer-list-update-hook.
+ (split-window): Make sure window--check-frame won't destroy an
+ existing atomic window in case the new window gets nested
+ inside.
+ (display-buffer-at-bottom): Ignore minibuffer window when
+ walking window tree. Don't split a side window.
+ (pop-to-buffer): Don't set-buffer here, the select-window call
+ should do that.
+ (mouse-autoselect-window-select): Autoselect only if we are in the
+ text portion of the window.
+
+2013-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-parse-image-data): New function to grab both the
+ data itself and the Content-Type.
+ (shr-put-image): Use it.
+
+ * net/eww.el (eww-display-image): Ditto.
+
+ * image.el (image-content-type-suffixes): New variable.
+
+2013-08-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-imenu--build-tree)
+ (python-imenu--put-parent): Simplify and Fix (GH bug 146).
+
+2013-08-13 Xue Fuqiao <xfq.free@gmail.com>
+
+ * simple.el (backward-word): Mention the optional argument.
+
+2013-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * frameset.el (frameset--make): Rename constructor from make-frameset.
+ (frameset-p, frameset-valid-p): Don't autoload.
+ (frameset-valid-p): Use normal accessors.
+
+2013-08-13 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/compile.el (compile-command): Tweak example in doc.
+ * obsolete/scribe.el (scribe-mode):
+ * progmodes/mixal-mode.el (mixal-mode): Quote buffer name. (Bug#15053)
+
+ * mail/feedmail.el (feedmail-confirm-outgoing)
+ (feedmail-display-full-frame, feedmail-deduce-bcc-where): Fix types.
+
+ * cus-start.el (truncate-partial-width-windows): Fix type.
+
+ * emulation/viper-init.el (viper-search-scroll-threshold): Fix type.
+
+ * net/shr.el (shr-table-horizontal-line): Fix custom type.
+
+2013-08-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/timer.el (timer--time-setter): New function.
+ (timer--time): Use it as gv-setter.
+
+ * emacs-lisp/gv.el (gv-define-simple-setter): Output warning when
+ setter is not a symbol.
+
+2013-08-12 Grégoire Jadi <daimrod@gmail.com>
+
+ * mail/sendmail.el (sendmail-send-it): Don't kill the error buffer
+ if sending fails. This makes debugging easier.
+
+2013-08-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * xml.el (xml-parse-tag-1): Use looking-at (this reverts change in
+ 2013-08-11T00:07:48Z!lekktu@gmail.com, which breaks the test suite).
+ https://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00263.html
+
+2013-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ * term/w32-win.el (dynamic-library-alist): Add DLLs for zlib.
+
+2013-08-12 Glenn Morris <rgm@gnu.org>
+
+ * format.el (format-annotate-function):
+ Handle read-only text properties in the source. (Bug#14887)
+
+2013-08-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-display-html): Ignore coding system errors.
+ One web site uses "utf-8lias" as the coding system.
+
+2013-08-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-valid-p): Fix check; STATES can indeed be nil.
+
+2013-08-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * tutorial.el (tutorial--describe-nonstandard-key): Use string-match-p.
+ (tutorial--detailed-help): Remove unused local variables.
+ (tutorial--save-tutorial-to): Use ignore-errors.
+ (help-with-tutorial): Use looking-at-p.
+
+ * view.el (view-buffer-other-window, view-buffer-other-frame):
+ Mark unused arguments.
+
+ * woman.el (woman-parse-colon-path, woman-parse-colon-path)
+ (woman-select-symbol-fonts, woman, woman-find-file)
+ (woman-insert-file-contents, woman-non-underline-faces):
+ Use string-match-p.
+ (woman1-unquote): Move declaration.
+
+ * xml.el (xml-parse-tag-1, xml-parse-string): Use looking-at-p.
+ (xml-parse-dtd): Use looking-at-p, string-match-p. Mark unused
+ argument. Remove unused local variable.
+ (xml-parse-elem-type): Use string-match-p.
+ (xml-substitute-numeric-entities): Use ignore-errors.
+
+ * calculator.el (calculator): Mark unused argument.
+ (calculator-paste, calculator-quit, calculator-integer-p):
+ Use ignore-errors.
+ (calculator-string-to-number, calculator-decimal, calculator-exp)
+ (calculator-op-or-exp): Use string-match-p.
+
+ * dired.el (dired-buffer-more-recently-used-p): Declare.
+ (dired-insert-set-properties, dired-insert-old-subdirs):
+ Use ignore-errors.
+
+ * dired-aux.el (dired-compress): Use ignore-errors.
+ (dired-do-chxxx, dired-do-chmod, dired-trample-file-versions)
+ (dired-do-async-shell-command, dired-do-shell-command)
+ (dired-shell-stuff-it, dired-compress-file, dired-insert-subdir)
+ (dired-insert-subdir-validate): Use string-match-p.
+ (dired-map-dired-file-lines, dired-subdir-hidden-p): Use looking-at-p.
+ (dired-add-entry): Use string-match-p, looking-at-p.
+ (dired-insert-subdir-newpos): Remove unused local variable.
+
+ * filenotify.el (file-notify-callback): Remove unused local variable.
+
+ * filesets.el (filesets-error): Mark unused argument.
+ (filesets-which-command-p, filesets-filter-dir-names)
+ (filesets-directory-files, filesets-get-external-viewer)
+ (filesets-ingroup-get-data): Use string-match-p.
+
+ * find-file.el (ff-other-file-name, ff-other-file-name)
+ (ff-find-the-other-file, ff-cc-hh-converter):
+ Remove unused local variables.
+ (ff-get-file-name): Use string-match-p.
+ (ff-all-dirs-under): Use ignore-errors.
+
+ * follow.el (follow-comint-scroll-to-bottom): Mark unused argument.
+ (follow-select-if-visible): Remove unused local variable.
+
+ * forms.el (read-file-filter): Move declaration.
+ (forms--make-format, forms--make-parser, forms-insert-record):
+ Quote function with #'.
+ (forms--update): Use string-match-p. Quote function with #'.
+
+ * help-mode.el (help-dir-local-var-def): Mark unused argument.
+ (help-make-xrefs): Use looking-at-p.
+ (help-xref-on-pp): Use looking-at-p, ignore-errors.
+
+ * ibuffer.el (ibuffer-ext-visible-p): Declare.
+ (ibuffer-confirm-operation-on): Use string-match-p.
+
+ * msb.el (msb-item-handler, msb-dired-item-handler):
+ Mark unused arguments.
+
+ * ses.el (ses-decode-cell-symbol)
+ (ses-kill-override): Remove unused local variable.
+ (ses-create-cell-variable, ses-relocate-formula): Use string-match-p.
+ (ses-load): Use ignore-errors, looking-at-p.
+ (ses-jump-safe): Use ignore-errors.
+ (ses-export-tsv, ses-export-tsf, ses-unsafe): Mark unused arguments.
+
+ * tabify.el (untabify, tabify): Mark unused arguments.
+
+ * thingatpt.el (thing-at-point--bounds-of-well-formed-url):
+ Mark unused argument.
+ (bounds-of-thing-at-point, thing-at-point-bounds-of-list-at-point)
+ (thing-at-point-newsgroup-p, form-at-point): Use ignore-errors.
+
+ * emacs-lisp/timer.el (timer--time): Define setter with
+ gv-define-setter to avoid deprecation warning.
+
+ * completion.el: Remove stuff unused since revno:3176 (1993-05-27).
+ (*record-cmpl-statistics-p*): Remove (was commented out).
+ (cmpl-statistics-block): Remove (body was commented out).
+ All callers changed.
+ (add-completions-from-buffer, load-completions-from-file):
+ Remove unused variables.
+
+2013-08-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * filecache.el (file-cache-delete-file-list):
+ Print message only when told so.
+ (file-cache-files-matching): Use #' in mapconcat argument.
+
+ * ffap.el (ffap-url-at-point): Fix reference to variable
+ thing-at-point-default-mail-uri-scheme.
+
+2013-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (define-error): New function.
+ * progmodes/ada-xref.el (ada-error-file-not-found): Rename from
+ error-file-not-found and define with define-error.
+ * emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
+ and define with define-error.
+ * userlock.el (file-locked, file-supersession):
+ * simple.el (mark-inactive):
+ * progmodes/js.el (js-moz-bad-rpc, js-js-error):
+ * progmodes/ada-mode.el (ada-mode-errors):
+ * play/life.el (life-extinct):
+ * nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
+ * nxml/xmltok.el (xmltok-markup-declaration-parse-error):
+ * nxml/rng-util.el (rng-error):
+ * nxml/rng-uri.el (rng-uri-error):
+ * nxml/rng-match.el (rng-compile-error):
+ * nxml/rng-cmpct.el (rng-c-incorrect-schema):
+ * nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
+ * nxml/nxml-rap.el (nxml-scan-error):
+ * nxml/nxml-outln.el (nxml-outline-error):
+ * net/soap-client.el (soap-error):
+ * net/gnutls.el (gnutls-error):
+ * net/ange-ftp.el (ftp-error):
+ * mpc.el (mpc-proc-error):
+ * json.el (json-error, json-readtable-error, json-unknown-keyword)
+ (json-number-format, json-string-escape, json-string-format)
+ (json-key-format, json-object-format):
+ * jka-compr.el (compression-error):
+ * international/quail.el (quail-error):
+ * international/kkc.el (kkc-error):
+ * emacs-lisp/ert.el (ert-test-failed):
+ * calc/calc.el (calc-error, inexact-result, math-overflow)
+ (math-underflow):
+ * bookmark.el (bookmark-error-no-filename):
+ * epg.el (epg-error): Define with define-error.
+
+ * time.el (display-time-event-handler)
+ (display-time-next-load-average): Don't call sit-for since it seems
+ unnecessary (bug#15045).
+
+ * emacs-lisp/checkdoc.el: Remove redundant :group keywords.
+ Use #' instead of ' to quote functions.
+ (checkdoc-output-mode): Use setq-local.
+ (checkdoc-spellcheck-documentation-flag, checkdoc-ispell-lisp-words)
+ (checkdoc-verb-check-experimental-flag, checkdoc-proper-noun-regexp)
+ (checkdoc-common-verbs-regexp): Mark safe-local-variable (bug#15010).
+ (checkdoc-ispell, checkdoc-ispell-current-buffer)
+ (checkdoc-ispell-interactive, checkdoc-ispell-message-interactive)
+ (checkdoc-ispell-message-text, checkdoc-ispell-start)
+ (checkdoc-ispell-continue, checkdoc-ispell-comments)
+ (checkdoc-ispell-defun): Remove unused arg `take-notes'.
+
+ * ido.el (ido-completion-help): Fix up compiler warning.
+
+2013-08-09 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-p): Add autoload cookie.
+ (frameset--jump-to-register): New function, based on code moved from
+ register.el.
+ (frameset-to-register): Move from register.el. Adapt to `registerv'.
+
+ * register.el (frameset-frame-id, frameset-frame-with-id, frameset-p)
+ (frameset-restore, frameset-save, frameset-session-filter-alist):
+ Remove declarations.
+ (register-alist): Doc fix.
+ (frameset-to-register): Move to frameset.el.
+ (jump-to-register, describe-register-1): Remove frameset-specific code.
+
+2013-08-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * allout-widgets.el (allout-widgets-pre-command-business)
+ (allout-widgets-post-command-business)
+ (allout-widgets-after-change-handler)
+ (allout-decorate-item-and-context, allout-set-boundary-marker)
+ (allout-body-modification-handler)
+ (allout-graphics-modification-handler): Mark ignored arguments.
+ (allout-widgets-post-command-business)
+ (allout-widgets-exposure-change-processor)
+ (allout-widgets-exposure-undo-processor)
+ (allout-decorate-item-and-context, allout-redecorate-visible-subtree)
+ (allout-parse-item-at-point, allout-decorate-item-guides)
+ (allout-decorate-item-cue, allout-item-span): Remove unused variables.
+ * allout.el (epa-passphrase-callback-function): Declare.
+ (allout-overlay-insert-in-front-handler)
+ (allout-overlay-interior-modification-handler)
+ (allout-isearch-end-handler, allout-chart-siblings)
+ (allout-up-current-level, allout-end-of-level, allout-reindent-body)
+ (allout-yank-processing, allout-process-exposed)
+ (allout-latex-verb-quote, allout-latexify-one-item, outlineify-sticky)
+ (allout-latex-verbatim-quote-curr-line): Remove unused variables.
+ * emacs-lisp/lisp-mode.el (lisp-eval-defun, last-sexp-toggle-display)
+ (lisp-indent-defform): Mark ignored arguments.
+ (lisp-indent-line): Mark ignored arguments. Remove unused variables.
+ (calculate-lisp-indent): Remove unused variables.
+ * international/characters.el (indian-2-column, arabic-2-column)
+ (tibetan): Mark ignored arguments.
+ (use-cjk-char-width-table): Mark ignored arguments.
+ Remove unused variables.
+ * international/fontset.el (build-default-fontset-data)
+ (x-compose-font-name, create-fontset-from-fontset-spec):
+ Mark ignored arguments.
+ (fontset-plain-name): Remove unused variables.
+ * international/mule.el (charset-id, charset-bytes, generic-char-p)
+ (keyboard-coding-system): Mark ignored arguments.
+ (find-auto-coding): Remove unused variables. Use `ignore-errors'.
+ * help.el (resize-temp-buffer-window):
+ * window.el (display-buffer-in-major-side-window)
+ (display-buffer-in-side-window, display-buffer-in-previous-window):
+ Remove unused variables.
+ * isearch.el (isearch-forward-symbol):
+ * version.el (emacs-bzr-version-bzr):
+ * international/mule-cmds.el (current-language-environment):
+ * term/common-win.el (x-handle-iconic, x-handle-geometry)
+ (x-handle-display):
+ * term/pc-win.el (x-list-fonts, x-display-planes)
+ (x-display-color-cells, x-server-max-request-size, x-server-vendor)
+ (x-server-version, x-display-screens, x-display-mm-height)
+ (x-display-mm-width, x-display-backing-store, x-display-visual-class)
+ (x-selection-owner-p, x-own-selection-internal)
+ (x-disown-selection-internal, x-get-selection-internal)
+ (msdos-initialize-window-system):
+ * term/tty-colors.el (tty-color-alist, tty-color-clear):
+ * term/x-win.el (x-handle-no-bitmap-icon):
+ * vc/vc-hooks.el (vc-mode, vc-default-make-version-backups-p)
+ (vc-default-find-file-hook, vc-default-extra-menu):
+ Mark ignored arguments.
+
+2013-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-debugger): Use edebug-eval to run the
+ break-condition in the context of the debugged code (bug#12685).
+
+2013-08-08 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * comint.el:
+ Do not use an overlay to highlight the last prompt. (Bug#14744)
+ (comint-mode): Make comint-last-prompt buffer local.
+ (comint-last-prompt): New variable.
+ (comint-last-prompt-overlay): Remove. Superseded by
+ comint-last-prompt.
+ (comint-snapshot-last-prompt, comint-output-filter):
+ Use comint-last-prompt.
+
+2013-08-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-valid-p): Check vector length. Doc fix.
+ (frameset-save): Check validity of the resulting frameset.
+
+2013-08-08 Xue Fuqiao <xfq.free@gmail.com>
+
+ * ido.el (ido-record-command): Add doc string.
+
+2013-08-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset): Do not disable creation of the default
+ frameset-p predicate. Doc fix.
+ (frameset-valid-p): New function, copied from the old predicate-p.
+ Add additional checks.
+ (frameset-restore): Check with frameset-valid-p.
+ (frameset-p, frameset-version, frameset-timestamp, frameset-app)
+ (frameset-name, frameset-description, frameset-properties)
+ (frameset-states): Add docstring.
+ (frameset-session-filter-alist, frameset-persistent-filter-alist)
+ (frameset-filter-alist): Doc fixes.
+
+2013-08-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-p, frameset-prop): Doc fixes.
+
+2013-08-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/bytecomp.el (byte-compile-function-warn): New function,
+ extracted from byte-compile-callargs-warn and byte-compile-normal-call.
+ (byte-compile-callargs-warn, byte-compile-function-form): Use it.
+ (byte-compile-normal-call): Remove obsolescence check.
+
+2013-08-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-restore): Doc fix.
+
+ * register.el (frameset-frame-id, frameset-frame-with-id)
+ (frameset-p, frameset-restore, frameset-save): Declare.
+ (register-alist): Document framesets.
+ (frameset-session-filter-alist): Declare.
+ (frameset-to-register): New function.
+ (jump-to-register): Implement jumping to framesets. Doc fix.
+ (describe-register-1): Describe framesets.
+
+ * bindings.el (ctl-x-r-map): Bind ?f to frameset-to-register.
+
+2013-08-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-save-frameset): Use new frameset-save args.
+ Use lexical-binding.
+
+ * frameset.el (frameset): Use type vector, not list (incompatible
+ change). Do not declare a new constructor, use the default one.
+ Upgrade suggested properties `app', `name' and `desc' to slots `app',
+ `name' and `description', respectively, and add read-only slot
+ `timestamp'. Doc fixes.
+ (frameset-copy, frameset-persistent-filter-alist)
+ (frameset-filter-alist, frameset-switch-to-gui-p)
+ (frameset-switch-to-tty-p, frameset-filter-tty-to-GUI)
+ (frameset-filter-sanitize-color, frameset-filter-minibuffer)
+ (frameset-filter-iconified, frameset-keep-original-display-p):
+ Doc fixes.
+ (frameset-filter-shelve-param, frameset-filter-unshelve-param):
+ Rename from frameset-filter-(save|restore)-param. All callers changed.
+ Doc fix.
+ (frameset-p): Adapt to change to vector and be more thorough.
+ Change arg name to OBJECT. Doc fix.
+ (frameset-prop): Rename arg PROP to PROPERTY. Doc fix.
+ (frameset-session-filter-alist): Rename from frameset-live-filter-alist.
+ All callers changed.
+ (frameset-frame-with-id): Rename from frameset-locate-frame-id.
+ All callers changed.
+ (frameset--record-minibuffer-relationships): Rename from
+ frameset--process-minibuffer-frames. All callers changed.
+ (frameset-save): Add new keyword arguments APP, NAME and DESCRIPTION.
+ Use new default constructor (again). Doc fix.
+ (frameset--find-frame-if): Rename from `frameset--find-frame'.
+ All callers changed.
+ (frameset--reuse-frame): Rename arg FRAME-CFG to PARAMETERS.
+ (frameset--initial-params): Rename arg FRAME-CFG to PARAMETERS.
+ Doc fix.
+ (frameset--restore-frame): Rename args FRAME-CFG and WINDOW-CFG to
+ PARAMETERS and WINDOW-STATE, respectively.
+ (frameset-restore): Add new keyword argument PREDICATE.
+ Reset frameset--target-display to nil. Doc fix.
+
+2013-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/bat-mode.el (bat--syntax-propertize): New var.
+ (bat-mode): Use it.
+ (bat-mode-syntax-table): Mark \n as end-of-comment.
+ (bat-font-lock-keywords): Remove comment rule.
+
+ * progmodes/bat-mode.el: Rename from dos.el. Use "bat-" prefix.
+ (dos-mode-help): Remove. Use describe-mode (C-h m) instead.
+
+ * emacs-lisp/bytecomp.el: Check existence of f in #'f.
+ (byte-compile-callargs-warn): Use `push'.
+ (byte-compile-arglist-warn): Ignore higher-order "calls".
+ (byte-compile-file-form-autoload): Use `pcase'.
+ (byte-compile-function-form): If quoting a symbol, check that it exists.
+
+2013-08-07 Eli Zaretskii <eliz@gnu.org>
+
+ * progmodes/dos.el (dos-font-lock-keywords): Rename LINUX to UNIX
+ and add a few popular commands found in batch files.
+ (dos, dos-label-face, dos-cmd-help, dos-run, dos-run-args)
+ (dos-mode): Doc fixes.
+
+2013-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/dos.el (auto-mode-alist): Add entries for dos-mode.
+ (dos-mode): Use setq-local. Add space after "rem".
+ (dos-mode-syntax-table): Don't use "w" for symbol chars.
+ (dos-font-lock-keywords): Try to adjust font-lock rules accordingly.
+
+2013-08-07 Arni Magnusson <arnima@hafro.is>
+
+ * progmodes/dos.el: New file.
+ * generic-x.el (bat-generic-mode): Redefine as an obsolete alias to
+ dos-mode.
+
+2013-08-06 Glenn Morris <rgm@gnu.org>
+
+ * calendar/calendar.el: Add new faces, and day-header-array.
+ (calendar-weekday-header, calendar-weekend-header)
+ (calendar-month-header): New faces.
+ (calendar-day-header-construct): New function.
+ (calendar-day-header-width): Also :set calendar-day-header-array.
+ (calendar-american-month-header, calendar-european-month-header)
+ (calendar-iso-month-header): Use calendar- faces.
+ (calendar-generate-month):
+ Use calendar-day-header-array for day headers; apply faces to them.
+ (calendar-mode): Check calendar-font-lock-keywords non-nil.
+ (calendar-abbrev-construct): Add optional maxlen argument.
+ (calendar-day-name-array): Doc fix.
+ (calendar-day-name-array, calendar-abbrev-length)
+ (calendar-day-abbrev-array):
+ Also :set calendar-day-header-array, and maybe redraw.
+ (calendar-day-header-array): New option. (Bug#15007)
+ (calendar-font-lock-keywords): Set to nil and make obsolete.
+ (calendar-day-name): Add option to use header array.
+
+2013-08-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-render-td): Remove debugging.
+ (shr-render-td): Make width computation consistent by defaulting
+ all zero-width columns to 10 characters. This may not be optimal,
+ but it's at least consistent.
+ (shr-make-table-1): Redo last change to fix the real problem in
+ colspan handling.
+
+2013-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * files.el (cache-long-line-scans):
+ Make obsolete alias to `cache-long-scans'.
+
+2013-08-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset, frameset-filter-alist)
+ (frameset-filter-params, frameset-save, frameset--reuse-frame)
+ (frameset--minibufferless-last-p, frameset-restore): Doc fixes.
+ (frameset-compute-pos): Rename from frameset--compute-pos,
+ and add docstring.
+ (frameset-move-onscreen): Use frameset-compute-pos.
+ Most changes suggested by Drew Adams <drew.adams@oracle.com>.
+
+ * find-lisp.el (find-lisp-line-indent, find-lisp-find-dired-filter):
+ Fix typos in docstrings.
+
+2013-08-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * frame.el (get-other-frame): Tiny cleanup.
+
+2013-08-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * vc/vc.el (vc-default-ignore-completion-table):
+ Silence byte-compiler warning.
+
+ * frameset.el (frameset-p): Don't check non-nullness of the `properties'
+ slot, which can indeed be nil.
+ (frameset-live-filter-alist, frameset-persistent-filter-alist):
+ Move entry for `left' from persistent to live filter alist.
+ (frameset-filter-alist, frameset--minibufferless-last-p, frameset-save):
+ Doc fixes.
+ (frameset-filter-params): When restoring a frame, copy items added to
+ `filtered', to avoid unwittingly modifying the original parameters.
+ (frameset-move-onscreen): Rename from frameset--move-onscreen. Doc fix.
+ (frameset--restore-frame): Fix reference to frameset-move-onscreen.
+
+ * dired.el (dired-insert-directory): Revert change in 2013-06-21T12:24:37Z!lekktu@gmail.com
+ to use looking-at-p instead of looking-at. (Bug#15028)
+
+2013-08-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Revert introduction of isearch-filter-predicates (bug#14714).
+ Rely on add-function instead.
+ * isearch.el (isearch-filter-predicates): Rename it back to
+ isearch-filter-predicate.
+ (isearch-message-prefix): Use advice-function-mapc and advice
+ properties to get the isearch-message-prefix.
+ (isearch-search, isearch-lazy-highlight-search): Revert to funcall
+ instead of run-hook-with-args-until-failure.
+ (isearch-filter-visible): Not obsolete any more.
+ * loadup.el: Preload nadvice.
+ * replace.el (perform-replace): Revert to funcall
+ instead of run-hook-with-args-until-failure.
+ * wdired.el (wdired-change-to-wdired-mode): Use add-function.
+ * dired-aux.el (dired-isearch-filenames-mode): Rename from
+ dired-isearch-filenames-toggle; make it into a proper minor mode.
+ Use add/remove-function.
+ (dired-isearch-filenames-setup, dired-isearch-filenames-end):
+ Call the minor-mode rather than add/remove-hook.
+ (dired-isearch-filter-filenames):
+ Remove isearch-message-prefix property.
+ * info.el (Info--search-loop): New function, extracted from Info-search.
+ Funcall isearch-filter-predicate instead of
+ run-hook-with-args-until-failure isearch-filter-predicates.
+ (Info-search): Use it.
+ (Info-mode): Use isearch-filter-predicate instead of
+ isearch-filter-predicates.
+
+2013-08-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not call to `selected-window' where it is assumed by default.
+ Affected functions are `window-minibuffer-p', `window-dedicated-p',
+ `window-hscroll', `window-width', `window-height', `window-buffer',
+ `window-frame', `window-start', `window-point', `next-window'
+ and `window-display-table'.
+ * abbrev.el (abbrev--default-expand):
+ * bs.el (bs--show-with-configuration):
+ * buff-menu.el (Buffer-menu-mouse-select):
+ * calc/calc.el (calc):
+ * calendar/calendar.el (calendar-generate-window):
+ * calendar/diary-lib.el (diary-simple-display, diary-show-all-entries)
+ (diary-make-entry):
+ * comint.el (send-invisible, comint-dynamic-complete-filename)
+ (comint-dynamic-simple-complete, comint-dynamic-list-completions):
+ * completion.el (complete):
+ * dabbrev.el (dabbrev-expand, dabbrev--make-friend-buffer-list):
+ * disp-table.el (describe-current-display-table):
+ * doc-view.el (doc-view-insert-image):
+ * ebuff-menu.el (Electric-buffer-menu-mouse-select):
+ * ehelp.el (with-electric-help):
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
+ * emacs-lisp/edebug.el (edebug-two-window-p, edebug-pop-to-buffer):
+ * emacs-lisp/helper.el (Helper-help-scroller):
+ * emulation/cua-base.el (cua--post-command-handler-1):
+ * eshell/esh-mode.el (eshell-output-filter):
+ * ffap.el (ffap-gnus-wrapper):
+ * help-macro.el (make-help-screen):
+ * hilit-chg.el (highlight-compare-buffers):
+ * hippie-exp.el (hippie-expand, try-expand-dabbrev-visible):
+ * hl-line.el (global-hl-line-highlight):
+ * icomplete.el (icomplete-simple-completing-p):
+ * isearch.el (isearch-done):
+ * jit-lock.el (jit-lock-stealth-fontify):
+ * mail/rmailsum.el (rmail-summary-scroll-msg-up):
+ * mouse-drag.el (mouse-drag-should-do-col-scrolling):
+ * mpc.el (mpc-tagbrowser, mpc):
+ * net/rcirc.el (rcirc-any-buffer):
+ * play/gomoku.el (gomoku-max-width, gomoku-max-height):
+ * play/landmark.el (landmark-max-width, landmark-max-height):
+ * play/zone.el (zone):
+ * progmodes/compile.el (compilation-goto-locus):
+ * progmodes/ebrowse.el (ebrowse-view/find-file-and-search-pattern):
+ * progmodes/etags.el (find-tag-other-window):
+ * progmodes/fortran.el (fortran-column-ruler):
+ * progmodes/gdb-mi.el (gdb-mouse-toggle-breakpoint-fringe):
+ * progmodes/verilog-mode.el (verilog-point-text):
+ * reposition.el (reposition-window):
+ * rot13.el (toggle-rot13-mode):
+ * server.el (server-switch-buffer):
+ * shell.el (shell-dynamic-complete-command)
+ (shell-dynamic-complete-environment-variable):
+ * simple.el (insert-buffer, set-selective-display)
+ (delete-completion-window):
+ * speedbar.el (speedbar-timer-fn, speedbar-center-buffer-smartly)
+ (speedbar-recenter):
+ * startup.el (fancy-splash-head):
+ * textmodes/ispell.el (ispell-command-loop):
+ * textmodes/makeinfo.el (makeinfo-compilation-sentinel-region):
+ * tutorial.el (help-with-tutorial):
+ * vc/add-log.el (add-change-log-entry):
+ * vc/compare-w.el (compare-windows):
+ * vc/ediff-help.el (ediff-indent-help-message):
+ * vc/ediff-util.el (ediff-setup-control-buffer, ediff-position-region):
+ * vc/ediff-wind.el (ediff-skip-unsuitable-frames)
+ (ediff-setup-control-frame):
+ * vc/emerge.el (emerge-position-region):
+ * vc/pcvs-util.el (cvs-bury-buffer):
+ * window.el (walk-windows, mouse-autoselect-window-select):
+ * winner.el (winner-set-conf, winner-undo): Related users changed.
+
+2013-08-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset--set-id): Doc fix.
+ (frameset-frame-id, frameset-frame-id-equal-p)
+ (frameset-locate-frame-id): New functions.
+ (frameset--process-minibuffer-frames, frameset--reuse-frame)
+ (frameset-restore): Use them.
+
+2013-08-05 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not call to `selected-frame' where it is assumed by default.
+ Affected functions are `raise-frame', `redraw-frame',
+ `frame-first-window', `frame-terminal' and `delete-frame'.
+ * calendar/appt.el (appt-disp-window):
+ * epg.el (epg-wait-for-completion):
+ * follow.el (follow-delete-other-windows-and-split)
+ (follow-avoid-tail-recenter):
+ * international/mule.el (set-terminal-coding-system):
+ * mail/rmail.el (rmail-mail-return):
+ * net/newst-plainview.el (newsticker--buffer-set-uptodate):
+ * progmodes/f90.el (f90-add-imenu-menu):
+ * progmodes/idlw-toolbar.el (idlwave-toolbar-toggle):
+ * server.el (server-switch-buffer):
+ * simple.el (delete-completion-window):
+ * talk.el (talk):
+ * term/xterm.el (terminal-init-xterm-modify-other-keys)
+ (xterm-turn-on-modify-other-keys, xterm-remove-modify-other-keys):
+ * vc/ediff-util.el (ediff-status-info, ediff-show-diff-output):
+ * vc/ediff.el (ediff-documentation): Related users changed.
+ * frame.el (selected-terminal): Remove the leftover.
+
+2013-08-05 Glenn Morris <rgm@gnu.org>
+
+ * calendar/calendar.el (calendar-generate-month):
+ Fix for calendar-column-width != 1 + calendar-day-digit-width.
+ (calendar-generate-month, calendar-font-lock-keywords):
+ Fix for calendar-day-header-width > length of any day name.
+
+2013-08-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-clear): Use new name of sort predicate.
+
+ * frameset.el (frameset): Add docstring. Move :version property to its
+ own `version' slot.
+ (frameset-copy): Rename from copy-frameset.
+ (frameset-p): Check more thoroughly.
+ (frameset-prop): Do not check for :version, which is no longer a prop.
+ (frameset-live-filter-alist, frameset-persistent-filter-alist):
+ Use new :never value instead of t.
+ (frameset-filter-alist): Expand and clarify docstring.
+ (frameset-filter-tty-to-GUI, frameset-filter-sanitize-color)
+ (frameset-filter-minibuffer, frameset-filter-save-param)
+ (frameset-filter-restore-param, frameset-filter-iconified):
+ Add pointer to docstring of frameset-filter-alist.
+ (frameset-filter-params): Rename filter values to be more meaningful:
+ :never instead of t, and reverse the meanings of :save and :restore.
+ (frameset--process-minibuffer-frames): Clarify error message.
+ (frameset-save): Avoid unnecessary and confusing call to framep.
+ Use new BOA constructor for framesets.
+ (frameset--reuse-list): Doc fix.
+ (frameset--restore-frame): Rename from frameset--get-frame. Doc fix.
+ (frameset--minibufferless-last-p): Rename from frameset--sort-states.
+ (frameset-minibufferless-first-p): Doc fix.
+ Rename from frameset-sort-frames-for-deletion.
+ (frameset-restore): Doc fixes. Use new function names.
+ Most changes suggested by Drew Adams <drew.adams@oracle.com>.
+
+2013-08-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-forces-onscreen)
+ (desktop-restore-reuses-frames): Document :keyword constant values.
+ (desktop-filter-parameters-alist): Remove, now identical to
+ frameset-filter-alist.
+ (desktop--filter-tty*): Remove, moved to frameset.el.
+ (desktop-save-frameset, desktop-restore-frameset):
+ Do not pass :filters argument.
+
+ * frameset.el (frameset-live-filter-alist)
+ (frameset-persistent-filter-alist): New variables.
+ (frameset-filter-alist): Use them. Add autoload cookie.
+ (frameset-filter-tty-to-GUI): Move from desktop.el and rename.
+ (frameset--set-id, frameset--reuse-frame): Rename `frame-id' to
+ `frameset--id' (it's supposed to be internal to frameset.el).
+ (frameset--process-minibuffer-frames): Ditto. Doc fix.
+ (frameset--initial-params): New function.
+ (frameset--get-frame): Use it. Doc fix.
+ (frameset--move-onscreen): Accept new PRED value for FORCE-ONSCREEN.
+ Accept :all, not 'all.
+ (frameset-restore): Add new predicate values for FORCE-ONSCREEN and
+ FORCE-DISPLAY. Use :keywords for constant arguments to avoid collision
+ with fbound symbols. Fix frame id matching, and remove matching ids if
+ the frame being restored is deleted. Obey :delete.
+
+2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (macrop): New function.
+ (text-clone--maintaining): New var.
+ (text-clone--maintain): Rename from text-clone-maintain. Use it
+ instead of inhibit-modification-hooks.
+
+ * emacs-lisp/nadvice.el (advice--normalize): For aliases to macros, use
+ a proxy, so as handle autoloads and redefinitions of the target.
+ (advice--defalias-fset, advice-remove): Use advice--symbol-function.
+
+ * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
+ Remove bogus (arrayp . stringp) pair. Add entries for `vectorp'.
+ (pcase--mutually-exclusive-p): New function.
+ (pcase--split-consp): Use it.
+ (pcase--split-pred): Use it. Optimize the case where `pat' is a qpat
+ mutually exclusive with the current predicate.
+
+ * emacs-lisp/edebug.el (edebug-lookup-function): Remove function.
+ (edebug-macrop): Remove. Use `macrop' instead.
+ * emacs-lisp/advice.el (ad-subr-p): Remove. Use `subrp' instead.
+ (ad-macro-p):
+ * eshell/esh-cmd.el (eshell-macrop):
+ * apropos.el (apropos-macrop): Remove. Use `macrop' instead.
+
+2013-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice-function-mapc): Rename from advice-mapc.
+ (advice-mapc): New function, using it.
+ (advice-function-member-p): New function.
+ (advice--normalize): Store the cdr in advice--saved-rewrite since
+ that's the part that will be changed.
+ (advice--symbol-function): New function.
+ (advice-remove): Handle removal before the function is defined.
+ Adjust to new advice--saved-rewrite.
+ (advice-member-p): Use advice-function-member-p and
+ advice--symbol-function.
+
+2013-08-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-p, frameset-save): Fix autoload cookies.
+ (frameset-filter-minibuffer): Doc fix.
+ (frameset-restore): Fix autoload cookie. Fix typo in docstring.
+ (frameset--set-id, frameset--process-minibuffer-frames)
+ (frameset-restore): Rename parameter `frameset-id' to `frame-id'.
+ (frameset--reuse-frame): Pass correct frame-id to frameset--find-frame.
+
+ * desktop.el (desktop-clear): Only delete frames when called
+ interactively and desktop-restore-frames is non-nil. Doc fix.
+ (desktop-read): Set desktop-saved-frameset to nil.
+
+2013-08-04 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc.el (vc-ignore): Rewrite.
+ (vc-default-ignore-completion-table, vc--read-lines)
+ (vc--add-line, vc--remove-regexp): New functions.
+
+ * vc/vc-svn.el (vc-svn-ignore): Doc fix.
+ (vc-svn-ignore-completion-table): New function.
+
+ * vc/vc-hg.el (vc-hg-ignore): Rewrite.
+ (vc-hg-ignore-completion-table)
+ (vc-hg-find-ignore-file): New functions.
+
+ * vc/vc-git.el (vc-git-ignore): Rewrite.
+ (vc-git-ignore-completion-table)
+ (vc-git-find-ignore-file): New functions.
+
+ * vc/vc-dir.el (vc-dir-menu-map): Add menu for vc-dir-ignore.
+
+ * vc/vc-bzr.el (vc-bzr-ignore): Rewrite.
+ (vc-bzr-ignore-completion-table)
+ (vc-bzr-find-ignore-file): New functions.
+
+2013-08-03 Juanma Barranquero <lekktu@gmail.com>
+
+ * frameset.el (frameset-prop): New function and setter.
+ (frameset-save): Do not modify frame list passed by the caller.
+
+2013-08-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-desc-from-define): Ignore unknown keys.
+
+2013-08-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/easy-mmode.el (define-globalized-minor-mode)
+ (easy-mmode-define-navigation): Avoid ((lambda (..) ..) ...).
+
+ * custom.el (custom-initialize-default, custom-initialize-set)
+ (custom-initialize-reset, custom-initialize-changed): Affect the
+ toplevel-default-value (bug#6275, bug#14586).
+ * emacs-lisp/advice.el (ad-compile-function): Undo previous workaround
+ for bug#6275.
+
+2013-08-02 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
+ Add cl-def* expressions.
+
+ * frameset.el (frameset-filter-params): Fix order of arguments.
+
+2013-08-02 Juanma Barranquero <lekktu@gmail.com>
+
+ Move code related to saving frames to frameset.el.
+ * desktop.el: Require frameset.
+ (desktop-restore-frames): Doc fix.
+ (desktop-restore-reuses-frames): Rename from
+ desktop-restoring-reuses-frames.
+ (desktop-saved-frameset): Rename from desktop-saved-frame-states.
+ (desktop-clear): Clear frames too.
+ (desktop-filter-parameters-alist): Set from frameset-filter-alist.
+ (desktop--filter-tty*, desktop-save, desktop-read):
+ Use frameset functions.
+ (desktop-before-saving-frames-functions, desktop--filter-*-color)
+ (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm, desktop--filter-iconified-position)
+ (desktop-restore-in-original-display-p, desktop--filter-frame-parms)
+ (desktop--process-minibuffer-frames, desktop-save-frames)
+ (desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen)
+ (desktop--find-frame, desktop--select-frame, desktop--make-frame)
+ (desktop--sort-states, desktop-restoring-frames-p)
+ (desktop-restore-frames): Remove. Most code moved to frameset.el.
+ (desktop-restoring-frameset-p, desktop-restore-frameset)
+ (desktop--check-dont-save, desktop-save-frameset): New functions.
+ (desktop--app-id): New constant.
+ (desktop-first-buffer, desktop-buffer-ok-count)
+ (desktop-buffer-fail-count): Move before first use.
+ * frameset.el: New file.
+
+2013-08-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el: Use lexical-binding.
+ (dir-locals-read-from-file): Remove unused `err' variable.
+ (hack-dir-local-variables--warned-coding): New var.
+ (hack-dir-local-variables): Use it to avoid repeated warnings.
+ (make-backup-file-name--default-function): New function.
+ (make-backup-file-name-function): Use it as default.
+ (buffer-stale--default-function): New function.
+ (buffer-stale-function): Use it as default.
+ (revert-buffer-insert-file-contents--default-function): New function.
+ (revert-buffer-insert-file-contents-function): Use it as default.
+ (insert-directory): Avoid add-to-list.
+
+ * autorevert.el (auto-revert-handler): Simplify.
+ Use buffer-stale--default-function.
+
+2013-08-01 Tassilo Horn <tsdh@gnu.org>
+
+ * speedbar.el (speedbar-query-confirmation-method): Doc fix.
+
+ * whitespace.el (whitespace-ensure-local-variables): New function.
+ (whitespace-cleanup-region): Call it.
+ (whitespace-turn-on): Call it.
+
+2013-08-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Complete file name handlers.
+
+ * net/tramp.el (tramp-handle-set-visited-file-modtime)
+ (tramp-handle-verify-visited-file-modtime)
+ (tramp-handle-file-notify-rm-watch): New functions.
+ (tramp-call-process): Do not bind `default-directory'.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ Order alphabetically.
+ <access-file, add-name-to-file, dired-call-process>:
+ <dired-compress-file, file-acl, file-notify-rm-watch>:
+ <file-ownership-preserved-p, file-selinux-context>:
+ <make-directory-internal, make-symbolic-link, set-file-acl>:
+ <set-file-selinux-context, set-visited-file-modtime>:
+ <verify-visited-file-modtime>: Add handler.
+ (tramp-adb-handle-write-region): Apply `set-visited-file-modtime'.
+
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist)
+ <file-notify-add-watch, file-notify-rm-watch>:
+ <set-file-times, set-visited-file-modtime>:
+ <verify-visited-file-modtime>: Add handler.
+ (with-tramp-gvfs-error-message)
+ (tramp-gvfs-handle-set-visited-file-modtime)
+ (tramp-gvfs-fuse-file-name): Remove.
+ (tramp-gvfs-handle-file-notify-add-watch)
+ (tramp-gvfs-file-gvfs-monitor-file-process-filter): New defuns.
+ (tramp-gvfs-handle-write-region): Fix error in moving tmpfile.
+
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+ Order alphabetically.
+ <file-notify-rm-watch>: Use default Tramp handler.
+ <executable-find>: Remove private handler.
+ (tramp-do-copy-or-rename-file-out-of-band): Do not bind
+ `default-directory'.
+ (tramp-sh-handle-executable-find)
+ (tramp-sh-handle-file-notify-rm-watch): Remove functions.
+ (tramp-sh-file-gvfs-monitor-dir-process-filter)
+ (tramp-sh-file-inotifywait-process-filter, tramp-set-remote-path):
+ Do not use `format' in `tramp-message'.
+
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist)
+ <file-notify-rm-watch, set-visited-file-modtime>:
+ <verify-visited-file-modtime>: Add handler.
+ (tramp-smb-call-winexe): Do not bind `default-directory'.
+
+2013-08-01 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-hooks.el (vc-menu-map): Fix menu entry for vc-ignore.
+
+2013-07-31 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/log-view.el (log-view-diff): Extract `log-view-diff-common',
+ use it.
+ (log-view-diff-changeset): Same.
+ (log-view-diff-common): Call backend command `previous-revision'
+ to find out the previous revision, in both cases. Swap the
+ variables `to' and `fr', so that `fr' usually refers to the
+ earlier revision (Bug#14989).
+
+2013-07-31 Kan-Ru Chen <kanru@kanru.info>
+
+ * ibuf-ext.el (ibuffer-filter-by-filename):
+ Make it work with dired buffers too.
+
+2013-07-31 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * emacs-lisp/re-builder.el (reb-color-display-p):
+ * files.el (save-buffers-kill-terminal):
+ * net/browse-url.el (browse-url):
+ * server.el (server-save-buffers-kill-terminal):
+ * textmodes/reftex-toc.el (reftex-toc, reftex-toc-revert):
+ Prefer nil to selected-frame for the first arg of frame-parameter.
+
+2013-07-31 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-hooks.el (vc-menu-map): Add menu entry for vc-ignore.
+
+2013-07-30 Stephen Berman <stephen.berman@gmx.net>
+
+ * minibuffer.el (completion--twq-all): Try and preserve each
+ completion's case choice (bug#14907).
+
+2013-07-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/network-stream.el (open-network-stream): Mention the new
+ :nogreeting parameter.
+ (network-stream-open-starttls): Use the :nogreeting parameter
+ (bug#14938).
+
+ * net/shr.el (shr-mouse-browse-url): Remove and use `shr-browse-url'.
+
+ * net/eww.el (eww-setup-buffer): Switching to the buffer seems
+ more natural than popping.
+
+ * net/shr.el (shr-urlify): Put `follow-link' on URLs (bug#14815).
+ (shr-urlify): Highlight under mouse.
+
+2013-07-30 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-hooks.el (vc-prefix-map): Add key binding for vc-ignore.
+
+ * vc/vc-dir.el (vc-dir-mode-map): Change key binding for vc-dir-ignore.
+
+ * vc/vc-svn.el (vc-svn-ignore): Remove `interactive'. Use `*vc*'
+ buffer for output.
+
+ * vc/vc-hg.el (vc-hg-ignore): Remove `interactive'. Do not assume
+ point-min==1. Fix search string. Fix parentheses missing.
+
+ * vc/vc-git.el (vc-git-ignore): Remove `interactive'. Do not
+ assume point-min==1. Fix search string. Fix parentheses missing.
+
+ * vc/vc-cvs.el (vc-cvs-ignore): Remove `interactive'.
+
+ * vc/vc-bzr.el (vc-bzr-ignore): Remove `interactive'. Use `*vc*'
+ buffer for output.
+
+2013-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ * frame.el (frame-notice-user-settings): Avoid inflooping when the
+ initial frame is minibuffer-less. (Bug#14841)
+
+2013-07-29 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-use-ssh-controlmaster-options): New customer
+ option.
+
+ * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection): Use it.
+
+2013-07-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--make-frame): Include `minibuffer' in the
+ minimal set of parameters passed when creating a frame, because
+ the minibuffer status of a frame cannot be changed later.
+
+2013-07-28 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el (todo-rename-file): Fix incorrect use of
+ replace-regexp-in-string and inadvertent omissions in previous change.
+ (todo-filter-items): Ensure only file names are comma-separated in
+ name of filtered items buffer.
+
+2013-07-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el: Optionally force offscreen frames back onscreen.
+ (desktop-restoring-reuses-frames): New option.
+ (desktop--compute-pos, desktop--move-onscreen): New functions.
+ (desktop--make-frame): Use desktop--move-onscreen.
+
+2013-07-27 Alan Mackenzie <acm@muc.de>
+
+ Fontify a Java generic method as a function.
+ * progmodes/cc-langs.el (c-recognize-<>-arglists): Set the Java
+ value to t.
+
+2013-07-27 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Add command to rename todo files.
+ (todo-rename-file): New command.
+ (todo-key-bindings-t): Add key binding for it. Change the
+ bindings of todo-filter-regexp-items(-multifile) to use `x'
+ instead of `r', since the latter is better suited to the new
+ renaming command.
+
+2013-07-27 Alan Mackenzie <acm@muc.de>
+
+ Make Java try-with-resources statement parse properly.
+ * progmodes/cc-langs.el (c-block-stmt-1-2-kwds)
+ (c-block-stmt-1-2-key): New language constants/variables.
+ * progmodes/cc-engine.el (c-beginning-of-statement-1)
+ (c-after-conditional): Adapt to deal with c-block-stmt-1-2-key.
+ * progmodes/cc-fonts.el (c-font-lock-declarations): Adapt to deal
+ with c-block-stmt-1-2-key.
+
+2013-07-27 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--make-frame): Apply most frame parameters after
+ creating the frame to force (partially or totally) offscreen frames to
+ be restored as such.
+
+2013-07-26 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-dir.el (vc-dir-mode-map): Add binding for vc-root-diff.
+ (Bug#14948)
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--called-interactively-skip): Use the new
+ `base' arg of backtrace-frame.
+
+2013-07-26 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (list-processes): Doc fix.
+
+2013-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--select-frame):
+ Try harder to reuse existing frames.
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el: Use backtrace-eval to handle lexical variables.
+ (edebug-eval): Use backtrace-eval.
+ (edebug--display, edebug--recursive-edit): Don't let-bind the
+ edebug-outer-* vars that keep track of variables we locally let-bind.
+ (edebug-outside-excursion): Don't restore outside values of locally
+ let-bound vars.
+ (edebug--display): Use user-error.
+ (cl-lexical-debug, cl-debug-env): Remove.
+
+2013-07-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-frames): Call `sit-for' once all frames
+ are restored to be sure that they are visible before deleting any
+ remaining ones.
+
+2013-07-26 Matthias Meulien <orontee@gmail.com>
+
+ * vc/vc-dir.el (vc-dir-mode-map): Add binding for
+ vc-print-root-log. (Bug#14948)
+
+2013-07-26 Richard Stallman <rms@gnu.org>
+
+ Add aliases for encrypting mail.
+ * epa.el (epa-mail-aliases): New option.
+ * epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs.
+ Bind inhibit-read-only so read-only text doesn't ruin everything.
+ (epa-mail-default-recipients): New subroutine broken out.
+ Handle epa-mail-aliases.
+
+2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add support for lexical variables to the debugger's `e' command.
+ * emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-*
+ vars, except for debugger-outer-match-data.
+ (debugger-frame-number): Move check for "on a function call" from
+ callers into it. Add `skip-base' argument.
+ (debugger-frame, debugger-frame-clear): Simplify accordingly.
+ (debugger-env-macro): Only reset the state stored in non-variables,
+ i.e. current-buffer and match-data.
+ (debugger-eval-expression): Rewrite using backtrace-eval.
+ * subr.el (internal--called-interactively-p--get-frame): Remove.
+ (called-interactively-p):
+ * emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new
+ `base' arg of backtrace-frame instead.
+
+2013-07-26 Glenn Morris <rgm@gnu.org>
+
+ * align.el (align-regexp): Doc fix. (Bug#14857)
+ (align-region): Explicit error if subexpression missing/does not match.
+
+ * simple.el (global-visual-line-mode):
+ Do not duplicate the mode lighter. (Bug#14858)
+
+2013-07-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (display-buffer): In display-buffer bind
+ split-window-keep-point to t, bug#14829.
+
+2013-07-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el: Rename internal "desktop-X" frame params to "desktop--X".
+ (desktop-filter-parameters-alist, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm, desktop--process-minibuffer-frames)
+ (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
+ Change accordingly.
+ (desktop--select-frame, desktop--sort-states, desktop-restore-frames):
+ Use pcase-let, pcase-let* to deobfuscate access to desktop--mini values.
+
+2013-07-25 Glenn Morris <rgm@gnu.org>
+
+ * dired-x.el (dired-mark-extension): Convert comment to doc string.
+
+2013-07-25 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--make-frame): Do not pass the `fullscreen'
+ parameter to modify-frame-parameters if the value has not changed;
+ this is a workaround for bug#14949.
+ (desktop--make-frame): On cl-delete-if call, check parameter name,
+ not full parameter.
+
+2013-07-30 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc.el (vc-ignore): New function.
+
+ * vc/vc-svn.el (vc-svn-ignore): New function.
+
+ * vc/vc-hg.el (vc-hg-ignore): New function.
+
+ * vc/vc-git.el (vc-git-ignore): New function.
+
+ * vc/vc-dir.el (vc-dir-mode-map): Add key binding for vc-dir-ignore
+ (vc-dir-ignore): New function.
+
+ * vc/vc-cvs.el (vc-cvs-ignore): New function.
+ (cvs-append-to-ignore): Move here from pcvs.el.
+
+ * vc/vc-bzr.el (vc-bzr-ignore): New function.
+
+ * vc/pcvs.el (vc-cvs): Require 'vc-cvs.
+
+2013-07-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restoring-frames-p): Return a true boolean.
+ (desktop-restore-frames): Warn when deleting an existing frame failed.
+
+2013-07-24 Glenn Morris <rgm@gnu.org>
+
+ * ffap.el (ffap-machine-p): Handle "not known" response. (Bug#14929)
+
+2013-07-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el (file-notify-supported-p):
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
+ Remove functions.
+
+ * autorevert.el (auto-revert-use-notify)
+ (auto-revert-notify-add-watch):
+ * net/tramp.el (tramp-file-name-for-operation):
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
+ Remove `file-notify-supported-p' entry.
+
+2013-07-24 Glenn Morris <rgm@gnu.org>
+
+ * printing.el: Replace all uses of deleted ps-windows-system,
+ ps-lp-system, ps-flatten-list with lpr- versions.
+
+2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/pcase.el (pcase--u1): Verify if self-quoting values can be
+ checked with memq (bug#14935).
+
+ * files.el (revert-buffer-function): Use a non-nil default.
+ (revert-buffer-preserve-modes): Declare var to
+ provide access to the `preserve-modes' argument.
+ (revert-buffer): Let-bind it.
+ (revert-buffer--default): New function, extracted from revert-buffer.
+
+2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lpr.el: Signal print errors more prominently.
+ (print-region-function): Don't default to nil.
+ (lpr-print-region): New function, extracted from print-region-1.
+ Check lpr's return value and signal an error in case of problem.
+ (print-region-1): Use it.
+ * ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-*
+ versions instead.
+ (ps-printer-name): Default to nil.
+ (ps-printer-name-option): Default to lpr-printer-switch.
+ (ps-print-region-function): Don't default to nil.
+ (ps-postscript-code-directory): Simplify default.
+ (ps-do-despool): Use lpr-print-region to properly check the outcome.
+ (ps-string-list, ps-eval-switch, ps-flatten-list)
+ (ps-flatten-list-1): Remove.
+ (ps-multibyte-buffer): Avoid setq.
+ * dos-w32.el (direct-print-region-helper): Use proper regexp operators.
+ (print-region-function, ps-print-region-function): Don't set them here.
+
+2013-07-24 Xue Fuqiao <xfq.free@gmail.com>
+
+ * ido.el (ido-fractionp, ido-cache-ftp-work-directory-time)
+ (ido-max-prospects, ido-mode, ido-max-file-prompt-width)
+ (ido-unc-hosts-cache, ido-max-directory-size, ido-max-dir-file-cache)
+ (ido-decorations): Doc fix.
+
+ * ansi-color.el: Fix old URL.
+
+2013-07-23 Michael R. Mauger <michael@mauger.com>
+
+ * progmodes/sql.el: Version 3.3
+ (sql-product-alist): Improve oracle :prompt-cont-regexp.
+ (sql-starts-with-prompt-re, sql-ends-with-prompt-re): New functions.
+ (sql-interactive-remove-continuation-prompt): Rewrite, use
+ functions above. Fix continuation prompt and complete output line
+ handling.
+ (sql-redirect-one, sql-execute): Use `read-only-mode' on
+ redirected output buffer.
+ (sql-mode): Restore deleted code (Bug#13591).
+
+2013-07-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-clear, desktop-list*): Fix previous change.
+
+2013-07-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-handle-file-notify-add-watch): New defun.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use it.
+
+2013-07-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-clear): Simplify; remove useless checks
+ against invalid buffer names.
+ (desktop-list*): Use cl-list*.
+ (desktop-buffer-info, desktop-create-buffer): Simplify.
+
+2013-07-23 Leo Liu <sdl.web@gmail.com>
+
+ * bookmark.el (bookmark-make-record): Restore NAME as a default
+ value. (Bug#14933)
+
+2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/autoload.el (autoload--setup-output): New function,
+ extracted from autoload--insert-text.
+ (autoload--insert-text): Remove.
+ (autoload--print-cookie-text): New function, extracted from
+ autoload--insert-cookie-text.
+ (autoload--insert-cookie-text): Remove.
+ (autoload-generate-file-autoloads): Adjust calls accordingly.
+
+ * winner.el (winner-hook-installed-p): Remove.
+ (winner-mode): Simplify accordingly.
+
+ * subr.el (add-to-list): Fix compiler-macro when `append' is
+ not constant. Don't use `cl-member' for the base case.
+
+ * progmodes/subword.el: Fix boundary case (bug#13758).
+ (subword-forward-regexp): Make it a constant. Wrap optional \\W in its
+ own group.
+ (subword-backward-regexp): Make it a constant.
+ (subword-forward-internal): Don't treat a trailing capital as the
+ beginning of a word.
+
+2013-07-22 Ari Roponen <ari.roponen@gmail.com> (tiny change)
+
+ * emacs-lisp/package.el (package-menu-mode): Don't modify the
+ global value of tabulated-list-revert-hook (bug#14930).
+
+2013-07-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el: Require 'cl-lib.
+ (desktop-before-saving-frames-functions): New hook.
+ (desktop--process-minibuffer-frames): Set desktop-mini parameter only
+ for frames being saved. Rename from desktop--save-minibuffer-frames.
+ (desktop-save-frames): Run hook desktop-before-saving-frames-functions.
+ Do not save frames with non-nil `desktop-dont-save' parameter.
+ Filter out deleted frames.
+ (desktop--find-frame): Use cl-find-if.
+ (desktop--select-frame): Use cl-(first|second|third) to access values
+ of desktop-mini.
+ (desktop--make-frame): Use cl-delete-if.
+ (desktop--sort-states): Fix sorting of minibuffer-owning frames.
+ (desktop-restore-frames): Use cl-(first|second|third) to access values
+ of desktop-mini. Look for visible frame at the end, not while
+ restoring frames.
+
+ * dired-x.el (dired-mark-unmarked-files, dired-virtual)
+ (dired-guess-default, dired-mark-sexp, dired-filename-at-point):
+ Use string-match-p, looking-at-p (bug#14927).
+
+2013-07-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-saved-frame-states):
+ Rename from desktop--saved-states; all users changed.
+ (desktop-save-frames): Rename from desktop--save-frames.
+ Do not save state to desktop file.
+ (desktop-save): Save desktop-saved-frame-states to desktop file
+ and reset to nil.
+ (desktop-restoring-frames-p): New function.
+ (desktop-restore-frames): Use it. Rename from desktop--restore-frames.
+ (desktop-read): Use desktop-restoring-frames-p. Do not try to fix
+ buffer-lists when restoring frames. Suggested by Martin Rudalics.
+
+ * desktop.el: Correctly restore iconified frames.
+ (desktop--filter-iconified-position): New function.
+ (desktop-filter-parameters-alist): Add entries for `top' and `left'.
+
+2013-07-20 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-delete-handler, gdb-stopped):
+ Let `message' do the formatting.
+ (def-gdb-preempt-display-buffer): Add explicit format.
+
+ * image-dired.el (image-dired-track-original-file):
+ Use with-current-buffer.
+ (image-dired-track-thumbnail): Use with-current-buffer.
+ Avoid changing point of wrong window.
+
+ * image-dired.el (image-dired-track-original-file):
+ Avoid changing point of wrong window. (Bug#14909)
+
+2013-07-20 Richard Copley <rcopley@gmail.com> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb-done-or-error):
+ Guard against "%" in gdb output. (Bug#14127)
+
+2013-07-20 Andreas Schwab <schwab@linux-m68k.org>
+
+ * progmodes/sh-script.el (sh-read-variable): Remove interactive spec.
+ (Bug#14826)
+
+ * international/mule.el (coding-system-iso-2022-flags): Fix last
+ change.
+
+2013-07-20 Kenichi Handa <handa@gnu.org>
+
+ * international/mule.el (coding-system-iso-2022-flags):
+ Add `8-bit-level-4'. (Bug#8522)
+
+2013-07-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-mouse-browse-url): New command and keystroke
+ (bug#14815).
+
+ * net/eww.el (eww-process-text-input): Allow inputting when the
+ point is at the start of the line, as the properties aren't
+ front-sticky.
+
+ * net/shr.el (shr-make-table-1): Ensure that we don't infloop on
+ degenerate widths.
+
+2013-07-19 Richard Stallman <rms@gnu.org>
+
+ * epa.el (epa-popup-info-window): Doc fix.
+
+ * subr.el (split-string): New arg TRIM.
+
+2013-07-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * frame.el (blink-cursor-timer-function, blink-cursor-suspend):
+ Add check for W32 (followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se).
+
+2013-07-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el (file-notify--library): Rename from
+ `file-notify-support'. Do not autoload. Adapt all uses.
+ (file-notify-supported-p): New defun.
+
+ * autorevert.el (auto-revert-use-notify):
+ Use `file-notify-supported-p' instead of `file-notify-support'.
+ Adapt docstring.
+ (auto-revert-notify-add-watch): Use `file-notify-supported-p'.
+
+ * net/tramp.el (tramp-file-name-for-operation):
+ Add `file-notify-supported-p'.
+
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p):
+ New defun.
+ (tramp-sh-file-name-handler-alist): Add it as handler for
+ `file-notify-supported-p '.
+
+ * net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * net/tramp-smb.el (tramp-smb-file-name-handler-alist):
+ Add `ignore' as handler for `file-notify-*' functions.
+
+2013-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-partial, line-move): Don't start vscroll or
+ scroll-up if the current line is not taller than the window.
+ (Bug#14881)
+
+2013-07-16 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Do not
+ highlight question marks in the method names as strings.
+ (ruby-block-beg-keywords): Inline.
+ (ruby-font-lock-keyword-beg-re): Extract from
+ `ruby-font-lock-keywords'.
+
+2013-07-16 Jan Djärv <jan.h.d@swipnet.se>
+
+ * frame.el (blink-cursor-blinks): New defcustom.
+ (blink-cursor-blinks-done): New defvar.
+ (blink-cursor-start): Set blink-cursor-blinks-done to 1.
+ (blink-cursor-timer-function): Check if number of blinks has been
+ done on X and NS.
+ (blink-cursor-suspend, blink-cursor-check): New defuns.
+
+2013-07-15 Glenn Morris <rgm@gnu.org>
+
+ * edmacro.el (edmacro-format-keys): Fix previous change.
+
+2013-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * shell.el (explicit-bash-args): Remove obsolete hack for Bash 1.x.
+ The hack didn't work outside English locales anyway.
+
+2013-07-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * simple.el (define-alternatives): Rename from alternatives-define,
+ per RMS' suggestion.
+
+2013-07-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-frames): Change default to t.
+ (desktop-restore-in-current-display): Now offer more options.
+ (desktop-restoring-reuses-frames): New customization option.
+ (desktop--saved-states): Doc fix.
+ (desktop-filter-parameters-alist): New variable, renamed and expanded
+ from desktop--excluded-frame-parameters.
+ (desktop--target-display): New variable.
+ (desktop-switch-to-gui-p, desktop-switch-to-tty-p)
+ (desktop--filter-tty*, desktop--filter-*-color)
+ (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm)
+ (desktop-restore-in-original-display-p): New functions.
+ (desktop--filter-frame-parms): Use new desktop-filter-parameters-alist.
+ (desktop--save-minibuffer-frames): New function, inspired by a similar
+ function from Martin Rudalics.
+ (desktop--save-frames): Call it; play nice with desktop-globals-to-save.
+ (desktop--restore-in-this-display-p): Remove.
+ (desktop--find-frame): Rename from desktop--find-frame-in-display
+ and add predicate argument.
+ (desktop--make-full-frame): Remove, integrated into desktop--make-frame.
+ (desktop--reuse-list): New variable.
+ (desktop--select-frame, desktop--make-frame, desktop--sort-states):
+ New functions.
+ (desktop--restore-frames): Add support for "minibuffer-special" frames.
+
+2013-07-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-vc-registered): Use `ignore-error'.
+
+2013-07-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Highlight conversion methods on Kernel.
+
+2013-07-13 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Label CASE 13
+ and comment it out. This out-commenting enables certain C++
+ declarations to be parsed correctly.
+
+2013-07-13 Eli Zaretskii <eliz@gnu.org>
+
+ * international/mule.el (define-coding-system): Doc fix.
+
+ * simple.el (default-font-height): Don't call font-info if the
+ frame's default font didn't change since the frame was created.
+ (Bug#14838)
+
+2013-07-13 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-file-name): Guard against non-symbol value.
+
+2013-07-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-imenu--build-tree): Fix corner case
+ in nested defuns.
+
+2013-07-13 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-exhibit): Handle ido-enter-matching-directory before
+ ido-set-matches call. (Bug#6852)
+
+2013-07-12 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-percent-literals-beg-re)
+ (ruby-syntax-expansion-allowed-p): Support array of symbols, for
+ Ruby 2.0.
+ (ruby-font-lock-keywords): Distinguish calls to functions with
+ module-like names from module references. Highlight character
+ literals.
+
+2013-07-12 Sergio Durigan Junior <sergiodj@riseup.net> (tiny change)
+
+ * progmodes/gdb-mi.el (gdb-strip-string-backslash): New function.
+ (gdb-send): Handle continued commands. (Bug#14847)
+
+2013-07-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop--v2s): Remove unused local variable.
+ (desktop-save-buffer): Make defvar-local; adjust docstring.
+ (desktop-auto-save-timeout, desktop-owner): Use ignore-errors.
+ (desktop-clear, desktop-save-buffer-p): Use string-match-p.
+
+2013-07-12 Andreas Schwab <schwab@linux-m68k.org>
+
+ * emacs-lisp/map-ynp.el (map-y-or-n-p): Fix last change.
+
+2013-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (next-line, previous-line): Document TRY-VSCROLL and ARG.
+ (Bug#14842)
+
+2013-07-12 Glenn Morris <rgm@gnu.org>
+
+ * doc-view.el: Require cl-lib at runtime too.
+ (doc-view-remove-if): Remove.
+ (doc-view-search-next-match, doc-view-search-previous-match):
+ Use cl-remove-if.
+
+ * edmacro.el: Require cl-lib at runtime too.
+ (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq.
+ (edmacro-mismatch, edmacro-subseq): Remove.
+
+ * shadowfile.el: Require cl-lib.
+ (shadow-remove-if): Remove.
+ (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo):
+ Use cl-remove-if.
+
+ * wid-edit.el: Require cl-lib.
+ (widget-choose): Use cl-remove-if.
+ (widget-remove-if): Remove.
+
+ * progmodes/ebrowse.el: Require cl-lib at runtime too.
+ (ebrowse-delete-if-not): Remove.
+ (ebrowse-browser-buffer-list, ebrowse-member-buffer-list)
+ (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list):
+ Use cl-delete-if-not.
+
+2013-07-12 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq)
+ (cl-the, cl-declare, cl-defstruct): Fix typos in docstrings.
+
+2013-07-12 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (dired-do-copy, dired): Set 'ido property. (Bug#11954)
+
+2013-07-11 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/edebug.el: Require cl-lib at run-time too.
+ (edebug-gensym-index, edebug-gensym):
+ Remove reimplementation of cl-gensym.
+ (edebug-make-enter-wrapper, edebug-make-form-wrapper): Use cl-gensym.
+
+ * thumbs.el: Require cl-lib at run-time too.
+ (thumbs-gensym-counter, thumbs-gensym):
+ Remove reimplementation of cl-gensym.
+ (thumbs-temp-file): Use cl-gensym.
+
+ * emacs-lisp/ert.el: Require cl-lib at runtime too.
+ (ert--cl-do-remf, ert--remprop, ert--remove-if-not)
+ (ert--intersection, ert--set-difference, ert--set-difference-eq)
+ (ert--union, ert--gensym-counter, ert--gensym-counter)
+ (ert--coerce-to-vector, ert--remove*, ert--string-position)
+ (ert--mismatch, ert--subseq): Remove reimplementations of cl funcs.
+ (ert-make-test-unbound, ert--expand-should-1)
+ (ert--expand-should, ert--should-error-handle-error)
+ (should-error, ert--explain-equal-rec)
+ (ert--plist-difference-explanation, ert-select-tests)
+ (ert--make-stats, ert--remove-from-list, ert--string-first-line):
+ Use cl-lib functions rather than reimplementations.
+
+2013-07-11 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-methods): Extend docstring.
+ (tramp-connection-timeout): New defcustom.
+ (tramp-error-with-buffer): Reset timestamp only when appropriate.
+ (with-tramp-progress-reporter): Simplify.
+ (tramp-process-actions): Improve messages.
+
+ * net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+ * net/tramp-sh.el (tramp-maybe-open-connection):
+ Use `tramp-connection-timeout'.
+ (tramp-methods) <su, sudo, ksu>: Add method specific timeouts.
+ (Bug#14808)
+
+2013-07-11 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-file-name): Conform to the requirements of
+ read-file-name. (Bug#11861)
+ (ido-read-directory-name): Conform to the requirements of
+ read-directory-name.
+
+2013-07-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * subr.el (delay-warning): New function.
+
+2013-07-10 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (default-line-height): New function.
+ (line-move-partial, line-move): Use it instead of computing the
+ line height inline.
+ (line-move-partial): Always compute ROWH. If the last line is
+ partially-visible, but its text is completely visible, allow
+ cursor to enter such a partially-visible line.
+
+2013-07-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve error messages. (Bug#14808)
+
+ * net/tramp.el (tramp-current-connection): New defvar, moved from
+ tramp-sh.el.
+ (tramp-message-show-progress-reporter-message): Remove, not
+ needed anymore.
+ (tramp-error-with-buffer): Show message in minibuffer.
+ Discard input before waiting. Reset connection timestamp.
+ (with-tramp-progress-reporter): Improve messages.
+ (tramp-process-actions): Use progress reporter. Delete process in
+ case of error. Improve messages.
+
+ * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case.
+ Call `tramp-error-with-buffer' with vector and buffer.
+ (tramp-current-connection): Remove.
+ (tramp-maybe-open-connection): The car of
+ `tramp-current-connection' are the first 3 slots of the vector.
+
+2013-07-10 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el (cfengine3-indent-line): Do not indent
+ inside continued strings.
+
+2013-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Timestamp fixes for undo (Bug#14824).
+ * files.el (clear-visited-file-modtime): Move here from fileio.c.
+
+2013-07-10 Leo Liu <sdl.web@gmail.com>
+
+ * files.el (require-final-newline): Allow safe local value.
+ (Bug#14834)
+
+2013-07-09 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-directory-name): Handle fallback.
+ (ido-read-file-name): Update DIR to ido-current-directory.
+ (Bug#1516)
+ (ido-add-virtual-buffers-to-list): Robustify. (Bug#14552)
+
+2013-07-09 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove extra
+ "autoload". Remove "warn lower camel case" section, previously
+ commented out. Highlight negation char. Do not highlight the
+ target in singleton method definitions.
+
+2013-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * faces.el (tty-setup-hook): Declare the hook.
+
+ * emacs-lisp/pcase.el (pcase--split-pred): Add `vars' argument to try
+ and detect when a guard/pred depends on local vars (bug#14773).
+ (pcase--u1): Adjust caller.
+
+2013-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-partial, line-move): Account for
+ line-spacing.
+ (line-move-partial): Avoid setting vscroll when the last
+ partially-visible line in window is of default height.
+
+2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-map): Reinstate the `u' key binding, since it's
+ been used a while.
+
+2013-07-07 Juanma Barranquero <lekktu@gmail.com>
+
+ * subr.el (read-quoted-char): Remove unused local variable `char'.
+
+2013-07-07 Michael Kifer <kifer@cs.stonybrook.edu>
+
+ * vc/ediff.el (ediff-version): Version update.
+ (ediff-files-command, ediff3-files-command, ediff-merge-command)
+ (ediff-merge-with-ancestor-command, ediff-directories-command)
+ (ediff-directories3-command, ediff-merge-directories-command)
+ (ediff-merge-directories-with-ancestor-command): New functions.
+ All are command-line interfaces to ediff: to facilitate calling
+ Emacs with the appropriate ediff functions invoked.
+
+ * emulation/viper-cmd.el (viper-del-forward-char-in-insert):
+ New function.
+ (viper-save-kill-buffer): Check if buffer is modified.
+
+ * emulation/viper.el (viper-version): Version update.
+ (viper-emacs-state-mode-list): Add egg-status-buffer-mode.
+
+2013-07-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * faces.el (tty-run-terminal-initialization): Run new tty-setup-hook.
+ * emulation/viper-cmd.el (viper-envelop-ESC-key): Remove function.
+ (viper-intercept-ESC-key): Simplify.
+ * emulation/viper-keym.el (viper-ESC-key): Make it a constant,
+ don't use kbd.
+ * emulation/viper.el (viper--tty-ESC-filter, viper--lookup-key)
+ (viper-catch-tty-ESC, viper-uncatch-tty-ESC)
+ (viper-setup-ESC-to-escape): New functions.
+ (viper-go-away, viper-set-hooks): Call viper-setup-ESC-to-escape.
+ (viper-set-hooks): Do not modify flyspell-mode-hook. (Bug#13793)
+
+2013-07-07 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (default-font-height, window-screen-lines):
+ New functions.
+ (line-move, line-move-partial): Use them instead of
+ frame-char-height and window-text-height. This makes scrolling
+ text smoother when the buffer's default face uses a font that is
+ different from the frame's default font.
+
+2013-07-06 Jan Djärv <jan.h.d@swipnet.se>
+
+ * files.el (write-file): Do not display confirm dialog for NS,
+ it does its own dialog, which can't be canceled (Bug#14578).
+
+2013-07-06 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-partial): Adjust the row returned by
+ posn-at-point for the current window-vscroll. (Bug#14567)
+
+2013-07-06 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-file-gvfs-monitor-dir-process-filter)
+ (tramp-sh-file-inotifywait-process-filter): Handle file names with
+ spaces.
+
+2013-07-06 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window-state-put-stale-windows): New variable.
+ (window--state-put-2): Save list of windows without matching buffer.
+ (window-state-put): Remove "bufferless" windows if possible.
+
+2013-07-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * simple.el (alternatives-define): Remove leftover :group keyword.
+ Tweak docstring.
+
+2013-07-06 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-use-virtual-buffers): Allow new value 'auto.
+ (ido-enable-virtual-buffers): New variable.
+ (ido-buffer-internal, ido-toggle-virtual-buffers)
+ (ido-make-buffer-list): Use it.
+ (ido-exhibit): Support turning on and off virtual buffers
+ automatically.
+
+2013-07-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * simple.el (alternatives-define): New macro.
+
+2013-07-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (read-quoted-char): Use read-key.
+ (sit-for): Let read-event decode tty input (bug#14782).
+
+2013-07-05 Stephen Berman <stephen.berman@gmx.net>
+
+ * calendar/todo-mode.el: Add handling of file deletion, both by
+ mode command and externally. Fix various related bugs.
+ Clarify Commentary and improve some documentation strings and code.
+ (todo-delete-file): New command.
+ (todo-check-file): New function.
+ (todo-show): Handle external deletion of the file we're trying to
+ show (bug#14688). Replace called-interactively-p by an optional
+ prefix argument to avoid problematic interaction with catch form
+ when byte compiled (bug#14702).
+ (todo-quit): Handle external deletion of the archive's todo file.
+ Make sure the buffer that was visiting the archive file is still
+ live before trying to bury it.
+ (todo-category-completions): Handle external deletion of any
+ category completion files.
+ (todo-jump-to-category, todo-basic-insert-item): Recalculate list
+ of todo files, in case of external deletion.
+ (todo-add-file): Replace unnecessary setq by let-binding.
+ (todo-find-archive): Check whether there are any archives.
+ Replace unnecessary setq by let-binding.
+ (todo-archive-done-item): Use find-file-noselect to get the
+ archive buffer whether or not the archive already exists.
+ Remove superfluous code. Use file size instead of buffer-file-name to
+ check if the archive is new; if it is, update list of archives.
+ (todo-default-todo-file): Allow nil to be a valid value for when
+ there are no todo files.
+ (todo-reevaluate-default-file-defcustom): Use corrected definition
+ of todo-default-todo-file.
+ (todo-key-bindings-t+a+f): Add key binding for todo-delete-file.
+ (todo-delete-category, todo-show-categories-table)
+ (todo-category-number): Clarify comment.
+ (todo-filter-items): Clarify documentation string.
+ (todo-show-current-file, todo-display-as-todo-file)
+ (todo-reset-and-enable-done-separator): Tweak documentation string.
+ (todo-done-separator): Make separator length window-width, since
+ bug#2749 is now fixed.
+
+2013-07-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch):
+ Support both "gvfs-monitor-dir" and "inotifywait".
+ (tramp-sh-file-inotifywait-process-filter): Rename from
+ `tramp-sh-file-notify-process-filter'.
+ (tramp-sh-file-gvfs-monitor-dir-process-filter)
+ (tramp-get-remote-gvfs-monitor-dir): New defuns.
+
+2013-07-05 Leo Liu <sdl.web@gmail.com>
+
+ * autoinsert.el (auto-insert-alist): Default to lexical-binding.
+
+2013-07-04 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * frame.el (display-pixel-height, display-pixel-width)
+ (display-mm-height, display-mm-width): Mention behavior on
+ multi-monitor setups in docstrings.
+ (w32-display-monitor-attributes-list): Declare function.
+ (display-monitor-attributes-list): Use it.
+
+2013-07-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * filenotify.el: New package.
+
+ * autorevert.el (top): Require filenotify.el.
+ (auto-revert-notify-enabled): Remove. Use `file-notify-support'
+ instead.
+ (auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
+ (auto-revert-notify-handler): Use `file-notify-*' functions.
+
+ * subr.el (file-notify-handle-event): Move function to filenotify.el.
+
+ * net/tramp.el (tramp-file-name-for-operation):
+ Handle `file-notify-add-watch' and `file-notify-rm-watch'.
+
+ * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add handler
+ for `file-notify-add-watch' and `file-notify-rm-watch'.
+ (tramp-process-sentinel): Improve trace.
+ (tramp-sh-handle-file-notify-add-watch)
+ (tramp-sh-file-notify-process-filter)
+ (tramp-sh-handle-file-notify-rm-watch)
+ (tramp-get-remote-inotifywait): New defuns.
+
+2013-07-03 Juri Linkov <juri@jurta.org>
+
+ * buff-menu.el (Buffer-menu-multi-occur): Add args and move the
+ call of `occur-read-primary-args' to interactive spec.
+
+ * ibuffer.el (ibuffer-mode-map): Bind "M-s a C-o" to
+ `ibuffer-do-occur' like in buff-menu.el. (Bug#14673)
+
+2013-07-03 Matthias Meulien <orontee@gmail.com>
+
+ * buff-menu.el (Buffer-menu-mode-map): Bind "M-s a C-o" to
+ `Buffer-menu-multi-occur'. Add it to the menu.
+ (Buffer-menu-mode): Document it in docstring.
+ (Buffer-menu-multi-occur): New command. (Bug#14673)
+
+2013-07-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more
+ keywords and built-ins.
+
+2013-07-03 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (y-or-n-p): Handle empty prompts. (Bug#14770)
+
+ Make info-xref checks case-sensitive by default
+ * info.el (Info-find-node, Info-find-in-tag-table)
+ (Info-find-node-in-buffer, Info-find-node-2, Info-goto-node):
+ Add option for exact case matching of nodes.
+ * info-xref.el (info-xref): New custom group.
+ (info-xref-case-fold): New option.
+ (info-xref-goto-node-p): Pass info-xref-case-fold to Info-goto-node.
+
+2013-07-03 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-delete-file-at-head): Respect delete-by-moving-to-trash.
+
+2013-07-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-move-to-block): When we're at a
+ middle of block statement initially, lower the depth. Remove
+ FIXME comment, not longer valid. Remove middle of block statement
+ detection, no need to do that anymore since we've been using
+ `ruby-parse-region' here.
+
+2013-07-02 Jan Djärv <jan.h.d@swipnet.se>
+
+ * term/ns-win.el (display-format-alist): Use .* (Bug#14765).
+
+2013-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * wid-edit.el (widget-default-get): Don't modify widget (Bug#14738).
+
+2013-07-01 Juanma Barranquero <lekktu@gmail.com>
+
+ * desktop.el (desktop-restore-frames): Rename from desktop-save-windows.
+ (desktop-restore-in-current-display): New customization option.
+ (desktop--excluded-frame-parameters): Add `font'.
+ (desktop--save-frames): Rename from desktop--save-windows.
+ (desktop--restore-in-this-display-p): New function.
+ (desktop--make-full-frame): Remove unwanted width/height from
+ full(width|height) frames.
+ (desktop--restore-frames): Rename from desktop--restore-windows.
+ Obey desktop-restore-current-display. Do not delete old frames or
+ select a new frame unless we were able to restore at least one frame.
+
+2013-06-30 Michal Nazarewicz <mina86@mina86.com>
+
+ * files.el (find-file-noselect): Simplify conditional expression.
+
+ * textmodes/remember.el (remember-append-to-file):
+ Don't mix `find-buffer-visiting' and `get-file-buffer'.
+
+ Add `remember-notes' function to store random notes across Emacs
+ restarts.
+ * textmodes/remember.el (remember-data-file): Add :set callback to
+ affect notes buffer (if any).
+ (remember-notes): New command.
+ (remember-notes-buffer-name, bury-remember-notes-on-kill):
+ New defcustoms for the `remember-notes' function.
+ (remember-notes-save-and-bury-buffer): New command.
+ (remember-notes-mode-map): New variable.
+ (remember-mode): New minor mode.
+ (remember-notes--kill-buffer-query): New function.
+ * startup.el (initial-buffer-choice): Add notes to custom type.
+
+2013-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ * bindings.el (right-char, left-char): Don't call sit-for, this is
+ no longer needed. Use arithmetic comparison only for numerical
+ arguments.
+
+ * international/mule-cmds.el (select-safe-coding-system):
+ Handle the case of FROM being a string correctly. (Bug#14755)
+
+2013-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-make-table-1): Add a sanity check that allows
+ progression on degenerate tables.
+ (shr-rescale-image): ImageMagick animated images currently don't work.
+
+2013-06-30 Juanma Barranquero <lekktu@gmail.com>
+
+ Some fixes and improvements for desktop frame restoration.
+ It is still experimental and disabled by default.
+ * desktop.el (desktop--save-windows): Put the selected frame at
+ the head of the list.
+ (desktop--make-full-frame): New function.
+ (desktop--restore-windows): Try to re-select the frame that was
+ selected upon saving. Do not abort if some frames fail to restore,
+ just show an error message and continue. Set up maximized frames
+ so they have default non-maximized dimensions.
+
+2013-06-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-function):
+ Don't start heredoc inside a string or comment.
+
+2013-06-29 Eli Zaretskii <eliz@gnu.org>
+
+ * bindings.el (visual-order-cursor-movement): New defcustom.
+ (right-char, left-char): Provide visual-order cursor motion by
+ calling move-point-visually. Update the doc strings.
+
+2013-06-28 Kenichi Handa <handa@gnu.org>
+
+ * international/mule.el (define-coding-system): New coding system
+ properties :inhibit-null-byte-detection,
+ :inhibit-iso-escape-detection, and :prefer-utf-8.
+ (set-buffer-file-coding-system): If :charset-list property of
+ CODING-SYSTEM is `emacs', do not check if CODING-SYSTEM is
+ appropriate for setting.
+
+ * international/mule-cmds.el (select-safe-coding-system):
+ If DEFAULT-CODING-SYSTEM is prefer-utf-8 and the buffer contains
+ multibyte characters, return utf-8 (or one of its siblings).
+
+ * international/mule-conf.el (prefer-utf-8): New coding system.
+ (file-coding-system-alist): Use prefer-utf-8 as default for Elisp
+ files.
+
+2013-06-28 Ivan Kanis <ivan@kanis.fr>
+
+ * net/shr.el (shr-render-region): New function.
+
+ * net/eww.el: Autoload `eww-browse-url'.
+
+2013-06-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Adapt to `package-desc-version' being a list.
+ Use `package--ac-desc-version' to retrieve version from a package
+ archive element.
+
+2013-06-27 Juanma Barranquero <lekktu@gmail.com>
+
+ New experimental feature to save&restore window and frame setup.
+ * desktop.el (desktop-save-windows): New defcustom.
+ (desktop--saved-states): New var.
+ (desktop--excluded-frame-parameters): New defconst.
+ (desktop--filter-frame-parms, desktop--find-frame-in-display)
+ (desktop--restore-windows, desktop--save-windows): New functions.
+ (desktop-save): Call `desktop--save-windows'.
+ (desktop-read): Call `desktop--restore-windows'.
+
+2013-06-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (add-face-text-property): Remove compat definition.
+
+2013-06-27 Stephen Berman <stephen.berman@gmx.net>
+
+ * info.el (Info-try-follow-nearest-node): Move search for footnote
+ above search for node name to prevent missing a footnote (bug#14717).
+
+2013-06-27 Stephen Berman <stephen.berman@gmx.net>
+
+ * obsolete/otodo-mode.el: Add obsolescence info to file header.
+
+2013-06-27 Leo Liu <sdl.web@gmail.com>
+
+ * net/eww.el (eww-read-bookmarks): Check file size.
+
+2013-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--defalias-fset): Move advice back to
+ advice--pending if newdef is nil or an autoload (bug#13820).
+ (advice-mapc): New function.
+
+2013-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-mode): Undo isn't necessary in eww buffers,
+ probably.
+ (eww-mode-map): Add a menu bar.
+ (eww-add-bookmark): New command.
+ (eww-bookmark-mode): New mode and commands.
+ (eww-add-bookmark): Remove newlines from the title.
+ (eww-bookmark-browse): Don't bug out if it's the only window.
+
+2013-06-26 Glenn Morris <rgm@gnu.org>
+
+ * htmlfontify.el (hfy-triplet): Handle unspecified-fg, bg.
+ (hfy-size): Handle ttys. (Bug#14668)
+
+ * info-xref.el: Update for Texinfo 5 change in *note format.
+ (info-xref-node-re, info-xref-note-re): New constants.
+ (info-xref-check-buffer): Use info-xref-note-re.
+
+2013-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (set-variable): Use read-from-minibuffer (bug#14710).
+
+ * emacs-lisp/package.el (package--add-to-archive-contents): Add missing
+ nil terminate the loop (bug#14718).
+
+2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el: Rework history traversal. When going forward/back,
+ put these actions into the history, too, so that they can be
+ replayed.
+ (eww-render): Move the history reset to the correct buffer.
+
+2013-06-25 Juri Linkov <juri@jurta.org>
+
+ * files-x.el (modify-dir-local-variable): Change the header comment
+ in the file with directory local variables. (Bug#14692)
+
+ * files-x.el (read-file-local-variable-value): Add `default'.
+ (Bug#14710)
+
+2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-make-unique-file-name): Create a unique file
+ name before saving to entering `y' accidentally asynchronously.
+
+2013-06-25 Ivan Kanis <ivan@kanis.fr>
+
+ * net/eww.el (eww-download): New command and keystroke.
+
+2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-copy-page-url): Change name of command.
+
+ * net/shr.el (shr-map): Change `shr-copy-url' from `u' to `w' to
+ be more consistent with Info and dired.
+
+ * net/eww.el (eww-mode-map): Ditto.
+
+2013-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el: Use lexical-binding. Include obsolete
+ packages from archives.
+ (package-archive-contents): Change format; include obsolete packages.
+ (package-desc): Use `dir' to mark builtin packages.
+ (package--from-builtin): Set the `dir' field to `builtin'.
+ (generated-autoload-file, version-control): Declare.
+ (package-compute-transaction): Change first arg and return value to be
+ lists of package-descs. Adjust to new package-archive-contents format.
+ (package--add-to-archive-contents): Adjust to new
+ package-archive-contents format.
+ (package-download-transaction): Arg is now a list of package-descs.
+ (package-install): If `pkg' is a package name, pass it as
+ a requirement, so it is subject to the usual (e.g. disabled) checks.
+ (describe-package): Accept package-desc as well.
+ (describe-package-1): Describe a specific package-desc. Add links to
+ other package-descs for the same package name.
+ (package-menu-describe-package): Pass the actual package-desc.
+ (package-menu-mode): Add to tabulated-list-revert-hook so revert-buffer
+ works correctly.
+ (package-desc-status): New function.
+ (package-menu--refresh): New function, extracted
+ from package-menu--generate.
+ (package-menu--generate): Use it.
+ (package-delete): Update package-alist.
+ (package-menu-execute): Don't call package-initialize.
+
+ * progmodes/idlw-toolbar.el, progmodes/idlw-shell.el,
+ progmodes/idlw-help.el, progmodes/idlw-complete-structtag.el,
+ progmodes/ebnf-yac.el, progmodes/ebnf-otz.el, progmodes/ebnf-iso.el,
+ progmodes/ebnf-ebx.el, progmodes/ebnf-dtd.el, progmodes/ebnf-bnf.el,
+ progmodes/ebnf-abn.el, emacs-lisp/package-x.el, emacs-lisp/cl-seq.el,
+ emacs-lisp/cl-macs.el: Neuter the "Version:" header.
+
+2013-06-25 Martin Rudalics <rudalics@gmx.at>
+
+ * window.el (window--state-get-1): Workaround for bug#14527.
+ http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00941.html
+
+2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-back-url): Implement the history by stashing all
+ the data into a list.
+ (eww-forward-url): Allow going forward in the history, too.
+
+2013-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files-x.el (read-file-local-variable-value): Use read-from-minibuffer
+ for values and use read--expression for expressions (bug#14710).
+ (read-file-local-variable): Avoid setq.
+ (read-file-local-variable-mode): Use minor-mode-list.
+
+2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * textmodes/bibtex.el (bibtex-generate-url-list): Add support
+ for DOI URLs.
+
+2013-06-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * textmodes/bibtex.el (bibtex-mode, bibtex-set-dialect):
+ Update imenu-support when dialect changes.
+
+2013-06-25 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-internal): Allow forward slash on windows.
+
+2013-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww): Start of strings is \\`, not ^.
+
+2013-06-24 Ivan Kanis <ivan@kanis.fr>
+
+ * net/shr.el (shr-browse-url): Fix interactive spec.
+
+ * net/eww.el (eww): Add a trailing slash to domain names.
+
+2013-06-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * faces.el (face-spec-recalc): Revert part of 2013-06-23T20:29:18Z!lekktu@gmail.com (bug#14705).
+
+2013-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-browse-url): Use an external browser if given a
+ prefix.
+
+ * net/eww.el (eww-external-browser): Move to shr.
+
+2013-06-24 Ivan Kanis <ivan@kanis.fr>
+
+ * net/eww.el (eww): Work more correctly for file: URLs.
+ (eww-detect-charset): Allow quoted charsets.
+ (eww-yank-page-url): New command and keystroke.
+
+2013-06-24 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-make-context): Check if PROTOCOL is valid; embed the
+ file name of gpg executable.
+ (epg-context-program): New function.
+ (epg-context-home-directory): New function.
+ (epg-context-set-program): New function.
+ (epg-context-set-home-directory): New function.
+ (epg--start): Use `epg-context-program' instead of
+ 'epg-gpg-program'.
+ (epg--list-keys-1): Likewise.
+
+2013-06-24 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-read-internal): Fix bug#14620.
+
+2013-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * faces.el (face-documentation): Simplify.
+ (read-face-attribute, tty-find-type, x-resolve-font-name):
+ Use `string-match-p'.
+ (list-faces-display): Use `string-match-p'. Simplify.
+ (face-spec-recalc): Check face to avoid face alias loops.
+ (read-color): Use `string-match-p' and non-capturing parenthesis.
+
+2013-06-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-rescale-image): Use the new
+ :max-width/:max-height functionality.
+
+2013-06-23 Ivan Kanis <ivan@kanis.fr>
+
+ * net/eww.el (eww-search-prefix): New variable.
+ (eww): Use it.
+ (eww-external-browser): New variable.
+ (eww-mode-map): New keystroke.
+ (eww-browse-with-external-browser): New command.
+
+ * net/eww.el: Bind `C-c C-c' to "submit" in all form keymaps.
+
+2013-06-23 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-init-header):
+ Don't skip aligning the next header field when padding is 0;
+ otherwise, field width is not respected unless the title is as
+ wide as the field.
+
+2013-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-el-version): Remove.
+ (package-process-define-package): Fix inf-loop.
+ (package-install): Allow symbols as arguments again.
+
+2013-06-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `catch',
+ add some more keyword-like methods.
+ http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00911.html
+
+2013-06-22 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs-buffer-show-mark): Make defvar-local.
+ (bs-mode): Use setq-local.
+
+ * emacs-lock.el (emacs-lock-mode, emacs-lock--old-mode)
+ (emacs-lock--try-unlocking): Make defvar-local.
+
+2013-06-22 Glenn Morris <rgm@gnu.org>
+
+ * play/cookie1.el (cookie-apropos): Minor simplification.
+
+ * progmodes/gdb-mi.el (gdb-mapcar*): Remove, replace with cl-mapcar.
+
+2013-06-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (auto-mode-alist): Do not use
+ `regexp-opt', it breaks the build during dumping.
+
+2013-06-21 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-font-lock-keywords):
+ Highlight keyword-like methods on Kernel and Module with
+ font-lock-builtin-face.
+ (auto-mode-alist): Consolidate different entries into one regexp
+ and add more *file-s.
+
+2013-06-21 Stephen Berman <stephen.berman@gmx.net>
+
+ * obsolete/otodo-mode.el: Move and rename from calendar/todo-mode.el.
+
+ * calendar/diary-lib.el (diary-goto-entry-function): New variable.
+ (diary-entry): Use it in the action of this button type instead of
+ diary-goto-entry.
+
+ * calendar/todo-mode.el: New version.
+ (todo-add-category): Append new category to end of file and give
+ it the highest number, instead of putting it at the beginning and
+ giving it 0. Incorporate noninteractive functionality.
+ (todo-forward-category): Adapt to 1-based category numbering.
+ Allow skipping over archived categories.
+ (todo-backward-category): Derive from todo-forward-category.
+ (todo-backward-item, todo-forward-item): Make noninteractive and
+ delegate interactive part to new commands. Make sensitive to done items.
+ (todo-categories): Make value an alist of category names and
+ vectors of item counts.
+ (todo-category-beg): Make a defconst.
+ (todo-category-number): Use 1 instead of 0 as initial value.
+ (todo-category-select): Make sensitive to overlays, optional item
+ highlighting and done items.
+ (todo-delete-item): Make sensitive to overlays and marked and done items.
+ (todo-edit-item): Make sensitive to overlays and editing of
+ date/time header optional. Add format checks.
+ (todo-edit-multiline): Rename to todo-edit-multiline-item. Make a
+ no-op if point is not on an item. Advertise using todo-edit-quit.
+ (todo-edit-mode): Make sensitive to new format, font-locking, and
+ multiple todo files.
+ (todo-insert-item, todo-insert-item-here): Derive from
+ todo-basic-insert-item and extend functionality.
+ (todo-item-end, todo-item-start): Make sensitive to done items.
+ (todo-item-string): Don't return text properties. Restore point.
+ (todo-jump-to-category): Make sensitive to multiple todo files and
+ todo archives. Use extended category completion.
+ (todo-lower-item, todo-raise-item): Rename to *-priority and
+ derive from todo-set-item-priority.
+ (todo-mode): Derive from special-mode. Make sensitive to new
+ format, font-locking and multiple todo files. Make read-only.
+ (todo-mode-map): Don't suppress digit keys, so they can supply
+ prefix arguments. Add many new key bindings.
+ (todo-prefix): Insert as an overlay instead of file text.
+ Change semantics from diary date expression to purely visual mark.
+ (todo-print): Rename to todo-print-buffer. Make buffer display
+ features printable. Remove option to restrict number of items
+ printed. Add option to print to file.
+ (todo-print-function): Rename to todo-print-buffer-function.
+ (todo-quit): Extend to handle exiting new todo modes.
+ (todo-remove-item): Make sensitive to overlays.
+ (todo-save): Extend to buffers of filtered items.
+ (todo-show): Make sensitive to done items, multiple todo files and
+ new todo modes. Offer to convert legacy todo file before creating
+ first new todo file.
+ (todo-show-priorities): Rename to todo-top-priorities.
+ Change semantics of value 0.
+ (todo-top-priorities): Rename to todo-filter-top-priorities,
+ derive from todo-filter-items and extend functionality.
+ (todo-save-top-priorities): Rename to todo-save-filtered-items-buffer
+ and extend functionality to other types of filtered items.
+ (todo-add-item-non-interactively, todo-ask-p, todo-cat-slct)
+ (todo-category-end, todo-category-sep, todo-cats, todo-cmd-back)
+ (todo-cmd-done, todo-cmd-edit, todo-cmd-forw, todo-cmd-inst)
+ (todo-cmd-kill, todo-cmd-lowr, todo-cmd-next, todo-cmd-prev)
+ (todo-cmd-rais, todo-cmd-save, todo-completing-read, todo-cp)
+ (todo-edit-mode-hook, todo-entry-prefix-function)
+ (todo-entry-timestamp-initials, todo-file-do, todo-file-done)
+ (todo-file-item, todo-file-top, todo-header, todo-initial-setup)
+ (todo-initials, todo-insert-threshold, todo-item-string-start)
+ (todo-line-string, todo-menu, todo-mode-hook)
+ (todo-more-important-p, todo-previous-answer, todo-previous-line)
+ (todo-print-priorities, todo-remove-separator)
+ (todo-save-top-priorities-too, todo-string-count-lines)
+ (todo-string-multiline-p, todo-time-string-format)
+ (todo-tmp-buffer-name): Remove.
+ (todo-add-file, todo-archive-done-item, todo-choose-archive)
+ (todo-convert-legacy-files, todo-copy-item, todo-delete-category)
+ (todo-edit-category-diary-inclusion)
+ (todo-edit-category-diary-nonmarking, todo-edit-done-item-comment)
+ (todo-edit-file, todo-edit-item-date-day)
+ (todo-edit-item-date-day-name, todo-edit-item-date-from-calendar)
+ (todo-edit-item-date-month, todo-edit-item-date-to-today)
+ (todo-edit-item-date-year, todo-edit-item-diary-inclusion)
+ (todo-edit-item-diary-nonmarking, todo-edit-item-header)
+ (todo-edit-item-time, todo-edit-quit, todo-filter-diary-items)
+ (todo-filter-diary-items-multifile, todo-filter-regexp-items)
+ (todo-filter-regexp-items-multifile, todo-filter-top-priorities)
+ (todo-filter-top-priorities-multifile, todo-find-archive)
+ (todo-find-filtered-items-file, todo-go-to-source-item)
+ (todo-insert-item-from-calendar, todo-item-done, todo-item-undone)
+ (todo-jump-to-archive-category, todo-lower-category)
+ (todo-mark-category, todo-marked-item-p, todo-merge-category)
+ (todo-move-category, todo-move-item, todo-next-button)
+ (todo-next-item, todo-padded-string, todo-powerset)
+ (todo-previous-button, todo-previous-item)
+ (todo-print-buffer-to-file, todo-raise-category)
+ (todo-rename-category, todo-repair-categories-sexp, todo-search)
+ (todo-set-category-number, todo-set-item-priority)
+ (todo-set-top-priorities-in-category)
+ (todo-set-top-priorities-in-file, todo-show-categories-table)
+ (todo-sort-categories-alphabetically-or-numerically)
+ (todo-sort-categories-by-archived, todo-sort-categories-by-diary)
+ (todo-sort-categories-by-done, todo-sort-categories-by-todo)
+ (todo-toggle-item-header, todo-toggle-item-highlighting)
+ (todo-toggle-mark-item, todo-toggle-prefix-numbers)
+ (todo-toggle-view-done-items, todo-toggle-view-done-only)
+ (todo-unarchive-items, todo-unmark-category): New commands.
+ (todo-absolute-file-name, todo-add-to-buffer-list)
+ (todo-adjusted-category-label-length, todo-basic-edit-item-header)
+ (todo-basic-insert-item, todo-category-completions)
+ (todo-category-number, todo-category-string-matcher-1)
+ (todo-category-string-matcher-2, todo-check-filtered-items-file)
+ (todo-check-format, todo-clear-matches)
+ (todo-comment-string-matcher, todo-convert-legacy-date-time)
+ (todo-current-category, todo-date-string-matcher)
+ (todo-define-insertion-command, todo-diary-expired-matcher)
+ (todo-diary-goto-entry, todo-diary-item-p)
+ (todo-diary-nonmarking-matcher, todo-display-as-todo-file)
+ (todo-display-categories, todo-display-sorted, todo-done-item-p)
+ (todo-done-item-section-p, todo-done-separator)
+ (todo-done-string-matcher, todo-files, todo-filter-items)
+ (todo-filter-items-1, todo-filter-items-filename, todo-find-item)
+ (todo-gen-arglists, todo-get-count, todo-get-overlay, todo-indent)
+ (todo-insert-category-line, todo-insert-item-from-calendar)
+ (todo-insert-sort-button, todo-insert-with-overlays)
+ (todo-insertion-command-name, todo-insertion-key-bindings)
+ (todo-label-to-key, todo-longest-category-name-length)
+ (todo-make-categories-list, todo-mode-external-set)
+ (todo-mode-line-control, todo-modes-set-1, todo-modes-set-2)
+ (todo-modes-set-3, todo-multiple-filter-files)
+ (todo-nondiary-marker-matcher, todo-prefix-overlays)
+ (todo-read-category, todo-read-date, todo-read-dayname)
+ (todo-read-file-name, todo-read-time)
+ (todo-reevaluate-category-completions-files-defcustom)
+ (todo-reevaluate-default-file-defcustom)
+ (todo-reevaluate-filelist-defcustoms)
+ (todo-reevaluate-filter-files-defcustom)
+ (todo-reset-and-enable-done-separator, todo-reset-comment-string)
+ (todo-reset-done-separator, todo-reset-done-separator-string)
+ (todo-reset-done-string, todo-reset-global-current-todo-file)
+ (todo-reset-highlight-item, todo-reset-nondiary-marker)
+ (todo-reset-prefix, todo-set-categories)
+ (todo-set-date-from-calendar, todo-set-show-current-file)
+ (todo-set-top-priorities, todo-short-file-name)
+ (todo-show-current-file, todo-sort, todo-time-string-matcher)
+ (todo-total-item-counts, todo-update-buffer-list)
+ (todo-update-categories-display, todo-update-categories-sexp)
+ (todo-update-count, todo-validate-name, todo-y-or-n-p):
+ New functions.
+ (todo-archive-mode, todo-categories-mode, todo-filtered-items-mode):
+ New major modes.
+ (todo-categories, todo-display, todo-edit, todo-faces)
+ (todo-filtered): New defgroups.
+ (todo-archived-only, todo-button, todo-category-string, todo-date)
+ (todo-diary-expired, todo-done, todo-done-sep, todo-comment)
+ (todo-mark, todo-nondiary, todo-prefix-string, todo-search)
+ (todo-sorted-column, todo-time, todo-top-priority): New deffaces.
+ (todo-add-item-if-new-category, todo-always-add-time-string)
+ (todo-categories-align, todo-categories-archived-label)
+ (todo-categories-category-label, todo-categories-diary-label)
+ (todo-categories-done-label, todo-categories-number-separator)
+ (todo-categories-todo-label, todo-categories-totals-label)
+ (todo-category-completions-files, todo-completion-ignore-case)
+ (todo-default-todo-file, todo-diary-nonmarking, todo-directory)
+ (todo-done-separator-string, todo-done-string)
+ (todo-files-function, todo-filter-done-items, todo-filter-files)
+ (todo-highlight-item, todo-include-in-diary, todo-indent-to-here)
+ (todo-initial-category, todo-initial-file, todo-item-mark)
+ (todo-legacy-date-time-regexp, todo-mode-line-function)
+ (todo-nondiary-marker, todo-number-prefix)
+ (todo-print-buffer-function, todo-show-current-file)
+ (todo-show-done-only, todo-show-first, todo-show-with-done)
+ (todo-skip-archived-categories, todo-top-priorities-overrides)
+ (todo-undo-item-omit-comment, todo-use-only-highlighted-region)
+ (todo-visit-files-commands, todo-wrap-lines, todo-y-with-space):
+ New defcustoms.
+ (todo-category-done, todo-date-pattern, todo-date-string-start)
+ (todo-diary-items-buffer, todo-done-string-start)
+ (todo-filtered-items-buffer, todo-item-start)
+ (todo-month-abbrev-array, todo-month-name-array)
+ (todo-nondiary-end, todo-nondiary-start, todo-regexp-items-buffer)
+ (todo-top-priorities-buffer): New defconsts.
+ (todo-archive-mode-map, todo-archives, todo-categories-mode-map)
+ (todo-categories-with-marks, todo-category-string-face)
+ (todo-comment-face, todo-comment-string, todo-current-todo-file)
+ (todo-date-face, todo-date-from-calendar, todo-descending-counts)
+ (todo-diary-expired-face, todo-done-face, todo-done-sep-face)
+ (todo-done-separator, todo-edit-buffer, todo-edit-mode-map)
+ (todo-file-buffers, todo-files, todo-filtered-items-mode-map)
+ (todo-font-lock-keywords, todo-global-current-todo-file)
+ (todo-insertion-commands, todo-insertion-commands-arg-key-list)
+ (todo-insertion-commands-args)
+ (todo-insertion-commands-args-genlist)
+ (todo-insertion-commands-names, todo-insertion-map)
+ (todo-key-bindings-t, todo-key-bindings-t+a)
+ (todo-key-bindings-t+a+f, todo-key-bindings-t+f, todo-mode-map)
+ (todo-multiple-filter-files, todo-multiple-filter-files-widget)
+ (todo-nondiary-face, todo-print-buffer, todo-time-face)
+ (todo-visited): New variables.
+
+2013-06-21 Glenn Morris <rgm@gnu.org>
+
+ * play/cookie1.el (cookie-apropos): Add optional display argument.
+ * obsolete/yow.el (apropos-zippy): Use cookie-apropos.
+ (psychoanalyze-pinhead): Use cookie-doctor.
+
+2013-06-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/package.el (tar-get-file-descriptor)
+ (tar--extract): Declare.
+
+2013-06-21 Eduard Wiebe <usenet@pusto.de>
+
+ Extend flymake's warning predicate to be a function (bug#14217).
+ * progmodes/flymake.el (flymake-warning-predicate): New.
+ (flymake-parse-line): Use it.
+ (flymake-warning-re): Make obsolete alias to
+ `flymake-warning-predicate'.
+
+2013-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-alist): Include obsolete packages.
+ (package-obsolete-list): Remove.
+ (package-activate): Remove min-version argument. Add `force' argument.
+ Adjust to new package-alist format.
+ (package-mark-obsolete): Remove.
+ (package-unpack): Force reload of the package's autoloads.
+ (package-installed-p): Check builtins if the installed package is not
+ recent enough.
+ (package-initialize): Don't reset package-obsolete-list.
+ Don't specify which package version to activate.
+ (package-process-define-package, describe-package-1)
+ (package-menu--generate): Adjust to new package-alist format.
+
+2013-06-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * allout-widgets.el (allout-widgets-mode-off)
+ (allout-widgets-mode-on, allout-widgets-pre-command-business)
+ (allout-widgets-post-command-business)
+ (allout-widgets-after-copy-or-kill-function)
+ (allout-widgets-after-undo-function, allout-test-range-overlaps)
+ (allout-decorate-item-and-context)
+ (allout-graphics-modification-handler): Fix typos in docstrings.
+ (allout-get-or-create-parent-widget): Use `looking-at-p'.
+
+ * cmuscheme.el (scheme-start-file): Doc fix.
+ (inferior-scheme-mode, switch-to-scheme): Fix typos in docstrings.
+ (scheme-input-filter): Use `string-match-p'.
+
+ * composite.el (compose-gstring-for-terminal): Fix typo in docstring.
+
+ * dired-x.el: Use Dired consistently in docstrings.
+
+ * dired.el: Use Dired consistently in docstrings.
+ (dired-readin, dired-mode): Use `setq-local'.
+ (dired-switches-alist): Make defvar-local.
+ (dired-buffers-for-dir): Use `zerop'.
+ (dired-safe-switches-p, dired-switches-escape-p)
+ (dired-insert-old-subdirs, dired-move-to-end-of-filename)
+ (dired-glob-regexp, dired-in-this-tree, dired-goto-file-1)
+ (dired-sort-set-mode-line, dired-sort-toggle, dired-sort-R-check)
+ (dired-goto-next-nontrivial-file): Use `string-match-p'.
+ (dired-align-file, dired-insert-directory, dired-mark-files-in-region)
+ (dired-toggle-marks, dired-mark-files-containing-regexp)
+ (dired-mark-symlinks, dired-mark-directories, dired-mark-executables)
+ (dired-flag-auto-save-files, dired-flag-backup-files):
+ Use `looking-at-p'.
+ (dired-mark-files-regexp, dired-build-subdir-alist):
+ Use `string-match-p', `looking-at-p'.
+
+ * dos-w32.el (untranslated-canonical-name, untranslated-file-p)
+ (direct-print-region-helper): Use `string-match-p'.
+
+2013-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * comint.el (comint-redirect-results-list-from-process):
+ Fix infinite loop.
+
+2013-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-update-header-line-format): Quote % characters.
+
+2013-06-21 Glenn Morris <rgm@gnu.org>
+
+ * play/cookie1.el (cookie): New custom group.
+ (cookie-file): New option.
+ (cookie-check-file): New function.
+ (cookie): Make it interactive. Make start and end messages optional.
+ Interactively, display the result. Default to cookie-file.
+ (cookie-insert): Default to cookie-file.
+ (cookie-snarf): Make start and end messages optional.
+ Default to cookie-file. Use with-temp-buffer.
+ (cookie-read): Rename from read-cookie.
+ Make start and end messages optional. Default to cookie-file.
+ (cookie-shuffle-vector): Rename from shuffle-vector. Use dotimes.
+ Do not autoload it.
+ (cookie-apropos, cookie-doctor): New functions, copied from yow.el
+ * obsolete/yow.el (read-zippyism): Use new name for read-cookie.
+
+2013-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode): Backward compatibility fix.
+
+2013-06-21 Glenn Morris <rgm@gnu.org>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add with-eval-after-load.
+
+2013-06-21 Stefan Monnier <monnier@iro.umontreal.ca>
+ Daniel Hackney <dan@haxney.org>
+
+ * emacs-lisp/package.el: Use tar-mode rather than tar executable.
+ Consolidate the single-file vs tarball code.
+ (package-desc-suffix): New function.
+ (package-desc-full-name): Don't bother inlining it.
+ (package-load-descriptor): Return the new package-desc.
+ (package-mark-obsolete): Remove unused arg `package'.
+ (package-unpack): Make it work for single files as well.
+ Make it update package-alist.
+ (package--make-autoloads-and-stuff): Rename from
+ package--make-autoloads-and-compile. Don't compile any more.
+ (package--compile): New function.
+ (package-generate-description-file): New function, extracted from
+ package-unpack-single.
+ (package-unpack-single): Remove.
+ (package--with-work-buffer): Add indentation and debugging info.
+ (package-download-single): Remove.
+ (package-install-from-archive): Rename from package-download-tar, make
+ it take a pkg-desc, and make it work for single files as well.
+ (package-download-transaction): Simplify.
+ (package-tar-file-info): Remove `file' arg. Rewrite not to use an
+ external tar program.
+ (package-install-from-buffer): Remove `pkg-desc' argument.
+ Use package-tar-file-info for tar-mode buffers.
+ (package-install-file): Simplify accordingly.
+ (package-archive-base): Change to take a pkg-desc.
+ * tar-mode.el (tar--check-descriptor): New function, extracted from
+ tar-get-descriptor.
+ (tar-get-descriptor): Use it.
+ (tar-get-file-descriptor): New function.
+ (tar--extract): New function, extracted from tar-extract.
+ (tar--extract): Use it.
+ * emacs-lisp/package-x.el (package-upload-file): Decode the file, in
+ case the summary uses non-ascii. Adjust to new calling convention of
+ package-tar-file-info.
+
+2013-06-21 Leo Liu <sdl.web@gmail.com>
+
+ * comint.el (comint-redirect-results-list-from-process):
+ Fix random delay. (Bug#14681)
+
+2013-06-21 Juanma Barranquero <lekktu@gmail.com>
+
+ * profiler.el (profiler-format-number): Use log, not log10.
+
+2013-06-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * term/x-win.el (emacs-session-filename): Use `locate-user-emacs-file'.
+
+2013-06-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-loaddefs.el: Don't version-control any more.
+ * emacs-lisp/cl-lib.el: Load cl-macs when cl-loaddefs is not
+ yet available.
+ * Makefile.in (AUTOGEN_VCS): Move cl-loaddefs.el...
+ (AUTOGENEL): ... here.
+ * emacs-lisp/cl-macs.el (cl--sublis): New function.
+ (cl--defsubst-expand): Use it.
+
+2013-06-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ * subr.el (log10): Move here from C code, and declare as obsolete.
+ All uses of (log10 X) replaced with (log X 10).
+
+2013-06-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-format): Fix typo.
+ Declare with `defvar-local'.
+ (tabulated-list-use-header-line, tabulated-list-entries)
+ (tabulated-list-padding, tabulated-list-printer)
+ (tabulated-list-sort-key): Declare with `defvar-local'.
+ (tabulated-list-init-header, tabulated-list-print-fake-header):
+ Use `setq-local'.
+
+2013-06-20 Michael Albinus <michael.albinus@gmx.de>
+
+ * arc-mode.el (archive-mode): Add `archive-write-file' to
+ `write-contents-functions' also for remote files. (Bug#14652)
+
+2013-06-20 Juanma Barranquero <lekktu@gmail.com>
+
+ * cus-edit.el (custom-commands): Fix typos.
+ (custom-display): Fix tooltip text.
+ (custom-magic-alist, custom-filter-face-spec, custom-group-members):
+ Fix typos in docstrings.
+ (custom--initialize-widget-variables, Custom-mode): Use `setq-local'.
+ (custom-unlispify-menu-entry, custom-magic-value-create)
+ (custom-add-see-also, custom-group-value-create): Use ?\s.
+ (custom-guess-type, customize-apropos, editable-field)
+ (custom-face-value-create): Use `string-match-p'.
+ (custom-save-variables, custom-save-faces): Use `looking-at-p'.
+
+ * custom.el (custom-load-symbol): Use `string-match-p'.
+
+ * ansi-color.el: Convert to lexical binding.
+ (ansi-colors): Fix URL.
+ (ansi-color-context, ansi-color-context-region): Use defvar-local.
+ (ansi-color-apply-sequence, ansi-color-map): Fix typos in docstrings.
+ (ansi-color-make-color-map): Rename local var ansi-color-map to map.
+
+2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el (eww-process-text-input): Display passwords as asterisks.
+
+ * net/shr.el (shr-make-table-1): Protect against invalid column-spans.
+
+2013-06-19 Tom Tromey <tromey@redhat.com>
+
+ * net/eww.el (eww-top-url): Remove.
+ (eww-home-url, eww-start-url, eww-contents-url): New defvars.
+ (eww-render): Set new variables. Don't set eww-top-url.
+ (eww-handle-link): Handle "prev", "home", and "contents".
+ Downcase the rel text.
+ (eww-top-url): Choose best top URL.
+
+2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/eww.el: Rewrite to implement form elements "by hand" instead of
+ relying in widget.el. Using widget.el leads to too many
+ user interface inconsistencies.
+ (eww-self-insert): Implement entering commands in text fields.
+ (eww-process-text-input): New function to make text input field editing
+ work.
+ (eww-submit): Rewrite to use the new-style form methods.
+ (eww-select-display): Display the correct selected item.
+ (eww-change-select): Implement changing the select value.
+ (eww-toggle-checkbox): Implement radio/checkboxes.
+ (eww-update-field): Fix compilation error.
+ (eww-tag-textarea): Implement <textarea>.
+
+ * net/shr.el (shr-urlify): Use `keymap' instead of `local-map' so that
+ we don't shadow mode-specific bindings.
+
+ * net/eww.el (eww-browse-url): Don't push stuff onto history if there's
+ nothing to push.
+
+ * net/shr.el (shr-map): Bind [down-mouse-1] to browse URLs.
+
+2013-06-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/eieio.el (defclass): Make it eval-and-compile once more.
+
+2013-06-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el (tramp-adb-get-toolbox): Remove function, it is
+ not needed.
+
+ * net/tramp-sh.el (tramp-find-shell): Don't set "busybox" property.
+
+2013-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/browse-url.el (browse-url-browser-function):
+ `eww-browse-url' has the right calling signature, `eww' does not.
+
+2013-06-19 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file-form-autoload):
+ Only eval autoloaded macros.
+ (byte-compile-autoload): Only give the macro warning for macros.
+
+ * progmodes/cperl-mode.el (ps-bold-faces, ps-italic-faces)
+ (ps-underlined-faces): Declare.
+
+ * progmodes/idlwave.el (func-menu): Only set it up on XEmacs.
+ (speedbar-add-supported-extension): Declare.
+
+ * international/titdic-cnv.el (tit-process-header, miscdic-convert):
+ Don't include a date stamp in the header of the generated file;
+ it leads to needless differences between output files.
+
+2013-06-19 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/secrets.el (secrets-struct-secret-content-type):
+ Replace check of introspection data by a test call of "CreateItem".
+ Some servers do not offer introspection.
+
+2013-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-pair-mode): Improve interaction with
+ electric-layout-mode.
+ (electric-pair-default-inhibit): Don't assume (eq char (char-before)).
+ (electric-pair-syntax): Use text-mode-syntax-table in comments
+ and strings.
+ (electric-pair--insert): New function.
+ (electric-pair-post-self-insert-function): Use it and
+ electric--after-char-pos.
+
+2013-06-19 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-help): Fix regexp.
+
+2013-06-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/shr.el (shr-make-table-1): Implement <td rowspan>.
+ (shr-table-horizontal-line): Allow nil as a value, and change the
+ default.
+ (shr-insert-table-ruler): Respect the nil value.
+
+2013-06-18 Tom Tromey <tromey@barimba>
+
+ * net/eww.el (eww-next-url, eww-previous-url, eww-up-url, eww-top-url):
+ New defvars.
+ (eww-open-file): New defun.
+ (eww-render): Initialize new variables.
+ (eww-display-html): Handle "link" and "a".
+ (eww-handle-link, eww-tag-link, eww-tag-a): New defuns.
+ (eww-mode-map): Move "p" to "l". Bind "p", "n", "t", and "u".
+ (eww-back-url): Rename from eww-previous-url.
+ (eww-next-url, eww-previous-url, eww-up-url, eww-top-url):
+ New defuns.
+
+2013-06-18 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-before-regexp-re):
+ Distinguish ternary operator tokens from slash symbol and slash
+ char literal.
+
+2013-06-18 Juanma Barranquero <lekktu@gmail.com>
+
+ Convert symbol prettification into minor mode and global minor mode.
+
+ * progmodes/prog-mode.el (prettify-symbols-alist): Rename from
+ `prog-prettify-symbols', and make a local defvar instead of defcustom.
+ (prettify-symbols--keywords): Rename from
+ `prog-prettify-symbols-alist' and make a local defvar.
+ (prettify-symbols--compose-symbol): Rename from
+ `prog--prettify-font-lock-compose-symbol'.
+ (prettify-symbols--make-keywords): Rename from
+ `prog-prettify-font-lock-symbols-keywords' and simplify.
+ (prog-prettify-install): Remove.
+ (prettify-symbols-mode): New minor mode, based on
+ `prog-prettify-install'.
+ (turn-on-prettify-symbols-mode): New function.
+ (global-prettify-symbols-mode): New globalized minor mode.
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ * progmodes/cfengine.el (cfengine3-mode):
+ * progmodes/perl-mode.el (perl-mode): Don't call
+ `prog-prettify-install'; set `prettify-symbols-alist' instead.
+
+2013-06-18 Juri Linkov <juri@jurta.org>
+
+ * files-x.el (modify-file-local-variable-message): New function.
+ (modify-file-local-variable)
+ (modify-file-local-variable-prop-line): Add arg INTERACTIVE
+ and call `modify-file-local-variable-message' when it's non-nil.
+ (add-file-local-variable, delete-file-local-variable)
+ (add-file-local-variable-prop-line)
+ (delete-file-local-variable-prop-line): Add arg INTERACTIVE
+ and use it. (Bug#9820)
+
+2013-06-18 Juri Linkov <juri@jurta.org>
+
+ * emulation/vi.el (vi-shell-op):
+ * emulation/vip.el (vip-execute-com, ex-command):
+ * emulation/viper-cmd.el (viper-exec-bang):
+ * emulation/viper-ex.el (ex-command): Add non-nil arg REPLACE to
+ the call of `shell-command-on-region'. (Bug#14637)
+
+ * simple.el (shell-command-on-region): Doc fix.
+
+2013-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/eieio-custom.el: Remove misleading Version: header
+ (bug#14633).
+
+2013-06-18 Glenn Morris <rgm@gnu.org>
+
+ * net/eww.el, net/shr.el, net/shr-color.el: Move here from gnus/.
+
+ * newcomment.el (comment-search-forward, comment-search-backward):
+ Doc fix. (Bug#14376)
+
+2013-06-18 Juanma Barranquero <lekktu@gmail.com>
+
+ * face-remap.el (buffer-face-toggle): Fix typo in docstring.
+ (buffer-face-mode-invoke): Doc fix.
+
+2013-06-18 Matthias Meulien <orontee@gmail.com>
+
+ * tabify.el (untabify, tabify): With prefix, apply to entire buffer.
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00545.html>
+
+2013-06-18 Glenn Morris <rgm@gnu.org>
+
+ * generic-x.el (bat-generic-mode, rc-generic-mode, rul-generic-mode):
+ Replace obsolete function generic-make-keywords with its expansion.
+
+ * progmodes/python.el (ffap-alist): Declare.
+
+ * textmodes/reftex.el (bibtex-mode-map): Declare.
+
+2013-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el: Update package-alist after install (bug#14632).
+ (package-unpack, package-unpack-single): Return the pkg-dir.
+ (package-download-transaction): Use it to update package-alist.
+
+2013-06-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * net/browse-url.el (browse-url-browser-function): Add `eww' as a
+ possible choice.
+
+2013-06-17 Juri Linkov <juri@jurta.org>
+
+ * net/webjump.el (webjump-sample-sites): Add DuckDuckGo.
+
+2013-06-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-load-descriptor):
+ Remove `with-syntax-table' call, `read' doesn't need it.
+ http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00539.html
+
+2013-06-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * startup.el (command-line): Expand package name returned by
+ `package--description-file' (bug#14639).
+
+2013-06-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/package.el (package-load-descriptor): Do not call
+ `emacs-lisp-mode', just use its syntax table.
+
+2013-06-17 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/prog-mode.el (prog-prettify-install): Add `composition' to
+ `font-lock-extra-managed-props' if any prettifying keyword is added.
+ (prog--prettify-font-lock-compose-symbol): Use ?\s instead of ?\ .
+ (prog-mode): Use `setq-local'.
+
+2013-06-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/characters.el (standard-case-table): Set syntax of ?»
+ and ?« to punctuation.
+
+2013-06-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * progmodes/prog-mode.el (prog--prettify-font-lock-compose-symbol):
+ Save relevant match data before calling `syntax-ppss' (bug#14595).
+
+2013-06-15 Juri Linkov <juri@jurta.org>
+
+ * files-x.el (modify-file-local-variable-prop-line): Add local
+ variables to the end of the existing comment on the first line.
+ Use `file-auto-mode-skip' to skip interpreter magic line,
+ and also skip XML declaration.
+
+2013-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * startup.el (package--builtin-versions): New var.
+ (package-subdirectory-regexp): Remove.
+ (package--description-file): Hard code its value instead.
+
+ * emacs-lisp/package.el: Don't activate packages older than builtin.
+ (package-obsolete-list): Rename from package-obsolete-alist, and make
+ it into a simple list of package-desc.
+ (package-strip-version): Remove.
+ (package-built-in-p): Use package--builtin-versions.
+ (package-mark-obsolete): Simplify.
+ (package-process-define-package): Mark it obsolete if older than the
+ builtin version.
+ (package-handle-response): Use line-end-position.
+ (package-read-archive-contents, package--download-one-archive):
+ Simplify.
+ (package--add-to-archive-contents): Skip if older than the builtin or
+ installed version.
+ (package-menu-describe-package): Fix last change.
+ (package-list-unversioned): New var.
+ (package-menu--generate): Use it.
+
+ * emacs-lisp/autoload.el: Manage package--builtin-versions.
+ (autoload--insert-text, autoload--insert-cookie-text): New functions.
+ (autoload-builtin-package-versions): New variable.
+ (autoload-generate-file-autoloads): Use them.
+ Remove the list of autoloaded functions/macros from the
+ (autoload...) comments.
+
+ * Makefile.in (autoloads): Set autoload-builtin-package-versions.
+
+2013-06-15 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-partial): Don't jump to the next screen
+ line as soon as it becomes visible. Instead, continue enlarging
+ the vscroll until the portion of a tall screen line that's left on
+ display is about the height of the frame's default font.
+ (Bug#14567)
+
+2013-06-15 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-dispatcher.el (vc-compilation-mode): Avoid making
+ compilation-error-regexp-alist void, or local while let-bound.
+
+ * progmodes/make-mode.el (makefile-mode-syntax-table):
+ Treat "=" as punctuation. (Bug#14614)
+
+2013-06-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * help-fns.el (describe-variable):
+ Add extra line for permanent-local variables.
+
+2013-06-15 Simen Heggestøyl <simenheg@ifi.uio.no> (tiny change)
+
+ * progmodes/scheme.el (scheme-font-lock-keywords-2):
+ Add export, import, library. (Bug#9164)
+ (library): Set indent function.
+
+2013-06-14 Glenn Morris <rgm@gnu.org>
+
+ * term/xterm.el (xterm--query):
+ Stop after first matching handler. (Bug#14615)
+
+2013-06-14 Ivan Kanis <ivan@kanis.fr>
+
+ Add support for dired in saveplace.
+ * dired.el (dired-initial-position-hook): New variable.
+ (dired-initial-position): Call hook to place cursor position.
+ * saveplace.el (save-place-to-alist): Add dired position.
+ (save-place-dired-hook): New function.
+
+2013-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (eval-after-load, set-temporary-overlay-map): Use indirection
+ through a symbol rather than letrec.
+
+ * emacs-lisp/package.el: Don't recompute dir. Use pkg-descs more.
+ (package-desc): Add `dir' field.
+ (package-desc-full-name): New function.
+ (package-load-descriptor): Combine the two arguments. Don't use `load'.
+ (package-maybe-load-descriptor): Remove.
+ (package-load-all-descriptors): Just call package-load-descriptor.
+ (package--disabled-p): New function.
+ (package-desc-vers, package-desc-doc): Remove aliases.
+ (package--dir): Remove function.
+ (package-activate): Check if a package is disabled.
+ (package-process-define-package): New function, extracted from
+ define-package.
+ (define-package): Turn into a place holder.
+ (package-unpack-single, package-tar-file-info):
+ Use package--description-file.
+ (package-compute-transaction): Use package--disabled-p.
+ (package-download-transaction): Don't call
+ package-maybe-load-descriptor since they're all loaded anyway.
+ (package-install): Change argument to be a pkg-desc.
+ (package-delete): Use a single pkg-desc argument.
+ (describe-package-1): Use package-desc-dir instead of package--dir.
+ Use package-desc property instead of package-symbol.
+ (package-install-button-action): Adjust accordingly.
+ (package--push): Rewrite.
+ (package-menu--print-info): Adjust accordingly. Change the ID format
+ to be a pkg-desc.
+ (package-menu-describe-package, package-menu-get-status)
+ (package-menu--find-upgrades, package-menu-mark-upgrades)
+ (package-menu-execute, package-menu--name-predicate):
+ Adjust accordingly.
+ * startup.el (package--description-file): New function.
+ (command-line): Use it.
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Use package-desc-version.
+
+ * emacs-lisp/bytecomp.el (byte-compile-force-lexical-warnings): New var.
+ (byte-compile-preprocess): Use it.
+ (byte-compile-file-form-defalias): Try a bit harder to use macros we
+ can't quite recognize.
+ (byte-compile-add-to-list): Remove.
+ * emacs-lisp/cconv.el (cconv-warnings-only): New function.
+ (cconv-closure-convert): Add assertion.
+
+ * emacs-lisp/map-ynp.el: Use lexical-binding.
+ (map-y-or-n-p): Remove unused vars `tail' and `object'.
+ Factor out some repeated code.
+
+2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (with-eval-after-load): New macro.
+ (eval-after-load): Allow form to be a function.
+ take advantage of lexical-binding.
+ (do-after-load-evaluation): Use dolist and adjust to new format.
+ * simple.el (bad-packages-alist): Use dolist and with-eval-after-load.
+
+2013-06-13 Juri Linkov <juri@jurta.org>
+
+ * replace.el (perform-replace): Display "symbol " and other search
+ modes from `isearch-message-prefix' in the *Help* buffer.
+
+ * isearch.el (isearch-query-replace): Add " symbol" and other
+ possible search modes from `isearch-message-prefix' to the prompt.
+ (isearch-occur): Use `with-isearch-suspended' to not exit Isearch
+ when reading a regexp to collect.
+
+2013-06-13 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (word-search-regexp): Match whitespace if the search
+ string begins or ends in whitespace. The LAX arg is applied to
+ both ends of the search string. Use `regexp-quote' and explicit
+ \< and \> instead of \b. Use \` and \' instead of ^ and $.
+ (isearch-symbol-regexp): Sync with `word-search-regexp' where word
+ boundaries are replaced with symbol boundaries, and characters
+ between symbols match non-word non-symbol syntax. (Bug#14602)
+
+2013-06-13 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-del-char): Don't exceed the length of
+ `isearch-string' by the prefix arg. (Bug#14563)
+
+2013-06-13 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-yank-word, isearch-yank-line)
+ (isearch-char-by-name, isearch-quote-char)
+ (isearch-printing-char, isearch-process-search-char):
+ Add optional count prefix arg. (Bug#14563)
+
+ * international/isearch-x.el
+ (isearch-process-search-multibyte-characters):
+ Add optional count prefix arg.
+
+2013-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (internal-push-keymap, internal-pop-keymap): New functions.
+ (set-temporary-overlay-map): Use them (bug#14095); and take advantage of
+ lexical-binding.
+
+2013-06-13 Vitalie Spinu <spinuvit@gmail.com>
+
+ * subr.el (set-temporary-overlay-map): Add on-exit argument.
+
+2013-06-13 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (tty-handle-args):
+ Don't just discard "--" and anything after. (Bug#14608)
+
+ * emacs-lisp/lisp.el (forward-sexp, backward-sexp): Doc fixes.
+
+2013-06-13 Michael Albinus <michael.albinus@gmx.de>
+
+ Implement changes in Secret Service API. Make it backward compatible.
+ * net/secrets.el (secrets-struct-secret-content-type): New defonst.
+ (secrets-create-item): Use it. Prefix properties with interface.
+
+2013-06-13 Michael Hoffman <9qobl2n02@sneakemail.com> (tiny change)
+
+ * term.el (term-suppress-hard-newline): New option. (Bug#12017)
+ (term-emulate-terminal): Respect term-suppress-hard-newline.
+
+2013-06-13 E Sabof <esabof@gmail.com> (tiny change)
+
+ * image-dired.el (image-dired-dired-toggle-marked-thumbs):
+ Only remove a `thumb-file' overlay. (Bug#14548)
+
+2013-06-12 Grégoire Jadi <daimrod@gmail.com>
+
+ * mail/reporter.el (reporter-submit-bug-report):
+ Handle missing package-name. (Bug#14600)
+
+2013-06-12 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * textmodes/reftex-cite.el (reftex-cite-regexp-hist)
+ (reftex-citation-prompt, reftex-default-bibliography)
+ (reftex-bib-or-thebib, reftex-get-bibfile-list)
+ (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries)
+ (reftex-bib-sort-author, reftex-bib-sort-year)
+ (reftex-bib-sort-year-reverse, reftex-get-crossref-alist)
+ (reftex-extract-bib-entries-from-thebibliography)
+ (reftex-get-bibkey-default, reftex-get-bib-names)
+ (reftex-parse-bibtex-entry, reftex-get-bib-field)
+ (reftex-format-bib-entry, reftex-parse-bibitem)
+ (reftex-format-bibitem, reftex-do-citation)
+ (reftex-figure-out-cite-format, reftex-offer-bib-menu)
+ (reftex-restrict-bib-matches, reftex-extract-bib-file)
+ (reftex-insert-bib-matches, reftex-format-citation)
+ (reftex-make-cite-echo-string, reftex-bibtex-selection-callback)
+ (reftex-create-bibtex-file): Add docstrings, mostly by converting
+ existing comments into docstrings.
+
+2013-06-12 Xue Fuqiao <xfq.free@gmail.com>
+
+ * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix.
+
+2013-06-12 Andreas Schwab <schwab@suse.de>
+
+ * international/mule.el (auto-coding-alist): Use utf-8-emacs-unix
+ for auto-save files.
+
+2013-06-12 Glenn Morris <rgm@gnu.org>
+
+ * ido.el (ido-delete-ignored-files): Remove.
+ (ido-wide-find-dirs-or-files, ido-make-file-list-1):
+ Go back to calling ido-ignore-item-p directly.
+
+2013-06-12 Eyal Lotem <eyal.lotem@gmail.com> (tiny change)
+
+ * ido.el (ido-wide-find-dirs-or-files): Respect ido-case-fold.
+
+ * ido.el (ido-delete-ignored-files): New function,
+ split from ido-make-file-list-1.
+ (ido-wide-find-dirs-or-files): Maybe ignore files. (Bug#13003)
+ (ido-make-file-list-1): Use ido-delete-ignored-files.
+
+2013-06-12 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup)
+ (inferior-octave-completion-table)
+ (inferior-octave-track-window-width-change)
+ (octave-eldoc-function-signatures, octave-help)
+ (octave-find-definition): Use single quoted strings.
+ (inferior-octave-startup-args): Change default value.
+ (inferior-octave-startup): Do not hard code "-i" and
+ "--no-line-editing".
+ (inferior-octave-resync-dirs): Add optional arg NOERROR.
+ (inferior-octave-directory-tracker): Use it.
+ (octave-goto-function-definition): Robustify.
+ (octave-help): Support highlighting operators in 'See also'.
+ (octave-find-definition): Find subfunctions only in Octave mode.
+
+2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * help-fns.el (help-fns--compiler-macro): If the handler function is
+ named, then put a link to it.
+ * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names.
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function.
+ (cl-typep): Use it.
+ (cl-eval-when): Simplify debug spec.
+ (cl-define-compiler-macro): Use eval-and-compile. Give a name to the
+ compiler-macro function instead of setting `compiler-macro-file'.
+
+2013-06-12 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix.
+ * vc/vc-hooks.el (vc-stay-local): Doc fix.
+
+2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
+ Daniel Hackney <dan@haxney.org>
+
+ First part of Daniel Hackney's patch to package.el.
+ * emacs-lisp/package.el: Use defstruct.
+ (package-desc): New, main struct.
+ (package--bi-desc, package--ac-desc): New structs, used to describe the
+ format in external files.
+ (package-desc-vers): Replace with package-desc-version accessor.
+ (package-desc-doc): Replace with package-desc-summary accessor.
+ (package-activate-1): Remove `package' arg since the pkg-vec now
+ includes the name.
+ (define-package): Use package-desc-from-define.
+ (package-unpack-single): Change file-name arg to be a symbol.
+ (package--add-to-archive-contents): Use package-desc-create and new
+ accessor functions to package--ac-desc.
+ (package-buffer-info, package-tar-file-info): Return a package-desc.
+ (package-install-from-buffer): Remove `type' argument. Change pkg-info
+ arg to be a package-desc.
+ (package-install-file): Adjust accordingly. Use \' to match EOS.
+ (package--from-builtin): New function.
+ (describe-package-1, package-menu--generate): Use it.
+ (package--make-autoloads-and-compile): Change name arg to be a symbol.
+ (package-generate-autoloads): Idem and return the name of the file.
+ * emacs-lisp/package-x.el (package-upload-buffer-internal):
+ Change pkg-info arg to be a package-desc.
+ Use package-make-ac-desc.
+ (package-upload-file): Use \' to match EOS.
+ * finder.el (finder-compile-keywords): Use package-make-builtin.
+
+2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc.el (vc-deduce-fileset): Change error message.
+ (vc-read-backend): New function.
+ (vc-next-action): Use it.
+
+ * subr.el (function-arity): Remove (mistakenly added) (bug#14590).
+
+ * progmodes/prolog.el (prolog-make-keywords-regexp): Remove.
+ (prolog-font-lock-keywords): Use regexp-opt instead.
+ Don't manually highlight strings.
+ (prolog-mode-variables): Simplify comment-start-skip.
+ (prolog-consult-compile): Use display-buffer. Remove unused old-filter.
+
+ * emacs-lisp/generic.el (generic--normalise-comments)
+ (generic-set-comment-syntax, generic-set-comment-vars): New functions.
+ (generic-mode-set-comments): Use them.
+ (generic-bracket-support): Use setq-local.
+ (generic-make-keywords-list): Declare obsolete.
+
+2013-06-11 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ Prettify after setting font-lock-defaults. (Bug#14574)
+
+2013-06-11 Juanma Barranquero <lekktu@gmail.com>
+
+ * replace.el (query-replace, occur-read-regexp-defaults-function)
+ (replace-search):
+ * subr.el (declare-function, number-sequence, local-set-key)
+ (substitute-key-definition, locate-user-emacs-file)
+ (with-silent-modifications, split-string, eval-after-load):
+ Fix typos, remove unneeded backslashes and reflow some docstrings.
+
+2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * international/mule-conf.el (file-coding-system-alist): Use utf-8 as
+ default for Elisp files.
+
+2013-06-11 Glenn Morris <rgm@gnu.org>
+
+ * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map,
+ although define-derived-mode was doing this anyway. (Bug#14583)
+
+2013-06-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * allout.el (allout-encryption-plaintext-sanitization-regexps):
+ Fix make-variable-buffer-local call to refer to the correct variable.
+
+2013-06-10 Aidan Gauland <aidalgol@amuri.net>
+
+ * eshell/em-term.el (eshell-visual-commands)
+ (eshell-visual-subcommands, eshell-visual-options):
+ Add summary line to docstrings. Add cross-references.
+
+2013-06-10 Glenn Morris <rgm@gnu.org>
+
+ * epa.el (epa-read-file-name): New function. (Bug#14510)
+ (epa-decrypt-file): Make plain-file optional. Use epa-read-file-name.
+
+2013-06-09 Aidan Gauland <aidalgol@amuri.net>
+
+ * eshell/em-term.el (eshell-visual-command-p): Fix bug that caused
+ output redirection to be ignored with visual commands.
+
+2013-06-09 Aidan Gauland <aidalgol@amuri.net>
+
+ * eshell/em-term.el (eshell-visual-command-p): New function.
+ (eshell-term-initialize): Move long lambda to separate function
+ eshell-visual-command-p.
+ * eshell/em-dirs.el (eshell-dirs-initialize):
+ * eshell/em-script.el (eshell-script-initialize):
+ Add missing #' to lambda.
+
+2013-06-08 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-add-log-current-defun): New function.
+ (octave-mode): Set add-log-current-defun-function.
+ (octave-goto-function-definition): Do not move point if not found.
+ (octave-find-definition): Enhance to try subfunctions first.
+
+2013-06-08 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-char-before)
+ (byte-compile-backward-char, byte-compile-backward-word):
+ Improve previous change, to handle non-explicit nil.
+
+2013-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el: Improve show-paren-mode behavior.
+ (smie--opener/closer-at-point): New function.
+ (smie--matching-block-data): Use it. Don't match from right after an
+ opener or right before a closer. Obey smie-blink-matching-inners.
+ Don't signal a mismatch for repeated inners like "switch..case..case".
+
+2013-06-07 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode): Set comment-use-global-state
+ to t. (Bug#14303)
+ (octave-function-header-regexp): Fix. (Bug#14570)
+ (octave-help-mode-finish-hook, octave-help-mode-finish):
+ Remove. Just use temp-buffer-show-hook.
+
+ * newcomment.el (comment-search-backward): Revert last change.
+ (Bug#14434)
+
+ * emacs-lisp/smie.el (smie--matching-block-data): Minor simplification.
+
+2013-06-07 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (TAGS TAGS-LISP): Pass the (long) list of *.el files
+ through xargs, to avoid failure due to MS-Windows limitations on
+ command-line length.
+
+2013-06-06 Glenn Morris <rgm@gnu.org>
+
+ * font-lock.el (lisp-font-lock-keywords-2):
+ Treat user-error like error.
+
+ * emacs-lisp/bytecomp.el (byte-compile-char-before)
+ (byte-compile-backward-char, byte-compile-backward-word):
+ Handle explicit nil arguments. (Bug#14565)
+
+2013-06-05 Alan Mackenzie <acm@muc.de>
+
+ * isearch.el (isearch-allow-prefix): New user option.
+ (isearch-other-meta-char): Don't exit isearch when a prefix
+ argument is typed whilst `isearch-allow-prefix' is non-nil.
+ (Bug#9706)
+
+2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * autorevert.el (auto-revert-notify-handler): Use memq.
+ Hide assertion failure.
+
+ * skeleton.el: Use cl-lib.
+ (skeleton-further-elements): Use defvar-local.
+ (skeleton-insert): Use cl-progv.
+
+2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/prog-mode.el (prog-prettify-symbols)
+ (prog-prettify-install): Update docstrings.
+
+2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el: Move all the prog-mode code to prog-mode.el.
+ * progmodes/prog-mode.el: New file.
+ * loadup.el: Add prog-mode.el.
+
+2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * simple.el (prog-prettify-symbols): Add version.
+ (prog-prettify-install): Add convenience function to prettify symbols.
+
+ * progmodes/perl-mode.el (perl--augmented-font-lock-keywords)
+ (perl--augmented-font-lock-keywords-1)
+ (perl--augmented-font-lock-keywords-2, perl-mode): Remove unneeded
+ variables and use it.
+
+ * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
+ (cfengine3-mode): Remove unneeded variable and use it.
+
+ * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
+ (lisp--augmented-font-lock-keywords-1)
+ (lisp--augmented-font-lock-keywords-2, lisp-mode-variables):
+ Remove unneeded variables and use it.
+
+2013-06-05 João Távora <joaotavora@gmail.com>
+
+ * net/tls.el (open-tls-stream): Remove unneeded buffer contents up
+ to point when opening the connection. (Bug#14380)
+
+2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (load-history-regexp, load-history-filename-element)
+ (eval-after-load, after-load-functions, do-after-load-evaluation)
+ (eval-next-after-load, display-delayed-warnings)
+ (collapse-delayed-warnings, delayed-warnings-hook): Move after the
+ definition of save-match-data.
+ (overriding-local-map): Remove accidental obsolescence declaration.
+
+ * emacs-lisp/edebug.el (edebug-result): Move before first use.
+
+2013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ Generalize symbol prettify support to prog-mode and implement it
+ for perl-mode, cfengine3-mode, and emacs-lisp-mode.
+ * simple.el (prog-prettify-symbols-alist, prog-prettify-symbols)
+ (prog--prettify-font-lock-compose-symbol)
+ (prog-prettify-font-lock-symbols-keywords): New variables and
+ functions to support symbol prettification.
+ * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
+ (lisp--augmented-font-lock-keywords-1)
+ (lisp--augmented-font-lock-keywords-2, lisp-mode-variables)
+ (lisp--prettify-symbols-alist): Implement prettify of lambda.
+ * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
+ (cfengine3--prettify-symbols-alist, cfengine3-mode):
+ Implement prettify of -> => :: strings.
+ * progmodes/perl-mode.el (perl-prettify-symbols)
+ (perl--font-lock-compose-symbol)
+ (perl--font-lock-symbols-keywords): Move to prog-mode.
+ (perl--prettify-symbols-alist): Prettify -> => :: strings.
+ (perl-font-lock-keywords-1)
+ (perl-font-lock-keywords-2): Remove explicit prettify support.
+ (perl--augmented-font-lock-keywords)
+ (perl--augmented-font-lock-keywords-1)
+ (perl--augmented-font-lock-keywords-2, perl-mode):
+ Implement prettify support.
+
+2013-06-05 Leo Liu <sdl.web@gmail.com>
+
+ Re-implement SMIE matching block highlight using
+ show-paren-data-function. (Bug#14395)
+ * emacs-lisp/smie.el (smie-matching-block-highlight)
+ (smie--highlight-matching-block-overlay)
+ (smie--highlight-matching-block-lastpos)
+ (smie-highlight-matching-block)
+ (smie-highlight-matching-block-mode): Remove.
+ (smie--matching-block-data-cache): New variable.
+ (smie--matching-block-data): New function.
+ (smie-setup): Use smie--matching-block-data for
+ show-paren-data-function.
+
+ * progmodes/octave.el (octave-mode-menu): Fix.
+ (octave-find-definition): Skip garbage lines.
+
+2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Fix compilation error with simultaneous dynamic+lexical scoping.
+ Add warning when a defvar appears after the first let-binding.
+ * emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var.
+ (byte-compile-close-variables): Initialize it.
+ (byte-compile--declare-var): New function.
+ (byte-compile-file-form-defvar)
+ (byte-compile-file-form-define-abbrev-table)
+ (byte-compile-file-form-custom-declare-variable): Use it.
+ (byte-compile-make-lambda-lexenv): Change the argument. Simplify.
+ (byte-compile-lambda): Share call to byte-compile-arglist-vars.
+ (byte-compile-bind): Handle dynamic bindings that shadow
+ lexical bindings.
+ (byte-compile-unbind): Make arg non-optional.
+ (byte-compile-let): Simplify.
+ * emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var.
+ (cconv--analyse-function, cconv-analyse-form): Populate it.
+ Protect byte-compile-bound-variables to limit the scope of defvars.
+ (cconv-analyse-form): Add missing rule for (defvar <foo>).
+ Remove unneeded rule for `declare'.
+
+ * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2
+ so as to avoid depending on cl-adjoin at run-time.
+ * emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes.
+
+ * emacs-lisp/macroexp.el (macroexp--compiling-p): New function.
+ (macroexp--warn-and-return): Use it.
+
+2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el: Convert to lexical binding.
+ (overriding-local-map): Make obsolete.
+ (add-to-list): Doc fix. Add compiler macro.
+ (read-key): Swap values of local maps.
+
+2013-06-05 Leo Liu <sdl.web@gmail.com>
+
+ * eshell/esh-mode.el (eshell-mode): Fix key bindings.
+
+2013-06-04 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/compile.el (compile-goto-error): Add optional arg NOMSG.
+ (compilation-auto-jump): Suppress the "Mark set" message to give
+ way to exit message.
+
+2013-06-04 Alan Mackenzie <acm@muc.de>
+
+ Remove faulty optimization from indentation calculation.
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Don't calculate
+ search limit based on 2000 characters back from indent-point.
+
+2013-06-03 Tassilo Horn <tsdh@gnu.org>
+
+ * eshell/em-term.el (cl-lib): Require `cl-lib'.
+
+2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp.el: Use lexical-binding.
+ (lisp--local-variables-1, lisp--local-variables): New functions.
+ (lisp--local-variables-completion-table): New var.
+ (lisp-completion-at-point): Use it complete let-bound vars.
+
+ * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros
+ eagerly (bug#14422).
+
+2013-06-03 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-notify-enabled)
+ (auto-revert-notify-rm-watch, auto-revert-notify-add-watch)
+ (auto-revert-notify-event-p, auto-revert-notify-event-file-name)
+ (auto-revert-notify-handler): Handle also gfilenotify.
+
+ * subr.el (file-notify-handle-event): New defun. Replacing ...
+ (inotify-event-p, inotify-handle-event, w32notify-handle-event):
+ Remove.
+
+2013-06-03 Juri Linkov <juri@jurta.org>
+
+ * bindings.el (search-map): Bind `highlight-symbol-at-point' to
+ `M-s h .'. (Bug#14427)
+
+ * hi-lock.el (highlight-symbol-at-point): New alias for the new
+ command `hi-lock-face-symbol-at-point'.
+ (hi-lock-face-symbol-at-point): New command.
+ (hi-lock-map): Bind `highlight-symbol-at-point' to `C-x w .'.
+ (hi-lock-menu): Add `highlight-symbol-at-point'.
+ (hi-lock-mode): Doc fix.
+
+ * isearch.el (isearch-forward-symbol-at-point): New command.
+ (search-map): Bind `isearch-forward-symbol-at-point' to `M-s .'.
+ (isearch-highlight-regexp): Add a regexp which matches
+ words/symbols for word/symbol mode.
+
+ * subr.el (find-tag-default-bounds): New function with the body
+ mostly moved from `find-tag-default'.
+ (find-tag-default): Move most code to `find-tag-default-bounds',
+ call it and apply `buffer-substring-no-properties' afterwards.
+
+2013-06-03 Tassilo Horn <tsdh@gnu.org>
+
+ * eshell/em-term.el (eshell-term-initialize):
+ Use `cl-intersection' rather than `intersection'.
+
+2013-06-02 Xue Fuqiao <xfq.free@gmail.com>
+
+ * vc/log-view.el: Doc fix.
+ (log-view-mode-map): Copy keymap from `special-mode-map'.
+
+2013-06-02 Eric Ludlam <zappo@gnu.org>
+
+ * emacs-lisp/eieio.el (eieio--defalias, eieio-hook)
+ (eieio-error-unsupported-class-tags, eieio-skip-typecheck)
+ (eieio-optimize-primary-methods-flag, eieio-initializing-object)
+ (eieio-unbound, eieio-default-superclass)
+ (eieio--define-field-accessors, method-static, method-before)
+ (method-primary, method-after, method-num-lists)
+ (method-generic-before, method-generic-primary)
+ (method-generic-after, method-num-slots)
+ (eieio-specialized-key-to-generic-key)
+ (eieio--check-type, class-v, class-p)
+ (eieio-class-name, define-obsolete-function-alias)
+ (eieio-class-parents-fast, eieio-class-children-fast)
+ (same-class-fast-p, class-constructor, generic-p)
+ (generic-primary-only-p, generic-primary-only-one-p)
+ (class-option-assoc, class-option, eieio-object-p)
+ (class-abstract-p, class-method-invocation-order)
+ (eieio-defclass-autoload-map, eieio-defclass-autoload)
+ (eieio-class-un-autoload, eieio-defclass)
+ (eieio-eval-default-p, eieio-perform-slot-validation-for-default)
+ (eieio-add-new-slot, eieio-copy-parents-into-subclass)
+ (eieio--defgeneric-init-form, eieio-defgeneric-form)
+ (eieio-defgeneric-reset-generic-form)
+ (eieio-defgeneric-form-primary-only)
+ (eieio-defgeneric-reset-generic-form-primary-only)
+ (eieio-defgeneric-form-primary-only-one)
+ (eieio-defgeneric-reset-generic-form-primary-only-one)
+ (eieio-unbind-method-implementations)
+ (eieio--defmethod, eieio--typep)
+ (eieio-perform-slot-validation, eieio-validate-slot-value)
+ (eieio-validate-class-slot-value, eieio-barf-if-slot-unbound)
+ (eieio-oref, eieio-oref-default, eieio-default-eval-maybe)
+ (eieio-oset, eieio-oset-default, eieio-slot-originating-class-p)
+ (eieio-slot-name-index, eieio-class-slot-name-index)
+ (eieio-set-defaults, eieio-initarg-to-attribute)
+ (eieio-attribute-to-initarg, eieio-c3-candidate)
+ (eieio-c3-merge-lists, eieio-class-precedence-c3)
+ (eieio-class-precedence-dfs, eieio-class-precedence-bfs)
+ (eieio-class-precedence-list, eieio-generic-call-methodname)
+ (eieio-generic-call-arglst, eieio-generic-call-key)
+ (eieio-generic-call-next-method-list)
+ (eieio-pre-method-execution-functions, eieio-generic-call)
+ (eieio-generic-call-primary-only, eieiomt-method-list)
+ (eieiomt-optimizing-obarray, eieiomt-install)
+ (eieiomt-add, eieiomt-next, eieiomt-sym-optimize)
+ (eieio-generic-form, eieio-defmethod, make-obsolete)
+ (eieio-defgeneric, make-obsolete): Move to eieio-core.el.
+ (defclass): Remove `eval-and-compile' from macro.
+ (call-next-method, shared-initialize): Instead of using
+ `scoped-class' variable, use new eieio--scoped-class, and
+ eieio--with-scoped-class.
+ (initialize-instance): Rename local variable 'scoped-class' to
+ 'this-class' to remove ambiguitity from old global.
+
+ * emacs-lisp/eieio-core.el: New file. Derived from key parts of
+ eieio.el.
+ (eieio--scoped-class-stack): New variable.
+ (eieio--scoped-class): New fcn.
+ (eieio--with-scoped-class): New scoping macro.
+ (eieio-defclass): Use pushnew instead of add-to-list.
+ (eieio-defgeneric-form-primary-only-one, eieio-oset-default)
+ (eieio-slot-name-index, eieio-set-defaults, eieio-generic-call)
+ (eieio-generic-call-primary-only, eieiomt-add): Instead of using
+ `scoped-class' variable, use new eieio--scoped-class, and
+ eieio--with-scoped-class.
+
+ * emacs-lisp/eieio-base.el (cl-lib): Require during compile.
+
+2013-06-02 Tassilo Horn <tsdh@gnu.org>
+
+ * eshell/esh-ext.el (eshell-external-command): Pass args to
+ `eshell-find-interpreter'.
+ (eshell-find-interpreter): Add new second parameter ARGS.
+
+ * eshell/em-script.el (eshell-script-initialize): Add second arg
+ to the function added as MATCH to `eshell-interpreter-alist'.
+
+ * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to
+ the function added as MATCH to `eshell-interpreter-alist'.
+
+ * eshell/em-term.el (eshell-visual-subcommands): New defcustom.
+ (eshell-visual-options): New defcustom.
+ (eshell-escape-control-x): Adapt docstring.
+ (eshell-term-initialize): Test `eshell-visual-subcommands' and
+ `eshell-visual-options' in addition to `eshell-visual-commands'.
+ (eshell-exec-visual): Pass args to `eshell-find-interpreter'.
+
+2013-06-01 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-indent-block-enders): Add break,
+ continue and raise keywords.
+
+2013-06-01 Glenn Morris <rgm@gnu.org>
+
+ * pcmpl-gnu.el (pcomplete/tar): Check obsolete variable is bound.
+
+ Plain (f)boundp silences compilation warnings since Emacs 22.1.
+ * progmodes/cc-cmds.el (delete-forward-p):
+ * progmodes/cc-defs.el (buffer-syntactic-context-depth):
+ * progmodes/cc-engine.el (buffer-syntactic-context):
+ * progmodes/cc-fonts.el (face-property-instance):
+ * progmodes/cc-mode.el (set-keymap-parents):
+ * progmodes/cc-vars.el (get-char-table): No need for cc-bytecomp-defun.
+ * 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.
+
+ * progmodes/cc-vars.el (other): Emacs has this widget since
+ at least 21.1, so don't (re)define it.
+
+ * eshell/em-cmpl.el (eshell-cmpl-initialize):
+ Replace the obsolete alias pcomplete-arg-quote-list.
+
+2013-06-01 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode-syntax-table): Give `.'
+ punctuation syntax.
+ (inferior-octave-minimal-columns)
+ (inferior-octave-last-column-width): New variables.
+ (inferior-octave-track-window-width-change): New function.
+ (inferior-octave-mode): Adjust column width so that Octave output,
+ for example from 'ls', can fit into the window nicely.
+
+2013-05-31 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p):
+ Highlight expansions inside regexp literals.
+
+2013-05-31 Glenn Morris <rgm@gnu.org>
+
+ * obsolete/sym-comp.el (symbol-complete):
+ Replace obsolete completion-annotate-function.
+
+ * progmodes/cc-vars.el (c-make-macro-with-semi-re): Silence compiler.
+
+2013-05-31 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p):
+ New function, checks if point is inside a literal that allows
+ expression expansion.
+ (ruby-syntax-propertize-expansion): Use it.
+ (ruby-syntax-propertize-function): Bind `case-fold-search' to nil
+ around the body.
+
+2013-05-30 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-mode-map): Bind `isearch-toggle-invisible'
+ to "\M-si".
+ (isearch-invisible): New variable.
+ (isearch-forward): Doc fix.
+ (isearch-mode): Set `isearch-invisible'
+ to the value of `search-invisible'.
+ (isearch-toggle-case-fold): Doc fix.
+ (isearch-toggle-invisible): New command.
+ (isearch-query-replace): Let-bind `search-invisible'
+ to the value of `isearch-invisible'.
+ (isearch-search): Use `isearch-invisible' instead of
+ `search-invisible'. Let-bind `search-invisible'
+ to the value of `isearch-invisible'. (Bug#11378)
+
+2013-05-30 Juri Linkov <juri@jurta.org>
+
+ * replace.el (perform-replace): Avoid `isearch-range-invisible'
+ call when `query-flag' is nil and `search-invisible' is non-nil.
+ (Bug#11746)
+
+2013-05-30 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/gdb-mi.el (gdb-wait-for-pending): Fix typo.
+
+ * progmodes/cc-bytecomp.el (cc-bytecomp-noruntime-functions): New.
+ (cc-require): Suppress spurious "noruntime" warnings.
+ (cc-require-when-compile): Use fboundp, for sake of compiler.
+
+ * progmodes/cc-mode.el: Move load of cc-vars before that of
+ cc-langs (which in turn loads cc-vars), to quieten compiler.
+
+2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * paren.el: Simplify the code.
+ (show-paren-mode): Always start the timer.
+ (show-paren--idle-timer): Rename from show-paren-idle-timer.
+ (show-paren--overlay, show-paren--overlay-1): Rename from
+ show-paren-overlay and show-paren-overlay-1, and initialize to an
+ overlay rather than to nil.
+ (show-paren-function): Misc cleanup and simplifications.
+
+2013-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * paren.el (show-paren-data-function): New hook.
+ (show-paren--default): New function, extracted from show-paren-function.
+ (show-paren-function): Use show-paren-data-function.
+
+2013-05-30 Glenn Morris <rgm@gnu.org>
+
+ * ielm.el (ielm-map, ielm-complete-symbol):
+ Use completion-at-point rather than obsolete functions.
+ (inferior-emacs-lisp-mode): Doc fix.
+ Set completion-at-point-functions, rather than
+ comint-dynamic-complete-functions.
+
+ * eshell/em-cmpl.el (eshell-complete-lisp-symbol): New function.
+ (eshell-cmpl-initialize, eshell-complete-parse-arguments):
+ Replace obsolete lisp-complete-symbol with eshell-complete-lisp-symbol.
+
+ * image.el (image-animated-p): Tweak definition.
+
+ * net/rlogin.el (rlogin-program, rlogin-explicit-args): Default to ssh.
+ (rlogin-process-connection-type): Tweak default. Add set-after.
+ (rlogin-host): Doc fix.
+ (rlogin): Tweak prompt.
+ (rlogin-tab-or-complete): Use completion-at-point rather than alias.
+
+ * net/net-utils.el (nslookup-mode-map, ftp-mode-map):
+ * progmodes/tcl.el (inferior-tcl-mode-map):
+ Use completion-at-point rather than obsolete alias.
+
+ * emacs-lisp/eieio.el (eieio-eval-default-p): Move before use.
+
+ * minibuffer.el (read-file-name-completion-ignore-case):
+ Move before completion--in-region, for eager macro expansion.
+
+2013-05-29 Juri Linkov <juri@jurta.org>
+
+ * replace.el (occur-engine): Rename `globalcount' to `global-lines'
+ for total count of matching lines. Add `global-matches' for total
+ count of matches. Rename `matches' to `lines' for count of
+ matching lines. Add `matches' for count of matches.
+ Rename `lines' to `curr-line' for line count. Rename `prev-lines'
+ to `prev-line' for line number of prev match endpt.
+ Increment `matches' for every match. Print the number of
+ matching lines in the header.
+ (occur-context-lines): Rename `lines' to `curr-line'.
+ Rename `prev-lines' to `prev-line'. (Bug#14017)
+
+2013-05-29 Juri Linkov <juri@jurta.org>
+
+ * replace.el (perform-replace): Add `skip-read-only-count',
+ `skip-filtered-count', `skip-invisible-count' let-bound to 0.
+ Increment them for corresponding conditions and report the number
+ of skipped occurrences in the final message. (Bug#11746)
+ (query-replace, query-replace-regexp, query-replace-regexp-eval)
+ (replace-string, replace-regexp): Doc fix.
+
+2013-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/trace.el (trace--read-args): Provide a default.
+
+ * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from
+ prog-mode-map (bug#14504).
+
+2013-05-29 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-indent-comment): Tweak regexps.
+ (octave-help): Small simplification.
+
+ * emacs-lisp/smie.el (smie-highlight-matching-block): Always turn
+ off the highlight first.
+
+2013-05-29 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/idlwave.el (idlwave-concatenate-rinfo-lists):
+ Handle idlwave-last-system-routine-info-cons-cell being nil.
+
+ * progmodes/idlwave.el (idlwave-scan-user-lib-files)
+ (idlwave-write-paths): Simplify via with-temp-buffer.
+
+ * emulation/cua-gmrk.el: Also load cua-base, cua-rect at run time.
+ * emulation/cua-rect.el: Also load cua-base at run time.
+
+ * progmodes/cperl-mode.el (imenu-choose-buffer-index)
+ (file-of-tag, etags-snarf-tag, etags-goto-tag-location): Declare.
+ (cperl-imenu-on-info): Require imenu.
+
+2013-05-28 Alan Mackenzie <acm@muc.de>
+
+ Handle "capitalised keywords" correctly.
+ * progmodes/cc-mode.el (c-after-change): Bind case-fold-search to nil.
+
+2013-05-28 Aidan Gauland <aidalgol@amuri.net>
+
+ * eshell/em-unix.el: Add -r option to cp.
+
+2013-05-28 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-arch.el (vc-exec-after): Declare.
+ (vc-switches): Autoload.
+ * vc/vc-bzr.el: No need to require vc when compiling.
+ (vc-exec-after, vc-set-async-update, vc-default-dir-printer)
+ (vc-resynch-buffer, vc-dir-refresh): Declare.
+ (vc-setup-buffer, vc-switches): Autoload.
+ * vc/vc-cvs.el (vc-exec-after, vc-coding-system-for-diff)
+ (vc-resynch-buffer): Declare.
+ (vc-switches, vc-default-revert, vc-version-backup-file): Autoload.
+ * vc/vc-dir.el (desktop-missing-file-warning): Declare.
+ * vc/vc-git.el (vc-exec-after, vc-set-async-update)
+ (grep-read-regexp, grep-read-files, grep-expand-template)
+ (vc-dir-refresh): Declare.
+ (vc-setup-buffer, vc-switches, vc-resynch-buffer): Autoload.
+ * vc/vc-hg.el (vc-exec-after, vc-set-async-update): Declare.
+ (vc-setup-buffer, vc-switches, vc-do-async-command): Autoload.
+ * vc/vc-mtn.el (vc-exec-after): Declare.
+ (vc-switches): Autoload.
+ * vc/vc-rcs.el (vc-expand-dirs, vc-switches)
+ (vc-tag-precondition, vc-buffer-sync, vc-rename-master): Autoload.
+ (vc-file-tree-walk): Declare.
+ * vc/vc-sccs.el (vc-file-tree-walk): Declare.
+ (vc-expand-dirs, vc-switches, vc-setup-buffer, vc-delistify)
+ (vc-tag-precondition, vc-rename-master): Autoload.
+ * vc/vc-svn.el (vc-exec-after): Declare.
+ (vc-switches, vc-setup-buffer): Autoload.
+ * obsolete/vc-mcvs.el (vc-checkout, vc-switches, vc-default-revert):
+ Autoload.
+ (vc-resynch-buffer): Declare.
+
+ * obsolete/fast-lock.el (byte-compile-warnings):
+ Don't warn about obsolete features in this obsolete file.
+
+ * progmodes/cc-vars.el (c-macro-names-with-semicolon):
+ Move definition before use.
+
+ * play/dunnet.el (byte-compile-warnings): Don't disable them all.
+ (dun-unix-verbs): Remove dun-zippy.
+ (dun-zippy): Remove function.
+
+ * emacs-lisp/bytecomp.el (byte-compile-warnings): Doc fix.
+
+2013-05-27 Juri Linkov <juri@jurta.org>
+
+ * replace.el (replace-search): New function with code moved out
+ from `perform-replace'.
+ (replace-highlight, replace-dehighlight): Move function definitions
+ up closer to `replace-search'. (Bug#11746)
+
+2013-05-27 Juri Linkov <juri@jurta.org>
+
+ * replace.el (perform-replace): Ignore invisible matches.
+ In addition to checking `query-replace-skip-read-only', also
+ filter out matches by calling `run-hook-with-args-until-failure'
+ on `isearch-filter-predicates', and also check `search-invisible'
+ for t or call `isearch-range-invisible'.
+ (replace-dehighlight): Call `isearch-clean-overlays'. (Bug#11746)
+
+2013-05-27 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-filter-predicates): Rename from
+ `isearch-filter-predicate'. Doc fix. (Bug#11378)
+ (isearch-message-prefix): Display text from the property
+ `isearch-message-prefix' of the currently active filters.
+ (isearch-search): Don't compare `isearch-filter-predicate' with
+ `isearch-filter-visible'. Call `run-hook-with-args-until-failure'
+ on `isearch-filter-predicates'. Also check `search-invisible' for t
+ or call `isearch-range-invisible'.
+ (isearch-filter-visible): Make obsolete.
+ (isearch-lazy-highlight-search):
+ Call `run-hook-with-args-until-failure' on
+ `isearch-filter-predicates' and use `isearch-range-invisible'.
+
+ * info.el (Info-search): Call `run-hook-with-args-until-failure' on
+ `isearch-filter-predicates' instead of `funcall'ing
+ `isearch-filter-predicate'.
+ (Info-mode): Set `Info-isearch-filter' to
+ `isearch-filter-predicates' instead of `isearch-filter-predicate'.
+
+ * dired-aux.el (dired-isearch-filter-predicate-orig):
+ Remove variable.
+ (dired-isearch-filenames-toggle, dired-isearch-filenames-setup)
+ (dired-isearch-filenames-end): Add and remove
+ `dired-isearch-filter-filenames' in `isearch-filter-predicates'
+ instead of changing the value of `isearch-filter-predicate'.
+ Rebind `dired-isearch-filenames-toggle' from "\M-sf" to "\M-sff".
+ (dired-isearch-filter-filenames): Don't use `isearch-filter-visible'.
+ Put property `isearch-message-prefix' to "filename " on
+ `dired-isearch-filter-filenames'.
+
+ * wdired.el (wdired-change-to-wdired-mode):
+ Add `isearch-filter-predicates' to `wdired-isearch-filter-read-only'
+ locally instead of changing `isearch-filter-predicate'.
+ (wdired-isearch-filter-read-only): Don't use `isearch-filter-visible'.
+
+2013-05-27 Dmitry Gutov <dgutov@yandex.ru>
+
+ * vc/vc-git.el (vc-git-working-revision): When in detached mode,
+ return the commit hash (Bug#14459). Also set the
+ `vc-git-detached' property.
+ (vc-git--rev-parse): Extract from `vc-git-previous-revision'.
+ (vc-git-mode-line-string): Use the same help-echo format whether
+ in detached mode or not, because we know the actual revision now.
+ When in detached mode, shorten the revision to 7 chars.
+
+2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode):
+ * emacs-lisp/derived.el (define-derived-mode): Always defvar the
+ mode hook and provide a docstring.
+
+2013-05-27 Alan Mackenzie <acm@muc.de>
+
+ Remove spurious syntax-table text properties inserted by C-y.
+ * progmodes/cc-mode.el (c-after-change): Also clear hard
+ syntax-table property with value nil.
+
+2013-05-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-call-method): Let-bind `inhibit-redisplay'
+ when reading the events; the buffer layout shall not be changed.
+
+2013-05-27 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-directory-tracker-resync):
+ New variable.
+ (inferior-octave-directory-tracker): Automatically re-sync
+ default-directory.
+ (octave-help): Improve handling of 'See also'.
+
+2013-05-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc-view.el: Minor naming convention tweaks.
+ (desktop-buffer-mode-handlers): Don't add to it repeatedly.
+
+ * image-mode.el (image-mode-reapply-winprops): Call image-mode-winprops
+ even if there's no `display' property yet (bug#14435).
+
+2013-05-25 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (unmsys--file-name): Rename from reveal-filename.
+
+ * Makefile.in (custom-deps, finder-data, autoloads)
+ ($(MH_E_DIR)/mh-loaddefs.el, $(TRAMP_DIR)/tramp-loaddefs.el)
+ ($(CAL_DIR)/cal-loaddefs.el, $(CAL_DIR)/diary-loaddefs.el)
+ ($(CAL_DIR)/hol-loaddefs.el): All users changed.
+
+2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point): Don't use
+ error-completion on the first 2 args of condition-case (bug#14446).
+ Don't burp at EOB.
+
+2013-05-25 Leo Liu <sdl.web@gmail.com>
+
+ * comint.el (comint-previous-matching-input): Do not flood the
+ *Messages* buffer with trivial messages.
+
+2013-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/flymake.el (flymake-nop): Don't return a string.
+ (flymake-set-at): Fix typo.
+
+ * simple.el (read--expression): New function, extracted from
+ eval-expression. Set completion-at-point-functions (bug#14465).
+ (eval-expression, eval-minibuffer): Use it.
+
+2013-05-25 Xue Fuqiao <xfq.free@gmail.com>
+
+ * progmodes/flymake.el (flymake-save-buffer-in-file)
+ (flymake-makehash, flymake-posn-at-point-as-event, flymake-nop)
+ (flymake-selected-frame, flymake-log, flymake-ins-after)
+ (flymake-set-at, flymake-get-buildfile-from-cache)
+ (flymake-add-buildfile-to-cache, flymake-clear-buildfile-cache)
+ (flymake-find-possible-master-files, flymake-save-buffer-in-file):
+ Refine the doc string.
+ (flymake-get-file-name-mode-and-masks): Reformat.
+ (flymake-get-real-file-name-function): Fix a minor bug.
+
+2013-05-24 Juri Linkov <juri@jurta.org>
+
+ * progmodes/grep.el (grep-mode-font-lock-keywords):
+ Support =linenumber= format used by git-grep for lines with
+ function names. (Bug#13549)
+
+2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/octave.el (octave-smie-rules): Return nil rather than
+ 0 after a semi-colon; it works better for smie-auto-fill.
+ (octave--indent-new-comment-line): New function.
+ (octave-indent-new-comment-line): Use it (indirectly).
+ (octave-mode): Don't disable smie-auto-fill. Use add-function to
+ modify comment-line-break-function.
+
+ * emacs-lisp/smie.el (smie-auto-fill): Rework to be more robust.
+ (smie-setup): Use add-function to set it.
+
+2013-05-24 Sam Steingold <sds@gnu.org>
+
+ * sort.el (delete-duplicate-lines): Accept an optional `keep-blanks'
+ argument (before the `interactive' argument).
+
+2013-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * image-mode.el (image-mode-winprops): Add winprops to
+ image-mode-winprops-alist before running
+ image-mode-new-window-functions.
+ * doc-view.el (doc-view-new-window-function): Don't delay
+ doc-view-goto-page via timers (bug#14435).
+
+2013-05-24 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el: Integrate with desktop.el. (Bug#14435)
+ (doc-view-desktop-save-buffer): New function.
+ (doc-view-restore-desktop-buffer): New function.
+ (desktop-buffer-mode-handlers):
+ Add `doc-view-restore-desktop-buffer' as desktop.el buffer mode
+ handler.
+ (doc-view-mode): Set `doc-view-desktop-save-buffer' as custom
+ `desktop-save-buffer' function.
+
+2013-05-24 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-gvfs.el (tramp-gvfs-enabled): New defconst.
+ (tramp-gvfs-file-name-handler): Raise a user error when
+ `tramp-gvfs-enabled' is nil.
+ (top): Register signals only when `tramp-gvfs-enabled' is non-nil.
+ Do not raise a user error when loading package. (Bug#14447)
+
+ * net/xesam.el: Move to obsolete/.
+
+2013-05-24 Glenn Morris <rgm@gnu.org>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Add with-coding-priority.
+
+ * emacs-lisp/chart.el (chart-sort): Replace obsolete `object-name'.
+
+ * progmodes/cperl-mode.el (cperl-mode): Use fboundp.
+ (Info-find-node, Man-getpage-in-background): Declare.
+
+ * mail/unrmail.el (unrmail):
+ Replace obsolete detect-coding-with-priority.
+
+ * net/socks.el (socks-split-string): Use this rather than split-string.
+ (socks-nslookup-host): Update for above change.
+ (dynamic-choice, s5-dynamic-choice-match)
+ (s5-dynamic-choice-match-inline, s5-widget-value-create):
+ Comment out unused code.
+
+ * tooltip.el (tooltip-use-echo-area): Warn only on 'set.
+ * progmodes/gud.el (gud-gdb-completion-function): Move before use.
+ (gud-tooltip-echo-area): Make obsolete.
+ (gud-tooltip-process-output, gud-tooltip-tips): Also check tooltip-mode.
+
+ * progmodes/js.el (js--optimize-arglist): Declare.
+
+ * progmodes/ruby-mode.el (ruby-syntax-propertize-expansion): Declare.
+
+ * progmodes/which-func.el (ediff-window-A, ediff-window-B)
+ (ediff-window-C): Declare.
+
+ * obsolete/pgg-gpg.el, obsolete/pgg-pgp.el, obsolete/pgg-pgp5.el:
+ Tweak requires to silence compiler.
+
+ * obsolete/sym-comp.el: No need to load hipper-exp when compiling.
+ (he-search-string, he-tried-table, he-expand-list)
+ (he-init-string, he-string-member, he-substitute-string)
+ (he-reset-string): Declare.
+
+ * obsolete/options.el (list-options): Use custom-variable-p,
+ rather than obsolete alias.
+
+2013-05-23 Sam Steingold <sds@gnu.org>
+
+ * 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>
+
+2013-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-indent-forward-token)
+ (smie-indent-backward-token): Handle string tokens (bug#14381).
+
+2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * ielm.el (ielm-menu): New menu.
+ (inferior-emacs-lisp-mode): Set comment-start.
+
+2013-05-23 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * textmodes/reftex.el (reftex-ref-style-toggle):
+ Fix deactivate action.
+
+ * textmodes/reftex-vars.el (reftex-ref-style-alist):
+ Add cleveref macros.
+
+ * textmodes/reftex-parse.el (reftex-locate-bibliography-files):
+ Accept options for bibliography commands.
+ * textmodes/reftex-vars.el (reftex-bibliography-commands):
+ Add addbibresource. Basic Biblatex support.
+
+2013-05-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-gvfs.el (top):
+ * net/xesam.el (xesam-dbus-unique-names): Suppress D-Bus errors
+ when loading package. (Bug#14447)
+
+2013-05-23 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/js.el: No need to load comint when compiling.
+ (ring-insert, comint-send-string, comint-send-input)
+ (comint-last-input-end, ido-chop): Declare.
+
+ * vc/ediff-diff.el, vc/ediff-merg.el: Require ediff-util at run-time.
+ * vc/ediff-mult.el: Adjust requires.
+ (ediff-directories-internal, ediff-directory-revisions-internal)
+ (ediff-patch-file-internal): Declare.
+ * vc/ediff-ptch.el: Adjust requires.
+ (ediff-use-last-dir, ediff-buffers-internal): Declare.
+ (ediff-find-file): Autoload.
+ * vc/ediff-util.el: No need to load ediff when compiling.
+ (ediff-regions-internal): Declare.
+ * vc/ediff-wind.el: Adjust requires.
+ (ediff-compute-toolbar-width): Define when compiling.
+ (ediff-setup-control-buffer, ediff-make-bottom-toolbar): Declare.
+ * vc/ediff.el: No need to load dired, ediff-ptch when compiling.
+ (dired-get-filename, dired-get-marked-files)
+ (ediff-last-dir-patch, ediff-patch-default-directory)
+ (ediff-get-patch-buffer, ediff-dispatch-file-patching-job)
+ (ediff-patch-buffer-internal): Declare.
+
+ * emacs-lisp/checkdoc.el: No need to load ispell when compiling.
+ (ispell-process, ispell-buffer-local-words, lm-summary)
+ (lm-section-start, lm-section-end): Declare.
+ (checkdoc-ispell-init): Simplify.
+
+ * progmodes/vera-mode.el (he-init-string, he-dabbrev-beg)
+ (he-string-member, he-reset-string, he-substitute-string): Declare.
+
+ * eshell/em-ls.el: Adjust requires.
+ (eshell-glob-regexp): Declare.
+ * eshell/em-tramp.el: Adjust requires.
+ (eshell-parse-command): Autoload.
+ * eshell/em-xtra.el: Adjust requires.
+ (eshell-parse-command): Autoload.
+ * eshell/esh-ext.el: Adjust requires.
+ (eshell-parse-command, eshell-close-handles): Autoload.
+ * eshell/esh-io.el: Adjust requires.
+ (eshell-output-filter): Autoload.
+ * eshell/esh-util.el: No need to load tramp when compiling.
+ (tramp-file-name-structure, ange-ftp-ls, ange-ftp-file-modtime):
+ Declare.
+ (eshell-parse-ange-ls): Require ange-ftp and tramp.
+ * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el:
+ * eshell/em-cmpl.el, eshell/em-glob.el, eshell/em-pred.el:
+ * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-smart.el:
+ * eshell/em-term.el, eshell/esh-arg.el, eshell/esh-mode.el:
+ * eshell/esh-opt.el, eshell/esh-proc.el:
+ * eshell/esh-var.el: Adjust requires.
+ * eshell/eshell.el: Do not require esh-util twice.
+ (eshell-add-input-to-history): Declare.
+ (eshell-command): Check history module is active before using it.
+
+ * eshell/em-ls.el (eshell-ls-dir): Fix -A handling.
+
+2013-05-22 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup): Fix bug#14433.
+
+2013-05-22 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-notify-add-watch)
+ (auto-revert-notify-handler): Add `attrib' for the inotify case,
+ it indicates changes in file modification time.
+
+2013-05-22 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file-form-autoload):
+ Always delete the autoloaded function from the noruntime and
+ unresolved functions lists.
+
+ * allout.el: No need to load epa, epg, overlay when compiling.
+ (epg-context-set-passphrase-callback, epg-list-keys)
+ (epg-decrypt-string, epg-encrypt-string, epg-user-id-string)
+ (epg-key-user-id-list): Declare.
+
+ * emulation/viper-cmd.el (viper-set-searchstyle-toggling-macros)
+ (viper-set-parsing-style-toggling-macro)
+ (viper-set-emacs-state-searchstyle-macros):
+ Use called-interactively-p on Emacs.
+ (viper-looking-back): Make it an obsolete alias. Update callers.
+ * emulation/viper-ex.el: Load viper-keym, not viper-cmd.
+ Use looking-back rather than viper-looking-back.
+ (viper-tmp-insert-at-eob, viper-enlarge-region)
+ (viper-read-string-with-history, viper-register-to-point)
+ (viper-append-to-register, viper-change-state-to-vi)
+ (viper-backward-char-carefully, viper-forward-char-carefully)
+ (viper-Put-back, viper-put-back, viper-add-newline-at-eob-if-necessary)
+ (viper-change-state-to-emacs): Declare.
+ * emulation/viper-macs.el: Load viper-mous, viper-ex, not viper-cmd.
+ (viper-change-state-to-insert, viper-change-state-to-vi): Declare.
+ * emulation/viper-mous.el: Do not load viper-cmd.
+ (viper-backward-char-carefully, viper-forward-char-carefully)
+ (viper-forward-word, viper-adjust-window): Declare.
+
+ * vc/ediff.el (ediff-version): Use called-interactively-p on Emacs.
+
+ * progmodes/idlw-help.el (idlwave-help-fontify):
+ Use called-interactively-p.
+
+ * term/w32console.el (w32-get-console-codepage)
+ (w32-get-console-output-codepage): Declare.
+
+ * dframe.el (x-sensitive-text-pointer-shape, x-pointer-shape):
+ Remove unnecessary declarations.
+ (dframe-message): Doc fix.
+
+ * info.el (dframe-select-attached-frame, dframe-current-frame):
+ Declare.
+
+ * speedbar.el (speedbar-message): Make it an obsolete alias.
+ Update all callers.
+ (speedbar-with-attached-buffer)
+ (speedbar-maybee-jump-to-attached-frame): Make these aliases obsolete.
+ (speedbar-with-writable): Use backquote.
+ * emacs-lisp/eieio-opt.el (eieio-describe-class-sb):
+ * emacs-lisp/eieio-speedbar.el (eieio-speedbar-handle-click):
+ Use dframe-with-attached-buffer, dframe-maybee-jump-to-attached-frame
+ rather than speedbar- aliases.
+ * mail/rmail.el: Load dframe rather than speedbar when compiling.
+ (speedbar-make-specialized-keymap, speedbar-insert-button)
+ (dframe-select-attached-frame, dframe-maybee-jump-to-attached-frame)
+ (speedbar-do-function-pointer): Declare.
+ (rmail-speedbar-button, rmail-speedbar-find-file)
+ (rmail-speedbar-move-message):
+ Use dframe-with-attached-buffer rather than speedbar- alias.
+ * progmodes/gud.el: Load dframe rather than speedbar when compiling.
+ (dframe-message, speedbar-make-specialized-keymap)
+ (speedbar-add-expansion-list, speedbar-mode-functions-list)
+ (speedbar-make-tag-line, speedbar-remove-localized-speedbar-support)
+ (speedbar-insert-button, dframe-select-attached-frame)
+ (dframe-maybee-jump-to-attached-frame)
+ (speedbar-change-initial-expansion-list)
+ (speedbar-previously-used-expansion-list-name): Declare.
+ (gud-speedbar-item-info, gud-gdb-goto-stackframe):
+ Use dframe-message, dframe-with-attached-buffer rather than
+ speedbar- aliases.
+ (gud-sentinel): Silence compiler.
+ * progmodes/vhdl-mode.el (speedbar-refresh)
+ (speedbar-do-function-pointer, speedbar-add-supported-extension)
+ (speedbar-add-mode-functions-list, speedbar-make-specialized-keymap)
+ (speedbar-change-initial-expansion-list, speedbar-add-expansion-list)
+ (speedbar-extension-list-to-regex, speedbar-directory-buttons)
+ (speedbar-file-lists, speedbar-make-tag-line)
+ (speedbar-line-directory, speedbar-goto-this-file)
+ (speedbar-center-buffer-smartly, speedbar-change-expand-button-char)
+ (speedbar-delete-subblock, speedbar-position-cursor-on-line)
+ (speedbar-make-button, speedbar-reset-scanners)
+ (speedbar-files-item-info, speedbar-line-text)
+ (speedbar-find-file-in-frame, speedbar-set-timer)
+ (dframe-maybee-jump-to-attached-frame, speedbar-line-file): Declare.
+ (speedbar-with-writable): Do not (re)define it.
+ (vhdl-speedbar-find-file): Use dframe-maybee-jump-to-attached-frame
+ rather than speedbar- alias.
+
+2013-05-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode-menu): Update and re-organize
+ menu items.
+ (octave-mode): Tweak fill-nobreak-predicate.
+ (inferior-octave-startup): Check process to avoid infinite loop.
+ (inferior-octave): Pop to buffer first to show abornmal process
+ exit information.
+
+2013-05-21 Glenn Morris <rgm@gnu.org>
+
+ * printing.el (pr-menu-bar): Define when compiling.
+
+2013-05-21 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-auto-fill): Remove.
+ (octave-indent-new-comment-line): Improve.
+ (octave-mode): Use auto fill mode through
+ comment-line-break-function and fill-nobreak-predicate.
+ (octave-goto-function-definition): Support DEFUN_DLD.
+ (octave-beginning-of-defun): Small tweak.
+ (octave-help): Show parent directory.
+
+2013-05-21 Glenn Morris <rgm@gnu.org>
+
+ * files.el (dired-unmark):
+ * progmodes/gud.el (gdb-input): Update declarations.
+
+ * calculator.el (electric, ehelp): No need to load when compiling.
+ (Electric-command-loop, electric-describe-mode): Declare.
+
+ * doc-view.el (doc-view-current-converter-processes): Move before use.
+
+ * emacs-lisp/easy-mmode.el (define-globalized-minor-mode):
+ Move MODE-set-explicitly definition before use.
+
+ * international/mule-diag.el (mule-diag):
+ Don't use obsolete window-system-version.
+
+ * mail/feedmail.el (smtpmail): No need to load when compiling.
+ (smtpmail-via-smtp, smtpmail-smtp-server): Declare.
+
+ * mail/mail-utils.el (rfc822): No need to load when compiling.
+ (rfc822-addresses): Autoload it.
+ (mail-strip-quoted-names): Trivial simplification.
+
+ * mail/rmail.el (rmail-mime-message-p, rmail-mime-toggle-raw): Declare.
+ (rmail-retry-failure): Don't assume that rmail-mime-feature == rmailmm.
+
+ * net/snmp-mode.el (tempo): Don't duplicate requires.
+
+ * progmodes/prolog.el (info): No need to load when compiling.
+ (comint): Require before shell requires it.
+ (Info-goto-node): Autoload it.
+ (Info-follow-nearest-node): Declare.
+ (prolog-help-info, prolog-goto-predicate-info): No need to require info.
+
+ * textmodes/artist.el (picture-mode-exit): Declare.
+
+ * textmodes/reftex-parse.el (reftex-parse-from-file):
+ Trivial rewrite so the compiler can parse it better.
+
+2013-05-20 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-help-mode-map)
+ (octave-help-mode-finish-hook): New variables.
+ (octave-help-mode, octave-help-mode-finish): New functions.
+ (octave-help): Use octave-help-mode.
+
+2013-05-20 Glenn Morris <rgm@gnu.org>
+
+ * format-spec.el (format-spec): Allow spec chars with nil. (Bug#14420)
+
+2013-05-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-expression-expansion-re): Allow to
+ start at point, so that expansion starting right after opening
+ slash in a regexp is recognized.
+ (ruby-syntax-before-regexp-re): New defvar, extracted from
+ ruby-syntax-propertize-function. Since the value of this regexp
+ is looked up at runtime now, we should be able to turn
+ `ruby-syntax-methods-before-regexp' into a defcustom later.
+ (ruby-syntax-propertize-function): Split regexp matching into two
+ parts, for opening and closing slashes. That allows us to skip
+ over string interpolations and support multiline regexps.
+ Don't call `ruby-syntax-propertize-expansions', instead use another rule
+ for them, which calls `ruby-syntax-propertize-expansion'.
+ (ruby-syntax-propertize-expansions): Move `remove-text-properties'
+ call to `ruby-syntax-propertize-function'.
+ (ruby-syntax-propertize-expansion): Extracted from
+ `ruby-syntax-propertize-expansions'. Handles one expansion.
+ (ruby-syntax-propertize-percent-literal): Leave point right after
+ the percent symbol, so that the expression expansion rule can
+ propertize the contents.
+ (ruby-syntax-propertize-heredoc): Leave point at bol following the
+ heredoc openers.
+ (ruby-syntax-propertize-expansions): Remove.
+
+2013-05-18 Juri Linkov <juri@jurta.org>
+
+ * man.el (Man-default-man-entry): Remove `-' from the end
+ of the default value. (Bug#14400)
+
+2013-05-18 Glenn Morris <rgm@gnu.org>
+
+ * comint.el (comint-password-prompt-regexp):
+ Allow "password for XXX" where XXX contains colons (eg https://...).
+
+2013-05-18 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup): Use OCTAVE_SRCDIR
+ instead. Include "--no-gui" to prevent hangs for Octave > 3.7.
+ (octave-source-directories): Don't check process.
+ (octave-source-directories, octave-find-definition): Doc fix.
+
+2013-05-18 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/vhdl-mode.el (vhdl-mode-map-init):
+ Remove backspace/delete bindings. (Bug#14392)
+
+ * cus-dep.el (custom-make-dependencies): Sort the output.
+ (custom-versions-load-alist): Convert comment to doc.
+
+2013-05-17 Leo Liu <sdl.web@gmail.com>
+
+ * newcomment.el (comment-search-backward): Stricter in finding
+ comment start. (Bug#14303)
+
+ * progmodes/octave.el (octave-comment-start): Remove the SPC char.
+ (octave-comment-start-skip): Properly anchored.
+
+2013-05-17 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/smie.el (smie-highlight-matching-block-mode):
+ Clean up when turned off. (Bug#14395)
+ (smie--highlight-matching-block-overlay): No longer buffer-local.
+ (smie-highlight-matching-block): Adjust.
+
+2013-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Doc string fix for "nanoseconds" (Bug#14406).
+ * emacs-lisp/timer.el (timer-relative-time, timer-inc-time):
+ Fix doc string typo that had "nanoseconds" instead of "microseconds".
+
+2013-05-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (math-extract-units): Preserve powers
+ of units.
+
+2013-05-17 Leo Liu <sdl.web@gmail.com>
+
+ * subr.el (delete-consecutive-dups): New function.
+ * ido.el (ido-set-matches-1): Use it.
+ * progmodes/octave.el (inferior-octave-completion-table): Use it.
+ * ido.el (ido-remove-consecutive-dups): Remove.
+
+2013-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re)
+ (f90-hpf-keywords-re, f90-constants-re): Use \\_< rather than
+ regexp-opt's `words'.
+
+2013-05-16 Leo Liu <sdl.web@gmail.com>
+
+ * emacs-lisp/smie.el (smie-matching-block-highlight): New face.
+ (smie--highlight-matching-block-overlay)
+ (smie--highlight-matching-block-lastpos)
+ (smie--highlight-matching-block-timer): New variables.
+ (smie-highlight-matching-block): New function.
+ (smie-highlight-matching-block-mode): New minor mode. (Bug#14395)
+ (smie-setup): Conditionally enable smie-blink-matching-open.
+
+2013-05-16 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Sync with upstream verilog-mode r840.
+ * progmodes/verilog-mode.el (verilog-mode-version)
+ (verilog-mode-release-date): Update.
+ (verilog-auto-lineup, verilog-auto-reset): Doc fixes.
+ (verilog-sig-tieoff): Fix string error on
+ AUTORESET with colon define, bug594. Reported by Andrew Hou.
+ (verilog-read-decls): Fix parameters confusing
+ AUTOINST interfaces, bug565. Reported by Leith Johnson.
+
+2013-05-16 Eli Zaretskii <eliz@gnu.org>
+
+ * subr.el (reveal-filename): New function.
+
+ * loadup.el: Compute Emacs executable versions on MS-Windows,
+ where executables have the .exe extension. Add a hard link
+ emacs-XX.YY.ZZ.exe on MS-Windows.
+
+ * Makefile.in (XARGS_LIMIT): New variable.
+ (custom-deps, finder-data, autoloads)
+ ($(MH_E_DIR)/mh-loaddefs.el, $(TRAMP_DIR)/tramp-loaddefs.el)
+ ($(CAL_DIR)/cal-loaddefs.el, $(CAL_DIR)/diary-loaddefs.el)
+ ($(CAL_DIR)/hol-loaddefs.el): Use reveal-filename.
+ (compile-main): Limit xargs according to $(XARGS_LIMIT).
+
+2013-05-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-indent-defun): Mark obsolete.
+ (octave-mode-menu, octave-mode-map): Remove its uses.
+
+2013-05-16 Reto Zimmermann <reto@gnu.org>
+
+ Sync with upstream vhdl mode v3.34.2.
+ * progmodes/vhdl-mode.el: Use `push' throughout.
+ (vhdl-version, vhdl-time-stamp, vhdl-doc-release-notes): Update.
+ (vhdl-compiler-alist): Replace "\t\n" by "\\t\\n".
+ Add IBM & Quartus compiler. Enhance entry for ADVance MS compiler.
+ (vhdl-actual-generic-name): New option to derive actual generic name.
+ (vhdl-port-paste-signals): Replace formal by actual generics.
+ (vhdl-beautify): New name for old group vhdl-align. Update users.
+ (vhdl-beautify-options): New option.
+ (vhdl-last-input-event): New compat alias. Use throughout.
+ (vhdl-goto-line): Replace user level function `goto-line'.
+ (vhdl-mode-map): Add bindings for vhdl-fix-statement-region,
+ vhdl-fix-statement-buffer.
+ (vhdl-create-mode-menu): Add some entries.
+ (vhdl-align-region-groups): Respect vhdl-beautify-options.
+ (vhdl-align-inline-comment-region-1): Handle "--" inside string.
+ (vhdl-fixup-whitespace-region): Handle symbols at EOL.
+ (vhdl-fix-statement-region, vhdl-fix-statement-buffer): New commands,
+ to force statements on one line.
+ (vhdl-remove-trailing-spaces-region):
+ New, split from vhdl-remove-trailing-spaces.
+ (vhdl-beautify-region): Fix statements, trailing spaces, ^M character.
+ Respect vhdl-beautify-options.
+ (vhdl-update-sensitivity-list-buffer): If non-interactive save buffer.
+ (vhdl-update-sensitivity-list): Not add with index if exists without.
+ Not include array index with signal. Ignore keywords in comments.
+ (vhdl-get-visible-signals): Regexp tweaks.
+ (vhdl-template-component-inst): Handle empty library.
+ (vhdl-template-type): Add template for 'enum' type.
+ (vhdl-port-paste-generic-map, vhdl-port-paste-constants):
+ Use vhdl-replace-string.
+ (vhdl-port-paste-signals): Use vhdl-prepare-search-1.
+ (vhdl-speedbar-mode-map): Rename from vhdl-speedbar-key-map.
+ (vhdl-speedbar-initialize): Update for above name change.
+ (vhdl-compose-wire-components): Fix in handling of constants.
+ (vhdl-error-regexp-emacs-alist): New variable.
+ (vhdl-error-regexp-add-emacs): New function;
+ adds support for new compile.el (Emacs 22+)
+ (vhdl-generate-makefile-1): Change target order for single lib. units.
+ Allow use of absolute file names.
+
+2013-05-16 Leo Liu <sdl.web@gmail.com>
+
+ * simple.el (prog-indent-sexp): Indent enclosing defun.
+
+2013-05-15 Glenn Morris <rgm@gnu.org>
+
+ * cus-start.el (show-trailing-whitespace): Move to editing basics.
+ * faces.el (trailing-whitespace): Don't use whitespace-faces group.
+ * obsolete/old-whitespace.el (whitespace-faces): Remove group.
+ (whitespace-highlight): Move to whitespace group.
+
+ * comint.el (comint-source):
+ * pcmpl-linux.el (pcmpl-linux):
+ * shell.el (shell-faces):
+ * eshell/esh-opt.el (eshell-opt):
+ * international/ccl.el (ccl): Remove empty custom groups.
+
+ * completion.el (dynamic-completion-mode):
+ * jit-lock.el (jit-lock-debug-mode):
+ * minibuffer.el (completion-in-region-mode):
+ * type-break.el (type-break-mode-line-message-mode)
+ (type-break-query-mode):
+ * emulation/tpu-edt.el (tpu-edt-mode):
+ * progmodes/subword.el (global-subword-mode, global-superword-mode):
+ * progmodes/vhdl-mode.el (vhdl-electric-mode, vhdl-stutter-mode):
+ * term/vt100.el (vt100-wide-mode): Specify explicit :group.
+
+ * term/xterm.el (xterm): Change parent group to terminals.
+
+ * master.el (master): Remove empty custom group.
+ (master-mode): Remove unused :group argument.
+ * textmodes/refill.el (refill): Remove empty custom group.
+ (refill-mode): Remove unused :group argument.
+
+ * textmodes/rst.el (rst-compile-toolsets): Use rst-compile group.
+
+ * cus-dep.el: Provide a feature.
+ (custom-make-dependencies): Ignore dotfiles (dir-locals).
+ Don't mistakenly ignore files whose basenames match a basename
+ from preloaded-file-list (eg cedet/ede/simple.el).
+ Add a fallback method for getting :group.
+
+2013-05-15 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-char-by-name): Rename from
+ `isearch-insert-char-by-name'. Doc fix.
+ (isearch-forward): Mention `isearch-char-by-name' in
+ the docstring. (Bug#13348)
+
+ * isearch.el (minibuffer-local-isearch-map): Bind "\r" to
+ `exit-minibuffer' instead of
+ `isearch-nonincremental-exit-minibuffer'.
+ (isearch-edit-string): Remove mention of
+ `isearch-nonincremental-exit-minibuffer' from docstring.
+ (isearch-nonincremental-exit-minibuffer): Mark as obsolete.
+ (isearch-forward-exit-minibuffer)
+ (isearch-reverse-exit-minibuffer): Add docstring. (Bug#13348)
+
+2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * loadup.el: Just use unversioned DOC.
+
+ * nxml/nxml-mode.el: Treat unclosed <[[, <?, comment, and other
+ literals as extending to EOB.
+ (nxml-last-fontify-end): Remove unused variable.
+ (nxml-after-change1): Use with-silent-modifications.
+ (nxml-extend-after-change-region): Simplify.
+ (nxml-extend-after-change-region1): Remove function.
+ (nxml-after-change1): Don't adjust for dependent regions.
+ (nxml-fontify-matcher): Simplify.
+ * nxml/xmltok.el (xmltok-dependent-regions): Remove variable.
+ (xmltok-add-dependent): Remove function.
+ (xmltok-scan-after-lt, xmltok-scan-after-processing-instruction-open)
+ (xmltok-scan-after-comment-open, xmltok-scan-prolog-literal)
+ (xmltok-scan-prolog-after-processing-instruction-open): Treat
+ unclosed <[[, <?, comment, and other literals as extending to EOB.
+ * nxml/rng-valid.el (rng-mark-xmltok-dependent-regions)
+ (rng-mark-xmltok-dependent-region, rng-dependent-region-changed):
+ Remove functions.
+ (rng-do-some-validation-1): Don't mark dependent regions.
+ * nxml/nxml-rap.el (nxml-adjust-start-for-dependent-regions)
+ (nxml-mark-parse-dependent-regions, nxml-mark-parse-dependent-region)
+ (nxml-clear-dependent-regions): Remove functions.
+ (nxml-scan-after-change, nxml-scan-prolog, nxml-tokenize-forward)
+ (nxml-ensure-scan-up-to-date):
+ Don't clear&mark dependent regions.
+
+2013-05-15 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-goto-function-definition):
+ Improve and fix callers.
+
+2013-05-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/cl-extra.el (cl-getf): Return the proper value in
+ the setter (bug#14387).
+
+ * progmodes/f90.el (f90-blocks-re): Include the terminating \> in the
+ surrounding group (bug#14402).
+
+2013-05-14 Juri Linkov <juri@jurta.org>
+
+ * subr.el (find-tag-default-as-regexp): Return nil if `tag' is nil.
+ (Bug#14390)
+
+2013-05-14 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/f90.el (f90-imenu-generic-expression):
+ Fix typo in 2013-05-08 change. (Bug#14402)
+
+2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
+
+ * progmodes/gdb-mi.el (gdb-running, gdb-starting):
+ Remove signals for which replies are never received.
+
+2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
+
+ * progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845)
+ (gdb-handler-alist, gdb-handler-number): Remove variables.
+ (gdb-handler-list): New variable.
+ (gdb-add-handler, gdb-delete-handler, gdb-get-handler-function)
+ (gdb-pending-handler-p, gdb-handle-reply)
+ (gdb-remove-all-pending-triggers): New functions.
+ (gdb-discard-unordered-replies): New defcustom.
+ (gdb-handler): New defstruct.
+ (gdb-wait-for-pending): Fix invalid backquote. Use gdb-handler-list.
+ instead of gdb-pending-triggers. Update docstring.
+ (gdb-init-1): Remove dead variables. Initialize gdb-handler-list.
+ (gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update)
+ (gdb-var-update-handler, def-gdb-auto-update-trigger)
+ (def-gdb-auto-update-handler, gdb-get-changed-registers)
+ (gdb-changed-registers-handler, gdb-get-main-selected-frame)
+ (gdb-frame-handler): Pending triggers are now automatically managed.
+ (def-gdb-trigger-and-handler, def-gdb-auto-update-handler):
+ Remove argument.
+ (gdb-input): Automatically handles pending triggers. Update docstring.
+ (gdb-resync): Replace gdb-pending-triggers by gdb-handler-list.
+ (gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler):
+ Update comments.
+ (gdb-done-or-error): Now use gdb-handle-reply.
+
+2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
+
+ * progmodes/gdb-mi.el (gdb-input): Include token numbers in
+ gdb-debug-log.
+
+2013-05-14 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (user-emacs-directory-warning): New option.
+ (locate-user-emacs-file): Handle non-accessible .emacs.d. (Bug#13930)
+
+2013-05-14 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-font-lock-keywords): Fix error
+ during redisplay.
+ (octave-goto-function-definition, octave-find-definition): Minor tweaks.
+ (octave-font-lock-texinfo-comment): Fix invalid search bound
+ error: wrong side of point.
+
+2013-05-14 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/flymake.el (flymake-xml-program): New option.
+ (flymake-xml-init): Use it.
+
+ * term/xterm.el: Provide a feature.
+
+ * term/sup-mouse.el: Move to obsolete/. Provide a feature.
+
+2013-05-13 Glenn Morris <rgm@gnu.org>
+
+ * cus-dep.el (defcustom-mh, defgroup-mh, defface-mh):
+ Add compat aliases as a hack workaround. (Bug#14384)
+
+2013-05-13 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-indent-comment): Fix indentation for
+ ###, and %!.
+ (octave-mode-map): Bind octave-indent-defun to C-c C-q instead of
+ C-M-q.
+ (octave-comment-start-skip): Include %!.
+ (octave-mode): Set comment-start-skip to octave-comment-start-skip.
+
+2013-05-12 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup): Store the value
+ of __octave_srcdir__ for octave-source-directories.
+ (inferior-octave-check-process): New function refactored out of
+ inferior-octave-send-list-and-digest.
+ (octave-source-directories)
+ (octave-find-definition-filename-function): New variables.
+ (octave-source-directories)
+ (octave-find-definition-default-filename): New functions.
+ (octave-find-definition): Improve to find functions implemented in C++.
+
+2013-05-12 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-outlook-format-1):
+ Don't include dayname in the output. (Bug#14349)
+
+2013-05-11 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/autoload.el (generated-autoload-load-name): Doc fix.
+
+ * cus-dep.el (custom-make-dependencies): Only use safe local variables.
+ Treat cc-provide like provide.
+
+2013-05-11 Kevin Ryde <user42@zip.com.au>
+
+ * cus-dep.el (custom-make-dependencies):
+ Use generated-autoload-load-name for the sake of files such
+ such cedet/semantic/bovine/c.el, where the base file name
+ is not in load-path. (Bug#5277)
+
+2013-05-11 Glenn Morris <rgm@gnu.org>
+
+ * dos-vars.el, emacs-lisp/cl-indent.el, emulation/tpu-extras.el:
+ Provide features.
+
+2013-05-11 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-indent-comment): Improve.
+ (octave-eldoc-message-style, octave-eldoc-cache): New variables.
+ (octave-eldoc-function-signatures, octave-eldoc-function):
+ New functions.
+ (octave-mode, inferior-octave-mode): Add eldoc support.
+
+2013-05-11 Richard Stallman <rms@gnu.org>
+
+ * epa.el (epa-decrypt-file): Take output file name as argument
+ and read it using `interactive'.
+
+2013-05-11 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-beginning-of-line)
+ (octave-end-of-line): Check before using up-list because it jumps
+ out of more syntactic contructs since moving to smie.
+ (octave-indent-comment): New function.
+ (octave-mode): Use it in smie-indent-functions. (Bug#14350)
+ (octave-begin-keywords, octave-end-keywords)
+ (octave-reserved-words, octave-smie-bnf-table)
+ (octave-smie-rules): Add new keywords from Octave 3.6.4.
+
+2013-05-11 Glenn Morris <rgm@gnu.org>
+
+ * faces.el (internal-face-x-get-resource):
+ * frame.el (ns-display-monitor-attributes-list):
+ * calc/calc-aent.el (math-to-radians-2):
+ * emacs-lisp/package.el (tar-header-name, tar-header-link-type):
+ Fix declarations.
+
+ * calc/calc-menu.el: Make it loadable in isolation.
+
+ * net/eudcb-bbdb.el: Make it loadable without bbdb.
+ (eudc-bbdb-filter-non-matching-record, eudc-bbdb-extract-phones)
+ (eudc-bbdb-extract-addresses, eudc-bbdb-format-record-as-result)
+ (eudc-bbdb-query-internal): Require 'bbdb.
+
+ * lpr.el (lpr-headers-switches):
+ * emacs-lisp/testcover.el (testcover-compose-functions): Fix :type.
+
+ * progmodes/sql.el (sql-login-params): Fix and improve :type.
+
+ * emulation/edt-mapper.el: In batch mode, error rather than hang.
+
+ * term.el (term-set-escape-char): Make it idempotent.
+
+2013-05-10 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-completion-table):
+ No longer a function and all uses changed. Use cache to speed up
+ completion due to bug#11906.
+ (octave-beginning-of-defun): Re-write to be more general.
+
+2013-05-10 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/cl-macs.el (cl-loop): Doc fix.
+
+2013-05-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * comint.el (comint-redirect-send-command-to-process): Use :around
+ rather than :override for comint-redirect-filter.
+ (comint-redirect-filter): Add the corresponding `orig-filter' argument.
+ Call it instead of comint-redirect-original-filter-function (which
+ is gone). Reported by Juanma Barranquero <lekktu@gmail.com>.
+
+2013-05-09 Jan Djärv <jan.h.d@swipnet.se>
+
+ * frame.el (display-monitor-attributes-list): Add NS case.
+ (ns-display-monitor-attributes-list): Declare.
+
+2013-05-09 Ulrich Mueller <ulm@gentoo.org>
+
+ * descr-text.el (describe-char): Fix %d/%x typo. (Bug#14360)
+
+2013-05-09 Glenn Morris <rgm@gnu.org>
+
+ * international/fontset.el (vertical-centering-font-regexp):
+ Set standard-value.
+
+ * tar-mode.el (tar-superior-buffer, tar-superior-descriptor): Add doc.
+
+ * bookmark.el (bookmark-search-delay):
+ * cus-start.el (vertical-centering-font-regexp):
+ * ps-mule.el (ps-mule-font-info-database-default):
+ * ps-print.el (ps-default-fg, ps-default-bg):
+ * type-break.el (type-break-good-break-interval):
+ * whitespace.el (whitespace-indentation-regexp)
+ (whitespace-space-after-tab-regexp):
+ * emacs-lisp/testcover.el (testcover-1value-functions)
+ (testcover-noreturn-functions, testcover-progn-functions)
+ (testcover-prog1-functions):
+ * emulation/viper-init.el (viper-emacs-state-cursor-color):
+ * eshell/em-glob.el (eshell-glob-translate-alist):
+ * play/tetris.el (tetris-tty-colors):
+ * progmodes/cpp.el (cpp-face-default-list):
+ * progmodes/flymake.el (flymake-allowed-file-name-masks):
+ * progmodes/idlw-help.el (idlwave-help-browser-generic-program)
+ (idlwave-help-browser-generic-args):
+ * progmodes/make-mode.el (makefile-special-targets-list):
+ * progmodes/python.el (python-shell-virtualenv-path):
+ * progmodes/verilog-mode.el (verilog-active-low-regexp)
+ (verilog-auto-input-ignore-regexp, verilog-auto-inout-ignore-regexp)
+ (verilog-auto-output-ignore-regexp, verilog-auto-tieoff-ignore-regexp)
+ (verilog-auto-unused-ignore-regexp, verilog-typedef-regexp):
+ * textmodes/reftex-vars.el (reftex-format-label-function):
+ * textmodes/remember.el (remember-diary-file): Fix custom types.
+
+ * jka-cmpr-hook.el (jka-compr-mode-alist-additions): Fix typo.
+ Add :version.
+
+2013-05-09 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-completion-at-point):
+ Restore file completion. (Bug#14300)
+ (inferior-octave-startup): Fix incorrect highlighting for the
+ first prompt.
+
+2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ruby-mode.el: First cut at SMIE support.
+ (ruby-use-smie): New var.
+ (ruby-smie-grammar): New constant.
+ (ruby-smie--bosp, ruby-smie--implicit-semi-p)
+ (ruby-smie--forward-token, ruby-smie--backward-token)
+ (ruby-smie-rules): New functions.
+ (ruby-mode-variables): Setup SMIE if applicable.
+
+2013-05-08 Eli Zaretskii <eliz@gnu.org>
+
+ * simple.el (line-move-visual): Signal beginning/end of buffer
+ only if vertical-motion moved less than it was requested. Avoids
+ silly incorrect error messages when there are display strings with
+ multiple newlines at EOL.
+
+2013-05-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/vera-mode.el (vera-underscore-is-part-of-word):
+ * progmodes/prolog.el (prolog-underscore-wordchar-flag)
+ (prolog-char-quote-workaround):
+ * progmodes/cperl-mode.el (cperl-under-as-char):
+ * progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word):
+ Mark as obsolete.
+ (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in
+ their declaration.
+ (vhdl-mode-syntax-table-init): Remove.
+
+ * progmodes/m4-mode.el (m4-mode-syntax-table): Add comment on
+ last change.
+
+ * progmodes/ld-script.el (ld-script-mode-syntax-table): Use symbol
+ syntax for "_".
+ (ld-script-font-lock-keywords):
+ Change regexps to use things like \_< and \_>.
+
+ * progmodes/f90.el (f90-mode-syntax-table): Use symbol syntax for "_".
+ Change all regexps to use things like \_< and \_>.
+
+ * progmodes/autoconf.el (autoconf-definition-regexp)
+ (autoconf-font-lock-keywords, autoconf-current-defun-function):
+ Handle a _ with symbol syntax.
+ (autoconf-mode): Don't change the syntax-table for imenu and font-lock.
+
+ * progmodes/ada-mode.el (ada-mode-abbrev-table):
+ Consolidate declaration.
+ (ada-mode-syntax-table, ada-mode-symbol-syntax-table): Initialize in
+ the declaration.
+ (ada-create-syntax-table): Remove.
+ (ada-capitalize-word): Don't mess with the syntax of "_" since it
+ already has the right syntax nowadays.
+ (ada-goto-next-word): Don't change the syntax of "_".
+
+ * font-lock.el (lisp-font-lock-keywords-2): Don't highlight obsolete
+ with-wrapper-hook.
+
+2013-05-08 Sam Steingold <sds@gnu.org>
+
+ * thingatpt.el (thing-at-point): Accept optional second argument
+ NO-PROPERTIES to strip the text properties from the return value.
+ * net/browse-url.el (browse-url-url-at-point): Pass NO-PROPERTIES
+ to `thing-at-point' instead of stripping the properties ourselves.
+ Also, when `thing-at-point' fails to find a url, prepend "http://"
+ to the filename at point on the assumption that the user is
+ pointing at something like gnu.org/gnu.
+
+2013-05-08 Juanma Barranquero <lekktu@gmail.com>
+
+ * emacs-lisp/bytecomp.el (byte-compile-insert-header):
+ * faces.el (crm-separator):
+ Silence byte-compiler.
+
+ * progmodes/gud.el (gdb-speedbar-auto-raise, gud-tooltip-mode)
+ (tool-bar-map): Remove unneeded defvars.
+
+2013-05-08 Leo Liu <sdl.web@gmail.com>
+
+ Re-work a fix for bug#10994 based on Le Wang's patch.
+ * ido.el (ido-remove-consecutive-dups): New helper.
+ (ido-completing-read): Use it.
+ (ido-chop): Revert fix for bug#10994.
+
+2013-05-08 Adam Spiers <emacs@adamspiers.org>
+
+ * cus-edit.el (custom-save-variables):
+ Pretty-print long values. (Bug#14187)
+
+2013-05-08 Glenn Morris <rgm@gnu.org>
+
+ * progmodes/m4-mode.el (m4-program): Assume it is in PATH.
+ (m4-mode-syntax-table): Init in the defvar.
+ (m4-mode-abbrev-table): Let define-derived-mode define it.
+
+2013-05-08 Tom Tromey <tromey@redhat.com>
+
+ * progmodes/m4-mode.el (m4-mode-syntax-table):
+ Do not treat "_" as word constituent. (Bug#14167)
+
+2013-05-07 Glenn Morris <rgm@gnu.org>
+
+ * eshell/em-hist.el (eshell-isearch-map): Initialize in the defvar.
+ Remove explicit eshell-isearch-cancel-map.
+
+ * progmodes/f90.el (f90-smart-end-names): New option.
+ (f90-smart-end): Doc fix.
+ (f90-end-block-optional-name): New constant.
+ (f90-block-match): Respect f90-smart-end-names.
+
+2013-05-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/octave.el (octave-smie-forward-token): Be more careful
+ about implicit semi-colons (bug#14218).
+
+2013-05-07 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ * frame.el (display-monitor-attributes-list)
+ (frame-monitor-attributes): New functions.
+
+2013-05-06 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-syntax-propertize-function): Change
+ \'s syntax to escape when inside double-quoted strings. (Bug#14332)
+ (octave-font-lock-keywords): Use octave-operator-regexp.
+ (octave-completion-at-point): Rename from
+ octave-completion-at-point-function.
+ (inferior-octave-directory-tracker): Robustify.
+ (octave-text-functions): Remove and fix its uses. No such things
+ any more.
+
+2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/trace.el (trace--display-buffer): New function.
+ (trace-make-advice): Use it.
+
+2013-05-06 Juri Linkov <juri@jurta.org>
+
+ * emacs-lisp/lisp-mode.el (eval-defun-2): Doc fix. (Bug#14344)
+ (eval-defun-2, eval-defun, eval-last-sexp, eval-last-sexp-1):
+ Doc fix.
+ (emacs-lisp-mode-map): Replace "minibuffer" with "echo area"
+ in the help string. (Bug#12985)
+
+2013-05-06 Kelly Dean <kellydeanch@yahoo.com> (tiny change)
+
+ * simple.el (shell-command-on-region): Doc fix. (Bug#14279)
+
+2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/perl-mode.el: Add support for here documents.
+ (perl-syntax-propertize-function): Match here-doc markers.
+ (perl-syntax-propertize-special-constructs): Find their end.
+ (perl-imenu-generic-expression): Use [:alnum:].
+
+ * emacs-lisp/nadvice.el (advice--member-p): Return the advice if found.
+ (advice--add-function): Refresh the advice if already present
+ (bug#14317).
+
+2013-05-06 Ivan Andrus <darthandrus@gmail.com>
+
+ * find-file.el (cc-other-file-alist): Add ".m" for ObjC. (Bug#14339)
+
+2013-05-06 Glenn Morris <rgm@gnu.org>
+
+ * w32-fns.el (w32-charset-info-alist): Declare.
+
+ * eshell/em-cmpl.el: Simply require pcomplete; eg we use a bunch
+ of its defcustom properties.
+ (eshell-cmpl-initialize): No need to load pcomplete.
+
+ * generic-x.el: No need to require comint when compiling.
+
+ * net/eudc-export.el: Make it loadable without bbdb.
+ (top-level): Use require rather than load-library.
+ (eudc-create-bbdb-record, eudc-bbdbify-phone)
+ (eudc-batch-export-records-to-bbdb)
+ (eudc-insert-record-at-point-into-bbdb, eudc-try-bbdb-insert):
+ Require bbdb.
+
+2013-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/octave.el (octave-texinfo-font-lock-keywords): Remove.
+ (octave-font-lock-texinfo-comment): Use texinfo-font-lock-keywords with
+ some tweaks, instead.
+
+2013-05-05 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-font-lock-keywords)
+ (octave-font-lock-texinfo-comment): Adjust for the byte-compiler.
+ (inferior-octave-send-list-and-digest): Improve error message.
+ (octave-mode, inferior-octave-mode): Use setq-local.
+ (octave-help): Set info-lookup-mode.
+
+2013-05-05 Richard Stallman <rms@gnu.org>
+
+ * vc/compare-w.el (compare-windows-whitespace):
+ Treat no-break space as whitespace.
+
+ * mail/rmailsum.el (rmail-summary-rmail-update):
+ Detect empty summary and don't change selected message.
+ (rmail-summary-goto-msg): Likewise.
+
+ * mail/rmailsum.el (rmail-new-summary, rmail-new-summary-1):
+ Doc fixes, rename args.
+
+2013-05-05 Alan Mackenzie <acm@muc.de>
+
+ * progmodes/cc-defs.el (c-version): Increment to 5.32.5.
+
+2013-05-05 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-read-subfile): Use (point-min) instead of (point)
+ to not add the length of the summary segment to the return value.
+ (Bug#14125)
+
+2013-05-05 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-strip-ctrl-g)
+ (inferior-octave-output-filter): Remove.
+ (octave-send-region, inferior-octave-startup): Fix callers.
+ (inferior-octave-mode-map): Don't use comint-dynamic-complete.
+ (octave-binary-file-extensions): New user variable.
+ (octave-find-definition): Confirm if opening binary files.
+ (octave-help-file): Use octave-find-definition to get the binary
+ confirmation.
+ (octave-help): Adjust for octave-help-file change.
+
+2013-05-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/pascal.el (pascal-font-lock-keywords): Use backquotes.
+ Merge the two entries that handle function definitions.
+ (pascal--syntax-propertize): New const.
+ (pascal-mode): Use it. Use setq-local.
+
+2013-05-04 Glenn Morris <rgm@gnu.org>
+
+ * calendar/diary-lib.el (diary-from-outlook-function): New variable.
+ (diary-from-outlook): Respect diary-from-outlook-function.
+
+2013-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * simple.el (read-expression-map): Use completion-at-point (bug#14255).
+ Move the declaration from C.
+ (read-minibuffer, eval-minibuffer): Move from C.
+ (completion-setup-function): Avoid minibuffer-completion-contents.
+
+2013-05-03 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-font-lock-keywords): Do not
+ dehighlight 'end' in comments or strings.
+ (octave-completing-read, octave-goto-function-definition):
+ New helpers.
+ (octave-help-buffer): New user variable.
+ (octave-help-file, octave-help-function): New button types.
+ (octave-help): New command and bind it to C-h ;.
+ (octave-find-definition): New command and bind it to M-.
+ (user-error): Alias to error if not defined.
+
+2013-05-02 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-mode-syntax-table): Correct syntax
+ for \. (bug#14332)
+ (octave-font-lock-keywords): Include [ and {.
+
+2013-05-02 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup-file): Change default.
+ (inferior-octave): Remove calling comint-mode and return the buffer.
+ (inferior-octave-startup): Cosmetic changes.
+
+2013-05-02 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-syntax-propertize-function):
+ Include the case when ' is at line beginning. (Bug#14336)
+
+2013-05-02 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-dir.el (vc-dir-mode): Don't autoload it for everyone.
+ * desktop.el (vc-dir-mode): Just autoload it here.
+
+2013-05-02 Alan Mackenzie <acm@muc.de>
+
+ Eliminate variable c-standard-font-lock-fontify-region-function.
+ * progmodes/cc-mode.el
+ (c-standard-font-lock-fontify-region-function): Remove.
+ (c-font-lock-fontify-region, c-after-font-lock-init): Adapt.
+
+2013-05-01 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el: Compatible with older emacs-24 releases.
+ (inferior-octave-has-built-in-variables): Remove. Built-in
+ variables were removed from Octave in 2007.
+ (inferior-octave-startup): Fix uses.
+ (comint-line-beginning-position): Remove compatibility code for
+ emacs 21.
+
+2013-05-01 Juri Linkov <juri@jurta.org>
+
+ * isearch.el (isearch-forward, isearch-mode): Doc fix. (Bug#13923)
+
+2013-05-01 Juri Linkov <juri@jurta.org>
+
+ * comint.el (comint-previous-matching-input): Don't print message
+ "History item: %d" when `isearch-mode' is active.
+ (comint-history-isearch-message): Print message "History item: %d"
+ when `comint-input-ring-index' is not empty and this function is
+ called from `isearch-update' with a nil `ellipsis'. (Bug#13223)
+
+2013-05-01 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-abbrev-table): Remove abbrev
+ definitions. Use completion-at-point to insert keywords.
+ (octave-abbrev-start): Remove.
+ (inferior-octave-mode, octave-mode): Use :abbrev-table instead.
+
+2013-04-30 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-prompt-read-only): Fix last
+ change.
+
+2013-04-30 Alan Mackenzie <acm@muc.de>
+
+ Handle arbitrarily long C++ member initialization lists.
+ * progmodes/cc-engine.el (c-back-over-member-initializers):
+ new function.
+ (c-guess-basic-syntax): New CASE 5R (extracted from 5B) to handle
+ (most) member init lists.
+
+2013-04-30 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * progmodes/octave.el (inferior-octave-prompt-read-only): New user
+ variable.
+
+2013-04-30 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-variables): Remove. No builtin
+ variables any more. All converted to functions.
+ (octave-font-lock-keywords, octave-completion-at-point-function):
+ Fix uses.
+ (octave-font-lock-texinfo-comment): New user variable.
+ (octave-texinfo-font-lock-keywords): New variable for texinfo
+ comment block.
+ (octave-function-comment-block): New face.
+ (octave-font-lock-texinfo-comment): New function.
+ (octave-mode): Font lock texinfo comment block.
+
+2013-04-29 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-font-lock-keywords): Handle 'end' in
+ indexing expression.
+ (octave-continuation-string): Do not use \.
+ (inferior-octave-complete-impossible): Remove.
+ (inferior-octave-completion-table)
+ (inferior-octave-completion-at-point): Remove its uses.
+ (inferior-octave-startup): completion_matches was introduced to
+ Octave in 1996 so safe to assume it.
+ (octave-function-file-comment): Improve to follow how Octave does it.
+ (octave-update-function-file-comment): Tweak.
+
+2013-04-29 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (inferior-octave-startup-hook): Obsolete.
+ (inferior-octave-startup): Remove inferior-octave-startup-hook.
+ (octave-function-file-comment): Fix typo.
+ (octave-sync-function-file-names): Use read-char-choice.
+
+2013-04-28 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc.el (math-normalize): Don't set `math-normalize-error'
+ to t for the less important warnings.
+
+2013-04-27 Darren Hoo <darren.hoo@gmail.com> (tiny change)
+
+ * isearch.el (isearch-fail-pos): Check for empty `cmds'. (Bug#14268)
+
+2013-04-27 Glenn Morris <rgm@gnu.org>
+
+ * vc/log-view.el (log-view-current-entry):
+ Treat "---" separator lines as part of the following rev. (Bug#14169)
+
+2013-04-27 Juri Linkov <juri@jurta.org>
+
+ * subr.el (read-number): Doc fix about using it by interactive
+ code letter `n'. (Bug#14254)
+
+2013-04-27 Juri Linkov <juri@jurta.org>
+
+ * desktop.el (desktop-auto-save-timeout): New option.
+ (desktop-file-checksum): New variable.
+ (desktop-save): Add optional arg `auto-save' and don't auto-save
+ if nothing changed.
+ (desktop-auto-save-timer): New variable.
+ (desktop-auto-save, desktop-auto-save-set-timer): New functions.
+ (after-init-hook): Call `desktop-auto-save-set-timer'.
+ Suggested by Reuben Thomas <rrt@sc3d.org> in
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00327.html>.
+
+2013-04-27 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-function-file-p)
+ (octave-skip-comment-forward, octave-function-file-comment)
+ (octave-update-function-file-comment): New functions.
+ (octave-mode-map): Bind C-c ; to
+ octave-update-function-file-comment.
+ (octave-mode-menu): Add octave-update-function-file-comment.
+ (octave-mode, inferior-octave-mode): Fix doc-string.
+ (octave-insert-defun): Conform to Octave's coding convention.
+ (Bug#14285)
+
+ * files.el (basic-save-buffer): Don't let errors in
+ before-save-hook prevent saving buffer.
+
+2013-04-20 Roland Winkler <winkler@gnu.org>
+
+ * faces.el (read-face-name): Use completing-read if arg multiple
+ is nil.
+
+2013-04-27 Ingo Lohmar <i.lohmar@gmail.com> (tiny change)
+
+ * ls-lisp.el (ls-lisp-insert-directory): If no files are
+ displayed, move point to after the totals line.
+ See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00677.html
+ for the details.
+
+2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-autoload-ensure-default-file):
+ Add current dir to the load-path.
+ (package-generate-autoloads): Don't rely on
+ autoload-ensure-default-file.
+
+2013-04-26 Reuben Thomas <rrt@sc3d.org>
+
+ * textmodes/remember.el (remember-store-in-files): Document that
+ the file name format is passed to `format-time-string'.
+
+2013-04-26 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-sync-function-file-names): New function.
+ (octave-mode): Use it in before-save-hook.
+
+2013-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/tabulated-list.el (tabulated-list-mode): Disable undo
+ (bug#14274).
+
+ * progmodes/octave.el (octave-smie-forward-token): Properly skip
+ \n and comment, even if it's not an implicit ; (bug#14218).
+
+2013-04-26 Glenn Morris <rgm@gnu.org>
+
+ * subr.el (read-number): Once more use `read' rather than
+ `string-to-number', to trap non-numeric input. (Bug#14254)
+
+2013-04-26 Erik Charlebois <erikcharlebois@gmail.com>
+
+ * emacs-lisp/syntax.el (syntax-propertize-multiline):
+ Use `syntax-multiline' text property consistently instead of
+ `font-lock-multiline'. (Bug#14237)
+
+2013-04-26 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/shadow.el (list-load-path-shadows):
+ No longer necessary to check for duplicate simple.el, since
+ 2012-07-07 change to init_lread to not include installation lisp
+ directories in load-path when running uninstalled. (Bug#14270)
+
+2013-04-26 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-submit-bug-report): Obsolete.
+ (octave-mode, inferior-octave-mode): Use setq-local.
+ (octave-not-in-string-or-comment-p): Rename to
+ octave-in-string-or-comment-p.
+ (octave-in-comment-p, octave-in-string-p)
+ (octave-in-string-or-comment-p): Replace defsubst with defun.
+
+2013-04-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * Makefile.in (distclean): Remove $(lisp)/loaddefs.el~.
+
+2013-04-25 Bastien Guerry <bzg@gnu.org>
+
+ * textmodes/remember.el (remember-data-directory)
+ (remember-directory-file-name-format): Fix custom types.
+
+2013-04-25 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave.el (octave-completion-at-point-function):
+ Make use of inferior octave process.
+ (octave-initialize-completions): Remove.
+ (inferior-octave-completion-table): New function.
+ (inferior-octave-completion-at-point): Use it.
+ (octave-completion-alist): Remove.
+
+2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/opascal.el: Use font-lock and syntax-propertize.
+ (opascal-mode-syntax-table): New var.
+ (opascal-literal-kind, opascal-is-literal-end)
+ (opascal-literal-token-at): Rewrite.
+ (opascal--literal-start-re, opascal-font-lock-keywords)
+ (opascal--syntax-propertize): New constants.
+ (opascal-font-lock-defaults): Adjust.
+ (opascal-mode): Use them. Set comment-<foo> variables as well.
+ (delphi-comment-face, opascal-comment-face, delphi-string-face)
+ (opascal-string-face, delphi-keyword-face, opascal-keyword-face)
+ (delphi-other-face, opascal-other-face): Remove face variables.
+ (opascal-save-state): Remove macro.
+ (opascal-fontifying-progress-step): Remove constant.
+ (opascal--ignore-changes): Remove var.
+ (opascal-set-token-property, opascal-parse-next-literal)
+ (opascal-is-stable-literal, opascal-complete-literal)
+ (opascal-is-literal-start, opascal-face-of)
+ (opascal-parse-region, opascal-parse-region-until-stable)
+ (opascal-fontify-region, opascal-after-change)
+ (opascal-debug-show-is-stable, opascal-debug-unparse-buffer)
+ (opascal-debug-parse-region, opascal-debug-parse-window)
+ (opascal-debug-parse-buffer, opascal-debug-fontify-window)
+ (opascal-debug-fontify-buffer): Remove.
+ (opascal-debug-mode-map): Adjust accordingly.
+
+2013-04-25 Leo Liu <sdl.web@gmail.com>
+
+ Merge octave-mod.el and octave-inf.el into octave.el with some
+ cleanups.
+ * progmodes/octave.el: New file renamed from octave-mod.el.
+ * progmodes/octave-inf.el: Merged into octave.el.
+ * progmodes/octave-mod.el: Renamed to octave.el.
+
+2013-04-25 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el
+ (reftex-label-ignored-macros-and-environments): New defcustom.
+
+ * textmodes/reftex-parse.el (reftex-parse-from-file): Use it.
+
+2013-04-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-indent--hanging-p): Don't burp at EOB.
+ (smie-indent-keyword): Improve the check to ensure that the next
+ comment is really on the same line.
+ (smie-indent-comment): Don't align with a subsequent closer (or eob).
+
+ * progmodes/octave-mod.el (octave-smie-forward-token): Only emit
+ semi-colons if the line is not otherwise empty (bug#14218).
+
+2013-04-25 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-print-log): Tweak LIMIT = 1 case.
+
+2013-04-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/opascal.el (opascal-set-token-property): Rename from
+ opascal-set-text-properties and only set `token' (bug#14134).
+ Suggested by Erik Knowles <eknowles@geosystemsoftware.com>.
+ (opascal-literal-text-properties): Remove.
+ (opascal-parse-next-literal, opascal-debug-unparse-buffer):
+ Adjust callers.
+
+2013-04-24 Reuben Thomas <rrt@sc3d.org>
+
+ * textmodes/remember.el (remember-handler-functions): Add an
+ option for a new handler `remember-store-in-files'.
+ (remember-data-directory, remember-directory-file-name-format):
+ New options.
+ (remember-store-in-files): New function to store remember notes
+ as separate files within a directory.
+
+2013-04-24 Magnus Henoch <magnus.henoch@gmail.com>
+
+ * progmodes/compile.el (compilation-next-error-function):
+ Pass "formats" to compilation-find-file (bug#11777).
+
+2013-04-24 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc-bzr.el (vc-bzr-print-log):
+ * vc/vc-hg.el (vc-hg-print-log):
+ * vc/vc-svn.el (vc-svn-print-log):
+ Fix START-REVISION with LIMIT != 1. (Bug#14168)
+
+ * vc/vc-bzr.el (vc-bzr-print-log):
+ * vc/vc-cvs.el (vc-cvs-print-log):
+ * vc/vc-git.el (vc-git-print-log):
+ * vc/vc-hg.el (vc-hg-print-log):
+ * vc/vc-mtn.el (vc-mtn-print-log):
+ * vc/vc-rcs.el (vc-rcs-print-log):
+ * vc/vc-sccs.el (vc-sccs-print-log):
+ * vc/vc-svn.el (vc-svn-print-log):
+ * vc/vc.el (vc-print-log-internal): Doc fixes.
+
+2013-04-23 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (normal-no-mouse-startup-screen, normal-about-screen):
+ Remove venerable code attempting to avoid substitute-command-keys.
+
+2013-04-23 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-label-regexps):
+ Call `reftex-compile-variables' after changes to this variable.
+
+2013-04-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * jit-lock.el: Fix signals in jit-lock-force-redisplay (bug#13542).
+ Use lexical-binding.
+ (jit-lock-force-redisplay): Use markers, check buffer's continued
+ existence and beware narrowed buffers.
+ (jit-lock-fontify-now): Adjust call accordingly.
+
+2013-04-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-completion-contents): Fix obsolescence info
+ to avoid misleading the user.
+
+2013-04-22 Leo Liu <sdl.web@gmail.com>
+
+ * info-look.el: Prefer latex2e.info. (Bug#14240)
+
+2013-04-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix pack/unpack coding. Reported by David Smith <davidsmith@acm.org>.
+
+ * net/tramp-compat.el (tramp-compat-call-process): Move function ...
+ * net/tramp.el (tramp-call-process): ... here.
+ (tramp-set-completion-function, tramp-parse-putty):
+ * net/tramp-adb.el (tramp-adb-execute-adb-command):
+ * net/tramp-gvfs.el (tramp-gvfs-send-command):
+ * net/tramp-sh.el (tramp-sh-handle-set-file-times)
+ (tramp-set-file-uid-gid, tramp-sh-handle-write-region)
+ (tramp-call-local-coding-command): Use `tramp-call-process'
+ instead of `tramp-compat-call-process'.
+
+ * net/tramp-sh.el (tramp-perl-pack, tramp-perl-unpack): New defconst.
+ (tramp-local-coding-commands, tramp-remote-coding-commands): Use them.
+ (tramp-sh-handle-file-local-copy, tramp-sh-handle-write-region)
+ (tramp-find-inline-compress): Improve traces.
+ (tramp-maybe-send-script): Check for Perl binary.
+ (tramp-get-inline-coding): Do not redirect STDOUT for local decoding.
+
+2013-04-22 Daiki Ueno <ueno@gnu.org>
+
+ * epg.el (epg-context-pinentry-mode): New function.
+ (epg-context-set-pinentry-mode): New function.
+ (epg--start): Pass --pinentry-mode option to gpg command.
+
+2013-04-21 Xue Fuqiao <xfq.free@gmail.com>
+
+ * comint.el (comint-dynamic-complete-functions, comint-mode-map):
+ `comint-dynamic-complete' is obsolete since 24.1, replaced by
+ `completion-at-point'. (Bug#13774)
+
+ * startup.el (normal-no-mouse-startup-screen): Bug fix, the
+ default key binding for `describe-distribution' has been moved to
+ `C-h C-o'. (Bug#13970)
+
+2013-04-21 Glenn Morris <rgm@gnu.org>
+
+ * vc/vc.el (vc-print-log-setup-buttons, vc-print-log-internal):
+ Add doc strings.
+ (vc-print-log): Clarify interactive prompt.
+
+2013-04-20 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-insert-header):
+ No longer include timestamp etc information.
+
+2013-04-20 Roland Winkler <winkler@gnu.org>
+
+ * faces.el (read-face-name): Bug fix, return just one face if arg
+ multiple is nil. (Bug#14209)
+
+2013-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (advice--where-alist): Add :override.
+ (remove-function): Autoload.
+
+ * comint.el (comint-redirect-original-filter-function): Remove.
+ (comint-redirect-cleanup, comint-redirect-send-command-to-process):
+ * vc/vc-cvs.el (vc-cvs-annotate-process-filter)
+ (vc-cvs-annotate-command):
+ * progmodes/octave-inf.el (inferior-octave-send-list-and-digest):
+ * progmodes/prolog.el (prolog-consult-compile):
+ * progmodes/gdb-mi.el (gdb, gdb--check-interpreter):
+ Use add/remove-function instead.
+ * progmodes/gud.el (gud-tooltip-original-filter): Remove.
+ (gud-tooltip-process-output, gud-tooltip-tips):
+ Use add/remove-function instead.
+ * progmodes/xscheme.el (xscheme-previous-process-state): Remove.
+ (scheme-interaction-mode, exit-scheme-interaction-mode):
+ Use add/remove-function instead.
+
+ * vc/vc-dispatcher.el: Use lexical-binding.
+ (vc--process-sentinel): Rename from vc-process-sentinel.
+ Change last arg to be the code to run. Don't use vc-previous-sentinel
+ and vc-sentinel-commands any more.
+ (vc-exec-after): Allow code to be a function. Use add/remove-function.
+ (compilation-error-regexp-alist, view-old-buffer-read-only): Declare.
+
+2013-04-19 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/sh-script.el (sh-imenu-generic-expression):
+ Handle function names with a single character. (Bug#14111)
+
+2013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change)
+
+ * progmodes/gud.el (gud-perldb-marker-filter): Understand position info
+ for subroutines defined in an eval (bug#14182).
+
+2013-04-19 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * bookmark.el (bookmark-completing-read): Improve handling of empty
+ string (bug#14176).
+
+2013-04-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-dispatcher.el (vc-do-command): Get rid of default sentinel msg.
+
+2013-04-19 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ New faster Imenu implementation (bug#14058).
+ * progmodes/python.el (python-imenu-prev-index-position)
+ (python-imenu-format-item-label-function)
+ (python-imenu-format-parent-item-label-function)
+ (python-imenu-format-parent-item-jump-label-function):
+ New vars.
+ (python-imenu-format-item-label)
+ (python-imenu-format-parent-item-label)
+ (python-imenu-format-parent-item-jump-label)
+ (python-imenu--put-parent, python-imenu--build-tree)
+ (python-imenu-create-index, python-imenu-create-flat-index)
+ (python-util-popn): New functions.
+ (python-mode): Set imenu-create-index-function to
+ python-imenu-create-index.
+
+2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * winner.el (winner-active-region): Use region-active-p, activate-mark
+ and deactivate-mark (bug#14225).
+
+ * simple.el (deactivate-mark): Don't inline it.
+
+2013-04-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-remote-process-environment): Add "TMOUT=0".
+
+2013-04-18 Tassilo Horn <tsdh@gnu.org>
+
+ * files.el (auto-mode-alist): Delete OpenDocument and StarOffice
+ file extensions from the archive-mode entry in order to prefer
+ doc-view-mode-maybe with archive-mode as fallback (bug#14188).
+
+2013-04-18 Leo Liu <sdl.web@gmail.com>
+
+ * bindings.el (help-event-list): Add ?\?.
+
+2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (with-wrapper-hook): Declare obsolete.
+ * simple.el (filter-buffer-substring-function): New hook.
+ (filter-buffer-substring): Use it.
+ (filter-buffer-substring-functions): Mark obsolete.
+ * minibuffer.el (completion-in-region-function): New hook.
+ (completion-in-region): Use it.
+ (completion-in-region-functions): Mark obsolete.
+ * mail/mailabbrev.el (mail-abbrevs-setup): Use abbrev-expand-function.
+ * abbrev.el (abbrev-expand-function): New hook.
+ (expand-abbrev): Use it.
+ (abbrev-expand-functions): Mark obsolete.
+ * emacs-lisp/nadvice.el (advice--where-alist): Add :filter-args
+ and :filter-return.
+
+2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-nav--syntactically): Fix cornercases
+ and do not care about match data.
+
+2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/lisp.el (lisp-completion-at-point): Provide specialized
+ completion tables when completing error conditions and
+ `declare' arguments.
+ (lisp-complete-symbol, field-complete): Mark as obsolete.
+ (check-parens): Unmatched parens are user errors.
+ * minibuffer.el (minibuffer-completion-contents): Mark as obsolete.
+
+2013-04-17 Michal Nazarewicz <mina86@mina86.com>
+
+ * textmodes/flyspell.el (flyspell-check-pre-word-p): Return nil if
+ command changed buffer (ie. `flyspell-pre-buffer' is not current
+ buffer), which prevents making decisions based on invalid value of
+ `flyspell-pre-point' in the wrong buffer. Most notably, this used to
+ cause an error when `flyspell-pre-point' was nil after switching
+ buffers.
+ (flyspell-post-command-hook): No longer needs to change buffers when
+ checking pre-word. While at it remove unnecessary progn.
+
+2013-04-17 Nicolas Richard <theonewiththeevillook@yahoo.fr> (tiny change)
+
+ * textmodes/ispell.el (ispell-add-per-file-word-list):
+ Fix `flyspell-correct-word-before-point' error when accepting
+ words and `coment-padding' is an integer by using
+ `comment-normalize-vars' (Bug #14214).
+
+2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ New defun movement commands.
+ * progmodes/python.el (python-nav--syntactically)
+ (python-nav--forward-defun, python-nav-backward-defun)
+ (python-nav-forward-defun): New functions.
+
+2013-04-17 Fabián Ezequiel Gallina <fgallina@gnu.org>
+
+ * progmodes/python.el (python-syntax--context-compiler-macro): New defun.
+ (python-syntax-context): Use named compiler-macro for backwards
+ compatibility with Emacs 24.x.
+
+2013-04-17 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave-mod.el (octave-mode-map): Fix key binding to
+ octave-hide-process-buffer.
+
+2013-04-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc/vc-hg.el (vc-hg-annotate-re): Disallow ": " in file names
+ (bug#14216).
+
+2013-04-17 Jean-Philippe Gravel <jpgravel@gmail.com>
+
+ * progmodes/gdb-mi.el (gdbmi-bnf-incomplete-record-result):
+ Fix adjustment of offset when receiving incomplete responses from GDB
+ (bug#14129).
+
+2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/python.el (python-mode-skeleton-abbrev-table): Rename from
+ python-mode-abbrev-table.
+ (python-skeleton-define): Adjust accordingly.
+ (python-mode-abbrev-table): New table that inherits from it so that
+ python-skeleton-autoinsert does not affect non-skeleton abbrevs.
+
+ * abbrev.el (abbrev--symbol): New function, extracted from abbrev-symbol.
+ (abbrev-symbol): Use it.
+ (abbrev--before-point): Use it since we already handle inheritance.
+
+2013-04-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/octave-mod.el (octave-mode-map): Remove redundant key
+ binding to info-lookup-symbol.
+
+2013-04-16 Juanma Barranquero <lekktu@gmail.com>
+
+ * minibuffer.el (completion--twq-all):
+ * term/ns-win.el (ns-initialize-window-system):
+ * term/w32-win.el (w32-initialize-window-system): Silence byte-compiler.
+
+2013-04-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el (add-function): Default simple vars to their
+ global bindings.
+
+ * doc-view.el (doc-view-start-process): Handle url-handler directories.
+
+2013-04-15 Dmitry Gutov <dgutov@yandex.ru>
+
+ * progmodes/ruby-mode.el (ruby-beginning-of-defun)
+ (ruby-end-of-defun, ruby-move-to-block): Bind `case-fold-search'
+ to nil.
+ (ruby-end-of-defun): Remove the unused arg, change the docstring
+ to reflect that this function is only used as the value of
+ `end-of-defun-function'.
+ (ruby-beginning-of-defun): Remove "top-level" from the docstring,
+ to reflect an earlier change that beginning/end-of-defun functions
+ jump between methods in a class definition, as well as top-level
+ functions.
+
+2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (minibuffer-complete): Don't just scroll
+ a *Completions* that's been iconified.
+ (minibuffer-force-complete): Make sure repetitions do cycle when going
+ through completion-in-region -> minibuffer-complete.
+
+2013-04-15 Alan Mackenzie <acm@muc.de>
+
+ Correct the placement of c-cpp-delimiters when there're #s not at
+ col 0.
+
+ * progmodes/cc-langs.el (c-anchored-cpp-prefix): Reformulate and
+ place a submatch around the #.
+ * progmodes/cc-mode.el(c-neutralize-syntax-in-and-mark-CPP):
+ Start a search at BOL. Put the c-cpp-delimiter category text propertiy
+ on the #, not BOL.
+
+2013-04-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/nadvice.el: Properly test names when adding advice.
+ (advice--member-p): New arg `name'.
+ (advice--add-function, advice-member-p): Use it (bug#14202).
+
+2013-04-15 Filipp Gunbin <fgunbin@fastmail.fm>
+
+ Reformulate java imenu-generic-expression.
+ The old expression contained ill formed regexps.
+
+ * progmodes/cc-menus.el (cc-imenu-java-ellipsis-regexp)
+ (cc-imenu-java-type-spec-regexp, cc-imenu-java-comment-regexp)
+ (cc-imenu-java-method-arg-regexp): New defconsts.
+ (cc-imenu-java-build-type-args-regex): New defun.
+ (cc-imenu-java-generic-expression): Fix, to remove "ambiguous"
+ handling of spaces in the regexp.
+
+2013-03-15 Agustín Martín Domingo <agustin.martin@hispalinux.es>
+
+ * textmodes/ispell.el (ispell-command-loop): Remove
+ flyspell highlight of a word when ispell accepts it (bug #14178).
+
+2013-04-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/ange-ftp.el (ange-ftp-run-real-handler-orig): New defun,
+ uses code from the previous `ange-ftp-run-real-handler'.
+ (ange-ftp-run-real-handler): Set it to `tramp-run-real-handler'
+ only in case that function exist. This is needed for proper
+ unloading of Tramp.
+
+2013-04-15 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-vars.el (reftex-label-regexps): New defcustom.
+
+ * textmodes/reftex.el (reftex-compile-variables): Use it.
+
+2013-04-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * files.el (normal-mode): Only use default major-mode if no other mode
+ was specified.
+
+ * emacs-lisp/trace.el (trace-values): New function.
+
+ * files.el: Allow : in local variables (bug#14089).
+ (hack-local-variable-regexp): New var.
+ (hack-local-variables-prop-line, hack-local-variables): Use it.
+
+2013-04-13 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-search-entries): Bug fix. Use match
+ data before it gets modified by bibtex-beginning-of-entry.
+
+2013-04-13 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-url): Doc fix.
+
+2013-04-13 Roland Winkler <winkler@gnu.org>
+
+ * textmodes/bibtex.el (bibtex-initialize): If the current buffer
+ does not visit a BibTeX file, exclude it from the list of buffers
+ returned by bibtex-initialize.
+
+2013-04-13 Stephen Berman <stephen.berman@gmx.net>
+
+ * window.el (split-window): Remove interactive form, since as a
+ command this function is a special case of split-window-below.
+ Correct doc string.
+
+2013-04-12 Roland Winkler <winkler@gnu.org>
+
+ * faces.el (read-face-name): Do not override value of arg default.
+ Allow single faces and strings as default values. Remove those
+ elements from return value that are not faces.
+ (describe-face): Simplify.
+ (face-at-point): New optional args thing and multiple so that this
+ function can provide the same functionality previously provided by
+ read-face-name.
+ (make-face-bold, make-face-unbold, make-face-italic)
+ (make-face-unitalic, make-face-bold-italic, invert-face)
+ (modify-face, read-face-and-attribute): Use face-at-point.
+
+ * cus-edit.el (customize-face, customize-face-other-window)
+ * cus-theme.el (custom-theme-add-face)
+ * face-remap.el (buffer-face-set)
+ * facemenu.el (facemenu-set-face): Use face-at-point.
+
+2013-04-12 Michael Albinus <michael.albinus@gmx.de>
+
+ * info.el (Info-file-list-for-emacs): Add "tramp" and "dbus".
+
+2013-04-10 Tassilo Horn <tsdh@gnu.org>
+
+ * textmodes/reftex-cite.el (reftex-parse-bibtex-entry): Don't cut
+ off leading { and trailing } from field values.
+
+2013-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/timer.el (timer--check): New function.
+ (timer--time, timer-set-function, timer-event-handler): Use it.
+ (timer-set-idle-time): Simplify.
+ (timer--activate): CSE.
+ (timer-event-handler): Give more info in error message.
+ (internal-timer-start-idle): New function, moved from C.
+
+ * mpc.el (mpc-proc): Add `restart' argument.
+ (mpc-proc-cmd): Use it.
+ (mpc--status-timer-run): Also catch signals from `mpc-proc'.
+ (mpc-status-buffer-show, mpc-tagbrowser-dir-toggle): Call `mpc-proc'
+ less often.
+
+2013-04-10 Masatake YAMATO <yamato@redhat.com>
+
+ * progmodes/sh-script.el: Implement `sh-mode' own
+ `add-log-current-defun-function' (bug#14112).
+ (sh-current-defun-name): New function.
+ (sh-mode): Use the function.
+
+2013-04-09 Bastien Guerry <bzg@gnu.org>
+
+ * simple.el (choose-completion-string): Fix docstring (bug#14163).
+
+2013-04-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-mode): Fix typo (bug#14144).
+
+ * emacs-lisp/timer.el (timer-event-handler): Don't retrigger a canceled
+ timer (bug#14156).
+
+2013-04-07 Nic Ferrier <nferrier@ferrier.me.uk>
+
+ * emacs-lisp/ert.el (should, should-not, should-error): Add edebug
+ declaration.
+
+2013-04-07 Leo Liu <sdl.web@gmail.com>
+
+ * pcmpl-x.el: New file.
+
+2013-04-06 Dmitry Antipov <dmantipov@yandex.ru>
+
+ Do not set x-display-name until X connection is established.
+ This is needed to prevent from weird situation described at
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00212.html>.
+ * frame.el (make-frame): Set x-display-name after call to
+ window system initialization function, not before.
+ * term/x-win.el (x-initialize-window-system): Add optional
+ display argument and use it.
+ * term/w32-win.el (w32-initialize-window-system):
+ * term/ns-win.el (ns-initialize-window-system):
+ * term/pc-win.el (msdos-initialize-window-system):
+ Add compatible optional display argument.
+
+2013-04-06 Eli Zaretskii <eliz@gnu.org>
+
+ * files.el (normal-backup-enable-predicate): On MS-Windows and
+ MS-DOS compare truenames of temporary-file-directory and of the
+ file, so that 8+3 aliases (usually found in $TEMP on Windows)
+ don't fail comparison by compare-strings. Also, compare file
+ names case-insensitively on MS-Windows and MS-DOS.
+
+2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-compute-transaction): Fix last fix.
+ Suggested by Donald Curtis <dcurtis@coe.edu> (bug#14082).
+
+2013-04-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ * whitespace.el (whitespace-color-on, whitespace-color-off):
+ Only call `font-lock-fontify-buffer' when `font-lock-mode' is on.
+
+2013-04-05 Jacek Chrząszcz <chrzaszcz@mimuw.edu.pl> (tiny change)
+
+ * ispell.el (ispell-set-spellchecker-params):
+ Really set `ispell-args' for all equivs.
+
+2013-04-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ido.el (ido-completions): Use extra elements of ido-decorations
+ (bug#14143).
+ (ido-decorations): Update docstring.
+
+2013-04-05 Michael Albinus <michael.albinus@gmx.de>
+
+ * autorevert.el (auto-revert-mode, auto-revert-tail-mode)
+ (global-auto-revert-mode): Let-bind `auto-revert-use-notify' to
+ nil during initialization, in order not to miss changes since the
+ file was opened. (Bug#14140)
+
+2013-04-05 Leo Liu <sdl.web@gmail.com>
+
+ * kmacro.el (kmacro-call-macro): Fix bug#14135.
+
+2013-04-05 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-units.el (calc-convert-units): Rewrite conditional.
+
+2013-04-04 Glenn Morris <rgm@gnu.org>
+
+ * electric.el (electric-pair-inhibit-predicate): Add :version.
+
+2013-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/package.el (package-compute-transaction): Fix ordering
+ when a package is required several times (bug#14082).
+
+2013-04-04 Roland Winkler <winkler@gnu.org>
+
+ * faces.el (read-face-name): Behave as promised by the docstring.
+ Assume that arg default is a list of faces.
+ (describe-face): Call read-face-name with list of default faces.
+
+2013-04-04 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ * bookmark.el: Fix deletion of bookmarks (bug#13972).
+ (bookmark-bmenu-list): Don't toggle filenames if alist is empty.
+ (bookmark-bmenu-execute-deletions): Only skip first line if it's
+ the header.
+ (bookmark-exit-hook-internal): Save even if list is empty.
+
+2013-04-04 Yann Hodique <yann.hodique@gmail.com> (tiny change)
+
+ * emacs-lisp/package.el (package-pinned-packages): New var.
+ (package--add-to-archive-contents): Obey it (bug#14118).
+
+2013-04-03 Alan Mackenzie <acm@muc.de>
+
+ Handle `parse-partial-sexp' landing inside a comment opener (Bug#13244).
+ Also adapt to the new values of element 7 of a parse state.
+
+ * progmodes/cc-engine.el (c-state-pp-to-literal): New optional
+ parameter `not-in-delimiter'. Handle being inside comment opener.
+ (c-invalidate-state-cache-1): Reckon with an extra "invalid"
+ character in case we're typing a '*' after a '/'.
+ (c-literal-limits): Handle the awkward "not-in-delimiter" cond arm
+ instead by passing the parameter to c-state-pp-to-literal.
+
+ * progmodes/cc-fonts.el (c-font-lock-doc-comments): New handling
+ for elt. 7 of a parse state.
+
+2013-04-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use UTF-8 for most files with non-ASCII characters (Bug#13936).
+ * international/latin1-disp.el, international/mule-util.el:
+ * language/cyril-util.el, language/european.el, language/ind-util.el:
+ * language/lao-util.el, language/thai.el, language/tibet-util.el:
+ * language/tibetan.el, language/viet-util.el:
+ Switch from iso-2022-7bit to utf-8 or (if needed) utf-8-emacs.
+
+2013-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * electric.el (electric-pair-inhibit-predicate): New var (bug#14000).
+ (electric-pair-post-self-insert-function): Use it.
+ (electric-pair-default-inhibit): New function, extracted from
+ electric-pair-post-self-insert-function.
+
+2013-03-31 Roland Winkler <winkler@gnu.org>
+
+ * emacs-lisp/crm.el (completing-read-multiple): Doc fix.
+
+2013-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * hi-lock.el (hi-lock-mode): Cleanup after revert-buffer (bug#13891).
+
+2013-03-30 Fabián Ezequiel Gallina <fabian@anue.biz>
+
+ Un-indent after "pass" and "return" statements (Bug#13888)
+ * progmodes/python.el (python-indent-block-enders): New var.
+ (python-indent-calculate-indentation): Use it.
+
+2013-03-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp.el (tramp-drop-volume-letter): Make it an ordinary
+ defun. Defining it as defalias could introduce too eager
+ byte-compiler optimization. (Bug#14030)
+
+2013-03-30 Chong Yidong <cyd@gnu.org>
+
+ * iswitchb.el (iswitchb-read-buffer): Fix typo.
+
+2013-03-30 Leo Liu <sdl.web@gmail.com>
+
+ * kmacro.el (kmacro-call-macro): Add optional arg MACRO.
+ (kmacro-execute-from-register): Pass the keyboard macro to
+ kmacro-call-macro or repeating won't work correctly.
+
+2013-03-30 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/subword.el: Back to using `forward-symbol'.
+
+ * subr.el (forward-whitespace, forward-symbol)
+ (forward-same-syntax): Move from thingatpt.el.
+
+2013-03-29 Leo Liu <sdl.web@gmail.com>
+
+ * kmacro.el (kmacro-to-register): New command.
+ (kmacro-execute-from-register): New function.
+ (kmacro-keymap): Bind to 'x'. (Bug#14071)
+
+2013-03-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mpc.el: Use defvar-local and setq-local.
+ (mpc--proc-connect): Connection failures are not bugs.
+ (mpc-mode-map): `follow-link' only applies to the buffer's content.
+ (mpc-volume-map): Bind to the up-events.
+
+2013-03-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/subword.el (superword-mode): Use `forward-sexp'
+ instead of `forward-symbol'.
+
+2013-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/edebug.el (edebug-mode): Make it a minor mode.
+ (edebug--recursive-edit): Use it.
+ (edebug-kill-buffer): Don't let-bind kill-buffer-hook.
+ (edebug-temp-display-freq-count): Don't let-bind buffer-read-only.
+
+2013-03-28 Leo Liu <sdl.web@gmail.com>
+
+ * vc/vc-bzr.el (vc-bzr-revert): Don't backup. (Bug#14066)
+
+2013-03-27 Eli Zaretskii <eliz@gnu.org>
+
+ * facemenu.el (list-colors-callback): New defvar.
+ (list-colors-redisplay): New function.
+ (list-colors-display): Install list-colors-redisplay as the
+ revert-buffer-function. (Bug#14063)
+
+2013-03-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-pcm--merge-completions): Make sure prefixes
+ and suffixes don't overlap (bug#14061).
+
+ * case-table.el: Use lexical-binding.
+ (case-table-get-table): New function.
+ (get-upcase-table): Use it. Mark as obsolete. Adjust callers.
+
+2013-03-27 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/subword.el: Add `superword-mode' to do word motion
+ over symbol_words (parallels and leverages `subword-mode' which
+ does word motion inside MixedCaseWords).
+
+2013-03-27 Aidan Gauland <aidalgol@no8wireless.co.nz>
+
+ * eshell/em-unix.el: Move su and sudo to...
+ * eshell/em-tramp.el: ...Eshell tramp module.
+
+2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * desktop.el (desktop--v2s): Rename from desktop-internal-v2s.
+ Change return value to be a sexp. Delay `get-buffer' to after
+ restoring the desktop (bug#13951).
+
+2013-03-26 Leo Liu <sdl.web@gmail.com>
+
+ * register.el: Move semantic tag handling back to
+ cedet/semantic/senator.el. (Bug#14052)
+
+2013-03-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * eshell/em-prompt.el (eshell-emit-prompt): Make sure we can't insert
+ into the prompt either (bug#13963).
+
+2013-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * font-lock.el (lisp-font-lock-keywords-2): Don't highlight the "error"
+ part of "(error-foo)".
+
+2013-03-24 Juri Linkov <juri@jurta.org>
+
+ * replace.el (list-matching-lines-prefix-face): New defcustom.
+ (occur-1): Pass `list-matching-lines-prefix-face' to the function
+ `occur-engine' if `face-differs-from-default-p' returns t.
+ (occur-engine): Add `,' inside backquote construct to evaluate
+ `prefix-face'. Propertize the prefix with the `prefix-face' face.
+ Pass `prefix-face' to the functions `occur-context-lines' and
+ `occur-engine-add-prefix'.
+ (occur-engine-add-prefix, occur-context-lines): Add optional arg
+ `prefix-face' and propertize the prefix with `prefix-face'.
+ (Bug#14017)
+
+2013-03-24 Leo Liu <sdl.web@gmail.com>
+
+ * nxml/rng-valid.el (rng-validate-while-idle)
+ (rng-validate-quick-while-idle): Guard against deleted buffer.
+ (Bug#13999)
+
+ * emacs-lisp/edebug.el (edebug-mode): Make sure edebug-kill-buffer
+ is the last entry in kill-buffer-hook.
+
+ * files.el (kill-buffer-hook): Doc fix.
+
+2013-03-23 Dmitry Gutov <dgutov@yandex.ru>
+
+ * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column):
+ Make it safe-local.
+
+ * vc/diff-mode.el (diff-mode-shared-map): Unbind "/" (Bug#14034).
+
+2013-03-23 Leo Liu <sdl.web@gmail.com>
+
+ * nxml/nxml-util.el (nxml-with-unmodifying-text-property-changes):
+ Remove.
+
+ * nxml/rng-valid.el (rng-validate-mode)
+ (rng-after-change-function, rng-do-some-validation):
+ * nxml/rng-maint.el (rng-validate-buffer):
+ * nxml/nxml-rap.el (nxml-tokenize-forward, nxml-ensure-scan-up-to-date):
+ * nxml/nxml-outln.el (nxml-show-all, nxml-set-outline-state):
+ * nxml/nxml-mode.el (nxml-mode, nxml-degrade, nxml-after-change)
+ (nxml-extend-after-change-region): Use with-silent-modifications.
+
+ * nxml/rng-nxml.el (rng-set-state-after): Do not let-bind
+ timer-idle-list.
+
+ * nxml/rng-valid.el (rng-validate-while-idle-continue-p)
+ (rng-next-error-1, rng-previous-error-1): Do not let-bind
+ timer-idle-list. (Bug#13999)
+
+2013-03-23 Juri Linkov <juri@jurta.org>
+
+ * info.el (info-index-match): New face.
+ (Info-index, Info-apropos-matches): Add a nested subgroup to the
+ main pattern and add text properties with the new face to matches
+ in index entries relative to the beginning of the index entry.
+ (Bug#14015)
+
+2013-03-21 Eric Ludlam <zappo@gnu.org>
+
+ * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots):
+ Inhibit read only while inserting objects.
+
+2013-03-22 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el: Update docs to mention
+ `cfengine-auto-mode'. Use \_> and \_< instead of \> and \< for
+ symbol motion. Remove "_" from the word syntax.
+
+2013-03-21 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el (cfengine-common-syntax): Add "_" to word
+ syntax for both `cfengine2-mode' and `cfengine3-mode'.
+
+2013-03-20 Juri Linkov <juri@jurta.org>
+
+ * info.el (Info-next-reference-or-link)
+ (Info-prev-reference-or-link): New functions.
+ (Info-next-reference, Info-prev-reference): Use them.
+ (Info-try-follow-nearest-node): Handle footnote navigation.
+ (Info-fontify-node): Fontify footnotes. (Bug#13989)
+
+2013-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * subr.el (posn-point, posn-string): Fix it here instead (bug#13979).
+ * mouse.el (mouse-on-link-p): Undo scroll-bar fix.
+
+2013-03-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Suppress unnecessary non-ASCII chatter during build process.
+ * international/ja-dic-cnv.el (skkdic-collect-okuri-nasi)
+ (batch-skkdic-convert): Suppress most of the chatter.
+ It's not needed so much now that machines are faster,
+ and its non-ASCII component was confusing; see Dmitry Gutov in
+ <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00508.html>.
+
+2013-03-20 Leo Liu <sdl.web@gmail.com>
+
+ * ido.el (ido-chop): Fix bug#10994.
+
+2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * whitespace.el (whitespace-font-lock, whitespace-font-lock-mode):
+ Remove vars.
+ (whitespace-color-on, whitespace-color-off):
+ Use `font-lock-fontify-buffer' (Bug#13817).
+
+2013-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mouse.el (mouse--down-1-maybe-follows-link): Fix follow-link
+ remapping in mode-line.
+ (mouse-on-link-p): Also check [mode-line follow-link] bindings.
+
+2013-03-19 Dmitry Gutov <dgutov@yandex.ru>
+
+ * whitespace.el (whitespace-color-on): Use `prepend' OVERRIDE
+ value for `whitespace-line' face (Bug#13875).
+ (whitespace-font-lock-keywords): Change description.
+ (whitespace-color-on): Don't save `font-lock-keywords' value, save
+ the constructed keywords instead.
+ (whitespace-color-off): Use `font-lock-remove-keywords' (Bug#13817).
+
+2013-03-19 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/compile.el (compilation-display-error): New command.
+ (compilation-mode-map, compilation-minor-mode-map): Bind it to
+ C-o. (Bug#13992)
+
+2013-03-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * term/x-win.el (x-keysym-pair): Add a Fixme (Bug#13936).
+
+2013-03-18 Jan Djärv <jan.h.d@swipnet.se>
+
+ * mouse.el (mouse-on-link-p): Check for scroll bar (Bug#13979).
+
+2013-03-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-compat.el (tramp-compat-user-error): New defun.
+
+ * net/tramp-adb.el (tramp-adb-handle-shell-command):
+ * net/tramp-gvfs.el (top):
+ * net/tramp.el (tramp-find-method, tramp-dissect-file-name)
+ (tramp-handle-shell-command): Use it.
+ (tramp-dissect-file-name): Raise an error when hostname is a
+ method name, and neither method nor user is specified.
+
+ * net/trampver.el: Update release number.
+
+2013-03-18 Leo Liu <sdl.web@gmail.com>
+
+ Make sure eldoc can be turned off properly.
+ * emacs-lisp/eldoc.el (eldoc-schedule-timer): Conditionalize on
+ eldoc-mode.
+ (eldoc-display-message-p): Revert last change.
+ (eldoc-display-message-no-interference-p)
+ (eldoc-print-current-symbol-info): Tweak.
+
+2013-03-18 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el (doc-view-new-window-function): Check the new window
+ overlay's display property instead the char property of the
+ buffer's first char. Use `with-selected-window' instead of
+ `save-window-excursion' with `select-window'.
+ (doc-view-document->bitmap): Check the current doc-view overlay's
+ display property instead the char property of the buffer's first char.
+
+2013-03-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Automate the build of ja-dic.el (Bug#13984).
+ * international/ja-dic-cnv.el (skkdic-convert): Remove the annotations
+ from the input, rather than assume that it's been done for us by the
+ SKK script unannotate.awk. Switch ja-dic.el to UTF-8. Don't put
+ the current date into a ja-dic.el comment, as that complicates
+ regression testing.
+
+2013-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * whitespace.el: Fix double evaluation.
+ (whitespace-space, whitespace-hspace, whitespace-tab)
+ (whitespace-newline, whitespace-trailing, whitespace-line)
+ (whitespace-space-before-tab, whitespace-indentation)
+ (whitespace-empty, whitespace-space-after-tab): Turn defcustoms into
+ obsolete defvars.
+ (whitespace-hspace-regexp): Fix regexp for emacs-unicode.
+ (whitespace-color-on): Use a single font-lock-add-keywords call.
+ Fix double-evaluation of face variables.
+
+2013-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-adb.el (tramp-adb-parse-device-names):
+ Use `start-process' instead of `call-process'. Otherwise, the
+ function might be blocked under MS Windows. (Bug#13299)
+
+2013-03-17 Leo Liu <sdl.web@gmail.com>
+
+ Extend eldoc to display info in the mode-line. (Bug#13978)
+ * emacs-lisp/eldoc.el (eldoc-post-insert-mode): New minor mode.
+ (eldoc-mode-line-string): New variable.
+ (eldoc-minibuffer-message): New function.
+ (eldoc-message-function): New variable.
+ (eldoc-message): Use it.
+ (eldoc-display-message-p)
+ (eldoc-display-message-no-interference-p):
+ Support eldoc-post-insert-mode.
+
+ * simple.el (eval-expression-minibuffer-setup-hook): New hook.
+ (eval-expression): Run it.
+
+2013-03-17 Roland Winkler <winkler@gnu.org>
+
+ * emacs-lisp/crm.el (completing-read-multiple): Ignore empty
+ strings in the list of return values.
+
+2013-03-17 Jay Belanger <jay.p.belanger@gmail.com>
+
+ * calc/calc-ext.el (math-read-number-fancy): Check for an explicit
+ radix before checking for HMS forms.
+
+2013-03-16 Leo Liu <sdl.web@gmail.com>
+
+ * progmodes/scheme.el: Add indentation and font-locking for λ.
+ (Bug#13975)
+
+2013-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/smie.el (smie-auto-fill): Don't inf-loop if there's no
+ token before point (bug#13942).
+
+2013-03-16 Leo Liu <sdl.web@gmail.com>
+
+ * thingatpt.el (end-of-sexp): Fix bug#13952. Use syntax-after.
+
+2013-03-16 Eli Zaretskii <eliz@gnu.org>
+
+ * startup.el (command-line-normalize-file-name): Fix handling of
+ backslashes in DOS and Windows file names. Reported by Xue Fuqiao
+ <xfq.free@gmail.com> in
+ http://lists.gnu.org/archive/html/help-gnu-emacs/2013-03/msg00245.html.
+
+2013-03-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Sync with Tramp 2.2.7.
+
+ * net/trampver.el: Update release number.
+
+2013-03-14 Tassilo Horn <tsdh@gnu.org>
+
+ * doc-view.el: Fix bug#13887.
+ (doc-view-insert-image): Don't modify overlay associated to
+ non-live windows, and implement horizontal centering of image in
+ case it's smaller than the window.
+ (doc-view-new-window-function): Force redisplay of new windows on
+ doc-view buffers.
+
+2013-03-13 Karl Fogel <kfogel@red-bean.com>
+
+ * saveplace.el (save-place-alist-to-file): Don't sort
+ `save-place-alist', just pretty-print it (bug#13882).
+
+2013-03-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/tramp-sh.el (tramp-sh-handle-insert-directory):
+ Check whether `default-file-name-coding-system' is bound.
+ It isn't in XEmacs.
+
+2013-03-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/byte-run.el (defun-declarations-alist): Don't use
+ backquotes for `obsolete' (bug#13929).
+
+ * international/mule.el (find-auto-coding): Include file name in
+ obsolescence warning (bug#13922).
+
+2013-03-12 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * progmodes/cfengine.el (cfengine-parameters-indent): New variable
+ for CFEngine 3-specific indentation.
+ (cfengine3-indent-line): Use it. Fix up category regex.
+ (cfengine3-font-lock-keywords): Add bundle and namespace characters.
+
+2013-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * type-break.el (type-break-file-name):
+ * textmodes/remember.el (remember-data-file):
+ * strokes.el (strokes-file):
+ * shadowfile.el (shadow-initialize):
+ * saveplace.el (save-place-file):
+ * ps-bdf.el (bdf-cache-file):
+ * progmodes/idlwave.el (idlwave-config-directory):
+ * net/quickurl.el (quickurl-url-file):
+ * international/kkc.el (kkc-init-file-name):
+ * ido.el (ido-save-directory-list-file):
+ * emulation/viper.el (viper-custom-file-name):
+ * emulation/vip.el (vip-startup-file):
+ * calendar/todo-mode.el (todo-file-do, todo-file-done, todo-file-top):
+ * calendar/timeclock.el (timeclock-file): Use locate-user-emacs-file.
+
+2013-03-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch encodings of tutorials, thai-word to UTF-8 (Bug#13880).
+ * language/thai-word.el: Switch to UTF-8.
+
+See ChangeLog.16 for earlier changes.
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+ Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+ This file is part of GNU Emacs.
+
+ GNU Emacs is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2
index fddc98a612d..e91122aea60 100644
--- a/lisp/ChangeLog.2
+++ b/lisp/ChangeLog.2
@@ -2624,7 +2624,7 @@
1986-11-04 Richard M. Stallman (rms@prep)
- * various files (dired-mode, Edit-options-mode, rmail-mode)
+ * Various files (dired-mode, Edit-options-mode, rmail-mode)
(rmail-summary-mode, rmail-edit-mode, Buffer-menu-mode):
Give these symbols `special' as a `mode-class' property.
@@ -3799,7 +3799,7 @@
1986-06-14 Richard M. Stallman (rms@prep)
- * mh-e.el : Install 3.3f from Larus.
+ * mh-e.el: Install 3.3f from Larus.
1986-06-12 Richard M. Stallman (rms@prep)
@@ -3992,7 +3992,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 1986-1988, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1986-1988, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index e9968fe6a4e..d8077e1fcd1 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -26,7 +26,7 @@
(find-file-read-only-other-window): Likewise.
(find-file-read-only-other-frame): Likewise.
- * timer.el (cancel-function-timers): Renamed from spurious duplicate
+ * timer.el (cancel-function-timers): Rename from spurious duplicate
definition of cancel-timer.
* add-log.el (find-change-log): Use file-chase-links.
@@ -82,7 +82,7 @@
* paths.el (Info-default-directory-list): Take out ../../info.
Avoid duplication.
- (manual-formatted-dirlist, manual-formatted-dir-prefix): Deleted.
+ (manual-formatted-dirlist, manual-formatted-dir-prefix): Delete.
* subr.el (baud-rate): Doc fix.
@@ -137,7 +137,7 @@
Delete the "local thinking machines" definitions at the end
since they caused compilation failure.
- * cl.el (cl-member): Renamed from member.
+ * cl.el (cl-member): Rename from member.
* time.el (display-time-day-and-date): Use defvar, not defconst.
@@ -163,7 +163,7 @@
(timezone-make-date-sortable): Make autoload for this.
(rmail-sort-by-recipient): Downcase the strings for sorting.
(rmail-sort-by-recipient): Likewise.
- (rmail-sort-by-lines): Renamed from rmail-sort-by-size-lines.
+ (rmail-sort-by-lines): Rename from rmail-sort-by-size-lines.
Use numbers to sort by.
(rmail-summary-...): New functions. Bind in rmail-summary-mode-map.
(rmail-sort-from-summary): New function.
@@ -172,10 +172,10 @@
Choose string< or < as predicate.
Reorder messages by exchanging them, with inhibit-quit bound.
(rmail-fetch-field): Start by widening.
- (rmail-sortable-date-string): Deleted.
+ (rmail-sortable-date-string): Delete.
(rmail-make-date-sortable): New function, used instead.
- * paths.el (gnus-local-organization): Renamed from ...-your-...
+ * paths.el (gnus-local-organization): Rename from ...-your-...
(gnus-local-domain): Likewise.
1993-05-26 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -185,8 +185,8 @@
(set-face-font): Only use x-resolve-font-name if FONT is a string.
Copying a faces shouldn't resolve the font.
- * paths.el (Info-default-directory-list): Add
- configure-info-directory to this list.
+ * paths.el (Info-default-directory-list):
+ Add configure-info-directory to this list.
1993-05-26 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -247,15 +247,15 @@
1993-05-25 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * term/x-win.el (command-switch-alist, x-switch-definitions): Treat
- `-i' like `-itype', as in Emacs 18.
+ * term/x-win.el (command-switch-alist, x-switch-definitions):
+ Treat `-i' like `-itype', as in Emacs 18.
1993-05-25 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
* Version 19.8 released.
- * startup.el (command-line-1): Don't handle `-i'. We're
- abandoning the `insert file' meaning in favor of the `use a
+ * startup.el (command-line-1): Don't handle `-i'.
+ We're abandoning the `insert file' meaning in favor of the `use a
bitmapped icon' meaning.
* faces.el (set-face-font): Call x-resolve-font-name on the font
@@ -265,8 +265,8 @@
* iso-syntax.el: Make downcase into a proper case table before
passing it to set-standard-case-table.
- * disp-table.el (standard-display-european): Doc fix. Make
- it autoload. Make it respond to prefix arg like a minor mode.
+ * disp-table.el (standard-display-european): Doc fix.
+ Make it autoload. Make it respond to prefix arg like a minor mode.
1993-05-24 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -360,8 +360,8 @@
1993-05-22 Jim Blandy (jimb@geech.gnu.ai.mit.edu)
- * cl.el (cl-floor, cl-ceiling, cl-truncate, cl-round): Renamed
- from floor, ceiling, truncate, and round; the old names conflict
+ * cl.el (cl-floor, cl-ceiling, cl-truncate, cl-round):
+ Rename from floor, ceiling, truncate, and round; the old names conflict
with built-in functions.
1993-05-22 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -432,7 +432,7 @@
current-time-string and current-time-zone. Adjust to new format
returned by current-time-zone.
- * xfaces.el (face-equal): Doc fix.
+ * faces.el (face-equal): Doc fix.
1993-05-19 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -524,7 +524,7 @@
1993-05-16 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * texinfo.el (texinfo-chapter-level-regexp): Copied here.
+ * texinfo.el (texinfo-chapter-level-regexp): Copy here.
1993-05-17 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -536,7 +536,7 @@
* gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el,
* nntp.el, nnspool.el, mhspool.el: Version 3.15 from Umeda.
- * frame.el (toggle-scroll-bar): Renamed from toggle-vertical-scroll...
+ * frame.el (toggle-scroll-bar): Rename from toggle-vertical-scroll...
1993-05-16 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -623,14 +623,14 @@
* menu-bar.el (menu-bar-mode): New command. Use for initialization.
* faces.el (make-face): Add interactive spec.
- (set-default-font): Deleted.
+ (set-default-font): Delete.
* isearch.el (isearch-mode-map): Handle any length vector in keymap.
(isearch-char-to-string): Handle non-character events properly.
1993-05-14 Jim Blandy (jimb@geech.gnu.ai.mit.edu)
- * subr.el (overlay-start, overlay-end, overlay-buffer): Removed.
+ * subr.el (overlay-start, overlay-end, overlay-buffer): Remove.
* vc.el (vc-version-diff): Match parens.
@@ -643,26 +643,26 @@
* emerge.el: Installed version 5 from drw.
Merged in previous FSF changes, plus new changes:
- (emerge-count-matches-string): Renamed from count-matches-string.
+ (emerge-count-matches-string): Rename from count-matches-string.
(emerge-command-prefix): Now C-c C-c.
- (emerge-shadow-key-definition): Deleted.
+ (emerge-shadow-key-definition): Delete.
Callers use substitute-key-definition.
- (emerge-recursively-substitute-key-definition): Deleted.
+ (emerge-recursively-substitute-key-definition): Delete.
Callers use substitute-key-definition.
- (emerge-unselect-hook): Renamed from emerge-unselect-hooks.
+ (emerge-unselect-hook): Rename from emerge-unselect-hooks.
(emerge-files-internal): Use file-local-copy to handle remote files.
(emerge-files-with-ancestor-internal): Likewise.
- (emerge-remote-file-p): Deleted.
+ (emerge-remote-file-p): Delete.
(emerge-abort): New command.
- (describe-mode): Deleted.
- (emerge-hash-string-into-string): Renamed from hash-string-into-string.
- (emerge-unslashify-name): Renamed from unslashify-name.
+ (describe-mode): Delete.
+ (emerge-hash-string-into-string): Rename from hash-string-into-string.
+ (emerge-unslashify-name): Rename from unslashify-name.
(emerge-write-and-delete): Don't write-file if file-out is nil.
(emerge-setup-fixed-keymaps): Put emerge-abort on C-].
- (emerge-find-difference-diff): Renamed from emerge-find-difference.
+ (emerge-find-difference-diff): Rename from emerge-find-difference.
(emerge-find-difference): New command. Now on `.'.
- (emerge-diff-ok-lines-regexp): Renamed from emerge-diff-ok-lines.
- (emerge-diff3-ok-lines-regexp): Renamed from emerge-diff3-ok-lines.
+ (emerge-diff-ok-lines-regexp): Rename from emerge-diff-ok-lines.
+ (emerge-diff3-ok-lines-regexp): Rename from emerge-diff3-ok-lines.
1993-05-13 Paul Eggert (eggert@twinsun.com)
@@ -768,7 +768,7 @@
(x-initialize-frame-faces): Use the NOERROR argument to the
font manipulation functions to avoid errors while starting up.
Remove initialization of isearch font.
- * xfaces.c (internal-x-complain-about-font): Add new frame
+ (internal-x-complain-about-font): Add new frame
argument, so we can check the frame parameters to find the
default font. Callers changed.
@@ -877,9 +877,9 @@
* comint.el (comint-previous-matching-input): New command, on M-r.
(comint-next-matching-input): New command, on M-s.
- (comint-previous-similar-input): Commented out.
+ (comint-previous-similar-input): Comment out.
(comint-next-similar-input): Likewise.
- (comint-previous-input-matching): Deleted.
+ (comint-previous-input-matching): Delete.
(comint-last-input-match): Var commented out.
(comint-mode): Don't make comint-last-input-match local.
@@ -911,8 +911,8 @@
* help.el (help-for-help): Use lower case letters for help options.
- * rect.el (string-rectangle): Renamed from fill-rectangle.
- (string-rectangle-line): Renamed from fill-rectangle-line.
+ * rect.el (string-rectangle): Rename from fill-rectangle.
+ (string-rectangle-line): Rename from fill-rectangle-line.
1993-05-01 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -944,8 +944,8 @@
FORCE argument non-nil, so that we don't get an error if the mark
isn't set yet.
- * edebug.el (global-edebug-prefix, global-edebug-map): Add
- autoload cookies for these, so they are present when Emacs starts
+ * edebug.el (global-edebug-prefix, global-edebug-map):
+ Add autoload cookies for these, so they are present when Emacs starts
up.
* edebug.el (global-edebug-map): Bind `C-x X d' to edebug-defun in
@@ -957,7 +957,7 @@
* complete.el: New file.
- * vc.el (vc-match-substring): Renamed from match-substring.
+ * vc.el (vc-match-substring): Rename from match-substring.
(vc-parse-buffer): Use new name.
* shell.el (shell-prompt-pattern): Undo last change.
@@ -965,7 +965,7 @@
* files.el (file-truename): Redo esr's change.
* loaddefs.el: Put arrow key bindings back to the ordinary Emacs cmds.
- * simple.el (up-arrow, down-arrow, left-arrow, right-arrow): Deleted.
+ * simple.el (up-arrow, down-arrow, left-arrow, right-arrow): Delete.
* simple.el (kill-line, next-line-add-newlines): Doc fix.
(kill-whole-line): Doc fix.
@@ -1089,42 +1089,42 @@
* gud.el: Set no-byte-compile local variable t to work around a
byte-compiler bug.
- (gud-def, global-map): Move C-x C-a commands to global map. Restore
- original C-x SPC global binding.
+ (gud-def, global-map): Move C-x C-a commands to global map.
+ Restore original C-x SPC global binding.
* vc.el (vc-diff): Get proper error message when you run this with
no prefix arg on an empty buffer.
(vc-directory): Better directory format --- replace the user and
group IDs with locking-user (if any).
- (vc-finish-logentry, vc-next-comment, vc-previous-comment): Replace
- *VC-comment-buffer* with a ring vector.
+ (vc-finish-logentry, vc-next-comment, vc-previous-comment):
+ Replace *VC-comment-buffer* with a ring vector.
1993-04-25 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
- * simple.el (down-arrow): New function. Uses
- next-line-add-newlines to suppress addition of new lines at end of
+ * simple.el (down-arrow): New function.
+ Uses next-line-add-newlines to suppress addition of new lines at end of
buffer.
(up-arrow): Alias of previous-line, added for consistency.
These changes complete terminal-type-independent support for arrow
keys.
- * tex-mode.el (tex-compilation-parse-errors): Added. At the
+ * tex-mode.el (tex-compilation-parse-errors): Add. At the
moment, this would have to be applied manually. It's not worth
trying to integrate this with the rest of the mode more tightly
until we decide whether and how compile's interface is going to
change away from a closed subsystem.
- * files.el (cd): Changed to use to resolve relative cd calls.
- (cd-absolute): Added. This is actually the old cd code with a
+ * files.el (cd): Change to use to resolve relative cd calls.
+ (cd-absolute): Add. This is actually the old cd code with a
changed doc string.
- (parse-colon-path): Added. Path-to-string exploder --- may be
+ (parse-colon-path): Add. Path-to-string exploder --- may be
useful elsewhere.
* ring.el: Added and fixed documentation.
(ring-rotate): Nuked. It was (a) unused, and (b) totally broken (as
in, any attempt to use it died with a type error, and when I patched
it to fix that I found its algorithm was broken).
- (ring-ref): Added doc string.
+ (ring-ref): Add doc string.
1993-04-25 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -1144,7 +1144,7 @@
1993-04-23 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
- * bytecomp.el (define-function): Changed name back to defaliases
+ * bytecomp.el (define-function): Change name back to defaliases
to get things in a known-good state. The unload patch had been
half-applied, leading to lossage.
@@ -1158,7 +1158,7 @@
* telnet.el: Commentary added.
(telnet): Doc fix.
- (rsh): Added entry point for rsh to remote host, per suggestion by
+ (rsh): Add entry point for rsh to remote host, per suggestion by
Michael McNamara <mac@ardent.com>. No change to any other code.
* info.el (Info-find-node, Info-insert-subfile): Do the right
@@ -1166,15 +1166,15 @@
saving me lots of disk space.
* simple.el: All fsets changed to defaliases.
- (kill-forward-chars, kill-backward-chars): Deleted. These were
+ (kill-forward-chars, kill-backward-chars): Delete. These were
internal subroutines used by delete-char and delete-backward-char
before those functions were moved into the C kernel. Now nothing
uses them.
- (kill-line): Added kill-whole-line variable. Defaults to nil; a
+ (kill-line): Add kill-whole-line variable. Defaults to nil; a
non-nil value causes a kill-line at the beginning of a line to
kill the newline as well as the line. I find it very convenient.
Emulates Unipress' &kill-lines-magic variable.
- (next-line): Added next-line-add-newlines variable. If nil,
+ (next-line): Add next-line-add-newlines variable. If nil,
next-line will not insert newlines when invoked at the end of a
buffer. This obviates three LCD packages.
(left-arrow, right-arrow): New functions. These do backward-char
@@ -1182,7 +1182,7 @@
left or right as necessary to make sure point is visible.
* loaddefs.el: All fsets changes to defaliases.
- (global-map): Changed bindings of [left] and [right] to left-arrow and
+ (global-map): Change bindings of [left] and [right] to left-arrow and
right-arrow respectively.
1993-04-22 Roland McGrath (roland@mole.gnu.ai.mit.edu)
@@ -1240,7 +1240,7 @@
1993-04-16 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
* electric.el (shrink-window-if-larger-than-buffer):
- Moved to window.el.
+ Move to window.el.
1993-04-16 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -1267,12 +1267,12 @@
1993-04-14 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * resume.el (resume-suspend-hook): Renamed from empty-args-file.
+ * resume.el (resume-suspend-hook): Rename from empty-args-file.
Add autoload cookie.
- (resume-emacs-args-buffer): Renamed.
- (resume-write-buffer-to-file): Renamed.
+ (resume-emacs-args-buffer): Rename.
+ (resume-write-buffer-to-file): Rename.
- * two-column.el (tc-dissociate): Renamed from tc-kill-association.
+ * two-column.el (tc-dissociate): Rename from tc-kill-association.
Move binding to C-x 6 d.
1993-04-14 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -1291,7 +1291,7 @@
* gud.el (gud-mode): Created C-c synonym bindings in the GUD
buffer's local map.
- (gud-key-prefix): Changed to C-x C-a.
+ (gud-key-prefix): Change to C-x C-a.
1993-04-14 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -1307,11 +1307,11 @@
ability to browse package commentary sections and a completely
point-and-shoot interface similar to Dired's.
- * window.el (shrink-window-if-larger-than-buffer): Moved from
+ * window.el (shrink-window-if-larger-than-buffer): Move from
electric.el to windows.el, minor bug fix. This is to avoid code
duplication between vc.el, electric.el, and finder.el.
- (ctl-x-map): Added C-x - and C-x + as experimental bindings for
+ (ctl-x-map): Add C-x - and C-x + as experimental bindings for
shrink-window-if-larger-than-buffer and balance-windows
respectively. Since shrink-window-if-larger-than-buffer has to
live here anyhow, let users use it to manage screen space.
@@ -1354,7 +1354,7 @@
1993-04-10 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
- * gud.el (gdb, sdb, dbx): Improved prompting a la grep.
+ * gud.el (gdb, sdb, dbx): Improve prompting a la grep.
* comint.el: Clean up cmu* uses in header comments.
@@ -1380,8 +1380,8 @@
1993-04-09 Jim Blandy (jimb@totoro.cs.oberlin.edu)
- * subr.el (overlay-start, overlay-end, overlay-buffer): New
- defsubsts.
+ * subr.el (overlay-start, overlay-end, overlay-buffer):
+ New defsubsts.
* finder.el (finder-by-keyword): Build an alist to pass to
completing-read, instead of building an invalid obarray.
@@ -1443,7 +1443,7 @@
(compile-internal): Make it the process's filter.
* compile.el (compilation-error-regexp-alist):
- Fixed MIPS CC regexp to match file
+ Fix MIPS CC regexp to match file
names longer than one char.
(compilation-parse-errors): Error if compilation-error-regexp-alist is nil.
@@ -1473,7 +1473,7 @@
* compile.el (compilation-filter): New function.
(compile-internal): Make it the process's filter.
- * compile.el (compilation-error-regexp-alist): Fixed MIPS CC
+ * compile.el (compilation-error-regexp-alist): Fix MIPS CC
regexp to match file names longer than one char.
(compilation-parse-errors): Error if
compilation-error-regexp-alist is nil.
@@ -1492,7 +1492,7 @@
(add-change-log-entry): FILE-NAME frobnicating code moved there;
call it.
* vc.el (vc-comment-to-change-log):
- Renamed from vc-comment-to-changelog.
+ Rename from vc-comment-to-changelog.
Take optional arg and pass it to find-change-log.
Added docstring and interactive spec.
@@ -1505,7 +1505,7 @@
Apollo cc regexp: make "s optional, and don't anchor to bol.
* compile.el (compilation-error-regexp-alist):
- Changed MIPS RISC CC regexp (last one) to
+ Change MIPS RISC CC regexp (last one) to
be anchored at bol, and to never match multiple lines.
1993-04-03 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
@@ -1528,7 +1528,7 @@
* mpuz.el (mpuz-try-letter): Use read-char to read digit.
Use message directly also. Use downcase.
- (mpuz-read-map): Deleted.
+ (mpuz-read-map): Delete.
* dired.el (dired-unmark-all-files): Read the arg as just a char.
@@ -1614,7 +1614,7 @@
1993-03-29 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
* vc.el (vc-next-action, vc-print-log, vc-diff, vc-revert-buffer):
- Improved logic for parent buffer finding.
+ Improve logic for parent buffer finding.
(vc-cancel-version): Bug fix.
@@ -1627,7 +1627,7 @@
* fill.el (fill-individual-paragraphs): When skipping mail headers,
skip to a blank line.
- * env.el (setenv): Renamed back from putenv.
+ * env.el (setenv): Rename back from putenv.
* replace.el (regexp-history): New history list.
(occur, flush-lines, keep-lines, how-many): Use it.
@@ -1638,7 +1638,7 @@
1993-03-28 Noah Friedman (friedman@splode.com)
* setenv.el: Renamed to env.el. Provide `env', not `setenv'.
- (setenv): Renamed to `putenv', which is the more proper complement
+ (setenv): Rename to `putenv', which is the more proper complement
of `getenv'. `setenv' retained as an alias.
Make VALUE parameter optional; if not set, remove VARIABLE from
process-environment.
@@ -1664,10 +1664,10 @@
* makefile.el: Added autoload cookie for entry point.
- * files.el (auto-mode-alist): Added pairs for .ms, .man, .mk,
+ * files.el (auto-mode-alist): Add pairs for .ms, .man, .mk,
[Mm]akefile, .lex.
- * electric.el (shrink-window-if-larger-than-buffer): Added doc
+ * electric.el (shrink-window-if-larger-than-buffer): Add doc
string. Made argument optional, because window-buffer does the
right thing with nil.
@@ -1691,8 +1691,8 @@
* rlogin.el: Updated copyright year and added autoload cookies.
(rlogin): Set process marker to beginning of buffer.
- (rlogin-filter): Use unwind-protect to restore match-data. Use
- insert-before-markers instead of insert to keep input and output
+ (rlogin-filter): Use unwind-protect to restore match-data.
+ Use insert-before-markers instead of insert to keep input and output
from getting garbled. Delete spurious ?\C-m chars in output
instead of replacing them with ?\ .
@@ -1710,26 +1710,26 @@
1993-03-27 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
- * lpr.el (printify-buffer): Added, debugged from Roland McGrath's
+ * lpr.el (printify-buffer): Add, debugged from Roland McGrath's
printify-buffer code in LCD.
- * cookie.el (cookie): Enhanced it to handle both LINS files and
+ * cookie.el (cookie): Enhance it to handle both LINS files and
UNIX fortune files.
- * rect.el (fill-rectangle): Added. Inspired by Lynn Slater's
+ * rect.el (fill-rectangle): Add. Inspired by Lynn Slater's
insert-box package in LCD, but the interface and implementation
are different.
- * loaddefs.el (ctl-x-map): Added binding for fill-rectangle.
+ * loaddefs.el (ctl-x-map): Add binding for fill-rectangle.
- * buff-menu.el (Buffer-menu-toggle-read-only): Added, per Rob
+ * buff-menu.el (Buffer-menu-toggle-read-only): Add, per Rob
Austein's suggestion in the LCD package bm-toggle.el.
- * subr.el (add-hook): Added optional arg to cause hook to be
+ * subr.el (add-hook): Add optional arg to cause hook to be
appended rather than prepended to the hook list. This obviates
the 23 different hook-bashing packages in LCD.
- * subr.el (current-word): Added. Lots of help and default-generator
+ * subr.el (current-word): Add. Lots of help and default-generator
functions in LCD use it, and it's remarkably difficult to get
right, especially given the new syntax primitives.
@@ -1741,8 +1741,8 @@
1993-03-26 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
- * yow.el (psychoanalyze-pinhead): Needed a prefrontal lobotomy. I
- gave it one.
+ * yow.el (psychoanalyze-pinhead): Needed a prefrontal lobotomy.
+ I gave it one.
* two-column.el: Added Commentary.
@@ -1754,13 +1754,13 @@
1993-03-25 Eric S. Raymond (eric@geech.gnu.ai.mit.edu)
- * lisp-mnt.el (lm-last-modified-date): Fixed return bug.
+ * lisp-mnt.el (lm-last-modified-date): Fix return bug.
(lm-author, lm-maintainer): These now return cons pairs, not strings.
* shell.el: Brent Benson's patch to support `cd -'.
- * mh-e.el (mh-unshar): Added.
+ * mh-e.el (mh-unshar): Add.
* emacsbug.el: Added a (provide 'emacsbug); lisp-mnt.el needs this.
@@ -1873,8 +1873,8 @@
* time.el (display-time): Doc fix.
- * isearch.el (isearch-switch-frame-handler): Call
- handle-switch-frame instead of select-frame; it has been renamed.
+ * isearch.el (isearch-switch-frame-handler):
+ Call handle-switch-frame instead of select-frame; it has been renamed.
* simple.el (comment-indent-function): New variable, intended to
replace comment-indent-hook.
@@ -1930,7 +1930,7 @@
1993-03-18 Richard Stallman (rms@geech.gnu.ai.mit.edu)
- * frame.el (make-frame): Renamed from new-frame.
+ * frame.el (make-frame): Rename from new-frame.
(new-frame): Alias for make-frame.
1993-03-18 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
@@ -2048,8 +2048,8 @@
1993-03-14 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * sort.el (sort-float-fields, sort-numeric-fields): Use
- string-to-number, not string-to-float or string-to-int.
+ * sort.el (sort-float-fields, sort-numeric-fields):
+ Use string-to-number, not string-to-float or string-to-int.
* sort.el (sort-float-fields): Make this autoloaded.
@@ -2080,7 +2080,7 @@
1993-03-12 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
- * loaddefs.el (global-map): Fixed a typo in the binding of
+ * loaddefs.el (global-map): Fix a typo in the binding of
[kp-backtab].
* term/x-win.el: Added library headers back in. Didn't touch
@@ -2121,14 +2121,9 @@
initialization that make it a lot smarter, with a more uniform
and featureful interface across many different keyboard types.
- * term.c (fkey_table): Has been expanded to handle the entire
- intersection of the capability sets defined by X keysyms and
- terminfo. That is, every keysym for which there is a natural
- equivalent in terminfo is now bound to that by the startup code.
-
* loaddefs.el (global-map): Natural default keybindings set up for
- almost all supported keysyms other than function keys. All
- other keysyms are now default-bound to a function which explains
+ almost all supported keysyms other than function keys.
+ All other keysyms are now default-bound to a function which explains
that the key is not bound to anything, then raises an error.
* term/README: Terminal package conventions and standard keysym
@@ -2149,8 +2144,8 @@
* term/news.el: Cleaned up, headers added.
- * term/sun.el: Headers added, [again] changed to [redo]. This
- package is a hairball and should probably be scrapped if we
+ * term/sun.el: Headers added, [again] changed to [redo].
+ This package is a hairball and should probably be scrapped if we
can find or built a better one.
* term/tvi970.el: Headers added, [enter] changed to [kp-enter].
@@ -2175,7 +2170,7 @@
* help.el: Added binding and menu line for new `P' package-finder
command. Won't actually take effect till the next Emacs build.
- * vc.el (vc-backend-checkin): Fixed bizarre POM-dependent bug
+ * vc.el (vc-backend-checkin): Fix bizarre POM-dependent bug
introduced into VC by a bad patch. This was one for the
books....badly corrupted vc-checkin code somehow mostly functioned
for three days. The Code That Would Not Die...
@@ -2257,7 +2252,7 @@
1993-03-08 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* subr.el (posn-timestamp, posn-col-row, posn-point, posn-window)
- (event-end, event-start, mouse-movement-p): Moved from mouse.el.
+ (event-end, event-start, mouse-movement-p): Move from mouse.el.
* mouse.el: Functions moved to subr.el.
1993-03-07 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -2368,7 +2363,7 @@
1993-03-05 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* disp-table.el: Add autoload comments.
- (rope-to-vector): Deleted.
+ (rope-to-vector): Delete.
(describe-display-table): Don't use rope-to-vector.
* compare-w.el (compare-windows): Use compare-buffer-substrings.
@@ -2429,7 +2424,7 @@
(rmail-undelete-previous-message, rmail-delete-forward)
(rmail-get-new-mail, rmail-show-message): Update summary buffer if any.
Call rmail-maybe-display-summary to put it back on screen.
- (rmail-only-expunge): Renamed from rmail-expunge.
+ (rmail-only-expunge): Rename from rmail-expunge.
(rmail-expunge): New function.
(rmail-message-recipients-p, rmail-message-regexp-p): New functions.
(rmail-summary-exists, rmail-summary-displayed): New functions.
@@ -2475,7 +2470,7 @@
1993-03-01 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* frame.el: Doc fixes.
- (set-pointer-color): Renamed to set-mouse-color.
+ (set-pointer-color): Rename to set-mouse-color.
(set-border-color): New function.
* info.el (Info-insert-dir): Make menu items in Top node
@@ -2515,8 +2510,8 @@
1993-02-26 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * frame.el (auto-raise-mode): Renamed from toggle-auto-raise.
- (auto-lower-mode): Renamed from toggle-auto-lower.
+ * frame.el (auto-raise-mode): Rename from toggle-auto-raise.
+ (auto-lower-mode): Rename from toggle-auto-lower.
1993-02-26 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -2555,8 +2550,8 @@
* gud.el (gud-break): With a prefix argument, set a temporary
breakpoint.
- (gud-apply-from-source): New argument ARGS, to pass to FUNC. Now
- it's really like `apply'.
+ (gud-apply-from-source): New argument ARGS, to pass to FUNC.
+ Now it's really like `apply'.
(gud-set-break): Add another argument to this method.
Document it in the section describing how the methods are supposed
to be used.
@@ -2619,11 +2614,11 @@
* frame.el (frame-initialize): Fix error syntax.
(toggle-horizontal-scroll-bar): Likewise.
- (toggle-horizontal-scroll-bar): Renamed from set-horizontal-bar.
+ (toggle-horizontal-scroll-bar): Rename from set-horizontal-bar.
(toggle-vertical-scroll-bar): Likewise.
(toggle-auto-lower, toggle-auto-raise): Likewise.
(set-foreground-color, set-background-color):
- Renamed from set-frame-{fore,back}ground.
+ Rename from set-frame-{fore,back}ground.
1993-02-15 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -2679,7 +2674,7 @@
1993-02-11 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * flow-ctrl.el (enable-flow-control...): Renamed from evade...
+ * flow-ctrl.el (enable-flow-control...): Rename from evade...
(enable-flow-control): Add autoload.
1993-02-10 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -2696,7 +2691,7 @@
* fortran.el (fortran-prepare-abbrev-list-buffer): Put quote in
front of first argument to `insert-abbrev-table-description'.
- * fortran.el (fortran-is-in-string-p): Fixed incorrect behavior
+ * fortran.el (fortran-is-in-string-p): Fix incorrect behavior
when in first statement of a buffer.
1993-02-08 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -2742,7 +2737,7 @@
1993-02-05 Roland McGrath (roland@geech.gnu.ai.mit.edu)
- * comint.el (make-comint): Added docstring.
+ * comint.el (make-comint): Add docstring.
1993-02-05 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -2771,7 +2766,7 @@
1993-01-31 Roland McGrath (roland@geech.gnu.ai.mit.edu)
* mailabbrev.el (mail-abbrev-end-of-buffer):
- Changed interactive spec from "P" to "p".
+ Change interactive spec from "P" to "p".
1993-01-29 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -2794,7 +2789,7 @@
x-own-selection has been renamed to x-set-selection, and the order
of its arguments has been reversed, for consistency with other
lisp functions like put and aset.
- * term/x-win.el (x-select-text): Adjusted.
+ * term/x-win.el (x-select-text): Adjust.
(x-cut-buffer-or-selection-value): Check the primary selection,
using x-selection, instead of checking the cut buffer again.
@@ -2809,7 +2804,7 @@
x-own-selection has been renamed to x-set-selection, and the order
of its arguments has been reversed, for consistency with other
lisp functions like put and aset.
- * term/x-win.el (x-select-text): Adjusted.
+ * term/x-win.el (x-select-text): Adjust.
(x-cut-buffer-or-selection-value): Check the primary selection,
using x-selection, instead of checking the cut buffer again.
@@ -3075,13 +3070,13 @@
* etags.el: Many comments added and docstrings fixed.
(tags-table-list): Elt of nil is not special.
(tags-expand-table-name): Value of nil is not special.
- (tags-next-table): Removed arg RESET; no caller used it.
+ (tags-next-table): Remove arg RESET; no caller used it.
(visit-tags-table-buffer): Don't need to do tags-expand-table-name
in or form. When table is invalid, only set tags-file-name to nil
globally if its global value contained the losing table file name.
(find-tag-tag): Return a string, not a list.
(find-tag-noselect, find-tag, find-tag-other-window)
- (find-tag-other-frame): Changed callers.
+ (find-tag-other-frame): Change callers.
(etags-recognize-tags-table): Call etags-verify-tags-table, rather than
duplicating its functionality.
(visit-tags-table-buffer): When CONT is 'same, set it to nil after the
@@ -3158,7 +3153,7 @@
1992-12-09 Roland McGrath (roland@wookumz.gnu.ai.mit.edu)
- * info.el (Info-{first,second,third,fourth,fifth}-menu-item): Removed.
+ * info.el (Info-{first,second,third,fourth,fifth}-menu-item): Remove.
(Info-nth-menu-item): New function; bound to 1..9.
1992-12-08 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -3172,8 +3167,8 @@
Just that.
* ls-lisp.el (insert-directory): Just that.
- * ange-ftp.el (ange-ftp-unhandled-file-name-directory): New
- function. Set ange-ftp's `unhandled-file-name-property' to its
+ * ange-ftp.el (ange-ftp-unhandled-file-name-directory):
+ New function. Set ange-ftp's `unhandled-file-name-property' to its
name.
1992-12-07 Jim Blandy (jimb@totoro.cs.oberlin.edu)
@@ -3243,7 +3238,7 @@
* paths.el (rmail-spool-directory): Add dgux-unix to the list of
systems which put their mail in "/usr/mail".
- * lpr.el (lpr-command, lpr-switches): Removed strings starting
+ * lpr.el (lpr-command, lpr-switches): Remove strings starting
with \newline; this file is loaded in loaddefs.el, and doesn't
need to follow that convention.
@@ -3356,8 +3351,8 @@
* fortran.el: Version 1.28.7a.
Cleaned up some doc strings.
- (fortran-abbrev-help, fortran-prepare-abbrev-list-buffer): Use
- `insert-abbrev-table-description' and make buffer in abbrevs-mode.
+ (fortran-abbrev-help, fortran-prepare-abbrev-list-buffer):
+ Use `insert-abbrev-table-description' and make buffer in abbrevs-mode.
* fortran.el: Version 1.28.7.
Many changes since version 1.28.3. Added auto-fill-mode, support
@@ -3371,7 +3366,7 @@
New functions to implement auto fill.
(fortran-indent-line, fortran-reindent-then-newline-and-indent):
- Added auto fill support.
+ Add auto fill support.
(find-comment-start-skip, is-in-fortran-string-p): New functions.
@@ -3381,7 +3376,7 @@
(fortran-indent-to-column): Use find-comment-start-skip instead of
searching for `comment-start-skip'.
- (fortran-mode, calculate-fortran-indent): Added indentation
+ (fortran-mode, calculate-fortran-indent): Add indentation
for fortran 90 statements.
(fortran-next-statement, fortran-previous-statement): Bug fixes.
@@ -3436,7 +3431,7 @@
1992-10-31 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * files.el (make-directory): Renamed from make-directory-path.
+ * files.el (make-directory): Rename from make-directory-path.
Optional argument says whether to create parent dirs.
Invoke file-name handler here.
(after-find-file): Delete code that offers to create dir.
@@ -3474,7 +3469,7 @@
* info.el: Rename buffer-flush-undo to buffer-disable-undo.
(Info-goto-emacs-key-command-node): Fix typo.
- (Info-menu-item-sequence): Commented out.
+ (Info-menu-item-sequence): Comment out.
(Info-follow-nearest-node): Use new event format.
Select the window clicked on.
@@ -3566,9 +3561,9 @@
* mailabbrev.el: Delete version 18 compatibility stuff.
(mail-abbrevs, build-mail-abbrevs, rebuild-mail-abbrevs)
- (merge-mail-abbrevs): Renamed `mail-aliases' to `mail-abbrevs'.
- (mail-abbrev-end-of-buffer): Renamed from abbrev-hacking-end-of-buffer.
- (mail-abbrev-next-line): Renamed from abbrev-hacking-next-line.
+ (merge-mail-abbrevs): Rename `mail-aliases' to `mail-abbrevs'.
+ (mail-abbrev-end-of-buffer): Rename from abbrev-hacking-end-of-buffer.
+ (mail-abbrev-next-line): Rename from abbrev-hacking-next-line.
* isearch-mode.el (isearch-mode-map): Use sparse keymaps.
Start printing-char loop at SPC.
@@ -3734,7 +3729,7 @@
1992-10-05 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * ls-lisp.el (insert-directory): Renamed from dired-ls.
+ * ls-lisp.el (insert-directory): Rename from dired-ls.
All other functions renamed to start with ls-lisp.
* ls-lisp.el: New file from Kremer.
@@ -3753,7 +3748,7 @@
* mouse.el: Begin adapting this to the new event format.
(event-window, event-point, mouse-coords, mouse-timestamp):
- Removed.
+ Remove.
(event-start, event-end, posn-window, posn-point, posn-col-row)
(posn-timestamp): New accessors; these are defsubsts.
(mouse-delete-window, mouse-delete-other-windows)
@@ -3788,7 +3783,7 @@
1992-09-30 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * gud.el (gud-last-frame): Added defvar for this.
+ * gud.el (gud-last-frame): Add defvar for this.
1992-09-29 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -3819,8 +3814,8 @@
Use x-get-cut-buffer and x-set-cut-buffer, instead of expecting
x-selection-value to manipulate the cut buffers.
- * term/x-win.el (x-cut-buffer-or-selection-value): Treat
- selections whose value is the empty string like unset selections.
+ * term/x-win.el (x-cut-buffer-or-selection-value):
+ Treat selections whose value is the empty string like unset selections.
This allows us to truncate cut buffers to the empty string (if the
text is too large, say) without causing
interprogram-paste-function to wipe out the latest kill.
@@ -3846,13 +3841,13 @@
latter doesn't exist.
(gud-dbx-debugger-setup): Use the argument `f', not the variable
`file', which happens to be bound in the caller.
- (gud-filter-insert): The variable `start' is never used. The
- variable `moving' is unnecessary. The variable `old-buffer' and
+ (gud-filter-insert): The variable `start' is never used.
+ The variable `moving' is unnecessary. The variable `old-buffer' and
the unwind-protect form are unneeded, since save-excursion can do
their work. The binding of output-after-point should be done after
switching to the process's buffer, not in whatever random buffer
- happens to be current when the process filter is called. There's
- no need to set the process mark if we've just inserted at its
+ happens to be current when the process filter is called.
+ There's no need to set the process mark if we've just inserted at its
location using insert-before-markers.
(gud-read-address): Don't bother setting the variable `result'; it
is never used.
@@ -3925,8 +3920,8 @@
* two-column.el (tc-window-width, tc-separator, tc-other):
Add permanent-local property.
- (tc-two-columns): Renamed from tc-split.
- (tc-split): Renamed from tc-unmerge. Put it on C-x 6 s.
+ (tc-two-columns): Rename from tc-split.
+ (tc-split): Rename from tc-unmerge. Put it on C-x 6 s.
Use make-local-variable on tc-separator.
* spook.el (spook): Make it autoload.
@@ -3934,7 +3929,7 @@
* gomoku.el (gomoku): Make it autoload.
* mpuz.el: Fix setup of mpuz-read-map not to depend on keymap format.
- (mpuz): Renamed from mult-puzzle. Make it autoload.
+ (mpuz): Rename from mult-puzzle. Make it autoload.
* setenv.el (setenv): Doc fix. Make it autoload.
@@ -3974,9 +3969,9 @@
* texinfo.el (texinfo-mode): Capitalize the mode name string.
- * mail-extr.el (mail-undo-backslash-quoting): Renamed from undo-...
- (mail-safe-move-sexp): Renamed from safe-...
- (mail-variant-method): Renamed from variant-method.
+ * mail-extr.el (mail-undo-backslash-quoting): Rename from undo-...
+ (mail-safe-move-sexp): Rename from safe-...
+ (mail-variant-method): Rename from variant-method.
* tq.el: Doc fixes. Make tq-create autoload.
@@ -3999,7 +3994,7 @@
* prompt.el: File deleted.
- * find-dired.el (start-process-shell-command): Deleted.
+ * find-dired.el (start-process-shell-command): Delete.
* diff.el (diff-switches): Default is now -c.
(diff-parse-differences): Use line beg as location of message.
@@ -4033,7 +4028,7 @@
(search-last-string, search-last-regexp): Vars deleted.
(search-highlight): No longer a user option.
- * subr.el (baud-rate): Defined.
+ * subr.el (baud-rate): Define.
(substitute-key-definition): Understand today's keymap format.
New arg OLDMAP. Operate recursively on prefix keys.
@@ -4065,7 +4060,7 @@
1992-09-16 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu)
- * isearch-mode.el (isearch-ring-advance-edit): Added missing
+ * isearch-mode.el (isearch-ring-advance-edit): Add missing
closing paren to end of this function.
1992-09-16 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -4092,7 +4087,7 @@
* simple.el (previous-history-element): Doc fix.
* isearch-mode.el (isearch-event-data-type):
- Renamed from isearch-events-exist.
+ Rename from isearch-events-exist.
(isearch-frames-exist): Set properly in Emacs 18.
(isearch-mode): Use baud-rate as variable, not function.
(isearch-abort): Use nil as 2nd arg to `signal'.
@@ -4142,8 +4137,8 @@
Don't try using length of keymap.
(isearch-update): Handle unread-command-char properly for Emacs 19.
(isearch-switch-frame-handler): Use select-frame to switch frames.
- (isearch-pre-command-hook): Commented out.
- (search-upper-case): Renamed from search-caps-disable-folding.
+ (isearch-pre-command-hook): Comment out.
+ (search-upper-case): Rename from search-caps-disable-folding.
1992-09-14 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -4245,7 +4240,7 @@
* dired-aux.el (dired-add-entry, dired-insert-subdir-doinsert):
Use insert-directory.
* dired.el (dired-readin-insert): Use insert-directory.
- (dired-ls, dired-ls-program): Deleted.
+ (dired-ls, dired-ls-program): Delete.
1992-09-12 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -4269,7 +4264,7 @@
* term/x-win.el (scroll-bar-mode): New function (and variable too).
- * dired.el (dired-next-subdir, dired-subdir-index): Moved here
+ * dired.el (dired-next-subdir, dired-subdir-index): Move here
* dired-aux.el: From here.
* dired.el (dired-build-subdir-alist): Don't print msg after each dir.
Clarify final message.
@@ -4301,7 +4296,7 @@
1992-09-08 Joseph Arceneaux (jla@geech.gnu.ai.mit.edu)
- * mailabbrev.el (sendmail-pre-abbrev-expand-hook): Changed the
+ * mailabbrev.el (sendmail-pre-abbrev-expand-hook): Change the
structure of this function: don't check to call
mail-resolve-all-aliases unless we are actually in a header field
where an abbrev should be expanded.
@@ -4350,7 +4345,7 @@
1992-09-02 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * c-mode.el (c-auto-newline): Added backslashed before quotes in
+ * c-mode.el (c-auto-newline): Add backslashed before quotes in
docstring.
1992-09-01 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -4451,7 +4446,7 @@
(mail-signature-file): This, since this is the way all the
other lisp packages do it, and it's how people always say they
want it on the mailing lists.
- (mail-setup, mail-signature): Adjusted accordingly.
+ (mail-setup, mail-signature): Adjust accordingly.
(mail): Doc fix.
1992-08-17 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -4549,9 +4544,9 @@
* calendar.el (calendar-interval): Fix doc string.
- * calendar.el (calendar): Changed use of prefix arg--now it causes
+ * calendar.el (calendar): Change use of prefix arg--now it causes
prompting for the month and year.
- (regenerate-calendar-window): Renamed generate-calendar-window.
+ (regenerate-calendar-window): Rename generate-calendar-window.
Changed optional argument from an offset from the current month to
a month, year pair.
(redraw-calendar, calendar-current-month, scroll-calendar-left)
@@ -4567,7 +4562,7 @@
1992-08-08 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * frame.el (set-screen-width, set-screen-height): Changed these
+ * frame.el (set-screen-width, set-screen-height): Change these
from fset aliases to actual functions, since they aren't supposed
to take a frame argument, while set-frame-{width,height} do.
@@ -4600,8 +4595,8 @@
* appt.el (appt-issue-message, appt-message-warning-time)
(appt-audible, appt-visible, appt-display-mode-line)
- (appt-msg-window, appt-display-duration, appt-display-diary): Added
- ;;;###autoload cookies for these variables, since they are options
+ (appt-msg-window, appt-display-duration, appt-display-diary):
+ Add ;;;###autoload cookies for these variables, since they are options
for the user to set.
* tex-mode.el (tex-shell-file-name, tex-directory, tex-offer-save)
(tex-run-command, latex-run-command, latex-block-names)
@@ -4615,29 +4610,29 @@
* add-log.el (add-log-current-defun): Use eq instead of = when one
side might be nil.
- * compile.el (compilation-mode-map): Change
- compilation-previous/next-file bindings to M-{ and M-}.
+ * compile.el (compilation-mode-map):
+ Change compilation-previous/next-file bindings to M-{ and M-}.
1992-08-05 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
* cl.el (*cl-valid-named-list-accessors*, *cl-valid-nth-offsets*)
- (byte-compile-named-accessors): Deleted.
+ (byte-compile-named-accessors): Delete.
(first, second, ... tenth, rest): Define these with defsubst, to
get the same effect.
- (byte-compile-ca*d*r): Deleted.
+ (byte-compile-ca*d*r): Delete.
(caar, cadr, ..., cddddr): Define these using defsubst.
Installed changes from Zawinski-Furuseth 2.04 to 2.07:
* byte-run.el (dont-compile): Doc fix.
(make-obsolete-variable): New function.
- * bytecomp.el (byte-compile-log-1): Added new optional argument,
+ * bytecomp.el (byte-compile-log-1): Add new optional argument,
FILL; if it is non-nil, reformat the error message.
(byte-compile-warn): Use that flag.
(byte-recompile-directory): Offer to recompile subdirectories.
If prefix argument is zero, create .elc files for those .el files
which lack them, without asking.
- (byte-compile-output-form, byte-compile-output-docform): Disable
- print-gensym while writing the form.
+ (byte-compile-output-form, byte-compile-output-docform):
+ Disable print-gensym while writing the form.
(byte-compile-form): Warn if t or nil are called as functions.
(byte-compile-variable-ref): Check for, and warn about, obsolete
variable uses.
@@ -4654,7 +4649,7 @@
* inf-lisp.el (inferior-lisp-filter-regexp, inferior-lisp-program)
(inferior-lisp-load-command, inferior-lisp-prompt)
- (inferior-lisp-mode-hook, inferior-lisp): Added ;;;###autoload
+ (inferior-lisp-mode-hook, inferior-lisp): Add ;;;###autoload
cookies for these.
* bytecomp.el (byte-compile-warnings): When choosing the default
@@ -4690,8 +4685,8 @@
* info.el (Info-mode): scroll-up, scroll-down now do the right
thing for preorder browsing when the beginning/end of the node
- is visible. RET now goes to the next preorder node. These
- changes make sequential reading of info subtrees easier.
+ is visible. RET now goes to the next preorder node.
+ These changes make sequential reading of info subtrees easier.
1992-08-04 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -4703,7 +4698,7 @@
* vc.el (vc-next-action, vc-register, vc-diff, vc-insert-headers)
(vc-directory, vc-create-snapshot, vc-retrieve-snapshot)
(vc-print-log, vc-revert-buffer, vc-cancel-version)
- (vc-update-change-log): Added the ;;;###autoload cookies to these
+ (vc-update-change-log): Add the ;;;###autoload cookies to these
functions, since they get bound to keys in the global keymap.
* loadup.el: Load vc-hooks.el.
@@ -4778,7 +4773,7 @@
(medit-zap-define-to-mdl): Change `medit-save-defun' to
`medit-save-define'.
(medit-save-region, medit-save-buffer, medit-zap-define-to-mdl):
- Changed `medit-go-to-mdl' to `medit-goto-mdl'. Did anyone ever
+ Change `medit-go-to-mdl' to `medit-goto-mdl'. Did anyone ever
try this code?
1992-08-02 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -4810,13 +4805,13 @@
(dired-create-files, dired-handle-overwrite):
Rename overwrite-confirmed to dired-overwrite-confirmed.
(dired-do-kill-lines): Handle prefix arg as number of lines to kill.
- (dired-kill-line-or-subdir): Deleted.
+ (dired-kill-line-or-subdir): Delete.
1992-08-01 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
- * mailabbrev.el [from jwz] (mail-interactive-insert-alias): Do
- mail-aliases-setup if necessary before completing for interactive.
- (build-mail-aliases): Changed parsing regexp.
+ * mailabbrev.el [from jwz] (mail-interactive-insert-alias):
+ Do mail-aliases-setup if necessary before completing for interactive.
+ (build-mail-aliases): Change parsing regexp.
* compile.el (compilation-parse-errors): Take 2nd arg FIND-AT-LEAST.
If non-nil, stop after parsing that many new errors.
@@ -4831,7 +4826,7 @@
* comint.el: ring-* functions deleted--get them from ring.el.
- * ring.el (ring-mod): Renamed from comint-mod.
+ * ring.el (ring-mod): Rename from comint-mod.
Provide `ring', not history'.
(make-ring, ring-p): Add autoloads.
* history.el: Link deleted.
@@ -4851,7 +4846,7 @@
Use buffer-disable-undo instead of buffer-flush-undo; the latter
is obsolete.
- * lpr.el (print-region-new-buffer): Added arguments START and END;
+ * lpr.el (print-region-new-buffer): Add arguments START and END;
this used to use dynamic scope, but it makes things less readable.
(print-region-1): Always call this with two arguments, not
sometimes two and sometimes none.
@@ -4882,7 +4877,7 @@
* hideif.el (hif-endif-to-ifdef): Fix munged comment which was
interfering with parsing.
- * hexl.el (hexl-next-line): Fixed up malformed let binding.
+ * hexl.el (hexl-next-line): Fix up malformed let binding.
* bytecomp.el (byte-compile-file): Catch errors that occur during
compilation, and record them in the compilation log. This allows
@@ -5047,10 +5042,10 @@
1992-07-28 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * files.el (backup-extract-version): Copied from Emacs 18.
+ * files.el (backup-extract-version): Copy from Emacs 18.
(find-backup-file-name): Use that.
- * dired-aux.el (dired-clean-directory): Moved here.
+ * dired-aux.el (dired-clean-directory): Move here.
(dired-map-dired-file-lines, dired-collect-file-versions)
(dired-trample-file-versions): Likewise.
* dired.el: Moved from here.
@@ -5075,7 +5070,7 @@
* compile.el (compile-goto-error): Doc fix.
- * etags.el (find-tag): Fixed prompt.
+ * etags.el (find-tag): Fix prompt.
(tag-exact-match-p): Rewritten (again).
* startup.el (command-line): Load site-start here.
@@ -5087,7 +5082,7 @@
* completion.el: Moved to external-lisp.
- * diff.el (diff-rcs, diff-sccs): Deleted.
+ * diff.el (diff-rcs, diff-sccs): Delete.
1992-07-27 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -5132,9 +5127,9 @@
1992-07-26 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* diff.el (diff-backup): New function.
- (diff-last-backup-file): Renamed from dired-last-backup-file.
+ (diff-last-backup-file): Rename from dired-last-backup-file.
* dired-aux.el (dired-backup-diff): Use diff-backup.
- (dired-last-backup-file): Moved and renamed.
+ (dired-last-backup-file): Move and renamed.
* dired.el, dired-aux.el (dired-diff, dired-backup-diff): Doc fixes.
* help.el (command-apropos): Fix call to apropos for new arg.
@@ -5190,9 +5185,9 @@
* replace.el (perform-replace): Fix typo: match-after => match-again.
(map-query-replace-regexp): Delete duplicate definition.
- * subr.el (defun-inline): Commented out.
+ * subr.el (defun-inline): Comment out.
- * comint.el (comint-input-ring*): Renamed from input-ring*.
+ * comint.el (comint-input-ring*): Rename from input-ring*.
(ring-remove, ring-rotate): Use setcar, not set-car.
* co-isearch.el: input-ring* renamed to comint-input-ring*.
@@ -5232,7 +5227,7 @@
1992-07-22 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* emerge.el (emerge-startup-hook, emerge-quit-hook):
- Renamed from ...-hooks.
+ Rename from ...-hooks.
* dired.el (dired-display-file): New command, on C-o.
@@ -5287,15 +5282,15 @@
* c-mode.el (c-backslash-region): New command.
(c-append-backslash, c-delete-backslash): New functions.
* c++-mode.el (c++-macroize-region, backslashify-current-line):
- Deleted.
- (c++-comment-region, c++-uncomment-region): Deleted.
+ Delete.
+ (c++-comment-region, c++-uncomment-region): Delete.
comment-region works just fine.
- (c++-beginning-of-defun, c++-end-defun, c++-indent-defun): Deleted.
- (c++-point-bol): Renamed from point-bol.
- (c++-within-string-p): Renamed from within-string-p.
- (c++-count-char-in-string): Renamed from count-char-in-string.
- (fill-c++-comment): Renamed from fill-C-comment.
- (c++-insert-header): Deleted.
+ (c++-beginning-of-defun, c++-end-defun, c++-indent-defun): Delete.
+ (c++-point-bol): Rename from point-bol.
+ (c++-within-string-p): Rename from within-string-p.
+ (c++-count-char-in-string): Rename from count-char-in-string.
+ (fill-c++-comment): Rename from fill-C-comment.
+ (c++-insert-header): Delete.
1992-07-21 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -5334,7 +5329,7 @@
* simple.el (end-of-buffer): If buffer end is on screen, don't scroll.
- * c-mode.el (set-c-style): Deleted the first version of this function.
+ * c-mode.el (set-c-style): Delete the first version of this function.
It was badly written.
Modified the remaining version by adding new argument GLOBAL
and setting the parameters locally if GLOBAL is nil.
@@ -5348,7 +5343,7 @@
1992-07-21 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * frame.el (get-frame): Renamed to get-other-frame; get-frame
+ * frame.el (get-frame): Rename to get-other-frame; get-frame
sounds like a parallel to get-buffer or get-process.
* c-mode.el (set-c-style): Remove the extraneous copy of this
@@ -5357,7 +5352,7 @@
* c++-mode.el (within-string-p): Use `%', not `mod', as the name
of the modulus function.
- * frame.el (frame-height, frame-width): Fixed several confusions
+ * frame.el (frame-height, frame-width): Fix several confusions
here.
* blackbox.el: When building blackbox-mode-map, locally rebind all
@@ -5389,7 +5384,7 @@
(visit-tags-file): If find-file-noselect changed the file name,
propagate the change to tags-file-name and tags-table-list.
- * startup.el (command-line): Fixed typo in comment.
+ * startup.el (command-line): Fix typo in comment.
1992-07-20 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -5411,7 +5406,7 @@
(frame-configuration-to-register): New function.
* loaddefs.el: Put them on C-x r w, C-x r f.
* window.el (window-config-to-register, register-to-window-config):
- Deleted, along with keybindings C-x 6 and C-x 7.
+ Delete, along with keybindings C-x 6 and C-x 7.
1992-07-19 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
@@ -5436,7 +5431,7 @@
(calendar-mode-map): Put it on a key.
(calendar-mode): Describe it.
- * cal-french.el (diary-french-date): Moved from diary.el and fixed
+ * cal-french.el (diary-french-date): Move from diary.el and fixed
accent.
* diary.el: Move dairy-french-date to cal-french.el and autoload it.
@@ -5474,7 +5469,7 @@
* files.el (auto-mode-alist): Recognize .texi.
- * rmail.el (rmail-delete-forward): Removed the feature
+ * rmail.el (rmail-delete-forward): Remove the feature
of moving back if there's nowhere to go forward.
1992-07-17 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
@@ -5524,12 +5519,12 @@
form so that it returns a list containing the filename and the
prefix argument, not just the prefix argument by itself.
- * bytecomp.el (byte-compile-file): Changed reference to
+ * bytecomp.el (byte-compile-file): Change reference to
byte-compile-report-call-tree to use display-call-tree.
* bytecomp.el (byte-recompile-directory, byte-compile-file)
(batch-byte-compile, byte-compile, compile-defun)
- (display-call-tree): Added autoload cookies for these functions.
+ (display-call-tree): Add autoload cookies for these functions.
1992-07-16 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -5538,7 +5533,7 @@
1992-07-16 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * byte-run.el (defsubst): Removed extra closing paren at the end
+ * byte-run.el (defsubst): Remove extra closing paren at the end
of this function.
1992-07-16 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -5572,7 +5567,7 @@
* bytecomp.el: Deleted support for running compiler in Emacs 18.
Spell "Emacs 18" properly.
(byte-compile-version): FSF 2.1.
- (byte-compiler-valid-options): Deleted.
+ (byte-compiler-valid-options): Delete.
(byte-compile-single-version): Always return nil.
(byte-compiler-version-cond): Always return the argument.
@@ -5593,7 +5588,7 @@
* buff-menu.el, bg-mouse.el, appt.el, abbrevlist.el, term/x-win.el,
* term/wyse50.el, term/vt200.el, term/vt100.el: All uses changed.
* screen.el (screen-height, screen-width, set-screen-height)
- (set-screen-width): Defined as aliases for frame-height,
+ (set-screen-width): Define as aliases for frame-height,
frame-width, set-frame-height, and set-frame-width.
(set-frame-height, set-frame-width): Functions deleted; they are
defined in frame.c.
@@ -5618,8 +5613,8 @@
* rmailsort.el: Change copyright to FSF; update permission notice.
* byte-run.el: Delete compatibility definition of make-byte-code.
- (byte-compiler-options): Commented out.
- (proclaim-inline, proclaim-notinline): Commented out.
+ (byte-compiler-options): Comment out.
+ (proclaim-inline, proclaim-notinline): Comment out.
* byte-opt.el: Change several doc strings to comments.
They had the wrong format anyway.
@@ -5628,22 +5623,22 @@
* disass.el: Require just bytecomp, not byte-opt.
* bytecomp.el (emacs-lisp-file-regexp):
- Renamed from elisp-source-file-re. All uses changed.
+ Rename from elisp-source-file-re. All uses changed.
(byte-compile-dest-file): Don't use that var.
- (compile-defun): Renamed from elisp-compile-defun.
+ (compile-defun): Rename from elisp-compile-defun.
(byte-compile-report-ops): Define unconditionally.
It's a bad idea to make function definitions of moderate size
conditional on anything.
- (byte-compile-and-load-file): Commented out.
+ (byte-compile-and-load-file): Comment out.
(byte-compiler-valid-options):
- Renamed from byte-compiler-legal-options.
+ Rename from byte-compiler-legal-options.
(byte-compile-overwrite-file): Variable deleted.
(byte-compile-file): Don't use that var.
(byte-compile-compatibility):
- Renamed from byte-compile-emacs18-compatibility.
+ Rename from byte-compile-emacs18-compatibility.
(byte-compile-generate-emacs19-bytecodes): Variable deleted.
Use byte-compile-compatibility instead.
- (byte-compiler-options-handler): Deleted.
+ (byte-compiler-options-handler): Delete.
(byte-compile-body-do-effect, byte-compile-form-do-effect):
Use defsubst, not proclaim-inline.
@@ -5699,7 +5694,7 @@
* disass.el: New version of the disassembler, to fit with the new
compiler.
- * mouse.el (mouse-select-buffer-line): Removed extraneous setting
+ * mouse.el (mouse-select-buffer-line): Remove extraneous setting
of the variable `the-buffer'; it's never used elsewhere.
* mouse.el (mouse-kill): Don't set the mark; pass point and the
@@ -5707,7 +5702,7 @@
1992-07-09 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * abbrev.el (write-abbrev-file): Removed extraneous interactive spec.
+ * abbrev.el (write-abbrev-file): Remove extraneous interactive spec.
* screen.el (current-screen-configuration,
set-screen-configuration): New functions.
@@ -5718,8 +5713,8 @@
instead of `deiconify-screen'; the latter no longer exists.
* files.el (find-backup-file-name): Replace the reference to
- `backup-extract-version' with a literal `function' form. This
- eliminates the use of dynamic binding, and allows us to remove
+ `backup-extract-version' with a literal `function' form.
+ This eliminates the use of dynamic binding, and allows us to remove
backup-extract-version, which doesn't really want to be its own
function.
(backup-extract-version): Function removed.
@@ -5771,7 +5766,7 @@
* tex-mode.el: Require comint instead of oshell.
(tex-start-shell): Use comint, not oshell.
- (tex-filter): Deleted function; no filter is now longer needed.
+ (tex-filter): Delete function; no filter is now longer needed.
* tex-mode.el (tex-run-command, latex-run-command, slitex-run-command)
(tex-bibtex-run-command, tex-dvi-print-command)
@@ -5848,7 +5843,7 @@
1992-06-28 Jim Blandy (jimb@pogo.cs.oberlin.edu)
* completion.el (completion-separator-self-insert-autofilling):
- Changed references to `auto-fill-hook' to `auto-fill-function'.
+ Change references to `auto-fill-hook' to `auto-fill-function'.
* mh-e.el (mh-letter-mode): Same thing.
* texinfo-upd.el (texinfo-update-node,
texinfo-sequential-node-update): Same thing.
@@ -5868,7 +5863,7 @@
calendar-daylight-savings-starts, calendar-daylight-savings-ends.
Add autoload of calendar-sunrise-sunset.
(calendar-mode): Add description of sunrise/sunset capability.
- (calendar-version): Changed to 5.
+ (calendar-version): Change to 5.
* diary.el: Autoload diary-sunrise-sunset and diary-sabbath-candles.
@@ -5920,10 +5915,10 @@
(all-christian-calendar-holidays, all-islamic-calendar-holidays)
(list-diary-entries-hook, diary-display-hook)
(nongregorian-diary-listing-hook, nongregorian-diary-marking-hook)
- (diary-list-include-blanks): Added autoload cookie for these;
+ (diary-list-include-blanks): Add autoload cookie for these;
Reingold's distribution suggests that these variables are ones
that you are especially likely to want to customize.
- * holiday.el (holidays): Added autoload cookie for this.
+ * holiday.el (holidays): Add autoload cookie for this.
1992-06-25 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
@@ -5958,7 +5953,7 @@
* dired.el: Complete rewrite, mostly by sk@thp.uni-koeln.de.
* dired-aux.el: Other parts of dired.
- * files.el (enable-local-eval): Renamed from `ignore-local-eval';
+ * files.el (enable-local-eval): Rename from `ignore-local-eval';
now has values like `enable-local-variables'.
(hack-local-variables): Test `enable-local-eval' properly.
@@ -5979,7 +5974,7 @@
1992-06-21 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * screen.el (ctl-x-5-map): Removed declaration and initialization
+ * screen.el (ctl-x-5-map): Remove declaration and initialization
of this here; it's done in subr.el, alongside ctl-x-4-map.
* autoload.el (generate-file-autoloads): If FILE is in the same
@@ -6008,7 +6003,7 @@
1992-06-18 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * edebug.el (edebug-debug): Added autoload cookie for this.
+ * edebug.el (edebug-debug): Add autoload cookie for this.
* etags.el (find-tag-other-frame): New function. Bind it to
`C-x 5 .'.
@@ -6048,7 +6043,7 @@
now the keymap `isearch-mode-map' controls special characters in
isearch-mode.
- * blackbox.el (blackbox): Added ;;;###autoload cookie.
+ * blackbox.el (blackbox): Add ;;;###autoload cookie.
* add-log.el (change-log-mode): Integrated some code from the
`change-log-mode' function in `text-mode.el'. Docstring now
@@ -6090,7 +6085,7 @@
1992-06-12 Joseph Arceneaux (jla@churchy.gnu.ai.mit.edu)
- * simple.el (current-kill): Fixed misnamed parameter and
+ * simple.el (current-kill): Fix misnamed parameter and
reorganized code slightly.
1992-06-11 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -6127,7 +6122,7 @@
1992-06-08 Richard Stallman (rms@mole.gnu.ai.mit.edu)
- * csharp.el (c-find-nesting): Renamed from csharp-find-nesting.
+ * csharp.el (c-find-nesting): Rename from csharp-find-nesting.
Add autoload.
All other functions in this file renamed to start with c-find-nesting.
@@ -6209,7 +6204,7 @@
1992-06-02 Roland McGrath (roland@geech.gnu.ai.mit.edu)
* add-log.el: Fixed copyright years to not use a range.
- (change-log-mode): Added docstring.
+ (change-log-mode): Add docstring.
(add-change-log-entry): Put a space between the file name and
"(function name):". Put a colon after the file name if we have
found no function name.
@@ -6252,7 +6247,7 @@
* fill.el (fill-region-as-paragraph): Treat } like closeparen.
If a fill prefix is specified globally, always use that one.
- * flow-ctrl.el (evade-flow-control-memstr=): Renamed from memstr=.
+ * flow-ctrl.el (evade-flow-control-memstr=): Rename from memstr=.
1992-05-31 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -6263,7 +6258,7 @@
1992-05-31 Noah Friedman (friedman@splode.com)
- * subr.el (lambda): Added docstring.
+ * subr.el (lambda): Add docstring.
1992-05-31 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
@@ -6291,7 +6286,7 @@
of writing out its code.
* comint.el: Merged with Olin Shivers' comint version 2.03.
- (comint-version): Changed accordingly.
+ (comint-version): Change accordingly.
(comint-previous-input-matching): Bind this to c-m-r, rather
than c-c c-r.
(comint-exec-hook): Make this variable buffer-local.
@@ -6305,8 +6300,8 @@
to "Non-echoed text: ". This conforms with the convention
used by existing prompts, and gives more room to type stuff.
- * comint.el (comint-last-input-start): New variable. In
- particular, this helps support subprocesses that insist on echoing
+ * comint.el (comint-last-input-start): New variable.
+ In particular, this helps support subprocesses that insist on echoing
their input. Added comments to porting guide indicating that
this should probably not be used for implementing history stuff.
(comint-mode): Create and initialize comint-last-input-start as a
@@ -6345,9 +6340,9 @@
1992-05-24 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
* calendar.el (list-yahrzeit-dates): New function.
- (hebrew-calendar-yahrzeit): Moved from diary.el.
+ (hebrew-calendar-yahrzeit): Move from diary.el.
- * diary.el (hebrew-calendar-yahrzeit): Moved to calendar.el.
+ * diary.el (hebrew-calendar-yahrzeit): Move to calendar.el.
(diary-ordinal-suffix): Give correct suffix for 111, 112, 113, 211,
212, 213, etc.
@@ -6366,7 +6361,7 @@
below instead of manipulating the kill ring directly, since the
functions correctly deal with interprogram cutting and pasting.
(kill-new): New function.
- (kill-append): Added doc string. Be sure to call the
+ (kill-append): Add doc string. Be sure to call the
interprogram-cut-function on the new string.
(current-kill): New function.
(rotate-yank-pointer): New optional argument do-not-move, to
@@ -6393,7 +6388,7 @@
how many characters were saved, and it's hard to interpret
intuitively.
- * screen.el (ctl-x-3-map): Renamed to ctl-x-5-map, and now bound
+ * screen.el (ctl-x-3-map): Rename to ctl-x-5-map, and now bound
to C-x 5, not C-x 3. This makes a nicer analogy with C-x 4.
Moving split-window-horizontally to C-x 3 also makes a nicer
analogy with C-x 2.
@@ -6508,7 +6503,7 @@
1992-04-21 Jim Blandy (jimb@pogo.cs.oberlin.edu)
- * doctor.el (doctor-svo): Deleted second expression from top let
+ * doctor.el (doctor-svo): Delete second expression from top let
binding; it used to read "(let ((foo <exp> sent)) ...)"; let
bindings can only have one expression.
@@ -6654,7 +6649,7 @@
* compile.el (compilation-mode-hook): New variable.
(compilation-mode): Run it.
(compilation-search-path): Made user variable, added autoload cookie.
- (compilation-window-height): Added autoload cookie.
+ (compilation-window-height): Add autoload cookie.
1992-02-27 Jim Blandy (jimb@pogo.cs.oberlin.edu)
@@ -6725,7 +6720,7 @@
1992-01-08 Jim Blandy (jimb@occs.cs.oberlin.edu)
- * simple.el (temporary-goal-column): Added missing closing paren.
+ * simple.el (temporary-goal-column): Add missing closing paren.
1991-12-25 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -6757,7 +6752,7 @@
1991-12-14 Eric S. Raymond (eric@mole.gnu.ai.mit.edu)
- * etags.el (find-tag-noselect): Fixed subtle bug due to
+ * etags.el (find-tag-noselect): Fix subtle bug due to
save-excursion.
(tags-tag-match): New function, made smarter about exact matches.
@@ -6808,7 +6803,7 @@
1991-12-08 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* diff.el (diff-internal-diff): New subroutine.
- (diff): Removed from here.
+ (diff): Remove from here.
(diff-sccs, diff-rcs): New commands using diff-internal-diff.
(diff-rcs-extension): New variable.
@@ -6860,7 +6855,7 @@
1991-11-06 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
* screen.el (screen-initialize, screen-notice-user-settings):
- Renamed global-minibuffer-screen to default-minibuffer-screen.
+ Rename global-minibuffer-screen to default-minibuffer-screen.
1991-11-05 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
@@ -6869,8 +6864,8 @@
1991-10-31 Richard Mlynarik (mly@peduncle)
- * ebuff-menu.el (electric-buffer-menu-mode-map): Define
- < and > to scroll-left and scroll-right per user suggestion.
+ * ebuff-menu.el (electric-buffer-menu-mode-map):
+ Define < and > to scroll-left and scroll-right per user suggestion.
1991-10-31 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -6886,7 +6881,7 @@
* cmushell.el: This is now the real shell.el. Removed the "cmu"
prefix from names.
- (shell): Marked this to be autoloaded.
+ (shell): Mark this to be autoloaded.
1991-10-29 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -6907,8 +6902,8 @@
1991-10-26 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
* disass.el (disassemble): Correctly distinguish functions with no
- interactive spec and functions that are (interactive). Correctly
- extract components of explicit calls to byte-code (old-style
+ interactive spec and functions that are (interactive).
+ Correctly extract components of explicit calls to byte-code (old-style
compiled functions). Correctly pass byte code of function to
disassemble-1.
(disassemble-1): Use nth to extract components of explicit call to
@@ -6928,14 +6923,14 @@
1991-10-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
- * info.el (Info-follow-nearest-node): Adjusted for new return
+ * info.el (Info-follow-nearest-node): Adjust for new return
value format from coordinates-in-window-p.
1991-10-08 Roland McGrath (roland@albert.gnu.ai.mit.edu)
* add-log.el (change-log-name): New fn.
- (add-change-log-entry, add-change-log-entry-other-window): All
- args optional. FILE-NAME defaults to new var
+ (add-change-log-entry, add-change-log-entry-other-window):
+ All args optional. FILE-NAME defaults to new var
`change-log-default-name'. Give this var a local value in the
buffer we were run from, pointing to the file we found.
@@ -6977,7 +6972,7 @@
1991-09-26 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
- * map-ynp.el (map-y-or-n-p): Fixed for lists containing nil.
+ * map-ynp.el (map-y-or-n-p): Fix for lists containing nil.
1991-09-10 Roland McGrath (roland@wookumz.gnu.ai.mit.edu)
@@ -7039,7 +7034,7 @@
* rmail.el (rmail-convert-to-babyl-format): Roland added the
missing paren in the wrong place; fixed.
- * screen.el (screen-initialize): Added missing `function' around
+ * screen.el (screen-initialize): Add missing `function' around
lambda expression.
1991-08-20 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -7068,7 +7063,7 @@
1991-08-17 Roland McGrath (roland@geech.gnu.ai.mit.edu)
* doctor.el (doctor-strangelove): New fn.
- (doctor-member): Removed.
+ (doctor-member): Remove.
(doctor-doc): Use member instead of doctor-member.
(doctor-rms): Restored.
@@ -7078,7 +7073,7 @@
1991-08-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
- * screen.el (screen-create-initial-screen): Renamed to
+ * screen.el (screen-create-initial-screen): Rename to
screen-initialize. Arrange to cause errors if people try to
create screens when no window system is running.
@@ -7090,14 +7085,14 @@
* loaddefs.el (ctl-x-4-map): Move definition from here...
* subr.el (ctl-x-4-map): To here.
(ctl-x-3-map): New prefix.
- (mouse-map): Deleted.
+ (mouse-map): Delete.
* screen.el (new-screen-x-delta, new-screen-y-delta)
- (new-screen-position): Removed.
- (new-screen): Simplified.
- (split-to-other-screen): Removed.
+ (new-screen-position): Remove.
+ (new-screen): Simplify.
+ (split-to-other-screen): Remove.
(switch-to-buffer-other-screen, find-file-other-screen)
- (find-file-read-only-other-screen, mail-other-screen): Moved, along
+ (find-file-read-only-other-screen, mail-other-screen): Move, along
with their keybindings, to...
* files.el (switch-to-buffer-other-screen, find-file-other-screen)
(find-file-read-only-other-screen): Here...
@@ -7141,11 +7136,11 @@
* screen.el, term/x-win.el: Renamed screen-default-alist to
default-screen-alist.
- (default-screen-alist): Moved declaration to screen.c; the
+ (default-screen-alist): Move declaration to screen.c; the
screen creation subrs should consult this transparently.
- * term/x-win.el (x-get-resources, x-pop-initial-window): Functions
- deleted. Don't call them at the bottom of the file anymore.
+ * term/x-win.el (x-get-resources, x-pop-initial-window):
+ Functions deleted. Don't call them at the bottom of the file anymore.
1991-08-12 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -7157,15 +7152,15 @@
1991-08-12 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
* window.el (split-window-keep-point): New user option.
- (split-window-vertically): Modified to support it.
+ (split-window-vertically): Modify to support it.
* startup.el (command-line): Choose a default value for
split-window-keep-point according to the baud rate.
* term/x-win.el: Set split-window-keep-point.
1991-08-10 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
- * term/x-win.el (x-daemon-mode, x-establish-daemon-mode): Removed
- these functions; we do this differently now.
+ * term/x-win.el (x-daemon-mode, x-establish-daemon-mode):
+ Remove these functions; we do this differently now.
1991-08-07 Roland McGrath (roland@geech.gnu.ai.mit.edu)
@@ -7174,7 +7169,7 @@
1991-08-05 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
- * screen.el (screen-creation-func): Renamed to
+ * screen.el (screen-creation-func): Rename to
screen-creation-function, as per the convention.
* screen.el (screen-creation-func): Do not initialize this
@@ -7189,7 +7184,7 @@
* startup.el (pre-init-hook): New variable.
(window-setup-hook): Doc fix.
(command-line): Call pre-init-hook.
- (command-line-1): Updated copyright date.
+ (command-line-1): Update copyright date.
1991-07-31 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -7198,7 +7193,7 @@
1991-07-31 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
- * screen.el (auto-new-screen-function): Renamed to
+ * screen.el (auto-new-screen-function): Rename to
pop-up-screen-function.
(buffer-in-other-screen): Use pop-up-screens, not auto-new-screen.
@@ -7244,12 +7239,12 @@
* view.el: (define-key "C-xv" 'view-file).
(view-file-other-window, view-buffer-other-window): New functions.
- (view-prev-buffer): Renamed to view-return-here.
+ (view-prev-buffer): Rename to view-return-here.
(view-exit): If view-return-here is a buffer, switch to it;
if it is a window configuration, apply it.
- * subr.el (search-forward-regexp, search-backward-regexp): Added
- alternate names.
+ * subr.el (search-forward-regexp, search-backward-regexp):
+ Add alternate names.
1991-07-24 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -7261,7 +7256,7 @@
* isearch.el (isearch): If the user switches to a different
screen, exit the isearch.
- * isearch.el (isearch): Changed reference to `cmds' to use
+ * isearch.el (isearch): Change reference to `cmds' to use
variable's new name `history'.
1991-07-23 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -7269,7 +7264,7 @@
* rmail.el (rmail-first-unseen-message): Make loop looking for
unseen msgs not skip the first one.
- * rmail.el (rmail-widen-to-current-msgbeg): Added missing close paren.
+ * rmail.el (rmail-widen-to-current-msgbeg): Add missing close paren.
1991-07-21 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -7291,7 +7286,7 @@
1991-07-19 Roland McGrath (roland@albert.gnu.ai.mit.edu)
- * files.el (save-some-buffers): Added save-excursions around code
+ * files.el (save-some-buffers): Add save-excursions around code
that does set-buffer.
1991-07-15 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
@@ -7302,7 +7297,7 @@
(find-tag-tag): Pass 'tags-completion-alist as TABLE to
completing-read, so the table is built on demand.
- * sendmail.el (mail-do-fcc): Added missing close paren.
+ * sendmail.el (mail-do-fcc): Add missing close paren.
1991-07-15 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -7318,8 +7313,8 @@
* fortran.el version 1.28.3
Now works in either mode when `tab-width' is not 8.
- (fortran-electric-line-number, fortran-indent-to-column): Use
- `fortran-minimum-statement-indent' instead of 8.
+ (fortran-electric-line-number, fortran-indent-to-column):
+ Use `fortran-minimum-statement-indent' instead of 8.
(fortran-current-line-indentation): Now skips over line number
and whitespace correctly when tab-width is not 8.
@@ -7336,7 +7331,7 @@
* startup.el (command-line): Remove the arguments from
command-line-args as we process them.
- (command-line-1): Removed code to ignore the arguments processed
+ (command-line-1): Remove code to ignore the arguments processed
in command-line, because they're all deleted now.
* replace.el (occur): Set tem to the location of the match before
@@ -7356,7 +7351,7 @@
1991-07-09 Roland McGrath (roland@albert.gnu.ai.mit.edu)
- * map-ynp.el (map-y-or-n-p): Fixed lossage on ? or random char.
+ * map-ynp.el (map-y-or-n-p): Fix lossage on ? or random char.
1991-07-08 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -7373,8 +7368,8 @@
* fortran.el: Added ;;;###autoload definition for
fortran-tab-mode-default variable.
- * fortran.el (fortran-numerical-continuation-char): Replace
- (backward-line 1) with (forward-line -1) since backward-line is
+ * fortran.el (fortran-numerical-continuation-char):
+ Replace (backward-line 1) with (forward-line -1) since backward-line is
defined only in edt.
(fortran-previous-statement): Fix error in parens.
(fortran-indent-to-column): Likewise.
@@ -7383,7 +7378,7 @@
* files.el (save-some-buffers): Use map-y-or-n-p return value.
- * map-ynp.el (map-y-or-n-p): Fixed bug that caused first elt on !
+ * map-ynp.el (map-y-or-n-p): Fix bug that caused first elt on !
hit not get acted on.
1991-07-04 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -7395,7 +7390,7 @@
1991-07-01 Roland McGrath (roland@churchy.gnu.ai.mit.edu)
- * map-ynp.el (map-y-or-n-p): Fixed misplaced paren.
+ * map-ynp.el (map-y-or-n-p): Fix misplaced paren.
Fixed list-eating bug.
1991-07-01 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -7430,7 +7425,7 @@
1991-06-20 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu)
- * subr.el (ignore): Added docstring for this; it appears as a key
+ * subr.el (ignore): Add docstring for this; it appears as a key
binding, so it ought to be described.
1991-06-19 Roland McGrath (roland@albert.gnu.ai.mit.edu)
@@ -7448,16 +7443,16 @@
1991-06-12 Roland McGrath (roland@albert.gnu.ai.mit.edu)
- * upd-copyr.el (update-copyright): Fixed typo in help text.
+ * upd-copyr.el (update-copyright): Fix typo in help text.
1991-05-26 Roland McGrath (roland@albert.gnu.ai.mit.edu)
- * disass.el (disassemble-internal): Fixed typo string? -> stringp.
+ * disass.el (disassemble-internal): Fix typo string? -> stringp.
1991-05-26 Edward M. Reingold (reingold@emr.cs.uiuc.edu)
- * holiday.el (calendar-holiday-function-passover-etc): Correct
- date and spelling of Yom HaAtzma'ut.
+ * holiday.el (calendar-holiday-function-passover-etc):
+ Correct date and spelling of Yom HaAtzma'ut.
1991-05-23 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
@@ -7506,14 +7501,14 @@
screen-default-alist alone; don't use x-switches-specified.
(x-read-resources): New function to read the X defaults and put
them in screen-default-alist. Call this function at the bottom.
- * screen.el (death-function): Removed, because this is now handled
+ * screen.el (death-function): Remove, because this is now handled
better in startup.el.
(pop-initial-screen): Don't do a condition-case to call
death-function.
1991-05-18 Jim Blandy (jimb@pogo.gnu.ai.mit.edu)
- * macros.el (apply-macro-to-region-lines): Added a save-excursion
+ * macros.el (apply-macro-to-region-lines): Add a save-excursion
around the macro invocation, so that the macro doesn't need to
stay on the same line.
@@ -7619,7 +7614,7 @@
* find-dired.el (find-dired-filter): Don't search; use
forward-line instead.
- (find-dired-filter, find-dired-sentinel): Changed docstrings to
+ (find-dired-filter, find-dired-sentinel): Change docstrings to
comments.
1991-05-11 Roland McGrath (roland@albert.gnu.ai.mit.edu)
@@ -7760,8 +7755,8 @@
Now supports tab or fixed format style of continuation control and
indentation. In tab style, lines start with a tab, or a line
number followed by a tab. If the first character after the tab is
- a digit from 1 to 9, the line is a continuation line. When
- entering fortran mode for a file, the first line that begins with
+ a digit from 1 to 9, the line is a continuation line.
+ When entering fortran mode for a file, the first line that begins with
6 spaces or a tab is found. The buffer is then set respectively
to either fixed format or tab format style. The mode may be
toggled with the command fortran-tab-mode.
@@ -7970,7 +7965,7 @@
1991-02-25 Paul Hilfinger (hilfingr@hilfinger.cs.nyu.edu)
- * fill.el (fill-individual-paragraphs): Changed response to mailp
+ * fill.el (fill-individual-paragraphs): Change response to mailp
to effect only leading lines in a region (was getting confused
about colons embedded in ordinary text). Changed method of
moving to next paragraph in the main loop to use forward-paragraph
@@ -7983,7 +7978,7 @@
1991-02-23 Roland McGrath (mcgrath@cygint.cygnus.com)
- * compile.el (next-error): Fixed bug in rms's optimization.
+ * compile.el (next-error): Fix bug in rms's optimization.
1991-02-23 Richard Stallman (rms@mole.ai.mit.edu)
@@ -8045,7 +8040,7 @@
1991-02-04 Jim Blandy (jimb@gnu.ai.mit.edu)
- * simple.el (eval-current-buffer): Removed, since it has been
+ * simple.el (eval-current-buffer): Remove, since it has been
reintroduced to the C code.
1991-02-02 Jim Blandy (jimb@gnu.ai.mit.edu)
@@ -8119,8 +8114,8 @@
* bibtex.el: Expanded the various bibtex-field-* patterns to
allow fields like 'title = poft # "Fifth Triquaterly" # random-conf,'.
Needs to have more work done to accept all cases. Added code for
- the bibtex 'crossref' command, which subsumes other options. Made
- field ordering different when this option on. Also allow user to
+ the bibtex 'crossref' command, which subsumes other options.
+ Made field ordering different when this option on. Also allow user to
have a list of field to be added to all entries
(bibtex-mode-user-optional-fields). Merged in Bengt Martensson's
changes.
@@ -8153,13 +8148,13 @@
1991-01-08 Roland McGrath (roland@albert.ai.mit.edu)
- * compile.el (compilation-parse-errors): Fixed maintenance of
+ * compile.el (compilation-parse-errors): Fix maintenance of
last-linenum, so dups are really found.
1991-01-08 Jim Blandy (jimb@pogo.ai.mit.edu)
- * bytecomp.el (byte-compile-byte-code-maker): Since
- byte-compile-lambda is free to return the original lambda
+ * bytecomp.el (byte-compile-byte-code-maker):
+ Since byte-compile-lambda is free to return the original lambda
expression, we'd better be prepared to handle things that aren't
bytecode objects.
@@ -8247,8 +8242,8 @@
1990-12-20 Chris Hanson (cph@kleph)
- * texnfo-upd.el (texinfo-update-menu-region-beginning): Change
- code that searches for "top" node so it returns the position of
+ * texnfo-upd.el (texinfo-update-menu-region-beginning):
+ Change code that searches for "top" node so it returns the position of
the beginning of the node line. Always search from the buffer's
start when looking for that node.
(texinfo-make-one-menu): Bump forward over the outer node line.
@@ -8322,7 +8317,7 @@
1990-12-12 Roland McGrath (roland@albert.ai.mit.edu)
- * compile.el (compilation-error-buffer): Removed.
+ * compile.el (compilation-error-buffer): Remove.
(compilation-last-buffer): Now last buffer in which any of: started
compilation; C-x `; C-c C-c; was done.
(compile-internal): Don't set compilation-error-buffer.
@@ -8345,7 +8340,7 @@
error-message, and regexp-alist.
(compile-internal): Do it here, after calling compilation-mode.
- * compile.el (compilation-error-list): Changed elt format.
+ * compile.el (compilation-error-list): Change elt format.
(compilation-parse-errors): Don't find files when parsing.
Instead record ((DIR . FILE) . LINENO) structures to describe each
error.
@@ -8406,35 +8401,35 @@
1990-11-30 Mike Newton (newton@gumby.cs.caltech.edu)
- * bibtex.el (start comments): Added earlier comments of Bengt
+ * bibtex.el (start comments): Add earlier comments of Bengt
Martensson. Some of the changes listed below are originally
his (including clean-entry, OPTkey and OPTannote, the function
renaming and the preamble code).
- * bibtex.el (bibtex-field-* patterns): Expanded to allow fields
+ * bibtex.el (bibtex-field-* patterns): Expand to allow fields
like 'title = poft # "Fifth Triquaterly" # random-conf,'.
Needs to have more work done to accept all cases.
- * bibtex.el (bibtex-clean-entry-zap-empty-opts): Added.
+ * bibtex.el (bibtex-clean-entry-zap-empty-opts): Add.
- * bibtex.el (bibtex-include-OPTcrossref): Added. If set, changes
+ * bibtex.el (bibtex-include-OPTcrossref): Add. If set, changes
order of the lists presented to luser.
- * bibtex.el (bibtex-include-OPTkey & bibtex-include-OPTannote): Added.
+ * bibtex.el (bibtex-include-OPTkey & bibtex-include-OPTannote): Add.
* bibtex.el (bibtex-mode-user-optional-fields): Can be set to a list
of field the user wants to add to entries.
- * bibtex.el (bibtex-mode documentation string): Updated for new changes,
+ * bibtex.el (bibtex-mode documentation string): Update for new changes,
DEAthesis added back in, bibtex-preamble call added.
* bibtex.el (bibtex-entry): Add OPTkey/annote. If OPTcrossref set
then put it in.
- * bibtex.el (bibtex-make-entry): Renamed bibtex-make-field.
+ * bibtex.el (bibtex-make-entry): Rename bibtex-make-field.
- * bibtex.el (bibtex-make-optional-entry): Renamed
- bibtex-make-optional-field.
+ * bibtex.el (bibtex-make-optional-entry):
+ Rename bibtex-make-optional-field.
* bibtex.el (bibtex-Article): Change order of presentation
if OPTcrossref is set.
@@ -8448,16 +8443,16 @@
* bibtex.el (bibtex-InProceedings): Change order of presentation
if OPTcrossref is set.
- * bibtex.el (bibtex-MastersThesis): Added "note".
+ * bibtex.el (bibtex-MastersThesis): Add "note".
- * bibtex.el (bibtex-preamble): Added.
+ * bibtex.el (bibtex-preamble): Add.
* bibtex.el (bibtex-inside-field): Only go backwards if quote is there.
- * bibtex.el (bibtex-clean-entry): Added call to
+ * bibtex.el (bibtex-clean-entry): Add call to
bibtex-clean-entry-zap-empty-opts, OPT field testing for errors.
- * bibtex.el (bibtex-x-help): Added options Conference and preamble,
+ * bibtex.el (bibtex-x-help): Add options Conference and preamble,
restored DEAthesis.
1990-11-30 Richard Stallman (rms@mole.ai.mit.edu)
@@ -8557,7 +8552,7 @@
(insert-hebrew-diary-entry, insert-monthly-hebrew-diary-entry)
(insert-yearly-hebrew-diary-entry, insert-islamic-diary-entry)
(insert-monthly-islamic-diary-entry)
- (insert-yearly-islamic-diary-entry): Modified so that if a prefix arg
+ (insert-yearly-islamic-diary-entry): Modify so that if a prefix arg
is supplied these make nonmarking diary entries; otherwise the entries
made are marking.
(insert-block-diary-entry, insert-anniversary-diary-entry)
@@ -8577,27 +8572,27 @@
1990-11-06 Ed Reingold (reingold@emr.cs.uiuc.edu)
* calendar.el (sexp-diary-entry-symbol): New variable.
- (cursor-to-iso-calendar-date): Simplified, slightly.
- (cursor-to-calendar-day-of-year): Fixed punctuation.
- (cursor-to-french-calendar-date): Moved French names to arrays.
+ (cursor-to-iso-calendar-date): Simplify, slightly.
+ (cursor-to-calendar-day-of-year): Fix punctuation.
+ (cursor-to-french-calendar-date): Move French names to arrays.
* diary.el (list-sexp-diary-entries, diary-sexp-entry, diary-cyclic)
(diary-hebrew-date, diary-iso-date, diary-day-of-year)
(diary-float, diary-islamic-date, diary-anniversary, diary-block)
(diary-french-date, diary-omer, diary-yahrzeit, diary-parasha)
(diary-rosh-hodesh, hebrew-calendar-parasha-name): New functions.
- (list-diary-entries): Added call to (list-sexp-diary-entries) and
+ (list-diary-entries): Add call to (list-sexp-diary-entries) and
fixed an obscure error that caused a diary entry to be missed if it
was preceded by an empty entry of the same style.
- (list-hebrew-diary-entries, list-islamic-diary-entries): Fixed an
+ (list-hebrew-diary-entries, list-islamic-diary-entries): Fix an
obscure error that caused a diary entry to be missed if it was
preceded by an empty entry of the same style.
- (mark-islamic-calendar-date-pattern): Renamed some local variables
+ (mark-islamic-calendar-date-pattern): Rename some local variables
more appropriately.
1990-11-05 Roland McGrath (roland@geech.ai.mit.edu)
- * compile.el (compilation-window-height): Added defconst for this,
+ * compile.el (compilation-window-height): Add defconst for this,
since it somehow disappeared.
* compile.el: Unoverhauled. Restored from old 19 compile.el, plus
@@ -8627,7 +8622,7 @@
called to generate a name for a compilation buffer. Passed one arg,
the name of the major mode of the buffer. (compile-internal): Use it.
[From tale's changes:]
- (compile): Moved window enlarging to compile-internal.
+ (compile): Move window enlarging to compile-internal.
(compile-internal): Don't use with-output-to-temp-buffer.
Use display-buffer instead.
@@ -8709,10 +8704,10 @@
1990-10-23 David Lawrence (tale@pogo.ai.mit.edu)
- * emerge.el (emerge-setup, emerge-setup-with-ancestor): Moved
- insert-buffer calls back before call to emerge-extract-diffs where
+ * emerge.el (emerge-setup, emerge-setup-with-ancestor):
+ Move insert-buffer calls back before call to emerge-extract-diffs where
the merge-buffer really needs to have something in it.
- (emerge-extract-diffs,emerge-extract-diffs3): Moved errant
+ (emerge-extract-diffs,emerge-extract-diffs3): Move errant
kill-buffer which interfered with return value of functions.
1990-10-22 David Lawrence (tale@pogo.ai.mit.edu)
@@ -8787,7 +8782,7 @@
(texinfo-menu-locate-entry-p, texinfo-copy-menu-title)
(texinfo-update-menu-region-beginning, texinfo-update-menu-region-end):
Handle `@ifinfo' as well as comment line following node line.
- (texinfo-multiple-files-update and aux. files): Added to handle
+ (texinfo-multiple-files-update and aux. files): Add to handle
multi-file Texinfo sources.
1990-10-18 Richard Stallman (rms@mole.ai.mit.edu)
@@ -8835,9 +8830,9 @@
* dired.el (dired-compress, dired-uncompress): Put output from
subprocess in a buffer to display it.
- * appt.el (fix-time): Deleted.
- (appt-select-lowest-window): Renamed from select-lowest-window.
- (appt-visible): Renamed from appt-visable.
+ * appt.el (fix-time): Delete.
+ (appt-select-lowest-window): Rename from select-lowest-window.
+ (appt-visible): Rename from appt-visable.
* time.el (display-time-filter): Run display-time-hook.
@@ -8847,10 +8842,10 @@
1990-10-08 Ed Reingold (reingold@emr.cs.uiuc.edu)
- * holiday.el (calendar-holiday-function-hebrew): Fixed minor problem
+ * holiday.el (calendar-holiday-function-hebrew): Fix minor problem
with the code to short-circuit the calculations to save time.
- * diary.el (mark-hebrew-calendar-date-pattern): Fixed minor problem
+ * diary.el (mark-hebrew-calendar-date-pattern): Fix minor problem
with the code to short-circuit the calculations to save time.
1990-10-08 Richard Stallman (rms@mole.ai.mit.edu)
@@ -8962,7 +8957,7 @@
1990-09-18 Richard Stallman (rms@mole.ai.mit.edu)
- * doctor.el (doctor-caddr, doctor-cadr, doctor-cddr): Renamed.
+ * doctor.el (doctor-caddr, doctor-cadr, doctor-cddr): Rename.
1990-09-13 Richard Stallman (rms@mole.ai.mit.edu)
@@ -8984,7 +8979,7 @@
1990-09-10 Ed Reingold (reingold@emr.cs.uiuc.edu)
* diary.el (list-diary-entries, list-hebrew-diary-entries)
- (list-islamic-diary-entries): Fixed to use add-to-diary-list.
+ (list-islamic-diary-entries): Fix to use add-to-diary-list.
1990-09-10 Chris Hanson (cph@kleph)
@@ -9044,7 +9039,7 @@
* diary.el (mark-diary-entries, mark-islamic-diary-entries)
(mark-hebrew-diary-entries): Eliminated use of constant alists for
month and day names.
- (prepare-fancy-diary-buffer): Fixed the way holidays are displayed
+ (prepare-fancy-diary-buffer): Fix the way holidays are displayed
when there are no diary entries but lots of holidays.
(ordinary-list-diary-hook, add-to-diary-list): New functions.
@@ -9054,21 +9049,21 @@
Changed reference at beginning of file from the report to the
published version of the paper.
Changed all calls to `mod' to call `%' to avoid problem with cl.
- (calendar-date-string): Added optional parameter `nodayname'.
- (cursor-to-islamic-calendar-date): Fixed so that
+ (calendar-date-string): Add optional parameter `nodayname'.
+ (cursor-to-islamic-calendar-date): Fix so that
calendar-date-string doesn't try find the day name.
- (cursor-to-hebrew-calendar-date): Fixed so that
+ (cursor-to-hebrew-calendar-date): Fix so that
calendar-date-string doesn't try find the day name.
nongregorian-diary-marking-hook: Fixed typo in doc string.
- (calendar-mode): Fixed a typo in doc string.
+ (calendar-mode): Fix a typo in doc string.
(cursor-to-iso-calendar-date): Made message consistent with
similar functions for Julian, Islamic, Hebrew, and French calendars.
- (calendar-absolute-from-gregorian): Simplified calculation.
- (calendar-mark-today): Changed today mark to `=' to avoid
+ (calendar-absolute-from-gregorian): Simplify calculation.
+ (calendar-mark-today): Change today mark to `=' to avoid
confusion with the default holiday mark.
(calendar-julian-from-absolute): Rewrote parallel to other functions.
(calendar-islamic-from-absolute): Rewrote parallel to other functions.
- (calendar-forward-day): Fixed movement when cursor is not on a date
+ (calendar-forward-day): Fix movement when cursor is not on a date
and arg is negative.
Added description of new `if' form to doc string for calendar-holidays.
@@ -9079,10 +9074,10 @@
* holiday.el:
Changed all calls to `mod' to call `%' to avoid problem with cl.
- (calendar-holiday-function-rosh-hashanah-etc): Fixed grammatical
+ (calendar-holiday-function-rosh-hashanah-etc): Fix grammatical
error in a comment.
- (calendar-holiday-function-hebrew): Fixed typo in doc string.
- (calendar-holiday-function-islamic): Fixed typo in doc string.
+ (calendar-holiday-function-hebrew): Fix typo in doc string.
+ (calendar-holiday-function-islamic): Fix typo in doc string.
(calendar-holiday-function-if): New function.
1990-09-06 Richard Stallman (rms@mole.ai.mit.edu)
@@ -9119,12 +9114,12 @@
* loaddefs.el:
(gnus, gnus-post-news): Autoload gnus.
(sendnews, postnews): fset to gnus-post-news instead of news-post-news.
- (rnews, news-post-news): Removed autoloads.
+ (rnews, news-post-news): Remove autoloads.
* gnus.el: New file.
- (gnus-make-newsrc-file): Removed.
+ (gnus-make-newsrc-file): Remove.
(gnus-read-newsrc-file): Work without above.
- (gnus-Info-directory): Removed.
+ (gnus-Info-directory): Remove.
(gnus-Info-find-node): Work without above.
(lots of variables): Made non-interactive. Some doc fixes.
@@ -9156,7 +9151,7 @@
(fortran-current-line-indentation): Only skip over continuation
char or line number for statements. It was giving back wrong
values for statements which started in columns 1-6.
- (fortran-mode-version): Removed.
+ (fortran-mode-version): Remove.
1990-08-28 David Lawrence (tale@pogo.ai.mit.edu)
@@ -9166,8 +9161,8 @@
copy-vector. Calling copy-sequence does the job.
(defsetf for point): Point's inverse is goto-char. Of course,
what do we do with the other basic types of Emacs Lisp?
- (member): Another, perhaps counterproductive, speed hack. When
- test or testnot are symbols (hopefully, non-null), they are
+ (member): Another, perhaps counterproductive, speed hack.
+ When test or testnot are symbols (hopefully, non-null), they are
replaced by their symbol-function slots. This presumably reduces
one indirection per each funcall in the inner loop.
(byte-compile-named-list-accessors): Another byte-compile
@@ -9177,7 +9172,7 @@
(with-keyword-args): Macro that simplifies most of the handling of
klists. The only neglected functionality is that no supplied-p
forms exist (although that is true also of lambda lists in Emacs Lisp).
- (cl-eval-print-last-sexp): Added half-hearted support for -, +,
+ (cl-eval-print-last-sexp): Add half-hearted support for -, +,
++, +++, *, **, ***, /, //, ///; and cleared the mvalues mechanism
at every call.
(declare, proclaim, the): Make some more CL codes easy to load.
@@ -9188,7 +9183,7 @@
(byte-compile-ca*d*r): New function, used as a handler from
byte-compile-form to eliminate the extra call to the c*r functions
in compiled code.
- (adjoin, map): Changed to use `memq' instead of `member', too.
+ (adjoin, map): Change to use `memq' instead of `member', too.
(case, ecase): Via a change in case-clausify, these macros now
generate tests using the primitive `memq', instead of the heavier
`member'.
@@ -9208,8 +9203,8 @@
functions.
(build-klist): Better error messages.
(psetf): Rewrote, patterned after the new psetq.
- (psetq): Added early check for even number of arguments. This
- causes a better error message than previously.
+ (psetq): Add early check for even number of arguments.
+ This causes a better error message than previously.
(defstruct, parse$defstruct$options): asp@CS.CMU.EDU (James
Aspnes) reported that defstruct wasn't handling properly the use
of accessors of an :included definition applied to instances of
@@ -9257,8 +9252,8 @@
*Completions* not *Help*.
* help.el (describe-mode): Use Dale Worley's version to also show
- minor mode documentation if argument is given. Fset
- defining-keyboard-macro to start-keyboard-macro so its
+ minor mode documentation if argument is given.
+ Fset defining-keyboard-macro to start-keyboard-macro so its
documentation can be found. Currently does not work with
auto-fill-mode because of the hook nature of its minor mode
indicator variable.
@@ -9362,7 +9357,7 @@
1990-07-26 David Lawrence (tale@pogo.ai.mit.edu)
* c-mode.el (c-auto-newline): Doc addition.
- (electric-c-terminator): Removed bogus set-marker.
+ (electric-c-terminator): Remove bogus set-marker.
(electric-c-sharp-sign): Make sure c-auto-newline is nil for call
to electric-c-terminator.
@@ -9469,7 +9464,7 @@
* compile.el (grep): Use `grep-command' to also hold args for
grep, like compile-command.
- * simple.el (kill-ring-save): Fixed to not reference free
+ * simple.el (kill-ring-save): Fix to not reference free
variable `verbose' but to just unconditionally echo message.
(shell-command): Use new `last-shell-command' interactively.
(shell-command-on-region): Use new `last-shell-command-on-region'
@@ -9483,7 +9478,7 @@
1990-06-23 Randall Smith (randy@substantia-nigra)
- * dired.el (dired-flag-regexp-files): Added function to flag all
+ * dired.el (dired-flag-regexp-files): Add function to flag all
files matching a REGEXP for deletion.
(): Bound this function to key "F" in dired-mode ("D" was already
taken).
@@ -9511,8 +9506,8 @@
* isearch.el (isearch): Do exit on meta keys.
Also exit on function keys and mouse clicks.
* loaddefs.el (search-exit-char): Change back to escape.
- (search-ring-advance-char): Moved from isearch.el.
- (search-ring-retreat-char): Renamed from ...-recline-char and moved.
+ (search-ring-advance-char): Move from isearch.el.
+ (search-ring-retreat-char): Rename from ...-recline-char and moved.
* float.el: Provide 'float.
@@ -9566,7 +9561,7 @@
updated all existing menus (very time consuming).
(texinfo-all-menus-update, texinfo-every-node-update):
- Added a save-excursion to each so that point does not move when
+ Add a save-excursion to each so that point does not move when
you update the menus or nodes.
* texinfmt.el (texinfo-format-parse-args): Expand arguments so
@@ -9577,16 +9572,16 @@
* backquote.el (bq-splicequote): Correctly splice in elements
when followed by constant elements; don't list the constant elements.
- * add-log.el (add-change-log-entry): Fixed match test for full name.
+ * add-log.el (add-change-log-entry): Fix match test for full name.
- * lpr.el (print-buffer): Removed an extra trailing parenthesis.
+ * lpr.el (print-buffer): Remove an extra trailing parenthesis.
1990-05-30 David Lawrence (tale@geech)
* comint.el (comint-load-hook): Superseded by eval-after-load.
- * inf-lisp.el (lisp-eval-region, lisp-compile-region): Use
- temporary files instead of send-string to avoid problems with pty
+ * inf-lisp.el (lisp-eval-region, lisp-compile-region):
+ Use temporary files instead of send-string to avoid problems with pty
buffering.
* tex-mode.el (tex-close-latex-block): Allow whitespace after
@@ -9634,7 +9629,7 @@
* informat.el (Info-tagify): Give status messages before and
after tagifying.
- (batch-info-validate): Removed status messages around Info-tagify.
+ (batch-info-validate): Remove status messages around Info-tagify.
* rmailout.el (rmail-output): Check for From:, Really-From: and
Sender: fields, in that order, and run mail-strip-quoted-names on
@@ -9642,13 +9637,13 @@
1990-05-21 Richard Stallman (rms@mole.ai.mit.edu)
- * buff-menu.el (Buffer-menu-buffer): Simplified.
+ * buff-menu.el (Buffer-menu-buffer): Simplify.
Set Buffer-menu-buffer-column initially.
1990-05-18 Robert J. Chassell (bob@apple-gunkies)
* page-ext.el (pages-addresses-file-name):
- Renamed from addresses-file-name.
+ Rename from addresses-file-name.
1990-05-17 Robert J. Chassell (bob@apple-gunkies)
@@ -9995,12 +9990,12 @@
* screen.el (iconify-function, iconify-emacs, deiconify-function):
New functions.
- * files.el (save-some-buffers): Removed last parameter skip-list.
+ * files.el (save-some-buffers): Remove last parameter skip-list.
Now this checks for buffer-local variable save-buffers-skip to
determine whether or not to avoid asking to save the buffer.
- * rmail.el (rmail-mode): Removed skip-list stuff.
+ * rmail.el (rmail-mode): Remove skip-list stuff.
(rmail-variables): make-local-variable save-buffers-skip.
- * compile.el (compile): Removed additional parameter to save-buffers.
+ * compile.el (compile): Remove additional parameter to save-buffers.
1990-02-26 David Lawrence (tale@pogo.ai.mit.edu)
@@ -10009,21 +10004,21 @@
display-time-string.
(rmail-pop-up): Default display-time-hook to automatically retrieve
new mail if the variable rmail-pop-up is non-nil.
- (add-clock-handler): Removed; superseded by timer.el.
+ (add-clock-handler): Remove; superseded by timer.el.
* loaddefs.el: Removed add-clock-handler.
1990-02-25 David Lawrence (tale@pogo.ai.mit.edu)
* c++-mode.el: New file.
- (point-bol): Removed this function.
+ (point-bol): Remove this function.
* loaddefs.el: Autoload C++-mode.
(auto-mode-alist): c++-mode for .C and .cc files.
1990-02-25 Joseph Arceneaux (jla@gnu.ai.mit.edu)
- * lisp-mode.el (indent-sexp): Changed opoint to last-point.
+ * lisp-mode.el (indent-sexp): Change opoint to last-point.
Very strange, I thought I'd already fixed this.
* screen.el: New file.
@@ -10053,11 +10048,11 @@
* files.el (file-newest-backup): Return either the name of an
existing backup file or nil if none exists.
- * server.el (server-program): Renamed from "server" to "emacsserver".
+ * server.el (server-program): Rename from "server" to "emacsserver".
1990-02-20 Joseph Arceneaux (jla@gnu.ai.mit.edu)
- * fill.el (fill-region-as-paragraph): Fixed regexp typo in call to
+ * fill.el (fill-region-as-paragraph): Fix regexp typo in call to
re-search-forward.
1990-02-19 David Lawrence (tale@pogo.ai.mit.edu)
@@ -10108,16 +10103,16 @@
1990-02-07 David Lawrence (tale@galapas)
- * inf-lisp.el: inferior-lisp-program can be a list of the programme
+ * inf-lisp.el: inferior-lisp-program can be a list of the program
name and its arguments.
1990-02-06 Ed Reingold (reingold@emr.cs.uiuc.edu)
* calendar.el (french-calendar-leap-year-p):
Rewritten with corrected rule.
- (calendar-absolute-from-french): Fixed comments.
+ (calendar-absolute-from-french): Fix comments.
(calendar-french-from-absolute): Rewrote using calendar-sum.
- (cursor-to-french-calendar-date): Simplified and corrected spelling.
+ (cursor-to-french-calendar-date): Simplify and corrected spelling.
1990-02-06 Richard Stallman (rms@mole.ai.mit.edu)
@@ -10156,9 +10151,9 @@
1990-01-27 Ed Reingold (reingold@emr.cs.uiuc.edu)
- * calendar.el (scroll-calendar-left): Fixed so it works when the cursor
+ * calendar.el (scroll-calendar-left): Fix so it works when the cursor
is not positioned on a day.
- (cursor-to-calendar-day-of-year): Fixed so that "day" is properly
+ (cursor-to-calendar-day-of-year): Fix so that "day" is properly
pluralized, depending how many days remain in the year.
(french-calendar-leap-year-p): New function.
(french-calendar-last-day-of-month): New function.
@@ -10227,14 +10222,14 @@
1990-01-11 Ed Reingold (reingold@emr.cs.uiuc.edu)
- * diary.el (list-diary-entries): Deleted several lines of extraneous
+ * diary.el (list-diary-entries): Delete several lines of extraneous
code and added `nongregorian-diary-listing-hook' to the list of hooks
called@the end; this is for use in including Hebrew, Islamic,
Julian, or ISO diary entries. A similar
`nongregorian-diary-marking-hook' was added to the list of hooks
called at the end of mark-diary-entries for the same reason.
- (diary-name-pattern): Fixed the documentation and added an optional
+ (diary-name-pattern): Fix the documentation and added an optional
parameter FULLNAME which insists on the full spelling of the name;
this is also for use in marking Hebrew or Islamic diary entries
(those month names are not unique in the first three characters).
@@ -10246,8 +10241,8 @@
(list-islamic-diary-entries): New function.
(mark-islamic-calendar-date-pattern): New function.
- (list-diary-entries): Added nongregorian-diary-listing-hook.
- (mark-diary-entries): Added nongregorian-diary-marking-hook.
+ (list-diary-entries): Add nongregorian-diary-listing-hook.
+ (mark-diary-entries): Add nongregorian-diary-marking-hook.
* calendar.el: Added documentation for the hooks described above.
@@ -10261,7 +10256,7 @@
1990-01-08 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu)
* texnfo-upd.el (texinfo-update-node, texinfo-sequential-node-update):
- Fixed auto-fill-hook bug.
+ Fix auto-fill-hook bug.
1990-01-08 Joseph Arceneaux (jla@spiff)
@@ -10270,7 +10265,7 @@
1990-01-08 Ed Reingold (reingold@emr.cs.uiuc.edu)
* calendar.el (calendar-date-is-visible-p):
- Fixed so it does not switch to the calendar buffer.
+ Fix so it does not switch to the calendar buffer.
* diary.el (prepare-fancy-diary-buffer): Compute the list of
holidays only once for each three-month period, not once for each date
@@ -10280,12 +10275,12 @@
1990-01-07 Ed Reingold (reingold@emr.cs.uiuc.edu)
* calendar.el: Fixed the value of list-diary-entries-hook.
- (regenerate-calendar-window): Changed (update-display) to (sit-for 0).
+ (regenerate-calendar-window): Change (update-display) to (sit-for 0).
Corrected several instances of "dairy" to "diary".
- (describe-calendar-mode): Added this function to issue the message
+ (describe-calendar-mode): Add this function to issue the message
"Preparing..." to `?' key in calendar-mode because it's so incredibly
slow for describe-mode to prepare the help buffer.
- (calendar-holidays): Fixed the examples in the doc-string.
+ (calendar-holidays): Fix the examples in the doc-string.
* diary.el: Corrected several instances of "dairy" to "diary".
@@ -10328,7 +10323,7 @@
(calendar-iso-from-absolute): New function.
(calendar-absolute-from-iso): New function.
- (cursor-to-iso-calendar-date): Added `D' calendar command to give
+ (cursor-to-iso-calendar-date): Add `D' calendar command to give
the day number in the Gregorian year and number of days remaining.
(mark-diary-entries): Made two-digit abbreviated years acceptable
in diary entries. Changed possible diary entry styles: DAY
@@ -10343,11 +10338,11 @@
(all functions containing the word `hebrew').
(list-diary-entries, mark-diary-entries)
(include-other-diary-files, mark-included-diary-files):
- Added the possibility of `shared diary files' with a recursive
+ Add the possibility of `shared diary files' with a recursive
include mechanism like the C preprocessor.
(list-calendar-holidays): Eliminated the 'special class of holidays,
rewriting the entire mechanism to make it more general.
- (calendar-holiday-function-float): Changed the 'float class of
+ (calendar-holiday-function-float): Change the 'float class of
holidays so that negative values count backward from end of month: 5
is no longer used for the last occurrence of a day in a month; -1 is
used instead.
@@ -10413,8 +10408,8 @@
1989-12-11 David Lawrence (tale@cocoa-puffs)
- * telnet.el: Converted to use comint. Removed
- delete-char-or-send-eof and telnet-copy-last-input. Added
+ * telnet.el: Converted to use comint.
+ Removed delete-char-or-send-eof and telnet-copy-last-input. Added
telnet-mode-hook. Modified telnet-filter to insert-before-markers
at the process-mark.
@@ -10423,8 +10418,8 @@
* prolog.el: Converted to use comint. Replaced copy-keymap for
copy-alist of comint-mode-map.
- * kermit.el: Converted to use comint. Replaced
- kermit-clean-filter with a more efficient version.
+ * kermit.el: Converted to use comint.
+ Replaced kermit-clean-filter with a more efficient version.
* comint.el: Added optional arguments ``terminator'' and
``delete'' to comint-send-input, for processes that want to see
@@ -10454,11 +10449,11 @@
1989-12-05 David Lawrence (tale@wheat-chex)
* comint.el (new file):
- Added FSF copyright.
+ Add FSF copyright.
Moved bindings off of C-c LETTER.
Cleaned up references to cmu* files.
Made comint-send-input do unconditional end-of-line before processing.
- cominit-exec will signal an error if no programme name.
+ cominit-exec will signal an error if no program name.
Removed full-copy-sparse-keymap and comint-log-user.
1989-12-04 Joseph Arceneaux (jla@spiff)
@@ -10599,7 +10594,7 @@
* x-mouse.el (x-paste-text): push-mark before inserting text.
(x-insert-selection, x-select):
- Moved these functions over from mouse.el.
+ Move these functions over from mouse.el.
1989-10-12 Richard Stallman (rms@mole.ai.mit.edu)
@@ -10773,7 +10768,7 @@
1989-09-11 Robert J. Chassell (bob@apple-gunkies.ai.mit.edu)
* texinfo.el (texinfo-update-node, texinfo-make-menu)
- (texinfo-master-menu, texinfo-sequential-node-update): Added functions
+ (texinfo-master-menu, texinfo-sequential-node-update): Add functions
to insert or update the next, previous, and up node pointers in a
Texinfo file, or alternatively to insert node pointers as a depth-first
traversal---sequentially through the file, each pointing to the next
@@ -10958,7 +10953,7 @@
1989-07-12 Joseph Arceneaux (jla@spiff)
- * lisp.el (insert-parentheses): Changed conditions for pre- and
+ * lisp.el (insert-parentheses): Change conditions for pre- and
post- insertion of blanks.
* bytecomp.el (byte-compile-file): If current buffer is in
@@ -11004,7 +10999,7 @@
1989-06-23 Joseph Arceneaux (jla@all-bran.ai.mit.edu)
* term/x-win.el (x-pop-up-window): Run hook x-pop-up-window-hook.
- (x-color-screen-p): New macro; used to be C function.
+ (x-color-screen-p): New macro; used to be C function in xfns.c.
1989-06-22 Richard Stallman (rms@mole.ai.mit.edu)
@@ -11077,7 +11072,7 @@
1989-06-08 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu)
- * term/x-win.el (new-screen): Added this function, which is the default
+ * term/x-win.el (new-screen): Add this function, which is the default
auto-screen function. It uses new variables new-screen-x-delta
and new-screen-y-delta.
(next-multiscreen-window, previous-multiscreen-window):
@@ -11205,7 +11200,7 @@
1989-05-15 Joseph Arceneaux (jla@apple-gunkies.ai.mit.edu)
- * tags.el (next-file): Fixed typo: " *next-file*" --> "*next-file*"
+ * tags.el (next-file): Fix typo: " *next-file*" --> "*next-file*"
1989-05-14 Richard Stallman (rms@mole.ai.mit.edu)
@@ -11285,7 +11280,7 @@
confusing and incompatible with xterm.
* mouse.el (mouse-scroll, mouse-del-char, mouse-kill-line)
- (narrow-window-to-region, mouse-window-to-region): Added these
+ (narrow-window-to-region, mouse-window-to-region): Add these
new functions.
1989-05-08 Richard Stallman (rms@mole.ai.mit.edu)
@@ -11444,7 +11439,7 @@
* replace.el (occur-mode-goto-occurrence): Insure arg to
count-lines is@start of line.
- * replace.el (occur): Removed an extraneous save-excursion.
+ * replace.el (occur): Remove an extraneous save-excursion.
* replace.el (perform-replace): Make ! undo as a unit.
@@ -11535,7 +11530,7 @@
(view-exit): Restore old mode from those local variables.
Apply specified fn to buffer that was viewed.
This is on C-c and q.
- (view-command-loop): Deleted.
+ (view-command-loop): Delete.
(view-window-size): Now applies to selected window.
* startup.el (normal-top-level): Use PWD envvar to set default dir.
@@ -11656,8 +11651,8 @@
(bibtex-enclosing-reference, bibtex-enclosing-regexp, bibtex-flash-entr)
(bibtex-flash-head, bibtex-inside-field, bibtex-make-optional-entry)
(bibtex-remove-OPT): New functions.
- (bibtex-find-it, bibtex-make-OPT-entry, bibtex-next-position): Deleted.
- (kill-current-line): Deleted.
+ (bibtex-find-it, bibtex-make-OPT-entry, bibtex-next-position): Delete.
+ (kill-current-line): Delete.
(bibtex-mode-map): C-c keys to make entries moved to C-c C-e.
(general): Use regexps instead of simple-minded cursor motion.
New keys include C-c C-p, C-c C-n, C-c C-k, C-c C-d, C-c C-c, TAB, LF.
@@ -12405,7 +12400,7 @@
* compile.el (grep): Use grep-command for program.
* loaddefs.el (grep-command): New variable.
- (compile-command): Moved to compile.el.
+ (compile-command): Move to compile.el.
* c-mode.el (electric-c-terminator): Make insertpos a marker.
@@ -12438,7 +12433,7 @@ See ChangeLog.2 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1989, 1993, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index d6e626b6b4a..a02a2cc9a01 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -2871,7 +2871,7 @@
1994-02-18 Paul Eggert (eggert@twinsun.com)
- * (vc-lookup-triple): Yield nil, not "", if version name is nil.
+ * vc.el (vc-lookup-triple): Yield nil, not "", if version name is nil.
1994-02-17 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -2954,10 +2954,6 @@
1994-02-11 Paul Eggert (eggert@twinsun.com)
- * editfns.c (init_editfns): Look at LOGNAME before USER.
- * fileio.c (Fsubstitute_in_file_name): Remove long-dead code
- that looked at USER before LOGNAME.
-
* time.el (display-time-filter): Remove unnecessary (getenv "LOGNAME")
and (getenv "USER"), since (user-login-name) already does this.
* gnuspost.el (gnus-inews-login-name): Likewise.
@@ -6780,7 +6776,7 @@
1993-07-29 Paul Eggert (eggert@twinsun.com)
- * (vc-mode-line): Set vc-mode to nil if FILE no longer is
+ * vc-hooks.el (vc-mode-line): Set vc-mode to nil if FILE no longer is
version-controlled.
1993-07-29 Richard Stallman (rms@mole.gnu.ai.mit.edu)
@@ -8273,7 +8269,7 @@
1993-06-15 Shane Hartman (shane@nugget.spr.com)
- * gud.el (xdb): New debugger supported (xdb under HPUX-PARISC).
+ * gud.el (xdb): New debugger supported (xdb under HPUX-PA-RISC).
(gud-xdb-debugger-startup): New function.
(gud-xdb-file-name, gud-xdb-accumulation): New functions.
(gud-xdb-marker-filter, gud-xdb-paths, gud-xdb-find-file): New.
@@ -8938,7 +8934,7 @@ See ChangeLog.3 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5
index 91c92677662..6103eaff416 100644
--- a/lisp/ChangeLog.5
+++ b/lisp/ChangeLog.5
@@ -1930,6 +1930,10 @@
1995-04-09 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+ * tpu-doc.el: File moved to ../etc/tpu-edt.doc.
+
+1995-04-09 Richard Stallman <rms@mole.gnu.ai.mit.edu>
+
* files.el (write-file): Default is ask for confirmation
only interactively.
@@ -3459,7 +3463,7 @@
1995-02-04 G Dinesh Dutt (brat@htilbom.ernet.in)
- * etags.el : Changes to support filenames as tags too and provided
+ * etags.el: Changes to support filenames as tags too and provided
a drop-in replacement for list-tags.
(find-tag-noselect): Recognize filenames as valid tags too.
(find-tag-file-order): New variable holds function to check for match
@@ -3667,7 +3671,7 @@
1994-01-24 G Dinesh Dutt (brat@htilbom.ernet.in)
- * etags.el : Changes to support filenames as tags too and provided
+ * etags.el: Changes to support filenames as tags too and provided
a drop-in replacement for list-tags.
(find-tag-noselect): Recognize filenames as valid tags too.
(find-tag-file-order): New variable added. This contains the name of
@@ -4275,7 +4279,7 @@
(forms--mode-menu-ro, forms--mode-menu-edit):
New functions to create a pulldown menu in the menubar.
(forms--mode-commands): Call them for the edit and view mode.
- * (forms-print): New function.
+ (forms-print): New function.
1995-01-04 Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -8257,7 +8261,7 @@
* rmail.el (rmail-mode-map): Add "Get New Mail" menu item under Mail.
* compile.el (compilation-next-error-locus): Don't call
- compilation-forget-errors if compilation is still runing.
+ compilation-forget-errors if compilation is still running.
1994-07-11 Erik Naggum (erik@naggum.no)
@@ -9264,7 +9268,7 @@ See ChangeLog.4 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 023d5091a15..c140cb56e73 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -3471,7 +3471,7 @@
1996-01-14 Erik Naggum <erik@naggum.no>
- * all files: Update FSF's address in, and unify formatting of,
+ * All files: Update FSF's address in, and unify formatting of,
comment preambles.
1996-01-13 Erik Naggum <erik@naggum.no>
@@ -3687,7 +3687,7 @@
When changing the environment, avoid need for setenv.
1996-01-05 Karl Eichwalder <ke@ke.Central.DE>
- Karl Fogel <kfogel@floss.red-bean.com>
+ Karl Fogel <kfogel@floss.red-bean.com>
* bookmark.el: "cyclic.com" addresses changed to "red-bean.com".
(bookmark-bmenu-mode-map): Don't bind C-k.
@@ -8021,7 +8021,7 @@ See ChangeLog.5 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index f52fdd7e194..816f6142cf2 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -13,10 +13,10 @@
* speedbar.el (speedbar-timer-fn): Disable updating if the frame
is an icon, or if the user is using the minibuffer.
- (speedbar-key-map): Added Q binding to destroy the frame.
- (speedbar-easymenu-definition-trailer): Added Quit item.
+ (speedbar-key-map): Add Q binding to destroy the frame.
+ (speedbar-easymenu-definition-trailer): Add Quit item.
(speedbar-frame-mode): Set the frame position at creation time.
- (speedbar-file-unshown-regexp): Added .# lock files.
+ (speedbar-file-unshown-regexp): Add .# lock files.
1998-08-18 Kenichi Handa <handa@etl.go.jp>
@@ -56,8 +56,8 @@
1998-08-17 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (set-language-environment): Reset
- syntax and case table to the defaults if the value of
+ * international/mule-cmds.el (set-language-environment):
+ Reset syntax and case table to the defaults if the value of
unibyte-syntax key is nil.
1998-08-16 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -86,8 +86,8 @@
* international/mule-cmds.el (language-info-alist): Doc-string
modified.
- (set-language-info-alist): Fix typo in doc-string. Update
- setup-language-environment-map unconditionally.
+ (set-language-info-alist): Fix typo in doc-string.
+ Update setup-language-environment-map unconditionally.
(mule-keymap): Key bindings for set-selection-coding-system and
set-next-selection-coding-system.
(set-coding-system-map): Add items of set-selection-coding-system
@@ -110,13 +110,13 @@
1998-08-14 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
- * international/mule-cmds.el (select-safe-coding-system): If
- default-coding-system is no-conversion return that, it is always
+ * international/mule-cmds.el (select-safe-coding-system):
+ If default-coding-system is no-conversion return that, it is always
safe.
1998-08-13 Eric Ludlam <zappo@mescaline.gnu.org>
- * speedbar.el (speedbar-frame-parameters): Removed scroll-bar-width.
+ * speedbar.el (speedbar-frame-parameters): Remove scroll-bar-width.
1998-08-13 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -124,9 +124,9 @@
* dired-aux.el (dired-do-rename-regexp): Doc fix.
- * midnight.el (midnight-float-time): Renamed from float-time.
- (midnight-time-float): Renamed from time-float.
- (midnight-buffer-display-time): Renamed from buffer-display-time.
+ * midnight.el (midnight-float-time): Rename from float-time.
+ (midnight-time-float): Rename from time-float.
+ (midnight-buffer-display-time): Rename from buffer-display-time.
(midnight-mode): Specify :initialize. Use nil as default value.
* complete.el (PC-do-completion): Exclude ./ and ../ from completion.
@@ -201,14 +201,14 @@
(read-language-name): Handle the case that the arg KEY is nil.
(describe-language-environment): Handle input-method property.
- * international/quail.el (quail-start-translation): If
- enable-multibyte-characters is nil, convert multibyte character to
+ * international/quail.el (quail-start-translation):
+ If enable-multibyte-characters is nil, convert multibyte character to
unibyte.
(quail-start-conversion): Likewise.
* language/: All files under this directory modified as below.
- (setup-XXX-environment): Just call set-language-environment. If
- they used to do some other jobs than what done by
+ (setup-XXX-environment): Just call set-language-environment.
+ If they used to do some other jobs than what done by
set-language-environment, those jobs are done in
setup-XXX-environment-internal now.
("LANGUAGE-ENVIRONMENT"): Delete property setup-function or change
@@ -278,7 +278,7 @@
1998-08-08 Eric M. Ludlam <zappo@ultranet.com>
* speedbar.el (speedbar-edit-line, speedbar-buffer-kill-buffer)
- (speedbar-buffer-revert-buffer): Updated buffer finding regex to
+ (speedbar-buffer-revert-buffer): Update buffer finding regex to
handle the [?] tag.
(speedbar-find-selected-file): New function.
(speedbar-clear-current-file): Uses `speedbar-find-selected-file'.
@@ -364,18 +364,18 @@
(quail-start-translation): Handle the case the arg KEY is nil.
Bind echo-keystrokes and help-char. Initialize quail-current-str
to "". If input-method-use-echo-area is non-nil, call
- read-key-sequence with appropriate PROMPT arg. Setup
- last-command-event by local variable `keyseq'. Generate an event
+ read-key-sequence with appropriate PROMPT arg.
+ Setup last-command-event by local variable `keyseq'. Generate an event
list form quail-current-str. If input-method-exit-on-first-char
is non-nil, return only the first event.
- (quail-start-conversion): Likewise. Initialize
- quail-conversion-str to "". Generate an event list form
+ (quail-start-conversion): Likewise.
+ Initialize quail-conversion-str to "". Generate an event list form
quail-conversion-str.
(quail-update-translation): Expect that the function given by
(quail-update-translation-function) returns a new control-flag.
- Handle the case the length of quail-current-key is 1. Use
- string-as-unibyte if enable-multibyte-characters is nil. Always
- assures that quail-current-str is Lisp string.
+ Handle the case the length of quail-current-key is 1.
+ Use string-as-unibyte if enable-multibyte-characters is nil.
+ Always assures that quail-current-str is Lisp string.
(quail-self-insert-command): Use `or' instead of `unless'.
(quail-update-current-translations): Always assures that
quail-current-str is Lisp string.
@@ -417,7 +417,7 @@
1998-08-05 Sam Steingold <sds@goems.com>
- * cl-indent.el (top-level let): Add defsubst.
+ * emacs-lisp/cl-indent.el (top-level let): Add defsubst.
1998-08-04 Andrew Innes <andrewi@harlequin.co.uk>
@@ -429,14 +429,14 @@
1998-08-04 Eric Ludlam <zappo@mescaline.gnu.org>
- * speedbar.el (speedbar-refresh): Removed special code to remove
+ * speedbar.el (speedbar-refresh): Remove special code to remove
the speedbar update message. Not necessary here.
(speedbar-timer-fn): Add code to remove the updating message and
thus restore the minibuffer.
- (speedbar-center-buffer-smartly): Fixed center error to handle
+ (speedbar-center-buffer-smartly): Fix center error to handle
the whole buffer.
(speedbar-delete-subblock): Rewrote to be more robust, less clever.
- (speedbar-timer-fn): Removed short display time for messages.
+ (speedbar-timer-fn): Remove short display time for messages.
1998-08-04 Dave Love <d.love@dl.ac.uk>
@@ -445,8 +445,8 @@
1998-08-04 Eli Zaretskii <eliz@delysid.gnu.org>
- * international/mule.el (find-new-buffer-file-coding-system): When
- inhibit-eol-conversion is non-nil and the buffer didn't already
+ * international/mule.el (find-new-buffer-file-coding-system):
+ When inhibit-eol-conversion is non-nil and the buffer didn't already
set a fully-qualified coding system, force -unix eol-type.
1998-08-04 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -469,15 +469,15 @@
1998-08-03 Eric Ludlam <zappo@mescaline.gnu.org>
- * info.el (Info-speedbar-hierarchy-buttons): Improved the speedbar
+ * info.el (Info-speedbar-hierarchy-buttons): Improve the speedbar
frame management.
- * speedbar.el (speedbar-update-current-file): Added call to
+ * speedbar.el (speedbar-update-current-file): Add call to
`speedbar-center-buffer-smartly' to improve the display.
(speedbar-center-buffer-smartly) Fixed off-by-one error in window
height calculation.
(speedbar-hack-buffer-menu): New function.
- (speedbar-frame-parameters): Removed scroll bar width.
+ (speedbar-frame-parameters): Remove scroll bar width.
(speedbar-frame-mode): Change pointer shape for X
and W32 window-systems only. When window-system is pc, bind the
speedbar frame name to "Speedbar", and select that frame so it is
@@ -488,8 +488,8 @@
(speedbar-directory-buttons-follow): Support both upper- and
lower-case drive letters. Use directory-sep-char instead of a
literal backslash.
- (speedbar-reconfigure-keymaps): Call
- `easy-menu-remove' before reconfiguring for a new menu bar.
+ (speedbar-reconfigure-keymaps):
+ Call `easy-menu-remove' before reconfiguring for a new menu bar.
(speedbar-previous-menu): New Variable.
(speedbar-frame-plist): Remove pointers.
(speedbar-refresh): Prevent the mark from being deactivated.
@@ -505,8 +505,8 @@
* international/kkc.el (kkc-lookup-cache): Initialize it to nil.
(kkc-lookup-cache-tag): New constant.
- (kkc-lookup-key): If kkc-lookup-cache is nil, initialize it. Use
- kkc-init-file-name.
+ (kkc-lookup-key): If kkc-lookup-cache is nil, initialize it.
+ Use kkc-init-file-name.
(kkc-region): Fix previous change. Call kkc-error on error.
(kkc-shorter-conversion, kkc-longer-phrase): New functions.
(kkc-keymap): Bind them to "I" and "O" respectively.
@@ -547,8 +547,8 @@
* language/cyril-util.el (cyrillic-encode-koi8-r-char): New function.
(cyrillic-encode-alternativnyj-char): New function.
- * language/cyrillic.el (cyrillic-koi8-r-decode-table): New
- variable.
+ * language/cyrillic.el (cyrillic-koi8-r-decode-table):
+ New variable.
(cyrillic-koi8-r-encode-table): Likewise.
(ccl-decode-koi8): Use cyrillic-koi8-r-decode-table.
(ccl-encode-koi8): Use cyrillic-koi8-r-encode-table.
@@ -558,10 +558,10 @@
charset-origin-alist properties.
(cyrillic-alternativnyj-decode-table): New variable.
(cyrillic-alternativnyj-encode-table): Likewise.
- (ccl-decode-alternativnyj): Use
- cyrillic-alternativnyj-decode-table.
- (ccl-encode-alternativnyj): Use
- cyrillic-alternativnyj-encode-table.
+ (ccl-decode-alternativnyj):
+ Use cyrillic-alternativnyj-decode-table.
+ (ccl-encode-alternativnyj):
+ Use cyrillic-alternativnyj-encode-table.
(ccl-encode-alternativnyj-font): Likewise.
(cyrillic-alternativnyj-nonascii-translation-table): New variable.
("Cyrillic-ALT"): Add nonascii-translation-table and
@@ -615,8 +615,8 @@
* emacs-lisp/cl-indent.el (lisp-indent-defun-method): New variable.
(common-lisp-indent-function): Use it.
(lisp-indent-259): Uncomment the `&lambda' code.
- (top-level let): Remove duplicate `catch' and `block'. Use
- `&lambda' when appropriate. Now the lambda lists are indented
+ (top-level let): Remove duplicate `catch' and `block'.
+ Use `&lambda' when appropriate. Now the lambda lists are indented
appropriately.
1998-07-30 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -697,7 +697,7 @@
1998-07-27 Richard Stallman <rms@psilocin.ai.mit.edu>
* textmodes/flyspell.el (flyspell-emacs-popup):
- Renamed from flyspell-gnuemacs-popup. Callers changed.
+ Rename from flyspell-gnuemacs-popup. Callers changed.
(push): Macro deleted. Callers changed to do it explicitly.
(flyspell-incorrect-face, flyspell-duplicate-face): Use defface.
(flyspell-incorrect-color): Variable deleted.
@@ -705,7 +705,7 @@
(flyspell-underline-p): Variable deleted.
(flyspell-font-lock-make-face): Function deleted.
(flyspell-mark-duplications-flag):
- Renamed from flyspell-doublon-as-error-flag.
+ Rename from flyspell-doublon-as-error-flag.
(flyspell-mode-on): Delete the debugging message.
(flyspell-mode-off): Delete the debugging message.
(flyspell-mode-on): Set flyspell-generic-check-word-p
@@ -796,16 +796,16 @@
1998-07-25 Kenichi Handa <handa@etl.go.jp>
* international/mule.el (auto-coding-alist): New variable.
- (set-auto-coding): Argument FILENAME is added. Check
- auto-coding-alist at first.
+ (set-auto-coding): Argument FILENAME is added.
+ Check auto-coding-alist at first.
* international/kkc.el (kkc-region): Unwind-protect the conversion
process.
(kkc-show-conversion-list-update): Pay attention to the length of
kkc-show-conversion-list-index-chars.
- * international/mule-cmds.el (find-multibyte-characters): New
- function.
+ * international/mule-cmds.el (find-multibyte-characters):
+ New function.
(select-safe-coding-system): Highlight characters which can't be
encoded. Show list of such characters also in *Warning* buffer.
@@ -822,10 +822,10 @@
(crisp-last-last-command): Doc fix.
(mark-something): Function deleted.
(crisp-mark-line): Avoid using mark-something.
- (crisp-region-active): Renamed from region-active.
- (crisp-set-clipboard): Renamed from copy-primary-selection.
- (crisp-kill-region): Renamed from kill-primary-selection.
- (crisp-yank-clipboard): Renamed from yank-clipboard-selection.
+ (crisp-region-active): Rename from region-active.
+ (crisp-set-clipboard): Rename from copy-primary-selection.
+ (crisp-kill-region): Rename from kill-primary-selection.
+ (crisp-yank-clipboard): Rename from yank-clipboard-selection.
* files.el (basic-save-buffer-2): New function.
(basic-save-buffer-1): Use basic-save-buffer-2,
@@ -850,8 +850,8 @@
1998-07-23 Ken'ichi Handa <handa@melange.gnu.org>
- * international/quail.el (quail-start-translation): Call
- this-single-command-raw-keys instead of this-single-command-keys.
+ * international/quail.el (quail-start-translation):
+ Call this-single-command-raw-keys instead of this-single-command-keys.
(quail-start-conversion): Likewise.
1998-07-23 Kenichi Handa <handa@etl.go.jp>
@@ -862,8 +862,8 @@
not isearch-printing-char, don't read multibyte chars from
minibuffer, but just call isearch-process-search-char.
- * international/quail.el (quail-start-translation): Use
- this-single-command-keys to get raw events instead of
+ * international/quail.el (quail-start-translation):
+ Use this-single-command-keys to get raw events instead of
listify-key-sequence.
(quail-start-conversion): Likewise.
@@ -878,7 +878,7 @@
(imenu-extract-index-name-function, imenu-default-goto-function)
(imenu-sort-function, imenu-prev-index-position-function): Likewise.
- * ange-ftp.el (ange-ftp-reread-dir): Renamed from `re-read'.
+ * ange-ftp.el (ange-ftp-reread-dir): Rename from `re-read'.
Old name defined as alias. Doc fix.
1998-07-21 Kenichi Handa <handa@etl.go.jp>
@@ -888,8 +888,8 @@
(kkc-terminate): Update kkc-overlay-head correctly.
(kkc-cancel): Don't call kkc-terminate, but set kkc-converting to nil.
- * international/quail.el (quail-simple-translation-keymap): Typo
- in doc-string fixed.
+ * international/quail.el (quail-simple-translation-keymap):
+ Typo in doc-string fixed.
(quail-start-translation): Check start position of quail-overlay
before calling quail-overlay-region-events.
(quail-start-conversion): Likewise.
@@ -915,8 +915,8 @@
* isearch.el (isearch-input-method-function): New variable.
(isearch-input-method-local-p): New variable.
- (isearch-mode): Setup the above two variable. Set
- input-method-function to nil locally.
+ (isearch-mode): Setup the above two variable.
+ Set input-method-function to nil locally.
(isearch-done): Restore the previous value of
input-method-function.
@@ -939,7 +939,7 @@
* international/kkc.el (kkc-region): Fix the return value.
* international/isearch-x.el
- (isearch-toggle-specified-input-method): Adjusted for the change
+ (isearch-toggle-specified-input-method): Adjust for the change
in isearch.el.
(isearch-toggle-input-method): Likewise.
(isearch-minibuffer-local-map): New variable.
@@ -949,8 +949,8 @@
characters from minibuffer with the keymap
isearch-minibuffer-local-map.
- * international/mule-cmds.el (read-multilingual-string): Don't
- activate an input method in the current buffer, but just bind
+ * international/mule-cmds.el (read-multilingual-string):
+ Don't activate an input method in the current buffer, but just bind
current-input-method.
* language/japan-util.el (japanese-replace-region): New function.
@@ -964,7 +964,7 @@
1998-07-17 Simon Marshall <simon@gnu.org>
- * lazy-lock.el (lazy-lock-fontify-after-visage): Renamed from
+ * lazy-lock.el (lazy-lock-fontify-after-visage): Rename from
lazy-lock-fontify-after-outline.
(lazy-lock-install-hooks): Add it to hs-hide-hook too.
(lazy-lock-unstall): Remove it from hs-hide-hook too.
@@ -989,14 +989,14 @@
* international/kkc.el (kkc-show-conversion-list-index-chars):
Default value changed.
- (kkc-keymap): Renamed from kkc-mode-map. Key binding for
+ (kkc-keymap): Rename from kkc-mode-map. Key binding for
kkc-non-kkc-command are deleted.
(kkc-mode): This function deleted.
(kkc-canceled): This variable deleted.
(kkc-converting): New variable.
(kkc-region): 3rd optional arg is deleted. Completely rewritten
to adjust for the change in quail.el.
- (kkc-terminate, kkc-cancel): Adjusted for the change of
+ (kkc-terminate, kkc-cancel): Adjust for the change of
kkc-region.
(kkc-non-kkc-command): This function deleted.
(kkc-select-from-list): Use last-input-event instead of
@@ -1008,16 +1008,16 @@
(quail-current-str, quail-current-translations): Likewise.
(quail-reset-conversion-region): This variable deleted.
(quail-use-package): Call quail-activate at the tail.
- (quail-translation-keymap, quail-simple-translation-keymap): Key
- bindings for quail-execute-non-quail-command deleted.
+ (quail-translation-keymap, quail-simple-translation-keymap):
+ Key bindings for quail-execute-non-quail-command deleted.
(quail-conversion-keymap): Likewise. Add key bindings for
quail-self-insert-command.
(quail-delete-overlays): Check overlay-start for overlays before
deleting them.
(quail-mode): This function deleted.
(quail-inactivate, quail-activate): New functions.
- (quail-saved-current-map, quail-saved-current-buffer): These
- variables deleted.
+ (quail-saved-current-map, quail-saved-current-buffer):
+ These variables deleted.
(quail-toggle-mode-temporarily, quail-execute-non-quail-command):
These functions deleted.
(quail-exit-conversion-mode, quail-prefix-arg): These variables
@@ -1032,9 +1032,9 @@
(quail-start-conversion): New function.
(quail-terminate-translation): Just set quail-translating to nil.
(quail-update-translation): Put some events back to
- unread-input-method-events instead of unread-command-events. Call
- quail-error instead of error.
- (quail-self-insert-command): Adjusted for the change of
+ unread-input-method-events instead of unread-command-events.
+ Call quail-error instead of error.
+ (quail-self-insert-command): Adjust for the change of
quail-start-translation.
(quail-next-translation): Don't call
quail-execute-non-quail-command, instead, put an event back of
@@ -1079,7 +1079,7 @@
(crisp-mode-map): Make this a sparse keymap parented from
current-global-map.
(crisp-mode-original-keymap): Don't copy the keymap.
- (crisp-last-last-command): Renamed from last-last-command. defvar it.
+ (crisp-last-last-command): Rename from last-last-command. defvar it.
(crisp-mode): Honor ARG.
(crisp-kill-line, crisp-copy-line): When a region isn't highlighted,
@@ -1145,7 +1145,7 @@
1998-07-12 Richard Stallman <rms@psilocin.ai.mit.edu>
* international/mule.el (set-selection-coding-system):
- Renamed from set-clipboard-coding-system.
+ Rename from set-clipboard-coding-system.
Set the variable's new name, selection-coding-system.
* mail/rmailout.el (rmail-output-to-rmail-file):
@@ -1155,9 +1155,9 @@
* speedbspec.el: Deleted; now integrated into speedbar.el.
* speedbar.el: More commentary.
- (speedbar-xemacsp): Moved definition.
- (speedbar-initial-expansion-mode-list): Was
- `speedbar-initial-expansion-list' and now has multiple modes.
+ (speedbar-xemacsp): Move definition.
+ (speedbar-initial-expansion-mode-list):
+ Was `speedbar-initial-expansion-list' and now has multiple modes.
(speedbar-stealthy-function-list): Now has mode labels.
(speedbar-initial-expansion-list-name)
(speedbar-previously-used-expansion-list-name)
@@ -1165,27 +1165,27 @@
(speedbar-tag-hierarchy-method, speedbar-tag-split-minimum-length)
(speedbar-tag-regroup-maximum-length)
(speedbar-hide-button-brackets-flag): New variables.
- (speedbar-special-mode-expansion-list): Updated documentation.
+ (speedbar-special-mode-expansion-list): Update documentation.
(speedbar-navigating-speed, speedbar-update-speed): Phasing out.
- (speedbar-vc-indicator): Removed space from this var.
+ (speedbar-vc-indicator): Remove space from this var.
(speedbar-indicator-separator, speedbar-obj-do-check)
(speedbar-obj-to-do-point, speedbar-obj-indicator, speedbar-obj-alist)
(speedbar-indicator-regex): New variables.
(speedbar-directory-unshown-regexp): New variable.
- (speedbar-supported-extension-expressions): Added more extensions.
+ (speedbar-supported-extension-expressions): Add more extensions.
(speedbar-add-supported-extension)
(speedbar-add-ignored-path-regexp): Made interactive.
(speedbar-update-flag): Nil w/ no window system.
- (speedbar-file-key-map): Moved some key bindings from
+ (speedbar-file-key-map): Move some key bindings from
`speedbar-key-map' to this map.
(speedbar-make-specialized-keymap): New function.
(speedbar-file-key-map): New key map.
- (speedbar-easymenu-definition-special): Updated to new functions.
- (speedbar-easymenu-definition-trailer): Changed conditional part.
- (speedbar-frame-mode): Removed commented code, fixed W32 cursor
+ (speedbar-easymenu-definition-special): Update to new functions.
+ (speedbar-easymenu-definition-trailer): Change conditional part.
+ (speedbar-frame-mode): Remove commented code, fixed W32 cursor
bug, Updated to better handle terminal frames.
(speedbar-switch-buffer-attached-frame): New function.
- (speedbar-mode): Updated documentation, no local keymap,
+ (speedbar-mode): Update documentation, no local keymap,
correct `temp-buffer-show-function' use, enable mouse-tracking.
(speedbar-show-info-under-mouse): New function.
(speedbar-reconfigure-keymaps): Was `speedbar-reconfigure-menubar'.
@@ -1195,9 +1195,9 @@
(speedbar-restricted-move, speedbar-restricted-next)
(speedbar-restricted-prev, speedbar-navigate-list)
(speedbar-forward-list, speedbar-backward-list): New commands.
- (speedbar-refresh): Updated message printing & verbosity.
- (speedbar-item-load): Updated message.
- (speedbar-item-byte-compile): Updated doc & reset scanners.
+ (speedbar-refresh): Update message printing & verbosity.
+ (speedbar-item-load): Update message.
+ (speedbar-item-byte-compile): Update doc & reset scanners.
(speedbar-item-info): Overhauled with more details.
(speedbar-item-copy): Update messages.
(speedbar-generic-item-info): New function.
@@ -1245,7 +1245,7 @@
* mail/rmail.el: No longer depends on speedbspec for byte compile.
(rmail-speedbar-match-folder-regexp): New variable.
- (rmail-speedbar-menu-items): Updated speedbar menu items.
+ (rmail-speedbar-menu-items): Update speedbar menu items.
(rmail-speedbar-key-map): New keymap.
(rmail-install-speedbar-variables): New function.
Install speedbar keymap only when speedbar is loaded.
@@ -1264,13 +1264,13 @@
* gud.el (gud-speedbar-key-map): New variable.
(gud-install-speedbar-variables): New function
Install speedbar keymap only when speedbar is loaded.
- (gud-gdb-get-stackframe): Added ":" to regex for c++.
+ (gud-gdb-get-stackframe): Add ":" to regex for c++.
1998-07-09 Sam Steingold <sds@usa.net>
* emacs-lisp/cl-indent.el: Indent `handler-case' correctly.
- * font-lock.el (lisp-font-lock-keywords): Fontify
- `handler-case', `ccase', `ctypecase', `assert', `error'.
+ * font-lock.el (lisp-font-lock-keywords):
+ Fontify `handler-case', `ccase', `ctypecase', `assert', `error'.
1998-07-09 Andrew Innes <andrewi@harlequin.co.uk>
@@ -1342,8 +1342,8 @@
1998-07-05 Richard Stallman <rms@psilocin.ai.mit.edu>
- * mail/mail-utils.el (rmail-dont-reply-to): Understand
- about doublequotes; don't be fooled by commas inside them.
+ * mail/mail-utils.el (rmail-dont-reply-to):
+ Understand about doublequotes; don't be fooled by commas inside them.
1998-07-04 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -1378,7 +1378,7 @@
1998-07-03 Espen Skoglund <espensk@stud.cs.uit.no>
- * pascal.el (pascal-insert-block): Fixed space-deletion bug in
+ * pascal.el (pascal-insert-block): Fix space-deletion bug in
front of the "begin" string.
(pascal-beg-of-defun): Used to locate the beginning of a function
incorrectly when a function contained several begin-end blocks.
@@ -1398,7 +1398,7 @@
* dos-vars.el (dos-printer): Obsolete variable deleted.
(dos-ps-printer): Likewise.
- * dos-w32.el (direct-print-region-function): Renamed from
+ * dos-w32.el (direct-print-region-function): Rename from
dos-print-region-function. Added &rest keyword.
(print-region-function): Set to direct-print-region-function.
(lpr-headers-switches): Initialize.
@@ -1441,12 +1441,12 @@
1998-07-03 Eric Ludlam <zappo@mescaline.gnu.org>
- * emacs-lisp/checkdoc.el (checkdoc): Updated commentary.
- (checkdoc-autofix-flag): Updated doc.
- (checkdoc-force-docstrings-flag): Updated doc.
+ * emacs-lisp/checkdoc.el (checkdoc): Update commentary.
+ (checkdoc-autofix-flag): Update doc.
+ (checkdoc-force-docstrings-flag): Update doc.
(checkdoc-force-history-flag): New flag.
- (checkdoc-triple-semi-comment-check-flag): Fixed name.
- (checkdoc-spellcheck-documentation-flag): Fixed doc.
+ (checkdoc-triple-semi-comment-check-flag): Fix name.
+ (checkdoc-spellcheck-documentation-flag): Fix doc.
(checkdoc-ispell-lisp-words): Update default value.
(checkdoc-generate-compile-warnings-flag, checkdoc-proper-noun-list)
(checkdoc-proper-noun-regexp, checkdoc-symbol-words): New variables.
@@ -1458,22 +1458,22 @@
Cursor now sits next to the error, forcing scrolling if needed,
and using a better centering algorithm, and much better error
navigation after choosing "f"ix.
- (checkdoc-next-error): Added parameter ENABLE-FIX.
+ (checkdoc-next-error): Add parameter ENABLE-FIX.
(checkdoc-next-message-error, checkdoc-recursive-edit): New functions.
(checkdoc-start): Was `checkdoc', uses new note taking system.
(checkdoc-current-buffer, checkdoc-continue, checkdoc-comments):
- Updated to use new note taking system.
+ Update to use new note taking system.
(checkdoc-rogue-spaces, checkdoc-rogue-space-check-engine):
- Added INTERACT parameter, uses new warnings functions.
+ Add INTERACT parameter, uses new warnings functions.
(checkdoc-message-text, checkdoc-defun):
- Updated to use new note taking system.
+ Update to use new note taking system.
(checkdoc-ispell-current-buffer, checkdoc-ispell-interactive): Fix doc.
(checkdoc-ispell-message-text, checkdoc-ispell-start): New function.
(checkdoc-create-error, checkdoc-error-text, checkdoc-error-start)
(checkdoc-error-end, checkdoc-error-unfixable): New functions.
- (checkdoc-minor-keymap): Updated keybinds to new interactive functions,
+ (checkdoc-minor-keymap): Update keybinds to new interactive functions,
completely re-arranged the minor-mode menu.
- (checkdoc-this-string-valid): Moved no doc-string warning here,
+ (checkdoc-this-string-valid): Move no doc-string warning here,
and added autofix if a comment already exists there.
(checkdoc-this-string-valid-engine): Fix doc, robusted doc finder.
All previously returned errors now call `checkdoc-create-error'.
@@ -1497,7 +1497,7 @@
for history and commentary. All previously returned errors now call
`checkdoc-create-error'. Message spelling and format.
(checkdoc-message-text-search):
- Moved parts to `checkdoc-message-text-next-string'.
+ Move parts to `checkdoc-message-text-next-string'.
(checkdoc-message-text-next-string): New function.
(checkdoc-message-text-engine): All previously returned errors
now call `checkdoc-create-error'. Can find/skip 'format' call
@@ -1506,12 +1506,12 @@
(checkdoc-y-or-n-p): New function.
(checkdoc-autofix-ask-replace): Update doc. Protect match-data.
Correctly handle `checkdoc-autofix-flag' of 'never. New behavior
- with `checkdoc-autofix-flag' of 'automatic-then-never. Better
- overlay handling.
- (checkdoc-output-font-lock-keywords): Updated to new output format.
+ with `checkdoc-autofix-flag' of 'automatic-then-never.
+ Better overlay handling.
+ (checkdoc-output-font-lock-keywords): Update to new output format.
(checkdoc-pending-errors): New variable.
- (checkdoc-find-error): Updated to new output format.
- (checkdoc-start-section, checkdoc-error): Improved the output.
+ (checkdoc-find-error): Update to new output format.
+ (checkdoc-start-section, checkdoc-error): Improve the output.
(checkdoc-show-diagnostics): Smarter show algorithm.
1998-07-03 Kenichi Handa <handa@etl.go.jp>
@@ -1563,12 +1563,12 @@
* derived.el (derived-mode-hooks-name): Use -hook, not -hooks,
in mode hook name.
- (derived-mode-hook-name): Renamed from ...-hooks; caller changed.
+ (derived-mode-hook-name): Rename from ...-hooks; caller changed.
1998-07-01 Ken'ichi Handa <handa@melange.gnu.org>
- * international/mule.el (mule-version): Changed to 4.0.
- (mule-version-date): Updated.
+ * international/mule.el (mule-version): Change to 4.0.
+ (mule-version-date): Update.
1998-06-30 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -1679,7 +1679,7 @@
* language/korea-util.el (isearch-toggle-korean-input-method)
(isearch-hangul-switch-symbol-ksc, isearch-hangul-switch-hanja):
New functions.
- (korean-key-bindings): Renamed from exit-korean-environment-data.
+ (korean-key-bindings): Rename from exit-korean-environment-data.
Initialized appropriately.
(setup-korean-environment): Setup key bindings according to
korean-key-bindings.
@@ -1714,10 +1714,10 @@
of `find-function-noselect'.
(find-function-search-for-symbol): `regexp-quote' the symbol name:
needed to find-function `mapcar*' for example.
- (find-function-noselect): Improved docstring. Don't include
+ (find-function-noselect): Improve docstring. Don't include
`library' in let.
Use `symbol-file' instead of `describe-symbol-find-file'.
- (find-function-read): Renamed from `find-function-read-function'.
+ (find-function-read): Rename from `find-function-read-function'.
With optional arg now read a variable.
(find-function-read): Separate `completing-read' calls for
variables and functions.
@@ -1746,7 +1746,7 @@
(find-variable-other-window): Remove most of docstring and add
reference to `find-variable' instead.
(find-variable-other-frame): Ditto.
- (find-function-on-key): Simplified. Removed stuff now taken care
+ (find-function-on-key): Simplify. Removed stuff now taken care
of by interactive "k".
(find-function-at-point): New function.
(find-variable-at-point): Ditto.
@@ -1768,7 +1768,7 @@
1998-06-24 Andrew Innes <andrewi@mescaline.gnu.org>
- * dos-w32.el (null-device): Renamed from grep-null-device.
+ * dos-w32.el (null-device): Rename from grep-null-device.
1998-06-24 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -1795,8 +1795,8 @@
(ange-ftp-generate-anonymous-password): Use `other' widget type.
* autoinsert.el (auto-insert, auto-insert-query): Use `other'
widget type.
- * bookmark.el (bookmark-save-flag, bookmark-version-control): Use
- `other' widget type.
+ * bookmark.el (bookmark-save-flag, bookmark-version-control):
+ Use `other' widget type.
* comint.el (comint-input-autoexpand): Use `other' widget type.
* complete.el (PC-first-char): Use `other' widget type.
* cus-edit.el (custom-magic-show): Use `other' widget type.
@@ -1855,8 +1855,8 @@
1998-06-23 Ken'ichi Handa <handa@melange.gnu.org>
- * international/fontset.el (x-style-funcs-alist): Remove
- duplicated code.
+ * international/fontset.el (x-style-funcs-alist):
+ Remove duplicated code.
1998-06-23 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -1896,8 +1896,8 @@
`composition'. Add property `jisx0208' to Japanese hankaku characters.
(japanese-kana-table): Add more data.
(japanese-symbol-table): Change the order of elements.
- (japanese-katakana-region): Adjusted for the above changes. Check
- character code properties directly here.
+ (japanese-katakana-region): Adjust for the above changes.
+ Check character code properties directly here.
(japanese-hiragana-region): Likewise.
(japanese-hankaku-region): Likewise.
(japanese-zenkaku-region): Likewise.
@@ -1983,8 +1983,8 @@
1998-06-20 Kenichi Handa <handa@etl.go.jp>
- * international/fontset.el (x-style-funcs-alist): If
- x-make-font-demibold or x-make-font-bold return nil, don't try
+ * international/fontset.el (x-style-funcs-alist):
+ If x-make-font-demibold or x-make-font-bold return nil, don't try
further style modification.
* international/encoded-kb.el (encoded-kbd-self-insert-sjis):
@@ -2003,8 +2003,8 @@
ethio-mode-map, and function ethio-mode.
(exit-ethiopic-environment-data): New variable.
(setup-ethiopic-environment): Recode information of changed key
- bindings in exit-ethiopic-environment-data. Add
- ethio-select-a-translation to quail-mode-hook.
+ bindings in exit-ethiopic-environment-data.
+ Add ethio-select-a-translation to quail-mode-hook.
(exit-ethiopic-environment): New function.
(ethio-find-file): Don't check ethio-mode.
(ethio-write-file): Likewise.
@@ -2067,7 +2067,7 @@
* international/mule.el (set-auto-coding): Redo the previous change.
- * tar-mode.el (tar-extract): Adjusted for the change of the spec
+ * tar-mode.el (tar-extract): Adjust for the change of the spec
of set-auto-coding-function.
1998-06-14 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -2154,8 +2154,8 @@
* faces.el (set-face-font): Pay attention to fontset.
(set-face-font-auto): Call resolve-fontset-name.
- * international/fontset.el (instantiate-fontset): Delete
- duplicated call of x-complement-fontset-spec. Call new-fontset
+ * international/fontset.el (instantiate-fontset):
+ Delete duplicated call of x-complement-fontset-spec. Call new-fontset
with a correct argument.
(x-compose-font-name): Argument name adjusted for the doc-string.
(x-complement-fontset-spec): Don't alter the contents of the
@@ -2163,8 +2163,8 @@
(x-style-funcs-alist): The format changed.
(x-modify-font-name): New function.
(create-fontset-from-fontset-spec): The arg STYLE-VARIANT-P is
- changed to STYLE-VARIANT, the format also changed. Use
- x-modify-font-name instead of calling functions in
+ changed to STYLE-VARIANT, the format also changed.
+ Use x-modify-font-name instead of calling functions in
x-style-funcs-alist directly.
(instantiate-fontset): Use x-modify-font-name instead of calling
functions in x-style-funcs-alist directly.
@@ -2283,8 +2283,8 @@
1998-06-09 Ed Reingold <reingold@cs.uiuc.edu>
- * calendar/cal-tex.el (cal-tex-list-diary-entries): Set
- diary-display-hook correctly.
+ * calendar/cal-tex.el (cal-tex-list-diary-entries):
+ Set diary-display-hook correctly.
* calendar/cal-menu.el (calendar-mouse-holidays)
(calendar-mouse-view-diary-entries)
@@ -2342,8 +2342,8 @@
1998-06-08 Andrew Innes <andrewi@harlequin.co.uk>
- * ange-ftp.el (ange-ftp-file-name-completion): Use
- ange-ftp-this-dir instead of literal "/" when calling real
+ * ange-ftp.el (ange-ftp-file-name-completion):
+ Use ange-ftp-this-dir instead of literal "/" when calling real
completion function.
1998-06-08 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -2450,8 +2450,8 @@
1998-06-05 Andrew Innes <andrewi@harlequin.co.uk>
- * jka-compr.el (jka-compr-write-region): Ensure
- `last-coding-system-used' is updated, so that basic-save-buffer
+ * jka-compr.el (jka-compr-write-region):
+ Ensure `last-coding-system-used' is updated, so that basic-save-buffer
sees the right value.
1998-06-05 Richard Stallman <rms@gnu.org>
@@ -2531,8 +2531,8 @@
* docref.el: Deleted in view of current approach to doc strings.
- * startup.el (normal-top-level-add-subdirs-to-load-path): Ignore
- CVS directories too.
+ * startup.el (normal-top-level-add-subdirs-to-load-path):
+ Ignore CVS directories too.
1998-06-02 Richard Stallman <rms@gnu.org>
@@ -2571,15 +2571,15 @@
1998-06-01 Per Starbäck <starback@update.uu.se>
- * apropos.el (apropos-variable): Fixed argument to apropos-command.
+ * apropos.el (apropos-variable): Fix argument to apropos-command.
(apropos-command): Let `var-predicate' have higher priority than
`do-all'.
1998-06-01 Dave Love <fx@gnu.org>
* textmodes/sgml-mode.el (sgml-font-lock-keywords-1): Add -. as
- NMCHARs. Elide upper case (see font-lock-defaults). Generalize
- comment declaration not to exclude markup.
+ NMCHARs. Elide upper case (see font-lock-defaults).
+ Generalize comment declaration not to exclude markup.
1998-05-31 Richard Stallman <rms@gnu.org>
@@ -2602,8 +2602,8 @@
1998-05-31 Alan Shutko <shutkoa@ugsolutions.com>
- * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Add
- missing format arg.
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode):
+ Add missing format arg.
1998-05-30 Dave Love <fx@gnu.org>
@@ -2626,17 +2626,17 @@
1998-05-30 Michael Kifer <kifer@cs.sunysb.edu>
* ediff-mult.el (ediff-mark-for-hiding-at-pos)
- (ediff-mark-for-operation-at-pos): Renamed from
+ (ediff-mark-for-operation-at-pos): Rename from
ediff-mark-for-hiding, ediff-mark-for-operation.
(ediff-mark-session-for-hiding, ediff-mark-session-for-operation)
- (ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding): New
- functions.
- (ediff-setup-meta-map): Changed bindings.
+ (ediff-unmark-all-for-operation, ediff-unmark-all-for-hiding):
+ New functions.
+ (ediff-setup-meta-map): Change bindings.
* viper-cmd.el (viper-backward-Word, viper-skip-separators): Bugfix.
(viper-switch-to-buffer, viper-switch-to-buffer-other-window): Bugfix.
* viper-util.el (viper-skip-syntax): Bug fix for eob/bob cases.
- * viper-mous.el (viper-surrounding-word): Added '_' to alpha modifiers.
+ * viper-mous.el (viper-surrounding-word): Add '_' to alpha modifiers.
1998-05-30 Ralph Schleicher <rs@purple.UL.BaWue.DE>
@@ -2700,8 +2700,8 @@
1998-05-27 Ed Reingold <reingold@cs.uiuc.edu>
- * calendar/calendar.el (calendar-buffer-list): Add
- other-calendars-buffer.
+ * calendar/calendar.el (calendar-buffer-list):
+ Add other-calendars-buffer.
(calendar-mode): Use activate-menubar-hook only in a window system.
1998-05-27 Dave Love <fx@gnu.org>
@@ -2749,7 +2749,7 @@
* abbrev.el: Likewise.
1998-05-26 Emilio Lopes <Emilio.Lopes@Physik.TU-Muenchen.DE>
- Karl Fogel <kfogel@red-bean.com>
+ Karl Fogel <kfogel@red-bean.com>
* bookmark.el: Changes so bookmark list mode works with Info:
(bookmark-jump-noselect): Use an inner save-window-excursion.
@@ -2794,13 +2794,13 @@
* emacs-lisp/byte-opt.el (byte-boolean-vars):
Add print-escape-nonascii.
- * emacs-lisp/autoload.el (generate-file-autoloads): Set
- print-escape-nonascii when printing autoload form.
+ * emacs-lisp/autoload.el (generate-file-autoloads):
+ Set print-escape-nonascii when printing autoload form.
1998-05-25 Kenichi HANDA <handa@etl.go.jp>
- * international/mule.el (set-coding-priority): Call
- set-coding-priority-internal at the tail.
+ * international/mule.el (set-coding-priority):
+ Call set-coding-priority-internal at the tail.
1998-05-24 Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -2924,12 +2924,12 @@
Use translation-table, not character-translation-table,
as char-table subtype.
(define-translation-table):
- Renamed from define-character-translation-table.
+ Rename from define-character-translation-table.
* mule-util.el: Likewise.
* mule-conf.el: Likewise.
(standard-translation-table-for-decode)
(standard-translation-table-for-encode):
- Renamed from standard-character-translation-table-...
+ Rename from standard-character-translation-table-...
1998-05-21 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -2956,7 +2956,7 @@
1998-05-21 Sam Steingold <sds@usa.net>
- * cl-indent.el: Indent `with-standard-io-syntax' correctly.
+ * emacs-lisp/cl-indent.el: Indent `with-standard-io-syntax' correctly.
1998-05-21 Michael Ernst <ernst@cs.washington.edu>
@@ -2965,17 +2965,17 @@
1998-05-21 Eli Zaretskii <eliz@mescaline.gnu.org>
- * arc-mode.el (archive-file-name-invalid-regexp): Remove. All
- users changed to use file-name-invalid-regexp instead.
+ * arc-mode.el (archive-file-name-invalid-regexp): Remove.
+ All users changed to use file-name-invalid-regexp instead.
* files.el (file-name-invalid-regexp): New variable, moved here
from arc-mode.el.
1998-05-21 Richard Stallman <rms@psilocin.ai.mit.edu>
* progmodes/vhdl-mode.el (vhdl-customize-colors):
- Renamed from vhdl-use-default-colors, and sense reversed.
+ Rename from vhdl-use-default-colors, and sense reversed.
(vhdl-customize-faces):
- Renamed from vhdl-use-default-faces, and sense reversed.
+ Rename from vhdl-use-default-faces, and sense reversed.
(vhdl-font-lock-init, vhdl-ps-init): Implement those changes.
(vhdl-submit-bug-report): Use new variable names.
@@ -2994,10 +2994,10 @@
FONTLIST).
(x-style-funcs-alist): New variable.
(create-fontset-from-fontset-spec): 2nd optional arg is changed
- from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete
- unused code. Adjusted for the change of
+ from STYLE to STYLE-VARIANT-P. The meaning also changed.
+ Delete unused code. Adjusted for the change of
uninstantiated-fontset-alist.
- (instantiate-fontset): Adjusted for the change of
+ (instantiate-fontset): Adjust for the change of
uninstantiated-fontset-alist.
* international/mule.el (make-coding-system): If ISO2022 based
@@ -3039,21 +3039,21 @@
1998-05-20 Kenichi Handa <handa@etl.go.jp>
- * international/fontset.el (x-font-name-charset-alist): New
- variable.
+ * international/fontset.el (x-font-name-charset-alist):
+ New variable.
(register-alternate-fontnames): Doc-string modified.
(x-complement-fontset-spec): Likewise.
- (x-complement-fontset-spec): Delete unused local variable. Delete
- ad hoc code for Latin-1, instead refer to
+ (x-complement-fontset-spec): Delete unused local variable.
+ Delete ad hoc code for Latin-1, instead refer to
x-font-name-charset-alist.
(uninstantiated-fontset-alist): Format changed (BASE-FONTSET ->
FONTLIST).
(x-style-funcs-alist): New variable.
(create-fontset-from-fontset-spec): 2nd optional arg is changed
- from STYLE to STYLE-VARIANT-P. The meaning also changed. Delete
- unused code. Adjusted for the change of
+ from STYLE to STYLE-VARIANT-P. The meaning also changed.
+ Delete unused code. Adjusted for the change of
uninstantiated-fontset-alist.
- (instantiate-fontset): Adjusted for the change of
+ (instantiate-fontset): Adjust for the change of
uninstantiated-fontset-alist.
* international/mule.el (make-coding-system): If ISO2022 based
@@ -3083,7 +3083,7 @@
* international/mule-cmds.el: Several doc fixes.
(get-language-info, set-language-info): Rename argument.
(set-language-info-alist): Likewise.
- (find-coding-systems-region-subset-p): Renamed from subset-p.
+ (find-coding-systems-region-subset-p): Rename from subset-p.
(find-coding-systems-region): Use new name.
(register-input-method): Rename argument.
(activate-input-method): If INPUT-METHOD is nil, deactivate.
@@ -3179,13 +3179,13 @@
(checkdoc-message-text-search, checkdoc-message-text-engine):
New functions.
(checkdoc-this-string-valid-engine):
- Added ambiguous function/symbol checking. Added new auto-fix
+ Add ambiguous function/symbol checking. Added new auto-fix
for missing parameters.
1998-05-16 Richard Stallman <rms@psilocin.ai.mit.edu>
* international/mule-cmds.el (find-coding-systems-region-subset-p):
- Renamed from subset-p.
+ Rename from subset-p.
(find-coding-systems-for-charsets): Call changed.
1998-05-16 Dan Nicolaescu <done@ece.arizona.edu>
@@ -3217,7 +3217,7 @@
Use expand-file-name on it.
* files.el (temporary-file-directory):
- Renamed from system-tmp-directory.
+ Rename from system-tmp-directory.
Value is now a directory name, not a file name.
* dired-aux.el (dired-mark-subdir-files): Doc fix.
@@ -3298,10 +3298,10 @@
All callers changed.
(archive-unique-fname): New function.
(archive-maybe-copy): Use it.
- (archive-maybe-copy, archive-write-file): Bind
- coding-system-for-write to no-conversion.
- (archive-maybe-update, archive-mode-revert): Bind
- coding-system-for-read to no-conversion.
+ (archive-maybe-copy, archive-write-file):
+ Bind coding-system-for-write to no-conversion.
+ (archive-maybe-update, archive-mode-revert):
+ Bind coding-system-for-read to no-conversion.
(archive-maybe-update): Remain at the same line in the archive
listing, after updating the archive. Print the buffer name of the
archive to be saved.
@@ -3309,8 +3309,8 @@
read-only. Don't set buffer-file-type. Remove the write-contents
hook for remote archives. Warn about read-only archives inside
other archives.
- (archive-write-file-member): Handle remote archives. Restore
- value of last-coding-system-used.
+ (archive-write-file-member): Handle remote archives.
+ Restore value of last-coding-system-used.
(archive-*-write-file-member): Handle archives inside other
archives. Save the value of last-coding-system-used.
(archive-write-file): New optional variable FILE: where to write
@@ -3442,10 +3442,10 @@
1998-05-08 Richard Stallman <rms@psilocin.gnu.org>
- * ps-print.el (ps-alist-position): Renamed from ps-position.
+ * ps-print.el (ps-alist-position): Rename from ps-position.
Look for ITEM as the car of an element.
(ps-font-number): Use ps-alist-position.
- (ps-font-alist): Renamed from ps-font-list.
+ (ps-font-alist): Rename from ps-font-list.
* mail/reporter.el (reporter-bug-hook): Use rfc822-goto-eoh.
@@ -3520,13 +3520,13 @@
1998-05-06 Sam Steingold <sds@usa.net>
- * window.el (quit-window): Fixed FRAME to be the frame and
+ * window.el (quit-window): Fix FRAME to be the frame and
never window.
1998-05-06 Michael Kifer <kifer@cs.sunysb.edu>
* ediff-init.el (ediff-highlight-all-diffs, ediff-use-faces):
- Changed the defaults.
+ Change the defaults.
1998-05-06 Richard Stallman <rms@psilocin.gnu.org>
@@ -3577,7 +3577,7 @@
1998-05-05 Simon Marshall <simon@gnu.org>
- * font-lock.el (lisp-font-lock-keywords-1): Fixed 1998-04-24 change;
+ * font-lock.el (lisp-font-lock-keywords-1): Fix 1998-04-24 change;
moved defpackage to here from lisp-font-lock-keywords-2.
1998-05-05 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
@@ -3613,7 +3613,7 @@
Now checks for toolbar support before referring toolbars.
* ediff-init.el (ediff-has-toolbar-support-p, ediff-use-toolbar-p):
- Moved here from ???.
+ Move here from ???.
* ediff-vers.el (cvs-run-ediff-on-file-descriptor):
Set default-directory.
@@ -3663,8 +3663,8 @@
* progmodes/compile.el (compilation-directory-stack): Doc fix.
(compilation-mode): Accept optional parameter and initialize
mode-name from it.
- (compile-internal): Pass name-of-mode to compilation-mode. Don't
- set mode-name here.
+ (compile-internal): Pass name-of-mode to compilation-mode.
+ Don't set mode-name here.
(compilation-minor-mode): Don't let mode-line-process change.
(compilation-next-error-locus): Use forward-char instead of
move-to-column.
@@ -3723,11 +3723,11 @@
1998-05-02 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc-hooks.el (vc-parse-cvs-status): Optimized. Ignore
- "Locally Removed" files.
+ * vc-hooks.el (vc-parse-cvs-status): Optimize.
+ Ignore "Locally Removed" files.
* vc.el (vc-fetch-cvs-status): Don't specify DIR on the command line.
- (vc-dired-hook): Optimized for CVS.
+ (vc-dired-hook): Optimize for CVS.
1998-05-02 Richard Stallman <rms@psilocin.gnu.org>
@@ -3776,19 +3776,19 @@
(file-cache-add-directory): Checks to see if directory exists
before adding it. Non-existing directories are simply skipped.
- * generic.el (generic): Added defgroup declaration.
+ * generic.el (generic): Add defgroup declaration.
(generic-make-keywords-list): Uses regexp-opt.
(generic-mode-set-font-lock): Uses regexp-opt.
- * generic-x.el (generic-x): Added defgroup declaration.
+ * generic-x.el (generic-x): Add defgroup declaration.
- * generic-x.el (generic-bat-mode-setup-function): Fixed comment-start
+ * generic-x.el (generic-bat-mode-setup-function): Fix comment-start
variable.
- * generic-x.el (generic-define-mswindows-modes): Enable
- hosts-generic-mode and apache-generic-mode.
+ * generic-x.el (generic-define-mswindows-modes):
+ Enable hosts-generic-mode and apache-generic-mode.
(generic-define-unix-modes): Enable alias-generic-mode.
- (java-properties-generic-mode): Changed regexp to allow property
+ (java-properties-generic-mode): Change regexp to allow property
and value to be separated by whitespace or an equal sign.
(alias-generic-mode): Check generic-extras-enable-list before
defining this mode.
@@ -3815,8 +3815,8 @@
(universal-coding-system-argument): Use buffer-file-coding-system
as default.
- * international/quail.el (quail-show-translations): Show
- followable keys in alphabetic order.
+ * international/quail.el (quail-show-translations):
+ Show followable keys in alphabetic order.
1998-04-29 Richard Stallman <rms@psilocin.gnu.org>
@@ -3937,10 +3937,10 @@
(ispell-dictionary-alist): Now customizable.
Fixed type of custom variables: ispell-help-in-bufferp.
(ispell-use-framepop-p): New variable.
- (ispell-dictionary-alist): Added dictionaries: castellano, castellano8
+ (ispell-dictionary-alist): Add dictionaries: castellano, castellano8
czech, esperanto, esperanto-tex, norsk, russian.
Capitalize XEmacs correctly, and change lucid to xemacs in code.
- (ispell-menu-lucid): Renamed to ispell-menu-xemacs.
+ (ispell-menu-lucid): Rename to ispell-menu-xemacs.
Changed string compares for version number to be correct for XEmacs.
Fixed to work with string properties.
(ispell-recursive-edit-marker): New marker saving return point.
@@ -4003,7 +4003,7 @@
1998-04-28 Inge Frick <inge@nada.kth.se>
- * emacs-lisp/easymenu.el (easy-menu-define-key): Fixed bug with BEFORE
+ * emacs-lisp/easymenu.el (easy-menu-define-key): Fix bug with BEFORE
argument. Now it works also if you repeat an identical call to
easy-menu-define-key.
@@ -4097,9 +4097,9 @@
1998-04-24 Sam Steingold <sds@usa.net>
- * cl-indent.el: Indent defpackage correctly.
+ * emacs-lisp/cl-indent.el: Indent defpackage correctly.
- * font-lock.el (lisp-font-lock-keywords-2): Added `defpackage'.
+ * font-lock.el (lisp-font-lock-keywords-2): Add `defpackage'.
1998-04-23 Geoff Voelker <voelker@cs.washington.edu>
@@ -4126,17 +4126,17 @@
* easymenu.el: Use new menu item format. Don't simulate button prefix.
(easy-menu-create-menu): Understand also keywords :active,
:label and :visible. Don't worry about button prefix.
- (easy-menu-button-prefix): Modified value.
+ (easy-menu-button-prefix): Modify value.
(easy-menu-do-add-item): Extensive changes to use new menu item format.
(easy-menu-define-key, easy-menu-always-true): New functions.
- (easy-menu-make-symbol): Don't use indirection for symbols. Property
- `menu-alias' not set.
- (easy-menu-filter, easy-menu-update-button): Deleted.
+ (easy-menu-make-symbol): Don't use indirection for symbols.
+ Property `menu-alias' not set.
+ (easy-menu-filter, easy-menu-update-button): Delete.
(easy-menu-add-item): Don't worry about button prefix.
- (easy-menu-remove-item): Don't worry about button prefix. Use
- `easy-menu-define-key'.
- (easy-menu-is-button, easy-menu-have-button): Deleted.
- (easy-menu-real-binding, easy-menu-change-prefix): Deleted.
+ (easy-menu-remove-item): Don't worry about button prefix.
+ Use `easy-menu-define-key'.
+ (easy-menu-is-button, easy-menu-have-button): Delete.
+ (easy-menu-real-binding, easy-menu-change-prefix): Delete.
1998-04-23 Richard Stallman <rms@psilocin.gnu.org>
@@ -4177,8 +4177,8 @@
1998-04-22 Eli Zaretskii <eliz@delysid.gnu.org>
- * term/pc-win.el (x-select-text, x-get-selection-value): Replace
- win16 with w16.
+ * term/pc-win.el (x-select-text, x-get-selection-value):
+ Replace win16 with w16.
1998-04-22 Dave Love <fx@gnu.org>
@@ -4244,9 +4244,9 @@
1998-04-20 Piet van Oostrum <piet@cs.ruu.nl>
- * smtpmail.el (smtpmail-send-it): Deleted all code related
+ * smtpmail.el (smtpmail-send-it): Delete all code related
to Resent-To: processing.
- (smtpmail-deduce-address-list): Changed the search for
+ (smtpmail-deduce-address-list): Change the search for
Resent-\(To\|Cc\|Bcc\) headers.
(smtpmail-do-bcc): Delete Resent-Bcc: headers.
@@ -4308,11 +4308,11 @@
1998-04-20 Kenichi Handa <handa@etl.go.jp>
- * international/ccl.el (ccl-compile-unify-character): Inhibit
- unification tables specified by integer value.
+ * international/ccl.el (ccl-compile-unify-character):
+ Inhibit unification tables specified by integer value.
(ccl-compile-translate-single-map): Likewise.
(ccl-compile-multiple-map-function): Likewise.
- (ccl-compile-translate-multiple-map): Modified for nested tables.
+ (ccl-compile-translate-multiple-map): Modify for nested tables.
(ccl-dump-iterate-multiple-map): Handle the case that ID is not
integer.
(ccl-dump-translate-multiple-map): Likewise.
@@ -4323,8 +4323,8 @@
* international/mule.el (make-coding-system): If TYPE is 4, FLAGS
can be a cons of CCL-PROGRAM symbols.
- * international/quail.el (quail-start-translation): Bind
- prefix-arg to current-prefix-arg.
+ * international/quail.el (quail-start-translation):
+ Bind prefix-arg to current-prefix-arg.
(quail-mode): Doc-string modified.
* language/cyrillic.el: FLAGS arguments for make-coding-system
@@ -4367,7 +4367,7 @@
* which-func.el (which-func): Add defgroup.
- * emacs-lisp/checkdoc.el (checkdoc): Added :version.
+ * emacs-lisp/checkdoc.el (checkdoc): Add :version.
* play/gametree.el (gametree): Likewise.
@@ -4442,8 +4442,8 @@
(ange-ftp-file-name-all-completions): Handle Windows filenames.
(file-name-handler-alist) [windows-nt]: Add patterns for name with
drive letters.
- (ange-ftp-dired-call-process, ange-ftp-call-chmod): Use
- dired-chmod-program.
+ (ange-ftp-dired-call-process, ange-ftp-call-chmod):
+ Use dired-chmod-program.
(ange-ftp-disable-netrc-security-check) [windows-nt]: Disable by
default.
(ange-ftp-real-expand-file-name-actual): New function.
@@ -4471,8 +4471,8 @@
1998-04-16 Ilya Zakharevich <ilya@math.ohio-state.edu>
- * cperl-mode.el (cperl-style-alist): New variable, since `c-mode'
- is no longer loaded.
+ * progmodes/cperl-mode.el (cperl-style-alist):
+ New variable, since `c-mode' is no longer loaded.
- (Somebody who uses the styles should check that they work OK!)
- (a lot of work is needed, especially with new
`cperl-fix-line-spacing').
@@ -4504,8 +4504,8 @@
(cperl-beautify-levels): New command.
(cperl-electric-keyword): Allow here-docs contain `=head1'
and friends for keyword expansion.
- Fix for broken `font-lock-unfontify-region-function'. Should
- preserve `syntax-table' properties even with `lazy-lock'.
+ Fix for broken `font-lock-unfontify-region-function'.
+ Should preserve `syntax-table' properties even with `lazy-lock'.
(cperl-indent-region-fix-else): New command.
(cperl-fix-line-spacing): New command.
(cperl-invert-if-unless): New command (C-c C-t and in Menu).
@@ -4517,7 +4517,7 @@
Workaround for another `font-lock's `syntax-table' text-property bug.
`zerop' could be applied to nil.
At last, may work with `font-lock' without setting `cperl-font-lock'.
- (cperl-indent-region-fix-constructs): Renamed from
+ (cperl-indent-region-fix-constructs): Rename from
`cperl-indent-region-fix-constructs'.
(cperl-fix-line-spacing): Could be triggered inside strings, would not
know what to do with BLOCKs of map/printf/etc.
@@ -4535,9 +4535,9 @@
(cperl-set-style-back): Old value of style is memorized when
choosing a new style, may be restored from the same menu.
Mode-documentation added to micro-docs.
- (cperl-praise): Updated.
+ (cperl-praise): Update.
(cperl-toggle-construct-fix): New command. Added on C-c C-w and menu.
- (auto-fill-mode): Added on C-c C-f and menu.
+ (auto-fill-mode): Add on C-c C-f and menu.
(cperl-style-alist): `PerlStyle' style added.
(cperl-find-pods-heres): Message for termination of scan corrected.
(cperl-speed): New variable with hints.
@@ -4592,8 +4592,8 @@
* arc-mode.el (archive-extract-by-stdout): Don't use
binary-process-output. Bind coding-system-for-read `undecided',
- so coding system is determined on the fly. Bind
- inherit-process-coding-system to t.
+ so coding system is determined on the fly.
+ Bind inherit-process-coding-system to t.
(archive-dos-members): Remove.
(archive-extract): Don't call archive-check-dos. Handle pkunzip
errors.
@@ -4690,7 +4690,7 @@
* vc.el (vc-next-action-on-file): Don't check out after
registering. This is two steps instead of one, and the second
does not make sense under CVS.
- (vc-next-action): Changed doc string to reflect the above.
+ (vc-next-action): Change doc string to reflect the above.
1998-04-14 Andreas Schwab <schwab@mescaline.gnu.org>
@@ -4804,7 +4804,7 @@
1998-04-09 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc.el (vc-next-action): Fixed bug that prevented registering
+ * vc.el (vc-next-action): Fix bug that prevented registering
files using C-x v v.
1998-04-09 Stephen Eglen <stephen@gnu.org>
@@ -4843,7 +4843,7 @@
* gud.el (jdb): Do proper analysis of classes defined in a Java
source. This removes the restriction of one class per file.
- (gud-jdb-package-of-file): Removed. Replaced with parsing routines.
+ (gud-jdb-package-of-file): Remove. Replaced with parsing routines.
(gud-jdb-skip-whitespace): New function.
(gud-jdb-skip-single-line-comment): New function.
(gud-jdb-skip-traditional-or-documentation-comment): New function.
@@ -4914,7 +4914,7 @@
(fortran-mode): Make `fill-column' buffer-local; set
`fill-paragraph-function', `indent-region-function',
`indent-line-function'.
- (calculate-fortran-indent): Renamed to `fortran-calculate-indent'.
+ (calculate-fortran-indent): Rename to `fortran-calculate-indent'.
(fortran-split-line): Simplify.
(fortran-remove-continuation): New function.
(fortran-join-line): Use it.
@@ -4967,18 +4967,18 @@
* language/japanese.el: Set exit-function to
exit-japanese-environment for Japanese environment.
- * language/japan-util.el (setup-japanese-environment): Setup
- sentence-end suitable for Japanese text.
+ * language/japan-util.el (setup-japanese-environment):
+ Setup sentence-end suitable for Japanese text.
(exit-japanese-environment): New function.
- * international/mule-cmds.el (subset-p): Renamed from
+ * international/mule-cmds.el (subset-p): Rename from
find-safe-coding-system-list-subset-p.
- (find-coding-systems-region, find-coding-systems-string): New
- functions.
- (find-coding-systems-for-charsets): Renamed from
+ (find-coding-systems-region, find-coding-systems-string):
+ New functions.
+ (find-coding-systems-for-charsets): Rename from
find-safe-coding-system. This is now a helper function of the
above two.
- (select-safe-coding-system): Adjusted for the above changes.
+ (select-safe-coding-system): Adjust for the above changes.
1998-04-05 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -4997,14 +4997,14 @@
hook, not a local variable.
* vc.el (vc-merge, vc-backend-merge): New functions.
- (vc-resolve-conflicts): Added optional parameters for buffer names.
+ (vc-resolve-conflicts): Add optional parameters for buffer names.
(vc-branch-p): New function.
- * vc-hooks.el (vc-prefix-map): Added "m" for vc-merge.
+ * vc-hooks.el (vc-prefix-map): Add "m" for vc-merge.
* vc.el (vc-ensure-vc-buffer): New function.
- (vc-registration-error): Replaced by the above. Updated all callers.
- (file-executable-p-18, file-regular-p-18): Removed.
+ (vc-registration-error): Replace by the above. Updated all callers.
+ (file-executable-p-18, file-regular-p-18): Remove.
1998-04-05 Richard Stallman <rms@psilocin.gnu.org>
@@ -5066,15 +5066,15 @@
1998-04-03 Andre Spiegel <spiegel@inf.fu-berlin.de>
* vc-hooks.el (vc-parse-cvs-status): New function.
- (vc-fetch-master-properties): Moved cvs status retrieval to
+ (vc-fetch-master-properties): Move cvs status retrieval to
the above.
(vc-backend): If a file is not registered, remember that by setting
the property to `none'.
(vc-name): Use the mechanism of vc-backend to compute the value.
(vc-after-save): Don't access vc-backend property directly.
- * vc.el (vc-next-action-dired): Use dired-do-redisplay. Handle
- window configuration correctly.
+ * vc.el (vc-next-action-dired): Use dired-do-redisplay.
+ Handle window configuration correctly.
(vc-next-action): Save window configuration for vc-next-action-dired.
(vc-finish-logentry): Only kill log buffer if it does exist.
(vc-dired-mode): Rewritten so that it works entirely through
@@ -5082,9 +5082,9 @@
ordinary dired.
(vc-dired-hook): New function.
(vc-state-info, vc-dired-reformat-line): Adapted.
- (vc-dired-update, vc-dired-update-line): Removed.
+ (vc-dired-update, vc-dired-update-line): Remove.
(vc-directory): Rewritten.
- (vc-directory-18): Removed.
+ (vc-directory-18): Remove.
(vc-dired-mark-locked): New function, bound to "*l" in vc-dired-mode.
(vc-do-command): Only compute vc-name if it is really needed.
(vc-fetch-cvs-status): New function.
@@ -5121,7 +5121,7 @@
* help.el: Make hyperlinks for cross-reference info intuited from
*Help* buffer.
- (help-font-lock-keywords): Removed.
+ (help-font-lock-keywords): Remove.
(help-mode-map): Define keys for navigating hyperlinks.
(help-xref-stack, help-xref-stack-item): New permanent-local
variables.
@@ -5138,8 +5138,8 @@
New variables.
(help-setup-xref, help-make-xrefs, help-xref-button)
(help-xref-interned, help-xref-mode, help-follow-mouse)
- (help-xref-go-back, help-go-back, help-follow, help-next-ref): New
- functions.
+ (help-xref-go-back, help-go-back, help-follow, help-next-ref):
+ New functions.
1998-04-02 Richard Stallman <rms@psilocin.gnu.org>
@@ -5216,7 +5216,7 @@
(iswitchb-complete): Use iswitchb-common-match-string rather than
recomputing the value.
(iswitchb-toggle-ignore): Recompute list of buffers.
- (iswitchb-init-XEmacs-trick): Renamed from iswitchb-init-Xemacs-trick.
+ (iswitchb-init-XEmacs-trick): Rename from iswitchb-init-Xemacs-trick.
1998-03-31 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -5300,8 +5300,8 @@
1998-03-25 Simon Marshall <simon@gnu.org>
- * font-lock.el (c-font-lock-keywords-2): Added "sizeof".
- (c++-font-lock-keywords-2): Added "export" and "typename".
+ * font-lock.el (c-font-lock-keywords-2): Add "sizeof".
+ (c++-font-lock-keywords-2): Add "export" and "typename".
* lazy-lock.el (lazy-lock-fontify-after-scroll)
(lazy-lock-fontify-after-trigger): Use new window-end UPDATE arg
@@ -5324,8 +5324,8 @@
1998-03-23 Andreas Schwab <schwab@gnu.org>
- * xt-mouse.el (xterm-mouse-translate, xterm-mouse-event): Replace
- obsolete `concat with integer' by format.
+ * xt-mouse.el (xterm-mouse-translate, xterm-mouse-event):
+ Replace obsolete `concat with integer' by format.
* rsz-mini.el (resize-minibuffer-mode): Make it a proper minor
mode: toggle resize-minibuffer mode when called without argument.
@@ -5341,8 +5341,8 @@
1998-03-22 Johan Vromans <jvromans@squirrel.nl>
- * complete.el (PC-expand-many-files): Apply
- completion-ignored-extensions.
+ * complete.el (PC-expand-many-files):
+ Apply completion-ignored-extensions.
1998-03-21 Richard Stallman <rms@psilocin.gnu.org>
@@ -5361,8 +5361,8 @@
when user tries to check-in, but file on disk has changed.
(vc-do-command): Rewrote doc string. Consider LAST argument
only if FILE is non-nil.
- (vc-add-triple, vc-record-rename, vc-lookup-file): Find
- vc-name-assoc-file based on vc-name of FILE.
+ (vc-add-triple, vc-record-rename, vc-lookup-file):
+ Find vc-name-assoc-file based on vc-name of FILE.
(vc-backend-admin, vc-rename-file): Handle the SCCS PROJECTDIR
feature.
@@ -5406,8 +5406,8 @@
1998-03-18 Dave Love <fx@gnu.org>
- * emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Adjust
- paragraph-start in default filling case so that filling doc
+ * emacs-lisp/lisp-mode.el (lisp-fill-paragraph):
+ Adjust paragraph-start in default filling case so that filling doc
strings works.
1998-03-18 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -5446,9 +5446,9 @@
1998-03-16 Peter Breton <pbreton@ne.mediaone.net>
* generic-x.el: Customize.
- (fvwm-generic-mode): Added new keywords, and .fvwm2rc config file.
- (ini-generic-mode): Changed regexps so that value can contain equal signs.
- (java-manifest-generic-mode): Added new keywords.
+ (fvwm-generic-mode): Add new keywords, and .fvwm2rc config file.
+ (ini-generic-mode): Change regexps so that value can contain equal signs.
+ (java-manifest-generic-mode): Add new keywords.
1998-03-16 Alfred Correira <ACorreir@pervasive-sw.com>
@@ -5496,9 +5496,9 @@
* locate.el (locate-current-line-number): No longer interactive.
* dirtrack.el: Customized.
- (dirtrack-forward-slash): Renamed from `forward-slash'.
- (dirtrack-backward-slash): Renamed from `backward-slash'.
- (dirtrack-replace-slash): Renamed from `replace-slash'.
+ (dirtrack-forward-slash): Rename from `forward-slash'.
+ (dirtrack-backward-slash): Rename from `backward-slash'.
+ (dirtrack-replace-slash): Rename from `replace-slash'.
* emacs-lisp/elp.el (elp-version): Now 3.2.
@@ -5587,17 +5587,17 @@
(undo-start): New args BEG and END.
(undo): If arg or active region, pass args to undo-start.
- * mouse.el (mouse-buffer-menu-maxlen): Renamed from
+ * mouse.el (mouse-buffer-menu-maxlen): Rename from
mouse-menu-buffer-maxlen.
1998-03-10 Eric M. Ludlam <zappo@ultranet.com>
- * checkdoc.el (checkdoc-continue): Removed check for doc string.
+ * checkdoc.el (checkdoc-continue): Remove check for doc string.
(checkdoc-this-string-valid-engine): Smarter keycode check regexp.
1998-03-10 Carsten Dominik <cd@delysid.gnu.org>
- * textmodes/reftex.el (reftex-mode-map): Added keybinding for
+ * textmodes/reftex.el (reftex-mode-map): Add keybinding for
`reftex-mouse-view-crossref' to `S-mouse-2'.
1998-03-09 Carsten Dominik <cd@delysid.gnu.org>
@@ -5634,7 +5634,7 @@
1998-03-08 Carsten Dominik <cd@gnu.org>
* textmodes/reftex.el (reftex-offer-label-menu)
- (reftex-select-item): Removed match-everywhere interpretation.
+ (reftex-select-item): Remove match-everywhere interpretation.
1998-03-08 Carsten Dominik <cd@gnu.org>
@@ -5660,8 +5660,8 @@
(vc-resynch-buffer): When operating on the current buffer, don't use
save-excursion, because that would undo the effects of the above
functions.
- (vc-clear-headers): Fixed regexp.
- (vc-resynch-window): Deleted code that removed vc-find-file-hook
+ (vc-clear-headers): Fix regexp.
+ (vc-resynch-window): Delete code that removed vc-find-file-hook
temporarily. This was unnecessary, because find-file-hooks are not
called when the buffer is reverted.
@@ -5671,7 +5671,7 @@
1998-03-07 Richard Stallman <rms@psilocin.gnu.org>
- * subr.el (read-passwd): Renamed from read-password.
+ * subr.el (read-passwd): Rename from read-password.
New second arg CONFIRM.
* wid-edit.el (widget-choice-value-create): If there is an
@@ -5684,7 +5684,7 @@
* dos-fns.el, find-file.el, follow.el, ispell4.el, shadowfile.el:
* tempo.el, tmm.el, vcursor.el, xscheme.el: Customize.
-1998-03-06 Barry A. Warsaw <cc-mode-help@python.org>
+1998-03-06 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* Release 5.21
@@ -5697,7 +5697,7 @@
* progmodes/cc-engine.el (c-inside-bracelist-p): Fix for enum test.
* progmodes/cc-mode.el (c-initialize-cc-mode):
- Moved require's to top level.
+ Move require's to top level.
* progmodes/cc-cmds.el (c-fill-paragraph):
Bind fill-paragraph-function to nil when calling fill-paragraph,
@@ -5711,8 +5711,8 @@
the same relative position. Fill comment before point if there's
nothing else on the same line. Fill block comments after code a
little better. Try harder to find a good fill-prefix when point
- is on a block comment ender line. Use
- c-Java-javadoc-paragraph-start in block comments in Java mode.
+ is on a block comment ender line.
+ Use c-Java-javadoc-paragraph-start in block comments in Java mode.
Leave block comment ender alone when c-hanging-comment-ender-p is
nil and point is on that line. Detect paragraph-separate in
multiparagraph comments. Fix for bug that may strip the `*' off
@@ -5733,8 +5733,8 @@
always bol. It's always bol when on the top level, however.
Changed cases: 5A.5, 5I, 14A.
- * progmodes/cc-engine.el (c-forward-token-1, c-backward-token-1): New
- functions to move by tokens.
+ * progmodes/cc-engine.el (c-forward-token-1, c-backward-token-1):
+ New functions to move by tokens.
(c-guess-basic-syntax): Fixes for Java 1.1 array initialization
brace lists.
@@ -5791,19 +5791,19 @@
1998-03-06 Kenichi Handa <handa@etl.go.jp>
- * international/titdic-cnv.el (titdic-convert): Use
- set-buffer-multibyte.
+ * international/titdic-cnv.el (titdic-convert):
+ Use set-buffer-multibyte.
* international/quail.el (quail-defrule-internal): New arg REPLACE.
(quail-defrule): Call quail-defrule-internal with REPLACE t.
1998-03-05 Peter Breton <pbreton@ne.mediaone.net>
- * generic.el (generic-mode-ini-file-find-file-hook): Use
- and-s instead of if-s.
- (generic-use-find-file-hook): Changed from defvar to defcustom.
- (generic-lines-to-scan): Changed from defvar to defcustom.
- (generic-find-file-regexp): Changed from defvar to defcustom.
+ * generic.el (generic-mode-ini-file-find-file-hook):
+ Use and-s instead of if-s.
+ (generic-use-find-file-hook): Change from defvar to defcustom.
+ (generic-lines-to-scan): Change from defvar to defcustom.
+ (generic-find-file-regexp): Change from defvar to defcustom.
1998-03-05 Ivar Rummelhoff <ivarr@ifi.uio.no>
@@ -5829,14 +5829,14 @@
configuration if the same command (changing the window
configuration) is applied several times in a row.
- * winner.el (winner-switch): Removed the command
+ * winner.el (winner-switch): Remove the command
`winner-switch' (and the variables connected to it), since
because of the change above, any "switching package" may now
be used without disturbing winner-mode too much.
* winner.el: Use list syntax for key definitions.
- * winner.el (winner-change-fun): Removed the pushnew
+ * winner.el (winner-change-fun): Remove the pushnew
command, so that `cl' will not have to be loaded.
* winner.el (winner-set-conf): Introduced "wrapper" around
@@ -5969,12 +5969,12 @@
* subr.el (sref): Typo in doc-string fixed.
- * international/mule-cmds.el (set-default-coding-systems): Set
- default-file-name-coding-system. Doc-string modified.
+ * international/mule-cmds.el (set-default-coding-systems):
+ Set default-file-name-coding-system. Doc-string modified.
(prefer-coding-system): Doc-string modified.
- * language/japan-util.el (setup-japanese-environment): Set
- default-file-name-coding-system to japanese-iso-8bit.
+ * language/japan-util.el (setup-japanese-environment):
+ Set default-file-name-coding-system to japanese-iso-8bit.
1998-03-02 Richard Stallman <rms@psilocin.gnu.org>
@@ -6004,18 +6004,18 @@
1998-03-01 Peter Breton <pbreton@ne.mediaone.net>
* locate.el (locate-update): New function.
- (locate-current-line-number): Renamed from `current-line'.
+ (locate-current-line-number): Rename from `current-line'.
(locate-default-make-command-line): Use list, not cons.
- (locate): Added a `save-window-excursion' form.
+ (locate): Add a `save-window-excursion' form.
(locate): Used an `apply' form for the start-process call.
(locate-mode): Now has a `revert-buffer-function'.
(locate-do-setup): Now longer deletes window.
(locate-header-face): Use underline, not region.
(locate-update-command): New option.
- (locate-command): Changed from defvar to defcustom.
- (locate-make-command-line): Changed from defvar to defcustom.
- (locate-fcodes-file): Changed from defvar to defcustom.
- (locate-mouse-face): Changed from defvar to defcustom.
+ (locate-command): Change from defvar to defcustom.
+ (locate-make-command-line): Change from defvar to defcustom.
+ (locate-fcodes-file): Change from defvar to defcustom.
+ (locate-mouse-face): Change from defvar to defcustom.
1998-02-28 Richard Stallman <rms@psilocin.gnu.org>
@@ -6048,8 +6048,8 @@
1998-02-27 Karl Heuer <kwzh@gnu.org>
* dired-x.el (dired-do-toggle): Function moved to dired.el.
- * dired.el (dired-do-toggle): Moved here from dired-x.el.
- (dired-mode-map): Changed dired-do-toggle from "T" to "t".
+ * dired.el (dired-do-toggle): Move here from dired-x.el.
+ (dired-mode-map): Change dired-do-toggle from "T" to "t".
1998-02-27 Carsten Dominik <dominik@strw.LeidenUniv.nl>
@@ -6090,21 +6090,21 @@
(custom-save-delete): Use it.
(custom-save-all): Use it.
- * shell.el (shell-dirtrack-mode): Renamed from shell-dirtrack-toggle.
- (dirtrack-mode, shell-dirtrack-toggle): Defined as aliases.
+ * shell.el (shell-dirtrack-mode): Rename from shell-dirtrack-toggle.
+ (dirtrack-mode, shell-dirtrack-toggle): Define as aliases.
1998-02-25 Carsten Dominik <dominik@strw.LeidenUniv.nl>
* textmodes/reftex.el (reftex-toc-mode, reftex-select-label-mode)
(reftex-select-bib-mode): New major modes for RefTeX's special buffers.
(reftex-offer-label-menu): Put selection buffer into
- `reftex-select-label-mode'. Make selection buffer read-only. Use
- `reftex-erase-buffer'.
+ `reftex-select-label-mode'. Make selection buffer read-only.
+ Use `reftex-erase-buffer'.
(reftex-do-citation): Put selection buffer into
- `reftex-select-bib-mode'. Make selection buffer read-only. Use
- `reftex-erase-buffer'. Set `reftex-select-return-marker'.
- (reftex-toc): Put *toc* buffer into reftex-toc-mode. Add
- mouse-face property.
+ `reftex-select-bib-mode'. Make selection buffer read-only.
+ Use `reftex-erase-buffer'. Set `reftex-select-return-marker'.
+ (reftex-toc): Put *toc* buffer into reftex-toc-mode.
+ Add mouse-face property.
(reftex-select-item): Use recursive edit instead of selfmade
command loop. Removed unnecessary local bindings. Changed the
tag for catch, to avoid problems with `exit' tag in
@@ -6126,13 +6126,13 @@
(reftex-select-search-backward, reftex-select-search)
(reftex-select-scroll-up, reftex-select-scroll-down)
(reftex-scroll-other-window, reftex-scroll-other-window-down)
- (reftex-empty-toc-buffer): Removed obsolete functions.
- (reftex-highlight-overlays): Removed obsolete 3rd overlay.
- (reftex-select-label-map, reftex-select-bib-map): Removed obsolete
+ (reftex-empty-toc-buffer): Remove obsolete functions.
+ (reftex-highlight-overlays): Remove obsolete 3rd overlay.
+ (reftex-select-label-map, reftex-select-bib-map): Remove obsolete
bindings, added mouse bindings, `digit-argument',
`negative-argument', `reftex-select-show-insertion-point'.
(reftex-erase-buffer): BUFFER now defaults to current buffer.
- (reftex-label-alist-builtin): Added sidecap packages support.
+ (reftex-label-alist-builtin): Add sidecap packages support.
(reftex-last-follow-point, reftex-select-return-marker): New variables.
(reftex-toc, reftex-select-item): Set `reftex-last-follow-point'.
(reftex-toc-post-command-hook): Use `reftex-last-follow-point'.
@@ -6208,7 +6208,7 @@
* font-lock.el (font-lock-constant-face): Variable and face renamed
from font-lock-reference-face.
- (font-lock-reference-face): Changed value to font-lock-constant-face.
+ (font-lock-reference-face): Change value to font-lock-constant-face.
* add-log.el:
* dired.el:
@@ -6246,12 +6246,12 @@
1998-02-19 Kenichi Handa <handa@etl.go.jp>
* international/mule.el
- (after-insert-file-set-buffer-file-coding-system): Call
- set-buffer-multibyte instead of directly setting
+ (after-insert-file-set-buffer-file-coding-system):
+ Call set-buffer-multibyte instead of directly setting
enable-multibyte-characters to nil.
- * language/china-util.el (setup-chinese-cns-environment): Correct
- the setting of default-input-method.
+ * language/china-util.el (setup-chinese-cns-environment):
+ Correct the setting of default-input-method.
* international/mule-cmds.el (select-safe-coding-system): Kill the
warning buffer before returning.
@@ -6294,7 +6294,7 @@
* info-look.el (info-complete): Rewrite minibuffer completion code.
* info-look.el (info-lookup-minor-mode, turn-on-info-lookup):
- Added minor mode interface.
+ Add minor mode interface.
(info-lookup-minor-mode-string): New variable.
(info-lookup-minor-mode-map): New variable.
@@ -6305,8 +6305,8 @@
(info-lookup-highlight-face): Variables customized.
* info-look.el (info-lookup-alist): No longer customizable.
- (info-lookup-add-help, info-lookup-maybe-add-help): Interface
- functions for adding new modes.
+ (info-lookup-add-help, info-lookup-maybe-add-help):
+ Interface functions for adding new modes.
(info-lookup-add-help*): New function.
(info-lookup-symbol-alist, info-lookup-file-alist): Variables deleted.
This info is specified now by calling info-lookup-maybe-add-help
@@ -6336,10 +6336,10 @@
`parse-partial-sexp' contains the starting pos of the last
literal.
-1998-02-16 Barry A. Warsaw <cc-mode-help@python.org>
+1998-02-16 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
- * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): Set
- imenu-case-fold-search to nil.
+ * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode):
+ Set imenu-case-fold-search to nil.
* progmodes/cc-langs.el (c-postprocess-file-styles): If a file
style or file offsets are set, make the variables local to the
@@ -6352,8 +6352,8 @@
* progmodes/cc-defs.el (c-point): In XEmacs, use scan-lists +
buffer-syntactic-context-depth.
- * progmodes/cc-vars.el (c-enable-xemacs-performance-kludge-p): New
- variable.
+ * progmodes/cc-vars.el (c-enable-xemacs-performance-kludge-p):
+ New variable.
* progmodes/cc-cmds.el, progmodes/cc-engine.el (c-beginning-of-defun)
(c-indent-defun, c-parse-state): Use (c-point 'bod) instead of
@@ -6362,7 +6362,7 @@
* progmodes/cc-align.el (c-semi&comma-no-newlines-before-nonblanks)
(c-semi&comma-no-newlines-for-oneline-inliners): New functions.
- * progmodes/cc-engine.el (c-guess-basic-syntax): Fixed a few byte
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix a few byte
compiler warnings.
* progmodes/cc-cmds.el (c-beginning-of-defun, c-end-of-defun):
@@ -6379,8 +6379,8 @@
* progmodes/cc-langs.el (c-java-method-key): Variable deleted.
- * progmodes/cc-mode.el (java-mode): Set c-method-key to nil. I
- don't think this is necessary for Java, and besides, the old value
+ * progmodes/cc-mode.el (java-mode): Set c-method-key to nil.
+ I don't think this is necessary for Java, and besides, the old value
was inherited from Objective-C which was clearly not right.
* progmodes/cc-cmds.el (c-electric-colon): Don't insert newlines
@@ -6397,10 +6397,10 @@
* progmodes/cc-cmds.el (c-electric-brace): namespace-open and
namespace-close braces can hang.
- * progmodes/cc-defs.el (c-emacs-features): Added autoload cookie.
+ * progmodes/cc-defs.el (c-emacs-features): Add autoload cookie.
- * progmodes/cc-engine.el (c-search-uplist-for-classkey): When
- searching up for a class key, instead of hardcoding the extended
+ * progmodes/cc-engine.el (c-search-uplist-for-classkey):
+ When searching up for a class key, instead of hardcoding the extended
search for "extern", use the new variable c-extra-toplevel-key,
which is language dependent. For C++, this variable includes the
keyword "namespace" which will match C++ namespace introducing
@@ -6415,14 +6415,14 @@
CASE 3: we can now determine whether we're at the beginning of a
cpp macro definition, or inside the middle of one. Set syntax to
- 'cpp-macro in the former case, 'cpp-macro-cont in the latter. In
- both cases, the relpos is the beginning of the macro.
+ 'cpp-macro in the former case, 'cpp-macro-cont in the latter.
+ In both cases, the relpos is the beginning of the macro.
- (c-forward-syntactic-ws): Added code that skips forward over
+ (c-forward-syntactic-ws): Add code that skips forward over
multi-line cpp macros.
- (c-beginning-of-macro): Moved, and made into a defsubst. This
- function can now actually find the beginning of a multi-line C
+ (c-beginning-of-macro): Move, and made into a defsubst.
+ This function can now actually find the beginning of a multi-line C
preprocessor macro.
(c-backward-syntactic-ws): Use c-beginning-of-macro to skip
@@ -6443,8 +6443,8 @@
(c-initialize-on-load): New variable, *not* customized.
* progmodes/cc-styles.el (c-offsets-alist): Three new syntactic
- symbols: innamespace, namespace-open, namespace-close. These
- support C++ namespace blocks.
+ symbols: innamespace, namespace-open, namespace-close.
+ These support C++ namespace blocks.
Also, new syntactic symbol cpp-macro-cont, by default bound to
c-lineup-dont-change. This symbol is assigned to subsequent lines
of a multi-line C preprocess macro definition.
@@ -6483,7 +6483,7 @@
Introduce the new default style "user" which contains all user
customizations.
- * progmodes/cc-vars.el (c-default-style): Renamed from
+ * progmodes/cc-vars.el (c-default-style): Rename from
c-site-default-style.
1998-02-15 Aki Vehtari <Aki.Vehtari@hut.fi>
@@ -6500,13 +6500,13 @@
`bibtex-autokey-before-presentation-function' as it is not hook.
(bibtex-autokey-get-namefield): Remove newlines unconditionally.
- * bibtex.el (bibtex-autokey): Fixed prefix.
+ * bibtex.el (bibtex-autokey): Fix prefix.
(bibtex-user-optional-fields): Better `:type'.
(bibtex-autokey-names): Better `:type' and doc-fix.
(bibtex-mark-active): New function, taking care of Emacs variants.
(bibtex-run-with-idle-timer): Ditto.
(bibtex-mode-map): Change `[(control tab)]' to `[(meta tab)]'.
- (bibtex-autokey-get-yearfield): Changed to accept year when year
+ (bibtex-autokey-get-yearfield): Change to accept year when year
field has field-delimiters. This is quick fix, there might
be better solution.
(bibtex-mode): Don't call idle timer with 0 seconds.
@@ -6514,7 +6514,7 @@
1998-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * bibtex.el (bibtex-autokey-get-yearfield): Fixed problem with
+ * bibtex.el (bibtex-autokey-get-yearfield): Fix problem with
parsing the year field.
* bibtex.el (bibtex-comment-start): Font locking for comments added.
@@ -6526,7 +6526,7 @@
* bibtex.el (bibtex-autokey-get-titles): Non capitalized title words
are used for key generation as well.
(bibtex-member-of-regexp): Case is honored for matches now.
- (bibtex-autokey-titleword-ignore): Added entries provide compatibility
+ (bibtex-autokey-titleword-ignore): Add entries provide compatibility
to former behavior.
* bibtex.el (bibtex-autokey-titleword-ignore): Title words found in
@@ -6561,7 +6561,7 @@
(info-look-completion): New variable.
* info-look.el (info-lookup-symbol-alist):
- Added support for latex-mode, perl-mode, awk-mode, emacs-lisp-mode.
+ Add support for latex-mode, perl-mode, awk-mode, emacs-lisp-mode.
1998-02-13 Richard Stallman <rms@psilocin.gnu.org>
@@ -6575,12 +6575,12 @@
1998-02-12 Dave Love <fx@gnu.org>
- * progmodes/scheme.el (scheme-imenu-generic-expression): Simplify
- regexps.
+ * progmodes/scheme.el (scheme-imenu-generic-expression):
+ Simplify regexps.
(dsssl-imenu-generic-expression): Likewise.
(scheme-mode-variables): Set imenu-syntax-alist.
- (dsssl-mode): Remove `!' from font-lock-defaults. Set
- imenu-syntax-alist.
+ (dsssl-mode): Remove `!' from font-lock-defaults.
+ Set imenu-syntax-alist.
1998-02-11 Richard Stallman <rms@psilocin.gnu.org>
@@ -6667,12 +6667,12 @@
* international/kinsoku.el: Use aref instead of sref.
- * international/mule-cmds.el (find-safe-coding-system): Return
- undecided if FROM == TO.
+ * international/mule-cmds.el (find-safe-coding-system):
+ Return undecided if FROM == TO.
(select-safe-coding-system): Doc-string modified.
- * international/mule-util.el (compose-chars-component): Return
- result as unibyte string.
+ * international/mule-util.el (compose-chars-component):
+ Return result as unibyte string.
(decompose-composite-char): Doc-string modified.
* international/titdic-cnv.el: Many codes re-written to adjust for
@@ -6724,7 +6724,7 @@
1998-02-02 Dan Nicolaescu <done@ece.arizona.edu>
- * progmodes/hideshow.el (hs-special-modes-alist): Enhanced java
+ * progmodes/hideshow.el (hs-special-modes-alist): Enhance java
regexp.
1998-02-02 Richard Stallman <rms@psilocin.gnu.org>
@@ -6736,8 +6736,8 @@
1998-02-01 Richard Stallman <rms@psilocin.gnu.org>
- * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode): Fix
- the doc strings used for the mode flag variable and the keymap.
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-minor-mode):
+ Fix the doc strings used for the mode flag variable and the keymap.
Delete duplicate &optional's.
* emacs-lisp/edebug.el: Doc fixes.
@@ -6752,7 +6752,7 @@
1998-02-01 Dan Nicolaescu <done@ece.arizona.edu>
- * hideshow.el (hs-special-modes-alist): Improved the regexp for java.
+ * hideshow.el (hs-special-modes-alist): Improve the regexp for java.
* isearch.el (isearch-range-invisible): Avoid infinite loop when
search-invisible is nil.
@@ -6784,8 +6784,8 @@
* fortran.el: Various docstring and commentary fixes, including
note of current maintainer.
(fortran-mode): Use imenu-syntax-alist.
- (fortran-imenu-generic-expression): Use
- fortran-continuation-string, not always `+'.
+ (fortran-imenu-generic-expression):
+ Use fortran-continuation-string, not always `+'.
(fortran-font-lock-keywords-1): Include symbol syntax as well as
word, following syntax table changes.
(fortran-imenu-generic-expression): Likewise.
@@ -6793,23 +6793,23 @@
(fortran-mode-version, fortran-startup-message): Delete misleading
variables.
(fortran-mode): Don't use them.
- (fortran-column-ruler-fixed, fortran-column-ruler-tab): Fix
- leading \ which made `0' into null.
+ (fortran-column-ruler-fixed, fortran-column-ruler-tab):
+ Fix leading \ which made `0' into null.
(fortran-join-line): New function and key binding.
(fortran-narrow-to-subprogram): New function and key binding.
(fortran-mode-syntax-table): Make ?., ?_, ?$ symbol, not word.
1998-01-29 Carsten Dominik <dominik@strw.LeidenUniv.nl>
- * textmodes/reftex.el (reftex-toc): Fixed bug with split-window. Using
- split-window instead of split-window-vertically.
- (reftex-reset-mode): Removed obsolete buffer from kill list.
- (reftex-make-and-insert-label-list, reftex-do-citation): Delete
- other windows before displaying selection.
- (reftex-cite-format-builtin): Fixed bug in Chicago format.
+ * textmodes/reftex.el (reftex-toc): Fix bug with split-window.
+ Using split-window instead of split-window-vertically.
+ (reftex-reset-mode): Remove obsolete buffer from kill list.
+ (reftex-make-and-insert-label-list, reftex-do-citation):
+ Delete other windows before displaying selection.
+ (reftex-cite-format-builtin): Fix bug in Chicago format.
(reftex-enlarge-to-fit): New function.
- (reftex-nicify-text): Cut context-string at \item,\\. Changed
- match sequence for efficiency reasons.
+ (reftex-nicify-text): Cut context-string at \item,\\.
+ Changed match sequence for efficiency reasons.
(reftex-parse-from-file): Include files can be ignored with
`reftex-no-include-regexps'.
(reftex-no-include-regexps): New option.
@@ -6819,16 +6819,16 @@
(reftex-where-am-I): Interpret appendix match.
(reftex-init-section-numbers): New arg: appendix.
(reftex-section-number): Treat appendix enumeration.
- (reftex-toc-external): Improved message.
+ (reftex-toc-external): Improve message.
(reftex-compute-ref-cite-tables): Regular expression extended for
appendix.
- (reftex-toc-rescan): Renamed from reftex-toc-redo.
- (reftex-toc-Rescan): Renamed from reftex-toc-Redo.
+ (reftex-toc-rescan): Rename from reftex-toc-redo.
+ (reftex-toc-Rescan): Rename from reftex-toc-Redo.
(reftex-toc-revert): New function.
(reftex-select-external-document): Completion on label prefixes.
- (reftex-find-file-on-path): Added an extra call to
+ (reftex-find-file-on-path): Add an extra call to
expand-file-name for the directory.
- (reftex-locate-bibliography-files): Added expand-file-name call.
+ (reftex-locate-bibliography-files): Add expand-file-name call.
(reftex-guess-label-type): New function.
(reftex-word-before-point): Function removed.
(reftex-reference): Uses reftex-guess-label-type. Changed meaning
@@ -6837,41 +6837,41 @@
(reftex-select-label-maps): Default bindings for TAB, up, down, RET.
(reftex-select-read-string): Now uses completion.
(reftex-make-and-insert-label-list): Prepare for completion.
- (reftex-where-am-I): Fixed bug with input files.
+ (reftex-where-am-I): Fix bug with input files.
(reftex-save-all-document-buffers): New command.
(reftex-select-next-heading): New function.
(reftex-select-previous-heading): New function.
(reftex-select-read-string): New function.
(reftex-offer-label-menu): Handle string value from reftex-select-item.
- (reftex-reference): Fixed bug (missing save-excursion).
- (reftex-toc-map): Added binding for ?n and ?p.
- (reftex-do-citation): Changed to use reftex-default-bibliography.
+ (reftex-reference): Fix bug (missing save-excursion).
+ (reftex-toc-map): Add binding for ?n and ?p.
+ (reftex-do-citation): Change to use reftex-default-bibliography.
(reftex-default-bibliography): New option.
(reftex-find-tex-file): Check for file-name-absolute-p first.
(reftex-format-label-function, reftex-format-ref-function)
(reftex-format-cite-function): New hooks.
(reftex-info): New function.
- (reftex-compute-ref-cite-tables): Removed interactive form.
- (reftex-where-am-I): Removed interactive form.
- (reftex-format-names): Removed interactive form.
+ (reftex-compute-ref-cite-tables): Remove interactive form.
+ (reftex-where-am-I): Remove interactive form.
+ (reftex-format-names): Remove interactive form.
(reftex-vref-is-default): New customization variable.
(reftex-mode-menu): Capitalize citation options.
(reftex-last-cnt): Variable removed.
(reftex-last-data, reftex-last-line): New variables.
(reftex-select-toggle-varioref): New function.
- (reftex-offer-label-menu): Changed mode-line-format for varioref.
+ (reftex-offer-label-menu): Change mode-line-format for varioref.
(reftex-select-label-help): Help string updated.
- (reftex-do-parse): Fixed bug with empty xr list.
+ (reftex-do-parse): Fix bug with empty xr list.
(reftex-view-crossref): Prefix argument interpretation changed.
(reftex-get-offset): New function.
(reftex-label): Remove selection buffer to force update.
(reftex-access-scan-info): Remove selection buffers.
- (reftex-select-external-document): Fixed bug with highest index.
+ (reftex-select-external-document): Fix bug with highest index.
(reftex-label-index-list, reftex-found-list): Variables removed.
(reftex-offer-label-menu, reftex-make-and-insert-label-list)
(reftex-select-item, reftex-citation, reftex-select-label-callback)
- (reftex-bibtex-selection-callback, reftex-select-callback): Changed
- to put the scan data directly into the text property :data,
+ (reftex-bibtex-selection-callback, reftex-select-callback):
+ Change to put the scan data directly into the text property :data,
instead of doing this indirectly with an index-list.
(reftex-make-selection-buffer-name): New function.
(reftex-tie-multifile-symbols): Store master-index-as-property.
@@ -6884,7 +6884,7 @@
(reftex-access-parse-file): `Restore' action now throws an
exception when the file is not found.
(reftex-create-customize-menu): New function.
- (reftex-label): Fixed bug which made naked labels in \footnotes.
+ (reftex-label): Fix bug which made naked labels in \footnotes.
(reftex-select-label-map, reftex-select-bib-map): New keymaps for
the RefTeX Select buffer.
(reftex-select-next, reftex-select-previous, reftex-select-scroll-down)
@@ -6912,7 +6912,7 @@
(reftex-extract-bib-entries-from-thebibliography): New function.
(reftex-format-bibitem): New function.
(reftex-parse-bibitem): New function.
- (reftex-make-desparate-section-regexp): Changed name to
+ (reftex-make-desparate-section-regexp): Change name to
reftex-make-desperate-section-regexp.
(reftex-do-parse, reftex-locate-bibliography-files)
(reftex-string-to-label, reftex-select-external-document)
@@ -6921,7 +6921,7 @@
(reftex-select-search-minibuffer-map, reftex-access-search-path)
(reftex-compute-ref-cite-tables, reftex-recursive-directory-list):
All lambda expressions now quoted with `function'.
- (reftex-view-crossref, reftex-mouse-view-crossref): Fixed bug with
+ (reftex-view-crossref, reftex-mouse-view-crossref): Fix bug with
multiple calls.
(reftex-get-buffer-visiting): Error message changed.
(reftex-select-external-document, reftex-query-label-type)
@@ -6949,7 +6949,7 @@
* progmodes/etags.el (find-tag-marker-ring-length): New variable.
(find-tag-marker-ring): New variable.
(tags-location-ring): New variable replacing tags-location-ring.
- (tags-location-stack): Deleted.
+ (tags-location-stack): Delete.
(tags-table-format-hooks): Doc fix.
(initialize-new-tags-table): Init find-tag-marker-ring,
tags-location-ring.
@@ -6970,13 +6970,13 @@
* international/mule-cmds.el (toggle-enable-multibyte-characters):
Use set-buffer-multibyte.
- (find-safe-coding-system-list-subset-p): Renamed from list-subset-p.
+ (find-safe-coding-system-list-subset-p): Rename from list-subset-p.
The call changed also.
1998-01-28 Kenichi Handa <handa@etl.go.jp>
- * international/titdic-cnv.el (titdic-convert): Set
- enable-multibyte-characters to t after inserting TIT file by
+ * international/titdic-cnv.el (titdic-convert):
+ Set enable-multibyte-characters to t after inserting TIT file by
no-conversion.
(tit-process-body): Do not bind enable-multibyte-characters to
nil.
@@ -6987,9 +6987,9 @@
instead of (` and (,. Implement :filter. Doc fix.
(easy-menu-do-define): Call `easy-menu-create-menu' instead of
`easy-menu-create-keymaps'.
- (easy-menu-create-keymaps): Replaced by `easy-menu-create-menu'.
- (easy-menu-create-menu): New public function. Replaces
- `easy-menu-create-keymaps', but with large changes.
+ (easy-menu-create-keymaps): Replace by `easy-menu-create-menu'.
+ (easy-menu-create-menu): New public function.
+ Replaces `easy-menu-create-keymaps', but with large changes.
(easy-menu-button-prefix): New constant.
(easy-menu-do-add-item, easy-menu-make-symbol): New functions.
(easy-menu-update-button): Doc fix.
@@ -7064,22 +7064,22 @@
* mail/emacsbug.el (emacsbug): Customized.
(report-emacs-bug-no-confirmation):
- Renamed from report-emacs-bug-run-tersely.
+ Rename from report-emacs-bug-run-tersely.
(report-emacs-bug-no-explanations): New option.
(report-emacs-bug): Handle that option.
1998-01-22 Eric Ludlam <zappo@mescaline.gnu.org>
- * mail/rmail.el (rmail-speedbar-buttons): Added speedbar support
+ * mail/rmail.el (rmail-speedbar-buttons): Add speedbar support
for Rmail, including rmail-speedbar-button,
rmail-speedbar-find-file, rmail-move-message-to-folder-on-line,
rmail-speedbar-move-message, and support variables.
- * info.el (Info-speedbar-buttons): Added speedbar support for Info
+ * info.el (Info-speedbar-buttons): Add speedbar support for Info
mode, including Info-speedbar-button, Info-speedbar-menu, and
support variables.
- * gud.el (gud-speedbar-buttons): Added speedbar support for GUD in
+ * gud.el (gud-speedbar-buttons): Add speedbar support for GUD in
general, and for GDB specifically, including
gud-gdb-goto-stackframe, gud-gdb-get-stackframe,
gud-gdb-run-command-fetch-lines, gud-gdb-speedbar-stack-filter,
@@ -7117,10 +7117,10 @@
1998-01-21 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (prefer-coding-system): Call
- update-iso-coding-systems.
+ * international/mule-cmds.el (prefer-coding-system):
+ Call update-iso-coding-systems.
- * international/mule-util.el (string-to-sequence): Adjusted for
+ * international/mule-util.el (string-to-sequence): Adjust for
the change of multibyte-form handling (byte-base to char-base).
(store-substring): Likewise.
(truncate-string-to-width): Likewise.
@@ -7160,13 +7160,13 @@
(set-language-environment-coding-systems): New function.
* international/mule-conf.el: Adjusted for the change of the
- format of make-coding-system's 6th argument. Initialize
- coding-category-iso-7-tight to iso-2022-jp.
+ format of make-coding-system's 6th argument.
+ Initialize coding-category-iso-7-tight to iso-2022-jp.
* international/mule-diag.el (describe-coding-system): Change the
format of showing safe charsets.
- * international/mule-util.el (find-safe-coding-system): Moved to
+ * international/mule-util.el (find-safe-coding-system): Move to
mule-cmds.el.
(detect-coding-with-priority): New macro.
(detect-coding-with-language-environment): New function.
@@ -7222,8 +7222,8 @@
* language/japanese.el, language/korean.el, language/lao.el,
* language/thai.el, language/tibetan.el, language/vietnamese.el:
- Adjusted for the change of make-coding-system. Register
- coding-priority key in
+ Adjusted for the change of make-coding-system.
+ Register coding-priority key in
* language/china-util.el, language/japan-util.el,
* language/korea-util.el, language/tibet-util.el,
@@ -7259,11 +7259,11 @@
(ccl-dump-translate-multiple-map, ccl-dump-translate-single-map):
New functions.
- * international/mule.el (define-character-unification-table): New
- function.
+ * international/mule.el (define-character-unification-table):
+ New function.
- * international/mule-conf.el (oldjis-newjis-jisroman-ascii): New
- character unification table.
+ * international/mule-conf.el (oldjis-newjis-jisroman-ascii):
+ New character unification table.
(standard-character-unification-table-for-decode): Initialize to
`unification-table' property of `oldjis-newjis-jisroman-ascii'.
@@ -7316,8 +7316,8 @@
1998-01-17 Karl Heuer <kwzh@gnu.org>
- * register.el (number-to-register, increment-register): Args
- renamed to match doc.
+ * register.el (number-to-register, increment-register):
+ Args renamed to match doc.
1998-01-17 Dave Love <d.love@dl.ac.uk>
@@ -7430,7 +7430,7 @@
1998-01-04 Richard Stallman <rms@psilocin.gnu.org>
- * subr.el (sref): Defined.
+ * subr.el (sref): Define.
1998-01-03 Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -7493,8 +7493,8 @@
1997-12-22 Kevin Rodgers <kevinr@ihs.com> (tiny change)
- * simple.el (previous-matching-history-element): Bind
- case-fold-search to nil if REGEXP contains an uppercase letter.
+ * simple.el (previous-matching-history-element):
+ Bind case-fold-search to nil if REGEXP contains an uppercase letter.
(previous-matching-history-element, next-matching-history-element):
Doc fixes.
@@ -7521,8 +7521,8 @@
1997-12-21 Richard Stallman <rms@psilocin.gnu.org>
- * msb.el (msb--home-dir): Renamed from msb--home-path.
- (msb--strip-dir): Renamed from msb--strip-path.
+ * msb.el (msb--home-dir): Rename from msb--home-path.
+ (msb--strip-dir): Rename from msb--strip-path.
1997-12-21 Lars Lindberg <Lars.G.Lindberg@capgemini.se>
@@ -7559,8 +7559,8 @@
(ps-generate): Replace (if A B) by (and A B).
(ps-do-despool): Dynamic evaluation for ps-lpr-switches.
Replace (if A B) by (and A B).
- (color-instance-rgb-components, ps-color-values): Replace
- pixel-components by color-instance-rgb-components.
+ (color-instance-rgb-components, ps-color-values):
+ Replace pixel-components by color-instance-rgb-components.
(ps-xemacs-face-kind-p): Replace face-font by face-font-instance,
replace x-font-properties by font-instance-properties.
@@ -7662,8 +7662,8 @@
* progmodes/scheme.el: Define indentation in normal dialect for
let-syntax, letrec-syntax, syntax-rules, call-with-values,
dynamic-wind.
- (scheme-mode-map): Remove lisp-complete-symbol. Add
- uncomment-region menu item.
+ (scheme-mode-map): Remove lisp-complete-symbol.
+ Add uncomment-region menu item.
(scheme-mode-hook, dsssl-mode-hook): Declare customized.
(dsssl-sgml-declaration): Fix customization.
@@ -7681,7 +7681,7 @@
* progmodes/scheme.el, progmodes/tcl-mode.el, progmodes/f90.el,
* progmodes/fortran.el, progmodes/c-mode.el, progmodes/ada-mode.el,
- * cc-mode.el, progmodes/cplus-md.el, progmodes/dcl-mode.el,
+ * progmodes/cc-mode.el, progmodes/cplus-md.el, progmodes/dcl-mode.el,
* progmodes/pascal.el, progmodes/perl-mode.el, textmodes/bibtex.el,
* textmodes/texinfo.el, emacs-lisp/lisp-mode.el, generic.el,
* progmodes/octave-mod.el: Use imenu-case-fold-search.
@@ -7726,7 +7726,7 @@
* cus-edit.el (customize-changed-options): New function.
(customize-version-lessp): New function.
- * facemenu.el (facemenu-remove-face-props): Renamed from
+ * facemenu.el (facemenu-remove-face-props): Rename from
facemenu-remove-props. Remove only face and mouse-face.
(facemenu-menu): Update menu item for facemenu-remove-face-props.
@@ -7853,10 +7853,10 @@
(debugger-mode): Now runs hook `debugger-mode-hook'.
* add-log.el (change-log-add-make-room): New function.
- (change-log-get-method-definition-1): Renamed get-method-definition-1.
- (change-log-get-method-definition): Renamed from get-method-definition.
+ (change-log-get-method-definition-1): Rename get-method-definition-1.
+ (change-log-get-method-definition): Rename from get-method-definition.
(add-log-keep-changes-together): New user variable.
- (add-change-log-entry): Added missing WHOAMI explanation.
+ (add-change-log-entry): Add missing WHOAMI explanation.
Added new functionality according to variable
`add-log-keep-changes-together'.
@@ -7876,8 +7876,8 @@
* progmodes/cc-menus.el: Require imenu.
- * calendar/cal-french.el (french-calendar-special-days-array): New
- function.
+ * calendar/cal-french.el (french-calendar-special-days-array):
+ New function.
(calendar-french-date-string, calendar-goto-french-date): Use that
function instead of the variable.
@@ -7890,8 +7890,8 @@
1997-12-01 Eli Zaretskii <eliz@is.elta.co.il>
- * frame.el (make-frame-names-alist, select-frame-by-name): New
- functions, support frame selection with completion and history.
+ * frame.el (make-frame-names-alist, select-frame-by-name):
+ New functions, support frame selection with completion and history.
(frame-name-history, frame-names-alist): New variables.
1997-11-30 Dave Love <d.love@dl.ac.uk>
@@ -7936,8 +7936,8 @@
1997-11-24 Michael Kifer <kifer@cs.sunysb.edu>
- * ediff-vers.el (cvs-run-ediff-on-file-descriptor): Set
- default-directory.
+ * ediff-vers.el (cvs-run-ediff-on-file-descriptor):
+ Set default-directory.
(cvs-run-ediff-on-file-descriptor): Use ediff-buffers when
type=MODIFIED.
* ediff-init.el: Commented out ediff-set-face-pixmap.
@@ -7948,7 +7948,7 @@
1997-11-24 Simon Marshall <simon@gnu.org>
- * menu-bar.el (menu-bar-describe-menu): Fixed duplicate KEYs.
+ * menu-bar.el (menu-bar-describe-menu): Fix duplicate KEYs.
1997-11-24 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -8062,7 +8062,7 @@
1997-11-20 Karl Heuer <kwzh@gnu.org>
- * international/mule-cmds.el (set-input-method): Renamed from
+ * international/mule-cmds.el (set-input-method): Rename from
select-input-method.
1997-11-20 Eli Zaretskii <eliz@is.elta.co.il>
@@ -8200,15 +8200,15 @@
* gnus/gnus-mule.el (gnus-mule-initialize): Do not set
nntp-coding-system-for-read and nntp-coding-system-for-write.
- * gnus/gnus-start.el (gnus-read-descriptions-file): Decode
- description if necessary.
+ * gnus/gnus-start.el (gnus-read-descriptions-file):
+ Decode description if necessary.
* gnus/nntp.el (nntp-coding-system-for-read): Set default value to
binary.
(nntp-coding-system-for-write): Likewise.
- * international/mule-cmds.el (set-language-environment): Run
- exit-language-environment-hook before calling `exit-function'
+ * international/mule-cmds.el (set-language-environment):
+ Run exit-language-environment-hook before calling `exit-function'
which is specified for the language environment.
* language/european.el: Add "Upper Sorbian" and "Lower Sorbian" in
@@ -8267,7 +8267,7 @@
(ediff-update-markers-in-dir-meta-buffer): New, for fast redisplay
of meta buffer.
(ediff-update-meta-buffer, ediff-redraw-directory-group-buffer)
- (ediff-previous-meta-overlay-start, ediff-next-meta-item): Changed to
+ (ediff-previous-meta-overlay-start, ediff-next-meta-item): Change to
support the above.
(ediff-insert-session-info-in-meta-buffer)
(diff-replace-session-status-in-meta-buffer)
@@ -8315,8 +8315,8 @@
1997-10-31 Dave Love <d.love@dl.ac.uk>
- * progmodes/fortran.el (fortran-imenu-generic-expression): New
- variable.
+ * progmodes/fortran.el (fortran-imenu-generic-expression):
+ New variable.
(fortran-mode): Use it.
1997-10-31 Richard Stallman <rms@gnu.org>
@@ -8327,8 +8327,8 @@
1997-10-28 Simon Marshall <simon@gnu.org>
* font-lock.el (font-lock-keywords): Doc fix.
- (font-lock-match-c++-style-declaration-item-and-skip-to-next): Allow
- any number of ::foo suffixes in declarative items.
+ (font-lock-match-c++-style-declaration-item-and-skip-to-next):
+ Allow any number of ::foo suffixes in declarative items.
* lazy-lock.el (lazy-lock-fontify-after-defer): Check each buffer to
make sure it still (a) exists and (b) has Lazy Lock mode turned on.
@@ -8369,18 +8369,18 @@
(octave-comment-indent): Handle magic comments correctly.
(calculate-octave-indent): Handle magic comments correctly.
- * progmodes/octave-mod.el (octave-abbrev-table): Added abbrevs for
+ * progmodes/octave-mod.el (octave-abbrev-table): Add abbrevs for
switch, case, otherwise, and endswitch.
- (octave-begin-keywords): Added switch.
- (octave-else-keywords): Added case and otherwise.
- (octave-end-keywords): Added endswitch.
- (octave-block-match-alist): Added an entry for switch syntax.
- (calculate-octave-indent): Added support for switch syntax.
+ (octave-begin-keywords): Add switch.
+ (octave-else-keywords): Add case and otherwise.
+ (octave-end-keywords): Add endswitch.
+ (octave-block-match-alist): Add an entry for switch syntax.
+ (calculate-octave-indent): Add support for switch syntax.
(octave-block-end-offset): New function.
(octave-comment-indent): Fix a typo.
- * progmodes/octave-mod.el (octave-block-match-alist): Move
- `otherwise' to right after `case' to have octave-close-block()
+ * progmodes/octave-mod.el (octave-block-match-alist):
+ Move `otherwise' to right after `case' to have octave-close-block()
correctly close a `switch' block by `endswitch'.
1997-10-24 Carsten Dominik <dominik@strw.LeidenUniv.nl>
@@ -8388,16 +8388,16 @@
* reftex.el: The menu now used toggle and radio for some items.
(reftex-default-context-regexps): `caption' now prefers the
optional short caption.
- (reftex-offer-label-menu): Fixed bug which could kill master
+ (reftex-offer-label-menu): Fix bug which could kill master
buffer of external document.
- (reftex-select-item, reftex-get-buffer-visiting): Compatibility
- code works now the other way round.
+ (reftex-select-item, reftex-get-buffer-visiting):
+ Compatibility code works now the other way round.
(reftex-select-external-document): Now gives a message when no
external documents are available.
(reftex-find-duplicate-labels): Single key strokes to exit or to
do a query replace. Made more user friendly in general.
- (reftex-section-levels, reftex-default-context-regexps): Move
- definition of these variables to configuration section.
+ (reftex-section-levels, reftex-default-context-regexps):
+ Move definition of these variables to configuration section.
1997-10-24 Richard Stallman <rms@gnu.org>
@@ -8485,16 +8485,16 @@
* international/mule-util.el (find-safe-coding-system): New function.
- * international/mule.el (load-with-code-conversion): Update
- preloaded-file-list, bind load-file-name and
+ * international/mule.el (load-with-code-conversion):
+ Update preloaded-file-list, bind load-file-name and
inhibit-frame-unsplittable properly.
(make-char): Make it a function. Set it byte-compile property to
optimize byte-compiled codes.
(make-coding-system): New optional arg charsets. Set property
`safe-charsets' of the coding system to it.
- * international/quail.el (quail-require-guidance-buf): Adjusted
- for the change of input-method-verbose-flag.
+ * international/quail.el (quail-require-guidance-buf):
+ Adjust for the change of input-method-verbose-flag.
* language/chinese.el: Give proper SAFE-CHARSET argument in each
call of make-coding-system.
@@ -8523,7 +8523,7 @@
* language/korean.el: Give proper SAFE-CHARSET argument in each
call of make-coding-system. Set exit-function for language
environment "Korean" to exit-korean-environment.
- (setup-korean-environment): Moved to korean.el.
+ (setup-korean-environment): Move to korean.el.
* language/lao.el: Give proper SAFE-CHARSET argument in each call
of make-coding-system.
@@ -8539,8 +8539,8 @@
* man.el (Man-getpage-in-background): Bind inhibit-eol-conversion
to t before calling start-process or call-process.
- (Man-softhyphen-to-minus): New function. If
- enable-multibyte-characters is non-nil, convert the code 0255 only
+ (Man-softhyphen-to-minus): New function.
+ If enable-multibyte-characters is non-nil, convert the code 0255 only
when it is not a part of a multibyte characters.
(Man-fontify-manpage): Call Man-softhyphen-to-minus.
(Man-cleanup-manpage): Likewise.
@@ -8568,7 +8568,7 @@
(lm-insert-at-column): Use FORCE arg of move-to-column.
* emulation/tpu-edt.el (tpu-arrange-rectangle): Likewise.
-1997-10-23 Barry A. Warsaw <cc-mode-help@python.org>
+1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
Merge in Release 5.19 of cc-mode.
@@ -8593,14 +8593,14 @@
comment-column and there is non-whitespace preceding this on the
current line.
- * progmodes/cc-mode.el (c-submit-bug-report): Remove
- c-recognize-knr-p. Add c-comment-continuation-stars.
+ * progmodes/cc-mode.el (c-submit-bug-report):
+ Remove c-recognize-knr-p. Add c-comment-continuation-stars.
* progmodes/cc-styles.el (c-initialize-builtin-style):
Only use copy-tree if it is funcall-able. This is the right patch, and
was given by Erik Naggum <erik@naggum.no>
-1997-10-23 Barry A. Warsaw <cc-mode-help@python.org>
+1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-menus.el (cc-imenu-c-prototype-macro-regexp): New var.
@@ -8608,7 +8608,7 @@
Given by jan.dubois@ibm.net (Jan Dubois).
* progmodes/cc-menus.el (cc-imenu-java-generic-expression):
- Removed test for declaration
+ Remove test for declaration
statements. Patch given by Ake Stenhoff <etxaksf@aom.ericsson.se>, as
forwarded to me by RMS.
@@ -8619,7 +8619,7 @@
to cc-imenu-objc-function to enable Imenu support for Objective-C.
Contributed by Masatake (jet) YAMATO.
-1997-10-23 Barry A. Warsaw <cc-mode-help@python.org>
+1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-styles.el (c-initialize-builtin-style):
Use existing copy-tree if it's defined.
@@ -8628,7 +8628,7 @@
c-offsets-alist must be copied recursively. Use copy-tree solution
given by Simon Marshall <simon@gnu.org>.
-1997-10-23 Barry A. Warsaw <cc-mode-help@python.org>
+1997-10-23 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-cmds.el (c-beginning-of-statement):
Fixes in sentence movement to properly
@@ -8660,8 +8660,8 @@
1997-10-22 Kenichi Handa <handa@etl.go.jp>
- * gnus/gnus-art.el (gnus-show-traditional-method): Call
- gnus-mule-decode-article only when enable-multibyte-characters is
+ * gnus/gnus-art.el (gnus-show-traditional-method):
+ Call gnus-mule-decode-article only when enable-multibyte-characters is
non-nil.
* gnus/gnus-ems.el (gnus-ems-redefine): Require `gnus-mule' only
@@ -8675,10 +8675,10 @@
1997-10-21 Kenichi Handa <handa@etl.go.jp>
- * international/mule-diag.el (describe-coding-system): Print
- information about coding system properties, post-read-conversion
+ * international/mule-diag.el (describe-coding-system):
+ Print information about coding system properties, post-read-conversion
and pre-write-conversion.
- (print-coding-system-briefly): Adjusted for the change in mule.el.
+ (print-coding-system-briefly): Adjust for the change in mule.el.
(describe-current-coding-system): Likewise.
(print-coding-system): Likewise.
@@ -8688,9 +8688,9 @@
(2) Properties of a coding system (except for `coding-system' and
`eol-type') is embedded in PLIST slot of coding-spec vector.
(coding-spec-plist-idx): Initialize to 3.
- (coding-system-spec-ref): Deleted.
- (coding-system-spec): Moved from src/coding.c.
- (coding-system-type): Adjusted for the above change.
+ (coding-system-spec-ref): Delete.
+ (coding-system-spec): Move from src/coding.c.
+ (coding-system-type): Adjust for the above change.
(coding-system-mnemonic): Likewise.
(coding-system-doc-string): Likewise.
(coding-system-flags): Likewise.
@@ -8698,37 +8698,37 @@
(coding-system-category): Likewise.
(coding-system-get, coding-system-put, coding-system-category):
New functions.
- (coding-system-base): Moved from mule-util.el and adjusted for the
+ (coding-system-base): Move from mule-util.el and adjusted for the
above change.
(coding-system-parent): Make it obsolete alias of
coding-system-base.
- (make-subsidiary-coding-system): Adjusted for the above change.
+ (make-subsidiary-coding-system): Adjust for the above change.
Update coding-system-list and coding-system-alist.
(make-coding-system): Likewise.
(define-coding-system-alias): Likewise.
(set-buffer-file-coding-system): Typo in doc-string fixed.
- (after-insert-file-set-buffer-file-coding-system): Change
- enable-multibyte-characters only when
+ (after-insert-file-set-buffer-file-coding-system):
+ Change enable-multibyte-characters only when
find-new-buffer-file-coding-system returns non-nil value.
- (find-new-buffer-file-coding-system): Adjusted for the above change.
+ (find-new-buffer-file-coding-system): Adjust for the above change.
- * international/mule-cmds.el (read-multilingual-string): Use
- current-input-method prior to default-input-method. Don't bind
+ * international/mule-cmds.el (read-multilingual-string):
+ Use current-input-method prior to default-input-method. Don't bind
current-input-method by `let', instead, activate the specified
input method in the current buffer temporarily.
* international/mule-conf.el: Change the way of making coding
systems no-conversion and undecided.
- * international/mule-util.el (coding-system-base): Moved to
+ * international/mule-util.el (coding-system-base): Move to
mule.el.
(coding-system-post-read-conversion):
Use the new function coding-system-get.
(coding-system-pre-write-conversion): Likewise.
(coding-system-unification-table-for-decode): Likewise.
(coding-system-unification-table-for-encode): Likewise.
- (coding-system-list): Adjusted for the change in mule.el.
- (coding-system-plist): Deleted.
+ (coding-system-list): Adjust for the change in mule.el.
+ (coding-system-plist): Delete.
(coding-system-equal): Do not use coding-system-plist.
* language/chinese.el: Use coding-system-put to set coding system
@@ -8748,8 +8748,8 @@
* language/thai.el: Use coding-system-put to set coding system
properties, post-read-conversion and pre-write-conversion.
- * language/tibet-util.el (tibetan-post-read-conversion): Return
- the length of converted region.
+ * language/tibet-util.el (tibetan-post-read-conversion):
+ Return the length of converted region.
* language/tibetan.el: Use coding-system-put to set coding system
properties, post-read-conversion and pre-write-conversion.
@@ -8770,8 +8770,8 @@
1997-10-21 Tomohiko Morioka <morioka@jaist.ac.jp>
- * gnus/nnfolder.el (nnfolder-request-list): Bind
- file-name-coding-system to binary.
+ * gnus/nnfolder.el (nnfolder-request-list):
+ Bind file-name-coding-system to binary.
(nnfolder-possibly-change-group): Likewise.
* gnus/nnml.el (nnml-retrieve-headers): Likewise.
@@ -8807,13 +8807,13 @@
gnus-mule-initialize and setting coding system for nntp.
(gnus-mule-select-coding-system): Get a coding system of the
current newsgroup from gnus-summary-buffer.
- (gnus-mule-decode-summary): Deleted.
+ (gnus-mule-decode-summary): Delete.
(gnus-mule-initialize): Add-hook gnus-mule-select-coding-system to
gnus-parse-headers-hook. Don't add-hook gnus-mule-decode-summary
and gnus-mule-decode-article. Don't set process coding system for
nntp stream to 'no-conversion, instead set
- nntp-coding-system-for-read to 'binary. Set
- nnheader-file-coding-system and nnmail-file-coding-system to
+ nntp-coding-system-for-read to 'binary.
+ Set nnheader-file-coding-system and nnmail-file-coding-system to
'binary.
1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -8866,8 +8866,8 @@
* nnml.el (nnml-directory): Doc fix.
- * gnus-topic.el (gnus-topic-make-menu-bar): Added
- gnus-topic-edit-parameters.
+ * gnus-topic.el (gnus-topic-make-menu-bar):
+ Add gnus-topic-edit-parameters.
1997-10-21 Jay Sachs <sachs@interactive.net>
@@ -8891,8 +8891,8 @@
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Escape
- newlines.
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format):
+ Escape newlines.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -8901,7 +8901,7 @@
1997-10-21 Danny Siu <dsiu@adobe.com>
* smiley.el (smiley-buffer): Make smiley case sensitive.
- (smiley-deformed-regexp-alist): Added more regexp for happy smiley.
+ (smiley-deformed-regexp-alist): Add more regexp for happy smiley.
(smiley-nosey-regexp-alist): Same as above.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -8919,9 +8919,9 @@
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * nntp.el (nntp-nov-gap): Changed default.
+ * nntp.el (nntp-nov-gap): Change default.
- * gnus-nocem.el (gnus-nocem-issuers): Fixed names.
+ * gnus-nocem.el (gnus-nocem-issuers): Fix names.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -8969,8 +8969,8 @@
* gnus.el (gnus-simplify-mode-line): Use varying formats.
- * gnus-xmas.el (gnus-xmas-group-remove-excess-properties): Removed.
- (gnus-xmas-topic-remove-excess-properties): Removed.
+ * gnus-xmas.el (gnus-xmas-group-remove-excess-properties): Remove.
+ (gnus-xmas-topic-remove-excess-properties): Remove.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -8993,8 +8993,8 @@
1997-10-21 Michael R. Cook <mcook@cognex.com>
- * gnus-topic.el (gnus-topic-toggle-display-empty-topics): List
- groups.
+ * gnus-topic.el (gnus-topic-toggle-display-empty-topics):
+ List groups.
1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -9013,8 +9013,8 @@
* gnus-start.el (gnus-check-first-time-used): Force reading the
active file the first time Gnus is used.
- * gnus-group.el (gnus-group-set-mode-line): Conditionalize
- modified.
+ * gnus-group.el (gnus-group-set-mode-line):
+ Conditionalize modified.
* gnus-ems.el (gnus-mode-line-modified): New variable.
@@ -9053,9 +9053,9 @@
* message.el (message-clone-locals): Made into own function.
- * gnus.el (gnus-select-method): Changed default.
+ * gnus.el (gnus-select-method): Change default.
- * gnus-start.el (gnus-read-active-file): Changed default to
+ * gnus-start.el (gnus-read-active-file): Change default to
`some'.
1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -9235,12 +9235,12 @@
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-sum.el (t): Moved pop article keystroke.
+ * gnus-sum.el (t): Move pop article keystroke.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * nnmail.el (nnmail-search-unix-mail-delim-backward): Allow
- several "From "'s.
+ * nnmail.el (nnmail-search-unix-mail-delim-backward):
+ Allow several "From "'s.
(nnmail-search-unix-mail-delim): Ditto.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9283,8 +9283,8 @@
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-sum.el (gnus-summary-limit-children): Typo. Wouldn't
- marked NoCeM'ed out messages as read.
+ * gnus-sum.el (gnus-summary-limit-children): Typo.
+ Wouldn't marked NoCeM'ed out messages as read.
1997-10-21 Darren Stalder <torin@daft.com>
@@ -9300,8 +9300,8 @@
1997-10-21 Danny Siu <dsiu@adobe.com>
- * gnus-picon.el (gnus-group-display-picons): Use
- gnus-group-real-name so that picons for foreign groups display
+ * gnus-picon.el (gnus-group-display-picons):
+ Use gnus-group-real-name so that picons for foreign groups display
correctly.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9364,8 +9364,8 @@
1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus-cite.el (gnus-cite-attribution-prefix): Recognize
- Microsoft/Agent style attribution lines.
+ * gnus-cite.el (gnus-cite-attribution-prefix):
+ Recognize Microsoft/Agent style attribution lines.
(gnus-cite-attribution-suffix): Ditto.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9375,8 +9375,8 @@
(gnus-cache-possibly-alter-active): Test statement removed.
(gnus-cache-articles-in-group): Would destroy hashtb.
- * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): Don't
- mark everything as read.
+ * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read):
+ Don't mark everything as read.
* gnus-cite.el (gnus-article-fill-cited-article): Nix out
gnus-cite-article.
@@ -9398,9 +9398,9 @@
* nnml.el (nnml-update-file-alist): Allow forcing.
- * nnheaderxm.el (nnheader-xmas-find-file-noselect): Removed.
- (nnheader-xmas-cancel-timer): Removed.
- (nnheader-xmas-cancel-function-timers): Removed.
+ * nnheaderxm.el (nnheader-xmas-find-file-noselect): Remove.
+ (nnheader-xmas-cancel-timer): Remove.
+ (nnheader-xmas-cancel-function-timers): Remove.
1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -9411,7 +9411,7 @@
* message.el (message-set-auto-save-file-name): Create unique auto
save file names.
- * gnus-topic.el (gnus-topic-tallied-groups): Removed.
+ * gnus-topic.el (gnus-topic-tallied-groups): Remove.
(gnus-topic-prepare-topic): Output right number of articles in
each sub-topic.
@@ -9451,23 +9451,23 @@
need be displayed.
(gnus-picons-lock): Function deleted.
(gnus-picons-remove): Don't use it. New way of locking.
- (gnus-picons-next-job-internal): New way of locking. Handle
- new tag 'bar.
+ (gnus-picons-next-job-internal): New way of locking.
+ Handle new tag 'bar.
(gnus-picons-next-job): New way of locking.
(gnus-picons-buffer): Variable deleted.
- (gnus-picons-remove-all): Modified accordingly.
+ (gnus-picons-remove-all): Modify accordingly.
(gnus-group-annotations-lock): Variable deleted.
(gnus-article-annotations-lock): Variable deleted.
(gnus-x-face-annotations-lock): Variable deleted.
- (gnus-picons-news-directories): Renamed, was
+ (gnus-picons-news-directories): Rename, was
gnus-picons-news-directory.
(gnus-picons-url-retrieve): Do not change url-show-status.
(gnus-picons-clear-cache): Also clear gnus-picons-url-alist.
1997-10-21 Michael R. Cook <mcook@cognex.com>
- * gnus-topic.el (gnus-topic-toggle-display-empty-topics): New
- function.
+ * gnus-topic.el (gnus-topic-toggle-display-empty-topics):
+ New function.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9504,7 +9504,7 @@
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
- * gnus-topic.el (gnus-topic-create-topic): Added doc.
+ * gnus-topic.el (gnus-topic-create-topic): Add doc.
* gnus-sum.el (gnus-summary-refer-article): Insert sparse
non-displayed articles properly.
@@ -9536,7 +9536,7 @@
(gnus-article-display-picons): Use the job queue if using the network.
(gnus-group-display-picons): Ditto.
(gnus-picons-make-path): Function deleted.
- (gnus-picons-lookup-internal): Modified accordingly.
+ (gnus-picons-lookup-internal): Modify accordingly.
(gnus-picons-lookup-user-internal): Take the LETs out of the loops.
(gnus-picons-lookup-pairs): Take constant calculation outside of loop.
(gnus-picons-display-picon-or-name): Use COND instead of nested IFs.
@@ -9577,23 +9577,23 @@
(gnus-picons-users-image-alist): New variable.
(gnus-picons-retrieve-user-callback): Use it.
Added support for network retrieval of picons.
- (gnus-picons-map): Removed.
- (gnus-picons-remove): Removed case to handle processes.
+ (gnus-picons-map): Remove.
+ (gnus-picons-remove): Remove case to handle processes.
(gnus-picons-processes-alist): New variable.
- (gnus-picons-x-face-sentinel): Simplified. Use processes alist.
+ (gnus-picons-x-face-sentinel): Simplify. Use processes alist.
(gnus-picons-display-x-face): Explicitly request an xface image.
Always call gnus-picons-prepare-for-annotations. Use processes alist.
(gnus-picons-lookup-internal): New function.
(gnus-picons-lookup): Use it.
(gnus-picons-lookup-user-internal): Ditto.
(gnus-picons-display-picon-or-name): No more xface-p argument.
- (gnus-picons-try-suffixes): Removed.
+ (gnus-picons-try-suffixes): Remove.
(gnus-picons-try-face): New function. Does the caching in
gnus-picons-glyph-alist.
(gnus-picons-try-to-find-face): Take a glyph argument instead of a
path. No more xface-p argument. Only use one annotation even if
gnus-picons-display-as-address.
- (gnus-picons-toggle-extent): Changed into an annotation action.
+ (gnus-picons-toggle-extent): Change into an annotation action.
1997-10-21 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -9601,8 +9601,8 @@
1997-10-21 Kim-Minh Kaplan <kimminh.kaplan@utopia.eunet.fr>
- * gnus-picon.el (gnus-picons-prepare-for-annotations): New
- function, and many changes.
+ * gnus-picon.el (gnus-picons-prepare-for-annotations):
+ New function, and many changes.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9671,8 +9671,8 @@
* gnus-cache.el (gnus-cache-move-cache): Allow entering directory
name.
- * nntp.el (nntp-telnet-command, nntp-telnet-switches): New
- variables.
+ * nntp.el (nntp-telnet-command, nntp-telnet-switches):
+ New variables.
* gnus-score.el (gnus-summary-increase-score): Refuse illegal
match types.
@@ -9684,7 +9684,7 @@
1997-10-21 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus-ems.el (gnus-article-x-face-command): Removed bogus
+ * gnus-ems.el (gnus-article-x-face-command): Remove bogus
declaration.
1997-10-21 Paul Franklin <paul@cs.washington.edu>
@@ -9758,8 +9758,8 @@
* message.el (message-cancel-news): Only say we cancel if we
cancel.
- * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Deactivate
- mark.
+ * gnus-msg.el (gnus-summary-mail-crosspost-complaint):
+ Deactivate mark.
1997-10-21 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -9842,7 +9842,7 @@
(reftex-make-master-buffer-hook): Hook removed.
(reftex-insert-buffer-or-file): Function removed.
(reftex-parse-document): Function adapted to new parser.
- (reftex-access-scan-info): Changed to fit new parser. Now detects
+ (reftex-access-scan-info): Change to fit new parser. Now detects
changes in label-alist related variables automatically.
(reftex-parse-one, reftex-parse-all): New functions.
(reftex-all-document-files): New function.
@@ -9872,8 +9872,8 @@
(reftex-find-nearby-label): Function removed.
(reftex-scan-buffer-for-labels): Function removed.
(reftex-section-info): New function.
- (reftex-nth-parens-substring): Renamed to reftex-nth-arg. Return
- nil when not enough args are present.
+ (reftex-nth-parens-substring): Rename to reftex-nth-arg.
+ Return nil when not enough args are present.
(reftex-move-over-touching-args): New function.
(reftex-where-am-I): New function.
(reftex-nth-arg-wrapper): New function.
@@ -9888,7 +9888,7 @@
several backup methods.
(reftex-citation): Recursive edit moved to `e' key.
(reftex-scan-buffer): Function removed.
- (reftex-get-bibfile-list): Changed to work with chapterbib
+ (reftex-get-bibfile-list): Change to work with chapterbib
package.
(reftex-find-tex-file): New function.
(reftex-find-files-on-path): Now first looks for file with
@@ -9897,7 +9897,7 @@
reftex-do-citation.
(reftex-do-citation): Recursive edit now on `e' key.
(reftex-what-macro): Allow white space between macro arguments.
- (reftex-allow-for-ctrl-m): Renamed to
+ (reftex-allow-for-ctrl-m): Rename to
`reftex-make-regexp-allow-for-ctrl-m'.
(reftex-nearest-match): New function.
(reftex-auto-mode-alist): New function.
@@ -9909,8 +9909,8 @@
(reftex-parse-args): New function.
(easy-menu-define): Menu extended. Some parts are now computed.
from the user options.
- (reftex-move-to-next-arg, reftex-move-to-previous-arg): New
- functions. Now we can parse macros with distributed arguments.
+ (reftex-move-to-next-arg, reftex-move-to-previous-arg):
+ New functions. Now we can parse macros with distributed arguments.
(reftex-goto-label): Function removed.
(reftex-position-cursor): Function removed.
(reftex-item): Function removed.
@@ -9944,8 +9944,8 @@
* iso-insert.el: Add autoloads for `8859-1-map'.
- * cus-edit.el (custom-group-value-create): Use
- `custom-group-visibility' instead of `group-visibility'.
+ * cus-edit.el (custom-group-value-create):
+ Use `custom-group-visibility' instead of `group-visibility'.
1997-10-19 Richard Stallman <rms@gnu.org>
@@ -10018,7 +10018,7 @@
(double-map): Add customize support.
(double-prefix-only): Ditto.
- * textmodes/nroff-mode.el (nroff): Moved from `editing' to `wp'.
+ * textmodes/nroff-mode.el (nroff): Move from `editing' to `wp'.
* wid-edit.el (variable-link): New widget.
(widget-variable-link-action): New function.
@@ -10033,7 +10033,7 @@
(view-highlight-face, view-scroll-auto-exit)
(view-try-extend-at-buffer-end)
(view-remove-frame-by-deleting, view-mode-hook):
- Defined by defcustom instead of by defvar.
+ Define by defcustom instead of by defvar.
(view-mode-enter): Install exit-action also when view-mode is
already on. Small rewrite using unless.
(view-mode, view-mode-exit, view-scroll-lines, view-really-at-end)
@@ -10109,8 +10109,8 @@
* comint.el (comint-regexp-arg): Likewise.
* term.el (term-regexp-arg): Likewise.
- * simple.el (repeat-complex-command): Bind
- minibuffer-history-sexp-flag to the minibuffer depth.
+ * simple.el (repeat-complex-command):
+ Bind minibuffer-history-sexp-flag to the minibuffer depth.
(next-history-element): Compare minibuffer-history-sexp-flag
against the current minibuffer depth to verify its validity.
(previous-matching-history-element): Likewise.
@@ -10138,7 +10138,7 @@
* finder.el (finder-mode-map): Bind [mouse-2].
(finder-compile-keywords): Match compressed file names, but don't
put compression extension in the output.
- (finder-find-library): Deleted.
+ (finder-find-library): Delete.
(finder-commentary): Use locate-library, not finder-find-library.
(finder-mouse-select): New function.
(finder-summary): Mention mouse binding.
@@ -10147,7 +10147,7 @@
1997-09-30 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc-hooks.el (vc-find-cvs-master): Added missing `throw' for
+ * vc-hooks.el (vc-find-cvs-master): Add missing `throw' for
the case when TIMESTAMP is arbitrary text.
1997-09-30 Hrvoje Niksic <hniksic@srce.hr>
@@ -10180,8 +10180,8 @@
* ediff-init.el: Added documentation to face-variables.
- * ediff-util.el (ediff-next-difference, ediff-previous-difference): Use
- ediff-merge-region-is-non-clash and don't compute fine diffs when
+ * ediff-util.el (ediff-next-difference, ediff-previous-difference):
+ Use ediff-merge-region-is-non-clash and don't compute fine diffs when
skipping non-clash regions.
* ediff-merg.el (ediff-merge-region-is-non-clash): New function.
@@ -10316,12 +10316,12 @@
1997-09-15 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
- * mule.el (find-new-buffer-file-coding-system): Reflect
- text coding part of default-buffer-file-coding-system to
+ * mule.el (find-new-buffer-file-coding-system):
+ Reflect text coding part of default-buffer-file-coding-system to
buffer-file-coding-system when buffer-file-coding-system is
not locally set and ASCII only text is read.
-1997-09-15 Barry A. Warsaw <cc-mode-help@python.org>
+1997-09-15 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-styles.el (c-initialize-builtin-style):
Copy the whole tree instead of just copy-sequence.
@@ -10335,11 +10335,11 @@
1997-09-15 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
- * international/quail.el (quail-completion-list-translations): Fix
- and simplify generation of translation list.
+ * international/quail.el (quail-completion-list-translations):
+ Fix and simplify generation of translation list.
- * international/titdic-cnv.el (tit-process-header): Convert
- argument of KEYPROMPT if it contains an escape.
+ * international/titdic-cnv.el (tit-process-header):
+ Convert argument of KEYPROMPT if it contains an escape.
(tit-process-body): Handle trailing whitespace and multiple spaces
between phrases.
@@ -10483,10 +10483,10 @@
1997-09-12 Michael Kifer <kifer@cs.sunysb.edu>
- * viper-keym.el (viper-want-ctl-h-help): Updated doc string.
+ * viper-keym.el (viper-want-ctl-h-help): Update doc string.
(viper-vi-basic-map, viper-insert-basic-map, viper-replace-map):
- Added binding for backspace.
- * viper-cmd.el (viper-adjust-keys-for): Separated backspace and C-h.
+ Add binding for backspace.
+ * viper-cmd.el (viper-adjust-keys-for): Separate backspace and C-h.
1997-09-12 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -10505,7 +10505,7 @@
1997-09-12 Inge Frick <inge@nada.kth.se>
- * compile.el (compilation-parse-errors): Fixed two bugs that
+ * compile.el (compilation-parse-errors): Fix two bugs that
could make compilation-parse-errors loop infinitely. Each round
of the parsing loop now either moves point ahead at least a line
or sets `found-desired' to true to stop the loop.
@@ -10535,8 +10535,8 @@
1997-09-11 Eli Zaretskii <eliz@is.elta.co.il>
- * international/mule-diag.el (describe-coding-system): Describe
- coding systems of type 5, raw-text.
+ * international/mule-diag.el (describe-coding-system):
+ Describe coding systems of type 5, raw-text.
* hexl.el (hexlify-buffer): Bind coding-system-for-write to
raw-text with eol-type derived from the buffer-file-coding-system.
@@ -10587,11 +10587,11 @@
1997-09-10 Michael Ernst <mernst@cs.washington.edu>
- * uniquify.el (uniquify-ignore-buffers-re): Added.
+ * uniquify.el (uniquify-ignore-buffers-re): Add.
1997-09-10 Michael Kifer <kifer@cs.sunysb.edu>
- * viper-keym.el (viper-help-modifier-map): Deleted; help mode map is
+ * viper-keym.el (viper-help-modifier-map): Delete; help mode map is
no longer modified.
* viper.el (viper-set-hooks): Make help buffers come up in emacs state.
@@ -10612,7 +10612,7 @@
(ethio-fidel-to-sera-mail-or-marker): New function.
(ethio-find-file): Do nothing if not in ethio-mode.
(ethio-write-file): Likewise.
- (ethio-prefer-ascii-space): Moved from leim/quail/ethiopic.el.
+ (ethio-prefer-ascii-space): Move from leim/quail/ethiopic.el.
(ethio-toggle-space): Likewise.
(ethio-insert-space): Likewise.
(ethio-insert-ethio-space): Likewise.
@@ -10627,8 +10627,8 @@
1997-09-10 Kenichi Handa <handa@etl.go.jp>
- * language/japan-util.el (setup-japanese-environment): Give
- iso-2022-jp to set-default-coding-system if not running on DOS.
+ * language/japan-util.el (setup-japanese-environment):
+ Give iso-2022-jp to set-default-coding-system if not running on DOS.
(read-hiragana-string): Use input method "japanese-hiragana".
* gnus/gnus-mule.el: Add coding system specification for several
@@ -10686,15 +10686,15 @@
1997-09-08 Per Abrahamsen <abraham@dina.kvl.dk>
- * cus-edit.el (custom-variable-save): Fixed doc string.
+ * cus-edit.el (custom-variable-save): Fix doc string.
* cus-edit.el (custom-variable-menu): Make it clear that `Lisp
mode' edit the initial lisp expression.
1997-09-08 Eli Zaretskii <eliz@is.elta.co.il>
- * info.el (info-insert-file-contents): Bind
- coding-system-for-write to no-conversion.
+ * info.el (info-insert-file-contents):
+ Bind coding-system-for-write to no-conversion.
1997-09-08 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
@@ -10742,9 +10742,9 @@
* telnet.el (telnet-initial-filter): Temporarily go to proper buffer.
-1997-09-07 Barry A. Warsaw <cc-mode-help@python.org>
+1997-09-07 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
- * progmodes/cc-mode.el (c-version): Updated.
+ * progmodes/cc-mode.el (c-version): Update.
* progmodes/cc-cmds.el (c-beginning-of-statement):
Fixes in sentence movement to properly
@@ -10916,8 +10916,8 @@
1997-09-05 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
- * language/japan-util.el (setup-japanese-environment): Set
- coding-category-iso-8-else to japanese-iso-8bit.
+ * language/japan-util.el (setup-japanese-environment):
+ Set coding-category-iso-8-else to japanese-iso-8bit.
1997-09-05 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -10950,10 +10950,10 @@
1997-09-05 Michael Kifer <kifer@cs.sunysb.edu>
* viper-init.el (viper-replace-region-start-delimiter):
- Improved the default.
+ Improve the default.
* viper-mous.el (viper-mouse-click-search-word)
(viper-mouse-click-insert-word):
- Fixed to not react when click is not over a text area.
+ Fix to not react when click is not over a text area.
* viper.el (read-file-name): Unadvised.
* viper-cmd.el (viper-insert-state-post-command-sentinel)
(viper-save-last-insertion):
@@ -11036,9 +11036,9 @@
1997-09-02 Geoff Voelker <voelker@cs.washington.edu>
* w32-fns.el: Update doc strings.
- (w32-startup): Deleted function.
+ (w32-startup): Delete function.
(w32-check-shell-configuration, w32-init-info): New functions.
- (w32-system-shell-p): Renamed from w32-using-system-shell-p.
+ (w32-system-shell-p): Rename from w32-using-system-shell-p.
Added shell name argument.
1997-09-02 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -11170,11 +11170,11 @@
1997-08-31 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
- * emacs-lisp/bytecomp.el (byte-compile-output-file-form): Handle
- custom-declare-variable.
+ * emacs-lisp/bytecomp.el (byte-compile-output-file-form):
+ Handle custom-declare-variable.
- * international/mule-diag.el (describe-current-coding-system): Add
- missing newline in output.
+ * international/mule-diag.el (describe-current-coding-system):
+ Add missing newline in output.
1997-08-31 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -11228,17 +11228,17 @@
1997-08-29 Carsten Dominik <dominik@strw.LeidenUniv.nl>
- * reftex.el (reftex-customize): Added call to customize browse.
+ * reftex.el (reftex-customize): Add call to customize browse.
(reftex-show-commentary): New function.
(reftex-label-alist): Prefix may contain % escapes. Nth macro
argument may be context. May give two different context methods.
(reftex-default-label-alist-entries): Customization type changed.
(reftex-label-menu-flags): Extra flag for searches.
- (reftex-cite-format): Changed completely, % escapes are now used.
+ (reftex-cite-format): Change completely, % escapes are now used.
(reftex-comment-citations): New variable.
(reftex-cite-comment-format): New variable.
(reftex-cite-punctuation): New variable.
- (reftex-make-master-buffer): Changed name of master buffer,
+ (reftex-make-master-buffer): Change name of master buffer,
removed interactive. Runs a hook on the buffer. Interpret
TEXINPUTS environment variable. Allow naked argument for \input.
Master buffer is now in fundamental mode.
@@ -11326,25 +11326,25 @@
* international/mule.el (make-coding-system): Make TYPE 5 means
raw-text.
- (after-insert-file-set-buffer-file-coding-system): Set
- enable-multibyte-characters to nil if we read a file with
+ (after-insert-file-set-buffer-file-coding-system):
+ Set enable-multibyte-characters to nil if we read a file with
no-conversion or raw-text-XXXX.
- * international/mule-conf.el (raw-text): New coding system. Set
- coding-category-raw-text to raw-text.
+ * international/mule-conf.el (raw-text): New coding system.
+ Set coding-category-raw-text to raw-text.
- * language/english.el (setup-english-environment): Set
- coding-category-raw-text to raw-text.
+ * language/english.el (setup-english-environment):
+ Set coding-category-raw-text to raw-text.
- * language/viet-util.el (setup-vietnamese-environment): Set
- coding-category-raw-text to vietnamese-viscii.
+ * language/viet-util.el (setup-vietnamese-environment):
+ Set coding-category-raw-text to vietnamese-viscii.
* language/cyril-util.el (setup-cyrillic-alternativnyj-environment):
Set coding-category-raw-text to cyrillic-alternativnyj.
* international/mule-cmds.el (update-leim-list-file): Make it
handle multiple directories.
- (update-all-leim-list-files): Deleted.
+ (update-all-leim-list-files): Delete.
* international/quail.el (quail-update-leim-list-file): Make it
handle multiple directories.
@@ -11357,8 +11357,8 @@
* nnfolder.el (nnfolder-request-list): Override
'nnmail-file-coding-system' by 'nnmail-active-file-coding-system'.
- (nnfolder-request-list, nnfolder-possibly-change-group): Protect
- from conversion by `pathname-coding-system' for XEmacs/mule.
+ (nnfolder-request-list, nnfolder-possibly-change-group):
+ Protect from conversion by `pathname-coding-system' for XEmacs/mule.
(nnfolder-group-pathname): Encode pathname for Emacs 20.
* nnmh.el (nnmh-request-list, nnmh-active-number): Protect from
@@ -11400,8 +11400,8 @@
* gnus-sum.el (gnus-structured-field-decoder): New variable.
(gnus-unstructured-field-decoder): New variable.
- (gnus-get-newsgroup-headers, gnus-nov-parse-line): Use
- `gnus-structured-field-decoder' and
+ (gnus-get-newsgroup-headers, gnus-nov-parse-line):
+ Use `gnus-structured-field-decoder' and
`gnus-unstructured-field-decoder' for Subject field.
1997-08-28 Miyashita Hisashi <himi@etl.go.jp>
@@ -11508,8 +11508,8 @@
* files.el (revert-buffer): Read a file without any code
conversion if we are reverting from an auto-saved file.
- * language/japanese.el (set-language-info-alist): Change
- iso-2022-7bit to iso-2022-jp.
+ * language/japanese.el (set-language-info-alist):
+ Change iso-2022-7bit to iso-2022-jp.
* replace.el (query-replace-read-args): Locally bind
minibuffer-inherit-input-method to t to make a minibuffer inherit
@@ -11635,14 +11635,14 @@
and changed into defsubsts.
(last): New function.
- * emacs-lisp/cl.el (caar, cadr, cdar, cddr): Moved to subr.el.
+ * emacs-lisp/cl.el (caar, cadr, cdar, cddr): Move to subr.el.
(last): Function renamed to last*.
* emacs-lisp/cl-macs.el (cl-loop-let): Use last*.
* time.el (display-time-hook): Minor doc fix.
- * ps-print.el (ps-zebra-stripes): Renamed from ps-zebra-stripe.
- (ps-zebra-stripe-height): Renamed from ps-number-of-zebra.
+ * ps-print.el (ps-zebra-stripes): Rename from ps-zebra-stripe.
+ (ps-zebra-stripe-height): Rename from ps-number-of-zebra.
* vc.el (vc-version-diff): Mention that default file is visited file.
@@ -11734,7 +11734,7 @@
(bookmark-bmenu-check-position): Return a meaningful value --
callers have apparently been assuming this anyway.
(bookmark-build-xemacs-menu): Unused function deleted.
- (bookmark-version): Removed this variable; the Emacs version suffices.
+ (bookmark-version): Remove this variable; the Emacs version suffices.
1997-08-22 Simon Marshall <simon@gnu.ai.mit.edu>
@@ -11756,7 +11756,7 @@
* viper-cmd.el (viper-replace-char-subr, viper-word-*)
(viper-separator-skipback-special): Made to work with mule and syntax
tables.
- (viper-change-state): Moved iso-accents-mode handling here from
+ (viper-change-state): Move iso-accents-mode handling here from
viper-change-state-to-vi/insert/etc. Also now toggles MULE.
1997-08-21 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -11769,7 +11769,7 @@
1997-08-21 Kenichi HANDA <handa@etl.go.jp>
- * language/cyril-util.el (setup-cyrillic-environment): Deleted.
+ * language/cyril-util.el (setup-cyrillic-environment): Delete.
(setup-cyrillic-iso-environment): New function.
(setup-cyrillic-koi8-environment): New function.
(setup-cyrillic-alternativnyj-environment): New function.
@@ -11784,20 +11784,20 @@
(auto-file-coding-system-function): Set this variable to
`auto-file-coding-system'.
- * international/quail.el (quail-terminate-translation): Run
- input-method-after-insert-chunk-hook only when the current input
+ * international/quail.el (quail-terminate-translation):
+ Run input-method-after-insert-chunk-hook only when the current input
method doesn't require conversion.
(quail-no-conversion): Run input-method-after-insert-chunk-hook.
* international/mule-util.el (coding-system-unification-table):
- Deleted.
+ Delete.
(coding-system-unification-table-for-decode): New function.
(coding-system-unification-table-for-encode): New function.
* international/mule.el (make-coding-system): Doc-string fixed.
- * international/fontset.el (register-alternate-fontnames): New
- function.
+ * international/fontset.el (register-alternate-fontnames):
+ New function.
(x-complement-fontset-spec): Register alternate fontnames by
calling register-alternate-fontnames.
(instanciate-fontset): Likewise.
@@ -11874,7 +11874,7 @@
(ps-background-image, ps-background, ps-header-height)
(ps-get-face): New internal functions.
(ps-control-character): Handle control characters.
- (ps-gnus-print-article-from-summary): Updated for Gnus 5.
+ (ps-gnus-print-article-from-summary): Update for Gnus 5.
(ps-jack-setup): Replace 'nil by nil, 't by t.
1997-08-19 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -11890,8 +11890,8 @@
* files.el (append-to-file): Doc-string fixed.
- * international/quail.el (quail-exit-from-minibuffer): Call
- inactivate-input-method instead of (quail-mode -1).
+ * international/quail.el (quail-exit-from-minibuffer):
+ Call inactivate-input-method instead of (quail-mode -1).
(quail-kill-guidance-buf): New function.
(quail-mode): Doc-string and comments modified. Make this
function non-interactive. Add quail-kill-guidance-buf to
@@ -11970,35 +11970,35 @@
(quail-define-package): Indentation fixed.
(quail-setup-overlays): New arg conversion-mode. Pay attention to
input-method-highlight-flag.
- (quail-mode-line-format): Deleted.
- (quail-generate-mode-line-format): Deleted.
+ (quail-mode-line-format): Delete.
+ (quail-generate-mode-line-format): Delete.
(quail-mode): Don't handle input-method-inactivate-hook and
input-method-activate-hook here. Delete code setting
quail-mode-line-format.
(quail-saved-current-map): Name changed from
quail-saved-overriding-local-map.
(quail-toggle-mode-temporarily): Completely re-written.
- (quail-execute-non-quail-command): Use
- quail-toggle-mode-temporarily.
- (quail-conv-overlay-modification-hook): Deleted.
- (quail-suppress-conversion): Deleted.
+ (quail-execute-non-quail-command):
+ Use quail-toggle-mode-temporarily.
+ (quail-conv-overlay-modification-hook): Delete.
+ (quail-suppress-conversion): Delete.
(quail-start-translation): Completely re-written.
(quail-start-translation-in-conversion-mode): Likewise.
(quail-delete-region): Check if quail-overlay is active.
- (quail-get-current-str): Don't call throw. Set
- overriding-terminal-local-map correctly.
+ (quail-get-current-str): Don't call throw.
+ Set overriding-terminal-local-map correctly.
(quail-update-translation): Run hooks in
input-method-after-insert-chunk-hook.
(quail-self-insert-command): Catch 'quail-tag here.
- (quail-conversion-delete-char): Don't call throw. Set
- overriding-terminal-local-map to nil.
+ (quail-conversion-delete-char): Don't call throw.
+ Set overriding-terminal-local-map to nil.
(quail-conversion-backward-delete-char): Likewise.
(quail-no-conversion): Likewise.
- (quail-help-insert-keymap-description): Bind
- overriding-terminal-local-map instead of overriding-local-map.
+ (quail-help-insert-keymap-description):
+ Bind overriding-terminal-local-map instead of overriding-local-map.
- * international/mule-cmds.el (previous-input-method): This
- variable deleted.
+ * international/mule-cmds.el (previous-input-method):
+ This variable deleted.
(input-method-history): New variable.
(read-input-method-name): Bind minibuffer-history to
input-method-history.
@@ -12006,27 +12006,27 @@
previous-input-method. Run hooks in input-method-activate-hook.
(inactivate-input-method): Update input-method-history. Run hooks
in input-method-inactivate-hook.
- (select-input-method): Doc-string modified. Use
- input-method-history instead of previous-input-method. Set
- default-input-method to input-method.
- (toggle-input-method): Doc-string modified. Use
- input-method-history instead of previous-input-method.
+ (select-input-method): Doc-string modified.
+ Use input-method-history instead of previous-input-method.
+ Set default-input-method to input-method.
+ (toggle-input-method): Doc-string modified.
+ Use input-method-history instead of previous-input-method.
(read-multilingual-string): Bind minibuffer-setup-hook correctly.
(input-method-exit-on-invalid-key): New variable.
- * isearch.el (isearch-multibyte-characters-flag): Deleted.
+ * isearch.el (isearch-multibyte-characters-flag): Delete.
(isearch-mode): Do not bind isearch-multibyte-characters-flag and
isearch-input-method.
(isearch-printing-char): Use current-input-method instead of
isearch-input-method.
(isearch-message-prefix): Likewise.
- * international/isearch-x.el (isearch-input-method): Deleted.
- (isearch-input-method-title): Deleted.
+ * international/isearch-x.el (isearch-input-method): Delete.
+ (isearch-input-method-title): Delete.
(isearch-toggle-specified-input-method): Call toggle-input-method.
(isearch-toggle-input-method): Likewise.
- (isearch-process-search-multibyte-characters): Use
- current-input-method instead of isearch-input-method.
+ (isearch-process-search-multibyte-characters):
+ Use current-input-method instead of isearch-input-method.
1997-08-17 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -12045,7 +12045,7 @@
For writing, use buffer-file-coding-system if set, otherwise
buffer-file-type.
(find-file-not-found-set-buffer-file-coding-system):
- Renamed from find-file-not-found-set-buffer-file-type.
+ Rename from find-file-not-found-set-buffer-file-type.
Set buffer-file-coding-system as well as buffer-file-type.
1997-08-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -12066,8 +12066,8 @@
* international/isearch-x.el (isearch-process-search-multibyte-characters):
Bind input-method-verbose-flag, not input-method-tersely-flag.
- * international/mule-cmds.el (input-method-verbose-flag): Renamed
- from input-method-tersely-flag and sense inverted.
+ * international/mule-cmds.el (input-method-verbose-flag):
+ Rename from input-method-tersely-flag and sense inverted.
(input-method-highlight-flag): New variable.
(toggle-input-method): Pass missing arg to read-input-method-name.
@@ -12079,8 +12079,8 @@
1997-08-16 Kenichi Handa <handa@etl.go.jp>
- * language/china-util.el (setup-chinese-gb-environment): Delete
- a code setting default value of default-input-method.
+ * language/china-util.el (setup-chinese-gb-environment):
+ Delete a code setting default value of default-input-method.
(setup-chinese-big5-environment): Likewise.
(setup-chinese-cns-environment): Likewise.
@@ -12107,34 +12107,36 @@
* loadup.el (loaddefs.el): Load that file much later, almost last.
Delete most calls to garbage-collect.
-1997-08-15 Barry A. Warsaw <cc-mode-help@python.org>
+1997-08-15 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
- * cc-styles.el (c-style-alist):
+ * progmodes/cc-styles.el (c-style-alist):
"python" style requires c-comment-continuation-stars be "".
- * cc-engine.el (c-end-of-statement-1):
+ * progmodes/cc-engine.el (c-end-of-statement-1):
Eliminate false hits on important characters
inside literals (strings, comments).
- * cc-cmds.el (c-comment-line-break-function):
+ * progmodes/cc-cmds.el (c-comment-line-break-function):
In this function, and the defadvice,
call indent-new-comment-line if not in a comment.
- * cc-cmds.el (c-fill-paragraph):
+ * progmodes/cc-cmds.el (c-fill-paragraph):
Remove conditional on obsolete variable
c-double-slash-is-comments-p.
- * cc-vars.el (c-buffer-is-cc-mode): Definition moved to cc-mode.el.
+ * progmodes/cc-vars.el (c-buffer-is-cc-mode):
+ Definition moved to cc-mode.el.
- * cc-mode.el (c-buffer-is-cc-mode):
+ * progmodes/cc-mode.el (c-buffer-is-cc-mode):
Definition moved here from cc-vars.el. Also,
put permanent-local property on variable so its value won't get
killed by kill-all-local-variables.
- * cc-mode.el (c++-mode, java-mode, objc-mode, idl-mode):
+ * progmodes/cc-mode.el (c++-mode, java-mode, objc-mode, idl-mode):
Remove obsolete variable c-double-slash-is-comments-p.
- * cc-langs.el (c-double-slash-is-comments-p): Remove obsolete variable.
+ * progmodes/cc-langs.el (c-double-slash-is-comments-p):
+ Remove obsolete variable.
1997-08-15 Boris Goldowsky <boris@gnu.ai.mit.edu>
@@ -12269,46 +12271,48 @@
* dos-fns.el (dos-print-region-function): Force EOL conversion to
DOS CR-LF pairs.
-1997-08-10 Barry A. Warsaw <cc-mode-help@python.org>
+1997-08-10 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* Release 5.15
- * cc-align.el (c-lineup-java-throws):
+ * progmodes/cc-align.el (c-lineup-java-throws):
Change the `when' clause to an `if-progn'.
- * cc-cmds.el (indent-new-comment-line): On older Emacs versions,
- add advice, to work around lack of comment-line-break-function.
+ * progmodes/cc-cmds.el (indent-new-comment-line):
+ On older Emacs versions, add advice, to work around
+ lack of comment-line-break-function.
- * cc-cmds.el (c-electric-slash):
+ * progmodes/cc-cmds.el (c-electric-slash):
Make this work as the final slash in a */ block
oriented comment closing token.
- * cc-cmds.el (c-comment-line-break-function): New function.
+ * progmodes/cc-cmds.el (c-comment-line-break-function): New function.
- * cc-vars.el (c-buffer-is-cc-mode): New variable.
+ * progmodes/cc-vars.el (c-buffer-is-cc-mode): New variable.
- * cc-vars.el (c-comment-continuation-stars): New variable.
+ * progmodes/cc-vars.el (c-comment-continuation-stars): New variable.
- * cc-mode.el (c-initialize-cc-mode): Set c-buffer-is-cc-mode to t.
+ * progmodes/cc-mode.el (c-initialize-cc-mode):
+ Set c-buffer-is-cc-mode to t.
- * cc-mode.el (c-initialize-cc-mode): Require 'cc-mode-19
+ * progmodes/cc-mode.el (c-initialize-cc-mode): Require 'cc-mode-19
if functionp is not bound. Check cc-mode-19 interface requirements.
- * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode, idl-mode):
- Don't set comment-multi-line here.
+ * progmodes/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode)
+ (idl-mode): Don't set comment-multi-line here.
- * cc-mode.el (c-mode): c-comment-start-regexp uses
+ * progmodes/cc-mode.el (c-mode): c-comment-start-regexp uses
c-C++-comment-start-regexp to support line oriented comments.
- * cc-langs.el (c-mode-base-map, c++-mode-map):
+ * progmodes/cc-langs.el (c-mode-base-map, c++-mode-map):
Move `/' as an electric character
from c++-mode-map to c-mode-base-map for all languages.
- * cc-langs.el (c-common-init): Set comment-multi-line and
+ * progmodes/cc-langs.el (c-common-init): Set comment-multi-line and
comment-line-break-function here for all modes.
Make comment-line-break-function buffer local iff it's boundp.
- * cc-langs.el (c-C-comment-start-regexp): Obsolete.
+ * progmodes/cc-langs.el (c-C-comment-start-regexp): Obsolete.
(c-comment-start-regexp): Initialize from c-C++-comment-start-regexp.
@@ -12319,19 +12323,19 @@
(c-enable-//-in-c-mode): Obsolete.
- * cc-langs.el (c++-mode-syntax-table, java-mode-syntax-table)
- (objc-mode-syntax-table, idl-mode-syntax-table): Added autoload
+ * progmodes/cc-langs.el (c++-mode-syntax-table, java-mode-syntax-table)
+ (objc-mode-syntax-table, idl-mode-syntax-table): Add autoload
cookies. c-mode-syntax-table already has one. Use the new syntax
table initialization idioms.
- * cc-engine.el (c-guess-basic-syntax):
+ * progmodes/cc-engine.el (c-guess-basic-syntax):
CASE 5D.4: template argument continuation
lines are now analyzed as template-args-cont.
- * cc-styles.el (c-offsets-alist):
- Added template-args-cont syntactic symbol.
+ * progmodes/cc-styles.el (c-offsets-alist):
+ Add template-args-cont syntactic symbol.
- * cc-styles.el (c-styles-alist):
+ * progmodes/cc-styles.el (c-styles-alist):
In "java" style, set c-hanging-comment-starter-p to
nil to preserve Javadoc starter lines.
@@ -12349,16 +12353,16 @@
* international/mule.el (make-coding-system): Add a new FLAGS
elements SAFE. Use it for terminal coding system if some other
coding system is specified explicitly.
- (ignore-relative-composition): Initialize
- ignore-relative-composition.
+ (ignore-relative-composition):
+ Initialize ignore-relative-composition.
- * international/mule-util.el(prefer-coding-system): Moved to
+ * international/mule-util.el(prefer-coding-system): Move to
mule-util.el.
* international/mule-cmds.el (set-default-coding-systems):
Doc-string modified.
- (prefer-coding-system): Moved from mule-util.el. Call
- set-default-coding-systems.
+ (prefer-coding-system): Move from mule-util.el.
+ Call set-default-coding-systems.
* international/mule-conf.el (iso-safe): New coding system.
@@ -12412,7 +12416,7 @@
* help.el (describe-key): Don't put a colon after the command name.
-1997-08-09 Barry A. Warsaw <cc-mode-help@python.org>
+1997-08-09 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-engine.el (c-beginning-of-statement-1):
When checking for bare semi, don't match
@@ -12434,7 +12438,7 @@
c-hanging-comment-starter-p to nil to preserve Javadoc starter lines.
* progmodes/cc-styles.el (c-set-style-2):
- Fixed broken implementation of inherited styles.
+ Fix broken implementation of inherited styles.
* progmodes/cc-styles.el (c-set-style):
Call c-initialize-builtin-style.
@@ -12635,12 +12639,12 @@
1997-08-04 Espen Skoglund <espensk@odslab5.cs.uit.no>
* pascal.el (pascal-mode-syntax-table): _ is now a symbol constituent.
- (pascal-indent-case): Removed unnecessary calls to marker-position.
+ (pascal-indent-case): Remove unnecessary calls to marker-position.
(pascal-indent-declaration): Editing a parameterlist at the end of
a buffer does not hang. Removed unnecessary call to marker-position.
- (pascal-get-lineup-indent): Removed unused variable.
+ (pascal-get-lineup-indent): Remove unused variable.
Indent parameterlist correctly.
- (pascal-completion-response): Removed unused variable.
+ (pascal-completion-response): Remove unused variable.
1997-08-04 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
@@ -12649,16 +12653,16 @@
* isearch.el (isearch-quote-char): Fix handling of control
characters, copied from quoted-insert.
- * emacs-lisp/pp.el (pp-to-string): Use
- emacs-lisp-mode-syntax-table.
+ * emacs-lisp/pp.el (pp-to-string):
+ Use emacs-lisp-mode-syntax-table.
* international/quail.el (quail-update-leim-list-file): Go to the
beginning of the package file, in case it was already visited.
1997-08-04 Kenichi Handa <handa@etl.go.jp>
- * language/english.el (setup-english-environment): Call
- set-default-coding-systems.
+ * language/english.el (setup-english-environment):
+ Call set-default-coding-systems.
* language/china-util.el (setup-chinese-gb-environment): Do not
call set-terminal-coding-system and set-keyboard-coding-system,
@@ -12672,8 +12676,8 @@
* language/korean.el (setup-korean-environment): Likewise.
- * international/mule-cmds.el (set-default-coding-systems): New
- function.
+ * international/mule-cmds.el (set-default-coding-systems):
+ New function.
* international/mule.el (default-terminal-coding-system): New var.
(set-terminal-coding-system):
@@ -12768,20 +12772,20 @@
* term/x-win.el: Fix previous change.
- * international/quail.el (quail-next-translation): Call
- quail-execute-non-quail-command when no current translations.
+ * international/quail.el (quail-next-translation):
+ Call quail-execute-non-quail-command when no current translations.
(quail-prev-translation): Likewise.
(quail-next-translation-block): Likewise.
(quail-prev-translation-block): Likewise.
- * language/china-util.el (setup-chinese-gb-environment): Set
- default value of default-input-method.
+ * language/china-util.el (setup-chinese-gb-environment):
+ Set default value of default-input-method.
(setup-chinese-big5-environment): Likewise.
(setup-chinese-cns-environment): Likewise. Correct input method
name.
- * language/ethio-util.el (setup-ethiopic-environment): Bind
- correct commands in global-map, rmail-mode-map, and mail-mode-map.
+ * language/ethio-util.el (setup-ethiopic-environment):
+ Bind correct commands in global-map, rmail-mode-map, and mail-mode-map.
* language/ethiopic.el (ccl-encode-ethio-font): Fix typo in
doc-string. Set default value of default-input-method.
@@ -12868,23 +12872,23 @@
* international/fontset.el (fontset-name-p): New function.
(uninstanciated-fontset-alist): New variable.
- (create-fontset-from-fontset-spec): Delete arg STYLE. Register
- style-variants of FONTSET in uninstanciated-fontset-alist.
- (create-fontset-from-x-resource): Call
- create-fontset-from-fontset-spec correctly.
+ (create-fontset-from-fontset-spec): Delete arg STYLE.
+ Register style-variants of FONTSET in uninstanciated-fontset-alist.
+ (create-fontset-from-x-resource):
+ Call create-fontset-from-fontset-spec correctly.
* international/mule-util.el (reference-point-alist): Doc-string
modified.
- * term/x-win.el: Do not create style-variants of fontset. They
- are just registered in uninstanciated-fontset-alist.
+ * term/x-win.el: Do not create style-variants of fontset.
+ They are just registered in uninstanciated-fontset-alist.
1997-07-31 Michael Kifer <kifer@cs.sunysb.edu>
- * ediff*.el (ediff-eval-in-buffer): Changed macro and renamed
+ * ediff*.el (ediff-eval-in-buffer): Change macro and renamed
ediff-with-current-buffer.
Eliminated inefficient calls to `intern'.
- * ediff-diff.el (ediff-exec-process): Changed to work with buffers
+ * ediff-diff.el (ediff-exec-process): Change to work with buffers
whose names have spaces.
(ediff-wordify): Use buffer-substring-no-properties.
@@ -13066,8 +13070,8 @@
1997-07-25 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
- * international/quail.el (quail-update-leim-list-file): Call
- find-file-noselect with t for arguments NOWARN and RAWFILE.
+ * international/quail.el (quail-update-leim-list-file):
+ Call find-file-noselect with t for arguments NOWARN and RAWFILE.
* international/mule-cmds.el (leim-list-entry-regexp): Make this
match only at beginning of line.
@@ -13116,8 +13120,8 @@
* language/tibet-util.el (setup-tibetan-environment): Correct
coding system names. Set default-input-method to "tibetan-wylie".
- * language/viet-util.el (setup-vietnamese-environment): Add
- autoload cookie.
+ * language/viet-util.el (setup-vietnamese-environment):
+ Add autoload cookie.
1997-07-25 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -13139,7 +13143,7 @@
1997-07-24 Michael Kifer <kifer@cs.sunysb.edu>
* viper.el (viper-non-vi-major-modes): New variable.
- (vip-set-hooks): Changed so it'll update viper-non-vi-major-modes.
+ (vip-set-hooks): Change so it'll update viper-non-vi-major-modes.
(viper-mode): Now checks viper-non-vi-major-modes.
1997-07-24 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -13164,11 +13168,11 @@
* cus-face.el (custom-declare-face): Use [set-]face-documentation.
- * faces.el (face-documentation): Renamed from face-doc-string.
- (set-face-documentation): Renamed from set-face-doc-string.
+ * faces.el (face-documentation): Rename from face-doc-string.
+ (set-face-documentation): Rename from set-face-doc-string.
(face-doc-string): Make this an alias.
- * term/bg-mouse.el (bg-yank-or-pop): Changed eql to eq.
+ * term/bg-mouse.el (bg-yank-or-pop): Change eql to eq.
* international/mule-cmds.el (read-input-method-name): Fix error msg.
@@ -13338,8 +13342,8 @@
Use undecided-dos for dos-text file names.
Use undecided for non-existing untranslated file names.
- * international/mule.el (modify-coding-system-alist): Added.
- international/mule-util.el (modify-coding-system-alist): Removed.
+ * international/mule.el (modify-coding-system-alist): Add.
+ international/mule-util.el (modify-coding-system-alist): Remove.
* loadup.el [windows-nt, ms-dos]: Undo loading
of international/mule-utils.
@@ -13403,7 +13407,7 @@
(occur-mode-find-occurrence): Use `occur' text property to find
marker for locus of the occurrence.
(occur-next, occur-prev): New commands.
- (occur): Fixed bug preventing line number being displayed if line
+ (occur): Fix bug preventing line number being displayed if line
number is less than the number of lines of context.
1997-07-18 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -13463,7 +13467,7 @@
* paren.el (show-paren-match-face): Use gray on all non-color screens.
-1997-07-17 Barry A. Warsaw <cc-mode-help@python.org>
+1997-07-17 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* progmodes/cc-mode.el (c-initialize-cc-mode): New function.
(c-mode, c++-mode, objc-mode, java-mode): Call it.
@@ -13476,7 +13480,7 @@
* progmodes/cc-langs.el: Require 'cc-defs for the definition of
c-emacs-features.
- * progmodes/cc-langs.el (c-mode-menu): Added uncomment region and
+ * progmodes/cc-langs.el (c-mode-menu): Add uncomment region and
slight rearrangement of items.
* progmodes/cc-cmds.el: Require cc-defs for the c-add-syntax macro.
@@ -13489,8 +13493,8 @@
* progmodes/cc-engine.el (c-maybe-labelp): Add defvar.
- * progmodes/cc-styles.el (c-initialize-builtin-style): Use
- copy-sequence instead of c-copy-tree.
+ * progmodes/cc-styles.el (c-initialize-builtin-style):
+ Use copy-sequence instead of c-copy-tree.
* progmodes/cc-defs.el (c-load-all): Function deleted.
@@ -13560,17 +13564,17 @@
* international/quail.el (quail-translate-key): Fix previous change.
- * international/mule.el (make-coding-system): Distinguish
- coding-category-iso-7-else and coding-category-iso-8-else.
+ * international/mule.el (make-coding-system):
+ Distinguish coding-category-iso-7-else and coding-category-iso-8-else.
- * international/mule-conf.el (coding-category-emacs-mule): Replace
- coding-category-iso-else with coding-category-iso-7-else and
+ * international/mule-conf.el (coding-category-emacs-mule):
+ Replace coding-category-iso-else with coding-category-iso-7-else and
coding-category-iso-8-else.
- * international/mule-diag.el (describe-current-coding-system): Use
- coding-category-iso-7-else instead of coding-category-iso-else.
+ * international/mule-diag.el (describe-current-coding-system):
+ Use coding-category-iso-7-else instead of coding-category-iso-else.
- * language/china-util.el (setup-chinese-gb-environment): Adjusted
+ * language/china-util.el (setup-chinese-gb-environment): Adjust
for the change of coding category names. Set default-input-method
to chinese-py-punct.
(setup-chinese-big5-environment): Set default-input-method to
@@ -13578,18 +13582,18 @@
(setup-chinese-cns-environment): Set default-input-method
correctly.
- * language/english.el (setup-english-environment): Adjusted for
+ * language/english.el (setup-english-environment): Adjust for
the change of coding category names.
- * language/japan-util.el (setup-japanese-environment): Adjusted
+ * language/japan-util.el (setup-japanese-environment): Adjust
for the change of coding category names. Set default-input-method
correctly.
- * language/ethio-util.el (setup-ethiopic-environment): Set
- default-input-method correctly.
+ * language/ethio-util.el (setup-ethiopic-environment):
+ Set default-input-method correctly.
- * language/korean.el (setup-korean-environment): Set
- default-input-method correctly.
+ * language/korean.el (setup-korean-environment):
+ Set default-input-method correctly.
* language/tibet-util.el (setup-tibetan-environment: Set
default-input-method correctly.
@@ -13652,8 +13656,8 @@
for iswitchb-kill-buffer and iswitchb-find-file.
(iswitchb): When no text typed in, show all buffers.
(iswitchb-complete): Use equal rather than eq.
- (iswitchb-next-match, iswitchb-prev-match): Use
- iswitchb-chop to handle reordering the buffer list.
+ (iswitchb-next-match, iswitchb-prev-match):
+ Use iswitchb-chop to handle reordering the buffer list.
(iswitchb-chop): New function.
(iswitchb-make-buflist): Rewritten for efficiency.
(iswitchb-to-end): Operate on a list of buffers, not just one.
@@ -13689,7 +13693,7 @@
1997-07-10 Rob Riepel <riepel@Stanford.EDU>
- * emulations/tpu-edt.el (tpu-set-mode-line) Added
+ * emulation/tpu-edt.el (tpu-set-mode-line) Added
mode-line-mule-info and mode-line-frame-identification.
1997-07-10 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de>
@@ -13706,9 +13710,10 @@
* progmodes/cc-styles.el (c-copy-tree): New function.
(c-initialize-builtin-style): Use c-copy-tree.
- * cc-align.el, cc-cmds.el, cc-compat.el, cc-defs.el, cc-engine.el:
- * cc-langs.el, cc-menus.el, cc-mode.el, cc-styles.el, cc-vars.el:
- New version of CC mode installed.
+ * progmodes/cc-align.el, progmodes/cc-cmds.el, progmodes/cc-compat.el:
+ * progmodes/cc-defs.el, progmodes/cc-engine.el, progmodes/cc-langs.el:
+ * progmodes/cc-menus.el, progmodes/cc-mode.el, progmodes/cc-styles.el:
+ * progmodes/cc-vars.el: New version of CC mode installed.
Old files completely replaced.
1997-07-10 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
@@ -13722,8 +13727,8 @@
1997-07-10 Kenichi Handa <handa@etl.go.jp>
- * international/fontset.el (create-fontset-from-fontset-spec): Add
- optional arg NOERROR.
+ * international/fontset.el (create-fontset-from-fontset-spec):
+ Add optional arg NOERROR.
(create-fontset-from-x-resource): Give t as arg NOERROR to
create-fontset-from-fontset-spec.
@@ -13737,11 +13742,11 @@
(isearch-input-method-title): New variable.
(isearch-toggle-specified-input-method): Set the above variables.
(isearch-toggle-input-method): Likewise.
- (isearch-process-search-multibyte-characters): Give
- isearch-input-method as arg to read-multilingual-string.
+ (isearch-process-search-multibyte-characters):
+ Give isearch-input-method as arg to read-multilingual-string.
- * international/mule-cmds.el (read-multilingual-string): Adjusted
- for the previous change of variables related to input methods.
+ * international/mule-cmds.el (read-multilingual-string):
+ Adjust for the previous change of variables related to input methods.
* isearch.el (isearch-message-prefix): Likewise.
@@ -13801,7 +13806,7 @@
* progmodes/cc-*.el: New files, totally reorganized.
* dunnet.el: Undo an earlier change:
- (dun-piss): Renamed from dunnet-urinate.
+ (dun-piss): Rename from dunnet-urinate.
(dun-verblist): Indecent word added back.
(dunnet): Delete "censored" message.
@@ -13908,7 +13913,7 @@
* browse-url.el: Require thingatpt when compiling.
(browse-url-url-at-point): Use `thing-at-point' (with URL code
moved from here).
- (browse-url-looking-at): Moved to thingatpt.el, renamed and changed.
+ (browse-url-looking-at): Move to thingatpt.el, renamed and changed.
* thingatpt.el (thing-at-point): Use `thing-at-point' property, if any.
(bounds-of-thing-at-point): Use `bounds-of-thing-at-point' property.
@@ -13947,11 +13952,11 @@
(widget-default-delete): Ditto.
* wid-edit.el (color): Make it an editable field.
- (widget-color-value-create): Deleted.
- (widget-color-value-get): Deleted.
- (widget-color-value-set): Deleted.
- (color-item): Deleted.
- (widget-color-item-button-face-get): Renamed to
+ (widget-color-value-create): Delete.
+ (widget-color-value-get): Delete.
+ (widget-color-value-set): Delete.
+ (color-item): Delete.
+ (widget-color-item-button-face-get): Rename to
`widget-color-sample-face-get'.
(color-sample): Delete.
(editable-color): Delete.
@@ -14061,15 +14066,15 @@
(custom-browse-visibility-action, custom-browse-group-tag)
(custom-browse-group-tag-action, custom-browse-variable-tag-action)
(custom-browse-face-tag, custom-browse-face-tag-action)
- (custom-browse-face-tag-action, custom-browse-alist): Changed
- prefix from `custom-tree' to `custom-browse'.
+ (custom-browse-face-tag-action, custom-browse-alist):
+ Change prefix from `custom-tree' to `custom-browse'.
(custom-variable-value-create, custom-face-value-create)
- (custom-group-value-create): Updated caller.
+ (custom-group-value-create): Update caller.
* cus-edit.el (custom-browse-only-groups): New option.
(custom-group-value-create): Use it. Omit non-groups if non-nil.
- * cus-edit.el (custom-help-menu): Renamed "Variable" to "Option".
+ * cus-edit.el (custom-help-menu): Rename "Variable" to "Option".
Remove "..." from non-prompting entries.
* wid-edit.el (widget-single-line-field-face): New face.
@@ -14091,7 +14096,7 @@
* language/european.el (setup-8-bit-environment): New argument
LANGUAGE.
- (setup-latin1-environment): Adjusted for the above change.
+ (setup-latin1-environment): Adjust for the above change.
(setup-latin2-environment): Likewise.
(setup-latin3-environment): Likewise.
(setup-latin4-environment): Likewise.
@@ -14101,8 +14106,8 @@
* language/hebrew.el (setup-hebrew-environment): Likewise.
- * language/cyril-util.el (setup-cyrillic-environment): Adjusted
- for the change of an input method name.
+ * language/cyril-util.el (setup-cyrillic-environment):
+ Adjust for the change of an input method name.
* language/devan-util.el (setup-devanagari-environment): Likewise.
@@ -14150,25 +14155,25 @@
(quail-defrule): Doc-string modified.
(quail-defrule-internal): Document it.
(quail-get-translation): Change the format of DEF part.
- (quail-lookup-key): Make the second argument LEN optional. Reset
- quail-current-translations to nil.
+ (quail-lookup-key): Make the second argument LEN optional.
+ Reset quail-current-translations to nil.
(quail-map-definition): New function.
(quail-get-current-str): New function.
(quail-guidance-translations-starting-column): New variable.
(quail-update-current-translations): New function.
- (quail-translate-key): Adjusted for the change of DEF format.
+ (quail-translate-key): Adjust for the change of DEF format.
Call quail-update-current-translations.
(quail-next-translation): Call quail-update-current-translations.
(quail-prev-translation): Likewise.
(quail-next-translation-block): Likewise.
(quail-prev-translation-block): Likewise.
- (quail-select-translation): Deleted.
+ (quail-select-translation): Delete.
(quail-make-guidance-frame): New function.
(quail-show-guidance-buf): Handle the case that minibuffer is in a
separate frame.
(quail-hide-guidance-buf): Likewise.
- (quail-show-translations): Call
- quail-update-current-translations. Check width of a frame to be
+ (quail-show-translations):
+ Call quail-update-current-translations. Check width of a frame to be
used.
(quail-completion): Do not supply LEN argument to
quail-lookup-key.
@@ -14181,8 +14186,8 @@
(charset-chars, charset-width, charset-direction)
(charset-iso-final-char, charset-iso-graphic-plane)
(charset-reverse-charset, charset-short-name, charset-long-name)
- (charset-description, charset-plit, set-charset-plist): Document
- them.
+ (charset-description, charset-plit, set-charset-plist):
+ Document them.
(make-char, charset-list): Doc-string modified.
(find-new-buffer-file-coding-system): Fix bug of handling the
coding system undecided.
@@ -14291,16 +14296,16 @@
(updates): Reject subdirs whose names start with =.
(custom-deps, finder-data, autoloads, update-subdirs): Likewise.
- * scroll-bar.el (toggle-scroll-bar): Moved from frame.el.
+ * scroll-bar.el (toggle-scroll-bar): Move from frame.el.
Use scroll-bar-mode to determine which side; if it's nil, use left.
(set-scroll-bar-mode): New subroutine, taken from scroll-bar-mode.
(scroll-bar-mode): Use the variable set-scroll-bar-mode.
(scroll-bar-mode): New variable. Extra defvar to avoid warning.
- (toggle-horizontal-scroll-bar): Moved from frame.el.
+ (toggle-horizontal-scroll-bar): Move from frame.el.
* frame.el (scroll-bar-side): Variable deleted.
(toggle-scroll-bar, toggle-horizontal-scroll-bar):
- Moved to scroll-bar.el.
+ Move to scroll-bar.el.
* files.el (file-chase-links): When handling .., make newname absolute.
Simplify several places.
@@ -14394,7 +14399,7 @@
* wid-edit.el (widget-button-click): Steal up event if key is not
bound in `widget-global-map'.
- * cus-edit.el (custom-tree-insert-prefix): Renamed from
+ * cus-edit.el (custom-tree-insert-prefix): Rename from
`custom-tree-insert'.
(custom-group-value-create): Use it.
@@ -14477,7 +14482,7 @@
(custom-button-face): New defface.
(custom widget-type): Use custom-button-face for buttons.
(custom-group-tag-faces): Initial value is nil.
- (custom-variable-tag-face): Renamed from custom-variable-sample-face.
+ (custom-variable-tag-face): Rename from custom-variable-sample-face.
Initialize it like custom-group-tag-face.
(custom-group-tag-faces): Initialize to nil.
(custom-state-face): New defface.
@@ -14492,21 +14497,21 @@
only if the item is modified. Take widget as arg.
(custom-mode): Use widget-edit-functions.
- * wid-edit.el (widget-edit-functions): Renamed from widget-edit-hook.
+ * wid-edit.el (widget-edit-functions): Rename from widget-edit-hook.
(widget-field-action): Pass the widget as an arg when running hook.
- * cus-edit.el (Custom-set): Renamed from custom-set.
- (Custom-save): Renamed from custom-save.
+ * cus-edit.el (Custom-set): Rename from custom-set.
+ (Custom-save): Rename from custom-save.
(custom-browse-sort-predicate): Defalias deleted.
(custom-group-value-create): Don't sort, in tree mode.
- (Custom-mode-menu): Renamed from custom-mode-menu.
- (Custom-reset-current): Renamed from custom-reset-current.
- (Custom-reset-saved): Renamed from custom-reset-saved.
- (Custom-reset-standard): Renamed from custom-reset-standard.
- (Custom-menu-update): Renamed from custom-menu-update.
- (customize-set-value): Renamed from custom-set-value.
- (customize-set-variable): Renamed from custom-set-variable.
- (customize-save-customized): Renamed from custom-save-customized.
+ (Custom-mode-menu): Rename from custom-mode-menu.
+ (Custom-reset-current): Rename from custom-reset-current.
+ (Custom-reset-saved): Rename from custom-reset-saved.
+ (Custom-reset-standard): Rename from custom-reset-standard.
+ (Custom-menu-update): Rename from custom-menu-update.
+ (customize-set-value): Rename from custom-set-value.
+ (customize-set-variable): Rename from custom-set-variable.
+ (customize-save-customized): Rename from custom-save-customized.
* cus-start.el (double-click-time): Use restricted-sexp.
(load-path): Make [Current dir?] itself the active button.
@@ -14543,7 +14548,7 @@
instead of displaying an echo area message.
(widget-toggle-action): Likewise.
(group-visibility, widget-group-visibility-create):
- Moved to cus-edit.el and renamed.
+ Move to cus-edit.el and renamed.
1997-06-23 Dan Nicolaescu <done@ece.arizona.edu>
@@ -14618,7 +14623,7 @@
1997-06-22 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
* decipher.el (decipher-copy-cons):
- Renamed from decipher-get-undo-copy. Calls changed.
+ Rename from decipher-get-undo-copy. Calls changed.
* emacs-lisp/lmenu.el (popup-menu): Redefine as macro.
(popup-menu-popup, popup-menu-internal): New function.
@@ -14742,11 +14747,11 @@
(custom-variable-value-create): Use it.
(custom-face-value-create): Use it.
(custom-group-value-create): Use it.
- (custom-buffer-groups-last): Changed default.
+ (custom-buffer-groups-last): Change default.
- * wid-edit.el (group-visibility): Deleted.
+ * wid-edit.el (group-visibility): Delete.
(widget-group-visibility-create): Ditto.
- (group-link): Deleted.
+ (group-link): Delete.
(widget-group-link-create): Ditto.
(widget-group-link-action): Ditto.
@@ -14756,12 +14761,12 @@
(custom-group-link-action): New function.
(custom-group-value-create): Use `custom-group-link'.
- * wid-edit.el (widget-before-change): Fixed comment and debug string.
+ * wid-edit.el (widget-before-change): Fix comment and debug string.
- * cus-edit.el (custom-mode-customize-menu): Deleted.
+ * cus-edit.el (custom-mode-customize-menu): Delete.
(custom-mode-menu): Define here.
(custom-mode): Don't add here.
- (custom-format-handler): Deleted.
+ (custom-format-handler): Delete.
(custom): Don't add here.
* cus-edit.el (custom-browse-sort-predicate): New alias.
@@ -14771,7 +14776,7 @@
(custom-group): Ditto.
(custom-group-value-create): Ditto.
- * cus-edit.el (face): Fixed format.
+ * cus-edit.el (face): Fix format.
(custom-face-value-create): Browse face, not option.
* cus-edit.el (custom-group-value-create): Rewrote to replace
@@ -14782,8 +14787,8 @@
(custom-variable): Ditto.
(custom-face): Delete :format and :format-handler.
(custom): Add :format.
- (custom-format-handler): Removed unnecessary code.
- (custom-face-format-handler): Deleted.
+ (custom-format-handler): Remove unnecessary code.
+ (custom-face-format-handler): Delete.
(custom-add-see-also): New function.
(custom-buffer-style): New option.
(widget-face-value-create): Use it here instead of :format.
@@ -14812,13 +14817,13 @@
(custom-menu-sort-predicate): Use them.
(custom-menu-create): Use it.
(custom-buffer-sort-predicate, custom-buffer-order-predicate)
- (custom-menu-sort-predicate, custom-menu-order-predicate): Deleted.
+ (custom-menu-sort-predicate, custom-menu-order-predicate): Delete.
* wid-edit.el (widget-leave-text): Don't delete nil overlays.
* wid-edit.el (widget-get-indirect): New function.
(widget-default-create): Use it.
- (widget-button-insert-indirect): Deleted.
+ (widget-button-insert-indirect): Delete.
* wid-edit.el (widget-inactive-face): Use dim gray instead of dark
gray.
@@ -14999,9 +15004,9 @@
1997-06-18 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
- * mule-util.el (coding-system-parent): Moved to mule.el.
+ * mule-util.el (coding-system-parent): Move to mule.el.
- * mule.el (coding-system-parent): Moved from mule-util.el.
+ * mule.el (coding-system-parent): Move from mule-util.el.
1997-06-18 Kenichi Handa <handa@etl.go.jp>
@@ -15010,7 +15015,7 @@
* subdirs.el: Add "language" in the argument of
normal-top-level-add-to-load-path.
- * rmail.el (rmail-enable-decoding-message): Deleted.
+ * rmail.el (rmail-enable-decoding-message): Delete.
(rmail-revert): Bind enable-multibyte-characters to nil before
calling rmail-convert-file.
(rmail-convert-to-babyl-format): If enable-multibyte-characters is
@@ -15044,7 +15049,7 @@
(coding-system-list): Sort coding systems by coding-system-lessp.
An element of returned list is always coding system, never be a
cons.
- (modify-coding-system-alist): Renamed from
+ (modify-coding-system-alist): Rename from
set-coding-system-alist.
(prefer-coding-system): New function.
(compose-chars-component): But fix for handling a composite
@@ -15071,8 +15076,8 @@
not a valid KEY argument now.
(leim-list-file-name, leim-list-header, leim-list-entry-regexp):
New variables.
- (update-leim-list-file, update-all-leim-list-files): New
- functions.
+ (update-leim-list-file, update-all-leim-list-files):
+ New functions.
(current-input-method): Doc-string modified because the value is
now input method name.
(default-input-method, previous-input-method): Likewise.
@@ -15081,12 +15086,12 @@
(input-method-alist): New variable.
(register-input-method): Register input method in
input-method-alist.
- (read-language-and-input-method-name): Deleted.
+ (read-language-and-input-method-name): Delete.
(read-input-method-name): New function.
(activate-input-method, select-input-method, toggle-input-method):
- Modified for the above change.
+ Modify for the above change.
(read-multilingual-string): Likewise.
- (describe-current-input-method): Renamed from
+ (describe-current-input-method): Rename from
describe-input-method.
(describe-input-method): New function.
(describe-language-environment): Don't put a vacant line at the
@@ -15116,7 +15121,7 @@
* language/cyril-util.el (setup-cyrillic-iso-environment)
(setup-cyrillic-koi8-environment)
- (setup-cyrillic-alternativnyj-environment): Deleted.
+ (setup-cyrillic-alternativnyj-environment): Delete.
(setup-cyrillic-environment): New function.
* language/cyrillic.el: Don't make the keymap
@@ -15166,12 +15171,12 @@
* tar-mode.el (tar-extract): Use second argument of
view-buffer instead of setting view-exit-action.
- * files.el (view-read-only): New option variable. If
- non-nil then buffers visiting files read-only, do it in view mode.
+ * files.el (view-read-only): New option variable.
+ If non-nil then buffers visiting files read-only, do it in view mode.
(find-file-read-only, find-file-read-only-other-window)
(find-file-read-only-other-frame): Call toggle-read-only
instead of setting buffer-read-only explicitly.
- (toggle-read-only, after-find-file): Changed to be aware
+ (toggle-read-only, after-find-file): Change to be aware
of view-read-only.
(save-some-buffers): Use second argument of view-buffer
instead of setting view-exit-action.
@@ -15186,7 +15191,7 @@
* icon.el (icon-indent-line): A comment ends at the end of the
line, delete call to nonexistent function.
- * icon.el (icon-font-lock-keywords-1): Improved regexp.
+ * icon.el (icon-font-lock-keywords-1): Improve regexp.
(icon-font-lock-keywords-2): Likewise.
1997-06-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -15205,15 +15210,15 @@
1997-06-16 Simon Marshall <simon@gnu.ai.mit.edu>
- * icon.el (icon-imenu-generic-expression): Improved regexp.
- (icon-font-lock-keywords-1): Improved regexps.
+ * icon.el (icon-imenu-generic-expression): Improve regexp.
+ (icon-font-lock-keywords-1): Improve regexps.
(icon-font-lock-keywords-2): Likewise.
(icon-mode): Don't set font-lock-comment-start-regexp via
font-lock-defaults; it is not needed anymore.
1996-06-16 Dan Nicolaescu <done@ece.arizona.edu>
- * icon.el (icon-imenu-generic-expression): Improved regexp.
+ * icon.el (icon-imenu-generic-expression): Improve regexp.
(icon-mode): Don't use pushnew.
1997-06-16 Michelangelo Grigni <mic@mathcs.emory.edu>
@@ -15221,9 +15226,9 @@
* ffap.el (ffap-soft-value): Make this a function again; the macro
version does intern-soft too early. Deleted XEmacs-specific code.
- (ffap-string-at-point-mode-alist): Added "=" and
+ (ffap-string-at-point-mode-alist): Add "=" and
"&" to the url syntax, as suggested by SJE.
- (ffap-read-file-or-url): Fixed the HIST argument to
+ (ffap-read-file-or-url): Fix the HIST argument to
completing-read (only visible in XEmacs?), as reported by
Christoph Wedler <wedler@fmi.uni-passau.de>.
(ffap-kpathsea-expand-path): New func, replaces ffap-add-subdirs,
@@ -15232,7 +15237,7 @@
Added mouse-track support (but no binding), as
suggested by MDB. Moved Emacs mouse bindings from
"down-mouse" events to ordinary mouse events.
- (ffap-alist): Added ffap-fortran-mode, as requested by MDB.
+ (ffap-alist): Add ffap-fortran-mode, as requested by MDB.
Rewrote and merged XEmacs support, eliminating file
ffap-xe.el. Modified ffap-other-frame to work in dedicated
frames, fixing a bug reported by JENS.
@@ -15242,20 +15247,20 @@
(ffap-read-file-or-url): For XEmacs, give extra HACK-HOMEDIR arg
to `abbreviate-file-name'.
(ffap-file-at-point): Suppress errors from `ffap-alist'.
- (ffap-url-at-point): Modified regexp to accept
+ (ffap-url-at-point): Modify regexp to accept
mail hostnames ending with a digit. Fixes bug report of SJE.
(ffap-url-at-point): Use higher level function
(w3-view-this-url t) suggested by wmperry, instead of
w3-zone-at/w3-zone-data or widget-at/widget-get.
- (ffap-url-at-point): Modified to work with
+ (ffap-url-at-point): Modify to work with
w3-version "WWW 2.3.64 1996/06/02 06:20:23" alpha, which
uses the 'widget package rather than the old w3-zone-at.
Bug was reported by JENS.
Adapted comments and doc strings to Emacs coding
conventions. Reorganized. Retired v18 support.
(ffap-bindings): Offers a default installation.
- (ffap-string-at-point): Modified arguments.
- (ffap-gnus-hook): Updated for Gnus 5.
+ (ffap-string-at-point): Modify arguments.
+ (ffap-gnus-hook): Update for Gnus 5.
(ffap-tex-init): Delayed initialization of `ffap-tex-path'.
(ffap-dired): New entry in `ffap-alist'.
(ffap-menu-rescan): May fontify the choices in buffer.
@@ -15304,7 +15309,7 @@
* cus-edit.el (widget-glyph-insert-glyph): Make the invisible
extent open ended.
- * cus-edit.el (custom-format-handler): Added :echo-help to
+ * cus-edit.el (custom-format-handler): Add :echo-help to
visibility widget.
(custom-variable-value-create): Ditto, also for tag.
* wid-edit.el (widget-documentation-string-value-create): Ditto.
@@ -15320,7 +15325,7 @@
* wid-edit.el (widget-tabable-at): New function.
(widget-move): Use it.
- * wid-edit.el (widget-after-change): Reimplemented :secret.
+ * wid-edit.el (widget-after-change): Reimplement :secret.
* wid-edit.el (widget-field-add-space): New option.
(widget-specify-field): Use it.
@@ -15373,7 +15378,7 @@
view-mode-enter or view-mode-exit.
(view-buffer, view-buffer-other-window): New argument exit-action.
(view-file, view-file-other-window, view-buffer-other-window)
- (view-buffer, view-mode-enter): Changed method used to restore
+ (view-buffer, view-mode-enter): Change method used to restore
windows when leaving view mode.
(view-mode-exit): New function.
(view-return-to-alist): New variable.
@@ -15463,7 +15468,7 @@
(widget-documentation-string-value-create): Also use documentation
properties on single line documentation strings.
- * wid-browse.el (widget-minor-mode): Fixed mistake in
+ * wid-browse.el (widget-minor-mode): Fix mistake in
widget-minor-mode - it had semantics of non-interactive calling
reversed.
@@ -15477,7 +15482,7 @@
* add-log.el (add-log-time-format): New variable.
(add-log-iso8601-time-string): New function.
(add-change-log-entry): Use add-log-time-format.
- (add-log-iso8601-time-zone): Renamed from iso8601-time-zone.
+ (add-log-iso8601-time-zone): Rename from iso8601-time-zone.
1997-06-13 Dan Nicolaescu <done@ece.arizona.edu>
@@ -15485,7 +15490,7 @@
(isearch-close-unecessary-overlays): New function.
(isearch-range-invisible): Use them.
- * isearch.el (search-invisible): Changed the semantics,
+ * isearch.el (search-invisible): Change the semantics,
the default value and updated the doc string.
(isearch-opened-overlays): New variable.
(isearch-mode): Initialize it.
@@ -15499,7 +15504,7 @@
opened, open them, add them to isearch-opened-overlays and say
that the range is visible.
- * hideshow.el (hideshow): Added a :prefix.
+ * hideshow.el (hideshow): Add a :prefix.
(hs-isearch-open): New variable.
(hs-flag-region): Use that variable.
Changed the semantics of the FLAG parameter and updated the docs.
@@ -15546,7 +15551,7 @@
Fix error messages.
* text-mode.el (paragraph-indent-text-mode):
- Renamed from spaced-text-mode.
+ Rename from spaced-text-mode.
(text-mode-map): Bind TAB to indent-relative.
(indented-text-mode-map): Variable deleted.
(indented-text-mode): Now an alias for text-mode.
@@ -15564,7 +15569,7 @@
* bibtex.el (bibtex-delete-whitespace, bibtex-current-line)
(bibtex-assoc-of-regexp, bibtex-skip-to-valid-entry)
(bibtex-map-entries):
- Renamed from delete-whitespace, current-line, assoc-of-regexp,
+ Rename from delete-whitespace, current-line, assoc-of-regexp,
skip-to-valid-bibtex-entry, and map-bibtex-entries, respectively.
1997-06-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -15580,14 +15585,14 @@
(reftex-label-alist-builtin): New default environment subfigure.
(reftex-find-duplicate-labels): Temporary buffer is now
"*Duplicate Labels*" instead of "*Help*".
- (reftex-bibtex-selection-callback): Renamed variable found-list.
- (reftex-found-list): Added defvar for this variable.
- (TeX-master): Added defvar for this variable.
+ (reftex-bibtex-selection-callback): Rename variable found-list.
+ (reftex-found-list): Add defvar for this variable.
+ (TeX-master): Add defvar for this variable.
(reftex-reset-mode): Kill temporary buffers associated with RefTeX.
1997-06-10 Ken'ichi Handa <handa@psilocin.gnu.ai.mit.edu>
- * mule-cmds.el (view-hello-file): Adjusted for the changes of
+ * mule-cmds.el (view-hello-file): Adjust for the changes of
coding system names.
1997-06-10 Terrence Brannon <brannon@sand.usc.edu>
@@ -15632,14 +15637,14 @@
1997-06-10 Stefan Schoef <schoef@OFFIS.Uni-Oldenburg.DE>
- * bibtex.el (bibtex-mode-map): Changed the binding of the C-TAB
+ * bibtex.el (bibtex-mode-map): Change the binding of the C-TAB
key, such that XEmacs will understand it, too.
* bibtex.el (bibtex-format-entry, bibtex-end-of-entry): Give specific
error message if not on valid BibTeX entry.
- * bibtex.el (bibtex-field-string-quoted): Small bug fix. Allow
- backslash followed by newline.
+ * bibtex.el (bibtex-field-string-quoted): Small bug fix.
+ Allow backslash followed by newline.
* bibtex.el (bibtex-reposition-window, bibtex-mark-entry): Two new
functions, bound to M-C-l and M-C-h, respectively.
@@ -15657,7 +15662,7 @@
of ---.
(bibtex-font-lock-keywords): Don't treat ALT prefixed entries as
comments.
- (bibtex-entry): Fixed parameter list. This function is not
+ (bibtex-entry): Fix parameter list. This function is not
intended to be called with required and optional fields as
optional arguments anymore.
@@ -15674,7 +15679,7 @@
* bibtex.el (bibtex-submit-bug-report): Report all variables.
* bibtex.el (bibtex-contline-indentation): New user option.
- (bibtex-entry-offset): Renamed from bibtex-entry-indentation.
+ (bibtex-entry-offset): Rename from bibtex-entry-indentation.
* bibtex.el (bibtex-entry-field-alist): Used different order for
some fields (as documented in btxdoc.tex). Changed one of the
@@ -15689,7 +15694,7 @@
* bibtex.el (bibtex-reference-key): Reincluded parentheses.
Parentheses should be disallowed only in field constants.
- * bibtex.el (bibtex-autokey-transcriptions): Fixed bug (two
+ * bibtex.el (bibtex-autokey-transcriptions): Fix bug (two
entries for `\o' while `\oe' entry was missing).
* bibtex.el (bibtex-entry-indentation): New variable to determine
@@ -15697,7 +15702,7 @@
(bibtex-move-outside-of-entry): Use `skip-chars-forward' instead
of `re-search-forward'.
(bibtex-beginning-of-first-entry, bibtex-beginning-of-last-entry):
- Renamed from beginning-of-first-bibtex-entry and
+ Rename from beginning-of-first-bibtex-entry and
beginning-of-last-bibtex-entry. Go to beginning of line, return point.
(bibtex-do-auto-fill, bibtex-make-field, bibtex-entry)
(bibtex-String, bibtex-Preamble): Respect `bibtex-entry-indentation'.
@@ -15709,8 +15714,8 @@
(bibtex-clean-entry): Use `bibtex-reference-maybe-empty-head'
instead of a fixed string.
- * bibtex.el (bibtex-beginning-of-entry, bibtex-end-of-entry): Now
- return point if called from a program.
+ * bibtex.el (bibtex-beginning-of-entry, bibtex-end-of-entry):
+ Now return point if called from a program.
(bibtex-enclosing-field, bibtex-format-entry)
(bibtex-generate-autokey, bibtex-parse-keys, bibtex-mode)
(bibtex-ispell-entry, bibtex-narrow-to-entry, bibtex-sort-buffer)
@@ -15735,12 +15740,12 @@
* bibtex.el (bibtex-entry-delimiters): New variable to determine
if entries shall be delimited by braces or parentheses.
- (bibtex-entry-left-delimiter, bibtex-entry-right-delimiter): New
- helper functions.
- (bibtex-entry, bibtex-String, bibtex-Preamble): Respect
- `bibtex-entry-delimiters'.
+ (bibtex-entry-left-delimiter, bibtex-entry-right-delimiter):
+ New helper functions.
+ (bibtex-entry, bibtex-String, bibtex-Preamble):
+ Respect `bibtex-entry-delimiters'.
(bibtex-entry-format): Doc fix.
- (bibtex-reference-key, bibtex-field-const): Removed parentheses
+ (bibtex-reference-key, bibtex-field-const): Remove parentheses
from allowed characters.
(bibtex-end-of-entry): Better handling of incorrect preambles.
@@ -15758,7 +15763,7 @@
(current-line): New helper function to calculate current
linenumber. Something like this should really be defined somewhere
else in Emacs.
- (bibtex-validate): Changed to show all errors in buffer in a
+ (bibtex-validate): Change to show all errors in buffer in a
`compilation mode' buffer. If there are syntax errors, it aborts
after the syntax check, since higher-level check functions rely on
the syntactical correctness of buffer. If called from another lisp
@@ -15769,7 +15774,7 @@
(twice as high) than `lazy-lock-stealth-time'.
(bibtex-member-of-regexp, assoc-of-regexp): Small cosmetic changes.
- * bibtex.el (bibtex-buffer-last-parsed-tick): Renamed from
+ * bibtex.el (bibtex-buffer-last-parsed-tick): Rename from
bibtex-buffer-last-parsed-for-keys-tick and made it really
buffer-local (bug fix).
(bibtex-parse-keys): Make it use bibtex-buffer-last-parsed-tick.
@@ -15781,7 +15786,7 @@
if it has been aborted.
(bibtex-mode): Run the new function bibtex-parse-buffers-stealthily.
- * bibtex.el (bibtex-generate-autokey): Changed the name part
+ * bibtex.el (bibtex-generate-autokey): Change the name part
generation (bugfix). This function handles now correctly all three
forms of BibTeX names, "First von Last", "von Last, First", "von
Last, Jr, First". In every case the "Last" part is correctly
@@ -15789,15 +15794,15 @@
the first is used. Name fields spread over more than one line are
no problem anymore.
- * bibtex.el (bibtex-entry-format): Changed default value to
+ * bibtex.el (bibtex-entry-format): Change default value to
exclude 'page-dashes. Modified documentation.
(bibtex-autokey-name-change-strings)
(bibtex-autokey-titleword-abbrevs)
(bibtex-autokey-titleword-change-strings, bibtex-entry)
(bibtex-validate): Doc fixes.
(bibtex-mode-map): Bound `C-c $' to bibtex-ispell-abstract.
- (bibtex-generate-autokey): Changed documentation. Small
- modification in calculating title field.
+ (bibtex-generate-autokey): Change documentation.
+ Small modification in calculating title field.
(bibtex-mode): Included bibtex-ispell-entry into the list of
`interesting' functions.
(bibtex-kill-field): Bug fix (killing of first field in entry
@@ -15813,7 +15818,7 @@
* bibtex.el (bibtex-mode-map): bibtex-complete-key wasn't bound
correctly.
- (bibtex-complete): Fixed bug (used string entries defined in
+ (bibtex-complete): Fix bug (used string entries defined in
buffer as object to completion).
* bibtex.el (Menu): Use easymenu. More menu items for
@@ -15834,16 +15839,16 @@
(bibtex-kill-field): Use new variable bibtex-field-kill-ring.
(bibtex-kill-entry): Use new variable bibtex-entry-kill-ring.
- * bibtex.el (bibtex-kill-ring, bibtex-kill-ring-yank-pointer): New
- internal variables like kill-ring and kill-ring-yank-pointer, but
+ * bibtex.el (bibtex-kill-ring, bibtex-kill-ring-yank-pointer):
+ New internal variables like kill-ring and kill-ring-yank-pointer, but
bibtex-kill-ring holds fields or complete reference entries
instead of raw strings.
(bibtex-kill-ring-max): New user option similar to kill-ring-max.
- (bibtex-kill-field): Renamed from bibtex-delete-field again. It
- now supports the new variable bibtex-kill-ring.
+ (bibtex-kill-field): Rename from bibtex-delete-field again.
+ It now supports the new variable bibtex-kill-ring.
(bibtex-copy-field-as-kill, bibtex-kill-entry)
- (bibtex-copy-entry-as-kill, bibtex-yank, bibtex-yank-pop): New
- interactive functions, which work on the bibtex-kill-ring
+ (bibtex-copy-entry-as-kill, bibtex-yank, bibtex-yank-pop):
+ New interactive functions, which work on the bibtex-kill-ring
variable.
(bibtex-insert-current-kill): New helper function to insert
contents of bibtex-kill-ring in an appropriate way.
@@ -15866,9 +15871,9 @@
generation, if year field of current entry is absent.
(bibtex-generate-autokey): Use this new variable.
- * bibtex.el (bibtex-include-OPTannote): Deleted (is set in
+ * bibtex.el (bibtex-include-OPTannote): Delete (is set in
bibtex-user-optional-fields).
- (bibtex-entry, bibtex-print-help-message): Removed support for
+ (bibtex-entry, bibtex-print-help-message): Remove support for
bibtex-include-OPTannote.
* bibtex.el (bibtex-entry-format): New constant
@@ -15877,25 +15882,25 @@
* bibtex.el (bibtex-mode): Set value for
font-lock-mark-block-function.
- * bibtex.el (bibtex-font-lock-keywords): Changed to distinguish
+ * bibtex.el (bibtex-font-lock-keywords): Change to distinguish
optional from ordinary fields.
(bibtex-format-entry, bibtex-print-help-message)
(bibtex-remove-OPT-or-ALT, bibtex-pop): Used simpler regexps.
- * bibtex.el (bibtex-delete-field): Changed from
+ * bibtex.el (bibtex-delete-field): Change from
bibtex-delete-optional-or-alternative-field. Deletes now mandatory
fields as well.
- (bibtex-mode): Changed documentation.
+ (bibtex-mode): Change documentation.
- * bibtex.el (bibtex-entry-type-history, bibtex-key-history): New
- variables to use own histories in BibTeX buffers.
+ * bibtex.el (bibtex-entry-type-history, bibtex-key-history):
+ New variables to use own histories in BibTeX buffers.
(bibtex-entry, bibtex-clean-entry, bibtex-String): Use these new
variables.
* bibtex.el (bibtex-entry, bibtex-make-field): A function can now
be used to generate a fields init string.
(bibtex-include-OPTkey, bibtex-include-OPTannote)
- (bibtex-entry-field-alist): Changed documentation accordingly.
+ (bibtex-entry-field-alist): Change documentation accordingly.
* bibtex.el (bibtex-mode): bibtex-parse-keys on start of mode is
now abortable, too.
@@ -15908,7 +15913,7 @@
* bibtex.el (bibtex-find-entry-location): Bug fix: Insertion into
completely empty buffer didn't work.
- * bibtex.el (bibtex-user-optional-fields): Renamed from
+ * bibtex.el (bibtex-user-optional-fields): Rename from
bibtex-mode-user-optional-fields.
(bibtex-submit-bug-report, bibtex-entry, bibtex-print-help-message):
Use bibtex-user-optional-fields.
@@ -15917,9 +15922,9 @@
delimiting braces and not those inside fields.
* bibtex.el (skip-to-valid-bibtex-entry, bibtex-parse-keys)
- (bibtex-end-of-entry, bibtex-validate, bibtex-reformat): Calculate
- complex regexps outside of loops.
- (bibtex-mode): Changed documentation on how to convert third party
+ (bibtex-end-of-entry, bibtex-validate, bibtex-reformat):
+ Calculate complex regexps outside of loops.
+ (bibtex-mode): Change documentation on how to convert third party
buffers.
* bibtex.el (bibtex-convert-alien): New function to convert a
@@ -15933,7 +15938,7 @@
call of bibtex-parse-keys. This avoids unnecessary double call if
Font Lock mode is chosen for buffer at startup.
- * bibtex.el (bibtex-String, bibtex-Preamble): Renamed from
+ * bibtex.el (bibtex-String, bibtex-Preamble): Rename from
bibtex-string and bibtex-preamble.
(bibtex-String): If bibtex-maintain-sorted-entries and
bibtex-sort-ignore-string-entries are both non-nil, read string
@@ -15941,9 +15946,9 @@
location (as for normal entries).
* bibtex.el (bibtex-autokey-titleword-first-ignore)
- (bibtex-autokey-titleword-abbrevs): Changed documentation: case of
+ (bibtex-autokey-titleword-abbrevs): Change documentation: case of
regexps doesn't matter anymore.
- (bibtex-field-const, bibtex-reference-key): Simplified to not
+ (bibtex-field-const, bibtex-reference-key): Simplify to not
contain uppercase letters.
(member-of-regexp, assoc-of-regexp): Ignore case of regexp.
(map-bibtex-entries): Call function not for every syntactical correct
@@ -15964,24 +15969,24 @@
(bibtex-end-of-entry): Only report an "unknown entry" message if
called interactively.
- * bibtex.el (bibtex-sort-ignore-string-entries): Renamed back from
+ * bibtex.el (bibtex-sort-ignore-string-entries): Rename back from
bibtex-sort-ignore-string-and-preamble. Of course, preambles are
always ignored, since they have no key at all.
(bibtex-string): Slightly less complex regexp.
(skip-to-valid-bibtex-entry): New helper function to skip forward
(or backward) to beginning of next syntactical correct known
- BibTeX entry, if not already there. Respects
- bibtex-sort-ignore-string-entries.
+ BibTeX entry, if not already there.
+ Respects bibtex-sort-ignore-string-entries.
(map-bibtex-entries): Bug fix: It wasn't called for string entries
even if bibtex-sort-ignore-string-entries was nil.
(beginning-of-last-bibtex-entry): New helper function to go to
last entry in buffer.
(bibtex-end-of-entry): Bug fix: Now works with string and preamble
entries as well.
- (bibtex-sort-buffer): Renamed from bibtex-sort-entries. Simplified
+ (bibtex-sort-buffer): Rename from bibtex-sort-entries. Simplified
by using new function skip-to-valid-bibtex-entry. Now only known
entries are checked.
- (bibtex-find-entry-location): Simplified by using new functions
+ (bibtex-find-entry-location): Simplify by using new functions
skip-to-valid-bibtex-entry and beginning-of-last-bibtex-entry.
Only known entries are used to determine location.
(bibtex-validate): Now checks string entries, too.
@@ -15989,8 +15994,8 @@
bibtex-end-of-entry.
* bibtex.el (bibtex-end-of-entry): Don't use forward-sexp anymore,
- since this fails on entries with non-escaped double-quotes. Use
- search-bibtex-reference instead (though it is slower, it is more
+ since this fails on entries with non-escaped double-quotes.
+ Use search-bibtex-reference instead (though it is slower, it is more
reliable).
(bibtex-ispell-abstract): Use normal regexps created by
bibtex-cfield instead of special ones.
@@ -16002,7 +16007,7 @@
work, since due to a bug all entries were simply skipped.
* bibtex.el (bibtex-mode): Doc fix.
- (bibtex-delete-optional-or-alternative-field): Renamed from
+ (bibtex-delete-optional-or-alternative-field): Rename from
bibtex-kill-optional-or-alternative-field.
(bibtex-delete-optional-or-alternative-field, bibtex-empty-field):
Use delete-region, not kill-region.
@@ -16015,7 +16020,7 @@
buffer, died on entries with `@' in other than first column).
(beginning-of-first-bibtex-entry, bibtex-format-entry)
(bibtex-beginning-of-entry, bibtex-validate, bibtex-clean-entry):
- Changed to allow BibTeX entries to start in a column different
+ Change to allow BibTeX entries to start in a column different
from 1 (but still for speed reasons only whitespace is allowed
prior to the `@' on the same line.
@@ -16039,21 +16044,21 @@
(bibtex-find-entry-location): A bug had been introduced by using
search-bibtex-reference instead of re-search-forward (fixed).
- * bibtex.el (bibtex-field-delimiters): Renamed from
+ * bibtex.el (bibtex-field-delimiters): Rename from
bibtex-field-delimiter.
(bibtex-entry-format): Constant empty-opts renamed to
empty-opts-or-alts.
- (bibtex-remove-delimiters): Renamed from
+ (bibtex-remove-delimiters): Rename from
bibtex-remove-double-quotes-or-braces.
(bibtex-reformat): New function.
* bibtex.el (bibtex-fill-entry): New function to refill entry.
- (bibtex-mode-map): Defined key for bibtex-fill-entry.
+ (bibtex-mode-map): Define key for bibtex-fill-entry.
* bibtex.el (bibtex-field-delimiter): Substitutes variables
bibtex-field-left-delimiter and bibtex-field-right-delimiter.
- (bibtex-field-left-delimiter, bibtex-field-right-delimiter): New
- helper functions.
+ (bibtex-field-left-delimiter, bibtex-field-right-delimiter):
+ New helper functions.
(bibtex-make-field, bibtex-pop): Use new variable
bibtex-field-delimiter.
(bibtex-empty-field, bibtex-string): Use new functions
@@ -16079,23 +16084,23 @@
(bibtex-mode): Don't set fill-prefix anymore, but use new function
bibtex-do-auto-fill.
- * bibtex.el (bibtex-find-entry-location): Fixed bug (when
+ * bibtex.el (bibtex-find-entry-location): Fix bug (when
bibtex-maintain-sorted-entries was non-nil, an entry with a key
greater than all other keys wasn't inserted in the correct place).
* bibtex.el (bibtex-mode): Don't use bibtex-auto-fill-function
anymore, but use directly variable fill-prefix.
- * bibtex.el (bibtex-find-entry-location): Fixed bug (on duplicate
+ * bibtex.el (bibtex-find-entry-location): Fix bug (on duplicate
keys, point must move to beginning of entry, so that bibtex-entry
works correctly).
- * bibtex.el (bibtex-complete): Fixed bug (parameter string-list
+ * bibtex.el (bibtex-complete): Fix bug (parameter string-list
was mistakenly altered by the function itself).
* bibtex.el (bibtex-mode-map): Bind bibtex-complete-key to C-TAB.
- * bibtex.el (bibtex-validate): Renamed from bibtex-validate-buffer
+ * bibtex.el (bibtex-validate): Rename from bibtex-validate-buffer
since it can acts on region if active. Use search-bibtex-reference.
(search-bibtex-reference): New function to be used in places where
prior a re-search-{forward|backward} for bibtex-reference or
@@ -16108,22 +16113,22 @@
bibtex-enclosing-reference-maybe-empty-head.
(bibtex-reference-infix, bibtex-reference-postfix): New constants
necessary due to splitting bibtex-reference.
- (bibtex-reference): Deleted.
- (bibtex-type-in-reference, skip-whitespace-and-comments): Deleted.
+ (bibtex-reference): Delete.
+ (bibtex-type-in-reference, skip-whitespace-and-comments): Delete.
* bibtex.el (bibtex-mode): Don't turn auto-fill-mode on. Use new
variable normal-auto-fill-function.
- * bibtex.el (bibtex-field-string): Simplified.
+ * bibtex.el (bibtex-field-string): Simplify.
- * bibtex.el (bibtex-mode-syntax-table): Changed syntax of
+ * bibtex.el (bibtex-mode-syntax-table): Change syntax of
double-quote back to quote syntax.
* bibtex.el (bibtex-complete): New generic function for interface
functions bibtex-complete-string and bibtex-complete-key.
(bibtex-complete-key): New function.
- * bibtex.el (bibtex-sort-ignore-string-and-preamble): Renamed from
+ * bibtex.el (bibtex-sort-ignore-string-and-preamble): Rename from
bibtex-sort-ignore-string-entries.
(map-bibtex-entries): Use bibtex-sort-ignore-string-and-preamble
and ignore preamble entries as well.
@@ -16147,10 +16152,10 @@
mark is active. With optional argument checks if required fields
are missing, too.
- * bibtex.el (bibtex-mode): Added support for imenu.
+ * bibtex.el (bibtex-mode): Add support for imenu.
* bibtex.el (bibtex-entry-field-alist)
- (bibtex-mode-user-optional-fields): Modified syntax to allow
+ (bibtex-mode-user-optional-fields): Modify syntax to allow
preinitialization of fields.
(bibtex-make-field, bibtex-make-optional-field):
Support preinitialization of fields.
@@ -16161,21 +16166,21 @@
(bibtex-generate-autokey): Use new variables.
* bibtex.el (bibtex-field-const, bibtex-reference-type)
- (bibtex-reference-key): Changed to match the (according to Oren
+ (bibtex-reference-key): Change to match the (according to Oren
Patashnik) allowed characters.
- * bibtex.el (bibtex-clean-entry-zap-empty-opts-or-alts): Renamed
- from bibtex-clean-entry-zap-empty-opts.
+ * bibtex.el (bibtex-clean-entry-zap-empty-opts-or-alts):
+ Rename from bibtex-clean-entry-zap-empty-opts.
(bibtex-entry-field-alist): Slightly modified syntax to support
alternative fields needed for Book and InBook references.
(bibtex-font-lock-keywords, bibtex-print-help-message)
(bibtex-make-field, bibtex-pop, bibtex-clean-entry):
Support ALT prefixed entries.
- (bibtex-mode): Documented new ALT prefixed fields.
- (bibtex-make-optional-field): Modified to give only field name as
+ (bibtex-mode): Document new ALT prefixed fields.
+ (bibtex-make-optional-field): Modify to give only field name as
arg to bibtex-make-field.
(bibtex-remove-OPT-or-ALT, bibtex-kill-optional-or-alternative-field):
- Renamed from bibtex-remove-OPT and bibtex-kill-optional-field,
+ Rename from bibtex-remove-OPT and bibtex-kill-optional-field,
respectively. Modified to support ALT prefixes.
* bibtex.el (bibtex-enclosing-field, bibtex-print-help-message):
@@ -16215,29 +16220,29 @@
1997-06-09 Kenichi Handa <handa@etl.go.jp>
- * mule.el: Delete declaration for buffer-file-coding-system. It
- is done in buffer.c now. In the comment, change coding-system to
+ * mule.el: Delete declaration for buffer-file-coding-system.
+ It is done in buffer.c now. In the comment, change coding-system to
coding system. The name coding-vector is changed to coding-spec.
(coding-vector-type, coding-vector-mnemonic)
- (coding-vector-docstring, coding-vector-flags): Deleted.
+ (coding-vector-docstring, coding-vector-flags): Delete.
(coding-system-spec-ref): New function.
(coding-system-type, coding-system-mnemonic, coding-system-flags):
Use coding-system-spec-ref.
- (coding-system-doc-string): Renamed from coding-system-docstring.
- (coding-system-eol-type): Renamed from coding-system-eoltype.
- (coding-system-eol-type-mnemonic): Moved to mule-util.el.
+ (coding-system-doc-string): Rename from coding-system-docstring.
+ (coding-system-eol-type): Rename from coding-system-eoltype.
+ (coding-system-eol-type-mnemonic): Move to mule-util.el.
(coding-system-post-read-conversion): Likewise.
(coding-system-pre-write-conversion): Likewise.
- (default-process-coding-system): Deleted. Now declared in
+ (default-process-coding-system): Delete. Now declared in
buffer.c.
(make-subsidiary-coding-system): New function.
(make-coding-system): Check arguments more strictly. Do not make
-unix, -dos, -mac variants for TYPE 4.
(define-coding-system-alias): Call make-subsidiary-coding-system.
- (set-buffer-file-coding-system): Adjusted for the function name
+ (set-buffer-file-coding-system): Adjust for the function name
changes.
(find-new-buffer-file-coding-system): Likewise.
- (default-process-coding-system): Deleted. Now defined in coding.c.
+ (default-process-coding-system): Delete. Now defined in coding.c.
* mule-conf.el: Coding system names changed.
@@ -16269,7 +16274,7 @@
(print-coding-system): Likewise.
(list-coding-systems): Likewise. Make it interactive.
- * mule-util.el (set-coding-system-alist): Deleted.
+ * mule-util.el (set-coding-system-alist): Delete.
(string-to-sequence): Doc string modified.
(coding-system-list): Add optional arg BASE-ONLY.
(coding-system-base): New function.
@@ -16362,14 +16367,14 @@
1997-06-07 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * files.el (file-name-non-special): Handle
- file-name-completion and file-name-all-completions.
+ * files.el (file-name-non-special):
+ Handle file-name-completion and file-name-all-completions.
* mailalias.el: Customize. Doc fixes.
Mark some risky local variables.
* dired.el (dired-unmark-all-marks):
- Renamed from dired-unmark-all-files-no-query.
+ Rename from dired-unmark-all-files-no-query.
* language/european.el (setup-8-bit-environment):
Load the file with load, not require, so that we reload it if nec.
@@ -16377,28 +16382,28 @@
* language/english.el ("English"): Improve doc string.
* language/indian.el (describe-indian-environment-map):
- Renamed from describe-indian-support-map.
+ Rename from describe-indian-support-map.
* language/devanagari.el: Corresponding changes.
* language/european.el (describe-european-environment-map):
- Renamed from describe-european-support-map.
+ Rename from describe-european-support-map.
* language/cyrillic.el (describe-cyrillic-environment-map):
- Renamed from describe-cyrillic-support-map.
+ Rename from describe-cyrillic-support-map.
* language/chinese.el (describe-chinese-environment-map):
- Renamed from describe-chinese-support-map.
+ Rename from describe-chinese-support-map.
* mule-cmds.el (describe-language-environment):
- Renamed from describe-language-support.
+ Rename from describe-language-support.
Do the real work here; don't call describe-specified-language-support.
Print the mnemonics when mentioning coding systems.
Improve style of output.
(describe-specified-language-environment):
- Renamed from describe-specified-language-support.
+ Rename from describe-specified-language-support.
Don't do the work here; call describe-language-environment.
(describe-language-environment-map):
- Renamed from describe-language-support-map.
+ Rename from describe-language-support-map.
* language/european.el (setup-8-bit-environment):
Do not set set-case-syntax-offset.
@@ -16446,7 +16451,7 @@
1997-06-04 Per Abrahamsen <abraham@dina.kvl.dk>
- * wid-edit.el (widget-kill-line): Fixed for overlays.
+ * wid-edit.el (widget-kill-line): Fix for overlays.
* cus-edit.el (custom-buffer-create-internal): Show full
documentation string in buffers with only a single item.
@@ -16462,9 +16467,9 @@
(widget-field-end): Workaround for local-map at
end of overlay.
(widget-specify-field): Ditto.
- (widget-move): Fixed but with single button buffers.
+ (widget-move): Fix but with single button buffers.
- * cus-edit.el (custom-buffer-create-internal): Improved help
+ * cus-edit.el (custom-buffer-create-internal): Improve help
strings for reset buttons.
* wid-edit.el (widget-move): Restored support for
@@ -16472,7 +16477,7 @@
(widget-documentation-string-value-create): Restore support for
`widget-documentation--face'.
- * cus-edit.el (customize-variable-other-window): Added defalias.
+ * cus-edit.el (customize-variable-other-window): Add defalias.
* widget.el (:complete): New keyword.
(:complete-function): New keyword.
@@ -16519,7 +16524,7 @@
1997-06-02 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * text-mode.el (spaced-text-mode): Renamed from text-mode.
+ * text-mode.el (spaced-text-mode): Rename from text-mode.
But change the mode name and hooks.
(text-mode): Put the guts of indented-text-mode here.
But don't define text-mode-abbrev-table, just use it.
@@ -16539,14 +16544,14 @@
1997-06-02 Michael Kifer <kifer@cs.sunysb.edu>
- * ediff-util.el (ediff-toggle-multiframe): Improved.
- (ediff-setup, ediff-inferior-compare-regions): Modified.
+ * ediff-util.el (ediff-toggle-multiframe): Improve.
+ (ediff-setup, ediff-inferior-compare-regions): Modify.
(ediff-setup): Bug fixed.
* ediff-init.el (ediff-file-attributes): Use ediff-file-remote-p.
* ediff-wind.el (ediff-setup-windows-multiframe-merge)
- (ediff-setup-windows-multiframe-compare): Improved window placement.
+ (ediff-setup-windows-multiframe-compare): Improve window placement.
* ediff-diff.el (ediff-make-fine-diffs):
- Fixed messages about whitespace regions.
+ Fix messages about whitespace regions.
* ediff-wind.el, ediff-ptch.el, ediff-mult.el, ediff-merg.el:
custom.el'ed.
@@ -16555,11 +16560,11 @@
* viper-init.el (vip-parse-sexp-ignore-comments): New variable.
* viper-cmd.el (vip-paren-match): Parsing comments is now controlled
with vip-parse-sexp-ignore-comments.
- * viper-cmd.el (vip-goto-col): Fixed.
+ * viper-cmd.el (vip-goto-col): Fix.
* viper-cmd.el (vip-autoindent): Now expands abbrevs.
(vip-adjust-keys-for): Unbinds vip-autoindent, if vip-auto-indent
is nil.
- * viper-cmd.el (vip-prefix-arg-value): Fixed computation of integer
+ * viper-cmd.el (vip-prefix-arg-value): Fix computation of integer
prefix args.
* viper-cmd.el, viper-init.el: New files.
@@ -16612,14 +16617,14 @@
1997-06-01 Dan Nicolaescu <done@ece.arizona.edu>
- * hideshow.el (hs-show-hidden-short-form): Updated doc string.
+ * hideshow.el (hs-show-hidden-short-form): Update doc string.
(hs-adjust-block-beginning): Likewise.
(hs-special-modes-alist): C and C++ should also use
hs-c-like-adjust-block-beginning.
(hs-find-block-beginning): If hs-adjust-block-beginning is t and
we apply hs-adjust-block-beginning and we reach the point means
that we found the block beginning.
- (hs-c-like-adjust-block-beginning): Renamed from
+ (hs-c-like-adjust-block-beginning): Rename from
java-hs-adjust-block-beginning.
1997-06-01 Simon Leinen <simon@switch.ch>
@@ -16661,7 +16666,7 @@
getting read-only bob and eob in XEmacs.
* wid-browse.el (widget-browse-at): Use `get-char-property'
instead of `get-text-property'.
- * widget.el (:value-from :value-to): Deleted.
+ * widget.el (:value-from :value-to): Delete.
* widget.el (:button-overlay, :field-overlay): New keywords.
* wid-edit.el (widget-default-delete): Delete overlays.
(widget-field-value-delete): Delete overlay.
@@ -16695,7 +16700,7 @@
1997-06-01 Per Abrahamsen <abraham@dina.kvl.dk>
- * cus-edit.el (custom-format-handler): Changed look of group
+ * cus-edit.el (custom-format-handler): Change look of group
indicators.
* wid-edit.el (widget-kill-line): Use forward-line instead of
@@ -16711,10 +16716,10 @@
* cus-edit.el (custom-variable-prompt):
Handle variable-at-point returning 0.
- (customize-option): Renamed from custom-variable.
+ (customize-option): Rename from custom-variable.
(customize-variable): Add it as an alias.
(customize-option-other-window):
- Renamed from customize-variable-other-window.
+ Rename from customize-variable-other-window.
(custom-load-symbol): Search for both short and absolute
names of the library, when avoiding duplicate loading.
@@ -16756,9 +16761,9 @@
* cus-edit.el (custom-format-handler): New %e and %- escapes.
(custom-group): Use them.
- * widget.el (:widget-doc): Removed keyword.
- * wid-edit.el (widget-help): Removed widget.
- (widget-help-action): Removed function.
+ * widget.el (:widget-doc): Remove keyword.
+ * wid-edit.el (widget-help): Remove widget.
+ (widget-help-action): Remove function.
* widget.el (:documentation-shown): New keyword.
* wid-edit.el (documentation-string): New widget.
@@ -16802,7 +16807,7 @@
* mule-cmds.el (set-language-environment): Add autoload cookie.
Renamed from setup-language-environment.
- * startup.el (iso-8859-n-locale-regexp): Renamed from
+ * startup.el (iso-8859-n-locale-regexp): Rename from
iso-8859-1-locale-regexp.
* loadup.el: Always load faces.el.
@@ -16851,8 +16856,8 @@
* icomplete.el: Integrated Emacs 19.34 and XEmacs 19.15 corrections
(typos, style, command revisions, etc).
- * icomplete.el: Integrated immediate keybindings display. See
- `icomplete-show-key-bindings', `icomplete-get-keys', and
+ * icomplete.el: Integrated immediate keybindings display.
+ See `icomplete-show-key-bindings', `icomplete-get-keys', and
`icomplete-completions'.
* icomplete.el (icomplete-get-keys): Return keys bound in prior
@@ -16898,7 +16903,7 @@
* cus-edit.el (custom-magic-alist): Shortened message.
- * cus-edit.el (custom-help-menu): Updated names.
+ * cus-edit.el (custom-help-menu): Update names.
* cus-edit.el: Say `invoke' instead of `activate'.
* wid-edit.el: Ditto.
@@ -16925,13 +16930,13 @@
(widget-glyph-insert-glyph): No tag here.
(widget-push-button-value-create): But here.
- * wid-edit.el (widget-field-face): Changed to dim gray.
+ * wid-edit.el (widget-field-face): Change to dim gray.
* wid-edit.el (widget-push-button-prefix): New option.
(widget-push-button-suffix): New option.
(widget-button): New group.
- * widget.el (:text-format): Removed.
+ * widget.el (:text-format): Remove.
(:button-suffix): New keyword.
(:button-prefix): New keyword.
@@ -16952,7 +16957,7 @@
* cus-edit.el (custom-magic-alist): Use `invoke' instead of
`push'.
- * cus-edit.el (custom-magic-alist): Changed rogue state message.
+ * cus-edit.el (custom-magic-alist): Change rogue state message.
* custom.el (defface): Doc fix.
@@ -16962,13 +16967,13 @@
* cus-edit.el, custom.el: Renamed `factory' to `standard'
everywhere.
- * cus-edit.el (custom-magic-show-button): Changed default to
+ * cus-edit.el (custom-magic-show-button): Change default to
`nil'.
- (custom): Removed `:format'.
- (custom-variable): Removed level button.
+ (custom): Remove `:format'.
+ (custom-variable): Remove level button.
(custom-face): Ditto.
- (custom-level): Deleted.
- (custom-level-action): Deleted.
+ (custom-level): Delete.
+ (custom-level-action): Delete.
(custom-format-handler): Update caller.
(custom-group-magic-alist): Merged into `custom-magic-alist'.
(custom-magic-value-create): Use merged `custom-magic-alist'.
@@ -16991,8 +16996,8 @@
* icomplete.el: Integrated Emacs 19.34 and XEmacs 19.15
corrections (typos, style, command revisions, etc).
- Integrated hacked up XEmacs immediate keybindings display. See
- `icomplete-show-key-bindings', `icomplete-get-keys', and
+ Integrated hacked up XEmacs immediate keybindings display.
+ See `icomplete-show-key-bindings', `icomplete-get-keys', and
`icomplete-completions'. Doesn't work with mainline GNU
Emacs 19.34 (because the cmdloop doesn't set owindow, and the
current-local-map doesn't take optional buffer arg), so feature
@@ -17041,7 +17046,7 @@
SYNTACTIC-PROPERTIES. Eval font-lock-syntactic-keywords with
font-lock-eval-keywords. Compile and compare all keywords.
(fast-lock-get-syntactic-properties): New function.
- (fast-lock-add-properties): Renamed from fast-lock-set-face-properties.
+ (fast-lock-add-properties): Rename from fast-lock-set-face-properties.
Take new arg SYNTACTIC-PROPERTIES and add syntax-table text properties.
Now fast-lock.el saves a buffer's value of font-lock-syntactic-keywords
and syntax-table text properties as added by font-lock.el.
@@ -17128,7 +17133,7 @@
set-current-process-coding-system.
* encoded-kb.el (encoded-kbd-mode): Fix typo in doc-string.
- (encoded-kbd-set-coding-system): Deleted.
+ (encoded-kbd-set-coding-system): Delete.
* case-table.el (describe-buffer-case-table): Use aref instead of
set-char-table-range.
@@ -17146,10 +17151,10 @@
(describe-specified-language-support): New function.
(describe-language-support): Call the above function.
(universal-coding-system-argument): New function.
- (read-language-and-input-method-name): Doc-string fixed. If
- default-input-method is nil, use previous-input-method as the
+ (read-language-and-input-method-name): Doc-string fixed.
+ If default-input-method is nil, use previous-input-method as the
default value.
- (set-default-input-method): Deleted.
+ (set-default-input-method): Delete.
* language/*.el: Most of setup-LANGUAGE-environment functions are
moved form LANGUAGE.el to LANG-util.el. These functions now at
@@ -17265,7 +17270,7 @@
also accept a subdir with a file called `index'.
* texinfmt.el (texinfo-extra-inter-column-width):
- Renamed from extra-inter-column-width. Doc fix.
+ Rename from extra-inter-column-width. Doc fix.
(texinfo-multitable-buffer-name):
Variable renamed from multitable-temp-buffer-name.
(texinfo-multitable-rectangle-name):
@@ -17386,8 +17391,8 @@
read-only data someday.
(eldoc-docstring-message): If truncating symbol name, show ending
of name rather than beginning. The former is generally more unique.
- (eldoc-function-argstring-from-docstring-method-table): Handle
- pathological `save-restriction' case.
+ (eldoc-function-argstring-from-docstring-method-table):
+ Handle pathological `save-restriction' case.
[top level]: Add `indent-for-tab-command' to eldoc-message-commands.
1997-05-21 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -17433,18 +17438,18 @@
(ada-font-lock-keywords-1): Move "task" before "task (body|type)" to
correct highlighting (regexp depends on order).
- * ada-mode.el (ada-in-char-const-p): Renamed from `ada-after-char-p'.
+ * ada-mode.el (ada-in-char-const-p): Rename from `ada-after-char-p'.
Also test following character.
(ada-adjust-case): Use better function `ada-in-char-const-p'.
(ada-in-string-or-comment-p): Test for being in a char constant.
- (ada-clean-buffer-before-saving): Changed default to t.
+ (ada-clean-buffer-before-saving): Change default to t.
(ada-mode): Set `font-lock-defaults' for Emacs only, use properties
for XEmacs.
- * ada-mode.el (ada-indent-newline-indent): Simplified by just calling
+ * ada-mode.el (ada-indent-newline-indent): Simplify by just calling
`ada-indent-current'.
- * ada-mode.el (ada-end-stmt-re): Added word delimiters in regexp.
+ * ada-mode.el (ada-end-stmt-re): Add word delimiters in regexp.
Removed `interactive' statements which were needed only for debugging.
* ada-mode.el:
@@ -17472,7 +17477,7 @@
(ada-goto-next-word): Generalized old `ada-goto-previous-word' for
both directions.
- * ada-mode.el (ada-indent-function): Removed unnecessary `package' case.
+ * ada-mode.el (ada-indent-function): Remove unnecessary `package' case.
(ada-get-indent-case): Before testing for `=>', be sure there is
an `is'.
(ada-search-prev-end-stmt): Test for `separate' keyword on the
@@ -17485,8 +17490,8 @@
* ada-mode.el: Doc fixes.
(ada-mode): Support new font-lock-mode.
- (ada-format-paramlist): Changed all `accept' to `access'.
- (ada-insert-paramlist): Changed all `accept' to `access'.
+ (ada-format-paramlist): Change all `accept' to `access'.
+ (ada-insert-paramlist): Change all `accept' to `access'.
(ada-in-comment-p): Use standard Emacs way `parse-partial-sexp'.
(ada-font-lock-keywords-1): Regexps in not byte-compiled code behave
different than byte-compiled regexps.
@@ -17513,7 +17518,7 @@
1997-05-20 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * word-help.el (set-word-help-file): Renamed from set-help-file.
+ * word-help.el (set-word-help-file): Rename from set-help-file.
* crisp.el (crisp-mode): Add autoload cookie.
@@ -17523,7 +17528,7 @@
* dos-w32.el (add-untranslated-filesystem)
(remove-untranslated-filesystem): Add interactive spec.
- * crisp.el (crisp-last-last-command): Renamed from last-last-command
+ * crisp.el (crisp-last-last-command): Rename from last-last-command
and defvar added.
* levents.el (event-closest-point): Fix paren error.
@@ -17601,12 +17606,12 @@
(compilation-revert-buffer): New function.
(compilation-mode): Set revert-buffer-function.
- * files.el (revert-without-query): Renamed from
+ * files.el (revert-without-query): Rename from
find-file-revert-without-query.
(find-file-noselect): Use new option.
(revert-buffer): Check the option here too.
- * cus-face.el (custom-facep): Defined (once again).
+ * cus-face.el (custom-facep): Define (once again).
* simple.el (do-auto-fill): Check enable-kinsoku and
enable-multibyte-characters.
@@ -17623,7 +17628,7 @@
1997-05-16 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
- * autoload.el (update-autoloads-from-directories): Renamed from
+ * autoload.el (update-autoloads-from-directories): Rename from
update-autoloads-from-directory. Take multiple directories as args.
Use locate-library to find loaddefs.el and the top level Lisp dir.
(batch-update-autoloads): Call update-autoloads-from-directories.
@@ -17665,11 +17670,11 @@
* mule-cmds.el (set-language-info): Change the special treatment
of key 'describe-function to 'documentation.
- (describe-specified-language-support): Renamed from
+ (describe-specified-language-support): Rename from
describe-language-support-internal. Get language name from
last-command-event.
- (describe-language-support): Call
- describe-specified-language-support.
+ (describe-language-support):
+ Call describe-specified-language-support.
* language/chinese.el: Delete functions describe-LANGUAGE-support.
Delete 'describe-function entries and change 'documentation
@@ -17786,13 +17791,13 @@
(default): Use `:mouse-down-action'.
(menu-choice): Ditto.
(widget-choice-mouse-down-action): New function.
- (widget-info-link-action): Removed kludge to steal up event.
+ (widget-info-link-action): Remove kludge to steal up event.
* cus-edit.el (widget-magic-mouse-down-action): New function.
(custom-magic-value-create): Use it.
- (custom-buffer-create-internal): Removed kludge to steal up event.
+ (custom-buffer-create-internal): Remove kludge to steal up event.
- * widget.el (:glyph-up, :glyph-down, :glyph-inactive): New
- keywords.
+ * widget.el (:glyph-up, :glyph-down, :glyph-inactive):
+ New keywords.
* wid-edit.el (widget-glyph-insert-glyph): Support optional `down'
and `inactive' glyphs.
(widget-push-button-value-create): Ditto.
@@ -17806,8 +17811,8 @@
(customize-variable-other-window, customize-face)
(customize-face-other-window, customize-customized)
(customize-saved, customize-apropos, custom-face-menu-create)
- (custom-variable-menu-create, boolean, custom-menu-create): Updated
- caller.
+ (custom-variable-menu-create, boolean, custom-menu-create):
+ Update caller.
* cus-edit.el (custom-variable-action): Reset magic state.
(custom-variable-menu): Allow `Reset to Current' on `changed'
@@ -17848,24 +17853,24 @@
(choice, radio): Use it.
(widget-prompt-value): Prepend widget type to prompt.
- * wid-edit.el (widget-parent-action): Renamed from
+ * wid-edit.el (widget-parent-action): Rename from
`widget-choice-item-action'.
- (choice-item): Updated widget.
+ (choice-item): Update widget.
* cus-edit.el (custom-magic): Ditto.
- * wid-edit.el (widget-children-validate): Renamed from
+ * wid-edit.el (widget-children-validate): Rename from
`widget-editable-list-validate'.
- (editable-list, group): Updated widgets.
+ (editable-list, group): Update widgets.
* cus-edit.el (custom, face): Ditto.
- * wid-edit.el (widget-value-value-get): Renamed from
+ * wid-edit.el (widget-value-value-get): Rename from
`widget-item-value-get'.
- (item): Updated widget.
+ (item): Update widget.
* cus-edit.el (face, custom): Ditto.
- * wid-edit.el (widget-value-convert-widget): Renamed from
+ * wid-edit.el (widget-value-convert-widget): Rename from
`widget-item-convert-widget'.
- (item, editable-field): Updated widgets.
+ (item, editable-field): Update widgets.
* cus-edit.el (face): Ditto.
1997-05-14 Simon Marshall <simon@wombat.gnu.ai.mit.edu>
@@ -17981,13 +17986,13 @@
* gnus-mule.el: Moved to `gnus' subdirectory.
- * gnus/gnus-mule.el (gnus-mule-message-send-news-function): New
- function to encode text before sending by news.
+ * gnus/gnus-mule.el (gnus-mule-message-send-news-function):
+ New function to encode text before sending by news.
(gnus-mule-message-send-mail-function): New function to encode
text before sending by mail.
(gnus-mule-initialize): Add gnus-mule-message-send-news-function
- to the hook message-send-news-hook. Add
- gnus-mule-message-send-mail-function to the hook
+ to the hook message-send-news-hook.
+ Add gnus-mule-message-send-mail-function to the hook
message-send-mail-hook.
* help.el (help-with-tutorial): Fix a bug of handling non-English
@@ -18031,16 +18036,16 @@
Setting of syntax and category for Devanagari characters are moved
to characters.el.
- * language/english.el (setup-english-environment): Set
- sendmail-coding-system and rmail-file-coding-system to nil.
+ * language/english.el (setup-english-environment):
+ Set sendmail-coding-system and rmail-file-coding-system to nil.
* language/ethio-util.el (fidel-to-tex-map): Name changed to
ethio-fidel-to-tex-map.
* language/european.el: Typo in comment fixed.
- * language/japanese.el (setup-japanese-environment): Set
- sendmail-coding-system and rmail-file-coding-system to
+ * language/japanese.el (setup-japanese-environment):
+ Set sendmail-coding-system and rmail-file-coding-system to
'iso-2022-jp.
* language/korean.el: Bug fixed in making coding system
@@ -18090,8 +18095,8 @@
(rmail-convert-file): Comment fixed.
(rmail-revert): Don't decode RMAIL file again because the backup
file is saved in Emacs' internal format.
- (rmail-convert-to-babyl-format): Check
- rmail-enable-decoding-message.
+ (rmail-convert-to-babyl-format):
+ Check rmail-enable-decoding-message.
* term/x-win.el: Create bold, italic, and bold-italic variants of
default fontset. Name a fontset created from user-specified ASCII
@@ -18133,7 +18138,7 @@
* simple.el (assoc-ignore-case): Downcase KEY as well as element cars.
* bibtex.el (assoc-ignore-case): Function deleted.
- (bibtex-member-of-regexp): Renamed from member-of-regexp.
+ (bibtex-member-of-regexp): Rename from member-of-regexp.
Call changed.
* timer.el (timer-event-handler): Take timer as arg directly.
@@ -18335,7 +18340,7 @@
(compilation-shell-minor-mode-map, compilation-shell-minor-mode):
New variables.
(compile-auto-highlight): Doc fix.
- (compilation-error-regexp-alist): Removed unnecessary line break
+ (compilation-error-regexp-alist): Remove unnecessary line break
in first regexp. Replaced \\(\\|.* on \\) by \\(.* on \\)? in
regexp for Absoft FORTRAN 77 Compiler 3.1.3. Added regexp for
SPARCcompiler Pascal. Divided long line in regexp for Cray C
@@ -18349,7 +18354,7 @@
(compilation-leave-directory-regexp-alist): New variables.
(compilation-file-regexp-alist)
(compilation-nomessage-regexp-alist): New variables.
- (grep-regexp-alist): Removed unnecessary ^ at beginning of regexp.
+ (grep-regexp-alist): Remove unnecessary ^ at beginning of regexp.
(compilation-enter-directory-regexp)
(compilation-leave-directory-regexp): Variables deleted.
Replaced by compilation-enter-directory-regexp-alist and
@@ -18389,7 +18394,7 @@
* cus-edit.el (custom-group-magic-alist): New variable.
(custom-group-state-update): Use custom-group-magic-alist.
- (customize-group): Renamed from `customize',
+ (customize-group): Rename from `customize',
and rename argument to GROUP.
(customize): New function.
@@ -18413,7 +18418,7 @@
* time-stamp.el (time-stamp-old-format-warn): Fix a tag string.
(time-stamp-format): Use %Y not %y in default value.
- * crisp.el (crisp-load-scroll-all): Renamed from ...-lock.
+ * crisp.el (crisp-load-scroll-all): Rename from ...-lock.
(crisp-mode): Use scroll-all... not scroll-lock...
* scroll-all.el: Renamed from scroll-lock.el.
@@ -18471,7 +18476,7 @@
* ange-ftp.el (ange-ftp-file-entry-p): If ange-ftp-get-files returns
nil, don't try ange-ftp-hash-entry-exists-p, just give up.
- * comint.el (comint-input-face): Deleted.
+ * comint.el (comint-input-face): Delete.
* compile.el (compilation-error-regexp-alist): Add regexp for Perl -w.
@@ -18510,34 +18515,34 @@
"In" or "Out" command tells you if you are already on or off the bus.
* dunnet.el (dun-sauna-heat):
- Changed "begin to sweat" to "are perspiring"
+ Change "begin to sweat" to "are perspiring"
so that it makes sense whether you are heating up or cooling down.
* dunnet.el (dun-help):
- Changed author e-mail address, added web page.
+ Change author e-mail address, added web page.
Added hint for batch mode.
* dunnet.el (*global*):
- Fixed spelling of Presely in global object list.
+ Fix spelling of Presely in global object list.
* dunnet.el (*global*):
- Added coconuts, tank, and lake as objects that are recognized.
+ Add coconuts, tank, and lake as objects that are recognized.
* dunnet.el (*global*):
- Added `slip' as another way of describing the paper,
+ Add `slip' as another way of describing the paper,
and `chip' as another way of describing the CPU.
* dunnet.el (*global*):
Upcase abbreviations of directions in room descriptions.
* dunnet.el (dun-login):
- Fixed erroneous login message to better-describe ftp limitations.
+ Fix erroneous login message to better-describe ftp limitations.
* dunnet.el (dun-rlogin):
- Added error message if user tries to rlogin back to pokey.
+ Add error message if user tries to rlogin back to pokey.
* dunnet.el (dun-load-d):
- Fixed so that if restore file isn't found which in non-batch mode,
+ Fix so that if restore file isn't found which in non-batch mode,
window will switch back to game.
1997-04-27 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -18563,11 +18568,11 @@
1997-04-26 Edward M Reingold <emr@silver.wisdom.weizmann.ac.il>
- * cal-french.el (calendar-print-french-date): Label
- French date in echo area.
+ * cal-french.el (calendar-print-french-date):
+ Label French date in echo area.
- * cal-coptic.el (calendar-print-coptic-date): Label
- Coptic/Ethiopic date in echo area.
+ * cal-coptic.el (calendar-print-coptic-date):
+ Label Coptic/Ethiopic date in echo area.
1997-04-25 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -18609,7 +18614,7 @@
* cus-edit.el (custom-set-value): New command.
(custom-set-variable): New command.
- (customize-saved): Renamed from `customize-customized'.
+ (customize-saved): Rename from `customize-customized'.
(customize-customized): New command.
(custom-save-customized): New command.
@@ -18672,7 +18677,7 @@
* cus-edit.el (custom-display-unselected-match): Matched too many
displays.
- * wid-edit.el (widget-field-face): Changed default background
+ * wid-edit.el (widget-field-face): Change default background
color.
* custom.el (custom-declare-variable): Set `custom-get' the right
@@ -18796,7 +18801,7 @@
* sh-script.el (sh-case): Make this a simple define-skeleton
as it was originally. Don't add a menu-enable property.
- (sh-assignment-regexp): Renamed from sh-assignment-prefix
+ (sh-assignment-regexp): Rename from sh-assignment-prefix
undoing a renaming made by mistake.
* sgml-mode.el (sgml-transformation): Fix previous change.
@@ -18941,7 +18946,7 @@
* cus-start.el: Add support for face documentation.
- * cus-dep.el (custom-make-dependencies): Fixed generation of
+ * cus-dep.el (custom-make-dependencies): Fix generation of
parens.
Fixed message.
@@ -18970,8 +18975,8 @@
1997-04-14 Steven L Baur <steve@altair.xemacs.org>
- * edebug.el (edebug-read-and-maybe-wrap-form): Protect
- against pathological recursive calls.
+ * edebug.el (edebug-read-and-maybe-wrap-form):
+ Protect against pathological recursive calls.
1997-04-14 Karl Heuer <kwzh@gnu.ai.mit.edu>
@@ -19074,8 +19079,8 @@
variable instead. buffer-substring with 3 arguments is non-portable.
* elp.el (elp-instrument-function, elp-instrument-list):
- Handle function symbols that have already been instrumented. Do
- not instrument them twice.
+ Handle function symbols that have already been instrumented.
+ Do not instrument them twice.
* elp.el (elp-recycle-buffers-p): New variable.
@@ -19123,18 +19128,18 @@
* cus-edit.el (customize-menu-create): New function.
(custom-mode-customize-menu): Use it.
- * cus-edit.el (custom-make-dependencies): Deleted function.
+ * cus-edit.el (custom-make-dependencies): Delete function.
* cus-edit.el (customize-face): Sort faces.
* cus-edit.el (custom-faces): New group.
- (custom-magic-alist): Added.
- (custom-variable-sample-face): Added.
- (custom-variable-button-face): Added.
- (custom-face-tag-face): Added.
- (custom-group-tag-faces): Added.
- (custom-group-tag-face): Added.
- (customize): Removed from faces group.
+ (custom-magic-alist): Add.
+ (custom-variable-sample-face): Add.
+ (custom-variable-button-face): Add.
+ (custom-face-tag-face): Add.
+ (custom-group-tag-faces): Add.
+ (custom-group-tag-face): Add.
+ (customize): Remove from faces group.
* cus-edit.el (custom-load-recursion): New variable.
(custom-load-symbol): Use it.
@@ -19146,14 +19151,14 @@
`custom-buffer-create'.
(custom-buffer-create-other-window): New function.
- * cus-edit.el (custom-guess-name-alist): Renamed from
+ * cus-edit.el (custom-guess-name-alist): Rename from
`custom-guess-type-alist'.
(custom-guess-doc-alist): New option.
(custom-guess-type): Use them.
- * cus-face.el (set-face-stipple): Removed Kyle Jones code.
+ * cus-face.el (set-face-stipple): Remove Kyle Jones code.
- * cus-face.el (face-doc-string): Changed property name to
+ * cus-face.el (face-doc-string): Change property name to
`face-documentation'.
(set-face-doc-string): Ditto.
@@ -19177,17 +19182,17 @@
unbound.
(custom-menu-nesting): Don't define for XEmacs.
- * cus-face.el (after-make-frame-hook): Removed
- `custom-initialize-frame', as this is now in `frame.el'.
+ * cus-face.el (after-make-frame-hook):
+ Remove `custom-initialize-frame', as this is now in `frame.el'.
* cus-edit.el (custom-guess-type-alist): New option.
(custom-guess-type): New function.
(custom-variable-type): New function.
(custom-variable-value-create): Use it.
- * cus-face.el (custom-face-attributes): Moved :family to the
+ * cus-face.el (custom-face-attributes): Move :family to the
beginning of the list.
- (custom-face-attributes): Added :strikethru attribute.
+ (custom-face-attributes): Add :strikethru attribute.
* custom.el (custom-set-variables): If variable is already set,
overwrite it here.
@@ -19198,7 +19203,6 @@
* widget.el (:text-format): New keyword.
* wid-edit.el (push-button): Define it.
(widget-push-button-value-create): Use it.
- * widget.texi (push-button): Documented it.
1997-04-11 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -19305,7 +19309,7 @@
(scheme-comment-indent, scheme-indent-offset)
(scheme-indent-function, scheme-indent-line)
(calculate-scheme-indent, scheme-indent-specform)
- (scheme-indent-defform, scheme-indent-sexp): Removed; use lisp-mode
+ (scheme-indent-defform, scheme-indent-sexp): Remove; use lisp-mode
equivalents.
(scheme-imenu-generic-expression): New variable.
(dsssl-imenu-generic-expression): New variable.
@@ -19467,9 +19471,9 @@
1997-03-30 Dan Nicolaescu <done@ece.arizona.edu>
- * icon.el (icon-mode-map): Added menus.
+ * icon.el (icon-mode-map): Add menus.
(icon-imenu-generic-expression): New variable to be used for imenu.
- (icon-mode): Added font-lock, imenu and hideshow support.
+ (icon-mode): Add font-lock, imenu and hideshow support.
(icon-font-lock-keywords-1, icon-font-lock-keywords-2):
New constants for different level of font-lock fontification.
(icon-font-lock-keywords): New variable. Default expression to be
@@ -19498,7 +19502,7 @@
* sh-script.el (sh-mode): If file has no #! line,
set the syntax table based on the default shell.
-1997-03-29 Barry A. Warsaw <cc-mode-help@python.org>
+1997-03-29 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* Public Release 4.389.
@@ -19551,23 +19555,23 @@
* term.el: Added a lot of new faces, they all start with
term- and follow a simple lexicographical convention. Note that
each change is commented: just search for -mm in the source.
- (term-char-mode): Added all the "gray-keys" to term-raw-map.
+ (term-char-mode): Add all the "gray-keys" to term-raw-map.
(term-send-up): Similar, decided to go for the more xterm-like
\eOA bindings in place of the previous \e[A.
(term-buffer-maximum-size): New variable.
- (term-mode): Added some make-local: now term-buffer-maximum-size,
+ (term-mode): Add some make-local: now term-buffer-maximum-size,
ange-ftp-default-user/password/an-pwd.
(term-emulate-terminal): Quite some modifications to allow
multiple outstanding ANSI style commands: notably all the
-previous-parameter stuff. Call term-handle-ansi-terminal-messages.
- (term-emulate-terminal): Added simple trimming function: at the
+ (term-emulate-terminal): Add simple trimming function: at the
end we simply check if the buffer is > term-buffer-maximum-size
and cut it accordingly.
(term-handle-colors-array): New function.
(term-handle-ansi-terminal-messages): New function.
- (term-handle-ansi-escape): Modified to allow ANSI coloring.
- (ansi-term): New function that creates multiple terminals. Put
- in the standard C-x map too: I'm quite used to C-x C-f and C-c C-f
+ (term-handle-ansi-escape): Modify to allow ANSI coloring.
+ (ansi-term): New function that creates multiple terminals.
+ Put in the standard C-x map too: I'm quite used to C-x C-f and C-c C-f
was too awkward.
1997-03-29 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -19579,7 +19583,7 @@
* hideshow.el: Use overlays for hiding instead of selective display.
Commented out the support for XEmacs because it doesn't support
overlays.
- (hs-special-modes-alist): Added support for java-mode.
+ (hs-special-modes-alist): Add support for java-mode.
(hs-minor-mode-hook): New variable.
(hs-c-start-regexp, hs-c-end-regexp, hs-forward-sexp-func)
(hs-block-start-regexp, hs-block-end-regexp)
@@ -19592,8 +19596,8 @@
(hs-hide-block-at-point, hs-hide-initial-comment-block)
(java-hs-forward-sexp, hs-mouse-toggle-hiding): New functions.
(hs-inside-comment-p, hs-hide-block)
- (hs-show-block): Added support for single line comments.
- (hs-hide-all): Added support for hiding comments.
+ (hs-show-block): Add support for single line comments.
+ (hs-hide-all): Add support for hiding comments.
1997-03-28 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -19707,7 +19711,7 @@
1997-03-20 Dan Nicolaescu <done@ece.arizona.edu>
* imenu.el (imenu-scanning-message): Support for bigger numbers.
- (imenu--generic-function): Fixed probably a typo: named appeared
+ (imenu--generic-function): Fix probably a typo: named appeared
twice in an item. Put function after name and beg in a special
item because a normal item has name and beg (for orthogonality).
(imenu-add-to-menubar): First test to see if the mode supports
@@ -19738,8 +19742,8 @@
1997-03-18 Kenichi Handa <handa@etl.go.jp>
- * fontset.el (x-complement-fontset-spec): Setup
- alternative-fontname-alist while complementing fontnames.
+ * fontset.el (x-complement-fontset-spec):
+ Setup alternative-fontname-alist while complementing fontnames.
1997-03-18 Naoto TAKAHASHI <ntakahas@etl.go.jp>
@@ -19754,11 +19758,11 @@
(quail-keyboard-layout): Docstring changed to reflect the above
change.
(quail-keyboard-layout-len): Increased for the above change.
- (quail-keyboard-layout-alist): Modified for the above change.
+ (quail-keyboard-layout-alist): Modify for the above change.
1997-03-18 Kenichi Handa <handa@etl.go.jp>
- * mule.el (make-char): Documented.
+ * mule.el (make-char): Document.
(charset-plist): Return quoted list even if CHARSET is
supplied by symbol.
@@ -19776,8 +19780,8 @@
* language/viet-util.el (viet-decode-viqr-region): Supply correct
argumnents to rassoc.
- (viqr-post-read-conversion, viqr-pre-write-conversion): New
- functions.
+ (viqr-post-read-conversion, viqr-pre-write-conversion):
+ New functions.
* language/vietnamese.el: Set the above functions to the coding
system viqr.
@@ -19852,7 +19856,7 @@
* mailalias.el (mail-passwd-files): New variable.
(mail-get-names): Use mail-passwd-files instead of always /etc/passwd.
-1997-03-12 Barry A. Warsaw <cc-mode-help@python.org>
+1997-03-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-mode.el (c-lineup-C-comments): Handle more cases, especially
when comment lines aren't prefixed with stars.
@@ -19879,7 +19883,7 @@
map them into inher-intro, inher-cont, and func-decl-cont
syntactic symbols. Do the indentation as of Java inheritance
lines better.
- (c-offsets-alist): Changed the syntactic symbol ansi-funcdecl-cont
+ (c-offsets-alist): Change the syntactic symbol ansi-funcdecl-cont
to func-decl-cont. This symbol is useful in Java throws
declarations.
(c-lineup-java-inher): New function for lining up "implements"
@@ -19953,8 +19957,8 @@
* make-mode.el (makefile-dependency-regex): Disallow "=" in name,
so that "flags=-o:1" is treated as an assignment, not a dependency.
- (makefile-dependency-regex, makefile-macroassign-regex): Disallow
- spaces in symbol name.
+ (makefile-dependency-regex, makefile-macroassign-regex):
+ Disallow spaces in symbol name.
1997-03-11 Dan Nicolaescu <done@ece.arizona.edu>
@@ -19963,8 +19967,8 @@
1997-03-12 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu>
- * dired-aux.el (dired-fun-in-all-buffers): New arg FILE. Don't
- operate on buffers whose wildcard pattern does not accept FILE.
+ * dired-aux.el (dired-fun-in-all-buffers): New arg FILE.
+ Don't operate on buffers whose wildcard pattern does not accept FILE.
All callers changed.
* dired.el (dired-glob-regexp): New function.
@@ -20054,14 +20058,14 @@
(rmail-show-mime-function, rmail-mime-feature): New variables to
control MIME feature.
(rmail-file-coding-system): Default value is nil.
- (rmail, rmail-convert-file, rmail-insert-inbox-text): Check
- rmail-enable-mime. Read a file without any code conversion.
+ (rmail, rmail-convert-file, rmail-insert-inbox-text):
+ Check rmail-enable-mime. Read a file without any code conversion.
(rmail-variables): Setup local variables rmail-buffer and
rmail-view-buffer.
- (rmail-decode-babyl-format, rmail-convert-babyl-format): Perform
- code conversion of RMAIL file if rmail-enable-mime is nil.
- (rmail-show-message): Make sure to be in rmail-buffer. If
- rmail-enable-mime is t, call appropriate function to decode MIME
+ (rmail-decode-babyl-format, rmail-convert-babyl-format):
+ Perform code conversion of RMAIL file if rmail-enable-mime is nil.
+ (rmail-show-message): Make sure to be in rmail-buffer.
+ If rmail-enable-mime is t, call appropriate function to decode MIME
format.
(rmail-mail, rmail-reply): Call rmail-start-mail with argument
rmail-view-buffer.
@@ -20072,8 +20076,8 @@
rmail-summary-line-decoder.
(rmail-summary-next-msg): Display rmail-view-buffer.
(rmail-summary-mode): Make rmail-view-buffer buffer local.
- (rmail-summary-rmail-update, rmail-summary-scroll-msg-up): Use
- rmail-view-buffer instead of rmail-buffer.
+ (rmail-summary-rmail-update, rmail-summary-scroll-msg-up):
+ Use rmail-view-buffer instead of rmail-buffer.
* mule-cmds.el (mule-keymap): Re-arranged.
(set-language-info): Typo fixed in docstring.
@@ -20184,8 +20188,8 @@
(turn-on-font-lock): Test font-lock-mode.
Added commented out menu code.
- * compile.el (compilation-mode-font-lock-keywords): Variable
- definition deleted. New function.
+ * compile.el (compilation-mode-font-lock-keywords):
+ Variable definition deleted. New function.
(compilation-mode-map): Add `...' to Compile menu entry.
1997-02-20 Yutaka NIIBE <gniibe@mri.co.jp>
@@ -20235,8 +20239,8 @@
* help.el (help-with-tutorial): Prefix argument to specify a
language interactively.
- * isearch.el (isearch-mode-map): Define
- isearch-toggle-input-method and
+ * isearch.el (isearch-mode-map):
+ Define isearch-toggle-input-method and
isearch-toggle-specified-input-method in the map.
(isearch-multibyte-characters-flag): New variable.
(isearch-mode): Initialize it to nil.
@@ -20268,8 +20272,8 @@
(sendmail-send-it): Perform code conversion on sending mail
according to sendmail-coding-system.
- * simple.el (kill-forward-chars, kill-backward-chars): Pay
- attention to multibyte characters.
+ * simple.el (kill-forward-chars, kill-backward-chars):
+ Pay attention to multibyte characters.
(what-cursor-position): With a prefix argument, print detailed
info of a character on cursor position.
(transpose-subr-1): Pay attention to multibyte characters.
@@ -20365,8 +20369,8 @@
* diff.el (diff-process-setup): New function, sets up the
compilation-exit-message-function so that it works with both
asynchronous and synchronous sub-processes.
- (diff): Bind compilation-exit-message-function. Run
- compilation-finish-function when compile-internal returns if async
+ (diff): Bind compilation-exit-message-function.
+ Run compilation-finish-function when compile-internal returns if async
processes aren't supported.
1997-02-08 Richard Stallman <rms@psilocin.gnu.ai.mit.edu>
@@ -20428,7 +20432,7 @@
* iso-acc.el (iso-accents-compose):
Handle case where unread-command-events is already nonempty.
- * frame.el (set-frame-font): Renamed from set-default-font.
+ * frame.el (set-frame-font): Rename from set-default-font.
1997-02-01 Tom Tromey <tromey@cygnus.com>
@@ -20480,7 +20484,7 @@
* compile.el (compilation-enter-directory-regexp)
(compilation-leave-directory-regexp): Add .* at beginning.
-1997-01-30 Barry A. Warsaw <cc-mode-help@python.org>
+1997-01-30 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-mode.el: Public Release 4.353.
@@ -20500,7 +20504,7 @@
* cc-mode.el (c-Java-access-key): Set to nil since Java doesn't
have C++-like access labels.
- * cc-mode.el (c-style-alist): Added "python" style.
+ * cc-mode.el (c-style-alist): Add "python" style.
* cc-mode.el (c-mode-menu): New function.
(c-popup-menu, c-common-init): Use c-mode-menu.
@@ -20521,9 +20525,9 @@
* cc-mode.el (c-emacs-features): Detect Infodock.
(c-common-init, c-mode-map): Don't install menus for Infodock.
- * cc-mode.el (c-indent-exp): Fixed infinite loop when multi-line C
+ * cc-mode.el (c-indent-exp): Fix infinite loop when multi-line C
comment is last thing in buffer.
- (c-guess-basic-offset): Fixed error when K&R C-like macro is first
+ (c-guess-basic-offset): Fix error when K&R C-like macro is first
non-syntactic whitespace in file.
* cc-mode.el (c-C++-comment-start-regexp):
@@ -20701,7 +20705,7 @@
1997-01-09 Simon Marshall <simon@wombat.gnu.ai.mit.edu>
- * font-lock.el (font-lock-unique): Deleted.
+ * font-lock.el (font-lock-unique): Delete.
(font-lock-prepend-text-property, font-lock-append-text-property):
Don't call it; behave as to-be-written builtins. Declare as defuns.
(font-lock-fillin-text-property): Declare as a defun.
@@ -20727,7 +20731,7 @@
(expand-mode-hook, expand-mode-name): Variables deleted.
(expand-load-hook): Variable renamed from expand-mode-load-hook.
(expand-map): Variable deleted.
- (expand-jump-to-next-slot): Renamed from expand-jump-to-next-mark.
+ (expand-jump-to-next-slot): Rename from expand-jump-to-next-mark.
Add autoload.
(expand-jump-to-previous-slot): Add autoload.
Renamed from expand-jump-to-previous-mark.
@@ -20799,11 +20803,11 @@
1997-01-02 Jens Toivo Berger Thielemann <jensthi@ifi.uio.no>
* word-help.el (word-help-mode-alist, reset-word-help)
- (word-help-switch-help-file): Added support for completion.
+ (word-help-switch-help-file): Add support for completion.
(word-help-complete, word-help-complete-list)
(word-help-complete-index, word-help-extract-matches)
(word-help-make-complete): New functions/variables for completion.
- (word-help-mode-alist): Enhanced search regexps.
+ (word-help-mode-alist): Enhance search regexps.
(word-help-index-mapper): Defaults now to extracting the first word.
(word-help-mode-alist, word-help-index-mapper)
(word-help-main-index, word-help-main-obarray)
@@ -20846,8 +20850,8 @@
1996-12-31 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
- * simple.el (repeat-complex-command): Bind
- minibuffer-history-position and minibuffer-history-sexp-flag
+ * simple.el (repeat-complex-command):
+ Bind minibuffer-history-position and minibuffer-history-sexp-flag
only for the read-from-minibuffer call.
1996-12-30 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -20925,7 +20929,7 @@
* expand.el: New file.
- * skeleton.el (skeleton-positions): Renamed from skeleton-marks.
+ * skeleton.el (skeleton-positions): Rename from skeleton-marks.
* skeleton.el (skeleton-marks): New variable.
(skeleton-insert, skeleton-internal-1): Set skeleton-marks.
@@ -20952,7 +20956,7 @@
(vip-convert-standard-file-name): New function.
* ediff-util.el (ediff-file-under-version-control): New function.
- (ediff-inferior-compare-regions): Improved interface.
+ (ediff-inferior-compare-regions): Improve interface.
(ediff-maybe-checkout): New function.
(ediff-maybe-save-and-delete-merge): New function.
(ediff-setup): Now uses convert-standard-filename.
@@ -20966,8 +20970,8 @@
subordinate Ediff sessions.
* ediff-ptch.el (ediff-patch-file-internal):
Now calls ediff-maybe-checkout.
- (ediff-context-diff-label-regexp): Fixed regexp.
- (ediff-map-patch-buffer): Fixed beg/end patch boundaries.
+ (ediff-context-diff-label-regexp): Fix regexp.
+ (ediff-map-patch-buffer): Fix beg/end patch boundaries.
* ediff.el: Now supports autostore for merge jobs.
1996-12-27 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -21014,15 +21018,15 @@
* vc-hooks.el (vc-user-login-name): New function.
(vc-fetch-master-properties, vc-lock-from-permissions, vc-file-owner)
- (vc-fetch-properties, vc-after-save, vc-mode-line, vc-status): Use
- `vc-user-login-name' instead of `user-login-name'.
+ (vc-fetch-properties, vc-after-save, vc-mode-line, vc-status):
+ Use `vc-user-login-name' instead of `user-login-name'.
* vc.el (vc-next-action-on-file, vc-update-change-log)
(vc-backend-checkout, vc-backend-steal): Use `vc-user-login-name'
instead of `user-login-name'.
(vc-update-change-log): If `user-full-name' is nil, try
`user-login-name'. Failing that, use uid as a string.
- (vc-make-buffer-writable-hook): Removed (was unused).
+ (vc-make-buffer-writable-hook): Remove (was unused).
1996-12-20 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -21290,7 +21294,7 @@
* thingatpt.el: Downcase arguments as Lisp symbols.
Fix many doc strings.
- (thing-at-point-file-name-chars): Renamed from file-name-chars.
+ (thing-at-point-file-name-chars): Rename from file-name-chars.
Allow a colon.
(thing-at-point-url-chars): New variable.
(url): Define new kind of "thing".
@@ -21305,7 +21309,7 @@
Two new arguments.
(rmail-forward): Always call rmail-start-mail, never `mail'.
- * sendmail.el (mail-reply-action): Renamed from mail-reply-buffer.
+ * sendmail.el (mail-reply-action): Rename from mail-reply-buffer.
(mail-yank-original): Handle either an action or a buffer
in mail-reply-action.
(mail): Doc fix.
@@ -21409,8 +21413,8 @@
(font-lock-face-attributes): Doc fix.
(font-lock-match-c-style-declaration-item-and-skip-to-next): New
function. Match just identifiers. Use it for C, Objective-C and Java.
- (font-lock-match-c++-style-declaration-item-and-skip-to-next): Match
- templates too.
+ (font-lock-match-c++-style-declaration-item-and-skip-to-next):
+ Match templates too.
(c-font-lock-extra-types, c++-font-lock-extra-types)
(objc-font-lock-extra-types, java-font-lock-extra-types): Use these
variables in EVAL forms, i.e., do not eval when font-lock.el is loaded.
@@ -21428,7 +21432,7 @@
(fast-lock-get-face-properties): Rewrite for face lists. Use it.
* lazy-lock.el (lazy-lock-submit-bug-report): Function deleted.
- (lazy-lock-defer-on-scrolling): Renamed from lazy-lock-defer-driven.
+ (lazy-lock-defer-on-scrolling): Rename from lazy-lock-defer-driven.
(lazy-lock-defer-on-the-fly): New variable from lazy-lock-defer-time.
(lazy-lock-install): Use it.
(lazy-lock-defer-time): Doc fix. Add top-level code to detect use of
@@ -21437,15 +21441,15 @@
(lazy-lock-stealth-load): New variable.
(lazy-lock-fontify-after-idle): Use it.
(lazy-lock-mode): Doc fix.
- (lazy-lock-defer-line-after-change): Renamed from
+ (lazy-lock-defer-line-after-change): Rename from
lazy-lock-defer-after-change.
(lazy-lock-defer-rest-after-change)
(lazy-lock-fontify-line-after-change)
(lazy-lock-fontify-rest-after-change): New functions.
(lazy-lock-install-hooks): Add one depending on deferral variables.
(lazy-lock-unstall): Remove them. Fontify if Font Lock mode still on.
- (lazy-lock-fontify-window, lazy-lock-fontify-conservatively): Use
- with-current-buffer rather than save-excursion.
+ (lazy-lock-fontify-window, lazy-lock-fontify-conservatively):
+ Use with-current-buffer rather than save-excursion.
(lazy-lock-percent-fontified): Cast size to float before multiplying.
1996-11-14 Karl Heuer <kwzh@gnu.ai.mit.edu>
@@ -21549,7 +21553,7 @@
* comint.el (comint-output-filter): Run comint-output-filter-functions
directly, not via comint-output-filter.
- * compile.el (compile-auto-highlight): Renamed from
+ * compile.el (compile-auto-highlight): Rename from
compile-highlight-display-limit.
* time-stamp.el (time-stamp-dd/mm/yyyy): New function.
@@ -21585,7 +21589,7 @@
1996-11-02 Henry Guillaume <henry@qbd.com.au>
* find-file.el (general): Enabled commentary for Finder.
- (ff-search-directories): Changed /usr/include/* to /usr/include.
+ (ff-search-directories): Change /usr/include/* to /usr/include.
(ff-get-file-name): Improve behavior when file is found in a buffer.
1996-11-02 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -21675,7 +21679,7 @@
1996-10-24 Dave Gillespie <daveg@synaptics.com>
- * cl-macs.el (lexical-let): Fixed a bug involving nested
+ * cl-macs.el (lexical-let): Fix a bug involving nested
lexical contexts and macros.
1996-10-23 Simon Marshall <simon@wombat.gnu.ai.mit.edu>
@@ -21736,7 +21740,7 @@
1996-10-20 Kevin Rodgers <kevinr@ihs.com>
- * compile.el (compilation-skip-to-next-location): Defined.
+ * compile.el (compilation-skip-to-next-location): Define.
(compilation-next-error-locus, compilation-parse-errors): Respect it.
1996-10-17 Andre Spiegel <spiegel@berlin.informatik.uni-stuttgart.de>
@@ -21763,19 +21767,19 @@
1996-10-14 Torbjorn Einarsson <T.Einarsson@clab.ericsson.se>
- * f90.el (f90-no-block-limit): Fixed bug for indentation of
+ * f90.el (f90-no-block-limit): Fix bug for indentation of
elsewhere and elseif.
(f90-looking-at-where-or-forall): Now allows for labeled forall
and where statements.
(f90-font-lock-keywords-2): New highlighting for labeled where
and forall. Fixed small bug with else highlighting.
- (f90-fill-region): Moved indentation to f90-break-line.
+ (f90-fill-region): Move indentation to f90-break-line.
(f90-break-line): Will now always indent the second line.
(f90-indent-line): Simpler test for auto-fill.
- (f90-auto-fill-mode): Removed.
- (f90-electric-insert): Added for possibility of auto-filling of
+ (f90-auto-fill-mode): Remove.
+ (f90-electric-insert): Add for possibility of auto-filling of
lines without spaces, as well as early updating of line.
- (f90-mode-map): Added bindings of operators to f90-electric-insert.
+ (f90-mode-map): Add bindings of operators to f90-electric-insert.
(f90-do-auto-fill): Now also updates line (changes case).
1996-10-12 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -21861,21 +21865,21 @@
* browse-url.el (browse-url): New function.
(browse-url-CCI-host): New variable.
- (browse-url-at-mouse): Added event-buffer and event-point
+ (browse-url-at-mouse): Add event-buffer and event-point
functions for XEmacs compatibility.
(browse-url-file-url): Check for EFS after alist, URL-encode
special chars.
(browse-url-grail): New function.
(browse-url-interactive-arg): Add new-window logic.
- (browse-url-looking-at): Fixed.
+ (browse-url-looking-at): Fix.
(browse-url-lynx-xterm): New function.
(browse-url-lynx-emacs): Use term.el instead of terminal.el.
(browse-url-netscape): Contact/start Netscape in the
- background. Multi-display support. Renamed
- browse-url-netscape-send. URL-encode comma.
+ background. Multi-display support.
+ Renamed browse-url-netscape-send. URL-encode comma.
(browse-url-netscape-command): New variable.
(browse-url-netscape-startup-arguments): New variable.
- (browse-url-url-at-point): Improved matching to supply missing
+ (browse-url-url-at-point): Improve matching to supply missing
"http://".
Other fixes for byte-compilation.
@@ -21899,7 +21903,7 @@
* rmail.el (rmail-mode-2): Don't run rmail-mode-hook here.
(rmail-mode, rmail): Run it here.
-1996-10-08 Barry A. Warsaw <cc-mode-help@python.org>
+1996-10-08 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-mode.el (c-mode-map):
Install FSF mode menu into menubar using the name
@@ -21908,7 +21912,7 @@
additional FSF menu.
* cc-mode.el:
- Removed the following variables from the built-in "cc-mode" style:
+ Remove the following variables from the built-in "cc-mode" style:
c-echo-syntactic-information-p
c-string-syntax-p
c-tab-always-indent
@@ -21917,7 +21921,7 @@
* cc-mode.el (c-indent-command): Doc fix.
- * cc-mode.el (c-style-alist): Added "linux" style.
+ * cc-mode.el (c-style-alist): Add "linux" style.
* cc-mode.el (c-lineup-comment): Preserve comment-column.
@@ -21971,10 +21975,10 @@
functions inside a nested class since they will twice add the
indentation of the inner class to the running total.
- The solution is to not give one of the two symbols a relpos. The
- decision was made to omit the relpos of the 'inline-open symbol.
+ The solution is to not give one of the two symbols a relpos.
+ The decision was made to omit the relpos of the 'inline-open symbol.
- (c-mode-help-address): Added cc-mode-help@python.org.
+ (c-mode-help-address): Add cc-mode-help@python.org.
(c-recognize-knr-p): No longer a user variable.
(c++-mode, java-mode): Set c-recognize-knr-p to nil.
@@ -22054,7 +22058,7 @@
(sgml-font-lock-keywords): Add an element for comments.
* rmailsum.el (rmail-summary-line-count-flag):
- Renamed from rmail-summary-line-count-p.
+ Rename from rmail-summary-line-count-p.
* rmailsum.el (rmail-summary-line-count-p): New variable.
(rmail-make-basic-summary-line): Optionally exclude the line count.
@@ -22124,8 +22128,8 @@
(ps-print-prologue-1, ps-print-prologue-2): New variables.
Major rewrite of the PostScript code to handle landscape mode,
multiple columns and new font management.
- (ps-landscape-mode, ps-number-of-columns, ps-inter-column): New
- variables.
+ (ps-landscape-mode, ps-number-of-columns, ps-inter-column):
+ New variables.
Add landscape mode and multiple columns with interspacing.
(ps-font-info-database, ps-font-family, ps-font-size)
(ps-header-font-family, ps-header-font-size, ps-header-title-font)
@@ -22138,10 +22142,10 @@
(/ReportAllFontInfo): New PostScript function to get all the font
families of the printer.
(ps-setup): New function.
- (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region): New
- utility functions.
- (ps-page-dimensions-get-width, ps-page-dimensions-get-height): New
- macros.
+ (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region):
+ New utility functions.
+ (ps-page-dimensions-get-width, ps-page-dimensions-get-height):
+ New macros.
(/HeaderOffset): Fix bug with /PrintStartY.
(/SetHeaderLines): Fix bug.
@@ -22232,7 +22236,7 @@
* tex-mode.el (tex-main-file): Add missing initial value.
(tex-file): Set tex-print-file to source-file always.
- (tex-last-file-texed): Renamed from tex-last-buffer-texed
+ (tex-last-file-texed): Rename from tex-last-buffer-texed
and now holds a file name.
(tex-region): Test and set tex-last-file-texed.
@@ -22282,15 +22286,15 @@
* ffap.el (path-separator): Duplicate definition deleted.
(ffap-what-domain): Don't define mail-extr-all-top-level-domains here.
- * refbib.el (r2b-capitalize-title-stop-words): Renamed from capit...
- (r2b-capitalize-title-stop-regexp): Renamed from capit...
- (r2b-capitalize-title-region): Renamed from capitalize...
- (r2b-capitalize-title): Renamed from capitalize...
+ * refbib.el (r2b-capitalize-title-stop-words): Rename from capit...
+ (r2b-capitalize-title-stop-regexp): Rename from capit...
+ (r2b-capitalize-title-region): Rename from capitalize...
+ (r2b-capitalize-title): Rename from capitalize...
- * bib-mode.el (bib-capitalize-title-stop-words): Renamed from capit...
- (bib-capitalize-title-stop-regexp): Renamed from capit...
- (bib-capitalize-title-region): Renamed from capitalize...
- (bib-capitalize-title): Renamed from capitalize...
+ * bib-mode.el (bib-capitalize-title-stop-words): Rename from capit...
+ (bib-capitalize-title-stop-regexp): Rename from capit...
+ (bib-capitalize-title-region): Rename from capitalize...
+ (bib-capitalize-title): Rename from capitalize...
* edmacro.el (insert-kbd-macro): Duplicate definition deleted.
@@ -22349,18 +22353,18 @@
New variables.
(ediff-convert-standard-file-name): New function.
Added on-line help, moved some functions to and from ediff-util.el.
- (ediff-file-remote-p): Modified.
+ (ediff-file-remote-p): Modify.
(ediff-set-face-pixmap): New function.
(ediff-odd-diff-pixmap, ediff-even-diff-pixmap, ediff-fine-diff-pixmap):
New variables.
- * ediff-ptch.el (ediff-context-diff-label-regexp): Fixed regexp.
- (ediff-map-patch-buffer): Fixed beg/end patch boundaries.
+ * ediff-ptch.el (ediff-context-diff-label-regexp): Fix regexp.
+ (ediff-map-patch-buffer): Fix beg/end patch boundaries.
Now checks for the return code from the patch program.
Fixed ediff-patch-options, ediff-backup-extension, ediff-backup-specs.
* ediff-merg.el, ediff-diff.el, ediff-init.el:
* ediff-hook.el: Changed ediff-meta to ediff-mult.
* ediff-ptch.el (ediff-backup-specs): New variable.
- * ediff.el (ediff-documentation): Modified.
+ * ediff.el (ediff-documentation): Modify.
* ediff-help.el: New file.
* ediff-mult.el (ediff-intersect-directories)
(ediff-meta-insert-file-info): Functions modified.
@@ -22407,7 +22411,7 @@
* vc.el (vc-print-log): Set the display window so that it shows
the current log entry completely.
- * vc-hooks.el (vc-find-cvs-master): Fixed handling of "locally
+ * vc-hooks.el (vc-find-cvs-master): Fix handling of "locally
added" files.
1996-09-16 Erik Naggum <erik@naggum.no>
@@ -22484,15 +22488,15 @@
* bindings.el: New file, split out from loaddefs.el.
* loadup.el: Load bindings.el.
- * gud.el (gud-find-c-expr): Renamed from find-c-expr.
+ * gud.el (gud-find-c-expr): Rename from find-c-expr.
Don't get fooled by if and while statements.
- (gud-expr-compound): Renamed from expr-compound.
- (gud-expr-compound-sep): Renamed from expr-compound-sep.
- (gud-next-expr): Renamed from expr-next.
- (gud-prev-expr): Renamed from expr-prev.
- (gud-forward-sexp): Renamed from expr-forward-sexp.
- (gud-backward-sexp): Renamed from expr-backward-sexp.
- (gud-innermost-expr): Renamed from expr-cur.
+ (gud-expr-compound): Rename from expr-compound.
+ (gud-expr-compound-sep): Rename from expr-compound-sep.
+ (gud-next-expr): Rename from expr-next.
+ (gud-prev-expr): Rename from expr-prev.
+ (gud-forward-sexp): Rename from expr-forward-sexp.
+ (gud-backward-sexp): Rename from expr-backward-sexp.
+ (gud-innermost-expr): Rename from expr-cur.
1996-09-10 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -22542,8 +22546,8 @@
1996-09-05 Michael Kifer <kifer@cs.sunysb.edu>
* viper-keym.el, viper.el (vip-scroll):
- Changed to vip-scroll-screen, other modifications.
- (vip-alternate-ESC): Changed to vip-alternate-Meta-key.
+ Change to vip-scroll-screen, other modifications.
+ (vip-alternate-ESC): Change to vip-alternate-Meta-key.
* viper.el (vip-escape-to-vi, vip-prefix-arg-value)
(vip-prefix-arg-value): Now work with prefix arguments and also
will work with 2dw and d2d style commands.
@@ -22552,7 +22556,7 @@
(vip-paren-match): Go to closing paren first.
(vip-find-char-forward, vip-find-char-backward, vip-goto-char-forward)
(vip-goto-char-backward): Functions modified.
- (vip-set-hooks): Added viper to fortran-mode.
+ (vip-set-hooks): Add viper to fortran-mode.
(viper-mode): Don't delete the startup message.
* viper-keym.el: C-\ is now the meta key.
C-z in insert mode now escapes to Vi.
@@ -22561,9 +22565,9 @@
* viper-util.el, viper.el: Added pixmaps to replace-region and
search faces.
(vip-get-filenames-from-buffer): The argument is now optional.
- (vip-ex-nontrivial-find-file-unix): Added the -d option to ls command.
+ (vip-ex-nontrivial-find-file-unix): Add the -d option to ls command.
(vip-read-key): Inhibit quit added.
- (vip-get-cursor-color): Fixed to work with XEmacs.
+ (vip-get-cursor-color): Fix to work with XEmacs.
* viper-ex.el (ex-edit): Don't change to vi in dired mode.
1996-09-04 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
@@ -22702,7 +22706,7 @@
(grep-regexp-alist, file-name-buffer-file-type-alist)
(find-buffer-file-type, find-file-not-found-set-buffer-file-type)
(find-file-binary, find-file-text, mode-line-format):
- Moved to dos-nt.el.
+ Move to dos-nt.el.
* winnt.el (save-to-unix-hook, revert-from-unix-hook)
(using-unix-filesystems): Functions removed.
@@ -23106,7 +23110,7 @@ See ChangeLog.6 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 1997-1998, 2001-2013 Free Software Foundation,
+ Copyright (C) 1997-1998, 2001-2015 Free Software Foundation,
Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 9dc3c20d1c3..df0188d8c76 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -3,13 +3,13 @@
* echistory.el (electric-command-history): Call Command-history-setup
and command-history-mode using their new conventions.
- * chistory.el (Command-history-setup): Don't switch buffers. Take
- no args, and do not set major-mode, mode-name or the local map.
+ * chistory.el (Command-history-setup): Don't switch buffers.
+ Take no args, and do not set major-mode, mode-name or the local map.
(command-history-mode): New function, does some of those things
Command-history-setup used to do.
(list-command-history): Call command-history-mode, not
Command-history-setup.
- (command-history): Renamed from command-history-mode.
+ (command-history): Rename from command-history-mode.
1999-12-31 Richard M. Stallman <rms@gnu.org>
@@ -51,8 +51,8 @@
* progmodes/hideshow.el (hs-minor-mode-menu): Fix omission bug;
was used but not declared.
- (hs-discard-overlays, hs-isearch-show, hs-isearch-show-temporary,
- hs-find-block-beginning): Add or modify docstrings.
+ (hs-discard-overlays, hs-isearch-show, hs-isearch-show-temporary)
+ (hs-find-block-beginning): Add or modify docstrings.
(hs-isearch-show): Rewrite.
@@ -91,9 +91,9 @@
1999-12-27 Jari Aalto <jari.aalto@poboxes.com>
- * add-log.el (change-log-version-number-regexp-list): Added tag
+ * add-log.el (change-log-version-number-regexp-list): Add tag
:version 20.6.
- (change-log-version-info-enabled): Added tag :version 20.6.
+ (change-log-version-info-enabled): Add tag :version 20.6.
1999-12-27 Jari Aalto <jari.aalto@poboxes.com>
@@ -103,13 +103,13 @@
(change-log-find-version): Rewritten. Use user-configurable
version numbering regexp list
change-log-version-number-regexp-list.
- (change-log-find-version): Renamed to
+ (change-log-find-version): Rename to
change-log-version-number-search.
(add-log-file-name-function): New.
- (change-log-search-vc-number): Added END parameter. Added doc
+ (change-log-search-vc-number): Add END parameter. Added doc
string to function.
- (change-log-version-rcs): Renamed. Was
- change-log-search-vc-number.
+ (change-log-version-rcs): Rename.
+ Was change-log-search-vc-number.
1999-12-26 Thien-Thi Nguyen <ttn@delysid.gnu.org>
@@ -144,7 +144,7 @@
(hs-hide-block, hs-show-block, hs-show-region, hs-hide-level)
(hs-mouse-toggle-hiding, hs-minor-mode): Rewrite.
- (hs-isearch-show): Renamed from `hs-isearch-open-invisible'.
+ (hs-isearch-show): Rename from `hs-isearch-open-invisible'.
(hs-isearch-show-temporary): New funcs.
(hs-show-block-at-point, java-hs-forward-sexp): Delete funcs.
@@ -173,19 +173,19 @@
1999-12-21 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Version 1.2 is released.
+ * progmodes/antlr-mode.el: Version 1.2 is released.
(antlr): This package has a web page.
1999-12-21 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Menu/keymap additions for commenting/uncommenting
+ * progmodes/antlr-mode.el: Menu/keymap additions for commenting/uncommenting
regions. Suggested by Dale Davis <Dale_Davis@securify.com>.
(antlr-mode-map): New binding [C-c C-c].
(antlr-mode-menu): New entries.
1999-12-21 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Respect Emacs conventions.
+ * progmodes/antlr-mode.el: Respect Emacs conventions.
((require 'cl)): Only use during compilation.
(antlr-language-for-option): New function to avoid using `find'.
(antlr-mode): Use it.
@@ -199,10 +199,10 @@
1999-11-21 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Really use `antlr-tab-offset-alist'.
+ * progmodes/antlr-mode.el: Really use `antlr-tab-offset-alist'.
(antlr-set-tabs): Don't use hard-coded values.
- * antlr-mode.el: Minor navigation changes. Not perfect, but this
+ * progmodes/antlr-mode.el: Minor navigation changes. Not perfect, but this
won't be possible without a huge time penalty.
(antlr-skip-exception-part): Be more specific.
(antlr-skip-file-prelude): Don't skip action prelude of next rule.
@@ -212,11 +212,11 @@
(antlr-beginning-of-body): Better error message.
(antlr-imenu-create-index-function): Skip rule action prelude.
- * antlr-mode.el: Minor syntax highlighting changes.
+ * progmodes/antlr-mode.el: Minor syntax highlighting changes.
(antlr-font-lock-default-face): Deletia.
- (antlr-font-lock-tokendef-face): Changed color.
- (antlr-font-lock-tokenref-face): Changed color.
- (antlr-font-lock-literal-face): Changed color.
+ (antlr-font-lock-tokendef-face): Change color.
+ (antlr-font-lock-tokenref-face): Change color.
+ (antlr-font-lock-literal-face): Change color.
(antlr-font-lock-additional-keywords): Minor changes.
1999-12-20 Carsten Dominik <cd@gnu.org>
@@ -295,7 +295,7 @@
(font-lock-removed-keywords-alist): New variable.
(font-lock-add-keywords): Updates `font-lock-removed-keywords-alist'.
Empty `font-lock-keywords-alist' when `append' is `set' to avoid
- growing datastructures.
+ growing data structures.
(font-lock-set-defaults): Removes keywords stored in
`font-lock-removed-keywords-alist' after local keywords added.
@@ -307,8 +307,8 @@
* font-lock.el (c-keywords): Only highlight preprocessor
directives when spelled correctly.
- * font-lock.el (font-lock-match-c++-structor-declaration,
- c++-keywords): Fontify constructors and destructors with function
+ * font-lock.el (font-lock-match-c++-structor-declaration)
+ (c++-keywords): Fontify constructors and destructors with function
face inside C++ class declarations.
1999-12-16 Gerd Moellmann <gerd@gnu.org>
@@ -351,7 +351,7 @@
(reftex-index-phrases-sort-prefers-entry)
(reftex-index-phrases-sort-in-blocks): New options.
(reftex-index-macros): Option structure changed.
- (reftex-index-macros-builtin): Added `repeat' item to each entry.
+ (reftex-index-macros-builtin): Add `repeat' item to each entry.
(reftex-label-alist): Additional item in each entry to specify if
the environment should be listed in the TOC.
(eval-when-compile (require 'cl)) added.
@@ -403,7 +403,7 @@
`t' command key can change `reftex-toc-max-level';
(eval-when-compile (require 'cl)) added.
- * textmode/reftex-sel.el (reftex-insert-docstruct): Respect
+ * textmodes/reftex-sel.el (reftex-insert-docstruct): Respect
`reftex-toc-max-level'. (eval-when-compile (require 'cl)) added.
* textmodes/reftex-auc.el: (eval-when-compile (require 'cl)) added.
@@ -415,12 +415,12 @@
Additional argument FORMAT-KEY to preselect a citation format;
(eval-when-compile (require 'cl)) added.
- * textmodes/reftex-parse.el (reftex-context-substring): Optional
- parameter to-end.
+ * textmodes/reftex-parse.el (reftex-context-substring):
+ Optional parameter to-end.
(reftex-section-info): Deal with environment matches;
(eval-when-compile (require 'cl)) added.
- * reftex-global.el: (eval-when-compile (require 'cl)) added.
+ * textmodes/reftex-global.el: (eval-when-compile (require 'cl)) added.
1999-12-15 Kenichi Handa <handa@etl.go.jp>
@@ -440,12 +440,12 @@
(ps-mule-plot-composition): New function.
(ps-mule-prepare-font-for-components): New function.
(ps-mule-plot-components): New function.
- (ps-mule-composition-prologue-generated): Renamed from
+ (ps-mule-composition-prologue-generated): Rename from
ps-mule-cmpchar-prologue-generated.
(ps-mule-composition-prologue): New named from
ps-mule-cmpchar-prologue. Modified for new composition.
- (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar,
- ps-mule-prepare-cmpchar-font): Deleted.
+ (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar)
+ (ps-mule-prepare-cmpchar-font): Delete.
(ps-mule-string-encoding): New arg NO-SETFONT.
(ps-mule-bitmap-prologue): In PostScript code of BuildGlyphCommon,
check Composing, not Cmpchar.
@@ -463,8 +463,8 @@
* international/fontset.el (vertical-centering-font-regexp):
New variable.
- * international/mule.el (mule-version): Updated to 5.0 (AOI).
- (mule-version-date): Updated to 1999.12.7.
+ * international/mule.el (mule-version): Update to 5.0 (AOI).
+ (mule-version-date): Update to 1999.12.7.
(with-category-table): New macro.
* international/mule-cmds.el (encode-coding-char): Don't check
@@ -477,9 +477,9 @@
* international/mule-util.el (set-nested-alist): Set BRANCHES (if
non-nil) at the tail of ALIST.
(compose-region, decompose-region, decompose-string)
- (reference-point-alist, compose-chars): Moved to composite.el.
+ (reference-point-alist, compose-chars): Move to composite.el.
(compose-chars-component, compose-chars-rule, decompose-composite-char):
- Deleted.
+ Delete.
* international/quail.el (quail-install-map): New optional arg NAME.
(quail-get-translation): If DEF is a symbol but not a function,
@@ -513,16 +513,16 @@
* language/thai-util.el (thai-category-table): Make it by
make-category-table.
(thai-composition-pattern): New variable.
- (thai-compose-region, thai-compose-string): Use
- with-category-table.
+ (thai-compose-region, thai-compose-string):
+ Use with-category-table.
(thai-post-read-conversion): Just call thai-compose-region.
- (thai-pre-write-conversion): Deleted.
+ (thai-pre-write-conversion): Delete.
(thai-composition-function): New function.
* language/tibet-util.el: Most functions rewritten.
- (tibetan-char-p): Renamed from tibetan-char-examin.
+ (tibetan-char-p): Rename from tibetan-char-examin.
(tibetan-composable-examin, tibetan-complete-char-examin)
- (tibetan-vertical-stacking, tibetan-composition): Deleted.
+ (tibetan-vertical-stacking, tibetan-composition): Delete.
(tibetan-add-components): New function.
(tibetan-composition-function): New function.
@@ -543,8 +543,8 @@
1999-12-14 Gerd Moellmann <gerd@gnu.org>
- * international/mule-cmds.el (default-input-method): Specify
- that it should be set after current-language-environment.
+ * international/mule-cmds.el (default-input-method):
+ Specify that it should be set after current-language-environment.
* custom.el (custom-handle-keyword): Add :set-after.
(custom-add-dependencies): New function.
@@ -556,11 +556,11 @@
* progmodes/cc-make.el: Removed.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* Release of cc-mode 5.26
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-cmds.el (c-forward-conditional): Handle an arbitrary
target depth. Optionally count #else lines as clause limits,
@@ -571,35 +571,35 @@
(c-down-conditional-with-else): New commands that uses the
added functionality in `c-forward-conditional'.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el (c-lineup-comment): Preserve the alignment with
a comment on the previous line instead of preserving the
comment-column.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
Fixes to IDL mode after input from Eric Eide <eeide@cs.utah.edu>:
- * cc-engine.el (c-beginning-of-statement-1): Allow
- `c-conditional-key' to be nil, for the benefit of IDL mode.
+ * cc-engine.el (c-beginning-of-statement-1):
+ Allow `c-conditional-key' to be nil, for the benefit of IDL mode.
* cc-engine.el (c-guess-basic-syntax): Ditto.
- cc-langs.el (C-IDL-class-key): Fixed. Don't match `class'
+ cc-langs.el (C-IDL-class-key): Fix. Don't match `class'
but do match CORBA 2.3 `valuetype'.
* cc-langs.el (c-IDL-access-key): New defconst. Should be nil
for IDL.
- * cc-langs.el (c-IDL-conditional-key): New defconst. Should
- be nil for IDL.
+ * cc-langs.el (c-IDL-conditional-key): New defconst.
+ Should be nil for IDL.
* cc-langs.el (c-IDL-comment-start-regexp): New defconst.
Like C++.
* cc-mode.el (idl-mode): Use new `c-IDL-*' defconsts. Also,
set `c-method-key' and `c-baseclass-key' to nil.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-menus.el (cc-imenu-c++-generic-expression): Match classes
with nonhanging open braces.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el: Added docstrings to all lineup functions.
@@ -610,12 +610,12 @@
comments. Use c-comment-prefix-regexp and comment-start-skip
instead of hardcoded regexps.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-beginning-of-defun, c-end-of-defun): Fixed eob
+ * cc-cmds.el (c-beginning-of-defun, c-end-of-defun): Fix eob
behavior and return value as documented.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
Changes for new style variable init system:
* cc-langs.el (c-common-init): Dito.
@@ -639,22 +639,22 @@
the throws clause that might follow the function prototype in
C++.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-beginning-of-macro): Fixed bug where point
+ * cc-defs.el (c-beginning-of-macro): Fix bug where point
could move forward for macros that doesn't start in column 0.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-align.el (c-indent-multi-line-block,
- c-lineup-whitesmith-in-block): Two new lineup functions for
+ * cc-align.el (c-indent-multi-line-block)
+ (c-lineup-whitesmith-in-block): Two new lineup functions for
use in whitesmith style.
* cc-styles.el (c-style-alist): More fixes to whitesmith
style. It should now handle all different braces uniformly in
both hanging and non-hanging cases.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-cmds.el (c-indent-exp): Use a marker to save point to
make it stay in the same position relative to the surrounding
@@ -676,7 +676,7 @@
<seanl@cs.umd.edu>. Also extended the bsd and whitesmith
styles with consistent brace placement for all constructs.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-cmds.el (c-context-line-break): Continue C++ comments too
when point is in the middle of them.
@@ -702,8 +702,8 @@
`normal-auto-fill-function' to implement the
`c-ignore-auto-fill' variable.
- * cc-cmds.el (c-beginning-of-statement): Use
- `c-comment-prefix-regexp' to avoid ending up inside the
+ * cc-cmds.el (c-beginning-of-statement):
+ Use `c-comment-prefix-regexp' to avoid ending up inside the
comment prefix. Better handling of comment starters and
enders. Catch comments better when traversing code. Stop at
preprocessor directives.
@@ -711,7 +711,7 @@
* cc-defs.el (c-forward-comment): New subst to hide platform
dependent quirks in `forward-comment'.
- * cc-engine.el (c-literal-limits): Added NOT-IN-DELIMITER
+ * cc-engine.el (c-literal-limits): Add NOT-IN-DELIMITER
argument.
(c-literal-limits-fast): Implemented NEAR and NOT-IN-DELIMITER
arguments. Activate this function by default when
@@ -722,16 +722,16 @@
arguments.
* cc-align.el (c-lineup-C-comments): Fixes to handle the
- changed anchor position in the `c' syntactic symbol. Handle
- more than stars in the comment prefix; use the new variable
+ changed anchor position in the `c' syntactic symbol.
+ Handle more than stars in the comment prefix; use the new variable
`c-comment-prefix-regexp'. Don't indent text not preceded by
a comment prefix to the right of the comment opener if it's
long.
* cc-langs.el: Fixes to mode initialization for new line
breaking and paragraph filling method. Adaptive fill mode is
- now activated at startup instead of deactivated. The
- variables used for adaptive filling and paragraph movement are
+ now activated at startup instead of deactivated.
+ The variables used for adaptive filling and paragraph movement are
also changed to incorporate the value of
`c-comment-prefix-regexp'. `substitute-key-definition' is
used to override some functions in the global map instead of
@@ -741,31 +741,31 @@
javadoc markup at mode init.
* cc-mode.el (c-setup-filladapt): A new convenience function
- to configure Kyle E. Jones' Filladapt mode for CC Mode. This
- function is intended to be used explicitly by the end user
+ to configure Kyle E. Jones' Filladapt mode for CC Mode.
+ This function is intended to be used explicitly by the end user
only.
* cc-vars.el (c-comment-prefix-regexp): New variable used to
recognize the comment fill prefix inside comments.
(c-block-comment-prefix): New name for
- `c-comment-continuation-stars', which is now obsolete. It's
- generalized to handle any character sequence.
+ `c-comment-continuation-stars', which is now obsolete.
+ It's generalized to handle any character sequence.
(c-ignore-auto-fill): New variable used to selectively disable
Auto Fill mode in specific contexts.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-cmds.el (c-comment-indent): Leave at least one space
between the comment and the last nonblank character in the
case where we look at the indentation of the comment on the
previous line (case 4).
- * cc-engine.el (c-beginning-of-statement-1): Added ``' to the
+ * cc-engine.el (c-beginning-of-statement-1): Add ``' to the
list of characters that may start a statement (it's a sort of
prefix operator in Pike, and isn't used at all in any of the
other languages).
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-guess-basic-syntax): Report brace list opens
inside continued statements as statement-cont instead of
@@ -775,12 +775,12 @@
context. Case 10B.2 changed. Also changed (the somewhat
esoteric) case 9A to cope with this.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-electric-brace): Added electric handling of
+ * cc-cmds.el (c-electric-brace): Add electric handling of
the open brace for brace-elseif-brace.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-defs.el (c-with-syntax-table): New macro to easily switch
syntax tables temporarily.
@@ -789,26 +789,26 @@
member init argument lists split over several lines. Case 5D
changed.
- * cc-langs.el (c-Java-javadoc-paragraph-start): Added new tag
+ * cc-langs.el (c-Java-javadoc-paragraph-start): Add new tag
@throws introduced in Javadoc 1.2.
- * cc-menus.el (cc-imenu-java-generic-expression): Applied
- patch from RMS to avoid infinite backtracking.
+ * cc-menus.el (cc-imenu-java-generic-expression):
+ Applied patch from RMS to avoid infinite backtracking.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el (c-lineup-arglist): Handle "arglists" surrounded
by [ ].
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el (c-lineup-dont-change): Compensate properly for
the column in langelem.
- * cc-engine.el (c-syntactic-information-on-region): New
- function to help debugging the syntactic analysis.
+ * cc-engine.el (c-syntactic-information-on-region):
+ New function to help debugging the syntactic analysis.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el (c-lineup-template-args): Handle nested template
arglists.
@@ -824,18 +824,18 @@
* cc-styles.el (c-offsets-alist): Use `c-lineup-template-args'
by default.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-guess-basic-syntax): Pike allows a comma
immediately before the closing paren in an arglist, so don't
check that in Pike mode. Case 7A changed.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-indent-region): Fixed bug where comment-only
+ * cc-cmds.el (c-indent-region): Fix bug where comment-only
lines were ignored under certain conditions.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-align.el (c-lineup-template-args): New function for
aligning continued template argument lists.
@@ -844,68 +844,68 @@
lists containing function arglists split over several lines.
Case 5D.1 changed.
- * cc-engine.el (c-guess-basic-syntax): Fixed bug where
+ * cc-engine.el (c-guess-basic-syntax): Fix bug where
template-args-cont didn't get recognized when the first
- arglist opener line doesn't contain a template argument. New
- case 5K.
+ arglist opener line doesn't contain a template argument.
+ New case 5K.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-point): Changed from subst to macro for
+ * cc-defs.el (c-point): Change from subst to macro for
efficiency.
- (c-beginning-of-defun-1, c-end-of-defun-1): New
- beginning-of-defun/end-of-defun wrappers separated from
+ (c-beginning-of-defun-1, c-end-of-defun-1):
+ New beginning-of-defun/end-of-defun wrappers separated from
c-point.
- * cc-menus.el (imenu-generic-expression,
- imenu-case-fold-search, imenu-progress-message): Dummy
- definitions to avoid compiler warnings if imenu can't be
+ * cc-menus.el (imenu-generic-expression)
+ (imenu-case-fold-search, imenu-progress-message):
+ Dummy definitions to avoid compiler warnings if imenu can't be
loaded.
* cc-menus.el (cc-imenu-init): New function called at mode
init.
- * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): Moved
- imenu initializations to cc-imenu-init.
+ * cc-mode.el (c-mode, c++-mode, objc-mode, java-mode):
+ Move imenu initializations to cc-imenu-init.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-guess-basic-syntax): Slightly better check
for lambda-intro-cont in Pike mode. Case 6 changed.
- * cc-engine.el (c-looking-at-inexpr-block): Fixed bug where
+ * cc-engine.el (c-looking-at-inexpr-block): Fix bug where
anything following "new Foo()" was considered an anonymous
class body in Java mode.
-1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org>
+1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-cmds.el (c-comment-line-break-function): When breaking in
a string, don't insert a new line.
-1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org>
+1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-engine.el (c-at-toplevel-p): New interface function which
returns information useful to add-on authors. It tells you
whether you're at a toplevel statement or not.
-1999-12-12 Barry A. Warsaw <bug-cc-mode@gnu.org>
+1999-12-12 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
* cc-cmds.el (c-comment-line-break-function): It is possible
that forward-line does not land us at the bol, say if we're on
the last line in a file. In that case, do a
back-to-indentation instead of a forward-comment -1.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-beginning-of-statement-1): Don't catch
"default:" as normal label in case 4.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-guess-basic-syntax): Use c-bitfield-key to
recognize continued bitfield declarations. Case 5D.1 changed.
* cc-langs.el: New variable c-bitfield-key.
* cc-mode.el: New variable c-bitfield-key.
-1999-12-12 Martin Stjernholm <bug-cc-mode@gnu.org>
+1999-12-12 Martin Stjernholm <mast@lysator.liu.se>
* cc-engine.el (c-inside-bracelist-p): Tighter test for Java
anonymous array expressions (i.e. "new Foo[] {.. bracelist
@@ -917,8 +917,8 @@
keymap and minor-mode-alist stuff. Don't set zmacs-region-stays.
(footnote-insert-text-marker, Footnote-insert-pointer-marker):
Avoid `acons'.
- (footnote-mode-line-string, Footnote-add-footnote): Remove
- autoload cookie.
+ (footnote-mode-line-string, Footnote-add-footnote):
+ Remove autoload cookie.
1999-12-12 Richard Sharman <rsharman@pobox.com>
@@ -967,8 +967,8 @@
* files.el (after-find-file): Use auto-save-visited-file-name if
set.
- * mail/feedmail.el (feedmail-find-eoh): Take
- feedmail-queue-alternative-mail-header-separator into account.
+ * mail/feedmail.el (feedmail-find-eoh):
+ Take feedmail-queue-alternative-mail-header-separator into account.
1999-12-09 Stefan Monnier <monnier@cs.yale.edu>
@@ -976,7 +976,7 @@
* font-lock.el (font-lock-multiline): New variable.
(font-lock-add-keywords): Rename `major-mode' into `mode'.
- (font-lock-remove-keywords): Added a dummy `mode' argument for
+ (font-lock-remove-keywords): Add a dummy `mode' argument for
potential future support.
(font-lock-fontify-anchored-keywords)
(font-lock-fontify-keywords-region): Only handle multiline strings
@@ -1019,10 +1019,10 @@
1999-12-06 Michael Kifer <kifer@cs.sunysb.edu>
- * viper-cmd.el (viper-minibuffer-standard-hook,
- viper-minibuffer-real-start): Mew functions.
- (viper-read-string-with-history,viper-file-add-suffix,
- viper-trim-replace-chars-to-delete-if-necessary): Adapt to the
+ * viper-cmd.el (viper-minibuffer-standard-hook)
+ (viper-minibuffer-real-start): Mew functions.
+ (viper-read-string-with-history, viper-file-add-suffix)
+ (viper-trim-replace-chars-to-delete-if-necessary): Adapt to the
change in the status of the minibuffer prompt.
1999-12-06 Gerd Moellmann <gerd@gnu.org>
@@ -1055,12 +1055,12 @@
for better approximation of X colors.
(msdos-face-setup): Call tty-color-clear. Remove code that sets
up tty-color-alist (it is now on startup.el).
- (x-display-color-p, x-color-defined-p, x-color-values,
- x-defined-colors, face-color-supported-p, face-color-gray-p):
+ (x-display-color-p, x-color-defined-p, x-color-values)
+ (x-defined-colors, face-color-supported-p, face-color-gray-p):
Remove.
- * facemenu.el (facemenu-read-color, list-colors-display): Use
- defined-colors for all frame types.
+ * facemenu.el (facemenu-read-color, list-colors-display):
+ Use defined-colors for all frame types.
(facemenu-color-equal): Use color-values for all frame types.
* faces.el (read-face-attribute): For :foreground and :background
@@ -1071,14 +1071,14 @@
of frames.
(defined-colors, color-defined-p, color-values, display-color-p):
New functions.
- (x-defined-colors, x-color-defined-p, x-color-values,
- x-display-color-p): Aliases for the above.
+ (x-defined-colors, x-color-defined-p, x-color-values)
+ (x-display-color-p): Aliases for the above.
* startup.el (command-line): Register terminal colors for frame
types other than x and w32, but only if the terminal supports
colors. Call tty-color-define instead of face-register-tty-color.
- * term/x-win.el (xw-defined-colors): Renamed from
+ * term/x-win.el (xw-defined-colors): Rename from
x-defined-colors.
* term/w32-win.el (xw-defined-colors): Likewise.
@@ -1091,7 +1091,7 @@
1999-12-06 Inge Frick <inge@nada.kth.se>
- * dired-aux.el (dired-do-shell-command): Changed documentation.
+ * dired-aux.el (dired-do-shell-command): Change documentation.
(dired-shell-stuff-it): A `?' in COMMAND has now the same
meaning as `*'.
@@ -1103,11 +1103,11 @@
1999-12-06 Sam Steingold <sds@goems.com>
- * progmodes/etags.el (etags-tags-completion-table): Modified the
+ * progmodes/etags.el (etags-tags-completion-table): Modify the
regexp to allow for the CL symbols starting with `+*'.
(tags-completion-table): Doc fix (it's an obarray, not an alist).
- (tags-completion-table, tags-recognize-empty-tags-table): Remove
- `function' quoting lambda.
+ (tags-completion-table, tags-recognize-empty-tags-table):
+ Remove `function' quoting lambda.
(tags-with-face): New macro.
(list-tags, tags-apropos): Use it.
(tags-apropos-additional-actions): New user option.
@@ -1116,31 +1116,31 @@
(tags-apropos-verbose): New user option.
(etags-tags-apropos): Use it.
(visit-tags-table-buffer, next-file): Use `unless'.
- (recognize-empty-tags-table): Renamed to
+ (recognize-empty-tags-table): Rename to
tags-recognize-empty-tags-table.
(complete-tag): Call tags-complete-tag bypassing try-completion.
1999-12-06 Kenichi Handa <handa@etl.go.jp>
- * international/mule.el (set-buffer-file-coding-system): Docstring
- modified.
+ * international/mule.el (set-buffer-file-coding-system):
+ Docstring modified.
1999-12-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * textmodes/bibtex.el (bibtex-hs-forward-sexp): Added to support
+ * textmodes/bibtex.el (bibtex-hs-forward-sexp): Add to support
using the hideshow package.
- (hs-special-modes-alist): Added entry for bibtex to allow the use
+ (hs-special-modes-alist): Add entry for bibtex to allow the use
of the hideshow package.
- (bibtex-hide-entry-bodies): Deleted as hiding of entry bodies is
+ (bibtex-hide-entry-bodies): Delete as hiding of entry bodies is
not longer provided by bibtex.el directly. Instead the hideshow
package should be used.
- (bibtex-mode-map, bibtex-edit-menu, bibtex-mode): Delete
- references to bibtex-hide-entry-bodies.
+ (bibtex-mode-map, bibtex-edit-menu, bibtex-mode):
+ Delete references to bibtex-hide-entry-bodies.
1999-12-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * textmodes/bibtex.el: Copyright notice is up to date. Moved
- maintainer information closer to the beginning of the bibtex.el
+ * textmodes/bibtex.el: Copyright notice is up to date.
+ Moved maintainer information closer to the beginning of the bibtex.el
file.
(bibtex-maintainer-salutation): New constant.
(bibtex-version): New constant.
@@ -1148,16 +1148,16 @@
bibtex-maintainer-salutation.
(bibtex-entry-field-alist): Made booktitle field optional for
@inproceedings entries when crossreferenced.
- (bibtex-entry-field-alist): Added booktitle field to proceedings
+ (bibtex-entry-field-alist): Add booktitle field to proceedings
entry type (for cross referencing). Thanks to Wagner Toledo Correa
for the suggestion.
- (bibtex-string-file-path): Fixed typo.
+ (bibtex-string-file-path): Fix typo.
1999-12-05 Carsten Dominik <dominik@strw.leidenuniv.nl>
* textmodes/bibtex.el (bibtex-mode-map): Reserved the key `C-c &'
for reftex.el.
- (bibtex-edit-menu): Added `reftex-view-crossref-from-bibtex' to menu.
+ (bibtex-edit-menu): Add `reftex-view-crossref-from-bibtex' to menu.
1999-12-04 Dave Love <fx@gnu.org>
@@ -1166,14 +1166,14 @@
1999-12-04 Michael Kifer <kifer@cs.sunysb.edu>
- * viper-cmd.el (viper-change-state): Use
- viper-ESC-moves-cursor-back to decide whether to move the cursor
+ * viper-cmd.el (viper-change-state):
+ Use viper-ESC-moves-cursor-back to decide whether to move the cursor
back.
1999-12-03 Kenichi Handa <handa@mule.m17n.org>
- * international/mule-util.el (truncate-string-to-width): Docstring
- fixed.
+ * international/mule-util.el (truncate-string-to-width):
+ Docstring fixed.
1999-12-02 Stefan Monnier <monnier@cs.yale.edu>
@@ -1200,8 +1200,8 @@
* vc.el (vc-update-change-log): Look for rcs2log under
exec-directory.
- * emacs-lisp/lisp-mode.el (lisp-mode-variables): Change
- outline-regexp, add outline-level.
+ * emacs-lisp/lisp-mode.el (lisp-mode-variables):
+ Change outline-regexp, add outline-level.
(lisp-outline-level): New.
* calendar/appt.el (appt-convert-time): Handle "12:MMam",
@@ -1284,8 +1284,8 @@
* cus-start.el: Add use-dialog-box.
* add-log.el (change-log-mode-hook): Customize.
- (add-log-current-defun): Use
- fortran-{beginning,end}-of-subprogram.
+ (add-log-current-defun):
+ Use fortran-{beginning,end}-of-subprogram.
1999-11-26 Richard M. Stallman <rms@gnu.org>
@@ -1330,10 +1330,10 @@
* ediff-merge.el (ediff-looks-like-combined-merge)
(ediff-get-combined-region):
- Changed to support the new format for ediff-combination-pattern.
+ Change to support the new format for ediff-combination-pattern.
* ediff-diff.el (ediff-set-fine-overlays-in-one-buffer):
- Changed to support the new format for ediff-combination-pattern.
+ Change to support the new format for ediff-combination-pattern.
1999-11-24 Dave Love <fx@gnu.org>
@@ -1368,8 +1368,8 @@
imenu-generic-expression.
* sql.el (sql-mode): Use ?_ and ?. instead of 95 and 46 when
- setting font-lock-defaults' SYNTAX-ALIST. Set
- imenu-generic-expression, imenu-case-fold-search, and
+ setting font-lock-defaults' SYNTAX-ALIST.
+ Set imenu-generic-expression, imenu-case-fold-search, and
imenu-syntax-alist.
* sql.el (sql-interactive-mode): Use ?_ and ?. instead of 95
@@ -1389,30 +1389,30 @@
1999-11-23 Dave Love <fx@gnu.org>
- * progmodes/fortran.el (fortran-comment-line-start): Renamed from
+ * progmodes/fortran.el (fortran-comment-line-start): Rename from
comment-line-start.
- (fortran-comment-line-start-skip): Renamed from
+ (fortran-comment-line-start-skip): Rename from
comment-line-start-skip.
(fortran-mode-map): Use renamed functions. Add manual and custom
entries to menu.
(fortran-mode-hook): Customize.
- (fortran-comment-indent-function): Renamed from
+ (fortran-comment-indent-function): Rename from
fortran-comment-hook.
(delete-horizontal-regexp): Function deleted.
- (fortran-electric-line-number): Simplified.
- (fortran-beginning-of-subprogram): Renamed from
+ (fortran-electric-line-number): Simplify.
+ (fortran-beginning-of-subprogram): Rename from
beginning-of-fortran-subprogram.
- (fortran-end-of-subprogram): Renamed from
+ (fortran-end-of-subprogram): Rename from
end-of-fortran-subprogram.
- (fortran-mark-subprogram): Renamed from mark-fortran-subprogram.
- (fortran-previous-statement, fortran-next-statement): Simplified.
+ (fortran-mark-subprogram): Rename from mark-fortran-subprogram.
+ (fortran-previous-statement, fortran-next-statement): Simplify.
(fortran-blink-match): New function.
(fortran-blink-matching-if, fortran-blink-matching-do): Use it.
(fortran-indent-to-column): Don't use delete-horizontal-regexp.
- (fortran-find-comment-start-skip, fortran-is-in-string-p): Use
- line-end-position.
+ (fortran-find-comment-start-skip, fortran-is-in-string-p):
+ Use line-end-position.
(fortran-fill): No longer interactive. Simplified.
- (fortran-break-line): Simplified.
+ (fortran-break-line): Simplify.
(fortran-analyze-file-format): Use char-after, not looking-at.
* emacs-lisp/find-func.el (find-function-regexp):
@@ -1432,7 +1432,7 @@
* emacs-lisp/easy-mmode.el: Changed maintainer.
(easy-mmode-define-toggle): New BODY arg; Never append `-mode';
Use defcustom for the hooks; Improve the auto-generated docstrings.
- (easy-mmode-define-minor-mode): Renamed `define-minor-mode'.
+ (easy-mmode-define-minor-mode): Rename `define-minor-mode'.
(define-minor-mode): Add BODY arg; Only declare the keymap if
provided; Improve the auto-generated docstrings.
@@ -1498,8 +1498,8 @@
* speedbar.el: Clean up comment at the start of the file.
Remove RCS id.
- * progmodes/compile.el (compilation-parse-errors): Use
- compilation-buffer-p instead of testing major-mode.
+ * progmodes/compile.el (compilation-parse-errors):
+ Use compilation-buffer-p instead of testing major-mode.
1999-11-18 Dave Pearson <davep@hagbard.demon.co.uk>
@@ -1544,11 +1544,11 @@
1999-11-15 Sam Steingold <sds@goems.com>
- * goto-addr.el (goto-address-at-mouse,
- goto-address-find-address-at-point): Use compose-mail.
- (goto-address-mail-method): Removed variable.
- (goto-address-send-using-mh-e, goto-address-send-using-mhe,
- goto-address-send-using-mail): Removed functions.
+ * goto-addr.el (goto-address-at-mouse)
+ (goto-address-find-address-at-point): Use compose-mail.
+ (goto-address-mail-method): Remove variable.
+ (goto-address-send-using-mh-e, goto-address-send-using-mhe)
+ (goto-address-send-using-mail): Remove functions.
1998-11-15 Sam Steingold <sds@goems.com>
@@ -1583,7 +1583,7 @@
1999-11-14 Alex Schroeder <alex@gnu.org>
- * ansi-color.el (ansi-color-apply): Updated regexps to include
+ * ansi-color.el (ansi-color-apply): Update regexps to include
highlighted face.
1999-01-14 Johan Vromans <jvromans@squirrel.nl>
@@ -1599,11 +1599,11 @@
1999-11-13 Peter Breton <pbreton@ne.mediaone.net>
- * net-utils.el (run-network-program, net-utils-run-program): Use
- the new backquote syntax.
+ * net-utils.el (run-network-program, net-utils-run-program):
+ Use the new backquote syntax.
(smbclient-program, smbclient-program-options)
- (smbclient-prompt-regexp, smbclient-font-lock-keywords): New
- variables.
+ (smbclient-prompt-regexp, smbclient-font-lock-keywords):
+ New variables.
(smbclient, smbclient-list-shares): New functions
1999-11-12 Sam Steingold <sds@ksp.com>
@@ -1638,7 +1638,7 @@
1999-11-12 Peter Kleiweg <kleiweg@let.rug.nl>
- * progmodes/ps-mode.el (ps-mode-submit-bug-report): Added list
+ * progmodes/ps-mode.el (ps-mode-submit-bug-report): Add list
of customizable variables to bug report message. Added
system-type to package name in bug report.
@@ -1655,8 +1655,8 @@
1999-11-10 Peter Kleiweg <kleiweg@let.rug.nl>
- * progmodes/ps-mode.el (ps-mode-maintainer-address): New
- constant.
+ * progmodes/ps-mode.el (ps-mode-maintainer-address):
+ New constant.
(ps-mode-submit-bug-report): New function. Entry added to menu.
1999-11-10 William M. Perry <wmperry@aventail.com>
@@ -1685,7 +1685,7 @@
1999-11-08 Peter Kleiweg <kleiweg@let.rug.nl>
- * progmodes/ps-mode.el (ps-mode-print-function): Changed default
+ * progmodes/ps-mode.el (ps-mode-print-function): Change default
lpr-command to "lp" for some system-types. (copied from lpr.el
Emacs version 20.2.1).
@@ -1727,8 +1727,8 @@
* isearch.el (isearch-complete-edit, isearch-ring-advance-edit):
Use erase-field instead of erase-buffer.
- * frame.el (blink-cursor-mode, blink-cursor-end): Use
- internal-show-cursor with new interface.
+ * frame.el (blink-cursor-mode, blink-cursor-end):
+ Use internal-show-cursor with new interface.
(blink-cursor-timer-function): New.
(blink-cursor-start): Use blink-cursor-timer-function.
@@ -1760,8 +1760,8 @@
1999-11-01 Markus Rost <rost@ias.edu>
- * dired-x.el (dired-smart-shell-command): Use
- shell-command-history as in shell-command.
+ * dired-x.el (dired-smart-shell-command):
+ Use shell-command-history as in shell-command.
1999-11-01 Richard M. Stallman <rms@gnu.org>
@@ -1775,7 +1775,7 @@
of show-cursor.
(blink-cursor-start, blink-cursor-end): Ditto.
- * textmodes/tex-mode.el (tex-default-mode): Changed to latex-mode.
+ * textmodes/tex-mode.el (tex-default-mode): Change to latex-mode.
1999-11-01 Richard M. Stallman <rms@gnu.org>
@@ -1792,12 +1792,12 @@
* ediff.el: Version change.
- * ediff-util.el (ediff-cleanup-mess): Fixed the case of dead windows.
+ * ediff-util.el (ediff-cleanup-mess): Fix the case of dead windows.
make sure you are in a good frame before deleting other
windows.
(ediff-file-checked-in-p): Don't consider CVS
files checked in.
- (ediff-make-temp-file,ediff-make-empty-tmp-file): Make sure you
+ (ediff-make-temp-file, ediff-make-empty-tmp-file): Make sure you
are writing to a newly created empty file.
* ediff-mult.el (ediff-show-session-group-hook): New default.
@@ -1816,15 +1816,15 @@
* viper-keym.el: Fixed calls to viper-ex, change key C-c g to C-c C-g.
- * viper-util.el (viper-nontrivial-find-file-function): Deleted.
+ * viper-util.el (viper-nontrivial-find-file-function): Delete.
(viper-glob-unix-files, viper-glob-mswindows-files): New functions.
- (viper-save-cursor-color,viper-restore-cursor-color):
- Improved cursor color handling.
+ (viper-save-cursor-color, viper-restore-cursor-color):
+ Improve cursor color handling.
(viper-get-saved-cursor-color-in-replace-mode)
(viper-get-saved-cursor-color-in-insert-mode): New functions for
better cursor color handling.
- * viper-ex.el (ex-read,ex-edit):
+ * viper-ex.el (ex-read, ex-edit):
Fixes for correct interpretation of #,%.
(viper-ex): Now works correctly when called from other functions.
(viper-glob-function): New variable.
@@ -1874,7 +1874,7 @@
`whitespace-check-<whitespace-type>' to nil.
(whitespace-unchecked-whitespaces): New function to return the
list of whitespaces for whom checks have been suppressed.
- (whitespace-display-unchecked-whitespaces): Renamed to
+ (whitespace-display-unchecked-whitespaces): Rename to
`whitespace-update-modeline' to reflect its functionality.
1999-10-30 Gerd Moellmann <gerd@gnu.org>
@@ -1895,8 +1895,8 @@
* progmodes/ada-stmt.el, progmodes/ada-xref.el: Doc-string and
comment fixes.
- * progmodes/compile.el (compilation-error-regexp-alist): Recognize
- MIPS Pro 7.3 compiler error message syntax.
+ * progmodes/compile.el (compilation-error-regexp-alist):
+ Recognize MIPS Pro 7.3 compiler error message syntax.
1999-10-27 Dave Love <fx@gnu.org>
@@ -1909,7 +1909,7 @@
1999-10-27 Dave Love <fx@gnu.org>
* emacs-lisp/advice.el: Doc fixes.
- (ad-lemacs-p): Removed.
+ (ad-lemacs-p): Remove.
(advice): Add :link to defgroup.
1999-10-27 Kenichi Handa <handa@etl.go.jp>
@@ -1924,11 +1924,11 @@
1999-10-27 Richard M. Stallman <rms@gnu.org>
- * emacs-lisp/advice.el (ad-activate-internal): Renamed from
+ * emacs-lisp/advice.el (ad-activate-internal): Rename from
ad-activate. All callers changed, including those in data.c.
- (ad-activate-internal-off): Renamed from ad-activate-off.
+ (ad-activate-internal-off): Rename from ad-activate-off.
All uses changed.
- (ad-activate): Renamed from ad-activate-on. All uses changed.
+ (ad-activate): Rename from ad-activate-on. All uses changed.
(ad-start-advice, ad-stop-advice, ad-recover-normality):
Alter the definition of ad-activate-internal, not ad-activate.
@@ -1951,7 +1951,7 @@
1999-10-25 Sam Steingold <sds@ksp.com>
- * Makefile (compile-files): Fixed the "tr" strings.
+ * Makefile (compile-files): Fix the "tr" strings.
(EMACS): Set to ../src/emacs.
1999-10-25 Gerd Moellmann <gerd@gnu.org>
@@ -1991,7 +1991,7 @@
1999-10-22 Paul Eggert <eggert@twinsun.com>
- * international/mule-cmds.c (locale-language-names):
+ * international/mule-cmds.el (locale-language-names):
Use Latin-1 (not Latin-3) for Afrikaans, Galician.
Use Latin-5 (not Cyrillic-ISO) for Byelorussian, Bulgarian,
Macedonian, Russian, Ukrainian, Serbian (Cyrillic alphabet).
@@ -2037,10 +2037,10 @@
* ps-print-def.el: New file: common definitions for all parts of
ps-print.
- (ps-multibyte-buffer): Moved from ps-mule.
+ (ps-multibyte-buffer): Move from ps-mule.
* ps-mule.el: File dependence fix.
- (ps-multibyte-buffer): Moved to ps-print-def.
+ (ps-multibyte-buffer): Move to ps-print-def.
* ps-print.el: Doc fix, better customization.
(ps-print-region-function, ps-number-of-columns, ps-spool-tumble)
@@ -2070,7 +2070,7 @@
* ps-print.el: Doc fix, n-up printing.
(ps-print-version): New version number (5.0).
- (ps-page-dimensions-database): Added document media.
+ (ps-page-dimensions-database): Add document media.
(ps-n-up-printing, ps-n-up-margin, ps-n-up-border-p, ps-n-up-filling)
(ps-page-order, ps-printing-region-p): New vars.
(ps-n-up-printing, ps-n-up-filling, ps-header-sheet, ps-end-job):
@@ -2085,8 +2085,8 @@
(ps-setup, ps-begin-file, ps-get-buffer-name, ps-begin-job)
(ps-end-file, ps-dummy-page, ps-generate): Fix funs.
(ps-print-prologue-1): Adjust PostScript programming for n-up printing.
- (ps-count-lines): Changed to defun.
- (ps-header-page): Changed to defsubst, fix fun.
+ (ps-count-lines): Change to defun.
+ (ps-header-page): Change to defsubst, fix fun.
(ps-printing-region): Doc fix, adjust programming code.
(ps-output-boolean, ps-background-pages, ps-background-text)
(ps-background-image, ps-background, ps-get-boundingbox):
@@ -2097,9 +2097,9 @@
* ps-print.el: Doc fix, duplex and setpagedevice configuration.
(ps-print-version): New version number (4.2).
(ps-spool-config, ps-spool-tumble): New vars.
- (ps-print-prologue-1): Changed to defconst, adjust PostScript
+ (ps-print-prologue-1): Change to defconst, adjust PostScript
programming, new PostScript procedure to handle errors.
- (ps-print-prologue-2): Changed to defconst.
+ (ps-print-prologue-2): Change to defconst.
(ps-print-duplex-feature): New const: duplex and tumble setting.
(ps-setup, ps-begin-file): Fix funs.
(ps-boolean-capitalized): New fun.
@@ -2107,9 +2107,9 @@
1999-10-19 Stefan Monnier <monnier@cs.yale.edu>
* Makefile (dontcompilefiles): Obsoleted.
- (DONTCOMPILE): Added emacs-lisp/cl-specs.el.
+ (DONTCOMPILE): Add emacs-lisp/cl-specs.el.
(EL): Unused.
- (temacs): Removed (unused).
+ (temacs): Remove (unused).
(cus-load.el, finder-inf.el, loaddefs.el): New targets to build a dummy
version of the file (necessary for the update to work properly).
(autoloads): Force the use of `pwd`/loaddefs.el.
@@ -2139,18 +2139,18 @@
value: \"lpr\" changed to "lpr".
(ps-mode-version): New constant.
(ps-mode-show-version): New function, added key in ps-mode-map.
- (ps-run-messages): Removed.
+ (ps-run-messages): Remove.
(ps-run-font-lock-keywords-2): New defcustom variable replacing
ps-run-messages. These keywords now include the value of
ps-run-prompt, making its fontification customizable.
- (ps-run-init): Removed \\n from docstring, it is now added when
+ (ps-run-init): Remove \\n from docstring, it is now added when
the value is used.
- (ps-run-font-lock-keywords-1): Added checking for initial ^ in
+ (ps-run-font-lock-keywords-1): Add checking for initial ^ in
ps-run-prompt.
- (ps-mode): Added ps-run-font-lock-keywords-2 to list of
+ (ps-mode): Add ps-run-font-lock-keywords-2 to list of
customizable variables in doc-string (its equivalent
ps-run-messages was missing in previous version of the doc-string).
- (ps-run-mode): Simplified assignment to font-lock-defaults, using
+ (ps-run-mode): Simplify assignment to font-lock-defaults, using
symbols only.
1999-10-19 Alex Schroeder <alex@gnu.org>
@@ -2177,7 +2177,7 @@
(set-display-table-and-terminal-coding-system): New function,
containing code migrated out of set-language-environment.
(set-language-environment, set-locale-environment): Use it.
- (locale-translation-file-name): Moved here from startup.el.
+ (locale-translation-file-name): Move here from startup.el.
(locale-language-names, locale-preferred-coding-systems):
New vars.
(locale-name-match, set-locale-environment): New functions.
@@ -2253,7 +2253,7 @@
1999-10-17 Sam Steingold <sds@ksp.com>
- * bindings.el (completion-ignored-extensions): Added ".sparcf"
+ * bindings.el (completion-ignored-extensions): Add ".sparcf"
for CMUCL on sparc and ".ufsl" for LispWorks.
(bound-and-true-p): Bugfix: free variable `v'.
@@ -2342,8 +2342,8 @@
1999-10-12 Stefan Monnier <monnier@cs.yale.edu>
- * simple.el (shell-command, shell-command-on-region): Use
- make-temp-file.
+ * simple.el (shell-command, shell-command-on-region):
+ Use make-temp-file.
(clone-buffer, clone-process, clone-buffer-hook): New functions.
* subr.el (with-current-buffer): Don't use backquotes to avoid
@@ -2355,7 +2355,7 @@
1999-10-12 Emmanuel Briot <briot@gnat.com>
- * ada-stmt.el: Doc-string fixes.
+ * progmodes/ada-stmt.el: Doc-string fixes.
1999-10-12 Gerd Moellmann <gerd@gnu.org>
@@ -2369,16 +2369,16 @@
1999-10-12 Richard Sharman <rsharman@pobox.com>
* sh-script.el: Added support for indenting existing scripts.
- (sh-mode-map): Added new bindings.
- (sh-mode): Updated mode doc-string for new commands, added
+ (sh-mode-map): Add new bindings.
+ (sh-mode): Update mode doc-string for new commands, added
make-local-variable calls, initialize mode-specific variables.
- (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line
+ (sh-indent-line): Rename to sh-basic-indent-line; sh-indent-line
is now a different function.
- (sh-header-marker): Changed docstring.
+ (sh-header-marker): Change docstring.
(sh-set-shell): Initialize mode-specific variables.
(sh-case, sh-for, sh-if, sh-indexed-loop, sh-repeat, sh-select)
(sh-tmp-file, sh-until, sh-until, sh-while, sh-while-getopts):
- Changed these define-skeleton calls to work with user-specified
+ Change these define-skeleton calls to work with user-specified
indentation settings.
(sh-basic-indent-line, sh-blink, sh-calculate-indent)
(sh-check-paren-in-case, sh-check-rule, sh-do-nothing)
@@ -2472,28 +2472,26 @@
1999-10-07 Emmanuel Briot <briot@gnat.com>
- * ada-xref.el: New file
+ * progmodes/ada-xref.el, progmodes/ada-prj.el: New files.
- * ada-prj.el: New file
+ * progmodes/ada-stmt.el (ada-stmt-add-to-ada-menu): New function.
- * ada-stmt.el (ada-stmt-add-to-ada-menu): New function
+ * progmodes/ada-stmt.el (ada-subprogram-body): Correctly find
+ the name of the subprogram being created.
- * ada-stmt.el (ada-subprogram-body): Correctly find the name of the
- subprogram being created.
+ * progmodes/ada-mode.el (ada-get-indent-*, ada-indent-current)
+ (ada-goto-*, ada-indent-newline-indent):
+ Rewritten to support the new indentation scheme.
- * ada-mode.el (ada-get-indent-*, ada-indent-current, ada-goto-*,
- ada-indent-newline-indent): Rewritten to support the new indentation
- scheme
+ * progmodes/ada-mode.el (ada-case-read-exceptions)
+ (ada-create-case-exceptions): New functions.
- * ada-mode.el (ada-case-read-exceptions, ada-create-case-exceptions):
- New functions
+ * progmodes/ada-mode.el (ada-fill-comment-paragraph):
+ Add support for the justification parameter
- * ada-mode.el (ada-fill-comment-paragraph): Add support for the
- justification parameter
-
- * ada-mode.el (ada-make-body, ada-gen-treat-proc,
- ada-make-subprogram-body): Rewritten to benefit from the gnatstub
- external program
+ * progmodes/ada-mode.el (ada-make-body, ada-gen-treat-proc)
+ (ada-make-subprogram-body): Rewritten to benefit from the gnatstub
+ external program.
1999-10-07 Dave Love <fx@gnu.org>
@@ -2604,9 +2602,9 @@
(isearch-yank-x-selection, isearch-ring-advance-edit): Doc fix.
(isearch-ring-retreat-edit): Doc fix.
(isearch-mouse-yank): New command.
- (isearch-last-command-char): Removed. Callers changed to use
+ (isearch-last-command-char): Remove. Callers changed to use
last-command-char.
- (isearch-char-to-string): Removed. Callers changed to use
+ (isearch-char-to-string): Remove. Callers changed to use
char-to-string.
1999-09-26 Oleg S. Tihonov <tihonov@ffke-campus.mipt.ru>
@@ -2654,10 +2652,10 @@
* textmodes/reftex-parse.el (reftex-parse-from-file): Scan for
multiple thebibliography environments.
- * textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Fixed bug
+ * textmodes/reftex-cite.el (reftex-pop-to-bibtex-entry): Fix bug
with recentering window.
(reftex-extract-bib-entries-from-thebibliography)
- (reftex-offer-bib-menu,reftex-bibtex-selection-callback):
+ (reftex-offer-bib-menu, reftex-bibtex-selection-callback):
Deal with multiple thebibliography environments.
* textmodes/reftex-vars.el (reftex-section-levels):
@@ -2751,7 +2749,7 @@
`copy-file'.
(dired-copy-file-recursive): New function. Copy directories
recursively.
- (dired-do-create-files): Added support for generalized directory
+ (dired-do-create-files): Add support for generalized directory
target. How-to function may now return a function. New fluid
variable `dired-one-file'.
(dired-copy-how-to-fn): New variable.
@@ -2772,8 +2770,8 @@
* whitespace.el (whitespace-modes): Add `change-log-mode' to the
list of modes to be checked for bogus whitespaces.
- * whitespace.el (whitespace-rescan-timer-time): Update
- documentation.
+ * whitespace.el (whitespace-rescan-timer-time):
+ Update documentation.
* whitespace.el (whitespace-display-unchecked-whitespaces):
New function to update modeline with untested whitespaces.
@@ -2818,8 +2816,8 @@
(widget-button-pressed-face): New variable.
(widget-button-click): Use it.
(widget-documentation-link-add): Specify mouse and button faces.
- (widget-echo-help-mouse, widget-stop-mouse-tracking): Functions
- removed now the functionality is built in.
+ (widget-echo-help-mouse, widget-stop-mouse-tracking):
+ Functions removed now the functionality is built in.
* cus-edit.el: Don't define-widget-keywords.
(multimedia): New group.
@@ -2837,15 +2835,15 @@
Changes from Didier Verna:
(custom-prompt-variable): Optional third arg makes prompt for a
comment string.
- (customize-set-value, customize-set-variable,
- customize-save-variable): Optional prefix makes function handle
+ (customize-set-value, customize-set-variable)
+ (customize-save-variable): Optional prefix makes function handle
variable comments.
(customize-customized, customize-saved, custom-variable-state-set)
(custom-variable-set, custom-variable-save, custom-face-state-set)
(custom-variable-reset-saved, custom-variable-reset-standard)
(custom-face-set, custom-face-save, custom-face-reset-saved)
- (custom-face-reset-standard, customize-save-customized): Handle
- custom comments.
+ (custom-face-reset-standard, customize-save-customized):
+ Handle custom comments.
(custom-comment-face, custom-comment-tag-face): New face.
(custom-comment): New widget.
(custom-comment-create, custom-comment-delete)
@@ -2938,8 +2936,8 @@
* emacs-lisp/byte-opt.el (byte-optimize-backward-char):
(byte-optimize-backward-word): New optimizations.
- (side-effect-free-fns, side-effect-and-error-free-fns): Add
- entries.
+ (side-effect-free-fns, side-effect-and-error-free-fns):
+ Add entries.
1999-09-09 Gerd Moellmann <gerd@gnu.org>
@@ -2975,7 +2973,7 @@
1999-09-08 Peter Breton <pbreton@ne.mediaone.net>
- * generic-x.el (generic-define-unix-modes): Added new modes:
+ * generic-x.el (generic-define-unix-modes): Add new modes:
inetd-conf-generic-mode, etc-services-generic-mode,
etc-passwd-generic-mode. These are all defined for Unix by default.
(apache-generic-mode): Use an imenu-generic-expression to list
@@ -2987,11 +2985,11 @@
font-lock-defaults setting.
(java-properties-generic-mode): Supports both ! and # as comment
characters.
- (java-properties-generic-mode): Added an imenu-generic-expression.
- (java-properties-generic-mode): Reworked to support the various
+ (java-properties-generic-mode): Add an imenu-generic-expression.
+ (java-properties-generic-mode): Rework to support the various
different ways to separate name and value (viz, '=', ':' and
whitespace).
- (show-tabs-generic-mode): Added this new generic-mode.
+ (show-tabs-generic-mode): Add this new generic-mode.
1999-09-08 Richard Stallman <rms@gnu.org>
@@ -3061,7 +3059,7 @@
1999-09-07 Dave Pearson <davep@hagbard.demon.co.uk>
- * quickurl.el (quickurl-list-focused-line): Removed.
+ * quickurl.el (quickurl-list-focused-line): Remove.
(quickurl-list-insert): Now works out the focused line using
`count-lines' instead of using `quickurl-list-focused-line'.
@@ -3074,7 +3072,7 @@
* isearch.el (isearch-mode-map): Add mouse-2.
- * mail/rmail.el (rmail-read-password): Deleted.
+ * mail/rmail.el (rmail-read-password): Delete.
(rmail-get-pop-password): Use read-password.
* quickurl.el: Don't conditionally define caddr.
@@ -3087,8 +3085,8 @@
1999-09-06 Stephen Eglen <stephen@gnu.org>
- * progmodes/octave-inf.el (inferior-octave-startup-args): Add
- --no-line-editing so that TABs in source files are not interpreted
+ * progmodes/octave-inf.el (inferior-octave-startup-args):
+ Add --no-line-editing so that TABs in source files are not interpreted
as completion requests.
1999-09-06 Gerd Moellmann <gerd@gnu.org>
@@ -3114,7 +3112,7 @@
1999-09-06 Dave Love <fx@gnu.org>
- * emacs-lisp/byte-opt.el (byte-boolean-vars): Removed. (Now primitive.)
+ * emacs-lisp/byte-opt.el (byte-boolean-vars): Remove. (Now primitive.)
1999-09-05 Richard Stallman <rms@gnu.org>
@@ -3130,7 +3128,7 @@
1999-09-05 Gerd Moellmann <gerd@gnu.org>
- * faces.el (header-line): Renamed from `top-line'.
+ * faces.el (header-line): Rename from `top-line'.
1999-09-05 Gerd Moellmann <gerd@gnu.org>
@@ -3185,20 +3183,20 @@
* startup.el (command-line): Compute the value of
small-temporary-file-directory.
- * ediff-init.el (ediff-temp-file-prefix): Use
- small-temporary-file-directory if non-nil.
+ * ediff-init.el (ediff-temp-file-prefix):
+ Use small-temporary-file-directory if non-nil.
* vc.el (vc-update-change-log): Likewise.
* progmodes/cmacexp.el (c-macro-expansion): Likewise.
- * simple.el (shell-command, shell-command-on-region): Use
- make-temp-name properly. Use small-temporary-file-directory if
+ * simple.el (shell-command, shell-command-on-region):
+ Use make-temp-name properly. Use small-temporary-file-directory if
non-nil, otherwise temporary-file-directory, to generate temporary
files.
- * dos-w32.el (direct-print-region-helper): Use
- temporary-file-directory. (From Stefan Monnier.)
+ * dos-w32.el (direct-print-region-helper):
+ Use temporary-file-directory. (From Stefan Monnier.)
1999-09-02 Richard Stallman <rms@gnu.org>
@@ -3239,8 +3237,8 @@
* progmodes/compile.el (compilation-error-regexp-alist):
New item for SGI IRIX MipsPro compilers.
- * speedbar.el (speedbar-directory-buttons): Recognize
- device names when checking for file names.
+ * speedbar.el (speedbar-directory-buttons):
+ Recognize device names when checking for file names.
* array.el (array-reconfigure-rows): Use generate-new-buffer.
@@ -3273,8 +3271,8 @@
* comint.el (comint-input-ring-separator): New variable.
(comint-read-input-ring): Doc change; use
comint-input-ring-separator when reading file.
- (comint-write-input-ring): Use
- comint-input-ring-separator when writing file.
+ (comint-write-input-ring):
+ Use comint-input-ring-separator when writing file.
1999-08-29 Marc Girod <girod@shire.ntc.nokia.com>
@@ -3308,8 +3306,8 @@
* calendar/cal-move.el: Call the new hook in every movement function.
- * calendar/calendar.el (calendar-goto-astro-day-number): Autoload
- the right function name.
+ * calendar/calendar.el (calendar-goto-astro-day-number):
+ Autoload the right function name.
1999-08-26 Stephen Gildea <gildea@stop.mail-abuse.org>
@@ -3318,7 +3316,7 @@
(time-stamp): Support multi-line patterns.
(time-stamp-inserts-lines): New variable.
(time-stamp-count): New variable.
- (time-stamp-string-preprocess): Fixed bug where "%%a" becomes
+ (time-stamp-string-preprocess): Fix bug where "%%a" becomes
"Thu" instead of "%a".
1999-08-25 Gerd Moellmann <gerd@gnu.org>
@@ -3340,7 +3338,7 @@
1999-08-24 Gerd Moellmann <gerd@gnu.org>
- * faces.el (margin): Renamed from bitmap-area.
+ * faces.el (margin): Rename from bitmap-area.
1999-08-24 Alex Schroeder <alex@gnu.org>
@@ -3425,8 +3423,8 @@
1999-08-16 Karl Heuer <kwzh@gnu.org>
- * subr.el (assoc-ignore-case, assoc-ignore-representation): Moved
- here from simple.el.
+ * subr.el (assoc-ignore-case, assoc-ignore-representation):
+ Move here from simple.el.
1999-08-16 Dave Love <fx@gnu.org>
@@ -3463,17 +3461,17 @@
1999-08-16 Carsten Dominik <cd@gnu.org>
- * textmodes/reftex.el (reftex-pop-to-bibtex-entry): Fixed
- conflict with pop-up-frames.
+ * textmodes/reftex.el (reftex-pop-to-bibtex-entry):
+ Fix conflict with pop-up-frames.
(reftex-special-environment-parsers): New constant.
(reftex-label-alist): car of an entry can also be a function.
(reftex-what-special-env): Cew function.
(reftex-label-location): Call `reftex-what-special-env'.
(reftex-compile-variables): Check for symbol in `reftex-label-alist'.
- (reftex-what-environment): Fixed bug with stacked environments of
+ (reftex-what-environment): Fix bug with stacked environments of
same kind (e.g. enumerate).
(reftex-process-string): Preserve default directory.
- (reftex-label-alist-builtin): Changed prefixes of endnote and footnote.
+ (reftex-label-alist-builtin): Change prefixes of endnote and footnote.
Also the magic words.
(reftex-reference): Interpret new option `reftex-fref-is-default'.
(reftex-replace-prefix-escapes): Interpret new `%S' format.
@@ -3488,7 +3486,7 @@
boundaries has been moved to `F'.
(reftex-select-label-map): Toggling display of file boundaries is
now on the `F' key, for consistency with `reftex-toc-map'.
- (reftex-erase-all-selection-and-index-buffers): Renamed from
+ (reftex-erase-all-selection-and-index-buffers): Rename from
`reftex-erase-all-selection-buffer'. Now also kills the index
buffers.
(reftex-viewing-cross-references): Customization group renamed
@@ -3606,23 +3604,23 @@
be the same size when necessary to fit all the rings in the
window; and poles can be oriented horizontally. Face support is
thrown in gratuitously.
- (hanoi): Changed default number of rings back to 3.
+ (hanoi): Change default number of rings back to 3.
(hanoi-unix, hanoi-unix-64): New commands.
- (hanoi-horizontal-flag, hanoi-move-period, hanoi-use-faces,
- hanoi-pole-face, hanoi-base-face, hanoi-even-ring-face,
- hanoi-odd-ring-face): New variables.
- (hanoi-internal, hanoi-current-time-float, hanoi-put-face,
- hanoi-n, hanoi-insert-ring, hanoi-goto-char, hanoi-sit-for,
- hanoi-ring-to-pos, hanoi-pos-on-tower-p): New functions.
- (hanoi-0): Renamed from hanoi0, for symmetry with hanoi-n.
- (hanoi-topos, hanoi-draw-ring): Removed.
+ (hanoi-horizontal-flag, hanoi-move-period, hanoi-use-faces)
+ (hanoi-pole-face, hanoi-base-face, hanoi-even-ring-face)
+ (hanoi-odd-ring-face): New variables.
+ (hanoi-internal, hanoi-current-time-float, hanoi-put-face)
+ (hanoi-n, hanoi-insert-ring, hanoi-goto-char, hanoi-sit-for)
+ (hanoi-ring-to-pos, hanoi-pos-on-tower-p): New functions.
+ (hanoi-0): Rename from hanoi0, for symmetry with hanoi-n.
+ (hanoi-topos, hanoi-draw-ring): Remove.
1999-08-12 Gerd Moellmann <gerd@gnu.org>
* faces.el (face-valid-attribute-values): Return an alist for
families on ttys.
- (face-read-integer): Handle unspecified face attributes. Add
- completion for `unspecified'.
+ (face-read-integer): Handle unspecified face attributes.
+ Add completion for `unspecified'.
(read-face-attribute): Handle unspecified font attributes.
(face-valid-attribute-values): Add `unspecified' to lists so that
it can be chosen via completion.
@@ -3660,7 +3658,7 @@
(easy-menu-change): Doc fix.
* info-look.el (info-lookup-guess-c-symbol): Use skip-syntax-backward.
- (info-lookup-guess-default): Simplified and cleaned up.
+ (info-lookup-guess-default): Simplify and cleaned up.
(info-lookup-guess-default*): Preserve point.
* view.el (view-mode-disable): If buffer-read-only is nil,
@@ -3680,13 +3678,13 @@
1999-08-10 Alex Schroeder <asc@bsiag.com>
- * ansi-color.el (ansi-color-to-text-properties): Added New state 5
+ * ansi-color.el (ansi-color-to-text-properties): Add New state 5
to prevent m-eating-bug.
1999-08-10 Eli Zaretskii <eliz@gnu.org>
- * term/pc-win.el (msdos-bg-mode): Remove. Call
- frame-set-background-mode instead. All callers changed.
+ * term/pc-win.el (msdos-bg-mode): Remove.
+ Call frame-set-background-mode instead. All callers changed.
(msdos-face-setup): Don't force color display parameter, it is set
by frame-set-background-mode.
(make-msdos-frame): Call x-handle-reverse-video and
@@ -3697,8 +3695,8 @@
1999-08-10 Dave Love <fx@melange.gnu.org>
- * emacs-lisp/advice.el (ad-make-single-advice-docstring): Treat
- case with no docstring specially.
+ * emacs-lisp/advice.el (ad-make-single-advice-docstring):
+ Treat case with no docstring specially.
1999-08-09 Eli Zaretskii <eliz@gnu.org>
@@ -3707,8 +3705,8 @@
1999-08-07 Dave Love <fx@gnu.org>
- * man.el (Man-softhyphen-to-minus): Revert previous change. Avoid
- unibyte to multibyte conversion of search-forward (from Handa),
+ * man.el (Man-softhyphen-to-minus): Revert previous change.
+ Avoid unibyte to multibyte conversion of search-forward (from Handa),
but avoid the replacement if the language is Latin-N.
1999-08-06 Richard Stallman <rms@gnu.org>
@@ -3771,7 +3769,7 @@
* progmodes/ada-mode.el (ada-tmp-directory):
Use temporary-file-directory.
- * progmodes/compile.el (compilation-parsing-end,compilation-setup)
+ * progmodes/compile.el (compilation-parsing-end, compilation-setup)
(compilation-filter, compilation-forget-errors)
(compilation-parse-errors): Use a marker instead of an integer for
`compilation-parsing-end'.
@@ -3813,14 +3811,14 @@
(apply-on-rectangle): New function, mostly replaces
`operate-on-rectangle'. All callers changed.
(move-to-column-force): Pass new second argument to `move-to-column'.
- (kill-rectangle): Added optional prefix arg to fill lines.
+ (kill-rectangle): Add optional prefix arg to fill lines.
(delete-rectangle): Ditto.
(delete-whitespace-rectangle): Ditto.
(delete-extract-rectangle): Ditto.
(open-rectangle): Ditto.
(clear-rectangle): Ditto.
(delete-whitespace-rectangle-line): New function.
- (delete-rectangle-line): Added third arg FILL.
+ (delete-rectangle-line): Add third arg FILL.
(delete-extract-rectangle-line): Ditto.
(open-rectangle-line): Ditto.
(clear-rectangle-line): Ditto.
@@ -3878,7 +3876,7 @@
frame-delete-all.
* frame.el: Change comments to doc strings and other doc fixes.
- (frame-delete-all): Moved to subr.el as `assoc-delete-all'.
+ (frame-delete-all): Move to subr.el as `assoc-delete-all'.
Callers changed.
(set-background-color, set-foreground-color, set-cursor-color)
(set-mouse-color, set-border-color): Offer completion of colors.
@@ -3950,7 +3948,7 @@
* mouse.el (x-fixed-font-alist): Add lucidasanstypewriter.
* msb.el: Require cl only when compiling.
- (msb--home-dir): Deleted.
+ (msb--home-dir): Delete.
(msb--format-title): Use abbreviate-file-name.
(msb--choose-file-menu): Simplify string comparison.
@@ -3982,7 +3980,7 @@
1999-07-26 Kenichi Handa <handa@etl.go.jp>
* international/ccl.el (ccl-embed-symbol): New function.
- (ccl-program-p): Deleted. Now it's implemented in C code.
+ (ccl-program-p): Delete. Now it's implemented in C code.
(ccl-compile-call): Use ccl-embed-symbol to embed a symbol.
(ccl-compile-translate-character): Likewise.
(ccl-compile-map-single): Likewise.
@@ -4023,19 +4021,19 @@
* fortran.el (fortran-mode-syntax-table): Change `\' to `\'
syntax.
- (fortran-fontify-string, fortran-match-!-comment): Deleted.
+ (fortran-fontify-string, fortran-match-!-comment): Delete.
(fortran-font-lock-syntactic-keywords): New variable.
(fortran-mode): Use it.
(fortran-font-lock-keywords-1): Don't do comments.
- (beginning-of-fortran-subprogram, end-of-fortran-subprogram): Save
- match data.
+ (beginning-of-fortran-subprogram, end-of-fortran-subprogram):
+ Save match data.
* textmodes/sgml-mode.el (sgml-validate-command): Use nsgmls.
- * msb.el (msb-menu-bar-update-buffers): Renamed from
+ * msb.el (msb-menu-bar-update-buffers): Rename from
menu-bar-update-buffers.
- (msb-custom-set, msb--toggle-menu-type): Call
- msb-menu-bar-update-buffers.
+ (msb-custom-set, msb--toggle-menu-type):
+ Call msb-menu-bar-update-buffers.
(msb-mode): Revise the hook setting.
* font-lock.el (turn-on-font-lock): Use tty-display-color-p.
@@ -4081,9 +4079,9 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * cl-extra.el (cl-make-hash-table): Renamed from make-hash-table.
- (cl-hash-table-p): Renamed from hash-table-p.
- (cl-hash-table-count): Renamed from hash-table-count.
+ * cl-extra.el (cl-make-hash-table): Rename from make-hash-table.
+ (cl-hash-table-p): Rename from hash-table-p.
+ (cl-hash-table-count): Rename from hash-table-count.
(maphash): Alias to cl-maphash removed.
(gethash): Likewise.
(puthash): Likewise.
@@ -4150,7 +4148,7 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * faces.el (face-underline): Removed.
+ * faces.el (face-underline): Remove.
(face-underline-color): Ditto.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
@@ -4321,10 +4319,10 @@
* bindings.el (make-mode-line-mouse-sensitive): Use down-mouse-3
instead of mouse-3 to pop up menus.
- (mode-line-kill-buffer): Removed.
+ (mode-line-kill-buffer): Remove.
(make-mode-line-mouse-sensitive): Pop mouse buffer menu over
buffer name.
- (mode-line-buffer-menu-1): Removed.
+ (mode-line-buffer-menu-1): Remove.
* startup.el (command-line-1): Call make-mode-line-mouse-sensitive.
@@ -4407,7 +4405,7 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * faces.el (frame-update-faces): Copied from 20.2.
+ * faces.el (frame-update-faces): Copy from 20.2.
(frame-update-face-colors): Ditto. Code removed that isn't
applicable in the new face implementation.
@@ -4426,12 +4424,12 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * faces.el (face-charset-registries): Removed since fontset.el
+ * faces.el (face-charset-registries): Remove since fontset.el
is no always loaded.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * faces.el (internal-get-face): Added as obsolete function for
+ * faces.el (internal-get-face): Add as obsolete function for
compatibility.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
@@ -4460,7 +4458,7 @@
* faces.el (face-id): Return the ID of a realized face for ASCII.
- * fontset.el (x-charset-registries): Removed. Now in faces.el.
+ * fontset.el (x-charset-registries): Remove. Now in faces.el.
(x-complement-fontset-spec): Use face-charset-registries.
* faces.el (face-font-selection-order): Set font selection order
@@ -4488,14 +4486,14 @@
* cus-face.el (custom-face-attributes): Add :bold and :italic
for compatibility with old code.
- * faces.el (set-face-attributes-from-resources): Additional
- frame parameter.
+ * faces.el (set-face-attributes-from-resources):
+ Additional frame parameter.
(make-face-x-resource-internal): Set attributes from resources
for a given frame or all frames.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
- * faces.el (all-faces): Removed.
+ * faces.el (all-faces): Remove.
* custom.el (defface): Add new face attributes to function
comment.
@@ -4514,8 +4512,8 @@
* cus-face.el (custom-face-attributes): Use new face attributes.
- * faces.el (set-face-attribute-from-resource): Initialize
- from resources only for X and W32.
+ * faces.el (set-face-attribute-from-resource):
+ Initialize from resources only for X and W32.
* cus-face.el (custom-declare-face): Don't make frame-local
faces.
@@ -4601,8 +4599,8 @@
* faces.el (eval-when-compile): Add set-face-shadow-thickness.
(internal-facep): Increase vector size.
(make-face): Ditto.
- (face-shadow-thickness): Added.
- (set-face-shadow-thickness): Added.
+ (face-shadow-thickness): Add.
+ (set-face-shadow-thickness): Add.
(modify-face): Add optional shadow-thickness parameter.
(make-face-x-resource-internal): Add shadows.
(copy-face): Ditto.
@@ -4648,8 +4646,8 @@
* fill.el (canonically-space-region, justify-current-line): Add *
to interactive spec.
(fill-region-as-paragraph, fill-paragraph, fill-region)
- (fill-nonuniform-paragraphs, fill-individual-paragraphs): Check
- readonly buffer in interactive spec.
+ (fill-nonuniform-paragraphs, fill-individual-paragraphs):
+ Check readonly buffer in interactive spec.
* paragraphs.el (kill-paragraph, backward-kill-paragraph)
(backward-kill-sentence, kill-sentence): Add * to interactive spec.
@@ -4664,7 +4662,7 @@
1999-07-19 John Wiegley <jwiegley@borland.com>
- * term.el (ansi-term-fg-faces-vector): Added support for ANSI
+ * term.el (ansi-term-fg-faces-vector): Add support for ANSI
color codes 39 and 49, which by the way lynx uses them seem to
mean "foreground reset" and "background reset".
@@ -4729,7 +4727,7 @@
1999-07-08 Espen Skoglund <espensk@stud.cs.uit.no>
- * pascal.el (pascal-calculate-indent): Fixed a bug occurring when
+ * pascal.el (pascal-calculate-indent): Fix a bug occurring when
the `end' keyword was in the very beginning of the buffer.
1999-07-08 Richard Stallman <rms@gnu.org>
@@ -4761,8 +4759,8 @@
* isearch.el (isearch-process-search-char): Write octal 200 correctly.
- * startup.el (normal-top-level-add-subdirs-to-load-path): Avoid
- doing a `stat' when it isn't necessary because that can cause
+ * startup.el (normal-top-level-add-subdirs-to-load-path):
+ Avoid doing a `stat' when it isn't necessary because that can cause
trouble when an NFS server is down.
1999-07-04 Richard Stallman <rms@gnu.org>
@@ -4871,8 +4869,8 @@
1999-06-18 Andrew Innes <andrewi@gnu.org>
- * mail/smtpmail.el (smtpmail-send-it): Use
- convert-standard-filename to make file names for queued mail safe
+ * mail/smtpmail.el (smtpmail-send-it):
+ Use convert-standard-filename to make file names for queued mail safe
on Windows (`:' is invalid in file names on Windows).
1999-06-17 Kenichi Handa <handa@etl.go.jp>
@@ -4913,8 +4911,8 @@
1999-06-15 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
- * mail/rmailsum.el (rmail-summary-output-to-rmail-file): Avoid
- multiple output of the last message.
+ * mail/rmailsum.el (rmail-summary-output-to-rmail-file):
+ Avoid multiple output of the last message.
1999-06-14 Eli Zaretskii <eliz@gnu.org>
@@ -4979,8 +4977,8 @@
1999-06-09 Dave Love <fx@gnu.org>
- * progmodes/compile.el (compilation-error-regexp-alist): Allow
- digits in program name in first pattern.
+ * progmodes/compile.el (compilation-error-regexp-alist):
+ Allow digits in program name in first pattern.
1999-06-09 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -4994,8 +4992,8 @@
1999-06-05 Stephen Eglen <stephen@gnu.org>
- * iswitchb.el (iswitchb-default-keybindings): Add
- iswitchb-minibuffer-setup to minibuffer-setup-hook here rather
+ * iswitchb.el (iswitchb-default-keybindings):
+ Add iswitchb-minibuffer-setup to minibuffer-setup-hook here rather
than when package is loaded.
1999-06-04 Richard M. Stallman <rms@gnu.org>
@@ -5035,7 +5033,7 @@
1999-06-04 Eric M. Ludlam <zappo@ultranet.com>
- * speedbar.el (speedbar-hack-buffer-menu): Fixed so if the user
+ * speedbar.el (speedbar-hack-buffer-menu): Fix so if the user
does not select a buffer from the buffers menu, then the attached
frame is not switched to anything.
@@ -5130,8 +5128,8 @@
1999-05-25 Ken'ichi Handa <handa@gnu.org>
- * mail/smtpmail.el (smtpmail-send-it): Bind
- smtpmail-code-conv-from properly.
+ * mail/smtpmail.el (smtpmail-send-it):
+ Bind smtpmail-code-conv-from properly.
(smtpmail-send-data-1): If DATA is a multibyte string, encode it
by smtpmail-code-conv-from.
@@ -5240,13 +5238,13 @@
1995-05-11 Joel N. Weber II <devnull@melange.gnu.org>
- * comint.el (comint-password-prompt-regexp): Modified to match the
+ * comint.el (comint-password-prompt-regexp): Modify to match the
output of ksu and ssh-add.
1999-05-11 Kenichi HANDA <handa@etl.go.jp>
* language/korea-util.el (isearch-toggle-korean-input-method):
- Adjusted for the change of input method handling in isearch.el.
+ Adjust for the change of input method handling in isearch.el.
(isearch-hangul-switch-symbol-ksc): Likewise.
(isearch-hangul-switch-hanja): Likewise.
@@ -5268,8 +5266,8 @@
1999-05-09 Ken'ichi Handa <handa@gnu.org>
- * ps-print.el (ps-control-character): Call
- ps-mule-prepare-ascii-font to setup ASCII fonts.
+ * ps-print.el (ps-control-character):
+ Call ps-mule-prepare-ascii-font to setup ASCII fonts.
* ps-mule.el (ps-mule-begin-job): Redo this change "if
ps-multibyte-buffer is nil, use
@@ -5280,16 +5278,16 @@
* ispell.el (ispell-local-dictionary-alist): New variable for
customizing local dictionaries not accessible by everyone.
(ispell-dictionary-alist): Loads `ispell-local-dictionary-alist'.
- (ispell-required-version): Changed format `(major minor
+ (ispell-required-version): Change format `(major minor
revision)' to support general pattern matching.
(ispell-tex-skip-alists): AMS Tex block comment and `\author'
skip region commented out due to incorrect skip potential in std latex.
- (ispell-word): Removed `when' macro. Fixed bug of not restoring
+ (ispell-word): Remove `when' macro. Fixed bug of not restoring
cursor point on small words for calls from `ispell-minor-mode'.
(check-ispell-version): Tests and accepts versions major.minor
and above, with adjustments for interactions in 3.1.0-3.1.11.
(ispell-get-line): No longer skips ispell process special characters.
- (ispell-comments-and-strings): Removed `when' macro call.
+ (ispell-comments-and-strings): Remove `when' macro call.
(ispell-minor-check): Requires ispell-word to restore cursor point.
(ispell-buffer-local-parsing): Supports checking comments only.
@@ -5310,7 +5308,7 @@
1999-05-07 Joel N. Weber II <devnull@melange.gnu.org>
- * comint.el (comint-password-prompt-regexp): Modified so that it
+ * comint.el (comint-password-prompt-regexp): Modify so that it
matches the output of kinit.
1999-05-06 Greg Stark <gsstark@mit.edu>
@@ -5452,8 +5450,8 @@
1999-04-26 John Wiegley <johnw@borland.com>
- * progmodes/compile.el (compilation-error-regexp-alist): Recognize
- C++Builder 4.0 error message syntax.
+ * progmodes/compile.el (compilation-error-regexp-alist):
+ Recognize C++Builder 4.0 error message syntax.
1999-04-26 Mark Diekhans <markd@Grizzly.COM>
@@ -5462,8 +5460,8 @@
1999-04-26 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
- * textmodes/texinfmt.el (texinfo-format-buffer): Bind
- coding-system-for-write, to avoid hanging when non-interactive.
+ * textmodes/texinfmt.el (texinfo-format-buffer):
+ Bind coding-system-for-write, to avoid hanging when non-interactive.
1999-04-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
@@ -5668,12 +5666,12 @@
1999-03-25 Andrew Innes <andrewi@gnu.org>
- * w32-fns.el (set-default-process-coding-system): Copied from
+ * w32-fns.el (set-default-process-coding-system): Copy from
dos-w32.el, but modified to use Unix line endings for process
input, and to add a suitable entry to process-coding-system-alist
for DOS shells.
- * dos-fns.el (set-default-process-coding-system): Copied from
+ * dos-fns.el (set-default-process-coding-system): Copy from
dos-w32.el.
* dos-w32.el (set-default-process-coding-system): Move function to
@@ -5714,8 +5712,8 @@
1999-03-18 Simon Marshall <simon@gnu.org>
- * font-lock.el (c-font-lock-keywords-2): Added "complex" type.
- (java-font-lock-keywords-2): Added "strictfp" keyword.
+ * font-lock.el (c-font-lock-keywords-2): Add "complex" type.
+ (java-font-lock-keywords-2): Add "strictfp" keyword.
1999-03-17 Jason Rumney <jasonr@altavista.net>
@@ -5724,8 +5722,8 @@
1999-03-17 Eli Zaretskii <eliz@gnu.org>
- * international/mule-cmds.el (set-language-environment): Fix
- previous change: don't use dos-codepage when unbound.
+ * international/mule-cmds.el (set-language-environment):
+ Fix previous change: don't use dos-codepage when unbound.
1999-03-17 Karl Heuer <kwzh@gnu.org>
@@ -5749,7 +5747,7 @@
1999-03-15 Simon Marshall <simon@gnu.org>
- * font-lock.el (c-font-lock-keywords-2): Added "restrict" keyword.
+ * font-lock.el (c-font-lock-keywords-2): Add "restrict" keyword.
1999-03-14 Milan Zamazal <pdm@pvt.net>
@@ -5779,7 +5777,7 @@
* speedbar.el: Added commentary about stealthy functions.
(speedbar-message): New function.
(speedbar-y-or-n-p): New function.
- (speedbar-with-attached-buffer): Moved macro before reference.
+ (speedbar-with-attached-buffer): Move macro before reference.
Now uses `save-selected-window'.
(speedbar-mouse-hscroll, speedbar-track-mouse, speedbar-refresh)
(speedbar-generic-item-info, speedbar-item-info-file-helper)
@@ -5822,8 +5820,8 @@
1999-03-09 Dave Love <fx@gnu.org>
- * textmodes/sgml-mode.el (html-mode): Use
- sentence-end-double-space when setting sentence-end.
+ * textmodes/sgml-mode.el (html-mode):
+ Use sentence-end-double-space when setting sentence-end.
1999-03-09 Ken'ichi Handa <handa@gnu.org>
@@ -5866,8 +5864,8 @@
1999-03-06 Dave Love <fx@gnu.org>
- * progmodes/cc-cmds.el (c-outline-level): Bind
- buffer-invisibility-spec.
+ * progmodes/cc-cmds.el (c-outline-level):
+ Bind buffer-invisibility-spec.
* progmodes/c-mode.el (c-outline-level): Likewise.
@@ -5907,8 +5905,8 @@
1999-03-03 Dave Love <fx@gnu.org>
* options.el (edit-options): Doc fix.
- (list-options): Don't lose with unbound symbols. Maintain
- Edit-options-mode.
+ (list-options): Don't lose with unbound symbols.
+ Maintain Edit-options-mode.
1999-03-01 Dave Love <fx@gnu.org>
@@ -5920,7 +5918,7 @@
(ispell-dictionary-alist): Don't setq it,
if ispell-dictionary-alist-override is set.
- * simple.el (shell-command-default-error-buffer): Renamed from
+ * simple.el (shell-command-default-error-buffer): Rename from
shell-command-on-region-default-error-buffer.
(shell-command-on-region): Mention in echo area when there
is some error output. Mention success or failure, too.
@@ -5966,8 +5964,8 @@
(ps-font-size, ps-header-font-size, ps-header-title-font-size):
Specifies landscape and portrait sizes.
(ps-setup, ps-print-quote, ps-line-lengths-internal, ps-nb-pages)
- (ps-get-page-dimensions, ps-begin-file, ps-begin-job, ps-generate): Fun
- fix.
+ (ps-get-page-dimensions, ps-begin-file, ps-begin-job, ps-generate):
+ Fun fix.
(ps-get-font-size): New fun.
(ps-font-size-internal, ps-header-font-size-internal)
(ps-header-title-font-size-internal): New vars.
@@ -6011,8 +6009,8 @@
1999-02-23 Ken'ichi Handa <handa@gnu.org>
- * international/encoded-kb.el (encoded-kbd-handle-8bit): Allow
- inputting ?\240.
+ * international/encoded-kb.el (encoded-kbd-handle-8bit):
+ Allow inputting ?\240.
1999-02-23 Karl Heuer <kwzh@gnu.org>
@@ -6029,8 +6027,8 @@
1999-02-22 Eli Zaretskii <eliz@gnu.org>
- * arc-mode.el (archive-set-buffer-as-visiting-file): Save
- excursion while calling set-auto-coding-function.
+ * arc-mode.el (archive-set-buffer-as-visiting-file):
+ Save excursion while calling set-auto-coding-function.
* play/handwrite.el (handwrite): Require ps-print, and use
ps-printer-name and ps-lpr-command. Call ps-print-region-function
@@ -6038,8 +6036,8 @@
1999-02-22 Kenichi Handa <handa@etl.go.jp>
- * international/codepage.el (cp-coding-system-for-codepage-1): Put
- charset-origin-alist property to a coding system for the codepage.
+ * international/codepage.el (cp-coding-system-for-codepage-1):
+ Put charset-origin-alist property to a coding system for the codepage.
* international/mule.el: Modify comment for charset-origin-alist
property of a coding system.
@@ -6055,7 +6053,7 @@
1999-02-21 Peter Breton <pbreton@ne.mediaone.net>
- * dirtrack.el (dirtrack): Added docstring. Now returns input.
+ * dirtrack.el (dirtrack): Add docstring. Now returns input.
1999-02-18 Peter Breton <pbreton@ne.mediaone.net>
@@ -6092,7 +6090,7 @@
(sql-stop): Use sql-input-ring-separator and sql-input-ring-file-name.
(sql-input-ring-file-name): New variable with customization.
(sql-input-ring-separator): New variable with customization.
- (sql-set-sqli-buffer): Renamed from sql-change-sqli-buffer.
+ (sql-set-sqli-buffer): Rename from sql-change-sqli-buffer.
Callers changed.
(sql-show-sqli-buffer): The message for "sql-buffer is not set"
now includes the name of the current buffer.
@@ -6108,7 +6106,7 @@
1999-02-18 Ken'ichi Handa <handa@gnu.org>
- * international/mule.el (coding-system-list): Moved here from
+ * international/mule.el (coding-system-list): Move here from
mule-util.el to avoid autoloading mule-util by the call of
select-safe-coding-system.
@@ -6124,12 +6122,12 @@
1999-02-17 Peter Breton <pbreton@ne.mediaone.net>
- * filecache.el (file-cache-filter-regexps): Added .class.
+ * filecache.el (file-cache-filter-regexps): Add .class.
1999-02-17 Ken'ichi Handa <handa@gnu.org>
- * international/mule-util.el (decompose-region): Use
- insert-buffer-substring instead of insert-buffer to avoid putting
+ * international/mule-util.el (decompose-region):
+ Use insert-buffer-substring instead of insert-buffer to avoid putting
mark.
1999-02-17 Andreas Schwab <schwab@gnu.org>
@@ -6181,8 +6179,8 @@
1999-02-16 Ken'ichi Handa <handa@gnu.org>
- * language/japanese.el (japanese-shift-jis): Add
- charset-origin-alist property.
+ * language/japanese.el (japanese-shift-jis):
+ Add charset-origin-alist property.
1999-02-15 Richard Stallman <rms@gnu.org>
@@ -6211,10 +6209,10 @@
1999-02-14 Richard Stallman <rms@gnu.org>
* international/iso-transl.el:
- (iso-transl-ae): Renamed from iso-transl-e-slash.
- (iso-transl-a-ring): Renamed from iso-transl-a-slash.
- (iso-transl-AE): Renamed from iso-transl-E-slash.
- (iso-transl-A-ring): Renamed from iso-transl-A-slash.
+ (iso-transl-ae): Rename from iso-transl-e-slash.
+ (iso-transl-a-ring): Rename from iso-transl-a-slash.
+ (iso-transl-AE): Rename from iso-transl-E-slash.
+ (iso-transl-A-ring): Rename from iso-transl-A-slash.
(iso-transl-char-map): Related changes.
* format.el (format-replace-strings): Fix value of TO in REVERSE case.
@@ -6231,7 +6229,7 @@
1999-02-12 Alex Schroeder <a.schroeder@bsiag.ch>
* sql.el: Set version to 1.3.2.
- (sql-solid-program): Added support for solid.
+ (sql-solid-program): Add support for solid.
(sql-help): Doc mentions sql-solid.
(sql-solid): Entry function for Solid.
(sql-buffer): Doc explains the use of the variable and how to
@@ -6245,16 +6243,16 @@
(sql-change-sqli-buffer): New function to change sql-buffer.
(sql-mode): Doc explains how to change sql-buffer.
(sql-send-paragraph): New function to send a paragraph.
- (sql-mode-map): Added keybinding for sql-send-paragraph.
+ (sql-mode-map): Add keybinding for sql-send-paragraph.
(sql-mysql): Doc corrected.
(sql-ms): Doc corrected.
* sql.el (sql-server): Doc fix.
- (sql-mysql): Added the use of sql-server to specify the host,
+ (sql-mysql): Add the use of sql-server to specify the host,
sql-database now specifies database instead of host.
(sql-mode-menu): Send... menu items are only active if sql-buffer
is non-nil.
- (sql-help): Changed tag of entry functions a bit.
+ (sql-help): Change tag of entry functions a bit.
* sql.el: Added keywords from `finder-by-keyword'.
(sql-mode): Made sql-buffer a local variable, changed the
@@ -6269,10 +6267,10 @@
sql-user and sql-password used during login.
(sql-sybase): Quoted *SQL* in doc string, added comma.
(sql-oracle): Likewise.
- (sql-interactive-mode): Added extensive documentation for having
+ (sql-interactive-mode): Add extensive documentation for having
multiple SQL buffers sending their stuff to different SQLi
buffers, each running a different process.
- (sql-buffer): Changed doc from *SQL* to SQLi.
+ (sql-buffer): Change doc from *SQL* to SQLi.
(sql-get-login): Doc fix.
1999-02-12 Ken'ichi Handa <handa@gnu.org>
@@ -6303,8 +6301,8 @@
1999-02-12 Ken'ichi Handa <handa@gnu.org>
- * international/quail.el (quail-show-kbd-layout): Bind
- blink-matching-paren to nil.
+ * international/quail.el (quail-show-kbd-layout):
+ Bind blink-matching-paren to nil.
* ps-mule.el (ps-mule-font-info-database-bdf): Fix ENCODING field
for ASCII and Latin-1.
@@ -6315,8 +6313,8 @@
1999-02-12 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (language-info-alist): Remove
- description about charset-origin-alist.
+ * international/mule-cmds.el (language-info-alist):
+ Remove description about charset-origin-alist.
* international/mule.el: Comment added for a new coding system
property `charset-origin-alist'.
@@ -6332,8 +6330,8 @@
("Cyrillic-KOI8"): Remove charset-origin-alist property.
("Cyrillic-ALT"): Likewise.
- * language/vietnamese.el (vietnamese-viqr): Add
- charset-origin-alist property.
+ * language/vietnamese.el (vietnamese-viqr):
+ Add charset-origin-alist property.
("Vietnamese"): Remove charset-origin-alist property.
* simple.el (what-cursor-position): Don't use the variable
@@ -6373,8 +6371,8 @@
1999-02-08 Eli Zaretskii <eliz@gnu.org>
- * international/codepage.el (cp-coding-system-for-codepage-1): On
- MS-DOS, use dos-unsupported-char-glyph for characters not
+ * international/codepage.el (cp-coding-system-for-codepage-1):
+ On MS-DOS, use dos-unsupported-char-glyph for characters not
supported by the codepage.
(cp-make-coding-systems-for-codepage): Likewise.
@@ -6383,11 +6381,11 @@
* international/mule-util.el (coding-system-list): Don't sort
coding-system-list here.
- * international/mule.el (coding-system-lessp): Moved here from
+ * international/mule.el (coding-system-lessp): Move here from
mule-util.el.
(add-to-coding-system-list): New function.
- (make-subsidiary-coding-system, make-coding-system,
- define-coding-system-alias): Use it instead of setting
+ (make-subsidiary-coding-system, make-coding-system)
+ (define-coding-system-alias): Use it instead of setting
coding-system-list directly.
1999-02-07 Dave Love <fx@gnu.org>
@@ -6429,18 +6427,18 @@
1999-02-05 Alex Schroeder <asc@bsiag.com>
* progmodes/sql.el: Changed version to 1.2.1.
- (sql-pop-to-buffer-after-send-region): Improved documentation.
- (sql-mysql-program): Added MySQL support.
+ (sql-pop-to-buffer-after-send-region): Improve documentation.
+ (sql-mysql-program): Add MySQL support.
(sql-prompt-length): Made prompt-length configurable.
(sql-mode-syntax-table): Made apostrophe (') be a string delimiter.
- (sql-help): Added MySQL support, changed documentation.
+ (sql-help): Add MySQL support, changed documentation.
(sql-send-region): A message is displayed if something is sent.
- (sql-mode): Added buffer-local comment-start.
+ (sql-mode): Add buffer-local comment-start.
(sql-interactive-mode): Use sql-prompt-length to set left-margin.
- (sql-interactive-mode): Added buffer-local comment-start.
+ (sql-interactive-mode): Add buffer-local comment-start.
(sql-oracle): Set sql-prompt-length.
(sql-sybase): Set sql-prompt-length.
- (sql-mysql): Added MySQL support.
+ (sql-mysql): Add MySQL support.
(sql-ingres): Set sql-prompt-length.
(sql-ms): Set sql-prompt-length.
(sql-postgres): Set sql-prompt-length.
@@ -6497,8 +6495,8 @@
1999-02-01 Ken'ichi Handa <handa@gnu.org>
- * international/mule-util.el (compose-chars-component): Add
- autoload cookie.
+ * international/mule-util.el (compose-chars-component):
+ Add autoload cookie.
1999-01-31 Ken'ichi Handa <handa@gnu.org>
@@ -6508,8 +6506,8 @@
1999-01-31 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
- * progmodes/compile.el (compilation-next-error-locus): Don't
- decrease argument FIND-AT-LEAST of compilation-next-error-locus.
+ * progmodes/compile.el (compilation-next-error-locus):
+ Don't decrease argument FIND-AT-LEAST of compilation-next-error-locus.
1999-01-31 Eli Zaretskii <eliz@gnu.org>
@@ -6540,8 +6538,8 @@
* tex-mode.el (tex-mode-map): Replace validate-tex-buffer by
tex-validate-buffer.
(plain-tex-mode, latex-mode, slitex-mode): Likewise.
- (tex-validate-buffer): Renamed from validate-tex-buffer. Works
- now with recent occur-mode.
+ (tex-validate-buffer): Rename from validate-tex-buffer.
+ Works now with recent occur-mode.
(tex-validate-region): Really walk through all Sexps.
(tex-region): Bind shell-dirtrack-verbose.
(tex-file, tex-bibtex-file): Likewise.
@@ -6641,8 +6639,8 @@
1999-01-25 Edward M. Reingold <reingold@emr.cs.uiuc.edu>
- * calendar/diary-lib.el (mark-diary-entries): Use
- assoc-ignore-case and do not capitalize when matching month and
+ * calendar/diary-lib.el (mark-diary-entries):
+ Use assoc-ignore-case and do not capitalize when matching month and
day names.
* calendar/calendar.el (calendar-read-date): Ditto.
@@ -6725,9 +6723,9 @@
(speedbar-buffers-line-path): Return is dir name only.
(speedbar-mode-functions-list): New variable.
(speedbar-mouse-item-info): Rewrote to be a replaceable fn.
- (speedbar-item-info-file-helper, speedbar-item-info-tag-helper
- speedbar-files-item-info speedbar-buffers-item-info): New functions.
- (speedbar-fetch-replacement-function,speedbar-add-mode-functions-list):
+ (speedbar-item-info-file-helper, speedbar-item-info-tag-helpe)
+ (speedbar-files-item-info speedbar-buffers-item-info): New functions.
+ (speedbar-fetch-replacement-function, speedbar-add-mode-functions-list):
New functions.
(speedbar-line-file): Broke out part that fetches file from a line.
(speedbar-line-text): New function extracted from speedbar-line-file.
@@ -6736,8 +6734,8 @@
1999-01-23 Ken'ichi Handa <handa@gnu.org>
- * international/fontset.el (create-fontset-from-x-resource): Make
- style variants.
+ * international/fontset.el (create-fontset-from-x-resource):
+ Make style variants.
1999-01-22 Dave Love <fx@gnu.org>
@@ -6750,7 +6748,7 @@
1999-01-22 Jason Rumney <jasonr@altavista.net>
- * term/w32-win.el (w32-standard-fontset-spec): Simplified.
+ * term/w32-win.el (w32-standard-fontset-spec): Simplify.
1999-01-22 Felix Lee <flee@cygnus.com>
@@ -6784,8 +6782,8 @@
1999-01-19 Jason Rumney <jasonr@altavista.net>
- * term/w32-win.el (w32-standard-fontspec-spec): Change
- iso8859-5 to koi8-r. Add iso8859-9.
+ * term/w32-win.el (w32-standard-fontspec-spec):
+ Change iso8859-5 to koi8-r. Add iso8859-9.
1999-01-19 Dave Love <fx@gnu.org>
@@ -6809,8 +6807,8 @@
* textmodes/tex-mode.el (tex-define-common-keys):
Remove key binding of tex-feed-input.
(tex-mode-map): Bind tex-feed-input here.
- (tex-start-shell): Use compilation-shell-minor-mode. Set
- comint-input-filter-functions before running tex-shell-hook.
+ (tex-start-shell): Use compilation-shell-minor-mode.
+ Set comint-input-filter-functions before running tex-shell-hook.
(tex-start-tex): Forget compilation errors.
(tex-compilation-parse-errors): Rewritten to work also with
compile-mouse-goto-error and compile-goto-error. Adjusted to
@@ -6829,8 +6827,8 @@
1999-01-18 Ken'ichi Handa <handa@gnu.org>
- * international/ccl.el (ccl-compile-translate-character): Handle
- the case that a translation table is CCL register correctly.
+ * international/ccl.el (ccl-compile-translate-character):
+ Handle the case that a translation table is CCL register correctly.
* international/mule-cmds.el (select-safe-coding-system):
Highlight at most 256 characters.
@@ -6871,7 +6869,7 @@
1999-01-17 Ian T Zimmerman <itz@transbay.net>
Patch failed to install:
- * gametree.el: Document scoring functionality.
+ * play/gametree.el: Document scoring functionality.
(gametree-score-regexp): Add optional plus sign.
(gametree-score-opener): Replace `:' with `=' as the former
conflicts with gametree-half-ply-regexp.
@@ -6895,8 +6893,8 @@
1999-01-17 Andrew Innes <andrewi@gnu.org>
- * dos-w32.el (find-buffer-file-type-coding-system): Use
- default-buffer-file-coding-system when file doesn't exist (and
+ * dos-w32.el (find-buffer-file-type-coding-system):
+ Use default-buffer-file-coding-system when file doesn't exist (and
isn't covered by a special case) instead of forcing undecided-dos
against the user's wishes.
@@ -6918,8 +6916,8 @@
* lpr.el (printer-name): Update docstring about usage on MS-DOS
and MS-Windows.
(lpr-command) [ms-dos, windows-nt]: Initialize to empty string on
- DOS and Windows platforms, to indicate direct printing. Update
- the docstring accordingly.
+ DOS and Windows platforms, to indicate direct printing.
+ Update the docstring accordingly.
* ps-print.el (ps-printer-name): Update docstring about usage on
MS-DOS and MS-Windows.
@@ -6949,13 +6947,13 @@
(ps-mule-generate-font): If FONT-NAME is a cons cell, use its car.
(ps-mule-prepare-font): Likewise.
- * international/codepage.el (cp855-decode-table,
- cp850-decode-table): Fill some nil entries.
+ * international/codepage.el (cp855-decode-table)
+ (cp850-decode-table): Fill some nil entries.
1999-01-16 Dave Love <fx@gnu.org>
- * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): Revert
- last change.
+ * help.el (temp-buffer-setup-hook, temp-buffer-show-hook):
+ Revert last change.
1999-01-15 Dave Love <fx@gnu.org>
@@ -7004,8 +7002,8 @@
1999-01-13 Eli Zaretskii <eliz@gnu.org>
* international/codepage.el (cp850-decode-table): Replace nil
- entries with codes of similary looking glyphs. (Suggested by
- Jason Rumney <jasonr@altavista.net>.)
+ entries with codes of similary looking glyphs. (
+ Suggested by Jason Rumney <jasonr@altavista.net>.)
1999-01-13 Dave Love <fx@gnu.org>
@@ -7028,12 +7026,12 @@
* cus-start.el: Add inhibit-eol-conversion.
- * help.el (temp-buffer-setup-hook, temp-buffer-show-hook): Swap
- the values round.
+ * help.el (temp-buffer-setup-hook, temp-buffer-show-hook):
+ Swap the values round.
1999-01-11 Richard Stallman <rms@psilocin.ai.mit.edu>
- * help.el (help-mode-finish): Renamed from help-mode-maybe.
+ * help.el (help-mode-finish): Rename from help-mode-maybe.
Don't switch to Help mode here.
(temp-buffer-setup-hook): Use help-mode-finish.
(help-mode-setup): New function.
@@ -7147,16 +7145,16 @@
1999-01-06 Eli Zaretskii <eliz@gnu.org>
- * international/codepage.el (cp-coding-system-for-codepage-1): Add
- the valid-codes property.
+ * international/codepage.el (cp-coding-system-for-codepage-1):
+ Add the valid-codes property.
- * international/mule-cmds.el (prefer-coding-system): Call
- set-coding-priority, so that the internal array of priorities is
+ * international/mule-cmds.el (prefer-coding-system):
+ Call set-coding-priority, so that the internal array of priorities is
also updated.
- * international/mule-util.el:
- (coding-system-change-eol-conversion,
- coding-system-change-text-conversion): Don't define here.
+ * international/mule-util.el
+ (coding-system-change-eol-conversion)
+ (coding-system-change-text-conversion): Don't define here.
* international/mule-cmds.el: Define them here. Remove the
autoload cookies.
@@ -7166,8 +7164,8 @@
* emacs-lisp/debug.el (debug): Leave recursive minibuffer enabled
if it was enabled before.
- * view.el (View-revert-buffer-scroll-page-forward): Bind
- view-scroll-auto-exit instead of obsolete view-mode-auto-exit.
+ * view.el (View-revert-buffer-scroll-page-forward):
+ Bind view-scroll-auto-exit instead of obsolete view-mode-auto-exit.
* files.el (recover-session): Preserve point when inserting
explanation.
@@ -7393,7 +7391,7 @@
1998-12-25 Ilya Zakharevich <ilya@math.ohio-state.edu>
- * cperl-mode.el:
+ * progmodes/cperl-mode.el:
Can use linear algorithm for indentation if Emacs supports it.
(cperl-after-expr-p): It is BLOCK if we reach lim when backup sexp.
(cperl-after-block-p): Likewise.
@@ -7440,9 +7438,9 @@
(cperl-syntaxify-by-font-lock): Set to t, should be safe now.
Better default, customizes to `message' too, off in text-mode.
- (cperl-array-face): Renamed from `font-lock-emphasized-face',
+ (cperl-array-face): Rename from `font-lock-emphasized-face',
`defface'd.
- (cperl-hash-face): Renamed from `font-lock-other-emphasized-face'.
+ (cperl-hash-face): Rename from `font-lock-other-emphasized-face'.
`defface'd.
(cperl-emacs-can-parse): New state variable.
(cperl-indent-line): Corrected to use global state.
@@ -7490,7 +7488,7 @@
inside of POD too.
(cperl-backward-to-noncomment): Better treatment of PODs and HEREs.
(cperl-clobber-mode-lists): New configuration variable.
- (cperl-not-bad-style-regexp): Updated.
+ (cperl-not-bad-style-regexp): Update.
Init: `cperl-is-face' was busted.
(cperl-make-face): New macros.
(cperl-force-face): New macros.
@@ -7505,7 +7503,7 @@
(cperl-tags-hier-init): Gross hack to pretend we work (are we?).
Another try to work around XEmacs problems. Better progress messages.
(toplevel): Require custom unprotected => failure on 19.28.
- (cperl-xemacs-p): Defined when compile too.
+ (cperl-xemacs-p): Define when compile too.
(cperl-find-tags): Was writing line/pos in a wrong order,
pos off by 1 and not at beg-of-line.
(cperl-etags-snarf-tag): New macro.
@@ -7601,8 +7599,8 @@
(speedbar-this-file-in-vc) Fix SCCS to use s. not p. files.
(speedbar-tag-group-name-minimum-length): New variable.
(speedbar-frame-parameter): New compatibility function.
- (speedbar-frame-mode): Updated to use speedbar-frame-parameter.
- (speedbar-apply-one-tag-hierarchy-method): Fixed up taging sub
+ (speedbar-frame-mode): Update to use speedbar-frame-parameter.
+ (speedbar-apply-one-tag-hierarchy-method): Fix up taging sub
groups to keep things in the right order, and to help with some
naming conventions.
(speedbar-create-tag-hierarchy): Enable buffer local version of
@@ -7728,8 +7726,8 @@
(ps-mule-plot-string): Set ps-mule-current-charset.
(ps-mule-initialize): Add autoload cookie. Don't set
ps-mule-font-info-database here.
- (ps-mule-begin-job): Renamed from ps-mule-begin. Update
- ps-mule-font-info-database and ps-control-or-escape-regexp.
+ (ps-mule-begin-job): Rename from ps-mule-begin.
+ Update ps-mule-font-info-database and ps-control-or-escape-regexp.
(ps-mule-begin-page): New fun.
* ps-print.el: Mule related code moved to ps-mule.el.
@@ -7751,7 +7749,7 @@
* ps-print.el (ps-mule-font-info-database): Doc-string modified.
(ps-mule-external-libraries): New element FEATURE.
- (ps-mule-init-external-library): Adjusted for the above change.
+ (ps-mule-init-external-library): Adjust for the above change.
(ps-mule-generate-font): Likewise.
(ps-mule-generate-glyphs): Likewise.
(ps-mule-prepare-font): Likewise.
@@ -7768,7 +7766,7 @@
Handle the case of unknown charset.
(find-multibyte-characters): If invalid multibyte characters are
found, return the corresponding strings instead of character codes.
- (find-multibyte-characters): Adjusted for the above change.
+ (find-multibyte-characters): Adjust for the above change.
(select-safe-coding-system): For a unibyte buffer, always returns
DEFAULT-CODING-SYSTEM.
(get-charset-property): Fix previous change. Make it a function.
@@ -7788,8 +7786,8 @@
1998-12-14 Andreas Schwab <schwab@delysid.gnu.org>
- * textmodes/texinfo.el (texinfo-tex-buffer): Bind
- tex-start-options-string to empty string.
+ * textmodes/texinfo.el (texinfo-tex-buffer):
+ Bind tex-start-options-string to empty string.
(texinfo-tex-region): Use texinfo-tex-trailer as documented.
1998-12-14 Andrew Innes <andrewi@delysid.gnu.org>
@@ -7841,7 +7839,7 @@
* help.el (symbol-file-load-history-loaded): Variable renamed,
and defvar moved from loadhist.el.
- (symbol-file): Renamed from describe-function-find-file.
+ (symbol-file): Rename from describe-function-find-file.
Load fns-VERSION.el here.
(describe-variable, describe-function-1): Use symbol-file.
@@ -7968,9 +7966,9 @@
1998-12-02 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc.el (vc-dired-window-configuration, vc-ediff-windows,
- vc-ediff-result, vc-dired-switches, vc-dired-terse-mode):
- Added defvars to suppress compilation warnings.
+ * vc.el (vc-dired-window-configuration, vc-ediff-windows)
+ (vc-ediff-result, vc-dired-switches, vc-dired-terse-mode):
+ Add defvars to suppress compilation warnings.
1998-11-30 Ken Stevens <k.stevens@ieee.org>
@@ -7986,13 +7984,13 @@
ispell-message-text-end, ispell-add-per-file-word-list.
(ispell-dictionary-alist-1, ispell-dictionary-alist2): A coding
system is now required for all languages. Casechars improved for
- castellano, castellano8, and norsk dictionaries. Dictionary
- norsk7-tex added. Dictionary polish added.
+ castellano, castellano8, and norsk dictionaries.
+ Dictionary norsk7-tex added. Dictionary polish added.
(ispell-dictionary-alist): Redefined at load-time to support
dictionary changes.
(ispell-menu-map): Redefined at load-time to support menu changes.
(ispell-check-version): New alias for `check-ispell-version'.
- (ispell-parse-output): Fixed matching for ispell error messages.
+ (ispell-parse-output): Fix matching for ispell error messages.
Correctly returns spelling suggestions in order generated by ispell
process.
(check-ispell-version): Ensure `case-fold-search' doesn't get
@@ -8004,12 +8002,12 @@
(ispell-kill-ispell): Ensures ispell process has terminated before
starting new process. This can otherwise confuse process filters
and hang the ispell process.
- (ispell-begin-skip-region-regexp, ispell-skip-region): Improved
- skipping support for sgml.
+ (ispell-begin-skip-region-regexp, ispell-skip-region):
+ Improve skipping support for sgml.
(ispell-minor-check): Support sgml labels. Fix mapping ^M to \r
which could cause `ispell-complete-word' to hang.
- (ispell-message): Improved message reference matching. Ensure
- `case-fold-search' doesn't get redefined.
+ (ispell-message): Improve message reference matching.
+ Ensure `case-fold-search' doesn't get redefined.
(ispell-buffer-local-parsing): Ensure `case-fold-search' doesn't
get redefined. Fixed bug in returning to nroff mode from tex mode.
(ispell-add-per-file-word-list): Ensure `case-fold-search' doesn't
@@ -8110,8 +8108,8 @@
1998-11-22 Andrew Innes <andrewi@delysid.gnu.org>
- * mail/rmail.el (rmail-set-message-counters-counter): Detect
- messages that have been added with DOS line endings and convert
+ * mail/rmail.el (rmail-set-message-counters-counter):
+ Detect messages that have been added with DOS line endings and convert
the line endings for such messages.
1998-11-22 Emilio Lopes <Emilio.Lopes@Physik.TU-Muenchen.DE>
@@ -8133,8 +8131,8 @@
1998-11-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * message.el (message-ignored-supersedes-headers): Remove
- NNTP-Posting-Date.
+ * message.el (message-ignored-supersedes-headers):
+ Remove NNTP-Posting-Date.
1998-11-21 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -8245,8 +8243,8 @@
(tar-extract): Avoid multibyte<->unibyte conversion in
insert-buffer-substring by setting both buffers unibyte
temporarily.
- (tar-copy): Set the buffer unibyte while doing a work. Write
- without code conversion.
+ (tar-copy): Set the buffer unibyte while doing a work.
+ Write without code conversion.
(tar-expunge): Set the buffer unibyte while doing a work.
(tar-alter-one-field): Likewise.
(tar-clear-modification-flags): Compare byte position with
@@ -8264,7 +8262,7 @@
1998-11-15 Dave Love <fx@gnu.org>
* progmodes/fortran.el: Fix previous change:
- (fortran-end-prog-re1): Changed.
+ (fortran-end-prog-re1): Change.
(fortran-check-end-prog-re): New function.
(beginning-of-fortran-subprogram, end-of-fortran-subprogram): Use it.
@@ -8277,21 +8275,21 @@
* textmodes/reftex.el (reftex-finding-files): Group documentation fixed.
(reftex-toc-toggle-file-boundary, reftex-toc-toggle-labels)
- (reftex-toc-toggle-context,reftex-find-start-point): New functions.
+ (reftex-toc-toggle-context, reftex-find-start-point): New functions.
(reftex-toc-include-labels, reftex-toc-include-context)
(reftex-toc-include-file-boundaries, reftex-toc-keep-other-windows):
New options.
(reftex-use-text-after-label-as-context): Option removed.
(reftex-extract-bib-entries): Protect use in non-latex buffers.
- (reftex-toc-visit-location): Renamed from `reftex-toc-visit-line'.
+ (reftex-toc-visit-location): Rename from `reftex-toc-visit-line'.
(reftex-latin1-to-ascii): Works now with and without Mule.
- (reftex-truncate): Removed special stuff for Emacs 20.2.
+ (reftex-truncate): Remove special stuff for Emacs 20.2.
(reftex-get-offset): Made more general.
- (reftex-show-label-location): Renamed from
+ (reftex-show-label-location): Rename from
`reftex-select-label-callback'.
(reftex-pop-to-label): Function removed (using
`reftex-show-label-location' instead.
- (reftex-insert-docstruct): Renamed from
+ (reftex-insert-docstruct): Rename from
`reftex-make-and-insert-label-list'. Function args changed.
(reftex-toc): Now uses `reftex-insert-docstruct' and
`reftex-find-start-point'.
@@ -8329,7 +8327,7 @@
1998-11-11 Per Starbäck <starback@update.uu.se>
- * ispell.el (ispell-dictionary-alist-2): Removed svenska, renamed
+ * ispell.el (ispell-dictionary-alist-2): Remove svenska, renamed
svenska8 to svenska, and fixed and extended CASECHARS for it.
1998-11-11 Andrew Innes <andrewi@delysid.gnu.org>
@@ -8340,8 +8338,8 @@
1998-11-11 Kenichi Handa <handa@etl.go.jp>
- * international/mule-util.el (compose-chars-component): Signal
- error if CH is a rule-based composition character.
+ * international/mule-util.el (compose-chars-component):
+ Signal error if CH is a rule-based composition character.
(compose-chars): Signal error if an already composed character is
going to be composed by rule-base.
@@ -8467,8 +8465,8 @@
1998-11-04 Kenichi Handa <handa@etl.go.jp>
- * international/quail.el (quail-show-guidance-buf): Call
- set-minibuffer-window to set minibuffer window of the current
+ * international/quail.el (quail-show-guidance-buf):
+ Call set-minibuffer-window to set minibuffer window of the current
frame correctly.
1998-11-03 Theodore Jump <tjump@tertius.com>
@@ -8529,13 +8527,13 @@
1998-10-30 Kenichi Handa <handa@etl.go.jp>
- * international/quail.el (quail-start-translation): Handle
- switching of the frame in read-key-sequence.
+ * international/quail.el (quail-start-translation):
+ Handle switching of the frame in read-key-sequence.
(quail-start-conversion): Likewise.
(quail-show-guidance-buf): Detach quail-guidance-buf from any
windows before setting an appropriate window for it.
- (quail-hide-guidance-buf): Use window-minibuffer-p. Set
- quail-guidance-win to nil.
+ (quail-hide-guidance-buf): Use window-minibuffer-p.
+ Set quail-guidance-win to nil.
(quail-update-guidance): If quail-guidance-buf is not in the
selected frame, call quail-show-guidance-buf again.
@@ -8567,23 +8565,23 @@
* emacs-lisp/eldoc.el (eldoc-argument-case): Fix customize type.
- * emacs-lisp/lisp-mnt.el (lm-report-bug): Use
- report-emacs-bug-address instead of undefined bug-gnu-emacs.
+ * emacs-lisp/lisp-mnt.el (lm-report-bug):
+ Use report-emacs-bug-address instead of undefined bug-gnu-emacs.
- * international/mule-cmds.el (select-message-coding-system): Doc
- fix.
+ * international/mule-cmds.el (select-message-coding-system):
+ Doc fix.
- * international/mule-diag.el (describe-coding-system): Describe
- all flags.
+ * international/mule-diag.el (describe-coding-system):
+ Describe all flags.
- * mail/sendmail.el (sendmail-coding-system,
- default-sendmail-coding-system): Doc fix.
+ * mail/sendmail.el (sendmail-coding-system)
+ (default-sendmail-coding-system): Doc fix.
* simple.el (shell-command-on-region): Doc fix.
* loadup.el: Write fns-*.el in current directory instead of
- data-directory since no installation directory exists yet. Mark
- buffer unmodified afterwards.
+ data-directory since no installation directory exists yet.
+ Mark buffer unmodified afterwards.
* loadhist.el (symbol-file): Load fns-*.el from exec-directory
instead of data-directory since it is architecture dependent.
@@ -8599,11 +8597,11 @@
1998-10-27 Richard Stallman <rms@psilocin.ai.mit.edu>
- * progmodes/tcl-mode.el (tcl-font-lock-keywords): Added itcl and
+ * progmodes/tcl-mode.el (tcl-font-lock-keywords): Add itcl and
namespace related keywords such as `class', `body', `private',
`variable', `namespace eval', etc.
(tcl-imenu-generic-expression): Handle itcl body and class definitions.
- (tcl-mode): Added ":" as a word constituent to the syntax-alist of
+ (tcl-mode): Add ":" as a word constituent to the syntax-alist of
imenu and font-lock so that searches for \sw would find words
containing colons.
@@ -8732,9 +8730,9 @@
(profile-functions): Simplify.
(profile-print): Use float. Make output include space separators.
(profile-add-time): New helper function.
- (profile-function-prolog): Renamed from profile-start-function.
+ (profile-function-prolog): Rename from profile-start-function.
Handle profile-distinct.
- (profile-function-epilog): Renamed from profile-update-function.
+ (profile-function-epilog): Rename from profile-update-function.
Handle profile-distinct.
(profile-a-function): If the function to be profiled is an
autoload form, load it. If it's lazy-loaded, fetch it.
@@ -8884,8 +8882,8 @@
1998-10-14 Emilio Lopes <Emilio.Lopes@Physik.TU-Muenchen.DE>
- * progmodes/fortran.el (fortran-join-line): Use
- `delete-indentation' instead of issuing an error message if not on
+ * progmodes/fortran.el (fortran-join-line):
+ Use `delete-indentation' instead of issuing an error message if not on
a continuation line. Provide for joining several lines using
prefix arg.
@@ -8918,7 +8916,7 @@
1998-10-13 Geoff Voelker <voelker@cs.washington.edu>
* ls-lisp.el (ls-lisp-use-insert-directory-program): New variable.
- (ls-lisp-insert-directory): Renamed from insert-directory.
+ (ls-lisp-insert-directory): Rename from insert-directory.
(insert-directory): New function.
1998-10-13 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -9051,7 +9049,7 @@
1998-10-06 Peter Breton <pbreton@ne.mediaone.net>
- * generic.el (generic-mode-with-type): Added hooks for generic-modes.
+ * generic.el (generic-mode-with-type): Add hooks for generic-modes.
* net-utils.el (ftp, nslookup): Require comint.
(network-service-connection): Likewise.
@@ -9061,7 +9059,7 @@
(whois-get-tld): New function.
* dirtrack.el: Mentioned dirtrack-debug-toggle in the docs.
- (dirtrack-debug-toggle): Added this function.
+ (dirtrack-debug-toggle): Add this function.
1998-10-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -9076,9 +9074,9 @@
* arc-mode.el (archive-mode-revert): Arg no-auto-save renamed from
no-autosave.
* tar-mode.el (tar-mode-revert): Likewise.
- * ediff-util.el (ediff-arrange-auto-save-in-merge-jobs): Renamed
- from ediff-arrange-autosave-in-merge-jobs. Callers changed.
- * gnus/message.el (message-auto-save-directory): Renamed from
+ * ediff-util.el (ediff-arrange-auto-save-in-merge-jobs):
+ Rename from ediff-arrange-autosave-in-merge-jobs. Callers changed.
+ * gnus/message.el (message-auto-save-directory): Rename from
message-autosave-directory. All references changed.
1998-10-06 Jonathan I. Kamens <jik@kamens.brookline.ma.us>
@@ -9093,15 +9091,15 @@
* replace.el (perform-replace): Position point properly
before and after the recursive edit of C-r.
- * progmodes/etags.el (tags-reset-tags-tables): Properly
- find the markers in the old rings that are being discarded.
+ * progmodes/etags.el (tags-reset-tags-tables):
+ Properly find the markers in the old rings that are being discarded.
1998-10-06 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
* apropos.el (apropos-print): Control invalid characters.
* play/landmark.el (lm-font-lock-face-O, lm-font-lock-face-X):
- Renamed from lm-font-lock-O-face, lm-font-lock-X-face to avoid
+ Rename from lm-font-lock-O-face, lm-font-lock-X-face to avoid
confusing customize.
1998-10-06 Eli Zaretskii <eliz@mescaline.gnu.org>
@@ -9111,12 +9109,12 @@
1998-10-05 Simon Marshall <simon@gnu.org>
- * menu-bar.el (menu-bar-tools-menu): Added entry for Speedbar.
+ * menu-bar.el (menu-bar-tools-menu): Add entry for Speedbar.
1998-10-04 Eric Ludlam <zappo@gnu.org>
- * speedbar.el (speedbar-initial-expansion-list-name): Remove
- customization since it is not useful in this case.
+ * speedbar.el (speedbar-initial-expansion-list-name):
+ Remove customization since it is not useful in this case.
(speedbar-frame-mode): Check if cfx or cfy is a list, and make
sure it gets evalled to a number. Also verify that set-frame-name
fn exists before calling it.
@@ -9135,8 +9133,8 @@
1998-10-02 Dave Love <fx@gnu.org>
- * outline.el (hide-region-body): Bind
- outline-view-change-hook to nil while making repeated calls to
+ * outline.el (hide-region-body):
+ Bind outline-view-change-hook to nil while making repeated calls to
outline-flag-region. Run it once at the end.
(hide-other, hide-sublevels, show-children): Likewise.
@@ -9224,8 +9222,9 @@
1998-09-27 Kurt Hornik <Kurt.Hornik@ci.tuwien.ac.at>
- * octave-inf.el (inferior-octave-prompt): Also match prompts of the
- form `octave.bin:1>' which come from using precompiled binary versions.
+ * progmodes/octave-inf.el (inferior-octave-prompt):
+ Also match prompts of the form `octave.bin:1>',
+ which come from using precompiled binary versions.
1998-09-27 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -9241,8 +9240,8 @@
* textmodes/texinfo.el (texinfo-show-structure):
Bind inhibit-read-only.
- * isearch.el (isearch-search-and-update): Properly
- handle upper case letters in the reverse-search special case.
+ * isearch.el (isearch-search-and-update):
+ Properly handle upper case letters in the reverse-search special case.
1998-09-25 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
@@ -9330,14 +9329,14 @@
whenever appt-mode-string has changed.
(appt-add, appt-delete): Add autoload cookies.
(appt-check): Catch errors from calling `diary'.
- (appt-max-time): Renamed from max-time.
+ (appt-max-time): Rename from max-time.
(appt-now-displayed, appt-display-count): New variables.
(appt-timer): Don't create one if we already have one.
* textmodes/tex-mode.el (tex-compilation-parse-errors):
More general code to use the source buffer instead of the zap file.
- * hilit-chg.el (highlight-compare-with-file): Renamed from
+ * hilit-chg.el (highlight-compare-with-file): Rename from
compare-with-file.
* loadhist.el (load-history-loaded): New variable.
@@ -9369,9 +9368,9 @@
* emacs-lisp/eldoc.el (eldoc-message): Check for 1-arg case, and
store string in eldoc-last-message without consing a new string.
Rearrange logic from nested if's into cond's.
- (eldoc-print-fnsym-args): Renamed to eldoc-get-fnsym-args-string.
+ (eldoc-print-fnsym-args): Rename to eldoc-get-fnsym-args-string.
Do not print message; just return string.
- (eldoc-get-var-docstring): Renamed from eldoc-print-var-docstring.
+ (eldoc-get-var-docstring): Rename from eldoc-print-var-docstring.
Do not print message; just return string.
Cache that string in eldoc-last-data.
(eldoc-last-data): Make into a vector.
@@ -9382,8 +9381,8 @@
(eldoc-get-var-docstring): Here also.
(eldoc-docstring-first-line): Minimize interim string consing.
Call substitute-command-keys on the result.
- (eldoc-print-var-docstrings, eldoc-print-docstring,
- eldoc-docstring-message): Functions removed.
+ (eldoc-print-var-docstrings, eldoc-print-docstring)
+ (eldoc-docstring-message): Functions removed.
(eldoc-docstring-format-sym-doc): New function, functionality
ripped out of eldoc-docstring-message.
(eldoc-get-fnsym-args-string, eldoc-get-var-docstring): Use it.
@@ -9396,48 +9395,48 @@
* progmodes/vhdl-mode.el (vhdl-header-file): Fix customize type.
- * progmodes/cpp.el (cpp-face-light-list, cpp-face-dark-list): Fix
- customize type.
+ * progmodes/cpp.el (cpp-face-light-list, cpp-face-dark-list):
+ Fix customize type.
* progmodes/cperl-mode.el (cperl-lazy-help-time): Fix customize
type.
- * progmodes/compile.el (compilation-error-screen-columns): New
- variable.
+ * progmodes/compile.el (compilation-error-screen-columns):
+ New variable.
(compilation-next-error-locus): Use it to decide whether to use
forward-char or move-to-column.
* mail/rmail.el (rmail-movemail-program): Fix customize type.
- * mail/feedmail.el (feedmail-x-mailer-line-user-appendage,
- feedmail-fiddle-plex-user-list,
- feedmail-spray-address-fiddle-plex-list,
- feedmail-prompt-before-queue-user-alist,
- feedmail-prompt-before-queue-help-supplement,
- feedmail-queue-reminder-alist, feedmail-queue-default-file-slug,
- feedmail-queue-alternative-mail-header-separator): Fix customize
+ * mail/feedmail.el (feedmail-x-mailer-line-user-appendage)
+ (feedmail-fiddle-plex-user-list)
+ (feedmail-spray-address-fiddle-plex-list)
+ (feedmail-prompt-before-queue-user-alist)
+ (feedmail-prompt-before-queue-help-supplement)
+ (feedmail-queue-reminder-alist, feedmail-queue-default-file-slug)
+ (feedmail-queue-alternative-mail-header-separator): Fix customize
type.
* startup.el (site-run-file): Fix customize type.
- * speedbar.el (speedbar-initial-expansion-list-name): Fix
- customize type.
+ * speedbar.el (speedbar-initial-expansion-list-name):
+ Fix customize type.
* shell.el (shell-input-autoexpand): Fix customize type.
* ps-print.el (ps-font-info-database): Add missing dots in value.
Improve layout of customize type.
- * net-utils.el (traceroute-program-options, ping-program-options,
- ipconfig-program-options, netstat-program-options,
- arp-program-options, route-program-options,
- nslookup-program-options, ftp-program-options): Fix customize
+ * net-utils.el (traceroute-program-options, ping-program-options)
+ (ipconfig-program-options, netstat-program-options)
+ (arp-program-options, route-program-options)
+ (nslookup-program-options, ftp-program-options): Fix customize
type.
- * midnight.el (clean-buffer-list-kill-regexps,
- clean-buffer-list-kill-buffer-names,
- clean-buffer-list-kill-never-buffer-names,
- clean-buffer-list-kill-never-regexps): Fix customize type.
+ * midnight.el (clean-buffer-list-kill-regexps)
+ (clean-buffer-list-kill-buffer-names)
+ (clean-buffer-list-kill-never-buffer-names)
+ (clean-buffer-list-kill-never-regexps): Fix customize type.
* man.el (Man-init-defvars): Avoid trailing nil on
Man-filter-list.
@@ -9446,24 +9445,24 @@
1998-09-16 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (reset-language-environment): Call
- update-coding-systems-internal.
+ * international/mule-cmds.el (reset-language-environment):
+ Call update-coding-systems-internal.
* international/mule-conf.el: Call update-coding-systems-internal
at the tail.
1998-09-14 Dave Love <fx@gnu.org>
- * vc-hooks.el (vc-menu-map): Change the vc-directory label. Don't
- use the menu-enable properties, pending doing it correctly and
+ * vc-hooks.el (vc-menu-map): Change the vc-directory label.
+ Don't use the menu-enable properties, pending doing it correctly and
acceptably fast.
* map-ynp.el (map-y-or-n-p): Mention RET, `q' in the help text.
1998-09-13 Dave Love <d.love@dl.ac.uk>
- * progmodes/hideshow.el (hs-grok-mode-type): Check
- comment-{start,end} non-nil as well as bound. Report an error if
+ * progmodes/hideshow.el (hs-grok-mode-type):
+ Check comment-{start,end} non-nil as well as bound. Report an error if
we can't grok the mode.
1998-09-13 Richard Stallman <rms@gnu.org>
@@ -9604,9 +9603,9 @@
(reftex-label-illegal-re): Default changed, removed Latin1.
(reftex-latin1-to-ascii): New function.
(reftex-what-environment): Check for section regexp before use.
- (reftex-find-tex-file, reftex-find-bib-file): Fixed bug with
+ (reftex-find-tex-file, reftex-find-bib-file): Fix bug with
absolute path names.
- (reftex-TeX-master-file): Changed sequence of file checks.
+ (reftex-TeX-master-file): Change sequence of file checks.
(reftex-do-citation): Bibview cache only with RefTeX mode on.
1998-09-06 Richard Stallman <rms@gnu.org>
@@ -9680,7 +9679,7 @@
1998-09-04 Peter Breton <pbreton@ne.mediaone.net>
- * net-utils.el (netstat-program-options): Changed from nil to "-a"
+ * net-utils.el (netstat-program-options): Change from nil to "-a"
so that by default netstat shows all network connections.
1998-09-04 Bob Weiner <weiner@altrasoft.com>
@@ -9700,8 +9699,8 @@
1998-09-03 Bill Richter <richter@brouwer.math.nwu.edu>
- * international/quail.el (quail-choose-completion-string): Store
- completion `choice' in `quail-current-str'; don't insert it.
+ * international/quail.el (quail-choose-completion-string):
+ Store completion `choice' in `quail-current-str'; don't insert it.
1998-09-02 Kenichi Handa <handa@etl.go.jp>
@@ -9728,8 +9727,8 @@
1998-09-01 Dave Love <fx@gnu.org>
- * international/mule-cmds.el (current-language-environment): Fix
- setter function.
+ * international/mule-cmds.el (current-language-environment):
+ Fix setter function.
1998-09-01 Simon Marshall <simon@gnu.org>
@@ -9809,8 +9808,8 @@
* ange-ftp.el (ange-ftp-allow-child-lookup): Reinstate checking
dired-local-variables-file for dired-x.
- * emacs-lisp/find-func.el (find-function-search-for-symbol): Look
- for compressed library files too.
+ * emacs-lisp/find-func.el (find-function-search-for-symbol):
+ Look for compressed library files too.
1998-08-26 Kenichi Handa <handa@etl.go.jp>
@@ -9843,8 +9842,8 @@
1998-08-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus/gnus-start.el (gnus-save-newsrc-file): Bind
- coding-system-for-write before saving.
+ * gnus/gnus-start.el (gnus-save-newsrc-file):
+ Bind coding-system-for-write before saving.
1998-08-26 Kevin Rodgers <kevinr@ihs.com> (tiny change)
@@ -9862,15 +9861,15 @@
* repeat.el (repeat): Doc fix.
[From rms:]
(repeat-previous-repeated-command): New variable.
- (repeat): Check for real-last-command being null or repeat. Set
- repeat-previous-repeated-command.
+ (repeat): Check for real-last-command being null or repeat.
+ Set repeat-previous-repeated-command.
* browse-url.el (browse-url-netscape): Fix format for hex escapes.
1998-08-25 Kenichi Handa <handa@etl.go.jp>
- * gnus/message.el (message-send-mail-with-sendmail): Bind
- coding-system-for-write by the return value of
+ * gnus/message.el (message-send-mail-with-sendmail):
+ Bind coding-system-for-write by the return value of
select-message-coding-system.
(message-send-mail-with-qmail): Likewise.
@@ -9905,7 +9904,7 @@
* ps-print.el: Add codes to make ps-print.el work also on Emacs
20.2 and the earlier version.
- (ps-mule-encode-7bit, ps-mule-encode-8bit): Modified for 20.2.
+ (ps-mule-encode-7bit, ps-mule-encode-8bit): Modify for 20.2.
(ccl-encode-ethio-unicode, ps-mule-encode-ethiopic): Likewise.
(ps-mule-find-wrappoint): Likewise.
(ps-mule-generate-font): Change `X' to `x' in format control-string.
@@ -9935,16 +9934,16 @@
(ps-mule-prepare-font): New fun.
(ps-mule-charset-list): New var.
(ps-mule-prologue-generated, ps-mule-prologue): New vars.
- (ps-mule-skip-same-charset, ps-mule-find-wrappoint,
- ps-mule-plot-string): New funs.
+ (ps-mule-skip-same-charset, ps-mule-find-wrappoint)
+ (ps-mule-plot-string): New funs.
(ps-mule-cmpchar-prologue-generated, ps-mule-cmpchar-prologue):
New vars.
- (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar,
- ps-mule-prepare-cmpchar-font): New funs.
- (ps-mule-bitmap-prologue-generated, ps-mule-bitmap-prologue): New
- vars.
- (ps-mule-generate-bitmap-prologue, ps-mule-generate-bitmap-font,
- ps-mule-generate-bitmap-glyph): New funs.
+ (ps-mule-plot-rule-cmpchar, ps-mule-plot-cmpchar)
+ (ps-mule-prepare-cmpchar-font): New funs.
+ (ps-mule-bitmap-prologue-generated, ps-mule-bitmap-prologue):
+ New vars.
+ (ps-mule-generate-bitmap-prologue, ps-mule-generate-bitmap-font)
+ (ps-mule-generate-bitmap-glyph): New funs.
(ps-mule-initialize, ps-mule-begin): New funs.
(ps-output-string-prim): Insert string as unibyte.
(ps-output-prologue): New fun.
@@ -9964,10 +9963,10 @@
1998-08-23 Kenichi HANDA <handa@etl.go.jp>
- * international/mule-cmds.el (select-message-coding-system): New
- function.
- (set-language-environment-coding-systems): Set
- default-sendmail-coding-system.
+ * international/mule-cmds.el (select-message-coding-system):
+ New function.
+ (set-language-environment-coding-systems):
+ Set default-sendmail-coding-system.
* mail/sendmail.el (sendmail-coding-system): Doc-string modified.
(default-sendmail-coding-system): New variable.
@@ -9993,7 +9992,7 @@ See ChangeLog.7 for earlier changes.
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2001-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index 3d4d7e05b1b..d56f90ddc91 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -49,7 +49,7 @@
This avoids a call to eshell-file-attributes, which can be
expensive in some situations.
- * eshell/em-ls.el (eshell-ls-dired-initial-args): Added an extra
+ * eshell/em-ls.el (eshell-ls-dired-initial-args): Add an extra
customization variable, to differentiate ls-in-dired from regular
uses of ls.
@@ -404,7 +404,7 @@
tcl-end-of-defun, tcl-submit-bug-report.
(tcl-xemacs-menu): Fix up and pass it directly to easymenu.
(tcl-add-emacs-menu): Remove.
- (tcl-fill-mode-map, tcl-fill-inferior-map): Moved into the defvar.
+ (tcl-fill-mode-map, tcl-fill-inferior-map): Move into the defvar.
(tcl-keyword-list): Add `chain'.
(tcl-font-lock-syntactic-keywords): New variable.
(tcl-pps-has-arg-6): Remove.
@@ -414,14 +414,14 @@
(tcl-mode): Use define-derived-mode. Simplify.
Set comment-indent-function.
(tcl-indent-command): Use line-beginning-position and comment-indent.
- (tcl-calculate-indent): Renamed from calculate-tcl-indent.
+ (tcl-calculate-indent): Rename from calculate-tcl-indent.
(tcl-indent-line): Use tcl-calculate-indent.
- (tcl-indent-exp): Renamed from indent-tcl-exp. Use new names.
- (tcl-add-log-defun): Renamed from add-log-tcl-defun. Use match-string.
+ (tcl-indent-exp): Rename from indent-tcl-exp. Use new names.
+ (tcl-add-log-defun): Rename from add-log-tcl-defun. Use match-string.
(tcl-filter): Use with-current-buffer, simplify.
(inferior-tcl-mode): Use define-derived-mode.
- (tcl-hairy-in-comment): Renamed tcl-in-comment.
- (tcl-simple-in-comment, tcl-in-comment): Removed.
+ (tcl-hairy-in-comment): Rename tcl-in-comment.
+ (tcl-simple-in-comment, tcl-in-comment): Remove.
(tcl-files-alist): New function.
(tcl-help-snarf-commands): Use it and return the result directly
rather than through a global variable.
@@ -493,7 +493,7 @@
(view-lossage): Call `help-setup-xref' instead of doing it manually.
* subr.el (symbol-file-load-history-loaded)
- (load-symbol-file-load-history, symbol-file): Moved from `help.el'.
+ (load-symbol-file-load-history, symbol-file): Move from `help.el'.
* loadup.el ("button"): Load removed.
@@ -556,7 +556,7 @@
* woman.el (woman-mode-map): Copy button-buffer-map instead of
making a new keymap. Don't bind mouse-2. Bind M-mouse-2 to
`woman-follow-word' instead of `woman-mouse-2'.
- (woman-follow-word): Renamed from `woman-mouse-2'.
+ (woman-follow-word): Rename from `woman-mouse-2'.
Follow current unconditionally, since this function is now only
bound to M-mouse-2. Use accessor functions.
(WoMan-highlight-references): Use `make-text-button'.
@@ -912,25 +912,25 @@
* calculator.el (calculator-copy-displayer): New user-option.
(calculator-displayer-prev, calculator-displayer-next):
- Renamed from calculator-displayed-{left,right}.
+ Rename from calculator-displayed-{left,right}.
(calculator, calculator-standard-displayer)
(calculator-num-to-string, calculator-update-display)
(calculator-copy, calculator-put-value): Bug and display fixes.
2001-09-24 Vinicius Jose Latorre <vinicius@cpqd.com.br>
- * ebnf2ps.el: Eliminate make-local-hook calls. Doc fix.
+ * progmodes/ebnf2ps.el: Eliminate make-local-hook calls. Doc fix.
(ebnf-version): New version (3.6.1).
- * ebnf-bnf.el: Fix character range regexp. Doc fix.
+ * progmodes/ebnf-bnf.el: Fix character range regexp. Doc fix.
(ebnf-bnf-non-terminal-chars): New internal const.
(ebnf-bnf-lex): Fix code.
- * ebnf-iso.el: Fix character range regexp. Doc fix.
+ * progmodes/ebnf-iso.el: Fix character range regexp. Doc fix.
(ebnf-iso-non-terminal-chars): New internal const.
(ebnf-iso-lex): Fix code.
- * ebnf-yac.el: Fix character range regexp. Doc fix.
+ * progmodes/ebnf-yac.el: Fix character range regexp. Doc fix.
(ebnf-yac-skip-chars): New internal const.
(ebnf-yac-skip-code): Fix code.
@@ -974,8 +974,8 @@
Use make-keymap instead of copy-keymap, since copying the global
keymap messes up the menu bar.
- * info.el (Info-goto-node, Info-menu): Doc fix. Suggested by
- Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>.
+ * info.el (Info-goto-node, Info-menu): Doc fix.
+ Suggested by Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>.
2001-09-21 Eli Zaretskii <eliz@is.elta.co.il>
@@ -1006,16 +1006,17 @@
2001-09-19 Vinicius Jose Latorre <vinicius@cpqd.com.br>
- * ebnf2ps.el: Replace "Prologue" by "Prolog" in PostScript
+ * progmodes/ebnf2ps.el: Replace "Prologue" by "Prolog" in PostScript
programming. Doc fix.
(ebnf-version): New version (3.6).
(ebnf-eps-begin): Data fix.
(ebnf-begin-file): Code fix.
- * ebnf-bnf.el: Doc fix.
+ * progmodes/ebnf-bnf.el: Doc fix.
(ebnf-bnf-lex): Fix regexp for non-terminal and terminal tokens.
- * ebnf-iso.el, ebnf-otz.el, ebnf-yac.el: Doc fix.
+ * progmodes/ebnf-iso.el, progmodes/ebnf-otz.el, progmodes/ebnf-yac.el:
+ Doc fix.
2001-09-18 Vinicius Jose Latorre <vinicius@cpqd.com.br>
@@ -1073,8 +1074,8 @@
* mail/rmail.el (top-level): Require mule-utils when compiling.
(rmail-decode-babyl-format): Use detect-coding-with-priority
instead of detect-coding-region, to favor detection of emacs-mule
- encoded Babyl files written by rmailout.el etc. Suggested by
- Kenichi Handa <handa@etl.go.jp>.
+ encoded Babyl files written by rmailout.el etc.
+ Suggested by Kenichi Handa <handa@etl.go.jp>.
2001-09-14 Eli Zaretskii <eliz@is.elta.co.il>
@@ -1182,7 +1183,7 @@
2001-09-07 Gerd Moellmann <gerd@gnu.org>
* isearch.el (isearch-intersects-p): New function.
- (isearch-close-unnecessary-overlays): Renamed from *unecessary*,
+ (isearch-close-unnecessary-overlays): Rename from *unecessary*,
use isearch-intersects-p, and clean up.
2001-09-07 Eli Zaretskii <eliz@is.elta.co.il>
@@ -1214,7 +1215,7 @@
* emacs-lisp/edebug.el (edebug-window-live-p):
Use get-window-with-predicate.
- * window.el (get-window-with-predicate): Renamed from some-window.
+ * window.el (get-window-with-predicate): Rename from some-window.
(some-window): Make it an alias.
2001-09-06 Gerd Moellmann <gerd@gnu.org>
@@ -1325,7 +1326,7 @@
2001-08-31 Gerd Moellmann <gerd@gnu.org>
- * isearch.el (isearch-mouse-2): Renamed from isearch-mouse-yank.
+ * isearch.el (isearch-mouse-2): Rename from isearch-mouse-yank.
Instead of running mouse-yank-at-click, see what the event is
bound to outside Isearch and run that.
@@ -1583,8 +1584,8 @@
2001-08-20 Gerd Moellmann <gerd@gnu.org>
- * textmodes/texnfo-upd.el (texinfo-every-node-update): Remove
- some spaces from a message. From Pavel Janík <Pavel@Janik.cz>.
+ * textmodes/texnfo-upd.el (texinfo-every-node-update):
+ Remove some spaces from a message. From Pavel Janík <Pavel@Janik.cz>.
* whitespace.el (whitespace-global-mode): Add autoload cookie.
@@ -1664,7 +1665,7 @@
* Makefile.in (DONTCOMPILE): Remove sc.el.
- * Makefile.in (finder_setwins): Renamed from nonobsolete_setwins.
+ * Makefile.in (finder_setwins): Rename from nonobsolete_setwins.
Don't include term/.
* mail/sc.el: Moved to obsolete/.
@@ -1744,7 +1745,7 @@
* calendar/calendar.el (calendar-mode-line-format):
Use make-mode-line-mouse-map instead of make-mode-line-mouse2-map.
- * bindings.el (make-mode-line-mouse-map): Renamed from
+ * bindings.el (make-mode-line-mouse-map): Rename from
make-mode-line-mouse2-map. Take additional arg MOUSE.
(mode-line-modified): Use mouse-3 instead of mouse-2.
(mode-line-buffer-identification-keymap): Bind keys differently.
@@ -1841,9 +1842,9 @@
* uniquify.el (uniquify-ref-base, uniquify-ref-filename)
(uniquify-ref-buffer, uniquify-ref-proposed): New functions.
(uniquify-fix-item-base, uniquify-fix-item-filename)
- (uniquify-fix-item-buffer, uniquify-fix-item-proposed): Deleted.
+ (uniquify-fix-item-buffer, uniquify-fix-item-proposed): Delete.
Callers changed.
- (uniquify-set-proposed): Changed to work with a vector item.
+ (uniquify-set-proposed): Change to work with a vector item.
(uniquify-rationalize-file-buffer-names): Use a list of arrays for
the fix list, and a list of strings for the non-file buffer
names. Both changes reduce consing.
@@ -1879,7 +1880,7 @@
* uniquify.el: These changes correct a corner case that the old
code managed correctly.
- (uniquify-fix-item-proposed): Renamed from
+ (uniquify-fix-item-proposed): Rename from
uniquify-fix-item-min-proposed.
(uniquify-set-proposed): New function.
(uniquify-rationalize-file-buffer-names): Code reshuffled for
@@ -1945,7 +1946,7 @@
2001-07-27 Gerd Moellmann <gerd@gnu.org>
* emacs-lisp/lisp-mode.el (last-sexp-setup-props): New function.
- (last-sexp-toggle-display): Renamed from last-sexp-print.
+ (last-sexp-toggle-display): Rename from last-sexp-print.
(last-sexp-toggle-display, eval-last-sexp-1):
Use last-sexp-setup-props.
@@ -1977,8 +1978,8 @@
* emacs-lisp/lisp-mode.el (eval-print-last-sexp, eval-defun):
Mention the effect of eval-expression-print-length and
- eval-expression-print-level in the doc strings. Suggested by
- Kevin Gallagher <kevingal@onramp.net>.
+ eval-expression-print-level in the doc strings.
+ Suggested by Kevin Gallagher <kevingal@onramp.net>.
2001-07-25 Gerd Moellmann <gerd@gnu.org>
@@ -2012,7 +2013,7 @@
* uniquify.el: Overall speedup changes when using many buffers.
(uniquify-fix-item-base, uniquify-fix-item-filename)
- (uniquify-fix-item-buffer): Changed defmacro to defalias (cosmetic).
+ (uniquify-fix-item-buffer): Change defmacro to defalias (cosmetic).
(uniquify-fix-item-unrationalized-buffer): Deleted: was the fourth
place in the item, but was never used.
(uniquify-fix-item-min-proposed): New defalias: the fourth place
@@ -2025,7 +2026,7 @@
of buffer whose name was changed, but that return value was never used.
(uniquify-item-lessp): Replaces uniquify-filename-lessp, works on
the cached proposed name, does much less consing and is quicker.
- (uniquify-filename-lessp): Deleted.
+ (uniquify-filename-lessp): Delete.
(uniquify-rationalize-a-list): Use dolist (cosmetic change).
Do not bind locally the uniquify-possibly-resolvable flag. Use the
cached proposed name is possible.
@@ -2066,7 +2067,7 @@
* ediff-util.el: Copyright years.
(ediff-choose-syntax-table): New function.
(ediff-setup): Use ediff-choose-syntax-table.
- (ediff-file-checked-out-p,ediff-file-checked-in-p): Check if
+ (ediff-file-checked-out-p, ediff-file-checked-in-p): Check if
vc-state is available.
(ediff-make-temp-file): Use ediff-coding-system-for-write.
@@ -2074,7 +2075,7 @@
with-syntax-table.
(ediff-coding-system-for-read): From ediff-diff.el.
(ediff-coding-system-for-write): New variable.
- (ediff-highest-priority): Fixed the bug having to do with disappearing
+ (ediff-highest-priority): Fix the bug having to do with disappearing
overlays.
(ediff-file-remote-p): Use file-remote-p, if available.
(ediff-listable-file): New function.
@@ -2087,30 +2088,30 @@
Use ediff-coding-system-for-read.
(ediff-patch-file-internal): Use ediff-coding-system-for-write.
- * ediff-diff.el (ediff-coding-system-for-read): Moved to ediff-init.el.
- (ediff-match-diff3-line,ediff-get-diff3-group): Improved pattern.
+ * ediff-diff.el (ediff-coding-system-for-read): Move to ediff-init.el.
+ (ediff-match-diff3-line, ediff-get-diff3-group): Improve pattern.
* ediff.el: Date of last update, copyright years.
* ediff-wind.el (ediff-setup-control-frame): Nill->nil.
- * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
+ * viper-ex.el (ex-token-list, ex-cmd-execute): Revamped, courtesy
of Scott Bronson.
- (ex-cmd-assoc,ex-compile,ex-cmd-one-letr): New functions.
- (viper-check-sub,viper-get-ex-command,viper-execute-ex-command):
- Deleted functions.
- (viper-get-ex-com-subr,viper-ex,ex-mark): Changed to use the new
+ (ex-cmd-assoc, ex-compile, ex-cmd-one-letr): New functions.
+ (viper-check-sub, viper-get-ex-command, viper-execute-ex-command):
+ Delete functions.
+ (viper-get-ex-com-subr, viper-ex, ex-mark): Change to use the new
ex-token-list.
(viper-get-ex-address-subr): Convert registers to char data type.
- * viper-util.el (viper-int-to-char,viper-char-equal): New functions.
+ * viper-util.el (viper-int-to-char, viper-char-equal): New functions.
(viper-memq-char): Use viper-int-to-char.
(viper-file-checked-in-p): Use vc-locking-user, if vc doesn't have
vc-locking-state.
(viper-read-key): Use viper-read-key-sequence.
* viper.el (viper-major-mode-modifier-list):
- Added inferior-emacs-lisp-mode.
+ Add inferior-emacs-lisp-mode.
(this-major-mode-requires-vi-state): New function that uses simple
heuristics to decide if vi state is appropriate.
(set-viper-state-in-major-mode): Use this-major-mode-requires-vi-state.
@@ -2118,18 +2119,18 @@
(viper-read-key-sequence): New function that replaces the
previously used advice to read-key-sequence.
- * viper-cmd.el (viper-test-com-defun,viper-exec-change)
- (viper-exec-Change,viper-execute-com,viper-insert,viper-append)
- (viper-Append,viper-Insert,viper-open-line,viper-Open-line)
- (viper-open-line-at-point,viper-substitute,viper-overwrite)
- (viper-replace-char-subr,viper-forward-word,viper-forward-Word):
+ * viper-cmd.el (viper-test-com-defun, viper-exec-change)
+ (viper-exec-Change, viper-execute-com, viper-insert, viper-append)
+ (viper-Append, viper-Insert, viper-open-line, viper-Open-line)
+ (viper-open-line-at-point, viper-substitute, viper-overwrite)
+ (viper-replace-char-subr, viper-forward-word, viper-forward-Word):
Got rid of the negative character hack.
- (viper-escape-to-state,viper-replace-state-exit-cmd):
+ (viper-escape-to-state, viper-replace-state-exit-cmd):
Use viper-read-key-sequence.
(viper-envelop-ESC-key): No need for ad-get-orig-definition.
- (viper-minibuffer-standard-hook,viper-read-string-with-history):
+ (viper-minibuffer-standard-hook, viper-read-string-with-history):
Don't override existing minibuffer-setup-hook.
- (viper-mark-point,viper-goto-mark-subr,viper-brac-function):
+ (viper-mark-point, viper-goto-mark-subr, viper-brac-function):
Convert registers to char data type.
(viper-autoindent): Use viper-indent-line.
@@ -2211,9 +2212,9 @@
* progmodes/tcl.el (tcl-fill-mode-map): Use tcl-indent-exp.
(tcl-mode): Use tcl-add-log-defun.
(tcl-indent-line): Use tcl-calculate-indent.
- (tcl-calculate-indent): Renamed from calculate-tcl-indent.
- (tcl-indent-exp): Renamed from indent-tcl-exp.
- (tcl-add-log-defun): Renamed from add-log-tcl-defun.
+ (tcl-calculate-indent): Rename from calculate-tcl-indent.
+ (tcl-indent-exp): Rename from indent-tcl-exp.
+ (tcl-add-log-defun): Rename from add-log-tcl-defun.
(tcl-indent-for-comment): Call comment-indent-function properly
and handle the case where it returns nil.
@@ -2250,7 +2251,7 @@
* mouse-sel.el (mouse-sel-bindings): Instead of unbinding
mouse-1 etc., bind them to `ignore'.
- * eshell/esh-mode.el (eshell-send-invisible): Renamed from
+ * eshell/esh-mode.el (eshell-send-invisible): Rename from
send-invisible, which is already defined in Comint.
(eshell-watch-for-password-prompt): Use it.
@@ -2437,20 +2438,6 @@
* emacs-lisp/elp.el: A fix to follow coding conventions.
- * gnus/binhex.el, gnus/binhex.el, gnus/earcon.el,
- * gnus/gnus-agent.el, gnus/gnus-art.el, gnus/gnus-audio.el,
- * gnus/gnus-logic.el, gnus/gnus-ml.el, gnus/gnus-mlspl.el,
- * gnus/gnus-setup.el, gnus/gnus-srvr.el, gnus/gnus-sum.el,
- * gnus/gnus-uu.el, gnus/gnus-vm.el, gnus/ietf-drums.el,
- * gnus/mail-parse.el, gnus/mail-prsvr.el, gnus/mail-source.el,
- * gnus/mm-bodies.el, gnus/mm-decode.el, gnus/mm-encode.el,
- * gnus/mm-partial.el, gnus/mm-util.el, gnus/mm-uu.el,
- * gnus/mm-view.el, gnus/mml.el, gnus/nnimap.el, gnus/nnoo.el,
- * gnus/parse-time.el, gnus/rfc1843.el, gnus/rfc2045.el,
- * gnus/rfc2047.el, gnus/rfc2104.el, gnus/rfc2231.el,
- * gnus/time-date.el, gnus/uudecode.el: Some fixes to follow coding
- conventions in files from Gnus.
-
* abbrevlist.el, array.el, buff-menu.el, calendar/appt.el,
* case-table.el, cdl.el, cmuscheme.el, compare-w.el, completion.el,
* custom.el, derived.el, dired-aux.el, disp-table.el, dos-vars.el,
@@ -2531,11 +2518,11 @@
2001-07-11 Stefan Monnier <monnier@cs.yale.edu>
- * vc.el (vc-prefix-map): Moved back to vc-hooks.el.
+ * vc.el (vc-prefix-map): Move back to vc-hooks.el.
(vc-dired-mode-map): Fix the madness.
* vc-hooks.el (vc-mode): Dummy function for doc purposes.
- (vc-prefix-map): Moved back from vc.el.
+ (vc-prefix-map): Move back from vc.el.
2001-07-11 Gerd Moellmann <gerd@gnu.org>
@@ -2567,9 +2554,9 @@
* startup.el (normal-top-level): Don't operate on the initial
frame if we failed to create one.
-2001-07-10 Martin Stjernholm <bug-cc-mode@gnu.org>
+2001-07-10 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-indent-exp): Keep the indentation of the block
+ * progmodes/cc-cmds.el (c-indent-exp): Keep the indentation of the block
itself, i.e. only indent the contents in it.
2001-07-10 Markus Rost <rost@math.ohio-state.edu>
@@ -2599,9 +2586,9 @@
* toolbar/*.pbm: Cleaned up.
From Luis Fernandes <elf@ee.ryerson.ca>.
-2001-07-09 Martin Stjernholm <bug-cc-mode@gnu.org>
+2001-07-09 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el: Extended the kludge to interoperate with the
+ * progmodes/cc-cmds.el: Extended the kludge to interoperate with the
delsel and pending-del packages wrt to the new function
`c-electric-delete-forward'.
@@ -2860,8 +2847,9 @@
* international/quail.el (quail-start-conversion):
Reset quail-translating to nil.
- * antlr-mode.el (antlr-mode): Check that `c-Java-access-key' is
- bound. Suggested by David B. Malkovsky <David.Malkovsky@sas.com>.
+ * progmodes/antlr-mode.el (antlr-mode):
+ Check that `c-Java-access-key' is bound.
+ Suggested by David B. Malkovsky <David.Malkovsky@sas.com>.
2001-06-18 Eli Zaretskii <eliz@is.elta.co.il>
@@ -3127,7 +3115,7 @@
2001-05-28 Miles Bader <miles@gnu.org>
- * comint.el (comint-carriage-motion): Renamed from
+ * comint.el (comint-carriage-motion): Rename from
`comint-cr-magic'. Operate on the buffer instead of the string
(for use as a comint post-output filter, instead of as a
pre-output filter). Handle backspaces too. Add to the
@@ -3238,7 +3226,7 @@
2001-05-21 Stefan Monnier <monnier@cs.yale.edu>
* diff-mode.el (diff-jump-to-old-file, diff-update-on-the-fly):
- Renamed by removing the silly `-flag' suffix.
+ Rename by removing the silly `-flag' suffix.
(diff-mode, diff-minor-mode, diff-find-source-location): Update.
2001-05-20 Stefan Monnier <monnier@cs.yale.edu>
@@ -3325,7 +3313,7 @@
2001-05-18 Simon Josefsson <simon@josefsson.org>
- * mail/smtpmail.el (maybe-append-domain): Renamed to
+ * mail/smtpmail.el (maybe-append-domain): Rename to
`smtpmail-maybe-append-domain'.
(smtpmail-via-smtp): Use the new name.
@@ -3513,13 +3501,13 @@
2001-05-08 John Wiegley <johnw@gnu.org>
* calendar/timeclock.el (timeclock-workday-remaining):
- Changed logic for determining how much time is remaining.
+ Change logic for determining how much time is remaining.
(timeclock-workday-elapsed): Don't accept a "relative" argument
for the current day's elapsed time. What could that have meant?
(timeclock-workday-elapsed-string): No "relative" argument anymore.
- (timeclock-when-to-leave): Changed logic, similarly to what was
+ (timeclock-when-to-leave): Change logic, similarly to what was
done for `timeclock-workday-remaining'.
- (timeclock-find-discrep): Removed "today-only" argument, which had
+ (timeclock-find-discrep): Remove "today-only" argument, which had
no meaning. Fixed some more math problems. The function now
returns a three member list: (TOTAL-TIME-DISCREPANCY
TODAYS-TIME-DISCREPANCY TODAYS-ELAPSED-TIME).
@@ -3613,10 +3601,10 @@
* mail/rmail.el (rmail-mode-map): Use rmail-sort-by-labels
instead of rmail-sort-by-keywords.
- * mail/rmailsort.el (rmail-sort-by-labels): Renamed from
+ * mail/rmailsort.el (rmail-sort-by-labels): Rename from
rmail-sort-by-keywords.
- * mail/rmailsum.el (rmail-summary-sort-by-labels): Renamed from
+ * mail/rmailsum.el (rmail-summary-sort-by-labels): Rename from
rmail-summary-sort-by-keywords. Doc fix.
(rmail-summary-mode): Doc fix.
@@ -3638,25 +3626,25 @@
* progmodes/cperl-mode.el (cperl-font-lock-keywords)
(cperl-font-lock-keywords-1, cperl-font-lock-keywords-2):
- Renamed from perl-font-lock-keywords to avoid clashes.
+ Rename from perl-font-lock-keywords to avoid clashes.
(cperl-mode, cperl-load-font-lock-keywords, cperl-init-faces)
(cperl-load-font-lock-keywords-1, cperl-load-font-lock-keywords-2):
- Updated correspondingly.
+ Update correspondingly.
* diff-mode.el (diff-nonexistent-face, diff-font-lock-keywords):
Typo `nonexistant' -> `nonexistent'.
-2001-05-04 Martin Stjernholm <bug-cc-mode@gnu.org>
+2001-05-04 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-electric-delete, c-electric-delete-forward):
+ * progmodes/cc-cmds.el (c-electric-delete, c-electric-delete-forward):
Split `c-electric-delete' into two functions where
`c-electric-delete-forward' always deletes forward and
`c-electric-delete' only contains the code necessary for XEmacs to
choose between backward and forward deletion.
- * cc-mode.el: `c-electric-delete-forward' is now bound to C-d to
- get the electric behavior on that key too.
- (c-fill-paragraph): Fixed bogus direct use of
+ * progmodes/cc-mode.el: `c-electric-delete-forward' is now bound
+ to C-d to get the electric behavior on that key too.
+ (c-fill-paragraph): Fix bogus direct use of
c-comment-prefix-regexp, which caused an error when it's a list.
2001-05-03 Eli Zaretskii <eliz@is.elta.co.il>
@@ -3797,7 +3785,7 @@
2001-04-23 John Wiegley <johnw@gnu.org>
- * eshell/em-unix.el (eshell/diff): Fixed problems that were
+ * eshell/em-unix.el (eshell/diff): Fix problems that were
occurring with Emacs 21's diff.el/compile.el interaction layer.
2001-04-23 Colin Walters <walters@cis.ohio-state.edu>
@@ -3808,28 +3796,28 @@
2001-04-23 John Wiegley <johnw@gnu.org>
- * eshell/em-smart.el (eshell-smart-redisplay): Added some safety
+ * eshell/em-smart.el (eshell-smart-redisplay): Add some safety
code to work around a redisplay problem I've been having.
2001-04-23 John Wiegley <johnw@gnu.org>
* calendar/timeclock.el (timeclock-day-required): If the time
required for a particular day is not set, use `timeclock-workday'.
- (timeclock-find-discrep): Added some sample code in a comment.
+ (timeclock-find-discrep): Add some sample code in a comment.
* eshell/eshell.el (eshell-command): Made a few changes so that
`eshell-command' could be called programmatically.
- * eshell/esh-mode.el (eshell-non-interactive-p): Moved to eshell.el.
+ * eshell/esh-mode.el (eshell-non-interactive-p): Move to eshell.el.
- * eshell/eshell.el (eshell-non-interactive-p): Moved from esh-mode.el.
+ * eshell/eshell.el (eshell-non-interactive-p): Move from esh-mode.el.
2001-04-23 John Wiegley <johnw@gnu.org>
* calendar/timeclock.el: Updated copyright.
(timeclock-generate-report): Don't report the daily or two-week
total, if no time has been worked in that period.
- (timeclock-find-discrep): Moved call to `file-readable-p'; removed
+ (timeclock-find-discrep): Move call to `file-readable-p'; removed
final computational form, which was unnecessary; corrected a
parsing problem when timeclock-relative was nil.
@@ -3888,7 +3876,7 @@
2001-04-20 Alex Schroeder <alex@gnu.org>
- * sql.el (sql-mode-menu): Added highlighting entries.
+ * sql.el (sql-mode-menu): Add highlighting entries.
(sql-highlight-oracle-keywords): New function.
(sql-highlight-postgres-keywords): New function.
(sql-highlight-ansi-keywords): New function.
@@ -3899,7 +3887,7 @@
2001-04-19 Karl Fogel <kfogel@collab.net>
- * saveplace.el (save-place-alist-to-file): Removed no-effect code
+ * saveplace.el (save-place-alist-to-file): Remove no-effect code
that inserted file content only to delete it immediately.
Probably a cut-and-paste bug. Thanks to Juanma Barranquero
<lektu@terra.es> for the patch.
@@ -3926,7 +3914,7 @@
* language/slovak.el ("Slovak"): Add tutorial entry.
- * net/browse-url.el (browse-url-new-window-flag): Renamed from
+ * net/browse-url.el (browse-url-new-window-flag): Rename from
browse-url-new-window-p.
2001-04-17 Eli Zaretskii <eliz@is.elta.co.il>
@@ -3945,13 +3933,13 @@
2001-04-17 Eli Zaretskii <eliz@is.elta.co.il>
* vc-cvs.el (vc-cvs-print-log, vc-cvs-diff): Don't invoke CVS as
- an async subprocess if start-process is unavailable. Suggested by
- Tim Van Holder <tim.van.holder@pandora.be>.
+ an async subprocess if start-process is unavailable.
+ Suggested by Tim Van Holder <tim.van.holder@pandora.be>.
2001-04-15 Eli Zaretskii <eliz@is.elta.co.il>
- * info.el (Info-additional-directory-list): Doc fix. Suggested by
- Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>.
+ * info.el (Info-additional-directory-list): Doc fix.
+ Suggested by Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>.
2001-04-14 Eli Zaretskii <eliz@is.elta.co.il>
@@ -4065,7 +4053,7 @@
2001-04-10 John Wiegley <johnw@gnu.org>
- * calendar/timeclock.el (timeclock-generate-report): Added a
+ * calendar/timeclock.el (timeclock-generate-report): Add a
missing insert of the project name.
2001-04-09 Gerd Moellmann <gerd@gnu.org>
@@ -4457,119 +4445,121 @@
* mail/sendmail.el (sendmail-send-it): Don't parse Resent-*
headers. Always invoke sendmail with option -t.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
* Release of cc-mode 5.28.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-mode.el, cc-vars.el (c-common-init, c-default-style):
- Removed the hardcoded switch to "java" style in Java mode.
+ * progmodes/cc-mode.el, progmodes/cc-vars.el (c-common-init)
+ (c-default-style):
+ Remove the hardcoded switch to "java" style in Java mode.
It's instead taken care of by the default value for c-default-style.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-align.el (c-lineup-math): Fix bug where lineup was
+ * progmodes/cc-align.el (c-lineup-math): Fix bug where lineup was
triggered by equal signs in string literals.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-fill-paragraph): Fixed bug in the paragraph
+ * progmodes/cc-cmds.el (c-fill-paragraph): Fix bug in the paragraph
limit detection when at the ends of the buffer.
- * cc-engine.el (c-guess-basic-syntax): Removed bogus check for
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Remove bogus check for
"for" statement clause in case 7F; a better one is done
earlier in case 7D anyway.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-guess-fill-prefix): Improved the heuristics
+ * progmodes/cc-cmds.el (c-guess-fill-prefix): Improve the heuristics
somewhat more and did a small optimization.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-beginning-of-statement, c-end-of-statement):
+ * progmodes/cc-cmds.el (c-beginning-of-statement, c-end-of-statement):
Use the limit argument only to limit the syntactic context
search, not to limit the actual movement.
- * cc-cmds.el (c-beginning-of-statement): Move by sentence
+ * progmodes/cc-cmds.el (c-beginning-of-statement): Move by sentence
inside multiline strings, just like in comments. Also various
fixes to the paragraph and comment prefix recognition, block
comment ender handling etc.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-fill-paragraph): Take more care to preserve
+ * progmodes/cc-cmds.el (c-fill-paragraph): Take more care to preserve
the relative position of the point.
- * cc-cmds.el (c-electric-continued-statement): New function to
+ * progmodes/cc-cmds.el (c-electric-continued-statement): New function to
use as abbrev hook to reindent for keywords such as "else"
that continues an earlier statement.
- * cc-menus.el (cc-imenu-c++-generic-expression): Treat structs
+ * progmodes/cc-menus.el (cc-imenu-c++-generic-expression): Treat structs
like classes.
- * cc-mode.el (c-mode, c++-mode, java-mode, objc-mode)
+ * progmodes/cc-mode.el (c-mode, c++-mode, java-mode, objc-mode)
(pike-mode): Populate the default abbrev tables to reindent for
keywords such as "else" that can continue earlier statements.
Abbrev mode is therefore turned on by default now. (Note that
this doesn't apply to idl-mode, since IDL afaik doesn't have
statements at all.)
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-inside-bracelist-p): Fix for handling
+ * progmodes/cc-engine.el (c-inside-bracelist-p): Fix for handling
bracelists where the declaration contains template arguments.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-comment-indent):
+ * progmodes/cc-cmds.el (c-comment-indent):
Use `c-get-syntactic-indentation' to correctly calculate the
syntactic indentation. Fixes bug with lineup functions that
return vectors.
- * cc-engine.el (c-get-syntactic-indentation): Split the
+ * progmodes/cc-engine.el (c-get-syntactic-indentation): Split the
indentation sum calculation from `c-indent-line' to a separate
function.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-beginning-of-statement, c-comment-indent):
- Fixed places where it was assumed that preprocessor directives
+ * progmodes/cc-cmds.el (c-beginning-of-statement, c-comment-indent):
+ Fix places where it was assumed that preprocessor directives
have to start in column zero.
- * cc-engine.el (c-beginning-of-member-init-list): Handle C++
+ * progmodes/cc-engine.el (c-beginning-of-member-init-list): Handle C++
template arguments after a class identifier properly.
- * cc-engine.el (c-guess-basic-syntax): Treat initializer brace
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Treat initializer brace
lists for `new Foo[]' constructs in Java as expressions and
not top level definition brace lists on the top level, so that
they'll get indented consistently with the same type of
expression in a normal block.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-fill-paragraph): The kludge that checks
+ * progmodes/cc-cmds.el (c-fill-paragraph): The kludge that checks
whether the adaptive filling package fails to keep the comment
prefix is now kludged further to check for filladapt-mode
which doesn't have that problem. This is really icky, but it's
the only way that works with the current misfeatures/bugs in
both adaptive-fill-mode and filladapt-mode.
- * cc-cmds.el (c-fill-paragraph): Made the way the paragraph
+ * progmodes/cc-cmds.el (c-fill-paragraph): Made the way the paragraph
around point is recognized more robust.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el, cc-engine.el, cc-lobotomy.el (c-state-cache)
+ * progmodes/cc-cmds.el, progmodes/cc-engine.el:
+ * progmodes/cc-lobotomy.el (c-state-cache)
(c-in-literal-cache, c-auto-fill-prefix, c-lit-limits)
- (c-lit-type): Fixed all internal variables used dynamically so
+ (c-lit-type): Fix all internal variables used dynamically so
that they are always bound.
- * cc-cmds.el, cc-engine.el: Improved recovery of syntactic
- errors:
+ * progmodes/cc-cmds.el, progmodes/cc-engine.el:
+ Improve recovery of syntactic errors:
- (c-indent-region): Fixed reporting of syntactic errors so that
+ (c-indent-region): Fix reporting of syntactic errors so that
the region is fully reindented even when an error occurs.
The last syntactic error is printed afterwards. Also cleanup up a
whole lot of code that tried to optimize indentation of whole
@@ -4577,7 +4567,7 @@
(c-indent-sexp): Use c-indent-region.
- (c-parsing-error): Changed this variable to hold the message
+ (c-parsing-error): Change this variable to hold the message
for any syntactic error that is discovered.
(c-parse-state): Search backward from point instead of the bod
@@ -4588,28 +4578,29 @@
dangling "else" clauses instead of throwing an error, and fall
back to a reasonable position.
- (c-indent-line): Added argument to avoid reporting syntactic errors.
+ (c-indent-line): Add argument to avoid reporting syntactic errors.
(c-show-syntactic-information): Don't report any syntactic errors.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-beginning-of-statement): Fixed bugs with
+ * progmodes/cc-cmds.el (c-beginning-of-statement): Fix bugs with
paragraph recognition when moving by sentence in literals.
- * cc-langs.el (c-Java-javadoc-paragraph-start): Modified paragraph
- start regexp for javadoc to recognize javadoc markup in general instead
- of a specific set of keywords, to be more future-safe.
+ * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start): Modify
+ paragraph start regexp for javadoc to recognize javadoc markup in
+ general instead of a specific set of keywords, to be more future-safe.
(c-Pike-pikedoc-paragraph-start)
(c-Pike-pikedoc-paragraph-separate): New regexps to recognize
pikedoc markup.
- * cc-mode.el: Fixed initialization and use of c-current-comment-prefix.
+ * progmodes/cc-mode.el:
+ Fixed initialization and use of c-current-comment-prefix.
(pike-mode): Initialize paragraph settings pikedoc recognition.
- * cc-vars.el (c-default-style): Made a nicer Customize widget.
+ * progmodes/cc-vars.el (c-default-style): Made a nicer Customize widget.
(c-comment-prefix-regexp): Made it possible to use an
association list on this to specify mode specific regexps.
@@ -4619,126 +4610,128 @@
(c-current-comment-prefix): New variable containing the actual
regexp from c-comment-prefix-regexp for the current buffer.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-electric-brace): Fixed check for special brace
+ * progmodes/cc-cmds.el (c-electric-brace): Fix check for special brace
lists: We can't look at the syntax, since a brace list can get
recognized as a plain statement-cont.
- * cc-engine.el (c-guess-basic-syntax): Fixed bug where a
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug where a
special brace list opener broken over two lines got recognized
as a statement on the second line. Case 9A changed.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-electric-brace): Fixed bug in c-state-cache
+ * progmodes/cc-cmds.el (c-electric-brace): Fix bug in c-state-cache
adjustment after line is reindented.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-point): Added optional argument for position
+ * progmodes/cc-defs.el (c-point): Add optional argument for position
to use instead of the current point.
- * cc-defs.el, cc-engine.el (c-add-class-syntax): Do not add
- the in-expression block symbols when the construct starts at
- boi, to avoid the extra level of indentation in that case.
+ * progmodes/cc-defs.el, progmodes/cc-engine.el (c-add-class-syntax):
+ Do not add the in-expression block symbols when the construct
+ starts at boi, to avoid the extra level of indentation in that case.
Cases 4, 16A and 17E affected.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el: Use `indent-according-to-mode' instead of direct
+ * progmodes/cc-cmds.el: Use `indent-according-to-mode' instead of direct
calls to `c-indent-line', to adhere better to Emacs conventions.
- * cc-engine.el (c-indent-line): Use the syntax already bound
+ * progmodes/cc-engine.el (c-indent-line): Use the syntax already bound
to `c-syntactic-context', if there is any.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-get-offset): Fixed bug where the indentation
+ * progmodes/cc-engine.el (c-get-offset): Fix bug where the indentation
wasn't added up correctly when a lineup function returned nil.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-collect-line-comments): Fixed bug where
+ * progmodes/cc-engine.el (c-collect-line-comments): Fix bug where
empty lines were ignored when collecting line comments backwards.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-align.el (c-lineup-dont-change): Return an absolute
+ * progmodes/cc-align.el (c-lineup-dont-change): Return an absolute
indentation column to work correctly in the case when several
syntactic elements are processed for the same line.
- * cc-engine.el, cc-styles.el, cc-vars.el (c-evaluate-offset)
+ * progmodes/cc-engine.el, progmodes/cc-styles.el:
+ * progmodes/cc-vars.el (c-evaluate-offset)
(c-get-offset, c-indent-line, c-valid-offset, c-read-offset)
- (c-set-offset): Added absolute indentation column settings by
+ (c-set-offset): Add absolute indentation column settings by
using the vector type.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el, cc-vars.el (c-electric-paren, c-cleanup-list):
+ * progmodes/cc-cmds.el, progmodes/cc-vars.el
+ (c-electric-paren, c-cleanup-list):
Implemented two new cleanups `space-before-funcall' and
`compact-empty-funcall'.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-paren-re, c-identifier-re): Two new macros for
+ * progmodes/cc-defs.el (c-paren-re, c-identifier-re): Two new macros for
helping building regexps.
- * cc-engine.el (c-on-identifier): New function for detecting
+ * progmodes/cc-engine.el (c-on-identifier): New function for detecting
identifiers. It takes keywords into account.
- * cc-langs.el, cc-mode.el: Added regexps for complete keyword
- lists. `c-keywords' is set to a regexp matching all keywords
- in the current language.
+ * progmodes/cc-langs.el, progmodes/cc-mode.el: Added regexps for
+ complete keyword lists. `c-keywords' is set to a regexp matching
+ all keywords in the current language.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-beginning-of-statement-1): Added '#' to the
+ * progmodes/cc-engine.el (c-beginning-of-statement-1): Add '#' to the
list of characters to skip backwards over at the beginning of
a statement, since it can precede string literals in Pike.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-guess-fill-prefix): Fixed bug with prefix
+ * progmodes/cc-cmds.el (c-guess-fill-prefix): Fix bug with prefix
recognition when standing on the last line in a C++ comment
with nothing but whitespace after the prefix.
- * cc-engine.el (c-backward-to-start-of-if): Fixed bug when
+ * progmodes/cc-engine.el (c-backward-to-start-of-if): Fix bug when
given no limit argument.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-inside-bracelist-p): Fixed brace list
+ * progmodes/cc-engine.el (c-inside-bracelist-p): Fix brace list
recognition for the `[]= operator symbol in Pike.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-bytecomp.el (cc-eval-when-compile): New macro that works
+ * progmodes/cc-bytecomp.el (cc-eval-when-compile): New macro that works
around a bug in `eval-when-compile' in the byte compiler.
- * cc-engine.el (c-forward-token-1): Fixed bug with return
+ * progmodes/cc-engine.el (c-forward-token-1): Fix bug with return
value when count is zero and there's no token start within the limit.
(c-guess-basic-syntax): Don't add 'comment-intro to lines with
"prefix comments", i.e. comments which are followed by code on
the same line.
- * cc-mode-19.el: Fixes so that checks that must be done at
+ * progmodes/cc-mode-19.el: Fixes so that checks that must be done at
compile time also are done then.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el: Make sure cc-mode-19 is loaded both at compile
+ * progmodes/cc-defs.el: Make sure cc-mode-19 is loaded both at compile
time and at runtime, and only when it's needed.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
Major cleanup for less error prone and more warning free
compilation, including some fixes for bugs due to different
compilation orders. Thanks to Martin Buchholz for providing
the basis for all this.
- * cc-bytecomp.el: New file that provides some byte compilation
+ * progmodes/cc-bytecomp.el: New file that provides some byte compilation
features: It ensures that files always are loaded from the
current source directory during compilation, and it provides a
set of macros to turn off specific compiler warnings for
@@ -4747,61 +4740,62 @@
Fixed a nearly acyclic dependency tree (both runtime and
compile-time) between all files.
- * cc-defs.el: Separated all macros before the inline functions,
- to ensure correct compilation.
+ * progmodes/cc-defs.el: Separated all macros before the
+ inline functions, to ensure correct compilation.
- * cc-defs.el, cc-engine.el: Moved c-beginning-of-macro to from
- cc-defs.el to cc-engine.el and made it a function instead.
+ * progmodes/cc-defs.el, progmodes/cc-engine.el: Moved
+ c-beginning-of-macro to from cc-defs.el to cc-engine.el and
+ made it a function instead.
- * cc-mode-19.el: Patch the byte compiler in Emacs 19 not to warn
- about char-after.
+ * progmodes/cc-mode-19.el: Patch the byte compiler in Emacs 19
+ not to warn about char-after.
- * cc-vars.el: Cope even when there isn't a custom package
+ * progmodes/cc-vars.el: Cope even when there isn't a custom package
containing defcustom available.
- * cc-make.el: Removed since it's no longer necessary.
+ * progmodes/cc-make.el: Removed since it's no longer necessary.
README: Updated installation instructions.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el, cc-langs.el, cc-mode.el: Moved around things to
- improve the modularity: Moved all mode init stuff from
- cc-langs.el to cc-mode.el, including the keymap
- initialization; cc-langs now only contains the various
- variables for configuring the language syntax.
+ * progmodes/cc-cmds.el, progmodes/cc-langs.el, progmodes/cc-mode.el:
+ Moved around things to improve the modularity:
+ Moved all mode init stuff from cc-langs.el to cc-mode.el,
+ including the keymap initialization; cc-langs now only contains
+ the various variables for configuring the language syntax.
- * cc-engine.el, cc-styles.el (c-evaluate-offset)
- (c-get-offset): Moved from cc-styles to cc-engine since file
+ * progmodes/cc-engine.el, progmodes/cc-styles.el (c-evaluate-offset)
+ (c-get-offset): Move from cc-styles to cc-engine since file
dependency analysis suggests they belong there (which also
makes more sense). Thanks to Martin Buchholz for doing the analysis.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-fn-region-is-active-p): New function that
+ * progmodes/cc-cmds.el (c-fn-region-is-active-p): New function that
wraps the corresponding macro, for use in places that aren't
compiled. Thanks to Martin Buchholz for pointing out this.
- * cc-langs.el (c-mode-menu): Use c-fn-region-is-active-p.
+ * progmodes/cc-langs.el (c-mode-menu): Use c-fn-region-is-active-p.
- * cc-mode.el (c-prepare-bug-report-hooks): Hook variable to
+ * progmodes/cc-mode.el (c-prepare-bug-report-hooks): Hook variable to
add things to the bug report.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-guess-fill-prefix): Fixed bug where the
+ * progmodes/cc-cmds.el (c-guess-fill-prefix): Fix bug where the
returned prefix could contain a newline when the search for a
good prefix line failed.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-toggle-auto-state, c-toggle-hungry-state)
+ * progmodes/cc-cmds.el (c-toggle-auto-state, c-toggle-hungry-state)
(c-toggle-auto-hungry-state): Made the argument optional, as
the documentation says it is.
-2000-03-21 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-03-21 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-guess-basic-syntax): Don't treat the Pike
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Don't treat the Pike
multiline string syntax, #"...", as a cpp macro.
2001-03-21 Paul Eggert <eggert@twinsun.com>
@@ -4873,12 +4867,12 @@
* ediff-wind.el (ediff-setup-control-frame): Nill->nil.
- * viper-ex.el (ex-token-list,ex-cmd-execute): Revamped, courtesy
+ * viper-ex.el (ex-token-list, ex-cmd-execute): Revamped, courtesy
of Scott Bronson.
- (ex-cmd-assoc,ex-cmd-one-letr): New functions.
- (viper-check-sub,viper-get-ex-command,viper-execute-ex-command):
- Deleted functions.
- (viper-get-ex-com-subr,viper-ex,ex-mark): Changed to use the new
+ (ex-cmd-assoc, ex-cmd-one-letr): New functions.
+ (viper-check-sub, viper-get-ex-command, viper-execute-ex-command):
+ Delete functions.
+ (viper-get-ex-com-subr, viper-ex, ex-mark): Change to use the new
ex-token-list.
* viper-util.el: Spaces, indentation.
@@ -4892,9 +4886,9 @@
2001-03-16 John Wiegley <johnw@gnu.org>
- * calendar/timeclock.el (timeclock-reread-log): Fixed problem with
+ * calendar/timeclock.el (timeclock-reread-log): Fix problem with
first-time checkins.
- (timeclock-log-data): Fixed problem with reading timelog log file.
+ (timeclock-log-data): Fix problem with reading timelog log file.
Resulting data in the "day list" was incorrect.
(timeclock-find-discrep): Check if `timeclock-file' is readable
before opening it.
@@ -5029,7 +5023,7 @@
2001-03-09 Gerd Moellmann <gerd@gnu.org>
- * help.el (string-key-binding): Renamed from
+ * help.el (string-key-binding): Rename from
mode-line-key-binding. Handle any event on a string.
Check for `keymap' properties as well as `local-map' properties.
@@ -5080,7 +5074,7 @@
2001-03-07 Stefan Monnier <monnier@cs.yale.edu>
* log-edit.el (log-edit-common-indent): New var.
- (log-edit-set-common-indentation): Renamed from
+ (log-edit-set-common-indentation): Rename from
log-edit-delete-common-indentation. Use the new var.
(log-edit-insert-changelog, log-edit-done-hook): Use the new name.
@@ -5411,8 +5405,8 @@
* startup.el (fancy-splash-screens): Use display-hourglass
instead of display-busy-cursor.
- * frame.el (display-hourglass): Renamed from busy-cursor.
- (hourglass-delay): Renamed from busy-cursor-delay-seconds.
+ * frame.el (display-hourglass): Rename from busy-cursor.
+ (hourglass-delay): Rename from busy-cursor-delay-seconds.
(show-cursor-in-non-selected-windows): Doc fix.
2001-02-20 Dave Love <fx@gnu.org>
@@ -5563,9 +5557,9 @@
2001-02-12 Michael Kifer <kifer@cs.sunysb.edu>
- * ediff-diff.el (ediff-make-diff2-buffer): Removed bogus checks
+ * ediff-diff.el (ediff-make-diff2-buffer): Remove bogus checks
for remote files.
- (ediff-coding-system-for-read): Replaced the no-conversion default
+ (ediff-coding-system-for-read): Replace the no-conversion default
with raw-text.
* ediff-init.el: Removed :version from defcustom vars.
@@ -5573,10 +5567,6 @@
* ediff-util.el (ediff-compute-custom-diffs-maybe):
Better handling of the diff mode.
- * ediff.texi: Added ediff-coding-system-for-read.
-
- * viper.texi: Fix typos.
-
2001-02-11 Dave Love <fx@gnu.org>
* shadowfile.el: Doc fixes.
@@ -5730,7 +5720,7 @@
2001-02-06 Gerd Moellmann <gerd@gnu.org>
- * dabbrev.el (dabbrev-ignored-buffer-regexps): Renamed from
+ * dabbrev.el (dabbrev-ignored-buffer-regexps): Rename from
dabbrev-ignored-regexps.
2001-02-06 Eli Zaretskii <eliz@is.elta.co.il>
@@ -5756,7 +5746,7 @@
2001-02-05 Vinicius Jose Latorre <vinicius@cpqd.com.br>
- * ebnf2ps.el: Eliminate time-stamp functions.
+ * progmodes/ebnf2ps.el: Eliminate time-stamp functions.
(ebnf-version): New version (3.5).
(ebnf-eps-finish-and-write): Replace time-stamp functions by
format-time-string.
@@ -6071,14 +6061,14 @@
2001-01-25 John Wiegley <johnw@gnu.org>
- * eshell/esh-util.el (eshell-ange-ls-uids): Changed use of `alist'
+ * eshell/esh-util.el (eshell-ange-ls-uids): Change use of `alist'
to `repeat' in the :type field.
- * pcomplete.el (pcomplete-file-ignore): Changed a :type field to
+ * pcomplete.el (pcomplete-file-ignore): Change a :type field to
allow a choice of regexp or nil.
(pcomplete-dir-ignore): Same.
- * eshell/em-unix.el (eshell/occur): Fixed bug causing `occur' (as
+ * eshell/em-unix.el (eshell/occur): Fix bug causing `occur' (as
a command) to always fail.
2001-01-25 Gerd Moellmann <gerd@gnu.org>
@@ -6127,14 +6117,14 @@
2001-01-24 Sam Steingold <sds@gnu.org>
- * dired.el (dired-replace-in-string): Removed.
+ * dired.el (dired-replace-in-string): Remove.
(dired-sort-toggle): Use `replace-regexps-in-string'
instead of `dired-replace-in-string'.
* dired-aux.el (dired-shell-stuff-it, dired-rename-subdir)
(dired-rename-subdir-2, dired-insert-subdir-doinsert): Ditto.
- * gs.el (gs-replace-in-string): Removed.
+ * gs.el (gs-replace-in-string): Remove.
(gs-options): Use `replace-regexps-in-string'
instead of `gs-replace-in-string'.
@@ -6258,7 +6248,7 @@
2001-01-19 Michael Kifer <kifer@cs.sunysb.edu>
- * ediff-hook.el (ediff-xemacs-init-menus): Fixed add-menu-button.
+ * ediff-hook.el (ediff-xemacs-init-menus): Fix add-menu-button.
* ediff-init.el (subst-char-in-string): Define and use it, unless
it's already defined.
@@ -6319,7 +6309,7 @@
overlay priorities should make it unnecessary, right?
(isearch-highlight): Face suppressing behavior removed.
(isearch-dehighlight): Face suppressing behavior removed.
- (isearch-set-lazy-highlight-faces-at): Removed.
+ (isearch-set-lazy-highlight-faces-at): Remove.
2001-01-17 Kenichi Handa <handa@etl.go.jp>
@@ -6556,19 +6546,19 @@
2000-01-09 Alex Schroeder <alex@gnu.org>
- * ansi-color.el (ansi-color-process): Removed, Emacs and XEmacs
+ * ansi-color.el (ansi-color-process): Remove, Emacs and XEmacs
both use ansi-color-process-output, now.
(ansi-color-process-output): Doesn't return string anymore. It is
installed in comint-output-filter-functions for both Emacs and
XEmacs, now.
- (ansi-color-unfontify-region): Simplified code removing variables
+ (ansi-color-unfontify-region): Simplify code removing variables
pos and start-ansi.
(ansi-color-apply): Put text-property ansi-color before putting
text-property face because ansi-color-unfontify-region is called
immediately after the call to put-text-property.
(ansi-color-context-region): Doc change.
- (ansi-color-filter-region): Simplified code.
- (ansi-color-apply-on-region): Changed start to start-marker, using
+ (ansi-color-filter-region): Simplify code.
+ (ansi-color-apply-on-region): Change start to start-marker, using
a marker explicitly. Put text-property ansi-color before putting
text-property face because ansi-color-unfontify-region is called
immediately after the call to put-text-property.
@@ -6576,15 +6566,15 @@
2000-01-09 Alex Schroeder <alex@gnu.org>
* ansi-color.el (ansi-color-faces-vector): Doc change.
- (ansi-color-for-comint-mode): Changed :type property to choice.
- (ansi-color-last-context): Removed.
+ (ansi-color-for-comint-mode): Change :type property to choice.
+ (ansi-color-last-context): Remove.
(ansi-color-process-output): Don't use ansi-color-last-context, as
the main functions will store their context now.
(ansi-color-context): Doc change.
(ansi-color-filter-apply): Rewrote it based on ansi-color-apply.
Uses ansi-color-context such that repeated calls will strip
partial escape sequences, too.
- (ansi-color-apply): Simplified code. Colorize end of string if
+ (ansi-color-apply): Simplify code. Colorize end of string if
face is not null. Store context in new (FACE STRING) format, such
that repeated calls will strip partial escape sequences, too.
Append faces to face property using ansi-color-apply-sequence such
@@ -6593,7 +6583,7 @@
(ansi-color-filter-region): Rewrote it based on
ansi-color-apply-on-region. Uses ansi-color-context-region such
that repeated calls will strip partial escape sequences, too.
- (ansi-color-apply-on-region): Simplified code. Colorize end of
+ (ansi-color-apply-on-region): Simplify code. Colorize end of
region if face is not null. Store context in new (FACE POS)
format, such that repeated calls will strip partial escape
sequences, too. Append faces to face property using
@@ -6654,8 +6644,8 @@
decide what to do. This function is added to
comint-preoutput-filter-functions when the package is loaded.
- (ansi-color-for-shell-mode-set): Removed.
- (ansi-color-for-shell-mode): Removed.
+ (ansi-color-for-shell-mode-set): Remove.
+ (ansi-color-for-shell-mode): Remove.
2000-01-09 Alex Schroeder <alex@gnu.org>
@@ -6706,14 +6696,14 @@
* vc.el (vc-default-latest-on-branch-p): New function, replaces
constant implementations in backends.
- * vc-cvs.el (vc-cvs-latest-on-branch-p): Removed.
- (vc-cvs-checkout): Renamed arg WRITABLE to EDITABLE.
+ * vc-cvs.el (vc-cvs-latest-on-branch-p): Remove.
+ (vc-cvs-checkout): Rename arg WRITABLE to EDITABLE.
- * vc-rcs.el (vc-rcs-checkout, vc-rcs-cancel-version): Renamed arg
+ * vc-rcs.el (vc-rcs-checkout, vc-rcs-cancel-version): Rename arg
WRITABLE to EDITABLE.
- * vc-sccs.el (vc-sccs-latest-on-branch-p): Removed.
- (vc-sccs-checkout, vc-sccs-cancel-version): Renamed arg WRITABLE
+ * vc-sccs.el (vc-sccs-latest-on-branch-p): Remove.
+ (vc-sccs-checkout, vc-sccs-cancel-version): Rename arg WRITABLE
to EDITABLE.
2001-01-08 Eli Zaretskii <eliz@is.elta.co.il>
@@ -6723,7 +6713,7 @@
2001-01-08 Gerd Moellmann <gerd@gnu.org>
- * isearch.el (isearch-old-signal-hook): Removed.
+ * isearch.el (isearch-old-signal-hook): Remove.
(isearch-mode): Add isearch-done to kbd-macro-termination-hook
instead of setting signal-hook-function.
(isearch-done): Remove isearch-done from kbd-macro-termination-hook.
@@ -6801,7 +6791,7 @@
2001-01-04 Gerd Moellmann <gerd@gnu.org>
* tooltip.el (tooltip-cancel-delayed-tip)
- (tooltip-start-delayed-tip): Renamed from tooltip-disable-timeout
+ (tooltip-start-delayed-tip): Rename from tooltip-disable-timeout
and tooltip-add-timeout.
(tooltip-show): Set border color from faces's foreground.
(tooltip-show-help-function): If called with the same help string
@@ -6835,8 +6825,8 @@
(dired-guess-shell-alist-default): Don't use xloadimage for PNG.
(dired-guess-shell-alist-user): Customize.
(dired-x-help-address): Set to bug-gnu-emacs.
- (dired-x-maintainer, dired-x-file, dired-x-version): Deleted.
- (dired-default-directory): Renamed from default-directory.
+ (dired-x-maintainer, dired-x-file, dired-x-version): Delete.
+ (dired-default-directory): Rename from default-directory.
* hl-line.el (hl-line): Doc fix.
@@ -6927,7 +6917,7 @@
* international/fontset.el (x-complement-fontset-spec):
Resolve ASCII font name so that the same family name is used for fonts
registered in x-font-name-charset-alist.
- (create-fontset-from-fontset-spec): Adjusted for the above change.
+ (create-fontset-from-fontset-spec): Adjust for the above change.
The name of fontset alias should be a unresolved ASCII font name.
2000-12-28 Gerd Moellmann <gerd@gnu.org>
@@ -6942,13 +6932,13 @@
2000-12-28 Kenichi Handa <handa@etl.go.jp>
- * textmodes/artist.el (artist-butlast): Deleted.
+ * textmodes/artist.el (artist-butlast): Delete.
(artist-ellipse-mirror-quadrant): Use butlast instead of
artist-butlast.
- * subr.el (butlast, nbutlast): Moved from cl.el to here.
+ * subr.el (butlast, nbutlast): Move from cl.el to here.
- * emacs-lisp/cl.el (butlast, nbutlast): Moved to subr.el.
+ * emacs-lisp/cl.el (butlast, nbutlast): Move to subr.el.
2000-12-27 Eli Zaretskii <eliz@is.elta.co.il>
@@ -6997,13 +6987,13 @@
2000-12-25 Michael Kifer <kifer@cs.sunysb.edu>
- * viper-init.el (viper-restore-cursor-type): Added condition-case guard.
+ * viper-init.el (viper-restore-cursor-type): Add condition-case guard.
- * ediff-init.el (ediff-quit-hook,ediff-suspend-hook):
- Changed initialization; use add-hook.
+ * ediff-init.el (ediff-quit-hook, ediff-suspend-hook):
+ Change initialization; use add-hook.
(ediff-file-remote-p): Use file-local-copy.
- * ediff-ptch.el (ediff-prompt-for-patch-buffer): Improved defaults.
+ * ediff-ptch.el (ediff-prompt-for-patch-buffer): Improve defaults.
* ediff.el (ediff-patch-buffer): Bug fix.
(ediff-revision): Allow selection of the file at the prompt.
@@ -7047,7 +7037,7 @@
2000-08-22 Emmanuel Briot <briot@gnat.com>
- * xml.el (top level comment): Updated to reflect the fact that
+ * xml.el (top level comment): Update to reflect the fact that
white spaces are relevant in the XML file.
(xml-parse-file): Do not kill an existing Emacs buffer if the file
to parse was already edited. This allows for on-the-fly analysis
@@ -7083,27 +7073,27 @@
2000-12-21 Vinicius Jose Latorre <vinicius@cpqd.com.br>
- * ebnf2ps.el: Fix a problem with skip-chars-forward: it doesn't accept
- ranges like \177-\237, but accepts the character sequence from \177 to
- \237. Doc fix.
+ * progmodes/ebnf2ps.el: Fix a problem with skip-chars-forward:
+ it doesn't accept ranges like \177-\237, but accepts the character
+ sequence from \177 to \237. Doc fix.
(ebnf-version): New version (3.4).
(ebnf-setup): Code fix.
(ebnf-range-regexp): New fun.
(ebnf-8-bit-chars): Const fix.
- * ebnf-bnf.el: Fix the same problem as described on ebnf2ps.el log
- entry. Doc fix.
+ * progmodes/ebnf-bnf.el: Fix the same problem as described
+ on ebnf2ps.el log entry. Doc fix.
(ebnf-bnf-lex): Code fix.
(ebnf-bnf-comment-chars): Const fix.
- * ebnf-iso.el: Fix the same problem as described on ebnf2ps.el log
- entry. Doc fix.
+ * progmodes/ebnf-iso.el: Fix the same problem as described
+ on ebnf2ps.el log entry. Doc fix.
(ebnf-iso-comment-chars): Const fix.
- * ebnf-otz.el: Doc fix.
+ * progmodes/ebnf-otz.el: Doc fix.
- * ebnf-yac.el: Fix the same problem as described on ebnf2ps.el log
- entry. Doc fix.
+ * progmodes/ebnf-yac.el: Fix the same problem as described
+ on ebnf2ps.el log entry. Doc fix.
(ebnf-yac-skip-code): Code fix.
(ebnf-yac-comment-chars): Const fix.
@@ -7168,7 +7158,7 @@
* progmodes/idlwave.el: Fixed copyright notice.
- * textmodes/reftex-dcr.el (reftex-view-crossref): Added SPACE and
+ * textmodes/reftex-dcr.el (reftex-view-crossref): Add SPACE and
TAB as key separators.
2000-12-19 Alex Schroeder <alex@gnu.org>
@@ -7176,7 +7166,7 @@
* sql.el (sql-sybase-options): New option.
(sql-sybase): Use it. Add sql-database to the list of parameters
provided for login. The options -w 2048 -n are not used any more.
- (sql-postgres-options): Changed default from "--pset" to "-P".
+ (sql-postgres-options): Change default from "--pset" to "-P".
(sql-mysql-options): Doc change.
(sql-stop): Doc change.
@@ -7200,7 +7190,7 @@
2000-12-18 Dave Love <fx@gnu.org>
* simple.el (mail-user-agent): Doc fix.
- (input-mode-8-bit): Removed.
+ (input-mode-8-bit): Remove.
* international/mule.el (set-keyboard-coding-system): Doc fix.
(keyboard-coding-system): New option.
@@ -7383,12 +7373,12 @@
* international/characters.el: Fix cases and syntaxes for
mule-unicode-0100-24ff.
- * dired.el (dired-move-to-filename-regexp): Fixed for the case
+ * dired.el (dired-move-to-filename-regexp): Fix for the case
that a Japanese character is not appended after day and year.
* info.el (Info-suffix-list): Change format for a command that
requires arguments.
- (info-insert-file-contents): Adjusted for the above change.
+ (info-insert-file-contents): Adjust for the above change.
2000-12-12 Andreas Schwab <schwab@suse.de>
@@ -7492,7 +7482,7 @@
* textmodes/reftex.el (reftex-scanning-info-available-p): New function.
(reftex-TeX-master-file): Check for `tex-main-file' early enough.
- * textmodes/reftex-global.el (reftex-create-tags-file): Fixed bug
+ * textmodes/reftex-global.el (reftex-create-tags-file): Fix bug
when master file is not open.
2000-12-09 Stefan Monnier <monnier@cs.yale.edu>
@@ -7680,12 +7670,12 @@
2000-12-05 Rob Riepel <riepel@Stanford.EDU>
- * emulation/tpu-edt.el (tpu-help): Fixed previous screen logic.
- (tpu-search-highlight): Fixed comparison of overlay end positions.
+ * emulation/tpu-edt.el (tpu-help): Fix previous screen logic.
+ (tpu-search-highlight): Fix comparison of overlay end positions.
(tpu-trim-line-ends): Implemented trimming logic locally.
* emulation/tpu-extras.el (tpu-write-file-hook)
- (tpu-set-cursor-bound): Replaced picture-clean with tpu-trim-line-ends.
+ (tpu-set-cursor-bound): Replace picture-clean with tpu-trim-line-ends.
2000-12-05 Kenichi Handa <handa@etl.go.jp>
@@ -7774,7 +7764,7 @@
* international/mule.el (make-char): Fix last change.
- * textmode/texinfo.el (texinfo-open-quote, texinfo-close-quote):
+ * textmodes/texinfo.el (texinfo-open-quote, texinfo-close-quote):
New defcustoms.
(texinfo-insert-quote): Don't call tex-insert-quote, to avoid
autoloading tex-mode; instead, do the same manually.
@@ -7930,8 +7920,8 @@
2000-11-29 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: New commands to run ANTLR from within Emacs and
- to create Makefile rules.
+ * progmodes/antlr-mode.el: New commands to run ANTLR from within
+ Emacs and to create Makefile rules.
(antlr-tool-command): New user option.
(antlr-ask-about-save): New user option.
(antlr-makefile-specification): New user option.
@@ -7950,7 +7940,7 @@
(antlr-insert-makefile-rules): New function.
(antlr-show-makefile-rules): New command.
- * antlr-mode.el: More Emacs/XEmacs stuff.
+ * progmodes/antlr-mode.el: More Emacs/XEmacs stuff.
(antlr-no-action-keywords): New constant with value nil.
(antlr-font-lock-keywords-alist): Use it. Old value would break
syntax highlighting in Emacs-21.0.
@@ -7960,14 +7950,14 @@
2000-11-29 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: imenu, parsing and highlighting changes.
+ * progmodes/antlr-mode.el: imenu, parsing and highlighting changes.
(antlr-imenu-create-index-function): Don't create extra submenus
for definitions in different grammar classes. It is not necessary
for the menu and would make command `imenu' awkward to use.
(antlr-skip-file-prelude): With ANTLR-2.7+, you can specify named
header actions and more than one.
- (antlr-font-lock-tokendef-face): Changed color.
- (antlr-font-lock-tokenref-face): Changed color.
+ (antlr-font-lock-tokendef-face): Change color.
+ (antlr-font-lock-tokenref-face): Change color.
(antlr-font-lock-additional-keywords): Also highlight lowercase.
(antlr-mode-syntax-table): New variable.
(antlr-mode): Populate and use it instead `java-mode-syntax-table'.
@@ -7975,7 +7965,7 @@
2000-11-29 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Minor changes: language setting.
+ * progmodes/antlr-mode.el: Minor changes: language setting.
(antlr-language-alist): The value for file option "language" can
be both an identifier and a string.
Reported by Rajesh Radhakrishnan <radhakrs@email.uc.edu>.
@@ -7983,7 +7973,7 @@
2000-11-29 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: Minor changes: tabs, hiding.
+ * progmodes/antlr-mode.el: Minor changes: tabs, hiding.
(antlr-tab-offset-alist): Set `indent-tabs-mode' to nil instead t.
(antlr-action-visibility): Also allow value nil to also hide the
braces. Renamed from `antlr-tiny-action-length'.
@@ -8208,15 +8198,15 @@
* ediff-init.el (ediff-abbrev-jobname): Use capitalize.
- * ediff-wind.el (ediff-skip-unsuitable-frames): Deleted the
+ * ediff-wind.el (ediff-skip-unsuitable-frames): Delete the
redundant skip-small-frames test.
* viper-cmd.el (viper-change-state-to-vi): Disable overwrite mode.
(viper-downgrade-to-insert): Protect against errors in hooks.
- * viper-init.el (viper-vi-state-hook,viper-insert-state-hook)
- (viper-replace-state-hook,viper-emacs-state-hook): Do cursor handling.
- (viper-restore-cursor-type,viper-set-insert-cursor-type):
+ * viper-init.el (viper-vi-state-hook, viper-insert-state-hook)
+ (viper-replace-state-hook, viper-emacs-state-hook): Do cursor handling.
+ (viper-restore-cursor-type, viper-set-insert-cursor-type):
New functions.
* viper-util.el (viper-memq-char): Bug fixes.
@@ -8307,11 +8297,11 @@
* progmodes/ada-mode.el (ada-mode): Use it instead of
`ada-remove-trailing-spaces'.
- (ada-remove-trailing-spaces): Removed.
+ (ada-remove-trailing-spaces): Remove.
* textmodes/two-column.el (2C-merge): Recommend it in the doc.
- * textmodes/picture.el (picture-clean): Removed.
+ * textmodes/picture.el (picture-clean): Remove.
(picture-mode-exit): Call it instead of `picture-clean'.
2000-11-22 Gerd Moellmann <gerd@gnu.org>
@@ -8343,7 +8333,7 @@
(string-rectangle): Check delete-selection-mode.
* emacs-lisp/edebug.el (edebug-version)
- (edebug-maintainer-address): Deleted.
+ (edebug-maintainer-address): Delete.
(edebug-submit-bug-report): Just alias to report-emacs-bug.
(edebug-read-function): Account for other `'#' read forms.
(edebug-mode-menus): Make some items toggles.
@@ -8354,11 +8344,11 @@
* recentf.el (recentf-menu-items-for-commands)
(recentf-make-menu-items, recentf-make-menu-item)
- (recentf-filter-changer): Added :help and :active menu-item properties.
+ (recentf-filter-changer): Add :help and :active menu-item properties.
(recentf-build-dir-rules, recentf-dump-variable)
(recentf-edit-list, recentf-open-files-item)
- (recentf-open-files): Replaced unnecessary `mapcar' with new
+ (recentf-open-files): Replace unnecessary `mapcar' with new
built-in `mapc'.
2000-11-23 Miles Bader <miles@gnu.org>
@@ -8531,7 +8521,7 @@
since this function is only concerned with master state.
* vc-hooks.el (vc-workfile-unchanged-p)
- (vc-default-workfile-unchanged-p): Moved here from vc.el.
+ (vc-default-workfile-unchanged-p): Move here from vc.el.
* vc.el (vc-workfile-unchanged-p)
(vc-default-workfile-unchanged-p): See above.
@@ -8591,7 +8581,7 @@
(vc-cvs-print-log, vc-cvs-diff): Use asynchronous mode only for
remote repositories.
- * vc.el (vc-annotate): Changed handling of prefix arg; now asks
+ * vc.el (vc-annotate): Change handling of prefix arg; now asks
for both version and ratio in the minibuffer.
* vc-cvs.el (vc-cvs-annotate-command): New optional arg VERSION.
@@ -8648,7 +8638,7 @@
2000-11-15 Eli Zaretskii <eliz@is.elta.co.il>
- * textmodes/texinfo.el (texinfo-insert-@uref): Renamed from
+ * textmodes/texinfo.el (texinfo-insert-@uref): Rename from
texinfo-insert-@url.
(texinfo-insert-@url): A defalias for texinfo-insert-@uref.
(texinfo-mode-map): Bind "C-c C-c u" to texinfo-insert-@uref.
@@ -9040,9 +9030,9 @@
2000-11-06 Miles Bader <miles@lsi.nec.co.jp>
- * mwheel.el (mouse-wheel-scroll-amount): Renamed from
+ * mwheel.el (mouse-wheel-scroll-amount): Rename from
`mwheel-scroll-amount'.
- (mouse-wheel-follow-mouse): Renamed from `mwheel-follow-mouse'.
+ (mouse-wheel-follow-mouse): Rename from `mwheel-follow-mouse'.
(mouse-wheel-mode): Use (featurep 'xemacs) instead of
string-matching against the version string.
@@ -9060,7 +9050,7 @@
* international/mule-conf.el (compound-text): Define this coding
system here. Make x-ctext and ctext aliases of it.
- * language/european.el (compound-text, ctext): Moved to
+ * language/european.el (compound-text, ctext): Move to
international/mule-conf.el.
2000-11-05 Andrew Innes <andrewi@gnu.org>
@@ -9273,13 +9263,13 @@
(ps-color-device): Use `color-values' to determine if device
supports color.
(ps-color-values): Try to use `x-color-values' when using XEmacs.
- (ps-print-page-p): Changed from defsubst to defun.
- (ps-page-number): Changed from defmacro to defun.
+ (ps-print-page-p): Change from defsubst to defun.
+ (ps-page-number): Change from defmacro to defun.
(ps-header-sheet, ps-header-page): Fix bug on selected pages for
printing.
(ps-print-ensure-fontified): Ensure fontification when jit-lock is on.
(ps-end-file, ps-dummy-page): Funs eliminated.
- (ps-print-color-scale): Changed default value.
+ (ps-print-color-scale): Change default value.
(ps-page-n-up, ps-print-page-p): New internal vars.
(ps-print-preprint, ps-output, ps-begin-file, ps-begin-page)
(ps-plot-region, ps-generate, ps-end-job): Code fix.
@@ -9291,8 +9281,8 @@
2000-10-31 Kenichi Handa <handa@etl.go.jp>
* term/mac-win.el (decode-mac-roman, encode-mac-roman, mac-roman):
- Moved to european.el.
- (ccl-encode-mac-roman-font, fontset-mac): Modified for
+ Move to european.el.
+ (ccl-encode-mac-roman-font, fontset-mac): Modify for
mule-unicode-2500-33ff and mule-unicode-e000-ffff.
(mac-roman-kbd-insert, mac-roman-kbd-mode): These functions deleted.
(mac-roman-kbd-mode, mac-roman-kbd-mode-map): These variables deleted.
@@ -9337,7 +9327,7 @@
* international/mule-cmds.el (encode-coding-char): Check property
safe-chars instead of safe-charsets.
- * international/fontset.el (fontset-default): Modified for
+ * international/fontset.el (fontset-default): Modify for
mule-unicode-2500-33ff and mule-unicode-e000-ffff.
(x-font-name-charset-alist): Likewise.
(ccl-encode-unicode-font): New CCL program. Record it in
@@ -9377,7 +9367,7 @@
* eshell/esh-mode.el (window-height test): Make certain that
`eshell-stringify-t' is non-nil.
- (eshell-password-prompt-regexp): Changed to a much simpler
+ (eshell-password-prompt-regexp): Change to a much simpler
password regexp.
(eshell-send-input): If `eshell-invoke-directly' returns t,
directly invoke the parsed command using `eval'. This improves
@@ -9401,7 +9391,7 @@
(eshell-rewrite-if-command): Use `eshell-protect' to wrap the call
bodies.
(eshell-separate-commands): Whitespace fix.
- (eshell-complex-commands): Added a new list of names, for
+ (eshell-complex-commands): Add a new list of names, for
determining whether a given command is as simple as it looks.
(eshell-invoke-directly): New function. Returns t if a command
should be invoked directly (using `eval'), rather than indirectly
@@ -9411,10 +9401,10 @@
* eshell/em-unix.el (eshell-default-target-is-dot): New variable,
which provides an emulation of the DOS shell behavior of assuming
that cp/mv/ln should copy/move/link to the current directory.
- (eshell-remove-entries): Added a doc string.
- (eshell-shuffle-files): Removed the check for `target' being null.
- (eshell-mvcp-template, eshell-mvcpln-template): Renamed
- `eshell-mvcp-template' to `eshell-mvcpln-template', and extended
+ (eshell-remove-entries): Add a doc string.
+ (eshell-shuffle-files): Remove the check for `target' being null.
+ (eshell-mvcp-template, eshell-mvcpln-template):
+ Rename `eshell-mvcp-template' to `eshell-mvcpln-template', and extended
it to do a smarter check of whether a destination was provided.
(eshell/mv, eshell/cp): Enable `:preserve-args'.
(eshell/ln): Enable `:preserve-args', and use
@@ -9423,7 +9413,7 @@
(eshell/du, eshell/diff, eshell/locate): Stringify the argument
list after flattening it. This makes it possible to cat files
with numerical names.
- (eshell-unix-initialize): Added several names to
+ (eshell-unix-initialize): Add several names to
`eshell-complex-commands.
(eshell-unix-command-complex-p): Return t if a given command name
may result in external processes being invoked.
@@ -9438,12 +9428,12 @@
(eshell-refresh-windows): Use `if' instead of `when'.
(eshell-smart-scroll-window): Calling `save-current-buffer' was
not necessary.
- (eshell-currently-handling-window): Added a missing global variable.
+ (eshell-currently-handling-window): Add a missing global variable.
* eshell/em-ls.el (eshell-do-ls): Code simplification.
(eshell-ls-sort-entries, eshell-ls-entries, eshell-ls-dir):
Whitespace fix.
- (eshell-ls-exclude-hidden): Added this variable in addition to
+ (eshell-ls-exclude-hidden): Add this variable in addition to
`eshell-ls-exclude-regexp'. This one prevents files beginning
with . from even being read, which can improve memory consumption
quite a bit.
@@ -9451,7 +9441,7 @@
read file entries beginning with a dot. In home directories with
lots of hidden files, fully two-thirds of the time spent in ls is
used to read directory entries that are immediately thrown away.
- (eshell-ls-initial-args): Added back this configuration variable,
+ (eshell-ls-initial-args): Add back this configuration variable,
for specifying default initial arguments to every call to ls.
Much faster than using an alias to do the same thing.
(eshell-do-ls): Use `eshell-ls-initial-args', if set.
@@ -9460,7 +9450,7 @@
* eshell/em-dirs.el (eshell/pwd): Small code simplification.
* eshell/esh-util.el: Don't require `ange-ftp' if it's not available.
- (eshell-stringify-t): Added a customization variable, to indicate
+ (eshell-stringify-t): Add a customization variable, to indicate
whether `t' should be rendered as a string at all. If not, one
can still determine if the result of an expression is true using
"file-exists-p FILE && echo true".
@@ -9470,7 +9460,7 @@
* eshell/esh-module.el: Whitespace fix.
* eshell/em-alias.el (eshell-alias-initialize):
- Added `eshell-command-aliased-p' to `eshell-complex-commands'.
+ Add `eshell-command-aliased-p' to `eshell-complex-commands'.
(eshell-command-aliased-p): New function that returns t if a
command name names an aliased.
@@ -9484,12 +9474,12 @@
Use viper-preserve-cursor-color.
Many functions changed to use viper= instead of = when comparing
characters.
- * viper-util.el (viper-memq-char,viper=): New functions for
+ * viper-util.el (viper-memq-char, viper=): New functions for
working with characters.
- (viper-change-cursor-color): Fixed buglet.
+ (viper-change-cursor-color): Fix buglet.
Many functions changed to use viper= instead of = when comparing
characters.
- * viper.el (viper-insert-state-mode-list): Added eshell.
+ * viper.el (viper-insert-state-mode-list): Add eshell.
* ediff-init.el (ediff-before-setup-hook): New hook.
Several typos fixed in various docstrings.
@@ -9499,14 +9489,14 @@
* ediff-util.el (ediff-setup): Run ediff-before-setup-hook.
(ediff-other-buffer): Use selected buffers if in Buffer-menu buffer.
(ediff-get-selected-buffers): New function.
- * ediff-vers.el (ediff-vc-internal,ediff-rcs-internal)
- (ediff-vc-merge-internal,ediff-rcs-merge-internal):
+ * ediff-vers.el (ediff-vc-internal, ediff-rcs-internal)
+ (ediff-vc-merge-internal, ediff-rcs-merge-internal):
Use save-window-excursion.
* ediff-wind.el (ediff-skip-unsuitable-frames): More robust
termination check in while loop.
* ediff.el (ediff-get-default-file-name): Better defaults when in
dired buffer.
- (ediff-files,ediff-merge-files,ediff-files3)
+ (ediff-files, ediff-merge-files, ediff-files3)
(ediff-merge-files-with-ancestor): Use ediff-get-default-file-name.
2000-10-28 Dave Love <fx@gnu.org>
@@ -9722,7 +9712,7 @@
(delimit-columns-end): New vars.
(delimit-columns-customize, delimit-columns-format): New funs.
(delimit-columns-region, delimit-columns-rectangle)
- (delimit-columns-rectangle-line): Modified to support column
+ (delimit-columns-rectangle-line): Modify to support column
formatting.
2000-10-24 Dave Love <fx@gnu.org>
@@ -9830,9 +9820,9 @@
* woman.el (woman-italic-face, woman-bold-face)
(woman-unknown-face): Add dark-background variants.
- (woman-default-faces): Renamed from `woman-colour-faces'.
+ (woman-default-faces): Rename from `woman-colour-faces'.
Set using the stored defaults, rather than using hard-wired colors.
- (woman-monochrome-faces): Renamed from `woman-black-faces'.
+ (woman-monochrome-faces): Rename from `woman-black-faces'.
Just make the foreground `unspecified' rather than "black".
(woman-menu): Rename menu entries accordingly.
@@ -9875,13 +9865,13 @@
(vc-delete-automatic-version-backups, vc-make-version-backup):
New functions.
(vc-before-save): Use the latter.
- (vc-default-make-version-backups-p): Added `-p' suffix to avoid
+ (vc-default-make-version-backups-p): Add `-p' suffix to avoid
confusion.
- * vc-cvs.el (vc-cvs-make-version-backups-p): Added `-p' suffix as
+ * vc-cvs.el (vc-cvs-make-version-backups-p): Add `-p' suffix as
expected by vc[-hooks].el.
- * vc.el (vc-checkout): Added `-p' suffix in call to
+ * vc.el (vc-checkout): Add `-p' suffix in call to
vc-make-version-backups-p; use vc-make-version-backup to actually
make the backup.
(vc-version-other-window, vc-version-backup-file): Handle both
@@ -9892,7 +9882,7 @@
2000-10-22 Miles Bader <miles@gnu.org>
* comint.el (comint-highlight-input, comint-highlight-prompt):
- Renamed, `-face' at end removed.
+ Rename, `-face' at end removed.
(comint-send-input, comint-output-filter): Use renamed faces.
* window.el (fit-window-to-buffer): Change defaulting of
@@ -9999,7 +9989,7 @@
* dirtrack.el (dirtrack): Fix call to run-hooks.
- * cmuscheme.el (cmuscheme-program-name): Renamed from
+ * cmuscheme.el (cmuscheme-program-name): Rename from
scheme-program-name because xscheme.el contains a defcustom with
the same name. As a consequence, customizing group `cmuscheme'
loaded `xscheme' which redefined run-scheme.
@@ -10100,8 +10090,8 @@
2000-10-18 Miles Bader <miles@gnu.org>
- * comint.el (comint-delete-output): Renamed from `comint-kill-output'.
- (comint-kill-output): Changed into an alias for `comint-delete-output',
+ * comint.el (comint-delete-output): Rename from `comint-kill-output'.
+ (comint-kill-output): Change into an alias for `comint-delete-output',
and made obsolete.
(comint-mode-map): Rename references to comint-kill-output.
@@ -10123,7 +10113,7 @@
* diff-mode.el (diff-header-face, diff-file-header-face):
Add specific setting for dark background.
- (diff-context-face): Renamed from diff-comment-face.
+ (diff-context-face): Rename from diff-comment-face.
Set explicitly rather than inheriting from font-lock-comment-face.
2000-10-17 Eli Zaretskii <eliz@is.elta.co.il>
@@ -10194,7 +10184,7 @@
* eshell/em-unix.el, eshell/em-term.el, eshell/em-smart.el,
* eshell/em-script.el, eshell/em-rebind.el, eshell/em-prompt.el,
* eshell/em-pred.el, eshell/em-ls.el, eshell/em-hist.el,
- * eshell/em-glob.el, shell/em-dirs.el, eshell/em-cmpl.el,
+ * eshell/em-glob.el, eshell/em-dirs.el, eshell/em-cmpl.el,
* eshell/em-basic.el, eshell/em-banner.el, eshell/em-alias.el:
Add author information.
@@ -10218,7 +10208,7 @@
* whitespace.el: Doc fixes.
(top-level): Don't add hooks here.
- (whitespace-running-emacs): Deleted.
+ (whitespace-running-emacs): Delete.
(timer): Don't require.
(whitespace): Add back :version conditional on xemacs test.
(whitespace-spacetab-regexp, whitespace-indent-regexp)
@@ -10312,7 +10302,7 @@
2000-10-13 John Wiegley <johnw@gnu.org>
- * eshell/esh-util.el (require): Added a missing `require' form,
+ * eshell/esh-util.el (require): Add a missing `require' form,
needed when compiling (for an ange-ftp macro definition).
2000-10-13 Dave Love <fx@gnu.org>
@@ -10328,10 +10318,10 @@
2000-10-13 Stephen Gildea <gildea@stop.mail-abuse.org>
- * time-stamp.el (time-stamp): Fixed bug in new multi-line code
+ * time-stamp.el (time-stamp): Fix bug in new multi-line code
that breaks with old list format timestamps.
(time-stamp-warn-inactive, time-stamp-old-format-warn)
- (time-stamp-count, time-stamp-conversion-warn): Improved doc strings.
+ (time-stamp-count, time-stamp-conversion-warn): Improve doc strings.
2000-10-13 John Wiegley <johnw@gnu.org>
@@ -10343,7 +10333,7 @@
2000-10-13 John Wiegley <johnw@gnu.org>
- * desktop.el (desktop-buffer-modes-to-save): Added a global for
+ * desktop.el (desktop-buffer-modes-to-save): Add a global for
specifying what "other" kinds of buffers should be saved.
This used to be hard-coded.
(desktop-buffer-misc-functions): A global for specifying how
@@ -10355,7 +10345,7 @@
(desktop-buffer-info-misc-data): Aux function for determining Info
buffer auxiliary info.
(desktop-buffer-dired-misc-data): Likewise, but for dired buffers.
- (desktop-buffer-info): Changed this function to use the info
+ (desktop-buffer-info): Change this function to use the info
gathered above.
(desktop-create-buffer): Be a little more careful about what
`minor-mode' means before calling it. This is important for some
@@ -10373,7 +10363,7 @@
(eshell-ls-annotate): Use `eshell-file-attributes'.
(eshell-ls-file): Made the user-id printing code a bit smarter.
- * eshell/esh-util.el (eshell-ange-ls-uids): Added variable, to
+ * eshell/esh-util.el (eshell-ange-ls-uids): Add variable, to
allow identification of alias user ids in remote directories.
It's manual, but there's no other way to know when the current user
on the local machine, is also the owning user on the remote machine.
@@ -10396,7 +10386,7 @@
full-fledged FTP client, with much more manipulation ability than
most other clients.
- * eshell/em-unix.el (eshell-du-prefer-over-ange): Added a new
+ * eshell/em-unix.el (eshell-du-prefer-over-ange): Add a new
variable, which means that Eshell's du should always be preferred
in remote directories.
(eshell-shuffle-files): Use `eshell-file-attributes', rather than
@@ -10405,7 +10395,7 @@
when reading remote directories. This is an Eshell-specific
variable (not part of ange-ftp).
(eshell/ln): Bind `ange-cache'.
- (eshell/du): Added some extra logic for determining when to use
+ (eshell/du): Add some extra logic for determining when to use
Eshell's du (which is slow), and when to use the external version
(which may or may not exist).
@@ -10414,7 +10404,7 @@
`get-buffer-process', since backgrounded processes don't count in
the context of this function's logic.
- * eshell/esh-arg.el (eshell-parse-double-quote): Moved a call to
+ * eshell/esh-arg.el (eshell-parse-double-quote): Move a call to
`forward-char', so that null strings are parsed correctly.
2000-09-13 John Wiegley <johnw@gnu.org>
@@ -10481,7 +10471,7 @@
2000-10-12 Gerd Moellmann <gerd@gnu.org>
* startup.el (fancy-splash-screens): Don't add a pre-command hook.
- (fancy-splash-pre-command, fancy-splash-pending-command): Removed.
+ (fancy-splash-pre-command, fancy-splash-pending-command): Remove.
(command-line-1): Don't use fancy-splash-pending-command.
(fancy-splash-screens-1): Goto point-min after inserting text.
@@ -10643,7 +10633,7 @@
* progmodes/etags.el: Docstring fixes. Maintainer line updated.
(initialize-new-tags-table): Use run-hook-with-args-until-success.
(find-tag): Use pop-to-buffer if switch-to-buffer failed.
- (tags-table-format-functions): Renamed from tags-table-format-hooks.
+ (tags-table-format-functions): Rename from tags-table-format-hooks.
* vc.el (vc-version-diff): diff-switches can be a list.
Use relative filenames for prettier output.
@@ -10668,8 +10658,8 @@
(jit-lock-unregister): Don't bother handling complex hooks any more.
(jit-lock-refontify): New function.
(jit-lock-fontify-buffer): Use it.
- (jit-lock-function-1): Replaced by jit-lock-fontify-now.
- (jit-lock-fontify-now): Renamed from jit-lock-function-1.
+ (jit-lock-function-1): Replace by jit-lock-fontify-now.
+ (jit-lock-fontify-now): Rename from jit-lock-function-1.
Add optional args START and END.
Never call font-lock-fontify-region directly.
(jit-lock-function, jit-lock-stealth-fontify): Use it.
@@ -10691,9 +10681,9 @@
* play/spook.el (spook-phrases-file): Use expand-file-name, not
concat.
- * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): Don't
- insist on symbols starting with word syntax.
- (lisp-mode-shared-map): Renamed from shared-lisp-mode-map.
+ * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression):
+ Don't insist on symbols starting with word syntax.
+ (lisp-mode-shared-map): Rename from shared-lisp-mode-map.
(eval-defun-1): Doc fix.
(indent-sexp): Use nconc to build up indent-stack.
@@ -10742,8 +10732,8 @@
2000-10-08 Eli Zaretskii <eliz@is.elta.co.il>
- * international/titdic-cnv.el (quail-cxterm-package-ext-info): Fix
- typos in doc strings.
+ * international/titdic-cnv.el (quail-cxterm-package-ext-info):
+ Fix typos in doc strings.
* font-lock.el (font-lock-mode, global-font-lock-mode): Mention in
the doc strings how to customize Font Lock faces.
@@ -10856,7 +10846,7 @@
* net/net-utils.el (nslookup-prompt-regexp, ftp-prompt-regexp)
(smbclient-prompt-regexp): Add usage note to doc string.
- (ftp-font-lock-keywords, smbclient-font-lock-keywords): Removed.
+ (ftp-font-lock-keywords, smbclient-font-lock-keywords): Remove.
(ftp-mode, smbclient-mode): Don't set `font-lock-defaults'.
Use add-hook for adding the comint filter function, and only do so
if it's not already in the global hook list.
@@ -10983,8 +10973,8 @@
2000-10-04 Andre Spiegel <spiegel@gnu.org>
- * vc-hooks.el (vc-before-save, vc-default-make-version-backups,
- vc-version-backup-file-name): New functions.
+ * vc-hooks.el (vc-before-save, vc-default-make-version-backups)
+ (vc-version-backup-file-name): New functions.
* files.el (basic-save-buffer): Call vc-before-save before saving.
@@ -11012,7 +11002,7 @@
(ftp-font-lock-keywords, smbclient-font-lock-keywords):
Only set if window-system is non-nil.
(net-utils-run-program): Returns buffer.
- (network-connection-reconnect): Added this function.
+ (network-connection-reconnect): Add this function.
* generic.el:
Incorporates extensive cleanup and docfixes by
@@ -11021,16 +11011,16 @@
(generic-mode-name, generic-comment-list)
(generic-keywords-list, generic-font-lock-expressions)
(generic-mode-function-list, generic-mode-syntax-table):
- Removed variables.
- (generic-mode-alist): Renamed to generic-mode-list.
+ Remove variables.
+ (generic-mode-alist): Rename to generic-mode-list.
(generic-find-file-regexp): Default changed to "^#".
(generic-read-type): Uses completing read on generic-mode-list.
- (generic-mode-sanity-check): Removed this function.
- (generic-add-to-auto-mode): Removed this function.
+ (generic-mode-sanity-check): Remove this function.
+ (generic-add-to-auto-mode): Remove this function.
(generic-mode-internal): Bind mode-specific definitions
into function instead of putting them in alist.
- (generic-mode-set-comments): Reworked extensively.
- (generic-mode-find-file-hook): Simplified regexp searching.
+ (generic-mode-set-comments): Rework extensively.
+ (generic-mode-find-file-hook): Simplify regexp searching.
(generic-make-keywords-list): Omit extra pair of parens.
* find-lisp.el (find-lisp-find-files-internal):
@@ -11038,13 +11028,13 @@
* generic-x.el (apache-conf-generic-mode):
Regexp now allows leading whitespace.
- (rc-generic-mode): Added eval-when-compile
+ (rc-generic-mode): Add eval-when-compile
around generic-make-keywords-list.
Deleted duplicate regexp.
- (rul-generic-mode): Added eval-when-compile
+ (rul-generic-mode): Add eval-when-compile
around generic-make-keywords-list.
(etc-fstab-generic-mode): New generic mode.
- (rul-generic-mode): Removed one eval-when-compile
+ (rul-generic-mode): Remove one eval-when-compile
which caused a max-specpdl-size exceeded error.
2000-10-04 Miles Bader <miles@gnu.org>
@@ -11094,7 +11084,7 @@
* isearch.el (isearch-faces): New custom group.
(isearch): New defface; was already tested for in the code.
- (isearch-lazy-highlight-face): Changed to defface from defcustom.
+ (isearch-lazy-highlight-face): Change to defface from defcustom.
(isearch-highlight): Always use face `isearch'.
2000-10-02 Dave Love <fx@gnu.org>
@@ -11165,14 +11155,14 @@
is visited.
(vc-start-entry): New argument initial-contents. Don't visit the file
if it isn't already visited. Brought documentation up-to-date.
- (vc-next-action, vc-register): Updated calls to vc-start-entry.
+ (vc-next-action, vc-register): Update calls to vc-start-entry.
(vc-checkin): New optional arg initial-contents, which is passed to
vc-start-entry.
(vc-finish-logentry): Make sure to bury log buffer only if there
really is one. Call `vc-resynch-buffer' on log-file, not
buffer-file-name.
(vc-default-comment-history, vc-default-wash-log): New functions.
- (vc-index-of): Removed.
+ (vc-index-of): Remove.
(vc-transfer-file): Make do without the above.
(vc-default-receive-file): Call comment-history unconditionally. Pass
the resulting string to vc-checkin, instead of inserting it into the
@@ -11185,8 +11175,8 @@
2000-10-01 Miles Bader <miles@gnu.org>
- * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): Call
- `recenter' with an arg to prevent redrawing the display.
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
+ Call `recenter' with an arg to prevent redrawing the display.
2000-09-30 Stefan Monnier <monnier@cs.yale.edu>
@@ -11201,7 +11191,7 @@
(latex-imenu-create-index): Use it.
Move the regexp construction outside loops (and use push).
(tex-font-lock-keywords-1, tex-font-lock-keywords-2)
- (tex-font-lock-keywords): Moved from font-lock.el.
+ (tex-font-lock-keywords): Move from font-lock.el.
(tex-comment-indent): Remove.
(tex-common-initialization): Don't set comment-indent-function.
(latex-block-default): New var.
@@ -11277,7 +11267,7 @@
2000-09-29 Miles Bader <miles@gnu.org>
* image-file.el (image-file-name-extensions): New variable.
- (image-file-name-regexps): Renamed from `image-file-regexps'.
+ (image-file-name-regexps): Rename from `image-file-regexps'.
New default value is nil. Call `auto-image-file-mode'.
(image-file-name-regexp): New function.
(auto-image-file-mode): New minor mode.
@@ -11557,9 +11547,9 @@
type.
(cperl-mode): Set normal-auto-fill-function and don't zap
auto-fill-function.
- (cperl-imenu--function-name-regexp-perl): Renamed from
+ (cperl-imenu--function-name-regexp-perl): Rename from
imenu-example--function-name-regexp-perl.
- (cperl-imenu--create-perl-index): Renamed from
+ (cperl-imenu--create-perl-index): Rename from
imenu-example--create-perl-index.
(cperl-xsub-scan): Don't require cl.
@@ -11628,8 +11618,8 @@
2000-09-20 Dave Love <fx@gnu.org>
* iswitchb.el: Some doc fixes.
- (iswitchb-mode-map): Define completely initially. Inherit
- minibuffer-local-map.
+ (iswitchb-mode-map): Define completely initially.
+ Inherit minibuffer-local-map.
(iswitchb-completion-help) <!iswitchb-xemacs>: Use
fundamental-mode.
(iswitchb-global-map): New variable.
@@ -11714,7 +11704,7 @@
* toolbar/tool-bar.el: Renamed from toolbar.el.
Change `toolbar' to `tool-bar' generally in symbols.
Make some items invisible in `special' major modes.
- (tool-bar-add-item-from-menu): Renamed from toolbar-like-menu-item.
+ (tool-bar-add-item-from-menu): Rename from toolbar-like-menu-item.
Add arg PROPS.
* startup.el (fancy-splash-screen) <defgroup>: Fix syntax.
@@ -11872,8 +11862,8 @@
* strokes.el: Sync with maintainer's current version with changes
for Emacs, but avoid runtime cl and levents.
(toplevel): Change autoloads and compilation requires.
- (strokes-version, strokes-bug-address, strokes-lift): Values
- changed.
+ (strokes-version, strokes-bug-address, strokes-lift):
+ Values changed.
(strokes-xpm-header, strokes-insinuated): New variable.
(strokes): Add :link.
(strokes-mode): Customized.
@@ -11900,8 +11890,8 @@
(strokes-xpm-encode-length-as-string, strokes-xpm-decode-char)
(strokes-xpm-to-compressed-string, strokes-decode-buffer)
(strokes-encode-buffer, strokes-xpm-for-compressed-string)
- (strokes-compose-complex-stroke, strokes-alphabetic-lessp): New
- functions.
+ (strokes-compose-complex-stroke, strokes-alphabetic-lessp):
+ New functions.
2000-09-15 Gerd Moellmann <gerd@gnu.org>
@@ -11954,10 +11944,10 @@
2000-09-14 Alex Schroeder <alex@gnu.org>
* ansi-color.el (ansi-colors): Doc change.
- (ansi-color-get-face): Simplified regexp.
- (ansi-color-faces-vector): Added more faces, doc change.
+ (ansi-color-get-face): Simplify regexp.
+ (ansi-color-faces-vector): Add more faces, doc change.
(ansi-color-names-vector): Doc change.
- (ansi-color-regexp): Simplified regexp.
+ (ansi-color-regexp): Simplify regexp.
(ansi-color-parameter-regexp): New regexp.
(ansi-color-filter-apply): Doc change.
(ansi-color-filter-region): Doc change.
@@ -11965,11 +11955,11 @@
deal with zero length parameters.
(ansi-color-apply-on-region): Doc change.
(ansi-color-map): Doc change.
- (ansi-color-map-update): Removed debugging message.
- (ansi-color-get-face-1): Added condition-case to trap
+ (ansi-color-map-update): Remove debugging message.
+ (ansi-color-get-face-1): Add condition-case to trap
args-out-of-range errors.
(ansi-color-get-face): Doc change.
- (ansi-color-make-face): Removed.
+ (ansi-color-make-face): Remove.
(ansi-color-for-shell-mode): New option.
2000-09-13 Kenichi Handa <handa@etl.go.jp>
@@ -12032,25 +12022,25 @@
2000-09-12 Kenichi Handa <handa@etl.go.jp>
- * international/quail.el (quail-define-package): Docstring
- modified.
+ * international/quail.el (quail-define-package):
+ Docstring modified.
2000-09-12 Kenichi Handa <handa@etl.go.jp>
- * international/titdic-cnv.el (quail-cxterm-package-ext-info): Add
- extra docstrings for "chinese-ccdospy", "chinese-ecdict",
+ * international/titdic-cnv.el (quail-cxterm-package-ext-info):
+ Add extra docstrings for "chinese-ccdospy", "chinese-ecdict",
"chinese-etzy", "chinese-sw", and "chinese-ziranma". Modify the
docstring of "chinese-py".
- * international/quail.el (quail-translation-docstring): New
- variable.
+ * international/quail.el (quail-translation-docstring):
+ New variable.
(quail-show-keyboard-layout): Docstring modified.
(quail-select-current): Likewise.
(quail-build-decode-map): Change arg MAP to MAP-LIST to avoid
infinite recursive call.
(quail-help): Check quail-translation-docstring. Format of the
output changed.
- (quail-help-insert-keymap-description): Adjusted for the above
+ (quail-help-insert-keymap-description): Adjust for the above
change.
2000-09-11 Gerd Moellmann <gerd@gnu.org>
@@ -12161,7 +12151,7 @@
2000-09-07 Kenichi Handa <handa@etl.go.jp>
- * help.el (help-make-xrefs): Adjusted for the change of
+ * help.el (help-make-xrefs): Adjust for the change of
help-xref-mule-regexp.
(help-insert-xref-button): New function.
@@ -12215,10 +12205,10 @@
(vc-merge): Use RET for first version to trigger merge-news, not
prefix arg.
(vc-annotate): Handle backends that do not support annotation.
- (vc-default-merge-news): Removed. The existence of a merge-news
+ (vc-default-merge-news): Remove. The existence of a merge-news
implementation is now checked on caller sites.
- * vc-hooks.el (vc-default-mode-line-string): Removed CVS special
+ * vc-hooks.el (vc-default-mode-line-string): Remove CVS special
case.
* vc-cvs.el (vc-cvs-mode-line-string): New function, handles the
@@ -12237,11 +12227,11 @@
(vc-after-save): Call `vc-dired-resynch-file' only if vc is loaded.
* vc.el: Require dired-aux during compilation.
- (vc-name-assoc-file): Moved to vc-sccs.el.
+ (vc-name-assoc-file): Move to vc-sccs.el.
(with-vc-properties): New macro.
- (vc-checkin, vc-checkout, vc-revert, vc-cancel-version,
- vc-finish-steal): Use it.
- (vc-cancel-version): Moved RCS-specific code to vc-rcs.el. The call
+ (vc-checkin, vc-checkout, vc-revert, vc-cancel-version)
+ (vc-finish-steal): Use it.
+ (vc-cancel-version): Move RCS-specific code to vc-rcs.el. The call
to the backend-specific function is now supposed to do the checkout,
too.
(vc-log-edit): Handle FILE being nil and added a FIXME for log-edit.
@@ -12249,15 +12239,15 @@
* vc-cvs.el (vc-cvs-checkin, vc-cvs-checkout): Don't bother to
set file properties; that gets done in the generic code now.
- * vc-rcs.el (vc-rcs-uncheck): Renamed to `vc-rcs-cancel-version'.
+ * vc-rcs.el (vc-rcs-uncheck): Rename to `vc-rcs-cancel-version'.
Changed parameter list, added code from vc.el that does the
checkout, possibly with a double-take.
- * vc-sccs.el (vc-sccs-name-assoc-file): Moved here from vc.el.
- (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple): Use
- the above under the new name.
- (vc-sccs-uncheck): Renamed to `vc-sccs-cancel-version'. Changed
- parameter list, added checkout command.
+ * vc-sccs.el (vc-sccs-name-assoc-file): Move here from vc.el.
+ (vc-sccs-add-triple, vc-sccs-rename-file, vc-sccs-lookup-triple):
+ Use the above under the new name.
+ (vc-sccs-uncheck): Rename to `vc-sccs-cancel-version'.
+ Changed parameter list, added checkout command.
(vc-sccs-checkin, vc-sccs-checkout): Don't bother to set file
properties; that gets done in the generic code now.
@@ -12298,8 +12288,8 @@
* sql.el (sql-mode-menu): Work around missing variable mark-active
in XEmacs.
- (sql-mode): Added call to easy-menu-add for XEmacs compatibility.
- (sql-interactive-mode): Added call to easy-menu-add for XEmacs
+ (sql-mode): Add call to easy-menu-add for XEmacs compatibility.
+ (sql-interactive-mode): Add call to easy-menu-add for XEmacs
compatibility.
2000-09-04 Gerd Moellmann <gerd@gnu.org>
@@ -12349,8 +12339,8 @@
(vc-default-could-register): New function.
(vc-dired-buffers-for-dir, vc-dired-resynch-file): New functions.
(vc-resynch-buffer): Call vc-dired-resynch-file.
- (vc-start-entry, vc-finish-logentry, vc-revert-buffer): Use
- vc-resynch-buffer instead of vc-resynch-window.
+ (vc-start-entry, vc-finish-logentry, vc-revert-buffer):
+ Use vc-resynch-buffer instead of vc-resynch-window.
(vc-next-action-dired): Don't redisplay here, that gets done as a
result of the individual file operations.
(vc-retrieve-snapshot): Corrected prompt order.
@@ -12359,8 +12349,8 @@
* vc-cvs.el (vc-cvs-stay-local): Allow it to be a hostname regexp
as well.
- (vc-cvs-remote-p): Renamed to vc-cvs-stay-local-p. Handle
- hostname regexps. Updated all callers.
+ (vc-cvs-remote-p): Rename to vc-cvs-stay-local-p.
+ Handle hostname regexps. Updated all callers.
(vc-cvs-responsible-p): Handle directories as well.
(vc-cvs-could-register): New function.
(vc-cvs-retrieve-snapshot): Parse "cvs update" output, keep file
@@ -12397,7 +12387,7 @@
(vc-dired-mode-map): Inherit from dired-mode-map.
(vc-dired-mode): Local value of dired-move-to-filename-regexp
simplified.
- (vc-dired-state-info): Removed, updated caller.
+ (vc-dired-state-info): Remove, updated caller.
(vc-default-dired-state-info): Use parentheses instead of hyphens.
(vc-dired-hook): Use vc-BACKEND-dir-state, if available.
(vc-dired-listing-switches): New variable.
@@ -12438,14 +12428,14 @@
* vc.el (vc-next-action-on-file): Corrected several messages.
(vc-merge): Add prefix arg `merge-news'; handle it.
- * vc-cvs.el (vc-cvs-workfile-version): Removed comment that this
+ * vc-cvs.el (vc-cvs-workfile-version): Remove comment that this
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-*.el (vc-*-checkout): Switch off coding systems for checkout
- via stdout. (Merge from main line.)
+ * vc-cvs.el, vc-rcs.el, vc-sccs.el (vc-*-checkout): Switch off
+ coding systems for checkout via stdout. (Merge from main line.)
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
@@ -12466,9 +12456,9 @@
(vc-new-comment-index): New function.
(vc-previous-comment): Use it. Make the minibuffer message
slightly less terse.
- (vc-comment-search-reverse): Make it work forward as well. Don't
- set vc-comment-ring-index if no match is found. Use
- vc-new-comment-index.
+ (vc-comment-search-reverse): Make it work forward as well.
+ Don't set vc-comment-ring-index if no match is found.
+ Use vc-new-comment-index.
(vc-comment-search-forward): Use vc-comment-search-reverse.
(vc-dired-mode-map): Don't inherit from dired-mode-map since
define-derived-mode will do it for us. Bind `v' to a keymap that
@@ -12492,7 +12482,7 @@
(vc-cvs-stay-local): Default to t.
(vc-cvs-remote-p): New function and property.
(vc-cvs-state): Stay local only if the above is t.
- (vc-handle-cvs): Removed.
+ (vc-handle-cvs): Remove.
(vc-cvs-registered): Don't check vc-handle-cvs -- it should all be
done via vc-handled-backends now.
(vc-cvs-header): Escape Id.
@@ -12509,10 +12499,10 @@
* vc.el (vc-exec-after): Fix disassembly of previous sentinel.
(vc-print-log): Search current revision from beginning of buffer.
(vc-revert-buffer): Clear echo area after the diff is finished.
- (vc-prefix-map): Removed definition of "t" for terse display in vc
+ (vc-prefix-map): Remove definition of "t" for terse display in vc
dired.
- (vc-dired-mode-map): Inherit from dired-mode-map. Added
- definition of "vt" for terse display.
+ (vc-dired-mode-map): Inherit from dired-mode-map.
+ Added definition of "vt" for terse display.
(vc-dired-mode): Fix dired-move-to-filename-regexp.
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
@@ -12530,11 +12520,11 @@
(vc-print-log): Use vc-exec-after and use log-view-goto-rev if
present.
- * vc-sccs.el (vc-sccs-state-heuristic): Use
- file-ownership-preserved-p.
+ * vc-sccs.el (vc-sccs-state-heuristic):
+ Use file-ownership-preserved-p.
- * vc-rcs.el (vc-rcs-state-heuristic): Use
- file-ownership-preserved-p.
+ * vc-rcs.el (vc-rcs-state-heuristic):
+ Use file-ownership-preserved-p.
(vc-rcs-checkout): Remove the error-handling for missing-rcs.
2000-09-04 Andre Spiegel <spiegel@gnu.org>
@@ -12563,11 +12553,11 @@
current buffer without any fuss'.
(vc-version-diff): Change the `diff' backend operation to just put
the diff in the current buffer without erasing it. Always use
- *vc-diff* even for directory-diffs. Use vc-setup-buffer. Protect
- shrink-window-if-larger-than-buffer.
+ *vc-diff* even for directory-diffs. Use vc-setup-buffer.
+ Protect shrink-window-if-larger-than-buffer.
(vc-print-log): Change the `print-log' backend operation to just
- put the log in the current buffer without erasing it. Protect
- shrink-window-if-larger-than-buffer.
+ put the log in the current buffer without erasing it.
+ Protect shrink-window-if-larger-than-buffer.
(vc-update-change-log): Fix setd typo.
* vc-sccs.el (vc-sccs-workfile-unchanged-p): Fix parenthesis.
@@ -12577,8 +12567,8 @@
(vc-rcs-diff): Insert in the current buffer and remove unused arg
CMP.
- * vc-cvs.el (vc-cvs-state, vc-cvs-fetch-status): Use
- with-temp-file. Use the new BUFFER=t argument to vc-do-command.
+ * vc-cvs.el (vc-cvs-state, vc-cvs-fetch-status):
+ Use with-temp-file. Use the new BUFFER=t argument to vc-do-command.
(vc-cvs-print-log, vc-cvs-diff): Insert in the current buffer.
2000-09-04 Andre Spiegel <spiegel@gnu.org>
@@ -12588,13 +12578,13 @@
(vc-default-workfile-unchanged-p): New function. Delegates to a
full vc-BACKEND-diff.
- * vc-hooks.el (vc-simple-command): Removed.
+ * vc-hooks.el (vc-simple-command): Remove.
* vc-rcs.el (vc-rcs-workfile-unchanged-p): Use vc-do-command
instead of vc-simple-command.
- (vc-rcs-fetch-master-state): Removed check for unlocked-changes to
+ (vc-rcs-fetch-master-state): Remove check for unlocked-changes to
avoid doing a diff when opening a file.
- (vc-rcs-state): Added check for unlocked-changes.
+ (vc-rcs-state): Add check for unlocked-changes.
(vc-rcs-header): Escape Id.
(vc-rcs-workfile-unchanged-p): Remove optional arg VERSION.
(vc-rcs-state): Call vc-workfile-unchanged-p, not the RCS-specific
@@ -12610,7 +12600,7 @@
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
- * vc.el (vc-editable-p): Renamed from vc-writable-p.
+ * vc.el (vc-editable-p): Rename from vc-writable-p.
(with-vc-file, vc-merge): Use vc-editable-p.
(vc-do-command): Remove unused var vc-file and fix the
doubly-defined `status' var. Add a user message when starting an
@@ -12684,8 +12674,8 @@
way the function itself works.
(vc-file-owner): Remove.
- * vc-cvs.el (vc-cvs-registered): Use with-temp-buffer. Reorder
- extraction of fields and call to file-attributes because of a
+ * vc-cvs.el (vc-cvs-registered): Use with-temp-buffer.
+ Reorder extraction of fields and call to file-attributes because of a
temporary bug in rcp.el.
(vc-cvs-fetch-status): Use with-current-buffer.
@@ -12705,21 +12695,22 @@
(vc-backend): Reintroduce the test for `file = nil' now that I
know why it was there (and added a comment to better remember).
- * vc-sccs-hooks.el: Merge into vc-sccs.el * vc-sccs.el: Merge in
- code from vc-sccs-hooks.el.
+ * vc-sccs-hooks.el: Merge into vc-sccs.el
+ * vc-sccs.el: Merge in code from vc-sccs-hooks.el.
(vc-sccs-release, vc-sccs-system-release): Remove. Don't require
'vc anymore.
(vc-sccs-responsible-p): Use expand-file-name instead of concat
and file-directory-p instead of file-exists-p.
(vc-sccs-check-headers): Simplify the regexp.
- * vc-rcs-hooks.el: Merge into vc-rcs.el * vc-rcs.el: Merge in code
- from vc-rcs-hooks.el. Don't require 'vc anymore.
+ * vc-rcs-hooks.el: Merge into vc-rcs.el
+ * vc-rcs.el: Merge in code from vc-rcs-hooks.el.
+ Don't require 'vc anymore.
(vc-rcs-responsible-p): Use expand-file-name instead of concat and
file-directory-p instead of file-exists-p.
- * vc-cvs-hooks.el: Merge into vc-cvs.el * vc-cvs.el: Merge in code
- from vc-cvs-hooks.el.
+ * vc-cvs-hooks.el: Merge into vc-cvs.el
+ * vc-cvs.el: Merge in code from vc-cvs-hooks.el.
(proto vc-cvs-registered): Require 'vc-cvs instead of
'vc-cvs-hooks. Don't require 'vc anymore.
(vc-cvs-responsible-p): Use expand-file-name instead of concat and
@@ -12735,8 +12726,8 @@
* vc-rcs.el (vc-rcs-exists): Remove.
(vc-rcs-header): New var.
- * vc-sccs.el (vc-sccs-responsible-p, vc-sccs-register): Use
- `vc-sccs-search-project-dir' instead of `vc-sccs-project-dir'.
+ * vc-sccs.el (vc-sccs-responsible-p, vc-sccs-register):
+ Use `vc-sccs-search-project-dir' instead of `vc-sccs-project-dir'.
(vc-sccs-header): New var.
* vc.el (vc-do-command): Get rid of the `last' argument.
@@ -12770,8 +12761,8 @@
(vc-cancel-version): prettify error message with \\[...].
(vc-rename-master): New function.
(vc-rename-file): Use vc-BACKEND-rename-file (which might in turn
- use vc-rename-master) instead of vc-BACKEND-record-rename. Make
- the CVS special case generic.
+ use vc-rename-master) instead of vc-BACKEND-record-rename.
+ Make the CVS special case generic.
(vc-default-record-rename): Remove.
(vc-file-tree-walk-internal): Only call FUNC for files that are
under control of some VC backend and replace `concat' with
@@ -12780,7 +12771,7 @@
(vc-version-diff, vc-snapshot-precondition, vc-create-snapshot)
(vc-retrieve-snapshot): Update call to vc-file-tree-walk.
- * vc-sccs.el (vc-sccs-rename-file): Renamed from
+ * vc-sccs.el (vc-sccs-rename-file): Rename from
vc-sccs-record-rename. Use `find-file-noselect' rather than
`find-file' and call `vc-rename-master' to do the actual move.
(vc-sccs-diff): Remove unused `backend' variable.
@@ -12842,7 +12833,7 @@
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
- * vc.el (vc-locking-user): Moved from vc-hooks.el.
+ * vc.el (vc-locking-user): Move from vc-hooks.el.
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
@@ -12853,11 +12844,10 @@
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
- * vc-rcs-hooks.el (vc-rcs-templates-grabbed,
- vc-rcs-grab-templates)
+ * vc-rcs-hooks.el (vc-rcs-templates-grabbed, vc-rcs-grab-templates)
(vc-rcs-registered): Remove. The default function works as well.
- * vc-sccs-hooks.el (vc-sccs-templates-grabbed,
- vc-sccs-grab-templates)
+ * vc-sccs-hooks.el (vc-sccs-templates-grabbed)
+ (vc-sccs-grab-templates)
(vc-sccs-registered): Remove. The default function works as well.
* vc.el (vc-version-diff): Left out a vc- in call to
@@ -12869,9 +12859,9 @@
using the default function.
(vc-call-backend): If calling the default function, pass it the
backend as first argument. Update the docstring accordingly.
- (vc-default-state-heuristic, vc-default-mode-line-string): Update
- for the new backend argument.
- (vc-make-backend-sym): Renamed from vc-make-backend-function.
+ (vc-default-state-heuristic, vc-default-mode-line-string):
+ Update for the new backend argument.
+ (vc-make-backend-sym): Rename from vc-make-backend-function.
(vc-find-backend-function): Use the new name.
(vc-default-registered): New function.
@@ -12937,8 +12927,8 @@
2000-09-04 Andre Spiegel <spiegel@gnu.org>
- * vc.el (vc-file-clear-masterprops): Removed.
- (vc-checkin, vc-revert-buffer): Removed calls to the above.
+ * vc.el (vc-file-clear-masterprops): Remove.
+ (vc-checkin, vc-revert-buffer): Remove calls to the above.
(vc-version-diff): Use buffer-size without argument.
(vc-register): Heed vc-initial-comment.
@@ -12947,12 +12937,12 @@
* vc-rcs.el (vc-rcs-register): Parse command output to find master
file name and workfile version.
- (vc-rcs-checkout): Removed call to vc-file-clear-masterprops.
+ (vc-rcs-checkout): Remove call to vc-file-clear-masterprops.
- * vc-cvs.el (vc-cvs-merge-news, vc-cvs-checkout): Removed call to
+ * vc-cvs.el (vc-cvs-merge-news, vc-cvs-checkout): Remove call to
vc-file-clear-masterprops.
- * vc-sccs.el (vc-sccs-checkout): Removed call to
+ * vc-sccs.el (vc-sccs-checkout): Remove call to
vc-file-clear-masterprops. If writable, set vc-state to 'edited
rather than user login name.
@@ -12979,7 +12969,7 @@
2000-09-04 Andre Spiegel <spiegel@gnu.org>
* vc.el (with-vc-file, vc-next-action, vc-version-diff)
- (vc-dired-mark-locked): Replaced usage of vc-locking-user with
+ (vc-dired-mark-locked): Replace usage of vc-locking-user with
vc-state or vc-up-to-date-p.
(vc-merge): Use vc-backend-defines to check whether merging is
possible. Set state to 'edited after successful merge.
@@ -12998,7 +12988,7 @@
`vc-locking-user' semantics.
(vc-backend-merge): Remove.
- * vc-rcs.el, vc-scc.el (vc-{sc,r}cs-check{in,out}): Update 'vc-state
+ * vc-rcs.el, vc-sccs.el (vc-{sc,r}cs-check{in,out}): Update 'vc-state
rather than 'vc-locking-user.
* vc-rcs-hooks.el (vc-rcs-consult-headers): Adapt to new `vc-state'.
@@ -13025,25 +13015,25 @@
* vc-cvs.el (vc-cvs-print-log, vc-cvs-diff): Run cvs asynchronously.
* vc.el (vc-do-command): kill-all-local-variables, to reset any
- major-mode in which the buffer might have been put earlier. Use
- `remove' and `when'. Allow `okstatus' to be `async' and use
+ major-mode in which the buffer might have been put earlier.
+ Use `remove' and `when'. Allow `okstatus' to be `async' and use
`start-process' in this case.
(vc-version-diff): Handle the case where the diff looks empty
because of the use of an async process.
2000-09-04 Andre Spiegel <spiegel@gnu.org>
- * vc.el (vc-next-action-on-file): Removed optional parameter
+ * vc.el (vc-next-action-on-file): Remove optional parameter
`simple'. Recompute state unconditionally.
- (vc-default-toggle-read-only): Removed.
+ (vc-default-toggle-read-only): Remove.
- * vc-hooks.el (vc-backend-functions): Removed vc-toggle-read-only.
+ * vc-hooks.el (vc-backend-functions): Remove vc-toggle-read-only.
(vc-toggle-read-only): Undid prev change.
- * vc-cvs.el (vc-cvs-stay-local): Renamed from
+ * vc-cvs.el (vc-cvs-stay-local): Rename from
vc-cvs-simple-toggle. Redocumented.
(vc-cvs-state): If locality is wanted, use vc-cvs-state-heuristic.
- (vc-cvs-toggle-read-only): Removed.
+ (vc-cvs-toggle-read-only): Remove.
2000-09-04 Stefan Monnier <monnier@cs.yale.edu>
@@ -13061,7 +13051,7 @@
(vc-dired-mode-map): Properly defvar it.
(vc-print-log): Call log-view-mode if available.
(small-temporary-file-directory): defvar instead of use boundp.
- (vc-merge-news): Moved to vc-cvs.el.
+ (vc-merge-news): Move to vc-cvs.el.
(vc-default-merge-news): New function.
* vc-sccs.el: Require 'vc and 'vc-sccs-hooks.
@@ -13079,13 +13069,13 @@
(vc-rcs-trunk-p, vc-rcs-branch-part): Move to vc-rcs-hooks.
(vc-rcs-backend-release-p): Remove (use vc-rcs-release-p).
(vc-release-greater-or-equal-p): Move from vc.
- (vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part,
- vc-rcs-minor-part, vc-rcs-previous-version): Remove duplicates.
+ (vc-rcs-trunk-p, vc-rcs-branch-p, vc-rcs-branch-part)
+ (vc-rcs-minor-part, vc-rcs-previous-version): Remove duplicates.
(vc-rcs-checkout): Add a missing `new-version' argument in the
call to vc-rcs-latest-on-branch-p. Hopefully that was the right one.
* vc-rcs-hooks.el: Provide 'vc-rcs-hooks.
- (vc-rcs-trunk-p, vc-rcs-branch-part): Moved from vc-rcs.el.
+ (vc-rcs-trunk-p, vc-rcs-branch-part): Move from vc-rcs.el.
(vc-rcs-latest-on-branch-p): Use the `version' argument rather
than the apparently unbound `workfile-version'.
@@ -13126,8 +13116,8 @@
* vc-cvs.el (vc-cvs-checkout): Docstring fix. Added a `(if
workfile' that got lost when the code was extracted from vc.el.
And merged the tail with the rest of the code (not possible in the
- old vc.el where the tail was shared among all backends). And
- explicitly set the state to 'edited if `writable' is set.
+ old vc.el where the tail was shared among all backends).
+ And explicitly set the state to 'edited if `writable' is set.
* vc-cvs-hooks.el (vc-cvs-registered): Use expand-file-name.
(vc-cvs-state): Be careful to return the value from
@@ -13138,71 +13128,71 @@
workfile was nil).
* vc.el: Removed those pesky unnecessary `(function' quotes.
- (vc-annotate-mode-map, vc-annotate-mode-syntax-table): Initialize
- directly in the defvar.
+ (vc-annotate-mode-map, vc-annotate-mode-syntax-table):
+ Initialize directly in the defvar.
(vc-do-command): Bind inhibit-read-only so as to properly handle
the case where the destination buffer has been made read-only.
(vc-diff): Delegate to vc-version-diff in all cases.
(vc-version-diff): Setup the *vc-diff* buffer as was done in vc-diff.
- (vc-annotate-mode-variables): Removed (code moved partly to
+ (vc-annotate-mode-variables): Remove (code moved partly to
defvars and partly to vc-annotate-add-menu).
(vc-annotate-mode): Turned into a derived-mode.
- (vc-annotate-add-menu): Moved in code in
+ (vc-annotate-add-menu): Move in code in
vc-annotate-mode-variables.
(vc-update-change-log): Use make-temp-file if available.
2000-09-04 Martin Lorentzson <martinl@delysid.gnu.org>
- * vc-cvs.el (vc-cvs-revert,vc-cvs-checkout): References to
+ * vc-cvs.el (vc-cvs-revert, vc-cvs-checkout): References to
`vc-checkout-model' updated to `vc-cvs-update-model'.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc.el (vc-next-action-on-file): Added handling of state
+ * vc.el (vc-next-action-on-file): Add handling of state
`unlocked-changes'.
(vc-checkout-carefully): Is now practically obsolete, unless the
above is too slow to be enabled unconditionally.
- (vc-update-change-log): Fixed typo.
+ (vc-update-change-log): Fix typo.
- * vc-sccs.el (vc-sccs-steal-lock): Renamed from `vc-sccs-steal'.
+ * vc-sccs.el (vc-sccs-steal-lock): Rename from `vc-sccs-steal'.
* vc-sccs-hooks.el (vc-sccs-state): Somewhat rewritten.
Now handles state `unlocked-changes'.
(vc-sccs-workfile-unchanged-p): New function, to support the above.
- * vc-rcs.el (vc-rcs-steal-lock): Renamed from `vc-rcs-steal'.
+ * vc-rcs.el (vc-rcs-steal-lock): Rename from `vc-rcs-steal'.
- * vc-rcs-hooks.el (vc-rcs-state): Fixed typo.
+ * vc-rcs-hooks.el (vc-rcs-state): Fix typo.
(vc-rcs-fetch-master-state): Bug fixes. Recognize state
`unlocked-changes'.
- (vc-rcs-workfile-unchanged-p): Renamed from
+ (vc-rcs-workfile-unchanged-p): Rename from
`vc-rcs-workfile-unchanged'. This is not a real backend-specific
function yet, but supposed to become one soon.
- * vc-hooks.el (vc-backend-functions): Renamed `vc-steal' to
+ * vc-hooks.el (vc-backend-functions): Rename `vc-steal' to
`vc-steal-lock'.
- (vc-call-backend): Changed error message.
- (vc-state): Added description of state `unlocked-changes'.
+ (vc-call-backend): Change error message.
+ (vc-state): Add description of state `unlocked-changes'.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc-cvs-hooks.el (vc-cvs-registered): Fixed bug that caused it to
+ * vc-cvs-hooks.el (vc-cvs-registered): Fix bug that caused it to
always return t in CVS-controlled directories.
* vc.el (vc-responsible-backend): New function.
(vc-register): Largely rewritten.
- (vc-admin): Removed (implementation moved into vc-register).
+ (vc-admin): Remove (implementation moved into vc-register).
(vc-checkin): Redocumented.
(vc-finish-logentry): If no backend defined yet (because we are in
the process of registering), use the responsible backend.
* vc-hooks.el (vc-backend-hook-functions, vc-backend-functions):
- Updated function lists.
- (vc-call-backend): Fixed typo.
+ Update function lists.
+ (vc-call-backend): Fix typo.
* vc-sccs.el, vc-rcs.el, vc-cvs.el (vc-BACKEND-responsible-p):
New functions.
- (vc-BACKEND-register): Renamed from `vc-BACKEND-admin'.
+ (vc-BACKEND-register): Rename from `vc-BACKEND-admin'.
Removed query option. Redocumented.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -13214,18 +13204,18 @@
2000-09-04 Martin Lorentzson <martinl@gnu.org>
- * vc-rcs.el (vc-rcs-backend-release-p): function added. other
- stuff updated to reference this function instead of the old
+ * vc-rcs.el (vc-rcs-backend-release-p): function added.
+ other stuff updated to reference this function instead of the old
`vc-backend-release-p'.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
- * vc-sccs-hooks.el (vc-uses-locking): Renamed to
+ * vc-sccs-hooks.el (vc-uses-locking): Rename to
vc-checkout-model. Return appropriate values. Updated callers.
2000-09-04 Martin Lorentzson <martinl@gnu.org>
- * vc.el (vc-backend-release, vc-backend-release-p): Moved to vc-rcs.el.
+ * vc.el (vc-backend-release, vc-backend-release-p): Move to vc-rcs.el.
(vc-backend-revert): Function moved into `vc-revert';
`vc-next-action' must be updated to accommodate this change.
(vc-backend-steal): Function moved into `vc-finish-steal'.
@@ -13250,7 +13240,7 @@
2000-09-04 Martin Lorentzson <martinl@gnu.org>
- * vc.el (vc-workfile-unchanged-p,vc-diff,vc-version-diff):
+ * vc.el (vc-workfile-unchanged-p, vc-diff, vc-version-diff):
Update to use the vc-BACKEND-diff functions instead.
`vc-diff' is now working.
@@ -13270,7 +13260,7 @@
This checkin is made with our new VC code base for the very first time.
A simple `(vc-checkin (buffer-file-name))' was used to perform it.
- * vc-cvs.el (vc-cvs-revert,vc-cvs-checkout): Function calls to
+ * vc-cvs.el (vc-cvs-revert, vc-cvs-checkout): Function calls to
`vc-checkout-required' updated to `vc-cvs-uses-locking'.
* vc-hooks.el (vc-backend-hook-functions): `vc-checkout-required'
@@ -13305,31 +13295,31 @@
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
* vc.el (vc-next-action-on-file): Rewritten for the new state model.
- (vc-backend-merge-news): Renamed to `vc-merge-news'. (Specific parts
+ (vc-backend-merge-news): Rename to `vc-merge-news'. (Specific parts
still need to be split, and implemented for RCS).
2000-09-04 Martin Lorentzson <martinl@gnu.org>
* vc-sccs-hooks.el (vc-sccs-state-heuristic): Bug found and fixed.
- * vc-sccs.el (vc-sccs-admin): Added the query-only option as
+ * vc-sccs.el (vc-sccs-admin): Add the query-only option as
required by the vc.el file.
- * vc-rcs.el (vc-rcs-admin): Added the query-only option as
+ * vc-rcs.el (vc-rcs-admin): Add the query-only option as
required by the vc.el file.
(vc-rcs-exists): Function added.
- * vc-cvs.el (vc-cvs-admin): Added the query-only option as
+ * vc-cvs.el (vc-cvs-admin): Add the query-only option as
required by the vc.el file.
- * vc.el (vc-admin): Updated to handle selection of appropriate
+ * vc.el (vc-admin): Update to handle selection of appropriate
backend. Current implementation is crufty and need re-thinking.
* vc-hooks.el (vc-parse-buffer): Bug found and fixed.
2000-09-04 Martin Lorentzson <martinl@gnu.org>
- * vc-cvs.el (vc-cvs-annotate-difference): Updated to handle
+ * vc-cvs.el (vc-cvs-annotate-difference): Update to handle
beginning of annotate buffers correctly.
* vc.el (vc-annotate-get-backend, vc-annotate-display-default)
@@ -13348,11 +13338,11 @@
2000-09-04 Martin Lorentzson <martinl@gnu.org>
- * vc-sccs-hooks.el (vc-sccs-registered): Updated.
+ * vc-sccs-hooks.el (vc-sccs-registered): Update.
- * vc-rcs-hooks.el (vc-rcs-registered): Updated.
+ * vc-rcs-hooks.el (vc-rcs-registered): Update.
- * vc-cvs-hooks.el (vc-cvs-registered): Updated.
+ * vc-cvs-hooks.el (vc-cvs-registered): Update.
2000-09-04 Martin Lorentzson <martinl@gnu.org>
@@ -13444,8 +13434,8 @@
* vc-hooks.el (vc-master-templates): Is really obsolete.
Comment out the definition for now. What is the right procedure
to get rid of it?
- (vc-registered, vc-backend, vc-buffer-backend, vc-name): Largely
- rewritten.
+ (vc-registered, vc-backend, vc-buffer-backend, vc-name):
+ Largely rewritten.
(vc-default-registered): Remove.
(vc-check-master-templates): New function; does mostly what the
above did before.
@@ -13492,12 +13482,12 @@
* vc.el (vc-backend-checkout): Function removed and replaced in
the vc-backend.el files.
- * vc-sccs.el (vc-sccs-checkout): Added function `vc-sccs-checkout'.
+ * vc-sccs.el (vc-sccs-checkout): Add function `vc-sccs-checkout'.
- * vc.el (vc-backend-admin): Removed and replaced in the
+ * vc.el (vc-backend-admin): Remove and replaced in the
vc-backend.el files.
- * vc.el (Martin): Removed all the annotate functionality since it
+ * vc.el (Martin): Remove all the annotate functionality since it
is CVS backend specific.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
@@ -13523,7 +13513,7 @@
(vc-logentry-check-hook): New option.
(vc-steal-lock): Use compose-mail.
(vc-dired-mode-map): Defvar when compiling.
- (vc-add-triple, vc-record-rename, vc-lookup-triple): Moved to
+ (vc-add-triple, vc-record-rename, vc-lookup-triple): Move to
vc-sccs.el and renamed. Callers changed.
(vc-backend-checkout, vc-backend-logentry-check)
(vc-backend-merge-news): Doc fix.
@@ -13548,7 +13538,7 @@
(vc-rcs-checkin): New functions (code from vc.el).
(vc-rcs-previous-version, vc-rcs-system-release, vc-rcs-checkout):
Doc fix.
- (vc-rcs-release): Deleted. (Duplicated vc-rcs-system-release).
+ (vc-rcs-release): Delete. (Duplicated vc-rcs-system-release).
* vc-sccs.el: Require vc when compiling.
(vc-sccs-print-log, vc-sccs-assign-name, vc-sccs-merge)
@@ -13557,7 +13547,7 @@
(vc-sccs-checkin, vc-sccs-logentry-check): New functions (code
from vc.el).
(vc-sccs-add-triple, vc-sccs-record-rename)
- (vc-sccs-lookup-triple): Moved from vc.el and renamed.
+ (vc-sccs-lookup-triple): Move from vc.el and renamed.
(vc-sccs-admin): Doc fix.
2000-09-04 Martin Lorentzson <martinl@gnu.org>
@@ -13567,64 +13557,64 @@
(vc-rcs-release-p, vc-rcs-admin, vc-rcs-checkout): New functions
from vc.el.
- * vc-sccs.el (vc-admin-sccs): Added from vc.el
+ * vc-sccs.el (vc-admin-sccs): Add from vc.el
* vc-cvs.el: Moved the annotate functionality from vc.el.
- (vc-cvs-admin, vc-cvs-fetch-status): Added from vc.el.
+ (vc-cvs-admin, vc-cvs-fetch-status): Add from vc.el.
2000-09-04 Dave Love <fx@gnu.org>
* vc.el (vc-backend-release): Call vc-system-release.
* vc-sccs.el (vc-sccs-system-release):
- Renamed from vc-sccs-backend-release.
+ Rename from vc-sccs-backend-release.
* vc-rcs.el (vc-rcs-system-release):
- Renamed from vc-rcs-backend-release.
+ Rename from vc-rcs-backend-release.
* vc-cvs.el (vc-cvs-system-release):
- Renamed from vc-cvs-backend-release.
+ Rename from vc-cvs-backend-release.
2000-09-04 Dave Love <fx@gnu.org>
- * vc.el (vc-rcs-release, vc-cvs-release, vc-sccs-release): Moved to
+ * vc.el (vc-rcs-release, vc-cvs-release, vc-sccs-release): Move to
backend files.
(vc-backend-release): Dispatch to backend functions.
(vc-backend-release-p): Don't mention CVS, RCS. [The SCCS case
probably needs attention.]
- * vc-sccs.el, vc-rcs.el (vc-sccs-release): Moved from vc.el.
+ * vc-sccs.el, vc-rcs.el (vc-sccs-release): Move from vc.el.
(vc-sccs-backend-release): New function.
- * vc-cvs.el (vc-cvs-release): Moved from vc.el.
+ * vc-cvs.el (vc-cvs-release): Move from vc.el.
(vc-cvs-backend-release): New function.
* vc.el (vc-dired-mode, vc-dired-reformat-line, vc-dired-purge):
Doc fix.
- (vc-fetch-cvs-status): Moved to vc-cvs.el and renamed.
+ (vc-fetch-cvs-status): Move to vc-cvs.el and renamed.
(vc-default-dired-state-info): New function.
(vc-dired-state-info): Dispatch to backends.
(vc-dired-hook): Doc fix. Simplify, pending removal of CVS specifics.
- * vc-cvs.el (vc-cvs-dired-state-info, vc-cvs-fetch-status): Moved
- from vc.el and renamed.
+ * vc-cvs.el (vc-cvs-dired-state-info, vc-cvs-fetch-status):
+ Move from vc.el and renamed.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
* vc.el (vc-file-clear-masterprops, vc-latest-on-branch-p)
- (vc-version-other-window, vc-backend-assign-name): Removed
- references to vc-latest-version; sometimes changed into
+ (vc-version-other-window, vc-backend-assign-name):
+ Remove references to vc-latest-version; sometimes changed into
vc-workfile-version.
- * vc-rcs-hooks.el (vc-master-workfile-version): Renamed to
+ * vc-rcs-hooks.el (vc-master-workfile-version): Rename to
vc-rcs-master-workfile-version.
(vc-rcs-workfile-version): Use the above. Don't call
vc-latest-version (that was unreachable code, anyway).
(vc-rcs-fetch-master-properties): Doc fix.
- * vc-hooks.el (vc-latest-version, vc-your-latest-version): Removed.
- (vc-backend-hook-functions): Removed them from this list, too.
- (vc-fetch-properties): Removed.
+ * vc-hooks.el (vc-latest-version, vc-your-latest-version): Remove.
+ (vc-backend-hook-functions): Remove them from this list, too.
+ (vc-fetch-properties): Remove.
(vc-workfile-version): Doc fix.
* vc-rcs-hooks.el (vc-rcs-consult-headers): New function.
@@ -13632,7 +13622,7 @@
(vc-rcs-uses-locking): Use it.
* vc-hooks.el (vc-consult-rcs-headers):
- Moved into vc-rcs-hooks.el, under the name
+ Move into vc-rcs-hooks.el, under the name
vc-rcs-consult-headers.
* vc-cvs-hooks.el (vc-cvs-workfile-version): Don't consult RCS
@@ -13648,7 +13638,7 @@
New functions.
* vc-hooks.el (vc-master-locks, vc-master-locking-user):
- Moved into both
+ Move into both
vc-rcs-hooks.el and vc-sccs-hooks.el. These properties and access
functions are implementation details of those two backends.
@@ -13664,31 +13654,31 @@
* vc-cvs-hooks.el (vc-cvs-fetch-master-properties): CVS-specific
code moved here from vc-hooks.
- * vc-hooks.el (vc-parse-locks, vc-fetch-master-properties): Split
- into back-end specific parts and removed. Callers not updated
+ * vc-hooks.el (vc-parse-locks, vc-fetch-master-properties):
+ Split into back-end specific parts and removed. Callers not updated
yet; because I guess these callers will disappear into back-end
specific files anyway.
2000-09-04 Andre Spiegel <spiegel@inf.fu-berlin.de>
* vc.el (with-vc-file, vc-next-action-on-file, vc-merge)
- (vc-backend-checkout): Changed calls to `vc-checkout-model' to
+ (vc-backend-checkout): Change calls to `vc-checkout-model' to
`vc-uses-locking'.
- * vc-hooks.el (vc-checkout-model): Renamed to vc-uses-locking.
+ * vc-hooks.el (vc-checkout-model): Rename to vc-uses-locking.
Store yes/no in the property, and return t/nil. Updated all
callers.
- * vc-sccs-hooks.el (vc-sccs-checkout-model): Renamed to
+ * vc-sccs-hooks.el (vc-sccs-checkout-model): Rename to
vc-sccs-uses-locking. Don't set property.
(vc-sccs-locking-user): Don't set property.
- * vc-cvs-hooks.el (vc-cvs-checkout-model): Renamed to
+ * vc-cvs-hooks.el (vc-cvs-checkout-model): Rename to
vc-cvs-uses-locking. Don't set property here; leave that to
vc-hooks.
(vc-cvs-locking-user): Reflect above change. Streamlined.
- * vc-rcs-hooks.el (vc-rcs-checkout-model): Renamed to
+ * vc-rcs-hooks.el (vc-rcs-checkout-model): Rename to
vc-rcs-uses-locking.
(vc-rcs-locking-user): Reflect above change.
@@ -13719,36 +13709,36 @@
2000-09-04 Dave Love <fx@gnu.org>
* vc-hooks.el (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff)
- (vc-master-workfile-version): Moved from vc-hooks.
+ (vc-master-workfile-version): Move from vc-hooks.
* vc-rcs-hooks.el: Fix duplicate code in last change.
* vc-rcs-hooks.el: Require vc-hooks when compiling.
(vc-rcs-master-templates): Improve :type.
- (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff,
- vc-master-workfile-version): Moved from vc-hooks.
+ (vc-rcsdiff-knows-brief, vc-rcs-lock-from-diff)
+ (vc-master-workfile-version): Move from vc-hooks.
* vc-sccs-hooks.el: Require vc-hooks when compiling.
(vc-sccs-master-templates): Improve :type.
(vc-sccs-lock-file): Moved/renamed from vc-hooks.el vc-lock-file.
- * vc-hooks.el (vc-lock-file): Moved to vc-sccs-hooks and renamed.
+ * vc-hooks.el (vc-lock-file): Move to vc-sccs-hooks and renamed.
* vc-cvs-hooks.el: Require vc-hooks when compiling.
- (vc-cvs-master-templates): Improve :type. Use
- vc-cvs-find-cvs-master.
- (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): Moved here
+ (vc-cvs-master-templates): Improve :type.
+ Use vc-cvs-find-cvs-master.
+ (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status): Move here
from vc-hooks.
- (vc-vc-find-cvs-master): Renamed to vc-cvs-find-cvs-master.
+ (vc-vc-find-cvs-master): Rename to vc-cvs-find-cvs-master.
* vc-hooks.el (vc-handle-cvs, vc-cvs-parse-status, vc-cvs-status):
- Moved to vc-cvs-hooks.
+ Move to vc-cvs-hooks.
* vc-hooks.el: Add doc strings in various places. Simplify the
minor mode setup.
(vc-handled-backends): New user variable.
- (vc-parse-buffer, vc-insert-file, vc-default-registered): Minor
- simplification.
+ (vc-parse-buffer, vc-insert-file, vc-default-registered):
+ Minor simplification.
2000-09-04 Dave Love <fx@gnu.org>
@@ -13806,11 +13796,11 @@
2000-09-04 Dave Love <fx@gnu.org>
- * mouse.el (mouse-major-mode-menu, mouse-popup-menubar): Run
- menu-bar-update-hook.
+ * mouse.el (mouse-major-mode-menu, mouse-popup-menubar):
+ Run menu-bar-update-hook.
- * help.el (help-manyarg-func-alist): Add
- find-operation-coding-system.
+ * help.el (help-manyarg-func-alist):
+ Add find-operation-coding-system.
* wid-edit.el (widget-sexp-validate): Fix garbled code.
@@ -13833,7 +13823,7 @@
2000-09-01 John Wiegley <johnw@gnu.org>
- * pcomplete.el (pcomplete-dirs-or-entries): Added a missing
+ * pcomplete.el (pcomplete-dirs-or-entries): Add a missing
predicate, which caused entries in the completion list to be
doubled.
@@ -13853,8 +13843,8 @@
2000-08-28 John Wiegley <johnw@gnu.org>
- * eshell/esh-var.el (pcomplete/eshell-mode/unset): Added
- completion function for Eshell's implementation of `unset'.
+ * eshell/esh-var.el (pcomplete/eshell-mode/unset):
+ Add completion function for Eshell's implementation of `unset'.
2000-09-02 Eli Zaretskii <eliz@is.elta.co.il>
@@ -13873,8 +13863,8 @@
2000-08-30 Andrew Innes <andrewi@gnu.org>
* timer.el (run-with-idle-timer): Undo last change, so that timer
- is not activated immediately if Emacs is already idle. Some
- existing code relies on this behavior.
+ is not activated immediately if Emacs is already idle.
+ Some existing code relies on this behavior.
2000-08-30 Miles Bader <miles@gnu.org>
@@ -13934,22 +13924,22 @@
* help.el (help-xref-mule-regexp): New variable.
(help-make-xrefs): Handle help-xref-mule-regexp.
- * international/mule-cmds.el (help-xref-mule-regexp-template): New
- variable.
+ * international/mule-cmds.el (help-xref-mule-regexp-template):
+ New variable.
(describe-input-method): Temporarily activate the specified input
method to display the information.
(describe-language-environment): Hyperlinks to mule related items.
- * international/mule-diag.el (charset-multibyte-form-string): New
- function.
+ * international/mule-diag.el (charset-multibyte-form-string):
+ New function.
(list-character-sets-1): Use charset-multibyte-form-string.
(describe-character-set): New function.
(describe-coding-system): Hyperlinks to safe character sets.
* international/quail.el (quail-help): New arg PACKAGE.
Hyperlinks to mule related items.
- (quail-help-insert-keymap-description): Use
- substitute-command-keys instead of describe-bindings.
+ (quail-help-insert-keymap-description):
+ Use substitute-command-keys instead of describe-bindings.
(quail-translation-help): Hyperlinks to mule related items.
2000-08-28 John Wiegley <johnw@gnu.org>
@@ -13958,7 +13948,7 @@
have a defsubst call itself. Made `eshell-flatten-list' back into
a function again.
- * eshell/em-smart.el (eshell-smart-redisplay): Added a safety
+ * eshell/em-smart.el (eshell-smart-redisplay): Add a safety
catch, in case re-centering point at bottom messes up the display.
This happens frequently in Emacs 21, due I believe to variable
line heights.
@@ -13988,11 +13978,11 @@
(eshell-copy-handles): Created a new macro for duplicating the
current set of open handles. This is needed by the looping
functions.
- (eshell-do-eval): Fixed while and if, so that the eshell-test-body
+ (eshell-do-eval): Fix while and if, so that the eshell-test-body
is not incorrectly stomped on.
- * eshell/em-cmpl.el (eshell-cmpl-use-paring): Mirror
- declaration for pcomplete-use-paring.
+ * eshell/em-cmpl.el (eshell-cmpl-use-paring):
+ Mirror declaration for pcomplete-use-paring.
(eshell-cmpl-initialize): Set pcomplete-use-paring based on the
value of eshell-cmpl-use-paring.
* pcomplete.el (pcomplete-use-paring): New config variable, to
@@ -14000,7 +13990,7 @@
(pcomplete-do-complete): If pcomplete-use-paring is t, pare out
completion alternatives that have already been used.
- * eshell/esh-mode.el (eshell-repeat-argument): Added function,
+ * eshell/esh-mode.el (eshell-repeat-argument): Add function,
bound to C-c C-y, which will repeat the previous N arguments
(based on prefix argument).
(eshell-mode): Bind C-c C-y to eshell-repeat-argument.
@@ -14011,8 +14001,8 @@
name to delete is.
* eshell/esh-util.el (eshell-read-passwd-file): Only keep the
- first entry that correlates to a passwd/group number. Later
- entries (used for group/user name aliasing to multiple IDs) are
+ first entry that correlates to a passwd/group number.
+ Later entries (used for group/user name aliasing to multiple IDs) are
ignored.
* eshell/em-xtra.el (eshell/expr):
@@ -14021,7 +14011,7 @@
* eshell/em-dirs.el (eshell-dirs-substitute-cd): Flatten the
argument list, before passing it to the system command.
- * eshell/esh-mode.el (eshell-find-tag): Added a special version of
+ * eshell/esh-mode.el (eshell-find-tag): Add a special version of
`find-tag' for use at final position in Eshell buffers (which
otherwise triggers an error on Emacs 21).
(eshell-mode): Bind M-. to `eshell-find-tag' with the Eshell
@@ -14040,10 +14030,10 @@
types RET after an open delimiter (like "), display a message
indicating that Eshell is waiting for the closing delimiter.
- * eshell/esh-var.el (eshell/unset): Added a command for unsetting
+ * eshell/esh-var.el (eshell/unset): Add a command for unsetting
environment variables.
- * eshell/em-unix.el (eshell/diff): Added logic to fail more
+ * eshell/em-unix.el (eshell/diff): Add logic to fail more
gracefully if the user enters incorrect arguments.
* eshell/esh-mode.el (eshell-mode): Disable auto-fill-function in
@@ -14056,7 +14046,7 @@
* eshell/em-ls.el (eshell-ls-decorated-name): Use /= instead of
(not (= ...)).
- * eshell/em-unix.el (eshell-shuffle-files): Added use of `apply',
+ * eshell/em-unix.el (eshell-shuffle-files): Add use of `apply',
to ensure the `preserve' flag gets propagated when doing recursive
directory copies.
@@ -14069,15 +14059,15 @@
2000-08-28 Eli Zaretskii <eliz@is.elta.co.il>
- * eshell/esh-util.el (eshell-processp): Added to relieve constant
+ * eshell/esh-util.el (eshell-processp): Add to relieve constant
testing of `fboundp' on `processp'.
* eshell/esh-proc.el (eshell/kill): Use eshell-processp.
(eshell/jobs): Don't call process-list if it is not bound.
(eshell-gather-process-output): Support systems where async
subprocesses aren't supported.
- (eshell-scratch-buffer, eshell-last-sync-output-start): New
- variables.
+ (eshell-scratch-buffer, eshell-last-sync-output-start):
+ New variables.
* eshell/esh-cmd.el (eshell-resume-eval): Handle the case when
eshell-do-eval returns t.
@@ -14092,8 +14082,8 @@
* eshell/esh-io.el (eshell-virtual-targets): Doc fix.
(eshell-close-target, eshell-get-target): Use eshell-processp.
- (eshell-print, eshell-error, eshell-errorn, eshell-printn): Doc
- fix.
+ (eshell-print, eshell-error, eshell-errorn, eshell-printn):
+ Doc fix.
(eshell-get-target, eshell-create-handles): Doc fix.
2000-08-28 Miles Bader <miles@lsi.nec.co.jp>
@@ -14108,7 +14098,7 @@
2000-08-28 Peter Breton <pbreton@ne.mediaone.net>
* locate.el (locate): Cleaned up locate command's interactive prompting
- Thanks to François_Pinard <pinard@iro.umontreal.ca> for suggestions.
+ Thanks to François Pinard <pinard@iro.umontreal.ca> for suggestions.
* filecache.el (file-cache-case-fold-search): New variable.
(file-cache-assoc-function): New variable.
@@ -14183,15 +14173,15 @@
2000-08-25 Kenichi Handa <handa@etl.go.jp>
- * terminal.el (terminal-emulator): Fix args to `concat'. Now
- concat doesn't accept integer.
+ * terminal.el (terminal-emulator): Fix args to `concat'.
+ Now concat doesn't accept integer.
- * international/kkc.el: Remove SKK from Keywords. Require
- ja-dic-utl instead of skkdic-utl.
+ * international/kkc.el: Remove SKK from Keywords.
+ Require ja-dic-utl instead of skkdic-utl.
* international/ja-dic-cnv.el: Renamed from skkdic-cnv.el.
Provide ja-dic-cnv instead of skkdic-cnv.
- (ja-dic-filename): Renamed from skkdic-filename. Referrers changed.
+ (ja-dic-filename): Rename from skkdic-filename. Referrers changed.
(iso-2022-7bit-short): Add safe-charsets property.
(skkdic-convert-postfix): Search Japanese chou-on character in
addition to Hiragana character.
@@ -14218,8 +14208,8 @@
2000-08-24 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (reset-language-environment): Set
- default-process-coding-system to '(undecided . iso-latin-1), which
+ * international/mule-cmds.el (reset-language-environment):
+ Set default-process-coding-system to '(undecided . iso-latin-1), which
makes process I/O almost consistent with file I/O. Call this
function when mule-cmds.el[c] is loaded.
@@ -14328,8 +14318,8 @@
* comint.el (comint-output-filter): Save the point with a marker,
not just a buffer position.
- * international/mule.el (set-buffer-process-coding-system): Make
- interactive prompt less confusing.
+ * international/mule.el (set-buffer-process-coding-system):
+ Make interactive prompt less confusing.
2000-08-19 Gerd Moellmann <gerd@gnu.org>
@@ -14368,8 +14358,8 @@
2000-08-18 Gerd Moellmann <gerd@gnu.org>
- * textmodes/ispell.el (ispell-dictionary-alist-6): Add
- `portugues'.
+ * textmodes/ispell.el (ispell-dictionary-alist-6):
+ Add `portugues'.
* bindings.el (esc-map): Bind `C-delete' and `C-backspace' to
backward-kill-sexp, analogous to kill-sexp.
@@ -14382,18 +14372,18 @@
* ispell.el: Set to standard author/maintainer/keyword fields.
Fine tuning to menu map appearance and operation, and added help.
Remove `start' and `end' error messages when compiling.
- (ispell-choices-win-default-height): Fixed comment string.
- (ispell-dictionary-alist-1): Fixed regexp in castellano and
+ (ispell-choices-win-default-height): Fix comment string.
+ (ispell-dictionary-alist-1): Fix regexp in castellano and
castellano8 dictionaries.
- (ispell-dictionary-alist-3): Fixed regexp in francais dictionary.
- (ispell-dictionary-alist-4): Fixed regexp in francais-tex
+ (ispell-dictionary-alist-3): Fix regexp in francais dictionary.
+ (ispell-dictionary-alist-4): Fix regexp in francais-tex
dictionary, added italiano dictionary.
- (ispell-skip-region-alist): Removed regexp thrashing when `-' is a
+ (ispell-skip-region-alist): Remove regexp thrashing when `-' is a
word character.
- (ispell-tex-skip-alists): Added psfig support.
- (ispell-skip-html): Renamed from ispell-skip-sgml.
+ (ispell-tex-skip-alists): Add psfig support.
+ (ispell-skip-html): Rename from ispell-skip-sgml.
(ispell-begin-skip-region-regexp, ispell-skip-region)
- (ispell-minor-check): Improved html skipping support to skip across
+ (ispell-minor-check): Improve html skipping support to skip across
code, and recognize `&' commands without proper `;' syntax.
(ispell-process-line): Fix alignment error when manually
correcting spelling.
@@ -14407,8 +14397,8 @@
shell-command-on-region as in format-decode-run-method because
shell-command-on-region can display a buffer with error output.
(format-decode): Don't record undo information for the decoding.
- (format-annotate-function): Add parameter FORMAT-COUNT. Make
- that number part of the temporary buffer name so that more than
+ (format-annotate-function): Add parameter FORMAT-COUNT.
+ Make that number part of the temporary buffer name so that more than
one decoding using a temporary buffer can happen safely.
* enriched.el (enriched-annotation-regexp): Use `A-Z' instead
@@ -14581,16 +14571,16 @@
2000-08-15 Miles Bader <miles@gnu.org>
* textmodes/ispell.el (ispell-graphic-p): New constant.
- (ispell-choices-win-default-height, ispell-help): Use
- `ispell-graphic-p' instead of `xemacsp'.
+ (ispell-choices-win-default-height, ispell-help):
+ Use `ispell-graphic-p' instead of `xemacsp'.
2000-08-15 Dave Love <fx@gnu.org>
* simple.el: Autoload widget-convert when compiling.
(mail-user-agent): Doc fix.
- * help.el (function-called-at-point, variable-at-point): Use
- with-syntax-table.
+ * help.el (function-called-at-point, variable-at-point):
+ Use with-syntax-table.
(help-manyarg-func-alist): Add insert-and-inherit.
* thingatpt.el (thing-at-point-url-regexp): Prepend `\<'.
@@ -14599,7 +14589,7 @@
* find-file.el: Doc fixes. Move provide to end.
(ff) <defgroup>: Add :link.
- (ff-goto-click): Deleted.
+ (ff-goto-click): Delete.
(ff-mouse-find-other-file, ff-mouse-find-other-file-other-window):
Use mouse-set-point.
@@ -14625,8 +14615,8 @@
Doze and Dog.
(browse-url): Use dolist, not mapcar.
(browse-url-at-point): Check for null url.
- (browse-url-event-buffer, browse-url-event-point): Functions
- deleted.
+ (browse-url-event-buffer, browse-url-event-point):
+ Functions deleted.
(browse-url-at-mouse, browse-url-netscape): Simplify.
* msb.el (msb--few-menus, msb--very-many-menus): Use current Gnus
@@ -14734,7 +14724,7 @@
(comint-snapshot-last-prompt): New function.
(comint-send-input): Snapshot the last prompt.
Use comint-highlight-input-face.
- (comint-highlight-input-face): Renamed from `comint-highlight-face'.
+ (comint-highlight-input-face): Rename from `comint-highlight-face'.
Use defface instead of defcustom.
(send-invisible, comint-send-eof): Snapshot the last prompt.
(comint-delchar-or-maybe-eof): Use comint-send-eof.
@@ -14795,8 +14785,8 @@
* emacs-lisp/lisp-mode.el (eval-last-sexp-1): Handle `#N='
labels.
- * help.el (print-help-return-message): When
- display-buffer-reuse-frames is set, let the help window been quit,
+ * help.el (print-help-return-message):
+ When display-buffer-reuse-frames is set, let the help window been quit,
instead of deleting it, which might delete a reused frame.
2000-08-08 Eli Zaretskii <eliz@is.elta.co.il>
@@ -14817,7 +14807,7 @@
* emacs-lisp/cl-indent.el (toplevel): Indent `defclass',
`defconst', `define-condition', `with-slots'.
- * font-lock.el (lisp-font-lock-keywords-2): Added `with-' and `do-'.
+ * font-lock.el (lisp-font-lock-keywords-2): Add `with-' and `do-'.
2000-08-03 Miles Bader <miles@gnu.org>
@@ -14836,16 +14826,16 @@
properties if comint-use-prompt-regexp-instead-of-fields is nil.
(comint-line-beginning-position): New function.
(comint-bol): Use comint-line-beginning-position. Make ARG optional.
- (comint-replace-by-expanded-history-before-point): Use
- comint-line-beginning-position and line-end-position.
+ (comint-replace-by-expanded-history-before-point):
+ Use comint-line-beginning-position and line-end-position.
(comint-last-output-overlay): New variable.
(comint-mode): Make `comint-last-output-overlay' buffer-local.
* shell.el (shell-prompt-pattern): Doc change.
(shell-backward-command): Use line-beginning-position.
- * gud.el (gud-gdb-complete-command): Use
- comint-line-beginning-position.
+ * gud.el (gud-gdb-complete-command):
+ Use comint-line-beginning-position.
* ielm.el (ielm-indent-line): Detect a "prompt" line by seeing if
comint-bol doesn't actually go to the beginning of the line.
@@ -14859,13 +14849,13 @@
(sql-copy-column): Use comint-line-beginning-position instead of
explicitly matching comint-prompt-regexp.
- * progmodes/octave-inf.el (inferior-octave-complete): Use
- comint-line-beginning-position.
+ * progmodes/octave-inf.el (inferior-octave-complete):
+ Use comint-line-beginning-position.
* progmodes/inf-lisp.el (inferior-lisp-prompt): Doc change.
- * progmodes/idlw-shell.el (idlwave-shell-send-command): When
- looking for a prompt, use `forward-line 0' instead of
+ * progmodes/idlw-shell.el (idlwave-shell-send-command):
+ When looking for a prompt, use `forward-line 0' instead of
`beginning-of-line', to avoid getting caught by an input field.
2000-08-07 Gerd Moellmann <gerd@gnu.org>
@@ -14936,8 +14926,8 @@
2000-08-03 Eli Zaretskii <eliz@is.elta.co.il>
- * international/mule-cmds.el (select-safe-coding-system): Make
- the message text about selecting a safe coding system more clear.
+ * international/mule-cmds.el (select-safe-coding-system):
+ Make the message text about selecting a safe coding system more clear.
2000-08-02 Gerd Moellmann <gerd@gnu.org>
@@ -14961,8 +14951,8 @@
2000-08-02 Eli Zaretskii <eliz@is.elta.co.il>
- * progmodes/ebrowse.el (ebrowse-tree-mode-map): Use
- display-mouse-p instead of window-system.
+ * progmodes/ebrowse.el (ebrowse-tree-mode-map):
+ Use display-mouse-p instead of window-system.
(ebrowse-member-mode-map): Ditto.
2000-08-01 Vinicius Jose Latorre <vinicius@cpqd.com.br>
@@ -14978,8 +14968,8 @@
font lock support on window-system.
(ftp-font-lock-keywords, smbclient-font-lock-keywords): Likewise.
- * textmodes/ispell.el (ispell-highlight-spelling-error): Use
- display-color-p, if fboundp, instead of window-system.
+ * textmodes/ispell.el (ispell-highlight-spelling-error):
+ Use display-color-p, if fboundp, instead of window-system.
2000-07-31 Eli Zaretskii <eliz@is.elta.co.il>
@@ -15046,7 +15036,7 @@
2000-07-30 Milan Zamazal <pdm@freesoft.cz>
- * glasses.el (glasses-make-readable): Fix uncapitalization of
+ * progmodes/glasses.el (glasses-make-readable): Fix uncapitalization of
identifiers like `myXMLDocument'.
2000-07-28 Karl Fogel <kfogel@red-bean.com>
@@ -15070,8 +15060,8 @@
* subr.el (remove, remq): New functions.
- * midnight.el (clean-buffer-list-kill-never-regexps): Correctly
- escape `*' in regexps.
+ * midnight.el (clean-buffer-list-kill-never-regexps):
+ Correctly escape `*' in regexps.
(midnight-find): Reverse order of arguments in the funcall of
TEST.
@@ -15082,12 +15072,12 @@
2000-07-27 Alex Schroeder <alex@gnu.org>
- * sql.el (sql-ms): Added autoload cookie.
+ * sql.el (sql-ms): Add autoload cookie.
(sql-ingres, sql-solid, sql-mysql, sql-informix, sql-sybase)
(sql-oracle): Ditto.
(sql-help): Doc change.
- (sql-mode-oracle-font-lock-keywords): Added PL/SQL keywords, data
+ (sql-mode-oracle-font-lock-keywords): Add PL/SQL keywords, data
types and exceptions.
2000-07-27 Alex Schroeder <alex@gnu.org>
@@ -15122,11 +15112,11 @@
(find-coding-systems-region-subset-p): This function deleted.
(sort-coding-systems-predicate): New variable.
(sort-coding-systems): New function.
- (find-coding-systems-region): Use
- find-coding-systems-region-internal.
+ (find-coding-systems-region):
+ Use find-coding-systems-region-internal.
(find-coding-systems-string): Use find-coding-systems-region.
- (find-coding-systems-for-charsets): Check
- char-coding-system-table.
+ (find-coding-systems-for-charsets):
+ Check char-coding-system-table.
(select-safe-coding-system-accept-default-p): New variable.
(select-safe-coding-system): Mostly rewritten. New argument
ACCEPT-DEFAULT-P.
@@ -15158,29 +15148,29 @@
* net/ange-ftp.el (ange-ftp-file-newer-than-file-p): New function.
(ange-ftp-real-file-newer-than-file-p): New function.
(ange-ftp-verify-visited-file-modtime): Use `float-time'.
- (ange-ftp-dot-to-slash): Removed (use `subst-char-in-string').
+ (ange-ftp-dot-to-slash): Remove (use `subst-char-in-string').
- * tooltip.el (tooltip-float-time): Removed (use `float-time').
+ * tooltip.el (tooltip-float-time): Remove (use `float-time').
* midnight.el (midnight-float-time): Ditto.
2000-07-26 Andreas Schwab <schwab@suse.de>
- * files.el (normal-backup-enable-predicate): Correct
- interpretation of the return value of compare-strings.
+ * files.el (normal-backup-enable-predicate):
+ Correct interpretation of the return value of compare-strings.
2000-07-26 Gerd Moellmann <gerd@gnu.org>
* isearch.el (isearch-resume): New function.
(isearch-done): Add something to command-history to resume
the search.
- (isearch-yank-line, isearch-yank-word): Use
- buffer-substring-no-properties instead of buffer-substring.
+ (isearch-yank-line, isearch-yank-word):
+ Use buffer-substring-no-properties instead of buffer-substring.
* textmodes/flyspell.el (flyspell-mouse-map): Use `map' instead
of flyspell-mouse-map.
- * progmodes/make-mode.el (makefile-mode-abbrev-table): Remove
- duplicate definition.
+ * progmodes/make-mode.el (makefile-mode-abbrev-table):
+ Remove duplicate definition.
(makefile-mode): Remove duplicate setting of local-abbrev-table.
* progmodes/m4-mode.el (m4-mode-abbrev-table): New variable.
@@ -15196,8 +15186,8 @@
(ange-ftp-dot-to-slash): New function.
(ange-ftp-fix-name-for-vms): Use it.
- * midnight.el (midnight-buffer-display-time): Use
- `with-current-buffer'.
+ * midnight.el (midnight-buffer-display-time):
+ Use `with-current-buffer'.
2000-07-25 Gerd Moellmann <gerd@gnu.org>
@@ -15261,245 +15251,245 @@
2000-07-24 Francis Wright <fjw@maths.qmw.ac.uk>
- * dired.el (dired-sort-R-check): Added to allow recursive listing
+ * dired.el (dired-sort-R-check): Add to allow recursive listing
to be undone.
(dired-sort-other): Use it.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
* Release of cc-mode 5.27
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-looking-at-inexpr-block): Replaced a call to
+ * progmodes/cc-engine.el (c-looking-at-inexpr-block): Replace a call to
c-beginning-of-statement-1 that caused a bad case of recursion
which could consume a lot of CPU in large classes in languages
that have in-expression classes (i.e. Java and Pike).
- * cc-engine.el (c-guess-basic-syntax): Check for in-expression
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Check for in-expression
statements before top level constructs (i.e. case 6 is moved
before case 5 and is now case 4) to catch in-expression
classes in top level expressions correctly.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-guess-basic-syntax): Less naive handling of
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Less naive handling of
objc-method-intro. Case 4 removed and case 5I added.
- * cc-langs.el (c-append-paragraph-start): New variable used by
+ * progmodes/cc-langs.el (c-append-paragraph-start): New variable used by
c-common-init to get paragraph-start correct.
- * cc-langs.el (c-common-init): Use c-append-paragraph-start to
+ * progmodes/cc-langs.el (c-common-init): Use c-append-paragraph-start to
initialize paragraph-start to make it correct both with and
without the javadoc special case.
- * cc-mode.el (java-mode): Use c-append-paragraph-start to
+ * progmodes/cc-mode.el (java-mode): Use c-append-paragraph-start to
initialize paragraph-start for javadoc markup.
- * cc-vars.el (c-style-variables-are-local-p): Incompatible
- change by defaulting this to t. It's motivated by the
+ * progmodes/cc-vars.el (c-style-variables-are-local-p):
+ Incompatible change by defaulting this to t. It's motivated by the
confusing behavior that otherwise arise from the style system
when editing both java and non-java files at the same time
(see the comments about style setting in c-common-init).
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-indent-new-comment-line): Added a kludge
+ * progmodes/cc-cmds.el (c-indent-new-comment-line): Add a kludge
similar to the one in c-fill-paragraph to check the fill
prefix from the adaptive fill function for sanity.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-end-of-defun-1): Fixed forward scanning into
+ * progmodes/cc-defs.el (c-end-of-defun-1): Fix forward scanning into
defun block.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-align.el (c-lineup-multi-inher): Handle lines with
+ * progmodes/cc-align.el (c-lineup-multi-inher): Handle lines with
leading comma nicely. Extended to handle member initializers
too.
- * cc-engine.el (c-beginning-of-inheritance-list)
- (c-guess-basic-syntax): Fixed recognition of inheritance lists
+ * progmodes/cc-engine.el (c-beginning-of-inheritance-list)
+ (c-guess-basic-syntax): Fix recognition of inheritance lists
when the lines begins with a comma.
- * cc-vars.el (c-offsets-alist): Changed default for
+ * progmodes/cc-vars.el (c-offsets-alist): Change default for
member-init-cont to c-lineup-multi-inher since it now handles
member initializers and indents better for leading commas.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-electric-brace): Fixed some bugs in the state
+ * progmodes/cc-cmds.el (c-electric-brace): Fix some bugs in the state
handling that caused class open lines to be recognized as
statement-conts in some cases.
- * cc-cmds.el (c-indent-new-comment-line): Keep the fill prefix
+ * progmodes/cc-cmds.el (c-indent-new-comment-line): Keep the fill prefix
guessed by the adaptive fill function unless point is on the
first line of a block comment.
- * cc-engine.el (c-forward-syntactic-ws): Fixed an infloop bug
+ * progmodes/cc-engine.el (c-forward-syntactic-ws): Fix an infloop bug
when the buffer ends with a macro continuation char.
- * cc-engine.el (c-guess-basic-syntax): Added support for
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Add support for
function definitions as statements in Pike. The first
statement in a lambda block is now labeled defun-block-intro
instead of statement-block-intro.
- * cc-engine.el (c-narrow-out-enclosing-class): Whack the state
+ * progmodes/cc-engine.el (c-narrow-out-enclosing-class): Whack the state
so that the class surrounding point is selected, not the one
innermost in the state.
- * cc-engine.el (c-guess-basic-syntax): Fixed bug in
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug in
recognition of switch labels having hanging multiline
statements.
- * cc-engine.el (c-beginning-of-member-init-list): Broke out
+ * progmodes/cc-engine.el (c-beginning-of-member-init-list): Broke out
some code in c-guess-basic-syntax to a separate function.
- * cc-engine.el (c-just-after-func-arglist-p): Fixed
- recognition of member inits with multiple line arglists.
- * cc-engine.el (c-guess-basic-syntax): New case 5B.3 to detect
+ * progmodes/cc-engine.el (c-just-after-func-arglist-p):
+ Fix recognition of member inits with multiple line arglists.
+ * progmodes/cc-engine.el (c-guess-basic-syntax): New case 5B.3 to detect
member-init-cont when the commas are in funny places.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-auto-newline): Removed this macro since it's
+ * progmodes/cc-defs.el (c-auto-newline): Remove this macro since it's
not used anymore.
- * cc-engine.el (c-looking-at-bos): New helper function.
- * cc-engine.el (c-looking-at-inexpr-block): More tests to tell
+ * progmodes/cc-engine.el (c-looking-at-bos): New helper function.
+ * progmodes/cc-engine.el (c-looking-at-inexpr-block): More tests to tell
inexpr and toplevel classes apart in Pike.
- * cc-engine.el (c-guess-basic-syntax): Fixed bogus recognition
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bogus recognition
of case 9A.
- * cc-langs.el, cc-mode.el (c-Pike-inexpr-class-key): New
- constant, since "class" can introduce an in-expression class
- in Pike nowadays.
+ * progmodes/cc-langs.el, progmodes/cc-mode.el
+ (c-Pike-inexpr-class-key): New constant, since "class" can
+ introduce an in-expression class in Pike nowadays.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-align.el (c-gnu-impose-minimum): Don't impose minimum
+ * progmodes/cc-align.el (c-gnu-impose-minimum): Don't impose minimum
indentation on cpp-macro lines.
- * cc-engine.el (c-guess-basic-syntax): Made the cpp-macro
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Made the cpp-macro
a syntax modifier like comment-intro, to make it possible to
- get syntactic indentation for preprocessor directives. It's
- incompatible wrt to lineup functions on cpp-macro, but it has
+ get syntactic indentation for preprocessor directives.
+ It's incompatible wrt to lineup functions on cpp-macro, but it has
no observable effect in the 99.9% common case where cpp-macro
is set to -1000.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-guess-basic-syntax): Fixed bug with missed
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug with missed
member-init-cont when the preceding arglist is several lines.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-styles.el (c-style-alist): The basic offset for the BSD
+ * progmodes/cc-styles.el (c-style-alist): The basic offset for the BSD
style corrected to 8.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-styles.el (c-style-alist): Adjusted the indentation of
+ * progmodes/cc-styles.el (c-style-alist): Adjust the indentation of
brace list openers in the gnu style.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-indent-command): Obey c-syntactic-indentation.
+ * progmodes/cc-cmds.el (c-indent-command): Obey c-syntactic-indentation.
- * cc-cmds.el (c-electric-brace, c-electric-slash,
- c-electric-star, c-electric-semi&comma, c-electric-colon,
- c-electric-lt-gt, c-electric-paren): Don't reindent old lines
+ * progmodes/cc-cmds.el (c-electric-brace, c-electric-slash)
+ (c-electric-star, c-electric-semi&comma, c-electric-colon)
+ (c-electric-lt-gt, c-electric-paren): Don't reindent old lines
when c-syntactic-indentation is nil.
- * cc-engine.el (c-beginning-of-statement-1): Fixed bug where
+ * progmodes/cc-engine.el (c-beginning-of-statement-1): Fix bug where
we were left at comments preceding the first statement when
reaching the beginning of the buffer.
- * cc-vars.el (c-syntactic-indentation): New variable to turn
+ * progmodes/cc-vars.el (c-syntactic-indentation): New variable to turn
off all syntactic indentation.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-fill-paragraph): Keep one or two spaces
+ * progmodes/cc-cmds.el (c-fill-paragraph): Keep one or two spaces
between the text and the block comment ender when it hangs,
depending on how many there are before the fill.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-beginning-of-closest-statement): New helper
+ * progmodes/cc-engine.el (c-beginning-of-closest-statement): New helper
function to go back to the closest preceding statement start,
which could be inside a conditional statement.
- * cc-engine.el (c-guess-basic-syntax): Use
- c-beginning-of-closest-statement in cases 10B.2, 17B and 17C.
+ * progmodes/cc-engine.el (c-guess-basic-syntax):
+ Use c-beginning-of-closest-statement in cases 10B.2, 17B and 17C.
- * cc-engine.el (c-guess-basic-syntax): Better handling of
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Better handling of
arglist-intro, arglist-cont-nonempty and arglist-close when
the arglist is nested inside parens. Cases 7A, 7C and 7F
changed.
- * cc-langs.el (c-Java-javadoc-paragraph-start): Brought
- up-to-date with javadoc 1.2.
+ * progmodes/cc-langs.el (c-Java-javadoc-paragraph-start):
+ Brought up-to-date with javadoc 1.2.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-beginning-of-statement-1): Fixed handling of
+ * progmodes/cc-engine.el (c-beginning-of-statement-1): Fix handling of
multiline Pike type decls.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-cmds.el (c-indent-new-comment-line): Always break
+ * progmodes/cc-cmds.el (c-indent-new-comment-line): Always break
multiline comments in multiline mode, regardless of
comment-multi-line.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-engine.el (c-guess-basic-syntax): Fixed bug with
+ * progmodes/cc-engine.el (c-guess-basic-syntax): Fix bug with
fully::qualified::names in C++ member init lists. Preamble in
case 5D changed.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-langs.el (c-common-init): Handling of obsolete variables
+ * progmodes/cc-langs.el (c-common-init): Handling of obsolete variables
moved to c-initialize-cc-mode. More compatible style override
when using global style variables.
- * cc-mode.el (c-initialize-cc-mode): Handling of obsolete
+ * progmodes/cc-mode.el (c-initialize-cc-mode): Handling of obsolete
variables moved here.
- * cc-styles.el (c-make-styles-buffer-local): Flag style
+ * progmodes/cc-styles.el (c-make-styles-buffer-local): Flag style
variable localness in c-style-variables-are-local-p to make
the compatibility measure in c-common-init work well.
- * cc-styles.el (c-set-style-1): c-special-indent-hook can no
+ * progmodes/cc-styles.el (c-set-style-1): c-special-indent-hook can no
longer contain set-from-style.
- * cc-styles.el (c-initialize-builtin-style): Don't check for
+ * progmodes/cc-styles.el (c-initialize-builtin-style): Don't check for
set-from-style on c-special-indent-hook.
- * cc-styles.el (c-copy-tree): Obsolete. The standard function
+ * progmodes/cc-styles.el (c-copy-tree): Obsolete. The standard function
copy-alist is sufficient now.
- * cc-styles.el (c-set-style, c-set-style-1,
- c-get-style-variables): Fixes to variable initialization so
+ * progmodes/cc-styles.el (c-set-style, c-set-style-1)
+ (c-get-style-variables): Fixes to variable initialization so
that duplicate entries in styles have the same effect
regardless of DONT-OVERRIDE.
- * cc-styles.el (c-set-style-2): Fixed bug where the
+ * progmodes/cc-styles.el (c-set-style-2): Fix bug where the
initialization of inheriting styles failed when the
dont-override flag is set.
- * cc-vars.el (c-special-indent-hook): Don't use set-from-style
+ * progmodes/cc-vars.el (c-special-indent-hook): Don't use set-from-style
on this.
-2000-07-24 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-07-24 Martin Stjernholm <mast@lysator.liu.se>
- * cc-defs.el (c-forward-comment): Removed the workaround
+ * progmodes/cc-defs.el (c-forward-comment): Remove the workaround
introduced in 5.38 since it had worse side-effects. If a line
contains the string "//\"", it regarded the // as a comment
start since the \ temporarily doesn't have escape syntax.
2000-07-17 Emmanuel Briot <briot@act-europe.fr>
- * ada-mode.el: Got rid of all byte-compiler warnings on Emacs Load
- ada-xref.el before ada-prj.el, so that the Project menu is created
- when ada-prj tries to add to it.
+ * progmodes/ada-mode.el: Got rid of all byte-compiler warnings on
+ Emacs. Load ada-xref.el before ada-prj.el, so that the Project
+ menu is created when ada-prj tries to add to it.
(ada-activate-keys-for-case): Suppress the characters that are not
part of the Ada syntax. Better compatibility with else-mode.
(ada-adjust-case-interactive): When auto-casing is not active,
@@ -15530,9 +15520,9 @@
paragraphs on the first or last line of a file.
(ada-format-paramlist): Fix handling of default parameter values.
(ada-get-body-name): New function.
- (ada-get-current-indent): Optimized by searching directly for an
- existing generic part or a statement outside of it. Handle
- ada-indent-align-comments when indenting comments Replaced some
+ (ada-get-current-indent): Optimize by searching directly for an
+ existing generic part or a statement outside of it.
+ Handle ada-indent-align-comments when indenting comments Replaced some
regexps by testing directly the next character. This results in a
huge speedup on some files. New indentation scheme for renames
statements. Stop looking for the 'while' or 'for' associated with
@@ -15584,7 +15574,7 @@
(ada-xemacs): Evaluate it at compile time too, so that ada-mode.el
can be batch-compiled from the command line.
- * ada-xref.el: Got rid of all byte-compiler warnings on Emacs.
+ * progmodes/ada-xref.el: Got rid of all byte-compiler warnings on Emacs.
Add to the menu when the file is loaded, not in ada-mode-hook.
Add -toolbar to the default ddd command Switches moved from
ada-prj-default-comp-cmd and ada-prj-default-make-cmd to
@@ -15592,7 +15582,7 @@
(ada-add-ada-menu): Remove the map and name parameters. Add the Ada
Reference Manual to the menu.
(ada-check-current): Rewritten as a call to ada-compile-current.
- (ada-compile): Removed.
+ (ada-compile): Remove.
(ada-compile-application, ada-compile-current, ada-check-current):
Set the compilation-search-path so that compile.el automatically
finds the sources in src_dir. Automatic scrolling of the
@@ -15606,7 +15596,7 @@
(ada-find-file-in-dir): New function.
(ada-find-references): Set the environment variables for gnatfind.
(ada-find-src-file-in-dir): New function.
- (ada-first-non-nil): Removed.
+ (ada-first-non-nil): Remove.
(ada-gdb-application): Add support for jdb, the java debugger.
(ada-get-ada-file-name): Load the original-file first if not done
yet.
@@ -15624,20 +15614,20 @@
compilation-search-path,... Add the standard runtime library to
the search path for find-file.
(ada-prj-default-debugger): Was missing an opening '{'.
- (ada-prj-default-bind-opt, ada-prj-default-link-opt): New
- variables.
+ (ada-prj-default-bind-opt, ada-prj-default-link-opt):
+ New variables.
(ada-prj-default-gnatmake-opt): New variable.
(ada-prj-find-prj-file): Handles non-file buffers For non-Ada
buffers, the project file is the default one Save the windows
configuration before displaying the menu.
- (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Removed.
+ (ada-prj-src-dir, ada-prj-obj-dir, ada-prj-comp-opt,...): Remove.
(ada-read-identifier): Fix xrefs on operators (for "mod", "and",
...) regexp-quote identifiers names to support operators +,
-,... in regexps.
(ada-remote): New function.
(ada-run-application): Erase the output buffer before starting the
- run Support remote execution of the application. Use
- call-process, or the arguments are incorrectly parsed.
+ run Support remote execution of the application.
+ Use call-process, or the arguments are incorrectly parsed.
(ada-set-default-project-file): Reread the content of the active
project file, not the one from the current buffer When a project
file is set as the default project, all directories are
@@ -15657,7 +15647,7 @@
cd to the build directory. New field: main_unit Provide a default
file name even if the current buffer has no prj file.
- * ada-prj.el:
+ * progmodes/ada-prj.el:
Rewritten to show a tabbed-dialog.
(ada-prj-add-ada-menu): Remove the map and name parameters.
(ada-prj-display-page, ada-prj-field, ada-prj-initialize-values):
@@ -15667,7 +15657,7 @@
(ada-prj-save): Always save fields that depend on the current buffer.
(ada-prj-show-value): New function
- * ada-stmt.el (ada-stmt-add-to-ada-menu): Hide the menu if not in
+ * progmodes/ada-stmt.el (ada-stmt-add-to-ada-menu): Hide the menu if not in
Ada mode. This will allow us to display the Ada menu in any buffer
we want (for project items).
(ada-header-tmpl): Use ada-fill-comment-prefix to put the correct
@@ -15817,7 +15807,7 @@
* net/goto-addr.el: Change maintainer to FSF.
- * info.el (Info-title-face-alist): Removed.
+ * info.el (Info-title-face-alist): Remove.
2000-07-18 David Ponce <david@dponce.com>
@@ -15886,13 +15876,13 @@
* align.el (align-newline-and-indent): Adding new function,
for auto-aligning blocks of code on RET.
- (align-region): Fixed badly formatted minibuffer message.
+ (align-region): Fix badly formatted minibuffer message.
2000-07-17 Kenichi Handa <handa@etl.go.jp>
* international/kkc.el (kkc-show-conversion-list-count): Customize it.
- (kkc-region): Update kkc-next-count and kkc-prev-count here. Show
- the conversion list at first if appropriate.
+ (kkc-region): Update kkc-next-count and kkc-prev-count here.
+ Show the conversion list at first if appropriate.
(kkc-next): Don't update kkc-next-count here.
(kkc-prev): Don't update kkc-prev-count here.
(kkc-show-conversion-list-update): Fix setting up of conversion
@@ -15907,8 +15897,8 @@
* cus-edit.el (custom-buffer-create-internal): Use a help-echo
function to be more specific.
- * wid-edit.el (widget-specify-field, widget-specify-button): Allow
- non-string help-echo.
+ * wid-edit.el (widget-specify-field, widget-specify-button):
+ Allow non-string help-echo.
(widget-types-convert-widget): Defsubst it.
(widget-echo-help): Try to cope with a help-echo function of two
possible sorts.
@@ -15983,7 +15973,7 @@
Use fortran-comment-indent, not fortran-comment-indent-function.
(fortran-comment-region, fortran-electric-line-number): Simplify.
(fortran-auto-fill): New function.
- (fortran-do-auto-fill): Deleted.
+ (fortran-do-auto-fill): Delete.
(fortran-find-comment-start-skip):
Check for non-null comment-start-skip.
(fortran-auto-fill-mode, fortran-fill-statement):
@@ -15995,8 +15985,8 @@
2000-07-11 Eli Zaretskii <eliz@is.elta.co.il>
- * eshell/esh-module.el (toplevel): Reference
- byte-compile-current-file only if it is bound.
+ * eshell/esh-module.el (toplevel):
+ Reference byte-compile-current-file only if it is bound.
2000-07-10 Gerd Moellmann <gerd@gnu.org>
@@ -16010,7 +16000,7 @@
2000-07-10 Kenichi Handa <handa@etl.go.jp>
- * international/mule-diag.el (describe-font): Adjusted for the
+ * international/mule-diag.el (describe-font): Adjust for the
change of fontset-info.
(print-fontset): Likewise.
@@ -16049,7 +16039,7 @@
2000-07-01 Francesco Potortì <pot@gnu.org>
- * rmail.el (mail-unsent-separator): Changed "the" to "\\w+", as
+ * rmail.el (mail-unsent-separator): Change "the" to "\\w+", as
exim can use "your message" instead of "the message".
2000-07-06 Stefan Monnier <monnier@cs.yale.edu>
@@ -16064,8 +16054,8 @@
2000-07-05 Michael Kifer <kifer@cs.sunysb.edu>
* ediff-diff.el (ediff-wordify): Use syntax table.
- * ediff-init.el (ediff-has-face-support-p): Use
- ediff-color-display-p.
+ * ediff-init.el (ediff-has-face-support-p):
+ Use ediff-color-display-p.
(ediff-color-display-p): Use display-color-p, changed to defun
from defsubst.
Got rid of special cases for NeXT and OS/2.
@@ -16086,7 +16076,7 @@
* Makefile.in (DONTCOMPILE): Add comment that the name may
not be changed without changing the make-dist script.
- * emacs-lisp/cl-extra.el (cl-old-mapc): Removed; don't defalias mapc.
+ * emacs-lisp/cl-extra.el (cl-old-mapc): Remove; don't defalias mapc.
(cl-mapc): Use mapc instead of cl-old-mapc.
2000-07-05 Andrew Innes <andrewi@gnu.org>
@@ -16201,8 +16191,8 @@
* mouse.el (mouse-show-mark, mouse-save-then-kill): Don't use
window-system.
- * man.el (Man-notify-when-ready): Don't use window-system. If
- Man-notify-method is newframe, and the display is not
+ * man.el (Man-notify-when-ready): Don't use window-system.
+ If Man-notify-method is newframe, and the display is not
multi-frame, select the frame created for the man page.
(Man-init-defvars): Doc fix.
@@ -16278,7 +16268,7 @@
(sql-find-sqli-buffer): Make sure the default-value of sql-buffer
is used.
- (sql-informix): Added command line parameter "-" to force
+ (sql-informix): Add command line parameter "-" to force
sql-informix-program to use stdout.
2000-06-25 Eli Zaretskii <eliz@is.elta.co.il>
@@ -16292,8 +16282,8 @@
2000-06-23 Dave Love <fx@gnu.org>
* font-lock.el (font-lock-support-mode) <defgroup>: Add :version.
- (font-lock-fontify-anchored-keywords): Use
- line-beginning-position.
+ (font-lock-fontify-anchored-keywords):
+ Use line-beginning-position.
(global-font-lock-mode): Use mapc.
2000-06-23 Stefan Monnier <monnier@cs.yale.edu>
@@ -16351,14 +16341,14 @@
2000-06-22 Vinicius Jose Latorre <vinicius@cpqd.com.br>
* ps-print.el: Fix bug: if ^L is the very first buffer character,
- ps-print crashes. New feature: page selection for printing. Create
- raw-text-unix coding system for XEmacs. Doc fix.
+ ps-print crashes. New feature: page selection for printing.
+ Create raw-text-unix coding system for XEmacs. Doc fix.
(ps-print-version): New version number (5.2.3).
(ps-plot-region): Bug fix.
(ps-setup, ps-init-output-queue, ps-output, ps-begin-job, ps-end-file)
(ps-header-sheet, ps-generate, ps-end-job): Code fix.
- (ps-restore-selected-pages, ps-selected-pages, ps-print-page-p): New
- funs.
+ (ps-restore-selected-pages, ps-selected-pages, ps-print-page-p):
+ New funs.
(ps-selected-pages, ps-last-selected-pages, ps-first-page)
(ps-last-page): New vars.
@@ -16373,8 +16363,8 @@
2000-06-21 Kenichi Handa <handa@etl.go.jp>
- * international/mule-cmds.el (set-language-info-alist): Docstring
- fixed.
+ * international/mule-cmds.el (set-language-info-alist):
+ Docstring fixed.
2000-06-20 Gerd Moellmann <gerd@gnu.org>
@@ -16388,7 +16378,7 @@
2000-06-20 Stefan Monnier <monnier@cs.yale.edu>
* jit-lock.el (with-buffer-prepared-for-jit-lock):
- Renamed from with-buffer-prepared-for-font-lock and use
+ Rename from with-buffer-prepared-for-font-lock and use
inhibit-modification-hooks rather than setting *-change-functions.
Update all functions to use the new name.
(jit-lock-first-unfontify-pos): New semantics (and doc).
@@ -16405,20 +16395,20 @@
2000-06-20 Sam Steingold <sds@gnu.org>
- * emacs-lisp/cl-indent.el (toplevel): Indent
- `print-unreadable-object' properly. Untabify.
+ * emacs-lisp/cl-indent.el (toplevel):
+ Indent `print-unreadable-object' properly. Untabify.
2000-06-14 Carsten Dominik <dominik@strw.leidenuniv.nl>
* textmodes/reftex.el (reftex-find-citation-regexp-format):
Support for bibentry.
- (reftex-compile-variables): Fixed problem with end of section-re.
+ (reftex-compile-variables): Fix problem with end of section-re.
- * texmodes/reftex-dcr.el (reftex-view-crossref,
- reftex-view-crossref-from-bibtex):
+ * textmodes/reftex-dcr.el (reftex-view-crossref)
+ (reftex-view-crossref-from-bibtex):
Deal with changed `reftex-find-citation-regexp-format'.
(reftex-view-regexp-match, reftex-view-crossref-from-bibtex):
- Replaced `remprop' with `put'.
+ Replace `remprop' with `put'.
(reftex-view-crossref, reftex-view-crossref-when-idle):
Support for bibentry.
@@ -16500,8 +16490,8 @@
(isearch-minibuffer-input-method-function): These variables
deleted.
(isearch-with-input-method): Don't use the above variables.
- (isearch-process-search-multibyte-characters): Likewise. Call
- read-string with the arg INHERIT-INPUT-METHOD t.
+ (isearch-process-search-multibyte-characters): Likewise.
+ Call read-string with the arg INHERIT-INPUT-METHOD t.
2000-06-17 Stefan Monnier <monnier@cs.yale.edu>
@@ -16556,8 +16546,8 @@
2000-06-15 Gerd Moellmann <gerd@gnu.org>
* info.el (Info-find-in-tag-table-1, Info-find-in-tag-table)
- (Info-find-node-in-buffer-1, Info-find-node-in-buffer): New
- functions.
+ (Info-find-node-in-buffer-1, Info-find-node-in-buffer):
+ New functions.
(Info-find-node-2): Try a case-sensitive search first, then
do a case-insensitive search.
@@ -16585,8 +16575,8 @@
2000-06-15 Kenichi Handa <handa@etl.go.jp>
- * international/mule.el (set-buffer-file-coding-system): Almost
- rewritten to handle `undecided' as no-op.
+ * international/mule.el (set-buffer-file-coding-system):
+ Almost rewritten to handle `undecided' as no-op.
2000-06-14 Gerd Moellmann <gerd@gnu.org>
@@ -16609,8 +16599,8 @@
(tar-subfile-save-buffer): Likewise.
* international/mule.el
- (after-insert-file-set-buffer-file-coding-system): Call
- set-buffer-file-coding-system with the arg FORCE t.
+ (after-insert-file-set-buffer-file-coding-system):
+ Call set-buffer-file-coding-system with the arg FORCE t.
2000-06-13 Gerd Moellmann <gerd@gnu.org>
@@ -16630,15 +16620,15 @@
2000-06-13 Eli Zaretskii <eliz@is.elta.co.il>
- * frame.el (display-multi-frame-p, display-multi-font-p): New
- defaliases for display-graphic-p.
+ * frame.el (display-multi-frame-p, display-multi-font-p):
+ New defaliases for display-graphic-p.
* hl-line.el: Fixed a typo in commentary.
2000-06-13 Kenichi Handa <handa@etl.go.jp>
- * language/tibet-util.el (tibetan-tibetan-to-transcription): Typo
- fixed.
+ * language/tibet-util.el (tibetan-tibetan-to-transcription):
+ Typo fixed.
2000-06-12 Dave Love <fx@gnu.org>
@@ -16719,8 +16709,8 @@
2000-06-12 Kenichi Handa <handa@etl.go.jp>
- * international/mule.el (set-buffer-file-coding-system): If
- CODING-SYSTEM is nil, set buffer-file-coding-system to nil
+ * international/mule.el (set-buffer-file-coding-system):
+ If CODING-SYSTEM is nil, set buffer-file-coding-system to nil
unconditionally.
2000-06-12 Dave Love <fx@gnu.org>
@@ -16779,8 +16769,8 @@
* progmodes/executable.el: Byte compile dynamic.
(executable-insert): Change custom type.
(executable-find): Add autoload cookie.
- (executable-make-buffer-file-executable-if-script-p): New
- function. After Noah Friedman.
+ (executable-make-buffer-file-executable-if-script-p):
+ New function. After Noah Friedman.
* files.el (after-save-hook): Customize, with
executable-make-buffer-file-executable-if-script-p as an option.
@@ -16802,8 +16792,8 @@
2000-06-08 Dave Love <fx@gnu.org>
- * international/mule-cmds.el (select-safe-coding-system): If
- DEFAULT-CODING-SYSTEM is not specified, also check the most
+ * international/mule-cmds.el (select-safe-coding-system):
+ If DEFAULT-CODING-SYSTEM is not specified, also check the most
preferred coding-system if buffer-file-coding-system is
`undecided'. From Handa.
@@ -16927,8 +16917,8 @@
(ccl-encode-alternativnyj, ccl-encode-alternativnyj-font):
Likewise.
- * international/mule-diag.el (non-iso-charset-alist): Specify
- translation table symbol instead of translation table itself.
+ * international/mule-diag.el (non-iso-charset-alist):
+ Specify translation table symbol instead of translation table itself.
(list-block-of-chars): CHARSET may be a translation table symbol.
* international/mule.el (make-coding-system): If CODING-SYSTEM
@@ -16937,9 +16927,9 @@
* international/fontset.el: Use family `proportional' for Tibetan
fonts.
- * international/ccl.el (ccl-compile-translate-character): Don't
- check if Rrr has property translation-table.
- (ccl-compile-map-multiple): Modified to avoid compiler warning.
+ * international/ccl.el (ccl-compile-translate-character):
+ Don't check if Rrr has property translation-table.
+ (ccl-compile-map-multiple): Modify to avoid compiler warning.
2000-06-05 Gerd Moellmann <gerd@gnu.org>
@@ -16968,7 +16958,7 @@
(sh-help-string-for-variable, sh-guess-basic-offset):
Don't quote lambdas.
(sh-electric-rparen, sh-electric-hash, sh-search-word): Docstring typo.
- (sh-regexp-for-done, sh-kw-alist, sh-kw): Moved to before their use.
+ (sh-regexp-for-done, sh-kw-alist, sh-kw): Move to before their use.
* mail/mh-comp.el (mh-send-sub): Check mh-etc is bound before using it.
(mh-letter-mode): Derive from text-mode.
@@ -17027,18 +17017,18 @@
2000-06-02 Dave Love <fx@gnu.org>
* wid-edit.el: byte-compile-dynamic since we typically don't use
- all the widgets. Don't require cl or widget. Remove
- eval-and-compile. Don't autoload finder-commentary. Doc fixes.
- (widget-read-event): Removed. Callers changed to use read-event.
- (widget-button-release-event-p): Renamed from
+ all the widgets. Don't require cl or widget.
+ Remove eval-and-compile. Don't autoload finder-commentary. Doc fixes.
+ (widget-read-event): Remove. Callers changed to use read-event.
+ (widget-button-release-event-p): Rename from
button-release-event-p.
(widget-field-add-space, widget-field-use-before-change):
Uncustomize.
(widget-specify-field): Use keymap property, not local-map.
(widget-specify-button): Obey :suppress-face.
(widget-specify-insert): Use modern backquote syntax.
- (widget-image-directory): Renamed from widget-glyph-directory.
- (widget-image-enable): Renamed from widget-glyph-enable.
+ (widget-image-directory): Rename from widget-glyph-directory.
+ (widget-image-enable): Rename from widget-glyph-enable.
(widget-image-find): Replaces widget-glyph-find.
(widget-button-pressed-face): Move defvar.
(widget-image-insert): Replaces widget-glyph-insert.
@@ -17054,8 +17044,8 @@
(widget-sexp-prompt-value, widget-echo-help): Simplify.
(widget-default-create): Use widget-image-insert; some rewriting.
(widget-visibility-value-create)
- (widget-push-button-value-create, widget-toggle-value-create): Use
- widget-image-insert.
+ (widget-push-button-value-create, widget-toggle-value-create):
+ Use widget-image-insert.
(checkbox): Create on and off images dynamically.
(documentation-link): Change :help-echo.
(widget-documentation-link-echo-help): Remove.
@@ -17124,8 +17114,8 @@
(tibetan-composition-function): Fix args to
tibetan-compose-string.
- * language/tibetan.el (tibetan-composable-pattern): More
- characters included.
+ * language/tibetan.el (tibetan-composable-pattern):
+ More characters included.
(tibetan-consonant-transcription-alist): Rule for "R" added.
(tibetan-subjoined-transcription-alist): Rules for "+W", "+Y", and
"+R" added.
@@ -17164,8 +17154,8 @@
2000-05-31 Dave Love <fx@gnu.org>
- * loadhist.el (loadhist-hook-functions): Remove
- before-change-function, after-change-function.
+ * loadhist.el (loadhist-hook-functions):
+ Remove before-change-function, after-change-function.
(unload-feature): Deal with symbols which are both bound and
fbound.
@@ -17235,25 +17225,25 @@
2000-05-29 Christoph Wedler <Christoph.Wedler@sap.com>
- * antlr-mode.el: New commands: hide/unhide actions,
+ * progmodes/antlr-mode.el: New commands: hide/unhide actions,
upcase/downcase literals.
(antlr-tiny-action-length): New user option.
- (antlr-hide-actions): New command. Suggested by
- Bjoern Mielenhausen <Bjoern.Mielenhausen@sap.com>.
+ (antlr-hide-actions): New command.
+ Suggested by Bjoern Mielenhausen <Bjoern.Mielenhausen@sap.com>.
(antlr-mode-map): New binding [C-c C-v].
(antlr-mode-menu): New entries.
(antlr-downcase-literals): New command.
(antlr-upcase-literals): Ditto.
- * antlr-mode.el: Minor changes: indentation, mode-name.
+ * progmodes/antlr-mode.el: Minor changes: indentation, mode-name.
(antlr-indent-line): Indent cpp directive at column 0.
(antlr-mode): Use mode-name prefix "Antlr." instead of "Antlr/".
- * antlr-mode.el: XEmacs bug workaround, XEmacs hint.
+ * progmodes/antlr-mode.el: XEmacs bug workaround, XEmacs hint.
(antlr-font-lock-additional-keywords): Workaround for intentional
bug in XEmacs version of font-lock.
- (antlr-mode): Set symbol property `mode-name' to "Antlr". Could
- be used by a smarter version of `buffers-menu-grouping-function'.
+ (antlr-mode): Set symbol property `mode-name' to "Antlr".
+ Could be used by a smarter version of `buffers-menu-grouping-function'.
2000-05-29 Gerd Moellmann <gerd@gnu.org>
@@ -17275,8 +17265,8 @@
2000-05-28 Eli Zaretskii <eliz@is.elta.co.il>
- * international/codepage.el (cp-coding-system-for-codepage-1): Add
- eight-bit-graphic and eight-bit-control to safe charsets for cpNNN
+ * international/codepage.el (cp-coding-system-for-codepage-1):
+ Add eight-bit-graphic and eight-bit-control to safe charsets for cpNNN
coding systems.
2000-05-26 Dave Love <fx@gnu.org>
@@ -17285,10 +17275,10 @@
internal-find-face.
* mail/reporter.el: Maintainer change. Doc fixes.
- (reporter-version): Deleted.
+ (reporter-version): Delete.
* emacs-lisp/elp.el: Maintainer change.
- (elp-help-address, elp-submit-bug-report, elp-version): Deleted.
+ (elp-help-address, elp-submit-bug-report, elp-version): Delete.
2000-05-26 Stefan Monnier <monnier@cs.yale.edu>
@@ -17300,8 +17290,8 @@
* loadhist.el (unload-feature): Fix interactive spec [from
lijnzaad@ebi.ac.uk].
- * emacs-lisp/bytecomp.el (byte-compile-callargs-warn): Use
- subr-arity to check primitives.
+ * emacs-lisp/bytecomp.el (byte-compile-callargs-warn):
+ Use subr-arity to check primitives.
(byte-compile-flush-pending, byte-compile-file-form-progn)
(byte-compile-normal-call, byte-compile-list, byte-compile-concat)
(byte-compile-insert, byte-compile-funcall): Use mapc instead of
@@ -17364,8 +17354,8 @@
window-system.
(ffap-highlight): Always default to t.
- * emacs-lisp/edebug.el (edebug-emacs-19-specific): Call
- display-popup-menus-p instead of looking at window-system.
+ * emacs-lisp/edebug.el (edebug-emacs-19-specific):
+ Call display-popup-menus-p instead of looking at window-system.
* disp-table.el (standard-display-g1, standard-display-graphic):
Only refuse to use string glyphs on X and MS-Windows.
@@ -17384,8 +17374,8 @@
2000-05-25 Eli Zaretskii <eliz@is.elta.co.il>
- * international/mule-diag.el (describe-char-after): Use
- display-graphic-p instead of window-system, so that this function
+ * international/mule-diag.el (describe-char-after):
+ Use display-graphic-p instead of window-system, so that this function
works on MS-DOS.
2000-05-25 Eli Zaretskii <eliz@is.elta.co.il>
@@ -17398,8 +17388,8 @@
* international/mule-conf.el: Specify CHARSET-ID explicitly for
private charsets.
- (mule-unicode-0100-24ff, japanese-jisx0213-1,
- japanese-jisx0213-2): New charsets.
+ (mule-unicode-0100-24ff, japanese-jisx0213-1)
+ (japanese-jisx0213-2): New charsets.
* international/fontset.el: Setup default fontset for new charsets.
@@ -17412,7 +17402,7 @@
2000-05-24 Eric M. Ludlam <zappo@ultranet.com>
- * rmailout.el (rmail-output-to-rmail-file): Added optional param
+ * rmailout.el (rmail-output-to-rmail-file): Add optional param
STAY.
* rmail.el (rmail-automatic-folder-directives): New user variable.
@@ -17424,15 +17414,15 @@
* ediff-diff.el (ediff-forward-word): Take syntactic word class into
account.
- (ediff-test-utility,ediff-diff-mandatory-option)
+ (ediff-test-utility, ediff-diff-mandatory-option)
(ediff-reset-diff-options): Utilities for proper initialization of
ediff-diff-options and ediff-diff3-options on Windows.
* ediff-init.el (ediff-merge-filename-prefix): New customizable
variable.
- * ediff-mult.el (ediff-filegroup-action): Use
- ediff-merge-filename-prefix.
+ * ediff-mult.el (ediff-filegroup-action):
+ Use ediff-merge-filename-prefix.
2000-05-24 Michael Kifer <kifer@cs.sunysb.edu>
@@ -17470,14 +17460,14 @@
* speedbar.el (speedbar-easymenu-definition-base): Image toggle fix.
(speedbar-insert-button): Invisible text property fix.
- (speedbar-directory-plus): Renamed from speedbar-directory-+.
- (speedbar-directory-minus): Renamed from speedbar-directory--.
- (speedbar-page-plus): Renamed from speedbar-file-+.
- (speedbar-page-minus): Renamed from speedbar-file--.
- (speedbar-page): Renamed from speedbar-file-.
- (speedbar-tag): Renamed from speedbar-tag-.
- (speedbar-tag-plus): Renamed from speedbar-tag-+.
- (speedbar-tag-minus): Renamed from speedbar-tag--.
+ (speedbar-directory-plus): Rename from speedbar-directory-+.
+ (speedbar-directory-minus): Rename from speedbar-directory--.
+ (speedbar-page-plus): Rename from speedbar-file-+.
+ (speedbar-page-minus): Rename from speedbar-file--.
+ (speedbar-page): Rename from speedbar-file-.
+ (speedbar-tag): Rename from speedbar-tag-.
+ (speedbar-tag-plus): Rename from speedbar-tag-+.
+ (speedbar-tag-minus): Rename from speedbar-tag--.
(speedbar-expand-image-button-alist): Use above renames.
* sb-dir-plus.xpm: Renamed from sb-dir+.xpm
@@ -17490,8 +17480,8 @@
2000-05-24 Kenichi Handa <handa@etl.go.jp>
- * international/quail.el (quail-show-guidance-buf): Set
- current-input-method of the guidance buffer to the name of the
+ * international/quail.el (quail-show-guidance-buf):
+ Set current-input-method of the guidance buffer to the name of the
current input method.
2000-05-23 Stefan Monnier <monnier@cs.yale.edu>
@@ -17530,8 +17520,8 @@
2000-05-22 Dave Love <fx@gnu.org>
- * loadhist.el (feature-symbols, file-provides, file-requires): Use
- mapc.
+ * loadhist.el (feature-symbols, file-provides, file-requires):
+ Use mapc.
(feature-file): Avoid calling symbol-name. Doc fix.
(file-set-intersect, file-dependents): Use dolist, not mapcar.
(loadhist-hook-functions): Add mouse-position-function.
@@ -17547,7 +17537,7 @@
2000-05-22 Sam Steingold <sds@gnu.org>
- * info.el (Info-fontify-node): Fixed the call to
+ * info.el (Info-fontify-node): Fix the call to
`add-text-properties' (bug introduced on 2000-05-18).
2000-05-22 Dave Love <fx@gnu.org>
@@ -17557,11 +17547,11 @@
* progmodes/etags.el: Add to debug-ignored-errors.
(visit-tags-table-buffer): Clear out buffers holding old tables
when making a new list.
- (etags-recognize-tags-table, tags-recognize-empty-tags-table): Use
- mapc.
+ (etags-recognize-tags-table, tags-recognize-empty-tags-table):
+ Use mapc.
- * completion.el: Doc fixes. Add to debug-ignored-errors. Don't
- quote keywords.
+ * completion.el: Doc fixes. Add to debug-ignored-errors.
+ Don't quote keywords.
(cmpl-string-case-type): Use character classes.
* comint.el:
@@ -17592,8 +17582,8 @@
2000-05-22 Kenichi Handa <handa@etl.go.jp>
- * international/quail.el (quail-simple-translation-keymap): Map
- 128..255 to quail-self-insert-command.
+ * international/quail.el (quail-simple-translation-keymap):
+ Map 128..255 to quail-self-insert-command.
(quail-keyboard-layout-alist): Add definition for "pc102-de".
2000-05-22 Stefan Monnier <monnier@cs.yale.edu>
@@ -17613,8 +17603,8 @@
* edmacro.el (edmacro-parse-keys): Return vector if any elements
are invalid characters.
- * international/mule-util.el (detect-coding-with-priority): Use
- mapc. Remove redundant lambda.
+ * international/mule-util.el (detect-coding-with-priority):
+ Use mapc. Remove redundant lambda.
* international/mule-diag.el (list-non-iso-charset-chars)
(describe-fontset): Remove redundant lambda.
@@ -17675,14 +17665,14 @@
* mail/rmail.el (rmail-decode-quoted-printable): Use delete-region
and insert, not subst-char-in-region.
- * international/mule-diag.el (list-character-sets-1): Handle
- charsets eight-bit-control and eight-bit-graphic.
+ * international/mule-diag.el (list-character-sets-1):
+ Handle charsets eight-bit-control and eight-bit-graphic.
(list-iso-charset-chars): Likewise.
(list-block-of-chars): If CHARSET is not char-table, insert 8-bit
characters as is. Use indent-to to align characters.
- * international/mule-cmds.el (find-multibyte-characters): Never
- exclude charsets eight-bit-control and eight-bit-graphic.
+ * international/mule-cmds.el (find-multibyte-characters):
+ Never exclude charsets eight-bit-control and eight-bit-graphic.
2000-05-19 Stefan Monnier <monnier@cs.yale.edu>
@@ -17717,18 +17707,18 @@
* ps-print.el: Compatibility, customization and doc fix.
(ps-printer-name-option): Replace defconst by defvar.
(ps-postscript-code-directory): XEmacs compatibility.
- (ps-header-sheet, ps-setup, ps-begin-file, ps-begin-job): Code
- fix.
+ (ps-header-sheet, ps-setup, ps-begin-file, ps-begin-job):
+ Code fix.
(ps-user-defined-prologue, ps-print-prologue-header)
- (ps-xemacs-face-kind-p, ps-face-bold-p, ps-face-italic-p): XEmacs
- compatibility and code fix.
+ (ps-xemacs-face-kind-p, ps-face-bold-p, ps-face-italic-p):
+ XEmacs compatibility and code fix.
(ps-print-background-image, ps-print-background-text):
Customization fix.
(ps-line-number-start, ps-n-up-on): New vars.
2000-05-18 Espen Skoglund <esk@ira.uka.de>
- * pascal.el (pascal-indent-alist, pascal-indent-comment): Changed
+ * pascal.el (pascal-indent-alist, pascal-indent-comment): Change
the indent-comment function to just return the appropriate indent.
2000-05-18 Eric M. Ludlam <zappo@ultranet.com>
@@ -17747,8 +17737,8 @@
2000-05-18 Kenichi Handa <handa@etl.go.jp>
- * international/mule-diag.el (describe-char-after): Call
- internal-char-font, not char-font. If internal-char-font returns
+ * international/mule-diag.el (describe-char-after):
+ Call internal-char-font, not char-font. If internal-char-font returns
nil, display "-- none --".
2000-05-17 Eli Zaretskii <eliz@is.elta.co.il>
@@ -17794,8 +17784,8 @@
* help.el (view-emacs-FAQ): Change `emacs-faq' to `efaq'.
- * progmodes/compile.el (compilation-parse-errors): Collect
- `nomessage' regexps last.
+ * progmodes/compile.el (compilation-parse-errors):
+ Collect `nomessage' regexps last.
* dired.el (dired-mode-map): Use dired-do-query-replace-regexp.
@@ -17839,17 +17829,20 @@
(help-xref-following): New variable.
(help-make-xrefs): Use it.
(help-xref-go-back): Use position information from stack element.
- (help-follow): Make position in stack element a pair. Use
- help-xref-following.
+ (help-follow): Make position in stack element a pair.
+ Use help-xref-following.
* autoarg.el: New file.
* faces.el: Declare more functions obsolete.
- * viet-util.el, thai-util.el, tibet-util.el, slovak.el
- * misc-lang.el, romanian.el, korea-util.el, lao-util.el
- * japan-util.el, greek.el, hebrew.el, european.el, ethio-util.el
- * english.el, czech.el, devan-util.el, cyril-util.el, china-util.el:
+ * language/viet-util.el, language/thai-util.el, language/tibet-util.el:
+ * language/slovak.el, language/misc-lang.el, language/romanian.el:
+ * language/korea-util.el, language/lao-util.el, language/japan-util.el:
+ * language/greek.el, language/hebrew.el, language/european.el:
+ * language/ethio-util.el, language/english.el, language/czech.el:
+ * language/devan-util.el, language/cyril-util.el:
+ * language/china-util.el:
Remove all the setup-...-environment functions.
2000-05-13 Eric M. Ludlam <zappo@ultranet.com>
@@ -17860,16 +17853,16 @@
(speedbar-easymenu-definition-special): Add flush cache & expand.
(speedbar-visiting-tag-hook): Set new defaults. Added options.
(speedbar-reconfigure-keymaps-hook): New variable.
- (speedbar-frame-parameters): Updated documentation.
- (speedbar-use-imenu-flag): Updated custom tag.
+ (speedbar-frame-parameters): Update documentation.
+ (speedbar-use-imenu-flag): Update custom tag.
(speedbar-dynamic-tags-function-list): New variable.
- (speedbar-tag-hierarchy-method): Updated doc & custom.
+ (speedbar-tag-hierarchy-method): Update doc & custom.
(speedbar-indentation-width, speedbar-indentation-width) New
variables.
(speedbar-hide-button-brackets-flag): Customizable.
(speedbar-vc-indicator): Doc update.
- (speedbar-ignored-path-expressions): Updated default value.
- (speedbar-supported-extension-expressions): Updated default value.
+ (speedbar-ignored-path-expressions): Update default value.
+ (speedbar-supported-extension-expressions): Update default value.
(speedbar-syntax-table): Remove {} paren status.
(speedbar-file-key-map, speedbar-buffers-key-map): Add "=" to act
as "+". Added overlay aliases.
@@ -17881,24 +17874,24 @@
(speedbar-reconfigure-keymaps): Run configure keymap hooks.
(speedbar-item-info-tag-helper): Revamped to handle a wider range
of arbitrary text, and new helper functions.
- (speedbar-item-copy, speedbar-item-rename): Fixed trailing \ in
+ (speedbar-item-copy, speedbar-item-rename): Fix trailing \ in
filename finder.
(speedbar-make-button): Call `speedbar-insert-image-button-maybe'.
(speedbar-directory-buttons): Update path search/expansion.
(speedbar-make-tag-line): Pay attention to
`speedbar-indentation-width'. Use more care w/ invisible
properties.
- (speedbar-change-expand-button-char): Call
- `speedbar-insert-image-button-maybe'.
- (speedbar-apply-one-tag-hierarchy-method): Deleted (and replaced).
+ (speedbar-change-expand-button-char):
+ Call `speedbar-insert-image-button-maybe'.
+ (speedbar-apply-one-tag-hierarchy-method): Delete (and replaced).
(speedbar-sort-tag-hierarchy, speedbar-prefix-group-tag-hierarchy)
(speedbar-trim-words-tag-hierarchy)
(speedbar-simple-group-tag-hierarchy): New functions.
(speedbar-create-tag-hierarchy): Update doc, use new tag hooks.
- (speedbar-insert-imenu-list, speedbar-insert-etags-list): New
- functions.
+ (speedbar-insert-imenu-list, speedbar-insert-etags-list):
+ New functions.
(speedbar-mouse-set-point): New function.
- (speedbar-power-click): Updated documentation.
+ (speedbar-power-click): Update documentation.
(speedbar-line-token, speedbar-goto-this-file): Handle more types
of tag prefix text.
(speedbar-expand-line, speedbar-contract-line): Make more robust
@@ -17909,10 +17902,10 @@
(speedbar-tag-file): Use new `speedbar-fetch-dynamic-tags' fn.
Use new generator insertion method.
(speedbar-fetch-dynamic-tags): New function.
- (speedbar-fetch-dynamic-imenu): Removed code now handled in
+ (speedbar-fetch-dynamic-imenu): Remove code now handled in
`speedbar-fetch-dynamic-imenu'.
(speedbar-fetch-dynamic-etags): Fix current buffer problem.
- (speedbar-buffer-easymenu-definition): Added "Kill Buffer", and
+ (speedbar-buffer-easymenu-definition): Add "Kill Buffer", and
"Revert Buffer" menu items.
(speedbar-buffer-buttons-engine): Be smarter when creating a
filename tag (for expansion purposes.).
@@ -17937,17 +17930,17 @@
of character sets.
* international/mule-diag.el (describe-char-after): New function.
- (describe-font-internal): Adjusted for the change of font-info.
+ (describe-font-internal): Adjust for the change of font-info.
(describe-font): Likewise.
(print-fontset): Rewritten for the new fontset implementation.
(describe-fontset): Include fontset alias names in completion.
- (list-fontsets): Adjusted for the change of print-fontset.
+ (list-fontsets): Adjust for the change of print-fontset.
* simple.el (what-cursor-position): If DETAIL is non-nil, call
describe-char-after instead of displaying the detail in the echo
area.
(syntax-code-table): Format changed.
- (string-to-syntax): Adjusted for the above change.
+ (string-to-syntax): Adjust for the above change.
2000-05-12 Stefan Monnier <monnier@cs.yale.edu>
@@ -18037,8 +18030,8 @@
(help-xref-symbol-regexp): Add `face'.
(help-make-xrefs): Check for quoted face names and adapt regexp
submatch numbers to cope.
- (help-xref-interned): Maybe insert face doc too. Separate
- sections with a line of hyphens.
+ (help-xref-interned): Maybe insert face doc too.
+ Separate sections with a line of hyphens.
* faces.el: Some doc fixes. Declare some functions obsolete.
(describe-face): Add customize button. Return the help
@@ -18059,8 +18052,8 @@
simulations for greek-iso8859-7, add latin-iso8859-14 and
latin-iso8859-15.
- * international/mule-cmds.el (set-language-info-alist): Call
- define-prefix-command with 3 arguments, to make the map suitable
+ * international/mule-cmds.el (set-language-info-alist):
+ Call define-prefix-command with 3 arguments, to make the map suitable
for a menu.
2000-05-07 Dave Love <fx@gnu.org>
@@ -18088,8 +18081,8 @@
2000-05-04 Milan Zamazal <pdm@freesoft.cz>
- * glasses.el (glasses-convert-to-unreadable): Use
- `glasses-separator' instead of the hard-wired "_".
+ * progmodes/glasses.el (glasses-convert-to-unreadable):
+ Use `glasses-separator' instead of the hard-wired "_".
(glasses-mode): Call `glasses-make-unreadable' only in a single
place.
@@ -18119,7 +18112,7 @@
* subr.el (add-minor-mode): Handle AFTER for keymaps. Don't
set TOGGLE's value.
- * mailabbrev.el (mail-abbrev-insert-alias): Renamed from
+ * mailabbrev.el (mail-abbrev-insert-alias): Rename from
mail-interactive-insert-alias.
(mail-abbrev-complete-alias): New command.
(mail-mode-map): Bind it to `M-TAB'.
@@ -18153,8 +18146,8 @@
2000-05-02 Eli Zaretskii <eliz@is.elta.co.il>
- * international/mule-cmds.el (set-language-environment): Don't
- concat an integer (dos-codepage), use format instead.
+ * international/mule-cmds.el (set-language-environment):
+ Don't concat an integer (dos-codepage), use format instead.
2000-05-02 Dave Love <fx@gnu.org>
@@ -18195,8 +18188,8 @@
2000-04-28 Kenichi Handa <handa@etl.go.jp>
- * mail/sendmail.el (sendmail-send-it): Set
- buffer-file-coding-system to the selected coding system for MIME
+ * mail/sendmail.el (sendmail-send-it):
+ Set buffer-file-coding-system to the selected coding system for MIME
header.
2000-04-27 Gerd Moellmann <gerd@gnu.org>
@@ -18242,8 +18235,8 @@
* image.el (find-image): New function.
(defimage): Rewritten to find image at load time.
- * startup.el (normal-top-level-add-to-load-path): Handle
- case that the default directory is not in load-path.
+ * startup.el (normal-top-level-add-to-load-path):
+ Handle case that the default directory is not in load-path.
* help.el: Old patch from Stefan Monnier.
(help-xref-on-pp): New function.
@@ -18266,13 +18259,13 @@
2000-04-25 Gerd Moellmann <gerd@gnu.org>
- * replace.el (perform-replace): Add parameters START and END. Use
- them instead of the check for a region in Transient Mark mode.
+ * replace.el (perform-replace): Add parameters START and END.
+ Use them instead of the check for a region in Transient Mark mode.
(query-replace-read-args): Return two more list elements for the
start and end of the region in Transient Mark mode.
(query-replace, query-replace-regexp, query-replace-regexp-eval)
- (map-query-replace-regexp, replace-string, replace-regexp): Add
- optional last arguments START and END and pass them to
+ (map-query-replace-regexp, replace-string, replace-regexp):
+ Add optional last arguments START and END and pass them to
perform-replace.
* progmodes/ebrowse.el (ebrowse-tags-query-replace): Construct a
@@ -18337,7 +18330,7 @@
* progmodes/inf-lisp.el (inferior-lisp-mode): Don't set
non-existing variable comint-input-sentinel.
- (inferior-lisp-args-to-list): Removed.
+ (inferior-lisp-args-to-list): Remove.
(inferior-lisp): Use split-string instead of
inferior-lisp-args-to-list.
@@ -18480,17 +18473,17 @@
* textmodes/ispell.el (ispell-cmd-args, ispell-output-buffer)
(ispell-session-buffer): New variables.
- (ispell-start-process, ispell-process-status,
- ispell-accept-output, ispell-send-string): New functions, for
+ (ispell-start-process, ispell-process-status)
+ (ispell-accept-output, ispell-send-string): New functions, for
Ispell invocation when async subprocesses aren't supported.
- (ispell-word, ispell-pdict-save, ispell-command-loop,
- ispell-process-line, ispell-buffer-local-parsing): Replace calls
+ (ispell-word, ispell-pdict-save, ispell-command-loop)
+ (ispell-process-line, ispell-buffer-local-parsing): Replace calls
to process-send-string with calls to ispell-send-string, and
accept-process-output with ispell-accept-output.
(ispell-init-process): Call ispell-process-status instead of
process-status with.
- (ispell-init-process): Call ispell-start-process. Call
- ispell-accept-output and ispell-send-string. Don't call
+ (ispell-init-process): Call ispell-start-process.
+ Call ispell-accept-output and ispell-send-string. Don't call
process-kill-without-query and kill-process if they are unbound.
(ispell-async-processp): New function.
@@ -18502,22 +18495,22 @@
* menu-bar.el (menu-bar-options-menu): Make `mule' always visible.
Modify `truncate-lines'. Make `describe-language-environment'
- always visible and add help. Modify `describe-key' help. Invoke
- Info-directory from `info'. New entry `emacs-manual'.
+ always visible and add help. Modify `describe-key' help.
+ Invoke Info-directory from `info'. New entry `emacs-manual'.
2000-04-10 Gerd Moellmann <gerd@gnu.org>
* progmodes/ebrowse.el (ebrowse-tree-mode):
Use propertized-buffer-identification.
(ebrowse-update-member-buffer-mode-line): Likewise.
- (ebrowse--mode-strings): Removed.
- (ebrowse--mode-line-props): Removed.
+ (ebrowse--mode-strings): Remove.
+ (ebrowse--mode-line-props): Remove.
* files.el (auto-mode-alist): Add `EBROWSE'.
* progmodes/ebrowse.el (ebrowse-read): Skip forward over white
space before testing for end of buffer.
- (ebrowse-load): Removed.
+ (ebrowse-load): Remove.
(ebrowse-revert-tree-buffer-from-file): Rewritten.
(ebrowse-create-tree-buffer): Rewritten.
(ebrowse-tree-mode): Read tree from buffer.
@@ -18548,7 +18541,7 @@
* progmodes/ebrowse-ffh.el: New file.
* progmodes/ebrowse.el (ebrowse-find-file-hook-fn):
- Moved to ebrowse-ffh.el.
+ Move to ebrowse-ffh.el.
(ebrowse-load): Add autoload.
* finder.el (finder-commentary): Add autoload cookie.
@@ -18607,7 +18600,7 @@
2000-04-04 Milan Zamazal <pdm@freesoft.cz>
- * glasses.el: Provide facilities for inserting space before left
+ * progmodes/glasses.el: Provide facilities for inserting space before left
parentheses and uncapitalization of identifiers.
(glasses-mode): Try to remove old overlays in all cases.
@@ -18753,7 +18746,7 @@
(network-connection-mode-setup): New function, saves host and
service information in local variables.
- * locate.el (locate-word-at-point): Added this function.
+ * locate.el (locate-word-at-point): Add this function.
(locate): Default to using locate-word-at-point as input
Run dired-mode-hook
@@ -18891,9 +18884,9 @@
text of the URL was passed. Now the whole URL structure is passed
and the function is responsible for extracting the parts it requires.
Changed the default of `quickurl-format-function' accordingly.
- (quickurl-insert): Changed the `funcall' of
+ (quickurl-insert): Change the `funcall' of
`quickurl-format-function' to match the above change.
- (quickurl-list-insert): Changed the `url' case so that it makes
+ (quickurl-list-insert): Change the `url' case so that it makes
use of `quickurl-format-function', previous to this the format was
hard wired.
@@ -19023,7 +19016,7 @@
* international/mule-diag.el (describe-font): Don't refer to
global-fontset-alist, instead call font-list.
(describe-fontset, list-fontsets, mule-diag): Likewise.
- (print-fontset): Adjusted for the change of fontset implementation.
+ (print-fontset): Adjust for the change of fontset implementation.
* international/fontset.el (x-charset-registries): Variable removed,
instead the corresponding data is stored in the default fontset.
@@ -19141,7 +19134,7 @@
2000-03-14 Dave Love <fx@gnu.org>
- * subr.el (replace-regexp-in-string): Renamed from
+ * subr.el (replace-regexp-in-string): Rename from
replace-regexps-in-string. Doc fix.
2000-03-12 Dave Love <fx@gnu.org>
@@ -19251,12 +19244,12 @@
* mouse.el (mouse-drag-region): Don't run up-event handler
if hscroll has changed.
- * octave-mod.el (octave-font-lock-keywords): To font-lock the
+ * progmodes/octave-mod.el (octave-font-lock-keywords): To font-lock the
builtin operators, use `font-lock-builtin-face' for Emacs and
`font-lock-preprocessor-face' otherwise.
- * font-lock.el (lisp-font-lock-keywords-1): Highlight
- `(defun (setf foo)' differently.
+ * font-lock.el (lisp-font-lock-keywords-1):
+ Highlight `(defun (setf foo)' differently.
2000-03-08 Stefan Monnier <monnier@cs.yale.edu>
@@ -19272,7 +19265,7 @@
both cases close together. Also apply a more generic algorithm
for suffixes (the mirror image of the algorithm used for
prefixes). Use shy-groups. Use nreverse rather than reverse.
- (regexp-opt-try-suffix): Removed.
+ (regexp-opt-try-suffix): Remove.
* cmuscheme.el (inferior-scheme-mode-map): Define it independently
from comint-mode-map, so we can just inherit from it. Also, move
@@ -19404,20 +19397,20 @@
2000-03-01 David Ponce <david.ponce@wanadoo.fr>
- * recentf.el (recentf): Added version tag to the defgroup of recentf.
+ * recentf.el (recentf): Add version tag to the defgroup of recentf.
2000-03-01 David Ponce <david.ponce@wanadoo.fr>
- * recentf.el (recentf-cleanup): Changed to remove excluded file too.
+ * recentf.el (recentf-cleanup): Change to remove excluded file too.
(recentf-edit-list-action): `recentf-edit-list' checkbox widget
action to select/unselect a file.
(recentf-edit-list): Code cleanup and improvement.
(recentf-open-more-files-action): `recentf-open-more-files' button
widget action to open a file.
(recentf-open-more-files): No more use standard completion but widgets.
- (recentf-more-collection): Deleted.
- (recentf-more-history): Deleted.
- (recentf-setup-more-completion): Deleted.
+ (recentf-more-collection): Delete.
+ (recentf-more-history): Delete.
+ (recentf-setup-more-completion): Delete.
2000-03-01 David Ponce <david.ponce@wanadoo.fr>
@@ -19431,7 +19424,7 @@
(recentf-edit-selected-items): New global variable, used by
`recentf-edit-list' to hold the list of files to be removed from
the recent list.
- (recentf-make-menu-items): Updated to display a "Edit list..."
+ (recentf-make-menu-items): Update to display a "Edit list..."
menu item. Minor code cleanup.
2000-03-01 David Ponce <david.ponce@wanadoo.fr>
@@ -19444,7 +19437,7 @@
used by `recentf-open-more-files' completion.
(recentf-setup-more-completion): New function to setup completion for
`recentf-open-more-files'.
- (recentf-make-menu-items): Updated to display a "More..." menu item.
+ (recentf-make-menu-items): Update to display a "More..." menu item.
2000-03-01 David Ponce <david.ponce@wanadoo.fr>
@@ -19457,8 +19450,8 @@
(recentf-make-menu-items): New menu filter handling.
(recentf-make-menu-item): New helper function.
(recentf-menu-elements): New menu handling function.
- (recentf-sort-ascending): Updated to new menu filter handling.
- (recentf-sort-descending): Updated to new menu filter handling.
+ (recentf-sort-ascending): Update to new menu filter handling.
+ (recentf-sort-descending): Update to new menu filter handling.
(recentf-sort-basenames-ascending): New menu filter function.
(recentf-sort-basenames-descending): New menu filter function.
(recentf-show-basenames): New menu filter function.
@@ -19497,20 +19490,20 @@
instead of assoc-delete-all.
(frame-notice-user-settings): Ditto.
- * subr.el (assq-delete-all): Renamed from assoc-delete-all.
+ * subr.el (assq-delete-all): Rename from assoc-delete-all.
Don't copy alist.
2000-02-28 Eli Barzilay <eli@cs.cornell.edu>
* calculator.el (calculator-use-menu): New option.
- (calculator-initial-bindings): Changed some bindings to work as macros.
- (calculator-forced-input): Removed.
+ (calculator-initial-bindings): Change some bindings to work as macros.
+ (calculator-forced-input): Remove.
(calculator-restart-other-mode): New variable.
(calculator-mode-map): Set up menu.
2000-02-28 Jari Aalto <jari.aalto@poboxes.com>
- * font-lock.el (java-keywords): Added missing java 1.2.2 Javadoc tags.
+ * font-lock.el (java-keywords): Add missing java 1.2.2 Javadoc tags.
2000-02-28 Michael Kifer <kifer@cs.sunysb.edu>
@@ -19589,7 +19582,7 @@
(footnote-latin-regexp): New variable.
(Footnote-latin): New function.
(footnote-style-alist): Add element for latin style.
- (footnote-style): Moved.
+ (footnote-style): Move.
(Footnote-goto-footnote): Use eq to test arg.
* mouse.el (mouse-drag-mode-line-1): Remove `growth =' message.
@@ -19759,7 +19752,7 @@
2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * textmodes/bibtex.el (bibtex-mode): Replaced manual splitting of path
+ * textmodes/bibtex.el (bibtex-mode): Replace manual splitting of path
at ':' characters by call to split-string.
2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
@@ -19771,21 +19764,21 @@
* textmodes/bibtex.el: Some temporary comments removed.
(bibtex-field-name, bibtex-entry-type): Made the relationship explicit.
(bibtex-field-const): Allow capital letters.
- (bibtex-start-of-string): Deleted because unused.
+ (bibtex-start-of-string): Delete because unused.
* textmodes/bibtex.el: Unified some nomenclature. We no longer
use the term 'reference' to describe a bibtex entry as a whole.
Further, reference keys are no longer called 'labels'.
- (bibtex-keys): Renamed to bibtex-reference-keys.
- (bibtex-reformat-previous-labels): Renamed to
+ (bibtex-keys): Rename to bibtex-reference-keys.
+ (bibtex-reformat-previous-labels): Rename to
bibtex-reformat-previous-reference-keys.
- (bibtex-reference-type): Renamed to bibtex-entry-type.
- (bibtex-reference-head): Renamed to bibtex-entry-head.
- (bibtex-reference-maybe-empty-head): Renamed to
+ (bibtex-reference-type): Rename to bibtex-entry-type.
+ (bibtex-reference-head): Rename to bibtex-entry-head.
+ (bibtex-reference-maybe-empty-head): Rename to
bibtex-entry-maybe-empty-head.
- (bibtex-key-in-reference): Renamed to bibtex-key-in-entry.
- (bibtex-search-reference): Renamed to bibtex-search-entry.
- (bibtex-enclosing-reference-maybe-empty-head): Renamed to
+ (bibtex-key-in-reference): Rename to bibtex-key-in-entry.
+ (bibtex-search-reference): Rename to bibtex-search-entry.
+ (bibtex-enclosing-reference-maybe-empty-head): Rename to
bibtex-enclosing-entry-maybe-empty-head.
(bibtex-entry-field-alist, bibtex-entry-head)
(bibtex-font-lock-keywords, bibtex-skip-to-valid-entry)
@@ -19796,11 +19789,11 @@
(bibtex-make-field, bibtex-end-of-entry, bibtex-sort-buffer)
(bibtex-find-entry-location, bibtex-validate, bibtex-find-text)
(bibtex-kill-entry, bibtex-clean-entry, bibtex-reformat)
- (bibtex-complete-key, bibtex-String) : Use the new nomenclature.
+ (bibtex-complete-key, bibtex-String): Use the new nomenclature.
2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * textmodes/bibtex.el (bibtex-strings, bibtex-keys): Removed redundant
+ * textmodes/bibtex.el (bibtex-strings, bibtex-keys): Remove redundant
comment.
(bibtex-format-field-delimiters): New function, functionality
extracted from bibtex-format-entry.
@@ -19820,7 +19813,7 @@
(bibtex-field-string-or-const, bibtex-field-text, bibtex-field)
(bibtex-name-in-field, bibtex-text-in-field, bibtex-reference-infix)
(bibtex-string, bibtex-key-in-string, bibtex-text-in-string):
- Deleted as parsing is now performed by the following functions.
+ Delete as parsing is now performed by the following functions.
(bibtex-parse-nested-braces, bibtex-parse-field-string-braced)
(bibtex-parse-quoted-string, bibtex-parse-field-string-quoted)
(bibtex-parse-field-string, bibtex-search-forward-field-string)
@@ -19839,7 +19832,7 @@
entries. Instead of reporting the results of the parsing by
match-beginning or match-end, these functions return data structures
that hold the corresponding positions.
- (bibtex-enclosing-field): Changed to also report field boundaries by
+ (bibtex-enclosing-field): Change to also report field boundaries by
return values rather than by match-beginning or match-end.
The following functions have been adapted to use the new
parsing functions.
@@ -19885,11 +19878,11 @@
* bibtex.el: Hiding of entry bodies is not longer provided by
bibtex.el directly. Instead the hideshow package can be used.
Added a special bibtex entry to hs-special-modes-alist.
- (bibtex-hs-forward-sexp): Added for hideshow.el.
+ (bibtex-hs-forward-sexp): Add for hideshow.el.
2000-02-15 Dirk Herrmann <D.Herrmann@tu-bs.de>
- * bibtex.el (bibtex-entry-field-alist): Added booktitle field to
+ * bibtex.el (bibtex-entry-field-alist): Add booktitle field to
proceedings entry type (for cross referencing). Thanks to Wagner
Toledo Correa for the suggestion.
@@ -19902,11 +19895,11 @@
2000-02-12 Gerd Moellmann <gerd@gnu.org>
* uniquify.el (toplevel): Require CL at compile time.
- (uniquify-push): Removed.
+ (uniquify-push): Remove.
- * shadowfile.el (shadow-when): Removed.
+ * shadowfile.el (shadow-when): Remove.
- * tempo.el (tempo-dolist, tempo-mapc): Removed.
+ * tempo.el (tempo-dolist, tempo-mapc): Remove.
(tempo-process-and-insert-string): Use dolist instead of tempo-dolist.
* textmodes/sgml-mode.el (sgml-mode-common): Remove `$' from
@@ -19919,7 +19912,7 @@
* wid-edit.el (widgets) [defgroup]: Remove url link.
(widget-color-choice-list, widget-color-history, widget-mouse-help):
- Deleted.
+ Delete.
(widget-specify-field, widget-specify-button): Don't use
widget-mouse-help as help-echo property.
(default): Use #'ignore for :validate and :mouse-down-action.
@@ -19929,22 +19922,22 @@
(widget-color-complete): Use facemenu-color-alist.
(widget-color-action): Use facemenu-read-color.
- * emacs-lisp/cl-macs.el: Don't bother testing for defalias. Don't
- set up `caar' &c that we now have.
+ * emacs-lisp/cl-macs.el: Don't bother testing for defalias.
+ Don't set up `caar' &c that we now have.
2000-02-09 Ray Blaak <blaak@gnu.org>
- * delphi.el: Make resourcestring a declaration region, like const
- and var.
+ * progmodes/delphi.el: Make resourcestring a declaration region,
+ like const and var.
2000-02-09 Dave Love <fx@gnu.org>
* bindings.el (mode-line-input-method-map): New variable.
(mode-line-mule-info): Use it; fix last change.
(mode-line-mode-menu): Move definition.
- (mode-line-mouse-sensitive-p): Deleted.
+ (mode-line-mouse-sensitive-p): Delete.
(mode-line-mode-name): Don't use mode-line-mouse-sensitive-p.
- (make-mode-line-mouse-sensitive): Deleted. Body moved to top level.
+ (make-mode-line-mouse-sensitive): Delete. Body moved to top level.
* startup.el (command-line-1): Don't call
make-mode-line-mouse-sensitive.
@@ -19967,7 +19960,7 @@
(font-lock-add-keywords): Make it work even if font-lock-mode is nil,
so that it can be used more easily in <foo>-mode-hook. Also make sure
to avoid duplicate entries.
- (font-lock-update-removed-keyword-alist): Renamed `major-mode'->`mode'.
+ (font-lock-update-removed-keyword-alist): Rename `major-mode'->`mode'.
(font-lock-remove-keywords): Just as was done for `add', allow it to
work even if font-lock-mode is nil. Also make sure we don't modify
any pre-existing list by forcing a copy-sequence. Finally rename
@@ -20012,12 +20005,12 @@
(idlwave-if, idlwave-procedure, idlwave-function, idlwave-repeat)
(idlwave-while): Respect `idlwave-reserved-word-upcase'.
(idlwave-rw-case): New function.
- (idlwave-statement-match): Fixed problem with assignment regexp.
- (idlwave-font-lock-keywords): Improved regexp for keyword parameters.
+ (idlwave-statement-match): Fix problem with assignment regexp.
+ (idlwave-font-lock-keywords): Improve regexp for keyword parameters.
(idlwave-surround): New argument LENGTH to support padding of
operators longer than 1 char.
- * progmodes/idlw-shell.el (idlwave-shell-print): Fixed bug with
+ * progmodes/idlw-shell.el (idlwave-shell-print): Fix bug with
idlwave-shell-expression-overlay. Implemented printing of
expressions on higher levels of the calling stack.
(idlwave-shell-display-level-in-calling-stack): Restore stack level.
@@ -20030,7 +20023,7 @@
negative level numbers.
(idlwave-shell-mode): Set `modeline-format'.
(idlwave-shell-display-line): Set `idlwave-shell-mode-line-info'.
- (idlwave-shell-make-new-bp-overlay): Fixed glyph display for Emacs 21.
+ (idlwave-shell-make-new-bp-overlay): Fix glyph display for Emacs 21.
(idlwave-shell-print-expression-function): New option.
* progmodes/idlw-toolbar.el (idlwave-toolbar-add-everywhere)
@@ -20103,15 +20096,15 @@
* windmove.el: New file.
- * progmodes/ebnf2ps.el, progmodes/ebnf-bnf.el,
- progmodes/ebnf-iso.el, progmodes/ebnf-otz.el,
- progmodes/ebnf-yac.el: Update copyright and license info.
+ * progmodes/ebnf2ps.el, progmodes/ebnf-bnf.el:
+ * progmodes/ebnf-iso.el, progmodes/ebnf-otz.el:
+ * progmodes/ebnf-yac.el: Update copyright and license info.
* jit-lock.el (jit-lock-function): Widen before calculating
end position.
(jit-lock-stealth-chunk-start): Rewritten.
- * info.el (Info-title-face-alist): Removed.
+ * info.el (Info-title-face-alist): Remove.
(Info-title-1-face, Info-title-2-face, Info-title-3-face): New faces.
(Info-fontify-node): Use these faces.
@@ -20182,8 +20175,8 @@
2000-01-28 Gerd Moellmann <gerd@gnu.org>
- * emacs-lisp/cl-macs.el (cl-parse-loop-clause): Recognize
- `collecting' as synonym for `collect'.
+ * emacs-lisp/cl-macs.el (cl-parse-loop-clause):
+ Recognize `collecting' as synonym for `collect'.
* ange-ftp.el (ange-ftp-copy-file-internal): Quote new name
for the case it contains spaces.
@@ -20259,7 +20252,7 @@
Do not call make-variable-buffer-local.
(end-of-defun): Use new variable name; doc fix.
- * subr.el (dolist, dotimes): Copied from cl-macs.el
+ * subr.el (dolist, dotimes): Copy from cl-macs.el
and made to work.
* mail/undigest.el (rmail-digest-end-regexps):
@@ -20288,7 +20281,7 @@
2000-01-14 Gerd Moellmann <gerd@gnu.org>
- * emacs-lisp/copyright.el (copyright-update): Removed the
+ * emacs-lisp/copyright.el (copyright-update): Remove the
requirement for a trailing space from `copyright-regexp', to
support copyrights with owner specified on a separate line..
@@ -20337,7 +20330,7 @@
* net: New directory.
- * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Renamed from
+ * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Rename from
eval-last-sexp. Don't bind debug-on-error here.
(eval-last-sexp): New function. Bind debug-on-error if
eval-expression-debug-on-error is non-nil.
@@ -20356,9 +20349,9 @@
* emacs-lisp/lisp-mode.el (with-syntax-table):
Set up lisp-indent-function property.
- * subr.el (with-syntax-table): Moved from simple.el.
+ * subr.el (with-syntax-table): Move from simple.el.
- * simple.el (with-syntax-table): Moved to subr.el.
+ * simple.el (with-syntax-table): Move to subr.el.
2000-01-11 Gerd Moellmann <gerd@gnu.org>
@@ -20388,7 +20381,7 @@
2000-01-10 John Wiegley <johnw@gnu.org>
- * allout.el (isearch-done/outline-provisions): Added `edit'
+ * allout.el (isearch-done/outline-provisions): Add `edit'
argument to correspond with the current definition of `isearch-done'.
2000-01-10 Dave Love <fx@gnu.org>
@@ -20410,17 +20403,17 @@
(version20p): New variable.
(xemacsp): New variable.
(ispell-choices-win-default-height): Fix for XEmacs visibility.
- (ispell-dictionary-alist1): Added Brasileiro dictionary.
+ (ispell-dictionary-alist1): Add Brasileiro dictionary.
(ispell-dictionary-alist6): Russian command lines no longer accept
run-together words.
(ispell-local-dictionary-alist): Add koi8-r to customize definition.
(ispell-dictionary-alist): Add koi8-r to customize definition.
- (check-ispell-version): Added documentation string. Return library
+ (check-ispell-version): Add documentation string. Return library
path when called non-interactively.
(ispell-menu-map-needed): Uses new variables.
(ispell-library-path): New variable.
(ispell-decode-string): XEmacs fix for bogus variable bindings.
- (ispell-word): Improved documentation string. Test for valid
+ (ispell-word): Improve documentation string. Test for valid
character mappings. Correctly check typed in word changes that can
result in single words split into multiple words.
Return replacement word.
@@ -20484,7 +20477,7 @@
2000-01-07 Dave Love <fx@gnu.org>
- * add-log.el (add-log-debugging): Deleted.
+ * add-log.el (add-log-debugging): Delete.
(add-change-log-entry): Treat a backup FILE-NAME as its parent
file. Remove debugging code.
(change-log-get-method-definition, change-log-name): Add doc.
@@ -20525,7 +20518,7 @@
M-C-e, M-C-h, C-j, C-xnd, TAB.
(fortran-mode): Set beginning-of-defun, end-of-defun.
(fortran-column-ruler): Simplify.
- (fortran-mark-subprogram, fortran-narrow-to-subprogram): Deleted.
+ (fortran-mark-subprogram, fortran-narrow-to-subprogram): Delete.
(fortran-with-subprogram-narrowing): Likewise.
(fortran-indent-subprogram): Call mark-defun.
(fortran-check-for-matching-do): Change narrowing.
@@ -20638,7 +20631,7 @@
* faces.el (face-read-integer, read-face-attribute)
(color-defined-p, color-values): Unspecified-{f,b}g are now strings.
-2000-01-03 Martin Stjernholm <bug-cc-mode@gnu.org>
+2000-01-03 Martin Stjernholm <mast@lysator.liu.se>
* progmodes/cc-cmds.el (c-fill-paragraph): Count number of spaces
at comment end, and re-insert them after filling.
@@ -20668,7 +20661,7 @@
(display-color-p, frame-set-background-mode): Pass the frame to
tty-display-color-p.
- * term/tty-colors.el (tty-defined-color-alist): Renamed from
+ * term/tty-colors.el (tty-defined-color-alist): Rename from
tty-color-alist.
(tty-color-alist, tty-modify-color-alist): New functions.
(tty-color-define, tty-color-clear, tty-color-approximate)
@@ -20692,7 +20685,7 @@ See ChangeLog.8 for earlier changes.
;; coding: utf-8
;; End:
- Copyright (C) 2000-2011, 2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2011, 2013-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 066e15368da..ed1246b0cf4 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -1,6 +1,6 @@
### @configure_input@
-# Copyright (C) 2000-2013 Free Software Foundation, Inc.
+# Copyright (C) 2000-2015 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
@@ -17,25 +17,43 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-SHELL = /bin/sh
+SHELL = @SHELL@
srcdir = @srcdir@
top_srcdir = @top_srcdir@
-abs_top_builddir = @abs_top_builddir@
lisp = $(srcdir)
VPATH = $(srcdir)
+EXEEXT = @EXEEXT@
# Empty for all systems except MinGW, where xargs needs an explicit
# limitation.
XARGS_LIMIT = @XARGS_LIMIT@
+# 'make' verbosity.
+AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
+
+AM_V_ELC = $(am__v_ELC_@AM_V@)
+am__v_ELC_ = $(am__v_ELC_@AM_DEFAULT_V@)
+am__v_ELC_0 = @echo " ELC " $@;
+am__v_ELC_1 =
+
+AM_V_GEN = $(am__v_GEN_@AM_V@)
+am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
+am__v_GEN_0 = @echo " GEN " $@;
+am__v_GEN_1 =
+
+AM_V_at = $(am__v_at_@AM_V@)
+am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
+am__v_at_0 = @
+am__v_at_1 =
+
# You can specify a different executable on the make command line,
# e.g. "make EMACS=../src/emacs ...".
-# We sometimes change directory before running Emacs (typically when
-# building out-of-tree, we chdir to the source directory), so we need
-# to use an absolute file name.
-EMACS = ${abs_top_builddir}/src/emacs
+# We never change directory before running Emacs, so a relative file
+# name is fine, and makes life easier. If we need to change
+# directory, we can use emacs --chdir.
+EMACS = ../src/emacs${EXEEXT}
# Command line flags for Emacs.
@@ -47,12 +65,6 @@ BYTE_COMPILE_EXTRA_FLAGS =
# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
# The example above is just for developers, it should not be used by default.
-lisptagsfiles1 = $(lisp)/*.el
-lisptagsfiles2 = $(lisp)/*/*.el
-lisptagsfiles3 = $(lisp)/*/*/*.el
-lisptagsfiles4 = $(lisp)/*/*/*/*.el
-ETAGS = ../lib-src/etags
-
# Automatically generated autoload files, apart from lisp/loaddefs.el.
# Note this includes only those files that need special rules to
# build; ie it does not need to include things created via
@@ -74,18 +86,8 @@ AUTOGENEL = loaddefs.el \
eshell/esh-groups.el \
cedet/semantic/loaddefs.el \
cedet/ede/loaddefs.el \
- cedet/srecode/loaddefs.el
-
-# Versioned files that are the value of someone's `generated-autoload-file'.
-# Note that update_loaddefs parses this.
-AUTOGEN_VCS = \
- ps-print.el \
- emulation/tpu-edt.el \
- mail/rmail.el \
- dired.el \
- ibuffer.el \
- htmlfontify.el \
- emacs-lisp/eieio.el
+ cedet/srecode/loaddefs.el \
+ org/org-loaddefs.el
# Value of max-lisp-eval-depth when compiling initially.
# During bootstrapping the byte-compiler is run interpreted when compiling
@@ -94,12 +96,14 @@ AUTOGEN_VCS = \
BIG_STACK_DEPTH = 2200
BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
-BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
+# Set load-prefer-newer for the benefit of the non-bootstrappers.
+BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) \
+ --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
# the slowest-compiler on the smallest file and move to larger files as the
-# compiler gets faster. `autoload.elc' comes last because it is not used by
+# compiler gets faster. 'autoload.elc' comes last because it is not used by
# the compiler (so its compilation does not speed up subsequent compilations),
# it's only placed here so as to speed up generation of the loaddefs.el file.
@@ -110,41 +114,32 @@ COMPILE_FIRST = \
$(lisp)/emacs-lisp/bytecomp.elc \
$(lisp)/emacs-lisp/autoload.elc
-# The actual Emacs command run in the targets below.
+# Prevent any settings in the user environment causing problems.
+unexport EMACSDATA EMACSDOC EMACSPATH
-emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
-
-# Common command to find subdirectories
-setwins=subdirs=`find . -type d -print`; \
- for file in $$subdirs; do \
- case $$file in */.* | */.*/* | */=* ) ;; \
- *) wins="$$wins $$file" ;; \
- esac; \
- done
-
-# Find all subdirectories except `obsolete' and `term'.
-setwins_almost=subdirs=`find . -type d -print`; \
- for file in $$subdirs; do \
- case $$file in */.* | */.*/* | */=* | */obsolete | */term ) ;; \
- *) wins="$$wins $$file" ;; \
- esac; \
- done
-
-# Find all subdirectories in which we might want to create subdirs.el
-setwins_for_subdirs=subdirs=`find . -type d -print`; \
- for file in $$subdirs; do \
- case $$file in */.* | */.*/* | */=* | */cedet* ) ;; \
- *) wins="$$wins $$file" ;; \
- esac; \
- done
+# The actual Emacs command run in the targets below.
+# Prevent any setting of EMACSLOADPATH in user environment causing problems.
+emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT)
+
+## Subdirectories, relative to builddir.
+SUBDIRS = $(sort $(shell find ${srcdir} -type d -print))
+## Subdirectories, relative to srcdir.
+SUBDIRS_REL = $(patsubst ${srcdir}%,.%,${SUBDIRS})
+## All subdirectories except 'obsolete' and 'term'.
+SUBDIRS_ALMOST = $(filter-out ${srcdir}/obsolete ${srcdir}/term,${SUBDIRS})
+## All subdirectories except 'obsolete', 'term', and 'leim' (and subdirs).
+## We don't want the leim files listed as packages, especially
+## since many share basenames with files in language/.
+SUBDIRS_FINDER = $(filter-out ${srcdir}/leim%,${SUBDIRS_ALMOST})
+## All subdirectories in which we might want to create subdirs.el.
+SUBDIRS_SUBDIRS = $(filter-out ${srcdir}/cedet% ${srcdir}/leim%,${SUBDIRS})
# cus-load and finder-inf are not explicitly requested by anything, so
# we add them here to make sure they get built.
all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el
-doit:
-
-.PHONY: all doit custom-deps finder-data autoloads update-subdirs
+PHONY_EXTRAS =
+.PHONY: all custom-deps finder-data autoloads update-subdirs $(PHONY_EXTRAS)
# custom-deps and finder-data both used to scan _all_ the *.el files.
# This could lead to problems in parallel builds if automatically
@@ -160,62 +155,85 @@ doit:
# Nowadays these commands don't scan automatically generated files,
# since they will never contain any useful information
# (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp).
+custom-deps:
+ $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/cus-load.el $(lisp)/cus-load.el
$(lisp)/cus-load.el:
- $(MAKE) $(MFLAGS) custom-deps
-custom-deps: doit
- cd $(lisp); $(setwins_almost); \
- echo Directories: $$wins; \
- $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(lisp)/cus-load.el"))' -f custom-make-dependencies $$wins
+ $(AM_V_GEN)$(emacs) -l cus-dep \
+ --eval '(setq generated-custom-dependencies-file (unmsys--file-name "$(srcdir)/cus-load.el"))' \
+ -f custom-make-dependencies ${SUBDIRS_ALMOST}
+finder-data:
+ $(AM_V_at)$(MAKE) PHONY_EXTRAS=$(lisp)/finder-inf.el \
+ $(lisp)/finder-inf.el
$(lisp)/finder-inf.el:
- $(MAKE) $(MFLAGS) finder-data
-finder-data: doit
- cd $(lisp); $(setwins_almost); \
- echo Directories: $$wins; \
- $(emacs) -l finder --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(lisp)/finder-inf.el"))' -f finder-compile-keywords-make-dist $$wins
-
-# The chmod +w is to handle env var CVSREAD=1.
-autoloads: $(LOADDEFS) doit
- cd $(lisp) && chmod +w $(AUTOGEN_VCS)
- cd $(lisp); $(setwins_almost); \
- echo Directories: $$wins; \
- $(emacs) -l autoload \
+ $(AM_V_GEN)$(emacs) -l finder \
+ --eval '(setq generated-finder-keywords-file (unmsys--file-name "$(srcdir)/finder-inf.el"))' \
+ -f finder-compile-keywords-make-dist ${SUBDIRS_FINDER}
+
+# Use expand-file-name rather than $abs_scrdir so that Emacs does not
+# get confused when it compares file-names for equality.
+#
+# Note that we set no-update-autoloads in _generated_ leim files.
+# If you want to allow autoloads in such files, remove that,
+# and make this depend on leim.
+autoloads .PHONY: $(lisp)/loaddefs.el
+$(lisp)/loaddefs.el: $(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)' \
- --eval '(setq generated-autoload-file (unmsys--file-name "$(lisp)/loaddefs.el"))' \
- -f batch-update-autoloads $$wins
+ --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \
+ -f batch-update-autoloads ${SUBDIRS_ALMOST}
# This is required by the bootstrap-emacs target in ../src/Makefile, so
# we know that if we have an emacs executable, we also have a subdirs.el.
$(lisp)/subdirs.el:
- $(MAKE) $(MFLAGS) update-subdirs
-update-subdirs: doit
- cd $(lisp); $(setwins_for_subdirs); \
- for file in $$wins; do \
- $(top_srcdir)/build-aux/update-subdirs $$file; \
+ $(AM_V_GEN)$(MAKE) update-subdirs
+update-subdirs:
+ $(AM_V_at)for file in ${SUBDIRS_SUBDIRS}; do \
+ $(srcdir)/../build-aux/update-subdirs $$file; \
done;
-.PHONY: updates bzr-update update-authors
+.PHONY: updates repo-update update-authors
# Some modes of make-dist use this.
updates: update-subdirs autoloads finder-data custom-deps
-# This is useful after "bzr up"; but it doesn't do anything that a
-# plain "make" at top-level doesn't.
-# The only difference between this and this directory's "all" rule
-# is that this runs "autoloads" as well (because it uses "compile"
-# rather than "compile-main"). In a bootstrap, $(lisp) in src/Makefile
-# triggers this directory's autoloads rule.
-bzr-update: compile finder-data custom-deps
+# This is useful after updating from the repository; but it doesn't do
+# anything that a plain "make" at top-level doesn't. The only
+# difference between this and this directory's "all" rule is that this
+# runs "autoloads" as well (because it uses "compile" rather than
+# "compile-main"). In a bootstrap, $(lisp) in src/Makefile triggers
+# this directory's autoloads rule.
+repo-update: compile finder-data custom-deps
# Update the AUTHORS file.
update-authors:
- $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir)
+ $(emacs) -L "$(top_srcdir)/admin" -l authors \
+ -f batch-update-authors "$(top_srcdir)/etc/AUTHORS" "$(top_srcdir)"
+
+
+ETAGS = ../lib-src/etags
+
+lisptagsfiles1 = $(srcdir)/*.el
+lisptagsfiles2 = $(srcdir)/*/*.el
+lisptagsfiles3 = $(srcdir)/*/*/*.el
+lisptagsfiles4 = $(srcdir)/*/*/*/*.el
+
+## The ls | sed | xargs is to stop the command line getting too long
+## on MS Windows, when the MSYS Bash passes it to a MinGW compiled
+## etags. It might be better to use find in a similar way to
+## compile-main. But maybe this is not even necessary any more now
+## that this uses relative filenames.
+TAGS: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
+ rm -f $@
+ touch $@
+ ls $(lisptagsfiles1) $(lisptagsfiles2) \
+ $(lisptagsfiles3) $(lisptagsfiles4) | \
+ sed -e '/loaddefs/d; /\/ldefs-boot/d; /esh-groups\.el/d' | \
+ xargs $(XARGS_LIMIT) "$(ETAGS)" -a -o $@
-TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
- rm -f $@; touch $@; \
- echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,," | \
- xargs $(XARGS_LIMIT) ${ETAGS} -a -o $@
# The src/Makefile.in has its own set of dependencies and when they decide
# that one Lisp file needs to be re-compiled, we had better recompile it as
@@ -228,12 +246,10 @@ TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptags
# src/Makefile.in to rebuild a particular Lisp file, no questions asked.
# Use byte-compile-refresh-preloaded to try and work around some of
# the most common problems of not bootstrapping from a clean state.
-.PHONY: compile-onefile
-compile-onefile:
- @echo Compiling $(THEFILE)
- @# Use byte-compile-refresh-preloaded to try and work around some of
- @# the most common bootstrapping problems.
- @$(emacs) $(BYTE_COMPILE_FLAGS) \
+THEFILE = no-such-file
+.PHONY: $(THEFILE)c
+$(THEFILE)c:
+ $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) \
-l bytecomp -f byte-compile-refresh-preloaded \
-f batch-byte-compile $(THEFILE)
@@ -249,80 +265,74 @@ compile-onefile:
# An old-fashioned suffix rule, which, according to the GNU Make manual,
# cannot have prerequisites.
.el.elc:
- @echo Compiling $<
- @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler
- @# files, which is normally done in compile-first, but may also be
- @# recompiled via this rule.
- @$(emacs) $(BYTE_COMPILE_FLAGS) \
- -f batch-byte-compile $<
+ $(AM_V_ELC)$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $<
.PHONY: compile-first compile-main compile compile-always
compile-first: $(COMPILE_FIRST)
-# In `compile-main' we could directly do
-# ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)"
+# In 'compile-main' we could directly do
+# ... | xargs $(MAKE)
# and it works, but it generates a lot of messages like
-# make[2]: « gnus/gnus-mlspl.elc » is up to date.
+# make[2]: gnus/gnus-mlspl.elc is up to date.
# so instead, we use "xargs echo" to split the list of file into manageable
-# chunks and then use an intermediate `compile-targets' target so the
+# chunks and then use an intermediate 'compile-targets' target so the
# actual targets (the .elc files) are not mentioned as targets on the
# make command line.
.PHONY: compile-targets
-# TARGETS is set dynamically in the recursive call from `compile-main'.
+# TARGETS is set dynamically in the recursive call from 'compile-main'.
compile-targets: $(TARGETS)
# Compile all the Elisp files that need it. Beware: it approximates
-# `no-byte-compile', so watch out for false-positives!
-compile-main: compile-clean
- @(cd $(lisp); $(setwins); \
- els=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
+# 'no-byte-compile', so watch out for false-positives!
+compile-main: leim semantic compile-clean
+ @(cd $(lisp) && \
+ els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
for el in $$els; do \
test -f $$el || continue; \
test ! -f $${el}c && GREP_OPTIONS= grep '^;.*no-byte-compile: t' $$el > /dev/null && continue; \
echo "$${el}c"; \
done | xargs $(XARGS_LIMIT) echo) | \
while read chunk; do \
- $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \
+ $(MAKE) compile-targets TARGETS="$$chunk"; \
done
.PHONY: compile-clean
# Erase left-over .elc files that do not have a corresponding .el file.
compile-clean:
- @cd $(lisp); $(setwins); \
- elcs=`echo "$$wins " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \
+ @cd $(lisp) && \
+ elcs=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.elc |g'`; \
for el in `echo $$elcs | sed -e 's/\.elc/\.el/g'`; do \
- if test -f "$$el" -o \! -f "$${el}c"; then :; else \
+ if test -f "$$el" || test ! -f "$${el}c"; then :; else \
echo rm "$${el}c"; \
rm "$${el}c"; \
fi \
done
+.PHONY: leim semantic
+leim:
+ $(MAKE) -C ../leim all EMACS="$(EMACS)"
+
+semantic:
+ $(MAKE) -C ../admin/grammars all EMACS="$(EMACS:.%=../.%)"
+
# Compile all Lisp files, but don't recompile those that are up to
# date. Some .el files don't get compiled because they set the
# local variable no-byte-compile.
# Calling make recursively because suffix rule cannot have prerequisites.
-# Explicitly pass EMACS (sometimes ../src/bootstrap-emacs) to those
-# sub-makes that run rules that use it, for the sake of some non-GNU makes.
compile: $(LOADDEFS) autoloads compile-first
- $(MAKE) $(MFLAGS) compile-main EMACS=$(EMACS)
+ $(MAKE) compile-main
-# Compile all Lisp files. This is like `compile' but compiles files
+# Compile all Lisp files. This is like 'compile' but compiles files
# unconditionally. Some files don't actually get compiled because they
# set the local variable no-byte-compile.
-compile-always: doit
- cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
- $(MAKE) $(MFLAGS) compile EMACS=$(EMACS)
-
-.PHONY: compile-calc backup-compiled-files compile-after-backup
+compile-always:
+ cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc
+ $(MAKE) compile
-compile-calc:
- for el in $(lisp)/calc/*.el; do \
- echo Compiling $$el; \
- $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1;\
- done
+.PHONY: backup-compiled-files compile-after-backup
# Backup compiled Lisp files in elc.tar.gz. If that file already
# exists, make a backup of it.
@@ -351,113 +361,96 @@ compile-after-backup: backup-compiled-files compile-always
# There is no reason to use this rule unless you only have a single
# core and CPU time is an issue.
.PHONY: compile-one-process
-compile-one-process: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc
+compile-one-process: $(LOADDEFS) compile-first
$(emacs) $(BYTE_COMPILE_FLAGS) \
--eval "(batch-byte-recompile-directory 0)" $(lisp)
# Update MH-E internal autoloads. These are not to be confused with
# the autoloads for the MH-E entry points, which are already in loaddefs.el.
MH_E_DIR = $(lisp)/mh-e
-## MH_E_SRC avoids a circular dependency warning for mh-loaddefs.el.
-MH_E_SRC = $(MH_E_DIR)/mh-acros.el $(MH_E_DIR)/mh-alias.el \
- $(MH_E_DIR)/mh-buffers.el $(MH_E_DIR)/mh-compat.el \
- $(MH_E_DIR)/mh-comp.el $(MH_E_DIR)/mh-e.el \
- $(MH_E_DIR)/mh-folder.el $(MH_E_DIR)/mh-funcs.el \
- $(MH_E_DIR)/mh-gnus.el $(MH_E_DIR)/mh-identity.el \
- $(MH_E_DIR)/mh-inc.el $(MH_E_DIR)/mh-junk.el \
- $(MH_E_DIR)/mh-letter.el $(MH_E_DIR)/mh-limit.el \
- $(MH_E_DIR)/mh-mime.el $(MH_E_DIR)/mh-print.el \
- $(MH_E_DIR)/mh-scan.el $(MH_E_DIR)/mh-search.el \
- $(MH_E_DIR)/mh-seq.el $(MH_E_DIR)/mh-show.el \
- $(MH_E_DIR)/mh-speed.el $(MH_E_DIR)/mh-thread.el \
- $(MH_E_DIR)/mh-tool-bar.el $(MH_E_DIR)/mh-utils.el \
- $(MH_E_DIR)/mh-xface.el
+MH_E_SRC = $(sort $(wildcard ${MH_E_DIR}/mh*.el))
+MH_E_SRC := $(filter-out ${MH_E_DIR}/mh-loaddefs.el,${MH_E_SRC})
.PHONY: mh-autoloads
mh-autoloads: $(MH_E_DIR)/mh-loaddefs.el
$(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
- $(emacs) -l autoload \
+ $(AM_V_GEN)$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
- --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \
- --eval "(setq make-backup-files nil)" \
+ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(MH_E_DIR)
# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
# an own subdirectory. OTOH, it does not hurt to keep them in
# lisp/net.
TRAMP_DIR = $(lisp)/net
-TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \
- $(TRAMP_DIR)/tramp-cache.el $(TRAMP_DIR)/tramp-cmds.el \
- $(TRAMP_DIR)/tramp-compat.el $(TRAMP_DIR)/tramp-ftp.el \
- $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \
- $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
- $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
+TRAMP_SRC = $(sort $(wildcard ${TRAMP_DIR}/tramp*.el))
+TRAMP_SRC := $(filter-out ${TRAMP_DIR}/tramp-loaddefs.el,${TRAMP_SRC})
$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
- $(emacs) -l autoload \
+ $(AM_V_GEN)$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
- --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \
- --eval "(setq make-backup-files nil)" \
+ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(TRAMP_DIR)
CAL_DIR = $(lisp)/calendar
## Those files that may contain internal calendar autoload cookies.
-## Avoids circular dependency warning for *-loaddefs.el.
-CAL_SRC = $(CAL_DIR)/cal-bahai.el $(CAL_DIR)/cal-china.el \
- $(CAL_DIR)/cal-coptic.el $(CAL_DIR)/cal-dst.el \
- $(CAL_DIR)/cal-french.el $(CAL_DIR)/cal-hebrew.el \
- $(CAL_DIR)/cal-html.el $(CAL_DIR)/cal-islam.el \
- $(CAL_DIR)/cal-iso.el $(CAL_DIR)/cal-julian.el \
- $(CAL_DIR)/cal-mayan.el $(CAL_DIR)/cal-menu.el \
- $(CAL_DIR)/cal-move.el $(CAL_DIR)/cal-persia.el \
- $(CAL_DIR)/cal-tex.el $(CAL_DIR)/cal-x.el \
- $(CAL_DIR)/calendar.el $(CAL_DIR)/diary-lib.el \
- $(CAL_DIR)/holidays.el $(CAL_DIR)/lunar.el \
- $(CAL_DIR)/solar.el
+CAL_SRC = $(addprefix ${CAL_DIR}/,diary-lib.el holidays.el lunar.el solar.el)
+CAL_SRC := $(sort ${CAL_SRC} $(wildcard ${CAL_DIR}/cal*.el))
+CAL_SRC := $(filter-out ${CAL_DIR}/cal-loaddefs.el,${CAL_SRC})
$(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC)
- $(emacs) -l autoload \
+ $(AM_V_GEN)$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
- --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \
- --eval "(setq make-backup-files nil)" \
+ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(CAL_DIR)
-$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC)
- $(emacs) -l autoload \
+$(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/cal-loaddefs.el
+ $(AM_V_GEN)$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
- --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \
- --eval "(setq make-backup-files nil)" \
+ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(CAL_DIR)
-$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC)
- $(emacs) -l autoload \
+$(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(CAL_DIR)/diary-loaddefs.el
+ $(AM_V_GEN)$(emacs) -l autoload \
--eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
- --eval "(setq generated-autoload-file (unmsys--file-name \"$@\"))" \
- --eval "(setq make-backup-files nil)" \
+ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \
-f batch-update-autoloads $(CAL_DIR)
.PHONY: bootstrap-clean distclean maintainer-clean
bootstrap-clean:
- cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL)
+ -cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL)
distclean:
-rm -f ./Makefile $(lisp)/loaddefs.el~
maintainer-clean: distclean bootstrap-clean
+ rm -f TAGS
.PHONY: check-declare
check-declare:
- $(emacs) -l $(lisp)/emacs-lisp/check-declare \
- --eval '(check-declare-directory "$(lisp)")'
+ $(emacs) -l check-declare --eval '(check-declare-directory "$(lisp)")'
+
+## This finds a lot of duplicates between foo.el and obsolete/foo.el.
+check-defun-dups:
+ sed -n -e '/^(defun /s/\(.\)(.*/\1/p' \
+ $$(find . -name '*.el' -print | \
+ grep -Ev '(loaddefs|ldefs-boot)\.el') | sort | uniq -d
# Dependencies
+## None of the following matters for bootstrap, which is the only way
+## to ensure a correct compilation of all lisp files.
+## Manually specifying dependencies of a handful of lisp files, (and
+## ones that don't change very often at that) seems pretty pointless
+## to me.
+
+# http://debbugs.gnu.org/1004
# CC Mode uses a compile time macro system which causes a compile time
# dependency in cc-*.elc files on the macros in other cc-*.el and the
# version string in cc-defs.el.
-$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\
+$(lisp)/progmodes/cc-align.elc\
$(lisp)/progmodes/cc-cmds.elc $(lisp)/progmodes/cc-compat.elc\
$(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-fonts.elc\
$(lisp)/progmodes/cc-langs.elc $(lisp)/progmodes/cc-menus.elc\
@@ -465,28 +458,22 @@ $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\
$(lisp)/progmodes/cc-vars.elc: \
$(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-defs.elc
-$(lisp)/progmodes/cc-align.elc: \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc
-
-$(lisp)/progmodes/cc-cmds.elc: \
+$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-cmds.elc: \
$(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc
$(lisp)/progmodes/cc-compat.elc: \
$(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-styles.elc \
$(lisp)/progmodes/cc-engine.elc
-$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc \
- $(lisp)/emacs-lisp/cl.elc $(lisp)/emacs-lisp/regexp-opt.elc
+$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc
$(lisp)/progmodes/cc-engine.elc: $(lisp)/progmodes/cc-langs.elc \
$(lisp)/progmodes/cc-vars.elc
$(lisp)/progmodes/cc-fonts.elc: $(lisp)/progmodes/cc-langs.elc \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
- $(lisp)/font-lock.elc
+ $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc
-$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \
- $(lisp)/emacs-lisp/cl.elc
+$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc
$(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \
$(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
@@ -496,61 +483,4 @@ $(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \
$(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \
$(lisp)/progmodes/cc-align.elc
-$(lisp)/progmodes/cc-vars.elc: $(lisp)/custom.elc $(lisp)/widget.elc
-
-# MH-E dependencies, mainly to prevent failures with parallel
-# compilation, due to race conditions between writing a given FOO.elc
-# file and another file being compiled that says "(require FOO)",
-# which causes Emacs to try to read FOO.elc.
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-comp.elc $(MH_E_DIR)/mh-folder.elc\
- $(MH_E_DIR)/mh-funcs.elc $(MH_E_DIR)/mh-identity.elc $(MH_E_DIR)/mh-inc.elc\
- $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-limit.elc\
- $(MH_E_DIR)/mh-mime.elc $(MH_E_DIR)/mh-print.elc $(MH_E_DIR)/mh-scan.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc\
- $(MH_E_DIR)/mh-speed.elc $(MH_E_DIR)/mh-thread.elc $(MH_E_DIR)/mh-tool-bar.elc\
- $(MH_E_DIR)/mh-utils.elc $(MH_E_DIR)/mh-xface.elc:\
- $(MH_E_DIR)/mh-e.elc
-
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-e.elc $(MH_E_DIR)/mh-folder.elc\
- $(MH_E_DIR)/mh-inc.elc $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-limit.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-speed.elc\
- $(MH_E_DIR)/mh-utils.elc $(MH_E_DIR)/mh-xface.elc:\
- $(lisp)/emacs-lisp/cl.elc
-
-$(MH_E_DIR)/mh-comp.elc $(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-funcs.elc\
- $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-limit.elc $(MH_E_DIR)/mh-print.elc\
- $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc $(MH_E_DIR)/mh-thread.elc:\
- $(MH_E_DIR)/mh-scan.elc
-
-$(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-mime.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-show.elc $(MH_E_DIR)/mh-speed.elc:\
- $(lisp)/gnus/gnus-util.elc
-
-$(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-search.elc:\
- $(lisp)/progmodes/which-func.elc
-
-$(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc\
- $(MH_E_DIR)/mh-utils.elc:\
- $(lisp)/font-lock.elc
-
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-show.elc: $(lisp)/net/goto-addr.elc
-
-$(MH_E_DIR)/mh-comp.elc: $(lisp)/mail/sendmail.elc
-
-$(MH_E_DIR)/mh-e.elc: $(MH_E_DIR)/mh-buffers.elc $(lisp)/gnus/gnus.elc \
- $(lisp)/cus-face.elc
-
-$(MH_E_DIR)/mh-letter.elc: $(lisp)/gnus/mailcap.elc $(lisp)/gnus/mm-decode.elc \
- $(lisp)/gnus/mm-view.elc $(lisp)/gnus/mml.elc $(lisp)/gnus/message.elc
-
-$(MH_E_DIR)/mh-print.elc: $(lisp)/ps-print.elc
-
-$(MH_E_DIR)/mh-search.elc: $(lisp)/imenu.elc
-
-$(MH_E_DIR)/mh-show.elc: $(lisp)/gnus/gnus-cite.elc
-
-$(MH_E_DIR)/mh-speed.elc: $(lisp)/speedbar.elc $(lisp)/emacs-lisp/timer.elc
-
-$(MH_E_DIR)/mh-tool-bar.elc: $(lisp)/tool-bar.elc
-
# Makefile ends here.
diff --git a/lisp/README b/lisp/README
index e250a700426..b68ad5e30f9 100644
--- a/lisp/README
+++ b/lisp/README
@@ -6,8 +6,7 @@ files are architecture-independent.
The term subdirectory contains Lisp files that customize Emacs for
certain terminal types. When Emacs starts, it checks the TERM
environment variable to get the terminal type and loads
-`term/${TERM}.el' if it exists.
+'term/${TERM}.el' if it exists.
The other subdirectories hold Lisp packages grouped by their general
purpose.
-
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index d82e2eabd84..f372a280ffe 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1,9 +1,9 @@
;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
;; Package: emacs
@@ -67,13 +67,15 @@ be replaced by its expansion."
(put 'abbrev-mode 'safe-local-variable 'booleanp)
-(defvar edit-abbrevs-map
+(defvar edit-abbrevs-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-s" 'abbrev-edit-save-buffer)
(define-key map "\C-x\C-w" 'abbrev-edit-save-to-file)
(define-key map "\C-c\C-c" 'edit-abbrevs-redefine)
map)
"Keymap used in `edit-abbrevs'.")
+(define-obsolete-variable-alias 'edit-abbrevs-map
+ 'edit-abbrevs-mode-map "24.4")
(defun kill-all-abbrevs ()
"Undefine all defined abbrevs."
@@ -144,16 +146,6 @@ Otherwise display all abbrevs."
(set-buffer-modified-p nil)
(current-buffer))))
-(defun edit-abbrevs-mode ()
- "Major mode for editing the list of abbrev definitions.
-\\{edit-abbrevs-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'edit-abbrevs-mode)
- (setq mode-name "Edit-Abbrevs")
- (use-local-map edit-abbrevs-map)
- (run-mode-hooks 'edit-abbrevs-mode-hook))
-
(defun edit-abbrevs ()
"Alter abbrev definitions by editing a list of them.
Selects a buffer containing a list of abbrev definitions with
@@ -407,7 +399,7 @@ A prefix argument means don't query; expand all abbrevs."
(buffer-substring-no-properties
(save-excursion (forward-word -1) (point))
pnt)))
- (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
+ (if (or noquery (y-or-n-p (format-message "Expand `%s'? " string)))
(expand-abbrev)))))))
;;; Abbrev properties.
@@ -429,7 +421,7 @@ A prefix argument means don't query; expand all abbrevs."
\(fn ABBREV PROP)")
(defalias 'abbrev-put 'put
- "Set the property PROP of abbrev ABREV to value VAL.
+ "Set the property PROP of abbrev ABBREV to value VAL.
See `define-abbrev' for the effect of some special properties.
\(fn ABBREV PROP VAL)")
@@ -596,7 +588,7 @@ An obsolete but still supported calling form is:
(boundp sym) (symbol-value sym)
(not (abbrev-get sym :system)))
(unless (or system-flag
- (and (boundp sym) (fboundp sym)
+ (and (boundp sym)
;; load-file-name
(equal (symbol-value sym) expansion)
(equal (symbol-function sym) hook)))
@@ -615,9 +607,9 @@ An obsolete but still supported calling form is:
"Check if the characters in ABBREV have word syntax in either the
current (if global is nil) or standard syntax table."
(with-syntax-table
- (cond ((null global) (standard-syntax-table))
+ (cond ((null global) (syntax-table))
;; ((syntax-table-p global) global)
- (t (syntax-table)))
+ (t (standard-syntax-table)))
(when (string-match "\\W" abbrev)
(let ((badchars ())
(pos 0))
@@ -832,23 +824,28 @@ see `define-abbrev' for details."
value))
(defvar abbrev-expand-functions nil
- "Wrapper hook around `expand-abbrev'.")
+ "Wrapper hook around `abbrev--default-expand'.")
(make-obsolete-variable 'abbrev-expand-functions 'abbrev-expand-function "24.4")
(defvar abbrev-expand-function #'abbrev--default-expand
- "Function to perform abbrev expansion.
+ "Function that `expand-abbrev' uses to perform abbrev expansion.
Takes no argument and should return the abbrev symbol if expansion took place.")
(defun expand-abbrev ()
"Expand the abbrev before point, if there is an abbrev there.
Effective when explicitly called even when `abbrev-mode' is nil.
-Returns the abbrev symbol, if expansion took place. (The actual
-return value is that of `abbrev-insert'.)"
+Before doing anything else, runs `pre-abbrev-expand-hook'.
+Calls `abbrev-expand-function' with no argument to do the work,
+and returns whatever it does. (This should be the abbrev symbol
+if expansion occurred, else nil.)"
(interactive)
(run-hooks 'pre-abbrev-expand-hook)
(funcall abbrev-expand-function))
(defun abbrev--default-expand ()
+ "Default function to use for `abbrev-expand-function'.
+This respects the wrapper hook `abbrev-expand-functions'.
+Calls `abbrev-insert' to insert any expansion, and returns what it does."
(with-wrapper-hook abbrev-expand-functions ()
(pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point)))
(when sym
@@ -956,7 +953,6 @@ Abbrevs marked as \"system abbrevs\" are omitted."
(insert " ))\n\n")))
nil)))
-(put 'define-abbrev-table 'doc-string-elt 3)
(defun define-abbrev-table (tablename definitions
&optional docstring &rest props)
"Define TABLENAME (a symbol) as an abbrev table name.
@@ -976,10 +972,15 @@ Properties with special meaning:
- `:enable-function' can be set to a function of no argument which returns
non-nil if and only if the abbrevs in this table should be used for this
instance of `expand-abbrev'."
+ (declare (doc-string 3))
;; We used to manually add the docstring, but we also want to record this
;; location as the definition of the variable (in load-history), so we may
;; as well just use `defvar'.
- (eval `(defvar ,tablename nil ,@(if (stringp docstring) (list docstring))))
+ (if (and docstring props (symbolp docstring))
+ ;; There is really no docstring, instead the docstring arg
+ ;; is a property name.
+ (push docstring props) (setq docstring nil))
+ (eval `(defvar ,tablename nil ,@(if docstring (list docstring))))
(let ((table (if (boundp tablename) (symbol-value tablename))))
(unless table
(setq table (make-abbrev-table))
@@ -990,6 +991,7 @@ Properties with special meaning:
;; if the table was pre-existing as is the case if it was created by
;; loading the user's abbrev file.
(while (consp props)
+ (unless (cdr props) (error "Missing value for property %S" (car props)))
(abbrev-table-put table (pop props) (pop props)))
(dolist (elt definitions)
(apply 'define-abbrev table elt))))
@@ -1013,6 +1015,11 @@ SORTFUN is passed to `sort' to change the default ordering."
(sort entries (lambda (x y)
(funcall sortfun (nth 2 x) (nth 2 y)))))))
+;; Keep it after define-abbrev-table, since define-derived-mode uses
+;; define-abbrev-table.
+(define-derived-mode edit-abbrevs-mode fundamental-mode "Edit-Abbrevs"
+ "Major mode for editing the list of abbrev definitions.")
+
(provide 'abbrev)
;;; abbrev.el ends here
diff --git a/lisp/align.el b/lisp/align.el
index 6f55ac9faf1..9eb04ef594f 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,9 +1,9 @@
;;; align.el --- align text to a specific column, by regexp -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience languages lisp
;; This file is part of GNU Emacs.
@@ -937,7 +937,7 @@ throughout the line.
See `align-rules-list' for more information about these options.
The non-interactive form of the previous example would look something like:
- \(align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
+ (align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
This function is a nothing more than a small wrapper that helps you
construct a rule to pass to `align-region', which does the real work."
@@ -1130,13 +1130,8 @@ TAB-STOP specifies whether SPACING refers to tab-stop boundaries."
column
(if (not tab-stop)
(+ column spacing)
- (let ((stops tab-stop-list))
- (while stops
- (if (and (> (car stops) column)
- (= (setq spacing (1- spacing)) 0))
- (setq column (car stops)
- stops nil)
- (setq stops (cdr stops)))))
+ (dotimes (_ spacing)
+ (setq column (indent-next-tab-stop column)))
column)))
(defsubst align-column (pos)
@@ -1353,7 +1348,7 @@ aligner would have dealt with are."
(if real-beg
(goto-char beg)
(if (or (not thissep) (eq thissep 'entire))
- (error "Cannot determine alignment region for '%s'"
+ (error "Cannot determine alignment region for `%s'"
(symbol-name (cdr (assq 'title rule)))))
(beginning-of-line)
(while (and (not (eobp))
@@ -1442,12 +1437,12 @@ aligner would have dealt with are."
(message
"Aligning `%s' (rule %d of %d) %d%%..."
(symbol-name symbol) rule-index rule-count
- (/ (* (- (point) real-beg) 100)
- (- end-mark real-beg)))
+ (floor (* (- (point) real-beg) 100.0)
+ (- end-mark real-beg)))
(message
"Aligning %d%%..."
- (/ (* (- (point) real-beg) 100)
- (- end-mark real-beg))))))
+ (floor (* (- (point) real-beg) 100.0)
+ (- end-mark real-beg))))))
;; if the search ended us on the beginning of
;; the next line, move back to the end of the
@@ -1603,7 +1598,7 @@ aligner would have dealt with are."
rule-index (1+ rule-index)))
;; This function can use a lot of temporary markers, so instead of
;; waiting for the next GC we delete them immediately (Bug#10047).
- (set-marker end-mark nil)
+ (when end-mark (set-marker end-mark nil))
(dolist (m markers)
(set-marker m nil))
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 1c76156b91a..f31c3d8689e 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -1,6 +1,6 @@
;; allout-widgets.el --- Visually highlight allout outline structure.
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
@@ -90,7 +90,6 @@
;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions:
;;;_ > defgroup allout-widgets
-;;;###autoload
(defgroup allout-widgets nil
"Allout extension that highlights outline structure graphically.
@@ -267,7 +266,7 @@ decreases as obsolete widgets are garbage collected."
(defvar allout-widgets-tally nil
"Hash-table of existing allout widgets, for debugging.
-Table is maintained iff `allout-widgets-maintain-tally' is non-nil.
+Table is maintained only if `allout-widgets-maintain-tally' is non-nil.
The table contents will be out of sync if any widgets are created
or deleted while this variable is nil.")
@@ -349,7 +348,7 @@ to `allout-body-modification-handler', and is always reset by
images with lists containing the name of the icon directory (as
found on the `load-path') and the icon name.
-Set this variable to `nil' to empty the cache, and have it replenish from the
+Set this variable to nil to empty the cache, and have it replenish from the
filesystem.")
;;;_ = allout-widgets-unset-inhibit-read-only
(defvar allout-widgets-unset-inhibit-read-only nil
@@ -385,9 +384,9 @@ The structure includes the guides lines, bullet, and bullet cue.")
Entries on the list are lists whose first element is a symbol indicating
the change type and subsequent elements are data specific to that change
-type. Specifically:
+type. For example:
- 'exposure `allout-exposure-from' `allout-exposure-to' `allout-exposure-flag'
+ (exposure ALLOUT-EXPOSURE-FROM ALLOUT-EXPOSURE-TO ALLOUT-EXPOSURE-FLAG)
The changes are recorded in reverse order, with new values pushed
onto the front.")
@@ -482,9 +481,9 @@ text in allout item bodies.")
\(That space is used to convey selected cues indicating body qualities,
including things like:
- - encryption '~'
- - numbering '#'
- - indirect reference '@'
+ - encryption `~'
+ - numbering `#'
+ - indirect reference `@'
- distinctive bullets - see `allout-distinctive-bullets-string'.)")
;;;_ = allout-span-to-category
(defvar allout-span-to-category
@@ -870,7 +869,7 @@ Optional RECURSING is for internal use, to limit recursion."
;; tell the allout-widgets-post-command-business to reestablish the hook:
(setq allout-widgets-reenable-before-change-handler t)
;; and raise an error to prevent the edit (and disable the hook):
- (error
+ (error "%s"
(substitute-command-keys allout-structure-unruly-deletion-message)))))
;;;_ > allout-widgets-after-change-handler
(defun allout-widgets-after-change-handler (_beg _end _prelength)
@@ -903,7 +902,7 @@ encompassing condition-case."
(header
(format "allout-widgets-last-hook-error stored, %s/%s %s %s"
this mode args
- (format-time-string "%e-%b-%Y %r" (current-time)))))
+ (format-time-string "%e-%b-%Y %r"))))
;; post to *Messages* then immediately replace with more compact notice:
(message "%s" (setq allout-widgets-last-hook-error
(format "%s:\n%s" header bt)))
@@ -1853,7 +1852,7 @@ In their absence, the current guide column flags are used.
Optional PARENT-WIDGET is the widget for the item's parent item.
-Optional HAS-SUCCESSOR is true iff the item is followed by a sibling.
+Optional HAS-SUCCESSOR is true if the item is followed by a sibling.
We also hide the header-prefix string.
@@ -2288,7 +2287,7 @@ Deletes allowed only when `inhibit-read-only' is t."
((yes-or-no-p "Unruly edit of outline structure - allow? ")
(setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only)
inhibit-read-only t))
- (t (error
+ (t (error "%s"
(substitute-command-keys allout-structure-unruly-deletion-message)))))
;;;_ > allout-item-icon-key-handler ()
(defun allout-item-icon-key-handler ()
@@ -2343,9 +2342,9 @@ We use a caching strategy, so the caller doesn't need to do so."
got)))
;;;_ : Miscellaneous
-;;;_ > allout-elapsed-time-seconds (triple)
+;;;_ > allout-elapsed-time-seconds (time-value time-value)
(defun allout-elapsed-time-seconds (end start)
- "Return seconds between `current-time' style time START/END triples."
+ "Return seconds between START/END time values."
(let ((elapsed (time-subtract end start)))
(float-time elapsed)))
;;;_ > allout-frame-property (frame property)
@@ -2373,7 +2372,7 @@ The elements of LIST are not copied, just the list structure itself."
(car list)))
;;;_ . allout-widgets-count-buttons-in-region (start end)
(defun allout-widgets-count-buttons-in-region (start end)
- "Debugging/diagnostic tool - count overlays with 'button' property in region."
+ "Debugging/diagnostic tool - count overlays with `button' property in region."
(interactive "r")
(setq start (or start (point-min))
end (or end (point-max)))
diff --git a/lisp/allout.el b/lisp/allout.el
index 0896ace5872..5273fe2b433 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -1,6 +1,6 @@
;;; allout.el --- extensive outline mode for use alone and with other modes
-;; Copyright (C) 1992-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail...>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
@@ -176,7 +176,7 @@ respective allout-mode keybinding variables, `allout-command-prefix',
(defcustom allout-command-prefix "\C-c "
"Key sequence to be used as prefix for outline mode command key bindings.
-Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
+Default is `\C-c<space>'; just `\C-c' is more short-and-sweet, if you're
willing to let allout use a bunch of \C-c keybindings."
:type 'string
:group 'allout-keybindings
@@ -229,7 +229,7 @@ See `allout-unprefixed-keybindings' for the list of keybindings
that are not prefixed.
Use vector format for the keys:
- - put literal keys after a '?' question mark, eg: '?a', '?.'
+ - put literal keys after a `?' question mark, eg: `?a', `?.'
- enclose control, shift, or meta-modified keys as sequences within
parentheses, with the literal key, as above, preceded by the name(s)
of the modifiers, eg: [(control ?a)]
@@ -257,7 +257,7 @@ This is in contrast to the majority of allout-mode bindings on
preceding command key.
Use vector format for the keys:
- - put literal keys after a '?' question mark, eg: '?a', '?.'
+ - put literal keys after a `?' question mark, eg: `?a', `?.'
- enclose control, shift, or meta-modified keys as sequences within
parentheses, with the literal key, as above, preceded by the name(s)
of the modifiers, eg: [(control ?a)]
@@ -322,7 +322,7 @@ With value nil, inhibit any automatic allout-mode activation."
"Default allout outline layout specification.
This setting specifies the outline exposure to use when
-`allout-layout' has the local value `t'. This docstring describes the
+`allout-layout' has the local value t. This docstring describes the
layout specifications.
A list value specifies a default layout for the current buffer,
@@ -610,7 +610,7 @@ strings."
Allout outline mode will use the mode-specific `allout-mode-leaders' or
comment-start string, if any, to lead the topic prefix string, so topic
headers look like comments in the programming language. It will also use
-the comment-start string, with an '_' appended, for `allout-primary-bullet'.
+the comment-start string, with an `_' appended, for `allout-primary-bullet'.
String values are used as literals, not regular expressions, so
do not escape any regular-expression characters.
@@ -917,7 +917,7 @@ has been customized to enable this behavior), `allout-mode' will be
automatically activated. The layout dictated by the value will be used to
set the initial exposure when `allout-mode' is activated.
-\*You should not setq-default this variable non-nil unless you want every
+*You should not setq-default this variable non-nil unless you want every
visited file to be treated as an allout file.*
The value would typically be set by a file local variable. For
@@ -933,7 +933,7 @@ followed by the equivalent of `(allout-expose-topic 0 : -1 -1 0)'.
\(This is the layout used for the allout.el source file.)
`allout-default-layout' describes the specification format.
-`allout-layout' can additionally have the value `t', in which
+`allout-layout' can additionally have the value t, in which
case the value of `allout-default-layout' is used.")
(make-variable-buffer-local 'allout-layout)
;;;###autoload
@@ -1012,9 +1012,9 @@ determination of aberrance is according to the mistaken item
being followed by a legitimate item of excessively greater depth.
The classic example of a mistaken item, for a standard allout
-outline configuration, is a body line that begins with an '...'
+outline configuration, is a body line that begins with an `...'
ellipsis. This happens to contain a legitimate depth-2 header
-prefix, constituted by two '..' dots at the beginning of the
+prefix, constituted by two `..' dots at the beginning of the
line. The only thing that can distinguish it *in principle* from
a legitimate one is if the following real header is at a depth
that is discontinuous from the depth of 2 implied by the
@@ -1326,20 +1326,20 @@ scope of the variable is restored along with its value. If it was a void
buffer-local value, then it is left as nil on resumption.
The pairs are lists whose car is the name of the variable and car of the
-cdr is the new value: '(some-var some-value)'. The pairs can actually be
+cdr is the new value: `(some-var some-value)'. The pairs can actually be
triples, where the third element qualifies the disposition of the setting,
as described further below.
-If the optional third element is the symbol 'extend, then the new value
+If the optional third element is the symbol `extend', then the new value
created by `cons'ing the second element of the pair onto the front of the
existing value.
-If the optional third element is the symbol 'append, then the new value is
+If the optional third element is the symbol `append', then the new value is
extended from the existing one by `append'ing a list containing the second
element of the pair onto the end of the existing value.
Extension, and resumptions in general, should not be used for hook
-functions -- use the 'local mode of `add-hook' for that, instead.
+functions -- use the `local' mode of `add-hook' for that, instead.
The settings are stored on `allout-mode-prior-settings'."
(while pairs
@@ -1512,7 +1512,7 @@ already associated with a file.
It consists of an encrypted random string useful only to verify that a
passphrase entered by the user is effective for decryption. The passphrase
-itself is \*not* recorded in the file anywhere, and the encrypted contents
+itself is *not* recorded in the file anywhere, and the encrypted contents
are random binary characters to avoid exposing greater susceptibility to
search attacks.
@@ -1838,7 +1838,7 @@ M-x outlineify-sticky Activate outline mode for current buffer,
buffer with name derived from derived from that
of current buffer -- \"*BUFFERNAME exposed*\".
\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
- Like above 'copy-exposed', but convert topic
+ Like above `copy-exposed', but convert topic
prefixes to section.subsection... numeric
format.
\\[customize-variable] allout-auto-activation
@@ -1862,7 +1862,7 @@ symmetric decryption keys, preventing entry of the correct key on
subsequent decryption attempts until the cache times-out. That
can take several minutes. (Decryption of other entries is not
affected.) Upgrade your EasyPG version, if you can, and you can
-deliberately clear your gpg-agent's cache by sending it a '-HUP'
+deliberately clear your gpg-agent's cache by sending it a `-HUP'
signal.
See `allout-toggle-current-subtree-encryption' function docstring
@@ -2080,21 +2080,21 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
use-layout
(and (not (string= allout-auto-activation "activate"))
(if (string= allout-auto-activation "ask")
- (if (y-or-n-p (format "Expose %s with layout '%s'? "
- (buffer-name)
- use-layout))
+ (if (y-or-n-p (format-message
+ "Expose %s with layout `%s'? "
+ (buffer-name) use-layout))
t
(message "Skipped %s layout." (buffer-name))
nil)
t)))
(save-excursion
- (message "Adjusting '%s' exposure..." (buffer-name))
+ (message "Adjusting `%s' exposure..." (buffer-name))
(goto-char 0)
(allout-this-or-next-heading)
(condition-case err
(progn
(apply 'allout-expose-topic (list use-layout))
- (message "Adjusting '%s' exposure... done."
+ (message "Adjusting `%s' exposure... done."
(buffer-name)))
;; Problem applying exposure -- notify user, but don't
;; interrupt, eg, file visit:
@@ -3483,9 +3483,10 @@ Offer one suitable for current depth DEPTH as default."
(save-excursion
(goto-char (allout-current-bullet-pos))
(setq choice (solicit-char-in-string
- (format "Select bullet: %s ('%s' default): "
- sans-escapes
- (allout-substring-no-properties default-bullet))
+ (format-message
+ "Select bullet: %s (`%s' default): "
+ sans-escapes
+ (allout-substring-no-properties default-bullet))
sans-escapes
t)))
(message "")
@@ -3720,7 +3721,7 @@ Nuances:
(save-match-data
(let* ((inhibit-field-text-motion t)
(depth (+ (allout-current-depth) relative-depth))
- (opening-on-blank (if (looking-at "^\$")
+ (opening-on-blank (if (looking-at "^$")
(not (setq before nil))))
;; bunch o vars set while computing ref-topic
opening-numbered
@@ -5134,15 +5135,15 @@ Simple (numeric and null-list) specs are interpreted as follows:
- - exposes the body of the corresponding topic.
Examples:
-\(allout-expose-topic '(-1 : 0))
+\(allout-expose-topic \\='(-1 : 0))
Close this and all following topics at current level, exposing
only their immediate children, but close down the last topic
at this current level completely.
-\(allout-expose-topic '(-1 () : 1 0))
+\(allout-expose-topic \\='(-1 () : 1 0))
Close current topic so only the immediate subtopics are shown;
show the children in the second to last topic, and completely
close the last one.
-\(allout-expose-topic '(-2 : -1 *))
+\(allout-expose-topic \\='(-2 : -1 *))
Expose children and grandchildren of all topics at current
level except the last two; expose children of the second to
last and completely open the last one."
@@ -5561,9 +5562,8 @@ Defaults:
;; Specified but not a buffer -- get it:
(let ((got (get-buffer frombuf)))
(if (not got)
- (error (concat "allout-process-exposed: source buffer "
- frombuf
- " not found."))
+ (error "allout-process-exposed: source buffer %s not found."
+ frombuf)
(setq frombuf got))))
;; not specified -- default it:
(setq frombuf (current-buffer)))
@@ -5589,9 +5589,9 @@ Defaults:
LISTIFIED is a list representing each topic header and body:
- \`(depth prefix text)'
+ `(depth prefix text)'
-or \`(depth prefix text bullet-plus)'
+or `(depth prefix text bullet-plus)'
If `bullet-plus' is specified, it is inserted just after the entire prefix."
(setq listified (cdr listified))
@@ -5878,7 +5878,7 @@ With repeat count, copy the exposed portions of entire buffer."
(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
"Encrypt clear or decrypt encoded topic text.
-Allout uses Emacs 'epg' library to perform encryption. Symmetric
+Allout uses Emacs `epg' library to perform encryption. Symmetric
and keypair encryption are supported. All encryption is ascii
armored.
@@ -5908,7 +5908,7 @@ file with topics pending encryption is saved, topics pending
encryption are encrypted. See `allout-encrypt-unencrypted-on-saves'
for auto-encryption specifics.
-\*NOTE WELL* that automatic encryption that happens during saves will
+*NOTE WELL* that automatic encryption that happens during saves will
default to symmetric encryption -- you must deliberately (re)encrypt key-pair
encrypted topics if you want them to continue to use the key-pair cipher.
@@ -5940,7 +5940,7 @@ associated with it. This can be used to dissociate any
recipients with the file, by selecting no recipients in the
dialog.
-Encryption and decryption uses the Emacs 'epg' library.
+Encryption and decryption uses the Emacs `epg' library.
Encrypted text will be ascii-armored.
@@ -6051,8 +6051,8 @@ See `allout-toggle-current-subtree-encryption' for more details."
(declare-function epg-decrypt-string "epg" (context cipher))
(declare-function epg-encrypt-string "epg"
(context plain recipients &optional sign always-trust))
-(declare-function epg-user-id-string "epg" (user-id))
-(declare-function epg-key-user-id-list "epg" (key))
+(declare-function epg-user-id-string "epg" (user-id) t)
+(declare-function epg-key-user-id-list "epg" (key) t)
;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
;;; &optional rejected)
@@ -6093,7 +6093,7 @@ symmetric decryption keys, preventing entry of the correct key on
subsequent decryption attempts until the cache times-out. That
can take several minutes. (Decryption of other entries is not
affected.) Upgrade your EasyPG version, if you can, and you can
-deliberately clear your gpg-agent's cache by sending it a '-HUP'
+deliberately clear your gpg-agent's cache by sending it a `-HUP'
signal."
(require 'epg)
@@ -6263,7 +6263,7 @@ the decryption."
"Return the point of the next topic pending encryption, or nil if none.
Such a topic has the `allout-topic-encryption-bullet' without an
-immediately following '*' that would mark the topic as being encrypted.
+immediately following `*' that would mark the topic as being encrypted.
It must also have content."
(let (done got content-beg)
(save-match-data
@@ -6378,8 +6378,9 @@ for details on preparing Emacs for automatic allout activation."
(if (allout-goto-prefix)
t
(allout-open-topic 2)
- (insert (concat "Dummy outline topic header -- see"
- "`allout-mode' docstring: `^Hm'."))
+ (insert (substitute-command-keys
+ (concat "Dummy outline topic header -- see"
+ " `allout-mode' docstring: `\\[describe-mode]'.")))
(allout-adjust-file-variable
"allout-layout" (or allout-layout '(-1 : 0))))))
;;;_ > allout-file-vars-section-data ()
@@ -6488,8 +6489,9 @@ not its value."
got)
(dolist (sym configvar-value)
(if (not (boundp sym))
- (if (yes-or-no-p (format "%s entry `%s' is unbound -- remove it? "
- configvar-name sym))
+ (if (yes-or-no-p (format-message
+ "%s entry `%s' is unbound -- remove it? "
+ configvar-name sym))
(delq sym (symbol-value configvar-name)))
(push (symbol-value sym) got)))
(reverse got)))
@@ -6543,7 +6545,7 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
(defun regexp-sans-escapes (regexp &optional successive-backslashes)
"Return a copy of REGEXP with all character escapes stripped out.
-Representations of actual backslashes -- '\\\\\\\\' -- are left as a
+Representations of actual backslashes -- `\\\\\\\\' -- are left as a
single backslash.
Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 105352117b7..2f3b5064348 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -1,6 +1,6 @@
;;; ansi-color.el --- translate ANSI escape sequences into faces -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
@@ -117,7 +117,7 @@ map. This color map is stored in the variable `ansi-color-map'."
:group 'ansi-colors)
(defcustom ansi-color-names-vector
- ["black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]
+ ["black" "red3" "green3" "yellow3" "blue2" "magenta3" "cyan3" "gray90"]
"Colors used for SGR control sequences determining a color.
This vector holds the colors used for SGR control sequences parameters
30 to 37 (foreground colors) and 40 to 47 (background colors).
@@ -147,13 +147,14 @@ foreground and background colors, respectively."
(choice color (cons color color)))
:set 'ansi-color-map-update
:initialize 'custom-initialize-default
+ :version "24.4" ; default colors copied from `xterm-standard-colors'
:group 'ansi-colors)
(defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)"
"Regexp that matches SGR control sequences.")
(defconst ansi-color-drop-regexp
- "\033\\[\\([ABCDsuK]\\|2J\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\)"
+ "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\|\\?[0-9]+[hl]\\)"
"Regexp that matches ANSI control sequences to silently drop.")
(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
@@ -260,7 +261,11 @@ This function can be added to `comint-preoutput-filter-functions'."
;; find the next escape sequence
(while (setq end (string-match ansi-color-regexp string start))
(setq result (concat result (substring string start end))
- start (match-end 0)))
+ start (match-end 0)))
+ ;; eliminate unrecognized escape sequences
+ (while (string-match ansi-color-drop-regexp string)
+ (setq string
+ (replace-match "" nil nil string)))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
@@ -326,6 +331,10 @@ This function can be added to `comint-preoutput-filter-functions'."
(when codes
(put-text-property start (length string)
'font-lock-face (ansi-color--find-face codes) string))
+ ;; eliminate unrecognized escape sequences
+ (while (string-match ansi-color-drop-regexp string)
+ (setq string
+ (replace-match "" nil nil string)))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 7a1a6f6a75a..6d7dc8af40d 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,6 +1,6 @@
;;; apropos.el --- apropos commands for users and programmers
-;; Copyright (C) 1989, 1994-1995, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1994-1995, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Joe Wells <jbw@bigbird.bu.edu>
@@ -99,7 +99,7 @@ include key-binding information in its output."
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
- "Face for property name in apropos output, or nil for none."
+ "Face for property name in Apropos output, or nil for none."
:group 'apropos
:version "24.3")
@@ -131,6 +131,7 @@ include key-binding information in its output."
"Face for matching text in Apropos documentation/value, or nil for none.
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")
@@ -181,7 +182,7 @@ If value is `verbose', the computed score is shown for each match."
"Regexp used in current apropos run.")
(defvar apropos-all-words-regexp nil
- "Regexp matching apropos-all-words.")
+ "Regexp matching `apropos-all-words'.")
(defvar apropos-files-scanned ()
"List of elc files already scanned in current run of `apropos-documentation'.")
@@ -341,16 +342,21 @@ before finding a label."
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS."
- (concat "\\("
- (mapconcat 'identity words "\\|")
- "\\)"
- (if (cdr words)
- (concat wild
- "\\("
- (mapconcat 'identity words "\\|")
- "\\)")
- "")))
+ "Make 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))
+ (car words)
+ (mapconcat
+ (lambda (w)
+ (concat "\\(?:" w "\\)" ;; parens for synonyms
+ wild "\\(?:"
+ (mapconcat 'identity
+ (delq w (copy-sequence words))
+ "\\|")
+ "\\)"))
+ words
+ "\\|")))
;;;###autoload
(defun apropos-read-pattern (subject)
@@ -364,7 +370,8 @@ kind of objects to search."
(read-string (concat "Search for " subject " (word list or regexp): "))))
(if (string-equal (regexp-quote pattern) pattern)
;; Split into words
- (split-string pattern "[ \t]+" t)
+ (or (split-string pattern "[ \t]+" t)
+ (user-error "No word list given"))
pattern)))
(defun apropos-parse-pattern (pattern)
@@ -404,7 +411,6 @@ This updates variables `apropos-pattern', `apropos-pattern-quoted',
apropos-pattern pattern
apropos-regexp pattern)))
-
(defun apropos-calc-scores (str words)
"Return apropos scores for string STR matching WORDS.
Value is a list of offsets of the words into the string."
@@ -448,7 +454,7 @@ Value is a list of offsets of the words into the string."
(defun apropos-true-hit (str words)
"Return t if STR is a genuine hit.
This may fail if only one of the keywords is matched more than once.
-This requires that at least 2 keywords (unless only one was given)."
+This requires at least two keywords (unless only one was given)."
(or (not str)
(not words)
(not (cdr words))
@@ -499,7 +505,7 @@ variables, not just user options."
;;;###autoload
(defun apropos-variable (pattern &optional do-not-all)
"Show variables that match PATTERN.
-When DO-NOT-ALL is not-nil, show user options only, i.e. behave
+When DO-NOT-ALL is non-nil, show user options only, i.e. behave
like `apropos-user-option'."
(interactive (list (apropos-read-pattern
(if current-prefix-arg "user option" "variable"))
@@ -675,7 +681,8 @@ the output includes key-bindings of commands."
(apropos-symbols-internal
symbols apropos-do-all
(concat
- (format "Library `%s' provides: %s\nand requires: %s"
+ (format-message
+ "Library `%s' provides: %s\nand requires: %s"
file
(mapconcat 'apropos-library-button
(or provides '(nil)) " and ")
@@ -712,7 +719,7 @@ the output includes key-bindings of commands."
(setq doc (list (car properties)))
(while (setq properties (cdr (cdr properties)))
(setq doc (cons (car properties) doc)))
- (mapconcat #'symbol-name (nreverse doc) " "))
+ (mapconcat (lambda (p) (format "%s" p)) (nreverse doc) " "))
(when (get symbol 'widget-type)
(apropos-documentation-property
symbol 'widget-documentation t))
@@ -720,11 +727,10 @@ the output includes key-bindings of commands."
(let ((alias (get symbol 'face-alias)))
(if alias
(if (facep alias)
- (format "%slias for the face `%s'."
- (if (get symbol 'obsolete-face)
- "Obsolete a"
- "A")
- alias)
+ (format-message
+ "%slias for the face `%s'."
+ (if (get symbol 'obsolete-face) "Obsolete a" "A")
+ alias)
;; Never happens in practice because fails
;; (facep symbol) test.
"(alias for undefined face)")
@@ -1000,8 +1006,7 @@ Returns list of symbols and documentation found."
"Like `documentation', except it avoids calling `get_doc_string'.
Will return nil instead."
(while (and function (symbolp function))
- (setq function (if (fboundp function)
- (symbol-function function))))
+ (setq function (symbol-function function)))
(if (eq (car-safe function) 'macro)
(setq function (cdr function)))
(setq function (if (byte-code-function-p function)
@@ -1032,14 +1037,12 @@ alphabetically by symbol name; but this function also sets
`apropos-accumulator' to nil before returning.
If SPACING is non-nil, it should be a string; separate items with that string.
-If non-nil TEXT is a string that will be printed as a heading."
+If non-nil, TEXT is a string that will be printed as a heading."
(if (null apropos-accumulator)
(message "No apropos matches for `%s'" apropos-pattern)
(setq apropos-accumulator
(sort apropos-accumulator
(lambda (a b)
- ;; Don't sort by score if user can't see the score.
- ;; It would be confusing. -- rms.
(if apropos-sort-by-scores
(or (> (cadr a) (cadr b))
(and (= (cadr a) (cadr b))
@@ -1049,6 +1052,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(let ((p apropos-accumulator)
(old-buffer (current-buffer))
(inhibit-read-only t)
+ (button-end 0)
symbol item)
(set-buffer standard-output)
(apropos-mode)
@@ -1066,10 +1070,12 @@ If non-nil TEXT is a string that will be printed as a heading."
(setq apropos-item
(cons (car apropos-item)
(cons nil (cdr apropos-item)))))
+ (when (= (point) button-end) (terpri))
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
'face 'apropos-symbol)
+ (setq button-end (point))
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
(insert " (" (number-to-string (cadr apropos-item)) ") "))
@@ -1199,7 +1205,7 @@ If non-nil TEXT is a string that will be printed as a heading."
(set-buffer standard-output)
(princ "Symbol ")
(prin1 symbol)
- (princ "'s plist is\n (")
+ (princ (substitute-command-keys "'s plist is\n ("))
(put-text-property (+ (point-min) 7) (- (point) 14)
'face 'apropos-symbol)
(insert (apropos-format-plist symbol "\n "))
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 5f001ad977b..cf071e2a1f5 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1,10 +1,10 @@
;;; arc-mode.el --- simple editing of archives
-;; Copyright (C) 1995, 1997-1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1995, 1997-1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Morten Welinder <terra@gnu.org>
-;; Keywords: files archives msdog editing major-mode
+;; Keywords: files archives ms-dos editing major-mode
;; Favorite-brand-of-beer: None, I hate beer.
;; This file is part of GNU Emacs.
@@ -31,7 +31,7 @@
;; understand the directory level of the archives. For this reason,
;; you should expect this code to need more fiddling than tar-mode.el
;; (although it at present has fewer bugs :-) In particular, I have
-;; not tested this under Ms-Dog myself.
+;; not tested this under MS-DOS myself.
;; -------------------------------------
;; INTERACTION: arc-mode.el should play together with
;;
@@ -78,7 +78,7 @@
;; interaction among members.
;; Headers come in three flavors called level 0, 1 and 2 headers.
;; Level 2 header is free of DOS specific restrictions and most
-;; prevalently used. Also level 1 and 2 headers consist of base
+;; commonly used. Also level 1 and 2 headers consist of base
;; and extension headers. For more details see
;; http://homepage1.nifty.com/dangan/en/Content/Program/Java/jLHA/Notes/Notes.html
;; http://www.osirusoft.com/joejared/lzhformat.html
@@ -147,6 +147,14 @@ A local copy of the archive will be used when updating."
"Hook run when an archive member has been extracted."
:type 'hook
:group 'archive)
+
+(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)
;; ------------------------------
;; Arc archive configuration
@@ -218,9 +226,14 @@ Archive and member name will be added."
;; ------------------------------
;; Zip archive configuration
+(defvar archive-7z-program (let ((7z (or (executable-find "7z")
+ (executable-find "7za"))))
+ (when 7z
+ (file-name-nondirectory 7z))))
+
(defcustom archive-zip-extract
(cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
- ((executable-find "7z") '("7z" "x" "-so"))
+ (archive-7z-program `(,archive-7z-program "x" "-so"))
((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
(t '("unzip" "-qq" "-c")))
"Program and its options to run in order to extract a zip file member.
@@ -239,7 +252,7 @@ be added."
(defcustom archive-zip-expunge
(cond ((executable-find "zip") '("zip" "-d" "-q"))
- ((executable-find "7z") '("7z" "d"))
+ (archive-7z-program `(,archive-7z-program "d"))
((executable-find "pkzip") '("pkzip" "-d"))
(t '("zip" "-d" "-q")))
"Program and its options to run in order to delete zip file members.
@@ -252,7 +265,7 @@ Archive and member names will be added."
(defcustom archive-zip-update
(cond ((executable-find "zip") '("zip" "-q"))
- ((executable-find "7z") '("7z" "u"))
+ (archive-7z-program `(,archive-7z-program "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q")))
"Program and its options to run in order to update a zip file member.
@@ -266,7 +279,7 @@ file. Archive and member name will be added."
(defcustom archive-zip-update-case
(cond ((executable-find "zip") '("zip" "-q" "-k"))
- ((executable-find "7z") '("7z" "u"))
+ (archive-7z-program `(,archive-7z-program "u"))
((executable-find "pkzip") '("pkzip" "-u" "-P"))
(t '("zip" "-q" "-k")))
"Program and its options to run in order to update a case fiddled zip member.
@@ -321,7 +334,7 @@ Archive and member name will be added."
;; 7z archive configuration
(defcustom archive-7z-extract
- '("7z" "x" "-so")
+ `(,(or archive-7z-program "7z") "x" "-so")
"Program and its options to run in order to extract a 7z file member.
Extraction should happen to standard output. Archive and member name will
be added."
@@ -333,7 +346,7 @@ be added."
:group 'archive-7z)
(defcustom archive-7z-expunge
- '("7z" "d")
+ `(,(or archive-7z-program "7z") "d")
"Program and its options to run in order to delete 7z file members.
Archive and member names will be added."
:version "24.1"
@@ -344,7 +357,7 @@ Archive and member names will be added."
:group 'archive-7z)
(defcustom archive-7z-update
- '("7z" "u")
+ `(,(or archive-7z-program "7z") "u")
"Program and its options to run in order to update a 7z file member.
Options should ensure that specified directory will be put into the 7z
file. Archive and member name will be added."
@@ -678,9 +691,9 @@ archive.
;; At present we cannot create archives from scratch
(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))))
- (kill-all-local-variables)
(make-local-variable 'archive-subtype)
(setq archive-subtype type)
@@ -737,7 +750,12 @@ archive.
(if (default-value 'enable-multibyte-characters)
(set-buffer-multibyte 'to))
(archive-summarize nil)
- (setq buffer-read-only t))))
+ (setq buffer-read-only t)
+ (when (and archive-visit-single-files
+ auto-compression-mode
+ (= (length archive-files) 1))
+ (rename-buffer (concat " " (buffer-name)))
+ (archive-extract)))))
;; Archive mode is suitable only for specially formatted data.
(put 'archive-mode 'mode-class 'special)
@@ -756,7 +774,7 @@ archive.
((looking-at "..-l[hz][0-9ds]-") 'lzh)
((looking-at "....................[\334]\247\304\375") 'zoo)
((and (looking-at "\C-z") ; signature too simple, IMHO
- (string-match "\\.[aA][rR][cC]$"
+ (string-match "\\.[aA][rR][cC]\\'"
(or buffer-file-name (buffer-name))))
'arc)
;; This pattern modeled on the BSD/GNU+Linux `file' command.
@@ -821,7 +839,7 @@ when parsing the archive."
;; long when the archive -- which has to be moved in memory -- is large.
(insert
(apply
- (function concat)
+ #'concat
(mapcar
(lambda (fil)
;; Using `concat' here copies the text also, so we can add
@@ -1032,7 +1050,7 @@ using `make-temp-file', and the generated name is returned."
(setq default-directory arcdir)
(make-local-variable 'archive-superior-buffer)
(setq archive-superior-buffer archive-buffer)
- (add-hook 'write-file-functions 'archive-write-file-member nil t)
+ (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
@@ -1073,7 +1091,7 @@ using `make-temp-file', and the generated name is returned."
(if read-only-p (setq archive-read-only t))
;; We will write out the archive ourselves if it is
;; part of another archive.
- (remove-hook 'write-contents-functions 'archive-write-file t))
+ (remove-hook 'write-contents-functions #'archive-write-file t))
(run-hooks 'archive-extract-hook)
(if archive-read-only
(message "Note: altering this archive is not implemented."))))
@@ -1093,7 +1111,7 @@ using `make-temp-file', and the generated name is returned."
exit-status success)
(make-directory (directory-file-name default-directory) t)
(setq exit-status
- (apply 'call-process
+ (apply #'call-process
(car command)
nil
nil
@@ -1118,7 +1136,7 @@ using `make-temp-file', and the generated name is returned."
(let ((stderr-file (make-temp-file "arc-stderr")))
(unwind-protect
(prog1
- (apply 'call-process
+ (apply #'call-process
(car command)
nil
(if stderr-file (list t stderr-file) t)
@@ -1139,12 +1157,12 @@ using `make-temp-file', and the generated name is returned."
(stdout-file (make-temp-file "arc-stdout")))
(unwind-protect
(prog1
- (apply 'call-process
+ (apply #'call-process
(car command)
nil
`(:file ,stdout-file)
nil
- (append (cdr command) (list archive name dest)))
+ `(,archive ,name ,@(cdr command) ,dest))
(with-temp-buffer
(insert-file-contents stdout-file)
(goto-char (point-min))
@@ -1160,8 +1178,10 @@ using `make-temp-file', and the generated name is returned."
(delete-file (expand-file-name name dest)))
(while (file-name-directory name)
(setq name (directory-file-name (file-name-directory name)))
- (delete-directory (expand-file-name name dest)))
- (delete-directory dest))))
+ (when (file-directory-p (expand-file-name name dest))
+ (delete-directory (expand-file-name name dest))))
+ (when (file-directory-p dest)
+ (delete-directory dest)))))
(defun archive-extract-other-window ()
"In archive mode, find this member in another window."
@@ -1264,7 +1284,7 @@ using `make-temp-file', and the generated name is returned."
(setq ename
(encode-coding-string ename archive-file-name-coding-system))
(let* ((coding-system-for-write 'no-conversion)
- (exitcode (apply 'call-process
+ (exitcode (apply #'call-process
(car command)
nil
nil
@@ -1424,7 +1444,7 @@ as a relative change like \"g+rw\" as for chmod(2)."
(revert-buffer))))))
(defun archive-*-expunge (archive files command)
- (apply 'call-process
+ (apply #'call-process
(car command)
nil
nil
@@ -1519,7 +1539,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length files)
(if (= 1 (length files)) "" "s"))
"\n"))
- (apply 'vector (nreverse files))))
+ (apply #'vector (nreverse files))))
(defun archive-arc-rename-entry (newname descr)
(if (string-match "[:\\\\/]" newname)
@@ -1688,7 +1708,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length files)
(if (= 1 (length files)) "" "s"))
"\n"))
- (apply 'vector (nreverse files))))
+ (apply #'vector (nreverse files))))
(defconst archive-lzh-alternate-display t)
@@ -1791,11 +1811,38 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(defun archive-zip-summarize ()
(goto-char (- (point-max) (- 22 18)))
(search-backward-regexp "[P]K\005\006")
- (let ((p (+ (point-min) (archive-l-e (+ (point) 16) 4)))
+ (let ((p (archive-l-e (+ (point) 16) 4))
(maxlen 8)
(totalsize 0)
files
- visual)
+ visual
+ emacs-int-has-32bits)
+ (when (= p -1)
+ ;; If the offset of end-of-central-directory is -1, this is a
+ ;; Zip64 extended ZIP file format, and we need to glean the info
+ ;; from Zip64 records instead.
+ ;;
+ ;; First, find the Zip64 end-of-central-directory locator.
+ (search-backward "PK\006\007")
+ ;; Pay attention: the offset of Zip64 end-of-central-directory
+ ;; is a 64-bit field, so it could overflow the Emacs integer
+ ;; even on a 64-bit host, let alone 32-bit one. But since we've
+ ;; already read the zip file into a buffer, and this is a byte
+ ;; offset into the file we've read, it must be short enough, so
+ ;; such an overflow can never happen, and we can safely read
+ ;; these 8 bytes into an Emacs integer. Moreover, on host with
+ ;; 32-bit Emacs integer we can only read 4 bytes, since they are
+ ;; stored in little-endian byte order.
+ (setq emacs-int-has-32bits (<= most-positive-fixnum #x1fffffff))
+ (setq p (+ (point-min)
+ (archive-l-e (+ (point) 8) (if emacs-int-has-32bits 4 8))))
+ (goto-char p)
+ ;; We should be at Zip64 end-of-central-directory record now.
+ (or (string= "PK\006\006" (buffer-substring p (+ p 4)))
+ (error "Unrecognized ZIP file format"))
+ ;; Offset to central directory:
+ (setq p (archive-l-e (+ p 48) (if emacs-int-has-32bits 4 8))))
+ (setq p (+ p (point-min)))
(while (string= "PK\001\002" (buffer-substring p (+ p 4)))
(let* ((creator (byte-after (+ p 5)))
;; (method (archive-l-e (+ p 10) 2))
@@ -1858,13 +1905,13 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length files)
(if (= 1 (length files)) "" "s"))
"\n"))
- (apply 'vector (nreverse files))))
+ (apply #'vector (nreverse files))))
(defun archive-zip-extract (archive name)
(cond
((member-ignore-case (car archive-zip-extract) '("pkunzip" "pkzip"))
(archive-*-extract archive name archive-zip-extract))
- ((equal (car archive-zip-extract) "7z")
+ ((equal (car archive-zip-extract) archive-7z-program)
(let ((archive-7z-extract archive-zip-extract))
(archive-7z-extract archive name)))
(t
@@ -1975,7 +2022,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length files)
(if (= 1 (length files)) "" "s"))
"\n"))
- (apply 'vector (nreverse files))))
+ (apply #'vector (nreverse files))))
(defun archive-zoo-extract (archive name)
(archive-extract-by-stdout archive name archive-zoo-extract))
@@ -1991,37 +2038,36 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(maxsize 5)
(files ()))
(with-temp-buffer
- (call-process "unrar-free" nil t nil "--list" (or file copy))
+ (call-process "lsar" nil t nil "-l" (or file copy))
(if copy (delete-file copy))
(goto-char (point-min))
- (re-search-forward "^-+\n")
- (while (looking-at (concat " \\(.*\\)\n" ;Name.
- ;; Size ; Packed.
- " +\\([0-9]+\\) +[0-9]+"
- ;; Ratio ; Date'
- " +\\([0-9%]+\\) +\\([-0-9]+\\)"
- ;; Time ; Attr.
- " +\\([0-9:]+\\) +[^ \n]\\{6,10\\}"
- ;; CRC; Meth ; Var.
- " +[0-9A-F]+ +[^ \n]+ +[0-9.]+\n"))
+ (re-search-forward "^\\(\s+=+\s?+\\)+\n")
+ (while (looking-at (concat "^\s+[0-9.]+\s+-+\s+" ; Flags
+ "\\([0-9-]+\\)\s+" ; Size
+ "\\([0-9.%]+\\)\s+" ; Ratio
+ "\\([0-9a-zA-Z]+\\)\s+" ; Mode
+ "\\([0-9-]+\\)\s+" ; Date
+ "\\([0-9:]+\\)\s+" ; Time
+ "\\(.*\\)\n" ; Name
+ ))
(goto-char (match-end 0))
- (let ((name (match-string 1))
- (size (match-string 2)))
+ (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 3)
+ size (match-string 2)
;; Date, Time.
(match-string 4) (match-string 5))
files))))
(setq files (nreverse files))
(goto-char (point-min))
(let* ((format (format " %%s %%s %%%ds %%5s %%s" maxsize))
- (sep (format format "--------" "-----" (make-string maxsize ?-)
+ (sep (format format "----------" "-----" (make-string maxsize ?-)
"-----" ""))
(column (length sep)))
- (insert (format format " Date " "Time " "Size " "Ratio" " Filename") "\n")
+ (insert (format format " Date " "Time " "Size" "Ratio" "Filename") "\n")
(insert sep (make-string maxname ?-) "\n")
(archive-summarize-files (mapcar (lambda (desc)
(let ((text
@@ -2036,7 +2082,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length text))))
files))
(insert sep (make-string maxname ?-) "\n")
- (apply 'vector files))))
+ (apply #'vector files))))
(defun archive-rar-extract (archive name)
;; unrar-free seems to have no way to extract to stdout or even to a file.
@@ -2044,7 +2090,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
;; The code below assumes the name is relative and may do undesirable
;; things otherwise.
(error "Can't extract files with non-relative names")
- (archive-extract-by-file archive name '("unrar-free" "--extract") "All OK")))
+ (archive-extract-by-file archive name `("unar" "-no-directory" "-o") "Successfully extracted")))
;;; Section: Rar self-extracting .exe archives.
@@ -2088,7 +2134,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(file buffer-file-name)
(files ()))
(with-temp-buffer
- (call-process "7z" nil t nil "l" "-slt" file)
+ (call-process archive-7z-program nil t nil "l" "-slt" file)
(goto-char (point-min))
;; Four dashes start the meta info section that should be skipped.
;; Archive members start with more than four dashes.
@@ -2124,7 +2170,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length text))))
files))
(insert sep (make-string maxname ?-) "\n")
- (apply 'vector files))))
+ (apply #'vector files))))
(defun archive-7z-extract (archive name)
;; 7z doesn't provide a `quiet' option to suppress non-essential
@@ -2174,11 +2220,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(size (string-to-number (match-string 6))))
;; Move to the beginning of the data.
(goto-char (match-end 0))
- (setq time
- (format-time-string
- "%Y-%m-%d %H:%M"
- (let ((high (truncate (/ time 65536))))
- (list high (truncate (- time (* 65536.0 high)))))))
+ (setq time (format-time-string "%Y-%m-%d %H:%M" time))
(setq extname
(cond ((equal name "// ")
(propertize ".<ExtNamesTable>." 'face 'italic))
@@ -2229,7 +2271,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(length text))))
files))
(insert sep (make-string maxname ?-) "\n")
- (apply 'vector files))))
+ (apply #'vector files))))
(defun archive-ar-extract (archive name)
(let ((destbuf (current-buffer))
diff --git a/lisp/array.el b/lisp/array.el
index e60cbdfffc1..86f41529765 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -1,9 +1,9 @@
;;; array.el --- array editing commands for GNU Emacs
-;; Copyright (C) 1987, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2015 Free Software Foundation, Inc.
;; Author: David M. Brown
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; This file is part of GNU Emacs.
@@ -800,7 +800,7 @@ Return COLUMN."
(put 'array-mode 'mode-class 'special)
;;;###autoload
-(defun array-mode ()
+(define-derived-mode array-mode fundamental-mode "Array"
"Major mode for editing arrays.
Array mode is a specialized mode for editing arrays. An array is
@@ -863,9 +863,6 @@ take a numeric prefix argument):
\\[array-display-local-variables] Display the current values of local variables.
Entering array mode calls the function `array-mode-hook'."
-
- (interactive)
- (kill-all-local-variables)
(make-local-variable 'array-buffer-line)
(make-local-variable 'array-buffer-column)
(make-local-variable 'array-row)
@@ -888,13 +885,9 @@ Entering array mode calls the function `array-mode-hook'."
(+ (floor (1- array-max-column) array-columns-per-line)
(if array-rows-numbered 2 1)))
(message "")
- (setq major-mode 'array-mode)
- (setq mode-name "Array")
(force-mode-line-update)
(set (make-local-variable 'truncate-lines) t)
- (setq overwrite-mode 'overwrite-mode-textual)
- (use-local-map array-mode-map)
- (run-mode-hooks 'array-mode-hook))
+ (setq overwrite-mode 'overwrite-mode-textual))
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index 6878995454a..83b4cff38e2 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,6 +1,6 @@
;;; autoarg.el --- make digit keys supply prefix args
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Created: 1998-09-04
@@ -75,7 +75,6 @@
(setq prefix-arg (if (zerop digit) '- (- digit))))
(t
(setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
(setq overriding-terminal-local-map universal-argument-map))
(defvar autoarg-kp-mode-map
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index daa654889b6..255ec9b169f 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -1,12 +1,12 @@
;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
-;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1987, 1994-1995, 1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Charlie Martin <crm@cs.duke.edu>
;; Adapted-By: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: convenience
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -67,7 +67,7 @@ Insertion is possible when something appropriate is found in
`auto-insert-alist'. When the insertion is marked as unmodified, you can
save it with \\[write-file] RET.
This variable is used when the function `auto-insert' is called, e.g.
-when you do (add-hook 'find-file-hook 'auto-insert).
+when you do (add-hook \\='find-file-hook \\='auto-insert).
With \\[auto-insert], this is always treated as if it were t."
:type '(choice (const :tag "Insert if possible" t)
(const :tag "Do nothing" nil)
@@ -91,23 +91,24 @@ If this contains a %s, that will be replaced by the matching rule."
(defcustom auto-insert-alist
- '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
- (upcase (concat (file-name-nondirectory
- (file-name-sans-extension buffer-file-name))
- "_"
- (file-name-extension buffer-file-name)))
+ '((("\\.\\([Hh]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'" . "C / C++ header")
+ (replace-regexp-in-string
+ "[^A-Z0-9]" "_"
+ (replace-regexp-in-string
+ "\\+" "P"
+ (upcase (file-name-nondirectory buffer-file-name))))
"#ifndef " str \n
"#define " str "\n\n"
_ "\n\n#endif")
- (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
+ (("\\.\\([Cc]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'" . "C / C++ program")
nil
"#include \""
- (let ((stem (file-name-sans-extension buffer-file-name)))
- (cond ((file-exists-p (concat stem ".h"))
- (file-name-nondirectory (concat stem ".h")))
- ((file-exists-p (concat stem ".hh"))
- (file-name-nondirectory (concat stem ".hh")))))
+ (let ((stem (file-name-sans-extension buffer-file-name))
+ ret)
+ (dolist (ext '("H" "h" "hh" "hpp" "hxx" "h++") ret)
+ (when (file-exists-p (concat stem "." ext))
+ (setq ret (file-name-nondirectory (concat stem "." ext))))))
& ?\" | -10)
(("[Mm]akefile\\'" . "Makefile") . "makefile.inc")
@@ -166,7 +167,7 @@ If this contains a %s, that will be replaced by the matching rule."
"Short description: "
";;; " (file-name-nondirectory (buffer-file-name)) " --- " str
(make-string (max 2 (- 80 (current-column) 27)) ?\s)
- "-*- lexical-binding: t; -*-"
+ "-*- lexical-binding: t; -*-" '(setq lexical-binding t)
"
;; Copyright (C) " (format-time-string "%Y") " "
@@ -305,6 +306,7 @@ file-name or one relative to `auto-insert-directory' or a function to call.
ACTION may also be a vector containing several successive single actions as
described above, e.g. [\"header.insert\" date-and-author-update]."
:type 'sexp
+ :version "25.1"
:group 'auto-insert)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 978a834cb4c..18b8161f1db 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -1,6 +1,6 @@
-;;; autorevert.el --- revert buffers when files on disk change
+;;; autorevert.el --- revert buffers when files on disk change -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;; Keywords: convenience
@@ -95,7 +95,7 @@
;; mode. For example, the following line will activate Auto-Revert
;; Mode in all C mode buffers:
;;
-;; (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)
+;; (add-hook 'c-mode-hook #'turn-on-auto-revert-mode)
;;; Code:
@@ -260,10 +260,9 @@ buffers. CPU usage depends on the version control system."
:type 'boolean
:version "22.1")
-(defvar global-auto-revert-ignore-buffer nil
+(defvar-local global-auto-revert-ignore-buffer nil
"When non-nil, Global Auto-Revert Mode will not revert this buffer.
This variable becomes buffer local when set in any fashion.")
-(make-variable-buffer-local 'global-auto-revert-ignore-buffer)
(defcustom auto-revert-remote-files nil
"If non-nil remote files are also reverted."
@@ -315,9 +314,9 @@ the list of old buffers.")
"Position of last known end of file.")
(add-hook 'find-file-hook
- (lambda ()
- (set (make-local-variable 'auto-revert-tail-pos)
- (nth 7 (file-attributes buffer-file-name)))))
+ (lambda ()
+ (setq-local auto-revert-tail-pos
+ (nth 7 (file-attributes buffer-file-name)))))
(defvar auto-revert-notify-watch-descriptor-hash-list
(make-hash-table :test 'equal)
@@ -326,15 +325,13 @@ Hash key is a watch descriptor, hash value is a list of buffers
which are related to files being watched and carrying the same
default directory.")
-(defvar auto-revert-notify-watch-descriptor nil
+(defvar-local auto-revert-notify-watch-descriptor nil
"The file watch descriptor active for the current buffer.")
-(make-variable-buffer-local 'auto-revert-notify-watch-descriptor)
(put 'auto-revert-notify-watch-descriptor 'permanent-local t)
-(defvar auto-revert-notify-modified-p nil
+(defvar-local auto-revert-notify-modified-p nil
"Non-nil when file has been modified on the file system.
This has been reported by a file notification event.")
-(make-variable-buffer-local 'auto-revert-notify-modified-p)
;; Functions:
@@ -361,9 +358,8 @@ without being changed in the part that is already in the buffer."
(delq (current-buffer) auto-revert-buffer-list)))
(auto-revert-set-timer)
(when auto-revert-mode
- (let (auto-revert-use-notify)
- (auto-revert-buffers)
- (setq auto-revert-tail-mode nil))))
+ (auto-revert-buffers)
+ (setq auto-revert-tail-mode nil)))
;;;###autoload
@@ -371,7 +367,7 @@ without being changed in the part that is already in the buffer."
"Turn on Auto-Revert Mode.
This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)"
+ (add-hook \\='c-mode-hook #\\='turn-on-auto-revert-mode)"
(auto-revert-mode 1))
@@ -417,13 +413,12 @@ Use `auto-revert-mode' for changes other than appends!"
(y-or-n-p "File changed on disk, content may be missing. \
Perform a full revert? ")
;; Use this (not just revert-buffer) for point-preservation.
- (let (auto-revert-use-notify)
- (auto-revert-handler)))
+ (auto-revert-buffers))
;; else we might reappend our own end when we save
(add-hook 'before-save-hook (lambda () (auto-revert-tail-mode 0)) nil t)
(or (local-variable-p 'auto-revert-tail-pos) ; don't lose prior position
- (set (make-local-variable 'auto-revert-tail-pos)
- (nth 7 (file-attributes buffer-file-name))))
+ (setq-local auto-revert-tail-pos
+ (nth 7 (file-attributes buffer-file-name))))
;; let auto-revert-mode set up the mechanism for us if it isn't already
(or auto-revert-mode
(let ((auto-revert-tail-mode t))
@@ -436,7 +431,7 @@ Perform a full revert? ")
"Turn on Auto-Revert Tail mode.
This function is designed to be added to hooks, for example:
- (add-hook 'my-logfile-mode-hook 'turn-on-auto-revert-tail-mode)"
+ (add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode)"
(auto-revert-tail-mode 1))
@@ -463,8 +458,7 @@ specifies in the mode line."
:global t :group 'auto-revert :lighter global-auto-revert-mode-text
(auto-revert-set-timer)
(if global-auto-revert-mode
- (let (auto-revert-use-notify)
- (auto-revert-buffers))
+ (auto-revert-buffers)
(dolist (buf (buffer-list))
(with-current-buffer buf
(when auto-revert-use-notify
@@ -498,40 +492,73 @@ will use an up-to-date value of `auto-revert-interval'"
(ignore-errors
(file-notify-rm-watch auto-revert-notify-watch-descriptor)))))
auto-revert-notify-watch-descriptor-hash-list)
- (remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch))
+ (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch))
(setq auto-revert-notify-watch-descriptor nil
auto-revert-notify-modified-p nil))
(defun auto-revert-notify-add-watch ()
"Enable file notification for current buffer's associated file."
- (when (string-match auto-revert-notify-exclude-dir-regexp
- (expand-file-name default-directory))
- ;; Fallback to file checks.
- (set (make-local-variable 'auto-revert-use-notify) nil))
-
- (when (and buffer-file-name auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor))
- (setq auto-revert-notify-watch-descriptor
- (ignore-errors
- (file-notify-add-watch
- (expand-file-name buffer-file-name default-directory)
- '(change attribute-change) 'auto-revert-notify-handler)))
- (if auto-revert-notify-watch-descriptor
- (progn
- (puthash
- auto-revert-notify-watch-descriptor
- (cons (current-buffer)
- (gethash auto-revert-notify-watch-descriptor
- auto-revert-notify-watch-descriptor-hash-list))
- auto-revert-notify-watch-descriptor-hash-list)
- (add-hook (make-local-variable 'kill-buffer-hook)
- 'auto-revert-notify-rm-watch))
+ ;; We can assume that `buffer-file-name' and
+ ;; `auto-revert-use-notify' are non-nil.
+ (if (or (string-match auto-revert-notify-exclude-dir-regexp
+ (expand-file-name default-directory))
+ (file-symlink-p (or buffer-file-name default-directory)))
+
;; Fallback to file checks.
- (set (make-local-variable 'auto-revert-use-notify) nil))))
+ (setq-local auto-revert-use-notify nil)
+
+ (when (not auto-revert-notify-watch-descriptor)
+ (setq auto-revert-notify-watch-descriptor
+ (ignore-errors
+ (if buffer-file-name
+ (file-notify-add-watch
+ (expand-file-name buffer-file-name default-directory)
+ '(change attribute-change)
+ 'auto-revert-notify-handler)
+ (file-notify-add-watch
+ (expand-file-name default-directory)
+ '(change)
+ 'auto-revert-notify-handler))))
+ (if auto-revert-notify-watch-descriptor
+ (progn
+ (puthash
+ auto-revert-notify-watch-descriptor
+ (cons (current-buffer)
+ (gethash auto-revert-notify-watch-descriptor
+ auto-revert-notify-watch-descriptor-hash-list))
+ auto-revert-notify-watch-descriptor-hash-list)
+ (add-hook 'kill-buffer-hook
+ #'auto-revert-notify-rm-watch nil t))
+ ;; Fallback to file checks.
+ (setq-local auto-revert-use-notify nil)))))
+
+;; If we have file notifications, we want to update the auto-revert buffers
+;; immediately when a notification occurs. Since file updates can happen very
+;; often, we want to skip some revert operations so that we don't spend all our
+;; time reverting the buffer.
+;;
+;; We do this by reverting immediately in response to the first in a flurry of
+;; notifications. We suppress subsequent notifications until the next time
+;; `auto-revert-buffers' is called (this happens on a timer with a period set by
+;; `auto-revert-interval').
+(defvar auto-revert-buffers-counter 1
+ "Incremented each time `auto-revert-buffers' is called")
+(defvar-local auto-revert-buffers-counter-lockedout 0
+ "Buffer-local value to indicate whether we should immediately
+update the buffer on a notification event or not. If
+
+ (= auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter)
+
+then the updates are locked out, and we wait until the next call
+of `auto-revert-buffers' to revert the buffer. If no lockout is
+present, then we revert immediately and set the lockout, so that
+no more reverts are possible until the next call of
+`auto-revert-buffers'")
(defun auto-revert-notify-handler (event)
"Handle an EVENT returned from file notification."
- (ignore-errors
+ (with-demoted-errors
(let* ((descriptor (car event))
(action (nth 1 event))
(file (nth 2 event))
@@ -540,29 +567,57 @@ will use an up-to-date value of `auto-revert-interval'"
auto-revert-notify-watch-descriptor-hash-list)))
;; Check, that event is meant for us.
(cl-assert descriptor)
- ;; We do not handle `deleted', because nothing has to be refreshed.
- (cl-assert (memq action '(attribute-changed changed created renamed)) t)
;; Since we watch a directory, a file name must be returned.
(cl-assert (stringp file))
(when (eq action 'renamed) (cl-assert (stringp file1)))
- ;; Loop over all buffers, in order to find the intended one.
- (dolist (buffer buffers)
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (and (stringp buffer-file-name)
- (or
- (and (memq action '(attribute-changed changed created))
- (string-equal
- (file-name-nondirectory file)
- (file-name-nondirectory buffer-file-name)))
- (and (eq action 'renamed)
- (string-equal
- (file-name-nondirectory file1)
- (file-name-nondirectory buffer-file-name)))))
- ;; Mark buffer modified.
- (setq auto-revert-notify-modified-p t)
- ;; No need to check other buffers.
- (cl-return))))))))
+
+ (if (eq action 'stopped)
+ ;; File notification has stopped. Continue with polling.
+ (cl-dolist (buffer buffers)
+ (with-current-buffer buffer
+ (when (or
+ ;; A buffer associated with a file.
+ (and (stringp buffer-file-name)
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ ;; A buffer w/o a file, like dired.
+ (null buffer-file-name))
+ (auto-revert-notify-rm-watch)
+ (setq-local auto-revert-use-notify nil))))
+
+ ;; Loop over all buffers, in order to find the intended one.
+ (cl-dolist (buffer buffers)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (or
+ ;; A buffer associated with a file.
+ (and (stringp buffer-file-name)
+ (or
+ (and (memq
+ action '(attribute-changed changed created))
+ (string-equal
+ (file-name-nondirectory file)
+ (file-name-nondirectory buffer-file-name)))
+ (and (eq action 'renamed)
+ (string-equal
+ (file-name-nondirectory file1)
+ (file-name-nondirectory buffer-file-name)))))
+ ;; A buffer w/o a file, like dired.
+ (and (null buffer-file-name)
+ (memq action '(created renamed deleted))))
+ ;; Mark buffer modified.
+ (setq auto-revert-notify-modified-p t)
+
+ ;; Revert the buffer now if we're not locked out.
+ (when (/= auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter)
+ (auto-revert-handler)
+ (setq auto-revert-buffers-counter-lockedout
+ auto-revert-buffers-counter))
+
+ ;; No need to check other buffers.
+ (cl-return)))))))))
(defun auto-revert-active-p ()
"Check if auto-revert is active (in current buffer or globally)."
@@ -577,64 +632,63 @@ will use an up-to-date value of `auto-revert-interval'"
(defun auto-revert-handler ()
"Revert current buffer, if appropriate.
This is an internal function used by Auto-Revert Mode."
- (when (or auto-revert-tail-mode (not (buffer-modified-p)))
- (let* ((buffer (current-buffer)) size
- ;; Tramp caches the file attributes. Setting
- ;; `remote-file-name-inhibit-cache' forces Tramp to reread
- ;; the values.
- (remote-file-name-inhibit-cache t)
- (revert
- (or (and buffer-file-name
- (or auto-revert-remote-files
- (not (file-remote-p buffer-file-name)))
- (or (not auto-revert-use-notify)
- auto-revert-notify-modified-p)
- (if auto-revert-tail-mode
- (and (file-readable-p buffer-file-name)
- (/= auto-revert-tail-pos
- (setq size
- (nth 7 (file-attributes
- buffer-file-name)))))
- (funcall (or buffer-stale-function
- #'buffer-stale--default-function)
- t)))
- (and (or auto-revert-mode
- global-auto-revert-non-file-buffers)
- (funcall (or buffer-stale-function
+ (let* ((buffer (current-buffer)) size
+ ;; Tramp caches the file attributes. Setting
+ ;; `remote-file-name-inhibit-cache' forces Tramp to reread
+ ;; the values.
+ (remote-file-name-inhibit-cache t)
+ (revert
+ (if buffer-file-name
+ (and (or auto-revert-remote-files
+ (not (file-remote-p buffer-file-name)))
+ (or (not auto-revert-use-notify)
+ auto-revert-notify-modified-p)
+ (if auto-revert-tail-mode
+ (and (file-readable-p buffer-file-name)
+ (/= auto-revert-tail-pos
+ (setq size
+ (nth 7 (file-attributes
+ buffer-file-name)))))
+ (funcall (or buffer-stale-function
#'buffer-stale--default-function)
- t))))
- eob eoblist)
- (setq auto-revert-notify-modified-p nil)
- (when revert
- (when (and auto-revert-verbose
- (not (eq revert 'fast)))
- (message "Reverting buffer `%s'." (buffer-name)))
- ;; If point (or a window point) is at the end of the buffer,
- ;; we want to keep it at the end after reverting. This allows
- ;; to tail a file.
- (when buffer-file-name
- (setq eob (eobp))
- (walk-windows
- (lambda (window)
- (and (eq (window-buffer window) buffer)
- (= (window-point window) (point-max))
- (push window eoblist)))
- 'no-mini t))
- (if auto-revert-tail-mode
- (auto-revert-tail-handler size)
- ;; Bind buffer-read-only in case user has done C-x C-q,
- ;; so as not to forget that. This gives undesirable results
- ;; when the file's mode changes, but that is less common.
- (let ((buffer-read-only buffer-read-only))
- (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))
- (when buffer-file-name
- (when eob (goto-char (point-max)))
- (dolist (window eoblist)
- (set-window-point window (point-max)))))
- ;; `preserve-modes' avoids changing the (minor) modes. But we
- ;; do want to reset the mode for VC, so we do it manually.
- (when (or revert auto-revert-check-vc-info)
- (vc-find-file-hook)))))
+ t)))
+ (and (or auto-revert-mode
+ global-auto-revert-non-file-buffers)
+ (funcall (or buffer-stale-function
+ #'buffer-stale--default-function)
+ t))))
+ eob eoblist)
+ (setq auto-revert-notify-modified-p nil)
+ (when revert
+ (when (and auto-revert-verbose
+ (not (eq revert 'fast)))
+ (message "Reverting buffer `%s'." (buffer-name)))
+ ;; If point (or a window point) is at the end of the buffer, we
+ ;; want to keep it at the end after reverting. This allows to
+ ;; tail a file.
+ (when buffer-file-name
+ (setq eob (eobp))
+ (walk-windows
+ (lambda (window)
+ (and (eq (window-buffer window) buffer)
+ (= (window-point window) (point-max))
+ (push window eoblist)))
+ 'no-mini t))
+ (if auto-revert-tail-mode
+ (auto-revert-tail-handler size)
+ ;; Bind buffer-read-only in case user has done C-x C-q, so as
+ ;; not to forget that. This gives undesirable results when
+ ;; the file's mode changes, but that is less common.
+ (let ((buffer-read-only buffer-read-only))
+ (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))
+ (when buffer-file-name
+ (when eob (goto-char (point-max)))
+ (dolist (window eoblist)
+ (set-window-point window (point-max)))))
+ ;; `preserve-modes' avoids changing the (minor) modes. But we do
+ ;; want to reset the mode for VC, so we do it manually.
+ (when (or revert auto-revert-check-vc-info)
+ (vc-refresh-state))))
(defun auto-revert-tail-handler (size)
(let ((modified (buffer-modified-p))
@@ -667,7 +721,7 @@ Should `auto-revert-mode' be active in some buffers, those buffers
are checked.
Non-file buffers that have a custom `revert-buffer-function' and
-a `buffer-stale-function' are reverted either when Auto-Revert
+`buffer-stale-function' are reverted either when Auto-Revert
Mode is active in that buffer, or when the variable
`global-auto-revert-non-file-buffers' is non-nil and Global
Auto-Revert Mode is active.
@@ -681,12 +735,15 @@ 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."
+
+ (setq auto-revert-buffers-counter
+ (1+ auto-revert-buffers-counter))
+
(save-match-data
(let ((bufs (if global-auto-revert-mode
(buffer-list)
auto-revert-buffer-list))
- (remaining ())
- (new ()))
+ 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
@@ -713,7 +770,7 @@ the timer when no buffers need to be checked."
(delq buf auto-revert-buffer-list)))
(when (auto-revert-active-p)
;; Enable file notification.
- (when (and auto-revert-use-notify buffer-file-name
+ (when (and auto-revert-use-notify
(not auto-revert-notify-watch-descriptor))
(auto-revert-notify-add-watch))
(auto-revert-handler)))
diff --git a/lisp/avoid.el b/lisp/avoid.el
index c92d456ef0c..36ced39269f 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -1,6 +1,6 @@
;;; avoid.el --- make mouse pointer stay out of the way of editing
-;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: mouse
@@ -41,9 +41,9 @@
;;
;; (if (eq window-system 'x)
;; (mouse-avoidance-set-pointer-shape
-;; (eval (nth (random 4)
-;; '(x-pointer-man x-pointer-spider
-;; x-pointer-gobbler x-pointer-gumby)))))
+;; (nth (random 4)
+;; (list x-pointer-man x-pointer-spider
+;; x-pointer-gobbler x-pointer-gumby))))
;;
;; For completely random pointer shape, replace the setq above with:
;; (setq x-pointer-shape (mouse-avoidance-random-shape))
@@ -52,9 +52,6 @@
;;
;; - Using this code does slow Emacs down. "banish" mode shouldn't
;; be too bad, and on my workstation even "animate" is reasonable.
-;;
-;; - It ought to find out where any overlapping frames are and avoid them,
-;; rather than always raising the frame.
;; Credits:
;; This code was helped by all those who contributed suggestions,
@@ -129,9 +126,9 @@ TOP-OR-BOTTOM: banish the mouse to top or bottom of frame or window.
TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
:group 'avoid
:version "24.3"
- :type '(alist :key-type symbol :value-type symbol)
- :options '(frame-or-window side (side-pos integer)
- top-or-bottom (top-or-bottom-pos integer)))
+ :type '(alist :key-type symbol :value-type (choice symbol integer))
+ :options '((frame-or-window symbol) (side symbol) (side-pos integer)
+ (top-or-bottom symbol) (top-or-bottom-pos integer)))
;; Internal variables
(defvar mouse-avoidance-state nil)
@@ -154,28 +151,26 @@ TOP-OR-BOTTOM-POS: Distance from top or bottom edge of frame or window."
(defun mouse-avoidance-point-position ()
"Return the position of point as (FRAME X . Y).
Analogous to `mouse-position'."
- (let ((edges (window-inside-edges))
- (x-y (posn-x-y (posn-at-point))))
- (cons (selected-frame)
- (cons (+ (car edges)
- (/ (car x-y) (frame-char-width)))
- (+ (car (cdr edges))
- (/ (cdr x-y) (frame-char-height)))))))
+ (let* ((edges (window-inside-edges))
+ (posn-at-point (posn-at-point))
+ (x-y (and posn-at-point (posn-x-y posn-at-point))))
+ (when x-y
+ (cons (selected-frame)
+ (cons (+ (car edges)
+ (/ (car x-y) (frame-char-width)))
+ (+ (car (cdr edges))
+ (/ (cdr x-y) (frame-char-height))))))))
;(defun mouse-avoidance-point-position-test ()
; (interactive)
-; (message (format "point=%s mouse=%s"
-; (cdr (mouse-avoidance-point-position))
-; (cdr (mouse-position)))))
+; (message "point=%s mouse=%s"
+; (cdr (mouse-avoidance-point-position))
+; (cdr (mouse-position))))
(defun mouse-avoidance-set-mouse-position (pos)
;; Carefully set mouse position to given position (X . Y)
- ;; Ideally, should check if X,Y is in the current frame, and if not,
- ;; leave the mouse where it was. However, this is currently
- ;; difficult to do, so we just raise the frame to avoid frame switches.
;; Returns t if it moved the mouse.
(let ((f (selected-frame)))
- (raise-frame f)
(set-mouse-position f (car pos) (cdr pos))
t))
@@ -185,19 +180,21 @@ MOUSE is the current mouse position as returned by `mouse-position'.
Acceptable distance is defined by `mouse-avoidance-threshold'."
(let* ((frame (car mouse))
(mouse-y (cdr (cdr mouse)))
- (tool-bar-lines (frame-parameter nil 'tool-bar-lines)))
+ (tool-bar-lines (frame-parameter nil 'tool-bar-lines))
+ point)
(or tool-bar-lines
(setq tool-bar-lines 0))
- (if (and mouse-y (< mouse-y tool-bar-lines))
- nil
- (let ((point (mouse-avoidance-point-position))
- (mouse-x (car (cdr mouse))))
+ (cond
+ ((and mouse-y (< mouse-y tool-bar-lines))
+ nil)
+ ((setq point (mouse-avoidance-point-position))
+ (let ((mouse-x (car (cdr mouse))))
(and (eq frame (car point))
(not (null mouse-x))
(< (abs (- mouse-x (car (cdr point))))
mouse-avoidance-threshold)
(< (abs (- mouse-y (cdr (cdr point))))
- mouse-avoidance-threshold))))))
+ mouse-avoidance-threshold)))))))
(defun mouse-avoidance-banish-destination ()
"The position to which Mouse Avoidance mode `banish' moves the mouse.
@@ -338,12 +335,18 @@ redefine this function to suit your own tastes."
(let ((modifiers (event-modifiers (car last-input-event))))
(or (memq (car last-input-event)
'(mouse-movement scroll-bar-movement
- select-window switch-frame))
+ select-window focus-out))
(memq 'click modifiers)
(memq 'double modifiers)
(memq 'triple modifiers)
(memq 'drag modifiers)
- (memq 'down modifiers)))))))
+ (memq 'down modifiers)
+ (memq 'meta modifiers)
+ (memq 'control modifiers)
+ (memq 'shift modifiers)
+ (memq 'hyper modifiers)
+ (memq 'super modifiers)
+ (memq 'alt modifiers)))))))
(defun mouse-avoidance-banish ()
(if (not (mouse-avoidance-ignore-p))
@@ -399,8 +402,6 @@ Effects of the different modes:
* cat-and-mouse: Same as `animate'.
* proteus: As `animate', but changes the shape of the mouse pointer too.
-Whenever the mouse is moved, the frame is also raised.
-
\(See `mouse-avoidance-threshold' for definition of \"too close\",
and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
definition of \"random distance\".)"
diff --git a/lisp/battery.el b/lisp/battery.el
index d4e4d8b3a31..b33e906f21e 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -1,6 +1,6 @@
-;;; battery.el --- display battery status information -*- coding: utf-8 -*-
+;;; battery.el --- display battery status information
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
;; Keywords: hardware
@@ -44,27 +44,27 @@
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
- 'battery-linux-proc-apm)
+ #'battery-linux-proc-apm)
((and (eq system-type 'gnu/linux)
(file-directory-p "/proc/acpi/battery"))
- 'battery-linux-proc-acpi)
+ #'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
(directory-files "/sys/class/power_supply/" nil
battery--linux-sysfs-regexp))
- 'battery-linux-sysfs)
+ #'battery-linux-sysfs)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
- 'battery-bsd-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)))
- 'battery-pmset)
+ #'battery-pmset)
((fboundp 'w32-battery-status)
- 'w32-battery-status))
+ #'w32-battery-status))
"Function for getting battery status information.
The function has to return an alist of conversion definitions.
Its cons cells are of the form
@@ -77,14 +77,7 @@ introduced by a `%' character in a control string."
:group 'battery)
(defcustom battery-echo-area-format
- (cond ((eq battery-status-function 'battery-linux-proc-acpi)
- "Power %L, battery %B at %r (%p%% load, remaining time %t)")
- ((eq battery-status-function 'battery-linux-sysfs)
- "Power %L, battery %B (%p%% load, remaining time %t)")
- ((eq battery-status-function 'battery-pmset)
- "%L power, battery %B (%p%% load, remaining time %t)")
- (battery-status-function
- "Power %L, battery %B (%p%% load, remaining time %t)"))
+ "Power %L, battery %B (%p%% load, remaining time %t)"
"Control string formatting the string to display in the echo area.
Ordinary characters in the control string are printed as-is, while
conversion specifications introduced by a `%' character in the control
@@ -201,19 +194,18 @@ seconds."
(defun battery-update ()
"Update battery status information in the mode line."
- (let ((data (and battery-status-function (funcall battery-status-function))))
+ (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
- (<= (car (read-from-string (cdr (assq ?p data))))
- battery-mode-line-limit))
- (battery-format
- battery-mode-line-format
- data)
+ (numberp percentage)
+ (<= percentage battery-mode-line-limit))
+ (battery-format battery-mode-line-format data)
"")
'face
- (and (<= (car (read-from-string (cdr (assq ?p data))))
- battery-load-critical)
- 'error)
+ (and (numberp percentage)
+ (<= percentage battery-load-critical)
+ 'error)
'help-echo "Battery status information")))
(force-mode-line-update))
@@ -437,11 +429,15 @@ 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 (charging-state rate temperature hours
- (charge-full 0.0)
- (charge-now 0.0)
+ (let (charging-state temperature hours
+ ;; Some batteries report charges and current, other 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))
+ (energy-now 0.0)
+ (power-now 0.0)
+ (voltage-now 10.8)) ;Arbitrary default, in case the info is missing.
;; SysFS provides information about each battery present in the
;; system in a separate subdirectory. We are going to merge the
;; available information together.
@@ -453,17 +449,28 @@ The following %-sequences are provided:
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t)
+ (setq voltage-now (/ (string-to-number (match-string 1)) 1000000.0)))
+ (goto-char (point-min))
(when (re-search-forward "POWER_SUPPLY_PRESENT=1$" nil t)
(goto-char (point-min))
(and (re-search-forward "POWER_SUPPLY_STATUS=\\(.*\\)$" nil t)
(member charging-state '("Unknown" "Full" nil))
(setq charging-state (match-string 1)))
+ (goto-char (point-min))
(when (re-search-forward
"POWER_SUPPLY_\\(CURRENT\\|POWER\\)_NOW=\\([0-9]*\\)$"
nil t)
- (setq rate (float (string-to-number (match-string 2)))))
+ (cl-incf power-now
+ (* (float (string-to-number (match-string 2)))
+ (if (eq (char-after (match-beginning 1)) ?C)
+ voltage-now 1.0))))
+ (goto-char (point-min))
(when (re-search-forward "POWER_SUPPLY_TEMP=\\([0-9]*\\)$" nil t)
(setq temperature (match-string 1)))
+ (goto-char (point-min))
(let (full-string now-string)
;; Sysfs may list either charge (mAh) or energy (mWh).
;; Keep track of both, and choose which to report later.
@@ -473,37 +480,31 @@ The following %-sequences are provided:
(re-search-forward
"POWER_SUPPLY_CHARGE_NOW=\\([0-9]*\\)$" nil t)
(setq now-string (match-string 1)))
- (setq charge-full (+ charge-full
- (string-to-number full-string))
- charge-now (+ charge-now
- (string-to-number now-string))))
- ((and (re-search-forward
+ (cl-incf energy-full (* (string-to-number full-string)
+ voltage-now))
+ (cl-incf energy-now (* (string-to-number now-string)
+ voltage-now)))
+ ((and (progn (goto-char (point-min)) t)
+ (re-search-forward
"POWER_SUPPLY_ENERGY_FULL=\\([0-9]*\\)$" nil t)
(setq full-string (match-string 1))
(re-search-forward
"POWER_SUPPLY_ENERGY_NOW=\\([0-9]*\\)$" nil t)
(setq now-string (match-string 1)))
- (setq energy-full (+ energy-full
- (string-to-number full-string))
- energy-now (+ energy-now
- (string-to-number now-string))))))
+ (cl-incf energy-full (string-to-number full-string))
+ (cl-incf energy-now (string-to-number now-string)))))
(goto-char (point-min))
- (when (and energy-now rate (not (zerop rate))
- (re-search-forward
- "POWER_SUPPLY_VOLTAGE_NOW=\\([0-9]*\\)$" nil t))
+ (unless (zerop power-now)
(let ((remaining (if (string= charging-state "Discharging")
energy-now
(- energy-full energy-now))))
- (setq hours (/ (/ (* remaining (string-to-number
- (match-string 1)))
- rate)
- 10000000.0)))))))
- (list (cons ?c (cond ((or (> charge-full 0) (> charge-now 0))
- (number-to-string charge-now))
- ((or (> energy-full 0) (> energy-now 0))
- (number-to-string 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")))
- (cons ?r (if rate (format "%.1f" (/ rate 1000000.0)) "N/A"))
+ (cons ?r (if (> power-now 0.0)
+ (format "%.1f" (/ power-now 1000000.0))
+ "N/A"))
(cons ?m (if hours (format "%d" (* hours 60)) "N/A"))
(cons ?h (if hours (format "%d" hours) "N/A"))
(cons ?t (if hours
@@ -511,21 +512,24 @@ The following %-sequences are provided:
"N/A"))
(cons ?d (or temperature "N/A"))
(cons ?B (or charging-state "N/A"))
- (cons ?p (cond ((and (> charge-full 0) (> charge-now 0))
- (format "%.1f"
- (/ (* 100 charge-now) charge-full)))
- ((> energy-full 0)
+ (cons ?p (cond ((and (> energy-full 0) (> energy-now 0))
(format "%.1f"
(/ (* 100 energy-now) energy-full)))
(t "N/A")))
- (cons ?L (if (file-readable-p "/sys/class/power_supply/AC/online")
- (if (battery-search-for-one-match-in-files
- (list "/sys/class/power_supply/AC/online"
- "/sys/class/power_supply/ACAD/online")
- "1" 0)
- "AC"
- "BAT")
- "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"))))))
;;; `apm' interface for BSD.
@@ -615,7 +619,7 @@ The following %-sequences are provided:
(with-temp-buffer
(ignore-errors (call-process "pmset" nil t nil "-g" "ps"))
(goto-char (point-min))
- (when (re-search-forward "Currentl?y drawing from '\\(AC\\|Battery\\) Power'" nil t)
+ (when (re-search-forward "\\(?:Currentl?y\\|Now\\) drawing from '\\(AC\\|Battery\\) Power'" nil t)
(setq power-source (match-string 1))
(when (re-search-forward "^ -InternalBattery-0[ \t]+" nil t)
(when (looking-at "\\([0-9]\\{1,3\\}\\)%")
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2ea6713216d..8560871694d 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1,9 +1,9 @@
;;; bindings.el --- define standard key bindings and some variables
-;; Copyright (C) 1985-1987, 1992-1996, 1999-2013 Free Software
+;; Copyright (C) 1985-1987, 1992-1996, 1999-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -36,7 +36,7 @@ corresponding to the mode line clicked."
(defun mode-line-toggle-read-only (event)
- "Like `toggle-read-only', for the mode-line."
+ "Like toggling `read-only-mode', for the mode-line."
(interactive "e")
(with-selected-window (posn-window (event-start event))
(read-only-mode 'toggle)))
@@ -229,11 +229,13 @@ mnemonics of the following coding systems:
'help-echo (purecopy (lambda (window _object _point)
(format "%s"
(with-selected-window window
- (concat
- (if (file-remote-p default-directory)
- "Current directory is remote: "
- "Current directory is local: ")
- default-directory)))))))
+ (if (stringp default-directory)
+ (concat
+ (if (file-remote-p default-directory)
+ "Current directory is remote: "
+ "Current directory is local: ")
+ default-directory)
+ "Current directory is nil")))))))
"Mode line construct to indicate a remote buffer.")
;;;###autoload
(put 'mode-line-remote 'risky-local-variable t)
@@ -631,7 +633,7 @@ okay. See `mode-line-format'.")
;; file-supersession should all be user-errors!
`(beginning-of-line beginning-of-buffer end-of-line
end-of-buffer end-of-file buffer-read-only
- file-supersession
+ file-supersession mark-inactive
user-error ;; That's the main one!
))
@@ -710,7 +712,7 @@ cursor movements produce identical results."
:type '(choice (const :tag "Logical-order cursor movement" nil)
(const :tag "Visual-order cursor movement" t))
:group 'display
- :version "24.5")
+ :version "24.4")
(defun right-char (&optional n)
"Move point N characters to the right (to the left if N is negative).
@@ -795,7 +797,6 @@ if `inhibit-field-text-motion' is non-nil."
;; suspend only the relevant terminal.
(substitute-key-definition 'suspend-emacs 'suspend-frame global-map)
-(define-key global-map "\C-j" 'newline-and-indent)
(define-key global-map "\C-m" 'newline)
(define-key global-map "\C-o" 'open-line)
(define-key esc-map "\C-o" 'split-line)
@@ -838,11 +839,11 @@ if `inhibit-field-text-motion' is non-nil."
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
- (define-key map [down] 'next-history-element)
+ (define-key map [down] 'next-line-or-history-element)
(define-key map [XF86Forward] 'next-history-element)
(define-key map "\ep" 'previous-history-element)
(define-key map [prior] 'previous-history-element)
- (define-key map [up] 'previous-history-element)
+ (define-key map [up] 'previous-line-or-history-element)
(define-key map [XF86Back] 'previous-history-element)
(define-key map "\es" 'next-matching-history-element)
(define-key map "\er" 'previous-matching-history-element)
@@ -873,6 +874,11 @@ if `inhibit-field-text-motion' is non-nil."
;; Update tutorial--default-keys if you change these.
(define-key global-map "\177" 'delete-backward-char)
+;; We explicitly want C-d to use `delete-char' instead of
+;; `delete-forward-char' so that it ignores `delete-active-region':
+;; Most C-d users are old-timers who don't expect
+;; `delete-active-region' here, while newer users who expect
+;; `delete-active-region' use C-d much less.
(define-key global-map "\C-d" 'delete-char)
(define-key global-map "\C-k" 'kill-line)
@@ -891,6 +897,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key ctl-x-map "\C-x" 'exchange-point-and-mark)
(define-key ctl-x-map "\C-@" 'pop-global-mark)
+(define-key ctl-x-map " " 'rectangle-mark-mode)
(define-key ctl-x-map [?\C- ] 'pop-global-mark)
(define-key global-map "\C-n" 'next-line)
@@ -918,14 +925,15 @@ if `inhibit-field-text-motion' is non-nil."
"Keymap for search related commands.")
(define-key esc-map "s" search-map)
-(define-key search-map "o" 'occur)
-(define-key search-map "hr" 'highlight-regexp)
-(define-key search-map "hp" 'highlight-phrase)
-(define-key search-map "hl" 'highlight-lines-matching-regexp)
-(define-key search-map "h." 'highlight-symbol-at-point)
-(define-key search-map "hu" 'unhighlight-regexp)
-(define-key search-map "hf" 'hi-lock-find-patterns)
-(define-key search-map "hw" 'hi-lock-write-interactive-patterns)
+(define-key search-map "o" 'occur)
+(define-key search-map "\M-w" 'eww-search-words)
+(define-key search-map "hr" 'highlight-regexp)
+(define-key search-map "hp" 'highlight-phrase)
+(define-key search-map "hl" 'highlight-lines-matching-regexp)
+(define-key search-map "h." 'highlight-symbol-at-point)
+(define-key search-map "hu" 'unhighlight-regexp)
+(define-key search-map "hf" 'hi-lock-find-patterns)
+(define-key search-map "hw" 'hi-lock-write-interactive-patterns)
;;(defun function-key-error ()
;; (interactive)
@@ -1055,36 +1063,34 @@ if `inhibit-field-text-motion' is non-nil."
;; FIXME: rather than list such mappings for every modifier-combination,
;; we should come up with a way to do it generically, something like
;; (define-key function-key-map [*-kp-home] [*-home])
-(define-key function-key-map [kp-home] [home])
-(define-key function-key-map [kp-left] [left])
-(define-key function-key-map [kp-up] [up])
-(define-key function-key-map [kp-right] [right])
-(define-key function-key-map [kp-down] [down])
-(define-key function-key-map [kp-prior] [prior])
-(define-key function-key-map [kp-next] [next])
-(define-key function-key-map [M-kp-next] [M-next])
-(define-key function-key-map [kp-end] [end])
-(define-key function-key-map [kp-begin] [begin])
-(define-key function-key-map [kp-insert] [insert])
+;; Currently we add keypad key combinations with basic modifiers
+;; (to complement plain bindings in "Keypad support" section in simple.el)
+;; Until [*-kp-home] is implemented, for more modifiers we could also use:
+;; (todo-powerset '(control meta shift hyper super alt)) (Bug#14397)
+(let ((modifiers '(nil (control) (meta) (control meta) (shift)
+ (control shift) (meta shift) (control meta shift)))
+ (keys '((kp-delete delete) (kp-insert insert)
+ (kp-end end) (kp-down down) (kp-next next)
+ (kp-left left) (kp-begin begin) (kp-right right)
+ (kp-home home) (kp-up up) (kp-prior prior)
+ (kp-enter enter) (kp-decimal ?.)
+ (kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
+ (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
+ (kp-add ?+) (kp-subtract ?-) (kp-multiply ?*) (kp-divide ?/))))
+ (dolist (pair keys)
+ (let ((keypad (nth 0 pair))
+ (normal (nth 1 pair)))
+ (when (characterp normal)
+ (put keypad 'ascii-character normal))
+ (dolist (mod modifiers)
+ (define-key function-key-map
+ (vector (append mod (list keypad)))
+ (vector (append mod (list normal))))))))
+
(define-key function-key-map [backspace] [?\C-?])
(define-key function-key-map [delete] [?\C-?])
(define-key function-key-map [kp-delete] [?\C-?])
-(define-key function-key-map [S-kp-end] [S-end])
-(define-key function-key-map [S-kp-down] [S-down])
-(define-key function-key-map [S-kp-next] [S-next])
-(define-key function-key-map [S-kp-left] [S-left])
-(define-key function-key-map [S-kp-right] [S-right])
-(define-key function-key-map [S-kp-home] [S-home])
-(define-key function-key-map [S-kp-up] [S-up])
-(define-key function-key-map [S-kp-prior] [S-prior])
-(define-key function-key-map [C-S-kp-end] [C-S-end])
-(define-key function-key-map [C-S-kp-down] [C-S-down])
-(define-key function-key-map [C-S-kp-next] [C-S-next])
-(define-key function-key-map [C-S-kp-left] [C-S-left])
-(define-key function-key-map [C-S-kp-right] [C-S-right])
-(define-key function-key-map [C-S-kp-home] [C-S-home])
-(define-key function-key-map [C-S-kp-up] [C-S-up])
-(define-key function-key-map [C-S-kp-prior] [C-S-prior])
+
;; Don't bind shifted keypad numeric keys, they reportedly
;; interfere with the feature of some keyboards to produce
;; numbers when NumLock is off.
@@ -1096,14 +1102,14 @@ if `inhibit-field-text-motion' is non-nil."
;(define-key function-key-map [S-kp-7] [S-home])
;(define-key function-key-map [S-kp-8] [S-up])
;(define-key function-key-map [S-kp-9] [S-prior])
-(define-key function-key-map [C-S-kp-1] [C-S-end])
-(define-key function-key-map [C-S-kp-2] [C-S-down])
-(define-key function-key-map [C-S-kp-3] [C-S-next])
-(define-key function-key-map [C-S-kp-4] [C-S-left])
-(define-key function-key-map [C-S-kp-6] [C-S-right])
-(define-key function-key-map [C-S-kp-7] [C-S-home])
-(define-key function-key-map [C-S-kp-8] [C-S-up])
-(define-key function-key-map [C-S-kp-9] [C-S-prior])
+;(define-key function-key-map [C-S-kp-1] [C-S-end])
+;(define-key function-key-map [C-S-kp-2] [C-S-down])
+;(define-key function-key-map [C-S-kp-3] [C-S-next])
+;(define-key function-key-map [C-S-kp-4] [C-S-left])
+;(define-key function-key-map [C-S-kp-6] [C-S-right])
+;(define-key function-key-map [C-S-kp-7] [C-S-home])
+;(define-key function-key-map [C-S-kp-8] [C-S-up])
+;(define-key function-key-map [C-S-kp-9] [C-S-prior])
;; Hitting C-SPC on text terminals, usually sends the ascii code 0 (aka C-@),
;; so we can't distinguish those two keys, but usually we consider C-SPC
@@ -1124,6 +1130,7 @@ if `inhibit-field-text-motion' is non-nil."
(define-key esc-map "j" 'indent-new-comment-line)
(define-key esc-map "\C-j" 'indent-new-comment-line)
(define-key ctl-x-map ";" 'comment-set-column)
+(define-key ctl-x-map [?\C-\;] 'comment-line)
(define-key ctl-x-map "f" 'set-fill-column)
(define-key ctl-x-map "$" 'set-selective-display)
@@ -1258,9 +1265,9 @@ if `inhibit-field-text-motion' is non-nil."
(define-key abbrev-map "e" 'expand-abbrev)
(define-key abbrev-map "'" 'expand-abbrev)
;; (define-key ctl-x-map "\C-a" 'add-mode-abbrev)
-;; (define-key ctl-x-map "\+" 'add-global-abbrev)
+;; (define-key ctl-x-map "+" 'add-global-abbrev)
;; (define-key ctl-x-map "\C-h" 'inverse-add-mode-abbrev)
-;; (define-key ctl-x-map "\-" 'inverse-add-global-abbrev)
+;; (define-key ctl-x-map "-" 'inverse-add-global-abbrev)
(define-key esc-map "'" 'abbrev-prefix-mark)
(define-key ctl-x-map "'" 'expand-abbrev)
(define-key ctl-x-map "\C-b" 'list-buffers)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 9514317809b..e9310259e7e 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -1,6 +1,6 @@
;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
-;; Copyright (C) 1993-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
@@ -130,14 +130,15 @@ recently set ones come first, oldest ones come last)."
:group 'bookmark)
(defcustom bookmark-bmenu-use-header-line t
- "Non-nil means to use an immovable header line, as opposed to inline
-text at the top of the buffer."
+ "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
:group 'bookmark)
(defconst bookmark-bmenu-inline-header-height 2
"Number of lines used for the *Bookmark List* header
-\(only significant when `bookmark-bmenu-use-header-line' is nil\).")
+\(only significant when `bookmark-bmenu-use-header-line' is nil).")
(defconst bookmark-bmenu-marks-width 2
"Number of columns (chars) used for the *Bookmark List* marks column,
@@ -841,8 +842,11 @@ whose annotation is being edited.")
"Return default annotation text for BOOKMARK-NAME.
The default annotation text is simply some text explaining how to use
annotations."
- (concat "# Type the annotation for bookmark '" bookmark-name "' here.\n"
- "# All lines which start with a '#' will be deleted.\n"
+ (concat (format-message
+ "# Type the annotation for bookmark `%s' here.\n"
+ bookmark-name)
+ (format-message
+ "# All lines which start with a `#' will be deleted.\n")
"# Type C-c C-c when done.\n#\n"
"# Author: " (user-full-name) " <" (user-login-name) "@"
(system-name) ">\n"
@@ -862,31 +866,25 @@ It takes one argument, the name of the bookmark, as a string.")
map)
"Keymap for editing an annotation of a bookmark.")
-
-(defun bookmark-edit-annotation-mode (bookmark-name-or-record)
- "Mode for editing the annotation of bookmark BOOKMARK-NAME-OR-RECORD.
-When you have finished composing, type \\[bookmark-send-annotation].
-
-\\{bookmark-edit-annotation-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (make-local-variable 'bookmark-annotation-name)
- (setq bookmark-annotation-name bookmark-name-or-record)
- (use-local-map bookmark-edit-annotation-mode-map)
- (setq major-mode 'bookmark-edit-annotation-mode
- mode-name "Edit Bookmark Annotation")
+(defun bookmark-insert-annotation (bookmark-name-or-record)
(insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
(let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
(if (and annotation (not (string-equal annotation "")))
- (insert annotation)))
- (run-mode-hooks 'text-mode-hook))
+ (insert annotation))))
+
+(define-derived-mode bookmark-edit-annotation-mode
+ text-mode "Edit Bookmark Annotation"
+ "Mode for editing the annotation of bookmarks.
+When you have finished composing, type \\[bookmark-send-annotation].
+
+\\{bookmark-edit-annotation-mode-map}")
(defun bookmark-send-edited-annotation ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
(interactive)
- (if (not (eq major-mode 'bookmark-edit-annotation-mode))
+ (if (not (derived-mode-p 'bookmark-edit-annotation-mode))
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
(while (< (point) (point-max))
@@ -906,7 +904,10 @@ Lines beginning with `#' are ignored."
(defun bookmark-edit-annotation (bookmark-name-or-record)
"Pop up a buffer for editing bookmark BOOKMARK-NAME-OR-RECORD's annotation."
(pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
- (bookmark-edit-annotation-mode bookmark-name-or-record))
+ (bookmark-insert-annotation bookmark-name-or-record)
+ (bookmark-edit-annotation-mode)
+ (set (make-local-variable 'bookmark-annotation-name)
+ bookmark-name-or-record))
(defun bookmark-buffer-name ()
@@ -1300,8 +1301,8 @@ is greater than `bookmark-alist-modification-count'."
;;;###autoload
(defun bookmark-write ()
- "Write bookmarks to a file (reading the file name with the minibuffer).
-Don't use this in Lisp programs; use `bookmark-save' instead."
+ "Write bookmarks to a file (reading the file name with the minibuffer)."
+ (declare (interactive-only bookmark-save))
(interactive)
(bookmark-maybe-load-default-file)
(bookmark-save t))
@@ -1422,8 +1423,7 @@ explicitly.
If you load a file containing bookmarks with the same names as
bookmarks already present in your Emacs, the new bookmarks will get
-unique numeric suffixes \"<2>\", \"<3>\", ... following the same
-method buffers use to resolve name collisions."
+unique numeric suffixes \"<2>\", \"<3>\", etc."
(interactive
(list (read-file-name
(format "Load bookmarks from: (%s) "
@@ -1543,7 +1543,7 @@ deletion, or > if it is flagged for displaying."
(let ((inhibit-read-only t))
(erase-buffer)
(if (not bookmark-bmenu-use-header-line)
- (insert "% Bookmark\n- --------\n"))
+ (insert "% Bookmark\n- --------\n"))
(add-text-properties (point-min) (point)
'(font-lock-face bookmark-menu-heading))
(dolist (full-record (bookmark-maybe-sort-alist))
@@ -1584,9 +1584,9 @@ deletion, or > if it is flagged for displaying."
(defun bookmark-bmenu-set-header ()
"Sets the immutable header line."
(let ((header (concat "%% " "Bookmark")))
- (when bookmark-bmenu-toggle-filenames
- (setq header (concat header
- (make-string (- bookmark-bmenu-file-column
+ (when bookmark-bmenu-toggle-filenames
+ (setq header (concat header
+ (make-string (- bookmark-bmenu-file-column
(- (length header) 3)) ?\s)
"File")))
(let ((pos 0))
@@ -1759,7 +1759,7 @@ if an annotation exists."
(save-selected-window
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
- (dolist (full-record bookmark-alist)
+ (dolist (full-record (bookmark-maybe-sort-alist))
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation full-record)))
(insert (concat name ":\n"))
@@ -2067,7 +2067,8 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(defun bookmark-bmenu-goto-bookmark (name)
"Move point to bookmark with name NAME."
(goto-char (point-min))
- (while (not (equal name (bookmark-bmenu-bookmark)))
+ (while (not (or (equal name (bookmark-bmenu-bookmark))
+ (eobp)))
(forward-line 1))
(forward-line 0))
diff --git a/lisp/bs.el b/lisp/bs.el
index 6871a7eeb83..1735c176700 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -1,6 +1,6 @@
;;; bs.el --- menu for selecting and displaying buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Keywords: convenience
@@ -954,7 +954,7 @@ Default is `bs--current-sort-function'."
(defun bs-toggle-readonly ()
"Toggle read-only status for buffer on current line.
-Uses function `toggle-read-only'."
+Uses function `read-only-mode'."
(interactive)
(with-current-buffer (bs--current-buffer)
(read-only-mode 'toggle))
@@ -1143,7 +1143,7 @@ and move point to current buffer."
(delete-char -1)
(bs--set-window-height)
(bs--goto-current-buffer)
- (font-lock-fontify-buffer)
+ (font-lock-ensure)
(bs-apply-sort-faces)
(set-buffer-modified-p nil)))
@@ -1314,7 +1314,7 @@ ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
(format-mode-line mode-name nil nil start-buffer))
(defun bs--get-file-name (_start-buffer _all-buffers)
- "Return string for column 'File' in Buffer Selection Menu.
+ "Return string for column `File' in Buffer Selection Menu.
This is the variable `buffer-file-name' of current buffer.
If not visiting a file, `list-buffers-directory' is returned instead.
START-BUFFER is the buffer where we started buffer selection.
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 58fde695b39..91bc0382951 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,9 +1,9 @@
;;; buff-menu.el --- Interface for viewing and manipulating buffers
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1995, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; Package: emacs
@@ -353,14 +353,22 @@ It will be displayed by the \\<Buffer-menu-mode-map>\\[Buffer-menu-select] comma
"Cancel all requested operations on buffer on this line and move down.
Optional prefix arg means move up."
(interactive "P")
- (tabulated-list-set-col 0 " " t)
+ (Buffer-menu--unmark)
(forward-line (if backup -1 1)))
(defun Buffer-menu-backup-unmark ()
"Move up and cancel all requested operations on buffer on line above."
(interactive)
(forward-line -1)
- (tabulated-list-set-col 0 " " t))
+ (Buffer-menu--unmark))
+
+(defun Buffer-menu--unmark ()
+ (tabulated-list-set-col 0 " " t)
+ (let ((buf (Buffer-menu-buffer)))
+ (when buf
+ (if (buffer-modified-p buf)
+ (tabulated-list-set-col 2 "*" t)
+ (tabulated-list-set-col 2 " " t)))))
(defun Buffer-menu-delete (&optional arg)
"Mark the buffer on this Buffer Menu buffer line for deletion.
@@ -531,7 +539,7 @@ The current window remains selected."
(defun Buffer-menu-toggle-read-only ()
"Toggle read-only status of buffer on this line.
-This behaves like invoking \\[toggle-read-only] in that buffer."
+This behaves like invoking \\[read-only-mode] in that buffer."
(interactive)
(let ((read-only
(with-current-buffer (Buffer-menu-buffer t)
diff --git a/lisp/button.el b/lisp/button.el
index 433c3990d59..e7602dd7050 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -1,6 +1,6 @@
;;; button.el --- clickable buttons
;;
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: extensions
@@ -224,10 +224,10 @@ changes to a supertype are not reflected in its subtypes)."
prop val))))
(defun button-activate (button &optional use-mouse-action)
- "Call BUTTON's action property.
-If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
-instead of its normal action; if the button has no mouse-action,
-the normal action is used instead.
+ "Call BUTTON's `action' property.
+If USE-MOUSE-ACTION is non-nil, invoke the button's `mouse-action'
+property instead of `action'; if the button has no `mouse-action',
+the value of `action' is used instead.
The action can either be a marker or a function. If it's a
marker then goto it. Otherwise it it is a function then it is
@@ -429,11 +429,13 @@ instead of starting at the next button."
(defun push-button (&optional pos use-mouse-action)
"Perform the action specified by a button at location POS.
POS may be either a buffer position or a mouse-event. If
-USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
-instead of its normal action; if the button has no mouse-action,
-the normal action is used instead. The action may be either a
-function to call or a marker to display and is invoked using
-`button-activate' (which see).
+USE-MOUSE-ACTION is non-nil, invoke the button's `mouse-action'
+property instead of its `action' property; if the button has no
+`mouse-action', the value of `action' is used instead.
+
+The action in both cases may be either a function to call or a
+marker to display and is invoked using `button-activate' (which
+see).
POS defaults to point, except when `push-button' is invoked
interactively as the result of a mouse-event, in which case, the
@@ -449,7 +451,7 @@ return t."
(if (posn-string posn)
;; mode-line, header-line, or display string event.
(button-activate (posn-string posn) t)
- (push-button (posn-point posn)) t)))
+ (push-button (posn-point posn) t))))
;; POS is just normal position
(let ((button (button-at (or pos (point)))))
(when button
diff --git a/lisp/calc/.gitignore b/lisp/calc/.gitignore
deleted file mode 100644
index a46b68dccbd..00000000000
--- a/lisp/calc/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-*.elc
-calc-loaddefs.el
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 6b0cfbb55d9..f4754c73e7e 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1,6 +1,6 @@
;;; calc-aent.el --- algebraic entry functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -30,6 +30,7 @@
(require 'calc-macs)
;; Declare functions which are defined elsewhere.
+(declare-function calc-digit-start-entry "calc" ())
(declare-function calc-refresh-evaltos "calc-ext" (&optional which-var))
(declare-function calc-execute-kbd-macro "calc-prog" (mac arg &rest prefix))
(declare-function math-is-true "calc-ext" (expr))
@@ -52,7 +53,7 @@
"The history list for quick-calc.")
;;;###autoload
-(defun calc-do-quick-calc ()
+(defun calc-do-quick-calc (&optional insert)
(require 'calc-ext)
(calc-check-defines)
(if (eq major-mode 'calc-mode)
@@ -108,7 +109,8 @@
(setq buf long))))
(calc-handle-whys)
(message "Result: %s" buf)))
- (if (eq last-command-event 10)
+ (if (or insert
+ (eq last-command-event 10))
(insert shortbuf)
(kill-new shortbuf)))))
@@ -449,12 +451,7 @@ The value t means abort and give an error message.")
;;;###autoload
(defun calc-alg-digit-entry ()
(calc-alg-entry
- (cond ((eq last-command-event ?e)
- (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
- ((eq last-command-event ?#) (format "%d#" calc-number-radix))
- ((eq last-command-event ?_) "-")
- ((eq last-command-event ?@) "0@ ")
- (t (char-to-string last-command-event)))))
+ (calc-digit-start-entry)))
;; The variable calc-digit-value is initially declared in calc.el,
;; but can be set by calcDigit-algebraic and calcDigit-edit.
@@ -1056,7 +1053,7 @@ If the current Calc language does not use placeholders, return nil."
(defun math-read-if (cond op)
(let ((then (math-read-expr-level 0)))
(or (equal math-expr-data ":")
- (throw 'syntax "Expected ':'"))
+ (throw 'syntax "Expected `:'"))
(math-read-token)
(list 'calcFunc-if cond then (math-read-expr-level (nth 3 op)))))
@@ -1176,7 +1173,7 @@ If the current Calc language does not use placeholders, return nil."
(setq el (cdr el))))
(if (equal math-expr-data "]")
(math-read-token)
- (throw 'syntax "Expected ']'")))
+ (throw 'syntax "Expected `]'")))
val)))))
((eq math-exp-token 'dollar)
(let ((abs (if (> math-expr-data 0) math-expr-data (- math-expr-data))))
@@ -1265,7 +1262,6 @@ If the current Calc language does not use placeholders, return nil."
(provide 'calc-aent)
;; Local variables:
-;; coding: utf-8
;; generated-autoload-file: "calc-loaddefs.el"
;; End:
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 2240c1c81b3..ebc5ba66ec6 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -1,6 +1,6 @@
;;; calc-alg.el --- algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -293,7 +293,7 @@
(Math-objectp a))
((eq (car a) 'var)
(if (eq (car b) 'var)
- (string-lessp (symbol-name (nth 1 a)) (symbol-name (nth 1 b)))
+ (string-lessp (nth 1 a) (nth 1 b))
(not (Math-numberp b))))
((eq (car b) 'var) (Math-numberp a))
((eq (car a) (car b))
@@ -302,7 +302,7 @@
(and b
(or (null a)
(math-beforep (car a) (car b)))))
- (t (string-lessp (symbol-name (car a)) (symbol-name (car b))))))
+ (t (string-lessp (car a) (car b)))))
(defsubst math-simplify-extended (a)
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index c64a4f49fe8..de27c5684e6 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -1,6 +1,6 @@
;;; calc-arith.el --- arithmetic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -2249,7 +2249,7 @@
(defun math-min-list (a b)
(if b
- (if (or (Math-anglep (car b)) (eq (car b) 'date)
+ (if (or (Math-anglep (car b)) (eq (caar b) 'date)
(and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
(math-infinitep (car b)))
(math-min-list (math-min a (car b)) (cdr b))
@@ -2279,7 +2279,7 @@
(defun math-max-list (a b)
(if b
- (if (or (Math-anglep (car b)) (eq (car b) 'date)
+ (if (or (Math-anglep (car b)) (eq (caar b) 'date)
(and (eq (car (car b)) 'intv) (math-intv-constp (car b)))
(math-infinitep (car b)))
(math-max-list (math-max a (car b)) (cdr b))
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index a159488b935..9a1e524e609 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -1,6 +1,6 @@
;;; calc-bin.el --- binary functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index e09bef0b5c9..4e52a3b144e 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -1,6 +1,6 @@
;;; calc-comb.el --- combinatoric functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -815,8 +815,14 @@
(list nil v)
'(t))))
((not (equal n (car math-prime-test-cache)))
- (cond ((= (% (nth 1 n) 2) 0) '(nil 2))
- ((= (% (nth 1 n) 5) 0) '(nil 5))
+ (cond ((if (consp n)
+ (= (% (nth 1 n) 2) 0)
+ (= (% n 2) 0))
+ '(nil 2))
+ ((if (consp n)
+ (= (% (nth 1 n) 5) 0)
+ (= (% n 5) 0))
+ '(nil 5))
(t (let ((q n) (sum 0))
(while (not (eq q 0))
(setq sum (%
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index 34297e83a5d..edcd3c21a0b 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -1,6 +1,6 @@
;;; calc-cplx.el --- Complex number functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 0da9be0d499..d0efe53f6e6 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -1,6 +1,6 @@
;;; calc-embed.el --- embed Calc in a buffer
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -30,7 +30,8 @@
(require 'calc-macs)
;; Declare functions which are defined elsewhere.
-(declare-function thing-at-point-looking-at "thingatpt" (regexp))
+(declare-function thing-at-point-looking-at "thingatpt"
+ (regexp &optional distance))
(defun calc-show-plain (n)
@@ -329,10 +330,12 @@
(if calc-embedded-firsttime-formula
(run-hooks 'calc-embedded-new-formula-hook))
(or (eq calc-embedded-quiet t)
- (message "Embedded Calc mode enabled; %s to return to normal"
- (if calc-embedded-quiet
- "Type `C-x * x'"
- "Give this command again")))))
+ (message (concat
+ "Embedded Calc mode enabled; "
+ (if calc-embedded-quiet
+ "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.
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 2cb5bf450d5..9adf66f23bd 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -1,6 +1,6 @@
;;; calc-ext.el --- various extension functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -561,6 +561,7 @@
(define-key calc-mode-map "ud" 'calc-define-unit)
(define-key calc-mode-map "ue" 'calc-explain-units)
(define-key calc-mode-map "ug" 'calc-get-unit-definition)
+ (define-key calc-mode-map "un" 'calc-convert-exact-units)
(define-key calc-mode-map "up" 'calc-permanent-units)
(define-key calc-mode-map "ur" 'calc-remove-units)
(define-key calc-mode-map "us" 'calc-simplify-units)
@@ -573,6 +574,7 @@
(define-key calc-mode-map "uG" 'calc-vector-geometric-mean)
(define-key calc-mode-map "uM" 'calc-vector-mean)
(define-key calc-mode-map "uN" 'calc-vector-min)
+ (define-key calc-mode-map "uR" 'calc-vector-rms)
(define-key calc-mode-map "uS" 'calc-vector-sdev)
(define-key calc-mode-map "uU" 'calc-undo)
(define-key calc-mode-map "uX" 'calc-vector-max)
@@ -931,7 +933,7 @@ calc-preserve-point calc-replace-selections calc-replace-sub-formula
calc-roll-down-with-selections calc-roll-up-with-selections
calc-sel-error)
- ("calc-stat" calc-vector-op calcFunc-agmean
+ ("calc-stat" calc-vector-op calcFunc-agmean calcFunc-rms
calcFunc-vcorr calcFunc-vcount calcFunc-vcov calcFunc-vflat
calcFunc-vgmean calcFunc-vhmean calcFunc-vmax calcFunc-vmean
calcFunc-vmeane calcFunc-vmedian calcFunc-vmin calcFunc-vpcov
@@ -1096,10 +1098,10 @@ calc-tan calc-tanh calc-to-degrees calc-to-radians)
("calc-mode" calc-alg-simplify-mode calc-algebraic-mode
calc-always-load-extensions calc-auto-recompute calc-auto-why
-calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors
-calc-center-justify calc-default-simplify-mode calc-display-raw
-calc-eng-notation calc-ext-simplify-mode calc-fix-notation
-calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char
+calc-basic-simplify-mode calc-bin-simplify-mode calc-break-vectors
+calc-center-justify calc-default-simplify-mode calc-display-raw
+calc-eng-notation calc-ext-simplify-mode calc-fix-notation
+calc-full-trail-vectors calc-full-vectors calc-get-modes calc-group-char
calc-group-digits calc-infinite-mode calc-left-justify calc-left-label
calc-line-breaking calc-line-numbering calc-matrix-brackets
calc-matrix-center-justify calc-matrix-left-justify calc-matrix-mode
@@ -1146,8 +1148,8 @@ calc-vector-covariance calc-vector-geometric-mean
calc-vector-harmonic-mean calc-vector-max calc-vector-mean
calc-vector-mean-error calc-vector-median calc-vector-min
calc-vector-pop-covariance calc-vector-pop-sdev
-calc-vector-pop-variance calc-vector-product calc-vector-sdev
-calc-vector-sum calc-vector-variance)
+calc-vector-pop-variance calc-vector-product calc-vector-rms
+calc-vector-sdev calc-vector-sum calc-vector-variance)
("calc-store" calc-assign calc-copy-special-constant
calc-copy-variable calc-declare-variable
@@ -1176,7 +1178,8 @@ calc-trail-scroll-right calc-trail-yank)
("calc-undo" calc-last-args calc-redo)
("calc-units" calc-autorange-units calc-base-units
-calc-convert-temperature calc-convert-units calc-define-unit
+calc-convert-temperature calc-convert-units
+calc-convert-exact-units calc-define-unit
calc-enter-units-table calc-explain-units calc-extract-units
calc-get-unit-definition calc-permanent-units calc-quick-units
calc-remove-units calc-simplify-units calc-undefine-unit
@@ -1243,7 +1246,7 @@ calc-kill calc-kill-region calc-yank))))
(defun calc-record-message (tag &rest args)
- (let ((msg (apply 'format args)))
+ (let ((msg (apply #'format-message args)))
(message "%s" msg)
(calc-record msg tag))
(calc-clear-command-flag 'clear-message))
@@ -1290,6 +1293,7 @@ calc-kill calc-kill-region calc-yank))))
(define-key calc-help-map "?" 'calc-help-for-help)
(define-key calc-help-map "\C-h" 'calc-help-for-help))
+(defvar calc-prefix-help-retry nil)
(defvar calc-prefix-help-phase 0)
(defun calc-do-prefix-help (msgs group key)
(if calc-full-help-flag
@@ -1297,7 +1301,7 @@ calc-kill calc-kill-region calc-yank))))
(if (cdr msgs)
(progn
(setq calc-prefix-help-phase
- (if (eq this-command last-command)
+ (if calc-prefix-help-retry
(% (1+ calc-prefix-help-phase) (1+ (length msgs)))
0))
(let ((msg (nth calc-prefix-help-phase msgs)))
@@ -1318,7 +1322,13 @@ calc-kill calc-kill-region calc-yank))))
(message "%s: %s: %c-" group (car msgs) key)
(message "%s: (none) %c-" group key))
(message "%s: %s" group (car msgs))))
- (and key (calc-unread-command key))))
+ (let* ((chr (read-char))
+ (bnd (local-key-binding (if key (string key chr) (string chr)))))
+ (setq calc-prefix-help-retry (= chr ??))
+ (if bnd
+ (call-interactively bnd)
+ (message "%s is undefined"
+ (key-description (if key (vector key chr) (vector chr))))))))
;;;; Commands.
@@ -1955,7 +1965,7 @@ calc-kill calc-kill-region calc-yank))))
(desc
(if (symbolp func)
(if (= (logand kind 3) 0)
- (format "`%c' = %s" key name)
+ (format-message "`%c' = %s" key name)
(if pos
(format "%s%c%s"
(downcase (substring name 0 pos))
@@ -1986,7 +1996,7 @@ calc-kill calc-kill-region calc-yank))))
"kbd-macros: [ (if), : (else), | (else-if), ] (end-if)"
"kbd-macros: < > (repeat), ( ) (for), { } (loop)"
"kbd-macros: / (break)"
- "kbd-macros: ` (save), ' (restore)")
+ "kbd-macros: \\=` (save), \\=' (restore)")
"user" ?Z))
@@ -3497,8 +3507,4 @@ A key may contain additional specs for Inverse, Hyperbolic, and Inv+Hyp.")
(provide 'calc-ext)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calc-ext.el ends here
diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el
index a93a57c79ee..76c34e63ef8 100644
--- a/lisp/calc/calc-fin.el
+++ b/lisp/calc/calc-fin.el
@@ -1,6 +1,6 @@
;;; calc-fin.el --- financial functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 77efb1efc84..08fa5ceaa79 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -1,6 +1,6 @@
;;; calc-forms.el --- data format conversion functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -63,7 +63,7 @@
(defun calc-hms-notation (fmt)
- (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
+ (interactive "sHours-minutes-seconds format (hms, @ \\=' \", etc.): ")
(calc-wrapper
(if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt)
(progn
@@ -273,7 +273,10 @@
(m (math-normalize (nth 2 a)))
(s (let ((calc-internal-prec (max (- calc-internal-prec 4) 3)))
(math-normalize (nth 3 a)))))
- (if (math-negp h)
+ (if (or
+ (math-negp h)
+ (and (= h 0) (math-negp m))
+ (and (= h 0) (= m 0) (math-negp s)))
(progn
(if (math-posp s)
(setq s (math-add s -60)
@@ -375,15 +378,15 @@
;;; A numerical date is the number of days since midnight on
;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian).
;;; Emacs's calendar refers to such a date as an absolute date, some Calc function
-;;; names also use that terminology. If the date is a non-integer, it represents
-;;; a specific date and time.
+;;; names also use that terminology. If the date is a non-integer, it represents
+;;; a specific date and time.
;;; A "dt" is a list of the form, (year month day), corresponding to
;;; an integer code, or (year month day hour minute second), corresponding
;;; to a non-integer code.
(defun math-date-to-gregorian-dt (date)
"Return the day (YEAR MONTH DAY) in the Gregorian calendar.
-DATE is the number of days since December 31, -1 in the Gregorian calendar."
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
(let* ((month 1)
day
(year (math-quotient (math-add date (if (Math-lessp date 711859)
@@ -396,7 +399,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar."
(setq year (math-add year -1)))
(if (eq year 0) (setq year -1))
(setq date (1+ (math-sub date temp)))
- (setq temp
+ (setq temp
(if (math-leap-year-p year)
[1 32 61 92 122 153 183 214 245 275 306 336 999]
[1 32 60 91 121 152 182 213 244 274 305 335 999]))
@@ -407,7 +410,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar."
(defun math-date-to-julian-dt (date)
"Return the day (YEAR MONTH DAY) in the Julian calendar.
-DATE is the number of days since December 31, -1 in the Gregorian calendar."
+DATE is the number of days since December 31, -1 in the Gregorian calendar."
(let* ((month 1)
day
(year (math-quotient (math-add date (if (Math-lessp date 711859)
@@ -420,7 +423,7 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar."
(setq year (math-add year -1)))
(if (eq year 0) (setq year -1))
(setq date (1+ (math-sub date temp)))
- (setq temp
+ (setq temp
(if (math-leap-year-p year t)
[1 32 61 92 122 153 183 214 245 275 306 336 999]
[1 32 60 91 121 152 182 213 244 274 305 335 999]))
@@ -441,7 +444,7 @@ in the Gregorian calendar and the remaining part determines the time."
(date (car parts))
(time (nth 1 parts))
(dt (if (and calc-gregorian-switch
- (Math-lessp value
+ (Math-lessp value
(or
(nth 3 calc-gregorian-switch)
(apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
@@ -450,7 +453,7 @@ in the Gregorian calendar and the remaining part determines the time."
(math-date-to-gregorian-dt date))))
(if (math-integerp value)
dt
- (append dt
+ (append dt
(list
(/ time 3600)
(% (/ time 60) 60)
@@ -464,13 +467,13 @@ in the Gregorian calendar and the remaining part determines the time."
(year (math-add approx
(let ((y approx)
(sum 0))
- (while (>= (math-compare date
+ (while (>= (math-compare date
(math-absolute-from-iso-dt (setq y (math-add y 1)) 1 1)) 0)
(setq sum (+ sum 1)))
sum))))
- (list
+ (list
year
- (math-add (car (math-idivmod
+ (math-add (car (math-idivmod
(math-sub date (math-absolute-from-iso-dt year 1 1))
7))
1)
@@ -522,7 +525,7 @@ in the Gregorian calendar and the remaining part determines the time."
(defun math-leap-year-p (year &optional julian)
"Non-nil if YEAR is a leap year.
If JULIAN is non-nil, then use the criterion for leap years
-in the Julian calendar, otherwise use the criterion in the
+in the Julian calendar, otherwise use the criterion in the
Gregorian calendar."
(if julian
(if (math-negp year)
@@ -581,7 +584,7 @@ Recall that DATE is the number of days since December 31, -1
in the Gregorian calendar."
(if (eq year 0) (setq year -1))
(let ((yearm1 (math-sub year 1)))
- (math-sub
+ (math-sub
;; Add the number of days of the year and the numbers of days
;; in the previous years (leap year days to be added separately)
(math-add (math-day-in-year year month day)
@@ -592,9 +595,9 @@ in the Gregorian calendar."
(math-sub 365
(math-quotient (math-sub 3 year)
4)))))
- ;; Subtract the number of Julian leap years which are not
- ;; Gregorian leap years. In C=4N+r centuries, there will
- ;; be 3N+r of these days. The following will compute
+ ;; Subtract the number of Julian leap years which are not
+ ;; Gregorian leap years. In C=4N+r centuries, there will
+ ;; be 3N+r of these days. The following will compute
;; 3N+r.
(let* ((correction (math-mul (math-quotient yearm1 100) 3))
(res (math-idivmod correction 4)))
@@ -609,7 +612,7 @@ Recall that DATE is the number of days since December 31, -1
in the Gregorian calendar."
(if (eq year 0) (setq year -1))
(let ((yearm1 (math-sub year 1)))
- (math-sub
+ (math-sub
;; Add the number of days of the year and the numbers of days
;; in the previous years (leap year days to be added separately)
(math-add (math-day-in-year year month day)
@@ -728,11 +731,11 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
((eq x 'n)
(math-format-number (math-floor math-fd-date)))
((eq x 'J)
- (math-format-number
+ (math-format-number
(math-add math-fd-date math-julian-date-beginning)))
((eq x 'j)
- (math-format-number (math-add
- (math-floor math-fd-date)
+ (math-format-number (math-add
+ (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))))
@@ -1079,7 +1082,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(throw 'syntax "Day value is out of range"))
(and hour
(progn
- (if (or (< hour 0)
+ (if (or (< hour 0)
(> hour 24)
(and (= hour 24)
(not (= minute 0))
@@ -1099,7 +1102,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
(throw 'syntax "Weekday value is out of range"))
(and hour
(progn
- (if (or (< hour 0)
+ (if (or (< hour 0)
(> hour 24)
(and (= hour 24)
(not (= minute 0))
@@ -1435,11 +1438,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 719164 (math-div date '(float 864 2))))
+ (setq date (math-add 719163 (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) 719164))
+ (math-add (nth 1 (math-date-parts (nth 1 date) 719163))
(calcFunc-tzone zone date))
(math-reject-arg date 'datep))))
@@ -1470,7 +1473,7 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
;; From cal-dst
(defvar calendar-current-time-zone-cache)
-(defvar math-calendar-tzinfo
+(defvar math-calendar-tzinfo
nil
"Information about the timezone, retrieved from the calendar.")
@@ -1520,7 +1523,7 @@ second, the number of seconds offset for daylight savings."
(if (calc-var-value 'var-TimeZone)
(calcFunc-tzone (calc-var-value 'var-TimeZone) date)
(let ((tzinfo (math-get-calendar-tzinfo)))
- (+ (nth 0 tzinfo)
+ (+ (nth 0 tzinfo)
(* (math-cal-daylight-savings-adjust date) (nth 1 tzinfo)))))))
(defvar math-daylight-savings-hook 'math-std-daylight-savings)
@@ -1556,8 +1559,8 @@ second, the number of seconds offset for daylight savings."
(+ (nth 3 dt) (/ (nth 4 dt) 60.0)))
(t
0)))
- (rounded-abs-date
- (+
+ (rounded-abs-date
+ (+
(calendar-absolute-from-gregorian
(list (nth 1 dt) (nth 2 dt) (nth 0 dt)))
(/ (round (* 60 time)) 60.0 24.0))))
@@ -1697,7 +1700,7 @@ and ends on the last Sunday of October at 2 a.m."
(let* ((dt (math-date-to-dt date))
(dim (math-days-in-month (car dt) (nth 1 dt)))
(julian (if calc-gregorian-switch
- (math-date-to-dt (math-sub
+ (math-date-to-dt (math-sub
(or (nth 3 calc-gregorian-switch)
(apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
1)))))
@@ -1724,14 +1727,14 @@ and ends on the last Sunday of October at 2 a.m."
(list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day))))
;; Otherwise do some computations
(let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian)))))
- (list 'date (math-dt-to-date
+ (list 'date (math-dt-to-date
(list (car dt)
(nth 1 dt)
- ;;
+ ;;
(if (> tm dim) dim tm)))))))
((and (eq (car dt) (car julian))
(= (nth 1 dt) (nth 1 julian)))
- ;; In this case, the current month is truncated because of the switch
+ ;; In this case, the current month is truncated because of the switch
;; to the Gregorian calendar
(list 'date (math-dt-to-date
(list (car dt)
@@ -1739,7 +1742,7 @@ and ends on the last Sunday of October at 2 a.m."
(if (>= day (nth 2 julian))
(nth 2 julian)
(1+ day))))))
- (t
+ (t
;; The default
(list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))
(list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))))
@@ -1776,7 +1779,7 @@ and ends on the last Sunday of October at 2 a.m."
;; Otherwise, just make sure the date doesn't go past the end of the year
(list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
(math-dt-to-date (list (car dt) 12 31))))))
- (t
+ (t
(list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
(1- day)))))
(list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index 63288054bb3..830bafed6ce 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -1,6 +1,6 @@
;;; calc-frac.el --- fraction functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 24dd95d23eb..51922c88099 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -1,6 +1,6 @@
;;; calc-funcs.el --- well-known functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 16fc6c09dbe..20b0249ec1a 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1,6 +1,6 @@
;;; calc-graph.el --- graph output functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 2b7b56c3f89..33cb1c1566c 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -1,6 +1,6 @@
;;; calc-help.el --- help display functions for Calc,
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -30,7 +30,7 @@
(require 'calc-macs)
;; Declare functions which are defined elsewhere.
-(declare-function Info-goto-node "info" (nodename &optional fork))
+(declare-function Info-goto-node "info" (nodename &optional fork strict-case))
(declare-function Info-last "info" ())
@@ -239,7 +239,7 @@ C-w Describe how there is no warranty for Calc."
(setq prompts (substring prompts 0 (match-beginning 0))))
(if (string-match "\\` +" prompts)
(setq prompts (substring prompts (match-end 0))))
- (setq msg (format
+ (setq msg (format-message
"%s: %s%s`%s'%s%s %s%s"
(if (string-match
"\\`\\(calc-[-a-zA-Z0-9]+\\) *\\(.*\\)\\'"
@@ -364,23 +364,21 @@ C-w Describe how there is no warranty for Calc."
(error "Can't find `%s' in %s" thing where)))
(let (Info-history)
(Info-goto-node (buffer-substring (match-beginning 1) (match-end 1))))
- (or (let ((case-fold-search nil))
- (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
- (or target thing)
- (or target thing)
- (or target thing)) nil t)
- (and not-quoted
- (let ((case-fold-search t))
- (search-forward (or target thing) nil t)))
- (search-forward (format "`%s'" (or target thing)) nil t)
- (search-forward (or target thing) nil t)))
- (let ((case-fold-search t))
- (or (re-search-forward (format "\\[`%s'\\]\\|(`%s')\\|\\<The[ \n]`%s'"
- (or target thing)
- (or target thing)
- (or target thing)) nil t)
- (search-forward (format "`%s'" (or target thing)) nil t)
- (search-forward (or target thing) nil t))))
+ (let* ((string-target (or target thing))
+ (quoted (format "['`‘]%s['’]" (regexp-quote string-target)))
+ (bracketed (format "\\[%s\\]\\|(%s)\\|\\<The[ \n]%s"
+ quoted quoted quoted)))
+ (or (let ((case-fold-search nil))
+ (or (re-search-forward bracketed nil t)
+ (and not-quoted
+ (let ((case-fold-search t))
+ (search-forward string-target nil t)))
+ (re-search-forward quoted nil t)
+ (search-forward string-target nil t)))
+ (let ((case-fold-search t))
+ (or (re-search-forward bracketed nil t)
+ (re-search-forward quoted nil t)
+ (search-forward string-target nil t)))))
(beginning-of-line)
(message "Found `%s' in %s" thing where)))
@@ -388,7 +386,7 @@ C-w Describe how there is no warranty for Calc."
(interactive)
(calc-quit)
(view-emacs-news)
- (re-search-forward "^\*+ .*\\<Calc\\>" nil t))
+ (re-search-forward "^\\*+ .*\\<Calc\\>" nil t))
(defvar calc-help-long-names '((?b . "binary/business")
(?g . "graphics")
@@ -402,11 +400,14 @@ C-w Describe how there is no warranty for Calc."
(princ "GNU Emacs Calculator.\n")
(princ " By Dave Gillespie.\n")
(princ (format " %s\n\n" emacs-copyright))
- (princ "Type `h s' for a more detailed summary.\n")
- (princ "Or type `h i' to read the full Calc manual on-line.\n\n")
+ (princ (format-message "Type `h s' for a more detailed summary.\n"))
+ (princ (format-message
+ "Or type `h i' to read the full Calc manual on-line.\n\n"))
(princ "Basic keys:\n")
(let* ((calc-full-help-flag t))
- (mapc (function (lambda (x) (princ (format " %s\n" x))))
+ (mapc (function (lambda (x) (princ (format
+ " %s\n"
+ (substitute-command-keys x)))))
(nreverse (cdr (reverse (cdr (calc-help))))))
(mapc (function (lambda (prefix)
(let ((msgs (condition-case err
@@ -415,9 +416,10 @@ C-w Describe how there is no warranty for Calc."
(if (car msgs)
(princ
(if (eq (nth 2 msgs) ?v)
- "\n`v' or `V' prefix (vector/matrix) keys: \n"
+ (format-message
+ "\n`v' or `V' prefix (vector/matrix) keys: \n")
(if (nth 2 msgs)
- (format
+ (format-message
"\n`%c' prefix (%s) keys:\n"
(nth 2 msgs)
(or (cdr (assq (nth 2 msgs)
@@ -425,8 +427,11 @@ C-w Describe how there is no warranty for Calc."
(nth 1 msgs)))
(format "\n%s-modified keys:\n"
(capitalize (nth 1 msgs)))))))
- (mapcar (function (lambda (x)
- (princ (format " %s\n" x))))
+ (mapcar (function
+ (lambda (x)
+ (princ (format
+ " %s\n"
+ (substitute-command-keys x)))))
(car msgs)))))
'(calc-inverse-prefix-help
calc-hyperbolic-prefix-help
@@ -541,7 +546,7 @@ C-w Describe how there is no warranty for Calc."
'("Select, Additional, Once; eVal, Formula; Rewrite"
"More, Less, 1-9, Next, Previous"
"Unselect, Clear; Display; Enable; Breakable"
- "' (replace), ` (edit), +, -, *, /, RET (grab), DEL"
+ "\\=' (replace), \\=` (edit), +, -, *, /, RET (grab), DEL"
"SHIFT + swap: Left, Right; maybe: Select, Once"
"SHIFT + Commute, Merge, Distrib, jump-Eqn, Isolate"
"SHIFT + Negate, & (invert); Unpack")
@@ -647,7 +652,7 @@ C-w Describe how there is no warranty for Calc."
(defun calc-u-prefix-help ()
(interactive)
(calc-do-prefix-help
- '("Simplify, Convert, Temperature-convert, Base-units"
+ '("Simplify, Convert, coNvert exact, Temperature-convert, Base-units"
"Autorange; Remove, eXtract; Explain; View-table; 0-9"
"Define, Undefine, Get-defn, Permanent"
"SHIFT + View-table-other-window"
diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el
index d86668ce328..b2856b99adc 100644
--- a/lisp/calc/calc-incom.el
+++ b/lisp/calc/calc-incom.el
@@ -1,6 +1,6 @@
;;; calc-incom.el --- complex data type input functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index bd24bf7f15d..18e900dc241 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -1,6 +1,6 @@
;;; calc-keypd.el --- mouse-capable keypad input for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 965cb65e8db..94366060a41 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -1,6 +1,6 @@
;;; calc-lang.el --- calc language functions
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -94,7 +94,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'c)
- (message "`C' language mode")))
+ (message "C language mode")))
(put 'c 'math-oper-table
'( ( "u!" calcFunc-lnot -1 1000 )
@@ -1211,7 +1211,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'yacas)
- (message "`Yacas' language mode")))
+ (message "Yacas language mode")))
(put 'yacas 'math-vector-brackets "{}")
@@ -1427,7 +1427,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'maxima)
- (message "`Maxima' language mode")))
+ (message "Maxima language mode")))
(put 'maxima 'math-oper-table
'(("+" + 100 100)
@@ -1625,7 +1625,7 @@
(interactive)
(calc-wrapper
(calc-set-language 'giac)
- (message "`Giac' language mode")))
+ (message "Giac language mode")))
(put 'giac 'math-oper-table
'( ( "[" (math-read-giac-subscr) 250 -1 )
@@ -1817,7 +1817,7 @@ order to Calc's."
(defun math-read-giac-subscr (x op)
(let ((idx (math-read-expr-level 0)))
(or (equal math-expr-data "]")
- (throw 'syntax "Expected ']'"))
+ (throw 'syntax "Expected `]'"))
(math-read-token)
(list 'calcFunc-subscr x (calc-normalize (list '+ idx 1)))))
@@ -1954,7 +1954,7 @@ order to Calc's."
(progn
(math-read-token)
(equal math-expr-data "]")))
- (throw 'syntax "Expected ']]'"))
+ (throw 'syntax "Expected `]]'"))
(math-read-token)
(list 'calcFunc-subscr x idx)))
@@ -2432,7 +2432,8 @@ order to Calc's."
(let ((y (math-read-big-rec h math-rb-v1 math-rb-h2
math-rb-v2 baseline nil t)))
(or (= (math-read-big-char math-read-big-h2 baseline) ?\:)
- (math-read-big-error math-read-big-h2 baseline "Expected `:'"))
+ (math-read-big-error math-read-big-h2 baseline
+ "Expected `:'"))
(setq p (list (nth 1 widest) p y
(math-read-big-rec
(1+ math-read-big-h2) math-rb-v1 math-rb-h2 math-rb-v2
@@ -2507,7 +2508,8 @@ order to Calc's."
(while (> count 0)
(if (>= h len)
(if what
- (math-read-big-error nil v (format "Unmatched `%s'" what))
+ (math-read-big-error nil v (format-message
+ "Unmatched `%s'" what))
(setq count 0))
(if (memq (aref line h) '(?\( ?\[))
(setq count (1+ count))
@@ -2523,8 +2525,4 @@ order to Calc's."
(provide 'calc-lang)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calc-lang.el ends here
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index 4b75f8d4ae8..9730d30a86b 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -1,6 +1,6 @@
;;; calc-macs.el --- important macros for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index cfc5a19701f..d2c9da86a6f 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -1,6 +1,6 @@
;;; calc-map.el --- higher-order functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -417,6 +417,7 @@
( ?G 1 calcFunc-vgmean )
( ?M 1 calcFunc-vmean )
( ?N 1 calcFunc-vmin )
+ ( ?R 1 calcFunc-rms )
( ?S 1 calcFunc-vsdev )
( ?X 1 calcFunc-vmax ) )
( ( ?C 2 calcFunc-vpcov )
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 3b845f563a1..e7d073a9c7a 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1,6 +1,6 @@
;;; calc-math.el --- mathematical functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index 5120528eaf4..8610090c5d1 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -1,6 +1,6 @@
;;; calc-menu.el --- a menu for Calc
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -863,6 +863,13 @@
:keys "I u M"
:active (>= (calc-stack-size) 1)
:help "The average (arithmetic mean) of the data values as an error form"]
+ ["rms(1:)"
+ (progn
+ (require 'calc-stat)
+ (call-interactively 'calc-vector-rms))
+ :keys "u R"
+ :active (>= (calc-stack-size) 1)
+ :help "The root mean square of the data values"]
["sdev(1:)"
(progn
(require 'calc-stat)
@@ -917,12 +924,13 @@
(call-interactively 'calc-vector-geometric-mean)))
:keys "H u G"
:active (>= (calc-stack-size) 1)]
- ["RMS(1:)"
- (progn (require 'calc-arith)
- (call-interactively 'calc-abs))
- :keys "A"
- :active (>= (calc-stack-size) 1)
- :help "The root-mean-square, or quadratic mean"])
+ ;; ["RMS(1:)"
+ ;; (progn (require 'calc-arith)
+ ;; (call-interactively 'calc-abs))
+ ;; :keys "A"
+ ;; :active (>= (calc-stack-size) 1)
+ ;; :help "The root-mean-square, or quadratic mean"]
+ )
["Abbreviate long vectors"
(progn
(require 'calc-mode)
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index 405131937f9..aa0ccb79edd 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -1,6 +1,6 @@
;;; calc-misc.el --- miscellaneous functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -89,7 +89,7 @@ For use with Embedded mode:
N calc-embedded-next. Advance cursor to next known formula in buffer.
P calc-embedded-previous. Advance cursor to previous known formula.
U calc-embedded-update-formula. Re-evaluate formula at point.
- ` calc-embedded-edit. Use calc-edit to edit formula at point.
+ \\=` calc-embedded-edit. Use calc-edit to edit formula at point.
Documentation:
I calc-info. Read the Calculator manual in the Emacs Info system.
@@ -225,7 +225,7 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
"Letter keys: SHIFT + Num-eval; More-recn; eXec-kbd-macro; Keep-args"
"Other keys: +, -, *, /, ^, \\ (int div), : (frac div)"
"Other keys: & (1/x), | (concat), % (modulo), ! (factorial)"
- "Other keys: ' (alg-entry), = (eval), ` (edit); M-RET (last-args)"
+ "Other keys: \\=' (alg-entry), = (eval), \\=` (edit); M-RET (last-args)"
"Other keys: SPC/RET (enter/dup), LFD (over); < > (scroll horiz)"
"Other keys: DEL (drop), M-DEL (drop-above); { } (scroll vert)"
"Other keys: TAB (swap/roll-dn), M-TAB (roll-up)"
@@ -253,11 +253,12 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
0))
(let ((msg (nth calc-help-phase msgs)))
(message "%s" (if msg
- (concat msg ":"
+ (concat (substitute-command-keys msg) ":"
(make-string (- (apply 'max
(mapcar 'length
msgs))
- (length msg)) 32)
+ (length msg))
+ ?\ )
" [?=MORE]")
""))))))))
@@ -952,7 +953,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
nil nil nil
"Please describe exactly what actions triggered the bug and the
precise symptoms of the bug. If possible, include a backtrace by
-doing 'M-x toggle-debug-on-error', then reproducing the bug.
+doing `\\[toggle-debug-on-error]', then reproducing the bug.
" )))
;;;###autoload
(defalias 'calc-report-bug 'report-calc-bug)
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index c46a2e5f21c..3ed9612f79a 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -1,6 +1,6 @@
;;; calc-mode.el --- calculator modes for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -258,7 +258,7 @@
(setq calc-display-raw (if calc-display-raw nil (if arg 0 t)))
(calc-do-refresh)
(if calc-display-raw
- (message "Press d ' again to cancel \"raw\" display mode"))))
+ (message "%s" "Press d ' again to cancel \"raw\" display mode"))))
@@ -410,7 +410,7 @@
((= n 4) 'global)
((= n 5) 'save)
(t 'local)))
- (message "%s"
+ (message "%s"
(cond ((and (eq calc-mode-save-mode 'local) calc-embedded-info)
"Recording mode changes with [calc-mode: ...]")
((eq calc-mode-save-mode 'edit)
@@ -446,11 +446,11 @@
(calc-change-mode '(calc-algebraic-mode calc-incomplete-algebraic-mode)
(list (not calc-algebraic-mode) nil)))
(use-local-map calc-mode-map)
- (message (if calc-algebraic-mode
- "Numeric keys and ( and [ begin algebraic entry"
- (if calc-incomplete-algebraic-mode
- "Only ( and [ begin algebraic entry"
- "No keys except ' and $ begin algebraic entry")))))
+ (message "%s" (if calc-algebraic-mode
+ "Numeric keys and ( and [ begin algebraic entry"
+ (if calc-incomplete-algebraic-mode
+ "Only ( and [ begin algebraic entry"
+ "No keys except ' and $ begin algebraic entry")))))
(defun calc-symbolic-mode (n)
(interactive "P")
@@ -478,7 +478,7 @@
(cond ((eq arg 0) 'scalar)
((< (prefix-numeric-value arg) 1)
(and (< (prefix-numeric-value arg) -1) 'matrix))
- (arg
+ (arg
(if (consp arg) 'sqmatrix
(prefix-numeric-value arg)))
((eq calc-matrix-mode 'matrix) 'scalar)
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index b3df0e3fde8..b8c5ff91093 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -1,6 +1,6 @@
;;; calc-mtx.el --- matrix functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index bd816c1e29c..8e0eb738682 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -1,6 +1,6 @@
;;; calc-nlfit.el --- nonlinear curve fitting for Calc
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index 07d725c88e7..1dab3c474aa 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -1,6 +1,6 @@
;;; calc-poly.el --- polynomial functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 4c4d090d7c9..8d97bc69a2d 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -1,6 +1,6 @@
;;; calc-prog.el --- user programmability functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -139,6 +139,7 @@
"calc-"))))
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) func)?
(if old
(setcdr old func)
(setcdr kmap (cons (cons key func) (cdr kmap))))))))
@@ -322,6 +323,7 @@
(if key
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) cmd)?
(if old
(setcdr old cmd)
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
@@ -467,6 +469,7 @@
(format "z%c" key)))))
(let* ((kmap (calc-user-key-map))
(old (assq key kmap)))
+ ;; FIXME: Why not (define-key kmap (vector key) func)?
(if old
(setcdr old cmd)
(setcdr kmap (cons (cons key cmd) (cdr kmap))))))))
@@ -594,9 +597,9 @@
",")
((equal name "#")
(search-backward "#")
- (error "Token '#' is reserved"))
+ (error "Token `#' is reserved"))
((and unquoted (string-match "#" name))
- (error "Tokens containing '#' must be quoted"))
+ (error "Tokens containing `#' must be quoted"))
((not (string-match "[^ ]" name))
(search-backward "\"" nil t)
(error "Blank tokens are not allowed"))
@@ -607,7 +610,7 @@
(quoted nil))
(while (progn
(skip-chars-forward "\n\t ")
- (if (eobp) (error "Expected '%s'" eterm))
+ (if (eobp) (error "Expected `%s'" eterm))
(not (looking-at term)))
(cond ((looking-at "%%")
(end-of-line))
@@ -615,7 +618,7 @@
(forward-char 2)
(let ((p (calc-read-parse-table-part "}" "}")))
(or (looking-at "[+*?]")
- (error "Expected '+', '*', or '?'"))
+ (error "Expected `+', `*', or `?'"))
(let ((sym (intern (buffer-substring (point) (1+ (point))))))
(forward-char 1)
(looking-at "[^\n\t ]*")
@@ -647,7 +650,7 @@
(match-end 1)))))))
(goto-char (match-end 0)))
((looking-at ":=[\n\t ]")
- (error "Misplaced ':='"))
+ (error "Misplaced `:='"))
(t
(looking-at "[^\n\t ]*")
(let ((end (match-end 0)))
@@ -1284,37 +1287,37 @@ Redefine the corresponding command."
(setq rpt-count (if rpt-count (prefix-numeric-value rpt-count) 1000000))
(let* ((count 0)
(parts nil)
- (body "")
+ (body (vector))
(open last-command-event)
(counter initial)
ch)
(or executing-kbd-macro
(message "Reading loop body..."))
(while (>= count 0)
- (setq ch (read-char))
- (if (= ch -1)
+ (setq ch (read-event))
+ (if (eq ch -1)
(error "Unterminated Z%c in keyboard macro" open))
- (if (= ch ?Z)
+ (if (eq ch ?Z)
(progn
- (setq ch (read-char)
- body (concat body "Z" (char-to-string ch)))
+ (setq ch (read-event)
+ body (vconcat body (vector ?Z ch)))
(cond ((memq ch '(?\< ?\( ?\{))
(setq count (1+ count)))
((memq ch '(?\> ?\) ?\}))
(setq count (1- count)))
((and (= ch ?/)
(= count 0))
- (setq parts (nconc parts (list (concat (substring body 0 -2)
- "Z]")))
+ (setq parts (nconc parts (list (vconcat (substring body 0 -2)
+ (vector ?Z ?\]) )))
body ""))
((eq ch 7)
(keyboard-quit))))
- (setq body (concat body (char-to-string ch)))))
+ (setq body (vconcat body (vector ch)))))
(if (/= ch (cdr (assq open '( (?\< . ?\>) (?\( . ?\)) (?\{ . ?\}) ))))
(error "Mismatched Z%c and Z%c in keyboard macro" open ch))
(or executing-kbd-macro
(message "Looping..."))
- (setq body (concat (substring body 0 -2) "Z]"))
+ (setq body (vconcat (substring body 0 -2) (vector ?Z ?\]) ))
(and (not executing-kbd-macro)
(= rpt-count 1000000)
(null parts)
@@ -1438,7 +1441,7 @@ Redefine the corresponding command."
(let ((calc-kbd-push-level 0))
(execute-kbd-macro (substring body 0 -2))))
(let ((calc-kbd-push-level (1+ calc-kbd-push-level)))
- (message "Saving modes; type Z' to restore")
+ (message "%s" "Saving modes; type Z' to restore")
(recursive-edit))))))
(defun calc-kbd-pop ()
@@ -1447,7 +1450,7 @@ Redefine the corresponding command."
(progn
(message "Mode settings restored")
(exit-recursive-edit))
- (error "Unbalanced Z' in keyboard macro")))
+ (error "%s" "Unbalanced Z' in keyboard macro")))
;; (defun calc-kbd-report (msg)
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 96c657285b9..e57a6b483c8 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -1,6 +1,6 @@
;;; calc-rewr.el --- rewriting functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index 8dedc257132..4489f66bf99 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -1,6 +1,6 @@
;;; calc-rules.el --- rules for simplifying algebraic expressions in Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index ad3c0cc6c3d..ec104ee3c53 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -1,6 +1,6 @@
;;; calc-sel.el --- data selection functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el
index db8f9d09cc5..a797db2e67d 100644
--- a/lisp/calc/calc-stat.el
+++ b/lisp/calc/calc-stat.el
@@ -1,6 +1,6 @@
;;; calc-stat.el --- statistical functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -71,6 +71,11 @@
(calc-vector-op "meae" 'calcFunc-vmeane arg)
(calc-vector-op "mean" 'calcFunc-vmean arg)))))
+(defun calc-vector-rms (arg)
+ (interactive "P")
+ (calc-slow-wrapper
+ (calc-vector-op "rms" 'calcFunc-rms arg)))
+
(defun calc-vector-mean-error (arg)
(interactive "P")
(calc-invert-func)
@@ -318,6 +323,12 @@
suminvsqrwts))
(math-div (calcFunc-reduce '(var add var-add) means) len)))))))
+(defun calcFunc-rms (a)
+ "Return the root-mean-square of the vector A."
+ (math-sqrt
+ (calcFunc-vmean
+ (calcFunc-map '(var abssqr var-abssqr) a))))
+
(defun math-fix-int-intv (x)
(if (math-floatp x)
x
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index e5274b21d8b..2684e627883 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -1,6 +1,6 @@
;;; calc-store.el --- value storage functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -58,8 +58,8 @@
(let ((msg
(calc-store-value var (or calc-given-value (calc-top 1))
"" calc-given-value-flag)))
- (message (concat "Stored to variable \"%s\"" msg)
- (calc-var-name var)))))
+ (message "Stored to variable \"%s\"%s"
+ (calc-var-name var) msg))))
(setq var (calc-is-assignments (calc-top 1)))
(if var
(while var
@@ -67,8 +67,8 @@
(calc-store-value (car (car var)) (cdr (car var))
(if (not (cdr var)) "")
(if (not (cdr var)) 1))))
- (message (concat "Stored to variable \"%s\"" msg)
- (calc-var-name (car (car var)))))
+ (message "Stored to variable \"%s\"%s"
+ (calc-var-name (car (car var))) msg))
(setq var (cdr var))))))))
(defun calc-store-plus (&optional var)
@@ -422,8 +422,8 @@
(calc-var-name var1)))))
(if var2
(let ((msg (calc-store-value var2 value "")))
- (message (concat "Variable \"%s\" copied to \"%s\"" msg)
- (calc-var-name var1) (calc-var-name var2))))))))
+ (message "Variable \"%s\" copied to \"%s\"%s"
+ (calc-var-name var1) (calc-var-name var2) msg)))))))
(defvar calc-last-edited-variable nil)
(defun calc-edit-variable (&optional var)
@@ -442,7 +442,8 @@
(setq calc-last-edited-variable var)
(calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
t
- (concat "Editing variable `" (calc-var-name var) "'. "))
+ (format-message
+ "Editing variable `%s'" (calc-var-name var)))
(and value
(insert (math-format-nice-expr value (frame-width)) "\n")))))
(calc-show-edit-buffer))
@@ -609,7 +610,8 @@
(defun calc-insert-permanent-variable (var)
(goto-char (point-min))
- (if (search-forward (concat "(setq " (symbol-name var) " '") nil t)
+ (if (let (case-fold-search)
+ (search-forward (concat "(setq " (symbol-name var) " '") nil t))
(progn
(setq calc-pv-pos (point-marker))
(forward-line -1)
@@ -675,8 +677,4 @@
(provide 'calc-store)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calc-store.el ends here
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 9535248c8f9..91ef259a109 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -1,6 +1,6 @@
;;; calc-stuff.el --- miscellaneous functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el
index 61824882446..9417f7f3fb6 100644
--- a/lisp/calc/calc-trail.el
+++ b/lisp/calc/calc-trail.el
@@ -1,6 +1,6 @@
;;; calc-trail.el --- functions for manipulating the Calc "trail"
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index cfae9b3e227..28c1679354c 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -1,6 +1,6 @@
;;; calc-undo.el --- undo functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 595d875eb6e..a450d8f82a9 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -1,6 +1,6 @@
;;; calc-units.el --- unit conversion functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -422,7 +422,7 @@ If EXPR is nil, return nil."
"Put the units in EXPR in the default units table.
If COMP or STD is non-nil, put that in the units table instead."
(let* ((new-units (or comp std (math-get-units expr)))
- (standard-units (math-get-standard-units
+ (standard-units (math-get-standard-units
(cond
(comp (math-simplify-units expr))
(std expr)
@@ -457,9 +457,9 @@ If COMP or STD is non-nil, put that in the units table instead."
(eq (math-get-standard-units expr) 1))))
(let ((uold (or old-units
(progn
- (setq uoldname
+ (setq uoldname
(if unitscancel
- (read-string
+ (read-string
"(The expression is unitless when simplified) Old Units: ")
(read-string "Old units: ")))
(if (equal uoldname "")
@@ -470,6 +470,8 @@ If COMP or STD is non-nil, put that in the units table instead."
(if (string-match "\\` */" uoldname)
(setq uoldname (concat "1" uoldname)))
(math-read-expr uoldname))))))
+ (unless (math-units-in-expr-p uold t)
+ (error "No units specified"))
(when (eq (car-safe uold) 'error)
(error "Bad format in units expression: %s" (nth 1 uold)))
(setq expr (math-mul expr uold))))
@@ -514,6 +516,38 @@ If COMP or STD is non-nil, put that in the units table instead."
(math-put-default-units (if noold units res) (if comp units)))
(calc-enter-result 1 "cvun" res))))))
+(defun calc-convert-exact-units ()
+ (interactive)
+ (calc-slow-wrapper
+ (let* ((expr (calc-top-n 1)))
+ (unless (math-units-in-expr-p expr t)
+ (error "No units in expression."))
+ (let* ((old-units (math-extract-units expr))
+ (defunits (math-get-default-units expr))
+ units
+ (new-units
+ (read-string (concat "New units"
+ (if defunits
+ (concat
+ " (default "
+ defunits
+ "): ")
+ ": ")))))
+ (if (and
+ (string= new-units "")
+ defunits)
+ (setq new-units defunits))
+ (setq units (math-read-expr new-units))
+ (when (eq (car-safe units) 'error)
+ (error "Bad format in units expression: %s" (nth 2 units)))
+ (math-check-unit-consistency old-units units)
+ (let ((res
+ (list '* (math-mul (math-remove-units expr)
+ (math-simplify-units
+ (math-to-standard-units (list '/ old-units units) nil)))
+ units)))
+ (calc-enter-result 1 "cvxu" res))))))
+
(defun calc-autorange-units (arg)
(interactive "P")
(calc-wrapper
@@ -904,10 +938,12 @@ If COMP or STD is non-nil, put that in the units table instead."
(and (consp expr)
(if (eq (car expr) 'var)
(math-check-unit-name expr)
- (and (or sub-exprs
- (memq (car expr) '(* / ^)))
- (or (math-units-in-expr-p (nth 1 expr) sub-exprs)
- (math-units-in-expr-p (nth 2 expr) sub-exprs))))))
+ (if (eq (car expr) 'neg)
+ (math-units-in-expr-p (nth 1 expr) sub-exprs)
+ (and (or sub-exprs
+ (memq (car expr) '(* / ^)))
+ (or (math-units-in-expr-p (nth 1 expr) sub-exprs)
+ (math-units-in-expr-p (nth 2 expr) sub-exprs)))))))
(defun math-only-units-in-expr-p (expr)
(and (consp expr)
@@ -924,6 +960,8 @@ If COMP or STD is non-nil, put that in the units table instead."
(cond ((math-scalarp expr) nil)
((eq (car expr) 'var)
(math-check-unit-name expr))
+ ((eq (car expr) 'neg)
+ (math-single-units-in-expr-p (nth 1 expr)))
((eq (car expr) '*)
(let ((u1 (math-single-units-in-expr-p (nth 1 expr)))
(u2 (math-single-units-in-expr-p (nth 2 expr))))
@@ -941,7 +979,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(or
(and (eq (car-safe newunits) 'var)
(assq (nth 1 newunits) math-standard-units-systems))
- (math-numberp (math-get-units (list '/ expr newunits)))))
+ (math-numberp (math-get-units (math-to-standard-units (list '/ expr newunits) nil)))))
(defun math-check-unit-consistency (expr units)
"Give an error if EXPR and UNITS do not have consistent units."
@@ -1079,6 +1117,8 @@ If COMP or STD is non-nil, put that in the units table instead."
((eq (car-safe expr) '/)
(or (math-find-compatible-unit-rec (nth 1 expr) pow)
(math-find-compatible-unit-rec (nth 2 expr) (- pow))))
+ ((eq (car-safe expr) 'neg)
+ (math-find-compatible-unit-rec (nth 1 expr) pow))
((and (eq (car-safe expr) '^)
(integerp (nth 2 expr)))
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr))))
@@ -1497,6 +1537,8 @@ If COMP or STD is non-nil, put that in the units table instead."
((memq (car-safe expr) '(* /))
(cons (car expr)
(mapcar 'math-extract-units (cdr expr))))
+ ((eq (car-safe expr) 'neg)
+ (math-extract-units (nth 1 expr)))
((eq (car-safe expr) '^)
(list '^ (math-extract-units (nth 1 expr)) (nth 2 expr)))
((math-check-unit-name expr) expr)
@@ -1579,11 +1621,14 @@ If COMP or STD is non-nil, put that in the units table instead."
(insert " " (nth 2 u) "\n")
(while (eq (car (car (setq uptr (cdr uptr)))) 0)))
(insert "\n\n")
- (insert "(**) When in TeX or LaTeX display mode, the TeX specific unit\n"
- "names will not use the `tex' prefix; the unit name for a\n"
- "TeX point will be `pt' instead of `texpt', for example.\n"
- "To avoid conflicts, the unit names for pint and parsec will\n"
- "be `pint' and `parsec' instead of `pt' and `pc'."))
+ (insert
+ (format-message
+ (concat
+ "(**) When in TeX or LaTeX display mode, the TeX specific unit\n"
+ "names will not use the `tex' prefix; the unit name for a\n"
+ "TeX point will be `pt' instead of `texpt', for example.\n"
+ "To avoid conflicts, the unit names for pint and parsec will\n"
+ "be `pint' and `parsec' instead of `pt' and `pc'."))))
(view-mode)
(message "Formatting units table...done"))
(setq math-units-table-buffer-valid t)
@@ -2118,8 +2163,4 @@ If non-nil, return a list consisting of the note and the cents coefficient."
(provide 'calc-units)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calc-units.el ends here
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 35ca41832dd..cd157703f49 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -1,6 +1,6 @@
;;; calc-vec.el --- vector functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -1107,7 +1107,7 @@
(cons 'vec (nreverse (sort (copy-sequence (cdr vec)) 'math-beforep)))
(math-reject-arg vec 'vectorp)))
-;; The variable math-grade-vec is local to calcFunc-grade and
+;; The variable math-grade-vec is local to calcFunc-grade and
;; calcFunc-rgrade, but is used by math-grade-beforep, which is called
;; by calcFunc-grade and calcFunc-rgrade.
(defvar math-grade-vec)
@@ -1149,7 +1149,7 @@
(setq bin (math-floor bin)))
(and (natnump bin)
(< bin n)
- (aset res bin
+ (aset res bin
(math-add (aref res bin)
(if wvec (car (setq wp (cdr wp))) wts)))))
(cons 'vec (append res nil))))
@@ -1167,7 +1167,7 @@
(while (and tbds (Math-lessp (car tbds) num))
(setq i (1+ i))
(setq tbds (cdr tbds)))
- (aset res i
+ (aset res i
(math-add (aref res i)
(if wvec (car (setq wp (cdr wp))) wts))))
(setq vp (cdr vp)))
@@ -1550,7 +1550,7 @@ of two matrices is a matrix."
;; indirectly) by math-read-brackets.
(defvar math-rb-close)
-;; The next few variables are local to math-read-exprs in calc-aent.el
+;; The next few variables are local to math-read-exprs in calc-aent.el
;; and math-read-expr in calc-ext.el, but are set in functions they call.
(defvar math-exp-pos)
(defvar math-exp-str)
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index d9807e70c92..5105ba9366c 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -1,6 +1,6 @@
;;; calc-yank.el --- kill-ring functionality for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -107,29 +107,131 @@
(interactive "r")
(calc-kill-region top bot t))
+(defun math-number-regexp (radix-num)
+ "Return a regexp which will match a Calc number base RADIX-NUM."
+ (let* ((digit-range
+ (cond
+ ;; radix 2 to 10
+ ((and (<= 2 radix-num)
+ (>= 10 radix-num))
+ (concat "[0-"
+ (number-to-string (1- radix-num))
+ "]"))
+ ;; radix 11
+ ((= 11 radix-num) "[0-9aA]")
+ ;; radix 12+
+ (t
+ (concat "[0-9"
+ "a-" (format "%c" (+ (- ?a 11) radix-num))
+ "A-" (format "%c" (+ (- ?A 11) radix-num))
+ "]"))))
+ (integer-regexp (concat digit-range "+"))
+ (decimal-regexp (concat digit-range "+\\." digit-range "*")))
+ (concat
+ " *\\("
+ ;; "e" notation
+ "[-_+]?" decimal-regexp "[eE][-+]?[0-9]+"
+ "\\|"
+ "[-_+]?" integer-regexp "[eE][-+]?[0-9]+"
+ "\\|"
+ ;; Integer+fractions
+ "[-_+]?" integer-regexp "*[:/]" integer-regexp "[:/]" integer-regexp
+ "\\|"
+ ;; Fractions
+ "[-_+]?" integer-regexp "[:/]" integer-regexp
+ "\\|"
+ ;; Decimal point
+ "[-_+]?" decimal-regexp
+ "\\|"
+ ;; Integers
+ "[-_+]?" integer-regexp
+ "\\) *\\(\n\\|\\'\\)")))
+
;; This function uses calc-last-kill if possible to get an exact result,
;; 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 ()
- (interactive)
+(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-wrapper
(calc-pop-push-record-list
0 "yank"
- (let ((thing (if (fboundp 'current-kill)
- (current-kill 0 t)
- (car kill-ring-yank-pointer))))
- (if (eq (car-safe calc-last-kill) thing)
- (cdr calc-last-kill)
- (if (stringp thing)
- (let ((val (math-read-exprs (calc-clean-newlines thing))))
- (if (eq (car-safe val) 'error)
- (progn
- (setq val (math-read-exprs thing))
- (if (eq (car-safe val) 'error)
- (error "Bad format in yanked data")
- val))
- val))))))))
+ (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)
+ (string-match-p "^[-(]*[0-9]\\{1,2\\}#" thing-raw))
+ thing-raw
+ (progn
+ (if (listp radix)
+ (progn
+ (setq radix-num
+ (read-number
+ "Set radix for yanked content (2-36): "))
+ (when (not (and (integerp radix-num)
+ (<= 2 radix-num)
+ (>= 36 radix-num)))
+ (error (concat "The radix has to be an "
+ "integer between 2 and 36."))))
+ (setq radix-num
+ (cond ((eq radix 2) 2)
+ ((eq radix 8) 8)
+ ((eq radix 0) 10)
+ ((eq radix 6) 16)
+ (t (message
+ (concat "No radix prepended "
+ "for invalid *numeric* "
+ "prefix %0d.")
+ radix)
+ nil))))
+ (if radix-num
+ (progn
+ (setq radix-notation
+ (concat (number-to-string radix-num) "#"))
+ (setq valid-num-regexp
+ (math-number-regexp radix-num))
+ ;; Ensure that the radix-notation is prefixed
+ ;; correctly even for multi-line yanks like below,
+ ;; 111
+ ;; 1111
+ (replace-regexp-in-string
+ valid-num-regexp
+ (concat radix-notation "\\&")
+ thing-raw))
+ thing-raw)))))
+ (if (eq (car-safe calc-last-kill) thing-raw)
+ (cdr calc-last-kill)
+ (if (stringp thing)
+ (let ((val (math-read-exprs (calc-clean-newlines thing))))
+ (if (eq (car-safe val) 'error)
+ (progn
+ (setq val (math-read-exprs thing))
+ (if (eq (car-safe val) 'error)
+ (error "Bad format in yanked data")
+ val))
+ val))))))))
;;; The Calc set- and get-register commands are modified versions of functions
;;; in register.el
@@ -143,16 +245,13 @@ TEXT and CALCVAL are the TEXT and internal structure of stack entries.")
"Set the contents of the Calc register REGISTER to (TEXT . CALCVAL),
as well as set the contents of the Emacs register REGISTER to TEXT."
(set-register register text)
- (let ((aelt (assq register calc-register-alist)))
- (if aelt
- (setcdr aelt (cons text calcval))
- (push (cons register (cons text calcval)) calc-register-alist))))
+ (setf (alist-get register calc-register-alist) (cons text calcval)))
(defun calc-get-register (reg)
"Return the CALCVAL portion of the contents of the Calc register REG,
unless the TEXT portion doesn't match the contents of the Emacs register REG,
in which case either return the contents of the Emacs register (if it is
-text) or `nil'."
+text) or nil."
(let ((cval (cdr (assq reg calc-register-alist)))
(val (cdr (assq reg register-alist))))
(if (stringp val)
@@ -163,8 +262,12 @@ text) or `nil'."
(defun calc-copy-to-register (register start end &optional delete-flag)
"Copy the lines in the region into register REGISTER.
-With prefix arg, delete as well."
- (interactive "cCopy to register: \nr\nP")
+With prefix arg, delete as well.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Copy to register: ")
+ (region-beginning) (region-end)
+ current-prefix-arg))
(if (eq major-mode 'calc-mode)
(let* ((top-num (calc-locate-cursor-element start))
(top-pos (save-excursion
@@ -183,8 +286,10 @@ With prefix arg, delete as well."
(copy-to-register register start end delete-flag)))
(defun calc-insert-register (register)
- "Insert the contents of register REGISTER."
- (interactive "cInsert register: ")
+ "Insert the contents of register REGISTER.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Insert register: ")))
(if (eq major-mode 'calc-mode)
(let ((val (calc-get-register register)))
(calc-wrapper
@@ -237,16 +342,24 @@ otherwise the end. If DELETE-FLAG is non-nil, also delete the region."
(defun calc-append-to-register (register start end &optional delete-flag)
"Copy the lines in the region to the end of register REGISTER.
-With prefix arg, also delete the region."
- (interactive "cAppend to register: \nr\nP")
+With prefix arg, also delete the region.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Append to register: ")
+ (region-beginning) (region-end)
+ current-prefix-arg))
(if (eq major-mode 'calc-mode)
(calc-add-to-register register start end nil delete-flag)
(append-to-register register start end delete-flag)))
(defun calc-prepend-to-register (register start end &optional delete-flag)
"Copy the lines in the region to the beginning of register REGISTER.
-With prefix arg, also delete the region."
- (interactive "cPrepend to register: \nr\nP")
+With prefix arg, also delete the region.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Prepend to register: ")
+ (region-beginning) (region-end)
+ current-prefix-arg))
(if (eq major-mode 'calc-mode)
(calc-add-to-register register start end t delete-flag)
(prepend-to-register register start end delete-flag)))
@@ -588,13 +701,13 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(add-hook 'kill-buffer-hook (lambda ()
(let ((calc-edit-handler nil))
(calc-edit-finish t))
- (message "(Cancelled)")) t t)
+ (message "(Canceled)")) t t)
(insert (propertize
(concat
(or title title "Calc Edit Mode. ")
- "Press `C-c C-c'"
+ (format-message "Press `C-c C-c'")
(if allow-ret "" " or RET")
- " to finish, `C-x k RET' to cancel.\n\n")
+ (format-message " to finish, `C-x k RET' to cancel.\n\n"))
'font-lock-face 'italic 'read-only t 'rear-nonsticky t 'front-sticky t))
(make-local-variable 'calc-edit-top)
(setq calc-edit-top (point))))
@@ -669,7 +782,7 @@ To cancel the edit, simply kill the *Calc Edit* buffer."
(interactive)
(let ((calc-edit-handler nil))
(calc-edit-finish))
- (message "(Cancelled)"))
+ (message "(Canceled)"))
(defun calc-finish-stack-edit (num)
(let ((buf (current-buffer))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 2eeb880c34d..e44226d8702 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,6 +1,6 @@
;;; calc.el --- the GNU Emacs calculator
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -146,13 +146,15 @@
(declare-function calc-set-language "calc-lang" (lang &optional option no-refresh))
(declare-function calc-edit-finish "calc-yank" (&optional keep))
(declare-function calc-edit-cancel "calc-yank" ())
-(declare-function calc-do-quick-calc "calc-aent" ())
+(declare-function calc-locate-cursor-element "calc-yank" (pt))
+(declare-function calc-do-quick-calc "calc-aent" (&optional insert))
(declare-function calc-do-calc-eval "calc-aent" (str separator args))
(declare-function calc-do-keypad "calc-keypd" (&optional full-display interactive))
(declare-function calcFunc-unixtime "calc-forms" (date &optional zone))
(declare-function math-parse-date "calc-forms" (math-pd-str))
(declare-function math-lessp "calc-ext" (a b))
(declare-function math-compare "calc-ext" (a b))
+(declare-function math-zerop "calc-misc" (a))
(declare-function calc-embedded-finish-command "calc-embed" ())
(declare-function calc-embedded-select-buffer "calc-embed" ())
(declare-function calc-embedded-mode-line-change "calc-embed" ())
@@ -426,6 +428,14 @@ when converting units."
:version "24.3"
:type 'boolean)
+(defcustom calc-context-sensitive-enter
+ nil
+ "If non-nil, the stack element under the cursor will be copied by `calc-enter'
+and deleted by `calc-pop'."
+ :group 'calc
+ :version "24.4"
+ :type 'boolean)
+
(defcustom calc-undo-length
100
"The number of undo steps that will be preserved when Calc is quit."
@@ -726,7 +736,7 @@ If hms, angles are in degrees-minutes-seconds.")
(defcalcmodevar calc-algebraic-mode nil
"If non-nil, numeric entry accepts whole algebraic expressions.
-If nil, algebraic expressions must be preceded by \"'\".")
+If nil, algebraic expressions must be preceded by \"\\='\".")
(defcalcmodevar calc-incomplete-algebraic-mode nil
"Like calc-algebraic-mode except only affects ( and [ keys.")
@@ -979,11 +989,11 @@ Used by `calc-user-invocation'.")
(defvar calc-last-kill nil
"The last number killed in calc-mode.")
(defvar calc-dollar-values nil
- "Values to be used for '$'.")
+ "Values to be used for `$'.")
(defvar calc-dollar-used nil
- "The highest order of '$' that occurred.")
+ "The highest order of `$' that occurred.")
(defvar calc-hashes-used nil
- "The highest order of '#' that occurred.")
+ "The highest order of `#' that occurred.")
(defvar calc-quick-prev-results nil
"Previous results from Quick Calc.")
(defvar calc-said-hello nil
@@ -1095,20 +1105,18 @@ Used by `calc-user-invocation'.")
"The key map for entering Calc digits.")
(mapc (lambda (x)
- (condition-case err
- (progn
- (define-key calc-digit-map x 'calcDigit-backspace)
- (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))
- (error nil)))
+ (ignore-errors
+ (define-key calc-digit-map x 'calcDigit-backspace)
+ (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-backward-char global-map)
(where-is-internal 'backward-delete-char global-map)
@@ -1179,25 +1187,24 @@ Used by `calc-user-invocation'.")
;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch)
;;;###autoload
-(defun calc-dispatch (&optional arg)
+(defun calc-dispatch (&optional _arg)
"Invoke the GNU Emacs Calculator. See \\[calc-dispatch-help] for details."
- (interactive "P")
+ (interactive)
; (sit-for echo-keystrokes)
- (condition-case err ; look for other keys bound to calc-dispatch
- (let ((keys (this-command-keys)))
- (unless (or (not (stringp keys))
- (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys)
- (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface))
- (when (and (string-match "\\`[\C-@-\C-_]" keys)
- (symbolp
- (lookup-key calc-dispatch-map (substring keys 0 1))))
- (define-key calc-dispatch-map (substring keys 0 1) nil))
- (define-key calc-dispatch-map keys 'calc-same-interface)))
- (error nil))
- (calc-do-dispatch arg))
+ (ignore-errors ; look for other keys bound to calc-dispatch
+ (let ((keys (this-command-keys)))
+ (unless (or (not (stringp keys))
+ (string-match "\\`\C-u\\|\\`\e[-0-9#]\\|`[\M--\M-0-\M-9]" keys)
+ (eq (lookup-key calc-dispatch-map keys) 'calc-same-interface))
+ (when (and (string-match "\\`[\C-@-\C-_]" keys)
+ (symbolp
+ (lookup-key calc-dispatch-map (substring keys 0 1))))
+ (define-key calc-dispatch-map (substring keys 0 1) nil))
+ (define-key calc-dispatch-map keys 'calc-same-interface))))
+ (calc-do-dispatch))
(defvar calc-dispatch-help nil)
-(defun calc-do-dispatch (arg)
+(defun calc-do-dispatch (&optional _arg)
"Start the Calculator."
(let ((key (calc-read-key-sequence
(if calc-dispatch-help
@@ -1215,8 +1222,7 @@ Used by `calc-user-invocation'.")
(defun calc-read-key-sequence (prompt map)
"Read keys, with prompt PROMPT and keymap MAP."
- (let ((prompt2 (format "%s " (key-description (this-command-keys))))
- (glob (current-global-map))
+ (let ((glob (current-global-map))
(loc (current-local-map)))
(or (input-pending-p) (message "%s" prompt))
(let ((key (calc-read-key t))
@@ -1244,7 +1250,6 @@ embedded information from the appropriate buffers and tidy up
the trail buffer."
(let ((cb (current-buffer))
(info-list nil)
- (buflist)
; (plural nil)
(cea calc-embedded-active))
;; Get a list of all buffers using this buffer for
@@ -1301,7 +1306,7 @@ This is an RPN calculator featuring arbitrary-precision integer, rational,
floating-point, complex, matrix, and symbolic arithmetic.
RPN calculation: 2 RET 3 + produces 5.
-Algebraic style: ' 2+3 RET produces 5.
+Algebraic style: \\=' 2+3 RET produces 5.
Basic operators are +, -, *, /, ^, & (reciprocal), % (modulo), n (change-sign).
@@ -1320,7 +1325,7 @@ Notations: 3.14e6 3.14 * 10^6
[1 .. 4) semi-open interval, 1 <= x < 4
2 +/- 3 (p key) number with mean 2, standard deviation 3
2 mod 3 (M key) number 2 computed modulo 3
- <1 jan 91> Date form (enter using ' key)
+ <1 jan 91> Date form (enter using \\=' key)
\\{calc-mode-map}
@@ -1387,7 +1392,12 @@ Notations: 3.14e6 3.14 * 10^6
(calc-check-defines))
(setplist 'calc-define nil)))))
-(defun calc-trail-mode (&optional buf)
+(defvar calc-trail-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map calc-mode-map)
+ map))
+
+(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
obtained by the GNU Emacs Calculator.
@@ -1397,26 +1407,18 @@ the Trail.
This buffer uses the same key map as the *Calculator* buffer; calculator
commands given here will actually operate on the *Calculator* stack."
- (interactive)
- (fundamental-mode)
- (use-local-map calc-mode-map)
- (setq major-mode 'calc-trail-mode)
- (setq mode-name "Calc Trail")
(setq truncate-lines t)
(setq buffer-read-only t)
(make-local-variable 'overlay-arrow-position)
(make-local-variable 'overlay-arrow-string)
- (when buf
- (set (make-local-variable 'calc-main-buffer) buf))
(when (= (buffer-size) 0)
(let ((buffer-read-only nil))
- (insert (propertize "Emacs Calculator Trail\n" 'face 'italic))))
- (run-mode-hooks 'calc-trail-mode-hook))
+ (insert (propertize "Emacs Calculator Trail\n" 'face 'italic)))))
(defun calc-create-buffer ()
"Create and initialize a buffer for the Calculator."
(set-buffer (get-buffer-create "*Calculator*"))
- (or (eq major-mode 'calc-mode)
+ (or (derived-mode-p 'calc-mode)
(calc-mode))
(setq max-lisp-eval-depth (max max-lisp-eval-depth 1000))
(when calc-always-load-extensions
@@ -1439,44 +1441,43 @@ commands given here will actually operate on the *Calculator* stack."
(when (get-buffer-window "*Calc Keypad*")
(calc-keypad)
(set-buffer (window-buffer)))
- (if (eq major-mode 'calc-mode)
+ (if (derived-mode-p 'calc-mode)
(calc-quit)
- (let ((oldbuf (current-buffer)))
- (calc-create-buffer)
- (setq calc-was-keypad-mode nil)
- (if (or (eq full-display t)
- (and (null full-display) calc-full-mode))
- (switch-to-buffer (current-buffer) t)
- (if (get-buffer-window (current-buffer))
- (select-window (get-buffer-window (current-buffer)))
- (if calc-window-hook
- (run-hooks 'calc-window-hook)
- (let ((w (get-largest-window)))
- (if (and pop-up-windows
- (> (window-height w)
- (+ window-min-height calc-window-height 2)))
- (progn
- (setq w (split-window w
- (- (window-height w)
- calc-window-height 2)
- nil))
- (set-window-buffer w (current-buffer))
- (select-window w))
- (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))
- (calc-check-defines)
- (when (and calc-said-hello interactive)
- (sit-for 2)
- (message ""))
- (setq calc-said-hello t)))))
+ (calc-create-buffer)
+ (setq calc-was-keypad-mode nil)
+ (if (or (eq full-display t)
+ (and (null full-display) calc-full-mode))
+ (switch-to-buffer (current-buffer) t)
+ (if (get-buffer-window (current-buffer))
+ (select-window (get-buffer-window (current-buffer)))
+ (if calc-window-hook
+ (run-hooks 'calc-window-hook)
+ (let ((w (get-largest-window)))
+ (if (and pop-up-windows
+ (> (window-height w)
+ (+ window-min-height calc-window-height 2)))
+ (progn
+ (setq w (split-window w
+ (- (window-height w)
+ calc-window-height 2)
+ nil))
+ (set-window-buffer w (current-buffer))
+ (select-window w))
+ (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))
+ (calc-check-defines)
+ (when (and calc-said-hello interactive)
+ (sit-for 2)
+ (message ""))
+ (setq calc-said-hello t))))
;;;###autoload
(defun full-calc (&optional interactive)
@@ -1490,7 +1491,7 @@ commands given here will actually operate on the *Calculator* stack."
(if (and (equal (buffer-name) "*Gnuplot Trail*")
(> (recursion-depth) 0))
(exit-recursive-edit)
- (if (eq major-mode 'calc-edit-mode)
+ (if (derived-mode-p 'calc-edit-mode)
(calc-edit-finish arg)
(if calc-was-keypad-mode
(calc-keypad)
@@ -1504,13 +1505,13 @@ commands given here will actually operate on the *Calculator* stack."
(if (and (equal (buffer-name) "*Gnuplot Trail*")
(> (recursion-depth) 0))
(exit-recursive-edit))
- (if (eq major-mode 'calc-edit-mode)
+ (if (derived-mode-p 'calc-edit-mode)
(calc-edit-cancel)
(if (and interactive
calc-embedded-info
(eq (current-buffer) (aref calc-embedded-info 0)))
(calc-embedded nil)
- (unless (eq major-mode 'calc-mode)
+ (unless (derived-mode-p 'calc-mode)
(calc-create-buffer))
(run-hooks 'calc-end-hook)
(if (integerp calc-undo-length)
@@ -1543,10 +1544,12 @@ commands given here will actually operate on the *Calculator* stack."
(and kbuf (bury-buffer kbuf))))))
;;;###autoload
-(defun quick-calc ()
- "Do a quick calculation in the minibuffer without invoking full Calculator."
- (interactive)
- (calc-do-quick-calc))
+(defun quick-calc (&optional insert)
+ "Do a quick calculation in the minibuffer without invoking full Calculator.
+With prefix argument INSERT, insert the result in the current
+buffer. Otherwise, the result is copied into the kill ring."
+ (interactive "P")
+ (calc-do-quick-calc insert))
;;;###autoload
(defun calc-eval (str &optional separator &rest args)
@@ -1631,10 +1634,10 @@ See calc-keypad for details."
(if (math-lessp 1 time)
(calc-record time "(t)"))))
(or (memq 'no-align calc-command-flags)
- (eq major-mode 'calc-trail-mode)
+ (derived-mode-p 'calc-trail-mode)
(calc-align-stack-window))
(and (memq 'position-point calc-command-flags)
- (if (eq major-mode 'calc-mode)
+ (if (derived-mode-p 'calc-mode)
(progn
(goto-char (point-min))
(forward-line (1- calc-final-point-line))
@@ -1664,7 +1667,7 @@ See calc-keypad for details."
(setq calc-command-flags (cons f calc-command-flags))))
(defun calc-select-buffer ()
- (or (eq major-mode 'calc-mode)
+ (or (derived-mode-p 'calc-mode)
(if calc-main-buffer
(set-buffer calc-main-buffer)
(let ((buf (get-buffer "*Calculator*")))
@@ -1801,7 +1804,7 @@ See calc-keypad for details."
(and calc-embedded-info (calc-embedded-mode-line-change))))))
(defun calc-align-stack-window ()
- (if (eq major-mode 'calc-mode)
+ (if (derived-mode-p 'calc-mode)
(progn
(let ((win (get-buffer-window (current-buffer))))
(if win
@@ -1988,11 +1991,11 @@ See calc-keypad for details."
(defvar calc-any-evaltos nil)
(defun calc-refresh (&optional align)
(interactive)
- (and (eq major-mode 'calc-mode)
+ (and (derived-mode-p 'calc-mode)
(not calc-executing-macro)
- (let* ((buffer-read-only nil)
+ (let* ((inhibit-read-only t)
(save-point (point))
- (save-mark (condition-case err (mark) (error nil)))
+ (save-mark (ignore-errors (mark)))
(save-aligned (looking-at "\\.$"))
(thing calc-stack)
(calc-any-evaltos nil))
@@ -2016,7 +2019,7 @@ See calc-keypad for details."
(calc-align-stack-window)
(goto-char save-point))
(if save-mark (set-mark save-mark))))
- (and calc-embedded-info (not (eq major-mode 'calc-mode))
+ (and calc-embedded-info (not (derived-mode-p 'calc-mode))
(with-current-buffer (aref calc-embedded-info 1)
(calc-refresh align)))
(setq calc-refresh-count (1+ calc-refresh-count)))
@@ -2025,7 +2028,7 @@ See calc-keypad for details."
;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed.
(defcustom calc-gregorian-switch nil
"The first day the Gregorian calendar is used by Calc's date forms.
-This is `nil' (the default) if the Gregorian calendar is the only one used.
+This is nil (the default) if the Gregorian calendar is the only one used.
Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use
the Gregorian calendar; Calc will use the Julian calendar for earlier dates.
The dates in which different regions of the world began to use the
@@ -2078,12 +2081,13 @@ the United States."
(null (buffer-name calc-trail-buffer)))
(save-excursion
(setq calc-trail-buffer (get-buffer-create "*Calc Trail*"))
- (let ((buf (or (and (not (eq major-mode 'calc-mode))
+ (let ((buf (or (and (not (derived-mode-p 'calc-mode))
(get-buffer "*Calculator*"))
(current-buffer))))
(set-buffer calc-trail-buffer)
- (or (eq major-mode 'calc-trail-mode)
- (calc-trail-mode buf)))))
+ (unless (derived-mode-p 'calc-trail-mode)
+ (calc-trail-mode)
+ (set (make-local-variable 'calc-main-buffer) buf)))))
(or (and calc-trail-pointer
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(with-current-buffer calc-trail-buffer
@@ -2092,11 +2096,12 @@ the United States."
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
+(defvar calc-can-abbrev-vectors)
+
(defun calc-record (val &optional prefix)
(setq calc-aborted-prefix nil)
(or calc-executing-macro
- (let* ((mainbuf (current-buffer))
- (buf (calc-trail-buffer))
+ (let* ((buf (calc-trail-buffer))
(calc-display-raw nil)
(calc-can-abbrev-vectors t)
(fval (if val
@@ -2152,7 +2157,7 @@ the United States."
(defun calc-trail-here ()
(interactive)
- (if (eq major-mode 'calc-trail-mode)
+ (if (derived-mode-p 'calc-trail-mode)
(progn
(beginning-of-line)
(if (bobp)
@@ -2253,44 +2258,60 @@ the United States."
(defun calc-enter (n)
(interactive "p")
- (calc-wrapper
- (cond ((< n 0)
- (calc-push-list (calc-top-list 1 (- n))))
- ((= n 0)
- (calc-push-list (calc-top-list (calc-stack-size))))
- (t
- (calc-push-list (calc-top-list n))))))
-
+ (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point))))))
+ (calc-wrapper
+ (cond ((< n 0)
+ (calc-push-list (calc-top-list 1 (- n))))
+ ((= n 0)
+ (calc-push-list (calc-top-list (calc-stack-size))))
+ (num
+ (calc-push-list (calc-top-list n num)))
+ (t
+ (calc-push-list (calc-top-list n)))))
+ (if (and calc-context-sensitive-enter (> n 0)) (calc-cursor-stack-index (+ num n)))))
(defun calc-pop (n)
(interactive "P")
- (calc-wrapper
- (let* ((nn (prefix-numeric-value n))
- (top (and (null n) (calc-top 1))))
- (cond ((and (null n)
- (eq (car-safe top) 'incomplete)
- (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
- (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
- (setcdr (nthcdr (- (length tt) 2) tt) nil)
- (list tt))))
- ((< nn 0)
- (if (and calc-any-selections
- (calc-top-selected 1 (- nn)))
- (calc-delete-selection (- nn))
- (calc-pop-stack 1 (- nn) t)))
- ((= nn 0)
- (calc-pop-stack (calc-stack-size) 1 t))
- (t
- (if (and calc-any-selections
- (= nn 1)
- (calc-top-selected 1 1))
- (calc-delete-selection 1)
- (calc-pop-stack nn)))))))
+ (let ((num (if calc-context-sensitive-enter (max 1 (calc-locate-cursor-element (point))))))
+ (calc-wrapper
+ (let* ((nn (prefix-numeric-value n))
+ (top (and (null n) (calc-top 1))))
+ (cond ((and calc-context-sensitive-enter (> num 1))
+ (calc-pop-stack nn num))
+ ((and (null n)
+ (eq (car-safe top) 'incomplete)
+ (> (length top) (if (eq (nth 1 top) 'intv) 3 2)))
+ (calc-pop-push-list 1 (let ((tt (copy-sequence top)))
+ (setcdr (nthcdr (- (length tt) 2) tt) nil)
+ (list tt))))
+ ((< nn 0)
+ (if (and calc-any-selections
+ (calc-top-selected 1 (- nn)))
+ (calc-delete-selection (- nn))
+ (calc-pop-stack 1 (- nn) t)))
+ ((= nn 0)
+ (calc-pop-stack (calc-stack-size) 1 t))
+ (t
+ (if (and calc-any-selections
+ (= nn 1)
+ (calc-top-selected 1 1))
+ (calc-delete-selection 1)
+ (calc-pop-stack nn))))))
+ (if calc-context-sensitive-enter (calc-cursor-stack-index (1- num)))))
+
;;;; Reading a number using the minibuffer.
+(defun calc-digit-start-entry ()
+ (cond ((eq last-command-event ?e)
+ (if (> calc-number-radix 14) (format "%d.^" calc-number-radix) "1e"))
+ ((eq last-command-event ?#) (format "%d#" calc-number-radix))
+ ((eq last-command-event ?_) "-")
+ ((eq last-command-event ?@) "0@ ")
+ (t (char-to-string last-command-event))))
+
(defvar calc-buffer)
(defvar calc-prev-char)
(defvar calc-prev-prev-char)
@@ -2301,7 +2322,6 @@ the United States."
(if (or calc-algebraic-mode
(and (> calc-number-radix 14) (eq last-command-event ?e)))
(calc-alg-digit-entry)
- (calc-unread-command)
(setq calc-aborted-prefix nil)
(let* ((calc-digit-value nil)
(calc-prev-char nil)
@@ -2319,7 +2339,8 @@ the United States."
(unwind-protect
(progn
(define-key global-map "\e" nil)
- (read-from-minibuffer "Calc: " "" calc-digit-map))
+ (read-from-minibuffer
+ "Calc: " (calc-digit-start-entry) calc-digit-map))
(define-key global-map "\e" old-esc))))))
(or calc-digit-value (setq calc-digit-value (math-read-number buf)))
(if (stringp calc-digit-value)
@@ -2758,9 +2779,18 @@ largest Emacs integer.")
;; Coerce integer A to be a bignum. [B S]
(defun math-bignum (a)
- (if (>= a 0)
- (cons 'bigpos (math-bignum-big a))
- (cons 'bigneg (math-bignum-big (- a)))))
+ (cond
+ ((>= a 0)
+ (cons 'bigpos (math-bignum-big a)))
+ ((= a most-negative-fixnum)
+ ;; Note: cannot get the negation directly because
+ ;; (- most-negative-fixnum) is most-negative-fixnum.
+ ;;
+ ;; most-negative-fixnum := -most-positive-fixnum - 1
+ (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum))
+ 1))
+ (t
+ (cons 'bigneg (math-bignum-big (- a))))))
(defun math-bignum-big (a) ; [L s]
(if (= a 0)
@@ -3017,7 +3047,7 @@ largest Emacs integer.")
(defun math-sub-bignum (a b) ; [l l l]
(if b
(if a
- (let* ((a (copy-sequence a)) (aa a) (borrow nil) sum diff)
+ (let* ((a (copy-sequence a)) (aa a) (borrow nil) diff)
(while (and aa b)
(if borrow
(if (>= (setq diff (- (car aa) (car b))) 1)
@@ -3171,7 +3201,8 @@ largest Emacs integer.")
aa a)
(while (progn
(setcar ss (% (setq prod (+ (+ (car ss) (* (car aa) d))
- c)) math-bignum-digit-size))
+ c))
+ math-bignum-digit-size))
(setq aa (cdr aa)))
(setq c (/ prod math-bignum-digit-size)
ss (or (cdr ss) (setcdr ss (list 0)))))
@@ -3406,6 +3437,10 @@ largest Emacs integer.")
;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy
;; in calccomp.el.
+(defvar math-svo-c)
+(defvar math-svo-wid)
+(defvar math-svo-off)
+
(defun math-stack-value-offset (math-svo-c)
(let* ((num (if calc-line-numbering 4 0))
(math-svo-wid (calc-window-width))
@@ -3891,8 +3926,4 @@ See Info node `(calc)Defining Functions'."
(provide 'calc)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calc.el ends here
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index cd962e7dbed..55064a35528 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -1,6 +1,6 @@
;;; calcalg2.el --- more algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index 564edc66f23..957f12064bd 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -1,6 +1,6 @@
;;; calcalg3.el --- more algebraic functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 2aa971628b4..119f41993c3 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -1,6 +1,6 @@
;;; calccomp.el --- composition functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -1670,8 +1670,4 @@
(provide 'calccomp)
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; calccomp.el ends here
diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el
index f299e6a8b73..ace26847963 100644
--- a/lisp/calc/calcsel2.el
+++ b/lisp/calc/calcsel2.el
@@ -1,6 +1,6 @@
;;; calcsel2.el --- selection functions for Calc
-;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
diff --git a/lisp/calculator.el b/lisp/calculator.el
index c9a73054712..80b7c070f1f 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1,6 +1,6 @@
-;;; calculator.el --- a [not so] simple calculator for Emacs
+;;; calculator.el --- a calculator for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Eli Barzilay <eli@barzilay.org>
;; Keywords: tools, convenience
@@ -33,15 +33,8 @@
;; "Run the Emacs calculator." t)
;; (global-set-key [(control return)] 'calculator)
;;
-;; Written by Eli Barzilay: Maze is Life! eli@barzilay.org
-;; http://www.barzilay.org/
+;; Written by Eli Barzilay, eli@barzilay.org
;;
-;; For latest version, check
-;; http://www.barzilay.org/misc/calculator.el
-;;
-
-;;; History:
-;; I hate history.
;;;=====================================================================
;;; Customization:
@@ -79,7 +72,7 @@ This determines the default behavior of unary operators."
(defcustom calculator-prompt "Calc=%s> "
"The prompt used by the Emacs calculator.
-It should contain a \"%s\" somewhere that will indicate the i/o radices;
+It should contain a \"%s\" somewhere that will indicate the i/o radixes;
this will be a two-character string as described in the documentation
for `calculator-mode'."
:type 'string
@@ -115,8 +108,8 @@ See `calculator-radix-grouping-mode'."
(defcustom calculator-remove-zeros t
"Non-nil value means delete all redundant zero decimal digits.
-If this value is not t, and not nil, redundant zeros are removed except
-for one and if it is nil, nothing is removed.
+If this value is not t and not nil, redundant zeros are removed except
+for one.
Used by the `calculator-remove-zeros' function."
:type '(choice (const t) (const leave-decimal) (const nil))
:group 'calculator)
@@ -131,27 +124,32 @@ The displayer is a symbol, a string or an expression. A symbol should
be the name of a one-argument function, a string is used with a single
argument and an expression will be evaluated with the variable `num'
bound to whatever should be displayed. If it is a function symbol, it
-should be able to handle special symbol arguments, currently 'left and
-'right which will be sent by special keys to modify display parameters
+should be able to handle special symbol arguments, currently `left' and
+`right' which will be sent by special keys to modify display parameters
associated with the displayer function (for example to change the number
of digits displayed).
-An exception to the above is the case of the list (std C) where C is a
-character, in this case the `calculator-standard-displayer' function
-will be used with this character for a format string."
+An exception to the above is the case of the list (std C [G]) where C is
+a character and G is an optional boolean, in this case the
+`calculator-standard-displayer' function will be used with these as
+arguments."
+ :type '(choice (function) (string) (sexp)
+ (list (const std) character)
+ (list (const std) character boolean))
:group 'calculator)
(defcustom calculator-displayers
'(((std ?n) "Standard display, decimal point or scientific")
(calculator-eng-display "Eng display")
- ((std ?f) "Standard display, decimal point")
+ ((std ?f t) "Standard display, decimal point with grouping")
((std ?e) "Standard display, scientific")
("%S" "Emacs printer"))
"A list of displayers.
Each element is a list of a displayer and a description string. The
-first element is the one which is currently used, this is for the display
-of result values not values in expressions. A displayer specification
-is the same as the values that can be stored in `calculator-displayer'.
+first element is the one which is currently used, this is for the
+display of result values not values in expressions. A displayer
+specification is the same as the values that can be stored in
+`calculator-displayer'.
`calculator-rotate-displayer' rotates this list."
:type 'sexp
@@ -181,7 +179,7 @@ Otherwise show as a negative number."
(defcustom calculator-mode-hook nil
"List of hook functions for `calculator-mode' to run.
Note: if `calculator-electric-mode' is on, then this hook will get
-activated in the minibuffer - in that case it should not do much more
+activated in the minibuffer -- in that case it should not do much more
than local key settings and other effects that will change things
outside the scope of calculator related code."
:type 'hook
@@ -193,7 +191,7 @@ Each element in this list is a list of a character and a number that
will be stored in that character's register.
For example, use this to define the golden ratio number:
- (setq calculator-user-registers '((?g . 1.61803398875)))
+ (setq calculator-user-registers \\='((?g . 1.61803398875)))
before you load calculator."
:type '(repeat (cons character number))
:set (lambda (_ val)
@@ -216,22 +214,21 @@ Examples:
t as a prefix key:
(setq calculator-user-operators
- '((\"tf\" cl-to-fr (+ 32 (/ (* X 9) 5)) 1)
+ \\='((\"tf\" cl-to-fr (+ 32 (/ (* X 9) 5)) 1)
(\"tc\" fr-to-cl (/ (* (- X 32) 5) 9) 1)
(\"tp\" kg-to-lb (/ X 0.453592) 1)
(\"tk\" lb-to-kg (* X 0.453592) 1)
(\"tF\" mt-to-ft (/ X 0.3048) 1)
(\"tM\" ft-to-mt (* X 0.3048) 1)))
-* Using a function-like form is very simple, X for an argument (Y the
- second in case of a binary operator), TX is a truncated version of X
- and F does a recursive call, Here is a [very inefficient] Fibonacci
- number calculation:
+* Using a function-like form is very simple: use `X' for the argument
+ (`Y' for the second in case of a binary operator), `TX' is a truncated
+ version of `X' and `F' for a recursive call. Here is a [very
+ inefficient] Fibonacci number calculation:
- (add-to-list 'calculator-user-operators
- '(\"F\" fib (if (<= TX 1)
- 1
- (+ (F (- TX 1)) (F (- TX 2)))) 0))
+ (add-to-list \\='calculator-user-operators
+ \\='(\"F\" fib
+ (if (<= TX 1) 1 (+ (F (- TX 1)) (F (- TX 2))))))
Note that this will be either postfix or prefix, according to
`calculator-unary-style'."
@@ -241,11 +238,13 @@ Examples:
;;;=====================================================================
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
;;;---------------------------------------------------------------------
;;; Variables
(defvar calculator-initial-operators
- '(;; "+"/"-" have keybindings of themselves, not calculator-ops
+ '(;; "+"/"-" have keybindings of their own, not calculator-ops
("=" = identity 1 -1)
(nobind "+" + + 2 4)
(nobind "-" - - 2 4)
@@ -300,26 +299,27 @@ user-defined operators, use `calculator-user-operators' instead.")
versions), `DX' (converted to radians if degrees mode is on), `D'
(function for converting radians to degrees if deg mode is on), `L'
(list of saved values), `F' (function for recursive iteration calls)
- and evaluates to the function value - these variables are capital;
+ and evaluates to the function value -- these variables are capital;
4. The function's arity, optional, one of: 2 => binary, -1 => prefix
- unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number =>
- postfix/prefix as determined by `calculator-unary-style' (the
- default);
+ unary, +1 => postfix unary, 0 => a 0-arg operator func (note that
+ using such a function replaces the currently entered number, if any),
+ non-number (the default) => postfix or prefix as determined by
+ `calculator-unary-style';
-5. The function's precedence - should be in the range of 1 (lowest) to
+5. The function's precedence -- should be in the range of 1 (lowest) to
9 (highest) (optional, defaults to 1);
It it possible have a unary prefix version of a binary operator if it
-comes later in this list. If the list begins with the symbol 'nobind,
-then no key binding will take place - this is only useful for predefined
-keys.
+comes later in this list. If the list begins with the symbol `nobind',
+then no key binding will take place -- this is only useful for
+predefined keys.
Use `calculator-user-operators' to add operators to this list, see its
documentation for an example.")
(defvar calculator-stack nil
- "Stack contents - operations and operands.")
+ "Stack contents -- operations and operands.")
(defvar calculator-curnum nil
"Current number being entered (as a string).")
@@ -424,9 +424,9 @@ Used for repeating operations in calculator-repR/L.")
(calculator-backspace [backspace])
)))
(while p
- ;; reverse the keys so first defs come last - makes the more
- ;; sensible bindings visible in the menu
- (let ((func (car (car p))) (keys (reverse (cdr (car p)))))
+ ;; reverse the keys so earlier definitions come last -- makes
+ ;; the more sensible bindings visible in the menu
+ (let ((func (caar p)) (keys (reverse (cdar p))))
(while keys
(define-key map (car keys) func)
(setq keys (cdr keys))))
@@ -438,7 +438,7 @@ Used for repeating operations in calculator-repR/L.")
;; make C-h work in text-mode
(or window-system (define-key map [?\C-h] 'calculator-backspace))
;; set up a menu
- (if (and calculator-use-menu (not (boundp 'calculator-menu)))
+ (when (and calculator-use-menu (not (boundp 'calculator-menu)))
(let ((radix-selectors
(mapcar (lambda (x)
`([,(nth 0 x)
@@ -577,7 +577,7 @@ Used for repeating operations in calculator-repR/L.")
"A [not so] simple calculator for Emacs.
This calculator is used in the same way as other popular calculators
-like xcalc or calc.exe - but using an Emacs interface.
+like xcalc or calc.exe -- but using an Emacs interface.
Expressions are entered using normal infix notation, parens are used as
normal. Unary functions are usually postfix, but some depends on the
@@ -586,8 +586,7 @@ specified, then it is fixed, otherwise it depends on this variable).
`+' and `-' can be used as either binary operators or prefix unary
operators. Numbers can be entered with exponential notation using `e',
except when using a non-decimal radix mode for input (in this case `e'
-will be the hexadecimal digit). If the result of a calculation is too
-large (out of range for Emacs), the value of \"inf\" is returned.
+will be the hexadecimal digit).
Here are the editing keys:
* `RET' `=' evaluate the current expression
@@ -606,8 +605,8 @@ These operators are pre-defined:
* `_' `;' postfix unary negation and reciprocal
* `^' `L' binary operators for x^y and log(x) in base y
* `Q' `!' unary square root and factorial
-* `S' `C' `T' unary trigonometric operators - sin, cos and tan
-* `|' `#' `&' `~' bitwise operators - or, xor, and, not
+* `S' `C' `T' unary trigonometric operators: sin, cos and tan
+* `|' `#' `&' `~' bitwise operators: or, xor, and, not
The trigonometric functions can be inverted if prefixed with an `I', see
below for the way to use degrees instead of the default radians.
@@ -633,9 +632,9 @@ The prompt indicates the current modes:
Also, the quote key can be used to switch display modes for decimal
numbers (double-quote rotates back), and the two brace characters
-\(\"{\" and \"}\" change display parameters that these displayers use (if
-they handle such). If output is using any radix mode, then these keys
-toggle digit grouping mode and the chunk size.
+\(\"{\" and \"}\" change display parameters that these displayers use,
+if they handle such). If output is using any radix mode, then these
+keys toggle digit grouping mode and the chunk size.
Values can be saved for future reference in either a list of saved
values, or in registers.
@@ -677,19 +676,21 @@ more information.
"Run the Emacs calculator.
See the documentation for `calculator-mode' for more information."
(interactive)
- (if calculator-restart-other-mode
+ (when calculator-restart-other-mode
(setq calculator-electric-mode (not calculator-electric-mode)))
- (if calculator-initial-operators
- (progn (calculator-add-operators calculator-initial-operators)
- (setq calculator-initial-operators nil)
- ;; don't change this since it is a customization variable,
- ;; its set function will add any new operators
- (calculator-add-operators calculator-user-operators)))
+ (when calculator-initial-operators
+ (calculator-add-operators calculator-initial-operators)
+ (setq calculator-initial-operators nil)
+ ;; don't change this since it is a customization variable,
+ ;; its set function will add any new operators
+ (calculator-add-operators calculator-user-operators))
(setq calculator-buffer (get-buffer-create "*calculator*"))
(if calculator-electric-mode
(save-window-excursion
- (progn (require 'electric) (message nil)) ; hide load message
- (let (old-g-map old-l-map (echo-keystrokes 0)
+ (require 'electric) (message nil) ; hide load message
+ (let (old-g-map old-l-map
+ (old-buf (window-buffer (minibuffer-window)))
+ (echo-keystrokes 0)
(garbage-collection-messages nil)) ; no gc msg when electric
(set-window-buffer (minibuffer-window) calculator-buffer)
(select-window (minibuffer-window))
@@ -709,8 +710,8 @@ See the documentation for `calculator-mode' for more information."
(lambda () 'noprompt)
nil
(lambda (_x _y) (calculator-update-display))))
- (and calculator-buffer
- (catch 'calculator-done (calculator-quit)))
+ (set-window-buffer (minibuffer-window) old-buf)
+ (kill-buffer calculator-buffer)
(use-local-map old-l-map)
(use-global-map old-g-map))))
(progn
@@ -719,45 +720,8 @@ See the documentation for `calculator-mode' for more information."
(let ((window-min-height 2))
;; maybe leave two lines for our window because of the
;; normal `raised' mode line
- (select-window
- (split-window-below
- ;; If the mode line might interfere with the calculator
- ;; buffer, use 3 lines instead.
- (if (and (fboundp 'face-attr-construct)
- (let* ((dh (plist-get (face-attr-construct 'default) :height))
- (mf (face-attr-construct 'mode-line))
- (mh (plist-get mf :height)))
- ;; If the mode line is shorter than the default,
- ;; stick with 2 lines. (It may be necessary to
- ;; check how much shorter.)
- (and
- (not
- (or (and (integerp dh)
- (integerp mh)
- (< mh dh))
- (and (numberp mh)
- (not (integerp mh))
- (< mh 1))))
- (or
- ;; If the mode line is taller than the default,
- ;; use 3 lines.
- (and (integerp dh)
- (integerp mh)
- (> mh dh))
- (and (numberp mh)
- (not (integerp mh))
- (> mh 1))
- ;; If the mode line has a box with non-negative line-width,
- ;; use 3 lines.
- (let* ((bx (plist-get mf :box))
- (lh (plist-get bx :line-width)))
- (and bx
- (or
- (not lh)
- (> lh 0))))
- ;; If the mode line has an overline, use 3 lines.
- (plist-get (face-attr-construct 'mode-line) :overline)))))
- -3 -2)))
+ (select-window (split-window-below
+ (if (calculator-need-3-lines) -3 -2)))
(switch-to-buffer calculator-buffer)))
((not (eq (current-buffer) calculator-buffer))
(select-window (get-buffer-window calculator-buffer))))
@@ -765,24 +729,46 @@ See the documentation for `calculator-mode' for more information."
(setq buffer-read-only t)
(calculator-reset)
(message "Hit `?' For a quick help screen.")))
- (if (and calculator-restart-other-mode calculator-electric-mode)
+ (when (and calculator-restart-other-mode calculator-electric-mode)
(calculator)))
+(defun calculator-need-3-lines ()
+ ;; If the mode line might interfere with the calculator buffer, use 3
+ ;; lines instead.
+ (let* ((dh (face-attribute 'default :height))
+ (mh (face-attribute 'mode-line :height)))
+ ;; if the mode line is shorter than the default, stick with 2 lines
+ ;; (it may be necessary to check how much shorter)
+ (and (not (or (and (integerp dh) (integerp mh) (< mh dh))
+ (and (numberp mh) (not (integerp mh)) (< mh 1))))
+ (or ;; if the mode line is taller than the default, use 3 lines
+ (and (integerp dh) (integerp mh) (> mh dh))
+ (and (numberp mh) (not (integerp mh)) (> mh 1))
+ ;; if the mode line has a box with non-negative line-width,
+ ;; use 3 lines
+ (let* ((bx (face-attribute 'mode-line :box))
+ (lh (plist-get bx :line-width)))
+ (and bx (or (not lh) (> lh 0))))
+ ;; if the mode line has an overline, use 3 lines
+ (not (memq (face-attribute 'mode-line :overline)
+ '(nil unspecified)))))))
+
(defun calculator-message (string &rest arguments)
- "Same as `message', but special handle of electric mode."
+ "Same as `message', but also handle electric mode."
(apply 'message string arguments)
- (if calculator-electric-mode
- (progn (sit-for 1) (message nil))))
+ (when calculator-electric-mode (sit-for 1) (message nil)))
;;;---------------------------------------------------------------------
;;; Operators
(defun calculator-op-arity (op)
- "Return OP's arity, 2, +1 or -1."
- (let ((arity (or (nth 3 op) 'x)))
- (if (numberp arity)
- arity
- (if (eq calculator-unary-style 'postfix) +1 -1))))
+ "Return OP's arity.
+Current results are one of 2 (binary), +1 (postfix), -1 (prefix), or
+0 (nullary)."
+ (let ((arity (nth 3 op)))
+ (cond ((numberp arity) arity)
+ ((eq calculator-unary-style 'postfix) +1)
+ (t -1))))
(defun calculator-op-prec (op)
"Return OP's precedence for reducing when inserting into the stack.
@@ -795,8 +781,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle
`calculator-initial-operators' and `calculator-user-operators'."
(let ((added-ops nil))
(while more-ops
- (or (eq (car (car more-ops)) 'nobind)
- (let ((i -1) (key (car (car more-ops))))
+ (or (eq (caar more-ops) 'nobind)
+ (let ((i -1) (key (caar more-ops)))
;; make sure the key is undefined, so it's easy to define
;; prefix keys
(while (< (setq i (1+ i)) (length key))
@@ -808,8 +794,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle
calculator-mode-map (substring key 0 (1+ i)) nil)
(setq i (length key)))))
(define-key calculator-mode-map key 'calculator-op)))
- (setq added-ops (cons (if (eq (car (car more-ops)) 'nobind)
- (cdr (car more-ops))
+ (setq added-ops (cons (if (eq (caar more-ops) 'nobind)
+ (cdar more-ops)
(car more-ops))
added-ops))
(setq more-ops (cdr more-ops)))
@@ -830,50 +816,37 @@ Adds MORE-OPS to `calculator-operator', called initially to handle
(setq calculator-restart-other-mode nil)
(calculator-update-display))
-(defun calculator-get-prompt ()
+(defun calculator-get-display ()
"Return a string to display.
-The string is set not to exceed the screen width."
- (let* ((calculator-prompt
- (format calculator-prompt
+The result should not exceed the screen width."
+ (let* ((in-r (and calculator-input-radix
+ (char-to-string
+ (car (rassq calculator-input-radix
+ calculator-char-radix)))))
+ (out-r (and calculator-output-radix
+ (char-to-string
+ (car (rassq calculator-output-radix
+ calculator-char-radix)))))
+ (prompt (format calculator-prompt
+ (cond ((or in-r out-r)
+ (concat (or in-r "=")
+ (if (equal in-r out-r) "="
+ (or out-r "="))))
+ (calculator-deg "D=")
+ (t "=="))))
+ (expr
+ (concat (cdr calculator-stack-display)
(cond
- ((or calculator-output-radix calculator-input-radix)
- (if (eq calculator-output-radix
- calculator-input-radix)
- (concat
- (char-to-string
- (car (rassq calculator-output-radix
- calculator-char-radix)))
- "=")
- (concat
- (if calculator-input-radix
- (char-to-string
- (car (rassq calculator-input-radix
- calculator-char-radix)))
- "=")
- (char-to-string
- (car (rassq calculator-output-radix
- calculator-char-radix))))))
- (calculator-deg "D=")
- (t "=="))))
- (prompt
- (concat calculator-prompt
- (cdr calculator-stack-display)
- (cond (calculator-curnum
- ;; number being typed
- (concat calculator-curnum "_"))
- ((and (= 1 (length calculator-stack))
- calculator-display-fragile)
- ;; only the result is shown, next number will
- ;; restart
- nil)
- (t
- ;; waiting for a number or an operator
- "?"))))
- (trim (- (length prompt) (1- (window-width)))))
- (if (<= trim 0)
- prompt
- (concat calculator-prompt
- (substring prompt (+ trim (length calculator-prompt)))))))
+ ;; entering a number
+ (calculator-curnum (concat calculator-curnum "_"))
+ ;; showing a result
+ ((and (= 1 (length calculator-stack))
+ calculator-display-fragile)
+ nil)
+ ;; waiting for a number or an operator
+ (t "?"))))
+ (trim (+ (length expr) (length prompt) 1 (- (window-width)))))
+ (concat prompt (if (<= trim 0) expr (substring expr trim)))))
(defun calculator-string-to-number (str)
"Convert the given STR to a number, according to the value of
@@ -899,7 +872,7 @@ The string is set not to exceed the screen width."
"Warning: Ignoring bad input character `%c'." ch)
(sit-for 1)
value))))
- (if (if (< new-value 0) (> value 0) (< value 0))
+ (when (if (< new-value 0) (> value 0) (< value 0))
(calculator-message "Warning: Overflow in input."))
(setq value new-value))
value)
@@ -913,9 +886,12 @@ The string is set not to exceed the screen width."
((stringp str) (concat str ".0"))
(t "0.0"))))))
-(defun calculator-curnum-value ()
- "Get the numeric value of the displayed number string as a float."
- (calculator-string-to-number calculator-curnum))
+(defun calculator-push-curnum ()
+ "Push the numeric value of the displayed number to the stack."
+ (when calculator-curnum
+ (push (calculator-string-to-number calculator-curnum)
+ calculator-stack)
+ (setq calculator-curnum nil)))
(defun calculator-rotate-displayer (&optional new-disp)
"Switch to the next displayer on the `calculator-displayers' list.
@@ -953,7 +929,7 @@ If radix output mode is active, toggle digit grouping."
(calculator-rotate-displayer (car (last calculator-displayers))))
(defun calculator-displayer-prev ()
- "Send the current displayer function a 'left argument.
+ "Send the current displayer function a `left' argument.
This is used to modify display arguments (if the current displayer
function supports this).
If radix output mode is active, increase the grouping size."
@@ -964,13 +940,12 @@ If radix output mode is active, increase the grouping size."
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
- (cond
- ((symbolp disp) (funcall disp 'left))
- ((and (consp disp) (eq 'std (car disp)))
- (calculator-standard-displayer 'left (cadr disp))))))))
+ (cond ((symbolp disp) (funcall disp 'left))
+ ((and (consp disp) (eq 'std (car disp)))
+ (calculator-standard-displayer 'left)))))))
(defun calculator-displayer-next ()
- "Send the current displayer function a 'right argument.
+ "Send the current displayer function a `right' argument.
This is used to modify display arguments (if the current displayer
function supports this).
If radix output mode is active, decrease the grouping size."
@@ -981,44 +956,51 @@ If radix output mode is active, decrease the grouping size."
(calculator-enter))
(and (car calculator-displayers)
(let ((disp (caar calculator-displayers)))
- (cond
- ((symbolp disp) (funcall disp 'right))
- ((and (consp disp) (eq 'std (car disp)))
- (calculator-standard-displayer 'right (cadr disp))))))))
+ (cond ((symbolp disp) (funcall disp 'right))
+ ((and (consp disp) (eq 'std (car disp)))
+ (calculator-standard-displayer 'right)))))))
(defun calculator-remove-zeros (numstr)
"Get a number string NUMSTR and remove unnecessary zeros.
The behavior of this function is controlled by
`calculator-remove-zeros'."
- (cond ((and (eq calculator-remove-zeros t)
- (string-match "\\.0+\\([eE][+-]?[0-9]*\\)?$" numstr))
- ;; remove all redundant zeros leaving an integer
- (if (match-beginning 1)
- (concat (substring numstr 0 (match-beginning 0))
- (match-string 1 numstr))
- (substring numstr 0 (match-beginning 0))))
- ((and calculator-remove-zeros
- (string-match
- "\\..\\([0-9]*[1-9]\\)?\\(0+\\)\\([eE][+-]?[0-9]*\\)?$"
- numstr))
- ;; remove zeros, except for first after the "."
- (if (match-beginning 3)
- (concat (substring numstr 0 (match-beginning 2))
- (match-string 3 numstr))
- (substring numstr 0 (match-beginning 2))))
- (t numstr)))
-
-(defun calculator-standard-displayer (num char)
+ (let* ((s (if (not (eq calculator-remove-zeros t)) numstr
+ ;; remove all redundant zeros leaving an integer
+ (replace-regexp-in-string
+ "\\.0+\\([eE].*\\)?$" "\\1" numstr)))
+ (s (if (not calculator-remove-zeros) s
+ ;; remove zeros, except for first after the "."
+ (replace-regexp-in-string
+ "\\(\\..[0-9]*?\\)0+\\([eE].*\\)?$" "\\1\\2" s))))
+ s))
+
+(defun calculator-groupize-number (str n sep &optional fromleft)
+ "Return the input string STR with occurrences of SEP that separate
+every N characters starting from the right, or from the left if
+FROMLEFT is true."
+ (let* ((len (length str)) (i (/ len n)) (j (% len n))
+ (r (if (or (not fromleft) (= j 0)) '()
+ (list (substring str (- len j))))))
+ (while (> i 0)
+ (let* ((e (* i n)) (e (if fromleft e (+ e j))))
+ (push (substring str (- e n) e) r))
+ (setq i (1- i)))
+ (when (and (not fromleft) (> j 0))
+ (push (substring str 0 j) r))
+ (mapconcat 'identity r sep)))
+
+(defun calculator-standard-displayer (num &optional char group-p)
"Standard display function, used to display NUM.
Its behavior is determined by `calculator-number-digits' and the given
CHAR argument (both will be used to compose a format string). If the
char is \"n\" then this function will choose one between %f or %e, this
is a work around %g jumping to exponential notation too fast.
-The special 'left and 'right symbols will make it change the current
-number of digits displayed (`calculator-number-digits').
+It will also split digit sequences into comma-separated groups
+and/or remove redundant zeros.
-It will also remove redundant zeros from the result."
+The special `left' and `right' symbols will make it change the current
+number of digits displayed (`calculator-number-digits')."
(if (symbolp num)
(cond ((eq num 'left)
(and (> calculator-number-digits 0)
@@ -1029,56 +1011,51 @@ It will also remove redundant zeros from the result."
(setq calculator-number-digits
(1+ calculator-number-digits))
(calculator-enter)))
- (let ((str (if (zerop num)
- "0"
- (format
- (concat "%."
- (number-to-string calculator-number-digits)
- (if (eq char ?n)
- (let ((n (abs num)))
- (if (or (< n 0.001) (> n 1e8)) "e" "f"))
- (string char)))
- num))))
- (calculator-remove-zeros str))))
+ (let* ((s (if (eq char ?n)
+ (let ((n (abs num)))
+ (if (or (and (< 0 n) (< n 0.001)) (< 1e8 n)) ?e ?f))
+ char))
+ (s (format "%%.%s%c" calculator-number-digits s))
+ (s (calculator-remove-zeros (format s num)))
+ (s (if (or (not group-p) (string-match-p "[eE]" s)) s
+ (replace-regexp-in-string
+ "\\([0-9]+\\)\\(?:\\..*\\|$\\)"
+ (lambda (_) (calculator-groupize-number
+ (match-string 1 s) 3 ","))
+ s nil nil 1))))
+ s)))
(defun calculator-eng-display (num)
"Display NUM in engineering notation.
The number of decimal digits used is controlled by
`calculator-number-digits', so to change it at runtime you have to use
-the 'left or 'right when one of the standard modes is used."
+the `left' or `right' when one of the standard modes is used."
(if (symbolp num)
(cond ((eq num 'left)
(setq calculator-eng-extra
- (if calculator-eng-extra
- (1+ calculator-eng-extra)
- 1))
+ (if calculator-eng-extra (1+ calculator-eng-extra) 1))
(let ((calculator-eng-tmp-show t)) (calculator-enter)))
((eq num 'right)
(setq calculator-eng-extra
- (if calculator-eng-extra
- (1- calculator-eng-extra)
- -1))
+ (if calculator-eng-extra (1- calculator-eng-extra) -1))
(let ((calculator-eng-tmp-show t)) (calculator-enter))))
(let ((exp 0))
- (and (not (= 0 num))
- (progn
- (while (< (abs num) 1.0)
- (setq num (* num 1000.0)) (setq exp (- exp 3)))
- (while (> (abs num) 999.0)
- (setq num (/ num 1000.0)) (setq exp (+ exp 3)))
- (and calculator-eng-tmp-show
- (not (= 0 calculator-eng-extra))
- (let ((i calculator-eng-extra))
- (while (> i 0)
- (setq num (* num 1000.0)) (setq exp (- exp 3))
- (setq i (1- i)))
- (while (< i 0)
- (setq num (/ num 1000.0)) (setq exp (+ exp 3))
- (setq i (1+ i)))))))
+ (unless (= 0 num)
+ (while (< (abs num) 1.0)
+ (setq num (* num 1000.0)) (setq exp (- exp 3)))
+ (while (> (abs num) 999.0)
+ (setq num (/ num 1000.0)) (setq exp (+ exp 3)))
+ (when (and calculator-eng-tmp-show
+ (not (= 0 calculator-eng-extra)))
+ (let ((i calculator-eng-extra))
+ (while (> i 0)
+ (setq num (* num 1000.0)) (setq exp (- exp 3))
+ (setq i (1- i)))
+ (while (< i 0)
+ (setq num (/ num 1000.0)) (setq exp (+ exp 3))
+ (setq i (1+ i))))))
(or calculator-eng-tmp-show (setq calculator-eng-extra nil))
- (let ((str (format (concat "%." (number-to-string
- calculator-number-digits)
- "f")
+ (let ((str (format (format "%%.%sf" calculator-number-digits)
num)))
(concat (let ((calculator-remove-zeros
;; make sure we don't leave integers
@@ -1089,57 +1066,48 @@ the 'left or 'right when one of the standard modes is used."
(defun calculator-number-to-string (num)
"Convert NUM to a displayable string."
(cond
- ((and (numberp num) calculator-output-radix)
- ;; print with radix - for binary I convert the octal number
- (let ((str (format (if (eq calculator-output-radix 'hex) "%x" "%o")
- (calculator-truncate
- (if calculator-2s-complement num (abs num))))))
- (if (eq calculator-output-radix 'bin)
- (let ((i -1) (s ""))
- (while (< (setq i (1+ i)) (length str))
- (setq s
- (concat s
- (cdr (assq (aref str i)
- '((?0 . "000") (?1 . "001")
- (?2 . "010") (?3 . "011")
- (?4 . "100") (?5 . "101")
- (?6 . "110") (?7 . "111")))))))
- (string-match "^0*\\(.+\\)" s)
- (setq str (match-string 1 s))))
- (if calculator-radix-grouping-mode
- (let ((d (/ (length str) calculator-radix-grouping-digits))
- (r (% (length str) calculator-radix-grouping-digits)))
- (while (>= (setq d (1- d)) (if (zerop r) 1 0))
- (let ((i (+ r (* d calculator-radix-grouping-digits))))
- (setq str (concat (substring str 0 i)
- calculator-radix-grouping-separator
- (substring str i)))))))
- (upcase
- (if (and (not calculator-2s-complement) (< num 0))
- (concat "-" str)
- str))))
- ((and (numberp num) calculator-displayer)
- (cond
- ((stringp calculator-displayer)
- (format calculator-displayer num))
- ((symbolp calculator-displayer)
- (funcall calculator-displayer num))
- ((and (consp calculator-displayer)
- (eq 'std (car calculator-displayer)))
- (calculator-standard-displayer num (cadr calculator-displayer)))
- ((listp calculator-displayer)
- (eval calculator-displayer))
- (t (prin1-to-string num t))))
- ;; operators are printed here
- (t (prin1-to-string (nth 1 num) t))))
+ ;; operators are printed here, the rest is for numbers
+ ((not (numberp num)) (prin1-to-string (nth 1 num) t))
+ ;; %f/%e handle these, but avoid them in radix or in user displayers
+ ((and (floatp num) (isnan num)) "NaN")
+ ((<= 1.0e+INF num) "Inf")
+ ((<= num -1.0e+INF) "-Inf")
+ (calculator-output-radix
+ ;; print with radix -- for binary, convert the octal number
+ (let* ((fmt (if (eq calculator-output-radix 'hex) "%x" "%o"))
+ (str (if calculator-2s-complement num (abs num)))
+ (str (format fmt (calculator-truncate str)))
+ (bins '((?0 "000") (?1 "001") (?2 "010") (?3 "011")
+ (?4 "100") (?5 "101") (?6 "110") (?7 "111")))
+ (str (if (not (eq calculator-output-radix 'bin)) str
+ (replace-regexp-in-string
+ "^0+\\(.\\)" "\\1"
+ (apply 'concat (mapcar (lambda (c)
+ (cadr (assq c bins)))
+ str)))))
+ (str (if (not calculator-radix-grouping-mode) str
+ (calculator-groupize-number
+ str calculator-radix-grouping-digits
+ calculator-radix-grouping-separator))))
+ (upcase (if (or calculator-2s-complement (>= num 0)) str
+ (concat "-" str)))))
+ ((stringp calculator-displayer) (format calculator-displayer num))
+ ((symbolp calculator-displayer) (funcall calculator-displayer num))
+ ((eq 'std (car-safe calculator-displayer))
+ (apply 'calculator-standard-displayer
+ num (cdr calculator-displayer)))
+ ((listp calculator-displayer)
+ (eval `(let ((num ',num)) ,calculator-displayer) t))
+ ;; nil (or bad) displayer
+ (t (prin1-to-string num t))))
(defun calculator-update-display (&optional force)
"Update the display.
If optional argument FORCE is non-nil, don't use the cached string."
(set-buffer calculator-buffer)
;; update calculator-stack-display
- (if (or force
- (not (eq (car calculator-stack-display) calculator-stack)))
+ (when (or force (not (eq (car calculator-stack-display)
+ calculator-stack)))
(setq calculator-stack-display
(cons calculator-stack
(if calculator-stack
@@ -1156,9 +1124,15 @@ If optional argument FORCE is non-nil, don't use the cached string."
" "
(and calculator-display-fragile
calculator-saved-list
- (= (car calculator-stack)
- (nth calculator-saved-ptr
- calculator-saved-list))
+ ;; Hack: use `eq' to compare the number: it's a
+ ;; flonum, so `eq' means that its the actual
+ ;; number rather than a computation that had an
+ ;; equal result (eg, enter 1,3,2, use "v" to see
+ ;; the average -- it now shows "2" instead of
+ ;; "2 [3]").
+ (eq (car calculator-stack)
+ (nth calculator-saved-ptr
+ calculator-saved-list))
(if (= 0 calculator-saved-ptr)
(format "[%s]" (length calculator-saved-list))
(format "[%s/%s]"
@@ -1168,170 +1142,99 @@ If optional argument FORCE is non-nil, don't use the cached string."
""))))
(let ((inhibit-read-only t))
(erase-buffer)
- (insert (calculator-get-prompt)))
+ (insert (calculator-get-display)))
(set-buffer-modified-p nil)
- (if calculator-display-fragile
- (goto-char (1+ (length calculator-prompt)))
- (goto-char (1- (point)))))
+ (goto-char (if calculator-display-fragile
+ (1+ (length calculator-prompt))
+ (1- (point)))))
;;;---------------------------------------------------------------------
;;; Stack computations
+(defun calculator-reduce-stack-once (prec)
+ "Worker for `calculator-reduce-stack'."
+ (cl-flet ((check (ar op) (and (listp op)
+ (<= prec (calculator-op-prec op))
+ (= ar (calculator-op-arity op))))
+ (call (op &rest args) (apply 'calculator-funcall
+ (nth 2 op) args)))
+ (pcase calculator-stack
+ ;; reduce "... ( x )" --> "... x"
+ (`((,_ \) . ,_) ,(and X (pred numberp)) (,_ \( . ,_) . ,rest)
+ (cons X rest))
+ ;; reduce "... x op y" --> "... r", r is the result
+ (`(,(and Y (pred numberp))
+ ,(and O (pred (check 2)))
+ ,(and X (pred numberp))
+ . ,rest)
+ (cons (call O X Y) rest))
+ ;; reduce "... op x" --> "... r" for prefix op
+ (`(,(and X (pred numberp)) ,(and O (pred (check -1))) . ,rest)
+ (cons (call O X) rest))
+ ;; reduce "... x op" --> "... r" for postfix op
+ (`(,(and O (pred (check +1))) ,(and X (pred numberp)) . ,rest)
+ (cons (call O X) rest))
+ ;; reduce "... op" --> "... r" for 0-ary op
+ (`(,(and O (pred (check 0))) . ,rest)
+ (cons (call O) rest))
+ ;; reduce "... y x" --> "... x"
+ ;; (needed for 0-ary ops: replace current number with result)
+ (`(,(and X (pred numberp)) ,(and _Y (pred numberp)) . ,rest)
+ (cons X rest))
+ (_ nil)))) ; nil = done
+
(defun calculator-reduce-stack (prec)
- "Reduce the stack using top operator.
-PREC is a precedence - reduce everything with higher precedence."
- (while
- (cond
- ((and (cdr (cdr calculator-stack)) ; have three values
- (consp (nth 0 calculator-stack)) ; two operators & num
- (numberp (nth 1 calculator-stack))
- (consp (nth 2 calculator-stack))
- (eq '\) (nth 1 (nth 0 calculator-stack)))
- (eq '\( (nth 1 (nth 2 calculator-stack))))
- ;; reduce "... ( x )" --> "... x"
- (setq calculator-stack
- (cons (nth 1 calculator-stack)
- (nthcdr 3 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr (cdr calculator-stack)) ; have three values
- (numberp (nth 0 calculator-stack)) ; two nums & operator
- (consp (nth 1 calculator-stack))
- (numberp (nth 2 calculator-stack))
- (= 2 (calculator-op-arity ; binary operator
- (nth 1 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 1 calculator-stack))))
- ;; reduce "... x op y" --> "... r", r is the result
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 1 calculator-stack))
- (nth 2 calculator-stack)
- (nth 0 calculator-stack))
- (nthcdr 3 calculator-stack)))
- ;; another iteration
- t)
- ((and (>= (length calculator-stack) 2) ; have two values
- (numberp (nth 0 calculator-stack)) ; number & operator
- (consp (nth 1 calculator-stack))
- (= -1 (calculator-op-arity ; prefix-unary op
- (nth 1 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 1 calculator-stack))))
- ;; reduce "... op x" --> "... r" for prefix op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 1 calculator-stack))
- (nth 0 calculator-stack))
- (nthcdr 2 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr calculator-stack) ; have two values
- (consp (nth 0 calculator-stack)) ; operator & number
- (numberp (nth 1 calculator-stack))
- (= +1 (calculator-op-arity ; postfix-unary op
- (nth 0 calculator-stack)))
- (<= prec ; with higher prec.
- (calculator-op-prec (nth 0 calculator-stack))))
- ;; reduce "... x op" --> "... r" for postfix op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 0 calculator-stack))
- (nth 1 calculator-stack))
- (nthcdr 2 calculator-stack)))
- ;; another iteration
- t)
- ((and calculator-stack ; have one value
- (consp (nth 0 calculator-stack)) ; an operator
- (= 0 (calculator-op-arity ; 0-ary op
- (nth 0 calculator-stack))))
- ;; reduce "... op" --> "... r" for 0-ary op
- (setq calculator-stack
- (cons (calculator-funcall
- (nth 2 (nth 0 calculator-stack)))
- (nthcdr 1 calculator-stack)))
- ;; another iteration
- t)
- ((and (cdr calculator-stack) ; have two values
- (numberp (nth 0 calculator-stack)) ; both numbers
- (numberp (nth 1 calculator-stack)))
- ;; get rid of redundant numbers:
- ;; reduce "... y x" --> "... x"
- ;; needed for 0-ary ops that puts more values
- (setcdr calculator-stack (cdr (cdr calculator-stack))))
- (t ;; no more iterations
- nil))))
+ "Reduce the stack using top operators as long as possible.
+PREC is a precedence -- reduce everything with higher precedence."
+ (let ((new nil))
+ (while (setq new (calculator-reduce-stack-once prec))
+ (setq calculator-stack new))))
(defun calculator-funcall (f &optional X Y)
"If F is a symbol, evaluate (F X Y).
Otherwise, it should be a list, evaluate it with X, Y bound to the
arguments."
;; remember binary ops for calculator-repR/L
- (if Y (setq calculator-last-opXY (list f X Y)))
- (condition-case nil
- ;; there used to be code here that returns 0 if the result was
- ;; smaller than calculator-epsilon (1e-15). I don't think this is
- ;; necessary now.
- (if (symbolp f)
- (cond ((and X Y) (funcall f X Y))
- (X (funcall f X))
- (t (funcall f)))
- ;; f is an expression
- (let* ((__f__ f) ; so we can get this value below...
- (TX (calculator-truncate X))
- (TY (and Y (calculator-truncate Y)))
- (DX (if calculator-deg (/ (* X pi) 180) X))
- (L calculator-saved-list)
- (Fbound (fboundp 'F))
- (Fsave (and Fbound (symbol-function 'F)))
- (Dbound (fboundp 'D))
- (Dsave (and Dbound (symbol-function 'D))))
- ;; a shortened version of flet
- (fset 'F (function
- (lambda (&optional x y)
- (calculator-funcall __f__ x y))))
- (fset 'D (function
- (lambda (x)
- (if calculator-deg (/ (* x 180) float-pi) x))))
- (unwind-protect (eval f)
- (if Fbound (fset 'F Fsave) (fmakunbound 'F))
- (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
- (error 0)))
+ (when Y (setq calculator-last-opXY (list f X Y)))
+ (if (symbolp f)
+ (cond ((and X Y) (funcall f X Y))
+ (X (funcall f X))
+ (t (funcall f)))
+ ;; f is an expression
+ (let ((TX (and X (calculator-truncate X)))
+ (TY (and Y (calculator-truncate Y)))
+ (DX (if (and X calculator-deg) (degrees-to-radians X) X))
+ (L calculator-saved-list)
+ (fF `(calculator-funcall ',f x y))
+ (fD `(if calculator-deg (* radians-to-degrees x) x)))
+ (eval `(cl-flet ((F (&optional x y) ,fF) (D (x) ,fD))
+ (let ((X ,X) (Y ,Y) (DX ,DX) (TX ,TX) (TY ,TY) (L ',L))
+ ,f))
+ t))))
;;;---------------------------------------------------------------------
;;; Input interaction
(defun calculator-last-input (&optional keys)
"Last char (or event or event sequence) that was read.
-Optional string argument KEYS will force using it as the keys entered."
+Use KEYS if given, otherwise use `this-command-keys'."
(let ((inp (or keys (this-command-keys))))
(if (or (stringp inp) (not (arrayp inp)))
inp
- ;; this translates kp-x to x and [tries to] create a string to
- ;; lookup operators
- (let* ((i -1) (converted-str (make-string (length inp) ? )) k)
- ;; converts an array to a string the ops lookup with keypad
- ;; input
- (while (< (setq i (1+ i)) (length inp))
- (setq k (aref inp i))
- ;; if Emacs will someday have a event-key, then this would
- ;; probably be modified anyway
- (and (if (fboundp 'key-press-event-p) (key-press-event-p k))
- (if (fboundp 'event-key)
- (and (event-key k) (setq k (event-key k)))))
- ;; assume all symbols are translatable with an ascii-character
- (and (symbolp k)
- (setq k (or (get k 'ascii-character) ? )))
- (aset converted-str i k))
- converted-str))))
+ ;; Translates kp-x to x and [tries to] create a string to lookup
+ ;; operators; assume all symbols are translatable via
+ ;; `function-key-map'. This is needed because we have key
+ ;; bindings for kp-* (which might be the wrong thing to do) so
+ ;; they don't get translated in `this-command-keys'.
+ (concat (mapcar (lambda (k)
+ (if (numberp k) k (error "??bad key?? (%S)" k)))
+ (or (lookup-key function-key-map inp) inp))))))
(defun calculator-clear-fragile (&optional op)
"Clear the fragile flag if it was set, then maybe reset all.
OP is the operator (if any) that caused this call."
- (if (and calculator-display-fragile
- (or (not op)
- (= -1 (calculator-op-arity op))
- (= 0 (calculator-op-arity op))))
+ (when (and calculator-display-fragile
+ (or (not op) (memq (calculator-op-arity op) '(-1 0))))
;; reset if last calc finished, and now get a num or prefix or 0-ary
;; op
(calculator-reset))
@@ -1341,53 +1244,44 @@ OP is the operator (if any) that caused this call."
"Enter a single digit."
(interactive)
(let ((inp (aref (calculator-last-input) 0)))
- (if (and (or calculator-display-fragile
- (not (numberp (car calculator-stack))))
- (cond
- ((not calculator-input-radix) (<= inp ?9))
- ((eq calculator-input-radix 'bin) (<= inp ?1))
- ((eq calculator-input-radix 'oct) (<= inp ?7))
- (t t)))
- ;; enter digit if starting a new computation or have an op on the
- ;; stack
- (progn
- (calculator-clear-fragile)
- (let ((digit (upcase (char-to-string inp))))
- (if (equal calculator-curnum "0")
- (setq calculator-curnum nil))
- (setq calculator-curnum
- (concat (or calculator-curnum "") digit)))
- (calculator-update-display)))))
+ (when (and (or calculator-display-fragile
+ (not (numberp (car calculator-stack))))
+ (<= inp (pcase calculator-input-radix
+ (`nil ?9) (`bin ?1) (`oct ?7) (_ 999))))
+ (calculator-clear-fragile)
+ (setq calculator-curnum
+ (concat (if (equal calculator-curnum "0") ""
+ calculator-curnum)
+ (list (upcase inp))))
+ (calculator-update-display))))
(defun calculator-decimal ()
"Enter a decimal period."
(interactive)
- (if (and (not calculator-input-radix)
- (or calculator-display-fragile
- (not (numberp (car calculator-stack))))
- (not (and calculator-curnum
- (string-match-p "[.eE]" calculator-curnum))))
+ (when (and (not calculator-input-radix)
+ (or calculator-display-fragile
+ (not (numberp (car calculator-stack))))
+ (not (and calculator-curnum
+ (string-match-p "[.eE]" calculator-curnum))))
;; enter the period on the same condition as a digit, only if no
;; period or exponent entered yet
- (progn
- (calculator-clear-fragile)
- (setq calculator-curnum (concat (or calculator-curnum "0") "."))
- (calculator-update-display))))
+ (calculator-clear-fragile)
+ (setq calculator-curnum (concat (or calculator-curnum "0") "."))
+ (calculator-update-display)))
(defun calculator-exp ()
"Enter an `E' exponent character, or a digit in hex input mode."
(interactive)
- (if calculator-input-radix
- (calculator-digit)
- (if (and (or calculator-display-fragile
- (not (numberp (car calculator-stack))))
- (not (and calculator-curnum
- (string-match-p "[eE]" calculator-curnum))))
- ;; same condition as above, also no E so far
- (progn
- (calculator-clear-fragile)
- (setq calculator-curnum (concat (or calculator-curnum "1") "e"))
- (calculator-update-display)))))
+ (cond
+ (calculator-input-radix (calculator-digit))
+ ((and (or calculator-display-fragile
+ (not (numberp (car calculator-stack))))
+ (not (and calculator-curnum
+ (string-match-p "[eE]" calculator-curnum))))
+ ;; same condition as above, also no E so far
+ (calculator-clear-fragile)
+ (setq calculator-curnum (concat (or calculator-curnum "1") "e"))
+ (calculator-update-display))))
(defun calculator-op (&optional keys)
"Enter an operator on the stack, doing all necessary reductions.
@@ -1397,42 +1291,29 @@ Optional string argument KEYS will force using it as the keys entered."
(let* ((last-inp (calculator-last-input keys))
(op (assoc last-inp calculator-operators)))
(calculator-clear-fragile op)
- (if (and calculator-curnum (/= (calculator-op-arity op) 0))
- (setq calculator-stack
- (cons (calculator-curnum-value) calculator-stack)))
- (setq calculator-curnum nil)
- (if (and (= 2 (calculator-op-arity op))
- (not (and calculator-stack
- (numberp (nth 0 calculator-stack)))))
- ;; we have a binary operator but no number - search for a prefix
- ;; version
- (let ((rest-ops calculator-operators))
- (while (not (equal last-inp (car (car rest-ops))))
- (setq rest-ops (cdr rest-ops)))
- (setq op (assoc last-inp (cdr rest-ops)))
- (if (not (and op (= -1 (calculator-op-arity op))))
- ;;(error "Binary operator without a first operand")
- (progn
- (calculator-message
- "Binary operator without a first operand")
- (throw 'op-error nil)))))
+ (calculator-push-curnum)
+ (when (and (= 2 (calculator-op-arity op))
+ (not (numberp (car calculator-stack))))
+ ;; we have a binary operator but no number -- search for a
+ ;; prefix version
+ (setq op (assoc last-inp (cdr (memq op calculator-operators))))
+ (unless (and op (= -1 (calculator-op-arity op)))
+ (calculator-message "Binary operator without a first operand")
+ (throw 'op-error nil)))
(calculator-reduce-stack
(cond ((eq (nth 1 op) '\() 10)
((eq (nth 1 op) '\)) 0)
(t (calculator-op-prec op))))
- (if (or (and (= -1 (calculator-op-arity op))
- (numberp (car calculator-stack)))
- (and (/= (calculator-op-arity op) -1)
- (/= (calculator-op-arity op) 0)
- (not (numberp (car calculator-stack)))))
- ;;(error "Unterminated expression")
- (progn
- (calculator-message "Unterminated expression")
- (throw 'op-error nil)))
- (setq calculator-stack (cons op calculator-stack))
+ (when (let ((hasnum (numberp (car calculator-stack))))
+ (pcase (calculator-op-arity op)
+ (-1 hasnum)
+ ((or 1 2) (not hasnum))))
+ (calculator-message "Incomplete expression")
+ (throw 'op-error nil))
+ (push op calculator-stack)
(calculator-reduce-stack (calculator-op-prec op))
(and (= (length calculator-stack) 1)
- (numberp (nth 0 calculator-stack))
+ (numberp (car calculator-stack))
;; the display is fragile if it contains only one number
(setq calculator-display-fragile t)
;; add number to the saved-list
@@ -1448,7 +1329,8 @@ Optional string argument KEYS will force using it as the keys entered."
(defun calculator-op-or-exp ()
"Either enter an operator or a digit.
Used with +/- for entering them as digits in numbers like 1e-3 (there is
-no need for negative numbers since these are handled by unary operators)."
+no need for negative numbers since these are handled by unary
+operators)."
(interactive)
(if (and (not calculator-display-fragile)
calculator-curnum
@@ -1462,14 +1344,11 @@ no need for negative numbers since these are handled by unary operators)."
(defun calculator-dec/deg-mode ()
"Set decimal mode for display & input, if decimal, toggle deg mode."
(interactive)
- (if calculator-curnum
- (setq calculator-stack
- (cons (calculator-curnum-value) calculator-stack)))
- (setq calculator-curnum nil)
+ (calculator-push-curnum)
(if (or calculator-input-radix calculator-output-radix)
(progn (setq calculator-input-radix nil)
(setq calculator-output-radix nil))
- ;; already decimal - toggle degrees mode
+ ;; already decimal -- toggle degrees mode
(setq calculator-deg (not calculator-deg)))
(calculator-update-display t))
@@ -1484,10 +1363,7 @@ Optional string argument KEYS will force using it as the keys entered."
"Set input radix modes.
Optional string argument KEYS will force using it as the keys entered."
(interactive)
- (if calculator-curnum
- (setq calculator-stack
- (cons (calculator-curnum-value) calculator-stack)))
- (setq calculator-curnum nil)
+ (calculator-push-curnum)
(setq calculator-input-radix
(let ((inp (calculator-last-input keys)))
(cdr (assq (upcase (aref inp (1- (length inp))))
@@ -1498,10 +1374,7 @@ Optional string argument KEYS will force using it as the keys entered."
"Set display radix modes.
Optional string argument KEYS will force using it as the keys entered."
(interactive)
- (if calculator-curnum
- (setq calculator-stack
- (cons (calculator-curnum-value) calculator-stack)))
- (setq calculator-curnum nil)
+ (calculator-push-curnum)
(setq calculator-output-radix
(let ((inp (calculator-last-input keys)))
(cdr (assq (upcase (aref inp (1- (length inp))))
@@ -1527,19 +1400,18 @@ Optional string argument KEYS will force using it as the keys entered."
(defun calculator-saved-move (n)
"Go N elements up the list of saved values."
(interactive)
- (and calculator-saved-list
- (or (null calculator-stack) calculator-display-fragile)
- (progn
- (setq calculator-saved-ptr
- (max (min (+ n calculator-saved-ptr)
- (length calculator-saved-list))
- 0))
- (if (nth calculator-saved-ptr calculator-saved-list)
- (setq calculator-stack
- (list (nth calculator-saved-ptr calculator-saved-list))
- calculator-display-fragile t)
- (calculator-reset))
- (calculator-update-display))))
+ (when (and calculator-saved-list
+ (or (null calculator-stack) calculator-display-fragile))
+ (setq calculator-saved-ptr
+ (max (min (+ n calculator-saved-ptr)
+ (length calculator-saved-list))
+ 0))
+ (if (nth calculator-saved-ptr calculator-saved-list)
+ (setq calculator-stack (list (nth calculator-saved-ptr
+ calculator-saved-list))
+ calculator-display-fragile t)
+ (calculator-reset))
+ (calculator-update-display)))
(defun calculator-saved-up ()
"Go up the list of saved values."
@@ -1586,7 +1458,7 @@ Optional string argument KEYS will force using it as the keys entered."
(interactive)
(setq calculator-curnum nil)
(cond
- ;; if the current number is from the saved-list - remove it
+ ;; if the current number is from the saved-list remove it
((and calculator-display-fragile
calculator-saved-list
(= (car calculator-stack)
@@ -1595,7 +1467,7 @@ Optional string argument KEYS will force using it as the keys entered."
(setq calculator-saved-list (cdr calculator-saved-list))
(let ((p (nthcdr (1- calculator-saved-ptr)
calculator-saved-list)))
- (setcdr p (cdr (cdr p)))
+ (setcdr p (cddr p))
(setq calculator-saved-ptr (1- calculator-saved-ptr))))
(if calculator-saved-list
(setq calculator-stack
@@ -1616,13 +1488,16 @@ Optional string argument KEYS will force using it as the keys entered."
(calculator-enter)
;; remove trailing spaces and an index
(let ((s (cdr calculator-stack-display)))
- (and s
- (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s)
- (setq s (match-string 1 s)))
- (kill-new s)))))
+ (when s
+ (kill-new (replace-regexp-in-string
+ "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" "\\1" s))))))
(defun calculator-set-register (reg)
"Set a register value for REG."
+ ;; FIXME: this should use `register-read-with-preview', but it uses
+ ;; calculator-registers rather than `register-alist'. (Maybe
+ ;; dynamically rebinding it will get blessed?) Also in to
+ ;; `calculator-get-register'.
(interactive "cRegister to store into: ")
(let* ((as (assq reg calculator-registers))
(val (progn (calculator-enter) (car calculator-stack))))
@@ -1635,15 +1510,14 @@ Optional string argument KEYS will force using it as the keys entered."
(defun calculator-put-value (val)
"Paste VAL as if entered.
Used by `calculator-paste' and `get-register'."
- (if (and (numberp val)
- ;; (not calculator-curnum)
- (or calculator-display-fragile
- (not (numberp (car calculator-stack)))))
- (progn
- (calculator-clear-fragile)
- (setq calculator-curnum (let ((calculator-displayer "%S"))
- (calculator-number-to-string val)))
- (calculator-update-display))))
+ (when (and (numberp val)
+ ;; (not calculator-curnum)
+ (or calculator-display-fragile
+ (not (numberp (car calculator-stack)))))
+ (calculator-clear-fragile)
+ (setq calculator-curnum (let ((calculator-displayer "%S"))
+ (calculator-number-to-string val)))
+ (calculator-update-display)))
(defun calculator-paste ()
"Paste a value from the `kill-ring'."
@@ -1677,7 +1551,7 @@ Used by `calculator-paste' and `get-register'."
+ - * / \\(div) %(rem) _(-X,postfix) ;(1/X,postfix) ^(exp) L(og)
Q(sqrt) !(fact) S(in) C(os) T(an) |(or) #(xor) &(and) ~(not)
* >/< repeats last binary operation with its 2nd (1st) arg as postfix op
-* I inverses next trig function * '/\"/{} - display/display args
+* I inverses next trig function * \\='/\"/{} - display/display args
* D - switch to all-decimal, or toggle deg/rad mode
* B/O/H/X - binary/octal/hex mode for i/o (X is a shortcut for H)
* i/o - prefix for d/b/o/x - set only input/output modes
@@ -1695,16 +1569,13 @@ Used by `calculator-paste' and `get-register'."
(g-map (current-global-map))
(win (selected-window)))
(require 'ehelp)
- (if calculator-electric-mode
+ (when calculator-electric-mode
(use-global-map calculator-saved-global-map))
- (if (or (not calculator-electric-mode)
- ;; XEmacs has a problem with electric-describe-mode
- (featurep 'xemacs))
- (describe-mode)
- (electric-describe-mode))
(if calculator-electric-mode
- (use-global-map g-map))
- (select-window win) ; these are for XEmacs (also below)
+ (electric-describe-mode)
+ (describe-mode))
+ (when calculator-electric-mode (use-global-map g-map))
+ (select-window win)
(message nil))
(let ((one (one-window-p t))
(win (selected-window))
@@ -1712,12 +1583,11 @@ Used by `calculator-paste' and `get-register'."
(save-window-excursion
(with-output-to-temp-buffer "*Help*"
(princ (documentation 'calculator-help)))
- (if one
- (shrink-window-if-larger-than-buffer
- (get-buffer-window help-buf)))
- (message
- "`%s' again for more help, any other key continues normally."
- (calculator-last-input))
+ (when one (shrink-window-if-larger-than-buffer
+ (get-buffer-window help-buf)))
+ (message "`%s' again for more help, %s."
+ (calculator-last-input)
+ "any other key continues normally")
(select-window win)
(sit-for 360))
(select-window win))))
@@ -1730,11 +1600,12 @@ Used by `calculator-paste' and `get-register'."
(unless calculator-electric-mode
(ignore-errors
(while (get-buffer-window calculator-buffer)
- (delete-window (get-buffer-window calculator-buffer))))
- (kill-buffer calculator-buffer))
- (setq calculator-buffer nil)
+ (delete-window (get-buffer-window calculator-buffer)))))
+ (kill-buffer calculator-buffer)
(message "Calculator done.")
- (if calculator-electric-mode (throw 'calculator-done nil)))
+ (if calculator-electric-mode
+ (throw 'calculator-done nil) ; will kill the buffer
+ (setq calculator-buffer nil)))
(defun calculator-save-and-quit ()
"Quit the calculator, saving the result on the `kill-ring'."
@@ -1763,58 +1634,47 @@ To use this, apply a binary operator (evaluate it), then call this."
(car calculator-last-opXY) (nth 1 calculator-last-opXY) x))
x))
-(defun calculator-integer-p (x)
- "Non-nil if X is equal to an integer."
- (ignore-errors (= x (ftruncate x))))
-
(defun calculator-expt (x y)
"Compute X^Y, dealing with errors appropriately."
(condition-case nil
(expt x y)
(domain-error 0.0e+NaN)
(range-error
- (cond
- ((and (< x 1.0) (> x -1.0))
- ;; For small x, the range error comes from large y.
- 0.0)
- ((and (> x 0.0) (< y 0.0))
- ;; For large positive x and negative y, the range error
- ;; comes from large negative y.
- 0.0)
- ((and (> x 0.0) (> y 0.0))
- ;; For large positive x and positive y, the range error
- ;; comes from large y.
- 1.0e+INF)
- ;; For the rest, x must be large and negative.
- ;; The range errors come from large integer y.
- ((< y 0.0)
- 0.0)
- ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp'
- ;; If y is odd
- -1.0e+INF)
- (t
- ;;
- 1.0e+INF)))
+ (cond ((and (< x 1.0) (> x -1.0))
+ ;; For small x, the range error comes from large y.
+ 0.0)
+ ((and (> x 0.0) (< y 0.0))
+ ;; For large positive x and negative y, the range error
+ ;; comes from large negative y.
+ 0.0)
+ ((and (> x 0.0) (> y 0.0))
+ ;; For large positive x and positive y, the range error
+ ;; comes from large y.
+ 1.0e+INF)
+ ;; For the rest, x must be large and negative.
+ ;; The range errors come from large integer y.
+ ((< y 0.0)
+ 0.0)
+ ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp'
+ ;; If y is odd
+ -1.0e+INF)
+ (t
+ ;;
+ 1.0e+INF)))
(error 0.0e+NaN)))
(defun calculator-fact (x)
"Simple factorial of X."
- (if (and (>= x 0)
- (calculator-integer-p x))
- (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF)
- 1.0e+INF
- (let ((r (if (<= x 10) 1 1.0)))
- (while (> x 0)
- (setq r (* r (truncate x)))
- (setq x (1- x)))
- (+ 0.0 r)))
- (if (= x 1.0e+INF)
- x
- 0.0e+NaN)))
+ (cond ((>= x 1.0e+INF) x)
+ ((or (and (floatp x) (isnan x)) (< x 0)) 0.0e+NaN)
+ ((>= (calculator-expt (/ x 3.0) x) 1.0e+INF) 1.0e+INF)
+ (t (let ((x (truncate x)) (r 1.0))
+ (while (> x 0) (setq r (* r x) x (1- x)))
+ r))))
(defun calculator-truncate (n)
"Truncate N, return 0 in case of overflow."
- (condition-case nil (truncate n) (error 0)))
+ (condition-case nil (truncate n) (range-error 0)))
(provide 'calculator)
diff --git a/lisp/calendar/.gitignore b/lisp/calendar/.gitignore
deleted file mode 100644
index d0de296c6e3..00000000000
--- a/lisp/calendar/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-*.elc
-cal-loaddefs.el
-diary-loaddefs.el
-hol-loaddefs.el
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 97b20f6b02b..d5d8a400218 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,6 +1,6 @@
;;; appt.el --- appointment notification functions
-;; Copyright (C) 1989-1990, 1994, 1998, 2001-2013 Free Software
+;; Copyright (C) 1989-1990, 1994, 1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
@@ -228,7 +228,7 @@ also calls `beep' for an audible reminder."
string (car string)))
(cond ((eq appt-display-format 'window)
;; TODO use calendar-month-abbrev-array rather than %b?
- (let ((time (format-time-string "%a %b %e " (current-time)))
+ (let ((time (format-time-string "%a %b %e "))
err)
(condition-case err
(funcall appt-disp-window-function
@@ -511,13 +511,13 @@ The default is `appt-message-warning-time'."
(interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\
sMinutes before the appointment to start warning: ")
(unless (string-match appt-time-regexp time)
- (error "Unacceptable time-string"))
+ (user-error "Unacceptable time-string"))
(and (stringp warntime)
(setq warntime (unless (string-equal warntime "")
(string-to-number warntime))))
(and warntime
(not (integerp warntime))
- (error "Argument WARNTIME must be an integer, or nil"))
+ (user-error "Argument WARNTIME must be an integer, or nil"))
(or appt-timer (appt-activate))
(let ((time-msg (list (list (appt-convert-time time))
(concat time " " msg) t)))
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 46a486af67b..d0b3021ea60 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -1,10 +1,10 @@
-;;; cal-bahai.el --- calendar functions for the Bahá'í calendar.
+;;; cal-bahai.el --- calendar functions for the Bahá’í calendar.
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: calendar
-;; Human-Keywords: Bahá'í calendar, Bahá'í, Baha'i, Bahai, calendar, diary
+;; Human-Keywords: Bahá’í calendar, Bahá’í, Baha'i, Bahai, calendar, diary
;; Package: calendar
;; This file is part of GNU Emacs.
@@ -25,9 +25,9 @@
;;; Commentary:
;; This collection of functions implements the features of calendar.el
-;; and diary-lib.el that deal with the Bahá'í calendar.
+;; and diary-lib.el that deal with the Bahá’í calendar.
-;; The Bahá'í (http://www.bahai.org) calendar system is based on a
+;; The Bahá’í (http://www.bahai.org) calendar system is based on a
;; solar cycle of 19 months with 19 days each. The four remaining
;; "intercalary" days are called the Ayyám-i-Há (days of Há), and are
;; placed between the 18th and 19th months. They are meant as a time
@@ -42,7 +42,7 @@
;; Váhids. A cycle of 19 Váhids (361 years) is called a Kullu-Shay,
;; which means "all things".
-;; The calendar was named the "Badí` calendar" by its author, the Báb.
+;; The calendar was named the "Badí‘ calendar" by its author, the Báb.
;; It uses a week of seven days, corresponding to the Gregorian week,
;; each of which has its own name, again patterned after the
;; attributes of God.
@@ -56,16 +56,16 @@
(require 'calendar)
(defconst calendar-bahai-month-name-array
- ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál"
- "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il"
- "Sharaf" "Sultán" "Mulk" "`Alá"]
- "Array of the month names in the Bahá'í calendar.")
+ ["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á’"]
+ "Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
- "Absolute date of start of Bahá'í calendar = March 21, 1844 AD.")
+ "Absolute date of start of Bahá’í calendar = March 21, 1844 AD.")
(defun calendar-bahai-leap-year-p (year)
- "True if Bahá'í YEAR is a leap year in the Bahá'í calendar."
+ "True if Bahá’í YEAR is a leap year in the Bahá’í calendar."
(calendar-leap-year-p (+ year 1844)))
(defconst calendar-bahai-leap-base
@@ -74,7 +74,7 @@
Used by `calendar-bahai-to-absolute'.")
(defun calendar-bahai-to-absolute (date)
- "Compute absolute date from Bahá'í date DATE.
+ "Compute absolute date from Bahá’í date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((month (calendar-extract-month date))
@@ -94,13 +94,10 @@ Gregorian date Sunday, December 31, 1 BC."
0)
day))) ; days so far this month
-(define-obsolete-function-alias 'calendar-absolute-from-bahai
- 'calendar-bahai-to-absolute "23.1")
-
(defun calendar-bahai-from-absolute (date)
- "Bahá'í date (month day year) corresponding to the absolute DATE."
+ "Bahá’í date (month day year) corresponding to the absolute DATE."
(if (< date calendar-bahai-epoch)
- (list 0 0 0) ; pre-Bahá'í date
+ (list 0 0 0) ; pre-Bahá’í date
(let* ((greg (calendar-gregorian-from-absolute date))
(gmonth (calendar-extract-month greg))
(year (+ (- (calendar-extract-year greg) 1844)
@@ -119,7 +116,7 @@ Gregorian date Sunday, December 31, 1 BC."
;;;###cal-autoload
(defun calendar-bahai-date-string (&optional date)
- "String of Bahá'í date of Gregorian DATE.
+ "String of Bahá’í date of Gregorian DATE.
Defaults to today's date if DATE is not given."
(let* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
@@ -145,22 +142,19 @@ Defaults to today's date if DATE is not given."
;;;###cal-autoload
(defun calendar-bahai-print-date ()
- "Show the Bahá'í calendar equivalent of the selected date."
+ "Show the Bahá’í calendar equivalent of the selected date."
(interactive)
(let ((s (calendar-bahai-date-string (calendar-cursor-to-date t))))
(if (string-equal s "")
- (message "Date is pre-Bahá'í")
- (message "Bahá'í date: %s" s))))
-
-(define-obsolete-function-alias
- 'calendar-print-bahai-date 'calendar-bahai-print-date "23.1")
+ (message "Date is pre-Bahá’í")
+ (message "Bahá’í date: %s" s))))
(defun calendar-bahai-read-date ()
- "Interactively read the arguments for a Bahá'í date command.
+ "Interactively read the arguments for a Bahá’í date command.
Reads a year, month and day."
(let* ((today (calendar-current-date))
(year (calendar-read
- "Bahá'í calendar year (not 0): "
+ "Bahá’í calendar year (not 0): "
(lambda (x) (not (zerop x)))
(number-to-string
(calendar-extract-year
@@ -169,37 +163,31 @@ Reads a year, month and day."
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
- "Bahá'í calendar month name: "
+ "Bahá’í calendar month name: "
(mapcar 'list
(append calendar-bahai-month-name-array nil))
nil t)
(calendar-make-alist calendar-bahai-month-name-array
1))))
- (day (calendar-read "Bahá'í calendar day (1-19): "
+ (day (calendar-read "Bahá’í calendar day (1-19): "
(lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
-(define-obsolete-function-alias
- 'calendar-bahai-prompt-for-date 'calendar-bahai-read-date "23.1")
-
;;;###cal-autoload
(defun calendar-bahai-goto-date (date &optional noecho)
- "Move cursor to Bahá'í date DATE; echo Bahá'í date unless NOECHO is non-nil."
+ "Move cursor to Bahá’í date DATE; echo Bahá’í date unless NOECHO is non-nil."
(interactive (calendar-bahai-read-date))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-bahai-to-absolute date)))
(or noecho (calendar-bahai-print-date)))
-(define-obsolete-function-alias
- 'calendar-goto-bahai-date 'calendar-bahai-goto-date "23.1")
-
(defvar displayed-month)
(defvar displayed-year)
;;;###holiday-autoload
(defun holiday-bahai (month day string)
- "Holiday on MONTH, DAY (Bahá'í) called STRING.
-If MONTH, DAY (Bahá'í) is visible in the current calendar window,
+ "Holiday on MONTH, DAY (Bahá’í) called STRING.
+If MONTH, DAY (Bahá’í) is visible in the current calendar window,
returns the corresponding Gregorian date in the form of the
list (((month day year) STRING)). Otherwise, returns nil."
;; Since the calendar window shows 3 months at a time, there are
@@ -211,7 +199,7 @@ list (((month day year) STRING)). Otherwise, returns nil."
(m (calendar-extract-month bahai-date))
(y (calendar-extract-year bahai-date))
date)
- (unless (< m 1) ; Bahá'í calendar doesn't apply
+ (unless (< m 1) ; Bahá’í calendar doesn't apply
;; Cf holiday-fixed, holiday-islamic.
;; With a +- 3 month calendar window, and 19 months per year,
;; month 16 is special. When m16 is central is when the
@@ -221,7 +209,7 @@ list (((month day year) STRING)). Otherwise, returns nil."
;; To see if other months are visible we can shift the range
;; accordingly.
(calendar-increment-month m y (- 16 month) 19)
- (and (> m 12) ; Bahá'í date might be visible
+ (and (> m 12) ; Bahá’í date might be visible
(calendar-date-is-visible-p
(setq date (calendar-gregorian-from-absolute
(calendar-bahai-to-absolute (list month day y)))))
@@ -231,9 +219,9 @@ list (((month day year) STRING)). Otherwise, returns nil."
;;;###holiday-autoload
(defun holiday-bahai-new-year ()
- "Holiday entry for the Bahá'í New Year, if visible in the calendar window."
+ "Holiday entry for the Bahá’í New Year, if visible in the calendar window."
(holiday-fixed 3 21
- (format "Bahá'í New Year (Naw-Ruz) %d"
+ (format "Bahá’í New Year (Naw-Ruz) %d"
(- displayed-year (1- 1844)))))
;;;###holiday-autoload
@@ -258,41 +246,34 @@ Only considers the first, ninth, and twelfth days, unless ALL or
;;;###diary-autoload
(defun diary-bahai-list-entries ()
- "Add any Bahá'í date entries from the diary file to `diary-entries-list'.
-Bahá'í date diary entries must be prefaced by `diary-bahai-entry-symbol'
+ "Add any Bahá’í date entries from the diary file to `diary-entries-list'.
+Bahá’í date diary entries must be prefaced by `diary-bahai-entry-symbol'
\(normally a `B'). The same diary date forms govern the style of the
-Bahá'í calendar entries, except that the Bahá'í month names cannot be
-abbreviated. The Bahá'í months are numbered from 1 to 19 with Bahá being
-1 and 19 being `Alá. If a Bahá'í date diary entry begins with
+Bahá’í calendar entries, except that the Bahá’í month names cannot be
+abbreviated. The Bahá’í months are numbered from 1 to 19 with Bahá being
+1 and 19 being `Alá. If a Bahá’í date diary entry begins with
`diary-nonmarking-symbol', the entry will appear in the diary listing, but
will not be marked in the calendar. This function is provided for use with
`diary-nongregorian-listing-hook'."
(diary-list-entries-1 calendar-bahai-month-name-array
diary-bahai-entry-symbol
'calendar-bahai-from-absolute))
-(define-obsolete-function-alias
- 'list-bahai-diary-entries 'diary-bahai-list-entries "23.1")
-
(autoload 'calendar-mark-1 "diary-lib")
;;;###diary-autoload
(defun calendar-bahai-mark-date-pattern (month day year &optional color)
- "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR.
+ "Mark dates in calendar window that conform to Bahá’í date MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-1 month day year 'calendar-bahai-from-absolute
'calendar-bahai-to-absolute color))
-(define-obsolete-function-alias
- 'mark-bahai-calendar-date-pattern 'calendar-bahai-mark-date-pattern "23.1")
-
-
(autoload 'diary-mark-entries-1 "diary-lib")
;;;###diary-autoload
(defun diary-bahai-mark-entries ()
- "Mark days in the calendar window that have Bahá'í date diary entries.
+ "Mark days in the calendar window that have Bahá’í date diary entries.
Marks each entry in `diary-file' (or included files) visible in the calendar
window. See `diary-bahai-list-entries' for more information."
(diary-mark-entries-1 'calendar-bahai-mark-date-pattern
@@ -300,64 +281,47 @@ window. See `diary-bahai-list-entries' for more information."
diary-bahai-entry-symbol
'calendar-bahai-from-absolute))
-(define-obsolete-function-alias
- 'mark-bahai-diary-entries 'diary-bahai-mark-entries "23.1")
-
-
(autoload 'diary-insert-entry-1 "diary-lib")
;;;###cal-autoload
(defun diary-bahai-insert-entry (arg)
"Insert a diary entry.
-For the Bahá'í date corresponding to the date indicated by point.
+For the Bahá’í date corresponding to the date indicated by point.
Prefix argument ARG makes the entry nonmarking."
(interactive "P")
(diary-insert-entry-1 nil arg calendar-bahai-month-name-array
diary-bahai-entry-symbol
'calendar-bahai-from-absolute))
-(define-obsolete-function-alias
- 'insert-bahai-diary-entry 'diary-bahai-insert-entry "23.1")
-
;;;###cal-autoload
(defun diary-bahai-insert-monthly-entry (arg)
"Insert a monthly diary entry.
-For the day of the Bahá'í month corresponding to the date indicated by point.
+For the day of the Bahá’í month corresponding to the date indicated by point.
Prefix argument ARG makes the entry nonmarking."
(interactive "P")
(diary-insert-entry-1 'monthly arg calendar-bahai-month-name-array
diary-bahai-entry-symbol
'calendar-bahai-from-absolute))
-(define-obsolete-function-alias
- 'insert-monthly-bahai-diary-entry 'diary-bahai-insert-monthly-entry "23.1")
-
;;;###cal-autoload
(defun diary-bahai-insert-yearly-entry (arg)
"Insert an annual diary entry.
-For the day of the Bahá'í year corresponding to the date indicated by point.
+For the day of the Bahá’í year corresponding to the date indicated by point.
Prefix argument ARG will make the entry nonmarking."
(interactive "P")
(diary-insert-entry-1 'yearly arg calendar-bahai-month-name-array
diary-bahai-entry-symbol
'calendar-bahai-from-absolute))
-(define-obsolete-function-alias
- 'insert-yearly-bahai-diary-entry 'diary-bahai-insert-yearly-entry "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-bahai-date ()
- "Bahá'í calendar equivalent of date diary entry."
- (format "Bahá'í date: %s" (calendar-bahai-date-string date)))
+ "Bahá’í calendar equivalent of date diary entry."
+ (format "Bahá’í date: %s" (calendar-bahai-date-string date)))
(provide 'cal-bahai)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; cal-bahai.el ends here
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 86e6efa9696..b635eb60aba 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -1,6 +1,6 @@
;;; cal-china.el --- calendar functions for the Chinese calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -58,9 +58,6 @@
:prefix "calendar-chinese-"
:group 'calendar)
-(define-obsolete-variable-alias 'chinese-calendar-time-zone
- 'calendar-chinese-time-zone "23.1")
-
(defcustom calendar-chinese-time-zone
'(if (< year 1928)
(+ 465 (/ 40.0 60.0))
@@ -78,18 +75,12 @@ Default is for Beijing. This is an expression in `year' since it changed at
(put 'chinese-calendar-time-zone 'risky-local-variable t)
-(define-obsolete-variable-alias 'chinese-calendar-location-name
- 'calendar-chinese-location-name "23.1")
-
;; FIXME unused.
(defcustom calendar-chinese-location-name "Beijing"
"Name of location used for calculation of Chinese calendar."
:type 'string
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-time-offset
- 'calendar-chinese-daylight-time-offset "23.1")
-
(defcustom calendar-chinese-daylight-time-offset 0
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
@@ -99,9 +90,6 @@ Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-standard-time-zone-name
- 'calendar-chinese-standard-time-zone-name "23.1")
-
(defcustom calendar-chinese-standard-time-zone-name
'(if (< year 1928)
"PMT"
@@ -112,17 +100,11 @@ at 1928-01-01 00:00:00 from `PMT' to `CST'."
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-time-zone-name
- 'calendar-chinese-daylight-time-zone-name "23.1")
-
(defcustom calendar-chinese-daylight-time-zone-name "CDT"
"Abbreviated name of daylight saving time zone used for Chinese calendar."
:type 'string
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts
- 'calendar-chinese-daylight-saving-start "23.1")
-
(defcustom calendar-chinese-daylight-saving-start nil
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
@@ -135,9 +117,6 @@ Default is for no daylight saving time. See documentation of
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends
- 'calendar-chinese-daylight-saving-end "23.1")
-
(defcustom calendar-chinese-daylight-saving-end nil
;; The correct value is as follows, but the Chinese calendrical
;; authorities do NOT use DST in determining astronomical events:
@@ -148,27 +127,18 @@ Default is for no daylight saving time. See documentation of
:type 'sexp
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-starts-time
- 'calendar-chinese-daylight-saving-start-time "23.1")
-
(defcustom calendar-chinese-daylight-saving-start-time 0
"Number of minutes after midnight that daylight saving time starts.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-daylight-savings-ends-time
- 'calendar-chinese-daylight-saving-end-time "23.1")
-
(defcustom calendar-chinese-daylight-saving-end-time 0
"Number of minutes after midnight that daylight saving time ends.
Default is for no daylight saving time."
:type 'integer
:group 'calendar-chinese)
-(define-obsolete-variable-alias 'chinese-calendar-celestial-stem
- 'calendar-chinese-celestial-stem "23.1")
-
(defcustom calendar-chinese-celestial-stem
["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"]
"Prefixes used by `calendar-chinese-sexagesimal-name'."
@@ -184,9 +154,6 @@ Default is for no daylight saving time."
(string :tag "Ren")
(string :tag "Gui")))
-(define-obsolete-variable-alias 'chinese-calendar-terrestrial-branch
- 'calendar-chinese-terrestrial-branch "23.1")
-
(defcustom calendar-chinese-terrestrial-branch
["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"]
"Suffixes used by `calendar-chinese-sexagesimal-name'."
@@ -327,19 +294,7 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
(defvar calendar-chinese-year-cache
;; Maintainers: delete existing value, position point at start of
;; empty line, then call M-: (calendar-chinese-year-cache-init N)
- '((2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273)
- (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450))
- (2001 (12 730480) (1 730509) (2 730539) (3 730569) (4 730598) (4.5 730628)
- (5 730657) (6 730687) (7 730716) (8 730745) (9 730775) (10 730804)
- (11 730834))
- (2002 (12 730863) (1 730893) (2 730923) (3 730953) (4 730982) (5 731012)
- (6 731041) (7 731071) (8 731100) (9 731129) (10 731159) (11 731188))
- (2003 (12 731218) (1 731247) (2 731277) (3 731307) (4 731336) (5 731366)
- (6 731396) (7 731425) (8 731455) (9 731484) (10 731513) (11 731543))
- (2004 (12 731572) (1 731602) (2 731631) (2.5 731661) (3 731690) (4 731720)
- (5 731750) (6 731779) (7 731809) (8 731838) (9 731868) (10 731897)
- (11 731927))
- (2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104)
+ '((2005 (12 731956) (1 731986) (2 732015) (3 732045) (4 732074) (5 732104)
(6 732133) (7 732163) (8 732193) (9 732222) (10 732252) (11 732281))
(2006 (12 732311) (1 732340) (2 732370) (3 732399) (4 732429) (5 732458)
(6 732488) (7 732517) (7.5 732547) (8 732576) (9 732606) (10 732636)
@@ -376,7 +331,19 @@ Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
(6 737243) (7 737272) (8 737301) (9 737331) (10 737360) (11 737389))
(2020 (12 737419) (1 737449) (2 737478) (3 737508) (4 737538) (4.5 737568)
(5 737597) (6 737627) (7 737656) (8 737685) (9 737715) (10 737744)
- (11 737774)))
+ (11 737774))
+ (2021 (12 737803) (1 737833) (2 737862) (3 737892) (4 737922) (5 737951)
+ (6 737981) (7 738010) (8 738040) (9 738069) (10 738099) (11 738128))
+ (2022 (12 738158) (1 738187) (2 738217) (3 738246) (4 738276) (5 738305)
+ (6 738335) (7 738365) (8 738394) (9 738424) (10 738453) (11 738483))
+ (2023 (12 738512) (1 738542) (2 738571) (2.5 738601) (3 738630) (4 738659)
+ (5 738689) (6 738719) (7 738748) (8 738778) (9 738808) (10 738837)
+ (11 738867))
+ (2024 (12 738896) (1 738926) (2 738955) (3 738985) (4 739014) (5 739043)
+ (6 739073) (7 739102) (8 739132) (9 739162) (10 739191) (11 739221))
+ (2025 (12 739251) (1 739280) (2 739310) (3 739339) (4 739369) (5 739398)
+ (6 739427) (6.5 739457) (7 739486) (8 739516) (9 739545) (10 739575)
+ (11 739605)))
"Alist of Chinese year structures as determined by `chinese-year'.
The default can be nil, but some values are precomputed for efficiency.")
@@ -432,9 +399,6 @@ Sunday, December 31, 1 BC is imaginary."
(calendar-chinese-year g-year))
(calendar-chinese-year (1+ g-year))))))))
-(define-obsolete-function-alias 'calendar-absolute-from-chinese
- 'calendar-chinese-to-absolute "23.1")
-
(defun calendar-chinese-from-absolute (date)
"Compute Chinese date (cycle year month day) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
@@ -599,9 +563,6 @@ Defaults to today's date if DATE is not given."
(message "Chinese date: %s"
(calendar-chinese-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-chinese-date
- 'calendar-chinese-print-date "23.1")
-
(defun calendar-chinese-months-to-alist (l)
"Make list of months L into an assoc list."
(and l (car l)
@@ -671,9 +632,6 @@ Echo Chinese date unless NOECHO is non-nil."
(calendar-chinese-to-absolute date)))
(or noecho (calendar-chinese-print-date)))
-(define-obsolete-function-alias 'calendar-goto-chinese-date
- 'calendar-chinese-goto-date "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
@@ -682,6 +640,139 @@ Echo Chinese date unless NOECHO is non-nil."
"Chinese calendar equivalent of date diary entry."
(format "Chinese date: %s" (calendar-chinese-date-string date)))
+;;;; diary support
+
+(autoload 'calendar-mark-1 "diary-lib")
+(autoload 'diary-mark-entries-1 "diary-lib")
+(autoload 'diary-list-entries-1 "diary-lib")
+(autoload 'diary-insert-entry-1 "diary-lib")
+(autoload 'diary-date-display-form "diary-lib")
+(autoload 'diary-make-date "diary-lib")
+(autoload 'diary-ordinal-suffix "diary-lib")
+(defvar diary-sexp-entry-symbol)
+(defvar entry) ;used by `diary-chinese-anniversary'
+
+(defvar calendar-chinese-month-name-array
+ ["正月" "二月" "三月" "四月" "五月" "六月"
+ "七月" "八月" "九月" "十月" "冬月" "臘月"])
+
+;;; NOTE: In the diary the cycle and year of a Chinese date is
+;;; combined using this formula: (+ (* cycle 100) year).
+;;;
+;;; These two functions convert to and back from this representation.
+(defun calendar-chinese-from-absolute-for-diary (date)
+ (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date)))
+ ;; Note: For leap months M is a float.
+ (list (floor m) d (+ (* c 100) y))))
+
+(defun calendar-chinese-to-absolute-for-diary (date &optional prefer-leap)
+ (pcase-let* ((`(,m ,d ,y) date)
+ (cycle (floor y 100))
+ (year (mod y 100))
+ (months (calendar-chinese-months cycle year))
+ (lm (+ (floor m) 0.5)))
+ (calendar-chinese-to-absolute
+ (if (and prefer-leap (memql lm months))
+ (list cycle year lm d)
+ (list cycle year m d)))))
+
+(defun calendar-chinese-mark-date-pattern (month day year &optional color)
+ (calendar-mark-1 month day year
+ #'calendar-chinese-from-absolute-for-diary
+ #'calendar-chinese-to-absolute-for-diary
+ color)
+ (unless (zerop month)
+ (calendar-mark-1 month day year
+ #'calendar-chinese-from-absolute-for-diary
+ (lambda (date) (calendar-chinese-to-absolute-for-diary date t))
+ color)))
+
+;;;###cal-autoload
+(defun diary-chinese-mark-entries ()
+ "Mark days in the calendar window that have Chinese date diary entries.
+Marks each entry in `diary-file' (or included files) visible in the calendar
+window. See `diary-chinese-list-entries' for more information.
+
+This function is provided for use with `diary-nongregorian-marking-hook'."
+ (diary-mark-entries-1 #'calendar-chinese-mark-date-pattern
+ calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-list-entries ()
+ "Add any Chinese date entries from the diary file to `diary-entries-list'.
+Chinese date diary entries must be prefixed by `diary-chinese-entry-symbol'
+\(normally a `C'). The same `diary-date-forms' govern the style
+of the Chinese calendar entries. If a Chinese date diary entry begins with
+`diary-nonmarking-symbol', the entry will appear in the diary listing,
+but will not be marked in the calendar.
+
+This function is provided for use with `diary-nongregorian-listing-hook'."
+ (diary-list-entries-1 calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-anniversary (month day &optional year mark)
+ "Like `diary-anniversary' (which see) but accepts Chinese date."
+ (pcase-let* ((ddate (diary-make-date month day year))
+ (`(,dc ,dy ,dm ,dd) ;diary chinese date
+ (if year
+ (calendar-chinese-from-absolute
+ (calendar-chinese-to-absolute-for-diary ddate))
+ (list nil nil (calendar-extract-month ddate)
+ (calendar-extract-day ddate))))
+ (`(,cc ,cy ,cm ,cd) ;current chinese date
+ (calendar-chinese-from-absolute
+ (calendar-absolute-from-gregorian date)))
+ (diff (if (and dc dy)
+ (+ (* 60 (- cc dc)) (- cy dy))
+ 100)))
+ (and (> diff 0)
+ ;; The Chinese month can differ by 0.5 in a leap month.
+ (or (= dm cm) (= (+ 0.5 dm) cm))
+ (= dd cd)
+ (cons mark (format entry diff (diary-ordinal-suffix diff))))))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-anniversary-entry (&optional arg)
+ "Insert an anniversary diary entry for the Chinese date at point.
+Prefix argument ARG makes the entry nonmarking."
+ (interactive "P")
+ (let ((calendar-date-display-form (diary-date-display-form)))
+ (diary-make-entry
+ (format "%s(diary-chinese-anniversary %s)"
+ diary-sexp-entry-symbol
+ (calendar-date-string
+ (calendar-chinese-from-absolute-for-diary
+ (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
+ arg)))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-entry (&optional arg)
+ "Insert a diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 nil arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-monthly-entry (&optional arg)
+ "Insert a monthly diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 'monthly arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
+;;;###cal-autoload
+(defun diary-chinese-insert-yearly-entry (&optional arg)
+ "Insert a yearly diary entry for the Chinese date at point."
+ (interactive "P")
+ (diary-insert-entry-1 'yearly arg calendar-chinese-month-name-array
+ diary-chinese-entry-symbol
+ #'calendar-chinese-from-absolute-for-diary))
+
(provide 'cal-china)
;;; cal-china.el ends here
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index fc912971ff1..0152dcb318d 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -1,6 +1,6 @@
;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -75,9 +75,6 @@ Gregorian date Sunday, December 31, 1 BC."
(* 30 (1- month)) ; days in prior months this year
day))) ; days so far this month
-(define-obsolete-function-alias 'calendar-absolute-from-coptic
- 'calendar-coptic-to-absolute "23.1")
-
(defun calendar-coptic-from-absolute (date)
"Compute the Coptic equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
@@ -135,9 +132,6 @@ Defaults to today's date if DATE is not given."
(message "Date is pre-%s calendar" calendar-coptic-name)
(message "%s date: %s" calendar-coptic-name f))))
-(define-obsolete-function-alias 'calendar-print-coptic-date
- 'calendar-coptic-print-date "23.1")
-
(defun calendar-coptic-read-date ()
"Interactively read the arguments for a Coptic date command.
Reads a year, month, and day."
@@ -164,9 +158,6 @@ Reads a year, month, and day."
(lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
-(define-obsolete-function-alias 'coptic-prompt-for-date
- 'calendar-coptic-read-date "23.1")
-
;;;###cal-autoload
(defun calendar-coptic-goto-date (date &optional noecho)
"Move cursor to Coptic date DATE.
@@ -176,8 +167,6 @@ Echo Coptic date unless NOECHO is t."
(calendar-coptic-to-absolute date)))
(or noecho (calendar-coptic-print-date)))
-(define-obsolete-function-alias 'calendar-goto-coptic-date
- 'calendar-coptic-goto-date "23.1")
(defvar date)
@@ -208,9 +197,6 @@ Gregorian date Sunday, December 31, 1 BC."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch))
(calendar-coptic-to-absolute date)))
-(define-obsolete-function-alias 'calendar-absolute-from-ethiopic
- 'calendar-ethiopic-to-absolute "23.1")
-
(defun calendar-ethiopic-from-absolute (date)
"Compute the Ethiopic equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
@@ -238,9 +224,6 @@ Defaults to today's date if DATE is not given."
(calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
(call-interactively 'calendar-coptic-print-date)))
-(define-obsolete-function-alias 'calendar-print-ethiopic-date
- 'calendar-ethiopic-print-date "23.1")
-
;;;###cal-autoload
(defun calendar-ethiopic-goto-date (date &optional noecho)
"Move cursor to Ethiopic date DATE.
@@ -254,9 +237,6 @@ Echo Ethiopic date unless NOECHO is t."
(calendar-ethiopic-to-absolute date)))
(or noecho (calendar-ethiopic-print-date)))
-(define-obsolete-function-alias 'calendar-goto-ethiopic-date
- 'calendar-ethiopic-goto-date "23.1")
-
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-ethiopic-date ()
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index c3f3bea44e9..a0d0def61a5 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -1,6 +1,6 @@
;;; cal-dst.el --- calendar functions for daylight saving rules
-;; Copyright (C) 1993-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Paul Eggert <eggert@twinsun.com>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -82,7 +82,7 @@ list and for correcting times of day in the solar and lunar calculations.
For example, if daylight saving time ends on the last Sunday in October:
- '(calendar-nth-named-day -1 0 10 year)
+ (calendar-nth-named-day -1 0 10 year)
If the locale never uses daylight saving time, set this to nil."
:type 'sexp
@@ -179,6 +179,7 @@ Return nil if no such transition can be found."
(if (eq (car (current-time-zone probe)) hi-utc-diff)
(setq hi probe)
(setq lo probe)))
+ (setcdr hi (list (cdr hi)))
hi))))
(autoload 'calendar-persian-to-absolute "cal-persia")
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index b41aa363180..33e8e8e0618 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -1,6 +1,6 @@
;;; cal-french.el --- calendar functions for the French Revolutionary calendar
-;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2013 Free
+;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2015 Free
;; Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -129,9 +129,6 @@ Gregorian date Sunday, December 31, 1 BC."
day ; days so far this month
(1- calendar-french-epoch)))) ; days before start of calendar
-(define-obsolete-function-alias 'calendar-absolute-from-french
- 'calendar-french-to-absolute "23.1")
-
(defun calendar-french-from-absolute (date)
"Compute the French Revolutionary equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
@@ -196,9 +193,6 @@ Defaults to today's date if DATE is not given."
(message "Date is pre-French Revolution")
(message "French Revolutionary date: %s" f))))
-(define-obsolete-function-alias 'calendar-print-french-date
- 'calendar-french-print-date "23.1")
-
;;;###cal-autoload
(defun calendar-french-goto-date (date &optional noecho)
"Move cursor to French Revolutionary date DATE.
@@ -249,9 +243,6 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(calendar-french-to-absolute date)))
(or noecho (calendar-french-print-date)))
-(define-obsolete-function-alias 'calendar-goto-french-date
- 'calendar-french-goto-date "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
@@ -265,8 +256,4 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(provide 'cal-french)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; cal-french.el ends here
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 6450b413aab..8bb1b88ee62 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,6 +1,6 @@
;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -32,9 +32,6 @@
(require 'calendar)
-(define-obsolete-variable-alias 'diary-sabbath-candles-minutes
- 'diary-hebrew-sabbath-candles-minutes "23.1")
-
(defcustom diary-hebrew-sabbath-candles-minutes 18
"Number of minutes before sunset for sabbath candle lighting.
Used by `diary-hebrew-sabbath-candles'."
@@ -136,9 +133,6 @@ Gregorian date Sunday, December 31, 1 BC."
(calendar-hebrew-elapsed-days year) ; days in prior years
-1373429))) ; days elapsed before absolute date 1
-(define-obsolete-function-alias 'calendar-absolute-from-hebrew
- 'calendar-hebrew-to-absolute "23.1")
-
(defun calendar-hebrew-from-absolute (date)
"Compute the Hebrew date (month day year) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
@@ -194,9 +188,6 @@ Driven by the variable `calendar-date-display-form'."
(message "Hebrew date (until sunset): %s"
(calendar-hebrew-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-hebrew-date
- 'calendar-hebrew-print-date "23.1")
-
(defun calendar-hebrew-yahrzeit (death-date year)
"Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
(let ((death-day (calendar-extract-day death-date))
@@ -230,9 +221,6 @@ Driven by the variable `calendar-date-display-form'."
(t (calendar-hebrew-to-absolute
(list death-month death-day year))))))
-(define-obsolete-function-alias 'hebrew-calendar-yahrzeit
- 'calendar-hebrew-yahrzeit "23.1")
-
(defun calendar-hebrew-read-date ()
"Interactively read the arguments for a Hebrew date command.
Reads a year, month, and day."
@@ -284,9 +272,6 @@ Reads a year, month, and day."
(calendar-hebrew-to-absolute date)))
(or noecho (calendar-hebrew-print-date)))
-(define-obsolete-function-alias 'calendar-goto-hebrew-date
- 'calendar-hebrew-goto-date "23.1")
-
(defvar displayed-month) ; from calendar-generate
(defun calendar-hebrew-date-is-visible-p (month day)
@@ -398,10 +383,6 @@ or ALL is non-nil."
"Hoshanah Rabbah"))))))))
;;;###holiday-autoload
-(define-obsolete-function-alias 'holiday-rosh-hashanah-etc
- 'holiday-hebrew-rosh-hashanah "23.1")
-
-;;;###holiday-autoload
(defun holiday-hebrew-hanukkah (&optional all)
"List of dates related to Hanukkah, as visible in calendar window.
Shows only Hanukkah, unless `calendar-hebrew-all-holidays-flag' or ALL
@@ -434,10 +415,6 @@ is non-nil."
(list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah")))))))
;;;###holiday-autoload
-(define-obsolete-function-alias 'holiday-hanukkah
- 'holiday-hebrew-hanukkah "23.1")
-
-;;;###holiday-autoload
(defun holiday-hebrew-passover (&optional all)
"List of dates related to Passover, as visible in calendar window.
Shows only the major holidays, unless `calendar-hebrew-all-holidays-flag'
@@ -520,10 +497,6 @@ or ALL is non-nil."
"Shavuot (second day)")))))))))
;;;###holiday-autoload
-(define-obsolete-function-alias 'holiday-passover-etc
- 'holiday-hebrew-passover "23.1")
-
-;;;###holiday-autoload
(defun holiday-hebrew-tisha-b-av ()
"List of dates around Tisha B'Av, as visible in calendar window."
(when (memq displayed-month '(5 6 7 8 9))
@@ -545,10 +518,6 @@ or ALL is non-nil."
(calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
"Shabbat Nahamu"))))))
-;;;###holiday-autoload
-(define-obsolete-function-alias 'holiday-tisha-b-av-etc
- 'holiday-hebrew-tisha-b-av "23.1")
-
(autoload 'holiday-julian "cal-julian")
;;;###holiday-autoload
@@ -634,9 +603,6 @@ is provided for use with `diary-nongregorian-listing-hook'."
(diary-list-entries-1 calendar-hebrew-month-name-array-leap-year
diary-hebrew-entry-symbol
'calendar-hebrew-from-absolute))
-;;;###diary-autoload
-(define-obsolete-function-alias 'list-hebrew-diary-entries
- 'diary-hebrew-list-entries "23.1")
(autoload 'calendar-mark-complex "diary-lib")
@@ -645,7 +611,7 @@ is provided for use with `diary-nongregorian-listing-hook'."
"Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
passed to `calendar-mark-visible-date' as MARK."
- ;; FIXME not the same as the Bahai and Islamic cases, so can't use
+ ;; FIXME not the same as the Bahá’í and Islamic cases, so can't use
;; calendar-mark-1.
(with-current-buffer calendar-buffer
(if (and (not (zerop month)) (not (zerop day)))
@@ -662,10 +628,6 @@ passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-complex month day year
'calendar-hebrew-from-absolute color))))
-;;;###diary-autoload
-(define-obsolete-function-alias 'mark-hebrew-calendar-date-pattern
- 'calendar-hebrew-mark-date-pattern "23.1")
-
(autoload 'diary-mark-entries-1 "diary-lib")
;;;###diary-autoload
@@ -678,10 +640,6 @@ window. See `list-hebrew-diary-entries' for more information."
diary-hebrew-entry-symbol
'calendar-hebrew-from-absolute))
-;;;###diary-autoload
-(define-obsolete-function-alias 'mark-hebrew-diary-entries
- 'diary-hebrew-mark-entries "23.1")
-
(autoload 'diary-insert-entry-1 "diary-lib")
;;;###cal-autoload
@@ -693,10 +651,6 @@ Prefix argument ARG makes the entry nonmarking."
diary-hebrew-entry-symbol
'calendar-hebrew-from-absolute))
-;;;###diary-autoload
-(define-obsolete-function-alias 'insert-hebrew-diary-entry
- 'diary-hebrew-insert-entry "23.1")
-
;;;###cal-autoload
(defun diary-hebrew-insert-monthly-entry (arg)
"Insert a monthly diary entry.
@@ -706,9 +660,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-insert-entry-1 'monthly arg calendar-hebrew-month-name-array-leap-year
diary-hebrew-entry-symbol
'calendar-hebrew-from-absolute))
-;;;###diary-autoload
-(define-obsolete-function-alias 'insert-monthly-hebrew-diary-entry
- 'diary-hebrew-insert-monthly-entry "23.1")
;;;###cal-autoload
(defun diary-hebrew-insert-yearly-entry (arg)
@@ -719,9 +670,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-insert-entry-1 'yearly arg calendar-hebrew-month-name-array-leap-year
diary-hebrew-entry-symbol
'calendar-hebrew-from-absolute))
-;;;###diary-autoload
-(define-obsolete-function-alias 'insert-yearly-hebrew-diary-entry
- 'diary-hebrew-insert-yearly-entry "23.1")
;;;###autoload
(defun calendar-hebrew-list-yahrzeits (death-date start-year end-year)
@@ -786,10 +734,6 @@ from the cursor position."
(calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))))
(message "Computing Yahrzeits...done"))
-;;;###autoload
-(define-obsolete-function-alias 'list-yahrzeit-dates
- 'calendar-hebrew-list-yahrzeits "23.1")
-
(defun calendar-hebrew-birthday (date year)
"Absolute date of the anniversary of Hebrew birth DATE, in Hebrew YEAR."
(let ((b-day (calendar-extract-day date))
@@ -869,8 +813,6 @@ use when highlighting the day in the calendar."
""
(format " and %d day%s"
day (if (= day 1) "" "s"))))))))))
-;;;###diary-autoload
-(define-obsolete-function-alias 'diary-omer 'diary-hebrew-omer "23.1")
(autoload 'diary-make-date "diary-lib")
@@ -912,9 +854,6 @@ use when highlighting the day in the calendar."
(diary-ordinal-suffix diff))))))
;;;###diary-autoload
-(define-obsolete-function-alias 'diary-yahrzeit 'diary-hebrew-yahrzeit "23.1")
-
-;;;###diary-autoload
(defun diary-hebrew-rosh-hodesh (&optional mark)
"Rosh Hodesh diary entry.
Entry applies if date is Rosh Hodesh, the day before, or the Saturday before.
@@ -976,9 +915,6 @@ use when highlighting the day in the calendar."
(calendar-hebrew-last-month-of-year
h-year))
0 h-month)))))))))
-;;;###diary-autoload
-(define-obsolete-function-alias 'diary-rosh-hodesh
- 'diary-hebrew-rosh-hodesh "23.1")
(defconst calendar-hebrew-parashiot-names
["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth"
@@ -1166,8 +1102,6 @@ use when highlighting the day in the calendar."
(cdr parasha))))
(calendar-hebrew-parasha-name parasha)))))))))
-(define-obsolete-function-alias 'diary-parasha 'diary-hebrew-parasha "23.1")
-
(declare-function solar-setup "solar" ())
(declare-function solar-sunrise-sunset "solar" (date))
@@ -1199,10 +1133,6 @@ use when highlighting the day in the calendar."
60.0))
(cdr sunset)))))))))
-;;;###diary-autoload
-(define-obsolete-function-alias 'diary-sabbath-candles
- 'diary-hebrew-sabbath-candles "23.1")
-
(provide 'cal-hebrew)
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index c463b6e27f8..4bddc384895 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -1,6 +1,6 @@
;;; cal-html.el --- functions for printing HTML calendars
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Anna M. Bigatti <bigatti@dima.unige.it>
;; Keywords: calendar
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index 342d1951823..8e287526b5f 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -1,6 +1,6 @@
;;; cal-islam.el --- calendar functions for the Islamic calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -87,9 +87,6 @@ Gregorian date Sunday, December 31, 1 BC."
leap-years-in-cycle ; leap days this cycle
(1- calendar-islamic-epoch)))) ; days before start of calendar
-(define-obsolete-function-alias 'calendar-absolute-from-islamic
- 'calendar-islamic-to-absolute "23.1")
-
(defun calendar-islamic-from-absolute (date)
"Compute the Islamic date (month day year) corresponding to absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
@@ -141,9 +138,6 @@ Driven by the variable `calendar-date-display-form'."
(message "Date is pre-Islamic")
(message "Islamic date (until sunset): %s" i))))
-(define-obsolete-function-alias 'calendar-print-islamic-date
- 'calendar-islamic-print-date "23.1")
-
(defun calendar-islamic-read-date ()
"Interactively read the arguments for an Islamic date command.
Reads a year, month, and day."
@@ -177,9 +171,6 @@ Reads a year, month, and day."
(calendar-islamic-to-absolute date)))
(or noecho (calendar-islamic-print-date)))
-(define-obsolete-function-alias 'calendar-goto-islamic-date
- 'calendar-islamic-goto-date "23.1")
-
(defvar displayed-month) ; from calendar-generate
(defvar displayed-year)
@@ -260,9 +251,6 @@ marked in the calendar. This function is provided for use with
diary-islamic-entry-symbol
'calendar-islamic-from-absolute))
-(define-obsolete-function-alias 'list-islamic-diary-entries
- 'diary-islamic-list-entries "23.1")
-
(autoload 'calendar-mark-1 "diary-lib")
;;;###diary-autoload
@@ -273,9 +261,6 @@ passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-1 month day year 'calendar-islamic-from-absolute
'calendar-islamic-to-absolute color))
-(define-obsolete-function-alias 'mark-islamic-calendar-date-pattern
- 'calendar-islamic-mark-date-pattern "23.1")
-
(autoload 'diary-mark-entries-1 "diary-lib")
;;;###diary-autoload
@@ -288,9 +273,6 @@ window. See `diary-islamic-list-entries' for more information."
diary-islamic-entry-symbol
'calendar-islamic-from-absolute))
-(define-obsolete-function-alias
- 'mark-islamic-diary-entries 'diary-islamic-mark-entries "23.1")
-
(autoload 'diary-insert-entry-1 "diary-lib")
;;;###cal-autoload
@@ -303,9 +285,6 @@ Prefix argument ARG makes the entry nonmarking."
diary-islamic-entry-symbol
'calendar-islamic-from-absolute))
-(define-obsolete-function-alias 'insert-islamic-diary-entry
- 'diary-islamic-insert-entry "23.1")
-
;;;###cal-autoload
(defun diary-islamic-insert-monthly-entry (arg)
"Insert a monthly diary entry.
@@ -316,9 +295,6 @@ Prefix argument ARG makes the entry nonmarking."
diary-islamic-entry-symbol
'calendar-islamic-from-absolute))
-(define-obsolete-function-alias 'insert-monthly-islamic-diary-entry
- 'diary-islamic-insert-monthly-entry "23.1")
-
;;;###cal-autoload
(defun diary-islamic-insert-yearly-entry (arg)
"Insert an annual diary entry.
@@ -328,8 +304,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-insert-entry-1 'yearly arg calendar-islamic-month-name-array
diary-islamic-entry-symbol
'calendar-islamic-from-absolute))
-(define-obsolete-function-alias
- 'insert-yearly-islamic-diary-entry 'diary-islamic-insert-yearly-entry "23.1")
(defvar date)
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 3db7295e70d..f3cc430590f 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,6 +1,6 @@
;;; cal-iso.el --- calendar functions for the ISO calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -47,9 +47,6 @@ Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary."
(* 7 (1- (calendar-extract-month date)))
(if (zerop day) 6 (1- day)))))
-(define-obsolete-function-alias 'calendar-absolute-from-iso
- 'calendar-iso-to-absolute "23.1")
-
;;;###cal-autoload
(defun calendar-iso-from-absolute (date)
"Compute the `ISO commercial date' corresponding to the absolute DATE.
@@ -91,9 +88,6 @@ date Sunday, December 31, 1 BC."
(message "ISO date: %s"
(calendar-iso-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-iso-date
- 'calendar-iso-print-date "23.1")
-
(defun calendar-iso-read-date (&optional dayflag)
"Interactively read the arguments for an ISO date command.
Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
@@ -118,9 +112,6 @@ taken to be 1)."
1)))
(list (list week day year))))
-(define-obsolete-function-alias 'calendar-iso-read-args
- 'calendar-iso-read-date "23.1")
-
;;;###cal-autoload
(defun calendar-iso-goto-date (date &optional noecho)
"Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil."
@@ -129,9 +120,6 @@ taken to be 1)."
(calendar-iso-to-absolute date)))
(or noecho (calendar-iso-print-date)))
-(define-obsolete-function-alias 'calendar-goto-iso-date
- 'calendar-iso-goto-date "23.1")
-
;;;###cal-autoload
(defun calendar-iso-goto-week (date &optional noecho)
"Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil.
@@ -141,9 +129,6 @@ Interactively, goes to the first day of the specified week."
(calendar-iso-to-absolute date)))
(or noecho (calendar-iso-print-date)))
-(define-obsolete-function-alias 'calendar-goto-iso-week
- 'calendar-iso-goto-week "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 86476826370..3cfa612d0a1 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,6 +1,6 @@
;;; cal-julian.el --- calendar functions for the Julian calendar
-;; Copyright (C) 1995, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -45,9 +45,6 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
(/ (1- year) 4)
-2)))
-(define-obsolete-function-alias 'calendar-absolute-from-julian
- 'calendar-julian-to-absolute "23.1")
-
;;;###cal-autoload
(defun calendar-julian-from-absolute (date)
"Compute the Julian (month day year) corresponding to the absolute DATE.
@@ -93,9 +90,6 @@ Driven by the variable `calendar-date-display-form'."
(message "Julian date: %s"
(calendar-julian-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-julian-date
- 'calendar-julian-print-date "23.1")
-
;;;###cal-autoload
(defun calendar-julian-goto-date (date &optional noecho)
"Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil."
@@ -132,9 +126,6 @@ Driven by the variable `calendar-date-display-form'."
(calendar-julian-to-absolute date)))
(or noecho (calendar-julian-print-date)))
-(define-obsolete-function-alias 'calendar-goto-julian-date
- 'calendar-julian-goto-date "23.1")
-
;;;###holiday-autoload
(defun holiday-julian (month day string)
"Holiday on MONTH, DAY (Julian) called STRING.
@@ -156,9 +147,6 @@ nil if it is not visible in the current calendar window."
"Absolute date of astronomical (Julian) day number D."
(- d 1721424.5))
-(define-obsolete-function-alias 'calendar-absolute-from-astro
- 'calendar-astro-to-absolute "23.1")
-
;;;###cal-autoload
(defun calendar-astro-from-absolute (d)
"Astronomical (Julian) day number of absolute date D."
@@ -181,9 +169,6 @@ Defaults to today's date if DATE is not given."
"Astronomical (Julian) day number (at noon UTC): %s.0"
(calendar-astro-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-astro-day-number
- 'calendar-astro-print-day-number "23.1")
-
;;;###cal-autoload
(defun calendar-astro-goto-day-number (daynumber &optional noecho)
"Move cursor to astronomical (Julian) DAYNUMBER.
@@ -197,8 +182,6 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
-(define-obsolete-function-alias 'calendar-goto-astro-day-number
- 'calendar-astro-goto-day-number "23.1")
(defvar date)
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index dd09a116a7c..cf3fc064b6a 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -1,6 +1,6 @@
;;; cal-mayan.el --- calendar functions for the Mayan calendars
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2013 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
@@ -132,9 +132,6 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(message "Mayan date: %s"
(calendar-mayan-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-mayan-date
- 'calendar-mayan-print-date "23.1")
-
(defun calendar-mayan-read-haab-date ()
"Prompt for a Mayan haab date."
(let* ((completion-ignore-case t)
@@ -179,9 +176,6 @@ Echo Mayan date unless NOECHO is non-nil."
(calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-mayan-print-date)))
-(define-obsolete-function-alias 'calendar-next-haab-date
- 'calendar-mayan-next-haab-date "23.1")
-
;;;###cal-autoload
(defun calendar-mayan-previous-haab-date (haab-date &optional noecho)
"Move cursor to previous instance of Mayan HAAB-DATE.
@@ -194,9 +188,6 @@ Echo Mayan date unless NOECHO is non-nil."
(1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-mayan-print-date)))
-(define-obsolete-function-alias 'calendar-previous-haab-date
- 'calendar-mayan-previous-haab-date "23.1")
-
(defun calendar-mayan-haab-to-string (haab)
"Convert Mayan HAAB date (a pair) into its traditional written form."
(let ((month (cdr haab)))
@@ -247,9 +238,6 @@ Echo Mayan date unless NOECHO is non-nil."
(calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-mayan-print-date)))
-(define-obsolete-function-alias 'calendar-next-tzolkin-date
- 'calendar-mayan-next-tzolkin-date "23.1")
-
;;;###cal-autoload
(defun calendar-mayan-previous-tzolkin-date (tzolkin-date &optional noecho)
"Move cursor to previous instance of Mayan TZOLKIN-DATE.
@@ -262,9 +250,6 @@ Echo Mayan date unless NOECHO is non-nil."
(1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
(or noecho (calendar-mayan-print-date)))
-(define-obsolete-function-alias 'calendar-previous-tzolkin-date
- 'calendar-mayan-previous-tzolkin-date "23.1")
-
(defun calendar-mayan-tzolkin-to-string (tzolkin)
"Convert Mayan TZOLKIN date (a pair) into its traditional written form."
(format "%d %s"
@@ -309,9 +294,6 @@ Echo Mayan date unless NOECHO is non-nil."
(calendar-goto-date (calendar-gregorian-from-absolute date))
(or noecho (calendar-mayan-print-date)))))
-(define-obsolete-function-alias 'calendar-next-calendar-round-date
- 'calendar-mayan-next-round-date "23.1")
-
;;;###cal-autoload
(defun calendar-mayan-previous-round-date
(tzolkin-date haab-date &optional noecho)
@@ -330,9 +312,6 @@ Echo Mayan date unless NOECHO is non-nil."
(calendar-goto-date (calendar-gregorian-from-absolute date))
(or noecho (calendar-mayan-print-date)))))
-(define-obsolete-function-alias 'calendar-previous-calendar-round-date
- 'calendar-mayan-previous-round-date "23.1")
-
(defun calendar-mayan-long-count-to-absolute (c)
"Compute the absolute date corresponding to the Mayan Long Count C.
Long count is a list (baktun katun tun uinal kin)"
@@ -344,9 +323,6 @@ Long count is a list (baktun katun tun uinal kin)"
;; Days before absolute date 0.
(- calendar-mayan-days-before-absolute-zero)))
-(define-obsolete-function-alias 'calendar-absolute-from-mayan-long-count
- 'calendar-mayan-long-count-to-absolute "23.1")
-
(defun calendar-mayan-long-count-common-era (lc)
"Return non-nil if long count LC represents a date in the Common Era."
(let ((base (calendar-mayan-long-count-from-absolute 1)))
@@ -377,9 +353,6 @@ Echo Mayan date unless NOECHO is non-nil."
(calendar-mayan-long-count-to-absolute date)))
(or noecho (calendar-mayan-print-date)))
-(define-obsolete-function-alias 'calendar-goto-mayan-long-count-date
- 'calendar-mayan-goto-long-count-date "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index c58eecbdc06..211f16c22f7 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,6 +1,6 @@
;;; cal-menu.el --- calendar functions for menu bar and popup menu support
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
@@ -52,10 +52,15 @@
["Insert Anniversary" diary-insert-anniversary-entry]
["Insert Block" diary-insert-block-entry]
["Insert Cyclic" diary-insert-cyclic-entry]
- ("Insert Bahá'í"
+ ("Insert Bahá’í"
["One time" diary-bahai-insert-entry]
["Monthly" diary-bahai-insert-monthly-entry]
["Yearly" diary-bahai-insert-yearly-entry])
+ ("Insert Chinese"
+ ["One time" diary-chinese-insert-entry]
+ ["Monthly" diary-chinese-insert-monthly-entry]
+ ["Yearly" diary-chinese-insert-yearly-entry]
+ ["Anniversary" diary-chinese-insert-anniversary-entry])
("Insert Islamic"
["One time" diary-islamic-insert-entry]
["Monthly" diary-islamic-insert-monthly-entry]
@@ -127,7 +132,7 @@
["Astronomical Date" calendar-astro-goto-day-number]
["Hebrew Date" calendar-hebrew-goto-date]
["Persian Date" calendar-persian-goto-date]
- ["Bahá'í Date" calendar-bahai-goto-date]
+ ["Bahá’í Date" calendar-bahai-goto-date]
["Islamic Date" calendar-islamic-goto-date]
["Julian Date" calendar-julian-goto-date]
["Chinese Date" calendar-chinese-goto-date]
@@ -273,18 +278,6 @@ is non-nil."
["Show diary" diary-show-all-entries]
["Exit calendar" calendar-exit]))
-;; Undocumented and probably useless.
-(defvar cal-menu-load-hook nil
- "Hook run on loading of the `cal-menu' package.")
-(make-obsolete-variable 'cal-menu-load-hook
- "it will be removed in future." "23.1")
-
-(run-hooks 'cal-menu-load-hook)
-
(provide 'cal-menu)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; cal-menu.el ends here
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 111fcfa5e1d..f7bae5f6441 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,6 +1,6 @@
;;; cal-move.el --- calendar functions for movement in the calendar
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -175,9 +175,6 @@ EVENT is an event like `last-nonmenu-event'."
(t (list month 1 year))))))
(run-hooks 'calendar-move-hook)))
-(define-obsolete-function-alias
- 'scroll-calendar-left 'calendar-scroll-left "23.1")
-
;;;###cal-autoload
(defun calendar-scroll-right (&optional arg event)
"Scroll the displayed calendar window right by ARG months.
@@ -188,9 +185,6 @@ EVENT is an event like `last-nonmenu-event'."
last-nonmenu-event))
(calendar-scroll-left (- (or arg 1)) event))
-(define-obsolete-function-alias
- 'scroll-calendar-right 'calendar-scroll-right "23.1")
-
;;;###cal-autoload
(defun calendar-scroll-left-three-months (arg &optional event)
"Scroll the displayed calendar window left by 3*ARG months.
@@ -201,9 +195,6 @@ EVENT is an event like `last-nonmenu-event'."
last-nonmenu-event))
(calendar-scroll-left (* 3 arg) event))
-(define-obsolete-function-alias 'scroll-calendar-left-three-months
- 'calendar-scroll-left-three-months "23.1")
-
;; cf scroll-bar-toolkit-scroll
;;;###cal-autoload
(defun calendar-scroll-toolkit-scroll (event)
@@ -226,9 +217,6 @@ EVENT is an event like `last-nonmenu-event'."
last-nonmenu-event))
(calendar-scroll-left (* -3 arg) event))
-(define-obsolete-function-alias 'scroll-calendar-right-three-months
- 'calendar-scroll-right-three-months "23.1")
-
;;;###cal-autoload
(defun calendar-forward-day (arg)
"Move the cursor forward ARG days.
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index 9a0fb77e7e1..542dea64e03 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -1,6 +1,6 @@
;;; cal-persia.el --- calendar functions for the Persian calendar
-;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -87,9 +87,6 @@ Gregorian date Sunday, December 31, 1 BC."
(calendar-persian-last-day-of-month m year))
day)))) ; days so far this month
-(define-obsolete-function-alias 'calendar-absolute-from-persian
- 'calendar-persian-to-absolute "23.1")
-
(defun calendar-persian-year-from-absolute (date)
"Persian year corresponding to the absolute DATE."
(let* ((d0 ; prior days since start of 2820 cycles
@@ -163,9 +160,6 @@ Gregorian date Sunday, December 31, 1 BC."
(message "Persian date: %s"
(calendar-persian-date-string (calendar-cursor-to-date t))))
-(define-obsolete-function-alias 'calendar-print-persian-date
- 'calendar-persian-print-date "23.1")
-
(defun calendar-persian-read-date ()
"Interactively read the arguments for a Persian date command.
Reads a year, month, and day."
@@ -192,9 +186,6 @@ Reads a year, month, and day."
(lambda (x) (and (< 0 x) (<= x last))))))
(list (list month day year))))
-(define-obsolete-function-alias 'persian-prompt-for-date
- 'calendar-persian-read-date "23.1")
-
;;;###cal-autoload
(defun calendar-persian-goto-date (date &optional noecho)
"Move cursor to Persian date DATE.
@@ -204,8 +195,6 @@ Echo Persian date unless NOECHO is non-nil."
(calendar-persian-to-absolute date)))
(or noecho (calendar-persian-print-date)))
-(define-obsolete-function-alias 'calendar-goto-persian-date
- 'calendar-persian-goto-date "23.1")
(defvar date)
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index b7497e38242..e512faef15e 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1,6 +1,6 @@
;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Steve Fisk <fisk@bowdoin.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -100,7 +100,7 @@ At present, this only affects the daily filofax calendar."
(format "%d/%d" day days-remaining))
"Lisp expression giving the date format to use in the LaTeX calendars.
This should be an expression involving the variable `date'. When
-this expression is called, `date' is a list of the form '(MONTH DAY YEAR)'.
+this expression is called, `date' is a list of the form `(MONTH DAY YEAR)'.
The string resulting from evaluating this expression is placed at
the bottom center of each date in monthly calendars, next to the
@@ -151,7 +151,7 @@ For example, to include extra packages:
"List of functions called after any LaTeX calendar buffer is generated.
You can use this to do post-processing on the buffer. For example, to change
characters with diacritical marks to their LaTeX equivalents, use
- (add-hook 'cal-tex-hook
+ (add-hook \\='cal-tex-hook
(lambda () (iso-iso2tex (point-min) (point-max))))"
:type 'hook
:group 'calendar-tex)
@@ -1602,7 +1602,7 @@ informative header, and run HOOK."
(goto-char (point-min))
(when (search-forward "documentclass" nil t)
(forward-line 1)
- ;; Eg for some Bahai holidays.
+ ;; E.g., for some Bahá’í holidays.
;; FIXME latin1 might not always be right.
(insert "\\usepackage[latin1]{inputenc}\n"))))
(latex-mode)
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 4a13602ec0f..22daa46fb14 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,6 +1,6 @@
;;; cal-x.el --- calendar windows in dedicated frames
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -65,9 +65,6 @@ Relevant if `calendar-setup' has the value `one-frame'."
(vertical-scroll-bars boolean))
:group 'calendar)
-(define-obsolete-variable-alias 'calendar-after-frame-setup-hooks
- 'calendar-after-frame-setup-hook "23.1")
-
(defcustom calendar-after-frame-setup-hook nil
"List of functions to be run after creating a calendar and/or diary frame."
:type 'hook
@@ -96,13 +93,9 @@ Runs `calendar-after-frame-setup-hook', selects frame, iconifies if needed."
"Display and dedicate the window associated with the diary buffer."
(set-window-dedicated-p
(display-buffer
- (if (if (listp diary-display-function)
- (or (memq 'diary-fancy-display diary-display-function)
- (memq 'fancy-diary-display diary-display-function))
- (memq diary-display-function '(diary-fancy-display
- fancy-diary-display)))
+ (if (eq diary-display-function 'diary-fancy-display)
(progn
- ;; If there are no diary entries, there won't be a fancy-diary
+ ;; If there are no diary entries, there won't be a buffer
;; to dedicate, so make a basic one.
(or (get-buffer diary-fancy-buffer)
(calendar-in-read-only-buffer diary-fancy-buffer
@@ -150,36 +143,6 @@ If PROMPT is non-nil, prompt for the month and year to use."
(if (eq config 'one-frame)
(calendar-dedicate-diary))))))
-
-;;;###cal-autoload
-(defun calendar-one-frame-setup (&optional prompt)
- "Display calendar and diary in a single dedicated frame.
-See `calendar-frame-setup' for more information."
- (declare (obsolete calendar-frame-setup "23.1"))
- (calendar-frame-setup 'one-frame prompt))
-
-;;;###cal-autoload
-(defun calendar-only-one-frame-setup (&optional prompt)
- "Display calendar in a dedicated frame.
-See `calendar-frame-setup' for more information."
- (declare (obsolete calendar-frame-setup "23.1"))
- (calendar-frame-setup 'calendar-only prompt))
-
-;;;###cal-autoload
-(defun calendar-two-frame-setup (&optional prompt)
- "Display calendar and diary in separate, dedicated frames.
-See `calendar-frame-setup' for more information."
- (declare (obsolete calendar-frame-setup "23.1"))
- (calendar-frame-setup 'two-frames prompt))
-
-;; Undocumented and probably useless.
-(defvar cal-x-load-hook nil
- "Hook run on loading of the `cal-x' package.")
-(make-obsolete-variable 'cal-x-load-hook "it will be removed in future." "23.1")
-
-(run-hooks 'cal-x-load-hook)
-
-
(provide 'cal-x)
;;; cal-x.el ends here
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index e1f85832dc4..6c1b4c258e9 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,6 +1,6 @@
;;; calendar.el --- calendar functions
-;; Copyright (C) 1988-1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1988-1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -42,7 +42,7 @@
;; can be translated from the (usual) Gregorian calendar to the day of
;; the year/days remaining in year, to the ISO commercial calendar, to
;; the Julian (old style) calendar, to the Hebrew calendar, to the
-;; Islamic calendar, to the Bahá'í calendar, to the French
+;; Islamic calendar, to the Bahá’í calendar, to the French
;; Revolutionary calendar, to the Mayan calendar, to the Chinese
;; calendar, to the Coptic calendar, to the Ethiopic calendar, and to
;; the astronomical (Julian) day number. Times of sunrise/sunset can
@@ -53,7 +53,7 @@
;; The following files are part of the calendar/diary code:
;; appt.el Appointment notification
-;; cal-bahai.el Bahá'í calendar
+;; cal-bahai.el Bahá’í calendar
;; cal-china.el Chinese calendar
;; cal-coptic.el Coptic/Ethiopic calendars
;; cal-dst.el Daylight saving time rules
@@ -190,8 +190,15 @@ movement commands will not work correctly."
(calendar-redraw))
:group 'calendar)
-(define-obsolete-variable-alias 'view-diary-entries-initially
- 'calendar-view-diary-initially-flag "23.1")
+(defcustom calendar-weekend-days '(0 6)
+ "Days of the week considered weekend days.
+0 means Sunday, 1 means Monday, and so on.
+
+Determines which day headers are fontified with
+`calendar-weekend-header'."
+ :type '(repeat integer)
+ :version "25.1"
+ :group 'calendar)
(defcustom calendar-view-diary-initially-flag nil
"Non-nil means display current date's diary entries on entry to calendar.
@@ -202,9 +209,6 @@ be overridden by the value of `calendar-setup'."
:type 'boolean
:group 'diary)
-(define-obsolete-variable-alias 'mark-diary-entries-in-calendar
- 'calendar-mark-diary-entries-flag "23.1")
-
;; FIXME :set
(defcustom calendar-mark-diary-entries-flag nil
"Non-nil means mark dates with diary entries, in the calendar window.
@@ -226,8 +230,6 @@ If nil, make an icon of the frame. If non-nil, delete the frame."
See the variable `calendar-today-marker'."
:group 'calendar-faces)
-(define-obsolete-face-alias 'calendar-today-face 'calendar-today "22.1")
-
(defface diary
'((((min-colors 88) (class color) (background light))
:foreground "red1")
@@ -244,8 +246,6 @@ Used to mark diary entries in the calendar (see `diary-entry-marker'),
and to highlight the date header in the fancy diary."
:group 'calendar-faces)
-(define-obsolete-face-alias 'diary-face 'diary "22.1")
-
(defface holiday
'((((class color) (background light))
:background "pink")
@@ -257,8 +257,6 @@ and to highlight the date header in the fancy diary."
See `calendar-holiday-marker'."
:group 'calendar-faces)
-(define-obsolete-face-alias 'holiday-face 'holiday "22.1")
-
(defface calendar-weekday-header '((t :inherit font-lock-constant-face))
"Face used for weekday column headers in the calendar.
See also the face `calendar-weekend-header'."
@@ -308,9 +306,6 @@ The value can be either a single-character string (e.g. \"*\") or a face."
:group 'holidays
:version "23.1")
-(define-obsolete-variable-alias 'view-calendar-holidays-initially
- 'calendar-view-holidays-initially-flag "23.1")
-
(defcustom calendar-view-holidays-initially-flag nil
"Non-nil means display holidays for current three month period on entry.
The holidays are displayed in another window when the calendar is first
@@ -318,9 +313,6 @@ displayed."
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'mark-holidays-in-calendar
- 'calendar-mark-holidays-flag "23.1")
-
;; FIXME :set
(defcustom calendar-mark-holidays-flag nil
"Non-nil means mark dates of holidays in the calendar window.
@@ -339,9 +331,6 @@ This is the place to add key bindings to `calendar-mode-map'."
:type 'hook
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'initial-calendar-window-hook
- 'calendar-initial-window-hook "23.1")
-
(defcustom calendar-initial-window-hook nil
"List of functions to be called when the calendar window is created.
Quitting the calendar and re-entering it will cause these functions
@@ -349,9 +338,6 @@ to be called again."
:type 'hook
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'today-visible-calendar-hook
- 'calendar-today-visible-hook "23.1")
-
(defcustom calendar-today-visible-hook nil
"List of functions called whenever the current date is visible.
To mark today's date, add the function `calendar-mark-today'.
@@ -364,9 +350,6 @@ since it may cause the movement commands to fail."
:options '(calendar-mark-today calendar-star-date)
:group 'calendar-hooks)
-(define-obsolete-variable-alias 'today-invisible-calendar-hook
- 'calendar-today-invisible-hook "23.1")
-
(defcustom calendar-today-invisible-hook nil
"List of functions called whenever the current date is not visible.
See also `calendar-today-visible-hook'."
@@ -377,7 +360,7 @@ See also `calendar-today-visible-hook'."
"List of functions called whenever the cursor moves in the calendar.
For example,
- (add-hook 'calendar-move-hook (lambda () (diary-view-entries 1)))
+ (add-hook \\='calendar-move-hook (lambda () (diary-view-entries 1)))
redisplays the diary for whatever date the cursor is moved to."
:type 'hook
@@ -392,7 +375,7 @@ When this expression is evaluated, DAY, MONTH, and YEAR are
integers appropriate to the relevant date. For example, to
display the ISO date:
- (setq calendar-date-echo-text '(format \"ISO date: %s\"
+ (setq calendar-date-echo-text \\='(format \"ISO date: %s\"
(calendar-iso-date-string
(list month day year))))
Changing this variable without using customize has no effect on
@@ -567,12 +550,12 @@ For example, to display the ISO week numbers:
(setq calendar-week-start-day 1
calendar-intermonth-text
- '(propertize
+ \\='(propertize
(format \"%2d\"
(car
(calendar-iso-from-absolute
(calendar-absolute-from-gregorian (list month day year)))))
- 'font-lock-face 'font-lock-function-name-face))
+ \\='font-lock-face \\='font-lock-function-name-face))
See also `calendar-intermonth-header'."
:group 'calendar
@@ -593,7 +576,7 @@ See also `calendar-intermonth-header'."
'font-lock-face 'font-lock-function-name-face)))
:version "23.1")
-(defcustom diary-file "~/diary"
+(defcustom diary-file (locate-user-emacs-file "diary" "diary")
"Name of the file in which one's personal diary of dates is kept.
The file's entries are lines beginning with any of the forms
@@ -672,7 +655,7 @@ causes the diary entry \"Vacation\" to appear from November 1 through
November 10, 1990. See the documentation for the function
`diary-list-sexp-entries' for more details.
-Diary entries based on the Hebrew, the Islamic and/or the Bahá'í
+Diary entries based on the Hebrew, the Islamic and/or the Bahá’í
calendar are also possible, but because these are somewhat slow, they
are ignored unless you set the `diary-nongregorian-listing-hook' and
the `diary-nongregorian-marking-hook' appropriately. See the
@@ -680,6 +663,7 @@ documentation of these hooks for details.
Diary files can contain directives to include the contents of other files; for
details, see the documentation for the variable `diary-list-entries-hook'."
+ :version "25.1" ; ~/diary -> locate-user-emacs-file
:type 'file
:group 'diary)
@@ -689,54 +673,28 @@ details, see the documentation for the variable `diary-list-entries-hook'."
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'hebrew-diary-entry-symbol
- 'diary-hebrew-entry-symbol "23.1")
+(defcustom diary-chinese-entry-symbol "C"
+ "Symbol indicating a diary entry according to the Chinese calendar."
+ :type 'string
+ :group 'diary
+ :version "25.1")
(defcustom diary-hebrew-entry-symbol "H"
"Symbol indicating a diary entry according to the Hebrew calendar."
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'islamic-diary-entry-symbol
- 'diary-islamic-entry-symbol "23.1")
-
(defcustom diary-islamic-entry-symbol "I"
"Symbol indicating a diary entry according to the Islamic calendar."
:type 'string
:group 'diary)
-(define-obsolete-variable-alias 'bahai-diary-entry-symbol
- 'diary-bahai-entry-symbol "23.1")
-
(defcustom diary-bahai-entry-symbol "B"
- "Symbol indicating a diary entry according to the Bahá'í calendar."
+ "Symbol indicating a diary entry according to the Bahá’í calendar."
:type 'string
:group 'diary)
-(defcustom european-calendar-style nil
- "Non-nil means use the European style of dates in the diary and display.
-In this case, a date like 1/2/1990 would be interpreted as
-February 1, 1990. See `diary-european-date-forms' for the
-default European diary date styles.
-
-Setting this variable directly does not take effect (if the
-calendar package is already loaded). Rather, use either
-\\[customize] or the function `calendar-set-date-style'."
- :type 'boolean
- ;; Without :initialize (require 'calendar) throws an error because
- ;; calendar-set-date-style is undefined at this point.
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
- (if value
- (calendar-set-date-style 'european)
- (calendar-set-date-style 'american)))
- :group 'calendar)
-
-(make-obsolete-variable 'european-calendar-style 'calendar-date-style "23.1")
-
-;; If this is autoloaded, c-d-s gets set before any customization of e-c-s.
-(defcustom calendar-date-style (if european-calendar-style 'european
- 'american)
+(defcustom calendar-date-style 'american
"Your preferred style for writing dates.
The options are:
`american' - month/day/year
@@ -785,9 +743,6 @@ but `diary-date-forms' (which see)."
(choice symbol regexp)))))
:group 'diary)
-(define-obsolete-variable-alias 'american-date-diary-pattern
- 'diary-american-date-forms "23.1")
-
(defcustom diary-american-date-forms
'((month "/" day "[^/0-9]")
(month "/" day "/" year "[^0-9]")
@@ -809,9 +764,6 @@ but `diary-date-forms' (which see)."
(choice symbol regexp)))))
:group 'diary)
-(define-obsolete-variable-alias 'european-date-diary-pattern
- 'diary-european-date-forms "23.1")
-
(defcustom diary-european-date-forms
'((day "/" month "[^/0-9]")
(day "/" month "/" year "[^0-9]")
@@ -901,9 +853,6 @@ Normally you should not customize this, but `calendar-date-display-form'
:version "23.1"
:group 'calendar)
-(define-obsolete-variable-alias 'european-calendar-display-form
- 'calendar-european-date-display-form "23.1")
-
(defcustom calendar-european-date-display-form
'((if dayname (concat dayname ", ")) day " " monthname " " year)
"Pseudo-pattern governing the way a date appears in the European style.
@@ -912,9 +861,6 @@ Normally you should not customize this, but `calendar-date-display-form'
:type 'sexp
:group 'calendar)
-(define-obsolete-variable-alias 'american-calendar-display-form
- 'calendar-american-date-display-form "23.1")
-
(defcustom calendar-american-date-display-form
'((if dayname (concat dayname ", ")) monthname " " day ", " year)
"Pseudo-pattern governing the way a date appears in the American style.
@@ -1029,21 +975,6 @@ The valid styles are described in the documentation of `calendar-date-style'."
(calendar-redraw)
(calendar-update-mode-line))
-(defun european-calendar ()
- "Set the interpretation and display of dates to the European style."
- (declare (obsolete calendar-set-date-style "23.1"))
- (interactive)
- (calendar-set-date-style 'european))
-
-(defun american-calendar ()
- "Set the interpretation and display of dates to the American style."
- (declare (obsolete calendar-set-date-style "23.1"))
- (interactive)
- (calendar-set-date-style 'american))
-
-(define-obsolete-variable-alias 'holidays-in-diary-buffer
- 'diary-show-holidays-flag "23.1")
-
(defcustom diary-show-holidays-flag t
"Non-nil means include holidays in the diary display.
The holidays appear in the mode line of the diary buffer, or in the
@@ -1057,9 +988,6 @@ somewhat; setting it to nil makes the diary display faster."
:type 'boolean
:group 'calendar)
-(define-obsolete-variable-alias 'all-hebrew-calendar-holidays
- 'calendar-hebrew-all-holidays-flag "23.1")
-
(defcustom calendar-hebrew-all-holidays-flag nil
"If nil, show only major holidays from the Hebrew calendar.
This means only those Jewish holidays that appear on secular calendars.
@@ -1068,9 +996,6 @@ calendar."
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-christian-calendar-holidays
- 'calendar-christian-all-holidays-flag "23.1")
-
(defcustom calendar-christian-all-holidays-flag nil
"If nil, show only major holidays from the Christian calendar.
This means only those Christian holidays that appear on secular calendars.
@@ -1079,9 +1004,6 @@ calendar."
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-islamic-calendar-holidays
- 'calendar-islamic-all-holidays-flag "23.1")
-
(defcustom calendar-islamic-all-holidays-flag nil
"If nil, show only major holidays from the Islamic calendar.
This means only those Islamic holidays that appear on secular calendars.
@@ -1090,13 +1012,10 @@ calendar."
:type 'boolean
:group 'holidays)
-(define-obsolete-variable-alias 'all-bahai-calendar-holidays
- 'calendar-bahai-all-holidays-flag "23.1")
-
(defcustom calendar-bahai-all-holidays-flag nil
- "If nil, show only major holidays from the Bahá'í calendar.
+ "If nil, show only major holidays from the Bahá’í calendar.
These are the days on which work and school must be suspended.
-Otherwise, show all the holidays that would appear in a complete Bahá'í
+Otherwise, show all the holidays that would appear in a complete Bahá’í
calendar."
:type 'boolean
:group 'holidays)
@@ -1123,8 +1042,6 @@ calendar."
(defconst diary-fancy-buffer "*Fancy Diary Entries*"
"Name of the buffer used for the optional fancy display of the diary.")
-(define-obsolete-variable-alias 'fancy-diary-buffer 'diary-fancy-buffer "23.1")
-
(defconst calendar-other-calendars-buffer "*Other Calendars*"
"Name of the buffer used for the display of date on other calendars.")
@@ -1157,9 +1074,6 @@ Optional NMONTHS is the number of months per year (default 12)."
(and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
(if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
-(define-obsolete-function-alias 'increment-calendar-month
- 'calendar-increment-month "23.1")
-
(defvar displayed-month)
(defvar displayed-year)
@@ -1172,17 +1086,6 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'."
(calendar-increment-month mon yr n)
(cons mon yr))
-(defmacro calendar-for-loop (var from init to final do &rest body)
- "Execute a for loop.
-Evaluate BODY with VAR bound to successive integers from INIT to FINAL,
-inclusive. The standard macro `dotimes' is preferable in most cases."
- (declare (obsolete "use `dotimes' or `while' instead." "23.1")
- (debug (symbolp "from" form "to" form "do" body))
- (indent defun))
- `(let ((,var (1- ,init)))
- (while (>= ,final (setq ,var (1+ ,var)))
- ,@body)))
-
(defmacro calendar-sum (index initial condition expression)
"For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION."
(declare (debug (symbolp form form form)))
@@ -1204,11 +1107,11 @@ with disabled undo. Leaves point at point-min, displays BUFFER."
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
+ (display-buffer ,buffer)
,@body
(goto-char (point-min))
(set-buffer-modified-p nil)
- (setq buffer-read-only t)
- (display-buffer ,buffer)))
+ (setq buffer-read-only t)))
;; The following are in-line for speed; they can be called thousands of times
;; when looking up holidays or processing the diary. Here, for example, are
@@ -1242,25 +1145,16 @@ with disabled undo. Leaves point at point-min, displays BUFFER."
"Extract the month part of DATE which has the form (month day year)."
(car date))
-(define-obsolete-function-alias 'extract-calendar-month
- 'calendar-extract-month "23.1")
-
;; Note gives wrong answer for result of (calendar-read-date 'noday),
;; but that is only used by `calendar-other-month'.
(defsubst calendar-extract-day (date)
"Extract the day part of DATE which has the form (month day year)."
(cadr date))
-(define-obsolete-function-alias 'extract-calendar-day
- 'calendar-extract-day "23.1")
-
(defsubst calendar-extract-year (date)
"Extract the year part of DATE which has the form (month day year)."
(nth 2 date))
-(define-obsolete-function-alias 'extract-calendar-year
- 'calendar-extract-year "23.1")
-
(defsubst calendar-leap-year-p (year)
"Return t if YEAR is a Gregorian leap year.
A negative year is interpreted as BC; -1 being 1 BC, and so on."
@@ -1311,7 +1205,7 @@ return negative results."
(let ((year (calendar-extract-year date))
offset-years)
(cond ((zerop year)
- (error "There was no year zero"))
+ (user-error "There was no year zero"))
((> year 0)
(setq offset-years (1- year))
(+ (calendar-day-number date) ; days this year
@@ -1418,10 +1312,16 @@ display the generated calendar."
;; the right thing in that case.
;;
;; Is this a wide frame? If so, split it horizontally.
- (if (window-splittable-p t) (split-window-right))
+
+ ;; The following doesn't sound useful: If we split horizontally
+ ;; here, the subsequent `pop-to-buffer' will likely split again
+ ;; horizontally and we end up with three side-by-side windows.
+ (when (window-splittable-p (selected-window) t)
+ (split-window-right))
(pop-to-buffer calendar-buffer)
;; Has the window already been split vertically?
(when (and (not (window-dedicated-p))
+ (window-splittable-p (selected-window))
(window-full-height-p))
(let ((win (split-window-below)))
;; In the upper window, show whatever was visible before.
@@ -1432,9 +1332,14 @@ display the generated calendar."
(calendar-generate-window month year)
(if (and calendar-view-diary-initially-flag
(calendar-date-is-visible-p date))
- (diary-view-entries))))
+ ;; Do not clobber the calendar with the diary, if the diary
+ ;; has previously been shown in the window that now shows the
+ ;; calendar (bug#18381).
+ (let ((display-buffer-overriding-action
+ '(nil . ((inhibit-same-window . t)))))
+ (diary-view-entries)))))
(if calendar-view-holidays-initially-flag
- (let* ((diary-buffer (get-file-buffer diary-file))
+ (let* ((diary-buffer (diary-live-p))
(diary-window (if diary-buffer (get-buffer-window diary-buffer)))
(split-height-threshold (if diary-window 2 1000)))
;; FIXME display buffer?
@@ -1468,17 +1373,15 @@ Optional integers MON and YR are used instead of today's date."
;; combined don't fit height to that of its buffer.
(set-window-vscroll nil 0))
(sit-for 0))
- (and (bound-and-true-p font-lock-mode)
- (font-lock-fontify-buffer))
(and calendar-mark-holidays-flag
-;;; (calendar-date-is-valid-p today) ; useful for BC dates
+ ;; (calendar-date-is-valid-p today) ; useful for BC dates
(calendar-mark-holidays)
(and in-calendar-window (sit-for 0)))
(unwind-protect
(if calendar-mark-diary-entries-flag (diary-mark-entries))
- (if today-visible
- (run-hooks 'calendar-today-visible-hook)
- (run-hooks 'calendar-today-invisible-hook)))))
+ (run-hooks (if today-visible
+ 'calendar-today-visible-hook
+ 'calendar-today-invisible-hook)))))
(defun calendar-generate (month year)
"Generate a three-month Gregorian calendar centered around MONTH, YEAR."
@@ -1487,7 +1390,7 @@ Optional integers MON and YR are used instead of today's date."
;; stands, almost all other calendar functions (eg holidays) would
;; at best have unpredictable results for such dates.
(if (< (+ month (* 12 (1- year))) 2)
- (error "Months before January, 1 AD cannot be displayed"))
+ (user-error "Months before January, 1 AD cannot be displayed"))
(setq displayed-month month
displayed-year year)
(erase-buffer)
@@ -1546,7 +1449,8 @@ line."
(last (calendar-last-day-of-month month year))
(trunc (min calendar-intermonth-spacing
(1- calendar-left-margin)))
- (day 1))
+ (day 1)
+ j)
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
@@ -1556,11 +1460,11 @@ line."
(calendar-insert-at-column indent calendar-intermonth-header trunc)
;; Use the first N characters of each day to head the columns.
(dotimes (i 7)
+ (setq j (mod (+ calendar-week-start-day i) 7))
(insert
(truncate-string-to-width
- (propertize (calendar-day-name (mod (+ calendar-week-start-day i) 7)
- 'header t)
- 'font-lock-face (if (memq i '(0 6))
+ (propertize (calendar-day-name j 'header t)
+ 'font-lock-face (if (memq j calendar-weekend-days)
'calendar-weekend-header
'calendar-weekday-header))
calendar-day-header-width nil ?\s)
@@ -1708,6 +1612,10 @@ line."
(define-key map "iBd" 'diary-bahai-insert-entry)
(define-key map "iBm" 'diary-bahai-insert-monthly-entry)
(define-key map "iBy" 'diary-bahai-insert-yearly-entry)
+ (define-key map "iCd" 'diary-chinese-insert-entry)
+ (define-key map "iCm" 'diary-chinese-insert-monthly-entry)
+ (define-key map "iCy" 'diary-chinese-insert-yearly-entry)
+ (define-key map "iCa" 'diary-chinese-insert-anniversary-entry)
(define-key map "?" 'calendar-goto-info-node)
(define-key map "Hm" 'cal-html-cursor-month)
(define-key map "Hy" 'cal-html-cursor-year)
@@ -1785,24 +1693,28 @@ is COMMAND's keybinding, STRING describes the binding."
nil "today"))
'(calendar-date-string (calendar-current-date) t)
(calendar-mode-line-entry 'calendar-scroll-left "next month" ">"))
- "The mode line of the calendar buffer.
+ "If non-nil, the mode line of the calendar buffer.
This is a list of items that evaluate to strings. The elements
are evaluated and concatenated, evenly separated by blanks.
During evaluation, the variable `date' is available as the date
nearest the cursor (or today's date if that fails). To update
-the mode-line as the cursor moves, add `calendar-update-mode-line'
-to `calendar-move-hook'. Here is an example that has the Hebrew date,
-the day number/days remaining in the year, and the ISO week/year numbers:
+the mode-line as the cursor moves, add
+`calendar-update-mode-line' to `calendar-move-hook'.
+
+If nil, do not modify the mode line at all.
+
+Here is an example that has the Hebrew date, the day number/days
+remaining in the year, and the ISO week/year numbers:
(list
\"\"
- '(calendar-hebrew-date-string date)
- '(let* ((year (calendar-extract-year date))
+ \\='(calendar-hebrew-date-string date)
+ \\='(let* ((year (calendar-extract-year date))
(d (calendar-day-number date))
(days-remaining
(- (calendar-day-number (list 12 31 year)) d)))
(format \"%d/%d\" d days-remaining))
- '(let* ((d (calendar-absolute-from-gregorian date))
+ \\='(let* ((d (calendar-absolute-from-gregorian date))
(iso-date (calendar-iso-from-absolute d)))
(format \"ISO week %d of %d\"
(calendar-extract-month iso-date)
@@ -1870,7 +1782,8 @@ the STRINGS are just concatenated and the result truncated."
(defun calendar-update-mode-line ()
"Update the calendar mode line with the current date and date style."
- (if (bufferp (get-buffer calendar-buffer))
+ (if (and calendar-mode-line-format
+ (bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
(let ((start (- calendar-left-margin 2))
(date (condition-case nil
@@ -1918,8 +1831,6 @@ the STRINGS are just concatenated and the result truncated."
(dolist (b calendar-buffers)
(quit-windows-on b kill))))))
-(define-obsolete-function-alias 'exit-calendar 'calendar-exit "23.1")
-
(defun calendar-current-date (&optional offset)
"Return the current date in a list (month day year).
Optional integer OFFSET is a number of days from the current date."
@@ -2282,7 +2193,7 @@ in `calendar-month-name-array'. These abbreviations are used in
the calendar menu entries, and can also be used in the diary
file. Do not include a trailing `.' in the strings specified in
this variable, though you may use such in the diary file. By
-default, each string is the first ``calendar-abbrev-length'
+default, each string is the first `calendar-abbrev-length'
characters of the corresponding full name."
:group 'calendar
:set-after '(calendar-abbrev-length calendar-month-name-array)
@@ -2472,9 +2383,6 @@ Returns the corresponding Gregorian date."
;; Note there are side effects on calendar navigation.
(<= 1 year))))
-(define-obsolete-function-alias 'calendar-date-is-legal-p
- 'calendar-date-is-valid-p "23.1")
-
(defun calendar-date-equal (date1 date2)
"Return t if the DATE1 and DATE2 are the same."
(and
@@ -2547,9 +2455,6 @@ MARK defaults to `diary-entry-marker'."
(make-overlay (1- (point)) (1+ (point))) 'face
(calendar-make-temp-face mark))))))))
-(define-obsolete-function-alias 'mark-visible-calendar-date
- 'calendar-mark-visible-date "23.1")
-
(defun calendar-star-date ()
"Replace the date under the cursor in the calendar window with asterisks.
You might want to add this function to `calendar-today-visible-hook'."
@@ -2666,7 +2571,7 @@ DATE is (month day year). Calendars that do not apply are omitted."
(unless (string-equal
(setq odate (calendar-bahai-date-string date))
"")
- (format "Bahá'í date: %s" odate))
+ (format "Bahá’í date: %s" odate))
(format "Chinese date: %s"
(calendar-chinese-date-string date))
(unless (string-equal
@@ -2724,15 +2629,12 @@ If called by a mouse-event, pops up a menu with the result."
"---")
(calendar-string-spread (list str) ?- width)))))
-(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1")
-
(run-hooks 'calendar-load-hook)
(provide 'calendar)
;; Local variables:
;; byte-compile-dynamic: t
-;; coding: utf-8
;; End:
;;; calendar.el ends here
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 6b89677554f..7382abf67fc 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,6 +1,6 @@
;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989-1990, 1992-1995, 2001-2013 Free Software
+;; Copyright (C) 1989-1990, 1992-1995, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -49,13 +49,6 @@ are holidays."
:type 'boolean
:group 'diary)
-(defcustom diary-face 'diary
- "Face name to use for diary entries."
- :type 'face
- :group 'calendar-faces)
-(make-obsolete-variable 'diary-face "customize the face `diary' instead."
- "23.1")
-
(defface diary-anniversary '((t :inherit font-lock-keyword-face))
"Face used for anniversaries in the fancy diary display."
:version "22.1"
@@ -72,8 +65,6 @@ are holidays."
:version "22.1"
:group 'calendar-faces)
-(define-obsolete-face-alias 'diary-button-face 'diary-button "22.1")
-
;; Face markup of calendar and diary displays: Any entry line that
;; ends with [foo:value] where foo is a face attribute (except :box
;; :stipple) or with [face:blah] tags, will have these values applied
@@ -113,9 +104,9 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'"
(choice (const string :tag "A string")
(const symbol :tag "A symbol")
(const int :tag "An integer")
- (const tnil :tag "`t' or `nil'")
+ (const tnil :tag "t or nil")
(const stringtnil
- :tag "A string, `t', or `nil'"))))
+ :tag "A string, t, or nil"))))
:group 'diary)
(defcustom diary-glob-file-regexp-prefix "^\\#"
@@ -133,9 +124,6 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'"
:type 'function
:group 'diary)
-(define-obsolete-variable-alias 'sexp-diary-entry-symbol
- 'diary-sexp-entry-symbol "23.1")
-
(defcustom diary-sexp-entry-symbol "%%"
"The string used to indicate a sexp diary entry in `diary-file'.
See the documentation for the function `diary-list-sexp-entries'."
@@ -168,18 +156,10 @@ Used for example by the appointment package - see `appt-activate'."
:type 'hook
:group 'diary)
-(define-obsolete-variable-alias 'diary-display-hook 'diary-display-function
- "23.1")
-
(defcustom diary-display-function 'diary-fancy-display
"Function used to display the diary.
The two standard options are `diary-fancy-display' and `diary-simple-display'.
-For historical reasons, `nil' is the same as `diary-simple-display'
-\(so you must use `ignore' for no display). Also for historical
-reasons, this variable can be a list of functions to run. These
-uses are not recommended and may be removed at some point.
-
When this function is called, the variable `diary-entries-list'
is a list, in order by date, of all relevant diary entries in the
form of ((MONTH DAY YEAR) STRING), where string is the diary
@@ -188,17 +168,13 @@ produce a different buffer for display (perhaps combined with
holidays), or hard copy output."
:type '(choice (const diary-fancy-display :tag "Fancy display")
(const diary-simple-display :tag "Basic display")
- (const ignore :tag "No display")
- (const nil :tag "Obsolete way to choose basic display")
- (hook :tag "Obsolete form with list of display functions"))
+ (const :tag "No display" ignore)
+ (function :tag "User-specified function"))
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
:version "23.2" ; simple->fancy
:group 'diary)
-(define-obsolete-variable-alias 'list-diary-entries-hook
- 'diary-list-entries-hook "23.1")
-
(defcustom diary-list-entries-hook nil
"Hook run after diary file is culled for relevant entries.
@@ -209,9 +185,9 @@ diary buffer to be displayed with diary entries from various
included files, each day's entries sorted into lexicographic
order, add the following to your init file:
- (setq diary-display-function 'diary-fancy-display)
- (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
- (add-hook 'diary-list-entries-hook 'diary-sort-entries t)
+ (setq diary-display-function \\='diary-fancy-display)
+ (add-hook \\='diary-list-entries-hook \\='diary-include-other-diary-files)
+ (add-hook \\='diary-list-entries-hook \\='diary-sort-entries t)
Note how the sort function is placed last, so that it can sort
the entries included from other files.
@@ -227,9 +203,6 @@ the main file and all included files, you would use the nongregorian hook."
:options '(diary-include-other-diary-files diary-sort-entries)
:group 'diary)
-(define-obsolete-variable-alias 'mark-diary-entries-hook
- 'diary-mark-entries-hook "23.1")
-
(defcustom diary-mark-entries-hook nil
"List of functions called after marking diary entries in the calendar.
You might wish to add `diary-mark-included-diary-files', in which case
@@ -244,9 +217,6 @@ differ only if you are using included diary files. In that case,
:options '(diary-mark-included-diary-files)
:group 'diary)
-(define-obsolete-variable-alias 'nongregorian-diary-listing-hook
- 'diary-nongregorian-listing-hook "23.1")
-
(defcustom diary-nongregorian-listing-hook nil
"List of functions called for listing diary file and included files.
As the files are processed for diary entries, these functions are used
@@ -264,9 +234,6 @@ use `diary-list-entries-hook', which runs only for the main diary file."
diary-islamic-list-entries)
:group 'diary)
-(define-obsolete-variable-alias 'nongregorian-diary-marking-hook
- 'diary-nongregorian-marking-hook "23.1")
-
(defcustom diary-nongregorian-marking-hook nil
"List of functions called for marking diary file and included files.
As the files are processed for diary entries, these functions are used
@@ -284,9 +251,6 @@ use `diary-mark-entries-hook', which runs only for the main diary file."
diary-islamic-mark-entries)
:group 'diary)
-(define-obsolete-variable-alias 'print-diary-entries-hook
- 'diary-print-entries-hook "23.1")
-
(defcustom diary-print-entries-hook 'lpr-buffer
"Run by `diary-print-entries' after preparing a temporary diary buffer.
The buffer shows only the diary entries currently visible in the
@@ -334,12 +298,9 @@ expressions that can involve the keywords `days' (a number), `date'
:type 'sexp
:group 'diary)
-(define-obsolete-variable-alias 'abbreviated-calendar-year
- 'diary-abbreviated-year-flag "23.1")
-
(defcustom diary-abbreviated-year-flag t
"Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
-This applies to the Gregorian, Hebrew, Islamic, and Bahá'í calendars.
+This applies to the Gregorian, Hebrew, Islamic, and Bahá’í calendars.
When the current century is added to a two-digit year, if the result
is more than 50 years in the future, the previous century is assumed.
If the result is more than 50 years in the past, the next century is assumed.
@@ -468,7 +429,8 @@ Only used if `diary-header-line-flag' is non-nil."
;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
;;;###cal-autoload
(defun diary-live-p ()
- "Return non-nil if the diary is being displayed."
+ "Return non-nil if the diary is being displayed.
+The actual return value is a diary buffer."
(or (get-buffer diary-fancy-buffer)
(and diary-file (find-buffer-visiting diary-file))))
@@ -484,9 +446,6 @@ just visiting the `diary-file'), and SYMBOL's value is to be changed."
;; Note this assumes diary was called without prefix arg.
(diary))))
-(define-obsolete-variable-alias 'number-of-diary-entries
- 'diary-number-of-entries "23.1")
-
(defcustom diary-number-of-entries 1
"Specifies how many days of diary entries are to be displayed initially.
This variable affects the diary display when the command \\[diary] is
@@ -562,10 +521,6 @@ DFILE specifies the file to use as the diary file."
(let ((diary-file dfile))
(diary-view-entries arg)))
-;;;###cal-autoload
-(define-obsolete-function-alias 'view-other-diary-entries
- 'diary-view-other-diary-entries "23.1")
-
(defvar diary-syntax-table
(let ((st (copy-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?* "w" st)
@@ -684,8 +639,6 @@ Also removes the region between `diary-comment-start' and
(list marker dfile literal)
globcolor)))))))
-(define-obsolete-function-alias 'add-to-diary-list 'diary-add-to-list "23.1")
-
(defun diary-list-entries-2 (date mark globattr list-only
&optional months symbol gdate)
"Internal subroutine of `diary-list-entries'.
@@ -901,12 +854,15 @@ LIST-ONLY is non-nil, in which case it just returns the list."
;;; (diary-include-other-diary-files) ; recurse
;;; (run-hooks 'diary-list-entries-hook))
(unless list-only
- (if (and diary-display-function
- (listp diary-display-function))
- ;; Backwards compatibility.
- (run-hooks 'diary-display-function)
- (funcall (or diary-display-function
- 'diary-simple-display))))
+ ;; Avoid M-x diary; M-x calendar; M-x diary
+ ;; clobbering the calendar window.
+ ;; FIXME this is not the right solution.
+ (let ((display-buffer-fallback-action
+ (list (delq
+ 'display-buffer-in-previous-window
+ (copy-sequence
+ (car display-buffer-fallback-action))))))
+ (funcall diary-display-function)))
(run-hooks 'diary-hook)))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
(or d-incp (message "Preparing diary...done"))
@@ -954,10 +910,12 @@ This is recursive; that is, included files may include other files."
(diary-list-entries original-date number t)))))
(display-warning
:error
- (format "Can't read included diary file %s\n" diary-file)))
+ (format-message "Can't read included diary file %s\n"
+ diary-file)))
(display-warning
:error
- (format "Can't find included diary file %s\n" diary-file)))))
+ (format-message "Can't find included diary file %s\n"
+ diary-file)))))
(goto-char (point-min)))
(defun diary-include-other-diary-files ()
@@ -967,9 +925,6 @@ For details, see `diary-include-files'.
See also `diary-mark-included-diary-files'."
(diary-include-files))
-(define-obsolete-function-alias 'include-other-diary-files
- 'diary-include-other-diary-files "23.1")
-
(defvar date-string) ; bound in diary-list-entries
(defun diary-display-no-entries ()
@@ -1028,9 +983,6 @@ in the mode line. This is an option for `diary-display-function'."
(set-window-point window diary-saved-point)
(set-window-start window (point-min)))))))
-(define-obsolete-function-alias 'simple-diary-display
- 'diary-simple-display "23.1")
-
(defvar diary-goto-entry-function 'diary-goto-entry
"Function called to jump to a diary entry.
Modes that require special handling of the included file
@@ -1157,9 +1109,6 @@ This is an option for `diary-display-function'."
(diary-fancy-display-mode))
(calendar-set-mode-line date-string))))
-(define-obsolete-function-alias 'fancy-diary-display
- 'diary-fancy-display "23.1")
-
;; FIXME modernize?
(defun diary-print-entries ()
"Print a hard copy of the diary display.
@@ -1204,9 +1153,6 @@ the actual printing."
(run-hooks 'diary-print-entries-hook)
(kill-buffer temp-buffer))))
-(define-obsolete-function-alias 'print-diary-entries
- 'diary-print-entries "23.1")
-
;;;###cal-autoload
(defun diary-show-all-entries ()
"Show all of the diary entries in the diary file.
@@ -1253,7 +1199,7 @@ ensure that all relevant variables are set.
"
(interactive "P")
(if (string-equal diary-mail-addr "")
- (error "You must set `diary-mail-addr' to use this command")
+ (user-error "You must set `diary-mail-addr' to use this command")
(let ((diary-display-function 'diary-fancy-display))
(diary-list-entries (calendar-current-date) (or ndays diary-mail-days)))
(compose-mail diary-mail-addr
@@ -1454,9 +1400,6 @@ marks. This is intended to deal with deleted diary entries."
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
(or d-incp (message "Marking diary entries...done"))))
-;;;###cal-autoload
-(define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries "23.1")
-
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
(let ((result (if calendar-debug-sexp
@@ -1534,9 +1477,6 @@ is marked. See the documentation for the function `diary-list-sexp-entries'."
(or (cadr (diary-pull-attrs entry file-glob-attrs))
(if (consp mark) (car mark)))))))))
-(define-obsolete-function-alias 'mark-sexp-diary-entries
- 'diary-mark-sexp-entries "23.1")
-
(defun diary-mark-included-diary-files ()
"Mark diary entries from included diary files.
To use, add this function to `diary-mark-entries-hook'.
@@ -1544,9 +1484,6 @@ For details, see `diary-include-files'.
See also `diary-include-other-diary-files'."
(diary-include-files t))
-(define-obsolete-function-alias 'mark-included-diary-files
- 'diary-mark-included-diary-files "23.1")
-
(defun calendar-mark-days-named (dayname &optional color)
"Mark all dates in the calendar window that are day DAYNAME of the week.
0 means all Sundays, 1 means all Mondays, and so on.
@@ -1569,9 +1506,6 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
color)
(setq day (+ day 7))))))
-(define-obsolete-function-alias 'mark-calendar-days-named
- 'calendar-mark-days-named "23.1")
-
(defun calendar-mark-month (month year p-month p-day p-year &optional color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P-DAY/P-YEAR.
A value of 0 in any position of the pattern is a wildcard.
@@ -1585,9 +1519,6 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-visible-date (list month (1+ i) year) color))
(calendar-mark-visible-date (list month p-day year) color))))
-(define-obsolete-function-alias 'mark-calendar-month
- 'calendar-mark-month "23.1")
-
(defun calendar-mark-date-pattern (month day year &optional color)
"Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
A value of 0 in any position is a wildcard. Optional argument COLOR is
@@ -1600,10 +1531,7 @@ passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-month m y month day year color)
(calendar-increment-month m y 1)))))
-(define-obsolete-function-alias 'mark-calendar-date-pattern
- 'calendar-mark-date-pattern "23.1")
-
-;; Bahai, Hebrew, Islamic.
+;; Bahá’í, Hebrew, Islamic.
(defun calendar-mark-complex (month day year fromabs &optional color)
"Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
The function FROMABS converts absolute dates to the appropriate date system.
@@ -1633,7 +1561,7 @@ Optional argument COLOR is passed to `calendar-mark-visible-date' as MARK."
(calendar-mark-visible-date
(calendar-gregorian-from-absolute date) color)))))
-;; Bahai, Islamic.
+;; Bahá’í, Islamic.
(defun calendar-mark-1 (month day year fromabs toabs &optional color)
"Mark dates in the calendar conforming to MONTH DAY YEAR of some system.
The function FROMABS converts absolute dates to the appropriate date system.
@@ -1661,8 +1589,7 @@ COLOR is passed to `calendar-mark-visible-date' as MARK."
(setq date (calendar-gregorian-from-absolute
(funcall toabs (list month day y)))))
(calendar-mark-visible-date date color)))))
- (calendar-mark-complex month day year
- 'calendar-bahai-from-absolute color))))
+ (calendar-mark-complex month day year fromabs color))))
(defun diary-entry-time (s)
@@ -1709,8 +1636,6 @@ be the last item in the hook, in case earlier items add diary
entries, or change the order."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
-(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1")
-
(defun diary-list-sexp-entries (date)
"Add sexp entries for DATE from the diary file to `diary-entries-list'.
@@ -1734,8 +1659,8 @@ on a weekend:
&%%(let ((dayname (calendar-day-of-week date))
(day (calendar-extract-day date)))
(or
- (and (= day 21) (memq dayname '(1 2 3 4 5)))
- (and (memq day '(19 20)) (= dayname 5)))
+ (and (= day 21) (memq dayname \\='(1 2 3 4 5)))
+ (and (memq day \\='(19 20)) (= dayname 5)))
) UIUC pay checks deposited
A number of built-in functions are available for this type of
@@ -1748,7 +1673,7 @@ DAY MONTH YEAR in the European style).
%%(diary-date MONTH DAY YEAR &optional MARK) text
Entry applies if date is MONTH, DAY, YEAR. DAY, MONTH, and YEAR can
- be a list of integers, `t' (meaning all values), or an integer.
+ be a list of integers, t (meaning all values), or an integer.
%%(diary-float MONTH DAYNAME N &optional DAY MARK) text
Entry will appear on the Nth DAYNAME after/before MONTH DAY.
@@ -1756,7 +1681,7 @@ DAY MONTH YEAR in the European style).
If N>0, use the Nth DAYNAME after MONTH DAY.
If N<0, use the Nth DAYNAME before MONTH DAY.
DAY defaults to 1 if N>0, and MONTH's last day otherwise.
- MONTH can be a list of months, a single month, or `t' to
+ MONTH can be a list of months, a single month, or t to
specify all months.
%%(diary-block M1 D1 Y1 M2 D2 Y2 &optional MARK) text
@@ -1869,9 +1794,6 @@ best if they are non-marking."
(setq entry-found (or entry-found diary-entry)))
entry-found))
-(define-obsolete-function-alias 'list-sexp-diary-entries
- 'diary-list-sexp-entries "23.1")
-
(defun diary-make-date (a b c)
"Convert A B C into the internal calendar date form.
The expected order of the inputs depends on `calendar-date-style',
@@ -1894,7 +1816,7 @@ form used internally by the calendar and diary."
(defun diary-date (month day year &optional mark)
"Specific date(s) diary entry.
Entry applies if date is MONTH, DAY, YEAR. Each parameter can be a
-list of integers, `t' (meaning all values), or an integer. The order
+list of integers, t (meaning all values), or an integer. The order
of the input parameters changes according to `calendar-date-style'
\(e.g. to DAY MONTH YEAR in the European style).
@@ -1943,7 +1865,7 @@ DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
If N>0, use the Nth DAYNAME after MONTH DAY.
If N<0, use the Nth DAYNAME before MONTH DAY.
DAY defaults to 1 if N>0, and MONTH's last day otherwise.
-MONTH can be a list of months, an integer, or `t' (meaning all months).
+MONTH can be a list of months, an integer, or t (meaning all months).
Optional MARK specifies a face or single-character string to use when
highlighting the day in the calendar."
;; This is messy because the diary entry may apply, but the date on which it
@@ -2049,7 +1971,7 @@ and %s by the ordinal ending of that number (that is, `st', `nd',
An optional parameter MARK specifies a face or single-character
string to use when highlighting the day in the calendar."
(or (> n 0)
- (error "Day count must be positive"))
+ (user-error "Day count must be positive"))
(let* ((diff (- (calendar-absolute-from-gregorian date)
(calendar-absolute-from-gregorian
(diary-make-date month day year))))
@@ -2133,9 +2055,6 @@ If omitted, NONMARKING defaults to nil and FILE defaults to
string " "))
;;;###cal-autoload
-(define-obsolete-function-alias 'make-diary-entry 'diary-make-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-entry (arg &optional event)
"Insert a diary entry for the date indicated by point.
Prefix argument ARG makes the entry nonmarking."
@@ -2145,9 +2064,6 @@ Prefix argument ARG makes the entry nonmarking."
arg))
;;;###cal-autoload
-(define-obsolete-function-alias 'insert-diary-entry 'diary-insert-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-weekly-entry (arg)
"Insert a weekly diary entry for the day of the week indicated by point.
Prefix argument ARG makes the entry nonmarking."
@@ -2155,10 +2071,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-make-entry (calendar-day-name (calendar-cursor-to-date t))
arg))
-;;;###cal-autoload
-(define-obsolete-function-alias 'insert-weekly-diary-entry
- 'diary-insert-weekly-entry "23.1")
-
(defun diary-date-display-form (&optional type)
"Return value for `calendar-date-display-form' using `calendar-date-style'.
Optional symbol TYPE is either `monthly' or `yearly'."
@@ -2214,10 +2126,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-insert-entry-1 'monthly arg))
;;;###cal-autoload
-(define-obsolete-function-alias 'insert-monthly-diary-entry
- 'diary-insert-monthly-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-yearly-entry (arg)
"Insert an annual diary entry for the day of the year indicated by point.
Prefix argument ARG makes the entry nonmarking."
@@ -2225,10 +2133,6 @@ Prefix argument ARG makes the entry nonmarking."
(diary-insert-entry-1 'yearly arg))
;;;###cal-autoload
-(define-obsolete-function-alias 'insert-yearly-diary-entry
- 'diary-insert-yearly-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-anniversary-entry (arg)
"Insert an anniversary diary entry for the date given by point.
Prefix argument ARG makes the entry nonmarking."
@@ -2241,10 +2145,6 @@ Prefix argument ARG makes the entry nonmarking."
arg)))
;;;###cal-autoload
-(define-obsolete-function-alias 'insert-anniversary-diary-entry
- 'diary-insert-anniversary-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-block-entry (arg)
"Insert a block diary entry for the days between the point and marked date.
Prefix argument ARG makes the entry nonmarking."
@@ -2268,10 +2168,6 @@ Prefix argument ARG makes the entry nonmarking."
arg)))
;;;###cal-autoload
-(define-obsolete-function-alias 'insert-block-diary-entry
- 'diary-insert-block-entry "23.1")
-
-;;;###cal-autoload
(defun diary-insert-cyclic-entry (arg)
"Insert a cyclic diary entry starting at the date given by point.
Prefix argument ARG makes the entry nonmarking."
@@ -2285,10 +2181,6 @@ Prefix argument ARG makes the entry nonmarking."
(calendar-date-string (calendar-cursor-to-date t) nil t))
arg)))
-;;;###cal-autoload
-(define-obsolete-function-alias 'insert-cyclic-diary-entry
- 'diary-insert-cyclic-entry "23.1")
-
;;; Diary mode.
(defun diary-redraw-calendar ()
@@ -2349,7 +2241,7 @@ full month names."
(if (equal (car x) 'backup)
(concat "\\)" (eval (car (reverse x))))
"\\)"))
- '(1 diary-face)))
+ '(1 'diary)))
diary-date-forms)))
(defmacro diary-font-lock-keywords-1 (markfunc listfunc feature months symbol)
@@ -2374,6 +2266,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
(defvar calendar-hebrew-month-name-array-leap-year)
(defvar calendar-islamic-month-name-array)
(defvar calendar-bahai-month-name-array)
+(defvar calendar-chinese-month-name-array)
;;;###cal-autoload
(defun diary-font-lock-keywords ()
@@ -2396,6 +2289,11 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
cal-bahai
calendar-bahai-month-name-array
diary-bahai-entry-symbol)
+ (diary-font-lock-keywords-1 diary-chinese-mark-entries
+ diary-chinese-list-entries
+ cal-china
+ calendar-chinese-month-name-array
+ diary-chinese-entry-symbol)
(list
(cons
(format "^%s.*$" (regexp-quote diary-include-string))
@@ -2412,7 +2310,8 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
(regexp-opt (mapcar 'regexp-quote
(list diary-hebrew-entry-symbol
diary-islamic-entry-symbol
- diary-bahai-entry-symbol))
+ diary-bahai-entry-symbol
+ diary-chinese-entry-symbol))
t))
'(1 font-lock-constant-face))
'(diary-font-lock-sexps . font-lock-keyword-face)
@@ -2479,11 +2378,8 @@ This depends on the calendar date style."
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
t))
-(define-obsolete-variable-alias 'fancy-diary-font-lock-keywords
- 'diary-fancy-font-lock-keywords "23.1")
-
(defvar diary-fancy-font-lock-keywords
- `((diary-fancy-date-matcher . diary-face)
+ `((diary-fancy-date-matcher . 'diary)
("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
("^.*Yahrzeit.*$" . font-lock-constant-face)
("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
@@ -2530,9 +2426,6 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil."
(list (cons t diary-fancy-overriding-map)))
(view-mode 1))
-(define-obsolete-function-alias 'fancy-diary-display-mode
- 'diary-fancy-display-mode "23.1")
-
;; Following code from Dave Love <fx@gnu.org>.
;; Import Outlook-format appointments from mail messages in Gnus or
;; Rmail using command `diary-from-outlook'. This, or the specialized
@@ -2641,8 +2534,4 @@ entry is found the user is asked to confirm its addition."
(provide 'diary-lib)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; diary-lib.el ends here
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index c78dff41d7c..307ab4deb82 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -1,6 +1,6 @@
;;; holidays.el --- holiday functions for the calendar package
-;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2013 Free Software
+;; Copyright (C) 1989-1990, 1992-1994, 1997, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -43,9 +43,6 @@
;; explicitly load this file.
;;;###autoload
-(define-obsolete-variable-alias 'general-holidays
- 'holiday-general-holidays "23.1")
-;;;###autoload
(defcustom holiday-general-holidays
(mapcar 'purecopy
'((holiday-fixed 1 1 "New Year's Day")
@@ -73,9 +70,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-general-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'oriental-holidays
- 'holiday-oriental-holidays "23.1")
-;;;###autoload
(defcustom holiday-oriental-holidays
(mapcar 'purecopy
'((holiday-chinese-new-year)
@@ -98,8 +92,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-oriental-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1")
-;;;###autoload
(defcustom holiday-local-holidays nil
"Local holidays.
See the documentation for `calendar-holidays' for details."
@@ -109,8 +101,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-local-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1")
-;;;###autoload
(defcustom holiday-other-holidays nil
"User defined holidays.
See the documentation for `calendar-holidays' for details."
@@ -120,108 +110,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-other-holidays 'risky-local-variable t)
;;;###autoload
-(defvar hebrew-holidays-1
- (mapcar 'purecopy
- '((holiday-hebrew-rosh-hashanah)
- (if calendar-hebrew-all-holidays-flag
- (holiday-julian
- 11
- (let ((m displayed-month)
- (y displayed-year)
- year)
- (calendar-increment-month m y -1)
- (setq year (calendar-extract-year
- (calendar-julian-from-absolute
- (calendar-absolute-from-gregorian (list m 1 y)))))
- (if (zerop (% (1+ year) 4))
- 22
- 21)) "\"Tal Umatar\" (evening)"))))
- "Component of the old default value of `holiday-hebrew-holidays'.")
-;;;###autoload
-(put 'hebrew-holidays-1 'risky-local-variable t)
-(make-obsolete-variable 'hebrew-holidays-1 'hebrew-holidays "23.1")
-
-;;;###autoload
-(defvar hebrew-holidays-2
- (mapcar 'purecopy
- '((holiday-hebrew-hanukkah) ; respects calendar-hebrew-all-holidays-flag
- (if calendar-hebrew-all-holidays-flag
- (holiday-hebrew
- 10
- (let ((h-year (calendar-extract-year
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (list displayed-month 28 displayed-year))))))
- (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year))
- 7))
- 11 10))
- "Tzom Teveth"))
- (if calendar-hebrew-all-holidays-flag
- (holiday-hebrew 11 15 "Tu B'Shevat"))))
- "Component of the old default value of `holiday-hebrew-holidays'.")
-;;;###autoload
-(put 'hebrew-holidays-2 'risky-local-variable t)
-(make-obsolete-variable 'hebrew-holidays-2 'hebrew-holidays "23.1")
-
-;;;###autoload
-(defvar hebrew-holidays-3
- (mapcar 'purecopy
- '((if calendar-hebrew-all-holidays-flag
- (holiday-hebrew
- 11
- (let* ((m displayed-month)
- (y displayed-year)
- (h-year (progn
- (calendar-increment-month m y 1)
- (calendar-extract-year
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (list m (calendar-last-day-of-month m y) y))))))
- (s-s
- (calendar-hebrew-from-absolute
- (if (= 6
- (% (calendar-hebrew-to-absolute
- (list 7 1 h-year))
- 7))
- (calendar-dayname-on-or-before
- 6 (calendar-hebrew-to-absolute
- (list 11 17 h-year)))
- (calendar-dayname-on-or-before
- 6 (calendar-hebrew-to-absolute
- (list 11 16 h-year))))))
- (day (calendar-extract-day s-s)))
- day)
- "Shabbat Shirah"))))
- "Component of the old default value of `holiday-hebrew-holidays'.")
-;;;###autoload
-(put 'hebrew-holidays-3 'risky-local-variable t)
-(make-obsolete-variable 'hebrew-holidays-3 'hebrew-holidays "23.1")
-
-;;;###autoload
-(defvar hebrew-holidays-4
- (mapcar 'purecopy
- '((holiday-hebrew-passover)
- (and calendar-hebrew-all-holidays-flag
- (let* ((m displayed-month)
- (y displayed-year)
- (year (progn
- (calendar-increment-month m y -1)
- (calendar-extract-year
- (calendar-julian-from-absolute
- (calendar-absolute-from-gregorian (list m 1 y)))))))
- (= 21 (% year 28)))
- (holiday-julian 3 26 "Kiddush HaHamah"))
- (if calendar-hebrew-all-holidays-flag
- (holiday-hebrew-tisha-b-av))))
- "Component of the old default value of `holiday-hebrew-holidays'.")
-;;;###autoload
-(put 'hebrew-holidays-4 'risky-local-variable t)
-(make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1")
-
-;;;###autoload
-(define-obsolete-variable-alias 'hebrew-holidays
- 'holiday-hebrew-holidays "23.1")
-;;;###autoload
(defcustom holiday-hebrew-holidays
(mapcar 'purecopy
'((holiday-hebrew-passover)
@@ -240,9 +128,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-hebrew-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'christian-holidays
- 'holiday-christian-holidays "23.1")
-;;;###autoload
(defcustom holiday-christian-holidays
(mapcar 'purecopy
'((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag
@@ -262,9 +147,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-christian-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'islamic-holidays
- 'holiday-islamic-holidays "23.1")
-;;;###autoload
(defcustom holiday-islamic-holidays
(mapcar 'purecopy
'((holiday-islamic-new-year)
@@ -286,22 +168,20 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-islamic-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
-;;;###autoload
(defcustom holiday-bahai-holidays
(mapcar 'purecopy
'((holiday-bahai-new-year)
(holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag
(holiday-fixed 5 23 "Declaration of the Báb")
- (holiday-fixed 5 29 "Ascension of Bahá'u'lláh")
+ (holiday-fixed 5 29 "Ascension of Bahá’u’lláh")
(holiday-fixed 7 9 "Martyrdom of the Báb")
(holiday-fixed 10 20 "Birth of the Báb")
- (holiday-fixed 11 12 "Birth of Bahá'u'lláh")
+ (holiday-fixed 11 12 "Birth of Bahá’u’lláh")
(if calendar-bahai-all-holidays-flag
(append
(holiday-fixed 11 26 "Day of the Covenant")
- (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá")))))
- "Bahá'í holidays.
+ (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá")))))
+ "Bahá’í holidays.
See the documentation for `calendar-holidays' for details."
:type 'sexp
:group 'holidays)
@@ -309,8 +189,6 @@ See the documentation for `calendar-holidays' for details."
(put 'holiday-bahai-holidays 'risky-local-variable t)
;;;###autoload
-(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1")
-;;;###autoload
(defcustom holiday-solar-holidays
(mapcar 'purecopy
'((solar-equinoxes-solstices)
@@ -376,7 +254,7 @@ Several basic functions are provided for this purpose:
K>0, and MONTH's last day otherwise.
(holiday-hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar
(holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
- (holiday-bahai MONTH DAY STRING) a fixed date on the Bahá'í calendar
+ (holiday-bahai MONTH DAY STRING) a fixed date on the Bahá’í calendar
(holiday-julian MONTH DAY STRING) a fixed date on the Julian calendar
(holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
in the variable `year'; if it evaluates to
@@ -389,9 +267,9 @@ For example, to add Bastille Day, celebrated in France on July 14, add
(holiday-fixed 7 14 \"Bastille Day\")
to the list. To add Hurricane Supplication Day, celebrated in the Virgin
-Islands on the fourth Monday in August, add
+Islands on the fourth Monday in July, add
- (holiday-float 8 1 4 \"Hurricane Supplication Day\")
+ (holiday-float 7 1 4 \"Hurricane Supplication Day\")
to the list (the last Monday would be specified with `-1' instead of `4').
To add the last day of Hanukkah to the list, use
@@ -404,11 +282,11 @@ To add the Islamic feast celebrating Mohammed's birthday, use
(holiday-islamic 3 12 \"Mohammed's Birthday\")
since the Islamic months are numbered from 1 starting with Muharram.
-To add an entry for the Bahá'í festival of Ridvan, use
+To add an entry for the Bahá’í festival of Ridvan, use
(holiday-bahai 2 13 \"Festival of Ridvan\")
-since the Bahá'í months are numbered from 1 starting with Bahá.
+since the Bahá’í months are numbered from 1 starting with Bahá.
To add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
(holiday-julian 4 2 \"Jefferson's Birthday\")
@@ -418,7 +296,7 @@ example, to include American presidential elections, which occur on the first
Tuesday after the first Monday in November of years divisible by 4, add
(holiday-sexp
- '(if (zerop (% year 4))
+ \\='(if (zerop (% year 4))
(calendar-gregorian-from-absolute
(1+ (calendar-dayname-on-or-before
1 (+ 6 (calendar-absolute-from-gregorian
@@ -516,9 +394,6 @@ use instead of point."
(message "Looking up holidays...done"))
holiday-list)))
-(define-obsolete-function-alias
- 'list-calendar-holidays 'calendar-list-holidays "23.1")
-
;;;###autoload
(defun holidays (&optional arg)
"Display the holidays for last month, this month, and next month.
@@ -585,7 +460,7 @@ The optional LABEL is used to label the buffer created."
(if holiday-islamic-holidays
(cons "Islamic" holiday-islamic-holidays))
(if holiday-bahai-holidays
- (cons "Bahá'í" holiday-bahai-holidays))
+ (cons "Bahá’í" holiday-bahai-holidays))
(if holiday-oriental-holidays
(cons "Oriental" holiday-oriental-holidays))
(if holiday-solar-holidays
@@ -645,9 +520,6 @@ strings describing those holidays that apply on DATE, or nil if none do."
(if (calendar-date-equal date (car h))
(setq holiday-list (append holiday-list (cdr h)))))))
-(define-obsolete-function-alias
- 'check-calendar-holidays 'calendar-check-holidays "23.1")
-
;; Formerly cal-tex-list-holidays.
(defun holiday-in-range (d1 d2)
@@ -724,9 +596,6 @@ use instead of point."
(calendar-mark-visible-date (car holiday) calendar-holiday-marker))
(message "Marking holidays...done")))
-(define-obsolete-function-alias
- 'mark-calendar-holidays 'calendar-mark-holidays "23.1")
-
;; Below are the functions that calculate the dates of holidays; these
;; are eval'ed in the function calendar-holiday-list. If you
;; write other such functions, be sure to imitate the style used below.
@@ -813,9 +682,6 @@ HLIST is a list of elements of the form (DATE) TEXT."
(and (car p) (calendar-date-is-visible-p (car p)) p))
hlist)))
-(define-obsolete-function-alias
- 'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
-
(defun holiday-sexp (sexp string)
"Sexp holiday for dates in the calendar window.
SEXP is an expression in variable `year' that is evaluated to
@@ -925,8 +791,16 @@ is non-nil)."
;; Prior call to calendar-julian-from-absolute will autoload cal-julian.
(declare-function calendar-julian-to-absolute "cal-julian" (date))
-(defun holiday-greek-orthodox-easter ()
- "Date of Easter according to the rule of the Council of Nicaea."
+(defun holiday-greek-orthodox-easter (&optional n string)
+ "Date of Nth day after Easter (named STRING), if visible in calendar window.
+It is calculated according to the rule of the Council of Nicaea.
+Negative values of N are interpreted as days before Easter.
+STRING is used purely for display purposes. The return value has
+the form ((MONTH DAY YEAR) STRING), where the date is that of the
+Nth day before or after Easter.
+
+For backwards compatibility, if this function is called with no
+arguments, it returns the date of Pascha (Greek Orthodox Easter)."
(let* ((m displayed-month)
(y displayed-year)
(julian-year (progn
@@ -942,16 +816,11 @@ is non-nil)."
(paschal-moon ; day after full moon on or after March 21
(- (calendar-julian-to-absolute (list 4 19 julian-year))
shifted-epact))
- (nicaean-easter ; Sunday following the Paschal moon
- (calendar-gregorian-from-absolute
- (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
- (if (calendar-date-is-visible-p nicaean-easter)
- (list (list nicaean-easter "Pascha (Greek Orthodox Easter)")))))
+ (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
+ (greg (calendar-gregorian-from-absolute (+ abs-easter (or n 0)))))
+ (if (calendar-date-is-visible-p greg)
+ (list (list greg (or string "Pascha (Greek Orthodox Easter)"))))))
(provide 'holidays)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; holidays.el ends here
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index bb3ff0436e0..0955e72aa04 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1,6 +1,6 @@
-;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*-
+;;; icalendar.el --- iCalendar implementation
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Created: August 2002
@@ -39,7 +39,7 @@
;;; History:
-;; 0.07 onwards: see lisp/ChangeLog
+;; 0.07 onwards: see commit logs and ../ChangeLog*.
;; 0.06: (2004-10-06)
;; - Bugfixes regarding icalendar-import-format-*.
@@ -240,6 +240,55 @@ code for the event, and your personal domain name."
:type 'string
:group 'icalendar)
+(defcustom icalendar-export-sexp-enumeration-days
+ 14
+ "Number of days over which a sexp diary entry is enumerated.
+In general sexp entries cannot be translated to icalendar format.
+They are therefore enumerated, i.e. explicitly evaluated for a
+certain number of days, and then exported. The enumeration starts
+on the current day and continues for the number of days given here.
+
+See `icalendar-export-sexp-enumerate-all' for a list of sexp
+entries which by default are NOT enumerated."
+ :version "25.1"
+ :type 'integer
+ :group 'icalendar)
+
+(defcustom icalendar-export-sexp-enumerate-all
+ nil
+ "Determines whether ALL sexp diary entries are enumerated.
+If non-nil all sexp diary entries are enumerated for
+`icalendar-export-sexp-enumeration-days' days instead of
+translating into an icalendar equivalent. This affects the
+following sexp diary entries: `diary-anniversary',
+`diary-cyclic', `diary-date', `diary-float', `diary-block'. All
+other sexp entries are enumerated in any case."
+ :version "25.1"
+ :type 'boolean
+ :group 'icalendar)
+
+
+(defcustom icalendar-export-alarms
+ nil
+ "Determine if and how alarms are included in exported diary events."
+ :version "25.1"
+ :type '(choice (const :tag "Do not include alarms in export"
+ nil)
+ (list :tag "Create alarms in exported diary entries"
+ (integer :tag "Advance time (minutes)"
+ :value 10)
+ (set :tag "Alarm type"
+ (list :tag "Audio"
+ (const audio :tag "Audio"))
+ (list :tag "Display"
+ (const display :tag "Display"))
+ (list :tag "Email"
+ (const email)
+ (repeat :tag "Attendees"
+ (string :tag "Email"))))))
+ :group 'icalendar)
+
+
(defvar icalendar-debug nil
"Enable icalendar debug messages.")
@@ -433,7 +482,7 @@ children."
result))
(defun icalendar--split-value (value-string)
- "Split VALUE-STRING at ';='."
+ "Split VALUE-STRING at `;='."
(let ((result '())
param-name param-value)
(when value-string
@@ -458,45 +507,52 @@ children."
ALIST is an alist entry from a VTIMEZONE, like STANDARD.
DST-P is non-nil if this is for daylight savings time.
The strings are suitable for assembling into a TZ variable."
- (let ((offset (car (cddr (assq 'TZOFFSETTO alist))))
- (rrule-value (car (cddr (assq 'RRULE alist))))
- (dtstart (car (cddr (assq 'DTSTART alist)))))
+ (let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
+ (offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
+ (rrule-value (car (cddr (assq 'RRULE alist))))
+ (dtstart (car (cddr (assq 'DTSTART alist))))
+ (no-dst (equal offsetto offsetfrom)))
;; FIXME: for now we only handle RRULE and not RDATE here.
- (when (and offset rrule-value dtstart)
+ (when (and offsetto dtstart (or rrule-value no-dst))
(let* ((rrule (icalendar--split-value rrule-value))
(freq (cadr (assq 'FREQ rrule)))
(bymonth (cadr (assq 'BYMONTH rrule)))
(byday (cadr (assq 'BYDAY rrule))))
;; FIXME: we don't correctly handle WKST here.
- (if (and (string= freq "YEARLY") bymonth)
+ (if (or no-dst (and (string= freq "YEARLY") bymonth))
(cons
(concat
;; Fake a name.
(if dst-p "DST" "STD")
;; For TZ, OFFSET is added to the local time. So,
;; invert the values.
- (if (eq (aref offset 0) ?-) "+" "-")
- (substring offset 1 3)
+ (if (eq (aref offsetto 0) ?-) "+" "-")
+ (substring offsetto 1 3)
":"
- (substring offset 3 5))
+ (substring offsetto 3 5))
;; The start time.
- (let* ((day (icalendar--get-weekday-number (substring byday -2)))
- (week (if (eq day -1)
- byday
- (substring byday 0 -2))))
- ;; "Translate" the iCalendar way to specify the last
- ;; (sun|mon|...)day in month to the tzset way.
- (if (string= week "-1") ; last day as iCalendar calls it
- (setq week "5")) ; last day as tzset calls it
- (concat "M" bymonth "." week "." (if (eq day -1) "0"
- (int-to-string day))
- ;; Start time.
- "/"
- (substring dtstart -6 -4)
- ":"
- (substring dtstart -4 -2)
- ":"
- (substring dtstart -2)))))))))
+ (let* ((day (if no-dst
+ 1
+ (icalendar--get-weekday-number (substring byday -2))))
+ (week (if no-dst
+ "1"
+ (if (eq day -1)
+ byday
+ (substring byday 0 -2)))))
+ ;; "Translate" the iCalendar way to specify the last
+ ;; (sun|mon|...)day in month to the tzset way.
+ (if (string= week "-1") ; last day as iCalendar calls it
+ (setq week "5")) ; last day as tzset calls it
+ (when no-dst (setq bymonth "1"))
+ (concat "M" bymonth "." week "." (if (eq day -1) "0"
+ (int-to-string day))
+ ;; Start time.
+ "/"
+ (substring dtstart -6 -4)
+ ":"
+ (substring dtstart -4 -2)
+ ":"
+ (substring dtstart -2)))))))))
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
@@ -562,8 +618,7 @@ FIXME: multiple comma-separated values should be allowed!"
(when (and (> (length isodatetimestring) 15)
;; UTC specifier present
(char-equal ?Z (aref isodatetimestring 15)))
- ;; if not UTC add current-time-zone offset
- (setq second (+ (car (current-time-zone)) second)))
+ (setq zone t))
;; shift if necessary
(if day-shift
(let ((mdy (calendar-gregorian-from-absolute
@@ -708,16 +763,6 @@ ISO format: (year month day)."
;; datetime == nil
nil))
-(defun icalendar--date-style ()
- "Return current calendar date style.
-Convenience function to handle transition from old
-`european-calendar-style' to new `calendar-date-style'."
- (if (boundp 'calendar-date-style)
- calendar-date-style
- (if (with-no-warnings european-calendar-style)
- 'european
- 'american)))
-
(defun icalendar--datetime-to-diary-date (datetime &optional separator)
"Convert the decoded DATETIME to diary format.
Optional argument SEPARATOR gives the separator between month,
@@ -725,7 +770,7 @@ day, and year. If nil a blank character is used as separator.
Call icalendar--datetime-to-*-date according to the current
calendar date style."
(funcall (intern-soft (format "icalendar--datetime-to-%s-date"
- (icalendar--date-style)))
+ calendar-date-style))
datetime separator))
(defun icalendar--datetime-to-colontime (datetime)
@@ -835,7 +880,7 @@ is not possible it uses the current calendar date style."
(match-end 2))))
(setq year (read (substring datestring (match-beginning 3)
(match-end 3))))
- (if (eq (icalendar--date-style) 'american)
+ (if (eq calendar-date-style 'american)
(let ((x month))
(setq month day)
(setq day x))))
@@ -891,10 +936,16 @@ is not possible it uses the current calendar date style."
(defun icalendar--diarytime-to-isotime (timestring ampmstring)
"Convert a time like 9:30pm to an iso-conform string like T213000.
-In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING
-would be \"pm\"."
+In this example the TIMESTRING would be \"9:30\" and the
+AMPMSTRING would be \"pm\". The minutes may be missing as long
+as the colon is missing as well, i.e. \"9\" is allowed as
+TIMESTRING and has the same result as \"9:00\"."
(if timestring
- (let ((starttimenum (read (icalendar--rris ":" "" timestring))))
+ (let* ((parts (save-match-data (split-string timestring ":")))
+ (h (car parts))
+ (m (if (cdr parts) (cadr parts)
+ (if (> (length h) 2) "" "00")))
+ (starttimenum (read (concat h m))))
;; take care of am/pm style
;; Be sure *not* to convert 12:00pm - 12:59pm to 2400-2459
(if (and ampmstring (string= "pm" ampmstring) (< starttimenum 1200))
@@ -991,10 +1042,12 @@ FExport diary data into iCalendar file: ")
(header "")
(contents-n-summary)
(contents)
+ (alarm)
(found-error nil)
(nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol)
"?"))
- (other-elements nil))
+ (other-elements nil)
+ (cns-cons-or-list nil))
;; prepare buffer with error messages
(save-current-buffer
(set-buffer (get-buffer-create "*icalendar-errors*"))
@@ -1016,49 +1069,59 @@ FExport diary data into iCalendar file: ")
(condition-case error-val
(progn
- (setq contents-n-summary
+ (setq cns-cons-or-list
(icalendar--convert-to-ical nonmarker entry-main))
(setq other-elements (icalendar--parse-summary-and-rest
entry-full))
- (setq contents (concat (car contents-n-summary)
- "\nSUMMARY:" (cadr contents-n-summary)))
- (let ((cla (cdr (assoc 'cla other-elements)))
- (des (cdr (assoc 'des other-elements)))
- (loc (cdr (assoc 'loc other-elements)))
- (org (cdr (assoc 'org other-elements)))
- (sta (cdr (assoc 'sta other-elements)))
- (sum (cdr (assoc 'sum other-elements)))
- (url (cdr (assoc 'url other-elements)))
- (uid (cdr (assoc 'uid other-elements))))
- (if cla
- (setq contents (concat contents "\nCLASS:" cla)))
- (if des
- (setq contents (concat contents "\nDESCRIPTION:" des)))
- (if loc
- (setq contents (concat contents "\nLOCATION:" loc)))
- (if org
- (setq contents (concat contents "\nORGANIZER:" org)))
- (if sta
- (setq contents (concat contents "\nSTATUS:" sta)))
- ;;(if sum
- ;; (setq contents (concat contents "\nSUMMARY:" sum)))
- (if url
- (setq contents (concat contents "\nURL:" url)))
-
- (setq header (concat "\nBEGIN:VEVENT\nUID:"
- (or uid
- (icalendar--create-uid entry-full
- contents)))))
- (setq result (concat result header contents "\nEND:VEVENT")))
+ (mapc (lambda (contents-n-summary)
+ (setq contents (concat (car contents-n-summary)
+ "\nSUMMARY:"
+ (cdr contents-n-summary)))
+ (let ((cla (cdr (assoc 'cla other-elements)))
+ (des (cdr (assoc 'des other-elements)))
+ (loc (cdr (assoc 'loc other-elements)))
+ (org (cdr (assoc 'org other-elements)))
+ (sta (cdr (assoc 'sta other-elements)))
+ (sum (cdr (assoc 'sum other-elements)))
+ (url (cdr (assoc 'url other-elements)))
+ (uid (cdr (assoc 'uid other-elements))))
+ (if cla
+ (setq contents (concat contents "\nCLASS:" cla)))
+ (if des
+ (setq contents (concat contents "\nDESCRIPTION:"
+ des)))
+ (if loc
+ (setq contents (concat contents "\nLOCATION:" loc)))
+ (if org
+ (setq contents (concat contents "\nORGANIZER:"
+ org)))
+ (if sta
+ (setq contents (concat contents "\nSTATUS:" sta)))
+ ;;(if sum
+ ;; (setq contents (concat contents "\nSUMMARY:" sum)))
+ (if url
+ (setq contents (concat contents "\nURL:" url)))
+
+ (setq header (concat "\nBEGIN:VEVENT\nUID:"
+ (or uid
+ (icalendar--create-uid
+ entry-full contents))))
+ (setq alarm (icalendar--create-ical-alarm
+ (cdr contents-n-summary))))
+ (setq result (concat result header contents alarm
+ "\nEND:VEVENT")))
+ (if (consp cns-cons-or-list)
+ (list cns-cons-or-list)
+ cns-cons-or-list)))
;; handle errors
(error
(setq found-error t)
(save-current-buffer
(set-buffer (get-buffer-create "*icalendar-errors*"))
- (insert (format "Error in line %d -- %s: `%s'\n"
- (count-lines (point-min) (point))
- error-val
- entry-main))))))
+ (insert (format-message "Error in line %d -- %s: `%s'\n"
+ (count-lines (point-min) (point))
+ error-val
+ entry-main))))))
;; we're done, insert everything into the file
(save-current-buffer
@@ -1081,16 +1144,18 @@ FExport diary data into iCalendar file: ")
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(or
- ;; anniversaries -- %%(diary-anniversary ...)
- (icalendar--convert-anniversary-to-ical nonmarker entry-main)
- ;; cyclic events -- %%(diary-cyclic ...)
- (icalendar--convert-cyclic-to-ical nonmarker entry-main)
- ;; diary-date -- %%(diary-date ...)
- (icalendar--convert-date-to-ical nonmarker entry-main)
- ;; float events -- %%(diary-float ...)
- (icalendar--convert-float-to-ical nonmarker entry-main)
- ;; block events -- %%(diary-block ...)
- (icalendar--convert-block-to-ical nonmarker entry-main)
+ (unless icalendar-export-sexp-enumerate-all
+ (or
+ ;; anniversaries -- %%(diary-anniversary ...)
+ (icalendar--convert-anniversary-to-ical nonmarker entry-main)
+ ;; cyclic events -- %%(diary-cyclic ...)
+ (icalendar--convert-cyclic-to-ical nonmarker entry-main)
+ ;; diary-date -- %%(diary-date ...)
+ (icalendar--convert-date-to-ical nonmarker entry-main)
+ ;; float events -- %%(diary-float ...)
+ (icalendar--convert-float-to-ical nonmarker entry-main)
+ ;; block events -- %%(diary-block ...)
+ (icalendar--convert-block-to-ical nonmarker entry-main)))
;; other sexp diary entries
(icalendar--convert-sexp-to-ical nonmarker entry-main)
;; weekly by day -- Monday 8:30 Team meeting
@@ -1218,6 +1283,43 @@ Returns an alist."
(if url (cons 'url url) nil)
(if uid (cons 'uid uid) nil))))))))
+(defun icalendar--create-ical-alarm (summary)
+ "Return VALARM blocks for the given SUMMARY."
+ (when icalendar-export-alarms
+ (let* ((advance-time (car icalendar-export-alarms))
+ (alarm-specs (cadr icalendar-export-alarms))
+ (fun (lambda (spec)
+ (icalendar--do-create-ical-alarm advance-time spec summary))))
+ (mapconcat fun alarm-specs ""))))
+
+(defun icalendar--do-create-ical-alarm (advance-time alarm-spec summary)
+ "Return a VALARM block.
+Argument ADVANCE-TIME is a number giving the time when the alarm
+fires (minutes before the respective event). Argument ALARM-SPEC
+is a list which must be one of '(audio), '(display) or
+'(email (ADDRESS1 ...)), see `icalendar-export-alarms'. Argument
+SUMMARY is a string which contains a short description for the
+alarm."
+ (let* ((action (car alarm-spec))
+ (act (format "\nACTION:%s"
+ (cdr (assoc action '((audio . "AUDIO")
+ (display . "DISPLAY")
+ (email . "EMAIL"))))))
+ (tri (format "\nTRIGGER:-PT%dM" advance-time))
+ (des (if (memq action '(display email))
+ (format "\nDESCRIPTION:%s" summary)
+ ""))
+ (sum (if (eq action 'email)
+ (format "\nSUMMARY:%s" summary)
+ ""))
+ (att (if (eq action 'email)
+ (mapconcat (lambda (i)
+ (format "\nATTENDEE:MAILTO:%s" i))
+ (cadr alarm-spec) "")
+ "")))
+
+ (concat "\nBEGIN:VALARM" act tri des sum att "\nEND:VALARM")))
+
;; subroutines for icalendar-export-region
(defun icalendar--convert-ordinary-to-ical (nonmarker entry-main)
"Convert \"ordinary\" diary entry to iCalendar format.
@@ -1226,9 +1328,9 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match
(concat nonmarker
"\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-*" ; date
- "\\(\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" ; start time
+ "\\(\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?" ; start time
"\\("
- "-\\([0-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" ; end time
+ "-\\([0-9][0-9]?\\(:[0-9][0-9]\\)?\\)\\([ap]m\\)?\\)?" ; end time
"\\)?"
"\\s-*\\(.*?\\) ?$")
entry-main)
@@ -1245,25 +1347,25 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(match-beginning 3)
(match-end 3))
nil)
- (if (match-beginning 4)
+ (if (match-beginning 5)
(substring entry-main
- (match-beginning 4)
- (match-end 4))
+ (match-beginning 5)
+ (match-end 5))
nil)))
(endtimestring (icalendar--diarytime-to-isotime
- (if (match-beginning 6)
- (substring entry-main
- (match-beginning 6)
- (match-end 6))
- nil)
(if (match-beginning 7)
(substring entry-main
(match-beginning 7)
(match-end 7))
+ nil)
+ (if (match-beginning 9)
+ (substring entry-main
+ (match-beginning 9)
+ (match-end 9))
nil)))
(summary (icalendar--convert-string-for-export
- (substring entry-main (match-beginning 8)
- (match-end 8)))))
+ (substring entry-main (match-beginning 10)
+ (match-end 10)))))
(icalendar--dmsg "ordinary %s" entry-main)
(unless startisostring
@@ -1289,7 +1391,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(- time 230000)))
(setq endisostring1 endisostring)) )))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
@@ -1370,7 +1472,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring
"VALUE=DATE-TIME:"
"VALUE=DATE:")
@@ -1403,7 +1505,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
NONMARKER is a regular expression matching the start of non-marking
entries. ENTRY-MAIN is the first line of the diary entry."
(if (string-match (concat nonmarker
- (if (eq (icalendar--date-style) 'european)
+ (if (eq calendar-date-style 'european)
"\\([0-9]+[0-9]?\\)\\s-+\\([a-z]+\\)\\s-+"
"\\([a-z]+\\)\\s-+\\([0-9]+[0-9]?\\)\\s-+")
"\\*?\\s-*"
@@ -1414,8 +1516,8 @@ entries. ENTRY-MAIN is the first line of the diary entry."
"\\s-*\\([^0-9]+.*?\\) ?$" ; must not match years
)
entry-main)
- (let* ((daypos (if (eq (icalendar--date-style) 'european) 1 2))
- (monpos (if (eq (icalendar--date-style) 'european) 2 1))
+ (let* ((daypos (if (eq calendar-date-style 'european) 1 2))
+ (monpos (if (eq calendar-date-style 'european) 2 1))
(day (read (substring entry-main
(match-beginning daypos)
(match-end daypos))))
@@ -1457,7 +1559,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
(format "1900%02d%02d" month day)
@@ -1478,13 +1580,16 @@ entries. ENTRY-MAIN is the first line of the diary entry."
;; no match
nil))
-(defun icalendar--convert-sexp-to-ical (nonmarker entry-main)
- "Convert complex sexp diary entry to iCalendar format -- unsupported!
-
-FIXME!
+(defun icalendar--convert-sexp-to-ical (nonmarker entry-main &optional start)
+ "Convert sexp diary entry to iCalendar format.
+Enumerate the evaluated sexp entry for the next
+`icalendar-export-sexp-enumeration-days' days. NONMARKER is a
+regular expression matching the start of non-marking entries.
+ENTRY-MAIN is the first line of the diary entry.
-NONMARKER is a regular expression matching the start of non-marking
-entries. ENTRY-MAIN is the first line of the diary entry."
+Optional argument START determines the first day of the
+enumeration, given as a time value, in same format as returned by
+`current-time' -- used for test purposes."
(cond ((string-match (concat nonmarker
"%%(and \\(([^)]+)\\))\\(\\s-*.*?\\) ?$")
entry-main)
@@ -1497,10 +1602,37 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(substring entry-main (match-beginning 1) (match-end 1))
(substring entry-main (match-beginning 2) (match-end 2)))))
((string-match (concat nonmarker
- "%%([^)]+)\\s-*.*")
+ "%%\\(([^)]+)\\)\\s-*\\(.*\\)")
entry-main)
+ ;; regular sexp entry
(icalendar--dmsg "diary-sexp %s" entry-main)
- (error "Sexp-entries are not supported yet"))
+ (let ((p1 (substring entry-main (match-beginning 1) (match-end 1)))
+ (p2 (substring entry-main (match-beginning 2) (match-end 2)))
+ (now (or start (current-time))))
+ (delete nil
+ (mapcar
+ (lambda (offset)
+ (let* ((day (decode-time (time-add now
+ (seconds-to-time
+ (* offset 60 60 24)))))
+ (d (nth 3 day))
+ (m (nth 4 day))
+ (y (nth 5 day))
+ (se (diary-sexp-entry p1 p2 (list m d y)))
+ (see (cond ((stringp se) se)
+ ((consp se) (cdr se))
+ (t nil))))
+ (cond ((null see)
+ nil)
+ ((stringp see)
+ (let ((calendar-date-style 'iso))
+ (icalendar--convert-ordinary-to-ical
+ nonmarker (format "%4d/%02d/%02d %s" y m d see))))
+ (;TODO:
+ (error "Unsupported Sexp-entry: %s"
+ entry-main)))))
+ (number-sequence
+ 0 (- icalendar-export-sexp-enumeration-days 1))))))
(t
;; no match
nil)))
@@ -1565,7 +1697,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(+ 10000 time))))))
(if starttimestring
;; with time -> write rrule
- (list (concat "\nDTSTART;VALUE=DATE-TIME:"
+ (cons (concat "\nDTSTART;VALUE=DATE-TIME:"
startisostring
starttimestring
"\nDTEND;VALUE=DATE-TIME:"
@@ -1575,7 +1707,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
endisostring)
summary)
;; no time -> write long event
- (list (concat "\nDTSTART;VALUE=DATE:" startisostring
+ (cons (concat "\nDTSTART;VALUE=DATE:" startisostring
"\nDTEND;VALUE=DATE:" endisostring+1)
summary)))
;; no match
@@ -1611,10 +1743,10 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(icalendar--dmsg "diary-float %s" entry-main)
(error "Don't know if or how to implement day in `diary-float'")))
- (list (concat
+ (cons (concat
;;Start today (yes this is an arbitrary choice):
"\nDTSTART;VALUE=DATE:"
- (format-time-string "%Y%m%d" (current-time))
+ (format-time-string "%Y%m%d")
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
@@ -1623,7 +1755,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
- (format-time-string "%Y%m%d" (current-time))))
+ (format-time-string "%Y%m%d")))
"\nRRULE:"
(if (or (numberp month) (listp month))
"FREQ=YEARLY;BYMONTH="
@@ -1716,7 +1848,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
@@ -1785,7 +1917,7 @@ entries. ENTRY-MAIN is the first line of the diary entry."
starttimestring))))
(setq endtimestring (format "T%06d"
(+ 10000 time))))))
- (list (concat "\nDTSTART;"
+ (cons (concat "\nDTSTART;"
(if starttimestring "VALUE=DATE-TIME:"
"VALUE=DATE:")
startisostring
@@ -1822,7 +1954,7 @@ Optional argument NON-MARKING determines whether events are created as
non-marking or not."
(interactive "fImport iCalendar data from file: \n\
Finto diary file:
-p")
+P")
;; clean up the diary file
(save-current-buffer
;; now load and convert from the ical file
@@ -2222,11 +2354,11 @@ END-T is the event's end time in diary format."
(let ((day (nth 3 dtstart-dec))
(month (nth 4 dtstart-dec)))
(setq result (concat "%%(and (diary-date "
- (cond ((eq (icalendar--date-style) 'iso)
+ (cond ((eq calendar-date-style 'iso)
(format "t %d %d" month day))
- ((eq (icalendar--date-style) 'european)
+ ((eq calendar-date-style 'european)
(format "%d %d t" day month))
- ((eq (icalendar--date-style) 'american)
+ ((eq calendar-date-style 'american)
(format "%d %d t" month day)))
") (diary-block "
dtstart-conv
@@ -2248,16 +2380,16 @@ END-T is the event's end time in diary format."
(format
"%%%%(and (diary-date %s) (diary-block %s %s)) %s%s%s"
(let ((day (nth 3 dtstart-dec)))
- (cond ((eq (icalendar--date-style) 'iso)
+ (cond ((eq calendar-date-style 'iso)
(format "t t %d" day))
- ((eq (icalendar--date-style) 'european)
+ ((eq calendar-date-style 'european)
(format "%d t t" day))
- ((eq (icalendar--date-style) 'american)
+ ((eq calendar-date-style 'american)
(format "t %d t" day))))
dtstart-conv
(if until
until-conv
- (if (eq (icalendar--date-style) 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
+ (if (eq calendar-date-style 'iso) "9999 1 1" "1 1 9999")) ;; FIXME: should be unlimited
(or start-t "")
(if end-t "-" "") (or end-t ""))))
;; daily
@@ -2341,8 +2473,8 @@ SUMMARY is not nil it must be a string that gives the summary of the
entry. In this case the user will be asked whether he wants to insert
the entry."
(when (or (not summary)
- (y-or-n-p (format "Add appointment for `%s' to diary? "
- summary)))
+ (y-or-n-p (format-message "Add appointment for `%s' to diary? "
+ summary)))
(when summary
(setq non-marking
(y-or-n-p (format "Make appointment non-marking? "))))
@@ -2368,8 +2500,8 @@ the entry."
;; ======================================================================
(defun icalendar-import-format-sample (event)
"Example function for formatting an iCalendar EVENT."
- (format (concat "SUMMARY=`%s' DESCRIPTION=`%s' LOCATION=`%s' ORGANIZER=`%s' "
- "STATUS=`%s' URL=`%s' CLASS=`%s'")
+ (format (concat "SUMMARY='%s' DESCRIPTION='%s' LOCATION='%s' ORGANIZER='%s' "
+ "STATUS='%s' URL='%s' CLASS='%s'")
(or (icalendar--get-event-property event 'SUMMARY) "")
(or (icalendar--get-event-property event 'DESCRIPTION) "")
(or (icalendar--get-event-property event 'LOCATION) "")
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index c62fb7622e0..1e0be16e71c 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,6 +1,6 @@
;;; lunar.el --- calendar functions for phases of the moon
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2013 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -228,10 +228,6 @@ use instead of point."
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
-;;;###cal-autoload
-(define-obsolete-function-alias 'calendar-phases-of-moon
- 'calendar-lunar-phases "23.1")
-
;;;###autoload
(defun lunar-phases (&optional arg)
"Display the quarters of the moon for last month, this month, and next month.
@@ -245,9 +241,6 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-lunar-phases))))
-;;;###autoload
-(define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1")
-
(defvar date)
;; To be called from diary-list-sexp-entries, where DATE is bound.
@@ -266,10 +259,6 @@ use when highlighting the day in the calendar."
(cons mark (concat (lunar-phase-name (nth 2 phase)) " "
(cadr phase))))))
-;;;###diary-autoload
-(define-obsolete-function-alias 'diary-phases-of-moon
- 'diary-lunar-phases "23.1")
-
;; For the Chinese calendar the calculations for the new moon need to be more
;; accurate than those above, so we use more terms in the approximation.
(defun lunar-new-moon-time (k)
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 5977062f8c3..b2b065ab65e 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -1,6 +1,6 @@
;;; parse-time.el --- parsing time strings
-;; Copyright (C) 1996, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2015 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: util
@@ -34,21 +34,12 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
-(defvar parse-time-digits (make-vector 256 nil))
+(require 'cl-lib)
;; Byte-compiler warnings
(defvar parse-time-elt)
(defvar parse-time-val)
-(unless (aref parse-time-digits ?0)
- (cl-loop for i from ?0 to ?9
- do (aset parse-time-digits i (- i ?0))))
-
-(defsubst digit-char-p (char)
- (aref parse-time-digits char))
-
(defsubst parse-time-string-chars (char)
(save-match-data
(let (case-fold-search str)
@@ -59,30 +50,6 @@
((string-match "[[:lower:]]" str) ?a)
((string-match "[[:digit:]]" str) ?0)))))
-(put 'parse-error 'error-conditions '(parse-error error))
-(put 'parse-error 'error-message "Parsing error")
-
-(defsubst parse-integer (string &optional start end)
- "[CL] Parse and return the integer in STRING, or nil if none."
- (let ((integer 0)
- (digit 0)
- (index (or start 0))
- (end (or end (length string))))
- (when (< index end)
- (let ((sign (aref string index)))
- (if (or (eq sign ?+) (eq sign ?-))
- (setq sign (parse-time-string-chars sign)
- index (1+ index))
- (setq sign 1))
- (while (and (< index end)
- (setq digit (digit-char-p (aref string index))))
- (setq integer (+ (* integer 10) digit)
- index (1+ index)))
- (if (/= index end)
- (signal 'parse-error `("not an integer"
- ,(substring string (or start 0) end)))
- (* sign integer))))))
-
(defun parse-time-tokenize (string)
"Tokenize STRING into substrings."
(let ((start nil)
@@ -100,7 +67,7 @@
(setq c (parse-time-string-chars (aref string index))))
(setq all-digits (and all-digits (eq c ?0))))
(if (<= index end)
- (push (if all-digits (parse-integer string start index)
+ (push (if all-digits (cl-parse-integer string :start start :end index)
(substring string start index))
list)))
(nreverse list)))
@@ -131,7 +98,7 @@
`(((6) parse-time-weekdays)
((3) (1 31))
((4) parse-time-months)
- ((5) (100 4038))
+ ((5) (100 ,most-positive-fixnum))
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 8)
@@ -147,8 +114,8 @@
(= 5 (length parse-time-elt))
(or (= (aref parse-time-elt 0) ?+)
(= (aref parse-time-elt 0) ?-))))
- ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5)
- (* 60 (parse-integer parse-time-elt 1 3)))
+ ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5)
+ (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3)))
(if (= (aref parse-time-elt 0) ?-) -1 1))))
((5 4 3)
,#'(lambda () (and (stringp parse-time-elt)
@@ -210,14 +177,77 @@ unknown are returned as nil."
(let ((new-val (if rule
(let ((this (pop rule)))
(if (vectorp this)
- (parse-integer
+ (cl-parse-integer
parse-time-elt
- (aref this 0) (aref this 1))
+ :start (aref this 0)
+ :end (aref this 1))
(funcall this)))
parse-time-val)))
(rplaca (nthcdr (pop slots) time) new-val))))))))
time))
+(defconst parse-time-iso8601-regexp
+ (let* ((dash "-?")
+ (colon ":?")
+ (4digit "\\([0-9][0-9][0-9][0-9]\\)")
+ (2digit "\\([0-9][0-9]\\)")
+ (date-fullyear 4digit)
+ (date-month 2digit)
+ (date-mday 2digit)
+ (time-hour 2digit)
+ (time-minute 2digit)
+ (time-second 2digit)
+ (time-secfrac "\\(\\.[0-9]+\\)?")
+ (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute))
+ (time-offset (concat "Z" time-numoffset))
+ (partial-time (concat time-hour colon time-minute colon time-second
+ time-secfrac))
+ (full-date (concat date-fullyear dash date-month dash date-mday))
+ (full-time (concat partial-time time-offset))
+ (date-time (concat full-date "T" full-time)))
+ (list (concat "^" full-date)
+ (concat "T" partial-time)
+ (concat "Z" time-numoffset)))
+ "List of regular expressions matching ISO 8601 dates.
+1st regular expression matches the date.
+2nd regular expression matches the time.
+3rd regular expression matches the (optional) timezone specification.")
+
+(defun parse-iso8601-time-string (date-string)
+ (let* ((date-re (nth 0 parse-time-iso8601-regexp))
+ (time-re (nth 1 parse-time-iso8601-regexp))
+ (tz-re (nth 2 parse-time-iso8601-regexp))
+ re-start
+ time seconds minute hour fractional-seconds
+ day month year day-of-week dst tz)
+ ;; We need to populate 'time' with
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+
+ ;; Nobody else handles iso8601 correctly, let's do it ourselves.
+ (when (string-match date-re date-string re-start)
+ (setq year (string-to-number (match-string 1 date-string))
+ month (string-to-number (match-string 2 date-string))
+ day (string-to-number (match-string 3 date-string))
+ re-start (match-end 0))
+ (when (string-match time-re date-string re-start)
+ (setq hour (string-to-number (match-string 1 date-string))
+ minute (string-to-number (match-string 2 date-string))
+ seconds (string-to-number (match-string 3 date-string))
+ fractional-seconds (string-to-number (or
+ (match-string 4 date-string)
+ "0"))
+ re-start (match-end 0))
+ (when (string-match tz-re date-string re-start)
+ (setq tz (match-string 1 date-string)))
+ (setq time (list seconds minute hour day month year day-of-week dst tz))))
+
+ ;; Fall back to having Gnus do fancy things for us.
+ (when (not time)
+ (setq time (parse-time-string date-string)))
+
+ (and time
+ (apply 'encode-time time))))
+
(provide 'parse-time)
;;; parse-time.el ends here
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 8de8740c4cc..a2f9d58585a 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,6 +1,6 @@
;;; solar.el --- calendar functions for solar events
-;; Copyright (C) 1992-1993, 1995, 1997, 2001-2013 Free Software
+;; Copyright (C) 1992-1993, 1995, 1997, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -346,7 +346,7 @@ If SUNRISE-FLAG is non-nil, only calculate longitude and inclination."
(solar-cosine-degrees (* 2 l)))
(* -0.5 y y (solar-sin-degrees (* 4 l)))
(* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
- 3.1415926535))))
+ float-pi))))
(list app i time-eq nut)))
(defun solar-ephemeris-correction (year)
@@ -657,7 +657,7 @@ Corresponding value is nil if there is no sunrise/sunset."
Optional NOLOCATION non-nil means do not print the location."
(let ((l (solar-sunrise-sunset date)))
(format
- "%s, %s%s (%s hours daylight)"
+ "%s, %s%s (%s hrs daylight)"
(if (car l)
(concat "Sunrise " (apply 'solar-time-string (car l)))
"No sunrise")
@@ -847,20 +847,12 @@ This function is suitable for execution in an init file."
(date (if (< arg 4) (calendar-current-date) (calendar-read-date)))
(date-string (calendar-date-string date t))
(time-string (solar-sunrise-sunset-string date))
- (msg (format "%s: %s" date-string time-string))
- (one-window (one-window-p t)))
- (if (<= (length msg) (frame-width))
- (message "%s" msg)
- (with-output-to-temp-buffer "*temp*"
- (princ (concat date-string "\n" time-string)))
- (message "%s"
- (substitute-command-keys
- (if one-window
- (if pop-up-windows
- "Type \\[delete-other-windows] to remove temp window."
- "Type \\[switch-to-buffer] RET to remove temp window.")
- "Type \\[switch-to-buffer-other-window] RET to restore old \
-contents of temp window."))))))
+ (msg (format "%s%s"
+ (if (< arg 4) "" ; don't print date if it's today's
+ (format "%s: " date-string))
+ time-string)))
+ (message "%s" msg)
+ msg))
;;;###cal-autoload
(defun calendar-sunrise-sunset (&optional event)
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 71c8117364a..2c646456112 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -1,6 +1,6 @@
;;; time-date.el --- Date and time handling functions
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
@@ -30,10 +30,9 @@
;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12
;; seconds, where missing components are treated as zero. HIGH can be
;; negative, either because the value is a time difference, or because
-;; the machine supports negative time stamps that fall before the epoch.
-;; The macro `with-decoded-time-value' and the function
-;; `encode-time-value' make it easier to deal with these formats.
-;; See `time-subtract' for an example of how to use them.
+;; it represents a time stamp before the epoch. Typically, there are
+;; more time values than the underlying system time type supports,
+;; but the reverse can also be true.
;;; Code:
@@ -44,7 +43,7 @@ The value of the last form in BODY is returned.
Each element of the list VARLIST is a list of the form
\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE).
-The time value TIME-VALUE is decoded and the result it bound to
+The time value TIME-VALUE is decoded and the result is bound to
the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
The optional PICO-SYMBOL is bound to the picoseconds part.
@@ -53,7 +52,8 @@ Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the
list (HIGH LOW MICRO PICO)."
(declare (indent 1)
- (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
+ (debug ((&rest (symbolp symbolp symbolp
+ &or [symbolp symbolp form] [symbolp form] form))
body)))
(if varlist
(let* ((elt (pop varlist))
@@ -66,7 +66,32 @@ list (HIGH LOW MICRO PICO)."
(pop elt)))
(time-value (car elt))
(gensym (make-symbol "time")))
- `(let* ,(append `((,gensym ,time-value)
+ `(let* ,(append `((,gensym (or ,time-value (current-time)))
+ (,gensym
+ (cond
+ ((integerp ,gensym)
+ (list (ash ,gensym -16)
+ (logand ,gensym 65535)))
+ ((floatp ,gensym)
+ (let* ((usec (* 1000000 (mod ,gensym 1)))
+ (ps (round (* 1000000 (mod usec 1))))
+ (us (floor usec))
+ (lo (floor (mod ,gensym 65536)))
+ (hi (floor ,gensym 65536)))
+ (if (eq ps 1000000)
+ (progn
+ (setq ps 0)
+ (setq us (1+ us))
+ (if (eq us 1000000)
+ (progn
+ (setq us 0)
+ (setq lo (1+ lo))
+ (if (eq lo 65536)
+ (progn
+ (setq lo 0)
+ (setq hi (1+ hi))))))))
+ (list hi lo us ps)))
+ (t ,gensym)))
(,high (pop ,gensym))
,low ,micro)
(when pico `(,pico))
@@ -108,6 +133,10 @@ it is assumed that PICO was omitted and should be treated as zero."
((eq type 3) (list high low micro pico))
((null type) (encode-time-value high low micro 0 pico))))
+(when (and (fboundp 'time-add) (subrp (symbol-function 'time-add)))
+ (make-obsolete 'encode-time-value nil "25.1")
+ (make-obsolete 'with-decoded-time-value nil "25.1"))
+
(autoload 'parse-time-string "parse-time")
(autoload 'timezone-make-date-arpa-standard "timezone")
@@ -119,13 +148,20 @@ it is assumed that PICO was omitted and should be treated as zero."
(defun date-to-time (date)
"Parse a string DATE that represents a date-time and return a time value.
If DATE lacks timezone information, GMT is assumed."
- (condition-case ()
+ (condition-case err
(apply 'encode-time (parse-time-string date))
- (error (condition-case ()
- (apply 'encode-time
- (parse-time-string
- (timezone-make-date-arpa-standard date)))
- (error (error "Invalid date: %s" date))))))
+ (error
+ (let ((overflow-error '(error "Specified time is not representable")))
+ (if (equal err overflow-error)
+ (apply 'signal err)
+ (condition-case err
+ (apply 'encode-time
+ (parse-time-string
+ (timezone-make-date-arpa-standard date)))
+ (error
+ (if (equal err overflow-error)
+ (apply 'signal err)
+ (error "Invalid date: %s" date)))))))))
;; Bit of a mess. Emacs has float-time since at least 21.1.
;; This file is synced to Gnus, and XEmacs packages may have been written
@@ -140,56 +176,28 @@ If DATE lacks timezone information, GMT is assumed."
(or (featurep 'emacs)
(and (fboundp 'float-time)
(subrp (symbol-function 'float-time)))
- (defun time-to-seconds (time)
- "Convert time value TIME to a floating point number."
- (with-decoded-time-value ((high low micro pico type time))
- (+ (* 1.0 high 65536)
+ (defun time-to-seconds (&optional time)
+ "Convert optional value TIME to a floating point number.
+TIME defaults to the current time."
+ (with-decoded-time-value ((high low micro pico _type
+ (or time (current-time))))
+ (+ (* high 65536.0)
low
(/ (+ (* micro 1e6) pico) 1e12))))))
;;;###autoload
(defun seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to a time value."
- (let* ((usec (* 1000000 (mod seconds 1)))
- (ps (round (* 1000000 (mod usec 1))))
- (us (floor usec))
- (lo (floor (mod seconds 65536)))
- (hi (floor seconds 65536)))
- (if (eq ps 1000000)
- (progn
- (setq ps 0)
- (setq us (1+ us))
- (if (eq us 1000000)
- (progn
- (setq us 0)
- (setq lo (1+ lo))
- (if (eq lo 65536)
- (progn
- (setq lo 0)
- (setq hi (1+ hi))))))))
- (list hi lo us ps)))
-
-;;;###autoload
-(defun time-less-p (t1 t2)
- "Return non-nil if time value T1 is earlier than time value T2."
- (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
- (high2 low2 micro2 pico2 type2 t2))
- (or (< high1 high2)
- (and (= high1 high2)
- (or (< low1 low2)
- (and (= low1 low2)
- (or (< micro1 micro2)
- (and (= micro1 micro2)
- (< pico1 pico2)))))))))
+ "Convert SECONDS to a time value."
+ (time-add 0 seconds))
;;;###autoload
(defun days-to-time (days)
"Convert DAYS into a time value."
- (let* ((seconds (* 1.0 days 60 60 24))
- (high (condition-case nil (floor (/ seconds 65536))
- (range-error most-positive-fixnum))))
- (list high (condition-case nil (floor (- seconds (* 1.0 high 65536)))
- (range-error 65535)))))
+ (let ((time (condition-case nil (seconds-to-time (* 86400.0 days))
+ (range-error (list most-positive-fixnum 65535)))))
+ (if (integerp days)
+ (setcdr (cdr time) nil))
+ time))
;;;###autoload
(defun time-since (time)
@@ -198,53 +206,71 @@ TIME should be either a time value or a date-time string."
(when (stringp time)
;; Convert date strings to internal time.
(setq time (date-to-time time)))
- (time-subtract (current-time) time))
+ (time-subtract nil time))
;;;###autoload
(defalias 'subtract-time 'time-subtract)
-;;;###autoload
-(defun time-subtract (t1 t2)
- "Subtract two time values, T1 minus T2.
+;; These autoloads do nothing in Emacs 25, where the functions are builtin.
+;;;###autoload(autoload 'time-add "time-date")
+;;;###autoload(autoload 'time-subtract "time-date")
+;;;###autoload(autoload 'time-less-p "time-date")
+
+(eval-and-compile
+ (when (not (and (fboundp 'time-add) (subrp (symbol-function 'time-add))))
+
+ (defun time-add (t1 t2)
+ "Add two time values T1 and T2. One should represent a time difference."
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
+ (setq high (+ high high2)
+ low (+ low low2)
+ micro (+ micro micro2)
+ pico (+ pico pico2)
+ type (max type type2))
+ (when (>= pico 1000000)
+ (setq micro (1+ micro)
+ pico (- pico 1000000)))
+ (when (>= micro 1000000)
+ (setq low (1+ low)
+ micro (- micro 1000000)))
+ (when (>= low 65536)
+ (setq high (1+ high)
+ low (- low 65536)))
+ (encode-time-value high low micro pico type)))
+
+ (defun time-subtract (t1 t2)
+ "Subtract two time values, T1 minus T2.
Return the difference in the format of a time value."
- (with-decoded-time-value ((high low micro pico type t1)
- (high2 low2 micro2 pico2 type2 t2))
- (setq high (- high high2)
- low (- low low2)
- micro (- micro micro2)
- pico (- pico pico2)
- type (max type type2))
- (when (< pico 0)
- (setq micro (1- micro)
- pico (+ pico 1000000)))
- (when (< micro 0)
- (setq low (1- low)
- micro (+ micro 1000000)))
- (when (< low 0)
- (setq high (1- high)
- low (+ low 65536)))
- (encode-time-value high low micro pico type)))
-
-;;;###autoload
-(defun time-add (t1 t2)
- "Add two time values T1 and T2. One should represent a time difference."
- (with-decoded-time-value ((high low micro pico type t1)
- (high2 low2 micro2 pico2 type2 t2))
- (setq high (+ high high2)
- low (+ low low2)
- micro (+ micro micro2)
- pico (+ pico pico2)
- type (max type type2))
- (when (>= pico 1000000)
- (setq micro (1+ micro)
- pico (- pico 1000000)))
- (when (>= micro 1000000)
- (setq low (1+ low)
- micro (- micro 1000000)))
- (when (>= low 65536)
- (setq high (1+ high)
- low (- low 65536)))
- (encode-time-value high low micro pico type)))
+ (with-decoded-time-value ((high low micro pico type t1)
+ (high2 low2 micro2 pico2 type2 t2))
+ (setq high (- high high2)
+ low (- low low2)
+ micro (- micro micro2)
+ pico (- pico pico2)
+ type (max type type2))
+ (when (< pico 0)
+ (setq micro (1- micro)
+ pico (+ pico 1000000)))
+ (when (< micro 0)
+ (setq low (1- low)
+ micro (+ micro 1000000)))
+ (when (< low 0)
+ (setq high (1- high)
+ low (+ low 65536)))
+ (encode-time-value high low micro pico type)))
+
+ (defun time-less-p (t1 t2)
+ "Return non-nil if time value T1 is earlier than time value T2."
+ (with-decoded-time-value ((high1 low1 micro1 pico1 _type1 t1)
+ (high2 low2 micro2 pico2 _type2 t2))
+ (or (< high1 high2)
+ (and (= high1 high2)
+ (or (< low1 low2)
+ (and (= low1 low2)
+ (or (< micro1 micro2)
+ (and (= micro1 micro2)
+ (< pico1 pico2)))))))))))
;;;###autoload
(defun date-to-day (date)
@@ -265,11 +291,9 @@ DATE1 and DATE2 should be date-time strings."
(not (zerop (% year 100))))
(zerop (% year 400))))
-;;;###autoload
-(defun time-to-day-in-year (time)
- "Return the day number within the year corresponding to TIME."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
+(defun time-date--day-in-year (tim)
+ "Return the day number within the year corresponding to the decoded time TIM."
+ (let* ((month (nth 4 tim))
(day (nth 3 tim))
(year (nth 5 tim))
(day-of-year (+ day (* 31 (1- month)))))
@@ -280,13 +304,18 @@ DATE1 and DATE2 should be date-time strings."
day-of-year))
;;;###autoload
+(defun time-to-day-in-year (time)
+ "Return the day number within the year corresponding to TIME."
+ (time-date--day-in-year (decode-time time)))
+
+;;;###autoload
(defun time-to-days (time)
"The number of days between the Gregorian date 0001-12-31bce and TIME.
TIME should be a time value.
The Gregorian date Sunday, December 31, 1bce is imaginary."
(let* ((tim (decode-time time))
(year (nth 5 tim)))
- (+ (time-to-day-in-year time) ; Days this year
+ (+ (time-date--day-in-year tim) ; Days this year
(* 365 (1- year)) ; + Days in prior years
(/ (1- year) 4) ; + Julian leap years
(- (/ (1- year) 100)) ; - century years
@@ -388,6 +417,23 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
t t string))))))
(replace-regexp-in-string "%%" "%" string))
+(defvar seconds-to-string
+ (list (list 1 "ms" 0.001)
+ (list 100 "s" 1)
+ (list (* 60 100) "m" 60.0)
+ (list (* 3600 30) "h" 3600.0)
+ (list (* 3600 24 400) "d" (* 3600.0 24.0))
+ (list nil "y" (* 365.25 24 3600)))
+ "Formatting used by the function `seconds-to-string'.")
+;;;###autoload
+(defun seconds-to-string (delay)
+ "Convert the time interval in seconds to a short string."
+ (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay))))
+ ((= 0 delay) "0s")
+ (t (let ((sts seconds-to-string) here)
+ (while (and (car (setq here (pop sts)))
+ (<= (car here) delay)))
+ (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here))))))
(provide 'time-date)
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index da074d377b5..67fc4c546ff 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1,6 +1,6 @@
;;; timeclock.el --- mode for keeping track of how much you work
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
@@ -64,7 +64,7 @@
;;
;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
-;; NOTE: If you change your .timelog file without using timeclock's
+;; NOTE: If you change your timelog file without using timeclock's
;; functions, or if you change the value of any of timeclock's
;; customizable variables, you should run the command
;; `timeclock-reread-log'. This will recompute any discrepancies in
@@ -83,6 +83,7 @@
(defcustom timeclock-file (locate-user-emacs-file "timelog" ".timelog")
"The file used to store timeclock data in."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'timeclock)
@@ -319,7 +320,7 @@ display (non-nil means on)."
(cancel-timer timeclock-update-timer)
(setq timeclock-update-timer nil))))
-(defsubst timeclock-time-to-date (time)
+(defsubst timeclock-time-to-date (&optional time)
"Convert the TIME value to a textual date string."
(format-time-string "%Y/%m/%d" time))
@@ -350,7 +351,7 @@ discover the name of the project."
(unless (and timeclock-last-event
(equal (timeclock-time-to-date
(cadr timeclock-last-event))
- (timeclock-time-to-date (current-time))))
+ (timeclock-time-to-date)))
(let ((workday (or (and (numberp arg) arg)
(and arg 0)
(and timeclock-get-workday-function
@@ -542,7 +543,7 @@ non-nil, the amount returned will be relative to past time worked."
If TODAY-ONLY is non-nil, the value returned will be relative only to
the time worked today, and not to past time."
(timeclock-seconds-to-time
- (- (timeclock-time-to-seconds (current-time))
+ (- (timeclock-time-to-seconds)
(let ((discrep (timeclock-find-discrep)))
(if discrep
(if today-only
@@ -646,14 +647,12 @@ that variable's documentation."
(if timeclock-use-elapsed
(timeclock-workday-elapsed)
(timeclock-workday-remaining (not timeclock-relative))))
- (last-in (equal (car timeclock-last-event) "i")))
+ (last-in (equal (car timeclock-last-event) "i"))
+ (todays-date (timeclock-time-to-date)))
(when (and (< remainder 0)
(not (and timeclock-day-over
- (equal timeclock-day-over
- (timeclock-time-to-date
- (current-time))))))
- (setq timeclock-day-over
- (timeclock-time-to-date (current-time)))
+ (equal timeclock-day-over todays-date))))
+ (setq timeclock-day-over todays-date)
(run-hooks 'timeclock-day-over-hook))
(setq timeclock-mode-string
(propertize
@@ -724,9 +723,8 @@ recorded to disk. If MOMENT is non-nil, use that as the current time.
This is only provided for coherency when used by
`timeclock-discrepancy'."
(if (equal (car timeclock-last-event) "i")
- (- (timeclock-time-to-seconds (or moment (current-time)))
- (timeclock-time-to-seconds
- (cadr timeclock-last-event)))
+ (- (timeclock-time-to-seconds moment)
+ (timeclock-time-to-seconds (cadr timeclock-last-event)))
timeclock-last-period))
(defsubst timeclock-entry-length (entry)
@@ -921,7 +919,7 @@ following format:
(DEBT ENTRIES-BY-DAY ENTRIES-BY-PROJECT)
DEBT is a floating point number representing the number of seconds
-\"owed\" before any work was done. For a new file (one without a 'b'
+“owed” before any work was done. For a new file (one without a `b'
entry), this is always zero.
The two entries lists have similar formats. They are both alists,
@@ -1155,7 +1153,7 @@ discrepancy, today's discrepancy, and the time worked today."
(+ timeclock-last-period timeclock-elapsed)))))
(setq timeclock-last-event event
timeclock-last-event-workday
- (if (equal (timeclock-time-to-date now) last-date-limited)
+ (if (equal todays-date last-date-limited)
last-date-seconds
timeclock-workday))
(forward-line))
@@ -1181,7 +1179,7 @@ discrepancy, today's discrepancy, and the time worked today."
(defun timeclock-day-base (&optional time)
"Given a time within a day, return 0:0:0 within that day.
If optional argument TIME is non-nil, use that instead of the current time."
- (let ((decoded (decode-time (or time (current-time)))))
+ (let ((decoded (decode-time time)))
(setcar (nthcdr 0 decoded) 0)
(setcar (nthcdr 1 decoded) 0)
(setcar (nthcdr 2 decoded) 0)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 943aa8b34b5..27ca17b4e4f 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1,6 +1,6 @@
;;; todo-mode.el --- facilities for making and maintaining todo lists
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Stephen Berman <stephen.berman@gmx.net>
@@ -24,63 +24,37 @@
;;; Commentary:
-;; This package provides facilities for making, displaying, navigating
-;; and editing todo lists, which are prioritized lists of todo items.
-;; Todo lists are identified with named categories, so you can group
-;; together and separately prioritize thematically related todo items.
-;; Each category is stored in a file, which thus provides a further
-;; level of organization. You can create as many todo files, and in
-;; each as many categories, as you want.
+;; This package provides facilities for making and maintaining
+;; prioritized lists of things to do. These todo lists are identified
+;; with named categories, so you can group together thematically
+;; related todo items. Each category is stored in a file, providing a
+;; further level of organization. You can create as many todo files,
+;; and in each as many categories, as you want.
;; With Todo mode you can navigate among the items of a category, and
;; between categories in the same and in different todo files. You
-;; can edit todo items, reprioritize them within their category, move
-;; them to another category, delete them, or mark items as done and
-;; store them separately from the not yet done items in a category.
-;; You can add new todo files, edit and delete them. You can add new
-;; categories, rename and delete them, move categories to another file
-;; and merge the items of two categories. You can also reorder the
-;; sequence of categories in a todo file for the purpose of
-;; navigation. You can display summary tables of the categories in a
-;; file and the types of items they contain. And you can compile
-;; lists of existing items from multiple categories in one or more
-;; todo files, which are filtered by various criteria.
-
-;; To get started, load this package and type `M-x todo-show'. This
-;; will prompt you for the name of the first todo file, its first
-;; category and the category's first item, create these and display
-;; them in Todo mode. Now you can insert further items into the list
-;; (i.e., the category) and assign them priorities by typing `i i'.
-
-;; You will probably find it convenient to give `todo-show' a global
-;; key binding in your init file, since it is one of the entry points
-;; to Todo mode; a good choice is `C-c t', since `todo-show' is
-;; bound to `t' in Todo mode.
-
-;; To see a list of all Todo mode commands and their key bindings,
-;; including other entry points, type `C-h m' in Todo mode. Consult
-;; the documentation strings of the commands for details of their use.
-;; The `todo' customization group and its subgroups list the options
-;; you can set to alter the behavior of many commands and various
-;; aspects of the display.
-
-;; This package is a new version of Oliver Seidel's todo-mode.el.
-;; While it retains the same basic organization and handling of todo
-;; lists and the basic UI, it significantly extends these and adds
-;; many features. This required also making changes to the internals,
-;; including the file format. If you have a todo file in old format,
-;; then the first time you invoke `todo-show' (i.e., before you have
-;; created any todo file in the current format), it will ask you
-;; whether to convert that file and show it. If you choose not to
-;; convert the old-style file at this time, you can do so later by
-;; calling the command `todo-convert-legacy-files'.
+;; can add and edit todo items, reprioritize them, move them to
+;; another category, or delete them. You can also mark items as done
+;; and store them within their category or in separate archive files.
+;; You can include todo items in the Emacs Fancy Diary display and
+;; treat them as appointments. You can add new todo files, and rename
+;; or delete them. You can add new categories to a file, rename or
+;; delete them, move a category to another file and merge the items of
+;; two categories. You can also reorder the sequence of categories in
+;; a todo file for the purpose of navigation. You can display
+;; sortable summary tables of the categories in a file and the types
+;; of items they contain. And you can filter items by various
+;; criteria from multiple categories in one or more todo files to
+;; create prioritizable cross-category overviews of your todo items.
+
+;; To get started, type `M-x todo-show'. For full details of the user
+;; interface, commands and options, consult the Todo mode user manual,
+;; which is included in the Info documentation.
;;; Code:
(require 'diary-lib)
-;; For cl-remove-duplicates (in todo-insertion-commands-args) and
-;; cl-oddp.
-(require 'cl-lib)
+(require 'cl-lib) ; For cl-oddp and cl-assert.
;; -----------------------------------------------------------------------------
;;; Setting up todo files, categories, and items
@@ -100,7 +74,7 @@ truenames (those with the extension \".toda\")."
(let ((files (if (file-exists-p todo-directory)
(mapcar 'file-truename
(directory-files todo-directory t
- (if archives "\.toda$" "\.todo$") t)))))
+ (if archives "\\.toda$" "\\.todo$") t)))))
(sort files (lambda (s1 s2) (let ((cis1 (upcase s1))
(cis2 (upcase s2)))
(string< cis1 cis2))))))
@@ -263,7 +237,8 @@ The final element is \"*\", indicating an unspecified month.")
(when (string= (widget-value widget) todo-item-mark)
(widget-put
widget :error
- "Invalid value: must be distinct from `todo-item-mark'")
+ (format-message
+ "Invalid value: must be distinct from `todo-item-mark'"))
widget)))
:initialize 'custom-initialize-default
:set 'todo-reset-prefix
@@ -330,6 +305,11 @@ shown in the Fancy Diary display."
;;; Faces
;; -----------------------------------------------------------------------------
+(defface todo-key-prompt
+ '((t (:weight bold)))
+ "Face for making keys in item insertion prompt stand out."
+ :group 'todo-faces)
+
(defface todo-mark
;; '((t :inherit font-lock-warning-face))
'((((class color)
@@ -561,13 +541,13 @@ less than or equal the category's top priority setting."
;;; Entering and exiting
;; -----------------------------------------------------------------------------
-(defcustom todo-visit-files-commands (list 'find-file 'dired-find-file)
- "List of file finding commands for `todo-display-as-todo-file'.
-Invoking these commands to visit a todo file or todo archive file
-calls `todo-show' or `todo-find-archive', so that the file is
-displayed correctly."
- :type '(repeat function)
- :group 'todo)
+;; (defcustom todo-visit-files-commands (list 'find-file 'dired-find-file)
+;; "List of file finding commands for `todo-display-as-todo-file'.
+;; Invoking these commands to visit a todo file or todo archive file
+;; calls `todo-show' or `todo-find-archive', so that the file is
+;; displayed correctly."
+;; :type '(repeat function)
+;; :group 'todo)
(defun todo-short-file-name (file)
"Return the short form of todo file FILE's name.
@@ -693,7 +673,7 @@ corresponding todo file, displaying the corresponding category."
todo-filtered-items-mode))))
(if (funcall todo-files-function)
(todo-read-file-name "Choose a todo file to visit: "
- nil t)
+ nil t)
(user-error "There are no todo files")))
((and (eq major-mode 'todo-archive-mode)
;; Called noninteractively via todo-quit
@@ -735,9 +715,12 @@ corresponding todo file, displaying the corresponding category."
"Choose a regexp items file: "
rxf) 'regexp))))))
(if (file-exists-p fi-file)
- (set-window-buffer
- (selected-window)
- (set-buffer (find-file-noselect fi-file 'nowarn)))
+ (progn
+ (set-window-buffer
+ (selected-window)
+ (set-buffer (find-file-noselect fi-file 'nowarn)))
+ (unless (derived-mode-p 'todo-filtered-items-mode)
+ (todo-filtered-items-mode)))
(message "There is no %s file for %s"
(cond ((eq todo-show-first 'top)
"top priorities")
@@ -750,14 +733,25 @@ corresponding todo file, displaying the corresponding category."
(when (or (member file todo-visited)
(eq todo-show-first 'first))
(unless (todo-check-file file) (throw 'end nil))
- (set-window-buffer (selected-window)
+ ;; If todo-show is called from the minibuffer, don't visit
+ ;; the todo file there.
+ (set-window-buffer (if (minibufferp) (minibuffer-selected-window)
+ (selected-window))
(set-buffer (find-file-noselect file 'nowarn)))
+ (if (equal (file-name-extension (buffer-file-name)) "toda")
+ (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
+ (unless (derived-mode-p 'todo-mode) (todo-mode)))
;; When quitting an archive file, show the corresponding
;; category in the corresponding todo file, if it exists.
(when (assoc cat todo-categories)
(setq todo-category-number (todo-category-number cat)))
;; If this is a new todo file, add its first category.
(when (zerop (buffer-size))
+ ;; Don't confuse an erased buffer with a fresh buffer for
+ ;; adding a new todo file -- it might have been erased by
+ ;; mistake or due to a bug (e.g. Bug#20832).
+ (when (buffer-modified-p)
+ (error "Buffer is empty but modified, please report a bug"))
(let (cat-added)
(unwind-protect
(setq todo-category-number
@@ -782,7 +776,7 @@ corresponding todo file, displaying the corresponding category."
(kill-buffer)
(keyboard-quit)))))
(save-excursion (todo-category-select))
- (when add-item (todo-basic-insert-item)))
+ (when add-item (todo-insert-item--basic)))
(setq todo-show-first show-first)
(add-to-list 'todo-visited file)))))
@@ -942,7 +936,7 @@ Categories mode."
(todo-category-number category)
(todo-category-select)
(goto-char (point-min))
- (when add-item (todo-basic-insert-item))))))
+ (when add-item (todo-insert-item--basic))))))
(defun todo-next-item (&optional count)
"Move point down to the beginning of the next item.
@@ -1040,7 +1034,7 @@ empty line above the done items separator."
(defun todo-toggle-item-highlighting ()
"Highlight or unhighlight the todo item the cursor is on."
(interactive)
- (eval-when-compile (require 'hl-line))
+ (eval-and-compile (require 'hl-line))
(when (memq major-mode
'(todo-mode todo-archive-mode todo-filtered-items-mode))
(if hl-line-mode
@@ -1085,6 +1079,9 @@ Noninteractively, return the name of the new file."
(let* ((prompt (concat "Enter name of new todo file "
"(TAB or SPC to see current names): "))
(file (todo-read-file-name prompt)))
+ ;; Don't accept the name of an existing todo file.
+ (setq file (todo-absolute-file-name
+ (todo-validate-name (todo-short-file-name file) 'file)))
(with-current-buffer (get-buffer-create file)
(erase-buffer)
(write-region (point-min) (point-max) file nil 'nomessage nil t)
@@ -1115,7 +1112,7 @@ these files, also rename them accordingly."
(snname (todo-short-file-name nname))
(files (directory-files todo-directory t
(concat ".*" (regexp-quote soname)
- ".*\.tod[aorty]$") t)))
+ ".*\\.tod[aorty]$") t)))
(dolist (f files)
(let* ((sfname (todo-short-file-name f))
(fext (file-name-extension f t))
@@ -1174,10 +1171,28 @@ visiting the deleted files."
(when (file-exists-p file1) (delete-file file1))
(setq todo-visited (delete file1 todo-visited))
(kill-buffer buf1)
- (when delete2
- (when (file-exists-p file2) (delete-file file2))
- (setq todo-visited (delete file2 todo-visited))
- (and buf2 (kill-buffer buf2)))
+ (if delete2
+ (progn
+ (when (file-exists-p file2) (delete-file file2))
+ (setq todo-visited (delete file2 todo-visited))
+ (and buf2 (kill-buffer buf2)))
+ ;; If we deleted an archive but not its todo file, update the
+ ;; latter's category sexp.
+ (when (equal (file-name-extension file2) "todo")
+ (with-current-buffer (or buf2 (find-file-noselect file2))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((sexp (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))
+ (buffer-read-only nil))
+ (mapc (lambda (x) (aset (cdr x) 3 0)) sexp)
+ (delete-region (line-beginning-position) (line-end-position))
+ (prin1 sexp (current-buffer)))))
+ (todo-set-categories)
+ (unless buf2 (kill-buffer)))))
(setq todo-files (funcall todo-files-function)
todo-archives (funcall todo-files-function t))
(when (or (string= file1-sn todo-default-todo-file)
@@ -1192,14 +1207,15 @@ visiting the deleted files."
(concat "and its "
(cond (todo "archive") (archive "todo"))
" file "))
- "deleted") file1-sn))))
+ "deleted")
+ file1-sn))))
(defvar todo-edit-buffer "*Todo Edit*"
"Name of current buffer in Todo Edit mode.")
(defun todo-edit-file ()
"Put current buffer in `todo-edit-mode'.
-This makes the entire file visible and the buffer writeable and
+This makes the entire file visible and the buffer writable and
you can use the self-insertion keys and standard Emacs editing
commands to make changes. To return to Todo mode, type
\\[todo-edit-quit]. This runs a file format check, signaling
@@ -1211,9 +1227,19 @@ this command should be used with caution."
(widen)
(todo-edit-mode)
(remove-overlays)
- (message "%s" (substitute-command-keys
- (concat "Type \\[todo-edit-quit] to check file format "
- "validity and return to Todo mode.\n"))))
+ (display-warning 'todo (format "\
+
+Type %s to return to Todo mode.
+
+This also runs a file format check and signals an error if
+the format has become invalid. However, this check cannot
+tell if the number of items or categories changed, which
+could result in the file containing inconsistent information.
+You can repair this inconsistency by invoking the command
+`todo-repair-categories-sexp', but this will revert any
+renumbering of the categories you have made, so you will
+have to renumber them again (see `(todo-mode) Reordering
+Categories')." (substitute-command-keys "\\[todo-edit-quit]"))))
(defun todo-add-category (&optional file cat)
"Add a new category to a todo file.
@@ -1262,7 +1288,7 @@ return the new category number."
(setq todo-category-number num)
(todo-category-select)
(when todo-add-item-if-new-category
- (todo-basic-insert-item)))
+ (todo-insert-item--basic)))
num))))
(defun todo-rename-category ()
@@ -1317,12 +1343,13 @@ todo or done items."
"deleting it will also delete the file.\n"
"Do you want to proceed? ")))
((> archived 0)
- (todo-y-or-n-p (concat "This category has archived items; "
+ (todo-y-or-n-p (format-message
+ (concat "This category has archived items; "
"the archived category will remain\n"
"after deleting the todo category. "
"Do you still want to delete it\n"
"(see `todo-skip-archived-categories' "
- "for another option)? ")))
+ "for another option)? "))))
(t
(todo-y-or-n-p (concat "Permanently remove category \"" cat
"\"" (and arg " and all its entries")
@@ -1360,8 +1387,9 @@ todo or done items."
(defun todo-move-category ()
"Move current category to a different todo file.
-If current category has archived items, also move those to the
-archive of the file moved to, creating it if it does not exist."
+If the todo file chosen does not exist, it is created.
+If the current category has archived items, also move those to
+the archive of the file moved to, creating it if it does not exist."
(interactive)
(when (or (> (length todo-categories) 1)
(todo-y-or-n-p (concat "This is the only category in this file; "
@@ -1369,16 +1397,22 @@ archive of the file moved to, creating it if it does not exist."
"Do you want to proceed? ")))
(let* ((ofile todo-current-todo-file)
(cat (todo-current-category))
- (nfile (todo-read-file-name
- "Choose a todo file to move this category to: " nil t))
+ (nfile (todo-read-file-name "Todo file to move this category to: "))
(archive (concat (file-name-sans-extension ofile) ".toda"))
(buffers (append (list ofile)
(unless (zerop (todo-get-count 'archived cat))
(list archive))))
new)
- (while (equal (file-truename nfile) (file-truename ofile))
+ (while (equal nfile (file-truename ofile))
(setq nfile (todo-read-file-name
- "Choose a file distinct from this file: " nil t)))
+ "Choose a file distinct from this file: ")))
+ (unless (member nfile todo-files)
+ (with-current-buffer (get-buffer-create nfile)
+ (erase-buffer)
+ (write-region (point-min) (point-max) nfile nil 'nomessage nil t)
+ (kill-buffer nfile))
+ (setq todo-files (funcall todo-files-function))
+ (todo-reevaluate-filelist-defcustoms))
(dolist (buf buffers)
(with-current-buffer (find-file-noselect buf)
(widen)
@@ -1405,6 +1439,10 @@ archive of the file moved to, creating it if it does not exist."
(if (member buf (funcall todo-files-function t))
(concat (file-name-sans-extension nfile) ".toda")
nfile))
+ (if (equal (file-name-extension (buffer-file-name)) "toda")
+ (unless (derived-mode-p 'todo-archive-mode)
+ (todo-archive-mode))
+ (unless (derived-mode-p 'todo-mode) (todo-mode)))
(let* ((nfile-short (todo-short-file-name nfile))
(prompt (concat
(format "Todo file \"%s\" already has "
@@ -1430,7 +1468,7 @@ archive of the file moved to, creating it if it does not exist."
"\\(" (regexp-quote cat) "\\)$") nil t)
(replace-match new nil nil nil 1)))
(setq todo-categories
- (append todo-categories (list (cons new counts))))
+ (append todo-categories (list (cons (or new cat) counts))))
(todo-update-categories-sexp)
;; If archive was just created, save it to avoid "File
;; <xyz> no longer exists!" message on invoking
@@ -1458,6 +1496,8 @@ archive of the file moved to, creating it if it does not exist."
(setq todo-categories (delete (assoc cat todo-categories)
todo-categories))
(todo-update-categories-sexp)
+ (when (> todo-category-number (length todo-categories))
+ (setq todo-category-number 1))
(todo-category-select)))))
(set-window-buffer (selected-window)
(set-buffer (find-file-noselect nfile)))
@@ -1472,25 +1512,25 @@ choose (with TAB completion) a category in it to merge into;
otherwise, choose and merge into a category in either the
current todo file or a file in `todo-category-completions-files'.
-After merging, the current category's todo and done items are
+After merging, the source category's todo and done items are
appended to the chosen goal category's todo and done items,
respectively. The goal category becomes the current category,
-and the previous current category is deleted.
+and the source category is deleted.
-If both the first and goal categories also have archived items,
-the former are merged to the latter. If only the first category
-has archived items, the archived category is renamed to the goal
-category."
+If both the source and goal categories also have archived items,
+they are also merged. If only the source category has archived
+items, the goal category is added as a new category to the
+archive file and the source category is deleted."
(interactive "P")
(let* ((tfile todo-current-todo-file)
(cat (todo-current-category))
(cat+file (todo-read-category "Merge into category: " 'todo file))
(goal (car cat+file))
(gfile (cdr cat+file))
- (archive (concat (file-name-sans-extension (if file gfile tfile))
- ".toda"))
- archived-count here)
- ;; Merge in todo file.
+ (tarchive (concat (file-name-sans-extension tfile) ".toda"))
+ (garchive (concat (file-name-sans-extension gfile) ".toda"))
+ (archived-count (todo-get-count 'archived))
+ here)
(with-current-buffer (get-buffer (find-file-noselect tfile))
(widen)
(let* ((buffer-read-only nil)
@@ -1513,94 +1553,102 @@ category."
(point-marker))
(point-max-marker))))
(todo (buffer-substring-no-properties tbeg tend))
- (done (buffer-substring-no-properties dbeg cend)))
- (goto-char (point-min))
- ;; Merge any todo items.
- (unless (zerop (length todo))
- (re-search-forward
- (concat "^" (regexp-quote (concat todo-category-beg goal)) "$")
- nil t)
- (re-search-forward
- (concat "^" (regexp-quote todo-category-done)) nil t)
- (forward-line -1)
- (setq here (point-marker))
- (insert todo)
- (todo-update-count 'todo (todo-get-count 'todo cat) goal))
- ;; Merge any done items.
- (unless (zerop (length done))
- (goto-char (if (re-search-forward
- (concat "^" (regexp-quote todo-category-beg)) nil t)
- (match-beginning 0)
- (point-max)))
- (when (zerop (length todo)) (setq here (point-marker)))
- (insert done)
- (todo-update-count 'done (todo-get-count 'done cat) goal))
+ (done (buffer-substring-no-properties dbeg cend))
+ (todo-count (todo-get-count 'todo cat))
+ (done-count (todo-get-count 'done cat)))
+ ;; Merge into goal todo category.
+ (with-current-buffer (get-buffer (find-file-noselect gfile))
+ (unless (derived-mode-p 'todo-mode) (todo-mode))
+ (widen)
+ (goto-char (point-min))
+ (let ((buffer-read-only nil))
+ ;; Merge any todo items.
+ (unless (zerop (length todo))
+ (re-search-forward
+ (concat "^" (regexp-quote (concat todo-category-beg goal)) "$")
+ nil t)
+ (re-search-forward
+ (concat "^" (regexp-quote todo-category-done)) nil t)
+ (forward-line -1)
+ (setq here (point-marker))
+ (insert todo)
+ (todo-update-count 'todo todo-count goal))
+ ;; Merge any done items.
+ (unless (zerop (length done))
+ (goto-char (if (re-search-forward
+ (concat "^" (regexp-quote todo-category-beg))
+ nil t)
+ (match-beginning 0)
+ (point-max)))
+ (when (zerop (length todo)) (setq here (point-marker)))
+ (insert done)
+ (todo-update-count 'done done-count goal)))
+ (todo-update-categories-sexp))
+ ;; Update and clean up source todo file.
(remove-overlays cbeg cend)
(delete-region cbeg cend)
(setq todo-categories (delete (assoc cat todo-categories)
- todo-categories))
+ todo-categories))
(todo-update-categories-sexp)
- (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend))))
- (when (file-exists-p archive)
- ;; Merge in archive file.
- (with-current-buffer (get-buffer (find-file-noselect archive))
+ (when (> todo-category-number (length todo-categories))
+ (setq todo-category-number 1))
+ (todo-category-select)
+ (mapc (lambda (m) (set-marker m nil))
+ (list cbeg tbeg dbeg tend cend))))
+ (when (> archived-count 0)
+ (with-current-buffer (get-buffer (find-file-noselect tarchive))
(widen)
(goto-char (point-min))
- (let ((buffer-read-only nil)
- (cbeg (save-excursion
- (when (re-search-forward
- (concat "^" (regexp-quote
- (concat todo-category-beg cat)) "$")
- nil t)
- (goto-char (match-beginning 0))
- (point-marker))))
- (gbeg (save-excursion
- (when (re-search-forward
- (concat "^" (regexp-quote
- (concat todo-category-beg goal)) "$")
- nil t)
- (goto-char (match-beginning 0))
- (point-marker))))
- cend carch)
- (when cbeg
- (setq archived-count (todo-get-count 'done cat))
- (setq cend (save-excursion
- (if (re-search-forward
- (concat "^" (regexp-quote todo-category-beg))
+ (let* ((buffer-read-only nil)
+ (cbeg (progn
+ (when (re-search-forward
+ (concat "^" (regexp-quote
+ (concat todo-category-beg cat)) "$")
nil t)
+ (goto-char (match-beginning 0))
+ (point-marker))))
+ (cend (if (re-search-forward
+ (concat "^" (regexp-quote todo-category-beg)) nil t)
+ (match-beginning 0)
+ (point-max)))
+ (carch (progn
+ (goto-char cbeg)
+ (forward-line)
+ (buffer-substring-no-properties (point) cend))))
+ ;; Merge into goal archive category, if it exists, else create it.
+ (with-current-buffer (get-buffer (find-file-noselect garchive))
+ (let ((gbeg (when (re-search-forward
+ (concat "^" (regexp-quote
+ (concat todo-category-beg goal))
+ "$")
+ nil t)
+ (goto-char (match-beginning 0))
+ (point-marker))))
+ (goto-char (if (and gbeg
+ (re-search-forward
+ (concat "^" (regexp-quote todo-category-beg))
+ nil t))
(match-beginning 0)
- (point-max))))
- (setq carch (save-excursion (goto-char cbeg) (forward-line)
- (buffer-substring-no-properties (point) cend)))
- ;; If both categories of the merge have archived items, merge the
- ;; source items to the goal items, else "merge" by renaming the
- ;; source category to goal.
- (if gbeg
- (progn
- (goto-char (if (re-search-forward
- (concat "^" (regexp-quote todo-category-beg))
- nil t)
- (match-beginning 0)
- (point-max)))
- (insert carch)
- (remove-overlays cbeg cend)
- (delete-region cbeg cend))
- (goto-char cbeg)
- (search-forward cat)
- (replace-match goal))
- (setq todo-categories (todo-make-categories-list t))
- (todo-update-categories-sexp)))))
- (with-current-buffer (get-file-buffer tfile)
- (when archived-count
- (unless (zerop archived-count)
- (todo-update-count 'archived archived-count goal)
- (todo-update-categories-sexp)))
- (todo-category-number goal)
- ;; If there are only merged done items, show them.
- (let ((todo-show-with-done (zerop (todo-get-count 'todo goal))))
- (todo-category-select)
- ;; Put point on the first merged item.
- (goto-char here)))
+ (point-max)))
+ (unless gbeg (todo-add-category nil goal))
+ (insert carch)
+ (todo-update-categories-sexp)))
+ ;; Update and clean up source archive file.
+ (remove-overlays cbeg cend)
+ (delete-region cbeg cend)
+ (setq todo-categories (todo-make-categories-list t))
+ (todo-update-categories-sexp))))
+ ;; Update goal todo file for merged archived items and display it.
+ (set-window-buffer (selected-window) (set-buffer (get-file-buffer gfile)))
+ (unless (zerop archived-count)
+ (todo-update-count 'archived archived-count goal)
+ (todo-update-categories-sexp))
+ (todo-category-number goal)
+ ;; If there are only merged done items, show them.
+ (let ((todo-show-with-done (zerop (todo-get-count 'todo goal))))
+ (todo-category-select)
+ ;; Put point on the first merged item.
+ (goto-char here))
(set-marker here nil)))
;; -----------------------------------------------------------------------------
@@ -1633,6 +1681,12 @@ current time, if nil, they include it."
:type 'boolean
:group 'todo-edit)
+(defcustom todo-default-priority 'first
+ "Default priority of new and moved items."
+ :type '(choice (const :tag "Highest priority" first)
+ (const :tag "Lowest priority" last))
+ :group 'todo-edit)
+
(defcustom todo-item-mark "*"
"String used to mark items.
To ensure item marking works, change the value of this option
@@ -1642,7 +1696,8 @@ only when no items are marked."
(when (string= (widget-value widget) todo-prefix)
(widget-put
widget :error
- "Invalid value: must be distinct from `todo-prefix'")
+ (format-message
+ "Invalid value: must be distinct from `todo-prefix'"))
widget)))
:set (lambda (symbol value)
(custom-set-default symbol (propertize value 'face 'todo-mark)))
@@ -1666,31 +1721,40 @@ means prompt user and omit comment only on confirmation."
(defun todo-toggle-mark-item (&optional n)
"Mark item with `todo-item-mark' if unmarked, otherwise unmark it.
-With a positive numerical prefix argument N, change the
-marking of the next N items."
+With positive numerical prefix argument N, change the marking of
+the next N items in the current category. If both the todo and
+done items sections are visible, the sequence of N items can
+consist of the the last todo items and the first done items."
(interactive "p")
(when (todo-item-string)
(unless (> n 1) (setq n 1))
- (dotimes (i n)
- (let* ((cat (todo-current-category))
- (marks (assoc cat todo-categories-with-marks))
- (ov (progn
- (unless (looking-at todo-item-start)
- (todo-item-start))
- (todo-get-overlay 'prefix)))
- (pref (overlay-get ov 'before-string)))
- (if (todo-marked-item-p)
- (progn
- (overlay-put ov 'before-string (substring pref 1))
- (if (= (cdr marks) 1) ; Deleted last mark in this category.
- (setq todo-categories-with-marks
- (assq-delete-all cat todo-categories-with-marks))
- (setcdr marks (1- (cdr marks)))))
- (overlay-put ov 'before-string (concat todo-item-mark pref))
- (if marks
- (setcdr marks (1+ (cdr marks)))
- (push (cons cat 1) todo-categories-with-marks))))
- (todo-forward-item))))
+ (catch 'end
+ (dotimes (i n)
+ (let* ((cat (todo-current-category))
+ (marks (assoc cat todo-categories-with-marks))
+ (ov (progn
+ (unless (looking-at todo-item-start)
+ (todo-item-start))
+ (todo-get-overlay 'prefix)))
+ (pref (overlay-get ov 'before-string)))
+ (if (todo-marked-item-p)
+ (progn
+ (overlay-put ov 'before-string (substring pref 1))
+ (if (= (cdr marks) 1) ; Deleted last mark in this category.
+ (setq todo-categories-with-marks
+ (assq-delete-all cat todo-categories-with-marks))
+ (setcdr marks (1- (cdr marks)))))
+ (overlay-put ov 'before-string (concat todo-item-mark pref))
+ (if marks
+ (setcdr marks (1+ (cdr marks)))
+ (push (cons cat 1) todo-categories-with-marks))))
+ (todo-forward-item)
+ ;; Don't try to mark the empty lines at the end of the todo
+ ;; and done items sections.
+ (when (looking-at "^$")
+ (if (eobp)
+ (throw 'end nil)
+ (todo-forward-item)))))))
(defun todo-mark-category ()
"Mark all visible items in this category with `todo-item-mark'."
@@ -1707,7 +1771,12 @@ marking of the next N items."
(if marks
(setcdr marks (1+ (cdr marks)))
(push (cons cat 1) todo-categories-with-marks))))
- (todo-forward-item)))))
+ (todo-forward-item)
+ ;; Don't try to mark the empty line between the todo and done
+ ;; items sections.
+ (when (looking-at "^$")
+ (unless (eobp)
+ (todo-forward-item)))))))
(defun todo-unmark-category ()
"Remove `todo-item-mark' from all visible items in this category."
@@ -1729,111 +1798,50 @@ marking of the next N items."
(defvar todo-date-from-calendar nil
"Helper variable for setting item date from the Emacs Calendar.")
-(defun todo-basic-insert-item (&optional arg diary nonmarking date-type time
- region-or-here)
- "Insert a new todo item into a category.
-This is the function from which the generated Todo mode item
-insertion commands derive.
-
-The generated commands have mnemonic key bindings based on the
-arguments' values and their order in the command's argument list,
-as follows: (1) for DIARY `d', (2) for NONMARKING `k', (3) for
-DATE-TYPE either `c' for calendar or `d' for date or `n' for
-weekday name, (4) for TIME `t', (5) for REGION-OR-HERE either `r'
-for region or `h' for here. Sequences of these keys are appended
-to the insertion prefix key `i'. Keys that allow a following
-key (i.e., any but `r' or `h') must be doubled when used finally.
-For example, the command bound to the key sequence `i y h' will
-insert a new item with today's date, marked according to the
-DIARY argument described below, and with priority according to
-the HERE argument; `i y y' does the same except that the priority
-is not given by HERE but by prompting.
-
-In command invocations, ARG is passed as a prefix argument as
-follows. With no prefix argument, add the item to the current
+(defvar todo-insert-item--keys-so-far)
+(defvar todo-insert-item--parameters)
+
+(defun todo-insert-item (&optional arg)
+ "Choose an item insertion operation and carry it out.
+This inserts a new todo item into a category.
+
+With no prefix argument ARG, add the item to the current
category; with one prefix argument (`C-u'), prompt for a category
-from the current todo file; with two prefix arguments (`C-u C-u'),
-first prompt for a todo file, then a category in that file. If
-a non-existing category is entered, ask whether to add it to the
-todo file; if answered affirmatively, add the category and
-insert the item there.
-
-The remaining arguments are set or left nil by the generated item
-insertion commands; their meanings are described in the follows
-paragraphs.
-
-When argument DIARY is non-nil, this overrides the intent of the
-user option `todo-include-in-diary' for this item: if
-`todo-include-in-diary' is nil, include the item in the Fancy
-Diary display, and if it is non-nil, exclude the item from the
-Fancy Diary display. When DIARY is nil, `todo-include-in-diary'
-has its intended effect.
-
-When the item is included in the Fancy Diary display and the
-argument NONMARKING is non-nil, this overrides the intent of the
-user option `todo-diary-nonmarking' for this item: if
-`todo-diary-nonmarking' is nil, append `diary-nonmarking-symbol'
-to the item, and if it is non-nil, omit `diary-nonmarking-symbol'.
-
-The argument DATE-TYPE determines the content of the item's
-mandatory date header string and how it is added:
-- If DATE-TYPE is the symbol `calendar', the Calendar pops up and
- when the user puts the cursor on a date and hits RET, that
- date, in the format set by `calendar-date-display-form',
- becomes the date in the header.
-- If DATE-TYPE is a string matching the regexp
- `todo-date-pattern', that string becomes the date in the
- header. This case is for the command
- `todo-insert-item-from-calendar' which is called from the
- Calendar.
-- If DATE-TYPE is the symbol `date', the header contains the date
- in the format set by `calendar-date-display-form', with year,
- month and day individually prompted for (month with tab
- completion).
-- If DATE-TYPE is the symbol `dayname' the header contains a
- weekday name instead of a date, prompted for with tab
- completion.
-- If DATE-TYPE has any other value (including nil or none) the
- header contains the current date (in the format set by
- `calendar-date-display-form').
-
-With non-nil argument TIME prompt for a time string, which must
-match `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). If TIME is absent or nil, add or
-omit the current time string according as
-`todo-always-add-time-string' is non-nil or nil, respectively.
-
-The argument REGION-OR-HERE determines the source and location of
-the new item:
-- If the REGION-OR-HERE is the symbol `here', prompt for the text of
- the new item and, if the command was invoked with point in the todo
- items section of the current category, give the new item the
- priority of the item at point, lowering the latter's priority and
- the priority of the remaining items. If point is in the done items
- section of the category, insert the new item as the first todo item
- in the category. Likewise, if the command with `here' is invoked
- outside of the current category, jump to the chosen category and
- insert the new item as the first item in the category.
-- If REGION-OR-HERE is the symbol `region', use the region of the
- current buffer as the text of the new item, depending on the
- value of user option `todo-use-only-highlighted-region': if
- this is non-nil, then use the region only when it is
- highlighted; otherwise, use the region regardless of
- highlighting. An error is signalled if there is no region in
- the current buffer. Prompt for the item's priority in the
- category (an integer between 1 and one more than the number of
- items in the category), and insert the item accordingly.
-- If REGION-OR-HERE has any other value (in particular, nil or
- none), prompt for the text and the item's priority, and insert
- the item accordingly."
+from the current todo file; with two prefix arguments (`C-u
+C-u'), first prompt for a todo file, then a category in that
+file. If a non-existing category is entered, ask whether to add
+it to the todo file; if answered affirmatively, add the category
+and insert the item there.
+
+There are a number of item insertion parameters which can be
+combined by entering specific keys to produce different insertion
+commands. After entering each key, a message shows which have
+already been entered and which remain available. See
+`(todo-mode) Inserting New Items' for details of the parameters,
+their associated keys and their effects."
+ (interactive "P")
+ (setq todo-insert-item--keys-so-far "i")
+ (todo-insert-item--next-param nil (list arg) todo-insert-item--parameters))
+
+(defun todo-insert-item--basic (&optional arg diary-type date-type time where)
+ "Function implementing the core of `todo-insert-item'."
;; If invoked outside of Todo mode and there is not yet any Todo
;; file, initialize one.
(if (null (funcall todo-files-function))
(todo-show)
- (let ((region (eq region-or-here 'region))
- (here (eq region-or-here 'here)))
+ (let ((copy (eq where 'copy))
+ (region (eq where 'region))
+ (here (eq where 'here))
+ diary-item)
+ (when copy
+ (cond
+ ((not (eq major-mode 'todo-mode))
+ (user-error "You must be in Todo mode to copy a todo item"))
+ ((todo-done-item-p)
+ (user-error "You cannot copy a done item as a new todo item"))
+ ((looking-at "^$")
+ (user-error "Point must be on a todo item to copy it")))
+ (setq diary-item (todo-diary-item-p)))
(when region
(let (use-empty-active-region)
(unless (and todo-use-only-highlighted-region (use-region-p))
@@ -1856,10 +1864,10 @@ the new item:
todo-default-todo-file))))))
(cat (car cat+file))
(file (cdr cat+file))
- (new-item (if region
- (buffer-substring-no-properties
- (region-beginning) (region-end))
- (read-from-minibuffer "Todo item: ")))
+ (new-item (cond (copy (todo-item-string))
+ (region (buffer-substring-no-properties
+ (region-beginning) (region-end)))
+ (t (read-from-minibuffer "Todo item: "))))
(date-string (cond
((eq date-type 'date)
(todo-read-date))
@@ -1898,22 +1906,26 @@ the new item:
(let ((buffer-read-only nil)
(called-from-outside (not (and todo-mm (equal cat ocat))))
done-only item-added)
- (setq new-item
- ;; Add date, time and diary marking as required.
- (concat (if (not (and diary (not todo-include-in-diary)))
- todo-nondiary-start
- (when (and nonmarking (not todo-diary-nonmarking))
- diary-nonmarking-symbol))
- date-string (when (and time-string ; Can be empty.
- (not (zerop (length
- time-string))))
- (concat " " time-string))
- (when (not (and diary (not todo-include-in-diary)))
- todo-nondiary-end)
- " " new-item))
- ;; Indent newlines inserted by C-q C-j if nonspace char follows.
- (setq new-item (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
- "\n\t" new-item nil nil 1))
+ (unless copy
+ (setq new-item
+ ;; Add date, time and diary marking as required.
+ (concat (if (not (and diary-type
+ (not todo-include-in-diary)))
+ todo-nondiary-start
+ (when (and (eq diary-type 'nonmarking)
+ (not todo-diary-nonmarking))
+ diary-nonmarking-symbol))
+ date-string (when (and time-string ; Can be empty.
+ (not (zerop (length
+ time-string))))
+ (concat " " time-string))
+ (when (not (and diary-type
+ (not todo-include-in-diary)))
+ todo-nondiary-end)
+ " " new-item))
+ ;; Indent newlines inserted by C-q C-j if nonspace char follows.
+ (setq new-item (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
+ "\n\t" new-item nil nil 1)))
(unwind-protect
(progn
;; Make sure the correct category is selected. There
@@ -1949,13 +1961,12 @@ the new item:
;; If user cancels before setting priority, restore
;; display.
(unless item-added
- (if ocat
- (progn
- (unless (equal cat ocat)
- (todo-category-number ocat)
- (todo-category-select))
- (and done-only (todo-toggle-view-done-only)))
- (set-window-buffer (selected-window) (set-buffer obuf)))
+ (set-window-buffer (selected-window) (set-buffer obuf))
+ (when ocat
+ (unless (equal cat ocat)
+ (todo-category-number ocat)
+ (todo-category-select))
+ (and done-only (todo-toggle-view-done-only)))
(goto-char opoint))
;; If the todo items section is not visible when the
;; insertion command is called (either because only done
@@ -1967,7 +1978,8 @@ the new item:
;; items are displayed in the window.
(when item-added (recenter)))
(todo-update-count 'todo 1)
- (if (or diary todo-include-in-diary) (todo-update-count 'diary 1))
+ (when (or diary-item diary-type todo-include-in-diary)
+ (todo-update-count 'diary 1))
(todo-update-categories-sexp))))))
(defun todo-set-date-from-calendar ()
@@ -2011,21 +2023,10 @@ prompt for a todo file and then for a category in it."
(setq todo-date-from-calendar
(calendar-date-string (calendar-cursor-to-date t) t t))
(calendar-exit)
- (todo-basic-insert-item arg nil nil todo-date-from-calendar))
+ (todo-insert-item--basic arg nil todo-date-from-calendar))
(define-key calendar-mode-map "it" 'todo-insert-item-from-calendar)
-(defun todo-copy-item ()
- "Copy item at point and insert the copy as a new item."
- (interactive)
- (unless (or (todo-done-item-p) (looking-at "^$"))
- (let ((copy (todo-item-string))
- (diary-item (todo-diary-item-p)))
- (todo-set-item-priority copy (todo-current-category) t)
- (todo-update-count 'todo 1)
- (when diary-item (todo-update-count 'diary 1))
- (todo-update-categories-sexp))))
-
(defun todo-delete-item ()
"Delete at least one item in this category.
If there are marked items, delete all of these; otherwise, delete
@@ -2072,64 +2073,107 @@ the item at point."
(todo-prefix-overlays)))
(if ov (delete-overlay ov)))))
-(defun todo-edit-item (&optional arg)
- "Edit the todo item at point.
-With non-nil prefix argument ARG, include the item's date/time
-header, making it also editable; otherwise, include only the item
-content.
+(defvar todo-edit-item--param-key-alist)
+(defvar todo-edit-done-item--param-key-alist)
-If the item consists of only one logical line, edit it in the
-minibuffer; otherwise, edit it in Todo Edit mode."
+(defun todo-edit-item (&optional arg)
+ "Choose an editing operation for the current item and carry it out."
(interactive "P")
- (when (todo-item-string)
- (let* ((opoint (point))
- (start (todo-item-start))
- (item-beg (progn
- (re-search-forward
- (concat todo-date-string-start todo-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todo-nondiary-end) "?")
- (line-end-position) t)
- (1+ (- (point) start))))
- (header (substring (todo-item-string) 0 item-beg))
- (item (if arg (todo-item-string)
- (substring (todo-item-string) item-beg)))
- (multiline (> (length (split-string item "\n")) 1))
- (buffer-read-only nil))
- (if multiline
- (todo-edit-multiline-item)
- (let ((new (concat (if arg "" header)
- (read-string "Edit: " (if arg
- (cons item item-beg)
- (cons item 0))))))
- (when arg
- (while (not (string-match (concat todo-date-string-start
- todo-date-pattern) new))
- (setq new (read-from-minibuffer
- "Item must start with a date: " new))))
- ;; Ensure lines following hard newlines are indented.
- (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
- "\n\t" new nil nil 1))
- ;; If user moved point during editing, make sure it moves back.
- (goto-char opoint)
- (todo-remove-item)
- (todo-insert-with-overlays new)
- (move-to-column item-beg))))))
-
-(defun todo-edit-multiline-item ()
- "Edit current todo item in Todo Edit mode.
-Use of newlines invokes `todo-indent' to insure compliance with
-the format of Diary entries."
- (interactive)
- (when (todo-item-string)
- (let ((buf todo-edit-buffer))
- (set-window-buffer (selected-window)
- (set-buffer (make-indirect-buffer (buffer-name) buf)))
- (narrow-to-region (todo-item-start) (todo-item-end))
- (todo-edit-mode)
- (message "%s" (substitute-command-keys
- (concat "Type \\[todo-edit-quit] "
- "to return to Todo mode.\n"))))))
+ (let ((marked (assoc (todo-current-category) todo-categories-with-marks)))
+ (cond ((and (todo-done-item-p) (not marked))
+ (todo-edit-item--next-key todo-edit-done-item--param-key-alist))
+ ((or marked (todo-item-string))
+ (todo-edit-item--next-key todo-edit-item--param-key-alist arg)))))
+
+(defun todo-edit-item--text (&optional arg)
+ "Function providing the text editing facilities of `todo-edit-item'."
+ (let ((full-item (todo-item-string)))
+ ;; If there are marked items and user invokes a text-editing
+ ;; commands with point not on an item, todo-item-start is nil and
+ ;; 1+ signals an error, so just make this a noop.
+ (when full-item
+ (let* ((opoint (point))
+ (start (todo-item-start))
+ (end (save-excursion (todo-item-end)))
+ (item-beg (progn
+ (re-search-forward
+ (concat todo-date-string-start todo-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "?")
+ (line-end-position) t)
+ (1+ (- (point) start))))
+ (include-header (eq arg 'include-header))
+ (comment-edit (eq arg 'comment-edit))
+ (comment-delete (eq arg 'comment-delete))
+ (header-string (substring full-item 0 item-beg))
+ (item (if (or include-header comment-edit comment-delete)
+ full-item
+ (substring full-item item-beg)))
+ (multiline (or (eq arg 'multiline)
+ (> (length (split-string item "\n")) 1)))
+ (comment (save-excursion
+ (todo-item-start)
+ (re-search-forward
+ (concat " \\[" (regexp-quote todo-comment-string)
+ ": \\([^]]+\\)\\]") end t)))
+ (prompt (if comment "Edit comment: " "Enter a comment: "))
+ (buffer-read-only nil))
+ ;; When there are marked items, user can invoke todo-edit-item
+ ;; even if point is not on an item, but text editing only
+ ;; applies to the item at point.
+ (when (or (and (todo-done-item-p)
+ (or comment-edit comment-delete))
+ (and (not (todo-done-item-p))
+ (or (not arg) include-header multiline)))
+ (cond
+ ((or comment-edit comment-delete)
+ (save-excursion
+ (todo-item-start)
+ (if (re-search-forward (concat " \\["
+ (regexp-quote todo-comment-string)
+ ": \\([^]]+\\)\\]") end t)
+ (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))
+ nil nil nil 1))
+ (if comment-delete
+ (user-error "There is no comment to delete")
+ (insert " [" todo-comment-string ": "
+ (prog1 (read-string prompt)
+ ;; If user moved point during editing,
+ ;; make sure it moves back.
+ (goto-char opoint)
+ (todo-item-end))
+ "]")))))
+ (multiline
+ (let ((buf todo-edit-buffer))
+ (set-window-buffer (selected-window)
+ (set-buffer (make-indirect-buffer
+ (buffer-name) buf)))
+ (narrow-to-region (todo-item-start) (todo-item-end))
+ (todo-edit-mode)
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[todo-edit-quit] "
+ "to return to Todo mode.\n")))))
+ (t
+ (let ((new (concat (if include-header "" header-string)
+ (read-string "Edit: " (if include-header
+ (cons item item-beg)
+ (cons item 0))))))
+ (when include-header
+ (while (not (string-match (concat todo-date-string-start
+ todo-date-pattern) new))
+ (setq new (read-from-minibuffer
+ "Item must start with a date: " new))))
+ ;; Ensure lines following hard newlines are indented.
+ (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]"
+ "\n\t" new nil nil 1))
+ ;; If user moved point during editing, make sure it moves back.
+ (goto-char opoint)
+ (todo-remove-item)
+ (todo-insert-with-overlays new)
+ (move-to-column item-beg)))))))))
(defun todo-edit-quit ()
"Return from Todo Edit mode to Todo mode.
@@ -2182,38 +2226,18 @@ made in the number or names of categories."
(todo-category-select)
(goto-char (point-min))))))
-(defun todo-basic-edit-item-header (what &optional inc)
- "Function underlying commands to edit item date/time header.
-
-The argument WHAT (passed by invoking commands) specifies what
-part of the header to edit; possible values are these symbols:
-`date', to edit the year, month, and day of the date string;
-`time', to edit just the time string; `calendar', to select the
-date from the Calendar; `today', to set the date to today's date;
-`dayname', to set the date string to the name of a day or to
-change the day name; and `year', `month' or `day', to edit only
-these respective parts of the date string (`day' is the number of
-the given day of the month, and `month' is either the name of the
-given month or its number, depending on the value of
-`calendar-date-display-form').
-
-The optional argument INC is a positive or negative integer
-\(passed by invoking commands as a numerical prefix argument)
-that in conjunction with the WHAT values `year', `month' or
-`day', increments or decrements the specified date string
-component by the specified number of suitable units, i.e., years,
-months, or days, with automatic adjustment of the other date
-string components as necessary.
-
-If there are marked items, apply the same edit to all of these;
-otherwise, edit just the item at point."
- (let* ((cat (todo-current-category))
- (marked (assoc cat todo-categories-with-marks))
- (first t)
- (todo-date-from-calendar t)
- (buffer-read-only nil)
- ndate ntime year monthname month day
- dayname) ; Needed by calendar-date-display-form.
+(defun todo-edit-item--header (what &optional inc)
+ "Function providing header editing facilities of `todo-edit-item'."
+ (let ((marked (assoc (todo-current-category) todo-categories-with-marks))
+ (first t)
+ (todo-date-from-calendar t)
+ ;; INC must be an integer, but users could pass it via
+ ;; `todo-edit-item' as e.g. `-' or `C-u'.
+ (inc (prefix-numeric-value inc))
+ (buffer-read-only nil)
+ ndate ntime year monthname month day
+ dayname) ; Needed by calendar-date-display-form.
+ (when marked (todo--user-error-if-marked-done-item))
(save-excursion
(or (and marked (goto-char (point-min))) (todo-item-start))
(catch 'end
@@ -2329,7 +2353,8 @@ otherwise, edit just the item at point."
((or (string= omonth "*") (string= omonthname "*"))
(setq dd (+ dd inc))
(if (> dd 31)
- (user-error "A month cannot have more than 31 days")
+ (user-error
+ "A month cannot have more than 31 days")
(number-to-string dd)))
;; Increment or decrement day by INC,
;; adjusting month and year if necessary
@@ -2371,80 +2396,31 @@ otherwise, edit just the item at point."
(todo-forward-item)
(goto-char (point-max))))))))
-(defun todo-edit-item-header ()
- "Interactively edit at least the date of item's date/time header.
-If user option `todo-always-add-time-string' is non-nil, also
-edit item's time string."
- (interactive)
- (todo-basic-edit-item-header 'date)
- (when todo-always-add-time-string
- (todo-edit-item-time)))
-
-(defun todo-edit-item-time ()
- "Interactively edit the time string of item's date/time header."
- (interactive)
- (todo-basic-edit-item-header 'time))
-
-(defun todo-edit-item-date-from-calendar ()
- "Interactively edit item's date using the Calendar."
- (interactive)
- (todo-basic-edit-item-header 'calendar))
-
-(defun todo-edit-item-date-to-today ()
- "Set item's date to today's date."
- (interactive)
- (todo-basic-edit-item-header 'today))
-
-(defun todo-edit-item-date-day-name ()
- "Replace item's date with the name of a day of the week."
- (interactive)
- (todo-basic-edit-item-header 'dayname))
-
-(defun todo-edit-item-date-year (&optional inc)
- "Interactively edit the year of item's date string.
-With prefix argument INC a positive or negative integer,
-increment or decrement the year by INC."
- (interactive "p")
- (todo-basic-edit-item-header 'year inc))
-
-(defun todo-edit-item-date-month (&optional inc)
- "Interactively edit the month of item's date string.
-With prefix argument INC a positive or negative integer,
-increment or decrement the month by INC."
- (interactive "p")
- (todo-basic-edit-item-header 'month inc))
-
-(defun todo-edit-item-date-day (&optional inc)
- "Interactively edit the day of the month of item's date string.
-With prefix argument INC a positive or negative integer,
-increment or decrement the day by INC."
- (interactive "p")
- (todo-basic-edit-item-header 'day inc))
-
-(defun todo-edit-item-diary-inclusion ()
- "Change diary status of one or more todo items in this category.
-That is, insert `todo-nondiary-marker' if the candidate items
-lack this marking; otherwise, remove it.
-
-If there are marked todo items, change the diary status of all
-and only these, otherwise change the diary status of the item at
-point."
- (interactive)
+(defun todo-edit-item--diary-inclusion (&optional nonmarking)
+ "Function providing diary marking facilities of `todo-edit-item'."
(let ((buffer-read-only)
- (marked (assoc (todo-current-category)
- todo-categories-with-marks)))
+ (marked (assoc (todo-current-category) todo-categories-with-marks)))
+ (when marked (todo--user-error-if-marked-done-item))
(catch 'stop
(save-excursion
(when marked (goto-char (point-min)))
(while (not (eobp))
- (if (todo-done-item-p)
- (throw 'stop (message "Done items cannot be edited"))
- (unless (and marked (not (todo-marked-item-p)))
- (let* ((beg (todo-item-start))
- (lim (save-excursion (todo-item-end)))
- (end (save-excursion
- (or (todo-time-string-matcher lim)
- (todo-date-string-matcher lim)))))
+ (unless (and marked (not (todo-marked-item-p)))
+ (let* ((beg (todo-item-start))
+ (lim (save-excursion (todo-item-end)))
+ (end (save-excursion
+ (or (todo-time-string-matcher lim)
+ (todo-date-string-matcher lim)))))
+ (if nonmarking
+ (if (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match "")
+ (when (looking-at (regexp-quote todo-nondiary-start))
+ (save-excursion
+ (replace-match "")
+ (search-forward todo-nondiary-end (1+ end) t)
+ (replace-match "")
+ (todo-update-count 'diary 1)))
+ (insert diary-nonmarking-symbol))
(if (looking-at (regexp-quote todo-nondiary-start))
(progn
(replace-match "")
@@ -2452,13 +2428,16 @@ point."
(replace-match "")
(todo-update-count 'diary 1))
(when end
+ (when (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match "")
+ (setq end (1- end))) ; Since we deleted nonmarking symbol.
(insert todo-nondiary-start)
(goto-char (1+ end))
(insert todo-nondiary-end)
- (todo-update-count 'diary -1)))))
- (unless marked (throw 'stop nil))
- (todo-forward-item)))))
- (todo-update-categories-sexp)))
+ (todo-update-count 'diary -1))))))
+ (unless marked (throw 'stop nil))
+ (todo-forward-item)))))
+ (todo-update-categories-sexp))
(defun todo-edit-category-diary-inclusion (arg)
"Make all items in this category diary items.
@@ -2481,6 +2460,9 @@ items."
(todo-date-string-matcher lim)))))
(if arg
(unless (looking-at (regexp-quote todo-nondiary-start))
+ (when (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match "")
+ (setq end (1- end))) ; Since we deleted nonmarking symbol.
(insert todo-nondiary-start)
(goto-char (1+ end))
(insert todo-nondiary-end))
@@ -2495,33 +2477,6 @@ items."
(- todo-count diary-count))))
(todo-update-categories-sexp)))))
-(defun todo-edit-item-diary-nonmarking ()
- "Change non-marking of one or more diary items in this category.
-That is, insert `diary-nonmarking-symbol' if the candidate items
-lack this marking; otherwise, remove it.
-
-If there are marked todo items, change the non-marking status of
-all and only these, otherwise change the non-marking status of
-the item at point."
- (interactive)
- (let ((buffer-read-only)
- (marked (assoc (todo-current-category)
- todo-categories-with-marks)))
- (catch 'stop
- (save-excursion
- (when marked (goto-char (point-min)))
- (while (not (eobp))
- (if (todo-done-item-p)
- (throw 'stop (message "Done items cannot be edited"))
- (unless (and marked (not (todo-marked-item-p)))
- (todo-item-start)
- (unless (looking-at (regexp-quote todo-nondiary-start))
- (if (looking-at (regexp-quote diary-nonmarking-symbol))
- (replace-match "")
- (insert diary-nonmarking-symbol))))
- (unless marked (throw 'stop nil))
- (todo-forward-item)))))))
-
(defun todo-edit-category-diary-nonmarking (arg)
"Add `diary-nonmarking-symbol' to all diary items in this category.
With prefix ARG, remove `diary-nonmarking-symbol' from all diary
@@ -2531,16 +2486,16 @@ items in this category."
(goto-char (point-min))
(let (buffer-read-only)
(catch 'stop
- (while (not (eobp))
- (if (todo-done-item-p) ; We've gone too far.
- (throw 'stop nil)
- (unless (looking-at (regexp-quote todo-nondiary-start))
- (if arg
- (when (looking-at (regexp-quote diary-nonmarking-symbol))
- (replace-match ""))
- (unless (looking-at (regexp-quote diary-nonmarking-symbol))
- (insert diary-nonmarking-symbol))))
- (todo-forward-item)))))))
+ (while (not (eobp))
+ (if (todo-done-item-p) ; We've gone too far.
+ (throw 'stop nil)
+ (unless (looking-at (regexp-quote todo-nondiary-start))
+ (if arg
+ (when (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match ""))
+ (unless (looking-at (regexp-quote diary-nonmarking-symbol))
+ (insert diary-nonmarking-symbol))))
+ (todo-forward-item)))))))
(defun todo-set-item-priority (&optional item cat new arg)
"Prompt for and set ITEM's priority in CATegory.
@@ -2610,14 +2565,16 @@ meaning to raise or lower the item's priority by one."
(goto-char (point-min))
(setq done (re-search-forward todo-done-string-start nil t))))
(let ((todo-show-with-done done))
- (todo-category-select)
- ;; Keep top of category in view while setting priority.
- (goto-char (point-min)))))
+ ;; Keep current item or top of moved to category in view
+ ;; while setting priority.
+ (save-excursion (todo-category-select)))))
;; Prompt for priority only when the category has at least one
;; todo item.
(when (> maxnum 1)
(while (not priority)
- (setq candidate (read-number prompt))
+ (setq candidate (read-number prompt
+ (if (eq todo-default-priority 'first)
+ 1 maxnum)))
(setq prompt (when (or (< candidate 1) (> candidate maxnum))
(format "Priority must be an integer between 1 and %d.\n"
maxnum)))
@@ -2660,7 +2617,8 @@ meaning to raise or lower the item's priority by one."
;; separator.
(when (looking-back (concat "^"
(regexp-quote todo-category-done)
- "\n"))
+ "\n")
+ (line-beginning-position 0))
(todo-backward-item))))
(todo-insert-with-overlays item)
;; If item was marked, restore the mark.
@@ -2851,21 +2809,7 @@ visible."
(interactive "P")
(let* ((cat (todo-current-category))
(marked (assoc cat todo-categories-with-marks)))
- (when marked
- (save-excursion
- (save-restriction
- (goto-char (point-max))
- (todo-backward-item)
- (unless (todo-done-item-p)
- (widen)
- (unless (re-search-forward
- (concat "^" (regexp-quote todo-category-beg)) nil t)
- (goto-char (point-max)))
- (forward-line -1))
- (while (todo-done-item-p)
- (when (todo-marked-item-p)
- (user-error "This command does not apply to done items"))
- (todo-backward-item)))))
+ (when marked (todo--user-error-if-marked-done-item))
(unless (and (not marked)
(or (todo-done-item-p)
;; Point is between todo and done items.
@@ -2884,7 +2828,8 @@ visible."
(goto-char (point-min))
(re-search-forward todo-done-string-start nil t)))
(buffer-read-only nil)
- item done-item opoint)
+ item done-item
+ (opoint (point)))
;; Don't add empty comment to done item.
(setq comment (unless (zerop (length comment))
(concat " [" todo-comment-string ": " comment "]")))
@@ -2922,35 +2867,11 @@ visible."
(todo-update-categories-sexp)
(let ((todo-show-with-done show-done))
(todo-category-select)
- ;; When done items are shown, put cursor on first just done item.
+ ;; When done items are visible, put point at the top of the
+ ;; done items section. When done items are hidden, restore
+ ;; point to its location prior to invoking this command.
(when opoint (goto-char opoint)))))))
-(defun todo-edit-done-item-comment (&optional arg)
- "Add a comment to this done item or edit an existing comment.
-With prefix ARG delete an existing comment."
- (interactive "P")
- (when (todo-done-item-p)
- (let ((item (todo-item-string))
- (opoint (point))
- (end (save-excursion (todo-item-end)))
- comment buffer-read-only)
- (save-excursion
- (todo-item-start)
- (if (re-search-forward (concat " \\["
- (regexp-quote todo-comment-string)
- ": \\([^]]+\\)\\]") end t)
- (if arg
- (when (todo-y-or-n-p "Delete comment? ")
- (delete-region (match-beginning 0) (match-end 0)))
- (setq comment (read-string "Edit comment: "
- (cons (match-string 1) 1)))
- (replace-match comment nil nil nil 1))
- (setq comment (read-string "Enter a comment: "))
- ;; If user moved point during editing, make sure it moves back.
- (goto-char opoint)
- (todo-item-end)
- (insert " [" todo-comment-string ": " comment "]"))))))
-
(defun todo-item-undone ()
"Restore at least one done item to this category's todo section.
Prompt for the new priority. If there are marked items, undo all
@@ -2979,7 +2900,9 @@ comments without asking."
(while (not (eobp))
(when (or (not marked) (and marked (todo-marked-item-p)))
(if (not (todo-done-item-p))
- (user-error "Only done items can be undone")
+ (progn
+ (goto-char opoint)
+ (user-error "Only done items can be undone"))
(todo-item-start)
(unless marked
(setq ov (make-overlay (save-excursion (todo-item-start))
@@ -3087,6 +3010,7 @@ displayed."
(when place
(set-window-buffer (selected-window)
(set-buffer (find-file-noselect archive)))
+ (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
(if (member place '(other-archive other-cat))
(setq todo-category-number 1)
(todo-category-number cat))
@@ -3119,7 +3043,7 @@ this category does not exist in the archive, it is created."
(afile (concat (file-name-sans-extension
todo-current-todo-file) ".toda"))
(archive (find-file-noselect afile t))
- (item (and (todo-done-item-p)
+ (item (and (not marked) (todo-done-item-p)
(concat (todo-item-string) "\n")))
(count 0)
(opoint (unless (todo-done-item-p) (point)))
@@ -3162,6 +3086,7 @@ this category does not exist in the archive, it is created."
(if (not (or marked all item))
(throw 'end (message "Only done items can be archived"))
(with-current-buffer archive
+ (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
(let (buffer-read-only)
(widen)
(goto-char (point-min))
@@ -3183,12 +3108,12 @@ this category does not exist in the archive, it is created."
(todo-update-categories-sexp)
;; If archive is new, save to file now (with
;; write-region to avoid prompt for file to save to)
- ;; to update todo-archives, and to let auto-mode-alist
- ;; take effect below on visiting the archive.
+ ;; to update todo-archives, and set the mode for
+ ;; visiting the archive below.
(unless (nth 7 (file-attributes afile))
(write-region nil nil afile t t)
(setq todo-archives (funcall todo-files-function t))
- (kill-buffer))))
+ (todo-archive-mode))))
(with-current-buffer tbuf
(cond
(all
@@ -3214,7 +3139,8 @@ this category does not exist in the archive, it is created."
(todo-update-count 'done -1)
(todo-update-count 'archived 1)
;; Don't leave point below last item.
- (and item (bolp) (eolp) (< (point-min) (point-max))
+ (and (or marked item) (bolp) (eolp)
+ (< (point-min) (point-max))
(todo-backward-item))
(when item
(throw 'done (setq item nil))))
@@ -3304,15 +3230,16 @@ the only category in the archive, the archive file is deleted."
(throw 'done (setq item nil))))
(todo-forward-item))))
(todo-update-count 'done (if marked (- marked-count) -1) cat)
- ;; If that was the last category in the archive, delete the whole file.
- (if (= (length todo-categories) 1)
- (progn
- (delete-file todo-current-todo-file)
- ;; Kill the archive buffer silently.
- (set-buffer-modified-p nil)
- (kill-buffer))
- ;; Otherwise, if the archive category is now empty, delete it.
- (when (eq (point-min) (point-max))
+ ;; If we unarchived the last item in category, then if that was
+ ;; the only category, delete the whole file, otherwise, just
+ ;; delete the category.
+ (when (= 0 (todo-get-count 'done))
+ (if (= 1 (length todo-categories))
+ (progn
+ (delete-file todo-current-todo-file)
+ ;; Kill the archive buffer silently.
+ (set-buffer-modified-p nil)
+ (kill-buffer))
(widen)
(let ((beg (re-search-backward
(concat "^" (regexp-quote todo-category-beg) cat "$")
@@ -3325,8 +3252,8 @@ the only category in the archive, the archive file is deleted."
(remove-overlays beg end)
(delete-region beg end)
(setq todo-categories (delete (assoc cat todo-categories)
- todo-categories))
- (todo-update-categories-sexp))))
+ todo-categories)))))
+ (todo-update-categories-sexp)
;; Visit category in todo file and show restored done items.
(let ((tfile (buffer-file-name tbuf))
(todo-show-with-done t))
@@ -4036,7 +3963,7 @@ regexp items."
(defun todo-find-filtered-items-file ()
"Choose a filtered items file and visit it."
(interactive)
- (let ((files (directory-files todo-directory t "\.tod[rty]$" t))
+ (let ((files (directory-files todo-directory t "\\.tod[rty]$" t))
falist file)
(dolist (f files)
(let ((type (cond ((equal (file-name-extension f) "todr") "regexp")
@@ -4047,7 +3974,10 @@ regexp items."
(setq file (completing-read "Choose a filtered items file: "
falist nil t nil nil (car falist)))
(setq file (cdr (assoc-string file falist)))
- (find-file file)))
+ (find-file file)
+ (unless (derived-mode-p 'todo-filtered-items-mode)
+ (todo-filtered-items-mode))
+ (todo-prefix-overlays)))
(defun todo-go-to-source-item ()
"Display the file and category of the filtered item at point."
@@ -4156,7 +4086,6 @@ multifile commands for further details."
(progn (todo-multiple-filter-files)
todo-multiple-filter-files))
(list todo-current-todo-file)))
- (multi (> (length flist) 1))
(fname (if (equal flist 'quit)
;; Pressed `cancel' in t-m-f-f file selection dialog.
(keyboard-quit)
@@ -4165,6 +4094,7 @@ multifile commands for further details."
(cond (top ".todt")
(diary ".tody")
(regexp ".todr")))))
+ (multi (> (length flist) 1))
(rxfiles (when regexp
(directory-files todo-directory t ".*\\.todr$" t)))
(file-exists (or (file-exists-p fname) rxfiles))
@@ -4178,6 +4108,8 @@ multifile commands for further details."
(completing-read "Choose a regexp items file: "
rxf) 'regexp))))
(find-file fname)
+ (unless (derived-mode-p 'todo-filtered-items-mode)
+ (todo-filtered-items-mode))
(todo-prefix-overlays)
(todo-check-filtered-items-file))
(t
@@ -4311,7 +4243,8 @@ the values of FILTER and FILE-LIST."
(if (and (eobp)
(looking-back
(concat (regexp-quote todo-done-string)
- "\n")))
+ "\n")
+ (line-beginning-position 0)))
(delete-region (point) (progn
(forward-line -2)
(point))))))
@@ -4366,30 +4299,31 @@ set the user customizable option `todo-top-priorities-overrides'."
(file todo-current-todo-file)
(rules todo-top-priorities-overrides)
(frule (assoc-string file rules))
- (crule (assoc-string cat (nth 2 frule)))
(crules (nth 2 frule))
- (cur (or (if arg (cdr crule) (nth 1 frule))
- todo-top-priorities))
+ (crule (assoc-string cat crules))
+ (fcur (or (nth 1 frule)
+ todo-top-priorities))
+ (ccur (or (and arg (cdr crule))
+ fcur))
(prompt (if arg (concat "Number of top priorities in this category"
" (currently %d): ")
(concat "Default number of top priorities per category"
" in this file (currently %d): ")))
- (new -1)
- nrule)
+ (new -1))
(while (< new 0)
- (let ((cur0 cur))
- (setq new (read-number (format prompt cur0))
+ (let ((cur (if arg ccur fcur)))
+ (setq new (read-number (format prompt cur))
prompt "Enter a non-negative number: "
- cur0 nil)))
- (setq nrule (if arg
- (append (delete crule crules) (list (cons cat new)))
- (append (list file new) (list crules))))
- (setq rules (cons (if arg
- (list file cur nrule)
- nrule)
- (delete frule rules)))
- (customize-save-variable 'todo-top-priorities-overrides rules)
- (todo-prefix-overlays)))
+ cur nil)))
+ (let ((nrule (if arg
+ (append (delete crule crules) (list (cons cat new)))
+ (append (list file new) (list crules)))))
+ (setq rules (cons (if arg
+ (list file fcur nrule)
+ nrule)
+ (delete frule rules)))
+ (customize-save-variable 'todo-top-priorities-overrides rules)
+ (todo-prefix-overlays))))
(defun todo-find-item (str)
"Search for filtered item STR in its saved todo file.
@@ -4431,6 +4365,9 @@ its priority has changed, and `same' otherwise."
todo-global-current-todo-file)))
(find-file-noselect file)
(with-current-buffer (find-buffer-visiting file)
+ (if archive
+ (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
+ (unless (derived-mode-p 'todo-mode) (todo-mode)))
(save-restriction
(widen)
(goto-char (point-min))
@@ -4724,7 +4661,7 @@ name in `todo-directory'. See also the documentation string of
;; If the item ends with a non-comment parenthesis not
;; followed by a period, we lose (but we inherit that
;; problem from the legacy code).
- (when (looking-back "(\\(.*\\)) ")
+ (when (looking-back "(\\(.*\\)) " (line-beginning-position))
(setq comment (match-string 1))
(replace-match "")
(insert "[" todo-comment-string ": " comment "]"))
@@ -4955,7 +4892,7 @@ With nil or omitted CATEGORY, default to the current category."
(widen)
(goto-char (point-min))
(setq todo-categories
- (if (looking-at "\(\(\"")
+ (if (looking-at "((\"")
(read (buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
@@ -5007,23 +4944,28 @@ the file."
;; Make sure to include newly created archives, e.g. due to
;; todo-move-category.
(when (member archive (funcall todo-files-function t))
- (let ((archive-count 0))
- (with-current-buffer (find-file-noselect archive)
- (widen)
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote todo-category-beg)
- cat "$")
- (point-max) t)
- (forward-line)
- (while (not (or (looking-at
- (concat
- (regexp-quote todo-category-beg)
- "\\(.*\\)\n"))
- (eobp)))
- (when (looking-at todo-done-string-start)
- (setq archive-count (1+ archive-count)))
- (forward-line))))
+ (let ((archive-count 0)
+ (visiting (find-buffer-visiting archive)))
+ (with-current-buffer (or visiting
+ (find-file-noselect archive))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote todo-category-beg)
+ cat "$")
+ (point-max) t)
+ (forward-line)
+ (while (not (or (looking-at
+ (concat
+ (regexp-quote todo-category-beg)
+ "\\(.*\\)\n"))
+ (eobp)))
+ (when (looking-at todo-done-string-start)
+ (setq archive-count (1+ archive-count)))
+ (forward-line)))))
+ (unless visiting (kill-buffer)))
(todo-update-count 'archived archive-count cat))))
((looking-at todo-done-string-start)
(todo-update-count 'done 1 cat))
@@ -5095,7 +5037,7 @@ but the categories sexp differs from the current value of
;; Warn user if categories sexp has changed.
(unless (string= ssexp cats)
(message (concat "The sexp at the beginning of the file differs "
- "from the value of `todo-categories.\n"
+ "from the value of `todo-categories'.\n"
"If the sexp is wrong, you can fix it with "
"M-x todo-repair-categories-sexp,\n"
"but note this reverts any changes you have "
@@ -5247,6 +5189,11 @@ Overrides `diary-goto-entry'."
(if (not (and (file-exists-p file)
(find-file-other-window file)))
(message "Unable to locate this diary entry")
+ ;; If it's a Todo file, make sure it's in Todo mode.
+ (when (and (equal (file-name-directory (file-truename file))
+ (file-truename todo-directory))
+ (not (derived-mode-p 'todo-mode)))
+ (todo-mode))
(when (eq major-mode 'todo-mode) (widen))
(goto-char (point-min))
(when (re-search-forward (format "%s.*\\(%s\\)" date content) nil t)
@@ -5263,6 +5210,31 @@ Overrides `diary-goto-entry'."
(add-function :override diary-goto-entry-function #'todo-diary-goto-entry)
+(defun todo-revert-buffer (&optional ignore-auto noconfirm)
+ "Call `revert-buffer', preserving buffer's current modes.
+Also preserve category display, if applicable."
+ (interactive (list (not current-prefix-arg)))
+ (let ((revert-buffer-function nil))
+ (revert-buffer ignore-auto noconfirm 'preserve-modes)
+ (when (memq major-mode '(todo-mode todo-archive-mode))
+ (todo-category-select))))
+
+(defun todo-desktop-save-buffer (_dir)
+ `((catnum . ,(todo-category-number (todo-current-category)))))
+
+(declare-function desktop-restore-file-buffer "desktop"
+ (buffer-filename buffer-name buffer-misc))
+
+(defun todo-restore-desktop-buffer (file buffer misc)
+ (desktop-restore-file-buffer file buffer misc)
+ (with-current-buffer buffer
+ (widen)
+ (let ((todo-category-number (cdr (assq 'catnum misc))))
+ (todo-category-select))))
+
+(add-to-list 'desktop-buffer-mode-handlers
+ '(todo-mode . todo-restore-desktop-buffer))
+
(defun todo-done-item-p ()
"Return non-nil if item at point is a done item."
(save-excursion
@@ -5277,6 +5249,25 @@ Overrides `diary-goto-entry'."
(progn (goto-char (point-min))
(looking-at todo-done-string-start)))))
+(defun todo--user-error-if-marked-done-item ()
+ "Signal user error on marked done items.
+Helper function for editing commands that apply only to (possibly
+marked) not done todo items."
+ (save-excursion
+ (save-restriction
+ (goto-char (point-max))
+ (todo-backward-item)
+ (unless (todo-done-item-p)
+ (widen)
+ (unless (re-search-forward
+ (concat "^" (regexp-quote todo-category-beg)) nil t)
+ (goto-char (point-max)))
+ (forward-line -1))
+ (while (todo-done-item-p)
+ (when (todo-marked-item-p)
+ (user-error "This command does not apply to done items"))
+ (todo-backward-item)))))
+
(defun todo-reset-done-separator (sep)
"Replace existing overlays of done items separator string SEP."
(save-excursion
@@ -5348,6 +5339,8 @@ of each other."
(todo-current-category)
(nth 2 (assoc-string todo-current-todo-file
todo-top-priorities-overrides))))
+ (nth 1 (assoc-string todo-current-todo-file
+ todo-top-priorities-overrides))
todo-top-priorities))
done prefix)
(save-excursion
@@ -5362,7 +5355,8 @@ of each other."
(looking-at todo-done-string-start)
(looking-back (concat "^"
(regexp-quote todo-category-done)
- "\n")))
+ "\n")
+ (line-beginning-position 0)))
(setq num 1
done t))
(setq prefix (concat (propertize
@@ -5390,134 +5384,224 @@ of each other."
(forward-line)))))
;; -----------------------------------------------------------------------------
-;;; Utilities for generating item insertion commands and key bindings
+;;; Generating and applying item insertion and editing key sequences
;; -----------------------------------------------------------------------------
-;; Wolfgang Jenkner posted this powerset definition to emacs-devel
-;; (http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00423.html)
-;; and kindly gave me permission to use it.
-
-(defun todo-powerset (list)
- "Return the powerset of LIST."
- (let ((powerset (list nil)))
- (dolist (elt list (mapcar 'reverse powerset))
- (nconc powerset (mapcar (apply-partially 'cons elt) powerset)))))
-
-(defun todo-gen-arglists (arglist)
- "Return list of lists of non-nil atoms produced from ARGLIST.
-The elements of ARGLIST may be atoms or lists."
- (let (arglists)
- (while arglist
- (let ((arg (pop arglist)))
- (cond ((symbolp arg)
- (setq arglists (if arglists
- (mapcar (lambda (l) (push arg l)) arglists)
- (list (push arg arglists)))))
- ((listp arg)
- (setq arglists
- (mapcar (lambda (a)
- (if (= 1 (length arglists))
- (apply (lambda (l) (push a l)) arglists)
- (mapcar (lambda (l) (push a l)) arglists)))
- arg))))))
- (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists))))))
-
-(defvar todo-insertion-commands-args-genlist
- '(diary nonmarking (calendar date dayname) time (here region))
- "Generator list for argument lists of item insertion commands.")
-
-(defvar todo-insertion-commands-args
- (let ((arglist (todo-gen-arglists todo-insertion-commands-args-genlist))
- res new)
- (setq res (cl-remove-duplicates
- (apply 'append (mapcar 'todo-powerset arglist)) :test 'equal))
- (dolist (l res)
- (unless (= 5 (length l))
- (let ((v (make-vector 5 nil)) elt)
- (while l
- (setq elt (pop l))
- (cond ((eq elt 'diary)
- (aset v 0 elt))
- ((eq elt 'nonmarking)
- (aset v 1 elt))
- ((or (eq elt 'calendar)
- (eq elt 'date)
- (eq elt 'dayname))
- (aset v 2 elt))
- ((eq elt 'time)
- (aset v 3 elt))
- ((or (eq elt 'here)
- (eq elt 'region))
- (aset v 4 elt))))
- (setq l (append v nil))))
- (setq new (append new (list l))))
- new)
- "List of all argument lists for Todo mode item insertion commands.")
-
-(defun todo-insertion-command-name (arglist)
- "Generate Todo mode item insertion command name from ARGLIST."
- (replace-regexp-in-string
- "-\\_>" ""
- (replace-regexp-in-string
- "-+" "-"
- (concat "todo-insert-item-"
- (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-")))))
-
-(defvar todo-insertion-commands-names
- (mapcar (lambda (l)
- (todo-insertion-command-name l))
- todo-insertion-commands-args)
- "List of names of Todo mode item insertion commands.")
-
-(defmacro todo-define-insertion-command (&rest args)
- "Generate Todo mode item insertion command definitions from ARGS."
- (let ((name (intern (todo-insertion-command-name args)))
- (arg0 (nth 0 args))
- (arg1 (nth 1 args))
- (arg2 (nth 2 args))
- (arg3 (nth 3 args))
- (arg4 (nth 4 args)))
- `(defun ,name (&optional arg &rest args)
- "Todo mode item insertion command generated from ARGS.
-For descriptions of the individual arguments, their values, and
-their relation to key bindings, see `todo-basic-insert-item'."
- (interactive (list current-prefix-arg))
- (todo-basic-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4))))
-
-(defvar todo-insertion-commands
- (mapcar (lambda (c)
- (eval `(todo-define-insertion-command ,@c)))
- todo-insertion-commands-args)
- "List of Todo mode item insertion commands.")
-
-(defvar todo-insertion-commands-arg-key-list
- '(("diary" "y" "yy")
- ("nonmarking" "k" "kk")
- ("calendar" "c" "cc")
- ("date" "d" "dd")
- ("dayname" "n" "nn")
- ("time" "t" "tt")
- ("here" "h" "h")
- ("region" "r" "r"))
- "List of mappings of item insertion command arguments to key sequences.")
-
-(defun todo-insertion-key-bindings (map)
- "Generate key binding definitions for item insertion keymap MAP."
- (dolist (c todo-insertion-commands)
- (let* ((key "")
- (cname (symbol-name c)))
- (mapc (lambda (l)
- (let ((arg (nth 0 l))
- (key1 (nth 1 l))
- (key2 (nth 2 l)))
- (if (string-match (concat (regexp-quote arg) "\\_>") cname)
- (setq key (concat key key2)))
- (if (string-match (concat (regexp-quote arg) ".+") cname)
- (setq key (concat key key1)))))
- todo-insertion-commands-arg-key-list)
- (if (string-match (concat (regexp-quote "todo-insert-item") "\\_>") cname)
- (setq key (concat key "i")))
- (define-key map key c))))
+;; Thanks to Stefan Monnier for suggesting dynamically generating item
+;; insertion commands and their key bindings, and offering an elegant
+;; implementation, which, however, relies on lexical scoping and so
+;; cannot be used here until the Calendar code used by todo-mode.el is
+;; converted to lexical binding. Hence, the following implementation
+;; uses dynamic binding.
+
+(defconst todo-insert-item--parameters
+ '((default copy) (diary nonmarking) (calendar date dayname) time (here region))
+ "List of all item insertion parameters.
+Passed by `todo-insert-item' to `todo-insert-item--next-param' to
+dynamically create item insertion commands.")
+
+(defconst todo-insert-item--param-key-alist
+ '((default . "i")
+ (copy . "p")
+ (diary . "y")
+ (nonmarking . "k")
+ (calendar . "c")
+ (date . "d")
+ (dayname . "n")
+ (time . "t")
+ (here . "h")
+ (region . "r"))
+ "List pairing item insertion parameters with their completion keys.")
+
+(defsubst todo-insert-item--keyof (param)
+ "Return key paired with item insertion PARAM."
+ (cdr (assoc param todo-insert-item--param-key-alist)))
+
+(defun todo-insert-item--argsleft (key list)
+ "Return sublist of LIST whose first member corresponds to KEY."
+ (let (l sym)
+ (mapc (lambda (m)
+ (when (consp m)
+ (catch 'found1
+ (dolist (s m)
+ (when (equal key (todo-insert-item--keyof s))
+ (throw 'found1 (setq sym s))))))
+ (if sym
+ (progn
+ (push sym l)
+ (setq sym nil))
+ (push m l)))
+ list)
+ (setq list (reverse l)))
+ (memq (catch 'found2
+ (dolist (e todo-insert-item--param-key-alist)
+ (when (equal key (cdr e))
+ (throw 'found2 (car e)))))
+ list))
+
+(defsubst todo-insert-item--this-key () (char-to-string last-command-event))
+
+(defvar todo-insert-item--keys-so-far ""
+ "String of item insertion keys so far entered for this command.")
+
+(defvar todo-insert-item--args nil)
+(defvar todo-insert-item--argleft nil)
+(defvar todo-insert-item--argsleft nil)
+(defvar todo-insert-item--newargsleft nil)
+
+(defun todo-insert-item--apply-args ()
+ "Build list of arguments for item insertion and apply them.
+The list consists of item insertion parameters that can be passed
+as insertion command arguments in fixed positions. If a position
+in the list is not occupied by the corresponding parameter, it is
+occupied by nil."
+ (let* ((arg (list (car todo-insert-item--args)))
+ (args (nconc (cdr todo-insert-item--args)
+ (list (car (todo-insert-item--argsleft
+ (todo-insert-item--this-key)
+ todo-insert-item--argsleft)))))
+ (arglist (if (= 4 (length args))
+ args
+ (let ((v (make-vector 4 nil)) elt)
+ (while args
+ (setq elt (pop args))
+ (cond ((memq elt '(diary nonmarking))
+ (aset v 0 elt))
+ ((memq elt '(calendar date dayname))
+ (aset v 1 elt))
+ ((eq elt 'time)
+ (aset v 2 elt))
+ ((memq elt '(copy here region))
+ (aset v 3 elt))))
+ (append v nil)))))
+ (apply #'todo-insert-item--basic (nconc arg arglist))))
+
+(defun todo-insert-item--next-param (last args argsleft)
+ "Build item insertion command from LAST, ARGS and ARGSLEFT and call it.
+Dynamically generate key bindings, prompting with the keys
+already entered and those still available."
+ (cl-assert argsleft)
+ (let* ((map (make-sparse-keymap))
+ (prompt nil)
+ (addprompt
+ (lambda (k name)
+ (setq prompt
+ (concat prompt
+ (format
+ (concat
+ (if (memq name '(default diary calendar here))
+ " { " " ")
+ "%s=>%s"
+ (when (memq name '(copy nonmarking dayname region))
+ " }"))
+ (propertize k 'face 'todo-key-prompt)
+ name))))))
+ (setq todo-insert-item--args args)
+ (setq todo-insert-item--argsleft argsleft)
+ (when last
+ (if (memq last '(default copy))
+ (progn
+ (setq todo-insert-item--argsleft nil)
+ (todo-insert-item--apply-args))
+ (let ((k (todo-insert-item--keyof last)))
+ (funcall addprompt k (make-symbol (concat (symbol-name last) ":GO!")))
+ (define-key map (todo-insert-item--keyof last)
+ (lambda () (interactive)
+ (todo-insert-item--apply-args))))))
+ (while todo-insert-item--argsleft
+ (let ((x (car todo-insert-item--argsleft)))
+ (setq todo-insert-item--newargsleft (cdr todo-insert-item--argsleft))
+ (dolist (argleft (if (consp x) x (list x)))
+ (let ((k (todo-insert-item--keyof argleft)))
+ (funcall addprompt k argleft)
+ (define-key map k
+ (if (null todo-insert-item--newargsleft)
+ (lambda () (interactive)
+ (todo-insert-item--apply-args))
+ (lambda () (interactive)
+ (setq todo-insert-item--keys-so-far
+ (concat todo-insert-item--keys-so-far " "
+ (todo-insert-item--this-key)))
+ (todo-insert-item--next-param
+ (car (todo-insert-item--argsleft
+ (todo-insert-item--this-key)
+ todo-insert-item--argsleft))
+ (nconc todo-insert-item--args
+ (list (car (todo-insert-item--argsleft
+ (todo-insert-item--this-key)
+ todo-insert-item--argsleft))))
+ (cdr (todo-insert-item--argsleft
+ (todo-insert-item--this-key)
+ todo-insert-item--argsleft)))))))))
+ (setq todo-insert-item--argsleft todo-insert-item--newargsleft))
+ (when prompt (message "Press a key (so far `%s'): %s"
+ todo-insert-item--keys-so-far prompt))
+ (set-transient-map map)
+ (setq todo-insert-item--argsleft argsleft)))
+
+(defconst todo-edit-item--param-key-alist
+ '((edit . "e")
+ (header . "h")
+ (multiline . "m")
+ (diary . "y")
+ (nonmarking . "k")
+ (date . "d")
+ (time . "t"))
+ "Alist of item editing parameters and their keys.")
+
+(defconst todo-edit-item--date-param-key-alist
+ '((full . "f")
+ (calendar . "c")
+ (today . "a")
+ (dayname . "n")
+ (year . "y")
+ (month . "m")
+ (daynum . "d"))
+ "Alist of item date editing parameters and their keys.")
+
+(defconst todo-edit-done-item--param-key-alist
+ '((add/edit . "c")
+ (delete . "d"))
+ "Alist of done item comment editing parameters and their keys.")
+
+(defvar todo-edit-item--prompt "Press a key (so far `e'): ")
+
+(defun todo-edit-item--next-key (params &optional arg)
+ (let* ((map (make-sparse-keymap))
+ (p->k (mapconcat (lambda (elt)
+ (format "%s=>%s"
+ (propertize (cdr elt) 'face
+ 'todo-key-prompt)
+ (concat (symbol-name (car elt))
+ (when (memq (car elt)
+ '(add/edit delete))
+ " comment"))))
+ params " "))
+ (key-prompt (substitute-command-keys todo-edit-item--prompt))
+ (this-key (let ((key (read-key (concat key-prompt p->k))))
+ (and (characterp key) (char-to-string key))))
+ (this-param (car (rassoc this-key params))))
+ (pcase this-param
+ (`edit (todo-edit-item--text))
+ (`header (todo-edit-item--text 'include-header))
+ (`multiline (todo-edit-item--text 'multiline))
+ (`add/edit (todo-edit-item--text 'comment-edit))
+ (`delete (todo-edit-item--text 'comment-delete))
+ (`diary (todo-edit-item--diary-inclusion))
+ (`nonmarking (todo-edit-item--diary-inclusion 'nonmarking))
+ (`date (let ((todo-edit-item--prompt "Press a key (so far `e d'): "))
+ (todo-edit-item--next-key
+ todo-edit-item--date-param-key-alist arg)))
+ (`full (progn (todo-edit-item--header 'date)
+ (when todo-always-add-time-string
+ (todo-edit-item--header 'time))))
+ (`calendar (todo-edit-item--header 'calendar))
+ (`today (todo-edit-item--header 'today))
+ (`dayname (todo-edit-item--header 'dayname))
+ (`year (todo-edit-item--header 'year arg))
+ (`month (todo-edit-item--header 'month arg))
+ (`daynum (todo-edit-item--header 'day arg))
+ (`time (todo-edit-item--header 'time)))))
;; -----------------------------------------------------------------------------
;;; Todo minibuffer utilities
@@ -5559,9 +5643,10 @@ have been removed."
(when deleted
(let ((pl (> (length deleted) 1))
(names (mapconcat (lambda (f) (concat "\"" f "\"")) deleted ", ")))
- (message (concat "File" (if pl "s" "") " " names " ha" (if pl "ve" "s")
+ (message (concat "File" (if pl "s" "") " %s ha" (if pl "ve" "s")
" been deleted and removed from\n"
- "the list of category completion files")))
+ "the list of category completion files")
+ names))
(todo-reevaluate-category-completions-files-defcustom)
(custom-set-default 'todo-category-completions-files
(symbol-value 'todo-category-completions-files))
@@ -5581,6 +5666,9 @@ have been removed."
(add-to-list 'files curfile))
(dolist (f files listall)
(with-current-buffer (find-file-noselect f 'nowarn)
+ (if archive
+ (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
+ (unless (derived-mode-p 'todo-mode) (todo-mode)))
;; Ensure category is properly displayed in case user
;; switches to file via a non-Todo mode command. And if
;; done items in category are visible, keep them visible.
@@ -5633,7 +5721,7 @@ otherwise, a new file name is allowed."
""))))
(unless (file-exists-p todo-directory)
(make-directory todo-directory))
- (unless mustmatch
+ (unless (or mustmatch (member file files))
(setq file (todo-validate-name file 'file)))
(setq file (file-truename (concat todo-directory file
(if archive ".toda" ".todo"))))))
@@ -5666,6 +5754,7 @@ categories from `todo-category-completions-files'."
(categories (cond (file0
(with-current-buffer
(find-file-noselect file0 'nowarn)
+ (unless (derived-mode-p 'todo-mode) (todo-mode))
(let ((todo-current-todo-file file0))
todo-categories)))
((and add (not file))
@@ -5932,8 +6021,9 @@ the empty string (i.e., no time string)."
(defun todo-reset-nondiary-marker (symbol value)
"The :set function for user option `todo-nondiary-marker'."
- (let ((oldvalue (symbol-value symbol))
- (files (append todo-files todo-archives)))
+ (let* ((oldvalue (symbol-value symbol))
+ (files (append todo-files todo-archives
+ (directory-files todo-directory t "\\.tod[rty]$" t))))
(custom-set-default symbol value)
;; Need to reset these to get font-locking right.
(setq todo-nondiary-start (nth 0 todo-nondiary-marker)
@@ -5944,23 +6034,28 @@ the empty string (i.e., no time string)."
(regexp-quote diary-nonmarking-symbol) "\\)?"))
(when (not (equal value oldvalue))
(dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- (concat "^\\(" todo-done-string-start "[^][]+] \\)?"
- "\\(?1:" (regexp-quote (car oldvalue))
- "\\)" todo-date-pattern "\\( "
- diary-time-regexp "\\)?\\(?2:"
- (regexp-quote (cadr oldvalue)) "\\)")
- nil t)
- (progn
- (replace-match (nth 0 value) t t nil 1)
- (replace-match (nth 1 value) t t nil 2))
- (forward-line)))
- (todo-category-select)))))))
+ (let ((buf (find-buffer-visiting f)))
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ (concat "^\\(" todo-done-string-start "[^][]+] \\)?"
+ "\\(?1:" (regexp-quote (car oldvalue))
+ "\\)" todo-date-pattern "\\( "
+ diary-time-regexp "\\)?\\(?2:"
+ (regexp-quote (cadr oldvalue)) "\\)")
+ nil t)
+ (progn
+ (replace-match (nth 0 value) t t nil 1)
+ (replace-match (nth 1 value) t t nil 2))
+ (forward-line)))
+ (if buf
+ (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (todo-category-select))
+ (save-buffer)
+ (kill-buffer)))))))))
(defun todo-reset-done-separator-string (symbol value)
"The :set function for `todo-done-separator-string'."
@@ -5980,51 +6075,63 @@ the empty string (i.e., no time string)."
(defun todo-reset-done-string (symbol value)
"The :set function for user option `todo-done-string'."
(let ((oldvalue (symbol-value symbol))
- (files (append todo-files todo-archives)))
+ (files (append todo-files todo-archives
+ (directory-files todo-directory t "\\.todr$" t))))
(custom-set-default symbol value)
;; Need to reset this to get font-locking right.
(setq todo-done-string-start
(concat "^\\[" (regexp-quote todo-done-string)))
(when (not (equal value oldvalue))
(dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- (concat "^" (regexp-quote todo-nondiary-start)
- "\\(" (regexp-quote oldvalue) "\\)")
- nil t)
- (replace-match value t t nil 1)
- (forward-line)))
- (todo-category-select)))))))
+ (let ((buf (find-buffer-visiting f)))
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ (concat "^" (regexp-quote todo-nondiary-start)
+ "\\(" (regexp-quote oldvalue) "\\)")
+ nil t)
+ (replace-match value t t nil 1)
+ (forward-line)))
+ (if buf
+ (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (todo-category-select))
+ (save-buffer)
+ (kill-buffer)))))))))
(defun todo-reset-comment-string (symbol value)
"The :set function for user option `todo-comment-string'."
(let ((oldvalue (symbol-value symbol))
- (files (append todo-files todo-archives)))
+ (files (append todo-files todo-archives
+ (directory-files todo-directory t "\\.todr$" t))))
(custom-set-default symbol value)
(when (not (equal value oldvalue))
(dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (save-excursion
+ (let ((buf (find-buffer-visiting f)))
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
(widen)
(goto-char (point-min))
(while (not (eobp))
(if (re-search-forward
- (concat
- "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]")
+ (concat "\\[\\(" (regexp-quote oldvalue)
+ "\\): [^]]*\\]")
nil t)
(replace-match value t t nil 1)
(forward-line)))
- (todo-category-select))))))))
+ (if buf
+ (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (todo-category-select))
+ (save-buffer)
+ (kill-buffer)))))))))
(defun todo-reset-highlight-item (symbol value)
- "The :set function for `todo-toggle-item-highlighting'."
+ "The :set function for user option `todo-highlight-item'."
(let ((oldvalue (symbol-value symbol))
- (files (append todo-files todo-archives)))
+ (files (append todo-files todo-archives
+ (directory-files todo-directory t "\\.tod[rty]$" t))))
(custom-set-default symbol value)
(when (not (equal value oldvalue))
(dolist (f files)
@@ -6192,13 +6299,6 @@ Filtered Items mode following todo (not done) items."
;;; Key binding
;; -----------------------------------------------------------------------------
-(defvar todo-insertion-map
- (let ((map (make-keymap)))
- (todo-insertion-key-bindings map)
- (define-key map "p" 'todo-copy-item)
- map)
- "Keymap for Todo mode item insertion commands.")
-
(defvar todo-key-bindings-t
`(
("Af" todo-find-archive)
@@ -6226,21 +6326,9 @@ Filtered Items mode following todo (not done) items."
("Fym" todo-filter-diary-items-multifile)
("Fxx" todo-filter-regexp-items)
("Fxm" todo-filter-regexp-items-multifile)
- ("ee" todo-edit-item)
- ("em" todo-edit-multiline-item)
- ("edt" todo-edit-item-header)
- ("edc" todo-edit-item-date-from-calendar)
- ("eda" todo-edit-item-date-to-today)
- ("edn" todo-edit-item-date-day-name)
- ("edy" todo-edit-item-date-year)
- ("edm" todo-edit-item-date-month)
- ("edd" todo-edit-item-date-day)
- ("et" todo-edit-item-time)
- ("eyy" todo-edit-item-diary-inclusion)
- ("eyk" todo-edit-item-diary-nonmarking)
- ("ec" todo-edit-done-item-comment)
+ ("e" todo-edit-item)
("d" todo-item-done)
- ("i" ,todo-insertion-map)
+ ("i" todo-insert-item)
("k" todo-delete-item)
("m" todo-move-item)
("u" todo-item-undone)
@@ -6356,64 +6444,74 @@ Filtered Items mode following todo (not done) items."
map)
"Todo Filtered Items mode keymap.")
-;; FIXME: Is it worth having a menu and if so, which commands?
-;; (easy-menu-define
-;; todo-menu todo-mode-map "Todo Menu"
-;; '("Todo"
-;; ("Navigation"
-;; ["Next Item" todo-forward-item t]
-;; ["Previous Item" todo-backward-item t]
-;; "---"
-;; ["Next Category" todo-forward-category t]
-;; ["Previous Category" todo-backward-category t]
-;; ["Jump to Category" todo-jump-to-category t]
-;; "---"
-;; ["Search Todo File" todo-search t]
-;; ["Clear Highlighting on Search Matches" todo-category-done t])
-;; ("Display"
-;; ["List Current Categories" todo-show-categories-table t]
-;; ;; ["List Categories Alphabetically" todo-display-categories-alphabetically t]
-;; ["Turn Item Highlighting on/off" todo-toggle-item-highlighting t]
-;; ["Turn Item Numbering on/off" todo-toggle-prefix-numbers t]
-;; ["Turn Item Time Stamp on/off" todo-toggle-item-header t]
-;; ["View/Hide Done Items" todo-toggle-view-done-items t]
-;; "---"
-;; ["View Diary Items" todo-filter-diary-items t]
-;; ["View Top Priority Items" todo-filter-top-priorities t]
-;; ["View Multifile Top Priority Items" todo-filter-top-priorities-multifile t]
-;; "---"
-;; ["Print Category" todo-print-buffer t])
-;; ("Editing"
-;; ["Insert New Item" todo-insert-item t]
-;; ["Insert Item Here" todo-insert-item-here t]
-;; ("More Insertion Commands")
-;; ["Edit Item" todo-edit-item t]
-;; ["Edit Multiline Item" todo-edit-multiline-item t]
-;; ["Edit Item Header" todo-edit-item-header t]
-;; ["Edit Item Date" todo-edit-item-date t]
-;; ["Edit Item Time" todo-edit-item-time t]
-;; "---"
-;; ["Lower Item Priority" todo-lower-item-priority t]
-;; ["Raise Item Priority" todo-raise-item-priority t]
-;; ["Set Item Priority" todo-set-item-priority t]
-;; ["Move (Recategorize) Item" todo-move-item t]
-;; ["Delete Item" todo-delete-item t]
-;; ["Undo Done Item" todo-item-undone t]
-;; ["Mark/Unmark Item for Diary" todo-toggle-item-diary-inclusion t]
-;; ["Mark/Unmark Items for Diary" todo-edit-item-diary-inclusion t]
-;; ["Mark & Hide Done Item" todo-item-done t]
-;; ["Archive Done Items" todo-archive-category-done-items t]
-;; "---"
-;; ["Add New Todo File" todo-add-file t]
-;; ["Add New Category" todo-add-category t]
-;; ["Delete Current Category" todo-delete-category t]
-;; ["Rename Current Category" todo-rename-category t]
-;; "---"
-;; ["Save Todo File" todo-save t]
-;; )
-;; "---"
-;; ["Quit" todo-quit t]
-;; ))
+(easy-menu-define
+ todo-menu todo-mode-map "Todo Menu"
+ '("Todo"
+ ("Navigation"
+ ["Next Item" todo-next-item t]
+ ["Previous Item" todo-previous-item t]
+ "---"
+ ["Next Category" todo-forward-category t]
+ ["Previous Category" todo-backward-category t]
+ ["Jump to Another Category" todo-jump-to-category t]
+ "---"
+ ["Visit Another Todo File" todo-show t]
+ ["Visit Archive" todo-find-archive t]
+ ["Visit Filtered Items File" todo-find-filtered-items-file t]
+ )
+ ("Editing"
+ ["Insert New Item" todo-insert-item t]
+ ["Edit Item" todo-edit-item t]
+ ["Lower Item Priority" todo-lower-item-priority t]
+ ["Raise Item Priority" todo-raise-item-priority t]
+ ["Set Item Priority" todo-set-item-priority t]
+ ["Mark/Unmark Item" todo-toggle-mark-item t]
+ ["Move (Recategorize) Item" todo-move-item t]
+ ["Delete Item" todo-delete-item t]
+ ["Mark and Bury Done Item" todo-item-done t]
+ ["Undo Done Item" todo-item-undone t]
+ ["Archive Done Item" todo-archive-done-item t]
+ "---"
+ ["Add New Category" todo-add-category t]
+ ["Rename Current Category" todo-rename-category t]
+ ["Delete Current Category" todo-delete-category t]
+ ["Move Current Category" todo-move-category t]
+ ["Merge Current Category" todo-merge-category t]
+ "---"
+ ["Add New Todo File" todo-add-file t]
+ ["Rename Todo File" todo-rename-file t]
+ ["Delete Todo File" todo-delete-file t]
+ ["Edit Todo File" todo-edit-file t]
+ )
+ ("Searching and Item Filtering"
+ ["Search Todo File" todo-search t]
+ ["Clear Match Highlighting" todo-clear-matches t]
+ "---"
+ ["Set Top Priorities in File" todo-set-top-priorities-in-file t]
+ ["Set Top Priorities in Category" todo-set-top-priorities-in-category t]
+ ["Filter Top Priorities" todo-filter-top-priorities t]
+ ["Filter Multifile Top Priorities" todo-filter-top-priorities-multifile t]
+ ["Filter Diary Items" todo-filter-diary-items t]
+ ["Filter Multifile Diary Items" todo-filter-diary-items-multifile t]
+ ["Filter Regexp" todo-filter-regexp-items t]
+ ["Filter Multifile Regexp" todo-filter-regexp-items-multifile t]
+ )
+ ("Display and Printing"
+ ["Show/Hide Done Items" todo-toggle-view-done-items t]
+ ["Show/Hide Done Items Only" todo-toggle-view-done-only t]
+ ["Show/Hide Item Highlighting" todo-toggle-item-highlighting t]
+ ["Show/Hide Item Numbering" todo-toggle-prefix-numbers t]
+ ["Show/Hide Item Header" todo-toggle-item-header t]
+ "---"
+ ["Display Table of Categories" todo-show-categories-table t]
+ "---"
+ ["Print Category" todo-print-buffer t]
+ ["Print Category to File" todo-print-buffer-to-file t]
+ )
+ "---"
+ ["Save Todo File" todo-save t]
+ ["Quit Todo Mode" todo-quit t]
+ ))
;; -----------------------------------------------------------------------------
;;; Hook functions and mode definitions
@@ -6425,20 +6523,20 @@ Added to `pre-command-hook' in Todo mode when user option
`todo-show-current-file' is set to non-nil."
(setq todo-global-current-todo-file todo-current-todo-file))
-(defun todo-display-as-todo-file ()
- "Show todo files correctly when visited from outside of Todo mode.
-Added to `find-file-hook' in Todo mode and Todo Archive mode."
- (and (member this-command todo-visit-files-commands)
- (= (- (point-max) (point-min)) (buffer-size))
- (member major-mode '(todo-mode todo-archive-mode))
- (todo-category-select)))
-
-(defun todo-add-to-buffer-list ()
- "Add name of just visited todo file to `todo-file-buffers'.
-This function is added to `find-file-hook' in Todo mode."
- (let ((filename (file-truename (buffer-file-name))))
- (when (member filename todo-files)
- (add-to-list 'todo-file-buffers filename))))
+;; (defun todo-display-as-todo-file ()
+;; "Show todo files correctly when visited from outside of Todo mode.
+;; Added to `find-file-hook' in Todo mode and Todo Archive mode."
+;; (and (member this-command todo-visit-files-commands)
+;; (= (- (point-max) (point-min)) (buffer-size))
+;; (member major-mode '(todo-mode todo-archive-mode))
+;; (todo-category-select)))
+
+;; (defun todo-add-to-buffer-list ()
+;; "Add name of just visited todo file to `todo-file-buffers'.
+;; This function is added to `find-file-hook' in Todo mode."
+;; (let ((filename (file-truename (buffer-file-name))))
+;; (when (member filename todo-files)
+;; (add-to-list 'todo-file-buffers filename))))
(defun todo-update-buffer-list ()
"Make current Todo mode buffer file car of `todo-file-buffers'.
@@ -6470,6 +6568,7 @@ Added to `window-configuration-change-hook' in Todo mode."
(defun todo-modes-set-1 ()
"Make some settings that apply to multiple Todo modes."
(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
@@ -6480,6 +6579,8 @@ Added to `window-configuration-change-hook' in Todo mode."
"Make some settings that apply to multiple Todo modes."
(add-to-invisibility-spec 'todo)
(setq buffer-read-only t)
+ (when (and (boundp 'desktop-save-mode) desktop-save-mode)
+ (setq-local desktop-save-buffer 'todo-desktop-save-buffer))
(when (boundp 'hl-line-range-function)
(setq-local hl-line-range-function
(lambda() (save-excursion
@@ -6491,36 +6592,42 @@ Added to `window-configuration-change-hook' in Todo mode."
"Make some settings that apply to multiple Todo modes."
(setq-local todo-categories (todo-set-categories))
(setq-local todo-category-number 1)
- (add-hook 'find-file-hook 'todo-display-as-todo-file nil t))
+ ;; (add-hook 'find-file-hook 'todo-display-as-todo-file nil t)
+ )
(put 'todo-mode 'mode-class 'special)
+;;;###autoload
(define-derived-mode todo-mode special-mode "Todo"
"Major mode for displaying, navigating and editing todo lists.
\\{todo-mode-map}"
- ;; (easy-menu-add todo-menu)
- (todo-modes-set-1)
- (todo-modes-set-2)
- (todo-modes-set-3)
- ;; Initialize todo-current-todo-file.
- (when (member (file-truename (buffer-file-name))
- (funcall todo-files-function))
- (setq-local todo-current-todo-file (file-truename (buffer-file-name))))
- (setq-local todo-show-done-only nil)
- (setq-local todo-categories-with-marks nil)
- (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t)
- (add-hook 'post-command-hook 'todo-update-buffer-list nil t)
- (when todo-show-current-file
- (add-hook 'pre-command-hook 'todo-show-current-file nil t))
- (add-hook 'window-configuration-change-hook
- 'todo-reset-and-enable-done-separator nil t)
- (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t))
+ (if (called-interactively-p 'any)
+ (message "%s"
+ (substitute-command-keys
+ "Type `\\[todo-show]' to enter Todo mode"))
+ (todo-modes-set-1)
+ (todo-modes-set-2)
+ (todo-modes-set-3)
+ ;; Initialize todo-current-todo-file.
+ (when (member (file-truename (buffer-file-name))
+ (funcall todo-files-function))
+ (setq-local todo-current-todo-file (file-truename (buffer-file-name))))
+ (setq-local todo-show-done-only nil)
+ (setq-local todo-categories-with-marks nil)
+ ;; (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t)
+ (add-hook 'post-command-hook 'todo-update-buffer-list nil t)
+ (when todo-show-current-file
+ (add-hook 'pre-command-hook 'todo-show-current-file nil t))
+ (add-hook 'window-configuration-change-hook
+ 'todo-reset-and-enable-done-separator nil t)
+ (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t)))
(put 'todo-archive-mode 'mode-class 'special)
;; If todo-mode is parent, all todo-mode key bindings appear to be
;; available in todo-archive-mode (e.g. shown by C-h m).
+;;;###autoload
(define-derived-mode todo-archive-mode special-mode "Todo-Arch"
"Major mode for archived todo categories.
@@ -6569,6 +6676,7 @@ Added to `window-configuration-change-hook' in Todo mode."
(put 'todo-filtered-items-mode 'mode-class 'special)
+;;;###autoload
(define-derived-mode todo-filtered-items-mode special-mode "Todo-Fltr"
"Mode for displaying and reprioritizing top priority Todo.
@@ -6576,10 +6684,6 @@ Added to `window-configuration-change-hook' in Todo mode."
(todo-modes-set-1)
(todo-modes-set-2))
-(add-to-list 'auto-mode-alist '("\\.todo\\'" . todo-mode))
-(add-to-list 'auto-mode-alist '("\\.toda\\'" . todo-archive-mode))
-(add-to-list 'auto-mode-alist '("\\.tod[tyr]\\'" . todo-filtered-items-mode))
-
;; -----------------------------------------------------------------------------
(provide 'todo-mode)
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 7d4aa27de1c..6193eb801a3 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -1,9 +1,9 @@
;;; case-table.el --- code to extend the character set and support case tables -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Package: emacs
diff --git a/lisp/cdl.el b/lisp/cdl.el
index f4f9da85114..5677d9db67a 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,9 +1,9 @@
;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: ATAE@spva.physics.imperial.ac.uk (Ata Etemadi)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: data
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog.1
index c39a8a700ef..c9ddc382d50 100644
--- a/lisp/cedet/ChangeLog
+++ b/lisp/cedet/ChangeLog.1
@@ -1,6 +1,686 @@
-2013-07-29 David Engster <deng@randomsample.de>
+2015-02-22 Paul Eggert <eggert@cs.ucla.edu>
- * lisp/cedet/cedet.el (cedet-packages): Remove speedbar since its
+ Spelling fixes
+ * semantic/doc.el (semantic-documentation-comment-preceding-tag):
+ Rename from semantic-documentation-comment-preceeding-tag. All
+ uses changed. Leave an obsolete alias behind.
+
+2015-02-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Fix copy&paste error
+ (semanticdb-project-database => sym). Avoid eieio--class-public-a
+ when possible.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use cl-generic instead of EIEIO's defgeneric/defmethod.
+ * **/*.el: Mechanically replace all calls to defmethod/defgeneric by
+ calls to cl-defmethod/cl-defgeneric.
+ * srecode/table.el:
+ * srecode/fields.el:
+ * srecode/dictionary.el:
+ * srecode/compile.el:
+ * semantic/debug.el:
+ * semantic/db-ref.el:
+ * ede/base.el:
+ * ede/auto.el:
+ * ede.el: Require `cl-generic'.
+
+2015-01-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Don't use <class> as a variable and don't assume that <class>-list-p is
+ automatically defined.
+
+ * ede/speedbar.el (ede-speedbar-compile-line)
+ (ede-speedbar-get-top-project-for-line):
+ * ede.el (ede-buffer-belongs-to-target-p)
+ (ede-buffer-belongs-to-project-p, ede-build-forms-menu)
+ (ede-add-project-to-global-list):
+ * semantic/db-typecache.el (semanticdb-get-typecache):
+ * semantic/db-file.el (semanticdb-load-database):
+ * semantic/db-el.el (semanticdb-elisp-sym->tag):
+ * semantic/db-ebrowse.el (semanticdb-ebrowse-load-helper):
+ * ede/project-am.el (project-am-preferred-target-type):
+ * ede/proj.el (ede-proj-load):
+ * ede/custom.el (ede-customize-current-target, ede-customize-target):
+ * semantic/ede-grammar.el ("semantic grammar"):
+ * semantic/scope.el (semantic-scope-reset-cache)
+ (semantic-calculate-scope):
+ * srecode/map.el (srecode-map-update-map):
+ * srecode/insert.el (srecode-insert-show-error-report)
+ (srecode-insert-method, srecode-insert-include-lookup)
+ (srecode-insert-method):
+ * srecode/fields.el (srecode-active-template-region):
+ * srecode/compile.el (srecode-flush-active-templates)
+ (srecode-compile-inserter): Don't use <class> as a variable.
+ Use `oref-default' for class slots.
+
+ * semantic/grammar.el (semantic-grammar-eldoc-last-data): New var.
+ (semantic-grammar-eldoc-get-macro-docstring): Use it instead of
+ eldoc-last-data.
+ * semantic/fw.el (semantic-exit-on-input): Use `declare'.
+ (semantic-throw-on-input): Use `with-current-buffer'.
+ * semantic/db.el (semanticdb-abstract-table-list): Define if not
+ pre-defined.
+ * semantic/db-find.el (semanticdb-find-tags-collector):
+ Use save-current-buffer.
+ (semanticdb-find-tags-collector): Don't use <class> as a variable.
+ * semantic/complete.el (semantic-complete-active-default)
+ (semantic-complete-current-matched-tag): Declare.
+ (semantic-complete-inline-custom-type): Don't use <class> as a variable.
+ * semantic/bovine/make.el (semantic-analyze-possible-completions):
+ Use with-current-buffer.
+ * semantic.el (semantic-parser-warnings): Declare.
+ * ede/base.el (ede-target-list): Define if not pre-defined.
+ (ede-with-projectfile): Prefer find-file-noselect over
+ save-window-excursion.
+
+2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * srecode/srt-mode.el (srecode-macro-help): Use eieio-class-children.
+
+ * semantic/db.el (semanticdb-cache-get): Prefer eieio-object-class over
+ eieio--object-class.
+
+ * semantic/db-el.el (semanticdb-elisp-sym->tag): Prefer find-class over
+ class-v.
+
+ * ede/generic.el (ede-find-target): Prefer \` and \' to ^ and $.
+
+2014-12-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ * semantic.el (semantic-analyze-completion-at-point-function)
+ (semantic-analyze-notc-completion-at-point-function)
+ (semantic-analyze-nolongprefix-completion-at-point-function):
+ Do nothing if the current buffer is not using Semantic (bug#19077).
+
+2014-12-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ * semantic/lex-spp.el (semantic-lex-spp-analyzer-do-replace):
+ Rename from semantic-lex-spp-anlyzer-do-replace.
+
+2014-12-08 Matt Curtis <matt.r.curtis@gmail.com> (tiny change)
+
+ * pulse.el (pulse-momentary-highlight-one-line): Respect the POINT
+ argument (bug#17260).
+
+2014-11-09 Eric Ludlam <zappo@gnu.org>
+
+ * semantic.el (semantic-mode): Add/remove 3
+ completion-at-point-functions.
+ (semantic-completion-at-point-function): Remove.
+ (semantic-analyze-completion-at-point-function)
+ (semantic-analyze-notc-completion-at-point-function)
+ (semantic-analyze-nolongprefix-completion-at-point-function):
+ New completion at point functions.
+
+ * semantic/doc.el (semantic-doc-snarf-comment-for-tag): Fix case
+ when comment-end is empty string.
+
+ * semantic/debug.el
+ (semantic-debug-parser-debugger-source): New buffer local
+ variable.
+ (semantic-debug-interface): Add 'nil' initform to overlays.
+ (semantic-debug-mode): Remove read-only tags from buffers on exit.
+ (semantic-debug): Add autoload cookie. Force the language
+ specific debugger to load.
+
+ * semantic/db.el (generic::semanticdb-full-filename): New generic
+ method to allow this method to be used on buffer names via an
+ associated database.
+
+ * semantic/symref.el
+ (semantic-symref-cleanup-recent-buffers-fcn): When cleaning up
+ buffers, don't clean up buffers that are being used (i.e., in a
+ window) when the hook fires.
+ (semantic-symref-recently-opened-buffers): New tracking variable.
+ (semantic-symref-cleanup-recent-buffers-fcn): New hook fcn.
+ (semantic-symref-result-get-tags): Move logic into
+ `semantic-symref-hit-to-tag-via-buffer', and cleanup buffers via
+ the symref cleanup function in post-command-hook.
+ (semantic-symref-hit-to-tag-via-buffer): Logic that used to be
+ from above.
+ (semantic-symref-hit-to-tag-via-db): New.
+
+ * semantic/analyze.el:
+ (semantic-analyze-find-tag-sequence-default): If first entry in
+ sequence is the only one, apply tagclass filter.
+ (semantic-analyze-princ-sequence): Show slot even if empty.
+ (semantic-analyze-find-tag-sequence)
+ (semantic-analyze-find-tag-sequence-default): Add flags argument.
+ Add support for forcing the final entry of the sequence to be of
+ class variable.
+ (semantic-analyze-find-tag): Fix bug where input class filter was
+ ignored if there was a typecache match.
+ (semantic-analyze-current-context-default): For assignments, the
+ assignee now must be of class variable.
+
+ * semantic/analyze/complete.el
+ (semantic-analyze-possible-completions-default):
+ Add 'no-longprefix' flag. When used, the prefix and prefixtypes are
+ shortened to just the last symbol.
+
+ * semantic/bovine/c.el (semantic-c-do-lex-if): Catch errors from
+ 'hideif', and push to the parser warning stack.
+ (semantic-lex-cpp-define): When a comment is at the end of a
+ macro, do not subtract an extra 1 from the found position.
+ Fixes bug with: #define foo (a)/**/ adding an extra ')' to the stream.
+
+ * semantic/bovine/scm.el (semantic-lex-scheme-symbol):
+ Allow symbols to be one char long.
+
+ * semantic/bovine/grammar.el
+ (bovine-grammar-calculate-source-on-path): New.
+ (bovine-grammar-setupcode-builder): Use it.
+
+ * ede.el (ede/detect): New require.
+ (ede-version): Bump version
+ (ede-initialize-state-current-buffer): Use new
+ `ede-detect-directory-for-project' to detect projects first
+ instead of depending on currente dir only.
+ (ede-delete-project-from-global-list): New.
+ (ede-flush-deleted-projects): Use above.
+ (ede-check-project-query-fcn): New variable
+ (ede-check-project-directory): Use above when querying the user.
+ Added to support unit testing of this security measure.
+ (ede-initialize-state-current-buffer):
+ Use `ede-directory-project-cons' instead of the -detect- fcn to take
+ advantage of the cache. Pass found project into
+ `ede-load-project-file'.
+ (ede-load-project-file): Add new input DETECTIN.
+ (ede-rescan-toplevel): Get the proj root a better way.
+ (ede-load-project-file): Return the loaded object. When asking
+ for existing project, ask for an exact match.
+ (ede-initialize-state-current-buffer): Simplify some conditional
+ logic.
+ (ede-load-project-file): Simplify conditional logic.
+ (ede-global-list-sanity-check): New Testing fcn.
+ (ede-parent-project): Replace old code with call to faster
+ `ede-find-subproject-for-directory'.
+ (ede-load-project-file):
+ Use `ede-directory-get-toplevel-open-project' instead of above
+ deleted. Rename "pfc" to "autoloader".
+ Use `ede-directory-project-cons' to detect a project. Delete no
+ project found case where we search up the tree.
+
+ * ede/auto.el (ede-project-autoload): Fix doc typo.
+ Add `:root-only' slot.
+ (ede-auto-load-project): Doc update: warn to not use.
+ (ede-dir-to-projectfile): Delete.
+ (ede-project-autoload-dirmatch): Add subdir-only slot.
+ Make configdatastash unbound by default.
+ (ede-do-dirmatch): If subdir-only is true, then don't allow exact
+ matches. Account for configdatastash as unbound. Assume value of
+ nil means no tool installed. Make sure loaded path matches from
+ beginning. Stash the regexp, not the raw string.
+ (ede-project-class-files): Note that makefile and automake are not
+ root only.
+ (ede-auto-detect-in-dir): New (for use with `ede/detect.el').
+ (ede-project-dirmatch-p): Delete.
+ (ede-project-root-directory): Remove body, return nil.
+ (ede-project-autoload): :proj-root-dirmatch can be null & doc fix.
+ (ede-auto-detect-in-dir): If there is no :proj-file, check for a
+ dirmatch.
+
+ * ede/generic.el (ede/config): Replace require of ede.
+ (ede-generic-new-autoloader): Generic projects are now safe by
+ default. Note this is NOT a root only project.
+ (project-rescan, ede-project-root, ede-generic-target-java)
+ (ede-java-classpath, ede-find-subproject-for-directory): New.
+ (ede-enable-generic-projects): Add new autoloaders for git, bzr,
+ hg, sv, CVS.
+ (ede-generic-vc-project)
+ (ede-generic-vc-project::ede-generic-setup-configuration): New.
+ (ede-generic-config): Remove slots: c-include-path,
+ c-preprocessor-table, c-preprocessor-files, classpath,
+ build-command, debug-command, run command. Inherit from
+ ede-extra-config-build, ede-extra-config-program.
+ Make run-command :value match :custom so only strings are accepted.
+ Add some more :group slot specifiers.
+ (ede-generic-project): Add mixins `ede-project-with-config-c' and
+ `ede-project-with-config-java'. Inherit from
+ `ede-project-with-config-build',
+ `ede-project-with-config-program'. Subclass
+ `ede-project-with-config'. Remove duplication from new baseclass.
+ (ede-generic-target): Inherit from `ede-target-with-config-build',
+ `ede-target-with-config-program'. Subclass `ede-target-with-config'.
+ (ede-generic-target-c-cpp): Add mixin `ede-target-with-config-c'.
+ (ede-generic-target-java): Add mixin `ede-target-with-config-java'.
+ (ede-preprocessor-map, ede-system-include-path)
+ (edejava-classpath): Delete, moved to config.el.
+ (project-compile-project, project-compile-target)
+ (project-debug-target, project-run-target): Delete.
+ (ede-generic-get-configuration, ede-generic-setup-configuration)
+ (ede-commit-project, project-rescan)
+ (ede-generic-project::ede-customize)
+ (ede-generic-target::ede-customize)
+ (ede-generic-config::eieio-done-customizing)
+ (ede-generic-config::ede-commit): Delete. Subsumed by new
+ baseclass.
+ (ede-preprocessor-map, ede-system-include-path)
+ (project-debug-target, project-run-target): Call new
+ `ede-config-get-configuration' instead of old version.
+ (ede-generic-load): Do not add to global list here.
+
+ * ede/files.el (ede-find-project-root)
+ (ede-files-find-existing)
+ (ede-directory-get-toplevel-open-project-new): Delete.
+ (ede-project-root-directory): Use `ede-project-root' first.
+ (ede-project-directory-remove-hash)
+ (ede--directory-project-from-hash)
+ (ede--directory-project-add-description-to-hash): Rename to make
+ internal symbols (via --). Expand input dir first.
+ (ede-directory-project-p): Doc fix (note obsoleted.)
+ (ede-toplevel-project-or-nil): Alias to `ede-toplevel-project'.
+ (ede-toplevel-project): Doc Fix. Delete commented out old code.
+ Simplify returning result from ede-detect-directory-for-project.
+ (ede-directory-get-open-project): Support when
+ inodes are disabled. If disabled to str compare on root project.
+ (ede-directory-get-toplevel-open-project): Enabled nested
+ projects. When doing directory name matching, save the 'short'
+ version of an answer (non-exact match) and eventually select the
+ shortest answer at the end. Expand the filename of tested
+ projects. Better support for when inodes are disabled.
+ Add 'exact' option so that it will return a project that is an exact
+ match.
+ (ede-find-subproject-for-directory): Small optimization to run
+ `file-truename' less often.
+ (ede-directory-project-p): Move content, then use
+ `ede-directory-project-cons'.
+ Use `ede-detect-directory-for-project', replacing old detection loop.
+ (ede-directory-project-cons): New, from above.
+ (ede-toplevel-project): Toss old scanning code.
+ Use `ede-detect-directory-for-project' instead.
+ (ede-directory-get-toplevel-open-project-new): New.
+
+ * ede/linux.el (ede-linux-project-root): Delete.
+ (ede-project-autoload): Remove dirmatch entry - it is no longer
+ needed.
+
+ * ede/proj.el (project-rescan): Replace direct
+ 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.
+
+ * ede/config.el:
+ * ede/detect.el: New files.
+
+ * ede/project-am.el (project-run-target): Add "./" to program to
+ run for systems where '.' isn't in PATH.
+ (project-am-load): Remove old code regarding `ede-constructing'.
+ Just read in the makefiles.
+
+ * ede/linux.el (ede-linux-load): Do not add to global list here.
+ Don't check for existing anymore.
+ (project-rescan): New.
+ (ede-linux-project-list, ede-linux-file-existing): Delete.
+ (ede-linux-project-root): Delete body. Need symbol for autoloads
+ for now.
+ (ede-linux-project): No longer instance tracker.
+ (ede-project-autoload): Don't provide :proj-root
+
+ * ede/emacs.el (ede-emacs-load): Do not add project to global list
+ here. Don't look for existing first.
+ (ede-project-autoload): Remove dirmatch entry - it is no longer
+ needed. Don't provide proj-root anymore.
+ (ede-emacs-project-list, ede-emacs-file-existing): Delete.
+ (ede-emacs-project-root): Remove body (need symbol for loaddefs
+ still).
+ (ede-emacs-project): Do not instance track anymore.
+
+ * ede/cpp-root.el (initialize-instance): Remove commented code.
+ Add note about why we are adding the project to the master list.
+ Make sure if we are replacing a prev version, remove from global
+ list.
+ (ede-cpp-root-file-existing)
+ (ede-cpp-root-project-file-for-dir)
+ (ede-cpp-root-count, ede-cpp-root-project-root, ede-cpp-root-load)
+ (ede-project-autoload cpp-root): Delete.
+ (ede-project-root-directory): Return :directory instead of
+ calculating from :file.
+ (project-rescan): New.
+
+ * ede/base.el (ede-toplevel): Only use buffer cached value if
+ subproj not passed in.
+
+ * srecode/java.el (srecode-semantic-handle-:java): Fix case when
+ an EDE project didn't support java paths.
+
+2014-11-09 David Engster <dengste@eml.cc>
+
+ * ede/proj-elisp.el (ede-proj-target-elisp::ede-proj-tweak-autoconf):
+ Kill buffer after saving modified elisp-comp script, so as to avoid
+ "file has changed on disk; really edit the buffer" questions when
+ script gets rewritten.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * srecode/args.el (srecode-semantic-handle-:time):
+ Don't call current-time twice to get the current time stamp,
+ as this can lead to inconsistent results.
+
+2014-10-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/complete.el: Require semantic/db-find.
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/wisent/comp.el (wisent-defcontext): Move declarations
+ outside of eval-when-compile. Use `declare'.
+ (wisent-with-context): Add `defvar' declarations in case this macro is
+ used in a file compiled with lexical-binding.
+ (wisent-semantic-action-expand-body): Avoid add-to-list on local var.
+
+2014-09-22 David Engster <deng@randomsample.de>
+
+ * ede/emacs.el (ede-emacs-version): Do not call 'egrep' to
+ determine Emacs version (it was dead code anyway). Make sure that
+ configure.ac or configure.in exist. (Bug#18476)
+
+2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/ia.el (semantic-ia-complete-symbol-menu): Use posn-at-point
+ instead of senator-completion-menu-point-as-event; un-comment, tho keep
+ the "no smart completion" fallback commented since it still doesn't
+ work.
+
+2014-05-01 Glenn Morris <rgm@gnu.org>
+
+ * ede.el (ede-project-directories, ede-check-project-directory):
+ * semantic/ia-sb.el (semantic-ia-sb-show-doc):
+ * semantic/tag.el (semantic-tag-in-buffer-p):
+ * semantic/bovine/c.el (semantic-tag-abstract-p):
+ Doc fixes (replace `iff').
+
+2014-04-01 Glenn Morris <rgm@gnu.org>
+
+ * ede/emacs.el (ede-emacs-version): Update AC_INIT regexp. (Bug#17160)
+
+2014-03-29 Glenn Morris <rgm@gnu.org>
+
+ * ede/dired.el (ede-dired-minor-mode): Add autoload cookie.
+ (generated-autoload-file, generated-autoload-load-name):
+ Set file-local values.
+ * ede.el: Load ede/loaddefs at compile time too.
+ (ede-dired-minor-mode): Remove hand-written autoload.
+
+2014-03-04 Glenn Morris <rgm@gnu.org>
+
+ * semantic/util.el (semantic-complete-symbol):
+ Replace use of obsolete argument of display-completion-list.
+
+2014-02-03 Glenn Morris <rgm@gnu.org>
+
+ * semantic/senator.el (senator-copy-tag-to-register):
+ Use register-read-with-preview, if available.
+
+2014-01-13 Eric Ludlam <zappo@gnu.org>
+
+ * semantic/analyze/refs.el (semantic-analyze-refs-impl): Fix typo
+ in a doc string.
+
+ * semantic/ia.el (semantic-ia-complete-symbol): Ignore case if
+ prefix is all lower case.
+ (semantic-ia-fast-jump): Push mark before jumping to an include file.
+
+ * semantic/complete.el (semantic-displayor-point-position):
+ Calculate if the toolbar is on the left when calculating point
+ position.
+
+2014-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * semantic/decorate/include.el (semantic-decoration-mouse-3):
+ Rename from semantic-decoratiton-mouse-3. All uses changed.
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * ede/linux.el (project-linux-build-directory-default)
+ (project-linux-architecture-default): Fix custom types. Add version.
+
+2013-12-12 David Engster <deng@randomsample.de>
+
+ * semantic/analyze.el (semantic-analyze-find-tag-sequence-default):
+ Always add scope to the local miniscope for each type. Otherwise,
+ structure tags are not analyzed correctly. Also, always search
+ the extended miniscope even when not dealing with types.
+
+ * semantic/ctxt.el (semantic-get-local-variables-default):
+ Also try to parse local variables for buffers which are currently
+ marked as unparseable. Otherwise, it is often impossible to
+ complete local variables.
+
+ * semantic/scope.el (semantic-analyze-scoped-types-default): If we
+ cannot find a type in the typecache, also look into the the types
+ we already found. This is necessary since in C++, a 'using
+ namespace' can be dependend on a previous one.
+ (semantic-completable-tags-from-type): When creating the list of
+ completable types, pull in types which are referenced through
+ 'using' statements, and also preserve their filenames.
+
+ * semantic/bovine/c.el (semantic/analyze/refs): Require.
+ (semantic-analyze-tag-references): New override. Mainly copied
+ from the default implementation, but if nothing could be found (or
+ just the tag itself), drop all namespaces from the scope and
+ search again. This is necessary for implementations which are
+ defined outside of the namespace and only pull those in through
+ 'using' statements.
+ (semantic-ctxt-scoped-types): Go through all tags around point and
+ search them for using statements. In the case for using
+ statements outside of function scope, append them in the correct
+ order instead of using 'cons'. This is important since using
+ statements may depend on previous ones.
+ (semantic-expand-c-tag-namelist): Do not try to parse struct
+ definitions as default values. The grammar parser seems to return
+ the point positions slightly differently (as a cons instead of a
+ list). Also, set parent for typedefs to 'nil'. It does not
+ really make sense to set a parent class for typedefs, and it can
+ also lead to endless loops when calculating scope.
+ (semantic-c-reconstitute-token): Change handling of function
+ pointers; instead of seeing them as variables, handle them as
+ functions with a 'function-pointer' attribute. Also, correctly
+ deal with function pointers as function arguments.
+ (semantic-c-reconstitute-function-arglist): New function to parse
+ function pointers inside an argument list.
+ (semantic-format-tag-name): Use 'function-pointer' attribute
+ instead of the old 'functionpointer-flag'.
+ (semantic-cpp-lexer): Use new `semantic-lex-spp-paren-or-list'.
+
+ * semantic/bovine/gcc.el (semantic-gcc-setup): Add 'features.h' to
+ the list of files whose preprocessor symbols are included.
+ This pulls in things like __USE_POSIX and similar.
+
+ * semantic/format.el (semantic-format-tag-prototype-default):
+ Display default values if available.
+
+ * semantic/analyze/refs.el (semantic-analyze-refs-impl)
+ (semantic-analyze-refs-proto): Add 'default-value' as ignorable in
+ call to `semantic-tag-similar-p'.
+
+ * semantic/db-mode.el (semanticdb-semantic-init-hook-fcn):
+ Always set buffer for `semanticdb-current-table'.
+
+ * semantic/db.el (semanticdb-table::semanticdb-refresh-table):
+ The previous change turned up a bug in this method. Since the current
+ table now correctly has a buffer set, the first clause in the
+ `cond' would be taken, but there was a `save-excursion' missing.
+
+ * semantic/lex-spp.el (semantic-c-end-of-macro): Declare.
+ (semantic-lex-spp-token-macro-to-macro-stream): Deal with macros
+ which open/close a scope. For this, leave an overlay if we
+ encounter a single open paren and return a semantic-list in the
+ lexer. When this list gets expanded, retrieve the old position
+ from the overlay. See the comments in the function for further
+ details.
+ (semantic-lex-spp-find-closing-macro): New function to find the
+ next macro which closes scope (i.e., has a closing paren).
+ (semantic-lex-spp-replace-or-symbol-or-keyword): Go to end of
+ closing macro if necessary.
+ (semantic-lex-spp-paren-or-list): New lexer to specially deal with
+ parens in macro definitions.
+
+ * semantic/decorate/mode.el (semantic-decoration-mode): Do not
+ decorate available tags immediately but in an idle timer, since
+ EDE will usually not be activated yet, which will make it
+ impossible to find project includes.
+
+ * semantic/decorate/include.el
+ (semantic-decoration-on-includes-highlight-default):
+ Remove 'unloaded' from throttle when decorating includes, otherwise all
+ would be loaded. Rename 'table' to 'currenttable' to make things
+ clearer.
+
+ * ede/linux.el (cl): Require during compile.
+
+2013-12-12 Lluís Vilanova <xscript@gmx.net>
+
+ * ede/linux.el (project-linux-build-directory-default)
+ (project-linux-architecture-default): Add customizable variables.
+ (ede-linux-project): Add additional slots to track Linux-specific
+ information (out-of-tree build directory and selected
+ architecture).
+ (ede-linux--get-build-directory, ede-linux--get-archs)
+ (ede-linux--detect-architecture, ede-linux--get-architecture)
+ (ede-linux--include-path): Add function to detect Linux-specific
+ information.
+ (ede-linux-load): Set new Linux-specific information when creating
+ a project.
+ (ede-expand-filename-impl): Use new and more accurate include
+ information.
+
+2013-12-12 Eric Ludlam <zappo@gnu.org>
+
+ * semantic/scope.el (semantic-calculate-scope): Return a clone of
+ the scopecache, so that everyone is working with its own (shallow)
+ copy. Otherwise, if one caller is resetting the scope, it would
+ be reset for all others working with the scope cache as well.
+
+2013-12-12 Alex Ott <alexott@gmail.com>
+
+ * ede/generic.el (project-run-target): Remove incorrect require.
+
+ * semantic/format.el (semantic-format-tag-prototype-default):
+ Use concat only for strings.
+
+2013-11-30 Glenn Morris <rgm@gnu.org>
+
+ Stop keeping (most) generated cedet grammar files in the repository.
+ * semantic/bovine/grammar.el (bovine--make-parser-1):
+ New function, split from bovine-make-parsers.
+ (bovine-make-parsers): Use bovine--make-parser-1.
+ (bovine-batch-make-parser): New function.
+ * semantic/wisent/grammar.el (wisent--make-parser-1):
+ New function, split from wisent-make-parsers.
+ (wisent-make-parsers): Use wisent--make-parser-1.
+ (wisent-batch-make-parser): New function.
+ * semantic/db.el (semanticdb-save-all-db):
+ Avoid prompting in batch mode.
+ * semantic/grammar.el (semantic-grammar-footer-template):
+ Disable version-control and autoloads in the output.
+ (semantic-grammar-create-package):
+ Add option to return nil if output is up-to-date.
+ * semantic/bovine/c-by.el, semantic/bovine/make-by.el:
+ * semantic/bovine/scm-by.el, semantic/wisent/javat-wy.el:
+ * semantic/wisent/js-wy.el, semantic/wisent/python-wy.el:
+ * srecode/srt-wy.el: Remove generated files from repository.
+
+2013-11-16 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * semantic/fw.el (semantic-exit-on-input)
+ (semantic-throw-on-input): Restore point before
+ accept-process-output because timers which redisplay can run.
+ (Bug#15045)
+
+2013-11-03 Johan Bockgård <bojohan@gnu.org>
+
+ * semantic/lex.el (semantic-lex-start-block)
+ (semantic-lex-end-block): Move after definition of
+ semantic-lex-token macro.
+
+2013-10-28 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * semantic/idle.el (semantic-idle-symbol-highlight)
+ (semantic-idle-symbol-highlight-face): Define face with defface
+ and obsolete the replaced one defined with defvar. (Bug#15745)
+ * pulse.el (pulse-momentary-highlight-overlay)
+ (pulse-momentary-highlight-region): Fix typo in doc
+
+2013-10-30 Glenn Morris <rgm@gnu.org>
+
+ * semantic/grammar.el (semantic-grammar-mode-keywords-2)
+ (semantic-grammar-mode-keywords-3): Handle renamed font-lock vars.
+
+2013-10-20 Johan Bockgård <bojohan@gnu.org>
+
+ * semantic/db-mode.el (global-semanticdb-minor-mode):
+ Remove hooks correctly.
+ (semanticdb-toggle-global-mode): Pass `toggle' to minor mode function.
+
+2013-09-28 Leo Liu <sdl.web@gmail.com>
+
+ * semantic/texi.el (semantic-analyze-possible-completions):
+ Use ispell-lookup-words instead. (Bug#15460)
+
+2013-09-20 Glenn Morris <rgm@gnu.org>
+
+ * semantic.el (semantic-new-buffer-fcn-was-run, semantic-active-p):
+ Move from here...
+ * semantic/fw.el: ...to here.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * semantic/find.el (semantic-brute-find-first-tag-by-name):
+ Replace obsolete function assoc-ignore-case with assoc-string.
+
+ * semantic/complete.el (tooltip-mode, tooltip-frame-parameters)
+ (tooltip-show): Declare.
+
+2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/symref/list.el (semantic-symref-results-mode):
+ Use define-derived-mode.
+ (semantic-symref-produce-list-on-results): Set up the results here
+ instead of in semantic-symref-results-mode. Move after
+ semantic-symref-current-results's defvar now that it refers to that var.
+ (semantic-symref-auto-expand-results)
+ (semantic-symref-results-summary-function)
+ (semantic-symref-results-mode-hook): Remove redundant :group arg.
+ (semantic-symref, semantic-symref-symbol, semantic-symref-regexp):
+ Initialize directly in the let.
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * semantic/ia.el (semantic-ia-complete-symbol-menu):
+ Comment it out, since it cannot work. (Bug#14522)
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * semantic/find.el (semantic-find-first-tag-by-name):
+ Replace obsolete function assoc-ignore-case with assoc-string.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * semantic/grammar.el (semantic-grammar-mode): Use define-derived-mode.
+ (semantic-grammar-mode-syntax-table): Rename from
+ semantic-grammar-syntax-table.
+ (semantic-grammar-mode-map): Rename from semantic-grammar-map.
+ * data-debug.el (data-debug-mode-map): Rename from data-debug-map.
+ (data-debug-mode): Use define-derived-mode.
+
+2013-09-05 Glenn Morris <rgm@gnu.org>
+
+ * semantic/fw.el (semantic-make-local-hook):
+ Simplify by dropping Emacs <= 20.
+
+2013-07-29 David Engster <deng@randomsample.de>
+
+ * cedet.el (cedet-packages): Remove speedbar since its
development does no longer happens in CEDET upstream but in Emacs
proper. Also remove cedet-contrib and cogre since those are only
in upstream.
@@ -10,18 +690,18 @@
* semantic/decorate/mode.el
(semantic-decoration-on-includes-p-default)
- (semantic-decoration-on-includes-highlight-default): Declare for
+ (semantic-decoration-on-includes-highlight-default): Declare for
byte compiler.
* semantic/wisent/python.el (semantic/format): New require.
-2013-07-27 Eric Ludlam <zappo@gnu.org>
+2013-07-27 Eric Ludlam <zappo@gnu.org>
- * lisp/cedet/semantic/edit.el (semantic-edits-splice-remove): Wrap
- debug message removing middle tag in semantic-edits-verbose-flag
+ * semantic/edit.el (semantic-edits-splice-remove):
+ Wrap debug message removing middle tag in semantic-edits-verbose-flag
check.
-2013-07-27 David Engster <deng@randomsample.de>
+2013-07-27 David Engster <deng@randomsample.de>
* semantic/bovine/el.el (semantic/db-el): New require.
@@ -64,8 +744,8 @@
`semantic/decorate/include' anymore.
(semantic-toggle-decoration-style): Error if an unknown decoration
style is toggled.
- (define-semantic-decoration-style): Add new :load option. When
- :load is specified, add autoload tokens for the definition
+ (define-semantic-decoration-style): Add new :load option.
+ When :load is specified, add autoload tokens for the definition
functions so that code is loaded when the mode is used.
(semantic-decoration-on-includes): New autoload definition for
highlighting includes.
@@ -89,8 +769,8 @@
* semantic/ctxt.el (semantic-ctxt-end-of-symbol): New.
(semantic-ctxt-current-symbol-default): New.
- * semantic/bovine/el.el (semantic-default-elisp-setup): Add
- autoload cookie. Explain existence.
+ * semantic/bovine/el.el (semantic-default-elisp-setup):
+ Add autoload cookie. Explain existence.
(footer): Add local variable for loaddefs.
* semantic/db.el (semanticdb-file-table-object): Add new filter,
@@ -115,7 +795,7 @@
* ede/cpp-root.el (ede-preprocessor-map): Protect against init
problems.
- * ede/proj.el (ede-proj-target): Added a new "custom" option for
+ * ede/proj.el (ede-proj-target): Add a new "custom" option for
custom symbols representing a compiler or linker instead of
restricting things to only the predefined compilers and linkers.
@@ -193,19 +873,19 @@
2013-04-27 David Engster <deng@randomsample.de>
* semantic/complete.el
- (semantic-collector-calculate-completions-raw): If
- `completionslist' is not set, refresh the cache if necessary and
+ (semantic-collector-calculate-completions-raw):
+ If `completionslist' is not set, refresh the cache if necessary and
use it for completions. This fixes the
`semantic-collector-buffer-deep' collector (bug#14265).
2013-03-26 Leo Liu <sdl.web@gmail.com>
- * semantic/senator.el (senator-copy-tag-to-register): Move
- register handling logic from register.el. (Bug#14052)
+ * semantic/senator.el (senator-copy-tag-to-register):
+ Move register handling logic from register.el. (Bug#14052)
2013-03-21 Eric Ludlam <zappo@gnu.org>
- * semantic.el (navigate-menu): Yank Tag :enable. Make sure
+ * semantic.el (navigate-menu): Yank Tag :enable. Make sure
`senator-tag-ring' is bound.
(semantic-parse-region-default): Stop reversing the output of
parse-whole-stream.
@@ -218,17 +898,17 @@
* semantic/find.el (semantic-filter-tags-by-class): New function.
- * semantic/tag-ls.el (semantic-tag-similar-p-default): Add
- short-circuit in case tag1 and 2 are identical.
+ * semantic/tag-ls.el (semantic-tag-similar-p-default):
+ Add short-circuit in case tag1 and 2 are identical.
* semantic/analyze/fcn.el
- (semantic-analyze-dereference-metatype-stack): Use
- `semantic-tag-similar-p' instead of 'eq' when comparing two tags
+ (semantic-analyze-dereference-metatype-stack):
+ Use `semantic-tag-similar-p' instead of 'eq' when comparing two tags
during metatype evaluation in case they are the same, but not the
same node. (Tweaked patch from Tomasz Gajewski) (Tiny change)
- * semantic/db-find.el (semanticdb-partial-synchronize): Fix
- require to semantic/db-typecache to be correct.
+ * semantic/db-find.el (semanticdb-partial-synchronize):
+ Fix require to semantic/db-typecache to be correct.
(semanticdb-find-tags-external-children-of-type): Make this a
brutish search by default.
@@ -238,19 +918,19 @@
input tag as the place to start searching for externally defined
methods.
- * semantic/db-file.el (semanticdb-default-save-directory): Doc
- fix: Add ref to default value.
+ * semantic/db-file.el (semanticdb-default-save-directory):
+ Doc fix: Add ref to default value.
- * semantic/complete.el (semantic-complete-post-command-hook): When
- detecting if cursor is outside completion area, do so if cursor
+ * semantic/complete.el (semantic-complete-post-command-hook):
+ When detecting if cursor is outside completion area, do so if cursor
moves before start of overlay, or the original starting location
of the overlay (i.e., if user deletes past beginning of the
overlay region).
(semantic-complete-inline-tag-engine): Initialize original start
of `semantic-complete-inline-overlay'.
- * semantic/bovine/c.el (semantic-c-describe-environment): Update
- some section titles. Test semanticdb table before printing it.
+ * semantic/bovine/c.el (semantic-c-describe-environment):
+ Update some section titles. Test semanticdb table before printing it.
(semantic-c-reset-preprocessor-symbol-map): Update
`semantic-lex-spp-macro-symbol-obarray' outside the loop over all
the files contributing to its value.
@@ -266,8 +946,8 @@
* srecode/cpp.el (srecode-semantic-handle-:c): Replace all
characters in FILENAME_SYMBOL that aren't valid CPP symbol chars.
- * srecode/map.el (srecode-map-validate-file-for-mode): Force
- semantic to load if it is not active in the template being added
+ * srecode/map.el (srecode-map-validate-file-for-mode):
+ Force semantic to load if it is not active in the template being added
to the map.
* srecode/srt.el: Add local variables for setting the autoload
@@ -282,7 +962,7 @@
has both a version variable and a Version: comment, always use
`call-next-method'.
- * ede/cpp-root.el (ede-set-project-variables): Deleted.
+ * ede/cpp-root.el (ede-set-project-variables): Delete.
`ede-preprocessor-map' does the job this function was attempting
to do with :spp-table.
(ede-preprocessor-map): Update file tests to provide better
@@ -297,8 +977,8 @@
2013-03-21 David Engster <deng@randomsample.de>
* semantic/bovine/c.el (semantic-get-local-variables): Also add a
- new variable 'this' if we are in an inline member function. For
- detecting this, we check overlays at point if there is a class
+ new variable 'this' if we are in an inline member function.
+ For detecting this, we check overlays at point if there is a class
spanning the current function. Also, the variable 'this' has to
be a pointer.
@@ -307,18 +987,15 @@
* srecode/srt-mode.el:
* srecode/compile.el:
- * semantic/elp.el:
* semantic/db-el.el:
* semantic/complete.el:
* ede.el:
- * cogre.el:
* srecode/table.el:
* srecode/mode.el:
* srecode/insert.el:
* srecode/compile.el:
* semantic/decorate/include.el:
* semantic/db.el:
- * semantic/adebug.el:
* ede/auto.el:
* srecode/dictionary.el:
* semantic/ede-grammar.el:
@@ -345,14 +1022,14 @@
2013-03-21 Tomasz Gajewski <tomga@wp.pl> (tiny change)
- * ede/cpp-root.el (ede-project-autoload, initialize-instance): Fix
- EDE file symbol to match rename. Fix ede-cpp-root symbol to
+ * ede/cpp-root.el (ede-project-autoload, initialize-instance):
+ Fix EDE file symbol to match rename. Fix ede-cpp-root symbol to
include -project in name.
2013-03-21 Alex Ott <alexott@gmail.com>
- * cedet-files.el (cedet-files-list-recursively): New. Recursively
- find files whose names are matching to given regex.
+ * cedet-files.el (cedet-files-list-recursively): New.
+ Recursively find files whose names are matching to given regex.
* ede.el (ede-current-project): Rewrite to avoid imperative style.
@@ -558,9 +1235,9 @@
* ede.el (ede-buffer-belongs-to-project-p): Use ede-object-project
to allow use in more kinds of buffers.
(ede-project-forms-menu): Add `Default configuration' menu item.
- (ede-configuration-forms-menu): New, for use in above.
- (ede-project-configurations-set): New command used from menu.
- (ede-java-classpath): New conveninece for Java support.
+ (ede-configuration-forms-menu): New, for use in above.
+ (ede-project-configurations-set): New command used from menu.
+ (ede-java-classpath): New conveninece for Java support.
(ede-apply-object-keymap): Combine keybindings from the project
and the target, not just whatever is local to the buffer.
(ede-apply-target-options): Call fcn to apply project local
@@ -627,9 +1304,9 @@
(-scheme, -makefile-misc, ede-proj-target-makefile-program)
(-makefile-archive, -makefile-shared-object)
(ede-proj-target-makefile-info, -grammar): New autoloads.
- (ede-proj-project): Inherit from eieio-persistent-read.
+ (ede-proj-project): Inherit from eieio-persistent-read.
Specify extension and header line.
- (ede-proj-load, ede-proj-save): Replace with impl using
+ (ede-proj-load, ede-proj-save): Replace with impl using
eieio-persistent-read.
* ede/project-am.el (project-add-file): Use ede-target-parent
@@ -673,7 +1350,7 @@
* semantic/db-typecache.el
(semanticdb-abstract-table::semanticdb-typecache-find-method):
Allow proxied tags to be resolved during the search.
- (semanticdb-typecache-complete-flush): Support missing or empty
+ (semanticdb-typecache-complete-flush): Support missing or empty
pointmax slot, to allow for more database types.
* semantic/db.el (semanticdb-abstract-table): Add db-refs slot.
@@ -738,7 +1415,7 @@
* srecode/compile.el (srecode-compile-templates): Add "framework"
special variable support.
- (srecode-compile-template-table): Support framework specifier.
+ (srecode-compile-template-table): Support framework specifier.
* srecode/cpp.el (srecode-semantic-handle-:c)
(srecode-semantic-handle-:cpp): New functions.
@@ -763,7 +1440,7 @@
* srecode/srt-mode.el (srecode-font-lock-keywords): Update.
* srecode/table.el (srecode-template-table): Add :framework slot.
- (srecode-dump): Dump it.
+ (srecode-dump): Dump it.
(srecode-mode-table): Add new modetables slot.
(srecode-get-mode-table): Find the mode, but also find all parent
modes, and merge the tables together in :tables from :modetables.
@@ -799,7 +1476,7 @@
(ede-proj-makefile-insert-variables): Do not insert preload items.
(ede-proj-target-elisp-autoloads): Don't depend on cedet-autogen.
- * ede/util.el (ede-make-buffer-writable):
+ * ede/util.el (ede-make-buffer-writable):
* semantic/debug.el (semantic-debug-mode): Set buffer-read-only
instead of calling toggle-read-only.
@@ -821,9 +1498,9 @@
(semantic-c-convert-spp-value-to-hideif-value)
(semantic-c-evaluate-symbol-for-hideif, semantic-c-hideif-lookup)
(semantic-c-hideif-defined): Revive hideif code from CEDET trunk.
- (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for
+ (semantic-lex-c-if, semantic-c-do-lex-ifdef): Revert changes for
regular expression parsing.
- (semantic-cpp-lexer): Add semantic-lex-c-ifdef.
+ (semantic-cpp-lexer): Add semantic-lex-c-ifdef.
(semantic-expand-c-tag): Check if tag is non-nil before adding it
to return list.
(semantic-expand-c-extern-C, semantic-expand-c-complex-type):
@@ -923,9 +1600,9 @@
(project-compile-project, project-compiler-target): New methods.
* inversion.el (inversion-decoders): New regexps for SXEmacs.
- (inversion-package-version): More verbose error message.
- (inversion-<): Deal with new special cases.
- (inversion-require-emacs): New argument sxemacs-ver; use it.
+ (inversion-package-version): More verbose error message.
+ (inversion-<): Deal with new special cases.
+ (inversion-require-emacs): New argument sxemacs-ver; use it.
2012-10-01 Nelson Ferreira <nelson.ferreira@ieee.org>
@@ -938,7 +1615,7 @@
(semantic-gcc-setup): If the first attempt at calling cpp fails,
try straight GCC.
-2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de>
+2012-10-01 Jan Moringen <jan.moringen@uni-bielefeld.de>
* semantic/idle.el
(semantic-idle-breadcrumbs--display-in-header-line):
@@ -978,7 +1655,7 @@
* semantic/wisent/python.el (wisent-python-string-start-re)
(wisent-python-string-re, wisent-python-forward-string)
- (wisent-python-forward-line,wisent-python-lex-string):
+ (wisent-python-forward-line, wisent-python-lex-string):
New variables.
(wisent-python-forward-balanced-expression): New function.
@@ -1081,7 +1758,7 @@
(ede-directory-safe-p): Check it.
(ede-initialize-state-current-buffer, ede, ede-new)
(ede-check-project-directory, ede-rescan-toplevel)
- (ede-load-project-file, ede-parent-project, ede-current-project):
+ (ede-load-project-file, ede-parent-project, ede-current-project)
(ede-target-parent): Avoid loading in a project unless it is safe,
since it may involve malicious code. This security flaw was
pointed out by Hiroshi Oota.
@@ -1194,7 +1871,7 @@
(semantic-decoration-unknown-include-describe): Fix filenames in
docstring.
- * semantic/ede-grammar.el (semantic-ede-grammar-compiler-wisent):
+ * semantic/ede-grammar.el (semantic-ede-grammar-compiler-wisent)
(semantic-ede-grammar-compiler-bovine): Fix requires that are
added to the grammar-make-script.
@@ -1211,7 +1888,7 @@
2011-10-19 Chong Yidong <cyd@gnu.org>
- * ede.el (ede-minor-mode,global-ede-mode):
+ * ede.el (ede-minor-mode, global-ede-mode):
* semantic.el (semantic-mode): Doc fix to reflect new
define-minor-mode calling behavior.
@@ -1435,10 +2112,10 @@
Synch EDE to CEDET 1.0.
* cedet-idutils.el (cedet-idutils-make-command): New option.
- (cedet-idutils-mkid-call):
+ (cedet-idutils-mkid-call)
(cedet-idutils-create/update-database): New functions.
- * cedet-cscope.el (cedet-cscope-create):
+ * cedet-cscope.el (cedet-cscope-create)
(cedet-cscope-create/update-database): New functions.
(cedet-cscope-support-for-directory): Make interactive.
@@ -1490,7 +2167,7 @@
(ede-project-root, ede-project-root-directory): Move to
ede/auto.el.
- * ede/locate.el (ede-locate-flush-hash):
+ * ede/locate.el (ede-locate-flush-hash)
(ede-locate-create/update-root-database): New methods.
(initialize-instance): Use ede-locate-flush-hash.
@@ -1603,7 +2280,7 @@
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a position.
- * semantic/complete.el (semantic-collector-local-members):
+ * semantic/complete.el (semantic-collector-local-members)
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
@@ -1775,7 +2452,7 @@
Use define-minor-mode in CEDET where applicable.
- * srecode/mode.el (srecode-minor-mode,global-srecode-minor-mode):
+ * srecode/mode.el (srecode-minor-mode, global-srecode-minor-mode):
Use define-minor-mode.
* semantic/util-modes.el (semantic-add-minor-mode):
@@ -2262,7 +2939,7 @@
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype)
(semantic-analyzer-debug-insert-include-summary):
- * semantic/util.el (semantic-file-tag-table):
+ * semantic/util.el (semantic-file-tag-table)
(semantic-describe-buffer-var-helper, semantic-something-to-tag-table)
(semantic-recursive-find-nonterminal-by-name):
* semantic/tag-ls.el (semantic-tag-calculate-parent-default):
@@ -2270,15 +2947,15 @@
* semantic/symref.el (semantic-symref-parse-tool-output):
* semantic/sb.el (semantic-sb-fetch-tag-table):
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
- * semantic/idle.el (semantic-idle-work-for-one-buffer):
+ * semantic/idle.el (semantic-idle-work-for-one-buffer)
(semantic-idle-summary-maybe-highlight):
* semantic/ia-sb.el (semantic-ia-speedbar)
(semantic-ia-sb-tag-info):
* semantic/grammar.el (semantic-analyze-possible-completions):
* semantic/find.el (semantic-brute-find-tag-by-position):
- * semantic/ede-grammar.el (project-compile-target):
+ * semantic/ede-grammar.el (project-compile-target)
(ede-proj-makefile-insert-variables):
- * semantic/debug.el (semantic-debug-set-parser-location):
+ * semantic/debug.el (semantic-debug-set-parser-location)
(semantic-debug-set-source-location, semantic-debug-interface-layout)
(semantic-debug-mode, semantic-debug):
* semantic/db.el (semanticdb-needs-refresh-p):
@@ -2309,10 +2986,10 @@
* ede.el (ede-buffer-header-file, ede-find-target)
(ede-buffer-documentation-files, ede-project-buffers, ede-set)
(ede-target-buffers, ede-buffers, ede-make-project-local-variable):
- * cedet-idutils.el (cedet-idutils-fnid-call):
+ * cedet-idutils.el (cedet-idutils-fnid-call)
(cedet-idutils-lid-call, cedet-idutils-expand-filename)
(cedet-idutils-version-check):
- * cedet-global.el (cedet-gnu-global-call):
+ * cedet-global.el (cedet-gnu-global-call)
(cedet-gnu-global-expand-filename, cedet-gnu-global-root)
(cedet-gnu-global-version-check, cedet-gnu-global-scan-hits):
* cedet-cscope.el (cedet-cscope-call)
@@ -2540,8 +3217,6 @@
* srecode/srt-mode.el (srecode-template-mode): Doc fix.
- * files.el (auto-mode-alist): Add .srt and Project.ede.
-
* semantic.el (semantic-mode):
Handle srecode-template-mode-hook as well.
(semantic-mode): Use js-mode-hook for Javascript hook.
@@ -2785,7 +3460,7 @@
;; coding: utf-8
;; End:
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 1452535f294..94b7b077199 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -1,6 +1,6 @@
;;; cedet-cscope.el --- CScope support for CEDET
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Package: cedet
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 236040befb8..8e3901a609e 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -1,6 +1,6 @@
;;; cedet-files.el --- Common routines dealing with file names.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index 04861c5e58f..3ceed5d3b54 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -1,6 +1,6 @@
;;; cedet-global.el --- GNU Global support for CEDET.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Package: cedet
@@ -36,7 +36,7 @@
(defcustom cedet-global-gtags-command "gtags"
"Command name for the GNU Global gtags executable.
-GTAGS is used to create the tags table queried by the 'global' command."
+GTAGS is used to create the tags table queried by the `global' command."
:type 'string
:group 'cedet)
@@ -93,6 +93,13 @@ SCOPE is the scope of the search, such as 'project or 'subdirs."
(apply 'call-process cedet-global-gtags-command
nil b nil
flags)
+
+ ;; Check for warnings.
+ (with-current-buffer b
+ (goto-char (point-min))
+ (when (re-search-forward "Error\\|Warning\\|invalid" nil t)
+ (error "Output:\n%S" (buffer-string))))
+
b))
(defun cedet-gnu-global-expand-filename (filename)
@@ -179,10 +186,14 @@ If a database already exists, then just update it."
(let ((root (cedet-gnu-global-root dir)))
(if root (setq dir root))
(let ((default-directory dir))
- (cedet-gnu-global-gtags-call
- (when root
- '("-i");; Incremental update flag.
- )))))
+ (if root
+ ;; Incremental update. This can be either "gtags -i" or
+ ;; "global -u"; the gtags manpage says it's better to use
+ ;; "global -u".
+ (cedet-gnu-global-call (list "-u"))
+ (cedet-gnu-global-gtags-call nil)
+ )
+ )))
(provide 'cedet-global)
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index 49d22b6a0ab..65af51c26b0 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -1,6 +1,6 @@
;;; cedet-idutils.el --- ID Utils support for CEDET.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Old-Version: 0.2
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index f34442996c1..facd2bcaff7 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -1,6 +1,6 @@
;;; cedet.el --- Setup CEDET environment
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index c468ec1046a..300bd04600b 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -1,6 +1,6 @@
-;;; data-debug.el --- Datastructure Debugger
+;;; data-debug.el --- Data structure debugger
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Old-Version: 0.2
@@ -55,7 +55,7 @@
(defalias 'data-debug-overlay-p 'extentp)
(if (not (fboundp 'propertize))
(defun dd-propertize (string &rest properties)
- "Mimic 'propertize' in from Emacs 23."
+ "Mimic `propertize' in from Emacs 23."
(add-text-properties 0 (length string) properties string)
string
)
@@ -869,7 +869,8 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
table)
"Syntax table used in data-debug macro buffers.")
-(defvar data-debug-map
+(define-obsolete-variable-alias 'data-debug-map 'data-debug-mode-map "24.1")
+(defvar data-debug-mode-map
(let ((km (make-sparse-keymap)))
(suppress-keymap km)
(define-key km [mouse-2] 'data-debug-expand-or-contract-mouse)
@@ -887,22 +888,15 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
:group 'data-debug
:type 'hook)
-(defun data-debug-mode ()
+(define-derived-mode data-debug-mode fundamental-mode "DATA-DEBUG"
"Major-mode for the Analyzer debugger.
-\\{data-debug-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'data-debug-mode
- mode-name "DATA-DEBUG"
- comment-start ";;"
+\\{data-debug-mode-map}"
+ (setq comment-start ";;"
comment-end ""
buffer-read-only t)
- (set (make-local-variable 'comment-start-skip)
+ (setq-local comment-start-skip
"\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set-syntax-table data-debug-mode-syntax-table)
- (use-local-map data-debug-map)
- (run-hooks 'data-debug-hook)
(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 3483d541122..76ec3567c63 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1,6 +1,6 @@
;;; ede.el --- Emacs Development Environment gloss
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -40,13 +40,17 @@
;; (global-ede-mode t)
(require 'cedet)
+(require 'cl-lib)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/source)
(require 'ede/base)
(require 'ede/auto)
+(require 'ede/detect)
-(load "ede/loaddefs" nil 'nomessage)
+(eval-and-compile
+ (load "ede/loaddefs" nil 'nomessage))
(declare-function ede-commit-project "ede/custom")
(declare-function ede-convert-path "ede/files")
@@ -60,7 +64,7 @@
(declare-function ede-up-directory "ede/files")
(declare-function semantic-lex-make-spp-table "semantic/lex-spp")
-(defconst ede-version "1.2"
+(defconst ede-version "2.0"
"Current version of the Emacs EDE.")
;;; Code:
@@ -99,7 +103,7 @@ target willing to take the file. 'never means never perform the check."
If the value is t, EDE may search in any directory.
If the value is a function, EDE calls that function with one
-argument, the directory name; the function should return t iff
+argument, the directory name; the function should return t if
EDE should look for project files in the directory.
Otherwise, the value should be a list of fully-expanded directory
@@ -246,20 +250,20 @@ Argument LIST-O-O is the list of objects to choose from."
(let ((obj ede-object))
(if (consp obj)
(setq obj (car obj)))
- (and obj (obj-of-class-p obj ede-target))))
+ (and obj (obj-of-class-p obj 'ede-target))))
(defun ede-buffer-belongs-to-project-p ()
"Return non-nil if this buffer belongs to at least one project."
(if (or (null ede-object) (consp ede-object)) nil
- (obj-of-class-p ede-object-project ede-project)))
+ (obj-of-class-p ede-object-project 'ede-project)))
(defun ede-menu-obj-of-class-p (class)
"Return non-nil if some member of `ede-object' is a child of CLASS."
(if (listp ede-object)
- (eval (cons 'or (mapcar (lambda (o) (obj-of-class-p o class)) ede-object)))
+ (cl-some (lambda (o) (obj-of-class-p o class)) ede-object)
(obj-of-class-p ede-object class)))
-(defun ede-build-forms-menu (menu-def)
+(defun ede-build-forms-menu (_menu-def)
"Create a sub menu for building different parts of an EDE system.
Argument MENU-DEF is the menu definition to use."
(easy-menu-filter-return
@@ -279,7 +283,7 @@ Argument MENU-DEF is the menu definition to use."
;; First, collect the build items from the project
(setq newmenu (append newmenu (ede-menu-items-build obj t)))
;; Second, declare the current target menu items
- (if (and ede-obj (ede-menu-obj-of-class-p ede-target))
+ (if (and ede-obj (ede-menu-obj-of-class-p 'ede-target))
(while ede-obj
(setq newmenu (append newmenu
(ede-menu-items-build (car ede-obj) t))
@@ -303,7 +307,7 @@ Argument MENU-DEF is the menu definition to use."
(append newmenu (list [ "Make distribution" ede-make-dist t ]))
)))))
-(defun ede-target-forms-menu (menu-def)
+(defun ede-target-forms-menu (_menu-def)
"Create a target MENU-DEF based on the object belonging to this buffer."
(easy-menu-filter-return
(easy-menu-create-menu
@@ -324,7 +328,7 @@ Argument MENU-DEF is the menu definition to use."
;; This is bad, but I'm not sure what else to do.
(oref (car obj) menu)))))))))
-(defun ede-project-forms-menu (menu-def)
+(defun ede-project-forms-menu (_menu-def)
"Create a target MENU-DEF based on the object belonging to this buffer."
(easy-menu-filter-return
(easy-menu-create-menu
@@ -336,7 +340,7 @@ Argument MENU-DEF is the menu definition to use."
(progn
(while (and class (slot-exists-p class 'menu))
;;(message "Looking at class %S" class)
- (setq menu (append menu (oref class menu))
+ (setq menu (append menu (oref-default class menu))
class (eieio-class-parent class))
(if (listp class) (setq class (car class))))
(append
@@ -350,7 +354,7 @@ Argument MENU-DEF is the menu definition to use."
menu)
)))))
-(defun ede-configuration-forms-menu (menu-def)
+(defun ede-configuration-forms-menu (_menu-def)
"Create a submenu for selecting the default configuration for this project.
The current default is in the current object's CONFIGURATION-DEFAULT slot.
All possible configurations are in CONFIGURATIONS.
@@ -385,7 +389,7 @@ but can also be used interactively."
(eieio-object-name (ede-current-project))
newconfig))
-(defun ede-customize-forms-menu (menu-def)
+(defun ede-customize-forms-menu (_menu-def)
"Create a menu of the project, and targets that can be customized.
Argument MENU-DEF is the definition of the current menu."
(easy-menu-filter-return
@@ -408,7 +412,7 @@ Argument MENU-DEF is the definition of the current menu."
targ)))))))
-(defun ede-apply-object-keymap (&optional default)
+(defun ede-apply-object-keymap (&optional _default)
"Add target specific keybindings into the local map.
Optional argument DEFAULT indicates if this should be set to the default
version of the keymap."
@@ -416,19 +420,18 @@ version of the keymap."
(proj ede-object-project))
(condition-case nil
(let ((keys (ede-object-keybindings object)))
- ;; Add keys for the project to whatever is in the current object
- ;; so long as it isn't the same.
- (when (not (eq object proj))
- (setq keys (append keys (ede-object-keybindings proj))))
- (while keys
- (local-set-key (concat "\C-c." (car (car keys)))
- (cdr (car keys)))
- (setq keys (cdr keys))))
+ (dolist (key
+ ;; Add keys for the project to whatever is in the current
+ ;; object so long as it isn't the same.
+ (if (eq object proj)
+ keys
+ (append keys (ede-object-keybindings proj))))
+ (local-set-key (concat "\C-c." (car key)) (cdr key))))
(error nil))))
;;; Menu building methods for building
;;
-(defmethod ede-menu-items-build ((obj ede-project) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-project) &optional current)
"Return a list of menu items for building project OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
@@ -438,7 +441,7 @@ If optional argument CURRENT is non-nil, return sub-menu code."
(concat "Build Project " (ede-name obj))
`(project-compile-project ,obj))))))
-(defmethod ede-menu-items-build ((obj ede-target) &optional current)
+(cl-defmethod ede-menu-items-build ((obj ede-target) &optional current)
"Return a list of menu items for building target OBJ.
If optional argument CURRENT is non-nil, return sub-menu code."
(if current
@@ -450,8 +453,6 @@ If optional argument CURRENT is non-nil, return sub-menu code."
;;; Mode Declarations
;;
-(eval-and-compile
- (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t))
(defun ede-apply-target-options ()
"Apply options to the current buffer for the active project/target."
@@ -501,59 +502,63 @@ Sets buffer local variables for EDE."
;; Init the buffer.
(let* ((ROOT nil)
(proj (ede-directory-get-open-project default-directory
- 'ROOT))
- (projauto nil))
-
- (when (or proj ROOT
- ;; If there is no open project, look up the project
- ;; autoloader to see if we should initialize.
- (setq projauto (ede-directory-project-p default-directory t)))
-
- (when (and (not proj) projauto)
-
- ;; No project was loaded, but we have a project description
- ;; object. This means that we can check if it is a safe
- ;; project to load before requesting it to be loaded.
-
- (when (or (oref projauto safe-p)
- ;; The project style is not safe, so check if it is
- ;; in `ede-project-directories'.
- (let ((top (ede-toplevel-project default-directory)))
- (ede-directory-safe-p top)))
-
- ;; The project is safe, so load it in.
- (setq proj (ede-load-project-file default-directory 'ROOT))))
-
- ;; Only initialize EDE state in this buffer if we found a project.
- (when proj
-
- (setq ede-object (ede-buffer-object (current-buffer)
+ 'ROOT)))
+
+ (when (not proj)
+ ;; If there is no open project, look up the project
+ ;; autoloader to see if we should initialize.
+ (let ((projdetect (ede-directory-project-cons default-directory)))
+
+ (when projdetect
+ ;; No project was loaded, but we have a project description
+ ;; object. This means that we try to load it.
+ ;;
+ ;; Before loading, we need to check if it is a safe
+ ;; project to load before requesting it to be loaded.
+
+ (when (or (oref (cdr projdetect) safe-p)
+ ;; The project style is not safe, so check if it is
+ ;; in `ede-project-directories'.
+ (let ((top (car projdetect)))
+ (ede-directory-safe-p top)))
+
+ ;; The project is safe, so load it in.
+ (setq proj (ede-load-project-file default-directory projdetect 'ROOT))))))
+
+ ;; If PROJ is now loaded in, we can initialize our buffer to it.
+ (when proj
+
+ ;; ede-object represents the specific EDE related class that best
+ ;; represents this buffer. It could be a project (for a project file)
+ ;; or a target. Also save off ede-object-project, the project that
+ ;; the buffer belongs to for the case where ede-object is a target.
+ (setq ede-object (ede-buffer-object (current-buffer)
'ede-object-project))
- (setq ede-object-root-project
- (or ROOT (ede-project-root ede-object-project)))
+ ;; Every project has a root. It might be the same as ede-object.
+ ;; Cache that also as the root is a very common thing to need.
+ (setq ede-object-root-project
+ (or ROOT (ede-project-root ede-object-project)))
- (if (and (not ede-object) ede-object-project)
- (ede-auto-add-to-target))
+ ;; Check to see if we want to add this buffer to a target.
+ (if (and (not ede-object) ede-object-project)
+ (ede-auto-add-to-target))
- (ede-apply-target-options)))))
+ ;; Apply any options from the found target.
+ (ede-apply-target-options))))
(defun ede-reset-all-buffers ()
"Reset all the buffers due to change in EDE."
(interactive)
- (let ((b (buffer-list)))
- (while b
- (when (buffer-file-name (car b))
- (with-current-buffer (car b)
- ;; Reset all state variables
- (setq ede-object nil
- ede-object-project nil
- ede-object-root-project nil)
- ;; Now re-initialize this buffer.
- (ede-initialize-state-current-buffer)
- )
- )
- (setq b (cdr b)))))
+ (dolist (b (buffer-list))
+ (when (buffer-file-name b)
+ (with-current-buffer b
+ ;; Reset all state variables
+ (setq ede-object nil
+ ede-object-project nil
+ ede-object-root-project nil)
+ ;; Now re-initialize this buffer.
+ (ede-initialize-state-current-buffer)))))
;;;###autoload
(define-minor-mode global-ede-mode
@@ -617,13 +622,10 @@ of objects with the `ede-want-file-p' method."
(if (or (eq ede-auto-add-method 'never)
(ede-ignore-file (buffer-file-name)))
nil
- (let (wants desires)
- ;; Find all the objects.
- (setq wants (oref (ede-current-project) targets))
- (while wants
- (if (ede-want-file-p (car wants) (buffer-file-name))
- (setq desires (cons (car wants) desires)))
- (setq wants (cdr wants)))
+ (let (desires)
+ (dolist (want (oref (ede-current-project) targets));Find all the objects.
+ (if (ede-want-file-p want (buffer-file-name))
+ (push want desires)))
(if desires
(cond ((or (eq ede-auto-add-method 'ask)
(and (eq ede-auto-add-method 'multi-ask)
@@ -680,6 +682,7 @@ Otherwise, create a new project for DIR."
(if (ede-check-project-directory dir)
(progn
;; Load the project in DIR, or make one.
+ ;; @TODO - IS THIS REAL?
(ede-load-project-file dir)
;; Check if we loaded anything on the previous line.
@@ -701,11 +704,15 @@ Otherwise, create a new project for DIR."
(error "%s is not an allowed project directory in `ede-project-directories'"
dir)))
+(defvar ede-check-project-query-fcn 'y-or-n-p
+ "Function used to ask the user if they want to permit a project to load.
+This is abstracted out so that tests can answer this question.")
+
(defun ede-check-project-directory (dir)
"Check if DIR should be in `ede-project-directories'.
If it is not, try asking the user if it should be added; if so,
add it and save `ede-project-directories' via Customize.
-Return nil iff DIR should not be in `ede-project-directories'."
+Return nil if DIR should not be in `ede-project-directories'."
(setq dir (directory-file-name (expand-file-name dir))) ; strip trailing /
(or (eq ede-project-directories t)
(and (functionp ede-project-directories)
@@ -713,9 +720,11 @@ Return nil iff DIR should not be in `ede-project-directories'."
;; If `ede-project-directories' is a list, maybe add it.
(when (listp ede-project-directories)
(or (member dir ede-project-directories)
- (when (y-or-n-p (format "`%s' is not listed in `ede-project-directories'.
+ (when (funcall ede-check-project-query-fcn
+ (format-message
+ "`%s' is not listed in `ede-project-directories'.
Add it to the list of allowed project directories? "
- dir))
+ dir))
(push dir ede-project-directories)
;; If possible, save `ede-project-directories'.
(if (or custom-file user-init-file)
@@ -738,7 +747,7 @@ Optional argument NAME is the name to give this project."
(r nil))
(while l
(if cs
- (if (eq (oref (car l) :class-sym)
+ (if (eq (oref (car l) class-sym)
cs)
(setq r (cons (car l) r)))
(if (oref (car l) new-p)
@@ -748,7 +757,7 @@ Optional argument NAME is the name to give this project."
(if cs
(error "No valid interactive sub project types for %s"
cs)
- (error "EDE error: Can't fin project types to create")))
+ (error "EDE error: Can't find project types to create")))
r)
)
nil t)))
@@ -783,10 +792,12 @@ Optional argument NAME is the name to give this project."
(error
"Unknown file name specifier %S"
pf)))
- :targets nil)))
+ :targets nil)
+
+ ))
(inits (oref obj initializers)))
;; Force the name to match for new objects.
- (eieio-object-set-name-string nobj (oref nobj :name))
+ (eieio-object-set-name-string nobj (oref nobj name))
;; Handle init args.
(while inits
(eieio-oset nobj (car inits) (car (cdr inits)))
@@ -805,7 +816,7 @@ Optional argument NAME is the name to give this project."
;; Allert the user
(message "Project created and saved. You may now create targets."))
-(defmethod ede-add-subproject ((proj-a ede-project) proj-b)
+(cl-defmethod ede-add-subproject ((proj-a ede-project) proj-b)
"Add into PROJ-A, the subproject PROJ-B."
(oset proj-a subproj (cons proj-b (oref proj-a subproj))))
@@ -822,16 +833,17 @@ ARGS are additional arguments to pass to method SYM."
(defun ede-rescan-toplevel ()
"Rescan all project files."
(interactive)
- (if (not (ede-directory-get-open-project default-directory))
- ;; This directory isn't open. Can't rescan.
- (error "Attempt to rescan a project that isn't open")
+ (when (not (ede-toplevel))
+ ;; This directory isn't open. Can't rescan.
+ (error "Attempt to rescan a project that isn't open"))
- ;; Continue
- (let ((toppath (ede-toplevel-project default-directory))
- (ede-deep-rescan t))
+ ;; Continue
+ (let ((root (ede-toplevel))
+ (ede-deep-rescan t))
- (project-rescan (ede-load-project-file toppath))
- (ede-reset-all-buffers))))
+ (project-rescan root)
+ (ede-reset-all-buffers)
+ ))
(defun ede-new-target (&rest args)
"Create a new target specific to this type of project file.
@@ -839,7 +851,7 @@ Different projects accept different arguments ARGS.
Typically you can specify NAME, target TYPE, and AUTOADD, where AUTOADD is
a string \"y\" or \"n\", which answers the y/n question done interactively."
(interactive)
- (apply 'project-new-target (ede-current-project) args)
+ (apply #'project-new-target (ede-current-project) args)
(when (and buffer-file-name
(not (file-directory-p buffer-file-name)))
(setq ede-object nil)
@@ -919,6 +931,8 @@ Optional argument FORCE forces the file to be removed without asking."
(interactive)
(ede-invoke-method 'project-edit-file-target))
+;;; Compilation / Debug / Run
+;;
(defun ede-compile-project ()
"Compile the current project."
(interactive)
@@ -967,75 +981,75 @@ Optional argument FORCE forces the file to be removed without asking."
;; files should inherit from `ede-project'. Create the appropriate
;; methods based on those below.
-(defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project-placeholder) prompt)
; checkdoc-params: (prompt)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-interactive-select-target this prompt))
-(defmethod project-interactive-select-target ((this ede-project) prompt)
+(cl-defmethod project-interactive-select-target ((this ede-project) prompt)
"Interactively query for a target that exists in project THIS.
Argument PROMPT is the prompt to use when querying the user for a target."
(let ((ob (object-assoc-list 'name (oref this targets))))
(cdr (assoc (completing-read prompt ob nil t) ob))))
-(defmethod project-add-file ((this ede-project-placeholder) file)
+(cl-defmethod project-add-file ((this ede-project-placeholder) file)
; checkdoc-params: (file)
"Make sure placeholder THIS is replaced with the real thing, and pass through."
(project-add-file this file))
-(defmethod project-add-file ((ot ede-target) file)
+(cl-defmethod project-add-file ((ot ede-target) _file)
"Add the current buffer into project project target OT.
Argument FILE is the file to add."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-remove-file ((ot ede-target) fnnd)
+(cl-defmethod project-remove-file ((ot ede-target) _fnnd)
"Remove the current buffer from project target OT.
Argument FNND is an argument."
(error "remove-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-edit-file-target ((ot ede-target))
+(cl-defmethod project-edit-file-target ((_ot ede-target))
"Edit the target OT associated with this file."
(find-file (oref (ede-current-project) file)))
-(defmethod project-new-target ((proj ede-project) &rest args)
+(cl-defmethod project-new-target ((proj ede-project) &rest _args)
"Create a new target. It is up to the project PROJ to get the name."
(error "new-target not supported by %s" (eieio-object-name proj)))
-(defmethod project-new-target-custom ((proj ede-project))
+(cl-defmethod project-new-target-custom ((proj ede-project))
"Create a new target. It is up to the project PROJ to get the name."
(error "New-target-custom not supported by %s" (eieio-object-name proj)))
-(defmethod project-delete-target ((ot ede-target))
+(cl-defmethod project-delete-target ((ot ede-target))
"Delete the current target OT from its parent project."
(error "add-file not supported by %s" (eieio-object-name ot)))
-(defmethod project-compile-project ((obj ede-project) &optional command)
+(cl-defmethod project-compile-project ((obj ede-project) &optional _command)
"Compile the entire current project OBJ.
Argument COMMAND is the command to use when compiling."
(error "compile-project not supported by %s" (eieio-object-name obj)))
-(defmethod project-compile-target ((obj ede-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-target) &optional _command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(error "compile-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-debug-target ((obj ede-target))
+(cl-defmethod project-debug-target ((obj ede-target))
"Run the current project target OBJ in a debugger."
(error "debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-target))
+(cl-defmethod project-run-target ((obj ede-target))
"Run the current project target OBJ."
(error "run-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-make-dist ((this ede-project))
+(cl-defmethod project-make-dist ((this ede-project))
"Build a distribution for the project based on THIS project."
(error "Make-dist not supported by %s" (eieio-object-name this)))
-(defmethod project-dist-files ((this ede-project))
+(cl-defmethod project-dist-files ((this ede-project))
"Return a list of files that constitute a distribution of THIS project."
(error "Dist-files is not supported by %s" (eieio-object-name this)))
-(defmethod project-rescan ((this ede-project))
+(cl-defmethod project-rescan ((this ede-project))
"Rescan the EDE project THIS."
(error "Rescanning a project is not supported by %s" (eieio-object-name this)))
@@ -1059,94 +1073,102 @@ On success, return the added project."
(error "No project created to add to master list"))
(when (not (eieio-object-p proj))
(error "Attempt to add non-object to master project list"))
- (when (not (obj-of-class-p proj ede-project-placeholder))
+ (when (not (obj-of-class-p proj 'ede-project-placeholder))
(error "Attempt to add a non-project to the ede projects list"))
(add-to-list 'ede-projects proj)
proj)
+(defun ede-delete-project-from-global-list (proj)
+ "Remove project PROJ from the master list of projects."
+ (setq ede-projects (remove proj ede-projects)))
+
(defun ede-flush-deleted-projects ()
"Scan the projects list for projects which no longer exist.
Flush the dead projects from the project cache."
(interactive)
(let ((dead nil))
(dolist (P ede-projects)
- (when (not (file-exists-p (oref P :file)))
+ (when (not (file-exists-p (oref P file)))
(add-to-list 'dead P)))
(dolist (D dead)
- (setq ede-projects (remove D ede-projects)))
+ (ede-delete-project-from-global-list D))
))
-(defun ede-load-project-file (dir &optional rootreturn)
+(defvar ede--disable-inode) ;Defined in ede/files.el.
+
+(defun ede-global-list-sanity-check ()
+ "Perform a sanity check to make sure there are no duplicate projects."
+ (interactive)
+ (let ((scanned nil))
+ (dolist (P ede-projects)
+ (if (member (oref P directory) scanned)
+ (error "Duplicate project (by dir) found in %s!" (oref P directory))
+ (push (oref P directory) scanned)))
+ (unless ede--disable-inode
+ (setq scanned nil)
+ (dolist (P ede-projects)
+ (if (member (ede--project-inode P) scanned)
+ (error "Duplicate project (by inode) found in %s!" (ede--project-inode P))
+ (push (ede--project-inode P) scanned))))
+ (message "EDE by directory %sis still sane." (if ede--disable-inode "" "& inode "))))
+
+(defun ede-load-project-file (dir &optional detectin rootreturn)
"Project file independent way to read a project in from DIR.
+Optional DETECTIN is an autoload cons from `ede-detect-directory-for-project'
+which can be passed in to save time.
Optional ROOTRETURN will return the root project for DIR."
- ;; Only load if something new is going on. Flush the dirhash.
- (ede-project-directory-remove-hash dir)
- ;; Do the load
- ;;(message "EDE LOAD : %S" file)
- (let* ((file dir)
- (path (file-name-as-directory (expand-file-name dir)))
- (pfc (ede-directory-project-p path))
- (toppath nil)
- (o nil))
- (cond
- ((not pfc)
- ;; @TODO - Do we really need to scan? Is this a waste of time?
- ;; Scan upward for a the next project file style.
- (let ((p path))
- (while (and p (not (ede-directory-project-p p)))
- (setq p (ede-up-directory p)))
- (if p (ede-load-project-file p)
- nil)
- ;; recomment as we go
- ;;nil
- ))
- ;; Do nothing if we are building an EDE project already.
- (ede-constructing
- nil)
- ;; Load in the project in question.
- (t
- (setq toppath (ede-toplevel-project path))
- ;; We found the top-most directory. Check to see if we already
- ;; have an object defining its project.
- (setq pfc (ede-directory-project-p toppath t))
-
- ;; See if it's been loaded before
- (setq o (object-assoc (ede-dir-to-projectfile pfc toppath) 'file
- ede-projects))
-
- ;; If not open yet, load it.
- (unless o
- (let ((ede-constructing pfc))
- (setq o (ede-auto-load-project pfc toppath))))
-
- ;; Return the found root project.
- (when rootreturn (set rootreturn o))
-
- (let (tocheck found)
- ;; Now find the project file belonging to FILE!
- (setq tocheck (list o))
- (setq file (ede-dir-to-projectfile pfc (expand-file-name path)))
- (while (and tocheck (not found))
- (let ((newbits nil))
- (when (car tocheck)
- (if (string= file (oref (car tocheck) file))
- (setq found (car tocheck)))
- (setq newbits (oref (car tocheck) subproj)))
- (setq tocheck
- (append (cdr tocheck) newbits))))
- (if (not found)
- (message "No project for %s, but passes project-p test" file)
- ;; Now that the file has been reset inside the project object, do
- ;; the cache maintenance.
- (setq ede-project-cache-files
- (delete (oref found file) ede-project-cache-files)))
- found)))))
+ ;; Don't do anything if we are in the process of
+ ;; constructing an EDE object.
+ ;;
+ ;; Prevent recursion.
+ (unless ede-constructing
+
+ ;; Only load if something new is going on. Flush the dirhash.
+ (ede-project-directory-remove-hash dir)
+
+ ;; Do the load
+ ;;(message "EDE LOAD : %S" file)
+ (let* ((path (file-name-as-directory (expand-file-name dir)))
+ (detect (or detectin (ede-directory-project-cons path)))
+ (autoloader nil)
+ (toppath nil)
+ (o nil))
+
+ (when detect
+ (setq toppath (car detect))
+ (setq autoloader (cdr detect))
+
+ ;; See if it's been loaded before. Use exact matching since
+ ;; know that 'toppath' is the root of the project.
+ (setq o (ede-directory-get-toplevel-open-project toppath 'exact))
+
+ ;; If not open yet, load it.
+ (unless o
+ ;; NOTE: We set ede-constructing to the autoloader we are using.
+ ;; Some project types have one class, but many autoloaders
+ ;; and this is how we tell the instantiation which kind of
+ ;; project to make.
+ (let ((ede-constructing autoloader))
+
+ ;; This is the only place `ede-auto-load-project' should be called.
+
+ (setq o (ede-auto-load-project autoloader toppath))))
+
+ ;; Return the found root project.
+ (when rootreturn (set rootreturn o))
+
+ ;; The project has been found (in the global list) or loaded from
+ ;; disk (via autoloader.) We can now search for the project asked
+ ;; for from DIR in the sub-list.
+ (ede-find-subproject-for-directory o path)
+
+ ;; Return the project.
+ o))))
;;; PROJECT ASSOCIATIONS
;;
;; Moving between relative projects. Associating between buffers and
;; projects.
-
(defun ede-parent-project (&optional obj)
"Return the project belonging to the parent directory.
Return nil if there is no previous directory.
@@ -1220,7 +1242,7 @@ that contains the target that becomes buffer's object."
;; Return our findings.
ede-object))
-(defmethod ede-target-in-project-p ((proj ede-project) target)
+(cl-defmethod ede-target-in-project-p ((proj ede-project) target)
"Is PROJ the parent of TARGET?
If TARGET belongs to a subproject, return that project file."
(if (and (slot-boundp proj 'targets)
@@ -1245,7 +1267,7 @@ could become slow in time."
projs (cdr projs)))
ans)))
-(defmethod ede-find-target ((proj ede-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-project) buffer)
"Fetch the target in PROJ belonging to BUFFER or nil."
(with-current-buffer buffer
@@ -1267,16 +1289,16 @@ could become slow in time."
(setq targets (cdr targets)))
f)))))
-(defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
+(cl-defmethod ede-target-buffer-in-sourcelist ((this ede-target) buffer source)
"Return non-nil if object THIS is in BUFFER to a SOURCE list.
Handles complex path issues."
(member (ede-convert-path this (buffer-file-name buffer)) source))
-(defmethod ede-buffer-mine ((this ede-project) buffer)
+(cl-defmethod ede-buffer-mine ((_this ede-project) _buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
nil)
-(defmethod ede-buffer-mine ((this ede-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-target) buffer)
"Return non-nil if object THIS lays claim to the file in BUFFER."
(condition-case nil
(ede-target-buffer-in-sourcelist this buffer (oref this source))
@@ -1326,26 +1348,26 @@ This includes buffers controlled by a specific target of PROJECT."
"Execute PROC on all buffers controlled by EDE."
(mapcar proc (ede-buffers)))
-(defmethod ede-map-project-buffers ((this ede-project) proc)
+(cl-defmethod ede-map-project-buffers ((this ede-project) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-project-buffers this)))
-(defmethod ede-map-target-buffers ((this ede-target) proc)
+(cl-defmethod ede-map-target-buffers ((this ede-target) proc)
"For THIS, execute PROC on all buffers belonging to THIS."
(mapcar proc (ede-target-buffers this)))
;; other types of mapping
-(defmethod ede-map-subprojects ((this ede-project) proc)
+(cl-defmethod ede-map-subprojects ((this ede-project) proc)
"For object THIS, execute PROC on all direct subprojects.
This function does not apply PROC to sub-sub projects.
See also `ede-map-all-subprojects'."
(mapcar proc (oref this subproj)))
-(defmethod ede-map-all-subprojects ((this ede-project) allproc)
+(cl-defmethod ede-map-all-subprojects ((this ede-project) allproc)
"For object THIS, execute PROC on THIS and all subprojects.
This function also applies PROC to sub-sub projects.
See also `ede-map-subprojects'."
- (apply 'append
+ (apply #'append
(list (funcall allproc this))
(ede-map-subprojects
this
@@ -1355,14 +1377,14 @@ See also `ede-map-subprojects'."
;; (ede-map-all-subprojects (ede-load-project-file "../semantic/") (lambda (sp) (oref sp file)))
-(defmethod ede-map-targets ((this ede-project) proc)
+(cl-defmethod ede-map-targets ((this ede-project) proc)
"For object THIS, execute PROC on all targets."
(mapcar proc (oref this targets)))
-(defmethod ede-map-any-target-p ((this ede-project) proc)
+(cl-defmethod ede-map-any-target-p ((this ede-project) proc)
"For project THIS, map PROC to all targets and return if any non-nil.
Return the first non-nil value returned by PROC."
- (eval (cons 'or (ede-map-targets this proc))))
+ (cl-some proc (oref this targets)))
;;; Some language specific methods.
@@ -1371,15 +1393,15 @@ Return the first non-nil value returned by PROC."
;; configuring items for Semantic.
;; Generic paths
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((_this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-system-include-path ((this ede-target))
+(cl-defmethod ede-system-include-path ((_this ede-target))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-source-paths ((this ede-project) mode)
+(cl-defmethod ede-source-paths ((_this ede-project) _mode)
"Get the base to all source trees in the current project for MODE.
For example, <root>/src for sources of c/c++, Java, etc,
and <root>/doc for doc sources."
@@ -1407,20 +1429,20 @@ and <root>/doc for doc sources."
(message "Choosing preprocessor syms for project %s"
(eieio-object-name (car objs)))))))
-(defmethod ede-system-include-path ((this ede-project))
+(cl-defmethod ede-system-include-path ((_this ede-project))
"Get the system include path used by project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-project))
+(cl-defmethod ede-preprocessor-map ((_this ede-project))
"Get the pre-processor map for project THIS."
nil)
-(defmethod ede-preprocessor-map ((this ede-target))
+(cl-defmethod ede-preprocessor-map ((_this ede-target))
"Get the pre-processor map for project THIS."
nil)
;; Java
-(defmethod ede-java-classpath ((this ede-project))
+(cl-defmethod ede-java-classpath ((_this ede-project))
"Return the classpath for this project."
;; @TODO - Can JDEE add something here?
nil)
@@ -1433,8 +1455,7 @@ and <root>/doc for doc sources."
If VARIABLE is not project local, just use set. Optional argument PROJ
is the project to use, instead of `ede-current-project'."
(interactive "sVariable: \nxExpression: ")
- (let ((p (or proj (ede-toplevel)))
- a)
+ (let ((p (or proj (ede-toplevel))))
;; Make the change
(ede-make-project-local-variable variable p)
(ede-set-project-local-variable variable value p)
@@ -1476,7 +1497,7 @@ It does not apply the value to buffers."
(error "Cannot set project variable until it is added with `ede-make-project-local-variable'"))
(setcdr va value)))
-(defmethod ede-set-project-variables ((project ede-project) &optional buffer)
+(cl-defmethod ede-set-project-variables ((project ede-project) &optional buffer)
"Set variables local to PROJECT in BUFFER."
(if (not buffer) (setq buffer (current-buffer)))
(with-current-buffer buffer
@@ -1484,10 +1505,26 @@ It does not apply the value to buffers."
(make-local-variable (car v))
(set (car v) (cdr v)))))
-(defmethod ede-commit-local-variables ((proj ede-project))
+(cl-defmethod ede-commit-local-variables ((_proj ede-project))
"Commit change to local variables in PROJ."
nil)
+;;; Integration with project.el
+
+(defun project-try-ede (dir)
+ (let ((project-dir
+ (locate-dominating-file
+ dir
+ (lambda (dir)
+ (ede-directory-get-open-project dir 'ROOT)))))
+ (when project-dir
+ (ede-directory-get-open-project project-dir 'ROOT))))
+
+(cl-defmethod project-roots ((project ede-project))
+ (list (ede-project-root-directory project)))
+
+(add-hook 'project-find-functions #'project-try-ede)
+
(provide 'ede)
;; Include this last because it depends on ede.
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index c0baf0fc8f8..7c2a6b8dbf1 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -1,6 +1,6 @@
;;; ede/auto.el --- Autoload features for EDE
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -30,6 +30,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(declare-function ede-directory-safe-p "ede")
(declare-function ede-add-project-to-global-list "ede")
@@ -47,8 +48,13 @@
:initform nil
:documentation
"An index into the match-data of `configregex'.")
- (configdatastash :initform nil
- :documentation
+ (subdir-only :initarg :subdir-only
+ :initform t
+ :documentation
+ "Non-nil means an exact match to the found directory is a non-match.
+This implies projects exist only in subdirectories of the configuration path.
+If `:subdir-only' is nil, then the directory from the configuration file is the project.")
+ (configdatastash :documentation
"Save discovered match string.")
)
"Support complex matches for projects that live in named directories.
@@ -57,7 +63,7 @@ location is varied dependent on other complex criteria, this class
can be used to define that match without loading the specific project
into memory.")
-(defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
+(cl-defmethod ede-dirmatch-installed ((dirmatch ede-project-autoload-dirmatch))
"Return non-nil if the tool DIRMATCH might match is installed on the system."
(let ((fc (oref dirmatch fromconfig)))
@@ -72,7 +78,7 @@ into memory.")
(t (error "Unknown dirmatch type.")))))
-(defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
+(cl-defmethod ede-do-dirmatch ((dirmatch ede-project-autoload-dirmatch) file)
"Does DIRMATCH match the filename FILE."
(let ((fc (oref dirmatch fromconfig)))
@@ -80,8 +86,11 @@ into memory.")
;; If the thing to match is stored in a config file.
((stringp fc)
(when (file-exists-p fc)
- (let ((matchstring (oref dirmatch configdatastash)))
- (unless matchstring
+ (let ((matchstring
+ (if (slot-boundp dirmatch 'configdatastash)
+ (oref dirmatch configdatastash)
+ nil)))
+ (when (and (not matchstring) (not (slot-boundp dirmatch 'configdatastash)))
(save-current-buffer
(let* ((buff (get-file-buffer fc))
(readbuff
@@ -94,10 +103,25 @@ into memory.")
(setq matchstring
(match-string (or (oref dirmatch configregexidx) 0)))))
(if (not buff) (kill-buffer readbuff))))
- ;; Save what we find in our cache.
- (oset dirmatch configdatastash matchstring))
+ (when matchstring
+ ;; If this dirmatch only finds subdirs of matchstring, then
+ ;; force matchstring to be a directory.
+ (when (oref dirmatch subdir-only)
+ (setq matchstring (file-name-as-directory matchstring)))
+ ;; Convert matchstring to a regexp
+ (setq matchstring (concat "^" (regexp-quote matchstring)))
+ ;; Stash it for later.
+ (oset dirmatch configdatastash matchstring))
+ ;; Debug
+ ;;(message "Stashing config data for dirmatch %S as %S" (eieio-object-name dirmatch) matchstring)
+ )
+ ;;(message "dirmatch %s against %s" matchstring (expand-file-name file))
;; Match against our discovered string
- (and matchstring (string-match (regexp-quote matchstring) file))
+ (setq file (file-name-as-directory (expand-file-name file)))
+ (and matchstring (string-match matchstring (expand-file-name file))
+ (or (not (oref dirmatch subdir-only))
+ (not (= (match-end 0) (length file))))
+ )
)))
;; Add new matches here
@@ -119,13 +143,21 @@ into memory.")
:documentation "The lisp file belonging to this class.")
(proj-file :initarg :proj-file
:documentation "Name of a project file of this type.")
+ (root-only :initarg :root-only
+ :initform t ;; Default - majority case.
+ :documentation
+ "Non-nil if project detection only finds proj-file @ project root.")
(proj-root-dirmatch :initarg :proj-root-dirmatch
- :initform ""
- :type (or string ede-project-autoload-dirmatch)
+ :initform nil
+ :type (or null string ede-project-autoload-dirmatch)
:documentation
"To avoid loading a project, check if the directory matches this.
-For projects that use directory name matches, a function would load that project.
-Specifying this matcher will allow EDE to check without loading the project.")
+Specifying this matcher object will allow EDE to perform a complex
+check without loading the project.
+
+NOTE: If you use dirmatch, you may need to set :root-only to nil.
+While it may be a root based project, all subdirs will happen to return
+true for the dirmatch, so for scanning purposes, set it to nil.")
(proj-root :initarg :proj-root
:type function
:documentation "A function symbol to call for the project root.
@@ -165,22 +197,22 @@ type is required and the load function used.")
(defvar ede-project-class-files
(list
- (ede-project-autoload "edeproject-makefile"
- :name "Make" :file 'ede/proj
+ (ede-project-autoload :name "Make" :file 'ede/proj
:proj-file "Project.ede"
+ :root-only nil
:load-type 'ede-proj-load
:class-sym 'ede-proj-project
:safe-p nil)
- (ede-project-autoload "edeproject-automake"
- :name "Automake" :file 'ede/proj
+ (ede-project-autoload :name "Automake" :file 'ede/proj
:proj-file "Project.ede"
+ :root-only nil
:initializers '(:makefile-type Makefile.am)
:load-type 'ede-proj-load
:class-sym 'ede-proj-project
:safe-p nil)
- (ede-project-autoload "automake"
- :name "automake" :file 'ede/project-am
+ (ede-project-autoload :name "automake" :file 'ede/project-am
:proj-file "Makefile.am"
+ :root-only nil
:load-type 'project-am-load
:class-sym 'project-am-makefile
:new-p nil
@@ -190,17 +222,30 @@ type is required and the load function used.")
(put 'ede-project-class-files 'risky-local-variable t)
+(defun ede-show-supported-projects ()
+ "Display all the project types registered with EDE."
+ (interactive)
+ (let ((b (get-buffer-create "*EDE Autodetect Projects*")))
+ (set-buffer b)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (dolist (prj ede-project-class-files)
+ (insert (oref prj name))
+ (newline))
+ (display-buffer b)
+ ))
+
(defun ede-add-project-autoload (projauto &optional flag)
"Add PROJAUTO, an EDE autoload definition to `ede-project-class-files'.
Optional argument FLAG indicates how this autoload should be
added. Possible values are:
- 'generic - A generic project type. Keep this at the very end.
- 'unique - A unique project type for a specific project. Keep at the very
- front of the list so more generic projects don't get priority."
+ `generic' - A generic project type. Keep this at the very end.
+ `unique' - A unique project type for a specific project. Keep at the very
+ front of the list so more generic projects don't get priority."
;; First, can we identify PROJAUTO as already in the list? If so, replace.
(let ((projlist ede-project-class-files)
- (projname (eieio-object-name-string projauto)))
- (while (and projlist (not (string= (eieio-object-name-string (car projlist)) projname)))
+ (projname (oref projauto name)))
+ (while (and projlist (not (string= (oref (car projlist) name) projname)))
(setq projlist (cdr projlist)))
(if projlist
@@ -233,106 +278,62 @@ added. Possible values are:
;; Splice into the list.
(setcdr prev (cons projauto next))))))))
-;;; EDE project-autoload methods
+;;; Project Autoload Methods
;;
-(defmethod ede-project-root ((this ede-project-autoload))
- "If a project knows its root, return it here.
-Allows for one-project-object-for-a-tree type systems."
- nil)
-
-(defun ede-project-dirmatch-p (file dirmatch)
- "Return non-nil if FILE matches DIRMATCH.
-DIRMATCH could be nil (no match), a string (regexp match),
-or an `ede-project-autoload-dirmatch' object."
- ;; If dirmatch is a string, then we simply match it against
- ;; the file we are testing.
- (if (stringp dirmatch)
- (string-match dirmatch file)
- ;; if dirmatch is instead a dirmatch object, we test against
- ;; that object instead.
- (if (ede-project-autoload-dirmatch-p dirmatch)
- (ede-do-dirmatch dirmatch file)
- (error "Unknown project directory match type."))
- ))
-(defmethod ede-project-root-directory ((this ede-project-autoload)
- &optional file)
- "If a project knows its root, return it here.
-Allows for one-project-object-for-a-tree type systems.
-Optional FILE is the file to test. If there is no FILE, use
-the current buffer."
- (when (not file)
- (setq file default-directory))
- (when (slot-boundp this :proj-root)
- (let ((dirmatch (oref this proj-root-dirmatch))
- (rootfcn (oref this proj-root))
- (callfcn t))
- (when rootfcn
- (if ;; If the dirmatch (an object) is not installed, then we
- ;; always skip doing a match.
- (and (ede-project-autoload-dirmatch-p dirmatch)
- (not (ede-dirmatch-installed dirmatch)))
- (setq callfcn nil)
- ;; Other types of dirmatch:
- (when (and
- ;; If the Emacs Lisp file handling this project hasn't
- ;; been loaded, we will use the quick dirmatch feature.
- (not (featurep (oref this file)))
- ;; If the dirmatch is an empty string, then we always
- ;; skip doing a match.
- (not (and (stringp dirmatch) (string= dirmatch "")))
- )
- ;; If this file DOES NOT match dirmatch, we set the callfcn
- ;; to nil, meaning don't load the ede support file for this
- ;; type of project. If it does match, we will load the file
- ;; and use a more accurate programmatic match from there.
- (unless (ede-project-dirmatch-p file dirmatch)
- (setq callfcn nil))))
- ;; Call into the project support file for a match.
- (when callfcn
- (condition-case nil
- (funcall rootfcn file)
- (error
- (funcall rootfcn))))
- ))))
-
-(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir)
- "Return a full file name of project THIS found in DIR.
-Return nil if the project file does not exist."
+;; New method using detect.el
+(cl-defmethod ede-auto-detect-in-dir ((this ede-project-autoload) dir)
+ "Return non-nil if THIS project autoload is found in DIR."
(let* ((d (file-name-as-directory dir))
- (root (ede-project-root-directory this d))
(pf (oref this proj-file))
- (dm (oref this proj-root-dirmatch))
- (f (cond ((stringp pf)
- (expand-file-name pf (or root d)))
- ((and (symbolp pf) (fboundp pf))
- ;; If there is a symbol to call, lets make extra
- ;; sure we really can call it without loading in
- ;; other EDE projects. This happens if the file is
- ;; already loaded, or if there is a dirmatch, but
- ;; root is empty.
- (when (and (featurep (oref this file))
- (or (not (stringp dm))
- (not (string= dm "")))
- root)
- (funcall pf (or root d))))))
- )
- (when (and f (file-exists-p f))
- f)))
-
-(defmethod ede-auto-load-project ((this ede-project-autoload) dir)
+ (f (when (stringp pf) (expand-file-name pf d))))
+ (if f
+ (and f (file-exists-p f))
+ (let ((dirmatch (oref this proj-root-dirmatch)))
+ (cond
+ ((stringp dirmatch)
+ nil) ; <- do something here - maybe obsolete the option?
+ ((ede-project-autoload-dirmatch-p dirmatch)
+ (if (and dirmatch (ede-dirmatch-installed dirmatch))
+ (ede-do-dirmatch dirmatch dir)
+ ;(message "Dirmatch %S not installed." dirmatch)
+ )))))))
+
+(cl-defmethod ede-auto-load-project ((this ede-project-autoload) dir)
"Load in the project associated with THIS project autoload description.
THIS project description should be valid for DIR, where the project will
-be loaded."
+be loaded.
+
+NOTE: Do not call this - it should only be called from `ede-load-project-file'."
;; Last line of defense: don't load unsafe projects.
- (when (not (or (oref this :safe-p)
+ (when (not (or (oref this safe-p)
(ede-directory-safe-p dir)))
(error "Attempt to load an unsafe project (bug elsewhere in EDE)"))
;; Things are good - so load the project.
(let ((o (funcall (oref this load-type) dir)))
(when (not o)
(error "Project type error: :load-type failed to create a project"))
- (ede-add-project-to-global-list o)))
+ (ede-add-project-to-global-list o)
+ ;; @TODO - Add to hash over at `ede-inode-directory-hash'.
+ ))
+
+
+
+
+
+
+;;; -------- Old Methods
+;; See if we can do without them.
+
+;; @FIXME - delete from loaddefs to remove this.
+(cl-defmethod ede-project-root ((this ede-project-autoload))
+ "If a project knows its root, return it here.
+Allows for one-project-object-for-a-tree type systems."
+ nil)
+
+;; @FIXME - delete from loaddefs to remove this.
+(cl-defmethod ede-project-root-directory ((this ede-project-autoload) &optional file)
+ "" nil)
(provide 'ede/auto)
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index 77e5f777866..687b8a0f5ad 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -1,6 +1,6 @@
;;; ede/autoconf-edit.el --- Keymap for autoconf
-;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project
@@ -60,6 +60,7 @@ configure the initial configure script using `autoconf-new-automake-string'"
(defvar autoconf-preferred-macro-order
'("AC_INIT"
+ "AC_CONFIG_SRCDIR"
"AM_INIT_AUTOMAKE"
"AM_CONFIG_HEADER"
;; Arg parsing
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index a94ce8f1868..f49cb5bdb16 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -1,6 +1,6 @@
;;; ede/base.el --- Baseclasses for EDE.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -27,6 +27,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-speedbar)
(require 'ede/auto)
@@ -104,7 +105,7 @@ which files this object is interested in."
:accessor ede-object-menu)
)
"A target is a structure that describes a file set that produces something.
-Targets, as with 'Make', is an entity that will manage a file set
+Targets, as with `Make', is an entity that will manage a file set
and knows how to compile or otherwise transform those files into some
other desired outcome.")
@@ -159,6 +160,9 @@ and querying them will cause the actual project to get loaded.")
;; Projects can also affect how EDE works, by changing what appears in
;; the EDE menu, or how some keys are bound.
;;
+(unless (fboundp 'ede-target-list-p)
+ (cl-deftype ede-target-list () '(list-of ede-target)))
+
(defclass ede-project (ede-project-placeholder)
((subproj :initform nil
:type list
@@ -287,16 +291,18 @@ All specific project types must derive from this project."
;;
(defmacro ede-with-projectfile (obj &rest forms)
"For the project in which OBJ resides, execute FORMS."
- `(save-window-excursion
- (let* ((pf (if (obj-of-class-p ,obj ede-target)
- (ede-target-parent ,obj)
- ,obj))
- (dbka (get-file-buffer (oref pf file))))
- (if (not dbka) (find-file (oref pf file))
- (switch-to-buffer dbka))
+ (declare (indent 1))
+ (unless (symbolp obj)
+ (message "Beware! ede-with-projectfile's first arg is copied: %S" obj))
+ `(let* ((pf (if (obj-of-class-p ,obj 'ede-target)
+ (ede-target-parent ,obj)
+ ,obj))
+ (dbka (get-file-buffer (oref pf file))))
+ (with-current-buffer
+ (if (not dbka) (find-file-noselect (oref pf file))
+ dbka)
,@forms
(if (not dbka) (kill-buffer (current-buffer))))))
-(put 'ede-with-projectfile 'lisp-indent-function 1)
;;; The EDE persistent cache.
;;
@@ -397,7 +403,7 @@ If set to nil, then the cache is not saved."
;;
;; Mode related methods are in ede.el. These methods are related
;; project specific activities not directly tied to a keybinding.
-(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
+(cl-defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in)
"Get a path name for PROJ which is relative to the parent project.
If PARENT is specified, then be relative to the PARENT project.
Specifying PARENT is useful for sub-sub projects relative to the root project."
@@ -407,7 +413,7 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
(file-relative-name dir (file-name-directory (oref parent file)))
"")))
-(defmethod ede-subproject-p ((proj ede-project))
+(cl-defmethod ede-subproject-p ((proj ede-project))
"Return non-nil if PROJ is a sub project."
;; @TODO - Use this in more places, and also pay attention to
;; metasubproject in ede/proj.el
@@ -420,26 +426,26 @@ Specifying PARENT is useful for sub-sub projects relative to the root project."
;; no need to in most situations because they are either a) simple, or
;; b) cosmetic.
-(defmethod ede-name ((this ede-target))
+(cl-defmethod ede-name ((this ede-target))
"Return the name of THIS target."
(oref this name))
-(defmethod ede-target-name ((this ede-target))
+(cl-defmethod ede-target-name ((this ede-target))
"Return the name of THIS target, suitable for make or debug style commands."
(oref this name))
-(defmethod ede-name ((this ede-project))
+(cl-defmethod ede-name ((this ede-project))
"Return a short-name for THIS project file.
Do this by extracting the lowest directory name."
(oref this name))
-(defmethod ede-description ((this ede-project))
+(cl-defmethod ede-description ((this ede-project))
"Return a description suitable for the minibuffer about THIS."
(format "Project %s: %d subprojects, %d targets."
(ede-name this) (length (oref this subproj))
(length (oref this targets))))
-(defmethod ede-description ((this ede-target))
+(cl-defmethod ede-description ((this ede-target))
"Return a description suitable for the minibuffer about THIS."
(format "Target %s: with %d source files."
(ede-name this) (length (oref this source))))
@@ -458,11 +464,11 @@ Not all buffers need headers, so return nil if no applicable."
(ede-buffer-header-file ede-object (current-buffer))
nil))
-(defmethod ede-buffer-header-file ((this ede-project) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-project) buffer)
"Return nil, projects don't have header files."
nil)
-(defmethod ede-buffer-header-file ((this ede-target) buffer)
+(cl-defmethod ede-buffer-header-file ((this ede-target) buffer)
"There are no default header files in EDE.
Do a quick check to see if there is a Header tag in this buffer."
(with-current-buffer buffer
@@ -484,12 +490,12 @@ Some projects may have multiple documentation files, so return a list."
(ede-buffer-documentation-files ede-object (current-buffer))
nil))
-(defmethod ede-buffer-documentation-files ((this ede-project) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-project) buffer)
"Return all documentation in project THIS based on BUFFER."
;; Find the info node.
(ede-documentation this))
-(defmethod ede-buffer-documentation-files ((this ede-target) buffer)
+(cl-defmethod ede-buffer-documentation-files ((this ede-target) buffer)
"Check for some documentation files for THIS.
Also do a quick check to see if there is a Documentation tag in this BUFFER."
(with-current-buffer buffer
@@ -500,7 +506,7 @@ Also do a quick check to see if there is a Documentation tag in this BUFFER."
(let ((cp (ede-toplevel)))
(ede-buffer-documentation-files cp (current-buffer))))))
-(defmethod ede-documentation ((this ede-project))
+(cl-defmethod ede-documentation ((this ede-project))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -515,7 +521,7 @@ files in the project."
proj (cdr proj)))
found))
-(defmethod ede-documentation ((this ede-target))
+(cl-defmethod ede-documentation ((this ede-target))
"Return a list of files that provide documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -526,7 +532,7 @@ files in the project."
(ede-html-documentation (ede-toplevel))
)
-(defmethod ede-html-documentation ((this ede-project))
+(cl-defmethod ede-html-documentation ((this ede-project))
"Return a list of HTML files provided by project THIS."
)
@@ -536,7 +542,7 @@ files in the project."
;; These methods are used to determine if a target "wants", or could
;; somehow handle a file, or some source type.
;;
-(defmethod ede-want-file-p ((this ede-target) file)
+(cl-defmethod ede-want-file-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -544,7 +550,7 @@ files in the project."
(setq src (cdr src)))
src))
-(defmethod ede-want-file-source-p ((this ede-target) file)
+(cl-defmethod ede-want-file-source-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -552,7 +558,7 @@ files in the project."
(setq src (cdr src)))
src))
-(defmethod ede-target-sourcecode ((this ede-target))
+(cl-defmethod ede-target-sourcecode ((this ede-target))
"Return the sourcecode objects which THIS permits."
(let ((sc (oref this sourcetype))
(rs nil))
@@ -605,7 +611,7 @@ Display the results as a debug list."
"Return the ede project which is the root of the current project.
Optional argument SUBPROJ indicates a subproject to start from
instead of the current project."
- (or ede-object-root-project
+ (or (when (not subproj) ede-object-root-project)
(let* ((cp (or subproj (ede-current-project))))
(or (and cp (ede-project-root cp))
(progn
@@ -620,7 +626,7 @@ instead of the current project."
(defun ede-normalize-file/directory (this project-file-name)
"Fills :directory or :file slots if they're missing in project THIS.
The other slot will be used to calculate values.
-PROJECT-FILE-NAME is a name of project file (short name, like 'pom.xml', etc."
+PROJECT-FILE-NAME is a name of project file (short name, like `pom.xml', etc."
(when (and (or (not (slot-boundp this :file))
(not (oref this :file)))
(slot-boundp this :directory)
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
new file mode 100644
index 00000000000..f5578a21883
--- /dev/null
+++ b/lisp/cedet/ede/config.el
@@ -0,0 +1,424 @@
+;;; ede/config.el --- Configuration Handler baseclass
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Eric Ludlam <eric@siege-engine.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Some auto-detecting projects (such as the 'generic' project type)
+;; can be enhanced by also saving a configuration file that is EDE
+;; specific. EDE will be able to load that configuration from the save
+;; file as a way of augmenting what is normally already detected.
+;;
+;; How To Use:
+;;
+;; Subclass `ede-extra-config', and add the features you want to use.
+;; Several mixins are available for adding in C++ or Java support. Bring
+;; in the pieces you need.
+;;
+;; Your project and targets should all have a common baseclass from
+;; `ede-project-with-config' or `ede-target-with-config'. When
+;; subclassing the project, be sure to override the class allocated
+;; slots for the `config-class'. This will tie your new project to
+;; the new configuration type.
+;;
+;; You can also override the file name used to save the configuration
+;; object in.
+;;
+;; If you need to take special action in `project-rescan' be sure to also
+;; call `call-next-method' to also get the configuration rescanned.
+;;
+;; Note on config file safety:
+;;
+;; Normally an EDE project that loads a save file should have it's
+;; autoload slot :safe-p set to nil. Projects who save data via
+;; config.el can mark their project as :safe-p t. The config system will
+;; do the queries needed to protect the user. This allows a generic
+;; project to become active in cases where no save file exists, nor is
+;; needed.
+
+;;; Code:
+(require 'ede)
+
+;;; CONFIG
+;;
+;; This is the base of a configuration class supported by the
+;; `ede-project-with-config' baseclass.
+;;
+(defclass ede-extra-config (eieio-persistent)
+ ((extension :initform ".ede")
+ (file-header-line :initform ";; EDE Project Configuration")
+ (project :type ede-project-with-config-child
+ :documentation
+ "The project this config is bound to.")
+ (ignored-file :initform nil
+ :type (or null symbol)
+ :documentation
+ "Set to non-nil if this was created and an on-disk file
+was ignored. Use this to warn the user that they might want to load in
+an on-disk version.")
+ )
+ "Baseclass for auxiliary configuration files for EDE.
+This should be subclassed by projects that auto detect a project
+and also want to save some extra level of configuration.")
+
+;;; PROJECT BASECLASS
+;;
+;; Subclass this baseclass if you want your EDE project to also
+;; support saving an extra configuration file of unique data
+;; needed for this project.
+;;
+(defclass ede-project-with-config (ede-project)
+ ((menu :initform nil)
+ (config-file-basename
+ :initform "Config.ede"
+ :allocation :class
+ :type string
+ :documentation
+ "The filename to use for saving the configuration.
+This filename excludes the directory name and is used to
+initialize the :file slot of the persistent baseclass.")
+ (config-class
+ :initform ede-extra-config
+ :allocation :class
+ :type class
+ :documentation
+ "The class of the configuration used by this project.")
+ (config :initform nil
+ :type (or null ede-extra-config-child)
+ :documentation
+ "The configuration object for this project.")
+ )
+ "Baseclass for projects that save a configuration.")
+
+(defclass ede-target-with-config (ede-target)
+ ()
+ "Baseclass for targets of classes that use a config object.")
+
+;;; Rescanning
+
+(cl-defmethod project-rescan ((this ede-project-with-config))
+ "Rescan this generic project from the sources."
+ ;; Force the config to be rescanned.
+ (oset this config nil)
+ ;; Ask if it is safe to load the config from disk.
+ (ede-config-get-configuration this t)
+ )
+
+;;; Project Methods for configuration
+
+(cl-defmethod ede-config-get-configuration ((proj ede-project-with-config) &optional loadask)
+ "Return the configuration for the project PROJ.
+If optional LOADASK is non-nil, then if a project file exists, and if
+the directory isn't on the `safe' list, ask to add it to the safe list."
+ (let ((config (oref proj config)))
+
+ ;; If the request is coming at a time when we want to ask the user,
+ ;; and there already is a configuration, AND the last time we ignored
+ ;; the on-file version we did so automatically (without asking) then
+ ;; in theory there are NO mods to this config, and we should re-ask,
+ ;; and possibly re-load.
+ (when (and loadask config (eq (oref config ignored-file) 'auto))
+ (setq config nil))
+
+ (when (not config)
+ (let* ((top (oref proj :directory))
+ (fname (expand-file-name (oref proj config-file-basename) top))
+ (class (oref proj config-class))
+ (ignore-type nil))
+ (if (and (file-exists-p fname)
+ (or (ede-directory-safe-p top)
+ ;; Only force the load if someone asked.
+ (and loadask (ede-check-project-directory top))))
+ ;; Load in the configuration
+ (setq config (eieio-persistent-read fname class))
+ ;; If someone said not to load stuff from here then
+ ;; pop up a warning.
+ (when (file-exists-p fname)
+ (message "Ignoring EDE config file for now and creating a new one. Use C-c . g to load it.")
+ ;; Set how it was ignored.
+ (if loadask
+ (setq ignore-type 'manual)
+ (setq ignore-type 'auto))
+ )
+ ;; Create a new one.
+ (setq config (make-instance class
+ "Configuration"
+ :file fname))
+ (oset config ignored-file ignore-type)
+
+ ;; Set initial values based on project.
+ (ede-config-setup-configuration proj config))
+ ;; Link things together.
+ (oset proj config config)
+ (oset config project proj)))
+ config))
+
+(cl-defmethod ede-config-setup-configuration ((proj ede-project-with-config) config)
+ "Default configuration setup method."
+ nil)
+
+(cl-defmethod ede-commit-project ((proj ede-project-with-config))
+ "Commit any change to PROJ to its file."
+ (let ((config (ede-config-get-configuration proj)))
+ (ede-commit config)))
+
+;;; Customization
+;;
+(cl-defmethod ede-customize ((proj ede-project-with-config))
+ "Customize the EDE project PROJ by actually configuring the config object."
+ (let ((config (ede-config-get-configuration proj t)))
+ (eieio-customize-object config)))
+
+(cl-defmethod ede-customize ((target ede-target-with-config))
+ "Customize the EDE TARGET by actually configuring the config object."
+ ;; Nothing unique for the targets, use the project.
+ (ede-customize-project))
+
+(cl-defmethod eieio-done-customizing ((config ede-extra-config))
+ "Called when EIEIO is done customizing the configuration object.
+We need to go back through the old buffers, and update them with
+the new configuration."
+ (ede-commit config)
+ ;; Loop over all the open buffers, and re-apply.
+ (ede-map-targets
+ (oref config project)
+ (lambda (target)
+ (ede-map-target-buffers
+ target
+ (lambda (b)
+ (with-current-buffer b
+ (ede-apply-target-options)))))))
+
+(cl-defmethod ede-commit ((config ede-extra-config))
+ "Commit all changes to the configuration to disk."
+ ;; So long as the user is trying to safe this config, make sure they can
+ ;; get at it again later.
+ (let ((dir (file-name-directory (oref config file))))
+ (ede-check-project-directory dir))
+
+ (eieio-persistent-save config))
+
+;;; PROJECT MIXINS
+;;
+;; These are project part mixins. Use multiple inheritance for each
+;; piece of these configuration options you would like to have as part
+;; of your project.
+
+;;; PROGRAM
+;; If there is a program that can be run or debugged that is unknown
+;; and needs to be configured.
+(defclass ede-extra-config-program ()
+ ((debug-command :initarg :debug-command
+ :initform "gdb "
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used for debugging this project.")
+ (run-command :initarg :run-command
+ :initform ""
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used to run something related to this project."))
+ "Class to mix into a configuration for debug/run of programs.")
+
+(defclass ede-project-with-config-program ()
+ ()
+ "Class to mix into a project with configuration for programs.")
+
+(defclass ede-target-with-config-program ()
+ ()
+ "Class to mix into a project with configuration for programs.
+This class brings in method overloads for running and debugging
+programs from a project.")
+
+(cl-defmethod project-debug-target ((target ede-target-with-config-program))
+ "Run the current project derived from TARGET in a debugger."
+ (let* ((proj (ede-target-parent target))
+ (config (ede-config-get-configuration proj t))
+ (debug (oref config :debug-command))
+ (cmd (read-from-minibuffer
+ "Debug Command: "
+ debug))
+ (cmdsplit (split-string cmd " " t))
+ ;; @TODO - this depends on the user always typing in something good
+ ;; like "gdb" or "dbx" which also exists as a useful Emacs command.
+ ;; Is there a better way?
+ (cmdsym (intern-soft (car cmdsplit))))
+ (call-interactively cmdsym t)))
+
+(declare-function ede-shell-run-something "ede/shell")
+
+(cl-defmethod project-run-target ((target ede-target-with-config-program))
+ "Run the current project derived from TARGET."
+ (let* ((proj (ede-target-parent target))
+ (config (ede-config-get-configuration proj t))
+ (run (concat "./" (oref config :run-command)))
+ (cmd (read-from-minibuffer "Run (like this): " run)))
+ (ede-shell-run-something target cmd)))
+
+;;; BUILD
+;; If the build style is unknown and needs to be configured.
+(defclass ede-extra-config-build ()
+ ((build-command :initarg :build-command
+ :initform "make -k"
+ :type string
+ :group commands
+ :custom string
+ :group (default build)
+ :documentation
+ "Command used for building this project."))
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-build ()
+ ()
+ "Class to mix into a project with configuration for builds.
+This class brings in method overloads for building.")
+
+(defclass ede-target-with-config-build ()
+ ()
+ "Class to mix into a project with configuration for builds.
+This class brings in method overloads for for building.")
+
+(cl-defmethod project-compile-project ((proj ede-project-with-config-build) &optional command)
+ "Compile the entire current project PROJ.
+Argument COMMAND is the command to use when compiling."
+ (let* ((config (ede-config-get-configuration proj t))
+ (comp (oref config :build-command)))
+ (compile comp)))
+
+(cl-defmethod project-compile-target ((obj ede-target-with-config-build) &optional command)
+ "Compile the current target OBJ.
+Argument COMMAND is the command to use for compiling the target."
+ (project-compile-project (ede-current-project) command))
+
+;;; C / C++
+;; Configure includes and preprocessor symbols for C/C++ needed by
+;; Semantic.
+(defclass ede-extra-config-c ()
+ ((c-include-path :initarg :c-include-path
+ :initform nil
+ :type list
+ :custom (repeat (string :tag "Path"))
+ :group c
+ :documentation
+ "The include path used by C/C++ projects.
+The include path is used when searching for symbols.")
+ (c-preprocessor-table :initarg :c-preprocessor-table
+ :initform nil
+ :type list
+ :custom (repeat (cons (string :tag "Macro")
+ (string :tag "Value")))
+ :group c
+ :documentation
+ "Preprocessor Symbols for this project.
+When files within this project are parsed by CEDET, these symbols will be
+used to resolve macro occurrences in source files.
+If you modify this slot, you will need to force your source files to be
+parsed again.")
+ (c-preprocessor-files :initarg :c-preprocessor-files
+ :initform nil
+ :type list
+ :group c
+ :custom (repeat (string :tag "Include File"))
+ :documentation
+ "Files parsed and used to populate preprocessor tables.
+When files within this project are parsed by CEDET, these symbols will be used to
+resolve macro occurrences in source files.
+If you modify this slot, you will need to force your source files to be
+parsed again."))
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-c ()
+ ()
+ "Class to mix into a project for C/C++ support.")
+
+(defclass ede-target-with-config-c ()
+ ()
+ "Class to mix into a project for C/C++ support.
+This target brings in methods used by Semantic to query
+the preprocessor map, and include paths.")
+
+(declare-function semanticdb-file-table-object "semantic/db"
+ (file &optional dontload))
+(declare-function semanticdb-needs-refresh-p "semantic/db" (arg &rest args))
+(declare-function semanticdb-refresh-table "semantic/db" (arg &rest args))
+
+(cl-defmethod ede-preprocessor-map ((this ede-target-with-config-c))
+ "Get the pre-processor map for some generic C code."
+ (require 'semantic/sb)
+ (let* ((proj (ede-target-parent this))
+ (root (ede-project-root proj))
+ (config (ede-config-get-configuration proj))
+ filemap
+ )
+ ;; Preprocessor files
+ (dolist (G (oref config :c-preprocessor-files))
+ (let ((table (semanticdb-file-table-object
+ (ede-expand-filename root G))))
+ (when table
+ (when (semanticdb-needs-refresh-p table)
+ (semanticdb-refresh-table table))
+ (setq filemap (append filemap (oref table lexical-table)))
+ )))
+ ;; The core table
+ (setq filemap (append filemap (oref config :c-preprocessor-table)))
+
+ filemap
+ ))
+
+(cl-defmethod ede-system-include-path ((this ede-target-with-config-c))
+ "Get the system include path used by project THIS."
+ (let* ((proj (ede-target-parent this))
+ (config (ede-config-get-configuration proj)))
+ (oref config c-include-path)))
+
+;;; Java
+;; Configuration needed for programming with Java.
+(defclass ede-extra-config-java ()
+ ()
+ "Class to mix into a configuration for compilation.")
+
+(defclass ede-project-with-config-java ()
+ ()
+ "Class to mix into a project to support java.
+This brings in methods to support Semantic querying the
+java class path.")
+
+(defclass ede-target-with-config-java ()
+ ()
+ "Class to mix into a project to support java.")
+
+(cl-defmethod ede-java-classpath ((proj ede-project-with-config-java))
+ "Return the classpath for this project."
+ (oref (ede-config-get-configuration proj) :classpath))
+
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "ede/config"
+;; End:
+
+(provide 'ede/config)
+
+;;; ede/config.el ends here
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index 719289765a3..22e24c8b67f 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -1,6 +1,6 @@
;;; ede/cpp-root.el --- A simple way to wrap a C++ project with a single root
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -95,7 +95,7 @@
;; Where FILENAME is a file in the root directory of the project.
;; Where MYFCN is a symbol for a function. See:
;;
-;; M-x describe-class RET ede-cpp-root-project RET
+;; M-x describe-function RET ede-cpp-root-project RET
;;
;; for documentation about the locate-fcn extension.
;;
@@ -116,11 +116,6 @@
;; <write your code here, or return nil>
;; )
;;
-;; (defun MY-ROOT-FCN ()
-;; "Return the root directory for `default-directory'"
-;; ;; You might be able to use `ede-cpp-root-project-root'.
-;; )
-;;
;; (defun MY-LOAD (dir)
;; "Load a project of type `cpp-root' for the directory DIR.
;; Return nil if there isn't one."
@@ -128,16 +123,14 @@
;; :locate-fcn 'MYFCN)
;; )
;;
-;; (add-to-list 'ede-project-class-files
-;; (ede-project-autoload "cpp-root"
+;; (ede-add-project-autoload
+;; (ede-project-autoload "cpp-root"
;; :name "CPP ROOT"
;; :file 'ede/cpp-root
;; :proj-file 'MY-FILE-FOR-DIR
-;; :proj-root 'MY-ROOT-FCN
;; :load-type 'MY-LOAD
;; :class-sym 'ede-cpp-root-project
-;; :safe-p t)
-;; t)
+;; :safe-p t))
;;
;;; TODO
;;
@@ -168,91 +161,13 @@
;;; PROJECT CACHE:
;;
-;; cpp-root projects are created in a .emacs or other config file, but
-;; there still needs to be a way for a particular file to be
-;; identified against it. The cache is where we look to map a file
-;; against a project.
-;;
-;; Setting up a simple in-memory cache of active projects allows the
-;; user to re-load their configuration file several times without
-;; messing up the active project set.
+;; cpp-root projects are created in a .emacs or other config file. We
+;; need to cache them so if the user re-loads a lisp file with the
+;; config in it, we can flush out the old one and replace it.
;;
(defvar ede-cpp-root-project-list nil
"List of projects created by option `ede-cpp-root-project'.")
-(defun ede-cpp-root-file-existing (dir)
- "Find a cpp-root project in the list of cpp-root projects.
-DIR is the directory to search from."
- (let ((projs ede-cpp-root-project-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root)) dir)
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-
-;;; PROJECT AUTOLOAD CONFIG
-;;
-;; Each project type registers itself into the project-class list.
-;; This way, each time a file is loaded, EDE can map that file to a
-;; project. This project type checks files against the internal cache
-;; of projects created by the user.
-;;
-;; EDE asks two kinds of questions. One is, does this DIR belong to a
-;; project. If it does, it then asks, what is the ROOT directory to
-;; the project in DIR. This is easy for cpp-root projects, but more
-;; complex for multiply nested projects.
-;;
-;; If EDE finds out that a project exists for DIR, it then loads that
-;; project. The LOAD routine can either create a new project object
-;; (if it needs to load it off disk) or more likely can return an
-;; existing object for the discovered directory. cpp-root always uses
-;; the second case.
-
-(defun ede-cpp-root-project-file-for-dir (&optional dir)
- "Return a full file name to the project file stored in DIR."
- (let ((proj (ede-cpp-root-file-existing dir)))
- (when proj (oref proj :file))))
-
-(defvar ede-cpp-root-count 0
- "Count number of hits to the cpp root thing.
-This is a debugging variable to test various optimizations in file
-lookup in the main EDE logic.")
-
-;;;###autoload
-(defun ede-cpp-root-project-root (&optional dir)
- "Get the root directory for DIR."
- (let ((projfile (ede-cpp-root-project-file-for-dir
- (or dir default-directory))))
- (setq ede-cpp-root-count (1+ ede-cpp-root-count))
- ;(debug)
- (when projfile
- (file-name-directory projfile))))
-
-(defun ede-cpp-root-load (dir &optional rootproj)
- "Return a CPP root object if you created one.
-Return nil if there isn't one.
-Argument DIR is the directory it is created for.
-ROOTPROJ is nil, since there is only one project."
- ;; Snoop through our master list.
- (ede-cpp-root-file-existing dir))
-
-;;;###autoload
-(ede-add-project-autoload
- (ede-project-autoload "cpp-root"
- :name "CPP ROOT"
- :file 'ede/cpp-root
- :proj-file 'ede-cpp-root-project-file-for-dir
- :proj-root 'ede-cpp-root-project-root
- :load-type 'ede-cpp-root-load
- :class-sym 'ede-cpp-root-project
- :new-p nil
- :safe-p t)
- ;; When a user creates one of these, it should override any other project
- ;; type that might happen to be in this directory, so force this to the
- ;; very front.
- 'unique)
;;; CLASSES
;;
@@ -347,7 +262,7 @@ exist, it should return nil."
:documentation
"Compilation command that will be used for this project.
It could be string or function that will accept proj argument and should return string.
-The string will be passed to 'compile' function that will be issued in root
+The string will be passed to `compile' function that will be issued in root
directory of project."
)
)
@@ -361,17 +276,18 @@ Each directory needs a project file to control it.")
;; find previous copies of this project, and make sure that one of the
;; objects is deleted.
-(defmethod initialize-instance ((this ede-cpp-root-project)
+(cl-defmethod initialize-instance ((this ede-cpp-root-project)
&rest fields)
"Make sure the :file is fully expanded."
;; Add ourselves to the master list
- (call-next-method)
+ (cl-call-next-method)
(let ((f (expand-file-name (oref this :file))))
;; Remove any previous entries from the main list.
(let ((old (eieio-instance-tracker-find (file-name-directory f)
:directory 'ede-cpp-root-project-list)))
;; This is safe, because :directory isn't filled in till later.
(when (and old (not (eq old this)))
+ (ede-delete-project-from-global-list old)
(delete-instance old)))
;; Basic initialization.
(when (or (not (file-exists-p f))
@@ -381,11 +297,13 @@ Each directory needs a project file to control it.")
(oset this :file f)
(oset this :directory (file-name-directory f))
(ede-project-directory-remove-hash (file-name-directory f))
+ ;; NOTE: We must add to global list here because these classes are not
+ ;; created via the typical loader, but instead via calls from a .emacs
+ ;; file.
(ede-add-project-to-global-list this)
+
(unless (slot-boundp this 'targets)
(oset this :targets nil))
- ;; We need to add ourselves to the master list.
- ;;(setq ede-projects (cons this ede-projects))
))
;;; SUBPROJ Management.
@@ -393,7 +311,7 @@ Each directory needs a project file to control it.")
;; This is a way to allow a subdirectory to point back to the root
;; project, simplifying authoring new single-point projects.
-(defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-cpp-root-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -403,7 +321,7 @@ Each directory needs a project file to control it.")
;; Creating new targets on a per directory basis is a good way to keep
;; files organized. See ede-emacs for an example with multiple file
;; types.
-(defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-cpp-root-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((targets (oref proj targets))
@@ -429,13 +347,13 @@ If one doesn't exist, create a new one for this directory."
;;
;; This tools also uses the ede-locate setup for augmented file name
;; lookup using external tools.
-(defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-cpp-root-project) name)
"Within this project PROJ, find the file NAME.
This knows details about or source tree."
;; The slow part of the original is looping over subprojects.
;; This version has no subprojects, so this will handle some
;; basic cases.
- (let ((ans (call-next-method)))
+ (let ((ans (cl-call-next-method)))
(unless ans
(let* ((lf (oref proj locate-fcn))
(dir (file-name-directory (oref proj file))))
@@ -454,30 +372,30 @@ This knows details about or source tree."
(setq ans tmp))
(setq ip (cdr ip)) ))
;; Else, do the usual.
- (setq ans (call-next-method)))
+ (setq ans (cl-call-next-method)))
)))
;; TODO - does this call-next-method happen twice. Is that bad?? Why is it here?
- (or ans (call-next-method))))
+ (or ans (cl-call-next-method))))
-(defmethod ede-project-root ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root ((this ede-cpp-root-project))
"Return my root."
this)
-(defmethod ede-project-root-directory ((this ede-cpp-root-project))
+(cl-defmethod ede-project-root-directory ((this ede-cpp-root-project))
"Return my root."
- (file-name-directory (oref this file)))
+ (oref this directory))
;;; C/CPP SPECIFIC CODE
;;
;; The following code is specific to setting up header files,
;; include lists, and Preprocessor symbol tables.
-(defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
+(cl-defmethod ede-cpp-root-header-file-p ((proj ede-cpp-root-project) name)
"Non nil if in PROJ the filename NAME is a header."
(save-match-data
(string-match (oref proj header-match-regexp) name)))
-(defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
+(cl-defmethod ede-cpp-root-translate-file ((proj ede-cpp-root-project) filename)
"For PROJ, translate a user specified FILENAME.
This is for project include paths and spp source files."
;; Step one: Root of this project.
@@ -493,11 +411,11 @@ This is for project include paths and spp source files."
filename))
-(defmethod ede-system-include-path ((this ede-cpp-root-project))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-project))
"Get the system include path used by project THIS."
(oref this system-include-path))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-project))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-project))
"Get the pre-processor map for project THIS."
(require 'semantic/db)
(let ((spp (oref this spp-table))
@@ -527,15 +445,15 @@ This is for project include paths and spp source files."
(oref this spp-files))
spp))
-(defmethod ede-system-include-path ((this ede-cpp-root-target))
+(cl-defmethod ede-system-include-path ((this ede-cpp-root-target))
"Get the system include path used by target THIS."
(ede-system-include-path (ede-target-parent this)))
-(defmethod ede-preprocessor-map ((this ede-cpp-root-target))
+(cl-defmethod ede-preprocessor-map ((this ede-cpp-root-target))
"Get the pre-processor map for project THIS."
(ede-preprocessor-map (ede-target-parent this)))
-(defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-cpp-root-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
;; we need to be in the proj root dir for this to work
@@ -551,13 +469,17 @@ Argument COMMAND is the command to use when compiling."
(let ((default-directory (ede-project-root-directory proj)))
(compile cmd-str)))))
-(defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-cpp-root-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(when (oref obj :project)
(project-compile-project (oref obj :project) command)))
+(cl-defmethod project-rescan ((this ede-cpp-root-project))
+ "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.
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index f37f8174f73..5b8783fd273 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -1,6 +1,6 @@
;;; ede/custom.el --- customization of EDE projects.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -61,7 +61,7 @@
"Edit fields of the current target through EIEIO & Custom."
(interactive)
(require 'eieio-custom)
- (if (not (obj-of-class-p ede-object ede-target))
+ (if (not (obj-of-class-p ede-object 'ede-target))
(error "Current file is not part of a target"))
(ede-customize-target ede-object))
@@ -72,15 +72,15 @@
"Edit fields of the current target through EIEIO & Custom.
OBJ is the target object to customize."
(require 'eieio-custom)
- (if (and obj (not (obj-of-class-p obj ede-target)))
+ (if (and obj (not (obj-of-class-p obj 'ede-target)))
(error "No logical target to customize"))
(ede-customize obj))
-(defmethod ede-customize ((proj ede-project))
+(cl-defmethod ede-customize ((proj ede-project))
"Customize the EDE project PROJ."
(eieio-customize-object proj 'default))
-(defmethod ede-customize ((target ede-target))
+(cl-defmethod ede-customize ((target ede-target))
"Customize the EDE TARGET."
(eieio-customize-object target 'default))
@@ -177,7 +177,7 @@ OBJ is the target object to customize."
;;; Customization hooks
;;
;; These hooks are used when finishing up a customization.
-(defmethod eieio-done-customizing ((proj ede-project))
+(cl-defmethod eieio-done-customizing ((proj ede-project))
"Call this when a user finishes customizing PROJ."
(let ((ov eieio-ede-old-variables)
(nv (oref proj local-variables)))
@@ -196,11 +196,11 @@ OBJ is the target object to customize."
;; These two methods should be implemented by subclasses of
;; project and targets in order to account for user specified
;; changes.
-(defmethod eieio-done-customizing ((target ede-target))
+(cl-defmethod eieio-done-customizing ((target ede-target))
"Call this when a user finishes customizing TARGET."
nil)
-(defmethod ede-commit-project ((proj ede-project))
+(cl-defmethod ede-commit-project ((proj ede-project))
"Commit any change to PROJ to its file."
nil
)
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
new file mode 100644
index 00000000000..9761b9e0828
--- /dev/null
+++ b/lisp/cedet/ede/detect.el
@@ -0,0 +1,210 @@
+;;; ede/detect.el --- EDE project detection and file associations
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <eric@siege-engine.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Project detection for EDE;
+;;
+;; Detection comes in multiple forms:
+;;
+;; `ede-detect-scan-directory-for-project' -
+;; Scan for a project via the file system.
+;; `ede-detect-directory-for-project' -
+;; Check our file cache for a project. If that fails, use
+;; the scan fcn above.
+
+;;; Code:
+
+(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)
+ "Return non-nil if we need to stop scanning upward in DIR."
+ ;;(let ((stop
+ (file-exists-p (expand-file-name ".ede_stop_scan" dir)))
+;;)
+;;(when stop
+;;(message "Stop Scan at %s" dir))
+;;stop))
+
+(defvar ede--detect-found-project nil
+ "When searching for a project, temporarily save that file.")
+
+(defun ede--detect-ldf-predicate (dir)
+ "Non-nil if DIR contain any known EDE project types."
+ (if (ede--detect-stop-scan-p dir)
+ (throw 'stopscan nil)
+ (let ((types ede-project-class-files))
+ ;; Loop over all types, loading in the first type that we find.
+ (while (and types (not ede--detect-found-project))
+ (if (ede-auto-detect-in-dir (car types) dir)
+ (progn
+ ;; We found one!
+ (setq ede--detect-found-project (car types)))
+ (setq types (cdr types)))
+ )
+ ede--detect-found-project)))
+
+(defun ede--detect-scan-directory-for-project (directory)
+ "Detect an EDE project for the current DIRECTORY by scanning.
+This function ALWAYS scans files and directories and DOES NOT
+use any file caches.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((ede--detect-found-project nil)
+ (root
+ (catch 'stopscan
+ (locate-dominating-file directory
+ 'ede--detect-ldf-predicate))))
+ (when root
+ (cons root ede--detect-found-project))))
+
+;;; Root Only project detect
+;;
+;; For projects that only have a detectable ROOT file, but may in fact
+;; contain a generic file such as a Makefile, we need to do a second scan
+;; to make sure we don't miss-match.
+(defun ede--detect-ldf-rootonly-predicate (dir)
+ "Non-nil if DIR contain any known EDE project types."
+ (if (ede--detect-stop-scan-p dir)
+ (throw 'stopscan nil)
+ (let ((types ede-project-class-files))
+ ;; Loop over all types, loading in the first type that we find.
+ (while (and types (not ede--detect-found-project))
+ (if (and
+ (oref (car types) root-only)
+ (ede-auto-detect-in-dir (car types) dir))
+ (progn
+ ;; We found one!
+ (setq ede--detect-found-project (car types)))
+ (setq types (cdr types)))
+ )
+ ede--detect-found-project)))
+
+(defun ede--detect-scan-directory-for-rootonly-project (directory)
+ "Detect an EDE project for the current DIRECTORY by scanning.
+This function ALWAYS scans files and directories and DOES NOT
+use any file caches.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((ede--detect-found-project nil)
+ (root
+ (catch 'stopscan
+ (locate-dominating-file directory
+ 'ede--detect-ldf-rootonly-predicate))))
+ (when root
+ (cons root ede--detect-found-project))))
+
+
+;;; NESTED PROJECT SCAN
+;;
+;; For projects that can have their dominating file exist in all their
+;; sub-directories as well.
+
+(defvar ede--detect-nomatch-auto nil
+ "An ede autoload that needs to be un-matched.")
+
+(defun ede--detect-ldf-root-predicate (dir)
+ "Non-nil if DIR no longer match `ede--detect-nomatch-auto'."
+ (or (ede--detect-stop-scan-p dir)
+ ;; To know if DIR is at the top, we need to look just above
+ ;; to see if there is a match.
+ (let ((updir (file-name-directory (directory-file-name dir))))
+ (if (equal updir dir)
+ ;; If it didn't change, then obviously this must be the top.
+ t
+ ;; If it is different, check updir for the file.
+ (not (ede-auto-detect-in-dir ede--detect-nomatch-auto updir))))))
+
+(defun ede--detect-scan-directory-for-project-root (directory auto)
+ "If DIRECTORY has already been detected with AUTO, find the root.
+Some projects have their dominating file in all their directories, such
+as Project.ede. In that case we will detect quickly, but then need
+to scan upward to find the topmost occurrence of that file."
+ (let* ((ede--detect-nomatch-auto auto)
+ (root (locate-dominating-file directory
+ 'ede--detect-ldf-root-predicate)))
+ root))
+
+;;; TOP LEVEL SCAN
+;;
+;; This function for combining the above scans.
+(defun ede-detect-directory-for-project (directory)
+ "Detect an EDE project for the current DIRECTORY.
+Scan the filesystem for a project.
+Return a cons cell:
+ ( ROOTDIR . PROJECT-AUTOLOAD)"
+ (let* ((scan (ede--detect-scan-directory-for-project directory))
+ (root (car scan))
+ (auto (cdr scan)))
+ (when scan
+ ;; If what we found is already a root-only project, return it.
+ (if (oref auto root-only)
+ scan
+
+ ;; If what we found is a generic project, check to make sure we aren't
+ ;; in some other kind of root project.
+ (if (oref auto generic-p)
+ (let ((moreroot (ede--detect-scan-directory-for-rootonly-project root)))
+ ;; If we found a rootier project, return that.
+ (if moreroot
+ moreroot
+
+ ;; If we didn't find a root from the generic project, then
+ ;; we need to rescan upward.
+ (cons (ede--detect-scan-directory-for-project-root root auto) auto)))
+
+ ;; Non-generic non-root projects also need to rescan upward.
+ (cons (ede--detect-scan-directory-for-project-root root auto) auto)))
+
+ )))
+
+;;; TEST
+;;
+;; A quick interactive testing fcn.
+(defun ede-detect-qtest ()
+ "Run a quick test for autodetecting on BUFFER."
+ (interactive)
+ (let ((start (current-time))
+ (ans (ede-detect-directory-for-project default-directory))
+ (end (current-time)))
+ (if ans
+ (message "Project found in %d sec @ %s of type %s"
+ (float-time (time-subtract end start))
+ (car ans)
+ (eieio-object-name-string (cdr ans)))
+ (message "No Project found.") )))
+
+
+(provide 'ede/detect)
+
+;;; ede/detect.el ends here
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index b010f5fddfa..836a538e2cd 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -1,10 +1,10 @@
;;; ede/dired.el --- EDE extensions to dired.
-;; Copyright (C) 1998-2000, 2003, 2009-2013 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2003, 2009-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.4
+;; Old-Version: 0.4
;; Keywords: project, make
;; This file is part of GNU Emacs.
@@ -56,6 +56,7 @@
map)
"Keymap used for ede dired minor mode.")
+;;;###autoload
(define-minor-mode ede-dired-minor-mode
"A minor mode that should only be activated in DIRED buffers.
If ARG is nil or a positive number, force on, if
@@ -84,4 +85,9 @@ negative, force off."
(provide 'ede/dired)
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "ede/dired"
+;; End:
+
;;; ede/dired.el ends here
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index f5a85f4a01b..c3caf98bc61 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -1,6 +1,6 @@
;;; ede/emacs.el --- Special project for Emacs
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,37 +38,12 @@
(declare-function semanticdb-refresh-table "semantic/db")
;;; Code:
-(defvar ede-emacs-project-list nil
- "List of projects created by option `ede-emacs-project'.")
-
-(defun ede-emacs-file-existing (dir)
- "Find a Emacs project in the list of Emacs projects.
-DIR is the directory to search from."
- (let ((projs ede-emacs-project-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root))
- (file-name-as-directory dir))
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-;;;###autoload
-(defun ede-emacs-project-root (&optional dir)
+;; @TODO - get rid of this. Stuck in loaddefs right now.
+
+(defun ede-emacs-project-root (&optional _dir)
"Get the root directory for DIR."
- (when (not dir) (setq dir default-directory))
- (let ((case-fold-search t)
- (proj (ede-files-find-existing dir ede-emacs-project-list)))
- (if proj
- (ede-up-directory (file-name-directory
- (oref proj :file)))
- ;; No pre-existing project. Let's take a wild-guess if we have
- ;; an Emacs project here.
- (when (string-match "emacs[^/]*" dir)
- (let ((base (substring dir 0 (match-end 0))))
- (when (file-exists-p (expand-file-name "src/emacs.c" base))
- base))))))
+ nil)
(defun ede-emacs-version (dir)
"Find the Emacs version for the Emacs src in DIR.
@@ -80,12 +55,6 @@ Return a tuple of ( EMACSNAME . VERSION )."
(with-current-buffer buff
(erase-buffer)
(setq default-directory (file-name-as-directory dir))
- (or (file-exists-p configure_ac)
- (setq configure_ac "configure.in"))
- ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile")
- (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac)
- (goto-char (point-min))
- ;(re-search-forward "version=\\([0-9.]+\\)")
(cond
;; Maybe XEmacs?
((file-exists-p "version.sh")
@@ -113,51 +82,48 @@ m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
;; Insert other Emacs here...
;; Vaguely recent version of GNU Emacs?
- (t
+ ((or (file-exists-p configure_ac)
+ (file-exists-p (setq configure_ac "configure.in")))
(insert-file-contents configure_ac)
(goto-char (point-min))
- (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)")
+ (re-search-forward "AC_INIT(\\(?:GNU \\)?[eE]macs,\\s-*\\([0-9.]+\\)\\s-*[,)]")
(setq ver (match-string 1))
)
)
;; Return a tuple
(cons emacs ver))))
-(defclass ede-emacs-project (ede-project eieio-instance-tracker)
- ((tracking-symbol :initform 'ede-emacs-project-list)
+(defclass ede-emacs-project (ede-project)
+ (
)
"Project Type for the Emacs source code."
:method-invocation-order :depth-first)
-(defun ede-emacs-load (dir &optional rootproj)
+(defun ede-emacs-load (dir &optional _rootproj)
"Return an Emacs Project object if there is a match.
Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
- (or (ede-files-find-existing dir ede-emacs-project-list)
- ;; Doesn't already exist, so let's make one.
- (let* ((vertuple (ede-emacs-version dir))
- (proj (ede-emacs-project
- (car vertuple)
- :name (car vertuple)
- :version (cdr vertuple)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "src/emacs.c"
- dir))))
- (ede-add-project-to-global-list proj))))
+ ;; Doesn't already exist, so let's make one.
+ (let* ((vertuple (ede-emacs-version dir)))
+ (ede-emacs-project
+ (car vertuple)
+ :name (car vertuple)
+ :version (cdr vertuple)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "src/emacs.c"
+ dir))))
;;;###autoload
(ede-add-project-autoload
- (ede-project-autoload "emacs"
- :name "EMACS ROOT"
- :file 'ede/emacs
- :proj-file "src/emacs.c"
- :proj-root-dirmatch "emacs[^/]*"
- :proj-root 'ede-emacs-project-root
- :load-type 'ede-emacs-load
- :class-sym 'ede-emacs-project
- :new-p nil
- :safe-p t)
+ (make-instance 'ede-project-autoload
+ :name "EMACS ROOT"
+ :file 'ede/emacs
+ :proj-file "src/emacs.c"
+ :load-type 'ede-emacs-load
+ :class-sym 'ede-emacs-project
+ :new-p nil
+ :safe-p t)
'unique)
(defclass ede-emacs-target-c (ede-target)
@@ -175,26 +141,26 @@ All directories need at least one target.")
"EDE Emacs Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-emacs-project)
- &rest fields)
+(cl-defmethod initialize-instance ((this ede-emacs-project)
+ &rest _fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-emacs-project)
- &optional file)
+(cl-defmethod ede-project-root-directory ((this ede-emacs-project)
+ &optional _file)
"Return the root for THIS Emacs project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-emacs-project))
+(cl-defmethod ede-project-root ((this ede-emacs-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
- dir)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -205,12 +171,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-emacs-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-emacs-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -238,7 +204,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-emacs-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-emacs-target-c))
"Get the pre-processor map for Emacs C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
@@ -287,7 +253,7 @@ All files need the macros from lisp.h!"
(setq dirs (cdr dirs))))
ans))
-(defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Emacs source tree is organized."
(let* ((ext (file-name-extension name))
@@ -303,10 +269,19 @@ Knows about how the Emacs source tree is organized."
'("doc"))
(t nil)))
)
- (if (not dirs) (call-next-method)
+ (if (not dirs) (cl-call-next-method)
(ede-emacs-find-in-directories name dir dirs))
))
+;;; Command Support
+;;
+(cl-defmethod project-rescan ((this ede-emacs-project))
+ "Rescan this Emacs project from the sources."
+ (let ((ver (ede-emacs-version (ede-project-root-directory this))))
+ (oset this name (car ver))
+ (oset this version (cdr ver))
+ ))
+
(provide 'ede/emacs)
;; Local variables:
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 91433add7b0..4ba823adeee 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -1,6 +1,6 @@
;;; ede/files.el --- Associate projects with files and directories.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -41,7 +41,7 @@
(declare-function ede-locate-flush-hash "ede/locate")
(defvar ede--disable-inode nil
- "Set to 't' to simulate systems w/out inode support.")
+ "Set to t to simulate systems w/out inode support.")
;;; Code:
;;;###autoload
@@ -69,57 +69,26 @@ the current EDE project."
;;; Placeholders for ROOT directory scanning on base objects
;;
-(defmethod ede-project-root ((this ede-project-placeholder))
+(cl-defmethod ede-project-root ((this ede-project-placeholder))
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems."
(oref this rootproject))
-(defmethod ede-project-root-directory ((this ede-project-placeholder)
+(cl-defmethod ede-project-root-directory ((this ede-project-placeholder)
&optional file)
"If a project knows its root, return it here.
Allows for one-project-object-for-a-tree type systems.
Optional FILE is the file to test. It is ignored in preference
of the anchor file for the project."
- (file-name-directory (expand-file-name (oref this file))))
+ (let ((root (or (ede-project-root this) this)))
+ (file-name-directory (expand-file-name (oref this file)))))
-(defmethod ede--project-inode ((proj ede-project-placeholder))
- "Get the inode of the directory project PROJ is in."
- (if (slot-boundp proj 'dirinode)
- (oref proj dirinode)
- (oset proj dirinode (ede--inode-for-dir (oref proj :directory)))))
-
-(defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
- dir)
- "Find a subproject of PROJ that corresponds to DIR."
- (if ede--disable-inode
- (let ((ans nil))
- ;; Try to find the right project w/out inodes.
- (ede-map-subprojects
- proj
- (lambda (SP)
- (when (not ans)
- (if (string= (file-truename dir) (oref SP :directory))
- (setq ans SP)
- (ede-find-subproject-for-directory SP dir)))))
- ans)
- ;; We can use inodes, so let's try it.
- (let ((ans nil)
- (inode (ede--inode-for-dir dir)))
- (ede-map-subprojects
- proj
- (lambda (SP)
- (when (not ans)
- (if (equal (ede--project-inode SP) inode)
- (setq ans SP)
- (setq ans (ede-find-subproject-for-directory SP dir))))))
- ans)))
+;; Why INODEs?
+;; An inode represents a unique ID that transcends symlinks, hardlinks, etc.
+;; so when we cache an inode in a project, and hash directories to inodes, we
+;; can avoid costly filesystem queries and regex matches.
-;;; DIRECTORY IN OPEN PROJECT
-;;
-;; These routines match some directory name to one of the many pre-existing
-;; open projects. This should avoid hitting the disk, or asking lots of questions
-;; if used throughout the other routines.
(defvar ede-inode-directory-hash (make-hash-table
;; Note on test. Can we compare inodes or something?
:test 'equal)
@@ -147,6 +116,32 @@ of the anchor file for the project."
(ede--put-inode-dir-hash dir (nth 10 fattr))
)))))
+(cl-defmethod ede--project-inode ((proj ede-project-placeholder))
+ "Get the inode of the directory project PROJ is in."
+ (if (slot-boundp proj 'dirinode)
+ (oref proj dirinode)
+ (oset proj dirinode (ede--inode-for-dir (oref proj :directory)))))
+
+(defun ede--inode-get-toplevel-open-project (inode)
+ "Return an already open toplevel project that is managing INODE.
+Does not check subprojects."
+ (when (or (and (numberp inode) (/= inode 0))
+ (consp inode))
+ (let ((all ede-projects)
+ (found nil)
+ )
+ (while (and all (not found))
+ (when (equal inode (ede--project-inode (car all)))
+ (setq found (car all)))
+ (setq all (cdr all)))
+ found)))
+
+;;; DIRECTORY IN OPEN PROJECT
+;;
+;; These routines match some directory name to one of the many pre-existing
+;; open projects. This should avoid hitting the disk, or asking lots of questions
+;; if used throughout the other routines.
+
(defun ede-directory-get-open-project (dir &optional rootreturn)
"Return an already open project that is managing DIR.
Optional ROOTRETURN specifies a symbol to set to the root project.
@@ -156,66 +151,105 @@ If DIR is the root project, then it is the same."
(proj (ede--inode-get-toplevel-open-project inode))
(ans nil))
;; Try file based search.
- (when (not proj)
+ (when (or ede--disable-inode (not proj))
(setq proj (ede-directory-get-toplevel-open-project ft)))
;; Default answer is this project
(setq ans proj)
;; Save.
(when rootreturn (set rootreturn proj))
;; Find subprojects.
- (when (and proj (or ede--disable-inode
- (not (equal inode (ede--project-inode proj)))))
+ (when (and proj (if ede--disable-inode
+ (not (string= ft (expand-file-name (oref proj :directory))))
+ (not (equal inode (ede--project-inode proj)))))
(setq ans (ede-find-subproject-for-directory proj ft)))
ans))
-(defun ede--inode-get-toplevel-open-project (inode)
- "Return an already open toplevel project that is managing INODE.
-Does not check subprojects."
- (when (or (and (numberp inode) (/= inode 0))
- (consp inode))
- (let ((all ede-projects)
- (found nil)
- )
- (while (and all (not found))
- (when (equal inode (ede--project-inode (car all)))
- (setq found (car all)))
- (setq all (cdr all)))
- found)))
-
-(defun ede-directory-get-toplevel-open-project (dir)
- "Return an already open toplevel project that is managing DIR."
+;; Force all users to switch to `ede-directory-get-open-project'
+;; for performance reasons.
+(defun ede-directory-get-toplevel-open-project (dir &optional exact)
+ "Return an already open toplevel project that is managing DIR.
+If optional EXACT is non-nil, only return exact matches for DIR."
(let ((ft (file-name-as-directory (expand-file-name dir)))
(all ede-projects)
- (ans nil))
+ (ans nil)
+ (shortans nil))
(while (and all (not ans))
;; Do the check.
- (let ((pd (oref (car all) :directory))
+ (let ((pd (expand-file-name (oref (car all) :directory)))
)
(cond
;; Exact text match.
((string= pd ft)
(setq ans (car all)))
;; Some sub-directory
- ((string-match (concat "^" (regexp-quote pd)) ft)
- (setq ans (car all)))
+ ((and (not exact) (string-match (concat "^" (regexp-quote pd)) ft))
+ (if (not shortans)
+ (setq shortans (car all))
+ ;; We already have a short answer, so see if pd (the match we found)
+ ;; is longer. If it is longer, then it is more precise.
+ (when (< (length (oref shortans :directory))
+ (length pd))
+ (setq shortans (car all))))
+ )
;; Exact inode match. Useful with symlinks or complex automounters.
- ((let ((pin (ede--project-inode (car all)))
- (inode (ede--inode-for-dir dir)))
- (and (not (eql pin 0)) (equal pin inode)))
+ ((and (not ede--disable-inode)
+ (let ((pin (ede--project-inode (car all)))
+ (inode (ede--inode-for-dir dir)))
+ (and (not (eql pin 0)) (equal pin inode))))
(setq ans (car all)))
;; Subdir via truename - slower by far, but faster than a traditional lookup.
- ((let ((ftn (file-truename ft))
- (ptd (file-truename (oref (car all) :directory))))
- (string-match (concat "^" (regexp-quote ptd)) ftn))
- (setq ans (car all)))
- ))
+ ;; Note that we must resort to truename in order to resolve issues such as
+ ;; cross-symlink projects.
+ ((and (not exact)
+ (let ((ftn (file-truename ft))
+ (ptd (file-truename pd)))
+ (string-match (concat "^" (regexp-quote ptd)) ftn)))
+ (if (not shortans)
+ (setq shortans (car all))
+ ;; We already have a short answer, so see if pd (the match we found)
+ ;; is longer. If it is longer, then it is more precise.
+ (when (< (length (expand-file-name (oref shortans :directory)))
+ (length pd))
+ (setq shortans (car all))))
+ )))
(setq all (cdr all)))
- ans))
+ ;; If we have an exact answer, use that, otherwise use
+ ;; the short answer we found -> ie - we are in a subproject.
+ (or ans shortans)))
+
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-project-placeholder)
+ dir)
+ "Find a subproject of PROJ that corresponds to DIR."
+ (if ede--disable-inode
+ (let ((ans nil)
+ (fulldir (file-truename dir)))
+ ;; Try to find the right project w/out inodes.
+ (ede-map-subprojects
+ proj
+ (lambda (SP)
+ (when (not ans)
+ (if (string= fulldir (file-truename (oref SP :directory)))
+ (setq ans SP)
+ (ede-find-subproject-for-directory SP dir)))))
+ ans)
+ ;; We can use inodes, so let's try it.
+ (let ((ans nil)
+ (inode (ede--inode-for-dir dir)))
+ (ede-map-subprojects
+ proj
+ (lambda (SP)
+ (when (not ans)
+ (if (equal (ede--project-inode SP) inode)
+ (setq ans SP)
+ (setq ans (ede-find-subproject-for-directory SP dir))))))
+ ans)))
-;;; DIRECTORY-PROJECT-P
+;;; DIRECTORY HASH
;;
-;; For a fresh buffer, or for a path w/ no open buffer, use this
-;; routine to determine if there is a known project type here.
+;; The directory hash matches expanded directory names to already detected
+;; projects. By hashing projects to directories, we can detect projects in
+;; places we have been before much more quickly.
+
(defvar ede-project-directory-hash (make-hash-table
;; Note on test. Can we compare inodes or something?
:test 'equal)
@@ -237,7 +271,7 @@ Do this only when developing new projects that are incorrectly putting
"Reset the directory hash for DIR.
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.
@@ -248,102 +282,99 @@ Do this whenever a new project is created, as opposed to loaded."
ede-project-directory-hash))
))
-(defun ede-directory-project-from-hash (dir)
+(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)))
-(defun ede-directory-project-add-description-to-hash (dir desc)
+(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))
+;;; DIRECTORY-PROJECT-P, -CONS
+;;
+;; These routines are useful for detecting if a project exists
+;; in a provided directory.
+;;
+;; Note that -P provides less information than -CONS, so use -CONS
+;; instead so that -P can be obsoleted.
(defun ede-directory-project-p (dir &optional force)
- "Return a project description object if DIR has a project.
+ "Return a project description object if DIR is in a project.
Optional argument FORCE means to ignore a hash-hit of 'nomatch.
This depends on an up to date `ede-project-class-files' variable.
Any directory that contains the file .ede-ignore will always
-return nil."
+return nil.
+
+Consider using `ede-directory-project-cons' instead if the next
+question you want to ask is where the root of found project is."
+ ;; @TODO - We used to have a full impl here, but moved it all
+ ;; to ede-directory-project-cons, and now hash contains only
+ ;; the results of detection which includes the root dir.
+ ;; Perhaps we can eventually remove this fcn?
+ (let ((detect (ede-directory-project-cons dir force)))
+ (cdr detect)))
+
+(defun ede-directory-project-cons (dir &optional force)
+ "Return a project CONS (ROOTDIR . AUTOLOAD) for DIR.
+If there is no project in DIR, return nil.
+Optional FORCE means to ignore the hash of known directories."
(when (not (file-exists-p (expand-file-name ".ede-ignore" dir)))
(let* ((dirtest (expand-file-name dir))
- (match (ede-directory-project-from-hash dirtest)))
+ (match (ede--directory-project-from-hash dirtest)))
(cond
((and (eq match 'nomatch) (not force))
nil)
((and match (not (eq match 'nomatch)))
match)
(t
- (let ((types ede-project-class-files)
- (ret nil))
- ;; Loop over all types, loading in the first type that we find.
- (while (and types (not ret))
- (if (ede-dir-to-projectfile (car types) dirtest)
- (progn
- ;; We found one! Require it now since we will need it.
- (require (oref (car types) file))
- (setq ret (car types))))
- (setq types (cdr types)))
- (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch))
- ret))))))
+ ;; First time here? Use the detection code to identify if we have
+ ;; a project here.
+ (let* ((detect (ede-detect-directory-for-project dirtest))
+ (autoloader (cdr detect))) ;; autoloader
+ (when autoloader (require (oref autoloader file)))
+ (ede--directory-project-add-description-to-hash dirtest (or detect 'nomatch))
+ detect)
+ )))))
+
;;; TOPLEVEL
;;
;; These utilities will identify the "toplevel" of a project.
;;
-(defun ede-toplevel-project-or-nil (dir)
- "Starting with DIR, find the toplevel project directory, or return nil.
-nil is returned if the current directory is not a part of a project."
- (let* ((ans (ede-directory-get-toplevel-open-project dir)))
- (if ans
- (oref ans :directory)
- (if (ede-directory-project-p dir)
- (ede-toplevel-project dir)
- nil))))
+;; NOTE: These two -toplevel- functions return a directory even though
+;; the function name implies a project.
(defun ede-toplevel-project (dir)
- "Starting with DIR, find the toplevel project directory."
- (if (and (string= dir default-directory)
+ "Starting with DIR, find the toplevel project directory.
+If DIR is not part of a project, return nil."
+ (let ((ans nil))
+
+ (cond
+ ;; Check if it is cached in the current buffer.
+ ((and (string= dir default-directory)
ede-object-root-project)
;; Try the local buffer cache first.
- (oref ede-object-root-project :directory)
- ;; Otherwise do it the hard way.
- (let* ((thisdir (ede-directory-project-p dir))
- (ans (ede-directory-get-toplevel-open-project dir)))
- (if (and ans ;; We have an answer
- (or (not thisdir) ;; this dir isn't setup
- (and (object-of-class-p ;; Same as class for this dir?
- ans (oref thisdir :class-sym)))
- ))
- (oref ans :directory)
- (let* ((toppath (expand-file-name dir))
- (newpath toppath)
- (proj (ede-directory-project-p dir))
- (ans nil))
- (if proj
- ;; If we already have a project, ask it what the root is.
- (setq ans (ede-project-root-directory proj)))
-
- ;; If PROJ didn't know, or there is no PROJ, then
-
- ;; Loop up to the topmost project, and then load that single
- ;; project, and its sub projects. When we are done, identify the
- ;; sub-project object belonging to file.
- (while (and (not ans) newpath proj)
- (setq toppath newpath
- newpath (ede-up-directory toppath))
- (when newpath
- (setq proj (ede-directory-project-p newpath)))
-
- (when proj
- ;; We can home someone in the middle knows too.
- (setq ans (ede-project-root-directory proj)))
- )
- (or ans toppath))))))
+ (oref ede-object-root-project :directory))
+
+ ;; See if there is an existing project in DIR.
+ ((setq ans (ede-directory-get-toplevel-open-project dir))
+ (oref ans :directory))
+
+ ;; Detect using our file system detector.
+ ((setq ans (ede-detect-directory-for-project dir))
+ (car ans))
+
+ (t nil))))
+
+(defalias 'ede-toplevel-project-or-nil 'ede-toplevel-project)
;;; DIRECTORY CONVERSION STUFF
;;
-(defmethod ede-convert-path ((this ede-project) path)
+(cl-defmethod ede-convert-path ((this ede-project) path)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to."
@@ -357,7 +388,7 @@ Argument THIS is the project to convert PATH to."
(substring fptf (match-end 0))
(error "Cannot convert relativize path %s" fp))))))
-(defmethod ede-convert-path ((this ede-target) path &optional project)
+(cl-defmethod ede-convert-path ((this ede-target) path &optional project)
"Convert path in a standard way for a given project.
Default to making it project relative.
Argument THIS is the project to convert PATH to.
@@ -388,7 +419,7 @@ Get it from the toplevel project. If it doesn't have one, make one."
(oref top locate-obj)
)))
-(defmethod ede-expand-filename ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
@@ -445,7 +476,7 @@ is returned."
ans))
-(defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
+(cl-defmethod ede-expand-filename-impl ((this ede-project) filename &optional force)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project.
@@ -465,7 +496,7 @@ doesn't exist."
;; Return it
found))
-(defmethod ede-expand-filename-local ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-local ((this ede-project) filename)
"Expand filename locally to project THIS with filesystem tests."
(let ((path (ede-project-root-directory this)))
(cond ((file-exists-p (expand-file-name filename path))
@@ -473,7 +504,7 @@ doesn't exist."
((file-exists-p (expand-file-name (concat "include/" filename) path))
(expand-file-name (concat "include/" filename) path)))))
-(defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
+(cl-defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename)
"Return a fully qualified file name based on project THIS.
FILENAME should be just a filename which occurs in a directory controlled
by this project."
@@ -489,7 +520,7 @@ by this project."
;; Return it
found))
-(defmethod ede-expand-filename ((this ede-target) filename &optional force)
+(cl-defmethod ede-expand-filename ((this ede-target) filename &optional force)
"Return a fully qualified file name based on target THIS.
FILENAME should be a filename which occurs in a directory in which THIS works.
Optional argument FORCE forces the default filename to be provided even if it
@@ -509,25 +540,6 @@ Argument DIR is the directory to trim upwards."
nil
fnd)))
-(defun ede-find-project-root (prj-file-name &optional dir)
- "Tries to find directory with given project file"
- (let ((prj-dir (locate-dominating-file (or dir default-directory)
- prj-file-name)))
- (when prj-dir
- (expand-file-name prj-dir))))
-
-(defun ede-files-find-existing (dir prj-list)
- "Find a project in the list of projects stored in given variable.
-DIR is the directory to search from."
- (let ((projs prj-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root)) dir)
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-
(provide 'ede/files)
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index fedf0ffc7c6..d3be545a158 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -1,6 +1,6 @@
;;; ede/generic.el --- Base Support for generic build systems
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -74,65 +74,22 @@
;; The ede-generic-target-c-cpp has some example methods setting up
;; the pre-processor map and system include path.
;;
-;; NOTE: It is not necessary to modify ede-generic.el to add any of
+;; NOTE: It is not necessary to modify ede/generic.el to add any of
;; the above described support features.
(require 'eieio-opt)
-(require 'ede)
+(require 'ede/config)
(require 'ede/shell)
(require 'semantic/db)
;;; Code:
;;
;; Start with the configuration system
-(defclass ede-generic-config (eieio-persistent)
- ((extension :initform ".ede")
- (file-header-line :initform ";; EDE Generic Project Configuration")
- (project :initform nil
- :documentation
- "The project this config is bound to.")
- ;; Generic customizations
- (build-command :initarg :build-command
- :initform "make -k"
- :type string
- :custom string
- :group (default build)
- :documentation
- "Command used for building this project.")
- (debug-command :initarg :debug-command
- :initform "gdb "
- :type string
- :custom string
- :group (default build)
- :documentation
- "Command used for debugging this project.")
- (run-command :initarg :run-command
- :initform nil
- :type (or null string)
- :custom string
- :group (default build)
- :documentation
- "Command used to run something related to this project.")
- ;; C target customizations
- (c-include-path :initarg :c-include-path
- :initform nil
- :type list
- :custom (repeat (string :tag "Path"))
- :group c
- :documentation
- "The include path used by C/C++ projects.")
- (c-preprocessor-table :initarg :c-preprocessor-table
- :initform nil
- :type list
- :custom (repeat (cons (string :tag "Macro")
- (string :tag "Value")))
- :group c
- :documentation
- "Preprocessor Symbols for this project.")
- (c-preprocessor-files :initarg :c-preprocessor-files
- :initform nil
- :type list
- :custom (repeat (string :tag "Include File")))
+(defclass ede-generic-config (ede-extra-config
+ ede-extra-config-build
+ ede-extra-config-program
+ ede-extra-config-c)
+ ((file-header-line :initform ";; EDE Generic Project Configuration")
)
"User Configuration object for a generic project.")
@@ -142,23 +99,24 @@ Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
;; Doesn't already exist, so let's make one.
- (let* ((alobj ede-constructing)
- (this nil))
+ (let* ((alobj ede-constructing))
(when (not alobj) (error "Cannot load generic project without the autoload instance"))
-
- (setq this
- (funcall (oref alobj class-sym)
- (symbol-name (oref alobj class-sym))
- :name (file-name-nondirectory
- (directory-file-name dir))
- :version "1.0"
- :directory (file-name-as-directory dir)
- :file (expand-file-name (oref alobj :proj-file)) ))
- (ede-add-project-to-global-list this)
+ ;;;
+ ;; TODO - find the root dir.
+ (let ((rootdir dir))
+ (funcall (oref alobj class-sym)
+ (symbol-name (oref alobj class-sym))
+ :name (file-name-nondirectory (directory-file-name dir))
+ :version "1.0"
+ :directory (file-name-as-directory rootdir)
+ :file (expand-file-name (oref alobj proj-file)
+ rootdir)))
))
;;; Base Classes for the system
-(defclass ede-generic-target (ede-target)
+(defclass ede-generic-target (ede-target-with-config
+ ede-target-with-config-build
+ ede-target-with-config-program)
((shortname :initform ""
:type string
:allocation :class
@@ -174,59 +132,42 @@ subclasses of this base target will override the default value.")
"Baseclass for all targets belonging to the generic ede system."
:abstract t)
-(defclass ede-generic-project (ede-project)
- ((buildfile :initform ""
+(defclass ede-generic-project (ede-project-with-config
+ ede-project-with-config-build
+ ede-project-with-config-program
+ ede-project-with-config-c
+ ede-project-with-config-java)
+ ((config-class :initform ede-generic-config)
+ (config-file-basename :initform "EDEConfig.el")
+ (buildfile :initform ""
:type string
:allocation :class
:documentation "The file name that identifies a project of this type.
The class allocated value is replace by different sub classes.")
- (config :initform nil
- :type (or null ede-generic-config)
- :documentation
- "The configuration object for this project.")
)
"The baseclass for all generic EDE project types."
:abstract t)
-(defmethod initialize-instance ((this ede-generic-project)
+(cl-defmethod initialize-instance ((this ede-generic-project)
&rest fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil))
)
-(defmethod ede-generic-get-configuration ((proj ede-generic-project))
- "Return the configuration for the project PROJ."
- (let ((config (oref proj config)))
- (when (not config)
- (let ((fname (expand-file-name "EDEConfig.el"
- (oref proj :directory))))
- (if (file-exists-p fname)
- ;; Load in the configuration
- (setq config (eieio-persistent-read fname 'ede-generic-config))
- ;; Create a new one.
- (setq config (ede-generic-config
- "Configuration"
- :file fname))
- ;; Set initial values based on project.
- (ede-generic-setup-configuration proj config))
- ;; Link things together.
- (oset proj config config)
- (oset config project proj)))
- config))
-
-(defmethod ede-generic-setup-configuration ((proj ede-generic-project) config)
- "Default configuration setup method."
- nil)
-
-(defmethod ede-commit-project ((proj ede-generic-project))
- "Commit any change to PROJ to its file."
- (let ((config (ede-generic-get-configuration proj)))
- (ede-commit config)))
+(cl-defmethod ede-project-root ((this ede-generic-project))
+ "Return my root."
+ this)
+
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-generic-project)
+ dir)
+ "Return PROJ, for handling all subdirs below DIR."
+ proj)
;;; A list of different targets
-(defclass ede-generic-target-c-cpp (ede-generic-target)
+(defclass ede-generic-target-c-cpp (ede-generic-target
+ ede-target-with-config-c)
((shortname :initform "C/C++")
(extension :initform "\\([ch]\\(pp\\|xx\\|\\+\\+\\)?\\|cc\\|hh\\|CC?\\)"))
"EDE Generic Project target for C and C++ code.
@@ -250,6 +191,13 @@ All directories need at least one target.")
"EDE Generic Project target for texinfo code.
All directories need at least one target.")
+(defclass ede-generic-target-java (ede-generic-target
+ ede-target-with-config-java)
+ ((shortname :initform "Java")
+ (extension :initform "java"))
+ "EDE Generic Project target for texinfo code.
+All directories need at least one target.")
+
;; MISC must always be last since it will always match the file.
(defclass ede-generic-target-misc (ede-generic-target)
((shortname :initform "Misc")
@@ -263,12 +211,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-generic-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-generic-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -282,9 +230,9 @@ If one doesn't exist, create a new one for this directory."
(when ext
(dolist (C classes)
(let* ((classsym (intern (car C)))
- (extreg (oref classsym extension)))
+ (extreg (oref-default classsym extension)))
(when (and (not (string= extreg ""))
- (string-match (concat "^" extreg "$") ext))
+ (string-match (concat "\\`\\(?:" extreg "\\)\\'") ext))
(setq cls classsym)))))
(when (not cls) (setq cls 'ede-generic-target-misc))
;; find a pre-existing matching target
@@ -293,136 +241,41 @@ If one doesn't exist, create a new one for this directory."
(when (not ans)
(setq ans (make-instance
cls
- :name (oref cls shortname)
+ :name (oref-default cls shortname)
:path dir
:source nil))
(object-add-to-list proj :targets ans)
)
ans))
-;;; C/C++ support
-(defmethod ede-preprocessor-map ((this ede-generic-target-c-cpp))
- "Get the pre-processor map for some generic C code."
- (let* ((proj (ede-target-parent this))
- (root (ede-project-root proj))
- (config (ede-generic-get-configuration proj))
- filemap
- )
- ;; Preprocessor files
- (dolist (G (oref config :c-preprocessor-files))
- (let ((table (semanticdb-file-table-object
- (ede-expand-filename root G))))
- (when table
- (when (semanticdb-needs-refresh-p table)
- (semanticdb-refresh-table table))
- (setq filemap (append filemap (oref table lexical-table)))
- )))
- ;; The core table
- (setq filemap (append filemap (oref config :c-preprocessor-table)))
-
- filemap
- ))
-
-(defmethod ede-system-include-path ((this ede-generic-target-c-cpp))
- "Get the system include path used by project THIS."
- (let* ((proj (ede-target-parent this))
- (config (ede-generic-get-configuration proj)))
- (oref config c-include-path)))
-
-;;; Commands
-;;
-(defmethod project-compile-project ((proj ede-generic-project) &optional command)
- "Compile the entire current project PROJ.
-Argument COMMAND is the command to use when compiling."
- (let* ((config (ede-generic-get-configuration proj))
- (comp (oref config :build-command)))
- (compile comp)))
-
-(defmethod project-compile-target ((obj ede-generic-target) &optional command)
- "Compile the current target OBJ.
-Argument COMMAND is the command to use for compiling the target."
- (project-compile-project (ede-current-project) command))
-
-(defmethod project-debug-target ((target ede-generic-target))
- "Run the current project derived from TARGET in a debugger."
- (let* ((proj (ede-target-parent target))
- (config (ede-generic-get-configuration proj))
- (debug (oref config :debug-command))
- (cmd (read-from-minibuffer
- "Debug Command: "
- debug))
- (cmdsplit (split-string cmd " " t))
- ;; @TODO - this depends on the user always typing in something good
- ;; like "gdb" or "dbx" which also exists as a useful Emacs command.
- ;; Is there a better way?
- (cmdsym (intern-soft (car cmdsplit))))
- (call-interactively cmdsym t)))
-
-(defmethod project-run-target ((target ede-generic-target))
- "Run the current project derived from TARGET."
- (require 'ede-shell)
- (let* ((proj (ede-target-parent target))
- (config (ede-generic-get-configuration proj))
- (run (concat "./" (oref config :run-command)))
- (cmd (read-from-minibuffer "Run (like this): " run)))
- (ede-shell-run-something target cmd)))
-
-;;; Customization
-;;
-(defmethod ede-customize ((proj ede-generic-project))
- "Customize the EDE project PROJ."
- (let ((config (ede-generic-get-configuration proj)))
- (eieio-customize-object config)))
-
-(defmethod ede-customize ((target ede-generic-target))
- "Customize the EDE TARGET."
- ;; Nothing unique for the targets, use the project.
- (ede-customize-project))
-
-(defmethod eieio-done-customizing ((config ede-generic-config))
- "Called when EIEIO is done customizing the configuration object.
-We need to go back through the old buffers, and update them with
-the new configuration."
- (ede-commit config)
- ;; Loop over all the open buffers, and re-apply.
- (ede-map-targets
- (oref config project)
- (lambda (target)
- (ede-map-target-buffers
- target
- (lambda (b)
- (with-current-buffer b
- (ede-apply-target-options)))))))
-
-(defmethod ede-commit ((config ede-generic-config))
- "Commit all changes to the configuration to disk."
- (eieio-persistent-save config))
-
;;; Creating Derived Projects:
;;
;; Derived projects need an autoloader so that EDE can find the
;; different projects on disk.
-(defun ede-generic-new-autoloader (internal-name external-name
- projectfile class)
+(defun ede-generic-new-autoloader (_internal-name external-name
+ projectfile class)
"Add a new EDE Autoload instance for identifying a generic project.
-INTERNAL-NAME is a long name that identifies this project type.
-EXTERNAL-NAME is a shorter human readable name to describe the project.
+INTERNAL-NAME is obsolete and ignored.
+EXTERNAL-NAME is a human readable name to describe the project; it
+must be unique among all autoloaded projects.
PROJECTFILE is a file name that identifies a project of this type to EDE, such as
a Makefile, or SConstruct file.
CLASS is the EIEIO class that is used to track this project. It should subclass
-the class `ede-generic-project' project."
+`ede-generic-project'."
(ede-add-project-autoload
- (ede-project-autoload internal-name
- :name external-name
+ (ede-project-autoload :name external-name
:file 'ede/generic
:proj-file projectfile
+ :root-only nil
:load-type 'ede-generic-load
:class-sym class
:new-p nil
- :safe-p nil) ; @todo - could be
- ; safe if we do something
- ; about the loading of the
- ; generic config file.
+ ;; NOTE: This project type is SAFE because it handles
+ ;; the user-query before loading its config file. These
+ ;; project types are useful without the config file so
+ ;; do the safe part until the user creates a saved config
+ ;; file for it.
+ :safe-p t)
;; Generics must go at the end, since more specific types
;; can create Makefiles also.
'generic))
@@ -431,12 +284,33 @@ the class `ede-generic-project' project."
(defun ede-enable-generic-projects ()
"Enable generic project loaders."
(interactive)
- (ede-generic-new-autoloader "generic-makefile" "Make"
+ (ede-generic-new-autoloader "generic-makefile" "Generic Make"
"Makefile" 'ede-generic-makefile-project)
- (ede-generic-new-autoloader "generic-scons" "SCons"
+ (ede-generic-new-autoloader "generic-scons" "Generic SCons"
"SConstruct" 'ede-generic-scons-project)
- (ede-generic-new-autoloader "generic-cmake" "CMake"
+ (ede-generic-new-autoloader "generic-cmake" "Generic CMake"
"CMakeLists" 'ede-generic-cmake-project)
+
+ ;; Super Generic found via revision control tags.
+ (ede-generic-new-autoloader "generic-git" "Generic Git"
+ ".git" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-bzr" "Generic Bazaar"
+ ".bzr" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-hg" "Generic Mercurial"
+ ".hg" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-svn" "Generic Subversions"
+ ".svn" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-cvs" "Generic CVS"
+ "CVS" 'ede-generic-vc-project)
+ (ede-generic-new-autoloader "generic-mtn" "Generic Monotone"
+ "_MTN" 'ede-generic-vc-project)
+
+ ;; Take advantage of existing 'projectile' based projects.
+ ;; @TODO - if projectile supports compile commands etc, can we
+ ;; read that out? Howto if projectile is not part of core emacs.
+ (ede-generic-new-autoloader "generic-projectile" "Generic .projectile"
+ ".projectile" 'ede-generic-vc-project)
+
)
@@ -450,7 +324,7 @@ the class `ede-generic-project' project."
)
"Generic Project for makefiles.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config)
"Setup a configuration for Make."
(oset config build-command "make -k")
(oset config debug-command "gdb ")
@@ -463,7 +337,7 @@ the class `ede-generic-project' project."
)
"Generic Project for scons.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config)
"Setup a configuration for SCONS."
(oset config build-command "scons")
(oset config debug-command "gdb ")
@@ -476,12 +350,21 @@ the class `ede-generic-project' project."
)
"Generic Project for cmake.")
-(defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config)
"Setup a configuration for CMake."
(oset config build-command "cmake")
(oset config debug-command "gdb ")
)
+;;; Generic Version Control System
+(defclass ede-generic-vc-project (ede-generic-project)
+ ()
+ "Generic project found via Version Control files.")
+
+(cl-defmethod ede-generic-setup-configuration ((proj ede-generic-vc-project) config)
+ "Setup a configuration for projects identified by revision control."
+ )
+
(provide 'ede/generic)
;; Local variables:
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 728d27e4460..edfa3640bd4 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -1,6 +1,6 @@
;;; ede/linux.el --- Special project for Linux
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -32,6 +32,8 @@
;; * Add texinfo lookup options.
;; * Add website
+(eval-when-compile (require 'cl))
+
(require 'ede)
(require 'ede/make)
@@ -46,6 +48,21 @@
:group 'ede
:version "24.3")
+(defcustom project-linux-build-directory-default 'ask
+ "Build directory."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (const :tag "Same as source directory" same)
+ (const :tag "Ask the user" ask)))
+
+(defcustom project-linux-architecture-default 'ask
+ "Target architecture to assume when not auto-detected."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (string :tag "Architecture name")
+ (const :tag "Ask the user" ask)))
+
+
(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
"*Default command used to compile a target."
:group 'project-linux
@@ -56,37 +73,6 @@
:group 'project-linux
:type 'string)
-(defvar ede-linux-project-list nil
- "List of projects created by option `ede-linux-project'.")
-
-(defun ede-linux-file-existing (dir)
- "Find a Linux project in the list of Linux projects.
-DIR is the directory to search from."
- (let ((projs ede-linux-project-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root)) dir)
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-
-;;;###autoload
-(defun ede-linux-project-root (&optional dir)
- "Get the root directory for DIR."
- (when (not dir) (setq dir default-directory))
- (let ((case-fold-search t)
- (proj (ede-linux-file-existing dir)))
- (if proj
- (ede-up-directory (file-name-directory
- (oref proj :file)))
- ;; No pre-existing project. Let's take a wild-guess if we have
- ;; an Linux project here.
- (when (string-match "linux[^/]*" dir)
- (let ((base (substring dir 0 (match-end 0))))
- (when (file-exists-p (expand-file-name "scripts/ver_linux" base))
- base))))))
-
(defun ede-linux-version (dir)
"Find the Linux version for the Linux src in DIR."
(let ((buff (get-buffer-create " *linux-query*")))
@@ -107,42 +93,131 @@ DIR is the directory to search from."
(kill-buffer buff)
)))))
-(defclass ede-linux-project (ede-project eieio-instance-tracker)
- ((tracking-symbol :initform 'ede-linux-project-list)
- )
+(defclass ede-linux-project (ede-project)
+ ((build-directory :initarg :build-directory
+ :type string
+ :documentation "Build directory.")
+ (architecture :initarg :architecture
+ :type string
+ :documentation "Target architecture.")
+ (include-path :initarg :include-path
+ :type list
+ :documentation "Include directories.
+Contains both common and target architecture-specific directories."))
"Project Type for the Linux source code."
:method-invocation-order :depth-first)
+
+(defun ede-linux--get-build-directory (dir)
+ "Detect build directory for sources in DIR.
+If DIR has not been used as a build directory, fall back to
+`project-linux-build-directory-default'."
+ (or
+ ;; detected build on source directory
+ (and (file-exists-p (expand-file-name ".config" dir)) dir)
+ ;; use configuration
+ (case project-linux-build-directory-default
+ (same dir)
+ (ask (read-directory-name "Select Linux' build directory: " dir)))))
+
+
+(defun ede-linux--get-archs (dir)
+ "Returns a list of architecture names found in DIR."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ archs)
+ (when (file-directory-p archs-dir)
+ (mapc (lambda (elem)
+ (when (and
+ (not (string= elem "."))
+ (not (string= elem ".."))
+ (not (string= elem "x86_64")) ; has no separate sources
+ (file-directory-p
+ (expand-file-name elem archs-dir)))
+ (add-to-list 'archs elem t)))
+ (directory-files archs-dir)))
+ archs))
+
+
+(defun ede-linux--detect-architecture (dir)
+ "Try to auto-detect the architecture as configured in DIR.
+DIR is Linux' build directory. If it cannot be auto-detected,
+returns `project-linux-architecture-default'."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ (archs (ede-linux--get-archs dir))
+ arch found)
+ (or (and
+ archs
+ ;; Look for /arch/<arch>/include/generated
+ (progn
+ (while (and archs (not found))
+ (setq arch (car archs))
+ (when (file-directory-p
+ (expand-file-name (concat arch "/include/generated")
+ archs-dir))
+ (setq found arch))
+ (setq archs (cdr archs)))
+ found))
+ project-linux-architecture-default)))
+
+(defun ede-linux--get-architecture (dir bdir)
+ "Try to auto-detect the architecture as configured in BDIR.
+Uses `ede-linux--detect-architecture' for the auto-detection. If
+the result is `ask', let the user choose from architectures found
+in DIR."
+ (let ((arch (ede-linux--detect-architecture bdir)))
+ (case arch
+ (ask
+ (completing-read "Select target architecture: "
+ (ede-linux--get-archs dir)))
+ (t arch))))
+
+
+(defun ede-linux--include-path (dir bdir arch)
+ "Returns a list with include directories.
+Returned directories might not exist, since they are not created
+until Linux is built for the first time."
+ (map 'list
+ (lambda (elem) (format (concat (car elem) "/" (cdr elem)) arch))
+ ;; XXX: taken from the output of "make V=1"
+ (list (cons dir "arch/%s/include")
+ (cons bdir "arch/%s/include/generated")
+ (cons dir "include")
+ (cons bdir "include")
+ (cons dir "arch/%s/include/uapi")
+ (cons bdir "arch/%s/include/generated/uapi")
+ (cons dir "include/uapi")
+ (cons bdir "include/generated/uapi"))))
+
;;;###autoload
-(defun ede-linux-load (dir &optional rootproj)
+(defun ede-linux-load (dir &optional _rootproj)
"Return an Linux Project object if there is a match.
Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
- (or (ede-linux-file-existing dir)
- ;; Doesn't already exist, so let's make one.
- (let ((proj (ede-linux-project
- "Linux"
- :name "Linux"
- :version (ede-linux-version dir)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "scripts/ver_linux"
- dir))))
- (ede-add-project-to-global-list proj))
- ))
+ ;; Doesn't already exist, so let's make one.
+ (let* ((bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (include-path (ede-linux--include-path dir bdir arch)))
+ (make-instance 'ede-linux-project
+ :name "Linux"
+ :version (ede-linux-version dir)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "scripts/ver_linux"
+ dir)
+ :build-directory bdir
+ :architecture arch
+ :include-path include-path)))
;;;###autoload
(ede-add-project-autoload
- (ede-project-autoload "linux"
- :name "LINUX ROOT"
- :file 'ede/linux
- :proj-file "scripts/ver_linux"
- :proj-root-dirmatch "linux[^/]*"
- :proj-root 'ede-linux-project-root
- :load-type 'ede-linux-load
- :class-sym 'ede-linux-project
- :new-p nil
- :safe-p t)
+ (make-instance 'ede-project-autoload
+ :name "LINUX ROOT"
+ :file 'ede/linux
+ :proj-file "scripts/ver_linux"
+ :load-type 'ede-linux-load
+ :class-sym 'ede-linux-project
+ :new-p nil
+ :safe-p t)
'unique)
(defclass ede-linux-target-c (ede-target)
@@ -155,26 +230,26 @@ All directories need at least one target.")
"EDE Linux Project target for Misc files.
All directories need at least one target.")
-(defmethod initialize-instance ((this ede-linux-project)
- &rest fields)
+(cl-defmethod initialize-instance ((this ede-linux-project)
+ &rest _fields)
"Make sure the targets slot is bound."
- (call-next-method)
+ (cl-call-next-method)
(unless (slot-boundp this 'targets)
(oset this :targets nil)))
;;; File Stuff
;;
-(defmethod ede-project-root-directory ((this ede-linux-project)
- &optional file)
+(cl-defmethod ede-project-root-directory ((this ede-linux-project)
+ &optional _file)
"Return the root for THIS Linux project with file."
(ede-up-directory (file-name-directory (oref this file))))
-(defmethod ede-project-root ((this ede-linux-project))
+(cl-defmethod ede-project-root ((this ede-linux-project))
"Return my root."
this)
-(defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
- dir)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
+ _dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
@@ -185,12 +260,12 @@ All directories need at least one target.")
(let ((match nil))
(dolist (T targets)
(when (and (object-of-class-p T class)
- (string= (oref T :path) dir))
+ (string= (oref T path) dir))
(setq match T)
))
match))
-(defmethod ede-find-target ((proj ede-linux-project) buffer)
+(cl-defmethod ede-find-target ((proj ede-linux-project) buffer)
"Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
(let* ((ext (file-name-extension (buffer-file-name buffer)))
@@ -216,7 +291,7 @@ If one doesn't exist, create a new one for this directory."
;;; UTILITIES SUPPORT.
;;
-(defmethod ede-preprocessor-map ((this ede-linux-target-c))
+(cl-defmethod ede-preprocessor-map ((this ede-linux-target-c))
"Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!"
(require 'semantic/db)
@@ -241,25 +316,32 @@ All files need the macros from lisp.h!"
(let ((F (expand-file-name name (expand-file-name subdir root))))
(when (file-exists-p F) F)))
-(defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
+(cl-defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
"Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name))
- (root (ede-project-root proj))
- (dir (ede-project-root-directory root))
- (F (cond
- ((not ext) nil)
- ((string-match "h" ext)
- (or (ede-linux-file-exists-name name dir "")
- (ede-linux-file-exists-name name dir "include"))
- )
- ((string-match "txt" ext)
- (ede-linux-file-exists-name name dir "Documentation"))
- (t nil)))
- )
- (or F (call-next-method))))
-
-(defmethod project-compile-project ((proj ede-linux-project)
+ (root (ede-project-root proj))
+ (dir (ede-project-root-directory root))
+ (bdir (oref proj build-directory))
+ (F (cond
+ ((not ext) nil)
+ ((string-match "h" ext)
+ (let ((dirs (oref proj include-path))
+ found)
+ (while (and dirs (not found))
+ (setq found
+ (or (ede-linux-file-exists-name name bdir (car dirs))
+ (ede-linux-file-exists-name name dir (car dirs))))
+ (setq dirs (cdr dirs)))
+ found))
+ ((string-match "txt" ext)
+ (ede-linux-file-exists-name name dir "Documentation"))
+ (t nil))))
+ (or F (cl-call-next-method))))
+
+;;; Command Support
+;;
+(cl-defmethod project-compile-project ((proj ede-linux-project)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -276,7 +358,7 @@ Argument COMMAND is the command to use when compiling."
(compile command)))
-(defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
+(cl-defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(let* ((proj (ede-target-parent obj))
@@ -295,6 +377,19 @@ Argument COMMAND is the command to use for compiling the target."
(compile command)))
+(cl-defmethod project-rescan ((this ede-linux-project))
+ "Rescan this Linux project from the sources."
+ (let* ((dir (ede-project-root-directory this))
+ (bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (inc (ede-linux--include-path dir bdir arch))
+ (ver (ede-linux-version dir)))
+ (oset this version ver)
+ (oset this :build-directory bdir)
+ (oset this :architecture arch)
+ (oset this :include-path inc)
+ ))
+
(provide 'ede/linux)
;; Local variables:
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index d8b29d3f0be..a076c46513c 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -1,6 +1,6 @@
;;; ede/locate.el --- Locate support
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -110,34 +110,34 @@ based on `ede-locate-setup-options'."
)
"Baseclass for LOCATE feature in EDE.")
-(defmethod initialize-instance ((loc ede-locate-base) &rest fields)
+(cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
"Make sure we have a hash table."
;; Basic setup.
- (call-next-method)
+ (cl-call-next-method)
;; Make sure we have a hash table.
(ede-locate-flush-hash loc)
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-base)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
root)
"Is it ok to use this project type under ROOT."
t)
-(defmethod ede-locate-flush-hash ((loc ede-locate-base))
+(cl-defmethod ede-locate-flush-hash ((loc ede-locate-base))
"For LOC, flush hashtable and start from scratch."
(oset loc hash (make-hash-table :test 'equal)))
-(defmethod ede-locate-file-in-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base)
filestring)
"For LOC, is the file FILESTRING in our hashtable?"
(gethash filestring (oref loc hash)))
-(defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
+(cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
filestring fullfilename)
"For LOC, add FILESTR to the hash with FULLFILENAME."
(puthash filestring fullfilename (oref loc hash)))
-(defmethod ede-locate-file-in-project ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
@@ -149,7 +149,7 @@ that created this EDE locate object."
(oset loc lastanswer ans)
ans))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
filesubstring
)
"Locate with LOC occurrences of FILESUBSTRING.
@@ -158,8 +158,8 @@ that created this EDE locate object."
nil
)
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-base) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-base)) root)
"Create or update the database for the current project.
You cannot create projects for the baseclass."
(error "Cannot create/update a database of type %S"
@@ -177,13 +177,13 @@ You cannot create projects for the baseclass."
Configure the Emacs `locate-program' variable to also
configure the use of EDE locate.")
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-locate)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
root)
"Is it ok to use this project type under ROOT."
(or (featurep 'locate) (locate-library "locate"))
)
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -220,12 +220,12 @@ that created this EDE locate object."
Configure EDE's use of GNU Global through the cedet-global.el
variable `cedet-global-command'.")
-(defmethod initialize-instance ((loc ede-locate-global)
+(cl-defmethod initialize-instance ((loc ede-locate-global)
&rest slots)
"Make sure that we can use GNU Global."
(require 'cedet-global)
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(cedet-gnu-global-version-check)
(let* ((default-directory (oref loc root))
@@ -235,7 +235,7 @@ variable `cedet-global-command'.")
(oref loc root))))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-global)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-global)
@@ -244,7 +244,7 @@ variable `cedet-global-command'.")
(newroot (cedet-gnu-global-root)))
newroot))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -253,8 +253,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root)))
(cedet-gnu-global-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-global) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-global)) root)
"Create or update the GNU Global database for the current project."
(cedet-gnu-global-create/update-database root))
@@ -272,11 +272,11 @@ that created this EDE locate object."
Configure EDE's use of IDUtils through the cedet-idutils.el
file name searching variable `cedet-idutils-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-idutils)
+(cl-defmethod initialize-instance ((loc ede-locate-idutils)
&rest slots)
"Make sure that we can use IDUtils."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-idutils)
(cedet-idutils-version-check)
@@ -285,7 +285,7 @@ file name searching variable `cedet-idutils-file-command'.")
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-idutils)
@@ -293,7 +293,7 @@ file name searching variable `cedet-idutils-file-command'.")
(when (cedet-idutils-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -302,8 +302,8 @@ that created this EDE locate object."
(let ((default-directory (oref loc root)))
(cedet-idutils-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-idutils) root)
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-idutils)) root)
"Create or update the GNU Global database for the current project."
(cedet-idutils-create/update-database root))
@@ -321,11 +321,11 @@ that created this EDE locate object."
Configure EDE's use of Cscope through the cedet-cscope.el
file name searching variable `cedet-cscope-file-command'.")
-(defmethod initialize-instance ((loc ede-locate-cscope)
+(cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest slots)
"Make sure that we can use Cscope."
;; Get ourselves initialized.
- (call-next-method)
+ (cl-call-next-method)
;; Do the checks.
(require 'cedet-cscope)
(cedet-cscope-version-check)
@@ -334,7 +334,7 @@ file name searching variable `cedet-cscope-file-command'.")
(oref loc root)))
)
-(defmethod ede-locate-ok-in-project :static ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
root)
"Is it ok to use this project type under ROOT."
(require 'cedet-cscope)
@@ -342,7 +342,7 @@ file name searching variable `cedet-cscope-file-command'.")
(when (cedet-cscope-support-for-directory root)
root))
-(defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
+(cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
filesubstring)
"Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
Searches are done under the current root of the EDE project
@@ -351,9 +351,9 @@ that created this EDE locate object."
(require 'cedet-cscope)
(cedet-cscope-expand-filename filesubstring)))
-(defmethod ede-locate-create/update-root-database :STATIC
- ((loc ede-locate-cscope) root)
- "Create or update the GNU Global database for the current project."
+(cl-defmethod ede-locate-create/update-root-database
+ ((loc (subclass ede-locate-cscope)) root)
+ "Create or update the Cscope database for the current project."
(require 'cedet-cscope)
(cedet-cscope-create/update-database root))
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index dbfdd89e451..6545bb305fa 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -1,6 +1,6 @@
;;; ede/make.el --- General information about "make"
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index d2425314fc7..e848d45dcb5 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -1,6 +1,6 @@
;;; makefile-edit.el --- Makefile editing/scanning commands.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index a29e3720ea2..664e91da2e9 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -1,6 +1,6 @@
;;; ede/pconf.el --- configure.ac maintenance for EDE
-;;; Copyright (C) 1998-2000, 2005, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -31,16 +31,16 @@
(defvar ede-pconf-create-file-query 'ask
"Controls if queries are made while creating project files.
-A value of 'ask means to always ask the user before creating
-a file, such as AUTHORS. A value of 'never means don't ask, and
+A value of `ask' means to always ask the user before creating
+a file, such as AUTHORS. A value of `never' means don't ask, and
don't do it. A value of nil means to just do it.")
;;; Code:
-(defmethod ede-proj-configure-file ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-file ((this ede-proj-project))
"The configure.ac script used by project THIS."
(ede-expand-filename (ede-toplevel this) "configure.ac" t))
-(defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
+(cl-defmethod ede-proj-configure-test-required-file ((this ede-proj-project) file)
"For project THIS, test that the file FILE exists, or create it."
(let ((f (ede-expand-filename (ede-toplevel this) file t)))
(when (not (file-exists-p f))
@@ -60,7 +60,7 @@ don't do it. A value of nil means to just do it.")
(error "Quit")))))))
-(defmethod ede-proj-configure-synchronize ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project))
"Synchronize what we know about project THIS into configure.ac."
(let ((b (find-file-noselect (ede-proj-configure-file this)))
;;(td (file-name-directory (ede-proj-configure-file this)))
@@ -93,14 +93,14 @@ don't do it. A value of nil means to just do it.")
(ede-map-all-subprojects
this
(lambda (sp)
- (ede-map-targets sp 'ede-proj-flush-autoconf)))
+ (ede-map-targets sp #'ede-proj-flush-autoconf)))
(ede-map-all-subprojects
this
(lambda (sp)
- (ede-map-targets this 'ede-proj-tweak-autoconf)))
+ (ede-map-targets this #'ede-proj-tweak-autoconf)))
;; Now save
(save-buffer)
- (setq postcmd "autoreconf -i;")
+ (setq postcmd "autoreconf -f -i;")
;; Verify a bunch of files that are required by automake.
(ede-proj-configure-test-required-file this "AUTHORS")
@@ -149,7 +149,7 @@ don't do it. A value of nil means to just do it.")
))))
-(defmethod ede-proj-configure-recreate ((this ede-proj-project))
+(cl-defmethod ede-proj-configure-recreate ((this ede-proj-project))
"Delete project THIS's configure script and start over."
(if (not (ede-proj-configure-file this))
(error "Could not determine configure.ac for %S" (eieio-object-name this)))
@@ -159,7 +159,7 @@ don't do it. A value of nil means to just do it.")
(if b (kill-buffer b)))
(ede-proj-configure-synchronize this))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target))
"Tweak the configure file (current buffer) to accommodate THIS."
;; Check the compilers belonging to THIS, and call the autoconf
;; setup for those compilers.
@@ -167,18 +167,21 @@ don't do it. A value of nil means to just do it.")
(mapc 'ede-proj-tweak-autoconf (ede-proj-linkers this))
)
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target))
"Flush the configure file (current buffer) to accommodate THIS.
By flushing, remove any cruft that may be in the file. Subsequent
calls to `ede-proj-tweak-autoconf' can restore items removed by flush."
nil)
-(defmethod ede-proj-configure-add-missing ((this ede-proj-target))
+
+;; @TODO - No-one calls this ???
+(cl-defmethod ede-proj-configure-add-missing ((this ede-proj-target))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
nil)
-(defmethod ede-proj-configure-create-missing ((this ede-proj-target))
+;; @TODO - No-one implements this yet.
+(cl-defmethod ede-proj-configure-create-missing ((this ede-proj-target))
"Add any missing files for THIS by creating them."
nil)
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 0328606b028..b494e27dc31 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -1,6 +1,6 @@
;;; ede-pmake.el --- EDE Generic Project Makefile code generator.
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -52,7 +52,7 @@
(declare-function ede-srecode-insert "ede/srecode")
;;; Code:
-(defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS.
MFILENAME is the makefile to generate."
(require 'ede/srecode)
@@ -284,26 +284,26 @@ Change . to _ in the variable name."
(setq name (replace-match "_" nil t name)))
name))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_YOU_FOUND_A_BUG"))
;;; DEPENDENCY FILE GENERATOR LISTS
;;
-(defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-dependency-files ((this ede-proj-target))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
nil)
;;; GENERIC VARIABLES
;;
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-project)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables-new ((this ede-proj-project))
"Insert variables needed by target THIS.
NOTE: Not yet in use! This is part of an SRecode conversion of
@@ -358,7 +358,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
; ))
)
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-project))
"Insert variables needed by target THIS."
(let ((conf-table (ede-proj-makefile-configuration-variables
this (oref this configuration-default)))
@@ -392,7 +392,7 @@ NOTE: Not yet in use! This is part of an SRecode conversion of
(insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " "
(file-name-nondirectory (ede-proj-dist-makefile this)) "\n"))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target)
&optional
moresource)
"Insert the source variables needed by THIS.
@@ -406,7 +406,7 @@ sources variable."
(if moresource
(insert " \\\n " (mapconcat (lambda (a) a) moresource " ") "")))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target) &optional
moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
@@ -414,18 +414,18 @@ sources variable."
(ede-proj-makefile-insert-source-variables this moresource)
)
-(defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-configuration-variables ((this ede-proj-target-makefile)
configuration)
"Return a list of configuration variables from THIS.
Use CONFIGURATION as the current configuration to query."
(cdr (assoc configuration (oref this configuration-variables))))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
- (call-next-method)
+ (cl-call-next-method)
(let* ((proj (ede-target-parent this))
(conf-table (ede-proj-makefile-configuration-variables
this (oref proj configuration-default)))
@@ -449,19 +449,19 @@ sources variable."
(ede-linker-only-once linker
(ede-proj-makefile-insert-variables linker)))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am before SOURCES."
nil)
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target))
"Insert variables needed by target THIS in Makefile.am after SOURCES."
nil)
;;; GARBAGE PATTERNS
;;
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-project))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
(let ((mc (ede-map-targets
@@ -476,7 +476,7 @@ These are removed with make clean."
(setq mc (cdr mc)))
(nreverse uniq)))
-(defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-garbage-patterns ((this ede-proj-target))
"Return a list of patterns that are considered garbage to THIS.
These are removed with make clean."
;; Get the source object from THIS, and use the specified garbage.
@@ -490,7 +490,7 @@ These are removed with make clean."
;;; RULES
;;
-(defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-subproj-rules ((this ede-proj-project))
"Insert a rule for the project THIS which should be a subproject."
(insert ".PHONY:" (ede-name this))
(newline)
@@ -501,29 +501,29 @@ These are removed with make clean."
(newline)
)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-project))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this inference-rules))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-project))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the project that should insert stuff."
(mapc 'ede-proj-makefile-insert-dist-dependencies (oref this targets))
)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
nil)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target))
"Insert any symbols that the DIST rule should depend on.
Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-dist-dependencies this)
)
-(defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-subdirs ((this ede-proj-project))
"Insert a SUBDIRS variable for Automake."
(proj-comp-insert-variable-once "SUBDIRS"
(ede-map-subprojects
@@ -531,11 +531,11 @@ Argument THIS is the target that should insert stuff."
(insert " " (ede-subproject-relative-path sproj))
))))
-(defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-automake-insert-extradist ((this ede-proj-project))
"Insert the EXTRADIST variable entries needed for Automake and EDE."
(proj-comp-insert-variable-once "EXTRA_DIST" (insert "Project.ede")))
-(defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-dist-rules ((this ede-proj-project))
"Insert distribution rules for THIS in a Makefile, such as CLEAN and DIST."
(let ((junk (ede-proj-makefile-garbage-patterns this))
tmp)
@@ -598,15 +598,16 @@ Argument THIS is the target that should insert stuff."
"\t@echo Makefile is out of date! "
"It needs to be regenerated by EDE.\n"
"\t@echo If you have not modified Project.ede, you can"
- " use 'touch' to update the Makefile time stamp.\n"
+ (format-message
+ " use `touch' to update the Makefile time stamp.\n")
"\t@false\n\n"
"\n\n# End of Makefile\n")))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target))
"Insert rules needed by THIS target."
nil)
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile))
"Insert rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules))
(let ((c (ede-proj-compilers this)))
@@ -619,7 +620,7 @@ Argument THIS is the target that should insert stuff."
(ede-proj-makefile-insert-commands this)
)))
-(defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-proj-target-makefile))
"Insert the commands needed by target THIS.
For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-compilers this))
@@ -627,18 +628,18 @@ For targets, insert the commands needed by the chosen compiler."
(mapc 'ede-proj-makefile-insert-commands (ede-proj-linkers this))))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-project))
"Insert user specified rules needed by THIS target.
This is different from `ede-proj-makefile-insert-rules' in that this
function won't create the building rules which are auto created with
automake."
(mapc 'ede-proj-makefile-insert-user-rules (oref this inference-rules)))
-(defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-insert-user-rules ((this ede-proj-target))
"Insert user specified rules needed by THIS target."
(mapc 'ede-proj-makefile-insert-rules (oref this rules)))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-makefile))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -667,7 +668,7 @@ This allows customization of how these elements appear."
out))))
;; Tags
-(defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
+(cl-defmethod ede-proj-makefile-tags ((this ede-proj-project) targets)
"Insert into the current location rules to make recursive TAGS files.
Argument THIS is the project to create tags for.
Argument TARGETS are the targets we should depend on for TAGS."
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 3d708622f05..8aa5477cea5 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -1,6 +1,6 @@
;;; ede/proj-archive.el --- EDE Generic Project archive support
-;; Copyright (C) 1998-2001, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -43,7 +43,7 @@
:objectextention "")
"Linker object for creating an archive.")
-(defmethod ede-proj-makefile-insert-source-variables :BEFORE
+(cl-defmethod ede-proj-makefile-insert-source-variables :before
((this ede-proj-target-makefile-archive) &optional moresource)
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
@@ -52,11 +52,11 @@ Makefile.am generator, so use it to add this important bin program."
(concat "lib" (ede-name this) "_a_LIBRARIES")
(insert (concat "lib" (ede-name this) ".a"))))
-(defmethod ede-proj-makefile-garbage-patterns
+(cl-defmethod ede-proj-makefile-garbage-patterns
((this ede-proj-target-makefile-archive))
"Add archive name to the garbage patterns.
-This makes sure that the archive is removed with 'make clean'."
- (let ((garb (call-next-method)))
+This makes sure that the archive is removed with `make clean'."
+ (let ((garb (cl-call-next-method)))
(append garb (list (concat "lib" (ede-name this) ".a")))))
(provide 'ede/proj-archive)
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index 628416449f5..0e76cda1986 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -1,6 +1,6 @@
;;; ede/proj-aux.el --- EDE Generic Project auxiliary file support
-;; Copyright (C) 1998-2000, 2007, 2009-2013 Free Software Foundation,
+;; Copyright (C) 1998-2000, 2007, 2009-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -39,7 +39,7 @@
:sourcepattern "^[A-Z]+$\\|\\.txt$")
"Miscellaneous fields definition.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-aux))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_AUX"))
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index fa7902e84d1..87eae6cb1c0 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -1,6 +1,6 @@
;;; ede/proj-comp.el --- EDE Generic Project compiler/rule driver
-;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2013 Free Software
+;; Copyright (C) 1999-2001, 2004-2005, 2007, 2009-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -173,12 +173,12 @@ Adds this rule to a .PHONY list."))
This is used when creating a Makefile to prevent duplicate variables and
rules from being created.")
-(defmethod initialize-instance :AFTER ((this ede-compiler) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-compiler) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(add-to-list 'ede-compiler-list this))
-(defmethod initialize-instance :AFTER ((this ede-linker) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-linker) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-linker-list'."
(add-to-list 'ede-linker-list this))
@@ -218,7 +218,7 @@ This will prevent rules from creating duplicate variables or rules."
(def-edebug-spec ede-pmake-insert-variable-shared (form def-body))
))
-;;; Querys
+;;; Queries
(defun ede-proj-find-compiler (compilers sourcetype)
"Return a compiler from the list COMPILERS that will compile SOURCETYPE."
(while (and compilers
@@ -235,7 +235,7 @@ This will prevent rules from creating duplicate variables or rules."
(car-safe linkers))
;;; Methods:
-(defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-compilation-program))
"Tweak the configure file (current buffer) to accommodate THIS."
(mapcar
(lambda (obj)
@@ -247,7 +247,7 @@ This will prevent rules from creating duplicate variables or rules."
)
(oref this autoconf)))
-(defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-compilation-program))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
@@ -263,7 +263,7 @@ Execute BODY in a location where a value can be placed."
))
(put 'proj-comp-insert-variable-once 'lisp-indent-function 1)
-(defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-compilation-program))
"Insert variables needed by the compiler THIS."
(if (eieio-instance-inheritor-slot-boundp this 'variables)
(with-slots (variables) this
@@ -276,19 +276,19 @@ Execute BODY in a location where a value can be placed."
(insert cd)))))
variables))))
-(defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
+(cl-defmethod ede-compiler-intermediate-objects-p ((this ede-compiler))
"Return non-nil if THIS has intermediate object files.
If this compiler creates code that can be linked together,
then the object files created by the compiler are considered intermediate."
(oref this uselinker))
-(defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
+(cl-defmethod ede-compiler-intermediate-object-variable ((this ede-compiler)
targetname)
"Return a string based on THIS representing a make object variable.
TARGETNAME is the name of the target that these objects belong to."
(concat targetname "_OBJ"))
-(defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
+(cl-defmethod ede-proj-makefile-insert-object-variables ((this ede-compiler)
targetname sourcefiles)
"Insert an OBJ variable to specify object code to be generated for THIS.
The name of the target is TARGETNAME as a string. SOURCEFILES is the list of
@@ -312,19 +312,19 @@ Not all compilers do this."
sourcefiles)
(insert "\n")))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-compilation-program))
"Insert rules needed for THIS compiler object."
(ede-compiler-only-once this
(mapc 'ede-proj-makefile-insert-rules (oref this rules))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-makefile-rule))
"Insert rules needed for THIS rule object."
(if (oref this phony) (insert ".PHONY: " (oref this target) "\n"))
(insert (oref this target) ": " (oref this dependencies) "\n\t"
(mapconcat (lambda (c) c) (oref this rules) "\n\t")
"\n\n"))
-(defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
+(cl-defmethod ede-proj-makefile-insert-commands ((this ede-compilation-program))
"Insert the commands needed to use compiler THIS.
The object creating makefile rules must call this method for the
compiler it decides to use after inserting in the rule."
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index d7720f25681..778d485c44c 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -1,6 +1,6 @@
;;; ede-proj-elisp.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -57,7 +57,7 @@ Each package's directory should also appear in :aux-packages via a package name.
"This target consists of a group of lisp files.
A lisp target may be one general program with many separate lisp files in it.")
-(defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this ede-proj-target-elisp))
"Insert rules needed by THIS target.
This inserts the PRELOADS target-local variable."
(let ((preloads (oref this pre-load-packages)))
@@ -67,7 +67,7 @@ This inserts the PRELOADS target-local variable."
(mapconcat 'identity preloads " ")))))
(insert "\n"))
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -109,7 +109,7 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs with XEmacs.")
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match "\\.elc$" (buffer-file-name buffer))
@@ -121,7 +121,7 @@ Lays claim to all .elc files that match .el files in this target."
;; Is this in our list.
(member fname (oref this auxsource))
)
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;;; Emacs Lisp Compiler
@@ -145,7 +145,7 @@ Lays claim to all .elc files that match .el files in this target."
packages (cdr packages))))
paths))
-(defmethod project-compile-target ((obj ede-proj-target-elisp))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp))
"Compile all sources in a Lisp target OBJ.
Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(let* ((proj (ede-target-parent obj))
@@ -173,7 +173,7 @@ Bonus: Return a cons cell: (COMPILED . UPTODATE)."
(message "All Emacs Lisp sources are up to date in %s" (eieio-object-name obj))
(cons comp utd)))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
@@ -195,12 +195,12 @@ is found, such as a `-version' variable, or the standard header."
(insert version)))))
(setq vs (cdr vs)))
;; The next method will include comments such as "Version:"
- (call-next-method))))
+ (cl-call-next-method))))
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p) '("lisp_LISP" . share))
(t (concat (ede-pmake-varname this) "_LISP"))))
@@ -219,7 +219,7 @@ is found, such as a `-version' variable, or the standard header."
(setq items (cdr items)))))
))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp))
"Insert variables needed by target THIS."
(let ((newitems (if (oref this aux-packages)
(ede-proj-elisp-packages-to-loadpath
@@ -244,9 +244,9 @@ is found, such as a `-version' variable, or the standard header."
)
(error "Don't know how to update load path"))))
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp))
"Tweak the configure file (current buffer) to accommodate THIS."
- (call-next-method)
+ (cl-call-next-method)
;; Ok, now we have to tweak the autoconf provided `elisp-comp' program.
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
(enable-local-variables nil))
@@ -255,7 +255,7 @@ is found, such as a `-version' variable, or the standard header."
(save-excursion
(if (file-symlink-p ec)
(progn
- ;; Desymlinkify
+ ;; Change symlinks to copies.
(rename-file ec (concat ec ".tmp"))
(copy-file (concat ec ".tmp") ec)
(delete-file (concat ec ".tmp"))))
@@ -267,9 +267,10 @@ is found, such as a `-version' variable, or the standard header."
(while paths
(ede-proj-elisp-add-path (car paths))
(setq paths (cdr paths))))
- (save-buffer)) )))
+ (save-buffer)
+ (kill-buffer)))))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp))
"Flush the configure file (current buffer) to accommodate THIS."
;; Remove crufty old paths from elisp-compile
(let ((ec (ede-expand-filename this "elisp-comp" 'newfile))
@@ -310,14 +311,14 @@ Files do not need to be added to this target.")
;;; Claiming files
-(defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target-elisp-autoloads) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all .elc files that match .el files in this target."
(if (string-match
(concat (regexp-quote (oref this autoload-file)) "$")
(buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
;; Compilers
@@ -337,7 +338,7 @@ Lays claim to all .elc files that match .el files in this target."
)
"Build an autoloads file.")
-(defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target-elisp-autoloads))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, get the car of the compilers list."
(let ((comp (oref obj compiler)))
@@ -350,7 +351,7 @@ If the `compiler' slot is empty, get the car of the compilers list."
(setq comp (list (car avail)))))
comp))
-(defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
+(cl-defmethod ede-proj-makefile-insert-source-variables ((this ede-proj-target-elisp-autoloads)
&optional
moresource)
"Insert the source variables needed by THIS.
@@ -358,16 +359,16 @@ Optional argument MORESOURCE is a list of additional sources to add to the
sources variable."
nil)
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-elisp-autoloads))
"Return the variable name for THIS's sources."
nil) ; "LOADDEFS")
-(defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-dependencies ((this ede-proj-target-elisp-autoloads))
"Return a string representing the dependencies for THIS.
Always return an empty string for an autoloads generator."
"")
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this ede-proj-target-elisp-autoloads))
"Insert variables needed by target THIS."
(ede-pmake-insert-variable-shared "LOADDEFS"
(insert (oref this autoload-file)))
@@ -377,7 +378,7 @@ Always return an empty string for an autoloads generator."
" ")))
)
-(defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
+(cl-defmethod project-compile-target ((obj ede-proj-target-elisp-autoloads))
"Create or update the autoload target."
(require 'cedet-autogen)
(let ((default-directory (ede-expand-filename obj ".")))
@@ -386,13 +387,13 @@ Always return an empty string for an autoloads generator."
(oref obj autoload-dirs))
))
-(defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
+(cl-defmethod ede-update-version-in-source ((this ede-proj-target-elisp-autoloads) version)
"In a Lisp file, updated a version string for THIS to VERSION.
There are standards in Elisp files specifying how the version string
is found, such as a `-version' variable, or the standard header."
nil)
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should depend on.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
@@ -401,18 +402,18 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-elisp-autoloads))
"Insert any symbols that the DIST rule should distribute.
Emacs Lisp autoload files ship the generated .el files.
Argument THIS is the target which needs to insert an info file."
(insert " " (oref this autoload-file))
)
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-elisp-autoloads))
"Tweak the configure file (current buffer) to accommodate THIS."
(error "Autoloads not supported in autoconf yet"))
-(defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
+(cl-defmethod ede-proj-flush-autoconf ((this ede-proj-target-elisp-autoloads))
"Flush the configure file (current buffer) to accommodate THIS."
nil)
diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el
index 10c32040ed4..a5031ae8758 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -1,6 +1,6 @@
;;; ede-proj-info.el --- EDE Generic Project texinfo support
-;;; Copyright (C) 1998-2001, 2004, 2007-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2001, 2004, 2007-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -72,17 +72,17 @@ All other sources should be included independently."))
;;; Makefile generation
;;
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-info))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (ede-expand-filename (ede-toplevel) "texinfo.tex")))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-info))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_TEXINFOS"))
-(defmethod ede-proj-makefile-insert-source-variables
+(cl-defmethod ede-proj-makefile-insert-source-variables
((this ede-proj-target-makefile-info) &optional moresource)
"Insert the source variables needed by THIS info target.
Optional argument MORESOURCE is a list of additional sources to add to the
@@ -90,7 +90,7 @@ sources variable.
Does the usual for Makefile mode, but splits source into two variables
when working in Automake mode."
(if (not (ede-proj-automake-p))
- (call-next-method)
+ (cl-call-next-method)
(let* ((sv (ede-proj-makefile-sourcevar this))
(src (copy-sequence (oref this source)))
(menu (or (oref this menu) (car src))))
@@ -119,7 +119,7 @@ when working in Automake mode."
(kill-buffer buffer))
info))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-info))
"Return the name of the main target for THIS target."
;; The target should be the main-menu file name translated to .info.
(let* ((source (if (not (string= (oref this mainmenu) ""))
@@ -128,7 +128,7 @@ when working in Automake mode."
(info (ede-makeinfo-find-info-filename source)))
(concat (or info (file-name-sans-extension source)) ".info")))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
@@ -137,7 +137,7 @@ Argument THIS is the target which needs to insert an info file."
(insert " " (ede-proj-makefile-target-name this))
)
-(defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-proj-makefile-insert-dist-filepatterns ((this ede-proj-target-makefile-info))
"Insert any symbols that the DIST rule should depend on.
Texinfo files want to insert generated `.info' files.
Argument THIS is the target which needs to insert an info file."
@@ -151,7 +151,7 @@ Argument THIS is the target which needs to insert an info file."
; n
; (concat n ".info"))))
-(defmethod object-write ((this ede-proj-target-makefile-info))
+(cl-defmethod object-write ((this ede-proj-target-makefile-info))
"Before committing any change to THIS, make sure the mainmenu is first."
(let ((mm (oref this mainmenu))
(s (oref this source))
@@ -161,9 +161,9 @@ Argument THIS is the target which needs to insert an info file."
;; Make sure that MM is first in the list of items.
(setq nl (cons mm (delq mm s)))
(oset this source nl)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-documentation ((this ede-proj-target-makefile-info))
+(cl-defmethod ede-documentation ((this ede-proj-target-makefile-info))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index badd507d954..c04c9bd78cc 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -1,6 +1,6 @@
;;; ede-proj-misc.el --- EDE Generic Project Emacs Lisp support
-;; Copyright (C) 1998-2001, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2001, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -65,11 +65,11 @@ All listed sources are included in the distribution.")
)
"Compile code via a sub-makefile.")
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-miscelaneous))
"Return the variable name for THIS's sources."
(concat (ede-pmake-varname this) "_MISC"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-miscelaneous))
"Return a list of files which THIS target depends on."
(with-slots (submakefile) this
@@ -79,7 +79,7 @@ All listed sources are included in the distribution.")
nil)
(t (list submakefile)))))
-(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
+(cl-defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-miscelaneous))
"Create the make rule needed to create an archive for THIS."
;; DO NOT call the next method. We will never have any compilers,
;; or any dependencies, or stuff like this. This rule will let us
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index 895929f5321..34e302d3d2c 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -1,6 +1,6 @@
;;; ede/proj-obj.el --- EDE Generic Project Object code generation support
-;;; Copyright (C) 1998-2000, 2005, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 1998-2000, 2005, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -126,7 +126,7 @@ file.")
(defvar ede-source-c++
(ede-sourcecode "ede-source-c++"
:name "C++"
- :sourcepattern "\\.\\(c\\(pp?\\|c\\|xx\\|++\\)\\|C\\\(PP\\)?\\)$"
+ :sourcepattern "\\.\\(c\\(pp?\\|c\\|xx\\|++\\)\\|C\\(PP\\)?\\)$"
:auxsourcepattern "\\.\\(hpp?\\|hh?\\|hxx\\|H\\)$"
:garbagepattern '("*.o" "*.obj" ".deps/*.P" ".lo"))
"C++ source code definition.")
@@ -275,9 +275,9 @@ No garbage pattern since it creates C or C++ code.")
;;; The EDE object compiler
;;
-(defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-object-compiler))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(if (eieio-instance-inheritor-slot-boundp this 'dependencyvar)
(with-slots (dependencyvar) this
(insert (car dependencyvar) "=")
@@ -289,30 +289,30 @@ No garbage pattern since it creates C or C++ code.")
;;; EDE Object target type methods
;;
-(defmethod ede-proj-makefile-sourcevar
+(cl-defmethod ede-proj-makefile-sourcevar
((this ede-proj-target-makefile-objectcode))
"Return the variable name for THIS's sources."
(require 'ede/pmake)
(concat (ede-pmake-varname this) "_SOURCES"))
-(defmethod ede-proj-makefile-dependency-files
+(cl-defmethod ede-proj-makefile-dependency-files
((this ede-proj-target-makefile-objectcode))
"Return a list of source files to convert to dependencies.
Argument THIS is the target to get sources from."
(append (oref this source) (oref this auxsource)))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-objectcode)
&optional moresource)
"Insert variables needed by target THIS.
Optional argument MORESOURCE is not used."
(let ((ede-proj-objectcode-dodependencies
(oref (ede-target-parent this) automatic-dependencies)))
- (call-next-method)))
+ (cl-call-next-method)))
-(defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
+(cl-defmethod ede-buffer-header-file((this ede-proj-target-makefile-objectcode)
buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
;; Ok, nothing obvious. Try looking in ourselves.
(let ((h (oref this auxsource)))
;; Add more logic here when the problem is better understood.
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index c109833b72d..a59317cf99a 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -1,6 +1,6 @@
;;; ede-proj-prog.el --- EDE Generic Project program support
-;; Copyright (C) 1998-2001, 2005, 2008-2013 Free Software Foundation,
+;; Copyright (C) 1998-2001, 2005, 2008-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -62,21 +62,21 @@ specified with ldlibs.")
"Libraries, such as \"m\" or \"Xt\" which this program depends on.
The linker flag \"-l\" is automatically prepended. Do not include a \"lib\"
prefix, or a \".so\" suffix.
-Use the 'ldflags' slot to specify where in-project libraries might be.
+Use the `ldflags' slot to specify where in-project libraries might be.
Note: Currently only used for Automake projects."
)
)
"This target is an executable program.")
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared "bin_PROGRAMS"
(insert (ede-name this)))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-program))
"Insert bin_PROGRAMS variables needed by target THIS."
(ede-pmake-insert-variable-shared
@@ -86,11 +86,11 @@ Note: Currently only used for Automake projects."
(when (oref this ldlibs)
(mapc (lambda (d) (insert " -l" d)) (oref this ldlibs)))
)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
+(cl-defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program))
"Insert variables needed by the compiler THIS."
- (call-next-method)
+ (cl-call-next-method)
(let ((lf (mapconcat 'identity (oref this ldflags) " ")))
(with-slots (ldlibs) this
(if ldlibs
@@ -100,7 +100,7 @@ Note: Currently only used for Automake projects."
(when (and lf (not (string= "" lf)))
(ede-pmake-insert-variable-once "LDDEPS" (insert lf)))))
-(defmethod project-debug-target ((obj ede-proj-target-makefile-program))
+(cl-defmethod project-debug-target ((obj ede-proj-target-makefile-program))
"Debug a program target OBJ."
(let ((tb (get-buffer-create " *padt*"))
(dd (if (not (string= (oref obj path) ""))
@@ -118,7 +118,7 @@ Note: Currently only used for Automake projects."
(funcall ede-debug-program-function cmd))
(kill-buffer tb))))
-(defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
+(cl-defmethod project-run-target ((obj ede-proj-target-makefile-program) &optional command)
"Run a program target OBJ.
Optional COMMAND is the command to run in place of asking the user."
(require 'ede/shell)
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 07330ef7188..5877bb98e6d 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -1,6 +1,6 @@
;;; ede/proj-scheme.el --- EDE Generic Project scheme (guile) support
-;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, scheme
@@ -40,7 +40,7 @@
)
"This target consists of scheme files.")
-(defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
+(cl-defmethod ede-proj-tweak-autoconf ((this ede-proj-target-scheme))
"Tweak the configure file (current buffer) to accommodate THIS."
(autoconf-insert-new-macro "AM_INIT_GUILE_MODULE"))
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index a31e1b3a172..a8edbe8fbdf 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -1,6 +1,6 @@
;;; ede-proj-shared.el --- EDE Generic Project shared library support
-;;; Copyright (C) 1998-2000, 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1998-2000, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -166,19 +166,19 @@ Use ldlibs to add addition libraries.")
"%.lo: %.c\n"
"\t@echo '$(LTCOMPILE) -c $<'; \\\n"
"\t$(LTCOMPILE) -Wp,-MD,.deps/$(*F).p -c $<\n"
- "\t@-sed -e 's/^\([^:]*\)\.o:/\1.lo \1.o:/' \\\n"
+ "\t@-sed -e 's/^\\([^:]*\\)\\.o:/\\1.lo \\1.o:/' \\\n"
"\t < .deps/$(*F).p > .deps/$(*F).P\n"
"\t@-rm -f .deps/$(*F).p\n\n"))
)
-(defmethod ede-proj-configure-add-missing
+(cl-defmethod ede-proj-configure-add-missing
((this ede-proj-target-makefile-shared-object))
"Query if any files needed by THIS provided by automake are missing.
Results in --add-missing being passed to automake."
(not (and (ede-expand-filename (ede-toplevel) "ltconfig")
(ede-expand-filename (ede-toplevel) "ltmain.sh"))))
-(defmethod ede-proj-makefile-insert-automake-pre-variables
+(cl-defmethod ede-proj-makefile-insert-automake-pre-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We aren't actually inserting SOURCE details, but this is used by the
@@ -186,23 +186,23 @@ Makefile.am generator, so use it to add this important bin program."
(ede-pmake-insert-variable-shared "lib_LTLIBRARIES"
(insert (concat "lib" (ede-name this) ".la"))))
-(defmethod ede-proj-makefile-insert-automake-post-variables
+(cl-defmethod ede-proj-makefile-insert-automake-post-variables
((this ede-proj-target-makefile-shared-object))
"Insert bin_PROGRAMS variables needed by target THIS.
We need to override -program which has an LDADD element."
nil)
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target-makefile-shared-object))
"Return the name of the main target for THIS target."
;; We need some platform gunk to make the .so change to .sl, or .a,
;; depending on the platform we are going to compile against.
(concat "lib" (ede-name this) ".la"))
-(defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
+(cl-defmethod ede-proj-makefile-sourcevar ((this ede-proj-target-makefile-shared-object))
"Return the variable name for THIS's sources."
(if (eq (oref (ede-target-parent this) makefile-type) 'Makefile.am)
(concat "lib" (oref this name) "_la_SOURCES")
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'ede/proj-shared)
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 99a5978b005..2bc8c09dbdd 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -1,6 +1,6 @@
;;; ede/proj.el --- EDE Generic Project file driver
-;; Copyright (C) 1998-2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2003, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -162,12 +162,12 @@ These are the linkers the user can choose from when setting the
:initform t
:type boolean
:custom boolean
- :label "Part of `all:' target"
+ :label "Part of all: target"
:group make
:documentation
- "Non nil means the rule created is part of the all target.
+ "Non nil means the rule created is part of the all: target.
Setting this to nil creates the rule to build this item, but does not
-include it in the ALL`all:' rule.")
+include it in the all: rule.")
(configuration-variables
:initarg :configuration-variables
:initform nil
@@ -297,7 +297,7 @@ for the tree being read in. If ROOTPROJ is nil, then assume that
the PROJECT being read in is the root project."
(save-excursion
(let ((ret (eieio-persistent-read (concat project "Project.ede")
- ede-proj-project))
+ 'ede-proj-project))
(subdirs (directory-files project nil "[^.].*" nil)))
(if (not (object-of-class-p ret 'ede-proj-project))
(error "Corrupt project file"))
@@ -310,7 +310,7 @@ the PROJECT being read in is the root project."
(let ((sd (file-name-as-directory
(expand-file-name (car subdirs) project))))
(if (and (file-directory-p sd)
- (ede-directory-project-p sd))
+ (file-exists-p (expand-file-name "Project.ede" sd)))
(oset ret subproj
(cons (ede-proj-load sd (or rootproj ret))
(oref ret subproj))))
@@ -329,27 +329,27 @@ the PROJECT being read in is the root project."
;; Restore the directory slot
(oset project directory cdir))) ))
-(defmethod ede-commit-local-variables ((proj ede-proj-project))
+(cl-defmethod ede-commit-local-variables ((proj ede-proj-project))
"Commit change to local variables in PROJ."
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((proj ede-proj-project))
+(cl-defmethod eieio-done-customizing ((proj ede-proj-project))
"Call this when a user finishes customizing this object.
Argument PROJ is the project to save."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save proj))
-(defmethod eieio-done-customizing ((target ede-proj-target))
+(cl-defmethod eieio-done-customizing ((target ede-proj-target))
"Call this when a user finishes customizing this object.
Argument TARGET is the project we are completing customization on."
- (call-next-method)
+ (cl-call-next-method)
(ede-proj-save (ede-current-project)))
-(defmethod ede-commit-project ((proj ede-proj-project))
+(cl-defmethod ede-commit-project ((proj ede-proj-project))
"Commit any change to PROJ to its file."
(ede-proj-save proj))
-(defmethod ede-buffer-mine ((this ede-proj-project) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-project) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((f (ede-convert-path this (buffer-file-name buffer))))
(or (string= (file-name-nondirectory (oref this file)) f)
@@ -360,9 +360,9 @@ Argument TARGET is the project we are completing customization on."
(member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README"))
)))
-(defmethod ede-buffer-mine ((this ede-proj-target) buffer)
+(cl-defmethod ede-buffer-mine ((this ede-proj-target) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
- (or (call-next-method)
+ (or (cl-call-next-method)
(ede-target-buffer-in-sourcelist this buffer (oref this auxsource))))
@@ -371,7 +371,7 @@ Argument TARGET is the project we are completing customization on."
(defvar ede-proj-target-history nil
"History when querying for a target type.")
-(defmethod project-new-target ((this ede-proj-project)
+(cl-defmethod project-new-target ((this ede-proj-project)
&optional name type autoadd)
"Create a new target in THIS based on the current buffer."
(let* ((name (or name (read-string "Name: " "")))
@@ -409,7 +409,7 @@ Argument TARGET is the project we are completing customization on."
;; And save
(ede-proj-save this)))
-(defmethod project-new-target-custom ((this ede-proj-project))
+(cl-defmethod project-new-target-custom ((this ede-proj-project))
"Create a new target in THIS for custom."
(let* ((name (read-string "Name: " ""))
(type (completing-read "Type: " ede-proj-target-alist
@@ -418,7 +418,7 @@ Argument TARGET is the project we are completing customization on."
:path (ede-convert-path this default-directory)
:source nil)))
-(defmethod project-delete-target ((this ede-proj-target))
+(cl-defmethod project-delete-target ((this ede-proj-target))
"Delete the current target THIS from its parent project."
(let ((p (ede-current-project))
(ts (oref this source)))
@@ -439,7 +439,7 @@ Argument TARGET is the project we are completing customization on."
(oset p targets (delq this (oref p targets)))
(ede-proj-save (ede-current-project))))
-(defmethod project-add-file ((this ede-proj-target) file)
+(cl-defmethod project-add-file ((this ede-proj-target) file)
"Add to target THIS the current buffer represented as FILE."
(let ((file (ede-convert-path this file))
(src (ede-target-sourcecode this)))
@@ -454,7 +454,7 @@ Argument TARGET is the project we are completing customization on."
(t (error "`project-add-file(ede-target)' source mismatch error")))
(ede-proj-save))))
-(defmethod project-remove-file ((target ede-proj-target) file)
+(cl-defmethod project-remove-file ((target ede-proj-target) file)
"For TARGET, remove FILE.
FILE must be massaged by `ede-convert-path'."
;; Speedy delete should be safe.
@@ -462,11 +462,11 @@ FILE must be massaged by `ede-convert-path'."
(object-remove-from-list target 'auxsource (ede-convert-path target file))
(ede-proj-save))
-(defmethod project-update-version ((this ede-proj-project))
+(cl-defmethod project-update-version ((this ede-proj-project))
"The :version of project THIS has changed."
(ede-proj-save))
-(defmethod project-make-dist ((this ede-proj-project))
+(cl-defmethod project-make-dist ((this ede-proj-project))
"Build a distribution for the project based on THIS target."
(let ((pm (ede-proj-dist-makefile this))
(df (project-dist-files this)))
@@ -479,14 +479,14 @@ FILE must be massaged by `ede-convert-path'."
(file-name-directory pm))))
(compile (concat ede-make-command " -f " pm " dist"))))
-(defmethod project-dist-files ((this ede-proj-project))
+(cl-defmethod project-dist-files ((this ede-proj-project))
"Return a list of files that constitutes a distribution of THIS project."
(list
;; Note to self, keep this first for the above fn to check against.
(concat (oref this name) "-" (oref this version) ".tar.gz")
))
-(defmethod project-compile-project ((proj ede-proj-project) &optional command)
+(cl-defmethod project-compile-project ((proj ede-proj-project) &optional command)
"Compile the entire current project PROJ.
Argument COMMAND is the command to use when compiling."
(let ((pm (ede-proj-dist-makefile proj))
@@ -499,12 +499,12 @@ Argument COMMAND is the command to use when compiling."
;;; Target type specific compilations/debug
;;
-(defmethod project-compile-target ((obj ede-proj-target) &optional command)
+(cl-defmethod project-compile-target ((obj ede-proj-target) &optional command)
"Compile the current target OBJ.
Argument COMMAND is the command to use for compiling the target."
(project-compile-project (ede-current-project) command))
-(defmethod project-compile-target ((obj ede-proj-target-makefile)
+(cl-defmethod project-compile-target ((obj ede-proj-target-makefile)
&optional command)
"Compile the current target program OBJ.
Optional argument COMMAND is the s the alternate command to use."
@@ -512,21 +512,21 @@ Optional argument COMMAND is the s the alternate command to use."
(compile (concat ede-make-command " -f " (oref obj makefile) " "
(ede-proj-makefile-target-name obj))))
-(defmethod project-debug-target ((obj ede-proj-target))
+(cl-defmethod project-debug-target ((obj ede-proj-target))
"Run the current project target OBJ in a debugger."
(error "Debug-target not supported by %s" (eieio-object-name obj)))
-(defmethod project-run-target ((obj ede-proj-target))
+(cl-defmethod project-run-target ((obj ede-proj-target))
"Run the current project target OBJ."
(error "Run-target not supported by %s" (eieio-object-name obj)))
-(defmethod ede-proj-makefile-target-name ((this ede-proj-target))
+(cl-defmethod ede-proj-makefile-target-name ((this ede-proj-target))
"Return the name of the main target for THIS target."
(ede-name this))
;;; Compiler and source code generators
;;
-(defmethod ede-want-file-auxiliary-p ((this ede-target) file)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-target) file)
"Return non-nil if THIS target wants FILE."
;; By default, all targets reference the source object, and let it decide.
(let ((src (ede-target-sourcecode this)))
@@ -534,7 +534,7 @@ Optional argument COMMAND is the s the alternate command to use."
(setq src (cdr src)))
src))
-(defmethod ede-proj-compilers ((obj ede-proj-target))
+(cl-defmethod ede-proj-compilers ((obj ede-proj-target))
"List of compilers being used by OBJ.
If the `compiler' slot is empty, concoct one on a first match found
basis for any given type from the `availablecompilers' slot.
@@ -570,7 +570,7 @@ You may need to add support for this type of file."
;; Return the discovered compilers.
comp)))
-(defmethod ede-proj-linkers ((obj ede-proj-target))
+(cl-defmethod ede-proj-linkers ((obj ede-proj-target))
"List of linkers being used by OBJ.
If the `linker' slot is empty, concoct one on a first match found
basis for any given type from the `availablelinkers' slot.
@@ -624,7 +624,7 @@ Converts all symbols into the objects to be used."
"Return non-nil if the current project PROJ is automake mode."
(eq (ede-proj-makefile-type proj) 'Makefile))
-(defmethod ede-proj-dist-makefile ((this ede-proj-project))
+(cl-defmethod ede-proj-dist-makefile ((this ede-proj-project))
"Return the name of the Makefile with the DIST target in it for THIS."
(cond ((eq (oref this makefile-type) 'Makefile.am)
(concat (file-name-directory (oref this file))
@@ -651,7 +651,7 @@ Converts all symbols into the objects to be used."
(interactive)
(ede-proj-setup-buildenvironment (ede-current-project) t))
-(defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
+(cl-defmethod ede-proj-makefile-create-maybe ((this ede-proj-project) mfilename)
"Create a Makefile for all Makefile targets in THIS if needed.
MFILENAME is the makefile to generate."
;; For now, pass through until dirty is implemented.
@@ -660,7 +660,7 @@ MFILENAME is the makefile to generate."
(file-newer-than-file-p (oref this file) mfilename))
(ede-proj-makefile-create this mfilename)))
-(defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
+(cl-defmethod ede-proj-setup-buildenvironment ((this ede-proj-project)
&optional force)
"Setup the build environment for project THIS.
Handles the Makefile, or a Makefile.am configure.ac combination.
@@ -686,11 +686,14 @@ Optional argument FORCE will force items to be regenerated."
;;; Lower level overloads
;;
-(defmethod project-rescan ((this ede-proj-project))
+(cl-defmethod project-rescan ((this ede-proj-project))
"Rescan the EDE proj project THIS."
(let ((root (or (ede-project-root this) this))
)
- (setq ede-projects (delq root ede-projects))
+ ;; @TODO - VERIFY THE BELOW WORKS
+ (ede-project-directory-remove-hash
+ (file-name-directory (ede-project-root-directory root)))
+ (ede-delete-project-from-global-list root)
;; NOTE : parent function double-checks that this dir was
;; already in memory once.
(ede-load-project-file (ede-project-root-directory root))
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 459959e220d..48bec3c49d8 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -1,10 +1,10 @@
;;; project-am.el --- A project management scheme based on automake files.
-;; Copyright (C) 1998-2000, 2003, 2005, 2007-2013 Free Software
+;; Copyright (C) 1998-2000, 2003, 2005, 2007-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.0.3
+;; Old-Version: 0.0.3
;; Keywords: project, make
;; This file is part of GNU Emacs.
@@ -194,7 +194,7 @@ other meta-variable based on this name.")
"Encode one makefile.")
;;; Code:
-(defmethod project-add-file ((ot project-am-target))
+(cl-defmethod project-add-file ((ot project-am-target))
"Add the current buffer into a project.
OT is the object target. DIR is the directory to start in."
(let* ((target (if ede-object (error "Already associated w/ a target")
@@ -221,7 +221,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer))
(setq ede-object ot)))
-(defmethod project-remove-file ((ot project-am-target) fnnd)
+(cl-defmethod project-remove-file ((ot project-am-target) fnnd)
"Remove the current buffer from any project targets."
(ede-with-projectfile ot
(makefile-move-to-macro (project-am-macro ot))
@@ -232,7 +232,7 @@ OT is the object target. DIR is the directory to start in."
(save-buffer))
(setq ede-object nil))
-(defmethod project-edit-file-target ((obj project-am-target))
+(cl-defmethod project-edit-file-target ((obj project-am-target))
"Edit the target associated w/ this file."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
@@ -240,7 +240,7 @@ OT is the object target. DIR is the directory to start in."
(if (= (point-min) (point))
(re-search-forward (ede-target-name obj))))
-(defmethod project-new-target ((proj project-am-makefile)
+(cl-defmethod project-new-target ((proj project-am-makefile)
&optional name type)
"Create a new target named NAME.
Argument TYPE is the type of target to insert. This is a string
@@ -300,7 +300,7 @@ buffer being in order to provide a smart default target type."
;; This should be handled at the EDE level, calling a method of the
;; top most project.
;;
-(defmethod project-compile-project ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-project ((obj project-am-target) &optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
(require 'compile)
@@ -324,7 +324,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-project ((obj project-am-makefile)
+(cl-defmethod project-compile-project ((obj project-am-makefile)
&optional command)
"Compile the entire current project.
Argument COMMAND is the command to use when compiling."
@@ -349,7 +349,7 @@ Argument COMMAND is the command to use when compiling."
(let* ((default-directory (project-am-find-topmost-level default-directory)))
(compile command)))
-(defmethod project-compile-target ((obj project-am-target) &optional command)
+(cl-defmethod project-compile-target ((obj project-am-target) &optional command)
"Compile the current target.
Argument COMMAND is the command to use for compiling the target."
(require 'compile)
@@ -378,7 +378,7 @@ Argument COMMAND is the command to use for compiling the target."
;; We better be in the right place when compiling a specific target.
(compile command))
-(defmethod project-debug-target ((obj project-am-objectcode))
+(cl-defmethod project-debug-target ((obj project-am-objectcode))
"Run the current project target in a debugger."
(let ((tb (get-buffer-create " *padt*"))
(dd (oref obj path))
@@ -397,7 +397,7 @@ Argument COMMAND is the command to use for compiling the target."
(declare-function ede-shell-run-something "ede/shell")
-(defmethod project-run-target ((obj project-am-objectcode))
+(cl-defmethod project-run-target ((obj project-am-objectcode))
"Run the current project target in comint buffer."
(require 'ede/shell)
(let ((tb (get-buffer-create " *padt*"))
@@ -409,11 +409,11 @@ Argument COMMAND is the command to use for compiling the target."
(setq default-directory dd)
(setq cmd (read-from-minibuffer
"Run (like this): "
- (concat (ede-target-name obj))))
+ (concat "./" (ede-target-name obj))))
(ede-shell-run-something obj cmd))
(kill-buffer tb))))
-(defmethod project-make-dist ((this project-am-target))
+(cl-defmethod project-make-dist ((this project-am-target))
"Run the current project in the debugger."
(require 'compile)
(if (not project-am-compile-project-command)
@@ -428,12 +428,8 @@ Argument COMMAND is the command to use for compiling the target."
If a given set of projects has already been loaded, then do nothing
but return the project for the directory given.
Optional ROOTPROJ is the root EDE project."
- (let* ((ede-constructing t)
- (amo (object-assoc (expand-file-name "Makefile.am" directory)
- 'file ede-projects)))
- (when (not amo)
- (setq amo (project-am-load-makefile directory)))
- amo))
+ ;; Just jump into creating the project from the Makefiles.
+ (project-am-load-makefile directory))
(defun project-am-find-topmost-level (dir)
"Find the topmost automakefile starting with DIR."
@@ -504,7 +500,7 @@ This is used when subprojects are made in named subdirectories."
ampf))))
;;; Methods:
-(defmethod project-targets-for-file ((proj project-am-makefile))
+(cl-defmethod project-targets-for-file ((proj project-am-makefile))
"Return a list of targets the project PROJ."
(oref proj targets))
@@ -616,7 +612,7 @@ Strip out duplicates, and recurse on variables."
subdirs)
)
-(defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
+(cl-defmethod project-rescan ((this project-am-makefile) &optional suggestedname)
"Rescan the makefile for all targets and sub targets."
(project-am-with-makefile-current (file-name-directory (oref this file))
;;(message "Scanning %s..." (oref this file))
@@ -696,7 +692,7 @@ Strip out duplicates, and recurse on variables."
)))
-(defmethod project-rescan ((this project-am-program))
+(cl-defmethod project-rescan ((this project-am-program))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
@@ -704,66 +700,66 @@ Strip out duplicates, and recurse on variables."
(oset this :ldadd (makefile-macro-file-list
(concat (oref this :name) "_LDADD"))))
-(defmethod project-rescan ((this project-am-lib))
+(cl-defmethod project-rescan ((this project-am-lib))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this)))
(unless (oref this :source)
(oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c")))))
-(defmethod project-rescan ((this project-am-texinfo))
+(cl-defmethod project-rescan ((this project-am-texinfo))
"Rescan object THIS."
(oset this :include (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-man))
+(cl-defmethod project-rescan ((this project-am-man))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-lisp))
+(cl-defmethod project-rescan ((this project-am-lisp))
"Rescan the lisp sources."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-header))
+(cl-defmethod project-rescan ((this project-am-header))
"Rescan the Header sources for object THIS."
(oset this :source (makefile-macro-file-list (project-am-macro this))))
-(defmethod project-rescan ((this project-am-built-src))
+(cl-defmethod project-rescan ((this project-am-built-src))
"Rescan built sources for object THIS."
(oset this :source (makefile-macro-file-list "BUILT_SOURCES")))
-(defmethod project-rescan ((this project-am-extra-dist))
+(cl-defmethod project-rescan ((this project-am-extra-dist))
"Rescan object THIS."
(oset this :source (makefile-macro-file-list "EXTRA_DIST")))
-(defmethod project-am-macro ((this project-am-objectcode))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-objectcode))
+ "Return the default macro to `edit' for this object type."
(concat (subst-char-in-string ?- ?_ (oref this :name)) "_SOURCES"))
-(defmethod project-am-macro ((this project-am-header-noinst))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-noinst))
+ "Return the default macro to `edit' for this object."
"noinst_HEADERS")
-(defmethod project-am-macro ((this project-am-header-inst))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-inst))
+ "Return the default macro to `edit' for this object."
"include_HEADERS")
-(defmethod project-am-macro ((this project-am-header-pkg))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-pkg))
+ "Return the default macro to `edit' for this object."
"pkginclude_HEADERS")
-(defmethod project-am-macro ((this project-am-header-chk))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-header-chk))
+ "Return the default macro to `edit' for this object."
"check_HEADERS")
-(defmethod project-am-macro ((this project-am-texinfo))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-texinfo))
+ "Return the default macro to `edit' for this object type."
(concat (file-name-sans-extension (oref this :name)) "_TEXINFOS"))
-(defmethod project-am-macro ((this project-am-man))
- "Return the default macro to 'edit' for this object type."
+(cl-defmethod project-am-macro ((this project-am-man))
+ "Return the default macro to `edit' for this object type."
(oref this :name))
-(defmethod project-am-macro ((this project-am-lisp))
- "Return the default macro to 'edit' for this object."
+(cl-defmethod project-am-macro ((this project-am-lisp))
+ "Return the default macro to `edit' for this object."
"lisp_LISP")
(defun project-am-buffer-object (amf buffer)
@@ -785,7 +781,7 @@ nil means that this buffer belongs to no-one."
sobj (cdr sobj)))
obj))))
-(defmethod ede-buffer-mine ((this project-am-makefile) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-makefile) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((efn (expand-file-name (buffer-file-name buffer))))
(or (string= (oref this :file) efn)
@@ -800,42 +796,42 @@ nil means that this buffer belongs to no-one."
ans)
)))
-(defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-objectcode) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-texinfo) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(let ((bfn (file-relative-name (buffer-file-name buffer)
(oref this :path))))
(or (string= (oref this :name) bfn)
(member bfn (oref this :include)))))
-(defmethod ede-buffer-mine ((this project-am-man) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-man) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(string= (oref this :name)
(file-relative-name (buffer-file-name buffer) (oref this :path))))
-(defmethod ede-buffer-mine ((this project-am-lisp) buffer)
+(cl-defmethod ede-buffer-mine ((this project-am-lisp) buffer)
"Return t if object THIS lays claim to the file in BUFFER."
(member (file-relative-name (buffer-file-name buffer) (oref this :path))
(oref this :source)))
-(defmethod project-am-subtree ((ampf project-am-makefile) subdir)
+(cl-defmethod project-am-subtree ((ampf project-am-makefile) subdir)
"Return the sub project in AMPF specified by SUBDIR."
(object-assoc (expand-file-name subdir) 'file (oref ampf subproj)))
-(defmethod project-compile-target-command ((this project-am-target))
+(cl-defmethod project-compile-target-command ((this project-am-target))
"Default target to use when compiling a given target."
;; This is a pretty good default for most.
"")
-(defmethod project-compile-target-command ((this project-am-objectcode))
+(cl-defmethod project-compile-target-command ((this project-am-objectcode))
"Default target to use when compiling an object code target."
(oref this :name))
-(defmethod project-compile-target-command ((this project-am-texinfo))
+(cl-defmethod project-compile-target-command ((this project-am-texinfo))
"Default target t- use when compiling a texinfo file."
(let ((n (oref this :name)))
(if (string-match "\\.texi?\\(nfo\\)?" n)
@@ -857,17 +853,17 @@ Argument FILE is the file to extract the end directory name from."
(defun project-am-preferred-target-type (file)
"For FILE, return the preferred type for that file."
(cond ((string-match "\\.texi?\\(nfo\\)$" file)
- project-am-texinfo)
+ 'project-am-texinfo)
((string-match "\\.[0-9]$" file)
- project-am-man)
+ 'project-am-man)
((string-match "\\.el$" file)
- project-am-lisp)
+ 'project-am-lisp)
(t
- project-am-program)))
+ 'project-am-program)))
-(defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
+(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer)
"There are no default header files."
- (or (call-next-method)
+ (or (cl-call-next-method)
(let ((s (oref this source))
(found nil))
(while (and s (not found))
@@ -877,7 +873,7 @@ Argument FILE is the file to extract the end directory name from."
(setq s (cdr s)))
found)))
-(defmethod ede-documentation ((this project-am-texinfo))
+(cl-defmethod ede-documentation ((this project-am-texinfo))
"Return a list of files that provides documentation.
Documentation is not for object THIS, but is provided by THIS for other
files in the project."
@@ -1001,12 +997,12 @@ Calculates the info with `project-am-extract-package-info'."
(project-am-extract-package-info dir)))
;; for simple per project include path extension
-(defmethod ede-system-include-path ((this project-am-makefile))
+(cl-defmethod ede-system-include-path ((this project-am-makefile))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
-(defmethod ede-system-include-path ((this project-am-target))
+(cl-defmethod ede-system-include-path ((this project-am-target))
"Return `project-am-localvars-include-path', usually local variable
per file or in .dir-locals.el or similar."
(bound-and-true-p project-am-localvars-include-path))
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index 94846e35742..bdb5d302287 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -1,6 +1,6 @@
;;; ede/shell.el --- A shell controlled by EDE.
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -33,7 +33,7 @@
(declare-function comint-send-input "comint")
-(defmethod ede-shell-run-something ((target ede-target) command)
+(cl-defmethod ede-shell-run-something ((target ede-target) command)
"Create a shell to run stuff for TARGET.
COMMAND is a text string representing the thing to be run."
(let* ((buff (ede-shell-buffer target))
@@ -42,10 +42,15 @@ COMMAND is a text string representing the thing to be run."
;; Show the new buffer.
(when (not (get-buffer-window buff))
(switch-to-buffer-other-window buff t))
- ;; Force a shell into the buffer.
- (shell buff)
- (while (eq (point-min) (point))
- (accept-process-output))
+ ;; Force a shell into the buffer, but only if the buffer
+ ;; doesn't already have a shell in it.
+ ;; Newer versions of `shell' pop the window forward.
+ (set-buffer buff)
+ (when (not (eq major-mode 'shell-mode))
+ (shell buff)
+ ;; Make sure the shell has started.
+ (while (eq (point-min) (point))
+ (accept-process-output)))
;; Change the default directory
(if (not (string= (file-name-as-directory (expand-file-name default-directory))
(file-name-as-directory (expand-file-name dd))))
@@ -67,7 +72,7 @@ COMMAND is a text string representing the thing to be run."
(comint-send-input)
)
-(defmethod ede-shell-buffer ((target ede-target))
+(cl-defmethod ede-shell-buffer ((target ede-target))
"Get the buffer for running shell commands for TARGET."
(let ((name (ede-name target)))
(get-buffer-create (format "*EDE Shell %s*" name))))
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index c1f72d48080..3c6cb0c2c28 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -1,6 +1,6 @@
;;; ede/simple.el --- Overlay an EDE structure on an existing project
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -102,7 +102,7 @@ All directories need at least one target.")
"EDE Simple project class.
Each directory needs a project file to control it.")
-(defmethod ede-commit-project ((proj ede-simple-project))
+(cl-defmethod ede-commit-project ((proj ede-simple-project))
"Commit any change to PROJ to its file."
(when (not (file-exists-p ede-simple-save-directory))
(if (y-or-n-p (concat ede-simple-save-directory
@@ -111,7 +111,7 @@ Each directory needs a project file to control it.")
(error "No save directory for new project")))
(eieio-persistent-save proj))
-(defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
+(cl-defmethod ede-find-subproject-for-directory ((proj ede-simple-project)
dir)
"Return PROJ, for handling all subdirs below DIR."
proj)
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index 7b675587f81..d7d27679623 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -1,6 +1,6 @@
;; ede/source.el --- EDE source code object
-;; Copyright (C) 2000, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -72,7 +72,7 @@ that they are willing to use.")
;;; Methods
;;
-(defmethod initialize-instance :AFTER ((this ede-sourcecode) &rest fields)
+(cl-defmethod initialize-instance :after ((this ede-sourcecode) &rest fields)
"Make sure that all ede compiler objects are cached in
`ede-compiler-list'."
(let ((lst ede-sourcecode-list))
@@ -85,45 +85,45 @@ that they are willing to use.")
;; Add to the beginning of the list.
(setq ede-sourcecode-list (cons this ede-sourcecode-list)))))
-(defmethod ede-want-file-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-p ((this ede-sourcecode) filename)
"Return non-nil if sourcecode definition THIS will take FILENAME."
(or (ede-want-file-source-p this filename)
(ede-want-file-auxiliary-p this filename)))
-(defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-source-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(string-match (oref this sourcepattern) filename)))
-(defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
+(cl-defmethod ede-want-file-auxiliary-p ((this ede-sourcecode) filename)
"Return non-nil if THIS will take FILENAME as an auxiliary ."
(let ((case-fold-search nil))
(and (slot-boundp this 'auxsourcepattern)
(oref this auxsourcepattern)
(string-match (oref this auxsourcepattern) filename))))
-(defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-source-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any source files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-source-p this (pop filenames))))
found))
-(defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-auxiliary-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any aux files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-auxiliary-p this (pop filenames))))
found))
-(defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
+(cl-defmethod ede-want-any-files-p ((this ede-sourcecode) filenames)
"Return non-nil if THIS will accept any files in FILENAMES."
(let (found)
(while (and (not found) filenames)
(setq found (ede-want-file-p this (pop filenames))))
found))
-(defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
+(cl-defmethod ede-buffer-header-file ((this ede-sourcecode) filename)
"Return a list of file names of header files for THIS with FILENAME.
Used to guess header files, but uses the auxsource regular expression."
(let ((dn (file-name-directory filename))
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index 0f3c96b1a7d..46c097ab725 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -1,6 +1,6 @@
;;; ede/speedbar.el --- Speedbar viewing of EDE projects
-;; Copyright (C) 1998-2001, 2003, 2005, 2007-2013 Free Software
+;; Copyright (C) 1998-2001, 2003, 2005, 2007-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -121,9 +121,9 @@ Argument DIR is the directory from which to derive the list of objects."
(let ((obj (eieio-speedbar-find-nearest-object)))
(if (not (eieio-object-p obj))
nil
- (cond ((obj-of-class-p obj ede-project)
+ (cond ((obj-of-class-p obj 'ede-project)
(project-compile-project obj))
- ((obj-of-class-p obj ede-target)
+ ((obj-of-class-p obj 'ede-target)
(project-compile-target obj))
(t (error "Error in speedbar structure"))))))
@@ -133,9 +133,9 @@ Argument DIR is the directory from which to derive the list of objects."
(let ((obj (eieio-speedbar-find-nearest-object)))
(if (not (eieio-object-p obj))
(error "Error in speedbar or ede structure")
- (if (obj-of-class-p obj ede-target)
+ (if (obj-of-class-p obj 'ede-target)
(setq obj (ede-target-parent obj)))
- (if (obj-of-class-p obj ede-project)
+ (if (obj-of-class-p obj 'ede-project)
obj
(error "Error in speedbar or ede structure")))))
@@ -181,13 +181,13 @@ Argument DIR is the directory from which to derive the list of objects."
(setq depth (1- depth)))
(speedbar-line-token))))
-(defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-project) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(file-name-directory (oref obj file))
)
-(defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
+(cl-defmethod eieio-speedbar-derive-line-path ((obj ede-target) &optional depth)
"Return the path to OBJ.
Optional DEPTH is the depth we start at."
(let ((proj (ede-target-parent obj)))
@@ -201,42 +201,42 @@ Optional DEPTH is the depth we start at."
(concat (eieio-speedbar-derive-line-path proj)
(ede-find-nearest-file-line)))))))
-(defmethod eieio-speedbar-description ((obj ede-project))
+(cl-defmethod eieio-speedbar-description ((obj ede-project))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-description ((obj ede-target))
"Provide a speedbar description for OBJ."
(ede-description obj))
-(defmethod eieio-speedbar-child-description ((obj ede-target))
+(cl-defmethod eieio-speedbar-child-description ((obj ede-target))
"Provide a speedbar description for a plain-child of OBJ.
A plain child is a child element which is not an EIEIO object."
(or (speedbar-item-info-file-helper)
(speedbar-item-info-tag-helper)))
-(defmethod eieio-speedbar-object-buttonname ((object ede-project))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-project))
"Return a string to use as a speedbar button for OBJECT."
(if (ede-parent-project object)
(ede-name object)
(concat (ede-name object) " " (oref object version))))
-(defmethod eieio-speedbar-object-buttonname ((object ede-target))
+(cl-defmethod eieio-speedbar-object-buttonname ((object ede-target))
"Return a string to use as a speedbar button for OBJECT."
(ede-name object))
-(defmethod eieio-speedbar-object-children ((this ede-project))
+(cl-defmethod eieio-speedbar-object-children ((this ede-project))
"Return the list of speedbar display children for THIS."
(condition-case nil
(with-slots (subproj targets) this
(append subproj targets))
(error nil)))
-(defmethod eieio-speedbar-object-children ((this ede-target))
+(cl-defmethod eieio-speedbar-object-children ((this ede-target))
"Return the list of speedbar display children for THIS."
(oref this source))
-(defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((this ede-target) depth)
"Create a speedbar tag line for a child of THIS.
It has depth DEPTH."
(with-slots (source) this
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index a7a4dc53dd9..3af0372d467 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -1,6 +1,6 @@
;;; ede/srecode.el --- EDE utilities on top of SRecoder
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index 00a03f037a6..b78d95cf62b 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -1,6 +1,6 @@
;;; ede-system.el --- EDE working with the system (VC, FTP, ETC)
-;; Copyright (C) 2001-2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make, vc
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index 71a79a1b706..dbbf46fd01c 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -1,6 +1,6 @@
;;; ede/util.el --- EDE utilities
-;; Copyright (C) 2000, 2005, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -46,19 +46,19 @@ Argument NEWVERSION is the version number to use in the current project."
(project-update-version ede-object)
(ede-update-version-in-source ede-object newversion))))
-(defmethod project-update-version ((ot ede-project))
+(cl-defmethod project-update-version ((ot ede-project))
"The :version of the project OT has been updated.
Handle saving, or other detail."
(error "project-update-version not supported by %s" (eieio-object-name ot)))
-(defmethod ede-update-version-in-source ((this ede-project) version)
+(cl-defmethod ede-update-version-in-source ((this ede-project) version)
"Change occurrences of a version string in sources.
In project THIS, cycle over all targets to give them a chance to set
their sources to VERSION."
(ede-map-targets this (lambda (targ)
(ede-update-version-in-source targ version))))
-(defmethod ede-update-version-in-source ((this ede-target) version)
+(cl-defmethod ede-update-version-in-source ((this ede-target) version)
"In sources for THIS, change version numbers to VERSION."
(if (and (slot-boundp this 'versionsource)
(oref this versionsource))
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index 533d959f6b7..9d07b67e894 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -1,6 +1,6 @@
;;; inversion.el --- When you need something in version XX.XX
-;;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.3
@@ -230,8 +230,8 @@ string. INCOMPATIBLE-VERSION can be nil.
RESERVED arguments are kept for a later use.
Return:
- nil if everything is ok.
-- 'outdated if VERSION is less than MINIMUM.
-- 'incompatible if VERSION is not backward compatible with MINIMUM.
+- `outdated' if VERSION is less than MINIMUM.
+- `incompatible' if VERSION is not backward compatible with MINIMUM.
- t if the check failed."
(let ((code (if (stringp version)
(inversion-decode-version version)
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 7c75e3f9f39..b5995ffa397 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -1,6 +1,6 @@
;;; mode-local.el --- Support for mode local facilities
;;
-;; Copyright (C) 2004-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -48,6 +48,13 @@
(eval-when-compile (require 'cl))
+(require 'find-func)
+;; For find-function-regexp-alist. It is tempting to replace this
+;; ‘require’ by (defvar find-function-regexp-alist) and
+;; with-eval-after-load, but model-local.el is typically loaded when a
+;; semantic autoload is invoked, and something in semantic loads
+;; find-func.el before mode-local.el, so the eval-after-load is lost.
+
;;; Misc utilities
;;
(defun mode-local-map-file-buffers (function &optional predicate buffers)
@@ -597,7 +604,7 @@ PROMPT, INITIAL, HIST, and DEFAULT are the same as for `completing-read'."
;;
(defun overload-docstring-extension (overload)
"Return the doc string that augments the description of OVERLOAD."
- (let ((doc "\n\This function can be overloaded\
+ (let ((doc "\nThis function can be overloaded\
with `define-mode-local-override'.")
(sym (overload-obsoleted-by overload)))
(when sym
@@ -625,13 +632,137 @@ SYMBOL is a function that can be overridden."
;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
)))
+(defun describe-mode-local-overload (symbol)
+ "For `help-fns-describe-function-functions'; add overloads for SYMBOL."
+ (when (get symbol 'mode-local-overload)
+ (let ((default (or (intern-soft (format "%s-default" (symbol-name symbol)))
+ symbol))
+ (override (with-current-buffer describe-function-orig-buffer
+ (fetch-overload symbol)))
+ modes)
+
+ (insert (overload-docstring-extension symbol) "\n\n")
+ (insert (format-message "default function: `%s'\n" default))
+ (if override
+ (insert (format-message "\noverride in buffer `%s': `%s'\n"
+ describe-function-orig-buffer override))
+ (insert (format-message "\nno override in buffer `%s'\n"
+ describe-function-orig-buffer)))
+
+ (mapatoms
+ (lambda (sym) (when (get sym 'mode-local-symbol-table) (push sym modes)))
+ obarray)
+
+ (dolist (mode modes)
+ (let* ((major-mode mode)
+ (override (fetch-overload symbol)))
+
+ (when override
+ (insert (format-message "\noverride in mode `%s': `%s'\n"
+ major-mode override))
+ )))
+ )))
+
+(add-hook 'help-fns-describe-function-functions 'describe-mode-local-overload)
+
+(declare-function xref-item-location "xref" (xref))
+
+(defun xref-mode-local--override-present (sym xrefs)
+ "Return non-nil if SYM is in XREFS."
+ (let (result)
+ (while (and (null result)
+ xrefs)
+ (when (equal sym (car (xref-elisp-location-symbol (xref-item-location (pop xrefs)))))
+ (setq result t)))
+ result))
+
+(defun xref-mode-local-overload (symbol)
+ "For `elisp-xref-find-def-functions'; add overloads for SYMBOL."
+ ;; Current buffer is the buffer where xref-find-definitions was invoked.
+ (when (get symbol 'mode-local-overload)
+ (let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol)))
+ (default (intern-soft (format "%s-default" (symbol-name symbol))))
+ (default-file (when default (find-lisp-object-file-name default (symbol-function default))))
+ modes
+ xrefs)
+
+ (mapatoms
+ (lambda (sym) (when (get sym 'mode-local-symbol-table) (push sym modes)))
+ obarray)
+
+ ;; mode-local-overrides are inherited from parent modes; we
+ ;; don't want to list the same function twice. So order ‘modes’
+ ;; with parents first, and check for duplicates.
+
+ (setq modes
+ (sort modes
+ (lambda (a b)
+ (not (equal b (get a 'mode-local-parent)))))) ;; a is not a child, or not a child of b
+
+ (dolist (mode modes)
+ (let* ((major-mode mode)
+ (override (fetch-overload symbol))
+ (override-file (when override (find-lisp-object-file-name override (symbol-function override)))))
+
+ (when (and override override-file)
+ (let ((meta-name (cons override major-mode))
+ ;; For the declaration:
+ ;;
+ ;;(define-mode-local-override xref-elisp-foo c-mode
+ ;;
+ ;; The override symbol name is
+ ;; "xref-elisp-foo-c-mode". The summary should match
+ ;; the declaration, so strip the mode from the
+ ;; symbol name.
+ (summary (format elisp--xref-format-extra
+ 'define-mode-local-override
+ (substring (symbol-name override) 0 (- (1+ (length (symbol-name major-mode)))))
+ major-mode)))
+
+ (unless (xref-mode-local--override-present override xrefs)
+ (push (elisp--xref-make-xref
+ 'define-mode-local-override meta-name override-file summary)
+ xrefs))))))
+
+ ;; %s-default is interned whether it is a separate function or
+ ;; not, so we have to check that here.
+ (when (and (functionp default) default-file)
+ (push (elisp--xref-make-xref nil default default-file) xrefs))
+
+ (when symbol-file
+ (push (elisp--xref-make-xref 'define-overloadable-function symbol symbol-file) xrefs))
+
+ xrefs)))
+
+(add-hook 'elisp-xref-find-def-functions 'xref-mode-local-overload)
+
+(defconst xref-mode-local-find-overloadable-regexp
+ "(\\(\\(define-overloadable-function\\)\\|\\(define-overload\\)\\) +%s"
+ "Regexp used by `xref-find-definitions' when searching for a
+ mode-local overloadable function definition.")
+
+(defun xref-mode-local-find-override (meta-name)
+ "Function used by `xref-find-definitions' when searching for an
+ override of a mode-local overloadable function.
+META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
+ (let* ((override (car meta-name))
+ (mode (cdr meta-name))
+ (regexp (format "(define-mode-local-override +%s +%s"
+ (substring (symbol-name override) 0 (- (1+ (length (symbol-name mode)))))
+ mode)))
+ (re-search-forward regexp nil t)
+ ))
+
+(add-to-list 'find-function-regexp-alist '(define-overloadable-function . xref-mode-local-find-overloadable-regexp))
+(add-to-list 'find-function-regexp-alist (cons 'define-mode-local-override #'xref-mode-local-find-override))
+
;; Help for mode-local bindings.
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."
(let ((value (symbol-value symbol)))
- (princ (format "\n `%s' value is\n " symbol))
+ (princ (format-message "\n `%s' value is\n " symbol))
(if (and value (symbolp value))
- (princ (format "`%s'" value))
+ (princ (format-message "`%s'" value))
(let ((pt (point)))
(pp value)
(save-excursion
@@ -689,7 +820,7 @@ SYMBOL is a function that can be overridden."
)
((symbolp buffer-or-mode)
(setq mode buffer-or-mode)
- (princ (format "`%s'\n" buffer-or-mode))
+ (princ (format-message "`%s'\n" buffer-or-mode))
)
((signal 'wrong-type-argument
(list 'buffer-or-mode buffer-or-mode))))
@@ -699,7 +830,7 @@ SYMBOL is a function that can be overridden."
(while mode
(setq table (get mode 'mode-local-symbol-table))
(when table
- (princ (format "\n- From `%s'\n" mode))
+ (princ (format-message "\n- From `%s'\n" mode))
(mode-local-print-bindings table))
(setq mode (get-mode-local-parent mode)))))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 268beed8b1a..dea73a06e2a 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -1,6 +1,6 @@
;;; pulse.el --- Pulsing Overlays
-;;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Version: 1.0
@@ -121,7 +121,7 @@ http://www.emacswiki.org/cgi-bin/wiki/hexrgb.el"
:group 'pulse
:type 'number)
(defcustom pulse-delay .03
- "Delay between face lightening iterations, as used by `sit-for'."
+ "Delay between face lightening iterations."
:group 'pulse
:type 'number)
@@ -131,58 +131,55 @@ Return t if there is more drift to do, nil if completed."
(if (>= (get 'pulse-highlight-face :iteration) pulse-iterations)
nil
(let* ((frame (color-values (face-background 'default)))
- (start (color-values (face-background
- (get 'pulse-highlight-face
- :startface))))
- (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
- (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
- (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
- (it (get 'pulse-highlight-face :iteration))
- )
- (set-face-background 'pulse-highlight-face
- (pulse-color-values-to-hex
- (list
- (+ (nth 0 start) (* (nth 0 frac) it))
- (+ (nth 1 start) (* (nth 1 frac) it))
- (+ (nth 2 start) (* (nth 2 frac) it)))))
- (put 'pulse-highlight-face :iteration (1+ it))
- (if (>= (1+ it) pulse-iterations)
- nil
- t))))
+ (pulse-background (face-background
+ (get 'pulse-highlight-face
+ :startface)
+ nil t)));; can be nil
+ (when pulse-background
+ (let* ((start (color-values pulse-background))
+ (frac (list (/ (- (nth 0 frame) (nth 0 start)) pulse-iterations)
+ (/ (- (nth 1 frame) (nth 1 start)) pulse-iterations)
+ (/ (- (nth 2 frame) (nth 2 start)) pulse-iterations)))
+ (it (get 'pulse-highlight-face :iteration))
+ )
+ (set-face-background 'pulse-highlight-face
+ (pulse-color-values-to-hex
+ (list
+ (+ (nth 0 start) (* (nth 0 frac) it))
+ (+ (nth 1 start) (* (nth 1 frac) it))
+ (+ (nth 2 start) (* (nth 2 frac) it)))))
+ (put 'pulse-highlight-face :iteration (1+ it))
+ (if (>= (1+ it) pulse-iterations)
+ nil
+ t)))
+ )))
(defun pulse-reset-face (&optional face)
"Reset the pulse highlighting FACE."
(set-face-background 'pulse-highlight-face
(if face
- (face-background face)
+ (face-background face nil t)
(face-background 'pulse-highlight-start-face)
))
(put 'pulse-highlight-face :startface (or face
'pulse-highlight-start-face))
(put 'pulse-highlight-face :iteration 0))
-(defun pulse (&optional face)
- "Pulse the colors on our highlight face.
-If optional FACE is provided, reset the face to FACE color,
-instead of `pulse-highlight-start-face'.
-Be sure to call `pulse-reset-face' after calling pulse."
- (unwind-protect
- (progn
- (pulse-reset-face face)
- (while (and (pulse-lighten-highlight)
- (sit-for pulse-delay))
- nil))))
-
;;; Convenience Functions
;;
(defvar pulse-momentary-overlay nil
"The current pulsing overlay.")
+(defvar pulse-momentary-timer nil
+ "The current pulsing timer.")
+
(defun pulse-momentary-highlight-overlay (o &optional face)
"Pulse the overlay O, unhighlighting before next command.
-Optional argument FACE specifies the fact to do the highlighting."
+Optional argument FACE specifies the face to do the highlighting."
+ ;; We don't support simultaneous highlightings.
+ (pulse-momentary-unhighlight)
(overlay-put o 'original-face (overlay-get o 'face))
- (add-to-list 'pulse-momentary-overlay o)
+ (setq pulse-momentary-overlay o)
(if (eq pulse-flag 'never)
nil
(if (or (not pulse-flag) (not (pulse-available-p)))
@@ -191,53 +188,63 @@ Optional argument FACE specifies the fact to do the highlighting."
(overlay-put o 'face (or face 'pulse-highlight-start-face))
(add-hook 'pre-command-hook
'pulse-momentary-unhighlight))
- ;; pulse it.
- (unwind-protect
- (progn
- (overlay-put o 'face 'pulse-highlight-face)
- ;; The pulse function puts FACE onto 'pulse-highlight-face.
- ;; Thus above we put our face on the overlay, but pulse
- ;; with a reference face needed for the color.
- (pulse face))
- (pulse-momentary-unhighlight)))))
+ ;; Pulse it.
+ (overlay-put o 'face 'pulse-highlight-face)
+ ;; The pulse function puts FACE onto 'pulse-highlight-face.
+ ;; Thus above we put our face on the overlay, but pulse
+ ;; with a reference face needed for the color.
+ (pulse-reset-face face)
+ (setq pulse-momentary-timer
+ (run-with-timer 0 pulse-delay #'pulse-tick
+ (time-add (current-time)
+ (* pulse-delay pulse-iterations)))))))
+
+(defun pulse-tick (stop-time)
+ (if (time-less-p (current-time) stop-time)
+ (pulse-lighten-highlight)
+ (pulse-momentary-unhighlight)))
(defun pulse-momentary-unhighlight ()
"Unhighlight a line recently highlighted."
- ;; If someone passes in an overlay, then pulse-momentary-overlay
- ;; will still be nil, and won't need modifying.
(when pulse-momentary-overlay
;; clear the starting face
- (mapc
- (lambda (ol)
- (overlay-put ol 'face (overlay-get ol 'original-face))
- (overlay-put ol 'original-face nil)
- ;; Clear the overlay if it needs deleting.
- (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
- pulse-momentary-overlay)
+ (let ((ol pulse-momentary-overlay))
+ (overlay-put ol 'face (overlay-get ol 'original-face))
+ (overlay-put ol 'original-face nil)
+ ;; Clear the overlay if it needs deleting.
+ (when (overlay-get ol 'pulse-delete) (delete-overlay ol)))
;; Clear the variable.
- (setq pulse-momentary-overlay nil))
+ (setq pulse-momentary-overlay nil)
- ;; Reset the pulsing face.
- (pulse-reset-face)
+ ;; Reset the pulsing face.
+ (pulse-reset-face))
+
+ ;; Cancel the timer.
+ (when pulse-momentary-timer
+ (cancel-timer pulse-momentary-timer))
;; Remove this hook.
(remove-hook 'pre-command-hook 'pulse-momentary-unhighlight))
+;;;###autoload
(defun pulse-momentary-highlight-one-line (point &optional face)
"Highlight the line around POINT, unhighlighting before next command.
Optional argument FACE specifies the face to do the highlighting."
- (let ((start (point-at-bol))
- (end (save-excursion
- (end-of-line)
- (when (not (eobp))
- (forward-char 1))
- (point))))
- (pulse-momentary-highlight-region start end face)))
-
+ (save-excursion
+ (goto-char point)
+ (let ((start (point-at-bol))
+ (end (save-excursion
+ (end-of-line)
+ (when (not (eobp))
+ (forward-char 1))
+ (point))))
+ (pulse-momentary-highlight-region start end face))))
+
+;;;###autoload
(defun pulse-momentary-highlight-region (start end &optional face)
"Highlight between START and END, unhighlighting before next command.
-Optional argument FACE specifies the fact to do the highlighting."
+Optional argument FACE specifies the face to do the highlighting."
(let ((o (make-overlay start end)))
;; Mark it for deletion
(overlay-put o 'pulse-delete t)
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 909902a71fe..290cd907beb 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -1,6 +1,6 @@
;;; semantic.el --- Semantic buffer evaluator.
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax tools
@@ -311,14 +311,6 @@ a parse of the buffer.")
(semantic-varalias-obsolete 'semantic-init-db-hooks
'semantic-init-db-hook "23.2")
-(defvar semantic-new-buffer-fcn-was-run nil
- "Non-nil after `semantic-new-buffer-fcn' has been executed.")
-(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
-
-(defsubst semantic-active-p ()
- "Return non-nil if the current buffer was set up for parsing."
- semantic-new-buffer-fcn-was-run)
-
(defsubst semantic-error-if-unparsed ()
"Raise an error if current buffer was not parsed by Semantic."
(unless semantic-new-buffer-fcn-was-run
@@ -390,7 +382,7 @@ Arguments START and END bound the time being calculated."
(defun bovinate (&optional clear)
"Parse the current buffer. Show output in a temp buffer.
Optional argument CLEAR will clear the cache before parsing.
-If CLEAR is negative, it will do a full reparse, and also not display
+If CLEAR is negative, it will do a full reparse, and also display
the output buffer."
(interactive "P")
(if clear (semantic-clear-toplevel-cache))
@@ -400,7 +392,8 @@ the output buffer."
(end (current-time)))
(message "Retrieving tags took %.2f seconds."
(semantic-elapsed-time start end))
- (when (or (null clear) (not (listp clear)))
+ (when (or (null clear) (not (listp clear))
+ (and (numberp clear) (< 0 clear)))
(pop-to-buffer "*Parser Output*")
(require 'pp)
(erase-buffer)
@@ -580,6 +573,7 @@ string."
;; The best way to call the parser from programs is via
;; `semantic-fetch-tags'. This, in turn, uses other internal
;; API functions which plug-in parsers can take advantage of.
+(defvar semantic-parser-warnings)
(defun semantic-fetch-tags ()
"Fetch semantic tags from the current buffer.
@@ -609,49 +603,49 @@ was marked unparseable, then do nothing, and return the cache."
(garbage-collect)
(cond
-;;;; Try the incremental parser to do a fast update.
- ((semantic-parse-tree-needs-update-p)
- (setq res (semantic-parse-changes))
- (if (semantic-parse-tree-needs-rebuild-p)
- ;; If the partial reparse fails, jump to a full reparse.
- (semantic-fetch-tags)
- ;; Clear the cache of unmatched syntax tokens
- ;;
- ;; NOTE TO SELF:
- ;;
- ;; Move this into the incremental parser. This is a bug.
- ;;
- (semantic-clear-unmatched-syntax-cache)
- (run-hook-with-args ;; Let hooks know the updated tags
- 'semantic-after-partial-cache-change-hook res))
- (setq semantic--completion-cache nil))
-
-;;;; Parse the whole system.
- ((semantic-parse-tree-needs-rebuild-p)
- ;; Use Emacs's built-in progress-reporter (only interactive).
- (if noninteractive
- (setq res (semantic-parse-region (point-min) (point-max)))
- (let ((semantic--progress-reporter
- (and (>= (point-max) semantic-minimum-working-buffer-size)
- (eq semantic-working-type 'percent)
- (make-progress-reporter
- (semantic-parser-working-message (buffer-name))
- 0 100))))
- (setq res (semantic-parse-region (point-min) (point-max)))
- (if semantic--progress-reporter
- (progress-reporter-done semantic--progress-reporter))))
-
- ;; Clear the caches when we see there were no errors.
- ;; But preserve the unmatched syntax cache and warnings!
- (let (semantic-unmatched-syntax-cache
- semantic-unmatched-syntax-cache-check
- semantic-parser-warnings)
- (semantic-clear-toplevel-cache))
- ;; Set up the new overlays
- (semantic--tag-link-list-to-buffer res)
- ;; Set up the cache with the new results
- (semantic--set-buffer-cache res)
- ))))
+ ;; Try the incremental parser to do a fast update.
+ ((semantic-parse-tree-needs-update-p)
+ (setq res (semantic-parse-changes))
+ (if (semantic-parse-tree-needs-rebuild-p)
+ ;; If the partial reparse fails, jump to a full reparse.
+ (semantic-fetch-tags)
+ ;; Clear the cache of unmatched syntax tokens
+ ;;
+ ;; NOTE TO SELF:
+ ;;
+ ;; Move this into the incremental parser. This is a bug.
+ ;;
+ (semantic-clear-unmatched-syntax-cache)
+ (run-hook-with-args ;; Let hooks know the updated tags
+ 'semantic-after-partial-cache-change-hook res))
+ (setq semantic--completion-cache nil))
+
+ ;; Parse the whole system.
+ ((semantic-parse-tree-needs-rebuild-p)
+ ;; Use Emacs's built-in progress-reporter (only interactive).
+ (if noninteractive
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (let ((semantic--progress-reporter
+ (and (>= (point-max) semantic-minimum-working-buffer-size)
+ (eq semantic-working-type 'percent)
+ (make-progress-reporter
+ (semantic-parser-working-message (buffer-name))
+ 0 100))))
+ (setq res (semantic-parse-region (point-min) (point-max)))
+ (if semantic--progress-reporter
+ (progress-reporter-done semantic--progress-reporter))))
+
+ ;; Clear the caches when we see there were no errors.
+ ;; But preserve the unmatched syntax cache and warnings!
+ (let (semantic-unmatched-syntax-cache
+ semantic-unmatched-syntax-cache-check
+ semantic-parser-warnings)
+ (semantic-clear-toplevel-cache))
+ ;; Set up the new overlays
+ (semantic--tag-link-list-to-buffer res)
+ ;; Set up the cache with the new results
+ (semantic--set-buffer-cache res)
+ ))))
;; Always return the current parse tree.
semantic--buffer-cache)
@@ -775,8 +769,8 @@ This function returns semantic tags without overlays."
(eq semantic-working-type 'percent)
(progress-reporter-update
semantic--progress-reporter
- (/ (* 100 (semantic-lex-token-start (car stream)))
- (point-max))))))
+ (floor (* 100.0 (semantic-lex-token-start (car stream)))
+ (point-max))))))
result))
;;; Parsing Warnings:
@@ -1134,8 +1128,16 @@ Semantic mode.
;; Add semantic-ia-complete-symbol to
;; completion-at-point-functions, so that it is run from
;; M-TAB.
+ ;;
+ ;; Note: The first entry added is the last entry run, so the
+ ;; most specific entry should be last.
+ (add-hook 'completion-at-point-functions
+ 'semantic-analyze-nolongprefix-completion-at-point-function)
+ (add-hook 'completion-at-point-functions
+ 'semantic-analyze-notc-completion-at-point-function)
(add-hook 'completion-at-point-functions
- 'semantic-completion-at-point-function)
+ 'semantic-analyze-completion-at-point-function)
+
(if global-ede-mode
(define-key cedet-menu-map [cedet-menu-separator] '("--")))
(dolist (b (buffer-list))
@@ -1147,7 +1149,12 @@ Semantic mode.
;; Semantic can be re-activated cleanly.
(remove-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
(remove-hook 'completion-at-point-functions
- 'semantic-completion-at-point-function)
+ 'semantic-analyze-completion-at-point-function)
+ (remove-hook 'completion-at-point-functions
+ 'semantic-analyze-notc-completion-at-point-function)
+ (remove-hook 'completion-at-point-functions
+ 'semantic-analyze-nolongprefix-completion-at-point-function)
+
(remove-hook 'after-change-functions
'semantic-change-function)
(define-key cedet-menu-map [cedet-menu-separator] nil)
@@ -1163,8 +1170,56 @@ Semantic mode.
;; re-activated.
(setq semantic-new-buffer-fcn-was-run nil)))
-(defun semantic-completion-at-point-function ()
- 'semantic-ia-complete-symbol)
+;;; Completion At Point functions
+(defun semantic-analyze-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions'.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions ctxt)))
+
+ ;; The return from this is either:
+ ;; nil - not applicable here.
+ ;; A list: (START END COLLECTION . PROPS)
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
+
+(defun semantic-analyze-notc-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions',
+but with the 'no-tc option passed in, which means constraints based
+on what is being assigned to are ignored.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions ctxt 'no-tc)))
+
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
+
+(defun semantic-analyze-nolongprefix-completion-at-point-function ()
+ "Return possible analysis completions at point.
+The completions provided are via `semantic-analyze-possible-completions',
+but with the 'no-tc and 'no-longprefix option passed in, which means
+constraints resulting in a long multi-symbol dereference are ignored.
+This function can be used by `completion-at-point-functions'."
+ (when (semantic-active-p)
+ (let* ((ctxt (semantic-analyze-current-context))
+ (possible (semantic-analyze-possible-completions
+ ctxt 'no-tc 'no-longprefix)))
+
+ (when possible
+ (list (car (oref ctxt bounds))
+ (cdr (oref ctxt bounds))
+ possible))
+ )))
;;; Autoload some functions that are not in semantic/loaddefs
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index 000193d4a55..fe888f57767 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -1,6 +1,6 @@
;;; semantic/analyze.el --- Analyze semantic tags against local context
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -168,7 +168,7 @@ of the parent function.")
;;
;; Simple methods against the context classes.
;;
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context) &optional desired-type)
"Return a type constraint for completing :prefix in CONTEXT.
Optional argument DESIRED-TYPE may be a non-type tag to analyze."
@@ -189,17 +189,17 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
)
desired-type))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-functionarg))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (oref context argument))))
+ (cl-call-next-method context (car (oref context argument))))
-(defmethod semantic-analyze-type-constraint
+(cl-defmethod semantic-analyze-type-constraint
((context semantic-analyze-context-assignment))
"Return a type constraint for completing :prefix in CONTEXT."
- (call-next-method context (car (reverse (oref context assignee)))))
+ (cl-call-next-method context (car (reverse (oref context assignee)))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context))
"Return a tag from CONTEXT that would be most interesting to a user."
(let ((prefix (reverse (oref context :prefix))))
@@ -209,15 +209,15 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; Return the found tag, or nil.
(car prefix)))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-functionarg))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :function))))
+ (or (cl-call-next-method) (car-safe (oref context :function))))
-(defmethod semantic-analyze-interesting-tag
+(cl-defmethod semantic-analyze-interesting-tag
((context semantic-analyze-context-assignment))
"Try the base, and if that fails, return what we are assigning into."
- (or (call-next-method) (car-safe (oref context :assignee))))
+ (or (cl-call-next-method) (car-safe (oref context :assignee))))
;;; ANALYSIS
;;
@@ -226,8 +226,8 @@ Optional argument DESIRED-TYPE may be a non-type tag to analyze."
;; by an application that doesn't need to calculate the full
;; context.
-(define-overloadable-function semantic-analyze-find-tag-sequence (sequence &optional
- scope typereturn throwsym)
+(define-overloadable-function semantic-analyze-find-tag-sequence
+ (sequence &optional scope typereturn throwsym &rest flags)
"Attempt to find all tags in SEQUENCE.
Optional argument LOCALVAR is the list of local variables to use when
finding the details on the first element of SEQUENCE in case
@@ -237,53 +237,67 @@ scoped. These are not local variables, but symbols available in a structure
which doesn't need to be dereferenced.
Optional argument TYPERETURN is a symbol in which the types of all found
will be stored. If nil, that data is thrown away.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.")
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.")
-(defun semantic-analyze-find-tag-sequence-default (sequence &optional
- scope typereturn
- throwsym)
+(defun semantic-analyze-find-tag-sequence-default
+ ;; Note: overloadable fcn uses &rest, but it is a list already, so we don't need
+ ;; to do that in the -default.
+ (sequence &optional scope typereturn throwsym flags)
"Attempt to find all tags in SEQUENCE.
SCOPE are extra tags which are in scope.
TYPERETURN is a symbol in which to place a list of tag classes that
are found in SEQUENCE.
-Optional argument THROWSYM specifies a symbol the throw on non-recoverable error."
+Optional argument THROWSYM specifies a symbol the throw on non-recoverable error.
+Remaining arguments FLAGS are additional flags to apply when searching.
+This function knows of flags:
+ `mustbeclassvariable'"
(let ((s sequence) ; copy of the sequence
(tmp nil) ; tmp find variable
(tag nil) ; tag return list
(tagtype nil) ; tag types return list
(fname nil)
(miniscope (when scope (clone scope)))
+ (tagclass (if (memq 'mustbeclassvariable flags)
+ 'variable nil))
)
;; First order check. Is this wholly contained in the typecache?
(setq tmp (semanticdb-typecache-find sequence))
- (if tmp
- (progn
+ (when tmp
+ (if (or (not tagclass) (semantic-tag-of-class-p tmp tagclass))
;; We are effectively done...
- (setq s nil)
- (setq tag (list tmp)))
-
- ;; For the first entry, it better be a variable, but it might
- ;; be in the local context too.
- ;; NOTE: Don't forget c++ namespace foo::bar.
- (setq tmp (or
- ;; Is this tag within our scope. Scopes can sometimes
- ;; shadow other things, so it goes first.
- (and scope (semantic-scope-find (car s) nil scope))
- ;; Find the tag out there... somewhere, but not in scope
- (semantic-analyze-find-tag (car s))
- ))
-
- (if (and (listp tmp) (semantic-tag-p (car tmp)))
- (setq tmp (semantic-analyze-select-best-tag tmp)))
- (if (not (semantic-tag-p tmp))
- (if throwsym
- (throw throwsym "Cannot find definition")
- (error "Cannot find definition for \"%s\"" (car s))))
- (setq s (cdr s))
- (setq tag (cons tmp tag)) ; tag is nil here...
- (setq fname (semantic-tag-file-name tmp))
- )
+ (setq s nil
+ tag (list tmp))
+ ;; tagclass doesn't match, so fail this.
+ (setq tmp nil)))
+
+ (unless tmp
+ ;; For tag class filtering, only apply the filter if the first entry
+ ;; is also the only entry.
+ (let ((lftagclass (if (= (length s) 1) tagclass)))
+
+ ;; For the first entry, it better be a variable, but it might
+ ;; be in the local context too.
+ ;; NOTE: Don't forget c++ namespace foo::bar.
+ (setq tmp (or
+ ;; Is this tag within our scope. Scopes can sometimes
+ ;; shadow other things, so it goes first.
+ (and scope (semantic-scope-find (car s) lftagclass scope))
+ ;; Find the tag out there... somewhere, but not in scope
+ (semantic-analyze-find-tag (car s) lftagclass)
+ ))
+
+ (if (and (listp tmp) (semantic-tag-p (car tmp)))
+ (setq tmp (semantic-analyze-select-best-tag tmp lftagclass)))
+ (if (not (semantic-tag-p tmp))
+ (if throwsym
+ (throw throwsym "Cannot find definition")
+ (error "Cannot find definition for \"%s\"" (car s))))
+ (setq s (cdr s))
+ (setq tag (cons tmp tag)) ; tag is nil here...
+ (setq fname (semantic-tag-file-name tmp))
+ ))
;; For the middle entries
(while s
@@ -295,18 +309,10 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
;; In some cases the found TMP is a type,
;; and we can use it directly.
(cond ((semantic-tag-of-class-p tmp 'type)
- ;; update the miniscope when we need to analyze types directly.
- (when miniscope
- (let ((rawscope
- (apply 'append
- (mapcar 'semantic-tag-type-members
- tagtype))))
- (oset miniscope fullscope rawscope)))
- ;; Now analyze the type to remove metatypes.
(or (semantic-analyze-type tmp miniscope)
tmp))
(t
- (semantic-analyze-tag-type tmp scope))))
+ (semantic-analyze-tag-type tmp miniscope))))
(typefile
(when tmptype
(semantic-tag-file-name tmptype)))
@@ -336,6 +342,11 @@ Optional argument THROWSYM specifies a symbol the throw on non-recoverable error
(semantic--tag-put-property tmp :filename fname))
(setq tag (cons tmp tag))
(setq tagtype (cons tmptype tagtype))
+ (when miniscope
+ (let ((rawscope
+ (apply 'append
+ (mapcar 'semantic-tag-type-members tagtype))))
+ (oset miniscope fullscope rawscope)))
)
(setq s (cdr s)))
@@ -385,7 +396,8 @@ searches use the same arguments."
;; Search in the typecache. First entries in a sequence are
;; often there.
(setq retlist (semanticdb-typecache-find name))
- (if retlist
+ (if (and retlist (or (not tagclass)
+ (semantic-tag-of-class-p retlist 'tagclass)))
retlist
(semantic-analyze-select-best-tag
(semanticdb-strip-find-results
@@ -650,7 +662,7 @@ Returns an object based on symbol `semantic-analyze-context'."
;; We have some sort of an assignment
(condition-case err
(setq asstag (semantic-analyze-find-tag-sequence
- assign scope))
+ assign scope nil nil 'mustbeclassvariable))
(error (semantic-analyze-push-error err)
nil)))
@@ -697,7 +709,7 @@ Returns nil if no alias was found."
(when (eq (semantic-tag-get-attribute (car taglist) :kind) 'alias)
(let ((tagname
(semantic-analyze-split-name
- (semantic-tag-name
+ (semantic-tag-name
(car (semantic-tag-get-attribute (car taglist) :members))))))
(append (if (listp tagname)
tagname
@@ -731,7 +743,7 @@ Optional argument CTXT is the context to show."
;;
(declare-function pulse-momentary-highlight-region "pulse")
-(defmethod semantic-analyze-pulse ((context semantic-analyze-context))
+(cl-defmethod semantic-analyze-pulse ((context semantic-analyze-context))
"Pulse the region that CONTEXT affects."
(require 'pulse)
(with-current-buffer (oref context :buffer)
@@ -749,24 +761,28 @@ Some useful functions are found in `semantic-format-tag-functions'."
"Send the tag SEQUENCE to standard out.
Use PREFIX as a label.
Use BUFF as a source of override methods."
+ ;; If there is no sequence, at least show the field as being empty.
+ (unless sequence (princ prefix) (princ "<none>\n"))
+
+ ;; Display the sequence column aligned.
(while sequence
- (princ prefix)
- (cond
- ((semantic-tag-p (car sequence))
- (princ (funcall semantic-analyze-summary-function
- (car sequence))))
- ((stringp (car sequence))
- (princ "\"")
- (princ (semantic--format-colorize-text (car sequence) 'variable))
- (princ "\""))
- (t
- (princ (format "'%S" (car sequence)))))
- (princ "\n")
- (setq sequence (cdr sequence))
- (setq prefix (make-string (length prefix) ? ))
- ))
-
-(defmethod semantic-analyze-show ((context semantic-analyze-context))
+ (princ prefix)
+ (cond
+ ((semantic-tag-p (car sequence))
+ (princ (funcall semantic-analyze-summary-function
+ (car sequence))))
+ ((stringp (car sequence))
+ (princ "\"")
+ (princ (semantic--format-colorize-text (car sequence) 'variable))
+ (princ "\""))
+ (t
+ (princ (format "'%S" (car sequence)))))
+ (princ "\n")
+ (setq sequence (cdr sequence))
+ (setq prefix (make-string (length prefix) ? ))
+ ))
+
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context prefix) "Prefix: " )
(semantic-analyze-princ-sequence (oref context prefixclass) "Prefix Classes: ")
@@ -780,19 +796,19 @@ Use BUFF as a source of override methods."
(semantic-analyze-show (oref context scope)))
)
-(defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-assignment))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context assignee) "Assignee: ")
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-analyze-show ((context semantic-analyze-context-functionarg))
"Insert CONTEXT into the current buffer in a nice way."
(semantic-analyze-princ-sequence (oref context function) "Function: ")
(princ "Argument Index: ")
(princ (oref context index))
(princ "\n")
(semantic-analyze-princ-sequence (oref context argument) "Argument: ")
- (call-next-method))
+ (cl-call-next-method))
(defun semantic-analyze-pop-to-context (context)
"Display CONTEXT in a temporary buffer.
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 7e225d04683..680a0ae65bd 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/complete.el --- Smart Completions
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -112,8 +112,9 @@ in a buffer."
Argument CONTEXT is an object specifying the locally derived context.
The optional argument FLAGS changes which return options are returned.
FLAGS can be any number of:
- 'no-tc - do not apply data-type constraint.
- 'no-unique - do not apply unique by name filtering."
+ `no-tc' - do not apply data-type constraint.
+ `no-longprefix' - ignore long multi-symbol prefixes.
+ `no-unique' - do not apply unique by name filtering."
(let* ((a context)
(desired-type (semantic-analyze-type-constraint a))
(desired-class (oref a prefixclass))
@@ -127,9 +128,16 @@ FLAGS can be any number of:
(c nil)
(any nil)
(do-typeconstraint (not (memq 'no-tc flags)))
+ (do-longprefix (not (memq 'no-longprefix flags)))
(do-unique (not (memq 'no-unique flags)))
)
+ (when (not do-longprefix)
+ ;; If we are not doing the long prefix, shorten all the key
+ ;; elements.
+ (setq prefix (list (car (reverse prefix)))
+ prefixtypes nil))
+
;; Calculate what our prefix string is so that we can
;; find all our matching text.
(setq completetext (car (reverse prefix)))
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index 65bcfd709e5..76a6cc2f9b2 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/debug.el --- Debug the analyzer
-;;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -405,7 +405,8 @@ or implementing a version specific to ")
(princ "\n\nInclude Path Summary:")
(when edeobj
- (princ "\n\nThis file's project include search is handled by the EDE object:\n")
+ (princ (substitute-command-keys
+ "\n\nThis file's project include search is handled by the EDE object:\n"))
(princ " Buffer Target: ")
(princ (object-print edeobj))
(princ "\n")
@@ -463,12 +464,12 @@ or implementing a version specific to ")
(princ "\nYou can fix the include path for ")
(princ (symbol-name (oref table major-mode)))
- (princ " by using this function:
+ (princ (substitute-command-keys " by using this function:
-M-x semantic-customize-system-include-path RET
+\\[semantic-customize-system-include-path]
which customizes the mode specific variable for the mode-local
-variable `semantic-dependency-system-include-path'.")
+variable `semantic-dependency-system-include-path'."))
)
(princ "\n No unknown includes.\n"))
@@ -512,7 +513,7 @@ Optional argument CLASSCONSTRAINT says to output to tags of that class."
)
(defun semantic-analyzer-debug-global-miss-text (name-in)
- "Use 'princ' to show text describing not finding symbol NAME-IN.
+ "Use `princ' to show text describing not finding symbol NAME-IN.
NAME is the name of the unfound symbol."
(let ((name (cond ((stringp name-in)
name-in)
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index 7512b7ca15a..4b105c1e5b4 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/fcn.el --- Analyzer support functions.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 93dd710a67d..3047dab5280 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -1,6 +1,6 @@
;;; semantic/analyze/refs.el --- Analysis of the references between tags.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -100,7 +100,7 @@ Use `semantic-analyze-current-tag' to debug this fcn."
;;
;; These accessor methods will calculate the useful bits from the context, and cache values
;; into the context.
-(defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-impl ((refs semantic-analyze-references) &optional in-buffer)
"Return the implementations derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
@@ -109,7 +109,7 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
)
(semanticdb-find-result-mapc
(lambda (T DB)
- "Examine T in the database DB, and sont it."
+ "Examine T in the database DB, and sort it."
(let* ((ans (semanticdb-normalize-one-tag DB T))
(aT (cdr ans))
(aDB (car ans))
@@ -118,13 +118,14 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT impl))))
allhits)
impl))
-(defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
+(cl-defmethod semantic-analyze-refs-proto ((refs semantic-analyze-references) &optional in-buffer)
"Return the prototypes derived in the reference analyzer REFS.
Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer."
(let ((allhits (oref refs rawsearchdata))
@@ -141,7 +142,8 @@ Optional argument IN-BUFFER indicates that the returned tag should be in an acti
(semantic-tag-similar-p tag aT
:prototype-flag
:parent
- :typemodifiers))
+ :typemodifiers
+ :default-value))
(when in-buffer (save-excursion (semantic-go-to-tag aT aDB)))
(push aT proto))))
allhits)
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index af7e3f66507..ef28fb9205f 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -1,6 +1,6 @@
;;; semantic/bovine.el --- LL Parser/Analyzer core.
-;; Copyright (C) 1999-2004, 2006-2007, 2009-2013 Free Software
+;; Copyright (C) 1999-2004, 2006-2007, 2009-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/bovine/c-by.el b/lisp/cedet/semantic/bovine/c-by.el
deleted file mode 100644
index af3724a32c8..00000000000
--- a/lisp/cedet/semantic/bovine/c-by.el
+++ /dev/null
@@ -1,2224 +0,0 @@
-;;; semantic/bovine/c-by.el --- Generated parser support file
-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/c.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-c-reconstitute-token "semantic/bovine/c"
- (tokenpart declmods typedecl))
-(declare-function semantic-c-reconstitute-template "semantic/bovine/c"
- (tag specifier))
-(declare-function semantic-expand-c-tag "semantic/bovine/c" (tag))
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst semantic-c-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("extern" . EXTERN)
- ("static" . STATIC)
- ("const" . CONST)
- ("volatile" . VOLATILE)
- ("register" . REGISTER)
- ("signed" . SIGNED)
- ("unsigned" . UNSIGNED)
- ("inline" . INLINE)
- ("virtual" . VIRTUAL)
- ("mutable" . MUTABLE)
- ("explicit" . EXPLICIT)
- ("struct" . STRUCT)
- ("union" . UNION)
- ("enum" . ENUM)
- ("typedef" . TYPEDEF)
- ("class" . CLASS)
- ("typename" . TYPENAME)
- ("namespace" . NAMESPACE)
- ("using" . USING)
- ("new" . NEW)
- ("delete" . DELETE)
- ("template" . TEMPLATE)
- ("throw" . THROW)
- ("reentrant" . REENTRANT)
- ("try" . TRY)
- ("catch" . CATCH)
- ("operator" . OPERATOR)
- ("public" . PUBLIC)
- ("private" . PRIVATE)
- ("protected" . PROTECTED)
- ("friend" . FRIEND)
- ("if" . IF)
- ("else" . ELSE)
- ("do" . DO)
- ("while" . WHILE)
- ("for" . FOR)
- ("switch" . SWITCH)
- ("case" . CASE)
- ("default" . DEFAULT)
- ("return" . RETURN)
- ("break" . BREAK)
- ("continue" . CONTINUE)
- ("sizeof" . SIZEOF)
- ("void" . VOID)
- ("char" . CHAR)
- ("wchar_t" . WCHAR)
- ("short" . SHORT)
- ("int" . INT)
- ("long" . LONG)
- ("float" . FLOAT)
- ("double" . DOUBLE)
- ("bool" . BOOL)
- ("_P" . UNDERP)
- ("__P" . UNDERUNDERP))
- '(("__P" summary "Common macro to eliminate prototype compatibility on some compilers")
- ("_P" summary "Common macro to eliminate prototype compatibility on some compilers")
- ("bool" summary "Primitive boolean type")
- ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
- ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
- ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
- ("int" summary "Integral Primitive Type: (-2147483648 to 2147483647)")
- ("short" summary "Integral Primitive Type: (-32768 to 32767)")
- ("wchar_t" summary "Wide Character Type")
- ("char" summary "Integral Character Type: (0 to 256)")
- ("void" summary "Built in typeless type: void")
- ("sizeof" summary "Compile time macro: sizeof(<type or variable>) // size in bytes")
- ("continue" summary "Non-local continue within a loop (for, do/while): continue;")
- ("break" summary "Non-local exit within a loop or switch (for, do/while, switch): break;")
- ("return" summary "return <value>;")
- ("default" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("case" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("switch" summary "switch (<variable>) { case <constvalue>: code; ... default: code; }")
- ("for" summary "for(<init>; <condition>; <increment>) { code }")
- ("while" summary "do { code } while (<condition>); or while (<condition>) { code };")
- ("do" summary " do { code } while (<condition>);")
- ("else" summary "if (<condition>) { code } [ else { code } ]")
- ("if" summary "if (<condition>) { code } [ else { code } ]")
- ("friend" summary "friend class <CLASSNAME>")
- ("catch" summary "try { <body> } catch { <catch code> }")
- ("try" summary "try { <body> } catch { <catch code> }")
- ("reentrant" summary "<type> <methoddef> (<method args>) reentrant ...")
- ("throw" summary "<type> <methoddef> (<method args>) throw (<exception>) ...")
- ("template" summary "template <class TYPE ...> TYPE_OR_FUNCTION")
- ("delete" summary "delete <object>;")
- ("new" summary "new <classname>();")
- ("using" summary "using <namespace>;")
- ("namespace" summary "Namespace Declaration: namespace <name> { ... };")
- ("typename" summary "typename is used to handle a qualified name as a typename;")
- ("class" summary "Class Declaration: class <name>[:parents] { ... };")
- ("typedef" summary "Arbitrary Type Declaration: typedef <typedeclaration> <name>;")
- ("enum" summary "Enumeration Type Declaration: enum [name] { ... };")
- ("union" summary "Union Type Declaration: union [name] { ... };")
- ("struct" summary "Structure Type Declaration: struct [name] { ... };")
- ("explicit" summary "Forbids implicit type conversion: explicit <constructor>")
- ("mutable" summary "Member Declaration Modifier: mutable <type> <name> ...")
- ("virtual" summary "Method Modifier: virtual <type> <name>(...) ...")
- ("inline" summary "Function Modifier: inline <return type> <name>(...) {...};")
- ("unsigned" summary "Numeric Type Modifier: unsigned <numeric type> <name> ...")
- ("signed" summary "Numeric Type Modifier: signed <numeric type> <name> ...")
- ("register" summary "Declaration Modifier: register <type> <name> ...")
- ("volatile" summary "Declaration Modifier: volatile <type> <name> ...")
- ("const" summary "Declaration Modifier: const <type> <name> ...")
- ("static" summary "Declaration Modifier: static <type> <name> ...")
- ("extern" summary "Declaration Modifier: extern <type> <name> ...")))
- "Table of language keywords.")
-
-(defconst semantic-c-by--token-table
- (semantic-lex-make-type-table
- '(("semantic-list"
- (BRACKETS . "\\[\\]")
- (PARENS . "()")
- (VOID_BLCK . "^(void)$")
- (BRACE_BLCK . "^{")
- (PAREN_BLCK . "^(")
- (BRACK_BLCK . "\\[.*\\]$"))
- ("close-paren"
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACE . "{")
- (LPAREN . "("))
- ("symbol"
- (RESTRICT . "\\<\\(__\\)?restrict\\>"))
- ("number"
- (ZERO . "^0$"))
- ("string"
- (CPP . "\"C\\+\\+\"")
- (C . "\"C\""))
- ("punctuation"
- (OR . "\\`[|]\\'")
- (HAT . "\\`\\^\\'")
- (MOD . "\\`[%]\\'")
- (TILDE . "\\`[~]\\'")
- (COMA . "\\`[,]\\'")
- (GREATER . "\\`[>]\\'")
- (LESS . "\\`[<]\\'")
- (EQUAL . "\\`[=]\\'")
- (BANG . "\\`[!]\\'")
- (MINUS . "\\`[-]\\'")
- (PLUS . "\\`[+]\\'")
- (DIVIDE . "\\`[/]\\'")
- (AMPERSAND . "\\`[&]\\'")
- (STAR . "\\`[*]\\'")
- (SEMICOLON . "\\`[;]\\'")
- (COLON . "\\`[:]\\'")
- (PERIOD . "\\`[.]\\'")
- (HASH . "\\`[#]\\'")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-c-by--parse-table
- `(
- (bovine-toplevel
- (declaration)
- ) ;; end bovine-toplevel
-
- (bovine-inner-scope
- (codeblock)
- ) ;; end bovine-inner-scope
-
- (declaration
- (macro)
- (type)
- (define)
- (var-or-fun)
- (extern-c)
- (template)
- (using)
- ) ;; end declaration
-
- (codeblock
- (define)
- (codeblock-var-or-fun)
- (type)
- (using)
- ) ;; end codeblock
-
- (extern-c-contents
- (open-paren
- ,(semantic-lambda
- (list nil))
- )
- (declaration)
- (close-paren
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end extern-c-contents
-
- (extern-c
- (EXTERN
- string
- "\"C\""
- semantic-list
- ,(semantic-lambda
- (semantic-tag
- "C"
- 'extern :members
- (semantic-parse-region
- (car
- (nth 2 vals))
- (cdr
- (nth 2 vals))
- 'extern-c-contents
- 1)))
- )
- (EXTERN
- string
- "\"C\\+\\+\""
- semantic-list
- ,(semantic-lambda
- (semantic-tag
- "C"
- 'extern :members
- (semantic-parse-region
- (car
- (nth 2 vals))
- (cdr
- (nth 2 vals))
- 'extern-c-contents
- 1)))
- )
- (EXTERN
- string
- "\"C\""
- ,(semantic-lambda
- (list nil))
- )
- (EXTERN
- string
- "\"C\\+\\+\""
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end extern-c
-
- (macro
- (spp-macro-def
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil nil :constant-flag t))
- )
- (spp-system-include
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 0 vals) t))
- )
- (spp-include
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 0 vals) nil))
- )
- ) ;; end macro
-
- (define
- (spp-macro-def
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil nil :constant-flag t))
- )
- (spp-macro-undef
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end define
-
- (unionparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'classsubparts
- 1))
- )
- ) ;; end unionparts
-
- (opt-symbol
- (symbol)
- ( ;;EMPTY
- )
- ) ;; end opt-symbol
-
- (classsubparts
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (class-protection
- opt-symbol
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 0 vals))
- 'label))
- )
- (var-or-fun)
- (FRIEND
- func-decl
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 1 vals))
- 'friend))
- )
- (FRIEND
- CLASS
- symbol
- ,(semantic-lambda
- (semantic-tag
- (nth 2 vals)
- 'friend))
- )
- (type)
- (define)
- (template)
- ( ;;EMPTY
- )
- ) ;; end classsubparts
-
- (opt-class-parents
- (punctuation
- "\\`[:]\\'"
- class-parents
- opt-template-specifier
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-class-parents
-
- (one-class-parent
- (opt-class-protection
- opt-class-declmods
- namespace-symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- "class" nil nil :protection
- (car
- (nth 0 vals))))
- )
- (opt-class-declmods
- opt-class-protection
- namespace-symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- "class" nil nil :protection
- (car
- (nth 1 vals))))
- )
- ) ;; end one-class-parent
-
- (class-parents
- (one-class-parent
- punctuation
- "\\`[,]\\'"
- class-parents
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (one-class-parent
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end class-parents
-
- (opt-class-declmods
- (class-declmods
- opt-class-declmods
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-class-declmods
-
- (class-declmods
- (VIRTUAL)
- ) ;; end class-declmods
-
- (class-protection
- (PUBLIC)
- (PRIVATE)
- (PROTECTED)
- ) ;; end class-protection
-
- (opt-class-protection
- (class-protection
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- "unspecified"))
- )
- ) ;; end opt-class-protection
-
- (namespaceparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'namespacesubparts
- 1))
- )
- ) ;; end namespaceparts
-
- (namespacesubparts
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (type)
- (var-or-fun)
- (define)
- (class-protection
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 0 vals))
- 'label))
- )
- (template)
- (using)
- (spp-include
- ,(semantic-lambda
- (semantic-tag
- (nth 0 vals)
- 'include :inside-ns t))
- )
- ( ;;EMPTY
- )
- ) ;; end namespacesubparts
-
- (enumparts
- (semantic-list
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'enumsubparts
- 1))
- )
- ) ;; end enumparts
-
- (enumsubparts
- (symbol
- opt-assign
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals)
- "int"
- (car
- (nth 1 vals)) :constant-flag t))
- )
- (open-paren
- "{"
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- "}"
- ,(semantic-lambda
- (list nil))
- )
- (punctuation
- "\\`[,]\\'"
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end enumsubparts
-
- (opt-name
- (symbol)
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- ""))
- )
- ) ;; end opt-name
-
- (typesimple
- (struct-or-class
- opt-class
- opt-name
- opt-template-specifier
- opt-class-parents
- semantic-list
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (car
- (nth 0 vals))
- (let
- (
- (semantic-c-classname
- (cons
- (car
- (nth 2 vals))
- (car
- (nth 0 vals)))))
- (semantic-parse-region
- (car
- (nth 5 vals))
- (cdr
- (nth 5 vals))
- 'classsubparts
- 1))
- (nth 4 vals) :template-specifier
- (nth 3 vals) :parent
- (car
- (nth 1 vals))))
- )
- (struct-or-class
- opt-class
- opt-name
- opt-template-specifier
- opt-class-parents
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (car
- (nth 0 vals)) nil
- (nth 4 vals) :template-specifier
- (nth 3 vals) :prototype t :parent
- (car
- (nth 1 vals))))
- )
- (UNION
- opt-class
- opt-name
- unionparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (nth 0 vals)
- (nth 3 vals) nil :parent
- (car
- (nth 1 vals))))
- )
- (ENUM
- opt-class
- opt-name
- enumparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 2 vals))
- (nth 0 vals)
- (nth 3 vals) nil :parent
- (car
- (nth 1 vals))))
- )
- (TYPEDEF
- declmods
- typeformbase
- cv-declmods
- typedef-symbol-list
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 4 vals)
- (nth 0 vals) nil
- (list
- (nth 2 vals))))
- )
- ) ;; end typesimple
-
- (typedef-symbol-list
- (typedefname
- punctuation
- "\\`[,]\\'"
- typedef-symbol-list
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (typedefname
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end typedef-symbol-list
-
- (typedefname
- (opt-stars
- symbol
- opt-bits
- opt-array
- ,(semantic-lambda
- (list
- (nth 0 vals)
- (nth 1 vals)))
- )
- ) ;; end typedefname
-
- (struct-or-class
- (STRUCT)
- (CLASS)
- ) ;; end struct-or-class
-
- (type
- (typesimple
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (nth 0 vals))
- )
- (NAMESPACE
- symbol
- namespaceparts
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals)
- (nth 2 vals) nil))
- )
- (NAMESPACE
- namespaceparts
- ,(semantic-lambda
- (semantic-tag-new-type
- "unnamed"
- (nth 0 vals)
- (nth 1 vals) nil))
- )
- (NAMESPACE
- symbol
- punctuation
- "\\`[=]\\'"
- typeformbase
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals)
- (list
- (semantic-tag-new-type
- (car
- (nth 3 vals))
- (nth 0 vals) nil nil)) nil :kind
- 'alias))
- )
- ) ;; end type
-
- (using
- (USING
- usingname
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-tag
- (car
- (nth 1 vals))
- 'using :type
- (nth 1 vals)))
- )
- ) ;; end using
-
- (usingname
- (typeformbase
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 0 vals))
- "class" nil nil :prototype t))
- )
- (NAMESPACE
- typeformbase
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 1 vals))
- "namespace" nil nil :prototype t))
- )
- ) ;; end usingname
-
- (template
- (TEMPLATE
- template-specifier
- opt-friend
- template-definition
- ,(semantic-lambda
- (semantic-c-reconstitute-template
- (nth 3 vals)
- (nth 1 vals)))
- )
- ) ;; end template
-
- (opt-friend
- (FRIEND)
- ( ;;EMPTY
- )
- ) ;; end opt-friend
-
- (opt-template-specifier
- (template-specifier
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-template-specifier
-
- (template-specifier
- (punctuation
- "\\`[<]\\'"
- template-specifier-types
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (nth 1 vals))
- )
- ) ;; end template-specifier
-
- (template-specifier-types
- (template-var
- template-specifier-type-list
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- )
- ) ;; end template-specifier-types
-
- (template-specifier-type-list
- (punctuation
- "\\`[,]\\'"
- template-specifier-types
- ,(semantic-lambda
- (nth 1 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end template-specifier-type-list
-
- (template-var
- (template-type
- opt-template-equal
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))))
- )
- (string
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (number
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (opt-stars
- opt-ref
- namespace-symbol
- ,(semantic-lambda
- (nth 2 vals))
- )
- (semantic-list
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (SIZEOF
- semantic-list
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end template-var
-
- (opt-template-equal
- (punctuation
- "\\`[=]\\'"
- symbol
- punctuation
- "\\`[<]\\'"
- template-specifier-types
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- (punctuation
- "\\`[=]\\'"
- symbol
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-template-equal
-
- (template-type
- (CLASS
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "class" nil nil))
- )
- (STRUCT
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "struct" nil nil))
- )
- (TYPENAME
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- "class" nil nil))
- )
- (declmods
- typeformbase
- cv-declmods
- opt-stars
- opt-ref
- variablearg-opt-name
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 1 vals)) nil nil nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) :reference
- (car
- (nth 4 vals)) :pointer
- (car
- (nth 3 vals))))
- )
- ) ;; end template-type
-
- (template-definition
- (type
- ,(semantic-lambda
- (nth 0 vals))
- )
- (var-or-fun
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end template-definition
-
- (opt-stars
- (punctuation
- "\\`[*]\\'"
- opt-starmod
- opt-stars
- ,(semantic-lambda
- (list
- (1+
- (car
- (nth 2 vals)))))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- 0))
- )
- ) ;; end opt-stars
-
- (opt-starmod
- (STARMOD
- opt-starmod
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end opt-starmod
-
- (STARMOD
- (CONST)
- ) ;; end STARMOD
-
- (declmods
- (DECLMOD
- declmods
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- (DECLMOD
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end declmods
-
- (DECLMOD
- (EXTERN)
- (STATIC)
- (CVDECLMOD)
- (INLINE)
- (REGISTER)
- (FRIEND)
- (TYPENAME)
- (METADECLMOD)
- (VIRTUAL)
- ) ;; end DECLMOD
-
- (metadeclmod
- (METADECLMOD
- ,(semantic-lambda)
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end metadeclmod
-
- (CVDECLMOD
- (CONST)
- (VOLATILE)
- ) ;; end CVDECLMOD
-
- (cv-declmods
- (CVDECLMOD
- cv-declmods
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 1 vals)))
- )
- (CVDECLMOD
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end cv-declmods
-
- (METADECLMOD
- (VIRTUAL)
- (MUTABLE)
- ) ;; end METADECLMOD
-
- (opt-ref
- (punctuation
- "\\`[&]\\'"
- ,(semantic-lambda
- (list
- 1))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list
- 0))
- )
- ) ;; end opt-ref
-
- (typeformbase
- (typesimple
- ,(semantic-lambda
- (nth 0 vals))
- )
- (STRUCT
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (UNION
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (ENUM
- symbol
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 1 vals)
- (nth 0 vals) nil nil))
- )
- (builtintype
- ,(semantic-lambda
- (nth 0 vals))
- )
- (symbol
- template-specifier
- ,(semantic-lambda
- (semantic-tag-new-type
- (nth 0 vals)
- "class" nil nil :template-specifier
- (nth 1 vals)))
- )
- (namespace-symbol-for-typeformbase
- opt-template-specifier
- ,(semantic-lambda
- (semantic-tag-new-type
- (car
- (nth 0 vals))
- "class" nil nil :template-specifier
- (nth 1 vals)))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end typeformbase
-
- (signedmod
- (UNSIGNED)
- (SIGNED)
- ) ;; end signedmod
-
- (builtintype-types
- (VOID)
- (CHAR)
- (WCHAR)
- (SHORT
- INT
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (SHORT)
- (INT)
- (LONG
- INT
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (FLOAT)
- (DOUBLE)
- (BOOL)
- (LONG
- DOUBLE
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (LONG
- LONG
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- " "
- (nth 1 vals))))
- )
- (LONG)
- ) ;; end builtintype-types
-
- (builtintype
- (signedmod
- builtintype-types
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- " "
- (car
- (nth 1 vals)))))
- )
- (builtintype-types
- ,(semantic-lambda
- (nth 0 vals))
- )
- (signedmod
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- " int")))
- )
- ) ;; end builtintype
-
- (codeblock-var-or-fun
- (declmods
- typeformbase
- declmods
- opt-ref
- var-or-func-decl
- ,(semantic-lambda
- (semantic-c-reconstitute-token
- (nth 4 vals)
- (nth 0 vals)
- (nth 1 vals)))
- )
- ) ;; end codeblock-var-or-fun
-
- (var-or-fun
- (codeblock-var-or-fun
- ,(semantic-lambda
- (nth 0 vals))
- )
- (declmods
- var-or-func-decl
- ,(semantic-lambda
- (semantic-c-reconstitute-token
- (nth 1 vals)
- (nth 0 vals) nil))
- )
- ) ;; end var-or-fun
-
- (var-or-func-decl
- (func-decl
- ,(semantic-lambda
- (nth 0 vals))
- )
- (var-decl
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end var-or-func-decl
-
- (func-decl
- (opt-stars
- opt-class
- opt-destructor
- functionname
- opt-template-specifier
- opt-under-p
- arg-list
- opt-post-fcn-modifiers
- opt-throw
- opt-initializers
- fun-or-proto-end
- ,(semantic-lambda
- (nth 3 vals)
- (list
- 'function
- (nth 1 vals)
- (nth 2 vals)
- (nth 6 vals)
- (nth 8 vals)
- (nth 7 vals))
- (nth 0 vals)
- (nth 10 vals)
- (list
- (nth 4 vals))
- (nth 9 vals))
- )
- (opt-stars
- opt-class
- opt-destructor
- functionname
- opt-template-specifier
- opt-under-p
- opt-post-fcn-modifiers
- opt-throw
- opt-initializers
- fun-try-end
- ,(semantic-lambda
- (nth 3 vals)
- (list
- 'function
- (nth 1 vals)
- (nth 2 vals) nil
- (nth 7 vals)
- (nth 6 vals))
- (nth 0 vals)
- (nth 9 vals)
- (list
- (nth 4 vals))
- (nth 8 vals))
- )
- ) ;; end func-decl
-
- (var-decl
- (varnamelist
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list
- (nth 0 vals)
- 'variable))
- )
- ) ;; end var-decl
-
- (opt-under-p
- (UNDERP
- ,(semantic-lambda
- (list nil))
- )
- (UNDERUNDERP
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-under-p
-
- (opt-initializers
- (punctuation
- "\\`[:]\\'"
- namespace-symbol
- semantic-list
- opt-initializers)
- (punctuation
- "\\`[,]\\'"
- namespace-symbol
- semantic-list
- opt-initializers)
- ( ;;EMPTY
- )
- ) ;; end opt-initializers
-
- (opt-post-fcn-modifiers
- (post-fcn-modifiers
- opt-post-fcn-modifiers
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-post-fcn-modifiers
-
- (post-fcn-modifiers
- (REENTRANT)
- (CONST)
- ) ;; end post-fcn-modifiers
-
- (opt-throw
- (THROW
- semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 1 vals))
- (cdr
- (nth 1 vals))
- 'throw-exception-list))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-throw
-
- (throw-exception-list
- (namespace-symbol
- punctuation
- "\\`[,]\\'"
- throw-exception-list
- ,(semantic-lambda
- (cons
- (car
- (nth 0 vals))
- (nth 2 vals)))
- )
- (namespace-symbol
- close-paren
- ")"
- ,(semantic-lambda
- (nth 0 vals))
- )
- (symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- (open-paren
- "("
- throw-exception-list
- ,(semantic-lambda
- (nth 1 vals))
- )
- (close-paren
- ")"
- ,(semantic-lambda)
- )
- ) ;; end throw-exception-list
-
- (opt-bits
- (punctuation
- "\\`[:]\\'"
- number
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-bits
-
- (opt-array
- (semantic-list
- "\\[.*\\]$"
- opt-array
- ,(semantic-lambda
- (list
- (cons
- 1
- (car
- (nth 1 vals)))))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-array
-
- (opt-assign
- (punctuation
- "\\`[=]\\'"
- expression
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-assign
-
- (opt-restrict
- (symbol
- "\\<\\(__\\)?restrict\\>")
- ( ;;EMPTY
- )
- ) ;; end opt-restrict
-
- (varname
- (opt-stars
- opt-restrict
- namespace-symbol
- opt-bits
- opt-array
- ,(semantic-lambda
- (nth 2 vals)
- (nth 0 vals)
- (nth 3 vals)
- (nth 4 vals))
- )
- ) ;; end varname
-
- (variablearg
- (declmods
- typeformbase
- cv-declmods
- opt-ref
- variablearg-opt-name
- ,(semantic-lambda
- (semantic-tag-new-variable
- (list
- (nth 4 vals))
- (nth 1 vals) nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (append
- (nth 0 vals)
- (nth 2 vals))) :reference
- (car
- (nth 3 vals))))
- )
- ) ;; end variablearg
-
- (variablearg-opt-name
- (varname
- ,(semantic-lambda
- (nth 0 vals))
- )
- (opt-stars
- ,(semantic-lambda
- (list
- "")
- (nth 0 vals)
- (list nil nil nil))
- )
- ) ;; end variablearg-opt-name
-
- (varname-opt-initializer
- (semantic-list)
- (opt-assign)
- ( ;;EMPTY
- )
- ) ;; end varname-opt-initializer
-
- (varnamelist
- (opt-ref
- varname
- varname-opt-initializer
- punctuation
- "\\`[,]\\'"
- varnamelist
- ,(semantic-lambda
- (cons
- (nth 1 vals)
- (nth 4 vals)))
- )
- (opt-ref
- varname
- varname-opt-initializer
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end varnamelist
-
- (namespace-symbol
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-symbol
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 4 vals)))))
- )
- (symbol
- opt-template-specifier
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-symbol
-
- (namespace-symbol-for-typeformbase
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-symbol-for-typeformbase
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 4 vals)))))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-symbol-for-typeformbase
-
- (namespace-opt-class
- (symbol
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- namespace-opt-class
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- "::"
- (car
- (nth 3 vals)))))
- )
- (symbol
- opt-template-specifier
- punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end namespace-opt-class
-
- (opt-class
- (namespace-opt-class
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-class
-
- (opt-destructor
- (punctuation
- "\\`[~]\\'"
- ,(semantic-lambda
- (list t))
- )
- ( ;;EMPTY
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end opt-destructor
-
- (arg-list
- (semantic-list
- "^("
- knr-arguments
- ,(semantic-lambda
- (nth 1 vals))
- )
- (semantic-list
- "^("
- ,(semantic-lambda
- (semantic-parse-region
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'arg-sub-list
- 1))
- )
- (semantic-list
- "^(void)$"
- ,(semantic-lambda)
- )
- ) ;; end arg-list
-
- (knr-varnamelist
- (varname
- punctuation
- "\\`[,]\\'"
- knr-varnamelist
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 2 vals)))
- )
- (varname
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end knr-varnamelist
-
- (knr-one-variable-decl
- (declmods
- typeformbase
- cv-declmods
- knr-varnamelist
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nreverse
- (nth 3 vals))
- (nth 1 vals) nil :constant-flag
- (if
- (member
- "const"
- (append
- (nth 2 vals))) t nil) :typemodifiers
- (delete
- "const"
- (nth 2 vals))))
- )
- ) ;; end knr-one-variable-decl
-
- (knr-arguments
- (knr-one-variable-decl
- punctuation
- "\\`[;]\\'"
- knr-arguments
- ,(semantic-lambda
- (append
- (semantic-expand-c-tag
- (nth 0 vals))
- (nth 2 vals)))
- )
- (knr-one-variable-decl
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (semantic-expand-c-tag
- (nth 0 vals)))
- )
- ) ;; end knr-arguments
-
- (arg-sub-list
- (variablearg
- ,(semantic-lambda
- (nth 0 vals))
- )
- (punctuation
- "\\`[.]\\'"
- punctuation
- "\\`[.]\\'"
- punctuation
- "\\`[.]\\'"
- close-paren
- ")"
- ,(semantic-lambda
- (semantic-tag-new-variable
- "..."
- "vararg" nil))
- )
- (punctuation
- "\\`[,]\\'"
- ,(semantic-lambda
- (list nil))
- )
- (open-paren
- "("
- ,(semantic-lambda
- (list nil))
- )
- (close-paren
- ")"
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end arg-sub-list
-
- (operatorsym
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "<<="))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- ">>="))
- )
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[<]\\'"
- ,(semantic-lambda
- (list
- "<<"))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- ">>"))
- )
- (punctuation
- "\\`[=]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "=="))
- )
- (punctuation
- "\\`[<]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "<="))
- )
- (punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- ">="))
- )
- (punctuation
- "\\`[!]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "!="))
- )
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "+="))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "-="))
- )
- (punctuation
- "\\`[*]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "*="))
- )
- (punctuation
- "\\`[/]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "/="))
- )
- (punctuation
- "\\`[%]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "%="))
- )
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "&="))
- )
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "|="))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- punctuation
- "\\`[*]\\'"
- ,(semantic-lambda
- (list
- "->*"))
- )
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- ,(semantic-lambda
- (list
- "->"))
- )
- (semantic-list
- "()"
- ,(semantic-lambda
- (list
- "()"))
- )
- (semantic-list
- "\\[\\]"
- ,(semantic-lambda
- (list
- "[]"))
- )
- (punctuation
- "\\`[<]\\'")
- (punctuation
- "\\`[>]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[+]\\'"
- ,(semantic-lambda
- (list
- "++"))
- )
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[-]\\'"
- ,(semantic-lambda
- (list
- "--"))
- )
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[&]\\'"
- ,(semantic-lambda
- (list
- "&&"))
- )
- (punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[|]\\'"
- ,(semantic-lambda
- (list
- "||"))
- )
- (punctuation
- "\\`[|]\\'")
- (punctuation
- "\\`[/]\\'")
- (punctuation
- "\\`[=]\\'")
- (punctuation
- "\\`[!]\\'")
- (punctuation
- "\\`[~]\\'")
- (punctuation
- "\\`[%]\\'")
- (punctuation
- "\\`[,]\\'")
- (punctuation
- "\\`\\^\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda
- (list
- "^="))
- )
- (punctuation
- "\\`\\^\\'")
- ) ;; end operatorsym
-
- (functionname
- (OPERATOR
- operatorsym
- ,(semantic-lambda
- (nth 1 vals))
- )
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'function-pointer))
- )
- (symbol
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end functionname
-
- (function-pointer
- (open-paren
- "("
- punctuation
- "\\`[*]\\'"
- symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (concat
- "*"
- (nth 2 vals))))
- )
- (open-paren
- "("
- symbol
- close-paren
- ")"
- ,(semantic-lambda
- (list
- (nth 1 vals)))
- )
- ) ;; end function-pointer
-
- (fun-or-proto-end
- (punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list t))
- )
- (semantic-list
- ,(semantic-lambda
- (list nil))
- )
- (punctuation
- "\\`[=]\\'"
- number
- "^0$"
- punctuation
- "\\`[;]\\'"
- ,(semantic-lambda
- (list ':pure-virtual-flag))
- )
- (fun-try-end
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end fun-or-proto-end
-
- (fun-try-end
- (TRY
- opt-initializers
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end fun-try-end
-
- (fun-try-several-catches
- (CATCH
- semantic-list
- "^("
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda)
- )
- (CATCH
- semantic-list
- "^{"
- fun-try-several-catches
- ,(semantic-lambda)
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end fun-try-several-catches
-
- (type-cast
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'type-cast-list))
- )
- ) ;; end type-cast
-
- (type-cast-list
- (open-paren
- typeformbase
- close-paren)
- ) ;; end type-cast-list
-
- (opt-stuff-after-symbol
- (semantic-list
- "^(")
- (semantic-list
- "\\[.*\\]$")
- ( ;;EMPTY
- )
- ) ;; end opt-stuff-after-symbol
-
- (multi-stage-dereference
- (namespace-symbol
- opt-stuff-after-symbol
- punctuation
- "\\`[.]\\'"
- multi-stage-dereference)
- (namespace-symbol
- opt-stuff-after-symbol
- punctuation
- "\\`[-]\\'"
- punctuation
- "\\`[>]\\'"
- multi-stage-dereference)
- (namespace-symbol
- opt-stuff-after-symbol)
- ) ;; end multi-stage-dereference
-
- (string-seq
- (string
- string-seq
- ,(semantic-lambda
- (list
- (concat
- (nth 0 vals)
- (car
- (nth 1 vals)))))
- )
- (string
- ,(semantic-lambda
- (list
- (nth 0 vals)))
- )
- ) ;; end string-seq
-
- (expr-start
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[&]\\'")
- ) ;; end expr-start
-
- (expr-binop
- (punctuation
- "\\`[-]\\'")
- (punctuation
- "\\`[+]\\'")
- (punctuation
- "\\`[*]\\'")
- (punctuation
- "\\`[/]\\'")
- (punctuation
- "\\`[&]\\'"
- punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[&]\\'")
- (punctuation
- "\\`[|]\\'"
- punctuation
- "\\`[|]\\'")
- (punctuation
- "\\`[|]\\'")
- ) ;; end expr-binop
-
- (expression
- (unaryexpression
- expr-binop
- unaryexpression
- ,(semantic-lambda
- (list
- (identity start)
- (identity end)))
- )
- (unaryexpression
- ,(semantic-lambda
- (list
- (identity start)
- (identity end)))
- )
- ) ;; end expression
-
- (unaryexpression
- (number)
- (multi-stage-dereference)
- (NEW
- multi-stage-dereference)
- (NEW
- builtintype-types
- semantic-list)
- (namespace-symbol)
- (string-seq)
- (type-cast
- expression)
- (semantic-list
- expression)
- (semantic-list)
- (expr-start
- expression)
- ) ;; end unaryexpression
- )
- "Parser table.")
-
-(defun semantic-c-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-c-by--parse-table
- semantic-debug-parser-source "c.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-c-by--keyword-table
- semantic-equivalent-major-modes '(c-mode c++-mode)
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/c-by)
-
-;;; semantic/bovine/c-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 3c991ea8555..1c25c7b0808 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/c.el --- Semantic details for C
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -27,6 +27,7 @@
(require 'semantic)
(require 'semantic/analyze)
+(require 'semantic/analyze/refs)
(require 'semantic/bovine)
(require 'semantic/bovine/gcc)
(require 'semantic/idle)
@@ -224,7 +225,7 @@ to store your global macros in a more natural way."
)
(defcustom semantic-c-member-of-autocast 't
- "Non-nil means classes with a '->' operator will cast to its return type.
+ "Non-nil means classes with a `->' operator will cast to its return type.
For Examples:
@@ -269,7 +270,7 @@ Return the defined symbol as a special spp lex token."
(if (looking-back "/\\*.*" beginning-of-define)
(progn
(goto-char (match-beginning 0))
- (1- (point)))
+ (point))
(point)))))
)
@@ -497,13 +498,19 @@ code to parse."
(parsedtokelist
(condition-case nil
;; This is imperfect, so always assume on error.
- (hif-canonicalize)
+ (hif-canonicalize hif-ifx-regexp)
(error nil))))
- (let ((eval-form (eval parsedtokelist)))
+ (let ((eval-form (condition-case err
+ (eval parsedtokelist)
+ (error
+ (semantic-push-parser-warning
+ (format "Hideif forms produced an error. Assuming false.\n%S" err)
+ (point) (1+ (point)))
+ nil))))
(if (or (not eval-form)
(and (numberp eval-form)
- (equal eval-form 0)));; ifdefline resulted in false
+ (equal eval-form 0)));; ifdef line resulted in false
;; The if indicates to skip this preprocessor section
(let ((pt nil))
@@ -812,7 +819,7 @@ Use semantic-cpp-lexer for parsing text inside a CPP macro."
;; semantic-lex-spp-replace-or-symbol-or-keyword
semantic-lex-symbol-or-keyword
semantic-lex-charquote
- semantic-lex-paren-or-list
+ semantic-lex-spp-paren-or-list
semantic-lex-close-paren
semantic-lex-ignore-comments
semantic-lex-punctuation
@@ -1042,8 +1049,8 @@ now.
return-list))
(defun semantic-expand-c-extern-C (tag)
- "Expand TAG containing an 'extern \"C\"' statement.
-This will return all members of TAG with 'extern \"C\"' added to
+ "Expand TAG containing an `extern \"C\"' statement.
+This will return all members of TAG with `extern \"C\"' added to
the typemodifiers attribute."
(when (eq (semantic-tag-class tag) 'extern)
(let* ((mb (semantic-tag-get-attribute tag :members))
@@ -1058,7 +1065,7 @@ the typemodifiers attribute."
(defun semantic-expand-c-complex-type (tag)
"Check if TAG has a full :type with a name on its own.
If so, extract it, and replace it with a reference to that type.
-Thus, 'struct A { int a; } B;' will create 2 toplevel tags, one
+Thus, `struct A { int a; } B;' will create 2 toplevel tags, one
is type A, and the other variable B where the :type of B is just
a type tag A that is a prototype, and the actual struct info of A
is its own toplevel tag. This function will return (cons A B)."
@@ -1118,7 +1125,8 @@ is its own toplevel tag. This function will return (cons A B)."
(semantic-tag-new-variable
(car cur) ;name
ty ;type
- (if default
+ (if (and default
+ (listp (cdr default)))
(buffer-substring-no-properties
(car default) (car (cdr default))))
:constant-flag (semantic-tag-variable-constant-p tag)
@@ -1173,11 +1181,7 @@ is its own toplevel tag. This function will return (cons A B)."
(nth 1 (car names)) ; name
"typedef"
(semantic-tag-type-members tag)
- ;; parent is just the name of what
- ;; is passed down as a tag.
- (list
- (semantic-tag-name
- (semantic-tag-type-superclasses tag)))
+ nil
:pointer
(let ((stars (car (car (car names)))))
(if (= stars 0) nil stars))
@@ -1227,6 +1231,45 @@ or \"struct\".")
name
(delete "" ans))))
+(define-mode-local-override semantic-analyze-tag-references c-mode (tag &optional db)
+ "Analyze the references for TAG.
+Returns a class with information about TAG.
+
+Optional argument DB is a database. It will be used to help
+locate TAG.
+
+Use `semantic-analyze-current-tag' to debug this fcn."
+ (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list 'semantic-tag-p tag)))
+ (let ((allhits nil)
+ (scope nil)
+ (refs nil))
+ (save-excursion
+ (semantic-go-to-tag tag db)
+ (setq scope (semantic-calculate-scope))
+
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t))
+
+ (when (or (zerop (semanticdb-find-result-length allhits))
+ (and (= (semanticdb-find-result-length allhits) 1)
+ (eq (car (semanticdb-find-result-nth allhits 0)) tag)))
+ ;; It found nothing or only itself - not good enough. As a
+ ;; last resort, let's remove all namespaces from the scope and
+ ;; search again.
+ (oset scope parents
+ (let ((parents (oref scope parents))
+ newparents)
+ (dolist (cur parents)
+ (unless (string= (semantic-tag-type cur) "namespace")
+ (push cur newparents)))
+ (reverse newparents)))
+ (setq allhits (semantic--analyze-refs-full-lookup tag scope t)))
+
+ (setq refs (semantic-analyze-references (semantic-tag-name tag)
+ :tag tag
+ :tagdb db
+ :scope scope
+ :rawsearchdata allhits)))))
+
(defun semantic-c-reconstitute-token (tokenpart declmods typedecl)
"Reconstitute a token TOKENPART with DECLMODS and TYPEDECL.
This is so we don't have to match the same starting text several times.
@@ -1258,7 +1301,8 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
(nth 10 tokenpart) ; initializers
)
(not (car (nth 3 tokenpart)))))
- (fcnpointer (string-match "^\\*" (car tokenpart)))
+ (fcnpointer (and (> (length (car tokenpart)) 0)
+ (= (aref (car tokenpart) 0) ?*)))
(fnname (if fcnpointer
(substring (car tokenpart) 1)
(car tokenpart)))
@@ -1266,70 +1310,80 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
nil
t))
)
- (if fcnpointer
- ;; Function pointers are really variables.
- (semantic-tag-new-variable
- fnname
- typedecl
- nil
- ;; It is a function pointer
- :functionpointer-flag t
- )
- ;; The function
- (semantic-tag-new-function
- fnname
- (or typedecl ;type
- (cond ((car (nth 3 tokenpart) )
- "void") ; Destructors have no return?
- (constructor
- ;; Constructors return an object.
- (semantic-tag-new-type
- ;; name
- (or (car semantic-c-classname)
- (let ((split (semantic-analyze-split-name-c-mode
- (car (nth 2 tokenpart)))))
- (if (stringp split) split
- (car (last split)))))
- ;; type
- (or (cdr semantic-c-classname)
- "class")
- ;; members
- nil
- ;; parents
- nil
- ))
- (t "int")))
- (nth 4 tokenpart) ;arglist
- :constant-flag (if (member "const" declmods) t nil)
- :typemodifiers (delete "const" declmods)
- :parent (car (nth 2 tokenpart))
- :destructor-flag (if (car (nth 3 tokenpart) ) t)
- :constructor-flag (if constructor t)
- :pointer (nth 7 tokenpart)
- :operator-flag operator
- ;; Even though it is "throw" in C++, we use
- ;; `throws' as a common name for things that toss
- ;; exceptions about.
- :throws (nth 5 tokenpart)
- ;; Reentrant is a C++ thingy. Add it here
- :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
- ;; A function post-const is funky. Try stuff
- :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
- ;; prototypes are functions w/ no body
- :prototype-flag (if (nth 8 tokenpart) t)
- ;; Pure virtual
- :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
- ;; Template specifier.
- :template-specifier (nth 9 tokenpart)
- )))
- )
- ))
+ ;; The function
+ (semantic-tag-new-function
+ fnname
+ (or typedecl ;type
+ (cond ((car (nth 3 tokenpart) )
+ "void") ; Destructors have no return?
+ (constructor
+ ;; Constructors return an object.
+ (semantic-tag-new-type
+ ;; name
+ (or (car semantic-c-classname)
+ (let ((split (semantic-analyze-split-name-c-mode
+ (car (nth 2 tokenpart)))))
+ (if (stringp split) split
+ (car (last split)))))
+ ;; type
+ (or (cdr semantic-c-classname)
+ "class")
+ ;; members
+ nil
+ ;; parents
+ nil
+ ))
+ (t "int")))
+ ;; Argument list can contain things like function pointers
+ (semantic-c-reconstitute-function-arglist (nth 4 tokenpart))
+ :constant-flag (if (member "const" declmods) t nil)
+ :typemodifiers (delete "const" declmods)
+ :parent (car (nth 2 tokenpart))
+ :destructor-flag (if (car (nth 3 tokenpart) ) t)
+ :constructor-flag (if constructor t)
+ :function-pointer fcnpointer
+ :pointer (nth 7 tokenpart)
+ :operator-flag operator
+ ;; Even though it is "throw" in C++, we use
+ ;; `throws' as a common name for things that toss
+ ;; exceptions about.
+ :throws (nth 5 tokenpart)
+ ;; Reentrant is a C++ thingy. Add it here
+ :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
+ ;; A function post-const is funky. Try stuff
+ :methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
+ ;; prototypes are functions w/ no body
+ :prototype-flag (if (nth 8 tokenpart) t)
+ ;; Pure virtual
+ :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
+ ;; Template specifier.
+ :template-specifier (nth 9 tokenpart))))))
(defun semantic-c-reconstitute-template (tag specifier)
"Reconstitute the token TAG with the template SPECIFIER."
(semantic-tag-put-attribute tag :template (or specifier ""))
tag)
+(defun semantic-c-reconstitute-function-arglist (arglist)
+ "Reconstitute the argument list of a function.
+This currently only checks if the function expects a function
+pointer as argument."
+ (let (result)
+ (dolist (arg arglist)
+ ;; Names starting with a '*' denote a function pointer
+ (if (and (> (length (semantic-tag-name arg)) 0)
+ (= (aref (semantic-tag-name arg) 0) ?*))
+ (setq result
+ (append result
+ (list
+ (semantic-tag-new-function
+ (substring (semantic-tag-name arg) 1)
+ (semantic-tag-type arg)
+ (cadr (semantic-tag-attributes arg))
+ :function-pointer t))))
+ (setq result (append result (list arg)))))
+ result))
+
;;; Override methods & Variables
;;
@@ -1338,7 +1392,7 @@ Optional argument STAR and REF indicate the number of * and & in the typedef."
"Convert TAG to a string that is the print name for TAG.
Optional PARENT and COLOR are ignored."
(let ((name (semantic-format-tag-name-default tag parent color))
- (fnptr (semantic-tag-get-attribute tag :functionpointer-flag))
+ (fnptr (semantic-tag-get-attribute tag :function-pointer))
)
(if (not fnptr)
name
@@ -1546,7 +1600,7 @@ Optional PARENT and COLOR as specified with
"Return non-nil if TAG is considered abstract.
PARENT is tag's parent.
In C, a method is abstract if it is `virtual', which is already
-handled. A class is abstract iff its destructor is virtual."
+handled. A class is abstract only if its destructor is virtual."
(cond
((eq (semantic-tag-class tag) 'type)
(require 'semantic/find)
@@ -1602,7 +1656,7 @@ SPEC-LIST is the template specifier of the datatype instantiated."
(defun semantic-c--template-name-1 (spec-list)
"Return a string used to compute template class name.
-Based on SPEC-LIST, for ref<Foo,Bar> it will return 'Foo,Bar'."
+Based on SPEC-LIST, for ref<Foo,Bar> it will return `Foo,Bar'."
(when (car spec-list)
(let* ((endpart (semantic-c--template-name-1 (cdr spec-list)))
(separator (and endpart ",")))
@@ -1611,7 +1665,7 @@ Based on SPEC-LIST, for ref<Foo,Bar> it will return 'Foo,Bar'."
(defun semantic-c--template-name (type spec-list)
"Return a template class name for TYPE based on SPEC-LIST.
For a type `ref' with a template specifier of (Foo Bar) it will
-return 'ref<Foo,Bar>'."
+return `ref<Foo,Bar>'."
(concat (semantic-tag-name type)
"<" (semantic-c--template-name-1 (cdr spec-list)) ">"))
@@ -1639,7 +1693,7 @@ instantiated as specified in TYPE-DECLARATION."
;;; Patch here by "Raf" for instantiating templates.
(defun semantic-c-dereference-member-of (type scope &optional type-declaration)
"Dereference through the `->' operator of TYPE.
-Uses the return type of the '->' operator if it is contained in TYPE.
+Uses the return type of the `->' operator if it is contained in TYPE.
SCOPE is the current local scope to perform searches in.
TYPE-DECLARATION is passed through."
(if semantic-c-member-of-autocast
@@ -1655,8 +1709,8 @@ TYPE-DECLARATION is passed through."
;; tests 5 and following.
(defun semantic-c-dereference-namespace (type scope &optional type-declaration)
- "Dereference namespace which might hold an 'alias' for TYPE.
-Such an alias can be created through 'using' statements in a
+ "Dereference namespace which might hold an `alias' for TYPE.
+Such an alias can be created through `using' statements in a
namespace declaration. This function checks the namespaces in
SCOPE for such statements."
(let ((scopetypes (oref scope scopetypes))
@@ -1772,7 +1826,7 @@ or nil if it cannot be found."
(define-mode-local-override semantic-analyze-dereference-metatype
c-mode (type scope &optional type-declaration)
"Dereference TYPE as described in `semantic-analyze-dereference-metatype'.
-Handle typedef, template instantiation, and '->' operator."
+Handle typedef, template instantiation, and `->' operator."
(let* ((dereferencer-list '(semantic-c-dereference-typedef
semantic-c-dereference-template
semantic-c-dereference-member-of
@@ -1823,31 +1877,31 @@ DO NOT return the list of tags encompassing point."
(let ((idx 0)
(len (semanticdb-find-result-length tmp)))
(while (< idx len)
- (setq tagreturn (cons (semantic-tag-type (car (semanticdb-find-result-nth tmp idx))) tagreturn))
- (setq idx (1+ idx)))
- )
- ;; Use the encompassed types around point to also look for using statements.
- ;;(setq tagreturn (cons "bread_name" tagreturn))
- (while (cdr tagsaroundpoint) ; don't search the last one
- (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint))))
- (dolist (T tmp)
- (setq tagreturn (cons (semantic-tag-type T) tagreturn))
- )
- (setq tagsaroundpoint (cdr tagsaroundpoint))
- )
- ;; If in a function...
- (when (and (semantic-tag-of-class-p (car tagsaroundpoint) 'function)
- ;; ...search for using statements in the local scope...
- (setq tmp (semantic-find-tags-by-class
- 'using
- (semantic-get-local-variables))))
- ;; ... and add them.
- (setq tagreturn
- (append tagreturn
- (mapcar 'semantic-tag-type tmp))))
+ (setq tagreturn
+ (append tagreturn (list (semantic-tag-type
+ (car (semanticdb-find-result-nth tmp idx))))))
+ (setq idx (1+ idx))))
+ ;; Use the encompassed types around point to also look for using
+ ;; statements. If we deal with types, search inside members; for
+ ;; functions, we have to call `semantic-get-local-variables' to
+ ;; parse inside the function's body.
+ (dolist (cur tagsaroundpoint)
+ (cond
+ ((and (eq (semantic-tag-class cur) 'type)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-tag-components (car tagsaroundpoint)))))
+ (dolist (T tmp)
+ (setq tagreturn (cons (semantic-tag-type T) tagreturn))))
+ ((and (semantic-tag-of-class-p (car (last tagsaroundpoint)) 'function)
+ (setq tmp (semantic-find-tags-by-class
+ 'using
+ (semantic-get-local-variables))))
+ (setq tagreturn
+ (append tagreturn
+ (mapcar 'semantic-tag-type tmp))))))
;; Return the stuff
- tagreturn
- ))
+ tagreturn))
(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point)
"Return the list of using tag types in scope of POINT."
@@ -2122,7 +2176,8 @@ actually in their parent which is not accessible.")
(princ "\n\nInclude Path Summary:\n")
(when (and (boundp 'ede-object) ede-object)
- (princ "\n This file's project include is handled by:\n")
+ (princ (substitute-command-keys
+ "\n This file's project include is handled by:\n"))
(let ((objs (if (listp ede-object)
ede-object
(list ede-object))))
@@ -2140,14 +2195,16 @@ actually in their parent which is not accessible.")
)
(when semantic-dependency-include-path
- (princ "\n This file's generic include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's generic include path is:\n"))
(dolist (dir semantic-dependency-include-path)
(princ " ")
(princ dir)
(princ "\n")))
(when semantic-dependency-system-include-path
- (princ "\n This file's system include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's system include path is:\n"))
(dolist (dir semantic-dependency-system-include-path)
(princ " ")
(princ dir)
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
index 3fc5479f856..8aebcd64eb2 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/debug.el --- Debugger support for bovinator
-;; Copyright (C) 2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -83,7 +83,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
(let* ((nonterm (oref frame nonterm))
(pb (oref semantic-debug-current-interface parser-buffer))
@@ -102,7 +102,7 @@ LEXTOKEN, is a token returned by the lexer which is being matched."
(oref frame lextoken))
))
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
(message "%S" (oref frame collection))
)
@@ -125,12 +125,12 @@ Argument CONDITION is the thrown error condition."
frame)
frame))
-(defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-bovine-debug-error-frame))
"Highlight a frame from an action."
;; How do I get the location of the action in the source buffer?
)
-(defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-bovine-debug-error-frame))
"Display info about the error thrown."
(message "Error: %S" (oref frame condition)))
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index c6f1ceb0f94..1b223d287b2 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/el.el --- Semantic details for Emacs Lisp
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index 7beb8ff3203..1d3f7730f35 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -86,13 +86,11 @@ to give to the program."
(let ((chars (append line nil)))
(when (= 32 (nth 0 chars))
(let ((path (substring line 1)))
- (when (file-accessible-directory-p path)
- (when (if (memq system-type '(windows-nt))
- (/= ?/ (nth 1 chars))
- (= ?/ (nth 1 chars)))
- (add-to-list 'inc-path
- (expand-file-name (substring line 1))
- t)))))))))
+ (when (and (file-accessible-directory-p path)
+ (file-name-absolute-p path))
+ (add-to-list 'inc-path
+ (expand-file-name path)
+ t))))))))
inc-path))
@@ -139,9 +137,9 @@ to give to the program."
"The GCC setup data.
This is setup by `semantic-gcc-setup'.
This is an alist, and should include keys of:
- 'version - the version of gcc
- '--host - the host symbol (used in include directories)
- '--prefix - where GCC was installed.
+ `version' - the version of gcc
+ `--host' - the host symbol (used in include directories)
+ `--prefix' - where GCC was installed.
It should also include other symbols GCC was compiled with.")
;;;###autoload
@@ -166,8 +164,9 @@ It should also include other symbols GCC was compiled with.")
(host (or (cdr (assoc 'target fields))
(cdr (assoc '--target fields))
(cdr (assoc '--host fields))))
- (prefix (cdr (assoc '--prefix fields)))
+ ;; (prefix (cdr (assoc '--prefix fields)))
;; gcc output supplied paths
+ ;; FIXME: Where are `c-include-path' and `c++-include-path' used?
(c-include-path (semantic-gcc-get-include-paths "c"))
(c++-include-path (semantic-gcc-get-include-paths "c++"))
(gcc-exe (locate-file "gcc" exec-path exec-suffixes 'executable))
@@ -210,7 +209,8 @@ It should also include other symbols GCC was compiled with.")
(semantic-add-system-include D 'c-mode))
(dolist (D (semantic-gcc-get-include-paths "c++"))
(semantic-add-system-include D 'c++-mode)
- (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h"))))
+ (let ((cppconfig (list (concat D "/bits/c++config.h") (concat D "/sys/cdefs.h")
+ (concat D "/features.h"))))
(dolist (cur cppconfig)
;; Presumably there will be only one of these files in the try-paths list...
(when (file-readable-p cur)
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index 0133ee72b18..ebe2fd1d82e 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/grammar.el --- Bovine's input grammar mode
;;
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -395,16 +395,33 @@ manual."
(insert ")\n")
(buffer-string))))
+(defun bovine-grammar-calculate-source-on-path ()
+ "Calculate the location of the source for current buffer.
+The source directory is relative to some root in the load path."
+ (condition-case nil
+ (let* ((dir (nreverse (split-string (buffer-file-name) "/")))
+ (newdir (car dir)))
+ (setq dir (cdr dir))
+ ;; Keep trying the file name until it is on the path.
+ (while (and (not (locate-library newdir)) dir)
+ (setq newdir (concat (car dir) "/" newdir)
+ dir (cdr dir)))
+ (if (not dir)
+ (buffer-name)
+ newdir))
+ (error (buffer-name))))
+
(defun bovine-grammar-setupcode-builder ()
"Return the text of the setup code."
(format
"(setq semantic--parse-table %s\n\
semantic-debug-parser-source %S\n\
semantic-debug-parser-class 'semantic-bovine-debug-parser
+ semantic-debug-parser-debugger-source 'semantic/bovine/debug
semantic-flex-keywords-obarray %s\n\
%s)"
(semantic-grammar-parsetable)
- (buffer-name)
+ (bovine-grammar-calculate-source-on-path)
(semantic-grammar-keywordtable)
(let ((mode (semantic-grammar-languagemode)))
;; Is there more than one major mode?
@@ -443,34 +460,39 @@ Menu items are appended to the common grammar menu.")
)
"Semantic grammar macros used in bovine grammars.")
-(defun bovine-make-parsers ()
- "Generate Emacs' built-in Bovine-based parser files."
- (interactive)
- (semantic-mode 1)
- ;; Loop through each .by file in current directory, and run
- ;; `semantic-grammar-batch-build-one-package' to build the grammar.
- (dolist (f (directory-files default-directory nil "\\.by\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- lang filename copyright-end)
- (when (and packagename
- (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
- (setq lang (match-string 1 packagename))
- (setq filename (concat lang "-by.el"))
- (with-temp-buffer
- (insert-file-contents filename)
- (setq buffer-file-name (expand-file-name filename))
- ;; Fix copyright header:
- (goto-char (point-min))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert ";; This file is part of GNU Emacs.
+(defun bovine--make-parser-1 (infile &optional outdir)
+ (if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
+ ;; It would be nicer to use a temp-buffer rather than find-file-noselect.
+ ;; The only thing stopping us is bovine-grammar-setupcode-builder's
+ ;; use of (buffer-name). Perhaps that could be changed to
+ ;; (file-name-nondirectory (buffer-file-name)) ?
+;; (with-temp-buffer
+;; (insert-file-contents infile)
+;; (bovine-grammar-mode)
+;; (setq buffer-file-name (expand-file-name infile))
+;; (if outdir (setq default-directory outdir))
+ (let ((packagename
+ ;; This is with-demoted-errors.
+ (condition-case err
+ (with-current-buffer (find-file-noselect infile)
+ (if outdir (setq default-directory outdir))
+ (semantic-grammar-create-package nil t))
+ (error (message "%s" (error-message-string err)) nil)))
+ lang filename copyright-end)
+ (when (and packagename
+ (string-match "^.*/\\(.*\\)-by\\.el\\'" packagename))
+ (setq lang (match-string 1 packagename))
+ (setq filename (expand-file-name (concat lang "-by.el") outdir))
+ (with-temp-file filename
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert ";; 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
@@ -488,18 +510,50 @@ Menu items are appended to the common grammar menu.")
;;; Commentary:
;;
;; This file was generated from admin/grammars/"
- lang ".by.
+ lang ".by.
;;; Code:
")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (delete-trailing-whitespace)
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (save-buffer))))))
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (delete-trailing-whitespace)
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)))))
+
+(defun bovine-make-parsers ()
+ "Generate Emacs's built-in Bovine-based parser files."
+ (interactive)
+ (semantic-mode 1)
+ ;; Loop through each .by file in current directory, and run
+ ;; `semantic-grammar-batch-build-one-package' to build the grammar.
+ (dolist (f (directory-files default-directory nil "\\.by\\'"))
+ (bovine--make-parser-1 f)))
+
+
+(defun bovine-batch-make-parser (&optional infile outdir)
+ "Generate a Bovine parser from input INFILE, writing to OUTDIR.
+This is mainly intended for use in batch mode:
+
+emacs -batch -l semantic/bovine/grammar -f bovine-make-parser-batch \\
+ [-dir output-dir | -o output-file] file.by
+
+If -o is supplied, only the directory part is used."
+ (semantic-mode 1)
+ (when (and noninteractive (not infile))
+ (let (arg)
+ (while command-line-args-left
+ (setq arg (pop command-line-args-left))
+ (cond ((string-equal arg "-dir")
+ (setq outdir (pop command-line-args-left)))
+ ((string-equal arg "-o")
+ (setq outdir (file-name-directory (pop command-line-args-left))))
+ (t (setq infile arg))))))
+ (or infile (error "No input file specified"))
+ (or (file-readable-p infile)
+ (error "Input file `%s' not readable" infile))
+ (bovine--make-parser-1 infile outdir))
(provide 'semantic/bovine/grammar)
diff --git a/lisp/cedet/semantic/bovine/make-by.el b/lisp/cedet/semantic/bovine/make-by.el
deleted file mode 100644
index b94cfa44aac..00000000000
--- a/lisp/cedet/semantic/bovine/make-by.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;;; semantic/bovine/make-by.el --- Generated parser support file
-
-;; Copyright (C) 1999-2004, 2008-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/make.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst semantic-make-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("if" . IF)
- ("ifdef" . IFDEF)
- ("ifndef" . IFNDEF)
- ("ifeq" . IFEQ)
- ("ifneq" . IFNEQ)
- ("else" . ELSE)
- ("endif" . ENDIF)
- ("include" . INCLUDE))
- '(("include" summary "Macro: include filename1 filename2 ...")
- ("ifneq" summary "Conditional: ifneq (expression) ... else ... endif")
- ("ifeq" summary "Conditional: ifeq (expression) ... else ... endif")
- ("ifndef" summary "Conditional: ifndef (expression) ... else ... endif")
- ("ifdef" summary "Conditional: ifdef (expression) ... else ... endif")
- ("endif" summary "Conditional: if (expression) ... else ... endif")
- ("else" summary "Conditional: if (expression) ... else ... endif")
- ("if" summary "Conditional: if (expression) ... else ... endif")))
- "Table of language keywords.")
-
-(defconst semantic-make-by--token-table
- (semantic-lex-make-type-table
- '(("punctuation"
- (BACKSLASH . "\\`[\\]\\'")
- (DOLLAR . "\\`[$]\\'")
- (EQUAL . "\\`[=]\\'")
- (PLUS . "\\`[+]\\'")
- (COLON . "\\`[:]\\'")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-make-by--parse-table
- `(
- (bovine-toplevel
- (Makefile)
- ) ;; end bovine-toplevel
-
- (Makefile
- (bol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (bol
- variable
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- rule
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- conditional
- ,(semantic-lambda
- (nth 1 vals))
- )
- (bol
- include
- ,(semantic-lambda
- (nth 1 vals))
- )
- (whitespace
- ,(semantic-lambda
- (list nil))
- )
- (newline
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end Makefile
-
- (variable
- (symbol
- opt-whitespace
- equals
- opt-whitespace
- element-list
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 0 vals) nil
- (nth 4 vals)))
- )
- ) ;; end variable
-
- (rule
- (targets
- opt-whitespace
- colons
- opt-whitespace
- element-list
- commands
- ,(semantic-lambda
- (semantic-tag-new-function
- (nth 0 vals) nil
- (nth 4 vals)))
- )
- ) ;; end rule
-
- (targets
- (target
- opt-whitespace
- targets
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))
- (car
- (nth 2 vals))))
- )
- (target
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))))
- )
- ) ;; end targets
-
- (target
- (sub-target
- target
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- (car
- (nth 2 vals)))))
- )
- (sub-target
- ,(semantic-lambda
- (list
- (car
- (nth 0 vals))))
- )
- ) ;; end target
-
- (sub-target
- (symbol)
- (string)
- (varref)
- ) ;; end sub-target
-
- (conditional
- (IF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFDEF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFNDEF
- some-whitespace
- symbol
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFEQ
- some-whitespace
- expression
- newline
- ,(semantic-lambda
- (list nil))
- )
- (IFNEQ
- some-whitespace
- expression
- newline
- ,(semantic-lambda
- (list nil))
- )
- (ELSE
- newline
- ,(semantic-lambda
- (list nil))
- )
- (ENDIF
- newline
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end conditional
-
- (expression
- (semantic-list)
- ) ;; end expression
-
- (include
- (INCLUDE
- some-whitespace
- element-list
- ,(semantic-lambda
- (semantic-tag-new-include
- (nth 2 vals) nil))
- )
- ) ;; end include
-
- (equals
- (punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[+]\\'"
- punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[=]\\'"
- ,(semantic-lambda)
- )
- ) ;; end equals
-
- (colons
- (punctuation
- "\\`[:]\\'"
- punctuation
- "\\`[:]\\'"
- ,(semantic-lambda)
- )
- (punctuation
- "\\`[:]\\'"
- ,(semantic-lambda)
- )
- ) ;; end colons
-
- (element-list
- (elements
- newline
- ,(semantic-lambda
- (nth 0 vals))
- )
- ) ;; end element-list
-
- (elements
- (element
- some-whitespace
- elements
- ,(semantic-lambda
- (nth 0 vals)
- (nth 2 vals))
- )
- (element
- ,(semantic-lambda
- (nth 0 vals))
- )
- ( ;;EMPTY
- )
- ) ;; end elements
-
- (element
- (sub-element
- element
- ,(semantic-lambda
- (list
- (concat
- (car
- (nth 0 vals))
- (car
- (nth 1 vals)))))
- )
- ( ;;EMPTY
- )
- ) ;; end element
-
- (sub-element
- (symbol)
- (string)
- (punctuation)
- (semantic-list
- ,(semantic-lambda
- (list
- (buffer-substring-no-properties
- (identity start)
- (identity end))))
- )
- ) ;; end sub-element
-
- (varref
- (punctuation
- "\\`[$]\\'"
- semantic-list
- ,(semantic-lambda
- (list
- (buffer-substring-no-properties
- (identity start)
- (identity end))))
- )
- ) ;; end varref
-
- (commands
- (bol
- shell-command
- newline
- commands
- ,(semantic-lambda
- (list
- (nth 0 vals))
- (nth 1 vals))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end commands
-
- (opt-whitespace
- (some-whitespace
- ,(semantic-lambda
- (list nil))
- )
- ( ;;EMPTY
- )
- ) ;; end opt-whitespace
-
- (some-whitespace
- (whitespace
- some-whitespace
- ,(semantic-lambda
- (list nil))
- )
- (whitespace
- ,(semantic-lambda
- (list nil))
- )
- ) ;; end some-whitespace
- )
- "Parser table.")
-
-(defun semantic-make-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-make-by--parse-table
- semantic-debug-parser-source "make.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-make-by--keyword-table
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/make-by)
-
-;;; semantic/bovine/make-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 8ed94174f62..c001a4dab5f 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/make.el --- Makefile parsing rules.
-;; Copyright (C) 2000-2004, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2004, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -178,9 +178,8 @@ This is the same as a regular prototype."
makefile-mode (context)
"Return a list of possible completions in a Makefile.
Uses default implementation, and also gets a list of filenames."
- (save-excursion
- (require 'semantic/analyze/complete)
- (set-buffer (oref context buffer))
+ (require 'semantic/analyze/complete)
+ (with-current-buffer (oref context buffer)
(let* ((normal (semantic-analyze-possible-completions-default context))
(classes (oref context :prefixclass))
(filetags nil))
diff --git a/lisp/cedet/semantic/bovine/scm-by.el b/lisp/cedet/semantic/bovine/scm-by.el
deleted file mode 100644
index 261607c84d1..00000000000
--- a/lisp/cedet/semantic/bovine/scm-by.el
+++ /dev/null
@@ -1,196 +0,0 @@
-;;; semantic/bovine/scm-by.el --- Generated parser support file
-
-;; Copyright (C) 2001, 2003, 2009-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/scm.by.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst semantic-scm-by--keyword-table
- (semantic-lex-make-keyword-table
- '(("define" . DEFINE)
- ("define-module" . DEFINE-MODULE)
- ("load" . LOAD))
- '(("load" summary "Function: (load \"filename\")")
- ("define-module" summary "Function: (define-module (name arg1 ...)) ")
- ("define" summary "Function: (define symbol expression)")))
- "Table of language keywords.")
-
-(defconst semantic-scm-by--token-table
- (semantic-lex-make-type-table
- '(("close-paren"
- (CLOSEPAREN . ")"))
- ("open-paren"
- (OPENPAREN . "(")))
- 'nil)
- "Table of lexical tokens.")
-
-(defconst semantic-scm-by--parse-table
- `(
- (bovine-toplevel
- (scheme)
- ) ;; end bovine-toplevel
-
- (scheme
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'scheme-list))
- )
- ) ;; end scheme
-
- (scheme-list
- (open-paren
- "("
- scheme-in-list
- close-paren
- ")"
- ,(semantic-lambda
- (nth 1 vals))
- )
- ) ;; end scheme-list
-
- (scheme-in-list
- (DEFINE
- symbol
- expression
- ,(semantic-lambda
- (semantic-tag-new-variable
- (nth 1 vals) nil
- (nth 2 vals)))
- )
- (DEFINE
- name-args
- opt-doc
- sequence
- ,(semantic-lambda
- (semantic-tag-new-function
- (car
- (nth 1 vals)) nil
- (cdr
- (nth 1 vals))))
- )
- (DEFINE-MODULE
- name-args
- ,(semantic-lambda
- (semantic-tag-new-package
- (nth
- (length
- (nth 1 vals))
- (nth 1 vals)) nil))
- )
- (LOAD
- string
- ,(semantic-lambda
- (semantic-tag-new-include
- (file-name-nondirectory
- (read
- (nth 1 vals)))
- (read
- (nth 1 vals))))
- )
- (symbol
- ,(semantic-lambda
- (semantic-tag-new-code
- (nth 0 vals) nil))
- )
- ) ;; end scheme-in-list
-
- (name-args
- (semantic-list
- ,(lambda (vals start end)
- (semantic-bovinate-from-nonterminal
- (car
- (nth 0 vals))
- (cdr
- (nth 0 vals))
- 'name-arg-expand))
- )
- ) ;; end name-args
-
- (name-arg-expand
- (open-paren
- name-arg-expand
- ,(semantic-lambda
- (nth 1 vals))
- )
- (symbol
- name-arg-expand
- ,(semantic-lambda
- (cons
- (nth 0 vals)
- (nth 1 vals)))
- )
- ( ;;EMPTY
- ,(semantic-lambda)
- )
- ) ;; end name-arg-expand
-
- (opt-doc
- (string)
- ( ;;EMPTY
- )
- ) ;; end opt-doc
-
- (sequence
- (expression
- sequence)
- (expression)
- ) ;; end sequence
-
- (expression
- (symbol)
- (semantic-list)
- (string)
- (number)
- ) ;; end expression
- )
- "Parser table.")
-
-(defun semantic-scm-by--install-parser ()
- "Setup the Semantic Parser."
- (setq semantic--parse-table semantic-scm-by--parse-table
- semantic-debug-parser-source "scheme.by"
- semantic-debug-parser-class 'semantic-bovine-debug-parser
- semantic-flex-keywords-obarray semantic-scm-by--keyword-table
- ))
-
-
-;;; Analyzers
-;;
-
-;;; Epilogue
-;;
-
-(provide 'semantic/bovine/scm-by)
-
-;;; semantic/bovine/scm-by.el ends here
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 2a0425f43d2..745731c6485 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -1,6 +1,6 @@
;;; semantic/bovine/scm.el --- Semantic details for Scheme (guile)
-;;; Copyright (C) 2001-2004, 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2001-2004, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -69,8 +69,8 @@ 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_\\)+\\)"
- ;; (message (format "symbol: %s" (match-string 0)))
+ "\\(\\sw\\([:]\\|\\sw\\|\\s_\\)*\\)"
+ ;; (message "symbol: %s" (match-string 0))
(semantic-lex-push-token
(semantic-lex-token
(or (semantic-lex-keyword-p (match-string 0)) 'symbol)
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
index 1a546cdf7ab..51d9e7d8957 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -1,6 +1,6 @@
;;; semantic/chart.el --- Utilities for use with semantic tag tables
-;; Copyright (C) 1999-2001, 2003, 2005, 2008-2013 Free Software
+;; Copyright (C) 1999-2001, 2003, 2005, 2008-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index b42e24fb9c0..9b7882c7acd 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -1,6 +1,6 @@
;;; semantic/complete.el --- Routines for performing tag completion
-;; Copyright (C) 2003-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -118,6 +118,7 @@
(eval-when-compile
;; For the semantic-find-tags-for-completion macro.
(require 'semantic/find))
+(require 'semantic/db-find) ;For type semanticdb-find-result-with-nil.
;;; Code:
@@ -155,7 +156,7 @@ Presumably if you call this you will insert something new there."
"Display the string FMT formatted with ARGS at the end of the minibuffer."
(if semantic-complete-inline-overlay
(apply 'message fmt args)
- (message (concat (buffer-string) (apply 'format fmt args)))))
+ (apply 'message (concat "%s" fmt) (buffer-string) args)))
;;; ------------------------------------------------------------
;;; MINIBUFFER: Option Selection harnesses
@@ -187,6 +188,8 @@ Value should be a ... what?")
"Default history variable for any unhistoried prompt.
Keeps STRINGS only in the history.")
+(defvar semantic-complete-active-default)
+(defvar semantic-complete-current-matched-tag)
(defun semantic-complete-read-tag-engine (collector displayor prompt
default-tag initial-input
@@ -927,7 +930,7 @@ derive from this list.")
The only options available for completion are those which can be logically
inserted into the current context.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-analyze-completions) prefix completionlist)
"calculate the completions for prefix from completionlist."
;; if there are no completions yet, calculate them.
@@ -942,11 +945,11 @@ inserted into the current context.")
prefix
(oref obj first-pass-completions)))))
-(defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-cleanup ((obj semantic-collector-abstract))
"Clean up any mess this collector may have."
nil)
-(defmethod semantic-collector-next-action
+(cl-defmethod semantic-collector-next-action
((obj semantic-collector-abstract) partial)
"What should we do next? OBJ can be used to determine the next action.
PARTIAL indicates if we are doing a partial completion."
@@ -971,19 +974,19 @@ PARTIAL indicates if we are doing a partial completion."
'complete-whitespace)))
'complete))
-(defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
+(cl-defmethod semantic-collector-last-prefix= ((obj semantic-collector-abstract)
last-prefix)
"Return non-nil if OBJ's prefix matches PREFIX."
(and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) last-prefix)))
-(defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-cache ((obj semantic-collector-abstract))
"Get the raw cache of tags for completion.
Calculate the cache if there isn't one."
(or (oref obj cache)
(semantic-collector-calculate-cache obj)))
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-abstract) prefix completionlist)
"Calculate the completions for prefix from completionlist.
Output must be in semanticdb Find result format."
@@ -1002,7 +1005,7 @@ Output must be in semanticdb Find result format."
(if result
(list (cons table result)))))
-(defmethod semantic-collector-calculate-completions
+(cl-defmethod semantic-collector-calculate-completions
((obj semantic-collector-abstract) prefix partial)
"Calculate completions for prefix as setup for other queries."
(let* ((case-fold-search semantic-case-fold)
@@ -1079,7 +1082,7 @@ Output must be in semanticdb Find result format."
)))
))
-(defmethod semantic-collector-try-completion-whitespace
+(cl-defmethod semantic-collector-try-completion-whitespace
((obj semantic-collector-abstract) prefix)
"For OBJ, do whitespace completion based on PREFIX.
This implies that if there are two completions, one matching
@@ -1111,7 +1114,7 @@ has been run first."
)))
-(defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-exact-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
@@ -1119,12 +1122,12 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match)
(oref obj current-exact-match)))
-(defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-current-whitespace-completion ((obj semantic-collector-abstract))
"Return the active whitespace completion value."
(when (slot-boundp obj 'last-whitespace-completion)
(oref obj last-whitespace-completion)))
-(defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
+(cl-defmethod semantic-collector-get-match ((obj semantic-collector-abstract))
"Return the active valid MATCH from the semantic collector.
For now, just return the first element from our list of available
matches. For semanticdb based results, make sure the file is loaded
@@ -1132,7 +1135,7 @@ into a buffer."
(when (slot-boundp obj 'current-exact-match)
(semanticdb-find-result-nth-in-buffer (oref obj current-exact-match) 0)))
-(defmethod semantic-collector-all-completions
+(cl-defmethod semantic-collector-all-completions
((obj semantic-collector-abstract) prefix)
"For OBJ, retrieve all completions matching PREFIX.
The returned list consists of all the tags currently
@@ -1140,7 +1143,7 @@ matching PREFIX."
(when (slot-boundp obj 'last-all-completions)
(oref obj last-all-completions)))
-(defmethod semantic-collector-try-completion
+(cl-defmethod semantic-collector-try-completion
((obj semantic-collector-abstract) prefix)
"For OBJ, attempt to match PREFIX.
See `try-completion' for details on how this works.
@@ -1151,13 +1154,13 @@ with that name."
(if (slot-boundp obj 'last-completion)
(oref obj last-completion)))
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-abstract))
"Calculate the completion cache for OBJ."
nil
)
-(defmethod semantic-collector-flush ((this semantic-collector-abstract))
+(cl-defmethod semantic-collector-flush ((this semantic-collector-abstract))
"Flush THIS collector object, clearing any caches and prefix."
(oset this cache nil)
(slot-makeunbound this 'last-prefix)
@@ -1174,7 +1177,7 @@ with that name."
These collectors track themselves on a per-buffer basis."
:abstract t)
-(defmethod constructor :STATIC ((this semantic-collector-buffer-abstract)
+(cl-defmethod constructor ((this (subclass semantic-collector-buffer-abstract))
newname &rest fields)
"Reuse previously created objects of this type in buffer."
(let ((old nil)
@@ -1183,7 +1186,7 @@ These collectors track themselves on a per-buffer basis."
(if (eq (eieio-object-class (car bl)) this)
(setq old (car bl))))
(unless old
- (let ((new (call-next-method)))
+ (let ((new (cl-call-next-method)))
(add-to-list 'semantic-collector-per-buffer-list new)
(setq old new)))
(slot-makeunbound old 'last-completion)
@@ -1214,7 +1217,7 @@ NEWCACHE is the new tag table, but we ignore it."
When searching for a tag, uses semantic deep search functions.
Basics search only in the current buffer.")
-(defmethod semantic-collector-calculate-cache
+(cl-defmethod semantic-collector-calculate-cache
((obj semantic-collector-buffer-deep))
"Calculate the completion cache for OBJ.
Uses `semantic-flatten-tags-table'"
@@ -1244,7 +1247,7 @@ Uses semanticdb for searching all tags in the current project."
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(semanticdb-find-tags-for-completion prefix (oref obj path)))
@@ -1257,7 +1260,7 @@ Uses semanticdb for searching all tags in the current project."
(declare-function semanticdb-brute-deep-find-tags-for-completion
"semantic/db-find")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-project-brutish) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(require 'semantic/db-find)
@@ -1271,7 +1274,7 @@ Uses semanticdb for searching all tags in the current project."
"The scope the local members are being completed from."))
"Completion engine for tags in a project.")
-(defmethod semantic-collector-calculate-completions-raw
+(cl-defmethod semantic-collector-calculate-completions-raw
((obj semantic-collector-local-members) prefix completionlist)
"Calculate the completions for prefix from completionlist."
(let* ((scope (or (oref obj scope)
@@ -1320,11 +1323,11 @@ Provides the basics for a displayor, including interacting with
a collector, and tracking tables of completion to display."
:abstract t)
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-abstract))
"Clean up any mess this displayor may have."
nil)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(or (eq this-command 'semantic-complete-inline-TAB)
@@ -1333,33 +1336,33 @@ a collector, and tracking tables of completion to display."
'scroll
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
(oset obj table table)
(oset obj last-prefix prefix))
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-abstract))
"A request to show the current tags table."
(ding))
-(defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-request ((obj semantic-displayor-abstract))
"A request to for the displayor to focus on some tag option."
(ding))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-abstract))
"A request to for the displayor to scroll the completion list (if needed)."
(scroll-other-window))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-abstract))
"Set the current focus to the previous item."
nil)
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-abstract))
"Set the current focus to the next item."
nil)
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-abstract))
"Return a single tag currently in focus.
This object type doesn't do focus, so will never have a focus object."
nil)
@@ -1378,7 +1381,7 @@ Traditional display mechanism for a list of possible completions.
Completions are showin in a new buffer and listed with the ability
to click on the items to aid in completion.")
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-traditional))
"A request to show the current tags table."
;; NOTE TO SELF. Find the character to type next, and emphasize it.
@@ -1409,7 +1412,7 @@ Focusing is a way of differentiating among multiple tags
which have the same name."
:abstract t)
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-focus-abstract))
"The next action to take on the minibuffer related to display."
(if (and (slot-boundp obj 'last-prefix)
(string= (oref obj last-prefix) (semantic-completion-text))
@@ -1425,13 +1428,13 @@ which have the same name."
'focus)
'display))
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-focus-abstract)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(slot-makeunbound obj 'focus))
-(defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-previous ((obj semantic-displayor-focus-abstract))
"Set the current focus to the previous item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
@@ -1443,7 +1446,7 @@ Not meaningful return value."
)
)))
-(defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-next ((obj semantic-displayor-focus-abstract))
"Set the current focus to the next item.
Not meaningful return value."
(when (and (slot-boundp obj 'table) (oref obj table))
@@ -1456,13 +1459,13 @@ Not meaningful return value."
(oset obj focus 0))
)))
-(defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-focus-tag ((obj semantic-displayor-focus-abstract))
"Return the next tag OBJ should focus on."
(when (and (slot-boundp obj 'table) (oref obj table))
(with-slots (table) obj
(semanticdb-find-result-nth table (oref obj focus)))))
-(defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
+(cl-defmethod semantic-displayor-current-focus ((obj semantic-displayor-focus-abstract))
"Return the tag currently in focus, or call parent method."
(if (and (slot-boundp obj 'focus)
(slot-boundp obj 'table)
@@ -1478,7 +1481,7 @@ Not meaningful return value."
;; database.
(car (semanticdb-find-result-nth (oref obj table) (oref obj focus))))
;; Do whatever
- (call-next-method)))
+ (cl-call-next-method)))
;;; Simple displayor which performs traditional display completion,
;; and also focuses with highlighting.
@@ -1488,10 +1491,10 @@ Not meaningful return value."
"Display completions in *Completions* buffer, with focus highlight.
A traditional displayor which can focus on a tag by showing it.
Same as `semantic-displayor-traditional', but with selection between
-multiple tags with the same name done by 'focusing' on the source
+multiple tags with the same name done by focusing on the source
location of the different tags to differentiate them.")
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-traditional-with-focus-highlight))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and highlighting
@@ -1627,19 +1630,21 @@ This will not happen if you directly set this variable via `setq'."
"Display completions options in a tooltip.
Display mechanism using tooltip for a list of possible completions.")
-(defmethod initialize-instance :AFTER ((obj semantic-displayor-tooltip) &rest args)
+(cl-defmethod initialize-instance :after ((obj semantic-displayor-tooltip) &rest args)
"Make sure we have tooltips required."
(condition-case nil
(require 'tooltip)
(error nil))
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
+(defvar tooltip-mode)
+
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-tooltip))
"A request to show the current tags table."
(if (or (not (featurep 'tooltip)) (not tooltip-mode))
;; If we cannot use tooltips, then go to the normal mode with
;; a traditional completion buffer.
- (call-next-method)
+ (cl-call-next-method)
(let* ((tablelong (semanticdb-strip-find-results (oref obj table)))
(table (semantic-unique-tag-table-by-name tablelong))
(completions (mapcar semantic-completion-displayor-format-tag-function table))
@@ -1660,7 +1665,7 @@ Display mechanism using tooltip for a list of possible completions.")
(when (>= (oref obj typing-count) 5)
(oset obj mode 'standard)
(setq mode 'standard)
- (message "Resetting inline-mode to 'standard'."))
+ (message "Resetting inline-mode to `standard'."))
(when (and (> numcompl max-tags)
(< (oref obj typing-count) 2))
;; Discretely hint at completion availability.
@@ -1679,7 +1684,7 @@ Display mechanism using tooltip for a list of possible completions.")
(setq msg-tail (concat "\n[<TAB> " (number-to-string (- numcompl max-tags)) " more]"))
(setq msg-tail (concat "\n[<n/a> " (number-to-string (- numcompl max-tags)) " more]"))
(when (>= (oref obj typing-count) 2)
- (message "Refine search to display results beyond the '%s' limit"
+ (message "Refine search to display results beyond the `%s' limit"
(symbol-name 'semantic-complete-inline-max-tags-extended)))))
((= numcompl 1)
;; two possible cases
@@ -1702,23 +1707,19 @@ Display mechanism using tooltip for a list of possible completions.")
;;; Compatibility
;;
-(eval-and-compile
- (if (fboundp 'window-inside-edges)
- ;; Emacs devel.
- (defalias 'semantic-displayor-window-edges
- 'window-inside-edges)
- ;; Emacs 21
- (defalias 'semantic-displayor-window-edges
- 'window-edges)
- ))
(defun semantic-displayor-point-position ()
"Return the location of POINT as positioned on the selected frame.
Return a cons cell (X . Y)"
(let* ((frame (selected-frame))
- (left (or (car-safe (cdr-safe (frame-parameter frame 'left)))
- (frame-parameter frame 'left)))
- (top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
+ (toolbarleft
+ (if (eq (cdr (assoc 'tool-bar-position default-frame-alist)) 'left)
+ (tool-bar-pixel-width)
+ 0))
+ (left (+ (or (car-safe (cdr-safe (frame-parameter frame 'left)))
+ (frame-parameter frame 'left))
+ toolbarleft))
+ (top (or (car-safe (cdr-safe (frame-parameter frame 'top)))
(frame-parameter frame 'top)))
(point-pix-pos (posn-x-y (posn-at-point)))
(edges (window-inside-pixel-edges (selected-window))))
@@ -1726,6 +1727,9 @@ Return a cons cell (X . Y)"
(+ (cdr point-pix-pos) (cadr edges) top))))
+(defvar tooltip-frame-parameters)
+(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+
(defun semantic-displayor-tooltip-show (text)
"Display a tooltip with TEXT near cursor."
(let ((point-pix-pos (semantic-displayor-point-position))
@@ -1739,7 +1743,7 @@ Return a cons cell (X . Y)"
tooltip-frame-parameters)
(tooltip-show text)))
-(defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
+(cl-defmethod semantic-displayor-scroll-request ((obj semantic-displayor-tooltip))
"A request to for the displayor to scroll the completion list (if needed)."
;; Do scrolling in the tooltip.
(oset obj max-tags-initial 30)
@@ -1765,9 +1769,9 @@ Completion displayor using ghost chars after point for focus options.
Whichever completion is currently in focus will be displayed as ghost
text using overlay options.")
-(defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-next-action ((obj semantic-displayor-ghost))
"The next action to take on the inline completion related to display."
- (let ((ans (call-next-method))
+ (let ((ans (cl-call-next-method))
(table (when (slot-boundp obj 'table)
(oref obj table))))
(if (and (eq ans 'displayend)
@@ -1777,22 +1781,22 @@ text using overlay options.")
nil
ans)))
-(defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-cleanup ((obj semantic-displayor-ghost))
"Clean up any mess this displayor may have."
(when (slot-boundp obj 'ghostoverlay)
(semantic-overlay-delete (oref obj ghostoverlay)))
)
-(defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
+(cl-defmethod semantic-displayor-set-completions ((obj semantic-displayor-ghost)
table prefix)
"Set the list of tags to be completed over to TABLE."
- (call-next-method)
+ (cl-call-next-method)
(semantic-displayor-cleanup obj)
)
-(defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
+(cl-defmethod semantic-displayor-show-request ((obj semantic-displayor-ghost))
"A request to show the current tags table."
; (if (oref obj first-show)
; (progn
@@ -1803,11 +1807,11 @@ text using overlay options.")
;; Only do the traditional thing if the first show request
;; has been seen. Use the first one to start doing the ghost
;; text display.
-; (call-next-method)
+; (cl-call-next-method)
; )
)
-(defmethod semantic-displayor-focus-request
+(cl-defmethod semantic-displayor-focus-request
((obj semantic-displayor-ghost))
"Focus in on possible tag completions.
Focus is performed by cycling through the tags and showing a possible
@@ -1860,7 +1864,7 @@ completion text in ghost text."
(list 'const
:tag doc1
C)))
- (eieio-build-class-alist semantic-displayor-abstract t))
+ (eieio-build-class-alist 'semantic-displayor-abstract t))
)
"Possible options for inline completion displayors.
Use this to enable custom editing.")
@@ -1963,7 +1967,7 @@ completion works."
(complst nil))
(when (and thissym (or (not (string= thissym ""))
nextsym))
- ;; Do a quick calcuation of completions.
+ ;; Do a quick calculation of completions.
(semantic-collector-calculate-completions
collector thissym nil)
;; Get the master list
@@ -2043,7 +2047,7 @@ completion works."
(complst nil))
(when (and thissym (or (not (string= thissym ""))
nextsym))
- ;; Do a quick calcuation of completions.
+ ;; Do a quick calculation of completions.
(semantic-collector-calculate-completions
collector thissym nil)
;; Get the master list
@@ -2213,6 +2217,7 @@ use `semantic-complete-analyze-inline' to complete."
;; input.
(when (save-window-excursion
(save-excursion
+ ;; FIXME: Use `while-no-input'?
(and (not (semantic-exit-on-input 'csi
(semantic-fetch-tags)
(semantic-throw-on-input 'csi)
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index b010a30da7f..33b9a2e6037 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -1,6 +1,6 @@
;;; semantic/ctxt.el --- Context calculations for Semantic tools.
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -168,8 +168,7 @@ Uses the bovinator with the special top-symbol `bovine-inner-scope'
to collect tags, such as local variables or prototypes."
;; This assumes a bovine parser. Make sure we don't do
;; anything in that case.
- (when (and semantic--parse-table (not (eq semantic--parse-table t))
- (not (semantic-parse-tree-unparseable-p)))
+ (when (and semantic--parse-table (not (eq semantic--parse-table t)))
(let ((vars (semantic-get-cache-data 'get-local-variables)))
(if vars
(progn
@@ -363,7 +362,7 @@ This skips forward over symbols in a complex reference.
For example, in the C statement:
this.that().entry;
-If the cursor is on 'this', will move point to the ; after entry.")
+If the cursor is on `this', will move point to the ; after entry.")
(defun semantic-ctxt-end-of-symbol-default (&optional point)
"Move point to the end of the current symbol under POINT.
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index 8b121587147..15f544746eb 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -1,6 +1,6 @@
;;; semantic/db-debug.el --- Extra level debugging routines for Semantic
-;;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index a62ac549ea7..2199a7d9862 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -1,6 +1,6 @@
;;; semantic/db-ebrowse.el --- Semanticdb backend using ebrowse.
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; Joakim Verona
@@ -192,7 +192,7 @@ is specified by `semanticdb-default-save-directory'."
If DIRECTORY is found to be defunct, it won't load the DB, and will
warn instead."
(if (file-directory-p directory)
- (semanticdb-create-database semanticdb-project-database-ebrowse
+ (semanticdb-create-database 'semanticdb-project-database-ebrowse
directory)
(let* ((BF (semanticdb-ebrowse-file-for-directory directory))
(BFL (concat BF "-load.el"))
@@ -224,7 +224,7 @@ warn instead."
()
"Search Ebrowse for symbols.")
-(defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
+(cl-defmethod semanticdb-needs-refresh-p ((table semanticdb-table-ebrowse))
"EBROWSE database do not need to be refreshed.
JAVE: stub for needs-refresh, because, how do we know if BROWSE files
@@ -282,7 +282,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE"
;;; Methods for creating a database or tables
;;
-(defmethod semanticdb-create-database :STATIC ((dbeC semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-create-database ((dbeC (subclass semanticdb-project-database-ebrowse))
directory)
"Create a new semantic database for DIRECTORY based on ebrowse.
If there is no database for DIRECTORY available, then
@@ -325,7 +325,7 @@ If there is no database for DIRECTORY available, then
db)))
-(defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
+(cl-defmethod semanticdb-ebrowse-strip-trees ((dbe semanticdb-project-database-ebrowse)
data)
"For the ebrowse database DBE, strip all tables from DATA."
;JAVE what it actually seems to do is split the original tree in "tables" associated with files
@@ -479,7 +479,7 @@ Optional argument BASECLASSES specifies a baseclass to the tree being provided."
;;;
;; Overload for converting the simple faux tag into something better.
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-ebrowse) tags)
"Convert in Ebrowse database OBJ a list of TAGS into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAGS
@@ -521,7 +521,7 @@ return that."
(setq tags (cdr tags))))
tagret))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-ebrowse) tag)
"Convert in Ebrowse database OBJ one TAG into a complete tag.
The default tag provided by searches exclude many features of a
semantic parsed tag. Look up the file for OBJ, and match TAG
@@ -569,48 +569,48 @@ return that."
;; NOTE WHEN IMPLEMENTING: Be sure to add doc-string updates explaining
;; how your new search routines are implemented.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
;;(message "semanticdb-find-tags-by-name-method name -- %s" name)
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; If we ever need to do something special, add here.
;; Since ebrowse tags are converted into semantic tags, we can
;; get away with this sort of thing.
- (call-next-method)
+ (cl-call-next-method)
)
)
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
- (call-next-method)
+ (cl-call-next-method)
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-ebrowse) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
- (call-next-method)))
+ (if tags (cl-call-next-method)
+ (cl-call-next-method)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -621,38 +621,38 @@ Returns a table of all matching tags."
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-ebrowse) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-method table name tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-ebrowse) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for ebrowse."
;;(semanticdb-find-tags-by-name-regexp-method table regex tags)
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-ebrowse) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-for-completion-method' for ebrowse."
;;(semanticdb-find-tags-for-completion-method table prefix tags)
- (call-next-method))
+ (cl-call-next-method))
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-ebrowse) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; Ebrowse collects all this type of stuff together for us.
;; but we can't use it.... yet.
nil
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 3376389c7d5..432f638475a 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -1,6 +1,6 @@
;;; semantic/db-el.el --- Semantic database extensions for Emacs Lisp
-;;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -44,16 +44,16 @@
)
"A table for returning search results from Emacs.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table-emacs-lisp) &optional force)
"Do not refresh Emacs Lisp table.
It does not need refreshing."
nil)
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table-emacs-lisp))
"Return nil, we never need a refresh."
nil)
-(defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
@@ -67,7 +67,7 @@ Adds the number of tags in this file to the object print name."
)
"Database representing Emacs core.")
-(defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database-emacs-lisp) &rest strings)
"Pretty printer extension for `semanticdb-table-emacs-lisp'.
Adds the number of tags in this file to the object print name."
(let ((count 0))
@@ -90,7 +90,7 @@ the omniscience database.")
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-emacs-lisp))
"For an Emacs Lisp database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; We need to return something since there is always the "master table"
@@ -101,34 +101,34 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-emacs-lisp) filename)
"From OBJ, return FILENAME's associated table object.
For Emacs Lisp, creates a specialized table."
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-emacs-lisp ))
"Return the list of tags belonging to TABLE."
;; specialty table ? Probably derive tags at request time.
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-emacs-lisp) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
(with-current-buffer buffer
(eq (or mode-local-active-mode major-mode) 'emacs-lisp-mode)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table-emacs-lisp))
"Fetch the full filename that OBJ refers to.
For Emacs Lisp system DB, there isn't one."
nil)
;;; Conversion
;;
-(defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-table-emacs-lisp) tags)
"Convert tags, originating from Emacs OBJ, into standardized form."
(let ((newtags nil))
(dolist (T tags)
@@ -138,7 +138,7 @@ For Emacs Lisp system DB, there isn't one."
;; There is no promise to have files associated.
(nreverse newtags)))
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-table-emacs-lisp) tag)
"Convert one TAG, originating from Emacs OBJ, into standardized form.
If Emacs cannot resolve this symbol to a particular file, then return nil."
;; Here's the idea. For each tag, get the name, then use
@@ -223,7 +223,11 @@ TOKTYPE is a hint to the type of tag desired."
(symbol-name sym)
"class"
(semantic-elisp-desymbolify
- (eieio--class-public-a (class-v semanticdb-project-database))) ;; slots
+ (let ((class (find-class sym)))
+ (if (fboundp 'eieio--class-public-a) ; Emacs < 25.1
+ (eieio--class-public-a class)
+ (mapcar #'eieio-slot-descriptor-name
+ (eieio-class-slots class)))))
(semantic-elisp-desymbolify (eieio-class-parents sym)) ;; parents
))
((not toktype)
@@ -243,12 +247,12 @@ TOKTYPE is a hint to the type of tag desired."
(defvar semanticdb-elisp-mapatom-collector nil
"Variable used to collect `mapatoms' output.")
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags named NAME in TABLE.
Uses `intern-soft' to match NAME to Emacs symbols.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; No need to search. Use `intern-soft' which does the same thing for us.
(let* ((sym (intern-soft name))
(fun (semanticdb-elisp-sym->tag sym 'function))
@@ -264,52 +268,52 @@ Return a list of tags."
taglst
))))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Uses `apropos-internal' to find matches.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(apropos-internal regex)))))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(delq nil (mapcar 'semanticdb-elisp-sym->tag
(all-completions prefix obarray)))))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-emacs-lisp) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; We could implement this, but it could be messy.
nil))
;;; Deep Searches
;;
;; For Emacs Lisp deep searches are like top level searches.
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-emacs-lisp) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-emacs-lisp) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for Emacs Lisp."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-emacs-lisp) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
@@ -318,12 +322,12 @@ Like `semanticdb-find-tags-for-completion-method' for Emacs Lisp."
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-emacs-lisp) type &optional tags)
"Find all nonterminals which are child elements of TYPE
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; EIEIO is the only time this matters
(when (featurep 'eieio)
(let* ((class (intern-soft type))
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index 2ef4fba1288..f38153b18c1 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -1,6 +1,6 @@
;;; semantic/db-file.el --- Save a semanticdb to a cache file.
-;;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -123,7 +123,7 @@ To save the version number, we must hand-set this version string.")
;;; Code:
;;
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database-file))
directory)
"Create a new semantic database for DIRECTORY and return it.
If a database for DIRECTORY has already been loaded, return it.
@@ -158,7 +158,8 @@ If DIRECTORY doesn't exist, create a new one."
(defun semanticdb-load-database (filename)
"Load the database FILENAME."
(condition-case foo
- (let* ((r (eieio-persistent-read filename semanticdb-project-database-file))
+ (let* ((r (eieio-persistent-read filename
+ 'semanticdb-project-database-file))
(c (semanticdb-get-database-tables r))
(tv (oref r semantic-tag-version))
(fv (oref r semanticdb-version))
@@ -196,7 +197,7 @@ If DIRECTORY doesn't exist, create a new one."
"Return the project belonging to FILENAME if it was already loaded."
(eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
-(defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-file-directory-exists-p ((DB semanticdb-project-database-file)
&optional suppress-questions)
"Does the directory the database DB needs to write to exist?
If SUPPRESS-QUESTIONS, then do not ask to create the directory."
@@ -218,7 +219,7 @@ If SUPPRESS-QUESTIONS, then do not ask to create the directory."
(setq semanticdb--inhibit-make-directory t))
nil))))
-(defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database-file)
&optional
suppress-questions)
"Write out the database DB to its file.
@@ -258,13 +259,13 @@ If DB is not specified, then use the current database."
)
))
-(defmethod semanticdb-live-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-project-database))
"Return non-nil if the file associated with OBJ is live.
Live databases are objects associated with existing directories."
(and (slot-boundp obj 'reference-directory)
(file-exists-p (oref obj reference-directory))))
-(defmethod semanticdb-live-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-live-p ((obj semanticdb-table))
"Return non-nil if the file associated with OBJ is live.
Live files are either buffers in Emacs, or files existing on the filesystem."
(let ((full-filename (semanticdb-full-filename obj)))
@@ -278,7 +279,7 @@ to prevent overload.")
(declare-function data-debug-insert-thing "data-debug")
-(defmethod object-write ((obj semanticdb-table))
+(cl-defmethod object-write ((obj semanticdb-table))
"When writing a table, we have to make sure we deoverlay it first.
Restore the overlays after writing.
Argument OBJ is the object to write."
@@ -311,7 +312,7 @@ Argument OBJ is the object to write."
;; Do it!
(condition-case tableerror
- (call-next-method)
+ (cl-call-next-method)
(error
(when semanticdb-data-debug-on-write-error
(require 'data-debug)
@@ -327,7 +328,7 @@ Argument OBJ is the object to write."
;;; State queries
;;
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database-file))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
(let ((path semanticdb-persistent-path))
@@ -359,25 +360,25 @@ Uses `semanticdb-persistent-path' to determine the return value."
(throw 'found t))
(t (error "Invalid path %S" (car path))))
(setq path (cdr path)))
- (call-next-method))
+ (cl-call-next-method))
))
;;; Filename manipulation
;;
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-file) filename)
"From OBJ, return FILENAME's associated table object."
;; Cheater option. In this case, we always have files directly
;; under ourselves. The main project type may not.
(object-assoc (file-name-nondirectory filename) 'file (oref obj tables)))
-(defmethod semanticdb-file-name-non-directory :STATIC
- ((dbclass semanticdb-project-database-file))
+(cl-defmethod semanticdb-file-name-non-directory
+ ((dbclass (subclass semanticdb-project-database-file)))
"Return the file name DBCLASS will use.
File name excludes any directory part."
semanticdb-default-file-name)
-(defmethod semanticdb-file-name-directory :STATIC
- ((dbclass semanticdb-project-database-file) directory)
+(cl-defmethod semanticdb-file-name-directory
+ ((dbclass (subclass semanticdb-project-database-file)) directory)
"Return the relative directory to where DBCLASS will save its cache file.
The returned path is related to DIRECTORY."
(if semanticdb-default-save-directory
@@ -388,8 +389,8 @@ The returned path is related to DIRECTORY."
file (file-name-as-directory semanticdb-default-save-directory)))
directory))
-(defmethod semanticdb-cache-filename :STATIC
- ((dbclass semanticdb-project-database-file) path)
+(cl-defmethod semanticdb-cache-filename
+ ((dbclass (subclass semanticdb-project-database-file)) path)
"For DBCLASS, return a file to a cache file belonging to PATH.
This could be a cache file in the current directory, or an encoded file
name in a secondary directory."
@@ -398,7 +399,7 @@ name in a secondary directory."
(concat (semanticdb-file-name-directory dbclass path)
(semanticdb-file-name-non-directory dbclass)))
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database-file))
"Fetch the full filename that OBJ refers to."
(oref obj file))
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 91b1e34b690..293f535d60b 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1,6 +1,6 @@
;;; semantic/db-find.el --- Searching through semantic databases.
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -196,7 +196,7 @@ expunge duplicates.")
"Concrete search index for `semanticdb-find'.
This class will cache data derived during various searches.")
-(defmethod semantic-reset ((idx semanticdb-find-search-index))
+(cl-defmethod semantic-reset ((idx semanticdb-find-search-index))
"Reset the object IDX."
(require 'semantic/scope)
;; Clear the include path.
@@ -208,7 +208,7 @@ This class will cache data derived during various searches.")
(semantic-scope-reset-cache)
)
-(defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; Reset our parts.
@@ -220,7 +220,7 @@ This class will cache data derived during various searches.")
(semantic-reset (semanticdb-get-table-index tab))))
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-find-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; Only reset if include statements changed.
@@ -297,7 +297,7 @@ refreshed when things change. See `semanticdb-ref-test'.
Note for overloading: If you opt to overload this function for your
major mode, and your routine takes a long time, be sure to call
- (semantic-throw-on-input 'your-symbol-here)
+ (semantic-throw-on-input \\='your-symbol-here)
so that it can be called from the idle work handler."
)
@@ -1114,7 +1114,7 @@ for backward compatibility.
If optional argument BRUTISH is non-nil, then ignore include statements,
and search all tables in this project tree."
(let (found match)
- (save-excursion
+ (save-current-buffer
;; If path is a buffer, set ourselves up in that buffer
;; so that the override methods work correctly.
(when (bufferp path) (set-buffer path))
@@ -1127,7 +1127,7 @@ and search all tables in this project tree."
;; databases and not associated with a file.
(unless (and find-file-match
(obj-of-class-p
- (car tableandtags) semanticdb-search-results-table))
+ (car tableandtags) 'semanticdb-search-results-table))
(when (setq match (funcall function
(car tableandtags) (cdr tableandtags)))
(when find-file-match
@@ -1144,7 +1144,7 @@ and search all tables in this project tree."
;; `semanticdb-search-results-table', since those are system
;; databases and not associated with a file.
(unless (and find-file-match
- (obj-of-class-p table semanticdb-search-results-table))
+ (obj-of-class-p table 'semanticdb-search-results-table))
(when (and table (setq match (funcall function table nil)))
(semanticdb-find-log-activity table match)
(when find-file-match
@@ -1304,25 +1304,25 @@ associated with that tag should be loaded into a buffer."
;; Override these with system databases to as new types of back ends.
;;; Top level Searches
-(defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name name (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(semantic-find-tags-for-completion prefix (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
+(cl-defmethod semanticdb-find-tags-by-class-method ((table semanticdb-abstract-table) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -1333,14 +1333,14 @@ Returns a table of all matching tags."
(semantic-find-tags-included (or tags (semanticdb-get-tags table)))
(semantic-find-tags-by-class class (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
(require 'semantic/find)
(semantic-find-tags-external-children-of-type parent (or tags (semanticdb-get-tags table))))
-(defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
+(cl-defmethod semanticdb-find-tags-subclasses-of-type-method ((table semanticdb-abstract-table) parent &optional tags)
"In TABLE, find all occurrences of tags whose parent is the PARENT type.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
@@ -1348,7 +1348,7 @@ Returns a table of all matching tags."
(semantic-find-tags-subclasses-of-type parent (or tags (semanticdb-get-tags table))))
;;; Deep Searches
-(defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-method ((table semanticdb-abstract-table) name &optional tags)
"In TABLE, find all occurrences of tags with NAME.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
@@ -1356,7 +1356,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags."
(semantic-find-tags-by-name name (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method ((table semanticdb-abstract-table) regexp &optional tags)
"In TABLE, find all occurrences of tags matching REGEXP.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
@@ -1364,7 +1364,7 @@ Optional argument TAGS is a list of tags to search.
Return a table of all matching tags."
(semantic-find-tags-by-name-regexp regexp (semantic-flatten-tags-table (or tags (semanticdb-get-tags table)))))
-(defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method ((table semanticdb-abstract-table) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Search in all tags in TABLE, and all components of top level tags in
TABLE.
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index 70d5f6ecc05..b95fa34cb3c 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -1,6 +1,6 @@
;;; semantic/db-global.el --- Semantic database extensions for GLOBAL
-;; Copyright (C) 2002-2006, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2006, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -112,12 +112,12 @@ if optional DONT-ERR-IF-NOT-AVAILABLE is non-nil; else throw an error."
)
"A table for returning search results from GNU Global.")
-(defmethod object-print ((obj semanticdb-table-global) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table-global) &rest strings)
"Pretty printer extension for `semanticdb-table-global'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj (cons " (proxy)" strings)))
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-global) &optional buffer)
"Return t, pretend that this table's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -126,7 +126,7 @@ local variable."
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-global))
"For a global database, there are no explicit tables.
For each file hit, get the traditional semantic table from that file."
;; We need to return something since there is always the "master table"
@@ -138,9 +138,9 @@ For each file hit, get the traditional semantic table from that file."
(oset newtable tags nil)
))
- (call-next-method))
+ (cl-call-next-method))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-global) filename)
"From OBJ, return FILENAME's associated table object."
;; We pass in "don't load". I wonder if we need to avoid that or not?
(car (semanticdb-get-database-tables obj))
@@ -150,13 +150,13 @@ For each file hit, get the traditional semantic table from that file."
;;
;; Only NAME based searches work with GLOBAL as that is all it tracks.
;;
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
;; Call out to GNU Global for some results.
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-name name 'project))
@@ -167,12 +167,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project))
)
@@ -180,12 +180,12 @@ Return a list of tags."
(semantic-symref-result-get-tags result))
)))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-completion prefix 'project))
(faketags nil)
@@ -206,21 +206,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-global) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-global) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for global."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-global) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index dbb3b84be0d..4aced34d8ef 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -1,6 +1,6 @@
;;; semantic/db-javascript.el --- Semantic database extensions for javascript
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Joakim Verona
@@ -111,7 +111,7 @@ the omniscience database.")
;;; Filename based methods
;;
-(defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
+(cl-defmethod semanticdb-get-database-tables ((obj semanticdb-project-database-javascript))
"For a javascript database, there are no explicit tables.
Create one of our special tables that can act as an intermediary."
;; NOTE: This method overrides an accessor for the `tables' slot in
@@ -126,23 +126,23 @@ Create one of our special tables that can act as an intermediary."
(oset newtable parent-db obj)
(oset newtable tags nil)
))
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database-javascript) filename)
"From OBJ, return FILENAME's associated table object."
;; NOTE: See not for `semanticdb-get-database-tables'.
(car (semanticdb-get-database-tables obj))
)
-(defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
+(cl-defmethod semanticdb-get-tags ((table semanticdb-table-javascript ))
"Return the list of tags belonging to TABLE."
;; NOTE: Omniscient databases probably don't want to keep large tables
;; lolly-gagging about. Keep internal Emacs tables empty and
;; refer to alternate databases when you need something.
semanticdb-javascript-tags)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table-javascript) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
@@ -192,43 +192,43 @@ database (if available.)"
(setq tags (cdr tags)))
result))
-(defmethod semanticdb-find-tags-by-name-method
+(cl-defmethod semanticdb-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags named NAME in TABLE.
Return a list of tags."
(if tags
;; If TAGS are passed in, then we don't need to do work here.
- (call-next-method)
+ (cl-call-next-method)
(assoc-string name semanticdb-javascript-tags)
))
-(defmethod semanticdb-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search regex)
))
-(defmethod semanticdb-find-tags-for-completion-method
+(cl-defmethod semanticdb-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
(semanticdb-javascript-regexp-search (concat "^" prefix ".*"))
))
-(defmethod semanticdb-find-tags-by-class-method
+(cl-defmethod semanticdb-find-tags-by-class-method
((table semanticdb-table-javascript) class &optional tags)
"In TABLE, find all occurrences of tags of CLASS.
Optional argument TAGS is a list of tags to search.
Returns a table of all matching tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; Note: This search method could be considered optional in an
@@ -244,21 +244,21 @@ Returns a table of all matching tags."
;; alone, otherwise replace with implementations similar to those
;; above.
;;
-(defmethod semanticdb-deep-find-tags-by-name-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-method
((table semanticdb-table-javascript) name &optional tags)
"Find all tags name NAME in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-method table name tags))
-(defmethod semanticdb-deep-find-tags-by-name-regexp-method
+(cl-defmethod semanticdb-deep-find-tags-by-name-regexp-method
((table semanticdb-table-javascript) regex &optional tags)
"Find all tags with name matching REGEX in TABLE.
Optional argument TAGS is a list of tags to search.
Like `semanticdb-find-tags-by-name-method' for javascript."
(semanticdb-find-tags-by-name-regexp-method table regex tags))
-(defmethod semanticdb-deep-find-tags-for-completion-method
+(cl-defmethod semanticdb-deep-find-tags-for-completion-method
((table semanticdb-table-javascript) prefix &optional tags)
"In TABLE, find all occurrences of tags matching PREFIX.
Optional argument TAGS is a list of tags to search.
@@ -267,12 +267,12 @@ Like `semanticdb-find-tags-for-completion-method' for javascript."
;;; Advanced Searches
;;
-(defmethod semanticdb-find-tags-external-children-of-type-method
+(cl-defmethod semanticdb-find-tags-external-children-of-type-method
((table semanticdb-table-javascript) type &optional tags)
"Find all nonterminals which are child elements of TYPE.
Optional argument TAGS is a list of tags to search.
Return a list of tags."
- (if tags (call-next-method)
+ (if tags (cl-call-next-method)
;; YOUR IMPLEMENTATION HERE
;;
;; OPTIONAL: This could be considered an optional function. It is
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 7d147113a92..433d5ae4fd1 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -1,6 +1,6 @@
;;; semantic/db-mode.el --- Semanticdb Minor Mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -66,7 +66,7 @@ database, which can be saved for future Emacs sessions."
(add-hook (cadr elt) (car elt)))
;; Disable
(dolist (elt semanticdb-hooks)
- (add-hook (cadr elt) (car elt)))))
+ (remove-hook (cadr elt) (car elt)))))
(defvaralias 'semanticdb-mode-hook 'global-semanticdb-minor-mode-hook)
(defvaralias 'semanticdb-global-mode 'global-semanticdb-minor-mode)
@@ -82,7 +82,7 @@ Update the environment of Semantic enabled buffers accordingly."
;; Save databases before disabling semanticdb.
(semanticdb-save-all-db))
;; Toggle semanticdb minor mode.
- (global-semanticdb-minor-mode))
+ (global-semanticdb-minor-mode 'toggle))
;;; Hook Functions:
;;
@@ -105,7 +105,8 @@ Sets up the semanticdb environment."
(oset ctbl major-mode major-mode)
;; Local state
(setq semanticdb-current-table ctbl)
- ;; Try to swap in saved tags
+ (oset ctbl buffer (current-buffer))
+ ;; Try to swap in saved tags
(if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags))
(/= (or (oref ctbl pointmax) 0) (point-max))
)
@@ -133,7 +134,6 @@ Sets up the semanticdb environment."
(semantic--set-buffer-cache (oref ctbl tags))
;; Don't need it to be dirty. Set dirty due to hooks from above.
(oset ctbl dirty nil) ;; Special case here.
- (oset ctbl buffer (current-buffer))
;; Bind into the buffer.
(semantic--tag-link-cache-to-buffer)
)
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index 2d00d07b9cf..445dcfe5c20 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -1,6 +1,6 @@
;;; semantic/db-ref.el --- Handle cross-db file references
-;;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -37,6 +37,7 @@
;;; Code:
(require 'eieio)
+(require 'cl-generic)
(require 'semantic)
(require 'semantic/db)
(require 'semantic/tag)
@@ -44,7 +45,7 @@
;; For the semantic-find-tags-by-name-regexp macro.
(eval-when-compile (require 'semantic/find))
-(defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
+(cl-defmethod semanticdb-add-reference ((dbt semanticdb-abstract-table)
include-tag)
"Add a reference for the database table DBT based on INCLUDE-TAG.
DBT is the database table that owns the INCLUDE-TAG. The reference
@@ -66,18 +67,18 @@ will be added to the database that INCLUDE-TAG refers to."
(object-add-to-list refdbt 'db-refs dbt)
t)))
-(defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-abstract-table))
"Check and cleanup references in the database DBT.
Abstract tables would be difficult to reference."
;; Not sure how an abstract table can have references.
nil)
-(defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-includes-in-table ((dbt semanticdb-abstract-table))
"Return a list of direct includes in table DBT."
(semantic-find-tags-by-class 'include (semanticdb-get-tags dbt)))
-(defmethod semanticdb-check-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-check-references ((dbt semanticdb-table))
"Check and cleanup references in the database DBT.
Any reference to a file that cannot be found, or whos file no longer
refers to DBT will be removed."
@@ -108,13 +109,13 @@ refers to DBT will be removed."
))
(setq refs (cdr refs)))))
-(defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-abstract-table))
"Refresh references to DBT in other files."
;; alternate tables can't be edited, so can't be changed.
nil
)
-(defmethod semanticdb-refresh-references ((dbt semanticdb-table))
+(cl-defmethod semanticdb-refresh-references ((dbt semanticdb-table))
"Refresh references to DBT in other files."
(let ((refs (semanticdb-includes-in-table dbt))
)
@@ -127,7 +128,7 @@ refers to DBT will be removed."
(setq refs (cdr refs)))
))
-(defmethod semanticdb-notify-references ((dbt semanticdb-table)
+(cl-defmethod semanticdb-notify-references ((dbt semanticdb-table)
method)
"Notify all references of the table DBT using method.
METHOD takes two arguments.
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index a20ff83aec8..20b5b3f9ea0 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -1,6 +1,6 @@
;;; semantic/db-typecache.el --- Manage Datatypes
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -67,7 +67,7 @@ Said object must support `semantic-reset' methods.")
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-typecache))
"Reset the object IDX."
(oset tc filestream nil)
(oset tc includestream nil)
@@ -78,14 +78,14 @@ Said object must support `semantic-reset' methods.")
(oset tc dependants nil)
)
-(defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
+(cl-defmethod semanticdb-typecache-notify-reset ((tc semanticdb-typecache))
"Do a reset from a notify from a table we depend on."
(oset tc includestream nil)
(mapc 'semantic-reset (oref tc dependants))
(oset tc dependants nil)
)
-(defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((tc semanticdb-typecache)
new-tags)
"Reset the typecache based on a partial reparse."
(when (semantic-find-tags-by-class 'include new-tags)
@@ -125,7 +125,7 @@ Debugging function."
(t -1) ))
-(defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-typecache ((table semanticdb-abstract-table))
"Retrieve the typecache from the semanticdb TABLE.
If there is no table, create one, and fill it in."
(semanticdb-refresh-table table)
@@ -141,7 +141,7 @@ If there is no table, create one, and fill it in."
cache))
-(defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-have-typecache-p ((table semanticdb-abstract-table))
"Return non-nil (the typecache) if TABLE has a pre-calculated typecache."
(let* ((idx (semanticdb-get-table-index table)))
(oref idx type-cache)))
@@ -162,25 +162,25 @@ If there is no table, create one, and fill it in."
)
"Structure for maintaining a typecache.")
-(defmethod semantic-reset ((tc semanticdb-database-typecache))
+(cl-defmethod semantic-reset ((tc semanticdb-database-typecache))
"Reset the object IDX."
(oset tc stream nil)
)
-(defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-database-typecache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
)
-(defmethod semanticdb-get-typecache ((db semanticdb-project-database))
+(cl-defmethod semanticdb-get-typecache ((db semanticdb-project-database))
"Retrieve the typecache from the semantic database DB.
If there is no table, create one, and fill it in."
- (semanticdb-cache-get db semanticdb-database-typecache)
+ (semanticdb-cache-get db 'semanticdb-database-typecache)
)
@@ -312,11 +312,11 @@ If TAG has fully qualified names, expand it to a series of nested
namespaces instead."
tag)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-file-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the file-tags.
File-tags are those that belong to this file only, and excludes
all included files."
@@ -338,11 +338,11 @@ all included files."
(oref cache filestream)
))
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-abstract-table))
"No tags available from non-file based tables."
nil)
-(defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
+(cl-defmethod semanticdb-typecache-include-tags ((table semanticdb-table))
"Update the typecache for TABLE, and return the merged types from the include tags.
Include-tags are the tags brought in via includes, all merged together into
a master list."
@@ -418,7 +418,7 @@ is of class 'type."
(types (semantic-find-tags-by-class 'type nmerge)))
(or (car-safe types) (car-safe nmerge))))
-(defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table)
type find-file-match)
"Search the typecache in TABLE for the datatype TYPE.
If type is a string, split the string, and search for the parts.
@@ -544,7 +544,7 @@ found tag to be loaded."
;;
;; Routines for a typecache that crosses all tables in a given database
;; for a matching major-mode.
-(defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
+(cl-defmethod semanticdb-typecache-for-database ((db semanticdb-project-database)
&optional mode)
"Return the typecache for the project database DB.
If there isn't one, create it.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 8d9cfcccd7d..e4ac56cdab4 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -1,6 +1,6 @@
;;; semantic/db.el --- Semantic tag database manager
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: tags
@@ -115,32 +115,44 @@ This table is the root of tables, and contains the minimum needed
for a new table not associated with a buffer."
:abstract t)
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
"Return a nil, meaning abstract table OBJ is not in a buffer."
nil)
-(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
"Return a buffer associated with OBJ.
If the buffer is not in memory, load it with `find-file-noselect'."
nil)
-(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
+;; This generic method allows for sloppier coding. Many
+;; functions treat "table" as something that could be a buffer,
+;; file name, or other. This makes use of table more robust.
+(cl-defmethod semanticdb-full-filename (buffer-or-string)
+ "Fetch the full filename that BUFFER-OR-STRING refers to.
+This uses semanticdb to get a better file name."
+ (cond ((bufferp buffer-or-string)
+ (with-current-buffer buffer-or-string
+ (semanticdb-full-filename semanticdb-current-table)))
+ ((and (stringp buffer-or-string) (file-exists-p buffer-or-string))
+ (expand-file-name buffer-or-string))))
+
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
- "Return non-nil if OBJ is 'dirty'."
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
+ "Return non-nil if OBJ is dirty."
nil)
-(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
"Mark the abstract table OBJ dirty.
Abstract tables can not be marked dirty, as there is nothing
for them to synchronize against."
;; The abstract table can not be dirty.
nil)
-(defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
+(cl-defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
"For the table OBJ, convert a list of TAGS, into standardized form.
The default is to return TAGS.
Some databases may default to searching and providing simplified tags
@@ -148,7 +160,7 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form."
tags)
-(defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
+(cl-defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
"For the table OBJ, convert a TAG, into standardized form.
This method returns a list of the form (DATABASE . NEWTAG).
@@ -159,14 +171,14 @@ based on whichever technique used. This method provides a hook for
them to convert TAG into a more complete form."
(cons obj tag))
-(defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
"Pretty printer extension for `semanticdb-abstract-table'.
Adds the number of tags in this file to the object print name."
(if (or (not strings)
(and (= (length strings) 1) (stringp (car strings))
(string= (car strings) "")))
;; Else, add a tags quantifier.
- (call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
+ (cl-call-next-method obj (format " (%d tags)" (length (semanticdb-get-tags obj))))
;; Pass through.
(apply 'call-next-method obj strings)
))
@@ -183,7 +195,7 @@ The search index will store data about which other tables might be
needed, or perhaps create hash or index tables for the current buffer."
:abstract t)
-(defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
+(cl-defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
"Return the search index for the table OBJ.
If one doesn't exist, create it."
(if (slot-boundp obj 'index)
@@ -197,13 +209,13 @@ If one doesn't exist, create it."
(oset obj index idx)
idx)))
-(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
+(cl-defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
new-tags)
"Synchronize the search index IDX with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -221,7 +233,7 @@ If one doesn't exist, create it."
Examples include search results from external sources such as from
Emacs's own symbol table, or from external libraries.")
-(defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-search-results-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
This will call `semantic-fetch-tags' if that file is in memory."
nil)
@@ -273,7 +285,7 @@ For C/C++, the C preprocessor macros can be saved here.")
)
"A single table of tags derived from file.")
-(defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer."
(let ((buff (oref obj buffer)))
@@ -281,7 +293,7 @@ If the buffer is in memory, return that buffer."
buff
(oset obj buffer nil))))
-(defmethod semanticdb-get-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-get-buffer ((obj semanticdb-table))
"Return a buffer associated with OBJ.
If the buffer is in memory, return that buffer.
If the buffer is not in memory, load it with `find-file-noselect'."
@@ -290,26 +302,26 @@ If the buffer is not in memory, load it with `find-file-noselect'."
(save-match-data
(find-file-noselect (semanticdb-full-filename obj) t))))
-(defmethod semanticdb-set-buffer ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-buffer ((obj semanticdb-table))
"Set the current buffer to be a buffer owned by OBJ.
If OBJ's file is not loaded, read it in first."
(set-buffer (semanticdb-get-buffer obj)))
-(defmethod semanticdb-full-filename ((obj semanticdb-table))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-table))
"Fetch the full filename that OBJ refers to."
(expand-file-name (oref obj file)
(oref (oref obj parent-db) reference-directory)))
-(defmethod semanticdb-dirty-p ((obj semanticdb-table))
- "Return non-nil if OBJ is 'dirty'."
+(cl-defmethod semanticdb-dirty-p ((obj semanticdb-table))
+ "Return non-nil if OBJ is dirty."
(oref obj dirty))
-(defmethod semanticdb-set-dirty ((obj semanticdb-table))
+(cl-defmethod semanticdb-set-dirty ((obj semanticdb-table))
"Mark the abstract table OBJ dirty."
(oset obj dirty t)
)
-(defmethod object-print ((obj semanticdb-table) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-table) &rest strings)
"Pretty printer extension for `semanticdb-table'.
Adds the number of tags in this file to the object print name."
(apply 'call-next-method obj
@@ -318,6 +330,10 @@ Adds the number of tags in this file to the object print name."
;;; DATABASE BASE CLASS
;;
+(unless (fboundp 'semanticdb-abstract-table-list-p)
+ (cl-deftype semanticdb-abstract-table-list ()
+ '(list-of semanticdb-abstract-table)))
+
(defclass semanticdb-project-database (eieio-instance-tracker)
((tracking-symbol :initform semanticdb-database-list)
(reference-directory :type string
@@ -347,13 +363,13 @@ Note: This index will not be saved in a persistent file.")
:documentation "List of `semantic-db-table' objects."))
"Database of file tables.")
-(defmethod semanticdb-full-filename ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-full-filename ((obj semanticdb-project-database))
"Fetch the full filename that OBJ refers to.
Abstract tables do not have file names associated with them."
nil)
-(defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
- "Return non-nil if DB is 'dirty'.
+(cl-defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
+ "Return non-nil if DB is dirty.
A database is dirty if the state of the database changed in a way
where it may need to resynchronize with some persistent storage."
(let ((dirty nil)
@@ -363,7 +379,7 @@ where it may need to resynchronize with some persistent storage."
(setq tabs (cdr tabs)))
dirty))
-(defmethod object-print ((obj semanticdb-project-database) &rest strings)
+(cl-defmethod object-print ((obj semanticdb-project-database) &rest strings)
"Pretty printer extension for `semanticdb-project-database'.
Adds the number of tables in this file to the object print name."
(apply 'call-next-method obj
@@ -374,7 +390,7 @@ Adds the number of tables in this file to the object print name."
)
strings)))
-(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory)
+(cl-defmethod semanticdb-create-database ((dbc (subclass semanticdb-project-database)) directory)
"Create a new semantic database of class DBC for DIRECTORY and return it.
If a database for DIRECTORY has already been created, return it.
If DIRECTORY doesn't exist, create a new one."
@@ -388,11 +404,11 @@ If DIRECTORY doesn't exist, create a new one."
(oset db reference-directory (file-truename directory)))
db))
-(defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
+(cl-defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
"Reset the tables in DB to be empty."
(oset db tables nil))
-(defmethod semanticdb-create-table ((db semanticdb-project-database) file)
+(cl-defmethod semanticdb-create-table ((db semanticdb-project-database) file)
"Create a new table in DB for FILE and return it.
The class of DB contains the class name for the type of table to create.
If the table for FILE exists, return it.
@@ -409,7 +425,7 @@ If the table for FILE does not exist, create one."
(object-add-to-list db 'tables newtab t))
newtab))
-(defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
+(cl-defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
"From OBJ, return FILENAME's associated table object."
(object-assoc (file-relative-name (file-truename filename)
(oref obj reference-directory))
@@ -459,7 +475,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
desired-class)
"Get a cache object on TABLE of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
@@ -469,7 +485,7 @@ other than :table."
(let ((cache (oref table cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
@@ -479,18 +495,18 @@ other than :table."
(object-add-to-list table 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list table 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -510,7 +526,7 @@ In order to keep your cache up to date, be sure to implement
See the file semantic/scope.el for an example."
:abstract t)
-(defmethod semanticdb-cache-get ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-get ((db semanticdb-project-database)
desired-class)
"Get a cache object on DB of class DESIRED-CLASS.
This method will create one if none exists with no init arguments
@@ -520,7 +536,7 @@ other than :table."
(let ((cache (oref db cache))
(obj nil))
(while (and (not obj) cache)
- (if (eq (eieio--object-class (car cache)) desired-class)
+ (if (eq (eieio-object-class (car cache)) desired-class)
(setq obj (car cache)))
(setq cache (cdr cache)))
(if obj
@@ -530,19 +546,19 @@ other than :table."
(object-add-to-list db 'cache obj)
obj)))
-(defmethod semanticdb-cache-remove ((db semanticdb-project-database)
+(cl-defmethod semanticdb-cache-remove ((db semanticdb-project-database)
cache)
"Remove from TABLE the cache object CACHE."
(object-remove-from-list db 'cache cache))
-(defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
;; The abstract class will do... NOTHING!
)
-(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; The abstract class will do... NOTHING!
@@ -550,7 +566,7 @@ other than :table."
;;; REFRESH
-(defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
+(cl-defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
"If the tag list associated with OBJ is loaded, refresh it.
Optional argument FORCE will force a refresh even if the file in question
is not in a buffer. Avoid using FORCE for most uses, as an old cache
@@ -560,8 +576,9 @@ This will call `semantic-fetch-tags' if that file is in memory."
;;
;; Already in a buffer, just do it.
((semanticdb-in-buffer-p obj)
- (semanticdb-set-buffer obj)
- (semantic-fetch-tags))
+ (save-excursion
+ (semanticdb-set-buffer obj)
+ (semantic-fetch-tags)))
;;
;; Not in a buffer. Forcing a load.
(force
@@ -576,7 +593,7 @@ This will call `semantic-fetch-tags' if that file is in memory."
;; Kill off the buffer if it didn't exist when we were called.
(kill-buffer buff))))))
-(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
+(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
"Return non-nil of OBJ's tag list is out of date.
The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj))
@@ -607,7 +624,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; Synchronization
;;
-(defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE with some NEW-TAGS."
(oset table tags new-tags)
@@ -638,7 +655,7 @@ The file associated with OBJ does not need to be in a buffer."
(semanticdb-refresh-references table)
)
-(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
+(cl-defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
new-tags)
"Synchronize the table TABLE where some NEW-TAGS changed."
;; You might think we need to reset the tags, but since the partial
@@ -671,7 +688,7 @@ The file associated with OBJ does not need to be in a buffer."
;;; SAVE/LOAD
;;
-(defmethod semanticdb-save-db ((DB semanticdb-project-database)
+(cl-defmethod semanticdb-save-db ((DB semanticdb-project-database)
&optional suppress-questions)
"Cause a database to save itself.
The database base class does not save itself persistently.
@@ -697,7 +714,7 @@ form."
(interactive)
(unless noninteractive
(message "Saving tag summaries..."))
- (let ((semanticdb--inhibit-make-directory nil))
+ (let ((semanticdb--inhibit-make-directory noninteractive))
(mapc 'semanticdb-save-db semanticdb-database-list))
(unless noninteractive
(message "Saving tag summaries...done")))
@@ -706,6 +723,7 @@ form."
"Save all semantic tag databases from idle time.
Exit the save between databases if there is user input."
(semantic-safe "Auto-DB Save: %S"
+ ;; FIXME: Use `while-no-input'?
(semantic-exit-on-input 'semanticdb-idle-save
(mapc (lambda (db)
(semantic-throw-on-input 'semanticdb-idle-save)
@@ -724,7 +742,7 @@ Project Management software (such as EDE and JDE) should add their own
predicates with `add-hook' to this variable, and semanticdb will save tag
caches in directories controlled by them.")
-(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
+(cl-defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
"Return non-nil if OBJ should be written to disk.
Uses `semanticdb-persistent-path' to determine the return value."
nil)
@@ -755,7 +773,7 @@ This temporarily sets `semanticdb-match-any-mode' while executing BODY."
,@body))
(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
-(defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
See `semanticdb-equivalent-mode' for details.
This version is used during searches. Major-modes that opt
@@ -766,13 +784,13 @@ all files of any type."
(semanticdb-equivalent-mode table buffer))
)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
nil)
-(defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
+(cl-defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
"Return non-nil if TABLE's mode is equivalent to BUFFER.
Equivalent modes are specified by the `semantic-equivalent-major-modes'
local variable."
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index 775f98fe4e0..4a3c51f4e0c 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -1,6 +1,6 @@
;;; semantic/debug.el --- Language Debugger framework
-;; Copyright (C) 2003-2005, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -39,6 +39,7 @@
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(eval-when-compile (require 'semantic/find))
;;; Code:
@@ -57,6 +58,12 @@ to one of the parser generators.")
;;;###autoload
(make-variable-buffer-local 'semantic-debug-parser-class)
+;;;###autoload
+(defvar semantic-debug-parser-debugger-source nil
+ "Location of the debug parser class.")
+;;;###autoload
+(make-variable-buffer-local 'semantic-debug-parser-source)
+
(defvar semantic-debug-enabled nil
"Non-nil when debugging a parser.")
@@ -104,19 +111,20 @@ These buffers are brought into view when layout occurs.")
"The currently displayed frame.")
(overlays :type list
:initarg nil
+ :initform nil
:documentation
"Any active overlays being used to show the debug position.")
)
"Controls action when in `semantic-debug-mode'")
;; Methods
-(defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
+(cl-defmethod semantic-debug-set-frame ((iface semantic-debug-interface) frame)
"Set the current frame on IFACE to FRAME."
(if frame
(oset iface current-frame frame)
(slot-makeunbound iface 'current-frame)))
-(defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-parser-location ((iface semantic-debug-interface) point)
"Set the parser location in IFACE to POINT."
(with-current-buffer (oref iface parser-buffer)
(if (not (slot-boundp iface 'parser-location))
@@ -124,7 +132,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface parser-location) point))
)
-(defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
+(cl-defmethod semantic-debug-set-source-location ((iface semantic-debug-interface) point)
"Set the source location in IFACE to POINT."
(with-current-buffer (oref iface source-buffer)
(if (not (slot-boundp iface 'source-location))
@@ -132,7 +140,7 @@ These buffers are brought into view when layout occurs.")
(move-marker (oref iface source-location) point))
)
-(defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-interface-layout ((iface semantic-debug-interface))
"Layout windows in the current frame to facilitate debugging."
(delete-other-windows)
;; Deal with the data buffer
@@ -160,7 +168,7 @@ These buffers are brought into view when layout occurs.")
(goto-char (oref iface source-location)))
)
-(defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
+(cl-defmethod semantic-debug-highlight-lexical-token ((iface semantic-debug-interface) token)
"For IFACE, highlight TOKEN in the source buffer .
TOKEN is a lexical token."
(set-buffer (oref iface :source-buffer))
@@ -171,7 +179,7 @@ TOKEN is a lexical token."
(semantic-debug-set-source-location iface (semantic-lex-token-start token))
)
-(defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
+(cl-defmethod semantic-debug-highlight-rule ((iface semantic-debug-interface) nonterm &optional rule match)
"For IFACE, highlight NONTERM in the parser buffer.
NONTERM is the name of the rule currently being processed that shows up
as a nonterminal (or tag) in the source buffer.
@@ -219,7 +227,7 @@ If RULE and MATCH indices are specified, highlight those also."
))))
-(defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
+(cl-defmethod semantic-debug-unhighlight ((iface semantic-debug-interface))
"Remove all debugging overlays."
(mapc 'semantic-overlay-delete (oref iface overlays))
(oset iface overlays nil))
@@ -264,12 +272,12 @@ on different types of return values."
)
"One frame representation.")
-(defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame))
"Highlight one parser frame."
)
-(defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
+(cl-defmethod semantic-debug-frame-info ((frame semantic-debug-frame))
"Display info about this one parser frame."
)
@@ -323,15 +331,18 @@ Argument ONOFF is non-nil when we are entering debug mode.
(oref semantic-debug-current-interface parser-buffer)
(use-local-map
(oref semantic-debug-current-interface parser-local-map))
+ (setq buffer-read-only nil)
)
(with-current-buffer
(oref semantic-debug-current-interface source-buffer)
(use-local-map
(oref semantic-debug-current-interface source-local-map))
+ (setq buffer-read-only nil)
)
(run-hooks 'semantic-debug-exit-hook)
)))
+;;;###autoload
(defun semantic-debug ()
"Parse the current buffer and run in debug mode."
(interactive)
@@ -341,6 +352,9 @@ Argument ONOFF is non-nil when we are entering debug mode.
(error "This major mode does not support parser debugging"))
;; Clear the cache to force a full reparse.
(semantic-clear-toplevel-cache)
+ ;; Load in the debugger for this file.
+ (when semantic-debug-parser-debugger-source
+ (require semantic-debug-parser-debugger-source))
;; Do the parse
(let ((semantic-debug-enabled t)
;; Create an interface
@@ -508,49 +522,49 @@ by overriding one of the command methods. Be sure to use
down to your parser later."
:abstract t)
-(defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-next ((parser semantic-debug-parser))
"Execute next for this PARSER."
(setq semantic-debug-user-command 'next)
)
-(defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-step ((parser semantic-debug-parser))
"Execute a step for this PARSER."
(setq semantic-debug-user-command 'step)
)
-(defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-go ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'go)
)
-(defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-fail ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'fail)
)
-(defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-quit ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'quit)
)
-(defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-abort ((parser semantic-debug-parser))
"Continue execution in this PARSER until the next breakpoint."
(setq semantic-debug-user-command 'abort)
)
-(defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-print-state ((parser semantic-debug-parser))
"Print state for this PARSER at the current breakpoint."
(with-slots (current-frame) semantic-debug-current-interface
(when current-frame
(semantic-debug-frame-info current-frame)
)))
-(defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-break ((parser semantic-debug-parser))
"Set a breakpoint for this PARSER."
)
;; Stack stuff
-(defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
+(cl-defmethod semantic-debug-parser-frames ((parser semantic-debug-parser))
"Return a list of frames for the current parser.
A frame is of the form:
( .. .what ? .. )
diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el
index 5bd683fcd22..6707fdff40c 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -1,6 +1,6 @@
;;; semantic/decorate.el --- Utilities for decorating/highlighting tokens.
-;;; Copyright (C) 1999-2003, 2005-2007, 2009-2013 Free Software
+;;; Copyright (C) 1999-2003, 2005-2007, 2009-2015 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -88,20 +88,6 @@ If VISIBLE is non-nil, make the text visible."
"Return non-nil if TAG is invisible."
(semantic-overlay-get (semantic-tag-overlay tag) 'invisible))
-(defun semantic-set-tag-intangible (tag &optional tangible)
- "Enable the text in TAG to be made intangible.
-If TANGIBLE is non-nil, make the text visible.
-This function does not have meaning in XEmacs because it seems that
-the extent 'intangible' property does not exist."
- (semantic-overlay-put (semantic-tag-overlay tag) 'intangible
- (not tangible)))
-
-(defun semantic-tag-intangible-p (tag)
- "Return non-nil if TAG is intangible.
-This function does not have meaning in XEmacs because it seems that
-the extent 'intangible' property does not exist."
- (semantic-overlay-get (semantic-tag-overlay tag) 'intangible))
-
(defun semantic-overlay-signal-read-only
(overlay after start end &optional len)
"Hook used in modification hooks to prevent modification.
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index 0451ad44fe8..1974e0ade07 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/include.el --- Decoration modes for include statements
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -42,8 +42,8 @@
;;; Code:
;;; FACES AND KEYMAPS
-(defvar semantic-decoratiton-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
- "The keybinding lisp object to use for binding the right mouse button.")
+(defvar semantic-decoration-mouse-3 (if (featurep 'xemacs) [ button3 ] [ mouse-3 ])
+ "The keybinding Lisp object to use for binding the right mouse button.")
;;; Includes that are in a happy state!
;;
@@ -55,7 +55,7 @@ Used by the decoration style: `semantic-decoration-on-includes'."
(defvar semantic-decoration-on-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-include-menu)
km)
"Keymap used on includes.")
@@ -126,7 +126,7 @@ Used by the decoration style: `semantic-decoration-on-unknown-includes'."
(defvar semantic-decoration-on-unknown-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-unknown-include-describe)
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unknown-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unknown-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -189,7 +189,7 @@ Used by the decoration style: `semantic-decoration-on-fileless-includes'."
(defvar semantic-decoration-on-fileless-include-map
(let ((km (make-sparse-keymap)))
;(define-key km [ mouse-2 ] 'semantic-decoration-fileless-include-describe)
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-fileless-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-fileless-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -251,7 +251,7 @@ Used by the decoration style: `semantic-decoration-on-unparsed-includes'."
(defvar semantic-decoration-on-unparsed-include-map
(let ((km (make-sparse-keymap)))
- (define-key km semantic-decoratiton-mouse-3 'semantic-decoration-unparsed-include-menu)
+ (define-key km semantic-decoration-mouse-3 'semantic-decoration-unparsed-include-menu)
km)
"Keymap used on unparsed includes.")
@@ -335,6 +335,9 @@ This mode provides a nice context menu on the include statements."
(defun semantic-decoration-on-includes-highlight-default (tag)
"Highlight the include TAG to show that semantic can't find it."
(let* ((file (semantic-dependency-tag-file tag))
+ ;; Don't actually load includes
+ (semanticdb-find-default-throttle
+ (remq 'unloaded semanticdb-find-default-throttle))
(table (semanticdb-find-table-for-include tag (current-buffer)))
(face nil)
(map nil)
@@ -365,8 +368,8 @@ This mode provides a nice context menu on the include statements."
(semanticdb-cache-get
table 'semantic-decoration-unparsed-include-cache)
;; Add a dependency.
- (let ((table semanticdb-current-table))
- (semanticdb-add-reference table tag))
+ (let ((currenttable semanticdb-current-table))
+ (semanticdb-add-reference currenttable tag))
)
))
@@ -500,7 +503,8 @@ Argument EVENT is the mouse clicked event."
(princ "Include File: ")
(princ (semantic-format-tag-name tag nil t))
(princ "\n\n")
- (princ "This header file has been marked \"Unknown\".
+ (princ (substitute-command-keys "\
+This header file has been marked \"Unknown\".
This means that Semantic has not been able to locate this file on disk.
When Semantic cannot find an include file, this means that the
@@ -518,9 +522,9 @@ M-x semantic-add-system-include RET /path/to/includes RET
or, in your .emacs file do:
- (semantic-add-system-include \"/path/to/include\" '")
+ (semantic-add-system-include \"/path/to/include\" \\='"))
(princ (symbol-name mm))
- (princ ")
+ (princ (substitute-command-keys ")
to add the path to Semantic's search.
@@ -528,7 +532,7 @@ If this is an include file that belongs to your project, then you may
need to update `semanticdb-project-roots' or better yet, use `ede'
to manage your project. See the ede manual for projects that will
wrap existing project code for Semantic's benefit.
-")
+"))
(when (or (eq mm 'c++-mode) (eq mm 'c-mode))
(princ "
@@ -536,7 +540,7 @@ For C/C++ includes located within a project, you can use a special
EDE project that will wrap an existing build system. You can do that
like this in your .emacs file:
- (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn 'MYFCN)
+ (ede-cpp-root-project \"NAME\" :file \"FILENAME\" :locate-fcn \\='MYFCN)
See the CEDET manual, the EDE manual, or the commentary in
ede/cpp-root.el for more.
@@ -742,7 +746,8 @@ Argument EVENT describes the event that caused this function to be called."
(when (and (boundp 'ede-object)
(boundp 'ede-object-project)
ede-object)
- (princ " This file's project include search is handled by the EDE object:\n")
+ (princ (substitute-command-keys
+ " This file's project include search is handled by the EDE object:\n"))
(princ " Buffer Target: ")
(princ (object-print ede-object))
(princ "\n")
@@ -766,7 +771,8 @@ Argument EVENT describes the event that caused this function to be called."
(princ "\n"))
)))
- (princ "\n This file's system include path is:\n")
+ (princ (substitute-command-keys
+ "\n This file's system include path is:\n"))
(dolist (dir semantic-dependency-system-include-path)
(princ " ")
(princ dir)
@@ -828,7 +834,7 @@ When an include's referring file is parsed, we need to undecorate
any decorated referring includes.")
-(defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
+(cl-defmethod semantic-reset ((obj semantic-decoration-unparsed-include-cache))
"Reset OBJ back to it's empty settings."
(let ((table (oref obj table)))
;; This is a hack. Add in something better?
@@ -838,13 +844,13 @@ any decorated referring includes.")
))
))
-(defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize CACHE with some NEW-TAGS."
(if (semantic-find-tags-by-class 'include new-tags)
(semantic-reset cache)))
-(defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-decoration-unparsed-include-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index cc5e9d9bec2..9192ec15165 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -1,6 +1,6 @@
;;; semantic/decorate/mode.el --- Minor mode for decorating tags
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -275,7 +275,13 @@ minor mode is enabled."
'semantic-decorate-tags-after-full-reparse nil t)
;; Add decorations to available tags. The above hooks ensure
;; that new tags will be decorated when they become available.
- (semantic-decorate-add-decorations (semantic-fetch-available-tags)))
+ ;; However, don't do this immediately, because EDE will be
+ ;; activated later by find-file-hook, and includes might not
+ ;; be found yet.
+ (run-with-idle-timer
+ 0.1 nil
+ (lambda ()
+ (semantic-decorate-add-decorations (semantic-fetch-available-tags)))))
;; Remove decorations from available tags.
(semantic-decorate-clear-decorations (semantic-fetch-available-tags))
;; Cleanup any leftover crap too.
@@ -387,7 +393,7 @@ must return non-nil to indicate that the tag should be decorated by
`NAME-highlight'.
To put primary decorations on a tag `NAME-highlight' must use
-functions like `semantic-set-tag-face', `semantic-set-tag-intangible',
+functions like `semantic-set-tag-face', `semantic-set-tag-read-only',
etc., found in the semantic-decorate library.
To add other kind of decorations on a tag, `NAME-highlight' must use
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 7f4321f6da6..e5e7da1dd79 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -1,6 +1,6 @@
;;; semantic/dep.el --- Methods for tracking dependencies (include files)
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index e5b958d90a3..3ceb3510ad2 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -1,6 +1,6 @@
;;; semantic/doc.el --- Routines for documentation strings
-;; Copyright (C) 1999-2003, 2005, 2008-2013 Free Software Foundation,
+;; Copyright (C) 1999-2003, 2005, 2008-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -56,13 +56,12 @@ If nosnarf if 'lex, then only return the lex token."
doctmp
;; Check just before the definition.
(when (semantic-tag-with-position-p tag)
- (semantic-documentation-comment-preceeding-tag tag nosnarf))
+ (semantic-documentation-comment-preceding-tag tag nosnarf))
;; Let's look for comments either after the definition, but before code:
;; Not sure yet. Fill in something clever later....
nil))))))
-;; FIXME this is not how you spell "preceding".
-(defun semantic-documentation-comment-preceeding-tag (&optional tag nosnarf)
+(defun semantic-documentation-comment-preceding-tag (&optional tag nosnarf)
"Find a comment preceding TAG.
If TAG is nil. use the tag under point.
Searches the space between TAG and the preceding tag for a comment,
@@ -84,6 +83,10 @@ just the lexical token and not the string."
;; of a function.
(semantic-doc-snarf-comment-for-tag nosnarf)))
))
+(define-obsolete-function-alias
+ 'semantic-documentation-comment-preceeding-tag
+ 'semantic-documentation-comment-preceding-tag
+ "25.1")
(defun semantic-doc-snarf-comment-for-tag (nosnarf)
"Snarf up the comment at POINT for `semantic-documentation-for-tag'.
@@ -118,7 +121,8 @@ If NOSNARF is 'lex, then return the lex token."
(setq ct (concat (substring ct 0 (match-beginning 0))
(substring ct (match-end 0)))))
;; Remove comment delimiter at the end of the string.
- (when (string-match (concat (regexp-quote comment-end) "$") ct)
+ (when (and comment-end (not (string= comment-end ""))
+ (string-match (concat (regexp-quote comment-end) "$") ct))
(setq ct (substring ct 0 (match-beginning 0)))))
;; Now return the text.
ct))))
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index 17859e232a3..eb4a98c0a2d 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -1,6 +1,6 @@
;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
-;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: project, make
@@ -51,7 +51,7 @@
A grammar target consists of grammar files that build Emacs Lisp programs for
parsing different languages.")
-(defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-dependencies ((this semantic-ede-proj-target-grammar))
"Return a string representing the dependencies for THIS.
Some compilers only use the first element in the dependencies, others
have a list of intermediates (object files), and others don't care.
@@ -124,17 +124,17 @@ For Emacs Lisp, return addsuffix command on source files."
"Compile Emacs Lisp programs.")
;;; Target options.
-(defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
+(cl-defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
"Return t if object THIS lays claim to the file in BUFFER.
Lays claim to all -by.el, and -wy.el files."
;; We need to be a little more careful than this, but at the moment it
;; is common to have only one target of this class per directory.
(if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
t
- (call-next-method) ; The usual thing.
+ (cl-call-next-method) ; The usual thing.
))
-(defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
+(cl-defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
"Compile all sources in a Lisp target OBJ."
(let* ((cb (current-buffer))
(proj (ede-target-parent obj))
@@ -167,13 +167,13 @@ Lays claim to all -by.el, and -wy.el files."
;;; Makefile generation functions
;;
-(defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
"Return the variable name for THIS's sources."
(cond ((ede-proj-automake-p)
(error "No Automake support for Semantic Grammars"))
(t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR"))))
-(defmethod ede-proj-makefile-insert-variables :AFTER ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-variables :after ((this semantic-ede-proj-target-grammar))
"Insert variables needed by target THIS."
(ede-proj-makefile-insert-loadpath-items
(ede-proj-elisp-packages-to-loadpath
@@ -192,7 +192,7 @@ Lays claim to all -by.el, and -wy.el files."
" ")))
)
-(defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar))
"Insert rules needed by THIS target.
This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be
needed for the compilation of the resulting parsers."
@@ -200,12 +200,12 @@ needed for the compilation of the resulting parsers."
max-lisp-eval-depth 700)'\n"
(oref this name))))
-(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
+(cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
"Insert dist dependencies, or intermediate targets.
This makes sure that all grammar lisp files are created before the dist
runs, so they are always up to date.
Argument THIS is the target that should insert stuff."
- (call-next-method)
+ (cl-call-next-method)
(insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
)
@@ -213,7 +213,7 @@ Argument THIS is the target that should insert stuff."
;; "Target class for Emacs/Semantic grammar files." nil nil)
(ede-proj-register-target "semantic grammar"
- semantic-ede-proj-target-grammar)
+ 'semantic-ede-proj-target-grammar)
(provide 'semantic/ede-grammar)
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 91455cdb741..aa7131e9773 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -1,6 +1,6 @@
;;; semantic/edit.el --- Edit Management for Semantic
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -463,11 +463,11 @@ See `semantic-edits-change-leaf-tag' for details on parents."
(defun semantic-parse-changes-failed (&rest args)
"Signal that Semantic failed to parse changes.
-That is, display a message by passing all ARGS to `format', then throw
+That is, display a message by passing all ARGS to `format-message', then throw
a 'semantic-parse-changes-failed exception with value t."
(when semantic-edits-verbose-flag
(message "Semantic parse changes failed: %S"
- (apply 'format args)))
+ (apply #'format-message args)))
(throw 'semantic-parse-changes-failed t))
(defsubst semantic-edits-incremental-fail ()
@@ -907,11 +907,11 @@ pre-positioned to a convenient location."
(defun semantic-edits-splice-insert (newtags parent cachelist)
"Insert NEWTAGS into PARENT using CACHELIST.
-PARENT could be nil, in which case CACHLIST is the buffer cache
+PARENT could be nil, in which case CACHELIST is the buffer cache
which must be updated.
CACHELIST must be searched to find where NEWTAGS are to be inserted.
The positions of NEWTAGS must be synchronized with those in
-CACHELIST for this to work. Some routines pre-position CACHLIST at a
+CACHELIST for this to work. Some routines pre-position CACHELIST at a
convenient location, so use that."
(let* ((start (semantic-tag-start (car newtags)))
(newtagendcell (nthcdr (1- (length newtags)) newtags))
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index f660c69ec3d..fdd5f5290f1 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -1,6 +1,6 @@
;;; semantic/find.el --- Search routines for Semantic
-;; Copyright (C) 1999-2005, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -265,9 +265,9 @@ TABLE is a semantic tags table. See `semantic-something-to-tag-table'."
"Find the first tag with NAME in TABLE.
NAME is a string.
TABLE is a semantic tags table. See `semantic-something-to-tag-table'.
-This routine uses `assoc' to quickly find the first matching entry."
- (funcall (if semantic-case-fold 'assoc-ignore-case 'assoc)
- name (semantic-something-to-tag-table table)))
+Respects `semantic-case-fold'."
+ (assoc-string name (semantic-something-to-tag-table table)
+ semantic-case-fold))
(defmacro semantic-find-tags-by-name (name &optional table)
"Find all tags with NAME in TABLE.
@@ -457,13 +457,11 @@ TABLE is a tag table. See `semantic-something-to-tag-table'."
"Find a tag NAME within STREAMORBUFFER. NAME is a string.
If SEARCH-PARTS is non-nil, search children of tags.
If SEARCH-INCLUDE was never implemented.
+Respects `semantic-case-fold'.
Use `semantic-find-first-tag-by-name' instead."
(let* ((stream (semantic-something-to-tag-table streamorbuffer))
- (assoc-fun (if semantic-case-fold
- #'assoc-ignore-case
- #'assoc))
- (m (funcall assoc-fun name stream)))
+ (m (assoc-string name stream semantic-case-fold)))
(if m
m
(let ((toklst stream)
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index c6fbbed2424..1184a98951e 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -1,6 +1,6 @@
;;; semantic/format.el --- Routines for formatting tags
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -499,7 +499,12 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(setq r (concat r "[]")
deref (1- deref)))
r)))
- )
+ (default (when (eq class 'variable)
+ (let ((defval
+ (semantic-tag-get-attribute tag :default-value)))
+ (when (and defval (stringp defval))
+ (concat "[=" defval "]")))))
+ )
(if args
(setq args
(concat " "
@@ -512,7 +517,8 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(if type (concat type " "))
name
(or args "")
- (or array ""))))
+ (or array "")
+ (or default ""))))
;;;###autoload
(define-overloadable-function semantic-format-tag-concise-prototype (tag &optional parent color)
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index dadf181ce21..d8ba6f275f3 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -1,6 +1,6 @@
;;; semantic/fw.el --- Framework for Semantic
-;;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -38,6 +38,7 @@
(if (featurep 'xemacs)
(progn
(defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
+ ;; FIXME: Why not just (require 'overlay)?
(defalias 'semantic-overlay-live-p
(lambda (o)
(and (extent-live-p o)
@@ -113,18 +114,13 @@
"Extract the window from EVENT."
(car (car (cdr event))))
- (if (> emacs-major-version 21)
- (defalias 'semantic-buffer-local-value 'buffer-local-value)
+ (defalias 'semantic-buffer-local-value 'buffer-local-value)
- (defun semantic-buffer-local-value (sym &optional buf)
- "Get the value of SYM from buffer local variable in BUF."
- (cdr (assoc sym (buffer-local-variables buf)))))
)
(defalias 'semantic-make-local-hook
- (if (and (not (featurep 'xemacs))
- (>= emacs-major-version 21))
+ (if (featurep 'emacs)
#'identity #'make-local-hook))
(defalias 'semantic-mode-line-update
@@ -177,10 +173,10 @@ recover the cached data with `semantic-get-cache-data'.
LIFESPAN indicates how long the data cache will be remembered.
The default LIFESPAN is 'end-of-command.
Possible Lifespans are:
- 'end-of-command - Remove the cache at the end of the currently
- executing command.
- 'exit-cache-zone - Remove when point leaves the overlay at the
- end of the currently executing command."
+ `end-of-command' - Remove the cache at the end of the currently
+ executing command.
+ `exit-cache-zone' - Remove when point leaves the overlay at the
+ end of the currently executing command."
;; Check if LIFESPAN is valid before to create any overlay
(or lifespan (setq lifespan 'end-of-command))
(or (memq lifespan '(end-of-command exit-cache-zone))
@@ -307,7 +303,7 @@ error message.
If `debug-on-error' is set, errors are not caught, so that you can
debug them.
Avoid using a large BODY since it is duplicated."
- ;;(declare (debug t) (indent 1))
+ (declare (debug t) (indent 1))
`(if debug-on-error
;;(let ((inhibit-quit nil)) ,@body)
;; Note to self: Doing the above screws up the wisent parser.
@@ -318,10 +314,18 @@ Avoid using a large BODY since it is duplicated."
(message ,format (format "%S - %s" (current-buffer)
(error-message-string err)))
nil))))
-(put 'semantic-safe 'lisp-indent-function 1)
;;; Misc utilities
;;
+
+(defvar semantic-new-buffer-fcn-was-run nil
+ "Non-nil after `semantic-new-buffer-fcn' has been executed.")
+(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
+
+(defsubst semantic-active-p ()
+ "Return non-nil if the current buffer was set up for parsing."
+ semantic-new-buffer-fcn-was-run)
+
(defsubst semantic-map-buffers (function)
"Run FUNCTION for each Semantic enabled buffer found.
FUNCTION does not have arguments. When FUNCTION is entered
@@ -361,6 +365,8 @@ later installation should be done in MODE hook."
;;
(defvar semantic-current-input-throw-symbol nil
"The current throw symbol for `semantic-exit-on-input'.")
+(defvar semantic--on-input-start-marker nil
+ "The marker when starting a semantic-exit-on-input form.")
(defmacro semantic-exit-on-input (symbol &rest forms)
"Using SYMBOL as an argument to `throw', execute FORMS.
@@ -368,10 +374,11 @@ If FORMS includes a call to `semantic-throw-on-input', then
if a user presses any key during execution, this form macro
will exit with the value passed to `semantic-throw-on-input'.
If FORMS completes, then the return value is the same as `progn'."
- `(let ((semantic-current-input-throw-symbol ,symbol))
+ (declare (indent 1) (debug def-body))
+ `(let ((semantic-current-input-throw-symbol ,symbol)
+ (semantic--on-input-start-marker (point-marker)))
(catch ,symbol
,@forms)))
-(put 'semantic-exit-on-input 'lisp-indent-function 1)
(defmacro semantic-throw-on-input (from)
"Exit with `throw' when in `semantic-exit-on-input' on user input.
@@ -379,7 +386,15 @@ FROM is an indication of where this function is called from as a value
to pass to `throw'. It is recommended to use the name of the function
calling this one."
`(when (and semantic-current-input-throw-symbol
- (or (input-pending-p) (accept-process-output)))
+ (or (input-pending-p)
+ (with-current-buffer
+ (marker-buffer semantic--on-input-start-marker)
+ ;; Timers might run during accept-process-output.
+ ;; If they redisplay, point must be where the user
+ ;; expects. (Bug#15045)
+ (save-excursion
+ (goto-char semantic--on-input-start-marker)
+ (accept-process-output)))))
(throw semantic-current-input-throw-symbol ,from)))
@@ -433,12 +448,12 @@ into `mode-local-init-hook'." file filename)
;;
(defmacro semanticdb-without-unloaded-file-searches (forms)
"Execute FORMS with `unloaded' removed from the current throttle."
+ (declare (indent 1))
`(let ((semanticdb-find-default-throttle
(if (featurep 'semantic/db-find)
(remq 'unloaded semanticdb-find-default-throttle)
nil)))
,forms))
-(put 'semanticdb-without-unloaded-file-searches 'lisp-indent-function 1)
;; ;;; Editor goodies ;-)
@@ -505,12 +520,6 @@ into `mode-local-init-hook'." file filename)
;; (font-lock-add-keywords 'emacs-lisp-mode
;; semantic-fw-font-lock-keywords))
-;;; Interfacing with edebug
-;;
-(defun semantic-fw-add-edebug-spec ()
- (def-edebug-spec semantic-exit-on-input 'def-body))
-
-(add-hook 'edebug-setup-hook 'semantic-fw-add-edebug-spec)
(provide 'semantic/fw)
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 4172390da4e..4b59e17f1e0 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -1,6 +1,6 @@
;;; semantic/grammar-wy.el --- Generated parser support file
-;; Copyright (C) 2002-2004, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2009-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -387,12 +387,12 @@
(let
((s $1))
(if
- (string-match "^{[ \n ]*" s)
+ (string-match "^{[\r\n\t ]*" s)
(setq s
(substring s
(match-end 0))))
(if
- (string-match "[ \n ]*}$" s)
+ (string-match "[\r\n\t ]*}$" s)
(setq s
(substring s 0
(match-beginning 0))))
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index ce658cd5d54..fc7e9e61a16 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/grammar.el --- Major mode framework for Semantic grammars
-;; Copyright (C) 2002-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -33,6 +33,8 @@
(require 'semantic/wisent)
(require 'semantic/ctxt)
(require 'semantic/format)
+;; FIXME this is a generated file, but we need to load this file to
+;; generate it!
(require 'semantic/grammar-wy)
(require 'semantic/idle)
(require 'help-fns)
@@ -605,6 +607,11 @@ The symbols in the template are local variables in
\(provide '" libr ")
+;; Local Variables:
+;; version-control: never
+;; no-update-autoloads: t
+;; End:
+
;;; " file " ends here
")
"Generated footer template.
@@ -621,39 +628,38 @@ The symbols in the list are local variables in
t)
(match-string 0))))
+(defun semantic-grammar--template-expand (template env)
+ (mapconcat (lambda (S)
+ (if (stringp S) S
+ (let ((x (assq S env)))
+ (cond
+ (x (cdr x))
+ ((symbolp S) (symbol-value S))))))
+ template ""))
+
(defun semantic-grammar-header ()
"Return text of a generated standard header."
- (let ((file (semantic-grammar-buffer-file
+ (semantic-grammar--template-expand
+ semantic-grammar-header-template
+ `((file . ,(semantic-grammar-buffer-file
semantic--grammar-output-buffer))
- (gram (semantic-grammar-buffer-file))
- (date (format-time-string "%Y-%m-%d %T%z"))
- (vcid (concat "$" "Id" "$")) ;; Avoid expansion
- ;; Try to get the copyright from the input grammar, or
- ;; generate a new one if not found.
- (copy (or (semantic-grammar-copyright-line)
+ (gram . ,(semantic-grammar-buffer-file))
+ (date . ,(format-time-string "%Y-%m-%d %T%z"))
+ (vcid . ,(concat "$" "Id" "$")) ;; Avoid expansion
+ ;; Try to get the copyright from the input grammar, or
+ ;; generate a new one if not found.
+ (copy . ,(or (semantic-grammar-copyright-line)
(concat (format-time-string ";; Copyright (C) %Y ")
- user-full-name)))
- (out ""))
- (dolist (S semantic-grammar-header-template)
- (cond ((stringp S)
- (setq out (concat out S)))
- ((symbolp S)
- (setq out (concat out (symbol-value S))))))
- out))
+ user-full-name))))))
(defun semantic-grammar-footer ()
"Return text of a generated standard footer."
- (let* ((file (semantic-grammar-buffer-file
- semantic--grammar-output-buffer))
- (libr (or semantic--grammar-provide
- semantic--grammar-package))
- (out ""))
- (dolist (S semantic-grammar-footer-template)
- (cond ((stringp S)
- (setq out (concat out S)))
- ((symbolp S)
- (setq out (concat out (symbol-value S))))))
- out))
+ (semantic-grammar--template-expand
+ semantic-grammar-footer-template
+ `((file . ,(semantic-grammar-buffer-file
+ semantic--grammar-output-buffer))
+ (libr . ,(or semantic--grammar-provide
+ semantic--grammar-package)))))
(defun semantic-grammar-token-data ()
"Return the string value of the table of lexical tokens."
@@ -707,7 +713,7 @@ Block definitions are read from the current table of lexical types."
(let* ((blocks (cdr (semantic-lex-type-value "block" t)))
(open-delims (cdr (semantic-lex-type-value "open-paren" t)))
(close-delims (cdr (semantic-lex-type-value "close-paren" t)))
- olist clist block-spec delim-spec open-spec close-spec)
+ olist clist delim-spec open-spec close-spec)
(dolist (block-spec blocks)
(setq delim-spec (semantic-grammar--lex-delim-spec block-spec)
open-spec (assq (car delim-spec) open-delims)
@@ -811,7 +817,7 @@ Block definitions are read from the current table of lexical types."
;;; Generation of the grammar support file.
;;
-(defcustom semantic-grammar-file-regexp "\\.[wb]y$"
+(defcustom semantic-grammar-file-regexp "\\.[wb]y\\'"
"Regexp which matches grammar source files."
:group 'semantic
:type 'regexp)
@@ -822,9 +828,10 @@ Block definitions are read from the current table of lexical types."
(noninteractive)
noninteractive))
-(defun semantic-grammar-create-package (&optional force)
+(defun semantic-grammar-create-package (&optional force uptodate)
"Create package Lisp code from grammar in current buffer.
-Does nothing if the Lisp code seems up to date.
+If the Lisp code seems up to date, do nothing (if UPTODATE
+is non-nil, return nil in such cases).
If optional argument FORCE is non-nil, unconditionally re-generate the
Lisp code."
(interactive "P")
@@ -854,13 +861,18 @@ Lisp code."
(file-newer-than-file-p
(buffer-file-name semantic--grammar-output-buffer)
(buffer-file-name semantic--grammar-input-buffer)))
- (message "Package `%s' is up to date." semantic--grammar-package)
+ (progn
+ (message "Package `%s' is up to date." semantic--grammar-package)
+ ;; It would be better if this were always the case, IMO,
+ ;; but the (unspecified) return value of this function is
+ ;; assumed to be non-nil in some places, it seems.
+ (if uptodate (setq output nil)))
;; Create the package
(set-buffer semantic--grammar-output-buffer)
;; Use Unix EOLs, so that the file is portable to all platforms.
(setq buffer-file-coding-system 'raw-text-unix)
(erase-buffer)
- (unless (eq major-mode 'emacs-lisp-mode)
+ (unless (derived-mode-p 'emacs-lisp-mode)
(emacs-lisp-mode))
;;;; Header + Prologue
@@ -1060,7 +1072,7 @@ See also the variable `semantic-grammar-file-regexp'."
(defvar semantic--grammar-macros-regexp-2 nil)
(make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
-(defun semantic--grammar-clear-macros-regexp-2 (&rest ignore)
+(defun semantic--grammar-clear-macros-regexp-2 (&rest _)
"Clear the cached regexp that match macros local in this grammar.
IGNORE arguments.
Added to `before-change-functions' hooks to be run before each text
@@ -1102,7 +1114,9 @@ END is the limit of the search."
;;;; Define major mode
;;;;
-(defvar semantic-grammar-syntax-table
+(define-obsolete-variable-alias 'semantic-grammar-syntax-table
+ 'semantic-grammar-mode-syntax-table "24.1")
+(defvar semantic-grammar-mode-syntax-table
(let ((table (make-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?\: "." table) ;; COLON
(modify-syntax-entry ?\> "." table) ;; GT
@@ -1158,19 +1172,25 @@ END is the limit of the search."
(defvar semantic-grammar-mode-keywords-2
(append semantic-grammar-mode-keywords-1
- lisp-font-lock-keywords-1)
+ (if (boundp 'lisp-font-lock-keywords-1)
+ lisp-font-lock-keywords-1
+ lisp-el-font-lock-keywords-1))
"Font Lock keywords used to highlight Semantic grammar buffers.")
(defvar semantic-grammar-mode-keywords-3
(append semantic-grammar-mode-keywords-1
- lisp-font-lock-keywords-2)
+ (if (boundp 'lisp-font-lock-keywords-2)
+ lisp-font-lock-keywords-2
+ lisp-el-font-lock-keywords-2))
"Font Lock keywords used to highlight Semantic grammar buffers.")
(defvar semantic-grammar-mode-keywords
semantic-grammar-mode-keywords-1
"Font Lock keywords used to highlight Semantic grammar buffers.")
-(defvar semantic-grammar-map
+(define-obsolete-variable-alias 'semantic-grammar-map
+ 'semantic-grammar-mode-map "24.1")
+(defvar semantic-grammar-mode-map
(let ((km (make-sparse-keymap)))
(define-key km "|" 'semantic-grammar-electric-punctuation)
@@ -1271,22 +1291,17 @@ the change bounds to encompass the whole nonterminal tag."
(semantic-tag-start outer)
(semantic-tag-end outer)))))
-(defun semantic-grammar-mode ()
+(define-derived-mode semantic-grammar-mode
+ fundamental-mode "Semantic Grammar Framework"
"Initialize a buffer for editing Semantic grammars.
-\\{semantic-grammar-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'semantic-grammar-mode
- mode-name "Semantic Grammar Framework")
+\\{semantic-grammar-mode-map}"
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start) ";;")
;; 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]\\)\\(\\\\\\\\\\)*\\);+ *")
- (set-syntax-table semantic-grammar-syntax-table)
- (use-local-map semantic-grammar-map)
(set (make-local-variable 'indent-line-function)
'semantic-grammar-indent)
(set (make-local-variable 'fill-paragraph-function)
@@ -1335,15 +1350,14 @@ the change bounds to encompass the whole nonterminal tag."
(semantic-make-local-hook 'semantic-edits-new-change-functions)
(add-hook 'semantic-edits-new-change-functions
'semantic-grammar-edits-new-change-hook-fcn
- nil t)
- (semantic-run-mode-hooks 'semantic-grammar-mode-hook))
+ nil t))
;;;;
;;;; Useful commands
;;;;
(defvar semantic-grammar-skip-quoted-syntax-table
- (let ((st (copy-syntax-table semantic-grammar-syntax-table)))
+ (let ((st (copy-syntax-table semantic-grammar-mode-syntax-table)))
(modify-syntax-entry ?\' "$" st)
st)
"Syntax table to skip a whole quoted expression in grammar code.
@@ -1644,20 +1658,17 @@ Select the buffer containing the tag's definition, and move point there."
)
"Association of syntax elements, and the corresponding help.")
-(declare-function eldoc-function-argstring "eldoc")
-(declare-function eldoc-docstring-format-sym-doc "eldoc")
-(declare-function eldoc-last-data-store "eldoc")
-(declare-function eldoc-get-fnsym-args-string "eldoc")
-(declare-function eldoc-get-var-docstring "eldoc")
+(defvar semantic-grammar-eldoc-last-data (cons nil nil))
(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."
(require 'eldoc)
- (if (and (eq expander (aref eldoc-last-data 0))
- (eq 'function (aref eldoc-last-data 2)))
- (aref eldoc-last-data 1)
- (let ((doc (help-split-fundoc (documentation expander t) expander)))
+ (cond
+ ((eq expander (car semantic-grammar-eldoc-last-data))
+ (cdr semantic-grammar-eldoc-last-data))
+ ((fboundp 'eldoc-function-argstring) ;; Emacs<25
+ (let* ((doc (help-split-fundoc (documentation expander t) expander)))
(cond
(doc
(setq doc (car doc))
@@ -1669,8 +1680,17 @@ EXPANDER is the name of the function that expands MACRO."
(setq doc
(eldoc-docstring-format-sym-doc
macro (format "==> %s %s" expander doc) 'default))
- (eldoc-last-data-store expander doc 'function))
- doc)))
+ (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)
+ 'face 'font-lock-keyword-face)
+ " ==> "
+ (propertize (symbol-name macro)
+ 'face 'font-lock-function-name-face)
+ ": ")))))
(define-mode-local-override semantic-idle-summary-current-symbol-info
semantic-grammar-mode ()
@@ -1701,10 +1721,14 @@ Otherwise return nil."
(setq val (semantic-grammar-eldoc-get-macro-docstring elt val)))
;; Function
((and elt (fboundp elt))
- (setq val (eldoc-get-fnsym-args-string elt)))
+ (setq val (if (fboundp 'eldoc-get-fnsym-args-string)
+ (eldoc-get-fnsym-args-string elt)
+ (elisp-get-fnsym-args-string elt))))
;; Variable
((and elt (boundp elt))
- (setq val (eldoc-get-var-docstring elt)))
+ (setq val (if (fboundp 'eldoc-get-var-docstring)
+ (eldoc-get-var-docstring elt)
+ (elisp-get-var-docstring elt))))
(t nil)))
(or val (semantic-idle-summary-current-symbol-info-default))))
@@ -1912,6 +1936,7 @@ Optional argument COLOR determines if color is added to the text."
(provide 'semantic/grammar)
+
;; Local variables:
;; generated-autoload-load-name: "semantic/grammar"
;; End:
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index d98ccf2bf55..2194bf5bd38 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -1,6 +1,6 @@
;;; semantic/html.el --- Semantic details for html files
-;; Copyright (C) 2004-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index a1595eb7b89..fcc9c002cef 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -1,6 +1,6 @@
;;; semantic/ia-sb.el --- Speedbar analysis display interactor
-;;; Copyright (C) 2002-2004, 2006, 2008-2013 Free Software Foundation,
+;;; Copyright (C) 2002-2004, 2006, 2008-2015 Free Software Foundation,
;;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -138,8 +138,8 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
)))
-(defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
- "Show documentation about CONTEXT iff CONTEXT points at a complete symbol."
+(cl-defmethod semantic-ia-sb-show-doc ((context semantic-analyze-context))
+ "Show documentation about CONTEXT if CONTEXT points at a complete symbol."
(let ((sym (car (reverse (oref context prefix))))
(doc nil))
(when (semantic-tag-p sym)
@@ -163,7 +163,7 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
;; This is from semantic-sb
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context))
"Show a set of speedbar buttons specific to CONTEXT."
(let ((prefix (oref context prefix)))
(when prefix
@@ -173,9 +173,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'semantic-sb-token-jump))
))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-assignment))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((assignee (oref context assignee)))
(when assignee
(speedbar-insert-separator "Assignee")
@@ -183,9 +183,9 @@ DIRECTORY is the current directory, which is ignored, and ZERO is 0."
'speedbar-tag-face
'semantic-sb-token-jump))))
-(defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
+(cl-defmethod semantic-ia-sb-more-buttons ((context semantic-analyze-context-functionarg))
"Show a set of speedbar buttons specific to CONTEXT."
- (call-next-method)
+ (cl-call-next-method)
(let ((func (oref context function)))
(when func
(speedbar-insert-separator "Function")
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index d087ac6fcde..27e6db16f39 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -1,6 +1,6 @@
;;; semantic/ia.el --- Interactive Analysis functions
-;;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -123,7 +123,8 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; the smart completion engine sometimes fails.
(semantic-complete-symbol))
;; Use try completion to seek a common substring.
- (let ((tc (try-completion (or pre "") syms)))
+ (let* ((completion-ignore-case (string= (downcase pre) pre))
+ (tc (try-completion (or pre "") syms)))
(if (and (stringp tc) (not (string= tc (or pre ""))))
(let ((tok (semantic-find-first-tag-by-name
tc syms)))
@@ -161,11 +162,14 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; Complete this symbol.
(if (not syms)
(progn
- (message "No smart completions found. Trying Senator.")
- (when (semantic-analyze-context-p a)
- ;; This is a quick way of getting a nice completion list
- ;; in the menu if the regular context mechanism fails.
- (senator-completion-menu-popup)))
+ (message "No smart completions found.")
+ ;; Disabled - see http://debbugs.gnu.org/14522
+ ;; (message "No smart completions found. Trying Senator.")
+ ;; (when (semantic-analyze-context-p a)
+ ;; ;; This is a quick way of getting a nice completion list
+ ;; ;; in the menu if the regular context mechanism fails.
+ ;; (senator-completion-menu-popup))
+ )
(let* ((menu
(mapcar
@@ -179,7 +183,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
;; XEmacs needs that the menu has at least 2 items. So,
;; include a nil item that will be ignored by imenu.
(cons nil menu)
- (senator-completion-menu-point-as-event)
+ `(down-mouse-1 ,(posn-at-point))
"Completions")))
(when ans
(if (not (semantic-tag-p ans))
@@ -360,21 +364,30 @@ origin of the code at point."
(let ((secondclass (car (reverse (oref ctxt prefixtypes)))))
(cond
((and (semantic-tag-with-position-p secondclass)
- (y-or-n-p (format "Could not find `%s'. Jump to %s? "
- first (semantic-tag-name secondclass))))
+ (y-or-n-p (format-message
+ "Could not find `%s'. Jump to %s? "
+ first (semantic-tag-name secondclass))))
(semantic-ia--fast-jump-helper secondclass)
)
;; If we missed out on the class of the second item, then
;; just visit SECOND.
((and (semantic-tag-p second)
- (y-or-n-p (format "Could not find `%s'. Jump to %s? "
- first (semantic-tag-name second))))
+ (y-or-n-p (format-message
+ "Could not find `%s'. Jump to %s? "
+ first (semantic-tag-name second))))
(semantic-ia--fast-jump-helper second)
))))
((semantic-tag-of-class-p (semantic-current-tag) 'include)
;; Just borrow this cool fcn.
(require 'semantic/decorate/include)
+
+ ;; Push the mark, so you can pop global mark back, or
+ ;; use semantic-mru-bookmark mode to do so.
+ (push-mark)
+ (when (fboundp 'push-tag-mark)
+ (push-tag-mark))
+
(semantic-decoration-include-visit)
)
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index d024e5d8237..95d9d846466 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -1,6 +1,6 @@
;;; idle.el --- Schedule parsing tasks in idle time
-;; Copyright (C) 2003-2006, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2006, 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -216,6 +216,7 @@ current buffer.")
And also manages services that depend on tag values."
(when semantic-idle-scheduler-verbose-flag
(message "IDLE: Core handler..."))
+ ;; FIXME: Use `while-no-input'?
(semantic-exit-on-input 'idle-timer
(let* ((inhibit-quit nil)
(buffers (delq (current-buffer)
@@ -715,8 +716,8 @@ It might be useful to override this variable to add comment faces
specific to a major mode. For example, in jde mode:
\(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
- (append (default-value 'semantic-idle-summary-out-of-context-faces)
- '(jde-java-font-lock-doc-tag-face
+ (append (default-value \\='semantic-idle-summary-out-of-context-faces)
+ \\='(jde-java-font-lock-doc-tag-face
jde-java-font-lock-link-face
jde-java-font-lock-bold-face
jde-java-font-lock-underline-face
@@ -830,8 +831,14 @@ turned on in every Semantic-supported buffer."
;; of all uses of the symbol that is under the cursor.
;;
;; This is to mimic the Eclipse tool of a similar nature.
-(defvar semantic-idle-symbol-highlight-face 'region
+(defface semantic-idle-symbol-highlight
+ '((t :inherit region))
+ "Face used for highlighting local symbols."
+ :group 'semantic-faces)
+(defvar semantic-idle-symbol-highlight-face 'semantic-idle-symbol-highlight
"Face used for highlighting local symbols.")
+(make-obsolete-variable 'semantic-idle-symbol-highlight-face
+ "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set)
(defun semantic-idle-symbol-maybe-highlight (tag)
"Perhaps add highlighting to the symbol represented by TAG.
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index 370f651b93d..c043125b5cf 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -1,7 +1,7 @@
;;; semantic/imenu.el --- Use Semantic as an imenu tag generator
-;;; Copyright (C) 2000-2005, 2007-2008, 2010-2013
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2008, 2010-2015 Free Software
+;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Maintainer: Eric Ludlam
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index b4e4bc5110d..829eafae37a 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -1,6 +1,6 @@
;;; semantic/java.el --- Semantic functions for Java
-;;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -369,7 +369,7 @@ That is @NAME."
(defsubst semantic-java-doc-tag-name (tag)
"Return name of the doc TAG symbol.
-That is TAG `symbol-name' without the leading '@'."
+That is TAG `symbol-name' without the leading `@'."
(substring (symbol-name tag) 1))
(defun semantic-java-doc-keyword-before-p (k1 k2)
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 462e520654a..761cc1af5ed 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1,6 +1,6 @@
;;; semantic/lex-spp.el --- Semantic Lexical Pre-processor
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -70,6 +70,8 @@
(require 'semantic)
(require 'semantic/lex)
+(declare-function semantic-c-end-of-macro "semantic/bovine/c")
+
;;; Code:
(defvar semantic-lex-spp-macro-symbol-obarray nil
"Table of macro keywords used by the Semantic Preprocessor.
@@ -527,16 +529,54 @@ and what valid VAL values are."
;;
;; Nested token FOO shows up in the table of macros, and gets replace
;; inline. This is the same as case 2.
+ ;;
+ ;; CASE 5: Macros which open a scope without closing it
+ ;;
+ ;; #define __NAMESPACE_STD namespace std {
+ ;; #define __NAMESPACE_END }
+ ;; ==>
+ ;; ((NAMESPACE "namespace" 140 . 149)
+ ;; (symbol "std" 150 . 153)
+ ;; (open-paren "{" 154 . 155))
+ ;;
+ ;; Note that we get a single 'open-paren' instead of a
+ ;; 'semantic-list', which is because we use
+ ;; 'semantic-lex-spp-paren-or-list' instead of
+ ;; 'semantic-lex-paren-or-list' in our spp-lexer. To keep things
+ ;; reasonably simple, we assume that such an open scope will always
+ ;; be closed by another macro (see
+ ;; `semantic-lex-spp-find-closing-macro'). We generate a
+ ;; 'semantic-list' to this closing macro, and we leave an overlay
+ ;; which contains information how far we got into the macro's
+ ;; stream (since it might open several scopes).
+
+ (let* ((arglist (semantic-lex-spp-macro-with-args val))
+ (argalist nil)
+ (val-tmp nil)
+ (v nil)
+ (sppov (semantic-lex-spp-get-overlay beg))
+ (sppinfo (when sppov (overlay-get sppov 'semantic-spp))))
+
+ ;; First, check if we were already here and left information
+ (when sppinfo
+ ;; Advance in the tokens as far as we got last time
+ (when (numberp (car sppinfo))
+ (while (and val
+ (>= (car sppinfo) (car (last (car val)))))
+ (setq val (cdr val))))
+ ;; And push an open paren
+ (semantic-lex-push-token
+ (semantic-lex-token 'open-paren beg (1+ beg) "{"))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (unless val
+ ;; We reached the end of this macro, so delete overlay
+ (delete-overlay sppov)))
- (let ((arglist (semantic-lex-spp-macro-with-args val))
- (argalist nil)
- (val-tmp nil)
- (v nil)
- )
;; CASE 2: Dealing with the arg list.
- (when arglist
+ (when (and val arglist)
;; Skip the arg list.
- (setq val (cdr val))
+ (when (eq (caar val) 'spp-arg-list)
+ (setq val (cdr val)))
;; Push args into the replacement list.
(let ((AV argvalues))
@@ -616,7 +656,32 @@ and what valid VAL values are."
(semantic-lex-push-token
(semantic-lex-token (semantic-lex-token-class v) beg end txt))
)
-
+ ;; CASE 5: Macro which opens a scope
+ ((eq (semantic-lex-token-class v) 'open-paren)
+ ;; We assume that the scope will be closed by another macro.
+ ;; (Everything else would be a terrible idea anyway.)
+ (let* ((endpoint (semantic-lex-spp-find-closing-macro))
+ (ov (when endpoint
+ (or sppov
+ (make-overlay beg end)))))
+ (when ov
+ ;; Generate a semantic-list which spans to the end of
+ ;; the closing macro
+ (semantic-lex-push-token
+ (semantic-lex-token 'semantic-list beg endpoint))
+ ;; The rest of the current macro's stream will be parsed
+ ;; next time.
+ (setq val-tmp nil)
+ ;; Store our current state were we are in the macro and
+ ;; the endpoint.
+ (overlay-put ov 'semantic-spp
+ (cons (car (last v)) endpoint)))))
+ ((eq (semantic-lex-token-class v) 'close-paren)
+ ;; Macro which closes a scope
+ ;; Just push the close paren, but also decrease depth
+ (semantic-lex-push-token
+ (semantic-lex-token 'close-paren beg end txt))
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth)))
;; CASE 1: Just another token in the stream.
(t
;; Nothing new.
@@ -652,6 +717,37 @@ will return empty string instead.")
txt
""))
+(defun semantic-lex-spp-find-closing-macro ()
+ "Find next macro which closes a scope through a close-paren.
+Returns position with the end of that macro."
+ (let ((macros (semantic-lex-spp-macros))
+ (cmacro-regexp "\\(")
+ (case-fold-search nil))
+ ;; Build a regexp which search for all macros with a closing
+ ;; paren, and search for it.
+ (dolist (cur macros)
+ (let ((stream (symbol-value cur)))
+ (when (and (listp stream) (listp (car stream)))
+ (while stream
+ (if (and (eq (caar stream) 'close-paren)
+ (string= (nth 1 (car stream)) "}"))
+ (setq cmacro-regexp (concat cmacro-regexp (symbol-name cur) "\\|")
+ stream nil)
+ (setq stream (cdr-safe stream)))))))
+ (when cmacro-regexp
+ (save-excursion
+ (when (re-search-forward
+ (concat (substring cmacro-regexp 0 -2) "\\)[^0-9a-zA-Z_]") nil t)
+ (point))))))
+
+(defun semantic-lex-spp-get-overlay (&optional point)
+ "Return first overlay which has a 'semantic-spp property."
+ (let ((overlays (overlays-at (or point (point)))))
+ (while (and overlays
+ (null (overlay-get (car overlays) 'semantic-spp)))
+ (setq overlays (cdr overlays)))
+ (car-safe overlays)))
+
;;; Macro Merging
;;
;; Used when token streams from different macros include each other.
@@ -727,7 +823,7 @@ ARGVALUES are values for any arg list, or nil."
;; An analyzer that will push tokens from a macro in place
;; of the macro symbol.
;;
-(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end)
+(defun semantic-lex-spp-analyzer-do-replace (sym val beg end)
"Do the lexical replacement for SYM with VAL.
Argument BEG and END specify the bounds of SYM in the buffer."
(if (not val)
@@ -767,6 +863,9 @@ Argument BEG and END specify the bounds of SYM in the buffer."
(setq semantic-lex-end-point end)
)
))
+(define-obsolete-function-alias
+ 'semantic-lex-spp-anlyzer-do-replace
+ 'semantic-lex-spp-analyzer-do-replace "25.1")
(defvar semantic-lex-spp-replacements-enabled t
"Non-nil means do replacements when finding keywords.
@@ -820,12 +919,50 @@ STR occurs in the current buffer between BEG and END."
))
(define-lex-regex-analyzer semantic-lex-spp-replace-or-symbol-or-keyword
- "Like 'semantic-lex-symbol-or-keyword' plus preprocessor macro replacement."
+ "Like `semantic-lex-symbol-or-keyword' plus preprocessor macro replacement."
"\\(\\sw\\|\\s_\\)+"
(let ((str (match-string 0))
(beg (match-beginning 0))
- (end (match-end 0)))
- (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)))
+ (end (match-end 0))
+ sppov)
+ (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)
+ (when (setq sppov (semantic-lex-spp-get-overlay beg))
+ (setq semantic-lex-end-point (cdr (overlay-get sppov 'semantic-spp))))))
+
+(define-lex-regex-analyzer semantic-lex-spp-paren-or-list
+ "Detect open parenthesis.
+Contrary to `semantic-lex-paren-or-list', this will push a single
+open-paren onto the stream if no closing paren can be found.
+This is important for macros which open a scope which is closed
+by another macro."
+ "\\s("
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (progn
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren (match-beginning 0) (match-end 0))))
+ (save-excursion
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (peom (save-excursion (semantic-c-end-of-macro) (point))))
+ (condition-case nil
+ (progn
+ ;; This will throw an error if no closing paren can be found.
+ (forward-list 1)
+ (when (> (point) peom)
+ ;; If we have left the macro, this is the wrong closing
+ ;; paren, so error out as well.
+ (error ""))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'semantic-list start (point))))
+ (error
+ ;; Only push a single open-paren.
+ (semantic-lex-push-token
+ (semantic-lex-token
+ 'open-paren start end))))))))
;;; ANALYZERS FOR NEW MACROS
;;
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index feead78985c..7738e06ff88 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1,6 +1,6 @@
;;; semantic/lex.el --- Lexical Analyzer builder
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -831,63 +831,6 @@ analyzer which might mistake a number for as a symbol."
;; Return the token stream
(nreverse semantic-lex-token-stream))))
-;;; Collapsed block tokens delimited by any tokens.
-;;
-(defun semantic-lex-start-block (syntax)
- "Mark the last read token as the beginning of a SYNTAX block."
- (if (or (not semantic-lex-maximum-depth)
- (< semantic-lex-current-depth semantic-lex-maximum-depth))
- (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
- (push (list syntax (car semantic-lex-token-stream))
- semantic-lex-block-stack)))
-
-(defun semantic-lex-end-block (syntax)
- "Process the end of a previously marked SYNTAX block.
-That is, collapse the tokens inside that block, including the
-beginning and end of block tokens, into a high level block token of
-class SYNTAX.
-The token at beginning of block is the one marked by a previous call
-to `semantic-lex-start-block'. The current token is the end of block.
-The collapsed tokens are saved in `semantic-lex-block-streams'."
- (if (null semantic-lex-block-stack)
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
- (let* ((stream semantic-lex-token-stream)
- (blk (pop semantic-lex-block-stack))
- (bstream (cdr blk))
- (first (car bstream))
- (last (pop stream)) ;; The current token mark the EOBLK
- tok)
- (if (not (eq (car blk) syntax))
- ;; SYNTAX doesn't match the syntax of the current block in
- ;; the stack. So we encountered the end of the SYNTAX block
- ;; before the end of the current one in the stack which is
- ;; signaled unterminated.
- (semantic-lex-unterminated-syntax-detected (car blk))
- ;; Move tokens found inside the block from the main stream
- ;; into a separate block stream.
- (while (and stream (not (eq (setq tok (pop stream)) first)))
- (push tok bstream))
- ;; The token marked as beginning of block was not encountered.
- ;; This should not happen!
- (or (eq tok first)
- (error "Token %S not found at beginning of block `%s'"
- first syntax))
- ;; Save the block stream for future reuse, to avoid to redo
- ;; the lexical analysis of the block content!
- ;; Anchor the block stream with its start position, so we can
- ;; use: (cdr (assq start semantic-lex-block-streams)) to
- ;; quickly retrieve the lexical stream associated to a block.
- (setcar blk (semantic-lex-token-start first))
- (setcdr blk (nreverse bstream))
- (push blk semantic-lex-block-streams)
- ;; In the main stream, replace the tokens inside the block by
- ;; a high level block token of class SYNTAX.
- (setq semantic-lex-token-stream stream)
- (semantic-lex-push-token
- (semantic-lex-token
- syntax (car blk) (semantic-lex-token-end last)))
- ))))
-
;;; Lexical token API
;;
;; Functions for accessing parts of a token. Use these functions
@@ -1049,6 +992,63 @@ Optional argument DEPTH is the depth to scan into lists."
(semantic-lex-token-end semlist)
depth))
+;;; Collapsed block tokens delimited by any tokens.
+;;
+(defun semantic-lex-start-block (syntax)
+ "Mark the last read token as the beginning of a SYNTAX block."
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (push (list syntax (car semantic-lex-token-stream))
+ semantic-lex-block-stack)))
+
+(defun semantic-lex-end-block (syntax)
+ "Process the end of a previously marked SYNTAX block.
+That is, collapse the tokens inside that block, including the
+beginning and end of block tokens, into a high level block token of
+class SYNTAX.
+The token at beginning of block is the one marked by a previous call
+to `semantic-lex-start-block'. The current token is the end of block.
+The collapsed tokens are saved in `semantic-lex-block-streams'."
+ (if (null semantic-lex-block-stack)
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+ (let* ((stream semantic-lex-token-stream)
+ (blk (pop semantic-lex-block-stack))
+ (bstream (cdr blk))
+ (first (car bstream))
+ (last (pop stream)) ;; The current token mark the EOBLK
+ tok)
+ (if (not (eq (car blk) syntax))
+ ;; SYNTAX doesn't match the syntax of the current block in
+ ;; the stack. So we encountered the end of the SYNTAX block
+ ;; before the end of the current one in the stack which is
+ ;; signaled unterminated.
+ (semantic-lex-unterminated-syntax-detected (car blk))
+ ;; Move tokens found inside the block from the main stream
+ ;; into a separate block stream.
+ (while (and stream (not (eq (setq tok (pop stream)) first)))
+ (push tok bstream))
+ ;; The token marked as beginning of block was not encountered.
+ ;; This should not happen!
+ (or (eq tok first)
+ (error "Token %S not found at beginning of block `%s'"
+ first syntax))
+ ;; Save the block stream for future reuse, to avoid to redo
+ ;; the lexical analysis of the block content!
+ ;; Anchor the block stream with its start position, so we can
+ ;; use: (cdr (assq start semantic-lex-block-streams)) to
+ ;; quickly retrieve the lexical stream associated to a block.
+ (setcar blk (semantic-lex-token-start first))
+ (setcdr blk (nreverse bstream))
+ (push blk semantic-lex-block-streams)
+ ;; In the main stream, replace the tokens inside the block by
+ ;; a high level block token of class SYNTAX.
+ (setq semantic-lex-token-stream stream)
+ (semantic-lex-push-token
+ (semantic-lex-token
+ syntax (car blk) (semantic-lex-token-end last)))
+ ))))
+
;;; Analyzer creation macros
;;
;; An individual analyzer is a condition and code that goes with it.
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index 297353fed67..b2a2c8c7619 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -1,6 +1,6 @@
;;; semantic/mru-bookmark.el --- Automatic bookmark tracking
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -86,7 +86,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
)
"A single bookmark.")
-(defmethod initialize-instance :AFTER ((sbm semantic-bookmark) &rest fields)
+(cl-defmethod initialize-instance :after ((sbm semantic-bookmark) &rest fields)
"Initialize the bookmark SBM with details about :tag."
(condition-case nil
(save-excursion
@@ -96,7 +96,7 @@ Nice values are 'edit, 'read, 'jump, and 'mark.
(error (message "Error bookmarking tag.")))
)
-(defmethod semantic-mrub-visit ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-visit ((sbm semantic-bookmark))
"Visit the semantic tag bookmark SBM.
Uses `semantic-go-to-tag' and highlighting."
(require 'semantic/decorate)
@@ -117,7 +117,7 @@ Uses `semantic-go-to-tag' and highlighting."
(semantic-momentary-highlight-tag tag)
))
-(defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
+(cl-defmethod semantic-mrub-update ((sbm semantic-bookmark) point reason)
"Update the existing bookmark SBM.
POINT is some important location.
REASON is a symbol. See slot `reason' on `semantic-bookmark'."
@@ -132,7 +132,7 @@ REASON is a symbol. See slot `reason' on `semantic-bookmark'."
(error nil))
)
-(defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
+(cl-defmethod semantic-mrub-preflush ((sbm semantic-bookmark))
"Method called on a tag before the current buffer list of tags is flushed.
If there is a buffer match, unlink the tag."
(let ((tag (oref sbm tag))
@@ -183,7 +183,7 @@ Argument POINT is where to find the tag near."
(when nearby (setq tag nearby))))
tag))
-(defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
+(cl-defmethod semantic-mrub-push ((sbr semantic-bookmark-ring) point
&optional reason)
"Add a bookmark to the ring SBR from POINT.
REASON is why it is being pushed. See doc for `semantic-bookmark'
@@ -207,7 +207,7 @@ The resulting bookmark is then sorted within the ring."
)))
(defun semantic-mrub-cache-flush-fcn ()
- "Function called in the `semantic-before-toplevel-cache-flush-hook`.
+ "Function called in the `semantic-before-toplevel-cache-flush-hook'.
Cause tags in the ring to become unlinked."
(let* ((ring (oref semantic-mru-bookmark-ring ring))
(len (ring-length ring))
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index accee18f257..295d4e9673b 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -1,6 +1,6 @@
;;; semantic/sb.el --- Semantic tag display for speedbar
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 13e858ca000..acc6545233b 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -1,6 +1,6 @@
;;; semantic/scope.el --- Analyzer Scope Calculations
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -101,7 +101,7 @@ Saves scoping information between runs of the analyzer.")
;;
;; Methods for basic management of the structure in semanticdb.
;;
-(defmethod semantic-reset ((obj semantic-scope-cache))
+(cl-defmethod semantic-reset ((obj semantic-scope-cache))
"Reset OBJ back to it's empty settings."
(oset obj tag nil)
(oset obj scopetypes nil)
@@ -114,13 +114,13 @@ Saves scoping information between runs of the analyzer.")
(oset obj typescope nil)
)
-(defmethod semanticdb-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
-(defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
+(cl-defmethod semanticdb-partial-synchronize ((cache semantic-scope-cache)
new-tags)
"Synchronize a CACHE with some changed NEW-TAGS."
;; If there are any includes or datatypes changed, then clear.
@@ -134,10 +134,10 @@ Saves scoping information between runs of the analyzer.")
"Get the current cached scope, and reset it."
(when semanticdb-current-table
(let ((co (semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache)))
+ 'semantic-scope-cache)))
(semantic-reset co))))
-(defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
+(cl-defmethod semantic-scope-set-typecache ((cache semantic-scope-cache)
types-in-scope)
"Set the :typescope property on CACHE to some types.
TYPES-IN-SCOPE is a list of type tags whos members are
@@ -195,12 +195,18 @@ Use `semantic-ctxt-scoped-types' to find types."
;; Get this thing as a tag
(let ((tmp (cond
((stringp (car sp))
- (semanticdb-typecache-find (car sp)))
- ;(semantic-analyze-find-tag (car sp) 'type))
+ (or (semanticdb-typecache-find (car sp))
+ ;; If we did not find it in the typecache,
+ ;; look in the tags we found so far
+ (car (semantic-deep-find-tags-by-name
+ (car sp)
+ code-scoped-types))))
((semantic-tag-p (car sp))
(if (semantic-tag-prototype-p (car sp))
- (semanticdb-typecache-find (semantic-tag-name (car sp)))
- ;;(semantic-analyze-find-tag (semantic-tag-name (car sp)) 'type)
+ (or (semanticdb-typecache-find (semantic-tag-name (car sp)))
+ (car (semantic-deep-find-tags-by-name
+ (semantic-tag-name (car sp))
+ code-scoped-types)))
(car sp)))
(t nil))))
(when tmp
@@ -506,10 +512,33 @@ tag is not something you can complete from within TYPE."
(leftover nil)
)
(dolist (S allslots)
- (when (or (not (semantic-tag-of-class-p S 'function))
- (not (semantic-tag-function-parent S)))
- (setq leftover (cons S leftover)))
- )
+ ;; We have to specially deal with 'using' tags here, since those
+ ;; pull in namespaces or classes into the current scope.
+ ;; (Should this go into c.el? If so, into which override?)
+ (if (semantic-tag-of-class-p S 'using)
+ (let* ((fullname (semantic-analyze-unsplit-name
+ (list (semantic-tag-name type)
+ (semantic-tag-name S))))
+ ;; Search the typecache, first for the unqualified name
+ (usingtype (or
+ (semanticdb-typecache-find (semantic-tag-name S))
+ ;; If that didn't return anything, use
+ ;; fully qualified name
+ (semanticdb-typecache-find fullname)))
+ (filename (when usingtype (semantic-tag-file-name usingtype))))
+ (when usingtype
+ ;; Use recursion to examine that namespace or class
+ (let ((tags (semantic-completable-tags-from-type usingtype)))
+ (if filename
+ ;; If we have a filename, copy the tags with it
+ (dolist (cur tags)
+ (setq leftover (cons (semantic-tag-copy cur nil filename)
+ leftover)))
+ ;; Otherwise just run with it
+ (setq leftover (append tags leftover))))))
+ (when (or (not (semantic-tag-of-class-p S 'function))
+ (not (semantic-tag-function-parent S)))
+ (setq leftover (cons S leftover)))))
(nreverse leftover)))
(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection)
@@ -677,7 +706,7 @@ The class returned from the scope calculation is variable
(let* ((TAG (semantic-current-tag))
(scopecache
(semanticdb-cache-get semanticdb-current-table
- semantic-scope-cache))
+ 'semantic-scope-cache))
)
(when (not (semantic-equivalent-tag-p TAG (oref scopecache tag)))
(semantic-reset scopecache))
@@ -734,8 +763,9 @@ The class returned from the scope calculation is variable
(when (called-interactively-p 'any)
(require 'eieio-datadebug)
(data-debug-show scopecache))
- ;; Return ourselves
- scopecache))))
+ ;; Return ourselves, but make a clone first so that the caller
+ ;; can reset the scope cache without affecting others.
+ (clone scopecache)))))
(defun semantic-scope-find (name &optional class scope-in)
"Find the tag with NAME, and optional CLASS in the current SCOPE-IN.
@@ -799,7 +829,7 @@ hits in order, with the first tag being in the closest scope."
;;; DUMP
;;
-(defmethod semantic-analyze-show ((context semantic-scope-cache))
+(cl-defmethod semantic-analyze-show ((context semantic-scope-cache))
"Insert CONTEXT into the current buffer in a nice way."
(require 'semantic/analyze)
(semantic-analyze-princ-sequence (oref context scopetypes) "-> ScopeTypes: " )
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index 157223ff192..544abff8dd1 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -1,9 +1,9 @@
;;; semantic/senator.el --- SEmantic NAvigaTOR
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 10 Nov 2000
;; Keywords: syntax
@@ -507,7 +507,7 @@ filters in `senator-search-tag-filter-functions' remain active."
(define-overloadable-function semantic-up-reference (tag)
"Return a tag that is referred to by TAG.
A \"reference\" could be any interesting feature of TAG.
-In C++, a function may have a 'parent' which is non-local.
+In C++, a function may have a `parent' which is non-local.
If that parent which is only a reference in the function tag
is found, we can jump to it.
Some tags such as includes have other reference features.")
@@ -516,7 +516,7 @@ Some tags such as includes have other reference features.")
(defun senator-go-to-up-reference (&optional tag)
"Move up one reference from the current TAG.
A \"reference\" could be any interesting feature of TAG.
-In C++, a function may have a 'parent' which is non-local.
+In C++, a function may have a `parent' which is non-local.
If that parent which is only a reference in the function tag
is found, we can jump to it.
Some tags such as includes have other reference features."
@@ -722,8 +722,14 @@ yanked to."
(defun senator-copy-tag-to-register (register &optional kill-flag)
"Copy the current tag into REGISTER.
Optional argument KILL-FLAG will delete the text of the tag to the
-kill ring."
- (interactive "cTag to register: \nP")
+kill ring.
+
+Interactively, reads the register using `register-read-with-preview',
+if available."
+ (interactive (list (if (fboundp 'register-read-with-preview)
+ (register-read-with-preview "Tag to register: ")
+ (read-char "Tag to register: "))
+ current-prefix-arg))
(semantic-fetch-tags)
(let ((ft (semantic-obtain-foreign-tag)))
(when ft
@@ -807,7 +813,7 @@ Use a senator search function when semantic isearch mode is enabled."
(concat (if senator-isearch-semantic-mode
"senator-"
"")
- (cond (isearch-word "word-")
+ (cond (isearch-regexp-function "word-")
(isearch-regexp "re-")
(t ""))
"search-"
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index b32e11290ac..587d084701d 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -1,6 +1,6 @@
;;; semantic/sort.el --- Utilities for sorting and re-arranging tag tables.
-;;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index f85b66e66c6..89e8b40632d 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -1,6 +1,6 @@
;;; semantic/symref.el --- Symbol Reference API
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -314,7 +314,7 @@ Use the `semantic-symref-hit-tags' method to get this list.")
)
"The results from a symbol reference search.")
-(defmethod semantic-symref-result-get-files ((result semantic-symref-result))
+(cl-defmethod semantic-symref-result-get-files ((result semantic-symref-result))
"Get the list of files from the symref result RESULT."
(if (slot-boundp result :hit-files)
(oref result hit-files)
@@ -333,7 +333,26 @@ Use the `semantic-symref-hit-tags' method to get this list.")
)
))
-(defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
+(defvar semantic-symref-recently-opened-buffers nil
+ "List of buffers opened by `semantic-symref-result-get-tags'.")
+
+(defun semantic-symref-cleanup-recent-buffers-fcn ()
+ "Hook function to be used in `post-command-hook' to cleanup buffers.
+Buffers collected during symref can result in some files being
+opened multiple times for one operation. This will keep buffers open
+until the next command is executed."
+ ;;(message "To Clean Up: %S" semantic-symref-recently-opened-buffers)
+ (mapc (lambda (buff)
+ ;; Don't delete any buffers which are being used
+ ;; upon completion of some command.
+ (when (not (get-buffer-window buff))
+ (kill-buffer buff)))
+ semantic-symref-recently-opened-buffers)
+ (setq semantic-symref-recently-opened-buffers nil)
+ (remove-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ )
+
+(cl-defmethod semantic-symref-result-get-tags ((result semantic-symref-result)
&optional open-buffers)
"Get the list of tags from the symref result RESULT.
Optional OPEN-BUFFERS indicates that the buffers that the hits are
@@ -347,75 +366,19 @@ already."
(txt (oref (oref result :created-by) :searchfor))
(searchtype (oref (oref result :created-by) :searchtype))
(ans nil)
- (out nil)
- (buffs-to-kill nil))
+ (out nil))
(save-excursion
- (setq
- ans
- (mapcar
- (lambda (hit)
- (let* ((line (car hit))
- (file (cdr hit))
- (buff (find-buffer-visiting file))
- (tag nil)
- )
- (cond
- ;; We have a buffer already. Check it out.
- (buff
- (set-buffer buff))
-
- ;; We have a table, but it needs a refresh.
- ;; This means we should load in that buffer.
- (t
- (let ((kbuff
- (if open-buffers
- ;; Even if we keep the buffers open, don't
- ;; let EDE ask lots of questions.
- (let ((ede-auto-add-method 'never))
- (find-file-noselect file t))
- ;; When not keeping the buffers open, then
- ;; don't setup all the fancy froo-froo features
- ;; either.
- (semantic-find-file-noselect file t))))
- (set-buffer kbuff)
- (setq buffs-to-kill (cons kbuff buffs-to-kill))
- (semantic-fetch-tags)
- ))
- )
-
- ;; Too much baggage in goto-line
- ;; (goto-line line)
- (goto-char (point-min))
- (forward-line (1- line))
-
- ;; Search forward for the matching text
- (when (re-search-forward (regexp-quote txt)
- (point-at-eol)
- t)
- (goto-char (match-beginning 0))
- )
-
- (setq tag (semantic-current-tag))
-
- ;; If we are searching for a tag, but bound the tag we are looking
- ;; for, see if it resides in some other parent tag.
- ;;
- ;; If there is no parent tag, then we still need to hang the originator
- ;; in our list.
- (when (and (eq searchtype 'symbol)
- (string= (semantic-tag-name tag) txt))
- (setq tag (or (semantic-current-tag-parent) tag)))
-
- ;; Copy the tag, which adds a :filename property.
- (when tag
- (setq tag (semantic-tag-copy tag nil t))
- ;; Ad this hit to the tag.
- (semantic--tag-put-property tag :hit (list line)))
- tag))
- lines)))
+ (setq ans (mapcar
+ (lambda (hit)
+ (semantic-symref-hit-to-tag-via-buffer
+ hit txt searchtype open-buffers))
+ lines)))
;; Kill off dead buffers, unless we were requested to leave them open.
- (when (not open-buffers)
- (mapc 'kill-buffer buffs-to-kill))
+ (if (not open-buffers)
+ (add-hook 'post-command-hook 'semantic-symref-cleanup-recent-buffers-fcn)
+ ;; Else, just clear the saved buffers so they aren't deleted later.
+ (setq semantic-symref-recently-opened-buffers nil)
+ )
;; Strip out duplicates.
(dolist (T ans)
(if (and T (not (semantic-equivalent-tag-p (car out) T)))
@@ -429,6 +392,115 @@ already."
;; Out is reversed... twice
(oset result :hit-tags (nreverse out)))))
+(defun semantic-symref-hit-to-tag-via-db (hit searchtxt searchtype)
+ "Convert the symref HIT into a TAG by looking up the tag via a database.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+If there is no database, of if the searchtype is wrong, return nil."
+ ;; Allowed search types for this mechanism:
+ ;; tagname, tagregexp, tagcompletions
+ (if (not (memq searchtype '(tagname tagregexp tagcompletions)))
+ nil
+ (let* ((line (car hit))
+ (file (cdr hit))
+ ;; FAIL here vv - don't load is not obeyed if no table found.
+ (db (semanticdb-file-table-object file t))
+ (found nil)
+ (hit nil)
+ )
+ (cond ((eq searchtype 'tagname)
+ (setq found (semantic-find-tags-by-name searchtxt db)))
+ ((eq searchtype 'tagregexp)
+ (setq found (semantic-find-tags-by-name-regexp searchtxt db)))
+ ((eq searchtype 'tagcompletions)
+ (setq found (semantic-find-tags-for-completion searchtxt db)))
+ )
+ ;; Loop over FOUND to see if we can line up a match with a line number.
+ (when (= (length found) 1)
+ (setq hit (car found)))
+
+ ;; FAIL here ^^ - symref finds line numbers, but our DB uses character locations.
+ ;; as such, this is a cheat and we will need to give up.
+ hit)))
+
+(defun semantic-symref-hit-to-tag-via-buffer (hit searchtxt searchtype &optional open-buffers)
+ "Convert the symref HIT into a TAG by looking up the tag via a buffer.
+Return the Semantic tag associated with HIT.
+SEARCHTXT is the text that is being searched for.
+Used to narrow the in-buffer search.
+SEARCHTYPE is the type of search (such as 'symbol or 'tagname).
+Optional OPEN-BUFFERS, when nil will use a faster version of
+`find-file' when a file needs to be opened. If non-nil, then
+normal buffer initialization will be used.
+This function will leave buffers loaded from a file open, but
+will add buffers that must be opened to `semantic-symref-recently-opened-buffers'.
+Any caller MUST deal with that variable, either clearing it, or deleting the
+buffers that were opened."
+ (let* ((line (car hit))
+ (file (cdr hit))
+ (buff (find-buffer-visiting file))
+ (tag nil)
+ )
+ (cond
+ ;; We have a buffer already. Check it out.
+ (buff
+ (set-buffer buff))
+
+ ;; We have a table, but it needs a refresh.
+ ;; This means we should load in that buffer.
+ (t
+ (let ((kbuff
+ (if open-buffers
+ ;; Even if we keep the buffers open, don't
+ ;; let EDE ask lots of questions.
+ (let ((ede-auto-add-method 'never))
+ (find-file-noselect file t))
+ ;; When not keeping the buffers open, then
+ ;; don't setup all the fancy froo-froo features
+ ;; either.
+ (semantic-find-file-noselect file t))))
+ (set-buffer kbuff)
+ (push kbuff semantic-symref-recently-opened-buffers)
+ (semantic-fetch-tags)
+ ))
+ )
+
+ ;; Too much baggage in goto-line
+ ;; (goto-line line)
+ (goto-char (point-min))
+ (forward-line (1- line))
+
+ ;; Search forward for the matching text.
+ ;; FIXME: This still fails if the regexp uses something specific
+ ;; to the extended syntax, like grouping.
+ (when (re-search-forward (if (memq searchtype '(regexp tagregexp))
+ searchtxt
+ (regexp-quote searchtxt))
+ (point-at-eol)
+ t)
+ (goto-char (match-beginning 0))
+ )
+
+ (setq tag (semantic-current-tag))
+
+ ;; If we are searching for a tag, but bound the tag we are looking
+ ;; for, see if it resides in some other parent tag.
+ ;;
+ ;; If there is no parent tag, then we still need to hang the originator
+ ;; in our list.
+ (when (and (eq searchtype 'symbol)
+ (string= (semantic-tag-name tag) searchtxt))
+ (setq tag (or (semantic-current-tag-parent) tag)))
+
+ ;; Copy the tag, which adds a :filename property.
+ (when tag
+ (setq tag (semantic-tag-copy tag nil t))
+ ;; Ad this hit to the tag.
+ (semantic--tag-put-property tag :hit (list line)))
+ tag))
+
;;; SYMREF TOOLS
;;
;; The base symref tool provides something to hang new tools off of
@@ -440,7 +512,7 @@ already."
(searchtype :initarg :searchtype
:type symbol
:documentation "The type of search to do.
-Values could be `symbol, `regexp, 'tagname, or 'completion.")
+Values could be 'symbol, 'regexp, 'tagname, or 'completion.")
(searchscope :initarg :searchscope
:type symbol
:documentation
@@ -463,7 +535,7 @@ NAME is the name of the tool used in the configuration variable
`semantic-symref-tool'"
:abstract t)
-(defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-get-result ((tool semantic-symref-tool-baseclass))
"Calculate the results of a search based on TOOL.
The symref TOOL should already contain the search criteria."
(let ((answer (semantic-symref-perform-search tool))
@@ -481,11 +553,11 @@ The symref TOOL should already contain the search criteria."
)
))
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-baseclass))
"Base search for symref tools should throw an error."
(error "Symref tool objects must implement `semantic-symref-perform-search'"))
-(defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
+(cl-defmethod semantic-symref-parse-tool-output ((tool semantic-symref-tool-baseclass)
outputbuffer)
"Parse the entire OUTPUTBUFFER of a symref tool.
Calls the method `semantic-symref-parse-tool-output-one-line' over and
@@ -499,7 +571,7 @@ over until it returns nil."
(nreverse result)))
)
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-baseclass))
"Base tool output parser is not implemented."
(error "Symref tool objects must implement `semantic-symref-parse-tool-output-one-line'"))
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 426e1202c3b..91804f4ac9d 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -1,6 +1,6 @@
;;; semantic/symref/cscope.el --- Semantic-symref support via cscope.
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -42,7 +42,7 @@ the hit list.
See the function `cedet-cscope-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-cscope))
"Perform a search with GNU Global."
(let* ((rootproj (when (and (featurep 'ede) ede-minor-mode)
(ede-toplevel)))
@@ -60,7 +60,7 @@ See the function `cedet-cscope-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-cscope))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index c7b41b0081e..1cfa69fca21 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -1,6 +1,6 @@
;;; semantic/symref/filter.el --- Filter symbol reference hits for accuracy.
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el
index 75c7b02e7d3..88713474d69 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -1,6 +1,6 @@
;;; semantic/symref/global.el --- Use GNU Global for symbol references
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,7 +38,7 @@ the hit list.
See the function `cedet-gnu-global-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-global))
"Perform a search with GNU Global."
(let ((b (cedet-gnu-global-search (oref tool :searchfor)
(oref tool :searchtype)
@@ -49,7 +49,7 @@ See the function `cedet-gnu-global-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-global))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((or (eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index ce5c80526a8..cea6d4f07cd 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -1,6 +1,6 @@
;;; semantic/symref/grep.el --- Symref implementation using find/grep
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -46,9 +46,11 @@ and those hits returned.")
'((c-mode "*.[ch]")
(c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
(html-mode "*.s?html" "*.php")
+ (ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
+ "Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
)
- "List of major modes and file extension pattern regexp.
-See find -regex man page for format.")
+ "List of major modes and file extension pattern.
+See find -name man page for format.")
(defun semantic-symref-derive-find-filepatterns (&optional mode)
"Derive a list of file patterns for the current buffer.
@@ -85,6 +87,9 @@ Optional argument MODE specifies the `major-mode' to test."
(error "Customize `semantic-symref-filepattern-alist' for %s" major-mode))
)))
+(defvar grepflags)
+(defvar greppattern)
+
(defvar semantic-symref-grep-expand-keywords
(condition-case nil
(let* ((kw (copy-alist grep-expand-keywords))
@@ -96,7 +101,7 @@ Optional argument MODE specifies the `major-mode' to test."
(error nil))
"Grep expand keywords used when expanding templates for symref.")
-(defun semantic-symref-grep-use-template (rootdir filepattern grepflags greppattern)
+(defun semantic-symref-grep-use-template (rootdir filepattern flags pattern)
"Use the grep template expand feature to create a grep command.
ROOTDIR is the root location to run the `find' from.
FILEPATTERN is a string representing find flags for searching file patterns.
@@ -104,43 +109,60 @@ GREPFLAGS are flags passed to grep, such as -n or -l.
GREPPATTERN is the pattern used by grep."
;; We have grep-compute-defaults. Let's use it.
(grep-compute-defaults)
- (let* ((grep-expand-keywords semantic-symref-grep-expand-keywords)
- (cmd (grep-expand-template grep-find-template
- greppattern
- filepattern
- rootdir)))
- ;; For some reason, my default has no <D> in it.
+ (let* ((grepflags flags)
+ (greppattern pattern)
+ (grep-expand-keywords semantic-symref-grep-expand-keywords)
+ (cmd (grep-expand-template
+ (if (memq system-type '(windows-nt ms-dos))
+ ;; grep-find uses '--color=always' on MS-Windows
+ ;; because it wants the colorized output, to show
+ ;; it to the user. By contrast, here we don't show
+ ;; the output, and the SGR escapes get in the way
+ ;; of parsing the output.
+ (replace-regexp-in-string "--color=always" ""
+ grep-find-template t t)
+ grep-find-template)
+ greppattern
+ filepattern
+ rootdir)))
+ ;; http://debbugs.gnu.org/20719
(when (string-match "find \\(\\.\\)" cmd)
(setq cmd (replace-match rootdir t t cmd 1)))
;;(message "New command: %s" cmd)
cmd))
-(defcustom semantic-symref-grep-shell "sh"
+(defcustom semantic-symref-grep-shell shell-file-name
"The shell command to use for executing find/grep.
This shell should support pipe redirect syntax."
:group 'semantic
:type 'string)
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
(let ((st (oref tool :searchtype)))
- (when (not (eq st 'symbol))
+ (when (not (memq st '(symbol regexp)))
(error "Symref impl GREP does not support searchtype of %s" st))
)
;; Find the root of the project, and do a find-grep...
(let* (;; Find the file patterns to use.
- (pat (cdr (assoc major-mode semantic-symref-filepattern-alist)))
(rootdir (semantic-symref-calculate-rootdir))
(filepattern (semantic-symref-derive-find-filepatterns))
;; Grep based flags.
(grepflags (cond ((eq (oref tool :resulttype) 'file)
- "-l ")
- (t "-n ")))
- (greppat (cond ((eq (oref tool :searchtype) 'regexp)
- (oref tool searchfor))
- (t
- (concat "'\\<" (oref tool searchfor) "\\>'"))))
+ "-l ")
+ ((eq (oref tool :searchtype) 'regexp)
+ "-nE ")
+ (t "-n ")))
+ (greppat (shell-quote-argument
+ (cond ((eq (oref tool :searchtype) 'regexp)
+ (oref tool searchfor))
+ (t
+ ;; Can't use the word boundaries: Grep
+ ;; doesn't always agrees with the language
+ ;; syntax on those.
+ (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)"
+ (oref tool searchfor))))))
;; Misc
(b (get-buffer-create "*Semantic SymRef*"))
(ans nil)
@@ -158,16 +180,18 @@ This shell should support pipe redirect syntax."
(let ((cmd (concat "find " default-directory " -type f " filepattern " -print0 "
"| xargs -0 grep -H " grepflags "-e " greppat)))
;;(message "Old command: %s" cmd)
- (call-process semantic-symref-grep-shell nil b nil "-c" cmd)
+ (call-process semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd)
)
(let ((cmd (semantic-symref-grep-use-template rootdir filepattern grepflags greppat)))
- (call-process semantic-symref-grep-shell nil b nil "-c" cmd))
+ (call-process semantic-symref-grep-shell nil b nil
+ shell-command-switch cmd))
))
(setq ans (semantic-symref-parse-tool-output tool b))
;; Return the answer
ans))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 499efe60230..655b000ccdd 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -1,6 +1,6 @@
;;; semantic/symref/idutils.el --- Symref implementation for idutils
-;;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -38,7 +38,7 @@ the hit list.
See the function `cedet-idutils-search' for more details.")
-(defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-idutils))
"Perform a search with IDUtils."
(let ((b (cedet-idutils-search (oref tool :searchfor)
(oref tool :searchtype)
@@ -49,7 +49,7 @@ See the function `cedet-idutils-search' for more details.")
(semantic-symref-parse-tool-output tool b)
))
-(defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
+(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-idutils))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
(cond ((eq (oref tool :resulttype) 'file)
@@ -60,7 +60,7 @@ Moves cursor to end of the match."
(when (re-search-forward "^\\([^ ]+\\) " nil t)
(match-string 1)))
(t
- (when (re-search-forward "^\\([^ :]+\\):+\\([0-9]+\\):" nil t)
+ (when (re-search-forward "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):" nil t)
(cons (string-to-number (match-string 2))
(expand-file-name (match-string 1) default-directory))
))))
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index c1f0a092afc..f72499bf88e 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -1,6 +1,6 @@
;;; semantic/symref/list.el --- Symref Output List UI.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -48,18 +48,18 @@ they are used in.
Display the references in `semantic-symref-results-mode'."
(interactive)
(semantic-fetch-tags)
- (let ((ct (semantic-current-tag))
- (res nil)
- )
+ (let ((ct (semantic-current-tag)))
;; Must have a tag...
(when (not ct) (error "Place cursor inside tag to be searched for"))
;; Check w/ user.
- (when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct))))
+ (when (not (y-or-n-p (format "Find references for %s? "
+ (semantic-tag-name ct))))
(error "Quit"))
;; Gather results and tags
(message "Gathering References...")
- (setq res (semantic-symref-find-references-by-name (semantic-tag-name ct)))
- (semantic-symref-produce-list-on-results res (semantic-tag-name ct))))
+ (let* ((name (semantic-tag-name ct))
+ (res (semantic-symref-find-references-by-name name)))
+ (semantic-symref-produce-list-on-results res name))))
;;;###autoload
(defun semantic-symref-symbol (sym)
@@ -72,11 +72,9 @@ Display the references in `semantic-symref-results-mode'."
(interactive (list (semantic-tag-name (semantic-complete-read-tag-project
"Symrefs for: "))))
(semantic-fetch-tags)
- (let ((res nil)
- )
- ;; Gather results and tags
- (message "Gathering References...")
- (setq res (semantic-symref-find-references-by-name sym))
+ ;; Gather results and tags
+ (message "Gathering References...")
+ (let ((res (semantic-symref-find-references-by-name sym)))
(semantic-symref-produce-list-on-results res sym)))
;;;###autoload
@@ -86,32 +84,19 @@ This command uses the currently configured references tool within the
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 (semantic-tag-name (semantic-complete-read-tag-buffer-deep
- "Symrefs for: "))))
+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)))))))
+ ;; FIXME: Shouldn't the input be in Emacs regexp format, for
+ ;; consistency? Converting it to extended is not hard.
(semantic-fetch-tags)
- (let ((res nil)
- )
- ;; Gather results and tags
- (message "Gathering References...")
- (setq res (semantic-symref-find-text sym))
+ (message "Gathering References...")
+ ;; Gather results and tags
+ (let ((res (semantic-symref-find-text sym)))
(semantic-symref-produce-list-on-results res sym)))
-
-(defun semantic-symref-produce-list-on-results (res str)
- "Produce a symref list mode buffer on the results RES."
- (when (not res) (error "No references found"))
- (semantic-symref-result-get-tags res t)
- (message "Gathering References...done")
- ;; Build a references buffer.
- (let ((buff (get-buffer-create
- (format "*Symref %s" str)))
- )
- (switch-to-buffer-other-window buff)
- (set-buffer buff)
- (semantic-symref-results-mode res))
- )
-
;;; RESULTS MODE
;;
(defgroup semantic-symref-results-mode nil
@@ -178,36 +163,35 @@ Display the references in`semantic-symref-results-mode'."
(defcustom semantic-symref-auto-expand-results nil
"Non-nil to expand symref results on buffer creation."
- :group 'semantic-symref-results-mode
:type 'boolean)
(defcustom semantic-symref-results-mode-hook nil
"Hook run when `semantic-symref-results-mode' starts."
- :group 'semantic-symref-results-mode
:type 'hook)
(defvar semantic-symref-current-results nil
"The current results in a results mode buffer.")
-(defun semantic-symref-results-mode (results)
- ;; FIXME: Use define-derived-mode.
- "Major-mode for displaying Semantic Symbol Reference RESULTS.
-RESULTS is an object of class `semantic-symref-results'."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'semantic-symref-results-mode
- mode-name "Symref"
- )
- (use-local-map semantic-symref-results-mode-map)
- (set (make-local-variable 'semantic-symref-current-results)
- results)
- (semantic-symref-results-dump results)
- (goto-char (point-min))
+(defun semantic-symref-produce-list-on-results (res str)
+ "Produce a symref list mode buffer on the results RES."
+ (when (not res) (error "No references found"))
+ (semantic-symref-result-get-tags res t)
+ (message "Gathering References...done")
+ ;; Build a references buffer.
+ (let ((buff (get-buffer-create (format "*Symref %s" str))))
+ (switch-to-buffer-other-window buff)
+ (set-buffer buff)
+ (semantic-symref-results-mode)
+ (set (make-local-variable 'semantic-symref-current-results) res)
+ (semantic-symref-results-dump res)
+ (goto-char (point-min))))
+
+(define-derived-mode semantic-symref-results-mode nil "Symref"
+ "Major-mode for displaying Semantic Symbol Reference results."
(buffer-disable-undo)
+ ;; FIXME: Why bother turning off font-lock?
(set (make-local-variable 'font-lock-global-modes) nil)
- (font-lock-mode -1)
- (run-mode-hooks 'semantic-symref-results-mode-hook)
- )
+ (font-lock-mode -1))
(defun semantic-symref-hide-buffer ()
"Hide buffer with semantic-symref results."
@@ -215,9 +199,8 @@ RESULTS is an object of class `semantic-symref-results'."
(bury-buffer))
(defcustom semantic-symref-results-summary-function 'semantic-format-tag-prototype
- "*Function to use when creating items in Imenu.
+ "Function to use when creating items in Imenu.
Some useful functions are found in `semantic-format-tag-functions'."
- :group 'semantic-symref-results-mode
:type semantic-format-tag-custom-list)
(defun semantic-symref-results-dump (results)
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index b32b46b9e6a..fc5af6b908e 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -1,6 +1,6 @@
;;; semantic/tag-file.el --- Routines that find files based on tags.
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index bc7be980998..fe4440b1e1a 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -1,6 +1,6 @@
;;; semantic/tag-ls.el --- Language Specific override functions for tags
-;; Copyright (C) 1999-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -271,11 +271,11 @@ search locally, then semanticdb for that tag (when enabled.)")
(define-overloadable-function semantic-tag-protection (tag &optional parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
- nil - No special protection. Language dependent.
- 'public - Anyone can access this TAG.
- 'private - Only methods in the local scope can access TAG.
- 'protected - Like private for outside scopes, like public for child
- classes.
+ nil - No special protection. Language dependent.
+ `public' - Anyone can access this TAG.
+ `private' - Only methods in the local scope can access TAG.
+ `protected' - Like private for outside scopes, like public for child
+ classes.
Some languages may choose to provide additional return symbols specific
to themselves. Use of this function should allow for this.
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index 6db6b2e473a..98357186251 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -1,6 +1,6 @@
;;; semantic/tag-write.el --- Write tags to a text stream
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 6c532d2ebf5..34fc8ba92ce 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1,6 +1,6 @@
;;; semantic/tag.el --- tag creation and access
-;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -95,7 +95,7 @@ print statement."
(defsubst semantic-tag-class (tag)
"Return the class of TAG.
-That is, the symbol 'variable, 'function, 'type, or other.
+This is a symbol like `variable', `function', or `type'.
There is no limit to the symbols that may represent the class of a tag.
Each parser generates tags with classes defined by it.
@@ -172,7 +172,7 @@ That function is for internal use only."
(semantic--tag-set-overlay tag (vector start end)))))
(defun semantic-tag-in-buffer-p (tag)
- "Return the buffer TAG resides in IFF tag is already in a buffer.
+ "Return the buffer TAG resides in, if tag is already in a buffer.
If a tag is not in a buffer, return nil."
(let ((o (semantic-tag-overlay tag)))
;; TAG is currently linked to a buffer, return it.
@@ -621,7 +621,7 @@ buffer, the originating buffer file name is kept in the `:filename'
property of the copied tag.
If KEEP-FILE is a string, and the originating buffer is NOT available,
then KEEP-FILE is stored on the `:filename' property.
-This runs the tag hook `unlink-copy-hook`."
+This runs the tag hook `unlink-copy-hook'."
;; Right now, TAG is a list.
(let ((copy (semantic-tag-clone tag name)))
@@ -958,7 +958,7 @@ Return nil if TAG is not of class 'alias."
"Return a list of components for TAG.
A Component is a part of TAG which itself may be a TAG.
Examples include the elements of a structure in a
-tag of class `type, or the list of arguments to a
+tag of class 'type, or the list of arguments to a
tag of class 'function."
)
@@ -1212,7 +1212,7 @@ Returns a list of cooked tags.
The parser returns raw tags with positional data START END at the
end of the tag data structure (a list for now). We convert it from
that to a cooked state that uses an overlay proxy, that is, a vector
-\[START END].
+[START END].
The raw tag is changed with side effects and maybe expanded in
several derived tags when the variable `semantic-tag-expand-function'
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 34a85b8b79b..cf6726e711e 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -1,6 +1,6 @@
;;; semantic/texi.el --- Semantic details for Texinfo files
-;; Copyright (C) 2001-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -32,7 +32,7 @@
(require 'texinfo)
(defvar ede-minor-mode)
-(declare-function lookup-words "ispell")
+(declare-function ispell-lookup-words "ispell")
(declare-function ede-current-project "ede")
(defvar semantic-texi-super-regex
@@ -431,7 +431,7 @@ that start with that symbol."
((member 'word (oref context :prefixclass))
;; Do completion for words via ispell.
(require 'ispell)
- (let ((word-list (lookup-words prefix)))
+ (let ((word-list (ispell-lookup-words prefix)))
(mapcar (lambda (f) (semantic-tag f 'word)) word-list))
)
(t nil))
diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el
index b04de9b1aa6..c080642f670 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -1,6 +1,6 @@
;;; semantic/util-modes.el --- Semantic minor modes
-;; Copyright (C) 2000-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2005, 2007-2015 Free Software Foundation, Inc.
;; Authors: Eric M. Ludlam <zappo@gnu.org>
;; David Ponce <david@dponce.com>
@@ -684,15 +684,11 @@ when it lands in the sticky line."
(defconst semantic-stickyfunc-header-line-format
(cond ((featurep 'xemacs)
nil)
- ((>= emacs-major-version 22)
+ (t
'(:eval (list
;; Magic bit I found on emacswiki.
(propertize " " 'display '((space :align-to 0)))
- (semantic-stickyfunc-fetch-stickyline))))
- ((= emacs-major-version 21)
- '(:eval (list semantic-stickyfunc-indent-string
- (semantic-stickyfunc-fetch-stickyline))))
- (t nil))
+ (semantic-stickyfunc-fetch-stickyline)))))
"The header line format used by stickyfunc mode.")
;;;###autoload
@@ -719,7 +715,7 @@ minor mode is enabled."
(unless (boundp 'default-header-line-format)
;; Disable if there are no header lines to use.
(setq semantic-stickyfunc-mode nil)
- (error "Sticky Function mode requires Emacs 21"))
+ (error "Sticky Function mode requires Emacs"))
;; Enable the mode
;; Save previous buffer local value of header line format.
(when (and (local-variable-p 'header-line-format (current-buffer))
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 9e89ccb3e6e..fedc28135ae 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -1,6 +1,6 @@
;;; semantic/util.el --- Utilities for use with semantic tag tables
-;;; Copyright (C) 1999-2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -419,7 +419,8 @@ determining which symbols are considered."
(setq list (sort list 'string<))
(if (> (length list) 1)
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list list pattern))
+ (display-completion-list
+ (completion-hilit-commonality list (length pattern) nil)))
;; Bury any out-of-date completions buffer.
(let ((win (get-buffer-window "*Completions*" 0)))
(if win (with-selected-window win (bury-buffer))))))
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 89c63e7be96..761bc6812da 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent.el --- Wisent - Semantic gateway
-;; Copyright (C) 2001-2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2007, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -322,9 +322,9 @@ the standard function `semantic-parse-region'."
semantic--progress-reporter
(progress-reporter-update
semantic--progress-reporter
- (/ (* 100 (semantic-lex-token-start
- (car wisent-lex-istream)))
- (point-max))))))
+ (floor (* 100.0 (semantic-lex-token-start
+ (car wisent-lex-istream)))
+ (point-max))))))
;; Return parse tree
(nreverse ptree)))
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index 48a83f2cc79..585c11a05d3 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/comp.el --- GNU Bison for Emacs - Grammar compiler
-;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2013 Free
+;; Copyright (C) 1984, 1986, 1989, 1992, 1995, 2000-2007, 2009-2015 Free
;; Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
@@ -41,6 +41,7 @@
;;; Code:
(require 'semantic/wisent)
+(eval-when-compile (require 'cl))
;;;; -------------------
;;;; Misc. useful things
@@ -66,18 +67,23 @@
(defmacro wisent-defcontext (name &rest vars)
"Define a context NAME that will bind variables VARS."
+ (declare (indent 1))
(let* ((context (wisent-context-name name))
- (bindings (mapcar #'(lambda (v) (list 'defvar v)) vars)))
- `(eval-when-compile
- ,@bindings
- (defvar ,context ',vars))))
-(put 'wisent-defcontext 'lisp-indent-function 1)
+ (declarations (mapcar #'(lambda (v) (list 'defvar v)) vars)))
+ `(progn
+ ,@declarations
+ (eval-when-compile
+ (defvar ,context ',vars)))))
(defmacro wisent-with-context (name &rest body)
"Bind variables in context NAME then eval BODY."
- `(let* ,(wisent-context-bindings name)
- ,@body))
-(put 'wisent-with-context 'lisp-indent-function 1)
+ (declare (indent 1))
+ (let ((bindings (wisent-context-bindings name)))
+ `(progn
+ ,@(mapcar (lambda (binding) `(defvar ,(or (car-safe binding) binding)))
+ bindings)
+ (let* ,bindings
+ ,@body))))
;; A naive implementation of data structures! But it suffice here ;-)
@@ -224,11 +230,11 @@ Its name is defined in constant `wisent-log-buffer-name'."
(defsubst wisent-log (&rest args)
"Insert text into the log buffer.
-`format' is applied to ARGS and the result string is inserted into the
+`format-message' is applied to ARGS and the result string is inserted into the
log buffer returned by the function `wisent-log-buffer'."
(and wisent-new-log-flag (wisent-new-log))
(with-current-buffer (wisent-log-buffer)
- (insert (apply 'format args))))
+ (insert (apply #'format-message args))))
(defconst wisent-log-file "wisent.output"
"The log file.
@@ -909,7 +915,7 @@ An NVARS by NRULES matrix of bits indicating which rules can help
derive the beginning of the data for each nonterminal. For example,
if symbol 5 can be derived as the sequence of symbols 8 3 20, and one
of the rules for deriving symbol 8 is rule 4, then the
-\[5 - NTOKENS, 4] bit in FDERIVES is set."
+[5 - NTOKENS, 4] bit in FDERIVES is set."
(let (i j k)
(setq fderives (make-vector nvars nil))
(setq i 0)
@@ -2886,7 +2892,7 @@ Also warn if X is a $N or $regionN symbol with N < 1 or N > M."
"Parse BODY of semantic action.
N is the maximum number of $N variables that can be referenced in
BODY. Warn on references out of permitted range.
-Optional argument FOUND is the accumulated list of '$N' references
+Optional argument FOUND is the accumulated list of $N references
encountered so far.
Return a cons (FOUND . XBODY), where FOUND is the list of $N
references found in BODY, and XBODY is BODY expression with
@@ -2896,7 +2902,7 @@ references found in BODY, and XBODY is BODY expression with
(progn
(if (wisent-check-$N body n)
;; Accumulate $i symbol
- (add-to-list 'found body))
+ (pushnew body found :test #'equal))
(cons found body))
;; BODY is a list, expand inside it
(let (xbody sexpr)
@@ -2916,7 +2922,7 @@ references found in BODY, and XBODY is BODY expression with
;; $i symbol
((wisent-check-$N sexpr n)
;; Accumulate $i symbol
- (add-to-list 'found sexpr))
+ (pushnew sexpr found :test #'equal))
)
;; Accumulate expanded forms
(setq xbody (nconc xbody (list sexpr))))
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index 109d5ae7dfb..a247c250810 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/grammar.el --- Wisent's input grammar mode
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -473,6 +473,54 @@ Menu items are appended to the common grammar menu.")
\;; 2009, 2010 Python Software Foundation; All Rights Reserved"
,wisent-make-parsers--python-license)))
+;; Cf bovine--make-parser-1.
+(defun wisent--make-parser-1 (infile &optional outdir)
+ (if outdir (setq outdir (file-name-directory (expand-file-name outdir))))
+ (let ((packagename
+ ;; This is with-demoted-errors.
+ (condition-case err
+ (with-current-buffer (find-file-noselect infile)
+ (if outdir (setq default-directory outdir))
+ (semantic-grammar-create-package nil t))
+ (error (message "%s" (error-message-string err)) nil)))
+ output-data)
+ (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
+ (let ((additional-copyright (nth 1 output-data))
+ (additional-license (nth 2 output-data))
+ (filename (expand-file-name
+ (progn (string-match ".*/\\(.*\\)" packagename)
+ (match-string 1 packagename))
+ outdir))
+ copyright-end)
+ ;; Touch up the generated parsers for Emacs integration.
+ (with-temp-file filename
+ (insert-file-contents filename)
+ ;; Fix copyright header:
+ (goto-char (point-min))
+ (when additional-copyright
+ (re-search-forward "Copyright (C).*$")
+ (insert "\n;; " additional-copyright))
+ (re-search-forward "^;; Author:")
+ (setq copyright-end (match-beginning 0))
+ (re-search-forward "^;;; Code:\n")
+ (delete-region copyright-end (match-end 0))
+ (goto-char copyright-end)
+ (insert wisent-make-parsers--emacs-license)
+ (insert "\n\n;;; Commentary:
+;;
+;; This file was generated from admin/grammars/"
+ (file-name-nondirectory infile) ".")
+ (when additional-license
+ (insert "\n" additional-license))
+ (insert "\n\n;;; Code:\n")
+ (goto-char (point-min))
+ (delete-region (point-min) (line-end-position))
+ (insert ";;; " packagename
+ " --- Generated parser support file")
+ (re-search-forward ";;; \\(.*\\) ends here")
+ (replace-match packagename nil nil nil 1)
+ (delete-trailing-whitespace))))))
+
(defun wisent-make-parsers ()
"Generate Emacs' built-in Wisent-based parser files."
(interactive)
@@ -480,46 +528,32 @@ Menu items are appended to the common grammar menu.")
;; Loop through each .wy file in current directory, and run
;; `semantic-grammar-batch-build-one-package' to build the grammar.
(dolist (f (directory-files default-directory nil "\\.wy\\'"))
- (let ((packagename
- (condition-case err
- (with-current-buffer (find-file-noselect f)
- (semantic-grammar-create-package))
- (error (message "%s" (error-message-string err)) nil)))
- output-data)
- (when (setq output-data (assoc packagename wisent-make-parsers--parser-file-name))
- (let ((additional-copyright (nth 1 output-data))
- (additional-license (nth 2 output-data))
- (filename (progn (string-match ".*/\\(.*\\)" packagename) (match-string 1 packagename)))
- copyright-end)
- ;; Touch up the generated parsers for Emacs integration.
- (with-temp-buffer
- (insert-file-contents filename)
- ;; Fix copyright header:
- (goto-char (point-min))
- (when additional-copyright
- (re-search-forward "Copyright (C).*$")
- (insert "\n;; " additional-copyright))
- (re-search-forward "^;; Author:")
- (setq copyright-end (match-beginning 0))
- (re-search-forward "^;;; Code:\n")
- (delete-region copyright-end (match-end 0))
- (goto-char copyright-end)
- (insert wisent-make-parsers--emacs-license)
- (insert "\n\n;;; Commentary:
-;;
-;; This file was generated from admin/grammars/"
- f ".")
- (when additional-license
- (insert "\n" additional-license))
- (insert "\n\n;;; Code:\n")
- (goto-char (point-min))
- (delete-region (point-min) (line-end-position))
- (insert ";;; " packagename
- " --- Generated parser support file")
- (re-search-forward ";;; \\(.*\\) ends here")
- (replace-match packagename nil nil nil 1)
- (delete-trailing-whitespace)
- (write-region nil nil (expand-file-name filename))))))))
+ (wisent--make-parser-1 f)))
+
+
+(defun wisent-batch-make-parser (&optional infile outdir)
+ "Generate a Wisent parser from input INFILE, writing to OUTDIR.
+This is mainly intended for use in batch mode:
+
+emacs -batch -l semantic/wisent/grammar -f wisent-make-parser-batch \\
+ [-dir output-dir | -o output-file] file.by
+
+If -o is supplied, only the directory part is used."
+ (semantic-mode 1)
+ (when (and noninteractive (not infile))
+ (let (arg)
+ (while command-line-args-left
+ (setq arg (pop command-line-args-left))
+ (cond ((string-equal arg "-dir")
+ (setq outdir (pop command-line-args-left)))
+ ((string-equal arg "-o")
+ (setq outdir (file-name-directory (pop command-line-args-left))))
+ (t (setq infile arg))))))
+ (or infile (error "No input file specified"))
+ (or (file-readable-p infile)
+ (error "Input file `%s' not readable" infile))
+ (wisent--make-parser-1 infile outdir))
+
(provide 'semantic/wisent/grammar)
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index 076ffedc419..f0496322d20 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs
-;; Copyright (C) 2001-2006, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2006, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index d27f1bc4c66..a676a8b4591 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/javascript.el --- javascript parser support
-;; Copyright (C) 2005, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Ludlam <zappo@gnu.org>
;; Keywords: syntax
@@ -73,11 +73,11 @@ This function overrides `get-local-variables'."
(define-mode-local-override semantic-tag-protection javascript-mode (tag &optional parent)
"Return protection information about TAG with optional PARENT.
This function returns on of the following symbols:
- nil - No special protection. Language dependent.
- 'public - Anyone can access this TAG.
- 'private - Only methods in the local scope can access TAG.
- 'protected - Like private for outside scopes, like public for child
- classes.
+ nil - No special protection. Language dependent.
+ `public' - Anyone can access this TAG.
+ `private' - Only methods in the local scope can access TAG.
+ `protected' - Like private for outside scopes, like public for child
+ classes.
Some languages may choose to provide additional return symbols specific
to themselves. Use of this function should allow for this.
@@ -114,7 +114,7 @@ This is currently needed for the mozrepl omniscient database."
(setq symlist (list (match-string 1 tmp)
(substring tmp (1+ (match-end 1)) (length tmp))))
(setq symlist (list tmp))))))))
-
+
;;; Setup Function
;;
;; Since javascript-mode is an alias for js-mode, let it inherit all
diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el
deleted file mode 100644
index 1156cb5792c..00000000000
--- a/lisp/cedet/semantic/wisent/javat-wy.el
+++ /dev/null
@@ -1,688 +0,0 @@
-;;; semantic/wisent/javat-wy.el --- Generated parser support file
-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/java-tags.wy.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-java-tags-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("abstract" . ABSTRACT)
- ("boolean" . BOOLEAN)
- ("break" . BREAK)
- ("byte" . BYTE)
- ("case" . CASE)
- ("catch" . CATCH)
- ("char" . CHAR)
- ("class" . CLASS)
- ("const" . CONST)
- ("continue" . CONTINUE)
- ("default" . DEFAULT)
- ("do" . DO)
- ("double" . DOUBLE)
- ("else" . ELSE)
- ("extends" . EXTENDS)
- ("final" . FINAL)
- ("finally" . FINALLY)
- ("float" . FLOAT)
- ("for" . FOR)
- ("goto" . GOTO)
- ("if" . IF)
- ("implements" . IMPLEMENTS)
- ("import" . IMPORT)
- ("instanceof" . INSTANCEOF)
- ("int" . INT)
- ("interface" . INTERFACE)
- ("long" . LONG)
- ("native" . NATIVE)
- ("new" . NEW)
- ("package" . PACKAGE)
- ("private" . PRIVATE)
- ("protected" . PROTECTED)
- ("public" . PUBLIC)
- ("return" . RETURN)
- ("short" . SHORT)
- ("static" . STATIC)
- ("strictfp" . STRICTFP)
- ("super" . SUPER)
- ("switch" . SWITCH)
- ("synchronized" . SYNCHRONIZED)
- ("this" . THIS)
- ("throw" . THROW)
- ("throws" . THROWS)
- ("transient" . TRANSIENT)
- ("try" . TRY)
- ("void" . VOID)
- ("volatile" . VOLATILE)
- ("while" . WHILE)
- ("@author" . _AUTHOR)
- ("@version" . _VERSION)
- ("@param" . _PARAM)
- ("@return" . _RETURN)
- ("@exception" . _EXCEPTION)
- ("@throws" . _THROWS)
- ("@see" . _SEE)
- ("@since" . _SINCE)
- ("@serial" . _SERIAL)
- ("@serialData" . _SERIALDATA)
- ("@serialField" . _SERIALFIELD)
- ("@deprecated" . _DEPRECATED))
- '(("@deprecated" javadoc
- (seq 12 usage
- (type function variable)
- opt t))
- ("@serialField" javadoc
- (seq 11 usage
- (variable)
- opt t))
- ("@serialData" javadoc
- (seq 10 usage
- (function)
- opt t))
- ("@serial" javadoc
- (seq 9 usage
- (variable)
- opt t))
- ("@since" javadoc
- (seq 8 usage
- (type function variable)
- opt t))
- ("@see" javadoc
- (seq 7 usage
- (type function variable)
- opt t with-ref t))
- ("@throws" javadoc
- (seq 6 usage
- (function)
- with-name t))
- ("@exception" javadoc
- (seq 5 usage
- (function)
- with-name t))
- ("@return" javadoc
- (seq 4 usage
- (function)))
- ("@param" javadoc
- (seq 3 usage
- (function)
- with-name t))
- ("@version" javadoc
- (seq 2 usage
- (type)))
- ("@author" javadoc
- (seq 1 usage
- (type)))
- ("while" summary "while (<expr>) <stmt> | do <stmt> while (<expr>);")
- ("volatile" summary "Field declaration modifier: volatile <type> <name> ...")
- ("void" summary "Method return type: void <name> ...")
- ("try" summary "try {<stmts>} [catch(<parm>) {<stmts>} ...] [finally {<stmts>}]")
- ("transient" summary "Field declaration modifier: transient <type> <name> ...")
- ("throws" summary "Method|Constructor declaration: throws <classType>, ...")
- ("throw" summary "throw <expr> ;")
- ("synchronized" summary "synchronized (<expr>) ... | Method decl. modifier: synchronized <type> <name> ...")
- ("switch" summary "switch(<expr>) {[case <const-expr>: <stmts> ...] [default: <stmts>]}")
- ("strictfp" summary "Declaration modifier: strictfp {class|interface|<type>} <name> ...")
- ("static" summary "Declaration modifier: static {class|interface|<type>} <name> ...")
- ("short" summary "Integral primitive type (-32768 to 32767)")
- ("return" summary "return [<expr>] ;")
- ("public" summary "Access level modifier: public {class|interface|<type>} <name> ...")
- ("protected" summary "Access level modifier: protected {class|interface|<type>} <name> ...")
- ("private" summary "Access level modifier: private {class|interface|<type>} <name> ...")
- ("package" summary "Package declaration: package <name>")
- ("native" summary "Method declaration modifier: native <type> <name> ...")
- ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
- ("interface" summary "Interface declaration: interface <name>")
- ("int" summary "Integral primitive type (-2147483648 to 2147483647)")
- ("import" summary "Import package declarations: import <package>")
- ("implements" summary "Class SuperInterfaces declaration: implements <name> [, ...]")
- ("if" summary "if (<expr>) <stmt> [else <stmt>]")
- ("goto" summary "Unused reserved word")
- ("for" summary "for ([<init-expr>]; [<expr>]; [<update-expr>]) <stmt>")
- ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
- ("finally" summary "try {<stmts>} ... finally {<stmts>}")
- ("final" summary "Class|Member declaration modifier: final {class|<type>} <name> ...")
- ("extends" summary "SuperClass|SuperInterfaces declaration: extends <name> [, ...]")
- ("else" summary "if (<expr>) <stmt> else <stmt>")
- ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
- ("do" summary "do <stmt> while (<expr>);")
- ("default" summary "switch(<expr>) { ... default: <stmts>}")
- ("continue" summary "continue [<label>] ;")
- ("const" summary "Unused reserved word")
- ("class" summary "Class declaration: class <name>")
- ("char" summary "Integral primitive type (0 to 65535)")
- ("catch" summary "try {<stmts>} catch(<parm>) {<stmts>} ... ")
- ("case" summary "switch(<expr>) {case <const-expr>: <stmts> ... }")
- ("byte" summary "Integral primitive type (-128 to 127)")
- ("break" summary "break [<label>] ;")
- ("boolean" summary "Primitive logical quantity type (true or false)")
- ("abstract" summary "Class|Method declaration modifier: abstract {class|<type>} <name> ...")))
- "Table of language keywords.")
-
-(defconst wisent-java-tags-wy--token-table
- (semantic-lex-make-type-table
- '(("unicode"
- (unicodecharacter))
- ("number"
- (NUMBER_LITERAL))
- ("string"
- (STRING_LITERAL))
- ("symbol"
- (IDENTIFIER))
- ("punctuation"
- (COMP . "~")
- (OROR . "||")
- (OREQ . "|=")
- (OR . "|")
- (XOREQ . "^=")
- (XOR . "^")
- (QUESTION . "?")
- (URSHIFTEQ . ">>>=")
- (URSHIFT . ">>>")
- (RSHIFTEQ . ">>=")
- (RSHIFT . ">>")
- (GTEQ . ">=")
- (GT . ">")
- (EQEQ . "==")
- (EQ . "=")
- (LTEQ . "<=")
- (LSHIFTEQ . "<<=")
- (LSHIFT . "<<")
- (LT . "<")
- (SEMICOLON . ";")
- (COLON . ":")
- (DIVEQ . "/=")
- (DIV . "/")
- (DOT . ".")
- (MINUSEQ . "-=")
- (MINUSMINUS . "--")
- (MINUS . "-")
- (COMMA . ",")
- (PLUSEQ . "+=")
- (PLUSPLUS . "++")
- (PLUS . "+")
- (MULTEQ . "*=")
- (MULT . "*")
- (ANDEQ . "&=")
- (ANDAND . "&&")
- (AND . "&")
- (MODEQ . "%=")
- (MOD . "%")
- (NOTEQ . "!=")
- (NOT . "!"))
- ("close-paren"
- (RBRACK . "]")
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACK . "[")
- (LBRACE . "{")
- (LPAREN . "("))
- ("block"
- (BRACK_BLOCK . "(LBRACK RBRACK)")
- (BRACE_BLOCK . "(LBRACE RBRACE)")
- (PAREN_BLOCK . "(LPAREN RPAREN)")))
- '(("keyword" :declared t)
- ("unicode" syntax "\\\\u[0-9a-f][0-9a-f][0-9a-f][0-9a-f]")
- ("unicode" :declared t)
- ("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("punctuation" :declared t)
- ("block" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-java-tags-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK NOT NOTEQ MOD MODEQ AND ANDAND ANDEQ MULT MULTEQ PLUS PLUSPLUS PLUSEQ COMMA MINUS MINUSMINUS MINUSEQ DOT DIV DIVEQ COLON SEMICOLON LT LSHIFT LSHIFTEQ LTEQ EQ EQEQ GT GTEQ RSHIFT RSHIFTEQ URSHIFT URSHIFTEQ QUESTION XOR XOREQ OR OREQ OROR COMP IDENTIFIER STRING_LITERAL NUMBER_LITERAL unicodecharacter ABSTRACT BOOLEAN BREAK BYTE CASE CATCH CHAR CLASS CONST CONTINUE DEFAULT DO DOUBLE ELSE EXTENDS FINAL FINALLY FLOAT FOR GOTO IF IMPLEMENTS IMPORT INSTANCEOF INT INTERFACE LONG NATIVE NEW PACKAGE PRIVATE PROTECTED PUBLIC RETURN SHORT STATIC STRICTFP SUPER SWITCH SYNCHRONIZED THIS THROW THROWS TRANSIENT TRY VOID VOLATILE WHILE _AUTHOR _VERSION _PARAM _RETURN _EXCEPTION _THROWS _SEE _SINCE _SERIAL _SERIALDATA _SERIALFIELD _DEPRECATED)
- nil
- (compilation_unit
- ((package_declaration))
- ((import_declaration))
- ((type_declaration)))
- (package_declaration
- ((PACKAGE qualified_name SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-package $2 nil))))
- (import_declaration
- ((IMPORT qualified_name SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil)))
- ((IMPORT qualified_name DOT MULT SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-include
- (concat $2 $3 $4)
- nil))))
- (type_declaration
- ((SEMICOLON)
- nil)
- ((class_declaration))
- ((interface_declaration)))
- (class_declaration
- ((modifiers_opt CLASS qualified_name superc_opt interfaces_opt class_body)
- (wisent-raw-tag
- (semantic-tag-new-type $3 $2 $6
- (if
- (or $4 $5)
- (cons $4 $5))
- :typemodifiers $1))))
- (superc_opt
- (nil)
- ((EXTENDS qualified_name)
- (identity $2)))
- (interfaces_opt
- (nil)
- ((IMPLEMENTS qualified_name_list)
- (nreverse $2)))
- (class_body
- ((BRACE_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'class_member_declaration 1)))
- (class_member_declaration
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((block)
- nil)
- ((static_initializer)
- nil)
- ((constructor_declaration))
- ((interface_declaration))
- ((class_declaration))
- ((method_declaration))
- ((field_declaration)))
- (interface_declaration
- ((modifiers_opt INTERFACE qualified_name extends_interfaces_opt interface_body)
- (wisent-raw-tag
- (semantic-tag-new-type $3 $2 $5
- (if $4
- (cons nil $4))
- :typemodifiers $1))))
- (extends_interfaces_opt
- (nil)
- ((EXTENDS qualified_name_list)
- (identity $2)))
- (interface_body
- ((BRACE_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'interface_member_declaration 1)))
- (interface_member_declaration
- ((LBRACE)
- nil)
- ((RBRACE)
- nil)
- ((interface_declaration))
- ((class_declaration))
- ((method_declaration))
- ((field_declaration)))
- (static_initializer
- ((STATIC block)))
- (constructor_declaration
- ((modifiers_opt constructor_declarator throwsc_opt constructor_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $2)
- nil
- (cdr $2)
- :typemodifiers $1 :throws $3 :constructor-flag t))))
- (constructor_declarator
- ((IDENTIFIER formal_parameter_list)
- (cons $1 $2)))
- (constructor_body
- ((block)))
- (method_declaration
- ((modifiers_opt VOID method_declarator throwsc_opt method_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $3)
- $2
- (cdr $3)
- :typemodifiers $1 :throws $4)))
- ((modifiers_opt type method_declarator throwsc_opt method_body)
- (wisent-raw-tag
- (semantic-tag-new-function
- (car $3)
- $2
- (cdr $3)
- :typemodifiers $1 :throws $4))))
- (method_declarator
- ((IDENTIFIER formal_parameter_list dims_opt)
- (cons
- (concat $1 $3)
- $2)))
- (throwsc_opt
- (nil)
- ((THROWS qualified_name_list)
- (nreverse $2)))
- (qualified_name_list
- ((qualified_name_list COMMA qualified_name)
- (cons $3 $1))
- ((qualified_name)
- (list $1)))
- (method_body
- ((SEMICOLON))
- ((block)))
- (block
- ((BRACE_BLOCK)))
- (formal_parameter_list
- ((PAREN_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'formal_parameters 1)))
- (formal_parameters
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((formal_parameter COMMA))
- ((formal_parameter RPAREN)))
- (formal_parameter
- ((formal_parameter_modifier_opt type opt_variable_declarator_id)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 $2 nil :typemodifiers $1))))
- (formal_parameter_modifier_opt
- (nil)
- ((FINAL)
- (list $1)))
- (field_declaration
- ((modifiers_opt type variable_declarators SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 $2 nil :typemodifiers $1))))
- (variable_declarators
- ((variable_declarators COMMA variable_declarator)
- (progn
- (setcdr
- (cdr
- (car $1))
- (cdr $region2))
- (cons $3 $1)))
- ((variable_declarator)
- (list $1)))
- (variable_declarator
- ((variable_declarator_id EQ variable_initializer)
- (cons $1 $region))
- ((variable_declarator_id)
- (cons $1 $region)))
- (opt_variable_declarator_id
- (nil
- (identity ""))
- ((variable_declarator_id)
- (identity $1)))
- (variable_declarator_id
- ((IDENTIFIER dims_opt)
- (concat $1 $2)))
- (variable_initializer
- ((expression)))
- (expression
- ((expression term))
- ((term)))
- (term
- ((literal))
- ((operator))
- ((primitive_type))
- ((IDENTIFIER))
- ((BRACK_BLOCK))
- ((PAREN_BLOCK))
- ((BRACE_BLOCK))
- ((NEW))
- ((CLASS))
- ((THIS))
- ((SUPER)))
- (literal
- ((STRING_LITERAL))
- ((NUMBER_LITERAL)))
- (operator
- ((NOT))
- ((PLUS))
- ((PLUSPLUS))
- ((MINUS))
- ((MINUSMINUS))
- ((NOTEQ))
- ((MOD))
- ((MODEQ))
- ((AND))
- ((ANDAND))
- ((ANDEQ))
- ((MULT))
- ((MULTEQ))
- ((PLUSEQ))
- ((MINUSEQ))
- ((DOT))
- ((DIV))
- ((DIVEQ))
- ((COLON))
- ((LT))
- ((LSHIFT))
- ((LSHIFTEQ))
- ((LTEQ))
- ((EQ))
- ((EQEQ))
- ((GT))
- ((GTEQ))
- ((RSHIFT))
- ((RSHIFTEQ))
- ((URSHIFT))
- ((URSHIFTEQ))
- ((QUESTION))
- ((XOR))
- ((XOREQ))
- ((OR))
- ((OREQ))
- ((OROR))
- ((COMP))
- ((INSTANCEOF)))
- (primitive_type
- ((BOOLEAN))
- ((CHAR))
- ((LONG))
- ((INT))
- ((SHORT))
- ((BYTE))
- ((DOUBLE))
- ((FLOAT)))
- (modifiers_opt
- (nil)
- ((modifiers)
- (nreverse $1)))
- (modifiers
- ((modifiers modifier)
- (cons $2 $1))
- ((modifier)
- (list $1)))
- (modifier
- ((STRICTFP))
- ((VOLATILE))
- ((TRANSIENT))
- ((SYNCHRONIZED))
- ((NATIVE))
- ((FINAL))
- ((ABSTRACT))
- ((STATIC))
- ((PRIVATE))
- ((PROTECTED))
- ((PUBLIC)))
- (type
- ((qualified_name dims_opt)
- (concat $1 $2))
- ((primitive_type dims_opt)
- (concat $1 $2)))
- (qualified_name
- ((qualified_name DOT IDENTIFIER)
- (concat $1 $2 $3))
- ((IDENTIFIER)))
- (dims_opt
- (nil
- (identity ""))
- ((dims)))
- (dims
- ((dims BRACK_BLOCK)
- (concat $1 "[]"))
- ((BRACK_BLOCK)
- (identity "[]"))))
- '(compilation_unit package_declaration import_declaration class_declaration field_declaration method_declaration formal_parameter constructor_declaration interface_declaration class_member_declaration interface_member_declaration formal_parameters)))
- "Parser table.")
-
-(defun wisent-java-tags-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-java-tags-wy--parse-table
- semantic-debug-parser-source "java-tags.wy"
- semantic-flex-keywords-obarray wisent-java-tags-wy--keyword-table
- semantic-lex-types-obarray wisent-java-tags-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-java-tags-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" LPAREN PAREN_BLOCK)
- ("{" LBRACE BRACE_BLOCK)
- ("[" LBRACK BRACK_BLOCK))
- (")" RPAREN)
- ("}" RBRACE)
- ("]" RBRACK))
- )
-
-(define-lex-string-type-analyzer wisent-java-tags-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((COMP . "~")
- (OROR . "||")
- (OREQ . "|=")
- (OR . "|")
- (XOREQ . "^=")
- (XOR . "^")
- (QUESTION . "?")
- (URSHIFTEQ . ">>>=")
- (URSHIFT . ">>>")
- (RSHIFTEQ . ">>=")
- (RSHIFT . ">>")
- (GTEQ . ">=")
- (GT . ">")
- (EQEQ . "==")
- (EQ . "=")
- (LTEQ . "<=")
- (LSHIFTEQ . "<<=")
- (LSHIFT . "<<")
- (LT . "<")
- (SEMICOLON . ";")
- (COLON . ":")
- (DIVEQ . "/=")
- (DIV . "/")
- (DOT . ".")
- (MINUSEQ . "-=")
- (MINUSMINUS . "--")
- (MINUS . "-")
- (COMMA . ",")
- (PLUSEQ . "+=")
- (PLUSPLUS . "++")
- (PLUS . "+")
- (MULTEQ . "*=")
- (MULT . "*")
- (ANDEQ . "&=")
- (ANDAND . "&&")
- (AND . "&")
- (MODEQ . "%=")
- (MOD . "%")
- (NOTEQ . "!=")
- (NOT . "!"))
- 'punctuation)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'IDENTIFIER)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<unicode>-regexp-analyzer
- "regexp analyzer for <unicode> tokens."
- "\\\\u[0-9a-f][0-9a-f][0-9a-f][0-9a-f]"
- nil
- 'unicodecharacter)
-
-(define-lex-regex-type-analyzer wisent-java-tags-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER_LITERAL)
-
-(define-lex-sexp-type-analyzer wisent-java-tags-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING_LITERAL)
-
-(define-lex-keyword-type-analyzer wisent-java-tags-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-;; Define the lexer for this grammar
-(define-lex wisent-java-tags-lexer
- "Lexical analyzer that handles Java buffers.
-It ignores whitespaces, newlines and comments."
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
- ;;;; Auto-generated analyzers.
- wisent-java-tags-wy--<number>-regexp-analyzer
- wisent-java-tags-wy--<string>-sexp-analyzer
- ;; Must detect keywords before other symbols
- wisent-java-tags-wy--<keyword>-keyword-analyzer
- wisent-java-tags-wy--<symbol>-regexp-analyzer
- wisent-java-tags-wy--<punctuation>-string-analyzer
- wisent-java-tags-wy--<block>-block-analyzer
- ;; In theory, Unicode chars should be turned into normal chars
- ;; and then combined into regular ascii keywords and text. This
- ;; analyzer just keeps these things from making the lexer go boom.
- wisent-java-tags-wy--<unicode>-regexp-analyzer
- ;;;;
- semantic-lex-default-action)
-
-(provide 'semantic/wisent/javat-wy)
-
-;;; semantic/wisent/javat-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/js-wy.el b/lisp/cedet/semantic/wisent/js-wy.el
deleted file mode 100644
index 2e331b1c4d9..00000000000
--- a/lisp/cedet/semantic/wisent/js-wy.el
+++ /dev/null
@@ -1,530 +0,0 @@
-;;; semantic/wisent/js-wy.el --- Generated parser support file
-
-;; Copyright (C) 2005, 2009-2013 Free Software Foundation, Inc.
-;; Copyright (C) 1998-2011 Ecma International.
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/js.wy.
-
-;; It is derived from the grammar in the ECMAScript Language
-;; Specification published at
-;;
-;; http://www.ecma-international.org/publications/standards/Ecma-262.htm
-;;
-;; and redistributed under the following license:
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above
-;; copyright notice, this list of conditions and the following
-;; disclaimer in the documentation and/or other materials provided
-;; with the distribution.
-;;
-;; 3. Neither the name of the authors nor Ecma International may be
-;; used to endorse or promote products derived from this software
-;; without specific prior written permission. THIS SOFTWARE IS
-;; PROVIDED BY THE ECMA INTERNATIONAL "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;; ARE DISCLAIMED. IN NO EVENT SHALL ECMA INTERNATIONAL BE LIABLE FOR
-;; ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
-;; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
-;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-;; DAMAGE.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-javascript-jv-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("if" . IF)
- ("break" . BREAK)
- ("continue" . CONTINUE)
- ("else" . ELSE)
- ("for" . FOR)
- ("function" . FUNCTION)
- ("this" . THIS)
- ("return" . RETURN)
- ("while" . WHILE)
- ("void" . VOID_SYMBOL)
- ("new" . NEW)
- ("delete" . DELETE)
- ("var" . VAR)
- ("with" . WITH)
- ("typeof" . TYPEOF)
- ("in" . IN))
- '(("in" summary "in something")
- ("typeof" summary "typeof ")
- ("with" summary "with ")
- ("var" summary "var <variablename> [= value];")
- ("delete" summary "delete(<objectreference>) - Deletes the object.")
- ("new" summary "new <objecttype> - Creates a new object.")
- ("void" summary "Method return type: void <name> ...")
- ("while" summary "while (<expr>) <stmt> | do <stmt> while (<expr>);")
- ("return" summary "return [<expr>] ;")
- ("this" summary "this")
- ("function" summary "function declaration blah blah")
- ("for" summary "for ([<init-expr>]; [<expr>]; [<update-expr>]) <stmt>")
- ("else" summary "if (<expr>) <stmt> else <stmt>")
- ("continue" summary "continue [<label>] ;")
- ("break" summary "break [<label>] ;")
- ("if" summary "if (<expr>) <stmt> [else <stmt>] (jv)")))
- "Table of language keywords.")
-
-(defconst wisent-javascript-jv-wy--token-table
- (semantic-lex-make-type-table
- '(("<no-type>"
- (NULL_TOKEN)
- (QUERY)
- (TRUE)
- (FALSE))
- ("number"
- (NUMBER))
- ("string"
- (STRING))
- ("symbol"
- (VARIABLE))
- ("close-paren"
- (CLOSE_SQ_BRACKETS . "]")
- (END_BLOCK . "}")
- (CLOSE_PARENTHESIS . ")"))
- ("open-paren"
- (OPEN_SQ_BRACKETS . "[")
- (START_BLOCK . "{")
- (OPEN_PARENTHESIS . "("))
- ("block"
- (BRACK_BLOCK . "(OPEN_SQ_BRACKETS CLOSE_SQ_BRACKETS)")
- (BRACE_BLOCK . "(START_BLOCK END_BLOCK)")
- (PAREN_BLOCK . "(OPEN_PARENTHESIS CLOSE_PARENTHESIS)"))
- ("punctuation"
- (ONES_COMPLIMENT . "~")
- (SEMICOLON . ";")
- (LINE_TERMINATOR . "\n")
- (LESS_THAN . "<")
- (DOT . ".")
- (COMMA . ",")
- (COLON . ":")
- (DIV . "/")
- (DECREMENT . "--")
- (INCREMENT . "++")
- (PLUS_EQUALS . "+=")
- (PLUS . "+")
- (MULTIPLY_EQUALS . "*=")
- (MULTIPLY . "*")
- (MOD_EQUALS . "%=")
- (MOD . "%")
- (MINUS_EQUALS . "-=")
- (MINUS . "-")
- (LS_EQUAL . "<=")
- (LOGICAL_NOT . "!!")
- (LOGICAL_OR . "||")
- (LOGICAL_AND . "&&")
- (GT_EQUAL . ">=")
- (GREATER_THAN . ">")
- (EQUALS . "==")
- (DIV_EQUALS . "/=")
- (NOT_EQUAL . "!=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS . ">>>=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL . ">>>")
- (BITWISE_SHIFT_RIGHT_EQUALS . ">>=")
- (BITWISE_SHIFT_RIGHT . ">>")
- (BITWISE_SHIFT_LEFT_EQUALS . "<<=")
- (BITWISE_SHIFT_LEFT . "<<")
- (BITWISE_OR_EQUALS . "|=")
- (BITWISE_OR . "|")
- (BITWISE_EXCLUSIVE_OR_EQUALS . "^=")
- (BITWISE_EXCLUSIVE_OR . "^")
- (BITWISE_AND_EQUALS . "&=")
- (BITWISE_AND . "&")
- (ASSIGN_SYMBOL . "=")))
- '(("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("keyword" :declared t)
- ("block" :declared t)
- ("punctuation" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-javascript-jv-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((ASSIGN_SYMBOL BITWISE_AND BITWISE_AND_EQUALS BITWISE_EXCLUSIVE_OR BITWISE_EXCLUSIVE_OR_EQUALS BITWISE_OR BITWISE_OR_EQUALS BITWISE_SHIFT_LEFT BITWISE_SHIFT_LEFT_EQUALS BITWISE_SHIFT_RIGHT BITWISE_SHIFT_RIGHT_EQUALS BITWISE_SHIFT_RIGHT_ZERO_FILL BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS NOT_EQUAL DIV_EQUALS EQUALS GREATER_THAN GT_EQUAL LOGICAL_AND LOGICAL_OR LOGICAL_NOT LS_EQUAL MINUS MINUS_EQUALS MOD MOD_EQUALS MULTIPLY MULTIPLY_EQUALS PLUS PLUS_EQUALS INCREMENT DECREMENT DIV COLON COMMA DOT LESS_THAN LINE_TERMINATOR SEMICOLON ONES_COMPLIMENT PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK OPEN_PARENTHESIS CLOSE_PARENTHESIS START_BLOCK END_BLOCK OPEN_SQ_BRACKETS CLOSE_SQ_BRACKETS IF BREAK CONTINUE ELSE FOR FUNCTION THIS RETURN WHILE VOID_SYMBOL NEW DELETE VAR WITH TYPEOF IN VARIABLE STRING NUMBER FALSE TRUE QUERY NULL_TOKEN)
- ((left PLUS MINUS)
- (left MULTIPLY DIV MOD)
- (nonassoc FALSE)
- (nonassoc HIGHER_THAN_FALSE)
- (nonassoc ELSE)
- (nonassoc LOWER_THAN_CLOSE_PARENTHESIS)
- (nonassoc CLOSE_PARENTHESIS))
- (Program
- ((SourceElement)))
- (SourceElement
- ((Statement))
- ((FunctionDeclaration)))
- (Statement
- ((Block))
- ((VariableStatement))
- ((EmptyStatement))
- ((ExpressionStatement))
- ((IfStatement))
- ((IterationExpression))
- ((ContinueStatement))
- ((BreakStatement))
- ((ReturnStatement))
- ((WithStatement)))
- (FunctionDeclaration
- ((FUNCTION VARIABLE FormalParameterListBlock Block)
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3))))
- (FormalParameterListBlock
- ((PAREN_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'FormalParameterList 1)))
- (FormalParameterList
- ((OPEN_PARENTHESIS)
- nil)
- ((VARIABLE)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil)))
- ((CLOSE_PARENTHESIS)
- nil)
- ((COMMA)
- nil))
- (StatementList
- ((Statement))
- ((StatementList Statement)))
- (Block
- ((BRACE_BLOCK)))
- (BlockExpand
- ((START_BLOCK StatementList END_BLOCK))
- ((START_BLOCK END_BLOCK)))
- (VariableStatement
- ((VAR VariableDeclarationList SEMICOLON)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil))))
- (VariableDeclarationList
- ((VariableDeclaration)
- (list $1))
- ((VariableDeclarationList COMMA VariableDeclaration)
- (append $1
- (list $3))))
- (VariableDeclaration
- ((VARIABLE)
- (append
- (list $1 nil)
- $region))
- ((VARIABLE Initializer)
- (append
- (cons $1 $2)
- $region)))
- (Initializer
- ((ASSIGN_SYMBOL AssignmentExpression)
- (list $2)))
- (EmptyStatement
- ((SEMICOLON)))
- (ExpressionStatement
- ((Expression SEMICOLON)))
- (IfStatement
- ((IF OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)
- [HIGHER_THAN_FALSE])
- ((IF OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement ELSE Statement))
- ((IF OPEN_PARENTHESIS FALSE CLOSE_PARENTHESIS Statement))
- ((IF OPEN_PARENTHESIS LeftHandSideExpression AssignmentOperator AssignmentExpression CLOSE_PARENTHESIS Statement)))
- (IterationExpression
- ((WHILE OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)
- [HIGHER_THAN_FALSE])
- ((WHILE OPEN_PARENTHESIS FALSE CLOSE_PARENTHESIS Statement))
- ((WHILE OPEN_PARENTHESIS LeftHandSideExpression AssignmentOperator AssignmentExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS OptionalExpression SEMICOLON OptionalExpression SEMICOLON OptionalExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS VAR VariableDeclarationList SEMICOLON OptionalExpression SEMICOLON OptionalExpression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS LeftHandSideExpression IN Expression CLOSE_PARENTHESIS Statement))
- ((FOR OPEN_PARENTHESIS VAR VARIABLE OptionalInitializer IN Expression CLOSE_PARENTHESIS Statement)))
- (ContinueStatement
- ((CONTINUE SEMICOLON)))
- (BreakStatement
- ((BREAK SEMICOLON)))
- (ReturnStatement
- ((RETURN Expression SEMICOLON))
- ((RETURN SEMICOLON)))
- (WithStatement
- ((WITH OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS Statement)))
- (OptionalInitializer
- ((Initializer))
- (nil))
- (PrimaryExpression
- ((THIS))
- ((VARIABLE))
- ((NUMBER))
- ((STRING))
- ((NULL_TOKEN))
- ((TRUE))
- ((FALSE))
- ((OPEN_PARENTHESIS Expression CLOSE_PARENTHESIS)))
- (MemberExpression
- ((PrimaryExpression))
- ((MemberExpression OPEN_SQ_BRACKETS Expression CLOSE_SQ_BRACKETS))
- ((MemberExpression DOT VARIABLE))
- ((NEW MemberExpression Arguments)))
- (NewExpression
- ((MemberExpression))
- ((NEW NewExpression)))
- (CallExpression
- ((MemberExpression Arguments))
- ((CallExpression Arguments))
- ((CallExpression OPEN_SQ_BRACKETS Expression CLOSE_SQ_BRACKETS))
- ((CallExpression DOT VARIABLE)))
- (Arguments
- ((OPEN_PARENTHESIS CLOSE_PARENTHESIS))
- ((OPEN_PARENTHESIS ArgumentList CLOSE_PARENTHESIS)))
- (ArgumentList
- ((AssignmentExpression))
- ((ArgumentList COMMA AssignmentExpression)))
- (LeftHandSideExpression
- ((NewExpression))
- ((CallExpression)))
- (PostfixExpression
- ((LeftHandSideExpression))
- ((LeftHandSideExpression INCREMENT))
- ((LeftHandSideExpression DECREMENT)))
- (UnaryExpression
- ((PostfixExpression))
- ((DELETE UnaryExpression))
- ((VOID_SYMBOL UnaryExpression))
- ((TYPEOF UnaryExpression))
- ((INCREMENT UnaryExpression))
- ((DECREMENT UnaryExpression))
- ((PLUS UnaryExpression))
- ((MINUS UnaryExpression))
- ((ONES_COMPLIMENT UnaryExpression))
- ((LOGICAL_NOT UnaryExpression)))
- (MultiplicativeExpression
- ((UnaryExpression))
- ((MultiplicativeExpression MULTIPLY UnaryExpression))
- ((MultiplicativeExpression DIV UnaryExpression))
- ((MultiplicativeExpression MOD UnaryExpression)))
- (AdditiveExpression
- ((MultiplicativeExpression))
- ((AdditiveExpression PLUS MultiplicativeExpression))
- ((AdditiveExpression MINUS MultiplicativeExpression)))
- (ShiftExpression
- ((AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_LEFT AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_RIGHT AdditiveExpression))
- ((ShiftExpression BITWISE_SHIFT_RIGHT_ZERO_FILL AdditiveExpression)))
- (RelationalExpression
- ((ShiftExpression))
- ((RelationalExpression LESS_THAN ShiftExpression))
- ((RelationalExpression GREATER_THAN ShiftExpression))
- ((RelationalExpression LS_EQUAL ShiftExpression))
- ((RelationalExpression GT_EQUAL ShiftExpression)))
- (EqualityExpression
- ((RelationalExpression))
- ((EqualityExpression EQUALS RelationalExpression))
- ((EqualityExpression NOT_EQUAL RelationalExpression)))
- (BitwiseANDExpression
- ((EqualityExpression))
- ((BitwiseANDExpression BITWISE_AND EqualityExpression)))
- (BitwiseXORExpression
- ((BitwiseANDExpression))
- ((BitwiseXORExpression BITWISE_EXCLUSIVE_OR BitwiseANDExpression)))
- (BitwiseORExpression
- ((BitwiseXORExpression))
- ((BitwiseORExpression BITWISE_OR BitwiseXORExpression)))
- (LogicalANDExpression
- ((BitwiseORExpression))
- ((LogicalANDExpression LOGICAL_AND BitwiseORExpression)))
- (LogicalORExpression
- ((LogicalANDExpression))
- ((LogicalORExpression LOGICAL_OR LogicalANDExpression)))
- (ConditionalExpression
- ((LogicalORExpression))
- ((LogicalORExpression QUERY AssignmentExpression COLON AssignmentExpression)))
- (AssignmentExpression
- ((ConditionalExpression))
- ((LeftHandSideExpression AssignmentOperator AssignmentExpression)
- [LOWER_THAN_CLOSE_PARENTHESIS]))
- (AssignmentOperator
- ((ASSIGN_SYMBOL))
- ((MULTIPLY_EQUALS))
- ((DIV_EQUALS))
- ((MOD_EQUALS))
- ((PLUS_EQUALS))
- ((MINUS_EQUALS))
- ((BITWISE_SHIFT_LEFT_EQUALS))
- ((BITWISE_SHIFT_RIGHT_EQUALS))
- ((BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS))
- ((BITWISE_AND_EQUALS))
- ((BITWISE_EXCLUSIVE_OR_EQUALS))
- ((BITWISE_OR_EQUALS)))
- (Expression
- ((AssignmentExpression))
- ((Expression COMMA AssignmentExpression)))
- (OptionalExpression
- ((Expression))
- (nil)))
- '(Program FormalParameterList)))
- "Parser table.")
-
-(defun wisent-javascript-jv-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-javascript-jv-wy--parse-table
- semantic-debug-parser-source "js.wy"
- semantic-flex-keywords-obarray wisent-javascript-jv-wy--keyword-table
- semantic-lex-types-obarray wisent-javascript-jv-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-javascript-jv-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" OPEN_PARENTHESIS PAREN_BLOCK)
- ("{" START_BLOCK BRACE_BLOCK)
- ("[" OPEN_SQ_BRACKETS BRACK_BLOCK))
- (")" CLOSE_PARENTHESIS)
- ("}" END_BLOCK)
- ("]" CLOSE_SQ_BRACKETS))
- )
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'VARIABLE)
-
-(define-lex-regex-type-analyzer wisent-javascript-jv-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER)
-
-(define-lex-string-type-analyzer wisent-javascript-jv-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((ONES_COMPLIMENT . "~")
- (SEMICOLON . ";")
- (LINE_TERMINATOR . "\n")
- (LESS_THAN . "<")
- (DOT . ".")
- (COMMA . ",")
- (COLON . ":")
- (DIV . "/")
- (DECREMENT . "--")
- (INCREMENT . "++")
- (PLUS_EQUALS . "+=")
- (PLUS . "+")
- (MULTIPLY_EQUALS . "*=")
- (MULTIPLY . "*")
- (MOD_EQUALS . "%=")
- (MOD . "%")
- (MINUS_EQUALS . "-=")
- (MINUS . "-")
- (LS_EQUAL . "<=")
- (LOGICAL_NOT . "!!")
- (LOGICAL_OR . "||")
- (LOGICAL_AND . "&&")
- (GT_EQUAL . ">=")
- (GREATER_THAN . ">")
- (EQUALS . "==")
- (DIV_EQUALS . "/=")
- (NOT_EQUAL . "!=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL_EQUALS . ">>>=")
- (BITWISE_SHIFT_RIGHT_ZERO_FILL . ">>>")
- (BITWISE_SHIFT_RIGHT_EQUALS . ">>=")
- (BITWISE_SHIFT_RIGHT . ">>")
- (BITWISE_SHIFT_LEFT_EQUALS . "<<=")
- (BITWISE_SHIFT_LEFT . "<<")
- (BITWISE_OR_EQUALS . "|=")
- (BITWISE_OR . "|")
- (BITWISE_EXCLUSIVE_OR_EQUALS . "^=")
- (BITWISE_EXCLUSIVE_OR . "^")
- (BITWISE_AND_EQUALS . "&=")
- (BITWISE_AND . "&")
- (ASSIGN_SYMBOL . "="))
- 'punctuation)
-
-(define-lex-sexp-type-analyzer wisent-javascript-jv-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'STRING)
-
-(define-lex-keyword-type-analyzer wisent-javascript-jv-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-;;here something like:
-;;(define-lex wisent-java-tags-lexer
-;; should go
-(define-lex javascript-lexer-jv
-"javascript thingy"
-;;std stuff
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
-
- ;;stuff generated from the wy file(one for each "type" declaration)
- wisent-javascript-jv-wy--<number>-regexp-analyzer
- wisent-javascript-jv-wy--<string>-sexp-analyzer
-
- wisent-javascript-jv-wy--<keyword>-keyword-analyzer
-
- wisent-javascript-jv-wy--<symbol>-regexp-analyzer
- wisent-javascript-jv-wy--<punctuation>-string-analyzer
- wisent-javascript-jv-wy--<block>-block-analyzer
-
-
- ;;;;more std stuff
- semantic-lex-default-action
- )
-
-(provide 'semantic/wisent/js-wy)
-
-;;; semantic/wisent/js-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/python-wy.el b/lisp/cedet/semantic/wisent/python-wy.el
deleted file mode 100644
index bfa96ff1a88..00000000000
--- a/lisp/cedet/semantic/wisent/python-wy.el
+++ /dev/null
@@ -1,847 +0,0 @@
-;;; semantic/wisent/python-wy.el --- Generated parser support file
-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
-;; Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Python Software Foundation; All Rights Reserved
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/python.wy.
-;; It is derived in part from the Python grammar, used under the
-;; following license:
-;;
-;; PYTHON SOFTWARE FOUNDATION LICENSE VERSION 2
-;; --------------------------------------------
-;; 1. This LICENSE AGREEMENT is between the Python Software Foundation
-;; ("PSF"), and the Individual or Organization ("Licensee") accessing
-;; and otherwise using this software ("Python") in source or binary
-;; form and its associated documentation.
-;;
-;; 2. Subject to the terms and conditions of this License Agreement,
-;; PSF hereby grants Licensee a nonexclusive, royalty-free, world-wide
-;; license to reproduce, analyze, test, perform and/or display
-;; publicly, prepare derivative works, distribute, and otherwise use
-;; Python alone or in any derivative version, provided, however, that
-;; PSF's License Agreement and PSF's notice of copyright, i.e.,
-;; "Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010 Python Software Foundation; All Rights Reserved" are
-;; retained in Python alone or in any derivative version prepared by
-;; Licensee.
-;;
-;; 3. In the event Licensee prepares a derivative work that is based
-;; on or incorporates Python or any part thereof, and wants to make
-;; the derivative work available to others as provided herein, then
-;; Licensee hereby agrees to include in any such work a brief summary
-;; of the changes made to Python.
-;;
-;; 4. PSF is making Python available to Licensee on an "AS IS"
-;; basis. PSF MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR
-;; IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PSF MAKES NO AND
-;; DISCLAIMS ANY REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS
-;; FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF PYTHON WILL NOT
-;; INFRINGE ANY THIRD PARTY RIGHTS.
-;;
-;; 5. PSF SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PYTHON
-;; FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
-;; RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PYTHON, OR
-;; ANY DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
-;;
-;; 6. This License Agreement will automatically terminate upon a
-;; material breach of its terms and conditions.
-;;
-;; 7. Nothing in this License Agreement shall be deemed to create any
-;; relationship of agency, partnership, or joint venture between PSF
-;; and Licensee. This License Agreement does not grant permission to
-;; use PSF trademarks or trade name in a trademark sense to endorse or
-;; promote products or services of Licensee, or any third party.
-;;
-;; 8. By copying, installing or otherwise using Python, Licensee
-;; agrees to be bound by the terms and conditions of this License
-;; Agreement.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-(declare-function wisent-python-reconstitute-function-tag
- "semantic/wisent/python" (tag suite))
-(declare-function wisent-python-reconstitute-class-tag "semantic/wisent/python"
- (tag))
-(declare-function semantic-parse-region "semantic"
- (start end &optional nonterminal depth returnonerror))
-
-;;; Declarations
-;;
-(defconst wisent-python-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("and" . AND)
- ("as" . AS)
- ("assert" . ASSERT)
- ("break" . BREAK)
- ("class" . CLASS)
- ("continue" . CONTINUE)
- ("def" . DEF)
- ("del" . DEL)
- ("elif" . ELIF)
- ("else" . ELSE)
- ("except" . EXCEPT)
- ("exec" . EXEC)
- ("finally" . FINALLY)
- ("for" . FOR)
- ("from" . FROM)
- ("global" . GLOBAL)
- ("if" . IF)
- ("import" . IMPORT)
- ("in" . IN)
- ("is" . IS)
- ("lambda" . LAMBDA)
- ("not" . NOT)
- ("or" . OR)
- ("pass" . PASS)
- ("print" . PRINT)
- ("raise" . RAISE)
- ("return" . RETURN)
- ("try" . TRY)
- ("while" . WHILE)
- ("with" . WITH)
- ("yield" . YIELD))
- '(("yield" summary "Create a generator function")
- ("with" summary "Start statement with an associated context object")
- ("while" summary "Start a 'while' loop")
- ("try" summary "Start of statements protected by exception handlers")
- ("return" summary "Return from a function")
- ("raise" summary "Raise an exception")
- ("print" summary "Print each argument to standard output")
- ("pass" summary "Statement that does nothing")
- ("or" summary "Binary logical 'or' operator")
- ("not" summary "Unary boolean negation operator")
- ("lambda" summary "Create anonymous function")
- ("is" summary "Binary operator that tests for object equality")
- ("in" summary "Part of 'for' statement ")
- ("import" summary "Load specified modules")
- ("if" summary "Start 'if' conditional statement")
- ("global" summary "Declare one or more symbols as global symbols")
- ("from" summary "Modify behavior of 'import' statement")
- ("for" summary "Start a 'for' loop")
- ("finally" summary "Specify code to be executed after 'try' statements whether or not an exception occurred")
- ("exec" summary "Dynamically execute Python code")
- ("except" summary "Specify exception handlers along with 'try' keyword")
- ("else" summary "Start the 'else' clause following an 'if' statement")
- ("elif" summary "Shorthand for 'else if' following an 'if' statement")
- ("del" summary "Delete specified objects, i.e., undo what assignment did")
- ("def" summary "Define a new function")
- ("continue" summary "Skip to the next iteration of enclosing 'for' or 'while' loop")
- ("class" summary "Define a new class")
- ("break" summary "Terminate 'for' or 'while' loop")
- ("assert" summary "Raise AssertionError exception if <expr> is false")
- ("as" summary "EXPR as NAME makes value of EXPR available as variable NAME")
- ("and" summary "Logical AND binary operator ... ")))
- "Table of language keywords.")
-
-(defconst wisent-python-wy--token-table
- (semantic-lex-make-type-table
- '(("symbol"
- (NAME))
- ("number"
- (NUMBER_LITERAL))
- ("string"
- (STRING_LITERAL))
- ("punctuation"
- (AT . "@")
- (BACKQUOTE . "`")
- (ASSIGN . "=")
- (COMMA . ",")
- (SEMICOLON . ";")
- (COLON . ":")
- (BAR . "|")
- (TILDE . "~")
- (PERIOD . ".")
- (MINUS . "-")
- (PLUS . "+")
- (MOD . "%")
- (DIV . "/")
- (MULT . "*")
- (AMP . "&")
- (GT . ">")
- (LT . "<")
- (HAT . "^")
- (NE . "!=")
- (LTGT . "<>")
- (HATEQ . "^=")
- (OREQ . "|=")
- (AMPEQ . "&=")
- (MODEQ . "%=")
- (DIVEQ . "/=")
- (MULTEQ . "*=")
- (MINUSEQ . "-=")
- (PLUSEQ . "+=")
- (LE . "<=")
- (GE . ">=")
- (EQ . "==")
- (EXPONENT . "**")
- (GTGT . ">>")
- (LTLT . "<<")
- (DIVDIV . "//")
- (DIVDIVEQ . "//=")
- (EXPEQ . "**=")
- (GTGTEQ . ">>=")
- (LTLTEQ . "<<="))
- ("close-paren"
- (RBRACK . "]")
- (RBRACE . "}")
- (RPAREN . ")"))
- ("open-paren"
- (LBRACK . "[")
- (LBRACE . "{")
- (LPAREN . "("))
- ("block"
- (BRACK_BLOCK . "(LBRACK RBRACK)")
- (BRACE_BLOCK . "(LBRACE RBRACE)")
- (PAREN_BLOCK . "(LPAREN RPAREN)"))
- ("indentation"
- (INDENT_BLOCK . "(INDENT DEDENT)")
- (DEDENT . "[^:INDENT:]")
- (INDENT . "^\\s-+"))
- ("newline"
- (NEWLINE . "\n"))
- ("charquote"
- (BACKSLASH . "\\")))
- '(("keyword" :declared t)
- ("symbol" :declared t)
- ("number" :declared t)
- ("punctuation" :declared t)
- ("block" :declared t)))
- "Table of lexical tokens.")
-
-(defconst wisent-python-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE AT STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE WITH YIELD)
- nil
- (goal
- ((NEWLINE))
- ((simple_stmt))
- ((compound_stmt)))
- (simple_stmt
- ((small_stmt_list semicolon_opt NEWLINE)))
- (small_stmt_list
- ((small_stmt))
- ((small_stmt_list SEMICOLON small_stmt)))
- (small_stmt
- ((expr_stmt))
- ((print_stmt))
- ((del_stmt))
- ((pass_stmt))
- ((flow_stmt))
- ((import_stmt))
- ((global_stmt))
- ((exec_stmt))
- ((assert_stmt)))
- (print_stmt
- ((PRINT print_stmt_trailer)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (print_stmt_trailer
- ((test_list_opt)
- nil)
- ((GTGT test trailing_test_list_with_opt_comma_opt)
- nil))
- (trailing_test_list_with_opt_comma_opt
- (nil)
- ((trailing_test_list comma_opt)
- nil))
- (trailing_test_list
- ((COMMA test)
- nil)
- ((trailing_test_list COMMA test)
- nil))
- (expr_stmt
- ((testlist expr_stmt_trailer)
- (if
- (and $2
- (stringp $1)
- (string-match "^\\(\\sw\\|\\s_\\)+$" $1))
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))))
- (expr_stmt_trailer
- ((augassign testlist))
- ((eq_testlist_zom)))
- (eq_testlist_zom
- (nil)
- ((eq_testlist_zom ASSIGN testlist)
- (identity $3)))
- (augassign
- ((PLUSEQ))
- ((MINUSEQ))
- ((MULTEQ))
- ((DIVEQ))
- ((MODEQ))
- ((AMPEQ))
- ((OREQ))
- ((HATEQ))
- ((LTLTEQ))
- ((GTGTEQ))
- ((EXPEQ))
- ((DIVDIVEQ)))
- (del_stmt
- ((DEL exprlist)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (exprlist
- ((expr_list comma_opt)
- nil))
- (expr_list
- ((expr)
- nil)
- ((expr_list COMMA expr)
- nil))
- (pass_stmt
- ((PASS)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (flow_stmt
- ((break_stmt))
- ((continue_stmt))
- ((return_stmt))
- ((raise_stmt))
- ((yield_stmt)))
- (break_stmt
- ((BREAK)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (continue_stmt
- ((CONTINUE)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (return_stmt
- ((RETURN testlist_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (testlist_opt
- (nil)
- ((testlist)
- nil))
- (yield_stmt
- ((YIELD)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((YIELD testlist)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (raise_stmt
- ((RAISE zero_one_two_or_three_tests)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (zero_one_two_or_three_tests
- (nil)
- ((test zero_one_or_two_tests)
- nil))
- (zero_one_or_two_tests
- (nil)
- ((COMMA test zero_or_one_comma_test)
- nil))
- (zero_or_one_comma_test
- (nil)
- ((COMMA test)
- nil))
- (import_stmt
- ((IMPORT dotted_as_name_list)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil)))
- ((FROM dotted_name IMPORT star_or_import_as_name_list)
- (wisent-raw-tag
- (semantic-tag-new-include $2 nil))))
- (dotted_as_name_list
- ((dotted_as_name_list COMMA dotted_as_name)
- (cons $3 $1))
- ((dotted_as_name)
- (list $1)))
- (star_or_import_as_name_list
- ((MULT)
- nil)
- ((import_as_name_list)
- nil))
- (import_as_name_list
- ((import_as_name)
- nil)
- ((import_as_name_list COMMA import_as_name)
- nil))
- (import_as_name
- ((NAME as_name_opt)
- nil))
- (dotted_as_name
- ((dotted_name as_name_opt)))
- (as_name_opt
- (nil)
- ((AS NAME)
- (identity $2)))
- (dotted_name
- ((NAME))
- ((dotted_name PERIOD NAME)
- (format "%s.%s" $1 $3)))
- (global_stmt
- ((GLOBAL comma_sep_name_list)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (comma_sep_name_list
- ((NAME))
- ((comma_sep_name_list COMMA NAME)))
- (exec_stmt
- ((EXEC expr exec_trailer)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (exec_trailer
- (nil)
- ((IN test comma_test_opt)
- nil))
- (comma_test_opt
- (nil)
- ((COMMA test)
- nil))
- (assert_stmt
- ((ASSERT test comma_test_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (compound_stmt
- ((if_stmt))
- ((while_stmt))
- ((for_stmt))
- ((try_stmt))
- ((with_stmt))
- ((funcdef))
- ((class_declaration)))
- (if_stmt
- ((IF test COLON suite elif_suite_pair_list else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (elif_suite_pair_list
- (nil)
- ((elif_suite_pair_list ELIF test COLON suite)
- nil))
- (else_suite_pair_opt
- (nil)
- ((ELSE COLON suite)
- nil))
- (suite
- ((simple_stmt)
- (list $1))
- ((NEWLINE indented_block)
- (progn $2)))
- (indented_block
- ((INDENT_BLOCK)
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'indented_block_body 1)))
- (indented_block_body
- ((INDENT)
- nil)
- ((DEDENT)
- nil)
- ((simple_stmt))
- ((compound_stmt)))
- (while_stmt
- ((WHILE test COLON suite else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (for_stmt
- ((FOR exprlist IN testlist COLON suite else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (try_stmt
- ((TRY COLON suite except_clause_suite_pair_list else_suite_pair_opt)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((TRY COLON suite FINALLY COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (except_clause_suite_pair_list
- ((except_clause COLON suite)
- nil)
- ((except_clause_suite_pair_list except_clause COLON suite)
- nil))
- (except_clause
- ((EXCEPT zero_one_or_two_test)
- nil))
- (zero_one_or_two_test
- (nil)
- ((test zero_or_one_comma_test)
- nil))
- (with_stmt
- ((WITH test COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil)))
- ((WITH test with_var COLON suite)
- (wisent-raw-tag
- (semantic-tag-new-code $1 nil))))
- (with_var
- ((AS expr)
- nil))
- (decorator
- ((AT dotted_name varargslist_opt NEWLINE)
- (wisent-raw-tag
- (semantic-tag-new-function $2 "decorator" $3))))
- (decorators
- ((decorator)
- (list $1))
- ((decorator decorators)
- (cons $1 $2)))
- (funcdef
- ((DEF NAME function_parameter_list COLON suite)
- (wisent-python-reconstitute-function-tag
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3))
- $5))
- ((decorators DEF NAME function_parameter_list COLON suite)
- (wisent-python-reconstitute-function-tag
- (wisent-raw-tag
- (semantic-tag-new-function $3 nil $4 :decorators $1))
- $6)))
- (function_parameter_list
- ((PAREN_BLOCK)
- (let
- ((wisent-python-EXPANDING-block t))
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'function_parameters 1))))
- (function_parameters
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((function_parameter COMMA))
- ((function_parameter RPAREN)))
- (function_parameter
- ((fpdef_opt_test))
- ((MULT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil)))
- ((EXPONENT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil nil))))
- (class_declaration
- ((CLASS NAME paren_class_list_opt COLON suite)
- (wisent-python-reconstitute-class-tag
- (wisent-raw-tag
- (semantic-tag-new-type $2 $1 $5
- (cons $3 nil))))))
- (paren_class_list_opt
- (nil)
- ((paren_class_list)))
- (paren_class_list
- ((PAREN_BLOCK)
- (let
- ((wisent-python-EXPANDING-block t))
- (mapcar 'semantic-tag-name
- (semantic-parse-region
- (car $region1)
- (cdr $region1)
- 'paren_classes 1)))))
- (paren_classes
- ((LPAREN)
- nil)
- ((RPAREN)
- nil)
- ((paren_class COMMA)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil)))
- ((paren_class RPAREN)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))))
- (paren_class
- ((dotted_name)))
- (test
- ((test_test))
- ((lambdef)))
- (test_test
- ((and_test))
- ((test_test OR and_test)
- nil))
- (and_test
- ((not_test))
- ((and_test AND not_test)
- nil))
- (not_test
- ((NOT not_test)
- nil)
- ((comparison)))
- (comparison
- ((expr))
- ((comparison comp_op expr)
- nil))
- (comp_op
- ((LT))
- ((GT))
- ((EQ))
- ((GE))
- ((LE))
- ((LTGT))
- ((NE))
- ((IN))
- ((NOT IN))
- ((IS))
- ((IS NOT)))
- (expr
- ((xor_expr))
- ((expr BAR xor_expr)
- nil))
- (xor_expr
- ((and_expr))
- ((xor_expr HAT and_expr)
- nil))
- (and_expr
- ((shift_expr))
- ((and_expr AMP shift_expr)
- nil))
- (shift_expr
- ((arith_expr))
- ((shift_expr shift_expr_operators arith_expr)
- nil))
- (shift_expr_operators
- ((LTLT))
- ((GTGT)))
- (arith_expr
- ((term))
- ((arith_expr plus_or_minus term)
- nil))
- (plus_or_minus
- ((PLUS))
- ((MINUS)))
- (term
- ((factor))
- ((term term_operator factor)
- nil))
- (term_operator
- ((MULT))
- ((DIV))
- ((MOD))
- ((DIVDIV)))
- (factor
- ((prefix_operators factor)
- nil)
- ((power)))
- (prefix_operators
- ((PLUS))
- ((MINUS))
- ((TILDE)))
- (power
- ((atom trailer_zom exponent_zom)
- (concat $1
- (if $2
- (concat " " $2 " ")
- "")
- (if $3
- (concat " " $3)
- ""))))
- (trailer_zom
- (nil)
- ((trailer_zom trailer)
- nil))
- (exponent_zom
- (nil)
- ((exponent_zom EXPONENT factor)
- nil))
- (trailer
- ((PAREN_BLOCK)
- nil)
- ((BRACK_BLOCK)
- nil)
- ((PERIOD NAME)
- nil))
- (atom
- ((PAREN_BLOCK)
- nil)
- ((BRACK_BLOCK)
- nil)
- ((BRACE_BLOCK)
- nil)
- ((BACKQUOTE testlist BACKQUOTE)
- nil)
- ((NAME))
- ((NUMBER_LITERAL))
- ((one_or_more_string)))
- (test_list_opt
- (nil)
- ((testlist)
- nil))
- (testlist
- ((comma_sep_test_list comma_opt)))
- (comma_sep_test_list
- ((test))
- ((comma_sep_test_list COMMA test)
- (format "%s, %s" $1 $3)))
- (one_or_more_string
- ((STRING_LITERAL))
- ((one_or_more_string STRING_LITERAL)
- (concat $1 $2)))
- (lambdef
- ((LAMBDA varargslist_opt COLON test)
- (format "%s %s" $1
- (or $2 ""))))
- (varargslist_opt
- (nil)
- ((varargslist)))
- (varargslist
- ((fpdef_opt_test_list_comma_zom rest_args)
- (nconc $2 $1))
- ((fpdef_opt_test_list comma_opt)))
- (rest_args
- ((MULT NAME multmult_name_opt)
- nil)
- ((EXPONENT NAME)
- nil))
- (multmult_name_opt
- (nil)
- ((COMMA EXPONENT NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $3 nil nil))))
- (fpdef_opt_test_list_comma_zom
- (nil)
- ((fpdef_opt_test_list_comma_zom fpdef_opt_test COMMA)
- (nconc $2 $1)))
- (fpdef_opt_test_list
- ((fpdef_opt_test))
- ((fpdef_opt_test_list COMMA fpdef_opt_test)
- (nconc $3 $1)))
- (fpdef_opt_test
- ((fpdef eq_test_opt)))
- (fpdef
- ((NAME)
- (wisent-raw-tag
- (semantic-tag-new-variable $1 nil nil))))
- (fplist
- ((fpdef_list comma_opt)))
- (fpdef_list
- ((fpdef))
- ((fpdef_list COMMA fpdef)))
- (eq_test_opt
- (nil)
- ((ASSIGN test)
- nil))
- (comma_opt
- (nil)
- ((COMMA)))
- (semicolon_opt
- (nil)
- ((SEMICOLON))))
- '(goal function_parameter paren_class indented_block function_parameters paren_classes indented_block_body)))
- "Parser table.")
-
-(defun wisent-python-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table wisent-python-wy--parse-table
- semantic-debug-parser-source "python.wy"
- semantic-flex-keywords-obarray wisent-python-wy--keyword-table
- semantic-lex-types-obarray wisent-python-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-block-type-analyzer wisent-python-wy--<block>-block-analyzer
- "block analyzer for <block> tokens."
- "\\s(\\|\\s)"
- '((("(" LPAREN PAREN_BLOCK)
- ("{" LBRACE BRACE_BLOCK)
- ("[" LBRACK BRACK_BLOCK))
- (")" RPAREN)
- ("}" RBRACE)
- ("]" RBRACK))
- )
-
-(define-lex-regex-type-analyzer wisent-python-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'NAME)
-
-(define-lex-regex-type-analyzer wisent-python-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'NUMBER_LITERAL)
-
-(define-lex-string-type-analyzer wisent-python-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\(\\s.\\|\\s$\\|\\s'\\)+"
- '((AT . "@")
- (BACKQUOTE . "`")
- (ASSIGN . "=")
- (COMMA . ",")
- (SEMICOLON . ";")
- (COLON . ":")
- (BAR . "|")
- (TILDE . "~")
- (PERIOD . ".")
- (MINUS . "-")
- (PLUS . "+")
- (MOD . "%")
- (DIV . "/")
- (MULT . "*")
- (AMP . "&")
- (GT . ">")
- (LT . "<")
- (HAT . "^")
- (NE . "!=")
- (LTGT . "<>")
- (HATEQ . "^=")
- (OREQ . "|=")
- (AMPEQ . "&=")
- (MODEQ . "%=")
- (DIVEQ . "/=")
- (MULTEQ . "*=")
- (MINUSEQ . "-=")
- (PLUSEQ . "+=")
- (LE . "<=")
- (GE . ">=")
- (EQ . "==")
- (EXPONENT . "**")
- (GTGT . ">>")
- (LTLT . "<<")
- (DIVDIV . "//")
- (DIVDIVEQ . "//=")
- (EXPEQ . "**=")
- (GTGTEQ . ">>=")
- (LTLTEQ . "<<="))
- 'punctuation)
-
-(define-lex-keyword-type-analyzer wisent-python-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-
-(provide 'semantic/wisent/python-wy)
-
-;;; semantic/wisent/python-wy.el ends here
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 2c0ed5868ce..2dc3dd3c2ad 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -1,6 +1,6 @@
;;; wisent-python.el --- Semantic support for Python
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Richard Kim <emacs18@gmail.com>
;; Maintainer: Richard Kim <emacs18@gmail.com>
@@ -130,7 +130,7 @@ curly braces."
(defun wisent-python-forward-balanced-expression ()
"Move point to the end of the balanced expression at point.
-Here 'balanced expression' means anything matched by Emacs'
+Here “balanced expression” means anything matched by Emacs's
open/close parenthesis syntax classes. We can't use forward-sexp
for this because that Emacs built-in can't parse Python's
triple-quoted string syntax."
@@ -490,7 +490,7 @@ Return nil if there is nothing relevant."
;;
(define-mode-local-override semantic-format-tag-abbreviate python-mode (tag &optional parent color)
"Format an abbreviated tag for python.
-Shortens 'code' tags, but passes through for others."
+Shortens `code' tags, but passes through for others."
(cond ((semantic-tag-of-class-p tag 'code)
;; Just take the first line.
(let ((name (semantic-tag-name tag)))
@@ -534,9 +534,6 @@ Shortens 'code' tags, but passes through for others."
(code . "Code")))
)
-;;;###autoload
-(add-hook 'python-mode-hook 'wisent-python-default-setup)
-
;; Make sure the newer python modes pull in the same python
;; mode overrides.
(define-child-mode python-2-mode python-mode "Python 2 mode")
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index 8a3318cd00f..4c5274198dd 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -1,6 +1,6 @@
;;; semantic/wisent/wisent.el --- GNU Bison for Emacs - Runtime
-;;; Copyright (C) 2002-2007, 2009-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2002-2007, 2009-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -44,11 +44,11 @@
"
/\\_.-^^^-._/\\ The GNU
\\_ _/
- ( `o ` (European ;-) Bison
- \\ ` /
+ ( \\=`o \\=` (European ;-) Bison
+ \\ \\=` /
( D ,\" for Emacs!
- ` ~ ,\"
- `\"\""
+ \\=` ~ ,\"
+ \\=`\"\""
:group 'semantic)
@@ -364,7 +364,7 @@ automaton has only one entry point."
- START specify the start symbol (nonterminal) used by the parser as
its goal. It defaults to the start symbol defined in the grammar
- \(see also `wisent-compile-grammar')."
+ (see also `wisent-compile-grammar')."
(run-hooks 'wisent-pre-parse-hook)
(let* ((actions (aref automaton 0))
(gotos (aref automaton 1))
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index 2e2cb8a3f80..c4f2c674af5 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -1,6 +1,6 @@
;;; srecode.el --- Semantic buffer evaluator.
-;;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el
index 6bc78295fa7..2cb2396092a 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -1,6 +1,6 @@
;;; srecode/args.el --- Provide some simple template arguments
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -101,35 +101,35 @@ do not contain any text from preceding or following text."
(defun srecode-semantic-handle-:time (dict)
"Add macros into the dictionary DICT based on the current :time."
;; DATE Values
- (srecode-dictionary-set-value
- dict "YEAR" (format-time-string "%Y" (current-time)))
- (srecode-dictionary-set-value
- dict "MONTHNAME" (format-time-string "%B" (current-time)))
- (srecode-dictionary-set-value
- dict "MONTH" (format-time-string "%m" (current-time)))
- (srecode-dictionary-set-value
- dict "DAY" (format-time-string "%d" (current-time)))
- (srecode-dictionary-set-value
- dict "WEEKDAY" (format-time-string "%a" (current-time)))
- ;; Time Values
- (srecode-dictionary-set-value
- dict "HOUR" (format-time-string "%H" (current-time)))
- (srecode-dictionary-set-value
- dict "HOUR12" (format-time-string "%l" (current-time)))
- (srecode-dictionary-set-value
- dict "AMPM" (format-time-string "%p" (current-time)))
- (srecode-dictionary-set-value
- dict "MINUTE" (format-time-string "%M" (current-time)))
- (srecode-dictionary-set-value
- dict "SECOND" (format-time-string "%S" (current-time)))
- (srecode-dictionary-set-value
- dict "TIMEZONE" (format-time-string "%Z" (current-time)))
- ;; Convenience pre-packed date/time
- (srecode-dictionary-set-value
- dict "DATE" (format-time-string "%D" (current-time)))
- (srecode-dictionary-set-value
- dict "TIME" (format-time-string "%X" (current-time)))
- )
+ (let ((now (current-time)))
+ (srecode-dictionary-set-value
+ dict "YEAR" (format-time-string "%Y" now))
+ (srecode-dictionary-set-value
+ dict "MONTHNAME" (format-time-string "%B" now))
+ (srecode-dictionary-set-value
+ dict "MONTH" (format-time-string "%m" now))
+ (srecode-dictionary-set-value
+ dict "DAY" (format-time-string "%d" now))
+ (srecode-dictionary-set-value
+ dict "WEEKDAY" (format-time-string "%a" now))
+ ;; Time Values
+ (srecode-dictionary-set-value
+ dict "HOUR" (format-time-string "%H" now))
+ (srecode-dictionary-set-value
+ dict "HOUR12" (format-time-string "%l" now))
+ (srecode-dictionary-set-value
+ dict "AMPM" (format-time-string "%p" now))
+ (srecode-dictionary-set-value
+ dict "MINUTE" (format-time-string "%M" now))
+ (srecode-dictionary-set-value
+ dict "SECOND" (format-time-string "%S" now))
+ (srecode-dictionary-set-value
+ dict "TIMEZONE" (format-time-string "%Z" now))
+ ;; Convenience pre-packed date/time
+ (srecode-dictionary-set-value
+ dict "DATE" (format-time-string "%D" now))
+ (srecode-dictionary-set-value
+ dict "TIME" (format-time-string "%X" now))))
;;; :file ARGUMENT HANDLING
;;
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 542fd49f8e5..c6b3b53f24d 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -1,6 +1,6 @@
;;; srecode/compile --- Compilation of srecode template files.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: codegeneration
@@ -34,6 +34,7 @@
(eval-when-compile (require 'cl))
(require 'semantic)
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'srecode/table)
(require 'srecode/dictionary)
@@ -74,7 +75,7 @@ any incoming dictionaries values.")
:initform nil
:documentation
"During template insertion, this is the stack of active templates.
-The top-most template is the 'active' template. Use the accessor methods
+The top-most template is the `active' template. Use the accessor methods
for push, pop, and peek for the active template.")
(table :initarg :table
:documentation
@@ -87,10 +88,10 @@ for push, pop, and peek for the active template.")
Useful if something goes wrong in SRecode, and the active template
stack is broken."
(interactive)
- (if (oref srecode-template active)
+ (if (oref-default 'srecode-template active)
(when (y-or-n-p (format "%d active templates. Flush? "
- (length (oref srecode-template active))))
- (oset-default srecode-template active nil))
+ (length (oref-default 'srecode-template active))))
+ (oset-default 'srecode-template active nil))
(message "No active templates to flush."))
)
@@ -115,23 +116,23 @@ additional static argument data."))
Plain text strings are not handled via this baseclass."
:abstract t)
-(defmethod srecode-parse-input ((ins srecode-template-inserter)
- tag input STATE)
+(cl-defmethod srecode-parse-input ((_ins srecode-template-inserter)
+ _tag input _STATE)
"For the template inserter INS, parse INPUT.
Shorten input only by the amount needed.
Return the remains of INPUT.
STATE is the current compilation state."
input)
-(defmethod srecode-match-end ((ins srecode-template-inserter) name)
+(cl-defmethod srecode-match-end ((_ins srecode-template-inserter) _name)
"For the template inserter INS, do I end a section called NAME?"
nil)
-(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter) STATE)
+(cl-defmethod srecode-inserter-apply-state ((_ins srecode-template-inserter) _STATE)
"For the template inserter INS, apply information from STATE."
nil)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-prin-example ((ins (subclass srecode-template-inserter))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -158,7 +159,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
"Current state of the compile.")
-(defmethod srecode-compile-add-prompt ((state srecode-compile-state)
+(cl-defmethod srecode-compile-add-prompt ((state srecode-compile-state)
prompttag)
"Add PROMPTTAG to the current list of prompts."
(with-slots (prompts) state
@@ -289,7 +290,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
)
;; Continue
(setq tags (cdr tags)))
-
+
;; MSG - Before install since nreverse whacks our list.
(when (called-interactively-p 'interactive)
(message "%d templates compiled for %s"
@@ -414,7 +415,7 @@ If END-NAME is specified, and the input string"
(match-end 0)))
(namestart (match-end 0))
(junk (string-match regexend what namestart))
- end tail name key)
+ end tail name)
;; Add string to compiled output
(when (> (length prefix) 0)
(setq comp (cons prefix comp)))
@@ -452,8 +453,7 @@ If END-NAME is specified, and the input string"
(semantic-tag-name tag)))
)
;; Add string to compiled output
- (setq name (substring what namestart end)
- key nil)
+ (setq name (substring what namestart end))
;; Trim WHAT back.
(setq what (substring what tail))
;; Get the inserter
@@ -514,7 +514,7 @@ to the inserter constructor."
;;(message "Compile: %s %S" name props)
(if (not key)
(apply 'srecode-template-inserter-variable name props)
- (let ((classes (eieio-class-children srecode-template-inserter))
+ (let ((classes (eieio-class-children 'srecode-template-inserter))
(new nil))
;; Loop over the various subclasses and
;; create the correct inserter.
@@ -522,7 +522,7 @@ to the inserter constructor."
(setq classes (append classes (eieio-class-children (car classes))))
;; Do we have a match?
(when (and (not (class-abstract-p (car classes)))
- (equal (oref (car classes) key) key))
+ (equal (oref-default (car classes) key) key))
;; Create the new class, and apply state.
(setq new (apply (car classes) name props))
(srecode-inserter-apply-state new STATE)
@@ -595,7 +595,7 @@ A list of defined variables VARS provides a variable table."
;; Dump out information about the current srecoder compiled templates.
;;
-(defmethod srecode-dump ((tmp srecode-template))
+(cl-defmethod srecode-dump ((tmp srecode-template))
"Dump the contents of the SRecode template tmp."
(princ "== Template \"")
(princ (eieio-object-name-string tmp))
@@ -641,7 +641,7 @@ Argument INDENT specifies the indentation level for the list."
(princ "\n"))))
)
-(defmethod srecode-dump ((ins srecode-template-inserter) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter) _indent)
"Dump the state of the SRecode template inserter INS."
(princ "INS: \"")
(princ (eieio-object-name-string ins))
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index fd500b6d9a3..e77e05c40b9 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -1,6 +1,6 @@
;;; srecode/cpp.el --- C++ specific handlers for Semantic Recoder
-;; Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; Jan Moringen <scymtym@users.sourceforge.net>
@@ -84,7 +84,7 @@ HEADER - Shown section if in a header file."
;;;###autoload
(defun srecode-semantic-handle-:cpp (dict)
"Add macros into the dictionary DICT based on the current c file.
-Calls `srecode-semantic-handle-:c.
+Calls `srecode-semantic-handle-:c'.
Also adds the following:
- nothing -"
(srecode-semantic-handle-:c dict)
diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 0b15e733364..56433183c2b 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -1,6 +1,6 @@
;;; srecode/ctxt.el --- Derive a context from the source buffer.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index bbc791f09d8..b95d45ebc86 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -1,6 +1,6 @@
;;; srecode/dictionary.el --- Dictionary code for the semantic recoder.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -30,6 +30,7 @@
(eval-when-compile (require 'cl))
(require 'eieio)
+(require 'cl-generic)
(require 'srecode)
(require 'srecode/table)
(eval-when-compile (require 'semantic))
@@ -103,7 +104,7 @@ set NAME \"str\" macro \"OTHERNAME\"
with appending various parts together in a list.")
-(defmethod initialize-instance ((this srecode-dictionary-compound-variable)
+(cl-defmethod initialize-instance ((this srecode-dictionary-compound-variable)
&optional fields)
"Initialize the compound variable THIS.
Makes sure that :value is compiled."
@@ -120,7 +121,7 @@ Makes sure that :value is compiled."
;;(when (not state)
;; (error "Cannot create compound variable outside of sectiondictionary"))
- (call-next-method this (nreverse newfields))
+ (cl-call-next-method this (nreverse newfields))
(when (not (slot-boundp this 'compiled))
(let ((val (oref this :value))
(comp nil))
@@ -194,8 +195,8 @@ associated with a buffer or parent."
initfrombuff t)))
;; Create the new dictionary object.
- (let ((dict (srecode-dictionary
- major-mode
+ (let ((dict (make-instance
+ 'srecode-dictionary
:buffer buffer
:parent parent
:namehash (make-hash-table :test 'equal
@@ -215,7 +216,7 @@ associated with a buffer or parent."
))
dict))))
-(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
tpl)
"Insert into DICT the variables found in table TPL.
TPL is an object representing a compiled template file."
@@ -235,7 +236,7 @@ TPL is an object representing a compiled template file."
(setq tabs (cdr tabs))))))
-(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
name value)
"In dictionary DICT, set NAME to have VALUE."
;; Validate inputs
@@ -247,7 +248,7 @@ TPL is an object representing a compiled template file."
(puthash name value namehash))
)
-(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
name &optional show-only force)
"In dictionary DICT, add a section dictionary for section macro NAME.
Return the new dictionary.
@@ -299,7 +300,7 @@ inserted dictionaries."
;; Return the new sub-dictionary.
new))
-(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be exposed."
;; Validate inputs
(unless (stringp name)
@@ -310,7 +311,7 @@ inserted dictionaries."
(srecode-dictionary-add-section-dictionary dict name t)
nil)
-(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
+(cl-defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
"In dictionary DICT, indicate that the section NAME should be hidden."
;; We need to find the has value, and then delete it.
;; Validate inputs
@@ -322,7 +323,7 @@ inserted dictionaries."
(remhash name namehash))
nil)
-(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-add-entries ((dict srecode-dictionary)
entries &optional state)
"Add ENTRIES to DICT.
@@ -373,7 +374,7 @@ values but STATE is nil."
(setq entries (nthcdr 2 entries)))
dict)
-(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
+(cl-defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict
&optional force)
"Merge into DICT the dictionary entries from OTHERDICT.
Unless the optional argument FORCE is non-nil, values in DICT are
@@ -405,7 +406,7 @@ OTHERDICT."
(srecode-dictionary-set-value dict key entry)))))
(oref otherdict namehash))))
-(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
+(cl-defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
name &optional non-recursive)
"Return information about DICT's value for NAME.
DICT is a dictionary, and NAME is a string that is treated as the
@@ -416,7 +417,7 @@ searched for NAME if it is not found in DICT. This recursive
lookup can be disabled by the optional argument NON-RECURSIVE.
This function derives values for some special NAMEs, such as
-'FIRST' and 'LAST'."
+`FIRST' and `LAST'."
(if (not (slot-boundp dict 'namehash))
nil
;; Get the value of this name from the dictionary or its parent
@@ -429,7 +430,7 @@ This function derives values for some special NAMEs, such as
(srecode-dictionary-lookup-name parent name)))))
)
-(defmethod srecode-root-dictionary ((dict srecode-dictionary))
+(cl-defmethod srecode-root-dictionary ((dict srecode-dictionary))
"For dictionary DICT, return the root dictionary.
The root dictionary is usually for a current or active insertion."
(let ((ans dict))
@@ -442,7 +443,7 @@ The root dictionary is usually for a current or active insertion."
;; Compound values must provide at least the toString method
;; for use in converting the compound value into something insertable.
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
function
dictionary)
"Convert the compound dictionary value CP to a string.
@@ -456,13 +457,13 @@ the value itself using `princ', or by detecting if the current
standard out is a buffer, and using `insert'."
(eieio-object-name cp))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-value)
&optional indent)
"Display information about this compound value."
(princ (eieio-object-name cp))
)
-(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
function
dictionary)
"Convert the compound dictionary variable value CP into a string.
@@ -471,7 +472,7 @@ FUNCTION and DICTIONARY are as for the baseclass."
(srecode-insert-code-stream (oref cp compiled) dictionary))
-(defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
+(cl-defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
&optional indent)
"Display information about this compound value."
(require 'srecode/compile)
@@ -501,7 +502,7 @@ Compound values allow a field to be stored in the dictionary for when
it is referenced a second time. This compound value can then be
inserted with a new editable field.")
-(defmethod srecode-compound-toString((cp srecode-field-value)
+(cl-defmethod srecode-compound-toString((cp srecode-field-value)
function
dictionary)
"Convert this field into an insertable string."
@@ -639,7 +640,7 @@ STATE is the current compiler state."
(srecode-dump dict))
))))
-(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
+(cl-defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
"Dump a dictionary."
(if (not indent) (setq indent 0))
(maphash (lambda (key entry)
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index 902eb6433b9..f0fe498cbba 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -1,6 +1,6 @@
;;; srecode/document.el --- Documentation (comment) generation
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -395,7 +395,7 @@ It is assumed that the comment occurs just in front of FCN-IN."
(beginning-of-line)
(forward-char -1)
- (let ((lextok (semantic-documentation-comment-preceeding-tag fcn-in 'lex))
+ (let ((lextok (semantic-documentation-comment-preceding-tag fcn-in 'lex))
(doctext
(srecode-document-function-name-comment fcn-in))
)
@@ -655,7 +655,7 @@ If there is only one tag in the region, complain."
"Create documentation for the function defined in TAG.
If we can identify a verb in the list followed by some
name part then check the return value to see if we can use that to
-finish off the sentence. That is, any function with 'alloc' in it will be
+finish off the sentence. That is, any function with `alloc' in it will be
allocating something based on its type."
(let ((al srecode-document-autocomment-return-first-alist)
(dropit nil)
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index cc6ee7298a7..7e91a612638 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -1,6 +1,6 @@
;;; srecode/el.el --- Emacs Lisp specific arguments
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -50,7 +50,7 @@ Adds the following:
(defun srecode-semantic-handle-:el-custom (dict)
"Add macros into the dictionary DICT based on the current Emacs Lisp file.
Adds the following:
- GROUP - The 'defgroup' name we guess you want for variables.
+ GROUP - The `defgroup' name we guess you want for variables.
FACEGROUP - The `defgroup' name you might want for faces."
(require 'semantic/db-find)
(let ((groups (semanticdb-strip-find-results
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index ddc4bebc7ad..205d207edda 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -1,6 +1,6 @@
;;; srecode/expandproto.el --- Expanding prototypes.
-;; Copyright (C) 2007, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 8ac379d12f4..027ae0c25dd 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -1,6 +1,6 @@
;;; srecode/extract.el --- Extract content from previously inserted macro.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -55,16 +55,16 @@
)
"The current extraction state.")
-(defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
+(cl-defmethod srecode-extract-state-set ((st srecode-extract-state) ins dict)
"Set onto the extract state ST a new inserter INS and dictionary DICT."
(oset st lastinserter ins)
(oset st lastdict dict))
-(defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
+(cl-defmethod srecode-extract-state-set-anchor ((st srecode-extract-state))
"Reset the anchor point on extract state ST."
(oset st anchor (point)))
-(defmethod srecode-extract-state-extract ((st srecode-extract-state)
+(cl-defmethod srecode-extract-state-extract ((st srecode-extract-state)
endpoint)
"Perform an extraction on the extract state ST with ENDPOINT.
If there was no waiting inserter, do nothing."
@@ -94,7 +94,7 @@ the dictionary entries were for that block of text."
(srecode-extract-method template dict state)
dict))))
-(defmethod srecode-extract-method ((st srecode-template) dictionary
+(cl-defmethod srecode-extract-method ((st srecode-template) dictionary
state)
"Extract template ST and store extracted text in DICTIONARY.
Optional STARTRETURN is a symbol in which the start of the first
@@ -139,11 +139,11 @@ Uses STATE to maintain the current extraction state."
;;; Inserter Base Extractors
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter))
"Return non-nil if this inserter can extract values."
nil)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter)
start end dict state)
"Extract text from START/END and store in DICT.
Return nil as this inserter will extract nothing."
@@ -151,11 +151,11 @@ Return nil as this inserter will extract nothing."
;;; Variable extractor is simple and can extract later.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-variable))
"Return non-nil if this inserter can extract values."
'later)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-variable)
start end vdict state)
"Extract text from START/END and store in VDICT.
Return t if something was extracted.
@@ -169,11 +169,11 @@ Return nil if this inserter doesn't need to extract anything."
;;; Section Inserter
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-section-start))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-section-start)
start end indict state)
"Extract text from START/END and store in INDICT.
Return the starting location of the first plain-text match.
@@ -203,11 +203,11 @@ Return nil if nothing was extracted."
;;; Include Extractor must extract now.
;;
-(defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
+(cl-defmethod srecode-inserter-do-extract-p ((ins srecode-template-inserter-include))
"Return non-nil if this inserter can extract values."
'now)
-(defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-extract ((ins srecode-template-inserter-include)
start end dict state)
"Extract text from START/END and store in DICT.
Return the starting location of the first plain-text match.
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index ea856f3a394..dd38b65d7bf 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -1,6 +1,6 @@
;;; srecode/fields.el --- Handling type-in fields in a buffer.
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -39,6 +39,7 @@
;; Keep this library independent of SRecode proper.
(require 'eieio)
+(require 'cl-generic)
;;; Code:
(defvar srecode-field-archive nil
@@ -74,7 +75,7 @@ The overlay will crossreference this object.")
"An object that gets automatically bound to an overlay.
Has virtual :start and :end initializers.")
-(defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
+(cl-defmethod initialize-instance ((olaid srecode-overlaid) &optional args)
"Initialize OLAID, being sure it archived."
;; Extract :start and :end from the olaid list.
(let ((newargs nil)
@@ -107,11 +108,11 @@ Has virtual :start and :end initializers.")
(overlay-put olay 'srecode-init-only t)
(oset olaid overlay olay)
- (call-next-method olaid (nreverse newargs))
+ (cl-call-next-method olaid (nreverse newargs))
))
-(defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
+(cl-defmethod srecode-overlaid-activate ((olaid srecode-overlaid))
"Activate the overlaid area."
(let* ((ola (oref olaid overlay))
(start (overlay-start ola))
@@ -128,23 +129,23 @@ Has virtual :start and :end initializers.")
))
-(defmethod srecode-delete ((olaid srecode-overlaid))
+(cl-defmethod srecode-delete ((olaid srecode-overlaid))
"Delete the overlay from OLAID."
(delete-overlay (oref olaid overlay))
(slot-makeunbound olaid 'overlay)
)
-(defmethod srecode-empty-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-empty-region-p ((olaid srecode-overlaid))
"Return non-nil if the region covered by OLAID is of length 0."
(= 0 (srecode-region-size olaid)))
-(defmethod srecode-region-size ((olaid srecode-overlaid))
+(cl-defmethod srecode-region-size ((olaid srecode-overlaid))
"Return the length of region covered by OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
(- end start)))
-(defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
+(cl-defmethod srecode-point-in-region-p ((olaid srecode-overlaid))
"Return non-nil if point is in the region of OLAID."
(let ((start (overlay-start (oref olaid overlay)))
(end (overlay-end (oref olaid overlay))))
@@ -161,7 +162,7 @@ Has virtual :start and :end initializers.")
(setq ol (cdr ol)))
(car (nreverse ret))))
-(defmethod srecode-overlaid-text ((olaid srecode-overlaid) &optional set-to)
+(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."
(let* ((ol (oref olaid overlay))
@@ -191,7 +192,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
)
"Manage a buffer region in which fields exist.")
-(defmethod initialize-instance ((ir srecode-template-inserted-region)
+(cl-defmethod initialize-instance ((ir srecode-template-inserted-region)
&rest args)
"Initialize IR, capturing the active fields, and creating the overlay."
;; Fill in the fields
@@ -199,10 +200,10 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(setq srecode-field-archive nil)
;; Initialize myself first.
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-overlaid-activate ((ir srecode-template-inserted-region))
"Activate the template area for IR."
;; Activate all our fields
@@ -210,7 +211,7 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(srecode-overlaid-activate F))
;; Activate our overlay.
- (call-next-method)
+ (cl-call-next-method)
;; Position the cursor at the first field
(let ((first (car (oref ir fields))))
@@ -223,21 +224,21 @@ If SET-TO is a string, then replace the text of OLAID wit SET-TO."
(add-hook 'post-command-hook 'srecode-field-post-command t t)
)
-(defmethod srecode-delete ((ir srecode-template-inserted-region))
+(cl-defmethod srecode-delete ((ir srecode-template-inserted-region))
"Call into our base, but also clear out the fields."
;; Clear us out of the baseclass.
(oset ir active-region nil)
;; Clear our fields.
(mapc 'srecode-delete (oref ir fields))
;; Call to our base
- (call-next-method)
+ (cl-call-next-method)
;; Clear our hook.
(remove-hook 'post-command-hook 'srecode-field-post-command t)
)
(defsubst srecode-active-template-region ()
"Return the active region for template fields."
- (oref srecode-template-inserted-region active-region))
+ (oref-default 'srecode-template-inserted-region active-region))
(defun srecode-field-post-command ()
"Srecode field handler in the post command hook."
@@ -285,15 +286,15 @@ Try to use this to provide useful completion when available.")
km)
"Keymap applied to field overlays.")
-(defmethod initialize-instance ((field srecode-field) &optional args)
+(cl-defmethod initialize-instance ((field srecode-field) &optional args)
"Initialize FIELD, being sure it archived."
(add-to-list 'srecode-field-archive field t)
- (call-next-method)
+ (cl-call-next-method)
)
-(defmethod srecode-overlaid-activate ((field srecode-field))
+(cl-defmethod srecode-overlaid-activate ((field srecode-field))
"Activate the FIELD area."
- (call-next-method)
+ (cl-call-next-method)
(let* ((ol (oref field overlay))
(end nil)
@@ -314,13 +315,13 @@ Try to use this to provide useful completion when available.")
)
)
-(defmethod srecode-delete ((olaid srecode-field))
+(cl-defmethod srecode-delete ((olaid srecode-field))
"Delete our secondary overlay."
;; Remove our spare overlay
(delete-overlay (oref olaid tail))
(slot-makeunbound olaid 'tail)
;; Do our baseclass work.
- (call-next-method)
+ (cl-call-next-method)
)
(defvar srecode-field-replication-max-size 100
@@ -379,7 +380,7 @@ PRE-LEN is used in the after mode for the length of the changed text."
(srecode-field-mod-hook ol after start end pre-len))
))
-(defmethod srecode-field-goto ((field srecode-field))
+(cl-defmethod srecode-field-goto ((field srecode-field))
"Goto the FIELD."
(goto-char (overlay-start (oref field overlay))))
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index bdc7c42fa09..dc296dccf92 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -1,6 +1,6 @@
;;; srecode/filters.el --- Filters for use in template variables.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index 6384913192d..092f739df7d 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -1,6 +1,6 @@
;;;; srecode/find.el --- Tools for finding templates in the database.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -96,7 +96,7 @@ all template files for that application will be loaded."
;;
;; Find if a template table has a project set, and if so, is the
;; current buffer in that project.
-(defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
+(cl-defmethod srecode-template-table-in-project-p ((tab srecode-template-table))
"Return non-nil if the table TAB can be used in the current project.
If TAB has a :project set, check that the directories match.
If TAB is nil, then always return t."
@@ -113,7 +113,7 @@ If TAB is nil, then always return t."
;;
;; Find a given template based on name, and features of the current
;; buffer.
-(defmethod srecode-template-get-table ((tab srecode-template-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-template-table)
template-name &optional
context application)
"Find in the template in table TAB, the template with TEMPLATE-NAME.
@@ -129,7 +129,7 @@ The APPLICATION argument is unused."
;; No context, perhaps a merged name?
(gethash template-name (oref tab namehash)))))
-(defmethod srecode-template-get-table ((tab srecode-mode-table)
+(cl-defmethod srecode-template-get-table ((tab srecode-mode-table)
template-name &optional
context application)
"Find in the template in mode table TAB, the template with TEMPLATE-NAME.
@@ -157,7 +157,7 @@ tables that do not belong to an application will be searched."
;;
;; Find a given template based on a key binding.
;;
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-template-table) binding &optional context)
"Find in the template name in table TAB, the template with BINDING.
Optional argument CONTEXT specifies that the template should part
@@ -190,7 +190,7 @@ of a particular context."
(maphash hashfcn (oref tab namehash)))
keyout)))
-(defmethod srecode-template-get-table-for-binding
+(cl-defmethod srecode-template-get-table-for-binding
((tab srecode-mode-table) binding &optional context application)
"Find in the template name in mode table TAB, the template with BINDING.
Optional argument CONTEXT specifies a context a particular template
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 617212759a1..07255af2bfe 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -1,6 +1,6 @@
;;; srecode/getset.el --- Package for inserting new get/set methods.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index 0d647bb56c5..2ff3060ac51 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -1,6 +1,6 @@
;;; srecode/insert.el --- Insert srecode templates to an output stream.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -35,7 +35,6 @@
(require 'srecode/args)
(require 'srecode/filters)
-(defvar srecode-template-inserter-point)
(declare-function srecode-overlaid-activate "srecode/fields")
(declare-function srecode-template-inserted-region "srecode/fields")
@@ -46,9 +45,9 @@
Only the ASK style inserter will query the user for a value.
Dictionary value references that ask begin with the ? character.
Possible values are:
- 'ask - Prompt in the minibuffer as the value is inserted.
- 'field - Use the dictionary macro name as the inserted value,
- and place a field there. Matched fields change together.
+ `ask' - Prompt in the minibuffer as the value is inserted.
+ `field' - Use the dictionary macro name as the inserted value,
+ and place a field there. Matched fields change together.
NOTE: The field feature does not yet work with XEmacs."
:group 'srecode
@@ -145,7 +144,7 @@ has set everything up already."
)
(set-buffer standard-output)
(setq end-mark (point-marker))
- (goto-char (oref srecode-template-inserter-point point)))
+ (goto-char (oref-default 'srecode-template-inserter-point point)))
(oset-default 'srecode-template-inserter-point point eieio-unbound)
;; Return the end-mark.
@@ -211,13 +210,13 @@ insertions."
(propertize " (most recent at bottom)" 'face '(:slant italic))
":\n")
(data-debug-insert-stuff-list
- (reverse (oref srecode-template active)) "> ")
+ (reverse (oref-default 'srecode-template active)) "> ")
;; Show the current dictionary.
(insert (propertize "Dictionary" 'face '(:weight bold)) "\n")
(data-debug-insert-thing dictionary "" "> ")
;; Show the error message.
(insert (propertize "Error" 'face '(:weight bold)) "\n")
- (insert (apply #'format format args))
+ (insert (apply #'format-message format args))
(pop-to-buffer (current-buffer))))
(defun srecode-insert-report-error (dictionary format &rest args)
@@ -260,20 +259,19 @@ Optional argument TEMP is the template that is getting its arguments resolved."
;; Code managing the top-level insert method and the current
;; insertion stack.
;;
-(defmethod srecode-push ((st srecode-template))
+(cl-defmethod srecode-push ((st srecode-template))
"Push the srecoder template ST onto the active stack."
(oset st active (cons st (oref st active))))
-(defmethod srecode-pop :STATIC ((st srecode-template))
- "Pop the srecoder template ST onto the active stack.
-ST can be a class, or an object."
+(cl-defmethod srecode-pop ((st srecode-template))
+ "Pop the srecoder template ST onto the active stack."
(oset st active (cdr (oref st active))))
-(defmethod srecode-peek :STATIC ((st srecode-template))
- "Fetch the topmost active template record. ST can be a class."
+(cl-defmethod srecode-peek ((st srecode-template))
+ "Fetch the topmost active template record."
(car (oref st active)))
-(defmethod srecode-insert-method ((st srecode-template) dictionary)
+(cl-defmethod srecode-insert-method ((st srecode-template) dictionary)
"Insert the srecoder template ST."
;; Merge any template entries into the input dictionary.
;; This may happen twice since some templates arguments need
@@ -324,7 +322,7 @@ by themselves.")
Specify the :indent argument to enable automatic indentation when newlines
occur in your template.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-newline)
dictionary)
"Insert the STI inserter."
;; To be safe, indent the previous line since the template will
@@ -363,9 +361,9 @@ occur in your template.")
((stringp i)
(princ i))))))
-(defmethod srecode-dump ((ins srecode-template-inserter-newline) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-newline) _indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(when (oref ins hard)
(princ " : hard")
))
@@ -379,16 +377,16 @@ Can't be blank, or it might be used by regular variable insertion.")
(where :initform 'begin
:initarg :where
:documentation
- "This should be 'begin or 'end, indicating where to insert a CR.
-When set to 'begin, it will insert a CR if we are not at 'bol'.
-When set to 'end it will insert a CR if we are not at 'eol'.")
+ "This should be `begin' or `end', indicating where to insert a CR.
+When `begin', insert a CR if not at 'bol'.
+When `end', insert a CR if not at 'eol'.")
;; @TODO - Add slot and control for the number of blank
;; lines before and after point.
)
"Insert a newline before and after a template, and possibly do indenting.
Specify the :blank argument to enable this inserter.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-blank)
dictionary)
"Make sure there is no text before or after point."
(let ((i (srecode-dictionary-lookup-name dictionary "INDENT"))
@@ -396,7 +394,7 @@ Specify the :blank argument to enable this inserter.")
(pm (point-marker)))
(when (and inbuff
;; Don't do this if we are not the active template.
- (= (length (oref srecode-template active)) 1))
+ (= (length (oref-default 'srecode-template active)) 1))
(when (and (eq i t) inbuff (not (eq (oref sti where) 'begin)))
(indent-according-to-mode)
@@ -425,8 +423,8 @@ Specify the :blank argument to enable this inserter.")
)
"Allow comments within template coding. This inserts nothing.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-comment)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-comment))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -436,8 +434,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-comment)
- dictionary)
+(cl-defmethod srecode-insert-method ((_sti srecode-template-inserter-comment)
+ _dictionary)
"Don't insert anything for comment macros in STI."
nil)
@@ -453,7 +451,7 @@ If there is no entry, insert nothing.")
(defvar srecode-inserter-variable-current-dictionary nil
"The active dictionary when calling a variable filter.")
-(defmethod srecode-insert-variable-secondname-handler
+(cl-defmethod srecode-insert-variable-secondname-handler
((sti srecode-template-inserter-variable) dictionary value secondname)
"For VALUE handle SECONDNAME behaviors for this variable inserter.
Return the result as a string.
@@ -471,7 +469,7 @@ If SECONDNAME is nil, return VALUE."
(object-print sti) secondname)))
value))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-variable)
dictionary)
"Insert the STI inserter."
;; Convert the name into a name/fcn pair
@@ -491,7 +489,7 @@ If SECONDNAME is nil, return VALUE."
(setq val (srecode-insert-variable-secondname-handler
sti dictionary val fcnpart)))
;; Compound data value
- ((srecode-dictionary-compound-value-child-p val)
+ ((cl-typep val 'srecode-dictionary-compound-value)
;; Force FCN to be a symbol
(when fcnpart (setq fcnpart (read fcnpart)))
;; Convert compound value to a string with the fcn.
@@ -502,7 +500,7 @@ If SECONDNAME is nil, return VALUE."
(setq do-princ nil)))
;; Dictionaries... not allowed in this style
- ((srecode-dictionary-child-p val)
+ ((cl-typep val 'srecode-dictionary)
(srecode-insert-report-error
dictionary
"Macro %s cannot insert a dictionary - use section macros instead"
@@ -541,7 +539,7 @@ If there is no entry, prompt the user for the value to use.
The prompt text used is derived from the previous PROMPT command in the
template file.")
-(defmethod srecode-inserter-apply-state
+(cl-defmethod srecode-inserter-apply-state
((ins srecode-template-inserter-ask) STATE)
"For the template inserter INS, apply information from STATE.
Loop over the prompts to see if we have a match."
@@ -561,14 +559,14 @@ Loop over the prompts to see if we have a match."
(setq prompts (cdr prompts)))
))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-ask)
dictionary)
"Insert the STI inserter."
(let ((val (srecode-dictionary-lookup-name
dictionary (oref sti :object-name))))
(if val
;; Does some extra work. Oh well.
- (call-next-method)
+ (cl-call-next-method)
;; How is our -ask value determined?
(if srecode-insert-with-fields-in-progress
@@ -585,9 +583,9 @@ Loop over the prompts to see if we have a match."
;; Now that this value is safely stowed in the dictionary,
;; we can do what regular inserters do.
- (call-next-method))))
+ (cl-call-next-method))))
-(defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-ask-default ((sti srecode-template-inserter-ask)
dictionary)
"Derive the default value for an askable inserter STI.
DICTIONARY is used to derive some values."
@@ -612,7 +610,7 @@ DICTIONARY is used to derive some values."
dictionary
"Unknown default for prompt: %S" defaultfcn)))))
-(defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-ask ((sti srecode-template-inserter-ask)
dictionary)
"Do the \"asking\" for the template inserter STI.
Use DICTIONARY to resolve values."
@@ -646,7 +644,7 @@ Use DICTIONARY to resolve values."
val)
)
-(defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
+(cl-defmethod srecode-insert-method-field ((sti srecode-template-inserter-ask)
dictionary)
"Create an editable field for the template inserter STI.
Use DICTIONARY to resolve values."
@@ -661,9 +659,9 @@ Use DICTIONARY to resolve values."
;; across multiple locations.
compound-value))
-(defmethod srecode-dump ((ins srecode-template-inserter-ask) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-ask) _indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ " : \"")
(princ (oref ins prompt))
(princ "\"")
@@ -681,8 +679,8 @@ Thus a specification of `10:left' will insert the value of A
to 10 characters, with spaces added to the left. Use `right' for adding
spaces to the right.")
-(defmethod srecode-insert-variable-secondname-handler
- ((sti srecode-template-inserter-width) dictionary value width)
+(cl-defmethod srecode-insert-variable-secondname-handler
+ ((_sti srecode-template-inserter-width) dictionary value width)
"For VALUE handle WIDTH behaviors for this variable inserter.
Return the result as a string.
By default, treat as a function name."
@@ -714,8 +712,8 @@ By default, treat as a function name."
(concat padchars value)
(concat value padchars))))))
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-width)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-width))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -750,8 +748,8 @@ The cursor is placed at the ^ macro after insertion.
Some inserter macros, such as `srecode-template-inserter-include-wrap'
will place text at the ^ macro from the included macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-point)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-point))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(princ " ")
@@ -761,10 +759,10 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-point)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-point)
dictionary)
"Insert the STI inserter.
-Save point in the class allocated 'point' slot.
+Save point in the class allocated `point' slot.
If `srecode-template-inserter-point-override' non-nil then this
generalized marker will do something else. See
`srecode-template-inserter-include-wrap' as an example."
@@ -773,7 +771,7 @@ generalized marker will do something else. See
;; valid. Compare this to the actual template nesting depth and
;; maybe use the override function which is stored in the cdr.
(if (and srecode-template-inserter-point-override
- (<= (length (oref srecode-template active))
+ (<= (length (oref-default 'srecode-template active))
(car srecode-template-inserter-point-override)))
;; Disable the old override while we do this.
(let ((over (cdr srecode-template-inserter-point-override))
@@ -787,11 +785,11 @@ generalized marker will do something else. See
"Wrap a section of a template under the control of a macro."
:abstract t)
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-subtemplate)
- escape-start escape-end)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-subtemplate))
+ escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
- (call-next-method)
+ (cl-call-next-method)
(princ " Template Text to control")
(terpri)
(princ " ")
@@ -801,11 +799,11 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-subtemplate ((sti srecode-template-inserter-subtemplate)
dict slot)
"Insert a subtemplate for the inserter STI with dictionary DICT."
;; Make sure that only dictionaries are used.
- (unless (srecode-dictionary-child-p dict)
+ (unless (cl-typep dict 'srecode-dictionary)
(srecode-insert-report-error
dict
"Only section dictionaries allowed for `%s'"
@@ -814,7 +812,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
;; Output the code from the sub-template.
(srecode-insert-method (slot-value sti slot) dict))
-(defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method-helper ((sti srecode-template-inserter-subtemplate)
dictionary slot)
"Do the work for inserting the STI inserter.
Loops over the embedded CODE which was saved here during compilation.
@@ -837,7 +835,7 @@ The template to insert is stored in SLOT."
(srecode-insert-subtemplate sti (car dicts) slot)
(setq dicts (cdr dicts)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-subtemplate)
dictionary)
"Insert the STI inserter.
Calls back to `srecode-insert-method-helper' for this class."
@@ -858,7 +856,7 @@ The dictionary saved at the named dictionary entry will be
applied to the text between the section start and the
`srecode-template-inserter-section-end' macro.")
-(defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
+(cl-defmethod srecode-parse-input ((ins srecode-template-inserter-section-start)
tag input STATE)
"For the section inserter INS, parse INPUT.
Shorten input until the END token is found.
@@ -872,9 +870,9 @@ Return the remains of INPUT."
:code (cdr out)))
(car out)))
-(defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
+(cl-defmethod srecode-dump ((ins srecode-template-inserter-section-start) indent)
"Dump the state of the SRecode template inserter INS."
- (call-next-method)
+ (cl-call-next-method)
(princ "\n")
(srecode-dump-code-list (oref (oref ins template) code)
(concat indent " "))
@@ -889,12 +887,12 @@ Return the remains of INPUT."
"All template segments between the section-start and section-end
are treated specially.")
-(defmethod srecode-insert-method ((sti srecode-template-inserter-section-end)
- dictionary)
+(cl-defmethod srecode-insert-method ((_sti srecode-template-inserter-section-end)
+ _dictionary)
"Insert the STI inserter."
)
-(defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
+(cl-defmethod srecode-match-end ((ins srecode-template-inserter-section-end) name)
"For the template inserter INS, do I end a section called NAME?"
(string= name (oref ins :object-name)))
@@ -912,7 +910,7 @@ are treated specially.")
The included template will have additional dictionary entries from the subdictionary
stored specified by this macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-include))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -923,7 +921,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-include-lookup ((sti srecode-template-inserter-include)
dictionary)
"For the template inserter STI, lookup the template to include.
Finds the template with this macro function part and stores it in
@@ -943,7 +941,7 @@ this template instance."
;; Calculate and store the discovered template
(let ((tmpl (srecode-template-get-table (srecode-table)
templatenamepart))
- (active (oref srecode-template active))
+ (active (oref-default 'srecode-template active))
ctxt)
(when (not tmpl)
;; If it isn't just available, scan back through
@@ -981,7 +979,7 @@ this template instance."
"No template \"%s\" found for include macro `%s'"
templatenamepart (oref sti :object-name)))))
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include)
dictionary)
"Insert the STI inserter.
Finds the template with this macro function part, and inserts it
@@ -1017,7 +1015,7 @@ stored specified by this macro. If the included macro includes a ^ macro,
then the text between this macro and the end macro will be inserted at
the ^ macro.")
-(defmethod srecode-inserter-prin-example :STATIC ((ins srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-inserter-prin-example ((_ins (subclass srecode-template-inserter-include-wrap))
escape-start escape-end)
"Insert an example using inserter INS.
Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
@@ -1035,7 +1033,7 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
(terpri)
)
-(defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
+(cl-defmethod srecode-insert-method ((sti srecode-template-inserter-include-wrap)
dictionary)
"Insert the template STI.
This will first insert the include part via inheritance, then
@@ -1053,7 +1051,7 @@ template where a ^ inserter occurs."
(lexical-let ((inserter1 sti))
(cons
;; DEPTH
- (+ (length (oref srecode-template active)) 1)
+ (+ (length (oref-default 'srecode-template active)) 1)
;; FUNCTION
(lambda (dict)
(let ((srecode-template-inserter-point-override nil))
@@ -1067,7 +1065,7 @@ template where a ^ inserter occurs."
inserter1 dict 'template))))))))
;; Do a regular insertion for an include, but with our override in
;; place.
- (call-next-method)))
+ (cl-call-next-method)))
(provide 'srecode/insert)
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index 1b8922c2746..d812df1c935 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -1,6 +1,6 @@
;;; srecode/java.el --- Srecode Java support
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -40,16 +40,15 @@ FILENAME_AS_CLASS - file converted to a Java class name."
(fnox (file-name-sans-extension fsym))
(dir (file-name-directory (buffer-file-name)))
(fpak fsym)
+ (proj (ede-current-project))
+ (pths (ede-source-paths proj 'java-mode))
)
(while (string-match "\\.\\| " fpak)
(setq fpak (replace-match "_" t t fpak)))
;; We can extract package from:
;; 1) a java EDE project source paths,
- (cond ((ede-current-project)
- (let* ((proj (ede-current-project))
- (pths (ede-source-paths proj 'java-mode))
- (pth)
- (res))
+ (cond ((and proj pths)
+ (let* ((pth) (res))
(while (and (not res)
(setq pth (expand-file-name (car pths))))
(when (string-match pth dir)
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 1dd9ba4cf47..71ed835e4ff 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -1,6 +1,6 @@
;;; srecode/map.el --- Manage a template file map
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -67,11 +67,11 @@ Each app keys to an alist of files and modes (as above.)")
)
"A map of srecode templates.")
-(defmethod srecode-map-entry-for-file ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file ((map srecode-map) file)
"Return the entry in MAP for FILE."
(assoc file (oref map files)))
-(defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
+(cl-defmethod srecode-map-entries-for-mode ((map srecode-map) mode)
"Return the entries in MAP for major MODE."
(let ((ans nil))
(dolist (f (oref map files))
@@ -79,12 +79,12 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-app ((map srecode-map) app)
- "Return the entry in MAP for APP'lication."
+(cl-defmethod srecode-map-entry-for-app ((map srecode-map) app)
+ "Return the entry in MAP for APP."
(assoc app (oref map apps))
)
-(defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
+(cl-defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode)
"Return the entries in MAP for major MODE."
(let ((ans nil)
(appentry (srecode-map-entry-for-app map app)))
@@ -93,7 +93,7 @@ Each app keys to an alist of files and modes (as above.)")
(setq ans (cons f ans))))
ans))
-(defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
+(cl-defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file)
"Search in all entry points in MAP for FILE.
Return a list ( APP . FILE-ASSOC ) where APP is nil
in the global map."
@@ -112,13 +112,13 @@ in the global map."
;; Other?
))
-(defmethod srecode-map-delete-file-entry ((map srecode-map) file)
+(cl-defmethod srecode-map-delete-file-entry ((map srecode-map) file)
"Update MAP to exclude FILE from the file list."
(let ((entry (srecode-map-entry-for-file map file)))
(when entry
(object-remove-from-list map 'files entry))))
-(defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
+(cl-defmethod srecode-map-update-file-entry ((map srecode-map) file mode)
"Update a MAP entry for FILE to be used with MODE.
Return non-nil if the MAP was changed."
(let ((entry (srecode-map-entry-for-file map file))
@@ -136,14 +136,14 @@ Return non-nil if the MAP was changed."
))
dirty))
-(defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
- "Delete from MAP the FILE entry within the APP'lication."
+(cl-defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app)
+ "Delete from MAP the FILE entry within the APP."
(let* ((appe (srecode-map-entry-for-app map app))
(fentry (assoc file (cdr appe))))
(setcdr appe (delete fentry (cdr appe))))
)
-(defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
+(cl-defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app)
"Update the MAP entry for FILE to be used with MODE within APP.
Return non-nil if the map was changed."
(let* ((appentry (srecode-map-entry-for-app map app))
@@ -298,7 +298,7 @@ if that file is NEW, otherwise assume the mode has not changed."
(when (not srecode-current-map)
(condition-case nil
(setq srecode-current-map
- (eieio-persistent-read srecode-map-save-file srecode-map))
+ (eieio-persistent-read srecode-map-save-file 'srecode-map))
(error
;; There was an error loading the old map. Create a new one.
(setq srecode-current-map
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index e8e1c78198e..a6daff8be56 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -1,6 +1,6 @@
;;; srecode/mode.el --- Minor mode for managing and using SRecode templates
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index c8b44c68d5d..0ea2ab4a5ff 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -1,6 +1,6 @@
;;; srecode/semantic.el --- Semantic specific extensions to SRecode.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -55,7 +55,7 @@
"Wrap up a collection of semantic tag information.
This class will be used to derive dictionary values.")
-(defmethod srecode-compound-toString((cp srecode-semantic-tag)
+(cl-defmethod srecode-compound-toString((cp srecode-semantic-tag)
function
dictionary)
"Convert the compound dictionary value CP to a string.
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index 2f43dc3872b..7fc35410b48 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -1,6 +1,6 @@
;;; srecode/srt-mode.el --- Major mode for writing screcode macros
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -188,6 +188,7 @@ we can tell font lock about them.")
;;;###autoload
(define-derived-mode srecode-template-mode fundamental-mode "SRecode"
+ ;; FIXME: Shouldn't it derive from prog-mode?
"Major-mode for writing SRecode macros."
(set (make-local-variable 'comment-start) ";;")
(set (make-local-variable 'comment-end) "")
@@ -232,7 +233,7 @@ we can tell font lock about them.")
"Provide help for working with macros in a template."
(interactive)
(let* ((root 'srecode-template-inserter)
- (chl (eieio--class-children (class-v root)))
+ (chl (eieio-class-children root))
(ess (srecode-template-get-escape-start))
(ees (srecode-template-get-escape-end))
)
@@ -248,7 +249,7 @@ we can tell font lock about them.")
(showexample t)
)
(setq chl (cdr chl))
- (setq chl (append (eieio--class-children (class-v C)) chl))
+ (setq chl (append (eieio-class-children C) chl))
(catch 'skip
(when (eq C 'srecode-template-inserter-section-end)
@@ -257,9 +258,9 @@ we can tell font lock about them.")
(when (class-abstract-p C)
(throw 'skip nil))
- (princ "`")
+ (princ (substitute-command-keys "`"))
(princ name)
- (princ "'")
+ (princ (substitute-command-keys "'"))
(when (slot-exists-p C 'key)
(when key
(princ " - Character Key: ")
diff --git a/lisp/cedet/srecode/srt-wy.el b/lisp/cedet/srecode/srt-wy.el
deleted file mode 100644
index 450f57d943c..00000000000
--- a/lisp/cedet/srecode/srt-wy.el
+++ /dev/null
@@ -1,306 +0,0 @@
-;;; srecode/srt-wy.el --- Generated parser support file
-
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file was generated from admin/grammars/srecode-template.wy.
-
-;;; Code:
-
-(require 'semantic/lex)
-(eval-when-compile (require 'semantic/bovine))
-
-;;; Prologue
-;;
-
-;;; Declarations
-;;
-(defconst srecode-template-wy--keyword-table
- (semantic-lex-make-keyword-table
- '(("set" . SET)
- ("show" . SHOW)
- ("macro" . MACRO)
- ("context" . CONTEXT)
- ("template" . TEMPLATE)
- ("sectiondictionary" . SECTIONDICTIONARY)
- ("section" . SECTION)
- ("end" . END)
- ("prompt" . PROMPT)
- ("default" . DEFAULT)
- ("defaultmacro" . DEFAULTMACRO)
- ("read" . READ)
- ("bind" . BIND))
- '(("bind" summary "bind \"<letter>\"")
- ("read" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("defaultmacro" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("default" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("prompt" summary "prompt <symbol> \"Describe Symbol: \" [default[macro] <lispsym>|\"valuetext\"] [read <lispsym>]")
- ("end" summary "section ... end")
- ("section" summary "section <name>\\n <dictionary entries>\\n end")
- ("sectiondictionary" summary "sectiondictionary <name>\\n <dictionary entries>")
- ("template" summary "template <name>\\n <template definition>")
- ("context" summary "context <name>")
- ("macro" summary "... macro \"string\" ...")
- ("show" summary "show <name> ; to show a section")
- ("set" summary "set <name> <value>")))
- "Table of language keywords.")
-
-(defconst srecode-template-wy--token-table
- (semantic-lex-make-type-table
- '(("number"
- (number))
- ("string"
- (string))
- ("symbol"
- (symbol))
- ("property"
- (property))
- ("separator"
- (TEMPLATE_BLOCK . "^----"))
- ("newline"
- (newline)))
- '(("number" :declared t)
- ("string" :declared t)
- ("symbol" :declared t)
- ("property" syntax ":\\(\\w\\|\\s_\\)*")
- ("property" :declared t)
- ("newline" :declared t)
- ("punctuation" syntax "\\s.+")
- ("punctuation" :declared t)
- ("keyword" :declared t)))
- "Table of lexical tokens.")
-
-(defconst srecode-template-wy--parse-table
- (progn
- (eval-when-compile
- (require 'semantic/wisent/comp))
- (wisent-compile-grammar
- '((SET SHOW MACRO CONTEXT TEMPLATE SECTIONDICTIONARY SECTION END PROMPT DEFAULT DEFAULTMACRO READ BIND newline TEMPLATE_BLOCK property symbol string number)
- nil
- (template_file
- ((newline)
- nil)
- ((context))
- ((prompt))
- ((variable))
- ((template)))
- (context
- ((CONTEXT symbol newline)
- (wisent-raw-tag
- (semantic-tag $2 'context))))
- (prompt
- ((PROMPT symbol string opt-default-fcn opt-read-fcn newline)
- (wisent-raw-tag
- (semantic-tag $2 'prompt :text
- (read $3)
- :default $4 :read $5))))
- (opt-default-fcn
- ((DEFAULT symbol)
- (progn
- (read $2)))
- ((DEFAULT string)
- (progn
- (read $2)))
- ((DEFAULTMACRO string)
- (progn
- (cons 'macro
- (read $2))))
- (nil nil))
- (opt-read-fcn
- ((READ symbol)
- (progn
- (read $2)))
- (nil nil))
- (variable
- ((SET symbol insertable-string-list newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil $3)))
- ((SET symbol number newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil
- (list $3))))
- ((SHOW symbol newline)
- (wisent-raw-tag
- (semantic-tag-new-variable $2 nil t))))
- (insertable-string-list
- ((insertable-string)
- (list $1))
- ((insertable-string-list insertable-string)
- (append $1
- (list $2))))
- (insertable-string
- ((string)
- (read $1))
- ((MACRO string)
- (cons 'macro
- (read $2))))
- (template
- ((TEMPLATE templatename opt-dynamic-arguments newline opt-string section-dictionary-list TEMPLATE_BLOCK newline opt-bind)
- (wisent-raw-tag
- (semantic-tag-new-function $2 nil $3 :documentation $5 :code $7 :dictionaries $6 :binding $9))))
- (templatename
- ((symbol))
- ((PROMPT))
- ((CONTEXT))
- ((TEMPLATE))
- ((DEFAULT))
- ((MACRO))
- ((DEFAULTMACRO))
- ((READ))
- ((SET)))
- (opt-dynamic-arguments
- ((property opt-dynamic-arguments)
- (cons $1 $2))
- (nil nil))
- (opt-string
- ((string newline)
- (read $1))
- (nil nil))
- (section-dictionary-list
- (nil nil)
- ((section-dictionary-list flat-section-dictionary)
- (append $1
- (list $2)))
- ((section-dictionary-list section-dictionary)
- (append $1
- (list $2))))
- (flat-section-dictionary
- ((SECTIONDICTIONARY string newline flat-dictionary-entry-list)
- (cons
- (read $2)
- $4)))
- (flat-dictionary-entry-list
- (nil nil)
- ((flat-dictionary-entry-list flat-dictionary-entry)
- (append $1 $2)))
- (flat-dictionary-entry
- ((variable)
- (wisent-cook-tag $1)))
- (section-dictionary
- ((SECTION string newline dictionary-entry-list END newline)
- (cons
- (read $2)
- $4)))
- (dictionary-entry-list
- (nil nil)
- ((dictionary-entry-list dictionary-entry)
- (append $1 $2)))
- (dictionary-entry
- ((variable)
- (wisent-cook-tag $1))
- ((section-dictionary)
- (list $1)))
- (opt-bind
- ((BIND string newline)
- (read $2))
- (nil nil)))
- '(template_file)))
- "Parser table.")
-
-(defun srecode-template-wy--install-parser ()
- "Setup the Semantic Parser."
- (semantic-install-function-overrides
- '((parse-stream . wisent-parse-stream)))
- (setq semantic-parser-name "LALR"
- semantic--parse-table srecode-template-wy--parse-table
- semantic-debug-parser-source "srecode-template.wy"
- semantic-flex-keywords-obarray srecode-template-wy--keyword-table
- semantic-lex-types-obarray srecode-template-wy--token-table)
- ;; Collect unmatched syntax lexical tokens
- (semantic-make-local-hook 'wisent-discarding-token-functions)
- (add-hook 'wisent-discarding-token-functions
- 'wisent-collect-unmatched-syntax nil t))
-
-
-;;; Analyzers
-;;
-(define-lex-regex-type-analyzer srecode-template-wy--<property>-regexp-analyzer
- "regexp analyzer for <property> tokens."
- ":\\(\\w\\|\\s_\\)*"
- nil
- 'property)
-
-(define-lex-regex-type-analyzer srecode-template-wy--<symbol>-regexp-analyzer
- "regexp analyzer for <symbol> tokens."
- "\\(\\sw\\|\\s_\\)+"
- nil
- 'symbol)
-
-(define-lex-regex-type-analyzer srecode-template-wy--<number>-regexp-analyzer
- "regexp analyzer for <number> tokens."
- semantic-lex-number-expression
- nil
- 'number)
-
-(define-lex-string-type-analyzer srecode-template-wy--<punctuation>-string-analyzer
- "string analyzer for <punctuation> tokens."
- "\\s.+"
- nil
- 'punctuation)
-
-(define-lex-sexp-type-analyzer srecode-template-wy--<string>-sexp-analyzer
- "sexp analyzer for <string> tokens."
- "\\s\""
- 'string)
-
-(define-lex-keyword-type-analyzer srecode-template-wy--<keyword>-keyword-analyzer
- "keyword analyzer for <keyword> tokens."
- "\\(\\sw\\|\\s_\\)+")
-
-
-;;; Epilogue
-;;
-(define-lex-simple-regex-analyzer srecode-template-property-analyzer
- "Detect and create a dynamic argument properties."
- ":\\(\\w\\|\\s_\\)*" 'property 0)
-
-(define-lex-regex-analyzer srecode-template-separator-block
- "Detect and create a template quote block."
- "^----\n"
- (semantic-lex-push-token
- (semantic-lex-token
- 'TEMPLATE_BLOCK
- (match-end 0)
- (semantic-lex-unterminated-syntax-protection 'TEMPLATE_BLOCK
- (goto-char (match-end 0))
- (re-search-forward "^----$")
- (match-beginning 0))))
- (setq semantic-lex-end-point (point)))
-
-
-(define-lex wisent-srecode-template-lexer
- "Lexical analyzer that handles SRecode Template buffers.
-It ignores whitespace, newlines and comments."
- semantic-lex-newline
- semantic-lex-ignore-whitespace
- semantic-lex-ignore-newline
- semantic-lex-ignore-comments
- srecode-template-separator-block
- srecode-template-wy--<keyword>-keyword-analyzer
- srecode-template-property-analyzer
- srecode-template-wy--<number>-regexp-analyzer
- srecode-template-wy--<symbol>-regexp-analyzer
- srecode-template-wy--<string>-sexp-analyzer
- srecode-template-wy--<punctuation>-string-analyzer
- semantic-lex-default-action
- )
-
-(provide 'srecode/srt-wy)
-
-;;; srecode/srt-wy.el ends here
diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el
index 1fad31dafd6..f369e45a834 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -1,6 +1,6 @@
;;; srecode/srt.el --- argument handlers for SRT files
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 26163bd1e51..a2baa7b231f 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -1,6 +1,6 @@
;;; srecode/table.el --- Tables of Semantic Recoders
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -26,6 +26,7 @@
;;
(require 'eieio)
+(require 'cl-generic)
(require 'eieio-base)
(require 'mode-local)
(require 'srecode)
@@ -172,7 +173,7 @@ calculate all inherited templates from parent modes."
new))))
-(defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
+(cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE.
Return nil if there was none."
(object-assoc file 'file (oref mt modetables)))
@@ -235,7 +236,7 @@ Use PREDICATE is the same as for the `sort' function."
(srecode-dump tmp))
)))
-(defmethod srecode-dump ((tab srecode-mode-table))
+(cl-defmethod srecode-dump ((tab srecode-mode-table))
"Dump the contents of the SRecode mode table TAB."
(princ "MODE TABLE FOR ")
(princ (oref tab :major-mode))
@@ -248,7 +249,7 @@ Use PREDICATE is the same as for the `sort' function."
(setq subtab (cdr subtab)))
))
-(defmethod srecode-dump ((tab srecode-template-table))
+(cl-defmethod srecode-dump ((tab srecode-template-table))
"Dump the contents of the SRecode template table TAB."
(princ "Template Table for ")
(princ (eieio-object-name-string tab))
diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index e3241a2ef40..3a7c45e9e06 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -1,6 +1,6 @@
;;; srecode/template.el --- SRecoder template language parser support.
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 9130c6ff863..38bdc9a2f72 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -1,6 +1,6 @@
;;; srecode/texi.el --- Srecode texinfo support.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
@@ -241,11 +241,11 @@ This is to take advantage of TeXinfo's markup symbols."
For instances where CLASS is the class being referenced, do not Xref
that class.
- `function' => @dfn{function}
- `variable' => @code{variable}
- `class' => @code{class} @xref{class}
- `unknown' => @code{unknown}
- \"text\" => ``text''
+ function => @dfn{function}
+ variable => @code{variable}
+ class => @code{class} @xref{class}
+ unknown => @code{unknown}
+ \"text\" => \\=`\\=`text\\='\\='
'quoteme => @code{quoteme}
non-nil => non-@code{nil}
t => @code{t}
@@ -253,7 +253,7 @@ that class.
[ stuff ] => @code{[ stuff ]}
Key => @kbd{Key} (key is C\\-h, M\\-h, SPC, RET, TAB and the like)
... => @dots{}"
- (while (string-match "`\\([-a-zA-Z0-9<>.]+\\)'" string)
+ (while (string-match "[`‘]\\([-a-zA-Z0-9<>.]+\\)['’]" string)
(let* ((vs (substring string (match-beginning 1) (match-end 1)))
(v (intern-soft vs)))
(setq string
diff --git a/lisp/character-fold.el b/lisp/character-fold.el
new file mode 100644
index 00000000000..0e156c50dde
--- /dev/null
+++ b/lisp/character-fold.el
@@ -0,0 +1,162 @@
+;;; character-fold.el --- match unicode to similar ASCII -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: matching
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+
+(defconst character-fold-table
+ (eval-when-compile
+ (let* ((equiv (make-char-table 'character-fold-table))
+ (table (unicode-property-table-internal 'decomposition))
+ (func (char-table-extra-slot table 1)))
+ ;; Ensure the table is populated.
+ (map-char-table
+ (lambda (i v) (when (consp i) (funcall func (car i) v table)))
+ table)
+
+ ;; Compile a list of all complex characters that each simple
+ ;; character should match.
+ (map-char-table
+ (lambda (i dec)
+ (when (consp dec)
+ ;; Discard a possible formatting tag.
+ (when (symbolp (car dec))
+ (setq dec (cdr dec)))
+ ;; Skip trivial cases like ?a decomposing to (?a).
+ (unless (or (and (eq i (car dec))
+ (not (cdr dec))))
+ (let ((d dec)
+ (fold-decomp t)
+ k found)
+ (while (and d (not found))
+ (setq k (pop d))
+ ;; Is k a number or letter, per unicode standard?
+ (setq found (memq (get-char-code-property k 'general-category)
+ '(Lu Ll Lt Lm Lo Nd Nl No))))
+ (if found
+ ;; Check if the decomposition has more than one letter,
+ ;; because then we don't want the first letter to match
+ ;; the decomposition.
+ (dolist (k d)
+ (when (and fold-decomp
+ (memq (get-char-code-property k 'general-category)
+ '(Lu Ll Lt Lm Lo Nd Nl No)))
+ (setq fold-decomp nil)))
+ ;; If there's no number or letter on the
+ ;; decomposition, take the first character in it.
+ (setq found (car-safe dec)))
+ ;; Finally, we only fold multi-char decomposition if at
+ ;; least one of the chars is non-spacing (combining).
+ (when fold-decomp
+ (setq fold-decomp nil)
+ (dolist (k dec)
+ (when (and (not fold-decomp)
+ (> (get-char-code-property k 'canonical-combining-class) 0))
+ (setq fold-decomp t))))
+ ;; Add i to the list of characters that k can
+ ;; represent. Also possibly add its decomposition, so we can
+ ;; match multi-char representations like (format "a%c" 769)
+ (when (and found (not (eq i k)))
+ (let ((chars (cons (char-to-string i) (aref equiv k))))
+ (aset equiv k
+ (if fold-decomp
+ (cons (apply #'string dec) chars)
+ chars))))))))
+ table)
+
+ ;; Add some manual entries.
+ (dolist (it '((?\" """ "“" "”" "”" "„" "⹂" "〞" "‟" "‟" "❞" "❝" "❠" "“" "„" "〝" "〟" "🙷" "🙶" "🙸" "«" "»")
+ (?' "❟" "❛" "❜" "‘" "’" "‚" "‛" "‚" "󠀢" "❮" "❯" "‹" "›")
+ (?` "❛" "‘" "‛" "󠀢" "❮" "‹")))
+ (let ((idx (car it))
+ (chars (cdr it)))
+ (aset equiv idx (append chars (aref equiv idx)))))
+
+ ;; Convert the lists of characters we compiled into regexps.
+ (map-char-table
+ (lambda (i v) (let ((re (regexp-opt (cons (char-to-string i) v))))
+ (if (consp i)
+ (set-char-table-range equiv i re)
+ (aset equiv i re))))
+ equiv)
+ equiv))
+ "Used for folding characters of the same group during search.")
+
+(defun character-fold--make-space-string (n)
+ "Return a string that matches N spaces."
+ (format "\\(?:%s\\|%s\\)"
+ (make-string n ?\s)
+ (apply #'concat
+ (make-list n (or (aref character-fold-table ?\s) " ")))))
+
+;;;###autoload
+(defun character-fold-to-regexp (string &optional _lax)
+ "Return a regexp matching anything that character-folds into STRING.
+Any character in STRING that has an entry in
+`character-fold-table' is replaced with that entry (which is a
+regexp) and other characters are `regexp-quote'd."
+ (let* ((spaces 0)
+ (chars (mapcar #'identity string))
+ (out chars))
+ ;; When the user types a space, we want to match the table entry,
+ ;; but we also want the ?\s to be visible to `search-spaces-regexp'.
+ ;; See commit message for a longer description.
+ (while chars
+ (let ((c (car chars)))
+ (setcar chars
+ (cond
+ ((eq c ?\s)
+ (setq spaces (1+ spaces))
+ nil)
+ ((> spaces 0)
+ (prog1 (concat (character-fold--make-space-string spaces)
+ (or (aref character-fold-table c)
+ (regexp-quote (string c))))
+ (setq spaces 0)))
+ (t (or (aref character-fold-table c)
+ (regexp-quote (string c))))))
+ (setq chars (cdr chars))))
+ (concat (apply #'concat out)
+ (when (> spaces 0)
+ (character-fold--make-space-string spaces)))))
+
+
+;;; Commands provided for completeness.
+(defun character-fold-search-forward (string &optional bound noerror count)
+ "Search forward for a character-folded version of STRING.
+STRING is converted to a regexp with `character-fold-to-regexp',
+which is searched for with `re-search-forward'.
+BOUND NOERROR COUNT are passed to `re-search-forward'."
+ (interactive "sSearch: ")
+ (re-search-forward (character-fold-to-regexp string) bound noerror count))
+
+(defun character-fold-search-backward (string &optional bound noerror count)
+ "Search backward for a character-folded version of STRING.
+STRING is converted to a regexp with `character-fold-to-regexp',
+which is searched for with `re-search-backward'.
+BOUND NOERROR COUNT are passed to `re-search-backward'."
+ (interactive "sSearch: ")
+ (re-search-backward (character-fold-to-regexp string) bound noerror count))
+
+(provide 'character-fold)
+
+;;; character-fold.el ends here
diff --git a/lisp/chistory.el b/lisp/chistory.el
index 509324ade88..d7326589227 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -1,9 +1,9 @@
;;; chistory.el --- list command history
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -121,7 +121,9 @@ The buffer is left in Command History mode."
(error "No command history")
(command-history-mode)))))
-(defvar command-history-map
+(define-obsolete-variable-alias 'command-history-map
+ 'command-history-mode-map "24.1")
+(defvar command-history-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map lisp-mode-shared-map)
(suppress-keymap map)
@@ -132,21 +134,11 @@ The buffer is left in Command History mode."
map)
"Keymap for `command-history-mode'.")
-(defun command-history-mode ()
+(define-derived-mode command-history-mode fundamental-mode "Command History"
"Major mode for listing and repeating recent commands.
Keybindings:
-\\{command-history-map}"
- (interactive)
- (Command-history-setup)
- (setq major-mode 'command-history-mode)
- (setq mode-name "Command History")
- (use-local-map command-history-map)
- (run-mode-hooks 'command-history-mode-hook))
-
-(defun Command-history-setup ()
- (kill-all-local-variables)
- (use-local-map command-history-map)
+\\{command-history-mode-map}"
(lisp-mode-variables nil)
(set-syntax-table emacs-lisp-mode-syntax-table)
(setq buffer-read-only t))
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index b78b8decfa6..724fc2bb7b0 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -1,10 +1,10 @@
;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el
-;; Copyright (C) 1988, 1994, 1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes, lisp
;; This file is part of GNU Emacs.
@@ -37,7 +37,7 @@
;;
;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
;; interface that communicates process state back to the superior emacs by
-;; outputting special control sequences. The gnumacs package, xscheme.el, has
+;; outputting special control sequences. The Emacs package, xscheme.el, has
;; lots and lots of special purpose code to read these control sequences, and
;; so is very tightly integrated with the cscheme process. The cscheme
;; interrupt handler and debugger read single character commands in cbreak
@@ -430,7 +430,7 @@ in the next one.")
(file-name-nondirectory file-name)))
(comint-send-string (scheme-proc) (concat "(load \""
file-name
- "\"\)\n")))
+ "\")\n")))
(defun scheme-compile-file (file-name)
"Compile a Scheme file FILE-NAME in the inferior Scheme process."
@@ -444,7 +444,7 @@ in the next one.")
(file-name-nondirectory file-name)))
(comint-send-string (scheme-proc) (concat "(compile-file \""
file-name
- "\"\)\n")))
+ "\")\n")))
(defvar scheme-buffer nil "The current scheme process buffer.
diff --git a/lisp/color.el b/lisp/color.el
index 50f6675bf4b..97656ca9e33 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -1,6 +1,6 @@
-;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*-
+;;; color.el --- Color manipulation library -*- lexical-binding:t -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Authors: Julien Danjou <julien@danjou.info>
;; Drew Adams <drew.adams@oracle.com>
@@ -93,7 +93,7 @@ resulting list."
"Compute hue from V1 and V2 H.
Used internally by `color-hsl-to-rgb'."
(cond
- ((< h (/ 1.0 6)) (+ v1 (* (- v2 v1) h 6.0)))
+ ((< h (/ 6.0)) (+ v1 (* (- v2 v1) h 6.0)))
((< h 0.5) v2)
((< h (/ 2.0 3)) (+ v1 (* (- v2 v1) (- (/ 2.0 3) h) 6.0)))
(t v1)))
@@ -110,9 +110,9 @@ inclusive."
(- (+ L S) (* L S))))
(m1 (- (* 2.0 L) m2)))
(list
- (color-hue-to-rgb m1 m2 (mod (+ H (/ 1.0 3)) 1))
+ (color-hue-to-rgb m1 m2 (mod (+ H (/ 3.0)) 1))
(color-hue-to-rgb m1 m2 H)
- (color-hue-to-rgb m1 m2 (mod (- H (/ 1.0 3)) 1))))))
+ (color-hue-to-rgb m1 m2 (mod (- H (/ 3.0)) 1))))))
(defun color-complement-hex (color)
"Return the color that is the complement of COLOR, in hexadecimal format."
@@ -199,13 +199,13 @@ RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
(list (if (<= r 0.0031308)
(* 12.92 r)
- (- (* 1.055 (expt r (/ 1 2.4))) 0.055))
+ (- (* 1.055 (expt r (/ 2.4))) 0.055))
(if (<= g 0.0031308)
(* 12.92 g)
- (- (* 1.055 (expt g (/ 1 2.4))) 0.055))
+ (- (* 1.055 (expt g (/ 2.4))) 0.055))
(if (<= b 0.0031308)
(* 12.92 b)
- (- (* 1.055 (expt b (/ 1 2.4))) 0.055)))))
+ (- (* 1.055 (expt b (/ 2.4))) 0.055)))))
(defconst color-d65-xyz '(0.950455 1.0 1.088753)
"D65 white point in CIE XYZ.")
@@ -222,13 +222,13 @@ conversion. If omitted or nil, use `color-d65-xyz'."
(yr (/ Y Yr))
(zr (/ Z Zr))
(fx (if (> xr color-cie-ε)
- (expt xr (/ 1 3.0))
+ (expt xr (/ 3.0))
(/ (+ (* color-cie-κ xr) 16) 116.0)))
(fy (if (> yr color-cie-ε)
- (expt yr (/ 1 3.0))
+ (expt yr (/ 3.0))
(/ (+ (* color-cie-κ yr) 16) 116.0)))
(fz (if (> zr color-cie-ε)
- (expt zr (/ 1 3.0))
+ (expt zr (/ 3.0))
(/ (+ (* color-cie-κ zr) 16) 116.0))))
(list
(- (* 116 fy) 16) ; L
diff --git a/lisp/comint.el b/lisp/comint.el
index 4517e9c65a0..e70fe88baf7 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -1,10 +1,10 @@
;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1990, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1990, 1992-2015 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes
;; Package: emacs
@@ -184,11 +184,11 @@ narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
wish to put something like the following in your init file:
-\(add-hook 'comint-mode-hook
+\(add-hook \\='comint-mode-hook
(lambda ()
- (define-key comint-mode-map \"\\C-w\" 'comint-kill-region)
- (define-key comint-mode-map [C-S-backspace]
- 'comint-kill-whole-line)))
+ (define-key comint-mode-map [remap kill-region] \\='comint-kill-region)
+ (define-key comint-mode-map [remap kill-whole-line]
+ \\='comint-kill-whole-line)))
If you sometimes use comint-mode on text-only terminals or with `emacs -nw',
you might wish to use another binding for `comint-kill-whole-line'."
@@ -347,14 +347,12 @@ This variable is buffer-local."
"Old" "old" "New" "new" "'s" "login"
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "[sudo]" "Repeat" "Bad") t)
" +\\)"
- (regexp-opt
- '("password" "Password" "passphrase" "Passphrase"
- "pass phrase" "Pass phrase" "Response"))
+ "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\
-\\(?: for .+\\)?:\\s *\\'")
+\\(?: for [^::៖]+\\)?[::៖]\\s *\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
- :version "24.1"
+ :version "24.4"
:type 'regexp
:group 'comint)
@@ -460,10 +458,10 @@ executed once when the buffer is created."
(define-key map "\e\C-l" 'comint-show-output)
(define-key map "\C-m" 'comint-send-input)
(define-key map "\C-d" 'comint-delchar-or-maybe-eof)
- ;; The following two are standardly aliased to C-d,
+ ;; The following two are standardly bound to delete-forward-char,
;; but they should never do EOF, just delete.
- (define-key map [delete] 'delete-char)
- (define-key map [kp-delete] 'delete-char)
+ (define-key map [delete] 'delete-forward-char)
+ (define-key map [kp-delete] 'delete-forward-char)
(define-key map "\C-c " 'comint-accumulate)
(define-key map "\C-c\C-x" 'comint-get-next-from-history)
(define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
@@ -474,6 +472,7 @@ executed once when the buffer is created."
(define-key map "\C-c\C-\\" 'comint-quit-subjob)
(define-key map "\C-c\C-m" 'comint-copy-old-input)
(define-key map "\C-c\C-o" 'comint-delete-output)
+ (define-key map "\C-c\M-o" 'comint-clear-buffer)
(define-key map "\C-c\C-r" 'comint-show-output)
(define-key map "\C-c\C-e" 'comint-show-maximum-output)
(define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
@@ -748,6 +747,7 @@ The buffer name is made by surrounding the file name of PROGRAM with `*'s.
The file name is used to make a symbol name, such as `comint-sh-hook', and any
hooks on this symbol are run in the buffer.
See `make-comint' and `comint-exec'."
+ (declare (interactive-only make-comint))
(interactive "sRun program: ")
(let ((name (file-name-nondirectory program)))
(switch-to-buffer (make-comint name program))
@@ -816,8 +816,6 @@ series of processes in the same Comint buffer. The hook
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))
- (unless (getenv "EMACS")
- (list "EMACS=t"))
(list (format "INSIDE_EMACS=%s,comint" emacs-version))
process-environment))
(default-directory
@@ -1053,7 +1051,7 @@ See also `comint-read-input-ring'."
(let ((ch (read-event)))
(if (eq ch ?\s)
(set-window-configuration conf)
- (setq unread-command-events (list ch)))))))
+ (push ch unread-command-events))))))
(defun comint-regexp-arg (prompt)
@@ -1209,8 +1207,9 @@ If N is negative, find the previous or Nth previous match."
With prefix argument N, search for Nth previous match.
If N is negative, search forwards for the -Nth following match."
(interactive "p")
- (if (not (memq last-command '(comint-previous-matching-input-from-input
- comint-next-matching-input-from-input)))
+ (let ((opoint (point)))
+ (unless (memq last-command '(comint-previous-matching-input-from-input
+ comint-next-matching-input-from-input))
;; Starting a new search
(setq comint-matching-input-from-input-string
(buffer-substring
@@ -1218,9 +1217,10 @@ If N is negative, search forwards for the -Nth following match."
(process-mark (get-buffer-process (current-buffer))))
(point))
comint-input-ring-index nil))
- (comint-previous-matching-input
- (concat "^" (regexp-quote comint-matching-input-from-input-string))
- n))
+ (comint-previous-matching-input
+ (concat "^" (regexp-quote comint-matching-input-from-input-string))
+ n)
+ (goto-char opoint)))
(defun comint-next-matching-input-from-input (n)
"Search forwards through input history for match for current input.
@@ -1406,13 +1406,13 @@ If nil, Isearch operates on the whole comint buffer."
"Search for a string backward in input history using Isearch."
(interactive)
(let ((comint-history-isearch t))
- (isearch-backward)))
+ (isearch-backward nil t)))
(defun comint-history-isearch-backward-regexp ()
"Search for a regular expression backward in input history using Isearch."
(interactive)
(let ((comint-history-isearch t))
- (isearch-backward-regexp)))
+ (isearch-backward-regexp nil t)))
(defvar-local comint-history-isearch-message-overlay nil)
@@ -1531,14 +1531,20 @@ the function `isearch-message'."
;; the initial comint prompt.
(if (overlayp comint-history-isearch-message-overlay)
(move-overlay comint-history-isearch-message-overlay
- (save-excursion (forward-line 0) (point))
+ (save-excursion
+ (goto-char (comint-line-beginning-position))
+ (forward-line 0)
+ (point))
(comint-line-beginning-position))
(setq comint-history-isearch-message-overlay
- (make-overlay (save-excursion (forward-line 0) (point))
+ (make-overlay (save-excursion
+ (goto-char (comint-line-beginning-position))
+ (forward-line 0)
+ (point))
(comint-line-beginning-position)))
(overlay-put comint-history-isearch-message-overlay 'evaporate t))
(overlay-put comint-history-isearch-message-overlay
- 'display (isearch-message-prefix c-q-hack ellipsis))
+ 'display (isearch-message-prefix ellipsis isearch-nonincremental))
(if (and comint-input-ring-index (not ellipsis))
;; Display the current history index.
(message "History item: %d" (1+ comint-input-ring-index))
@@ -1562,8 +1568,9 @@ or to the last history element for a backward search."
"Save a function restoring the state of input history search.
Save `comint-input-ring-index' to the additional state parameter
in the search status stack."
- `(lambda (cmd)
- (comint-history-isearch-pop-state cmd ,comint-input-ring-index)))
+ (let ((index comint-input-ring-index))
+ (lambda (cmd)
+ (comint-history-isearch-pop-state cmd index))))
(defun comint-history-isearch-pop-state (_cmd hist-pos)
"Restore the input history search state.
@@ -1574,7 +1581,7 @@ Go to the history element by the absolute history position HIST-POS."
(defun comint-within-quotes (beg end)
"Return t if the number of quotes between BEG and END is odd.
Quotes are single and double."
- (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
+ (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)'" beg end))
(countdq (comint-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
(or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
@@ -1767,13 +1774,22 @@ If the Comint is Lucid Common Lisp,
Similarly for Soar, Scheme, etc."
(interactive)
+ ;; If we're currently completing, stop. We're definitely done
+ ;; completing, and by sending the input, we might cause side effects
+ ;; that will confuse the code running in the completion
+ ;; post-command-hook.
+ (when completion-in-region-mode
+ (completion-in-region-mode -1))
;; Note that the input string does not include its terminal newline.
(let ((proc (get-buffer-process (current-buffer))))
(if (not proc) (user-error "Current buffer has no process")
(widen)
(let* ((pmark (process-mark proc))
(intxt (if (>= (point) (marker-position pmark))
- (progn (if comint-eol-on-send (end-of-line))
+ (progn (if comint-eol-on-send
+ (if comint-use-prompt-regexp
+ (end-of-line)
+ (goto-char (field-end))))
(buffer-substring pmark (point)))
(let ((copy (funcall comint-get-old-input)))
(goto-char pmark)
@@ -1912,10 +1928,10 @@ the start, the cdr to the end of the last prompt recognized.")
Freezes the `font-lock-face' text property in place."
(when comint-last-prompt
(with-silent-modifications
- (add-text-properties
+ (font-lock-prepend-text-property
(car comint-last-prompt)
(cdr comint-last-prompt)
- '(font-lock-face comint-highlight-prompt)))
+ 'font-lock-face 'comint-highlight-prompt))
;; Reset comint-last-prompt so later on comint-output-filter does
;; not remove the font-lock-face text property of the previous
;; (this) prompt.
@@ -2058,23 +2074,27 @@ Make backspaces delete the previous character."
(let ((prompt-start (save-excursion (forward-line 0) (point)))
(inhibit-read-only t))
(when comint-prompt-read-only
- (with-silent-modifications
- (or (= (point-min) prompt-start)
- (get-text-property (1- prompt-start) 'read-only)
- (put-text-property
- (1- prompt-start) prompt-start 'read-only 'fence))
- (add-text-properties
- prompt-start (point)
- '(read-only t rear-nonsticky t front-sticky (read-only)))))
+ (with-silent-modifications
+ (or (= (point-min) prompt-start)
+ (get-text-property (1- prompt-start) 'read-only)
+ (put-text-property (1- prompt-start)
+ prompt-start 'read-only 'fence))
+ (add-text-properties prompt-start (point)
+ '(read-only t front-sticky (read-only)))))
(when comint-last-prompt
- (remove-text-properties (car comint-last-prompt)
- (cdr comint-last-prompt)
- '(font-lock-face)))
+ ;; There might be some keywords here waiting for
+ ;; fontification, so no `with-silent-modifications'.
+ (font-lock--remove-face-from-text-property
+ (car comint-last-prompt)
+ (cdr comint-last-prompt)
+ 'font-lock-face
+ 'comint-highlight-prompt))
(setq comint-last-prompt
(cons (copy-marker prompt-start) (point-marker)))
- (add-text-properties (car comint-last-prompt)
- (cdr comint-last-prompt)
- '(font-lock-face comint-highlight-prompt)))
+ (font-lock-prepend-text-property prompt-start (point)
+ 'font-lock-face
+ 'comint-highlight-prompt)
+ (add-text-properties prompt-start (point) '(rear-nonsticky t)))
(goto-char saved-point)))))))
(defun comint-preinput-scroll-to-bottom ()
@@ -2205,7 +2225,10 @@ the current line with any initial string matching the regexp
(null (get-char-property (setq bof (field-beginning)) 'field)))
(field-string-no-properties bof)
(comint-bol)
- (buffer-substring-no-properties (point) (line-end-position)))))
+ (buffer-substring-no-properties (point)
+ (if comint-use-prompt-regexp
+ (line-end-position)
+ (field-end))))))
(defun comint-copy-old-input ()
"Insert after prompt old input at point as new input to be edited.
@@ -2263,7 +2286,10 @@ a buffer local variable."
;; if there are two fields on a line, then the first one is the
;; prompt, and the second one is an input field, and is front-sticky
;; (as input fields should be).
- (constrain-to-field (line-beginning-position) (line-end-position))))
+ (constrain-to-field (if (eq (field-at-pos (point)) 'output)
+ (line-beginning-position)
+ (field-beginning))
+ (line-end-position))))
(defun comint-bol (&optional arg)
"Go to the beginning of line, then skip past the prompt, if any.
@@ -2315,7 +2341,8 @@ process if STRING contains a password prompt defined by
`comint-password-prompt-regexp'.
This function could be in the list `comint-output-filter-functions'."
- (when (string-match comint-password-prompt-regexp string)
+ (when (let ((case-fold-search t))
+ (string-match comint-password-prompt-regexp string))
(when (string-match "^[ \n\r\t\v\f\b\a]+" string)
(setq string (replace-match "" t t string)))
(send-invisible string)))
@@ -2414,6 +2441,11 @@ Sets mark to the value of point when this command is run."
(goto-char (field-beginning pos))
(set-window-start (selected-window) (point))))))
+(defun comint-clear-buffer ()
+ "Clear the comint buffer."
+ (interactive)
+ (let ((comint-buffer-maximum-size 0))
+ (comint-truncate-buffer)))
(defun comint-interrupt-subjob ()
"Interrupt the current subjob.
@@ -2678,7 +2710,7 @@ if necessary."
(kill-whole-line count)
(when (>= count 0) (comint-update-fence))))
-(defun comint-kill-region (beg end &optional yank-handler)
+(defun comint-kill-region (beg end)
"Like `kill-region', but ignores read-only properties, if safe.
This command assumes that the buffer contains read-only
\"prompts\" which are regions with front-sticky read-only
@@ -2692,7 +2724,6 @@ prompts should stay at the beginning of a line. If this is not
the case, this command just calls `kill-region' with all
read-only properties intact. The read-only status of newlines is
updated using `comint-update-fence', if necessary."
- (declare (advertised-calling-convention (beg end) "23.3"))
(interactive "r")
(save-excursion
(let* ((true-beg (min beg end))
@@ -2707,9 +2738,9 @@ updated using `comint-update-fence', if necessary."
(if (listp end-lst) (memq 'read-only end-lst) t))))
(if (or (and (not beg-bolp) (or beg-bad end-bad))
(and (not end-bolp) end-bad))
- (kill-region beg end yank-handler)
+ (kill-region beg end)
(let ((inhibit-read-only t))
- (kill-region beg end yank-handler)
+ (kill-region beg end)
(comint-update-fence))))))
;; Support for source-file processing commands.
@@ -2819,7 +2850,7 @@ then the filename reader will only accept a file that exists.
A typical use:
(interactive (comint-get-source \"Compile file: \" prev-lisp-dir/file
- '(lisp-mode) t))"
+ \\='(lisp-mode) t))"
(let* ((def (comint-source-default prev-dir/file source-modes))
(stringfile (comint-extract-string))
(sfile-p (and stringfile
@@ -3273,8 +3304,12 @@ See also `comint-dynamic-complete-filename'."
(defun comint-dynamic-list-completions (completions &optional common-substring)
"Display a list of sorted COMPLETIONS.
-The meaning of COMMON-SUBSTRING is the same as in `display-completion-list'.
-Typing SPC flushes the completions buffer."
+Typing SPC flushes the completions buffer.
+
+The optional argument COMMON-SUBSTRING, if non-nil, should be a string
+specifying a common substring for adding the faces
+`completions-first-difference' and `completions-common-part' to
+the completions."
(let ((window (get-buffer-window "*Completions*" 0)))
(setq completions (sort completions 'string-lessp))
(if (and (eq last-command this-command)
@@ -3305,7 +3340,8 @@ Typing SPC flushes the completions buffer."
(setq comint-dynamic-list-completions-config
(current-window-configuration))
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list completions common-substring))
+ (display-completion-list
+ (completion-hilit-commonality completions (length common-substring))))
(if (window-minibuffer-p)
(minibuffer-message "Type space to flush; repeat completion command to scroll")
(message "Type space to flush; repeat completion command to scroll")))
@@ -3320,15 +3356,17 @@ Typing SPC flushes the completions buffer."
(and (consp first) (consp (event-start first))
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
- (eq (key-binding key) 'mouse-choose-completion)))
- ;; If the user does mouse-choose-completion with the mouse,
+ (memq (key-binding key)
+ '(mouse-choose-completion choose-completion))))
+ ;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
(choose-completion first)
(set-window-configuration comint-dynamic-list-completions-config))
(if (eq first ?\s)
(set-window-configuration comint-dynamic-list-completions-config)
- (setq unread-command-events (listify-key-sequence key)))))))
+ (setq unread-command-events
+ (nconc (listify-key-sequence key) unread-command-events)))))))
(defun comint-get-next-from-history ()
"After fetching a line from input history, this fetches the following line.
@@ -3629,8 +3667,8 @@ This function does not need to be invoked by the end user."
;; If we see the prompt, tidy up
;; We'll look for the prompt in the original string, so nobody can
;; clobber it
- (and (string-match comint-redirect-finished-regexp
- (concat comint-redirect-previous-input-string
+ (and (string-match comint-redirect-finished-regexp
+ (concat comint-redirect-previous-input-string
input-string))
(progn
(and comint-redirect-verbose
@@ -3792,25 +3830,21 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
;; comint-mode will take care of it. The following example, from shell.el,
;; is typical:
;;
-;; (defvar shell-mode-map '())
-;; (cond ((not shell-mode-map)
-;; (setq shell-mode-map (copy-keymap comint-mode-map))
-;; (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-;; (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-;; (define-key shell-mode-map "\t" 'completion-at-point)
-;; (define-key shell-mode-map "\M-?"
-;; 'comint-dynamic-list-filename-completions)))
+;; (defvar shell-mode-map
+;; (let ((map (make-sparse-keymap)))
+;; (set-keymap-parent map comint-mode-map)
+;; (define-key map "\C-c\C-f" 'shell-forward-command)
+;; (define-key map "\C-c\C-b" 'shell-backward-command)
+;; (define-key map "\t" 'completion-at-point)
+;; (define-key map "\M-?"
+;; 'comint-dynamic-list-filename-completions)
+;; map))
;;
-;; (defun shell-mode ()
-;; (interactive)
-;; (comint-mode)
+;; (define-derived-mode shell-mode comint-mode "Shell"
+;; "Doc."
;; (setq comint-prompt-regexp shell-prompt-pattern)
-;; (setq major-mode 'shell-mode)
-;; (setq mode-name "Shell")
-;; (use-local-map shell-mode-map)
;; (setq-local shell-directory-stack nil)
-;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
-;; (run-mode-hooks 'shell-mode-hook))
+;; (add-hook 'comint-input-filter-functions 'shell-directory-tracker))
;;
;;
;; Completion for comint-mode users
diff --git a/lisp/completion.el b/lisp/completion.el
index ee0234536aa..b53f2d3ac79 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -1,9 +1,9 @@
;;; completion.el --- dynamic word-completion code
-;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2013 Free Software
+;; Copyright (C) 1990, 1993, 1995, 1997, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev convenience
;; Author: Jim Salem <alem@bbnplanet.com> of Thinking Machines Inc.
;; (ideas suggested by Brewster Kahle)
@@ -373,7 +373,7 @@ Used to decide whether to save completions.")
(defvar cmpl-preceding-syntax)
-(defvar completion-string)
+(defvar cmpl--completion-string)
;;---------------------------------------------------------------------------
;; Low level tools
@@ -435,8 +435,7 @@ Used to decide whether to save completions.")
(defun cmpl-hours-since-origin ()
- (let ((time (current-time)))
- (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
+ (floor (float-time) 3600))
;;---------------------------------------------------------------------------
;; "Symbol" parsing functions
@@ -1083,7 +1082,7 @@ Must be called after `find-exact-completion'."
(cmpl-db-debug-p
;; not found, error if debug mode
(error "Completion entry exists but not on prefix list - %s"
- completion-string))
+ cmpl--completion-string))
(inside-locate-completion-entry
;; recursive error: really scrod
(locate-completion-db-error))
@@ -1150,73 +1149,75 @@ COMPLETION-STRING must be longer than `completion-prefix-min-length'.
Updates the saved string with the supplied string.
This must be very fast.
Returns the completion entry."
- ;; Handle pending acceptance
- (if completion-to-accept (accept-completion))
- ;; test if already in database
- (if (setq cmpl-db-entry (find-exact-completion completion-string))
- ;; found
- (let* ((prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length)))
- (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
- (cmpl-ptr (cdr splice-ptr)))
- ;; update entry
- (set-completion-string cmpl-db-entry completion-string)
- ;; move to head (if necessary)
- (cond (splice-ptr
- ;; These should all execute atomically but it is not fatal if
- ;; they don't.
- ;; splice it out
- (or (setcdr splice-ptr (cdr cmpl-ptr))
- ;; fix up tail if necessary
- (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
- ;; splice in at head
- (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
- (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
- cmpl-db-entry)
- ;; not there
- (let (;; create an entry
- (entry (list (make-completion completion-string)))
- ;; setup the prefix
- (prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length))))
- (cond (prefix-entry
- ;; Splice in at head
- (setcdr entry (cmpl-prefix-entry-head prefix-entry))
- (set-cmpl-prefix-entry-head prefix-entry entry))
- (t
- ;; Start new prefix entry
- (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
- ;; Add it to the symbol
- (set cmpl-db-symbol (car entry)))))
+ (let ((cmpl--completion-string completion-string))
+ ;; Handle pending acceptance
+ (if completion-to-accept (accept-completion))
+ ;; test if already in database
+ (if (setq cmpl-db-entry (find-exact-completion completion-string))
+ ;; found
+ (let* ((prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length)))
+ (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
+ (cmpl-ptr (cdr splice-ptr)))
+ ;; update entry
+ (set-completion-string cmpl-db-entry completion-string)
+ ;; move to head (if necessary)
+ (cond (splice-ptr
+ ;; These should all execute atomically but it is not fatal if
+ ;; they don't.
+ ;; splice it out
+ (or (setcdr splice-ptr (cdr cmpl-ptr))
+ ;; fix up tail if necessary
+ (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
+ ;; splice in at head
+ (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
+ (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)))
+ cmpl-db-entry)
+ ;; not there
+ (let ( ;; create an entry
+ (entry (list (make-completion completion-string)))
+ ;; setup the prefix
+ (prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length))))
+ (cond (prefix-entry
+ ;; Splice in at head
+ (setcdr entry (cmpl-prefix-entry-head prefix-entry))
+ (set-cmpl-prefix-entry-head prefix-entry entry))
+ (t
+ ;; Start new prefix entry
+ (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))))
+ ;; Add it to the symbol
+ (set cmpl-db-symbol (car entry))))))
(defun delete-completion (completion-string)
"Delete the completion from the database.
String must be longer than `completion-prefix-min-length'."
;; Handle pending acceptance
- (if completion-to-accept (accept-completion))
- (if (setq cmpl-db-entry (find-exact-completion completion-string))
- ;; found
- (let* ((prefix-entry (find-cmpl-prefix-entry
- (substring cmpl-db-downcase-string 0
- completion-prefix-min-length)))
- (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
- ;; delete symbol reference
- (set cmpl-db-symbol nil)
- ;; remove from prefix list
- (cond (splice-ptr
- ;; not at head
- (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
- ;; fix up tail if necessary
- (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
- (t
- ;; at head
- (or (set-cmpl-prefix-entry-head
+ (let ((cmpl--completion-string completion-string))
+ (if completion-to-accept (accept-completion))
+ (if (setq cmpl-db-entry (find-exact-completion completion-string))
+ ;; found
+ (let* ((prefix-entry (find-cmpl-prefix-entry
+ (substring cmpl-db-downcase-string 0
+ completion-prefix-min-length)))
+ (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry)))
+ ;; delete symbol reference
+ (set cmpl-db-symbol nil)
+ ;; remove from prefix list
+ (cond (splice-ptr
+ ;; not at head
+ (or (setcdr splice-ptr (cdr (cdr splice-ptr)))
+ ;; fix up tail if necessary
+ (set-cmpl-prefix-entry-tail prefix-entry splice-ptr)))
+ (t
+ ;; at head
+ (or (set-cmpl-prefix-entry-head
prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
- ;; List is now empty
- (set cmpl-db-prefix-symbol nil)))))
- (error "Unknown completion `%s'" completion-string)))
+ ;; List is now empty
+ (set cmpl-db-prefix-symbol nil)))))
+ (error "Unknown completion `%s'" completion-string))))
;; Tests --
;; - Add and Find -
@@ -1312,7 +1313,7 @@ are specified."
(delete-completion string))
(defun accept-completion ()
- "Accepts the pending completion in `completion-to-accept'.
+ "Accept the pending completion in `completion-to-accept'.
This bumps num-uses. Called by `add-completion-to-head' and
`completion-search-reset'."
(let ((string completion-to-accept)
@@ -1950,7 +1951,7 @@ If file name is not specified, use `save-completions-file-name'."
(kept-old-versions 0)
(kept-new-versions completions-file-versions-kept)
last-use-time
- (current-time (cmpl-hours-since-origin))
+ (this-use-time (cmpl-hours-since-origin))
(total-in-db 0)
(total-perm 0)
(total-saved 0)
@@ -1982,13 +1983,13 @@ If file name is not specified, use `save-completions-file-name'."
;; or if
(if (> (completion-num-uses completion) 0)
;; it's been used
- (setq last-use-time current-time)
+ (setq last-use-time this-use-time)
;; or it was saved before and
(and last-use-time
;; save-completions-retention-time is nil
(or (not save-completions-retention-time)
;; or time since last use is < ...retention-time*
- (< (- current-time last-use-time)
+ (< (- this-use-time last-use-time)
save-completions-retention-time)))))
;; write to file
(setq total-saved (1+ total-saved))
@@ -2157,26 +2158,27 @@ Patched to remove the most recent completion."
;; to work)
;; All common separators (eg. space "(" ")" """) characters go through a
-;; function to add new words to the list of words to complete from:
-;; COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
+;; 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
;; symbol before point to the completion list (using ADD-COMPLETION).
-(defun completion-separator-self-insert-command (arg)
- (interactive "p")
- (if (command-remapping 'self-insert-command)
- (funcall (command-remapping 'self-insert-command) arg)
- (use-completion-before-separator)
- (self-insert-command arg)))
-
-(defun completion-separator-self-insert-autofilling (arg)
- (interactive "p")
- (if (command-remapping 'self-insert-command)
- (funcall (command-remapping 'self-insert-command) arg)
- (use-completion-before-separator)
- (self-insert-command arg)
- (and auto-fill-function
- (funcall auto-fill-function))))
+(defvar completion-separator-chars
+ (append " !%^&()=`|{}[];\\'#,?"
+ ;; We include period and colon even though they are symbol
+ ;; chars because :
+ ;; - in text we want to pick up the last word in a sentence.
+ ;; - in C pointer refs. we want to pick up the first symbol
+ ;; - it won't make a difference for lisp mode (package names
+ ;; are short)
+ ".:" nil))
+
+(defun completion--post-self-insert ()
+ (when (memq last-command-event completion-separator-chars)
+ (let ((after-pos (electric--after-char-pos)))
+ (when after-pos
+ (save-excursion
+ (goto-char (1- after-pos))
+ (use-completion-before-separator))))))
;;-----------------------------------------------
;; Wrapping Macro
@@ -2226,12 +2228,9 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(defun completion-lisp-mode-hook ()
(setq completion-syntax-table completion-lisp-syntax-table)
;; Lisp Mode diffs
- (local-set-key "!" 'self-insert-command)
- (local-set-key "&" 'self-insert-command)
- (local-set-key "%" 'self-insert-command)
- (local-set-key "?" 'self-insert-command)
- (local-set-key "=" 'self-insert-command)
- (local-set-key "^" 'self-insert-command))
+ (setq-local completion-separator-chars
+ (cl-set-difference completion-separator-chars
+ (append "!&%?=^" nil))))
;; C mode diffs.
@@ -2245,9 +2244,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(completion-def-wrapper 'electric-c-semi :separator)
(defun completion-c-mode-hook ()
(setq completion-syntax-table completion-c-syntax-table)
- (local-set-key "+" 'completion-separator-self-insert-command)
- (local-set-key "*" 'completion-separator-self-insert-command)
- (local-set-key "/" 'completion-separator-self-insert-command))
+ (setq-local completion-separator-chars
+ (append "+*/" completion-separator-chars)))
;; FORTRAN mode diffs. (these are defined when fortran is called)
@@ -2260,10 +2258,8 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
(defun completion-setup-fortran-mode ()
(setq completion-syntax-table completion-fortran-syntax-table)
- (local-set-key "+" 'completion-separator-self-insert-command)
- (local-set-key "-" 'completion-separator-self-insert-command)
- (local-set-key "*" 'completion-separator-self-insert-command)
- (local-set-key "/" 'completion-separator-self-insert-command))
+ (setq-local completion-separator-chars
+ (append "+-*/" completion-separator-chars)))
;; Enable completion mode.
@@ -2282,15 +2278,16 @@ if ARG is omitted or nil."
;; This is always good, not specific to dynamic-completion-mode.
(define-key function-key-map [C-return] [?\C-\r])
- (dolist (x '((find-file-hook . completion-find-file-hook)
- (pre-command-hook . completion-before-command)
+ (dolist (x `((find-file-hook . ,#'completion-find-file-hook)
+ (pre-command-hook . ,#'completion-before-command)
;; Save completions when killing Emacs.
- (kill-emacs-hook . kill-emacs-save-completions)
+ (kill-emacs-hook . ,#'kill-emacs-save-completions)
+ (post-self-insert-hook . ,#'completion--post-self-insert)
;; Install the appropriate mode tables.
- (lisp-mode-hook . completion-lisp-mode-hook)
- (c-mode-hook . completion-c-mode-hook)
- (fortran-mode-hook . completion-setup-fortran-mode)))
+ (lisp-mode-hook . ,#'completion-lisp-mode-hook)
+ (c-mode-hook . ,#'completion-c-mode-hook)
+ (fortran-mode-hook . ,#'completion-setup-fortran-mode)))
(if dynamic-completion-mode
(add-hook (car x) (cdr x))
(remove-hook (car x) (cdr x))))
@@ -2316,44 +2313,7 @@ if ARG is omitted or nil."
;; cumb
;; Patches to standard keymaps insert completions
- ([remap kill-region] . completion-kill-region)
-
- ;; Separators
- ;; We've used the completion syntax table given as a guide.
- ;;
- ;; Global separator chars.
- ;; We left out <tab> because there are too many special
- ;; cases for it. Also, in normal coding it's rarely typed
- ;; after a word.
- (" " . completion-separator-self-insert-autofilling)
- ("!" . completion-separator-self-insert-command)
- ("%" . completion-separator-self-insert-command)
- ("^" . completion-separator-self-insert-command)
- ("&" . completion-separator-self-insert-command)
- ("(" . completion-separator-self-insert-command)
- (")" . completion-separator-self-insert-command)
- ("=" . completion-separator-self-insert-command)
- ("`" . completion-separator-self-insert-command)
- ("|" . completion-separator-self-insert-command)
- ("{" . completion-separator-self-insert-command)
- ("}" . completion-separator-self-insert-command)
- ("[" . completion-separator-self-insert-command)
- ("]" . completion-separator-self-insert-command)
- (";" . completion-separator-self-insert-command)
- ("\"". completion-separator-self-insert-command)
- ("'" . completion-separator-self-insert-command)
- ("#" . completion-separator-self-insert-command)
- ("," . completion-separator-self-insert-command)
- ("?" . completion-separator-self-insert-command)
-
- ;; We include period and colon even though they are symbol
- ;; chars because :
- ;; - in text we want to pick up the last word in a sentence.
- ;; - in C pointer refs. we want to pick up the first symbol
- ;; - it won't make a difference for lisp mode (package names
- ;; are short)
- ("." . completion-separator-self-insert-command)
- (":" . completion-separator-self-insert-command)))
+ ([remap kill-region] . completion-kill-region)))
(push (cons (car binding) (lookup-key global-map (car binding)))
completion-saved-bindings)
(global-set-key (car binding) (cdr binding)))
diff --git a/lisp/composite.el b/lisp/composite.el
index 3c25b8b60af..4ab31d775a0 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,5 +1,7 @@
;;; composite.el --- support character composition
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -555,7 +557,11 @@ All non-spacing characters have this function in
(rbearing (lglyph-rbearing glyph))
(lbearing (lglyph-lbearing glyph))
(center (/ (+ lbearing rbearing) 2))
+ ;; Artificial vertical gap between the glyphs.
(gap (round (* (font-get (lgstring-font gstring) :size) 0.1))))
+ (if (= gap 0)
+ ;; Assure at least 1 pixel vertical gap.
+ (setq gap 1))
(dotimes (i nchars)
(setq glyph (lgstring-glyph gstring i))
(when (> i 0)
@@ -566,8 +572,10 @@ All non-spacing characters have this function in
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
+ (w (lglyph-width glyph))
xoff yoff)
- (when (and class (>= class 200) (<= class 240))
+ (cond
+ ((and class (>= class 200) (<= class 240))
(setq xoff 0 yoff 0)
(cond
((= class 200)
@@ -621,6 +629,38 @@ All non-spacing characters have this function in
rb (+ lb xoff)
as (- as yoff)
de (+ de yoff)))
+ ((and (= class 0)
+ (eq (get-char-code-property (lglyph-char glyph)
+ 'general-category) 'Me))
+ ;; Artificially laying out glyphs in an enclosing
+ ;; mark is difficult. All we can do is to adjust
+ ;; the x-offset and width of the base glyph to
+ ;; 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
+ ;; depending on how the glyph is designed.
+
+ ;; (non-spacing or not). For instance, when we
+ ;; have these glyphs:
+ ;; X position |
+ ;; base: <-*-> lbearing=0 rbearing=5 width=5
+ ;; mark: <----------.> lb=-11 rb=2 w=0
+ ;; we get a correct layout by moving them as this:
+ ;; base: <-*-> XOFF=4 WAD=9
+ ;; mark: <----------.> xoff=2 wad=4
+ ;; we have moved the base to the left by 4-pixel
+ ;; and make its width 9-pixel, then move the mark
+ ;; to the left 2-pixel and make its width 4-pixel.
+ (let* (;; Adjustment for the base glyph
+ (XOFF (/ (- rb lb width) 2))
+ (WAD (+ width XOFF))
+ ;; Adjustment for the enclosing mark glyph
+ (xoff (- (+ lb WAD)))
+ (wad (- rb lb WAD)))
+ (lglyph-set-adjustment glyph xoff 0 wad)
+ (setq glyph (lgstring-glyph gstring 0))
+ (lglyph-set-adjustment glyph XOFF 0 WAD))))
(if (< ascent as)
(setq ascent as))
(if (< descent de)
@@ -631,13 +671,61 @@ All non-spacing characters have this function in
(setq i (1+ i))))
gstring))))))
-(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
- [nil 0 compose-gstring-for-graphic])))
- (map-char-table
- #'(lambda (key val)
- (if (memq val '(Mn Mc Me))
- (set-char-table-range composition-function-table key elt)))
- unicode-category-table))
+(defun compose-gstring-for-dotted-circle (gstring)
+ (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
+ (dc-id (lglyph-code dc))
+ (fc (lgstring-glyph gstring 1)) ; glyph of the following char
+ (fc-id (lglyph-code fc))
+ (gstr (and nil (font-shape-gstring gstring))))
+ (if (and gstr
+ (or (= (lgstring-glyph-len gstr) 1)
+ (and (= (lgstring-glyph-len gstr) 2)
+ (= (lglyph-to (lgstring-glyph gstr 0))
+ (lglyph-to (lgstring-glyph gstr 1))))))
+ ;; It seems that font-shape-gstring has composed glyphs.
+ gstr
+ ;; Artificially compose the following glyph with the preceding
+ ;; dotted-circle.
+ (setq dc (lgstring-glyph gstring 0)
+ fc (lgstring-glyph gstring 1))
+ (let ((dc-width (lglyph-width dc))
+ (fc-width (- (lglyph-rbearing fc) (lglyph-lbearing fc)))
+ (from (lglyph-from dc))
+ (to (lglyph-to fc))
+ (xoff 0) (yoff 0) (width 0))
+ (if (and (< (lglyph-descent fc) 0)
+ (> (lglyph-ascent dc) (- (lglyph-descent fc))))
+ ;; Set YOFF so that the following glyph is put on top of
+ ;; the dotted-circle.
+ (setq yoff (- (- (lglyph-descent fc)) (lglyph-ascent dc))))
+ (if (> (lglyph-width fc) 0)
+ (setq xoff (- (lglyph-rbearing fc))))
+ (if (< dc-width fc-width)
+ ;; The following glyph is wider, but we don't know how to
+ ;; align both glyphs. So, try the easiest method;
+ ;; i.e. align left edges of the glyphs.
+ (setq xoff (- xoff (- dc-width) (- (lglyph-lbearing fc )))
+ width (- fc-width dc-width)))
+ (if (or (/= xoff 0) (/= yoff 0) (/= width 0) (/= (lglyph-width fc) 0))
+ (lglyph-set-adjustment fc xoff yoff width))
+ (lglyph-set-from-to dc from to)
+ (lglyph-set-from-to fc from to))
+ (if (> (lgstring-glyph-len gstring) 2)
+ (lgstring-set-glyph gstring 2 nil))
+ gstring)))
+
+;; Allow for bootstrapping without uni-*.el.
+(when unicode-category-table
+ (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
+ [nil 0 compose-gstring-for-graphic])))
+ (map-char-table
+ #'(lambda (key val)
+ (if (memq val '(Mn Mc Me))
+ (set-char-table-range composition-function-table key elt)))
+ unicode-category-table))
+ ;; for dotted-circle
+ (aset composition-function-table #x25CC
+ `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])))
(defun compose-gstring-for-terminal (gstring)
"Compose glyph-string GSTRING for terminal display.
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index a7718ffb920..856c96dd034 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -1,6 +1,6 @@
;;; cus-dep.el --- find customization dependencies
;;
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
@@ -60,9 +60,10 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
;; Use up command-line-args-left else Emacs can try to open
;; the args as directories after we are done.
(while (setq subdir (pop command-line-args-left))
- (message "Directory %s" subdir)
+ (message "Scanning %s for custom" subdir)
(let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'"))
- (default-directory (expand-file-name subdir))
+ (default-directory
+ (file-name-as-directory (expand-file-name subdir)))
(preloaded (concat "\\`\\(\\./+\\)?"
(regexp-opt preloaded-file-list t)
"\\.el\\'")))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index b50c1a5155b..aa26ac38fc5 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,9 +1,9 @@
-;;; cus-edit.el --- tools for customizing Emacs and Lisp packages
+;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*- lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
@@ -324,7 +324,7 @@
:group 'emacs)
(defgroup help nil
- "Support for on-line help systems."
+ "Support for Emacs help systems."
:group 'emacs)
(defgroup multimedia nil
@@ -477,7 +477,7 @@
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
You can get the original back from the result with:
- (mapconcat 'identity result \"\\|\")
+ (mapconcat \\='identity result \"\\|\")
IF REGEXP is not a string, return it unchanged."
(if (stringp regexp)
@@ -633,7 +633,7 @@ if that fails, the doc string with `custom-guess-doc-alist'."
(setq found (nth 1 current)
names nil)))
(unless found
- (let ((doc (documentation-property symbol 'variable-documentation))
+ (let ((doc (documentation-property symbol 'variable-documentation t))
(docs custom-guess-doc-alist))
(when doc
(while docs
@@ -699,7 +699,7 @@ If `last', order groups after non-groups."
(defun custom-sort-items (items sort-alphabetically order-groups)
"Return a sorted copy of ITEMS.
-ITEMS should be a `custom-group' property.
+ITEMS should be a list of `custom-group' properties.
If SORT-ALPHABETICALLY non-nil, sort alphabetically.
If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
groups after non-groups, if nil do not order groups at all."
@@ -779,7 +779,8 @@ when the action is chosen.")
"Call function FUN on all widgets in `custom-options'.
If there is more than one widget, ask user for confirmation using
the query string QUERY, using `y-or-n-p' if STRONG-QUERY is nil,
-and `yes-or-no-p' otherwise."
+and `yes-or-no-p' otherwise. Return non-nil if the functionality
+has been executed, nil otherwise."
(if (or (and (= 1 (length custom-options))
(memq (widget-type (car custom-options))
'(custom-variable custom-face)))
@@ -892,16 +893,16 @@ making them as if they had never been customized at all."
;; Bind these temporarily.
(let ((custom-reset-standard-variables-list '(t))
(custom-reset-standard-faces-list '(t)))
- (custom-command-apply
- (lambda (widget)
- (and (or (null (widget-get widget :custom-standard-value))
- (widget-apply widget :custom-standard-value))
- (memq (widget-get widget :custom-state)
- '(modified set changed saved rogue))
- (widget-apply widget :custom-mark-to-reset-standard)))
- "The settings will revert to their default values, in this
+ (if (custom-command-apply
+ (lambda (widget)
+ (and (or (null (widget-get widget :custom-standard-value))
+ (widget-apply widget :custom-standard-value))
+ (memq (widget-get widget :custom-state)
+ '(modified set changed saved rogue))
+ (widget-apply widget :custom-mark-to-reset-standard)))
+ "The settings will revert to their default values, in this
and future sessions. Really erase customizations? " t)
- (custom-reset-standard-save-and-update)))
+ (custom-reset-standard-save-and-update))))
;;; The Customize Commands
@@ -1057,8 +1058,8 @@ the resulting list value now. Otherwise, add an entry to
(let ((coding-system-for-read nil))
(customize-save-variable list-var (eval list-var)))
(add-hook 'after-init-hook
- `(lambda ()
- (customize-push-and-save ',list-var ',elts)))))
+ (lambda ()
+ (customize-push-and-save list-var elts)))))
;;;###autoload
(defun customize ()
@@ -1188,8 +1189,8 @@ and `defface'.
For example, the MH-E package updates this alist as follows:
- (add-to-list 'customize-package-emacs-version-alist
- '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
+ (add-to-list \\='customize-package-emacs-version-alist
+ \\='(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
(\"7.0\" . \"22.1\") (\"7.1\" . \"22.1\")
(\"7.2\" . \"22.1\") (\"7.3\" . \"22.1\")
(\"7.4\" . \"22.1\") (\"8.0\" . \"22.1\")))
@@ -1355,12 +1356,10 @@ suggest to customize that face, if it's customizable."
(or (face-at-point t t) "all faces") t)))
(customize-face face t))
-(defalias 'customize-customized 'customize-unsaved)
-
-;;;###autoload
-(defun customize-unsaved ()
- "Customize all options and faces set in this session but not saved."
- (interactive)
+(defun custom-unsaved-options ()
+ "List of options and faces set in this session but not saved.
+Each entry is of the form (SYMBOL TYPE), where TYPE is one of the
+symbols `custom-face' or `custom-variable'."
(let ((found nil))
(mapatoms (lambda (symbol)
(and (or (get symbol 'customized-face)
@@ -1371,6 +1370,15 @@ suggest to customize that face, if it's customizable."
(get symbol 'customized-variable-comment))
(boundp symbol)
(push (list symbol 'custom-variable) found))))
+ found))
+
+(defalias 'customize-customized 'customize-unsaved)
+
+;;;###autoload
+(defun customize-unsaved ()
+ "Customize all options and faces set in this session but not saved."
+ (interactive)
+ (let ((found (custom-unsaved-options)))
(if (not found)
(error "No user options are set but unsaved")
(custom-buffer-create (custom-sort-items found t nil)
@@ -1415,6 +1423,7 @@ suggest to customize that face, if it's customizable."
"*Customize Saved*"))))
(declare-function apropos-parse-pattern "apropos" (pattern))
+(defvar apropos-regexp)
;;;###autoload
(defun customize-apropos (pattern &optional type)
@@ -1431,25 +1440,28 @@ If TYPE is `groups', include only groups."
(require 'apropos)
(unless (memq type '(nil options faces groups))
(error "Invalid setting type %s" (symbol-name type)))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern) ;Sets apropos-regexp by side-effect: Yuck!
(let (found)
(mapatoms
- `(lambda (symbol)
- (when (string-match-p apropos-regexp (symbol-name symbol))
- ,(if (memq type '(nil groups))
- '(if (get symbol 'custom-group)
- (push (list symbol 'custom-group) found)))
- ,(if (memq type '(nil faces))
- '(if (custom-facep symbol)
- (push (list symbol 'custom-face) found)))
- ,(if (memq type '(nil options))
- `(if (and (boundp symbol)
- (eq (indirect-variable symbol) symbol)
- (or (get symbol 'saved-value)
- (custom-variable-p symbol)))
- (push (list symbol 'custom-variable) found))))))
+ (lambda (symbol)
+ (when (string-match-p apropos-regexp (symbol-name symbol))
+ (if (memq type '(nil groups))
+ (if (get symbol 'custom-group)
+ (push (list symbol 'custom-group) found)))
+ (if (memq type '(nil faces))
+ (if (custom-facep symbol)
+ (push (list symbol 'custom-face) found)))
+ (if (memq type '(nil options))
+ (if (and (boundp symbol)
+ (eq (indirect-variable symbol) symbol)
+ (or (get symbol 'saved-value)
+ (custom-variable-p symbol)))
+ (push (list symbol 'custom-variable) found))))))
(unless found
- (error "No customizable %s matching %s" (symbol-name type) pattern))
+ (error "No customizable %s matching %s" (if (not type)
+ "group, face, or option"
+ (symbol-name type))
+ pattern))
(custom-buffer-create
(custom-sort-items found t custom-buffer-order-groups)
"*Customize Apropos*")))
@@ -1472,6 +1484,16 @@ If TYPE is `groups', include only groups."
(interactive (list (apropos-read-pattern "groups")))
(customize-apropos regexp 'groups))
+;;;###autoload
+(defun custom-prompt-customize-unsaved-options ()
+ "Prompt user to customize any unsaved customization options.
+Return non-nil if user chooses to customize, for use in
+`kill-emacs-query-functions'."
+ (not (and (custom-unsaved-options)
+ (yes-or-no-p "Some customized options have not been saved; Examine? ")
+ (customize-unsaved)
+ t)))
+
;;; Buffer.
(defcustom custom-buffer-style 'links
@@ -1526,7 +1548,8 @@ not for everybody."
Optional NAME is the name of the buffer.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
-that option."
+that option.
+DESCRIPTION is unused."
(pop-to-buffer-same-window (custom-get-fresh-buffer (or name "*Customization*")))
(custom-buffer-create-internal options description))
@@ -1576,7 +1599,7 @@ This button will have a menu with all three reset operations."
(defcustom custom-raised-buttons (not (equal (face-valid-attribute-values :box)
'(("unspecified" . unspecified))))
- "If non-nil, indicate active buttons in a `raised-button' style.
+ "If non-nil, indicate active buttons in a raised-button style.
Otherwise use brackets."
:type 'boolean
:version "21.1"
@@ -1621,8 +1644,8 @@ or a regular expression.")
(widget-create
'editable-field
:size 40 :help-echo echo
- :action `(lambda (widget &optional event)
- (customize-apropos (split-string (widget-value widget)))))))
+ :action (lambda (widget &optional _event)
+ (customize-apropos (split-string (widget-value widget)))))))
(widget-insert " ")
(widget-create-child-and-convert
search-widget 'push-button
@@ -1686,7 +1709,7 @@ Operate on all settings in this buffer:\n"))
(mapcar (lambda (entry)
(prog2
(message "Creating customization items ...%2d%%"
- (/ (* 100.0 count) length))
+ (floor (* 100.0 count) length))
(widget-create (nth 1 entry)
:tag (custom-unlispify-tag-name
(nth 0 entry))
@@ -1725,7 +1748,7 @@ Operate on all settings in this buffer:\n"))
on a button to invoke its action.
Invoke [+] to expand a group, and [-] to collapse an expanded group.\n"
(if custom-raised-buttons
- "`Raised' text indicates"
+ "Raised text indicates"
"Square brackets indicate")))
@@ -1930,7 +1953,7 @@ SAVED and set." "\
something in this group has been set and saved.")
(themed "o" custom-themed "\
THEMED." "\
-visible group members are all at standard values.")
+visible group members are set by enabled themes.")
(rogue "@" custom-rogue "\
NO CUSTOMIZATION DATA; not intended to be customized." "\
something in this group is not prepared for customization.")
@@ -1942,7 +1965,7 @@ Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where
STATE is one of the following symbols:
-`nil'
+nil
For internal use, should never occur.
`unknown'
For internal use, should never occur.
@@ -1960,6 +1983,8 @@ STATE is one of the following symbols:
This item is marked for saving.
`rogue'
This item has no customization information.
+`themed'
+ This item was set by an enabled Custom theme.
`standard'
This item is unchanged from the standard setting.
@@ -2432,7 +2457,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
"Return documentation of VARIABLE for use in Custom buffer.
Normally just return the docstring. But if VARIABLE automatically
becomes buffer local when set, append a message to that effect."
- (format "%s%s" (documentation-property variable 'variable-documentation)
+ (format "%s%s" (documentation-property variable 'variable-documentation t)
(if (and (local-variable-if-set-p variable)
(or (not (local-variable-p variable))
(with-temp-buffer
@@ -3090,7 +3115,7 @@ face attributes (as specified by a `default' defface entry)."
widget
(widget-get widget :default-face-attributes)))
entry)
- (unless (looking-back "^ *")
+ (unless (looking-back "^ *" (line-beginning-position))
(insert ?\n))
(insert-char ?\s (widget-get widget :extra-offset))
(if (or alist defaults show-all)
@@ -3965,12 +3990,12 @@ If GROUPS-ONLY is non-nil, return only those members that are groups."
;; (indent (widget-get widget :indent))
(prefix (widget-get widget :custom-prefix))
(buttons (widget-get widget :buttons))
- (tag (widget-get widget :tag))
+ (tag (substitute-command-keys (widget-get widget :tag)))
(symbol (widget-value widget))
(members (custom-group-members symbol
(and (eq custom-buffer-style 'tree)
custom-browse-only-groups)))
- (doc (widget-docstring widget)))
+ (doc (substitute-command-keys (widget-docstring widget))))
(cond ((and (eq custom-buffer-style 'tree)
(eq state 'hidden)
(or members (custom-unloaded-widget-p widget)))
@@ -4352,7 +4377,8 @@ if only the first line of the docstring is shown."))
(defun custom-file (&optional no-error)
"Return the file name for saving customizations."
- (if (null user-init-file)
+ (if (or (null user-init-file)
+ (and (null custom-file) init-file-had-error))
;; Started with -q, i.e. the file containing Custom settings
;; hasn't been read. Saving settings there won't make much
;; sense.
@@ -4381,7 +4407,9 @@ if only the first line of the docstring is shown."))
old-buffer-name)
(with-current-buffer (let ((find-file-visit-truename t))
- (or old-buffer (find-file-noselect filename)))
+ (or old-buffer
+ (let ((delay-mode-hooks t))
+ (find-file-noselect filename))))
;; We'll save using file-precious-flag, so avoid destroying
;; symlinks. (If we're not already visiting the buffer, this is
;; handled by find-file-visit-truename, above.)
@@ -4390,7 +4418,7 @@ if only the first line of the docstring is shown."))
(set-visited-file-name (file-chase-links filename)))
(unless (eq major-mode 'emacs-lisp-mode)
- (emacs-lisp-mode))
+ (delay-mode-hooks (emacs-lisp-mode)))
(let ((inhibit-read-only t)
(print-length nil)
(print-level nil))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index e1f1668d1ad..35c853bd697 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -1,6 +1,6 @@
;;; cus-face.el --- customization support for faces
;;
-;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, faces
@@ -218,6 +218,10 @@
(color :tag "Foreground"
:help-echo "Set foreground color (name or #RRGGBB hex spec)."))
+ (:distant-foreground
+ (color :tag "Distant Foreground"
+ :help-echo "Set distant foreground color (name or #RRGGBB hex spec)."))
+
(:background
(color :tag "Background"
:help-echo "Set background color (name or #RRGGBB hex spec)."))
@@ -285,47 +289,48 @@ If FRAME is nil, use the global defaults for FACE."
;;; Initializing.
(defun custom-set-faces (&rest args)
- "Initialize faces according to user preferences.
-This associates the settings with the `user' theme.
+ "Apply a list of face specs for user customizations.
+This works by calling `custom-theme-set-faces' for the `user'
+theme, a special theme referring to settings made via Customize.
The arguments should be a list where each entry has the form:
(FACE SPEC [NOW [COMMENT]])
-SPEC is stored as the saved value for FACE, as well as the value for the
-`user' theme. The `user' theme is one of the default themes known to Emacs.
-See `custom-known-themes' for more information on the known themes.
-See `custom-theme-set-faces' for more information on the interplay
-between themes and faces.
-See `defface' for the format of SPEC.
-
-If NOW is present and non-nil, FACE is created now, according to SPEC.
-COMMENT is a string comment about FACE."
+See the documentation of `custom-theme-set-faces' for details."
(apply 'custom-theme-set-faces 'user args))
(defun custom-theme-set-faces (theme &rest args)
- "Initialize faces for theme THEME.
-The arguments should be a list where each entry has the form:
+ "Apply a list of face specs associated with theme THEME.
+THEME should be a theme name (a symbol). The special theme named
+`user' refers to user settings applied via Customize.
+
+The remaining ARGS should be a list where each entry is a list of
+the form:
(FACE SPEC [NOW [COMMENT]])
-SPEC is stored as the saved value for FACE, as well as the value for the
-`user' theme. The `user' theme is one of the default themes known to Emacs.
-See `custom-known-themes' for more information on the known themes.
-See `custom-theme-set-faces' for more information on the interplay
-between themes and faces.
-See `defface' for the format of SPEC.
+FACE should be a face name (a symbol). If FACE is a face alias,
+the setting refers to the parent face.
-If NOW is present and non-nil, FACE is created now, according to SPEC.
-COMMENT is a string comment about FACE.
+SPEC should be a face spec. For details, see `defface'.
+
+NOW, if present and non-nil, forces the face settings to take
+immediate effect in the Emacs display; in particular, FACE is
+initialized as a face if it is not yet one. If NOW is omitted or
+nil, the caller is responsible for making the settings take
+effect later, by calling `custom-theme-recalc-face' or
+`face-spec-recalc'.
-Several properties of THEME and FACE are used in the process:
+COMMENT is a string comment about FACE.
-If THEME property `theme-immediate' is non-nil, this is equivalent of
-providing the NOW argument to all faces in the argument list: FACE is
-created now.
+This function works by calling `custom-push-theme' to record each
+SPEC in each FACE's `theme-face' property, and in THEME's
+`theme-settings' property. If FACE has not already been
+customized, it also stores SPEC in the `saved-face' property.
-SPEC itself is saved in FACE property `saved-face' and it is stored in
-FACE's list property `theme-face' \(using `custom-push-theme')."
+If THEME has a non-nil `theme-immediate' property, this is
+equivalent to providing the NOW argument to all faces in the
+argument list."
(custom-check-theme theme)
(let ((immediate (get theme 'theme-immediate)))
(dolist (entry args)
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 24f8ac3bade..dc40ca9321a 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -1,6 +1,6 @@
-;;; cus-start.el --- define customization properties of builtins
+;;; cus-start.el --- define customization properties of builtins -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
@@ -33,6 +33,14 @@
;;; Code:
+(defun minibuffer-prompt-properties--setter (symbol value)
+ (set-default symbol value)
+ (if (memq 'cursor-intangible value)
+ (add-hook 'minibuffer-setup-hook 'cursor-intangible-mode)
+ ;; Removing it is a bit trickier since it could have been added by someone
+ ;; else as well, so let's just not bother.
+ ))
+
;; Elements of this list have the form:
;; SYMBOL GROUP TYPE VERSION REST...
;; SYMBOL is the name of the variable.
@@ -46,7 +54,23 @@
;; :risky - risky-local-variable property
;; :safe - safe-local-variable property
;; :tag - custom-tag property
-(let ((all '(;; alloc.c
+(let (standard native-p prop propval
+ ;; This function turns a value
+ ;; into an expression which produces that value.
+ (quoter (lambda (sexp)
+ ;; FIXME: We'd like to use macroexp-quote here, but cus-start
+ ;; is loaded too early in loadup.el for that.
+ (if (or (memq sexp '(t nil))
+ (keywordp sexp)
+ (and (listp sexp)
+ (memq (car sexp) '(lambda)))
+ (stringp sexp)
+ (numberp sexp))
+ sexp
+ (list 'quote sexp)))))
+ (pcase-dolist
+ (`(,symbol ,group ,type ,version . ,rest)
+ '(;; alloc.c
(gc-cons-threshold alloc integer)
(gc-cons-percentage alloc float)
(garbage-collection-messages alloc boolean)
@@ -145,13 +169,19 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(shell-file-name execute file)
(exec-path execute
(repeat (choice (const :tag "default directory" nil)
- (directory :format "%v"))))
+ (directory :format "%v")))
+ nil
+ :standard
+ (mapcar 'directory-file-name
+ (append (parse-colon-path (getenv "PATH"))
+ (list exec-directory))))
(exec-suffixes execute (repeat string))
;; charset.c
(charset-map-path installation
(repeat (directory :format "%v")))
;; coding.c
(inhibit-eol-conversion mule boolean)
+ (enable-character-translation mule boolean)
(eol-mnemonic-undecided mule string)
;; startup.el fiddles with the values. IMO, would be
;; simpler to just use #ifdefs in coding.c.
@@ -190,7 +220,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(visible-bell display boolean)
(no-redraw-on-reenter display boolean)
- ;; dosfns.c
+ ;; dosfns.c
(dos-display-scancodes display boolean)
(dos-hyper-key keyboard integer)
(dos-super-key keyboard integer)
@@ -198,6 +228,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; editfns.c
(user-full-name mail string)
+ ;; emacs.c
+ (report-emacs-bug-address emacsbug string)
;; eval.c
(max-specpdl-size limits integer)
(max-lisp-eval-depth limits integer)
@@ -267,11 +299,18 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(make-pointer-invisible mouse boolean "23.2")
(menu-bar-mode frames boolean nil
;; FIXME?
-; :initialize custom-initialize-default
+ ;; :initialize custom-initialize-default
:set custom-set-minor-mode)
(tool-bar-mode (frames mouse) boolean nil
-; :initialize custom-initialize-default
+ ;; :initialize custom-initialize-default
:set custom-set-minor-mode)
+ (frame-resize-pixelwise frames boolean "24.4")
+ (frame-inhibit-implied-resize frames
+ (choice
+ (const :tag "Never" nil)
+ (const :tag "Always" t)
+ (repeat (symbol :tag "Parameter")))
+ "25.1")
;; fringe.c
(overflow-newline-into-fringe fringe boolean)
;; image.c
@@ -311,11 +350,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; :format "%[Current dir?%] %v"
;; (const :tag " current dir" nil)
;; (directory :format "%v"))))
+ (load-prefer-newer lisp boolean "24.4")
;; minibuf.c
(enable-recursive-minibuffers minibuffer boolean)
(history-length minibuffer
(choice (const :tag "Infinite" t) integer)
- "22.1")
+ "24.5") ; 30 -> 100
(history-delete-duplicates minibuffer boolean "22.1")
(read-buffer-completion-ignore-case minibuffer boolean "23.1")
@@ -332,19 +372,19 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
:doc "Prevent point from ever entering prompt"
:format "%t%n%h"
:inline t
- (point-entered minibuffer-avoid-prompt)))
+ (cursor-intangible t)))
(repeat :inline t
:tag "Other Properties"
(list :inline t
:format "%v"
(symbol :tag "Property")
(sexp :tag "Value"))))
- "21.1")
+ "21.1"
+ :set minibuffer-prompt-properties--setter)
(minibuffer-auto-raise minibuffer boolean)
;; options property set at end
(read-buffer-function minibuffer
(choice (const nil)
- (function-item iswitchb-read-buffer)
function))
;; msdos.c
(dos-unsupported-char-glyph display integer)
@@ -362,7 +402,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
left)
(const control) (const meta)
(const alt) (const hyper)
- (const super)) "24.0")
+ (const super)) "24.1")
(ns-command-modifier
ns
(choice (const :tag "No modifier" nil)
@@ -376,7 +416,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
left)
(const control) (const meta)
(const alt) (const hyper)
- (const super)) "24.0")
+ (const super)) "24.1")
(ns-alternate-modifier
ns
(choice (const :tag "No modifier (work as alternate/option)" none)
@@ -398,8 +438,11 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const alt) (const hyper)
(const super)) "23.1")
(ns-antialias-text ns boolean "23.1")
- (ns-auto-hide-menu-bar ns boolean "24.0")
+ (ns-auto-hide-menu-bar ns boolean "24.1")
+ (ns-confirm-quit ns boolean "25.1")
(ns-use-native-fullscreen ns boolean "24.4")
+ (ns-use-fullscreen-animation ns boolean "25.1")
+ (ns-use-srgb-colorspace ns boolean "24.4")
;; process.c
(delete-exited-processes processes-basics boolean)
;; syntax.c
@@ -409,6 +452,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
"21.1")
;; term.c
(visible-cursor cursor boolean "22.1")
+ ;; terminal.c
+ (ring-bell-function display
+ (choice
+ (const :tag "Default" nil)
+ (const :tag "Silent" ignore)
+ function))
;; undo.c
(undo-limit undo integer)
(undo-strong-limit undo integer)
@@ -448,6 +497,8 @@ since it could result in memory overflow and make Emacs crash."
:value display-buffer)
(other :tag "Always (t)" :value t))
"24.3")
+ (fast-but-imprecise-scrolling scrolling boolean "25.1")
+ (window-resize-pixelwise windows boolean "24.4")
;; xdisp.c
;; The whitespace group is for whitespace.el.
(show-trailing-whitespace editing-basics boolean nil
@@ -506,7 +557,12 @@ since it could result in memory overflow and make Emacs crash."
(const :tag "Hourglass" :value hourglass)))
(display-hourglass cursor boolean)
(hourglass-delay cursor number)
-
+ (resize-mini-windows
+ windows (choice
+ (const :tag "Off (nil)" :value nil)
+ (const :tag "Fit (t)" :value t)
+ (const :tag "Grow only" :value grow-only))
+ "25.1")
;; xfaces.c
(scalable-fonts-allowed display boolean "22.1")
;; xfns.c
@@ -515,7 +571,6 @@ since it could result in memory overflow and make Emacs crash."
(x-gtk-use-old-file-dialog menu boolean "22.1")
(x-gtk-show-hidden-files menu boolean "22.1")
(x-gtk-file-dialog-help-text menu boolean "22.1")
- (x-gtk-whole-detached-tool-bar x boolean "22.1")
(x-gtk-use-system-tooltips tooltip boolean "23.3")
;; xterm.c
(x-use-underline-position-properties display boolean "22.1")
@@ -526,27 +581,7 @@ since it could result in memory overflow and make Emacs crash."
(x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
(font-use-system-font font-selection boolean "23.2")))
- this symbol group type standard version native-p rest prop propval
- ;; This function turns a value
- ;; into an expression which produces that value.
- (quoter (lambda (sexp)
- (if (or (memq sexp '(t nil))
- (keywordp sexp)
- (and (listp sexp)
- (memq (car sexp) '(lambda)))
- (stringp sexp)
- (numberp sexp))
- sexp
- (list 'quote sexp)))))
- (while all
- (setq this (car all)
- all (cdr all)
- symbol (nth 0 this)
- group (nth 1 this)
- type (nth 2 this)
- version (nth 3 this)
- rest (nthcdr 4 this)
- ;; If we did not specify any standard value expression above,
+ (setq ;; If we did not specify any standard value expression above,
;; use the current value as the standard value.
standard (if (setq prop (memq :standard rest))
(cadr prop)
@@ -604,7 +639,11 @@ since it could result in memory overflow and make Emacs crash."
(put symbol 'custom-set (cadr prop)))
;; Note this is the _only_ initialize property we handle.
(if (eq (cadr (memq :initialize rest)) 'custom-initialize-delay)
- (push symbol custom-delayed-init-variables))
+ ;; These vars are defined early and should hence be initialized
+ ;; early, even if this file happens to be loaded late. so add them
+ ;; to the end of custom-delayed-init-variables. Otherwise,
+ ;; auto-save-file-name-transforms will appear in M-x customize-rogue.
+ (add-to-list 'custom-delayed-init-variables symbol 'append))
;; If this is NOT while dumping Emacs, set up the rest of the
;; customization info. This is the stuff that is not needed
;; until someone does M-x customize etc.
@@ -625,7 +664,6 @@ since it could result in memory overflow and make Emacs crash."
((eq prop :tag)
(put symbol 'custom-tag propval))))))))
-(custom-add-to-group 'iswitchb 'read-buffer-function 'custom-variable)
(custom-add-to-group 'font-lock 'open-paren-in-column-0-is-defun-start
'custom-variable)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index dbe4fa42d8e..3ec0811f218 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -1,9 +1,9 @@
;;; cus-theme.el -- custom theme creation user interface
;;
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
@@ -32,9 +32,11 @@
(defvar custom-new-theme-mode-map
(let ((map (make-keymap)))
- (set-keymap-parent map widget-keymap)
+ (set-keymap-parent map (make-composed-keymap widget-keymap
+ special-mode-map))
(suppress-keymap map)
(define-key map "\C-x\C-s" 'custom-theme-write)
+ (define-key map "q" 'Custom-buffer-done)
(define-key map "n" 'widget-forward)
(define-key map "p" 'widget-backward)
map)
@@ -490,10 +492,10 @@ It includes all faces in list FACES."
'("" "c")))
doc)
(when fn
- (princ " in `")
+ (princ (substitute-command-keys " in `"))
(help-insert-xref-button (file-name-nondirectory fn)
'help-theme-def fn)
- (princ "'"))
+ (princ (substitute-command-keys "'")))
(princ ".\n")
(if (custom-theme-p theme)
(progn
@@ -515,7 +517,7 @@ It includes all faces in list FACES."
(setq doc (nth 2 sexp)))))))
(princ "\n\nDocumentation:\n")
(princ (if (stringp doc)
- doc
+ (substitute-command-keys doc)
"No documentation available.")))
(princ "\n\nYou can ")
(help-insert-xref-button "customize" 'help-theme-edit theme)
@@ -585,7 +587,7 @@ Theme files are named *-theme.el in `"))
:follow-link 'mouse-face
:action (lambda (_widget &rest _ignore)
(describe-variable 'custom-theme-load-path)))
- (widget-insert "'.\n\n")
+ (widget-insert (substitute-command-keys "'.\n\n"))
;; If the user has made customizations, display a warning and
;; provide buttons to disable or convert them.
diff --git a/lisp/custom.el b/lisp/custom.el
index 3db34e4d1fb..afff8674f34 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1,10 +1,10 @@
;;; custom.el --- tools for declaring and initializing options
;;
-;; Copyright (C) 1996-1997, 1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1996-1997, 1999, 2001-2015 Free Software Foundation,
;; Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
;; Package: emacs
@@ -155,15 +155,14 @@ set to nil, as the value is no longer rogue."
(unless (memq :group args)
(custom-add-to-group (custom-current-group) symbol 'custom-variable))
(while args
- (let ((arg (car args)))
- (setq args (cdr args))
- (unless (symbolp arg)
+ (let ((keyword (pop args)))
+ (unless (symbolp keyword)
(error "Junk in args %S" args))
- (let ((keyword arg)
- (value (car args)))
- (unless args
- (error "Keyword %s is missing an argument" keyword))
- (setq args (cdr args))
+ (unless args
+ (error "Keyword %s is missing an argument" keyword))
+ (let ((value (pop args)))
+ ;; Can't use `pcase' because it is loaded after `custom.el'
+ ;; during bootstrap. See `loadup.el'.
(cond ((eq keyword :initialize)
(setq initialize value))
((eq keyword :set)
@@ -232,9 +231,10 @@ The following keywords are meaningful:
given in the `defcustom' call. The default is
`custom-initialize-reset'.
:set VALUE should be a function to set the value of the symbol
- when using the Customize user interface.
- It takes two arguments, the symbol to set and the value to
- give it. The default choice of function is `set-default'.
+ when using the Customize user interface. It takes two arguments,
+ the symbol to set and the value to give it. The function should
+ not modify its value argument destructively. The default choice
+ of function is `set-default'.
:get VALUE should be a function to extract the value of symbol.
The function takes one argument, a symbol, and should return
the current value for that symbol. The default choice of function
@@ -354,7 +354,7 @@ FACE does not need to be quoted.
Third argument DOC is the face documentation.
-If FACE has been set with `custom-set-faces', set the face
+If FACE has been set with `custom-theme-set-faces', set the face
attributes as specified by that function, otherwise set the face
attributes according to SPEC.
@@ -362,7 +362,7 @@ The remaining arguments should have the form [KEYWORD VALUE]...
For a list of valid keywords, see the common keywords listed in
`defcustom'.
-SPEC should be an alist of the form
+SPEC should be a \"face spec\", i.e., an alist of the form
((DISPLAY . ATTS)...)
@@ -410,7 +410,8 @@ In the ATTS property list, possible attributes are `:family',
See Info node `(elisp) Faces' in the Emacs Lisp manual for more
information."
- (declare (doc-string 3))
+ (declare (doc-string 3)
+ (indent 1))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
@@ -447,8 +448,7 @@ information."
;; Record the group on the `current' list.
(let ((elt (assoc load-file-name custom-current-group-alist)))
(if elt (setcdr elt symbol)
- (push (cons (purecopy load-file-name) symbol)
- custom-current-group-alist)))
+ (push (cons load-file-name symbol) custom-current-group-alist)))
(run-hooks 'custom-define-hook)
symbol)
@@ -870,20 +870,21 @@ See `custom-known-themes' for a list of known themes."
(setcar (cdr setting) value)))
;; Add a new setting:
(t
- (unless old
- ;; If the user changed a variable outside of Customize, save
- ;; the value to a fake theme, `changed'. If the theme is
- ;; later disabled, we use this to bring back the old value.
- ;;
- ;; For faces, we just use `face-new-frame-defaults' to
- ;; recompute when the theme is disabled.
- (when (and (eq prop 'theme-value)
- (boundp symbol))
- (let ((sv (get symbol 'standard-value))
- (val (symbol-value symbol)))
- (unless (and sv (equal (eval (car sv)) val))
- (setq old `((changed ,(custom-quote val))))))))
- (put symbol prop (cons (list theme value) old))
+ (unless custom--inhibit-theme-enable
+ (unless old
+ ;; If the user changed a variable outside of Customize, save
+ ;; the value to a fake theme, `changed'. If the theme is
+ ;; later disabled, we use this to bring back the old value.
+ ;;
+ ;; For faces, we just use `face-new-frame-defaults' to
+ ;; recompute when the theme is disabled.
+ (when (and (eq prop 'theme-value)
+ (boundp symbol))
+ (let ((sv (get symbol 'standard-value))
+ (val (symbol-value symbol)))
+ (unless (and sv (equal (eval (car sv)) val))
+ (setq old `((changed ,(custom-quote val))))))))
+ (put symbol prop (cons (list theme value) old)))
(put theme 'theme-settings
(cons (list prop symbol theme value) theme-settings))))))
@@ -1118,7 +1119,7 @@ directory first---see `custom-theme-load-path'."
:group 'customize
:version "22.1")
-(defcustom custom-theme-load-path (list 'custom-theme-directory t)
+(defvar custom-theme-load-path (list 'custom-theme-directory t)
"List of directories to search for custom theme files.
When loading custom themes (e.g. in `customize-themes' and
`load-theme'), Emacs searches for theme files in the specified
@@ -1130,13 +1131,11 @@ order. Each element in the list should be one of the following:
- a directory name (a string).
Each theme file is named THEME-theme.el, where THEME is the theme
-name."
- :type '(repeat (choice (const :tag "custom-theme-directory"
- custom-theme-directory)
- (const :tag "Built-in theme directory" t)
- directory))
- :group 'customize
- :version "24.1")
+name.
+
+This variable is designed for use in lisp code (including
+external packages). For manual user customizations, use
+`custom-theme-directory' instead.")
(defvar custom--inhibit-theme-enable nil
"Whether the custom-theme-set-* functions act immediately.
@@ -1212,13 +1211,11 @@ Return t if THEME was successfully loaded, nil otherwise."
(put theme 'theme-documentation nil))
(let ((fn (locate-file (concat (symbol-name theme) "-theme.el")
(custom-theme--load-path)
- '("" "c")))
- hash)
+ '("" "c"))))
(unless fn
(error "Unable to find theme file for `%s'" theme))
(with-temp-buffer
(insert-file-contents fn)
- (setq hash (secure-hash 'sha256 (current-buffer)))
;; Check file safety with `custom-safe-themes', prompting the
;; user if necessary.
(when (or no-confirm
@@ -1226,8 +1223,9 @@ Return t if THEME was successfully loaded, nil otherwise."
(and (memq 'default custom-safe-themes)
(equal (file-name-directory fn)
(expand-file-name "themes/" data-directory)))
- (member hash custom-safe-themes)
- (custom-theme-load-confirm hash))
+ (let ((hash (secure-hash 'sha256 (current-buffer))))
+ (or (member hash custom-safe-themes)
+ (custom-theme-load-confirm hash))))
(let ((custom--inhibit-theme-enable t)
(buffer-file-name fn)) ;For load-history.
(eval-buffer))
@@ -1277,7 +1275,14 @@ NAME should be a symbol."
(eq name 'changed)))))
(defun custom-available-themes ()
- "Return a list of available Custom themes (symbols)."
+ "Return a list of Custom themes available for loading.
+Search the directories specified by `custom-theme-load-path' for
+files named FOO-theme.el, and return a list of FOO symbols.
+
+The returned symbols may not correspond to themes that have been
+loaded, and no effort is made to check that the files contain
+valid Custom themes. For a list of loaded themes, check the
+variable `custom-known-themes'."
(let (sym themes)
(dolist (dir (custom-theme--load-path))
(when (file-directory-p dir)
@@ -1416,6 +1421,10 @@ See `custom-enabled-themes' for a list of enabled themes."
(setq custom-enabled-themes
(delq theme custom-enabled-themes)))))
+;; Only used if window-system not null.
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
+
(defun custom--frame-color-default (frame attribute resource-attr resource-class
tty-default x-default)
(let ((col (face-attribute 'default attribute t)))
@@ -1448,12 +1457,15 @@ This function returns nil if no custom theme specifies a value for VARIABLE."
(eval (car valspec))))))
(defun custom-theme-recalc-face (face)
- "Set FACE according to currently enabled custom themes."
+ "Set FACE according to currently enabled custom themes.
+If FACE is not initialized as a face, do nothing; otherwise call
+`face-spec-recalc' to recalculate the face on all frames."
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
- ;; Reset the faces for each frame.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame)))
+ (if (facep face)
+ ;; Reset the faces for each frame.
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame))))
;;; XEmacs compatibility functions
@@ -1486,11 +1498,6 @@ This means reset VARIABLE. (The argument IGNORED is ignored)."
;;; The End.
-;; Process the defcustoms for variables loaded before this file.
-(while custom-declare-variable-list
- (apply 'custom-declare-variable (car custom-declare-variable-list))
- (setq custom-declare-variable-list (cdr custom-declare-variable-list)))
-
(provide 'custom)
;;; custom.el ends here
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index e2aeb4ea19b..b32d115d499 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -1,6 +1,6 @@
;;; dabbrev.el --- dynamic abbreviation package -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2013 Free
+;; Copyright (C) 1985-1986, 1992, 1994, 1996-1997, 2000-2015 Free
;; Software Foundation, Inc.
;; Author: Don Morrison
@@ -120,7 +120,7 @@
Example: Set this to \"\\\\$\" for programming languages
in which variable names may appear with or without a leading `$'.
-\(For example, in Makefiles.\)
+\(For example, in Makefiles.)
Set this to nil if no characters should be skipped."
:type '(choice regexp
@@ -285,6 +285,7 @@ A mode setting this variable should make it buffer local."
If this variable is non-nil, dabbrev will only look in these buffers.
It will not even look in the current buffer if it is not a member of
this list."
+ :type '(choice (const nil) (repeat :tag "List of buffers" string))
:group 'dabbrev)
;;----------------------------------------------------------------
@@ -533,7 +534,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
(if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found)
(minibuffer-window-active-p (selected-window))))
(progn
- (message "Expansion found in '%s'"
+ (message "Expansion found in `%s'"
(buffer-name dabbrev--last-buffer))
(setq dabbrev--last-buffer-found dabbrev--last-buffer))
(message nil))
diff --git a/lisp/delim-col.el b/lisp/delim-col.el
index 02721a64fd6..bb4b5f4ab66 100644
--- a/lisp/delim-col.el
+++ b/lisp/delim-col.el
@@ -1,6 +1,6 @@
;;; delim-col.el --- prettify all columns in a region or rectangle
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -179,11 +179,11 @@ Valid values are:
`delimit-columns-separator' and then followed by spaces.
For example, the result is: \"<ccc>: <dddd>: \"
- 'separator align separators. That is, `delimit-columns-after' is followed
+ `separator' align separators. That is, `delimit-columns-after' is followed
by spaces and then followed by `delimit-columns-separator'.
For example, the result is: \"<ccc> :<dddd> :\"
- 'padding format column by filling with spaces before
+ `padding' format column by filling with spaces before
`delimit-columns-after'. That is, spaces are followed by
`delimit-columns-after' and then followed by
`delimit-columns-separator'.
diff --git a/lisp/delsel.el b/lisp/delsel.el
index 672c93443d8..586c130020b 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -1,10 +1,10 @@
-;;; delsel.el --- delete selection if you insert
+;;; delsel.el --- delete selection if you insert -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1997-1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1997-1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Matthieu Devin <devin@lucid.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 14 Jul 92
;; Keywords: convenience emulations
@@ -35,25 +35,25 @@
;; property on their symbols; commands which insert text but don't
;; have this property won't delete the selection. It can be one of
;; the values:
-;; 'yank
+;; `yank'
;; For commands which do a yank; ensures the region about to be
;; deleted isn't yanked.
-;; 'supersede
+;; `supersede'
;; Delete the active region and ignore the current command,
;; i.e. the command will just delete the region.
-;; 'kill
-;; `kill-region' is used on the selection, rather than
-;; `delete-region'. (Text selected with the mouse will typically
-;; be yankable anyhow.)
;; t
;; The normal case: delete the active region prior to executing
;; the command which will insert replacement text.
;; <function>
-;; For commands which need to dynamically determine this behaviour.
+;; For commands which need to dynamically determine this behavior.
;; The function should return one of the above values or nil.
;;; Code:
+(defvar delete-selection-save-to-register nil
+ "If non-nil, deleted region text is stored in this register.
+Value must be the register (key) to use.")
+
;;;###autoload
(defalias 'pending-delete-mode 'delete-selection-mode)
@@ -64,23 +64,84 @@ With a prefix argument ARG, enable Delete Selection mode if ARG
is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
-When Delete Selection mode is enabled, Transient Mark mode is also
-enabled and typed text replaces the selection if the selection is
-active. Otherwise, typed text is just inserted at point regardless of
-any selection."
+When Delete Selection mode is enabled, typed text replaces the selection
+if the selection is active. Otherwise, typed text is just inserted at
+point regardless of any selection."
:global t :group 'editing-basics
(if (not delete-selection-mode)
(remove-hook 'pre-command-hook 'delete-selection-pre-hook)
- (add-hook 'pre-command-hook 'delete-selection-pre-hook)
- (transient-mark-mode t)))
+ (add-hook 'pre-command-hook 'delete-selection-pre-hook)))
+
+(defvar delsel--replace-text-or-position nil)
(defun delete-active-region (&optional killp)
"Delete the active region.
If KILLP in not-nil, the active region is killed instead of deleted."
- (if killp
- (kill-region (point) (mark))
- (delete-region (point) (mark)))
- t)
+ (cond
+ (killp
+ ;; Don't allow `kill-region' to change the value of `this-command'.
+ (let (this-command)
+ (kill-region (point) (mark) t)))
+ (delete-selection-save-to-register
+ (set-register delete-selection-save-to-register
+ (funcall region-extract-function t))
+ (setq delsel--replace-text-or-position
+ (cons (current-buffer)
+ (and (consp buffer-undo-list) (car buffer-undo-list)))))
+ (t
+ (funcall region-extract-function 'delete-only))))
+
+(defun delete-selection-repeat-replace-region (arg)
+ "Repeat replacing text of highlighted region with typed text.
+Search for the next stretch of text identical to the region last replaced
+by typing text over it and replaces it with the same stretch of text.
+With ARG, repeat that many times. `C-u' means until end of buffer."
+ (interactive "P")
+ (let ((old-text (and delete-selection-save-to-register
+ (get-register delete-selection-save-to-register)))
+ (count (if (consp arg) (point-max)
+ (prefix-numeric-value current-prefix-arg))))
+ (if (not (and old-text
+ (> (length old-text) 0)
+ (or (stringp delsel--replace-text-or-position)
+ (buffer-live-p (car delsel--replace-text-or-position)))))
+ (message "No known previous replacement")
+ ;; If this is the first use after overwriting regions,
+ ;; find the replacement text by looking at the undo list.
+ (when (consp delsel--replace-text-or-position)
+ (let ((buffer (car delsel--replace-text-or-position))
+ (elt (cdr delsel--replace-text-or-position)))
+ (setq delsel--replace-text-or-position nil)
+ (with-current-buffer buffer
+ (save-restriction
+ (widen)
+ ;; Find the text that replaced the region via the undo list.
+ (let ((ul buffer-undo-list) u s e)
+ (when elt
+ (while (consp ul)
+ (setq u (car ul) ul (cdr ul))
+ (cond
+ ((eq u elt) ;; got it
+ (setq ul nil))
+ ((and (consp u) (integerp (car u)) (integerp (cdr u)))
+ (if (and s (= (cdr u) s))
+ (setq s (car u))
+ (setq s (car u) e (cdr u)))))))
+ (cond ((and s e (<= s e) (= s (mark t)))
+ (setq delsel--replace-text-or-position
+ (filter-buffer-substring s e))
+ (set-text-properties
+ 0 (length delsel--replace-text-or-position)
+ nil delsel--replace-text-or-position))
+ ((and (null s) (eq u elt)) ;; Nothing inserted.
+ (setq delsel--replace-text-or-position ""))
+ (t
+ (message "Cannot locate replacement text"))))))))
+ (while (and (> count 0)
+ delsel--replace-text-or-position
+ (search-forward old-text nil t))
+ (replace-match delsel--replace-text-or-position nil t)
+ (setq count (1- count))))))
(defun delete-selection-helper (type)
"Delete selection according to TYPE:
@@ -98,11 +159,17 @@ If KILLP in not-nil, the active region is killed instead of deleted."
The normal case: delete the active region prior to executing
the command which will insert replacement text.
FUNCTION
- For commands which need to dynamically determine this behaviour.
+ For commands which need to dynamically determine this behavior.
FUNCTION should take no argument and return one of the above values or nil."
(condition-case data
- (cond ((eq type 'kill)
- (delete-active-region t))
+ (cond ((eq type 'kill) ;Deprecated, backward compatibility.
+ (delete-active-region t)
+ (if (and overwrite-mode
+ (eq this-command 'self-insert-command))
+ (let ((overwrite-mode nil))
+ (self-insert-command
+ (prefix-numeric-value current-prefix-arg))
+ (setq this-command 'ignore))))
((eq type 'yank)
;; Before a yank command, make sure we don't yank the
;; head of the kill-ring that really comes from the
@@ -114,7 +181,11 @@ If KILLP in not-nil, the active region is killed instead of deleted."
(fboundp 'mouse-region-match)
(mouse-region-match))
(current-kill 1))
- (delete-active-region))
+ (let ((pos (copy-marker (region-beginning))))
+ (delete-active-region)
+ ;; If the region was, say, rectangular, make sure we yank
+ ;; from the top, to "replace".
+ (goto-char pos)))
((eq type 'supersede)
(let ((empty-region (= (point) (mark))))
(delete-active-region)
@@ -160,24 +231,33 @@ See `delete-selection-helper'."
(delete-selection-helper (and (symbolp this-command)
(get this-command 'delete-selection)))))
-(put 'self-insert-command 'delete-selection
- (lambda ()
- (not (run-hook-with-args-until-success
- 'self-insert-uses-region-functions))))
+(defun delete-selection-uses-region-p ()
+ "Return t when the current command will be using the region
+rather than having `delete-selection' delete it, nil otherwise.
+
+This function is intended for use as the value of the
+`delete-selection' property of a command, and shouldn't be used
+for anything else."
+ (not (run-hook-with-args-until-success
+ 'self-insert-uses-region-functions)))
-(put 'self-insert-iso 'delete-selection t)
+(put 'self-insert-command 'delete-selection 'delete-selection-uses-region-p)
+
+(put 'insert-char 'delete-selection t)
+(put 'quoted-insert 'delete-selection t)
(put 'yank 'delete-selection 'yank)
(put 'clipboard-yank 'delete-selection 'yank)
(put 'insert-register 'delete-selection t)
-
-(put 'delete-backward-char 'delete-selection 'supersede)
-(put 'backward-delete-char-untabify 'delete-selection 'supersede)
+;; delete-backward-char and delete-forward-char already delete the selection by
+;; default, but not delete-char.
(put 'delete-char 'delete-selection 'supersede)
+(put 'reindent-then-newline-and-indent 'delete-selection t)
(put 'newline-and-indent 'delete-selection t)
(put 'newline 'delete-selection t)
-(put 'open-line 'delete-selection 'kill)
+(put 'electric-newline-and-maybe-indent 'delete-selection t)
+(put 'open-line 'delete-selection t)
;; This is very useful for canceling a selection in the minibuffer without
;; aborting the minibuffer.
@@ -186,7 +266,7 @@ See `delete-selection-helper'."
In Delete Selection mode, if the mark is active, just deactivate it;
then it takes a second \\[keyboard-quit] to abort the minibuffer."
(interactive)
- (if (and delete-selection-mode transient-mark-mode mark-active)
+ (if (and delete-selection-mode (region-active-p))
(setq deactivate-mark t)
(abort-recursive-edit)))
@@ -203,9 +283,9 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer."
(define-key minibuffer-local-completion-map "\C-g" 'abort-recursive-edit)
(define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit)
(define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit)
- (dolist (sym '(self-insert-command self-insert-iso yank clipboard-yank
- insert-register delete-backward-char backward-delete-char-untabify
- delete-char newline-and-indent newline open-line))
+ (dolist (sym '(self-insert-command insert-char quoted-insert yank
+ clipboard-yank insert-register newline-and-indent
+ reindent-then-newline-and-indent newline open-line))
(put sym 'delete-selection nil))
;; continue standard unloading
nil)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 774ee92a146..be69a0b27d8 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -1,9 +1,9 @@
-;;; descr-text.el --- describe text mode
+;;; descr-text.el --- describe text mode -*- lexical-binding:t -*-
-;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: faces, i18n, Unicode, multilingual
;; This file is part of GNU Emacs.
@@ -23,7 +23,7 @@
;;; Commentary:
-;;; Describe-Text Mode.
+;; Describe-Text Mode.
;;; Code:
@@ -36,8 +36,7 @@
"Insert text to describe WIDGET in the current buffer."
(insert-text-button
(symbol-name (if (symbolp widget) widget (car widget)))
- 'action `(lambda (&rest ignore)
- (widget-browse ',widget))
+ 'action (lambda (&rest _ignore) (widget-browse widget))
'help-echo "mouse-2, RET: browse this widget")
(insert " ")
(insert-text-button
@@ -55,10 +54,10 @@
(<= (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]" '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)
@@ -81,8 +80,8 @@ into help buttons that call `describe-text-category' or
(cond ((eq key 'category)
(insert-text-button
(symbol-name value)
- 'action `(lambda (&rest ignore)
- (describe-text-category ',value))
+ 'action (lambda (&rest _ignore)
+ (describe-text-category value))
'follow-link t
'help-echo "mouse-2, RET: describe this category"))
((memq key '(face font-lock-face mouse-face))
@@ -162,8 +161,8 @@ otherwise."
;; Buttons
(when (and button (not (widgetp wid-button)))
(newline)
- (insert "Here is a `" (format "%S" button-type)
- "' button labeled `" button-label "'.\n\n"))
+ (insert (format-message "Here is a `%S' button labeled `%s'.\n\n"
+ button-type button-label)))
;; Overlays
(when overlays
(newline)
@@ -435,13 +434,26 @@ relevant to POS."
code (encode-char char charset)))
(setq code char))
(cond
- ;; Append a PDF character to directional embeddings and
- ;; overrides, to prevent potential messup of the following
- ;; text.
- ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e))
+ ;; Append a PDF character to left-to-right directional
+ ;; embeddings and overrides, to prevent potential messup of the
+ ;; following text.
+ ((memq char '(?\x202a ?\x202d))
(setq char-description
(concat char-description
(propertize (string ?\x202c) 'invisible t))))
+ ;; Append a PDF character followed by LRM to right-to-left
+ ;; directional embeddings and overrides, to prevent potential
+ ;; messup of the following numerical text.
+ ((memq char '(?\x202b ?\x202e))
+ (setq char-description
+ (concat char-description
+ (propertize (string ?\x202c ?\x200e) 'invisible t))))
+ ;; Append a PDI character to directional isolate initiators, to
+ ;; prevent potential messup of the following numerical text
+ ((memq char '(?\x2066 ?\x2067 ?\x2068))
+ (setq char-description
+ (concat char-description
+ (propertize (string ?\x2069) 'invisible t))))
;; Append a LRM character to any strong character to avoid
;; messing up the numerical codepoint.
((memq (get-char-code-property char 'bidi-class) '(R AL))
@@ -527,9 +539,7 @@ relevant to POS."
,(let* ((beg (point-min))
(end (point-max))
(total (buffer-size))
- (percent (if (> total 50000) ; Avoid overflow multiplying by 100
- (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
- (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
+ (percent (round (* 100.0 (1- pos)) (max total 1)))
(hscroll (if (= (window-hscroll) 0)
""
(format ", Hscroll: %d" (window-hscroll))))
@@ -606,7 +616,14 @@ relevant to POS."
'help-args '(,current-input-method))
"input method")
(list
- "type \"C-x 8 RET HEX-CODEPOINT\" or \"C-x 8 RET NAME\"")))))
+ (let ((name
+ (or (get-char-code-property char 'name)
+ (get-char-code-property char 'old-name))))
+ (if name
+ (format
+ "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\""
+ char name)
+ (format "type \"C-x 8 RET %x\"" char))))))))
("buffer code"
,(if multibyte-p
(encoded-string-description
@@ -663,7 +680,7 @@ relevant to POS."
((and (< char 32) (not (memq char '(9 10))))
'escape-glyph)))))
(if face (list (list "hardcoded face"
- `(insert-text-button
+ `(insert-text-button ;FIXME: Wrap in lambda!
,(symbol-name face)
'type 'help-face
'help-args '(,face))))))
@@ -707,26 +724,17 @@ relevant to POS."
(when disp-vector
(insert
"\nThe display table entry is displayed by ")
- (if (display-graphic-p (selected-frame))
- (progn
- (insert "these fonts (glyph codes):\n")
- (dotimes (i (length disp-vector))
- (insert (glyph-char (car (aref disp-vector i))) ?:
- (propertize " " 'display '(space :align-to 5))
- (or (cdr (aref disp-vector i)) "-- no font --")
- "\n")
- (let ((face (glyph-face (car (aref disp-vector i)))))
- (when face
- (insert (propertize " " 'display '(space :align-to 5))
- "face: ")
- (insert (concat "`" (symbol-name face) "'"))
- (insert "\n")))))
- (insert "these terminal codes:\n")
- (dotimes (i (length disp-vector))
- (insert (car (aref disp-vector i))
- (propertize " " 'display '(space :align-to 5))
- (or (cdr (aref disp-vector i)) "-- not encodable --")
- "\n"))))
+ (insert "these fonts (glyph codes):\n")
+ (dotimes (i (length disp-vector))
+ (insert (glyph-char (car (aref disp-vector i))) ?:
+ (propertize " " 'display '(space :align-to 5))
+ (or (cdr (aref disp-vector i)) "-- no font --")
+ "\n")
+ (let ((face (glyph-face (car (aref disp-vector i)))))
+ (when face
+ (insert (propertize " " 'display '(space :align-to 5))
+ "face: ")
+ (insert (format-message "`%s'\n" face))))))
(when composition
(insert "\nComposed")
@@ -783,7 +791,8 @@ relevant to POS."
(insert "\n " (car elt) ":"
(propertize " " 'display '(space :align-to 4))
(or (cdr elt) "-- not encodable --"))))
- (insert "\nSee the variable `reference-point-alist' for "
+ (insert (substitute-command-keys
+ "\nSee the variable `reference-point-alist' for ")
"the meaning of the rule.\n")))
(unless eight-bit-p
@@ -813,6 +822,102 @@ relevant to POS."
(define-obsolete-function-alias 'describe-char-after 'describe-char "22.1")
+;;; Describe-Char-ElDoc
+
+(defun describe-char-eldoc--truncate (name width)
+ "Truncate NAME at white spaces such that it is no longer than WIDTH.
+
+Split NAME on white space character and return string with as
+many leading words of NAME as possible without exceeding WIDTH
+characters. If NAME consists of white space characters only,
+return an empty string. Three dots (\"...\") are appended to
+returned string if some of the words from NAME have been omitted.
+
+NB: Function may return string longer than WIDTH if name consists
+of a single word, or it's first word is longer than WIDTH
+characters."
+ (let ((words (split-string name)))
+ (if words
+ (let ((last words))
+ (setq width (- width (length (car words))))
+ (while (and (cdr last)
+ (<= (+ (length (cadr last)) (if (cddr last) 4 1)) width))
+ (setq last (cdr last))
+ (setq width (- width (length (car last)) 1)))
+ (let ((ellipsis (and (cdr last) "...")))
+ (setcdr last nil)
+ (concat (mapconcat 'identity words " ") ellipsis)))
+ "")))
+
+(defun describe-char-eldoc--format (ch &optional width)
+ "Format a description for character CH which is no more than WIDTH characters.
+
+Full description message has a \"U+HEX: NAME (GC: GENERAL-CATEGORY)\"
+format where:
+- HEX is a hexadecimal codepoint of the character (zero-padded to at
+ least four digits),
+- NAME is name of the character.
+- GC is a two-letter abbreviation of the general-category of the
+ character, and
+- GENERAL-CATEGORY is full name of the general-category of the
+ character.
+
+If WIDTH is non-nil some elements of the description may be
+omitted to accommodate the length restriction. Under certain
+condition, the function may return string longer than WIDTH, see
+`describe-char-eldoc--truncate'."
+ (let ((name (get-char-code-property ch 'name)))
+ (when name
+ (let* ((code (propertize (format "U+%04X" ch)
+ 'face 'font-lock-constant-face))
+ (gc (get-char-code-property ch 'general-category))
+ (gc-desc (char-code-property-description 'general-category gc)))
+
+ (unless (or (not width) (<= (length name) width))
+ (setq name (describe-char-eldoc--truncate name width)))
+ (setq name (concat (substring name 0 1) (downcase (substring name 1))))
+ (setq name (propertize name 'face 'font-lock-variable-name-face))
+
+ (setq gc (propertize (symbol-name gc) 'face 'font-lock-comment-face))
+ (when gc-desc
+ (setq gc-desc (propertize gc-desc 'face 'font-lock-comment-face)))
+
+ (let ((lcode (length code))
+ (lname (length name))
+ (lgc (length gc))
+ (lgc-desc (and gc-desc (length gc-desc))))
+ (cond
+ ((and gc-desc
+ (or (not width) (<= (+ lcode lname lgc lgc-desc 7) width)))
+ (concat code ": " name " (" gc ": " gc-desc ")"))
+ ((and gc-desc (<= (+ lcode lname lgc-desc 5) width))
+ (concat code ": " name " (" gc-desc ")"))
+ ((or (not width) (<= (+ lcode lname lgc 5) width))
+ (concat code ": " name " (" gc ")"))
+ ((<= (+ lname lgc 3) width)
+ (concat name " (" gc ")"))
+ (t name)))))))
+
+;;;###autoload
+(defun describe-char-eldoc ()
+ "Return a description of character at point for use by ElDoc mode.
+
+Return nil if character at point is a printable ASCII
+character (i.e. codepoint between 32 and 127 inclusively).
+Otherwise return a description formatted by
+`describe-char-eldoc--format' function taking into account value
+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."
+ (let ((ch (following-char)))
+ (when (and (not (zerop ch)) (or (< ch 32) (> ch 127)))
+ (describe-char-eldoc--format
+ ch
+ (unless (eq eldoc-echo-area-use-multiline-p t)
+ (1- (window-width (minibuffer-window))))))))
+
(provide 'descr-text)
;;; descr-text.el ends here
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 1bbc33cb244..e95a8c9288b 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1,6 +1,6 @@
;;; desktop.el --- save partial status of Emacs when killed -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993-1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Morten Welinder <terra@diku.dk>
@@ -83,8 +83,10 @@
;; (add-to-list 'desktop-minor-mode-handlers
;; '(bar-mode . bar-desktop-restore))
-;; in the module itself, and make sure that the mode function is
-;; autoloaded. See the docstrings of `desktop-buffer-mode-handlers' and
+;; in the module itself. The mode function must either be autoloaded,
+;; or of the form "foobar-mode" and defined in library "foobar", so that
+;; desktop can guess how to load its definition.
+;; See the docstrings of `desktop-buffer-mode-handlers' and
;; `desktop-minor-mode-handlers' for more info.
;; Minor modes.
@@ -124,7 +126,7 @@
;; f89-kam@nada.kth.se (Klas Mellbourn) for a mh-e tip.
;; kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt.
;; treese@lcs.mit.edu (Win Treese) for ange-ftp tips.
-;; pot@cnuce.cnr.it (Francesco Potorti`) for misc. tips.
+;; pot@cnuce.cnr.it (Francesco Potortì) for misc. tips.
;; ---------------------------------------------------------------------------
;; TODO:
;;
@@ -136,7 +138,7 @@
(require 'cl-lib)
(require 'frameset)
-(defvar desktop-file-version "206"
+(defvar desktop-file-version "208"
"Version number of desktop file format.
Written into the desktop file and used at desktop read to provide
backward compatibility.")
@@ -154,15 +156,29 @@ backward compatibility.")
;;;###autoload
(define-minor-mode desktop-save-mode
"Toggle desktop saving (Desktop Save mode).
-With a prefix argument ARG, enable Desktop Save mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+With a prefix argument ARG, enable Desktop Save mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode if ARG
+is omitted or nil.
-If Desktop Save mode is enabled, the state of Emacs is saved from
-one session to another. See variable `desktop-save' and function
-`desktop-read' for details."
+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
+it exits (this may prompt you; see the option `desktop-save'). The next
+time Emacs starts, if this mode is active it will restore the desktop.
+
+To manually save the desktop at any time, use the command `\\[desktop-save]'.
+To load it, use `\\[desktop-read]'.
+
+Once a desktop file exists, Emacs will auto-save it according to the
+option `desktop-auto-save-timeout'.
+
+To see all the options you can set, browse the `desktop' customization group.
+
+For further details, see info node `(emacs)Saving Emacs Sessions'."
:global t
- :group 'desktop)
+ :group 'desktop
+ (if desktop-save-mode
+ (desktop-auto-save-enable)
+ (desktop-auto-save-disable)))
(defun desktop-save-mode-off ()
"Disable `desktop-save-mode'. Provided for use in hooks."
@@ -192,14 +208,19 @@ determine where the desktop is saved."
:group 'desktop
:version "22.1")
-(defcustom desktop-auto-save-timeout nil
- "Number of seconds between auto-saves of the desktop.
-Zero or nil means disable timer-based auto-saving."
+(defcustom desktop-auto-save-timeout auto-save-timeout
+ "Number of seconds idle time before auto-save of the desktop.
+The idle timer activates auto-saving only when window configuration changes.
+This applies to an existing desktop file when `desktop-save-mode' is enabled.
+Zero or nil means disable auto-saving due to idleness."
:type '(choice (const :tag "Off" nil)
(integer :tag "Seconds"))
:set (lambda (symbol value)
(set-default symbol value)
- (ignore-errors (desktop-auto-save-set-timer)))
+ (ignore-errors
+ (if (and (integerp value) (> value 0))
+ (desktop-auto-save-enable value)
+ (desktop-auto-save-disable))))
:group 'desktop
:version "24.4")
@@ -350,11 +371,11 @@ modes are restored automatically; they should not be listed here."
:type '(repeat symbol)
:group 'desktop)
-(defcustom desktop-buffers-not-to-save nil
+(defcustom desktop-buffers-not-to-save "\\` "
"Regexp identifying buffers that are to be excluded from saving."
:type '(choice (const :tag "None" nil)
regexp)
- :version "23.2" ; set to nil
+ :version "24.4" ; skip invisible temporary buffers
:group 'desktop)
;; Skip tramp and ange-ftp files
@@ -373,37 +394,42 @@ modes are restored automatically; they should not be listed here."
:group 'desktop)
(defcustom desktop-restore-frames t
- "When non-nil, save frames to desktop file."
+ "When non-nil, save and restore the frame and window configuration.
+See related options `desktop-restore-reuses-frames',
+`desktop-restore-in-current-display', and `desktop-restore-forces-onscreen'."
:type 'boolean
:group 'desktop
:version "24.4")
(defcustom desktop-restore-in-current-display nil
- "If t, frames are restored in the current display.
-If nil, frames are restored, if possible, in their original displays.
-If `delete', frames on other displays are deleted instead of restored."
+ "Controls how restoring of frames treats displays.
+If t, restores frames into the current display.
+If nil, restores frames into their original displays (if possible).
+If `delete', deletes frames on other displays instead of restoring them."
:type '(choice (const :tag "Restore in current display" t)
(const :tag "Restore in original display" nil)
- (const :tag "Delete frames in other displays" 'delete))
+ (const :tag "Delete frames in other displays" delete))
:group 'desktop
:version "24.4")
(defcustom desktop-restore-forces-onscreen t
- "If t, offscreen frames are restored onscreen instead.
-If `:all', frames that are partially offscreen are also forced onscreen.
-NOTE: Checking of frame boundaries is only approximate and can fail
-to reliably detect frames whose onscreen/offscreen state depends on a
-few pixels, especially near the right / bottom borders of the screen."
+ "If t, restores frames that are fully offscreen onscreen instead.
+If `all', also restores frames that are partially offscreen onscreen.
+
+Note that checking of frame boundaries is only approximate.
+It can fail to reliably detect frames whose onscreen/offscreen state
+depends on a few pixels, especially near the right / bottom borders
+of the screen."
:type '(choice (const :tag "Only fully offscreen frames" t)
- (const :tag "Also partially offscreen frames" :all)
+ (const :tag "Also partially offscreen frames" all)
(const :tag "Do not force frames onscreen" nil))
:group 'desktop
:version "24.4")
(defcustom desktop-restore-reuses-frames t
"If t, restoring frames reuses existing frames.
-If nil, existing frames are deleted.
-If `:keep', existing frames are kept and not reused."
+If nil, deletes existing frames.
+If `keep', keeps existing frames and does not reuse them."
:type '(choice (const :tag "Reuse existing frames" t)
(const :tag "Delete existing frames" nil)
(const :tag "Keep existing frames" :keep))
@@ -477,13 +503,13 @@ Handlers are called with argument list
Furthermore, they may use the following variables:
- desktop-file-version
- desktop-buffer-major-mode
- desktop-buffer-minor-modes
- desktop-buffer-point
- desktop-buffer-mark
- desktop-buffer-read-only
- desktop-buffer-locals
+ `desktop-file-version'
+ `desktop-buffer-major-mode'
+ `desktop-buffer-minor-modes'
+ `desktop-buffer-point'
+ `desktop-buffer-mark'
+ `desktop-buffer-read-only'
+ `desktop-buffer-locals'
If a handler returns a buffer, then the saved mode settings
and variable values for that buffer are copied into it.
@@ -496,7 +522,9 @@ code like
(add-to-list 'desktop-buffer-mode-handlers
'(foo-mode . foo-restore-desktop-buffer))
-Furthermore the major mode function must be autoloaded.")
+The major mode function must either be autoloaded, or of the form
+\"foobar-mode\" and defined in library \"foobar\", so that desktop
+can guess how to load the mode's definition.")
;;;###autoload
(put 'desktop-buffer-mode-handlers 'risky-local-variable t)
@@ -505,6 +533,8 @@ Furthermore the major mode function must be autoloaded.")
(defcustom desktop-minor-mode-table
'((auto-fill-function auto-fill-mode)
+ (defining-kbd-macro nil)
+ (isearch-mode nil)
(vc-mode nil)
(vc-dired-mode nil)
(erc-track-minor-mode nil)
@@ -537,15 +567,15 @@ Handlers are called with argument list
Furthermore, they may use the following variables:
- desktop-file-version
- desktop-buffer-file-name
- desktop-buffer-name
- desktop-buffer-major-mode
- desktop-buffer-minor-modes
- desktop-buffer-point
- desktop-buffer-mark
- desktop-buffer-read-only
- desktop-buffer-misc
+ `desktop-file-version'
+ `desktop-buffer-file-name'
+ `desktop-buffer-name'
+ `desktop-buffer-major-mode'
+ `desktop-buffer-minor-modes'
+ `desktop-buffer-point'
+ `desktop-buffer-mark'
+ `desktop-buffer-read-only'
+ `desktop-buffer-misc'
When a handler is called, the buffer has been created and the major mode has
been set, but local variables listed in desktop-buffer-locals has not yet been
@@ -559,7 +589,9 @@ code like
(add-to-list 'desktop-minor-mode-handlers
'(foo-mode . foo-desktop-restore))
-Furthermore the minor mode function must be autoloaded.
+The minor mode function must either be autoloaded, or of the form
+\"foobar-mode\" and defined in library \"foobar\", so that desktop
+can guess how to load the mode's definition.
See also `desktop-minor-mode-table'.")
@@ -603,6 +635,18 @@ Only valid during frame saving & restoring; intended for internal use.")
"When the desktop file was last modified to the knowledge of this Emacs.
Used to detect desktop file conflicts.")
+(defvar desktop-var-serdes-funs
+ (list (list
+ 'mark-ring
+ (lambda (mr)
+ (mapcar #'marker-position mr))
+ (lambda (mr)
+ (mapcar #'copy-marker mr))))
+ "Table of serialization/deserialization functions for variables.
+Each record is a list of form: (var serializer deserializer).
+These records can be freely reordered, deleted, or new ones added.
+However, for compatibility, don't modify the functions for existing records.")
+
(defun desktop-owner (&optional dirname)
"Return the PID of the Emacs process that owns the desktop file in DIRNAME.
Return nil if no desktop file found or no Emacs process is using it.
@@ -678,7 +722,7 @@ if different)."
(frame-parameter frame 'desktop-dont-clear))
(delete-frame frame))
(error
- (delay-warning 'desktop (error-message-string err))))))))
+ (delay-warning 'desktop (error-message-string err))))))))
;; ----------------------------------------------------------------------------
(unless noninteractive
@@ -718,6 +762,24 @@ is nil, ask the user where to save the desktop."
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info (buffer)
+ "Return information describing BUFFER.
+This function is not pure, as BUFFER is made current with
+`set-buffer'.
+
+Returns a list of all the necessary information to recreate the
+buffer, which is (in order):
+
+ `uniquify-buffer-base-name';
+ `buffer-file-name';
+ `buffer-name';
+ `major-mode';
+ list of minor-modes,;
+ `point';
+ `mark';
+ `buffer-read-only';
+ auxiliary information given by `desktop-save-buffer';
+ local variables;
+ auxiliary information given by `desktop-var-serdes-funs'."
(set-buffer buffer)
(list
;; base name of the buffer; replaces the buffer name if managed by uniquify
@@ -728,16 +790,13 @@ is nil, ask the user where to save the desktop."
major-mode
;; minor modes
(let (ret)
- (mapc
- #'(lambda (minor-mode)
- (and (boundp minor-mode)
- (symbol-value minor-mode)
- (let* ((special (assq minor-mode desktop-minor-mode-table))
- (value (cond (special (cadr special))
- ((functionp minor-mode) minor-mode))))
- (when value (add-to-list 'ret value)))))
- (mapcar #'car minor-mode-alist))
- ret)
+ (dolist (minor-mode (mapcar #'car minor-mode-alist) ret)
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let* ((special (assq minor-mode desktop-minor-mode-table))
+ (value (cond (special (cadr special))
+ ((functionp minor-mode) minor-mode))))
+ (when value (cl-pushnew value ret))))))
;; point and mark, and read-only status
(point)
(list (mark t) mark-active)
@@ -754,7 +813,12 @@ is nil, ask the user where to save the desktop."
(push here ll))
((member local loclist)
(push local ll)))))
- ll)))
+ ll)
+ (mapcar (lambda (record)
+ (let ((var (car record)))
+ (list var
+ (funcall (cadr record) (symbol-value var)))))
+ desktop-var-serdes-funs)))
;; ----------------------------------------------------------------------------
(defun desktop--v2s (value)
@@ -825,12 +889,13 @@ QUOTE may be `may' (value may be quoted),
"Convert VALUE to a string that when read evaluates to the same value.
Not all types of values are supported."
(let* ((print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
(float-output-format nil)
(quote.sexp (desktop--v2s value))
(quote (car quote.sexp))
- (txt
- (let ((print-quoted t))
- (prin1-to-string (cdr quote.sexp)))))
+ (print-quoted t)
+ (txt (prin1-to-string (cdr quote.sexp))))
(if (eq quote 'must)
(concat "'" txt)
txt)))
@@ -864,23 +929,25 @@ FILENAME is the visited file name, BUFNAME is the buffer name, and
MODE is the major mode.
\n\(fn FILENAME BUFNAME MODE)"
(let ((case-fold-search nil)
- dired-skip)
- (and (not (and (stringp desktop-buffers-not-to-save)
- (not filename)
- (string-match-p desktop-buffers-not-to-save bufname)))
- (not (memq mode desktop-modes-not-to-save))
- ;; FIXME this is broken if desktop-files-not-to-save is nil.
- (or (and filename
- (stringp desktop-files-not-to-save)
- (not (string-match-p desktop-files-not-to-save filename)))
- (and (memq mode '(dired-mode vc-dir-mode))
- (with-current-buffer bufname
- (not (setq dired-skip
- (string-match-p desktop-files-not-to-save
- default-directory)))))
- (and (null filename)
- (null dired-skip) ; bug#5755
- (with-current-buffer bufname desktop-save-buffer))))))
+ (no-regexp-to-check (not (stringp desktop-files-not-to-save)))
+ dired-skip)
+ (and (or filename
+ (not (stringp desktop-buffers-not-to-save))
+ (not (string-match-p desktop-buffers-not-to-save bufname)))
+ (not (memq mode desktop-modes-not-to-save))
+ (or (and filename
+ (or no-regexp-to-check
+ (not (string-match-p desktop-files-not-to-save filename))))
+ (and (memq mode '(dired-mode vc-dir-mode))
+ (or no-regexp-to-check
+ (not (setq dired-skip
+ (with-current-buffer bufname
+ (string-match-p desktop-files-not-to-save
+ default-directory))))))
+ (and (null filename)
+ (null dired-skip) ; bug#5755
+ (with-current-buffer bufname desktop-save-buffer)))
+ t)))
;; ----------------------------------------------------------------------------
(defun desktop-file-name (filename dirname)
@@ -912,17 +979,24 @@ Frames with a non-nil `desktop-dont-save' parameter are not saved."
(and desktop-restore-frames
(frameset-save nil
:app desktop--app-id
- :name (concat user-login-name "@" system-name)
+ :name (concat user-login-name "@" (system-name))
:predicate #'desktop--check-dont-save))))
;;;###autoload
-(defun desktop-save (dirname &optional release auto-save)
+(defun desktop-save (dirname &optional release only-if-changed)
"Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
Optional parameter RELEASE says whether we're done with this desktop.
-If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
-and don't save the buffer if they are the same."
- (interactive "DDirectory to save desktop file in: ")
+If ONLY-IF-CHANGED is non-nil, compare the current desktop information
+to that in the desktop file, and if the desktop information has not
+changed since it was last saved then do not rewrite the file."
+ (interactive (list
+ ;; Or should we just use (car desktop-path)?
+ (let ((default (if (member "." desktop-path)
+ default-directory
+ user-emacs-directory)))
+ (read-directory-name "Directory to save desktop file in: "
+ default default t))))
(setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
(let ((eager desktop-restore-eager)
@@ -987,12 +1061,21 @@ and don't save the buffer if they are the same."
(insert ")\n\n"))))
(setq default-directory desktop-dirname)
- ;; If auto-saving, avoid writing if nothing has changed since the last write.
- ;; Don't check 300 characters of the header that contains the timestamp.
- (let ((checksum (and auto-save (md5 (current-buffer)
- (+ (point-min) 300) (point-max)
- 'emacs-mule))))
- (unless (and auto-save (equal checksum desktop-file-checksum))
+ ;; When auto-saving, avoid writing if nothing has changed since the last write.
+ (let* ((beg (and only-if-changed
+ (save-excursion
+ (goto-char (point-min))
+ ;; Don't check the header with changing timestamp
+ (and (search-forward "Global section" nil t)
+ ;; Also skip the timestamp in desktop-saved-frameset
+ ;; if it's saved in the first non-header line
+ (search-forward "desktop-saved-frameset"
+ (line-beginning-position 3) t)
+ ;; This is saved after the timestamp
+ (search-forward (format "%S" desktop--app-id) nil t))
+ (point))))
+ (checksum (and beg (md5 (current-buffer) beg (point-max) 'emacs-mule))))
+ (unless (and checksum (equal checksum desktop-file-checksum))
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
(setq desktop-file-checksum checksum)
@@ -1027,7 +1110,8 @@ This function depends on the value of `desktop-saved-frameset'
being set (usually, by reading it from the desktop)."
(when (desktop-restoring-frameset-p)
(frameset-restore desktop-saved-frameset
- :reuse-frames desktop-restore-reuses-frames
+ :reuse-frames (eq desktop-restore-reuses-frames t)
+ :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep))
:force-display desktop-restore-in-current-display
:force-onscreen desktop-restore-forces-onscreen)))
@@ -1037,6 +1121,7 @@ being set (usually, by reading it from the desktop)."
(defvar desktop-buffer-ok-count)
(defvar desktop-buffer-fail-count)
+;; FIXME Interactively, this should have the option to prompt for dirname.
;;;###autoload
(defun desktop-read (&optional dirname)
"Read and process the desktop file in directory DIRNAME.
@@ -1072,7 +1157,8 @@ It returns t if a desktop file was loaded, nil otherwise."
(desktop-buffer-fail-count 0)
(owner (desktop-owner))
;; Avoid desktop saving during evaluation of desktop buffer.
- (desktop-save nil))
+ (desktop-save nil)
+ (desktop-autosave-was-enabled))
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
@@ -1085,12 +1171,18 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(unless desktop-dirname
(message "Desktop file in use; not loaded.")))
(desktop-lazy-abort)
+ ;; Temporarily disable the autosave that will leave it
+ ;; disabled when loading the desktop fails with errors,
+ ;; thus not overwriting the desktop with broken contents.
+ (setq desktop-autosave-was-enabled
+ (memq 'desktop-auto-save-set-timer window-configuration-change-hook))
+ (desktop-auto-save-disable)
;; Evaluate desktop buffer and remember when it was modified.
(load (desktop-full-file-name) t t t)
(setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
;; If it wasn't already, mark it as in-use, to bother other
;; desktop instances.
- (unless owner
+ (unless (eq (emacs-pid) owner)
(condition-case nil
(desktop-claim-lock)
(file-error (message "Couldn't record use of desktop file")
@@ -1137,9 +1229,9 @@ Using it may cause conflicts. Use it anyway? " owner)))))
(set-window-prev-buffers window nil)
(set-window-next-buffers window nil))))
(setq desktop-saved-frameset nil)
+ (if desktop-autosave-was-enabled (desktop-auto-save-enable))
t))
;; No desktop file found.
- (desktop-clear)
(let ((default-directory desktop-dirname))
(run-hooks 'desktop-no-desktop-file-hook))
(message "No desktop file.")
@@ -1183,6 +1275,15 @@ directory DIRNAME."
;; Auto-Saving.
(defvar desktop-auto-save-timer nil)
+(defun desktop-auto-save-enable (&optional timeout)
+ (when (and (integerp (or timeout desktop-auto-save-timeout))
+ (> (or timeout desktop-auto-save-timeout) 0))
+ (add-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer)))
+
+(defun desktop-auto-save-disable ()
+ (remove-hook 'window-configuration-change-hook 'desktop-auto-save-set-timer)
+ (desktop-auto-save-cancel-timer))
+
(defun desktop-auto-save ()
"Save the desktop periodically.
Called by the timer created in `desktop-auto-save-set-timer'."
@@ -1194,21 +1295,24 @@ Called by the timer created in `desktop-auto-save-set-timer'."
;; Save only to own desktop file.
(eq (emacs-pid) (desktop-owner))
desktop-dirname)
- (desktop-save desktop-dirname nil t))
- (desktop-auto-save-set-timer))
+ (desktop-save desktop-dirname nil t)))
(defun desktop-auto-save-set-timer ()
- "Reset the auto-save timer.
+ "Set the auto-save timer.
Cancel any previous timer. When `desktop-auto-save-timeout' is a positive
-integer, start a new timer to call `desktop-auto-save' in that many seconds."
- (when desktop-auto-save-timer
- (cancel-timer desktop-auto-save-timer)
- (setq desktop-auto-save-timer nil))
+integer, start a new idle timer to call `desktop-auto-save' repeatedly
+after that many seconds of idle time."
+ (desktop-auto-save-cancel-timer)
(when (and (integerp desktop-auto-save-timeout)
(> desktop-auto-save-timeout 0))
(setq desktop-auto-save-timer
- (run-with-timer desktop-auto-save-timeout nil
- 'desktop-auto-save))))
+ (run-with-idle-timer desktop-auto-save-timeout nil
+ 'desktop-auto-save))))
+
+(defun desktop-auto-save-cancel-timer ()
+ (when desktop-auto-save-timer
+ (cancel-timer desktop-auto-save-timer)
+ (setq desktop-auto-save-timer nil)))
;; ----------------------------------------------------------------------------
;;;###autoload
@@ -1254,9 +1358,18 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds."
nil)))
(defun desktop-load-file (function)
- "Load the file where auto loaded FUNCTION is defined."
- (when (fboundp function)
- (autoload-do-load (symbol-function function) function)))
+ "Load the file where auto loaded FUNCTION is defined.
+If FUNCTION is not currently defined, guess the library that defines it
+and try to load that."
+ (if (fboundp function)
+ (autoload-do-load (symbol-function function) function)
+ ;; Guess that foobar-mode is defined in foobar.
+ ;; TODO rather than guessing or requiring an autoload, the desktop
+ ;; file should record the name of the library.
+ (let ((name (symbol-name function)))
+ (if (string-match "\\`\\(.*\\)-mode\\'" name)
+ (with-demoted-errors "Require error in desktop-load-file: %S"
+ (require (intern (match-string 1 name)) nil t))))))
;; ----------------------------------------------------------------------------
;; Create a buffer, load its file, set its mode, ...;
@@ -1273,7 +1386,9 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds."
buffer-readonly
buffer-misc
&optional
- buffer-locals)
+ buffer-locals
+ compacted-vars
+ &rest _unsupported)
(let ((desktop-file-version file-version)
(desktop-buffer-file-name buffer-filename)
@@ -1312,7 +1427,9 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds."
;; Restore buffer list order with new buffer at end. Don't change
;; the order for old desktop files (old desktop module behavior).
(unless (< desktop-file-version 206)
- (mapc 'bury-buffer buffer-list)
+ (dolist (buf buffer-list)
+ (and (buffer-live-p buf)
+ (bury-buffer buf)))
(when result (bury-buffer result)))
(when result
(unless (or desktop-first-buffer (< desktop-file-version 206))
@@ -1345,22 +1462,30 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds."
(eval desktop-buffer-point)
(error (message "%s" (error-message-string err)) 1))))
(when desktop-buffer-mark
- (if (consp desktop-buffer-mark)
- (progn
- (set-mark (car desktop-buffer-mark))
- (setq mark-active (car (cdr desktop-buffer-mark))))
- (set-mark desktop-buffer-mark)))
+ (if (consp desktop-buffer-mark)
+ (progn
+ (move-marker (mark-marker) (car desktop-buffer-mark))
+ (if (car (cdr desktop-buffer-mark))
+ (activate-mark 'dont-touch-tmm)))
+ (move-marker (mark-marker) desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
(when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
(dolist (this desktop-buffer-locals)
(if (consp this)
- ;; an entry of this form `(symbol . value)'
+ ;; An entry of this form `(symbol . value)'.
(progn
(make-local-variable (car this))
(set (car this) (cdr this)))
- ;; an entry of the form `symbol'
+ ;; An entry of the form `symbol'.
(make-local-variable this)
- (makunbound this))))))))
+ (makunbound this)))
+ (unless (< desktop-file-version 208) ; Don't misinterpret any old custom args
+ (dolist (record compacted-vars)
+ (let*
+ ((var (car record))
+ (deser-fun (nth 2 (assq var desktop-var-serdes-funs))))
+ (if deser-fun (set var (funcall deser-fun (cadr record))))))))
+ result))))
;; ----------------------------------------------------------------------------
;; Backward compatibility -- update parameters to 205 standards.
@@ -1450,14 +1575,17 @@ If there are no buffers left to create, kill the timer."
(let ((key "--no-desktop"))
(when (member key command-line-args)
(setq command-line-args (delete key command-line-args))
- (setq desktop-save-mode nil)))
+ (desktop-save-mode 0)))
(when desktop-save-mode
- (desktop-read)
- (desktop-auto-save-set-timer)
- (setq inhibit-startup-screen t))))
-
-;; So we can restore vc-dir buffers.
-(autoload 'vc-dir-mode "vc-dir" nil t)
+ ;; People don't expect emacs -nw, or --daemon,
+ ;; to create graphical frames (bug#17693).
+ ;; TODO perhaps there should be a separate value
+ ;; for desktop-restore-frames to control this startup behavior?
+ (let ((desktop-restore-frames (and desktop-restore-frames
+ initial-window-system
+ (not (daemonp)))))
+ (desktop-read)
+ (setq inhibit-startup-screen t)))))
(provide 'desktop)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 21b508512d3..d8ddbc8f08f 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,6 +1,6 @@
-;;; dframe --- dedicate frame support modes
+;;; dframe --- dedicate frame support modes -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -243,6 +243,9 @@ Local to those buffers, as a function called that created it.")
"Return non-nil if FRAME is currently available."
(and frame (frame-live-p frame) (frame-visible-p frame)))
+(defvar x-sensitive-text-pointer-shape)
+(defvar x-pointer-shape)
+
(defun dframe-frame-mode (arg frame-var cache-var buffer-var frame-name
local-mode-fn
&optional
@@ -259,9 +262,15 @@ This buffer will have `dframe-frame-mode' run on it.
FRAME-NAME is the name of the frame to create.
LOCAL-MODE-FN is the function used to call this one.
PARAMETERS are frame parameters to apply to this dframe.
-DELETE-HOOK are hooks to run when deleting a frame.
-POPUP-HOOK are hooks to run before showing a frame.
-CREATE-HOOK are hooks to run after creating a frame."
+DELETE-HOOK is a hook to run when deleting a frame.
+POPUP-HOOK is a hook to run before showing a frame.
+CREATE-HOOK is a hook to run after creating a frame."
+ (let ((conv-hook (lambda (val)
+ (let ((sym (make-symbol "hook")))
+ (set sym val) sym))))
+ (if (consp delete-hook) (setq delete-hook (funcall conv-hook delete-hook)))
+ (if (consp create-hook) (setq create-hook (funcall conv-hook create-hook)))
+ (if (consp popup-hook) (setq popup-hook (funcall conv-hook popup-hook))))
;; toggle frame on and off.
(if (not arg) (if (dframe-live-p (symbol-value frame-var))
(setq arg -1) (setq arg 1)))
@@ -270,7 +279,7 @@ CREATE-HOOK are hooks to run after creating a frame."
;; turn the frame off on neg number
(if (and (numberp arg) (< arg 0))
(progn
- (run-hooks 'delete-hook)
+ (run-hooks delete-hook)
(if (and (symbol-value frame-var)
(frame-live-p (symbol-value frame-var)))
(progn
@@ -279,7 +288,7 @@ CREATE-HOOK are hooks to run after creating a frame."
(set frame-var nil))
;; Set this as our currently attached frame
(setq dframe-attached-frame (selected-frame))
- (run-hooks 'popup-hook)
+ (run-hooks popup-hook)
;; Updated the buffer passed in to contain all the hacks needed
;; to make it work well in a dedicated window.
(with-current-buffer (symbol-value buffer-var)
@@ -331,15 +340,15 @@ CREATE-HOOK are hooks to run after creating a frame."
(setq temp-buffer-show-function 'dframe-temp-buffer-show-function)
;; If this buffer is killed, we must make sure that we destroy
;; the frame the dedicated window is in.
- (add-hook 'kill-buffer-hook `(lambda ()
- (let ((skilling (boundp 'skilling)))
- (if skilling
- nil
- (if dframe-controlled
- (progn
- (funcall dframe-controlled -1)
- (setq ,buffer-var nil)
- )))))
+ (add-hook 'kill-buffer-hook (lambda ()
+ (let ((skilling (boundp 'skilling)))
+ (if skilling
+ nil
+ (if dframe-controlled
+ (progn
+ (funcall dframe-controlled -1)
+ (set buffer-var nil)
+ )))))
t t)
)
;; Get the frame to work in
@@ -396,7 +405,7 @@ CREATE-HOOK are hooks to run after creating a frame."
(switch-to-buffer (symbol-value buffer-var))
(set-window-dedicated-p (selected-window) t))
;; Run hooks (like reposition)
- (run-hooks 'create-hook)
+ (run-hooks create-hook)
;; Frame name
(if (and (or (null window-system) (eq window-system 'pc))
(fboundp 'set-frame-name))
@@ -521,7 +530,7 @@ LOCATION can be one of 'random, 'left-right, or 'top-bottom."
(defun dframe-detach (frame-var cache-var buffer-var)
"Detach the frame in symbol FRAME-VAR.
-CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'"
+CACHE-VAR and BUFFER-VAR are symbols as in `dframe-frame-mode'."
(with-current-buffer (symbol-value buffer-var)
(rename-buffer (buffer-name) t)
(let ((oldframe (symbol-value frame-var)))
@@ -597,13 +606,12 @@ Argument E is the event deleting the frame."
;;; Utilities
;;
-(defun dframe-get-focus (frame-var activator &optional hook)
+(defun dframe-get-focus (frame-var activator)
"Change frame focus to or from a dedicated frame.
If the selected frame is not in the symbol FRAME-VAR, then FRAME-VAR
frame is selected. If the FRAME-VAR is active, then select the
attached frame. If FRAME-VAR is nil, ACTIVATOR is called to
-created it. HOOK is an optional argument of hooks to run when
-selecting FRAME-VAR."
+created it."
(interactive)
(if (eq (selected-frame) (symbol-value frame-var))
(if (frame-live-p dframe-attached-frame)
@@ -614,9 +622,7 @@ selecting FRAME-VAR."
;; go there
(select-frame (symbol-value frame-var))
)
- (other-frame 0)
- ;; If updates are off, then refresh the frame (they want it now...)
- (run-hooks 'hook))
+ (other-frame 0))
(defun dframe-close-frame ()
@@ -682,11 +688,11 @@ Optionally select that frame if necessary."
Argument FMT is the format string, and ARGS are the arguments for message."
(save-selected-window
(if dframe-suppress-message-flag
- (apply 'format fmt args)
+ (apply #'format-message fmt args)
(if dframe-attached-frame
;; KB: Here we do not need calling `dframe-select-attached-frame'
(select-frame dframe-attached-frame))
- (apply 'message fmt args))))
+ (apply #'message fmt args))))
(defun dframe-y-or-n-p (prompt)
"Like `y-or-n-p', but for use in a dedicated frame.
@@ -752,9 +758,8 @@ who requested the timer. NULL-ON-ERROR is ignored."
Evaluates all cached timer functions in sequence."
(let ((l dframe-client-functions))
(while (and l (sit-for 0))
- (condition-case er
- (funcall (car l))
- (error (message "DFRAME TIMER ERROR: %S" er)))
+ (with-demoted-errors "DFRAME TIMER ERROR: %S"
+ (funcall (car l)))
(setq l (cdr l)))))
;;; Menu hacking for mouse-3
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 31d0495175a..9f115140527 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,10 +1,10 @@
;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Package: emacs
@@ -215,19 +215,24 @@ condition. Two file items are considered to match if they are equal
(dolist (file1 list1)
(unless (let ((list list2))
(while (and list
- (not (let* ((file2 (car list))
- (fa1 (car (cddr file1)))
- (fa2 (car (cddr file2)))
- (size1 (nth 7 fa1))
- (size2 (nth 7 fa2))
- (mtime1 (float-time (nth 5 fa1)))
- (mtime2 (float-time (nth 5 fa2))))
- (and
- (equal (car file1) (car file2))
- (not (eval predicate))))))
+ (let* ((file2 (car list))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2))))
+ (or
+ (not (equal (car file1) (car file2)))
+ (eval predicate
+ `((fa1 . ,fa1)
+ (fa2 . ,fa2)
+ (size1 . ,(nth 7 fa1))
+ (size2 . ,(nth 7 fa2))
+ (mtime1
+ . ,(float-time (nth 5 fa1)))
+ (mtime2
+ . ,(float-time (nth 5 fa2)))
+ )))))
(setq list (cdr list)))
list)
- (setq res (cons file1 res))))
+ (push file1 res)))
(nreverse res))))
(defun dired-files-attributes (dir)
@@ -408,13 +413,22 @@ into the minibuffer."
;; Now the original list FILES has been put back as it was.
(nconc past pending))))
+(defvar lpr-printer-switch)
+
;;;###autoload
(defun dired-do-print (&optional arg)
"Print the marked (or next ARG) files.
Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
(interactive "P")
+ (require 'lpr)
(let* ((file-list (dired-get-marked-files t arg))
+ (lpr-switches
+ (if (and (stringp printer-name)
+ (string< "" printer-name))
+ (cons (concat lpr-printer-switch printer-name)
+ lpr-switches)
+ lpr-switches))
(command (dired-mark-read-string
"Print %s with: "
(mapconcat 'identity
@@ -672,9 +686,11 @@ can be produced by `dired-get-marked-files', for example."
(if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
((and star on-each)
- (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `*' as a wildcard? ")))
((and qmark no-subst)
- (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `?' as a wildcard? ")))
(t))
(if on-each
(dired-bunch-files
@@ -746,12 +762,12 @@ can be produced by `dired-get-marked-files', for example."
(defun dired-check-process (msg program &rest arguments)
-; "Display MSG while running PROGRAM, and check for output.
-;Remaining arguments are strings passed as command arguments to PROGRAM.
-; On error, insert output
-; in a log buffer and return the offending ARGUMENTS or PROGRAM.
-; Caller can cons up a list of failed args.
-;Else returns nil for success."
+ "Display MSG while running PROGRAM, and check for output.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+On error, insert output
+in a log buffer and return the offending ARGUMENTS or PROGRAM.
+Caller can cons up a list of failed args.
+Else returns nil for success."
(let (err-buffer err (dir default-directory))
(message "%s..." msg)
(save-excursion
@@ -769,6 +785,26 @@ can be produced by `dired-get-marked-files', for example."
(kill-buffer err-buffer)
(message "%s...done" msg)
nil))))
+
+(defun dired-shell-command (cmd)
+ "Run CMD, and check for output.
+On error, pop up the log buffer.
+Return the result of `process-file' - zero for success."
+ (let ((out-buffer " *dired-check-process output*")
+ (dir default-directory))
+ (with-current-buffer (get-buffer-create out-buffer)
+ (erase-buffer)
+ (let* ((default-directory dir)
+ (res (process-file
+ shell-file-name
+ nil
+ t
+ nil
+ shell-command-switch
+ cmd)))
+ (unless (zerop res)
+ (pop-to-buffer out-buffer))
+ res))))
;; Commands that delete or redisplay part of the dired buffer.
@@ -848,7 +884,12 @@ command with a prefix argument (the value does not matter)."
from-file)))
(defvar dired-compress-file-suffixes
- '(("\\.gz\\'" "" "gunzip")
+ '(
+ ;; "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.
+ ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv")
+ ("\\.gz\\'" "" "gunzip")
("\\.tgz\\'" ".tar" "gunzip")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
@@ -858,8 +899,11 @@ command with a prefix argument (the value does not matter)."
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
("\\.xz\\'" "" "unxz")
+ ("\\.zip\\'" "" "unzip -o -d %o %i")
;; This item controls naming for compression.
- ("\\.tar\\'" ".tgz" nil))
+ ("\\.tar\\'" ".tgz" nil)
+ ;; This item controls the compression of directories
+ (":" ".tar.gz" "tar -c %i | gzip -c9 > %o"))
"Control changes in file name suffixes for compression and uncompression.
Each element specifies one transformation rule, and has the form:
(REGEXP NEW-SUFFIX PROGRAM)
@@ -868,60 +912,139 @@ The new file name is computed by deleting the part that matches REGEXP
(as well as anything after that), then adding NEW-SUFFIX in its place.
If PROGRAM is non-nil, the rule is an uncompression rule,
and uncompression is done by running PROGRAM.
-Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
+Within PROGRAM, %i denotes the input file, and %o denotes the
+output file.
+
+Otherwise, the rule is a compression rule, and compression is done with gzip.
+ARGS are command switches passed to PROGRAM.")
+
+(defvar dired-compress-files-alist
+ '(("\\.tar\\.gz\\'" . "tar -c %i | gzip -c9 > %o")
+ ("\\.tar\\.bz2\\'" . "tar -c %i | bzip2 -c9 > %o")
+ ("\\.tar\\.xz\\'" . "tar -c %i | xz -c9 > %o")
+ ("\\.zip\\'" . "zip %o -r --filesync %i"))
+ "Control the compression shell command for `dired-do-compress-to'.
+
+Each element is (REGEXP . CMD), where REGEXP is the name of the
+archive to which you want to compress, and CMD the the
+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.")
+
+;;;###autoload
+(defun dired-do-compress-to ()
+ "Compress selected files and directories to an archive.
+You are prompted for the archive name.
+The archiving command is chosen based on the archive name extension and
+`dired-compress-files-alist'."
+ (interactive)
+ (let* ((in-files (dired-get-marked-files))
+ (out-file (read-file-name "Compress to: "))
+ (rule (cl-find-if
+ (lambda (x)
+ (string-match (car x) out-file))
+ dired-compress-files-alist)))
+ (cond ((not rule)
+ (error
+ "No compression rule found for %s, see `dired-compress-files-alist'"
+ out-file))
+ ((and (file-exists-p out-file)
+ (not (y-or-n-p
+ (format "%s exists, overwrite?"
+ (abbreviate-file-name out-file)))))
+ (message "Compression aborted"))
+ (t
+ (when (zerop
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" out-file
+ (replace-regexp-in-string
+ "%i" (mapconcat #'file-name-nondirectory in-files " ")
+ (cdr rule)))))
+ (message "Compressed %d file(s) to %s"
+ (length in-files)
+ (file-name-nondirectory out-file)))))))
;;;###autoload
(defun dired-compress-file (file)
- ;; Compress or uncompress FILE.
- ;; Return the name of the compressed or uncompressed file.
- ;; Return nil if no change in files.
+ "Compress or uncompress FILE.
+Return the name of the compressed or uncompressed file.
+Return nil if no change in files."
(let ((handler (find-file-name-handler file 'dired-compress-file))
- suffix newname
- (suffixes dired-compress-file-suffixes))
+ suffix newname
+ (suffixes dired-compress-file-suffixes)
+ command)
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
- (if (string-match-p (car (car suffixes)) file)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
+ (if (string-match (car (car suffixes)) file)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
;; If so, compute desired new name.
(if suffix
- (setq newname (concat (substring file 0 (match-beginning 0))
- (nth 1 suffix))))
+ (setq newname (concat (substring file 0 (match-beginning 0))
+ (nth 1 suffix))))
(cond (handler
- (funcall handler 'dired-compress-file file))
- ((file-symlink-p file)
- nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (if (not (dired-check-process (concat "Uncompressing " file)
- (nth 2 suffix) file))
- newname))
- (t
- ;;; We don't recognize the file as compressed, so compress it.
- ;;; Try gzip; if we don't have that, use compress.
- (condition-case nil
- (let ((out-name (concat file ".gz")))
- (and (or (not (file-exists-p out-name))
- (y-or-n-p
- (format "File %s already exists. Really compress? "
- out-name)))
- (not (dired-check-process (concat "Compressing " file)
- "gzip" "-f" file))
- (or (file-exists-p out-name)
- (setq out-name (concat file ".z")))
- ;; Rename the compressed file to NEWNAME
- ;; if it hasn't got that name already.
- (if (and newname (not (equal newname out-name)))
- (progn
- (rename-file out-name newname t)
- newname)
- out-name)))
- (file-error
- (if (not (dired-check-process (concat "Compressing " file)
- "compress" "-f" file))
- ;; Don't use NEWNAME with `compress'.
- (concat file ".Z"))))))))
+ (funcall handler 'dired-compress-file file))
+ ((file-symlink-p file)
+ nil)
+ ((and suffix (setq command (nth 2 suffix)))
+ (if (string-match "%[io]" command)
+ (prog1 (setq newname (file-name-as-directory newname))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" newname
+ (replace-regexp-in-string
+ "%i" file
+ command))))
+ ;; We found an uncompression rule.
+ (when (not
+ (dired-check-process
+ (concat "Uncompressing " file)
+ command
+ file))
+ newname)))
+ (t
+ ;; We don't recognize the file as compressed, so compress it.
+ ;; Try gzip; if we don't have that, use compress.
+ (condition-case nil
+ (if (file-directory-p file)
+ (progn
+ (setq suffix (cdr (assoc ":" dired-compress-file-suffixes)))
+ (when suffix
+ (let ((out-name (concat file (car suffix)))
+ (default-directory (file-name-directory file)))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" out-name
+ (replace-regexp-in-string
+ "%i" (file-name-nondirectory file)
+ (cadr suffix))))
+ out-name)))
+ (let ((out-name (concat file ".gz")))
+ (and (or (not (file-exists-p out-name))
+ (y-or-n-p
+ (format "File %s already exists. Really compress? "
+ out-name)))
+ (not
+ (dired-check-process (concat "Compressing " file)
+ "gzip" "-f" file))
+ (or (file-exists-p out-name)
+ (setq out-name (concat file ".z")))
+ ;; Rename the compressed file to NEWNAME
+ ;; if it hasn't got that name already.
+ (if (and newname (not (equal newname out-name)))
+ (progn
+ (rename-file out-name newname t)
+ newname)
+ out-name))))
+ (file-error
+ (if (not (dired-check-process (concat "Compressing " file)
+ "compress" "-f" file))
+ ;; Don't use NEWNAME with `compress'.
+ (concat file ".Z"))))))))
(defun dired-mark-confirm (op-symbol arg)
;; Request confirmation from the user that the operation described
@@ -992,7 +1115,7 @@ return t; if SYM is q or ESC, return nil."
nil) ; skip, and don't ask again
(t ; no previous answer - ask now
(setq prompt
- (concat (apply 'format prompt args)
+ (concat (apply #'format-message prompt args)
(if help-form
(format " [Type yn!q or %s] "
(key-description (vector help-char)))
@@ -1105,15 +1228,16 @@ See Info node `(emacs)Subdir switches' for more details."
;; here is faster than with dired-add-entry's optional arg).
;; Does not update other dired buffers. Use dired-relist-entry for that.
(let* ((opoint (line-beginning-position))
- (char (char-after opoint))
- (buffer-read-only))
+ (char (char-after opoint))
+ (buffer-read-only))
(delete-region opoint (progn (forward-line 1) (point)))
(if file
- (progn
- (dired-add-entry file nil t)
- ;; Replace space by old marker without moving point.
- ;; Faster than goto+insdel inside a save-excursion?
- (subst-char-in-region opoint (1+ opoint) ?\040 char))))
+ (progn
+ (dired-add-entry file nil t)
+ ;; Replace space by old marker without moving point.
+ ;; Faster than goto+insdel inside a save-excursion?
+ (when char
+ (subst-char-in-region opoint (1+ opoint) ?\040 char)))))
(dired-move-to-filename))
;;;###autoload
@@ -1337,9 +1461,7 @@ Special value `always' suppresses confirmation."
(eq t (car attrs))
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
- ;; This is a directory.
(copy-directory from to preserve-time)
- ;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
(if (stringp (car attrs))
@@ -1485,7 +1607,7 @@ or with the current marker character if MARKER-CHAR is t."
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
- (let ((help-form '(format "\
+ (let ((help-form '(format-message "\
Type SPC or `y' to overwrite file `%s',
DEL or `n' to skip to next,
ESC or `q' to not overwrite any of the remaining files,
@@ -1866,11 +1988,11 @@ of `dired-dwim-target', which see."
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
(operation-prompt (concat operation " `%s' to `%s'?"))
- (rename-regexp-help-form (format "\
+ (rename-regexp-help-form (format-message "\
Type SPC or `y' to %s one match, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation)))
+ (downcase operation)
+ (downcase operation)))
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
@@ -1917,8 +2039,9 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next,
(arg
(if whole-name nil current-prefix-arg))
(regexp
- (dired-read-regexp
- (concat (if whole-name "Abs. " "") operation " from (regexp): ")))
+ (read-regexp
+ (concat (if whole-name "Abs. " "") operation " from (regexp): ")
+ nil 'dired-regexp-history))
(newname
(read-string
(concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
@@ -1990,11 +2113,11 @@ See function `dired-do-rename-regexp' for more info."
(let ((to (concat (file-name-directory from)
(funcall basename-constructor
(file-name-nondirectory from)))))
- (and (let ((help-form (format "\
+ (and (let ((help-form (format-message "\
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation))))
+ (downcase operation)
+ (downcase operation))))
(dired-query 'rename-non-directory-query
(concat operation " `%s' to `%s'")
(dired-make-relative from)
@@ -2052,7 +2175,10 @@ See Info node `(emacs)Subdir switches' for more details."
;; inserted *after* opoint.
(setq dirname (file-name-as-directory dirname))
(or (and (not switches)
- (dired-goto-subdir dirname))
+ (when (dired-goto-subdir dirname)
+ (unless (dired-subdir-hidden-p dirname)
+ (dired-initial-position dirname))
+ t))
(dired-insert-subdir dirname switches no-error-if-not-dir-p))
;; Push mark so that it's easy to find back. Do this after the
;; insert message so that the user sees the `Mark set' message.
@@ -2241,7 +2367,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
;; string-lessp could arguably be replaced by file-newer-than-file-p
- ;; if dired-actual-switches contained `t'.
+ ;; if dired-actual-switches contained t.
(setq dir1 (file-name-as-directory dir1)
dir2 (file-name-as-directory dir2))
(let ((components-1 (dired-split "/" dir1))
@@ -2526,24 +2652,22 @@ Intended to be added to `isearch-mode-hook'."
"Test whether the current search hit is a file name.
Return non-nil if the text from BEG to END is part of a file
name (has the text property `dired-filename')."
- (if dired-isearch-filenames
- (text-property-not-all (min beg end) (max beg end)
- 'dired-filename nil)
- t))
+ (text-property-not-all (min beg end) (max beg end)
+ 'dired-filename nil))
;;;###autoload
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward)))
+ (isearch-forward nil t)))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward-regexp)))
+ (isearch-forward-regexp nil t)))
;; Functions for searching in tags style among marked files.
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 0c432593909..b6704bb34fd 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1,6 +1,6 @@
-;;; dired-x.el --- extra Dired functionality
+;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1993-1994, 1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
@@ -149,7 +149,7 @@ regexp `dired-omit-files', nor files ending with extensions in
To enable omitting in every Dired buffer, you can put this in
your init file:
- (add-hook 'dired-mode-hook (lambda () (dired-omit-mode)))
+ (add-hook \\='dired-mode-hook (lambda () (dired-omit-mode)))
See Info node `(dired-x) Omitting Variables' for more information."
:group 'dired-x
@@ -241,7 +241,7 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
;;; KEY BINDINGS.
-(define-key dired-mode-map "\M-o" 'dired-omit-mode)
+(define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode)
(define-key dired-mode-map "*O" 'dired-mark-omitted)
(define-key dired-mode-map "\M-(" 'dired-mark-sexp)
(define-key dired-mode-map "*(" 'dired-mark-sexp)
@@ -402,6 +402,7 @@ See variables `dired-texinfo-unclean-extensions',
dired-tex-unclean-extensions
(list ".dvi"))))
+(defvar tar-superior-buffer)
;;; JUMP.
;;;###autoload
@@ -416,30 +417,32 @@ Interactively with prefix argument, read FILE-NAME and
move to its line in dired."
(interactive
(list nil (and current-prefix-arg
- (read-file-name "Jump to Dired file: "))))
- (let* ((file (or 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)
+ (read-file-name "Jump to Dired file: "))))
+ (if (bound-and-true-p tar-subfile-mode)
+ (switch-to-buffer tar-superior-buffer)
+ (let* ((file (or 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
- (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)))))))
+ (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)
@@ -556,8 +559,9 @@ interactively, prompt for REGEXP.
With prefix argument, unflag all those files.
Optional fourth argument LOCALP is as in `dired-get-filename'."
(interactive
- (list (dired-read-regexp
- "Mark unmarked files matching regexp (default all): ")
+ (list (read-regexp
+ "Mark unmarked files matching regexp (default all): "
+ nil 'dired-regexp-history)
nil current-prefix-arg nil))
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if
@@ -686,8 +690,8 @@ to put saved Dired buffers automatically into Virtual Dired mode.
Also useful for `auto-mode-alist' like this:
- (add-to-list 'auto-mode-alist
- '(\"[^/]\\\\.dired\\\\'\" . dired-virtual-mode))"
+ (add-to-list \\='auto-mode-alist
+ \\='(\"[^/]\\\\.dired\\\\\\='\" . dired-virtual-mode))"
(interactive)
(dired-virtual (dired-virtual-guess-dir)))
@@ -1047,7 +1051,8 @@ Each element of this list looks like
(REGEXP COMMAND...)
where each COMMAND can either be a string or a Lisp expression that evaluates
-to a string. If several COMMANDs are given, the first one will be the default
+to a string. This expression can access the file name as the variable `file'.
+If several COMMANDs are given, the first one will be the default
and the rest will be added temporarily to the history and can be retrieved
with \\[previous-history-element] (M-p) .
@@ -1105,8 +1110,8 @@ See `dired-guess-shell-alist-user'."
;; Return commands or nil if flist is still non-nil.
;; Evaluate the commands in order that any logical testing will be done.
(if (cdr cmds)
- (delete-dups (mapcar #'eval cmds))
- (eval (car cmds))))) ; single command
+ (delete-dups (mapcar (lambda (cmd) (eval cmd `((file . ,file)))) cmds))
+ (eval (car cmds) `((file . ,file)))))) ; single command
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
@@ -1185,7 +1190,7 @@ results in
(setq count (1+ count)
start (1+ start)))
;; ... and prepend a "../" for each slash found:
- (dotimes (_n count)
+ (dotimes (_ count)
(setq name1 (concat "../" name1)))))
(make-symbolic-link
(directory-file-name name1) ; must not link to foo/
@@ -1351,12 +1356,12 @@ otherwise."
(interactive)
(let ((file (dired-get-filename t)))
(if dired-bind-vm
- (if (y-or-n-p (concat "Visit `" file
- "' as a mail folder with VM?"))
+ (if (y-or-n-p (format-message
+ "Visit `%s' as a mail folder with VM?" file))
(dired-vm))
;; Read mail folder using rmail.
- (if (y-or-n-p (concat "Visit `" file
- "' as a mailbox with RMAIL?"))
+ (if (y-or-n-p (format-message
+ "Visit `%s' as a mailbox with RMAIL?" file))
(dired-rmail)))))
@@ -1394,25 +1399,25 @@ Considers buffers closer to the car of `buffer-list' to be more recent."
;; result))
+;; Needed if ls -lh is supported and also for GNU ls -ls.
+(defun dired-x--string-to-number (str)
+ "Like `string-to-number' but recognize a trailing unit prefix.
+For example, 2K is expanded to 2048.0. The caller should make
+sure that a trailing letter in STR is one of BKkMGTPEZY."
+ (let* ((val (string-to-number str))
+ (u (unless (zerop val)
+ (aref str (1- (length str))))))
+ (when (and u (> u ?9))
+ (when (= u ?k)
+ (setq u ?K))
+ (let ((units '(?B ?K ?M ?G ?T ?P ?E ?Z ?Y)))
+ (while (and units (/= (pop units) u))
+ (setq val (* 1024.0 val)))))
+ val))
+
;; Does anyone use this? - lrd 6/29/93.
;; Apparently people do use it. - lrd 12/22/97.
-(with-no-warnings
- ;; Warnings are suppressed to avoid "global/dynamic var `X' lacks a prefix".
- ;; This is unbearably ugly, but not more than having global variables
- ;; named size, time, name or s, however practical it can be while writing
- ;; `dired-mark-sexp' predicates.
- (defvar inode)
- (defvar s)
- (defvar mode)
- (defvar nlink)
- (defvar uid)
- (defvar gid)
- (defvar size)
- (defvar time)
- (defvar name)
- (defvar sym))
-
(defun dired-mark-sexp (predicate &optional unflag-p)
"Mark files for which PREDICATE returns non-nil.
With a prefix arg, unmark or unflag those files instead.
@@ -1436,7 +1441,19 @@ For example, use
(equal 0 size)
-to mark all zero length files."
+to mark all zero length files.
+
+There's an ambiguity when a single integer not followed by a unit
+prefix precedes the file mode: It is then parsed as inode number
+and not as block size (this always works for GNU coreutils ls).
+
+Another limitation is that the uid field is needed for the
+function to work correctly. In particular, the field is not
+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."
;; 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
@@ -1456,56 +1473,96 @@ to mark all zero length files."
;; to nil or the appropriate value, so they need not be initialized.
;; Moves point within the current line.
(dired-move-to-filename)
- (let (pos
- (mode-len 10) ; length of mode string
- ;; like in dired.el, but with subexpressions \1=inode, \2=s:
- (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?"))
- (beginning-of-line)
- (forward-char 2)
- (if (looking-at dired-re-inode-size)
- (progn
- (goto-char (match-end 0))
- (setq inode (string-to-number
- (buffer-substring (match-beginning 1)
- (match-end 1)))
- s (string-to-number
- (buffer-substring (match-beginning 2)
- (match-end 2)))))
- (setq inode nil
- s nil))
+ (let ((mode-len 10) ; length of mode string
+ ;; like in dired.el, but with subexpressions \1=inode, \2=s:
+ ;; GNU ls -hs suffixes the block count with a unit and
+ ;; prints it as a float, FreeBSD does neither.
+ (dired-re-inode-size "\\=\\s *\\([0-9]+\\s +\\)?\
+\\(?:\\([0-9]+\\(?:\\.[0-9]*\\)?[BkKMGTPEZY]?\\)? ?\\)"))
+ (beginning-of-line)
+ (forward-char 2)
+ (search-forward-regexp dired-re-inode-size nil t)
+ ;; XXX Might be a size not followed by a unit prefix.
+ ;; We could set s to inode if it were otherwise nil,
+ ;; with a similar reasoning as below for setting gid to uid,
+ ;; but it would be even more whimsical.
+ (setq inode (when (match-string 1)
+ (string-to-number (match-string 1))))
+ (setq s (when (match-string 2)
+ (dired-x--string-to-number (match-string 2))))
(setq mode (buffer-substring (point) (+ mode-len (point))))
(forward-char mode-len)
+ ;; Skip any extended attributes marker ("." or "+").
+ (or (looking-at " ")
+ (forward-char 1))
(setq nlink (read (current-buffer)))
;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid.
- (setq uid (buffer-substring (1+ (point))
- (progn (forward-word 1) (point))))
- (re-search-forward directory-listing-before-filename-regexp)
- (goto-char (match-beginning 1))
- (forward-char -1)
- (setq size (string-to-number
- (buffer-substring (save-excursion
- (backward-word 1)
- (setq pos (point)))
+ ;; Another issue is that GNU ls -n right-justifies numerical
+ ;; UIDs and GIDs, while FreeBSD left-justifies them, so
+ ;; don't rely on a specific whitespace layout. Both of them
+ ;; right-justify all other numbers, though.
+ ;; XXX Return a number if the uid or gid seems to be
+ ;; numerical?
+ (setq uid (buffer-substring (progn
+ (skip-chars-forward " \t")
+ (point))
+ (progn
+ (skip-chars-forward "^ \t")
(point))))
- (goto-char pos)
- (backward-word 1)
- ;; if no gid is displayed, gid will be set to uid
- ;; but user will then not reference it anyway in PREDICATE.
- (setq gid (buffer-substring (save-excursion
- (forward-word 1) (point))
+ (dired-move-to-filename)
+ (save-excursion
+ (setq time
+ ;; The regexp below tries to match from the last
+ ;; digit of the size field through a space after the
+ ;; date. Also, dates may have different formats
+ ;; depending on file age, so the date column need
+ ;; not be aligned to the right.
+ (buffer-substring (save-excursion
+ (skip-chars-backward " \t")
(point))
- time (buffer-substring (match-beginning 1)
- (1- (dired-move-to-filename)))
- name (buffer-substring (point)
- (or
- (dired-move-to-end-of-filename t)
- (point)))
- sym (if (looking-at-p " -> ")
- (buffer-substring (progn (forward-char 4) (point))
- (line-end-position))
- ""))
+ (progn
+ (re-search-backward
+ directory-listing-before-filename-regexp)
+ (skip-chars-forward "^ \t")
+ (1+ (point))))
+ size (dired-x--string-to-number
+ ;; We know that there's some kind of number
+ ;; before point because the regexp search
+ ;; above succeeded. I don't think it's worth
+ ;; doing an extra check for leading garbage.
+ (buffer-substring (point)
+ (progn
+ (skip-chars-backward "^ \t")
+ (point))))
+ ;; If no gid is displayed, gid will be set to uid
+ ;; but the user will then not reference it anyway in
+ ;; PREDICATE.
+ gid (buffer-substring (progn
+ (skip-chars-backward " \t")
+ (point))
+ (progn
+ (skip-chars-backward "^ \t")
+ (point)))))
+ (setq name (buffer-substring (point)
+ (or
+ (dired-move-to-end-of-filename t)
+ (point)))
+ sym (if (looking-at " -> ")
+ (buffer-substring (progn (forward-char 4) (point))
+ (line-end-position))
+ ""))
t)
- (eval predicate)))
+ (eval predicate
+ `((inode . ,inode)
+ (s . ,s)
+ (mode . ,mode)
+ (nlink . ,nlink)
+ (uid . ,uid)
+ (gid . ,gid)
+ (size . ,size)
+ (time . ,time)
+ (name . ,name)
+ (sym . ,sym)))))
(format "'%s file" predicate))))
diff --git a/lisp/dired.el b/lisp/dired.el
index f830623a255..5f0a83afd04 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1,10 +1,10 @@
;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992-1997, 2000-2013 Free Software
+;; Copyright (C) 1985-1986, 1992-1997, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Package: emacs
@@ -91,7 +91,7 @@ spaces. You might want to install ls from GNU Coreutils, which does
support this option. Alternatively, you might want to use Emacs's
own emulation of \"ls\", by using:
(setq ls-lisp-use-insert-directory-program nil)
- (require 'ls-lisp)
+ (require \\='ls-lisp)
This is used by default on MS Windows, which does not have an \"ls\" program.
Note that `ls-lisp' does not support as many options as GNU ls, though.
For more details, see Info node `(emacs)ls in Lisp'."
@@ -220,9 +220,9 @@ with the buffer narrowed to the listing."
;; Note this can't simply be run inside function `dired-ls' as the hook
;; functions probably depend on the dired-subdir-alist to be OK.
-(defcustom dired-initial-point-hook nil
+(defcustom dired-initial-position-hook nil
"This hook is used to position the point.
-It is run the function `dired-initial-position'."
+It is run by the function `dired-initial-position'."
:group 'dired
:type 'hook
:version "24.4")
@@ -241,13 +241,13 @@ new Dired buffers."
:group 'dired)
(defcustom dired-hide-details-hide-symlink-targets t
- "If non-nil, `dired-hide-details-mode' hides symbolic link targets."
+ "Non-nil means `dired-hide-details-mode' hides symbolic link targets."
:type 'boolean
:version "24.4"
:group 'dired)
(defcustom dired-hide-details-hide-information-lines t
- "Non-nil means hide lines other than header and file/dir lines."
+ "Non-nil means `dired-hide-details-mode' hides all but header and file lines."
:type 'boolean
:version "24.4"
:group 'dired)
@@ -634,7 +634,8 @@ Optional second argument ARG, if non-nil, specifies files near
point instead of marked files. It usually comes from the prefix
argument.
If ARG is an integer, use the next ARG files.
- Any other non-nil value means to use the current file instead.
+ If ARG is any other non-nil value, return the current file name.
+ If no files are marked, and ARG is nil, also return the current file name.
Optional third argument FILTER, if non-nil, is a function to select
some of the files--those for which (funcall FILTER FILENAME) is non-nil.
@@ -733,7 +734,9 @@ Don't use that together with FILTER."
(defun dired-file-name-at-point ()
"Try to get a file name at point in the current dired buffer.
-This hook is intended to be put in `file-name-at-point-functions'."
+This hook is intended to be put in `file-name-at-point-functions'.
+Note that it returns an abbreviated name that can't be used
+as an argument to `dired-goto-file'."
(let ((filename (dired-get-filename nil t)))
(when filename
(if (file-directory-p filename)
@@ -746,10 +749,16 @@ This hook is intended to be put in `file-name-at-point-functions'."
"\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Optional second argument SWITCHES specifies the `ls' options used.
\(Interactively, use a prefix argument to be able to specify SWITCHES.)
-Dired displays a list of files in DIRNAME (which may also have
-shell wildcards appended to select certain files). If DIRNAME is a cons,
-its first element is taken as the directory name and the rest as an explicit
-list of files to make directory entries for.
+
+If DIRNAME is a string, Dired displays a list of files in DIRNAME (which
+may also have shell wildcards appended to select certain files).
+
+If DIRNAME is a cons, its first element is taken as the directory name
+and the rest as an explicit list of files to make directory entries for.
+In this case, SWITCHES are applied to each of the files separately, and
+therefore switches that control the order of the files in the produced
+listing have no effect.
+
\\<dired-mode-map>\
You can flag files for deletion with \\[dired-flag-file-deletion] and then
delete them by typing \\[dired-do-flagged-delete].
@@ -1139,10 +1148,22 @@ BEG..END is the line where the file info is located."
(defvar ls-lisp-use-insert-directory-program)
+(defun dired-check-switches (switches short &optional long)
+ "Return non-nil if the string SWITCHES matches LONG or SHORT format."
+ (let (case-fold-search)
+ (and (stringp switches)
+ (string-match-p (concat "\\(\\`\\| \\)-[[:alnum:]]*" short
+ (if long (concat "\\|--" long "\\>") ""))
+ switches))))
+
(defun dired-switches-escape-p (switches)
"Return non-nil if the string SWITCHES contains -b or --escape."
;; Do not match things like "--block-size" that happen to contain "b".
- (string-match-p "\\(\\`\\| \\)-[[:alnum:]]*b\\|--escape\\>" switches))
+ (dired-check-switches switches "b" "escape"))
+
+(defun dired-switches-recursive-p (switches)
+ "Return non-nil if the string SWITCHES contains -R or --recursive."
+ (dired-check-switches switches "R" "recursive"))
(defun dired-insert-directory (dir switches &optional file-list wildcard hdr)
"Insert a directory listing of DIR, Dired style.
@@ -1247,9 +1268,11 @@ see `dired-use-ls-dired' for more details.")
(while (< (point) end)
(ignore-errors
(if (not (dired-move-to-filename))
- (put-text-property (line-beginning-position)
- (1+ (line-end-position))
- 'invisible 'dired-hide-details-information)
+ (unless (or (looking-at-p "^$")
+ (looking-at-p dired-subdir-regexp))
+ (put-text-property (line-beginning-position)
+ (1+ (line-end-position))
+ 'invisible 'dired-hide-details-information))
(put-text-property (+ (line-beginning-position) 1) (1- (point))
'invisible 'dired-hide-details-detail)
(add-text-properties
@@ -1397,7 +1420,7 @@ Each element of ALIST looks like (FILE . MARKERCHAR)."
(defun dired-insert-old-subdirs (old-subdir-alist)
"Try to insert all subdirs that were displayed before.
Do so according to the former subdir alist OLD-SUBDIR-ALIST."
- (or (string-match-p "R" dired-actual-switches)
+ (or (dired-switches-recursive-p dired-actual-switches)
(let (elt dir)
(while old-subdir-alist
(setq elt (car old-subdir-alist)
@@ -1443,6 +1466,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map "T" 'dired-do-touch)
(define-key map "X" 'dired-do-shell-command)
(define-key map "Z" 'dired-do-compress)
+ (define-key map "c" 'dired-do-compress-to)
(define-key map "!" 'dired-do-shell-command)
(define-key map "&" 'dired-do-async-shell-command)
;; Comparison commands
@@ -1783,22 +1807,22 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
(define-key map
[menu-bar operate epa-dired-do-decrypt]
'(menu-item "Decrypt..." epa-dired-do-decrypt
- :help "Decrypt file at cursor"))
+ :help "Decrypt current or marked files"))
(define-key map
[menu-bar operate epa-dired-do-verify]
'(menu-item "Verify" epa-dired-do-verify
- :help "Verify digital signature of file at cursor"))
+ :help "Verify digital signature of current or marked files"))
(define-key map
[menu-bar operate epa-dired-do-sign]
'(menu-item "Sign..." epa-dired-do-sign
- :help "Create digital signature of file at cursor"))
+ :help "Create digital signature of current or marked files"))
(define-key map
[menu-bar operate epa-dired-do-encrypt]
'(menu-item "Encrypt..." epa-dired-do-encrypt
- :help "Encrypt file at cursor"))
+ :help "Encrypt current or marked files"))
(define-key map [menu-bar operate dashes-3]
'("--"))
@@ -1895,7 +1919,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands.
to see why something went wrong.
Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
-Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'.
+Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'.
Type \\[dired-find-file] to Find the current line's file
(or dired it in another buffer, if it is a directory).
Type \\[dired-find-file-other-window] to find file or Dired directory in Other window.
@@ -1998,7 +2022,7 @@ Actual changes in files cannot be undone by Emacs."))
"Edit Dired buffer with Wdired, or make it read-only.
If the current buffer can be edited with Wdired, (i.e. the major
mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
-Otherwise, call `toggle-read-only'."
+Otherwise, toggle `read-only-mode'."
(interactive)
(if (derived-mode-p 'dired-mode)
(wdired-change-to-wdired-mode)
@@ -2043,7 +2067,9 @@ Optional prefix ARG says how many lines to move; default is one line."
(defun dired-up-directory (&optional other-window)
"Run Dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
-Creates a buffer if necessary."
+Creates a buffer if necessary.
+If OTHER-WINDOW (the optional prefix arg), display the parent
+directory in another window."
(interactive "P")
(let* ((dir (dired-current-directory))
(up (file-name-directory (directory-file-name dir))))
@@ -2131,7 +2157,8 @@ Otherwise, display it in another buffer."
(defun dired-display-file ()
"In Dired, display this file or directory in another window."
(interactive)
- (display-buffer (find-file-noselect (dired-get-file-for-visit))))
+ (display-buffer (find-file-noselect (dired-get-file-for-visit))
+ t))
;;; Functions for extracting and manipulating file names in Dired buffers.
@@ -2265,10 +2292,13 @@ unchanged."
(substring file (match-end 0))
file))
-;;; Minor mode for hiding details
-;;;###autoload
(define-minor-mode dired-hide-details-mode
- "Hide details in Dired mode."
+ "Toggle visibility of detailed information in current Dired buffer.
+When this minor mode is enabled, details such as file ownership and
+permissions are hidden from view.
+
+See options: `dired-hide-details-hide-symlink-targets' and
+`dired-hide-details-hide-information-lines'."
:group 'dired
(unless (derived-mode-p 'dired-mode)
(error "Not a Dired buffer"))
@@ -2338,9 +2368,8 @@ Return the position of the beginning of the filename, or nil if none found."
;; This is the UNIX version.
(if (get-text-property (point) 'dired-filename)
(goto-char (next-single-property-change (point) 'dired-filename))
- (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
- ;; case-fold-search is nil now, so we can test for capital F:
- (setq used-F (string-match-p "F" dired-actual-switches)
+ (let (opoint file-type executable symlink hidden used-F eol)
+ (setq used-F (dired-check-switches dired-actual-switches "F" "classify")
opoint (point)
eol (line-end-position)
hidden (and selective-display
@@ -2602,7 +2631,7 @@ instead of `dired-actual-switches'."
(R-ftp-base-dir-regex
;; Used to expand subdirectory names correctly in recursive
;; ange-ftp listings.
- (and (string-match-p "R" switches)
+ (and (dired-switches-recursive-p switches)
(string-match "\\`/.*:\\(/.*\\)" default-directory)
(concat "\\`" (match-string 1 default-directory)))))
(goto-char (point-min))
@@ -2757,13 +2786,13 @@ as returned by `dired-get-filename'. LIMIT is the search limit."
;; FIXME document whatever dired-x is doing.
(defun dired-initial-position (dirname)
"Where point should go in a new listing of DIRNAME.
-Point assumed at beginning of new subdir line.
+Point is assumed to be at the beginning of new subdir line.
It runs the hook `dired-initial-position-hook'."
(end-of-line)
(and (featurep 'dired-x) dired-find-subdir
(dired-goto-subdir dirname))
(if dired-trivial-filenames (dired-goto-next-nontrivial-file))
- (run-hooks 'dired-initial-point-hook))
+ (run-hooks 'dired-initial-position-hook))
;; These are hooks which make tree dired work.
;; They are in this file because other parts of dired need to call them.
@@ -2828,11 +2857,16 @@ Any other value means to ask for each directory."
;; to e.g. recursive-delete-file and put it somewhere else.
(defun dired-delete-file (file &optional recursive trash) "\
Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
-RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
-nil, do not delete.
-`always', delete recursively without asking.
-`top', ask for each directory at top level.
-Anything else, ask for each sub-directory."
+RECURSIVE determines what to do with a non-empty directory. The effect of
+its possible values is:
+
+ nil -- do not delete.
+ `always' -- delete recursively without asking.
+ `top' -- ask for each directory at top level.
+ Anything else -- ask for each sub-directory.
+
+TRASH non-nil means to trash the file instead of deleting, provided
+`delete-by-moving-to-trash' (which see) is non-nil."
;; This test is equivalent to
;; (and (file-directory-p fn) (not (file-symlink-p fn)))
;; but more efficient
@@ -2898,11 +2932,7 @@ non-empty directories is allowed."
(let* ((files (mapcar (function car) l))
(count (length l))
(succ 0)
- (trashing (and trash delete-by-moving-to-trash))
- (progress-reporter
- (make-progress-reporter
- (if trashing "Trashing..." "Deleting...")
- succ count)))
+ (trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
(setq files (nreverse (mapcar (function dired-make-relative) files)))
(if (dired-mark-pop-up
@@ -2911,7 +2941,11 @@ non-empty directories is allowed."
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(save-excursion
- (let (failures);; files better be in reverse order for this loop!
+ (let ((progress-reporter
+ (make-progress-reporter
+ (if trashing "Trashing..." "Deleting...")
+ succ count))
+ failures) ;; files better be in reverse order for this loop!
(while l
(goto-char (cdr (car l)))
(let ((inhibit-read-only t))
@@ -2924,7 +2958,7 @@ non-empty directories is allowed."
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
(function dired-delete-entry) fn))
- (error;; catch errors from failed deletions
+ (error ;; catch errors from failed deletions
(dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
(setq l (cdr l)))
@@ -3037,7 +3071,7 @@ or \"* [3 files]\"."
(when dired-shrink-to-fit
;; Try to not delete window when we want to display less than
;; `window-min-height' lines.
- (fit-window-to-buffer (get-buffer-window buf) nil 1)))
+ (fit-window-to-buffer (get-buffer-window buf) nil 1 nil nil t)))
(defcustom dired-no-confirm nil
"A list of symbols for commands Dired should not confirm, or t.
@@ -3077,26 +3111,29 @@ argument or confirmation)."
;; If FILES defaulted to the current line's file.
(= (length files) 1))
(apply function args)
- (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))))
- (with-current-buffer buffer
- (let ((split-height-threshold 0))
- (with-temp-buffer-window
- buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)))
- #'(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.
- (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))))))))
+ (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*")))
+ ;; 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
+ buffer
+ (cons 'display-buffer-below-selected
+ '((window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))))
+ #'(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)))))))
(defun dired-format-columns-of-files (files)
(let ((beg (point)))
@@ -3136,7 +3173,9 @@ argument or confirmation)."
(save-excursion (not (dired-move-to-filename))))
(defun dired-next-marked-file (arg &optional wrap opoint)
- "Move to the next marked file, wrapping around the end of the buffer."
+ "Move to the next marked file.
+If WRAP is non-nil, wrap around to the beginning of the buffer if
+we reach the end."
(interactive "p\np")
(or opoint (setq opoint (point)));; return to where interactively started
(if (if (> arg 0)
@@ -3153,7 +3192,9 @@ argument or confirmation)."
(dired-next-marked-file arg nil opoint))))
(defun dired-prev-marked-file (arg &optional wrap)
- "Move to the previous marked file, wrapping around the end of the buffer."
+ "Move to the previous marked file.
+If WRAP is non-nil, wrap around to the end of the buffer if we
+reach the beginning of the buffer."
(interactive "p\np")
(dired-next-marked-file (- arg) wrap))
@@ -3273,6 +3314,8 @@ As always, hidden subdirs are not affected."
"History list of regular expressions used in Dired commands.")
(defun dired-read-regexp (prompt &optional default history)
+ "Read a regexp using `read-regexp'."
+ (declare (obsolete read-regexp "24.5"))
(read-regexp prompt default (or history 'dired-regexp-history)))
(defun dired-mark-files-regexp (regexp &optional marker-char)
@@ -3283,8 +3326,9 @@ A prefix argument means to unmark them instead.
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
- (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
- " files (regexp): "))
+ (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
+ " files (regexp): ")
+ nil 'dired-regexp-history)
(if current-prefix-arg ?\040)))
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
@@ -3299,8 +3343,9 @@ object files--just `.o' will mark more than you might think."
A prefix argument means to unmark them instead.
`.' and `..' are never marked."
(interactive
- (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
- " files containing (regexp): "))
+ (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
+ " files containing (regexp): ")
+ nil 'dired-regexp-history)
(if current-prefix-arg ?\040)))
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
@@ -3330,7 +3375,8 @@ A prefix argument means to unmark them instead.
The match is against the non-directory part of the filename. Use `^'
and `$' to anchor matches. Exclude subdirs by hiding them.
`.' and `..' are never flagged."
- (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
+ (interactive (list (read-regexp "Flag for deletion (regexp): "
+ nil 'dired-regexp-history)))
(dired-mark-files-regexp regexp dired-del-marker))
(defun dired-mark-symlinks (unflag-p)
@@ -3449,6 +3495,9 @@ OLD and NEW are both characters used to mark files."
(interactive)
(dired-unmark-all-files ?\r))
+;; Bound in dired-unmark-all-files
+(defvar dired-unmark-all-files-query)
+
(defun dired-unmark-all-files (mark &optional arg)
"Remove a specific mark (or any mark) from every file.
After this command, type the mark character to remove,
@@ -3459,6 +3508,7 @@ Type \\[help-command] at that time for help."
(save-excursion
(let* ((count 0)
(inhibit-read-only t) case-fold-search
+ dired-unmark-all-files-query
(string (format "\n%c" mark))
(help-form "\
Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
@@ -3470,7 +3520,8 @@ Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
(if (or (not arg)
(let ((file (dired-get-filename t t)))
(and file
- (dired-query 'query "Unmark file `%s'? "
+ (dired-query 'dired-unmark-all-files-query
+ "Unmark file `%s'? "
file))))
(progn (subst-char-in-region (1- (point)) (point)
(preceding-char) ?\s)
@@ -3513,7 +3564,7 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
(let ((inhibit-read-only t))
(cond ((stringp log)
(insert (if args
- (apply (function format) log args)
+ (apply #'format-message log args)
log)))
((bufferp log)
(insert-buffer-substring log))
@@ -3522,7 +3573,7 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
(unless (bolp)
(insert "\n"))
(insert (current-time-string)
- "\tBuffer `" (buffer-name obuf) "'\n")
+ (format-message "\tBuffer `%s'\n" (buffer-name obuf)))
(goto-char (point-max))
(insert "\f\n")))))))
@@ -3627,6 +3678,7 @@ With a prefix argument, edit the current listing switches instead."
;; Remove a switch of the form -XtY for some X and Y.
(setq dired-actual-switches
(replace-match "" t t dired-actual-switches 3))))
+
;; Now, if we weren't sorting by date before, add the -t switch.
;; Some simple-minded ls implementations (eg ftp servers) only
;; allow a single option string, so try not to add " -t" if possible.
@@ -3672,12 +3724,12 @@ Saves `dired-subdir-alist' when R is set and restores saved value
minus any directories explicitly deleted when R is cleared.
To be called first in body of `dired-sort-other', etc."
(cond
- ((and (string-match-p "R" switches)
- (not (string-match-p "R" dired-actual-switches)))
+ ((and (dired-switches-recursive-p switches)
+ (not (dired-switches-recursive-p dired-actual-switches)))
;; Adding -R to ls switches -- save `dired-subdir-alist':
(setq dired-subdir-alist-pre-R dired-subdir-alist))
- ((and (string-match-p "R" dired-actual-switches)
- (not (string-match-p "R" switches)))
+ ((and (dired-switches-recursive-p dired-actual-switches)
+ (not (dired-switches-recursive-p switches)))
;; Deleting -R from ls switches -- revert to pre-R subdirs
;; that are still present:
(setq dired-subdir-alist
@@ -3765,7 +3817,8 @@ Ask means pop up a menu for the user to select one of copy, move or link."
((memq action '(copy private move link))
(let ((overwrite (and (file-exists-p to)
(y-or-n-p
- (format "Overwrite existing file `%s'? " to))))
+ (format-message
+ "Overwrite existing file `%s'? " to))))
;; Binding dired-overwrite-confirmed to nil makes
;; dired-handle-overwrite a no-op. We instead use
;; y-or-n-p, which pops a graphical menu.
@@ -3778,7 +3831,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(car (find-backup-file-name to)))
(or (eq dired-backup-overwrite 'always)
(y-or-n-p
- (format
+ (format-message
"Make backup for existing file `%s'? " to))))
(rename-file to backup-file 0)
(dired-relist-entry backup-file))
@@ -3833,7 +3886,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(let* ((dired-dir (car misc-data))
(dir (if (consp dired-dir) (car dired-dir) dired-dir)))
(if (file-directory-p (file-name-directory dir))
- (progn
+ (with-demoted-errors "Desktop: Problem restoring directory: %S"
(dired dired-dir)
;; The following elements of `misc-data' are the keys
;; from `dired-subdir-alist'.
@@ -3849,7 +3902,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;; Start of automatically extracted autoloads.
-;;;### (autoloads nil "dired-aux" "dired-aux.el" "04b4cb6bde3220f55574eb1d99ac0d29")
+;;;### (autoloads nil "dired-aux" "dired-aux.el" "29842a53d6651f8f535ec8e02d20d7cc")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
@@ -4041,8 +4094,18 @@ command with a prefix argument (the value does not matter).
\(fn &optional ARG FMT)" t nil)
-(autoload 'dired-compress-file "dired-aux" "\
+(autoload 'dired-do-compress-to "dired-aux" "\
+Compress selected files and directories to an archive.
+You are prompted for the archive name.
+The archiving command is chosen based on the archive name extension and
+`dired-compress-files-alist'.
+
+\(fn)" t nil)
+(autoload 'dired-compress-file "dired-aux" "\
+Compress or uncompress FILE.
+Return the name of the compressed or uncompressed file.
+Return nil if no change in files.
\(fn FILE)" nil nil)
@@ -4352,7 +4415,7 @@ instead.
;;;***
-;;;### (autoloads nil "dired-x" "dired-x.el" "1419d865898f84c17f172320e578380c")
+;;;### (autoloads nil "dired-x" "dired-x.el" "06f532e2e812fa1cb10ade31249e9700")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index e73cf279e51..ab7e34cb7eb 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -1,6 +1,6 @@
;;; dirtrack.el --- Directory Tracking by watching the prompt
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 17 1996
@@ -51,7 +51,7 @@
;; which matches your prompt up to and including the pathname part.
;; The second is a number which tells which regular expression group to
;; match to extract only the pathname. If you use a multi-line prompt,
-;; add 't' as a third element. Note that some of the functions in
+;; add t as a third element. Note that some of the functions in
;; 'comint.el' assume a single-line prompt (eg, comint-bol).
;;
;; Determining this information may take some experimentation. Using
@@ -218,7 +218,7 @@ the mode if ARG is omitted or nil."
(when dirtrack-debug-mode
(with-current-buffer (get-buffer-create dirtrack-debug-buffer)
(goto-char (point-max))
- (insert msg1 msg2 "\n"))))
+ (insert (substitute-command-keys msg1) msg2 "\n"))))
(declare-function shell-prefixed-directory-name "shell" (dir))
(declare-function shell-process-cd "shell" (arg))
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 7c75b38c9d4..62ed10218e4 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -1,11 +1,11 @@
;;; disp-table.el --- functions for dealing with char tables
-;; Copyright (C) 1987, 1994-1995, 1999, 2001-2013 Free Software
+;; Copyright (C) 1987, 1994-1995, 1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Based on a previous version by Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Package: emacs
@@ -281,7 +281,8 @@ in `.emacs'."
(set-terminal-coding-system nil))))
(display-warning 'i18n
- "`standard-display-european' is semi-obsolete; see its doc string for details"
+ (format-message
+ "`standard-display-european' is semi-obsolete; see its doc string for details")
:warning)
;; Switch to Latin-1 language environment
diff --git a/lisp/dnd.el b/lisp/dnd.el
index d9061273c32..d4fb0889f0a 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -1,9 +1,9 @@
-;;; dnd.el --- drag and drop support. -*- coding: utf-8 -*-
+;;; dnd.el --- drag and drop support
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: window, drag, drop
;; Package: emacs
@@ -122,17 +122,18 @@ Return nil if URI is not a local file."
;; The hostname may be our hostname, in that case, convert to a local
;; file. Otherwise return nil. TODO: How about an IP-address as hostname?
- (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
+ (let ((sysname (system-name)))
+ (let ((hostname (when (string-match "^file://\\([^/]*\\)" uri)
(downcase (match-string 1 uri))))
- (system-name-no-dot
- (downcase (if (string-match "^[^\\.]+" system-name)
- (match-string 0 system-name)
- system-name))))
- (when (and hostname
- (or (string-equal "localhost" hostname)
- (string-equal (downcase system-name) hostname)
- (string-equal system-name-no-dot hostname)))
- (concat "file://" (substring uri (+ 7 (length hostname)))))))
+ (sysname-no-dot
+ (downcase (if (string-match "^[^\\.]+" sysname)
+ (match-string 0 sysname)
+ sysname))))
+ (when (and hostname
+ (or (string-equal "localhost" hostname)
+ (string-equal (downcase sysname) hostname)
+ (string-equal sysname-no-dot hostname)))
+ (concat "file://" (substring uri (+ 7 (length hostname))))))))
(defsubst dnd-unescape-uri (uri)
(replace-regexp-in-string
@@ -152,10 +153,13 @@ Return nil if URI is not a local file."
(let ((f (cond ((string-match "^file:///" uri) ; XDND format.
(substring uri (1- (match-end 0))))
((string-match "^file:" uri) ; Old KDE, Motif, Sun
- (substring uri (match-end 0))))))
- (and f (setq f (decode-coding-string (dnd-unescape-uri f)
- (or file-name-coding-system
- default-file-name-coding-system))))
+ (substring uri (match-end 0)))))
+ (coding (if (equal system-type 'windows-nt)
+ ;; W32 pretends that file names are UTF-8 encoded.
+ 'utf-8
+ (or file-name-coding-system
+ default-file-name-coding-system))))
+ (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 589a57b64c2..edc001455c9 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1,6 +1,6 @@
;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;;
;; Author: Tassilo Horn <tsdh@gnu.org>
;; Maintainer: Tassilo Horn <tsdh@gnu.org>
@@ -198,6 +198,7 @@ Higher values result in larger images."
If nil, the document is re-rendered every time the scaling factor is modified.
This only has an effect if the image libraries linked with Emacs support
scaling."
+ :version "24.4"
:type 'boolean)
(defcustom doc-view-image-width 850
@@ -335,7 +336,7 @@ of the page moves to the previous page."
;; Don't do it if there's a conversion is running, since in that case, it
;; will be done later.
(with-selected-window (car winprops)
- (doc-view-goto-page 1)))))
+ (doc-view-goto-page (image-mode-window-get 'page t))))))
(defvar-local doc-view--current-files nil
"Only used internally.")
@@ -405,13 +406,15 @@ Typically \"page-%s.png\".")
(define-key map (kbd "RET") 'image-next-line)
;; Zoom in/out.
(define-key map "+" 'doc-view-enlarge)
+ (define-key map "=" 'doc-view-enlarge)
(define-key map "-" 'doc-view-shrink)
+ (define-key map "0" 'doc-view-scale-reset)
+ (define-key map [remap text-scale-adjust] 'doc-view-scale-adjust)
;; Fit the image to the window
(define-key map "W" 'doc-view-fit-width-to-window)
(define-key map "H" 'doc-view-fit-height-to-window)
(define-key map "P" 'doc-view-fit-page-to-window)
;; Killing the buffer (and the process)
- (define-key map (kbd "k") 'doc-view-kill-proc-and-buffer)
(define-key map (kbd "K") 'doc-view-kill-proc)
;; Slicing the image
(define-key map (kbd "s s") 'doc-view-set-slice)
@@ -437,10 +440,23 @@ Typically \"page-%s.png\".")
(defun doc-view-revert-buffer (&optional ignore-auto noconfirm)
"Like `revert-buffer', but preserves the buffer's current modes."
- ;; FIXME: this should probably be moved to files.el and used for
- ;; most/all "g" bindings to revert-buffer.
(interactive (list (not current-prefix-arg)))
- (revert-buffer ignore-auto noconfirm 'preserve-modes))
+ (cl-labels ((revert ()
+ (let (revert-buffer-function)
+ (revert-buffer ignore-auto noconfirm 'preserve-modes))))
+ (if (and (eq 'pdf doc-view-doc-type)
+ (executable-find "pdfinfo"))
+ ;; We don't want to revert if the PDF file is corrupted which
+ ;; might happen when it it currently recompiled from a tex
+ ;; file. (TODO: We'd like to have something like that also
+ ;; for other types, at least PS, but I don't know a good way
+ ;; to test if a PS file is complete.)
+ (if (= 0 (call-process (executable-find "pdfinfo") nil nil nil
+ doc-view--buffer-file-name))
+ (revert)
+ (when (called-interactively-p 'interactive)
+ (message "Can't revert right now because the file is corrupted.")))
+ (revert))))
(easy-menu-define doc-view-menu doc-view-mode-map
@@ -496,6 +512,7 @@ Typically \"page-%s.png\".")
;; how many pages will be available.
(null doc-view--current-converter-processes))
(setq page len)))
+ (force-mode-line-update) ;To update `current-page'.
(setf (doc-view-current-page) page
(doc-view-current-info)
(concat
@@ -640,25 +657,15 @@ at the top edge of the page moves to the previous page."
(setq doc-view--current-timer nil))
(setq mode-line-process nil))
-(defun doc-view-kill-proc-and-buffer ()
- "Kill the current converter process and buffer."
- (interactive)
- (doc-view-kill-proc)
- (when (eq major-mode 'doc-view-mode)
- (kill-buffer (current-buffer))))
+(define-obsolete-function-alias 'doc-view-kill-proc-and-buffer
+ #'image-kill-buffer "25.1")
(defun doc-view-make-safe-dir (dir)
(condition-case nil
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- ;; 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.
- (set-default-file-modes #o0700)
- (make-directory dir))
- ;; Reset the umask.
- (set-default-file-modes umask)))
+ ;; 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.
+ (with-file-modes #o0700 (make-directory dir))
(file-already-exists
(when (file-symlink-p dir)
(error "Danger: %s points to a symbolic link" dir))
@@ -753,6 +760,38 @@ OpenDocument format)."
(interactive (list doc-view-shrink-factor))
(doc-view-enlarge (/ 1.0 factor)))
+(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))
+ (progn
+ (kill-local-variable 'doc-view-image-width)
+ (doc-view-insert-image
+ (plist-get (cdr (doc-view-current-image)) :file)
+ :width doc-view-image-width))
+ (kill-local-variable 'doc-view-resolution)
+ (doc-view-reconvert-doc)))
+
+(defun doc-view-scale-adjust (factor)
+ "Adjust the scale of the DocView page images by FACTOR.
+FACTOR defaults to `doc-view-shrink-factor'.
+
+The actual adjustment made depends on the final component of the
+key-binding used to invoke the command, with all modifiers removed:
+
+ +, = Increase the image scale by FACTOR
+ - Decrease the image scale by FACTOR
+ 0 Reset the image scale to the initial scale"
+ (interactive (list doc-view-shrink-factor))
+ (let ((ev last-command-event)
+ (echo-keystrokes nil))
+ (pcase (event-basic-type ev)
+ ((or ?+ ?=) (doc-view-enlarge factor))
+ (?- (doc-view-shrink factor))
+ (?0 (doc-view-scale-reset)))))
+
(defun doc-view-fit-width-to-window ()
"Fit the image width to the window width."
(interactive)
@@ -1361,18 +1400,28 @@ For now these keys are useful:
(tooltip-show (doc-view-current-info)))
(defun doc-view-open-text ()
- "Open a buffer with the current doc's contents as text."
+ "Display the current doc's contents as text."
(interactive)
(if doc-view--current-converter-processes
(message "DocView: please wait till conversion finished.")
(let ((txt (expand-file-name "doc.txt" (doc-view--current-cache-dir))))
(if (file-readable-p txt)
- (let ((name (concat "Text contents of "
- (file-name-nondirectory buffer-file-name)))
- (dir (file-name-directory buffer-file-name)))
- (with-current-buffer (find-file txt)
- (rename-buffer name)
- (setq default-directory dir)))
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t)
+ (dv-bfn doc-view--buffer-file-name))
+ (erase-buffer)
+ (set-buffer-multibyte t)
+ (insert-file-contents txt)
+ (text-mode)
+ (setq-local doc-view--buffer-file-name dv-bfn)
+ (set-buffer-modified-p nil)
+ (doc-view-minor-mode)
+ (add-hook 'write-file-functions
+ (lambda ()
+ (when (eq major-mode 'text-mode)
+ (error "Cannot save text contents of document %s"
+ buffer-file-name)))
+ nil t))
(doc-view-doc->txt txt 'doc-view-open-text)))))
;;;;; Toggle between editing and viewing
@@ -1384,20 +1433,30 @@ For now these keys are useful:
(defun doc-view-toggle-display ()
"Toggle between editing a document as text or viewing it."
(interactive)
- (if (eq major-mode 'doc-view-mode)
- ;; Switch to editing mode
- (progn
- (doc-view-kill-proc)
- (setq buffer-read-only nil)
- ;; Switch to the previously used major mode or fall back to
- ;; normal mode.
- (doc-view-fallback-mode)
- (doc-view-minor-mode 1))
+ (cond
+ ((eq major-mode 'doc-view-mode)
+ ;; Switch to editing mode
+ (doc-view-kill-proc)
+ (setq buffer-read-only nil)
+ ;; Switch to the previously used major mode or fall back to
+ ;; normal mode.
+ (doc-view-fallback-mode)
+ (doc-view-minor-mode 1))
+ ((eq major-mode 'text-mode)
+ (let ((buffer-undo-list t))
+ ;; We're currently viewing the document's text contents, so switch
+ ;; back to .
+ (setq buffer-read-only nil)
+ (insert-file-contents doc-view--buffer-file-name nil nil nil t)
+ (doc-view-fallback-mode)
+ (doc-view-minor-mode 1)
+ (set-buffer-modified-p nil)))
+ (t
;; Switch to doc-view-mode
(when (and (buffer-modified-p)
(y-or-n-p "The buffer has been modified. Save the changes? "))
(save-buffer))
- (doc-view-mode)))
+ (doc-view-mode))))
;;;; Searching
@@ -1553,11 +1612,11 @@ If BACKWARD is non-nil, jump to the previous match."
(concat "No PNG support is available, or some conversion utility for "
(file-name-extension doc-view--buffer-file-name)
" files is missing."))
- (when (and (executable-find doc-view-pdftotext-program)
- (y-or-n-p
- "Unable to render file. View extracted text instead? "))
- (doc-view-open-text))
- (doc-view-toggle-display)))
+ (if (and (executable-find doc-view-pdftotext-program)
+ (y-or-n-p
+ "Unable to render file. View extracted text instead? "))
+ (doc-view-open-text)
+ (doc-view-toggle-display))))
(defvar bookmark-make-record-function)
@@ -1584,24 +1643,26 @@ If BACKWARD is non-nil, jump to the previous match."
"Figure out the current document type (`doc-view-doc-type')."
(let ((name-types
(when buffer-file-name
- (cdr (assoc (file-name-extension buffer-file-name)
- '(
- ;; DVI
- ("dvi" dvi)
- ;; PDF
- ("pdf" pdf) ("epdf" pdf)
- ;; PostScript
- ("ps" ps) ("eps" ps)
- ;; DjVu
- ("djvu" djvu)
- ;; OpenDocument formats
- ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf)
- ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf)
- ("ots" odf) ("otp" odf) ("otg" odf)
- ;; Microsoft Office formats (also handled
- ;; by the odf conversion chain)
- ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf)
- ("ppt" odf) ("pptx" odf))))))
+ (cdr (assoc-string
+ (file-name-extension buffer-file-name)
+ '(
+ ;; DVI
+ ("dvi" dvi)
+ ;; PDF
+ ("pdf" pdf) ("epdf" pdf)
+ ;; PostScript
+ ("ps" ps) ("eps" ps)
+ ;; DjVu
+ ("djvu" djvu)
+ ;; OpenDocument formats.
+ ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf)
+ ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf)
+ ("ots" odf) ("otp" odf) ("otg" odf)
+ ;; Microsoft Office formats (also handled by the odf
+ ;; conversion chain).
+ ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf)
+ ("ppt" odf) ("pps" odf) ("pptx" odf) ("rtf" odf))
+ t))))
(content-types
(save-excursion
(goto-char (point-min))
@@ -1632,6 +1693,9 @@ If BACKWARD is non-nil, jump to the previous match."
;; desktop.el integration
(defun doc-view-desktop-save-buffer (_desktop-dirname)
+ ;; FIXME: This is wrong, since this info is per-window but we only do it once
+ ;; here for the buffer. IOW it should be saved via something like
+ ;; `window-persistent-parameters'.
`((page . ,(doc-view-current-page))
(slice . ,(doc-view-current-slice))))
@@ -1642,8 +1706,13 @@ If BACKWARD is non-nil, jump to the previous match."
(let ((page (cdr (assq 'page misc)))
(slice (cdr (assq 'slice misc))))
(desktop-restore-file-buffer file name misc)
+ ;; FIXME: We need to run this code after displaying the buffer.
(with-selected-window (or (get-buffer-window (current-buffer) 0)
(selected-window))
+ ;; FIXME: This should be done for all windows restored that show
+ ;; this buffer. Basically, the page/slice should be saved as
+ ;; window-parameters in the window-state(s) and then restoring this
+ ;; window-state should call us back (to interpret/use those parameters).
(doc-view-goto-page page)
(when slice (apply 'doc-view-set-slice slice)))))
@@ -1710,6 +1779,8 @@ toggle between displaying the document or editing it as text.
(when (not (string= doc-view--buffer-file-name buffer-file-name))
(write-region nil nil doc-view--buffer-file-name))
+ (setq-local revert-buffer-function #'doc-view-revert-buffer)
+
(add-hook 'change-major-mode-hook
(lambda ()
(doc-view-kill-proc)
@@ -1733,9 +1804,12 @@ toggle between displaying the document or editing it as text.
"/" (:eval (number-to-string (doc-view-last-page-number)))))
;; Don't scroll unless the user specifically asked for it.
(setq-local auto-hscroll-mode nil)
- (setq-local mwheel-scroll-up-function #'doc-view-scroll-up-or-next-page)
- (setq-local mwheel-scroll-down-function
- #'doc-view-scroll-down-or-previous-page)
+ (if (boundp 'mwheel-scroll-up-function) ; not --without-x build
+ (setq-local mwheel-scroll-up-function
+ #'doc-view-scroll-up-or-next-page))
+ (if (boundp 'mwheel-scroll-down-function)
+ (setq-local mwheel-scroll-down-function
+ #'doc-view-scroll-down-or-previous-page))
(setq-local cursor-type nil)
(use-local-map doc-view-mode-map)
(add-hook 'after-revert-hook 'doc-view-reconvert-doc nil t)
@@ -1822,20 +1896,23 @@ See the command `doc-view-mode' for more information on this mode."
`((page . ,(doc-view-current-page))
(handler . doc-view-bookmark-jump))))
-
;;;###autoload
(defun doc-view-bookmark-jump (bmk)
;; This implements the `handler' function interface for record type
;; returned by `doc-view-bookmark-make-record', which see.
- (prog1 (bookmark-default-handler bmk)
- (let ((page (bookmark-prop-get bmk 'page)))
- (when (not (eq major-mode 'doc-view-mode))
- (doc-view-toggle-display))
- (with-selected-window
- (or (get-buffer-window (current-buffer) 0)
- (selected-window))
- (doc-view-goto-page page)))))
-
+ (let ((page (bookmark-prop-get bmk 'page))
+ (show-fn-sym (make-symbol "doc-view-bookmark-after-jump-hook")))
+ (fset show-fn-sym
+ (lambda ()
+ (remove-hook 'bookmark-after-jump-hook show-fn-sym)
+ (when (not (eq major-mode 'doc-view-mode))
+ (doc-view-toggle-display))
+ (with-selected-window
+ (or (get-buffer-window (current-buffer) 0)
+ (selected-window))
+ (doc-view-goto-page page))))
+ (add-hook 'bookmark-after-jump-hook show-fn-sym)
+ (bookmark-default-handler bmk)))
(provide 'doc-view)
diff --git a/lisp/dom.el b/lisp/dom.el
new file mode 100644
index 00000000000..091197a8f9d
--- /dev/null
+++ b/lisp/dom.el
@@ -0,0 +1,241 @@
+;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: xml, html
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+(eval-when-compile (require 'subr-x))
+
+(defsubst dom-tag (node)
+ "Return the NODE tag."
+ ;; Called on a list of nodes. Use the first.
+ (if (consp (car node))
+ (caar node)
+ (car node)))
+
+(defsubst dom-attributes (node)
+ "Return the NODE attributes."
+ ;; Called on a list of nodes. Use the first.
+ (if (consp (car node))
+ (cadr (car node))
+ (cadr node)))
+
+(defsubst dom-children (node)
+ "Return the NODE children."
+ ;; Called on a list of nodes. Use the first.
+ (if (consp (car node))
+ (cddr (car node))
+ (cddr node)))
+
+(defun dom-non-text-children (node)
+ "Return all non-text-node children of NODE."
+ (cl-loop for child in (dom-children node)
+ unless (stringp child)
+ collect child))
+
+(defun dom-set-attributes (node attributes)
+ "Set the attributes of NODE to ATTRIBUTES."
+ (setq node (dom-ensure-node node))
+ (setcar (cdr node) attributes))
+
+(defun dom-set-attribute (node attribute value)
+ "Set ATTRIBUTE in NODE to VALUE."
+ (setq node (dom-ensure-node node))
+ (let ((old (assoc attribute (cadr node))))
+ (if old
+ (setcdr old value)
+ (setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+
+(defmacro dom-attr (node attr)
+ "Return the attribute ATTR from NODE.
+A typical attribute is `href'."
+ `(cdr (assq ,attr (dom-attributes ,node))))
+
+(defun dom-text (node)
+ "Return all the text bits in the current node concatenated."
+ (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " "))
+
+(defun dom-texts (node &optional separator)
+ "Return all textual data under NODE concatenated with SEPARATOR in-between."
+ (mapconcat
+ 'identity
+ (mapcar
+ (lambda (elem)
+ (if (stringp elem)
+ elem
+ (dom-texts elem separator)))
+ (dom-children node))
+ (or separator " ")))
+
+(defun dom-child-by-tag (dom tag)
+ "Return the first child of DOM that is of type TAG."
+ (assoc tag (dom-children dom)))
+
+(defun dom-by-tag (dom tag)
+ "Return elements in DOM that is of type TAG.
+A name is a symbol like `td'."
+ (let ((matches (cl-loop for child in (dom-children dom)
+ for matches = (and (not (stringp child))
+ (dom-by-tag child tag))
+ when matches
+ append matches)))
+ (if (equal (dom-tag dom) tag)
+ (cons dom matches)
+ matches)))
+
+(defun dom-strings (dom)
+ "Return elements in DOM that are strings."
+ (cl-loop for child in (dom-children dom)
+ if (stringp child)
+ collect child
+ else
+ append (dom-strings child)))
+
+(defun dom-by-class (dom match)
+ "Return elements in DOM that have a class name that matches regexp MATCH."
+ (dom-elements dom 'class match))
+
+(defun dom-by-style (dom match)
+ "Return elements in DOM that have a style that matches regexp MATCH."
+ (dom-elements dom 'style match))
+
+(defun dom-by-id (dom match)
+ "Return elements in DOM that have an ID that matches regexp MATCH."
+ (dom-elements dom 'id match))
+
+(defun dom-elements (dom attribute match)
+ "Find elements matching MATCH (a regexp) in ATTRIBUTE.
+ATTRIBUTE would typically be `class', `id' or the like."
+ (let ((matches (cl-loop for child in (dom-children dom)
+ for matches = (and (not (stringp child))
+ (dom-elements child attribute
+ match))
+ when matches
+ append matches))
+ (attr (dom-attr dom attribute)))
+ (if (and attr
+ (string-match match attr))
+ (cons dom matches)
+ matches)))
+
+(defun dom-parent (dom node)
+ "Return the parent of NODE in DOM."
+ (if (memq node (dom-children dom))
+ dom
+ (let ((result nil))
+ (dolist (elem (dom-children dom))
+ (when (and (not result)
+ (not (stringp elem)))
+ (setq result (dom-parent elem node))))
+ result)))
+
+(defun dom-previous-sibling (dom node)
+ (when-let (parent (dom-parent dom node))
+ (let ((siblings (dom-children parent))
+ (previous nil))
+ (while siblings
+ (when (eq (cadr siblings) node)
+ (setq previous (car siblings)))
+ (pop siblings))
+ previous)))
+
+(defun dom-node (tag &optional attributes &rest children)
+ "Return a DOM node with TAG and ATTRIBUTES."
+ (if children
+ `(,tag ,attributes ,@children)
+ (list tag attributes)))
+
+(defun dom-append-child (node child)
+ "Append CHILD to the end of NODE's children."
+ (setq node (dom-ensure-node node))
+ (nconc node (list child)))
+
+(defun dom-add-child-before (node child &optional before)
+ "Add CHILD to NODE's children before child BEFORE.
+If BEFORE is nil, make CHILD NODE's first child."
+ (setq node (dom-ensure-node node))
+ (let ((children (dom-children node)))
+ (when (and before
+ (not (memq before children)))
+ (error "%s does not exist as a child" before))
+ (let ((pos (if before
+ (cl-position before children)
+ 0)))
+ (if (zerop pos)
+ ;; First child.
+ (setcdr (cdr node) (cons child (cddr node)))
+ (setcdr (nthcdr (1- pos) children)
+ (cons child (nthcdr pos children))))))
+ node)
+
+(defun dom-ensure-node (node)
+ "Ensure that NODE is a proper DOM node."
+ ;; Add empty attributes, if none.
+ (when (consp (car node))
+ (setq node (car node)))
+ (when (= (length node) 1)
+ (setcdr node (list nil)))
+ node)
+
+(defun dom-pp (dom &optional remove-empty)
+ "Pretty-print DOM at point.
+If REMOVE-EMPTY, ignore textual nodes that contain just
+white-space."
+ (let ((column (current-column)))
+ (insert (format "(%S " (dom-tag dom)))
+ (let* ((attr (dom-attributes dom))
+ (times (length attr))
+ (column (1+ (current-column))))
+ (if (null attr)
+ (insert "nil")
+ (insert "(")
+ (dolist (elem attr)
+ (insert (format "(%S . %S)" (car elem) (cdr elem)))
+ (if (zerop (cl-decf times))
+ (insert ")")
+ (insert "\n" (make-string column ? ))))))
+ (let* ((children (if remove-empty
+ (cl-remove-if
+ (lambda (child)
+ (and (stringp child)
+ (string-match "\\`[\n\r\t  ]*\\'" child)))
+ (dom-children dom))
+ (dom-children dom)))
+ (times (length children)))
+ (if (null children)
+ (insert ")")
+ (insert "\n" (make-string (1+ column) ? ))
+ (dolist (child children)
+ (if (stringp child)
+ (if (or (not remove-empty)
+ (not (string-match "\\`[\n\r\t  ]*\\'" child)))
+ (insert (format "%S" child)))
+ (dom-pp child remove-empty))
+ (if (zerop (cl-decf times))
+ (insert ")")
+ (insert "\n" (make-string (1+ column) ? ))))))))
+
+(provide 'dom)
+
+;;; dom.el ends here
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 7d81398aa49..60bfdb70adc 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -1,6 +1,6 @@
;;; dos-fns.el --- MS-Dos specific functions
-;; Copyright (C) 1991, 1993, 1995-1996, 2001-2013 Free Software
+;; Copyright (C) 1991, 1993, 1995-1996, 2001-2015 Free Software
;; Foundation, Inc.
;; Maintainer: Morten Welinder <terra@diku.dk>
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index e335bf737c1..b2bdf2dabfb 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -1,8 +1,8 @@
;;; dos-vars.el --- MS-Dos specific user options
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 0573caa6c23..2ce37c9b416 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -1,6 +1,6 @@
;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Maintainer: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -29,13 +29,12 @@
;;; Code:
;; Use ";" instead of ":" as a path separator (from files.el).
-(setq path-separator ";")
-
-(setq minibuffer-history-case-insensitive-variables
- (cons 'file-name-history minibuffer-history-case-insensitive-variables))
-
-;; Set the null device (for compile.el).
-(setq null-device "NUL")
+(when (memq system-type '(ms-dos windows-nt))
+ (setq path-separator ";")
+ (push 'file-name-history minibuffer-history-case-insensitive-variables)
+ ;; Set the null device (for compile.el).
+ (setq null-device "NUL")
+ (setq-default buffer-file-coding-system 'undecided-dos))
;; For distinguishing file types based upon suffixes. DEPRECATED, DO NOT USE!
(defcustom file-name-buffer-file-type-alist
@@ -67,18 +66,16 @@ This variable is deprecated, not used anywhere, and will soon be deleted."
'file-coding-system-alist
"24.4")
-(setq-default buffer-file-coding-system 'undecided-dos)
-
(defun find-buffer-file-type-coding-system (command)
"Choose a coding system for a file operation in COMMAND.
COMMAND is a list that specifies the operation, an I/O primitive, as its
CAR, and the arguments that might be given to that operation as its CDR.
If operation is `insert-file-contents', the coding system is chosen based
upon the filename (the CAR of the arguments beyond the operation), the contents
-of `untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
+of `w32-untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
and whether the file exists:
- If it matches in `untranslated-filesystem-list':
+ If it matches in `w32-untranslated-filesystem-list':
If the file exists: `undecided'
If the file does not exist: `undecided-unix'
Otherwise:
@@ -95,7 +92,7 @@ upon the value of `buffer-file-coding-system'. If
Otherwise, it is `undecided-dos'.
The most common situation is when DOS and Unix files are read and
-written, and their names do not match in `untranslated-filesystem-list'.
+written, and their names do not match in `w32-untranslated-filesystem-list'.
In these cases, the coding system initially will be `undecided'.
As the file is read in the DOS case, the coding system will be
changed to `undecided-dos' as CR/LFs are detected. As the file
@@ -135,7 +132,7 @@ when writing the file."
(file-name-directory target)))))
(setq undecided t))
;; Next check for a non-DOS file system.
- ((untranslated-file-p target)
+ ((w32-untranslated-file-p target)
(setq undecided-unix t)))
(cond (undecided-unix '(undecided-unix . undecided-unix))
(undecided '(undecided . undecided))
@@ -149,11 +146,14 @@ when writing the file."
;; buffer, because normally buffer-file-coding-system is non-nil
;; in a file-visiting buffer.
'(undecided-dos . undecided-dos))))))
+(make-obsolete 'find-buffer-file-type-coding-system nil "24.4")
(defun find-file-binary (filename)
"Visit file FILENAME and treat it as binary."
+ ;; FIXME: Why here rather than in files.el?
+ ;; FIXME: Can't we use find-file-literally for the same purposes?
(interactive "FFind file binary: ")
- (let ((coding-system-for-read 'no-conversion))
+ (let ((coding-system-for-read 'no-conversion)) ;; FIXME: undecided-unix?
(find-file filename)))
(defun find-file-text (filename)
@@ -162,7 +162,7 @@ when writing the file."
(let ((coding-system-for-read 'undecided-dos))
(find-file filename)))
-(defun find-file-not-found-set-buffer-file-coding-system ()
+(defun w32-find-file-not-found-set-buffer-file-coding-system ()
(with-current-buffer (current-buffer)
(let ((coding buffer-file-coding-system))
;; buffer-file-coding-system is already set by
@@ -171,49 +171,50 @@ when writing the file."
;; the EOL conversion, if required by the user.
(when (and (null coding-system-for-read)
(or inhibit-eol-conversion
- (untranslated-file-p (buffer-file-name))))
+ (w32-untranslated-file-p (buffer-file-name))))
(setq coding (coding-system-change-eol-conversion coding 0))
(setq buffer-file-coding-system coding))
nil)))
-;;; To set the default coding system on new files.
+;; To set the default coding system on new files.
(add-hook 'find-file-not-found-functions
- 'find-file-not-found-set-buffer-file-coding-system)
+ 'w32-find-file-not-found-set-buffer-file-coding-system)
;;; To accommodate filesystems that do not require CR/LF translation.
-(defvar untranslated-filesystem-list nil
+(define-obsolete-variable-alias 'untranslated-filesystem-list
+ 'w32-untranslated-filesystem-list "24.4")
+(defvar w32-untranslated-filesystem-list nil
"List of filesystems that require no CR/LF translation when reading
and writing files. Each filesystem in the list is a string naming
the directory prefix corresponding to the filesystem.")
-(defun untranslated-canonical-name (filename)
+(defun w32-untranslated-canonical-name (filename)
"Return FILENAME in a canonicalized form for use with the functions
dealing with untranslated filesystems."
(if (memq system-type '(ms-dos windows-nt cygwin))
;; The canonical form for DOS/W32 is with A-Z downcased and all
;; directory separators changed to directory-sep-char.
- (let ((name nil))
- (setq name (mapconcat
- (lambda (char)
- (if (and (<= ?A char) (<= char ?Z))
- (char-to-string (+ (- char ?A) ?a))
- (char-to-string char)))
- filename nil))
+ (let ((name
+ (mapconcat (lambda (char)
+ (char-to-string (if (and (<= ?A char ?Z))
+ (+ (- char ?A) ?a)
+ char)))
+ filename nil)))
;; Use expand-file-name to canonicalize directory separators, except
;; with bare drive letters (which would have the cwd appended).
;; Avoid expanding names that could trigger ange-ftp to prompt
;; for passwords, though.
- (if (or (string-match-p "^.:$" name)
+ (if (or (string-match-p "^.:\\'" name)
(string-match-p "^/[^/:]+:" name))
name
(expand-file-name name)))
filename))
-(defun untranslated-file-p (filename)
+(defun w32-untranslated-file-p (filename)
"Return t if FILENAME is on a filesystem that does not require
CR/LF translation, and nil otherwise."
- (let ((fs (untranslated-canonical-name filename))
- (ufs-list untranslated-filesystem-list)
+ (let ((fs (w32-untranslated-canonical-name filename))
+ (ufs-list w32-untranslated-filesystem-list)
(found nil))
(while (and (not found) ufs-list)
(if (string-match-p (concat "^" (car ufs-list)) fs)
@@ -221,7 +222,9 @@ CR/LF translation, and nil otherwise."
(setq ufs-list (cdr ufs-list))))
found))
-(defun add-untranslated-filesystem (filesystem)
+(define-obsolete-function-alias 'add-untranslated-filesystem
+ 'w32-add-untranslated-filesystem "24.4")
+(defun w32-add-untranslated-filesystem (filesystem)
"Add FILESYSTEM to the list of filesystems that do not require
CR/LF translation. FILESYSTEM is a string containing the directory
prefix corresponding to the filesystem. For example, for a Unix
@@ -230,25 +233,29 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
;; with a directory, but RET returns the current buffer's file, not
;; its directory.
(interactive "DUntranslated file system: ")
- (let ((fs (untranslated-canonical-name filesystem)))
- (if (member fs untranslated-filesystem-list)
- untranslated-filesystem-list
- (setq untranslated-filesystem-list
- (cons fs untranslated-filesystem-list)))))
+ (let ((fs (w32-untranslated-canonical-name filesystem)))
+ (if (member fs w32-untranslated-filesystem-list)
+ w32-untranslated-filesystem-list
+ (push fs w32-untranslated-filesystem-list))))
+
-(defun remove-untranslated-filesystem (filesystem)
+(define-obsolete-function-alias 'remove-untranslated-filesystem
+ 'w32-remove-untranslated-filesystem "24.4")
+(defun w32-remove-untranslated-filesystem (filesystem)
"Remove FILESYSTEM from the list of filesystems that do not require
CR/LF translation. FILESYSTEM is a string containing the directory
prefix corresponding to the filesystem. For example, for a Unix
filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
(interactive "fUntranslated file system: ")
- (setq untranslated-filesystem-list
- (delete (untranslated-canonical-name filesystem)
- untranslated-filesystem-list)))
+ (setq w32-untranslated-filesystem-list
+ (delete (w32-untranslated-canonical-name filesystem)
+ w32-untranslated-filesystem-list)))
;;; Support for printing under DOS/Windows, see lpr.el and ps-print.el.
-(defcustom direct-print-region-use-command-dot-com t
+(define-obsolete-variable-alias 'direct-print-region-use-command-dot-com
+ 'w32-direct-print-region-use-command-dot-com "24.4")
+(defcustom w32-direct-print-region-use-command-dot-com t
"If non-nil, use command.com to print on Windows 9x."
:type 'boolean
:group 'dos-fns
@@ -256,7 +263,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
;; Function to actually send data to the printer port.
;; Supports writing directly, and using various programs.
-(defun direct-print-region-helper (printer
+(defun w32-direct-print-region-helper (printer
start end
lpr-prog
_delete-text _buf _display
@@ -332,7 +339,7 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
((and (eq system-type 'windows-nt)
(getenv "winbootdir")
;; Allow cop-out so command.com isn't invoked
- direct-print-region-use-command-dot-com
+ w32-direct-print-region-use-command-dot-com
;; file-attributes fails on LPT ports on Windows 9x but
;; not on NT, so handle both cases for safety.
(eq (or (nth 7 (file-attributes printer)) 0) 0))
@@ -351,10 +358,12 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
(declare-function default-printer-name "w32fns.c")
-(defun direct-print-region-function (start end
- &optional lpr-prog
- delete-text buf display
- &rest rest)
+(define-obsolete-function-alias 'direct-print-region-function
+ 'w32-direct-print-region-function "24.4")
+(defun w32-direct-print-region-function (start end
+ &optional lpr-prog
+ delete-text buf display
+ &rest rest)
"DOS/Windows-specific function to print the region on a printer.
Writes the region to the device or file which is a value of
`printer-name' (which see), unless the value of `lpr-command'
@@ -382,8 +391,8 @@ indicates a specific program should be invoked."
(or (eq coding-system-for-write 'no-conversion)
(setq coding-system-for-write
(aref eol-type 1))) ; force conversion to DOS EOLs
- (direct-print-region-helper printer start end lpr-prog
- delete-text buf display rest)))
+ (w32-direct-print-region-helper printer start end lpr-prog
+ delete-text buf display rest)))
(defvar lpr-headers-switches)
@@ -395,14 +404,17 @@ indicates a specific program should be invoked."
;; then requests to print page headers will be silently
;; ignored, and `print-buffer' and `print-region' produce
;; the same output as `lpr-buffer' and `lpr-region', accordingly.
-(setq lpr-headers-switches "(page headers are not supported)")
+(when (memq system-type '(ms-dos windows-nt))
+ (setq lpr-headers-switches "(page headers are not supported)"))
(defvar ps-printer-name)
-(defun direct-ps-print-region-function (start end
- &optional lpr-prog
- delete-text buf display
- &rest rest)
+(define-obsolete-function-alias 'direct-ps-print-region-function
+ 'w32-direct-ps-print-region-function "24.4")
+(defun w32-direct-ps-print-region-function (start end
+ &optional lpr-prog
+ delete-text buf display
+ &rest rest)
"DOS/Windows-specific function to print the region on a PostScript printer.
Writes the region to the device or file which is a value of
`ps-printer-name' (which see), unless the value of `ps-lpr-command'
@@ -413,8 +425,8 @@ indicates a specific program should be invoked."
(symbol-value 'dos-ps-printer))
ps-printer-name
(default-printer-name))))
- (direct-print-region-helper printer start end lpr-prog
- delete-text buf display rest)))
+ (w32-direct-print-region-helper printer start end lpr-prog
+ delete-text buf display rest)))
;(setq ps-lpr-command "gs")
diff --git a/lisp/double.el b/lisp/double.el
index b37fd7ef199..ee511e55963 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -1,6 +1,6 @@
;;; double.el --- support for keyboard remapping with double clicking
-;; Copyright (C) 1994, 1997-1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1994, 1997-1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
@@ -122,9 +122,10 @@ but not `C-u X' or `ESC X' since the X is not the prefix key."
(append (make-list (1- (length (nth 1 entry)))
127)
(nth 2 entry)
- '(magic-end)))
+ '(magic-end)
+ unread-command-events))
(vector 127))
- (setq unread-command-events (list new))
+ (push new unread-command-events)
[ignore])))
((eq key 'magic-end)
;; End of double event. Ignore.
@@ -134,7 +135,8 @@ but not `C-u X' or `ESC X' since the X is not the prefix key."
(let ((exp (nth 1 (assoc key double-map))))
(setq double-last-event key)
(setq unread-command-events
- (append (substring exp 1) '(magic-start)))
+ (append (substring exp 1) '(magic-start)
+ unread-command-events))
(vector (aref exp 0)))))))
;;; Mode
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index d264243ab44..40ef8477c53 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -1,9 +1,9 @@
;;; dynamic-setting.el --- Support dynamic changes
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: font, system-font, tool-bar-style
;; Package: emacs
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index 9ac62b68272..93418063d10 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -1,10 +1,10 @@
;;; ebuff-menu.el --- electric-buffer-list mode
-;; Copyright (C) 1985-1986, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Richard Mlynarik <mly@ai.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -133,7 +133,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
(setq select
(catch 'electric-buffer-menu-select
(message "<<< Type SPC or RET to bury the buffer list >>>")
- (setq unread-command-events (list (read-event)))
+ (push (read-event) unread-command-events)
(let ((start-point (point))
(first (progn (goto-char (point-min))
(unless Buffer-menu-use-header-line
@@ -210,7 +210,9 @@ See the documentation of `electric-buffer-list' for details."
(defun Electric-buffer-menu-exit ()
(interactive)
- (setq unread-command-events (listify-key-sequence (this-command-keys)))
+ (setq unread-command-events
+ (nconc (listify-key-sequence (this-command-keys))
+ unread-command-events))
;; for robustness
(condition-case ()
(throw 'electric-buffer-menu-select nil)
diff --git a/lisp/echistory.el b/lisp/echistory.el
index fc576aa6484..e4146dca7bf 100644
--- a/lisp/echistory.el
+++ b/lisp/echistory.el
@@ -1,9 +1,9 @@
;;; echistory.el --- Electric Command History Mode
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -117,7 +117,6 @@ The Command History listing is recomputed each time this mode is invoked."
(save-window-excursion
(list-command-history)
(set-buffer "*Command History*")
- (Command-history-setup)
(setq major-mode 'electric-command-history)
(setq mode-name "Electric History")
(use-local-map electric-history-map))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 73662951188..acbd1e2f6b9 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -1,6 +1,6 @@
;;; edmacro.el --- keyboard macro editor
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Dave Gillespie <daveg@synaptics.com>
@@ -89,7 +89,7 @@ Default nil means to write characters above \\177 in octal notation."
"Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 300 keystrokes as a keyboard macro, or `M-x' to edit a macro by
+the last 300 keystrokes as a keyboard macro, or `\\[execute-extended-command]' to edit a macro by
its command name.
With a prefix argument, format the macro in a more concise way."
(interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index b2007909209..2e15af34a81 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -1,10 +1,10 @@
;;; ehelp.el --- bindings for electric-help mode -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Richard Mlynarik
;; (according to ack.texi and authors.el)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, extensions
;; This file is part of GNU Emacs.
@@ -25,7 +25,7 @@
;;; Commentary:
;; This package provides a pre-packaged `Electric Help Mode' for
-;; browsing on-line help screens. There is one entry point,
+;; browsing Emacs help screens. There is one entry point,
;; `with-electric-help'; all you have to give it is a no-argument
;; function that generates the actual text of the help into the current
;; buffer.
@@ -204,10 +204,10 @@ BUFFER is put back into its original major mode."
(catch 'exit
(if (pos-visible-in-window-p (point-max))
(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
- (if (equal (setq unread-command-events (list (read-event)))
- '(?\s))
- (progn (setq unread-command-events nil)
- (throw 'exit t)))))
+ (let ((ev (read-event)))
+ (if (equal ev ?\s)
+ (throw 'exit t)
+ (push ev unread-command-events)))))
(let (up down both neither
(standard (and (eq (key-binding " " nil t)
'scroll-up)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
new file mode 100644
index 00000000000..205ad7e488b
--- /dev/null
+++ b/lisp/elec-pair.el
@@ -0,0 +1,591 @@
+;;; elec-pair.el --- Automatic parenthesis pairing -*- lexical-binding:t -*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: João Távora <joaotavora@gmail.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'electric)
+
+;;; Electric pairing.
+
+(defcustom electric-pair-pairs
+ '((?\" . ?\"))
+ "Alist of pairs that should be used regardless of major mode.
+
+Pairs of delimiters in this list are a fallback in case they have
+no syntax relevant to `electric-pair-mode' in the mode's syntax
+table.
+
+See also the variable `electric-pair-text-pairs'."
+ :version "24.1"
+ :group 'electricity
+ :type '(repeat (cons character character)))
+
+;;;###autoload
+(defcustom electric-pair-text-pairs
+ '((?\" . ?\" ))
+ "Alist of pairs that should always be used in comments and strings.
+
+Pairs of delimiters in this list are a fallback in case they have
+no syntax relevant to `electric-pair-mode' in the syntax table
+defined in `electric-pair-text-syntax-table'"
+ :version "24.4"
+ :group 'electricity
+ :type '(repeat (cons character character)))
+
+(defcustom electric-pair-skip-self #'electric-pair-default-skip-self
+ "If non-nil, skip char instead of inserting a second closing paren.
+
+When inserting a closing paren character right before the same character,
+just skip that character instead, so that hitting ( followed by ) results
+in \"()\" rather than \"())\".
+
+This can be convenient for people who find it easier to hit ) than C-f.
+
+Can also be a function of one argument (the closer char just
+inserted), in which case that function's return value is
+considered instead."
+ :version "24.1"
+ :group 'electricity
+ :type '(choice
+ (const :tag "Never skip" nil)
+ (const :tag "Help balance" electric-pair-default-skip-self)
+ (const :tag "Always skip" t)
+ function))
+
+(defcustom electric-pair-inhibit-predicate
+ #'electric-pair-default-inhibit
+ "Predicate to prevent insertion of a matching pair.
+
+The function is called with a single char (the opening char just inserted).
+If it returns non-nil, then `electric-pair-mode' will not insert a matching
+closer."
+ :version "24.4"
+ :group 'electricity
+ :type '(choice
+ (const :tag "Conservative" electric-pair-conservative-inhibit)
+ (const :tag "Help balance" electric-pair-default-inhibit)
+ (const :tag "Always pair" ignore)
+ function))
+
+(defcustom electric-pair-preserve-balance t
+ "Non-nil if default pairing and skipping should help balance parentheses.
+
+The default values of `electric-pair-inhibit-predicate' and
+`electric-pair-skip-self' check this variable before delegating to other
+predicates responsible for making decisions on whether to pair/skip some
+characters based on the actual state of the buffer's parentheses and
+quotes."
+ :version "24.4"
+ :group 'electricity
+ :type 'boolean)
+
+(defcustom electric-pair-delete-adjacent-pairs t
+ "If non-nil, backspacing an open paren also deletes adjacent closer.
+
+Can also be a function of no arguments, in which case that function's
+return value is considered instead."
+ :version "24.4"
+ :group 'electricity
+ :type '(choice
+ (const :tag "Yes" t)
+ (const :tag "No" nil)
+ function))
+
+(defcustom electric-pair-open-newline-between-pairs t
+ "If non-nil, a newline between adjacent parentheses opens an extra one.
+
+Can also be a function of no arguments, in which case that function's
+return value is considered instead."
+ :version "24.4"
+ :group 'electricity
+ :type '(choice
+ (const :tag "Yes" t)
+ (const :tag "No" nil)
+ function))
+
+(defcustom electric-pair-skip-whitespace t
+ "If non-nil skip whitespace when skipping over closing parens.
+
+The specific kind of whitespace skipped is given by the variable
+`electric-pair-skip-whitespace-chars'.
+
+The symbol `chomp' specifies that the skipped-over whitespace
+should be deleted.
+
+Can also be a function of no arguments, in which case that function's
+return value is considered instead."
+ :version "24.4"
+ :group 'electricity
+ :type '(choice
+ (const :tag "Yes, jump over whitespace" t)
+ (const :tag "Yes, and delete whitespace" chomp)
+ (const :tag "No, no whitespace skipping" nil)
+ function))
+
+(defcustom electric-pair-skip-whitespace-chars (list ?\t ?\s ?\n)
+ "Whitespace characters considered by `electric-pair-skip-whitespace'."
+ :version "24.4"
+ :group 'electricity
+ :type '(choice (set (const :tag "Space" ?\s)
+ (const :tag "Tab" ?\t)
+ (const :tag "Newline" ?\n))
+ (list character)))
+
+(defun electric-pair--skip-whitespace ()
+ "Skip whitespace forward, not crossing comment or string boundaries."
+ (let ((saved (point))
+ (string-or-comment (nth 8 (syntax-ppss))))
+ (skip-chars-forward (apply #'string electric-pair-skip-whitespace-chars))
+ (unless (eq string-or-comment (nth 8 (syntax-ppss)))
+ (goto-char saved))))
+
+(defvar electric-pair-text-syntax-table prog-mode-syntax-table
+ "Syntax table used when pairing inside comments and strings.
+
+`electric-pair-mode' considers this syntax table only when point in inside
+quotes or comments. If lookup fails here, `electric-pair-text-pairs' will
+be considered.")
+
+(defun electric-pair-conservative-inhibit (char)
+ (or
+ ;; I find it more often preferable not to pair when the
+ ;; same char is next.
+ (eq char (char-after))
+ ;; Don't pair up when we insert the second of "" or of ((.
+ (and (eq char (char-before))
+ (eq char (char-before (1- (point)))))
+ ;; I also find it often preferable not to pair next to a word.
+ (eq (char-syntax (following-char)) ?w)))
+
+(defun electric-pair-syntax-info (command-event)
+ "Calculate a list (SYNTAX PAIR UNCONDITIONAL STRING-OR-COMMENT-START).
+
+SYNTAX is COMMAND-EVENT's syntax character. PAIR is
+COMMAND-EVENT's pair. UNCONDITIONAL indicates the variables
+`electric-pair-pairs' or `electric-pair-text-pairs' were used to
+lookup syntax. STRING-OR-COMMENT-START indicates that point is
+inside a comment or string."
+ (let* ((pre-string-or-comment (or (bobp)
+ (nth 8 (save-excursion
+ (syntax-ppss (1- (point)))))))
+ (post-string-or-comment (nth 8 (syntax-ppss (point))))
+ (string-or-comment (and post-string-or-comment
+ pre-string-or-comment))
+ (table (if string-or-comment
+ electric-pair-text-syntax-table
+ (syntax-table)))
+ (table-syntax-and-pair (with-syntax-table table
+ (list (char-syntax command-event)
+ (or (matching-paren command-event)
+ command-event))))
+ (fallback (if string-or-comment
+ (append electric-pair-text-pairs
+ electric-pair-pairs)
+ electric-pair-pairs))
+ (direct (assq command-event fallback))
+ (reverse (rassq command-event fallback)))
+ (cond
+ ((memq (car table-syntax-and-pair)
+ '(?\" ?\( ?\) ?\$))
+ (append table-syntax-and-pair (list nil string-or-comment)))
+ (direct (if (eq (car direct) (cdr direct))
+ (list ?\" command-event t string-or-comment)
+ (list ?\( (cdr direct) t string-or-comment)))
+ (reverse (list ?\) (car reverse) t string-or-comment)))))
+
+(defun electric-pair--insert (char)
+ (let ((last-command-event char)
+ (blink-matching-paren nil)
+ (electric-pair-mode nil))
+ (self-insert-command 1)))
+
+(defun electric-pair--syntax-ppss (&optional pos where)
+ "Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'.
+
+WHERE is a list defaulting to '(string comment) and indicates
+when to fallback to `parse-partial-sexp'."
+ (let* ((pos (or pos (point)))
+ (where (or where '(string comment)))
+ (quick-ppss (syntax-ppss pos))
+ (in-string (and (nth 3 quick-ppss) (memq 'string where)))
+ (in-comment (and (nth 4 quick-ppss) (memq 'comment where)))
+ (s-or-c-start (cond (in-string
+ (1+ (nth 8 quick-ppss)))
+ (in-comment
+ (goto-char (nth 8 quick-ppss))
+ (forward-comment (- (point-max)))
+ (skip-syntax-forward " >!")
+ (point)))))
+ (if s-or-c-start
+ (with-syntax-table electric-pair-text-syntax-table
+ (parse-partial-sexp s-or-c-start pos))
+ ;; HACK! cc-mode apparently has some `syntax-ppss' bugs
+ (if (memq major-mode '(c-mode c++ mode))
+ (parse-partial-sexp (point-min) pos)
+ quick-ppss))))
+
+;; Balancing means controlling pairing and skipping of parentheses
+;; so that, if possible, the buffer ends up at least as balanced as
+;; before, if not more. The algorithm is slightly complex because
+;; some situations like "()))" need pairing to occur at the end but
+;; not at the beginning. Balancing should also happen independently
+;; for different types of parentheses, so that having your {}'s
+;; unbalanced doesn't keep `electric-pair-mode' from balancing your
+;; ()'s and your []'s.
+(defun electric-pair--balance-info (direction string-or-comment)
+ "Examine lists forward or backward according to DIRECTION's sign.
+
+STRING-OR-COMMENT is info suitable for running `parse-partial-sexp'.
+
+Return a cons of two descriptions (MATCHED-P . PAIR) for the
+innermost and outermost lists that enclose point. The outermost
+list enclosing point is either the first top-level or first
+mismatched list found by listing up.
+
+If the outermost list is matched, don't rely on its PAIR.
+If point is not enclosed by any lists, return ((t) . (t))."
+ (let* (innermost
+ outermost
+ (table (if string-or-comment
+ electric-pair-text-syntax-table
+ (syntax-table)))
+ (at-top-level-or-equivalent-fn
+ ;; called when `scan-sexps' ran perfectly, when it found
+ ;; a parenthesis pointing in the direction of travel.
+ ;; Also when travel started inside a comment and exited it.
+ #'(lambda ()
+ (setq outermost (list t))
+ (unless innermost
+ (setq innermost (list t)))))
+ (ended-prematurely-fn
+ ;; called when `scan-sexps' crashed against a parenthesis
+ ;; pointing opposite the direction of travel. After
+ ;; traversing that character, the idea is to travel one sexp
+ ;; in the opposite direction looking for a matching
+ ;; delimiter.
+ #'(lambda ()
+ (let* ((pos (point))
+ (matched
+ (save-excursion
+ (cond ((< direction 0)
+ (condition-case nil
+ (eq (char-after pos)
+ (with-syntax-table table
+ (matching-paren
+ (char-before
+ (scan-sexps (point) 1)))))
+ (scan-error nil)))
+ (t
+ ;; In this case, no need to use
+ ;; `scan-sexps', we can use some
+ ;; `electric-pair--syntax-ppss' in this
+ ;; case (which uses the quicker
+ ;; `syntax-ppss' in some cases)
+ (let* ((ppss (electric-pair--syntax-ppss
+ (1- (point))))
+ (start (car (last (nth 9 ppss))))
+ (opener (char-after start)))
+ (and start
+ (eq (char-before pos)
+ (or (with-syntax-table table
+ (matching-paren opener))
+ opener))))))))
+ (actual-pair (if (> direction 0)
+ (char-before (point))
+ (char-after (point)))))
+ (unless innermost
+ (setq innermost (cons matched actual-pair)))
+ (unless matched
+ (setq outermost (cons matched actual-pair)))))))
+ (save-excursion
+ (while (not outermost)
+ (condition-case err
+ (with-syntax-table table
+ (scan-sexps (point) (if (> direction 0)
+ (point-max)
+ (- (point-max))))
+ (funcall at-top-level-or-equivalent-fn))
+ (scan-error
+ (cond ((or
+ ;; some error happened and it is not of the "ended
+ ;; prematurely" kind...
+ (not (string-match "ends prematurely" (nth 1 err)))
+ ;; ... or we were in a comment and just came out of
+ ;; it.
+ (and string-or-comment
+ (not (nth 8 (syntax-ppss)))))
+ (funcall at-top-level-or-equivalent-fn))
+ (t
+ ;; exit the sexp
+ (goto-char (nth 3 err))
+ (funcall ended-prematurely-fn)))))))
+ (cons innermost outermost)))
+
+(defvar electric-pair-string-bound-function 'point-max
+ "Next buffer position where strings are syntactically unexpected.
+Value is a function called with no arguments and returning a
+buffer position. Major modes should set this variable
+buffer-locally if they experience slowness with
+`electric-pair-mode' when pairing quotes.")
+
+(defun electric-pair--unbalanced-strings-p (char)
+ "Return non-nil if there are unbalanced strings started by CHAR."
+ (let* ((selector-ppss (syntax-ppss))
+ (relevant-ppss (save-excursion
+ (if (nth 4 selector-ppss) ; comment
+ (electric-pair--syntax-ppss
+ (progn
+ (goto-char (nth 8 selector-ppss))
+ (forward-comment (point-max))
+ (skip-syntax-backward " >!")
+ (point)))
+ (syntax-ppss
+ (funcall electric-pair-string-bound-function)))))
+ (string-delim (nth 3 relevant-ppss)))
+ (or (eq t string-delim)
+ (eq char string-delim))))
+
+(defun electric-pair--inside-string-p (char)
+ "Return non-nil if point is inside a string started by CHAR.
+
+A comments text is parsed with `electric-pair-text-syntax-table'.
+Also consider strings within comments, but not strings within
+strings."
+ ;; FIXME: could also consider strings within strings by examining
+ ;; delimiters.
+ (let ((ppss (electric-pair--syntax-ppss (point) '(comment))))
+ (memq (nth 3 ppss) (list t char))))
+
+(defun electric-pair-inhibit-if-helps-balance (char)
+ "Return non-nil if auto-pairing of CHAR would hurt parentheses' balance.
+
+Works by first removing the character from the buffer, then doing
+some list calculations, finally restoring the situation as if nothing
+happened."
+ (pcase (electric-pair-syntax-info char)
+ (`(,syntax ,pair ,_ ,s-or-c)
+ (unwind-protect
+ (progn
+ (delete-char -1)
+ (cond ((eq ?\( syntax)
+ (let* ((pair-data
+ (electric-pair--balance-info 1 s-or-c))
+ (outermost (cdr pair-data)))
+ (cond ((car outermost)
+ nil)
+ (t
+ (eq (cdr outermost) pair)))))
+ ((eq syntax ?\")
+ (electric-pair--unbalanced-strings-p char))))
+ (insert-char char)))))
+
+(defun electric-pair-skip-if-helps-balance (char)
+ "Return non-nil if skipping CHAR would benefit parentheses' balance.
+
+Works by first removing the character from the buffer, then doing
+some list calculations, finally restoring the situation as if nothing
+happened."
+ (pcase (electric-pair-syntax-info char)
+ (`(,syntax ,pair ,_ ,s-or-c)
+ (unwind-protect
+ (progn
+ (delete-char -1)
+ (cond ((eq syntax ?\))
+ (let* ((pair-data
+ (electric-pair--balance-info
+ -1 s-or-c))
+ (innermost (car pair-data))
+ (outermost (cdr pair-data)))
+ (and
+ (cond ((car outermost)
+ (car innermost))
+ ((car innermost)
+ (not (eq (cdr outermost) pair)))))))
+ ((eq syntax ?\")
+ (electric-pair--inside-string-p char))))
+ (insert-char char)))))
+
+(defun electric-pair-default-skip-self (char)
+ (if electric-pair-preserve-balance
+ (electric-pair-skip-if-helps-balance char)
+ t))
+
+(defun electric-pair-default-inhibit (char)
+ (if electric-pair-preserve-balance
+ (electric-pair-inhibit-if-helps-balance char)
+ (electric-pair-conservative-inhibit char)))
+
+(defun electric-pair-post-self-insert-function ()
+ (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
+ (skip-whitespace-info))
+ (pcase (electric-pair-syntax-info last-command-event)
+ (`(,syntax ,pair ,unconditional ,_)
+ (cond
+ ((null pos) nil)
+ ;; Wrap a pair around the active region.
+ ;;
+ ((and (memq syntax '(?\( ?\) ?\" ?\$)) (use-region-p))
+ ;; FIXME: To do this right, we'd need a post-self-insert-function
+ ;; so we could add-function around it and insert the closer after
+ ;; all the rest of the hook has run.
+ (if (or (eq syntax ?\")
+ (and (eq syntax ?\))
+ (>= (point) (mark)))
+ (and (not (eq syntax ?\)))
+ (>= (mark) (point))))
+ (save-excursion
+ (goto-char (mark))
+ (electric-pair--insert pair))
+ (delete-region pos (1- pos))
+ (electric-pair--insert pair)
+ (goto-char (mark))
+ (electric-pair--insert last-command-event)))
+ ;; Backslash-escaped: no pairing, no skipping.
+ ((save-excursion
+ (goto-char (1- pos))
+ (not (zerop (% (skip-syntax-backward "\\") 2))))
+ nil)
+ ;; Skip self.
+ ((and (memq syntax '(?\) ?\" ?\$))
+ (and (or unconditional
+ (if (functionp electric-pair-skip-self)
+ (funcall electric-pair-skip-self last-command-event)
+ electric-pair-skip-self))
+ (save-excursion
+ (when (and (not (and unconditional
+ (eq syntax ?\")))
+ (setq skip-whitespace-info
+ (if (and (not (eq electric-pair-skip-whitespace 'chomp))
+ (functionp electric-pair-skip-whitespace))
+ (funcall electric-pair-skip-whitespace)
+ electric-pair-skip-whitespace)))
+ (electric-pair--skip-whitespace))
+ (eq (char-after) last-command-event))))
+ ;; This is too late: rather than insert&delete we'd want to only
+ ;; skip (or insert in overwrite mode). The difference is in what
+ ;; goes in the undo-log and in the intermediate state which might
+ ;; be visible to other post-self-insert-hook. We'll just have to
+ ;; live with it for now.
+ (when skip-whitespace-info
+ (electric-pair--skip-whitespace))
+ (delete-region (1- pos) (if (eq skip-whitespace-info 'chomp)
+ (point)
+ pos))
+ (forward-char))
+ ;; Insert matching pair.
+ ((and (memq syntax `(?\( ?\" ?\$))
+ (not overwrite-mode)
+ (or unconditional
+ (not (funcall electric-pair-inhibit-predicate
+ last-command-event))))
+ (save-excursion (electric-pair--insert pair)))))
+ (_
+ (when (and (if (functionp electric-pair-open-newline-between-pairs)
+ (funcall electric-pair-open-newline-between-pairs)
+ electric-pair-open-newline-between-pairs)
+ (eq last-command-event ?\n)
+ (< (1+ (point-min)) (point) (point-max))
+ (eq (save-excursion
+ (skip-chars-backward "\t\s")
+ (char-before (1- (point))))
+ (matching-paren (char-after))))
+ (save-excursion (newline 1 t)))))))
+
+(put 'electric-pair-post-self-insert-function 'priority 20)
+
+(defun electric-pair-will-use-region ()
+ (and (use-region-p)
+ (memq (car (electric-pair-syntax-info last-command-event))
+ '(?\( ?\) ?\" ?\$))))
+
+(defun electric-pair-delete-pair (arg &optional killp)
+ "When between adjacent paired delimiters, delete both of them.
+ARG and KILLP are passed directly to
+`backward-delete-char-untabify', which see."
+ (interactive "*p\nP")
+ (delete-char 1)
+ (backward-delete-char-untabify arg killp))
+
+(defvar electric-pair-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\177"
+ `(menu-item
+ "" electric-pair-delete-pair
+ :filter
+ ,(lambda (cmd)
+ (let* ((prev (char-before))
+ (next (char-after))
+ (syntax-info (and prev
+ (electric-pair-syntax-info prev)))
+ (syntax (car syntax-info))
+ (pair (cadr syntax-info)))
+ (and next pair
+ (memq syntax '(?\( ?\" ?\$))
+ (eq pair next)
+ (if (functionp electric-pair-delete-adjacent-pairs)
+ (funcall electric-pair-delete-adjacent-pairs)
+ electric-pair-delete-adjacent-pairs)
+ cmd)))))
+ map)
+ "Keymap used by `electric-pair-mode'.")
+
+;;;###autoload
+(define-minor-mode electric-pair-mode
+ "Toggle automatic parens pairing (Electric Pair mode).
+With a prefix argument ARG, enable Electric Pair mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Electric Pair mode is a global minor mode. When enabled, typing
+an open parenthesis automatically inserts the corresponding
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'."
+ :global t :group 'electricity
+ (if electric-pair-mode
+ (progn
+ (add-hook 'post-self-insert-hook
+ #'electric-pair-post-self-insert-function)
+ (electric--sort-post-self-insertion-hook)
+ (add-hook 'self-insert-uses-region-functions
+ #'electric-pair-will-use-region))
+ (remove-hook 'post-self-insert-hook
+ #'electric-pair-post-self-insert-function)
+ (remove-hook 'self-insert-uses-region-functions
+ #'electric-pair-will-use-region)))
+
+;;;###autoload
+(define-minor-mode electric-pair-local-mode
+ "Toggle `electric-pair-mode' only in this buffer."
+ :variable (buffer-local-value 'electric-pair-mode (current-buffer))
+ (cond
+ ((eq electric-pair-mode (default-value 'electric-pair-mode))
+ (kill-local-variable 'electric-pair-mode))
+ ((not (default-value 'electric-pair-mode))
+ ;; Locally enabled, but globally disabled.
+ (electric-pair-mode 1) ; Setup the hooks.
+ (setq-default electric-pair-mode nil) ; But keep it globally disabled.
+ )))
+
+(provide 'elec-pair)
+
+;;; elec-pair.el ends here
diff --git a/lisp/electric.el b/lisp/electric.el
index 351468fd75d..47cb020108c 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -1,10 +1,10 @@
;;; electric.el --- window maker and Command loop for `electric' modes
-;; Copyright (C) 1985-1986, 1995, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1995, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; This file is part of GNU Emacs.
@@ -78,8 +78,6 @@
(setq last-command-event (aref cmd (1- (length cmd)))
this-command (key-binding cmd t)
cmd this-command)
- ;; This makes universal-argument-other-key work.
- (setq universal-argument-num-events 0)
(if (or (prog1 quit-flag (setq quit-flag nil))
(eq last-input-event ?\C-g))
(progn (setq unread-command-events nil
@@ -166,7 +164,10 @@
;; Don't shrink the window, but expand it if necessary.
(goto-char (point-min))
(unless (= (point-max) (window-end win t))
- (fit-window-to-buffer win max-height))
+ ;; This call is executed even if the window existed before, was
+ ;; reused, ... contradicting a claim in the comment before this
+ ;; function.
+ (fit-window-to-buffer win max-height nil nil nil t))
win)))
;;; Electric keys.
@@ -189,7 +190,18 @@ Returns nil when we can't find this char."
(eq (char-before) last-command-event)))))
pos)))
-;; Electric indentation.
+(defun electric--sort-post-self-insertion-hook ()
+ "Ensure order of electric functions in `post-self-insertion-hook'.
+
+Hooks in this variable interact in non-trivial ways, so a
+relative order must be maintained within it."
+ (setq-default post-self-insert-hook
+ (sort (default-value 'post-self-insert-hook)
+ #'(lambda (fn1 fn2)
+ (< (or (get fn1 'priority) 0)
+ (or (get fn2 'priority) 0))))))
+
+;;; Electric indentation.
;; Autoloading variables is generally undesirable, but major modes
;; should usually set this variable by adding elements to the default
@@ -204,7 +216,26 @@ Each function is called with one argument (the inserted char), with
point right after that char, and it should return t to cause indentation,
`no-indent' to prevent indentation or nil to let other functions decide.")
+(defvar-local electric-indent-inhibit nil
+ "If non-nil, reindentation is not appropriate for this buffer.
+This should be set by major modes such as `python-mode' since
+Python does not lend itself to fully automatic indentation.")
+
+(defvar electric-indent-functions-without-reindent
+ '(indent-relative indent-to-left-margin indent-relative-maybe
+ py-indent-line coffee-indent-line org-indent-line yaml-indent-line
+ haskell-indentation-indent-line haskell-indent-cycle haskell-simple-indent
+ yaml-indent-line)
+ "List of indent functions that can't reindent.
+If `line-indent-function' is one of those, then `electric-indent-mode' will
+not try to reindent lines. It is normally better to make the major
+mode set `electric-indent-inhibit', but this can be used as a workaround.")
+
(defun electric-indent-post-self-insert-function ()
+ "Function that `electric-indent-mode' adds to `post-self-insert-hook'.
+This indents if the hook `electric-indent-functions' returns non-nil,
+or if a member of `electric-indent-chars' was typed; but not in a string
+or comment."
;; FIXME: This reindents the current line, but what we really want instead is
;; to reindent the whole affected text. That's the current line for simple
;; cases, but not all cases. We do take care of the newline case in an
@@ -231,27 +262,54 @@ point right after that char, and it should return t to cause indentation,
(unless (eq act 'do-indent) (nth 8 (syntax-ppss))))))))
;; For newline, we want to reindent both lines and basically behave like
;; reindent-then-newline-and-indent (whose code we hence copied).
- (when (< (1- pos) (line-beginning-position))
- (let ((before (copy-marker (1- pos) t)))
- (save-excursion
- (unless (memq indent-line-function
- '(indent-relative indent-to-left-margin
- indent-relative-maybe))
- ;; Don't reindent the previous line if the indentation function
- ;; is not a real one.
+ (let ((at-newline (<= pos (line-beginning-position))))
+ (when at-newline
+ (let ((before (copy-marker (1- pos) t)))
+ (save-excursion
+ (unless (or (memq indent-line-function
+ electric-indent-functions-without-reindent)
+ electric-indent-inhibit)
+ ;; Don't reindent the previous line if the indentation function
+ ;; is not a real one.
+ (goto-char before)
+ (indent-according-to-mode))
+ ;; We are at EOL before the call to indent-according-to-mode, and
+ ;; after it we usually are as well, but not always. We tried to
+ ;; address it with `save-excursion' but that uses a normal marker
+ ;; whereas we need `move after insertion', so we do the
+ ;; save/restore by hand.
(goto-char before)
- (indent-according-to-mode))
- ;; We are at EOL before the call to indent-according-to-mode, and
- ;; after it we usually are as well, but not always. We tried to
- ;; address it with `save-excursion' but that uses a normal marker
- ;; whereas we need `move after insertion', so we do the
- ;; save/restore by hand.
- (goto-char before)
- ;; Remove the trailing whitespace after indentation because
- ;; indentation may (re)introduce the whitespace.
- (delete-horizontal-space t))))
- (unless (memq indent-line-function '(indent-to-left-margin))
- (indent-according-to-mode)))))
+ (when (eolp)
+ ;; Remove the trailing whitespace after indentation because
+ ;; indentation may (re)introduce the whitespace.
+ (delete-horizontal-space t)))))
+ (unless (and electric-indent-inhibit
+ (not at-newline))
+ (indent-according-to-mode))))))
+
+(put 'electric-indent-post-self-insert-function 'priority 60)
+
+(defun electric-indent-just-newline (arg)
+ "Insert just a newline, without any auto-indentation."
+ (interactive "*P")
+ (let ((electric-indent-mode nil))
+ (newline arg 'interactive)))
+
+;;;###autoload
+(define-key global-map "\C-j" 'electric-newline-and-maybe-indent)
+;;;###autoload
+(defun electric-newline-and-maybe-indent ()
+ "Insert a newline.
+If `electric-indent-mode' is enabled, that's that, but if it
+is *disabled* then additionally indent according to major mode.
+Indentation is done using the value of `indent-line-function'.
+In programming language modes, this is the same as TAB.
+In some text modes, where TAB inserts a tab, this command indents to the
+column specified by the function `current-left-margin'."
+ (interactive "*")
+ (if electric-indent-mode
+ (electric-indent-just-newline nil)
+ (newline-and-indent)))
;;;###autoload
(define-minor-mode electric-indent-mode
@@ -260,170 +318,51 @@ With a prefix argument ARG, enable Electric Indent mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-This is a global minor mode. When enabled, it reindents whenever
-the hook `electric-indent-functions' returns non-nil, or you
-insert a character from `electric-indent-chars'."
- :global t
- :group 'electricity
+When enabled, this reindents whenever the hook `electric-indent-functions'
+returns non-nil, or if you insert a character from `electric-indent-chars'.
+
+This is a global minor mode. To toggle the mode in a single buffer,
+use `electric-indent-local-mode'."
+ :global t :group 'electricity
+ :initialize 'custom-initialize-delay
+ :init-value t
(if (not electric-indent-mode)
- (remove-hook 'post-self-insert-hook
- #'electric-indent-post-self-insert-function)
- ;; post-self-insert-hooks interact in non-trivial ways.
- ;; It turns out that electric-indent-mode generally works better if run
- ;; late, but still before blink-paren.
+ (unless (catch 'found
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if electric-indent-mode (throw 'found t)))))
+ (remove-hook 'post-self-insert-hook
+ #'electric-indent-post-self-insert-function))
(add-hook 'post-self-insert-hook
- #'electric-indent-post-self-insert-function
- 'append)
- ;; FIXME: Ugly!
- (let ((bp (memq #'blink-paren-post-self-insert-function
- (default-value 'post-self-insert-hook))))
- (when (memq #'electric-indent-post-self-insert-function bp)
- (setcar bp #'electric-indent-post-self-insert-function)
- (setcdr bp (cons #'blink-paren-post-self-insert-function
- (delq #'electric-indent-post-self-insert-function
- (cdr bp))))))))
-
-;; Electric pairing.
-
-(defcustom electric-pair-pairs
- '((?\" . ?\"))
- "Alist of pairs that should be used regardless of major mode."
- :group 'electricity
- :version "24.1"
- :type '(repeat (cons character character)))
-
-(defcustom electric-pair-skip-self t
- "If non-nil, skip char instead of inserting a second closing paren.
-When inserting a closing paren character right before the same character,
-just skip that character instead, so that hitting ( followed by ) results
-in \"()\" rather than \"())\".
-This can be convenient for people who find it easier to hit ) than C-f."
- :group 'electricity
- :version "24.1"
- :type 'boolean)
-
-(defcustom electric-pair-inhibit-predicate
- #'electric-pair-default-inhibit
- "Predicate to prevent insertion of a matching pair.
-The function is called with a single char (the opening char just inserted).
-If it returns non-nil, then `electric-pair-mode' will not insert a matching
-closer."
- :version "24.4"
- :type '(choice
- (const :tag "Default" electric-pair-default-inhibit)
- (const :tag "Always pair" ignore)
- function))
-
-(defun electric-pair-default-inhibit (char)
- (or
- ;; I find it more often preferable not to pair when the
- ;; same char is next.
- (eq char (char-after))
- ;; Don't pair up when we insert the second of "" or of ((.
- (and (eq char (char-before))
- (eq char (char-before (1- (point)))))
- ;; I also find it often preferable not to pair next to a word.
- (eq (char-syntax (following-char)) ?w)))
-
-(defun electric-pair-syntax (command-event)
- (let ((x (assq command-event electric-pair-pairs)))
- (cond
- (x (if (eq (car x) (cdr x)) ?\" ?\())
- ((rassq command-event electric-pair-pairs) ?\))
- ((nth 8 (syntax-ppss))
- (with-syntax-table text-mode-syntax-table (char-syntax command-event)))
- (t (char-syntax command-event)))))
-
-(defun electric-pair--insert (char)
- (let ((last-command-event char)
- (blink-matching-paren nil)
- (electric-pair-mode nil))
- (self-insert-command 1)))
-
-(defun electric-pair-post-self-insert-function ()
- (let* ((pos (and electric-pair-mode (electric--after-char-pos)))
- (syntax (and pos (electric-pair-syntax last-command-event)))
- (closer (if (eq syntax ?\()
- (cdr (or (assq last-command-event electric-pair-pairs)
- (aref (syntax-table) last-command-event)))
- last-command-event)))
- (cond
- ((null pos) nil)
- ;; Wrap a pair around the active region.
- ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
- ;; FIXME: To do this right, we'd need a post-self-insert-function
- ;; so we could add-function around it and insert the closer after
- ;; all the rest of the hook has run.
- (if (>= (mark) (point))
- (goto-char (mark))
- ;; We already inserted the open-paren but at the end of the
- ;; region, so we have to remove it and start over.
- (delete-region (1- pos) (point))
- (save-excursion
- (goto-char (mark))
- (electric-pair--insert last-command-event)))
- ;; Since we're right after the closer now, we could tell the rest of
- ;; post-self-insert-hook that we inserted `closer', but then we'd get
- ;; blink-paren to kick in, which is annoying.
- ;;(setq last-command-event closer)
- (insert closer))
- ;; Backslash-escaped: no pairing, no skipping.
- ((save-excursion
- (goto-char (1- pos))
- (not (zerop (% (skip-syntax-backward "\\") 2))))
- nil)
- ;; Skip self.
- ((and (memq syntax '(?\) ?\" ?\$))
- electric-pair-skip-self
- (eq (char-after pos) last-command-event))
- ;; This is too late: rather than insert&delete we'd want to only skip (or
- ;; insert in overwrite mode). The difference is in what goes in the
- ;; undo-log and in the intermediate state which might be visible to other
- ;; post-self-insert-hook. We'll just have to live with it for now.
- (delete-char 1))
- ;; Insert matching pair.
- ((not (or (not (memq syntax `(?\( ?\" ?\$)))
- overwrite-mode
- (funcall electric-pair-inhibit-predicate last-command-event)))
- (save-excursion (electric-pair--insert closer))))))
-
-(defun electric-pair-will-use-region ()
- (and (use-region-p)
- (memq (electric-pair-syntax last-command-event) '(?\( ?\" ?\$))))
+ #'electric-indent-post-self-insert-function)
+ (electric--sort-post-self-insertion-hook)))
;;;###autoload
-(define-minor-mode electric-pair-mode
- "Toggle automatic parens pairing (Electric Pair mode).
-With a prefix argument ARG, enable Electric Pair mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Electric Pair mode is a global minor mode. When enabled, typing
-an open parenthesis automatically inserts the corresponding
-closing parenthesis. \(Likewise for brackets, etc.)
-
-See options `electric-pair-pairs' and `electric-pair-skip-self'."
- :global t
- :group 'electricity
- (if electric-pair-mode
- (progn
- (add-hook 'post-self-insert-hook
- #'electric-pair-post-self-insert-function)
- (add-hook 'self-insert-uses-region-functions
- #'electric-pair-will-use-region))
- (remove-hook 'post-self-insert-hook
- #'electric-pair-post-self-insert-function)
- (remove-hook 'self-insert-uses-region-functions
- #'electric-pair-will-use-region)))
-
-;; Automatically add newlines after/before/around some chars.
-
-(defvar electric-layout-rules '()
+(define-minor-mode electric-indent-local-mode
+ "Toggle `electric-indent-mode' only in this buffer."
+ :variable (buffer-local-value 'electric-indent-mode (current-buffer))
+ (cond
+ ((eq electric-indent-mode (default-value 'electric-indent-mode))
+ (kill-local-variable 'electric-indent-mode))
+ ((not (default-value 'electric-indent-mode))
+ ;; Locally enabled, but globally disabled.
+ (electric-indent-mode 1) ; Setup the hooks.
+ (setq-default electric-indent-mode nil) ; But keep it globally disabled.
+ )))
+
+;;; Electric newlines after/before/around some chars.
+
+(defvar electric-layout-rules nil
"List of rules saying where to automatically insert newlines.
-Each rule has the form (CHAR . WHERE) where CHAR is the char
-that was just inserted and WHERE specifies where to insert newlines
-and can be: nil, `before', `after', `around', or a function of no
-arguments that returns one of those symbols.")
+
+Each rule has the form (CHAR . WHERE) where CHAR is the char that
+was just inserted and WHERE specifies where to insert newlines
+and can be: nil, `before', `after', `around', `after-stay', or a
+function of no arguments that returns one of those symbols.
+
+The symbols specify where in relation to CHAR the newline
+character(s) should be inserted. `after-stay' means insert a
+newline after CHAR but stay in the same place.")
(defun electric-layout-post-self-insert-function ()
(let* ((rule (cdr (assq last-command-event electric-layout-rules)))
@@ -432,23 +371,32 @@ arguments that returns one of those symbols.")
(setq pos (electric--after-char-pos))
;; Not in a string or comment.
(not (nth 8 (save-excursion (syntax-ppss pos)))))
- (let ((end (copy-marker (point) t)))
+ (let ((end (point-marker))
+ (sym (if (functionp rule) (funcall rule) rule)))
+ (set-marker-insertion-type end (not (eq sym 'after-stay)))
(goto-char pos)
- (pcase (if (functionp rule) (funcall rule) rule)
+ (pcase sym
;; FIXME: we used `newline' down here which called
;; self-insert-command and ran post-self-insert-hook recursively.
;; It happened to make electric-indent-mode work automatically with
;; electric-layout-mode (at the cost of re-indenting lines
;; multiple times), but I'm not sure it's what we want.
+ ;;
+ ;; FIXME: check eolp before inserting \n?
(`before (goto-char (1- pos)) (skip-chars-backward " \t")
- (unless (bolp) (insert "\n")))
- (`after (insert "\n")) ; FIXME: check eolp before inserting \n?
+ (unless (bolp) (insert "\n")))
+ (`after (insert "\n"))
+ (`after-stay (save-excursion
+ (let ((electric-layout-rules nil))
+ (newline 1 t))))
(`around (save-excursion
- (goto-char (1- pos)) (skip-chars-backward " \t")
- (unless (bolp) (insert "\n")))
- (insert "\n"))) ; FIXME: check eolp before inserting \n?
+ (goto-char (1- pos)) (skip-chars-backward " \t")
+ (unless (bolp) (insert "\n")))
+ (insert "\n"))) ; FIXME: check eolp before inserting \n?
(goto-char end)))))
+(put 'electric-layout-post-self-insert-function 'priority 40)
+
;;;###autoload
(define-minor-mode electric-layout-mode
"Automatically insert newlines around some chars.
@@ -456,13 +404,119 @@ With a prefix argument ARG, enable Electric Layout mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
The variable `electric-layout-rules' says when and how to insert newlines."
- :global t
- :group 'electricity
- (if electric-layout-mode
- (add-hook 'post-self-insert-hook
- #'electric-layout-post-self-insert-function)
- (remove-hook 'post-self-insert-hook
- #'electric-layout-post-self-insert-function)))
+ :global t :group 'electricity
+ (cond (electric-layout-mode
+ (add-hook 'post-self-insert-hook
+ #'electric-layout-post-self-insert-function)
+ (electric--sort-post-self-insertion-hook))
+ (t
+ (remove-hook 'post-self-insert-hook
+ #'electric-layout-post-self-insert-function))))
+
+;;; Electric quoting.
+
+(defcustom electric-quote-comment t
+ "Non-nil means to use electric quoting in program comments."
+ :type 'boolean :safe 'booleanp :group 'electricity)
+
+(defcustom electric-quote-string nil
+ "Non-nil means to use electric quoting in program strings."
+ :type 'boolean :safe 'booleanp :group 'electricity)
+
+(defcustom electric-quote-paragraph t
+ "Non-nil means to use electric quoting in text paragraphs."
+ :type 'boolean :safe 'booleanp :group 'electricity)
+
+(defun electric--insertable-p (string)
+ (or (not buffer-file-coding-system)
+ (eq (coding-system-base buffer-file-coding-system) 'undecided)
+ (not (unencodable-char-position nil nil buffer-file-coding-system
+ nil string))))
+
+(defun electric-quote-post-self-insert-function ()
+ "Function that `electric-quote-mode' adds to `post-self-insert-hook'.
+This requotes when a quoting key is typed."
+ (when (and electric-quote-mode
+ (memq last-command-event '(?\' ?\`)))
+ (let ((start
+ (if (and comment-start comment-use-syntax)
+ (when (or electric-quote-comment electric-quote-string)
+ (let ((syntax (syntax-ppss)))
+ (and (or (and electric-quote-comment (nth 4 syntax))
+ (and electric-quote-string (nth 3 syntax)))
+ (nth 8 syntax))))
+ (and electric-quote-paragraph
+ (derived-mode-p 'text-mode)
+ (or (eq last-command-event ?\`)
+ (save-excursion (backward-paragraph) (point)))))))
+ (when start
+ (save-excursion
+ (if (eq last-command-event ?\`)
+ (cond ((and (electric--insertable-p "“")
+ (search-backward "‘`" (- (point) 2) t))
+ (replace-match "“")
+ (when (and electric-pair-mode
+ (eq (cdr-safe
+ (assq ?‘ electric-pair-text-pairs))
+ (char-after)))
+ (delete-char 1))
+ (setq last-command-event ?“))
+ ((and (electric--insertable-p "‘")
+ (search-backward "`" (1- (point)) t))
+ (replace-match "‘")
+ (setq last-command-event ?‘)))
+ (cond ((and (electric--insertable-p "”")
+ (search-backward "’'" (- (point) 2) t))
+ (replace-match "”")
+ (setq last-command-event ?”))
+ ((and (electric--insertable-p "’")
+ (search-backward "'" (1- (point)) t))
+ (replace-match "’")
+ (setq last-command-event ?’)))))))))
+
+(put 'electric-quote-post-self-insert-function 'priority 10)
+
+;;;###autoload
+(define-minor-mode electric-quote-mode
+ "Toggle on-the-fly requoting (Electric Quote mode).
+With a prefix argument ARG, enable Electric Quote mode if
+ARG is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+When enabled, as you type this replaces \\=` with \\=‘, \\=' with \\=’,
+\\=`\\=` with “, and \\='\\=' with ”. This occurs only in comments, strings,
+and text paragraphs, and these are selectively controlled with
+`electric-quote-comment', `electric-quote-string', and
+`electric-quote-paragraph'.
+
+This is a global minor mode. To toggle the mode in a single buffer,
+use `electric-quote-local-mode'."
+ :global t :group 'electricity
+ :initialize 'custom-initialize-delay
+ :init-value nil
+ (if (not electric-quote-mode)
+ (unless (catch 'found
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if electric-quote-mode (throw 'found t)))))
+ (remove-hook 'post-self-insert-hook
+ #'electric-quote-post-self-insert-function))
+ (add-hook 'post-self-insert-hook
+ #'electric-quote-post-self-insert-function)
+ (electric--sort-post-self-insertion-hook)))
+
+;;;###autoload
+(define-minor-mode electric-quote-local-mode
+ "Toggle `electric-quote-mode' only in this buffer."
+ :variable (buffer-local-value 'electric-quote-mode (current-buffer))
+ (cond
+ ((eq electric-quote-mode (default-value 'electric-quote-mode))
+ (kill-local-variable 'electric-quote-mode))
+ ((not (default-value 'electric-quote-mode))
+ ;; Locally enabled, but globally disabled.
+ (electric-quote-mode 1) ; Setup the hooks.
+ (setq-default electric-quote-mode nil) ; But keep it globally disabled.
+ )))
(provide 'electric)
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 7a468e416c2..4076f00c536 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,6 +1,6 @@
;;; elide-head.el --- hide headers in files
-;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: outlines tools
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 861054e777f..4ee830023fc 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,9 +1,9 @@
;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 12 Dec 1992
;; Keywords: extensions, lisp, tools
;; Package: emacs
@@ -168,7 +168,8 @@
;; "Switch to non-existing buffers only upon confirmation."
;; (interactive "BSwitch to buffer: ")
;; (if (or (get-buffer (ad-get-arg 0))
-;; (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
+;; (y-or-n-p (format-message "`%s' does not exist, create? "
+;; (ad-get-arg 0))))
;; ad-do-it))
;;
;;(defadvice find-file (before existing-files-only activate)
@@ -295,8 +296,8 @@
;; {<after-K-1-body-form>}*
;; ad-return-value))
-;; Macros and special forms will be redefined as macros, hence the optional
-;; [macro] in the beginning of the definition.
+;; Macros are redefined as macros, hence the optional [macro] in the
+;; beginning of the definition.
;; <arglist> is either the argument list of the original function or the
;; first argument list defined in the list of before/around/after advices.
@@ -698,6 +699,7 @@
;; problems because they get expanded at compile or load time, hence, they
;; might not have all the necessary runtime support and such advice cannot be
;; de/activated or changed as it is possible for functions.
+;;
;; Special forms cannot be advised.
;;
;; MORAL: - Only advise macros when you are absolutely sure what you are doing.
@@ -1563,29 +1565,6 @@
;; flexibility and effectiveness of the advice mechanism. Macros that were
;; compile-time expanded before the advice was activated will of course never
;; exhibit the advised behavior.
-;;
-;; @@ Advising special forms:
-;; ==========================
-;; Now for something that should be even more rare than advising macros:
-;; Advising special forms. Because special forms are irregular in their
-;; argument evaluation behavior (e.g., `setq' evaluates the second but not
-;; the first argument) they have to be advised into macros. A dangerous
-;; consequence of this is that the byte-compiler will not recognize them
-;; as special forms anymore (well, in most cases) and use their expansion
-;; rather than the proper byte-code. Also, because the original definition
-;; of a special form cannot be `funcall'ed, `eval' has to be used instead
-;; which is less efficient.
-;;
-;; MORAL: Do not advise special forms unless you are completely sure about
-;; what you are doing (some of the forward advice behavior is
-;; implemented via advice of the special forms `defun' and `defmacro').
-;; As a safety measure one should always do `ad-deactivate-all' before
-;; one byte-compiles a file to avoid any interference of advised
-;; special forms.
-;;
-;; Apart from the safety concerns advising special forms is not any different
-;; from advising plain functions or subrs.
-
;;; Code:
@@ -2101,9 +2080,7 @@ mapped to the closest extremal position).
If FUNCTION was not advised already, its advice info will be
initialized. Redefining a piece of advice whose name is part of
-the cache-id will clear the cache.
-
-See Info node `(elisp)Computed Advice' for detailed documentation."
+the cache-id will clear the cache."
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
@@ -2173,7 +2150,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
(defun ad-arglist (definition)
"Return the argument list of DEFINITION."
- (require 'help-fns)
(help-function-arglist
(if (or (macrop definition) (ad-advice-p definition))
(cdr definition)
@@ -2207,26 +2183,6 @@ Like `interactive-form', but also works on pieces of advice."
(if (ad-interactive-form definition) 1 0))
(cdr (cdr (ad-lambda-expression definition)))))))
-(defun ad-make-advised-definition-docstring (_function)
- "Make an identifying docstring for the advised definition of FUNCTION.
-Put function name into the documentation string so we can infer
-the name of the advised function from the docstring. This is needed
-to generate a proper advised docstring even if we are just given a
-definition (see the code for `documentation')."
- (eval-when-compile
- (propertize "Advice function assembled by advice.el."
- 'dynamic-docstring-function
- #'ad--make-advised-docstring)))
-
-(defun ad-advised-definition-p (definition)
- "Return non-nil if DEFINITION was generated from advice information."
- (if (or (ad-lambda-p definition)
- (macrop definition)
- (ad-compiled-p definition))
- (let ((docstring (ad-docstring definition)))
- (and (stringp docstring)
- (get-text-property 0 'dynamic-docstring-function docstring)))))
-
(defun ad-definition-type (definition)
"Return symbol that describes the type of DEFINITION."
;; These symbols are only ever used to check a cache entry's validity.
@@ -2463,8 +2419,8 @@ as if they had been supplied to a function with TARGET-ARGLIST directly.
Excess source arguments will be neglected, missing source arguments will be
supplied as nil. Returns a `funcall' or `apply' form with the second element
being `function' which has to be replaced by an actual function argument.
-Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
- `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'."
+Example: (ad-map-arglists '(a &rest args) '(w x y z)) will return
+ (funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))."
(let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
(source-reqopt-args (append (nth 0 parsed-source-arglist)
(nth 1 parsed-source-arglist)))
@@ -2518,38 +2474,39 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
(capitalize (symbol-name class))
(ad-advice-name advice)))))))
-(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
-
-(defun ad--make-advised-docstring (origdoc function &optional style)
+(defun ad--make-advised-docstring (function &optional style)
"Construct a documentation string for the advised FUNCTION.
-It concatenates the original documentation with the documentation
-strings of the individual pieces of advice which will be formatted
-according to STYLE. STYLE can be `plain', everything else
-will be interpreted as `default'. The order of the advice documentation
-strings corresponds to before/around/after and the individual ordering
-in any of these classes."
- (if (and (symbolp function)
- (string-match "\\`ad-+Advice-" (symbol-name function)))
- (setq function
- (intern (substring (symbol-name function) (match-end 0)))))
- (let* ((usage (help-split-fundoc origdoc function))
- paragraphs advice-docstring)
- (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
- (if origdoc (setq paragraphs (list origdoc)))
- (dolist (class ad-advice-classes)
- (dolist (advice (ad-get-enabled-advices function class))
- (setq advice-docstring
- (ad-make-single-advice-docstring advice class style))
- (if advice-docstring
- (push advice-docstring paragraphs))))
- (setq origdoc (if paragraphs
- (propertize
- ;; separate paragraphs with blank lines:
- (mapconcat 'identity (nreverse paragraphs) "\n\n")
- ;; FIXME: what is this for?
- 'dynamic-docstring-function
- #'ad--make-advised-docstring)))
- (help-add-fundoc-usage origdoc usage)))
+Concatenate the original documentation with the documentation
+strings of the individual pieces of advice. Optional argument
+STYLE specifies how to format the pieces of advice; it can be
+`plain', or any other value which means the default formatting.
+
+The advice documentation is shown in order of before/around/after
+advice type, obeying the priority in each of these types."
+ ;; Retrieve the original function documentation
+ (let* ((fun (get function 'function-documentation))
+ (origdoc (unwind-protect
+ (progn (put function 'function-documentation nil)
+ (documentation function t))
+ (put function 'function-documentation fun))))
+ (if (and (symbolp function)
+ (string-match "\\`ad-+Advice-" (symbol-name function)))
+ (setq function
+ (intern (substring (symbol-name function) (match-end 0)))))
+ (let* ((usage (help-split-fundoc origdoc function))
+ paragraphs advice-docstring)
+ (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
+ (if origdoc (setq paragraphs (list origdoc)))
+ (dolist (class ad-advice-classes)
+ (dolist (advice (ad-get-enabled-advices function class))
+ (setq advice-docstring
+ (ad-make-single-advice-docstring advice class style))
+ (if advice-docstring
+ (push advice-docstring paragraphs))))
+ (setq origdoc (if paragraphs
+ (mapconcat 'identity (nreverse paragraphs)
+ "\n\n")))
+ (help-add-fundoc-usage origdoc usage))))
;; @@@ Accessing overriding arglists and interactive forms:
@@ -2597,7 +2554,7 @@ in any of these classes."
;; Finally, build the sucker:
(ad-assemble-advised-definition
advised-arglist
- (ad-make-advised-definition-docstring function)
+ nil
interactive-form
orig-form
(ad-get-enabled-advices function 'before)
@@ -2911,6 +2868,8 @@ The current definition and its cache-id will be put into the cache."
(fset advicefunname
(or verified-cached-definition
(ad-make-advised-definition function)))
+ (put advicefunname 'function-documentation
+ `(ad--make-advised-docstring ',advicefunname))
(unless (equal (interactive-form advicefunname) old-ispec)
;; If the interactive-spec of advicefunname has changed, force nadvice to
;; refresh its copy.
@@ -3148,7 +3107,7 @@ deactivation, which might run hooks and get into other trouble."
"Define a piece of advice for FUNCTION (a symbol).
The syntax of `defadvice' is as follows:
- \(defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
+ (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)
@@ -3186,11 +3145,10 @@ time. This generates a compiled advised definition according to the current
advice state that will be used during activation if appropriate. Only use
this if the `defadvice' gets actually compiled.
-See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
- (declare (doc-string 3)
+ (declare (doc-string 3) (indent 2)
(debug (&define name ;; thing being advised.
(name ;; class is [&or "before" "around" "after"
;; "activation" "deactivation"]
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
deleted file mode 100644
index 270badd53cb..00000000000
--- a/lisp/emacs-lisp/authors.el
+++ /dev/null
@@ -1,1097 +0,0 @@
-;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*-
-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
-
-;; Author: Gerd Moellmann <gerd@gnu.org>
-;; Maintainer: Kim F. Storm <storm@cua.dk>
-;; Keywords: maint
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Use M-x authors RET to create an *Authors* buffer that can used as
-;; or merged with Emacs's AUTHORS file.
-
-;;; Code:
-
-(defvar authors-coding-system 'utf-8
- "Coding system used in the AUTHORS file.")
-
-(defconst authors-many-files 20
- "Maximum number of files for which to print individual information.
-If an author has modified more files, only the names of the most
-frequently modified files are printed and a count of the additional
-files.")
-
-(defconst authors-aliases
- '(
- ("Aaron S. Hawley" "Aaron Hawley")
- ("Alexandru Harsanyi" "Alex Harsanyi")
- ("Andrew Csillag" "Drew Csillag")
- ("Anna M. Bigatti" "Anna Bigatti")
- ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc."
- "Barry A. Warsaw, ITB" "Barry Warsaw")
- ("Bill Carpenter" "WJ Carpenter")
- ("Bill Mann" "William F. Mann")
- ("Bill Rozas" "Guillermo J. Rozas")
- ("Björn Torkelsson" "Bjorn Torkelsson")
- ("Brian Fox" "Brian J. Fox")
- ("Brian Sniffen" "Brian T. Sniffen")
- ("Christoph Wedler" "Christoph.Wedler@sap.com")
- ("Daniel Pfeiffer" "<Daniel.Pfeiffer@Informatik.START.db.de>"
- "<Daniel.Pfeiffer@Informatik.START.dbp.de>")
- ("David Abrahams" "Dave Abrahams")
- ("David De La Harpe Golden" "David Golden")
- ("David Gillespie" "Dave Gillespie")
- ("David Kågedal" "David K..edal")
- ("David M. Koppelman" "David M. Koppelman, Koppel@Ec?e.Lsu.Edu"
- "David Koppelman")
- ("David M. Smith" "David Smith" "David M Smith")
- ("David O'Toole" "David T. O'Toole")
- ("Deepak Goel" "D. Goel")
- ("Ed L. Cashin" "Ed L Cashin")
- ("Edward M. Reingold" "Ed Reingold" "Edward M Reingold"
- "Reingold Edward M")
- ("Eli Zaretskii" "eliz")
- ("Emilio C. Lopes" "Emilio Lopes")
- ("Era Eriksson" "Era@Iki.Fi")
- ("Eric M. Ludlam" "Eric Ludlam")
- ("Eric S. Raymond" "Eric Raymond")
- ("Eric Youngdale" "(Eric Youngdale at youngdale@v6550c.nrl.navy.mil)")
- ("Francis J. Wright" "Dr Francis J. Wright" "Francis Wright")
- ("François Pinard" "Francois Pinard")
- ("Francesco Potortì" "Francesco Potorti" "Francesco Potorti`")
- ("Frederic Pierresteguy" "Fred Pierresteguy")
- ("Geoff Voelker" "voelker")
- ("Gerd Möllmann" "Gerd Moellmann")
- ("Hallvard B. Furuseth" "Hallvard B Furuseth" "Hallvard Furuseth")
- ("Hrvoje Nikšić" "Hrvoje Niksic")
- ;; lisp/org/ChangeLog 2010-11-11.
- (nil "aaa bbb")
- ;; src/ChangeLog.4, 1994-01-11, since fixed.
-;;; (nil "(afs@hplb.hpl.hp.com)")
- ;; lisp/gnus/ChangeLog.1, 1998-01-15.
- ;; http://quimby.gnus.org/cgi-bin/cvsweb.cgi/gnus/lisp/gnus-art.el?rev=4.13
- (nil "<Use-Author-Address-Header@\\[127.1\\]>")
- (nil "Code Extracted") ; lisp/newcomment.el's "Author:" header
- (nil "\\`FSF") ; FIXME what is this for - no effect?
- ;; lisp/gnus/ChangeLog.1, 1997-10-12, since fixed.
-;;; (nil "ISO-2022-JP")
- ("Jaeyoun Chung" "Jae-youn Chung" "Jae-you Chung" "Chung Jae-youn")
- ("Jan Djärv" "Jan D." "Jan Djarv")
- ("Jay K. Adams" "jka@ece.cmu.edu" "Jay Adams")
- ("Jérôme Marant" "Jérôme Marant" "Jerome Marant")
- ("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
- ("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
- ("Johan Bockgård" "Johan Bockgard")
- ("John J Foerch" "John Foerch")
- ("John W. Eaton" "John Eaton")
- ("Jonathan I. Kamens" "Jonathan Kamens")
- ("Joseph Arceneaux" "Joe Arceneaux")
- ("Joseph M. Kelsey" "Joe Kelsey") ; FIXME ?
- ("Juan León Lahoz García" "Juan-Leon Lahoz Garcia")
- ("K. Shane Hartman" "Shane Hartman")
- ("Kai Großjohann" "Kai Grossjohann" "Kai Großjohann"
- "Kai.Grossjohann@Cs.Uni-Dortmund.De"
- "Kai.Grossjohann@Gmx.Net")
- ("Karl Berry" "K. Berry")
- ("Károly Lőrentey" "Károly Lőrentey" "Lőrentey Károly")
- ("Kazushi Marukawa" "Kazushi")
- ("Ken Manheimer" "Kenneth Manheimer")
- ("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA")
- ("Kevin Greiner" "Kevin J. Greiner")
- ("Kim F. Storm" "Kim Storm")
- ("Kyle Jones" "Kyle E. Jones")
- ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen")
- ("Marcus G. Daniels" "Marcus Daniels")
- ("Mark D. Baushke" "Mark D Baushke")
- ("Marko Kohtala" "Kohtala Marko")
- ("Agustín Martín" "Agustin Martin" "Agustín Martín Domingo")
- ("Martin Lorentzon" "Martin Lorentzson")
- ("Matt Swift" "Matthew Swift")
- ("Maxime Edouard Robert Froumentin" "Max Froumentin")
- ("Michael R. Mauger" "Michael Mauger")
- ("Michael D. Ernst" "Michael Ernst")
- ("Michaël Cadilhac" "Michael Cadilhac")
- ("Michael I. Bushnell" "Michael I Bushnell" "Michael I. Bushnell, P/Bsg")
- ("Michael R. Cook" "Michael Cook")
- ("Michael Sperber" "Michael Sperber \\[Mr. Preprocessor\\]")
- ("Mikio Nakajima" "Nakajima Mikio")
- ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
- ("Noorul Islam" "Noorul Islam K M")
- ("Paul Eggert" "eggert")
- ("Paul Reilly" "(pmr@legacy.pajato.com)")
- ("Pavel Janík" "Pavel Janík Ml." "Pavel Janik Ml." "Pavel Janik" "Pavel Janík" "Pavel@Janik.Cz")
- ("Pavel Kobiakov" "Pavel Kobyakov")
- ("Per Abrahamsen" "Per Abhiddenware")
- ("Per Starbäck" "Per Starback")
- ("Peter J. Weisberg" "PJ Weisberg")
- ("Peter S. Galbraith" "Peter Galbraith")
- ("Peter Runestig" "Peter 'luna' Runestig")
- ("Peter S. Galbraith" "Peter S Galbraith")
- ("Raja R. Harinath" "Raja R Harinath")
- ("Richard G. Bielawski" "Richard G Bielawski" "Richard Bielawski")
- ("Richard King" "Dick King")
- ("Richard M. Stallman" "Richard M. Stallman,,," "Richard Stallman"
- "rms" "rms@gnu.org")
- ("Robert J. Chassell" "Bob Chassell")
- ("Roland B. Roberts" "Roland B Roberts" "Roland Roberts")
- ("Rui-Tao Dong" "Rui-Tao Dong ~{6-Hpln~}")
- ("Sacha Chua" "Sandra Jean Chua")
- ("Sam Steingold" "Sam Shteingold")
- ("Satyaki Das" "Indexed search by Satyaki Das")
- ("Sébastien Vauban" "Sebastien Vauban")
- ;; There are other Stefans.
-;;; ("Stefan Monnier" "Stefan")
- ("Stephen A. Wood" "(saw@cebaf.gov)")
- ("Steven L. Baur" "SL Baur" "Steven L Baur")
- ("Stewart M. Clamen" "Stewart Clamen")
- ("Stuart D. Herring" "Stuart Herring" "Davis Herring")
- ("T.V. Raman" "T\\. V\\. Raman")
- ("Taichi Kawabata" "KAWABATA,? Taichi")
- ("Takaaki Ota" "Tak Ota")
- ("Takahashi Naoto" "Naoto Takahashi")
- ("Teodor Zlatanov" "Ted Zlatanov")
- ("Thomas Dye" "Tom Dye")
- ("Thomas Horsley" "Tom Horsley") ; FIXME ?
- ("Thomas Wurgler" "Tom Wurgler")
- ("Toby Cubitt" "Toby S\\. Cubitt")
- ("Tomohiko Morioka" "MORIOKA Tomohiko")
- ("Torbjörn Axelsson" "Torbjvrn Axelsson")
- ("Torbjörn Einarsson" "Torbj.*rn Einarsson")
- ("Toru Tomabechi" "Toru Tomabechi,")
- ("Tsugutomo Enami" "enami tsugutomo")
- ("Ulrich Müller" "Ulrich Mueller")
- ("Vincent Del Vecchio" "Vince Del Vecchio")
- ("William M. Perry" "Bill Perry")
- ("Wlodzimierz Bzyl" "W.*dek Bzyl")
- ("Yoni Rabkin" "Yoni Rabkin Katzenell")
- ("Yoshinori Koseki" "KOSEKI Yoshinori" "小関 吉則")
- ("Yutaka NIIBE" "NIIBE Yutaka")
- )
- "Alist of author aliases.
-
-Each entry is of the form (REALNAME REGEXP...). If an author's name
-matches one of the REGEXPs, use REALNAME instead.
-If REALNAME is nil, ignore that author.")
-
-;; FIXME seems it would be less fragile to check for O', Mc, etc.
-(defconst authors-fixed-case
- '("Bryan O'Sullivan"
- "Christian von Roques"
- "Christophe de Dinechin"
- "Craig McDaniel"
- "David J. MacKenzie"
- "David McCabe"
- "David O'Toole"
- "Devon Sean McCullough"
- "Dominique de Waleffe"
- "Edward O'Connor"
- "Exal de Jesus Garcia Carrillo"
- "Greg McGary"
- "Hans de Graaff"
- "James TD Smith"
- "Joel N. Weber II"
- "Michael McNamara"
- "Mike McEwan"
- "Nelson Jose dos Santos Ferreira"
- "Peter von der Ahe"
- "Peter O'Gorman"
- "Piet van Oostrum"
- "Roland McGrath"
- "Sean O'Halpin"
- "Sean O'Rourke"
- "Tijs van Bakel")
- "List of authors whose names cannot be simply capitalized.")
-
-(defvar authors-public-domain-files
- '("emerge\\.el"
- "vi\\.el"
- "feedmail\\.el"
- "mailpost\\.el"
- "hanoi\\.el"
- "meese\\.el"
- "studly\\.el"
- "modula2\\.el"
- "nnmaildir\\.el"
- "nnil\\.el"
- "b2m\\.c"
- "unexhp9k800\\.c"
- "emacsclient\\.1"
- "check-doc-strings")
- "List of regexps matching files for which the FSF doesn't need papers.")
-
-
-(defvar authors-obsolete-files-regexps
- '("vc-\\*\\.el$"
- "spec.txt$"
- ".*loaddefs.el$" ; not obsolete, but auto-generated
- "\\.\\(cvs\\|git\\)ignore$" ; obsolete or uninteresting
- "\\.arch-inventory$"
- ;; TODO lib/? Matches other things?
- "build-aux/" "m4/" "Emacs.xcodeproj" "charsets" "mapfiles"
- "preferences\\.\\(nib\\|gorm\\)"
- "vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el$")
- "List of regexps matching obsolete files.
-Changes to files matching one of the regexps in this list are not listed.")
-
-(defconst authors-ignored-files
- '("external-lisp"
- "lock" "share-lib" "local-lisp"
- "noleim-Makefile.in"
- "NEWS" "ORDERS" "PROBLEMS" "FAQ" "AUTHORS" "FOR-RELEASE" "TODO" "todo"
- "MACHINES" "SERVICE"
- "README.unicode" "README.multi-tty" "TUTORIAL.translators"
- "NEWS.unicode" "COPYING.DJ" "Makefile.old" "Makefile.am"
- "NEWS.1" "OOOOONEWS...OONEWS" "OOOONEWS" "etc/NEWS"
- "NEWS.1-17" "NEWS.18" "NEWS.19" "NEWS.20" "NEWS.21" "NEWS.22"
- "MAINTAINERS" "MH-E-NEWS"
- "install-sh" "missing" "mkinstalldirs"
- "termcap.dat" "termcap.src" "termcap.ucb" "termcap"
- "ChangeLog.nextstep" "Emacs.clr" "spec.txt"
- "gfdl.1"
- "texi/Makefile.in"
- "Imakefile" "icons/sink.ico" "aixcc.lex"
- "nxml/char-name/unicode"
- "js2-mode.el" ; only installed very briefly, replaced by js.el
- "cedet/tests/testtemplates.cpp"
- "cedet/tests/testusing.cpp"
- "cedet/tests/scopetest.cpp"
- "cedet/tests/scopetest.java"
- "cedet/tests/test.cpp"
- "cedet/tests/test.py"
- "cedet/tests/teststruct.cpp"
- "*.el"
- ;; Autogen:
- "cus-load.el" "finder-inf.el" "ldefs-boot.el"
- "compile" "config.guess" "config.sub" "depcomp"
- ;; Only existed briefly, then renamed:
- "images/icons/allout-widgets-dark-bg"
- "images/icons/allout-widgets-light-bg"
- ;; Never had any meaningful changes logged, now deleted:
- "unidata/bidimirror.awk" "unidata/biditype.awk"
- "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
- "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
- "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
- "CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit"
- "NICKLES.WORTH" "INTERVAL.IDEAS" "RCP"
- "3B-MAXMEM" "AIX.DUMP" "SUN-SUPPORT" "XENIX"
- "CODINGS" "CHARSETS"
- "calc/INSTALL" "calc/Makefile"
- "vms-pp.trans" "_emacs" "batcomp.com" "notes/cpp" ; admin/
- "emacsver.texi.in"
- "vpath.sed"
- "Cocoa/Emacs.base/Contents/Info.plist"
- "Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings"
- "GNUstep/Emacs.base/Resources/Info-gnustep.plist"
- "GNUstep/Emacs.base/Resources/Emacs.desktop"
- "Cocoa/Emacs.base/Contents/Resources/English.lproj"
- ;; Only existed briefly, then deleted:
- "coccinelle/overlay.cocci" "coccinelle/symbol.cocci"
- ;; MH-E stuff not in Emacs:
- "import-emacs" "release-utils"
- ;; Erc stuff not in Emacs:
- "ChangeLog.2001" "ChangeLog.2002" "ChangeLog.2003" "ChangeLog.2004"
- "ChangeLog.2005"
- "README.extras" "dir-template" "mkChangeLog" "MkChangeLog" "erc-auto.in"
- "CREDITS" "HACKING"
- "debian/changelog"
- "debian/control"
- "debian/copyright"
- "debian/maint/conffiles"
- "debian/maint/conffiles.in"
- "debian/maint/postinst"
- "debian/maint/postinst.in"
- "debian/maint/prerm"
- "debian/maint/prerm.in"
- "debian/README.Debian"
- "debian/README.erc-speak"
- "debian/rules"
- "debian/scripts/install"
- "debian/scripts/install.in"
- "debian/scripts/remove"
- "debian/scripts/remove.in"
- "debian/scripts/startup"
- "debian/scripts/startup.erc"
- "debian/scripts/startup.erc-speak"
- )
- "List of files and directories to ignore.
-Changes to files in this list are not listed.")
-
-;; List via: find . -name '*.el' | sed 's/.*\///g' | sort | uniq -d
-;; FIXME It would be better to discover these dynamically.
-;; Note that traditionally "Makefile.in" etc have not been in this list.
-;; Ditto for "abbrev.texi" etc.
-(defconst authors-ambiguous-files
- '("chart.el"
- "compile.el"
- "complete.el"
- "cpp.el"
- "ctxt.el"
- "custom.el"
- "cyrillic.el"
- "czech.el"
- "debug.el"
- "dired.el"
- "el.el"
- "eshell.el"
- "ethiopic.el"
- "f90.el"
- "files.el"
- "find.el"
- "format.el"
- "generic.el"
- "georgian.el"
- "greek.el"
- "grep.el"
- "hebrew.el"
- "imenu.el"
- "indian.el"
- "japanese.el"
- "java.el"
- "lao.el"
- "linux.el"
- "locate.el"
- "make.el"
- "mode.el"
- "python.el"
- "rmailmm.el"
- "semantic.el"
- "shell.el"
- "simple.el"
- "slovak.el"
- "sort.el"
- "speedbar.el"
- "srecode.el"
- "table.el"
- "texi.el"
- "thai.el"
- "tibetan.el"
- "util.el"
- "vc-bzr.el"
- "wisent.el")
- "List of basenames occurring more than once in the source.")
-
-;; FIXME :cowrote entries here can be overwritten by :wrote entries
-;; derived from a file's Author: header (eg mh-e). This really means
-;; the Author: header is erroneous.
-(defconst authors-fixed-entries
- '(("Richard M. Stallman" :wrote "[The original GNU Emacs and numerous files]")
- ("Joseph Arceneaux" :wrote "xrdb.c")
- ;; This refers to the obsolete Willisson (qv) version.
-;;; ("Blitz Product Development Corporation" :wrote "ispell.el")
- ("Frank Bresz" :wrote "diff.el")
- ("David M. Brown" :wrote "array.el")
- ;; No longer distributed.
-;;; ("Gary Byers" :changed "xenix.h")
- ("Shawn M. Carey" :wrote "freebsd.h")
- ;; hp800.h renamed from hp9000s800.h, hpux.h merged into hpux10-20.h.
- ;; FIXME overwritten by Author:.
- ("Satyaki Das" :cowrote "mh-search.el")
- ("Eric Decker" :changed "hp800.h" "hpux10-20.h" "sysdep.c")
- ("Lawrence R. Dodd" :cowrote "dired-x.el")
- ;; No longer distributed.
-;;; ("Viktor Dukhovni" :wrote "unexsunos4.c")
- ("Paul Eggert" :wrote "rcs2log") ; "vcdiff"
- ("Fred Fish" :changed "unexcoff.c")
- ;; No longer distributed.
-;;; ("Tim Fleehart" :wrote "makefile.nt")
- ("Keith Gabryelski" :wrote "hexl.c")
- ("Kevin Gallagher" :wrote "flow-ctrl.el")
- ;; Also wrote an earlier version of disp-table.el, since replaced
- ;; by Erik Naggum's version; also iso-syntax.el, later renamed to
- ;; latin-1.el, since deleted.
- ("Howard Gayle" :wrote "casetab.c")
- ;; :wrote mh-pick.el, since merged into mh-search.el.
- ;; Originally wrote mh-funcs.el, but it has been rewritten since.
- ("Stephen Gildea" :wrote "refcard.tex"
- :cowrote "mh-funcs.el" "mh-search.el")
- ;; cl.texinfo renamed to cl.texi.
- ("David Gillespie" :wrote "cl.texi")
- ;; No longer distributed: emacsserver.c.
- ("Hewlett-Packard" :changed "emacsclient.c" "server.el" "keyboard.c")
- ;; No longer distributed.
-;;; ("Thomas Horsley" :wrote "cxux.h" "cxux7.h")
- ("Indiana University Foundation" :changed "buffer.c" "buffer.h"
- "indent.c" "search.c" "xdisp.c" "region-cache.c" "region-cache.h")
- ;; ibmrt.h, ibmrt-aix.h no longer distributed.
- ("International Business Machines" :changed "emacs.c" "fileio.c"
- "process.c" "sysdep.c" "unexcoff.c")
- ;; No longer distributed.
-;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h")
- ;; ymakefile no longer distributed.
- ("Michael K. Johnson" :changed "configure.ac" "emacs.c" "intel386.h"
- "mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h"
- "systty.h" "unexcoff.c" "linux.h")
- ;; No longer distributed.
-;;; ("Kyle Jones" :wrote "mldrag.el")
- ("Henry Kautz" :wrote "bib-mode.el")
- ;; No longer distributed: vms-pwd.h, vmsfns.c, uaf.h.
- ("Joseph M. Kelsey" :changed "fileio.c" "dir.h")
- ("Sam Kendall" :changed "etags.c" "etags.el")
- ;; ack.texi: "We're not using his backquote.el any more."
- ("Richard King" :wrote "userlock.el" "filelock.c")
- ("Sebastian Kremer" :changed "add-log.el")
- ("Mark Lambert" :changed "process.c" "process.h")
- ("Aaron Larson" :changed "bibtex.el")
- ;; It was :wrote, but it has been rewritten since.
- ("James R. Larus" :cowrote "mh-e.el")
- ("Lars Lindberg" :changed "dabbrev.el" :cowrote "imenu.el")
- ;; No longer distributed: lselect.el.
- ("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el"
- "bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el"
- "lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
- ;; MCC. No longer distributed: emacsserver.c.
- ("Microelectronics and Computer Technology Corporation"
- :changed "etags.c" "emacsclient.c" "movemail.c"
- "rmail.el" "rmailedit.el" "rmailkwd.el"
- "rmailmsc.el" "rmailout.el" "rmailsum.el" "scribe.el"
- ;; It was :wrote for xmenu.c, but it has been rewritten since.
- "server.el" "lisp.h" "sysdep.c" "unexcoff.c" "xmenu.c")
- ("Niall Mansfield" :changed "etags.c")
- ("Brian Marick" :cowrote "hideif.el")
- ("Marko Kohtala" :changed "info.el")
- ("Sidney Markowitz" :changed "doctor.el")
- ;; No longer distributed: env.c.
- ("Richard Mlynarik" :wrote "ehelp.el")
- ("Mosur Mohan" :changed "etags.c")
- ("Jeff Morgenthaler" :changed "flow-ctrl.el" "vt200.el" "vt201.el"
- "vt220.el" "vt240.el")
- ("Motorola" :changed "buff-menu.el")
- ("Hiroshi Nakano" :changed "ralloc.c")
- ;; File removed in Emacs 24.1.
-;;; ("Sundar Narasimhan" :changed "rnewspost.el")
- ;; No longer distributed.
-;;; ("NeXT, Inc." :wrote "unexnext.c")
- ("Mark Neale" :changed "fortran.el")
- ;; Renamed from sc.el.
- ("Martin Neitzel" :changed "supercite.el")
- ("Andrew Oram" :changed "calendar.texi (and other files in man/)")
- ("Frederic Pierresteguy" :wrote "widget.c")
- ("Michael D. Prange" :changed "tex-mode.el")
- ;; No longer distributed (dgux5-4r3.h was renamed to dgux5-4-3.h).
-;;; ("Paul Reilly" :wrote "gux5-4r2.h" "dgux5-4-3.h")
- ("Roland B. Roberts" :changed "files.el" "sort.el"
- "buffer.h" "callproc.c" "dired.c" "process.c" "sysdep.c" "systty.h")
- ;; No longer distributed.
-;;; "vmspaths.h" "build.com" "compile.com" "kepteditor.com" "precomp.com"
-;;; "vmsproc.el" :wrote "logout.com" "mailemacs.com")
-;;; ("Guillermo J. Rozas" :wrote "fakemail.c")
- ("Wolfgang Rupprecht" :changed "lisp-mode.el" "loadup.el"
- "sort.el" "alloc.c" "callint.c"
- ;; config.in renamed from config.h.in; ecrt0.c from crt0.c.
- "config.in" "ecrt0.c" "data.c" "fns.c"
- "lisp.h" "lread.c" ; "sun3.h" "ymakefile" - no longer distributed
- "print.c" :wrote "float-sup.el" "floatfns.c")
- ("Schlumberger Technology Corporation" :changed "gud.el")
- ;; Replaced by tcl.el.
-;;; ("Gregor Schmid" :wrote "tcl-mode.el")
- ("Rainer Schoepf" :wrote "alpha.h" "unexalpha.c")
- ;; No longer distributed: emacsserver.c.
- ("William Sommerfeld" :wrote "emacsclient.c" "scribe.el")
- ;; No longer distributed: emacsserver.c.
- ("Leigh Stoller" :changed "emacsclient.c" "server.el")
- ("Steve Strassmann" :wrote "spook.el")
- ("Shinichirou Sugou" :changed "etags.c")
- ;; No longer distributed: emacsserver.c.
- ("Sun Microsystems, Inc" :changed "emacsclient.c" "server.el"
- :wrote "emacs.icon" "sun.el")
- ;; No longer distributed.
-;;; "emacstool.1" "emacstool.c" "sun-curs.el"
-;;; "sun-fns.el" "sun-mouse.el" "sunfns.c")
- ;; Renamed from sc.el.
- ("Kayvan Sylvan" :changed "supercite.el")
- ;; No longer distributed: emacsserver.c, tcp.c.
- ("Spencer Thomas" :changed "emacsclient.c" "server.el"
- "dabbrev.el" "unexcoff.c" "gnus.texi")
- ("Jonathan Vail" :changed "vc.el")
- ("James Van Artsdalen" :changed "usg5-4.h" "unexcoff.c")
- ;; No longer distributed: src/makefile.nt, lisp/makefile.nt
- ;; winnt.el renamed to w32-fns.el; nt.[ch] to w32.[ch];
- ;; ntheap.[ch] to w32heap.[ch]; ntinevt.c to w32inevt.c;
- ;; ntproc.c to w32proc.c; ntterm.c to w32term.c;
- ;; windowsnt.h to ms-w32.h.
- ("Geoff Voelker" :wrote "w32-fns.el" "w32.c" "w32.h" "w32heap.c"
- "w32heap.h" "w32inevt.c" "w32proc.c" "w32term.c" "ms-w32.h")
- ("Morten Welinder" :wrote "dosfns.c" "[many MS-DOS files]" "msdos.h")
- ("Eli Zaretskii" :wrote "bidi.c" "[bidirectional display in xdisp.c]")
- ;; Not using this version any more.
-;;; ("Pace Willisson" :wrote "ispell.el")
- ;; FIXME overwritten by Author:.
- ("Bill Wohler" :cowrote "mh-e.el")
- ("Garrett Wollman" :changed "sendmail.el")
- ("Dale R. Worley" :changed "mail-extr.el")
- ("Jamie Zawinski" :changed "bytecode.c" :wrote "tar-mode.el"
- :cowrote "disass.el"))
- "Actions taken from the original, manually (un)maintained AUTHORS file.")
-
-
-(defconst authors-valid-file-names
- '("aclocal.m4"
- "build-ins.in"
- "Makefile.noleim"
- "makedist.bat"
- "makefile.def"
- "makefile.nt"
- "ns.mk"
- "debug.bat.in" "emacs.bat.in"
- ".gdbinit-union"
- "alloca.s"
- "make-delta"
- "config.w95"
- "emacstool.1"
- "align.umax"
- "cxux-crt0.s"
- "gould-sigvec.s"
- "getdate.y"
- "ymakefile"
- "permute-index" "index.perm"
- "ibmrs6000.inp"
- "b2m.c" "b2m.1" "b2m.pl" "rcs-checkin.1"
- "emacs.bash" "emacs.csh" "ms-kermit"
- "emacs.ico"
- "emacs21.ico"
- "emacs.py" "emacs2.py" "emacs3.py"
- "BABYL" "LPF" "LEDIT" "OTHER.EMACSES"
- "emacs16_mac.png" "emacs24_mac.png"
- "emacs256_mac.png" "emacs32_mac.png"
- "emacs48_mac.png" "emacs512_mac.png"
- "revdiff" ; admin/
- "vcdiff" "rcs-checkin" "tindex.pl"
- "mainmake" "sed1.inp" "sed2.inp" "sed3.inp" ; msdos/
- "mac-fix-env.m"
- ;; Deleted vms stuff:
- "temacs.opt" "descrip.mms" "compile.com" "link.com"
- )
- "File names which are valid, but no longer exist (or cannot be found)
-in the repository.")
-
-(defconst authors-renamed-files-alist
- '(("nt.c" . "w32.c") ("nt.h" . "w32.h")
- ("ntheap.c" . "w32heap.c") ("ntheap.h" . "w32heap.h")
- ("ntinevt.c" . "w32inevt.c") ("ntinevt.h" . "w32inevt.h")
- ("ntproc.c" . "w32proc.c")
- ("w32console.c" . "w32term.c")
- ("unexnt.c" . "unexw32.c")
- ("s/windowsnt.h" . "s/ms-w32.h")
- ("s/ms-w32.h" . "inc/ms-w32.h")
- ("winnt.el" . "w32-fns.el")
- ("emacs.manifest" . "emacs-x86.manifest")
- ("config.emacs" . "configure")
- ("configure.in" . "configure.ac")
- ("config.h.dist" . "config.in")
- ("config.h-dist" . "config.in")
- ("config.h.in" . "config.in")
- ("paths.h-dist" . "paths.h.in")
- ("patch1" . "sed1.inp")
- ("GETTING.GNU.SOFTWARE" . "FTP")
- ("etc/MACHINES" . "MACHINES")
- ("ONEWS" . "NEWS.19")
- ("ONEWS.1" . "NEWS.1-17")
- ("ONEWS.2" . "NEWS.1-17")
- ("ONEWS.3" . "NEWS.18")
- ("ONEWS.4" . "NEWS.18")
- ("ORDERS.USA" . "ORDERS")
- ("EUROPE" . "ORDERS")
- ("DIFF" . "OTHER.EMACSES")
- ("CCADIFF" . "OTHER.EMACSES")
- ("GOSDIFF" . "OTHER.EMACSES")
- ("Makefile.in.in" . "Makefile.in")
- ("leim-Makefile" . "leim/Makefile")
- ("leim-Makefile.in" . "leim/Makefile.in")
- ("emacs-lisp/testcover-ses.el" . "tcover-ses.el")
- ("emacs-lisp/testcover-unsafep.el" . "tcover-unsafep.el")
- ;; index and pick merged into search.
- ("mh-index.el" . "mh-search.el")
- ("mh-pick.el" . "mh-search.el")
- ("font-setting.el" . "dynamic-setting.el")
- ;; INSTALL-CVS -> .CVS -> .BZR
- ("INSTALL-CVS" . "INSTALL.BZR")
- ("INSTALL.CVS" . "INSTALL.BZR")
- ("refcards/fr-drdref.pdf" . "refcards/fr-dired-ref.pdf")
- ("gnus-logo.eps" . "refcards/gnus-logo.eps")
- ("build-install" . "build-ins.in")
- ("build-install.in" . "build-ins.in")
- ("unidata/Makefile" . "unidata/Makefile.in")
- ("move-if-change" . "build-aux/move-if-change")
- ("update-subdirs" . "build-aux/update-subdirs")
- ;; Not renamed, but we only have the latter in the Emacs repo.
- ("trampver.texi.in" . "trampver.texi")
- ("e/eterm" . "e/eterm-color")
- ("e/eterm.ti" . "e/eterm-color.ti")
- ("README.txt" . "README")
- ("emacs.names" . "JOKES")
- ("ED.WORSHIP" . "JOKES")
- ("GNU.JOKES" . "JOKES")
- ("CHARACTERS" . "TODO")
- ("schema/xhtml-basic-form.rnc" . "schema/xhtml-bform.rnc" )
- ("schema/xhtml-basic-table.rnc" . "schema/xhtml-btable.rnc")
- ("schema/xhtml-list.rnc" . "schema/xhtml-lst.rnc")
- ("schema/xhtml-target.rnc" . "schema/xhtml-tgt.rnc")
- ("schema/xhtml-style.rnc" . "schema/xhtml-xstyle.rnc")
- ("schema/docbook-dyntbl.rnc" . "schema/docbk-dyntbl.rnc")
- ("schema/docbook-soextbl.rnc" . "schema/docbk-soextbl.rn" )
- ("texi/url.txi" . "url.texi")
- ("edt-user.doc" . "edt.texi")
- ("DEV-NOTES" . "nextstep")
- ("org/COPYRIGHT-AND-LICENSE" . "org/README")
- ;; Moved to different directories.
- ("ctags.1" . "ctags.1")
- ("etags.1" . "etags.1")
- ("emacs.1" . "emacs.1")
- ("emacsclient.1" . "emacsclient.1")
- ("icons/emacs21.ico" . "emacs21.ico")
- ;; Moved from admin/nt/ to nt/.
- ("nt/README.W32" . "README.W32")
- )
- "Alist of files which have been renamed during their lifetime.
-Elements are (OLDNAME . NEWNAME).")
-
-(defconst authors-renamed-files-regexps
- '(("^m/m-\\(.*\\.h\\)$" . "m/\\1")
- ("^m-\\(.*\\.h\\)$" . "\\1")
- ("^s/s-\\(.*\\.h\\)$" . "s/\\1")
- ("^s-\\(.*\\.h\\)$" . "\\1")
- ("^s/[-.a-zA-Z0-9_]+\\.h$" . t)
- ("\\(.*\\)\\.cmd$" . "\\1.bat")
- ("\\.bat$" . t)
- ("\\.[ch]$" . t)
- ("\\.el$" . t)
- ("\\.ps$" . t)
- ("\\.texi?$" . t)
- ("\\.texinfo$" . t)
- ("\\.xml?$" . t)
- ("\\.x[pb]m$" . t)
- ("\\.[xp]bm$" . t)
- ("^paths\\." . t)
- ("^install\\." . t)
- ("^\\(TUTORIAL[^/]*\\)" . "tutorials/\\1")
- ("^\\(tree-widget/\\(?:default\\|folder\\)/[-a-z]+\\.png\\)$" .
- "images/\\1")
- ("^\\(images/icons/\\)mac\\(emacs\\)_\\([0-9]+\\)\\(\\.png\\)" .
- "\\1\\2\\3_mac\\4")
- ("\\(images/icons/\\)emacs_\\([0-9][0-9]\\)\\.png" .
- "\\1hicolor/\\2x\\2/apps/emacs.png")
- )
- "List regexps and rewriting rules for renamed files.
-Elements are (REGEXP . REPLACE). If REPLACE is a string, the file
-name matching REGEXP is replaced by REPLACE using `replace-string'.
-Otherwise, the file name is accepted as is.")
-
-(defvar authors-checked-files-alist)
-(defvar authors-invalid-file-names)
-
-(defun authors-disambiguate-file-name (fullname)
- "Convert FULLNAME to an unambiguous relative-name."
- (let ((relname (file-name-nondirectory fullname))
- parent)
- (if (member relname authors-ambiguous-files)
- ;; In case of ambiguity, just prepend the parent directory.
- ;; FIXME obviously this is not a perfect solution.
- (if (string-equal "lisp"
- (setq parent (file-name-nondirectory
- (directory-file-name
- (file-name-directory fullname)))))
- relname
- (format "%s/%s" parent relname))
- relname)))
-
-(defun authors-canonical-file-name (file log-file pos author)
- "Return canonical file name for FILE found in LOG-FILE.
-Checks whether FILE is a valid (existing) file name, has been renamed,
-or is on the list of removed files. Returns the non-directory part of
-the file name. Only uses the LOG-FILE position POS and associated AUTHOR
-to print a message if FILE is not found."
- ;; FILE should be re-checked in every different directory associated
- ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the
- ;; same as that from top-level/ChangeLog.
- (let* ((fullname (expand-file-name file (file-name-directory log-file)))
- (entry (assoc fullname authors-checked-files-alist))
- relname
- valid)
- (if entry
- (cdr entry)
- (setq relname (file-name-nondirectory file))
- (if (or (member relname authors-valid-file-names)
- (file-exists-p file)
- (file-exists-p relname)
- (file-exists-p (concat "etc/" relname)))
- (setq valid (authors-disambiguate-file-name fullname))
- (setq valid (assoc file authors-renamed-files-alist))
- (if valid
- (setq valid (cdr valid))
- (let ((rules authors-renamed-files-regexps))
- (while rules
- (if (string-match (car (car rules)) file)
- (setq valid (if (stringp (cdr (car rules)))
- (file-name-nondirectory
- (replace-match (cdr (car rules)) t nil file))
- relname)
- rules nil))
- (setq rules (cdr rules))))))
- (setq authors-checked-files-alist
- (cons (cons fullname valid) authors-checked-files-alist))
- (unless (or valid
- (member file authors-ignored-files)
- (authors-obsolete-file-p file)
- (string-match "[*]" file)
- (string-match "^[0-9.]+$" file))
- (setq authors-invalid-file-names
- (cons (format "%s:%d: unrecognized `%s' for %s"
- log-file
- (1+ (count-lines (point-min) pos))
- file author)
- authors-invalid-file-names)))
- valid)))
-
-(defun authors-add-fixed-entries (table)
- "Add actions from `authors-fixed-entries' to TABLE."
- (dolist (entry authors-fixed-entries)
- (let ((author (car entry))
- action)
- (dolist (item (cdr entry))
- (if (symbolp item)
- (setq action item)
- (authors-add author item action table))))))
-
-
-(defun authors-obsolete-file-p (file)
- "Return non-nil if FILE is obsolete.
-FILE is considered obsolete if it matches one of the regular expressions
-from `authors-obsolete-files-regexps'."
- (let (obsolete-p
- (regexps authors-obsolete-files-regexps))
- (while (and regexps (not obsolete-p))
- (setq obsolete-p (string-match (car regexps) file)
- regexps (cdr regexps)))
- obsolete-p))
-
-
-(defun authors-add (author file action table)
- "Record that AUTHOR worked on FILE.
-ACTION is a keyword symbol describing what he did. Record file,
-author and what he did in hash table TABLE. See the description of
-`authors-scan-change-log' for the structure of the hash table."
- (unless (or (member file authors-ignored-files)
- (authors-obsolete-file-p file)
- (equal author ""))
- (let* ((value (gethash author table))
- (entry (assoc file value))
- slot)
- (if (null entry)
- (puthash author (cons (list file (cons action 1)) value) table)
- (if (setq slot (assoc action (cdr entry)))
- (setcdr slot (1+ (cdr slot)))
- (nconc entry (list (cons action 1))))))))
-
-
-(defun authors-canonical-author-name (author)
- "Return a canonicalized form of AUTHOR, an author name.
-If AUTHOR has an entry in `authors-aliases', use that. Remove
-email addresses. Capitalize words in the author's name, unless
-it is found in `authors-fixed-case'."
- (let* ((aliases authors-aliases)
- regexps realname)
- (while aliases
- (setq realname (car (car aliases))
- regexps (cdr (car aliases))
- aliases (cdr aliases))
- (while regexps
- (if (string-match (car regexps) author)
- (setq author realname
- regexps nil
- aliases nil)
- (setq regexps (cdr regexps))))))
- (when author
- (setq author (replace-regexp-in-string "[ \t]*[(<].*$" "" author))
- (setq author (replace-regexp-in-string "\`[ \t]+" "" author))
- (setq author (replace-regexp-in-string "[ \t]+$" "" author))
- (setq author (replace-regexp-in-string "[ \t]+" " " author))
- (unless (string-match "[-, \t]" author)
- (setq author ""))
- (or (car (member author authors-fixed-case))
- (capitalize author))))
-
-(defun authors-scan-change-log (log-file table)
- "Scan change log LOG-FILE for author information.
-
-For each change mentioned in the log, add an entry to hash table TABLE
-under the author's canonical name.
-
-Keys of TABLE are author names. Values are alists of entries (FILE
-\(ACTION . COUNT) ...). FILE is one file the author worked on. The
-rest of the entry is a list of keyword symbols describing what he did
-with the file and the number of each action:
-
-:wrote means the author wrote the file
-:cowrote means he wrote the file in collaboration with others
-:changed means he changed the file COUNT times."
-
- (let* ((enable-local-variables :safe) ; for find-file, hence let*
- (enable-local-eval nil)
- (existing-buffer (get-file-buffer log-file))
- (buffer (find-file-noselect log-file))
- authors pos)
- (with-current-buffer buffer
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward "^[0-9]\\|^[ \t]+\\* " nil t)
- (beginning-of-line)
- (setq pos (point))
- (cond ((looking-at "^[0-9]+-[0-9]+-[0-9]+")
- ;; Handle joint authorship of changes.
- ;; This can be a bit fragile, and is not too common.
- (setq authors nil)
- (while (progn
- (skip-chars-forward " \t+:0-9-")
- (not (looking-at "\\($\\|\\*\\|\
-Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
- (push (authors-canonical-author-name
- (buffer-substring-no-properties
- (point) (line-end-position))) authors)
- (forward-line 1)))
- ((looking-at "^[ \t]+\\*")
- (let ((line (buffer-substring-no-properties
- (match-end 0) (line-end-position))))
- (while (and (not (string-match ":" line))
- (forward-line 1)
- (not (looking-at ":\\|^[ \t]*$")))
- (setq line (concat line
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))))
- (when (string-match ":" line)
- (setq line (substring line 0 (match-beginning 0)))
- (setq line (replace-regexp-in-string "[[(<{].*$" "" line))
- (setq line (replace-regexp-in-string "," "" line))
- (dolist (file (split-string line))
- (when (setq file (authors-canonical-file-name file log-file pos (car authors)))
- (dolist (author authors)
- ;;(message "%s changed %s" author file)
- (authors-add author file :changed table)))))
- (forward-line 1)))))))
- (unless existing-buffer
- (kill-buffer buffer))))
-
-
-(defun authors-scan-el (file table)
- "Scan Lisp file FILE for author information.
-TABLE is a hash table to add author information to."
- (let* ((existing-buffer (get-file-buffer file))
- (enable-local-variables :safe) ; for find-file, hence let*
- (enable-local-eval nil)
- (buffer (find-file-noselect file)))
- (setq file (authors-disambiguate-file-name (expand-file-name file)))
- (with-current-buffer buffer
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (and (re-search-forward
- "^;+[ \t]*\\(Authors?\\|Commentary\\|Code\\):[ \t]*" nil t)
- (not (member (match-string 1) '("Commentary" "Code"))))
- (let ((continue t)
- (action :wrote)
- authors)
- (while continue
- ;; Some entries contain a year range in front of the
- ;; author's name.
- (skip-chars-forward "-0-9 \t")
- (push (authors-canonical-author-name
- (buffer-substring-no-properties
- (point) (line-end-position))) authors)
- ;; tips.texi says the continuation line should begin
- ;; with a tab, but often spaces are used.
- (setq continue
- (and (zerop (forward-line 1))
- (looking-at ";;;?\\(\t+ *\\| +\\)[[:alnum:]]")
- (goto-char (1- (match-end 0)))
- (not (looking-at "[[:upper:]][-[:alpha:]]+:[ \t]")))))
- (and (> (length authors) 1)
- (setq action :cowrote))
- (mapc (lambda (author)
- (authors-add author file action table))
- authors)))))
- (unless existing-buffer
- (kill-buffer buffer))))
-
-
-(defun authors-public-domain-p (file)
- "Return t if FILE is a file that was put in public domain."
- (let ((public-domain-p nil)
- (list authors-public-domain-files))
- (while (and list (not public-domain-p))
- (when (string-match (car list) file)
- (setq public-domain-p t))
- (setq list (cdr list)))
- public-domain-p))
-
-(defvar authors-author-list)
-
-(defun authors-add-to-author-list (author changes)
- "Insert information about AUTHOR's work on Emacs into `authors-author-list'.
-CHANGES is an alist of entries (FILE (ACTION . COUNT) ...), as produced by
-`authors-scan-change-log'.
-The element added to `authors-author-list' is (AUTHOR WROTE CO-WROTE CHANGED),
-where WROTE, CO-WROTE, and CHANGED are lists of the files written, co-written
-and changed by AUTHOR."
- (when author
- (let ((nchanged 0)
- wrote-list
- cowrote-list
- changed-list)
- (dolist (change changes)
- (let* ((actions (cdr change))
- (file (car change))
- (filestat (if (authors-public-domain-p file)
- (concat file " (public domain)")
- file)))
- (cond ((assq :wrote actions)
- (setq wrote-list (cons filestat wrote-list)))
- ((assq :cowrote actions)
- (setq cowrote-list (cons filestat cowrote-list)))
- (t
- (setq changed-list
- (cons (cons file (cdr (assq :changed actions)))
- changed-list))))))
- (if wrote-list
- (setq wrote-list (sort wrote-list 'string-lessp)))
- (if cowrote-list
- (setq cowrote-list (sort cowrote-list 'string-lessp)))
- (when changed-list
- (setq changed-list (sort changed-list
- (lambda (a b)
- (if (= (cdr a) (cdr b))
- (string-lessp (car a) (car b))
- (> (cdr a) (cdr b))))))
- (setq nchanged (length changed-list))
- (setq changed-list (mapcar 'car changed-list)))
- (if (> (- nchanged authors-many-files) 2)
- (setcdr (nthcdr authors-many-files changed-list)
- (list (format "and %d other files" (- nchanged authors-many-files)))))
- (setq authors-author-list
- (cons (list author wrote-list cowrote-list changed-list)
- authors-author-list)))))
-
-(defun authors (root)
- "Extract author information from change logs and Lisp source files.
-ROOT is the root directory under which to find the files. If called
-interactively, ROOT is read from the minibuffer.
-Result is a buffer *Authors* containing authorship information, and a
-buffer *Authors Errors* containing references to unknown files."
- (interactive "DEmacs source directory: ")
- (setq root (expand-file-name root))
- (let ((logs (process-lines find-program root "-name" "ChangeLog*"))
- (table (make-hash-table :test 'equal))
- (buffer-name "*Authors*")
- authors-checked-files-alist
- authors-invalid-file-names)
- (authors-add-fixed-entries table)
- (unless (file-exists-p (expand-file-name "src/emacs.c" root))
- (unless (y-or-n-p
- (format "Not the root directory of Emacs: %s, continue? " root))
- (error "Not the root directory")))
- (dolist (log logs)
- (when (string-match "ChangeLog\\(.[0-9]+\\)?$" log)
- (message "Scanning %s..." log)
- (authors-scan-change-log log table)))
- (let ((els (process-lines find-program root "-name" "*.el")))
- (dolist (file els)
- (message "Scanning %s..." file)
- (authors-scan-el file table)))
- (message "Generating buffer %s..." buffer-name)
- (set-buffer (get-buffer-create buffer-name))
- (erase-buffer)
- (set-buffer-file-coding-system authors-coding-system)
- (insert
-"Many people have contributed code included in the Free Software
-Foundation's distribution of GNU Emacs. To show our appreciation for
-their public spirit, we list here in alphabetical order a condensed
-list of their contributions.\n")
- (let (authors-author-list a)
- (maphash #'authors-add-to-author-list table)
- (setq authors-author-list
- (sort authors-author-list
- (lambda (a b) (string-lessp (car a) (car b)))))
- (dolist (a authors-author-list)
- (let ((author (car a))
- (wrote (nth 1 a))
- (cowrote (nth 2 a))
- (changed (nth 3 a))
- file)
- (insert "\n" author ": ")
- (when wrote
- (insert "wrote")
- (dolist (file wrote)
- (if (> (+ (current-column) (length file)) 72)
- (insert "\n "))
- (insert " " file))
- (insert "\n"))
- (when cowrote
- (if wrote
- (insert "and "))
- (insert "co-wrote")
- (dolist (file cowrote)
- (if (> (+ (current-column) (length file)) 72)
- (insert "\n "))
- (insert " " file))
- (insert "\n"))
- (when changed
- (if (or wrote cowrote)
- (insert "and "))
- (insert "changed")
- (dolist (file changed)
- (if (> (+ (current-column) (length file)) 72)
- (insert "\n "))
- (insert " " file))
- (insert "\n")))))
- (insert "\nLocal" " Variables:\ncoding: "
- (symbol-name authors-coding-system) "\nEnd:\n")
- (message "Generating buffer %s... done" buffer-name)
- (unless noninteractive
- (when authors-invalid-file-names
- (with-current-buffer (get-buffer-create "*Authors Errors*")
- (setq buffer-read-only nil)
- (erase-buffer)
- (set-buffer-file-coding-system authors-coding-system)
- (insert "Unrecognized file entries found:\n\n")
- (mapc (lambda (f) (if (not (string-match "^[A-Za-z]+$" f)) (insert f "\n")))
- (sort authors-invalid-file-names 'string-lessp))
- (goto-char (point-min))
- (compilation-mode)
- (message "Errors were found. See buffer %s" (buffer-name))))
- (pop-to-buffer buffer-name))))
-
-
-(defun batch-update-authors ()
- "Produce an AUTHORS file.
-Call this function in batch mode with two command line arguments FILE
-and ROOT. FILE is the file to write, ROOT is the root directory of
-the Emacs source tree, from which to build the file."
- (unless noninteractive
- (error "`batch-update-authors' is to be used only with -batch"))
- (when (/= (length command-line-args-left) 2)
- (error "Call `batch-update-authors' with the name of the file to write"))
- (let* ((file (pop command-line-args-left))
- (root (pop command-line-args-left)))
- (authors root)
- (write-file file)))
-
-(provide 'authors)
-
-;;; authors.el ends here
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index e531bc0bdae..12d0a94127f 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,6 +1,6 @@
;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
-;; Copyright (C) 1991-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
@@ -32,7 +32,6 @@
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
-(require 'help-fns) ;for help-add-fundoc-usage.
(eval-when-compile (require 'cl-lib))
(defvar generated-autoload-file nil
@@ -120,7 +119,8 @@ expression, in which case we want to handle forms differently."
;; Look for an interactive spec.
(interactive (pcase body
((or `((interactive . ,_) . ,_)
- `(,_ (interactive . ,_) . ,_)) t))))
+ `(,_ (interactive . ,_) . ,_))
+ t))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
@@ -140,11 +140,9 @@ expression, in which case we want to handle forms differently."
;; For complex cases, try again on the macro-expansion.
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode defun defmacro
- ;; FIXME: we'd want `defmacro*' here as well, so as
- ;; to handle its `declare', but when autoload is run
- ;; CL is not loaded so macroexpand doesn't know how
- ;; to expand it!
- easy-mmode-define-minor-mode define-minor-mode))
+ easy-mmode-define-minor-mode define-minor-mode
+ define-inline cl-defun cl-defmacro))
+ (macrop car)
(setq expand (let ((load-file-name file)) (macroexpand form)))
(memq (car expand) '(progn prog1 defalias)))
(make-autoload expand file 'expansion)) ;Recurse on the expansion.
@@ -236,8 +234,9 @@ If a buffer is visiting the desired autoload file, return it."
(enable-local-eval nil))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
- (find-file-noselect
- (autoload-ensure-default-file (autoload-generated-file)))))
+ (let ((delay-mode-hooks t))
+ (find-file-noselect
+ (autoload-ensure-default-file (autoload-generated-file))))))
(defun autoload-generated-file ()
(expand-file-name generated-autoload-file
@@ -351,9 +350,26 @@ not be relied upon."
";;; " basename
" ends here\n")))
+(defvar autoload-ensure-writable nil
+ "Non-nil means `autoload-ensure-default-file' makes existing file writable.")
+;; Just in case someone tries to get you to overwrite a file that you
+;; don't want to.
+;;;###autoload
+(put 'autoload-ensure-writable 'risky-local-variable t)
+
(defun autoload-ensure-default-file (file)
- "Make sure that the autoload file FILE exists and if not create it."
- (unless (file-exists-p file)
+ "Make sure that the autoload file FILE exists, creating it if needed.
+If the file already exists and `autoload-ensure-writable' is non-nil,
+make it writable."
+ (if (file-exists-p file)
+ ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
+ ;; which was designed to handle CVSREAD=1 and equivalent.
+ (and autoload-ensure-writable
+ (let ((modes (file-modes file)))
+ (if (zerop (logand modes #o0200))
+ ;; Ignore any errors here, and let subsequent attempts
+ ;; to write the file raise any real error.
+ (ignore-errors (set-file-modes file (logior modes #o0200))))))
(write-region (autoload-rubric file) nil file))
file)
@@ -384,7 +400,7 @@ which lists the file name and which functions are in it, etc."
(erase-buffer)
(setq buffer-undo-list t
buffer-read-only nil)
- (emacs-lisp-mode)
+ (delay-mode-hooks (emacs-lisp-mode))
(setq default-directory (file-name-directory file))
(insert-file-contents file nil)
(let ((enable-local-variables :safe)
@@ -506,112 +522,132 @@ If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
different from OUTFILE, then OUTBUF is ignored.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
-\(or OUTBUF if OUTFILE is nil)."
- (catch 'done
- (let (load-name
- (print-length nil)
- (print-level nil)
- (print-readably t) ; This does something in Lucid Emacs.
- (float-output-format nil)
- (visited (get-file-buffer file))
- (otherbuf nil)
- (absfile (expand-file-name file))
- ;; nil until we found a cookie.
- output-start)
- (with-current-buffer (or visited
- ;; It is faster to avoid visiting the file.
- (autoload-find-file file))
- ;; Obey the no-update-autoloads file local variable.
- (unless no-update-autoloads
- (message "Generating autoloads for %s..." file)
- (setq load-name
- (if (stringp generated-autoload-load-name)
- generated-autoload-load-name
- (autoload-file-load-name absfile)))
- (when (and outfile
- (not
- (if (memq system-type '(ms-dos windows-nt))
- (equal (downcase outfile)
- (downcase (autoload-generated-file)))
- (equal outfile (autoload-generated-file)))))
- (setq otherbuf t))
- (save-excursion
- (save-restriction
- (widen)
- (when autoload-builtin-package-versions
- (let ((version (lm-header "version"))
- package)
- (and version
- (setq version (ignore-errors (version-to-list version)))
- (setq package (or (lm-header "package")
- (file-name-sans-extension
- (file-name-nondirectory file))))
- (setq output-start (autoload--setup-output
- otherbuf outbuf absfile load-name))
- (let ((standard-output (marker-buffer output-start))
- (print-quoted t))
- (princ `(push (purecopy
- ',(cons (intern package) version))
- package--builtin-versions))
- (newline)))))
-
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n\f")
- (cond
- ((looking-at (regexp-quote generate-autoload-cookie))
- ;; 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)))
- (autoload--print-cookie-text output-start load-name file))
- ((looking-at ";")
- ;; Don't read the comment.
- (forward-line 1))
- (t
- (forward-sexp 1)
- (forward-line 1))))))
-
- (when output-start
- (let ((secondary-autoloads-file-buf
- (if otherbuf (current-buffer))))
- (with-current-buffer (marker-buffer output-start)
- (save-excursion
- ;; Insert the section-header line which lists the file name
- ;; and which functions are in it, etc.
- (goto-char output-start)
- (let ((relfile (file-relative-name absfile)))
- (autoload-insert-section-header
- (marker-buffer output-start)
- () load-name relfile
- (if secondary-autoloads-file-buf
- ;; MD5 checksums are much better because they do not
- ;; change unless the file changes (so they'll be
- ;; equal on two different systems and will change
- ;; less often than time-stamps, thus leading to fewer
- ;; unneeded changes causing spurious conflicts), but
- ;; using time-stamps is a very useful optimization,
- ;; so we use time-stamps for the main autoloads file
- ;; (loaddefs.el) where we have special ways to
- ;; circumvent the "random change problem", and MD5
- ;; checksum in secondary autoload files where we do
- ;; not need the time-stamp optimization because it is
- ;; already provided by the primary autoloads file.
- (md5 secondary-autoloads-file-buf
- ;; We'd really want to just use
- ;; `emacs-internal' instead.
- nil nil 'emacs-mule-unix)
- (nth 5 (file-attributes relfile))))
- (insert ";;; Generated autoloads from " relfile "\n")))
- (insert generate-autoload-section-trailer))))
- (message "Generating autoloads for %s...done" file))
- (or visited
- ;; We created this buffer, so we should kill it.
- (kill-buffer (current-buffer))))
- (or (not output-start)
- ;; If the entries were added to some other buffer, then the file
- ;; doesn't add entries to OUTFILE.
- otherbuf))))
+\(or OUTBUF if OUTFILE is nil). The actual return value is
+FILE's modification time."
+ ;; Include the file name in any error messages
+ (condition-case err
+ (let (load-name
+ (print-length nil)
+ (print-level nil)
+ (print-readably t) ; This does something in Lucid Emacs.
+ (float-output-format nil)
+ (visited (get-file-buffer file))
+ (otherbuf nil)
+ (absfile (expand-file-name file))
+ ;; nil until we found a cookie.
+ output-start)
+ (when
+ (catch 'done
+ (with-current-buffer (or visited
+ ;; It is faster to avoid visiting the file.
+ (autoload-find-file file))
+ ;; Obey the no-update-autoloads file local variable.
+ (unless no-update-autoloads
+ (or noninteractive (message "Generating autoloads for %s..." file))
+ (setq load-name
+ (if (stringp generated-autoload-load-name)
+ generated-autoload-load-name
+ (autoload-file-load-name absfile)))
+ ;; 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
+ (if (memq system-type '(ms-dos windows-nt))
+ (equal (downcase outfile)
+ (downcase (autoload-generated-file)))
+ (equal outfile (autoload-generated-file)))))
+ (setq otherbuf t))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (when autoload-builtin-package-versions
+ (let ((version (lm-header "version"))
+ package)
+ (and version
+ (setq version (ignore-errors (version-to-list version)))
+ (setq package (or (lm-header "package")
+ (file-name-sans-extension
+ (file-name-nondirectory file))))
+ (setq output-start (autoload--setup-output
+ otherbuf outbuf absfile load-name))
+ (let ((standard-output (marker-buffer output-start))
+ (print-quoted t))
+ (princ `(push (purecopy
+ ',(cons (intern package) version))
+ package--builtin-versions))
+ (princ "\n")))))
+
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n\f")
+ (cond
+ ((looking-at (regexp-quote generate-autoload-cookie))
+ ;; 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)))
+ (autoload--print-cookie-text output-start load-name file))
+ ((looking-at ";")
+ ;; Don't read the comment.
+ (forward-line 1))
+ (t
+ (forward-sexp 1)
+ (forward-line 1))))))
+
+ (when output-start
+ (let ((secondary-autoloads-file-buf
+ (if otherbuf (current-buffer))))
+ (with-current-buffer (marker-buffer output-start)
+ (save-excursion
+ ;; Insert the section-header line which lists the file name
+ ;; and which functions are in it, etc.
+ (goto-char output-start)
+ (let ((relfile (file-relative-name absfile)))
+ (autoload-insert-section-header
+ (marker-buffer output-start)
+ () load-name relfile
+ (if secondary-autoloads-file-buf
+ ;; MD5 checksums are much better because they do not
+ ;; change unless the file changes (so they'll be
+ ;; equal on two different systems and will change
+ ;; less often than time-stamps, thus leading to fewer
+ ;; unneeded changes causing spurious conflicts), but
+ ;; using time-stamps is a very useful optimization,
+ ;; so we use time-stamps for the main autoloads file
+ ;; (loaddefs.el) where we have special ways to
+ ;; circumvent the "random change problem", and MD5
+ ;; checksum in secondary autoload files where we do
+ ;; not need the time-stamp optimization because it is
+ ;; already provided by the primary autoloads file.
+ (md5 secondary-autoloads-file-buf
+ ;; We'd really want to just use
+ ;; `emacs-internal' instead.
+ nil nil 'emacs-mule-unix)
+ (nth 5 (file-attributes relfile))))
+ (insert ";;; Generated autoloads from " relfile "\n")))
+ (insert generate-autoload-section-trailer))))
+ (or noninteractive
+ (message "Generating autoloads for %s...done" file)))
+ (or visited
+ ;; We created this buffer, so we should kill it.
+ (kill-buffer (current-buffer))))
+ (or (not output-start)
+ ;; If the entries were added to some other buffer, then the file
+ ;; doesn't add entries to OUTFILE.
+ otherbuf))
+ (nth 5 (file-attributes absfile))))
+ (error
+ ;; Probably unbalanced parens in forward-sexp. In that case, the
+ ;; condition is scan-error, and the signal data includes point
+ ;; where the error was found; we'd like to convert that to
+ ;; line:col, but line-number-at-pos gets the wrong line in batch
+ ;; mode for some reason.
+ ;;
+ ;; At least this gets the file name in the error message; the
+ ;; developer can use goto-char to get to the error position.
+ (error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
+ ))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
@@ -737,7 +773,7 @@ write its autoloads into the specified file instead."
t files-re))
dirs)))
(done ())
- (this-time (current-time))
+ (last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
@@ -762,14 +798,14 @@ write its autoloads into the specified file instead."
;; There shouldn't be more than one such entry.
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
- (let ((last-time (nth 4 form)))
- (dolist (file file)
- (let ((file-time (nth 5 (file-attributes file))))
- (when (and file-time
- (not (time-less-p last-time file-time)))
- ;; file unchanged
- (push file no-autoloads)
- (setq files (delete file files)))))))
+ (setq last-time (nth 4 form))
+ (dolist (file file)
+ (let ((file-time (nth 5 (file-attributes file))))
+ (when (and file-time
+ (not (time-less-p last-time file-time)))
+ ;; file unchanged
+ (push file no-autoloads)
+ (setq files (delete file files))))))
((not (stringp file)))
((or (not (file-exists-p file))
;; Remove duplicates as well, just in case.
@@ -791,24 +827,28 @@ write its autoloads into the specified file instead."
(push file done)
(setq files (delete file files)))))
;; Elements remaining in FILES have no existing autoload sections yet.
- (dolist (file files)
- (cond
- ((member (expand-file-name file) autoload-excludes) nil)
- ;; Passing nil as second argument forces
- ;; autoload-generate-file-autoloads to look for the right
- ;; spot where to insert each autoloads section.
- ((autoload-generate-file-autoloads file nil buffer-file-name)
- (push file no-autoloads))))
-
- (when no-autoloads
- ;; Sort them for better readability.
- (setq no-autoloads (sort no-autoloads 'string<))
- ;; Add the `no-autoloads' section.
- (goto-char (point-max))
- (search-backward "\f" nil t)
- (autoload-insert-section-header
- (current-buffer) nil nil no-autoloads this-time)
- (insert generate-autoload-section-trailer))
+ (let ((no-autoloads-time (or last-time '(0 0 0 0))) file-time)
+ (dolist (file files)
+ (cond
+ ((member (expand-file-name file) autoload-excludes) nil)
+ ;; Passing nil as second argument forces
+ ;; autoload-generate-file-autoloads to look for the right
+ ;; spot where to insert each autoloads section.
+ ((setq file-time
+ (autoload-generate-file-autoloads file nil buffer-file-name))
+ (push file no-autoloads)
+ (if (time-less-p no-autoloads-time file-time)
+ (setq no-autoloads-time file-time)))))
+
+ (when no-autoloads
+ ;; Sort them for better readability.
+ (setq no-autoloads (sort no-autoloads 'string<))
+ ;; Add the `no-autoloads' section.
+ (goto-char (point-max))
+ (search-backward "\f" nil t)
+ (autoload-insert-section-header
+ (current-buffer) nil nil no-autoloads no-autoloads-time)
+ (insert generate-autoload-section-trailer)))
(let ((version-control 'never))
(save-buffer))
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 4481bc9ae61..99a329b021e 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,12 +1,12 @@
-;;; avl-tree.el --- balanced binary trees, AVL-trees
+;;; avl-tree.el --- balanced binary trees, AVL-trees -*- lexical-binding:t -*-
-;; Copyright (C) 1995, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2007-2015 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
;; Thomas Bellman <bellman@lysator.liu.se>
;; Toby Cubitt <toby-predictive@dr-qubit.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 10 May 1991
;; Keywords: extensions, data structures, AVL, tree
@@ -27,23 +27,23 @@
;;; Commentary:
-;; An AVL tree is a self-balancing binary tree. As such, inserting,
+;; An AVL tree is a self-balancing binary tree. As such, inserting,
;; deleting, and retrieving data from an AVL tree containing n elements
-;; is O(log n). It is somewhat more rigidly balanced than other
+;; is O(log n). It is somewhat more rigidly balanced than other
;; self-balancing binary trees (such as red-black trees and AA trees),
;; making insertion slightly slower, deletion somewhat slower, and
;; retrieval somewhat faster (the asymptotic scaling is of course the
-;; same for all types). Thus it may be a good choice when the tree will
+;; same for all types). Thus it may be a good choice when the tree will
;; be relatively static, i.e. data will be retrieved more often than
;; they are modified.
;;
;; Internally, a tree consists of two elements, the root node and the
-;; comparison function. The actual tree has a dummy node as its root
+;; comparison function. The actual tree has a dummy node as its root
;; with the real root in the left pointer, which allows the root node to
;; be treated on a par with all other nodes.
;;
;; Each node of the tree consists of one data element, one left
-;; sub-tree, one right sub-tree, and a balance count. The latter is the
+;; sub-tree, one right sub-tree, and a balance count. The latter is the
;; difference in depth of the left and right sub-trees.
;;
;; The functions with names of the form "avl-tree--" are intended for
@@ -51,7 +51,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
@@ -62,7 +62,7 @@
;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree.
-(defstruct (avl-tree-
+(cl-defstruct (avl-tree-
;; A tagged list is the pre-defstruct representation.
;; (:type list)
:named
@@ -77,15 +77,10 @@
;; Return the root node for an AVL tree. INTERNAL USE ONLY.
`(avl-tree--node-left (avl-tree--dummyroot ,tree)))
-(defsetf avl-tree--root (tree) (node)
- `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
-
-
-
;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree node.
-(defstruct (avl-tree--node
+(cl-defstruct (avl-tree--node
;; We force a representation without tag so it matches the
;; pre-defstruct representation. Also we use the underlying
;; representation in the implementation of
@@ -97,7 +92,7 @@
left right data balance)
-(defalias 'avl-tree--node-branch 'aref
+(defalias 'avl-tree--node-branch #'aref
;; This implementation is efficient but breaks the defstruct
;; abstraction. An alternative could be (funcall (aref [avl-tree-left
;; avl-tree-right avl-tree-data] branch) node)
@@ -109,7 +104,7 @@ NODE is the node, and BRANCH is the branch.
;; The funcall/aref trick wouldn't work for the setf method, unless we
;; tried to access the underlying setter function, but this wouldn't be
;; portable either.
-(defsetf avl-tree--node-branch aset)
+(gv-define-simple-setter avl-tree--node-branch aset)
@@ -297,7 +292,8 @@ Return t if the height of the tree has grown."
(if (< (* sgn b2) 0) sgn 0)
(avl-tree--node-branch node branch) p2))
(setf (avl-tree--node-balance
- (avl-tree--node-branch node branch)) 0)
+ (avl-tree--node-branch node branch))
+ 0)
nil))))
(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
@@ -346,7 +342,7 @@ inserted data."
(if (null node) 0
(let ((dl (avl-tree--check-node (avl-tree--node-left node)))
(dr (avl-tree--check-node (avl-tree--node-right node))))
- (assert (= (- dr dl) (avl-tree--node-balance node)))
+ (cl-assert (= (- dr dl) (avl-tree--node-balance node)))
(1+ (max dl dr)))))
;; ----------------------------------------------------------------
@@ -391,7 +387,7 @@ itself."
(avl-tree--node-data root)
(avl-tree--node-balance root))))
-(defstruct (avl-tree--stack
+(cl-defstruct (avl-tree--stack
(:constructor nil)
(:constructor avl-tree--stack-create
(tree &optional reverse
@@ -403,7 +399,7 @@ itself."
(:copier nil))
reverse store)
-(defalias 'avl-tree-stack-p 'avl-tree--stack-p
+(defalias 'avl-tree-stack-p #'avl-tree--stack-p
"Return t if argument is an avl-tree-stack, nil otherwise.")
(defun avl-tree--stack-repopulate (stack)
@@ -420,12 +416,12 @@ itself."
;;; The public functions which operate on AVL trees.
;; define public alias for constructors so that we can set docstring
-(defalias 'avl-tree-create 'avl-tree--create
+(defalias 'avl-tree-create #'avl-tree--create
"Create an empty AVL tree.
COMPARE-FUNCTION is a function which takes two arguments, A and B,
and returns non-nil if A is less than B, and nil otherwise.")
-(defalias 'avl-tree-compare-function 'avl-tree--cmpfun
+(defalias 'avl-tree-compare-function #'avl-tree--cmpfun
"Return the comparison function for the AVL tree TREE.
\(fn TREE)")
@@ -505,7 +501,7 @@ previously specified in `avl-tree-create' when TREE was created."
(not (eq (avl-tree-member tree data flag) flag))))
-(defun avl-tree-map (__map-function__ tree &optional reverse)
+(defun avl-tree-map (fun tree &optional reverse)
"Modify all elements in the AVL tree TREE by applying FUNCTION.
Each element is replaced by the return value of FUNCTION applied
@@ -516,12 +512,12 @@ descending order if REVERSE is non-nil."
(avl-tree--mapc
(lambda (node)
(setf (avl-tree--node-data node)
- (funcall __map-function__ (avl-tree--node-data node))))
+ (funcall fun (avl-tree--node-data node))))
(avl-tree--root tree)
(if reverse 1 0)))
-(defun avl-tree-mapc (__map-function__ tree &optional reverse)
+(defun avl-tree-mapc (fun tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE,
for side-effect only.
@@ -529,13 +525,13 @@ FUNCTION is applied to the elements in ascending order, or
descending order if REVERSE is non-nil."
(avl-tree--mapc
(lambda (node)
- (funcall __map-function__ (avl-tree--node-data node)))
+ (funcall fun (avl-tree--node-data node)))
(avl-tree--root tree)
(if reverse 1 0)))
(defun avl-tree-mapf
- (__map-function__ combinator tree &optional reverse)
+ (fun combinator tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE,
and combine the results using COMBINATOR.
@@ -546,7 +542,7 @@ order, or descending order if REVERSE is non-nil."
(lambda (node)
(setq avl-tree-mapf--accumulate
(funcall combinator
- (funcall __map-function__
+ (funcall fun
(avl-tree--node-data node))
avl-tree-mapf--accumulate)))
(avl-tree--root tree)
@@ -554,7 +550,7 @@ order, or descending order if REVERSE is non-nil."
(nreverse avl-tree-mapf--accumulate)))
-(defun avl-tree-mapcar (__map-function__ tree &optional reverse)
+(defun avl-tree-mapcar (fun tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE,
and make a list of the results.
@@ -568,7 +564,7 @@ then
(avl-tree-mapf function 'cons tree (not reverse))
is more efficient."
- (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse)))
+ (nreverse (avl-tree-mapf fun 'cons tree reverse)))
(defun avl-tree-first (tree)
@@ -605,7 +601,7 @@ is more efficient."
"Return the number of elements in TREE."
(let ((treesize 0))
(avl-tree--mapc
- (lambda (data) (setq treesize (1+ treesize)))
+ (lambda (_) (setq treesize (1+ treesize)))
(avl-tree--root tree) 0)
treesize))
@@ -619,7 +615,7 @@ is more efficient."
of all elements of TREE.
If REVERSE is non-nil, the stack is sorted in reverse order.
-\(See also `avl-tree-stack-pop'\).
+\(See also `avl-tree-stack-pop').
Note that any modification to TREE *immediately* invalidates all
avl-tree-stacks created before the modification (in particular,
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 2dc84e9ddfb..dc61e156130 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -1,10 +1,10 @@
;;; backquote.el --- implement the ` Lisp construct
-;; Copyright (C) 1990, 1992, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1990, 1992, 1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Rick Sladkey <jrs@world.std.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, internal
;; Package: emacs
@@ -99,9 +99,9 @@ places where expressions are evaluated and inserted or spliced in.
For example:
b => (ba bb bc) ; assume b has this value
-`(a b c) => (a b c) ; backquote acts like quote
-`(a ,b c) => (a (ba bb bc) c) ; insert the value of b
-`(a ,@b c) => (a ba bb bc c) ; splice in the value of b
+\\=`(a b c) => (a b c) ; backquote acts like quote
+\\=`(a ,b c) => (a (ba bb bc) c) ; insert the value of b
+\\=`(a ,@b c) => (a ba bb bc c) ; splice in the value of b
Vectors work just like lists. Nested backquotes are permitted."
(cdr (backquote-process structure)))
@@ -120,9 +120,7 @@ Vectors work just like lists. Nested backquotes are permitted."
This simply recurses through the body."
(let ((exp (backquote-listify (list (cons 0 (list 'quote (car s))))
(backquote-process (cdr s) level))))
- (if (eq (car-safe exp) 'quote)
- (cons 0 (list 'quote s))
- (cons 1 exp))))
+ (cons (if (eq (car-safe exp) 'quote) 0 1) exp)))
(defun backquote-process (s &optional level)
"Process the body of a backquote.
@@ -148,16 +146,26 @@ LEVEL is only used internally and indicates the nesting level:
(t
(list 'apply '(function vector) (cdr n))))))))
((atom s)
+ ;; FIXME: Use macroexp-quote!
(cons 0 (if (or (null s) (eq s t) (not (symbolp s)))
s
(list 'quote s))))
((eq (car s) backquote-unquote-symbol)
(if (<= level 0)
- (cons 1 (nth 1 s))
+ (cond
+ ((> (length s) 2)
+ ;; We could support it with: (cons 2 `(list . ,(cdr s)))
+ ;; But let's not encourage such uses.
+ (error "Multiple args to , are not supported: %S" s))
+ (t (cons (if (eq (car-safe (nth 1 s)) 'quote) 0 1)
+ (nth 1 s))))
(backquote-delay-process s (1- level))))
((eq (car s) backquote-splice-symbol)
(if (<= level 0)
- (cons 2 (nth 1 s))
+ (if (> (length s) 2)
+ ;; (cons 2 `(append . ,(cdr s)))
+ (error "Multiple args to ,@ are not supported: %S" s)
+ (cons 2 (nth 1 s)))
(backquote-delay-process s (1- level))))
((eq (car s) backquote-backquote-symbol)
(backquote-delay-process s (1+ level)))
@@ -208,9 +216,7 @@ LEVEL is only used internally and indicates the nesting level:
;; Tack on any initial elements.
(if firstlist
(setq expression (backquote-listify firstlist (cons 1 expression))))
- (if (eq (car-safe expression) 'quote)
- (cons 0 (list 'quote s))
- (cons 1 expression))))))
+ (cons (if (eq (car-safe expression) 'quote) 0 1) expression)))))
;; backquote-listify takes (tag . structure) pairs from backquote-process
;; and decides between append, list, backquote-list*, and cons depending
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index c97b33f4e7d..dc1b44e3164 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -1,6 +1,6 @@
;;; benchmark.el --- support for benchmarking code
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: lisp, extensions
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 86d72fef9b5..2aa636e4e82 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,6 +1,6 @@
;;; bindat.el --- binary data structure packing and unpacking.
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 7214501362d..c3c61d6c81e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,10 +1,10 @@
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
-;; Copyright (C) 1991, 1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -192,7 +192,7 @@
;; (if (aref byte-code-vector 0)
;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
(byte-compile-log-1
- (apply 'format format
+ (apply #'format-message format
(let (c a)
(mapcar (lambda (arg)
(if (not (consp arg))
@@ -248,10 +248,10 @@
(defun byte-compile-inline-expand (form)
(let* ((name (car form))
(localfn (cdr (assq name byte-compile-function-environment)))
- (fn (or localfn (and (fboundp name) (symbol-function name)))))
+ (fn (or localfn (symbol-function name))))
(when (autoloadp fn)
(autoload-do-load fn)
- (setq fn (or (and (fboundp name) (symbol-function name))
+ (setq fn (or (symbol-function name)
(cdr (assq name byte-compile-function-environment)))))
(pcase fn
(`nil
@@ -292,7 +292,7 @@
(format "Inlining closure %S failed" name))
form))))
- (t ;; Give up on inlining.
+ (_ ;; Give up on inlining.
form))))
;; ((lambda ...) ...)
@@ -302,65 +302,65 @@
;; doesn't matter here, because function's behavior is underspecified so it
;; can safely be turned into a `let', even though the reverse is not true.
(or name (setq name "anonymous lambda"))
- (let ((lambda (car form))
- (values (cdr form)))
- (let ((arglist (nth 1 lambda))
- (body (cdr (cdr lambda)))
- optionalp restp
- bindings)
- (if (and (stringp (car body)) (cdr body))
- (setq body (cdr body)))
- (if (and (consp (car body)) (eq 'interactive (car (car body))))
- (setq body (cdr body)))
- ;; FIXME: The checks below do not belong in an optimization phase.
- (while arglist
- (cond ((eq (car arglist) '&optional)
- ;; ok, I'll let this slide because funcall_lambda() does...
- ;; (if optionalp (error "multiple &optional keywords in %s" name))
- (if restp (error "&optional found after &rest in %s" name))
- (if (null (cdr arglist))
- (error "nothing after &optional in %s" name))
- (setq optionalp t))
- ((eq (car arglist) '&rest)
- ;; ...but it is by no stretch of the imagination a reasonable
- ;; thing that funcall_lambda() allows (&rest x y) and
- ;; (&rest x &optional y) in arglists.
- (if (null (cdr arglist))
- (error "nothing after &rest in %s" name))
- (if (cdr (cdr arglist))
- (error "multiple vars after &rest in %s" name))
- (setq restp t))
- (restp
- (setq bindings (cons (list (car arglist)
- (and values (cons 'list values)))
- bindings)
- values nil))
- ((and (not optionalp) (null values))
- (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
- (setq arglist nil values 'too-few))
- (t
- (setq bindings (cons (list (car arglist) (car values))
- bindings)
- values (cdr values))))
- (setq arglist (cdr arglist)))
- (if values
- (progn
- (or (eq values 'too-few)
- (byte-compile-warn
- "attempt to open-code `%s' with too many arguments" name))
- form)
-
- ;; The following leads to infinite recursion when loading a
- ;; file containing `(defsubst f () (f))', and then trying to
- ;; byte-compile that file.
- ;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
- (if bindings
- (cons 'let (cons (nreverse bindings) body))
- (cons 'progn body))))
- (byte-compile-log " %s\t==>\t%s" form newform)
- newform)))))
+ (let* ((lambda (car form))
+ (values (cdr form))
+ (arglist (nth 1 lambda))
+ (body (cdr (cdr lambda)))
+ optionalp restp
+ bindings)
+ (if (and (stringp (car body)) (cdr body))
+ (setq body (cdr body)))
+ (if (and (consp (car body)) (eq 'interactive (car (car body))))
+ (setq body (cdr body)))
+ ;; FIXME: The checks below do not belong in an optimization phase.
+ (while arglist
+ (cond ((eq (car arglist) '&optional)
+ ;; ok, I'll let this slide because funcall_lambda() does...
+ ;; (if optionalp (error "multiple &optional keywords in %s" name))
+ (if restp (error "&optional found after &rest in %s" name))
+ (if (null (cdr arglist))
+ (error "nothing after &optional in %s" name))
+ (setq optionalp t))
+ ((eq (car arglist) '&rest)
+ ;; ...but it is by no stretch of the imagination a reasonable
+ ;; thing that funcall_lambda() allows (&rest x y) and
+ ;; (&rest x &optional y) in arglists.
+ (if (null (cdr arglist))
+ (error "nothing after &rest in %s" name))
+ (if (cdr (cdr arglist))
+ (error "multiple vars after &rest in %s" name))
+ (setq restp t))
+ (restp
+ (setq bindings (cons (list (car arglist)
+ (and values (cons 'list values)))
+ bindings)
+ values nil))
+ ((and (not optionalp) (null values))
+ (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
+ (setq arglist nil values 'too-few))
+ (t
+ (setq bindings (cons (list (car arglist) (car values))
+ bindings)
+ values (cdr values))))
+ (setq arglist (cdr arglist)))
+ (if values
+ (progn
+ (or (eq values 'too-few)
+ (byte-compile-warn
+ "attempt to open-code `%s' with too many arguments" name))
+ form)
+
+ ;; The following leads to infinite recursion when loading a
+ ;; file containing `(defsubst f () (f))', and then trying to
+ ;; byte-compile that file.
+ ;(setq body (mapcar 'byte-optimize-form body)))
+
+ (let ((newform
+ (if bindings
+ (cons 'let (cons (nreverse bindings) body))
+ (cons 'progn body))))
+ (byte-compile-log " %s\t==>\t%s" form newform)
+ newform))))
;;; implementing source-level optimizers
@@ -390,12 +390,13 @@
(and (nth 1 form)
(not for-effect)
form))
- ((eq 'lambda (car-safe fn))
+ ((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
@@ -488,11 +489,22 @@
(prin1-to-string form))
nil)
- ((memq fn '(function condition-case))
- ;; These forms are compiled as constants or by breaking out
+ ((eq fn 'function)
+ ;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
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)))))
+
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
;; optimized) as a top-level form, so don't do it here. But the
@@ -504,13 +516,14 @@
(cdr (cdr form)))))
((eq fn 'catch)
- ;; the body of a catch is compiled (and thus optimized) as a
- ;; top-level form, so don't do it here. The tag is never
- ;; for-effect. The body should have the same for-effect status
- ;; as the catch form itself, but that isn't handled properly yet.
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
- (cdr (cdr form)))))
+ (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)))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
@@ -533,18 +546,6 @@
((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors
(eq tmp 'error-free)
- ;; Detect the expansion of (pop foo).
- ;; There is no need to compile the call to `car' there.
- (and (eq fn 'car)
- (eq (car-safe (cadr form)) 'prog1)
- (let ((var (cadr (cadr form)))
- (last (nth 2 (cadr form))))
- (and (symbolp var)
- (null (nthcdr 3 (cadr form)))
- (eq (car-safe last) 'setq)
- (eq (cadr last) var)
- (eq (car-safe (nth 2 last)) 'cdr)
- (eq (cadr (nth 2 last)) var))))
(progn
(byte-compile-warn "value returned from %s is unused"
(prin1-to-string form))
@@ -565,7 +566,7 @@
(cons fn args)))))))
(defun byte-optimize-all-constp (list)
- "Non-nil if all elements of LIST satisfy `macroexp-const-p"
+ "Non-nil if all elements of LIST satisfy `macroexp-const-p'."
(let ((constant t))
(while (and list constant)
(unless (macroexp-const-p (car list))
@@ -859,14 +860,16 @@
(defun byte-optimize-binary-predicate (form)
- (if (macroexp-const-p (nth 1 form))
- (if (macroexp-const-p (nth 2 form))
- (condition-case ()
- (list 'quote (eval form))
- (error form))
- ;; This can enable some lapcode optimizations.
- (list (car form) (nth 2 form) (nth 1 form)))
- form))
+ (cond
+ ((or (not (macroexp-const-p (nth 1 form)))
+ (nthcdr 3 form)) ;; In case there are more than 2 args.
+ form)
+ ((macroexp-const-p (nth 2 form))
+ (condition-case ()
+ (list 'quote (eval form))
+ (error form)))
+ (t ;; This can enable some lapcode optimizations.
+ (list (car form) (nth 2 form) (nth 1 form)))))
(defun byte-optimize-predicate (form)
(let ((ok t)
@@ -942,15 +945,6 @@
form
(nth 1 form)))
-(defun byte-optimize-zerop (form)
- (cond ((numberp (nth 1 form))
- (eval form))
- (byte-compile-delete-errors
- (list '= (nth 1 form) 0))
- (form)))
-
-(put 'zerop 'byte-optimizer 'byte-optimize-zerop)
-
(defun byte-optimize-and (form)
;; Simplify if less than 2 args.
;; if there is a literal nil in the args to `and', throw it and following
@@ -1231,7 +1225,7 @@
window-left-child window-left-column window-margins window-minibuffer-p
window-next-buffers window-next-sibling window-new-normal
window-new-total window-normal-size window-parameter window-parameters
- window-parent window-pixel-edges window-point window-prev-buffers
+ window-parent window-pixel-edges window-point window-prev-buffers
window-prev-sibling window-redisplay-end-trigger window-scroll-bars
window-start window-text-height window-top-child window-top-line
window-total-height window-total-width window-use-time window-vscroll
@@ -1304,7 +1298,7 @@
"Don't call this!"
;; Fetch and return the offset for the current opcode.
;; Return nil if this opcode has no offset.
- (cond ((< bytedecomp-op byte-nth)
+ (cond ((< bytedecomp-op byte-pophandler)
(let ((tem (logand bytedecomp-op 7)))
(setq bytedecomp-op (logand bytedecomp-op 248))
(cond ((eq tem 6)
@@ -1323,7 +1317,9 @@
(setq bytedecomp-op byte-constant)))
((or (and (>= bytedecomp-op byte-constant2)
(<= bytedecomp-op byte-goto-if-not-nil-else-pop))
- (= bytedecomp-op byte-stack-set2))
+ (memq bytedecomp-op (eval-when-compile
+ (list byte-stack-set2 byte-pushcatch
+ byte-pushconditioncase))))
;; Offset in next 2 bytes.
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
(+ (aref bytes bytedecomp-ptr)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 0bb04950dfd..73c2977e8eb 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -1,10 +1,10 @@
;;; byte-run.el --- byte-compiler support for inlining -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -30,6 +30,18 @@
;;; Code:
+(defalias 'function-put
+ ;; We don't want people to just use `put' because we can't conveniently
+ ;; hook into `put' to remap old properties to new ones. But for now, there's
+ ;; no such remapping, so we just call `put'.
+ #'(lambda (function prop value)
+ "Set FUNCTION's property PROP to VALUE.
+The namespace for PROP is shared with symbols.
+So far, FUNCTION can only be a symbol, not a lambda expression."
+ (put function prop value)))
+(function-put 'defmacro 'doc-string-elt 3)
+(function-put 'defmacro 'lisp-indent-function 2)
+
;; `macro-declaration-function' are both obsolete (as marked at the end of this
;; file) but used in many .elc files.
@@ -69,6 +81,7 @@ The return value of this function is not used."
;; handle declarations in macro definitions and this is the first file
;; loaded by loadup.el that uses declarations in macros.
+;; 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
@@ -81,43 +94,77 @@ The return value of this function is not used."
#'(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))))
+ ;; FIXME: Merge `pure' and `side-effect-free'.
+ (list 'pure
+ #'(lambda (f _args val)
+ (list 'function-put (list 'quote f)
+ ''pure (list 'quote val)))
+ "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)))
+ "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)
- `(eval-and-compile
- (put ',f 'compiler-macro
- ,(if (eq (car-safe compiler-function) 'lambda)
- `(lambda ,(append (cadr compiler-function) args)
- ,@(cddr compiler-function))
- `#',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"))))
+ `(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 (,@(cadr compiler-function) ,@args)
+ ,@(cddr compiler-function))))))))
(list 'doc-string
#'(lambda (f _args pos)
- (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
+ (list 'function-put (list 'quote f)
+ ''doc-string-elt (list 'quote pos))))
(list 'indent
#'(lambda (f _args val)
- (list 'put (list 'quote f)
+ (list 'function-put (list 'quote f)
''lisp-indent-function (list 'quote val)))))
"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,
the FUN corresponding to PROP is called with the function name,
the function's arglist, and the VALUES and should return the code to use
-to set this property.")
+to set this property.
+
+This is used by `declare'.")
(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)))))
- defun-declarations-alist)
+ #'(lambda (name _args spec)
+ (list 'progn :autoload-end
+ (list 'put (list 'quote name)
+ ''edebug-form-spec (list 'quote spec)))))
+ (cons
+ (list 'no-font-lock-keyword
+ #'(lambda (name _args val)
+ (list 'function-put (list 'quote name)
+ ''no-font-lock-keyword (list 'quote val))))
+ 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. For each (PROP . VALUES) in a macro's declaration,
-the FUN corresponding to PROP is called with the function name
-and the VALUES and should return the code to use to set this property.")
+Each element of the list takes the form (PROP FUN) where FUN is a function.
+For each (PROP . VALUES) in a macro's declaration, the FUN corresponding
+to PROP is called with the macro name, the macro's arglist, and the VALUES
+and should return the code to use to set this property.
+
+This is used by `declare'.")
-(put 'defmacro 'doc-string-elt 3)
(defalias 'defmacro
(cons
'macro
@@ -159,6 +206,19 @@ The return value is undefined.
(message "Warning: Unknown macro property %S in %S"
(car x) name))))
decls)))
+ ;; Refresh font-lock if this is a new macro, or it is an
+ ;; existing macro whose 'no-font-lock-keyword declaration
+ ;; has changed.
+ (if (and
+ ;; If lisp-mode hasn't been loaded, there's no reason
+ ;; to flush.
+ (fboundp 'lisp--el-font-lock-flush-elisp-buffers)
+ (or (not (fboundp name)) ;; new macro
+ (and (fboundp name) ;; existing macro
+ (member `(function-put ',name 'no-font-lock-keyword
+ ',(get name 'no-font-lock-keyword))
+ declarations))))
+ (lisp--el-font-lock-flush-elisp-buffers))
(if declarations
(cons 'prog1 (cons def declarations))
def))))))
@@ -179,7 +239,7 @@ The return value is undefined.
;; (defun foo (arg) (toto) nil)
;; from
;; (defun foo (arg) (toto)).
- (declare (doc-string 3))
+ (declare (doc-string 3) (indent 2))
(let ((decls (cond
((eq (car-safe docstring) 'declare)
(prog1 (cdr docstring) (setq docstring nil)))
@@ -217,7 +277,8 @@ The return value is undefined.
(cons arglist body))))))
(if declarations
(cons 'prog1 (cons def declarations))
- def))))
+ def))))
+
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
@@ -284,7 +345,6 @@ was first made obsolete, for example a date or a release number."
(declare (advertised-calling-convention
;; New code should always provide the `when' argument.
(obsolete-name current-name when) "23.1"))
- (interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
@@ -295,12 +355,12 @@ was first made obsolete, for example a date or a release number."
&optional when docstring)
"Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
-\(define-obsolete-function-alias 'old-fun 'new-fun \"22.1\" \"old-fun's doc.\")
+\(define-obsolete-function-alias \\='old-fun \\='new-fun \"22.1\" \"old-fun's doc.\")
is equivalent to the following two lines of code:
-\(defalias 'old-fun 'new-fun \"old-fun's doc.\")
-\(make-obsolete 'old-fun 'new-fun \"22.1\")
+\(defalias \\='old-fun \\='new-fun \"old-fun's doc.\")
+\(make-obsolete \\='old-fun \\='new-fun \"22.1\")
See the docstrings of `defalias' and `make-obsolete' for more details."
(declare (doc-string 4)
@@ -333,7 +393,7 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger
This uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
-If CURRENT-NAME is a defcustom (more generally, any variable
+If CURRENT-NAME is a defcustom or a defvar (more generally, any variable
where OBSOLETE-NAME may be set, e.g. in an init file, before the
alias is defined), then the define-obsolete-variable-alias
statement should be evaluated before the defcustom, if user
@@ -347,7 +407,7 @@ variable (this is due to the way `defvaralias' works).
For the benefit of `custom-set-variables', if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:
-'saved-value, 'saved-variable-comment."
+`saved-value', `saved-variable-comment'."
(declare (doc-string 4)
(advertised-calling-convention
;; New code should always provide the `when' argument.
@@ -389,13 +449,20 @@ If you think you need this, you're probably making a mistake somewhere."
(defmacro eval-when-compile (&rest body)
"Like `progn', but evaluates the body at compile time if you're compiling.
-Thus, the result of the body appears to the compiler as a quoted constant.
-In interpreted code, this is entirely equivalent to `progn'."
- (declare (debug t) (indent 0))
+Thus, the result of the body appears to the compiler as a quoted
+constant. In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."
+ (declare (debug (&rest def-form)) (indent 0))
(list 'quote (eval (cons 'progn body) lexical-binding)))
(defmacro eval-and-compile (&rest body)
- "Like `progn', but evaluates the body at compile time and at load time."
+ "Like `progn', but evaluates the body at compile time and at
+load time. In interpreted code, this is entirely equivalent to
+`progn', except that the value of the expression may be (but is
+not necessarily) computed at load time if eager macro expansion
+is enabled."
(declare (debug t) (indent 0))
;; When the byte-compiler expands code, this macro is not used, so we're
;; either about to run `body' (plain interpretation) or we're doing eager
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c6612024fa6..db200f3c504 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,11 +1,11 @@
;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp
;; Package: emacs
@@ -31,6 +31,10 @@
;; faster. [`LAP' == `Lisp Assembly Program'.]
;; The user entry points are byte-compile-file and byte-recompile-directory.
+;;; Todo:
+
+;; - Turn "not bound at runtime" functions into autoloads.
+
;;; Code:
;; ========================================================================
@@ -120,7 +124,11 @@
(require 'backquote)
(require 'macroexp)
(require 'cconv)
-(eval-when-compile (require 'cl-lib))
+
+;; During bootstrap, cl-loaddefs.el is not created yet, so loading cl-lib
+;; doesn't setup autoloads for things like cl-every, which is why we have to
+;; require cl-extra instead (bug#18804).
+(require 'cl-extra)
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
@@ -340,7 +348,7 @@ else the global value will be modified."
;;;###autoload
(defun byte-compile-enable-warning (warning)
"Change `byte-compile-warnings' to enable WARNING.
-If `byte-compile-warnings' is `t', do nothing. Otherwise, if the
+If `byte-compile-warnings' is t, do nothing. Otherwise, if the
first element is `not', remove WARNING, else add it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified."
@@ -353,11 +361,11 @@ else the global value will be modified."
(t
(append byte-compile-warnings (list warning)))))))
-(defvar byte-compile-interactive-only-functions
- '(beginning-of-buffer end-of-buffer replace-string replace-regexp
- insert-file insert-buffer insert-file-literally previous-line next-line
- goto-line comint-run delete-backward-char)
+(defvar byte-compile-interactive-only-functions nil
"List of commands that are not meant to be called from Lisp.")
+(make-obsolete-variable 'byte-compile-interactive-only-functions
+ "use the `interactive-only' symbol property instead."
+ "24.4")
(defvar byte-compile-not-obsolete-vars nil
"List of variables that shouldn't be reported as obsolete.")
@@ -389,7 +397,7 @@ invoked interactively are excluded from this list."
"Alist of functions and their call tree.
Each element looks like
- \(FUNCTION CALLERS CALLS\)
+ (FUNCTION CALLERS CALLS)
where CALLERS is a list of functions that call FUNCTION, and CALLS
is a list of functions for which calls were generated while compiling
@@ -413,7 +421,7 @@ specify different fields to sort on."
This list lives partly on the stack.")
(defvar byte-compile-lexical-variables nil
"List of variables that have been treated as lexical.
-Filled in `cconv-analyse-form' but initialized and consulted here.")
+Filled in `cconv-analyze-form' but initialized and consulted here.")
(defvar byte-compile-const-variables nil
"List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references)
@@ -421,31 +429,51 @@ Filled in `cconv-analyse-form' but initialized and consulted here.")
(defvar byte-compiler-error-flag)
+(defun byte-compile-recurse-toplevel (form non-toplevel-case)
+ "Implement `eval-when-compile' and `eval-and-compile'.
+Return the compile-time value of FORM."
+ ;; Macroexpand (not macroexpand-all!) form at toplevel in case it
+ ;; expands into a toplevel-equivalent `progn'. See CLHS section
+ ;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very
+ ;; subtle: see test/automated/bytecomp-tests.el for interesting
+ ;; cases.
+ (setf form (macroexp-macroexpand form byte-compile-macro-environment))
+ (if (eq (car-safe form) 'progn)
+ (cons 'progn
+ (mapcar (lambda (subform)
+ (byte-compile-recurse-toplevel
+ subform non-toplevel-case))
+ (cdr form)))
+ (funcall non-toplevel-case form)))
+
(defconst byte-compile-initial-macro-environment
- '(
+ `(
;; (byte-compiler-options . (lambda (&rest forms)
;; (apply 'byte-compiler-options-handler forms)))
(declare-function . byte-compile-macroexpand-declare-function)
- (eval-when-compile . (lambda (&rest body)
- (list
- 'quote
- (byte-compile-eval
- (byte-compile-top-level
- (byte-compile-preprocess (cons 'progn body)))))))
- (eval-and-compile . (lambda (&rest body)
- ;; Byte compile before running it. Do it piece by
- ;; piece, in case further expressions need earlier
- ;; ones to be evaluated already, as is the case in
- ;; eieio.el.
- `(progn
- ,@(mapcar (lambda (exp)
- (let ((cexp
- (byte-compile-top-level
- (byte-compile-preprocess
- exp))))
- (eval cexp)
- cexp))
- body)))))
+ (eval-when-compile . ,(lambda (&rest body)
+ (let ((result nil))
+ (byte-compile-recurse-toplevel
+ (macroexp-progn body)
+ (lambda (form)
+ (setf result
+ (byte-compile-eval
+ (byte-compile-top-level
+ (byte-compile-preprocess form))))))
+ (list 'quote result))))
+ (eval-and-compile . ,(lambda (&rest body)
+ (byte-compile-recurse-toplevel
+ (macroexp-progn body)
+ (lambda (form)
+ ;; Don't compile here, since we don't know
+ ;; whether to compile as byte-compile-form
+ ;; or byte-compile-file-form.
+ (let ((expanded
+ (macroexpand-all
+ form
+ macroexpand-all-environment)))
+ (eval expanded lexical-binding)
+ expanded))))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
@@ -535,7 +563,13 @@ Each element is (INDEX . VALUE)")
(byte-defop 40 0 byte-unbind "for unbinding special bindings")
;; codes 8-47 are consumed by the preceding opcodes
-;; unused: 48-55
+;; New (in Emacs-24.4) bytecodes for more efficient handling of non-local exits
+;; (especially useful in lexical-binding code).
+(byte-defop 48 0 byte-pophandler)
+(byte-defop 50 -1 byte-pushcatch)
+(byte-defop 49 -1 byte-pushconditioncase)
+
+;; unused: 51-55
(byte-defop 56 -1 byte-nth)
(byte-defop 57 0 byte-symbolp)
@@ -707,7 +741,8 @@ otherwise pop it")
(defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
byte-goto-if-nil-else-pop
- byte-goto-if-not-nil-else-pop)
+ byte-goto-if-not-nil-else-pop
+ byte-pushcatch byte-pushconditioncase)
"List of byte-codes whose offset is a pc.")
(defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
@@ -938,7 +973,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(print-level 4)
(print-length 4))
(byte-compile-log-1
- (format
+ (format-message
,format-string
,@(mapcar
(lambda (x) (if (symbolp x) (list 'prin1-to-string x) x))
@@ -1085,7 +1120,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
pt)
(when dir
(unless was-same
- (insert (format "Leaving directory `%s'\n" default-directory))))
+ (insert (format-message "Leaving directory `%s'\n"
+ default-directory))))
(unless (bolp)
(insert "\n"))
(setq pt (point-marker))
@@ -1100,8 +1136,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when dir
(setq default-directory dir)
(unless was-same
- (insert (format "Entering directory `%s'\n"
- default-directory))))
+ (insert (format-message "Entering directory `%s'\n"
+ default-directory))))
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form nil)
;; Do this after setting default-directory.
@@ -1119,7 +1155,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defun byte-compile-warn (format &rest args)
"Issue a byte compiler warning; use (format FORMAT ARGS...) for message."
- (setq format (apply 'format format args))
+ (setq format (apply #'format-message format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
@@ -1136,10 +1172,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(byte-compile-warn "%s" msg)))))
(defun byte-compile-report-error (error-info)
- "Report Lisp error in compilation. ERROR-INFO is the error data."
+ "Report Lisp error in compilation.
+ERROR-INFO is the error data, in the form of either (ERROR-SYMBOL . DATA)
+or STRING."
(setq byte-compiler-error-flag t)
(byte-compile-log-warning
- (error-message-string error-info)
+ (if (stringp error-info) error-info
+ (error-message-string error-info))
nil :error))
;;; sanity-checking arglists
@@ -1258,8 +1297,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(if (byte-code-function-p def)
(aref def 0)
'(&rest def)))))
- (if (and (fboundp (car form))
- (subrp (symbol-function (car form))))
+ (if (subrp (symbol-function (car form)))
(subr-arity (symbol-function (car form))))))
(ncall (length (cdr form))))
;; Check many or unevalled from subr-arity.
@@ -1316,13 +1354,13 @@ extra args."
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
@@ -1336,6 +1374,33 @@ extra args."
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (name arglist macrop)
+ ;; This is the first definition. See if previous calls are compatible.
+ (let ((calls (assq name byte-compile-unresolved-functions))
+ nums sig min max)
+ (when (and calls macrop)
+ (byte-compile-warn "macro `%s' defined too late" name))
+ (setq byte-compile-unresolved-functions
+ (delq calls byte-compile-unresolved-functions))
+ (setq calls (delq t calls)) ;Ignore higher-order uses of the function.
+ (when (cdr calls)
+ (when (and (symbolp name)
+ (eq (function-get name 'byte-optimizer)
+ 'byte-compile-inline-expand))
+ (byte-compile-warn "defsubst `%s' was used before it was defined"
+ name))
+ (setq sig (byte-compile-arglist-signature arglist)
+ nums (sort (copy-sequence (cdr calls)) (function <))
+ min (car nums)
+ max (car (nreverse nums)))
+ (when (or (< min (car sig))
+ (and (cdr sig) (> max (cdr sig))))
+ (byte-compile-set-symbol-position name)
+ (byte-compile-warn
+ "%s being defined to take %s%s, but was previously called with %s"
+ name
+ (byte-compile-arglist-signature-string sig)
+ (if (equal sig '(1 . 1)) " arg" " args")
+ (byte-compile-arglist-signature-string (cons min max))))))
(let* ((old (byte-compile-fdefinition name macrop))
(initial (and macrop
(cdr (assq name
@@ -1344,52 +1409,26 @@ extra args."
;; to a defined function. (Bug#8646)
(and initial (symbolp initial)
(setq old (byte-compile-fdefinition initial nil)))
- (if (and old (not (eq old t)))
- (progn
- (and (eq 'macro (car-safe old))
- (eq 'lambda (car-safe (cdr-safe old)))
- (setq old (cdr old)))
- (let ((sig1 (byte-compile-arglist-signature
- (pcase old
- (`(lambda ,args . ,_) args)
- (`(closure ,_ ,args . ,_) args)
- ((pred byte-code-function-p) (aref old 0))
- (t '(&rest def)))))
- (sig2 (byte-compile-arglist-signature arglist)))
- (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
- (byte-compile-set-symbol-position name)
- (byte-compile-warn
- "%s %s used to take %s %s, now takes %s"
- (if macrop "macro" "function")
- name
- (byte-compile-arglist-signature-string sig1)
- (if (equal sig1 '(1 . 1)) "argument" "arguments")
- (byte-compile-arglist-signature-string sig2)))))
- ;; This is the first definition. See if previous calls are compatible.
- (let ((calls (assq name byte-compile-unresolved-functions))
- nums sig min max)
- (setq byte-compile-unresolved-functions
- (delq calls byte-compile-unresolved-functions))
- (setq calls (delq t calls)) ;Ignore higher-order uses of the function.
- (when (cdr calls)
- (when (and (symbolp name)
- (eq (function-get name 'byte-optimizer)
- 'byte-compile-inline-expand))
- (byte-compile-warn "defsubst `%s' was used before it was defined"
- name))
- (setq sig (byte-compile-arglist-signature arglist)
- nums (sort (copy-sequence (cdr calls)) (function <))
- min (car nums)
- max (car (nreverse nums)))
- (when (or (< min (car sig))
- (and (cdr sig) (> max (cdr sig))))
- (byte-compile-set-symbol-position name)
- (byte-compile-warn
- "%s being defined to take %s%s, but was previously called with %s"
- name
- (byte-compile-arglist-signature-string sig)
- (if (equal sig '(1 . 1)) " arg" " args")
- (byte-compile-arglist-signature-string (cons min max)))))))))
+ (when (and old (not (eq old t)))
+ (and (eq 'macro (car-safe old))
+ (eq 'lambda (car-safe (cdr-safe old)))
+ (setq old (cdr old)))
+ (let ((sig1 (byte-compile-arglist-signature
+ (pcase old
+ (`(lambda ,args . ,_) args)
+ (`(closure ,_ ,args . ,_) args)
+ ((pred byte-code-function-p) (aref old 0))
+ (_ '(&rest def)))))
+ (sig2 (byte-compile-arglist-signature arglist)))
+ (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+ (byte-compile-set-symbol-position name)
+ (byte-compile-warn
+ "%s %s used to take %s %s, now takes %s"
+ (if macrop "macro" "function")
+ name
+ (byte-compile-arglist-signature-string sig1)
+ (if (equal sig1 '(1 . 1)) "argument" "arguments")
+ (byte-compile-arglist-signature-string sig2)))))))
(defvar byte-compile-cl-functions nil
"List of functions defined in CL.")
@@ -1424,7 +1463,7 @@ extra args."
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
- macroexpand cl-macroexpand-all
+ macroexpand
cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
@@ -1593,14 +1632,14 @@ that already has a `.elc' file."
(message "Checking %s..." directory)
(dolist (file (directory-files directory))
(let ((source (expand-file-name file directory)))
- (if (and (not (member file '("RCS" "CVS")))
- (not (eq ?\. (aref file 0)))
- (file-directory-p source)
- (not (file-symlink-p source)))
- ;; This file is a subdirectory. Handle them differently.
- (when (or (null arg) (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories (nconc directories (list source))))
+ (if (file-directory-p source)
+ (and (not (member file '("RCS" "CVS")))
+ (not (eq ?\. (aref file 0)))
+ (not (file-symlink-p source))
+ ;; This file is a subdirectory. Handle them differently.
+ (or (null arg) (eq 0 arg)
+ (y-or-n-p (concat "Check " source "? ")))
+ (setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
;; The next 2 tests avoid compiling lock files
@@ -1699,16 +1738,14 @@ The value is non-nil if there were no errors, nil if errors."
;; (interactive "fByte compile file: \nP")
(interactive
(let ((file buffer-file-name)
- (file-name nil)
(file-dir nil))
(and file
(derived-mode-p 'emacs-lisp-mode)
- (setq file-name (file-name-nondirectory file)
- file-dir (file-name-directory file)))
+ (setq file-dir (file-name-directory file)))
(list (read-file-name (if current-prefix-arg
"Byte compile and load file: "
"Byte compile file: ")
- file-dir file-name nil)
+ file-dir buffer-file-name nil)
current-prefix-arg)))
;; Expand now so we get the current buffer's defaults
(setq filename (expand-file-name filename))
@@ -1763,7 +1800,7 @@ The value is non-nil if there were no errors, nil if errors."
(progn
(setq-default major-mode 'emacs-lisp-mode)
;; Arg of t means don't alter enable-local-variables.
- (normal-mode t))
+ (delay-mode-hooks (normal-mode t)))
(setq-default major-mode dmm))
;; There may be a file local variable setting (bug#10419).
(setq buffer-read-only nil
@@ -1826,13 +1863,13 @@ The value is non-nil if there were no errors, nil if errors."
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t)
- (message "Wrote %s" target-file))
+ (or noninteractive (message "Wrote %s" target-file)))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
(if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
+ "Cannot overwrite file"
+ "Directory not writable or nonexistent")
target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
@@ -1864,7 +1901,10 @@ With argument ARG, insert value in current buffer after the form."
(let ((read-with-symbol-positions (current-buffer))
(read-symbol-positions-list nil))
(displaying-byte-compile-warnings
- (byte-compile-sexp (read (current-buffer)))))
+ (byte-compile-sexp
+ (eval-sexp-add-defvars
+ (read (current-buffer))
+ byte-compile-read-position))))
lexical-binding)))
(cond (arg
(message "Compiling from buffer... done.")
@@ -2092,11 +2132,6 @@ list that represents a doc string reference.
(eq (aref (nth (nth 1 info) form) 0) ?*))
(setq position (- position)))))
- (if preface
- (progn
- (insert preface)
- (prin1 name byte-compile--outbuffer)))
- (insert (car info))
(let ((print-continuous-numbering t)
print-number-table
(index 0)
@@ -2109,6 +2144,15 @@ list that represents a doc string reference.
(print-gensym t)
(print-circle ; Handle circular data structures.
(not byte-compile-disable-print-circle)))
+ (if preface
+ (progn
+ ;; FIXME: We don't handle uninterned names correctly.
+ ;; E.g. if cl-define-compiler-macro uses uninterned name we get:
+ ;; (defalias '#1=#:foo--cmacro #[514 ...])
+ ;; (put 'foo 'compiler-macro '#:foo--cmacro)
+ (insert preface)
+ (prin1 name byte-compile--outbuffer)))
+ (insert (car info))
(prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
@@ -2194,9 +2238,12 @@ list that represents a doc string reference.
(t form)))
;; byte-hunk-handlers cannot call this!
-(defun byte-compile-toplevel-file-form (form)
- (let ((byte-compile-current-form nil)) ; close over this for warnings.
- (byte-compile-file-form (byte-compile-preprocess form t))))
+(defun byte-compile-toplevel-file-form (top-level-form)
+ (byte-compile-recurse-toplevel
+ top-level-form
+ (lambda (form)
+ (let ((byte-compile-current-form nil)) ; close over this for warnings.
+ (byte-compile-file-form (byte-compile-preprocess form t))))))
;; byte-hunk-handlers can call this.
(defun byte-compile-file-form (form)
@@ -2280,10 +2327,12 @@ list that represents a doc string reference.
form))
(put 'define-abbrev-table 'byte-hunk-handler
- 'byte-compile-file-form-define-abbrev-table)
-(defun byte-compile-file-form-define-abbrev-table (form)
- (if (eq 'quote (car-safe (car-safe (cdr form))))
- (byte-compile--declare-var (car-safe (cdr (cadr form)))))
+ 'byte-compile-file-form-defvar-function)
+(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function)
+
+(defun byte-compile-file-form-defvar-function (form)
+ (pcase-let (((or `',name (let name nil)) (nth 1 form)))
+ (if name (byte-compile--declare-var name)))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
@@ -2291,8 +2340,7 @@ list that represents a doc string reference.
(defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (byte-compile--declare-var (nth 1 (nth 1 form)))
- (byte-compile-keep-pending form))
+ (byte-compile-file-form-defvar-function form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
@@ -2389,9 +2437,8 @@ not to take responsibility for the actual compilation of the code."
(byte-compile-warn "%s `%s' defined multiple times in this file"
(if macro "macro" "function")
name)))
- ((and (fboundp name)
- (eq (car-safe (symbol-function name))
- (if macro 'lambda 'macro)))
+ ((eq (car-safe (symbol-function name))
+ (if macro 'lambda 'macro))
(when (byte-compile-warning-enabled-p 'redefine)
(byte-compile-warn "%s `%s' being redefined as a %s"
(if macro "function" "macro")
@@ -2500,7 +2547,8 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
"Return an expression which will evaluate to a function value FUN.
FUN should be either a `lambda' value or a `closure' value."
(pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
- `(closure ,env ,args . ,body)) fun)
+ `(closure ,env ,args . ,body))
+ fun)
(renv ()))
;; Turn the function's closed vars (if any) into local let bindings.
(dolist (binding env)
@@ -2525,7 +2573,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-close-variables
(let* ((lexical-binding lexical-binding)
(fun (if (symbolp form)
- (and (fboundp form) (symbol-function form))
+ (symbol-function form)
form))
(macro (eq (car-safe fun) 'macro)))
(if macro
@@ -2540,18 +2588,14 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (symbolp form) form "provided"))
fun)
(t
- (when (symbolp form)
- (unless (memq (car-safe fun) '(closure lambda))
- (error "Don't know how to compile %S" fun))
+ (when (or (symbolp form) (eq (car-safe fun) 'closure))
+ ;; `fun' is a function *value*, so try to recover its corresponding
+ ;; source code.
(setq lexical-binding (eq (car fun) 'closure))
(setq fun (byte-compile--reify-function fun)))
- (unless (eq (car-safe fun) 'lambda)
- (error "Don't know how to compile %S" fun))
;; Expand macros.
(setq fun (byte-compile-preprocess fun))
- ;; Get rid of the `function' quote added by the `lambda' macro.
- (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
- (setq fun (byte-compile-lambda fun))
+ (setq fun (byte-compile-top-level fun nil 'eval))
(if macro (push 'macro fun))
(if (symbolp form)
(fset form fun)
@@ -2702,8 +2746,9 @@ for symbols generated by the byte compiler itself."
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
- (cond (lexical-binding
- (require 'help-fns)
+ (cond ((and lexical-binding arglist)
+ ;; byte-compile-make-args-desc lost the args's names,
+ ;; so preserve them in the docstring.
(list (help-add-fundoc-usage doc arglist)))
((or doc int)
(list doc)))
@@ -2881,11 +2926,17 @@ for symbols generated by the byte compiler itself."
;; Special macro-expander used during byte-compilation.
(defun byte-compile-macroexpand-declare-function (fn file &rest args)
- (push (cons fn
- (if (and (consp args) (listp (car args)))
- (list 'declared (car args))
- t)) ; Arglist not specified.
- byte-compile-function-environment)
+ (let ((gotargs (and (consp args) (listp (car args))))
+ (unresolved (assq fn byte-compile-unresolved-functions)))
+ (when unresolved ; function was called before declaration
+ (if (and gotargs (byte-compile-warning-enabled-p 'callargs))
+ (byte-compile-arglist-warn fn (car args) nil)
+ (setq byte-compile-unresolved-functions
+ (delq unresolved byte-compile-unresolved-functions))))
+ (push (cons fn (if gotargs
+ (list 'declared (car args))
+ t)) ; Arglist not specified.
+ byte-compile-function-environment))
;; We are stating that it _will_ be defined at runtime.
(setq byte-compile-noruntime-functions
(delq fn byte-compile-noruntime-functions))
@@ -2922,17 +2973,39 @@ for symbols generated by the byte compiler itself."
(byte-compile-variable-ref form))))
((symbolp (car form))
(let* ((fn (car form))
- (handler (get fn 'byte-compile)))
+ (handler (get fn 'byte-compile))
+ (interactive-only
+ (or (get fn 'interactive-only)
+ (memq fn byte-compile-interactive-only-functions))))
+ (when (memq fn '(set symbol-value run-hooks ;; add-to-list
+ add-hook remove-hook run-hook-with-args
+ run-hook-with-args-until-success
+ run-hook-with-args-until-failure))
+ (pcase (cdr form)
+ (`(',var . ,_)
+ (when (assq var byte-compile-lexical-variables)
+ (byte-compile-log-warning
+ (format-message "%s cannot use lexical var `%s'" fn var)
+ nil :error)))))
(when (macroexp--const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
- (and (byte-compile-warning-enabled-p 'interactive-only)
- (memq fn byte-compile-interactive-only-functions)
- (byte-compile-warn "`%s' used from Lisp code\n\
-That command is designed for interactive use only" fn))
- (if (and (fboundp (car form))
- (eq (car-safe (symbol-function (car form))) 'macro))
+ (when (and (byte-compile-warning-enabled-p 'interactive-only)
+ interactive-only)
+ (byte-compile-warn "`%s' is for interactive use only%s"
+ fn
+ (cond ((stringp interactive-only)
+ (format "; %s"
+ (substitute-command-keys
+ interactive-only)))
+ ((and (symbolp 'interactive-only)
+ (not (eq interactive-only t)))
+ (format-message "; use `%s' instead."
+ interactive-only))
+ (t "."))))
+ (if (eq (car-safe (symbol-function (car form))) 'macro)
(byte-compile-log-warning
- (format "Forgot to expand macro %s" (car form)) nil :error))
+ (format "Forgot to expand macro %s in %S" (car form) form)
+ nil :error))
(if (and handler
;; Make sure that function exists.
(and (functionp handler)
@@ -3029,8 +3102,9 @@ That command is designed for interactive use only" fn))
(dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
- (byte-compile-log-warning "Too many arguments for inlined function"
- nil :error)
+ (byte-compile-log-warning
+ (format "Too many arguments for inlined function %S" form)
+ nil :error)
(byte-compile-discard (- alen (/ fmax2 2))))
(t
;; Turn &rest args into a list.
@@ -3058,7 +3132,7 @@ That command is designed for interactive use only" fn))
(cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants)
(byte-compile-warn (if (eq access-type 'let-bind)
- "attempt to let-bind %s `%s`"
+ "attempt to let-bind %s `%s'"
"variable reference to %s `%s'")
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))))
@@ -3168,6 +3242,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
'((0 . byte-compile-no-args)
(1 . byte-compile-one-arg)
(2 . byte-compile-two-args)
+ (2-and . byte-compile-and-folded)
(3 . byte-compile-three-args)
(0-1 . byte-compile-zero-or-one-arg)
(1-2 . byte-compile-one-or-two-args)
@@ -3249,11 +3324,11 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-defop-compiler cons 2)
(byte-defop-compiler aref 2)
(byte-defop-compiler set 2)
-(byte-defop-compiler (= byte-eqlsign) 2)
-(byte-defop-compiler (< byte-lss) 2)
-(byte-defop-compiler (> byte-gtr) 2)
-(byte-defop-compiler (<= byte-leq) 2)
-(byte-defop-compiler (>= byte-geq) 2)
+(byte-defop-compiler (= byte-eqlsign) 2-and)
+(byte-defop-compiler (< byte-lss) 2-and)
+(byte-defop-compiler (> byte-gtr) 2-and)
+(byte-defop-compiler (<= byte-leq) 2-and)
+(byte-defop-compiler (>= byte-geq) 2-and)
(byte-defop-compiler get 2)
(byte-defop-compiler nth 2)
(byte-defop-compiler substring 2-3)
@@ -3317,6 +3392,18 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(byte-compile-form (nth 2 form))
(byte-compile-out (get (car form) 'byte-opcode) 0)))
+(defun byte-compile-and-folded (form)
+ "Compile calls to functions like `<='.
+These implicitly `and' together a bunch of two-arg bytecodes."
+ (let ((l (length form)))
+ (cond
+ ((< l 3) (byte-compile-form `(progn ,(nth 1 form) t)))
+ ((= l 3) (byte-compile-two-args form))
+ ((cl-every #'macroexp-copyable-p (nthcdr 2 form))
+ (byte-compile-form `(and (,(car form) ,(nth 1 form) ,(nth 2 form))
+ (,(car form) ,@(nthcdr 2 form)))))
+ (t (byte-compile-normal-call form)))))
+
(defun byte-compile-three-args (form)
(if (not (= (length form) 4))
(byte-compile-subr-wrong-args form 3)
@@ -3390,15 +3477,22 @@ discarding."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(let* ((vars (nth 1 form))
(env (nth 2 form))
- (body (nthcdr 3 form))
+ (docstring-exp (nth 3 form))
+ (body (nthcdr 4 form))
(fun
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
- (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
+ (cl-assert (or (> (length env) 0)
+ docstring-exp)) ;Otherwise, we don't need a closure.
(cl-assert (byte-code-function-p fun))
(byte-compile-form `(make-byte-code
',(aref fun 0) ',(aref fun 1)
(vconcat (vector . ,env) ',(aref fun 2))
- ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
+ ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
+ (if docstring-exp
+ `(,(car rest)
+ ,docstring-exp
+ ,@(cddr rest))
+ rest)))))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
@@ -3526,8 +3620,8 @@ discarding."
(defun byte-compile-quo (form)
(let ((len (length form)))
- (cond ((<= len 2)
- (byte-compile-subr-wrong-args form "2 or more"))
+ (cond ((< len 2)
+ (byte-compile-subr-wrong-args form "1 or more"))
((= len 3)
(byte-compile-two-args form))
(t
@@ -3580,7 +3674,7 @@ discarding."
(byte-compile-constant (if (eq 'lambda (car-safe f))
(byte-compile-lambda f)
f))))
-
+
(defun byte-compile-indent-to (form)
(let ((len (length form)))
(cond ((= len 2)
@@ -3738,11 +3832,11 @@ discarding."
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
BODY is the code to compile in the first arm of the if or the body of
-the cond clause. If CONDITION's value is of the form (fboundp 'foo)
-or (boundp 'foo), the relevant warnings from BODY about foo's
+the cond clause. If CONDITION's value is of the form (fboundp \\='foo)
+or (boundp \\='foo), the relevant warnings from BODY about foo's
being undefined (or obsolete) will be suppressed.
-If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
+If CONDITION's value is (not (featurep \\='emacs)) or (featurep \\='xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
`(let* ((fbound-list (byte-compile-find-bound-condition
@@ -3757,6 +3851,10 @@ that suppresses all warnings during execution of BODY."
;; If things not being bound at all is ok, so must them being
;; obsolete. Note that we add to the existing lists since Tramp
;; (ab)uses this feature.
+ ;; FIXME: If `foo' is obsoleted by `bar', the code below
+ ;; correctly arranges to silence the warnings after testing
+ ;; existence of `foo', but the warning should also be
+ ;; silenced after testing the existence of `bar'.
(let ((byte-compile-not-obsolete-vars
(append byte-compile-not-obsolete-vars bound-list))
(byte-compile-not-obsolete-funcs
@@ -4026,36 +4124,46 @@ binding slots have been popped."
(byte-defop-compiler-1 save-restriction)
;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
-(byte-defop-compiler-1 track-mouse)
+
+(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)))
- (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))
+ (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)))
(defun byte-compile-unwind-protect (form)
(pcase (cddr form)
(`(:fun-body ,f)
- (byte-compile-form `(list (list 'funcall ,f))))
+ (byte-compile-form
+ (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
(handlers
- (byte-compile-push-constant
- (byte-compile-top-level-body handlers t))))
+ (if byte-compile--use-old-handlers
+ (byte-compile-push-constant
+ (byte-compile-top-level-body handlers t))
+ (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-track-mouse (form)
- (byte-compile-form
- (pcase form
- (`(,_ :fun-body ,f) `(eval (list 'track-mouse (list 'funcall ,f))))
- (_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form))))))))
-
(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
@@ -4106,6 +4214,62 @@ binding slots have been popped."
(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)
+ (clauses (mapcar (lambda (clause)
+ (cons (byte-compile-make-tag) clause))
+ (nthcdr 3 form)))
+ (endtag (byte-compile-make-tag)))
+ (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))
+
+ (dolist (clause (reverse clauses))
+ (let ((condition (nth 1 clause)))
+ (unless (consp condition) (setq condition (list condition)))
+ (dolist (c condition)
+ (unless (and c (symbolp c))
+ (byte-compile-warn
+ "`%S' is not a condition name (in condition-case)" c))
+ ;; In reality, the `error-conditions' property is only required
+ ;; for the argument to `signal', not to `condition-case'.
+ ;;(unless (consp (get c 'error-conditions))
+ ;; (byte-compile-warn
+ ;; "`%s' is not a known condition name (in condition-case)"
+ ;; c))
+ )
+ (byte-compile-push-constant condition))
+ (byte-compile-goto 'byte-pushconditioncase (car clause)))
+
+ (byte-compile-form body) ;; byte-compile--for-effect
+ (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+ (byte-compile-goto 'byte-goto endtag)
+
+ (while clauses
+ (let ((clause (pop clauses))
+ (byte-compile-bound-variables byte-compile-bound-variables)
+ (byte-compile--lexical-environment
+ byte-compile--lexical-environment))
+ (setq byte-compile-depth (1+ depth))
+ (byte-compile-out-tag (pop clause))
+ (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
+ (cond
+ ((null var) (byte-compile-discard))
+ (lexical-binding
+ (push (cons var (1- byte-compile-depth))
+ byte-compile--lexical-environment))
+ (t (byte-compile-dynamic-variable-bind var)))
+ (byte-compile-body (cdr clause)) ;; byte-compile--for-effect
+ (cond
+ ((null var) nil)
+ (lexical-binding (byte-compile-discard 1 'preserve-tos))
+ (t (byte-compile-out 'byte-unbind 1)))
+ (byte-compile-goto 'byte-goto endtag)))
+
+ (byte-compile-out-tag endtag)))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
@@ -4260,7 +4424,7 @@ binding slots have been popped."
;; which is to call back byte-compile-file-form and then return nil.
;; Except that we can't just call byte-compile-file-form since it would
;; call us right back.
- (t (byte-compile-keep-pending form)))))
+ (_ (byte-compile-keep-pending form)))))
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
@@ -4368,11 +4532,11 @@ whose definitions have been compiled in this Emacs session, as well as
all functions called by those functions.
The call graph does not include macros, inline functions, or
-primitives that the byte-code interpreter knows about directly \(eq,
-cons, etc.\).
+primitives that the byte-code interpreter knows about directly
+\(`eq', `cons', etc.).
The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled\), and which cannot be
+\(that is, to which no calls have been compiled), and which cannot be
invoked interactively."
(interactive)
(message "Generating call tree...")
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 70fa71a0da4..efa9a3da011 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,9 +1,9 @@
-;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
+;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp
;; Package: emacs
@@ -30,13 +30,13 @@
;; All macros should be expanded beforehand.
;;
;; Here is a brief explanation how this code works.
-;; Firstly, we analyze the tree by calling cconv-analyse-form.
+;; Firstly, we analyze the tree by calling cconv-analyze-form.
;; This function finds all mutated variables, all functions that are suitable
;; for lambda lifting and all variables captured by closure. It passes the tree
;; once, returning a list of three lists.
;;
;; Then we calculate the intersection of the first and third lists returned by
-;; cconv-analyse form to find all mutated variables that are captured by
+;; cconv-analyze form to find all mutated variables that are captured by
;; closure.
;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the
@@ -48,14 +48,14 @@
;; if the function is suitable for lambda lifting (if all calls are known)
;;
;; (lambda (v0 ...) ... fv0 .. fv1 ...) =>
-;; (internal-make-closure (v0 ...) (fv1 ...)
+;; (internal-make-closure (v0 ...) (fv0 ...) <doc>
;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...)
;;
;; If the function has no free variables, we don't do anything.
;;
;; If a variable is mutated (updated by setq), and it is used in a closure
;; we wrap its definition with list: (list val) and we also replace
-;; var => (car var) wherever this variable is used, and also
+;; var => (car-safe var) wherever this variable is used, and also
;; (setq var value) => (setcar var value) where it is updated.
;;
;; If defun argument is closure mutable, we letbind it and wrap it's
@@ -65,6 +65,14 @@
;;
;;; Code:
+;; PROBLEM cases found during conversion to lexical binding.
+;; We should try and detect and warn about those cases, even
+;; for lexical-binding==nil to help prepare the migration.
+;; - Uses of run-hooks, and friends.
+;; - Cases where we want to apply the same code to different vars depending on
+;; some test. These sometimes use a (let ((foo (if bar 'a 'b)))
+;; ... (symbol-value foo) ... (set foo ...)).
+
;; TODO: (not just for cconv but also for the lexbind changes in general)
;; - let (e)debug find the value of lexical variables from the stack.
;; - make eval-region do the eval-sexp-add-defvars dance.
@@ -79,8 +87,7 @@
;; command-history).
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
-;; - new byte codes for unwind-protect, catch, and condition-case so that
-;; closures aren't needed at all.
+;; - new byte codes for unwind-protect so that closures aren't needed at all.
;; - a reference to a var that is known statically to always hold a constant
;; should be turned into a byte-constant rather than a byte-stack-ref.
;; Hmm... right, that's called constant propagation and could be done here,
@@ -88,9 +95,8 @@
;; the bytecomp only compiles it once.
;; - Since we know here when a variable is not mutated, we could pass that
;; info to the byte-compiler, e.g. by using a new `immutable-let'.
-;; - add tail-calls to bytecode.c and the byte compiler.
;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapcar to a while loop.
+;; - optimize mapc to a dolist loop.
;; (defmacro dlet (binders &rest body)
;; ;; Works in both lexical and non-lexical mode.
@@ -141,7 +147,7 @@ Returns a form where all lambdas don't have any free variables."
(cconv-lambda-candidates '())
(cconv-captured+mutated '()))
;; Analyze form - fill these variables with new information.
- (cconv-analyse-form form '())
+ (cconv-analyze-form form '())
(setq cconv-freevars-alist (nreverse cconv-freevars-alist))
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
@@ -153,7 +159,7 @@ Returns a form where all lambdas don't have any free variables."
(cconv-lambda-candidates '())
(cconv-captured+mutated '()))
;; Analyze form - fill these variables with new information.
- (cconv-analyse-form form '())
+ (cconv-analyze-form form '())
;; But don't perform the closure conversion.
form))
@@ -196,7 +202,7 @@ Returns a form where all lambdas don't have any free variables."
(unless (memq (car b) s) (push b res)))
(nreverse res)))
-(defun cconv--convert-function (args body env parentform)
+(defun cconv--convert-function (args body env parentform &optional docstring)
(cl-assert (equal body (caar cconv-freevars-alist)))
(let* ((fvs (cdr (pop cconv-freevars-alist)))
(body-new '())
@@ -211,9 +217,9 @@ Returns a form where all lambdas don't have any free variables."
;; If `fv' is a variable that's wrapped in a cons-cell,
;; we want to put the cons-cell itself in the closure,
;; rather than just a copy of its current content.
- (`(car ,iexp . ,_)
+ (`(car-safe ,iexp . ,_)
(push iexp envector)
- (push `(,fv . (car (internal-get-closed-var ,i))) new-env))
+ (push `(,fv . (car-safe (internal-get-closed-var ,i))) new-env))
(_
(push exp envector)
(push `(,fv . (internal-get-closed-var ,i)) new-env))))
@@ -224,7 +230,7 @@ Returns a form where all lambdas don't have any free variables."
(dolist (arg args)
(if (not (member (cons (list arg) parentform) cconv-captured+mutated))
(if (assq arg new-env) (push `(,arg) new-env))
- (push `(,arg . (car ,arg)) new-env)
+ (push `(,arg . (car-safe ,arg)) new-env)
(push `(,arg (list ,arg)) letbind)))
(setq body-new (mapcar (lambda (form)
@@ -241,11 +247,11 @@ Returns a form where all lambdas don't have any free variables."
`(,@(nreverse special-forms) (let ,letbind . ,body-new)))))
(cond
- ((null envector) ;if no freevars - do nothing
+ ((not (or envector docstring)) ;If no freevars - do nothing.
`(function (lambda ,args . ,body-new)))
(t
`(internal-make-closure
- ,args ,envector . ,body-new)))))
+ ,args ,envector ,docstring . ,body-new)))))
(defun cconv-convert (form env extend)
;; This function actually rewrites the tree.
@@ -254,7 +260,7 @@ ENV is a lexical environment mapping variables to the expression
used to get its value. This is used for variables that are copied into
closures, moved into cons cells, ...
ENV is a list where each entry takes the shape either:
- (VAR . (car EXP)): VAR has been moved into the car of a cons-cell, and EXP
+ (VAR . (car-safe EXP)): VAR has been moved into the car of a cons-cell, and EXP
is an expression that evaluates to this cons-cell.
(VAR . (internal-get-closed-var N)): VAR has been copied into the closure
environment's Nth slot.
@@ -290,12 +296,16 @@ places where they originally did not directly appear."
(dolist (binder binders)
(let* ((value nil)
- (var (if (not (consp binder))
- (prog1 binder (setq binder (list binder)))
- (setq value (cadr binder))
- (car binder)))
- (new-val
- (cond
+ (var (if (not (consp binder))
+ (prog1 binder (setq binder (list binder)))
+ (when (cddr binder)
+ (byte-compile-log-warning
+ (format-message "Malformed `%S' binding: %S"
+ letsym binder)))
+ (setq value (cadr binder))
+ (car binder)))
+ (new-val
+ (cond
;; Check if var is a candidate for lambda lifting.
((and (member (cons binder form) cconv-lambda-candidates)
(progn
@@ -320,9 +330,9 @@ places where they originally did not directly appear."
(push `(,var . (apply-partially ,var . ,fvs)) new-env)
(dolist (fv fvs)
(cl-pushnew fv new-extend)
- (if (and (eq 'car (car-safe (cdr (assq fv env))))
+ (if (and (eq 'car-safe (car-safe (cdr (assq fv env))))
(not (memq fv funargs)))
- (push `(,fv . (car ,fv)) funcbody-env)))
+ (push `(,fv . (car-safe ,fv)) funcbody-env)))
`(function (lambda ,funcvars .
,(mapcar (lambda (form)
(cconv-convert
@@ -332,7 +342,7 @@ places where they originally did not directly appear."
;; Check if it needs to be turned into a "ref-cell".
((member (cons binder form) cconv-captured+mutated)
;; Declared variable is mutated and captured.
- (push `(,var . (car ,var)) new-env)
+ (push `(,var . (car-safe ,var)) new-env)
`(list ,(cconv-convert value env extend)))
;; Normal default case.
@@ -405,7 +415,9 @@ places where they originally did not directly appear."
cond-forms)))
(`(function (lambda ,args . ,body) . ,_)
- (cconv--convert-function args body env form))
+ (let ((docstring (if (eq :documentation (car-safe (car body)))
+ (cconv-convert (cadr (pop body)) env extend))))
+ (cconv--convert-function args body env form docstring)))
(`(internal-make-closure . ,_)
(byte-compile-report-error
@@ -421,25 +433,45 @@ places where they originally did not directly appear."
forms)))
;condition-case
- (`(condition-case ,var ,protected-form . ,handlers)
+ ((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)
+ ,@(mapcar (lambda (handler)
(list (car handler)
(cconv--convert-function
(list (or var cconv--dummy-var))
(cdr handler) env form)))
handlers))))
- (`(,(and head (or `catch `unwind-protect)) ,form . ,body)
+ ; condition-case with new byte-codes.
+ (`(condition-case ,var ,protected-form . ,handlers)
+ `(condition-case ,var
+ ,(cconv-convert protected-form env extend)
+ ,@(let* ((cm (and var (member (cons (list var) form)
+ cconv-captured+mutated)))
+ (newenv
+ (cond (cm (cons `(,var . (car-save ,var)) env))
+ ((assq var env) (cons `(,var) env))
+ (t env))))
+ (mapcar
+ (lambda (handler)
+ `(,(car handler)
+ ,@(let ((body
+ (mapcar (lambda (form)
+ (cconv-convert form newenv extend))
+ (cdr handler))))
+ (if (not cm) body
+ `((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)
:fun-body ,(cconv--convert-function () body env form)))
- (`(track-mouse . ,body)
- `(track-mouse
- :fun-body ,(cconv--convert-function () body env form)))
-
(`(setq . ,forms) ; setq special form
(let ((prognlist ()))
(while forms
@@ -448,7 +480,7 @@ places where they originally did not directly appear."
(value (cconv-convert (pop forms) env extend)))
(push (pcase sym-new
((pred symbolp) `(setq ,sym-new ,value))
- (`(car ,iexp) `(setcar ,iexp ,value))
+ (`(car-safe ,iexp) `(setcar ,iexp ,value))
;; This "should never happen", but for variables which are
;; mutated+captured+unused, we may end up trying to `setq'
;; on a closed-over variable, so just drop the setq.
@@ -472,7 +504,7 @@ places where they originally did not directly appear."
,@(mapcar (lambda (fv)
(let ((exp (or (cdr (assq fv env)) fv)))
(pcase exp
- (`(car ,iexp . ,_) iexp)
+ (`(car-safe ,iexp . ,_) iexp)
(_ exp))))
fvs)
,@(mapcar (lambda (arg)
@@ -491,7 +523,7 @@ places where they originally did not directly appear."
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
- ;; if, progn, prog1, prog2, while, until
+ ;; if, catch, progn, prog1, prog2, while, until
`(,func . ,(mapcar (lambda (form)
(cconv-convert form env extend))
forms)))
@@ -503,7 +535,7 @@ places where they originally did not directly appear."
(defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
-(defun cconv--analyse-use (vardata form varkind)
+(defun cconv--analyze-use (vardata form varkind)
"Analyze the use of a variable.
VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
VARKIND is the name of the kind of variable.
@@ -511,10 +543,10 @@ FORM is the parent form that binds this var."
;; use = `(,binder ,read ,mutated ,captured ,called)
(pcase vardata
(`(,_ nil nil nil nil) nil)
- (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_)
+ (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
,_ ,_ ,_ ,_)
(byte-compile-log-warning
- (format "%s `%S' not left unused" varkind var))))
+ (format-message "%s `%S' not left unused" varkind var))))
(pcase vardata
(`((,var . ,_) nil ,_ ,_ nil)
;; FIXME: This gives warnings in the wrong order, with imprecise line
@@ -526,8 +558,8 @@ FORM is the parent form that binds this var."
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
(eq var 'ignored))
- (byte-compile-log-warning (format "Unused lexical %s `%S'"
- varkind var))))
+ (byte-compile-log-warning (format-message "Unused lexical %s `%S'"
+ varkind var))))
;; If it's unused, there's no point converting it into a cons-cell, even if
;; it's captured and mutated.
(`(,binder ,_ t t ,_)
@@ -535,7 +567,7 @@ FORM is the parent form that binds this var."
(`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
(push (cons binder form) cconv-lambda-candidates))))
-(defun cconv--analyse-function (args body env parentform)
+(defun cconv--analyze-function (args body env parentform)
(let* ((newvars nil)
(freevars (list body))
;; We analyze the body within a new environment where all uses are
@@ -552,17 +584,18 @@ FORM is the parent form that binds this var."
(cond
((byte-compile-not-lexical-var-p arg)
(byte-compile-log-warning
- (format "Argument %S is not a lexical variable" arg)))
+ (format "Lexical argument shadows the dynamic variable %S"
+ arg)))
((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
(t (let ((varstruct (list arg nil nil nil nil)))
(cl-pushnew arg byte-compile-lexical-variables)
(push (cons (list arg) (cdr varstruct)) newvars)
(push varstruct newenv)))))
(dolist (form body) ;Analyze body forms.
- (cconv-analyse-form form newenv))
+ (cconv-analyze-form form newenv))
;; Summarize resulting data about arguments.
(dolist (vardata newvars)
- (cconv--analyse-use vardata parentform "argument"))
+ (cconv--analyze-use vardata parentform "argument"))
;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
;; and compute free variables.
(while env
@@ -578,7 +611,7 @@ FORM is the parent form that binds this var."
(setf (nth 3 (car env)) t))
(setq env (cdr env) envcopy (cdr envcopy))))))
-(defun cconv-analyse-form (form env)
+(defun cconv-analyze-form (form env)
"Find mutated variables and variables captured by closure.
Analyze lambdas if they are suitable for lambda lifting.
- FORM is a piece of Elisp code after macroexpansion.
@@ -605,7 +638,7 @@ and updates the data stored in ENV."
(setq var (car binder))
(setq value (cadr binder))
- (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
+ (cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
(unless (byte-compile-not-lexical-var-p var)
(cl-pushnew var byte-compile-lexical-variables)
@@ -614,13 +647,15 @@ and updates the data stored in ENV."
(push varstruct env))))
(dolist (form body-forms) ; Analyze body forms.
- (cconv-analyse-form form env))
+ (cconv-analyze-form form env))
(dolist (vardata newvars)
- (cconv--analyse-use vardata form "variable"))))
+ (cconv--analyze-use vardata form "variable"))))
(`(function (lambda ,vrs . ,body-forms))
- (cconv--analyse-function vrs body-forms env form))
+ (when (eq :documentation (car-safe (car body-forms)))
+ (cconv-analyze-form (cadr (pop body-forms)) env))
+ (cconv--analyze-function vrs body-forms env form))
(`(setq . ,forms)
;; If a local variable (member of env) is modified by setq then
@@ -628,7 +663,7 @@ and updates the data stored in ENV."
(while forms
(let ((v (assq (car forms) env))) ; v = non nil if visible
(when v (setf (nth 2 v) t)))
- (cconv-analyse-form (cadr forms) env)
+ (cconv-analyze-form (cadr forms) env)
(setq forms (cddr forms))))
(`((lambda . ,_) . ,_) ; First element is lambda expression.
@@ -636,37 +671,52 @@ and updates the data stored in ENV."
(format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form)))
- (cconv-analyse-form exp env)))
+ (cconv-analyze-form exp env)))
(`(cond . ,cond-forms) ; cond special form
(dolist (forms cond-forms)
- (dolist (form forms) (cconv-analyse-form form env))))
+ (dolist (form forms) (cconv-analyze-form form env))))
+
+ ;; ((and `(quote ,v . ,_) (guard (assq v env)))
+ ;; (byte-compile-log-warning
+ ;; (format-message "Possible confusion variable/symbol for `%S'" v)))
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
- (`(condition-case ,var ,protected-form . ,handlers)
+ ((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 (for handlers, it's understandable
- ;; but not for the protected form).
- (cconv--analyse-function () (list protected-form) env form)
+ ;; form and handlers in closures.
+ (cconv--analyze-function () (list protected-form) env form)
(dolist (handler handlers)
- (cconv--analyse-function (if var (list var)) (cdr handler) env form)))
+ (cconv--analyze-function (if var (list var)) (cdr handler)
+ env form)))
- ;; FIXME: The bytecode for catch forces us to wrap the body.
- (`(,(or `catch `unwind-protect) ,form . ,body)
- (cconv-analyse-form form env)
- (cconv--analyse-function () body env form))
-
- ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body.
- ;; `track-mouse' really should be made into a macro.
- (`(track-mouse . ,body)
- (cconv--analyse-function () body 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))
+ (byte-compile-log-warning
+ (format "Lexical variable shadows the dynamic variable %S" var)))
+ (let* ((varstruct (list var nil nil nil nil)))
+ (if var (push varstruct env))
+ (dolist (handler handlers)
+ (dolist (form (cdr handler))
+ (cconv-analyze-form form env)))
+ (if var (cconv--analyze-use (cons (list var) (cdr varstruct))
+ 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)
+ (cconv-analyze-form form env)
+ (cconv--analyze-function () body env form))
(`(defvar ,var) (push var byte-compile-bound-variables))
(`(,(or `defconst `defvar) ,var ,value . ,_)
(push var byte-compile-bound-variables)
- (cconv-analyse-form value env))
+ (cconv-analyze-form value env))
(`(,(or `funcall `apply) ,fun . ,args)
;; Here we ignore fun because funcall and apply are the only two
@@ -676,8 +726,8 @@ and updates the data stored in ENV."
(let ((fdata (and (symbolp fun) (assq fun env))))
(if fdata
(setf (nth 4 fdata) t)
- (cconv-analyse-form fun env)))
- (dolist (form args) (cconv-analyse-form form env)))
+ (cconv-analyze-form fun env)))
+ (dolist (form args) (cconv-analyze-form form env)))
(`(interactive . ,forms)
;; These appear within the function body but they don't have access
@@ -685,19 +735,20 @@ and updates the data stored in ENV."
;; We could extend this to allow interactive specs to refer to
;; variables in the function's enclosing environment, but it doesn't
;; seem worth the trouble.
- (dolist (form forms) (cconv-analyse-form form nil)))
+ (dolist (form forms) (cconv-analyze-form form nil)))
;; `declare' should now be macro-expanded away (and if they're not, we're
;; in trouble because they *can* contain code nowadays).
;; (`(declare . ,_) nil) ;The args don't contain code.
(`(,_ . ,body-forms) ; First element is a function or whatever.
- (dolist (form body-forms) (cconv-analyse-form form env)))
+ (dolist (form body-forms) (cconv-analyze-form form env)))
((pred symbolp)
(let ((dv (assq form env))) ; dv = declared and visible
(when dv
(setf (nth 1 dv) t))))))
+(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1")
(provide 'cconv)
;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 032eced7592..06601252a4c 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -1,6 +1,6 @@
;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2013 Free
+;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2015 Free
;; Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -86,10 +86,10 @@ Useful if new Emacs is used on B&W display.")
:group 'eieio
:type 'boolean)
+(declare-function x-display-color-cells "xfns.c" (&optional terminal))
+
(defvar chart-face-list
- (if (if (fboundp 'display-color-p)
- (display-color-p)
- window-system)
+ (if (display-color-p)
(let ((cl chart-face-color-list)
(pl chart-face-pixmap-list)
(faces ())
@@ -280,7 +280,7 @@ START and END represent the boundary."
"Draw axis information based upon a range to be spread along the edge.
A is the chart to draw. DIR is the direction.
MARGIN, ZONE, START, and END specify restrictions in chart space."
- (call-next-method)
+ (cl-call-next-method)
;; We prefer about 5 spaces between each value
(let* ((i (car (oref a bounds)))
(e (cdr (oref a bounds)))
@@ -333,7 +333,7 @@ Automatically compensates for direction."
"Draw axis information based upon A range to be spread along the edge.
Optional argument DIR is the direction of the chart.
Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing."
- (call-next-method)
+ (cl-call-next-method)
;; We prefer about 5 spaces between each value
(let* ((i 0)
(s (oref a items))
@@ -422,7 +422,7 @@ or is created with the bounds of SEQ."
(if (stringp (car (oref seq data)))
(let ((labels (oref seq data)))
(if (not axis)
- (setq axis (make-instance chart-axis-names
+ (setq axis (make-instance 'chart-axis-names
:name (oref seq name)
:items labels
:chart c))
@@ -430,7 +430,7 @@ or is created with the bounds of SEQ."
(let ((range (cons 0 1))
(l (oref seq data)))
(if (not axis)
- (setq axis (make-instance chart-axis-range
+ (setq axis (make-instance 'chart-axis-range
:name (oref seq name)
:chart c)))
(while l
@@ -577,19 +577,19 @@ labeled NUMTITLE.
Optional arguments:
Set the chart's max element display to MAX, and sort lists with
SORT-PRED if desired."
- (let ((nc (make-instance chart-bar
+ (let ((nc (make-instance 'chart-bar
:title title
:key-label "8-m" ; This is a text key pic
:direction dir
))
(iv (eq dir 'vertical)))
(chart-add-sequence nc
- (make-instance chart-sequece
+ (make-instance 'chart-sequece
:data namelst
:name nametitle)
(if iv 'x-axis 'y-axis))
(chart-add-sequence nc
- (make-instance chart-sequece
+ (make-instance 'chart-sequece
:data numlst
:name numtitle)
(if iv 'y-axis 'x-axis))
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 367db5240c9..536e4186c41 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,6 +1,6 @@
;;; check-declare.el --- Check declare-function statements
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Glenn Morris <rgm@gnu.org>
;; Keywords: lisp, tools, maint
@@ -98,7 +98,7 @@ don't know how to recognize (e.g. some macros)."
(stringp (setq fnfile (nth 2 form)))
(setq fnfile (check-declare-locate fnfile
(expand-file-name file)))
- ;; Use `t' to distinguish unspecified arglist from empty one.
+ ;; Use t to distinguish unspecified arglist from empty one.
(or (eq t (setq arglist (if (> len 3)
(nth 3 form)
t)))
@@ -125,6 +125,14 @@ With optional argument FULL, sums the number of elements in each element."
(autoload 'byte-compile-arglist-signature "bytecomp")
+(defgroup check-declare nil
+ "Check declare-function statements."
+ :group 'tools)
+
+(defcustom check-declare-ext-errors nil
+ "When non-nil, warn about functions not found in :ext."
+ :type 'boolean)
+
(defun check-declare-verify (fnfile fnlist)
"Check that FNFILE contains function definitions matching FNLIST.
Each element of FNLIST has the form (FILE FN ARGLIST FILEONLY), where
@@ -149,11 +157,12 @@ is a string giving details of the error."
(setq re (format (if cflag
"^[ \t]*\\(DEFUN\\)[ \t]*([ \t]*\"%s\""
"^[ \t]*(\\(fset[ \t]+'\\|\
+cl-def\\(?:generic\\|method\\)\\|\
def\\(?:un\\|subst\\|foo\\|method\\|class\\|\
ine-\\(?:derived\\|generic\\|\\(?:global\\(?:ized\\)?-\\)?minor\\)-mode\\|\
\\(?:ine-obsolete-function-\\)?alias[ \t]+'\\|\
ine-overloadable-function\\)\\)\
-\[ \t]*%s\\([ \t;]+\\|$\\)")
+[ \t]*%s\\([ \t;]+\\|$\\)")
(regexp-opt (mapcar 'cadr fnlist) t)))
(while (re-search-forward re nil t)
(skip-chars-forward " \t\n")
@@ -192,8 +201,8 @@ ine-overloadable-function\\)\\)\
type)
'obsolete)
;; Can't easily check arguments in these cases.
- ((string-match "\\`\\(def\\(alias\\|\
-method\\|class\\)\\|fset\\)\\>" type)
+ ((string-match "\\`\\(def\\(alias\\|class\\)\\|\
+fset\\|\\(?:cl-\\)?defmethod\\)\\>" type)
t)
((looking-at "\\((\\|nil\\)")
(byte-compile-arglist-signature
@@ -226,7 +235,8 @@ method\\|class\\)\\|fset\\)\\>" type)
(when type
(setq errlist (cons (list (car e) (cadr e) type) errlist))))
(message "%s%s" m
- (if (or re (not ext))
+ (if (or re (or check-declare-ext-errors
+ (not ext)))
(check-declare-errmsg errlist)
(progn
(setq errlist nil)
@@ -251,12 +261,29 @@ Returned list has elements FNFILE (FILE ...)."
"Warn that FILE made a false claim about FN in FNFILE.
TYPE is a string giving the nature of the error. Warning is displayed in
`check-declare-warning-buffer'."
- (display-warning 'check-declare
- (format "%s said `%s' was defined in %s: %s"
- (file-name-nondirectory file) fn
- (file-name-nondirectory fnfile)
- type)
- nil check-declare-warning-buffer))
+ (let ((warning-prefix-function
+ (lambda (level entry)
+ (let ((line 0)
+ (col 0))
+ (insert
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (format "(declare-function[ \t\n]+%s" fn) nil t)
+ (goto-char (match-beginning 0))
+ (setq line (line-number-at-pos))
+ (setq col (1+ (current-column))))
+ (format "%s:%d:%d:"
+ (file-name-nondirectory file)
+ line col))))
+ entry))
+ (warning-fill-prefix " "))
+ (display-warning 'check-declare
+ (format-message "said `%s' was defined in %s: %s"
+ fn (file-name-nondirectory fnfile) type)
+ nil check-declare-warning-buffer)))
+
+(declare-function compilation-forget-errors "compile" ())
(defun check-declare-files (&rest files)
"Check veracity of all `declare-function' statements in FILES.
@@ -269,13 +296,20 @@ Return a list of any errors found."
(dolist (e (check-declare-sort alist))
(if (setq err (check-declare-verify (car e) (cdr e)))
(setq errlist (cons (cons (car e) err) errlist))))
+ (setq errlist (nreverse errlist))
(if (get-buffer check-declare-warning-buffer)
(kill-buffer check-declare-warning-buffer))
+ (with-current-buffer (get-buffer-create check-declare-warning-buffer)
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ (let ((inhibit-read-only t))
+ (insert "\f\n"))
+ (compilation-forget-errors))
;; Sort back again so that errors are ordered by the files
;; containing the declare-function statements.
(dolist (e (check-declare-sort errlist))
- (dolist (f (cdr e))
- (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
+ (dolist (f (cdr e))
+ (check-declare-warn (car e) (cadr f) (car f) (nth 2 f))))
errlist))
;;;###autoload
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 9c5b408637f..bf1a21acaf1 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
-;;; checkdoc.el --- check documentation strings for style requirements
+;;; checkdoc.el --- check documentation strings for style requirements -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.6.2
@@ -267,6 +267,11 @@ made in the style guide relating to order."
:type 'boolean)
;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
+(defcustom checkdoc-package-keywords-flag nil
+ "Non-nil means warn if this file's package keywords are not recognized.
+Currently, all recognized keywords must be on `finder-known-keywords'."
+ :type 'boolean)
+
(define-obsolete-variable-alias 'checkdoc-style-hooks
'checkdoc-style-functions "24.3")
(defvar checkdoc-style-functions nil
@@ -315,6 +320,7 @@ This should be set in an Emacs Lisp file's local variables."
;;;###autoload
(defun checkdoc-list-of-strings-p (obj)
+ "Return t when OBJ is a list of strings."
;; this is a function so it might be shared by checkdoc-proper-noun-list
;; and/or checkdoc-ispell-lisp-words in the future
(and (listp obj)
@@ -741,7 +747,7 @@ buffer, otherwise searching starts at START-HERE."
;; Loop over docstrings.
(while (checkdoc-next-docstring)
(message "Searching for doc string spell error...%d%%"
- (/ (* 100 (point)) (point-max)))
+ (floor (* 100.0 (point)) (point-max)))
(if (looking-at "\"")
(checkdoc-ispell-docstring-engine
(save-excursion (forward-sexp 1) (point-marker)))))
@@ -761,7 +767,7 @@ buffer, otherwise searching starts at START-HERE."
;; Loop over message strings.
(while (checkdoc-message-text-next-string (point-max))
(message "Searching for message string spell error...%d%%"
- (/ (* 100 (point)) (point-max)))
+ (floor (* 100.0 (point)) (point-max)))
(if (looking-at "\"")
(checkdoc-ispell-docstring-engine
(save-excursion (forward-sexp 1) (point-marker)))))
@@ -785,7 +791,7 @@ perform the fix."
(condition-case nil
(while (and (not msg) (checkdoc-next-docstring))
(message "Searching for doc string error...%d%%"
- (/ (* 100 (point)) (point-max)))
+ (floor (* 100.0 (point)) (point-max)))
(if (setq msg (checkdoc-this-string-valid))
(setq msg (cons msg (point)))))
;; Quit.. restore position, Other errors, leave alone
@@ -807,7 +813,7 @@ assumes that the cursor is already positioned to perform the fix."
(setq type
(checkdoc-message-text-next-string (point-max))))
(message "Searching for message string error...%d%%"
- (/ (* 100 (point)) (point-max)))
+ (floor (* 100.0 (point)) (point-max)))
(if (setq msg (checkdoc-message-text-engine type))
(setq msg (cons msg (point)))))
;; Quit.. restore position, Other errors, leave alone
@@ -866,11 +872,20 @@ otherwise stop after the first error."
(checkdoc-start)
(checkdoc-message-text)
(checkdoc-rogue-spaces)
+ (when checkdoc-package-keywords-flag
+ (checkdoc-package-keywords))
(not (called-interactively-p 'interactive))
(if take-notes (checkdoc-show-diagnostics))
(message "Checking buffer for style...Done."))))
;;;###autoload
+(defun checkdoc-file (file)
+ "Check FILE for document, comment, error style, and rogue spaces."
+ (with-current-buffer (find-file-noselect file)
+ (let ((checkdoc-diagnostic-buffer "*warn*"))
+ (checkdoc-current-buffer t))))
+
+;;;###autoload
(defun checkdoc-start (&optional take-notes)
"Start scanning the current buffer for documentation string style errors.
Only documentation strings are checked.
@@ -1404,7 +1419,7 @@ regexp short cuts work. FP is the function defun information."
(when (re-search-forward "^(" e t)
(if (checkdoc-autofix-ask-replace (match-beginning 0)
(match-end 0)
- "Escape this '('? "
+ (format-message "Escape this `('? ")
"\\(")
nil
(checkdoc-create-error
@@ -1524,7 +1539,7 @@ may require more formatting")
;; Instead, use the `\\[...]' construct to stand for them.
(save-excursion
(let ((f nil) (m nil) (start (point))
- (re "[^`A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\
+ (re "[^`‘A-Za-z0-9_]\\([CMA]-[a-zA-Z]\\|\\(\\([CMA]-\\)?\
mouse-[0-3]\\)\\)\\>"))
;; Find the first key sequence not in a sample
(while (and (not f) (setq m (re-search-forward re e t)))
@@ -1554,7 +1569,8 @@ mouse-[0-3]\\)\\)\\>"))
(save-excursion
(let ((case-fold-search t)
(ret nil) mb me)
- (while (and (re-search-forward "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'" e t)
+ (while (and (re-search-forward
+ "[`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]" e t)
(not ret))
(let* ((ms1 (match-string 1))
(sym (intern-soft ms1)))
@@ -1615,8 +1631,8 @@ function,command,variable,option or symbol." ms1))))))
(or
;; * The documentation string for a variable that is a
;; yes-or-no flag should start with words such as Non-nil
- ;; means..., to make it clear that all non-`nil' values are
- ;; equivalent and indicate explicitly what `nil' and non-`nil'
+ ;; means..., to make it clear that all non-nil values are
+ ;; equivalent and indicate explicitly what nil and non-nil
;; mean.
;; * If a user option variable records a true-or-false
;; condition, give it a name that ends in `-flag'.
@@ -1663,14 +1679,15 @@ function,command,variable,option or symbol." ms1))))))
;; Addendum: Make sure they appear in the doc in the same
;; order that they are found in the arg list.
- (let ((args (cdr (cdr (cdr (cdr fp)))))
+ (let ((args (nthcdr 4 fp))
(last-pos 0)
(found 1)
(order (and (nth 3 fp) (car (nth 3 fp))))
(nocheck (append '("&optional" "&rest") (nth 3 fp)))
(inopts nil))
(while (and args found (> found last-pos))
- (if (member (car args) nocheck)
+ (if (or (member (car args) nocheck)
+ (string-match "\\`_" (car args)))
(setq args (cdr args)
inopts t)
(setq last-pos found
@@ -1697,7 +1714,7 @@ function,command,variable,option or symbol." ms1))))))
e t))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
- (format
+ (format-message
"If this is the argument `%s', it should appear as %s. Fix? "
(car args) (upcase (car args)))
(upcase (car args)) t)
@@ -1723,7 +1740,7 @@ function,command,variable,option or symbol." ms1))))))
(insert "."))
nil)
(checkdoc-create-error
- (format
+ (format-message
"Argument `%s' should appear (as %s) in the doc string"
(car args) (upcase (car args)))
s (marker-position e)))
@@ -1784,16 +1801,17 @@ Replace with \"%s\"? " original replace)
)))
;;* When a documentation string refers to a Lisp symbol, write it as
;; it would be printed (which usually means in lower case), with
- ;; single-quotes around it. For example: `lambda'. There are two
- ;; exceptions: write t and nil without single-quotes. (In this
- ;; manual, we normally do use single-quotes for those symbols.)
+ ;; single-quotes around it. For example: ‘lambda’. There are two
+ ;; exceptions: write t and nil without single-quotes. (For
+ ;; compatibility with an older Emacs style, quoting with ` and '
+ ;; also works, e.g., `lambda' is treated like ‘lambda’.)
(save-excursion
(let ((found nil) (start (point)) (msg nil) (ms nil))
(while (and (not msg)
(re-search-forward
;; Ignore manual page references like
;; git-config(1).
- "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']"
+ "[^-([`'‘’:a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^]('’]"
e t))
(setq ms (match-string 1))
;; A . is a \s_ char, so we must remove periods from
@@ -1806,16 +1824,16 @@ Replace with \"%s\"? " original replace)
(setq found (intern-soft ms))
(or (boundp found) (fboundp found)))
(progn
- (setq msg (format "Add quotes around Lisp symbol `%s'? "
- ms))
+ (setq msg (format-message
+ "Add quotes around Lisp symbol `%s'? " ms))
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (+ (match-beginning 1)
(length ms))
- msg (concat "`" ms "'") t)
+ msg (format-message "`%s'" ms) t)
(setq msg nil)
(setq msg
- (format "Lisp symbol `%s' should appear in quotes"
- ms))))))
+ (format-message
+ "Lisp symbol `%s' should appear in quotes" ms))))))
(if msg
(checkdoc-create-error msg (match-beginning 1)
(+ (match-beginning 1)
@@ -1823,7 +1841,7 @@ Replace with \"%s\"? " original replace)
nil)))
;; t and nil case
(save-excursion
- (if (re-search-forward "\\(`\\(t\\|nil\\)'\\)" e t)
+ (if (re-search-forward "\\([`‘]\\(t\\|nil\\)['’]\\)" e t)
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (match-end 1)
(format "%s should not appear in quotes. Remove? "
@@ -1831,7 +1849,7 @@ Replace with \"%s\"? " original replace)
(match-string 2) t)
nil
(checkdoc-create-error
- "Symbols t and nil should not appear in `...' quotes"
+ "Symbols t and nil should not appear in single quotes"
(match-beginning 1) (match-end 1)))))
;; Here is some basic sentence formatting
(checkdoc-sentencespace-region-engine (point) e)
@@ -1936,7 +1954,7 @@ from the comment."
"Return non-nil if the current point is in a code fragment.
A code fragment is identified by an open parenthesis followed by a
symbol which is a valid function or a word in all CAPS, or a parenthesis
-that is quoted with the ' character. Only the region from START to LIMIT
+that is quoted with the \\=' character. Only the region from START to LIMIT
is allowed while searching for the bounding parenthesis."
(save-match-data
(save-restriction
@@ -1988,7 +2006,7 @@ If the offending word is in a piece of quoted text, then it is skipped."
(if (and (not (save-excursion
(goto-char b)
(forward-char -1)
- (looking-at "`\\|\"\\|\\.\\|\\\\")))
+ (looking-at "[`\".‘]\\|\\\\")))
;; surrounded by /, as in a URL or filename: /emacs/
(not (and (= ?/ (char-after e))
(= ?/ (char-before b))))
@@ -2404,7 +2422,7 @@ Argument END is the maximum bounds to search in."
According to the documentation for the function `error', the error list
should not end with a period, and should start with a capital letter.
The function `y-or-n-p' has similar constraints.
-Argument TYPE specifies the type of question, such as `error or `y-or-n-p."
+Argument TYPE specifies the type of question, such as `error' or `y-or-n-p'."
;; If type is nil, then attempt to derive it.
(if (not type)
(save-excursion
@@ -2469,7 +2487,8 @@ Argument TYPE specifies the type of question, such as `error or `y-or-n-p."
;; If we see a ?, then replace with "? ".
(if (checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "`y-or-n-p' argument should end with \"? \". Fix? "
+ (format-message
+ "`y-or-n-p' argument should end with \"? \". Fix? ")
"? " t)
nil
(checkdoc-create-error
@@ -2480,7 +2499,8 @@ Argument TYPE specifies the type of question, such as `error or `y-or-n-p."
(looking-at " "))
(if (checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "`y-or-n-p' argument should end with \"? \". Fix? "
+ (format-message
+ "`y-or-n-p' argument should end with \"? \". Fix? ")
"? " t)
nil
(checkdoc-create-error
@@ -2492,7 +2512,8 @@ Argument TYPE specifies the type of question, such as `error or `y-or-n-p."
(looking-at "\""))
(checkdoc-autofix-ask-replace
(match-beginning 0) (match-end 0)
- "`y-or-n-p' argument should end with \"? \". Fix? "
+ (format-message
+ "`y-or-n-p' argument should end with \"? \". Fix? ")
"? \"" t))
nil
(checkdoc-create-error
@@ -2608,28 +2629,65 @@ function called to create the messages."
"Store POINT and MSG as errors in the checkdoc diagnostic buffer."
(setq checkdoc-pending-errors t)
(let ((text (list "\n" (checkdoc-buffer-label) ":"
- (int-to-string
- (count-lines (point-min) (or point (point-min))))
- ": " msg)))
- (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (apply #'insert text)))))
+ (int-to-string
+ (count-lines (point-min) (or point (point-min))))
+ ": " msg)))
+ (if (string= checkdoc-diagnostic-buffer "*warn*")
+ (warn (apply #'concat text))
+ (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+ (let ((inhibit-read-only t)
+ (pt (point-max)))
+ (goto-char pt)
+ (apply #'insert text))))))
(defun checkdoc-show-diagnostics ()
"Display the checkdoc diagnostic buffer in a temporary window."
(if checkdoc-pending-errors
- (let ((b (get-buffer checkdoc-diagnostic-buffer)))
- (if b (progn (pop-to-buffer b)
- (goto-char (point-max))
- (re-search-backward "\C-l" nil t)
- (beginning-of-line)
- (forward-line 1)
- (recenter 0)))
- (other-window -1)
+ (let* ((b (get-buffer checkdoc-diagnostic-buffer))
+ (win (if b (display-buffer b))))
+ (when win
+ (with-selected-window win
+ (goto-char (point-max))
+ (re-search-backward "\C-l" nil t)
+ (beginning-of-line)
+ (forward-line 1)
+ (recenter 0)))
(setq checkdoc-pending-errors nil)
nil)))
+(defun checkdoc-get-keywords ()
+ "Return a list of package keywords for the current file."
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
+ (split-string (match-string-no-properties 1) ", " t))))
+
+(defvar finder-known-keywords)
+
+;;;###autoload
+(defun checkdoc-package-keywords ()
+ "Find package keywords that aren't in `finder-known-keywords'."
+ (interactive)
+ (require 'finder)
+ (let ((unrecognized-keys
+ (cl-remove-if
+ (lambda (x) (assoc (intern-soft x) finder-known-keywords))
+ (checkdoc-get-keywords))))
+ (if unrecognized-keys
+ (let* ((checkdoc-autofix-flag 'never)
+ (checkdoc-generate-compile-warnings-flag t))
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^;; Keywords: \\(.*\\)$" nil t)
+ (checkdoc-start-section "checkdoc-package-keywords")
+ (checkdoc-create-error
+ (concat "Unrecognized keywords: "
+ (mapconcat #'identity unrecognized-keys ", "))
+ (match-beginning 1) (match-end 1)))
+ (checkdoc-show-diagnostics))
+ (when (called-interactively-p 'any)
+ (message "No Package Keyword Errors.")))))
+
(custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
(provide 'checkdoc)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 70ad1283cb2..afa021dffc7 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1,6 +1,6 @@
;;; cl-extra.el --- Common Lisp features, part 2 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: extensions
@@ -269,43 +269,20 @@ If so, return the true (non-nil) value returned by PREDICATE.
;;;###autoload
(defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
(or cl-buffer (setq cl-buffer (current-buffer)))
- (if (fboundp 'overlay-lists)
-
- ;; This is the preferred algorithm, though overlay-lists is undocumented.
- (let (cl-ovl)
- (with-current-buffer cl-buffer
- (setq cl-ovl (overlay-lists))
- (if cl-start (setq cl-start (copy-marker cl-start)))
- (if cl-end (setq cl-end (copy-marker cl-end))))
- (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
- (while (and cl-ovl
- (or (not (overlay-start (car cl-ovl)))
- (and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
- (and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
- (not (funcall cl-func (car cl-ovl) cl-arg))))
- (setq cl-ovl (cdr cl-ovl)))
- (if cl-start (set-marker cl-start nil))
- (if cl-end (set-marker cl-end nil)))
-
- ;; This alternate algorithm fails to find zero-length overlays.
- (let ((cl-mark (with-current-buffer cl-buffer
- (copy-marker (or cl-start (point-min)))))
- (cl-mark2 (and cl-end (with-current-buffer cl-buffer
- (copy-marker cl-end))))
- cl-pos cl-ovl)
- (while (save-excursion
- (and (setq cl-pos (marker-position cl-mark))
- (< cl-pos (or cl-mark2 (point-max)))
- (progn
- (set-buffer cl-buffer)
- (setq cl-ovl (overlays-at cl-pos))
- (set-marker cl-mark (next-overlay-change cl-pos)))))
- (while (and cl-ovl
- (or (/= (overlay-start (car cl-ovl)) cl-pos)
- (not (and (funcall cl-func (car cl-ovl) cl-arg)
- (set-marker cl-mark nil)))))
- (setq cl-ovl (cdr cl-ovl))))
- (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))
+ (let (cl-ovl)
+ (with-current-buffer cl-buffer
+ (setq cl-ovl (overlay-lists))
+ (if cl-start (setq cl-start (copy-marker cl-start)))
+ (if cl-end (setq cl-end (copy-marker cl-end))))
+ (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
+ (while (and cl-ovl
+ (or (not (overlay-start (car cl-ovl)))
+ (and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
+ (and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
+ (not (funcall cl-func (car cl-ovl) cl-arg))))
+ (setq cl-ovl (cdr cl-ovl)))
+ (if cl-start (set-marker cl-start nil))
+ (if cl-end (set-marker cl-end nil))))
;;; Support for `setf'.
;;;###autoload
@@ -321,22 +298,21 @@ If so, return the true (non-nil) value returned by PREDICATE.
;;;###autoload
(defun cl-gcd (&rest args)
"Return the greatest common divisor of the arguments."
- (let ((a (abs (or (pop args) 0))))
- (while args
- (let ((b (abs (pop args))))
- (while (> b 0) (setq b (% a (setq a b))))))
- a))
+ (let ((a (or (pop args) 0)))
+ (dolist (b args)
+ (while (/= b 0)
+ (setq b (% a (setq a b)))))
+ (abs a)))
;;;###autoload
(defun cl-lcm (&rest args)
"Return the least common multiple of the arguments."
(if (memq 0 args)
0
- (let ((a (abs (or (pop args) 1))))
- (while args
- (let ((b (abs (pop args))))
- (setq a (* (/ a (cl-gcd a b)) b))))
- a)))
+ (let ((a (or (pop args) 1)))
+ (dolist (b args)
+ (setq a (* (/ a (cl-gcd a b)) b)))
+ (abs a))))
;;;###autoload
(defun cl-isqrt (x)
@@ -406,6 +382,42 @@ With two arguments, return rounding and remainder of their quotient."
"Return 1 if X is positive, -1 if negative, 0 if zero."
(cond ((> x 0) 1) ((< x 0) -1) (t 0)))
+;;;###autoload
+(cl-defun cl-parse-integer (string &key start end radix junk-allowed)
+ "Parse integer from the substring of STRING from START to END.
+STRING may be surrounded by whitespace chars (chars with syntax ` ').
+Other non-digit chars are considered junk.
+RADIX is an integer between 2 and 36, the default is 10. Signal
+an error if the substring between START and END cannot be parsed
+as an integer unless JUNK-ALLOWED is non-nil."
+ (cl-check-type string string)
+ (let* ((start (or start 0))
+ (len (length string))
+ (end (or end len))
+ (radix (or radix 10)))
+ (or (<= start end len)
+ (error "Bad interval: [%d, %d)" start end))
+ (cl-flet ((skip-whitespace ()
+ (while (and (< start end)
+ (= 32 (char-syntax (aref string start))))
+ (setq start (1+ start)))))
+ (skip-whitespace)
+ (let ((sign (cl-case (and (< start end) (aref string start))
+ (?+ (cl-incf start) +1)
+ (?- (cl-incf start) -1)
+ (t +1)))
+ digit sum)
+ (while (and (< start end)
+ (setq digit (cl-digit-char-p (aref string start) radix)))
+ (setq sum (+ (* (or sum 0) radix) digit)
+ start (1+ start)))
+ (skip-whitespace)
+ (cond ((and junk-allowed (null sum)) sum)
+ (junk-allowed (* sign sum))
+ ((or (/= start end) (null sum))
+ (error "Not an integer string: `%s'" string))
+ (t (* sign sum)))))))
+
;; Random numbers.
@@ -417,7 +429,7 @@ Optional second arg STATE is a random-state object."
;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
(let ((vec (aref state 3)))
(if (integerp vec)
- (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1))
+ (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1))
(aset state 3 (setq vec (make-vector 55 nil)))
(aset vec 0 j)
(while (> (setq i (% (+ i 21) 55)) 0)
@@ -485,7 +497,7 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
(setq cl-least-positive-normalized-float y
cl-least-negative-normalized-float (- y))
;; Divide down until value underflows to zero.
- (setq x (/ 1 z) y x)
+ (setq x (/ z) y x)
(while (condition-case _ (> (/ x 2) 0) (arith-error nil))
(setq x (/ x 2)))
(setq cl-least-positive-float x
@@ -505,41 +517,44 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
(defun cl-subseq (seq start &optional end)
"Return the subsequence of SEQ from START to END.
If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
+If START or END is negative, it counts from the end.
+Signal an error if START or END are outside of the sequence (i.e
+too large if positive or too small if negative)."
(declare (gv-setter
(lambda (new)
- `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
- ,new))))
- (if (stringp seq) (substring seq start end)
- (let (len)
- (and end (< end 0) (setq end (+ end (setq len (length seq)))))
- (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
- (cond ((listp seq)
- (if (> start 0) (setq seq (nthcdr start seq)))
- (if end
- (let ((res nil))
- (while (>= (setq end (1- end)) start)
- (push (pop seq) res))
- (nreverse res))
- (copy-sequence seq)))
- (t
- (or end (setq end (or len (length seq))))
- (let ((res (make-vector (max (- end start) 0) nil))
- (i 0))
- (while (< start end)
- (aset res i (aref seq start))
- (setq i (1+ i) start (1+ start)))
- res))))))
-
-;;;###autoload
-(defun cl-concatenate (type &rest seqs)
+ (macroexp-let2 nil new new
+ `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
+ ,new)))))
+ (cond ((or (stringp seq) (vectorp seq)) (substring seq start end))
+ ((listp seq)
+ (let (len
+ (errtext (format "Bad bounding indices: %s, %s" start end)))
+ (and end (< end 0) (setq end (+ end (setq len (length seq)))))
+ (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
+ (unless (>= start 0)
+ (error "%s" errtext))
+ (when (> start 0)
+ (setq seq (nthcdr (1- start) seq))
+ (or seq (error "%s" errtext))
+ (setq seq (cdr seq)))
+ (if end
+ (let ((res nil))
+ (while (and (>= (setq end (1- end)) start) seq)
+ (push (pop seq) res))
+ (or (= (1+ end) start) (error "%s" errtext))
+ (nreverse res))
+ (copy-sequence seq))))
+ (t (error "Unsupported sequence: %s" seq))))
+
+;;;###autoload
+(defun cl-concatenate (type &rest sequences)
"Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
\n(fn TYPE SEQUENCE...)"
- (cond ((eq type 'vector) (apply 'vconcat seqs))
- ((eq type 'string) (apply 'concat seqs))
- ((eq type 'list) (apply 'append (append seqs '(nil))))
- (t (error "Not a sequence type name: %s" type))))
-
+ (pcase type
+ (`vector (apply #'vconcat sequences))
+ (`string (apply #'concat sequences))
+ (`list (apply #'append (append sequences '(nil))))
+ (_ (error "Not a sequence type name: %S" type))))
;;; List functions.
@@ -575,7 +590,7 @@ If START or END is negative, it counts from the end."
"Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
(declare (compiler-macro cl--compiler-macro-get)
- (gv-setter (lambda (store) `(put ,sym ,tag ,store))))
+ (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store))))
(or (get sym tag)
(and def
;; Make sure `def' is really absent as opposed to set to nil.
@@ -593,15 +608,14 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(declare (gv-expander
(lambda (do)
(gv-letplace (getter setter) plist
- (macroexp-let2 nil k tag
- (macroexp-let2 nil d def
- (funcall do `(cl-getf ,getter ,k ,d)
- (lambda (v)
- (macroexp-let2 nil val v
- `(progn
- ,(funcall setter
- `(cl--set-getf ,getter ,k ,val))
- ,val))))))))))
+ (macroexp-let2* nil ((k tag) (d def))
+ (funcall do `(cl-getf ,getter ,k ,d)
+ (lambda (v)
+ (macroexp-let2 nil val v
+ `(progn
+ ,(funcall setter
+ `(cl--set-getf ,getter ,k ,val))
+ ,val)))))))))
(setplist '--cl-getf-symbol-- plist)
(or (get '--cl-getf-symbol-- tag)
;; Originally we called cl-get here,
@@ -634,6 +648,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(progn (setplist sym (cdr (cdr plist))) t)
(cl--do-remf plist tag))))
+;;; Streams.
+
+;;;###autoload
+(defun cl-fresh-line (&optional stream)
+ "Output a newline unless already at the beginning of a line."
+ (terpri stream 'ensure))
+
;;; Some debugging aids.
(defun cl-prettyprint (form)
@@ -691,6 +712,171 @@ including `cl-block' and `cl-eval-when'."
(prog1 (cl-prettyprint form)
(message ""))))
+;;; Integration into the online help system.
+
+(eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class.
+(require 'help-mode)
+
+;; FIXME: We could go crazy and add another entry so describe-symbol can be
+;; used with the slot names of CL structs (and/or EIEIO objects).
+(add-to-list 'describe-symbol-backends
+ `(nil ,#'cl-find-class ,(lambda (s _b _f) (cl-describe-type s))))
+
+(defconst cl--typedef-regexp
+ (concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
+ "cl-deftype" "deftype"))
+ "[ \t\r\n]+%s[ \t\r\n]+"))
+(with-eval-after-load 'find-func
+ (defvar find-function-regexp-alist)
+ (add-to-list 'find-function-regexp-alist
+ `(define-type . cl--typedef-regexp)))
+
+(define-button-type 'cl-help-type
+ :supertype 'help-function-def
+ 'help-function #'cl-describe-type
+ 'help-echo (purecopy "mouse-2, RET: describe this type"))
+
+(define-button-type 'cl-type-definition
+ :supertype 'help-function-def
+ 'help-echo (purecopy "mouse-2, RET: find type definition"))
+
+(declare-function help-fns-short-filename "help-fns" (filename))
+
+;;;###autoload
+(defun cl-find-class (type) (cl--find-class type))
+
+;;;###autoload
+(defun cl-describe-type (type)
+ "Display the documentation for type TYPE (a symbol)."
+ (interactive
+ (let ((str (completing-read "Describe type: " obarray #'cl-find-class t)))
+ (if (<= (length str) 0)
+ (user-error "Abort!")
+ (list (intern str)))))
+ (help-setup-xref (list #'cl-describe-type type)
+ (called-interactively-p 'interactive))
+ (save-excursion
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (let ((class (cl-find-class type)))
+ (if class
+ (cl--describe-class type class)
+ ;; FIXME: Describe other types (the built-in ones, or those from
+ ;; cl-deftype).
+ (user-error "Unknown type %S" type))))
+ (with-current-buffer standard-output
+ ;; Return the text we displayed.
+ (buffer-string)))))
+
+(defun cl--describe-class (type &optional class)
+ (unless class (setq class (cl--find-class type)))
+ (let ((location (find-lisp-object-file-name type 'define-type))
+ ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
+ (metatype (cl--class-name (symbol-value (aref class 0)))))
+ (insert (symbol-name type)
+ (substitute-command-keys " is a type (of kind `"))
+ (help-insert-xref-button (symbol-name metatype)
+ 'cl-help-type metatype)
+ (insert (substitute-command-keys "')"))
+ (when location
+ (insert (substitute-command-keys " in `"))
+ (help-insert-xref-button
+ (help-fns-short-filename location)
+ 'cl-type-definition type location 'define-type)
+ (insert (substitute-command-keys "'")))
+ (insert ".\n")
+
+ ;; Parents.
+ (let ((pl (cl--class-parents class))
+ cur)
+ (when pl
+ (insert " Inherits from ")
+ (while (setq cur (pop pl))
+ (setq cur (cl--class-name cur))
+ (insert (substitute-command-keys "`"))
+ (help-insert-xref-button (symbol-name cur)
+ 'cl-help-type cur)
+ (insert (substitute-command-keys (if pl "', " "'"))))
+ (insert ".\n")))
+
+ ;; Children, if available. ¡For EIEIO!
+ (let ((ch (condition-case nil
+ (cl-struct-slot-value metatype 'children class)
+ (cl-struct-unknown-slot nil)))
+ cur)
+ (when ch
+ (insert " Children ")
+ (while (setq cur (pop ch))
+ (insert (substitute-command-keys "`"))
+ (help-insert-xref-button (symbol-name cur)
+ 'cl-help-type cur)
+ (insert (substitute-command-keys (if ch "', " "'"))))
+ (insert ".\n")))
+
+ ;; Type's documentation.
+ (let ((doc (cl--class-docstring class)))
+ (when doc
+ (insert "\n" doc "\n\n")))
+
+ ;; Describe all the slots in this class.
+ (cl--describe-class-slots class)
+
+ ;; Describe all the methods specific to this class.
+ (let ((generics (cl--generic-all-functions type)))
+ (when generics
+ (insert (propertize "Specialized Methods:\n\n" 'face 'bold))
+ (dolist (generic generics)
+ (insert (substitute-command-keys "`"))
+ (help-insert-xref-button (symbol-name generic)
+ 'help-function generic)
+ (insert (substitute-command-keys "'"))
+ (pcase-dolist (`(,qualifiers ,args ,doc)
+ (cl--generic-method-documentation generic type))
+ (insert (format " %s%S\n" qualifiers args)
+ (or doc "")))
+ (insert "\n\n"))))))
+
+(defun cl--describe-class-slot (slot)
+ (insert
+ (concat
+ (propertize "Slot: " 'face 'bold)
+ (prin1-to-string (cl--slot-descriptor-name slot))
+ (unless (eq (cl--slot-descriptor-type slot) t)
+ (concat " type = "
+ (prin1-to-string (cl--slot-descriptor-type slot))))
+ ;; FIXME: The default init form is treated differently for structs and for
+ ;; eieio objects: for structs, the default is nil, for eieio-objects
+ ;; it's a special "unbound" value.
+ (unless nil ;; (eq (cl--slot-descriptor-initform slot) eieio-unbound)
+ (concat " default = "
+ (prin1-to-string (cl--slot-descriptor-initform slot))))
+ (when (alist-get :printer (cl--slot-descriptor-props slot))
+ (concat " printer = "
+ (prin1-to-string
+ (alist-get :printer (cl--slot-descriptor-props slot)))))
+ (when (alist-get :documentation (cl--slot-descriptor-props slot))
+ (concat "\n "
+ (substitute-command-keys
+ (alist-get :documentation (cl--slot-descriptor-props slot)))
+ "\n")))
+ "\n"))
+
+(defun cl--describe-class-slots (class)
+ "Print help description for the slots in CLASS.
+Outputs to the current buffer."
+ (let* ((slots (cl--class-slots class))
+ ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch.
+ (metatype (cl--class-name (symbol-value (aref class 0))))
+ ;; ¡For EIEIO!
+ (cslots (condition-case nil
+ (cl-struct-slot-value metatype 'class-slots class)
+ (cl-struct-unknown-slot nil))))
+ (insert (propertize "Instance Allocated Slots:\n\n"
+ 'face 'bold))
+ (mapc #'cl--describe-class-slot slots)
+ (when (> (length cslots) 0)
+ (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
+ (mapc #'cl--describe-class-slot cslots))))
(run-hooks 'cl-extra-load-hook)
@@ -700,4 +886,5 @@ including `cl-block' and `cl-eval-when'."
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
+(provide 'cl-extra)
;;; cl-extra.el ends here
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
new file mode 100644
index 00000000000..aae517e8ea7
--- /dev/null
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -0,0 +1,1159 @@
+;;; cl-generic.el --- CLOS-style generic functions for Elisp -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Version: 1.0
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This implements the most of CLOS's multiple-dispatch generic functions.
+;; To use it you need either (require 'cl-generic) or (require 'cl-lib).
+;; The main entry points are: `cl-defgeneric' and `cl-defmethod'.
+
+;; Missing elements:
+;; - We don't support make-method, call-method, define-method-combination.
+;; CLOS's define-method-combination is IMO overly complicated, and it suffers
+;; from a significant problem: the method-combination code returns a sexp
+;; that needs to be `eval'uated or compiled. IOW it requires run-time
+;; code generation. Given how rarely method-combinations are used,
+;; I just provided a cl-generic-combine-methods generic function, to which
+;; people can add methods if they are really desperate for such functionality.
+;; - In defgeneric we don't support the options:
+;; declare, :method-combination, :generic-function-class, :method-class.
+;; Added elements:
+;; - We support aliases to generic functions.
+;; - cl-generic-generalizers. This generic function lets you extend the kind
+;; of thing on which to dispatch. There is support in this file for
+;; dispatch on:
+;; - (eql <val>)
+;; - (head <val>) which checks that the arg is a cons with <val> as its head.
+;; - plain old types
+;; - type of CL structs
+;; eieio-core adds dispatch on:
+;; - class of eieio objects
+;; - actual class argument, using the syntax (subclass <class>).
+;; - cl-generic-combine-methods (i.s.o define-method-combination and
+;; compute-effective-method).
+;; - cl-generic-call-method (which replaces make-method and call-method).
+;; - The standard method combination supports ":extra STRING" qualifiers
+;; which simply allows adding more methods for the same
+;; specializers&qualifiers.
+;; - Methods can dispatch on the context. For that, a method needs to specify
+;; context arguments, introduced by `&context' (which need to come right
+;; after the mandatory arguments and before anything like
+;; &optional/&rest/&key). Each context argument is given as (EXP SPECIALIZER)
+;; which means that EXP is taken as an expression which computes some context
+;; and this value is then used to dispatch.
+;; E.g. (foo &context (major-mode (eql c-mode))) is an arglist specifying
+;; that this method will only be applicable when `major-mode' has value
+;; `c-mode'.
+
+;; Efficiency considerations: overall, I've made an effort to make this fairly
+;; efficient for the expected case (e.g. no constant redefinition of methods).
+;; - Generic functions which do not dispatch on any argument are implemented
+;; optimally (just as efficient as plain old functions).
+;; - Generic functions which only dispatch on one argument are fairly efficient
+;; (not a lot of room for improvement without changes to the byte-compiler,
+;; I think).
+;; - Multiple dispatch is implemented rather naively. There's an extra `apply'
+;; function call for every dispatch; we don't optimize each dispatch
+;; based on the set of candidate methods remaining; we don't optimize the
+;; order in which we performs the dispatches either;
+;; If/when this becomes a problem, we can try and optimize it.
+;; - call-next-method could be made more efficient, but isn't too terrible.
+
+;; TODO:
+;;
+;; - A generic "filter" generalizer (e.g. could be used to cleanly add methods
+;; to cl-generic-combine-methods with a specializer that says it applies only
+;; when some particular qualifier is used).
+;; - A way to dispatch on the context (e.g. the major-mode, some global
+;; variable, you name it).
+
+;;; Code:
+
+;; Note: For generic functions that dispatch on several arguments (i.e. those
+;; which use the multiple-dispatch feature), we always use the same "tagcodes"
+;; and the same set of arguments on which to dispatch. This works, but is
+;; often suboptimal since after one dispatch, the remaining dispatches can
+;; usually be simplified, or even completely skipped.
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs)) ;For cl--find-class.
+(eval-when-compile (require 'pcase))
+
+(cl-defstruct (cl--generic-generalizer
+ (:constructor nil)
+ (:constructor cl-generic-make-generalizer
+ (name priority tagcode-function specializers-function)))
+ (name nil :type string)
+ (priority nil :type integer)
+ tagcode-function
+ specializers-function)
+
+
+(defmacro cl-generic-define-generalizer
+ (name priority tagcode-function specializers-function)
+ "Define a new kind of generalizer.
+NAME is the name of the variable that will hold it.
+PRIORITY defines which generalizer takes precedence.
+ The catch-all generalizer has priority 0.
+ Then `eql' generalizer has priority 100.
+TAGCODE-FUNCTION takes as first argument a varname and should return
+ a chunk of code that computes the tag of the value held in that variable.
+ Further arguments are reserved for future use.
+SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
+ and should return a list of specializers that match TAG.
+ Further arguments are reserved for future use."
+ (declare (indent 1) (debug (symbolp body)))
+ `(defconst ,name
+ (cl-generic-make-generalizer
+ ',name ,priority ,tagcode-function ,specializers-function)))
+
+(cl-generic-define-generalizer cl--generic-t-generalizer
+ 0 (lambda (_name &rest _) nil) (lambda (_tag &rest _) '(t)))
+
+(cl-defstruct (cl--generic-method
+ (:constructor nil)
+ (:constructor cl--generic-make-method
+ (specializers qualifiers uses-cnm function))
+ (:predicate nil))
+ (specializers nil :read-only t :type list)
+ (qualifiers nil :read-only t :type (list-of atom))
+ ;; USES-CNM is a boolean indicating if FUNCTION expects an extra argument
+ ;; holding the next-method.
+ (uses-cnm nil :read-only t :type boolean)
+ (function nil :read-only t :type function))
+
+(cl-defstruct (cl--generic
+ (:constructor nil)
+ (:constructor cl--generic-make (name))
+ (:predicate nil))
+ (name nil :type symbol :read-only t) ;Pointer back to the symbol.
+ ;; `dispatches' holds a list of (ARGNUM . TAGCODES) where ARGNUM is the index
+ ;; of the corresponding argument and TAGCODES is a list of (PRIORITY . EXP)
+ ;; where the EXPs are expressions (to be `or'd together) to compute the tag
+ ;; on which to dispatch and PRIORITY is the priority of each expression to
+ ;; decide in which order to sort them.
+ ;; The most important dispatch is last in the list (and the least is first).
+ (dispatches nil :type (list-of (cons natnum (list-of generalizers))))
+ (method-table nil :type (list-of cl--generic-method))
+ (options nil :type list))
+
+(defun cl-generic-function-options (generic)
+ "Return the options of the generic function GENERIC."
+ (cl--generic-options generic))
+
+(defmacro cl--generic (name)
+ `(get ,name 'cl--generic))
+
+(defun cl-generic-ensure-function (name &optional noerror)
+ (let (generic
+ (origname name))
+ (while (and (null (setq generic (cl--generic name)))
+ (fboundp name)
+ (null noerror)
+ (symbolp (symbol-function name)))
+ (setq name (symbol-function name)))
+ (unless (or (not (fboundp name))
+ (autoloadp (symbol-function name))
+ (and (functionp name) generic)
+ noerror)
+ (error "%s is already defined as something else than a generic function"
+ origname))
+ (if generic
+ (cl-assert (eq name (cl--generic-name generic)))
+ (setf (cl--generic name) (setq generic (cl--generic-make name)))
+ (defalias name (cl--generic-make-function generic)))
+ generic))
+
+;;;###autoload
+(defmacro cl-defgeneric (name args &rest options-and-methods)
+ "Create a generic function NAME.
+DOC-STRING is the base documentation for this class. A generic
+function has no body, as its purpose is to decide which method body
+is appropriate to use. Specific methods are defined with `cl-defmethod'.
+With this implementation the ARGS are currently ignored.
+OPTIONS-AND-METHODS currently understands:
+- (:documentation DOCSTRING)
+- (declare DECLARATIONS)
+- (:argument-precedence-order &rest ARGS)
+- (:method [QUALIFIERS...] ARGS &rest BODY)
+BODY, if present, is used as the body of a default method.
+
+\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest BODY)"
+ (declare (indent 2) (doc-string 3))
+ (let* ((doc (if (stringp (car-safe options-and-methods))
+ (pop options-and-methods)))
+ (declarations nil)
+ (methods ())
+ (options ())
+ next-head)
+ (while (progn (setq next-head (car-safe (car options-and-methods)))
+ (or (keywordp next-head)
+ (eq next-head 'declare)))
+ (pcase next-head
+ (`:documentation
+ (when doc (error "Multiple doc strings for %S" name))
+ (setq doc (cadr (pop options-and-methods))))
+ (`declare
+ (when declarations (error "Multiple `declare' for %S" name))
+ (setq declarations (pop options-and-methods)))
+ (`:method (push (cdr (pop options-and-methods)) methods))
+ (_ (push (pop options-and-methods) options))))
+ (when options-and-methods
+ ;; Anything remaining is assumed to be a default method body.
+ (push `(,args ,@options-and-methods) methods))
+ (when (eq 'setf (car-safe name))
+ (require 'gv)
+ (setq name (gv-setter (cadr name))))
+ `(progn
+ ,@(mapcar (lambda (declaration)
+ (let ((f (cdr (assq (car declaration)
+ defun-declarations-alist))))
+ (cond
+ (f (apply (car f) name args (cdr declaration)))
+ (t (message "Warning: Unknown defun property `%S' in %S"
+ (car declaration) name)
+ nil))))
+ (cdr declarations))
+ (defalias ',name
+ (cl-generic-define ',name ',args ',(nreverse options))
+ ,(help-add-fundoc-usage doc args))
+ ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method))
+ (nreverse methods)))))
+
+;;;###autoload
+(defun cl-generic-define (name args options)
+ (pcase-let* ((generic (cl-generic-ensure-function name 'noerror))
+ (`(,spec-args . ,_) (cl--generic-split-args args))
+ (mandatory (mapcar #'car spec-args))
+ (apo (assq :argument-precedence-order options)))
+ (unless (fboundp name)
+ ;; If the generic function was fmakunbound, throw away previous methods.
+ (setf (cl--generic-dispatches generic) nil)
+ (setf (cl--generic-method-table generic) nil))
+ (when apo
+ (dolist (arg (cdr apo))
+ (let ((pos (memq arg mandatory)))
+ (unless pos (error "%S is not a mandatory argument" arg))
+ (let* ((argno (- (length mandatory) (length pos)))
+ (dispatches (cl--generic-dispatches generic))
+ (dispatch (or (assq argno dispatches) (list argno))))
+ (setf (cl--generic-dispatches generic)
+ (cons dispatch (delq dispatch dispatches)))))))
+ (setf (cl--generic-options generic) options)
+ (cl--generic-make-function generic)))
+
+(defmacro cl-generic-current-method-specializers ()
+ "List of (VAR . TYPE) where TYPE is var's specializer.
+This macro can only be used within the lexical scope of a cl-generic method."
+ (error "cl-generic-current-method-specializers used outside of a method"))
+
+(defmacro cl-generic-define-context-rewriter (name args &rest body)
+ "Define a special kind of context named NAME.
+Whenever a context specializer of the form (NAME . ACTUALS) appears,
+the specializer used will be the one returned by BODY."
+ (declare (debug (&define name lambda-list def-body)) (indent defun))
+ `(eval-and-compile
+ (put ',name 'cl-generic--context-rewriter
+ (lambda ,args ,@body))))
+
+(eval-and-compile ;Needed while compiling the cl-defmethod calls below!
+ (defun cl--generic-fgrep (vars sexp) ;Copied from pcase.el.
+ "Check which of the symbols VARS appear in SEXP."
+ (let ((res '()))
+ (while (consp sexp)
+ (dolist (var (cl--generic-fgrep vars (pop sexp)))
+ (unless (memq var res) (push var res))))
+ (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
+ res))
+
+ (defun cl--generic-split-args (args)
+ "Return (SPEC-ARGS . PLAIN-ARGS)."
+ (let ((plain-args ())
+ (specializers nil)
+ (mandatory t))
+ (dolist (arg args)
+ (push (pcase arg
+ ((or '&optional '&rest '&key) (setq mandatory nil) arg)
+ ('&context
+ (unless mandatory
+ (error "&context not immediately after mandatory args"))
+ (setq mandatory 'context) nil)
+ ((let 'nil mandatory) arg)
+ ((let 'context mandatory)
+ (unless (consp arg)
+ (error "Invalid &context arg: %S" arg))
+ (let* ((name (car arg))
+ (rewriter
+ (and (symbolp name)
+ (get name 'cl-generic--context-rewriter))))
+ (if rewriter (setq arg (apply rewriter (cdr arg)))))
+ (push `((&context . ,(car arg)) . ,(cadr arg)) specializers)
+ nil)
+ (`(,name . ,type)
+ (push (cons name (car type)) specializers)
+ name)
+ (_
+ (push (cons arg t) specializers)
+ arg))
+ plain-args))
+ (cons (nreverse specializers)
+ (nreverse (delq nil plain-args)))))
+
+ (defun cl--generic-lambda (args body)
+ "Make the lambda expression for a method with ARGS and BODY."
+ (pcase-let* ((`(,spec-args . ,plain-args)
+ (cl--generic-split-args args))
+ (fun `(cl-function (lambda ,plain-args ,@body)))
+ (macroenv (cons `(cl-generic-current-method-specializers
+ . ,(lambda () spec-args))
+ macroexpand-all-environment)))
+ (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
+ ;; First macroexpand away the cl-function stuff (e.g. &key and
+ ;; destructuring args, `declare' and whatnot).
+ (pcase (macroexpand fun macroenv)
+ (`#'(lambda ,args . ,body)
+ (let* ((parsed-body (macroexp-parse-body body))
+ (cnm (make-symbol "cl--cnm"))
+ (nmp (make-symbol "cl--nmp"))
+ (nbody (macroexpand-all
+ `(cl-flet ((cl-call-next-method ,cnm)
+ (cl-next-method-p ,nmp))
+ ,@(cdr parsed-body))
+ macroenv))
+ ;; FIXME: Rather than `grep' after the fact, the
+ ;; macroexpansion should directly set some flag when cnm
+ ;; is used.
+ ;; FIXME: Also, optimize the case where call-next-method is
+ ;; only called with explicit arguments.
+ (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+ (cons (not (not uses-cnm))
+ `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
+ ,@(car parsed-body)
+ ,(if (not (memq nmp uses-cnm))
+ nbody
+ `(let ((,nmp (lambda ()
+ (cl--generic-isnot-nnm-p ,cnm))))
+ ,nbody))))))
+ (f (error "Unexpected macroexpansion result: %S" f))))))
+
+
+;;;###autoload
+(defmacro cl-defmethod (name args &rest body)
+ "Define a new method for generic function NAME.
+I.e. it defines the implementation of NAME to use for invocations where the
+value of the dispatch argument matches the specified TYPE.
+The dispatch argument has to be one of the mandatory arguments, and
+all methods of NAME have to use the same argument for dispatch.
+The dispatch argument and TYPE are specified in ARGS where the corresponding
+formal argument appears as (VAR TYPE) rather than just VAR.
+
+The optional second argument QUALIFIER is a specifier that
+modifies how the method is combined with other methods, including:
+ :before - Method will be called before the primary
+ :after - Method will be called after the primary
+ :around - Method will be called around everything else
+The absence of QUALIFIER means this is a \"primary\" method.
+
+Other than a type, TYPE can also be of the form `(eql VAL)' in
+which case this method will be invoked when the argument is `eql' to VAL.
+
+\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
+ (declare (doc-string 3) (indent 2)
+ (debug
+ (&define ; this means we are defining something
+ [&or name ("setf" :name setf name)]
+ ;; ^^ This is the methods symbol
+ [ &optional keywordp ] ; this is key :before etc
+ list ; arguments
+ [ &optional stringp ] ; documentation string
+ def-body))) ; part to be debugged
+ (let ((qualifiers nil))
+ (while (not (listp args))
+ (push args qualifiers)
+ (setq args (pop body)))
+ (when (eq 'setf (car-safe name))
+ (require 'gv)
+ (setq name (gv-setter (cadr name))))
+ (pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
+ `(progn
+ ,(and (get name 'byte-obsolete-info)
+ (or (not (fboundp 'byte-compile-warning-enabled-p))
+ (byte-compile-warning-enabled-p 'obsolete))
+ (let* ((obsolete (get name 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning name obsolete "generic function")
+ nil)))
+ ;; You could argue that `defmethod' modifies rather than defines the
+ ;; function, so warnings like "not known to be defined" are fair game.
+ ;; But in practice, it's common to use `cl-defmethod'
+ ;; without a previous `cl-defgeneric'.
+ (declare-function ,name "")
+ (cl-generic-define-method ',name ',(nreverse qualifiers) ',args
+ ,uses-cnm ,fun)))))
+
+(defun cl--generic-member-method (specializers qualifiers methods)
+ (while
+ (and methods
+ (let ((m (car methods)))
+ (not (and (equal (cl--generic-method-specializers m) specializers)
+ (equal (cl--generic-method-qualifiers m) qualifiers)))))
+ (setq methods (cdr methods)))
+ methods)
+
+;;;###autoload
+(defun cl-generic-define-method (name qualifiers args uses-cnm function)
+ (pcase-let*
+ ((generic (cl-generic-ensure-function name))
+ (`(,spec-args . ,_) (cl--generic-split-args args))
+ (specializers (mapcar (lambda (spec-arg)
+ (if (eq '&context (car-safe (car spec-arg)))
+ spec-arg (cdr spec-arg)))
+ spec-args))
+ (method (cl--generic-make-method
+ specializers qualifiers uses-cnm function))
+ (mt (cl--generic-method-table generic))
+ (me (cl--generic-member-method specializers qualifiers mt))
+ (dispatches (cl--generic-dispatches generic))
+ (i 0))
+ (dolist (spec-arg spec-args)
+ (let* ((key (if (eq '&context (car-safe (car spec-arg)))
+ (car spec-arg) i))
+ (generalizers (cl-generic-generalizers (cdr spec-arg)))
+ (x (assoc key dispatches)))
+ (unless x
+ (setq x (cons key (cl-generic-generalizers t)))
+ (setf (cl--generic-dispatches generic)
+ (setq dispatches (cons x dispatches))))
+ (dolist (generalizer generalizers)
+ (unless (member generalizer (cdr x))
+ (setf (cdr x)
+ (sort (cons generalizer (cdr x))
+ (lambda (x y)
+ (> (cl--generic-generalizer-priority x)
+ (cl--generic-generalizer-priority y)))))))
+ (setq i (1+ i))))
+ ;; We used to (setcar me method), but that can cause false positives in
+ ;; the hash-consing table of the method-builder (bug#20644).
+ ;; See also the related FIXME in cl--generic-build-combined-method.
+ (setf (cl--generic-method-table generic)
+ (if (null me)
+ (cons method mt)
+ ;; Keep the ordering; important for methods with :extra qualifiers.
+ (mapcar (lambda (x) (if (eq x (car me)) method x)) mt)))
+ (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
+ current-load-list :test #'equal)
+ ;; FIXME: Try to avoid re-constructing a new function if the old one
+ ;; is still valid (e.g. still empty method cache)?
+ (let ((gfun (cl--generic-make-function generic))
+ ;; Prevent `defalias' from recording this as the definition site of
+ ;; the generic function.
+ current-load-list)
+ ;; For aliases, cl--generic-name gives us the actual name.
+ (let ((purify-flag
+ ;; BEWARE! Don't purify this function definition, since that leads
+ ;; to memory corruption if the hash-tables it holds are modified
+ ;; (the GC doesn't trace those pointers).
+ nil))
+ ;; But do use `defalias', so that it interacts properly with nadvice,
+ ;; e.g. for tracing/debug-on-entry.
+ (defalias (cl--generic-name generic) gfun)))))
+
+(defmacro cl--generic-with-memoization (place &rest code)
+ (declare (indent 1) (debug t))
+ (gv-letplace (getter setter) place
+ `(or ,getter
+ ,(macroexp-let2 nil val (macroexp-progn code)
+ `(progn
+ ,(funcall setter val)
+ ,val)))))
+
+(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
+
+(defun cl--generic-get-dispatcher (dispatch)
+ (cl--generic-with-memoization
+ (gethash dispatch cl--generic-dispatchers)
+ ;; (message "cl--generic-get-dispatcher (%S)" dispatch)
+ (let* ((dispatch-arg (car dispatch))
+ (generalizers (cdr dispatch))
+ (lexical-binding t)
+ (tagcodes
+ (mapcar (lambda (generalizer)
+ (funcall (cl--generic-generalizer-tagcode-function
+ generalizer)
+ 'arg))
+ generalizers))
+ (typescodes
+ (mapcar
+ (lambda (generalizer)
+ `(funcall ',(cl--generic-generalizer-specializers-function
+ generalizer)
+ ,(funcall (cl--generic-generalizer-tagcode-function
+ generalizer)
+ 'arg)))
+ generalizers))
+ (tag-exp
+ ;; Minor optimization: since this tag-exp is
+ ;; only used to lookup the method-cache, it
+ ;; doesn't matter if the default value is some
+ ;; constant or nil.
+ `(or ,@(if (macroexp-const-p (car (last tagcodes)))
+ (butlast tagcodes)
+ tagcodes)))
+ (fixedargs '(arg))
+ (dispatch-idx dispatch-arg)
+ (bindings nil))
+ (when (eq '&context (car-safe dispatch-arg))
+ (setq bindings `((arg ,(cdr dispatch-arg))))
+ (setq fixedargs nil)
+ (setq dispatch-idx 0))
+ (dotimes (i dispatch-idx)
+ (push (make-symbol (format "arg%d" (- dispatch-idx i 1))) fixedargs))
+ ;; FIXME: For generic functions with a single method (or with 2 methods,
+ ;; one of which always matches), using a tagcode + hash-table is
+ ;; overkill: better just use a `cl-typep' test.
+ (byte-compile
+ `(lambda (generic dispatches-left methods)
+ (let ((method-cache (make-hash-table :test #'eql)))
+ (lambda (,@fixedargs &rest args)
+ (let ,bindings
+ (apply (cl--generic-with-memoization
+ (gethash ,tag-exp method-cache)
+ (cl--generic-cache-miss
+ generic ',dispatch-arg dispatches-left methods
+ ,(if (cdr typescodes)
+ `(append ,@typescodes) (car typescodes))))
+ ,@fixedargs args)))))))))
+
+(defun cl--generic-make-function (generic)
+ (cl--generic-make-next-function generic
+ (cl--generic-dispatches generic)
+ (cl--generic-method-table generic)))
+
+(defun cl--generic-make-next-function (generic dispatches methods)
+ (let* ((dispatch
+ (progn
+ (while (and dispatches
+ (let ((x (nth 1 (car dispatches))))
+ ;; No need to dispatch for t specializers.
+ (or (null x) (equal x cl--generic-t-generalizer))))
+ (setq dispatches (cdr dispatches)))
+ (pop dispatches))))
+ (if (not (and dispatch
+ ;; If there's no method left, there's no point checking
+ ;; further arguments.
+ methods))
+ (cl--generic-build-combined-method generic methods)
+ (let ((dispatcher (cl--generic-get-dispatcher dispatch)))
+ (funcall dispatcher generic dispatches methods)))))
+
+(defvar cl--generic-combined-method-memoization
+ (make-hash-table :test #'equal :weakness 'value)
+ "Table storing previously built combined-methods.
+This is particularly useful when many different tags select the same set
+of methods, since this table then allows us to share a single combined-method
+for all those different tags in the method-cache.")
+
+(define-error 'cl--generic-cyclic-definition "Cyclic definition: %S")
+
+(defun cl--generic-build-combined-method (generic methods)
+ (if (null methods)
+ ;; Special case needed to fix a circularity during bootstrap.
+ (cl--generic-standard-method-combination generic methods)
+ (let ((f
+ (cl--generic-with-memoization
+ ;; FIXME: Since the fields of `generic' are modified, this
+ ;; hash-table won't work right, because the hashes will change!
+ ;; It's not terribly serious, but reduces the effectiveness of
+ ;; the table.
+ (gethash (cons generic methods)
+ cl--generic-combined-method-memoization)
+ (puthash (cons generic methods) :cl--generic--under-construction
+ cl--generic-combined-method-memoization)
+ (condition-case nil
+ (cl-generic-combine-methods generic methods)
+ ;; Special case needed to fix a circularity during bootstrap.
+ (cl--generic-cyclic-definition
+ (cl--generic-standard-method-combination generic methods))))))
+ (if (eq f :cl--generic--under-construction)
+ (signal 'cl--generic-cyclic-definition
+ (list (cl--generic-name generic)))
+ f))))
+
+(defun cl--generic-no-next-method-function (generic method)
+ (lambda (&rest args)
+ (apply #'cl-no-next-method generic method args)))
+
+(defun cl-generic-call-method (generic method &optional fun)
+ "Return a function that calls METHOD.
+FUN is the function that should be called when METHOD calls
+`call-next-method'."
+ (if (not (cl--generic-method-uses-cnm method))
+ (cl--generic-method-function method)
+ (let ((met-fun (cl--generic-method-function method))
+ (next (or fun (cl--generic-no-next-method-function
+ generic method))))
+ (lambda (&rest args)
+ (apply met-fun
+ ;; FIXME: This sucks: passing just `next' would
+ ;; be a lot more efficient than the lambda+apply
+ ;; quasi-η, but we need this to implement the
+ ;; "if call-next-method is called with no
+ ;; arguments, then use the previous arguments".
+ (lambda (&rest cnm-args)
+ (apply next (or cnm-args args)))
+ args)))))
+
+;; Standard CLOS name.
+(defalias 'cl-method-qualifiers #'cl--generic-method-qualifiers)
+
+(defun cl--generic-standard-method-combination (generic methods)
+ (let ((mets-by-qual ()))
+ (dolist (method methods)
+ (let ((qualifiers (cl-method-qualifiers method)))
+ (if (eq (car qualifiers) :extra) (setq qualifiers (cddr qualifiers)))
+ (unless (member qualifiers '(() (:after) (:before) (:around)))
+ (error "Unsupported qualifiers in function %S: %S"
+ (cl--generic-name generic) qualifiers))
+ (push method (alist-get (car qualifiers) mets-by-qual))))
+ (cond
+ ((null mets-by-qual)
+ (lambda (&rest args)
+ (apply #'cl-no-applicable-method generic args)))
+ ((null (alist-get nil mets-by-qual))
+ (lambda (&rest args)
+ (apply #'cl-no-primary-method generic args)))
+ (t
+ (let* ((fun nil)
+ (ab-call (lambda (m) (cl-generic-call-method generic m)))
+ (before
+ (mapcar ab-call (reverse (cdr (assoc :before mets-by-qual)))))
+ (after (mapcar ab-call (cdr (assoc :after mets-by-qual)))))
+ (dolist (method (cdr (assoc nil mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ (when (or after before)
+ (let ((next fun))
+ (setq fun (lambda (&rest args)
+ (dolist (bf before)
+ (apply bf args))
+ (prog1
+ (apply next args)
+ (dolist (af after)
+ (apply af args)))))))
+ (dolist (method (cdr (assoc :around mets-by-qual)))
+ (setq fun (cl-generic-call-method generic method fun)))
+ fun)))))
+
+(defun cl--generic-arg-specializer (method dispatch-arg)
+ (or (if (integerp dispatch-arg)
+ (nth dispatch-arg
+ (cl--generic-method-specializers method))
+ (cdr (assoc dispatch-arg
+ (cl--generic-method-specializers method))))
+ t))
+
+(defun cl--generic-cache-miss (generic
+ dispatch-arg dispatches-left methods-left types)
+ (let ((methods '()))
+ (dolist (method methods-left)
+ (let* ((specializer (cl--generic-arg-specializer method dispatch-arg))
+ (m (member specializer types)))
+ (when m
+ (push (cons (length m) method) methods))))
+ ;; Sort the methods, most specific first.
+ ;; It would be tempting to sort them once and for all in the method-table
+ ;; rather than here, but the order might depend on the actual argument
+ ;; (e.g. for multiple inheritance with defclass).
+ (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car))))
+ (cl--generic-make-next-function generic dispatches-left methods)))
+
+(cl-defgeneric cl-generic-generalizers (specializer)
+ "Return a list of generalizers for a given SPECIALIZER.
+To each kind of `specializer', corresponds a `generalizer' which describes
+how to extract a \"tag\" from an object which will then let us check if this
+object matches the specializer. A typical example of a \"tag\" would be the
+type of an object. It's called a `generalizer' because it
+takes a specific object and returns a more general approximation,
+denoting a set of objects to which it belongs.
+A generalizer gives us the chunk of code which the
+dispatch function needs to use to extract the \"tag\" of an object, as well
+as a function which turns this tag into an ordered list of
+`specializers' that this object matches.
+The code which extracts the tag should be as fast as possible.
+The tags should be chosen according to the following rules:
+- The tags should not be too specific: similar objects which match the
+ same list of specializers should ideally use the same (`eql') tag.
+ This insures that the cached computation of the applicable
+ methods for one object can be reused for other objects.
+- Corollary: objects which don't match any of the relevant specializers
+ should ideally all use the same tag (typically nil).
+ This insures that this cache does not grow unnecessarily large.
+- Two different generalizers G1 and G2 should not use the same tag
+ unless they use it for the same set of objects. IOW, if G1.tag(X1) =
+ G2.tag(X2) then G1.tag(X1) = G2.tag(X1) = G1.tag(X2) = G2.tag(X2).
+- If G1.priority > G2.priority and G1.tag(X1) = G1.tag(X2) and this tag is
+ non-nil, then you have to make sure that the G2.tag(X1) = G2.tag(X2).
+ This is because the method-cache is only indexed with the first non-nil
+ tag (by order of decreasing priority).")
+
+(cl-defgeneric cl-generic-combine-methods (generic methods)
+ "Build the effective method made of METHODS.
+It should return a function that expects the same arguments as the methods, and
+ calls those methods in some appropriate order.
+GENERIC is the generic function (mostly used for its name).
+METHODS is the list of the selected methods.
+The METHODS list is sorted from most specific first to most generic last.
+The function can use `cl-generic-call-method' to create functions that call those
+methods.")
+
+(unless (ignore-errors (cl-generic-generalizers t))
+ ;; Temporary definition to let the next defmethod succeed.
+ (fset 'cl-generic-generalizers
+ (lambda (specializer)
+ (if (eq t specializer) (list cl--generic-t-generalizer))))
+ (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination))
+
+(cl-defmethod cl-generic-generalizers (specializer)
+ "Support for the catch-all t specializer."
+ (if (eq specializer t) (list cl--generic-t-generalizer)
+ (error "Unknown specializer %S" specializer)))
+
+(eval-when-compile
+ ;; This macro is brittle and only really important in order to be
+ ;; able to preload cl-generic without also preloading the byte-compiler,
+ ;; So we use `eval-when-compile' so as not keep it available longer than
+ ;; strictly needed.
+(defmacro cl--generic-prefill-dispatchers (arg-or-context specializer)
+ (unless (integerp arg-or-context)
+ (setq arg-or-context `(&context . ,arg-or-context)))
+ (unless (fboundp 'cl--generic-get-dispatcher)
+ (require 'cl-generic))
+ (let ((fun (cl--generic-get-dispatcher
+ `(,arg-or-context ,@(cl-generic-generalizers specializer)
+ ,cl--generic-t-generalizer))))
+ ;; Recompute dispatch at run-time, since the generalizers may be slightly
+ ;; different (e.g. byte-compiled rather than interpreted).
+ ;; FIXME: There is a risk that the run-time generalizer is not equivalent
+ ;; to the compile-time one, in which case `fun' may not be correct
+ ;; any more!
+ `(let ((dispatch `(,',arg-or-context
+ ,@(cl-generic-generalizers ',specializer)
+ ,cl--generic-t-generalizer)))
+ ;; (message "Prefilling for %S with \n%S" dispatch ',fun)
+ (puthash dispatch ',fun cl--generic-dispatchers)))))
+
+(cl-defmethod cl-generic-combine-methods (generic methods)
+ "Standard support for :after, :before, :around, and `:extra NAME' qualifiers."
+ (cl--generic-standard-method-combination generic methods))
+
+(defconst cl--generic-nnm-sample (cl--generic-no-next-method-function t t))
+(defconst cl--generic-cnm-sample
+ (funcall (cl--generic-build-combined-method
+ nil (list (cl--generic-make-method () () t #'identity)))))
+
+(defun cl--generic-isnot-nnm-p (cnm)
+ "Return non-nil if CNM is the function that calls `cl-no-next-method'."
+ ;; ¡Big Gross Ugly Hack!
+ ;; `next-method-p' just sucks, we should let it die. But EIEIO did support
+ ;; it, and some packages use it, so we need to support it.
+ (catch 'found
+ (cl-assert (function-equal cnm cl--generic-cnm-sample))
+ (if (byte-code-function-p cnm)
+ (let ((cnm-constants (aref cnm 2))
+ (sample-constants (aref cl--generic-cnm-sample 2)))
+ (dotimes (i (length sample-constants))
+ (when (function-equal (aref sample-constants i)
+ cl--generic-nnm-sample)
+ (throw 'found
+ (not (function-equal (aref cnm-constants i)
+ cl--generic-nnm-sample))))))
+ (cl-assert (eq 'closure (car-safe cl--generic-cnm-sample)))
+ (let ((cnm-env (cadr cnm)))
+ (dolist (vb (cadr cl--generic-cnm-sample))
+ (when (function-equal (cdr vb) cl--generic-nnm-sample)
+ (throw 'found
+ (not (function-equal (cdar cnm-env)
+ cl--generic-nnm-sample))))
+ (setq cnm-env (cdr cnm-env)))))
+ (error "Haven't found no-next-method-sample in cnm-sample")))
+
+;;; Define some pre-defined generic functions, used internally.
+
+(define-error 'cl-no-method "No method for %S")
+(define-error 'cl-no-next-method "No next method for %S" 'cl-no-method)
+(define-error 'cl-no-primary-method "No primary method for %S" 'cl-no-method)
+(define-error 'cl-no-applicable-method "No applicable method for %S"
+ 'cl-no-method)
+
+(cl-defgeneric cl-no-next-method (generic method &rest args)
+ "Function called when `cl-call-next-method' finds no next method."
+ (signal 'cl-no-next-method `(,(cl--generic-name generic) ,method ,@args)))
+
+(cl-defgeneric cl-no-applicable-method (generic &rest args)
+ "Function called when a method call finds no applicable method."
+ (signal 'cl-no-applicable-method `(,(cl--generic-name generic) ,@args)))
+
+(cl-defgeneric cl-no-primary-method (generic &rest args)
+ "Function called when a method call finds no primary method."
+ (signal 'cl-no-primary-method `(,(cl--generic-name generic) ,@args)))
+
+(defun cl-call-next-method (&rest _args)
+ "Function to call the next applicable method.
+Can only be used from within the lexical body of a primary or around method."
+ (error "cl-call-next-method only allowed inside primary and around methods"))
+
+(defun cl-next-method-p ()
+ "Return non-nil if there is a next method.
+Can only be used from within the lexical body of a primary or around method."
+ (declare (obsolete "make sure there's always a next method, or catch `cl-no-next-method' instead" "25.1"))
+ (error "cl-next-method-p only allowed inside primary and around methods"))
+
+;;;###autoload
+(defun cl-find-method (generic qualifiers specializers)
+ (car (cl--generic-member-method
+ specializers qualifiers
+ (cl--generic-method-table (cl--generic generic)))))
+
+;;; Add support for describe-function
+
+(defun cl--generic-search-method (met-name)
+ "For `find-function-regexp-alist'. Searches for a cl-defmethod.
+MET-NAME is a cons (SYMBOL . SPECIALIZERS)."
+ (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
+ (regexp-quote (format "%s" (car met-name)))
+ "\\_>")))
+ (or
+ (re-search-forward
+ (concat base-re "[^&\"\n]*"
+ (mapconcat (lambda (specializer)
+ (regexp-quote
+ (format "%S" (if (consp specializer)
+ (nth 1 specializer) specializer))))
+ (remq t (cdr met-name))
+ "[ \t\n]*)[^&\"\n]*"))
+ nil t)
+ (re-search-forward base-re nil t))))
+
+;; WORKAROUND: This can't be a defconst due to bug#21237.
+(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[ \t]+%s\\>")
+
+(with-eval-after-load 'find-func
+ (defvar find-function-regexp-alist)
+ (add-to-list 'find-function-regexp-alist
+ `(cl-defmethod . ,#'cl--generic-search-method))
+ (add-to-list 'find-function-regexp-alist
+ `(cl-defgeneric . cl--generic-find-defgeneric-regexp)))
+
+(defun cl--generic-method-info (method)
+ (let* ((specializers (cl--generic-method-specializers method))
+ (qualifiers (cl--generic-method-qualifiers method))
+ (uses-cnm (cl--generic-method-uses-cnm method))
+ (function (cl--generic-method-function method))
+ (args (help-function-arglist function 'names))
+ (docstring (documentation function))
+ (qual-string
+ (if (null qualifiers) ""
+ (cl-assert (consp qualifiers))
+ (let ((s (prin1-to-string qualifiers)))
+ (concat (substring s 1 -1) " "))))
+ (doconly (if docstring
+ (let ((split (help-split-fundoc docstring nil)))
+ (if split (cdr split) docstring))))
+ (combined-args ()))
+ (if uses-cnm (setq args (cdr args)))
+ (dolist (specializer specializers)
+ (let ((arg (if (eq '&rest (car args))
+ (intern (format "arg%d" (length combined-args)))
+ (pop args))))
+ (push (if (eq specializer t) arg (list arg specializer))
+ combined-args)))
+ (setq combined-args (append (nreverse combined-args) args))
+ (list qual-string combined-args doconly)))
+
+(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
+(defun cl--generic-describe (function)
+ ;; Supposedly this is called from help-fns, so help-fns should be loaded at
+ ;; this point.
+ (declare-function help-fns-short-filename "help-fns" (filename))
+ (let ((generic (if (symbolp function) (cl--generic function))))
+ (when generic
+ (require 'help-mode) ;Needed for `help-function-def' button!
+ (save-excursion
+ (insert "\n\nThis is a generic function.\n\n")
+ (insert (propertize "Implementations:\n\n" 'face 'bold))
+ ;; Loop over fanciful generics
+ (dolist (method (cl--generic-method-table generic))
+ (let* ((info (cl--generic-method-info method)))
+ ;; FIXME: Add hyperlinks for the types as well.
+ (insert (format "%s%S" (nth 0 info) (nth 1 info)))
+ (let* ((met-name (cons function
+ (cl--generic-method-specializers method)))
+ (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+ (when file
+ (insert (substitute-command-keys " in `"))
+ (help-insert-xref-button (help-fns-short-filename file)
+ 'help-function-def met-name file
+ 'cl-defmethod)
+ (insert (substitute-command-keys "'.\n"))))
+ (insert "\n" (or (nth 2 info) "Undocumented") "\n\n")))))))
+
+(defun cl--generic-specializers-apply-to-type-p (specializers type)
+ "Return non-nil if a method with SPECIALIZERS applies to TYPE."
+ (let ((applies nil))
+ (dolist (specializer specializers)
+ (if (memq (car-safe specializer) '(subclass eieio--static))
+ (setq specializer (nth 1 specializer)))
+ ;; Don't include the methods that are "too generic", such as those
+ ;; applying to `eieio-default-superclass'.
+ (and (not (memq specializer '(t eieio-default-superclass)))
+ (or (equal type specializer)
+ (when (symbolp specializer)
+ (let ((sclass (cl--find-class specializer))
+ (tclass (cl--find-class type)))
+ (when (and sclass tclass)
+ (member specializer (cl--generic-class-parents tclass))))))
+ (setq applies t)))
+ applies))
+
+(defun cl--generic-all-functions (&optional type)
+ "Return a list of all generic functions.
+Optional TYPE argument returns only those functions that contain
+methods for TYPE."
+ (let ((l nil))
+ (mapatoms
+ (lambda (symbol)
+ (let ((generic (and (fboundp symbol) (cl--generic symbol))))
+ (and generic
+ (catch 'found
+ (if (null type) (throw 'found t))
+ (dolist (method (cl--generic-method-table generic))
+ (if (cl--generic-specializers-apply-to-type-p
+ (cl--generic-method-specializers method) type)
+ (throw 'found t))))
+ (push symbol l)))))
+ l))
+
+(defun cl--generic-method-documentation (function type)
+ "Return info for all methods of FUNCTION (a symbol) applicable to TYPE.
+The value returned is a list of elements of the form
+\(QUALIFIERS ARGS DOC)."
+ (let ((generic (cl--generic function))
+ (docs ()))
+ (when generic
+ (dolist (method (cl--generic-method-table generic))
+ (when (cl--generic-specializers-apply-to-type-p
+ (cl--generic-method-specializers method) type)
+ (push (cl--generic-method-info method) docs))))
+ docs))
+
+;;; Support for (head <val>) specializers.
+
+;; For both the `eql' and the `head' specializers, the dispatch
+;; is unsatisfactory. Basically, in the "common&fast case", we end up doing
+;;
+;; (let ((tag (gethash value <tagcode-hashtable>)))
+;; (funcall (gethash tag <method-cache>)))
+;;
+;; whereas we'd like to just do
+;;
+;; (funcall (gethash value <method-cache>)))
+;;
+;; but the problem is that the method-cache is normally "open ended", so
+;; a nil means "not computed yet" and if we bump into it, we dutifully fill the
+;; corresponding entry, whereas we'd want to just fallback on some default
+;; effective method (so as not to fill the cache with lots of redundant
+;; entries).
+
+(defvar cl--generic-head-used (make-hash-table :test #'eql))
+
+(cl-generic-define-generalizer cl--generic-head-generalizer
+ 80 (lambda (name &rest _) `(gethash (car-safe ,name) cl--generic-head-used))
+ (lambda (tag &rest _) (if (eq (car-safe tag) 'head) (list tag))))
+
+(cl-defmethod cl-generic-generalizers :extra "head" (specializer)
+ "Support for the `(head VAL)' specializers."
+ ;; We have to implement `head' here using the :extra qualifier,
+ ;; since we can't use the `head' specializer to implement itself.
+ (if (not (eq (car-safe specializer) 'head))
+ (cl-call-next-method)
+ (cl--generic-with-memoization
+ (gethash (cadr specializer) cl--generic-head-used) specializer)
+ (list cl--generic-head-generalizer)))
+
+(cl--generic-prefill-dispatchers 0 (head eql))
+
+;;; Support for (eql <val>) specializers.
+
+(defvar cl--generic-eql-used (make-hash-table :test #'eql))
+
+(cl-generic-define-generalizer cl--generic-eql-generalizer
+ 100 (lambda (name &rest _) `(gethash ,name cl--generic-eql-used))
+ (lambda (tag &rest _) (if (eq (car-safe tag) 'eql) (list tag))))
+
+(cl-defmethod cl-generic-generalizers ((specializer (head eql)))
+ "Support for the `(eql VAL)' specializers."
+ (puthash (cadr specializer) specializer cl--generic-eql-used)
+ (list cl--generic-eql-generalizer))
+
+(cl--generic-prefill-dispatchers 0 (eql nil))
+(cl--generic-prefill-dispatchers window-system (eql nil))
+
+;;; Support for cl-defstructs specializers.
+
+(defun cl--generic-struct-tag (name &rest _)
+ ;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
+ ;; but that would suffer from some problems:
+ ;; - the vector may have size 0.
+ ;; - when called on an actual vector (rather than an object), we'd
+ ;; end up returning an arbitrary value, possibly colliding with
+ ;; other tagcode's values.
+ ;; - it can also result in returning all kinds of irrelevant
+ ;; values which would end up filling up the method-cache with
+ ;; lots of irrelevant/redundant entries.
+ ;; FIXME: We could speed this up by introducing a dedicated
+ ;; vector type at the C level, so we could do something like
+ ;; (and (vector-objectp ,name) (aref ,name 0))
+ `(and (vectorp ,name)
+ (> (length ,name) 0)
+ (let ((tag (aref ,name 0)))
+ (and (symbolp tag)
+ (eq (symbol-function tag) :quick-object-witness-check)
+ tag))))
+
+(defun cl--generic-class-parents (class)
+ (let ((parents ())
+ (classes (list class)))
+ ;; BFS precedence. FIXME: Use a topological sort.
+ (while (let ((class (pop classes)))
+ (cl-pushnew (cl--class-name class) parents)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse parents)))
+
+(defun cl--generic-struct-specializers (tag &rest _)
+ (and (symbolp tag) (boundp tag)
+ (let ((class (symbol-value tag)))
+ (when (cl-typep class 'cl-structure-class)
+ (cl--generic-class-parents class)))))
+
+(cl-generic-define-generalizer cl--generic-struct-generalizer
+ 50 #'cl--generic-struct-tag
+ #'cl--generic-struct-specializers)
+
+(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
+ "Support for dispatch on cl-struct types."
+ (or
+ (when (symbolp type)
+ ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
+ ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
+ ;; take place without requiring cl-lib.
+ (let ((class (cl--find-class type)))
+ (and (cl-typep class 'cl-structure-class)
+ (or (null (cl--struct-class-type class))
+ (error "Can't dispatch on cl-struct %S: type is %S"
+ type (cl--struct-class-type class)))
+ (progn (cl-assert (null (cl--struct-class-named class))) t)
+ (list cl--generic-struct-generalizer))))
+ (cl-call-next-method)))
+
+(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
+
+;;; Dispatch on "system types".
+
+(defconst cl--generic-typeof-types
+ ;; Hand made from the source code of `type-of'.
+ '((integer number) (symbol) (string array sequence) (cons list sequence)
+ ;; Markers aren't `numberp', yet they are accepted wherever integers are
+ ;; accepted, pretty much.
+ (marker) (overlay) (float number) (window-configuration)
+ (process) (window) (subr) (compiled-function) (buffer)
+ (char-table array sequence)
+ (bool-vector array sequence)
+ (frame) (hash-table) (font-spec) (font-entity) (font-object)
+ (vector array sequence)
+ ;; Plus, hand made:
+ (null symbol list sequence)
+ (list sequence)
+ (array sequence)
+ (sequence)
+ (number)))
+
+(cl-generic-define-generalizer cl--generic-typeof-generalizer
+ ;; FIXME: We could also change `type-of' to return `null' for nil.
+ 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
+ (lambda (tag &rest _)
+ (and (symbolp tag) (assq tag cl--generic-typeof-types))))
+
+(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
+ "Support for dispatch on builtin types."
+ ;; FIXME: Add support for other types accepted by `cl-typep' such
+ ;; as `character', `atom', `face', `function', ...
+ (or
+ (and (assq type cl--generic-typeof-types)
+ (progn
+ ;; FIXME: While this wrinkle in the semantics can be occasionally
+ ;; problematic, this warning is more often annoying than helpful.
+ ;;(if (memq type '(vector array sequence))
+ ;; (message "`%S' also matches CL structs and EIEIO classes"
+ ;; type))
+ (list cl--generic-typeof-generalizer)))
+ (cl-call-next-method)))
+
+(cl--generic-prefill-dispatchers 0 integer)
+
+;;; Dispatch on major mode.
+
+;; Two parts:
+;; - first define a specializer (derived-mode <mode>) to match symbols
+;; representing major modes, while obeying the major mode hierarchy.
+;; - then define a context-rewriter so you can write
+;; "&context (major-mode c-mode)" rather than
+;; "&context (major-mode (derived-mode c-mode))".
+
+(defun cl--generic-derived-specializers (mode &rest _)
+ ;; FIXME: Handle (derived-mode <mode1> ... <modeN>)
+ (let ((specializers ()))
+ (while mode
+ (push `(derived-mode ,mode) specializers)
+ (setq mode (get mode 'derived-mode-parent)))
+ (nreverse specializers)))
+
+(cl-generic-define-generalizer cl--generic-derived-generalizer
+ 90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name))
+ #'cl--generic-derived-specializers)
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head derived-mode)))
+ "Support for the `(derived-mode MODE)' specializers."
+ (list cl--generic-derived-generalizer))
+
+(cl-generic-define-context-rewriter major-mode (mode &rest modes)
+ `(major-mode ,(if (consp mode)
+ ;;E.g. could be (eql ...)
+ (progn (cl-assert (null modes)) mode)
+ `(derived-mode ,mode . ,modes))))
+
+;; Local variables:
+;; generated-autoload-file: "cl-loaddefs.el"
+;; End:
+
+(provide 'cl-generic)
+;;; cl-generic.el ends here
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index bbfe9ec6424..5134e50fa3b 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -1,10 +1,10 @@
;;; cl-indent.el --- enhanced lisp-indent mode
-;; Copyright (C) 1987, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2015 Free Software Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
;; Created: July 1987
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools
;; Package: emacs
@@ -27,6 +27,8 @@
;; This package supplies a single entry point, common-lisp-indent-function,
;; which performs indentation in the preferred style for Common Lisp code.
+;; It is also a suitable function for indenting Emacs lisp code.
+;;
;; To enable it:
;;
;; (setq lisp-indent-function 'common-lisp-indent-function)
@@ -136,6 +138,19 @@ If non-nil, alignment is done with the first parameter
:type 'boolean
:group 'lisp-indent)
+(defcustom lisp-indent-backquote-substitution-mode t
+ "How to indent substitutions in backquotes.
+If t, the default, indent substituted forms normally.
+If nil, do not apply special indentation rule to substituted
+forms. If `corrected', subtract the `,' or `,@' from the form
+column, indenting as if this character sequence were not present.
+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)
+
(defvar lisp-indent-defun-method '(4 &lambda &body)
"Defun-like indentation method.
@@ -143,7 +158,7 @@ This applies when the value of the `common-lisp-indent-function' property
is set to `defun'.")
-(defun extended-loop-p (loop-start)
+(defun lisp-extended-loop-p (loop-start)
"True if an extended loop form starts at LOOP-START."
(condition-case ()
(save-excursion
@@ -154,16 +169,36 @@ is set to `defun'.")
(looking-at "\\sw"))
(error t)))
+(defun lisp-indent-find-method (symbol &optional no-compat)
+ "Find the lisp indentation function for SYMBOL.
+If NO-COMPAT is non-nil, do not retrieve indenters intended for
+the standard lisp indent package."
+ (or (and (derived-mode-p 'emacs-lisp-mode)
+ (get symbol 'common-lisp-indent-function-for-elisp))
+ (get symbol 'common-lisp-indent-function)
+ (and (not no-compat)
+ (get symbol 'lisp-indent-function))))
(defun common-lisp-loop-part-indentation (indent-point state)
"Compute the indentation of loop form constituents."
(let* ((loop-indentation (save-excursion
(goto-char (elt state 1))
- (current-column))))
+ (current-column))))
+ (when (and (eq lisp-indent-backquote-substitution-mode 'corrected))
+ (save-excursion
+ (goto-char (elt state 1))
+ (incf loop-indentation
+ (cond ((eq (char-before) ?,) -1)
+ ((and (eq (char-before) ?@)
+ (progn (backward-char)
+ (eq (char-before) ?,)))
+ -2)
+ (t 0)))))
+
(goto-char indent-point)
(beginning-of-line)
(list
- (cond ((not (extended-loop-p (elt state 1)))
+ (cond ((not (lisp-extended-loop-p (elt state 1)))
(+ loop-indentation lisp-simple-loop-indentation))
((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
(+ loop-indentation lisp-loop-keyword-indentation))
@@ -245,9 +280,23 @@ For example, the function `case' has an indent property
* indent the first argument by 4.
* arguments after the first should be lists, and there may be any number
of them. The first list element has an offset of 2, all the rest
- have an offset of 2+1=3."
+ have an offset of 2+1=3.
+
+If the current mode is actually `emacs-lisp-mode', look for a
+`common-lisp-indent-function-for-elisp' property before looking
+at `common-lisp-indent-function' and, if set, use its value
+instead."
+ ;; FIXME: why do we need to special-case loop?
(if (save-excursion (goto-char (elt state 1))
- (looking-at "([Ll][Oo][Oo][Pp]"))
+ (and (looking-at (if (derived-mode-p 'emacs-lisp-mode)
+ "(\\(cl-\\)?loop"
+ "([Ll][Oo][Oo][Pp]"))
+ (or lisp-indent-backquote-substitution-mode
+ (not
+ (or (and (eq (char-before) ?@)
+ (progn (backward-char)
+ (eq (char-before) ?,)))
+ (eq (char-before) ?,))))))
(common-lisp-loop-part-indentation indent-point state)
(common-lisp-indent-function-1 indent-point state)))
@@ -291,18 +340,29 @@ For example, the function `case' has an indent property
(setq function (downcase (buffer-substring-no-properties
tem (point))))
(goto-char tem)
+ ;; Elisp generally provides CL functionality with a CL
+ ;; prefix, so if we have a special indenter for the
+ ;; unprefixed version, prefer it over whatever's defined
+ ;; for the cl- version. Users can override this
+ ;; heuristic by defining a
+ ;; common-lisp-indent-function-for-elisp property on the
+ ;; cl- version.
+ (when (and (derived-mode-p 'emacs-lisp-mode)
+ (not (lisp-indent-find-method
+ (intern-soft function) t))
+ (string-match "\\`cl-" function)
+ (setf tem (intern-soft
+ (substring function (match-end 0))))
+ (lisp-indent-find-method tem t))
+ (setf function (symbol-name tem)))
(setq tem (intern-soft function)
- method (get tem 'common-lisp-indent-function))
- (cond ((and (null method)
- (string-match ":[^:]+" function))
- ;; The pleblisp package feature
- (setq function (substring function
- (1+ (match-beginning 0)))
- method (get (intern-soft function)
- 'common-lisp-indent-function)))
- ((and (null method))
- ;; backwards compatibility
- (setq method (get tem 'lisp-indent-function)))))
+ method (lisp-indent-find-method tem))
+ ;; The pleblisp package feature
+ (when (and (null tem)
+ (string-match ":[^:]+" function))
+ (setq function (substring function (1+ (match-beginning 0)))
+ tem (intern-soft function)
+ method (lisp-indent-find-method tem))))
(let ((n 0))
;; How far into the containing form is the current form?
(if (< (point) indent-point)
@@ -343,11 +403,21 @@ For example, the function `case' has an indent property
(not (eq (char-after (- containing-sexp 2)) ?\#)))
;; No indentation for "'(...)" elements
(setq calculated (1+ sexp-column)))
- ((or (eq (char-after (1- containing-sexp)) ?\,)
- (and (eq (char-after (1- containing-sexp)) ?\@)
- (eq (char-after (- containing-sexp 2)) ?\,)))
- ;; ",(...)" or ",@(...)"
- (setq calculated normal-indent))
+ ((when
+ (or (eq (char-after (1- containing-sexp)) ?\,)
+ (and (eq (char-after (1- containing-sexp)) ?\@)
+ (eq (char-after (- containing-sexp 2)) ?\,)))
+ ;; ",(...)" or ",@(...)"
+ (when (eq lisp-indent-backquote-substitution-mode
+ 'corrected)
+ (incf sexp-column -1)
+ (when (eq (char-after (1- containing-sexp)) ?\@)
+ (incf sexp-column -1)))
+ (cond (lisp-indent-backquote-substitution-mode
+ (setf tentative-calculated normal-indent)
+ (setq depth lisp-indent-maximum-backtracking)
+ nil)
+ (t (setq calculated normal-indent)))))
((eq (char-after (1- containing-sexp)) ?\#)
;; "#(...)"
(setq calculated (1+ sexp-column)))
@@ -756,6 +826,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\
(when 1)
(with-accessors . multiple-value-bind)
(with-condition-restarts . multiple-value-bind)
+ (with-compilation-unit (&lambda &body))
(with-output-to-string (4 2))
(with-slots . multiple-value-bind)
(with-standard-io-syntax (2)))))
@@ -763,7 +834,12 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\
(put (car el) 'common-lisp-indent-function
(if (symbolp (cdr el))
(get (cdr el) 'common-lisp-indent-function)
- (car (cdr el))))))
+ (car (cdr el))))))
+
+;; In elisp, the else part of `if' is in an implicit progn, so indent
+;; it more.
+(put 'if 'common-lisp-indent-function-for-elisp 2)
+(put 'with-output-to-string 'common-lisp-indent-function-for-elisp 0)
;(defun foo (x)
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index e826cf4375a..2dd05192019 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -1,6 +1,6 @@
;;; cl-lib.el --- Common Lisp extensions for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 1.0
@@ -152,9 +152,6 @@ an element already on the list.
`(setq ,place (cl-adjoin ,x ,place ,@keys)))
`(cl-callf2 cl-adjoin ,x ,place ,@keys)))
-(defun cl--set-elt (seq n val)
- (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
-
(defun cl--set-buffer-substring (start end val)
(save-excursion (delete-region start end)
(goto-char start)
@@ -252,16 +249,6 @@ so that they are registered at compile-time as well as run-time."
`(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when.
-;;; Symbols.
-
-(defun cl--random-time ()
- (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
- (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
- v))
-
-(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100))
-
-
;;; Numbers.
(define-obsolete-function-alias 'cl-floatp-safe 'floatp "24.4")
@@ -282,6 +269,30 @@ so that they are registered at compile-time as well as run-time."
"Return t if INTEGER is even."
(eq (logand integer 1) 0))
+(defconst cl-digit-char-table
+ (let* ((digits (make-vector 256 nil))
+ (populate (lambda (start end base)
+ (mapc (lambda (i)
+ (aset digits i (+ base (- i start))))
+ (number-sequence start end)))))
+ (funcall populate ?0 ?9 0)
+ (funcall populate ?A ?Z 10)
+ (funcall populate ?a ?z 10)
+ digits))
+
+(defun cl-digit-char-p (char &optional radix)
+ "Test if CHAR is a digit in the specified RADIX (default 10).
+If true return the decimal value of digit CHAR in RADIX."
+ (or (<= 2 (or radix 10) 36)
+ (signal 'args-out-of-range (list 'radix radix '(2 36))))
+ (let ((n (aref cl-digit-char-table char)))
+ (and n (< n (or radix 10)) n)))
+
+(defun cl--random-time ()
+ (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+ (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+ v))
+
(defvar cl--random-state
(vector 'cl--random-state-tag -1 30 (cl--random-time)))
@@ -361,7 +372,13 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
(cl--defalias 'cl-first 'car)
(cl--defalias 'cl-second 'cadr)
(cl--defalias 'cl-rest 'cdr)
-(cl--defalias 'cl-endp 'null)
+
+(defun cl-endp (x)
+ "Return true if X is the empty list; false if it is a cons.
+Signal an error if X is not a list."
+ (if (listp x)
+ (null x)
+ (signal 'wrong-type-argument (list 'listp x 'x))))
(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
@@ -398,122 +415,122 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
(defun cl-caaar (x)
"Return the `car' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (car x))))
(defun cl-caadr (x)
"Return the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (cdr x))))
(defun cl-cadar (x)
"Return the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (car x))))
(defun cl-caddr (x)
"Return the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (cdr x))))
(defun cl-cdaar (x)
"Return the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (car x))))
(defun cl-cdadr (x)
"Return the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (cdr x))))
(defun cl-cddar (x)
"Return the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (car x))))
(defun cl-cdddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (cdr x))))
(defun cl-caaaar (x)
"Return the `car' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (car (car x)))))
(defun cl-caaadr (x)
"Return the `car' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (car (cdr x)))))
(defun cl-caadar (x)
"Return the `car' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (cdr (car x)))))
(defun cl-caaddr (x)
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car (cdr (cdr x)))))
(defun cl-cadaar (x)
"Return the `car' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (car (car x)))))
(defun cl-cadadr (x)
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (car (cdr x)))))
(defun cl-caddar (x)
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (cdr (car x)))))
(defun cl-cadddr (x)
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr (cdr (cdr x)))))
(defun cl-cdaaar (x)
"Return the `cdr' of the `car' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (car (car x)))))
(defun cl-cdaadr (x)
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (car (cdr x)))))
(defun cl-cdadar (x)
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (cdr (car x)))))
(defun cl-cdaddr (x)
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car (cdr (cdr x)))))
(defun cl-cddaar (x)
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (car (car x)))))
(defun cl-cddadr (x)
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (car (cdr x)))))
(defun cl-cdddar (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (cdr (car x)))))
(defun cl-cddddr (x)
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
- (declare (compiler-macro cl--compiler-macro-cXXr))
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr (cdr (cdr x)))))
;;(defun last* (x &optional n)
@@ -607,7 +624,6 @@ the process stops as soon as KEYS or VALUES run out.
If ALIST is non-nil, the new pairs are prepended to it."
(nconc (cl-mapcar 'cons keys values) alist))
-
;;; Generalized variables.
;; These used to be in cl-macs.el since all macros that use them (like setf)
@@ -625,7 +641,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
`(insert (prog1 ,store (erase-buffer))))
(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
(gv-define-simple-setter current-buffer set-buffer)
-(gv-define-simple-setter current-case-table set-case-table)
(gv-define-simple-setter current-column move-to-column t)
(gv-define-simple-setter current-global-map use-global-map t)
(gv-define-setter current-input-mode (store)
@@ -680,7 +695,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
(gv-define-setter window-width (store)
`(progn (enlarge-window (- ,store (window-width)) t) ,store))
(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
-(gv-define-simple-setter x-get-selection x-own-selection t)
;; More complex setf-methods.
@@ -703,35 +717,19 @@ If ALIST is non-nil, the new pairs are prepended to it."
(gv-define-expander substring
(lambda (do place from &optional to)
(gv-letplace (getter setter) place
- (macroexp-let2 nil start from
- (macroexp-let2 nil end to
- (funcall do `(substring ,getter ,start ,end)
- (lambda (v)
- (funcall setter `(cl--set-substring
- ,getter ,start ,end ,v)))))))))
+ (macroexp-let2* nil ((start from) (end to))
+ (funcall do `(substring ,getter ,start ,end)
+ (lambda (v)
+ (funcall setter `(cl--set-substring
+ ,getter ,start ,end ,v))))))))
;;; Miscellaneous.
-;;;###autoload
-(progn
- ;; The `assert' macro from the cl package signals
- ;; `cl-assertion-failed' at runtime so always define it.
- (define-error 'cl-assertion-failed (purecopy "Assertion failed"))
- ;; Make sure functions defined with cl-defsubst can be inlined even in
- ;; packages which do not require CL. We don't put an autoload cookie
- ;; directly on that function, since those cookies only go to cl-loaddefs.
- (autoload 'cl--defsubst-expand "cl-macs")
- ;; Autoload, so autoload.el and font-lock can use it even when CL
- ;; is not loaded.
- (put 'cl-defun 'doc-string-elt 3)
- (put 'cl-defmacro 'doc-string-elt 3)
- (put 'cl-defsubst 'doc-string-elt 3)
- (put 'cl-defstruct 'doc-string-elt 2))
-
(provide 'cl-lib)
-(or (load "cl-loaddefs" 'noerror 'quiet)
- ;; When bootstrapping, cl-loaddefs hasn't been built yet!
- (require 'cl-macs))
+(unless (load "cl-loaddefs" 'noerror 'quiet)
+ ;; When bootstrapping, cl-loaddefs hasn't been built yet!
+ (require 'cl-macs)
+ (require 'cl-seq))
;; Local variables:
;; byte-compile-dynamic: t
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d9d6658811f..c42094f0f0c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,6 +1,6 @@
-;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t; coding: utf-8 -*-
+;;; cl-macs.el --- Common Lisp macros -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Old-Version: 2.02
@@ -70,20 +70,12 @@
(setq form `(cons ,(car args) ,form)))
form))
+;; Note: `cl--compiler-macro-cXXr' has been copied to
+;; `internal--compiler-macro-cXXr' in subr.el. If you amend either
+;; one, you may want to amend the other, too.
;;;###autoload
-(defun cl--compiler-macro-cXXr (form x)
- (let* ((head (car form))
- (n (symbol-name (car form)))
- (i (- (length n) 2)))
- (if (not (string-match "c[ad]+r\\'" n))
- (if (and (fboundp head) (symbolp (symbol-function head)))
- (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
- x)
- (error "Compiler macro for cXXr applied to non-cXXr form"))
- (while (> i (match-beginning 0))
- (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
- (setq i (1- i)))
- x)))
+(define-obsolete-function-alias 'cl--compiler-macro-cXXr
+ 'internal--compiler-macro-cXXr "25.1")
;;; Some predicates for analyzing Lisp forms.
;; These are used by various
@@ -135,7 +127,13 @@
(t t)))
(defun cl--const-expr-val (x)
- (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
+ "Return the value of X known at compile-time.
+If X is not known at compile time, return nil. Before testing
+whether X is known at compile time, macroexpand it completely in
+`macroexpand-all-environment'."
+ (let ((x (macroexpand-all x macroexpand-all-environment)))
+ (if (macroexp-const-p x)
+ (if (consp x) (nth 1 x) x))))
(defun cl--expr-contains (x y)
"Count number of times X refers to Y. Return nil for 0 times."
@@ -163,7 +161,7 @@
;;; Symbols.
-(defvar cl--gensym-counter)
+(defvar cl--gensym-counter 0)
;;;###autoload
(defun cl-gensym (&optional prefix)
"Generate a new uninterned symbol.
@@ -209,11 +207,26 @@ The name is made by appending a number to PREFIX, default \"G\"."
(def-edebug-spec cl-&key-arg
(&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
+(def-edebug-spec cl-type-spec sexp)
+
(defconst cl--lambda-list-keywords
'(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
-(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
+;; Internal hacks used in formal arg lists:
+;; - &cl-quote: Added to formal-arglists to mean that any default value
+;; mentioned in the formal arglist should be considered as implicitly
+;; quoted rather than evaluated. This is used in `cl-defsubst' when
+;; performing compiler-macro-expansion, since at that time the
+;; arguments hold expressions rather than values.
+;; - &cl-defs (DEF . DEFS): Gives the default value to use for missing
+;; optional arguments which don't have an explicit default value.
+;; DEFS is an alist mapping vars to their default default value.
+;; and DEF is the default default to use for all other vars.
+
+(defvar cl--bind-block) ;Name of surrounding block, only use for `signal' data.
+(defvar cl--bind-defs) ;(DEF . DEFS) giving the "default default" for optargs.
+(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
+(defvar cl--bind-lets) (defvar cl--bind-forms)
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
@@ -223,57 +236,88 @@ function's body.
FORM is of the form (ARGS . BODY)."
(let* ((args (car form)) (body (cdr form)) (orig-args args)
(cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
- (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
- (header nil) (simple-args nil))
- (while (or (stringp (car body))
- (memq (car-safe (car body)) '(interactive declare cl-declare)))
- (push (pop body) header))
+ (parsed-body (macroexp-parse-body body))
+ (header (car parsed-body)) (simple-args nil))
+ (setq body (cdr parsed-body))
+ ;; "(. X) to (&rest X)" conversion already done in cl--do-arglist, but we
+ ;; do it here as well, so as to be able to see if we can avoid
+ ;; cl--do-arglist.
(setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
- (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
- (setq args (delq '&cl-defs (delq cl--bind-defs args))
- cl--bind-defs (cadr cl--bind-defs)))
+ (let ((cl-defs (memq '&cl-defs args)))
+ (when cl-defs
+ (setq cl--bind-defs (cadr cl-defs))
+ ;; Remove "&cl-defs DEFS" from args.
+ (setcdr cl-defs (cddr cl-defs))
+ (setq args (delq '&cl-defs args))))
(if (setq cl--bind-enquote (memq '&cl-quote args))
(setq args (delq '&cl-quote args)))
(if (memq '&whole args) (error "&whole not currently implemented"))
- (let* ((p (memq '&environment args)) (v (cadr p))
- (env-exp 'macroexpand-all-environment))
+ (let* ((p (memq '&environment args))
+ (v (cadr p)))
(if p (setq args (nconc (delq (car p) (delq v args))
- (list '&aux (list v env-exp))))))
- (while (and args (symbolp (car args))
- (not (memq (car args) '(nil &rest &body &key &aux)))
- (not (and (eq (car args) '&optional)
- (or cl--bind-defs (consp (cadr args))))))
- (push (pop args) simple-args))
+ `(&aux (,v macroexpand-all-environment))))))
+ ;; Take away all the simple args whose parsing can be handled more
+ ;; efficiently by a plain old `lambda' than the manual parsing generated
+ ;; by `cl--do-arglist'.
+ (let ((optional nil))
+ (while (and args (symbolp (car args))
+ (not (memq (car args) '(nil &rest &body &key &aux)))
+ (or (not optional)
+ ;; Optional args whose default is nil are simple.
+ (null (nth 1 (assq (car args) (cdr cl--bind-defs)))))
+ (not (and (eq (car args) '&optional) (setq optional t)
+ (car cl--bind-defs))))
+ (push (pop args) simple-args))
+ (when optional
+ (if args (push '&optional args))
+ ;; Don't keep a dummy trailing &optional without actual optional args.
+ (if (eq '&optional (car simple-args)) (pop simple-args))))
(or (eq cl--bind-block 'cl-none)
(setq body (list `(cl-block ,cl--bind-block ,@body))))
- (if (null args)
- (cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
- (if (memq '&optional simple-args) (push '&optional args))
- (cl--do-arglist args nil (- (length simple-args)
- (if (memq '&optional simple-args) 1 0)))
- (setq cl--bind-lets (nreverse cl--bind-lets))
- (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
- ,@(nreverse cl--bind-inits)))
- (nconc (nreverse simple-args)
- (list '&rest (car (pop cl--bind-lets))))
- (nconc (let ((hdr (nreverse header)))
+ (let* ((cl--bind-lets nil) (cl--bind-forms nil)
+ (rest-args
+ (cond
+ ((null args) nil)
+ ((eq (car args) '&aux)
+ (cl--do-&aux args)
+ (setq cl--bind-lets (nreverse cl--bind-lets))
+ nil)
+ (t ;; `simple-args' doesn't handle all the parsing that we need,
+ ;; so we pass the rest to cl--do-arglist which will do
+ ;; "manual" parsing.
+ (let ((slen (length simple-args)))
+ (when (memq '&optional simple-args)
+ (cl-decf slen))
+ (setq header
;; Macro expansion can take place in the middle of
;; apparently harmless computation, so it should not
;; touch the match-data.
(save-match-data
- (require 'help-fns)
(cons (help-add-fundoc-usage
- (if (stringp (car hdr)) (pop hdr))
+ (if (stringp (car header)) (pop header))
;; Be careful with make-symbol and (back)quote,
;; see bug#12884.
(let ((print-gensym nil) (print-quoted t))
(format "%S" (cons 'fn (cl--make-usage-args
orig-args)))))
- hdr)))
- (list `(let* ,cl--bind-lets
- ,@(nreverse cl--bind-forms)
- ,@body)))))))
+ header)))
+ ;; FIXME: we'd want to choose an arg name for the &rest param
+ ;; and pass that as `expr' to cl--do-arglist, but that ends up
+ ;; generating code with a redundant let-binding, so we instead
+ ;; pass a dummy and then look in cl--bind-lets to find what var
+ ;; this was bound to.
+ (cl--do-arglist args :dummy slen)
+ (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)
+ ,@header
+ ,(macroexp-let* cl--bind-lets
+ (macroexp-progn
+ `(,@(nreverse cl--bind-forms)
+ ,@body)))))))
;;;###autoload
(defmacro cl-defun (name args &rest body)
@@ -295,6 +339,27 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
(form `(defun ,name ,@(cdr res))))
(if (car res) `(progn ,(car res) ,form) form)))
+;;;###autoload
+(defmacro cl-iter-defun (name args &rest body)
+ "Define NAME as a generator function.
+Like normal `iter-defun', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug
+ ;; Same as iter-defun but use cl-lambda-list.
+ (&define [&or name ("setf" :name setf name)]
+ cl-lambda-list
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
+ def-body))
+ (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)))
+
;; 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
;; top level list.
@@ -374,8 +439,6 @@ its argument list allows full Common Lisp conventions."
(if (car res) `(progn ,(car res) ,form) form))
`(function ,func)))
-(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
-
(defun cl--make-usage-var (x)
"X can be a var or a (destructuring) lambda-list."
(cond
@@ -384,6 +447,11 @@ its argument list allows full Common Lisp conventions."
(t x)))
(defun cl--make-usage-args (arglist)
+ (let ((aux (ignore-errors (cl-position '&aux arglist))))
+ (when aux
+ ;; `&aux' args aren't arguments, so let's just drop them from the
+ ;; usage info.
+ (setq arglist (cl-subseq arglist 0 aux))))
(if (cdr-safe (last arglist)) ;Not a proper list.
(let* ((last (last arglist))
(tail (cdr last)))
@@ -392,8 +460,7 @@ its argument list allows full Common Lisp conventions."
(setcdr last nil)
(nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
(setcdr last tail)))
- ;; `orig-args' can contain &cl-defs (an internal
- ;; CL thingy I don't understand), so remove it.
+ ;; `orig-args' can contain &cl-defs.
(let ((x (memq '&cl-defs arglist)))
(when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
(let ((state nil))
@@ -420,7 +487,18 @@ its argument list allows full Common Lisp conventions."
))))
arglist))))
-(defun cl--do-arglist (args expr &optional num) ; uses bind-*
+(defun cl--do-&aux (args)
+ (while (and (eq (car args) '&aux) (pop args))
+ (while (and args (not (memq (car args) cl--lambda-list-keywords)))
+ (if (consp (car args))
+ (if (and cl--bind-enquote (cl-cadar args))
+ (cl--do-arglist (caar args)
+ `',(cadr (pop args)))
+ (cl--do-arglist (caar args) (cadr (pop args))))
+ (cl--do-arglist (pop args) nil))))
+ (if args (error "Malformed argument list ends with: %S" args)))
+
+(defun cl--do-arglist (args expr &optional num) ; uses cl--bind-*
(if (nlistp args)
(if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
(error "Invalid argument name: %s" args)
@@ -429,15 +507,14 @@ its argument list allows full Common Lisp conventions."
(let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
(let ((p (memq '&body args))) (if p (setcar p '&rest)))
(if (memq '&environment args) (error "&environment used incorrectly"))
- (let ((save-args args)
- (restarg (memq '&rest args))
+ (let ((restarg (memq '&rest args))
(safety (if (cl--compiling-file) cl--optimize-safety 3))
(keys nil)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
- (if (listp (cadr restarg))
- (setq restarg (make-symbol "--cl-rest--"))
- (setq restarg (cadr restarg)))
+ (setq restarg (if (listp (cadr restarg))
+ (make-symbol "--cl-rest--")
+ (cadr restarg)))
(push (list restarg expr) cl--bind-lets)
(if (eq (car args) '&whole)
(push (list (cl--pop2 args) restarg) cl--bind-lets))
@@ -500,8 +577,13 @@ its argument list allows full Common Lisp conventions."
(intern (format ":%s" name)))))
(varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
(def (if (cdr arg) (cadr arg)
- (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
- (look `(memq ',karg ,restarg)))
+ ;; The ordering between those two or clauses is
+ ;; irrelevant, since in practice only one of the two
+ ;; is ever non-nil (the car is only used for
+ ;; cl-deftype which doesn't use the cdr).
+ (or (car cl--bind-defs)
+ (cadr (assq varg cl--bind-defs)))))
+ (look `(plist-member ,restarg ',karg)))
(and def cl--bind-enquote (setq def `',def))
(if (cddr arg)
(let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
@@ -537,15 +619,8 @@ its argument list allows full Common Lisp conventions."
keys)
(car ,var)))))))
(push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
- (while (and (eq (car args) '&aux) (pop args))
- (while (and args (not (memq (car args) cl--lambda-list-keywords)))
- (if (consp (car args))
- (if (and cl--bind-enquote (cl-cadar args))
- (cl--do-arglist (caar args)
- `',(cadr (pop args)))
- (cl--do-arglist (caar args) (cadr (pop args))))
- (cl--do-arglist (pop args) nil))))
- (if args (error "Malformed argument list %s" save-args)))))
+ (cl--do-&aux args)
+ nil)))
(defun cl--arglist-args (args)
(if (nlistp args) (list args)
@@ -564,12 +639,11 @@ its argument list allows full Common Lisp conventions."
"Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2)
(debug (&define cl-macro-list def-form cl-declarations def-body)))
- (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
+ (let* ((cl--bind-lets nil) (cl--bind-forms nil)
(cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
(cl--do-arglist (or args '(&aux)) expr)
- (append '(progn) cl--bind-inits
- (list `(let* ,(nreverse cl--bind-lets)
- ,@(nreverse cl--bind-forms) ,@body)))))
+ (macroexp-let* (nreverse cl--bind-lets)
+ (macroexp-progn (append (nreverse cl--bind-forms) body)))))
;;; The `cl-eval-when' form.
@@ -619,14 +693,20 @@ The result of the body appears to the compiler as a quoted constant."
(set `(setq ,temp ,form)))
(if (and (fboundp 'byte-compile-file-form-defmumble)
(boundp 'this-kind) (boundp 'that-one))
- (fset 'byte-compile-file-form
- `(lambda (form)
- (fset 'byte-compile-file-form
- ',(symbol-function 'byte-compile-file-form))
- (byte-compile-file-form ',set)
- (byte-compile-file-form form)))
- (print set (symbol-value 'byte-compile--outbuffer)))
- `(symbol-value ',temp))
+ ;; Else, we can't output right away, so we have to delay it to the
+ ;; next time we're at the top-level.
+ ;; FIXME: Use advice-add/remove.
+ (fset 'byte-compile-file-form
+ (let ((old (symbol-function 'byte-compile-file-form)))
+ (lambda (form)
+ (fset 'byte-compile-file-form old)
+ (byte-compile-file-form set)
+ (byte-compile-file-form form))))
+ ;; If we're not in the middle of compiling something, we can
+ ;; output directly to byte-compile-outbuffer, to make sure
+ ;; temp is set before we use it.
+ (print set byte-compile--outbuffer))
+ temp)
`',(eval form)))
@@ -643,30 +723,26 @@ allowed only in the final clause, and matches if no other keys match.
Key values are compared by `eql'.
\n(fn EXPR (KEYLIST BODY...)...)"
(declare (indent 1) (debug (form &rest (sexp body))))
- (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
- (head-list nil)
- (body (cons
- 'cond
- (mapcar
- (function
- (lambda (c)
- (cons (cond ((memq (car c) '(t otherwise)) t)
- ((eq (car c) 'cl--ecase-error-flag)
- `(error "cl-ecase failed: %s, %s"
- ,temp ',(reverse head-list)))
- ((listp (car c))
- (setq head-list (append (car c) head-list))
- `(cl-member ,temp ',(car c)))
- (t
- (if (memq (car c) head-list)
- (error "Duplicate key in case: %s"
- (car c)))
- (push (car c) head-list)
- `(eql ,temp ',(car c))))
- (or (cdr c) '(nil)))))
- clauses))))
- (if (eq temp expr) body
- `(let ((,temp ,expr)) ,body))))
+ (macroexp-let2 macroexp-copyable-p temp expr
+ (let* ((head-list nil))
+ `(cond
+ ,@(mapcar
+ (lambda (c)
+ (cons (cond ((memq (car c) '(t otherwise)) t)
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-ecase failed: %s, %s"
+ ,temp ',(reverse head-list)))
+ ((listp (car c))
+ (setq head-list (append (car c) head-list))
+ `(cl-member ,temp ',(car c)))
+ (t
+ (if (memq (car c) head-list)
+ (error "Duplicate key in case: %s"
+ (car c)))
+ (push (car c) head-list)
+ `(eql ,temp ',(car c))))
+ (or (cdr c) '(nil))))
+ clauses)))))
;;;###autoload
(defmacro cl-ecase (expr &rest clauses)
@@ -686,24 +762,22 @@ final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
(declare (indent 1)
(debug (form &rest ([&or cl-type-spec "otherwise"] body))))
- (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
- (type-list nil)
- (body (cons
- 'cond
- (mapcar
- (function
- (lambda (c)
- (cons (cond ((eq (car c) 'otherwise) t)
- ((eq (car c) 'cl--ecase-error-flag)
- `(error "cl-etypecase failed: %s, %s"
- ,temp ',(reverse type-list)))
- (t
- (push (car c) type-list)
- (cl--make-type-test temp (car c))))
- (or (cdr c) '(nil)))))
- clauses))))
- (if (eq temp expr) body
- `(let ((,temp ,expr)) ,body))))
+ (macroexp-let2 macroexp-copyable-p temp expr
+ (let* ((type-list nil))
+ (cons
+ 'cond
+ (mapcar
+ (function
+ (lambda (c)
+ (cons (cond ((eq (car c) 'otherwise) t)
+ ((eq (car c) 'cl--ecase-error-flag)
+ `(error "cl-etypecase failed: %s, %s"
+ ,temp ',(reverse type-list)))
+ (t
+ (push (car c) type-list)
+ `(cl-typep ,temp ',(car c))))
+ (or (cdr c) '(nil)))))
+ clauses)))))
;;;###autoload
(defmacro cl-etypecase (expr &rest clauses)
@@ -754,14 +828,22 @@ 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-destr-temps)
-(defvar cl--loop-finally) (defvar cl--loop-finish-flag)
+(defvar cl--loop-bindings) (defvar cl--loop-body)
+(defvar cl--loop-finally)
+(defvar cl--loop-finish-flag) ;Symbol set to nil to exit the loop?
(defvar cl--loop-first-flag)
-(defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name)
+(defvar cl--loop-initially) (defvar cl--loop-iterator-function)
+(defvar cl--loop-name)
(defvar cl--loop-result) (defvar cl--loop-result-explicit)
(defvar cl--loop-result-var) (defvar cl--loop-steps)
(defvar cl--loop-symbol-macs)
+(defun cl--loop-set-iterator-function (kind iterator)
+ (if cl--loop-iterator-function
+ ;; FIXME: Of course, we could make it work, but why bother.
+ (error "Iteration on %S does not support this combination" kind)
+ (setq cl--loop-iterator-function iterator)))
+
;;;###autoload
(defmacro cl-loop (&rest loop-args)
"The Common Lisp `loop' macro.
@@ -808,20 +890,43 @@ For more details, see Info node `(cl)Loop Facility'.
"repeat" "while" "until" "always" "never"
"thereis" "collect" "append" "nconc" "sum"
"count" "maximize" "minimize" "if" "unless"
- "return"] form]
+ "return"]
+ form]
;; Simple default, which covers 99% of the cases.
symbolp form)))
(if (not (memq t (mapcar #'symbolp
(delq nil (delq t (cl-copy-list loop-args))))))
`(cl-block nil (while t ,@loop-args))
(let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil)
- (cl--loop-body nil) (cl--loop-steps nil)
- (cl--loop-result nil) (cl--loop-result-explicit nil)
- (cl--loop-result-var nil) (cl--loop-finish-flag nil)
+ (cl--loop-body nil) (cl--loop-steps nil)
+ (cl--loop-result nil) (cl--loop-result-explicit nil)
+ (cl--loop-result-var nil) (cl--loop-finish-flag nil)
(cl--loop-accum-var nil) (cl--loop-accum-vars nil)
(cl--loop-initially nil) (cl--loop-finally nil)
- (cl--loop-map-form nil) (cl--loop-first-flag nil)
- (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil))
+ (cl--loop-iterator-function nil) (cl--loop-first-flag nil)
+ (cl--loop-symbol-macs nil))
+ ;; Here is more or less how those dynbind vars are used after looping
+ ;; over cl--parse-loop-clause:
+ ;;
+ ;; (cl-block ,cl--loop-name
+ ;; (cl-symbol-macrolet ,cl--loop-symbol-macs
+ ;; (foldl #'cl--loop-let
+ ;; `((,cl--loop-result-var)
+ ;; ((,cl--loop-first-flag t))
+ ;; ((,cl--loop-finish-flag t))
+ ;; ,@cl--loop-bindings)
+ ;; ,@(nreverse cl--loop-initially)
+ ;; (while ;(well: cl--loop-iterator-function)
+ ;; ,(car (cl--loop-build-ands (nreverse cl--loop-body)))
+ ;; ,@(cadr (cl--loop-build-ands (nreverse cl--loop-body)))
+ ;; ,@(nreverse cl--loop-steps)
+ ;; (setq ,cl--loop-first-flag nil))
+ ;; (if (not ,cl--loop-finish-flag) ;FIXME: Why `if' vs `progn'?
+ ;; ,cl--loop-result-var
+ ;; ,@(nreverse cl--loop-finally)
+ ;; ,(or cl--loop-result-explicit
+ ;; cl--loop-result)))))
+ ;;
(setq cl--loop-args (append cl--loop-args '(cl-end-loop)))
(while (not (eq (car cl--loop-args) 'cl-end-loop))
(cl--parse-loop-clause))
@@ -837,15 +942,15 @@ For more details, see Info node `(cl)Loop Facility'.
(while-body (nconc (cadr ands) (nreverse cl--loop-steps)))
(body (append
(nreverse cl--loop-initially)
- (list (if cl--loop-map-form
+ (list (if cl--loop-iterator-function
`(cl-block --cl-finish--
- ,(cl-subst
- (if (eq (car ands) t) while-body
- (cons `(or ,(car ands)
- (cl-return-from --cl-finish--
- nil))
- while-body))
- '--cl-map cl--loop-map-form))
+ ,(funcall cl--loop-iterator-function
+ (if (eq (car ands) t) while-body
+ (cons `(or ,(car ands)
+ (cl-return-from
+ --cl-finish--
+ nil))
+ while-body))))
`(while ,(car ands) ,@while-body)))
(if cl--loop-finish-flag
(if (equal epilogue '(nil)) (list cl--loop-result-var)
@@ -1074,10 +1179,10 @@ For more details, see Info node `(cl)Loop Facility'.
(if (memq (car cl--loop-args) '(downto above))
(error "Must specify `from' value for downward cl-loop"))
(let* ((down (or (eq (car cl--loop-args) 'downfrom)
- (memq (cl-caddr cl--loop-args)
+ (memq (nth 2 cl--loop-args)
'(downto above))))
(excl (or (memq (car cl--loop-args) '(above below))
- (memq (cl-caddr cl--loop-args)
+ (memq (nth 2 cl--loop-args)
'(above below))))
(start (and (memq (car cl--loop-args)
'(from upfrom downfrom))
@@ -1100,7 +1205,8 @@ For more details, see Info node `(cl)Loop Facility'.
(if end
(push (list
(if down (if excl '> '>=) (if excl '< '<=))
- var (or end-var end)) cl--loop-body))
+ var (or end-var end))
+ cl--loop-body))
(push (list var (list (if down '- '+) var
(or step-var step 1)))
loop-for-steps)))
@@ -1158,7 +1264,8 @@ For more details, see Info node `(cl)Loop Facility'.
(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)
+ (length ,temp-vec))
+ cl--loop-body)
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@@ -1214,15 +1321,18 @@ For more details, see Info node `(cl)Loop Facility'.
(make-symbol "--cl-var--"))))
(if (memq word '(hash-value hash-values))
(setq var (prog1 other (setq other var))))
- (setq cl--loop-map-form
- `(maphash (lambda (,var ,other) . --cl-map) ,table))))
+ (cl--loop-set-iterator-function
+ 'hash-tables (lambda (body)
+ `(maphash (lambda (,var ,other) . ,body)
+ ,table)))))
((memq word '(symbol present-symbol external-symbol
symbols present-symbols external-symbols))
(let ((ob (and (memq (car cl--loop-args) '(in of))
(cl--pop2 cl--loop-args))))
- (setq cl--loop-map-form
- `(mapatoms (lambda (,var) . --cl-map) ,ob))))
+ (cl--loop-set-iterator-function
+ 'symbols (lambda (body)
+ `(mapatoms (lambda (,var) . ,body) ,ob)))))
((memq word '(overlay overlays extent extents))
(let ((buf nil) (from nil) (to nil))
@@ -1232,11 +1342,12 @@ For more details, see Info node `(cl)Loop Facility'.
((eq (car cl--loop-args) 'to)
(setq to (cl--pop2 cl--loop-args)))
(t (setq buf (cl--pop2 cl--loop-args)))))
- (setq cl--loop-map-form
- `(cl--map-overlays
- (lambda (,var ,(make-symbol "--cl-var--"))
- (progn . --cl-map) nil)
- ,buf ,from ,to))))
+ (cl--loop-set-iterator-function
+ 'overlays (lambda (body)
+ `(cl--map-overlays
+ (lambda (,var ,(make-symbol "--cl-var--"))
+ (progn . ,body) nil)
+ ,buf ,from ,to)))))
((memq word '(interval intervals))
(let ((buf nil) (prop nil) (from nil) (to nil)
@@ -1253,10 +1364,11 @@ For more details, see Info node `(cl)Loop Facility'.
(if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
(setq var1 (car var) var2 (cdr var))
(push (list var `(cons ,var1 ,var2)) loop-for-sets))
- (setq cl--loop-map-form
- `(cl--map-intervals
- (lambda (,var1 ,var2) . --cl-map)
- ,buf ,prop ,from ,to))))
+ (cl--loop-set-iterator-function
+ 'intervals (lambda (body)
+ `(cl--map-intervals
+ (lambda (,var1 ,var2) . ,body)
+ ,buf ,prop ,from ,to)))))
((memq word key-types)
(or (memq (car cl--loop-args) '(in of))
@@ -1272,10 +1384,11 @@ For more details, see Info node `(cl)Loop Facility'.
(make-symbol "--cl-var--"))))
(if (memq word '(key-binding key-bindings))
(setq var (prog1 other (setq other var))))
- (setq cl--loop-map-form
- `(,(if (memq word '(key-seq key-seqs))
- 'cl--map-keymap-recursively 'map-keymap)
- (lambda (,var ,other) . --cl-map) ,cl-map))))
+ (cl--loop-set-iterator-function
+ 'keys (lambda (body)
+ `(,(if (memq word '(key-seq key-seqs))
+ 'cl--map-keymap-recursively 'map-keymap)
+ (lambda (,var ,other) . ,body) ,cl-map)))))
((memq word '(frame frames screen screens))
(let ((temp (make-symbol "--cl-var--")))
@@ -1328,7 +1441,8 @@ For more details, see Info node `(cl)Loop Facility'.
(if loop-for-sets
(push `(progn
,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
- t) cl--loop-body))
+ t)
+ cl--loop-body))
(if loop-for-steps
(push (cons (if ands 'cl-psetq 'setq)
(apply 'append (nreverse loop-for-steps)))
@@ -1346,7 +1460,8 @@ For more details, see Info node `(cl)Loop Facility'.
(push `(progn (push ,what ,var) t) cl--loop-body)
(push `(progn
(setq ,var (nconc ,var (list ,what)))
- t) cl--loop-body))))
+ t)
+ cl--loop-body))))
((memq word '(nconc nconcing append appending))
(let ((what (pop cl--loop-args))
@@ -1361,7 +1476,9 @@ For more details, see Info node `(cl)Loop Facility'.
,var)
`(,(if (memq word '(nconc nconcing))
#'nconc #'append)
- ,var ,what))) t) cl--loop-body)))
+ ,var ,what)))
+ t)
+ cl--loop-body)))
((memq word '(concat concating))
(let ((what (pop cl--loop-args))
@@ -1384,15 +1501,14 @@ For more details, see Info node `(cl)Loop Facility'.
(push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
((memq word '(minimize minimizing maximize maximizing))
- (let* ((what (pop cl--loop-args))
- (temp (if (cl--simple-expr-p what) what
- (make-symbol "--cl-var--")))
- (var (cl--loop-handle-accum nil))
- (func (intern (substring (symbol-name word) 0 3)))
- (set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
- (push `(progn ,(if (eq temp what) set
- `(let ((,temp ,what)) ,set))
- t) cl--loop-body)))
+ (push `(progn ,(macroexp-let2 macroexp-copyable-p temp
+ (pop cl--loop-args)
+ (let* ((var (cl--loop-handle-accum nil))
+ (func (intern (substring (symbol-name word)
+ 0 3))))
+ `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+ t)
+ cl--loop-body))
((eq word 'with)
(let ((bindings nil))
@@ -1446,12 +1562,9 @@ For more details, see Info node `(cl)Loop Facility'.
(if (eq word 'unless) (setq then (prog1 else (setq else then))))
(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
(if simple (nth 1 else) (list (nth 2 else))))))
- (if (cl--expr-contains form 'it)
- (let ((temp (make-symbol "--cl-var--")))
- (push (list temp) cl--loop-bindings)
- (setq form `(if (setq ,temp ,cond)
- ,@(cl-subst temp 'it form))))
- (setq form `(if ,cond ,@form)))
+ (setq form (if (cl--expr-contains form 'it)
+ `(let ((it ,cond)) (if it ,@form))
+ `(if ,cond ,@form)))
(push (if simple `(progn ,form t) form) cl--loop-body))))
((memq word '(do doing))
@@ -1466,7 +1579,8 @@ For more details, see Info node `(cl)Loop Facility'.
(or cl--loop-result-var
(setq cl--loop-result-var (make-symbol "--cl-var--")))
(push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
- ,cl--loop-finish-flag nil) cl--loop-body))
+ ,cl--loop-finish-flag nil)
+ cl--loop-body))
(t
;; This is an advertised interface: (info "(cl)Other Clauses").
@@ -1476,36 +1590,52 @@ For more details, see Info node `(cl)Loop Facility'.
(if (eq (car cl--loop-args) 'and)
(progn (pop cl--loop-args) (cl--parse-loop-clause)))))
-(defun cl--loop-let (specs body par) ; uses loop-*
- (let ((p specs) (temps nil) (new nil))
- (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
- (setq p (cdr p)))
- (and par p
- (progn
- (setq par nil p specs)
- (while p
- (or (macroexp-const-p (cl-cadar p))
- (let ((temp (make-symbol "--cl-var--")))
- (push (list temp (cl-cadar p)) temps)
- (setcar (cdar p) temp)))
- (setq p (cdr p)))))
+(defun cl--unused-var-p (sym)
+ (or (null sym) (eq ?_ (aref (symbol-name sym) 0))))
+
+(defun cl--loop-let (specs body par) ; modifies cl--loop-bindings
+ "Build an expression equivalent to (let SPECS BODY).
+SPECS can include bindings using `cl-loop's destructuring (not to be
+confused with the patterns of `cl-destructuring-bind').
+If PAR is nil, do the bindings step by step, like `let*'.
+If BODY is `setq', then use SPECS for assignments rather than for bindings."
+ (let ((temps nil) (new nil))
+ (when par
+ (let ((p specs))
+ (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
+ (setq p (cdr p)))
+ (when p
+ (setq par nil)
+ (dolist (spec specs)
+ (or (macroexp-const-p (cadr spec))
+ (let ((temp (make-symbol "--cl-var--")))
+ (push (list temp (cadr spec)) temps)
+ (setcar (cdr spec) temp)))))))
(while specs
- (if (and (consp (car specs)) (listp (caar specs)))
- (let* ((spec (caar specs)) (nspecs nil)
- (expr (cadr (pop specs)))
- (temp
- (cdr (or (assq spec cl--loop-destr-temps)
- (car (push (cons spec
- (or (last spec 0)
- (make-symbol "--cl-var--")))
- cl--loop-destr-temps))))))
- (push (list temp expr) new)
- (while (consp spec)
- (push (list (pop spec)
- (and expr (list (if spec 'pop 'car) temp)))
- nspecs))
- (setq specs (nconc (nreverse nspecs) specs)))
- (push (pop specs) new)))
+ (let* ((binding (pop specs))
+ (spec (car-safe binding)))
+ (if (and (consp binding) (or (consp spec) (cl--unused-var-p spec)))
+ (let* ((nspecs nil)
+ (expr (car (cdr-safe binding)))
+ (temp (last spec 0)))
+ (if (and (cl--unused-var-p temp) (null expr))
+ nil ;; Don't bother declaring/setting `temp' since it won't
+ ;; be used when `expr' is nil, anyway.
+ (when (or (null temp)
+ (and (eq body 'setq) (cl--unused-var-p temp)))
+ ;; Prefer a fresh uninterned symbol over "_to", to avoid
+ ;; warnings that we set an unused variable.
+ (setq temp (make-symbol "--cl-var--"))
+ ;; Make sure this temp variable is locally declared.
+ (when (eq body 'setq)
+ (push (list (list temp)) cl--loop-bindings)))
+ (push (list temp expr) new))
+ (while (consp spec)
+ (push (list (pop spec)
+ (and expr (list (if spec 'pop 'car) temp)))
+ nspecs))
+ (setq specs (nconc (nreverse nspecs) specs)))
+ (push binding new))))
(if (eq body 'setq)
(let ((set (cons (if par 'cl-psetq 'setq)
(apply 'nconc (nreverse new)))))
@@ -1613,7 +1743,7 @@ An implicit nil block is established around the loop.
(declare (debug ((symbolp form &optional form) cl-declarations body))
(indent 1))
(let ((loop `(dolist ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dolist)
loop `(cl-block nil ,loop))))
;;;###autoload
@@ -1626,7 +1756,7 @@ nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
(declare (debug cl-dolist) (indent 1))
(let ((loop `(dotimes ,spec ,@body)))
- (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+ (if (advice-member-p 'cl--wrap-in-nil-block 'dotimes)
loop `(cl-block nil ,loop))))
(defvar cl--tagbody-alist nil)
@@ -1656,7 +1786,8 @@ Labels have lexical scope and dynamic extent."
(unless (eq 'go (car-safe (car-safe block)))
(push `(go cl--exit) block))
(push (nreverse block) blocks))
- (let ((catch-tag (make-symbol "cl--tagbody-tag")))
+ (let ((catch-tag (make-symbol "cl--tagbody-tag"))
+ (cl--tagbody-alist cl--tagbody-alist))
(push (cons 'cl--exit catch-tag) cl--tagbody-alist)
(dolist (block blocks)
(push (cons (car block) catch-tag) cl--tagbody-alist))
@@ -1689,7 +1820,7 @@ from OBARRAY.
(let (,(car spec))
(mapatoms #'(lambda (,(car spec)) ,@body)
,@(and (cadr spec) (list (cadr spec))))
- ,(cl-caddr spec))))
+ ,(nth 2 spec))))
;;;###autoload
(defmacro cl-do-all-symbols (spec &rest body)
@@ -1737,6 +1868,8 @@ a `let' form, except that the list of symbols can be computed at run-time."
(push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
(eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun))))))))
+(defconst cl--labels-magic (make-symbol "cl--labels-magic"))
+
(defvar cl--labels-convert-cache nil)
(defun cl--labels-convert (f)
@@ -1748,10 +1881,12 @@ a `let' form, except that the list of symbols can be computed at run-time."
;; being expanded even though we don't receive it.
((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
(t
- (let ((found (assq f macroexpand-all-environment)))
- (if (and found (ignore-errors
- (eq (cadr (cl-caddr found)) 'cl-labels-args)))
- (cadr (cl-caddr (cl-cadddr found)))
+ (let* ((found (assq f macroexpand-all-environment))
+ (replacement (and found
+ (ignore-errors
+ (funcall (cdr found) cl--labels-magic)))))
+ (if (and replacement (eq cl--labels-magic (car replacement)))
+ (nth 1 replacement)
(let ((res `(function ,f)))
(setq cl--labels-convert-cache (cons f res))
res))))))
@@ -1760,25 +1895,38 @@ a `let' form, except that the list of symbols can be computed at run-time."
(defmacro cl-flet (bindings &rest body)
"Make local function definitions.
Like `cl-labels' but the definitions are not recursive.
+Each binding can take the form (FUNC EXP) where
+FUNC is the function name, and EXP is an expression that returns the
+function value to which it should be bound, or it can take the more common
+form \(FUNC ARGLIST BODY...) which is a shorthand
+for (FUNC (lambda ARGLIST BODY)).
\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
(declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
(let ((binds ()) (newenv macroexpand-all-environment))
(dolist (binding bindings)
- (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
- (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+ (let ((var (make-symbol (format "--cl-%s--" (car binding))))
+ (args-and-body (cdr binding)))
+ (if (and (= (length args-and-body) 1) (symbolp (car args-and-body)))
+ ;; Optimize (cl-flet ((fun var)) body).
+ (setq var (car args-and-body))
+ (push (list var (if (= (length args-and-body) 1)
+ (car args-and-body)
+ `(cl-function (lambda . ,args-and-body))))
+ binds))
(push (cons (car binding)
- `(lambda (&rest cl-labels-args)
- (cl-list* 'funcall ',var
- cl-labels-args)))
+ (lambda (&rest args)
+ (if (eq (car args) cl--labels-magic)
+ (list cl--labels-magic var)
+ `(funcall ,var ,@args))))
newenv)))
- `(let ,(nreverse binds)
- ,@(macroexp-unprogn
- (macroexpand-all
- `(progn ,@body)
- ;; Don't override lexical-let's macro-expander.
- (if (assq 'function newenv) newenv
- (cons (cons 'function #'cl--labels-convert) newenv)))))))
+ ;; FIXME: Eliminate those functions which aren't referenced.
+ (macroexp-let* (nreverse binds)
+ (macroexpand-all
+ `(progn ,@body)
+ ;; Don't override lexical-let's macro-expander.
+ (if (assq 'function newenv) newenv
+ (cons (cons 'function #'cl--labels-convert) newenv))))))
;;;###autoload
(defmacro cl-flet* (bindings &rest body)
@@ -1805,9 +1953,10 @@ in closures will only work if `lexical-binding' is in use.
(let ((var (make-symbol (format "--cl-%s--" (car binding)))))
(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
(push (cons (car binding)
- `(lambda (&rest cl-labels-args)
- (cl-list* 'funcall ',var
- cl-labels-args)))
+ (lambda (&rest args)
+ (if (eq (car args) cl--labels-magic)
+ (list cl--labels-magic var)
+ (cl-list* 'funcall var args))))
newenv)))
(macroexpand-all `(letrec ,(nreverse binds) ,@body)
;; Don't override lexical-let's macro-expander.
@@ -1829,13 +1978,14 @@ This is like `cl-flet', but for macros instead of functions.
cl-declarations body)))
(if (cdr bindings)
`(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
- (if (null bindings) (cons 'progn body)
+ (if (null bindings) (macroexp-progn body)
(let* ((name (caar bindings))
(res (cl--transform-lambda (cdar bindings) name)))
(eval (car res))
- (macroexpand-all (cons 'progn body)
- (cons (cons name `(lambda ,@(cdr res)))
- macroexpand-all-environment))))))
+ (macroexpand-all (macroexp-progn body)
+ (cons (cons name
+ (eval `(cl-function (lambda ,@(cdr res))) t))
+ macroexpand-all-environment))))))
(defconst cl--old-macroexpand
(if (and (boundp 'cl--old-macroexpand)
@@ -1943,11 +2093,18 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
(unwind-protect
(progn
(fset 'macroexpand #'cl--sm-macroexpand)
- ;; FIXME: For N bindings, this will traverse `body' N times!
- (macroexpand-all (cons 'progn body)
- (cons (list (symbol-name (caar bindings))
- (cl-cadar bindings))
- macroexpand-all-environment)))
+ (let ((expansion
+ ;; FIXME: For N bindings, this will traverse `body' N times!
+ (macroexpand-all (macroexp-progn body)
+ (cons (list (symbol-name (caar bindings))
+ (cl-cadar bindings))
+ macroexpand-all-environment))))
+ (if (or (null (cdar bindings)) (cl-cddar bindings))
+ (macroexp--warn-and-return
+ (format-message "Malformed `cl-symbol-macrolet' binding: %S"
+ (car bindings))
+ expansion)
+ expansion)))
(fset 'macroexpand previous-macroexpand))))))
;;; Multiple values.
@@ -2001,10 +2158,18 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
(declare (debug t))
(cons 'progn body))
;;;###autoload
-(defmacro cl-the (_type form)
- "At present this ignores TYPE and is simply equivalent to FORM."
+(defmacro cl-the (type form)
+ "Return FORM. If type-checking is enabled, assert that it is of TYPE."
(declare (indent 1) (debug (cl-type-spec form)))
- form)
+ (if (not (or (not (cl--compiling-file))
+ (< cl--optimize-speed 3)
+ (= cl--optimize-safety 3)))
+ form
+ (macroexp-let2 macroexp-copyable-p temp form
+ `(progn (unless (cl-typep ,temp ',type)
+ (signal 'wrong-type-argument
+ (list ',type ,temp ',form)))
+ ,temp))))
(defvar cl--proclaim-history t) ; for future compilers
(defvar cl--declare-stack t) ; for future compilers
@@ -2261,8 +2426,80 @@ Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
(if (symbolp func) (cons func rargs)
`(funcall #',func ,@rargs))))))))
+;;;###autoload
+(defmacro cl-defsubst (name args &rest body)
+ "Define NAME as a function.
+Like `defun', except the function is automatically declared `inline' and
+the arguments are immutable.
+ARGLIST allows full Common Lisp conventions, and BODY is implicitly
+surrounded by (cl-block NAME ...).
+The function's arguments should be treated as immutable.
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+ (declare (debug cl-defun) (indent 2))
+ (let* ((argns (cl--arglist-args args))
+ (real-args (if (eq '&cl-defs (car args)) (cddr args) args))
+ (p argns)
+ ;; (pbody (cons 'progn body))
+ )
+ (while (and p (eq (cl--expr-contains real-args (car p)) 1)) (pop p))
+ `(progn
+ ,(if p nil ; give up if defaults refer to earlier args
+ `(cl-define-compiler-macro ,name
+ ,(if (memq '&key args)
+ `(&whole cl-whole &cl-quote ,@args)
+ (cons '&cl-quote args))
+ (cl--defsubst-expand
+ ',argns '(cl-block ,name ,@body)
+ ;; We used to pass `simple' as
+ ;; (not (or unsafe (cl-expr-access-order pbody argns)))
+ ;; But this is much too simplistic since it
+ ;; does not pay attention to the argvs (and
+ ;; cl-expr-access-order itself is also too naive).
+ nil
+ ,(and (memq '&key args) 'cl-whole) nil ,@argns)))
+ (cl-defun ,name ,args ,@body))))
+
+(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs)
+ (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
+ (if (cl--simple-exprs-p argvs) (setq simple t))
+ (let* ((substs ())
+ (lets (delq nil
+ (cl-mapcar (lambda (argn argv)
+ (if (or simple (macroexp-const-p argv))
+ (progn (push (cons argn argv) substs)
+ nil)
+ (list argn argv)))
+ argns argvs))))
+ ;; FIXME: `sublis/subst' will happily substitute the symbol
+ ;; `argn' in places where it's not used as a reference
+ ;; to a variable.
+ ;; FIXME: `sublis/subst' will happily copy `argv' to a different
+ ;; scope, leading to name capture.
+ (setq body (cond ((null substs) body)
+ ((null (cdr substs))
+ (cl-subst (cdar substs) (caar substs) body))
+ (t (cl--sublis substs body))))
+ (if lets `(let ,lets ,body) body))))
+
+(defun cl--sublis (alist tree)
+ "Perform substitutions indicated by ALIST in TREE (non-destructively)."
+ (let ((x (assq tree alist)))
+ (cond
+ (x (cdr x))
+ ((consp tree)
+ (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
+ (t tree))))
+
;;; Structures.
+(defmacro cl--find-class (type)
+ `(get ,type 'cl--class))
+
+;; Rather than hard code cl-structure-object, we indirect through this variable
+;; for bootstrapping reasons.
+(defvar cl--struct-default-parent nil)
+
;;;###autoload
(defmacro cl-defstruct (struct &rest descs)
"Define a struct type.
@@ -2318,14 +2555,12 @@ non-nil value, that slot cannot be set via `setf'.
(tag (intern (format "cl-struct-%s" name)))
(tag-symbol (intern (format "cl-struct-%s-tags" name)))
(include-descs nil)
- (side-eff nil)
+ (include-name nil)
(type nil)
(named nil)
(forms nil)
+ (docstring (if (stringp (car descs)) (pop descs)))
pred-form pred-check)
- (if (stringp (car descs))
- (push `(put ',name 'structure-documentation
- ,(pop descs)) forms))
(setq descs (cons '(cl-tag-slot)
(mapcar (function (lambda (x) (if (consp x) x (list x))))
descs)))
@@ -2350,11 +2585,14 @@ non-nil value, that slot cannot be set via `setf'.
((eq opt :predicate)
(if args (setq predicate (car args))))
((eq opt :include)
- (setq include (car args)
- include-descs (mapcar (function
- (lambda (x)
- (if (consp x) x (list x))))
- (cdr args))))
+ ;; FIXME: Actually, we can include more than once as long as
+ ;; we include EIEIO classes rather than cl-structs!
+ (when include-name (error "Can't :include more than once"))
+ (setq include-name (car args))
+ (setq include-descs (mapcar (function
+ (lambda (x)
+ (if (consp x) x (list x))))
+ (cdr args))))
((eq opt :print-function)
(setq print-func (car args)))
((eq opt :type)
@@ -2366,19 +2604,21 @@ non-nil value, that slot cannot be set via `setf'.
descs)))
(t
(error "Slot option %s unrecognized" opt)))))
+ (unless (or include-name type)
+ (setq include-name cl--struct-default-parent))
+ (when include-name (setq include (cl--struct-get-class include-name)))
(if print-func
(setq print-func
`(progn (funcall #',print-func cl-x cl-s cl-n) t))
- (or type (and include (not (get include 'cl-struct-print)))
+ (or type (and include (not (cl--struct-class-print include)))
(setq print-auto t
print-func (and (or (not (or include type)) (null print-func))
`(progn
(princ ,(format "#S(%s" name) cl-s))))))
(if include
- (let ((inc-type (get include 'cl-struct-type))
- (old-descs (get include 'cl-struct-slots)))
- (or inc-type (error "%s is not a struct name" include))
- (and type (not (eq (car inc-type) type))
+ (let* ((inc-type (cl--struct-class-type include))
+ (old-descs (cl-struct-slot-info include)))
+ (and type (not (eq inc-type type))
(error ":type disagrees with :include for %s" name))
(while include-descs
(setcar (memq (or (assq (caar include-descs) old-descs)
@@ -2387,39 +2627,35 @@ non-nil value, that slot cannot be set via `setf'.
old-descs)
(pop include-descs)))
(setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
- type (car inc-type)
- named (assq 'cl-tag-slot descs))
- (if (cadr inc-type) (setq tag name named t))
- (let ((incl include))
- (while incl
- (push `(cl-pushnew ',tag
- ,(intern (format "cl-struct-%s-tags" incl)))
- forms)
- (setq incl (get incl 'cl-struct-include)))))
+ type inc-type
+ named (if type (assq 'cl-tag-slot descs) 'true))
+ (if (cl--struct-class-named include) (setq tag name named t)))
(if type
(progn
(or (memq type '(vector list))
(error "Invalid :type specifier: %s" type))
(if named (setq tag name)))
- (setq type 'vector named 'true)))
+ (setq named 'true)))
(or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
- (push `(defvar ,tag-symbol) forms)
+ (when (and (null predicate) named)
+ (setq predicate (intern (format "cl--struct-%s-p" name))))
(setq pred-form (and named
(let ((pos (- (length descs)
(length (memq (assq 'cl-tag-slot descs)
descs)))))
- (if (eq type 'vector)
- `(and (vectorp cl-x)
- (>= (length cl-x) ,(length descs))
- (memq (aref cl-x ,pos) ,tag-symbol))
- (if (= pos 0)
- `(memq (car-safe cl-x) ,tag-symbol)
- `(and (consp cl-x)
+ (cond
+ ((memq type '(nil vector))
+ `(and (vectorp cl-x)
+ (>= (length cl-x) ,(length descs))
+ (memq (aref cl-x ,pos) ,tag-symbol)))
+ ((= pos 0) `(memq (car-safe cl-x) ,tag-symbol))
+ (t `(and (consp cl-x)
(memq (nth ,pos cl-x) ,tag-symbol))))))
pred-check (and pred-form (> safety 0)
(if (and (eq (cl-caadr pred-form) 'vectorp)
(= safety 1))
- (cons 'and (cl-cdddr pred-form)) pred-form)))
+ (cons 'and (cl-cdddr pred-form))
+ `(,predicate cl-x))))
(let ((pos 0) (descp descs))
(while descp
(let* ((desc (pop descp))
@@ -2435,14 +2671,15 @@ non-nil value, that slot cannot be set via `setf'.
(push slot slots)
(push (nth 1 desc) defaults)
(push `(cl-defsubst ,accessor (cl-x)
+ (declare (side-effect-free t))
,@(and pred-check
(list `(or ,pred-check
- (error "%s accessing a non-%s"
- ',accessor ',name))))
- ,(if (eq type 'vector) `(aref cl-x ,pos)
+ (signal 'wrong-type-argument
+ (list ',name cl-x)))))
+ ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
(if (= pos 0) '(car cl-x)
- `(nth ,pos cl-x)))) forms)
- (push (cons accessor t) side-eff)
+ `(nth ,pos cl-x))))
+ forms)
(if (cadr (memq :read-only (cddr desc)))
(push `(gv-define-expander ,accessor
(lambda (_cl-do _cl-x)
@@ -2473,30 +2710,32 @@ non-nil value, that slot cannot be set via `setf'.
(setq pos (1+ pos))))
(setq slots (nreverse slots)
defaults (nreverse defaults))
- (and predicate pred-form
- (progn (push `(cl-defsubst ,predicate (cl-x)
- ,(if (eq (car pred-form) 'and)
- (append pred-form '(t))
- `(and ,pred-form t))) forms)
- (push (cons predicate 'error-free) side-eff)))
+ (when pred-form
+ (push `(cl-defsubst ,predicate (cl-x)
+ (declare (side-effect-free error-free))
+ ,(if (eq (car pred-form) 'and)
+ (append pred-form '(t))
+ `(and ,pred-form t)))
+ forms)
+ (push `(put ',name 'cl-deftype-satisfies ',predicate) forms))
(and copier
- (progn (push `(defun ,copier (x) (copy-sequence x)) forms)
- (push (cons copier t) side-eff)))
+ (push `(defalias ',copier #'copy-sequence) forms))
(if constructor
(push (list constructor
- (cons '&key (delq nil (copy-sequence slots))))
- constrs))
- (while constrs
- (let* ((name (caar constrs))
- (args (cadr (pop constrs)))
- (anames (cl--arglist-args args))
+ (cons '&key (delq nil (copy-sequence slots))))
+ 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 `(cl-defsubst ,name
- (&cl-defs '(nil ,@descs) ,@args)
- (,type ,@make)) forms)
- (if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
- (push (cons name t) side-eff))))
+ (push `(cl-defsubst ,cname
+ (&cl-defs (nil ,@descs) ,@args)
+ ,(if (stringp doc) (list 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 #'vector) ,@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
;; by anything anyway!
@@ -2509,81 +2748,201 @@ non-nil value, that slot cannot be set via `setf'.
;; (and ,pred-form ,print-func))
;; cl-custom-print-functions))
;; forms))
- (push `(setq ,tag-symbol (list ',tag)) forms)
- (push `(cl-eval-when (compile load eval)
- (put ',name 'cl-struct-slots ',descs)
- (put ',name 'cl-struct-type ',(list type (eq named t)))
- (put ',name 'cl-struct-include ',include)
- (put ',name 'cl-struct-print ,print-auto)
- ,@(mapcar (lambda (x)
- `(put ',(car x) 'side-effect-free ',(cdr x)))
- side-eff))
- forms)
- `(progn ,@(nreverse (cons `',name forms)))))
-
-;;; Types and assertions.
+ `(progn
+ (defvar ,tag-symbol)
+ ,@(nreverse forms)
+ ;; Call cl-struct-define during compilation as well, so that
+ ;; a subsequent cl-defstruct in the same file can correctly include this
+ ;; struct as a parent.
+ (eval-and-compile
+ (cl-struct-define ',name ,docstring ',include-name
+ ',type ,(eq named t) ',descs ',tag-symbol ',tag
+ ',print-auto))
+ ',name)))
+
+;;; Add cl-struct support to pcase
+
+(defun cl--struct-all-parents (class)
+ (when (cl--struct-class-p class)
+ (let ((res ())
+ (classes (list class)))
+ ;; BFS precedence.
+ (while (let ((class (pop classes)))
+ (push class res)
+ (setq classes
+ (append classes
+ (cl--class-parents class)))))
+ (nreverse res))))
;;;###autoload
-(defmacro cl-deftype (name arglist &rest body)
- "Define NAME as a new data type.
-The type name can then be used in `cl-typecase', `cl-check-type', etc."
- (declare (debug cl-defmacro) (doc-string 3))
- `(cl-eval-when (compile load eval)
- (put ',name 'cl-deftype-handler
- (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
-
-(defun cl--make-type-test (val type)
- (if (symbolp type)
- (cond ((get type 'cl-deftype-handler)
- (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
- ((memq type '(nil t)) type)
- ((eq type 'null) `(null ,val))
- ((eq type 'atom) `(atom ,val))
- ((eq type 'float) `(floatp ,val))
- ((eq type 'real) `(numberp ,val))
- ((eq type 'fixnum) `(integerp ,val))
- ;; FIXME: Should `character' accept things like ?\C-\M-a ? --Stef
- ((memq type '(character string-char)) `(characterp ,val))
- (t
- (let* ((name (symbol-name type))
- (namep (intern (concat name "p"))))
- (if (fboundp namep) (list namep val)
- (list (intern (concat name "-p")) val)))))
- (cond ((get (car type) 'cl-deftype-handler)
- (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler)
- (cdr type))))
- ((memq (car type) '(integer float real number))
- (delq t `(and ,(cl--make-type-test val (car type))
- ,(if (memq (cadr type) '(* nil)) t
- (if (consp (cadr type)) `(> ,val ,(cl-caadr type))
- `(>= ,val ,(cadr type))))
- ,(if (memq (cl-caddr type) '(* nil)) t
- (if (consp (cl-caddr type))
- `(< ,val ,(cl-caaddr type))
- `(<= ,val ,(cl-caddr type)))))))
- ((memq (car type) '(and or not))
- (cons (car type)
- (mapcar (function (lambda (x) (cl--make-type-test val x)))
- (cdr type))))
- ((memq (car type) '(member cl-member))
- `(and (cl-member ,val ',(cdr type)) t))
- ((eq (car type) 'satisfies) (list (cadr type) val))
- (t (error "Bad type spec: %s" type)))))
-
-(defvar cl--object)
+(pcase-defmacro cl-struct (type &rest fields)
+ "Pcase patterns to match cl-structs.
+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 (sexp &rest [&or (sexp pcase-PAT) sexp])))
+ `(and (pred (pcase--flip cl-typep ',type))
+ ,@(mapcar
+ (lambda (field)
+ (let* ((name (if (consp field) (car field) field))
+ (pat (if (consp field) (cadr field) field)))
+ `(app ,(if (eq (cl-struct-sequence-type type) 'list)
+ `(nth ,(cl-struct-slot-offset type name))
+ `(pcase--flip aref ,(cl-struct-slot-offset type name)))
+ ,pat)))
+ fields)))
+
+(defun cl--pcase-mutually-exclusive-p (orig pred1 pred2)
+ "Extra special cases for `cl-typep' predicates."
+ (let* ((x1 pred1) (x2 pred2)
+ (t1
+ (and (eq 'pcase--flip (car-safe x1)) (setq x1 (cdr x1))
+ (eq 'cl-typep (car-safe x1)) (setq x1 (cdr x1))
+ (null (cdr-safe x1)) (setq x1 (car x1))
+ (eq 'quote (car-safe x1)) (cadr x1)))
+ (t2
+ (and (eq 'pcase--flip (car-safe x2)) (setq x2 (cdr x2))
+ (eq 'cl-typep (car-safe x2)) (setq x2 (cdr x2))
+ (null (cdr-safe x2)) (setq x2 (car x2))
+ (eq 'quote (car-safe x2)) (cadr x2))))
+ (or
+ (and (symbolp t1) (symbolp t2)
+ (let ((c1 (cl--find-class t1))
+ (c2 (cl--find-class t2)))
+ (and c1 c2
+ (not (or (memq c1 (cl--struct-all-parents c2))
+ (memq c2 (cl--struct-all-parents c1)))))))
+ (let ((c1 (and (symbolp t1) (cl--find-class t1))))
+ (and c1 (cl--struct-class-p c1)
+ (funcall orig (if (eq 'list (cl-struct-sequence-type t1))
+ 'consp 'vectorp)
+ pred2)))
+ (let ((c2 (and (symbolp t2) (cl--find-class t2))))
+ (and c2 (cl--struct-class-p c2)
+ (funcall orig pred1
+ (if (eq 'list (cl-struct-sequence-type t2))
+ 'consp 'vectorp))))
+ (funcall orig pred1 pred2))))
+(advice-add 'pcase--mutually-exclusive-p
+ :around #'cl--pcase-mutually-exclusive-p)
+
+
+(defun cl-struct-sequence-type (struct-type)
+ "Return the sequence used to build STRUCT-TYPE.
+STRUCT-TYPE is a symbol naming a struct type. Return 'vector or
+'list, or nil if STRUCT-TYPE is not a struct type. "
+ (declare (side-effect-free t) (pure t))
+ (cl--struct-class-type (cl--struct-get-class struct-type)))
+
+(defun cl-struct-slot-info (struct-type)
+ "Return a list of slot names of struct STRUCT-TYPE.
+Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a
+slot name symbol and OPTS is a list of slot options given to
+`cl-defstruct'. Dummy slots that represent the struct name and
+slots skipped by :initial-offset may appear in the list."
+ (declare (side-effect-free t) (pure t))
+ (let* ((class (cl--struct-get-class struct-type))
+ (slots (cl--struct-class-slots class))
+ (type (cl--struct-class-type class))
+ (descs (if type () (list '(cl-tag-slot)))))
+ (dotimes (i (length slots))
+ (let ((slot (aref slots i)))
+ (push `(,(cl--slot-descriptor-name slot)
+ ,(cl--slot-descriptor-initform slot)
+ ,@(if (not (eq (cl--slot-descriptor-type slot) t))
+ `(:type ,(cl--slot-descriptor-type slot)))
+ ,@(cl--slot-descriptor-props slot))
+ descs)))
+ (nreverse descs)))
+
+(define-error 'cl-struct-unknown-slot "struct %S has no slot %S")
+
+(defun cl-struct-slot-offset (struct-type slot-name)
+ "Return the offset of slot SLOT-NAME in STRUCT-TYPE.
+The returned zero-based slot index is relative to the start of
+the structure data type and is adjusted for any structure name
+and :initial-offset slots. Signal error if struct STRUCT-TYPE
+does not contain SLOT-NAME."
+ (declare (side-effect-free t) (pure t))
+ (or (gethash slot-name
+ (cl--class-index-table (cl--struct-get-class struct-type)))
+ (signal 'cl-struct-unknown-slot (list struct-type slot-name))))
+
+(defvar byte-compile-function-environment)
+(defvar byte-compile-macro-environment)
+
+(defun cl--macroexp-fboundp (sym)
+ "Return non-nil if SYM will be bound when we run the code.
+Of course, we really can't know that for sure, so it's just a heuristic."
+ (or (fboundp sym)
+ (and (cl--compiling-file)
+ (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 #'integerp)
+
+
;;;###autoload
-(defun cl-typep (object type) ; See compiler macro below.
- "Check that OBJECT is of type TYPE.
-TYPE is a Common Lisp-style type specifier."
- (declare (compiler-macro cl--compiler-macro-typep))
- (let ((cl--object object)) ;; Yuck!!
- (eval (cl--make-type-test 'cl--object type))))
-
-(defun cl--compiler-macro-typep (form val type)
- (if (macroexp-const-p type)
- (macroexp-let2 macroexp-copyable-p temp val
- (cl--make-type-test temp (cl--const-expr-val type)))
- form))
+(define-inline cl-typep (val type)
+ (inline-letevals (val)
+ (pcase (inline-const-val type)
+ ((and `(,name . ,args) (guard (get name 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(apply (get name 'cl-deftype-handler) args))))
+ (`(,(and name (or 'integer 'float 'real 'number))
+ . ,(or `(,min ,max) pcase--dontcare))
+ (inline-quote
+ (and (cl-typep ,val ',name)
+ ,(if (memq min '(* nil)) t
+ (if (consp min)
+ (inline-quote (> ,val ',(car min)))
+ (inline-quote (>= ,val ',min))))
+ ,(if (memq max '(* nil)) t
+ (if (consp max)
+ (inline-quote (< ,val ',(car max)))
+ (inline-quote (<= ,val ',max)))))))
+ (`(not ,type) (inline-quote (not (cl-typep ,val ',type))))
+ (`(,(and name (or 'and 'or)) . ,types)
+ (cond
+ ((null types) (inline-quote ',(eq name 'and)))
+ ((null (cdr types))
+ (inline-quote (cl-typep ,val ',(car types))))
+ (t
+ (let ((head (car types))
+ (rest `(,name . ,(cdr types))))
+ (cond
+ ((eq name 'and)
+ (inline-quote (and (cl-typep ,val ',head)
+ (cl-typep ,val ',rest))))
+ (t
+ (inline-quote (or (cl-typep ,val ',head)
+ (cl-typep ,val ',rest)))))))))
+ (`(eql ,v) (inline-quote (and (eql ,val ',v) t)))
+ (`(member . ,args) (inline-quote (and (memql ,val ',args) t)))
+ (`(satisfies ,pred) (inline-quote (funcall #',pred ,val)))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-handler)))
+ (inline-quote
+ (cl-typep ,val ',(funcall (get type 'cl-deftype-handler)))))
+ ((and (pred symbolp) type (guard (get type 'cl-deftype-satisfies)))
+ (inline-quote (funcall #',(get type 'cl-deftype-satisfies) ,val)))
+ ((and (or 'nil 't) type) (inline-quote ',type))
+ ((and (pred symbolp) type)
+ (let* ((name (symbol-name type))
+ (namep (intern (concat name "p"))))
+ (cond
+ ((cl--macroexp-fboundp namep) (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp
+ (setq namep (intern (concat name "-p"))))
+ (inline-quote (funcall #',namep ,val)))
+ ((cl--macroexp-fboundp type) (inline-quote (funcall #',type ,val)))
+ (t (error "Unknown type %S" type)))))
+ (type (error "Bad type spec: %s" type)))))
+
;;;###autoload
(defmacro cl-check-type (form type &optional string)
@@ -2592,14 +2951,11 @@ STRING is an optional description of the desired type."
(declare (debug (place cl-type-spec &optional stringp)))
(and (or (not (cl--compiling-file))
(< cl--optimize-speed 3) (= cl--optimize-safety 3))
- (let* ((temp (if (cl--simple-expr-p form 3)
- form (make-symbol "--cl-var--")))
- (body `(or ,(cl--make-type-test temp type)
- (signal 'wrong-type-argument
- (list ,(or string `',type)
- ,temp ',form)))))
- (if (eq temp form) `(progn ,body nil)
- `(let ((,temp ,form)) ,body nil)))))
+ (macroexp-let2 macroexp-copyable-p temp form
+ `(progn (or (cl-typep ,temp ',type)
+ (signal 'wrong-type-argument
+ (list ,(or string `',type) ,temp ',form)))
+ nil))))
;;;###autoload
(defmacro cl-assert (form &optional show-args string &rest args)
@@ -2619,10 +2975,9 @@ omitted, a default message listing FORM itself is used."
(cdr form))))))
`(progn
(or ,form
- ,(if string
- `(error ,string ,@sargs ,@args)
- `(signal 'cl-assertion-failed
- (list ',form ,@sargs))))
+ (cl--assertion-failed
+ ',form ,@(if (or string sargs args)
+ `(,string (list ,@sargs) (list ,@args)))))
nil))))
;;; Compiler macros.
@@ -2639,11 +2994,16 @@ compiler macros are expanded repeatedly until no further expansions are
possible. Unlike regular macros, BODY can decide to \"punt\" and leave the
original function call alone by declaring an initial `&whole foo' parameter
and then returning foo."
- (declare (debug cl-defmacro))
+ (declare (debug cl-defmacro) (indent 2))
(let ((p args) (res nil))
(while (consp p) (push (pop p) res))
(setq args (nconc (nreverse res) (and p (list '&rest p)))))
- (let ((fname (make-symbol (concat (symbol-name func) "--cmacro"))))
+ ;; FIXME: The code in bytecomp mishandles top-level expressions that define
+ ;; uninterned functions. E.g. it would generate code like:
+ ;; (defalias '#1=#:foo--cmacro #[514 ...])
+ ;; (put 'foo 'compiler-macro '#:foo--cmacro)
+ ;; So we circumvent this by using an interned name.
+ (let ((fname (intern (concat (symbol-name func) "--cmacro"))))
`(eval-and-compile
;; Name the compiler-macro function, so that `symbol-file' can find it.
(cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args)
@@ -2677,12 +3037,12 @@ macro that returns its `&whole' argument."
(let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
(cl--active-block-names (cons cl-entry cl--active-block-names))
(cl-body (macroexpand-all ;Performs compiler-macro expansions.
- (cons 'progn (cddr cl-form))
+ (macroexp-progn (cddr cl-form))
macroexpand-all-environment)))
;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able
;; to indicate that this return value is already fully expanded.
(if (cdr cl-entry)
- `(catch ,(nth 1 cl-form) ,@(cdr cl-body))
+ `(catch ,(nth 1 cl-form) ,@(macroexp-unprogn cl-body))
cl-body)))
(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
@@ -2690,67 +3050,6 @@ macro that returns its `&whole' argument."
(if cl-found (setcdr cl-found t)))
`(throw ,cl-tag ,cl-value))
-;;;###autoload
-(defmacro cl-defsubst (name args &rest body)
- "Define NAME as a function.
-Like `defun', except the function is automatically declared `inline',
-ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (cl-block NAME ...).
-
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
- (declare (debug cl-defun) (indent 2))
- (let* ((argns (cl--arglist-args args)) (p argns)
- (pbody (cons 'progn body))
- (unsafe (not (cl--safe-expr-p pbody))))
- (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
- `(progn
- ,(if p nil ; give up if defaults refer to earlier args
- `(cl-define-compiler-macro ,name
- ,(if (memq '&key args)
- `(&whole cl-whole &cl-quote ,@args)
- (cons '&cl-quote args))
- (cl--defsubst-expand
- ',argns '(cl-block ,name ,@body)
- ;; We used to pass `simple' as
- ;; (not (or unsafe (cl-expr-access-order pbody argns)))
- ;; But this is much too simplistic since it
- ;; does not pay attention to the argvs (and
- ;; cl-expr-access-order itself is also too naive).
- nil
- ,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
- (cl-defun ,name ,args ,@body))))
-
-(defun cl--defsubst-expand (argns body simple whole unsafe &rest argvs)
- (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole
- (if (cl--simple-exprs-p argvs) (setq simple t))
- (let* ((substs ())
- (lets (delq nil
- (cl-mapcar (lambda (argn argv)
- (if (or simple (macroexp-const-p argv))
- (progn (push (cons argn argv) substs)
- (and unsafe (list argn argv)))
- (list argn argv)))
- argns argvs))))
- ;; FIXME: `sublis/subst' will happily substitute the symbol
- ;; `argn' in places where it's not used as a reference
- ;; to a variable.
- ;; FIXME: `sublis/subst' will happily copy `argv' to a different
- ;; scope, leading to name capture.
- (setq body (cond ((null substs) body)
- ((null (cdr substs))
- (cl-subst (cdar substs) (caar substs) body))
- (t (cl--sublis substs body))))
- (if lets `(let ,lets ,body) body))))
-
-(defun cl--sublis (alist tree)
- "Perform substitutions indicated by ALIST in TREE (non-destructively)."
- (let ((x (assq tree alist)))
- (cond
- (x (cdr x))
- ((consp tree)
- (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
- (t tree))))
-
;; Compile-time optimizations for some functions defined in this package.
(defun cl--compiler-macro-member (form a list &rest keys)
@@ -2774,9 +3073,8 @@ surrounded by (cl-block NAME ...).
;;;###autoload
(defun cl--compiler-macro-adjoin (form a list &rest keys)
(if (memq :key keys) form
- (macroexp-let2 macroexp-copyable-p va a
- (macroexp-let2 macroexp-copyable-p vlist list
- `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
+ (macroexp-let2* macroexp-copyable-p ((va a) (vlist list))
+ `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist)))))
(defun cl--compiler-macro-get (_form sym prop &optional def)
(if def
@@ -2799,19 +3097,50 @@ surrounded by (cl-block NAME ...).
;;; Things that are inline.
(cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany
- cl-notevery cl--set-elt cl-revappend cl-nreconc gethash))
+ cl-notevery cl-revappend cl-nreconc gethash))
;;; Things that are side-effect-free.
-(mapc (lambda (x) (put x 'side-effect-free t))
+(mapc (lambda (x) (function-put x 'side-effect-free t))
'(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd
cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem
cl-subseq cl-list-length cl-get cl-getf))
;;; Things that are side-effect-and-error-free.
-(mapc (lambda (x) (put x 'side-effect-free 'error-free))
+(mapc (lambda (x) (function-put x 'side-effect-free 'error-free))
'(eql cl-list* cl-subst cl-acons cl-equalp
cl-random-state-p copy-tree cl-sublis))
+;;; Types and assertions.
+
+;;;###autoload
+(defmacro cl-deftype (name arglist &rest body)
+ "Define NAME as a new data type.
+The type name can then be used in `cl-typecase', `cl-check-type', etc."
+ (declare (debug cl-defmacro) (doc-string 3) (indent 2))
+ `(cl-eval-when (compile load eval)
+ (put ',name 'cl-deftype-handler
+ (cl-function (lambda (&cl-defs ('*) ,@arglist) ,@body)))))
+
+(cl-deftype extended-char () `(and character (not base-char)))
+
+;;; Additional functions that we can now define because we've defined
+;;; `cl-defsubst' and `cl-typep'.
+
+(define-inline cl-struct-slot-value (struct-type slot-name inst)
+ "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
+STRUCT and SLOT-NAME are symbols. INST is a structure instance."
+ (declare (side-effect-free t))
+ (inline-letevals (struct-type slot-name inst)
+ (inline-quote
+ (progn
+ (unless (cl-typep ,inst ,struct-type)
+ (signal 'wrong-type-argument (list ,struct-type ,inst)))
+ ;; We could use `elt', but since the byte compiler will resolve the
+ ;; branch below at compile time, it's more efficient to use the
+ ;; type-specific accessor.
+ (if (eq (cl-struct-sequence-type ,struct-type) 'list)
+ (nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst)
+ (aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name)))))))
(run-hooks 'cl-macs-load-hook)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
new file mode 100644
index 00000000000..03480b2756b
--- /dev/null
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -0,0 +1,265 @@
+;;; cl-preloaded.el --- Preloaded part of the CL library -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The cl-defstruct macro is full of circularities, since it uses the
+;; cl-structure-class type (and its accessors) which is defined with itself,
+;; and it setups a default parent (cl-structure-object) which is also defined
+;; with cl-defstruct, and to make things more interesting, the class of
+;; cl-structure-object is of course an object of type cl-structure-class while
+;; cl-structure-class's parent is cl-structure-object.
+;; Furthermore, the code generated by cl-defstruct generally assumes that the
+;; parent will be loaded when the child is loaded. But at the same time, the
+;; expectation is that structs defined with cl-defstruct do not need cl-lib at
+;; run-time, which means that the `cl-structure-object' parent can't be in
+;; cl-lib but should be preloaded. So here's this preloaded circular setup.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-macs)) ;For cl--struct-class.
+
+;; The `assert' macro from the cl package signals
+;; `cl-assertion-failed' at runtime so always define it.
+(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
+
+(defun cl--assertion-failed (form &optional string sargs args)
+ (if debug-on-error
+ (debug `(cl-assertion-failed ,form ,string ,@sargs))
+ (if string
+ (apply #'error string (append sargs args))
+ (signal 'cl-assertion-failed `(,form ,@sargs)))))
+
+;; When we load this (compiled) file during pre-loading, the cl--struct-class
+;; code below will need to access the `cl-struct' info, since it's considered
+;; already as its parent (because `cl-struct' was defined while the file was
+;; compiled). So let's temporarily setup a fake.
+(defvar cl-struct-cl-structure-object-tags nil)
+(unless (cl--find-class 'cl-structure-object)
+ (setf (cl--find-class 'cl-structure-object) 'dummy))
+
+(fset 'cl--make-slot-desc
+ ;; To break circularity, we pre-define the slot constructor by hand.
+ ;; It's redefined a bit further down as part of the cl-defstruct of
+ ;; cl--slot-descriptor.
+ ;; BEWARE: Obviously, it's important to keep the two in sync!
+ (lambda (name &optional initform type props)
+ (vector 'cl-struct-cl-slot-descriptor
+ name initform type props)))
+
+(defun cl--struct-get-class (name)
+ (or (if (not (symbolp name)) name)
+ (cl--find-class name)
+ (if (not (get name 'cl-struct-type))
+ ;; FIXME: Add a conversion for `eieio--class' so we can
+ ;; create a cl-defstruct that inherits from an eieio class?
+ (error "%S is not a struct name" name)
+ ;; Backward compatibility with a defstruct compiled with a version
+ ;; cl-defstruct from Emacs<25. Convert to new format.
+ (let ((tag (intern (format "cl-struct-%s" name)))
+ (type-and-named (get name 'cl-struct-type))
+ (descs (get name 'cl-struct-slots)))
+ (cl-struct-define name nil (get name 'cl-struct-include)
+ (unless (and (eq (car type-and-named) 'vector)
+ (null (cadr type-and-named))
+ (assq 'cl-tag-slot descs))
+ (car type-and-named))
+ (cadr type-and-named)
+ descs
+ (intern (format "cl-struct-%s-tags" name))
+ tag
+ (get name 'cl-struct-print))
+ (cl--find-class name)))))
+
+(defun cl--plist-remove (plist member)
+ (cond
+ ((null plist) nil)
+ ((null member) plist)
+ ((eq plist member) (cddr plist))
+ (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member)))))
+
+(defun cl--struct-register-child (parent tag)
+ ;; Can't use (cl-typep parent 'cl-structure-class) at this stage
+ ;; because `cl-structure-class' is defined later.
+ (while (vectorp parent)
+ (add-to-list (cl--struct-class-children-sym parent) tag)
+ ;; Only register ourselves as a child of the leftmost parent since structs
+ ;; can only only have one parent.
+ (setq parent (car (cl--struct-class-parents parent)))))
+
+;;;###autoload
+(defun cl-struct-define (name docstring parent type named slots children-sym
+ tag print)
+ (cl-assert (or type (not named)))
+ (if (boundp children-sym)
+ (add-to-list children-sym tag)
+ (set children-sym (list tag)))
+ (and (null type) (eq (caar slots) 'cl-tag-slot)
+ ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs.
+ (setq slots (cdr slots)))
+ (let* ((parent-class (when parent (cl--struct-get-class parent)))
+ (n (length slots))
+ (index-table (make-hash-table :test 'eq :size n))
+ (vslots (let ((v (make-vector n nil))
+ (i 0)
+ (offset (if type 0 1)))
+ (dolist (slot slots)
+ (let* ((props (cddr slot))
+ (typep (plist-member props :type))
+ (type (if typep (cadr typep) t)))
+ (aset v i (cl--make-slot-desc
+ (car slot) (nth 1 slot)
+ type (cl--plist-remove props typep))))
+ (puthash (car slot) (+ i offset) index-table)
+ (cl-incf i))
+ v))
+ (class (cl--struct-new-class
+ name docstring
+ (unless (symbolp parent-class) (list parent-class))
+ type named vslots index-table children-sym tag print)))
+ (unless (symbolp parent-class)
+ (let ((pslots (cl--struct-class-slots parent-class)))
+ (or (>= n (length pslots))
+ (let ((ok t))
+ (dotimes (i (length pslots))
+ (unless (eq (cl--slot-descriptor-name (aref pslots i))
+ (cl--slot-descriptor-name (aref vslots i)))
+ (setq ok nil)))
+ ok)
+ (error "Included struct %S has changed since compilation of %S"
+ parent name))))
+ (add-to-list 'current-load-list `(define-type . ,name))
+ (cl--struct-register-child parent-class tag)
+ (unless (eq named t)
+ (eval `(defconst ,tag ',class) t)
+ ;; In the cl-generic support, we need to be able to check
+ ;; if a vector is a cl-struct object, without knowing its particular type.
+ ;; So we use the (otherwise) unused function slots of the tag symbol
+ ;; to put a special witness value, to make the check easy and reliable.
+ (fset tag :quick-object-witness-check))
+ (setf (cl--find-class name) class)))
+
+(cl-defstruct (cl-structure-class
+ (:conc-name cl--struct-class-)
+ (:predicate cl--struct-class-p)
+ (:constructor nil)
+ (:constructor cl--struct-new-class
+ (name docstring parents type named slots index-table
+ children-sym tag print))
+ (:copier nil))
+ "The type of CL structs descriptors."
+ ;; The first few fields here are actually inherited from cl--class, but we
+ ;; have to define this one before, to break the circularity, so we manually
+ ;; list the fields here and later "backpatch" cl--class as the parent.
+ ;; BEWARE: Obviously, it's indispensable to keep these two structs in sync!
+ (name nil :type symbol) ;The type name.
+ (docstring nil :type string)
+ (parents nil :type (list-of cl--class)) ;The included struct.
+ (slots nil :type (vector cl--slot-descriptor))
+ (index-table nil :type hash-table)
+ (tag nil :type symbol) ;Placed in cl-tag-slot. Holds the struct-class object.
+ (type nil :type (memq (vector list)))
+ (named nil :type bool)
+ (print nil :type bool)
+ (children-sym nil :type symbol) ;This sym's value holds the tags of children.
+ )
+
+(cl-defstruct (cl-structure-object
+ (:predicate cl-struct-p)
+ (:constructor nil)
+ (:copier nil))
+ "The root parent of all \"normal\" CL structs")
+
+(setq cl--struct-default-parent 'cl-structure-object)
+
+(cl-defstruct (cl-slot-descriptor
+ (:conc-name cl--slot-descriptor-)
+ (:constructor nil)
+ (:constructor cl--make-slot-descriptor
+ (name &optional initform type props))
+ (:copier cl--copy-slot-descriptor-1))
+ ;; FIXME: This is actually not used yet, for circularity reasons!
+ "Descriptor of structure slot."
+ name ;Attribute name (symbol).
+ initform
+ type
+ ;; Extra properties, kept in an alist, can include:
+ ;; :documentation, :protection, :custom, :label, :group, :printer.
+ (props nil :type alist))
+
+(defun cl--copy-slot-descriptor (slot)
+ (let ((new (cl--copy-slot-descriptor-1 slot)))
+ (cl-callf copy-alist (cl--slot-descriptor-props new))
+ new))
+
+(cl-defstruct (cl--class
+ (:constructor nil)
+ (:copier nil))
+ "Type of descriptors for any kind of structure-like data."
+ ;; Intended to be shared between defstruct and defclass.
+ (name nil :type symbol) ;The type name.
+ (docstring nil :type string)
+ ;; For structs there can only be one parent, but when EIEIO classes inherit
+ ;; from cl--class, we'll need this to hold a list.
+ (parents nil :type (list-of cl--class))
+ (slots nil :type (vector cl-slot-descriptor))
+ (index-table nil :type hash-table))
+
+(cl-assert
+ (let ((sc-slots (cl--struct-class-slots (cl--find-class 'cl-structure-class)))
+ (c-slots (cl--struct-class-slots (cl--find-class 'cl--class)))
+ (eq t))
+ (dotimes (i (length c-slots))
+ (let ((sc-slot (aref sc-slots i))
+ (c-slot (aref c-slots i)))
+ (unless (eq (cl--slot-descriptor-name sc-slot)
+ (cl--slot-descriptor-name c-slot))
+ (setq eq nil))))
+ eq))
+
+;; Close the recursion between cl-structure-object and cl-structure-class.
+(setf (cl--struct-class-parents (cl--find-class 'cl-structure-class))
+ (list (cl--find-class 'cl--class)))
+(cl--struct-register-child
+ (cl--find-class 'cl--class)
+ (cl--struct-class-tag (cl--find-class 'cl-structure-class)))
+
+(cl-assert (cl--find-class 'cl-structure-class))
+(cl-assert (cl--find-class 'cl-structure-object))
+(cl-assert (cl-struct-p (cl--find-class 'cl-structure-class)))
+(cl-assert (cl-struct-p (cl--find-class 'cl-structure-object)))
+(cl-assert (cl--class-p (cl--find-class 'cl-structure-class)))
+(cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
+
+;; Make sure functions defined with cl-defsubst can be inlined even in
+;; packages which do not require CL. We don't put an autoload cookie
+;; directly on that function, since those cookies only go to cl-loaddefs.
+(autoload 'cl--defsubst-expand "cl-macs")
+;; Autoload, so autoload.el and font-lock can use it even when CL
+;; is not loaded.
+(put 'cl-defun 'doc-string-elt 3)
+(put 'cl-defmacro 'doc-string-elt 3)
+(put 'cl-defsubst 'doc-string-elt 3)
+(put 'cl-defstruct 'doc-string-elt 2)
+
+(provide 'cl-preloaded)
+;;; cl-preloaded.el ends here
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 6b5b329e33f..3aea67ad11b 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1,6 +1,6 @@
;;; cl-seq.el --- Common Lisp features, part 3 -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Old-Version: 2.02
@@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned.
(cl-n (min (- (or cl-end1 cl-len) cl-start1)
(- (or cl-end2 cl-len) cl-start2))))
(while (>= (setq cl-n (1- cl-n)) 0)
- (cl--set-elt cl-seq1 (+ cl-start1 cl-n)
+ (setf (elt cl-seq1 (+ cl-start1 cl-n))
(elt cl-seq2 (+ cl-start2 cl-n))))))
(if (listp cl-seq1)
(let ((cl-p1 (nthcdr cl-start1 cl-seq1))
@@ -392,7 +392,7 @@ to avoid corrupting the original SEQ.
cl-seq
(setq cl-seq (copy-sequence cl-seq))
(or cl-from-end
- (progn (cl--set-elt cl-seq cl-i cl-new)
+ (progn (setf (elt cl-seq cl-i) cl-new)
(setq cl-i (1+ cl-i) cl-count (1- cl-count))))
(apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
:start cl-i cl-keys))))))
@@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
(setq cl-end (1- cl-end))
(if (cl--check-test cl-old (elt cl-seq cl-end))
(progn
- (cl--set-elt cl-seq cl-end cl-new)
+ (setf (elt cl-seq cl-end) cl-new)
(setq cl-count (1- cl-count)))))
(while (and (< cl-start cl-end) (> cl-count 0))
(if (cl--check-test cl-old (aref cl-seq cl-start))
@@ -1018,4 +1018,6 @@ Atoms are compared by `eql'; cons cells are compared recursively.
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
+(provide 'cl-seq)
+
;;; cl-seq.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index ea4d9511f9d..46472ccd257 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,6 +1,6 @@
;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
@@ -29,6 +29,7 @@
(require 'cl-lib)
(require 'macroexp)
+(require 'gv)
;; (defun cl--rename ()
;; (let ((vdefs ())
@@ -341,6 +342,8 @@ The two cases that are handled are:
- renaming of F when it's a function defined via `cl-labels' or `labels'."
(require 'cl-macs)
(declare-function cl--expr-contains-any "cl-macs" (x y))
+ (declare-function cl--labels-convert "cl-macs" (f))
+ (defvar cl--labels-convert-cache)
(cond
;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
;; *after* handling `function', but we want to stop macroexpansion from
@@ -373,13 +376,7 @@ The two cases that are handled are:
(setq cl--function-convert-cache (cons newf res))
res))))
(t
- (let ((found (assq f macroexpand-all-environment)))
- (if (and found (ignore-errors
- (eq (cadr (cl-caddr found)) 'cl-labels-args)))
- (cadr (cl-caddr (cl-cadddr found)))
- (let ((res `(function ,f)))
- (setq cl--function-convert-cache (cons f res))
- res))))))
+ (cl--labels-convert f))))
(defmacro lexical-let (bindings &rest body)
"Like `let', but lexically scoped.
@@ -400,7 +397,7 @@ lexical closures as in Common Lisp.
(macroexpand-all
`(cl-symbol-macrolet
,(mapcar (lambda (x)
- `(,(car x) (symbol-value ,(cl-caddr x))))
+ `(,(car x) (symbol-value ,(nth 2 x))))
vars)
,@body)
(cons (cons 'function #'cl--function-convert)
@@ -413,20 +410,20 @@ lexical closures as in Common Lisp.
;; dynamic scoping, since with lexical scoping we'd need
;; (let ((foo <val>)) ...foo...).
`(progn
- ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
- (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+ ,@(mapcar (lambda (x) `(defvar ,(nth 2 x))) vars)
+ (let ,(mapcar (lambda (x) (list (nth 2 x) (nth 1 x))) vars)
,(cl-sublis (mapcar (lambda (x)
- (cons (cl-caddr x)
- `',(cl-caddr x)))
+ (cons (nth 2 x)
+ `',(nth 2 x)))
vars)
ebody)))
`(let ,(mapcar (lambda (x)
- (list (cl-caddr x)
+ (list (nth 2 x)
`(make-symbol ,(format "--%s--" (car x)))))
vars)
(setf ,@(apply #'append
(mapcar (lambda (x)
- (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+ (list `(symbol-value ,(nth 2 x)) (nth 1 x)))
vars)))
,ebody))))
@@ -571,7 +568,7 @@ may be bound to temporary variables which are introduced
automatically to preserve proper execution order of the arguments.
For example:
- (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+ (defsetf nth (n x) (v) \\=`(setcar (nthcdr ,n ,x) ,v))
You can replace this form with `gv-define-setter'.
@@ -629,6 +626,8 @@ You can replace this form with `gv-define-setter'.
;; ...the rest, and build the 5-tuple))
(make-obsolete 'get-setf-method 'gv-letplace "24.3")
+(declare-function cl--arglist-args "cl-macs" (args))
+
(defmacro define-modify-macro (name arglist func &optional doc)
"Define a `setf'-like modify macro.
If NAME is called, it combines its PLACE argument with the other
@@ -642,6 +641,7 @@ You can replace this macro with `gv-letplace'."
symbolp &optional stringp)))
(if (memq '&key arglist)
(error "&key not allowed in define-modify-macro"))
+ (require 'cl-macs) ;For cl--arglist-args.
(let ((place (make-symbol "--cl-place--")))
`(cl-defmacro ,name (,place ,@arglist)
,doc
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index b3fc6fb887a..50f880d7b33 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,6 +1,6 @@
;;; copyright.el --- update the copyright notice in current buffer
-;; Copyright (C) 1991-1995, 1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1991-1995, 1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
@@ -145,18 +145,17 @@ The header must match `copyright-regexp' and `copyright-names-regexp', if set.
This function sets the match-data that `copyright-update-year' uses."
(widen)
(goto-char (copyright-start-point))
- (condition-case err
- ;; (1) Need the extra \\( \\) around copyright-regexp because we
- ;; goto (match-end 1) below. See note (2) below.
- (copyright-re-search (concat "\\(" copyright-regexp
- "\\)\\([ \t]*\n\\)?.*\\(?:"
- copyright-names-regexp "\\)")
- (copyright-limit)
- t)
- ;; In case the regexp is rejected. This is useful because
- ;; copyright-update is typically called from before-save-hook where
- ;; such an error is very inconvenient for the user.
- (error (message "Can't update copyright: %s" err) nil)))
+ ;; In case the regexp is rejected. This is useful because
+ ;; copyright-update is typically called from before-save-hook where
+ ;; such an error is very inconvenient for the user.
+ (with-demoted-errors "Can't update copyright: %s"
+ ;; (1) Need the extra \\( \\) around copyright-regexp because we
+ ;; goto (match-end 1) below. See note (2) below.
+ (copyright-re-search (concat "\\(" copyright-regexp
+ "\\)\\([ \t]*\n\\)?.*\\(?:"
+ copyright-names-regexp "\\)")
+ (copyright-limit)
+ t)))
(defun copyright-find-end ()
"Possibly adjust the search performed by `copyright-find-copyright'.
@@ -376,9 +375,4 @@ If FIX is non-nil, run `copyright-fix-years' instead."
(provide 'copyright)
-;; For the copyright sign:
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; copyright.el ends here
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index b8e327625e7..61cb3c3af4e 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,6 +1,6 @@
;;; crm.el --- read multiple strings with completion
-;; Copyright (C) 1985-1986, 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-2015 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: completion, minibuffer, multiple elements
@@ -24,27 +24,7 @@
;; This code defines a function, `completing-read-multiple', which
;; provides the ability to read multiple strings in the minibuffer,
-;; with completion.
-
-;; By using this functionality, a user may specify multiple strings at
-;; a single prompt, optionally using completion.
-
-;; Multiple strings are specified by separating each of the strings
-;; with a prespecified separator regexp. For example, if the
-;; separator regexp is ",", the strings 'alice', 'bob', and
-;; 'eve' would be specified as 'alice,bob,eve'.
-
-;; The default value for the separator regexp is the value of
-;; `crm-default-separator' (comma). The separator regexp may be
-;; changed by modifying the value of `crm-separator'.
-
-;; Contiguous strings of non-separator-characters are referred to as
-;; 'elements'. In the aforementioned example, the elements are:
-;; 'alice', 'bob', and 'eve'.
-
-;; Completion is available on a per-element basis. For example, if
-;; the contents of the minibuffer are 'alice,bob,eve' and point is
-;; between 'l' and 'i', pressing TAB operates on the element 'alice'.
+;; with completion. See that function's documentation for details.
;; For the moment, I have decided to not bind any special behavior to
;; the separator key. In the future, the separator key might be used
@@ -96,14 +76,16 @@
;; first revamped version
;;; Code:
+
+;; FIXME I don't see that this needs to exist as a separate variable.
+;; crm-separator should suffice.
(defconst crm-default-separator "[ \t]*,[ \t]*"
- "Default separator regexp for `completing-read-multiple'.")
+ "Default value of `crm-separator'.")
(defvar crm-separator crm-default-separator
"Separator regexp used for separating strings in `completing-read-multiple'.
It should be a regexp that does not match the list of completion candidates.
-Modify this value to make `completing-read-multiple' use a separator other
-than `crm-default-separator'.")
+The default value is `crm-default-separator'.")
(defvar crm-local-completion-map
(let ((map (make-sparse-keymap)))
@@ -146,8 +128,8 @@ A value of nil specifies `try-completion'. A value of t specifies
`all-completions'. A value of lambda specifies a test for an exact match.
For more information on STRING, PREDICATE, and FLAG, see the Elisp
-Reference sections on 'Programmed Completion' and 'Basic Completion
-Functions'."
+Reference sections on “Programmed Completion” and “Basic Completion
+Functions”."
(let ((beg 0))
(while (string-match crm-separator string beg)
(setq beg (match-end 0)))
@@ -157,33 +139,32 @@ Functions'."
predicate
flag)))
-(defun crm--select-current-element ()
+(defun crm--current-element ()
"Parse the minibuffer to find the current element.
-Place an overlay on the element, with a `field' property, and return it."
- (let* ((bob (minibuffer-prompt-end))
- (start (save-excursion
+Return the element's boundaries as (START . END)."
+ (let ((bob (minibuffer-prompt-end)))
+ (cons (save-excursion
(if (re-search-backward crm-separator bob t)
(match-end 0)
- bob)))
- (end (save-excursion
+ bob))
+ (save-excursion
(if (re-search-forward crm-separator nil t)
(match-beginning 0)
- (point-max))))
- (ol (make-overlay start end nil nil t)))
- (overlay-put ol 'field (make-symbol "crm"))
- ol))
-
-(defmacro crm--completion-command (command)
- "Make COMMAND a completion command for `completing-read-multiple'."
- `(let ((ol (crm--select-current-element)))
- (unwind-protect
- ,command
- (delete-overlay ol))))
+ (point-max))))))
+
+(defmacro crm--completion-command (beg end &rest body)
+ "Run BODY with BEG and END bound to the current element's boundaries."
+ (declare (indent 2) (debug (sexp sexp &rest body)))
+ `(let* ((crm--boundaries (crm--current-element))
+ (,beg (car crm--boundaries))
+ (,end (cdr crm--boundaries)))
+ ,@body))
(defun crm-completion-help ()
"Display a list of possible completions of the current minibuffer element."
(interactive)
- (crm--completion-command (minibuffer-completion-help))
+ (crm--completion-command beg end
+ (minibuffer-completion-help beg end))
nil)
(defun crm-complete ()
@@ -192,13 +173,18 @@ If no characters can be completed, display a list of possible completions.
Return t if the current element is now a valid match; otherwise return nil."
(interactive)
- (crm--completion-command (minibuffer-complete)))
+ (crm--completion-command beg end
+ (completion-in-region beg end
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
(defun crm-complete-word ()
"Complete the current element at most a single word.
Like `minibuffer-complete-word' but for `completing-read-multiple'."
(interactive)
- (crm--completion-command (minibuffer-complete-word)))
+ (crm--completion-command beg end
+ (completion-in-region--single-word
+ beg end minibuffer-completion-table minibuffer-completion-predicate)))
(defun crm-complete-and-exit ()
"If all of the minibuffer elements are valid completions then exit.
@@ -211,16 +197,14 @@ This function is modeled after `minibuffer-complete-and-exit'."
(goto-char (minibuffer-prompt-end))
(while
(and doexit
- (let ((ol (crm--select-current-element)))
- (goto-char (overlay-end ol))
- (unwind-protect
- (catch 'exit
- (minibuffer-complete-and-exit)
- ;; This did not throw `exit', so there was a problem.
- (setq doexit nil))
- (goto-char (overlay-end ol))
- (delete-overlay ol))
- (not (eobp)))
+ (crm--completion-command beg end
+ (let ((end (copy-marker end t)))
+ (goto-char end)
+ (setq doexit nil)
+ (completion-complete-and-exit beg end
+ (lambda () (setq doexit t)))
+ (goto-char end)
+ (not (eobp))))
(looking-at crm-separator))
;; Skip to the next element.
(goto-char (match-end 0)))
@@ -238,37 +222,29 @@ exiting the minibuffer."
t))
;; superemulates behavior of completing_read in src/minibuf.c
+;; Use \\<crm-local-completion-map> so that help-enable-auto-load can
+;; do its thing. Any keymap that is defined will do.
;;;###autoload
(defun completing-read-multiple
(prompt table &optional predicate require-match initial-input
hist def inherit-input-method)
"Read multiple strings in the minibuffer, with completion.
-By using this functionality, a user may specify multiple strings at a
-single prompt, optionally using completion.
-
-Multiple strings are specified by separating each of the strings with
-a prespecified separator regexp. For example, if the separator
-regexp is \",\", the strings 'alice', 'bob', and 'eve' would be
-specified as 'alice,bob,eve'.
+The arguments are the same as those of `completing-read'.
+\\<crm-local-completion-map>
+Input multiple strings by separating each one with a string that
+matches the regexp `crm-separator'. For example, if the separator
+regexp is \",\", entering \"alice,bob,eve\" specifies the strings
+\"alice\", \"bob\", and \"eve\".
-The default value for the separator regexp is the value of
-`crm-default-separator' (comma). The separator regexp may be
-changed by modifying the value of `crm-separator'.
-
-Contiguous strings of non-separator-characters are referred to as
-'elements'. In the aforementioned example, the elements are: 'alice',
-'bob', and 'eve'.
+We refer to contiguous strings of non-separator-characters as
+\"elements\". In this example there are three elements.
Completion is available on a per-element basis. For example, if the
-contents of the minibuffer are 'alice,bob,eve' and point is between
-'l' and 'i', pressing TAB operates on the element 'alice'.
-
-The return value of this function is a list of the read strings
-with empty strings removed.
+contents of the minibuffer are \"alice,bob,eve\" and point is between
+\"l\" and \"i\", pressing \\[minibuffer-complete] operates on the element \"alice\".
-See the documentation for `completing-read' for details on the arguments:
-PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
-INHERIT-INPUT-METHOD."
+This function returns a list of the strings that were read,
+with empty strings removed."
(unwind-protect
(progn
(add-hook 'choose-completion-string-functions
diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el
new file mode 100644
index 00000000000..1d1780baed0
--- /dev/null
+++ b/lisp/emacs-lisp/cursor-sensor.el
@@ -0,0 +1,180 @@
+;;; cursor-sensor.el --- React to cursor movement -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords:
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package implements the `cursor-intangible' property, which is
+;; meant to replace the old `intangible' property. To use it, just enable the
+;; `cursor-intangible-mode', after which this package will move point away from
+;; any position that has a non-nil `cursor-intangible' property. This is only
+;; done just before redisplay happens, contrary to the old `intangible'
+;; property which was done at a much lower level.
+
+;;; Code:
+
+(defvar cursor-sensor-inhibit nil)
+
+(defun cursor-sensor--intangible-p (pos)
+ (let ((p (get-pos-property pos 'cursor-intangible)))
+ (if p
+ (let (a b)
+ (if (and (setq a (get-char-property pos 'cursor-intangible))
+ (setq b (if (> pos (point-min))
+ (get-char-property (1- pos) 'cursor-intangible)))
+ (not (eq a b)))
+ ;; If we're right between two different intangible thingies,
+ ;; we can stop here. This is not quite consistent with the
+ ;; interpretation of "if it's sticky, then this boundary is
+ ;; itself intangible", but it's convenient (and it better matches
+ ;; the behavior of `intangible', making it easier to port code).
+ nil p))
+ p)))
+
+(defun cursor-sensor-tangible-pos (curpos window &optional second-chance)
+ (let ((newpos curpos))
+ (when (cursor-sensor--intangible-p newpos)
+ (let ((oldpos (window-parameter window 'cursor-intangible--last-point)))
+ (cond
+ ((or (and (integerp oldpos) (< oldpos newpos))
+ (eq newpos (point-min)))
+ (while
+ (when (< newpos (point-max))
+ (setq newpos
+ (if (get-char-property newpos 'cursor-intangible)
+ (next-single-char-property-change
+ newpos 'cursor-intangible nil (point-max))
+ (1+ newpos)))
+ (cursor-sensor--intangible-p newpos))))
+ (t ;; (>= oldpos newpos)
+ (while
+ (when (> newpos (point-min))
+ (setq newpos
+ (if (get-char-property (1- newpos) 'cursor-intangible)
+ (previous-single-char-property-change
+ newpos 'cursor-intangible nil (point-min))
+ (1- newpos)))
+ (cursor-sensor--intangible-p newpos)))))
+ (if (not (and (or (eq newpos (point-min)) (eq newpos (point-max)))
+ (cursor-sensor--intangible-p newpos)))
+ ;; All clear, we're good to go.
+ newpos
+ ;; We're still on an intangible position because we bumped
+ ;; into an intangible BOB/EOB: try to move in the other direction.
+ (if second-chance
+ ;; Actually, we tried already and that failed!
+ curpos
+ (cursor-sensor-tangible-pos newpos window 'second-chance)))))))
+
+(defun cursor-sensor-move-to-tangible (window)
+ (let* ((curpos (window-point window))
+ (newpos (cursor-sensor-tangible-pos curpos window)))
+ (when newpos (set-window-point window newpos))
+ (set-window-parameter window 'cursor-intangible--last-point
+ (or newpos curpos))))
+
+(defun cursor-sensor--move-to-tangible (window)
+ (unless cursor-sensor-inhibit
+ (cursor-sensor-move-to-tangible window)))
+
+;;;###autoload
+(define-minor-mode cursor-intangible-mode
+ "Keep cursor outside of any `cursor-intangible' text property."
+ nil nil nil
+ (if cursor-intangible-mode
+ (add-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible
+ nil t)
+ (remove-hook 'pre-redisplay-functions #'cursor-sensor--move-to-tangible t)))
+
+;;; Detect cursor movement.
+
+(defun cursor-sensor--detect (window)
+ (unless cursor-sensor-inhibit
+ (let* ((point (window-point window))
+ ;; It's often desirable to make the cursor-sensor-functions property
+ ;; non-sticky on both ends, but that means get-pos-property might
+ ;; never see it.
+ (new (or (get-char-property point 'cursor-sensor-functions)
+ (unless (bobp)
+ (get-char-property (1- point) 'cursor-sensor-functions))))
+ (old (window-parameter window 'cursor-sensor--last-state))
+ (oldposmark (car old))
+ (oldpos (or (if oldposmark (marker-position oldposmark))
+ (point-min)))
+ (start (min oldpos point))
+ (end (max oldpos point)))
+ (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer)))
+ ;; `window' does not display the same buffer any more!
+ (setcdr old nil))
+ (if (or (and (null new) (null (cdr old)))
+ (and (eq new (cdr old))
+ (eq (next-single-property-change
+ start 'cursor-sensor-functions nil end)
+ end)))
+ ;; Clearly nothing to do.
+ nil
+ ;; Maybe something to do. Let's see exactly what needs to run.
+ (let* ((missing-p
+ (lambda (f)
+ "Non-nil if F is missing somewhere between START and END."
+ (let ((pos start)
+ (missing nil))
+ (while (< pos end)
+ (setq pos (next-single-property-change
+ pos 'cursor-sensor-functions
+ nil end))
+ (unless (memq f (get-char-property
+ pos 'cursor-sensor-functions))
+ (setq missing t)))
+ missing))))
+ (dolist (f (cdr old))
+ (unless (and (memq f new) (not (funcall missing-p f)))
+ (funcall f window oldpos 'left)))
+ (dolist (f new)
+ (unless (and (memq f (cdr old)) (not (funcall missing-p f)))
+ (funcall f window oldpos 'entered)))))
+
+ ;; Remember current state for next time.
+ ;; Re-read cursor-sensor-functions since the functions may have moved
+ ;; window-point!
+ (if old
+ (progn (move-marker (car old) point)
+ (setcdr old new))
+ (set-window-parameter window 'cursor-sensor--last-state
+ (cons (copy-marker point) new))))))
+
+;;;###autoload
+(define-minor-mode cursor-sensor-mode
+ "Handle the `cursor-sensor-functions' text property.
+This property should hold a list of functions which react to the motion
+of the cursor. They're called with three arguments (WINDOW OLDPOS DIR)
+where WINDOW is the affected window, OLDPOS is the last known position of
+the cursor and DIR can be `left' or `entered' depending on whether the cursor is
+entering the area covered by the text-property property or leaving it."
+ nil nil nil
+ (if cursor-sensor-mode
+ (add-hook 'pre-redisplay-functions #'cursor-sensor--detect
+ nil t)
+ (remove-hook 'pre-redisplay-functions #'cursor-sensor--detect
+ t)))
+
+(provide 'cursor-sensor)
+;;; cursor-sensor.el ends here
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 709a094e73b..0e307fae70a 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -1,9 +1,9 @@
;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
@@ -54,7 +54,7 @@ the middle is discarded, and just the beginning and end are displayed."
The value affects the behavior of operations on any window
previously showing the debugger buffer.
-`nil' means that if its window is not deleted when exiting the
+nil means that if its window is not deleted when exiting the
debugger, invoking `switch-to-prev-buffer' will usually show
the debugger buffer again.
@@ -106,10 +106,10 @@ This is to optimize `debugger-make-xrefs'.")
"Non-nil if we expect to get back in the debugger soon.")
(defvar inhibit-debug-on-entry nil
- "Non-nil means that debug-on-entry is disabled.")
+ "Non-nil means that `debug-on-entry' is disabled.")
(defvar debugger-jumping-flag nil
- "Non-nil means that debug-on-entry is disabled.
+ "Non-nil means that `debug-on-entry' is disabled.
This variable is used by `debugger-jump', `debugger-step-through',
and `debugger-reenable' to temporarily disable debug-on-entry.")
@@ -165,7 +165,6 @@ first will be printed into the backtrace buffer."
;; Don't let these magic variables affect the debugger itself.
(let ((last-command nil) this-command track-mouse
(inhibit-trace t)
- (inhibit-debug-on-entry t)
unread-command-events
unread-post-input-method-events
last-input-event last-command-event last-nonmenu-event
@@ -193,8 +192,10 @@ first will be printed into the backtrace buffer."
debugger-buffer
`((display-buffer-reuse-window
display-buffer-in-previous-window)
- . (,(when debugger-previous-window
- `(previous-window . ,debugger-previous-window)))))
+ . (,(when (and (window-live-p debugger-previous-window)
+ (frame-visible-p
+ (window-frame debugger-previous-window)))
+ `(previous-window . ,debugger-previous-window)))))
(setq debugger-window (selected-window))
(if (eq debugger-previous-window debugger-window)
(when debugger-jumping-flag
@@ -204,7 +205,7 @@ first will be printed into the backtrace buffer."
(window-resize
debugger-window
(- debugger-previous-window-height
- (window-total-size debugger-window)))
+ (window-total-height debugger-window)))
(error nil)))
(setq debugger-previous-window debugger-window))
(debugger-mode)
@@ -236,7 +237,7 @@ first will be printed into the backtrace buffer."
(eq (window-buffer debugger-window) debugger-buffer))
;; Record height of debugger window.
(setq debugger-previous-window-height
- (window-total-size debugger-window)))
+ (window-total-height debugger-window)))
(if debugger-will-be-back
;; Restore previous window configuration (Bug#12623).
(set-window-configuration window-configuration)
@@ -494,9 +495,13 @@ removes itself from that hook."
(forward-line 1)
(while (progn
(forward-char 2)
- (if (= (following-char) ?\()
- (forward-sexp 1)
- (forward-sexp 2))
+ (cond ((debugger--locals-visible-p)
+ (goto-char (next-single-char-property-change
+ (point) 'locals-visible)))
+ ((= (following-char) ?\()
+ (forward-sexp 1))
+ (t
+ (forward-sexp 2)))
(forward-line 1)
(<= (point) opoint))
(if (looking-at " *;;;")
@@ -531,16 +536,20 @@ Applies to the frame whose line point is on in the backtrace."
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
(declare (indent 0))
- `(save-excursion
- (if (null (buffer-live-p debugger-old-buffer))
- ;; old buffer deleted
- (setq debugger-old-buffer (current-buffer)))
- (set-buffer debugger-old-buffer)
+ `(progn
(set-match-data debugger-outer-match-data)
(prog1
(progn ,@body)
(setq debugger-outer-match-data (match-data)))))
+(defun debugger--backtrace-base ()
+ "Return the function name that marks the top of the backtrace.
+See `backtrace-frame'."
+ (cond ((eq 'debug--implement-debug-on-entry
+ (cadr (backtrace-frame 1 'debug)))
+ 'debug--implement-debug-on-entry)
+ (t 'debug)))
+
(defun debugger-eval-expression (exp &optional nframe)
"Eval an expression, in an environment like that outside the debugger.
The environment used is the one when entering the activation frame at point."
@@ -549,15 +558,70 @@ The environment used is the one when entering the activation frame at point."
(let ((nframe (or nframe
(condition-case nil (1+ (debugger-frame-number 'skip-base))
(error 0)))) ;; If on first line.
- (base (if (eq 'debug--implement-debug-on-entry
- (cadr (backtrace-frame 1 'debug)))
- 'debug--implement-debug-on-entry 'debug)))
+ (base (debugger--backtrace-base)))
(debugger-env-macro
(let ((val (backtrace-eval exp nframe base)))
(prog1
(prin1 val t)
(let ((str (eval-expression-print-format val)))
(if str (princ str t))))))))
+
+(defun debugger--locals-visible-p ()
+ "Are the local variables of the current stack frame visible?"
+ (save-excursion
+ (move-to-column 2)
+ (get-text-property (point) 'locals-visible)))
+
+(defun debugger--insert-locals (locals)
+ "Insert the local variables LOCALS at point."
+ (cond ((null locals)
+ (insert "\n [no locals]"))
+ (t
+ (let ((print-escape-newlines t))
+ (dolist (s+v locals)
+ (let ((symbol (car s+v))
+ (value (cdr s+v)))
+ (insert "\n ")
+ (prin1 symbol (current-buffer))
+ (insert " = ")
+ (prin1 value (current-buffer))))))))
+
+(defun debugger--show-locals ()
+ "For the frame at point, insert locals and add text properties."
+ (let* ((nframe (1+ (debugger-frame-number 'skip-base)))
+ (base (debugger--backtrace-base))
+ (locals (backtrace--locals nframe base))
+ (inhibit-read-only t))
+ (save-excursion
+ (let ((start (progn
+ (move-to-column 2)
+ (point))))
+ (end-of-line)
+ (debugger--insert-locals locals)
+ (add-text-properties start (point) '(locals-visible t))))))
+
+(defun debugger--hide-locals ()
+ "Delete local variables and remove the text property."
+ (let* ((col (current-column))
+ (end (progn
+ (move-to-column 2)
+ (next-single-char-property-change (point) 'locals-visible)))
+ (start (previous-single-char-property-change end 'locals-visible))
+ (inhibit-read-only t))
+ (remove-text-properties start end '(locals-visible))
+ (goto-char start)
+ (end-of-line)
+ (delete-region (point) end)
+ (move-to-column col)))
+
+(defun debugger-toggle-locals ()
+ "Show or hide local variables of the current stack frame."
+ (interactive)
+ (cond ((debugger--locals-visible-p)
+ (debugger--hide-locals))
+ (t
+ (debugger--show-locals))))
+
(defvar debugger-mode-map
(let ((map (make-keymap))
@@ -575,6 +639,7 @@ The environment used is the one when entering the activation frame at point."
(define-key map "h" 'describe-mode)
(define-key map "q" 'top-level)
(define-key map "e" 'debugger-eval-expression)
+ (define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables".
(define-key map " " 'next-line)
(define-key map "R" 'debugger-record-expression)
(define-key map "\C-m" 'debug-help-follow)
@@ -626,7 +691,7 @@ The environment used is the one when entering the activation frame at point."
(put 'debugger-mode 'mode-class 'special)
-(defun debugger-mode ()
+(define-derived-mode debugger-mode fundamental-mode "Debugger"
"Mode for backtrace buffers, selected in debugger.
\\<debugger-mode-map>
A line starts with `*' if exiting that frame will call the debugger.
@@ -641,13 +706,9 @@ which functions will enter the debugger when called.
Complete list of commands:
\\{debugger-mode-map}"
- (kill-all-local-variables)
- (setq major-mode 'debugger-mode)
- (setq mode-name "Debugger")
(setq truncate-lines t)
(set-syntax-table emacs-lisp-mode-syntax-table)
- (use-local-map debugger-mode-map)
- (run-mode-hooks 'debugger-mode-hook))
+ (use-local-map debugger-mode-map))
(defcustom debugger-record-buffer "*Debugger-record*"
"Buffer name for expression values, for \\[debugger-record-expression]."
@@ -670,14 +731,11 @@ Complete list of commands:
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
-(declare-function help-xref-interned "help-mode" (symbol))
-
(defun debug-help-follow (&optional pos)
"Follow cross-reference at POS, defaulting to point.
For the cross-reference format, see `help-make-xrefs'."
(interactive "d")
- (require 'help-mode)
;; Ideally we'd just do (call-interactively 'help-follow) except that this
;; assumes we're already in a *Help* buffer and reuses it, so it ends up
;; incorrectly "reusing" the *Backtrace* buffer to show the help info.
@@ -693,7 +751,7 @@ For the cross-reference format, see `help-make-xrefs'."
(progn (skip-syntax-forward "w_")
(point)))))))
(when (or (boundp sym) (fboundp sym) (facep sym))
- (help-xref-interned sym)))))
+ (describe-symbol sym)))))
;; When you change this, you may also need to change the number of
;; frames that the debugger skips.
@@ -703,7 +761,8 @@ A call to this function is inserted by `debug-on-entry' to cause
functions to break on entry."
(if (or inhibit-debug-on-entry debugger-jumping-flag)
nil
- (funcall debugger 'debug)))
+ (let ((inhibit-debug-on-entry t))
+ (funcall debugger 'debug))))
;;;###autoload
(defun debug-on-entry (function)
@@ -734,7 +793,8 @@ Redefining FUNCTION also cancels it."
(not (special-form-p symbol))))
t nil nil (symbol-name fn)))
(list (if (equal val "") fn (intern val)))))
- (advice-add function :before #'debug--implement-debug-on-entry)
+ (advice-add function :before #'debug--implement-debug-on-entry
+ '((depth . -100)))
function)
(defun debug--function-list ()
@@ -764,7 +824,7 @@ To specify a nil argument interactively, exit with an empty minibuffer."
(progn
(advice-remove function #'debug--implement-debug-on-entry)
function)
- (message "Cancelling debug-on-entry for all functions")
+ (message "Canceling debug-on-entry for all functions")
(mapcar #'cancel-debug-on-entry (debug--function-list))))
(defun debugger-list-functions ()
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 96c223c9e18..ee137f1771e 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,11 +1,11 @@
;;; derived.el --- allow inheritance of major modes
;; (formerly mode-clone.el)
-;; Copyright (C) 1993-1994, 1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1993-1994, 1999, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; Package: emacs
@@ -162,7 +162,8 @@ The new mode runs the hook constructed by the function
See Info node `(elisp)Derived Modes' for more details."
(declare (debug (&define name symbolp sexp [&optional stringp]
[&rest keywordp sexp] def-body))
- (doc-string 4))
+ (doc-string 4)
+ (indent 3))
(when (and docstring (not (stringp docstring)))
;; Some trickiness, since what appears to be the docstring may really be
@@ -330,8 +331,11 @@ which more-or-less shadow%s %s's corresponding table%s."
"\n\nThis mode "
(concat
"\n\nIn addition to any hooks its parent mode "
- (if (string-match (regexp-quote (format "`%s'" parent))
- docstring) nil
+ (if (string-match (format "[`‘]%s['’]"
+ (regexp-quote
+ (symbol-name parent)))
+ docstring)
+ nil
(format "`%s' " parent))
"might have run,\nthis mode "))
(format "runs the hook `%s'" hook)
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index dc0e55df500..12cf605cce9 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,10 +1,10 @@
-;;; disass.el --- disassembler for compiled Emacs Lisp code
+;;; disass.el --- disassembler for compiled Emacs Lisp code -*- lexical-binding:t -*-
-;; Copyright (C) 1986, 1991, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991, 2002-2015 Free Software Foundation, Inc.
;; Author: Doug Cutting <doug@csli.stanford.edu>
;; Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -37,9 +37,9 @@
(require 'macroexp)
-;;; The variable byte-code-vector is defined by the new bytecomp.el.
-;;; The function byte-decompile-lapcode is defined in byte-opt.el.
-;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
+;; The variable byte-code-vector is defined by the new bytecomp.el.
+;; The function byte-decompile-lapcode is defined in byte-opt.el.
+;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
(require 'byte-compile "bytecomp")
(defvar disassemble-column-1-indent 8 "*")
@@ -57,8 +57,8 @@ redefine OBJECT if it is a symbol."
(interactive (list (intern (completing-read "Disassemble function: "
obarray 'fboundp t))
nil 0 t))
- (if (and (consp object) (not (eq (car object) 'lambda)))
- (setq object (list 'lambda () object)))
+ (if (and (consp object) (not (functionp object)))
+ (setq object `(lambda () ,object)))
(or indent (setq indent 0)) ;Default indent to zero
(save-excursion
(if (or interactive-p (null buffer))
@@ -72,37 +72,34 @@ redefine OBJECT if it is a symbol."
(defun disassemble-internal (obj indent interactive-p)
(let ((macro 'nil)
- (name 'nil)
- (doc 'nil)
+ (name (when (symbolp obj)
+ (prog1 obj
+ (setq obj (indirect-function obj)))))
args)
- (while (symbolp obj)
- (setq name obj
- obj (symbol-function obj)))
+ (setq obj (autoload-do-load obj name))
(if (subrp obj)
(error "Can't disassemble #<subr %s>" name))
- (setq obj (autoload-do-load obj name))
(if (eq (car-safe obj) 'macro) ;Handle macros.
(setq macro t
obj (cdr obj)))
- (if (and (listp obj) (eq (car obj) 'byte-code))
- (setq obj (list 'lambda nil obj)))
- (if (and (listp obj) (not (eq (car obj) 'lambda)))
- (error "not a function"))
- (if (consp obj)
- (if (assq 'byte-code obj)
- nil
- (if interactive-p (message (if name
- "Compiling %s's definition..."
- "Compiling definition...")
- name))
- (setq obj (byte-compile obj))
- (if interactive-p (message "Done compiling. Disassembling..."))))
+ (if (eq (car-safe obj) 'byte-code)
+ (setq obj `(lambda () ,obj)))
+ (when (consp obj)
+ (unless (functionp obj) (error "not a function"))
+ (if (assq 'byte-code obj)
+ nil
+ (if interactive-p (message (if name
+ "Compiling %s's definition..."
+ "Compiling definition...")
+ name))
+ (setq obj (byte-compile obj))
+ (if interactive-p (message "Done compiling. Disassembling..."))))
(cond ((consp obj)
+ (setq args (help-function-arglist obj)) ;save arg list
(setq obj (cdr obj)) ;throw lambda away
- (setq args (car obj)) ;save arg list
(setq obj (cdr obj)))
((byte-code-function-p obj)
- (setq args (aref obj 0)))
+ (setq args (help-function-arglist obj)))
(t (error "Compilation failed")))
(if (zerop indent) ; not a nested function
(progn
@@ -127,10 +124,7 @@ redefine OBJECT if it is a symbol."
(insert " args: ")
(prin1 args (current-buffer))
(insert "\n")
- (let ((interactive (cond ((consp obj)
- (assq 'interactive obj))
- ((> (length obj) 5)
- (list 'interactive (aref obj 5))))))
+ (let ((interactive (interactive-form obj)))
(if interactive
(progn
(setq interactive (nth 1 interactive))
@@ -226,15 +220,16 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
;; but if the value of the constant is compiled code, then
;; recursively disassemble it.
(cond ((or (byte-code-function-p arg)
- (and (eq (car-safe arg) 'lambda)
+ (and (consp arg) (functionp arg)
(assq 'byte-code arg))
(and (eq (car-safe arg) 'macro)
(or (byte-code-function-p (cdr arg))
- (and (eq (car-safe (cdr arg)) 'lambda)
+ (and (consp (cdr arg))
+ (functionp (cdr arg))
(assq 'byte-code (cdr arg))))))
(cond ((byte-code-function-p arg)
(insert "<compiled-function>\n"))
- ((eq (car-safe arg) 'lambda)
+ ((functionp arg)
(insert "<compiled lambda>"))
(t (insert "<compiled macro>\n")))
(disassemble-internal
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 1301b70bb85..56f95111ab8 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,6 +1,6 @@
;;; easy-mmode.el --- easy definition for major and minor modes
-;; Copyright (C) 1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -114,9 +114,12 @@ Optional KEYMAP is the default keymap bound to the mode keymap.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
- alternating keywords and values. These following special keywords
- are supported (other keywords are passed to `defcustom' if the minor
- mode is global):
+ alternating keywords and values. If you provide BODY, then you must
+ provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
+ at least one keyword argument, or both; otherwise, BODY would be
+ misinterpreted as the first omitted argument. The following special
+ keywords are supported (other keywords are passed to `defcustom' if
+ 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\".
@@ -133,7 +136,7 @@ BODY contains code to execute each time the mode is enabled or disabled.
:variable PLACE The location to use instead of the variable MODE to store
the state of the mode. This can be simply a different
named variable, or a generalized variable.
- PLACE can also be of the form \(GET . SET), where GET is
+ PLACE can also be of the form (GET . SET), where GET is
an expression that returns the current state, and SET is
a function that takes one argument, the new state, and
sets it. If you specify a :variable, this function does
@@ -148,17 +151,19 @@ For example, you could write
:lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
...BODY CODE...)"
(declare (doc-string 2)
- (debug (&define name stringp
- [&optional [&not keywordp] sexp
- &optional [&not keywordp] sexp
- &optional [&not keywordp] sexp]
- [&rest [keywordp sexp]]
- def-body)))
+ (debug (&define name string-or-null-p
+ [&optional [&not keywordp] sexp
+ &optional [&not keywordp] sexp
+ &optional [&not keywordp] sexp]
+ [&rest [keywordp sexp]]
+ def-body))
+ (indent 1))
;; Allow skipping the first three args.
(cond
((keywordp init-value)
- (setq body `(,init-value ,lighter ,keymap ,@body)
+ (setq body (if keymap `(,init-value ,lighter ,keymap ,@body)
+ `(,init-value ,lighter))
init-value nil lighter nil keymap nil))
((keywordp lighter)
(setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
@@ -175,7 +180,8 @@ For example, you could write
(extra-args nil)
(extra-keywords nil)
(variable nil) ;The PLACE where the state is stored.
- (setter nil) ;The function (if any) to set the mode var.
+ (setter `(setq ,mode)) ;The beginning of the exp to set the mode var.
+ (getter mode) ;The exp to get the mode value.
(modefun mode) ;The minor mode function name we're defining.
(require t)
(after-hook nil)
@@ -190,7 +196,10 @@ For example, you could write
(pcase keyw
(`:init-value (setq init-value (pop body)))
(`:lighter (setq lighter (purecopy (pop body))))
- (`:global (setq globalp (pop body)))
+ (`:global (setq globalp (pop body))
+ (when (and globalp (symbolp mode))
+ (setq setter `(setq-default ,mode))
+ (setq getter `(default-value ',mode))))
(`:extra-args (setq extra-args (pop body)))
(`:set (setq set (list :set (pop body))))
(`:initialize (setq initialize (list :initialize (pop body))))
@@ -203,16 +212,18 @@ For example, you could write
(or (symbolp tmp)
(functionp tmp))))
;; PLACE is not of the form (GET . SET).
- (setq mode variable)
- (setq mode (car variable))
- (setq setter (cdr variable))))
+ (progn
+ (setq setter `(setf ,variable))
+ (setq getter variable))
+ (setq getter (car variable))
+ (setq setter `(funcall #',(cdr variable)))))
(`:after-hook (setq after-hook (pop body)))
(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
(setq keymap-sym (if (and keymap (symbolp keymap)) keymap
(intern (concat mode-name "-map"))))
- (unless set (setq set '(:set 'custom-set-minor-mode)))
+ (unless set (setq set '(:set #'custom-set-minor-mode)))
(unless initialize
(setq initialize '(:initialize 'custom-initialize-default)))
@@ -267,30 +278,30 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
;; repeat-command still does the toggling correctly.
(interactive (list (or current-prefix-arg 'toggle)))
(let ((,last-message (current-message)))
- (,@(if setter `(funcall #',setter)
- (list (if (symbolp mode) 'setq 'setf) mode))
+ (,@setter
(if (eq arg 'toggle)
- (not ,mode)
+ (not ,getter)
;; A nil argument also means ON now.
(> (prefix-numeric-value arg) 0)))
,@body
;; The on/off hooks are here for backward compatibility only.
- (run-hooks ',hook (if ,mode ',hook-on ',hook-off))
+ (run-hooks ',hook (if ,getter ',hook-on ',hook-off))
(if (called-interactively-p 'any)
(progn
- ,(if (and globalp (symbolp mode))
+ ,(if (and globalp (not variable))
`(customize-mark-as-set ',mode))
;; Avoid overwriting a message shown by the body,
;; but do overwrite previous messages.
(unless (and (current-message)
(not (equal ,last-message
(current-message))))
- (message ,(format "%s %%sabled" pretty-name)
- (if ,mode "en" "dis")))))
+ (let ((local ,(if globalp "" " in current buffer")))
+ (message ,(format "%s %%sabled%%s" pretty-name)
+ (if ,getter "en" "dis") local)))))
,@(when after-hook `(,after-hook)))
(force-mode-line-update)
;; Return the new setting.
- ,mode)
+ ,getter)
;; Autoloading a define-minor-mode autoloads everything
;; up-to-here.
@@ -300,7 +311,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
,(format "Hook run after entering or leaving `%s'.
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
- mode))
+ modefun))
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
@@ -311,15 +322,16 @@ No problems result if this variable is not bound.
(t (error "Invalid keymap %S" m))))
,(format "Keymap for `%s'." mode-name)))
- ,(if (not (symbolp mode))
- (if (or lighter keymap)
- (error ":lighter and :keymap unsupported with mode expression %s" mode))
- `(with-no-warnings
- (add-minor-mode ',mode ',lighter
- ,(if keymap keymap-sym
- `(if (boundp ',keymap-sym) ,keymap-sym))
- nil
- ,(unless (eq mode modefun) `',modefun)))))))
+ ,(let ((modevar (pcase getter (`(default-value ',v) v) (_ getter))))
+ (if (not (symbolp modevar))
+ (if (or lighter keymap)
+ (error ":lighter and :keymap unsupported with mode expression %S" getter))
+ `(with-no-warnings
+ (add-minor-mode ',modevar ',lighter
+ ,(if keymap keymap-sym
+ `(if (boundp ',keymap-sym) ,keymap-sym))
+ nil
+ ,(unless (eq mode modefun) `',modefun))))))))
;;;
;;; make global minor mode
@@ -399,7 +411,7 @@ otherwise, disable it. If called from Lisp, enable the mode if
ARG is omitted or nil.
%s is enabled in all buffers where
-\`%s' would do it.
+`%s' would do it.
See `%s' for more information on %s."
pretty-name pretty-global-name
pretty-name turn-on mode pretty-name)
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index f33ae54bf25..ad2ba6994f2 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -1,6 +1,6 @@
-;;; easymenu.el --- support the easymenu interface for defining a menu
+;;; easymenu.el --- support the easymenu interface for defining a menu -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998-2015 Free Software Foundation, Inc.
;; Keywords: emulations
;; Author: Richard Stallman <rms@gnu.org>
@@ -218,21 +218,22 @@ MENU-NAME is a string, the name of the menu. MENU-ITEMS is a list of items
possibly preceded by keyword pairs as described in `easy-menu-define'."
(let ((menu (make-sparse-keymap menu-name))
(easy-menu-avoid-duplicate-keys nil)
- prop keyword arg label enable filter visible help)
+ prop keyword label enable filter visible help)
;; Look for keywords.
(while (and menu-items
(cdr menu-items)
(keywordp (setq keyword (car menu-items))))
- (setq arg (cadr menu-items))
- (setq menu-items (cddr menu-items))
- (pcase keyword
- (`:filter
- (setq filter `(lambda (menu)
- (easy-menu-filter-return (,arg menu) ,menu-name))))
- ((or `:enable `:active) (setq enable (or arg ''nil)))
- (`:label (setq label arg))
- (`:help (setq help arg))
- ((or `:included `:visible) (setq visible (or arg ''nil)))))
+ (let ((arg (cadr menu-items)))
+ (setq menu-items (cddr menu-items))
+ (pcase keyword
+ (`:filter
+ (setq filter (lambda (menu)
+ (easy-menu-filter-return (funcall arg menu)
+ menu-name))))
+ ((or `:enable `:active) (setq enable (or arg ''nil)))
+ (`:label (setq label arg))
+ (`:help (setq help arg))
+ ((or `:included `:visible) (setq visible (or arg ''nil))))))
(if (equal visible ''nil)
nil ; Invisible menu entry, return nil.
(if (and visible (not (easy-menu-always-true-p visible)))
@@ -496,7 +497,7 @@ Contrary to XEmacs, this is a nop on Emacs since menus are automatically
\(fn MENU)")
-(defun easy-menu-add (menu &optional map)
+(defun easy-menu-add (_menu &optional _map)
"Add the menu to the menubar.
On Emacs, menus are already automatically activated when the
corresponding keymap is activated. On XEmacs this is needed to
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index ec343eab631..a3e3b567cc4 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1,10 +1,10 @@
;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1988-1995, 1997, 1999-2013 Free Software Foundation,
+;; Copyright (C) 1988-1995, 1997, 1999-2015 Free Software Foundation,
;; Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, tools, maint
;; This file is part of GNU Emacs.
@@ -85,7 +85,7 @@ This applies to `eval-defun', `eval-region', `eval-buffer', and
You can use the command `edebug-all-defs' to toggle the value of this
variable. You may wish to make it local to each buffer with
-\(make-local-variable 'edebug-all-defs) in your
+\(make-local-variable \\='edebug-all-defs) in your
`emacs-lisp-mode-hook'."
:type 'boolean
:group 'edebug)
@@ -411,12 +411,7 @@ Return the result of the last expression in BODY."
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-;; Save the original read function
-(defalias 'edebug-original-read
- (symbol-function (if (fboundp 'edebug-original-read)
- 'edebug-original-read 'read)))
-
-(defun edebug-read (&optional stream)
+(defun edebug--read (orig &optional stream)
"Read one Lisp expression as text from STREAM, return as Lisp object.
If STREAM is nil, use the value of `standard-input' (which see).
STREAM or the value of `standard-input' may be:
@@ -434,10 +429,7 @@ the option `edebug-all-forms'."
(or stream (setq stream standard-input))
(if (eq stream (current-buffer))
(edebug-read-and-maybe-wrap-form)
- (edebug-original-read stream)))
-
-(or (fboundp 'edebug-original-eval-defun)
- (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
+ (funcall (or orig #'read) stream)))
(defvar edebug-result) ; The result of the function call returned by body.
@@ -497,7 +489,10 @@ the minibuffer."
(put (nth 1 form) 'saved-face nil)))))
(setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding))
(if (not edebugging)
- (princ edebug-result)
+ (prog1
+ (prin1 edebug-result)
+ (let ((str (eval-expression-print-format edebug-result)))
+ (if str (princ str))))
edebug-result)))
@@ -565,16 +560,13 @@ already is one.)"
(defun edebug-install-read-eval-functions ()
(interactive)
- ;; Don't install if already installed.
- (unless load-read-function
- (setq load-read-function 'edebug-read)
- (defalias 'eval-defun 'edebug-eval-defun)))
+ (add-function :around load-read-function #'edebug--read)
+ (advice-add 'eval-defun :override #'edebug-eval-defun))
(defun edebug-uninstall-read-eval-functions ()
(interactive)
- (setq load-read-function nil)
- (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-
+ (remove-function load-read-function #'edebug--read)
+ (advice-remove 'eval-defun 'edebug-eval-defun))
;;; Edebug internal data
@@ -608,7 +600,7 @@ list of a symbol.")
(defun edebug-get-form-data-entry (pnt &optional end-point)
;; Find the edebug form data entry which is closest to PNT.
;; If END-POINT is supplied, match must be exact.
- ;; Return `nil' if none found.
+ ;; Return nil if none found.
(let ((rest edebug-form-data)
closest-entry
(closest-dist 999999)) ;; Need maxint here.
@@ -719,8 +711,8 @@ Maybe clear the markers and delete the symbol's edebug property?"
(cond
;; read goes one too far if a (possibly quoted) string or symbol
;; is immediately followed by non-whitespace.
- ((eq class 'symbol) (edebug-original-read (current-buffer)))
- ((eq class 'string) (edebug-original-read (current-buffer)))
+ ((eq class 'symbol) (read (current-buffer)))
+ ((eq class 'string) (read (current-buffer)))
((eq class 'quote) (forward-char 1)
(list 'quote (edebug-read-sexp)))
((eq class 'backquote)
@@ -728,7 +720,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
((eq class 'comma)
(list '\, (edebug-read-sexp)))
(t ; anything else, just read it.
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
;;; Offsets for reader
@@ -824,14 +816,11 @@ Maybe clear the markers and delete the symbol's edebug property?"
(funcall
(or (cdr (assq (edebug-next-token-class) edebug-read-alist))
;; anything else, just read it.
- 'edebug-original-read)
+ #'read)
stream))))
-(defun edebug-read-symbol (stream)
- (edebug-original-read stream))
-
-(defun edebug-read-string (stream)
- (edebug-original-read stream))
+(defalias 'edebug-read-symbol #'read)
+(defalias 'edebug-read-string #'read)
(defun edebug-read-quote (stream)
;; Turn 'thing into (quote thing)
@@ -875,7 +864,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
?7 ?8 ?9 ?0))
(backward-char 1)
- (edebug-original-read stream))
+ (read stream))
(t (edebug-syntax-error "Bad char after #"))))
(defun edebug-read-list (stream)
@@ -1046,16 +1035,15 @@ Maybe clear the markers and delete the symbol's edebug property?"
edebug-gate
edebug-best-error
edebug-error-point
- no-match
;; Do this once here instead of several times.
(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
(max-specpdl-size (+ 2000 max-specpdl-size)))
- (setq no-match
- (catch 'no-match
- (setq result (edebug-read-and-maybe-wrap-form1))
- nil))
- (if no-match
- (apply 'edebug-syntax-error no-match))
+ (let ((no-match
+ (catch 'no-match
+ (setq result (edebug-read-and-maybe-wrap-form1))
+ nil)))
+ (if no-match
+ (apply 'edebug-syntax-error no-match)))
result))
@@ -1074,7 +1062,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
(if (and (eq 'lparen (edebug-next-token-class))
(eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
;; Find out if this is a defining form from first symbol
- (setq def-kind (edebug-original-read (current-buffer))
+ (setq def-kind (read (current-buffer))
spec (and (symbolp def-kind) (get-edebug-spec def-kind))
defining-form-p (and (listp spec)
(eq '&define (car spec)))
@@ -1082,7 +1070,7 @@ Maybe clear the markers and delete the symbol's edebug property?"
def-name (if (and defining-form-p
(eq 'name (car (cdr spec)))
(eq 'symbol (edebug-next-token-class)))
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
(cond
(defining-form-p
@@ -1737,6 +1725,17 @@ expressions; a `progn' form will be returned enclosing these forms."
(t
(error "Bad spec: %s" specs)))))
+ ((eq 'vector spec)
+ (if (vectorp form)
+ ;; Special case: match a vector with the specs.
+ (let ((result (edebug-match-sublist
+ (edebug-new-cursor
+ form (cdr (edebug-top-offset cursor)))
+ (cdr specs))))
+ (edebug-move-cursor cursor)
+ (list (apply 'vector result)))
+ (edebug-no-match cursor "Expected" specs)))
+
((listp form)
(prog1
(list (edebug-match-sublist
@@ -1746,15 +1745,6 @@ expressions; a `progn' form will be returned enclosing these forms."
specs))
(edebug-move-cursor cursor)))
- ((and (eq 'vector spec) (vectorp form))
- ;; Special case: match a vector with the specs.
- (let ((result (edebug-match-sublist
- (edebug-new-cursor
- form (cdr (edebug-top-offset cursor)))
- (cdr specs))))
- (edebug-move-cursor cursor)
- (list (apply 'vector result))))
-
(t (edebug-no-match cursor "Expected" specs)))
)))
@@ -1881,8 +1871,13 @@ expressions; a `progn' form will be returned enclosing these forms."
;; Like body but body is wrapped in edebug-enter form.
;; The body is assumed to be executing inside of the function context.
;; Not to be used otherwise.
- (let ((edebug-inside-func t))
- (list (edebug-wrap-def-body (edebug-forms cursor)))))
+ (let* ((edebug-inside-func t)
+ (forms (edebug-forms cursor)))
+ ;; If there's no form, there's nothing to wrap!
+ ;; This happens to handle bug#20281, tho maybe a better fix would be to
+ ;; improve the `defun' spec.
+ (when forms
+ (list (edebug-wrap-def-body forms)))))
;;;; Edebug Form Specs
@@ -1933,11 +1928,11 @@ expressions; a `progn' form will be returned enclosing these forms."
[&optional stringp]
[&optional ("interactive" interactive)]
def-body))
-;; FIXME? Isn't this missing the doc-string? Cf defun.
(def-edebug-spec defmacro
;; FIXME: Improve `declare' so we can Edebug gv-expander and
;; gv-setter declarations.
- (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
+ (&define name lambda-list [&optional stringp]
+ [&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
@@ -2370,6 +2365,12 @@ MSG is printed after `::::} '."
(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
+ ;; yet a bit deeper.
+ (save-excursion (edebug--display-1 value offset-index arg-mode)))
+
+(defun edebug--display-1 (value offset-index arg-mode)
(unless (marker-position edebug-def-mark)
;; The buffer holding the source has been killed.
;; Let's at least show a backtrace so the user can figure out
@@ -2402,9 +2403,7 @@ MSG is printed after `::::} '."
(edebug-outside-d-c-i-n-s-w
(default-value 'cursor-in-non-selected-windows)))
(unwind-protect
- (let ((overlay-arrow-position overlay-arrow-position)
- (overlay-arrow-string overlay-arrow-string)
- (cursor-in-echo-area nil)
+ (let ((cursor-in-echo-area nil)
(unread-command-events nil)
;; any others??
)
@@ -2454,147 +2453,144 @@ MSG is printed after `::::} '."
edebug-function)
))
- (setcdr edebug-window-data
- (edebug-adjust-window (cdr edebug-window-data)))
+ ;; Make sure we bind those in the right buffer (bug#16410).
+ (let ((overlay-arrow-position overlay-arrow-position)
+ (overlay-arrow-string overlay-arrow-string))
+ ;; Now display arrow based on mode.
+ (edebug-overlay-arrow)
- ;; Test if there is input, not including keyboard macros.
- (if (input-pending-p)
- (progn
- (setq edebug-execution-mode 'step
- edebug-stop t)
- (edebug-stop)
- ;; (discard-input) ; is this unfriendly??
- ))
- ;; Now display arrow based on mode.
- (edebug-overlay-arrow)
+ (cond
+ ((eq 'error arg-mode)
+ ;; Display error message
+ (setq edebug-execution-mode 'step)
+ (edebug-overlay-arrow)
+ (beep)
+ (if (eq 'quit (car value))
+ (message "Quit")
+ (edebug-report-error value)))
+ (edebug-break
+ (cond
+ (edebug-global-break
+ (message "Global Break: %s => %s"
+ edebug-global-break-condition
+ edebug-global-break-result))
+ (edebug-break-condition
+ (message "Break: %s => %s"
+ edebug-break-condition
+ edebug-break-result))
+ ((not (eq edebug-execution-mode 'Continue-fast))
+ (message "Break"))
+ (t)))
+
+ (t (message "")))
+
+ (if (eq 'after arg-mode)
+ (progn
+ ;; Display result of previous evaluation.
+ (if (and edebug-break
+ (not (eq edebug-execution-mode 'Continue-fast)))
+ (sit-for edebug-sit-for-seconds)) ; Show message.
+ (edebug-previous-result)))
+
+ (cond
+ (edebug-break
+ (cond
+ ((eq edebug-execution-mode 'continue)
+ (sit-for edebug-sit-for-seconds))
+ ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
+ (t (setq edebug-stop t))))
+ ;; not edebug-break
+ ((eq edebug-execution-mode 'trace)
+ (sit-for edebug-sit-for-seconds)) ; Force update and pause.
+ ((eq edebug-execution-mode 'Trace-fast)
+ (sit-for 0))) ; Force update and continue.
+
+ (when (input-pending-p)
+ (setq edebug-stop t)
+ (setq edebug-execution-mode 'step) ; for `edebug-overlay-arrow'
+ (edebug-stop))
- (cond
- ((eq 'error arg-mode)
- ;; Display error message
- (setq edebug-execution-mode 'step)
(edebug-overlay-arrow)
- (beep)
- (if (eq 'quit (car value))
- (message "Quit")
- (edebug-report-error value)))
- (edebug-break
- (cond
- (edebug-global-break
- (message "Global Break: %s => %s"
- edebug-global-break-condition
- edebug-global-break-result))
- (edebug-break-condition
- (message "Break: %s => %s"
- edebug-break-condition
- edebug-break-result))
- ((not (eq edebug-execution-mode 'Continue-fast))
- (message "Break"))
- (t)))
-
- (t (message "")))
-
- (if (eq 'after arg-mode)
- (progn
- ;; Display result of previous evaluation.
- (if (and edebug-break
- (not (eq edebug-execution-mode 'Continue-fast)))
- (sit-for edebug-sit-for-seconds)) ; Show message.
- (edebug-previous-result)))
- (cond
- (edebug-break
- (cond
- ((eq edebug-execution-mode 'continue)
- (sit-for edebug-sit-for-seconds))
- ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
- (t (setq edebug-stop t))))
- ;; not edebug-break
- ((eq edebug-execution-mode 'trace)
- (sit-for edebug-sit-for-seconds)) ; Force update and pause.
- ((eq edebug-execution-mode 'Trace-fast)
- (sit-for 0))) ; Force update and continue.
-
- (unwind-protect
- (if (or edebug-stop
- (memq edebug-execution-mode '(step next))
- (eq arg-mode 'error))
- (progn
- ;; (setq edebug-execution-mode 'step)
- ;; (edebug-overlay-arrow) ; This doesn't always show up.
- (edebug--recursive-edit arg-mode))) ; <----- Recursive edit
-
- ;; Reset the edebug-window-data to whatever it is now.
- (let ((window (if (eq (window-buffer) edebug-buffer)
- (selected-window)
- (get-buffer-window edebug-buffer))))
- ;; Remember window-start for edebug-buffer, if still displayed.
- (if window
- (progn
- (setcar edebug-window-data window)
- (setcdr edebug-window-data (window-start window)))))
-
- ;; Save trace window point before restoring outside windows.
- ;; Could generalize this for other buffers.
- (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
- (if edebug-trace-window
- (setq edebug-trace-window-start
- (and edebug-trace-window
- (window-start edebug-trace-window))))
-
- ;; Restore windows before continuing.
- (if edebug-save-windows
- (progn
- (edebug-set-windows edebug-outside-windows)
-
- ;; Restore displayed buffer points.
- ;; Needed even if restoring windows because
- ;; window-points are not restored. (should they be??)
- (if edebug-save-displayed-buffer-points
- (edebug-set-buffer-points edebug-buffer-points))
-
- ;; Unrestore trace window's window-point.
- (if edebug-trace-window
- (set-window-start edebug-trace-window
- edebug-trace-window-start))
-
- ;; Unrestore edebug-buffer's window-start, if displayed.
- (let ((window (car edebug-window-data)))
- (if (and (edebug-window-live-p window)
- (eq (window-buffer) edebug-buffer))
- (progn
- (set-window-start window (cdr edebug-window-data)
- 'no-force)
- ;; Unrestore edebug-buffer's window-point.
- ;; Needed in addition to setting the buffer point
- ;; - otherwise quitting doesn't leave point as is.
- ;; But this causes point to not be restored at times.
- ;; Also, it may not be a visible window.
- ;; (set-window-point window edebug-point)
- )))
-
- ;; Unrestore edebug-buffer's point. Rerestored below.
- ;; (goto-char edebug-point) ;; in edebug-buffer
- )
- ;; Since we may be in a save-excursion, in case of quit,
- ;; reselect the outside window only.
- ;; Only needed if we are not recovering windows??
- (if (edebug-window-live-p edebug-outside-window)
- (select-window edebug-outside-window))
- ) ; if edebug-save-windows
-
- ;; Restore current buffer always, in case application needs it.
- (if (buffer-name edebug-outside-buffer)
- (set-buffer edebug-outside-buffer))
- ;; Restore point, and mark.
- ;; Needed even if restoring windows because
- ;; that doesn't restore point and mark in the current buffer.
- ;; 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))
- ) ; unwind-protect
+ (unwind-protect
+ (if (or edebug-stop
+ (memq edebug-execution-mode '(step next))
+ (eq arg-mode 'error))
+ (edebug--recursive-edit arg-mode)) ; <--- Recursive edit
+
+ ;; Reset the edebug-window-data to whatever it is now.
+ (let ((window (if (eq (window-buffer) edebug-buffer)
+ (selected-window)
+ (get-buffer-window edebug-buffer))))
+ ;; Remember window-start for edebug-buffer, if still displayed.
+ (if window
+ (progn
+ (setcar edebug-window-data window)
+ (setcdr edebug-window-data (window-start window)))))
+
+ ;; Save trace window point before restoring outside windows.
+ ;; Could generalize this for other buffers.
+ (setq edebug-trace-window
+ (get-buffer-window edebug-trace-buffer))
+ (if edebug-trace-window
+ (setq edebug-trace-window-start
+ (and edebug-trace-window
+ (window-start edebug-trace-window))))
+
+ ;; Restore windows before continuing.
+ (if edebug-save-windows
+ (progn
+ (edebug-set-windows edebug-outside-windows)
+
+ ;; Restore displayed buffer points.
+ ;; Needed even if restoring windows because
+ ;; window-points are not restored. (should they be??)
+ (if edebug-save-displayed-buffer-points
+ (edebug-set-buffer-points edebug-buffer-points))
+
+ ;; Unrestore trace window's window-point.
+ (if edebug-trace-window
+ (set-window-start edebug-trace-window
+ edebug-trace-window-start))
+
+ ;; Unrestore edebug-buffer's window-start, if displayed.
+ (let ((window (car edebug-window-data)))
+ (if (and (edebug-window-live-p window)
+ (eq (window-buffer) edebug-buffer))
+ (progn
+ (set-window-start window (cdr edebug-window-data)
+ 'no-force)
+ ;; Unrestore edebug-buffer's window-point.
+ ;; Needed in addition to setting the buffer point
+ ;; - otherwise quitting doesn't leave point as is.
+ ;; But can this causes point to not be restored.
+ ;; Also, it may not be a visible window.
+ ;; (set-window-point window edebug-point)
+ )))
+
+ ;; Unrestore edebug-buffer's point. Rerestored below.
+ ;; (goto-char edebug-point) ;; in edebug-buffer
+ )
+ ;; Since we may be in a save-excursion, in case of quit,
+ ;; reselect the outside window only.
+ ;; Only needed if we are not recovering windows??
+ (if (edebug-window-live-p edebug-outside-window)
+ (select-window edebug-outside-window))
+ ) ; if edebug-save-windows
+
+ ;; Restore current buffer always, in case application needs it.
+ (if (buffer-name edebug-outside-buffer)
+ (set-buffer edebug-outside-buffer))
+ ;; Restore point, and mark.
+ ;; Needed even if restoring windows because
+ ;; that doesn't restore point and mark in the current buffer.
+ ;; 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))
+ )) ; unwind-protect
;; None of the following is done if quit or signal occurs.
;; Restore edebug-buffer's outside point.
@@ -2680,12 +2676,6 @@ MSG is printed after `::::} '."
(defining-kbd-macro
(if edebug-continue-kbd-macro defining-kbd-macro))
- ;; Disable command hooks. This is essential when
- ;; a hook function is instrumented - to avoid infinite loop.
- ;; This may be more than we need, however.
- (pre-command-hook nil)
- (post-command-hook nil)
-
;; others??
)
@@ -2714,8 +2704,9 @@ MSG is printed after `::::} '."
(if (buffer-name edebug-buffer) ; if it still exists
(progn
(set-buffer edebug-buffer)
- (if (memq edebug-execution-mode '(go Go-nonstop))
- (edebug-overlay-arrow))
+ (when (memq edebug-execution-mode '(go Go-nonstop))
+ (edebug-overlay-arrow)
+ (sit-for 0))
(edebug-mode -1))
;; gotta have a buffer to let its buffer local variables be set
(get-buffer-create " bogus edebug buffer"))
@@ -2725,31 +2716,6 @@ MSG is printed after `::::} '."
;;; Display related functions
-(defun edebug-adjust-window (old-start)
- ;; If pos is not visible, adjust current window to fit following context.
- ;; (message "window: %s old-start: %s window-start: %s pos: %s"
- ;; (selected-window) old-start (window-start) (point)) (sit-for 5)
- (if (not (pos-visible-in-window-p))
- (progn
- ;; First try old-start
- (if old-start
- (set-window-start (selected-window) old-start))
- (if (not (pos-visible-in-window-p))
- (progn
- ;; (message "resetting window start") (sit-for 2)
- (set-window-start
- (selected-window)
- (save-excursion
- (forward-line
- (if (< (point) (window-start)) -1 ; one line before if in back
- (- (/ (window-height) 2)) ; center the line moving forward
- ))
- (beginning-of-line)
- (point)))))))
- (window-start))
-
-
-
(defconst edebug-arrow-alist
'((Continue-fast . "=")
(Trace-fast . "-")
@@ -2758,7 +2724,7 @@ MSG is printed after `::::} '."
(step . "=>")
(next . "=>")
(go . "<>")
- (Go-nonstop . "..") ; not used
+ (Go-nonstop . "..")
)
"Association list of arrows for each edebug mode.")
@@ -3196,15 +3162,15 @@ Do this when stopped before the form or it will be too late.
One side effect of using this command is that the next time the
function or macro is called, Edebug will be called there as well."
(interactive)
- (if (not (looking-at "\("))
+ (if (not (looking-at "("))
(error "You must be before a list form")
(let ((func
(save-excursion
(down-list 1)
- (if (looking-at "\(")
+ (if (looking-at "(")
(edebug--form-data-name
(edebug-get-form-data-entry (point)))
- (edebug-original-read (current-buffer))))))
+ (read (current-buffer))))))
(edebug-instrument-function func))))
@@ -3232,25 +3198,14 @@ canceled the first time the function is entered."
(put function 'edebug-on-entry nil))
-(if (not (fboundp 'edebug-original-debug-on-entry))
- (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
-'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
+'(advice-add 'debug-on-entry :around 'edebug--debug-on-entry) ;; Should we do this?
;; Also need edebug-cancel-debug-on-entry
-'(defun edebug-debug-on-entry (function)
- "Request FUNCTION to invoke debugger each time it is called.
-If the user continues, FUNCTION's execution proceeds.
-Works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use `cancel-debug-on-entry' to cancel the effect of this command.
-Redefining FUNCTION also does that.
-
-This version is from Edebug. If the function is instrumented for
-Edebug, it calls `edebug-on-entry'."
- (interactive "aDebug on entry (to function): ")
+'(defun edebug--debug-on-entry (orig function)
+ "If the function is instrumented for Edebug, call `edebug-on-entry'."
(let ((func-data (get function 'edebug)))
(if (or (null func-data) (markerp func-data))
- (edebug-original-debug-on-entry function)
+ (funcall orig function)
(edebug-on-entry function))))
@@ -3261,57 +3216,45 @@ This is useful for exiting even if `unwind-protect' code may be executed."
(setq edebug-execution-mode 'Go-nonstop)
(top-level))
-
;;(defun edebug-exit-out ()
;; "Go until the current function exits."
;; (interactive)
;; (edebug-set-mode 'exiting "Exit..."))
-
-;;; The following initial mode setting definitions are not used yet.
-
-'(defconst edebug-initial-mode-alist
- '((edebug-Continue-fast . Continue-fast)
- (edebug-Trace-fast . Trace-fast)
- (edebug-continue . continue)
- (edebug-trace . trace)
- (edebug-go . go)
- (edebug-step-through . step)
- (edebug-Go-nonstop . Go-nonstop)
- )
+(defconst edebug-initial-mode-alist
+ '((edebug-step-mode . step)
+ (edebug-next-mode . next)
+ (edebug-trace-mode . trace)
+ (edebug-Trace-fast-mode . Trace-fast)
+ (edebug-go-mode . go)
+ (edebug-continue-mode . continue)
+ (edebug-Continue-fast-mode . Continue-fast)
+ (edebug-Go-nonstop-mode . Go-nonstop))
"Association list between commands and the modes they set.")
+(defvar edebug-mode-map) ; will be defined fully later.
-'(defun edebug-set-initial-mode ()
- "Ask for the initial mode of the enclosing function.
+(defun edebug-set-initial-mode ()
+ "Set the initial execution mode of Edebug.
The mode is requested via the key that would be used to set the mode in
edebug-mode."
(interactive)
- (let* ((this-function (edebug-which-function))
- (keymap (if (eq edebug-mode-map (current-local-map))
- edebug-mode-map))
- (old-mode (or (get this-function 'edebug-initial-mode)
- edebug-initial-mode))
+ (let* ((old-mode edebug-initial-mode)
(key (read-key-sequence
(format
- "Change initial edebug mode for %s from %s (%s) to (enter key): "
- this-function
- old-mode
- (where-is-internal
- (car (rassq old-mode edebug-initial-mode-alist))
- keymap 'firstonly
- ))))
- (mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
- )
- (if (and mode
- (or (get this-function 'edebug-initial-mode)
- (not (eq mode edebug-initial-mode))))
+ "Change initial edebug mode from %s (%c) to (enter key): "
+ old-mode
+ (aref (where-is-internal
+ (car (rassq old-mode edebug-initial-mode-alist))
+ edebug-mode-map 'firstonly)
+ 0))))
+ (mode (cdr (assq (lookup-key edebug-mode-map key)
+ edebug-initial-mode-alist))))
+ (if mode
(progn
- (put this-function 'edebug-initial-mode mode)
- (message "Initial mode for %s is now: %s"
- this-function mode))
- (error "Key must map to one of the mode changing commands")
- )))
+ (setq edebug-initial-mode mode)
+ (message "Edebug's initial mode is now: %s" mode))
+ (error "Key must map to one of the mode changing commands"))))
;;; Evaluation of expressions
@@ -3337,6 +3280,9 @@ Return the result of the last expression."
;; Restore outside context.
(setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w)
(unwind-protect
+ ;; FIXME: This restoring of edebug-outside-buffer and
+ ;; edebug-outside-point is redundant now that backtrace-eval does it
+ ;; for us.
(with-current-buffer edebug-outside-buffer ; of edebug-buffer
(goto-char edebug-outside-point)
(if (marker-buffer (edebug-mark-marker))
@@ -3394,9 +3340,7 @@ Return the result of the last expression."
(print-level (or edebug-print-level print-level))
(print-circle (or edebug-print-circle print-circle))
(print-readably nil)) ; lemacs uses this.
- (condition-case nil
- (edebug-prin1-to-string value)
- (error "#Apparently circular structure#"))))
+ (edebug-prin1-to-string value)))
(defun edebug-compute-previous-result (previous-value)
(if edebug-unwrap-results
@@ -3417,7 +3361,7 @@ Return the result of the last expression."
(defalias 'edebug-prin1 'prin1)
(defalias 'edebug-print 'print)
(defalias 'edebug-prin1-to-string 'prin1-to-string)
-(defalias 'edebug-format 'format)
+(defalias 'edebug-format 'format-message)
(defalias 'edebug-message 'message)
(defun edebug-eval-expression (expr)
@@ -3469,7 +3413,9 @@ be installed in `emacs-lisp-mode-map'.")
(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
- (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where))
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
+ ;; The following isn't a GUD binding.
+ (define-key emacs-lisp-mode-map "\C-x\C-a\C-m" 'edebug-set-initial-mode))
(defvar edebug-mode-map
(let ((map (copy-keymap emacs-lisp-mode-map)))
@@ -3834,10 +3780,10 @@ Otherwise call `debug' normally."
(if t (progn
;; Delete interspersed edebug internals.
- (while (re-search-forward "^ \(?edebug" nil t)
+ (while (re-search-forward "^ (?edebug" nil t)
(beginning-of-line)
(cond
- ((looking-at "^ \(edebug-after")
+ ((looking-at "^ (edebug-after")
;; Previous lines may contain code, so just delete this line.
(setq last-ok-point (point))
(forward-line 1)
@@ -4131,9 +4077,8 @@ With prefix argument, make it a temporary breakpoint."
'edebug--called-interactively-skip)
(remove-hook 'cl-read-load-hooks 'edebug--require-cl-read)
(edebug-uninstall-read-eval-functions)
- ;; continue standard unloading
+ ;; Continue standard unloading.
nil)
(provide 'edebug)
-
;;; edebug.el ends here
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 21190446624..400bdb95c06 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,6 +1,6 @@
-;;; eieio-base.el --- Base classes for EIEIO.
+;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*-
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2013 Free Software
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2015 Free Software
;;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -31,7 +31,7 @@
;;; Code:
(require 'eieio)
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
+(eval-when-compile (require 'cl-lib))
;;; eieio-instance-inheritor
;;
@@ -40,7 +40,7 @@
;; error if a slot is unbound.
(defclass eieio-instance-inheritor ()
((parent-instance :initarg :parent-instance
- :type eieio-instance-inheritor-child
+ :type eieio-instance-inheritor
:documentation
"The parent of this instance.
If a slot of this class is referenced, and is unbound, then the parent
@@ -52,7 +52,8 @@ a parent instance. When a slot in the child is referenced, and has
not been set, use values from the parent."
:abstract t)
-(defmethod slot-unbound ((object eieio-instance-inheritor) class slot-name fn)
+(cl-defmethod slot-unbound ((object eieio-instance-inheritor)
+ _class slot-name _fn)
"If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal.
SLOT-NAME is the offending slot. FN is the function signaling the error."
(if (slot-boundp object 'parent-instance)
@@ -60,31 +61,16 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
;; method if the parent instance's slot is unbound.
(eieio-oref (oref object parent-instance) slot-name)
;; Throw the regular signal.
- (call-next-method)))
+ (cl-call-next-method)))
-(defmethod clone ((obj eieio-instance-inheritor) &rest params)
+(cl-defmethod clone ((obj eieio-instance-inheritor) &rest _params)
"Clone OBJ, initializing `:parent' to OBJ.
All slots are unbound, except those initialized with PARAMS."
- (let ((nobj (make-vector (length obj) eieio-unbound))
- (nm (eieio--object-name obj))
- (passname (and params (stringp (car params))))
- (num 1))
- (aset nobj 0 'object)
- (setf (eieio--object-class nobj) (eieio--object-class obj))
- ;; The following was copied from the default clone.
- (if (not passname)
- (save-match-data
- (if (string-match "-\\([0-9]+\\)" nm)
- (setq num (1+ (string-to-number (match-string 1 nm)))
- nm (substring nm 0 (match-beginning 0))))
- (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
- (setf (eieio--object-name nobj) (car params)))
- ;; Now initialize from params.
- (if params (shared-initialize nobj (if passname (cdr params) params)))
+ (let ((nobj (cl-call-next-method)))
(oset nobj parent-instance obj)
nobj))
-(defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
+(cl-defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
slot)
"Return non-nil if the instance inheritor OBJECT's SLOT is bound.
See `slot-boundp' for details on binding slots.
@@ -117,8 +103,8 @@ Inheritors from this class must overload `tracking-symbol' which is
a variable symbol used to store a list of all instances."
:abstract t)
-(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
- &rest slots)
+(cl-defmethod initialize-instance :after ((this eieio-instance-tracker)
+ &rest _slots)
"Make sure THIS is in our master list of this class.
Optional argument SLOTS are the initialization arguments."
;; Theoretically, this is never called twice for a given instance.
@@ -126,7 +112,7 @@ Optional argument SLOTS are the initialization arguments."
(if (not (memq this (symbol-value sym)))
(set sym (append (symbol-value sym) (list this))))))
-(defmethod delete-instance ((this eieio-instance-tracker))
+(cl-defmethod delete-instance ((this eieio-instance-tracker))
"Remove THIS from the master list of this class."
(set (oref this tracking-symbol)
(delq this (symbol-value (oref this tracking-symbol)))))
@@ -154,7 +140,7 @@ Multiple calls to `make-instance' will return this object."))
A singleton is a class which will only ever have one instance."
:abstract t)
-(defmethod constructor :STATIC ((class eieio-singleton) name &rest slots)
+(cl-defmethod make-instance ((class (subclass eieio-singleton)) &rest _slots)
"Constructor for singleton CLASS.
NAME and SLOTS initialize the new object.
This constructor guarantees that no matter how many you request,
@@ -163,7 +149,7 @@ only one object ever exists."
;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
(if (eq old eieio-unbound)
- (oset-default class singleton (call-next-method))
+ (oset-default class singleton (cl-call-next-method))
old)))
@@ -212,7 +198,7 @@ object. For this reason, only slots which do not have an `:initarg'
specified will not be saved."
:abstract t)
-(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
+(cl-defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
&optional name)
"Prepare to save THIS. Use in an `interactive' statement.
Query user for file name with PROMPT if THIS does not yet specify
@@ -233,7 +219,7 @@ for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
being pedantic."
(unless class
(message "Unsafe call to `eieio-persistent-read'."))
- (when class (eieio--check-type class-p class))
+ (when class (cl-check-type class class))
(let ((ret nil)
(buffstr nil))
(unwind-protect
@@ -268,31 +254,34 @@ 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))
- (objname (nth 1 inputlist))
- (slots (nthcdr 2 inputlist))
- (createslots nil))
-
- ;; If OBJCLASS is an eieio autoload object, then we need to load it.
- (eieio-class-un-autoload objclass)
+ (let* ((objclass (nth 0 inputlist))
+ ;; (objname (nth 1 inputlist))
+ (slots (nthcdr 2 inputlist))
+ (createslots nil)
+ (class
+ (progn
+ ;; If OBJCLASS is an eieio autoload object, then we need to
+ ;; load it.
+ (eieio-class-un-autoload objclass)
+ (eieio--class-object objclass))))
(while slots
- (let ((name (car 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
- objclass name value))
+ class (eieio--initarg-to-attribute class initarg) value))
- (push name createslots)
+ (push initarg createslots)
(push value createslots)
)
(setq slots (cdr (cdr slots))))
- (apply 'make-instance objclass objname (nreverse createslots))
+ (apply #'make-instance objclass (nreverse createslots))
;;(eval inputlist)
))
@@ -304,15 +293,12 @@ constructor functions are considered valid.
Second, any text properties will be stripped from strings."
(cond ((consp proposed-value)
;; Lists with something in them need special treatment.
- (let ((slot-idx (eieio-slot-name-index class nil slot))
- (type nil)
- (classtype nil))
- (setq slot-idx (- slot-idx 3))
- (setq type (aref (eieio--class-public-type (class-v class))
- slot-idx))
-
- (setq classtype (eieio-persistent-slot-type-is-class-p
- type))
+ (let* ((slot-idx (- (eieio--slot-name-index class slot)
+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))))
+ (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)))
@@ -345,8 +331,8 @@ Second, any text properties will be stripped from strings."
(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"
- slot))
+ (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))
@@ -374,31 +360,49 @@ Second, any text properties will be stripped from strings."
)
(defun eieio-persistent-slot-type-is-class-p (type)
- "Return the class refered to in 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 (symbolp type) (string-match "-child$" (symbol-name 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))))
-
- ((and (symbolp type) (string-match "-list$" (symbol-name type))
+ ;; 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))
- ((and (consp type) (eq (car type) 'or))
+ ((eq (car-safe type) 'or)
;; If type is a list, and is an or, it is possibly something
;; like (or null myclass), so check for that.
(let ((ans nil))
@@ -411,85 +415,89 @@ If no class is referenced there, then return nil."
;; No match, not a class.
nil)))
-(defmethod object-write ((this eieio-persistent) &optional comment)
+(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
Optional argument COMMENT is a header line comment."
- (call-next-method this (or comment (oref this file-header-line))))
+ (cl-call-next-method this (or comment (oref this file-header-line))))
-(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
+(cl-defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
"For object THIS, make absolute file name FILE relative."
(file-relative-name (expand-file-name file)
(file-name-directory (oref this file))))
-(defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
+(cl-defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
"Save persistent object THIS to disk.
Optional argument FILE overrides the file name specified in the object
instance."
- (save-excursion
- (let ((b (set-buffer (get-buffer-create " *tmp object write*")))
- (default-directory (file-name-directory (oref this file)))
- (cfn (oref this file)))
- (unwind-protect
- (save-excursion
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (oset this file
- (if file
- (eieio-persistent-path-relative this file)
- (file-name-nondirectory cfn)))
- (object-write this (oref this file-header-line)))
- (let ((backup-inhibited (not (oref this do-backups)))
- (cs (car (find-coding-systems-region
- (point-min) (point-max)))))
- (unless (eq cs 'undecided)
- (setq buffer-file-coding-system cs))
- ;; Old way - write file. Leaves message behind.
- ;;(write-file cfn nil)
-
- ;; New way - Avoid the vast quantities of error checking
- ;; just so I can get at the special flags that disable
- ;; displaying random messages.
- (write-region (point-min) (point-max)
- cfn nil 1)
- ))
- ;; Restore :file, and kill the tmp buffer
- (oset this file cfn)
- (setq buffer-file-name nil)
- (kill-buffer b)))))
+ (when file (setq file (expand-file-name file)))
+ (with-temp-buffer
+ (let* ((cfn (or file (oref this file)))
+ (default-directory (file-name-directory cfn)))
+ (cl-letf ((standard-output (current-buffer))
+ ((oref this file) ;FIXME: Why change it?
+ (if file
+ ;; FIXME: Makes a name relative to (oref this file),
+ ;; whereas I think it should be relative to cfn.
+ (eieio-persistent-path-relative this file)
+ (file-name-nondirectory cfn))))
+ (object-write this (oref this file-header-line)))
+ (let ((backup-inhibited (not (oref this do-backups)))
+ (coding-system-for-write 'utf-8-emacs))
+ ;; Old way - write file. Leaves message behind.
+ ;;(write-file cfn nil)
+
+ ;; New way - Avoid the vast quantities of error checking
+ ;; just so I can get at the special flags that disable
+ ;; displaying random messages.
+ (write-region (point-min) (point-max) cfn nil 1)
+ ))))
;; Notes on the persistent object:
;; It should also set up some hooks to help it keep itself up to date.
;;; Named object
-;;
-;; Named objects use the objects `name' as a slot, and that slot
-;; is accessed with the `object-name' symbol.
(defclass eieio-named ()
- ()
- "Object with a name.
-Name storage already occurs in an object. This object provides get/set
-access to it."
+ ((object-name :initarg :object-name :initform nil))
+ "Object with a name."
:abstract t)
-(defmethod slot-missing ((obj eieio-named)
- slot-name operation &optional new-value)
- "Called when a non-existent slot is accessed.
-For variable `eieio-named', provide an imaginary `object-name' slot.
-Argument OBJ is the named object.
-Argument SLOT-NAME is the slot that was attempted to be accessed.
-OPERATION is the type of access, such as `oref' or `oset'.
-NEW-VALUE is the value that was being set into SLOT if OPERATION were
-a set type."
- (if (memq slot-name '(object-name :object-name))
- (cond ((eq operation 'oset)
- (if (not (stringp new-value))
- (signal 'invalid-slot-type
- (list obj slot-name 'string new-value)))
- (eieio-object-set-name-string obj new-value))
- (t (eieio-object-name-string obj)))
- (call-next-method)))
+(cl-defmethod eieio-object-name-string ((obj eieio-named))
+ "Return a string which is OBJ's name."
+ (or (slot-value obj 'object-name)
+ (symbol-name (eieio-object-class obj))))
+
+(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
+ "Set the string which is OBJ's NAME."
+ (cl-check-type name string)
+ (eieio-oset obj 'object-name name))
+
+(cl-defmethod clone ((obj eieio-named) &rest params)
+ "Clone OBJ, initializing `:parent' to OBJ.
+All slots are unbound, except those initialized with PARAMS."
+ (let* ((newname (and (stringp (car params)) (pop params)))
+ (nobj (apply #'cl-call-next-method obj params))
+ (nm (slot-value obj 'object-name)))
+ (eieio-oset obj 'object-name
+ (or newname
+ (save-match-data
+ (if (and nm (string-match "-\\([0-9]+\\)" nm))
+ (let ((num (1+ (string-to-number
+ (match-string 1 nm)))))
+ (concat (substring nm 0 (match-beginning 0))
+ "-" (int-to-string num)))
+ (concat nm "-1")))))
+ nobj))
+
+(cl-defmethod make-instance ((class (subclass eieio-named)) &rest args)
+ (if (not (stringp (car args)))
+ (cl-call-next-method)
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete: name passed without :object-name to %S constructor"
+ class)
+ (apply #'cl-call-next-method class :object-name args)))
+
(provide 'eieio-base)
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
new file mode 100644
index 00000000000..638c475ef2b
--- /dev/null
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -0,0 +1,272 @@
+;;; eieio-compat.el --- Compatibility with Older EIEIO versions -*- lexical-binding:t -*-
+
+;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: OO, lisp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Backward compatibility definition of old EIEIO functions in
+;; terms of newer equivalent.
+
+;; The main elements are the old EIEIO `defmethod' and `defgeneric' which are
+;; now implemented on top of cl-generic. The differences we have to
+;; accommodate are:
+;; - EIEIO's :static methods (turned into a new `eieio--static' specializer).
+;; - EIEIO's support for `call-next-method' and `next-method-p' instead of
+;; `cl-next-method-p' and `cl-call-next-method' (simple matter of renaming).
+;; - Different errors are signaled.
+;; - EIEIO's defgeneric does not reset the function.
+;; - EIEIO's no-next-method and no-applicable-method can't be aliases of
+;; cl-generic's namesakes since they have different calling conventions,
+;; which means that packages that (defmethod no-next-method ..) don't work.
+;; - EIEIO's `call-next-method' and `next-method-p' had dynamic scope whereas
+;; cl-generic's `cl-next-method-p' and `cl-call-next-method' are lexically
+;; scoped.
+
+;;; Code:
+
+(require 'eieio-core)
+(require 'cl-generic)
+
+(put 'eieio--defalias 'byte-hunk-handler
+ #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
+;;;###autoload
+(defun eieio--defalias (name body)
+ "Like `defalias', but with less side-effects.
+More specifically, it has no side-effects at all when the new function
+definition is the same (`eq') as the old one."
+ (cl-assert (not (symbolp body)))
+ (while (and (fboundp name) (symbolp (symbol-function name)))
+ ;; Follow aliases, so methods applied to obsolete aliases still work.
+ (setq name (symbol-function name)))
+ (unless (and (fboundp name)
+ (eq (symbol-function name) body))
+ (defalias name body)))
+
+;;;###autoload
+(defmacro defgeneric (method args &optional doc-string)
+ "Create a generic function METHOD.
+DOC-STRING is the base documentation for this class. A generic
+function has no body, as its purpose is to decide which method body
+is appropriate to use. Uses `defmethod' to create methods, and calls
+`defgeneric' for you. With this implementation the ARGS are
+currently ignored. You can use `defgeneric' to apply specialized
+top level documentation to a method."
+ (declare (doc-string 3) (obsolete cl-defgeneric "25.1"))
+ `(eieio--defalias ',method
+ (eieio--defgeneric-init-form
+ ',method
+ ,(if doc-string (help-add-fundoc-usage doc-string args)))))
+
+;;;###autoload
+(defmacro defmethod (method &rest args)
+ "Create a new METHOD through `defgeneric' with ARGS.
+
+The optional second argument KEY is a specifier that
+modifies how the method is called, including:
+ :before - Method will be called before the :primary
+ :primary - The default if not specified
+ :after - Method will be called after the :primary
+ :static - First arg could be an object or class
+The next argument is the ARGLIST. The ARGLIST specifies the arguments
+to the method as with `defun'. The first argument can have a type
+specifier, such as:
+ ((VARNAME CLASS) ARG2 ...)
+where VARNAME is the name of the local variable for the method being
+created. The CLASS is a class symbol for a class made with `defclass'.
+A DOCSTRING comes after the ARGLIST, and is optional.
+All the rest of the args are the BODY of the method. A method will
+return the value of the last form in the BODY.
+
+Summary:
+
+ (defmethod mymethod [:before | :primary | :after | :static]
+ ((typearg class-name) arg2 &optional opt &rest rest)
+ \"doc-string\"
+ body)"
+ (declare (doc-string 3) (obsolete cl-defmethod "25.1")
+ (debug
+ (&define ; this means we are defining something
+ [&or name ("setf" :name setf name)]
+ ;; ^^ This is the methods symbol
+ [ &optional symbolp ] ; this is key :before etc
+ list ; arguments
+ [ &optional stringp ] ; documentation string
+ def-body ; part to be debugged
+ )))
+ (let* ((key (if (keywordp (car args)) (pop args)))
+ (params (car args))
+ (arg1 (car params))
+ (fargs (if (consp arg1)
+ (cons (car arg1) (cdr params))
+ params))
+ (class (if (consp arg1) (nth 1 arg1)))
+ (code `(lambda ,fargs ,@(cdr args))))
+ `(progn
+ ;; Make sure there is a generic and the byte-compiler sees it.
+ (defgeneric ,method ,args)
+ (eieio--defmethod ',method ',key ',class #',code))))
+
+(defun eieio--generic-static-symbol-specializers (tag &rest _)
+ (cl-assert (or (null tag) (eieio--class-p tag)))
+ (when (eieio--class-p tag)
+ (let ((superclasses (eieio--generic-subclass-specializers tag))
+ (specializers ()))
+ (dolist (superclass superclasses)
+ (push superclass specializers)
+ (push `(eieio--static ,(cadr superclass)) specializers))
+ (nreverse specializers))))
+
+(cl-generic-define-generalizer eieio--generic-static-symbol-generalizer
+ ;; Give it a slightly higher priority than `subclass' so that the
+ ;; interleaved list comes before subclass's non-interleaved list.
+ 61 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
+ #'eieio--generic-static-symbol-specializers)
+(cl-generic-define-generalizer eieio--generic-static-object-generalizer
+ ;; Give it a slightly higher priority than `class' so that the
+ ;; interleaved list comes before the class's non-interleaved list.
+ 51 #'cl--generic-struct-tag
+ (lambda (tag _targets)
+ (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag))
+ (eieio--class-p tag)
+ (let ((superclasses (eieio--class-precedence-list tag))
+ (specializers ()))
+ (dolist (superclass superclasses)
+ (setq superclass (eieio--class-name superclass))
+ (push superclass specializers)
+ (push `(eieio--static ,superclass) specializers))
+ (nreverse specializers)))))
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head eieio--static)))
+ (list eieio--generic-static-symbol-generalizer
+ eieio--generic-static-object-generalizer))
+
+;;;###autoload
+(defun eieio--defgeneric-init-form (method doc-string)
+ (if doc-string (put method 'function-documentation doc-string))
+ (if (memq method '(no-next-method no-applicable-method))
+ (symbol-function method)
+ (let ((generic (cl-generic-ensure-function method)))
+ (symbol-function (cl--generic-name generic)))))
+
+;;;###autoload
+(defun eieio--defmethod (method kind argclass code)
+ (setq kind (intern (downcase (symbol-name kind))))
+ (let* ((specializer (if (not (eq kind :static))
+ (or argclass t)
+ (setq kind nil)
+ `(eieio--static ,argclass)))
+ (uses-cnm (not (memq kind '(:before :after))))
+ (specializers `((arg ,specializer)))
+ (code
+ ;; Backward compatibility for `no-next-method' and
+ ;; `no-applicable-method', which have slightly different calling
+ ;; convention than their cl-generic counterpart.
+ (pcase method
+ (`no-next-method
+ (setq method 'cl-no-next-method)
+ (setq specializers `(generic method ,@specializers))
+ (lambda (_generic _method &rest args) (apply code args)))
+ (`no-applicable-method
+ (setq method 'cl-no-applicable-method)
+ (setq specializers `(generic ,@specializers))
+ (lambda (generic arg &rest args) (apply code arg generic args)))
+ (_ code))))
+ (cl-generic-define-method
+ method (unless (memq kind '(nil :primary)) (list kind))
+ specializers uses-cnm
+ (if uses-cnm
+ (let* ((docstring (documentation code 'raw))
+ (args (help-function-arglist code 'preserve-names))
+ (doc-only (if docstring
+ (let ((split (help-split-fundoc docstring nil)))
+ (if split (cdr split) docstring)))))
+ (lambda (cnm &rest args)
+ (:documentation
+ (help-add-fundoc-usage doc-only (cons 'cl-cnm args)))
+ (cl-letf (((symbol-function 'call-next-method) cnm)
+ ((symbol-function 'next-method-p)
+ (lambda () (cl--generic-isnot-nnm-p cnm))))
+ (apply code args))))
+ code))
+ ;; The old EIEIO code did not signal an error when there are methods
+ ;; applicable but only of the before/after kind. So if we add a :before
+ ;; or :after, make sure there's a matching dummy primary.
+ (when (and (memq kind '(:before :after))
+ ;; FIXME: Use `cl-find-method'?
+ (not (cl-find-method method ()
+ (mapcar (lambda (arg)
+ (if (consp arg) (nth 1 arg) t))
+ specializers))))
+ (cl-generic-define-method method () specializers t
+ (lambda (cnm &rest args)
+ (if (cl--generic-isnot-nnm-p cnm)
+ (apply cnm args)))))
+ method))
+
+;; Compatibility with code which tries to catch `no-method-definition' errors.
+(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
+
+(defun generic-p (fname) (not (null (cl--generic fname))))
+
+(defun no-next-method (&rest args)
+ (declare (obsolete cl-no-next-method "25.1"))
+ (apply #'cl-no-next-method 'unknown nil args))
+
+(defun no-applicable-method (object method &rest args)
+ (declare (obsolete cl-no-applicable-method "25.1"))
+ (apply #'cl-no-applicable-method method object args))
+
+(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
+(defun next-method-p ()
+ (declare (obsolete cl-next-method-p "25.1"))
+ ;; EIEIO's `next-method-p' just returned nil when called in an
+ ;; invalid context.
+ (message "next-method-p called outside of a primary or around method")
+ nil)
+
+;;;###autoload
+(defun eieio-defmethod (method args)
+ "Obsolete work part of an old version of the `defmethod' macro."
+ (declare (obsolete cl-defmethod "24.1"))
+ (eval `(defmethod ,method ,@args))
+ method)
+
+;;;###autoload
+(defun eieio-defgeneric (method doc-string)
+ "Obsolete work part of an old version of the `defgeneric' macro."
+ (declare (obsolete cl-defgeneric "24.1"))
+ (eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
+ ;; Return the method
+ 'method)
+
+;;;###autoload
+(defun eieio-defclass (cname superclasses slots options)
+ (declare (obsolete eieio-defclass-internal "25.1"))
+ (eval `(defclass ,cname ,superclasses ,slots ,@options)))
+
+
+;; Local Variables:
+;; generated-autoload-file: "eieio-core.el"
+;; End:
+
+(provide 'eieio-compat)
+
+;;; eieio-compat.el ends here
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index da475638bb7..7011a30656b 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1,6 +1,6 @@
-;;; eieio-core.el --- Core implementation for eieio
+;;; eieio-core.el --- Core implementation for eieio -*- lexical-binding:t -*-
-;; Copyright (C) 1995-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.4
@@ -31,31 +31,8 @@
;;; Code:
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
-
-;; Compatibility
-(if (fboundp 'compiled-function-arglist)
-
- ;; XEmacs can only access a compiled functions arglist like this:
- (defalias 'eieio-compiled-function-arglist 'compiled-function-arglist)
-
- ;; Emacs doesn't have this function, but since FUNC is a vector, we can just
- ;; grab the appropriate element.
- (defun eieio-compiled-function-arglist (func)
- "Return the argument list for the compiled function FUNC."
- (aref func 0))
-
- )
-
-(put 'eieio--defalias 'byte-hunk-handler
- #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
-(defun eieio--defalias (name body)
- "Like `defalias', but with less side-effects.
-More specifically, it has no side-effects at all when the new function
-definition is the same (`eq') as the old one."
- (unless (and (fboundp name)
- (eq (symbol-function name) body))
- (defalias name body)))
+(require 'cl-lib)
+(require 'pcase)
;;;
;; A few functions that are better in the official EIEIO src, but
@@ -63,6 +40,8 @@ definition is the same (`eq') as the old one."
(declare-function slot-unbound "eieio")
(declare-function slot-missing "eieio")
(declare-function child-of-class-p "eieio")
+(declare-function same-class-p "eieio")
+(declare-function object-of-class-p "eieio")
;;;
@@ -85,8 +64,12 @@ default setting for optimization purposes.")
(defvar eieio-optimize-primary-methods-flag t
"Non-nil means to optimize the method dispatch on primary methods.")
-(defvar eieio-initializing-object nil
- "Set to non-nil while initializing an object.")
+(defvar eieio-backward-compatibility t
+ "If nil, drop support for some behaviors of older versions of EIEIO.
+Currently under control of this var:
+- Define every class as a var whose value is the class symbol.
+- Define <class>-child-p and <class>-list-p predicates.
+- Allow object names in constructors.")
(defconst eieio-unbound
(if (and (boundp 'eieio-unbound) (symbolp eieio-unbound))
@@ -98,237 +81,122 @@ default setting for optimization purposes.")
;; while it is being built itself.
(defvar eieio-default-superclass nil)
-;;;
-;; Class currently in scope.
-;;
-;; When invoking methods, the running method needs to know which class
-;; is currently in scope. Generally this is the class of the method
-;; being called, but 'call-next-method' needs to query this state,
-;; and change it to be then next super class up.
-;;
-;; Thus, the scoped class is a stack that needs to be managed.
+(progn
+ ;; Arrange for field access not to bother checking if the access is indeed
+ ;; made to an eieio--class object.
+ (cl-declaim (optimize (safety 0)))
+
+(cl-defstruct (eieio--class
+ (:constructor nil)
+ (:constructor eieio--class-make (name))
+ (:include cl--class)
+ (:copier nil))
+ children
+ initarg-tuples ;; initarg tuples list
+ (class-slots nil :type eieio--slot)
+ class-allocation-values ;; class allocated value vector
+ default-object-cache ;; what a newly created object would look like.
+ ; This will speed up instantiation time as
+ ; only a `copy-sequence' will be needed, instead of
+ ; looping over all the values and setting them from
+ ; the default.
+ options ;; storage location of tagged class option
+ ; Stored outright without modifications or stripping
+ )
+ ;; Set it back to the default value.
+ (cl-declaim (optimize (safety 1))))
-(defvar eieio--scoped-class-stack nil
- "A stack of the classes currently in scope during method invocation.")
-(defun eieio--scoped-class ()
- "Return the class currently in scope, or nil."
- (car-safe eieio--scoped-class-stack))
+(cl-defstruct (eieio--object
+ (:type vector) ;We manage our own tagging system.
+ (:constructor nil)
+ (:copier nil))
+ ;; `class-tag' holds a symbol, which is not the class name, but is instead
+ ;; properly prefixed as an internal EIEIO thingy and which holds the class
+ ;; object/struct in its `symbol-value' slot.
+ class-tag)
-(defmacro eieio--with-scoped-class (class &rest forms)
- "Set CLASS as the currently scoped class while executing FORMS."
- `(unwind-protect
- (progn
- (push ,class eieio--scoped-class-stack)
- ,@forms)
- (pop eieio--scoped-class-stack)))
-(put 'eieio--with-scoped-class 'lisp-indent-function 1)
+(eval-when-compile
+ (defconst eieio--object-num-slots
+ (length (cl-struct-slot-info 'eieio--object))))
-;;;
-;; Field Accessors
-;;
-(defmacro eieio--define-field-accessors (prefix fields)
- (declare (indent 1))
- (let ((index 0)
- (defs '()))
- (dolist (field fields)
- (let ((doc (if (listp field)
- (prog1 (cadr field) (setq field (car field))))))
- (push `(defmacro ,(intern (format "eieio--%s-%s" prefix field)) (x)
- ,@(if doc (list (format (if (string-match "\n" doc)
- "Return %s" "Return %s of a %s.")
- doc prefix)))
- (list 'aref x ,index))
- defs)
- (setq index (1+ index))))
- `(eval-and-compile
- ,@(nreverse defs)
- (defconst ,(intern (format "eieio--%s-num-slots" prefix)) ,index))))
-
-(eieio--define-field-accessors class
- (-unused-0 ;;FIXME: not sure, but at least there was no accessor!
- (symbol "symbol (self-referencing)")
- parent children
- (symbol-obarray "obarray permitting fast access to variable position indexes")
- ;; @todo
- ;; the word "public" here is leftovers from the very first version.
- ;; Get rid of it!
- (public-a "class attribute index")
- (public-d "class attribute defaults index")
- (public-doc "class documentation strings for attributes")
- (public-type "class type for a slot")
- (public-custom "class custom type for a slot")
- (public-custom-label "class custom group for a slot")
- (public-custom-group "class custom group for a slot")
- (public-printer "printer for a slot")
- (protection "protection for a slot")
- (initarg-tuples "initarg tuples list")
- (class-allocation-a "class allocated attributes")
- (class-allocation-doc "class allocated documentation")
- (class-allocation-type "class allocated value type")
- (class-allocation-custom "class allocated custom descriptor")
- (class-allocation-custom-label "class allocated custom descriptor")
- (class-allocation-custom-group "class allocated custom group")
- (class-allocation-printer "class allocated printer for a slot")
- (class-allocation-protection "class allocated protection list")
- (class-allocation-values "class allocated value vector")
- (default-object-cache "what a newly created object would look like.
-This will speed up instantiation time as only a `copy-sequence' will
-be needed, instead of looping over all the values and setting them
-from the default.")
- (options "storage location of tagged class options.
-Stored outright without modifications or stripping.")))
-
-(eieio--define-field-accessors object
- (-unused-0 ;;FIXME: not sure, but at least there was no accessor!
- (class "class struct defining OBJ")
- name))
-
-;; FIXME: The constants below should have an `eieio-' prefix added!!
-
-(defconst method-static 0 "Index into :static tag on a method.")
-(defconst method-before 1 "Index into :before tag on a method.")
-(defconst method-primary 2 "Index into :primary tag on a method.")
-(defconst method-after 3 "Index into :after tag on a method.")
-(defconst method-num-lists 4 "Number of indexes into methods vector in which groups of functions are kept.")
-(defconst method-generic-before 4 "Index into generic :before tag on a method.")
-(defconst method-generic-primary 5 "Index into generic :primary tag on a method.")
-(defconst method-generic-after 6 "Index into generic :after tag on a method.")
-(defconst method-num-slots 7 "Number of indexes into a method's vector.")
-
-(defsubst eieio-specialized-key-to-generic-key (key)
- "Convert a specialized KEY into a generic method key."
- (cond ((eq key method-static) 0) ;; don't convert
- ((< key method-num-lists) (+ key 3)) ;; The conversion
- (t key) ;; already generic.. maybe.
- ))
+(defsubst eieio--object-class (obj)
+ (symbol-value (eieio--object-class-tag obj)))
;;; Important macros used internally in eieio.
-;;
-(defmacro eieio--check-type (type obj)
- (unless (symbolp obj)
- (error "eieio--check-type wants OBJ to be a variable"))
- `(if (not ,(cond
- ((eq 'or (car-safe type))
- `(or ,@(mapcar (lambda (type) `(,type ,obj)) (cdr type))))
- (t `(,type ,obj))))
- (signal 'wrong-type-argument (list ',type ,obj))))
-
-(defmacro class-v (class)
- "Internal: Return the class vector from the CLASS symbol."
- ;; No check: If eieio gets this far, it has probably been checked already.
- `(get ,class 'eieio-class-definition))
-
-(defmacro class-p (class)
- "Return t if CLASS is a valid class vector.
-CLASS is a symbol."
- ;; this new method is faster since it doesn't waste time checking lots of
- ;; things.
- `(condition-case nil
- (eq (aref (class-v ,class) 0) 'defclass)
- (error nil)))
-
-(defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS."
- (eieio--check-type class-p class)
- ;; I think this is supposed to return a symbol, but to me CLASS is a symbol,
- ;; and I wanted a string. Arg!
- (format "#<class %s>" (symbol-name class)))
+
+(require 'cl-macs) ;For cl--find-class.
+
+(defsubst eieio--class-object (class)
+ "Return the class object."
+ (if (symbolp class)
+ ;; Keep the symbol if class-v is nil, for better error messages.
+ (or (cl--find-class class) class)
+ class))
+
+(defun class-p (x)
+ "Return non-nil if X is a valid class vector.
+X can also be is a symbol."
+ (eieio--class-p (if (symbolp x) (cl--find-class x) x)))
+
+(defun eieio--class-print-name (class)
+ "Return a printed representation of CLASS."
+ (format "#<class %s>" (eieio-class-name class)))
+
+(defun eieio-class-name (class)
+ "Return a Lisp like symbol name for CLASS."
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (eieio--class-name class))
(define-obsolete-function-alias 'class-name #'eieio-class-name "24.4")
-(defmacro eieio-class-parents-fast (class)
- "Return parent classes to CLASS with no check."
- `(eieio--class-parent (class-v ,class)))
-
-(defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check."
- `(eieio--class-children (class-v ,class)))
-
-(defmacro same-class-fast-p (obj class)
- "Return t if OBJ is of class-type CLASS with no error checking."
- `(eq (eieio--object-class ,obj) ,class))
-
-(defmacro class-constructor (class)
- "Return the symbol representing the constructor of CLASS."
- `(eieio--class-symbol (class-v ,class)))
-
-(defmacro generic-p (method)
- "Return t if symbol METHOD is a generic function.
-Only methods have the symbol `eieio-method-obarray' as a property
-\(which contains a list of all bindings to that method type.)"
- `(and (fboundp ,method) (get ,method 'eieio-method-obarray)))
-
-(defun generic-primary-only-p (method)
- "Return t if symbol METHOD is a generic function with only primary methods.
-Only methods have the symbol `eieio-method-obarray' as a property (which
-contains a list of all bindings to that method type.)
-Methods with only primary implementations are executed in an optimized way."
- (and (generic-p method)
- (let ((M (get method 'eieio-method-tree)))
- (and (< 0 (length (aref M method-primary)))
- (not (aref M method-static))
- (not (aref M method-before))
- (not (aref M method-after))
- (not (aref M method-generic-before))
- (not (aref M method-generic-primary))
- (not (aref M method-generic-after))))
- ))
-
-(defun generic-primary-only-one-p (method)
- "Return t if symbol METHOD is a generic function with only primary methods.
-Only methods have the symbol `eieio-method-obarray' as a property (which
-contains a list of all bindings to that method type.)
-Methods with only primary implementations are executed in an optimized way."
- (and (generic-p method)
- (let ((M (get method 'eieio-method-tree)))
- (and (= 1 (length (aref M method-primary)))
- (not (aref M method-static))
- (not (aref M method-before))
- (not (aref M method-after))
- (not (aref M method-generic-before))
- (not (aref M method-generic-primary))
- (not (aref M method-generic-after))))
- ))
-
-(defmacro class-option-assoc (list option)
+(defalias 'eieio--class-constructor #'identity
+ "Return the symbol representing the constructor of CLASS.")
+
+(defmacro eieio--class-option-assoc (list option)
"Return from LIST the found OPTION, or nil if it doesn't exist."
`(car-safe (cdr (memq ,option ,list))))
-(defmacro class-option (class option)
+(defsubst eieio--class-option (class option)
"Return the value stored for CLASS' OPTION.
Return nil if that option doesn't exist."
- `(class-option-assoc (eieio--class-options (class-v ,class)) ',option))
+ (eieio--class-option-assoc (eieio--class-options class) option))
-(defmacro eieio-object-p (obj)
+(defun eieio-object-p (obj)
"Return non-nil if OBJ is an EIEIO object."
- `(condition-case nil
- (let ((tobj ,obj))
- (and (eq (aref tobj 0) 'object)
- (class-p (eieio--object-class tobj))))
- (error nil)))
-(defalias 'object-p 'eieio-object-p)
-
-(defmacro class-abstract-p (class)
+ (and (vectorp obj)
+ (> (length obj) 0)
+ (let ((tag (eieio--object-class-tag obj)))
+ (and (symbolp tag)
+ ;; (eq (symbol-function tag) :quick-object-witness-check)
+ (boundp tag)
+ (eieio--class-p (symbol-value tag))))))
+
+(define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
+
+(defun class-abstract-p (class)
"Return non-nil if CLASS is abstract.
Abstract classes cannot be instantiated."
- `(class-option ,class :abstract))
+ (eieio--class-option (cl--find-class class) :abstract))
-(defmacro class-method-invocation-order (class)
+(defsubst eieio--class-method-invocation-order (class)
"Return the invocation order of CLASS.
Abstract classes cannot be instantiated."
- `(or (class-option ,class :method-invocation-order)
- :breadth-first))
+ (or (eieio--class-option class :method-invocation-order)
+ :breadth-first))
;;;
;; Class Creation
-(defvar eieio-defclass-autoload-map (make-vector 7 nil)
+(defvar eieio-defclass-autoload-map (make-hash-table)
"Symbol map of superclasses we find in autoloads.")
;; We autoload this because it's used in `make-autoload'.
;;;###autoload
-(defun eieio-defclass-autoload (cname superclasses filename doc)
+(defun eieio-defclass-autoload (cname _superclasses filename doc)
"Create autoload symbols for the EIEIO class CNAME.
SUPERCLASSES are the superclasses that CNAME inherits from.
DOC is the docstring for CNAME.
@@ -337,82 +205,69 @@ SUPERCLASSES as children.
It creates an autoload function for CNAME's constructor."
;; Assume we've already debugged inputs.
- (let* ((oldc (when (class-p cname) (class-v cname)))
- (newc (make-vector eieio--class-num-slots nil))
- )
- (if oldc
+ ;; We used to store the list of superclasses in the `parent' slot (as a list
+ ;; of class names). But now this slot holds a list of class objects, and
+ ;; those parents may not exist yet, so the corresponding class objects may
+ ;; simply not exist yet. So instead we just don't store the list of parents
+ ;; here in eieio-defclass-autoload at all, since it seems that they're just
+ ;; not needed before the class is actually loaded.
+ (let* ((oldc (cl--find-class cname))
+ (newc (eieio--class-make cname)))
+ (if (eieio--class-p oldc)
nil ;; Do nothing if we already have this class.
- ;; Create the class in NEWC, but don't fill anything else in.
- (aset newc 0 'defclass)
- (setf (eieio--class-symbol newc) cname)
-
- (let ((clear-parent nil))
- ;; No parents?
- (when (not superclasses)
- (setq superclasses '(eieio-default-superclass)
- clear-parent t)
- )
-
- ;; Hook our new class into the existing structures so we can
- ;; autoload it later.
- (dolist (SC superclasses)
-
-
- ;; TODO - If we create an autoload that is in the map, that
- ;; map needs to be cleared!
-
-
- ;; Does our parent exist?
- (if (not (class-p SC))
-
- ;; Create a symbol for this parent, and then store this
- ;; parent on that symbol.
- (let ((sym (intern (symbol-name SC) eieio-defclass-autoload-map)))
- (if (not (boundp sym))
- (set sym (list cname))
- (add-to-list sym cname))
- )
-
- ;; We have a parent, save the child in there.
- (when (not (member cname (eieio--class-children (class-v SC))))
- (setf (eieio--class-children (class-v SC))
- (cons cname (eieio--class-children (class-v SC))))))
-
- ;; save parent in child
- (setf (eieio--class-parent newc) (cons SC (eieio--class-parent newc)))
- )
-
- ;; turn this into a usable self-pointing symbol
- (set cname cname)
-
- ;; Store the new class vector definition into the symbol. We need to
- ;; do this first so that we can call defmethod for the accessor.
- ;; The vector will be updated by the following while loop and will not
- ;; need to be stored a second time.
- (put cname 'eieio-class-definition newc)
-
- ;; Clear the parent
- (if clear-parent (setf (eieio--class-parent newc) nil))
-
- ;; Create an autoload on top of our constructor function.
- (autoload cname filename doc nil nil)
- (autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
- (autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
- (autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
-
- ))))
+ ;; turn this into a usable self-pointing symbol
+ (when eieio-backward-compatibility
+ (set cname cname)
+ (make-obsolete-variable cname (format "use \\='%s instead" cname)
+ "25.1"))
+
+ ;; Store the new class vector definition into the symbol. We need to
+ ;; do this first so that we can call defmethod for the accessor.
+ ;; The vector will be updated by the following while loop and will not
+ ;; need to be stored a second time.
+ (setf (cl--find-class cname) newc)
+
+ ;; Create an autoload on top of our constructor function.
+ (autoload cname filename doc nil nil)
+ (autoload (intern (format "%s-p" cname)) filename "" nil nil)
+ (when eieio-backward-compatibility
+ (autoload (intern (format "%s-child-p" cname)) filename "" nil nil)
+ (autoload (intern (format "%s-list-p" cname)) filename "" nil nil)))))
(defsubst eieio-class-un-autoload (cname)
"If class CNAME is in an autoload state, load its file."
- (when (eq (car-safe (symbol-function cname)) 'autoload)
- (load-library (car (cdr (symbol-function cname))))))
-
-(defun eieio-defclass (cname superclasses slots options-and-doc)
- ;; FIXME: Most of this should be moved to the `defclass' macro.
+ (autoload-do-load (symbol-function cname))) ; cname
+
+(cl-deftype list-of (elem-type)
+ `(and list
+ (satisfies (lambda (list)
+ (cl-every (lambda (elem) (cl-typep elem ',elem-type))
+ list)))))
+
+
+(defun eieio-make-class-predicate (class)
+ (lambda (obj)
+ (:documentation
+ (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)"
+ class))
+ (and (eieio-object-p obj)
+ (same-class-p obj class))))
+
+(defun eieio-make-child-predicate (class)
+ (lambda (obj)
+ (:documentation
+ (format "Return non-nil if OBJ is an object of type `%S' or a subclass.
+\n(fn OBJ)" class))
+ (and (eieio-object-p obj)
+ (object-of-class-p obj class))))
+
+(defvar eieio--known-slot-names nil)
+
+(defun eieio-defclass-internal (cname superclasses slots options)
"Define CNAME as a new subclass of SUPERCLASSES.
-SLOTS are the slots residing in that class definition, and options or
-documentation OPTIONS-AND-DOC is the toplevel documentation for this class.
+SLOTS are the slots residing in that class definition, and OPTIONS
+holds the class options.
See `defclass' for more information."
;; Run our eieio-hook each time, and clear it when we are done.
;; This way people can add hooks safely if they want to modify eieio
@@ -420,385 +275,214 @@ See `defclass' for more information."
(run-hooks 'eieio-hook)
(setq eieio-hook nil)
- (eieio--check-type listp superclasses)
-
- (let* ((pname superclasses)
- (newc (make-vector eieio--class-num-slots nil))
- (oldc (when (class-p cname) (class-v cname)))
+ (let* ((oldc (let ((c (cl--find-class cname))) (if (eieio--class-p c) c)))
+ (newc (or oldc
+ ;; Reuse `oldc' instead of creating a new one, so that
+ ;; existing references stay valid. E.g. when
+ ;; reloading the file that does the `defclass', we don't
+ ;; want to create a new class object.
+ (eieio--class-make cname)))
(groups nil) ;; list of groups id'd from slots
- (options nil)
(clearparent nil))
- (aset newc 0 'defclass)
- (setf (eieio--class-symbol newc) cname)
-
;; If this class already existed, and we are updating its structure,
;; make sure we keep the old child list. This can cause bugs, but
;; if no new slots are created, it also saves time, and prevents
;; method table breakage, particularly when the users is only
;; byte compiling an EIEIO file.
(if oldc
- (setf (eieio--class-children newc) (eieio--class-children oldc))
- ;; If the old class did not exist, but did exist in the autoload map, then adopt those children.
- ;; This is like the above, but deals with autoloads nicely.
- (let ((sym (intern-soft (symbol-name cname) eieio-defclass-autoload-map)))
- (when sym
- (condition-case nil
- (setf (eieio--class-children newc) (symbol-value sym))
- (error nil))
- (unintern (symbol-name cname) eieio-defclass-autoload-map)
- ))
- )
-
- (cond ((and (stringp (car options-and-doc))
- (/= 1 (% (length options-and-doc) 2)))
- (error "Too many arguments to `defclass'"))
- ((and (symbolp (car options-and-doc))
- (/= 0 (% (length options-and-doc) 2)))
- (error "Too many arguments to `defclass'"))
- )
-
- (setq options
- (if (stringp (car options-and-doc))
- (cons :documentation options-and-doc)
- options-and-doc))
-
- (if pname
+ (progn
+ (cl-assert (eq newc oldc))
+ ;; Reset the fields.
+ (setf (eieio--class-parents newc) nil)
+ (setf (eieio--class-slots newc) nil)
+ (setf (eieio--class-initarg-tuples newc) nil)
+ (setf (eieio--class-class-slots newc) nil))
+ ;; If the old class did not exist, but did exist in the autoload map,
+ ;; then adopt those children. This is like the above, but deals with
+ ;; autoloads nicely.
+ (let ((children (gethash cname eieio-defclass-autoload-map)))
+ (when children
+ (setf (eieio--class-children newc) children)
+ (remhash cname eieio-defclass-autoload-map))))
+
+ (if superclasses
(progn
- (while pname
- (if (and (car pname) (symbolp (car pname)))
- (if (not (class-p (car pname)))
+ (dolist (p superclasses)
+ (if (not (and p (symbolp p)))
+ (error "Invalid parent class %S" p)
+ (let ((c (cl--find-class p)))
+ (if (not (eieio--class-p c))
;; bad class
- (error "Given parent class %s is not a class" (car pname))
+ (error "Given parent class %S is not a class" p)
;; good parent class...
;; save new child in parent
- (when (not (member cname (eieio--class-children (class-v (car pname)))))
- (setf (eieio--class-children (class-v (car pname)))
- (cons cname (eieio--class-children (class-v (car pname))))))
+ (cl-pushnew cname (eieio--class-children c))
;; Get custom groups, and store them into our local copy.
- (mapc (lambda (g) (pushnew g groups :test #'equal))
- (class-option (car pname) :custom-groups))
- ;; save parent in child
- (setf (eieio--class-parent newc) (cons (car pname) (eieio--class-parent newc))))
- (error "Invalid parent class %s" pname))
- (setq pname (cdr pname)))
+ (mapc (lambda (g) (cl-pushnew g groups :test #'equal))
+ (eieio--class-option c :custom-groups))
+ ;; Save parent in child.
+ (push c (eieio--class-parents newc))))))
;; Reverse the list of our parents so that they are prioritized in
;; the same order as specified in the code.
- (setf (eieio--class-parent newc) (nreverse (eieio--class-parent newc))) )
+ (cl-callf nreverse (eieio--class-parents newc)))
;; If there is nothing to loop over, then inherit from the
;; default superclass.
(unless (eq cname 'eieio-default-superclass)
;; adopt the default parent here, but clear it later...
(setq clearparent t)
- ;; save new child in parent
- (if (not (member cname (eieio--class-children (class-v 'eieio-default-superclass))))
- (setf (eieio--class-children (class-v 'eieio-default-superclass))
- (cons cname (eieio--class-children (class-v 'eieio-default-superclass)))))
- ;; save parent in child
- (setf (eieio--class-parent newc) (list eieio-default-superclass))))
-
- ;; turn this into a usable self-pointing symbol
- (set cname cname)
-
- ;; These two tests must be created right away so we can have self-
- ;; referencing classes. ei, a class whose slot can contain only
- ;; pointers to itself.
-
- ;; Create the test function
- (let ((csym (intern (concat (symbol-name cname) "-p"))))
- (fset csym
- (list 'lambda (list 'obj)
- (format "Test OBJ to see if it an object of type %s" cname)
- (list 'and '(eieio-object-p obj)
- (list 'same-class-p 'obj cname)))))
-
- ;; Make sure the method invocation order is a valid value.
- (let ((io (class-option-assoc options :method-invocation-order)))
- (when (and io (not (member io '(:depth-first :breadth-first :c3))))
- (error "Method invocation order %s is not allowed" io)
- ))
+ ;; save new child in parent
+ (cl-pushnew cname (eieio--class-children eieio-default-superclass))
+ ;; save parent in child
+ (setf (eieio--class-parents newc) (list eieio-default-superclass))))
- ;; Create a handy child test too
- (let ((csym (intern (concat (symbol-name cname) "-child-p"))))
- (fset csym
- `(lambda (obj)
- ,(format
- "Test OBJ to see if it an object is a child of type %s"
- cname)
- (and (eieio-object-p obj)
- (object-of-class-p obj ,cname))))
+ ;; turn this into a usable self-pointing symbol; FIXME: Why?
+ (when eieio-backward-compatibility
+ (set cname cname)
+ (make-obsolete-variable cname (format "use \\='%s instead" cname)
+ "25.1"))
;; Create a handy list of the class test too
- (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
- (fset csym
- `(lambda (obj)
- ,(format
- "Test OBJ to see if it a list of objects which are a child of type %s"
- cname)
- (when (listp obj)
- (let ((ans t)) ;; nil is valid
- ;; Loop over all the elements of the input list, test
- ;; each to make sure it is a child of the desired object class.
- (while (and obj ans)
- (setq ans (and (eieio-object-p (car obj))
- (object-of-class-p (car obj) ,cname)))
- (setq obj (cdr obj)))
- ans)))))
-
- ;; When using typep, (typep OBJ 'myclass) returns t for objects which
- ;; are subclasses of myclass. For our predicates, however, it is
- ;; important for EIEIO to be backwards compatible, where
- ;; myobject-p, and myobject-child-p are different.
- ;; "cl" uses this technique to specify symbols with specific typep
- ;; test, so we can let typep have the CLOS documented behavior
- ;; while keeping our above predicate clean.
-
- ;; It would be cleaner to use `defsetf' here, but that requires cl
- ;; at runtime.
- (put cname 'cl-deftype-handler
- (list 'lambda () `(list 'satisfies (quote ,csym)))))
+ (when eieio-backward-compatibility
+ (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
+ (defalias csym
+ `(lambda (obj)
+ ,(format
+ "Test OBJ to see if it a list of objects which are a child of type %s"
+ cname)
+ (when (listp obj)
+ (let ((ans t)) ;; nil is valid
+ ;; Loop over all the elements of the input list, test
+ ;; each to make sure it is a child of the desired object class.
+ (while (and obj ans)
+ (setq ans (and (eieio-object-p (car obj))
+ (object-of-class-p (car obj) ,cname)))
+ (setq obj (cdr obj)))
+ ans))))
+ (make-obsolete csym (format
+ "use (cl-typep ... \\='(list-of %s)) instead"
+ cname)
+ "25.1")))
;; Before adding new slots, let's add all the methods and classes
;; in from the parent class.
- (eieio-copy-parents-into-subclass newc superclasses)
+ (eieio-copy-parents-into-subclass newc)
;; Store the new class vector definition into the symbol. We need to
;; do this first so that we can call defmethod for the accessor.
;; The vector will be updated by the following while loop and will not
;; need to be stored a second time.
- (put cname 'eieio-class-definition newc)
+ (setf (cl--find-class cname) newc)
;; Query each slot in the declaration list and mangle into the
;; class structure I have defined.
- (while slots
- (let* ((slot1 (car slots))
- (name (car slot1))
- (slot (cdr slot1))
- (acces (plist-get slot ':accessor))
- (init (or (plist-get slot ':initform)
- (if (member ':initform slot) nil
+ (pcase-dolist (`(,name . ,slot) slots)
+ (let* ((init (or (plist-get slot :initform)
+ (if (member :initform slot) nil
eieio-unbound)))
- (initarg (plist-get slot ':initarg))
- (docstr (plist-get slot ':documentation))
- (prot (plist-get slot ':protection))
- (reader (plist-get slot ':reader))
- (writer (plist-get slot ':writer))
- (alloc (plist-get slot ':allocation))
- (type (plist-get slot ':type))
- (custom (plist-get slot ':custom))
- (label (plist-get slot ':label))
- (customg (plist-get slot ':group))
- (printer (plist-get slot ':printer))
-
- (skip-nil (class-option-assoc options :allow-nil-initform))
+ (initarg (plist-get slot :initarg))
+ (docstr (plist-get slot :documentation))
+ (prot (plist-get slot :protection))
+ (alloc (plist-get slot :allocation))
+ (type (plist-get slot :type))
+ (custom (plist-get slot :custom))
+ (label (plist-get slot :label))
+ (customg (plist-get slot :group))
+ (printer (plist-get slot :printer))
+
+ (skip-nil (eieio--class-option-assoc options :allow-nil-initform))
)
- (if eieio-error-unsupported-class-tags
- (let ((tmp slot))
- (while tmp
- (if (not (member (car tmp) '(:accessor
- :initform
- :initarg
- :documentation
- :protection
- :reader
- :writer
- :allocation
- :type
- :custom
- :label
- :group
- :printer
- :allow-nil-initform
- :custom-groups)))
- (signal 'invalid-slot-type (list (car tmp))))
- (setq tmp (cdr (cdr tmp))))))
-
;; Clean up the meaning of protection.
- (cond ((or (eq prot 'public) (eq prot :public)) (setq prot nil))
- ((or (eq prot 'protected) (eq prot :protected)) (setq prot 'protected))
- ((or (eq prot 'private) (eq prot :private)) (setq prot 'private))
- ((eq prot nil) nil)
- (t (signal 'invalid-slot-type (list ':protection prot))))
-
- ;; Make sure the :allocation parameter has a valid value.
- (if (not (or (not alloc) (eq alloc :class) (eq alloc :instance)))
- (signal 'invalid-slot-type (list ':allocation alloc)))
+ (setq prot
+ (pcase prot
+ ((or 'nil 'public ':public) nil)
+ ((or 'protected ':protected) 'protected)
+ ((or 'private ':private) 'private)
+ (_ (signal 'invalid-slot-type (list :protection prot)))))
;; The default type specifier is supposed to be t, meaning anything.
(if (not type) (setq type t))
- ;; Label is nil, or a string
- (if (not (or (null label) (stringp label)))
- (signal 'invalid-slot-type (list ':label label)))
-
- ;; Is there an initarg, but allocation of class?
- (if (and initarg (eq alloc :class))
- (message "Class allocated slots do not need :initarg"))
-
;; intern the symbol so we can use it blankly
- (if initarg (set initarg initarg))
-
- ;; The customgroup should be a list of symbols
- (cond ((null customg)
+ (if eieio-backward-compatibility
+ (and initarg (not (keywordp initarg))
+ (progn
+ (set initarg initarg)
+ (make-obsolete-variable
+ initarg (format "use \\='%s instead" initarg) "25.1"))))
+
+ ;; The customgroup should be a list of symbols.
+ (cond ((and (null customg) custom)
(setq customg '(default)))
((not (listp customg))
(setq customg (list customg))))
- ;; The customgroup better be a symbol, or list of symbols.
- (mapc (lambda (cg)
- (if (not (symbolp cg))
- (signal 'invalid-slot-type (list ':group cg))))
- customg)
+ ;; The customgroup better be a list of symbols.
+ (dolist (cg customg)
+ (unless (symbolp cg)
+ (signal 'invalid-slot-type (list :group cg))))
;; First up, add this slot into our new class.
- (eieio-add-new-slot newc name init docstr type custom label customg printer
- prot initarg alloc 'defaultoverride skip-nil)
+ (eieio--add-new-slot
+ newc (cl--make-slot-descriptor
+ name init type
+ `(,@(if docstr `((:documentation . ,docstr)))
+ ,@(if custom `((:custom . ,custom)))
+ ,@(if label `((:label . ,label)))
+ ,@(if customg `((:group . ,customg)))
+ ,@(if printer `((:printer . ,printer)))
+ ,@(if prot `((:protection . ,prot)))))
+ initarg alloc 'defaultoverride skip-nil)
;; We need to id the group, and store them in a group list attribute.
- (mapc (lambda (cg) (pushnew cg groups :test 'equal)) customg)
-
- ;; Anyone can have an accessor function. This creates a function
- ;; of the specified name, and also performs a `defsetf' if applicable
- ;; so that users can `setf' the space returned by this function.
- (if acces
- (progn
- (eieio--defmethod
- acces (if (eq alloc :class) :static :primary) cname
- `(lambda (this)
- ,(format
- "Retrieves the slot `%s' from an object of class `%s'"
- name cname)
- (if (slot-boundp this ',name)
- (eieio-oref this ',name)
- ;; Else - Some error? nil?
- nil)))
-
- (if (fboundp 'gv-define-setter)
- ;; FIXME: We should move more of eieio-defclass into the
- ;; defclass macro so we don't have to use `eval' and require
- ;; `gv' at run-time.
- (eval `(gv-define-setter ,acces (eieio--store eieio--object)
- (list 'eieio-oset eieio--object '',name
- eieio--store)))
- ;; Provide a setf method. It would be cleaner to use
- ;; defsetf, but that would require CL at runtime.
- (put acces 'setf-method
- `(lambda (widget)
- (let* ((--widget-sym-- (make-symbol "--widget--"))
- (--store-sym-- (make-symbol "--store--")))
- (list
- (list --widget-sym--)
- (list widget)
- (list --store-sym--)
- (list 'eieio-oset --widget-sym-- '',name
- --store-sym--)
- (list 'getfoo --widget-sym--))))))))
-
- ;; If a writer is defined, then create a generic method of that
- ;; name whose purpose is to set the value of the slot.
- (if writer
- (eieio--defmethod
- writer nil cname
- `(lambda (this value)
- ,(format "Set the slot `%s' of an object of class `%s'"
- name cname)
- (setf (slot-value this ',name) value))))
- ;; If a reader is defined, then create a generic method
- ;; of that name whose purpose is to access this slot value.
- (if reader
- (eieio--defmethod
- reader nil cname
- `(lambda (this)
- ,(format "Access the slot `%s' from object of class `%s'"
- name cname)
- (slot-value this ',name))))
- )
- (setq slots (cdr slots)))
+ (dolist (cg customg)
+ (cl-pushnew cg groups :test #'equal))
+ ))
;; Now that everything has been loaded up, all our lists are backwards!
- ;; Fix that up now.
- (setf (eieio--class-public-a newc) (nreverse (eieio--class-public-a newc)))
- (setf (eieio--class-public-d newc) (nreverse (eieio--class-public-d newc)))
- (setf (eieio--class-public-doc newc) (nreverse (eieio--class-public-doc newc)))
- (setf (eieio--class-public-type newc)
- (apply 'vector (nreverse (eieio--class-public-type newc))))
- (setf (eieio--class-public-custom newc) (nreverse (eieio--class-public-custom newc)))
- (setf (eieio--class-public-custom-label newc) (nreverse (eieio--class-public-custom-label newc)))
- (setf (eieio--class-public-custom-group newc) (nreverse (eieio--class-public-custom-group newc)))
- (setf (eieio--class-public-printer newc) (nreverse (eieio--class-public-printer newc)))
- (setf (eieio--class-protection newc) (nreverse (eieio--class-protection newc)))
- (setf (eieio--class-initarg-tuples newc) (nreverse (eieio--class-initarg-tuples newc)))
+ ;; Fix that up now and then them into vectors.
+ (cl-callf (lambda (slots) (apply #'vector (nreverse slots)))
+ (eieio--class-slots newc))
+ (cl-callf nreverse (eieio--class-initarg-tuples newc))
;; The storage for class-class-allocation-type needs to be turned into
;; a vector now.
- (setf (eieio--class-class-allocation-type newc)
- (apply 'vector (eieio--class-class-allocation-type newc)))
-
- ;; Also, take class allocated values, and vectorize them for speed.
- (setf (eieio--class-class-allocation-values newc)
- (apply 'vector (eieio--class-class-allocation-values newc)))
-
- ;; Attach slot symbols into an obarray, and store the index of
- ;; this slot as the variable slot in this new symbol. We need to
- ;; know about primes, because obarrays are best set in vectors of
- ;; prime number length, and we also need to make our vector small
- ;; to save space, and also optimal for the number of items we have.
- (let* ((cnt 0)
- (pubsyms (eieio--class-public-a newc))
- (prots (eieio--class-protection newc))
- (l (length pubsyms))
- (vl (let ((primes '( 3 5 7 11 13 17 19 23 29 31 37 41 43 47
- 53 59 61 67 71 73 79 83 89 97 101 )))
- (while (and primes (< (car primes) l))
- (setq primes (cdr primes)))
- (car primes)))
- (oa (make-vector vl 0))
- (newsym))
- (while pubsyms
- (setq newsym (intern (symbol-name (car pubsyms)) oa))
- (set newsym cnt)
- (setq cnt (1+ cnt))
- (if (car prots) (put newsym 'protection (car prots)))
- (setq pubsyms (cdr pubsyms)
- prots (cdr prots)))
- (setf (eieio--class-symbol-obarray newc) oa)
- )
-
- ;; Create the constructor function
- (if (class-option-assoc options :abstract)
- ;; Abstract classes cannot be instantiated. Say so.
- (let ((abs (class-option-assoc options :abstract)))
- (if (not (stringp abs))
- (setq abs (format "Class %s is abstract" cname)))
- (fset cname
- `(lambda (&rest stuff)
- ,(format "You cannot create a new object of type %s" cname)
- (error ,abs))))
-
- ;; Non-abstract classes need a constructor.
- (fset cname
- `(lambda (newname &rest slots)
- ,(format "Create a new object with name NAME of class type %s" cname)
- (apply 'constructor ,cname newname slots)))
- )
+ (cl-callf (lambda (slots) (apply #'vector slots))
+ (eieio--class-class-slots newc))
+
+ ;; Also, setup the class allocated values.
+ (let* ((slots (eieio--class-class-slots newc))
+ (n (length slots))
+ (v (make-vector n nil)))
+ (dotimes (i n)
+ (setf (aref v i) (eieio-default-eval-maybe
+ (cl--slot-descriptor-initform (aref slots i)))))
+ (setf (eieio--class-class-allocation-values newc) v))
+
+ ;; Attach slot symbols into a hashtable, and store the index of
+ ;; this slot as the value this table.
+ (let* ((slots (eieio--class-slots newc))
+ ;; (cslots (eieio--class-class-slots newc))
+ (oa (make-hash-table :test #'eq)))
+ ;; (dotimes (cnt (length cslots))
+ ;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt)))
+ (dotimes (cnt (length slots))
+ (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt))
+ (setf (eieio--class-index-table newc) oa))
;; Set up a specialized doc string.
;; Use stored value since it is calculated in a non-trivial way
- (put cname 'variable-documentation
- (class-option-assoc options :documentation))
+ (let ((docstring (eieio--class-option-assoc options :documentation)))
+ (setf (eieio--class-docstring newc) docstring)
+ (when eieio-backward-compatibility
+ (put cname 'variable-documentation docstring)))
;; Save the file location where this class is defined.
- (let ((fname (if load-in-progress
- load-file-name
- buffer-file-name)))
- (when fname
- (when (string-match "\\.elc\\'" fname)
- (setq fname (substring fname 0 (1- (length fname)))))
- (put cname 'class-location fname)))
+ (add-to-list 'current-load-list `(define-type . ,cname))
;; We have a list of custom groups. Store them into the options.
- (let ((g (class-option-assoc options :custom-groups)))
- (mapc (lambda (cg) (pushnew cg g :test 'equal)) groups)
+ (let ((g (eieio--class-option-assoc options :custom-groups)))
+ (mapc (lambda (cg) (cl-pushnew cg g :test 'equal)) groups)
(if (memq :custom-groups options)
(setcar (cdr (memq :custom-groups options)) g)
(setq options (cons :custom-groups (cons g options)))))
@@ -808,14 +492,21 @@ See `defclass' for more information."
;; if this is a superclass, clear out parent (which was set to the
;; default superclass eieio-default-superclass)
- (if clearparent (setf (eieio--class-parent newc) nil))
+ (if clearparent (setf (eieio--class-parents newc) nil))
;; Create the cached default object.
- (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) 3)
- nil)))
- (aset cache 0 'object)
- (setf (eieio--object-class cache) cname)
- (setf (eieio--object-name cache) 'default-cache-object)
+ (let ((cache (make-vector (+ (length (eieio--class-slots newc))
+ (eval-when-compile eieio--object-num-slots))
+ nil))
+ ;; We don't strictly speaking need to use a symbol, but the old
+ ;; code used the class's name rather than the class's object, so
+ ;; we follow this preference for using a symbol, which is probably
+ ;; convenient to keep the printed representation of such Elisp
+ ;; objects readable.
+ (tag (intern (format "eieio-class-tag--%s" cname))))
+ (set tag newc)
+ (fset tag :quick-object-witness-check)
+ (setf (eieio--object-class-tag cache) tag)
(let ((eieio-skip-typecheck t))
;; All type-checking has been done to our satisfaction
;; before this call. Don't waste our time in this call..
@@ -831,523 +522,172 @@ See `defclass' for more information."
"Whether the default value VAL should be evaluated for use."
(and (consp val) (symbolp (car val)) (fboundp (car val))))
-(defun eieio-perform-slot-validation-for-default (slot spec value skipnil)
- "For SLOT, signal if SPEC does not match VALUE.
-If SKIPNIL is non-nil, then if VALUE is nil return t instead."
- (if (and (not (eieio-eval-default-p value))
- (not eieio-skip-typecheck)
- (not (and skipnil (null value)))
- (not (eieio-perform-slot-validation spec value)))
- (signal 'invalid-slot-type (list slot spec value))))
-
-(defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc
+(defun eieio--perform-slot-validation-for-default (slot skipnil)
+ "For SLOT, signal if its type does not match its default value.
+If SKIPNIL is non-nil, then if default value is nil return t instead."
+ (let ((value (cl--slot-descriptor-initform slot))
+ (spec (cl--slot-descriptor-type slot)))
+ (if (not (or (eieio-eval-default-p value) ;FIXME: Why?
+ eieio-skip-typecheck
+ (and skipnil (null value))
+ (eieio--perform-slot-validation spec value)))
+ (signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value)))))
+
+(defun eieio--slot-override (old new skipnil)
+ (cl-assert (eq (cl--slot-descriptor-name old) (cl--slot-descriptor-name new)))
+ ;; There is a match, and we must override the old value.
+ (let* ((a (cl--slot-descriptor-name old))
+ (tp (cl--slot-descriptor-type old))
+ (d (cl--slot-descriptor-initform new))
+ (type (cl--slot-descriptor-type new))
+ (oprops (cl--slot-descriptor-props old))
+ (nprops (cl--slot-descriptor-props new))
+ (custg (alist-get :group nprops)))
+ ;; If type is passed in, is it the same?
+ (if (not (eq type t))
+ (if (not (equal type tp))
+ (error
+ "Child slot type `%s' does not match inherited type `%s' for `%s'"
+ type tp a))
+ (setf (cl--slot-descriptor-type new) tp))
+ ;; If we have a repeat, only update the initarg...
+ (unless (eq d eieio-unbound)
+ (eieio--perform-slot-validation-for-default new skipnil)
+ (setf (cl--slot-descriptor-initform old) d))
+
+ ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
+ ;; checked and SHOULD match the superclass
+ ;; protection. Otherwise an error is thrown. However
+ ;; I wonder if a more flexible schedule might be
+ ;; implemented.
+ ;;
+ ;; EML - We used to have (if prot... here,
+ ;; but a prot of 'nil means public.
+ ;;
+ (let ((super-prot (alist-get :protection oprops))
+ (prot (alist-get :protection nprops)))
+ (if (not (eq prot super-prot))
+ (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
+ prot super-prot a)))
+ ;; End original PLN
+
+ ;; PLN Tue Jun 26 11:57:06 2007 :
+ ;; Do a non redundant combination of ancient custom
+ ;; groups and new ones.
+ (when custg
+ (let* ((list1 (alist-get :group oprops)))
+ (dolist (elt custg)
+ (unless (memq elt list1)
+ (push elt list1)))
+ (setf (alist-get :group (cl--slot-descriptor-props old)) list1)))
+ ;; End PLN
+
+ ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is
+ ;; set, simply replaces the old one.
+ (dolist (prop '(:custom :label :documentation :printer))
+ (when (alist-get prop (cl--slot-descriptor-props new))
+ (setf (alist-get prop (cl--slot-descriptor-props old))
+ (alist-get prop (cl--slot-descriptor-props new))))
+
+ ) ))
+
+(defun eieio--add-new-slot (newc slot init alloc
&optional defaultoverride skipnil)
- "Add into NEWC attribute A.
-If A already exists in NEWC, then do nothing. If it doesn't exist,
-then also add in D (default), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg.
+ "Add into NEWC attribute SLOT.
+If a slot of that name already exists in NEWC, then do nothing. If it doesn't exist,
+INIT is the initarg, if any.
Argument ALLOC specifies if the slot is allocated per instance, or per class.
If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC,
we must override its value for a default.
Optional argument SKIPNIL indicates if type checking should be skipped
if default value is nil."
;; Make sure we duplicate those items that are sequences.
- (condition-case nil
- (if (sequencep d) (setq d (copy-sequence d)))
- ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work.
- (error nil))
- (if (sequencep type) (setq type (copy-sequence type)))
- (if (sequencep cust) (setq cust (copy-sequence cust)))
- (if (sequencep custg) (setq custg (copy-sequence custg)))
-
- ;; To prevent override information w/out specification of storage,
- ;; we need to do this little hack.
- (if (member a (eieio--class-class-allocation-a newc)) (setq alloc ':class))
-
- (if (or (not alloc) (and (symbolp alloc) (eq alloc ':instance)))
- ;; In this case, we modify the INSTANCE version of a given slot.
-
- (progn
-
- ;; Only add this element if it is so-far unique
- (if (not (member a (eieio--class-public-a newc)))
- (progn
- (eieio-perform-slot-validation-for-default a type d skipnil)
- (setf (eieio--class-public-a newc) (cons a (eieio--class-public-a newc)))
- (setf (eieio--class-public-d newc) (cons d (eieio--class-public-d newc)))
- (setf (eieio--class-public-doc newc) (cons doc (eieio--class-public-doc newc)))
- (setf (eieio--class-public-type newc) (cons type (eieio--class-public-type newc)))
- (setf (eieio--class-public-custom newc) (cons cust (eieio--class-public-custom newc)))
- (setf (eieio--class-public-custom-label newc) (cons label (eieio--class-public-custom-label newc)))
- (setf (eieio--class-public-custom-group newc) (cons custg (eieio--class-public-custom-group newc)))
- (setf (eieio--class-public-printer newc) (cons print (eieio--class-public-printer newc)))
- (setf (eieio--class-protection newc) (cons prot (eieio--class-protection newc)))
- (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc)))
- )
- ;; When defaultoverride is true, we are usually adding new local
- ;; attributes which must override the default value of any slot
- ;; passed in by one of the parent classes.
- (when defaultoverride
- ;; There is a match, and we must override the old value.
- (let* ((ca (eieio--class-public-a newc))
- (np (member a ca))
- (num (- (length ca) (length np)))
- (dp (if np (nthcdr num (eieio--class-public-d newc))
- nil))
- (tp (if np (nth num (eieio--class-public-type newc))))
- )
- (if (not np)
- (error "EIEIO internal error overriding default value for %s"
- a)
- ;; If type is passed in, is it the same?
- (if (not (eq type t))
- (if (not (equal type tp))
- (error
- "Child slot type `%s' does not match inherited type `%s' for `%s'"
- type tp a)))
- ;; If we have a repeat, only update the initarg...
- (unless (eq d eieio-unbound)
- (eieio-perform-slot-validation-for-default a tp d skipnil)
- (setcar dp d))
- ;; If we have a new initarg, check for it.
- (when init
- (let* ((inits (eieio--class-initarg-tuples newc))
- (inita (rassq a inits)))
- ;; Replace the CAR of the associate INITA.
- ;;(message "Initarg: %S replace %s" inita init)
- (setcar inita init)
- ))
-
- ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
- ;; checked and SHOULD match the superclass
- ;; protection. Otherwise an error is thrown. However
- ;; I wonder if a more flexible schedule might be
- ;; implemented.
- ;;
- ;; EML - We used to have (if prot... here,
- ;; but a prot of 'nil means public.
- ;;
- (let ((super-prot (nth num (eieio--class-protection newc)))
- )
- (if (not (eq prot super-prot))
- (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
- prot super-prot a)))
- ;; End original PLN
-
- ;; PLN Tue Jun 26 11:57:06 2007 :
- ;; Do a non redundant combination of ancient custom
- ;; groups and new ones.
- (when custg
- (let* ((groups
- (nthcdr num (eieio--class-public-custom-group newc)))
- (list1 (car groups))
- (list2 (if (listp custg) custg (list custg))))
- (if (< (length list1) (length list2))
- (setq list1 (prog1 list2 (setq list2 list1))))
- (dolist (elt list2)
- (unless (memq elt list1)
- (push elt list1)))
- (setcar groups list1)))
- ;; End PLN
-
- ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is
- ;; set, simply replaces the old one.
- (when cust
- ;; (message "Custom type redefined to %s" cust)
- (setcar (nthcdr num (eieio--class-public-custom newc)) cust))
-
- ;; If a new label is specified, it simply replaces
- ;; the old one.
- (when label
- ;; (message "Custom label redefined to %s" label)
- (setcar (nthcdr num (eieio--class-public-custom-label newc)) label))
- ;; End PLN
-
- ;; PLN Sat Jun 30 17:24:42 2007 : when a new
- ;; doc is specified, simply replaces the old one.
- (when doc
- ;;(message "Documentation redefined to %s" doc)
- (setcar (nthcdr num (eieio--class-public-doc newc))
- doc))
- ;; End PLN
-
- ;; If a new printer is specified, it simply replaces
- ;; the old one.
- (when print
- ;; (message "printer redefined to %s" print)
- (setcar (nthcdr num (eieio--class-public-printer newc)) print))
-
- )))
- ))
-
- ;; CLASS ALLOCATED SLOTS
- (let ((value (eieio-default-eval-maybe d)))
- (if (not (member a (eieio--class-class-allocation-a newc)))
- (progn
- (eieio-perform-slot-validation-for-default a type value skipnil)
- ;; Here we have found a :class version of a slot. This
- ;; requires a very different approach.
- (setf (eieio--class-class-allocation-a newc) (cons a (eieio--class-class-allocation-a newc)))
- (setf (eieio--class-class-allocation-doc newc) (cons doc (eieio--class-class-allocation-doc newc)))
- (setf (eieio--class-class-allocation-type newc) (cons type (eieio--class-class-allocation-type newc)))
- (setf (eieio--class-class-allocation-custom newc) (cons cust (eieio--class-class-allocation-custom newc)))
- (setf (eieio--class-class-allocation-custom-label newc) (cons label (eieio--class-class-allocation-custom-label newc)))
- (setf (eieio--class-class-allocation-custom-group newc) (cons custg (eieio--class-class-allocation-custom-group newc)))
- (setf (eieio--class-class-allocation-protection newc) (cons prot (eieio--class-class-allocation-protection newc)))
- ;; Default value is stored in the 'values section, since new objects
- ;; can't initialize from this element.
- (setf (eieio--class-class-allocation-values newc) (cons value (eieio--class-class-allocation-values newc))))
- (when defaultoverride
- ;; There is a match, and we must override the old value.
- (let* ((ca (eieio--class-class-allocation-a newc))
- (np (member a ca))
- (num (- (length ca) (length np)))
- (dp (if np
- (nthcdr num
- (eieio--class-class-allocation-values newc))
- nil))
- (tp (if np (nth num (eieio--class-class-allocation-type newc))
- nil)))
- (if (not np)
- (error "EIEIO internal error overriding default value for %s"
- a)
- ;; If type is passed in, is it the same?
- (if (not (eq type t))
- (if (not (equal type tp))
- (error
- "Child slot type `%s' does not match inherited type `%s' for `%s'"
- type tp a)))
- ;; EML - Note: the only reason to override a class bound slot
- ;; is to change the default, so allow unbound in.
-
- ;; If we have a repeat, only update the value...
- (eieio-perform-slot-validation-for-default a tp value skipnil)
- (setcar dp value))
-
- ;; PLN Tue Jun 26 11:57:06 2007 : The protection is
- ;; checked and SHOULD match the superclass
- ;; protection. Otherwise an error is thrown. However
- ;; I wonder if a more flexible schedule might be
- ;; implemented.
- (let ((super-prot
- (car (nthcdr num (eieio--class-class-allocation-protection newc)))))
- (if (not (eq prot super-prot))
- (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'"
- prot super-prot a)))
- ;; Do a non redundant combination of ancient custom groups
- ;; and new ones.
- (when custg
- (let* ((groups
- (nthcdr num (eieio--class-class-allocation-custom-group newc)))
- (list1 (car groups))
- (list2 (if (listp custg) custg (list custg))))
- (if (< (length list1) (length list2))
- (setq list1 (prog1 list2 (setq list2 list1))))
- (dolist (elt list2)
- (unless (memq elt list1)
- (push elt list1)))
- (setcar groups list1)))
-
- ;; PLN Sat Jun 30 17:24:42 2007 : when a new
- ;; doc is specified, simply replaces the old one.
- (when doc
- ;;(message "Documentation redefined to %s" doc)
- (setcar (nthcdr num (eieio--class-class-allocation-doc newc))
- doc))
- ;; End PLN
-
- ;; If a new printer is specified, it simply replaces
- ;; the old one.
- (when print
- ;; (message "printer redefined to %s" print)
- (setcar (nthcdr num (eieio--class-class-allocation-printer newc)) print))
-
- ))
- ))
- ))
-
-(defun eieio-copy-parents-into-subclass (newc parents)
+ (let* ((a (cl--slot-descriptor-name slot))
+ (d (cl--slot-descriptor-initform slot))
+ (old (car (cl-member a (eieio--class-slots newc)
+ :key #'cl--slot-descriptor-name)))
+ (cold (car (cl-member a (eieio--class-class-slots newc)
+ :key #'cl--slot-descriptor-name))))
+ (cl-pushnew a eieio--known-slot-names)
+ (condition-case nil
+ (if (sequencep d) (setq d (copy-sequence d)))
+ ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's
+ ;; skip it if it doesn't work.
+ (error nil))
+ ;; (if (sequencep type) (setq type (copy-sequence type)))
+ ;; (if (sequencep cust) (setq cust (copy-sequence cust)))
+ ;; (if (sequencep custg) (setq custg (copy-sequence custg)))
+
+ ;; To prevent override information w/out specification of storage,
+ ;; we need to do this little hack.
+ (if cold (setq alloc :class))
+
+ (if (memq alloc '(nil :instance))
+ ;; In this case, we modify the INSTANCE version of a given slot.
+ (progn
+ ;; Only add this element if it is so-far unique
+ (if (not old)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ (push slot (eieio--class-slots newc))
+ )
+ ;; When defaultoverride is true, we are usually adding new local
+ ;; attributes which must override the default value of any slot
+ ;; passed in by one of the parent classes.
+ (when defaultoverride
+ (eieio--slot-override old slot skipnil)))
+ (when init
+ (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc)
+ :test #'equal)))
+
+ ;; CLASS ALLOCATED SLOTS
+ (if (not cold)
+ (progn
+ (eieio--perform-slot-validation-for-default slot skipnil)
+ ;; Here we have found a :class version of a slot. This
+ ;; requires a very different approach.
+ (push slot (eieio--class-class-slots newc)))
+ (when defaultoverride
+ ;; There is a match, and we must override the old value.
+ (eieio--slot-override cold slot skipnil))))))
+
+(defun eieio-copy-parents-into-subclass (newc)
"Copy into NEWC the slots of PARENTS.
Follow the rules of not overwriting early parents when applying to
the new child class."
- (let ((ps (eieio--class-parent newc))
- (sn (class-option-assoc (eieio--class-options newc)
- ':allow-nil-initform)))
- (while ps
+ (let ((sn (eieio--class-option-assoc (eieio--class-options newc)
+ :allow-nil-initform)))
+ (dolist (pcv (eieio--class-parents newc))
;; First, duplicate all the slots of the parent.
- (let ((pcv (class-v (car ps))))
- (let ((pa (eieio--class-public-a pcv))
- (pd (eieio--class-public-d pcv))
- (pdoc (eieio--class-public-doc pcv))
- (ptype (eieio--class-public-type pcv))
- (pcust (eieio--class-public-custom pcv))
- (plabel (eieio--class-public-custom-label pcv))
- (pcustg (eieio--class-public-custom-group pcv))
- (printer (eieio--class-public-printer pcv))
- (pprot (eieio--class-protection pcv))
- (pinit (eieio--class-initarg-tuples pcv))
- (i 0))
- (while pa
- (eieio-add-new-slot newc
- (car pa) (car pd) (car pdoc) (aref ptype i)
- (car pcust) (car plabel) (car pcustg)
- (car printer)
- (car pprot) (car-safe (car pinit)) nil nil sn)
- ;; Increment each value.
- (setq pa (cdr pa)
- pd (cdr pd)
- pdoc (cdr pdoc)
- i (1+ i)
- pcust (cdr pcust)
- plabel (cdr plabel)
- pcustg (cdr pcustg)
- printer (cdr printer)
- pprot (cdr pprot)
- pinit (cdr pinit))
- )) ;; while/let
- ;; Now duplicate all the class alloc slots.
- (let ((pa (eieio--class-class-allocation-a pcv))
- (pdoc (eieio--class-class-allocation-doc pcv))
- (ptype (eieio--class-class-allocation-type pcv))
- (pcust (eieio--class-class-allocation-custom pcv))
- (plabel (eieio--class-class-allocation-custom-label pcv))
- (pcustg (eieio--class-class-allocation-custom-group pcv))
- (printer (eieio--class-class-allocation-printer pcv))
- (pprot (eieio--class-class-allocation-protection pcv))
- (pval (eieio--class-class-allocation-values pcv))
- (i 0))
- (while pa
- (eieio-add-new-slot newc
- (car pa) (aref pval i) (car pdoc) (aref ptype i)
- (car pcust) (car plabel) (car pcustg)
- (car printer)
- (car pprot) nil ':class sn)
- ;; Increment each value.
- (setq pa (cdr pa)
- pdoc (cdr pdoc)
- pcust (cdr pcust)
- plabel (cdr plabel)
- pcustg (cdr pcustg)
- printer (cdr printer)
- pprot (cdr pprot)
- i (1+ i))
- ))) ;; while/let
- ;; Loop over each parent class
- (setq ps (cdr ps)))
- ))
+ (let ((pslots (eieio--class-slots pcv))
+ (pinit (eieio--class-initarg-tuples pcv)))
+ (dotimes (i (length pslots))
+ (let* ((sd (cl--copy-slot-descriptor (aref pslots i)))
+ (init (car (rassq (cl--slot-descriptor-name sd) pinit))))
+ (eieio--add-new-slot newc sd init nil nil sn))
+ )) ;; while/let
+ ;; Now duplicate all the class alloc slots.
+ (let ((pcslots (eieio--class-class-slots pcv)))
+ (dotimes (i (length pcslots))
+ (eieio--add-new-slot newc (cl--copy-slot-descriptor
+ (aref pcslots i))
+ nil :class sn)
+ )))))
-;;; CLOS methods and generics
-;;
-
-(defun eieio--defgeneric-init-form (method doc-string)
- "Form to use for the initial definition of a generic."
- (cond
- ((or (not (fboundp method))
- (eq 'autoload (car-safe (symbol-function method))))
- ;; Make sure the method tables are installed.
- (eieiomt-install method)
- ;; Construct the actual body of this function.
- (eieio-defgeneric-form method doc-string))
- ((generic-p method) (symbol-function method)) ;Leave it as-is.
- (t (error "You cannot create a generic/method over an existing symbol: %s"
- method))))
-
-(defun eieio-defgeneric-form (method doc-string)
- "The lambda form that would be used as the function defined on METHOD.
-All methods should call the same EIEIO function for dispatch.
-DOC-STRING is the documentation attached to METHOD."
- `(lambda (&rest local-args)
- ,doc-string
- (eieio-generic-call (quote ,method) local-args)))
-
-(defsubst eieio-defgeneric-reset-generic-form (method)
- "Setup METHOD to call the generic form."
- (let ((doc-string (documentation method)))
- (fset method (eieio-defgeneric-form method doc-string))))
-
-(defun eieio-defgeneric-form-primary-only (method doc-string)
- "The lambda form that would be used as the function defined on METHOD.
-All methods should call the same EIEIO function for dispatch.
-DOC-STRING is the documentation attached to METHOD."
- `(lambda (&rest local-args)
- ,doc-string
- (eieio-generic-call-primary-only (quote ,method) local-args)))
-
-(defsubst eieio-defgeneric-reset-generic-form-primary-only (method)
- "Setup METHOD to call the generic form."
- (let ((doc-string (documentation method)))
- (fset method (eieio-defgeneric-form-primary-only method doc-string))))
-
-(defun eieio-defgeneric-form-primary-only-one (method doc-string
- class
- impl
- )
- "The lambda form that would be used as the function defined on METHOD.
-All methods should call the same EIEIO function for dispatch.
-DOC-STRING is the documentation attached to METHOD.
-CLASS is the class symbol needed for private method access.
-IMPL is the symbol holding the method implementation."
- ;; NOTE: I tried out byte compiling this little fcn. Turns out it
- ;; is faster to execute this for not byte-compiled. ie, install this,
- ;; then measure calls going through here. I wonder why.
- (require 'bytecomp)
- (let ((byte-compile-warnings nil))
- (byte-compile
- `(lambda (&rest local-args)
- ,doc-string
- ;; This is a cool cheat. Usually we need to look up in the
- ;; method table to find out if there is a method or not. We can
- ;; instead make that determination at load time when there is
- ;; only one method. If the first arg is not a child of the class
- ;; of that one implementation, then clearly, there is no method def.
- (if (not (eieio-object-p (car local-args)))
- ;; Not an object. Just signal.
- (signal 'no-method-definition
- (list ',method local-args))
-
- ;; We do have an object. Make sure it is the right type.
- (if ,(if (eq class eieio-default-superclass)
- nil ; default superclass means just an obj. Already asked.
- `(not (child-of-class-p (eieio--object-class (car local-args))
- ',class)))
-
- ;; If not the right kind of object, call no applicable
- (apply 'no-applicable-method (car local-args)
- ',method local-args)
-
- ;; It is ok, do the call.
- ;; Fill in inter-call variables then evaluate the method.
- (let ((eieio-generic-call-next-method-list nil)
- (eieio-generic-call-key method-primary)
- (eieio-generic-call-methodname ',method)
- (eieio-generic-call-arglst local-args)
- )
- (eieio--with-scoped-class ',class
- ,(if (< emacs-major-version 24)
- `(apply ,(list 'quote impl) local-args)
- `(apply #',impl local-args)))
- ;(,impl local-args)
- )))))))
-
-(defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
- "Setup METHOD to call the generic form."
- (let* ((doc-string (documentation method))
- (M (get method 'eieio-method-tree))
- (entry (car (aref M method-primary)))
- )
- (fset method (eieio-defgeneric-form-primary-only-one
- method doc-string
- (car entry)
- (cdr entry)
- ))))
-
-(defun eieio-unbind-method-implementations (method)
- "Make the generic method METHOD have no implementations.
-It will leave the original generic function in place,
-but remove reference to all implementations of METHOD."
- (put method 'eieio-method-tree nil)
- (put method 'eieio-method-obarray nil))
-
-(defun eieio--defmethod (method kind argclass code)
- "Work part of the `defmethod' macro defining METHOD with ARGS."
- (let ((key
- ;; Find optional keys.
- (cond ((memq kind '(:BEFORE :before)) method-before)
- ((memq kind '(:AFTER :after)) method-after)
- ((memq kind '(:STATIC :static)) method-static)
- ((memq kind '(:PRIMARY :primary nil)) method-primary)
- ;; Primary key.
- ;; (t method-primary)
- (t (error "Unknown method kind %S" kind)))))
- ;; Make sure there is a generic (when called from defclass).
- (eieio--defalias
- method (eieio--defgeneric-init-form
- method (or (documentation code)
- (format "Generically created method `%s'." method))))
- ;; Create symbol for property to bind to. If the first arg is of
- ;; the form (varname vartype) and `vartype' is a class, then
- ;; that class will be the type symbol. If not, then it will fall
- ;; under the type `primary' which is a non-specific calling of the
- ;; function.
- (if argclass
- (if (not (class-p argclass))
- (error "Unknown class type %s in method parameters"
- argclass))
- ;; Generics are higher.
- (setq key (eieio-specialized-key-to-generic-key key)))
- ;; Put this lambda into the symbol so we can find it.
- (eieiomt-add method code key argclass)
- )
-
- (when eieio-optimize-primary-methods-flag
- ;; Optimizing step:
- ;;
- ;; If this method, after this setup, only has primary methods, then
- ;; we can setup the generic that way.
- (if (generic-primary-only-p method)
- ;; If there is only one primary method, then we can go one more
- ;; optimization step.
- (if (generic-primary-only-one-p method)
- (eieio-defgeneric-reset-generic-form-primary-only-one method)
- (eieio-defgeneric-reset-generic-form-primary-only method))
- (eieio-defgeneric-reset-generic-form method)))
-
- method)
-
;;; Slot type validation
;; This is a hideous hack for replacing `typep' from cl-macs, to avoid
;; requiring the CL library at run-time. It can be eliminated if/when
;; `typep' is merged into Emacs core.
-(defun eieio--typep (val type)
- (if (symbolp type)
- (cond ((get type 'cl-deftype-handler)
- (eieio--typep val (funcall (get type 'cl-deftype-handler))))
- ((eq type t) t)
- ((eq type 'null) (null val))
- ((eq type 'atom) (atom val))
- ((eq type 'float) (and (numberp val) (not (integerp val))))
- ((eq type 'real) (numberp val))
- ((eq type 'fixnum) (integerp val))
- ((memq type '(character string-char)) (characterp val))
- (t
- (let* ((name (symbol-name type))
- (namep (intern (concat name "p"))))
- (if (fboundp namep)
- (funcall `(lambda () (,namep val)))
- (funcall `(lambda ()
- (,(intern (concat name "-p")) val)))))))
- (cond ((get (car type) 'cl-deftype-handler)
- (eieio--typep val (apply (get (car type) 'cl-deftype-handler)
- (cdr type))))
- ((memq (car type) '(integer float real number))
- (and (eieio--typep val (car type))
- (or (memq (cadr type) '(* nil))
- (if (consp (cadr type))
- (> val (car (cadr type)))
- (>= val (cadr type))))
- (or (memq (caddr type) '(* nil))
- (if (consp (car (cddr type)))
- (< val (caar (cddr type)))
- (<= val (car (cddr type)))))))
- ((memq (car type) '(and or not))
- (eval (cons (car type)
- (mapcar (lambda (x)
- `(eieio--typep (quote ,val) (quote ,x)))
- (cdr type)))))
- ((memq (car type) '(member member*))
- (memql val (cdr type)))
- ((eq (car type) 'satisfies)
- (funcall `(lambda () (,(cadr type) val))))
- (t (error "Bad type spec: %s" type)))))
-
-(defun eieio-perform-slot-validation (spec value)
+
+(defun eieio--perform-slot-validation (spec value)
"Return non-nil if SPEC does not match VALUE."
(or (eq spec t) ; t always passes
(eq value eieio-unbound) ; unbound always passes
- (eieio--typep value spec)))
+ (cl-typep value spec)))
-(defun eieio-validate-slot-value (class slot-idx value slot)
+(defun eieio--validate-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
Checks the :type specifier.
SLOT is the slot that is being checked, and is only used when throwing
@@ -1355,22 +695,25 @@ an error."
(if eieio-skip-typecheck
nil
;; Trim off object IDX junk added in for the object index.
- (setq slot-idx (- slot-idx 3))
- (let ((st (aref (eieio--class-public-type (class-v class)) slot-idx)))
- (if (not (eieio-perform-slot-validation st value))
- (signal 'invalid-slot-type (list class slot st value))))))
-
-(defun eieio-validate-class-slot-value (class slot-idx value slot)
+ (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
+ (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class)
+ slot-idx))))
+ (if (not (eieio--perform-slot-validation st value))
+ (signal 'invalid-slot-type
+ (list (eieio--class-name class) slot st value))))))
+
+(defun eieio--validate-class-slot-value (class slot-idx value slot)
"Make sure that for CLASS referencing SLOT-IDX, VALUE is valid.
Checks the :type specifier.
SLOT is the slot that is being checked, and is only used when throwing
an error."
(if eieio-skip-typecheck
nil
- (let ((st (aref (eieio--class-class-allocation-type (class-v class))
- slot-idx)))
- (if (not (eieio-perform-slot-validation st value))
- (signal 'invalid-slot-type (list class slot st value))))))
+ (let ((st (cl--slot-descriptor-type (aref (eieio--class-class-slots class)
+ slot-idx))))
+ (if (not (eieio--perform-slot-validation st value))
+ (signal 'invalid-slot-type
+ (list (eieio--class-name class) slot st value))))))
(defun eieio-barf-if-slot-unbound (value instance slotname fn)
"Throw a signal if VALUE is a representation of an UNBOUND slot.
@@ -1383,55 +726,74 @@ Argument FN is the function calling this verifier."
;;; Get/Set slots in an object.
-;;
+
(defun eieio-oref (obj slot)
"Return the value in OBJ at SLOT in the object vector."
- (eieio--check-type (or eieio-object-p class-p) obj)
- (eieio--check-type symbolp slot)
- (if (class-p obj) (eieio-class-un-autoload obj))
- (let* ((class (if (class-p obj) obj (eieio--object-class obj)))
- (c (eieio-slot-name-index class obj slot)))
+ (declare (compiler-macro
+ (lambda (exp)
+ (ignore obj)
+ (pcase slot
+ ((and (or `',name (and name (pred keywordp)))
+ (guard (not (memq name eieio--known-slot-names))))
+ (macroexp--warn-and-return
+ (format-message "Unknown slot `%S'" name) exp 'compile-only))
+ (_ exp)))))
+ (cl-check-type slot symbol)
+ (cl-check-type obj (or eieio-object class))
+ (let* ((class (cond ((symbolp obj)
+ (error "eieio-oref called on a class: %s" obj)
+ (let ((c (cl--find-class obj)))
+ (if (eieio--class-p c) (eieio-class-un-autoload obj))
+ c))
+ (t (eieio--object-class obj))))
+ (c (eieio--slot-name-index class slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
- (if (setq c (eieio-class-slot-name-index class slot))
+ (if (setq c (eieio--class-slot-name-index class slot))
;; Oref that slot.
- (aref (eieio--class-class-allocation-values (class-v class)) c)
+ (aref (eieio--class-class-allocation-values class) c)
;; The slot-missing method is a cool way of allowing an object author
;; to intercept missing slot definitions. Since it is also the LAST
;; thing called in this fn, its return value would be retrieved.
(slot-missing obj slot 'oref)
;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
)
- (eieio--check-type eieio-object-p obj)
+ (cl-check-type obj eieio-object)
(eieio-barf-if-slot-unbound (aref obj c) obj slot 'oref))))
(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."
- (eieio--check-type (or eieio-object-p class-p) obj)
- (eieio--check-type symbolp slot)
- (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj))
- (c (eieio-slot-name-index cl obj slot)))
+ (cl-check-type obj (or eieio-object class))
+ (cl-check-type slot symbol)
+ (let* ((cl (cond ((symbolp obj) (cl--find-class obj))
+ ((eieio-object-p obj) (eieio--object-class obj))
+ (t obj)))
+ (c (eieio--slot-name-index cl slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(if (setq c
- (eieio-class-slot-name-index cl slot))
+ (eieio--class-slot-name-index cl slot))
;; Oref that slot.
- (aref (eieio--class-class-allocation-values (class-v cl))
+ (aref (eieio--class-class-allocation-values cl)
c)
(slot-missing obj slot 'oref-default)
;;(signal 'invalid-slot-name (list (class-name cl) slot))
)
(eieio-barf-if-slot-unbound
- (let ((val (nth (- c 3) (eieio--class-public-d (class-v cl)))))
+ (let ((val (cl--slot-descriptor-initform
+ (aref (eieio--class-slots cl)
+ (- c (eval-when-compile eieio--object-num-slots))))))
(eieio-default-eval-maybe val))
- obj cl 'oref-default))))
+ obj (eieio--class-name cl) 'oref-default))))
(defun eieio-default-eval-maybe (val)
"Check VAL, and return what `oref-default' would provide."
+ ;; FIXME: What the hell is this supposed to do? Shouldn't it evaluate
+ ;; variables as well? Why not just always call `eval'?
(cond
;; Is it a function call? If so, evaluate it.
((eieio-eval-default-p val)
@@ -1445,115 +807,100 @@ Fills in OBJ's SLOT with its default value."
(defun eieio-oset (obj slot value)
"Do the work for the macro `oset'.
Fills in OBJ's SLOT with VALUE."
- (eieio--check-type eieio-object-p obj)
- (eieio--check-type symbolp slot)
- (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot)))
+ (cl-check-type obj eieio-object)
+ (cl-check-type slot symbol)
+ (let* ((class (eieio--object-class obj))
+ (c (eieio--slot-name-index class slot)))
(if (not c)
;; It might be missing because it is a :class allocated slot.
;; Let's check that info out.
(if (setq c
- (eieio-class-slot-name-index (eieio--object-class obj) slot))
+ (eieio--class-slot-name-index class slot))
;; Oset that slot.
(progn
- (eieio-validate-class-slot-value (eieio--object-class obj) c value slot)
- (aset (eieio--class-class-allocation-values (class-v (eieio--object-class obj)))
+ (eieio--validate-class-slot-value class c value slot)
+ (aset (eieio--class-class-allocation-values class)
c value))
;; See oref for comment on `slot-missing'
(slot-missing obj slot 'oset value)
;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot))
)
- (eieio-validate-slot-value (eieio--object-class obj) c value slot)
+ (eieio--validate-slot-value class c value slot)
(aset obj c value))))
(defun eieio-oset-default (class slot value)
"Do the work for the macro `oset-default'.
Fills in the default value in CLASS' in SLOT with VALUE."
- (eieio--check-type class-p class)
- (eieio--check-type symbolp slot)
- (eieio--with-scoped-class class
- (let* ((c (eieio-slot-name-index class nil slot)))
- (if (not c)
- ;; It might be missing because it is a :class allocated slot.
- ;; Let's check that info out.
- (if (setq c (eieio-class-slot-name-index class slot))
- (progn
- ;; Oref that slot.
- (eieio-validate-class-slot-value class c value slot)
- (aset (eieio--class-class-allocation-values (class-v class)) c
- value))
- (signal 'invalid-slot-name (list (eieio-class-name class) slot)))
- (eieio-validate-slot-value class c value slot)
- ;; Set this into the storage for defaults.
- (setcar (nthcdr (- c 3) (eieio--class-public-d (class-v class)))
- value)
- ;; Take the value, and put it into our cache object.
- (eieio-oset (eieio--class-default-object-cache (class-v class))
- slot value)
- ))))
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (cl-check-type slot symbol)
+ (let* ((c (eieio--slot-name-index class slot)))
+ (if (not c)
+ ;; It might be missing because it is a :class allocated slot.
+ ;; Let's check that info out.
+ (if (setq c (eieio--class-slot-name-index class slot))
+ (progn
+ ;; Oref that slot.
+ (eieio--validate-class-slot-value class c value slot)
+ (aset (eieio--class-class-allocation-values class) c
+ value))
+ (signal 'invalid-slot-name (list (eieio--class-name class) slot)))
+ ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but
+ ;; not by CLOS and is mildly inconsistent with the :initform thingy, so
+ ;; it'd be nice to get of it. This said, it is/was used at one place by
+ ;; gnus/registry.el, so it might be used elsewhere as well, so let's
+ ;; keep it for now.
+ ;; FIXME: Generate a compile-time warning for it!
+ ;; (error "Can't `oset-default' an instance-allocated slot: %S of %S"
+ ;; slot class)
+ (eieio--validate-slot-value class c value slot)
+ ;; Set this into the storage for defaults.
+ (if (eieio-eval-default-p value)
+ (error "Can't set default to a sexp that gets evaluated again"))
+ (setf (cl--slot-descriptor-initform
+ ;; FIXME: Apparently we set it both in `slots' and in
+ ;; `object-cache', which seems redundant.
+ (aref (eieio--class-slots class)
+ (- c (eval-when-compile eieio--object-num-slots))))
+ value)
+ ;; Take the value, and put it into our cache object.
+ (eieio-oset (eieio--class-default-object-cache class)
+ slot value)
+ )))
;;; EIEIO internal search functions
;;
-(defun eieio-slot-originating-class-p (start-class slot)
- "Return non-nil if START-CLASS is the first class to define SLOT.
-This is for testing if the class currently in scope is the class that defines SLOT
-so that we can protect private slots."
- (let ((par (eieio-class-parents-fast start-class))
- (ret t))
- (if (not par)
- t
- (while (and par ret)
- (if (intern-soft (symbol-name slot)
- (eieio--class-symbol-obarray (class-v (car par))))
- (setq ret nil))
- (setq par (cdr par)))
- ret)))
-
-(defun eieio-slot-name-index (class obj slot)
- "In CLASS for OBJ find the index of the named SLOT.
-The slot is a symbol which is installed in CLASS by the `defclass'
-call. OBJ can be nil, but if it is an object, and the slot in question
-is protected, access will be allowed if OBJ is a child of the currently
-scoped class.
+(defun eieio--slot-name-index (class slot)
+ "In CLASS find the index of the named SLOT.
+The slot is a symbol which is installed in CLASS by the `defclass' call.
If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; Removed checks to outside this call
- (let* ((fsym (intern-soft (symbol-name slot)
- (eieio--class-symbol-obarray (class-v class))))
- (fsi (if (symbolp fsym) (symbol-value fsym) nil)))
+ (let* ((fsi (gethash slot (eieio--class-index-table class))))
(if (integerp fsi)
- (cond
- ((not (get fsym 'protection))
- (+ 3 fsi))
- ((and (eq (get fsym 'protection) 'protected)
- (eieio--scoped-class)
- (or (child-of-class-p class (eieio--scoped-class))
- (and (eieio-object-p obj)
- (child-of-class-p class (eieio--object-class obj)))))
- (+ 3 fsi))
- ((and (eq (get fsym 'protection) 'private)
- (or (and (eieio--scoped-class)
- (eieio-slot-originating-class-p (eieio--scoped-class) slot))
- eieio-initializing-object))
- (+ 3 fsi))
- (t nil))
- (let ((fn (eieio-initarg-to-attribute class slot)))
- (if fn (eieio-slot-name-index class obj fn) nil)))))
-
-(defun eieio-class-slot-name-index (class slot)
+ (+ (eval-when-compile eieio--object-num-slots) fsi)
+ (let ((fn (eieio--initarg-to-attribute class slot)))
+ (if fn
+ ;; Accessing a slot via its :initarg is accepted by EIEIO
+ ;; (but not CLOS) but is a bad idea (for one: it's slower).
+ ;; FIXME: We should emit a compile-time warning when this happens!
+ (eieio--slot-name-index class fn)
+ nil)))))
+
+(defun eieio--class-slot-name-index (class slot)
"In CLASS find the index of the named SLOT.
The slot is a symbol which is installed in CLASS by the `defclass'
call. If SLOT is the value created with :initarg instead,
reverse-lookup that name, and recurse with the associated slot value."
;; This will happen less often, and with fewer slots. Do this the
;; storage cheap way.
- (let* ((a (eieio--class-class-allocation-a (class-v class)))
- (l1 (length a))
- (af (memq slot a))
- (l2 (length af)))
- ;; Slot # is length of the total list, minus the remaining list of
- ;; the found slot.
- (if af (- l1 l2))))
+ (let ((index nil)
+ (slots (eieio--class-class-slots class)))
+ (dotimes (i (length slots))
+ (if (eq slot (cl--slot-descriptor-name (aref slots i)))
+ (setq index i)))
+ index))
;;;
;; Way to assign slots based on a list. Used for constructors, or
@@ -1564,36 +911,26 @@ reverse-lookup that name, and recurse with the associated slot value."
If SET-ALL is non-nil, then when a default is nil, that value is
reset. If SET-ALL is nil, the slots are only reset if the default is
not nil."
- (eieio--with-scoped-class (eieio--object-class obj)
- (let ((eieio-initializing-object t)
- (pub (eieio--class-public-a (class-v (eieio--object-class obj)))))
- (while pub
- (let ((df (eieio-oref-default obj (car pub))))
- (if (or df set-all)
- (eieio-oset obj (car pub) df)))
- (setq pub (cdr pub))))))
-
-(defun eieio-initarg-to-attribute (class initarg)
+ (let ((slots (eieio--class-slots (eieio--object-class obj))))
+ (dotimes (i (length slots))
+ (let* ((name (cl--slot-descriptor-name (aref slots i)))
+ (df (eieio-oref-default obj name)))
+ (if (or df set-all)
+ (eieio-oset obj name df))))))
+
+(defun eieio--initarg-to-attribute (class initarg)
"For CLASS, convert INITARG to the actual attribute name.
If there is no translation, pass it in directly (so we can cheat if
need be... May remove that later...)"
- (let ((tuple (assoc initarg (eieio--class-initarg-tuples (class-v class)))))
+ (let ((tuple (assoc initarg (eieio--class-initarg-tuples class))))
(if tuple
(cdr tuple)
nil)))
-(defun eieio-attribute-to-initarg (class attribute)
- "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
-This is usually a symbol that starts with `:'."
- (let ((tuple (rassoc attribute (eieio--class-initarg-tuples (class-v class)))))
- (if tuple
- (car tuple)
- nil)))
-
;;;
;; Method Invocation order: C3
-(defun eieio-c3-candidate (class remaining-inputs)
- "Return CLASS if it can go in the result now, otherwise nil"
+(defun eieio--c3-candidate (class remaining-inputs)
+ "Return CLASS if it can go in the result now, otherwise nil."
;; Ensure CLASS is not in any position but the first in any of the
;; element lists of REMAINING-INPUTS.
(and (not (let ((found nil))
@@ -1603,14 +940,11 @@ This is usually a symbol that starts with `:'."
found))
class))
-(defun eieio-c3-merge-lists (reversed-partial-result remaining-inputs)
+(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs)
"Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible.
If a consistent order does not exist, signal an error."
- (if (let ((tail remaining-inputs)
- (found nil))
- (while (and tail (not found))
- (setq found (car tail) tail (cdr tail)))
- (not found))
+ (setq remaining-inputs (delq nil remaining-inputs))
+ (if (null remaining-inputs)
;; If all remaining inputs are empty lists, we are done.
(nreverse reversed-partial-result)
;; Otherwise, we try to find the next element of the result. This
@@ -1621,42 +955,42 @@ If a consistent order does not exist, signal an error."
(tail remaining-inputs)
(next (progn
(while (and tail (not found))
- (setq found (and (car tail)
- (eieio-c3-candidate (caar tail)
- remaining-inputs))
+ (setq found (eieio--c3-candidate (caar tail)
+ remaining-inputs)
tail (cdr tail)))
found)))
(if next
;; The graph is consistent so far, add NEXT to result and
;; merge input lists, dropping NEXT from their heads where
;; applicable.
- (eieio-c3-merge-lists
+ (eieio--c3-merge-lists
(cons next reversed-partial-result)
- (mapcar (lambda (l) (if (eq (first l) next) (rest l) l))
+ (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l))
remaining-inputs))
;; The graph is inconsistent, give up
(signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
-(defun eieio-class-precedence-c3 (class)
+(defsubst eieio--class/struct-parents (class)
+ (or (eieio--class-parents class)
+ `(,eieio-default-superclass)))
+
+(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
- (let ((parents (eieio-class-parents-fast class)))
- (eieio-c3-merge-lists
+ (let ((parents (eieio--class-parents (cl--find-class class))))
+ (eieio--c3-merge-lists
(list class)
(append
(or
- (mapcar
- (lambda (x)
- (eieio-class-precedence-c3 x))
- parents)
- '((eieio-default-superclass)))
+ (mapcar #'eieio--class-precedence-c3 parents)
+ `((,eieio-default-superclass)))
(list parents))))
)
;;;
;; Method Invocation Order: Depth First
-(defun eieio-class-precedence-dfs (class)
+(defun eieio--class-precedence-dfs (class)
"Return all parents of CLASS in depth-first order."
- (let* ((parents (eieio-class-parents-fast class))
+ (let* ((parents (eieio--class-parents class))
(classes (copy-sequence
(apply #'append
(list class)
@@ -1664,9 +998,9 @@ If a consistent order does not exist, signal an error."
(mapcar
(lambda (parent)
(cons parent
- (eieio-class-precedence-dfs parent)))
+ (eieio--class-precedence-dfs parent)))
parents)
- '((eieio-default-superclass))))))
+ `((,eieio-default-superclass))))))
(tail classes))
;; Remove duplicates.
(while tail
@@ -1676,588 +1010,187 @@ If a consistent order does not exist, signal an error."
;;;
;; Method Invocation Order: Breadth First
-(defun eieio-class-precedence-bfs (class)
+(defun eieio--class-precedence-bfs (class)
"Return all parents of CLASS in breadth-first order."
- (let ((result)
- (queue (or (eieio-class-parents-fast class)
- '(eieio-default-superclass))))
+ (let* ((result)
+ (queue (eieio--class/struct-parents class)))
(while queue
(let ((head (pop queue)))
(unless (member head result)
(push head result)
- (unless (eq head 'eieio-default-superclass)
- (setq queue (append queue (or (eieio-class-parents-fast head)
- '(eieio-default-superclass))))))))
+ (unless (eq head eieio-default-superclass)
+ (setq queue (append queue (eieio--class/struct-parents head)))))))
(cons class (nreverse result)))
)
;;;
;; Method Invocation Order
-(defun eieio-class-precedence-list (class)
+(defun eieio--class-precedence-list (class)
"Return (transitively closed) list of parents of CLASS.
The order, in which the parents are returned depends on the
method invocation orders of the involved classes."
- (if (or (null class) (eq class 'eieio-default-superclass))
+ (if (or (null class) (eq class eieio-default-superclass))
nil
- (case (class-method-invocation-order class)
+ (unless (eieio--class-default-object-cache class)
+ (eieio-class-un-autoload (eieio--class-name class)))
+ (cl-case (eieio--class-method-invocation-order class)
(:depth-first
- (eieio-class-precedence-dfs class))
+ (eieio--class-precedence-dfs class))
(:breadth-first
- (eieio-class-precedence-bfs class))
+ (eieio--class-precedence-bfs class))
(:c3
- (eieio-class-precedence-c3 class))))
+ (eieio--class-precedence-c3 class))))
)
(define-obsolete-function-alias
- 'class-precedence-list 'eieio-class-precedence-list "24.4")
+ 'class-precedence-list 'eieio--class-precedence-list "24.4")
-;;; CLOS generics internal function handling
+;;; Here are some special types of errors
;;
-(defvar eieio-generic-call-methodname nil
- "When using `call-next-method', provides a context on how to do it.")
-(defvar eieio-generic-call-arglst nil
- "When using `call-next-method', provides a context for parameters.")
-(defvar eieio-generic-call-key nil
- "When using `call-next-method', provides a context for the current key.
-Keys are a number representing :before, :primary, and :after methods.")
-(defvar eieio-generic-call-next-method-list nil
- "When executing a PRIMARY or STATIC method, track the 'next-method'.
-During executions, the list is first generated, then as each next method
-is called, the next method is popped off the stack.")
-
-(define-obsolete-variable-alias 'eieio-pre-method-execution-hooks
- 'eieio-pre-method-execution-functions "24.3")
-(defvar eieio-pre-method-execution-functions nil
- "Abnormal hook run just before an EIEIO method is executed.
-The hook function must accept one argument, the list of forms
-about to be executed.")
-
-(defun eieio-generic-call (method args)
- "Call METHOD with ARGS.
-ARGS provides the context on which implementation to use.
-This should only be called from a generic function."
- ;; We must expand our arguments first as they are always
- ;; passed in as quoted symbols
- (let ((newargs nil) (mclass nil) (lambdas nil) (tlambdas nil) (keys nil)
- (eieio-generic-call-methodname method)
- (eieio-generic-call-arglst args)
- (firstarg nil)
- (primarymethodlist nil))
- ;; get a copy
- (setq newargs args
- firstarg (car newargs))
- ;; Is the class passed in autoloaded?
- ;; Since class names are also constructors, they can be autoloaded
- ;; via the autoload command. Check for this, and load them in.
- ;; It is ok if it doesn't turn out to be a class. Probably want that
- ;; function loaded anyway.
- (if (and (symbolp firstarg)
- (fboundp firstarg)
- (listp (symbol-function firstarg))
- (eq 'autoload (car (symbol-function firstarg))))
- (load (nth 1 (symbol-function firstarg))))
- ;; Determine the class to use.
- (cond ((eieio-object-p firstarg)
- (setq mclass (eieio--object-class firstarg)))
- ((class-p firstarg)
- (setq mclass firstarg))
- )
- ;; Make sure the class is a valid class
- ;; mclass can be nil (meaning a generic for should be used.
- ;; mclass cannot have a value that is not a class, however.
- (when (and (not (null mclass)) (not (class-p mclass)))
- (error "Cannot dispatch method %S on class %S"
- method mclass)
- )
- ;; Now create a list in reverse order of all the calls we have
- ;; make in order to successfully do this right. Rules:
- ;; 1) Only call generics if scoped-class is not defined
- ;; This prevents multiple calls in the case of recursion
- ;; 2) Only call static if this is a static method.
- ;; 3) Only call specifics if the definition allows for them.
- ;; 4) Call in order based on :before, :primary, and :after
- (when (eieio-object-p firstarg)
- ;; Non-static calls do all this stuff.
-
- ;; :after methods
- (setq tlambdas
- (if mclass
- (eieiomt-method-list method method-after mclass)
- (list (eieio-generic-form method method-after nil)))
- ;;(or (and mclass (eieio-generic-form method method-after mclass))
- ;; (eieio-generic-form method method-after nil))
- )
- (setq lambdas (append tlambdas lambdas)
- keys (append (make-list (length tlambdas) method-after) keys))
-
- ;; :primary methods
- (setq tlambdas
- (or (and mclass (eieio-generic-form method method-primary mclass))
- (eieio-generic-form method method-primary nil)))
- (when tlambdas
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-primary keys)
- primarymethodlist
- (eieiomt-method-list method method-primary mclass)))
-
- ;; :before methods
- (setq tlambdas
- (if mclass
- (eieiomt-method-list method method-before mclass)
- (list (eieio-generic-form method method-before nil)))
- ;;(or (and mclass (eieio-generic-form method method-before mclass))
- ;; (eieio-generic-form method method-before nil))
- )
- (setq lambdas (append tlambdas lambdas)
- keys (append (make-list (length tlambdas) method-before) keys))
- )
-
- (if mclass
- ;; For the case of a class,
- ;; if there were no methods found, then there could be :static methods.
- (when (not lambdas)
- (setq tlambdas
- (eieio-generic-form method method-static mclass))
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-static keys)
- primarymethodlist ;; Re-use even with bad name here
- (eieiomt-method-list method method-static mclass)))
- ;; For the case of no class (ie - mclass == nil) then there may
- ;; be a primary method.
- (setq tlambdas
- (eieio-generic-form method method-primary nil))
- (when tlambdas
- (setq lambdas (cons tlambdas lambdas)
- keys (cons method-primary keys)
- primarymethodlist
- (eieiomt-method-list method method-primary nil)))
- )
-
- (run-hook-with-args 'eieio-pre-method-execution-functions
- primarymethodlist)
-
- ;; Now loop through all occurrences forms which we must execute
- ;; (which are happily sorted now) and execute them all!
- (let ((rval nil) (lastval nil) (rvalever nil) (found nil))
- (while lambdas
- (if (car lambdas)
- (eieio--with-scoped-class (cdr (car lambdas))
- (let* ((eieio-generic-call-key (car keys))
- (has-return-val
- (or (= eieio-generic-call-key method-primary)
- (= eieio-generic-call-key method-static)))
- (eieio-generic-call-next-method-list
- ;; Use the cdr, as the first element is the fcn
- ;; we are calling right now.
- (when has-return-val (cdr primarymethodlist)))
- )
- (setq found t)
- ;;(setq rval (apply (car (car lambdas)) newargs))
- (setq lastval (apply (car (car lambdas)) newargs))
- (when has-return-val
- (setq rval lastval
- rvalever t))
- )))
- (setq lambdas (cdr lambdas)
- keys (cdr keys)))
- (if (not found)
- (if (eieio-object-p (car args))
- (setq rval (apply 'no-applicable-method (car args) method args)
- rvalever t)
- (signal
- 'no-method-definition
- (list method args))))
- ;; Right Here... it could be that lastval is returned when
- ;; rvalever is nil. Is that right?
- rval)))
-
-(defun eieio-generic-call-primary-only (method args)
- "Call METHOD with ARGS for methods with only :PRIMARY implementations.
-ARGS provides the context on which implementation to use.
-This should only be called from a generic function.
-
-This method is like `eieio-generic-call', but only
-implementations in the :PRIMARY slot are queried. After many
-years of use, it appears that over 90% of methods in use
-have :PRIMARY implementations only. We can therefore optimize
-for this common case to improve performance."
- ;; We must expand our arguments first as they are always
- ;; passed in as quoted symbols
- (let ((newargs nil) (mclass nil) (lambdas nil)
- (eieio-generic-call-methodname method)
- (eieio-generic-call-arglst args)
- (firstarg nil)
- (primarymethodlist nil)
- )
- ;; get a copy
- (setq newargs args
- firstarg (car newargs))
-
- ;; Determine the class to use.
- (cond ((eieio-object-p firstarg)
- (setq mclass (eieio--object-class firstarg)))
- ((not firstarg)
- (error "Method %s called on nil" method))
- ((not (eieio-object-p firstarg))
- (error "Primary-only method %s called on something not an object" method))
- (t
- (error "EIEIO Error: Improperly classified method %s as primary only"
- method)
- ))
- ;; Make sure the class is a valid class
- ;; mclass can be nil (meaning a generic for should be used.
- ;; mclass cannot have a value that is not a class, however.
- (when (null mclass)
- (error "Cannot dispatch method %S on class %S" method mclass)
- )
-
- ;; :primary methods
- (setq lambdas (eieio-generic-form method method-primary mclass))
- (setq primarymethodlist ;; Re-use even with bad name here
- (eieiomt-method-list method method-primary mclass))
-
- ;; Now loop through all occurrences forms which we must execute
- ;; (which are happily sorted now) and execute them all!
- (eieio--with-scoped-class (cdr lambdas)
- (let* ((rval nil) (lastval nil) (rvalever nil)
- (eieio-generic-call-key method-primary)
- ;; Use the cdr, as the first element is the fcn
- ;; we are calling right now.
- (eieio-generic-call-next-method-list (cdr primarymethodlist))
- )
+(define-error 'invalid-slot-name "Invalid slot name")
+(define-error 'invalid-slot-type "Invalid slot type")
+(define-error 'unbound-slot "Unbound slot")
+(define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy")
+
+;;; Hooking into cl-generic.
+
+(require 'cl-generic)
+
+;;;; General support to dispatch based on the type of the argument.
+
+(cl-generic-define-generalizer eieio--generic-generalizer
+ ;; Use the exact same tagcode as for cl-struct, so that methods
+ ;; that dispatch on both kinds of objects get to share this
+ ;; part of the dispatch code.
+ 50 #'cl--generic-struct-tag
+ (lambda (tag &rest _)
+ (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
+ (mapcar #'eieio--class-name
+ (eieio--class-precedence-list (symbol-value tag))))))
+
+(cl-defmethod cl-generic-generalizers :extra "class" (specializer)
+ ;; CLHS says:
+ ;; A class must be defined before it can be used as a parameter
+ ;; specializer in a defmethod form.
+ ;; So we can ignore types that are not known to denote classes.
+ (or
+ (and (eieio--class-p (eieio--class-object specializer))
+ (list eieio--generic-generalizer))
+ (cl-call-next-method)))
+
+;;;; Dispatch for arguments which are classes.
+
+;; Since EIEIO does not support metaclasses, users can't easily use the
+;; "dispatch on argument type" for class arguments. That's why EIEIO's
+;; `defmethod' added the :static qualifier. For cl-generic, such a qualifier
+;; would not make much sense (e.g. to which argument should it apply?).
+;; Instead, we add a new "subclass" specializer.
+
+(defun eieio--generic-subclass-specializers (tag &rest _)
+ (when (eieio--class-p tag)
+ (mapcar (lambda (class)
+ `(subclass ,(eieio--class-name class)))
+ (eieio--class-precedence-list tag))))
+
+(cl-generic-define-generalizer eieio--generic-subclass-generalizer
+ 60 (lambda (name &rest _) `(and (symbolp ,name) (cl--find-class ,name)))
+ #'eieio--generic-subclass-specializers)
+
+(cl-defmethod cl-generic-generalizers ((_specializer (head subclass)))
+ (list eieio--generic-subclass-generalizer))
- (if (or (not lambdas) (not (car lambdas)))
+
+;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "bd51800d7de6429a2c9a6a600ba2dc52")
+;;; Generated autoloads from eieio-compat.el
- ;; No methods found for this impl...
- (if (eieio-object-p (car args))
- (setq rval (apply 'no-applicable-method (car args) method args)
- rvalever t)
- (signal
- 'no-method-definition
- (list method args)))
+(autoload 'eieio--defalias "eieio-compat" "\
+Like `defalias', but with less side-effects.
+More specifically, it has no side-effects at all when the new function
+definition is the same (`eq') as the old one.
- ;; Do the regular implementation here.
+\(fn NAME BODY)" nil nil)
- (run-hook-with-args 'eieio-pre-method-execution-functions
- lambdas)
+(autoload 'defgeneric "eieio-compat" "\
+Create a generic function METHOD.
+DOC-STRING is the base documentation for this class. A generic
+function has no body, as its purpose is to decide which method body
+is appropriate to use. Uses `defmethod' to create methods, and calls
+`defgeneric' for you. With this implementation the ARGS are
+currently ignored. You can use `defgeneric' to apply specialized
+top level documentation to a method.
- (setq lastval (apply (car lambdas) newargs))
- (setq rval lastval
- rvalever t)
- )
+\(fn METHOD ARGS &optional DOC-STRING)" nil t)
- ;; Right Here... it could be that lastval is returned when
- ;; rvalever is nil. Is that right?
- rval))))
-
-(defun eieiomt-method-list (method key class)
- "Return an alist list of methods lambdas.
-METHOD is the method name.
-KEY represents either :before, or :after methods.
-CLASS is the starting class to search from in the method tree.
-If CLASS is nil, then an empty list of methods should be returned."
- ;; Note: eieiomt - the MT means MethodTree. See more comments below
- ;; for the rest of the eieiomt methods.
-
- ;; Collect lambda expressions stored for the class and its parent
- ;; classes.
- (let (lambdas)
- (dolist (ancestor (eieio-class-precedence-list class))
- ;; Lookup the form to use for the PRIMARY object for the next level
- (let ((tmpl (eieio-generic-form method key ancestor)))
- (when (and tmpl
- (or (not lambdas)
- ;; This prevents duplicates coming out of the
- ;; class method optimizer. Perhaps we should
- ;; just not optimize before/afters?
- (not (member tmpl lambdas))))
- (push tmpl lambdas))))
-
- ;; Return collected lambda. For :after methods, return in current
- ;; order (most general class last); Otherwise, reverse order.
- (if (eq key method-after)
- lambdas
- (nreverse lambdas))))
+(function-put 'defgeneric 'doc-string-elt '3)
+
+(make-obsolete 'defgeneric 'cl-defgeneric '"25.1")
+
+(autoload 'defmethod "eieio-compat" "\
+Create a new METHOD through `defgeneric' with ARGS.
+
+The optional second argument KEY is a specifier that
+modifies how the method is called, including:
+ :before - Method will be called before the :primary
+ :primary - The default if not specified
+ :after - Method will be called after the :primary
+ :static - First arg could be an object or class
+The next argument is the ARGLIST. The ARGLIST specifies the arguments
+to the method as with `defun'. The first argument can have a type
+specifier, such as:
+ ((VARNAME CLASS) ARG2 ...)
+where VARNAME is the name of the local variable for the method being
+created. The CLASS is a class symbol for a class made with `defclass'.
+A DOCSTRING comes after the ARGLIST, and is optional.
+All the rest of the args are the BODY of the method. A method will
+return the value of the last form in the BODY.
+
+Summary:
+
+ (defmethod mymethod [:before | :primary | :after | :static]
+ ((typearg class-name) arg2 &optional opt &rest rest)
+ \"doc-string\"
+ body)
+
+\(fn METHOD &rest ARGS)" nil t)
+
+(function-put 'defmethod 'doc-string-elt '3)
+
+(make-obsolete 'defmethod 'cl-defmethod '"25.1")
+
+(autoload 'eieio--defgeneric-init-form "eieio-compat" "\
+
+
+\(fn METHOD DOC-STRING)" nil nil)
+
+(autoload 'eieio--defmethod "eieio-compat" "\
-
-;;;
-;; eieio-method-tree : eieiomt-
-;;
-;; Stored as eieio-method-tree in property list of a generic method
-;;
-;; (eieio-method-tree . [BEFORE PRIMARY AFTER
-;; genericBEFORE genericPRIMARY genericAFTER])
-;; and
-;; (eieio-method-obarray . [BEFORE PRIMARY AFTER
-;; genericBEFORE genericPRIMARY genericAFTER])
-;; where the association is a vector.
-;; (aref 0 -- all static methods.
-;; (aref 1 -- all methods classified as :before
-;; (aref 2 -- all methods classified as :primary
-;; (aref 3 -- all methods classified as :after
-;; (aref 4 -- a generic classified as :before
-;; (aref 5 -- a generic classified as :primary
-;; (aref 6 -- a generic classified as :after
-;;
-(defvar eieiomt-optimizing-obarray nil
- "While mapping atoms, this contain the obarray being optimized.")
-
-(defun eieiomt-install (method-name)
- "Install the method tree, and obarray onto METHOD-NAME.
-Do not do the work if they already exist."
- (let ((emtv (get method-name 'eieio-method-tree))
- (emto (get method-name 'eieio-method-obarray)))
- (if (or (not emtv) (not emto))
- (progn
- (setq emtv (put method-name 'eieio-method-tree
- (make-vector method-num-slots nil))
- emto (put method-name 'eieio-method-obarray
- (make-vector method-num-slots nil)))
- (aset emto 0 (make-vector 11 0))
- (aset emto 1 (make-vector 11 0))
- (aset emto 2 (make-vector 41 0))
- (aset emto 3 (make-vector 11 0))
- ))))
-
-(defun eieiomt-add (method-name method key class)
- "Add to METHOD-NAME the forms METHOD in a call position KEY for CLASS.
-METHOD-NAME is the name created by a call to `defgeneric'.
-METHOD are the forms for a given implementation.
-KEY is an integer (see comment in eieio.el near this function) which
-is associated with the :static :before :primary and :after tags.
-It also indicates if CLASS is defined or not.
-CLASS is the class this method is associated with."
- (if (or (> key method-num-slots) (< key 0))
- (error "eieiomt-add: method key error!"))
- (let ((emtv (get method-name 'eieio-method-tree))
- (emto (get method-name 'eieio-method-obarray)))
- ;; Make sure the method tables are available.
- (if (or (not emtv) (not emto))
- (error "Programmer error: eieiomt-add"))
- ;; only add new cells on if it doesn't already exist!
- (if (assq class (aref emtv key))
- (setcdr (assq class (aref emtv key)) method)
- (aset emtv key (cons (cons class method) (aref emtv key))))
- ;; Add function definition into newly created symbol, and store
- ;; said symbol in the correct obarray, otherwise use the
- ;; other array to keep this stuff
- (if (< key method-num-lists)
- (let ((nsym (intern (symbol-name class) (aref emto key))))
- (fset nsym method)))
- ;; Save the defmethod file location in a symbol property.
- (let ((fname (if load-in-progress
- load-file-name
- buffer-file-name))
- loc)
- (when fname
- (when (string-match "\\.elc$" fname)
- (setq fname (substring fname 0 (1- (length fname)))))
- (setq loc (get method-name 'method-locations))
- (pushnew (list class fname) loc :test 'equal)
- (put method-name 'method-locations loc)))
- ;; Now optimize the entire obarray
- (if (< key method-num-lists)
- (let ((eieiomt-optimizing-obarray (aref emto key)))
- ;; @todo - Is this overkill? Should we just clear the symbol?
- (mapatoms 'eieiomt-sym-optimize eieiomt-optimizing-obarray)))
- ))
-(defun eieiomt-next (class)
- "Return the next parent class for CLASS.
-If CLASS is a superclass, return variable `eieio-default-superclass'.
-If CLASS is variable `eieio-default-superclass' then return nil.
-This is different from function `class-parent' as class parent returns
-nil for superclasses. This function performs no type checking!"
- ;; No type-checking because all calls are made from functions which
- ;; are safe and do checking for us.
- (or (eieio-class-parents-fast class)
- (if (eq class 'eieio-default-superclass)
- nil
- '(eieio-default-superclass))))
-
-(defun eieiomt-sym-optimize (s)
- "Find the next class above S which has a function body for the optimizer."
- ;; Set the value to nil in case there is no nearest cell.
- (set s nil)
- ;; Find the nearest cell that has a function body. If we find one,
- ;; we replace the nil from above.
- (let ((external-symbol (intern-soft (symbol-name s))))
- (catch 'done
- (dolist (ancestor (rest (eieio-class-precedence-list external-symbol)))
- (let ((ov (intern-soft (symbol-name ancestor)
- eieiomt-optimizing-obarray)))
- (when (fboundp ov)
- (set s ov) ;; store ov as our next symbol
- (throw 'done ancestor)))))))
-
-(defun eieio-generic-form (method key class)
- "Return the lambda form belonging to METHOD using KEY based upon CLASS.
-If CLASS is not a class then use `generic' instead. If class has
-no form, but has a parent class, then trace to that parent class.
-The first time a form is requested from a symbol, an optimized path
-is memorized for faster future use."
- (let ((emto (aref (get method 'eieio-method-obarray)
- (if class key (eieio-specialized-key-to-generic-key key)))))
- (if (class-p class)
- ;; 1) find our symbol
- (let ((cs (intern-soft (symbol-name class) emto)))
- (if (not cs)
- ;; 2) If there isn't one, then make one.
- ;; This can be slow since it only occurs once
- (progn
- (setq cs (intern (symbol-name class) emto))
- ;; 2.1) Cache its nearest neighbor with a quick optimize
- ;; which should only occur once for this call ever
- (let ((eieiomt-optimizing-obarray emto))
- (eieiomt-sym-optimize cs))))
- ;; 3) If it's bound return this one.
- (if (fboundp cs)
- (cons cs (eieio--class-symbol (class-v class)))
- ;; 4) If it's not bound then this variable knows something
- (if (symbol-value cs)
- (progn
- ;; 4.1) This symbol holds the next class in its value
- (setq class (symbol-value cs)
- cs (intern-soft (symbol-name class) emto))
- ;; 4.2) The optimizer should always have chosen a
- ;; function-symbol
- ;;(if (fboundp cs)
- (cons cs (eieio--class-symbol (class-v (intern (symbol-name class)))))
- ;;(error "EIEIO optimizer: erratic data loss!"))
- )
- ;; There never will be a funcall...
- nil)))
- ;; for a generic call, what is a list, is the function body we want.
- (let ((emtl (aref (get method 'eieio-method-tree)
- (if class key (eieio-specialized-key-to-generic-key key)))))
- (if emtl
- ;; The car of EMTL is supposed to be a class, which in this
- ;; case is nil, so skip it.
- (cons (cdr (car emtl)) nil)
- nil)))))
+\(fn METHOD KIND ARGCLASS CODE)" nil nil)
+(autoload 'eieio-defmethod "eieio-compat" "\
+Obsolete work part of an old version of the `defmethod' macro.
+
+\(fn METHOD ARGS)" nil nil)
+
+(make-obsolete 'eieio-defmethod 'cl-defmethod '"24.1")
+
+(autoload 'eieio-defgeneric "eieio-compat" "\
+Obsolete work part of an old version of the `defgeneric' macro.
+
+\(fn METHOD DOC-STRING)" nil nil)
+
+(make-obsolete 'eieio-defgeneric 'cl-defgeneric '"24.1")
+
+(autoload 'eieio-defclass "eieio-compat" "\
+
+
+\(fn CNAME SUPERCLASSES SLOTS OPTIONS)" nil nil)
+
+(make-obsolete 'eieio-defclass 'eieio-defclass-internal '"25.1")
+
+;;;***
-;;; Here are some special types of errors
-;;
-(intern "no-method-definition")
-(put 'no-method-definition 'error-conditions '(no-method-definition error))
-(put 'no-method-definition 'error-message "No method definition")
-
-(intern "no-next-method")
-(put 'no-next-method 'error-conditions '(no-next-method error))
-(put 'no-next-method 'error-message "No next method")
-
-(intern "invalid-slot-name")
-(put 'invalid-slot-name 'error-conditions '(invalid-slot-name error))
-(put 'invalid-slot-name 'error-message "Invalid slot name")
-
-(intern "invalid-slot-type")
-(put 'invalid-slot-type 'error-conditions '(invalid-slot-type error nil))
-(put 'invalid-slot-type 'error-message "Invalid slot type")
-
-(intern "unbound-slot")
-(put 'unbound-slot 'error-conditions '(unbound-slot error nil))
-(put 'unbound-slot 'error-message "Unbound slot")
-
-(intern "inconsistent-class-hierarchy")
-(put 'inconsistent-class-hierarchy 'error-conditions
- '(inconsistent-class-hierarchy error nil))
-(put 'inconsistent-class-hierarchy 'error-message "Inconsistent class hierarchy")
-
-;;; Obsolete backward compatibility functions.
-;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
-
-(defun eieio-defmethod (method args)
- "Obsolete work part of an old version of the `defmethod' macro."
- (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa)
- ;; find optional keys
- (setq key
- (cond ((memq (car args) '(:BEFORE :before))
- (setq args (cdr args))
- method-before)
- ((memq (car args) '(:AFTER :after))
- (setq args (cdr args))
- method-after)
- ((memq (car args) '(:STATIC :static))
- (setq args (cdr args))
- method-static)
- ((memq (car args) '(:PRIMARY :primary))
- (setq args (cdr args))
- method-primary)
- ;; Primary key.
- (t method-primary)))
- ;; Get body, and fix contents of args to be the arguments of the fn.
- (setq body (cdr args)
- args (car args))
- (setq loopa args)
- ;; Create a fixed version of the arguments.
- (while loopa
- (setq argfix (cons (if (listp (car loopa)) (car (car loopa)) (car loopa))
- argfix))
- (setq loopa (cdr loopa)))
- ;; Make sure there is a generic.
- (eieio-defgeneric
- method
- (if (stringp (car body))
- (car body) (format "Generically created method `%s'." method)))
- ;; create symbol for property to bind to. If the first arg is of
- ;; the form (varname vartype) and `vartype' is a class, then
- ;; that class will be the type symbol. If not, then it will fall
- ;; under the type `primary' which is a non-specific calling of the
- ;; function.
- (setq firstarg (car args))
- (if (listp firstarg)
- (progn
- (setq argclass (nth 1 firstarg))
- (if (not (class-p argclass))
- (error "Unknown class type %s in method parameters"
- (nth 1 firstarg))))
- ;; Generics are higher.
- (setq key (eieio-specialized-key-to-generic-key key)))
- ;; Put this lambda into the symbol so we can find it.
- (if (byte-code-function-p (car-safe body))
- (eieiomt-add method (car-safe body) key argclass)
- (eieiomt-add method (append (list 'lambda (reverse argfix)) body)
- key argclass))
- )
-
- (when eieio-optimize-primary-methods-flag
- ;; Optimizing step:
- ;;
- ;; If this method, after this setup, only has primary methods, then
- ;; we can setup the generic that way.
- (if (generic-primary-only-p method)
- ;; If there is only one primary method, then we can go one more
- ;; optimization step.
- (if (generic-primary-only-one-p method)
- (eieio-defgeneric-reset-generic-form-primary-only-one method)
- (eieio-defgeneric-reset-generic-form-primary-only method))
- (eieio-defgeneric-reset-generic-form method)))
-
- method)
-(make-obsolete 'eieio-defmethod 'eieio--defmethod "24.1")
-
-(defun eieio-defgeneric (method doc-string)
- "Obsolete work part of an old version of the `defgeneric' macro."
- (if (and (fboundp method) (not (generic-p method))
- (or (byte-code-function-p (symbol-function method))
- (not (eq 'autoload (car (symbol-function method)))))
- )
- (error "You cannot create a generic/method over an existing symbol: %s"
- method))
- ;; Don't do this over and over.
- (unless (fboundp 'method)
- ;; This defun tells emacs where the first definition of this
- ;; method is defined.
- `(defun ,method nil)
- ;; Make sure the method tables are installed.
- (eieiomt-install method)
- ;; Apply the actual body of this function.
- (fset method (eieio-defgeneric-form method doc-string))
- ;; Return the method
- 'method))
-(make-obsolete 'eieio-defgeneric nil "24.1")
(provide 'eieio-core)
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index aff07b29edf..31d0b85c55a 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,6 +1,6 @@
-;;; eieio-custom.el -- eieio object customization
+;;; eieio-custom.el -- eieio object customization -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2001, 2005, 2007-2013 Free Software Foundation,
+;; Copyright (C) 1999-2001, 2005, 2007-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -70,7 +70,7 @@ of these.")
:documentation "A number of thingies."))
"A class for testing the widget on.")
-(defcustom eieio-widget-test (eieio-widget-test-class "Foo")
+(defcustom eieio-widget-test (eieio-widget-test-class)
"Test variable for editing an object."
:type 'object
:group 'eieio)
@@ -136,7 +136,7 @@ Updates occur regardless of the current customization group.")
))
(widget-value-set vc (widget-value vc))))
-(defun eieio-custom-toggle-parent (widget &rest ignore)
+(defun eieio-custom-toggle-parent (widget &rest _)
"Toggle visibility of parent of WIDGET.
Optional argument IGNORE is an extraneous parameter."
(eieio-custom-toggle-hide (widget-get widget :parent)))
@@ -154,7 +154,7 @@ Optional argument IGNORE is an extraneous parameter."
:clone-object-children nil
)
-(defun eieio-object-match (widget value)
+(defun eieio-object-match (_widget _value)
"Match info for WIDGET against VALUE."
;; Write me
t)
@@ -184,7 +184,7 @@ Optional argument IGNORE is an extraneous parameter."
(if (not (widget-get widget :value))
(widget-put widget
:value (cond ((widget-get widget :objecttype)
- (funcall (class-constructor
+ (funcall (eieio--class-constructor
(widget-get widget :objecttype))
"Custom-new"))
((widget-get widget :objectcreatefcn)
@@ -193,12 +193,8 @@ Optional argument IGNORE is an extraneous parameter."
(let* ((chil nil)
(obj (widget-get widget :value))
(master-group (widget-get widget :eieio-group))
- (cv (class-v (eieio--object-class obj)))
- (slots (eieio--class-public-a cv))
- (flabel (eieio--class-public-custom-label cv))
- (fgroup (eieio--class-public-custom-group cv))
- (fdoc (eieio--class-public-doc cv))
- (fcust (eieio--class-public-custom cv)))
+ (cv (eieio--object-class obj))
+ (slots (eieio--class-slots cv)))
;; First line describes the object, but may not editable.
(if (widget-get widget :eieio-show-name)
(setq chil (cons (widget-create-child-and-convert
@@ -208,7 +204,8 @@ Optional argument IGNORE is an extraneous parameter."
chil)))
;; Display information about the group being shown
(when master-group
- (let ((groups (class-option (eieio--object-class obj) :custom-groups)))
+ (let ((groups (eieio--class-option (eieio--object-class obj)
+ :custom-groups)))
(widget-insert "Groups:")
(while groups
(widget-insert " ")
@@ -216,7 +213,7 @@ Optional argument IGNORE is an extraneous parameter."
(widget-insert "*" (capitalize (symbol-name master-group)) "*")
(widget-create 'push-button
:thing (cons obj (car groups))
- :notify (lambda (widget &rest stuff)
+ :notify (lambda (widget &rest _)
(eieio-customize-object
(car (widget-get widget :thing))
(cdr (widget-get widget :thing))))
@@ -224,63 +221,60 @@ Optional argument IGNORE is an extraneous parameter."
(setq groups (cdr groups)))
(widget-insert "\n\n")))
;; Loop over all the slots, creating child widgets.
- (while slots
- ;; Output this slot if it has a customize flag associated with it.
- (when (and (car fcust)
- (or (not master-group) (member master-group (car fgroup)))
- (slot-boundp obj (car slots)))
- ;; In this case, this slot has a custom type. Create its
- ;; children widgets.
- (let ((type (eieio-filter-slot-type widget (car fcust)))
- (stuff nil))
- ;; This next bit is an evil hack to get some EDE functions
- ;; working the way I like.
- (if (and (listp type)
- (setq stuff (member :slotofchoices type)))
- (let ((choices (eieio-oref obj (car (cdr stuff))))
- (newtype nil))
- (while (not (eq (car type) :slotofchoices))
- (setq newtype (cons (car type) newtype)
- type (cdr type)))
- (while choices
- (setq newtype (cons (list 'const (car choices))
- newtype)
- choices (cdr choices)))
- (setq type (nreverse newtype))))
- (setq chil (cons (widget-create-child-and-convert
- widget 'object-slot
- :childtype type
- :sample-face 'eieio-custom-slot-tag-face
- :tag
- (concat
- (make-string
- (or (widget-get widget :indent) 0)
- ? )
- (if (car flabel)
- (car flabel)
- (let ((s (symbol-name
- (or
- (class-slot-initarg
- (eieio--object-class obj)
- (car slots))
- (car slots)))))
- (capitalize
- (if (string-match "^:" s)
- (substring s (match-end 0))
- s)))))
- :value (slot-value obj (car slots))
- :doc (if (car fdoc) (car fdoc)
- "Slot not Documented.")
- :eieio-custom-visibility 'visible
- )
- chil))
- )
- )
- (setq slots (cdr slots)
- fdoc (cdr fdoc)
- fcust (cdr fcust)
- flabel (cdr flabel)
- fgroup (cdr fgroup)))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (sname (eieio-slot-descriptor-name slot))
+ (props (cl--slot-descriptor-props slot)))
+ ;; Output this slot if it has a customize flag associated with it.
+ (when (and (alist-get :custom props)
+ (or (not master-group)
+ (member master-group (alist-get :group props)))
+ (slot-boundp obj (cl--slot-descriptor-name slot)))
+ ;; In this case, this slot has a custom type. Create its
+ ;; children widgets.
+ (let ((type (eieio-filter-slot-type widget (alist-get :custom props)))
+ (stuff nil))
+ ;; This next bit is an evil hack to get some EDE functions
+ ;; working the way I like.
+ (if (and (listp type)
+ (setq stuff (member :slotofchoices type)))
+ (let ((choices (eieio-oref obj (car (cdr stuff))))
+ (newtype nil))
+ (while (not (eq (car type) :slotofchoices))
+ (setq newtype (cons (car type) newtype)
+ type (cdr type)))
+ (while choices
+ (setq newtype (cons (list 'const (car choices))
+ newtype)
+ choices (cdr choices)))
+ (setq type (nreverse newtype))))
+ (setq chil (cons (widget-create-child-and-convert
+ widget 'object-slot
+ :childtype type
+ :sample-face 'eieio-custom-slot-tag-face
+ :tag
+ (concat
+ (make-string
+ (or (widget-get widget :indent) 0)
+ ?\s)
+ (or (alist-get :label props)
+ (let ((s (symbol-name
+ (or
+ (eieio--class-slot-initarg
+ (eieio--object-class obj)
+ sname)
+ sname))))
+ (capitalize
+ (if (string-match "^:" s)
+ (substring s (match-end 0))
+ s)))))
+ :value (slot-value obj sname)
+ :doc (or (alist-get :documentation props)
+ "Slot not Documented.")
+ :eieio-custom-visibility 'visible
+ )
+ chil))
+ ))))
(widget-put widget :children (nreverse chil))
))
@@ -288,40 +282,46 @@ Optional argument IGNORE is an extraneous parameter."
"Get the value of WIDGET."
(let* ((obj (widget-get widget :value))
(master-group eieio-cog)
- (cv (class-v (eieio--object-class obj)))
- (fgroup (eieio--class-public-custom-group cv))
(wids (widget-get widget :children))
(name (if (widget-get widget :eieio-show-name)
(car (widget-apply (car wids) :value-inline))
nil))
(chil (if (widget-get widget :eieio-show-name)
(nthcdr 1 wids) wids))
- (cv (class-v (eieio--object-class obj)))
- (slots (eieio--class-public-a cv))
- (fcust (eieio--class-public-custom cv)))
+ (cv (eieio--object-class obj))
+ (i 0)
+ (slots (eieio--class-slots cv)))
;; If there are any prefix widgets, clear them.
;; -- None yet
;; Create a batch of initargs for each slot.
- (while (and slots chil)
- (if (and (car fcust)
- (or eieio-custom-ignore-eieio-co
- (not master-group) (member master-group (car fgroup)))
- (slot-boundp obj (car slots)))
- (progn
- ;; Only customized slots have widgets
- (let ((eieio-custom-ignore-eieio-co t))
- (eieio-oset obj (car slots)
- (car (widget-apply (car chil) :value-inline))))
- (setq chil (cdr chil))))
- (setq slots (cdr slots)
- fgroup (cdr fgroup)
- fcust (cdr fcust)))
+ (while (and (< i (length slots)) chil)
+ (let* ((slot (aref slots i))
+ (props (cl--slot-descriptor-props slot))
+ (cust (alist-get :custom props)))
+ ;;
+ ;; Shouldn't I be incremented unconditionally? Or
+ ;; better shouldn't we simply mapc on the slots vector
+ ;; avoiding use of this integer variable? PLN Sat May
+ ;; 2 07:35:45 2015
+ ;;
+ (setq i (+ i 1))
+ (if (and cust
+ (or eieio-custom-ignore-eieio-co
+ (not master-group)
+ (member master-group (alist-get :group props)))
+ (slot-boundp obj (cl--slot-descriptor-name slot)))
+ (progn
+ ;; Only customized slots have widgets
+ (let ((eieio-custom-ignore-eieio-co t))
+ (eieio-oset obj (cl--slot-descriptor-name slot)
+ (car (widget-apply (car chil) :value-inline))))
+ (setq chil (cdr chil))))))
;; Set any name updates on it.
- (if name (setf (eieio--object-name obj) name))
+ (if name (eieio-object-set-name-string obj name))
;; This is the same object we had before.
obj))
-(defmethod eieio-done-customizing ((obj eieio-default-superclass))
+(cl-defmethod eieio-done-customizing ((_obj eieio-default-superclass))
"When applying change to a widget, call this method.
This method is called by the default widget-edit commands.
User made commands should also call this method when applying changes.
@@ -344,7 +344,7 @@ Optional argument GROUP is the sub-group of slots to display."
"Major mode for customizing EIEIO objects.
\\{eieio-custom-mode-map}")
-(defmethod eieio-customize-object ((obj eieio-default-superclass)
+(cl-defmethod eieio-customize-object ((obj eieio-default-superclass)
&optional group)
"Customize OBJ in a specialized custom buffer.
To override call the `eieio-custom-widget-insert' to just insert the
@@ -383,20 +383,20 @@ These groups are specified with the `:group' slot flag."
(make-local-variable 'eieio-co)
(setq eieio-co obj)
(make-local-variable 'eieio-cog)
- (setq eieio-cog group)))
+ (setq eieio-cog g)))
-(defmethod eieio-custom-object-apply-reset ((obj eieio-default-superclass))
+(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(widget-apply eieio-wo :value-get)
(eieio-done-customizing eieio-co)
(bury-buffer))
"Accept")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
;; I think the act of getting it sets
;; its value through the get function.
(message "Applying Changes...")
@@ -406,17 +406,17 @@ Argument OBJ is the object being customized."
"Apply")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(message "Resetting")
(eieio-customize-object eieio-co eieio-cog))
"Reset")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(bury-buffer))
"Cancel"))
-(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
+(cl-defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
&rest flags)
"Insert the widget used for editing object OBJ in the current buffer.
Arguments FLAGS are widget compatible flags.
@@ -431,13 +431,11 @@ Must return the created widget."
:clone-object-children t
)
-(defun eieio-object-value-to-abstract (widget value)
+(defun eieio-object-value-to-abstract (_widget value)
"For WIDGET, convert VALUE to an abstract /safe/ representation."
- (if (eieio-object-p value) value
- (if (null value) value
- nil)))
+ (if (eieio-object-p value) value))
-(defun eieio-object-abstract-to-value (widget value)
+(defun eieio-object-abstract-to-value (_widget value)
"For WIDGET, convert VALUE from an abstract /safe/ representation."
value)
@@ -447,21 +445,22 @@ Must return the created widget."
;; These functions provide the ability to create dynamic menus to
;; customize specific sections of an object. They do not hook directly
;; into a filter, but can be used to create easymenu vectors.
-(defmethod eieio-customize-object-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-customize-object-group ((obj eieio-default-superclass))
"Create a list of vectors for customizing sections of OBJ."
(mapcar (lambda (group)
(vector (concat "Group " (symbol-name group))
(list 'customize-object obj (list 'quote group))
t))
- (class-option (eieio--object-class obj) :custom-groups)))
+ (eieio--class-option (eieio--object-class obj) :custom-groups)))
(defvar eieio-read-custom-group-history nil
"History for the custom group reader.")
-(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
+(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass))
"Do a completing read on the name of a customization group in OBJ.
Return the symbol for the group, or nil"
- (let ((g (class-option (eieio--object-class obj) :custom-groups)))
+ (let ((g (eieio--class-option (eieio--object-class obj)
+ :custom-groups)))
(if (= (length g) 1)
(car g)
;; Make the association list
@@ -473,4 +472,8 @@ Return the symbol for the group, or nil"
(provide 'eieio-custom)
+;; Local variables:
+;; generated-autoload-file: "eieio.el"
+;; End:
+
;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index d3ae8b191e1..c820180359b 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,6 +1,6 @@
-;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
+;;; eieio-datadebug.el --- EIEIO extensions to the data debugger. -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: OO, lisp
@@ -31,6 +31,9 @@
;;; Code:
+(declare-function data-debug/eieio-insert-slots "eieio-datadebug"
+ (obj eieio-default-superclass))
+
(defun data-debug-insert-object-slots (object prefix)
"Insert all the slots of OBJECT.
PREFIX specifies what to insert at the start of each line."
@@ -54,16 +57,17 @@ PREFIX specifies what to insert at the start of each line."
"Insert a button representing OBJECT.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between PREFIX and the object button."
- (let ((start (point))
- (end nil)
- (str (object-print object))
- (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
- (eieio-object-name-string object)
- (eieio-object-class object)
- (eieio-class-parents (eieio-object-class object))
- (length (object-slots object))
- ))
- )
+ (let* ((start (point))
+ (end nil)
+ (str (object-print object))
+ (class (eieio-object-class object))
+ (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots"
+ (eieio-object-name-string object)
+ class
+ (eieio-class-parents class)
+ (length (eieio-class-slots class))
+ ))
+ )
(insert prefix prebuttontext str)
(setq end (point))
(put-text-property (- end (length str)) end 'face 'font-lock-keyword-face)
@@ -79,70 +83,46 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
;;
;; Each object should have an opportunity to show stuff about itself.
-(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
- prefix)
+(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
+ prefix)
"Insert the slots of OBJ into the current DDEBUG buffer."
(let ((inhibit-read-only t))
(data-debug-insert-thing (eieio-object-name-string obj)
prefix
"Name: ")
- (let* ((cl (eieio-object-class obj))
- (cv (class-v cl)))
- (data-debug-insert-thing (class-constructor cl)
+ (let* ((cv (eieio--object-class obj)))
+ (data-debug-insert-thing (eieio--class-name cv)
prefix
"Class: ")
;; Loop over all the public slots
- (let ((publa (eieio--class-public-a cv))
- )
- (while publa
- (if (slot-boundp obj (car publa))
- (let* ((i (class-slot-initarg cl (car publa)))
- (v (eieio-oref obj (car publa))))
- (data-debug-insert-thing
- v prefix (concat
- (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")))
- ;; Unbound case
- (let ((i (class-slot-initarg cl (car publa))))
- (data-debug-insert-custom
- "#unbound" prefix
- (concat (if i (symbol-name i)
- (symbol-name (car publa)))
- " ")
- 'font-lock-keyword-face))
- )
- (setq publa (cdr publa)))))))
+ (let ((slots (eieio--class-slots cv)))
+ (dotimes (i (length slots))
+ (let* ((slot (aref slots i))
+ (sname (cl--slot-descriptor-name slot))
+ (i (eieio--class-slot-initarg cv sname))
+ (sstr (concat (symbol-name (or i sname)) " ")))
+ (if (slot-boundp obj sname)
+ (let* ((v (eieio-oref obj sname)))
+ (data-debug-insert-thing v prefix sstr))
+ ;; Unbound case
+ (data-debug-insert-custom
+ "#unbound" prefix sstr
+ 'font-lock-keyword-face)
+ )))))))
;;; Augment the Data debug thing display list.
-(data-debug-add-specialized-thing (lambda (thing) (object-p thing))
+(data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing))
#'data-debug-insert-object-button)
;;; DEBUG METHODS
;;
;; A generic function to run DDEBUG on an object and popup a new buffer.
;;
-(defmethod data-debug-show ((obj eieio-default-superclass))
+(cl-defmethod data-debug-show ((obj eieio-default-superclass))
"Run ddebug against any EIEIO object OBJ."
(data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
(data-debug-insert-object-slots obj "]"))
-;;; DEBUG FUNCTIONS
-;;
-(defun eieio-debug-methodinvoke (method class)
- "Show the method invocation order for METHOD with CLASS object."
- (interactive "aMethod: \nXClass Expression: ")
- (let* ((eieio-pre-method-execution-functions
- (lambda (l) (throw 'moose l) ))
- (data
- (catch 'moose (eieio-generic-call
- method (list class))))
- (buf (data-debug-new-buffer "*Method Invocation*"))
- (data2 (mapcar (lambda (sym)
- (symbol-function (car sym)))
- data)))
- (data-debug-insert-thing data2 ">" "")))
-
(provide 'eieio-datadebug)
;;; eieio-datadebug.el ends here
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 27f97b31ebe..a5d8b6fcf89 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,6 +1,6 @@
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
-;; Copyright (C) 1996, 1998-2003, 2005, 2008-2013 Free Software
+;; Copyright (C) 1996, 1998-2003, 2005, 2008-2015 Free Software
;; Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -31,7 +31,6 @@
(require 'eieio)
(require 'find-func)
(require 'speedbar)
-(require 'help-mode)
;;; Code:
;;;###autoload
@@ -45,7 +44,7 @@ variable `eieio-default-superclass'."
nil t)))
nil))
(if (not root-class) (setq root-class 'eieio-default-superclass))
- (eieio--check-type class-p root-class)
+ (cl-check-type root-class class)
(display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
(with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
(erase-buffer)
@@ -58,9 +57,9 @@ variable `eieio-default-superclass'."
Argument THIS-ROOT is the local root of the tree.
Argument PREFIX is the character prefix to use.
Argument CH-PREFIX is another character prefix to display."
- (eieio--check-type class-p this-root)
+ (cl-check-type this-root class)
(let ((myname (symbol-name this-root))
- (chl (eieio--class-children (class-v this-root)))
+ (chl (eieio--class-children (cl--find-class this-root)))
(fprefix (concat ch-prefix " +--"))
(mprefix (concat ch-prefix " | "))
(lprefix (concat ch-prefix " ")))
@@ -74,215 +73,11 @@ Argument CH-PREFIX is another character prefix to display."
;;; CLASS COMPLETION / DOCUMENTATION
-;;;###autoload(defalias 'describe-class 'eieio-describe-class)
+;; Called via help-fns-describe-function-functions.
+(declare-function help-fns-short-filename "help-fns" (filename))
;;;###autoload
-(defun eieio-describe-class (class &optional headerfcn)
- "Describe a CLASS defined by a string or symbol.
-If CLASS is actually an object, then also display current values of that object.
-Optional HEADERFCN should be called to insert a few bits of info first."
- (interactive (list (eieio-read-class "Class: ")))
- (with-output-to-temp-buffer (help-buffer) ;"*Help*"
- (help-setup-xref (list #'eieio-describe-class class headerfcn)
- (called-interactively-p 'interactive))
-
- (when headerfcn (funcall headerfcn))
- (prin1 class)
- (princ " is a")
- (if (class-option class :abstract)
- (princ "n abstract"))
- (princ " class")
- ;; Print file location
- (when (get class 'class-location)
- (princ " in `")
- (princ (file-name-nondirectory (get class 'class-location)))
- (princ "'"))
- (terpri)
- ;; Inheritance tree information
- (let ((pl (eieio-class-parents class)))
- (when pl
- (princ " Inherits from ")
- (while pl
- (princ "`") (prin1 (car pl)) (princ "'")
- (setq pl (cdr pl))
- (if pl (princ ", ")))
- (terpri)))
- (let ((ch (eieio-class-children class)))
- (when ch
- (princ " Children ")
- (while ch
- (princ "`") (prin1 (car ch)) (princ "'")
- (setq ch (cdr ch))
- (if ch (princ ", ")))
- (terpri)))
- (terpri)
- ;; System documentation
- (let ((doc (documentation-property class 'variable-documentation)))
- (when doc
- (princ "Documentation:")
- (terpri)
- (princ doc)
- (terpri)
- (terpri)))
- ;; Describe all the slots in this class
- (eieio-describe-class-slots class)
- ;; Describe all the methods specific to this class.
- (let ((methods (eieio-all-generic-functions class))
- (doc nil))
- (if (not methods) nil
- (princ "Specialized Methods:")
- (terpri)
- (terpri)
- (while methods
- (setq doc (eieio-method-documentation (car methods) class))
- (princ "`")
- (prin1 (car methods))
- (princ "'")
- (if (not doc)
- (princ " Undocumented")
- (if (car doc)
- (progn
- (princ " :STATIC ")
- (prin1 (car (car doc)))
- (terpri)
- (princ (cdr (car doc)))))
- (setq doc (cdr doc))
- (if (car doc)
- (progn
- (princ " :BEFORE ")
- (prin1 (car (car doc)))
- (terpri)
- (princ (cdr (car doc)))))
- (setq doc (cdr doc))
- (if (car doc)
- (progn
- (princ " :PRIMARY ")
- (prin1 (car (car doc)))
- (terpri)
- (princ (cdr (car doc)))))
- (setq doc (cdr doc))
- (if (car doc)
- (progn
- (princ " :AFTER ")
- (prin1 (car (car doc)))
- (terpri)
- (princ (cdr (car doc)))))
- (terpri)
- (terpri))
- (setq methods (cdr methods))))))
- (with-current-buffer (help-buffer)
- (buffer-string)))
-
-(defun eieio-describe-class-slots (class)
- "Describe the slots in CLASS.
-Outputs to the standard output."
- (let* ((cv (class-v class))
- (docs (eieio--class-public-doc cv))
- (names (eieio--class-public-a cv))
- (deflt (eieio--class-public-d cv))
- (types (eieio--class-public-type cv))
- (publp (eieio--class-public-printer cv))
- (i 0)
- (prot (eieio--class-protection cv))
- )
- (princ "Instance Allocated Slots:")
- (terpri)
- (terpri)
- (while names
- (if (car prot) (princ "Private "))
- (princ "Slot: ")
- (prin1 (car names))
- (when (not (eq (aref types i) t))
- (princ " type = ")
- (prin1 (aref types i)))
- (unless (eq (car deflt) eieio-unbound)
- (princ " default = ")
- (prin1 (car deflt)))
- (when (car publp)
- (princ " printer = ")
- (prin1 (car publp)))
- (when (car docs)
- (terpri)
- (princ " ")
- (princ (car docs))
- (terpri))
- (terpri)
- (setq names (cdr names)
- docs (cdr docs)
- deflt (cdr deflt)
- publp (cdr publp)
- prot (cdr prot)
- i (1+ i)))
- (setq docs (eieio--class-class-allocation-doc cv)
- names (eieio--class-class-allocation-a cv)
- types (eieio--class-class-allocation-type cv)
- i 0
- prot (eieio--class-class-allocation-protection cv))
- (when names
- (terpri)
- (princ "Class Allocated Slots:"))
- (terpri)
- (terpri)
- (while names
- (when (car prot)
- (princ "Private "))
- (princ "Slot: ")
- (prin1 (car names))
- (unless (eq (aref types i) t)
- (princ " type = ")
- (prin1 (aref types i)))
- (condition-case nil
- (let ((value (eieio-oref class (car names))))
- (princ " value = ")
- (prin1 value))
- (error nil))
- (when (car docs)
- (terpri)
- (princ " ")
- (princ (car docs))
- (terpri))
- (terpri)
- (setq names (cdr names)
- docs (cdr docs)
- prot (cdr prot)
- i (1+ i)))))
-
-;;;###autoload
-(defun eieio-describe-constructor (fcn)
- "Describe the constructor function FCN.
-Uses `eieio-describe-class' to describe the class being constructed."
- (interactive
- ;; Use eieio-read-class since all constructors have the same name as
- ;; the class they create.
- (list (eieio-read-class "Class: ")))
- (eieio-describe-class
- fcn (lambda ()
- ;; Describe the constructor part.
- (prin1 fcn)
- (princ " is an object constructor function")
- ;; Print file location
- (when (get fcn 'class-location)
- (princ " in `")
- (princ (file-name-nondirectory (get fcn 'class-location)))
- (princ "'"))
- (terpri)
- (princ "Creates an object of class ")
- (prin1 fcn)
- (princ ".")
- (terpri)
- (terpri)
- ))
- )
-
-(defun eieio-build-class-list (class)
- "Return a list of all classes that inherit from CLASS."
- (if (class-p class)
- (apply #'append
- (mapcar
- (lambda (c)
- (append (list c) (eieio-build-class-list c)))
- (eieio-class-children-fast class)))
- (list class)))
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
(defun eieio-build-class-alist (&optional class instantiable-only buildlist)
"Return an alist of all currently active classes for completion purposes.
@@ -290,15 +85,16 @@ Optional argument CLASS is the class to start with.
If INSTANTIABLE-ONLY is non nil, only allow names of classes which
are not abstract, otherwise allow all classes.
Optional argument BUILDLIST is more list to attach and is used internally."
- (let* ((cc (or class eieio-default-superclass))
- (sublst (eieio--class-children (class-v cc))))
+ (let* ((cc (or class 'eieio-default-superclass))
+ (sublst (eieio--class-children (cl--find-class cc))))
(unless (assoc (symbol-name cc) buildlist)
(when (or (not instantiable-only) (not (class-abstract-p cc)))
+ ;; FIXME: Completion tables don't need alists, and ede/generic.el needs
+ ;; the symbols rather than their names.
(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
- (while sublst
+ (dolist (elem sublst)
(setq buildlist (eieio-build-class-alist
- (car sublst) instantiable-only buildlist))
- (setq sublst (cdr sublst)))
+ elem instantiable-only buildlist)))
buildlist))
(defvar eieio-read-class nil
@@ -326,163 +122,39 @@ are not abstract."
;;; METHOD COMPLETION / DOC
-(defalias 'describe-method 'eieio-describe-generic)
-;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
-(defalias 'eieio-describe-method 'eieio-describe-generic)
;;;###autoload
-(defun eieio-describe-generic (generic)
- "Describe the generic function GENERIC.
-Also extracts information about all methods specific to this generic."
- (interactive (list (eieio-read-generic "Generic Method: ")))
- (eieio--check-type generic-p generic)
- (with-output-to-temp-buffer (help-buffer) ; "*Help*"
- (help-setup-xref (list #'eieio-describe-generic generic)
- (called-interactively-p 'interactive))
-
- (prin1 generic)
- (princ " is a generic function")
- (when (generic-primary-only-p generic)
- (princ " with only ")
- (when (generic-primary-only-one-p generic)
- (princ "one "))
- (princ "primary method")
- (when (not (generic-primary-only-one-p generic))
- (princ "s"))
- )
- (princ ".")
- (terpri)
- (terpri)
- (let ((d (documentation generic)))
- (if (not d)
- (princ "The generic is not documented.\n")
- (princ "Documentation:")
- (terpri)
- (princ d)
- (terpri)
- (terpri)))
- (princ "Implementations:")
- (terpri)
- (terpri)
- (let ((i 4)
- (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
- ;; Loop over fanciful generics
- (while (< i 7)
- (let ((gm (aref (get generic 'eieio-method-tree) i)))
- (when gm
- (princ "Generic ")
- (princ (aref prefix (- i 3)))
- (terpri)
- (princ (or (nth 2 gm) "Undocumented"))
- (terpri)
- (terpri)))
- (setq i (1+ i)))
- (setq i 0)
- ;; Loop over defined class-specific methods
- (while (< i 4)
- (let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
- location)
- (while gm
- (princ "`")
- (prin1 (car (car gm)))
- (princ "'")
- ;; prefix type
- (princ " ")
- (princ (aref prefix i))
- (princ " ")
- ;; argument list
- (let* ((func (cdr (car gm)))
- (arglst (eieio-lambda-arglist func)))
- (prin1 arglst))
- (terpri)
- ;; 3 because of cdr
- (princ (or (documentation (cdr (car gm)))
- "Undocumented"))
- ;; Print file location if available
- (when (and (setq location (get generic 'method-locations))
- (setq location (assoc (caar gm) location)))
- (setq location (cadr location))
- (princ "\n\nDefined in `")
- (princ (file-name-nondirectory location))
- (princ "'\n"))
- (setq gm (cdr gm))
- (terpri)
- (terpri)))
- (setq i (1+ i)))))
- (with-current-buffer (help-buffer)
- (buffer-string)))
-
-(defun eieio-lambda-arglist (func)
- "Return the argument list of FUNC, a function body."
- (if (symbolp func) (setq func (symbol-function func)))
- (if (byte-code-function-p func)
- (eieio-compiled-function-arglist func)
- (car (cdr func))))
-
-(defun eieio-all-generic-functions (&optional class)
- "Return a list of all generic functions.
-Optional CLASS argument returns only those functions that contain
-methods for CLASS."
- (let ((l nil) tree (cn (if class (symbol-name class) nil)))
- (mapatoms
- (lambda (symbol)
- (setq tree (get symbol 'eieio-method-obarray))
- (if tree
- (progn
- ;; A symbol might be interned for that class in one of
- ;; these three slots in the method-obarray.
- (if (or (not class)
- (fboundp (intern-soft cn (aref tree 0)))
- (fboundp (intern-soft cn (aref tree 1)))
- (fboundp (intern-soft cn (aref tree 2))))
- (setq l (cons symbol l)))))))
- l))
-
-(defun eieio-method-documentation (generic class)
- "Return a list of the specific documentation of GENERIC for CLASS.
-If there is not an explicit method for CLASS in GENERIC, or if that
-function has no documentation, then return nil."
- (let ((tree (get generic 'eieio-method-obarray))
- (cn (symbol-name class))
- before primary after)
- (if (not tree)
- nil
- ;; A symbol might be interned for that class in one of
- ;; these three slots in the method-obarray.
- (setq before (intern-soft cn (aref tree 0))
- primary (intern-soft cn (aref tree 1))
- after (intern-soft cn (aref tree 2)))
- (if (not (or (fboundp before)
- (fboundp primary)
- (fboundp after)))
- nil
- (list (if (fboundp before)
- (cons (eieio-lambda-arglist before)
- (documentation before))
- nil)
- (if (fboundp primary)
- (cons (eieio-lambda-arglist primary)
- (documentation primary))
- nil)
- (if (fboundp after)
- (cons (eieio-lambda-arglist after)
- (documentation after))
- nil))))))
-
-(defvar eieio-read-generic nil
- "History of the `eieio-read-generic' prompt.")
-
-(defun eieio-read-generic-p (fn)
- "Function used in function `eieio-read-generic'.
-This is because `generic-p' is a macro.
-Argument FN is the function to test."
- (generic-p fn))
-
-(defun eieio-read-generic (prompt &optional historyvar)
- "Read a generic function from the minibuffer with PROMPT.
-Optional argument HISTORYVAR is the variable to use as history."
- (intern (completing-read prompt obarray 'eieio-read-generic-p
- t nil (or historyvar 'eieio-read-generic))))
+(defun eieio-help-constructor (ctr)
+ "Describe CTR if it is a class constructor."
+ (when (class-p ctr)
+ (erase-buffer)
+ (let ((location (find-lisp-object-file-name ctr 'define-type))
+ (def (symbol-function ctr)))
+ (goto-char (point-min))
+ (prin1 ctr)
+ (insert (format " is an %s object constructor function"
+ (if (autoloadp def)
+ "autoloaded"
+ "")))
+ (when (and (autoloadp def)
+ (null location))
+ (setq location
+ (find-lisp-object-file-name ctr def)))
+ (when location
+ (insert (substitute-command-keys " in `"))
+ (help-insert-xref-button
+ (help-fns-short-filename location)
+ 'cl-type-definition ctr location 'define-type)
+ (insert (substitute-command-keys "'")))
+ (insert ".\nCreates an object of class " (symbol-name ctr) ".")
+ (goto-char (point-max))
+ (if (autoloadp def)
+ (insert "\n\n[Class description not available until class definition is loaded.]\n")
+ (save-excursion
+ (insert (propertize "\n\nClass description:\n" 'face 'bold))
+ (eieio-help-class ctr))
+ ))))
+
;;; METHOD STATS
;;
@@ -490,7 +162,7 @@ Optional argument HISTORYVAR is the variable to use as history."
(defun eieio-display-method-list ()
"Display a list of all the methods and what features are used."
(interactive)
- (let* ((meth1 (eieio-all-generic-functions))
+ (let* ((meth1 (cl--generic-all-functions))
(meth (sort meth1 (lambda (a b)
(string< (symbol-name a)
(symbol-name b)))))
@@ -571,142 +243,17 @@ Optional argument HISTORYVAR is the variable to use as history."
(princ "Methods Primary Only: ")
(prin1 primaryonly)
(princ "\t")
- (princ (format "%d" (* (/ (float primaryonly) (float methidx)) 100)))
+ (princ (format "%d" (floor (* 100.0 primaryonly) methidx)))
(princ "% of total methods")
(terpri)
(princ "Only One Primary Impl: ")
(prin1 oneprimary)
(princ "\t")
- (princ (format "%d" (* (/ (float oneprimary) (float primaryonly)) 100)))
+ (princ (format "%d" (floor (* 100.0 oneprimary) primaryonly)))
(princ "% of total primary methods")
(terpri)
))
-;;; HELP AUGMENTATION
-;;
-(define-button-type 'eieio-method-def
- :supertype 'help-xref
- 'help-function (lambda (class method file)
- (eieio-help-find-method-definition class method file))
- 'help-echo (purecopy "mouse-2, RET: find method's definition"))
-
-(define-button-type 'eieio-class-def
- :supertype 'help-xref
- 'help-function (lambda (class file)
- (eieio-help-find-class-definition class file))
- 'help-echo (purecopy "mouse-2, RET: find class definition"))
-
-(defun eieio-help-find-method-definition (class method file)
- (let ((filename (find-library-name file))
- location buf)
- (when (null filename)
- (error "Cannot find library %s" file))
- (setq buf (find-file-noselect filename))
- (with-current-buffer buf
- (goto-char (point-min))
- (when
- (re-search-forward
- ;; Regexp for searching methods.
- (concat "(defmethod[ \t\r\n]+" method
- "\\([ \t\r\n]+:[a-zA-Z]+\\)?"
- "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
- class
- "\\s-*)")
- nil t)
- (setq location (match-beginning 0))))
- (if (null location)
- (message "Unable to find location in file")
- (pop-to-buffer buf)
- (goto-char location)
- (recenter)
- (beginning-of-line))))
-
-(defun eieio-help-find-class-definition (class file)
- (let ((filename (find-library-name file))
- location buf)
- (when (null filename)
- (error "Cannot find library %s" file))
- (setq buf (find-file-noselect filename))
- (with-current-buffer buf
- (goto-char (point-min))
- (when
- (re-search-forward
- ;; Regexp for searching a class.
- (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
- nil t)
- (setq location (match-beginning 0))))
- (if (null location)
- (message "Unable to find location in file")
- (pop-to-buffer buf)
- (goto-char location)
- (recenter)
- (beginning-of-line))))
-
-
-(defun eieio-help-mode-augmentation-maybee (&rest unused)
- "For buffers thrown into help mode, augment for EIEIO.
-Arguments UNUSED are not used."
- ;; Scan created buttons so far if we are in help mode.
- (when (eq major-mode 'help-mode)
- (save-excursion
- (goto-char (point-min))
- (let ((pos t) (inhibit-read-only t))
- (while pos
- (if (get-text-property (point) 'help-xref) ; move off reference
- (goto-char
- (or (next-single-property-change (point) 'help-xref)
- (point))))
- (setq pos (next-single-property-change (point) 'help-xref))
- (when pos
- (goto-char pos)
- (let* ((help-data (get-text-property (point) 'help-xref))
- ;(method (car help-data))
- (args (cdr help-data)))
- (when (symbolp (car args))
- (cond ((class-p (car args))
- (setcar help-data 'eieio-describe-class))
- ((generic-p (car args))
- (setcar help-data 'eieio-describe-generic))
- (t nil))
- ))))
- ;; start back at the beginning, and highlight some sections
- (goto-char (point-min))
- (while (re-search-forward "^\\(Documentation\\|Implementations\\):$" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (if (re-search-forward "^Specialized Methods:$" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (while (re-search-forward "^\\(Instance\\|Class\\) Allocated Slots:$" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (while (re-search-forward ":\\(STATIC\\|BEFORE\\|AFTER\\|PRIMARY\\)" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (while (re-search-forward "^\\(Private \\)?Slot:" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (cond
- ((looking-at "\\(.+\\) is a generic function")
- (let ((mname (match-string 1))
- cname)
- (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
- (setq cname (match-string-no-properties 1))
- (help-xref-button 2 'eieio-method-def cname
- mname
- (cadr (assoc (intern cname)
- (get (intern mname)
- 'method-locations)))))))
- ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
- (let ((cname (match-string-no-properties 1)))
- (help-xref-button 2 'eieio-class-def cname
- (get (intern cname) 'class-location))))
- ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
- (let ((cname (match-string-no-properties 1)))
- (help-xref-button 3 'eieio-class-def cname
- (get (intern cname) 'class-location)))))
- ))))
-
;;; SPEEDBAR SUPPORT
;;
@@ -743,21 +290,21 @@ Arguments UNUSED are not used."
()
"Menu part in easymenu format used in speedbar while in `eieio' mode.")
-(defun eieio-class-speedbar (dir-or-object depth)
+(defun eieio-class-speedbar (_dir-or-object _depth)
"Create buttons in speedbar that represents the current project.
DIR-OR-OBJECT is the object to expand, or nil, and DEPTH is the
current expansion depth."
(when (eq (point-min) (point-max))
;; This function is only called once, to start the whole deal.
- ;; Ceate, and expand the default object.
- (eieio-class-button eieio-default-superclass 0)
+ ;; Create and expand the default object.
+ (eieio-class-button 'eieio-default-superclass 0)
(forward-line -1)
(speedbar-expand-line)))
(defun eieio-class-button (class depth)
"Draw a speedbar button at the current point for CLASS at DEPTH."
- (eieio--check-type class-p class)
- (let ((subclasses (eieio--class-children (class-v class))))
+ (cl-check-type class class)
+ (let ((subclasses (eieio--class-children (cl--find-class class))))
(if subclasses
(speedbar-make-tag-line 'angle ?+
'eieio-sb-expand
@@ -782,7 +329,7 @@ Argument INDENT is the depth of indentation."
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
- (let ((subclasses (eieio--class-children (class-v class))))
+ (let ((subclasses (eieio--class-children (cl--find-class class))))
(while subclasses
(eieio-class-button (car subclasses) (1+ indent))
(setq subclasses (cdr subclasses)))))))
@@ -792,13 +339,17 @@ Argument INDENT is the depth of indentation."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defun eieio-describe-class-sb (text token indent)
+(defun eieio-describe-class-sb (_text token _indent)
"Describe the class TEXT in TOKEN.
INDENT is the current indentation level."
(dframe-with-attached-buffer
- (eieio-describe-class token))
+ (describe-function token))
(dframe-maybee-jump-to-attached-frame))
(provide 'eieio-opt)
+;; Local variables:
+;; generated-autoload-file: "eieio.el"
+;; End:
+
;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index e964263754f..a1eabcf9700 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -1,6 +1,6 @@
-;;; eieio-speedbar.el -- Classes for managing speedbar displays.
+;;; eieio-speedbar.el -- Classes for managing speedbar displays. -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2002, 2005, 2007-2013 Free Software Foundation,
+;; Copyright (C) 1999-2002, 2005, 2007-2015 Free Software Foundation,
;; Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
@@ -196,19 +196,19 @@ that path."
;; when no other methods are found, allowing multiple inheritance to work
;; reliably with eieio-speedbar.
-(defmethod eieio-speedbar-description (object)
+(cl-defmethod eieio-speedbar-description (object)
"Return a string describing OBJECT."
(eieio-object-name-string object))
-(defmethod eieio-speedbar-derive-line-path (object)
+(cl-defmethod eieio-speedbar-derive-line-path (_object)
"Return the path which OBJECT has something to do with."
nil)
-(defmethod eieio-speedbar-object-buttonname (object)
+(cl-defmethod eieio-speedbar-object-buttonname (object)
"Return a string to use as a speedbar button for OBJECT."
(eieio-object-name-string object))
-(defmethod eieio-speedbar-make-tag-line (object depth)
+(cl-defmethod eieio-speedbar-make-tag-line (object depth)
"Insert a tag line into speedbar at point for OBJECT.
By default, all objects appear as simple TAGS with no need to inherit from
the special `eieio-speedbar' classes. Child classes should redefine this
@@ -221,7 +221,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
'speedbar-tag-face
depth))
-(defmethod eieio-speedbar-handle-click (object)
+(cl-defmethod eieio-speedbar-handle-click (object)
"Handle a click action on OBJECT in speedbar.
Any object can be represented as a tag in SPEEDBAR without special
attributes. These default objects will be pulled up in a custom
@@ -285,7 +285,7 @@ Add one of the child classes to this class to the parent list of a class."
;;; Methods to eieio-speedbar-* which do not need to be overridden
;;
-(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
+(cl-defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
depth)
"Insert a tag line into speedbar at point for OBJECT.
All objects a child of symbol `eieio-speedbar' can be created from
@@ -321,12 +321,12 @@ Argument DEPTH is the depth at which the tag line is inserted."
(if exp
(eieio-speedbar-expand object (1+ depth))))))
-(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) depth)
+(cl-defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
"Base method for creating tag lines for non-object children."
(error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
(eieio-object-name object)))
-(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
+(cl-defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
"Expand OBJECT at indentation DEPTH.
Inserts a list of new tag lines representing expanded elements within
OBJECT."
@@ -340,7 +340,7 @@ OBJECT."
;;; Speedbar specific function callbacks.
;;
-(defun eieio-speedbar-object-click (text token indent)
+(defun eieio-speedbar-object-click (_text token _indent)
"Handle a user click on TEXT representing object TOKEN.
The object is at indentation level INDENT."
(eieio-speedbar-handle-click token))
@@ -362,7 +362,7 @@ TOKEN is the object. INDENT is the current indentation level."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
-(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
+(cl-defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
"Return a description for a child of OBJ which is not an object."
(error "You must implement `eieio-speedbar-child-description' for %s"
(eieio-object-name obj)))
@@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at."
;;; Methods to the eieio-speedbar-* classes which need to be overridden.
;;
-(defmethod eieio-speedbar-object-children ((object eieio-speedbar))
+(cl-defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
"Return a list of children to be displayed in speedbar.
If the return value is a list of OBJECTs, then those objects are
queried for details. If the return list is made of strings,
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index fc5da3198f9..790e8bc9e0e 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1,7 +1,7 @@
-;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
+;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects -*- lexical-binding:t -*-
;;; or maybe Eric's Implementation of Emacs Interpreted Objects
-;; Copyright (C) 1995-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 1.4
@@ -36,15 +36,13 @@
;; Retrieved from:
;; http://192.220.96.201/dylan/linearization-oopsla96.html
-;; There is funny stuff going on with typep and deftype. This
-;; is the only way I seem to be able to make this stuff load properly.
-
;; @TODO - fix :initform to be a form, not a quoted value
;; @TODO - Prefix non-clos functions with `eieio-'.
-;;; Code:
+;; TODO: better integrate CL's defstructs and classes. E.g. make it possible
+;; to create a new class that inherits from a struct.
-(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib!
+;;; Code:
(defvar eieio-version "1.4"
"Current version of EIEIO.")
@@ -59,13 +57,11 @@
;;; Defining a new class
;;
-(defmacro defclass (name superclass slots &rest options-and-doc)
+(defmacro defclass (name superclasses slots &rest options-and-doc)
"Define NAME as a new class derived from SUPERCLASS with SLOTS.
OPTIONS-AND-DOC is used as the class' options and base documentation.
-SUPERCLASS is a list of superclasses to inherit from, with SLOTS
-being the slots residing in that class definition. NOTE: Currently
-only one slot may exist in SUPERCLASS as multiple inheritance is not
-yet supported. Supported tags are:
+SUPERCLASSES is a list of superclasses to inherit from, with SLOTS
+being the slots residing in that class definition. Supported tags are:
:initform - Initializing form.
:initarg - Tag used during initialization.
@@ -79,8 +75,6 @@ yet supported. Supported tags are:
- A string documenting use of this slot.
The following are extensions on CLOS:
- :protection - Specify protection for this slot.
- Defaults to `:public'. Also use `:protected', or `:private'.
:custom - When customizing an object, the custom :type. Public only.
:label - A text string label used for a slot when customizing.
:group - Name of a customization group this slot belongs in.
@@ -115,96 +109,175 @@ Options in CLOS not supported in EIEIO:
Due to the way class options are set up, you can add any tags you wish,
and reference them using the function `class-option'."
- ;; This is eval-and-compile only to silence spurious compiler warnings
- ;; about functions and variables not known to be defined.
- ;; When eieio-defclass code is merged here and this becomes
- ;; transparent to the compiler, the eval-and-compile can be removed.
- `(eval-and-compile
- (eieio-defclass ',name ',superclass ',slots ',options-and-doc)))
-
-
-;;; CLOS style implementation of object creators.
-;;
-(defun make-instance (class &rest initargs)
- "Make a new instance of CLASS based on INITARGS.
-CLASS is a class symbol. For example:
-
- (make-instance 'foo)
-
- INITARGS is a property list with keywords based on the :initarg
-for each slot. For example:
-
- (make-instance 'foo :slot1 value1 :slotN valueN)
-
-Compatibility note:
+ (declare (doc-string 4))
+ (cl-check-type superclasses list)
+
+ (cond ((and (stringp (car options-and-doc))
+ (/= 1 (% (length options-and-doc) 2)))
+ (error "Too many arguments to `defclass'"))
+ ((and (symbolp (car options-and-doc))
+ (/= 0 (% (length options-and-doc) 2)))
+ (error "Too many arguments to `defclass'")))
+
+ (if (stringp (car options-and-doc))
+ (setq options-and-doc
+ (cons :documentation options-and-doc)))
+
+ ;; Make sure the method invocation order is a valid value.
+ (let ((io (eieio--class-option-assoc options-and-doc
+ :method-invocation-order)))
+ (when (and io (not (member io '(:depth-first :breadth-first :c3))))
+ (error "Method invocation order %s is not allowed" io)))
+
+ (let ((testsym1 (intern (concat (symbol-name name) "-p")))
+ (testsym2 (intern (format "%s--eieio-childp" name)))
+ (accessors ()))
+
+ ;; Collect the accessors we need to define.
+ (pcase-dolist (`(,sname . ,soptions) slots)
+ (let* ((acces (plist-get soptions :accessor))
+ (initarg (plist-get soptions :initarg))
+ (reader (plist-get soptions :reader))
+ (writer (plist-get soptions :writer))
+ (alloc (plist-get soptions :allocation))
+ (label (plist-get soptions :label)))
+
+ ;; Update eieio--known-slot-names already in case we compile code which
+ ;; uses this before the class is loaded.
+ (cl-pushnew sname eieio--known-slot-names)
+
+ (if eieio-error-unsupported-class-tags
+ (let ((tmp soptions))
+ (while tmp
+ (if (not (member (car tmp) '(:accessor
+ :initform
+ :initarg
+ :documentation
+ :protection
+ :reader
+ :writer
+ :allocation
+ :type
+ :custom
+ :label
+ :group
+ :printer
+ :allow-nil-initform
+ :custom-groups)))
+ (signal 'invalid-slot-type (list (car tmp))))
+ (setq tmp (cdr (cdr tmp))))))
+
+ ;; Make sure the :allocation parameter has a valid value.
+ (if (not (memq alloc '(nil :class :instance)))
+ (signal 'invalid-slot-type (list :allocation alloc)))
+
+ ;; Label is nil, or a string
+ (if (not (or (null label) (stringp label)))
+ (signal 'invalid-slot-type (list :label label)))
+
+ ;; Is there an initarg, but allocation of class?
+ (if (and initarg (eq alloc :class))
+ (message "Class allocated slots do not need :initarg"))
+
+ ;; Anyone can have an accessor function. This creates a function
+ ;; of the specified name, and also performs a `defsetf' if applicable
+ ;; so that users can `setf' the space returned by this function.
+ (when acces
+ (push `(cl-defmethod (setf ,acces) (value (this ,name))
+ (eieio-oset this ',sname value))
+ accessors)
+ (push `(cl-defmethod ,acces ((this ,name))
+ ,(format
+ "Retrieve the slot `%S' from an object of class `%S'."
+ sname name)
+ ;; FIXME: Why is this different from the :reader case?
+ (if (slot-boundp this ',sname) (eieio-oref this ',sname)))
+ accessors)
+ (when (and eieio-backward-compatibility (eq alloc :class))
+ ;; FIXME: How could I declare this *method* as obsolete.
+ (push `(cl-defmethod ,acces ((this (subclass ,name)))
+ ,(format
+ "Retrieve the class slot `%S' from a class `%S'.
+This method is obsolete."
+ sname name)
+ (if (slot-boundp this ',sname)
+ (eieio-oref-default this ',sname)))
+ accessors)))
+
+ ;; If a writer is defined, then create a generic method of that
+ ;; name whose purpose is to set the value of the slot.
+ (if writer
+ (push `(cl-defmethod ,writer ((this ,name) value)
+ ,(format "Set the slot `%S' of an object of class `%S'."
+ sname name)
+ (setf (slot-value this ',sname) value))
+ accessors))
+ ;; If a reader is defined, then create a generic method
+ ;; of that name whose purpose is to access this slot value.
+ (if reader
+ (push `(cl-defmethod ,reader ((this ,name))
+ ,(format "Access the slot `%S' from object of class `%S'."
+ sname name)
+ (slot-value this ',sname))
+ accessors))
+ ))
-If the first element of INITARGS is a string, it is used as the
-name of the class.
-
-In EIEIO, the class' constructor requires a name for use when printing.
-`make-instance' in CLOS doesn't use names the way Emacs does, so the
-class is used as the name slot instead when INITARGS doesn't start with
-a string."
- (if (and (car initargs) (stringp (car initargs)))
- (apply (class-constructor class) initargs)
- (apply (class-constructor class)
- (cond ((symbolp class) (symbol-name class))
- (t (format "%S" class)))
- initargs)))
-
-
-;;; CLOS methods and generics
-;;
-(defmacro defgeneric (method args &optional doc-string)
- "Create a generic function METHOD.
-DOC-STRING is the base documentation for this class. A generic
-function has no body, as its purpose is to decide which method body
-is appropriate to use. Uses `defmethod' to create methods, and calls
-`defgeneric' for you. With this implementation the ARGS are
-currently ignored. You can use `defgeneric' to apply specialized
-top level documentation to a method."
- `(eieio--defalias ',method
- (eieio--defgeneric-init-form ',method ,doc-string)))
-
-(defmacro defmethod (method &rest args)
- "Create a new METHOD through `defgeneric' with ARGS.
-
-The optional second argument KEY is a specifier that
-modifies how the method is called, including:
- :before - Method will be called before the :primary
- :primary - The default if not specified
- :after - Method will be called after the :primary
- :static - First arg could be an object or class
-The next argument is the ARGLIST. The ARGLIST specifies the arguments
-to the method as with `defun'. The first argument can have a type
-specifier, such as:
- ((VARNAME CLASS) ARG2 ...)
-where VARNAME is the name of the local variable for the method being
-created. The CLASS is a class symbol for a class made with `defclass'.
-A DOCSTRING comes after the ARGLIST, and is optional.
-All the rest of the args are the BODY of the method. A method will
-return the value of the last form in the BODY.
-
-Summary:
-
- (defmethod mymethod [:before | :primary | :after | :static]
- ((typearg class-name) arg2 &optional opt &rest rest)
- \"doc-string\"
- body)"
- (let* ((key (if (keywordp (car args)) (pop args)))
- (params (car args))
- (arg1 (car params))
- (fargs (if (consp arg1)
- (cons (car arg1) (cdr params))
- params))
- (class (if (consp arg1) (nth 1 arg1)))
- (code `(lambda ,fargs ,@(cdr args))))
`(progn
- ;; Make sure there is a generic and the byte-compiler sees it.
- (defgeneric ,method ,args
- ,(or (documentation code)
- (format "Generically created method `%s'." method)))
- (eieio--defmethod ',method ',key ',class #',code))))
+ ;; This test must be created right away so we can have self-
+ ;; referencing classes. ei, a class whose slot can contain only
+ ;; pointers to itself.
+
+ ;; Create the test functions.
+ (defalias ',testsym1 (eieio-make-class-predicate ',name))
+ (defalias ',testsym2 (eieio-make-child-predicate ',name))
+
+ ,@(when eieio-backward-compatibility
+ (let ((f (intern (format "%s-child-p" name))))
+ `((defalias ',f ',testsym2)
+ (make-obsolete
+ ',f ,(format "use (cl-typep ... \\='%s) instead" name)
+ "25.1"))))
+
+ ;; When using typep, (typep OBJ 'myclass) returns t for objects which
+ ;; are subclasses of myclass. For our predicates, however, it is
+ ;; important for EIEIO to be backwards compatible, where
+ ;; myobject-p, and myobject-child-p are different.
+ ;; "cl" uses this technique to specify symbols with specific typep
+ ;; test, so we can let typep have the CLOS documented behavior
+ ;; while keeping our above predicate clean.
+
+ (put ',name 'cl-deftype-satisfies #',testsym2)
+
+ (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
+
+ ,@accessors
+
+ ;; Create the constructor function
+ ,(if (eieio--class-option-assoc options-and-doc :abstract)
+ ;; Abstract classes cannot be instantiated. Say so.
+ (let ((abs (eieio--class-option-assoc options-and-doc :abstract)))
+ (if (not (stringp abs))
+ (setq abs (format "Class %s is abstract" name)))
+ `(defun ,name (&rest _)
+ ,(format "You cannot create a new object of type `%S'." name)
+ (error ,abs)))
+
+ ;; Non-abstract classes need a constructor.
+ `(defun ,name (&rest slots)
+ ,(format "Create a new object of class type `%S'." name)
+ (declare (compiler-macro
+ (lambda (whole)
+ (if (not (stringp (car slots)))
+ whole
+ (macroexp--warn-and-return
+ (format "Obsolete name arg %S to constructor %S"
+ (car slots) (car whole))
+ ;; Keep the name arg, for backward compatibility,
+ ;; but hide it so we don't trigger indefinitely.
+ `(,(car whole) (identity ,(car slots))
+ ,@(cdr slots)))))))
+ (apply #'make-instance ',name slots))))))
+
;;; Get/Set slots in an object.
;;
@@ -212,16 +285,19 @@ Summary:
"Retrieve the value stored in OBJ in the slot named by SLOT.
Slot is the name of the slot when created by `defclass' or the label
created by the :initarg tag."
+ (declare (debug (form symbolp)))
`(eieio-oref ,obj (quote ,slot)))
(defalias 'slot-value 'eieio-oref)
(defalias 'set-slot-value 'eieio-oset)
+(make-obsolete 'set-slot-value "use (setf (slot-value ..) ..) instead" "25.1")
(defmacro oref-default (obj slot)
"Get the default value of OBJ (maybe a class) for SLOT.
The default value is the value installed in a class with the :initform
tag. SLOT can be the slot name, or the tag specified by the :initarg
tag in the `defclass' call."
+ (declare (debug (form symbolp)))
`(eieio-oref-default ,obj (quote ,slot)))
;;; Handy CLOS macros
@@ -245,54 +321,108 @@ SPEC-LIST is of a form similar to `let'. For example:
Where each VAR is the local variable given to the associated
SLOT. A slot specified without a variable name is given a
variable name of the same name as the slot."
- (declare (indent 2))
- ;; Transform the spec-list into a symbol-macrolet spec-list.
- (let ((mappings (mapcar (lambda (entry)
- (let ((var (if (listp entry) (car entry) entry))
- (slot (if (listp entry) (cadr entry) entry)))
- (list var `(slot-value ,object ',slot))))
- spec-list)))
- (append (list 'symbol-macrolet mappings)
- body)))
+ (declare (indent 2) (debug (sexp sexp def-body)))
+ (require 'cl-lib)
+ ;; Transform the spec-list into a cl-symbol-macrolet spec-list.
+ (macroexp-let2 nil object object
+ `(cl-symbol-macrolet
+ ,(mapcar (lambda (entry)
+ (let ((var (if (listp entry) (car entry) entry))
+ (slot (if (listp entry) (cadr entry) entry)))
+ (list var `(slot-value ,object ',slot))))
+ spec-list)
+ ,@body)))
+
+;; Keep it as a non-inlined function, so the internals of object don't get
+;; hard-coded in random .elc files.
+(defun eieio-pcase-slot-index-table (obj)
+ "Return some data structure from which can be extracted the slot offset."
+ (eieio--class-index-table
+ (symbol-value (eieio--object-class-tag obj))))
+
+(defun eieio-pcase-slot-index-from-index-table (index-table slot)
+ "Find the index to pass to `aref' to access SLOT."
+ (let ((index (gethash slot index-table)))
+ (if index (+ (eval-when-compile
+ (length (cl-struct-slot-info 'eieio--object)))
+ index))))
+
+(pcase-defmacro eieio (&rest fields)
+ "Pcase patterns to match EIEIO objects.
+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))))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
;;
+
(define-obsolete-function-alias
- 'object-class-fast #'eieio--object-class "24.4")
+ 'object-class-fast #'eieio-object-class "24.4")
+
+(cl-defgeneric eieio-object-name-string (obj)
+ "Return a string which is OBJ's name."
+ (declare (obsolete eieio-named "25.1")))
(defun eieio-object-name (obj &optional extra)
- "Return a Lisp like symbol string for object OBJ.
+ "Return a printed representation for object OBJ.
If EXTRA, include that in the string returned to represent the symbol."
- (eieio--check-type eieio-object-p obj)
- (format "#<%s %s%s>" (symbol-name (eieio--object-class obj))
- (eieio--object-name obj) (or extra "")))
+ (cl-check-type obj eieio-object)
+ (format "#<%s %s%s>" (eieio-object-class obj)
+ (eieio-object-name-string obj) (or extra "")))
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
-(defun eieio-object-name-string (obj) "Return a string which is OBJ's name."
- (eieio--check-type eieio-object-p obj)
- (eieio--object-name obj))
+(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key))
+
+;; In the past, every EIEIO object had a `name' field, so we had the two method
+;; below "for free". Since this field is very rarely used, we got rid of it
+;; and instead we keep it in a weak hash-tables, for those very rare objects
+;; that use it.
+(cl-defmethod eieio-object-name-string (obj)
+ (or (gethash obj eieio--object-names)
+ (symbol-name (eieio-object-class obj))))
(define-obsolete-function-alias
'object-name-string #'eieio-object-name-string "24.4")
-(defun eieio-object-set-name-string (obj name)
+(cl-defmethod eieio-object-set-name-string (obj name)
"Set the string which is OBJ's NAME."
- (eieio--check-type eieio-object-p obj)
- (eieio--check-type stringp name)
- (setf (eieio--object-name obj) name))
+ (declare (obsolete eieio-named "25.1"))
+ (cl-check-type name string)
+ (setf (gethash obj eieio--object-names) name))
(define-obsolete-function-alias
'object-set-name-string 'eieio-object-set-name-string "24.4")
-(defun eieio-object-class (obj) "Return the class struct defining OBJ."
- (eieio--check-type eieio-object-p obj)
- (eieio--object-class obj))
+(defun eieio-object-class (obj)
+ "Return the class struct defining OBJ."
+ ;; FIXME: We say we return a "struct" but we return a symbol instead!
+ (cl-check-type obj eieio-object)
+ (eieio--class-name (eieio--object-class obj)))
(define-obsolete-function-alias 'object-class #'eieio-object-class "24.4")
;; CLOS name, maybe?
(define-obsolete-function-alias 'class-of #'eieio-object-class "24.4")
(defun eieio-object-class-name (obj)
"Return a Lisp like symbol name for OBJ's class."
- (eieio--check-type eieio-object-p obj)
+ (cl-check-type obj eieio-object)
(eieio-class-name (eieio--object-class obj)))
(define-obsolete-function-alias
'object-class-name 'eieio-object-class-name "24.4")
@@ -301,15 +431,15 @@ If EXTRA, include that in the string returned to represent the symbol."
"Return parent classes to CLASS. (overload of variable).
The CLOS function `class-direct-superclasses' is aliased to this function."
- (eieio--check-type class-p class)
- (eieio-class-parents-fast class))
+ (eieio--class-parents (eieio--class-object class)))
+
(define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4")
(defun eieio-class-children (class)
"Return child classes to CLASS.
The CLOS function `class-direct-subclasses' is aliased to this function."
- (eieio--check-type class-p class)
- (eieio-class-children-fast class))
+ (cl-check-type class class)
+ (eieio--class-children (cl--find-class class)))
(define-obsolete-function-alias
'class-children #'eieio-class-children "24.4")
@@ -322,16 +452,18 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(defmacro eieio-class-parent (class)
"Return first parent class to CLASS. (overload of variable)."
`(car (eieio-class-parents ,class)))
-(define-obsolete-function-alias 'class-parent #'eieio-class-parent "24.4")
+(define-obsolete-function-alias 'class-parent 'eieio-class-parent "24.4")
-(defun same-class-p (obj class) "Return t if OBJ is of class-type CLASS."
- (eieio--check-type class-p class)
- (eieio--check-type eieio-object-p obj)
- (same-class-fast-p obj class))
+(defun same-class-p (obj class)
+ "Return t if OBJ is of class-type CLASS."
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (cl-check-type obj eieio-object)
+ (eq (eieio--object-class obj) class))
(defun object-of-class-p (obj class)
"Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses."
- (eieio--check-type eieio-object-p obj)
+ (cl-check-type obj eieio-object)
;; class will be checked one layer down
(child-of-class-p (eieio--object-class obj) class))
;; Backwards compatibility
@@ -339,23 +471,41 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
(defun child-of-class-p (child class)
"Return non-nil if CHILD class is a subclass of CLASS."
- (eieio--check-type class-p class)
- (eieio--check-type class-p child)
- (let ((p nil))
- (while (and child (not (eq child class)))
- (setq p (append p (eieio--class-parent (class-v child)))
- child (car p)
- p (cdr p)))
- (if child t)))
+ (setq child (eieio--class-object child))
+ (cl-check-type child eieio--class)
+ ;; `eieio-default-superclass' is never mentioned in eieio--class-parents,
+ ;; so we have to special case it here.
+ (or (eq class 'eieio-default-superclass)
+ (let ((p nil))
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (while (and child (not (eq child class)))
+ (setq p (append p (eieio--class-parents child))
+ child (pop p)))
+ (if child t))))
+
+(defun eieio-slot-descriptor-name (slot)
+ (cl--slot-descriptor-name slot))
+
+(defun eieio-class-slots (class)
+ "Return list of slots available in instances of CLASS."
+ ;; FIXME: This only gives the instance slots and ignores the
+ ;; class-allocated slots.
+ (setq class (eieio--class-object class))
+ (cl-check-type class eieio--class)
+ (mapcar #'identity (eieio--class-slots class)))
(defun object-slots (obj)
- "Return list of slots available in OBJ."
- (eieio--check-type eieio-object-p obj)
- (eieio--class-public-a (class-v (eieio--object-class obj))))
-
-(defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg."
- (eieio--check-type class-p class)
- (let ((ia (eieio--class-initarg-tuples (class-v class)))
+ "Return list of slot names available in OBJ."
+ (declare (obsolete eieio-class-slots "25.1"))
+ (cl-check-type obj eieio-object)
+ (mapcar #'cl--slot-descriptor-name
+ (eieio-class-slots (eieio--object-class obj))))
+
+(defun eieio--class-slot-initarg (class slot)
+ "Fetch from CLASS, SLOT's :initarg."
+ (cl-check-type class eieio--class)
+ (let ((ia (eieio--class-initarg-tuples class))
(f nil))
(while (and ia (not f))
(if (eq (cdr (car ia)) slot)
@@ -369,6 +519,7 @@ The CLOS function `class-direct-subclasses' is aliased to this function."
"Set the value in OBJ for slot SLOT to VALUE.
SLOT is the slot name as specified in `defclass' or the tag created
with in the :initarg slot. VALUE can be any Lisp object."
+ (declare (debug (form symbolp form)))
`(eieio-oset ,obj (quote ,slot) ,value))
(defmacro oset-default (class slot value)
@@ -376,6 +527,7 @@ with in the :initarg slot. VALUE can be any Lisp object."
The default value is usually set with the :initform tag during class
creation. This allows users to change the default behavior of classes
after they are created."
+ (declare (debug (form symbolp form)))
`(eieio-oset-default ,class (quote ,slot) ,value))
;;; CLOS queries into classes and slots
@@ -390,7 +542,7 @@ OBJECT can be an instance or a class."
;; Return nil if the magic symbol is in there.
(not (eq (cond
((eieio-object-p object) (eieio-oref object slot))
- ((class-p object) (eieio-oref-default object slot))
+ ((symbolp object) (eieio-oref-default object slot))
(t (signal 'wrong-type-argument (list 'eieio-object-p object))))
eieio-unbound))))
@@ -400,23 +552,28 @@ OBJECT can be an instance or a class."
(defun slot-exists-p (object-or-class slot)
"Return non-nil if OBJECT-OR-CLASS has SLOT."
- (let ((cv (class-v (cond ((eieio-object-p object-or-class)
- (eieio-object-class object-or-class))
- ((class-p object-or-class)
- object-or-class))
- )))
- (or (memq slot (eieio--class-public-a cv))
- (memq slot (eieio--class-class-allocation-a cv)))
- ))
+ (let ((cv (cond ((eieio-object-p object-or-class)
+ (eieio--object-class object-or-class))
+ ((eieio--class-p object-or-class) object-or-class)
+ (t (find-class object-or-class 'error)))))
+ (or (gethash slot (eieio--class-index-table cv))
+ ;; FIXME: We could speed this up by adding class slots into the
+ ;; index-table (e.g. with a negative index?).
+ (let ((cs (eieio--class-class-slots cv))
+ found)
+ (dotimes (i (length cs))
+ (if (eq slot (cl--slot-descriptor-name (aref cs i)))
+ (setq found t)))
+ found))))
(defun find-class (symbol &optional errorp)
"Return the class that SYMBOL represents.
If there is no class, nil is returned if ERRORP is nil.
If ERRORP is non-nil, `wrong-argument-type' is signaled."
- (if (not (class-p symbol))
- (if errorp (signal 'wrong-type-argument (list 'class-p symbol))
- nil)
- (class-v symbol)))
+ (let ((class (cl--find-class symbol)))
+ (cond
+ ((eieio--class-p class) class)
+ (errorp (signal 'wrong-type-argument (list 'class-p symbol))))))
;;; Slightly more complex utility functions for objects
;;
@@ -426,7 +583,7 @@ LIST is a list of objects whose slots are searched.
Objects in LIST do not need to have a slot named SLOT, nor does
SLOT need to be bound. If these errors occur, those objects will
be ignored."
- (eieio--check-type listp list)
+ (cl-check-type list list)
(while (and list (not (condition-case nil
;; This prevents errors for missing slots.
(equal key (eieio-oref (car list) slot))
@@ -438,7 +595,7 @@ be ignored."
"Return an association list with the contents of SLOT as the key element.
LIST must be a list of objects with SLOT in it.
This is useful when you need to do completing read on an object group."
- (eieio--check-type listp list)
+ (cl-check-type list list)
(let ((assoclist nil))
(while list
(setq assoclist (cons (cons (eieio-oref (car list) slot)
@@ -452,7 +609,7 @@ This is useful when you need to do completing read on an object group."
LIST must be a list of objects, but those objects do not need to have
SLOT in it. If it does not, then that element is left out of the association
list."
- (eieio--check-type listp list)
+ (cl-check-type list list)
(let ((assoclist nil))
(while list
(if (slot-exists-p (car list) slot)
@@ -494,68 +651,13 @@ If SLOT is unbound, do nothing."
nil
(eieio-oset object slot (delete item (eieio-oref object slot)))))
-;;;
-;; Method Calling Functions
-
-(defun next-method-p ()
- "Return non-nil if there is a next method.
-Returns a list of lambda expressions which is the `next-method'
-order."
- eieio-generic-call-next-method-list)
-
-(defun call-next-method (&rest replacement-args)
- "Call the superclass method from a subclass method.
-The superclass method is specified in the current method list,
-and is called the next method.
-
-If REPLACEMENT-ARGS is non-nil, then use them instead of
-`eieio-generic-call-arglst'. The generic arg list are the
-arguments passed in at the top level.
-
-Use `next-method-p' to find out if there is a next method to call."
- (if (not (eieio--scoped-class))
- (error "`call-next-method' not called within a class specific method"))
- (if (and (/= eieio-generic-call-key method-primary)
- (/= eieio-generic-call-key method-static))
- (error "Cannot `call-next-method' except in :primary or :static methods")
- )
- (let ((newargs (or replacement-args eieio-generic-call-arglst))
- (next (car eieio-generic-call-next-method-list))
- )
- (if (or (not next) (not (car next)))
- (apply 'no-next-method (car newargs) (cdr newargs))
- (let* ((eieio-generic-call-next-method-list
- (cdr eieio-generic-call-next-method-list))
- (eieio-generic-call-arglst newargs)
- (fcn (car next))
- )
- (eieio--with-scoped-class (cdr next)
- (apply fcn newargs)) ))))
-
;;; Here are some CLOS items that need the CL package
;;
-(defsetf eieio-oref eieio-oset)
-
-(if (eval-when-compile (fboundp 'gv-define-expander))
- ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
- ;; follows aliases.
- nil
-(defsetf slot-value eieio-oset)
-
-;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
-(define-setf-method oref (obj slot)
- (with-no-warnings
- (require 'cl)
- (let ((obj-temp (gensym))
- (slot-temp (gensym))
- (store-temp (gensym)))
- (list (list obj-temp slot-temp)
- (list obj `(quote ,slot))
- (list store-temp)
- (list 'set-slot-value obj-temp slot-temp
- store-temp)
- (list 'slot-value obj-temp slot-temp))))))
+;; 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)
;;;
@@ -574,48 +676,65 @@ Its slots are automatically adopted by classes with no specified parents.
This class is not stored in the `parent' slot of a class vector."
:abstract t)
+(setq eieio-default-superclass (cl--find-class 'eieio-default-superclass))
+
(defalias 'standard-class 'eieio-default-superclass)
-(defgeneric constructor (class newname &rest slots)
- "Default constructor for CLASS `eieio-default-superclass'.")
+(cl-defgeneric make-instance (class &rest initargs)
+ "Make a new instance of CLASS based on INITARGS.
+For example:
+
+ (make-instance \\='foo)
+
+INITARGS is a property list with keywords based on the `:initarg'
+for each slot. For example:
+
+ (make-instance \\='foo :slot1 value1 :slotN valueN)")
+
+(define-obsolete-function-alias 'constructor #'make-instance "25.1")
-(defmethod constructor :static
- ((class eieio-default-superclass) newname &rest slots)
+(cl-defmethod make-instance
+ ((class (subclass eieio-default-superclass)) &rest slots)
"Default constructor for CLASS `eieio-default-superclass'.
-NEWNAME is the name to be given to the constructed object.
-SLOTS are the initialization slots used by `shared-initialize'.
+SLOTS are the initialization slots used by `initialize-instance'.
This static method is called when an object is constructed.
It allocates the vector used to represent an EIEIO object, and then
-calls `shared-initialize' on that object."
- (let* ((new-object (copy-sequence (eieio--class-default-object-cache (class-v class)))))
- ;; Update the name for the newly created object.
- (setf (eieio--object-name new-object) newname)
+calls `initialize-instance' on that object."
+ (let* ((new-object (copy-sequence (eieio--class-default-object-cache
+ (eieio--class-object class)))))
+ (if (and slots
+ (let ((x (car slots)))
+ (or (stringp x) (null x))))
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete name %S passed to %S constructor"
+ (pop slots) class))
;; Call the initialize method on the new object with the slots
;; that were passed down to us.
(initialize-instance new-object slots)
;; Return the created object.
new-object))
-(defgeneric shared-initialize (obj slots)
+;; FIXME: CLOS uses "&rest INITARGS" instead.
+(cl-defgeneric shared-initialize (obj slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine.")
-(defmethod shared-initialize ((obj eieio-default-superclass) slots)
+(cl-defmethod shared-initialize ((obj eieio-default-superclass) slots)
"Set slots of OBJ with SLOTS which is a list of name/value pairs.
Called from the constructor routine."
- (eieio--with-scoped-class (eieio--object-class obj)
- (while slots
- (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj)
- (car slots))))
- (if (not rn)
- (slot-missing obj (car slots) 'oset (car (cdr slots)))
- (eieio-oset obj rn (car (cdr slots)))))
- (setq slots (cdr (cdr slots))))))
-
-(defgeneric initialize-instance (this &optional slots)
+ (while slots
+ (let ((rn (eieio--initarg-to-attribute (eieio--object-class obj)
+ (car slots))))
+ (if (not rn)
+ (slot-missing obj (car slots) 'oset (car (cdr slots)))
+ (eieio-oset obj rn (car (cdr slots)))))
+ (setq slots (cdr (cdr slots)))))
+
+;; FIXME: CLOS uses "&rest INITARGS" instead.
+(cl-defgeneric initialize-instance (this &optional slots)
"Construct the new object THIS based on SLOTS.")
-(defmethod initialize-instance ((this eieio-default-superclass)
+(cl-defmethod initialize-instance ((this eieio-default-superclass)
&optional slots)
"Construct the new object THIS based on SLOTS.
SLOTS is a tagged list where odd numbered elements are tags, and
@@ -627,10 +746,9 @@ not taken, then new objects of your class will not have their values
dynamically set from SLOTS."
;; First, see if any of our defaults are `lambda', and
;; re-evaluate them and apply the value to our slots.
- (let* ((this-class (class-v (eieio--object-class this)))
- (slot (eieio--class-public-a this-class))
- (defaults (eieio--class-public-d this-class)))
- (while slot
+ (let* ((this-class (eieio--object-class this))
+ (slots (eieio--class-slots this-class)))
+ (dotimes (i (length slots))
;; For each slot, see if we need to evaluate it.
;;
;; Paul Landes said in an email:
@@ -638,20 +756,20 @@ dynamically set from SLOTS."
;; > the quoted thing as you already have. This is by the
;; > Sonya E. Keene book and other things I've look at on the
;; > web.
- (let ((dflt (eieio-default-eval-maybe (car defaults))))
- (when (not (eq dflt (car defaults)))
- (eieio-oset this (car slot) dflt) ))
- ;; Next.
- (setq slot (cdr slot)
- defaults (cdr defaults))))
+ (let* ((slot (aref slots i))
+ (initform (cl--slot-descriptor-initform slot))
+ (dflt (eieio-default-eval-maybe initform)))
+ (when (not (eq dflt initform))
+ ;; FIXME: We should be able to just do (aset this (+ i <cst>) dflt)!
+ (eieio-oset this (cl--slot-descriptor-name slot) dflt)))))
;; Shared initialize will parse our slots for us.
(shared-initialize this slots))
-(defgeneric slot-missing (object slot-name operation &optional new-value)
+(cl-defgeneric slot-missing (object slot-name operation &optional new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.")
-(defmethod slot-missing ((object eieio-default-superclass) slot-name
- operation &optional new-value)
+(cl-defmethod slot-missing ((object eieio-default-superclass) slot-name
+ _operation &optional _new-value)
"Method invoked when an attempt to access a slot in OBJECT fails.
SLOT-NAME is the name of the failed slot, OPERATION is the type of access
that was requested, and optional NEW-VALUE is the value that was desired
@@ -662,10 +780,10 @@ directly reference slots in EIEIO objects."
(signal 'invalid-slot-name (list (eieio-object-name object)
slot-name)))
-(defgeneric slot-unbound (object class slot-name fn)
+(cl-defgeneric slot-unbound (object class slot-name fn)
"Slot unbound is invoked during an attempt to reference an unbound slot.")
-(defmethod slot-unbound ((object eieio-default-superclass)
+(cl-defmethod slot-unbound ((object eieio-default-superclass)
class slot-name fn)
"Slot unbound is invoked during an attempt to reference an unbound slot.
OBJECT is the instance of the object being reference. CLASS is the
@@ -677,78 +795,44 @@ Use `slot-boundp' to determine if a slot is bound or not.
In CLOS, the argument list is (CLASS OBJECT SLOT-NAME), but
EIEIO can only dispatch on the first argument, so the first two are swapped."
- (signal 'unbound-slot (list (eieio-class-name class) (eieio-object-name object)
+ (signal 'unbound-slot (list (eieio-class-name class)
+ (eieio-object-name object)
slot-name fn)))
-(defgeneric no-applicable-method (object method &rest args)
- "Called if there are no implementations for OBJECT in METHOD.")
-
-(defmethod no-applicable-method ((object eieio-default-superclass)
- method &rest args)
- "Called if there are no implementations for OBJECT in METHOD.
-OBJECT is the object which has no method implementation.
-ARGS are the arguments that were passed to METHOD.
-
-Implement this for a class to block this signal. The return
-value becomes the return value of the original method call."
- (signal 'no-method-definition (list method (eieio-object-name object)))
- )
-
-(defgeneric no-next-method (object &rest args)
-"Called from `call-next-method' when no additional methods are available.")
-
-(defmethod no-next-method ((object eieio-default-superclass)
- &rest args)
- "Called from `call-next-method' when no additional methods are available.
-OBJECT is othe object being called on `call-next-method'.
-ARGS are the arguments it is called by.
-This method signals `no-next-method' by default. Override this
-method to not throw an error, and its return value becomes the
-return value of `call-next-method'."
- (signal 'no-next-method (list (eieio-object-name object) args))
- )
-
-(defgeneric clone (obj &rest params)
+(cl-defgeneric clone (obj &rest params)
"Make a copy of OBJ, and then supply PARAMS.
PARAMS is a parameter list of the same form used by `initialize-instance'.
When overloading `clone', be sure to call `call-next-method'
first and modify the returned object.")
-(defmethod clone ((obj eieio-default-superclass) &rest params)
+(cl-defmethod clone ((obj eieio-default-superclass) &rest params)
"Make a copy of OBJ, and then apply PARAMS."
- (let ((nobj (copy-sequence obj))
- (nm (eieio--object-name obj))
- (passname (and params (stringp (car params))))
- (num 1))
- (if params (shared-initialize nobj (if passname (cdr params) params)))
- (if (not passname)
- (save-match-data
- (if (string-match "-\\([0-9]+\\)" nm)
- (setq num (1+ (string-to-number (match-string 1 nm)))
- nm (substring nm 0 (match-beginning 0))))
- (setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
- (setf (eieio--object-name nobj) (car params)))
+ (let ((nobj (copy-sequence obj)))
+ (if (stringp (car params))
+ (funcall (if eieio-backward-compatibility #'ignore #'message)
+ "Obsolete name %S passed to clone" (pop params)))
+ (if params (shared-initialize nobj params))
nobj))
-(defgeneric destructor (this &rest params)
+(cl-defgeneric destructor (this &rest params)
"Destructor for cleaning up any dynamic links to our object.")
-(defmethod destructor ((this eieio-default-superclass) &rest params)
+(cl-defmethod destructor ((_this eieio-default-superclass) &rest _params)
"Destructor for cleaning up any dynamic links to our object.
Argument THIS is the object being destroyed. PARAMS are additional
ignored parameters."
;; No cleanup... yet.
)
-(defgeneric object-print (this &rest strings)
+(cl-defgeneric object-print (this &rest strings)
"Pretty printer for object THIS. Call function `object-name' with STRINGS.
It is sometimes useful to put a summary of the object into the
default #<notation> string when using EIEIO browsing tools.
Implement this method to customize the summary.")
-(defmethod object-print ((this eieio-default-superclass) &rest strings)
+(cl-defmethod object-print ((this eieio-default-superclass) &rest strings)
"Pretty printer for object THIS. Call function `object-name' with STRINGS.
The default method for printing object THIS is to use the
function `object-name'.
@@ -760,16 +844,16 @@ Implement this function and specify STRINGS in a call to
`call-next-method' to provide additional summary information.
When passing in extra strings from child classes, always remember
to prepend a space."
- (eieio-object-name this (apply 'concat strings)))
+ (eieio-object-name this (apply #'concat strings)))
(defvar eieio-print-depth 0
"When printing, keep track of the current indentation depth.")
-(defgeneric object-write (this &optional comment)
+(cl-defgeneric object-write (this &optional comment)
"Write out object THIS to the current stream.
Optional COMMENT will add comments to the beginning of the output.")
-(defmethod object-write ((this eieio-default-superclass) &optional comment)
+(cl-defmethod object-write ((this eieio-default-superclass) &optional comment)
"Write object THIS out to the current stream.
This writes out the vector version of this object. Complex and recursive
object are discouraged from being written.
@@ -782,44 +866,43 @@ this object."
(princ comment)
(princ "\n"))
(let* ((cl (eieio-object-class this))
- (cv (class-v cl)))
+ (cv (cl--find-class cl)))
;; 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.
(princ (make-string (* eieio-print-depth 2) ? ))
(princ "(")
- (princ (symbol-name (class-constructor (eieio-object-class this))))
+ (princ (symbol-name (eieio--class-constructor (eieio-object-class this))))
(princ " ")
(prin1 (eieio-object-name-string this))
(princ "\n")
;; Loop over all the public slots
- (let ((publa (eieio--class-public-a cv))
- (publd (eieio--class-public-d cv))
- (publp (eieio--class-public-printer cv))
+ (let ((slots (eieio--class-slots cv))
(eieio-print-depth (1+ eieio-print-depth)))
- (while publa
- (when (slot-boundp this (car publa))
- (let ((i (class-slot-initarg cl (car publa)))
- (v (eieio-oref this (car publa)))
- )
- (unless (or (not i) (equal v (car publd)))
- (unless (bolp)
- (princ "\n"))
- (princ (make-string (* eieio-print-depth 2) ? ))
- (princ (symbol-name i))
- (if (car publp)
- ;; Use our public printer
- (progn
- (princ " ")
- (funcall (car publp) v))
- ;; Use our generic override prin1 function.
- (princ (if (or (eieio-object-p v)
- (eieio-object-p (car-safe v)))
- "\n" " "))
- (eieio-override-prin1 v)))))
- (setq publa (cdr publa) publd (cdr publd)
- publp (cdr publp))))
+ (dotimes (i (length slots))
+ (let ((slot (aref slots i)))
+ (when (slot-boundp this (cl--slot-descriptor-name slot))
+ (let ((i (eieio--class-slot-initarg
+ cv (cl--slot-descriptor-name slot)))
+ (v (eieio-oref this (cl--slot-descriptor-name slot))))
+ (unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
+ (unless (bolp)
+ (princ "\n"))
+ (princ (make-string (* eieio-print-depth 2) ? ))
+ (princ (symbol-name i))
+ (if (alist-get :printer (cl--slot-descriptor-props slot))
+ ;; Use our public printer
+ (progn
+ (princ " ")
+ (funcall (alist-get :printer
+ (cl--slot-descriptor-props slot))
+ v))
+ ;; Use our generic override prin1 function.
+ (princ (if (or (eieio-object-p v)
+ (eieio-object-p (car-safe v)))
+ "\n" " "))
+ (eieio-override-prin1 v))))))))
(princ ")")
(when (= eieio-print-depth 0)
(princ "\n"))))
@@ -830,12 +913,8 @@ this object."
(object-write thing))
((consp thing)
(eieio-list-prin1 thing))
- ((class-p thing)
- (princ (eieio-class-name thing)))
- ((or (keywordp thing) (booleanp thing))
- (prin1 thing))
- ((symbolp thing)
- (princ (concat "'" (symbol-name thing))))
+ ((eieio--class-p thing)
+ (princ (eieio--class-print-name thing)))
(t (prin1 thing))))
(defun eieio-list-prin1 (list)
@@ -859,64 +938,42 @@ this object."
;;; Unimplemented functions from CLOS
;;
-(defun change-class (obj class)
+(defun change-class (_obj _class)
"Change the class of OBJ to type CLASS.
This may create or delete slots, but does not affect the return value
of `eq'."
(error "EIEIO: `change-class' is unimplemented"))
+;; Hook ourselves into help system for describing classes and methods.
+;; FIXME: This is not actually needed any more since we can click on the
+;; hyperlink from the constructor's docstring to see the type definition.
+(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor)
+
;;; Interfacing with edebug
;;
-(defun eieio-edebug-prin1-to-string (object &optional noescape)
+(defun eieio-edebug-prin1-to-string (print-function object &optional noescape)
"Display EIEIO OBJECT in fancy format.
-Overrides the edebug default.
-Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
- (cond ((class-p object) (eieio-class-name object))
+
+Used as advice around `edebug-prin1-to-string', held in the
+variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
+`prin1-to-string' when appropriate."
+ (cond ((eieio--class-p object) (eieio--class-print-name object))
((eieio-object-p object) (object-print object))
- ((and (listp object) (or (class-p (car object))
+ ((and (listp object) (or (eieio--class-p (car object))
(eieio-object-p (car object))))
- (concat "(" (mapconcat 'eieio-edebug-prin1-to-string object " ") ")"))
- (t (prin1-to-string object noescape))))
-
-(add-hook 'edebug-setup-hook
- (lambda ()
- (def-edebug-spec defmethod
- (&define ; this means we are defining something
- [&or name ("setf" :name setf name)]
- ;; ^^ This is the methods symbol
- [ &optional symbolp ] ; this is key :before etc
- list ; arguments
- [ &optional stringp ] ; documentation string
- def-body ; part to be debugged
- ))
- ;; The rest of the macros
- (def-edebug-spec oref (form quote))
- (def-edebug-spec oref-default (form quote))
- (def-edebug-spec oset (form quote form))
- (def-edebug-spec oset-default (form quote form))
- (def-edebug-spec class-v form)
- (def-edebug-spec class-p form)
- (def-edebug-spec eieio-object-p form)
- (def-edebug-spec class-constructor form)
- (def-edebug-spec generic-p form)
- (def-edebug-spec with-slots (list list def-body))
- ;; I suspect this isn't the best way to do this, but when
- ;; cust-print was used on my system all my objects
- ;; appeared as "#1 =" which was not useful. This allows
- ;; edebug to print my objects in the nice way they were
- ;; meant to with `object-print' and `class-name'
- ;; (defalias 'edebug-prin1-to-string 'eieio-edebug-prin1-to-string)
- )
- )
-
-;;; Autoloading some external symbols, and hooking into the help system
-;;
+ (concat "(" (mapconcat
+ (lambda (x) (eieio-edebug-prin1-to-string print-function x))
+ object " ")
+ ")"))
+ (t (funcall print-function object noescape))))
+
+(advice-add 'edebug-prin1-to-string
+ :around #'eieio-edebug-prin1-to-string)
;;; Start of automatically extracted autoloads.
-;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;; "928623502e8bf40454822355388542b5")
+;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "916f54b818479a77a02f3ecccda84a11")
;;; Generated autoloads from eieio-custom.el
(autoload 'customize-object "eieio-custom" "\
@@ -927,9 +984,7 @@ Optional argument GROUP is the sub-group of slots to display.
;;;***
-;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
-;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;; "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
+;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "d00419c898056fadf2f8e491f864aa1e")
;;; Generated autoloads from eieio-opt.el
(autoload 'eieio-browse "eieio-opt" "\
@@ -938,33 +993,13 @@ If optional ROOT-CLASS, then start with that, otherwise start with
variable `eieio-default-superclass'.
\(fn &optional ROOT-CLASS)" t nil)
-(defalias 'describe-class 'eieio-describe-class)
-
-(autoload 'eieio-describe-class "eieio-opt" "\
-Describe a CLASS defined by a string or symbol.
-If CLASS is actually an object, then also display current values of that object.
-Optional HEADERFCN should be called to insert a few bits of info first.
-
-\(fn CLASS &optional HEADERFCN)" t nil)
-
-(autoload 'eieio-describe-constructor "eieio-opt" "\
-Describe the constructor function FCN.
-Uses `eieio-describe-class' to describe the class being constructed.
-
-\(fn FCN)" t nil)
-(defalias 'describe-generic 'eieio-describe-generic)
-
-(autoload 'eieio-describe-generic "eieio-opt" "\
-Describe the generic function GENERIC.
-Also extracts information about all methods specific to this generic.
-\(fn GENERIC)" t nil)
+(define-obsolete-function-alias 'eieio-help-class 'cl--describe-class "25.1")
-(autoload 'eieio-help-mode-augmentation-maybee "eieio-opt" "\
-For buffers thrown into help mode, augment for EIEIO.
-Arguments UNUSED are not used.
+(autoload 'eieio-help-constructor "eieio-opt" "\
+Describe CTR if it is a class constructor.
-\(fn &rest UNUSED)" nil nil)
+\(fn CTR)" nil nil)
;;;***
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 4efbdcb22cb..bbc8e153f74 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,6 +1,6 @@
-;;; eldoc.el --- show function arglist or variable docstring in echo area
+;;; eldoc.el --- Show function arglist or variable docstring in echo area -*- lexical-binding:t; -*-
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Noah Friedman <friedman@splode.com>
;; Maintainer: friedman@splode.com
@@ -36,9 +36,10 @@
;; One useful way to enable this minor mode is to put the following in your
;; .emacs:
;;
-;; (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
-;; (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
-;; (add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)
+;; (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)
;; Major modes for other languages may use ElDoc by defining an
;; appropriate function as the buffer-local value of
@@ -46,8 +47,6 @@
;;; Code:
-(require 'help-fns) ;For fundoc-usage handling functions.
-
(defgroup eldoc nil
"Show function arglist or variable docstring in echo area."
:group 'lisp
@@ -62,24 +61,31 @@ If this variable is set to 0, no idle time is required."
:type 'number
:group 'eldoc)
+(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
+ :group 'eldoc)
+
;;;###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)
-(defcustom eldoc-argument-case 'upcase
+(defcustom eldoc-argument-case #'identity
"Case to display argument names of functions, as a symbol.
This has two preferred values: `upcase' or `downcase'.
Actually, any name of a function which takes a string as an argument and
returns another string is acceptable.
-Note that if `eldoc-documentation-function' is non-nil, this variable
-has no effect, unless the function handles it explicitly."
+Note that this variable has no effect, unless
+`eldoc-documentation-function' handles it explicitly."
:type '(radio (function-item upcase)
(function-item downcase)
function)
:group 'eldoc)
+(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.
@@ -96,8 +102,8 @@ 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 if `eldoc-documentation-function' is non-nil, this variable
-has no effect, unless the function handles it explicitly."
+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\
@@ -107,8 +113,8 @@ has no effect, unless the function handles it explicitly."
(defface eldoc-highlight-function-argument
'((t (:inherit bold)))
"Face used for the argument at point in a function's argument list.
-Note that if `eldoc-documentation-function' is non-nil, this face
-has no effect, unless the function handles it explicitly."
+Note that this face has no effect unless the `eldoc-documentation-function'
+handles it explicitly."
:group 'eldoc)
;;; No user options below here.
@@ -120,7 +126,8 @@ choose to increase the number of buckets, you must do so before loading
this file since the obarray is initialized at load time.
Remember to keep it a prime number to improve hash performance.")
-(defconst eldoc-message-commands
+(defvar eldoc-message-commands
+ ;; Don't define as `defconst' since it would then go to (read-only) purespace.
(make-vector eldoc-message-commands-table-size 0)
"Commands after which it is appropriate to print in the echo area.
ElDoc does not try to print function arglists, etc., after just any command,
@@ -131,12 +138,14 @@ This variable contains an obarray of symbols; do not manipulate it
directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
;; Not a constant.
-(defconst eldoc-last-data (make-vector 3 nil)
+(defvar eldoc-last-data (make-vector 3 nil)
+ ;; Don't define as `defconst' since it would then go to (read-only) purespace.
"Bookkeeping; elements are as follows:
0 - contains the last symbol read from the buffer.
1 - contains the string last displayed in the echo area for variables,
or argument string for functions.
- 2 - 'function if function args, 'variable if variable documentation.")
+ 2 - `function' if function args, `variable' if variable documentation.")
+(make-obsolete-variable 'eldoc-last-data "use your own instead" "25.1")
(defvar eldoc-last-message nil)
@@ -146,10 +155,20 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
"Idle time delay currently in use by timer.
This is used to determine if `eldoc-idle-delay' is changed by the user.")
-(defvar eldoc-message-function 'eldoc-minibuffer-message
+(defvar eldoc-message-function #'eldoc-minibuffer-message
"The function used by `eldoc-message' to display messages.
It should receive the same arguments as `message'.")
+(defun eldoc-edit-message-commands ()
+ (let ((cmds (make-vector 31 0))
+ (re (regexp-opt '("delete" "insert" "edit" "electric" "newline"))))
+ (mapatoms (lambda (s)
+ (and (commandp s)
+ (string-match-p re (symbol-name s))
+ (intern (symbol-name s) cmds)))
+ obarray)
+ cmds))
+
;;;###autoload
(define-minor-mode eldoc-mode
@@ -166,41 +185,50 @@ it displays the argument list of the function called in the
expression point is on."
:group 'eldoc :lighter eldoc-minor-mode-string
(setq eldoc-last-message nil)
- (if eldoc-mode
- (progn
- (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
- (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))
- (remove-hook 'post-command-hook 'eldoc-schedule-timer)
- (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area)))
+ (cond
+ ((memq eldoc-documentation-function '(nil ignore))
+ (message "There is no ElDoc support in this buffer")
+ (setq eldoc-mode nil))
+ (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))
+ (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))))
;;;###autoload
-(define-minor-mode eldoc-post-insert-mode nil
- :group 'eldoc :lighter (:eval (if eldoc-mode ""
- (concat eldoc-minor-mode-string "|i")))
+(define-minor-mode global-eldoc-mode
+ "Enable `eldoc-mode' in all buffers where it's applicable."
+ :group 'eldoc :global t
+ :initialize 'custom-initialize-delay
+ :init-value t
(setq eldoc-last-message nil)
- (let ((prn-info (lambda ()
- (unless eldoc-mode
- (eldoc-print-current-symbol-info)))))
- (if eldoc-post-insert-mode
- (add-hook 'post-self-insert-hook prn-info nil t)
- (remove-hook 'post-self-insert-hook prn-info t))))
-
-(add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-post-insert-mode)
+ (if global-eldoc-mode
+ (progn
+ (add-hook 'post-command-hook #'eldoc-schedule-timer)
+ (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))
+ (remove-hook 'post-command-hook #'eldoc-schedule-timer)
+ (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)))
;;;###autoload
-(defun turn-on-eldoc-mode ()
- "Unequivocally turn on ElDoc mode (see command `eldoc-mode')."
- (interactive)
- (eldoc-mode 1))
+(define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4")
(defun eldoc-schedule-timer ()
(or (and eldoc-timer
- (memq eldoc-timer timer-idle-list))
+ (memq eldoc-timer timer-idle-list)) ;FIXME: Why?
(setq eldoc-timer
(run-with-idle-timer
- eldoc-idle-delay t
- (lambda () (and eldoc-mode (eldoc-print-current-symbol-info))))))
+ eldoc-idle-delay nil
+ (lambda ()
+ (when (or eldoc-mode
+ (and global-eldoc-mode
+ (not (memq eldoc-documentation-function
+ '(nil ignore)))))
+ (eldoc-print-current-symbol-info))))))
;; If user has changed the idle delay, update the timer.
(cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
@@ -215,6 +243,11 @@ expression point is on."
Otherwise work like `message'."
(if (minibufferp)
(progn
+ (add-hook 'minibuffer-exit-hook
+ (lambda () (setq eldoc-mode-line-string nil
+ ;; http://debbugs.gnu.org/16920
+ eldoc-last-message nil))
+ nil t)
(with-current-buffer
(window-buffer
(or (window-in-direction 'above (minibuffer-window))
@@ -225,17 +258,11 @@ Otherwise work like `message'."
(setq mode-line-format
(list "" '(eldoc-mode-line-string
(" " eldoc-mode-line-string " "))
- mode-line-format))))
- (add-hook 'minibuffer-exit-hook
- (lambda () (setq eldoc-mode-line-string nil))
- nil t)
- (cond
- ((null format-string)
- (setq eldoc-mode-line-string nil))
- ((stringp format-string)
- (setq eldoc-mode-line-string
- (apply 'format format-string args))))
- (force-mode-line-update))
+ 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)))
(defun eldoc-message (&rest args)
@@ -247,7 +274,7 @@ Otherwise work like `message'."
;; eldoc-last-message so eq test above might succeed on
;; subsequent calls.
((null (cdr args)) (car args))
- (t (apply 'format args))))
+ (t (apply #'format-message args))))
;; 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.
@@ -258,6 +285,10 @@ Otherwise work like `message'."
(omessage (funcall eldoc-message-function nil)))))
eldoc-last-message)
+(defun eldoc--message-command-p (command)
+ (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,
;; which make eldoc messages flicker or disappear just before motion
@@ -266,8 +297,12 @@ Otherwise work like `message'."
;; This doesn't seem to be required for Emacs 19.28 and earlier.
(defun eldoc-pre-command-refresh-echo-area ()
(and eldoc-last-message
- (if (eldoc-display-message-no-interference-p)
- (eldoc-message 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
+ ;; 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.
@@ -277,22 +312,19 @@ Otherwise work like `message'."
;; 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.
- (and (not this-command)
- (symbolp last-command)
- (intern-soft (symbol-name last-command)
- eldoc-message-commands))))
+ (not this-command)
+ (eldoc--message-command-p last-command)))
+
;; Check various conditions about the current environment that might make
;; it undesirable to print eldoc messages right this instant.
(defun eldoc-display-message-no-interference-p ()
- (and eldoc-mode
- (not executing-kbd-macro)
- (not (and (boundp 'edebug-active) edebug-active))))
+ (not (or executing-kbd-macro (bound-and-true-p edebug-active))))
;;;###autoload
-(defvar eldoc-documentation-function nil
- "If non-nil, function to call to return doc string.
+(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.
@@ -304,252 +336,50 @@ 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.
-This variable is expected to be made buffer-local by modes (other than
-Emacs Lisp mode) that support ElDoc.")
+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
+return any documentation.")
(defun eldoc-print-current-symbol-info ()
- (condition-case err
- (and (or (eldoc-display-message-p) eldoc-post-insert-mode)
- (if eldoc-documentation-function
- (eldoc-message (funcall eldoc-documentation-function))
- (let* ((current-symbol (eldoc-current-symbol))
- (current-fnsym (eldoc-fnsym-in-current-sexp))
- (doc (cond
- ((null current-fnsym)
- nil)
- ((eq current-symbol (car current-fnsym))
- (or (apply 'eldoc-get-fnsym-args-string
- current-fnsym)
- (eldoc-get-var-docstring current-symbol)))
- (t
- (or (eldoc-get-var-docstring current-symbol)
- (apply 'eldoc-get-fnsym-args-string
- current-fnsym))))))
- (eldoc-message doc))))
- ;; This is run from post-command-hook or some idle timer thing,
- ;; so we need to be careful that errors aren't ignored.
- (error (message "eldoc error: %s" err))))
-
-(defun eldoc-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. Calls the functions
-`eldoc-function-argstring-format' and
-`eldoc-highlight-function-argument' to format the result. The
-former calls `eldoc-argument-case'; the latter gives the
-function name `font-lock-function-name-face', and optionally
-highlights argument number INDEX."
- (let (args doc advertised)
- (cond ((not (and sym (symbolp sym) (fboundp sym))))
- ((and (eq sym (aref eldoc-last-data 0))
- (eq 'function (aref eldoc-last-data 2)))
- (setq doc (aref eldoc-last-data 1)))
- ((listp (setq advertised (gethash (indirect-function sym)
- advertised-signature-table t)))
- (setq args advertised))
- ((setq doc (help-split-fundoc (documentation sym t) sym))
- (setq args (car doc))
- ;; Remove any enclosing (), since e-function-argstring adds them.
- (string-match "\\`[^ )]* ?" args)
- (setq args (substring args (match-end 0)))
- (if (string-match-p ")\\'" args)
- (setq args (substring args 0 -1))))
- (t
- (setq args (help-function-arglist sym))))
- (if args
- ;; Stringify, and store before highlighting, downcasing, etc.
- ;; FIXME should truncate before storing.
- (eldoc-last-data-store sym (setq args (eldoc-function-argstring args))
- 'function)
- (setq args doc)) ; use stored value
- ;; Change case, highlight, truncate.
- (if args
- (eldoc-highlight-function-argument
- sym (eldoc-function-argstring-format args) index))))
-
-(defun eldoc-highlight-function-argument (sym args index)
- "Highlight argument INDEX in ARGS list for function SYM.
-In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
- (let ((start nil)
- (end 0)
- (argument-face 'eldoc-highlight-function-argument))
- ;; Find the current argument in the argument string. We need to
- ;; handle `&rest' and informal `...' properly.
- ;;
- ;; FIXME: What to do with optional arguments, like in
- ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
- ;; The problem is there is no robust way to determine if
- ;; the current argument is indeed a docstring.
- (while (and index (>= index 1))
- (if (string-match "[^ ()]+" args end)
- (progn
- (setq start (match-beginning 0)
- end (match-end 0))
- (let ((argument (match-string 0 args)))
- (cond ((string= argument "&rest")
- ;; All the rest arguments are the same.
- (setq index 1))
- ((string= argument "&optional"))
- ((string-match-p "\\.\\.\\.$" argument)
- (setq index 0))
- (t
- (setq index (1- index))))))
- (setq end (length args)
- start (1- end)
- argument-face 'font-lock-warning-face
- index 0)))
- (let ((doc args))
- (when start
- (setq doc (copy-sequence args))
- (add-text-properties start end (list 'face argument-face) doc))
- (setq doc (eldoc-docstring-format-sym-doc
- sym doc (if (functionp sym) 'font-lock-function-name-face
- 'font-lock-keyword-face)))
- doc)))
-
-;; Return a string containing a brief (one-line) documentation string for
-;; the variable.
-(defun eldoc-get-var-docstring (sym)
- (when sym
- (cond ((and (eq sym (aref eldoc-last-data 0))
- (eq 'variable (aref eldoc-last-data 2)))
- (aref eldoc-last-data 1))
- (t
- (let ((doc (documentation-property sym 'variable-documentation t)))
- (cond (doc
- (setq doc (eldoc-docstring-format-sym-doc
- sym (eldoc-docstring-first-line doc)
- 'font-lock-variable-name-face))
- (eldoc-last-data-store sym doc 'variable)))
- doc)))))
-
-(defun eldoc-last-data-store (symbol doc type)
- (aset eldoc-last-data 0 symbol)
- (aset eldoc-last-data 1 doc)
- (aset eldoc-last-data 2 type))
-
-;; Note that any leading `*' in the docstring (which indicates the variable
-;; is a user option) is removed.
-(defun eldoc-docstring-first-line (doc)
- (and (stringp doc)
- (substitute-command-keys
- (save-match-data
- ;; Don't use "^" in the regexp below since it may match
- ;; anywhere in the doc-string.
- (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
- (cond ((string-match "\n" doc)
- (substring doc start (match-beginning 0)))
- ((zerop start) doc)
- (t (substring doc start))))))))
+ ;; 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"
+ (and (or (eldoc-display-message-p)
+ ;; Erase the last message if we won't display a new one.
+ (when eldoc-last-message
+ (eldoc-message nil)
+ nil))
+ (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 (sym doc face)
- (save-match-data
- (let* ((name (symbol-name sym))
- (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 name) (length ": ") (length doc)) ea-width)))
- (cond ((or (<= strip 0)
- (eq ea-multi t)
- (and ea-multi (> (length doc) ea-width)))
- (format "%s: %s" (propertize name 'face face) doc))
- ((> (length doc) ea-width)
- (substring (format "%s" doc) 0 ea-width))
- ((>= strip (length name))
- (format "%s" 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.
- (setq name (substring name strip))
- (format "%s: %s" (propertize name 'face face) doc))))))
-
-
-;; Return a list of current function name and argument index.
-(defun eldoc-fnsym-in-current-sexp ()
- (save-excursion
- (let ((argument-index (1- (eldoc-beginning-of-sexp))))
- ;; If we are at the beginning of function name, this will be -1.
- (when (< argument-index 0)
- (setq argument-index 0))
- ;; Don't do anything if current word is inside a string.
- (if (= (or (char-after (1- (point))) 0) ?\")
- nil
- (list (eldoc-current-symbol) argument-index)))))
-
-;; Move to the beginning of current sexp. Return the number of nested
-;; sexp the point was over or after.
-(defun eldoc-beginning-of-sexp ()
- (let ((parse-sexp-ignore-comments t)
- (num-skipped-sexps 0))
- (condition-case err
- (progn
- ;; First account for the case the point is directly over a
- ;; beginning of a nested sexp.
- (condition-case err
- (let ((p (point)))
- (forward-sexp -1)
- (forward-sexp 1)
- (when (< (point) p)
- (setq num-skipped-sexps 1)))
- (error))
- (while
- (let ((p (point)))
- (forward-sexp -1)
- (when (< (point) p)
- (setq num-skipped-sexps (1+ num-skipped-sexps))))))
- (error))
- num-skipped-sexps))
-
-;; returns nil unless current word is an interned symbol.
-(defun eldoc-current-symbol ()
- (let ((c (char-after (point))))
- (and c
- (memq (char-syntax c) '(?w ?_))
- (intern-soft (current-word)))))
-
-;; Do indirect function resolution if possible.
-(defun eldoc-symbol-function (fsym)
- (let ((defn (and (fboundp fsym)
- (symbol-function fsym))))
- (and (symbolp defn)
- (condition-case err
- (setq defn (indirect-function fsym))
- (error (setq defn nil))))
- defn))
-
-(defun eldoc-function-argstring (arglist)
- "Return ARGLIST as a string enclosed by ().
-ARGLIST is either a string, or a list of strings or symbols."
- (cond ((stringp arglist))
- ((not (listp arglist))
- (setq arglist nil))
- ((symbolp (car arglist))
- (setq arglist
- (mapconcat (lambda (s) (symbol-name s))
- arglist " ")))
- ((stringp (car arglist))
- (setq arglist
- (mapconcat (lambda (s) s)
- arglist " "))))
- (if arglist
- (format "(%s)" arglist)))
-
-(defun eldoc-function-argstring-format (argstring)
- "Apply `eldoc-argument-case' to each word in ARGSTRING.
-The words \"&rest\", \"&optional\" are returned unchanged."
- (mapconcat (lambda (s)
- (if (string-match-p "\\`(?&\\(?:optional\\|rest\\))?\\'" s)
- s
- (funcall eldoc-argument-case s)))
- (split-string argstring) " "))
+(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
+ (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)))))
-
;; 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
@@ -564,7 +394,7 @@ The words \"&rest\", \"&optional\" are returned unchanged."
(defun eldoc-add-command-completions (&rest names)
(dolist (name names)
- (apply 'eldoc-add-command (all-completions name obarray 'commandp))))
+ (apply #'eldoc-add-command (all-completions name obarray 'commandp))))
(defun eldoc-remove-command (&rest cmds)
(dolist (name cmds)
@@ -574,12 +404,13 @@ The words \"&rest\", \"&optional\" are returned unchanged."
(defun eldoc-remove-command-completions (&rest names)
(dolist (name names)
- (apply 'eldoc-remove-command
+ (apply #'eldoc-remove-command
(all-completions name eldoc-message-commands))))
;; Prime the command list.
(eldoc-add-command-completions
+ "back-to-indentation"
"backward-" "beginning-of-" "delete-other-windows" "delete-window"
"down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-"
"handle-select-window" "indent-for-tab-command" "left-" "mark-page"
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index 7998f732f06..64d65c05902 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -1,6 +1,6 @@
;;; elint.el --- Lint Emacs Lisp
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter Liljenberg <petli@lysator.liu.se>
;; Created: May 1997
@@ -46,8 +46,6 @@
;;; Code:
-(require 'help-fns)
-
(defgroup elint nil
"Linting for Emacs Lisp."
:prefix "elint-"
@@ -251,9 +249,9 @@ This environment can be passed to `macroexpand'."
(elint-set-mode-line t)
(with-current-buffer elint-log-buffer
(unless (string-equal default-directory dir)
- (elint-log-message (format " \nLeaving directory `%s'"
- default-directory) t)
- (elint-log-message (format "Entering directory `%s'" dir) t)
+ (elint-log-message (format-message " \nLeaving directory `%s'"
+ default-directory) t)
+ (elint-log-message (format-message "Entering directory `%s'" dir) t)
(setq default-directory dir))))
(let ((str (format "Linting file %s" file)))
(message "%s..." str)
@@ -374,9 +372,9 @@ Returns the forms."
(let ((elint-current-pos (point)))
;; non-list check could be here too. errors may be out of seq.
;; quoted check cannot be elsewhere, since quotes skipped.
- (if (looking-back "'")
+ (if (looking-back "'" (1- (point)))
;; Eg cust-print.el uses ' as a comment syntax.
- (elint-warning "Skipping quoted form `'%.20s...'"
+ (elint-warning "Skipping quoted form `%c%.20s...'" ?\'
(read (current-buffer)))
(condition-case nil
(setq tops (cons
@@ -385,7 +383,7 @@ Returns the forms."
tops))
(end-of-file
(goto-char elint-current-pos)
- (error "Missing ')' in top form: %s"
+ (error "Missing `)' in top form: %s"
(buffer-substring elint-current-pos
(line-end-position))))))))
(nreverse tops))))
@@ -522,7 +520,7 @@ Return nil if there are no more forms, t otherwise."
;;; (with-syntax-table emacs-lisp-mode-syntax-table
;;; (elint-update-env))
;;; (setq env (elint-env-add-env env elint-buffer-env))))
- ;;(message "Elint processed (require '%s)" name))
+ ;;(message "%s" (format "Elint processed (require '%s)" name))
(error "%s.el not found in load-path" libname)))
(error
(message "Can't get variables from require'd library %s: %s"
@@ -984,7 +982,7 @@ Does basic handling of `featurep' tests."
(line-beginning-position))))
0) ; unknown position
type
- (apply 'format string args))))
+ (apply #'format-message string args))))
(defun elint-error (string &rest args)
"Report a linting error.
@@ -1145,8 +1143,8 @@ Marks the function with their arguments, and returns a list of variables."
(defun elint-find-builtins ()
"Return a list of all built-in functions."
(let (subrs)
- (mapatoms (lambda (s) (and (fboundp s) (subrp (symbol-function s))
- (setq subrs (cons s subrs)))))
+ (mapatoms (lambda (s) (and (subrp (symbol-function s))
+ (push s subrs))))
subrs))
(defun elint-find-builtin-args (&optional list)
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index f1321eb4e6d..39d62ad34a0 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,10 +1,10 @@
;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997-1998, 2001-2013 Free Software
+;; Copyright (C) 1994-1995, 1997-1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Barry A. Warsaw
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 26-Feb-1994
;; Keywords: debugging lisp tools
@@ -251,7 +251,7 @@ FUNSYM must be a symbol of a defined function."
;; Set the symbol's new profiling function definition to run
;; ELP wrapper.
(advice-add funsym :around (elp--make-wrapper funsym)
- `((name . ,elp--advice-name)))))
+ `((name . ,elp--advice-name) (depth . -99)))))
(defun elp--instrumented-p (sym)
(advice-member-p elp--advice-name sym))
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 531e83c1e6a..f899f40fb80 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -1,6 +1,6 @@
;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*-
-;; Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2015 Free Software Foundation, Inc.
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Christian Ohler <ohler@gnu.org>
@@ -137,7 +137,7 @@ the name of the test and the result of NAME-FORM."
This effectively executes
- \(apply (car COMMAND) (cdr COMMAND)\)
+ (apply (car COMMAND) (cdr COMMAND))
and returns the same value, but additionally runs hooks like
`pre-command-hook' and `post-command-hook', and sets variables
@@ -189,7 +189,7 @@ test for `called-interactively' in the command will fail."
"Return a copy of S with all matches of REGEXPS removed.
Elements of REGEXPS may also be two-element lists \(REGEXP
-SUBEXP\), where SUBEXP is the number of a subexpression in
+SUBEXP), where SUBEXP is the number of a subexpression in
REGEXP. In that case, only that subexpression will be removed
rather than the entire match."
;; Use a temporary buffer since replace-match copies strings, which
@@ -214,8 +214,8 @@ property list, or no properties if there is no plist before it.
As a simple example,
-\(ert-propertized-string \"foo \" '(face italic) \"bar\" \" baz\" nil \
-\" quux\"\)
+\(ert-propertized-string \"foo \" \\='(face italic) \"bar\" \" baz\" nil \
+\" quux\")
would return the string \"foo bar baz quux\" where the substring
\"bar baz\" has a `face' property with the value `italic'.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 98576687f3d..21c1f1be394 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,6 +1,6 @@
;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2015 Free Software Foundation, Inc.
;; Author: Christian Ohler <ohler@gnu.org>
;; Keywords: lisp, tools
@@ -34,14 +34,17 @@
;; `ert-run-tests-batch-and-exit' for non-interactive use.
;;
;; The body of `ert-deftest' forms resembles a function body, but the
-;; additional operators `should', `should-not' and `should-error' are
-;; available. `should' is similar to cl's `assert', but signals a
-;; different error when its condition is violated that is caught and
-;; processed by ERT. In addition, it analyzes its argument form and
-;; records information that helps debugging (`assert' tries to do
-;; something similar when its second argument SHOW-ARGS is true, but
-;; `should' is more sophisticated). For information on `should-not'
-;; and `should-error', see their docstrings.
+;; additional operators `should', `should-not', `should-error' and
+;; `skip-unless' are available. `should' is similar to cl's `assert',
+;; but signals a different error when its condition is violated that
+;; is caught and processed by ERT. In addition, it analyzes its
+;; argument form and records information that helps debugging
+;; (`assert' tries to do something similar when its second argument
+;; SHOW-ARGS is true, but `should' is more sophisticated). For
+;; information on `should-not' and `should-error', see their
+;; docstrings. `skip-unless' skips the test immediately without
+;; processing further, this is useful for checking the test
+;; environment (like availability of features, external binaries, etc).
;;
;; See ERT's info manual as well as the docstrings for more details.
;; To compile the manual, run `makeinfo ert.texinfo' in the ERT
@@ -61,7 +64,7 @@
(require 'ewoc)
(require 'find-func)
(require 'help)
-
+(require 'pp)
;;; UI customization options.
@@ -174,8 +177,8 @@ and the body."
BODY is evaluated as a `progn' when the test is run. It should
signal a condition on failure or just return if the test passes.
-`should', `should-not' and `should-error' are useful for
-assertions in BODY.
+`should', `should-not', `should-error' and `skip-unless' are
+useful for assertions in BODY.
Use `ert' to run tests interactively.
@@ -184,7 +187,7 @@ using :expected-result. See `ert-test-result-type-p' for a
description of valid values for RESULT-TYPE.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
-\[:tags '(TAG...)] BODY...)"
+[:tags '(TAG...)] BODY...)"
(declare (debug (&define :name test
name sexp [&optional stringp]
[&rest keywordp sexp] def-body))
@@ -200,7 +203,7 @@ description of valid values for RESULT-TYPE.
(tags nil tags-supplied-p))
body)
(ert--parse-keys-and-body docstring-keys-and-body)
- `(progn
+ `(cl-macrolet ((skip-unless (form) `(ert--skip-unless ,form)))
(ert-set-test ',name
(make-ert-test
:name ',name
@@ -237,6 +240,7 @@ description of valid values for RESULT-TYPE.
(define-error 'ert-test-failed "Test failed")
+(define-error 'ert-test-skipped "Test skipped")
(defun ert-pass ()
"Terminate the current test and mark it passed. Does not return."
@@ -247,6 +251,11 @@ description of valid values for RESULT-TYPE.
DATA is displayed to the user and should state the reason of the failure."
(signal 'ert-test-failed (list data)))
+(defun ert-skip (data)
+ "Terminate the current test and mark it skipped. Does not return.
+DATA is displayed to the user and should state the reason for skipping."
+ (signal 'ert-test-skipped (list data)))
+
;;; The `should' macros.
@@ -260,7 +269,7 @@ DATA is displayed to the user and should state the reason of the failure."
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
(and (symbolp thing)
- (let ((definition (indirect-function thing t)))
+ (let ((definition (indirect-function thing)))
(and (subrp definition)
(eql (cdr (subr-arity definition)) 'unevalled)))))
@@ -425,6 +434,15 @@ failed."
(list
:fail-reason "did not signal an error")))))))))
+(cl-defmacro ert--skip-unless (form)
+ "Evaluate FORM. If it returns nil, skip the current test.
+Errors during evaluation are caught and handled like nil."
+ (declare (debug t))
+ (ert--expand-should `(skip-unless ,form) form
+ (lambda (inner-form form-description-form _value-var)
+ `(unless (ignore-errors ,inner-form)
+ (ert-skip ,form-description-form)))))
+
;;; Explanation of `should' failures.
@@ -644,6 +662,7 @@ and is displayed in front of the value of MESSAGE-FORM."
(infos (cl-assert nil)))
(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition)))
(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(cl-defstruct (ert-test-skipped (:include ert-test-result-with-condition)))
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
@@ -728,6 +747,7 @@ run. ARGS are the arguments to `debugger'."
(let* ((condition (car more-debugger-args))
(type (cl-case (car condition)
((quit) 'quit)
+ ((ert-test-skipped) 'skipped)
(otherwise 'failed)))
(backtrace (ert--record-backtrace))
(infos (reverse ert--infos)))
@@ -737,6 +757,10 @@ run. ARGS are the arguments to `debugger'."
(make-ert-test-quit :condition condition
:backtrace backtrace
:infos infos))
+ (skipped
+ (make-ert-test-skipped :condition condition
+ :backtrace backtrace
+ :infos infos))
(failed
(make-ert-test-failed :condition condition
:backtrace backtrace
@@ -785,7 +809,7 @@ This mainly sets up debugger-related bindings."
"Immediately truncate *Messages* buffer according to `message-log-max'.
This can be useful after reducing the value of `message-log-max'."
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (messages-buffer)
;; This is a reimplementation of this part of message_dolog() in xdisp.c:
;; if (NATNUMP (Vmessage_log_max))
;; {
@@ -798,7 +822,8 @@ This can be useful after reducing the value of `message-log-max'."
(end (save-excursion
(goto-char (point-max))
(forward-line (- message-log-max))
- (point))))
+ (point)))
+ (inhibit-read-only t))
(delete-region begin end)))))
(defvar ert--running-tests nil
@@ -818,7 +843,7 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
(setf (ert-test-most-recent-result ert-test) nil)
(cl-block error
(let ((begin-marker
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (messages-buffer)
(point-max-marker))))
(unwind-protect
(let ((info (make-ert--test-execution-info
@@ -837,7 +862,7 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
(ert--run-test-internal info))
(let ((result (ert--test-execution-info-result info)))
(setf (ert-test-result-messages result)
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (messages-buffer)
(buffer-substring begin-marker (point-max))))
(ert--force-message-log-buffer-truncation)
(setq should-form-accu (nreverse should-form-accu))
@@ -861,11 +886,11 @@ Valid result types:
nil -- Never matches.
t -- Always matches.
-:failed, :passed -- Matches corresponding results.
-\(and TYPES...\) -- Matches if all TYPES match.
-\(or TYPES...\) -- Matches if some TYPES match.
-\(not TYPE\) -- Matches if TYPE does not match.
-\(satisfies PREDICATE\) -- Matches if PREDICATE returns true when called with
+:failed, :passed, :skipped -- Matches corresponding results.
+\(and TYPES...) -- Matches if all TYPES match.
+\(or TYPES...) -- Matches if some TYPES match.
+\(not TYPE) -- Matches if TYPE does not match.
+\(satisfies PREDICATE) -- Matches if PREDICATE returns true when called with
RESULT."
;; It would be easy to add `member' and `eql' types etc., but I
;; haven't bothered yet.
@@ -874,6 +899,7 @@ t -- Always matches.
((member t) t)
((member :failed) (ert-test-failed-p result))
((member :passed) (ert-test-passed-p result))
+ ((member :skipped) (ert-test-skipped-p result))
(cons
(cl-destructuring-bind (operator &rest operands) result-type
(cl-ecase operator
@@ -898,7 +924,9 @@ t -- Always matches.
(defun ert-test-result-expected-p (test result)
"Return non-nil if TEST's expected result type matches RESULT."
- (ert-test-result-type-p result (ert-test-expected-result-type test)))
+ (or
+ (ert-test-result-type-p result :skipped)
+ (ert-test-result-type-p result (ert-test-expected-result-type test))))
(defun ert-select-tests (selector universe)
"Return a list of tests that match SELECTOR.
@@ -918,7 +946,7 @@ a test -- (i.e., an object of the ert-test data-type) Selects that test.
a symbol -- Selects the test that the symbol names, errors if none.
\(member TESTS...) -- Selects the elements of TESTS, a list of tests
or symbols naming tests.
-\(eql TEST\) -- Selects TEST, a test or a symbol naming a test.
+\(eql TEST) -- Selects TEST, a test or a symbol naming a test.
\(and SELECTORS...) -- Selects the tests that match all SELECTORS.
\(or SELECTORS...) -- Selects the tests that match any of the SELECTORS.
\(not SELECTOR) -- Selects all tests that do not match SELECTOR.
@@ -971,7 +999,8 @@ contained in UNIVERSE."
(list (cl-remove-if-not (lambda (test)
(and (ert-test-name test)
(string-match selector
- (ert-test-name test))))
+ (symbol-name
+ (ert-test-name test)))))
universe))))
(ert-test (list selector))
(symbol
@@ -1084,6 +1113,7 @@ contained in UNIVERSE."
(passed-unexpected 0)
(failed-expected 0)
(failed-unexpected 0)
+ (skipped 0)
(start-time nil)
(end-time nil)
(aborted-p nil)
@@ -1102,10 +1132,15 @@ contained in UNIVERSE."
(+ (ert--stats-passed-unexpected stats)
(ert--stats-failed-unexpected stats)))
+(defun ert-stats-skipped (stats)
+ "Number of tests in STATS that have skipped."
+ (ert--stats-skipped stats))
+
(defun ert-stats-completed (stats)
"Number of tests in STATS that have run so far."
(+ (ert-stats-completed-expected stats)
- (ert-stats-completed-unexpected stats)))
+ (ert-stats-completed-unexpected stats)
+ (ert-stats-skipped stats)))
(defun ert-stats-total (stats)
"Number of tests in STATS, regardless of whether they have run yet."
@@ -1137,6 +1172,8 @@ Also changes the counters in STATS to match."
(cl-incf (ert--stats-passed-expected stats) d))
(ert-test-failed
(cl-incf (ert--stats-failed-expected stats) d))
+ (ert-test-skipped
+ (cl-incf (ert--stats-skipped stats) d))
(null)
(ert-test-aborted-with-non-local-exit)
(ert-test-quit))
@@ -1145,6 +1182,8 @@ Also changes the counters in STATS to match."
(cl-incf (ert--stats-passed-unexpected stats) d))
(ert-test-failed
(cl-incf (ert--stats-failed-unexpected stats) d))
+ (ert-test-skipped
+ (cl-incf (ert--stats-skipped stats) d))
(null)
(ert-test-aborted-with-non-local-exit)
(ert-test-quit)))))
@@ -1239,6 +1278,7 @@ EXPECTEDP specifies whether the result was expected."
(let ((s (cl-etypecase result
(ert-test-passed ".P")
(ert-test-failed "fF")
+ (ert-test-skipped "sS")
(null "--")
(ert-test-aborted-with-non-local-exit "aA")
(ert-test-quit "qQ"))))
@@ -1251,6 +1291,7 @@ EXPECTEDP specifies whether the result was expected."
(let ((s (cl-etypecase result
(ert-test-passed '("passed" "PASSED"))
(ert-test-failed '("failed" "FAILED"))
+ (ert-test-skipped '("skipped" "SKIPPED"))
(null '("unknown" "UNKNOWN"))
(ert-test-aborted-with-non-local-exit '("aborted" "ABORTED"))
(ert-test-quit '("quit" "QUIT")))))
@@ -1259,7 +1300,8 @@ EXPECTEDP specifies whether the result was expected."
(defun ert--pp-with-indentation-and-newline (object)
"Pretty-print OBJECT, indenting it to the current column of point.
Ensures a final newline is inserted."
- (let ((begin (point)))
+ (let ((begin (point))
+ (pp-escape-newlines nil))
(pp object (current-buffer))
(unless (bolp) (insert "\n"))
(save-excursion
@@ -1279,7 +1321,7 @@ RESULT must be an `ert-test-result-with-condition'."
(unwind-protect
(progn
(insert message "\n")
- (setq end (copy-marker (point)))
+ (setq end (point-marker))
(goto-char begin)
(insert " " prefix)
(forward-line 1)
@@ -1317,8 +1359,9 @@ Returns the stats object."
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
(let ((unexpected (ert-stats-completed-unexpected stats))
- (expected-failures (ert--stats-failed-expected stats)))
- (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
+ (skipped (ert-stats-skipped stats))
+ (expected-failures (ert--stats-failed-expected stats)))
+ (message "\n%sRan %s tests, %s results as expected%s%s (%s)%s\n"
(if (not abortedp)
""
"Aborted: ")
@@ -1327,6 +1370,9 @@ Returns the stats object."
(if (zerop unexpected)
""
(format ", %s unexpected" unexpected))
+ (if (zerop skipped)
+ ""
+ (format ", %s skipped" skipped))
(ert--format-time-iso8601 (ert--stats-end-time stats))
(if (zerop expected-failures)
""
@@ -1339,6 +1385,15 @@ Returns the stats object."
(message "%9s %S"
(ert-string-for-test-result result nil)
(ert-test-name test))))
+ (message "%s" ""))
+ (unless (zerop skipped)
+ (message "%s skipped results:" skipped)
+ (cl-loop for test across (ert--stats-tests stats)
+ for result = (ert-test-most-recent-result test) do
+ (when (ert-test-result-type-p result :skipped)
+ (message "%9s %S"
+ (ert-string-for-test-result result nil)
+ (ert-test-name test))))
(message "%s" "")))))
(test-started
)
@@ -1409,13 +1464,72 @@ the tests)."
(kill-emacs 2))))
+(defun ert-summarize-tests-batch-and-exit ()
+ "Summarize the results of testing.
+Expects to be called in batch mode, with logfiles as command-line arguments.
+The logfiles should have the `ert-run-tests-batch' format. When finished,
+this exits Emacs, with status as per `ert-run-tests-batch-and-exit'."
+ (or noninteractive
+ (user-error "This function is only for use in batch mode"))
+ (let ((nlogs (length command-line-args-left))
+ (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0)
+ nnotrun logfile notests badtests unexpected)
+ (with-temp-buffer
+ (while (setq logfile (pop command-line-args-left))
+ (erase-buffer)
+ (insert-file-contents logfile)
+ (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t))
+ (push logfile notests)
+ (setq ntests (+ ntests (string-to-number (match-string 1))))
+ (if (not (re-search-forward "^\\(Aborted: \\)?\
+Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
+\\(?:, \\([0-9]+\\) unexpected\\)?\
+\\(?:, \\([0-9]+\\) skipped\\)?" nil t))
+ (push logfile badtests)
+ (if (match-string 1) (push logfile badtests))
+ (setq nrun (+ nrun (string-to-number (match-string 2)))
+ nexpected (+ nexpected (string-to-number (match-string 3))))
+ (when (match-string 4)
+ (push logfile unexpected)
+ (setq nunexpected (+ nunexpected
+ (string-to-number (match-string 4)))))
+ (if (match-string 5)
+ (setq nskipped (+ nskipped
+ (string-to-number (match-string 5)))))))))
+ (setq nnotrun (- ntests nrun))
+ (message "\nSUMMARY OF TEST RESULTS")
+ (message "-----------------------")
+ (message "Files examined: %d" nlogs)
+ (message "Ran %d tests%s, %d results as expected%s%s"
+ nrun
+ (if (zerop nnotrun) "" (format ", %d failed to run" nnotrun))
+ nexpected
+ (if (zerop nunexpected)
+ ""
+ (format ", %d unexpected" nunexpected))
+ (if (zerop nskipped)
+ ""
+ (format ", %d skipped" nskipped)))
+ (when notests
+ (message "%d files did not contain any tests:" (length notests))
+ (mapc (lambda (l) (message " %s" l)) notests))
+ (when badtests
+ (message "%d files did not finish:" (length badtests))
+ (mapc (lambda (l) (message " %s" l)) badtests))
+ (when unexpected
+ (message "%d files contained unexpected results:" (length unexpected))
+ (mapc (lambda (l) (message " %s" l)) unexpected))
+ (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2)
+ (unexpected 1)
+ (t 0)))))
+
;;; Utility functions for load/unload actions.
(defun ert--activate-font-lock-keywords ()
"Activate font-lock keywords for some of ERT's symbols."
(font-lock-add-keywords
nil
- '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\sw+\\)?"
+ '(("(\\(\\<ert-deftest\\)\\>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face nil t)
(2 font-lock-function-name-face nil t)))))
@@ -1561,15 +1675,17 @@ Also sets `ert--results-progress-bar-button-begin'."
(ert--insert-human-readable-selector (ert--stats-selector stats))
(insert "\n")
(insert
- (format (concat "Passed: %s\n"
- "Failed: %s\n"
- "Total: %s/%s\n\n")
+ (format (concat "Passed: %s\n"
+ "Failed: %s\n"
+ "Skipped: %s\n"
+ "Total: %s/%s\n\n")
(ert--results-format-expected-unexpected
(ert--stats-passed-expected stats)
(ert--stats-passed-unexpected stats))
(ert--results-format-expected-unexpected
(ert--stats-failed-expected stats)
(ert--stats-failed-unexpected stats))
+ (ert-stats-skipped stats)
run-count
(ert-stats-total stats)))
(insert
@@ -1734,7 +1850,9 @@ non-nil, returns the face for expected results.."
(when (ert-test-documentation test)
(insert " "
(propertize
- (ert--string-first-line (ert-test-documentation test))
+ (ert--string-first-line
+ (substitute-command-keys
+ (ert-test-documentation test)))
'font-lock-face 'font-lock-doc-face)
"\n"))
(cl-etypecase result
@@ -1826,11 +1944,12 @@ and how to display message."
;; defined without cl.
(car ert--selector-history)
"t")))
- (read-from-minibuffer (if (null default)
- "Run tests: "
- (format "Run tests (default %s): " default))
- nil nil t 'ert--selector-history
- default nil))
+ (read
+ (completing-read (if (null default)
+ "Run tests: "
+ (format "Run tests (default %s): " default))
+ obarray #'ert-test-boundp nil nil
+ 'ert--selector-history default nil)))
nil))
(unless message-fn (setq message-fn 'message))
(let ((output-buffer-name output-buffer-name)
@@ -1849,7 +1968,7 @@ and how to display message."
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
(funcall message-fn
- "%sRan %s tests, %s results were as expected%s"
+ "%sRan %s tests, %s results were as expected%s%s"
(if (not abortedp)
""
"Aborted: ")
@@ -1859,7 +1978,12 @@ and how to display message."
(ert-stats-completed-unexpected stats)))
(if (zerop unexpected)
""
- (format ", %s unexpected" unexpected))))
+ (format ", %s unexpected" unexpected)))
+ (let ((skipped
+ (ert-stats-skipped stats)))
+ (if (zerop skipped)
+ ""
+ (format ", %s skipped" skipped))))
(ert--results-update-stats-display (with-current-buffer buffer
ert--results-ewoc)
stats)))
@@ -2254,9 +2378,9 @@ To be used in the ERT results buffer."
(ert--print-backtrace backtrace)
(debugger-make-xrefs)
(goto-char (point-min))
- (insert "Backtrace for test `")
+ (insert (substitute-command-keys "Backtrace for test `"))
(ert-insert-test-name-button (ert-test-name test))
- (insert "':\n")))))))
+ (insert (substitute-command-keys "':\n"))))))))
(defun ert-results-pop-to-messages-for-test-at-point ()
"Display the part of the *Messages* buffer generated during the test at point.
@@ -2275,9 +2399,9 @@ To be used in the ERT results buffer."
(ert-simple-view-mode)
(insert (ert-test-result-messages result))
(goto-char (point-min))
- (insert "Messages for test `")
+ (insert (substitute-command-keys "Messages for test `"))
(ert-insert-test-name-button (ert-test-name test))
- (insert "':\n")))))
+ (insert (substitute-command-keys "':\n"))))))
(defun ert-results-pop-to-should-forms-for-test-at-point ()
"Display the list of `should' forms executed during the test at point.
@@ -2305,9 +2429,10 @@ To be used in the ERT results buffer."
(ert--pp-with-indentation-and-newline form-description)
(ert--make-xrefs-region begin (point)))))
(goto-char (point-min))
- (insert "`should' forms executed during test `")
+ (insert (substitute-command-keys
+ "`should' forms executed during test `"))
(ert-insert-test-name-button (ert-test-name test))
- (insert "':\n")
+ (insert (substitute-command-keys "':\n"))
(insert "\n")
(insert (concat "(Values are shallow copies and may have "
"looked different during the test if they\n"
@@ -2384,9 +2509,11 @@ To be used in the ERT results buffer."
(let ((file-name (and test-name
(symbol-file test-name 'ert-deftest))))
(when file-name
- (insert " defined in `" (file-name-nondirectory file-name) "'")
+ (insert (format-message " defined in `%s'"
+ (file-name-nondirectory file-name)))
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function-def test-name file-name)))
(insert ".")
(fill-region-as-paragraph (point-min) (point))
@@ -2398,8 +2525,9 @@ To be used in the ERT results buffer."
"this documentation refers to an old definition.")
(fill-region-as-paragraph begin (point)))
(insert "\n\n"))
- (insert (or (ert-test-documentation test-definition)
- "It is not documented.")
+ (insert (substitute-command-keys
+ (or (ert-test-documentation test-definition)
+ "It is not documented."))
"\n")))))))
(defun ert-results-describe-test-at-point ()
@@ -2416,7 +2544,7 @@ To be used in the ERT results buffer."
(add-to-list 'minor-mode-alist '(ert--current-run-stats
(:eval
(ert--tests-running-mode-line-indicator))))
-(add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords)
+(add-hook 'emacs-lisp-mode-hook #'ert--activate-font-lock-keywords)
(defun ert--unload-function ()
"Unload function to undo the side-effects of loading ert.el."
@@ -2427,7 +2555,7 @@ To be used in the ERT results buffer."
nil)
(defvar ert-unload-hook '())
-(add-hook 'ert-unload-hook 'ert--unload-function)
+(add-hook 'ert-unload-hook #'ert--unload-function)
(provide 'ert)
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index ffd17e5d7af..1f0c25e8205 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -1,6 +1,6 @@
;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer -*- lexical-binding: t -*-
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se>
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index f06ad912bc8..69d545560d4 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
-;;; find-func.el --- find the definition of the Emacs Lisp function near point
+;;; find-func.el --- find the definition of the Emacs Lisp function near point -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@@ -59,10 +59,10 @@
(concat
"^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
-foo\\|[^icfgv]\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
+foo\\|\\(?:[^icfgv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
menu-bar-make-toggle\\)"
find-function-space-re
- "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")
+ "\\('\\|(quote \\)?%s\\(\\s-\\|$\\|[()]\\)")
"The regexp used by `find-function' to search for a function definition.
Note it must contain a `%s' at the place where `format'
should insert the function name. The default value avoids `defconst',
@@ -100,13 +100,40 @@ Please send improvements and fixes to the maintainer."
:group 'find-function
:version "22.1")
+(defcustom find-feature-regexp
+ (concat ";;; Code:")
+ "The regexp used by `xref-find-definitions' when searching for a feature definition.
+Note it must contain a `%s' at the place where `format'
+should insert the feature name."
+ ;; We search for ";;; Code" rather than (feature '%s) because the
+ ;; former is near the start of the code, and the latter is very
+ ;; uninteresting. If the regexp is not found, just goes to
+ ;; (point-min), which is acceptable in this case.
+ :type 'regexp
+ :group 'xref
+ :version "25.0")
+
+(defcustom find-alias-regexp
+ "(defalias +'%s"
+ "The regexp used by `xref-find-definitions' to search for an alias definition.
+Note it must contain a `%s' at the place where `format'
+should insert the feature name."
+ :type 'regexp
+ :group 'xref
+ :version "25.0")
+
(defvar find-function-regexp-alist
'((nil . find-function-regexp)
(defvar . find-variable-regexp)
- (defface . find-face-regexp))
+ (defface . find-face-regexp)
+ (feature . find-feature-regexp)
+ (defalias . find-alias-regexp))
"Alist mapping definition types into regexp variables.
Each regexp variable's value should actually be a format string
-to be used to substitute the desired symbol name into the regexp.")
+to be used to substitute the desired symbol name into the regexp.
+Instead of regexp variable, types can be mapped to functions as well,
+in which case the function is called with one argument (the object
+we're looking for) and it should search for it.")
(put 'find-function-regexp-alist 'risky-local-variable t)
(defcustom find-function-source-path nil
@@ -178,8 +205,7 @@ LIBRARY should be a string (the name of the library)."
(defvar find-function-C-source-directory
(let ((dir (expand-file-name "src" source-directory)))
- (when (and (file-directory-p dir) (file-readable-p dir))
- dir))
+ (if (file-accessible-directory-p dir) dir))
"Directory where the C source files of Emacs can be found.
If nil, do not try to find the source code of functions and variables
defined in C.")
@@ -187,12 +213,15 @@ defined in C.")
(declare-function ad-get-advice-info "advice" (function))
(defun find-function-advised-original (func)
- "Return the original function symbol of an advised function FUNC.
-If FUNC is not the symbol of an advised function, just returns FUNC."
+ "Return the original function definition of an advised function FUNC.
+If FUNC is not a symbol, return it. Else, if it's not advised,
+return the symbol's function definition."
(or (and (symbolp func)
- (featurep 'advice)
- (let ((ofunc (cdr (assq 'origname (ad-get-advice-info func)))))
- (and (fboundp ofunc) ofunc)))
+ (featurep 'nadvice)
+ (let ((ofunc (advice--symbol-function func)))
+ (if (advice--p ofunc)
+ (advice--cd*r ofunc)
+ ofunc)))
func))
(defun find-function-C-source (fun-or-var file type)
@@ -219,7 +248,7 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
(regexp-quote (symbol-name fun-or-var))
"\"")
(concat "DEFUN[ \t\n]*([ \t\n]*\""
- (regexp-quote (subr-name fun-or-var))
+ (regexp-quote (subr-name (advice--cd*r fun-or-var)))
"\""))
nil t)
(error "Can't find source for %s" fun-or-var))
@@ -283,35 +312,79 @@ The search is done in the source for library LIBRARY."
(let* ((filename (find-library-name library))
(regexp-symbol (cdr (assq type find-function-regexp-alist))))
(with-current-buffer (find-file-noselect filename)
- (let ((regexp (format (symbol-value regexp-symbol)
- ;; Entry for ` (backquote) macro in loaddefs.el,
- ;; (defalias (quote \`)..., has a \ but
- ;; (symbol-name symbol) doesn't. Add an
- ;; optional \ to catch this.
- (concat "\\\\?"
- (regexp-quote (symbol-name symbol)))))
+ (let ((regexp (if (functionp regexp-symbol) regexp-symbol
+ (format (symbol-value regexp-symbol)
+ ;; Entry for ` (backquote) macro in loaddefs.el,
+ ;; (defalias (quote \`)..., has a \ but
+ ;; (symbol-name symbol) doesn't. Add an
+ ;; optional \ to catch this.
+ (concat "\\\\?"
+ (regexp-quote (symbol-name symbol))))))
(case-fold-search))
(with-syntax-table emacs-lisp-mode-syntax-table
(goto-char (point-min))
- (if (or (re-search-forward regexp nil t)
- ;; `regexp' matches definitions using known forms like
- ;; `defun', or `defvar'. But some functions/variables
- ;; are defined using special macros (or functions), so
- ;; if `regexp' can't find the definition, we look for
- ;; something of the form "(SOMETHING <symbol> ...)".
- ;; This fails to distinguish function definitions from
- ;; variable declarations (or even uses thereof), but is
- ;; a good pragmatic fallback.
- (re-search-forward
- (concat "^([^ ]+" find-function-space-re "['(]?"
- (regexp-quote (symbol-name symbol))
- "\\_>")
- nil t))
+ (if (if (functionp regexp)
+ (funcall regexp symbol)
+ (or (re-search-forward regexp nil t)
+ ;; `regexp' matches definitions using known forms like
+ ;; `defun', or `defvar'. But some functions/variables
+ ;; are defined using special macros (or functions), so
+ ;; if `regexp' can't find the definition, we look for
+ ;; something of the form "(SOMETHING <symbol> ...)".
+ ;; This fails to distinguish function definitions from
+ ;; variable declarations (or even uses thereof), but is
+ ;; a good pragmatic fallback.
+ (re-search-forward
+ (concat "^([^ ]+" find-function-space-re "['(]?"
+ (regexp-quote (symbol-name symbol))
+ "\\_>")
+ nil t)))
(progn
(beginning-of-line)
(cons (current-buffer) (point)))
(cons (current-buffer) nil))))))))
+(defun find-function-library (function &optional lisp-only verbose)
+ "Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION.
+
+ORIG-FUNCTION is the original name, after removing all advice and
+resolving aliases. LIBRARY is an absolute file name, a relative
+file name inside the C sources directory, or a name of an
+autoloaded feature.
+
+If ORIG-FUNCTION is a built-in function and LISP-ONLY is non-nil,
+signal an error.
+
+If VERBOSE is non-nil, and FUNCTION is an alias, display a
+message about the whole chain of aliases."
+ (let ((def (if (symbolp function)
+ (find-function-advised-original function)))
+ aliases)
+ ;; FIXME for completeness, it might be nice to print something like:
+ ;; foo (which is advised), which is an alias for bar (which is advised).
+ (while (and def (symbolp def))
+ (or (eq def function)
+ (not verbose)
+ (setq aliases (if aliases
+ (concat aliases
+ (format-message
+ ", which is an alias for `%s'"
+ (symbol-name def)))
+ (format-message "`%s' is an alias for `%s'"
+ function (symbol-name def)))))
+ (setq function (find-function-advised-original function)
+ def (find-function-advised-original function)))
+ (if aliases
+ (message "%s" aliases))
+ (cons function
+ (cond
+ ((autoloadp def) (nth 1 def))
+ ((subrp def)
+ (if lisp-only
+ (error "%s is a built-in function" function))
+ (help-C-file-name def 'subr))
+ ((symbol-file function 'defun))))))
+
;;;###autoload
(defun find-function-noselect (function &optional lisp-only)
"Return a pair (BUFFER . POINT) pointing to the definition of FUNCTION.
@@ -330,30 +403,8 @@ searched for in `find-function-source-path' if non-nil, otherwise
in `load-path'."
(if (not function)
(error "You didn't specify a function"))
- (let ((def (symbol-function (find-function-advised-original function)))
- aliases)
- ;; FIXME for completeness, it might be nice to print something like:
- ;; foo (which is advised), which is an alias for bar (which is advised).
- (while (symbolp def)
- (or (eq def function)
- (if aliases
- (setq aliases (concat aliases
- (format ", which is an alias for `%s'"
- (symbol-name def))))
- (setq aliases (format "`%s' is an alias for `%s'"
- function (symbol-name def)))))
- (setq function (symbol-function (find-function-advised-original function))
- def (symbol-function (find-function-advised-original function))))
- (if aliases
- (message "%s" aliases))
- (let ((library
- (cond ((autoloadp def) (nth 1 def))
- ((subrp def)
- (if lisp-only
- (error "%s is a built-in function" function))
- (help-C-file-name def 'subr))
- ((symbol-file function 'defun)))))
- (find-function-search-for-symbol function nil library))))
+ (let ((func-lib (find-function-library function lisp-only t)))
+ (find-function-search-for-symbol (car func-lib) nil (cdr func-lib))))
(defun find-function-read (&optional type)
"Read and return an interned symbol, defaulting to the one near point.
@@ -392,7 +443,6 @@ See also `find-function-after-hook'.
Set mark before moving, if the buffer already existed."
(let* ((orig-point (point))
- (orig-buf (window-buffer))
(orig-buffers (buffer-list))
(buffer-point (save-excursion
(find-definition-noselect symbol type)))
@@ -525,11 +575,11 @@ See also `find-function-recenter-line' and `find-function-after-hook'."
(interactive (find-function-read 'defface))
(find-function-do-it face 'defface 'switch-to-buffer))
-;;;###autoload
-(defun find-function-on-key (key)
+(defun find-function-on-key-do-it (key find-fn)
"Find the function that KEY invokes. KEY is a string.
-Set mark before moving, if the buffer already existed."
- (interactive "kFind function on key: ")
+Set mark before moving, if the buffer already existed.
+
+FIND-FN is the function to call to navigate to the function."
(let (defn)
(save-excursion
(let* ((event (and (eventp key) (aref key 0))) ; Null event OK below.
@@ -550,7 +600,28 @@ Set mark before moving, if the buffer already existed."
(message "%s is unbound" key-desc)
(if (consp defn)
(message "%s runs %s" key-desc (prin1-to-string defn))
- (find-function-other-window defn))))))
+ (funcall find-fn defn))))))
+
+;;;###autoload
+(defun find-function-on-key (key)
+ "Find the function that KEY invokes. KEY is a string.
+Set mark before moving, if the buffer already existed."
+ (interactive "kFind function on key: ")
+ (find-function-on-key-do-it key #'find-function))
+
+;;;###autoload
+(defun find-function-on-key-other-window (key)
+ "Find, in the other window, the function that KEY invokes.
+See `find-function-on-key'."
+ (interactive "kFind function on key: ")
+ (find-function-on-key-do-it key #'find-function-other-window))
+
+;;;###autoload
+(defun find-function-on-key-other-frame (key)
+ "Find, in the other frame, the function that KEY invokes.
+See `find-function-on-key'."
+ (interactive "kFind function on key: ")
+ (find-function-on-key-do-it key #'find-function-other-frame))
;;;###autoload
(defun find-function-at-point ()
@@ -575,6 +646,8 @@ Set mark before moving, if the buffer already existed."
(define-key ctl-x-4-map "F" 'find-function-other-window)
(define-key ctl-x-5-map "F" 'find-function-other-frame)
(define-key ctl-x-map "K" 'find-function-on-key)
+ (define-key ctl-x-4-map "K" 'find-function-on-key-other-window)
+ (define-key ctl-x-5-map "K" 'find-function-on-key-other-frame)
(define-key ctl-x-map "V" 'find-variable)
(define-key ctl-x-4-map "V" 'find-variable-other-window)
(define-key ctl-x-5-map "V" 'find-variable-other-frame))
diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el
deleted file mode 100644
index 82b3e94bb4d..00000000000
--- a/lisp/emacs-lisp/find-gc.el
+++ /dev/null
@@ -1,161 +0,0 @@
-;;; find-gc.el --- detect functions that call the garbage collector
-
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Produce in find-gc-unsafe-list the set of all functions that may invoke GC.
-;; This expects the Emacs sources to live in find-gc-source-directory.
-;; It creates a temporary working directory /tmp/esrc.
-
-;;; Code:
-
-(defvar find-gc-unsafe-list nil
- "The list of unsafe functions is placed here by `find-gc-unsafe'.")
-
-(defvar find-gc-source-directory)
-
-(defvar find-gc-subrs-callers nil
- "Alist of users of subrs, from GC testing.
-Each entry has the form (FUNCTION . FUNCTIONS-THAT-CALL-IT).")
-
-(defvar find-gc-subrs-called nil
- "Alist of subrs called, in GC testing.
-Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).")
-
-
-;;; Functions on this list are safe, even if they appear to be able
-;;; to call the target.
-
-(defvar find-gc-noreturn-list '(Fsignal Fthrow wrong_type_argument))
-
-;;; This was originally generated directory-files, but there were
-;;; too many files there that were not actually compiled. The
-;;; list below was created for a HP-UX 7.0 system.
-
-(defvar find-gc-source-files
- '("dispnew.c" "scroll.c" "xdisp.c" "window.c"
- "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c"
- "keymap.c" "sysdep.c" "buffer.c" "filelock.c"
- "insdel.c" "marker.c" "minibuf.c" "fileio.c"
- "dired.c" "cmds.c" "casefiddle.c"
- "indent.c" "search.c" "regex.c" "undo.c"
- "alloc.c" "data.c" "doc.c" "editfns.c"
- "callint.c" "eval.c" "fns.c" "print.c" "lread.c"
- "abbrev.c" "syntax.c" "unexcoff.c"
- "bytecode.c" "process.c" "callproc.c" "doprnt.c"
- "x11term.c" "x11fns.c"))
-
-
-(defun find-gc-unsafe ()
- "Return a list of unsafe functions--that is, which can call GC.
-Also store it in `find-gc-unsafe'."
- (trace-call-tree nil)
- (trace-use-tree)
- (find-unsafe-funcs 'Fgarbage_collect)
- (setq find-gc-unsafe-list
- (sort find-gc-unsafe-list
- (function (lambda (x y)
- (string-lessp (car x) (car y))))))
-)
-
-;;; This does a depth-first search to find all functions that can
-;;; ultimately call the function "target". The result is an a-list
-;;; in find-gc-unsafe-list; the cars are the unsafe functions, and the cdrs
-;;; are (one of) the unsafe functions that these functions directly
-;;; call.
-
-(defun find-unsafe-funcs (target)
- (setq find-gc-unsafe-list (list (list target)))
- (trace-unsafe target)
-)
-
-(defun trace-unsafe (func)
- (let ((used (assq func find-gc-subrs-callers)))
- (or used
- (error "No find-gc-subrs-callers for %s" (car find-gc-unsafe-list)))
- (while (setq used (cdr used))
- (or (assq (car used) find-gc-unsafe-list)
- (memq (car used) find-gc-noreturn-list)
- (progn
- (push (cons (car used) func) find-gc-unsafe-list)
- (trace-unsafe (car used))))))
-)
-
-
-
-
-(defun trace-call-tree (&optional already-setup)
- (message "Setting up directories...")
- (or already-setup
- (progn
- ;; Gee, wouldn't a built-in "system" function be handy here.
- (call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc")
- (call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc")
- (call-process "csh" nil nil nil "-c"
- (format "ln -s %s/*.[ch] /tmp/esrc"
- find-gc-source-directory))))
- (with-current-buffer (get-buffer-create "*Trace Call Tree*")
- (setq find-gc-subrs-called nil)
- (let ((case-fold-search nil)
- (files find-gc-source-files)
- name entry)
- (while files
- (message "Compiling %s..." (car files))
- (call-process "csh" nil nil nil "-c"
- (format "gcc -dr -c /tmp/esrc/%s -o /dev/null"
- (car files)))
- (erase-buffer)
- (insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl"))
- (while (re-search-forward ";; Function \\|(call_insn " nil t)
- (if (= (char-after (- (point) 3)) ?o)
- (progn
- (looking-at "[a-zA-Z0-9_]+")
- (setq name (intern (buffer-substring (match-beginning 0)
- (match-end 0))))
- (message "%s : %s" (car files) name)
- (setq entry (list name)
- find-gc-subrs-called (cons entry find-gc-subrs-called)))
- (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
- (progn
- (setq name (intern (buffer-substring (match-beginning 1)
- (match-end 1))))
- (or (memq name (cdr entry))
- (setcdr entry (cons name (cdr entry))))))))
- (delete-file (concat "/tmp/esrc/" (car files) ".rtl"))
- (setq files (cdr files)))))
-)
-
-
-(defun trace-use-tree ()
- (setq find-gc-subrs-callers (mapcar 'list (mapcar 'car find-gc-subrs-called)))
- (let ((ptr find-gc-subrs-called)
- p2 found)
- (while ptr
- (setq p2 (car ptr))
- (while (setq p2 (cdr p2))
- (if (setq found (assq (car p2) find-gc-subrs-callers))
- (setcdr found (cons (car (car ptr)) (cdr found)))))
- (setq ptr (cdr ptr))))
-)
-
-(provide 'find-gc)
-
-;;; find-gc.el ends here
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 6dee2cb48da..0320662af94 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,8 +1,8 @@
;;; float-sup.el --- define some constants useful for floating point numbers.
-;; Copyright (C) 1985-1987, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
new file mode 100644
index 00000000000..123f64b9660
--- /dev/null
+++ b/lisp/emacs-lisp/generator.el
@@ -0,0 +1,796 @@
+;;; generator.el --- generators -*- lexical-binding: t -*-
+
+;;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daniel Colascione <dancol@dancol.org>
+;; Keywords: extensions, elisp
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package implements generators for Emacs Lisp through a
+;; continuation-passing transformation. It provides essentially the
+;; same generator API and iterator facilities that Python and
+;; JavaScript ES6 provide.
+;;
+;; `iter-lambda' and `iter-defun' work like `lambda' and `defun',
+;; except that they evaluate to or define, respectively, generator
+;; functions. These functions, when called, return an iterator.
+;; An iterator is an opaque object that generates a sequence of
+;; values. Callers use `iter-next' to retrieve the next value from
+;; the sequence; when the sequence is exhausted, `iter-next' will
+;; raise the `iter-end-of-sequence' condition.
+;;
+;; Generator functions are written like normal functions, except that
+;; they can invoke `iter-yield' to suspend themselves and return a
+;; value to callers; this value becomes the return value of
+;; `iter-next'. On the next call to `iter-next', execution of the
+;; generator function resumes where it left off. When a generator
+;; function returns normally, the `iter-next' raises
+;; `iter-end-of-sequence' with the value the function returned.
+;;
+;; `iter-yield-from' yields all the values from another iterator; it
+;; then evaluates to the value the sub-iterator returned normally.
+;; This facility is useful for functional composition of generators
+;; and for implementing coroutines.
+;;
+;; `iter-yield' is illegal inside the UNWINDFORMS of an
+;; `unwind-protect' for various sordid internal reasons documented in
+;; the code.
+;;
+;; N.B. Each call to a generator function generates a *new* iterator,
+;; and each iterator maintains its own internal state.
+;;
+;; This raw form of iteration is general, but a bit awkward to use, so
+;; this library also provides some convenience functions:
+;;
+;; `iter-do' is like `cl-do', except that instead of walking a list,
+;; it walks an iterator. `cl-loop' is also extended with a new
+;; keyword, `iter-by', that iterates over an iterator.
+;;
+
+;;; Implementation:
+
+;;
+;; The internal cps transformation code uses the cps- namespace.
+;; Iteration functions use the `iter-' namespace. Generator functions
+;; are somewhat less efficient than conventional elisp routines,
+;; although we try to avoid CPS transformation on forms that do not
+;; invoke `iter-yield'.
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'pcase)
+
+(defvar cps--bindings nil)
+(defvar cps--states nil)
+(defvar cps--value-symbol nil)
+(defvar cps--state-symbol nil)
+(defvar cps--cleanup-table-symbol nil)
+(defvar cps--cleanup-function nil)
+
+(defmacro cps--gensym (fmt &rest args)
+ ;; Change this function to use `cl-gensym' if you want the generated
+ ;; code to be easier to read and debug.
+ ;; (cl-gensym (apply #'format fmt args))
+ `(progn (ignore ,@args) (make-symbol ,fmt)))
+
+(defvar cps--dynamic-wrappers '(identity)
+ "List of transformer functions to apply to atomic forms we
+evaluate in CPS context.")
+
+(defconst cps-standard-special-forms
+ '(setq setq-default throw interactive)
+ "List of special forms that we treat just like ordinary
+ function applications." )
+
+(defun cps--trace-funcall (func &rest args)
+ (message "%S: args=%S" func args)
+ (let ((result (apply func args)))
+ (message "%S: result=%S" func result)
+ result))
+
+(defun cps--trace (fmt &rest args)
+ (princ (apply #'format (concat fmt "\n") args)))
+
+(defun cps--special-form-p (definition)
+ "Non-nil if and only if DEFINITION is a special form."
+ ;; Copied from ad-special-form-p
+ (if (and (symbolp definition) (fboundp definition))
+ (setf definition (indirect-function definition)))
+ (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
+
+(defmacro cps--define-unsupported (function)
+ `(defun ,(intern (format "cps--transform-%s" function))
+ (error "%s not supported in generators" ,function)))
+
+(defmacro cps--with-value-wrapper (wrapper &rest body)
+ "Continue generating CPS code with an atomic-form wrapper
+to the current stack of such wrappers. WRAPPER is a function that
+takes a form and returns a wrapped form.
+
+Whenever we generate an atomic form (i.e., a form that can't
+iter-yield), we first (before actually inserting that form in our
+generated code) pass that form through all the transformer
+functions. We use this facility to wrap forms that can transfer
+control flow non-locally in goo that diverts this control flow to
+the CPS state machinery.
+"
+ (declare (indent 1))
+ `(let ((cps--dynamic-wrappers
+ (cons
+ ,wrapper
+ cps--dynamic-wrappers)))
+ ,@body))
+
+(defun cps--make-dynamic-binding-wrapper (dynamic-var static-var)
+ (cl-assert lexical-binding)
+ (lambda (form)
+ `(let ((,dynamic-var ,static-var))
+ (unwind-protect ; Update the static shadow after evaluation is done
+ ,form
+ (setf ,static-var ,dynamic-var))
+ ,form)))
+
+(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
+ "Evaluate BODY such that generated atomic evaluations run with
+DYNAMIC-VAR bound to STATIC-VAR."
+ (declare (indent 2))
+ `(cps--with-value-wrapper
+ (cps--make-dynamic-binding-wrapper ,dynamic-var ,static-var)
+ ,@body))
+
+(defun cps--add-state (kind body)
+ "Create a new CPS state with body BODY and return the state's name."
+ (declare (indent 1))
+ (let* ((state (cps--gensym "cps-state-%s-" kind)))
+ (push (list state body cps--cleanup-function) cps--states)
+ (push state cps--bindings)
+ state))
+
+(defun cps--add-binding (original-name)
+ (car (push (cps--gensym (format "cps-binding-%s-" original-name))
+ cps--bindings)))
+
+(defun cps--find-special-form-handler (form)
+ (let* ((handler-name (format "cps--transform-%s" (car-safe form)))
+ (handler (intern-soft handler-name)))
+ (and (fboundp handler) handler)))
+
+(defvar cps-inhibit-atomic-optimization nil
+ "When t, always rewrite forms into cps even when they
+don't yield.")
+
+(defvar cps--yield-seen)
+
+(defun cps--atomic-p (form)
+ "Return whether the given form never yields."
+
+ (and (not cps-inhibit-atomic-optimization)
+ (let* ((cps--yield-seen))
+ (ignore (macroexpand-all
+ `(cl-macrolet ((cps-internal-yield
+ (_val)
+ (setf cps--yield-seen t)))
+ ,form)
+ macroexpand-all-environment))
+ (not cps--yield-seen))))
+
+(defun cps--make-atomic-state (form next-state)
+ (let ((tform `(prog1 ,form (setf ,cps--state-symbol ,next-state))))
+ (cl-loop for wrapper in cps--dynamic-wrappers
+ do (setf tform (funcall wrapper tform)))
+ ;; Bind cps--cleanup-function to nil here because the wrapper
+ ;; function mechanism is responsible for cleanup here, not the
+ ;; generic cleanup mechanism. If we didn't make this binding,
+ ;; we'd run cleanup handlers twice on anything that made it out
+ ;; to toplevel.
+ (let ((cps--cleanup-function nil))
+ (cps--add-state "atom"
+ `(setf ,cps--value-symbol ,tform)))))
+
+(defun cps--transform-1 (form next-state)
+ (pcase form
+
+ ;; If we're looking at an "atomic" form (i.e., one that does not
+ ;; iter-yield), just evaluate the form as a whole instead of rewriting
+ ;; it into CPS.
+
+ ((guard (cps--atomic-p form))
+ (cps--make-atomic-state form next-state))
+
+ ;; Process `and'.
+
+ (`(and) ; (and) -> t
+ (cps--transform-1 t next-state))
+ (`(and ,condition) ; (and CONDITION) -> CONDITION
+ (cps--transform-1 condition next-state))
+ (`(and ,condition . ,rest)
+ ;; Evaluate CONDITION; if it's true, go on to evaluate the rest
+ ;; of the `and'.
+ (cps--transform-1
+ condition
+ (cps--add-state "and"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1 `(and ,@rest)
+ next-state)
+ ,next-state)))))
+
+ ;; Process `catch'.
+
+ (`(catch ,tag . ,body)
+ (let ((tag-binding (cps--add-binding "catch-tag")))
+ (cps--transform-1 tag
+ (cps--add-state "cps-update-tag"
+ `(setf ,tag-binding ,cps--value-symbol
+ ,cps--state-symbol
+ ,(cps--with-value-wrapper
+ (cps--make-catch-wrapper
+ tag-binding next-state)
+ (cps--transform-1 `(progn ,@body)
+ next-state)))))))
+
+ ;; Process `cond': transform into `if' or `or' depending on the
+ ;; precise kind of the condition we're looking at.
+
+ (`(cond) ; (cond) -> nil
+ (cps--transform-1 nil next-state))
+ (`(cond (,condition) . ,rest)
+ (cps--transform-1 `(or ,condition (cond ,@rest))
+ next-state))
+ (`(cond (,condition . ,body) . ,rest)
+ (cps--transform-1 `(if ,condition
+ (progn ,@body)
+ (cond ,@rest))
+ next-state))
+
+ ;; Process `condition-case': do the heavy lifting in a helper
+ ;; function.
+
+ (`(condition-case ,var ,bodyform . ,handlers)
+ (cps--with-value-wrapper
+ (cps--make-condition-wrapper var next-state handlers)
+ (cps--transform-1 bodyform
+ next-state)))
+
+ ;; Process `if'.
+
+ (`(if ,cond ,then . ,else)
+ (cps--transform-1 cond
+ (cps--add-state "if"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1 then
+ next-state)
+ ,(cps--transform-1 `(progn ,@else)
+ next-state))))))
+
+ ;; Process `progn' and `inline': they are identical except for the
+ ;; name, which has some significance to the byte compiler.
+
+ (`(inline) (cps--transform-1 nil next-state))
+ (`(inline ,form) (cps--transform-1 form next-state))
+ (`(inline ,form . ,rest)
+ (cps--transform-1 form
+ (cps--transform-1 `(inline ,@rest)
+ next-state)))
+
+ (`(progn) (cps--transform-1 nil next-state))
+ (`(progn ,form) (cps--transform-1 form next-state))
+ (`(progn ,form . ,rest)
+ (cps--transform-1 form
+ (cps--transform-1 `(progn ,@rest)
+ next-state)))
+
+ ;; Process `let' in a helper function that transforms it into a
+ ;; let* with temporaries.
+
+ (`(let ,bindings . ,body)
+ (let* ((bindings (cl-loop for binding in bindings
+ collect (if (symbolp binding)
+ (list binding nil)
+ binding)))
+ (temps (cl-loop for (var _value-form) in bindings
+ collect (cps--add-binding var))))
+ (cps--transform-1
+ `(let* ,(append
+ (cl-loop for (_var value-form) in bindings
+ for temp in temps
+ collect (list temp value-form))
+ (cl-loop for (var _binding) in bindings
+ for temp in temps
+ collect (list var temp)))
+ ,@body)
+ next-state)))
+
+ ;; Process `let*' binding: process one binding at a time. Flatten
+ ;; lexical bindings.
+
+ (`(let* () . ,body)
+ (cps--transform-1 `(progn ,@body) next-state))
+
+ (`(let* (,binding . ,more-bindings) . ,body)
+ (let* ((var (if (symbolp binding) binding (car binding)))
+ (value-form (car (cdr-safe binding)))
+ (new-var (cps--add-binding var)))
+
+ (cps--transform-1
+ value-form
+ (cps--add-state "let*"
+ `(setf ,new-var ,cps--value-symbol
+ ,cps--state-symbol
+ ,(if (or (not lexical-binding) (special-variable-p var))
+ (cps--with-dynamic-binding var new-var
+ (cps--transform-1
+ `(let* ,more-bindings ,@body)
+ next-state))
+ (cps--transform-1
+ (cps--replace-variable-references
+ var new-var
+ `(let* ,more-bindings ,@body))
+ next-state)))))))
+
+ ;; Process `or'.
+
+ (`(or) (cps--transform-1 nil next-state))
+ (`(or ,condition) (cps--transform-1 condition next-state))
+ (`(or ,condition . ,rest)
+ (cps--transform-1
+ condition
+ (cps--add-state "or"
+ `(setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,next-state
+ ,(cps--transform-1
+ `(or ,@rest) next-state))))))
+
+ ;; Process `prog1'.
+
+ (`(prog1 ,first) (cps--transform-1 first next-state))
+ (`(prog1 ,first . ,body)
+ (cps--transform-1
+ first
+ (let ((temp-var-symbol (cps--add-binding "prog1-temp")))
+ (cps--add-state "prog1"
+ `(setf ,temp-var-symbol
+ ,cps--value-symbol
+ ,cps--state-symbol
+ ,(cps--transform-1
+ `(progn ,@body)
+ (cps--add-state "prog1inner"
+ `(setf ,cps--value-symbol ,temp-var-symbol
+ ,cps--state-symbol ,next-state))))))))
+
+ ;; Process `prog2'.
+
+ (`(prog2 ,form1 ,form2 . ,body)
+ (cps--transform-1
+ `(progn ,form1 (prog1 ,form2 ,@body))
+ next-state))
+
+ ;; Process `unwind-protect': If we're inside an unwind-protect, we
+ ;; have a block of code UNWINDFORMS which we would like to run
+ ;; whenever control flows away from the main piece of code,
+ ;; BODYFORM. We deal with the local control flow case by
+ ;; generating BODYFORM such that it yields to a continuation that
+ ;; executes UNWINDFORMS, which then yields to NEXT-STATE.
+ ;;
+ ;; Non-local control flow is trickier: we need to ensure that we
+ ;; execute UNWINDFORMS even when control bypasses our normal
+ ;; continuation. To make this guarantee, we wrap every external
+ ;; application (i.e., every piece of elisp that can transfer
+ ;; control non-locally) in an unwind-protect that runs UNWINDFORMS
+ ;; before allowing the non-local control transfer to proceed.
+ ;;
+ ;; Unfortunately, because elisp lacks a mechanism for generically
+ ;; capturing the reason for an arbitrary non-local control
+ ;; transfer and restarting the transfer at a later point, we
+ ;; cannot reify non-local transfers and cannot allow
+ ;; continuation-passing code inside UNWINDFORMS.
+
+ (`(unwind-protect ,bodyform . ,unwindforms)
+ ;; Signal the evaluator-generator that it needs to generate code
+ ;; to handle cleanup forms.
+ (unless cps--cleanup-table-symbol
+ (setf cps--cleanup-table-symbol (cps--gensym "cps-cleanup-table-")))
+ (let* ((unwind-state
+ (cps--add-state
+ "unwind"
+ ;; N.B. It's safe to just substitute unwindforms by
+ ;; sexp-splicing: we've already replaced all variable
+ ;; references inside it with lifted equivalents.
+ `(progn
+ ,@unwindforms
+ (setf ,cps--state-symbol ,next-state))))
+ (old-cleanup cps--cleanup-function)
+ (cps--cleanup-function
+ (let ((cps--cleanup-function nil))
+ (cps--add-state "cleanup"
+ `(progn
+ ,(when old-cleanup `(funcall ,old-cleanup))
+ ,@unwindforms)))))
+ (cps--with-value-wrapper
+ (cps--make-unwind-wrapper unwindforms)
+ (cps--transform-1 bodyform unwind-state))))
+
+ ;; Process `while'.
+
+ (`(while ,test . ,body)
+ ;; Open-code state addition instead of using cps--add-state: we
+ ;; need our states to be self-referential. (That's what makes the
+ ;; state a loop.)
+ (let* ((loop-state
+ (cps--gensym "cps-state-while-"))
+ (eval-loop-condition-state
+ (cps--transform-1 test loop-state))
+ (loop-state-body
+ `(progn
+ (setf ,cps--state-symbol
+ (if ,cps--value-symbol
+ ,(cps--transform-1
+ `(progn ,@body)
+ eval-loop-condition-state)
+ ,next-state)))))
+ (push (list loop-state loop-state-body cps--cleanup-function)
+ cps--states)
+ (push loop-state cps--bindings)
+ eval-loop-condition-state))
+
+ ;; Process various kinds of `quote'.
+
+ (`(quote ,arg) (cps--add-state "quote"
+ `(setf ,cps--value-symbol (quote ,arg)
+ ,cps--state-symbol ,next-state)))
+ (`(function ,arg) (cps--add-state "function"
+ `(setf ,cps--value-symbol (function ,arg)
+ ,cps--state-symbol ,next-state)))
+
+ ;; Deal with `iter-yield'.
+
+ (`(cps-internal-yield ,value)
+ (cps--transform-1
+ value
+ (cps--add-state "iter-yield"
+ `(progn
+ (setf ,cps--state-symbol
+ ,(if cps--cleanup-function
+ (cps--add-state "after-yield"
+ `(setf ,cps--state-symbol ,next-state))
+ next-state))
+ (throw 'cps--yield ,cps--value-symbol)))))
+
+ ;; Catch any unhandled special forms.
+
+ ((and `(,name . ,_)
+ (guard (cps--special-form-p name))
+ (guard (not (memq name cps-standard-special-forms))))
+ name ; Shut up byte compiler
+ (error "special form %S incorrect or not supported" form))
+
+ ;; Process regular function applications with nontrivial
+ ;; parameters, converting them to applications of trivial
+ ;; let-bound parameters.
+
+ ((and `(,function . ,arguments)
+ (guard (not (cl-loop for argument in arguments
+ always (atom argument)))))
+ (let ((argument-symbols
+ (cl-loop for argument in arguments
+ collect (if (atom argument)
+ argument
+ (cps--gensym "cps-argument-")))))
+
+ (cps--transform-1
+ `(let* ,(cl-loop for argument in arguments
+ for argument-symbol in argument-symbols
+ unless (eq argument argument-symbol)
+ collect (list argument-symbol argument))
+ ,(cons function argument-symbols))
+ next-state)))
+
+ ;; Process everything else by just evaluating the form normally.
+ (_ (cps--make-atomic-state form next-state))))
+
+(defun cps--make-catch-wrapper (tag-binding next-state)
+ (lambda (form)
+ (let ((normal-exit-symbol
+ (cps--gensym "cps-normal-exit-from-catch-")))
+ `(let (,normal-exit-symbol)
+ (prog1
+ (catch ,tag-binding
+ (prog1
+ ,form
+ (setf ,normal-exit-symbol t)))
+ (unless ,normal-exit-symbol
+ (setf ,cps--state-symbol ,next-state)))))))
+
+(defun cps--make-condition-wrapper (var next-state handlers)
+ ;; Each handler is both one of the transformers with which we wrap
+ ;; evaluated atomic forms and a state to which we jump when we
+ ;; encounter the given error.
+
+ (let* ((error-symbol (cps--add-binding "condition-case-error"))
+ (lexical-error-symbol (cps--gensym "cps-lexical-error-"))
+ (processed-handlers
+ (cl-loop for (condition . body) in handlers
+ collect (cons condition
+ (cps--transform-1
+ (cps--replace-variable-references
+ var error-symbol
+ `(progn ,@body))
+ next-state)))))
+
+ (lambda (form)
+ `(condition-case
+ ,lexical-error-symbol
+ ,form
+ ,@(cl-loop
+ for (condition . error-state) in processed-handlers
+ collect
+ `(,condition
+ (setf ,error-symbol
+ ,lexical-error-symbol
+ ,cps--state-symbol
+ ,error-state)))))))
+
+(defun cps--replace-variable-references (var new-var form)
+ "Replace all non-shadowed references to VAR with NEW-VAR in FORM.
+This routine does not modify FORM. Instead, it returns a
+modified copy."
+ (macroexpand-all
+ `(cl-symbol-macrolet ((,var ,new-var)) ,form)
+ macroexpand-all-environment))
+
+(defun cps--make-unwind-wrapper (unwind-forms)
+ (cl-assert lexical-binding)
+ (lambda (form)
+ (let ((normal-exit-symbol
+ (cps--gensym "cps-normal-exit-from-unwind-")))
+ `(let (,normal-exit-symbol)
+ (unwind-protect
+ (prog1
+ ,form
+ (setf ,normal-exit-symbol t))
+ (unless ,normal-exit-symbol
+ ,@unwind-forms))))))
+
+(put 'iter-end-of-sequence 'error-conditions '(iter-end-of-sequence))
+(put 'iter-end-of-sequence 'error-message "iteration terminated")
+
+(defun cps--make-close-iterator-form (terminal-state)
+ (if cps--cleanup-table-symbol
+ `(let ((cleanup (cdr (assq ,cps--state-symbol ,cps--cleanup-table-symbol))))
+ (setf ,cps--state-symbol ,terminal-state
+ ,cps--value-symbol nil)
+ (when cleanup (funcall cleanup)))
+ `(setf ,cps--state-symbol ,terminal-state
+ ,cps--value-symbol nil)))
+
+(defun cps-generate-evaluator (body)
+ (let* (cps--states
+ cps--bindings
+ cps--cleanup-function
+ (cps--value-symbol (cps--gensym "cps-current-value-"))
+ (cps--state-symbol (cps--gensym "cps-current-state-"))
+ ;; We make *cps-cleanup-table-symbol** non-nil when we notice
+ ;; that we have cleanup processing to perform.
+ (cps--cleanup-table-symbol nil)
+ (terminal-state (cps--add-state "terminal"
+ `(signal 'iter-end-of-sequence
+ ,cps--value-symbol)))
+ (initial-state (cps--transform-1
+ (macroexpand-all
+ `(cl-macrolet
+ ((iter-yield (value)
+ `(cps-internal-yield ,value)))
+ ,@body)
+ macroexpand-all-environment)
+ terminal-state))
+ (finalizer-symbol
+ (when cps--cleanup-table-symbol
+ (when cps--cleanup-table-symbol
+ (cps--gensym "cps-iterator-finalizer-")))))
+ `(let ,(append (list cps--state-symbol cps--value-symbol)
+ (when cps--cleanup-table-symbol
+ (list cps--cleanup-table-symbol))
+ (when finalizer-symbol
+ (list finalizer-symbol))
+ (nreverse cps--bindings))
+ ;; Order state list so that cleanup states are always defined
+ ;; before they're referenced.
+ ,@(cl-loop for (state body cleanup) in (nreverse cps--states)
+ collect `(setf ,state (lambda () ,body))
+ when cleanup
+ do (cl-assert cps--cleanup-table-symbol)
+ and collect `(push (cons ,state ,cleanup) ,cps--cleanup-table-symbol))
+ (setf ,cps--state-symbol ,initial-state)
+
+ (let ((iterator
+ (lambda (op value)
+ (cond
+ ,@(when finalizer-symbol
+ `(((eq op :stash-finalizer)
+ (setf ,finalizer-symbol value))
+ ((eq op :get-finalizer)
+ ,finalizer-symbol)))
+ ((eq op :close)
+ ,(cps--make-close-iterator-form terminal-state))
+ ((eq op :next)
+ (setf ,cps--value-symbol value)
+ (let ((yielded nil))
+ (unwind-protect
+ (prog1
+ (catch 'cps--yield
+ (while t
+ (funcall ,cps--state-symbol)))
+ (setf yielded t))
+ (unless yielded
+ ;; If we're exiting non-locally (error, quit,
+ ;; etc.) close the iterator.
+ ,(cps--make-close-iterator-form terminal-state)))))
+ (t (error "unknown iterator operation %S" op))))))
+ ,(when finalizer-symbol
+ `(funcall iterator
+ :stash-finalizer
+ (make-finalizer
+ (lambda ()
+ (iter-close iterator)))))
+ iterator))))
+
+(defun iter-yield (value)
+ "When used inside a generator, yield control to caller.
+The caller of `iter-next' receives VALUE, and the next call to
+`iter-next' resumes execution at the previous
+`iter-yield' point."
+ (identity value)
+ (error "`iter-yield' used outside a generator"))
+
+(defmacro iter-yield-from (value)
+ "When used inside a generator function, delegate to a sub-iterator.
+The values that the sub-iterator yields are passed directly to
+the caller, and values supplied to `iter-next' are sent to the
+sub-iterator. `iter-yield-from' evaluates to the value that the
+sub-iterator function returns via `iter-end-of-sequence'."
+ (let ((errsym (cps--gensym "yield-from-result"))
+ (valsym (cps--gensym "yield-from-value")))
+ `(let ((,valsym ,value))
+ (unwind-protect
+ (condition-case ,errsym
+ (let ((vs nil))
+ (while t
+ (setf vs (iter-yield (iter-next ,valsym vs)))))
+ (iter-end-of-sequence (cdr ,errsym)))
+ (iter-close ,valsym)))))
+
+(defmacro iter-defun (name arglist &rest body)
+ "Creates a generator NAME.
+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))
+ (cl-assert lexical-binding)
+ (let* ((parsed-body (macroexp-parse-body body))
+ (declarations (car parsed-body))
+ (exps (cdr parsed-body)))
+ `(defun ,name ,arglist
+ ,@declarations
+ ,(cps-generate-evaluator exps))))
+
+(defmacro iter-lambda (arglist &rest body)
+ "Return a lambda generator.
+`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
+ (declare (indent defun))
+ (cl-assert lexical-binding)
+ `(lambda ,arglist
+ ,(cps-generate-evaluator body)))
+
+(defun iter-next (iterator &optional yield-result)
+ "Extract a value from an iterator.
+YIELD-RESULT becomes the return value of `iter-yield' in the
+context of the generator.
+
+This routine raises the `iter-end-of-sequence' condition if the
+iterator cannot supply more values."
+ (funcall iterator :next yield-result))
+
+(defun iter-close (iterator)
+ "Terminate an iterator early.
+Run any unwind-protect handlers in scope at the point ITERATOR
+is blocked."
+ (funcall iterator :close nil))
+
+(cl-defmacro iter-do ((var iterator) &rest body)
+ "Loop over values from an iterator.
+Evaluate BODY with VAR bound to each value from ITERATOR.
+Return the value with which ITERATOR finished iteration."
+ (declare (indent 1))
+ (let ((done-symbol (cps--gensym "iter-do-iterator-done"))
+ (condition-symbol (cps--gensym "iter-do-condition"))
+ (it-symbol (cps--gensym "iter-do-iterator"))
+ (result-symbol (cps--gensym "iter-do-result")))
+ `(let (,var
+ ,result-symbol
+ (,done-symbol nil)
+ (,it-symbol ,iterator))
+ (while (not ,done-symbol)
+ (condition-case ,condition-symbol
+ (setf ,var (iter-next ,it-symbol))
+ (iter-end-of-sequence
+ (setf ,result-symbol (cdr ,condition-symbol))
+ (setf ,done-symbol t)))
+ (unless ,done-symbol ,@body))
+ ,result-symbol)))
+
+(defvar cl--loop-args)
+
+(defmacro cps--advance-for (conscell)
+ ;; See cps--handle-loop-for
+ `(condition-case nil
+ (progn
+ (setcar ,conscell (iter-next (cdr ,conscell)))
+ ,conscell)
+ (iter-end-of-sequence
+ nil)))
+
+(defmacro cps--initialize-for (iterator)
+ ;; See cps--handle-loop-for
+ (let ((cs (cps--gensym "cps--loop-temp")))
+ `(let ((,cs (cons nil ,iterator)))
+ (cps--advance-for ,cs))))
+
+(defun cps--handle-loop-for (var)
+ "Support `iter-by' in `loop'. "
+ ;; N.B. While the cl-loop-for-handler is a documented interface,
+ ;; there's no documented way for cl-loop-for-handler callbacks to do
+ ;; anything useful! Additionally, cl-loop currently lexbinds useful
+ ;; internal variables, so our only option is to modify
+ ;; cl--loop-args. If we substitute a general-purpose for-clause for
+ ;; our iterating clause, however, we can't preserve the
+ ;; parallel-versus-sequential `loop' semantics for for clauses ---
+ ;; we need a terminating condition as well, which requires us to use
+ ;; while, and inserting a while would break and-sequencing.
+ ;;
+ ;; To work around this problem, we actually use the "for var in LIST
+ ;; by FUNCTION" syntax, creating a new fake list each time through
+ ;; the loop, this "list" being a cons cell (val . it).
+ (let ((it-form (pop cl--loop-args)))
+ (setf cl--loop-args
+ (append
+ `(for ,var
+ in (cps--initialize-for ,it-form)
+ by 'cps--advance-for)
+ cl--loop-args))))
+
+(put 'iter-by 'cl-loop-for-handler 'cps--handle-loop-for)
+
+(eval-after-load 'elisp-mode
+ (lambda ()
+ (font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("(\\(iter-defun\\)\\_>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
+ (1 font-lock-keyword-face nil t)
+ (2 font-lock-function-name-face nil t))
+ ("(\\(iter-\\(?:next\\|lambda\\|yield\\|yield-from\\)\\)\\_>"
+ (1 font-lock-keyword-face nil t))))))
+
+(provide 'generator)
+
+;;; generator.el ends here
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 3eb64f9f7f0..b7f4070cf60 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,6 +1,6 @@
;;; generic.el --- defining simple major modes with comment and font-lock
;;
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Fri Sep 27 1996
@@ -224,7 +224,7 @@ Some generic modes are defined in `generic-x.el'."
;;; Comment Functionality
-(defun generic--normalise-comments (comment-list)
+(defun generic--normalize-comments (comment-list)
(let ((normalized '()))
(dolist (start comment-list)
(let (end)
@@ -300,7 +300,7 @@ Some generic modes are defined in `generic-x.el'."
(defun generic-mode-set-comments (comment-list)
"Set up comment functionality for generic mode."
(let ((st (make-syntax-table))
- (comment-list (generic--normalise-comments comment-list)))
+ (comment-list (generic--normalize-comments comment-list)))
(generic-set-comment-syntax st comment-list)
(generic-set-comment-vars comment-list)
(set-syntax-table st)))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 279ae582a05..94fe6c3d441 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -1,6 +1,6 @@
;;; gv.el --- generalized variables -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
@@ -74,6 +74,8 @@
;; (defvar gv--macro-environment nil
;; "Macro expanders for generalized variables.")
+(define-error 'gv-invalid-place "%S is not a valid place expression")
+
;;;###autoload
(defun gv-get (place do)
"Build the code that applies DO to PLACE.
@@ -84,15 +86,17 @@ and SETTER is a function which returns the code to set PLACE when called
with a (not necessarily copyable) Elisp expression that returns the value to
set it to.
DO must return an Elisp expression."
- (if (symbolp place)
- (funcall do place (lambda (v) `(setq ,place ,v)))
+ (cond
+ ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
+ ((not (consp place)) (signal 'gv-invalid-place (list place)))
+ (t
(let* ((head (car place))
(gf (function-get head 'gv-expander 'autoload)))
(if gf (apply gf do (cdr place))
- (let ((me (macroexpand place ;FIXME: expand one step at a time!
- ;; (append macroexpand-all-environment
- ;; gv--macro-environment)
- macroexpand-all-environment)))
+ (let ((me (macroexpand-1 place
+ ;; (append macroexpand-all-environment
+ ;; gv--macro-environment)
+ macroexpand-all-environment)))
(if (and (eq me place) (get head 'compiler-macro))
;; Expand compiler macros: this takes care of all the accessors
;; defined via cl-defsubst, such as cXXXr and defstruct slots.
@@ -102,8 +106,21 @@ DO must return an Elisp expression."
;; Follow aliases.
(setq me (cons (symbol-function head) (cdr place))))
(if (eq me place)
- (error "%S is not a valid place expression" place)
- (gv-get me do)))))))
+ (if (and (symbolp head) (get head 'setf-method))
+ (error "Incompatible place needs recompilation: %S" head)
+ (let* ((setter (gv-setter head)))
+ (gv--defsetter head (lambda (&rest args) `(,setter ,@args))
+ do (cdr place))))
+ (gv-get me do))))))))
+
+(defun gv-setter (name)
+ ;; The name taken from Scheme's SRFI-17. Actually, for SRFI-17, the argument
+ ;; could/should be a function value rather than a symbol.
+ "Return the symbol where the (setf NAME) function should be placed."
+ (if (get name 'gv-expander)
+ (error "gv-expander conflicts with (setf %S)" name))
+ ;; FIXME: This is wrong if `name' is uninterned (or interned elsewhere).
+ (intern (format "(setf %s)" name)))
;;;###autoload
(defmacro gv-letplace (vars place &rest body)
@@ -155,11 +172,15 @@ arguments as NAME. DO is a function as defined in `gv-get'."
(_ (message "Unknown %s declaration %S" symbol handler) nil))))
;;;###autoload
-(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
- defun-declarations-alist)
+(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)))
;;;###autoload
-(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
- defun-declarations-alist)
+(or (assq 'gv-setter defun-declarations-alist)
+ (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+ defun-declarations-alist))
;; (defmacro gv-define-expand (name expander)
;; "Use EXPANDER to handle NAME as a generalized var.
@@ -197,7 +218,7 @@ return a Lisp form that does the assignment.
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))"
+ (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
(declare (indent 2) (debug (&define name sexp body)))
`(gv-define-expander ,name
(lambda (do &rest args)
@@ -212,7 +233,7 @@ turned into calls of the form (SETTER ARGS... VAL).
If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
instead the assignment is turned into something equivalent to
- \(let ((temp VAL))
+ (let ((temp VAL))
(SETTER ARGS... temp)
temp)
so as to preserve the semantics of `setf'."
@@ -278,9 +299,9 @@ The return value is the last VAL in the list.
;; containing a non-trivial `push' even before gv.el was loaded.
;;;###autoload
(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+
;; CL did the equivalent of:
;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
-
(put 'edebug-after 'gv-expander
(lambda (do before index place)
(gv-letplace (getter setter) place
@@ -336,13 +357,50 @@ The return value is the last VAL in the list.
(gv-define-simple-setter process-filter set-process-filter)
(gv-define-simple-setter process-sentinel set-process-sentinel)
(gv-define-simple-setter process-get process-put)
-(gv-define-simple-setter window-buffer set-window-buffer)
-(gv-define-simple-setter window-display-table set-window-display-table 'fix)
-(gv-define-simple-setter window-dedicated-p set-window-dedicated-p)
-(gv-define-simple-setter window-hscroll set-window-hscroll)
(gv-define-simple-setter window-parameter set-window-parameter)
-(gv-define-simple-setter window-point set-window-point)
-(gv-define-simple-setter window-start set-window-start)
+(gv-define-setter window-buffer (v &optional w)
+ (macroexp-let2 nil v v
+ `(progn (set-window-buffer ,w ,v) ,v)))
+(gv-define-setter window-display-table (v &optional w)
+ (macroexp-let2 nil v v
+ `(progn (set-window-display-table ,w ,v) ,v)))
+(gv-define-setter window-dedicated-p (v &optional w)
+ `(set-window-dedicated-p ,w ,v))
+(gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v))
+(gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v))
+(gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v))
+
+(gv-define-setter buffer-local-value (val var buf)
+ (macroexp-let2 nil v val
+ `(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
+
+(gv-define-expander alist-get
+ (lambda (do key alist &optional default remove)
+ (macroexp-let2 macroexp-copyable-p k key
+ (gv-letplace (getter setter) alist
+ (macroexp-let2 nil p `(assq ,k ,getter)
+ (funcall do (if (null default) `(cdr ,p)
+ `(if ,p (cdr ,p) ,default))
+ (lambda (v)
+ (macroexp-let2 nil v v
+ (let ((set-exp
+ `(if ,p (setcdr ,p ,v)
+ ,(funcall setter
+ `(cons (setq ,p (cons ,k ,v))
+ ,getter)))))
+ (cond
+ ((null remove) set-exp)
+ ((or (eql v default)
+ (and (eq (car-safe v) 'quote)
+ (eq (car-safe default) 'quote)
+ (eql (cadr v) (cadr default))))
+ `(if ,p ,(funcall setter `(delq ,p ,getter))))
+ (t
+ `(cond
+ ((not (eql ,default ,v)) ,set-exp)
+ (,p ,(funcall setter
+ `(delq ,p ,getter)))))))))))))))
+
;;; Some occasionally handy extensions.
@@ -419,6 +477,32 @@ The return value is the last VAL in the list.
(funcall do `(funcall (car ,gv))
(lambda (v) `(funcall (cdr ,gv) ,v))))))))
+(defmacro gv-synthetic-place (getter setter)
+ "Special place described by its setter and getter.
+GETTER and SETTER (typically obtained via `gv-letplace') get and
+set that place. I.e. This macro allows you to do the \"reverse\" of what
+`gv-letplace' does.
+This macro only makes sense when used in a place."
+ (declare (gv-expander funcall))
+ (ignore setter)
+ getter)
+
+(defmacro gv-delay-error (place)
+ "Special place which delays the `gv-invalid-place' error to run-time.
+It behaves just like PLACE except that in case PLACE is not a valid place,
+the `gv-invalid-place' error will only be signaled at run-time when (and if)
+we try to use the setter.
+This macro only makes sense when used in a place."
+ (declare
+ (gv-expander
+ (lambda (do)
+ (condition-case err
+ (gv-get place do)
+ (gv-invalid-place
+ ;; Delay the error until we try to use the setter.
+ (funcall do place (lambda (_) `(signal ',(car err) ',(cdr err)))))))))
+ place)
+
;;; Even more debatable extensions.
(put 'cons 'gv-expander
@@ -448,10 +532,24 @@ The return value is the last VAL in the list.
;;;###autoload
(defmacro gv-ref (place)
"Return a reference to PLACE.
-This is like the `&' operator of the C language."
- (gv-letplace (getter setter) place
- `(cons (lambda () ,getter)
- (lambda (gv--val) ,(funcall setter 'gv--val)))))
+This is like the `&' operator of the C language.
+Note: this only works reliably with lexical binding mode, except for very
+simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
+binding mode."
+ (let ((code
+ (gv-letplace (getter setter) place
+ `(cons (lambda () ,getter)
+ (lambda (gv--val) ,(funcall setter 'gv--val))))))
+ (if (or lexical-binding
+ ;; If `code' still starts with `cons' then presumably gv-letplace
+ ;; did not add any new let-bindings, so the `lambda's don't capture
+ ;; any new variables. As a consequence, the code probably works in
+ ;; dynamic binding mode as well.
+ (eq (car-safe code) 'cons))
+ code
+ (macroexp--warn-and-return
+ "Use of gv-ref probably requires lexical-binding"
+ code))))
(defsubst gv-deref (ref)
"Dereference REF, returning the referenced value.
@@ -463,22 +561,13 @@ REF must have been previously obtained with `gv-ref'."
;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
-;;; Vaguely related definitions that should be moved elsewhere.
-
-;; (defun alist-get (key alist)
-;; "Get the value associated to KEY in ALIST."
-;; (declare
-;; (gv-expander
-;; (lambda (do)
-;; (macroexp-let2 macroexp-copyable-p k key
-;; (gv-letplace (getter setter) alist
-;; (macroexp-let2 nil p `(assoc ,k ,getter)
-;; (funcall do `(cdr ,p)
-;; (lambda (v)
-;; `(if ,p (setcdr ,p ,v)
-;; ,(funcall setter
-;; `(cons (cons ,k ,v) ,getter)))))))))))
-;; (cdr (assoc key alist)))
+;; (defmacro gv-letref (vars place &rest body)
+;; (declare (indent 2) (debug (sexp form &rest body)))
+;; (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap reasons!
+;; (gv-letplace (getter setter) place
+;; `(cl-macrolet ((,(nth 0 vars) () ',getter)
+;; (,(nth 1 vars) (v) (funcall ',setter v)))
+;; ,@body)))
(provide 'gv)
;;; gv.el ends here
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 5bef0b06fd4..8b7737b1d3e 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,9 +1,9 @@
;;; helper.el --- utility help package supporting help in electric modes
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
;; Package: emacs
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
new file mode 100644
index 00000000000..c3f696feda1
--- /dev/null
+++ b/lisp/emacs-lisp/inline.el
@@ -0,0 +1,262 @@
+;;; inline.el --- Define functions by their inliner -*- lexical-binding:t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides the macro `define-inline' which lets you define
+;; functions by defining their (exhaustive) compiler macro.
+;;
+;; The idea is that instead of doing like defsubst and cl-defsubst (i.e. from
+;; the function's definition, guess the best way to inline the function),
+;; we go the other way around: the programmer provides the code that does the
+;; inlining (as a compiler-macro) and from that we derive the definition of the
+;; function itself. The idea originated in an attempt to clean up `cl-typep',
+;; whose function definition amounted to (eval (cl--make-type-test EXP TYPE)).
+;;
+;; The simplest use is for plain and simple inlinable functions. Rather than:
+;;
+;; (defmacro myaccessor (obj)
+;; (macroexp-let2 macroexp-copyable-p obj obj
+;; `(if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2))))
+;; Or
+;; (defsubst myaccessor (obj)
+;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2)))
+;; Or
+;; (cl-defsubst myaccessor (obj)
+;; (if (foop obj) (aref (cdr obj) 3) (aref obj 2)))
+;;
+;; You'd do
+;;
+;; (define-inline myaccessor (obj)
+;; (inline-letevals (obj)
+;; (inline-quote (if (foop ,obj) (aref (cdr ,obj) 3) (aref ,obj 2)))))
+;;
+;; Other than verbosity, you get the best of all 3 above without their
+;; respective downsides:
+;; - defmacro: can't be passed to `mapcar' since it's not a function.
+;; - defsubst: not as efficient, and doesn't work as a `gv' place.
+;; - cl-defsubst: only works by accident, since it has latent bugs in its
+;; handling of variables and scopes which could bite you at any time.
+;; (e.g. try (cl-defsubst my-test1 (x) (let ((y 5)) (+ x y)))
+;; and then M-: (macroexpand-all '(my-test1 y)) RET)
+;; There is still one downside shared with the defmacro and cl-defsubst
+;; approach: when the function is inlined, the scoping rules (dynamic or
+;; lexical) will be inherited from the the call site.
+
+;; Of course, since define-inline defines a compiler macro, you can also do
+;; call-site optimizations, just like you can with `defmacro', but not with
+;; defsubst nor cl-defsubst.
+
+;;; Code:
+
+(require 'macroexp)
+
+(defmacro inline-quote (_exp)
+ "Similar to backquote, but quotes code and only accepts , and not ,@."
+ (declare (debug t))
+ (error "inline-quote can only be used within define-inline"))
+
+(defmacro inline-const-p (_exp)
+ "Return non-nil if the value of EXP is already known."
+ (declare (debug t))
+ (error "inline-const-p can only be used within define-inline"))
+
+(defmacro inline-const-val (_exp)
+ "Return the value of EXP."
+ (declare (debug t))
+ (error "inline-const-val can only be used within define-inline"))
+
+(defmacro inline-error (_format &rest _args)
+ "Signal an error."
+ (declare (debug t))
+ (error "inline-error can only be used within define-inline"))
+
+(defmacro inline--leteval (_var-exp &rest _body)
+ (declare (indent 1) (debug (sexp &rest body)))
+ (error "inline-letevals can only be used within define-inline"))
+(defmacro inline--letlisteval (_list &rest _body)
+ (declare (indent 1) (debug (sexp &rest body)))
+ (error "inline-letevals can only be used within define-inline"))
+
+(defmacro inline-letevals (vars &rest body)
+ "Make sure the expressions in VARS are evaluated.
+VARS should be a list of elements of the form (VAR EXP) or just VAR, in case
+EXP is equal to VAR. The result is to evaluate EXP and bind the result to VAR.
+
+The tail of VARS can be either nil or a symbol VAR which should hold a list
+of arguments,in which case each argument is evaluated and the resulting
+new list is re-bound to VAR.
+
+After VARS is handled, BODY is evaluated in the new environment."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (cond
+ ((consp vars)
+ `(inline--leteval ,(pop vars) (inline-letevals ,vars ,@body)))
+ (vars
+ `(inline--letlisteval ,vars ,@body))
+ (t (macroexp-progn body))))
+
+;; (defmacro inline-if (testfun testexp then else)
+;; (declare (indent 2) (debug (sexp symbolp form form)))
+;; (macroexp-let2 macroexp-copyable-p testsym testexp
+;; `(if (inline-const-p ,testexp)
+;; (if (,testfun (inline-const-val ,testexp)) ,then ,else)
+;; (inline-quote (if (,testfun ,testexp) ,(list '\, then)
+;; ,(list '\, else))))))
+
+;;;###autoload
+(defmacro define-inline (name args &rest body)
+ ;; FIXME: How can this work with CL arglists?
+ (declare (indent defun) (debug defun) (doc-string 3))
+ (let ((doc (if (stringp (car-safe body)) (list (pop body))))
+ (declares (if (eq (car-safe (car-safe body)) 'declare) (pop body)))
+ (cm-name (intern (format "%s--inliner" name)))
+ (bodyexp (macroexp-progn body)))
+ ;; If the function is autoloaded then when we load the .el file, the
+ ;; `compiler-macro' property is already set (from loaddefs.el) and might
+ ;; hence be called during the macroexpand-all calls below (if the function
+ ;; is recursive).
+ ;; So we disable any pre-loaded compiler-macro setting to avoid this.
+ (function-put name 'compiler-macro nil)
+ `(progn
+ (defun ,name ,args
+ ,@doc
+ (declare (compiler-macro ,cm-name) ,@(cdr declares))
+ ,(macroexpand-all bodyexp
+ `((inline-quote . inline--dont-quote)
+ ;; (inline-\` . inline--dont-quote)
+ (inline--leteval . inline--dont-leteval)
+ (inline--letlisteval . inline--dont-letlisteval)
+ (inline-const-p . inline--alwaysconst-p)
+ (inline-const-val . inline--alwaysconst-val)
+ (inline-error . inline--error)
+ ,@macroexpand-all-environment)))
+ :autoload-end
+ (eval-and-compile
+ (defun ,cm-name ,(cons 'inline--form args)
+ (ignore inline--form) ;In case it's not used!
+ (catch 'inline--just-use
+ ,(macroexpand-all
+ bodyexp
+ `((inline-quote . inline--do-quote)
+ ;; (inline-\` . inline--do-quote)
+ (inline--leteval . inline--do-leteval)
+ (inline--letlisteval
+ . inline--do-letlisteval)
+ (inline-const-p . inline--testconst-p)
+ (inline-const-val . inline--getconst-val)
+ (inline-error . inline--warning)
+ ,@macroexpand-all-environment))))))))
+
+(defun inline--do-quote (exp)
+ (pcase exp
+ (`(,'\, ,e) e) ;Eval `e' now *and* later.
+ (`'(,'\, ,e) `(list 'quote ,e)) ;Only eval `e' now, not later.
+ (`#'(,'\, ,e) `(list 'function ,e)) ;Only eval `e' now, not later.
+ ((pred consp)
+ (let ((args ()))
+ (while (and (consp exp) (not (eq '\, (car exp))))
+ (push (inline--do-quote (pop exp)) args))
+ (setq args (nreverse args))
+ (if exp
+ `(backquote-list* ,@args ,(inline--do-quote exp))
+ `(list ,@args))))
+ (_ (macroexp-quote exp))))
+
+(defun inline--dont-quote (exp)
+ (pcase exp
+ (`(,'\, ,e) e)
+ (`'(,'\, ,e) e)
+ (`#'(,'\, ,e) e)
+ ((pred consp)
+ (let ((args ()))
+ (while (and (consp exp) (not (eq '\, (car exp))))
+ (push (inline--dont-quote (pop exp)) args))
+ (setq args (nreverse args))
+ (if exp
+ `(apply ,@args ,(inline--dont-quote exp))
+ args)))
+ (_ exp)))
+
+(defun inline--do-leteval (var-exp &rest body)
+ `(macroexp-let2 ,(if (symbolp var-exp) #'macroexp-copyable-p #'ignore)
+ ,(or (car-safe var-exp) var-exp)
+ ,(or (car (cdr-safe var-exp)) var-exp)
+ ,@body))
+
+(defun inline--dont-leteval (var-exp &rest body)
+ (if (symbolp var-exp)
+ (macroexp-progn body)
+ `(let (,var-exp) ,@body)))
+
+(defun inline--do-letlisteval (listvar &rest body)
+ ;; Here's a sample situation:
+ ;; (define-inline foo (arg &rest keys)
+ ;; (inline-letevals (arg . keys)
+ ;; <check-keys>))
+ ;; I.e. in <check-keys> we need `keys' to contain a list of
+ ;; macroexp-copyable-p expressions.
+ (let ((bsym (make-symbol "bindings")))
+ `(let* ((,bsym ())
+ (,listvar (mapcar (lambda (e)
+ (if (macroexp-copyable-p e) e
+ (let ((v (make-symbol "v")))
+ (push (list v e) ,bsym)
+ v)))
+ ,listvar)))
+ (macroexp-let* (nreverse ,bsym)
+ ,(macroexp-progn body)))))
+
+(defun inline--dont-letlisteval (_listvar &rest body)
+ (macroexp-progn body))
+
+(defun inline--testconst-p (exp)
+ (macroexp-let2 macroexp-copyable-p exp exp
+ `(or (macroexp-const-p ,exp)
+ (eq (car-safe ,exp) 'function))))
+
+(defun inline--alwaysconst-p (_exp)
+ t)
+
+(defun inline--getconst-val (exp)
+ (macroexp-let2 macroexp-copyable-p exp exp
+ `(cond
+ ((not ,(inline--testconst-p exp))
+ (throw 'inline--just-use inline--form))
+ ((consp ,exp) (cadr ,exp))
+ (t ,exp))))
+
+(defun inline--alwaysconst-val (exp)
+ exp)
+
+(defun inline--error (&rest args)
+ `(error ,@args))
+
+(defun inline--warning (&rest _args)
+ `(throw 'inline--just-use
+ ;; FIXME: This would inf-loop by calling us right back when
+ ;; macroexpand-all recurses to expand inline--form.
+ ;; (macroexp--warn-and-return (format ,@args)
+ ;; inline--form)
+ inline--form))
+
+(provide 'inline)
+;;; inline.el ends here
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
new file mode 100644
index 00000000000..ca7a904a087
--- /dev/null
+++ b/lisp/emacs-lisp/let-alist.el
@@ -0,0 +1,142 @@
+;;; let-alist.el --- Easily let-bind values of an assoc-list by their names -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
+;; Maintainer: Artur Malabarba <bruce.connor.am@gmail.com>
+;; Version: 1.0.4
+;; Keywords: extensions lisp
+;; Prefix: let-alist
+;; Separator: -
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package offers a single macro, `let-alist'. This macro takes a
+;; first argument (whose value must be an alist) and a body.
+;;
+;; The macro expands to a let form containing body, where each dotted
+;; symbol inside body is let-bound to their cdrs in the alist. Dotted
+;; symbol is any symbol starting with a `.'. Only those present in
+;; the body are let-bound and this search is done at compile time.
+;;
+;; For instance, the following code
+;;
+;; (let-alist alist
+;; (if (and .title .body)
+;; .body
+;; .site
+;; .site.contents))
+;;
+;; essentially expands to
+;;
+;; (let ((.title (cdr (assq 'title alist)))
+;; (.body (cdr (assq 'body alist)))
+;; (.site (cdr (assq 'site alist)))
+;; (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
+;; (if (and .title .body)
+;; .body
+;; .site
+;; .site.contents))
+;;
+;; If you nest `let-alist' invocations, the inner one can't access
+;; the variables of the outer one. You can, however, access alists
+;; inside the original alist by using dots inside the symbol, as
+;; displayed in the example above by the `.site.contents'.
+;;
+;;; Code:
+
+
+(defun let-alist--deep-dot-search (data)
+ "Return alist of symbols inside DATA that start with a `.'.
+Perform a deep search and return an alist where each car is the
+symbol, and each cdr is the same symbol without the `.'."
+ (cond
+ ((symbolp data)
+ (let ((name (symbol-name data)))
+ (when (string-match "\\`\\." name)
+ ;; Return the cons cell inside a list, so it can be appended
+ ;; with other results in the clause below.
+ (list (cons data (intern (replace-match "" nil nil name)))))))
+ ((not (consp data)) nil)
+ (t (append (let-alist--deep-dot-search (car data))
+ (let-alist--deep-dot-search (cdr data))))))
+
+(defun let-alist--access-sexp (symbol variable)
+ "Return a sexp used to access SYMBOL inside VARIABLE."
+ (let* ((clean (let-alist--remove-dot symbol))
+ (name (symbol-name clean)))
+ (if (string-match "\\`\\." name)
+ clean
+ (let-alist--list-to-sexp
+ (mapcar #'intern (nreverse (split-string name "\\.")))
+ variable))))
+
+(defun let-alist--list-to-sexp (list var)
+ "Turn symbols LIST into recursive calls to `cdr' `assq' on VAR."
+ `(cdr (assq ',(car list)
+ ,(if (cdr list) (let-alist--list-to-sexp (cdr list) var)
+ var))))
+
+(defun let-alist--remove-dot (symbol)
+ "Return SYMBOL, sans an initial dot."
+ (let ((name (symbol-name symbol)))
+ (if (string-match "\\`\\." name)
+ (intern (replace-match "" nil nil name))
+ symbol)))
+
+
+;;; The actual macro.
+;;;###autoload
+(defmacro let-alist (alist &rest body)
+ "Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
+Dotted symbol is any symbol starting with a `.'. Only those present
+in BODY are let-bound and this search is done at compile time.
+
+For instance, the following code
+
+ (let-alist alist
+ (if (and .title .body)
+ .body
+ .site
+ .site.contents))
+
+essentially expands to
+
+ (let ((.title (cdr (assq 'title alist)))
+ (.body (cdr (assq 'body alist)))
+ (.site (cdr (assq 'site alist)))
+ (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
+ (if (and .title .body)
+ .body
+ .site
+ .site.contents))
+
+If you nest `let-alist' invocations, the inner one can't access
+the variables of the outer one. You can, however, access alists
+inside the original alist by using dots inside the symbol, as
+displayed in the example above."
+ (declare (indent 1) (debug t))
+ (let ((var (make-symbol "alist")))
+ `(let ((,var ,alist))
+ (let ,(mapcar (lambda (x) `(,(car x) ,(let-alist--access-sexp (car x) var)))
+ (delete-dups (let-alist--deep-dot-search body)))
+ ,@body))))
+
+(provide 'let-alist)
+
+;;; let-alist.el ends here
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index f2e691102d4..393f0dd99e8 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -1,10 +1,10 @@
;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
-;; Copyright (C) 1992, 1994, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 14 Jul 1992
;; Keywords: docs
;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
@@ -70,11 +70,8 @@
;; ;; Dave Brennan <brennan@hal.com>
;; ;; Eric Raymond <esr@snark.thyrsus.com>
;;
-;; This field may have some special values; notably "FSF", meaning
-;; "Free Software Foundation".
-;;
;; * Maintainer line --- should be a single name/address as in the Author
-;; line, or an address only, or the string "FSF". If there is no maintainer
+;; line, or an address only. If there is no maintainer
;; line, the person(s) in the Author field are presumed to be it.
;; The idea behind these two fields is to be able to write a Lisp function
;; that does "send mail to the author" without having to mine the name out by
@@ -88,10 +85,9 @@
;; at a different version of the file than the one they're accustomed to. This
;; may be an RCS or SCCS header.
;;
-;; * Adapted-By line --- this is for FSF's internal use. The person named
-;; in this field was the one responsible for installing and adapting the
-;; package for the distribution. (This file doesn't have one because the
-;; author *is* one of the maintainers.)
+;; * Adapted-By line --- this was used historically when some files
+;; were added to Emacs. The person named in this field installed and
+;; (possibly adapted) the package in the Emacs distribution.
;;
;; * Keywords line --- used by the finder code for finding Emacs
;; Lisp code related to a topic.
@@ -269,16 +265,17 @@ a section."
(defun lm-header (header)
"Return the contents of the header named HEADER."
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
- ;; RCS ident likes format "$identifier: data$"
- (looking-at
- (if (save-excursion
- (skip-chars-backward "^$" (match-beginning 0))
- (= (point) (match-beginning 0)))
- "[^\n]+" "[^$\n]+")))
- (match-string-no-properties 0))))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
+ ;; RCS ident likes format "$identifier: data$"
+ (looking-at
+ (if (save-excursion
+ (skip-chars-backward "^$" (match-beginning 0))
+ (= (point) (match-beginning 0)))
+ "[^\n]+" "[^$\n]+")))
+ (match-string-no-properties 0)))))
(defun lm-header-multiline (header)
"Return the contents of the header named HEADER, with continuation lines.
@@ -440,8 +437,10 @@ This can be found in an RCS or SCCS header."
;; Look for an SCCS header
((re-search-forward
(concat
- (regexp-quote "@(#)")
- (regexp-quote (file-name-nondirectory (buffer-file-name)))
+ "@(#)"
+ (if buffer-file-name
+ (regexp-quote (file-name-nondirectory buffer-file-name))
+ "[^\t\n]+")
"\t\\([012345679.]*\\)")
header-max t)
(match-string-no-properties 1)))))))
@@ -461,8 +460,8 @@ each line."
(let ((keywords (lm-keywords file)))
(if keywords
(if (string-match-p "," keywords)
- (split-string keywords ",[ \t\n]*" t)
- (split-string keywords "[ \t\n]+" t)))))
+ (split-string keywords ",[ \t\n]*" t "[ ]+")
+ (split-string keywords "[ \t\n]+" t "[ ]+")))))
(defvar finder-known-keywords)
(defun lm-keywords-finder-p (&optional file)
@@ -553,11 +552,11 @@ copyright notice is allowed."
((not (lm-keywords-finder-p))
"`Keywords:' has no valid finder keywords (see `finder-known-keywords')")
((not (lm-commentary-mark))
- "Can't find a 'Commentary' section marker")
+ "Can't find a `Commentary' section marker")
((not (lm-history-mark))
- "Can't find a 'History' section marker")
+ "Can't find a `History' section marker")
((not (lm-code-mark))
- "Can't find a 'Code' section marker")
+ "Can't find a `Code' section marker")
((progn
(goto-char (point-max))
(not
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index f7105b7d3b4..9ce0dfd49e8 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,8 +1,8 @@
-;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -*- coding: utf-8 -*-
+;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, languages
;; Package: emacs
@@ -28,22 +28,17 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defvar font-lock-comment-face)
(defvar font-lock-doc-face)
(defvar font-lock-keywords-case-fold-search)
(defvar font-lock-string-face)
-(defvar lisp-mode-abbrev-table nil)
(define-abbrev-table 'lisp-mode-abbrev-table ()
"Abbrev table for Lisp mode.")
-(defvar emacs-lisp-mode-abbrev-table nil)
-(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
- "Abbrev table for Emacs Lisp mode.
-It has `lisp-mode-abbrev-table' as its parent."
- :parents (list lisp-mode-abbrev-table))
-
-(defvar emacs-lisp-mode-syntax-table
+(defvar lisp--mode-syntax-table
(let ((table (make-syntax-table))
(i 0))
(while (< i ?0)
@@ -74,7 +69,7 @@ It has `lisp-mode-abbrev-table' as its parent."
(modify-syntax-entry ?` "' " table)
(modify-syntax-entry ?' "' " table)
(modify-syntax-entry ?, "' " table)
- (modify-syntax-entry ?@ "' " table)
+ (modify-syntax-entry ?@ "_ p" table)
;; Used to be singlequote; changed for flonums.
(modify-syntax-entry ?. "_ " table)
(modify-syntax-entry ?# "' " table)
@@ -82,13 +77,11 @@ It has `lisp-mode-abbrev-table' as its parent."
(modify-syntax-entry ?\\ "\\ " table)
(modify-syntax-entry ?\( "() " table)
(modify-syntax-entry ?\) ")( " table)
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table)
table)
- "Syntax table used in `emacs-lisp-mode'.")
+ "Parent syntax table used in Lisp modes.")
(defvar lisp-mode-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ (let ((table (make-syntax-table lisp--mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table)
(modify-syntax-entry ?# "' 14" table)
@@ -96,47 +89,66 @@ It has `lisp-mode-abbrev-table' as its parent."
table)
"Syntax table used in `lisp-mode'.")
+(eval-and-compile
+ (defconst lisp-mode-symbol-regexp "\\(?:\\sw\\|\\s_\\|\\\\.\\)+"))
+
(defvar lisp-imenu-generic-expression
(list
(list nil
(purecopy (concat "^\\s-*("
(eval-when-compile
(regexp-opt
- '("defun" "defun*" "defsubst" "defmacro"
- "defadvice" "define-skeleton"
- "define-minor-mode" "define-global-minor-mode"
+ '("defun" "defmacro"
+ ;; Elisp.
+ "defun*" "defsubst" "define-inline"
+ "define-advice" "defadvice" "define-skeleton"
+ "define-compilation-mode" "define-minor-mode"
+ "define-global-minor-mode"
"define-globalized-minor-mode"
"define-derived-mode" "define-generic-mode"
+ "cl-defun" "cl-defsubst" "cl-defmacro"
+ "cl-define-compiler-macro"
+ ;; CL.
"define-compiler-macro" "define-modify-macro"
"defsetf" "define-setf-expander"
"define-method-combination"
- "defgeneric" "defmethod"
- "cl-defun" "cl-defsubst" "cl-defmacro"
- "cl-define-compiler-macro") t))
- "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
+ ;; CLOS and EIEIO
+ "defgeneric" "defmethod")
+ t))
+ "\\s-+\\(" lisp-mode-symbol-regexp "\\)"))
2)
(list (purecopy "Variables")
(purecopy (concat "^\\s-*("
(eval-when-compile
(regexp-opt
- '("defconst" "defconstant" "defcustom"
- "defparameter" "define-symbol-macro") t))
- "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
+ '(;; Elisp
+ "defconst" "defcustom"
+ ;; CL
+ "defconstant"
+ "defparameter" "define-symbol-macro")
+ t))
+ "\\s-+\\(" lisp-mode-symbol-regexp "\\)"))
2)
;; For `defvar', we ignore (defvar FOO) constructs.
(list (purecopy "Variables")
- (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+ (purecopy (concat "^\\s-*(defvar\\s-+\\(" lisp-mode-symbol-regexp "\\)"
"[[:space:]\n]+[^)]"))
1)
(list (purecopy "Types")
(purecopy (concat "^\\s-*("
(eval-when-compile
(regexp-opt
- '("defgroup" "deftheme" "deftype" "defstruct"
- "defclass" "define-condition" "define-widget"
- "defface" "defpackage" "cl-deftype"
- "cl-defstruct") t))
- "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
+ '(;; Elisp
+ "defgroup" "deftheme"
+ "define-widget" "define-error"
+ "defface" "cl-deftype" "cl-defstruct"
+ ;; CL
+ "deftype" "defstruct"
+ "define-condition" "defpackage"
+ ;; CLOS and EIEIO
+ "defclass")
+ t))
+ "\\s-+'?\\(" lisp-mode-symbol-regexp "\\)"))
2))
"Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
@@ -153,6 +165,364 @@ It has `lisp-mode-abbrev-table' as its parent."
(defvar lisp-doc-string-elt-property 'doc-string-elt
"The symbol property that holds the docstring position info.")
+
+;;;; Font-lock support.
+
+(defun lisp--match-hidden-arg (limit)
+ (let ((res nil))
+ (while
+ (let ((ppss (parse-partial-sexp (line-beginning-position)
+ (line-end-position)
+ -1)))
+ (skip-syntax-forward " )")
+ (if (or (>= (car ppss) 0)
+ (looking-at ";\\|$"))
+ (progn
+ (forward-line 1)
+ (< (point) limit))
+ (looking-at ".*") ;Set the match-data.
+ (forward-line 1)
+ (setq res (point))
+ nil)))
+ res))
+
+(defun lisp--el-non-funcall-position-p (pos)
+ "Heuristically determine whether POS is an evaluated position."
+ (save-match-data
+ (save-excursion
+ (ignore-errors
+ (goto-char pos)
+ (or (eql (char-before) ?\')
+ (let* ((ppss (syntax-ppss))
+ (paren-posns (nth 9 ppss))
+ (parent
+ (when paren-posns
+ (goto-char (car (last paren-posns))) ;(up-list -1)
+ (cond
+ ((ignore-errors
+ (and (eql (char-after) ?\()
+ (when (cdr paren-posns)
+ (goto-char (car (last paren-posns 2)))
+ (looking-at "(\\_<let\\*?\\_>"))))
+ (goto-char (match-end 0))
+ 'let)
+ ((looking-at
+ (rx "("
+ (group-n 1 (+ (or (syntax w) (syntax _))))
+ symbol-end))
+ (prog1 (intern-soft (match-string-no-properties 1))
+ (goto-char (match-end 1))))))))
+ (or (eq parent 'declare)
+ (and (eq parent 'let)
+ (progn
+ (forward-sexp 1)
+ (< pos (point))))
+ (and (eq parent 'condition-case)
+ (progn
+ (forward-sexp 2)
+ (< (point) pos))))))))))
+
+(defun lisp--el-match-keyword (limit)
+ ;; FIXME: Move to elisp-mode.el.
+ (catch 'found
+ (while (re-search-forward
+ (eval-when-compile
+ (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
+ limit t)
+ (let ((sym (intern-soft (match-string 1))))
+ (when (or (special-form-p sym)
+ (and (macrop sym)
+ (not (get sym 'no-font-lock-keyword))
+ (not (lisp--el-non-funcall-position-p
+ (match-beginning 0)))))
+ (throw 'found t))))))
+
+(defmacro let-when-compile (bindings &rest body)
+ "Like `let*', but allow for compile time optimization.
+Use BINDINGS as in regular `let*', but in BODY each usage should
+be wrapped in `eval-when-compile'.
+This will generate compile-time constants from BINDINGS."
+ (declare (indent 1) (debug let))
+ (letrec ((loop
+ (lambda (bindings)
+ (if (null bindings)
+ (macroexpand-all (macroexp-progn body)
+ macroexpand-all-environment)
+ (let ((binding (pop bindings)))
+ (cl-progv (list (car binding))
+ (list (eval (nth 1 binding) t))
+ (funcall loop bindings)))))))
+ (funcall loop bindings)))
+
+(let-when-compile
+ ((lisp-fdefs '("defmacro" "defun"))
+ (lisp-vdefs '("defvar"))
+ (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1"
+ "prog2" "lambda" "unwind-protect" "condition-case"
+ "when" "unless" "with-output-to-string"
+ "ignore-errors" "dotimes" "dolist" "declare"))
+ (lisp-errs '("warn" "error" "signal"))
+ ;; Elisp constructs. Now they are update dynamically
+ ;; from obarray but they are also used for setting up
+ ;; the keywords for Common Lisp.
+ (el-fdefs '("defsubst" "cl-defsubst" "define-inline"
+ "define-advice" "defadvice" "defalias"
+ "define-derived-mode" "define-minor-mode"
+ "define-generic-mode" "define-global-minor-mode"
+ "define-globalized-minor-mode" "define-skeleton"
+ "define-widget"))
+ (el-vdefs '("defconst" "defcustom" "defvaralias" "defvar-local"
+ "defface"))
+ (el-tdefs '("defgroup" "deftheme"))
+ (el-errs '("user-error"))
+ ;; Common-Lisp constructs supported by EIEIO. FIXME: namespace.
+ (eieio-fdefs '("defgeneric" "defmethod"))
+ (eieio-tdefs '("defclass"))
+ ;; Common-Lisp constructs supported by cl-lib.
+ (cl-lib-fdefs '("defmacro" "defsubst" "defun" "defmethod" "defgeneric"))
+ (cl-lib-tdefs '("defstruct" "deftype"))
+ (cl-lib-errs '("assert" "check-type"))
+ ;; Common-Lisp constructs not supported by cl-lib.
+ (cl-fdefs '("defsetf" "define-method-combination"
+ "define-condition" "define-setf-expander"
+ ;; "define-function"??
+ "define-compiler-macro" "define-modify-macro"))
+ (cl-vdefs '("define-symbol-macro" "defconstant" "defparameter"))
+ (cl-tdefs '("defpackage" "defstruct" "deftype"))
+ (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase"
+ "declaim" "destructuring-bind" "do" "do*"
+ "ecase" "etypecase" "eval-when" "flet" "flet*"
+ "go" "handler-case" "handler-bind" "in-package" ;; "inline"
+ "labels" "letf" "locally" "loop"
+ "macrolet" "multiple-value-bind" "multiple-value-prog1"
+ "proclaim" "prog" "prog*" "progv"
+ "restart-case" "restart-bind" "return" "return-from"
+ "symbol-macrolet" "tagbody" "the" "typecase"
+ "with-accessors" "with-compilation-unit"
+ "with-condition-restarts" "with-hash-table-iterator"
+ "with-input-from-string" "with-open-file"
+ "with-open-stream" "with-package-iterator"
+ "with-simple-restart" "with-slots" "with-standard-io-syntax"))
+ (cl-errs '("abort" "cerror")))
+ (let ((vdefs (eval-when-compile
+ (append lisp-vdefs el-vdefs cl-vdefs)))
+ (tdefs (eval-when-compile
+ (append el-tdefs eieio-tdefs cl-tdefs cl-lib-tdefs
+ (mapcar (lambda (s) (concat "cl-" s)) cl-lib-tdefs))))
+ ;; Elisp and Common Lisp definers.
+ (el-defs-re (eval-when-compile
+ (regexp-opt (append lisp-fdefs lisp-vdefs
+ el-fdefs el-vdefs el-tdefs
+ (mapcar (lambda (s) (concat "cl-" s))
+ (append cl-lib-fdefs cl-lib-tdefs))
+ eieio-fdefs eieio-tdefs)
+ t)))
+ (cl-defs-re (eval-when-compile
+ (regexp-opt (append lisp-fdefs lisp-vdefs
+ cl-lib-fdefs cl-lib-tdefs
+ eieio-fdefs eieio-tdefs
+ cl-fdefs cl-vdefs cl-tdefs)
+ t)))
+ ;; Common Lisp keywords (Elisp keywords are handled dynamically).
+ (cl-kws-re (eval-when-compile
+ (regexp-opt (append lisp-kw cl-kw) t)))
+ ;; Elisp and Common Lisp "errors".
+ (el-errs-re (eval-when-compile
+ (regexp-opt (append (mapcar (lambda (s) (concat "cl-" s))
+ cl-lib-errs)
+ lisp-errs el-errs)
+ t)))
+ (cl-errs-re (eval-when-compile
+ (regexp-opt (append lisp-errs cl-lib-errs cl-errs) t))))
+ (dolist (v vdefs)
+ (put (intern v) 'lisp-define-type 'var))
+ (dolist (v tdefs)
+ (put (intern v) 'lisp-define-type 'type))
+
+ (define-obsolete-variable-alias 'lisp-font-lock-keywords-1
+ 'lisp-el-font-lock-keywords-1 "24.4")
+ (defconst lisp-el-font-lock-keywords-1
+ `( ;; Definitions.
+ (,(concat "(" el-defs-re "\\_>"
+ ;; Any whitespace and defined object.
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp
+ "\\|" lisp-mode-symbol-regexp "\\)?")
+ (1 font-lock-keyword-face)
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (cond ((eq type 'var) font-lock-variable-name-face)
+ ((eq type 'type) font-lock-type-face)
+ ;; If match-string 2 is non-nil, we encountered a
+ ;; form like (defalias (intern (concat s "-p"))),
+ ;; unless match-string 4 is also there. Then its a
+ ;; defmethod with (setf foo) as name.
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf method.
+ (match-string 4)))
+ font-lock-function-name-face)))
+ nil t))
+ ;; Emacs Lisp autoload cookies. Supports the slightly different
+ ;; forms used by mh-e, calendar, etc.
+ ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
+ "Subdued level highlighting for Emacs Lisp mode.")
+
+ (defconst lisp-cl-font-lock-keywords-1
+ `( ;; Definitions.
+ (,(concat "(" cl-defs-re "\\_>"
+ ;; Any whitespace and defined object.
+ "[ \t']*"
+ "\\(([ \t']*\\)?" ;; An opening paren.
+ "\\(\\(setf\\)[ \t]+" lisp-mode-symbol-regexp
+ "\\|" lisp-mode-symbol-regexp "\\)?")
+ (1 font-lock-keyword-face)
+ (3 (let ((type (get (intern-soft (match-string 1)) 'lisp-define-type)))
+ (cond ((eq type 'var) font-lock-variable-name-face)
+ ((eq type 'type) font-lock-type-face)
+ ((or (not (match-string 2)) ;; Normal defun.
+ (and (match-string 2) ;; Setf function.
+ (match-string 4))) font-lock-function-name-face)))
+ nil t)))
+ "Subdued level highlighting for Lisp modes.")
+
+ (define-obsolete-variable-alias 'lisp-font-lock-keywords-2
+ 'lisp-el-font-lock-keywords-2 "24.4")
+ (defconst lisp-el-font-lock-keywords-2
+ (append
+ lisp-el-font-lock-keywords-1
+ `( ;; Regexp negated char group.
+ ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+ ;; Control structures. Common Lisp forms.
+ (lisp--el-match-keyword . 1)
+ ;; Exit/Feature symbols as constants.
+ (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
+ "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?")
+ (1 font-lock-keyword-face)
+ (2 font-lock-constant-face nil t))
+ ;; Erroneous structures.
+ (,(concat "(" el-errs-re "\\_>")
+ (1 font-lock-warning-face))
+ ;; Words inside \\[] tend to be for `substitute-command-keys'.
+ (,(concat "\\\\\\\\\\[\\(" lisp-mode-symbol-regexp "\\)\\]")
+ (1 font-lock-constant-face prepend))
+ ;; Words inside ‘’ and '' and `' tend to be symbol names.
+ (,(concat "['`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
+ lisp-mode-symbol-regexp "\\)['’]")
+ (1 font-lock-constant-face prepend))
+ ;; Constant values.
+ (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
+ (0 font-lock-builtin-face))
+ ;; ELisp and CLisp `&' keywords as types.
+ (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>")
+ . font-lock-type-face)
+ ;; ELisp regexp grouping constructs
+ (,(lambda (bound)
+ (catch 'found
+ ;; The following loop is needed to continue searching after matches
+ ;; that do not occur in strings. The associated regexp matches one
+ ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to
+ ;; avoid highlighting, for example, `\\(' in `\\\\('.
+ (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
+ (unless (match-beginning 2)
+ (let ((face (get-text-property (1- (point)) 'face)))
+ (when (or (and (listp face)
+ (memq 'font-lock-string-face face))
+ (eq 'font-lock-string-face face))
+ (throw 'found t)))))))
+ (1 'font-lock-regexp-grouping-backslash prepend)
+ (3 'font-lock-regexp-grouping-construct prepend))
+ ;; This is too general -- rms.
+ ;; A user complained that he has functions whose names start with `do'
+ ;; and that they get the wrong color.
+ ;; ;; CL `with-' and `do-' constructs
+ ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 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?")))
+ ))
+ "Gaudy level highlighting for Emacs Lisp mode.")
+
+ (defconst lisp-cl-font-lock-keywords-2
+ (append
+ lisp-cl-font-lock-keywords-1
+ `( ;; Regexp negated char group.
+ ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)
+ ;; Control structures. Common Lisp forms.
+ (,(concat "(" cl-kws-re "\\_>") . 1)
+ ;; Exit/Feature symbols as constants.
+ (,(concat "(\\(catch\\|throw\\|provide\\|require\\)\\_>"
+ "[ \t']*\\(" lisp-mode-symbol-regexp "\\)?")
+ (1 font-lock-keyword-face)
+ (2 font-lock-constant-face nil t))
+ ;; Erroneous structures.
+ (,(concat "(" cl-errs-re "\\_>")
+ (1 font-lock-warning-face))
+ ;; Words inside ‘’ and '' and `' tend to be symbol names.
+ (,(concat "['`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
+ lisp-mode-symbol-regexp "\\)['’]")
+ (1 font-lock-constant-face prepend))
+ ;; Constant values.
+ (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
+ (0 font-lock-builtin-face))
+ ;; ELisp and CLisp `&' keywords as types.
+ (,(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'
+ ;; and that they get the wrong color.
+ ;; ;; CL `with-' and `do-' constructs
+ ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 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?")))
+ ))
+ "Gaudy level highlighting for Lisp modes.")))
+
+(define-obsolete-variable-alias 'lisp-font-lock-keywords
+ 'lisp-el-font-lock-keywords "24.4")
+(defvar lisp-el-font-lock-keywords lisp-el-font-lock-keywords-1
+ "Default expressions to highlight in Emacs Lisp mode.")
+(defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1
+ "Default expressions to highlight in Lisp modes.")
+
+(defun lisp-string-in-doc-position-p (listbeg startpos)
+ (let* ((firstsym (and listbeg
+ (save-excursion
+ (goto-char listbeg)
+ (and (looking-at
+ (eval-when-compile
+ (concat "([ \t\n]*\\("
+ lisp-mode-symbol-regexp "\\)")))
+ (match-string 1)))))
+ (docelt (and firstsym
+ (function-get (intern-soft firstsym)
+ lisp-doc-string-elt-property))))
+ (and docelt
+ ;; It's a string in a form that can have a docstring.
+ ;; Check whether it's in docstring position.
+ (save-excursion
+ (when (functionp docelt)
+ (goto-char (match-end 1))
+ (setq docelt (funcall docelt)))
+ (goto-char listbeg)
+ (forward-char 1)
+ (condition-case nil
+ (while (and (> docelt 0) (< (point) startpos)
+ (progn (forward-sexp 1) t))
+ (setq docelt (1- docelt)))
+ (error nil))
+ (and (zerop docelt) (<= (point) startpos)
+ (progn (forward-comment (point-max)) t)
+ (= (point) startpos))))))
+
+(defun lisp-string-after-doc-keyword-p (listbeg startpos)
+ (and listbeg ; We are inside a Lisp form.
+ (save-excursion
+ (goto-char startpos)
+ (ignore-errors
+ (progn (backward-sexp 1)
+ (looking-at ":documentation\\_>"))))))
+
(defun lisp-font-lock-syntactic-face-function (state)
(if (nth 3 state)
;; This might be a (doc)string or a |...| symbol.
@@ -160,37 +530,15 @@ It has `lisp-mode-abbrev-table' as its parent."
(if (eq (char-after startpos) ?|)
;; This is not a string, but a |...| symbol.
nil
- (let* ((listbeg (nth 1 state))
- (firstsym (and listbeg
- (save-excursion
- (goto-char listbeg)
- (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
- (match-string 1)))))
- (docelt (and firstsym
- (function-get (intern-soft firstsym)
- lisp-doc-string-elt-property))))
- (if (and docelt
- ;; It's a string in a form that can have a docstring.
- ;; Check whether it's in docstring position.
- (save-excursion
- (when (functionp docelt)
- (goto-char (match-end 1))
- (setq docelt (funcall docelt)))
- (goto-char listbeg)
- (forward-char 1)
- (condition-case nil
- (while (and (> docelt 0) (< (point) startpos)
- (progn (forward-sexp 1) t))
- (setq docelt (1- docelt)))
- (error nil))
- (and (zerop docelt) (<= (point) startpos)
- (progn (forward-comment (point-max)) t)
- (= (point) (nth 8 state)))))
+ (let ((listbeg (nth 1 state)))
+ (if (or (lisp-string-in-doc-position-p listbeg startpos)
+ (lisp-string-after-doc-keyword-p listbeg startpos))
font-lock-doc-face
font-lock-string-face))))
font-lock-comment-face))
-(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive)
+(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
+ elisp)
"Common initialization routine for lisp modes.
The LISP-SYNTAX argument is used by code in inf-lisp.el and is
\(uselessly) passed from pp.el, chistory.el, gnus-kill.el and
@@ -214,27 +562,28 @@ font-lock keywords will not be case sensitive."
(setq-local outline-level 'lisp-outline-level)
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
(setq-local comment-start ";")
- ;; Look within the line for a ; following an even number of backslashes
- ;; after either a non-backslash or the line beginning.
- (setq-local comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
- ;; Font lock mode uses this only when it KNOWS a comment is starting.
- (setq-local font-lock-comment-start-skip ";+ *")
+ (setq-local comment-start-skip ";+ *")
(setq-local comment-add 1) ;default to `;;' in comment-region
(setq-local comment-column 40)
- ;; Don't get confused by `;' in doc strings when paragraph-filling.
- (setq-local comment-use-global-state t)
+ (setq-local comment-use-syntax t)
(setq-local imenu-generic-expression lisp-imenu-generic-expression)
(setq-local multibyte-syntax-as-symbol t)
- (setq-local syntax-begin-function 'beginning-of-defun)
+ ;; (setq-local syntax-begin-function 'beginning-of-defun) ;;Bug#16247.
(setq font-lock-defaults
- `((lisp-font-lock-keywords
- lisp-font-lock-keywords-1
- lisp-font-lock-keywords-2)
+ `(,(if elisp '(lisp-el-font-lock-keywords
+ lisp-el-font-lock-keywords-1
+ lisp-el-font-lock-keywords-2)
+ '(lisp-cl-font-lock-keywords
+ lisp-cl-font-lock-keywords-1
+ lisp-cl-font-lock-keywords-2))
nil ,keywords-case-insensitive nil nil
(font-lock-mark-block-function . mark-defun)
+ (font-lock-extra-managed-props help-echo)
(font-lock-syntactic-face-function
. lisp-font-lock-syntactic-face-function)))
- (setq-local prettify-symbols-alist lisp--prettify-symbols-alist))
+ (setq-local prettify-symbols-alist lisp--prettify-symbols-alist)
+ (setq-local electric-pair-skip-whitespace 'chomp)
+ (setq-local electric-pair-open-newline-between-pairs nil))
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
@@ -281,166 +630,6 @@ font-lock keywords will not be case sensitive."
map)
"Keymap for commands shared by all sorts of Lisp modes.")
-(defvar emacs-lisp-mode-map
- (let ((map (make-sparse-keymap "Emacs-Lisp"))
- (menu-map (make-sparse-keymap "Emacs-Lisp"))
- (lint-map (make-sparse-keymap))
- (prof-map (make-sparse-keymap))
- (tracing-map (make-sparse-keymap)))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\t" 'completion-at-point)
- (define-key map "\e\C-x" 'eval-defun)
- (define-key map "\e\C-q" 'indent-pp-sexp)
- (bindings--define-key map [menu-bar emacs-lisp]
- (cons "Emacs-Lisp" menu-map))
- (bindings--define-key menu-map [eldoc]
- '(menu-item "Auto-Display Documentation Strings" eldoc-mode
- :button (:toggle . (bound-and-true-p eldoc-mode))
- :help "Display the documentation string for the item under cursor"))
- (bindings--define-key menu-map [checkdoc]
- '(menu-item "Check Documentation Strings" checkdoc
- :help "Check documentation strings for style requirements"))
- (bindings--define-key menu-map [re-builder]
- '(menu-item "Construct Regexp" re-builder
- :help "Construct a regexp interactively"))
- (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
- (bindings--define-key tracing-map [tr-a]
- '(menu-item "Untrace All" untrace-all
- :help "Untrace all currently traced functions"))
- (bindings--define-key tracing-map [tr-uf]
- '(menu-item "Untrace Function..." untrace-function
- :help "Untrace function, and possibly activate all remaining advice"))
- (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
- (bindings--define-key tracing-map [tr-q]
- '(menu-item "Trace Function Quietly..." trace-function-background
- :help "Trace the function with trace output going quietly to a buffer"))
- (bindings--define-key tracing-map [tr-f]
- '(menu-item "Trace Function..." trace-function
- :help "Trace the function given as an argument"))
- (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
- (bindings--define-key prof-map [prof-restall]
- '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
- :help "Restore the original definitions of all functions being profiled"))
- (bindings--define-key prof-map [prof-restfunc]
- '(menu-item "Remove Instrumentation for Function..." elp-restore-function
- :help "Restore an instrumented function to its original definition"))
-
- (bindings--define-key prof-map [sep-rem] menu-bar-separator)
- (bindings--define-key prof-map [prof-resall]
- '(menu-item "Reset Counters for All Functions" elp-reset-all
- :help "Reset the profiling information for all functions being profiled"))
- (bindings--define-key prof-map [prof-resfunc]
- '(menu-item "Reset Counters for Function..." elp-reset-function
- :help "Reset the profiling information for a function"))
- (bindings--define-key prof-map [prof-res]
- '(menu-item "Show Profiling Results" elp-results
- :help "Display current profiling results"))
- (bindings--define-key prof-map [prof-pack]
- '(menu-item "Instrument Package..." elp-instrument-package
- :help "Instrument for profiling all function that start with a prefix"))
- (bindings--define-key prof-map [prof-func]
- '(menu-item "Instrument Function..." elp-instrument-function
- :help "Instrument a function for profiling"))
- ;; Maybe this should be in a separate submenu from the ELP stuff?
- (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
- (bindings--define-key prof-map [prof-natprof-stop]
- '(menu-item "Stop Native Profiler" profiler-stop
- :help "Stop recording profiling information"
- :enable (and (featurep 'profiler)
- (profiler-running-p))))
- (bindings--define-key prof-map [prof-natprof-report]
- '(menu-item "Show Profiler Report" profiler-report
- :help "Show the current profiler report"
- :enable (and (featurep 'profiler)
- (profiler-running-p))))
- (bindings--define-key prof-map [prof-natprof-start]
- '(menu-item "Start Native Profiler..." profiler-start
- :help "Start recording profiling information"))
-
- (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
- (bindings--define-key lint-map [lint-di]
- '(menu-item "Lint Directory..." elint-directory
- :help "Lint a directory"))
- (bindings--define-key lint-map [lint-f]
- '(menu-item "Lint File..." elint-file
- :help "Lint a file"))
- (bindings--define-key lint-map [lint-b]
- '(menu-item "Lint Buffer" elint-current-buffer
- :help "Lint the current buffer"))
- (bindings--define-key lint-map [lint-d]
- '(menu-item "Lint Defun" elint-defun
- :help "Lint the function at point"))
- (bindings--define-key menu-map [edebug-defun]
- '(menu-item "Instrument Function for Debugging" edebug-defun
- :help "Evaluate the top level form point is in, stepping through with Edebug"
- :keys "C-u C-M-x"))
- (bindings--define-key menu-map [separator-byte] menu-bar-separator)
- (bindings--define-key menu-map [disas]
- '(menu-item "Disassemble Byte Compiled Object..." disassemble
- :help "Print disassembled code for OBJECT in a buffer"))
- (bindings--define-key menu-map [byte-recompile]
- '(menu-item "Byte-recompile Directory..." byte-recompile-directory
- :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
- (bindings--define-key menu-map [emacs-byte-compile-and-load]
- '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
- :help "Byte-compile the current file (if it has changed), then load compiled code"))
- (bindings--define-key menu-map [byte-compile]
- '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
- :help "Byte compile the file containing the current buffer"))
- (bindings--define-key menu-map [separator-eval] menu-bar-separator)
- (bindings--define-key menu-map [ielm]
- '(menu-item "Interactive Expression Evaluation" ielm
- :help "Interactively evaluate Emacs Lisp expressions"))
- (bindings--define-key menu-map [eval-buffer]
- '(menu-item "Evaluate Buffer" eval-buffer
- :help "Execute the current buffer as Lisp code"))
- (bindings--define-key menu-map [eval-region]
- '(menu-item "Evaluate Region" eval-region
- :help "Execute the region as Lisp code"
- :enable mark-active))
- (bindings--define-key menu-map [eval-sexp]
- '(menu-item "Evaluate Last S-expression" eval-last-sexp
- :help "Evaluate sexp before point; print value in echo area"))
- (bindings--define-key menu-map [separator-format] menu-bar-separator)
- (bindings--define-key menu-map [comment-region]
- '(menu-item "Comment Out Region" comment-region
- :help "Comment or uncomment each line in the region"
- :enable mark-active))
- (bindings--define-key menu-map [indent-region]
- '(menu-item "Indent Region" indent-region
- :help "Indent each nonblank line in the region"
- :enable mark-active))
- (bindings--define-key menu-map [indent-line]
- '(menu-item "Indent Line" lisp-indent-line))
- map)
- "Keymap for Emacs Lisp mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(defun emacs-lisp-byte-compile ()
- "Byte compile the file containing the current buffer."
- (interactive)
- (if buffer-file-name
- (byte-compile-file buffer-file-name)
- (error "The buffer must be saved in a file first")))
-
-(defun emacs-lisp-byte-compile-and-load ()
- "Byte-compile the current file (if it has changed), then load compiled code."
- (interactive)
- (or buffer-file-name
- (error "The buffer must be saved in a file first"))
- (require 'bytecomp)
- ;; Recompile if file or buffer has changed since last compilation.
- (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))
-
-(defcustom emacs-lisp-mode-hook nil
- "Hook run when entering Emacs Lisp mode."
- :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
- :type 'hook
- :group 'lisp)
-
(defcustom lisp-mode-hook nil
"Hook run when entering Lisp mode."
:options '(imenu-add-menubar-index)
@@ -449,81 +638,13 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(defcustom lisp-interaction-mode-hook nil
"Hook run when entering Lisp Interaction mode."
- :options '(turn-on-eldoc-mode)
+ :options '(eldoc-mode)
:type 'hook
:group 'lisp)
(defconst lisp--prettify-symbols-alist
'(("lambda" . ?λ)))
-(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
- "Major mode for editing Lisp code to run in Emacs.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs. Semicolons start comments.
-
-\\{emacs-lisp-mode-map}
-Entry to this mode calls the value of `emacs-lisp-mode-hook'
-if that value is non-nil."
- :group 'lisp
- (lisp-mode-variables)
- (setq imenu-case-fold-search nil)
- (add-hook 'completion-at-point-functions
- 'lisp-completion-at-point nil 'local))
-
-;;; Emacs Lisp Byte-Code mode
-
-(eval-and-compile
- (defconst emacs-list-byte-code-comment-re
- (concat "\\(#\\)@\\([0-9]+\\) "
- ;; Make sure it's a docstring and not a lazy-loaded byte-code.
- "\\(?:[^(]\\|([^\"]\\)")))
-
-(defun emacs-lisp-byte-code-comment (end &optional _point)
- "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
- (let ((ppss (syntax-ppss)))
- (when (and (nth 4 ppss)
- (eq (char-after (nth 8 ppss)) ?#))
- (let* ((n (save-excursion
- (goto-char (nth 8 ppss))
- (when (looking-at emacs-list-byte-code-comment-re)
- (string-to-number (match-string 2)))))
- ;; `maxdiff' tries to make sure the loop below terminates.
- (maxdiff n))
- (when n
- (let* ((bchar (match-end 2))
- (b (position-bytes bchar)))
- (goto-char (+ b n))
- (while (let ((diff (- (position-bytes (point)) b n)))
- (unless (zerop diff)
- (when (> diff maxdiff) (setq diff maxdiff))
- (forward-char (- diff))
- (setq maxdiff (if (> diff 0) diff
- (max (1- maxdiff) 1)))
- t))))
- (if (<= (point) end)
- (put-text-property (1- (point)) (point)
- 'syntax-table
- (string-to-syntax "> b"))
- (goto-char end)))))))
-
-(defun emacs-lisp-byte-code-syntax-propertize (start end)
- (emacs-lisp-byte-code-comment end (point))
- (funcall
- (syntax-propertize-rules
- (emacs-list-byte-code-comment-re
- (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
- start end))
-
-(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
-(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
- "Elisp-Byte-Code"
- "Major mode for *.elc files."
- ;; TODO: Add way to disassemble byte-code under point.
- (setq-local open-paren-in-column-0-is-defun-start nil)
- (setq-local syntax-propertize-function
- #'emacs-lisp-byte-code-syntax-propertize))
-
;;; Generic Lisp mode.
(defvar lisp-mode-map
@@ -554,10 +675,7 @@ 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.
-
-Entry to this mode calls the value of `lisp-mode-hook'
-if that value is non-nil."
+or to switch back to an existing one."
(lisp-mode-variables nil t)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
@@ -580,407 +698,6 @@ if that value is non-nil."
(interactive)
(error "Process lisp does not exist"))
-(defvar lisp-interaction-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Lisp-Interaction")))
- (set-keymap-parent map lisp-mode-shared-map)
- (define-key map "\e\C-x" 'eval-defun)
- (define-key map "\e\C-q" 'indent-pp-sexp)
- (define-key map "\e\t" 'completion-at-point)
- (define-key map "\n" 'eval-print-last-sexp)
- (bindings--define-key map [menu-bar lisp-interaction]
- (cons "Lisp-Interaction" menu-map))
- (bindings--define-key menu-map [eval-defun]
- '(menu-item "Evaluate Defun" eval-defun
- :help "Evaluate the top-level form containing point, or after point"))
- (bindings--define-key menu-map [eval-print-last-sexp]
- '(menu-item "Evaluate and Print" eval-print-last-sexp
- :help "Evaluate sexp before point; print value into current buffer"))
- (bindings--define-key menu-map [edebug-defun-lisp-interaction]
- '(menu-item "Instrument Function for Debugging" edebug-defun
- :help "Evaluate the top level form point is in, stepping through with Edebug"
- :keys "C-u C-M-x"))
- (bindings--define-key menu-map [indent-pp-sexp]
- '(menu-item "Indent or Pretty-Print" indent-pp-sexp
- :help "Indent each line of the list starting just after point, or prettyprint it"))
- (bindings--define-key menu-map [complete-symbol]
- '(menu-item "Complete Lisp Symbol" completion-at-point
- :help "Perform completion on Lisp symbol preceding point"))
- map)
- "Keymap for Lisp Interaction mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
- "Major mode for typing and evaluating Lisp forms.
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
-before point, and prints its value into the buffer, advancing point.
-Note that printing is controlled by `eval-expression-print-length'
-and `eval-expression-print-level'.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Paragraphs are separated only by blank lines.
-Semicolons start comments.
-
-\\{lisp-interaction-mode-map}
-Entry to this mode calls the value of `lisp-interaction-mode-hook'
-if that value is non-nil."
- :abbrev-table nil)
-
-(defun eval-print-last-sexp ()
- "Evaluate sexp before point; print value into current buffer.
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger.
-
-Note that printing the result is controlled by the variables
-`eval-expression-print-length' and `eval-expression-print-level',
-which see."
- (interactive)
- (let ((standard-output (current-buffer)))
- (terpri)
- (eval-last-sexp t)
- (terpri)))
-
-
-(defun last-sexp-setup-props (beg end value alt1 alt2)
- "Set up text properties for the output of `eval-last-sexp-1'.
-BEG and END are the start and end of the output in current-buffer.
-VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
-alternative printed representations that can be displayed."
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-m" 'last-sexp-toggle-display)
- (define-key map [down-mouse-2] 'mouse-set-point)
- (define-key map [mouse-2] 'last-sexp-toggle-display)
- (add-text-properties
- beg end
- `(printed-value (,value ,alt1 ,alt2)
- mouse-face highlight
- keymap ,map
- help-echo "RET, mouse-2: toggle abbreviated display"
- rear-nonsticky (mouse-face keymap help-echo
- printed-value)))))
-
-
-(defun last-sexp-toggle-display (&optional _arg)
- "Toggle between abbreviated and unabbreviated printed representations."
- (interactive "P")
- (save-restriction
- (widen)
- (let ((value (get-text-property (point) 'printed-value)))
- (when value
- (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
- 'printed-value)
- (point)))
- (end (or (next-single-char-property-change (point) 'printed-value) (point)))
- (standard-output (current-buffer))
- (point (point)))
- (delete-region beg end)
- (insert (nth 1 value))
- (or (= beg point)
- (setq point (1- (point))))
- (last-sexp-setup-props beg (point)
- (nth 0 value)
- (nth 2 value)
- (nth 1 value))
- (goto-char (min (point-max) point)))))))
-
-(defun prin1-char (char)
- "Return a string representing CHAR as a character rather than as an integer.
-If CHAR is not a character, return nil."
- (and (integerp char)
- (eventp char)
- (let ((c (event-basic-type char))
- (mods (event-modifiers char))
- string)
- ;; Prevent ?A from turning into ?\S-a.
- (if (and (memq 'shift mods)
- (zerop (logand char ?\S-\^@))
- (not (let ((case-fold-search nil))
- (char-equal c (upcase c)))))
- (setq c (upcase c) mods nil))
- ;; What string are we considering using?
- (condition-case nil
- (setq string
- (concat
- "?"
- (mapconcat
- (lambda (modif)
- (cond ((eq modif 'super) "\\s-")
- (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
- mods "")
- (cond
- ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
- ((eq c 127) "\\C-?")
- (t
- (string c)))))
- (error nil))
- ;; Verify the string reads a CHAR, not to some other character.
- ;; If it doesn't, return nil instead.
- (and string
- (= (car (read-from-string string)) char)
- string))))
-
-
-(defun preceding-sexp ()
- "Return sexp before the point."
- (let ((opoint (point))
- ignore-quotes
- expr)
- (save-excursion
- (with-syntax-table emacs-lisp-mode-syntax-table
- ;; If this sexp appears to be enclosed in `...'
- ;; then ignore the surrounding quotes.
- (setq ignore-quotes
- (or (eq (following-char) ?\')
- (eq (preceding-char) ?\')))
- (forward-sexp -1)
- ;; If we were after `?\e' (or similar case),
- ;; use the whole thing, not just the `e'.
- (when (eq (preceding-char) ?\\)
- (forward-char -1)
- (when (eq (preceding-char) ??)
- (forward-char -1)))
-
- ;; Skip over hash table read syntax.
- (and (> (point) (1+ (point-min)))
- (looking-back "#s" (- (point) 2))
- (forward-char -2))
-
- ;; Skip over `#N='s.
- (when (eq (preceding-char) ?=)
- (let (labeled-p)
- (save-excursion
- (skip-chars-backward "0-9#=")
- (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
- (when labeled-p
- (forward-sexp -1))))
-
- (save-restriction
- ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
- ;; `variable' so that the value is returned, not the
- ;; name
- (if (and ignore-quotes
- (eq (following-char) ?`))
- (forward-char))
- (narrow-to-region (point-min) opoint)
- (setq expr (read (current-buffer)))
- ;; If it's an (interactive ...) form, it's more
- ;; useful to show how an interactive call would
- ;; use it.
- (and (consp expr)
- (eq (car expr) 'interactive)
- (setq expr
- (list 'call-interactively
- (list 'quote
- (list 'lambda
- '(&rest args)
- expr
- 'args)))))
- expr)))))
-
-
-(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
- "Evaluate sexp before point; print value in the echo area.
-With argument, print output into current buffer."
- (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
- ;; Setup the lexical environment if lexical-binding is enabled.
- (eval-last-sexp-print-value
- (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding))))
-
-
-(defun eval-last-sexp-print-value (value)
- (let ((unabbreviated (let ((print-length nil) (print-level nil))
- (prin1-to-string value)))
- (print-length eval-expression-print-length)
- (print-level eval-expression-print-level)
- (beg (point))
- end)
- (prog1
- (prin1 value)
- (let ((str (eval-expression-print-format value)))
- (if str (princ str)))
- (setq end (point))
- (when (and (bufferp standard-output)
- (or (not (null print-length))
- (not (null print-level)))
- (not (string= unabbreviated
- (buffer-substring-no-properties beg end))))
- (last-sexp-setup-props beg end value
- unabbreviated
- (buffer-substring-no-properties beg end))
- ))))
-
-
-(defvar eval-last-sexp-fake-value (make-symbol "t"))
-
-(defun eval-sexp-add-defvars (exp &optional pos)
- "Prepend EXP with all the `defvar's that precede it in the buffer.
-POS specifies the starting position where EXP was found and defaults to point."
- (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
- (if (not lexical-binding)
- exp
- (save-excursion
- (unless pos (setq pos (point)))
- (let ((vars ()))
- (goto-char (point-min))
- (while (re-search-forward
- "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
- pos t)
- (let ((var (intern (match-string 1))))
- (and (not (special-variable-p var))
- (save-excursion
- (zerop (car (syntax-ppss (match-beginning 0)))))
- (push var vars))))
- `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
-
-(defun eval-last-sexp (eval-last-sexp-arg-internal)
- "Evaluate sexp before point; print value in the echo area.
-Interactively, with prefix argument, print output into current buffer.
-Truncates long output according to the value of the variables
-`eval-expression-print-length' and `eval-expression-print-level'.
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger."
- (interactive "P")
- (if (null eval-expression-debug-on-error)
- (eval-last-sexp-1 eval-last-sexp-arg-internal)
- (let ((value
- (let ((debug-on-error eval-last-sexp-fake-value))
- (cons (eval-last-sexp-1 eval-last-sexp-arg-internal)
- debug-on-error))))
- (unless (eq (cdr value) eval-last-sexp-fake-value)
- (setq debug-on-error (cdr value)))
- (car value))))
-
-(defun eval-defun-1 (form)
- "Treat some expressions specially.
-Reset the `defvar' and `defcustom' variables to the initial value.
-\(For `defcustom', use the :set function if there is one.)
-Reinitialize the face according to the `defface' specification."
- ;; The code in edebug-defun should be consistent with this, but not
- ;; the same, since this gets a macroexpanded form.
- (cond ((not (listp form))
- form)
- ((and (eq (car form) 'defvar)
- (cdr-safe (cdr-safe form))
- (boundp (cadr form)))
- ;; Force variable to be re-set.
- `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
- (setq-default ,(nth 1 form) ,(nth 2 form))))
- ;; `defcustom' is now macroexpanded to
- ;; `custom-declare-variable' with a quoted value arg.
- ((and (eq (car form) 'custom-declare-variable)
- (default-boundp (eval (nth 1 form) lexical-binding)))
- ;; Force variable to be bound, using :set function if specified.
- (let ((setfunc (memq :set form)))
- (when setfunc
- (setq setfunc (car-safe (cdr-safe setfunc)))
- (or (functionp setfunc) (setq setfunc nil)))
- (funcall (or setfunc 'set-default)
- (eval (nth 1 form) lexical-binding)
- ;; The second arg is an expression that evaluates to
- ;; an expression. The second evaluation is the one
- ;; normally performed not by normal execution but by
- ;; custom-initialize-set (for example), which does not
- ;; use lexical-binding.
- (eval (eval (nth 2 form) lexical-binding))))
- form)
- ;; `defface' is macroexpanded to `custom-declare-face'.
- ((eq (car form) 'custom-declare-face)
- ;; Reset the face.
- (let ((face-symbol (eval (nth 1 form) lexical-binding)))
- (setq face-new-frame-defaults
- (assq-delete-all face-symbol face-new-frame-defaults))
- (put face-symbol 'face-defface-spec nil)
- (put face-symbol 'face-override-spec nil))
- form)
- ((eq (car form) 'progn)
- (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
- (t form)))
-
-(defun eval-defun-2 ()
- "Evaluate defun that point is in or before.
-The value is displayed in the echo area.
-If the current defun is actually a call to `defvar',
-then reset the variable using the initial value expression
-even if the variable already has some other value.
-\(Normally `defvar' does not change the variable's value
-if it already has a value.\)
-
-Return the result of evaluation."
- ;; FIXME: the print-length/level bindings should only be applied while
- ;; printing, not while evaluating.
- (let ((debug-on-error eval-expression-debug-on-error)
- (print-length eval-expression-print-length)
- (print-level eval-expression-print-level))
- (save-excursion
- ;; Arrange for eval-region to "read" the (possibly) altered form.
- ;; eval-region handles recording which file defines a function or
- ;; variable. Re-written using `apply' to avoid capturing
- ;; variables like `end'.
- (apply
- #'eval-region
- (let ((standard-output t)
- beg end form)
- ;; Read the form from the buffer, and record where it ends.
- (save-excursion
- (end-of-defun)
- (beginning-of-defun)
- (setq beg (point))
- (setq form (read (current-buffer)))
- (setq end (point)))
- ;; Alter the form if necessary.
- (setq form (eval-sexp-add-defvars (eval-defun-1 (macroexpand form))))
- (list beg end standard-output
- `(lambda (ignore)
- ;; Skipping to the end of the specified region
- ;; will make eval-region return.
- (goto-char ,end)
- ',form))))))
- ;; The result of evaluation has been put onto VALUES. So return it.
- (car values))
-
-(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point, or after point.
-
-If the current defun is actually a call to `defvar' or `defcustom',
-evaluating it this way resets the variable using its initial value
-expression (using the defcustom's :set function if there is one), even
-if the variable already has some other value. \(Normally `defvar' and
-`defcustom' do not alter the value if there already is one.) In an
-analogous way, evaluating a `defface' overrides any customizations of
-the face, so that it becomes defined exactly as the `defface' expression
-says.
-
-If `eval-expression-debug-on-error' is non-nil, which is the default,
-this command arranges for all errors to enter the debugger.
-
-With a prefix argument, instrument the code for Edebug.
-
-If acting on a `defun' for FUNCTION, and the function was
-instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
-instrumented, just FUNCTION is printed.
-
-If not acting on a `defun', the result of evaluation is displayed in
-the echo area. This display is controlled by the variables
-`eval-expression-print-length' and `eval-expression-print-level',
-which see."
- (interactive "P")
- (cond (edebug-it
- (require 'edebug)
- (eval-defun (not edebug-all-defs)))
- (t
- (if (null eval-expression-debug-on-error)
- (eval-defun-2)
- (let ((old-value (make-symbol "t")) new-value value)
- (let ((debug-on-error old-value))
- (setq value (eval-defun-2))
- (setq new-value debug-on-error))
- (unless (eq old-value new-value)
- (setq debug-on-error new-value))
- value)))))
-
;; May still be used by some external Lisp-mode variant.
(define-obsolete-function-alias 'lisp-comment-indent
'comment-indent-default "22.1")
@@ -1147,9 +864,10 @@ is the buffer position of the start of the containing expression."
;; Handle prefix characters and whitespace
;; following an open paren. (Bug#1012)
(backward-prefix-chars)
- (while (and (not (looking-back "^[ \t]*\\|([ \t]+"))
- (or (not containing-sexp)
- (< (1+ containing-sexp) (point))))
+ (while (not (or (looking-back "^[ \t]*\\|([ \t]+"
+ (line-beginning-position))
+ (and containing-sexp
+ (>= (1+ containing-sexp) (point)))))
(forward-sexp -1)
(backward-prefix-chars))
(setq calculate-lisp-indent-last-sexp (point)))
@@ -1190,7 +908,7 @@ property `lisp-indent-function' (or the deprecated `lisp-indent-hook'),
it specifies how to indent. The property value can be:
* `defun', meaning indent `defun'-style
- \(this is also the case if there is no property and the function
+ (this is also the case if there is no property and the function
has a name that begins with \"def\", and three or more arguments);
* an integer N, meaning indent the first N arguments specially
@@ -1303,19 +1021,21 @@ Lisp function does not specify a special indentation."
;; like defun if the first form is placed on the next line, otherwise
;; it is indented like any other form (i.e. forms line up under first).
-(put 'autoload 'lisp-indent-function 'defun)
+(put 'autoload 'lisp-indent-function 'defun) ;Elisp
(put 'progn 'lisp-indent-function 0)
(put 'prog1 'lisp-indent-function 1)
(put 'prog2 'lisp-indent-function 2)
-(put 'save-excursion 'lisp-indent-function 0)
-(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-current-buffer 'lisp-indent-function 0)
+(put 'save-excursion 'lisp-indent-function 0) ;Elisp
+(put 'save-restriction 'lisp-indent-function 0) ;Elisp
+(put 'save-current-buffer 'lisp-indent-function 0) ;Elisp
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)
(put 'while 'lisp-indent-function 1)
(put 'if 'lisp-indent-function 2)
(put 'catch 'lisp-indent-function 1)
(put 'condition-case 'lisp-indent-function 2)
+(put 'handler-case 'lisp-indent-function 1) ;CL
+(put 'handler-bind 'lisp-indent-function 1) ;CL
(put 'unwind-protect 'lisp-indent-function 1)
(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index b37a811b8d5..ca977db4b1d 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -1,9 +1,9 @@
;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1994, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1994, 2000-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, languages
;; Package: emacs
@@ -57,10 +57,14 @@ Should take the same arguments and behave similarly to `forward-sexp'.")
(defun forward-sexp (&optional arg)
"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 point is not in a string or comment.
-Calls `forward-sexp-function' to do the work, if that is non-nil."
+With ARG, do it that many times. Negative arg -N means move
+backward across N balanced expressions. This command assumes
+point is not in a string or comment. Calls
+`forward-sexp-function' to do the work, if that is non-nil. 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
@@ -106,6 +110,8 @@ This command assumes point is not in a string or comment."
(defun forward-list (&optional arg)
"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."
@@ -115,6 +121,8 @@ This command assumes point is not in a string or comment."
(defun backward-list (&optional arg)
"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."
@@ -124,6 +132,8 @@ This command assumes point is not in a string or comment."
(defun down-list (&optional arg)
"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."
@@ -134,34 +144,92 @@ This command assumes point is not in a string or comment."
(goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
(setq arg (- arg inc)))))
-(defun backward-up-list (&optional arg)
+(defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
"Move backward out of one level of parentheses.
-With ARG, do this that many times.
-A negative argument means move forward but still to a less deep spot.
-This command assumes point is not in a string or comment."
- (interactive "^p")
- (up-list (- (or arg 1))))
-
-(defun up-list (&optional arg)
+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 forward but still to
+a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
+interactively), move out of enclosing strings as well. If
+NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
+break out of any enclosing string instead of moving to the start
+of a list broken across multiple strings. On error, location of
+point is unspecified."
+ (interactive "^p\nd\nd")
+ (up-list (- (or arg 1)) escape-strings no-syntax-crossing))
+
+(defun up-list (&optional arg escape-strings no-syntax-crossing)
"Move forward out of one level of parentheses.
-With ARG, do this that many times.
-A negative argument means move backward but still to a less deep spot.
-This command assumes point is not in a string or comment."
- (interactive "^p")
+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 to
+a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
+interactively), move out of enclosing strings as well. If
+NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
+break out of any enclosing string instead of moving to the start
+of a list broken across multiple strings. On error, location of
+point is unspecified."
+ (interactive "^p\nd\nd")
(or arg (setq arg 1))
(let ((inc (if (> arg 0) 1 -1))
- pos)
+ (pos nil))
(while (/= arg 0)
- (if (null forward-sexp-function)
- (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
- (condition-case err
- (while (progn (setq pos (point))
- (forward-sexp inc)
- (/= (point) pos)))
- (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
- (if (= (point) pos)
- (signal 'scan-error
- (list "Unbalanced parentheses" (point) (point)))))
+ (condition-case err
+ (save-restriction
+ ;; If we've been asked not to cross string boundaries
+ ;; and we're inside a string, narrow to that string so
+ ;; that scan-lists doesn't find a match in a different
+ ;; string.
+ (when no-syntax-crossing
+ (let* ((syntax (syntax-ppss))
+ (string-comment-start (nth 8 syntax)))
+ (when string-comment-start
+ (save-excursion
+ (goto-char string-comment-start)
+ (narrow-to-region
+ (point)
+ (if (nth 3 syntax) ; in string
+ (condition-case nil
+ (progn (forward-sexp) (point))
+ (scan-error (point-max)))
+ (forward-comment 1)
+ (point)))))))
+ (if (null forward-sexp-function)
+ (goto-char (or (scan-lists (point) inc 1)
+ (buffer-end arg)))
+ (condition-case err
+ (while (progn (setq pos (point))
+ (forward-sexp inc)
+ (/= (point) pos)))
+ (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
+ (if (= (point) pos)
+ (signal 'scan-error
+ (list "Unbalanced parentheses" (point) (point))))))
+ (scan-error
+ (let ((syntax nil))
+ (or
+ ;; If we bumped up against the end of a list, see whether
+ ;; we're inside a string: if so, just go to the beginning
+ ;; or end of that string.
+ (and escape-strings
+ (or syntax (setf syntax (syntax-ppss)))
+ (nth 3 syntax)
+ (goto-char (nth 8 syntax))
+ (progn (when (> inc 0)
+ (forward-sexp))
+ t))
+ ;; If we narrowed to a comment above and failed to escape
+ ;; it, the error might be our fault, not an indication
+ ;; that we're out of syntax. Try again from beginning or
+ ;; end of the comment.
+ (and no-syntax-crossing
+ (or syntax (setf syntax (syntax-ppss)))
+ (nth 4 syntax)
+ (goto-char (nth 8 syntax))
+ (or (< inc 0)
+ (forward-comment 1))
+ (setf arg (+ arg inc)))
+ (signal (car err) (cdr err))))))
(setq arg (- arg inc)))))
(defun kill-sexp (&optional arg)
@@ -195,7 +263,7 @@ This command assumes point is not in a string or comment."
(backward-up-list arg)
(kill-sexp)
(insert current-sexp))
- (error "Not at a sexp"))))
+ (user-error "Not at a sexp"))))
(defvar beginning-of-defun-function nil
"If non-nil, function for `beginning-of-defun-raw' to call.
@@ -296,8 +364,7 @@ is called as a function to find the defun's beginning."
(arg-+ve (> arg 0)))
(save-restriction
(widen)
- (let ((ppss (let (syntax-begin-function
- font-lock-beginning-of-syntax-function)
+ (let ((ppss (let (syntax-begin-function)
(syntax-ppss)))
;; position of least enclosing paren, or nil.
encl-pos)
@@ -363,16 +430,18 @@ is called as a function to find the defun's end."
(push-mark))
(if (or (null arg) (= arg 0)) (setq arg 1))
(let ((pos (point))
- (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))))
+ (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
+ (skip (lambda ()
+ ;; When comparing point against pos, we want to consider that if
+ ;; point was right after the end of the function, it's still
+ ;; considered as "in that function".
+ ;; E.g. `eval-defun' from right after the last close-paren.
+ (unless (bolp)
+ (skip-chars-forward " \t")
+ (if (looking-at "\\s<\\|\n")
+ (forward-line 1))))))
(funcall end-of-defun-function)
- ;; When comparing point against pos, we want to consider that if
- ;; point was right after the end of the function, it's still
- ;; considered as "in that function".
- ;; E.g. `eval-defun' from right after the last close-paren.
- (unless (bolp)
- (skip-chars-forward " \t")
- (if (looking-at "\\s<\\|\n")
- (forward-line 1)))
+ (funcall skip)
(cond
((> arg 0)
;; Moving forward.
@@ -395,11 +464,19 @@ is called as a function to find the defun's end."
(goto-char beg))
(unless (zerop arg)
(beginning-of-defun-raw (- arg))
+ (setq beg (point))
(funcall end-of-defun-function))))
- (unless (bolp)
- (skip-chars-forward " \t")
- (if (looking-at "\\s<\\|\n")
- (forward-line 1)))))
+ (funcall skip)
+ (while (and (< arg 0) (>= (point) pos))
+ ;; We intended to move backward, but this ended up not doing so:
+ ;; Try harder!
+ (goto-char beg)
+ (beginning-of-defun-raw (- arg))
+ (if (>= (point) beg)
+ (setq arg 0)
+ (setq beg (point))
+ (funcall end-of-defun-function)
+ (funcall skip)))))
(defun mark-defun (&optional allow-extend)
"Put mark at end of this defun, point at beginning.
@@ -444,11 +521,15 @@ it marks the next defun after the ones already marked."
(beginning-of-defun))
(re-search-backward "^\n" (- (point) 1) t)))))
-(defun narrow-to-defun (&optional _arg)
+(defvar narrow-to-defun-include-comments nil
+ "If non-nil, `narrow-to-defun' will also show comments preceding the defun.")
+
+(defun narrow-to-defun (&optional include-comments)
"Make text outside current defun invisible.
-The defun visible is the one that contains point or follows point.
-Optional ARG is ignored."
- (interactive)
+The current defun is the one that contains point or follows point.
+Preceding comments are included if INCLUDE-COMMENTS is non-nil.
+Interactively, the behavior depends on `narrow-to-defun-include-comments'."
+ (interactive (list narrow-to-defun-include-comments))
(save-excursion
(widen)
(let ((opoint (point))
@@ -484,6 +565,18 @@ Optional ARG is ignored."
(setq end (point))
(beginning-of-defun)
(setq beg (point)))
+ (when include-comments
+ (goto-char beg)
+ ;; Move back past all preceding comments (and whitespace).
+ (when (forward-comment -1)
+ (while (forward-comment -1))
+ ;; Move forwards past any page breaks within these comments.
+ (when (and page-delimiter (not (string= page-delimiter "")))
+ (while (re-search-forward page-delimiter beg t)))
+ ;; Lastly, move past any empty lines.
+ (skip-chars-forward "[:space:]\n")
+ (beginning-of-line)
+ (setq beg (point))))
(goto-char end)
(re-search-backward "^\n" (- (point) 1) t)
(narrow-to-region beg end))))
@@ -620,7 +713,8 @@ character."
(condition-case data
;; Buffer can't have more than (point-max) sexps.
(scan-sexps (point-min) (point-max))
- (scan-error (goto-char (nth 2 data))
+ (scan-error (push-mark)
+ (goto-char (nth 2 data))
;; Could print (nth 1 data), which is either
;; "Containing expression ends prematurely" or
;; "Unbalanced parentheses", but those may not be so
@@ -641,22 +735,20 @@ character."
)
(call-interactively 'minibuffer-complete)))
-(defun lisp-complete-symbol (&optional predicate)
+(defun lisp-complete-symbol (&optional _predicate)
"Perform completion on Lisp symbol preceding point.
Compare that symbol against the known Lisp symbols.
If no characters can be completed, display a list of possible completions.
Repeating the command at that point scrolls the list.
-When called from a program, optional arg PREDICATE is a predicate
-determining which symbols are considered, e.g. `commandp'.
-If PREDICATE is nil, the context determines which symbols are
-considered. If the symbol starts just after an open-parenthesis, only
-symbols with function definitions are considered. Otherwise, all
-symbols with function definitions, values or properties are
-considered."
- (declare (obsolete completion-at-point "24.4"))
+The context determines which symbols are considered. If the
+symbol starts just after an open-parenthesis, only symbols with
+function definitions are considered. Otherwise, all symbols with
+function definitions, values or properties are considered."
+ (declare (obsolete completion-at-point "24.4")
+ (advertised-calling-convention () "25.1"))
(interactive)
- (let* ((data (lisp-completion-at-point predicate))
+ (let* ((data (elisp-completion-at-point))
(plist (nthcdr 3 data)))
(if (null data)
(minibuffer-message "Nothing to complete")
@@ -664,164 +756,4 @@ considered."
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(plist-get plist :predicate))))))
-(defun lisp--local-variables-1 (vars sexp)
- "Return the vars locally bound around the witness, or nil if not found."
- (let (res)
- (while
- (unless
- (setq res
- (pcase sexp
- (`(,(or `let `let*) ,bindings)
- (let ((vars vars))
- (when (eq 'let* (car sexp))
- (dolist (binding (cdr (reverse bindings)))
- (push (or (car-safe binding) binding) vars)))
- (lisp--local-variables-1
- vars (car (cdr-safe (car (last bindings)))))))
- (`(,(or `let `let*) ,bindings . ,body)
- (let ((vars vars))
- (dolist (binding bindings)
- (push (or (car-safe binding) binding) vars))
- (lisp--local-variables-1 vars (car (last body)))))
- (`(lambda ,_) (setq sexp nil))
- (`(lambda ,args . ,body)
- (lisp--local-variables-1
- (append args vars) (car (last body))))
- (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e))
- (`(condition-case ,v ,_ . ,catches)
- (lisp--local-variables-1
- (cons v vars) (cdr (car (last catches)))))
- (`(,_ . ,_)
- (lisp--local-variables-1 vars (car (last sexp))))
- (`lisp--witness--lisp (or vars '(nil)))
- (_ nil)))
- (setq sexp (ignore-errors (butlast sexp)))))
- res))
-
-(defun lisp--local-variables ()
- "Return a list of locally let-bound variables at point."
- (save-excursion
- (skip-syntax-backward "w_")
- (let* ((ppss (syntax-ppss))
- (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
- (or (nth 8 ppss) (point))))
- (closer ()))
- (dolist (p (nth 9 ppss))
- (push (cdr (syntax-after p)) closer))
- (setq closer (apply #'string closer))
- (let* ((sexp (car (read-from-string
- (concat txt "lisp--witness--lisp" closer))))
- (macroexpand-advice (lambda (expander form &rest args)
- (condition-case nil
- (apply expander form args)
- (error form))))
- (sexp
- (unwind-protect
- (progn
- (advice-add 'macroexpand :around macroexpand-advice)
- (macroexpand-all sexp))
- (advice-remove 'macroexpand macroexpand-advice)))
- (vars (lisp--local-variables-1 nil sexp)))
- (delq nil
- (mapcar (lambda (var)
- (and (symbolp var)
- (not (string-match (symbol-name var) "\\`[&_]"))
- ;; Eliminate uninterned vars.
- (intern-soft var)
- var))
- vars))))))
-
-(defvar lisp--local-variables-completion-table
- ;; Use `defvar' rather than `defconst' since defconst would purecopy this
- ;; value, which would doubly fail: it would fail because purecopy can't
- ;; handle the recursive bytecode object, and it would fail because it would
- ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
- (let ((lastpos nil) (lastvars nil))
- (letrec ((hookfun (lambda ()
- (setq lastpos nil)
- (remove-hook 'post-command-hook hookfun))))
- (completion-table-dynamic
- (lambda (_string)
- (save-excursion
- (skip-syntax-backward "_w")
- (let ((newpos (cons (point) (current-buffer))))
- (unless (equal lastpos newpos)
- (add-hook 'post-command-hook hookfun)
- (setq lastpos newpos)
- (setq lastvars
- (mapcar #'symbol-name (lisp--local-variables))))))
- lastvars)))))
-
-(defun lisp-completion-at-point (&optional _predicate)
- "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
- (with-syntax-table emacs-lisp-mode-syntax-table
- (let* ((pos (point))
- (beg (condition-case nil
- (save-excursion
- (backward-sexp 1)
- (skip-syntax-forward "'")
- (point))
- (scan-error pos)))
- (end
- (unless (or (eq beg (point-max))
- (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
- (condition-case nil
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (when (>= (point) pos)
- (point)))
- (scan-error pos))))
- (funpos (eq (char-before beg) ?\()) ;t if in function position.
- (table-etc
- (if (not funpos)
- ;; FIXME: We could look at the first element of the list and
- ;; use it to provide a more specific completion table in some
- ;; cases. E.g. filter out keywords that are not understood by
- ;; the macro/function being called.
- (list nil (completion-table-in-turn
- lisp--local-variables-completion-table
- obarray) ;Could be anything.
- :annotation-function
- (lambda (str) (if (fboundp (intern-soft str)) " <f>")))
- ;; Looks like a funcall position. Let's double check.
- (save-excursion
- (goto-char (1- beg))
- (let ((parent
- (condition-case nil
- (progn (up-list -1) (forward-char 1)
- (let ((c (char-after)))
- (if (eq c ?\() ?\(
- (if (memq (char-syntax c) '(?w ?_))
- (read (current-buffer))))))
- (error nil))))
- (pcase parent
- ;; FIXME: Rather than hardcode special cases here,
- ;; we should use something like a symbol-property.
- (`declare
- (list t (mapcar (lambda (x) (symbol-name (car x)))
- (delete-dups
- (append
- macro-declarations-alist
- defun-declarations-alist)))))
- ((and (or `condition-case `condition-case-unless-debug)
- (guard (save-excursion
- (ignore-errors
- (forward-sexp 2)
- (< (point) beg)))))
- (list t obarray
- :predicate (lambda (sym) (get sym 'error-conditions))))
- (_ (list nil obarray #'fboundp))))))))
- (when end
- (let ((tail (if (null (car table-etc))
- (cdr table-etc)
- (cons
- (if (memq (char-syntax (or (char-after end) ?\s))
- '(?\s ?>))
- (cadr table-etc)
- (apply-partially 'completion-table-with-terminator
- " " (cadr table-etc)))
- (cddr table-etc)))))
- `(,beg ,end ,@tail))))))
-
;;; lisp.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index e8b513fcd3e..8983454d318 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -1,6 +1,6 @@
-;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*-
+;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: lisp, compiler, macros
@@ -25,7 +25,6 @@
;; This file contains macro-expansions functions that are not defined in
;; the Lisp core, namely `macroexpand-all', which expands all macros in
;; a form, not just a top-level one.
-;;
;;; Code:
@@ -97,7 +96,8 @@ each clause."
(defun macroexp--compiler-macro (handler form)
(condition-case err
(apply handler form (cdr form))
- (error (message "Compiler-macro error for %S: %S" (car form) err)
+ (error
+ (message "Compiler-macro error for %S: %S" (car form) err)
form)))
(defun macroexp--funcall-if-compiled (_form)
@@ -119,36 +119,89 @@ and also to avoid outputting the warning during normal execution."
(member '(declare-function . byte-compile-macroexpand-declare-function)
macroexpand-all-environment))
+(defvar macroexp--warned (make-hash-table :test #'equal :weakness 'key))
-(defun macroexp--warn-and-return (msg form)
+(defun macroexp--warn-and-return (msg form &optional compile-only)
(let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
(cond
((null msg) form)
((macroexp--compiling-p)
- `(progn
- (macroexp--funcall-if-compiled ',when-compiled)
- ,form))
+ (if (gethash form macroexp--warned)
+ ;; Already wrapped this exp with a warning: avoid inf-looping
+ ;; where we keep adding the same warning onto `form' because
+ ;; macroexpand-all gets right back to macroexpanding `form'.
+ form
+ (puthash form form macroexp--warned)
+ `(progn
+ (macroexp--funcall-if-compiled ',when-compiled)
+ ,form)))
(t
- (message "%s%s" (if (stringp load-file-name)
- (concat (file-relative-name load-file-name) ": ")
- "")
- msg)
+ (unless compile-only
+ (message "%s%s" (if (stringp load-file-name)
+ (concat (file-relative-name load-file-name) ": ")
+ "")
+ msg))
form))))
(defun macroexp--obsolete-warning (fun obsolescence-data type)
(let ((instead (car obsolescence-data))
(asof (nth 2 obsolescence-data)))
- (format "`%s' is an obsolete %s%s%s" fun type
- (if asof (concat " (as of " asof ")") "")
- (cond ((stringp instead) (concat "; " instead))
- (instead (format "; use `%s' instead." instead))
- (t ".")))))
+ (format-message
+ "`%s' is an obsolete %s%s%s" fun type
+ (if asof (concat " (as of " asof ")") "")
+ (cond ((stringp instead) (concat "; " (substitute-command-keys instead)))
+ (instead (format-message "; use `%s' instead." instead))
+ (t ".")))))
+
+(defun macroexpand-1 (form &optional environment)
+ "Perform (at most) one step of macroexpansion."
+ (cond
+ ((consp form)
+ (let* ((head (car form))
+ (env-expander (assq head environment)))
+ (if env-expander
+ (if (cdr env-expander)
+ (apply (cdr env-expander) (cdr form))
+ form)
+ (if (not (and (symbolp head) (fboundp head)))
+ form
+ (let ((def (autoload-do-load (symbol-function head) head 'macro)))
+ (cond
+ ;; Follow alias, but only for macros, otherwise we may end up
+ ;; skipping an important compiler-macro (e.g. cl--block-wrapper).
+ ((and (symbolp def) (macrop def)) (cons def (cdr form)))
+ ((not (consp def)) form)
+ (t
+ (if (eq 'macro (car def))
+ (apply (cdr def) (cdr form))
+ form))))))))
+ (t form)))
+
+(defun macroexp-macroexpand (form env)
+ "Like `macroexpand' but checking obsolescence."
+ (let ((new-form
+ (macroexpand form env)))
+ (if (and (not (eq form new-form)) ;It was a macro call.
+ (car-safe form)
+ (symbolp (car form))
+ (get (car form) 'byte-obsolete-info)
+ (or (not (fboundp 'byte-compile-warning-enabled-p))
+ (byte-compile-warning-enabled-p 'obsolete)))
+ (let* ((fun (car form))
+ (obsolete (get fun 'byte-obsolete-info)))
+ (macroexp--warn-and-return
+ (macroexp--obsolete-warning
+ fun obsolete
+ (if (symbolp (symbol-function fun))
+ "alias" "macro"))
+ new-form))
+ new-form)))
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
Assumes the caller has bound `macroexpand-all-environment'."
- (if (and (listp form) (eq (car form) 'backquote-list*))
+ (if (eq (car-safe form) 'backquote-list*)
;; Special-case `backquote-list*', as it is normally a macro that
;; generates exceedingly deep expansions from relatively shallow input
;; forms. We just process it `in reverse' -- first we expand all the
@@ -156,24 +209,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexpand (macroexp--all-forms form 1)
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
- (let ((new-form
- (macroexpand form macroexpand-all-environment)))
- (setq form
- (if (and (not (eq form new-form)) ;It was a macro call.
- (car-safe form)
- (symbolp (car form))
- (get (car form) 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete)))
- (let* ((fun (car form))
- (obsolete (get fun 'byte-obsolete-info)))
- (macroexp--warn-and-return
- (macroexp--obsolete-warning
- fun obsolete
- (if (symbolp (symbol-function fun))
- "alias" "macro"))
- new-form))
- new-form)))
+ (setq form (macroexp-macroexpand form macroexpand-all-environment))
(pcase form
(`(cond . ,clauses)
(macroexp--cons 'cond (macroexp--all-clauses clauses) form))
@@ -181,30 +217,30 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--cons
'condition-case
(macroexp--cons err
- (macroexp--cons (macroexp--expand-all body)
- (macroexp--all-clauses handlers 1)
- (cddr form))
- (cdr form))
+ (macroexp--cons (macroexp--expand-all body)
+ (macroexp--all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
form))
(`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
(`(function ,(and f `(lambda . ,_)))
(macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form))
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form))
(`(,(or `function `quote) . ,_) form)
(`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
(macroexp--cons fun
- (macroexp--cons (macroexp--all-clauses bindings 1)
- (macroexp--all-forms body)
- (cdr form))
- form))
+ (macroexp--cons (macroexp--all-clauses bindings 1)
+ (macroexp--all-forms body)
+ (cdr form))
+ form))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
(macroexp--cons (macroexp--all-forms fun 2)
- (macroexp--all-forms args)
- form))
+ (macroexp--all-forms args)
+ form))
;; The following few cases are for normal function calls that
;; are known to funcall one of their arguments. The byte
;; compiler has traditionally handled these functions specially
@@ -225,6 +261,10 @@ Assumes the caller has bound `macroexpand-all-environment'."
(format "%s quoted with ' rather than with #'"
(list 'lambda (nth 1 f) '...))
(macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
+ (`(funcall (,(or 'quote 'function) ,(and f (pred symbolp)) . ,_) . ,args)
+ ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo'
+ ;; has a compiler-macro.
+ (macroexp--expand-all `(,f . ,args)))
(`(,func . ,_)
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro can
@@ -238,7 +278,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
;; If the handler is not loaded yet, try (auto)loading the
;; function itself, which may in turn load the handler.
(unless (functionp handler)
- (ignore-errors
+ (with-demoted-errors "macroexp--expand-all: %S"
(autoload-do-load (indirect-function func) func)))
(let ((newform (macroexp--compiler-macro handler form)))
(if (eq form newform)
@@ -253,7 +293,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
(macroexp--expand-all newform)))
(macroexp--expand-all newform))))))
- (t form))))
+ (_ form))))
;;;###autoload
(defun macroexpand-all (form &optional environment)
@@ -266,13 +306,25 @@ definitions to shadow the loaded ones for use in file byte-compilation."
;;; Handy functions to use in macros.
+(defun macroexp-parse-body (body)
+ "Parse a function BODY into (DECLARATIONS . EXPS)."
+ (let ((decls ()))
+ (while (and (cdr body)
+ (let ((e (car body)))
+ (or (stringp e)
+ (memq (car-safe e)
+ '(:documentation declare interactive cl-declare)))))
+ (push (pop body) decls))
+ (cons (nreverse decls) body)))
+
(defun macroexp-progn (exps)
"Return an expression equivalent to `(progn ,@EXPS)."
(if (cdr exps) `(progn ,@exps) (car exps)))
(defun macroexp-unprogn (exp)
- "Turn EXP into a list of expressions to execute in sequence."
- (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+ "Turn EXP into a list of expressions to execute in sequence.
+Never returns an empty list."
+ (if (eq (car-safe exp) 'progn) (or (cdr exp) '(nil)) (list exp)))
(defun macroexp-let* (bindings exp)
"Return an expression equivalent to `(let* ,bindings ,exp)."
@@ -282,40 +334,83 @@ definitions to shadow the loaded ones for use in file byte-compilation."
(t `(let* ,bindings ,exp))))
(defun macroexp-if (test then else)
- "Return an expression equivalent to `(if ,test ,then ,else)."
+ "Return an expression equivalent to `(if ,TEST ,THEN ,ELSE)."
(cond
((eq (car-safe else) 'if)
- (if (equal test (nth 1 else))
- ;; Doing a test a second time: get rid of the redundancy.
- `(if ,test ,then ,@(nthcdr 3 else))
- `(cond (,test ,then)
- (,(nth 1 else) ,(nth 2 else))
- (t ,@(nthcdr 3 else)))))
+ (cond
+ ;; Drop this optimization: It's unsafe (it assumes that `test' is
+ ;; pure, or at least idempotent), and it's not used even a single
+ ;; time while compiling Emacs's sources.
+ ;;((equal test (nth 1 else))
+ ;; ;; Doing a test a second time: get rid of the redundancy.
+ ;; (message "macroexp-if: sharing 'test' %S" test)
+ ;; `(if ,test ,then ,@(nthcdr 3 else)))
+ ((equal then (nth 2 else))
+ ;; (message "macroexp-if: sharing 'then' %S" then)
+ `(if (or ,test ,(nth 1 else)) ,then ,@(nthcdr 3 else)))
+ ((equal (macroexp-unprogn then) (nthcdr 3 else))
+ ;; (message "macroexp-if: sharing 'then' with not %S" then)
+ `(if (or ,test (not ,(nth 1 else)))
+ ,then ,@(macroexp-unprogn (nth 2 else))))
+ (t
+ `(cond (,test ,@(macroexp-unprogn then))
+ (,(nth 1 else) ,@(macroexp-unprogn (nth 2 else)))
+ (t ,@(nthcdr 3 else))))))
((eq (car-safe else) 'cond)
- `(cond (,test ,then)
- ;; Doing a test a second time: get rid of the redundancy, as above.
- ,@(remove (assoc test else) (cdr else))))
+ `(cond (,test ,@(macroexp-unprogn then)) ,@(cdr else)))
;; Invert the test if that lets us reduce the depth of the tree.
((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
- (t `(if ,test ,then ,else))))
-
-(defmacro macroexp-let2 (test var exp &rest exps)
- "Bind VAR to a copyable expression that returns the value of EXP.
-This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated
-symbol which EXPS can find in VAR.
-TEST should be the name of a predicate on EXP checking whether the `let' can
-be skipped; if nil, as is usual, `macroexp-const-p' is used."
+ (t `(if ,test ,then ,@(macroexp-unprogn else)))))
+
+(defmacro macroexp-let2 (test sym exp &rest body)
+ "Evaluate BODY with SYM bound to an expression for EXP's value.
+The intended usage is that BODY generates an expression that
+will refer to EXP's value multiple times, but will evaluate
+EXP only once. As BODY generates that expression, it should
+use SYM to stand for the value of EXP.
+
+If EXP is a simple, safe expression, then SYM's value is EXP itself.
+Otherwise, SYM's value is a symbol which holds the value produced by
+evaluating EXP. The return value incorporates the value of BODY, plus
+additional code to evaluate EXP once and save the result so SYM can
+refer to it.
+
+If BODY consists of multiple forms, they are all evaluated
+but only the last one's value matters.
+
+TEST is a predicate to determine whether EXP qualifies as simple and
+safe; if TEST is nil, only constant expressions qualify.
+
+Example:
+ (macroexp-let2 nil foo EXP
+ \\=`(* ,foo ,foo))
+generates an expression that evaluates EXP once,
+then returns the square of that value.
+You could do this with
+ (let ((foovar EXP))
+ (* foovar foovar))
+but using `macroexp-let2' produces more efficient code in
+cases where EXP is a constant."
(declare (indent 3) (debug (sexp sexp form body)))
(let ((bodysym (make-symbol "body"))
(expsym (make-symbol "exp")))
`(let* ((,expsym ,exp)
- (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym)
- ,expsym (make-symbol ,(symbol-name var))))
- (,bodysym ,(macroexp-progn exps)))
- (if (eq ,var ,expsym) ,bodysym
- (macroexp-let* (list (list ,var ,expsym))
+ (,sym (if (funcall #',(or test #'macroexp-const-p) ,expsym)
+ ,expsym (make-symbol ,(symbol-name sym))))
+ (,bodysym ,(macroexp-progn body)))
+ (if (eq ,sym ,expsym) ,bodysym
+ (macroexp-let* (list (list ,sym ,expsym))
,bodysym)))))
+(defmacro macroexp-let2* (test bindings &rest body)
+ "Bind each binding in BINDINGS as `macroexp-let2' does."
+ (declare (indent 2) (debug (sexp (&rest (sexp form)) body)))
+ (pcase-exhaustive bindings
+ (`nil (macroexp-progn body))
+ (`((,var ,exp) . ,tl)
+ `(macroexp-let2 ,test ,var ,exp
+ (macroexp-let2* ,test ,tl ,@body)))))
+
(defun macroexp--maxsize (exp size)
(cond ((< size 0) size)
((symbolp exp) (1- size))
@@ -367,6 +462,18 @@ symbol itself."
"Return non-nil if EXP can be copied without extra cost."
(or (symbolp exp) (macroexp-const-p exp)))
+(defun macroexp-quote (v)
+ "Return an expression E such that `(eval E)' is V.
+
+E is either V or (quote V) depending on whether V evaluates to
+itself or not."
+ (if (and (not (consp v))
+ (or (keywordp v)
+ (not (symbolp v))
+ (memq v '(nil t))))
+ v
+ (list 'quote v)))
+
;;; Load-time macro-expansion.
;; Because macro-expansion used to be more lazy, eager macro-expansion
@@ -402,7 +509,9 @@ symbol itself."
(defvar macroexp--pending-eager-loads nil
"Stack of files currently undergoing eager macro-expansion.")
-(defun internal-macroexpand-for-load (form)
+(defvar macroexp--debug-eager nil)
+
+(defun internal-macroexpand-for-load (form full-p)
;; Called from the eager-macroexpansion in readevalloop.
(cond
;; Don't repeat the same warning for every top-level element.
@@ -417,15 +526,19 @@ symbol itself."
(tail (member elem (cdr (member elem bt)))))
(if tail (setcdr tail (list '…)))
(if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
- (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
- (mapconcat #'prin1-to-string (nreverse bt) " => "))
+ (if macroexp--debug-eager
+ (debug 'eager-macroexp-cycle)
+ (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
+ (mapconcat #'prin1-to-string (nreverse bt) " => ")))
(push 'skip macroexp--pending-eager-loads)
form))
(t
(condition-case err
(let ((macroexp--pending-eager-loads
(cons load-file-name macroexp--pending-eager-loads)))
- (macroexpand-all form))
+ (if full-p
+ (macroexpand-all form)
+ (macroexpand form)))
(error
;; Hopefully this shouldn't happen thanks to the cycle detection,
;; but in case it does happen, let's catch the error and give the
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 56bfe04f9ce..b8fb540d6cb 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -1,9 +1,9 @@
;;; map-ynp.el --- general-purpose boolean question-asker -*- lexical-binding:t -*-
-;; Copyright (C) 1991-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, extensions
;; Package: emacs
@@ -34,7 +34,7 @@
;;; Code:
-(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
(defun map-y-or-n-p (prompter actor list &optional help action-alist
no-cursor-in-echo-area)
@@ -44,7 +44,7 @@ Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST.
LIST is a list of objects, or a function of no arguments to return the next
object or nil.
-If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not
+If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT). If not
a string, PROMPTER is a function of one arg (an object from LIST), which
returns a string to be used as the prompt for that object. If the return
value is not a string, it may be nil to ignore the object or non-nil to act
@@ -56,7 +56,7 @@ which gets called with each object that the user answers `yes' for.
If HELP is given, it is a list (OBJECT OBJECTS ACTION),
where OBJECT is a string giving the singular noun for an elt of LIST;
OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive
-verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\).
+verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\").
At the prompts, the user may enter y, Y, or SPC to act on that object;
n, N, or DEL to skip that object; ! to act on all following objects;
@@ -198,7 +198,8 @@ Returns the number of actions taken."
(objects (if help (nth 1 help) "objects"))
(action (if help (nth 2 help) "act on")))
(concat
- (format "Type SPC or `y' to %s the current %s;
+ (format-message "\
+Type SPC or `y' to %s the current %s;
DEL or `n' to skip the current %s;
RET or `q' to give up on the %s (skip all remaining %s);
C-g to quit (cancel the whole command);
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
new file mode 100644
index 00000000000..5ef51f12d96
--- /dev/null
+++ b/lisp/emacs-lisp/map.el
@@ -0,0 +1,377 @@
+;;; map.el --- Map manipulation functions -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Keywords: convenience, map, hash-table, alist, array
+;; Version: 1.0
+;; Package: map
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; map.el provides map-manipulation functions that work on alists,
+;; hash-table and arrays. All functions are prefixed with "map-".
+;;
+;; Functions taking a predicate or iterating over a map using a
+;; function take the function as their first argument. All other
+;; functions take the map as their first argument.
+
+;; TODO:
+;; - Add support for char-tables
+;; - Maybe add support for gv?
+;; - See if we can integrate text-properties
+;; - A macro similar to let-alist but working on any type of map could
+;; be really useful
+
+;;; Code:
+
+(require 'seq)
+
+(pcase-defmacro map (&rest args)
+ "Build a `pcase' pattern matching map elements.
+
+The `pcase' pattern will match each element of PATTERN against
+the corresponding elements of the map.
+
+Extra elements of the map are ignored if fewer ARGS are
+given, and the match does not fail.
+
+ARGS can be a list of the form (KEY PAT), in which case KEY in an
+unquoted form.
+
+ARGS can also be a list of symbols, which stands for ('SYMBOL
+SYMBOL)."
+ `(and (pred map-p)
+ ,@(map--make-pcase-bindings args)))
+
+(defmacro map-let (keys map &rest body)
+ "Bind the variables in KEYS to the elements of MAP then evaluate BODY.
+
+KEYS can be a list of symbols, in which case each element will be
+bound to the looked up value in MAP.
+
+KEYS can also be a list of (KEY VARNAME) pairs, in which case
+KEY is an unquoted form.
+
+MAP can be a list, hash-table or array."
+ (declare (indent 2) (debug t))
+ `(pcase-let ((,(map--make-pcase-patterns keys) ,map))
+ ,@body))
+
+(eval-when-compile
+ (defmacro map--dispatch (map-var &rest args)
+ "Evaluate one of the forms specified by ARGS based on the type of MAP.
+
+The following keyword types are meaningful: `:list',
+`:hash-table' and `:array'.
+
+An error is thrown if MAP is neither a list, hash-table nor array.
+
+Return RESULT if non-nil or the result of evaluation of the form."
+ (declare (debug t) (indent 1))
+ `(cond ((listp ,map-var) ,(plist-get args :list))
+ ((hash-table-p ,map-var) ,(plist-get args :hash-table))
+ ((arrayp ,map-var) ,(plist-get args :array))
+ (t (error "Unsupported map: %s" ,map-var)))))
+
+(defun map-elt (map key &optional default)
+ "Lookup KEY in MAP and return its associated value.
+If KEY is not found, return DEFAULT which defaults to nil.
+
+If MAP is a list, `eql' is used to lookup KEY.
+
+MAP can be a list, hash-table or array."
+ (declare
+ (gv-expander
+ (lambda (do)
+ (gv-letplace (mgetter msetter) `(gv-delay-error ,map)
+ (macroexp-let2* nil
+ ;; Eval them once and for all in the right order.
+ ((key key) (default default))
+ `(if (listp ,mgetter)
+ ;; Special case the alist case, since it can't be handled by the
+ ;; map--put function.
+ ,(gv-get `(alist-get ,key (gv-synthetic-place
+ ,mgetter ,msetter)
+ ,default)
+ do)
+ ,(funcall do `(map-elt ,mgetter ,key ,default)
+ (lambda (v) `(map--put ,mgetter ,key ,v)))))))))
+ (map--dispatch map
+ :list (alist-get key map default)
+ :hash-table (gethash key map default)
+ :array (if (and (>= key 0) (< key (seq-length map)))
+ (seq-elt map key)
+ default)))
+
+(defmacro map-put (map key value)
+ "Associate KEY with VALUE in MAP and return MAP.
+If KEY is already present in MAP, replace the associated value
+with VALUE.
+
+MAP can be a list, hash-table or array."
+ (macroexp-let2 nil map map
+ `(progn
+ (setf (map-elt ,map ,key) ,value)
+ ,map)))
+
+(defmacro map-delete (map key)
+ "Delete KEY from MAP and return MAP.
+No error is signaled if KEY is not a key of MAP. If MAP is an
+array, store nil at the index KEY.
+
+MAP can be a list, hash-table or array."
+ (declare (debug t))
+ (gv-letplace (mgetter msetter) `(gv-delay-error ,map)
+ (macroexp-let2 nil key key
+ `(if (not (listp ,mgetter))
+ (map--delete ,mgetter ,key)
+ ;; The alist case is special, since it can't be handled by the
+ ;; map--delete function.
+ (setf (alist-get ,key (gv-synthetic-place ,mgetter ,msetter)
+ nil t)
+ nil)
+ ,mgetter))))
+
+(defun map-nested-elt (map keys &optional default)
+ "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil.
+
+Map can be a nested map composed of alists, hash-tables and arrays."
+ (or (seq-reduce (lambda (acc key)
+ (when (map-p acc)
+ (map-elt acc key)))
+ keys
+ map)
+ default))
+
+(defun map-keys (map)
+ "Return the list of keys in MAP.
+
+MAP can be a list, hash-table or array."
+ (map-apply (lambda (key _) key) map))
+
+(defun map-values (map)
+ "Return the list of values in MAP.
+
+MAP can be a list, hash-table or array."
+ (map-apply (lambda (_ value) value) map))
+
+(defun map-pairs (map)
+ "Return the elements of MAP as key/value association lists.
+
+MAP can be a list, hash-table or array."
+ (map-apply #'cons map))
+
+(defun map-length (map)
+ "Return the length of MAP.
+
+MAP can be a list, hash-table or array."
+ (length (map-keys map)))
+
+(defun map-copy (map)
+ "Return a copy of MAP.
+
+MAP can be a list, hash-table or array."
+ (map--dispatch map
+ :list (seq-copy map)
+ :hash-table (copy-hash-table map)
+ :array (seq-copy map)))
+
+(defun map-apply (function map)
+ "Apply FUNCTION to each element of MAP and return the result as a list.
+FUNCTION is called with two arguments, the key and the value.
+
+MAP can be a list, hash-table or array."
+ (funcall (map--dispatch map
+ :list #'map--apply-alist
+ :hash-table #'map--apply-hash-table
+ :array #'map--apply-array)
+ function
+ map))
+
+(defun map-keys-apply (function map)
+ "Return the result of applying FUNCTION to each key of MAP.
+
+MAP can be a list, hash-table or array."
+ (map-apply (lambda (key _)
+ (funcall function key))
+ map))
+
+(defun map-values-apply (function map)
+ "Return the result of applying FUNCTION to each value of MAP.
+
+MAP can be a list, hash-table or array."
+ (map-apply (lambda (_ val)
+ (funcall function val))
+ map))
+
+(defun map-filter (pred map)
+ "Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
+
+MAP can be a list, hash-table or array."
+ (delq nil (map-apply (lambda (key val)
+ (if (funcall pred key val)
+ (cons key val)
+ nil))
+ map)))
+
+(defun map-remove (pred map)
+ "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
+
+MAP can be a list, hash-table or array."
+ (map-filter (lambda (key val) (not (funcall pred key val)))
+ map))
+
+(defun map-p (map)
+ "Return non-nil if MAP is a map (list, hash-table or array)."
+ (or (listp map)
+ (hash-table-p map)
+ (arrayp map)))
+
+(defun map-empty-p (map)
+ "Return non-nil if MAP is empty.
+
+MAP can be a list, hash-table or array."
+ (map--dispatch map
+ :list (null map)
+ :array (seq-empty-p map)
+ :hash-table (zerop (hash-table-count map))))
+
+(defun map-contains-key (map key &optional testfn)
+ "Return non-nil if MAP contain KEY, nil otherwise.
+Equality is defined by TESTFN if non-nil or by `equal' if nil.
+
+MAP can be a list, hash-table or array."
+ (seq-contains (map-keys map) key testfn))
+
+(defun map-some (pred map)
+ "Return a non-nil if (PRED key val) is non-nil for any key/value pair in MAP.
+
+MAP can be a list, hash-table or array."
+ (catch 'map--break
+ (map-apply (lambda (key value)
+ (let ((result (funcall pred key value)))
+ (when result
+ (throw 'map--break result))))
+ map)
+ nil))
+
+(defun map-every-p (pred map)
+ "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP.
+
+MAP can be a list, hash-table or array."
+ (catch 'map--break
+ (map-apply (lambda (key value)
+ (or (funcall pred key value)
+ (throw 'map--break nil)))
+ map)
+ t))
+
+(defun map-merge (type &rest maps)
+ "Merge into a map of type TYPE all the key/value pairs in MAPS.
+
+MAP can be a list, hash-table or array."
+ (let (result)
+ (while maps
+ (map-apply (lambda (key value)
+ (setf (map-elt result key) value))
+ (pop maps)))
+ (map-into result type)))
+
+(defun map-into (map type)
+ "Convert the map MAP into a map of type TYPE.
+
+TYPE can be one of the following symbols: list or hash-table.
+MAP can be a list, hash-table or array."
+ (pcase type
+ (`list (map-pairs map))
+ (`hash-table (map--into-hash-table map))
+ (_ (error "Not a map type name: %S" type))))
+
+(defun map--put (map key v)
+ (map--dispatch map
+ :list (let ((p (assoc key map)))
+ (if p (setcdr p v)
+ (error "No place to change the mapping for %S" key)))
+ :hash-table (puthash key v map)
+ :array (aset map key v)))
+
+(defun map--apply-alist (function map)
+ "Private function used to apply FUNCTION over MAP, MAP being an alist."
+ (seq-map (lambda (pair)
+ (funcall function
+ (car pair)
+ (cdr pair)))
+ map))
+
+(defun map--delete (map key)
+ (map--dispatch map
+ :list (error "No place to remove the mapping for %S" key)
+ :hash-table (remhash key map)
+ :array (and (>= key 0)
+ (<= key (seq-length map))
+ (aset map key nil)))
+ map)
+
+(defun map--apply-hash-table (function map)
+ "Private function used to apply FUNCTION over MAP, MAP being a hash-table."
+ (let (result)
+ (maphash (lambda (key value)
+ (push (funcall function key value) result))
+ map)
+ (nreverse result)))
+
+(defun map--apply-array (function map)
+ "Private function used to apply FUNCTION over MAP, MAP being an array."
+ (let ((index 0))
+ (seq-map (lambda (elt)
+ (prog1
+ (funcall function index elt)
+ (setq index (1+ index))))
+ map)))
+
+(defun map--into-hash-table (map)
+ "Convert MAP into a hash-table."
+ (let ((ht (make-hash-table :size (map-length map)
+ :test 'equal)))
+ (map-apply (lambda (key value)
+ (setf (map-elt ht key) value))
+ map)
+ ht))
+
+(defun map--make-pcase-bindings (args)
+ "Return a list of pcase bindings from ARGS to the elements of a map."
+ (seq-map (lambda (elt)
+ (if (consp elt)
+ `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))
+ `(app (pcase--flip map-elt ',elt) ,elt)))
+ args))
+
+(defun map--make-pcase-patterns (args)
+ "Return a list of `(map ...)' pcase patterns built from ARGS."
+ (cons 'map
+ (seq-map (lambda (elt)
+ (if (and (consp elt) (eq 'map (car elt)))
+ (map--make-pcase-patterns elt)
+ elt))
+ args)))
+
+(provide 'map)
+;;; map.el ends here
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 576e72088e9..2cd34e12810 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -1,6 +1,6 @@
;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions, lisp, tools
@@ -67,14 +67,26 @@ Each element has the form (WHERE BYTECODE STACK) where:
(defsubst advice--cdr (f) (aref (aref f 2) 2))
(defsubst advice--props (f) (aref (aref f 2) 3))
-(defun advice--make-docstring (_string function)
- "Build the raw doc-string of SYMBOL, presumably advised."
- (let ((flist (indirect-function function))
- (docstring nil))
+(defun advice--cd*r (f)
+ (while (advice--p f)
+ (setq f (advice--cdr f)))
+ f)
+
+(defun advice--make-docstring (function)
+ "Build the raw docstring for FUNCTION, presumably advised."
+ (let* ((flist (indirect-function function))
+ (docfun nil)
+ (docstring nil))
(if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
(while (advice--p flist)
(let ((bytecode (aref flist 1))
+ (doc (aref flist 4))
(where nil))
+ ;; Hack attack! For advices installed before calling
+ ;; Snarf-documentation, the integer offset into the DOC file will not
+ ;; be installed in the "core unadvised function" but in the advice
+ ;; object instead! So here we try to undo the damage.
+ (if (integerp doc) (setq docfun flist))
(dolist (elem advice--where-alist)
(if (eq bytecode (cadr elem)) (setq where (car elem))))
(setq docstring
@@ -83,7 +95,7 @@ Each element has the form (WHERE BYTECODE STACK) where:
(propertize (format "%s advice: " where)
'face 'warning)
(let ((fun (advice--car flist)))
- (if (symbolp fun) (format "`%S'" fun)
+ (if (symbolp fun) (format-message "`%S'" fun)
(let* ((name (cdr (assq 'name (advice--props flist))))
(doc (documentation fun t))
(usage (help-split-fundoc doc function)))
@@ -96,22 +108,16 @@ Each element has the form (WHERE BYTECODE STACK) where:
"\n")))
(setq flist (advice--cdr flist)))
(if docstring (setq docstring (concat docstring "\n")))
- (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
- (documentation flist t)))
+ (unless docfun (setq docfun flist))
+ (let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops.
+ (documentation docfun t)))
(usage (help-split-fundoc origdoc function)))
(setq usage (if (null usage)
(let ((arglist (help-function-arglist flist)))
- (format "%S" (help-make-usage function arglist)))
+ (help--make-usage-docstring function arglist))
(setq origdoc (cdr usage)) (car usage)))
(help-add-fundoc-usage (concat docstring origdoc) usage))))
-(defvar advice--docstring
- ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
- ;; which drops the text-properties.
- ;;(eval-when-compile
- (propertize "Advised function"
- 'dynamic-docstring-function #'advice--make-docstring)) ;; )
-
(defun advice-eval-interactive-spec (spec)
"Evaluate the interactive spec SPEC."
(cond
@@ -125,48 +131,65 @@ Each element has the form (WHERE BYTECODE STACK) where:
;; ((functionp spec) (funcall spec))
(t (eval spec))))
+(defun advice--interactive-form (function)
+ ;; Like `interactive-form' but tries to avoid autoloading functions.
+ (when (commandp function)
+ (if (not (and (symbolp function) (autoloadp (indirect-function function))))
+ (interactive-form function)
+ `(interactive (advice-eval-interactive-spec
+ (cadr (interactive-form ',function)))))))
+
(defun advice--make-interactive-form (function main)
;; TODO: make it so that interactive spec can be a constant which
;; dynamically checks the advice--car/cdr to do its job.
;; For that, advice-eval-interactive-spec needs to be more faithful.
- ;; FIXME: The calls to interactive-form below load autoloaded functions
- ;; too eagerly.
- (let ((fspec (cadr (interactive-form function))))
+ (let* ((iff (advice--interactive-form function))
+ (ifm (advice--interactive-form main))
+ (fspec (cadr iff)))
(when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
(setq fspec (nth 1 fspec)))
(if (functionp fspec)
- `(funcall ',fspec
- ',(cadr (interactive-form main)))
- (cadr (or (interactive-form function)
- (interactive-form main))))))
+ `(funcall ',fspec ',(cadr ifm))
+ (cadr (or iff ifm)))))
-(defsubst advice--make-1 (byte-code stack-depth function main props)
+(defun advice--make-1 (byte-code stack-depth function main props)
"Build a function value that adds FUNCTION to MAIN."
(let ((adv-sig (gethash main advertised-signature-table))
(advice
(apply #'make-byte-code 128 byte-code
- (vector #'apply function main props) stack-depth
- advice--docstring
- (when (or (commandp function) (commandp main))
- (list (advice--make-interactive-form
- function main))))))
+ (vector #'apply function main props) stack-depth nil
+ (and (or (commandp function) (commandp main))
+ (list (advice--make-interactive-form
+ function main))))))
(when adv-sig (puthash advice adv-sig advertised-signature-table))
advice))
(defun advice--make (where function main props)
"Build a function value that adds FUNCTION to MAIN at WHERE.
WHERE is a symbol to select an entry in `advice--where-alist'."
- (let ((desc (assq where advice--where-alist)))
- (unless desc (error "Unknown add-function location `%S'" where))
- (advice--make-1 (nth 1 desc) (nth 2 desc)
- function main props)))
-
-(defun advice--member-p (function name definition)
+ (let ((fd (or (cdr (assq 'depth props)) 0))
+ (md (if (advice--p main)
+ (or (cdr (assq 'depth (advice--props main))) 0))))
+ (if (and md (> fd md))
+ ;; `function' should go deeper.
+ (let ((rest (advice--make where function (advice--cdr main) props)))
+ (advice--make-1 (aref main 1) (aref main 3)
+ (advice--car main) rest (advice--props main)))
+ (let ((desc (assq where advice--where-alist)))
+ (unless desc (error "Unknown add-function location `%S'" where))
+ (advice--make-1 (nth 1 desc) (nth 2 desc)
+ function main props)))))
+
+(defun advice--member-p (function use-name definition)
(let ((found nil))
(while (and (not found) (advice--p definition))
- (if (or (equal function (advice--car definition))
- (when name
- (equal name (cdr (assq 'name (advice--props definition))))))
+ (if (if (eq use-name :use-both)
+ (or (equal function
+ (cdr (assq 'name (advice--props definition))))
+ (equal function (advice--car definition)))
+ (equal function (if use-name
+ (cdr (assq 'name (advice--props definition)))
+ (advice--car definition))))
(setq found definition)
(setq definition (advice--cdr definition))))
found))
@@ -190,8 +213,8 @@ WHERE is a symbol to select an entry in `advice--where-alist'."
(lambda (first rest props)
(cond ((not first) rest)
((or (equal function first)
- (equal function (cdr (assq 'name props))))
- (list rest))))))
+ (equal function (cdr (assq 'name props))))
+ (list (advice--remove-function rest function)))))))
(defvar advice--buffer-local-function-sample nil
"keeps an example of the special \"run the default value\" functions.
@@ -213,11 +236,16 @@ different, but `function-equal' will hopefully ignore those differences.")
;; This function acts like the t special value in buffer-local hooks.
(lambda (&rest args) (apply (default-value var) args)))))
+(eval-and-compile
+ (defun advice--normalize-place (place)
+ (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place)))
+ ((eq 'var (car-safe place)) (nth 1 place))
+ ((symbolp place) `(default-value ',place))
+ (t place))))
+
;;;###autoload
(defmacro add-function (where place function &optional props)
;; TODO:
- ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP
- ;; and tracing want to stay first.
;; - maybe let `where' specify some kind of predicate and use it
;; to implement things like mode-local or eieio-defmethod.
;; Of course, that only makes sense if the predicates of all advices can
@@ -245,9 +273,14 @@ If FUNCTION was already added, do nothing.
PROPS is an alist of additional properties, among which the following have
a special meaning:
- `name': a string or symbol. It can be used to refer to this piece of advice.
+- `depth': a number indicating a preference w.r.t ordering.
+ The default depth is 0. By convention, a depth of 100 means that
+ the advice should be innermost (i.e. at the end of the list),
+ whereas a depth of -100 means that the advice should be outermost.
-If PLACE is a simple variable, only its global value will be affected.
-Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally.
+If PLACE is a symbol, its `default-value' will be affected.
+Use (local 'SYMBOL) if you want to apply FUNCTION to SYMBOL buffer-locally.
+Use (var VAR) if you want to apply FUNCTION to the (lexical) VAR.
If one of FUNCTION or OLDFUN is interactive, then the resulting function
is also interactive. There are 3 cases:
@@ -257,20 +290,18 @@ is also interactive. There are 3 cases:
`advice-eval-interactive-spec') and return the list of arguments to use.
- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
(declare (debug t)) ;;(indent 2)
- (cond ((eq 'local (car-safe place))
- (setq place `(advice--buffer-local ,@(cdr place))))
- ((symbolp place)
- (setq place `(default-value ',place))))
- `(advice--add-function ,where (gv-ref ,place) ,function ,props))
+ `(advice--add-function ,where (gv-ref ,(advice--normalize-place place))
+ ,function ,props))
;;;###autoload
(defun advice--add-function (where ref function props)
- (let ((a (advice--member-p function (cdr (assq 'name props))
- (gv-deref ref))))
+ (let* ((name (cdr (assq 'name props)))
+ (a (advice--member-p (or name function) (if name t) (gv-deref ref))))
(when a
;; The advice is already present. Remove the old one, first.
(setf (gv-deref ref)
- (advice--remove-function (gv-deref ref) (advice--car a))))
+ (advice--remove-function (gv-deref ref)
+ (or name (advice--car a)))))
(setf (gv-deref ref)
(advice--make where function (gv-deref ref) props))))
@@ -281,11 +312,7 @@ If FUNCTION was not added to PLACE, do nothing.
Instead of FUNCTION being the actual function, it can also be the `name'
of the piece of advice."
(declare (debug t))
- (cond ((eq 'local (car-safe place))
- (setq place `(advice--buffer-local ,@(cdr place))))
- ((symbolp place)
- (error "Use (default-value '%S) or (local '%S)" place place)))
- (gv-letplace (getter setter) place
+ (gv-letplace (getter setter) (advice--normalize-place place)
(macroexp-let2 nil new `(advice--remove-function ,getter ,function)
`(unless (eq ,new ,getter) ,(funcall setter new)))))
@@ -301,7 +328,7 @@ properties alist that was specified when it was added."
"Return non-nil if ADVICE is already in FUNCTION-DEF.
Instead of ADVICE being the actual function, it can also be the `name'
of the piece of advice."
- (advice--member-p advice advice function-def))
+ (advice--member-p advice :use-both function-def))
;;;; Specific application of add-function to `symbol-function' for advice.
@@ -360,7 +387,6 @@ of the piece of advice."
(unless (eq oldadv (get symbol 'advice--pending))
(put symbol 'advice--pending (advice--subst-main oldadv nil)))
(funcall fsetfun symbol newdef))))
-
;;;###autoload
(defun advice-add (symbol where function &optional props)
@@ -379,15 +405,15 @@ is defined as a macro, alias, command, ..."
;; Reasons to delay installation of the advice:
;; - If the function is not yet defined, installing
;; the advice would affect `fboundp'ness.
- ;; - If it's an autoloaded command,
- ;; advice--make-interactive-form would end up
- ;; loading the command eagerly.
+ ;; - the symbol-function slot of an autoloaded
+ ;; function is not itself a function value.
;; - `autoload' does nothing if the function is
;; not an autoload or undefined.
((or (not nf) (autoloadp nf))
(get symbol 'advice--pending))
(t (symbol-function symbol)))
function props)
+ (put symbol 'function-documentation `(advice--make-docstring ',symbol))
(add-function :around (get symbol 'defalias-fset-function)
#'advice--defalias-fset))
nil)
@@ -407,7 +433,6 @@ of the piece of advice."
(t (symbol-function symbol)))
function)
(unless (advice--p (advice--symbol-function symbol))
- ;; Not advised any more.
(remove-function (get symbol 'defalias-fset-function)
#'advice--defalias-fset)
(let ((asr (get symbol 'advice--saved-rewrite)))
@@ -416,6 +441,30 @@ of the piece of advice."
(fset symbol (car (get symbol 'advice--saved-rewrite)))))))
nil)
+;;;###autoload
+(defmacro define-advice (symbol args &rest body)
+ "Define an advice and add it to function named SYMBOL.
+See `advice-add' and `add-function' for explanation on the
+arguments. Note if NAME is nil the advice is anonymous;
+otherwise it is named `SYMBOL@NAME'.
+
+\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)"
+ (declare (indent 2) (doc-string 3) (debug (sexp sexp body)))
+ (or (listp args) (signal 'wrong-type-argument (list 'listp args)))
+ (or (<= 2 (length args) 4)
+ (signal 'wrong-number-of-arguments (list 2 4 (length args))))
+ (let* ((where (nth 0 args))
+ (lambda-list (nth 1 args))
+ (name (nth 2 args))
+ (depth (nth 3 args))
+ (props (and depth `((depth . ,depth))))
+ (advice (cond ((null name) `(lambda ,lambda-list ,@body))
+ ((or (stringp name) (symbolp name))
+ (intern (format "%s@%s" symbol name)))
+ (t (error "Unrecognized name spec `%S'" name)))))
+ `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body)))
+ (advice-add ',symbol ,where #',advice ,@(and props `(',props))))))
+
(defun advice-mapc (fun symbol)
"Apply FUN to every advice function in SYMBOL.
FUN is called with a two arguments: the function that was added, and the
@@ -473,8 +522,9 @@ of the piece of advice."
(while
(progn
(funcall get-next-frame)
- (not (and (eq (nth 1 frame2) 'apply)
- (eq (nth 3 frame2) inneradvice)))))
+ (and frame2
+ (not (and (eq (nth 1 frame2) 'apply)
+ (eq (nth 3 frame2) inneradvice))))))
(funcall get-next-frame)
(funcall get-next-frame))))
(- i origi 1))))
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 76d7565d64b..81d0b834722 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,6 +1,6 @@
;;; package-x.el --- Package extras
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
@@ -114,18 +114,12 @@ inserted after its first occurrence in the file."
(defun package--archive-contents-from-url (archive-url)
"Parse archive-contents file at ARCHIVE-URL.
Return the file contents, as a string, or nil if unsuccessful."
- (ignore-errors
- (when archive-url
- (let* ((buffer (url-retrieve-synchronously
- (concat archive-url "archive-contents"))))
- (set-buffer buffer)
- (package-handle-response)
- (re-search-forward "^$" nil 'move)
- (forward-char)
- (delete-region (point-min) (point))
- (prog1 (package-read-from-string
- (buffer-substring-no-properties (point-min) (point-max)))
- (kill-buffer buffer))))))
+ (when archive-url
+ (with-temp-buffer
+ (ignore-errors
+ (url-insert-file-contents (concat archive-url "archive-contents"))
+ (package-read-from-string
+ (buffer-substring-no-properties (point-min) (point-max)))))))
(defun package--archive-contents-from-file ()
"Parse the archive-contents at `package-archive-upload-base'"
@@ -162,6 +156,7 @@ DESCRIPTION is the text of the news item."
archive-url))
(declare-function lm-commentary "lisp-mnt" (&optional file))
+(defvar tar-data-buffer)
(defun package-upload-buffer-internal (pkg-desc extension &optional archive-url)
"Upload a package whose contents are in the current buffer.
@@ -209,15 +204,20 @@ if it exists."
(pcase file-type
(`single (lm-commentary))
(`tar nil))) ;; FIXME: Get it from the README file.
+ (extras (package-desc-extras pkg-desc))
(pkg-version (package-version-join split-version))
(pkg-buffer (current-buffer)))
+ ;; `package-upload-file' will error if given a directory,
+ ;; but we check it here as well just in case.
+ (when (eq 'dir file-type)
+ (user-error "Can't upload directory, tar it instead"))
;; Get archive-contents from ARCHIVE-URL if it's non-nil, or
;; from `package-archive-upload-base' otherwise.
(let ((contents (or (package--archive-contents-from-url archive-url)
(package--archive-contents-from-file)))
(new-desc (package-make-ac-desc
- split-version requires desc file-type)))
+ split-version requires desc file-type extras)))
(if (> (car contents) package-archive-version)
(error "Unrecognized archive version %d" (car contents)))
(let ((elt (assq pkg-name (cdr contents))))
@@ -248,7 +248,7 @@ if it exists."
(concat (symbol-name pkg-name) "-readme.txt")
package-archive-upload-base)))
- (set-buffer pkg-buffer)
+ (set-buffer (if (eq file-type 'tar) tar-data-buffer pkg-buffer))
(write-region (point-min) (point-max)
(expand-file-name
(format "%s-%s.%s" pkg-name pkg-version extension)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index add73fd4bde..2962da5a917 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1,6 +1,6 @@
;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
@@ -113,8 +113,6 @@
;;; ToDo:
-;; - a trust mechanism, since compiling a package can run arbitrary code.
-;; For example, download package signatures and check that they match.
;; - putting info dirs at the start of the info path means
;; users see a weird ordering of categories. OTOH we want to
;; override later entries. maybe emacs needs to enforce
@@ -163,15 +161,20 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'epg)) ;For setf accessors.
(require 'tabulated-list)
+(require 'macroexp)
(defgroup package nil
"Manager for Emacs Lisp packages."
:group 'applications
:version "24.1")
+
+;;; Customization options
;;;###autoload
(defcustom package-enable-at-startup t
"Whether to activate installed packages when Emacs starts.
@@ -182,7 +185,6 @@ and before `after-init-hook'. Activation is not done if
Even if the value is nil, you can type \\[package-initialize] to
activate the package system at any time."
:type 'boolean
- :group 'package
:version "24.1")
(defcustom package-load-list '(all)
@@ -200,16 +202,8 @@ If VERSION is a string, only that version is ever loaded.
If VERSION is nil, the package is not loaded (it is \"disabled\")."
:type '(repeat symbol)
:risky t
- :group 'package
:version "24.1")
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-(declare-function url-http-parse-response "url-http" ())
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-(defvar url-http-end-of-headers)
-
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch.
The default value points to the GNU Emacs package repository.
@@ -226,37 +220,72 @@ a package can run arbitrary code."
:type '(alist :key-type (string :tag "Archive name")
:value-type (string :tag "URL or directory name"))
:risky t
- :group 'package
:version "24.1")
-(defcustom package-pinned-packages nil
- "An alist of packages that are pinned to a specific archive
-
-Each element has the form (SYM . ID).
- SYM is a package, as a symbol.
- ID is an archive name. This should correspond to an
- entry in `package-archives'.
+(defcustom package-menu-hide-low-priority 'archive
+ "If non-nil, hide low priority packages from the packages menu.
+A package is considered low priority if there's another version
+of it available such that:
+ (a) the archive of the other package is higher priority than
+ this one, as per `package-archive-priorities';
+ or
+ (b) they both have the same archive priority but the other
+ package has a higher version number.
+
+This variable has three possible values:
+ nil: no packages are hidden;
+ `archive': only criteria (a) is used;
+ t: both criteria are used.
+
+This variable has no effect if `package-menu--hide-packages' is
+nil, so it can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding]."
+ :type '(choice (const :tag "Don't hide anything" nil)
+ (const :tag "Hide per package-archive-priorities"
+ archive)
+ (const :tag "Hide per archive and version number" t))
+ :version "25.1")
+
+(defcustom package-archive-priorities nil
+ "An alist of priorities for packages.
+
+Each element has the form (ARCHIVE-ID . PRIORITY).
+
+When installing packages, the package with the highest version
+number from the archive with the highest priority is
+selected. When higher versions are available from archives with
+lower priorities, the user has to select those manually.
+
+Archives not in this list have the priority 0.
+
+See also `package-menu-hide-low-priority'."
+ :type '(alist :key-type (string :tag "Archive name")
+ :value-type (integer :tag "Priority (default is 0)"))
+ :risky t
+ :version "25.1")
-If the archive of name ID does not contain the package SYM, no
-other location will be considered, which will make the
-package unavailable."
+(defcustom package-pinned-packages nil
+ "An alist of packages that are pinned to specific archives.
+This can be useful if you have multiple package archives enabled,
+and want to control which archive a given package gets installed from.
+
+Each element of the alist has the form (PACKAGE . ARCHIVE), where:
+ PACKAGE is a symbol representing a package
+ ARCHIVE is a string representing an archive (it should be the car of
+an element in `package-archives', e.g. \"gnu\").
+
+Adding an entry to this variable means that only ARCHIVE will be
+considered as a source for PACKAGE. If other archives provide PACKAGE,
+they are ignored (for this package). If ARCHIVE does not contain PACKAGE,
+the package will be unavailable."
:type '(alist :key-type (symbol :tag "Package")
:value-type (string :tag "Archive name"))
+ ;; I don't really see why this is risky...
+ ;; I suppose it could prevent you receiving updates for a package,
+ ;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue
+ ;; if PACKAGE has a known vulnerability that is fixed in newer versions.
:risky t
- :group 'package
:version "24.4")
-(defconst package-archive-version 1
- "Version number of the package archive understood by this file.
-Lower version numbers than this will probably be understood as well.")
-
-;; We don't prime the cache since it tends to get out of date.
-(defvar package-archive-contents nil
- "Cache of the contents of the Emacs Lisp Package Archive.
-This is an alist mapping package names (symbols) to
-non-empty lists of `package-desc' structures.")
-(put 'package-archive-contents 'risky-local-variable t)
-
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
The directory name should be absolute.
@@ -264,7 +293,6 @@ Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
:risky t
- :group 'package
:version "24.1")
(defcustom package-directory-list
@@ -272,8 +300,8 @@ packages in `package-directory-list'."
(let (result)
(dolist (f load-path)
(and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) result)))
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) result)))
(nreverse result))
"List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
@@ -282,9 +310,60 @@ These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
:risky t
- :group 'package
:version "24.1")
+(defvar epg-gpg-program)
+
+(defcustom package-check-signature
+ (if (progn (require 'epg-config) (executable-find epg-gpg-program))
+ 'allow-unsigned)
+ "Non-nil means to check package signatures when installing.
+The value `allow-unsigned' means to still install a package even if
+it is unsigned.
+
+This also applies to the \"archive-contents\" file that lists the
+contents of the archive."
+ :type '(choice (const nil :tag "Never")
+ (const allow-unsigned :tag "Allow unsigned")
+ (const t :tag "Check always"))
+ :risky t
+ :version "24.4")
+
+(defcustom package-unsigned-archives nil
+ "List of archives where we do not check for package signatures."
+ :type '(repeat (string :tag "Archive name"))
+ :risky t
+ :version "24.4")
+
+(defcustom package-selected-packages nil
+ "Store here packages installed explicitly by user.
+This variable is fed automatically by Emacs when installing a new package.
+This variable is used by `package-autoremove' to decide
+which packages are no longer needed.
+You can use it to (re)install packages on other machines
+by running `package-install-selected-packages'.
+
+To check if a package is contained in this list here, use
+`package--user-selected-p', as it may populate the variable with
+a sane initial value."
+ :type '(repeat symbol))
+
+(defcustom package-menu-async t
+ "If non-nil, package-menu will use async operations when possible.
+Currently, only the refreshing of archive contents supports
+asynchronous operations. Package transactions are still done
+synchronously."
+ :type 'boolean
+ :version "25.1")
+
+
+;;; `package-desc' object definition
+;; This is the struct used internally to represent packages.
+;; Functions that deal with packages should generally take this object
+;; as an argument. In some situations (e.g. commands that query the
+;; user) it makes sense to take the package name as a symbol instead,
+;; but keep in mind there could be multiple `package-desc's with the
+;; same name.
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
@@ -296,7 +375,7 @@ contrast, `package-user-dir' contains packages for personal use."
(:constructor
package-desc-from-define
(name-string version-string &optional summary requirements
- &key kind archive &allow-other-keys
+ &rest rest-plist
&aux
(name (intern name-string))
(version (version-to-list version-string))
@@ -305,7 +384,21 @@ contrast, `package-user-dir' contains packages for personal use."
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
- requirements))))))
+ requirements)))
+ (kind (plist-get rest-plist :kind))
+ (archive (plist-get rest-plist :archive))
+ (extras (let (alist)
+ (while rest-plist
+ (unless (memq (car rest-plist) '(:kind :archive))
+ (let ((value (cadr rest-plist)))
+ (when value
+ (push (cons (car rest-plist)
+ (if (eq (car-safe value) 'quote)
+ (cadr value)
+ value))
+ alist))))
+ (setq rest-plist (cddr rest-plist)))
+ alist)))))
"Structure containing information about an individual package.
Slots:
@@ -314,29 +407,71 @@ Slots:
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
- the first line of the file.
+ the first line of the file.
`reqs' Requirements of the package. A list of (PACKAGE
- VERSION-LIST) naming the dependent package and the minimum
- required version.
+ VERSION-LIST) naming the dependent package and the minimum
+ required version.
`kind' The distribution format of the package. Currently, it is
- either `single' or `tar'.
+ either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
- package came.
+ package came.
`dir' The directory where the package is installed (if installed),
- `builtin' if it is built-in, or nil otherwise."
+ `builtin' if it is built-in, or nil otherwise.
+
+`extras' Optional alist of additional keyword-value pairs.
+
+`signed' Flag to indicate that the package is signed by provider."
name
version
(summary package--default-summary)
reqs
kind
archive
- dir)
+ dir
+ extras
+ signed)
+
+(defun package--from-builtin (bi-desc)
+ (package-desc-create :name (pop bi-desc)
+ :version (package--bi-desc-version bi-desc)
+ :summary (package--bi-desc-summary bi-desc)
+ :dir 'builtin))
;; Pseudo fields.
+(defun package-version-join (vlist)
+ "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+ (if (null vlist)
+ ""
+ (let ((str-list (list "." (int-to-string (car vlist)))))
+ (dolist (num (cdr vlist))
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -4)
+ (error "Invalid version list `%s'" vlist))
+ (t
+ ;; pre, or beta, or alpha
+ (cond ((equal "." (car str-list))
+ (pop str-list))
+ ((not (string-match "[0-9]+" (car str-list)))
+ (error "Invalid version list `%s'" vlist)))
+ (push (cond ((= num -1) "pre")
+ ((= num -2) "beta")
+ ((= num -3) "alpha")
+ ((= num -4) "snapshot"))
+ str-list))))
+ (if (equal "." (car str-list))
+ (pop str-list))
+ (apply 'concat (nreverse str-list)))))
+
(defun package-desc-full-name (pkg-desc)
(format "%s-%s"
(package-desc-name pkg-desc)
@@ -346,8 +481,19 @@ Slots:
(pcase (package-desc-kind pkg-desc)
(`single ".el")
(`tar ".tar")
+ (`dir "")
(kind (error "Unknown package kind: %s" kind))))
+(defun package-desc--keywords (pkg-desc)
+ (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc)))))
+ (if (eq (car-safe keywords) 'quote)
+ (nth 1 keywords)
+ keywords)))
+
+(defun package-desc-priority (p)
+ "Return the priority of the archive of package-desc object P."
+ (package-archive-priority (package-desc-archive p)))
+
;; Package descriptor format used in finder-inf.el and package--builtins.
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
@@ -356,6 +502,13 @@ Slots:
reqs
summary)
+
+;;; Installed packages
+;; The following variables store information about packages present in
+;; the system. The most important of these is `package-alist'. The
+;; command `package-initialize' is also closely related to this
+;; section, but it is left for a later section because it also affects
+;; other stuff.
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
@@ -382,46 +535,44 @@ loaded and/or activated, customize `package-load-list'.")
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
-(defun package-version-join (vlist)
- "Return the version string corresponding to the list VLIST.
-This is, approximately, the inverse of `version-to-list'.
-\(Actually, it returns only one of the possible inverses, since
-`version-to-list' is a many-to-one operation.)"
- (if (null vlist)
- ""
- (let ((str-list (list "." (int-to-string (car vlist)))))
- (dolist (num (cdr vlist))
- (cond
- ((>= num 0)
- (push (int-to-string num) str-list)
- (push "." str-list))
- ((< num -3)
- (error "Invalid version list `%s'" vlist))
- (t
- ;; pre, or beta, or alpha
- (cond ((equal "." (car str-list))
- (pop str-list))
- ((not (string-match "[0-9]+" (car str-list)))
- (error "Invalid version list `%s'" vlist)))
- (push (cond ((= num -1) "pre")
- ((= num -2) "beta")
- ((= num -3) "alpha"))
- str-list))))
- (if (equal "." (car str-list))
- (pop str-list))
- (apply 'concat (nreverse str-list)))))
+;;;; Populating `package-alist'.
+;; The following functions are called on each installed package by
+;; `package-load-all-descriptors', which ultimately populates the
+;; `package-alist' variable.
+(defun package-process-define-package (exp)
+ (when (eq (car-safe exp) 'define-package)
+ (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
+ (name (package-desc-name new-pkg-desc))
+ (version (package-desc-version new-pkg-desc))
+ (old-pkgs (assq name package-alist)))
+ (if (null old-pkgs)
+ ;; If there's no old package, just add this to `package-alist'.
+ (push (list name new-pkg-desc) package-alist)
+ ;; If there is, insert the new package at the right place in the list.
+ (while
+ (if (and (cdr old-pkgs)
+ (version-list-< version
+ (package-desc-version (cadr old-pkgs))))
+ (setq old-pkgs (cdr old-pkgs))
+ (push new-pkg-desc (cdr old-pkgs))
+ nil)))
+ new-pkg-desc)))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
+ pkg-dir))
+ (signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
(goto-char (point-min))
- (let ((pkg-desc (package-process-define-package
- (read (current-buffer)) pkg-file)))
+ (let ((pkg-desc (or (package-process-define-package
+ (read (current-buffer)))
+ (error "Can't find define-package in %s" pkg-file))))
(setf (package-desc-dir pkg-desc) pkg-dir)
+ (if (file-exists-p signed-file)
+ (setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
@@ -436,10 +587,29 @@ updates `package-alist'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
- (let ((pkg-dir (expand-file-name subdir dir)))
- (when (file-directory-p pkg-dir)
- (package-load-descriptor pkg-dir)))))))
+ (unless (equal subdir "..")
+ (let ((pkg-dir (expand-file-name subdir dir)))
+ (when (file-directory-p pkg-dir)
+ (package-load-descriptor pkg-dir))))))))
+
+(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.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+ ;; FIXME: Placeholder! Should we keep it?
+ (error "Don't call me!"))
+
+;;; Package activation
+;; Section for functions used by `package-activate', which see.
(defun package-disabled-p (pkg-name version)
"Return whether PKG-NAME at VERSION can be activated.
The decision is made according to `package-load-list'.
@@ -455,50 +625,123 @@ Return the max version (as a string) if the package is held at a lower version."
force))
(t (error "Invalid element in `package-load-list'")))))
-(defun package-activate-1 (pkg-desc)
+(defun package-built-in-p (package &optional min-version)
+ "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+ (if (package-desc-p package) ;; was built-in and then was converted
+ (eq 'builtin (package-desc-dir package))
+ (let ((bi (assq package package--builtin-versions)))
+ (cond
+ (bi (version-list-<= min-version (cdr bi)))
+ ((remove 0 min-version) nil)
+ (t
+ (require 'finder-inf nil t) ; For `package--builtins'.
+ (assq package package--builtins))))))
+
+(defun package--autoloads-file-name (pkg-desc)
+ "Return the absolute name of the autoloads file, sans extension.
+PKG-DESC is a `package-desc' object."
+ (expand-file-name
+ (format "%s-autoloads" (package-desc-name pkg-desc))
+ (package-desc-dir pkg-desc)))
+
+(defun package--activate-autoloads-and-load-path (pkg-desc)
+ "Load the autoloads file and add package dir to `load-path'.
+PKG-DESC is a `package-desc' object."
+ (let* ((old-lp load-path)
+ (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir-dir (file-name-as-directory pkg-dir)))
+ (with-demoted-errors "Error loading autoloads: %s"
+ (load (package--autoloads-file-name pkg-desc) nil t))
+ (when (and (eq old-lp load-path)
+ (not (or (member pkg-dir load-path)
+ (member pkg-dir-dir load-path))))
+ ;; Old packages don't add themselves to the `load-path', so we have to
+ ;; do it ourselves.
+ (push pkg-dir load-path))))
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+
+(defun package-activate-1 (pkg-desc &optional reload)
+ "Activate package given by PKG-DESC, even if it was already active.
+If RELOAD is non-nil, also `load' any files inside the package which
+correspond to previously loaded files (those returned by
+`package--list-loaded-files')."
(let* ((name (package-desc-name pkg-desc))
- (pkg-dir (package-desc-dir pkg-desc)))
+ (pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
- (package-desc-full-name pkg-desc)))
+ (package-desc-full-name pkg-desc)))
+ (let* ((loaded-files-list (when reload
+ (package--list-loaded-files pkg-dir))))
+ ;; Add to load path, add autoloads, and activate the package.
+ (package--activate-autoloads-and-load-path pkg-desc)
+ ;; Call `load' on all files in `pkg-dir' already present in
+ ;; `load-history'. This is done so that macros in these files are updated
+ ;; to their new definitions. If another package is being installed which
+ ;; depends on this new definition, not doing this update would cause
+ ;; compilation errors and break the installation.
+ (with-demoted-errors "Error in package-activate-1: %s"
+ (mapc (lambda (feature) (load feature nil t))
+ ;; Skip autoloads file since we already evaluated it above.
+ (remove (file-truename (package--autoloads-file-name pkg-desc))
+ loaded-files-list))))
;; Add info node.
(when (file-exists-p (expand-file-name "dir" pkg-dir))
;; FIXME: not the friendliest, but simple.
(require 'info)
(info-initialize)
(push pkg-dir Info-directory-list))
- ;; Add to load path, add autoloads, and activate the package.
- (push pkg-dir load-path)
- (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)
(push name package-activated-list)
;; Don't return nil.
t))
-(defun package-built-in-p (package &optional min-version)
- "Return true if PACKAGE is built-in to Emacs.
-Optional arg MIN-VERSION, if non-nil, should be a version list
-specifying the minimum acceptable version."
- (let ((bi (assq package package--builtin-versions)))
- (cond
- (bi (version-list-<= min-version (cdr bi)))
- (min-version nil)
- (t
- (require 'finder-inf nil t) ; For `package--builtins'.
- (assq package package--builtins)))))
-
-(defun package--from-builtin (bi-desc)
- (package-desc-create :name (pop bi-desc)
- :version (package--bi-desc-version bi-desc)
- :summary (package--bi-desc-summary bi-desc)
- :dir 'builtin))
-
-;; This function goes ahead and activates a newer version of a package
-;; if an older one was already activated. This is not ideal; we'd at
-;; least need to check to see if the package has actually been loaded,
-;; and not merely activated.
+(declare-function find-library-name "find-func" (library))
+
+(defun package--list-loaded-files (dir)
+ "Recursively list all files in DIR which correspond to loaded features.
+Returns the `file-name-sans-extension' of each file, relative to
+DIR, sorted by most recently loaded last."
+ (let* ((history (delq nil
+ (mapcar (lambda (x)
+ (let ((f (car x)))
+ (and f (file-name-sans-extension f))))
+ load-history)))
+ (dir (file-truename dir))
+ ;; List all files that have already been loaded.
+ (list-of-conflicts
+ (delq
+ nil
+ (mapcar
+ (lambda (x) (let* ((file (file-relative-name x dir))
+ ;; Previously loaded file, if any.
+ (previous
+ (ignore-errors
+ (file-name-sans-extension
+ (file-truename (find-library-name file)))))
+ (pos (when previous (member previous history))))
+ ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+ (when pos
+ (cons (file-name-sans-extension file) (length pos)))))
+ (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
+ ;; Turn the list of (FILENAME . POS) back into a list of features. Files in
+ ;; subdirectories are returned relative to DIR (so not actually features).
+ (let ((default-directory (file-name-as-directory dir)))
+ (mapcar (lambda (x) (file-truename (car x)))
+ (sort list-of-conflicts
+ ;; Sort the files by ascending HISTORY-POSITION.
+ (lambda (x y) (< (cdr x) (cdr y))))))))
+
+;;;; `package-activate'
+;; This function activates a newer version of a package if an older
+;; one was already activated. It also loads a features of this
+;; package which were already loaded.
(defun package-activate (package &optional force)
"Activate package PACKAGE.
-If FORCE is true, (re-)activate it if it's already activated."
+If FORCE is true, (re-)activate it if it's already activated.
+Newer versions are always activated, regardless of FORCE."
(let ((pkg-descs (cdr (assq package package-alist))))
;; Check if PACKAGE is available in `package-alist'.
(while
@@ -521,85 +764,23 @@ If FORCE is true, (re-)activate it if it's already activated."
(fail (catch 'dep-failure
;; Activate its dependencies recursively.
(dolist (req (package-desc-reqs pkg-vec))
- (unless (package-activate (car req) (cadr req))
+ (unless (package-activate (car req))
(throw 'dep-failure req))))))
- (if fail
- (warn "Unable to activate package `%s'.
+ (if fail
+ (warn "Unable to activate package `%s'.
Required package `%s-%s' is unavailable"
- package (car fail) (package-version-join (cadr fail)))
- ;; If all goes well, activate the package itself.
- (package-activate-1 pkg-vec)))))))
-
-(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.
-DOCSTRING is a short description of the package, a string.
-REQUIREMENTS is a list of dependencies on other packages.
- Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
- where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
- ;; FIXME: Placeholder! Should we keep it?
- (error "Don't call me!"))
-
-(defun package-process-define-package (exp origin)
- (unless (eq (car-safe exp) 'define-package)
- (error "Can't find define-package in %s" origin))
- (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
- (name (package-desc-name new-pkg-desc))
- (version (package-desc-version new-pkg-desc))
- (old-pkgs (assq name package-alist)))
- (if (null old-pkgs)
- ;; If there's no old package, just add this to `package-alist'.
- (push (list name new-pkg-desc) package-alist)
- ;; If there is, insert the new package at the right place in the list.
- (while
- (if (and (cdr old-pkgs)
- (version-list-< version
- (package-desc-version (cadr old-pkgs))))
- (setq old-pkgs (cdr old-pkgs))
- (push new-pkg-desc (cdr old-pkgs))
- nil)))
- new-pkg-desc))
-
-;; From Emacs 22, but changed so it adds to load-path.
-(defun package-autoload-ensure-default-file (file)
- "Make sure that the autoload file FILE exists and if not create it."
- (unless (file-exists-p file)
- (write-region
- (concat ";;; " (file-name-nondirectory file)
- " --- automatically extracted autoloads\n"
- ";;\n"
- ";;; Code:\n"
- "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
- " \n;; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n"
- ";; no-update-autoloads: t\n"
- ";; End:\n"
- ";;; " (file-name-nondirectory file)
- " ends here\n")
- nil file))
- file)
+ package (car fail) (package-version-join (cadr fail)))
+ ;; If all goes well, activate the package itself.
+ (package-activate-1 pkg-vec force)))))))
-(defvar generated-autoload-file)
-(defvar version-control)
-
-(defun package-generate-autoloads (name pkg-dir)
- (require 'autoload) ;Load before we let-bind generated-autoload-file!
- (let* ((auto-name (format "%s-autoloads.el" name))
- ;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
- (version-control 'never))
- (package-autoload-ensure-default-file generated-autoload-file)
- (update-directory-autoloads pkg-dir)
- (let ((buf (find-buffer-visiting generated-autoload-file)))
- (when buf (kill-buffer buf)))
- auto-name))
+
+;;; Installation -- Local operations
+;; This section contains a variety of features regarding installing a
+;; package to/from disk. This includes autoload generation,
+;; unpacking, compiling, as well as defining a package from the
+;; current buffer.
+;;;; Unpacking
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
(declare-function tar-header-name "tar-mode" (tar-header) t)
@@ -613,50 +794,41 @@ untar into a directory named DIR; otherwise, signal an error."
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
- (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+ (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
(dolist (tar-data tar-parse-info)
(let ((name (expand-file-name (tar-header-name tar-data))))
- (or (string-match regexp name)
- ;; Tarballs created by some utilities don't list
- ;; directories with a trailing slash (Bug#13136).
- (and (string-equal dir name)
- (eq (tar-header-link-type tar-data) 5))
- (error "Package does not untar cleanly into directory %s/" dir)))))
+ (or (string-match regexp name)
+ ;; Tarballs created by some utilities don't list
+ ;; directories with a trailing slash (Bug#13136).
+ (and (string-equal dir name)
+ (eq (tar-header-link-type tar-data) 5))
+ (error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
-(defun package-generate-description-file (pkg-desc pkg-dir)
- "Create the foo-pkg.el file for single-file packages."
- (let* ((name (package-desc-name pkg-desc))
- (pkg-file (expand-file-name (package--description-file pkg-dir)
- pkg-dir)))
- (let ((print-level nil)
- (print-quoted t)
- (print-length nil))
- (write-region
- (concat
- (prin1-to-string
- (list 'define-package
- (symbol-name name)
- (package-version-join (package-desc-version pkg-desc))
- (package-desc-summary pkg-desc)
- (let ((requires (package-desc-reqs pkg-desc)))
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires)))))
- "\n")
- nil
- pkg-file))))
-
+(defun package--alist-to-plist-args (alist)
+ (mapcar 'macroexp-quote
+ (apply #'nconc
+ (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
(defun package-unpack (pkg-desc)
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
- (pkg-dir (expand-file-name dirname package-user-dir)))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
+ (`dir
+ (make-directory pkg-dir t)
+ (let ((file-list
+ (directory-files
+ default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
+ (dolist (source-file file-list)
+ (let ((target-el-file
+ (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
+ (copy-file source-file target-el-file t)))
+ ;; Now that the files have been installed, this package is
+ ;; indistinguishable from a `tar' or a `single'. Let's make
+ ;; things simple by ensuring we're one of them.
+ (setf (package-desc-kind pkg-desc)
+ (if (> (length file-list) 1) 'tar 'single))))
(`tar
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
@@ -679,23 +851,269 @@ untar into a directory named DIR; otherwise, signal an error."
(package-activate name 'force)
pkg-dir))
+(defun package-generate-description-file (pkg-desc pkg-file)
+ "Create the foo-pkg.el file for single-file packages."
+ (let* ((name (package-desc-name pkg-desc)))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (package-version-join (package-desc-version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+;;;; Autoload
+;; From Emacs 22, but changed so it adds to load-path.
+(defun package-autoload-ensure-default-file (file)
+ "Make sure that the autoload file FILE exists and if not create it."
+ (unless (file-exists-p file)
+ (write-region
+ (concat ";;; " (file-name-nondirectory file)
+ " --- automatically extracted autoloads\n"
+ ";;\n"
+ ";;; Code:\n"
+ ;; `load-path' should contain only directory names
+ "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n"
+ " \n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
+ ";; End:\n"
+ ";;; " (file-name-nondirectory file)
+ " ends here\n")
+ nil file nil 'silent))
+ file)
+
+(defvar generated-autoload-file)
+(defvar version-control)
+
+(defun package-generate-autoloads (name pkg-dir)
+ (let* ((auto-name (format "%s-autoloads.el" name))
+ ;;(ignore-name (concat name "-pkg.el"))
+ (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ ;; Silence `autoload-generate-file-autoloads'.
+ (noninteractive inhibit-message)
+ (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)))
+ (when buf (kill-buffer buf)))
+ auto-name))
+
(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
"Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
(package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
- (let ((desc-file (package--description-file pkg-dir)))
+ (let ((desc-file (expand-file-name (package--description-file pkg-dir)
+ pkg-dir)))
(unless (file-exists-p desc-file)
- (package-generate-description-file pkg-desc pkg-dir)))
+ (package-generate-description-file pkg-desc desc-file)))
;; FIXME: Create foo.info and dir file from foo.texi?
)
+;;;; Compilation
+(defvar warning-minimum-level)
(defun package--compile (pkg-desc)
"Byte-compile installed package PKG-DESC."
- (package-activate-1 pkg-desc)
- (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))
+ (let ((warning-minimum-level :error)
+ (save-silently inhibit-message)
+ (load-path load-path))
+ (package--activate-autoloads-and-load-path pkg-desc)
+ (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
+
+;;;; Inferring package from current buffer
+(defun package-read-from-string (str)
+ "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+ (let* ((read-data (read-from-string str))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
+ (if more-left
+ (error "Can't read whole string")
+ (car read-data))))
+
+(defun package--prepare-dependencies (deps)
+ "Turn DEPS into an acceptable list of dependencies.
+
+Any parts missing a version string get a default version string
+of \"0\" (meaning any version) and an appropriate level of lists
+is wrapped around any parts requiring it."
+ (cond
+ ((not (listp deps))
+ (error "Invalid requirement specifier: %S" deps))
+ (t (mapcar (lambda (dep)
+ (cond
+ ((symbolp dep) `(,dep "0"))
+ ((stringp dep)
+ (error "Invalid requirement specifier: %S" dep))
+ ((and (listp dep) (null (cdr dep)))
+ (list (car dep) "0"))
+ (t dep)))
+ deps))))
+
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-homepage "lisp-mnt" (&optional file))
+(declare-function lm-maintainer "lisp-mnt" (&optional file))
+(declare-function lm-authors "lisp-mnt" (&optional file))
+
+(defun package-buffer-info ()
+ "Return a `package-desc' describing the package in the current buffer.
+
+If the buffer does not contain a conforming package, signal an
+error. If there is a package, narrow the buffer to the file's
+boundaries."
+ (goto-char (point-min))
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
+ (error "Package lacks a file header"))
+ (let ((file-name (match-string-no-properties 1))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
+ (unless (search-forward (concat ";;; " file-name ".el ends here"))
+ (error "Package lacks a terminating comment"))
+ ;; Try to include a trailing newline.
+ (forward-line)
+ (narrow-to-region start (point))
+ (require 'lisp-mnt)
+ ;; Use some headers we've invented to drive the process.
+ (let* ((requires-str (lm-header "package-requires"))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
+ (homepage (lm-homepage)))
+ (unless pkg-version
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (package-desc-from-define
+ file-name pkg-version desc
+ (if requires-str
+ (package--prepare-dependencies
+ (package-read-from-string requires-str)))
+ :kind 'single
+ :url homepage
+ :maintainer (lm-maintainer)
+ :authors (lm-authors)))))
+
+(defun package--read-pkg-desc (kind)
+ "Read a `define-package' form in current buffer.
+Return the pkg-desc, with desc-kind set to KIND."
+ (goto-char (point-min))
+ (unwind-protect
+ (let* ((pkg-def-parsed (read (current-buffer)))
+ (pkg-desc
+ (when (eq (car pkg-def-parsed) 'define-package)
+ (apply #'package-desc-from-define
+ (append (cdr pkg-def-parsed))))))
+ (when pkg-desc
+ (setf (package-desc-kind pkg-desc) kind)
+ pkg-desc))))
+
+(declare-function tar-get-file-descriptor "tar-mode" (file))
+(declare-function tar--extract "tar-mode" (descriptor))
+
+(defun package-tar-file-info ()
+ "Find package information for a tar file.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'tar-mode))
+ (let* ((dir-name (file-name-directory
+ (tar-header-name (car tar-parse-info))))
+ (desc-file (package--description-file dir-name))
+ (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
+ (unless tar-desc
+ (error "No package descriptor file found"))
+ (with-current-buffer (tar--extract tar-desc)
+ (unwind-protect
+ (or (package--read-pkg-desc 'tar)
+ (error "Can't find define-package in %s"
+ (tar-header-name tar-desc)))
+ (kill-buffer (current-buffer))))))
+
+(defun package-dir-info ()
+ "Find package information for a directory.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'dired-mode))
+ (let* ((desc-file (package--description-file default-directory)))
+ (if (file-readable-p desc-file)
+ (with-temp-buffer
+ (insert-file-contents desc-file)
+ (package--read-pkg-desc 'dir))
+ (let ((files (directory-files default-directory t "\\.el\\'" t))
+ info)
+ (while files
+ (with-temp-buffer
+ (insert-file-contents (pop files))
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))
+ ;; and return the info.
+ info))))
+
+;;; Communicating with Archives
+;; Set of low-level functions for communicating with archives and
+;; signature checking.
(defun package--write-file-no-coding (file-name)
(let ((buffer-file-coding-system 'no-conversion))
- (write-region (point-min) (point-max) file-name)))
+ (write-region (point-min) (point-max) file-name nil 'silent)))
+
+(declare-function url-http-file-exists-p "url-http" (url))
+
+(defun package--archive-file-exists-p (location file)
+ (let ((http (string-match "\\`https?:" location)))
+ (if http
+ (progn
+ (require 'url-http)
+ (url-http-file-exists-p (concat location file)))
+ (file-exists-p (expand-file-name file location)))))
+
+(declare-function epg-make-context "epg"
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm))
+(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))
+
+(defun package--display-verify-error (context sig-file)
+ (unless (equal (epg-context-error-output context) "")
+ (with-output-to-temp-buffer "*Error*"
+ (with-current-buffer standard-output
+ (if (epg-context-result-for context 'verify)
+ (insert (format "Failed to verify signature %s:\n" sig-file)
+ (mapconcat #'epg-signature-to-string
+ (epg-context-result-for context 'verify)
+ "\n"))
+ (insert (format "Error while verifying signature %s:\n" sig-file)))
+ (insert "\nCommand output:\n" (epg-context-error-output context))))))
(defmacro package--with-work-buffer (location file &rest body)
"Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -707,61 +1125,436 @@ This macro retrieves FILE from LOCATION into a temporary buffer,
and evaluates BODY while that buffer is current. This work
buffer is killed afterwards. Return the last value in BODY."
(declare (indent 2) (debug t))
- `(let* ((http (string-match "\\`https?:" ,location))
- (buffer
- (if http
- (url-retrieve-synchronously (concat ,location ,file))
- (generate-new-buffer "*package work buffer*"))))
- (prog1
- (with-current-buffer buffer
- (if http
- (progn (package-handle-response)
- (re-search-forward "^$" nil 'move)
- (forward-char)
- (delete-region (point-min) (point)))
- (unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
- (insert-file-contents (expand-file-name ,file ,location)))
- ,@body)
- (kill-buffer buffer))))
-
-(defun package-handle-response ()
- "Handle the response from a `url-retrieve-synchronously' call.
-Parse the HTTP response and throw if an error occurred.
-The url package seems to require extra processing for this.
-This should be called in a `save-excursion', in the download buffer.
-It will move point to somewhere in the headers."
- ;; We assume HTTP here.
- (require 'url-http)
- (let ((response (url-http-parse-response)))
- (when (or (< response 200) (>= response 300))
- (error "Error during download request:%s"
- (buffer-substring-no-properties (point) (line-end-position))))))
+ `(with-temp-buffer
+ (if (string-match-p "\\`https?:" ,location)
+ (url-insert-file-contents (concat ,location ,file))
+ (unless (file-name-absolute-p ,location)
+ (error "Archive location %s is not an absolute file name"
+ ,location))
+ (insert-file-contents (expand-file-name ,file ,location)))
+ ,@body))
+
+(defmacro package--with-work-buffer-async (location file async &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+If ASYNC is non-nil, and if it is possible, run BODY
+asynchronously. If an error is encountered and ASYNC is a
+function, call it with no arguments (instead of executing BODY).
+If it returns non-nil, or if it wasn't a function, propagate the
+error.
+
+For a description of the other arguments see
+`package--with-work-buffer'."
+ (declare (indent 3) (debug t))
+ (macroexp-let2* macroexp-copyable-p
+ ((async-1 async)
+ (file-1 file)
+ (location-1 location))
+ `(if (or (not ,async-1)
+ (not (string-match-p "\\`https?:" ,location-1)))
+ (package--with-work-buffer ,location-1 ,file-1 ,@body)
+ ;; This `condition-case' is to catch connection errors.
+ (condition-case error-signal
+ (url-retrieve (concat ,location-1 ,file-1)
+ ;; This is to catch execution errors.
+ (lambda (status)
+ (condition-case error-signal
+ (progn
+ (when-let ((er (plist-get status :error)))
+ (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er))
+ (goto-char (point-min))
+ (unless (search-forward "\n\n" nil 'noerror)
+ (error "Invalid url response in buffer %s"
+ (current-buffer)))
+ (delete-region (point-min) (point))
+ ,@body
+ (kill-buffer (current-buffer)))
+ (error (when (if (functionp ,async-1) (funcall ,async-1) t)
+ (signal (car error-signal) (cdr error-signal))))))
+ nil
+ 'silent)
+ (error (when (if (functionp ,async-1) (funcall ,async-1) t)
+ (message "Error contacting: %s" (concat ,location-1 ,file-1))
+ (signal (car error-signal) (cdr error-signal))))))))
+
+(defun package--check-signature-content (content string &optional sig-file)
+ "Check signature CONTENT against STRING.
+SIG-FILE is the name of the signature file, used when signaling
+errors."
+ (let* ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (setf (epg-context-home-directory context) homedir)
+ (condition-case error
+ (epg-verify-string context content string)
+ (error (package--display-verify-error context sig-file)
+ (signal (car error) (cdr error))))
+ (let (good-signatures had-fatal-error)
+ ;; The .sig file may contain multiple signatures. Success if one
+ ;; of the signatures is good.
+ (dolist (sig (epg-context-result-for context 'verify))
+ (if (eq (epg-signature-status sig) 'good)
+ (push sig good-signatures)
+ ;; If package-check-signature is allow-unsigned, don't
+ ;; signal error when we can't verify signature because of
+ ;; missing public key. Other errors are still treated as
+ ;; fatal (bug#17625).
+ (unless (and (eq package-check-signature 'allow-unsigned)
+ (eq (epg-signature-status sig) 'no-pubkey))
+ (setq had-fatal-error t))))
+ (when (and (null good-signatures) had-fatal-error)
+ (package--display-verify-error context sig-file)
+ (error "Failed to verify signature %s" sig-file))
+ good-signatures)))
+
+(defun package--check-signature (location file &optional string async callback)
+ "Check signature of the current buffer.
+Download the signature file from LOCATION by appending \".sig\"
+to FILE.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'.
+STRING is the string to verify, it defaults to `buffer-string'.
+If ASYNC is non-nil, the download of the signature file is
+done asynchronously.
+
+If the signature is verified and CALLBACK was provided, CALLBACK
+is `funcall'ed with the list of good signatures as argument (the
+list can be empty). If the signatures file is not found,
+CALLBACK is called with no arguments."
+ (let ((sig-file (concat file ".sig"))
+ (string (or string (buffer-string))))
+ (condition-case nil
+ (package--with-work-buffer-async
+ location sig-file (when async (or callback t))
+ (let ((sig (package--check-signature-content
+ (buffer-string) string sig-file)))
+ (when callback (funcall callback sig))
+ sig))
+ (file-error (funcall callback)))))
-(defun package-install-from-archive (pkg-desc)
- "Download and install a tar package."
- (let ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc))))
- (package--with-work-buffer location file
- (package-unpack pkg-desc))))
+
+;;; Packages on Archives
+;; The following variables store information about packages available
+;; from archives. The most important of these is
+;; `package-archive-contents' which is initially populated by the
+;; function `package-read-all-archive-contents' from a cache on disk.
+;; The `package-initialize' command is also closely related to this
+;; section, but it has its own section.
+(defconst package-archive-version 1
+ "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+ "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to
+non-empty lists of `package-desc' structures.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defvar package--compatibility-table nil
+ "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used. To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
+(defun package--build-compatibility-table ()
+ "Build `package--compatibility-table' with `package--mapc'."
+ ;; Initialize the list of built-ins.
+ (require 'finder-inf nil t)
+ ;; Build compat table.
+ (setq package--compatibility-table (make-hash-table :test 'eq))
+ (package--mapc #'package--add-to-compatibility-table))
+
+(defun package--add-to-compatibility-table (pkg)
+ "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+ (unless (package--incompatible-p pkg 'shallow)
+ (let* ((name (package-desc-name pkg))
+ (version (or (package-desc-version pkg) '(0)))
+ (table-version (gethash name package--compatibility-table)))
+ (when (or (not table-version)
+ (version-list-< table-version version))
+ (puthash name version package--compatibility-table)))))
+
+;; Package descriptor objects used inside the "archive-contents" file.
+;; Changing this defstruct implies changing the format of the
+;; "archive-contents" files.
+(cl-defstruct (package--ac-desc
+ (:constructor package-make-ac-desc (version reqs summary kind extras))
+ (:copier nil)
+ (:type vector))
+ version reqs summary kind extras)
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
+
+(defun package--add-to-archive-contents (package archive)
+ "Add the PACKAGE from the given ARCHIVE if necessary.
+PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
+Also, add the originating archive to the `package-desc' structure."
+ (let* ((name (car package))
+ (version (package--ac-desc-version (cdr package)))
+ (pkg-desc
+ (package-desc-create
+ :name name
+ :version version
+ :reqs (package--ac-desc-reqs (cdr package))
+ :summary (package--ac-desc-summary (cdr package))
+ :kind (package--ac-desc-kind (cdr package))
+ :archive archive
+ :extras (and (> (length (cdr package)) 4)
+ ;; Older archive-contents files have only 4
+ ;; elements here.
+ (package--ac-desc-extras (cdr package)))))
+ (pinned-to-archive (assoc name package-pinned-packages)))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--read-archive-file (file)
+ "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+ (let ((filename (expand-file-name file package-user-dir)))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8))
+ (insert-file-contents filename))
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
+
+(defun package-read-archive-contents (archive)
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((contents-file (format "archives/%s/archive-contents" archive))
+ (contents (package--read-archive-file contents-file)))
+ (when contents
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
+
+(defvar package--old-archive-priorities nil
+ "Store currently used `package-archive-priorities'.
+This is the value of `package-archive-priorities' last time
+`package-read-all-archive-contents' was called. It can be used
+by arbitrary functions to decide whether it is necessary to call
+it again.")
+
+(defun package-read-all-archive-contents ()
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+ (setq package-archive-contents nil)
+ (setq package--old-archive-priorities package-archive-priorities)
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive))))
+;;;; Package Initialize
+;; A bit of a milestone. This brings together some of the above
+;; sections and populates all relevant lists of packages from contents
+;; available on disk.
(defvar package--initialized nil)
-(defun package-installed-p (package &optional min-version)
- "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
-MIN-VERSION should be a version list."
- (unless package--initialized (error "package.el is not yet initialized!"))
- (or
- (let ((pkg-descs (cdr (assq package package-alist))))
- (and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
- ;; Also check built-in packages.
- (package-built-in-p package min-version)))
+(defvar package--init-file-ensured nil
+ "Whether we know the init file has package-initialize.")
+
+;;;###autoload
+(defun package-initialize (&optional no-activate)
+ "Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+If `user-init-file' does not mention `(package-initialize)', add
+it to the file.
+If called as part of loading `user-init-file', set
+`package-enable-at-startup' to nil, to prevent accidentally
+loading packages twice."
+ (interactive)
+ (setq package-alist nil)
+ (if (equal user-init-file load-file-name)
+ ;; If `package-initialize' is being called as part of loading
+ ;; the init file, it's obvious we don't need to ensure-init.
+ (setq package--init-file-ensured t
+ ;; And likely we don't need to run it again after init.
+ package-enable-at-startup nil)
+ (package--ensure-init-file))
+ (package-load-all-descriptors)
+ (package-read-all-archive-contents)
+ (unless no-activate
+ (dolist (elt package-alist)
+ (package-activate (car elt))))
+ (setq package--initialized t)
+ ;; This uses `package--mapc' so it must be called after
+ ;; `package--initialized' is t.
+ (package--build-compatibility-table))
+
+
+;;;; Populating `package-archive-contents' from archives
+;; This subsection populates the variables listed above from the
+;; actual archives, instead of from a local cache.
+(defvar package--downloads-in-progress nil
+ "List of in-progress asynchronous downloads.")
+
+(declare-function epg-check-configuration "epg-config"
+ (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+;;;###autoload
+(defun package-import-keyring (&optional file)
+ "Import keys from FILE."
+ (interactive "fFile: ")
+ (setq file (expand-file-name file))
+ (let ((context (epg-make-context 'OpenPGP))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
+ (with-file-modes 448
+ (make-directory homedir t))
+ (setf (epg-context-home-directory context) homedir)
+ (message "Importing %s..." (file-name-nondirectory file))
+ (epg-import-keys-from-file context file)
+ (message "Importing %s...done" (file-name-nondirectory file))))
+
+(defvar package--post-download-archives-hook nil
+ "Hook run after the archive contents are downloaded.
+Don't run this hook directly. It is meant to be run as part of
+`package--update-downloads-in-progress'.")
+(put 'package--post-download-archives-hook 'risky-local-variable t)
+
+(defun package--update-downloads-in-progress (entry)
+ "Remove ENTRY from `package--downloads-in-progress'.
+Once it's empty, run `package--post-download-archives-hook'."
+ ;; Keep track of the downloading progress.
+ (setq package--downloads-in-progress
+ (remove entry package--downloads-in-progress))
+ ;; If this was the last download, run the hook.
+ (unless package--downloads-in-progress
+ (package-read-all-archive-contents)
+ (package--build-compatibility-table)
+ ;; We message before running the hook, so the hook can give
+ ;; messages as well.
+ (message "Package refresh done")
+ (run-hooks 'package--post-download-archives-hook)))
+
+(defun package--download-one-archive (archive file &optional async)
+ "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'. Save the cached copy to
+\"archives/NAME/FILE\" in `package-user-dir'."
+ (package--with-work-buffer-async (cdr archive) file async
+ (let* ((location (cdr archive))
+ (name (car archive))
+ (content (buffer-string))
+ (dir (expand-file-name (format "archives/%s" name) package-user-dir))
+ (local-file (expand-file-name file dir)))
+ (when (listp (read-from-string content))
+ (make-directory dir t)
+ (if (or (not package-check-signature)
+ (member archive package-unsigned-archives))
+ ;; If we don't care about the signature, save the file and
+ ;; we're done.
+ (progn (write-region content nil local-file nil 'silent)
+ (package--update-downloads-in-progress archive))
+ ;; If we care, check it (perhaps async) and *then* write the file.
+ (package--check-signature
+ location file content async
+ ;; This function will be called after signature checking.
+ (lambda (&optional good-sigs)
+ (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
+ ;; Even if the sig fails, this download is done, so
+ ;; remove it from the in-progress list.
+ (package--update-downloads-in-progress archive)
+ (error "Unsigned archive `%s'" name))
+ ;; Write out the archives file.
+ (write-region content nil local-file nil 'silent)
+ ;; Write out good signatures into archive-contents.signed file.
+ (when good-sigs
+ (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+ nil (concat local-file ".signed") nil 'silent))
+ (package--update-downloads-in-progress archive)
+ ;; If we got this far, either everything worked or we don't mind
+ ;; not signing, so tell `package--with-work-buffer-async' to not
+ ;; propagate errors.
+ nil)))))))
+
+(defun package--download-and-read-archives (&optional async)
+ "Download descriptions of all `package-archives' and read them.
+This populates `package-archive-contents'. If ASYNC is non-nil,
+perform the downloads asynchronously."
+ ;; The downloaded archive contents will be read as part of
+ ;; `package--update-downloads-in-progress'.
+ (dolist (archive package-archives)
+ (cl-pushnew archive package--downloads-in-progress
+ :test #'equal))
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive
+ archive "archive-contents"
+ ;; Called if the async download fails
+ (when async
+ ;; The t at the end means to propagate connection errors.
+ (lambda () (package--update-downloads-in-progress archive) t)))
+ (error (message "Failed to download `%s' archive."
+ (car archive))))))
+
+;;;###autoload
+(defun package-refresh-contents (&optional async)
+ "Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument ASYNC specifies whether to perform the
+downloads in the background."
+ (interactive)
+ (unless (file-exists-p package-user-dir)
+ (make-directory package-user-dir t))
+ (let ((default-keyring (expand-file-name "package-keyring.gpg"
+ data-directory))
+ (inhibit-message async))
+ (when (and package-check-signature (file-exists-p default-keyring))
+ (condition-case-unless-debug error
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package-import-keyring default-keyring))
+ (error (message "Cannot import default keyring: %S" (cdr error))))))
+ (package--download-and-read-archives async))
-(defun package-compute-transaction (packages requirements)
+
+;;; Dependency Management
+;; Calculating the full transaction necessary for an installation,
+;; keeping track of which packages were installed strictly as
+;; dependencies, and determining which packages cannot be removed
+;; because they are dependencies.
+(defun package-compute-transaction (packages requirements &optional seen)
"Return a list of packages to be installed, including PACKAGES.
PACKAGES should be a list of `package-desc'.
@@ -773,7 +1566,9 @@ version of that package.
This function recursively computes the requirements of the
packages in REQUIREMENTS, and returns a list of all the packages
that must be installed. Packages that are already installed are
-not included in this list."
+not included in this list.
+
+SEEN is used internally to detect infinite recursion."
;; FIXME: We really should use backtracking to explore the whole
;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1
;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0:
@@ -781,27 +1576,35 @@ not included in this list."
;; older bar-1.3).
(dolist (elt requirements)
(let* ((next-pkg (car elt))
- (next-version (cadr elt))
+ (next-version (cadr elt))
(already ()))
(dolist (pkg packages)
(if (eq next-pkg (package-desc-name pkg))
(setq already pkg)))
- (cond
- (already
- (if (version-list-< next-version (package-desc-version already))
- ;; Move to front, so it gets installed early enough (bug#14082).
- (setq packages (cons already (delq already packages)))
- (error "Need package `%s-%s', but only %s is available"
+ (when already
+ (if (version-list-<= next-version (package-desc-version already))
+ ;; `next-pkg' is already in `packages', but its position there
+ ;; means it might be installed too late: remove it from there, so
+ ;; we re-add it (along with its dependencies) at an earlier place
+ ;; below (bug#16994).
+ (if (memq already seen) ;Avoid inf-loop on dependency cycles.
+ (message "Dependency cycle going through %S"
+ (package-desc-full-name already))
+ (setq packages (delq already packages))
+ (setq already nil))
+ (error "Need package `%s-%s', but only %s is being installed"
next-pkg (package-version-join next-version)
(package-version-join (package-desc-version already)))))
-
+ (cond
+ (already nil)
((package-installed-p next-pkg next-version) nil)
(t
- ;; A package is required, but not installed. It might also be
- ;; blocked via `package-load-list'.
- (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
+ ;; A package is required, but not installed. It might also be
+ ;; blocked via `package-load-list'.
+ (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
(found nil)
+ (found-something nil)
(problem nil))
(while (and pkg-descs (not found))
(let* ((pkg-desc (pop pkg-descs))
@@ -809,124 +1612,228 @@ not included in this list."
(disabled (package-disabled-p next-pkg version)))
(cond
((version-list-< version next-version)
- (error
- "Need package `%s-%s', but only %s is available"
- next-pkg (package-version-join next-version)
- (package-version-join version)))
+ ;; pkg-descs is sorted by priority, not version, so
+ ;; don't error just yet.
+ (unless found-something
+ (setq found-something (package-version-join version))))
(disabled
(unless problem
(setq problem
(if (stringp disabled)
- (format "Package `%s' held at version %s, \
-but version %s required"
- next-pkg disabled
- (package-version-join next-version))
- (format "Required package '%s' is disabled"
- next-pkg)))))
+ (format-message
+ "Package `%s' held at version %s, but version %s required"
+ next-pkg disabled
+ (package-version-join next-version))
+ (format-message "Required package `%s' is disabled"
+ next-pkg)))))
(t (setq found pkg-desc)))))
- (unless found
- (if problem
- (error problem)
- (error "Package `%s-%s' is unavailable"
- next-pkg (package-version-join next-version))))
- (setq packages
- (package-compute-transaction (cons found packages)
- (package-desc-reqs found))))))))
+ (unless found
+ (cond
+ (problem (error "%s" problem))
+ (found-something
+ (error "Need package `%s-%s', but only %s is available"
+ next-pkg (package-version-join next-version)
+ found-something))
+ (t (error "Package `%s-%s' is unavailable"
+ next-pkg (package-version-join next-version)))))
+ (setq packages
+ (package-compute-transaction (cons found packages)
+ (package-desc-reqs found)
+ (cons found seen))))))))
packages)
-(defun package-read-from-string (str)
- "Read a Lisp expression from STR.
-Signal an error if the entire string was not used."
- (let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
- (if more-left
- (error "Can't read whole string")
- (car read-data))))
-
-(defun package--read-archive-file (file)
- "Re-read archive file FILE, if it exists.
-Will return the data from the file, or nil if the file does not exist.
-Will throw an error if the archive version is too new."
- (let ((filename (expand-file-name file package-user-dir)))
- (when (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents-literally filename)
- (let ((contents (read (current-buffer))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is higher than %d"
- (car contents) package-archive-version))
- (cdr contents))))))
+(defun package--find-non-dependencies ()
+ "Return a list of installed packages which are not dependencies.
+Finds all packages in `package-alist' which are not dependencies
+of any other packages.
+Used to populate `package-selected-packages'."
+ (let ((dep-list
+ (delete-dups
+ (apply #'append
+ (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p))))
+ package-alist)))))
+ (cl-loop for p in package-alist
+ for name = (car p)
+ unless (memq name dep-list)
+ collect name)))
+
+(defun package--save-selected-packages (&optional value)
+ "Set and save `package-selected-packages' to VALUE."
+ (when value
+ (setq package-selected-packages value))
+ (if after-init-time
+ (let ((save-silently inhibit-message))
+ (customize-save-variable 'package-selected-packages package-selected-packages))
+ (add-hook 'after-init-hook #'package--save-selected-packages)))
+
+(defun package--user-selected-p (pkg)
+ "Return non-nil if PKG is a package was installed by the user.
+PKG is a package name.
+This looks into `package-selected-packages', populating it first
+if it is still empty."
+ (unless (consp package-selected-packages)
+ (package--save-selected-packages (package--find-non-dependencies)))
+ (memq pkg package-selected-packages))
+
+(defun package--get-deps (pkg &optional only)
+ (let* ((pkg-desc (cadr (assq pkg package-alist)))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (assq name package-alist)
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps
+ append (package--get-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (delete-dups (append direct-deps indirect-deps))))))
+
+(defun package--removable-packages ()
+ "Return a list of names of packages no longer needed.
+These are packages which are neither contained in
+`package-selected-packages' nor a dependency of one that is."
+ (let ((needed (cl-loop for p in package-selected-packages
+ if (assq p package-alist)
+ ;; `p' and its dependencies are needed.
+ append (cons p (package--get-deps p)))))
+ (cl-loop for p in (mapcar #'car package-alist)
+ unless (memq p needed)
+ collect p)))
+
+(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all)
+ "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
+Return the first package found in PKG-LIST of which PKG is a
+dependency. If ALL is non-nil, return all such packages instead.
+
+When not specified, PKG-LIST defaults to `package-alist'
+with PKG-DESC entry removed."
+ (unless (string= (package-desc-status pkg-desc) "obsolete")
+ (let* ((pkg (package-desc-name pkg-desc))
+ (alist (or pkg-list
+ (remove (assq pkg package-alist)
+ package-alist))))
+ (if all
+ (cl-loop for p in alist
+ if (assq pkg (package-desc-reqs (cadr p)))
+ collect (cadr p))
+ (cl-loop for p in alist thereis
+ (and (assq pkg (package-desc-reqs (cadr p)))
+ (cadr p)))))))
+
+(defun package--sort-deps-in-alist (package only)
+ "Return a list of dependencies for PACKAGE sorted by dependency.
+PACKAGE is included as the first element of the returned list.
+ONLY is an alist associating package names to package objects.
+Only these packages will be in the return value an their cdrs are
+destructively set to nil in ONLY."
+ (let ((out))
+ (dolist (dep (package-desc-reqs package))
+ (when-let ((cell (assq (car dep) only))
+ (dep-package (cdr-safe cell)))
+ (setcdr cell nil)
+ (setq out (append (package--sort-deps-in-alist dep-package only)
+ out))))
+ (cons package out)))
+
+(defun package--sort-by-dependence (package-list)
+ "Return PACKAGE-LIST sorted by dependence.
+That is, any element of the returned list is guaranteed to not
+directly depend on any elements that come before it.
+
+PACKAGE-LIST is a list of package-desc objects.
+Indirect dependencies are guaranteed to be returned in order only
+if all the in-between dependencies are also in PACKAGE-LIST."
+ (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list))
+ out-list)
+ (dolist (cell alist out-list)
+ ;; `package--sort-deps-in-alist' destructively changes alist, so
+ ;; some cells might already be empty. We check this here.
+ (when-let ((pkg-desc (cdr cell)))
+ (setcdr cell nil)
+ (setq out-list
+ (append (package--sort-deps-in-alist pkg-desc alist)
+ out-list))))))
-(defun package-read-all-archive-contents ()
- "Re-read `archive-contents', if it exists.
-If successful, set `package-archive-contents'."
- (setq package-archive-contents nil)
- (dolist (archive package-archives)
- (package-read-archive-contents (car archive))))
+
+;;; Installation Functions
+;; As opposed to the previous section (which listed some underlying
+;; functions necessary for installation), this one contains the actual
+;; functions that install packages. The package itself can be
+;; installed in a variety of ways (archives, buffer, file), but
+;; requirements (dependencies) are always satisfied by looking in
+;; `package-archive-contents'.
+(defun package-archive-base (desc)
+ "Return the archive containing the package NAME."
+ (cdr (assoc (package-desc-archive desc) package-archives)))
-(defun package-read-archive-contents (archive)
- "Re-read archive contents for ARCHIVE.
-If successful, set the variable `package-archive-contents'.
-If the archive version is too new, signal an error."
- ;; Version 1 of 'archive-contents' is identical to our internal
- ;; representation.
- (let* ((contents-file (format "archives/%s/archive-contents" archive))
- (contents (package--read-archive-file contents-file)))
- (when contents
- (dolist (package contents)
- (package--add-to-archive-contents package archive)))))
+(defun package-install-from-archive (pkg-desc)
+ "Download and install a tar package."
+ ;; This won't happen, unless the archive is doing something wrong.
+ (when (eq (package-desc-kind pkg-desc) 'dir)
+ (error "Can't install directory package from archive"))
+ (let* ((location (package-archive-base pkg-desc))
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc))))
+ (package--with-work-buffer location file
+ (if (or (not package-check-signature)
+ (member (package-desc-archive pkg-desc)
+ package-unsigned-archives))
+ ;; If we don't care about the signature, unpack and we're
+ ;; done.
+ (let ((save-silently t))
+ (package-unpack pkg-desc))
+ ;; If we care, check it and *then* write the file.
+ (let ((content (buffer-string)))
+ (package--check-signature
+ location file content nil
+ ;; This function will be called after signature checking.
+ (lambda (&optional good-sigs)
+ (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
+ ;; Even if the sig fails, this download is done, so
+ ;; remove it from the in-progress list.
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))
+ ;; Signature checked, unpack now.
+ (with-temp-buffer (insert content)
+ (let ((save-silently t))
+ (package-unpack pkg-desc)))
+ ;; Here the package has been installed successfully, mark it as
+ ;; signed if appropriate.
+ (when good-sigs
+ ;; Write out good signatures into NAME-VERSION.signed file.
+ (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc) ".signed")
+ package-user-dir)
+ nil 'silent)
+ ;; Update the old pkg-desc which will be shown on the description buffer.
+ (setf (package-desc-signed pkg-desc) t)
+ ;; Update the new (activated) pkg-desc as well.
+ (when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))))
+ (setf (package-desc-signed (car pkg-descs)) t))))))))))
-;; Package descriptor objects used inside the "archive-contents" file.
-;; Changing this defstruct implies changing the format of the
-;; "archive-contents" files.
-(cl-defstruct (package--ac-desc
- (:constructor package-make-ac-desc (version reqs summary kind))
- (:copier nil)
- (:type vector))
- version reqs summary kind)
+(defun package-installed-p (package &optional min-version)
+ "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+If PACKAGE is a symbol, it is the package name and MIN-VERSION
+should be a version list.
-(defun package--add-to-archive-contents (package archive)
- "Add the PACKAGE from the given ARCHIVE if necessary.
-PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
-Also, add the originating archive to the `package-desc' structure."
- (let* ((name (car package))
- (version (package--ac-desc-version (cdr package)))
- (pkg-desc
- (package-desc-create
- :name name
- :version version
- :reqs (package--ac-desc-reqs (cdr package))
- :summary (package--ac-desc-summary (cdr package))
- :kind (package--ac-desc-kind (cdr package))
- :archive archive))
- (existing-packages (assq name package-archive-contents))
- (pinned-to-archive (assoc name package-pinned-packages)))
- (cond
- ;; Skip entirely if pinned to another archive or already installed.
- ((or (and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive)))
- (let ((bi (assq name package--builtin-versions)))
- (and bi (version-list-= version (cdr bi))))
- (let ((ins (cdr (assq name package-alist))))
- (and ins (version-list-= version
- (package-desc-version (car ins))))))
- nil)
- ((not existing-packages)
- (push (list name pkg-desc) package-archive-contents))
- (t
- (while
- (if (and (cdr existing-packages)
- (version-list-<
- version (package-desc-version (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))))))
+If PACKAGE is a package-desc object, MIN-VERSION is ignored."
+ (unless package--initialized (error "package.el is not yet initialized!"))
+ (if (package-desc-p package)
+ (let ((dir (package-desc-dir package)))
+ (and (stringp dir)
+ (file-exists-p dir)))
+ (or
+ (let ((pkg-descs (cdr (assq package package-alist))))
+ (and pkg-descs
+ (version-list-<= min-version
+ (package-desc-version (car pkg-descs)))))
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version))))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
@@ -936,11 +1843,67 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
+(defun package--ensure-init-file ()
+ "Ensure that the user's init file has `package-initialize'.
+`package-initialize' doesn't have to be called, as long as it is
+present somewhere in the file, even as a comment. If it is not,
+add a call to it along with some explanatory comments."
+ ;; Don't mess with the init-file from "emacs -Q".
+ (when (and (stringp user-init-file)
+ (not package--init-file-ensured)
+ (file-readable-p user-init-file)
+ (file-writable-p user-init-file))
+ (let* ((buffer (find-buffer-visiting user-init-file))
+ (contains-init
+ (if buffer
+ (with-current-buffer buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward "(package-initialize\\_>" nil 'noerror))))
+ ;; Don't visit the file if we don't have to.
+ (with-temp-buffer
+ (insert-file-contents user-init-file)
+ (goto-char (point-min))
+ (re-search-forward "(package-initialize\\_>" nil 'noerror)))))
+ (unless contains-init
+ (with-current-buffer (or buffer
+ (let ((delay-mode-hooks t))
+ (find-file-noselect user-init-file)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (and (looking-at-p "[[:blank:]]*\\(;\\|$\\)")
+ (not (eobp)))
+ (forward-line 1))
+ (insert
+ "\n"
+ ";; Added by Package.el. This must come before configurations of\n"
+ ";; installed packages. Don't delete this line. If you don't want it,\n"
+ ";; just comment it out by adding a semicolon to the start of the line.\n"
+ ";; You may delete these explanatory comments.\n"
+ "(package-initialize)\n")
+ (unless (looking-at-p "$")
+ (insert "\n"))
+ (let ((file-precious-flag t))
+ (save-buffer))
+ (unless buffer
+ (kill-buffer (current-buffer)))))))))
+ (setq package--init-file-ensured t))
+
;;;###autoload
-(defun package-install (pkg)
+(defun package-install (pkg &optional dont-select)
"Install the package PKG.
-PKG can be a package-desc or the package name of one the available packages
-in an archive in `package-archives'. Interactively, prompt for its name."
+PKG can be a package-desc or a symbol naming one of the available packages
+in an archive in `package-archives'. Interactively, prompt for its name.
+
+If called interactively or if DONT-SELECT nil, add PKG to
+`package-selected-packages'.
+
+If PKG is a package-desc and it is already installed, don't try
+to install it but still mark it as selected."
(interactive
(progn
;; Initialize the package system to get the list of package
@@ -951,15 +1914,28 @@ in an archive in `package-archives'. Interactively, prompt for its name."
(package-refresh-contents))
(list (intern (completing-read
"Install package: "
- (mapcar (lambda (elt) (symbol-name (car elt)))
- package-archive-contents)
- nil t)))))
- (package-download-transaction
- (if (package-desc-p pkg)
- (package-compute-transaction (list pkg)
- (package-desc-reqs pkg))
- (package-compute-transaction ()
- (list (list pkg))))))
+ (delq nil
+ (mapcar (lambda (elt)
+ (unless (package-installed-p (car elt))
+ (symbol-name (car elt))))
+ package-archive-contents))
+ nil t))
+ nil)))
+ (add-hook 'post-command-hook #'package-menu--post-refresh)
+ (let ((name (if (package-desc-p pkg)
+ (package-desc-name pkg)
+ pkg)))
+ (unless (or dont-select (package--user-selected-p name))
+ (package--save-selected-packages
+ (cons name package-selected-packages)))
+ (if-let ((transaction
+ (if (package-desc-p pkg)
+ (unless (package-installed-p pkg)
+ (package-compute-transaction (list pkg)
+ (package-desc-reqs pkg)))
+ (package-compute-transaction () (list (list pkg))))))
+ (package-download-transaction transaction)
+ (message "`%s' is already installed" name))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
@@ -968,163 +1944,199 @@ Otherwise return nil."
(when str
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
- (condition-case nil
- (if (version-to-list str)
- str)
- (error nil))))
-
-(defun package-buffer-info ()
- "Return a `package-desc' describing the package in the current buffer.
-
-If the buffer does not contain a conforming package, signal an
-error. If there is a package, narrow the buffer to the file's
-boundaries."
- (goto-char (point-min))
- (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
- (error "Packages lacks a file header"))
- (let ((file-name (match-string-no-properties 1))
- (desc (match-string-no-properties 2))
- (start (line-beginning-position)))
- (unless (search-forward (concat ";;; " file-name ".el ends here"))
- (error "Package lacks a terminating comment"))
- ;; Try to include a trailing newline.
- (forward-line)
- (narrow-to-region start (point))
- (require 'lisp-mnt)
- ;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
- ;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version")))))
- (unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
- (package-desc-from-define
- file-name pkg-version desc
- (if requires-str (package-read-from-string requires-str))
- :kind 'single))))
-
-(declare-function tar-get-file-descriptor "tar-mode" (file))
-(declare-function tar--extract "tar-mode" (descriptor))
-
-(defun package-tar-file-info ()
- "Find package information for a tar file.
-The return result is a `package-desc'."
- (cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (file-name-directory
- (tar-header-name (car tar-parse-info))))
- (desc-file (package--description-file dir-name))
- (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
- (unless tar-desc
- (error "No package descriptor file found"))
- (with-current-buffer (tar--extract tar-desc)
- (goto-char (point-min))
- (unwind-protect
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (if (not (eq (car pkg-def-parsed) 'define-package))
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc))
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (setf (package-desc-kind pkg-desc) 'tar)
- pkg-desc)
- (kill-buffer (current-buffer))))))
+ (ignore-errors
+ (if (version-to-list str) str))))
+(declare-function lm-homepage "lisp-mnt" (&optional file))
;;;###autoload
(defun package-install-from-buffer ()
"Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file that follows the
-packaging guidelines; see info node `(elisp)Packaging'.
+The current buffer is assumed to be a single .el or .tar file or
+a directory. These must follow the packaging guidelines (see
+info node `(elisp)Packaging').
+
+Specially, if current buffer is a directory, the -pkg.el
+description file is not mandatory, in which case the information
+is derived from the main .el file in the directory.
+
Downloads and installs required packages as needed."
(interactive)
- (let ((pkg-desc (if (derived-mode-p 'tar-mode)
- (package-tar-file-info)
- (package-buffer-info))))
+ (let* ((pkg-desc
+ (cond
+ ((derived-mode-p 'dired-mode)
+ ;; This is the only way a package-desc object with a `dir'
+ ;; desc-kind can be created. Such packages can't be
+ ;; uploaded or installed from archives, they can only be
+ ;; installed from local buffers or directories.
+ (package-dir-info))
+ ((derived-mode-p 'tar-mode)
+ (package-tar-file-info))
+ (t
+ (package-buffer-info))))
+ (name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
(transaction (package-compute-transaction nil requires)))
(package-download-transaction transaction))
;; Install the package itself.
(package-unpack pkg-desc)
+ (unless (package--user-selected-p name)
+ (package--save-selected-packages
+ (cons name package-selected-packages)))
pkg-desc))
;;;###autoload
(defun package-install-file (file)
"Install a package from a file.
-The file can either be a tar file or an Emacs Lisp file."
+The file can either be a tar file, an Emacs Lisp file, or a
+directory."
(interactive "fPackage file name: ")
(with-temp-buffer
- (insert-file-contents-literally file)
- (when (string-match "\\.tar\\'" file) (tar-mode))
+ (if (file-directory-p file)
+ (progn
+ (setq default-directory file)
+ (dired-mode))
+ (insert-file-contents-literally file)
+ (when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
-(defun package-delete (pkg-desc)
- (let ((dir (package-desc-dir pkg-desc)))
- (if (not (string-prefix-p (file-name-as-directory
- (expand-file-name package-user-dir))
- (expand-file-name dir)))
- ;; Don't delete "system" packages.
- (error "Package `%s' is a system package, not deleting"
- (package-desc-full-name pkg-desc))
- (delete-directory dir t t)
- ;; Update package-alist.
- (let* ((name (package-desc-name pkg-desc)))
- (delete pkg-desc (assq name package-alist)))
- (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
-
-(defun package-archive-base (desc)
- "Return the archive containing the package NAME."
- (cdr (assoc (package-desc-archive desc) package-archives)))
+;;;###autoload
+(defun package-install-selected-packages ()
+ "Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them."
+ (interactive)
+ ;; We don't need to populate `package-selected-packages' before
+ ;; using here, because the outcome is the same either way (nothing
+ ;; gets installed).
+ (if (not package-selected-packages)
+ (message "`package-selected-packages' is empty, nothing to install")
+ (cl-loop for p in package-selected-packages
+ unless (package-installed-p p)
+ collect p into lst
+ finally
+ (if lst
+ (when (y-or-n-p
+ (format "%s packages will be installed:\n%s, proceed?"
+ (length lst)
+ (mapconcat #'symbol-name lst ", ")))
+ (mapc #'package-install lst))
+ (message "All your packages are already installed")))))
-(defun package--download-one-archive (archive file)
- "Retrieve an archive file FILE from ARCHIVE, and cache it.
-ARCHIVE should be a cons cell of the form (NAME . LOCATION),
-similar to an entry in `package-alist'. Save the cached copy to
-\"archives/NAME/archive-contents\" in `package-user-dir'."
- (let* ((dir (expand-file-name (format "archives/%s" (car archive))
- package-user-dir)))
- (package--with-work-buffer (cdr archive) file
- ;; Read the retrieved buffer to make sure it is valid (e.g. it
- ;; may fetch a URL redirect page).
- (when (listp (read buffer))
- (make-directory dir t)
- (setq buffer-file-name (expand-file-name file dir))
- (let ((version-control 'never))
- (save-buffer))))))
+
+;;; Package Deletion
+(defun package--newest-p (pkg)
+ "Return t if PKG is the newest package with its name."
+ (equal (cadr (assq (package-desc-name pkg) package-alist))
+ pkg))
+
+(defun package-delete (pkg-desc &optional force nosave)
+ "Delete package PKG-DESC.
+
+Argument PKG-DESC is a full description of package as vector.
+Interactively, prompt the user for the package name and version.
+
+When package is used elsewhere as dependency of another package,
+refuse deleting it and return an error.
+If prefix argument FORCE is non-nil, package will be deleted even
+if it is used elsewhere.
+If NOSAVE is non-nil, the package is not removed from
+`package-selected-packages'."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (unless package--initialized
+ (package-initialize t))
+ (let* ((package-table
+ (mapcar
+ (lambda (p) (cons (package-desc-full-name p) p))
+ (delq nil
+ (mapcar (lambda (p) (unless (package-built-in-p p) p))
+ (apply #'append (mapcar #'cdr package-alist))))))
+ (package-name (completing-read "Delete package: "
+ (mapcar #'car package-table)
+ nil t)))
+ (list (cdr (assoc package-name package-table))
+ current-prefix-arg nil))))
+ (let ((dir (package-desc-dir pkg-desc))
+ (name (package-desc-name pkg-desc))
+ pkg-used-elsewhere-by)
+ ;; If the user is trying to delete this package, they definitely
+ ;; don't want it marked as selected, so we remove it from
+ ;; `package-selected-packages' even if it can't be deleted.
+ (when (and (null nosave)
+ (package--user-selected-p name)
+ ;; Don't deselect if this is an older version of an
+ ;; upgraded package.
+ (package--newest-p pkg-desc))
+ (package--save-selected-packages (remove name package-selected-packages)))
+ (cond ((not (string-prefix-p (file-name-as-directory
+ (expand-file-name package-user-dir))
+ (expand-file-name dir)))
+ ;; Don't delete "system" packages.
+ (error "Package `%s' is a system package, not deleting"
+ (package-desc-full-name pkg-desc)))
+ ((and (null force)
+ (setq pkg-used-elsewhere-by
+ (package--used-elsewhere-p pkg-desc)))
+ ;; Don't delete packages used as dependency elsewhere.
+ (error "Package `%s' is used by `%s' as dependency, not deleting"
+ (package-desc-full-name pkg-desc)
+ (package-desc-name pkg-used-elsewhere-by)))
+ (t
+ (add-hook 'post-command-hook #'package-menu--post-refresh)
+ (delete-directory dir t t)
+ ;; Remove NAME-VERSION.signed file.
+ (let ((signed-file (concat dir ".signed")))
+ (if (file-exists-p signed-file)
+ (delete-file signed-file)))
+ ;; Update package-alist.
+ (let ((pkgs (assq name package-alist)))
+ (delete pkg-desc pkgs)
+ (unless (cdr pkgs)
+ (setq package-alist (delq pkgs package-alist))))
+ (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
;;;###autoload
-(defun package-refresh-contents ()
- "Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download."
- (interactive)
- ;; FIXME: Do it asynchronously.
- (unless (file-exists-p package-user-dir)
- (make-directory package-user-dir t))
- (dolist (archive package-archives)
- (condition-case-unless-debug nil
- (package--download-one-archive archive "archive-contents")
- (error (message "Failed to download `%s' archive."
- (car archive)))))
- (package-read-all-archive-contents))
+(defun package-reinstall (pkg)
+ "Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object."
+ (interactive (list (intern (completing-read
+ "Reinstall package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist))))))
+ (package-delete
+ (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
+ 'force 'nosave)
+ (package-install pkg 'dont-select))
;;;###autoload
-(defun package-initialize (&optional no-activate)
- "Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+(defun package-autoremove ()
+ "Remove packages that are no more needed.
+
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted."
(interactive)
- (setq package-alist nil)
- (package-load-all-descriptors)
- (package-read-all-archive-contents)
- (unless no-activate
- (dolist (elt package-alist)
- (package-activate (car elt))))
- (setq package--initialized t))
+ ;; If `package-selected-packages' is nil, it would make no sense to
+ ;; try to populate it here, because then `package-autoremove' will
+ ;; do absolutely nothing.
+ (when (or package-selected-packages
+ (yes-or-no-p
+ (format-message
+ "`package-selected-packages' is empty! Really remove ALL packages? ")))
+ (let ((removable (package--removable-packages)))
+ (if removable
+ (when (y-or-n-p
+ (format "%s packages will be deleted:\n%s, proceed? "
+ (length removable)
+ (mapconcat #'symbol-name removable ", ")))
+ (mapc (lambda (p)
+ (package-delete (cadr (assq p package-alist)) t))
+ removable))
+ (message "Nothing to autoremove")))))
;;;; Package description buffer.
@@ -1133,7 +2145,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(defun describe-package (package)
"Display the full documentation of PACKAGE (a symbol)."
(interactive
- (let* ((guess (function-called-at-point)))
+ (let* ((guess (or (function-called-at-point)
+ (symbol-at-point))))
(require 'finder-inf nil t)
;; Load the package list if necessary (but don't activate them).
(unless package--initialized
@@ -1149,15 +2162,34 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(format "Describe package (default %s): "
guess)
"Describe package: ")
- packages nil t nil nil guess)))
+ packages nil t nil nil (when guess
+ (symbol-name guess)))))
(list (intern val))))))
(if (not (or (package-desc-p package) (and package (symbolp package))))
(message "No package specified")
(help-setup-xref (list #'describe-package package)
- (called-interactively-p 'interactive))
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (describe-package-1 package)))))
+ (describe-package-1 package)))))
+
+(defface package-help-section-name
+ '((t :inherit (bold font-lock-function-name-face)))
+ "Face used on section names in package description buffers."
+ :version "25.1")
+
+(defun package--print-help-section (name &rest strings)
+ "Print \"NAME: \", right aligned to the 13th column.
+If more STRINGS are provided, insert them followed by a newline.
+Otherwise no newline is inserted."
+ (declare (indent 1))
+ (insert (make-string (max 0 (- 11 (string-width name))) ?\s)
+ (propertize (concat name ": ") 'font-lock-face 'package-help-section-name))
+ (when strings
+ (apply #'insert strings)
+ (insert "\n")))
+
+(declare-function lm-commentary "lisp-mnt" (&optional file))
(defun describe-package-1 (pkg)
(require 'lisp-mnt)
@@ -1171,151 +2203,231 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(name (if desc (package-desc-name desc) pkg))
(pkg-dir (if desc (package-desc-dir desc)))
(reqs (if desc (package-desc-reqs desc)))
+ (required-by (if desc (package--used-elsewhere-p desc nil 'all)))
(version (if desc (package-desc-version desc)))
(archive (if desc (package-desc-archive desc)))
+ (extras (and desc (package-desc-extras desc)))
+ (homepage (cdr (assoc :url extras)))
+ (keywords (if desc (package-desc--keywords desc)))
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
- (status (if desc (package-desc-status desc) "orphan")))
+ (status (if desc (package-desc-status desc) "orphan"))
+ (incompatible-reason (package--incompatible-p desc))
+ (signed (if desc (package-desc-signed desc))))
+ (when (string= status "avail-obso")
+ (setq status "available obsolete"))
+ (when incompatible-reason
+ (setq status "incompatible"))
(prin1 name)
(princ " is ")
(princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
(princ status)
(princ " package.\n\n")
- (insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
+ (package--print-help-section "Status")
(cond (built-in
- (insert (propertize (capitalize status)
- 'font-lock-face 'font-lock-builtin-face)
+ (insert (propertize (capitalize status)
+ 'font-lock-face 'package-status-builtin-face)
"."))
- (pkg-dir
- (insert (propertize (capitalize status) ;FIXME: Why comment-face?
- 'font-lock-face 'font-lock-comment-face))
- (insert " in `")
- ;; Todo: Add button for uninstalling.
- (help-insert-xref-button (abbreviate-file-name
- (file-name-as-directory pkg-dir))
- 'help-package-def pkg-dir)
- (if (and (package-built-in-p name)
+ (pkg-dir
+ (insert (propertize (if (member status '("unsigned" "dependency"))
+ "Installed"
+ (capitalize status))
+ 'font-lock-face 'package-status-builtin-face))
+ (insert (substitute-command-keys " in `"))
+ (let ((dir (abbreviate-file-name
+ (file-name-as-directory
+ (if (file-in-directory-p pkg-dir package-user-dir)
+ (file-relative-name pkg-dir package-user-dir)
+ pkg-dir)))))
+ (help-insert-xref-button dir 'help-package-def pkg-dir))
+ (if (and (package-built-in-p name)
(not (package-built-in-p name version)))
- (insert "',\n shadowing a "
- (propertize "built-in package"
- 'font-lock-face 'font-lock-builtin-face)
- ".")
- (insert "'.")))
- (installable
+ (insert (substitute-command-keys
+ "',\n shadowing a ")
+ (propertize "built-in package"
+ 'font-lock-face 'package-status-builtin-face))
+ (insert (substitute-command-keys "'")))
+ (if signed
+ (insert ".")
+ (insert " (unsigned)."))
+ (when (and (package-desc-p desc)
+ (not required-by)
+ (member status '("unsigned" "installed")))
+ (insert " ")
+ (package-make-button "Delete"
+ 'action #'package-delete-button-action
+ 'package-desc desc)))
+ (incompatible-reason
+ (insert (propertize "Incompatible" 'font-lock-face font-lock-warning-face)
+ " because it depends on ")
+ (if (stringp incompatible-reason)
+ (insert "Emacs " incompatible-reason ".")
+ (insert "uninstallable packages.")))
+ (installable
(insert (capitalize status))
- (insert " from " (format "%s" archive))
- (insert " -- ")
- (let ((button-text (if (display-graphic-p) "Install" "[Install]"))
- (button-face (if (display-graphic-p)
- '(:box (:line-width 2 :color "dark grey")
- :background "light grey"
- :foreground "black")
- 'link)))
- (insert-text-button button-text 'face button-face 'follow-link t
- 'package-desc desc
- 'action 'package-install-button-action)))
- (t (insert (capitalize status) ".")))
+ (insert " from " (format "%s" archive))
+ (insert " -- ")
+ (package-make-button
+ "Install"
+ 'action 'package-install-button-action
+ 'package-desc desc))
+ (t (insert (capitalize status) ".")))
(insert "\n")
+ (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive.
+ (package--print-help-section "Archive"
+ (or archive "n/a") "\n"))
(and version
- (insert " "
- (propertize "Version" 'font-lock-face 'bold) ": "
- (package-version-join version) "\n"))
+ (package--print-help-section "Version"
+ (package-version-join version)))
+ (when desc
+ (package--print-help-section "Summary"
+ (package-desc-summary desc)))
(setq reqs (if desc (package-desc-reqs desc)))
(when reqs
- (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
- (let ((first t)
- name vers text)
- (dolist (req reqs)
- (setq name (car req)
- vers (cadr req)
- text (format "%s-%s" (symbol-name name)
- (package-version-join vers)))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package name))
- (insert "\n")))
- (insert " " (propertize "Summary" 'font-lock-face 'bold)
- ": " (if desc (package-desc-summary desc)) "\n")
-
+ (package--print-help-section "Requires")
+ (let ((first t))
+ (dolist (req reqs)
+ (let* ((name (car req))
+ (vers (cadr req))
+ (text (format "%s-%s" (symbol-name name)
+ (package-version-join vers)))
+ (reason (if (and (listp incompatible-reason)
+ (assq name incompatible-reason))
+ " (not available)" "")))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text) (length reason))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package name)
+ (insert reason)))
+ (insert "\n")))
+ (when required-by
+ (package--print-help-section "Required by")
+ (let ((first t))
+ (dolist (pkg required-by)
+ (let ((text (package-desc-full-name pkg)))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package
+ (package-desc-name pkg))))
+ (insert "\n")))
+ (when homepage
+ (package--print-help-section "Homepage")
+ (help-insert-xref-button homepage 'help-url homepage)
+ (insert "\n"))
+ (when keywords
+ (package--print-help-section "Keywords")
+ (dolist (k keywords)
+ (package-make-button
+ k
+ 'package-keyword k
+ 'action 'package-keyword-button-action)
+ (insert " "))
+ (insert "\n"))
(let* ((all-pkgs (append (cdr (assq name package-alist))
(cdr (assq name package-archive-contents))
(let ((bi (assq name package--builtins)))
(if bi (list (package--from-builtin bi))))))
(other-pkgs (delete desc all-pkgs)))
(when other-pkgs
- (insert " " (propertize "Other versions" 'font-lock-face 'bold) ": "
- (mapconcat
- (lambda (opkg)
- (let* ((ov (package-desc-version opkg))
- (dir (package-desc-dir opkg))
- (from (or (package-desc-archive opkg)
- (if (stringp dir) "installed" dir))))
- (if (not ov) (format "%s" from)
- (format "%s (%s)"
- (make-text-button (package-version-join ov) nil
- 'face 'link
- 'follow-link t
- 'action
- (lambda (_button)
- (describe-package opkg)))
- from))))
- other-pkgs ", ")
- ".\n")))
+ (package--print-help-section "Other versions"
+ (mapconcat (lambda (opkg)
+ (let* ((ov (package-desc-version opkg))
+ (dir (package-desc-dir opkg))
+ (from (or (package-desc-archive opkg)
+ (if (stringp dir) "installed" dir))))
+ (if (not ov) (format "%s" from)
+ (format "%s (%s)"
+ (make-text-button (package-version-join ov) nil
+ 'font-lock-face 'link
+ 'follow-link t
+ 'action
+ (lambda (_button)
+ (describe-package opkg)))
+ from))))
+ other-pkgs ", ")
+ ".")))
(insert "\n")
(if built-in
- ;; For built-in packages, insert the commentary.
- (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 ""))))
+ ;; For built-in packages, insert the commentary.
+ (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 ""))))
(let ((readme (expand-file-name (format "%s-readme.txt" name)
- package-user-dir))
- readme-string)
- ;; For elpa packages, try downloading the commentary. If that
- ;; fails, try an existing readme file in `package-user-dir'.
- (cond ((condition-case nil
- (package--with-work-buffer
- (package-archive-base desc)
- (format "%s-readme.txt" name)
- (setq buffer-file-name
- (expand-file-name readme package-user-dir))
- (let ((version-control 'never))
- (save-buffer))
- (setq readme-string (buffer-string))
- t)
- (error nil))
- (insert readme-string))
- ((file-readable-p readme)
- (insert-file-contents readme)
- (goto-char (point-max))))))))
+ package-user-dir))
+ readme-string)
+ ;; For elpa packages, try downloading the commentary. If that
+ ;; fails, try an existing readme file in `package-user-dir'.
+ (cond ((condition-case nil
+ (save-excursion
+ (package--with-work-buffer
+ (package-archive-base desc)
+ (format "%s-readme.txt" name)
+ (save-excursion
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert ?\n)))
+ (write-region nil nil
+ (expand-file-name readme package-user-dir)
+ nil 'silent)
+ (setq readme-string (buffer-string))
+ t))
+ (error nil))
+ (insert readme-string))
+ ((file-readable-p readme)
+ (insert-file-contents readme)
+ (goto-char (point-max))))))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
- (when (y-or-n-p (format "Install package `%s'? "
- (package-desc-full-name pkg-desc)))
- (package-install pkg-desc)
+ (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)))))
+
+(defun package-delete-button-action (button)
+ (let ((pkg-desc (button-get button 'package-desc)))
+ (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)))))
+(defun package-keyword-button-action (button)
+ (let ((pkg-keyword (button-get button 'package-keyword)))
+ (package-show-package-list t (list pkg-keyword))))
+
+(defun package-make-button (text &rest props)
+ (let ((button-text (if (display-graphic-p) text (concat "[" text "]")))
+ (button-face (if (display-graphic-p)
+ '(:box (:line-width 2 :color "dark grey")
+ :background "light grey"
+ :foreground "black")
+ 'link)))
+ (apply 'insert-text-button button-text 'face button-face 'follow-link t
+ props)))
+
;;;; Package menu mode.
(defvar package-menu-mode-map
- (let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Package")))
+ (let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "\C-m" 'package-menu-describe-package)
(define-key map "u" 'package-menu-mark-unmark)
@@ -1324,73 +2436,69 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(define-key map "i" 'package-menu-mark-install)
(define-key map "U" 'package-menu-mark-upgrades)
(define-key map "r" 'package-menu-refresh)
+ (define-key map "f" 'package-menu-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 [menu-bar package-menu] (cons "Package" menu-map))
- (define-key menu-map [mq]
- '(menu-item "Quit" quit-window
- :help "Quit package selection"))
- (define-key menu-map [s1] '("--"))
- (define-key menu-map [mn]
- '(menu-item "Next" next-line
- :help "Next Line"))
- (define-key menu-map [mp]
- '(menu-item "Previous" previous-line
- :help "Previous Line"))
- (define-key menu-map [s2] '("--"))
- (define-key menu-map [mu]
- '(menu-item "Unmark" package-menu-mark-unmark
- :help "Clear any marks on a package and move to the next line"))
- (define-key menu-map [munm]
- '(menu-item "Unmark Backwards" package-menu-backup-unmark
- :help "Back up one line and clear any marks on that package"))
- (define-key menu-map [md]
- '(menu-item "Mark for Deletion" package-menu-mark-delete
- :help "Mark a package for deletion and move to the next line"))
- (define-key menu-map [mi]
- '(menu-item "Mark for Install" package-menu-mark-install
- :help "Mark a package for installation and move to the next line"))
- (define-key menu-map [mupgrades]
- '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
- :help "Mark packages that have a newer version for upgrading"))
- (define-key menu-map [s3] '("--"))
- (define-key menu-map [mg]
- '(menu-item "Update Package List" revert-buffer
- :help "Update the list of packages"))
- (define-key menu-map [mr]
- '(menu-item "Refresh Package List" package-menu-refresh
- :help "Download the ELPA archive"))
- (define-key menu-map [s4] '("--"))
- (define-key menu-map [mt]
- '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
- :help "Mark all obsolete packages for deletion"))
- (define-key menu-map [mx]
- '(menu-item "Execute Actions" package-menu-execute
- :help "Perform all the marked actions"))
- (define-key menu-map [s5] '("--"))
- (define-key menu-map [mh]
- '(menu-item "Help" package-menu-quick-help
- :help "Show short key binding help for package-menu-mode"))
- (define-key menu-map [mc]
- '(menu-item "View Commentary" package-menu-view-commentary
- :help "Display information about this package"))
+ (define-key map "(" #'package-menu-toggle-hiding)
map)
"Local keymap for `package-menu-mode' buffers.")
+(easy-menu-define package-menu-mode-menu package-menu-mode-map
+ "Menu for `package-menu-mode'."
+ `("Package"
+ ["Describe Package" package-menu-describe-package :help "Display information about this package"]
+ ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"]
+ "--"
+ ["Refresh Package List" package-menu-refresh
+ :help "Redownload the ELPA archive"
+ :active (not package--downloads-in-progress)]
+ ["Redisplay buffer" revert-buffer :help "Update the buffer with current list of packages"]
+ ["Execute Marked Actions" package-menu-execute :help "Perform all the marked actions"]
+
+ "--"
+ ["Mark All Available Upgrades" package-menu-mark-upgrades
+ :help "Mark packages that have a newer version for upgrading"
+ :active (not package--downloads-in-progress)]
+ ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"]
+ ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"]
+ ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"]
+ ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"]
+
+ "--"
+ ["Filter Package List" package-menu-filter :help "Filter package selection (q to go back)"]
+ ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"]
+ ["Display Older Versions" package-menu-toggle-hiding
+ :style toggle :selected (not package-menu--hide-packages)
+ :help "Display package even if a newer version is already installed"]
+
+ "--"
+ ["Quit" quit-window :help "Quit package selection"]
+ ["Customize" (customize-group 'package)]))
+
(defvar package-menu--new-package-list nil
"List of newly-available packages since `list-packages' was last called.")
+(defvar package-menu--transaction-status nil
+ "Mode-line status of ongoing package transaction.")
+
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
- (setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
- ("Version" 12 nil)
- ("Status" 10 package-menu--status-predicate)
- ("Description" 0 nil)])
+ (setq mode-line-process '((package--downloads-in-progress ":Loading")
+ (package-menu--transaction-status
+ package-menu--transaction-status)))
+ (setq tabulated-list-format
+ `[("Package" 18 package-menu--name-predicate)
+ ("Version" 13 nil)
+ ("Status" 10 package-menu--status-predicate)
+ ,@(if (cdr package-archives)
+ '(("Archive" 10 package-menu--archive-predicate)))
+ ("Description" 0 nil)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
(add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t)
@@ -1407,12 +2515,47 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
(defvar package-list-unversioned nil
"If non-nil include packages that don't have a version in `list-package'.")
+(defvar package-list-unsigned nil
+ "If non-nil, mention in the list which packages were installed w/o signature.")
+
+(defvar package--emacs-version-list (version-to-list emacs-version)
+ "`emacs-version', as a list.")
+
+(defun package--incompatible-p (pkg &optional shallow)
+ "Return non-nil if PKG has no chance of being installable.
+PKG is a package-desc object.
+
+If SHALLOW is non-nil, this only checks if PKG depends on a
+higher `emacs-version' than the one being used. Otherwise, also
+checks the viability of dependencies, according to
+`package--compatibility-table'.
+
+If PKG requires an incompatible Emacs version, the return value
+is this version (as a string).
+If PKG requires incompatible packages, the return value is a list
+of these dependencies, similar to the list returned by
+`package-desc-reqs'."
+ (let* ((reqs (package-desc-reqs pkg))
+ (version (cadr (assq 'emacs reqs))))
+ (if (and version (version-list-< package--emacs-version-list version))
+ (package-version-join version)
+ (unless shallow
+ (let (out)
+ (dolist (dep (package-desc-reqs pkg) out)
+ (let ((dep-name (car dep)))
+ (unless (eq 'emacs dep-name)
+ (let ((cv (gethash dep-name package--compatibility-table)))
+ (when (version-list-< (or cv '(0)) (or (cadr dep) '(0)))
+ (push dep out)))))))))))
+
(defun package-desc-status (pkg-desc)
(let* ((name (package-desc-name pkg-desc))
(dir (package-desc-dir pkg-desc))
(lle (assq name package-load-list))
(held (cadr lle))
- (version (package-desc-version pkg-desc)))
+ (version (package-desc-version pkg-desc))
+ (signed (or (not package-list-unsigned)
+ (package-desc-signed pkg-desc))))
(cond
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
@@ -1422,34 +2565,166 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC."
((version-list-= version hv) "held")
((version-list-< version hv) "obsolete")
(t "disabled"))))
- ((package-built-in-p name version) "obsolete")
(dir ;One of the installed packages.
(cond
- ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
- ((eq pkg-desc (cadr (assq name package-alist))) "installed")
+ ((not (file-exists-p dir)) "deleted")
+ ;; Not inside `package-user-dir'.
+ ((not (file-in-directory-p dir package-user-dir)) "external")
+ ((eq pkg-desc (cadr (assq name package-alist)))
+ (if (not signed) "unsigned"
+ (if (package--user-selected-p name)
+ "installed" "dependency")))
(t "obsolete")))
+ ((package--incompatible-p pkg-desc) "incompat")
(t
(let* ((ins (cadr (assq name package-alist)))
(ins-v (if ins (package-desc-version ins))))
(cond
- ((or (null ins) (version-list-< ins-v version))
+ ;; Installed obsolete packages are handled in the `dir'
+ ;; clause above. Here we handle available obsolete, which
+ ;; are displayed depending on `package-menu--hide-packages'.
+ ((and ins (version-list-<= version ins-v)) "avail-obso")
+ (t
(if (memq name package-menu--new-package-list)
- "new" "available"))
- ((version-list-< version ins-v) "obsolete")
- ((version-list-= version ins-v) "installed")))))))
+ "new" "available"))))))))
-(defun package-menu--refresh (&optional packages)
+(defvar package-menu--hide-packages t
+ "Whether available obsolete packages should be hidden.
+Can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding].
+Installed obsolete packages are always displayed.")
+
+(defun package-menu-toggle-hiding ()
+ "Toggle visibility of obsolete available packages."
+ (interactive)
+ (unless (derived-mode-p 'package-menu-mode)
+ (user-error "The current buffer is not a Package Menu"))
+ (setq package-menu--hide-packages
+ (not package-menu--hide-packages))
+ (message "%s packages" (if package-menu--hide-packages
+ "Hiding obsolete or unwanted"
+ "Displaying all"))
+ (revert-buffer nil 'no-confirm))
+
+(defun package--remove-hidden (pkg-list)
+ "Filter PKG-LIST according to `package-archive-priorities'.
+PKG-LIST must be a list of package-desc objects, all with the
+same name, sorted by decreasing `package-desc-priority-version'.
+Return a list of packages tied for the highest priority according
+to their archives."
+ (when pkg-list
+ ;; Variable toggled with `package-menu-toggle-hiding'.
+ (if (not package-menu--hide-packages)
+ pkg-list
+ (let ((installed (cadr (assq (package-desc-name (car pkg-list))
+ package-alist))))
+ (when installed
+ (setq pkg-list
+ (let ((ins-version (package-desc-version installed)))
+ (cl-remove-if (lambda (p) (version-list-< (package-desc-version p)
+ ins-version))
+ pkg-list))))
+ (let ((filtered-by-priority
+ (cond
+ ((not package-menu-hide-low-priority)
+ pkg-list)
+ ((eq package-menu-hide-low-priority 'archive)
+ (let* ((max-priority most-negative-fixnum)
+ (out))
+ (while pkg-list
+ (let ((p (pop pkg-list)))
+ (let ((priority (package-desc-priority p)))
+ (if (< priority max-priority)
+ (setq pkg-list nil)
+ (push p out)
+ (setq max-priority priority)))))
+ (nreverse out)))
+ (pkg-list
+ (list (car pkg-list))))))
+ (if (not installed)
+ filtered-by-priority
+ (let ((ins-version (package-desc-version installed)))
+ (cl-remove-if (lambda (p) (version-list-= (package-desc-version p)
+ ins-version))
+ filtered-by-priority))))))))
+
+(defcustom package-hidden-regexps nil
+ "List of regexps matching the name of packages to hide.
+If the name of a package matches any of these regexps it is
+omitted from the package menu. To toggle this, type \\[package-menu-toggle-hiding].
+
+Values can be interactively added to this list by typing
+\\[package-menu-hide-package] on a package"
+ :type '(repeat (regexp :tag "Hide packages with name matching")))
+
+(defun package-menu--refresh (&optional packages keywords)
"Re-populate the `tabulated-list-entries'.
-PACKAGES should be nil or t, which means to display all known packages."
+PACKAGES should be nil or t, which means to display all known packages.
+KEYWORDS should be nil or a list of keywords."
;; Construct list of (PKG-DESC . STATUS).
(unless packages (setq packages t))
- (let (info-list name)
+ (let ((hidden-names (mapconcat #'identity package-hidden-regexps "\\|"))
+ info-list)
+ ;; Installed packages:
+ (dolist (elt package-alist)
+ (let ((name (car elt)))
+ (when (or (eq packages t) (memq name packages))
+ (dolist (pkg (cdr elt))
+ (when (package--has-keyword-p pkg keywords)
+ (push pkg info-list))))))
+
+ ;; Built-in packages:
+ (dolist (elt package--builtins)
+ (let ((pkg (package--from-builtin elt))
+ (name (car elt)))
+ (when (not (eq name 'emacs)) ; Hide the `emacs' package.
+ (when (and (package--has-keyword-p pkg keywords)
+ (or package-list-unversioned
+ (package--bi-desc-version (cdr elt)))
+ (or (eq packages t) (memq name packages)))
+ (push pkg info-list)))))
+
+ ;; Available and disabled packages:
+ (unless (equal package--old-archive-priorities package-archive-priorities)
+ (package-read-all-archive-contents))
+ (dolist (elt package-archive-contents)
+ (let ((name (car elt)))
+ ;; To be displayed it must be in PACKAGES;
+ (when (and (or (eq packages t) (memq name packages))
+ ;; and we must either not be hiding anything,
+ (or (not package-menu--hide-packages)
+ (not package-hidden-regexps)
+ ;; or just not hiding this specific package.
+ (not (string-match hidden-names (symbol-name name)))))
+ ;; Hide available-obsolete or low-priority packages.
+ (dolist (pkg (package--remove-hidden (cdr elt)))
+ (when (package--has-keyword-p pkg keywords)
+ (push pkg info-list))))))
+
+ ;; Print the result.
+ (setq tabulated-list-entries
+ (mapcar #'package-menu--print-info-simple info-list))))
+
+(defun package-all-keywords ()
+ "Collect all package keywords"
+ (let ((key-list))
+ (package--mapc (lambda (desc)
+ (setq key-list (append (package-desc--keywords desc)
+ key-list))))
+ key-list))
+
+(defun package--mapc (function &optional packages)
+ "Call FUNCTION for all known PACKAGES.
+PACKAGES can be nil or t, which means to display all known
+packages, or a list of packages.
+
+Built-in packages are converted with `package--from-builtin'."
+ (unless packages (setq packages t))
+ (let (name)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
- (dolist (pkg (cdr elt))
- (package--push pkg (package-desc-status pkg) info-list))))
+ (mapc function (cdr elt))))
;; Built-in packages:
(dolist (elt package--builtins)
@@ -1457,8 +2732,8 @@ PACKAGES should be nil or t, which means to display all known packages."
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (package--push (package--from-builtin elt) "built-in" info-list)))
+ (or (eq packages t) (memq name packages)))
+ (funcall function (package--from-builtin elt))))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
@@ -1468,46 +2743,157 @@ PACKAGES should be nil or t, which means to display all known packages."
;; Hide obsolete packages.
(unless (package-installed-p (package-desc-name pkg)
(package-desc-version pkg))
- (package--push pkg (package-desc-status pkg) info-list)))))
-
- ;; Print the result.
- (setq tabulated-list-entries
- (mapcar #'package-menu--print-info info-list))))
+ (funcall function pkg)))))))
+
+(defun package--has-keyword-p (desc &optional keywords)
+ "Test if package DESC has any of the given KEYWORDS.
+When none are given, the package matches."
+ (if keywords
+ (let ((desc-keywords (and desc (package-desc--keywords desc)))
+ found)
+ (while (and (not found) keywords)
+ (let ((k (pop keywords)))
+ (setq found
+ (or (string= k (concat "arc:" (package-desc-archive desc)))
+ (string= k (concat "status:" (package-desc-status desc)))
+ (member k desc-keywords)))))
+ found)
+ t))
-(defun package-menu--generate (remember-pos packages)
+(defun package-menu--generate (remember-pos packages &optional keywords)
"Populate 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."
- (package-menu--refresh packages)
+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"))
+ (if keywords
+ (define-key package-menu-mode-map "q" 'package-show-package-list)
+ (define-key package-menu-mode-map "q" 'quit-window))
+ (tabulated-list-init-header)
(tabulated-list-print remember-pos))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
PKG has the form (PKG-DESC . STATUS).
Return (PKG-DESC [NAME VERSION STATUS DOC])."
- (let* ((pkg-desc (car pkg))
- (status (cdr pkg))
- (face (pcase status
- (`"built-in" 'font-lock-builtin-face)
- (`"available" 'default)
- (`"new" 'bold)
- (`"held" 'font-lock-constant-face)
- (`"disabled" 'font-lock-warning-face)
- (`"installed" 'font-lock-comment-face)
- (_ 'font-lock-warning-face)))) ; obsolete.
- (list pkg-desc
- (vector (list (symbol-name (package-desc-name pkg-desc))
- 'face 'link
- 'follow-link t
- 'package-desc pkg-desc
- 'action 'package-menu-describe-package)
- (propertize (package-version-join
- (package-desc-version pkg-desc))
- 'font-lock-face face)
- (propertize status 'font-lock-face face)
- (propertize (package-desc-summary pkg-desc)
- 'font-lock-face face)))))
+ (package-menu--print-info-simple (car pkg)))
+(make-obsolete 'package-menu--print-info
+ 'package-menu--print-info-simple "25.1")
+
+
+;;; Package menu faces
+(defface package-name
+ '((t :inherit link))
+ "Face used on package names in the package menu."
+ :version "25.1")
+
+(defface package-description
+ '((t :inherit default))
+ "Face used on package description summaries in the package menu."
+ :version "25.1")
+
+(defface package-status-built-in
+ '((t :inherit font-lock-builtin-face))
+ "Face used on the status and version of built-in packages."
+ :version "25.1")
+
+(defface package-status-external
+ '((t :inherit package-status-builtin-face))
+ "Face used on the status and version of external packages."
+ :version "25.1")
+
+(defface package-status-available
+ '((t :inherit default))
+ "Face used on the status and version of available packages."
+ :version "25.1")
+
+(defface package-status-new
+ '((t :inherit (bold package-status-available)))
+ "Face used on the status and version of new packages."
+ :version "25.1")
+
+(defface package-status-held
+ '((t :inherit font-lock-constant-face))
+ "Face used on the status and version of held packages."
+ :version "25.1")
+
+(defface package-status-disabled
+ '((t :inherit font-lock-warning-face))
+ "Face used on the status and version of disabled packages."
+ :version "25.1")
+
+(defface package-status-installed
+ '((t :inherit font-lock-comment-face))
+ "Face used on the status and version of installed packages."
+ :version "25.1")
+
+(defface package-status-dependency
+ '((t :inherit package-status-installed))
+ "Face used on the status and version of dependency packages."
+ :version "25.1")
+
+(defface package-status-unsigned
+ '((t :inherit font-lock-warning-face))
+ "Face used on the status and version of unsigned packages."
+ :version "25.1")
+
+(defface package-status-incompat
+ '((t :inherit font-lock-comment-face))
+ "Face used on the status and version of incompat packages."
+ :version "25.1")
+
+(defface package-status-avail-obso
+ '((t :inherit package-status-incompat))
+ "Face used on the status and version of avail-obso packages."
+ :version "25.1")
+
+
+;;; Package menu printing
+(defun package-menu--print-info-simple (pkg)
+ "Return a package entry suitable for `tabulated-list-entries'.
+PKG is a package-desc object.
+Return (PKG-DESC [NAME VERSION STATUS DOC])."
+ (let* ((status (package-desc-status pkg))
+ (face (pcase status
+ (`"built-in" 'package-status-built-in)
+ (`"external" 'package-status-external)
+ (`"available" 'package-status-available)
+ (`"avail-obso" 'package-status-avail-obso)
+ (`"new" 'package-status-new)
+ (`"held" 'package-status-held)
+ (`"disabled" 'package-status-disabled)
+ (`"installed" 'package-status-installed)
+ (`"dependency" 'package-status-dependency)
+ (`"unsigned" 'package-status-unsigned)
+ (`"incompat" 'package-status-incompat)
+ (_ 'font-lock-warning-face)))) ; obsolete.
+ (list pkg
+ `[(,(symbol-name (package-desc-name pkg))
+ face package-name
+ font-lock-face package-name
+ follow-link t
+ package-desc ,pkg
+ action package-menu-describe-package)
+ ,(propertize (package-version-join
+ (package-desc-version pkg))
+ 'font-lock-face face)
+ ,(propertize status 'font-lock-face face)
+ ,@(if (cdr package-archives)
+ (list (propertize (or (package-desc-archive pkg) "")
+ 'font-lock-face face)))
+ ,(propertize (package-desc-summary pkg)
+ 'font-lock-face 'package-description)])))
+
+(defvar package-menu--old-archive-contents nil
+ "`package-archive-contents' before the latest refresh.")
(defun package-menu-refresh ()
"Download the Emacs Lisp package archive.
@@ -1515,32 +2901,57 @@ This fetches the contents of each archive specified in
`package-archives', and then refreshes the package menu."
(interactive)
(unless (derived-mode-p 'package-menu-mode)
- (error "The current buffer is not a Package Menu"))
- (package-refresh-contents)
- (package-menu--generate t t))
+ (user-error "The current buffer is not a Package Menu"))
+ (setq package-menu--old-archive-contents package-archive-contents)
+ (setq package-menu--new-package-list nil)
+ (package-refresh-contents package-menu-async))
+
+(defun package-menu-hide-package ()
+ "Hide a package under point.
+If optional arg BUTTON is non-nil, describe its associated package."
+ (interactive)
+ (declare (interactive-only "change `package-hidden-regexps' instead."))
+ (let* ((name (when (derived-mode-p 'package-menu-mode)
+ (concat "\\`" (regexp-quote (symbol-name (package-desc-name
+ (tabulated-list-get-id)))))))
+ (re (read-string "Hide packages matching regexp: " name)))
+ ;; Test if it is valid.
+ (string-match re "")
+ (push re package-hidden-regexps)
+ (customize-save-variable 'package-hidden-regexps package-hidden-regexps)
+ (package-menu--post-refresh)
+ (let ((hidden
+ (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e))))
+ package-archive-contents)))
+ (message (substitute-command-keys
+ (concat "Hiding %s packages, type `\\[package-menu-toggle-hiding]'"
+ " to toggle or `\\[customize-variable] RET package-hidden-regexps'"
+ " to customize it"))
+ (length hidden)))))
(defun package-menu-describe-package (&optional button)
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
(let ((pkg-desc (if button (button-get button 'package-desc)
- (tabulated-list-get-id))))
+ (tabulated-list-get-id))))
(if pkg-desc
- (describe-package pkg-desc)
- (error "No package here"))))
+ (describe-package pkg-desc)
+ (user-error "No package here"))))
;; fixme numeric argument
(defun package-menu-mark-delete (&optional _num)
"Mark a package for deletion and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("installed" "obsolete"))
+ (if (member (package-menu-get-status)
+ '("installed" "dependency" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
(defun package-menu-mark-install (&optional _num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("available" "new"))
+ (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
(tabulated-list-put-tag "I" t)
(forward-line)))
@@ -1562,72 +2973,216 @@ If optional arg BUTTON is non-nil, describe its associated package."
(goto-char (point-min))
(while (not (eobp))
(if (equal (package-menu-get-status) "obsolete")
- (tabulated-list-put-tag "D" t)
- (forward-line 1)))))
+ (tabulated-list-put-tag "D" t)
+ (forward-line 1)))))
+
+(defvar package--quick-help-keys
+ '(("install," "delete," "unmark," ("execute" . 1))
+ ("next," "previous")
+ ("Hide-package," "(-toggle-hidden")
+ ("refresh-contents," "g-redisplay," "filter," "help")))
+
+(defun package--prettify-quick-help-key (desc)
+ "Prettify DESC to be displayed as a help menu."
+ (if (listp desc)
+ (if (listp (cdr desc))
+ (mapconcat #'package--prettify-quick-help-key desc " ")
+ (let ((place (cdr desc))
+ (out (car desc)))
+ (add-text-properties place (1+ place)
+ '(face (bold font-lock-warning-face))
+ out)
+ out))
+ (package--prettify-quick-help-key (cons desc 0))))
(defun package-menu-quick-help ()
- "Show short key binding help for package-menu-mode."
+ "Show short key binding help for `package-menu-mode'.
+The full list of keys can be viewed with \\[describe-mode]."
(interactive)
- (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
+ (message (mapconcat #'package--prettify-quick-help-key
+ package--quick-help-keys "\n")))
(define-obsolete-function-alias
'package-menu-view-commentary 'package-menu-describe-package "24.1")
(defun package-menu-get-status ()
(let* ((id (tabulated-list-get-id))
- (entry (and id (assq id tabulated-list-entries))))
+ (entry (and id (assoc id tabulated-list-entries))))
(if entry
- (aref (cadr entry) 2)
+ (aref (cadr entry) 2)
"")))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+ (or (cdr (assoc archive package-archive-priorities))
+ 0))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-desc-priority pkg-desc)
+ (package-desc-version pkg-desc)))
+
(defun package-menu--find-upgrades ()
(let (installed available upgrades)
;; Build list of installed/available packages in this buffer.
(dolist (entry tabulated-list-entries)
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
- (status (aref (cadr entry) 2)))
- (cond ((equal status "installed")
- (push pkg-desc installed))
- ((member status '("available" "new"))
- (push (cons (package-desc-name pkg-desc) pkg-desc)
- available)))))
+ (status (aref (cadr entry) 2)))
+ (cond ((member status '("installed" "dependency" "unsigned"))
+ (push pkg-desc installed))
+ ((member status '("available" "new"))
+ (setq available (package--append-to-alist pkg-desc available))))))
;; Loop through list of installed packages, finding upgrades.
(dolist (pkg-desc installed)
- (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
- (and avail-pkg
- (version-list-< (package-desc-version pkg-desc)
- (package-desc-version (cdr avail-pkg)))
- (push avail-pkg upgrades))))
+ (let* ((name (package-desc-name pkg-desc))
+ (avail-pkg (cadr (assq name available))))
+ (and avail-pkg
+ (version-list-< (package-desc-priority-version pkg-desc)
+ (package-desc-priority-version avail-pkg))
+ (push (cons name avail-pkg) upgrades))))
upgrades))
-(defun package-menu-mark-upgrades ()
+(defvar package-menu--mark-upgrades-pending nil
+ "Whether mark-upgrades is waiting for a refresh to finish.")
+
+(defun package-menu--mark-upgrades-1 ()
"Mark all upgradable packages in the Package Menu.
-For each installed package with a newer version available, place
-an (I)nstall flag on the available version and a (D)elete flag on
-the installed version. A subsequent \\[package-menu-execute]
-call will upgrade the package."
- (interactive)
+Implementation of `package-menu-mark-upgrades'."
(unless (derived-mode-p 'package-menu-mode)
(error "The current buffer is not a Package Menu"))
+ (setq package-menu--mark-upgrades-pending nil)
(let ((upgrades (package-menu--find-upgrades)))
(if (null upgrades)
- (message "No packages to upgrade.")
+ (message "No packages to upgrade.")
(widen)
(save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pkg-desc (tabulated-list-get-id))
- (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
- (cond ((null upgrade)
- (forward-line 1))
- ((equal pkg-desc upgrade)
- (package-menu-mark-install))
- (t
- (package-menu-mark-delete))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pkg-desc (tabulated-list-get-id))
+ (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
+ (cond ((null upgrade)
+ (forward-line 1))
+ ((equal pkg-desc upgrade)
+ (package-menu-mark-install))
+ (t
+ (package-menu-mark-delete))))))
(message "%d package%s marked for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")))))
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")))))
+
+(defun package-menu-mark-upgrades ()
+ "Mark all upgradable packages in the Package Menu.
+For each installed package with a newer version available, place
+an (I)nstall flag on the available version and a (D)elete flag on
+the installed version. A subsequent \\[package-menu-execute]
+call will upgrade the package.
+
+If there's an async refresh operation in progress, the flags will
+be placed as part of `package-menu--post-refresh' instead of
+immediately."
+ (interactive)
+ (if (not package--downloads-in-progress)
+ (package-menu--mark-upgrades-1)
+ (setq package-menu--mark-upgrades-pending t)
+ (message "Waiting for refresh to finish...")))
+
+(defun package-menu--list-to-prompt (packages)
+ "Return a string listing PACKAGES that's usable in a prompt.
+PACKAGES is a list of `package-desc' objects.
+Formats the returned string to be usable in a minibuffer
+prompt (see `package-menu--prompt-transaction-p')."
+ (cond
+ ;; None
+ ((not packages) "")
+ ;; More than 1
+ ((cdr packages)
+ (format "these %d packages (%s)"
+ (length packages)
+ (mapconcat #'package-desc-full-name packages ", ")))
+ ;; Exactly 1
+ (t (format-message "package `%s'"
+ (package-desc-full-name (car packages))))))
+
+(defun package-menu--prompt-transaction-p (delete install upgrade)
+ "Prompt the user about DELETE, INSTALL, and UPGRADE.
+DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects.
+Either may be nil, but not all."
+ (y-or-n-p
+ (concat
+ (when delete "Delete ")
+ (package-menu--list-to-prompt delete)
+ (when (and delete install)
+ (if upgrade "; " "; and "))
+ (when install "Install ")
+ (package-menu--list-to-prompt install)
+ (when (and upgrade (or install delete)) "; and ")
+ (when upgrade "Upgrade ")
+ (package-menu--list-to-prompt upgrade)
+ "? ")))
+
+(defun package-menu--partition-transaction (install delete)
+ "Return an alist describing an INSTALL DELETE transaction.
+Alist contains three entries, upgrade, delete, and install, each
+with a list of package names.
+
+The upgrade entry contains any `package-desc' objects in INSTALL
+whose name coincides with an object in DELETE. The delete and
+the install entries are the same as DELETE and INSTALL with such
+objects removed."
+ (let* ((upg (cl-intersection install delete :key #'package-desc-name))
+ (ins (cl-set-difference install upg :key #'package-desc-name))
+ (del (cl-set-difference delete upg :key #'package-desc-name)))
+ `((delete . ,del) (install . ,ins) (upgrade . ,upg))))
+
+(defun package-menu--perform-transaction (install-list delete-list)
+ "Install packages in INSTALL-LIST and delete DELETE-LIST."
+ (if install-list
+ (let ((status-format (format ":Installing %%d/%d"
+ (length install-list)))
+ (i 0)
+ (package-menu--transaction-status))
+ (dolist (pkg install-list)
+ (setq package-menu--transaction-status
+ (format status-format (cl-incf i)))
+ (force-mode-line-update)
+ (redisplay 'force)
+ ;; Don't mark as selected, `package-menu-execute' already
+ ;; does that.
+ (package-install pkg 'dont-select))))
+ (let ((package-menu--transaction-status ":Deleting"))
+ (force-mode-line-update)
+ (redisplay 'force)
+ (dolist (elt (package--sort-by-dependence delete-list))
+ (condition-case-unless-debug err
+ (let ((inhibit-message package-menu-async))
+ (package-delete elt nil 'nosave))
+ (error (message "Error trying to delete `%s': %S"
+ (package-desc-full-name elt)
+ err))))))
+
+(defun package--update-selected-packages (add remove)
+ "Update the `package-selected-packages' list according to ADD and REMOVE.
+ADD and REMOVE must be disjoint lists of package names (or
+`package-desc' objects) to be added and removed to the selected
+packages list, respectively."
+ (dolist (p add)
+ (cl-pushnew (if (package-desc-p p) (package-desc-name p) p)
+ package-selected-packages))
+ (dolist (p remove)
+ (setq package-selected-packages
+ (remove (if (package-desc-p p) (package-desc-name p) p)
+ package-selected-packages)))
+ (when (or add remove)
+ (package--save-selected-packages package-selected-packages)))
(defun package-menu-execute (&optional noquery)
"Perform marked Package Menu actions.
@@ -1641,84 +3196,140 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (setq cmd (char-after))
- (unless (eq cmd ?\s)
- ;; This is the key PKG-DESC.
- (setq pkg-desc (tabulated-list-get-id))
- (cond ((eq cmd ?D)
- (push pkg-desc delete-list))
- ((eq cmd ?I)
- (push pkg-desc install-list))))
- (forward-line)))
- (when install-list
- (if (or
- noquery
- (yes-or-no-p
- (if (= (length install-list) 1)
- (format "Install package `%s'? "
- (package-desc-full-name (car install-list)))
- (format "Install these %d packages (%s)? "
- (length install-list)
- (mapconcat #'package-desc-full-name
- install-list ", ")))))
- (mapc 'package-install install-list)))
- ;; Delete packages, prompting if necessary.
- (when delete-list
- (if (or
- noquery
- (yes-or-no-p
- (if (= (length delete-list) 1)
- (format "Delete package `%s'? "
- (package-desc-full-name (car delete-list)))
- (format "Delete these %d packages (%s)? "
- (length delete-list)
- (mapconcat #'package-desc-full-name
- delete-list ", ")))))
- (dolist (elt delete-list)
- (condition-case-unless-debug err
- (package-delete elt)
- (error (message (cadr err)))))
- (error "Aborted")))
- (if (or delete-list install-list)
- (package-menu--generate t t)
- (message "No operations specified."))))
+ (setq cmd (char-after))
+ (unless (eq cmd ?\s)
+ ;; This is the key PKG-DESC.
+ (setq pkg-desc (tabulated-list-get-id))
+ (cond ((eq cmd ?D)
+ (push pkg-desc delete-list))
+ ((eq cmd ?I)
+ (push pkg-desc install-list))))
+ (forward-line)))
+ (unless (or delete-list install-list)
+ (user-error "No operations specified"))
+ (let-alist (package-menu--partition-transaction install-list delete-list)
+ (when (or noquery
+ (package-menu--prompt-transaction-p .delete .install .upgrade))
+ (let ((message-template
+ (concat "Package menu: Operation %s ["
+ (when .delete (format "Delet__ %s" (length .delete)))
+ (when (and .delete .install) "; ")
+ (when .install (format "Install__ %s" (length .install)))
+ (when (and .upgrade (or .install .delete)) "; ")
+ (when .upgrade (format "Upgrad__ %s" (length .upgrade)))
+ "]")))
+ (message (replace-regexp-in-string "__" "ing" message-template) "started")
+ ;; Packages being upgraded are not marked as selected.
+ (package--update-selected-packages .install .delete)
+ (package-menu--perform-transaction install-list delete-list)
+ (when package-selected-packages
+ (if-let ((removable (package--removable-packages)))
+ (message "Package menu: Operation finished. %d packages %s"
+ (length removable)
+ (substitute-command-keys
+ "are no longer needed, type `\\[package-autoremove]' to remove them"))
+ (message (replace-regexp-in-string "__" "ed" message-template)
+ "finished"))))))))
(defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0)))
- (vB (or (aref (cadr B) 1) '(0))))
+ (vB (or (aref (cadr B) 1) '(0))))
(if (version-list-= vA vB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(version-list-< vA vB))))
(defun package-menu--status-predicate (A B)
(let ((sA (aref (cadr A) 2))
- (sB (aref (cadr B) 2)))
+ (sB (aref (cadr B) 2)))
(cond ((string= sA sB)
- (package-menu--name-predicate A B))
- ((string= sA "new") t)
- ((string= sB "new") nil)
- ((string= sA "available") t)
- ((string= sB "available") nil)
- ((string= sA "installed") t)
- ((string= sB "installed") nil)
- ((string= sA "held") t)
- ((string= sB "held") nil)
- ((string= sA "built-in") t)
- ((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
- (t (string< sA sB)))))
+ (package-menu--name-predicate A B))
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string-prefix-p "avail" sA)
+ (if (string-prefix-p "avail" sB)
+ (package-menu--name-predicate A B)
+ t))
+ ((string-prefix-p "avail" sB) nil)
+ ((string= sA "installed") t)
+ ((string= sB "installed") nil)
+ ((string= sA "dependency") t)
+ ((string= sB "dependency") nil)
+ ((string= sA "unsigned") t)
+ ((string= sB "unsigned") nil)
+ ((string= sA "held") t)
+ ((string= sB "held") nil)
+ ((string= sA "external") t)
+ ((string= sB "external") nil)
+ ((string= sA "built-in") t)
+ ((string= sB "built-in") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
+ ((string= sA "incompat") t)
+ ((string= sB "incompat") nil)
+ (t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
(let ((dA (aref (cadr A) 3))
- (dB (aref (cadr B) 3)))
+ (dB (aref (cadr B) 3)))
(if (string= dA dB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(string< dA dB))))
(defun package-menu--name-predicate (A B)
(string< (symbol-name (package-desc-name (car A)))
- (symbol-name (package-desc-name (car B)))))
+ (symbol-name (package-desc-name (car B)))))
+
+(defun package-menu--archive-predicate (A B)
+ (string< (or (package-desc-archive (car A)) "")
+ (or (package-desc-archive (car B)) "")))
+
+(defun package-menu--populate-new-package-list ()
+ "Decide which packages are new in `package-archives-contents'.
+Store this list in `package-menu--new-package-list'."
+ ;; Find which packages are new.
+ (when package-menu--old-archive-contents
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) package-menu--old-archive-contents)
+ (push (car elt) package-menu--new-package-list)))
+ (setq package-menu--old-archive-contents nil)))
+
+(defun package-menu--find-and-notify-upgrades ()
+ "Notify the user of upgradable packages."
+ (when-let ((upgrades (package-menu--find-upgrades)))
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))
+
+(defun package-menu--post-refresh ()
+ "If there's a *Packages* buffer, revert it and check for new packages and upgrades.
+Do nothing if there's no *Packages* buffer.
+
+This function is called after `package-refresh-contents' and it
+is added to `post-command-hook' by any function which alters the
+package database (`package-install' and `package-delete'). When
+run, it removes itself from `post-command-hook'."
+ (remove-hook 'post-command-hook #'package-menu--post-refresh)
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (package-menu--populate-new-package-list)
+ (run-hooks 'tabulated-list-revert-hook)
+ (tabulated-list-print 'remember 'update)))))
+
+(defun package-menu--mark-or-notify-upgrades ()
+ "If there's a *Packages* buffer, check for upgrades and possibly mark them.
+Do nothing if there's no *Packages* buffer. If there are
+upgrades, mark them if `package-menu--mark-upgrades-pending' is
+non-nil, otherwise just notify the user that there are upgrades.
+This function is called after `package-refresh-contents'."
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (if package-menu--mark-upgrades-pending
+ (package-menu--mark-upgrades-1)
+ (package-menu--find-and-notify-upgrades))))))
;;;###autoload
(defun list-packages (&optional no-fetch)
@@ -1731,52 +3342,66 @@ The list is displayed in a buffer named `*Packages*'."
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (let (old-archives new-packages)
- (unless no-fetch
- ;; Read the locally-cached archive-contents.
- (package-read-all-archive-contents)
- (setq old-archives package-archive-contents)
+ ;; Integrate the package-menu with updating the archives.
+ (add-hook 'package--post-download-archives-hook
+ #'package-menu--post-refresh)
+ (add-hook 'package--post-download-archives-hook
+ #'package-menu--mark-or-notify-upgrades 'append)
+
+ ;; Generate the Package Menu.
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+
;; Fetch the remote list of packages.
- (package-refresh-contents)
- ;; Find which packages are new.
- (dolist (elt package-archive-contents)
- (unless (assq (car elt) old-archives)
- (push (car elt) new-packages))))
-
- ;; Generate the Package Menu.
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- (package-menu-mode)
- (set (make-local-variable 'package-menu--new-package-list)
- new-packages)
- (package-menu--generate nil t))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf))
-
- (let ((upgrades (package-menu--find-upgrades)))
- (if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")
- (if (= (length upgrades) 1) "it" "them"))))))
+ (unless no-fetch (package-menu-refresh))
+
+ ;; If we're not async, this would be redundant.
+ (when package-menu-async
+ (package-menu--generate nil t)))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
;; Used in finder.el
-(defun package-show-package-list (packages)
+(defun package-show-package-list (&optional packages keywords)
"Display PACKAGES in a *Packages* buffer.
This is similar to `list-packages', but it does not fetch the
updated list of packages, and it only displays packages with
-names in PACKAGES (which should be a list of symbols)."
+names in PACKAGES (which should be a list of symbols).
+
+When KEYWORDS are given, only packages with those KEYWORDS are
+shown."
+ (interactive)
(require 'finder-inf nil t)
- (let ((buf (get-buffer-create "*Packages*")))
+ (let* ((buf (get-buffer-create "*Packages*"))
+ (win (get-buffer-window buf)))
(with-current-buffer buf
(package-menu-mode)
- (package-menu--generate nil packages))
- (switch-to-buffer buf)))
+ (package-menu--generate nil packages keywords))
+ (if win
+ (select-window win)
+ (switch-to-buffer buf))))
+
+;; package-menu--generate rebinds "q" on the fly, so we have to
+;; hard-code the binding in the doc-string here.
+(defun package-menu-filter (keyword)
+ "Filter the *Packages* buffer.
+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.
+
+To restore the full package list, type `q'."
+ (interactive
+ (list (completing-read-multiple
+ "Keywords (comma separated): " (package-all-keywords))))
+ (package-show-package-list t (if (stringp keyword)
+ (list keyword)
+ keyword)))
(defun package-list-packages-no-fetch ()
"Display a list of packages.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index eb2c7f002e8..8bcb447cfbb 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,6 +1,6 @@
-;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
@@ -47,7 +47,7 @@
;; to be performed anyway, so better do it first so it's shared).
;; - then choose the test that discriminates more (?).
;; - provide Agda's `with' (along with its `...' companion).
-;; - implement (not UPAT). This might require a significant redesign.
+;; - implement (not PAT). This might require a significant redesign.
;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
;; generate a lex-style DFA to decide whether to run E1 or E2.
@@ -68,62 +68,78 @@
(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
+(defvar pcase--dontwarn-upats '(pcase--dontcare))
+
(def-edebug-spec
- pcase-UPAT
+ pcase-PAT
(&or symbolp
- ("or" &rest pcase-UPAT)
- ("and" &rest pcase-UPAT)
- ("`" pcase-QPAT)
+ ("or" &rest pcase-PAT)
+ ("and" &rest pcase-PAT)
("guard" form)
- ("let" pcase-UPAT form)
- ("pred"
- &or lambda-expr
- ;; Punt on macros/special forms.
- (functionp &rest form)
- sexp)
+ ("let" pcase-PAT form)
+ ("pred" pcase-FUN)
+ ("app" pcase-FUN pcase-PAT)
+ pcase-MACRO
sexp))
(def-edebug-spec
- pcase-QPAT
- (&or ("," pcase-UPAT)
- (pcase-QPAT . pcase-QPAT)
+ pcase-FUN
+ (&or lambda-expr
+ ;; Punt on macros/special forms.
+ (functionp &rest form)
sexp))
+(def-edebug-spec pcase-MACRO pcase--edebug-match-macro)
+
+;; Only called from edebug.
+(declare-function get-edebug-spec "edebug" (symbol))
+(declare-function edebug-match "edebug" (cursor specs))
+
+(defun pcase--edebug-match-macro (cursor)
+ (let (specs)
+ (mapatoms
+ (lambda (s)
+ (let ((m (get s 'pcase-macroexpander)))
+ (when (and m (get-edebug-spec m))
+ (push (cons (symbol-name s) (get-edebug-spec m))
+ specs)))))
+ (edebug-match cursor (cons '&or specs))))
+
;;;###autoload
(defmacro pcase (exp &rest cases)
"Perform ML-style pattern matching on EXP.
-CASES is a list of elements of the form (UPATTERN CODE...).
+CASES is a list of elements of the form (PATTERN CODE...).
-UPatterns can take the following forms:
+Patterns can take the following forms:
_ matches anything.
- SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
- (or UPAT...) matches if any of the patterns matches.
- (and UPAT...) matches if all the patterns match.
- `QPAT matches if the QPattern QPAT matches.
- (pred PRED) matches if PRED applied to the object returns non-nil.
+ (or PAT...) matches if any of the patterns matches.
+ (and PAT...) matches if all the patterns match.
+ \\='VAL matches if the object is `equal' to VAL
+ ATOM is a shorthand for \\='ATOM.
+ ATOM can be a keyword, an integer, or a string.
+ (pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
- (let UPAT EXP) matches if EXP matches UPAT.
+ (let PAT EXP) matches if EXP matches PAT.
+ (app FUN PAT) matches if FUN applied to the object matches PAT.
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-QPatterns for vectors are not implemented yet.
-
-PRED can take the form
- FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+FUN can take the form
+ SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
+ (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
which is the value being matched.
-A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
-PRED patterns can refer to variables bound earlier in the pattern.
+So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
+FUN can refer to variables bound earlier in the pattern.
+FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
+and two identical calls can be merged into one.
E.g. you can match pairs where the cdr is larger than the car with a pattern
-like `(,a . ,(pred (< a))) or, with more checks:
-`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
- (declare (indent 1) (debug (form &rest (pcase-UPAT body))))
+like \\=`(,a . ,(pred (< a))) or, with more checks:
+\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:"
+ (declare (indent 1) (debug (form &rest (pcase-PAT body))))
;; We want to use a weak hash table as a cache, but the key will unavoidably
;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
;; we're called so it'll be immediately GC'd. So we use (car cases) as key
@@ -147,6 +163,65 @@ like `(,a . ,(pred (< a))) or, with more checks:
;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
expansion))))
+(declare-function help-fns--signature "help-fns"
+ (function doc real-def real-function buffer))
+
+;; FIXME: Obviously, this will collide with nadvice's use of
+;; function-documentation if we happen to advise `pcase'.
+(put 'pcase 'function-documentation '(pcase--make-docstring))
+(defun pcase--make-docstring ()
+ (let* ((main (documentation (symbol-function 'pcase) 'raw))
+ (ud (help-split-fundoc main 'pcase)))
+ ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
+ ;; where cl-lib is anything using pcase-defmacro.
+ (require 'help-fns)
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (mapatoms
+ (lambda (symbol)
+ (let ((me (get symbol 'pcase-macroexpander)))
+ (when me
+ (insert "\n\n-- ")
+ (let* ((doc (documentation me 'raw)))
+ (setq doc (help-fns--signature symbol doc me
+ (indirect-function me) nil))
+ (insert "\n" (or doc "Not documented.")))))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
+
+;;;###autoload
+(defmacro pcase-exhaustive (exp &rest cases)
+ "The exhaustive version of `pcase' (which see)."
+ (declare (indent 1) (debug pcase))
+ (let* ((x (make-symbol "x"))
+ (pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
+ (pcase--expand
+ ;; FIXME: Could we add the FILE:LINE data in the error message?
+ exp (append cases `((,x (error "No clause matching `%S'" ,x)))))))
+
+;;;###autoload
+(defmacro pcase-lambda (lambda-list &rest body)
+ "Like `lambda' but allow each argument to be a pattern.
+I.e. accepts the usual &optional and &rest keywords, but every
+formal argument can be any pattern accepted by `pcase' (a mere
+variable name being but a special case of it)."
+ (declare (doc-string 2) (indent defun)
+ (debug ((&rest pcase-PAT) body)))
+ (let* ((bindings ())
+ (parsed-body (macroexp-parse-body body))
+ (args (mapcar (lambda (pat)
+ (if (symbolp pat)
+ ;; Simple vars and &rest/&optional are just passed
+ ;; through unchanged.
+ pat
+ (let ((arg (make-symbol
+ (format "arg%s" (length bindings)))))
+ (push `(,pat ,arg) bindings)
+ arg)))
+ lambda-list)))
+ `(lambda ,args ,@(car parsed-body)
+ (pcase-let* ,(nreverse bindings) ,@(cdr parsed-body)))))
+
(defun pcase--let* (bindings body)
(cond
((null bindings) (macroexp-progn body))
@@ -168,9 +243,9 @@ like `(,a . ,(pred (< a))) or, with more checks:
(defmacro pcase-let* (bindings &rest body)
"Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
-of the form (UPAT EXP)."
+of the form (PAT EXP)."
(declare (indent 1)
- (debug ((&rest (pcase-UPAT &optional form)) body)))
+ (debug ((&rest (pcase-PAT &optional form)) body)))
(let ((cached (gethash bindings pcase--memoize)))
;; cached = (BODY . EXPANSION)
(if (equal (car cached) body)
@@ -183,7 +258,10 @@ of the form (UPAT EXP)."
(defmacro pcase-let (bindings &rest body)
"Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
-of the form (UPAT EXP)."
+of the form (PAT EXP).
+The macro is expanded and optimized under the assumption that those
+patterns *will* match, so a mismatch may go undetected or may cause
+any kind of error."
(declare (indent 1) (debug pcase-let*))
(if (null (cdr bindings))
`(pcase-let* ,bindings ,@body)
@@ -199,8 +277,9 @@ of the form (UPAT EXP)."
(push (list (car binding) tmpvar) matches)))))
`(let ,(nreverse bindings) (pcase-let* ,matches ,@body)))))
+;;;###autoload
(defmacro pcase-dolist (spec &rest body)
- (declare (indent 1) (debug ((pcase-UPAT form) body)))
+ (declare (indent 1) (debug ((pcase-PAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
(let ((tmpvar (make-symbol "x")))
@@ -265,7 +344,7 @@ of the form (UPAT EXP)."
(main
(pcase--u
(mapcar (lambda (case)
- `((match ,val . ,(car case))
+ `(,(pcase--match val (pcase--macroexpand (car case)))
,(lambda (vars)
(unless (memq case used-cases)
;; Keep track of the cases that are used.
@@ -279,10 +358,59 @@ of the form (UPAT EXP)."
vars))))
cases))))
(dolist (case cases)
- (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+ (unless (or (memq case used-cases)
+ (memq (car case) pcase--dontwarn-upats))
(message "Redundant pcase pattern: %S" (car case))))
(macroexp-let* defs main))))
+(defun pcase--macroexpand (pat)
+ "Expands all macro-patterns in PAT."
+ (let ((head (car-safe pat)))
+ (cond
+ ((null head)
+ (if (pcase--self-quoting-p pat) `',pat pat))
+ ((memq head '(pred guard quote)) pat)
+ ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat))))
+ ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
+ ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
+ (t
+ (let* ((expander (get head 'pcase-macroexpander))
+ (npat (if expander (apply expander (cdr pat)))))
+ (if (null npat)
+ (error (if expander
+ "Unexpandable %s pattern: %S"
+ "Unknown %s pattern: %S")
+ head pat)
+ (pcase--macroexpand npat)))))))
+
+;;;###autoload
+(defmacro pcase-defmacro (name args &rest body)
+ "Define a new kind of pcase PATTERN, by macro expansion.
+Patterns of the form (NAME ...) will be expanded according
+to this macro."
+ (declare (indent 2) (debug defun) (doc-string 3))
+ ;; Add the function via `fsym', so that an autoload cookie placed
+ ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+ (let ((fsym (intern (format "%s--pcase-macroexpander" name)))
+ (decl (assq 'declare body)))
+ (when decl (setq body (remove decl body)))
+ `(progn
+ (defun ,fsym ,args ,@body)
+ (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
+ (put ',name 'pcase-macroexpander #',fsym))))
+
+(defun pcase--match (val upat)
+ "Build a MATCH structure, hoisting all `or's and `and's outside."
+ (cond
+ ;; Hoist or/and patterns into or/and matches.
+ ((memq (car-safe upat) '(or and))
+ `(,(car upat)
+ ,@(mapcar (lambda (upat)
+ (pcase--match val upat))
+ (cdr upat))))
+ (t
+ `(match ,val . ,upat))))
+
(defun pcase-codegen (code vars)
;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
@@ -306,11 +434,6 @@ of the form (UPAT EXP)."
((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
(t (macroexp-if test then else))))
-(defun pcase--upat (qpattern)
- (cond
- ((eq (car-safe qpattern) '\,) (cadr qpattern))
- (t (list '\` qpattern))))
-
;; Note about MATCH:
;; When we have patterns like `(PAT1 . PAT2), after performing the `consp'
;; check, we want to turn all the similar patterns into ones of the form
@@ -335,7 +458,7 @@ Each BRANCH has the form (MATCH CODE . VARS) where
CODE is the code generator for that branch.
VARS is the set of vars already bound by earlier matches.
MATCH is the pattern that needs to be matched, of the form:
- (match VAR . UPAT)
+ (match VAR . PAT)
(and MATCH ...)
(or MATCH ...)"
(when (setq branches (delq nil branches))
@@ -383,21 +506,12 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase--split-match (sym splitter match)
(cond
- ((eq (car match) 'match)
+ ((eq (car-safe match) 'match)
(if (not (eq sym (cadr match)))
(cons match match)
- (let ((pat (cddr match)))
- (cond
- ;; Hoist `or' and `and' patterns to `or' and `and' matches.
- ((memq (car-safe pat) '(or and))
- (pcase--split-match sym splitter
- (cons (car pat)
- (mapcar (lambda (alt)
- `(match ,sym . ,alt))
- (cdr pat)))))
- (t (let ((res (funcall splitter (cddr match))))
- (cons (or (car res) match) (or (cdr res) match))))))))
- ((memq (car match) '(or and))
+ (let ((res (funcall splitter (cddr match))))
+ (cons (or (car res) match) (or (cdr res) match)))))
+ ((memq (car-safe match) '(or and))
(let ((then-alts '())
(else-alts '())
(neutral-elem (if (eq 'or (car match))
@@ -417,6 +531,7 @@ MATCH is the pattern that needs to be matched, of the form:
((null else-alts) neutral-elem)
((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))))
(defun pcase--split-rest (sym splitter rest)
@@ -433,27 +548,13 @@ MATCH is the pattern that needs to be matched, of the form:
(push (cons (cdr split) code&vars) else-rest))))
(cons (nreverse then-rest) (nreverse else-rest))))
-(defun pcase--split-consp (syma symd pat)
- (cond
- ;; A QPattern for a cons, can only go the `then' side.
- ((and (eq (car-safe pat) '\`) (consp (cadr pat)))
- (let ((qpat (cadr pat)))
- (cons `(and (match ,syma . ,(pcase--upat (car qpat)))
- (match ,symd . ,(pcase--upat (cdr qpat))))
- :pcase--fail)))
- ;; A QPattern but not for a cons, can only go to the `else' side.
- ((eq (car-safe pat) '\`) '(:pcase--fail . nil))
- ((and (eq (car-safe pat) 'pred)
- (pcase--mutually-exclusive-p #'consp (cadr pat)))
- '(:pcase--fail . nil))))
-
(defun pcase--split-equal (elem pat)
(cond
;; The same match will give the same result.
- ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem))
+ ((and (eq (car-safe pat) 'quote) (equal (cadr pat) elem))
'(:pcase--succeed . :pcase--fail))
;; A different match will fail if this one succeeds.
- ((and (eq (car-safe pat) '\`)
+ ((and (eq (car-safe pat) 'quote)
;; (or (integerp (cadr pat)) (symbolp (cadr pat))
;; (consp (cadr pat)))
)
@@ -461,11 +562,13 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free))
- (if (funcall (cadr pat) elem)
- '(:pcase--succeed . nil)
- '(:pcase--fail . nil)))))
+ (ignore-errors
+ (if (funcall (cadr pat) elem)
+ '(:pcase--succeed . nil)
+ '(:pcase--fail . nil))))))
(defun pcase--split-member (elems pat)
+ ;; FIXME: The new pred-based member code doesn't do these optimizations!
;; Based on pcase--split-equal.
(cond
;; The same match (or a match of membership in a superset) will
@@ -473,10 +576,10 @@ MATCH is the pattern that needs to be matched, of the form:
;; (???
;; '(:pcase--succeed . nil))
;; A match for one of the elements may succeed or fail.
- ((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
+ ((and (eq (car-safe pat) 'quote) (member (cadr pat) elems))
nil)
;; A different match will fail if this one succeeds.
- ((and (eq (car-safe pat) '\`)
+ ((and (eq (car-safe pat) 'quote)
;; (or (integerp (cadr pat)) (symbolp (cadr pat))
;; (consp (cadr pat)))
)
@@ -484,10 +587,11 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq (car-safe pat) 'pred)
(symbolp (cadr pat))
(get (cadr pat) 'side-effect-free)
- (let ((p (cadr pat)) (all t))
- (dolist (elem elems)
- (unless (funcall p elem) (setq all nil)))
- all))
+ (ignore-errors
+ (let ((p (cadr pat)) (all t))
+ (dolist (elem elems)
+ (unless (funcall p elem) (setq all nil)))
+ all)))
'(:pcase--succeed . nil))))
(defun pcase--split-pred (vars upat pat)
@@ -506,15 +610,16 @@ MATCH is the pattern that needs to be matched, of the form:
((and (eq 'pred (car upat))
(let ((otherpred
(cond ((eq 'pred (car-safe pat)) (cadr pat))
- ((not (eq '\` (car-safe pat))) nil)
+ ((not (eq 'quote (car-safe pat))) nil)
((consp (cadr pat)) #'consp)
+ ((stringp (cadr pat)) #'stringp)
((vectorp (cadr pat)) #'vectorp)
((byte-code-function-p (cadr pat))
#'byte-code-function-p))))
(pcase--mutually-exclusive-p (cadr upat) otherpred)))
'(:pcase--fail . nil))
((and (eq 'pred (car upat))
- (eq '\` (car-safe pat))
+ (eq 'quote (car-safe pat))
(symbolp (cadr upat))
(or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
(get (cadr upat) 'side-effect-free)
@@ -534,12 +639,73 @@ MATCH is the pattern that needs to be matched, of the form:
res))
(defun pcase--self-quoting-p (upat)
- (or (keywordp upat) (numberp upat) (stringp upat)))
+ (or (keywordp upat) (integerp upat) (stringp upat)))
+
+(defun pcase--app-subst-match (match sym fun nsym)
+ (cond
+ ((eq (car-safe match) 'match)
+ (if (and (eq sym (cadr match))
+ (eq 'app (car-safe (cddr match)))
+ (equal fun (nth 1 (cddr match))))
+ (pcase--match nsym (nth 2 (cddr match)))
+ match))
+ ((memq (car-safe match) '(or and))
+ `(,(car match)
+ ,@(mapcar (lambda (match)
+ (pcase--app-subst-match match sym fun nsym))
+ (cdr match))))
+ ((memq match '(:pcase--succeed :pcase--fail)) match)
+ (t (error "Uknown MATCH %s" match))))
+
+(defun pcase--app-subst-rest (rest sym fun nsym)
+ (mapcar (lambda (branch)
+ `(,(pcase--app-subst-match (car branch) sym fun nsym)
+ ,@(cdr branch)))
+ rest))
(defsubst pcase--mark-used (sym)
;; Exceptionally, `sym' may be a constant expression rather than a symbol.
(if (symbolp sym) (put sym 'pcase-used t)))
+(defmacro pcase--flip (fun arg1 arg2)
+ "Helper function, used internally to avoid (funcall (lambda ...) ...)."
+ (declare (debug (sexp body)))
+ `(,fun ,arg2 ,arg1))
+
+(defun pcase--funcall (fun arg vars)
+ "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))
+ (call (progn
+ (when (memq arg vs)
+ ;; `arg' is shadowed by `env'.
+ (let ((newsym (make-symbol "x")))
+ (push (list newsym arg) env)
+ (setq arg newsym)))
+ (if (functionp fun)
+ `(funcall #',fun ,arg)
+ `(,@fun ,arg)))))
+ (if (null vs)
+ call
+ ;; Let's not replace `vars' in `fun' since it's
+ ;; too difficult to do it right, instead just
+ ;; let-bind `vars' around `fun'.
+ `(let* ,env ,call)))))
+
+(defun pcase--eval (exp vars)
+ "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)))))
+
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
(defun pcase--u1 (matches code vars rest)
@@ -561,22 +727,26 @@ Otherwise, it defers to REST which is a list of branches of the form
((eq 'or (caar matches))
(let* ((alts (cdar matches))
(var (if (eq (caar alts) 'match) (cadr (car alts))))
- (simples '()) (others '()))
+ (simples '()) (others '()) (memq-ok t))
(when var
(dolist (alt alts)
(if (and (eq (car alt) 'match) (eq var (cadr alt))
(let ((upat (cddr alt)))
- (and (eq (car-safe upat) '\`)
- (or (integerp (cadr upat)) (symbolp (cadr upat))
- (stringp (cadr upat))))))
- (push (cddr alt) simples)
+ (eq (car-safe upat) 'quote)))
+ (let ((val (cadr (cddr alt))))
+ (unless (or (integerp val) (symbolp val))
+ (setq memq-ok nil))
+ (push (cadr (cddr alt)) simples))
(push alt others))))
(cond
((null alts) (error "Please avoid it") (pcase--u rest))
+ ;; Yes, we can use `memq' (or `member')!
((> (length simples) 1)
- ;; De-hoist the `or' MATCH into an `or' pattern that will be
- ;; turned into a `memq' below.
- (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches))
+ (pcase--u1 (cons `(match ,var
+ . (pred (pcase--flip
+ ,(if memq-ok #'memq #'member)
+ ',simples)))
+ (cdr matches))
code vars
(if (null others) rest
(cons (cons
@@ -601,7 +771,12 @@ Otherwise, it defers to REST which is a list of branches of the form
(sym (car cdrpopmatches))
(upat (cdr cdrpopmatches)))
(cond
- ((memq upat '(t _)) (pcase--u1 matches code vars rest))
+ ((memq upat '(t _))
+ (let ((code (pcase--u1 matches code vars rest)))
+ (if (eq upat '_) code
+ (macroexp--warn-and-return
+ "Pattern t is deprecated. Use `_' instead"
+ code))))
((eq upat 'pcase--dontcare) :pcase--dontcare)
((memq (car-safe upat) '(guard pred))
(if (eq (car upat) 'pred) (pcase--mark-used sym))
@@ -610,36 +785,12 @@ Otherwise, it defers to REST which is a list of branches of the form
sym (lambda (pat) (pcase--split-pred vars upat pat)) rest))
(then-rest (car splitrest))
(else-rest (cdr splitrest)))
- (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
- `(,(cadr upat) ,sym)
- (let* ((exp (cadr upat))
- ;; `vs' is an upper bound on the vars we need.
- (vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs))
- (call (if (eq 'guard (car upat))
- exp
- (when (memq sym vs)
- ;; `sym' is shadowed by `env'.
- (let ((newsym (make-symbol "x")))
- (push (list newsym sym) env)
- (setq sym newsym)))
- (if (functionp exp)
- `(funcall #',exp ,sym)
- `(,@exp ,sym)))))
- (if (null vs)
- call
- ;; Let's not replace `vars' in `exp' since it's
- ;; too difficult to do it right, instead just
- ;; let-bind `vars' around `exp'.
- `(let* ,env ,call))))
+ (pcase--if (if (eq (car upat) 'pred)
+ (pcase--funcall (cadr upat) sym vars)
+ (pcase--eval (cadr upat) vars))
(pcase--u1 matches code vars then-rest)
(pcase--u else-rest))))
- ((pcase--self-quoting-p upat)
- (pcase--mark-used sym)
- (pcase--q1 sym upat matches code vars rest))
- ((symbolp upat)
+ ((and (symbolp upat) upat)
(pcase--mark-used sym)
(if (not (assq upat vars))
(pcase--u1 matches code (cons (cons upat sym) vars) rest)
@@ -653,57 +804,41 @@ Otherwise, it defers to REST which is a list of branches of the form
;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
(macroexp-let2
macroexp-copyable-p sym
- (let* ((exp (nth 2 upat))
- (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))))
- (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
+ (pcase--eval (nth 2 upat) vars)
+ (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches)
code vars rest)))
- ((eq (car-safe upat) '\`)
+ ((eq (car-safe upat) 'app)
+ ;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
- (pcase--q1 sym (cadr upat) matches code vars rest))
- ((eq (car-safe upat) 'or)
- (let ((all (> (length (cdr upat)) 1))
- (memq-fine t))
- (when all
- (dolist (alt (cdr upat))
- (unless (if (pcase--self-quoting-p alt)
- (progn
- (unless (or (symbolp alt) (integerp alt))
- (setq memq-fine nil))
- t)
- (and (eq (car-safe alt) '\`)
- (or (symbolp (cadr alt)) (integerp (cadr alt))
- (setq memq-fine nil)
- (stringp (cadr alt)))))
- (setq all nil))))
- (if all
- ;; Use memq for (or `a `b `c `d) rather than a big tree.
- (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
- (cdr upat)))
- (splitrest
- (pcase--split-rest
- sym (lambda (pat) (pcase--split-member elems pat)) rest))
- (then-rest (car splitrest))
- (else-rest (cdr splitrest)))
- (pcase--mark-used sym)
- (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
- (pcase--u1 matches code vars then-rest)
- (pcase--u else-rest)))
- (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars
- (append (mapcar (lambda (upat)
- `((and (match ,sym . ,upat) ,@matches)
- ,code ,@vars))
- (cddr upat))
- rest)))))
- ((eq (car-safe upat) 'and)
- (pcase--u1 (append (mapcar (lambda (upat) `(match ,sym ,@upat))
- (cdr upat))
- matches)
- code vars rest))
+ (let* ((fun (nth 1 upat))
+ (nsym (make-symbol "x"))
+ (body
+ ;; We don't change `matches' to reuse the newly computed value,
+ ;; because we assume there shouldn't be such redundancy in there.
+ (pcase--u1 (cons (pcase--match nsym (nth 2 upat)) matches)
+ code vars
+ (pcase--app-subst-rest rest sym fun nsym))))
+ (if (not (get nsym 'pcase-used))
+ body
+ (macroexp-let*
+ `((,nsym ,(pcase--funcall fun sym vars)))
+ body))))
+ ((eq (car-safe upat) 'quote)
+ (pcase--mark-used sym)
+ (let* ((val (cadr upat))
+ (splitrest (pcase--split-rest
+ sym (lambda (pat) (pcase--split-equal val pat)) rest))
+ (then-rest (car splitrest))
+ (else-rest (cdr splitrest)))
+ (pcase--if (cond
+ ((null val) `(null ,sym))
+ ((or (integerp val) (symbolp val))
+ (if (pcase--self-quoting-p val)
+ `(eq ,sym ,val)
+ `(eq ,sym ',val)))
+ (t `(equal ,sym ',val)))
+ (pcase--u1 matches code vars then-rest)
+ (pcase--u else-rest))))
((eq (car-safe upat) 'not)
;; FIXME: The implementation below is naive and results in
;; inefficient code.
@@ -725,57 +860,42 @@ Otherwise, it defers to REST which is a list of branches of the form
(pcase--u rest))
vars
(list `((and . ,matches) ,code . ,vars))))
- (t (error "Unknown upattern `%s'" upat)))))
- (t (error "Incorrect MATCH %s" (car matches)))))
+ (t (error "Unknown pattern `%S'" upat)))))
+ (t (error "Incorrect MATCH %S" (car matches)))))
-(defun pcase--q1 (sym qpat matches code vars rest)
- "Return code that runs CODE if SYM matches QPAT and if MATCHES match.
-Otherwise, it defers to REST which is a list of branches of the form
-\(OTHER_MATCH OTHER-CODE . OTHER-VARS)."
+(def-edebug-spec
+ pcase-QPAT
+ (&or ("," pcase-PAT)
+ (pcase-QPAT . pcase-QPAT)
+ (vector &rest pcase-QPAT)
+ sexp))
+
+(pcase-defmacro \` (qpat)
+ "Backquote-style pcase patterns.
+QPAT can take the following forms:
+ (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
+ [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
+ its 0..(n-1)th elements, respectively.
+ ,PAT matches if the pcase pattern PAT matches.
+ ATOM matches if the object is `equal' to ATOM.
+ ATOM can be a symbol, an integer, or a string."
+ (declare (debug (pcase-QPAT)))
(cond
- ((eq (car-safe qpat) '\,) (error "Can't use `,UPATTERN"))
- ((floatp qpat) (error "Floating point patterns not supported"))
+ ((eq (car-safe qpat) '\,) (cadr qpat))
((vectorp qpat)
- ;; FIXME.
- (error "Vector QPatterns not implemented yet"))
+ `(and (pred vectorp)
+ (app length ,(length qpat))
+ ,@(let ((upats nil))
+ (dotimes (i (length qpat))
+ (push `(app (pcase--flip aref ,i) ,(list '\` (aref qpat i)))
+ upats))
+ (nreverse upats))))
((consp qpat)
- (let* ((syma (make-symbol "xcar"))
- (symd (make-symbol "xcdr"))
- (splitrest (pcase--split-rest
- sym
- (lambda (pat) (pcase--split-consp syma symd pat))
- rest))
- (then-rest (car splitrest))
- (else-rest (cdr splitrest))
- (then-body (pcase--u1 `((match ,syma . ,(pcase--upat (car qpat)))
- (match ,symd . ,(pcase--upat (cdr qpat)))
- ,@matches)
- code vars then-rest)))
- (pcase--if
- `(consp ,sym)
- ;; We want to be careful to only add bindings that are used.
- ;; The byte-compiler could do that for us, but it would have to pay
- ;; attention to the `consp' test in order to figure out that car/cdr
- ;; can't signal errors and our byte-compiler is not that clever.
- ;; FIXME: Some of those let bindings occur too early (they are used in
- ;; `then-body', but only within some sub-branch).
- (macroexp-let*
- `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
- ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
- then-body)
- (pcase--u else-rest))))
- ((or (integerp qpat) (symbolp qpat) (stringp qpat))
- (let* ((splitrest (pcase--split-rest
- sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
- (then-rest (car splitrest))
- (else-rest (cdr splitrest)))
- (pcase--if (cond
- ((stringp qpat) `(equal ,sym ,qpat))
- ((null qpat) `(null ,sym))
- (t `(eq ,sym ',qpat)))
- (pcase--u1 matches code vars then-rest)
- (pcase--u else-rest))))
- (t (error "Unknown QPattern %s" qpat))))
+ `(and (pred consp)
+ (app car ,(list '\` (car qpat)))
+ (app cdr ,(list '\` (cdr qpat)))))
+ ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
+ (t (error "Unknown QPAT: %S" qpat))))
(provide 'pcase)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 4cb089aca97..ac3cc74ca6a 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -1,6 +1,6 @@
;;; pp.el --- pretty printer for Emacs Lisp
-;; Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Randal Schwartz <merlyn@stonehenge.com>
;; Keywords: lisp
@@ -129,7 +129,7 @@ Also add the value to the front of the list in the variable `values'."
(interactive
(list (read--expression "Eval: ")))
(message "Evaluating...")
- (setq values (cons (eval expression) values))
+ (setq values (cons (eval expression lexical-binding) values))
(pp-display-expression (car values) "*Pp Eval Output*"))
;;;###autoload
@@ -137,7 +137,7 @@ Also add the value to the front of the list in the variable `values'."
"Macroexpand EXPRESSION and pretty-print its value."
(interactive
(list (read--expression "Macroexpand: ")))
- (pp-display-expression (macroexpand expression) "*Pp Macroexpand Output*"))
+ (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*"))
(defun pp-last-sexp ()
"Read sexp before point. Ignores leading comment characters."
@@ -165,7 +165,7 @@ With argument, pretty-print output into current buffer.
Ignores leading comment characters."
(interactive "P")
(if arg
- (insert (pp-to-string (eval (pp-last-sexp))))
+ (insert (pp-to-string (eval (pp-last-sexp) lexical-binding)))
(pp-eval-expression (pp-last-sexp))))
;;;###autoload
@@ -175,7 +175,7 @@ With argument, pretty-print output into current buffer.
Ignores leading comment characters."
(interactive "P")
(if arg
- (insert (pp-to-string (macroexpand (pp-last-sexp))))
+ (insert (pp-to-string (macroexpand-1 (pp-last-sexp))))
(pp-macroexpand-expression (pp-last-sexp))))
;;; Test cases for quote
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index d463bfac412..a499b038b93 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -1,6 +1,6 @@
;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index de9966c0af0..e315733e222 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -1,9 +1,9 @@
;;; regexp-opt.el --- generate efficient regexps to match strings
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: strings, regexps, extensions
;; This file is part of GNU Emacs.
@@ -92,7 +92,7 @@ is enclosed by at least one regexp grouping construct.
The returned regexp is typically more efficient than the equivalent regexp:
(let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
- (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
+ (concat open (mapconcat \\='regexp-quote STRINGS \"\\\\|\") close))
If PAREN is `words', then the resulting regexp is additionally surrounded
by \\=\\< and \\>.
@@ -143,7 +143,7 @@ If LAX non-nil, don't output parentheses if it doesn't require them.
Merges keywords to avoid backtracking in Emacs's regexp matcher."
;; The basic idea is to find the shortest common prefix or suffix, remove it
;; and recurse. If there is no prefix, we divide the list into two so that
- ;; \(at least) one half will have at least a one-character common prefix.
+ ;; (at least) one half will have at least a one-character common prefix.
;; Also we delay the addition of grouping parenthesis as long as possible
;; until we're sure we need them, and try to remove one-character sequences
@@ -205,9 +205,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher."
(regexp-opt-group suffixes t t)
close-group))
- (let* ((sgnirts (mapcar (lambda (s)
- (concat (nreverse (string-to-list s))))
- strings))
+ (let* ((sgnirts (mapcar #'reverse strings))
(xiffus (try-completion "" sgnirts)))
(if (> (length xiffus) 0)
;; common suffix: take it and recurse on the prefixes.
@@ -218,8 +216,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher."
'string-lessp)))
(concat open-group
(regexp-opt-group prefixes t t)
- (regexp-quote
- (concat (nreverse (string-to-list xiffus))))
+ (regexp-quote (nreverse xiffus))
close-group))
;; Otherwise, divide the list into those that start with a
@@ -285,7 +282,9 @@ CHARS should be a list of characters."
;;
;; Make sure a caret is not first and a dash is first or last.
(if (and (string-equal charset "") (string-equal bracket ""))
- (concat "[" dash caret "]")
+ (if (string-equal dash "")
+ "\\^" ; [^] is not a valid regexp
+ (concat "[" dash caret "]"))
(concat "[" bracket charset caret dash "]"))))
(provide 'regexp-opt)
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 9514ee62485..2b317f6e253 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,6 +1,6 @@
;;; regi.el --- REGular expression Interpreting engine
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Maintainer: bwarsaw@cen.com
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index f2c4389e71f..2447dfa8e38 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -1,8 +1,8 @@
;;; ring.el --- handle rings of items
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index e578298106d..a5ff9722698 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,9 +1,9 @@
;;; rx.el --- sexp notation for regular expressions
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: strings, regexps, extensions
;; This file is part of GNU Emacs.
@@ -258,7 +258,8 @@ regular expressions.")
(not-at-end-of-line . ?<)
(not-at-beginning-of-line . ?>)
(alpha-numeric-two-byte . ?A)
- (chinse-two-byte . ?C)
+ (chinese-two-byte . ?C)
+ (chinse-two-byte . ?C) ;; A typo in Emacs 21.1-24.3.
(greek-two-byte . ?G)
(japanese-hiragana-two-byte . ?H)
(indian-two-byte . ?I)
@@ -767,8 +768,8 @@ of all atomic regexps."
((= l 3) (string-match "\\`\\(?:\\\\[cCsS_]\\|\\[[^^]\\]\\)" r))
((null lax)
(cond
- ((string-match "\\`\\[^?\]?\\(?:\\[:[a-z]+:]\\|[^\]]\\)*\\]\\'" r))
- ((string-match "\\`\\\\(\\(?:[^\\]\\|\\\\[^\)]\\)*\\\\)\\'" r)))))))
+ ((string-match "\\`\\[^?\]?\\(?:\\[:[a-z]+:]\\|[^]]\\)*\\]\\'" r))
+ ((string-match "\\`\\\\(\\(?:[^\\]\\|\\\\[^)]\\)*\\\\)\\'" r)))))))
(defun rx-syntax (form)
@@ -814,9 +815,9 @@ of all atomic regexps."
(defun rx-greedy (form)
"Parse and produce code from FORM.
-If FORM is '(minimal-match FORM1)', non-greedy versions of `*',
+If FORM is `(minimal-match FORM1)', non-greedy versions of `*',
`+', and `?' operators will be used in FORM1. If FORM is
-'(maximal-match FORM1)', greedy operators will be used."
+`(maximal-match FORM1)', greedy operators will be used."
(rx-check form)
(let ((rx-greedy-flag (eq (car form) 'maximal-match)))
(rx-form (cadr form) rx-parent)))
@@ -871,7 +872,7 @@ NO-GROUP non-nil means don't put shy groups around the result."
REGEXPS is a non-empty sequence of forms of the sort listed below.
Note that `rx' is a Lisp macro; when used in a Lisp program being
- compiled, the translation is performed by the compiler.
+compiled, the translation is performed by the compiler.
See `rx-to-string' for how to do such a translation at run-time.
The following are valid subforms of regular expressions in sexp
@@ -964,20 +965,20 @@ CHAR
matches space and tab only.
`graphic', `graph'
- matches graphic characters--everything except ASCII control chars,
- space, and DEL.
+ matches graphic characters--everything except whitespace, ASCII
+ and non-ASCII control characters, surrogates, and codepoints
+ unassigned by Unicode.
`printing', `print'
- matches printing characters--everything except ASCII control chars
- and DEL.
+ matches whitespace and graphic characters.
`alphanumeric', `alnum'
- matches letters and digits. (But at present, for multibyte characters,
- it matches anything that has word syntax.)
+ matches alphabetic characters and digits. (For multibyte characters,
+ it matches according to Unicode character properties.)
`letter', `alphabetic', `alpha'
- matches letters. (But at present, for multibyte characters,
- it matches anything that has word syntax.)
+ matches alphabetic characters. (For multibyte characters,
+ it matches according to Unicode character properties.)
`ascii'
matches ASCII (unibyte) characters.
@@ -1045,7 +1046,7 @@ CHAR
`not-at-end-of-line' (\\c<)
`not-at-beginning-of-line' (\\c>)
`alpha-numeric-two-byte' (\\cA)
- `chinse-two-byte' (\\cC)
+ `chinese-two-byte' (\\cC)
`greek-two-byte' (\\cG)
`japanese-hiragana-two-byte' (\\cH)
`indian-tow-byte' (\\cI)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
new file mode 100644
index 00000000000..68265094c17
--- /dev/null
+++ b/lisp/emacs-lisp/seq.el
@@ -0,0 +1,487 @@
+;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Keywords: sequences
+;; Version: 2.2
+;; Package: seq
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Sequence-manipulation functions that complement basic functions
+;; provided by subr.el.
+;;
+;; All functions are prefixed with "seq-".
+;;
+;; All provided functions work on lists, strings and vectors.
+;;
+;; Functions taking a predicate or iterating over a sequence using a
+;; function as argument take the function as their first argument and
+;; the sequence as their second argument. All other functions take
+;; the sequence as their first argument.
+;;
+;; While seq.el version 1.8 is in GNU ELPA for convenience, seq.el
+;; version 2.0 requires Emacs>=25.1.
+;;
+;; seq.el can be extended to support new type of sequences. Here are
+;; the generic functions that must be implemented by new seq types:
+;; - `seq-elt'
+;; - `seq-length'
+;; - `seq-do'
+;; - `seq-p'
+;; - `seq-subseq'
+;; - `seq-into-sequence'
+;; - `seq-copy'
+;; - `seq-into'
+;;
+;; All functions are tested in test/automated/seq-tests.el
+
+;;; Code:
+
+(eval-when-compile (require 'cl-generic))
+(require 'cl-extra) ;; for cl-subseq
+
+(defmacro seq-doseq (spec &rest body)
+ "Loop over a sequence.
+Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
+
+Similar to `dolist' but can be applied to lists, strings, and vectors.
+
+\(fn (VAR SEQUENCE) BODY...)"
+ (declare (indent 1) (debug ((symbolp form &optional form) body)))
+ `(seq-do (lambda (,(car spec))
+ ,@body)
+ ,(cadr spec)))
+
+(pcase-defmacro seq (&rest patterns)
+ "Build a `pcase' pattern that matches elements of SEQUENCE.
+
+The `pcase' pattern will match each element of PATTERNS against the
+corresponding element of SEQUENCE.
+
+Extra elements of the sequence are ignored if fewer PATTERNS are
+given, and the match does not fail."
+ `(and (pred seq-p)
+ ,@(seq--make-pcase-bindings patterns)))
+
+(defmacro seq-let (args sequence &rest body)
+ "Bind the variables in ARGS to the elements of SEQUENCE, then evaluate BODY.
+
+ARGS can also include the `&rest' marker followed by a variable
+name to be bound to the rest of SEQUENCE."
+ (declare (indent 2) (debug t))
+ `(pcase-let ((,(seq--make-pcase-patterns args) ,sequence))
+ ,@body))
+
+
+;;; Basic seq functions that have to be implemented by new sequence types
+(cl-defgeneric seq-elt (sequence n)
+ "Return Nth element of SEQUENCE."
+ (elt sequence n))
+
+;; Default gv setters for `seq-elt'.
+;; It can be a good idea for new sequence implementations to provide a
+;; "gv-setter" for `seq-elt'.
+(cl-defmethod (setf seq-elt) (store (sequence array) n)
+ (aset sequence n store))
+
+(cl-defmethod (setf seq-elt) (store (sequence cons) n)
+ (setcar (nthcdr n sequence) store))
+
+(cl-defgeneric seq-length (sequence)
+ "Return the number of elements of SEQUENCE."
+ (length sequence))
+
+(cl-defgeneric seq-do (function sequence)
+ "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
+Return SEQUENCE."
+ (mapc function sequence))
+
+(defalias 'seq-each #'seq-do)
+
+(cl-defgeneric seq-p (sequence)
+ "Return non-nil if SEQUENCE is a sequence, nil otherwise."
+ (sequencep sequence))
+
+(cl-defgeneric seq-copy (sequence)
+ "Return a shallow copy of SEQUENCE."
+ (copy-sequence sequence))
+
+(cl-defgeneric seq-subseq (sequence start &optional end)
+ "Return the sequence of elements of SEQUENCE from START to END.
+END is inclusive.
+
+If END is omitted, it defaults to the length of the sequence. If
+START or END is negative, it counts from the end. Signal an
+error if START or END are outside of the sequence (i.e too large
+if positive or too small if negative)."
+ (cl-subseq sequence start end))
+
+
+(cl-defgeneric seq-map (function sequence)
+ "Return the result of applying FUNCTION to each element of SEQUENCE."
+ (let (result)
+ (seq-do (lambda (elt)
+ (push (funcall function elt) result))
+ sequence)
+ (nreverse result)))
+
+;; faster implementation for sequences (sequencep)
+(cl-defmethod seq-map (function (sequence sequence))
+ (mapcar function sequence))
+
+(cl-defgeneric seq-mapn (function sequence &rest sequences)
+ "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
+The arity of FUNCTION must match the number of SEQUENCES, and the
+mapping stops on the shortest sequence.
+Return a list of the results.
+
+\(fn FUNCTION SEQUENCES...)"
+ (let ((result nil)
+ (sequences (seq-map (lambda (s) (seq-into s 'list))
+ (cons sequence sequences))))
+ (while (not (memq nil sequences))
+ (push (apply function (seq-map #'car sequences)) result)
+ (setq sequences (seq-map #'cdr sequences)))
+ (nreverse result)))
+
+(cl-defgeneric seq-drop (sequence n)
+ "Remove the first N elements of SEQUENCE and return the result.
+The result is a sequence of the same type as SEQUENCE.
+
+If N is a negative integer or zero, SEQUENCE is returned."
+ (if (<= n 0)
+ sequence
+ (let ((length (seq-length sequence)))
+ (seq-subseq sequence (min n length) length))))
+
+(cl-defgeneric seq-take (sequence n)
+ "Take the first N elements of SEQUENCE and return the result.
+The result is a sequence of the same type as SEQUENCE.
+
+If N is a negative integer or zero, an empty sequence is
+returned."
+ (seq-subseq sequence 0 (min (max n 0) (seq-length sequence))))
+
+(cl-defgeneric seq-drop-while (pred sequence)
+ "Remove the successive elements of SEQUENCE for which PRED returns non-nil.
+PRED is a function of one argument. The result is a sequence of
+the same type as SEQUENCE."
+ (seq-drop sequence (seq--count-successive pred sequence)))
+
+(cl-defgeneric seq-take-while (pred sequence)
+ "Take the successive elements of SEQUENCE for which PRED returns non-nil.
+PRED is a function of one argument. The result is a sequence of
+the same type as SEQUENCE."
+ (seq-take sequence (seq--count-successive pred sequence)))
+
+(cl-defgeneric seq-empty-p (sequence)
+ "Return non-nil if the SEQUENCE is empty, nil otherwise."
+ (= 0 (seq-length sequence)))
+
+(cl-defgeneric seq-sort (pred sequence)
+ "Sort SEQUENCE using PRED as comparison function.
+The result is a sequence of the same type as SEQUENCE."
+ (let ((result (seq-sort pred (append sequence nil))))
+ (seq-into result (type-of sequence))))
+
+(cl-defmethod seq-sort (pred (list list))
+ (sort (seq-copy list) pred))
+
+(cl-defgeneric seq-reverse (sequence)
+ "Return a sequence with elements of SEQUENCE in reverse order."
+ (let ((result '()))
+ (seq-map (lambda (elt)
+ (push elt result))
+ sequence)
+ (seq-into result (type-of sequence))))
+
+;; faster implementation for sequences (sequencep)
+(cl-defmethod seq-reverse ((sequence sequence))
+ (reverse sequence))
+
+(cl-defgeneric seq-concatenate (type &rest sequences)
+ "Concatenate SEQUENCES into a single sequence of type TYPE.
+TYPE must be one of following symbols: vector, string or list.
+
+\n(fn TYPE SEQUENCE...)"
+ (apply #'cl-concatenate type (seq-map #'seq-into-sequence sequences)))
+
+(cl-defgeneric seq-into-sequence (sequence)
+ "Convert SEQUENCE into a sequence.
+
+The default implementation is to signal an error if SEQUENCE is not a
+sequence, specific functions should be implemented for new types
+of sequence."
+ (unless (sequencep sequence)
+ (error "Cannot convert %S into a sequence" sequence))
+ sequence)
+
+(cl-defgeneric seq-into (sequence type)
+ "Concatenate the elements of SEQUENCE into a sequence of type TYPE.
+TYPE can be one of the following symbols: vector, string or
+list."
+ (pcase type
+ (`vector (vconcat sequence))
+ (`string (concat sequence))
+ (`list (append sequence nil))
+ (_ (error "Not a sequence type name: %S" type))))
+
+(cl-defgeneric seq-filter (pred sequence)
+ "Return a list of all the elements for which (PRED element) is non-nil in SEQUENCE."
+ (let ((exclude (make-symbol "exclude")))
+ (delq exclude (seq-map (lambda (elt)
+ (if (funcall pred elt)
+ elt
+ exclude))
+ sequence))))
+
+(cl-defgeneric seq-remove (pred sequence)
+ "Return a list of all the elements for which (PRED element) is nil in SEQUENCE."
+ (seq-filter (lambda (elt) (not (funcall pred elt)))
+ sequence))
+
+(cl-defgeneric seq-reduce (function sequence initial-value)
+ "Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
+
+Return the result of calling FUNCTION with INITIAL-VALUE and the
+first element of SEQUENCE, then calling FUNCTION with that result and
+the second element of SEQUENCE, then with that result and the third
+element of SEQUENCE, etc.
+
+If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
+ (if (seq-empty-p sequence)
+ initial-value
+ (let ((acc initial-value))
+ (seq-doseq (elt sequence)
+ (setq acc (funcall function acc elt)))
+ acc)))
+
+(cl-defgeneric seq-every-p (pred sequence)
+ "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
+ (catch 'seq--break
+ (seq-doseq (elt sequence)
+ (or (funcall pred elt)
+ (throw 'seq--break nil)))
+ t))
+
+(cl-defgeneric seq-some (pred sequence)
+ "Return the first value for which if (PRED element) is non-nil for in SEQUENCE."
+ (catch 'seq--break
+ (seq-doseq (elt sequence)
+ (let ((result (funcall pred elt)))
+ (when result
+ (throw 'seq--break result))))
+ nil))
+
+(cl-defgeneric seq-find (pred sequence &optional default)
+ "Return the first element for which (PRED element) is non-nil in SEQUENCE.
+If no element is found, return DEFAULT.
+
+Note that `seq-find' has an ambiguity if the found element is
+identical to DEFAULT, as it cannot be known if an element was
+found or not."
+ (catch 'seq--break
+ (seq-doseq (elt sequence)
+ (when (funcall pred elt)
+ (throw 'seq--break elt)))
+ default))
+
+(cl-defgeneric seq-count (pred sequence)
+ "Return the number of elements for which (PRED element) is non-nil in SEQUENCE."
+ (let ((count 0))
+ (seq-doseq (elt sequence)
+ (when (funcall pred elt)
+ (setq count (+ 1 count))))
+ count))
+
+(cl-defgeneric seq-contains (sequence elt &optional testfn)
+ "Return the first element in SEQUENCE that is equal to ELT.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (seq-some (lambda (e)
+ (funcall (or testfn #'equal) elt e))
+ sequence))
+
+(cl-defgeneric seq-position (sequence elt &optional testfn)
+ "Return the index of the first element in SEQUENCE that is equal to ELT.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (let ((index 0))
+ (catch 'seq--break
+ (seq-doseq (e sequence)
+ (when (funcall (or testfn #'equal) e elt)
+ (throw 'seq--break index))
+ (setq index (1+ index)))
+ nil)))
+
+(cl-defgeneric seq-uniq (sequence &optional testfn)
+ "Return a list of the elements of SEQUENCE with duplicates removed.
+TESTFN is used to compare elements, or `equal' if TESTFN is nil."
+ (let ((result '()))
+ (seq-doseq (elt sequence)
+ (unless (seq-contains result elt testfn)
+ (setq result (cons elt result))))
+ (nreverse result)))
+
+(cl-defgeneric seq-mapcat (function sequence &optional type)
+ "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
+The result is a sequence of type TYPE, or a list if TYPE is nil."
+ (apply #'seq-concatenate (or type 'list)
+ (seq-map function sequence)))
+
+(cl-defgeneric seq-partition (sequence n)
+ "Return a list of the elements of SEQUENCE grouped into sub-sequences of length N.
+The last sequence may contain less than N elements. If N is a
+negative integer or 0, nil is returned."
+ (unless (< n 1)
+ (let ((result '()))
+ (while (not (seq-empty-p sequence))
+ (push (seq-take sequence n) result)
+ (setq sequence (seq-drop sequence n)))
+ (nreverse result))))
+
+(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
+ "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (seq-reduce (lambda (acc elt)
+ (if (seq-contains sequence2 elt testfn)
+ (cons elt acc)
+ acc))
+ (seq-reverse sequence1)
+ '()))
+
+(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
+ "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
+Equality is defined by TESTFN if non-nil or by `equal' if nil."
+ (seq-reduce (lambda (acc elt)
+ (if (not (seq-contains sequence2 elt testfn))
+ (cons elt acc)
+ acc))
+ (seq-reverse sequence1)
+ '()))
+
+(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
+keys. Keys are compared using `equal'."
+ (seq-reduce
+ (lambda (acc elt)
+ (let* ((key (funcall function elt))
+ (cell (assoc key acc)))
+ (if cell
+ (setcdr cell (push elt (cdr cell)))
+ (push (list key elt) acc))
+ acc))
+ (seq-reverse sequence)
+ nil))
+
+(cl-defgeneric seq-min (sequence)
+ "Return the smallest element of SEQUENCE.
+SEQUENCE must be a sequence of numbers or markers."
+ (apply #'min (seq-into sequence 'list)))
+
+(cl-defgeneric seq-max (sequence)
+ "Return the largest element of SEQUENCE.
+SEQUENCE must be a sequence of numbers or markers."
+ (apply #'max (seq-into sequence 'list)))
+
+(defun seq--count-successive (pred sequence)
+ "Return the number of successive elements for which (PRED element) is non-nil in SEQUENCE."
+ (let ((n 0)
+ (len (seq-length sequence)))
+ (while (and (< n len)
+ (funcall pred (seq-elt sequence n)))
+ (setq n (+ 1 n)))
+ n))
+
+(defun seq--make-pcase-bindings (args)
+ "Return a list of bindings of the variables in ARGS to the elements of a sequence."
+ (let ((bindings '())
+ (index 0)
+ (rest-marker nil))
+ (seq-doseq (name args)
+ (unless rest-marker
+ (pcase name
+ (`&rest
+ (progn (push `(app (pcase--flip seq-drop ,index)
+ ,(seq--elt-safe args (1+ index)))
+ bindings)
+ (setq rest-marker t)))
+ (_
+ (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings))))
+ (setq index (1+ index)))
+ bindings))
+
+(defun seq--make-pcase-patterns (args)
+ "Return a list of `(seq ...)' pcase patterns from the argument list ARGS."
+ (cons 'seq
+ (seq-map (lambda (elt)
+ (if (seq-p elt)
+ (seq--make-pcase-patterns elt)
+ elt))
+ args)))
+
+;; TODO: make public?
+(defun seq--elt-safe (sequence n)
+ "Return element of SEQUENCE at the index N.
+If no element is found, return nil."
+ (ignore-errors (seq-elt sequence n)))
+
+
+;;; Optimized implementations for lists
+
+(cl-defmethod seq-drop ((list list) n)
+ "Optimized implementation of `seq-drop' for lists."
+ (while (and list (> n 0))
+ (setq list (cdr list)
+ n (1- n)))
+ list)
+
+(cl-defmethod seq-take ((list list) n)
+ "Optimized implementation of `seq-take' for lists."
+ (let ((result '()))
+ (while (and list (> n 0))
+ (setq n (1- n))
+ (push (pop list) result))
+ (nreverse result)))
+
+(cl-defmethod seq-drop-while (pred (list list))
+ "Optimized implementation of `seq-drop-while' for lists."
+ (while (and list (funcall pred (car list)))
+ (setq list (cdr list)))
+ list)
+
+(cl-defmethod seq-empty-p ((list list))
+ "Optimized implementation of `seq-empty-p' for lists."
+ (null list))
+
+
+(defun seq--activate-font-lock-keywords ()
+ "Activate font-lock keywords for some symbols defined in seq."
+ (font-lock-add-keywords 'emacs-lisp-mode
+ '("\\<seq-doseq\\>" "\\<seq-let\\>")))
+
+(unless (fboundp 'elisp--font-lock-flush-elisp-buffers)
+ ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others)
+ ;; we automatically highlight macros.
+ (add-hook 'emacs-lisp-mode-hook #'seq--activate-font-lock-keywords))
+
+(provide 'seq)
+;;; seq.el ends here
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index d0e3c5763b5..229bb587488 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,6 +1,6 @@
;;; shadow.el --- locate Emacs Lisp file shadowings
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Terry Jones <terry@santafe.edu>
;; Keywords: lisp
@@ -45,7 +45,7 @@
;;
;; emacs -batch -f list-load-path-shadows
;;
-;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
+;; Thanks to Francesco Potortì <pot@cnuce.cnr.it> for suggestions,
;; rewritings & speedups.
;;; Code:
@@ -68,9 +68,9 @@ This is slower, but filters out some innocuous shadowing."
"Return a list of Emacs Lisp files that create shadows.
This function does the work for `list-load-path-shadows'.
-We traverse PATH looking for shadows, and return a \(possibly empty\)
+We traverse PATH looking for shadows, and return a \(possibly empty)
even-length list of files. A file in this list at position 2i shadows
-the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc\)
+the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc)
are stripped from the file names in the list.
See the documentation for `list-load-path-shadows' for further information."
@@ -115,7 +115,9 @@ See the documentation for `list-load-path-shadows' for further information."
;; FILE now contains the current file name, with no suffix.
(unless (or (member file files-seen-this-dir)
;; Ignore these files.
- (member file '("subdirs" "leim-list")))
+ (member file (list "subdirs" "leim-list"
+ (file-name-sans-extension
+ dir-locals-file))))
;; File has not been seen yet in this directory.
;; This test prevents us declaring that XXX.el shadows
;; XXX.elc (or vice-versa) when they are in the same directory.
@@ -211,7 +213,7 @@ For example, suppose `load-path' is set to
and that each of these directories contains a file called XXX.el. Then
XXX.el in the site-lisp directory is referred to by all of:
-\(require 'XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
+\(require \\='XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
The first XXX.el file prevents Emacs from seeing the second (unless
the second is loaded explicitly via `load-file').
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index f9d0fd9366b..738bdddcddf 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1,6 +1,6 @@
;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: languages, lisp, internal, parsing, indentation
@@ -169,13 +169,13 @@
(cl-incf smie-warning-count))
(puthash key val table))))
-(put 'smie-precs->prec2 'pure t)
(defun smie-precs->prec2 (precs)
"Compute a 2D precedence table from a list of precedences.
PRECS should be a list, sorted by precedence (e.g. \"+\" will
come before \"*\"), of elements of the form \(left OP ...)
or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in
one of those elements share the same precedence level and associativity."
+ (declare (pure t))
(let ((prec2-table (make-hash-table :test 'equal)))
(dolist (prec precs)
(dolist (op (cdr prec))
@@ -193,8 +193,8 @@ one of those elements share the same precedence level and associativity."
(smie-set-prec2tab prec2-table other-op op op1)))))))
prec2-table))
-(put 'smie-merge-prec2s 'pure t)
(defun smie-merge-prec2s (&rest tables)
+ (declare (pure t))
(if (null (cdr tables))
(car tables)
(let ((prec2 (make-hash-table :test 'equal)))
@@ -209,11 +209,10 @@ one of those elements share the same precedence level and associativity."
table))
prec2)))
-(put 'smie-bnf->prec2 'pure t)
(defun smie-bnf->prec2 (bnf &rest resolvers)
"Convert the BNF grammar into a prec2 table.
BNF is a list of nonterminal definitions of the form:
- \(NONTERM RHS1 RHS2 ...)
+ (NONTERM RHS1 RHS2 ...)
where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals.
Not all grammars are accepted:
- an RHS cannot be an empty list (this is not needed, since SMIE allows all
@@ -232,6 +231,7 @@ Conflicts can be resolved via RESOLVERS, which is a list of elements that can
be either:
- a precs table (see `smie-precs->prec2') to resolve conflicting constraints,
- a constraint (T1 REL T2) where REL is one of = < or >."
+ (declare (pure t))
;; FIXME: Add repetition operator like (repeat <separator> <elems>).
;; Maybe also add (or <elem1> <elem2>...) for things like
;; (exp (exp (or "+" "*" "=" ..) exp)).
@@ -503,11 +503,11 @@ CSTS is a list of pairs representing arcs in a graph."
;; (t (cl-assert (eq v '=))))))))
;; prec2))
-(put 'smie-prec2->grammar 'pure t)
(defun smie-prec2->grammar (prec2)
"Take a 2D precedence table and turn it into an alist of precedence levels.
PREC2 is a table as returned by `smie-precs->prec2' or
`smie-bnf->prec2'."
+ (declare (pure t))
;; For each operator, we create two "variables" (corresponding to
;; the left and right precedence level), which are represented by
;; cons cells. Those are the very cons cells that appear in the
@@ -612,8 +612,11 @@ PREC2 is a table as returned by `smie-precs->prec2' or
(cons (pcase (cdr x)
(`closer (cddr (assoc token table)))
(`opener (cdr (assoc token table))))))
- (cl-assert (numberp (car cons)))
- (setf (car cons) (list (car cons)))))
+ ;; `cons' can be nil for openers/closers which only contain
+ ;; "atomic" elements.
+ (when cons
+ (cl-assert (numberp (car cons)))
+ (setf (car cons) (list (car cons))))))
(let ((ca (gethash :smie-closer-alist prec2)))
(when ca (push (cons :smie-closer-alist ca) table)))
;; (smie-check-grammar table prec2 'step3)
@@ -632,14 +635,14 @@ e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like
an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something
like a close-paren.")
-(defvar smie-forward-token-function 'smie-default-forward-token
+(defvar smie-forward-token-function #'smie-default-forward-token
"Function to scan forward for the next token.
Called with no argument should return a token and move to its end.
If no token is found, return nil or the empty string.
It can return nil when bumping into a parenthesis, which lets SMIE
use syntax-tables to handle them in efficient C code.")
-(defvar smie-backward-token-function 'smie-default-backward-token
+(defvar smie-backward-token-function #'smie-default-backward-token
"Function to scan backward the previous token.
Same calling convention as `smie-forward-token-function' except
it should move backward to the beginning of the previous token.")
@@ -707,13 +710,16 @@ Possible return values:
((null toklevels)
(when (zerop (length token))
(condition-case err
- (progn (goto-char pos) (funcall next-sexp 1) nil)
+ (progn (funcall next-sexp 1) nil)
(scan-error
- (let ((pos (nth 2 err)))
+ (let* ((epos1 (nth 2 err))
+ (epos (if (<= (point) epos1) (nth 3 err) epos1)))
+ (goto-char pos)
(throw 'return
- (list t pos
+ (list t epos
(buffer-substring-no-properties
- pos (+ pos (if (< (point) pos) -1 1))))))))
+ epos
+ (+ epos (if (< (point) epos) -1 1))))))))
(if (eq pos (point))
;; We did not move, so let's abort the loop.
(throw 'return (list t (point))))))
@@ -803,9 +809,9 @@ Possible return values:
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
(indirect-function smie-backward-token-function)
- (indirect-function 'backward-sexp)
- (indirect-function 'smie-op-left)
- (indirect-function 'smie-op-right)
+ (indirect-function #'backward-sexp)
+ (indirect-function #'smie-op-left)
+ (indirect-function #'smie-op-right)
halfsexp))
(defun smie-forward-sexp (&optional halfsexp)
@@ -824,19 +830,19 @@ Possible return values:
nil: we skipped over an identifier, matched parentheses, ..."
(smie-next-sexp
(indirect-function smie-forward-token-function)
- (indirect-function 'forward-sexp)
- (indirect-function 'smie-op-right)
- (indirect-function 'smie-op-left)
+ (indirect-function #'forward-sexp)
+ (indirect-function #'smie-op-right)
+ (indirect-function #'smie-op-left)
halfsexp))
;;; Miscellaneous commands using the precedence parser.
-(defun smie-backward-sexp-command (&optional n)
+(defun smie-backward-sexp-command (n)
"Move backward through N logical elements."
(interactive "^p")
(smie-forward-sexp-command (- n)))
-(defun smie-forward-sexp-command (&optional n)
+(defun smie-forward-sexp-command (n)
"Move forward through N logical elements."
(interactive "^p")
(let ((forw (> n 0))
@@ -1060,10 +1066,12 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
(defun smie--matching-block-data (orig &rest args)
"A function suitable for `show-paren-data-function' (which see)."
(if (or (null smie-closer-alist)
- (eq (point) (car smie--matching-block-data-cache)))
+ (equal (cons (point) (buffer-chars-modified-tick))
+ (car smie--matching-block-data-cache)))
(or (cdr smie--matching-block-data-cache)
(apply orig args))
- (setq smie--matching-block-data-cache (list (point)))
+ (setq smie--matching-block-data-cache
+ (list (cons (point) (buffer-chars-modified-tick))))
(unless (nth 8 (syntax-ppss))
(condition-case nil
(let ((here (smie--opener/closer-at-point)))
@@ -1106,7 +1114,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
(nth 1 there) (nth 2 there)
(not (nth 0 there)))))))
(scan-error nil))
- (goto-char (car smie--matching-block-data-cache)))
+ (goto-char (caar smie--matching-block-data-cache)))
(apply #'smie--matching-block-data orig args)))
;;; The indentation engine.
@@ -1116,7 +1124,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
:type 'integer
:group 'smie)
-(defvar smie-rules-function 'ignore
+(defvar smie-rules-function #'ignore
"Function providing the indentation rules.
It takes two arguments METHOD and ARG where the meaning of ARG
and the expected return value depends on METHOD.
@@ -1128,9 +1136,15 @@ METHOD can be:
- :elem, in which case the function should return either:
- the offset to use to indent function arguments (ARG = `arg')
- the basic indentation step (ARG = `basic').
+ - the token to use (when ARG = `empty-line-token') when we don't know how
+ to indent an empty line.
- :list-intro, in which case ARG is a token and the function should return
non-nil if TOKEN is followed by a list of expressions (not separated by any
token) rather than an expression.
+- :close-all, in which case ARG is a close-paren token at indentation and
+ the function should return non-nil if it should be aligned with the opener
+ of the last close-paren token on the same line, if there are multiple.
+ Otherwise, it will be aligned with its own opener.
When ARG is a token, the function is called with point just before that token.
A return value of nil always means to fallback on the default behavior, so the
@@ -1146,6 +1160,15 @@ NUMBER offset by NUMBER, relative to a base token
The functions whose name starts with \"smie-rule-\" are helper functions
designed specifically for use in this function.")
+(defvar smie--hanging-eolp-function
+ ;; FIXME: This is a quick hack for 24.4. Don't document it and replace with
+ ;; a well-defined function with a cleaner interface instead!
+ (lambda ()
+ (skip-chars-forward " \t")
+ (or (eolp)
+ (and ;; (looking-at comment-start-skip) ;(bug#16041).
+ (forward-comment (point-max))))))
+
(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
(defun smie-indent--hanging-p ()
"Return non-nil if the current token is \"hanging\".
@@ -1159,10 +1182,7 @@ the beginning of a line."
(not (eobp))
;; Could be an open-paren.
(forward-char 1))
- (skip-chars-forward " \t")
- (or (eolp)
- (and (looking-at comment-start-skip)
- (forward-comment (point-max))))
+ (funcall smie--hanging-eolp-function)
(point))))))
(defalias 'smie-rule-bolp 'smie-indent--bolp)
@@ -1180,6 +1200,21 @@ Comments are treated as spaces."
(forward-comment (- (point)))
(<= (point) bol))))
+(defun smie-indent--current-column ()
+ "Like `current-column', but if there's a comment before us, use that."
+ ;; This is used, so that when we align elements, we don't get
+ ;; toto = { /* foo, */ a,
+ ;; b }
+ ;; but
+ ;; toto = { /* foo, */ a,
+ ;; b }
+ (let ((pos (point))
+ (lbp (line-beginning-position)))
+ (save-excursion
+ (unless (and (forward-comment -1) (>= (point) lbp))
+ (goto-char pos))
+ (current-column))))
+
;; Dynamically scoped.
(defvar smie--parent) (defvar smie--after) (defvar smie--token)
@@ -1232,14 +1267,7 @@ Only meaningful when called from within `smie-rules-function'."
(goto-char (cadr (smie-indent--parent)))
(cons 'column
(+ (or offset 0)
- ;; Use smie-indent-virtual when indenting relative to an opener:
- ;; this will also by default use current-column unless
- ;; that opener is hanging, but will additionally consult
- ;; rules-function, so it gives it a chance to tweak
- ;; indentation (e.g. by forcing indentation relative to
- ;; its own parent, as in fn a => fn b => fn c =>).
- (if (or (listp (car smie--parent)) (smie-indent--hanging-p))
- (smie-indent-virtual) (current-column))))))
+ (smie-indent-virtual)))))
(defvar smie-rule-separator-outdent 2)
@@ -1319,8 +1347,8 @@ Only meaningful when called from within `smie-rules-function'."
(defun smie-indent--rule (method token
;; FIXME: Too many parameters.
&optional after parent base-pos)
- "Compute indentation column according to `indent-rule-functions'.
-METHOD and TOKEN are passed to `indent-rule-functions'.
+ "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.
PARENT is the parent info returned by `smie-backward-sexp', if known.
BASE-POS is the position relative to which offsets should be applied."
@@ -1333,11 +1361,7 @@ BASE-POS is the position relative to which offsets should be applied."
;; - :after tok, where
;; ; after is set; parent=nil; base-pos=point;
(save-excursion
- (let ((offset
- (let ((smie--parent parent)
- (smie--token token)
- (smie--after after))
- (funcall smie-rules-function method token))))
+ (let ((offset (smie-indent--rule-1 method token after parent)))
(cond
((not offset) nil)
((eq (car-safe offset) 'column) (cdr offset))
@@ -1358,6 +1382,12 @@ BASE-POS is the position relative to which offsets should be applied."
(smie-indent-virtual) (current-column)))))
(t (error "Unknown indentation offset %s" offset))))))
+(defun smie-indent--rule-1 (method token &optional after parent)
+ (let ((smie--parent parent)
+ (smie--token token)
+ (smie--after after))
+ (funcall smie-rules-function method token)))
+
(defun smie-indent-forward-token ()
"Skip token forward and return it, along with its levels."
(let ((tok (funcall smie-forward-token-function)))
@@ -1365,9 +1395,9 @@ BASE-POS is the position relative to which offsets should be applied."
((< 0 (length tok)) (assoc tok smie-grammar))
((looking-at "\\s(\\|\\s)\\(\\)")
(forward-char 1)
- (cons (buffer-substring (1- (point)) (point))
+ (cons (buffer-substring-no-properties (1- (point)) (point))
(if (match-end 1) '(0 nil) '(nil 0))))
- ((looking-at "\\s\"")
+ ((looking-at "\\s\"\\|\\s|")
(forward-sexp 1)
nil)
((eobp) nil)
@@ -1382,9 +1412,9 @@ BASE-POS is the position relative to which offsets should be applied."
;; 4 == open paren syntax, 5 == close.
((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5))
(forward-char -1)
- (cons (buffer-substring (point) (1+ (point)))
+ (cons (buffer-substring-no-properties (point) (1+ (point)))
(if (eq class 4) '(nil 0) '(0 nil))))
- ((eq class 7)
+ ((memq class '(7 15))
(backward-sexp 1)
nil)
((bobp) nil)
@@ -1426,8 +1456,13 @@ in order to figure out the indentation of some other (further down) point."
(save-excursion
;; (forward-comment (point-max))
(when (looking-at "\\s)")
- (while (not (zerop (skip-syntax-forward ")")))
- (skip-chars-forward " \t"))
+ (if (smie-indent--rule-1 :close-all
+ (buffer-substring-no-properties
+ (point) (1+ (point)))
+ (1+ (point)))
+ (while (not (zerop (skip-syntax-forward ")")))
+ (skip-chars-forward " \t"))
+ (forward-char 1))
(condition-case nil
(progn
(backward-sexp 1)
@@ -1559,7 +1594,9 @@ should not be computed on the basis of the following token."
;; So we use a heuristic here, which is that we only use virtual
;; if the parent is tightly linked to the child token (they're
;; part of the same BNF rule).
- (if (car parent) (current-column) (smie-indent-virtual)))))))))))
+ (if (car parent)
+ (smie-indent--current-column)
+ (smie-indent-virtual)))))))))))
(defun smie-indent-comment ()
"Compute indentation of a comment."
@@ -1651,6 +1688,19 @@ should not be computed on the basis of the following token."
(+ (smie-indent-virtual) (smie-indent--offset 'basic))) ;
(t (smie-indent-virtual)))))) ;An infix.
+(defun smie-indent-empty-line ()
+ "Indentation rule when there's nothing yet on the line."
+ ;; Without this rule, SMIE assumes that an empty line will be filled with an
+ ;; argument (since it falls back to smie-indent-sexps), which tends
+ ;; to indent far too deeply.
+ (when (eolp)
+ (let ((token (or (funcall smie-rules-function :elem 'empty-line-token)
+ ;; FIXME: Should we default to ";"?
+ ;; ";"
+ )))
+ (when (assoc token smie-grammar)
+ (smie-indent-keyword token)))))
+
(defun smie-indent-exps ()
;; Indentation of sequences of simple expressions without
;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f".
@@ -1689,12 +1739,12 @@ should not be computed on the basis of the following token."
;; There's a previous element, and it's not special (it's not
;; the function), so let's just align with that one.
(goto-char (car positions))
- (current-column))
+ (smie-indent--current-column))
((cdr positions)
;; We skipped some args plus the function and bumped into something.
;; Align with the first arg.
(goto-char (cadr positions))
- (current-column))
+ (smie-indent--current-column))
(positions
;; We're the first arg.
(goto-char (car positions))
@@ -1702,14 +1752,14 @@ should not be computed on the basis of the following token."
;; We used to use (smie-indent-virtual), but that
;; doesn't seem right since it might then indent args less than
;; the function itself.
- (current-column)))))))
+ (smie-indent--current-column)))))))
(defvar smie-indent-functions
'(smie-indent-fixindent smie-indent-bob smie-indent-close
smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
smie-indent-comment-inside smie-indent-inside-string
smie-indent-keyword smie-indent-after-keyword
- smie-indent-exps)
+ smie-indent-empty-line smie-indent-exps)
"Functions to compute the indentation.
Each function is called with no argument, shouldn't move point, and should
return either nil if it has no opinion, or an integer representing the column
@@ -1824,6 +1874,375 @@ KEYWORDS are additional arguments, which can use the following keywords:
(append smie-blink-matching-triggers
(delete-dups triggers)))))))
+(declare-function edebug-instrument-function "edebug" (func))
+
+(defun smie-edebug ()
+ "Instrument the `smie-rules-function' for Edebug."
+ (interactive)
+ (require 'edebug)
+ (if (symbolp smie-rules-function)
+ (edebug-instrument-function smie-rules-function)
+ (error "Sorry, don't know how to instrument a lambda expression")))
+
+(defun smie--next-indent-change ()
+ "Go to the next line that needs to be reindented (and reindent it)."
+ (interactive)
+ (while
+ (let ((tick (buffer-chars-modified-tick)))
+ (indent-according-to-mode)
+ (eq tick (buffer-chars-modified-tick)))
+ (forward-line 1)))
+
+;;; User configuration
+
+;; This is designed to be a completely independent "module", so we can play
+;; with various kinds of smie-config modules without having to change the core.
+
+;; This smie-config module is fairly primitive and suffers from serious
+;; restrictions:
+;; - You can only change a returned offset, so you can't change the offset
+;; passed to smie-rule-parent, nor can you change the object with which
+;; to align (in general).
+;; - The rewrite rule can only distinguish cases based on the kind+token arg
+;; and smie-rules-function's return value, so you can't distinguish cases
+;; where smie-rules-function returns the same value.
+;; - Since config-rules depend on the return value of smie-rules-function, any
+;; config change that modifies this return value (e.g. changing
+;; foo-indent-basic) ends up invalidating config-rules.
+;; This last one is a serious problem since it means that file-local
+;; config-rules will only work if the user hasn't changed foo-indent-basic.
+;; One possible way to change it is to modify smie-rules-functions so they can
+;; return special symbols like +, ++, -, etc. Or make them use a new
+;; smie-rule-basic function which can then be used to know when a returned
+;; offset was computed based on foo-indent-basic.
+
+(defvar-local smie-config--mode-local nil
+ "Indentation config rules installed for this major mode.
+Typically manipulated from the major-mode's hook.")
+(defvar-local smie-config--buffer-local nil
+ "Indentation config rules installed for this very buffer.
+E.g. provided via a file-local call to `smie-config-local'.")
+(defvar smie-config--trace nil
+ "Variable used to trace calls to `smie-rules-function'.")
+
+(defun smie-config--advice (orig kind token)
+ (let* ((ret (funcall orig kind token))
+ (sig (list kind token ret))
+ (brule (rassoc sig smie-config--buffer-local))
+ (mrule (rassoc sig smie-config--mode-local)))
+ (when smie-config--trace
+ (setq smie-config--trace (or brule mrule)))
+ (cond
+ (brule (car brule))
+ (mrule (car mrule))
+ (t ret))))
+
+(defun smie-config--mode-hook (rules)
+ (setq smie-config--mode-local
+ (append rules smie-config--mode-local))
+ (add-function :around (local 'smie-rules-function) #'smie-config--advice))
+
+(defvar smie-config--modefuns nil)
+
+(defun smie-config--setter (var value)
+ (setq-default var value)
+ (let ((old-modefuns smie-config--modefuns))
+ (setq smie-config--modefuns nil)
+ (pcase-dolist (`(,mode . ,rules) value)
+ (let ((modefunname (intern (format "smie-config--modefun-%s" mode))))
+ (fset modefunname (lambda () (smie-config--mode-hook rules)))
+ (push modefunname smie-config--modefuns)
+ (add-hook (intern (format "%s-hook" mode)) modefunname)))
+ ;; Neuter any left-over previously installed hook.
+ (dolist (modefun old-modefuns)
+ (unless (memq modefun smie-config--modefuns)
+ (fset modefun #'ignore)))))
+
+(defcustom smie-config nil
+ ;; FIXME: there should be a file-local equivalent.
+ "User configuration of SMIE indentation.
+This is a list of elements (MODE . RULES), where RULES is a list
+of elements describing when and how to change the indentation rules.
+Each RULE element should be of the form (NEW KIND TOKEN NORMAL),
+where KIND and TOKEN are the elements passed to `smie-rules-function',
+NORMAL is the value returned by `smie-rules-function' and NEW is the
+value with which to replace it."
+ :version "24.4"
+ ;; FIXME improve value-type.
+ :type '(choice (const nil)
+ (alist :key-type symbol))
+ :initialize 'custom-initialize-default
+ :set #'smie-config--setter)
+
+(defun smie-config-local (rules)
+ "Add RULES as local indentation rules to use in this buffer.
+These replace any previous local rules, but supplement the rules
+specified in `smie-config'."
+ (setq smie-config--buffer-local rules)
+ (add-function :around (local 'smie-rules-function) #'smie-config--advice))
+
+;; Make it so we can set those in the file-local block.
+;; FIXME: Better would be to be able to write "smie-config-local: (...)" rather
+;; than "eval: (smie-config-local '(...))".
+(put 'smie-config-local 'safe-local-eval-function t)
+
+(defun smie-config--get-trace ()
+ (save-excursion
+ (forward-line 0)
+ (skip-chars-forward " \t")
+ (let* ((trace ())
+ (srf-fun (lambda (orig kind token)
+ (let* ((pos (point))
+ (smie-config--trace t)
+ (res (funcall orig kind token)))
+ (push (if (consp smie-config--trace)
+ (list pos kind token res smie-config--trace)
+ (list pos kind token res))
+ trace)
+ res))))
+ (unwind-protect
+ (progn
+ (add-function :around (local 'smie-rules-function) srf-fun)
+ (cons (smie-indent-calculate)
+ trace))
+ (remove-function (local 'smie-rules-function) srf-fun)))))
+
+(defun smie-config-show-indent (&optional arg)
+ "Display the SMIE rules that are used to indent the current line.
+If prefix ARG is given, then move briefly point to the buffer
+position corresponding to each rule."
+ (interactive "P")
+ (let ((trace (cdr (smie-config--get-trace))))
+ (cond
+ ((null trace) (message "No SMIE rules involved"))
+ ((not arg)
+ (message "Rules used: %s"
+ (mapconcat (lambda (elem)
+ (pcase-let ((`(,_pos ,kind ,token ,res ,rewrite)
+ elem))
+ (format "%S %S -> %S%s" kind token res
+ (if (null rewrite) ""
+ (format "(via %S)" (nth 3 rewrite))))))
+ trace
+ ", ")))
+ (t
+ (save-excursion
+ (pcase-dolist (`(,pos ,kind ,token ,res ,rewrite) trace)
+ (message "%S %S -> %S%s" kind token res
+ (if (null rewrite) ""
+ (format "(via %S)" (nth 3 rewrite))))
+ (goto-char pos)
+ (sit-for blink-matching-delay)))))))
+
+(defun smie-config--guess-value (sig)
+ (add-function :around (local 'smie-rules-function) #'smie-config--advice)
+ (let* ((rule (cons 0 sig))
+ (smie-config--buffer-local (cons rule smie-config--buffer-local))
+ (goal (current-indentation))
+ (cur (smie-indent-calculate)))
+ (cond
+ ((and (eq goal
+ (progn (setf (car rule) (- goal cur))
+ (smie-indent-calculate))))
+ (- goal cur)))))
+
+(defun smie-config-set-indent ()
+ "Add a rule to adjust the indentation of current line."
+ (interactive)
+ (let* ((trace (cdr (smie-config--get-trace)))
+ (_ (unless trace (error "No SMIE rules involved")))
+ (sig (if (null (cdr trace))
+ (pcase-let* ((elem (car trace))
+ (`(,_pos ,kind ,token ,res ,rewrite) elem))
+ (list kind token (or (nth 3 rewrite) res)))
+ (let* ((choicestr
+ (completing-read
+ "Adjust rule: "
+ (mapcar (lambda (elem)
+ (format "%s %S"
+ (substring (symbol-name (cadr elem))
+ 1)
+ (nth 2 elem)))
+ trace)
+ nil t nil nil
+ nil)) ;FIXME: Provide good default!
+ (choicelst (car (read-from-string
+ (concat "(:" choicestr ")")))))
+ (catch 'found
+ (pcase-dolist (`(,_pos ,kind ,token ,res ,rewrite) trace)
+ (when (and (eq kind (car choicelst))
+ (equal token (nth 1 choicelst)))
+ (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)))
+ nil nil (format "%S" default-new)))
+ (new (car (read-from-string newstr))))
+ (let ((old (rassoc sig smie-config--buffer-local)))
+ (when old
+ (setq smie-config--buffer-local
+ (remove old smie-config--buffer-local))))
+ (push (cons new sig) smie-config--buffer-local)
+ (message "Added rule %S %S -> %S (via %S)"
+ (nth 0 sig) (nth 1 sig) new (nth 2 sig))
+ (add-function :around (local 'smie-rules-function) #'smie-config--advice)))
+
+(defun smie-config--guess (beg end)
+ (let ((otraces (make-hash-table :test #'equal))
+ (smie-config--buffer-local nil)
+ (smie-config--mode-local nil)
+ (pr (make-progress-reporter "Analyzing the buffer" beg end)))
+
+ ;; First, lets get the indentation traces and offsets for the region.
+ (save-excursion
+ (goto-char beg)
+ (forward-line 0)
+ (while (< (point) end)
+ (skip-chars-forward " \t")
+ (unless (eolp) ;Skip empty lines.
+ (progress-reporter-update pr (point))
+ (let* ((itrace (smie-config--get-trace))
+ (nindent (car itrace))
+ (trace (mapcar #'cdr (cdr itrace)))
+ (cur (current-indentation)))
+ (when (numberp nindent) ;Skip `noindent' and friends.
+ (cl-incf (gethash (cons (- cur nindent) trace) otraces 0)))))
+ (forward-line 1)))
+ (progress-reporter-done pr)
+
+ ;; Second, compile the data. Our algorithm only knows how to adjust rules
+ ;; where the smie-rules-function returns an integer. We call those
+ ;; "adjustable sigs". We build a table mapping each adjustable sig
+ ;; to its data, describing the total number of times we encountered it,
+ ;; the offsets found, and the traces in which it was found.
+ (message "Guessing...")
+ (let ((sigs (make-hash-table :test #'equal)))
+ (maphash (lambda (otrace count)
+ (let ((offset (car otrace))
+ (trace (cdr otrace))
+ (double nil))
+ (let ((sigs trace))
+ (while sigs
+ (let ((sig (pop sigs)))
+ (if (and (integerp (nth 2 sig)) (member sig sigs))
+ (setq double t)))))
+ (if double
+ ;; Disregard those traces where an adjustable sig
+ ;; appears twice, because the rest of the code assumes
+ ;; that adding a rule to add an offset N will change the
+ ;; end result by N rather than 2*N or more.
+ nil
+ (dolist (sig trace)
+ (if (not (integerp (nth 2 sig)))
+ ;; Disregard those sigs that return nil or a column,
+ ;; because our algorithm doesn't know how to adjust
+ ;; them anyway.
+ nil
+ (let ((sig-data (or (gethash sig sigs)
+ (let ((data (list 0 nil nil)))
+ (puthash sig data sigs)
+ data))))
+ (cl-incf (nth 0 sig-data) count)
+ (push (cons count otrace) (nth 2 sig-data))
+ (let ((sig-off-data
+ (or (assq offset (nth 1 sig-data))
+ (let ((off-data (cons offset 0)))
+ (push off-data (nth 1 sig-data))
+ off-data))))
+ (cl-incf (cdr sig-off-data) count))))))))
+ otraces)
+
+ ;; Finally, guess the indentation rules.
+ (prog1
+ (smie-config--guess-1 sigs)
+ (message "Guessing...done")))))
+
+(defun smie-config--guess-1 (sigs)
+ (let ((ssigs nil)
+ (rules nil))
+ ;; Sort the sigs by frequency of occurrence.
+ (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs)
+ (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2)))))
+ (while ssigs
+ (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs)))
+ (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist))))
+ (let* ((sorted-off-alist
+ (sort off-alist (lambda (x y) (> (cdr x) (cdr y)))))
+ (offset (caar sorted-off-alist)))
+ (if (zerop offset)
+ ;; Nothing to do with this sig; indentation is
+ ;; correct already.
+ nil
+ (push (cons (+ offset (nth 2 sig)) sig) rules)
+ ;; Adjust the rest of the data.
+ (pcase-dolist ((and cotrace `(,count ,toffset . ,trace))
+ cotraces)
+ (setf (nth 1 cotrace) (- toffset offset))
+ (dolist (sig trace)
+ (let ((sig-data (cdr (assq sig ssigs))))
+ (when sig-data
+ (let* ((ooff-data (assq toffset (nth 1 sig-data)))
+ (noffset (- toffset offset))
+ (noff-data
+ (or (assq noffset (nth 1 sig-data))
+ (let ((off-data (cons noffset 0)))
+ (push off-data (nth 1 sig-data))
+ off-data))))
+ (cl-assert (>= (cdr ooff-data) count))
+ (cl-decf (cdr ooff-data) count)
+ (cl-incf (cdr noff-data) count))))))))))
+ rules))
+
+(defun smie-config-guess ()
+ "Try and figure out this buffer's indentation settings.
+To save the result for future sessions, use `smie-config-save'."
+ (interactive)
+ (if (eq smie-grammar 'unset)
+ (user-error "This buffer does not seem to be using SMIE"))
+ (let ((config (smie-config--guess (point-min) (point-max))))
+ (cond
+ ((null config) (message "Nothing to change"))
+ ((null smie-config--buffer-local)
+ (smie-config-local config)
+ (message "Local rules set"))
+ ((y-or-n-p "Replace existing local config? ")
+ (message "Local rules replaced")
+ (smie-config-local config))
+ ((y-or-n-p "Merge with existing local config? ")
+ (message "Local rules adjusted")
+ (smie-config-local (append config smie-config--buffer-local)))
+ (t
+ (message "Rules guessed: %S" config)))))
+
+(defun smie-config-save ()
+ "Save local rules for use with this major mode.
+One way to generate local rules is the command `smie-config-guess'."
+ (interactive)
+ (cond
+ ((null smie-config--buffer-local)
+ (message "No local rules to save"))
+ (t
+ (let* ((existing (assq major-mode smie-config))
+ (config
+ (cond ((null existing)
+ (message "Local rules saved in `smie-config'")
+ smie-config--buffer-local)
+ ((y-or-n-p "Replace the existing mode's config? ")
+ (message "Mode rules replaced in `smie-config'")
+ smie-config--buffer-local)
+ ((y-or-n-p "Merge with existing mode's config? ")
+ (message "Mode rules adjusted in `smie-config'")
+ (append smie-config--buffer-local (cdr existing)))
+ (t (error "Abort")))))
+ (if existing
+ (setcdr existing config)
+ (push (cons major-mode config) smie-config))
+ (setq smie-config--mode-local config)
+ (kill-local-variable 'smie-config--buffer-local)
+ (customize-mark-as-set 'smie-config)))))
(provide 'smie)
;;; smie.el ends here
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
new file mode 100644
index 00000000000..e6d451ac62e
--- /dev/null
+++ b/lisp/emacs-lisp/subr-x.el
@@ -0,0 +1,203 @@
+;;; subr-x.el --- extra Lisp functions -*- lexical-binding:t -*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: convenience
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Less commonly used functions that complement basic APIs, often implemented in
+;; C code (like hash-tables and strings), and are not eligible for inclusion
+;; in subr.el.
+
+;; Do not document these functions in the lispref.
+;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01006.html
+
+;;; Code:
+
+(require 'pcase)
+
+
+(defmacro internal--thread-argument (first? &rest forms)
+ "Internal implementation for `thread-first' and `thread-last'.
+When Argument FIRST? is non-nil argument is threaded first, else
+last. FORMS are the expressions to be threaded."
+ (pcase forms
+ (`(,x (,f . ,args) . ,rest)
+ `(internal--thread-argument
+ ,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
+ (`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
+ (_ (car forms))))
+
+(defmacro thread-first (&rest forms)
+ "Thread FORMS elements as the first argument of their successor.
+Example:
+ (thread-first
+ 5
+ (+ 20)
+ (/ 25)
+ -
+ (+ 40))
+Is equivalent to:
+ (+ (- (/ (+ 5 20) 25)) 40)
+Note how the single `-' got converted into a list before
+threading."
+ (declare (indent 1)
+ (debug (form &rest [&or symbolp (sexp &rest form)])))
+ `(internal--thread-argument t ,@forms))
+
+(defmacro thread-last (&rest forms)
+ "Thread FORMS elements as the last argument of their successor.
+Example:
+ (thread-last
+ 5
+ (+ 20)
+ (/ 25)
+ -
+ (+ 40))
+Is equivalent to:
+ (+ 40 (- (/ 25 (+ 20 5))))
+Note how the single `-' got converted into a list before
+threading."
+ (declare (indent 1) (debug thread-first))
+ `(internal--thread-argument nil ,@forms))
+
+(defsubst internal--listify (elt)
+ "Wrap ELT in a list if it is not one."
+ (if (not (listp elt))
+ (list elt)
+ elt))
+
+(defsubst internal--check-binding (binding)
+ "Check BINDING is properly formed."
+ (when (> (length binding) 2)
+ (signal
+ 'error
+ (cons "`let' bindings can have only one value-form" binding)))
+ binding)
+
+(defsubst internal--build-binding-value-form (binding prev-var)
+ "Build the conditional value form for BINDING using PREV-VAR."
+ `(,(car binding) (and ,prev-var ,(cadr binding))))
+
+(defun internal--build-binding (binding prev-var)
+ "Check and build a single BINDING with PREV-VAR."
+ (thread-first
+ binding
+ internal--listify
+ internal--check-binding
+ (internal--build-binding-value-form prev-var)))
+
+(defun internal--build-bindings (bindings)
+ "Check and build conditional value forms for BINDINGS."
+ (let ((prev-var t))
+ (mapcar (lambda (binding)
+ (let ((binding (internal--build-binding binding prev-var)))
+ (setq prev-var (car binding))
+ binding))
+ bindings)))
+
+(defmacro if-let (bindings then &rest else)
+ "Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
+Argument BINDINGS is a list of tuples whose car is a symbol to be
+bound and (optionally) used in THEN, and its cadr is a sexp to be
+evalled to set symbol's value. In the special case you only want
+to bind a single value, BINDINGS can just be a plain tuple."
+ (declare (indent 2)
+ (debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
+ (when (and (<= (length bindings) 2)
+ (not (listp (car bindings))))
+ ;; Adjust the single binding case
+ (setq bindings (list bindings)))
+ `(let* ,(internal--build-bindings bindings)
+ (if ,(car (internal--listify (car (last bindings))))
+ ,then
+ ,@else)))
+
+(defmacro when-let (bindings &rest body)
+ "Process BINDINGS and if all values are non-nil eval BODY.
+Argument BINDINGS is a list of tuples whose car is a symbol to be
+bound and (optionally) used in BODY, and its cadr is a sexp to be
+evalled to set symbol's value. In the special case you only want
+to bind a single value, BINDINGS can just be a plain tuple."
+ (declare (indent 1) (debug if-let))
+ (list 'if-let bindings (macroexp-progn body)))
+
+(defsubst hash-table-empty-p (hash-table)
+ "Check whether HASH-TABLE is empty (has 0 elements)."
+ (zerop (hash-table-count hash-table)))
+
+(defsubst hash-table-keys (hash-table)
+ "Return a list of keys in HASH-TABLE."
+ (let ((keys '()))
+ (maphash (lambda (k _v) (push k keys)) hash-table)
+ keys))
+
+(defsubst hash-table-values (hash-table)
+ "Return a list of values in HASH-TABLE."
+ (let ((values '()))
+ (maphash (lambda (_k v) (push v values)) hash-table)
+ values))
+
+(defsubst string-empty-p (string)
+ "Check whether STRING is empty."
+ (string= string ""))
+
+(defsubst string-join (strings &optional separator)
+ "Join all STRINGS using SEPARATOR."
+ (mapconcat 'identity strings separator))
+
+(define-obsolete-function-alias 'string-reverse 'reverse "25.1")
+
+(defsubst string-trim-left (string)
+ "Remove leading whitespace from STRING."
+ (if (string-match "\\`[ \t\n\r]+" string)
+ (replace-match "" t t string)
+ string))
+
+(defsubst string-trim-right (string)
+ "Remove trailing whitespace from STRING."
+ (if (string-match "[ \t\n\r]+\\'" string)
+ (replace-match "" t t string)
+ string))
+
+(defsubst string-trim (string)
+ "Remove leading and trailing whitespace from STRING."
+ (string-trim-left (string-trim-right string)))
+
+(defsubst string-blank-p (string)
+ "Check whether STRING is either empty or only whitespace."
+ (string-match-p "\\`[ \t\n\r]*\\'" string))
+
+(defsubst string-remove-prefix (prefix string)
+ "Remove PREFIX from STRING if present."
+ (if (string-prefix-p prefix string)
+ (substring string (length prefix))
+ string))
+
+(defsubst string-remove-suffix (suffix string)
+ "Remove SUFFIX from STRING if present."
+ (if (string-suffix-p suffix string)
+ (substring string 0 (- (length string) (length suffix)))
+ string))
+
+(provide 'subr-x)
+
+;;; subr-x.el ends here
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 3e850320133..d446a2c0af7 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -1,8 +1,8 @@
;;; syntax.el --- helper functions to find syntactic context -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -43,8 +43,6 @@
(eval-when-compile (require 'cl-lib))
-(defvar font-lock-beginning-of-syntax-function)
-
;;; Applying syntax-table properties where needed.
(defvar syntax-propertize-function nil
@@ -106,10 +104,6 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(point-max))))
(cons beg end))
-(defvar syntax-propertize--done -1
- "Position up to which syntax-table properties have been set.")
-(make-variable-buffer-local 'syntax-propertize--done)
-
(defun syntax-propertize--shift-groups (re n)
(replace-regexp-in-string
"\\\\(\\?\\([0-9]+\\):"
@@ -290,39 +284,60 @@ The return value is a function suitable for `syntax-propertize-function'."
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS."
- (when (and syntax-propertize-function
- (< syntax-propertize--done pos))
- ;; (message "Needs to syntax-propertize from %s to %s"
- ;; syntax-propertize--done pos)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (save-excursion
- (with-silent-modifications
- (let* ((start (max syntax-propertize--done (point-min)))
- (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)))
- (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)))))
- ;; Move the limit before calling the function, so the function
- ;; can use syntax-ppss.
- (setq syntax-propertize--done end)
- ;; (message "syntax-propertizing from %s to %s" start end)
- (remove-text-properties start end
- '(syntax-table nil syntax-multiline nil))
- (funcall syntax-propertize-function start end))))))
+ (when (< syntax-propertize--done pos)
+ (if (null syntax-propertize-function)
+ (setq syntax-propertize--done (max (point-max) pos))
+ ;; (message "Needs to syntax-propertize from %s to %s"
+ ;; syntax-propertize--done pos)
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (save-excursion
+ (with-silent-modifications
+ (make-local-variable 'syntax-propertize--done) ;Just in case!
+ (let* ((start (max (min syntax-propertize--done (point-max))
+ (point-min)))
+ (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)))))
+ ;; Move the limit before calling the function, so the function
+ ;; can use syntax-ppss.
+ (setq syntax-propertize--done end)
+ ;; (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))
+ (funcall syntax-propertize-function start end))))))))
+
+;;; Link syntax-propertize with syntax.c.
+
+(defvar syntax-propertize-chunks
+ ;; We're not sure how far we'll go. In my tests, using chunks of 2000
+ ;; brings to overhead to something negligible. Passing ‘charpos’ directly
+ ;; also works (basically works line-by-line) but results in an overhead which
+ ;; I thought was a bit too high (like around 50%).
+ 2000)
+
+(defun internal--syntax-propertize (charpos)
+ ;; FIXME: Called directly from C.
+ (save-match-data
+ (syntax-propertize (min (+ syntax-propertize-chunks charpos) (point-max)))))
;;; Incrementally compute and memoize parser state.
@@ -360,13 +375,12 @@ from each other, to avoid keeping too much useless info.")
"Function to move back outside of any comment/string/paren.
This function should move the cursor back to some syntactically safe
point (where the PPSS is equivalent to nil).")
+(make-obsolete-variable 'syntax-begin-function nil "25.1")
-(defvar syntax-ppss-cache nil
+(defvar-local syntax-ppss-cache nil
"List of (POS . PPSS) pairs, in decreasing POS order.")
-(make-variable-buffer-local 'syntax-ppss-cache)
-(defvar syntax-ppss-last nil
+(defvar-local syntax-ppss-last nil
"Cache of (LAST-POS . LAST-PPSS).")
-(make-variable-buffer-local 'syntax-ppss-last)
(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
(defun syntax-ppss-flush-cache (beg &rest ignored)
@@ -405,9 +419,14 @@ point (where the PPSS is equivalent to nil).")
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
The returned value is the same as that of `parse-partial-sexp'
-run from point-min to POS except that values at positions 2 and 6
+run from `point-min' to POS except that values at positions 2 and 6
in the returned list (counting from 0) cannot be relied upon.
-Point is at POS when this function returns."
+Point is at POS when this function returns.
+
+It is necessary to call `syntax-ppss-flush-cache' explicitly if
+this function is called while `before-change-functions' is
+temporarily let-bound, or if the buffer is modified without
+running the hook."
;; Default values.
(unless pos (setq pos (point)))
(syntax-propertize pos)
@@ -482,11 +501,6 @@ Point is at POS when this function returns."
;; - The function might be slow.
;; - If this function almost always finds a safe nearby spot,
;; the cache won't be populated, so consulting it is cheap.
- (when (and (not syntax-begin-function)
- (boundp 'font-lock-beginning-of-syntax-function)
- font-lock-beginning-of-syntax-function)
- (set (make-local-variable 'syntax-begin-function)
- font-lock-beginning-of-syntax-function))
(when (and syntax-begin-function
(progn (goto-char pos)
(funcall syntax-begin-function)
@@ -569,7 +583,7 @@ Point is at POS when this function returns."
;; (defun buffer-syntactic-context (&optional buffer)
;; "Syntactic context at point in BUFFER.
-;; Either of `string', `comment' or `nil'.
+;; Either of `string', `comment' or nil.
;; This is an XEmacs compatibility function."
;; (with-current-buffer (or buffer (current-buffer))
;; (syntax-ppss-context (syntax-ppss))))
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 9c5115bcd7b..4bd8a19937d 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -1,6 +1,6 @@
;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: extensions, lisp
@@ -179,7 +179,9 @@ If ADVANCE is non-nil, move forward by one line afterwards."
table)
"The `glyphless-char-display' table in Tabulated List buffers.")
-(defvar tabulated-list--header-string nil)
+(defvar tabulated-list--header-string nil
+ "Holds the header if `tabulated-list-use-header-line' is nil.
+Populated by `tabulated-list-init-header'.")
(defvar tabulated-list--header-overlay nil)
(defun tabulated-list-init-header ()
@@ -243,15 +245,17 @@ If ADVANCE is non-nil, move forward by one line afterwards."
(setq-local tabulated-list--header-string cols))))
(defun tabulated-list-print-fake-header ()
- "Insert a fake Tabulated List \"header line\" at the start of the buffer."
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (insert tabulated-list--header-string "\n")
- (if tabulated-list--header-overlay
- (move-overlay tabulated-list--header-overlay (point-min) (point))
- (setq-local tabulated-list--header-overlay
- (make-overlay (point-min) (point))))
- (overlay-put tabulated-list--header-overlay 'face 'underline)))
+ "Insert a fake Tabulated List \"header line\" at the start of the buffer.
+Do nothing if `tabulated-list--header-string' is nil."
+ (when tabulated-list--header-string
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (insert tabulated-list--header-string "\n")
+ (if tabulated-list--header-overlay
+ (move-overlay tabulated-list--header-overlay (point-min) (point))
+ (setq-local tabulated-list--header-overlay
+ (make-overlay (point-min) (point))))
+ (overlay-put tabulated-list--header-overlay 'face 'underline))))
(defun tabulated-list-revert (&rest ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
@@ -273,57 +277,105 @@ It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(or found
(error "No column named %s" name))))
-(defun tabulated-list-print (&optional remember-pos)
+(defun tabulated-list--get-sorter ()
+ "Return a sorting predicate for the current tabulated-list.
+Return nil if `tabulated-list-sort-key' specifies an unsortable
+column. Negate the predicate that would be returned if
+`tabulated-list-sort-key' has a non-nil cdr."
+ (when (and tabulated-list-sort-key
+ (car tabulated-list-sort-key))
+ (let* ((sort-column (car tabulated-list-sort-key))
+ (n (tabulated-list--column-number sort-column))
+ (sorter (nth 2 (aref tabulated-list-format n))))
+ (when (eq sorter t); Default sorter checks column N:
+ (setq sorter (lambda (A B)
+ (let ((a (aref (cadr A) n))
+ (b (aref (cadr B) n)))
+ (string< (if (stringp a) a (car a))
+ (if (stringp b) b (car b)))))))
+ ;; Reversed order.
+ (if (cdr tabulated-list-sort-key)
+ (lambda (a b) (not (funcall sorter a b)))
+ sorter))))
+
+(defun tabulated-list-print (&optional remember-pos update)
"Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
-to the entry with the same ID element as the current line."
+to the entry with the same ID element as the current line and
+recenter window line accordingly.
+
+Non-nil UPDATE argument means to use an alternative printing
+method which is faster if most entries haven't changed since the
+last print. The only difference in outcome is that tags will not
+be removed from entries that haven't changed (see
+`tabulated-list-put-tag'). Don't use this immediately after
+changing `tabulated-list-sort-key'."
(let ((inhibit-read-only t)
(entries (if (functionp tabulated-list-entries)
(funcall tabulated-list-entries)
tabulated-list-entries))
- entry-id saved-pt saved-col)
+ (sorter (tabulated-list--get-sorter))
+ entry-id saved-pt saved-col window-line)
(and remember-pos
(setq entry-id (tabulated-list-get-id))
- (setq saved-col (current-column)))
- (erase-buffer)
- (unless tabulated-list-use-header-line
- (tabulated-list-print-fake-header))
+ (setq saved-col (current-column))
+ (when (eq (window-buffer) (current-buffer))
+ (setq window-line
+ (count-screen-lines (window-start) (point)))))
;; Sort the entries, if necessary.
- (when (and tabulated-list-sort-key
- (car tabulated-list-sort-key))
- (let* ((sort-column (car tabulated-list-sort-key))
- (n (tabulated-list--column-number sort-column))
- (sorter (nth 2 (aref tabulated-list-format n))))
- ;; Is the specified column sortable?
- (when sorter
- (when (eq sorter t)
- (setq sorter ; Default sorter checks column N:
- (lambda (A B)
- (setq A (aref (cadr A) n))
- (setq B (aref (cadr B) n))
- (string< (if (stringp A) A (car A))
- (if (stringp B) B (car B))))))
- (setq entries (sort entries sorter))
- (if (cdr tabulated-list-sort-key)
- (setq entries (nreverse entries)))
- (unless (functionp tabulated-list-entries)
- (setq tabulated-list-entries entries)))))
- ;; Print the resulting list.
+ (when sorter
+ (setq entries (sort entries sorter)))
+ (unless (functionp tabulated-list-entries)
+ (setq tabulated-list-entries entries))
+ ;; Without a sorter, we have no way to just update.
+ (when (and update (not sorter))
+ (setq update nil))
+ (if update (goto-char (point-min))
+ ;; Redo the buffer, unless we're just updating.
+ (erase-buffer)
+ (unless tabulated-list-use-header-line
+ (tabulated-list-print-fake-header)))
+ ;; Finally, print the resulting list.
(dolist (elt entries)
- (and entry-id
- (equal entry-id (car elt))
- (setq saved-pt (point)))
- (apply tabulated-list-printer elt))
+ (let ((id (car elt)))
+ (and entry-id
+ (equal entry-id id)
+ (setq entry-id nil
+ saved-pt (point)))
+ ;; If the buffer this empty, simply print each elt.
+ (if (or (not update) (eobp))
+ (apply tabulated-list-printer elt)
+ (while (let ((local-id (tabulated-list-get-id)))
+ ;; If we find id, then nothing to update.
+ (cond ((equal id local-id)
+ (forward-line 1)
+ nil)
+ ;; If this entry sorts after id (or it's the
+ ;; end), then just insert id and move on.
+ ((or (not local-id)
+ (funcall sorter elt
+ ;; FIXME: Might be faster if
+ ;; don't construct this list.
+ (list local-id (tabulated-list-get-entry))))
+ (apply tabulated-list-printer elt)
+ nil)
+ ;; We find an entry that sorts before id,
+ ;; it needs to be deleted.
+ (t t)))
+ (let ((old (point)))
+ (forward-line 1)
+ (delete-region old (point)))))))
(set-buffer-modified-p nil)
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
(move-to-column saved-col)
- (recenter))
+ (when window-line
+ (recenter window-line)))
(goto-char (point-min)))))
(defun tabulated-list-print-entry (id cols)
@@ -340,8 +392,10 @@ of column descriptors."
(dotimes (n ncols)
(setq x (tabulated-list-print-col n (aref cols n) x)))
(insert ?\n)
- (put-text-property beg (point) 'tabulated-list-id id)
- (put-text-property beg (point) 'tabulated-list-entry cols)))
+ ;; Ever so slightly faster than calling `put-text-property' twice.
+ (add-text-properties
+ beg (point)
+ `(tabulated-list-id ,id tabulated-list-entry ,cols))))
(defun tabulated-list-print-col (n col-desc x)
"Insert a specified Tabulated List entry at point.
@@ -466,7 +520,9 @@ With a numeric prefix argument N, sort the Nth column."
(car (aref tabulated-list-format n))
(get-text-property (point)
'tabulated-list-column-name))))
- (tabulated-list--sort-by-column-name name)))
+ (if (nth 2 (assoc name (append tabulated-list-format nil)))
+ (tabulated-list--sort-by-column-name name)
+ (user-error "Cannot sort by %s" name))))
(defun tabulated-list--sort-by-column-name (name)
(when (and name (derived-mode-p 'tabulated-list-mode))
@@ -518,14 +574,13 @@ as the ewoc pretty-printer."
(setq-local buffer-read-only t)
(setq-local buffer-undo-list t)
(setq-local revert-buffer-function #'tabulated-list-revert)
- (setq-local glyphless-char-display tabulated-list-glyphless-char-display))
+ (setq-local glyphless-char-display tabulated-list-glyphless-char-display)
+ ;; Avoid messing up the entries' display just because the first
+ ;; column of the first entry happens to begin with a R2L letter.
+ (setq bidi-paragraph-direction 'left-to-right))
(put 'tabulated-list-mode 'mode-class 'special)
(provide 'tabulated-list)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; tabulated-list.el ends here
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 02023b957a5..61a21dc74fd 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,6 +1,6 @@
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index e557e1c30c1..c683826535b 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -1,6 +1,6 @@
;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@engineer.com>
;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index a5619583145..110c63f777a 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,6 +1,6 @@
-;;;; testcover.el -- Visual code-coverage tool
+;;;; testcover.el -- Visual code-coverage tool -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@@ -146,7 +146,8 @@ call to one of the `testcover-1value-functions'."
'(add-hook and beep or remove-hook unless when)
"Functions that are potentially 1-valued. No brown splotch if actually
1-valued, no error if actually multi-valued."
- :group 'testcover)
+ :group 'testcover
+ :type '(repeat symbol))
(defface testcover-nohits
'((t (:background "DeepPink2")))
@@ -190,8 +191,9 @@ problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
non-nil, byte-compiles each function after instrumenting."
(interactive "fStart covering file: ")
(let ((buf (find-file filename))
- (load-read-function 'testcover-read)
- (edebug-all-defs t))
+ (load-read-function load-read-function))
+ (add-function :around load-read-function
+ #'testcover--read)
(setq edebug-form-data nil
testcover-module-constants nil
testcover-module-1value-functions nil)
@@ -206,22 +208,26 @@ non-nil, byte-compiles each function after instrumenting."
(defun testcover-this-defun ()
"Start coverage on function under point."
(interactive)
- (let* ((edebug-all-defs t)
- (x (symbol-function (eval-defun nil))))
+ (let ((x (let ((edebug-all-defs t))
+ (symbol-function (eval-defun nil)))))
(testcover-reinstrument x)
x))
-(defun testcover-read (&optional stream)
+(defun testcover--read (orig &optional stream)
"Read a form using edebug, changing edebug callbacks to testcover callbacks."
- (let ((x (edebug-read stream)))
- (testcover-reinstrument x)
- x))
+ (or stream (setq stream standard-input))
+ (if (eq stream (current-buffer))
+ (let ((x (let ((edebug-all-defs t))
+ (edebug-read-and-maybe-wrap-form))))
+ (testcover-reinstrument x)
+ x)
+ (funcall (or orig #'read) stream)))
(defun testcover-reinstrument (form)
"Reinstruments FORM to use testcover instead of edebug. This
function modifies the list that FORM points to. Result is nil if
FORM should return multiple values, t if should always return same
-value, 'maybe if either is acceptable."
+value, `maybe' if either is acceptable."
(let ((fun (car-safe form))
id val)
(cond
@@ -494,7 +500,7 @@ eliminated by adding more test cases."
(len (length points))
(changed (buffer-modified-p))
(coverage (get def 'edebug-coverage))
- ov j item)
+ ov j)
(or (and def-mark points coverage)
(error "Missing edebug data for function %s" def))
(when (> len 0)
diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el
new file mode 100644
index 00000000000..0c5816a616d
--- /dev/null
+++ b/lisp/emacs-lisp/thunk.el
@@ -0,0 +1,74 @@
+;;; thunk.el --- Lazy form evaluation -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <nicolas@petton.fr>
+;; Keywords: sequences
+;; Version: 1.0
+;; Package: thunk
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Thunk provides functions and macros to delay the evaluation of
+;; forms.
+;;
+;; Use `thunk-delay' to delay the evaluation of a form, and
+;; `thunk-force' to evaluate it. The result of the evaluation is
+;; cached, and only happens once.
+;;
+;; Here is an example of a form which evaluation is delayed:
+;;
+;; (setq delayed (thunk-delay (message "this message is delayed")))
+;;
+;; `delayed' is not evaluated until `thunk-force' is called, like the
+;; following:
+;;
+;; (thunk-force delayed)
+
+;; Tests are located at test/automated/thunk-tests.el
+
+;;; Code:
+
+(defmacro thunk-delay (&rest body)
+ "Delay the evaluation of BODY."
+ (declare (debug t))
+ (let ((forced (make-symbol "forced"))
+ (val (make-symbol "val")))
+ `(let (,forced ,val)
+ (lambda (&optional check)
+ (if check
+ ,forced
+ (unless ,forced
+ (setf ,val (progn ,@body))
+ (setf ,forced t))
+ ,val)))))
+
+(defun thunk-force (delayed)
+ "Force the evaluation of DELAYED.
+The result is cached and will be returned on subsequent calls
+with the same DELAYED argument."
+ (funcall delayed))
+
+(defun thunk-evaluated-p (delayed)
+ "Return non-nil if DELAYED has been evaluated."
+ (funcall delayed t))
+
+(provide 'thunk)
+;;; thunk.el ends here
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 1ee3cec15a6..c9e3fbe4f7d 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -1,8 +1,8 @@
;;; timer.el --- run a function with args at some time in future
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
@@ -125,9 +125,7 @@ of SECS seconds since the epoch. SECS may be a fraction."
"Advance TIME by SECS seconds and optionally USECS microseconds
and PSECS picoseconds. SECS may be either an integer or a
floating point number."
- (let ((delta (if (floatp secs)
- (seconds-to-time secs)
- (list (floor secs 65536) (mod secs 65536)))))
+ (let ((delta secs))
(if (or usecs psecs)
(setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
(time-add time delta)))
@@ -207,7 +205,7 @@ timers). If nil, allocate a new cell."
"Insert TIMER into `timer-idle-list'.
This arranges to activate TIMER whenever Emacs is next idle.
If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately \(see below\), or at the right time, if Emacs is
+immediately \(see below), or at the right time, if Emacs is
already idle.
REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
@@ -290,42 +288,51 @@ This function is called, by name, directly by the C code."
(cell
;; Delete from queue. Record the cons cell that was used.
(cancel-timer-internal timer)))
- ;; Re-schedule if requested.
- (if (timer--repeat-delay timer)
- (if (timer--idle-delay timer)
- (timer-activate-when-idle timer nil cell)
- (timer-inc-time timer (timer--repeat-delay timer) 0)
- ;; If real time has jumped forward,
- ;; perhaps because Emacs was suspended for a long time,
- ;; limit how many times things get repeated.
- (if (and (numberp timer-max-repeats)
- (< 0 (timer-until timer (current-time))))
- (let ((repeats (/ (timer-until timer (current-time))
- (timer--repeat-delay timer))))
- (if (> repeats timer-max-repeats)
- (timer-inc-time timer (* (timer--repeat-delay timer)
- repeats)))))
- ;; Place it back on the timer-list before running
- ;; timer--function, so it can cancel-timer itself.
- (timer-activate timer t cell)
- (setq retrigger t)))
- ;; Run handler.
- (condition-case-unless-debug err
- ;; Timer functions should not change the current buffer.
- ;; If they do, all kinds of nasty surprises can happen,
- ;; and it can be hellish to track down their source.
- (save-current-buffer
- (apply (timer--function timer) (timer--args timer)))
- (error (message "Error running timer%s: %S"
- (if (symbolp (timer--function timer))
- (format " `%s'" (timer--function timer)) "")
- err)))
- (when (and retrigger
- ;; If the timer's been canceled, don't "retrigger" it
- ;; since it might still be in the copy of timer-list kept
- ;; by keyboard.c:timer_check (bug#14156).
- (memq timer timer-list))
- (setf (timer--triggered timer) nil)))))
+ ;; If `cell' is nil, it means the timer was already canceled, so we
+ ;; shouldn't be running it at all. This can happen for example with the
+ ;; following scenario (bug#17392):
+ ;; - we run timers, starting with A (and remembering the rest as (B C)).
+ ;; - A runs and a does a sit-for.
+ ;; - during sit-for we run timer D which cancels timer B.
+ ;; - timer A finally finishes, so we move on to timers B and C.
+ (when cell
+ ;; Re-schedule if requested.
+ (if (timer--repeat-delay timer)
+ (if (timer--idle-delay timer)
+ (timer-activate-when-idle timer nil cell)
+ (timer-inc-time timer (timer--repeat-delay timer) 0)
+ ;; If real time has jumped forward,
+ ;; perhaps because Emacs was suspended for a long time,
+ ;; limit how many times things get repeated.
+ (if (and (numberp timer-max-repeats)
+ (< 0 (timer-until timer nil)))
+ (let ((repeats (/ (timer-until timer nil)
+ (timer--repeat-delay timer))))
+ (if (> repeats timer-max-repeats)
+ (timer-inc-time timer (* (timer--repeat-delay timer)
+ repeats)))))
+ ;; Place it back on the timer-list before running
+ ;; timer--function, so it can cancel-timer itself.
+ (timer-activate timer t cell)
+ (setq retrigger t)))
+ ;; Run handler.
+ (condition-case-unless-debug err
+ ;; Timer functions should not change the current buffer.
+ ;; If they do, all kinds of nasty surprises can happen,
+ ;; and it can be hellish to track down their source.
+ (save-current-buffer
+ (apply (timer--function timer) (timer--args timer)))
+ (error (message "Error running timer%s: %S"
+ (if (symbolp (timer--function timer))
+ (format-message " `%s'" (timer--function timer))
+ "")
+ err)))
+ (when (and retrigger
+ ;; If the timer's been canceled, don't "retrigger" it
+ ;; since it might still be in the copy of timer-list kept
+ ;; by keyboard.c:timer_check (bug#14156).
+ (memq timer timer-list))
+ (setf (timer--triggered timer) nil))))))
;; This function is incompatible with the one in levents.el.
(defun timeout-event-p (event)
@@ -338,18 +345,26 @@ This function is called, by name, directly by the C code."
(defun run-at-time (time repeat function &rest args)
"Perform an action at time TIME.
Repeat the action every REPEAT seconds, if REPEAT is non-nil.
-TIME should be one of: a string giving an absolute time like
-\"11:23pm\" (the acceptable formats are those recognized by
-`diary-entry-time'; note that such times are interpreted as times
-today, even if in the past); a string giving a relative time like
-\"2 hours 35 minutes\" (the acceptable formats are those
-recognized by `timer-duration'); nil meaning now; a number of
-seconds from now; a value from `encode-time'; or t (with non-nil
-REPEAT) meaning the next integral multiple of REPEAT. REPEAT may
-be an integer or floating point number. The action is to call
-FUNCTION with arguments ARGS.
+REPEAT may be an integer or floating point number.
+TIME should be one of:
+- a string giving today's time like \"11:23pm\"
+ (the acceptable formats are HHMM, H:MM, HH:MM, HHam, HHAM,
+ HHpm, HHPM, HH:MMam, HH:MMAM, HH:MMpm, or HH:MMPM;
+ a period `.' can be used instead of a colon `:' to separate
+ the hour and minute parts);
+- a string giving a relative time like \"90\" or \"2 hours 35 minutes\"
+ (the acceptable forms are a number of seconds without units
+ or some combination of values using units in `timer-duration-words');
+- nil, meaning now;
+- a number of seconds from now;
+- a value from `encode-time';
+- or t (with non-nil REPEAT) meaning the next integral
+ multiple of REPEAT.
-This function returns a timer object which you can use in `cancel-timer'."
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in
+`cancel-timer'."
(interactive "sRun at time: \nNRepeat interval: \naFunction: ")
(or (null repeat)
@@ -366,13 +381,13 @@ This function returns a timer object which you can use in `cancel-timer'."
;; Handle numbers as relative times in seconds.
(if (numberp time)
- (setq time (timer-relative-time (current-time) time)))
+ (setq time (timer-relative-time nil time)))
;; Handle relative times like "2 hours 35 minutes"
(if (stringp time)
(let ((secs (timer-duration time)))
(if secs
- (setq time (timer-relative-time (current-time) secs)))))
+ (setq time (timer-relative-time nil secs)))))
;; Handle "11:23pm" and the like. Interpret it as meaning today
;; which admittedly is rather stupid if we have passed that time
@@ -478,7 +493,7 @@ The value is a list that the debugger can pass to `with-timeout-unsuspend'
when it exits, to make these timers start counting again."
(mapcar (lambda (timer)
(cancel-timer timer)
- (list timer (time-subtract (timer--time timer) (current-time))))
+ (list timer (time-subtract (timer--time timer) nil)))
with-timeout-timers))
(defun with-timeout-unsuspend (timer-spec-list)
@@ -487,7 +502,7 @@ The argument should be a value previously returned by `with-timeout-suspend'."
(dolist (elt timer-spec-list)
(let ((timer (car elt))
(delay (cadr elt)))
- (timer-set-time timer (time-add (current-time) delay))
+ (timer-set-time timer (time-add nil delay))
(timer-activate timer))))
(defun y-or-n-p-with-timeout (prompt seconds default-value)
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index d308ce694d2..b652cbe193e 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -1,10 +1,10 @@
-;;; tq.el --- utility to maintain a transaction queue
+;;; tq.el --- utility to maintain a transaction queue -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Scott Draves <spot@cs.cmu.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR
;; Keywords: extensions
@@ -87,8 +87,7 @@ to a tcp server on another machine."
(process-name process)))))))
(buffer-disable-undo (tq-buffer tq))
(set-process-filter process
- `(lambda (proc string)
- (tq-filter ',tq string)))
+ (lambda (_proc string) (tq-filter tq string)))
tq))
(defun tq-queue-add (tq question re closure fn)
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index f605c2865c0..7a2fb22f3d5 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,9 +1,9 @@
;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*-
-;; Copyright (C) 1993, 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 15 Dec 1992
;; Keywords: tools, lisp
@@ -32,9 +32,9 @@
;; Introduction:
;; =============
-;; A simple trace package that utilizes advice.el. It generates trace
+;; A simple trace package that utilizes nadvice.el. It generates trace
;; information in a Lisp-style fashion and inserts it into a trace output
-;; buffer. Tracing can be done in the background (or silently) so that
+;; buffer. Tracing can be done in the background (or silently) so that
;; generation of trace output won't interfere with what you are currently
;; doing.
@@ -48,15 +48,14 @@
;; + Compiled calls to subrs that have special byte-codes associated
;; with them (e.g., car, cdr, ...)
;; + Macros that were expanded during compilation
-;; - All the restrictions that apply to advice.el
+;; - All the restrictions that apply to nadvice.el
;; Usage:
;; ======
-;; - To trace a function say `M-x trace-function' which will ask you for the
-;; name of the function/subr/macro to trace, as well as for the buffer
-;; into which trace output should go.
+;; - To trace a function say `M-x trace-function', which will ask you for the
+;; name of the function/subr/macro to trace.
;; - If you want to trace a function that switches buffers or does other
-;; display oriented stuff use `M-x trace-function-background' which will
+;; display oriented stuff use `M-x trace-function-background', which will
;; generate the trace output silently in the background without popping
;; up windows and doing other irritating stuff.
;; - To untrace a function say `M-x untrace-function'.
@@ -222,6 +221,7 @@ be printed along with the arguments in the trace."
(lambda (body &rest args)
(let ((trace-level (1+ trace-level))
(trace-buffer (get-buffer-create buffer))
+ (deactivate-mark nil) ;Protect deactivate-mark.
(ctx (funcall context)))
(unless inhibit-trace
(with-current-buffer trace-buffer
@@ -255,12 +255,15 @@ be printed along with the arguments in the trace."
function :around
(trace-make-advice function (or buffer trace-buffer) background
(or context (lambda () "")))
- `((name . ,trace-advice-name))))
+ `((name . ,trace-advice-name) (depth . -100))))
(defun trace-is-traced (function)
(advice-member-p trace-advice-name function))
(defun trace--read-args (prompt)
+ "Read a function name, prompting with string PROMPT.
+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)))
@@ -287,23 +290,30 @@ be printed along with the arguments in the trace."
;;;###autoload
(defun trace-function-foreground (function &optional buffer context)
- "Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead.
-
-To untrace a function, use `untrace-function' or `untrace-all'."
+ "Trace calls to function FUNCTION.
+With a prefix argument, also prompt for the trace buffer (default
+`trace-buffer'), and a Lisp expression CONTEXT.
+
+Tracing a function causes every call to that function to insert
+into BUFFER Lisp-style trace messages that display the function's
+arguments and return values. It also evaluates CONTEXT, if that is
+non-nil, and inserts its value too. For example, you can use this
+to track the current buffer, or position of point.
+
+This function creates BUFFER if it does not exist. This buffer will
+popup whenever FUNCTION is called. Do not use this function to trace
+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: "))
(trace-function-internal function buffer nil context))
;;;###autoload
(defun trace-function-background (function &optional buffer context)
- "Traces FUNCTION with trace output going quietly to BUFFER.
-Like `trace-function-foreground' but without popping up the trace BUFFER or
-changing the window configuration."
+ "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: "))
(trace-function-internal function buffer t context))
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index 699392fb349..35a36b8498c 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,6 +1,6 @@
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 4c20a0974d1..b88af1dbe1a 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,8 +1,8 @@
;;; warnings.el --- log and display warnings
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -224,92 +224,99 @@ See the `warnings' custom group for user customization features.
See also `warning-series', `warning-prefix-function' and
`warning-fill-prefix' for additional programming features."
- (unless level
- (setq level :warning))
- (unless buffer-name
- (setq buffer-name "*Warnings*"))
- (if (assq level warning-level-aliases)
- (setq level (cdr (assq level warning-level-aliases))))
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-log-level))
- (warning-suppress-p type warning-suppress-log-types)
- (let* ((typename (if (consp type) (car type) type))
- (old (get-buffer buffer-name))
- (buffer (or old (get-buffer-create buffer-name)))
- (level-info (assq level warning-levels))
- start end)
- (with-current-buffer buffer
- ;; If we created the buffer, disable undo.
- (unless old
- (special-mode)
- (setq buffer-read-only t)
- (setq buffer-undo-list t))
- (goto-char (point-max))
- (when (and warning-series (symbolp warning-series))
- (setq warning-series
- (prog1 (point-marker)
- (unless (eq warning-series t)
- (funcall warning-series)))))
- (let ((inhibit-read-only t))
- (unless (bolp)
- (newline))
- (setq start (point))
- (if warning-prefix-function
- (setq level-info (funcall warning-prefix-function
- level level-info)))
- (insert (format (nth 1 level-info)
- (format warning-type-format typename))
- message)
- (newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
- (let ((fill-prefix warning-fill-prefix)
- (fill-column 78))
- (fill-region start (point))))
- (setq end (point)))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (goto-char warning-series)))
- (if (nth 2 level-info)
- (funcall (nth 2 level-info)))
- (cond (noninteractive
- ;; Noninteractively, take the text we inserted
- ;; in the warnings buffer and print it.
- ;; Do this unconditionally, since there is no way
- ;; to view logged messages unless we output them.
- (with-current-buffer buffer
- (save-excursion
- ;; Don't include the final newline in the arg
- ;; to `message', because it adds a newline.
- (goto-char end)
- (if (bolp)
- (forward-char -1))
- (message "%s" (buffer-substring start (point))))))
- ((and (daemonp) (null after-init-time))
- ;; Warnings assigned during daemon initialization go into
- ;; the messages buffer.
- (message "%s"
- (with-current-buffer buffer
- (save-excursion
- (goto-char end)
- (if (bolp)
- (forward-char -1))
- (buffer-substring start (point))))))
- (t
- ;; Interactively, decide whether the warning merits
- ;; immediate display.
- (or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-level))
- (warning-suppress-p type warning-suppress-types)
- (let ((window (display-buffer buffer)))
- (when (and (markerp warning-series)
- (eq (marker-buffer warning-series) buffer))
- (set-window-start window warning-series))
- (sit-for 0))))))))
+ (if (not (or after-init-time noninteractive (daemonp)))
+ ;; Ensure warnings that happen early in the startup sequence
+ ;; are visible when startup completes (bug#20792).
+ (delay-warning type message level buffer-name)
+ (unless level
+ (setq level :warning))
+ (unless buffer-name
+ (setq buffer-name "*Warnings*"))
+ (if (assq level warning-level-aliases)
+ (setq level (cdr (assq level warning-level-aliases))))
+ (or (< (warning-numeric-level level)
+ (warning-numeric-level warning-minimum-log-level))
+ (warning-suppress-p type warning-suppress-log-types)
+ (let* ((typename (if (consp type) (car type) type))
+ (old (get-buffer buffer-name))
+ (buffer (or old (get-buffer-create buffer-name)))
+ (level-info (assq level warning-levels))
+ start end)
+ (with-current-buffer buffer
+ ;; If we created the buffer, disable undo.
+ (unless old
+ (special-mode)
+ (setq buffer-read-only t)
+ (setq buffer-undo-list t))
+ (goto-char (point-max))
+ (when (and warning-series (symbolp warning-series))
+ (setq warning-series
+ (prog1 (point-marker)
+ (unless (eq warning-series t)
+ (funcall warning-series)))))
+ (let ((inhibit-read-only t))
+ (unless (bolp)
+ (newline))
+ (setq start (point))
+ (if warning-prefix-function
+ (setq level-info (funcall warning-prefix-function
+ level level-info)))
+ (insert (format (nth 1 level-info)
+ (format warning-type-format typename))
+ message)
+ (newline)
+ (when (and warning-fill-prefix (not (string-match "\n" message)))
+ (let ((fill-prefix warning-fill-prefix)
+ (fill-column 78))
+ (fill-region start (point))))
+ (setq end (point)))
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
+ (goto-char warning-series)))
+ (if (nth 2 level-info)
+ (funcall (nth 2 level-info)))
+ (cond (noninteractive
+ ;; Noninteractively, take the text we inserted
+ ;; in the warnings buffer and print it.
+ ;; Do this unconditionally, since there is no way
+ ;; to view logged messages unless we output them.
+ (with-current-buffer buffer
+ (save-excursion
+ ;; Don't include the final newline in the arg
+ ;; to `message', because it adds a newline.
+ (goto-char end)
+ (if (bolp)
+ (forward-char -1))
+ (message "%s" (buffer-substring start (point))))))
+ ((and (daemonp) (null after-init-time))
+ ;; Warnings assigned during daemon initialization go into
+ ;; the messages buffer.
+ (message "%s"
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char end)
+ (if (bolp)
+ (forward-char -1))
+ (buffer-substring start (point))))))
+ (t
+ ;; Interactively, decide whether the warning merits
+ ;; immediate display.
+ (or (< (warning-numeric-level level)
+ (warning-numeric-level warning-minimum-level))
+ (warning-suppress-p type warning-suppress-types)
+ (let ((window (display-buffer buffer)))
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
+ (set-window-start window warning-series))
+ (sit-for 0)))))))))
+;; Use \\<special-mode-map> so that help-enable-auto-load can do its thing.
+;; Any keymap that is defined will do.
;;;###autoload
(defun lwarn (type level message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
+ "Display a warning message made from (format-message MESSAGE ARGS...).
+\\<special-mode-map>
+Aside from generating the message with `format-message',
this is equivalent to `display-warning'.
TYPE is the warning type: either a custom group name (a symbol),
@@ -325,15 +332,15 @@ LEVEL should be either :debug, :warning, :error, or :emergency
:error -- invalid data or circumstances.
:warning -- suspicious data or circumstances.
:debug -- info for debugging only."
- (display-warning type (apply 'format message args) level))
+ (display-warning type (apply #'format-message message args) level))
;;;###autoload
(defun warn (message &rest args)
- "Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
+ "Display a warning message made from (format-message MESSAGE ARGS...).
+Aside from generating the message with `format-message',
this is equivalent to `display-warning', using
`emacs' as the type and `:warning' as the level."
- (display-warning 'emacs (apply 'format message args)))
+ (display-warning 'emacs (apply #'format-message message args)))
(provide 'warnings)
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index ac12c149b01..919cbcb0c50 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -1,10 +1,10 @@
;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, processes
;; This file is part of GNU Emacs.
@@ -109,8 +109,7 @@ Internal use only.")
(defun emacs-lock-live-process-p (buffer-or-name)
"Return t if BUFFER-OR-NAME is associated with a live process."
- (let ((proc (get-buffer-process buffer-or-name)))
- (and proc (process-live-p proc))))
+ (process-live-p (get-buffer-process buffer-or-name)))
(defun emacs-lock--can-auto-unlock (action)
"Return t if the current buffer can auto-unlock for ACTION.
diff --git a/lisp/emulation/.gitignore b/lisp/emulation/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/emulation/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 292fd401a56..52e1647ede7 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1,6 +1,6 @@
;;; cua-base.el --- emulate CUA key bindings
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua
@@ -96,10 +96,6 @@
;; This is done by highlighting the first occurrence of "redo"
;; and type "repeat" M-v M-v.
-;; Note: Since CUA-mode duplicates the functionality of the
-;; delete-selection-mode, that mode is automatically disabled when
-;; CUA-mode is enabled.
-
;; CUA mode indications
;; --------------------
@@ -281,7 +277,7 @@ enabled."
(defcustom cua-remap-control-v t
"If non-nil, C-v binding is used for paste (yank).
-Also, M-v is mapped to `cua-repeat-replace-region'."
+Also, M-v is mapped to `delete-selection-repeat-replace-region'."
:type 'boolean
:group 'cua)
@@ -298,6 +294,8 @@ But when the mark was set using \\[cua-set-mark], Transient Mark mode
is not turned on."
:type 'boolean
:group 'cua)
+(make-obsolete-variable 'cua-highlight-region-shift-only
+ 'transient-mark-mode "24.4")
(defcustom cua-prefix-override-inhibit-delay 0.2
"If non-nil, time in seconds to delay before overriding prefix key.
@@ -352,6 +350,8 @@ interpreted as a register number."
:group 'cua)
(defcustom cua-delete-copy-to-register-0 t
+ ;; FIXME: Obey delete-selection-save-to-register rather than hardcoding
+ ;; register 0.
"If non-nil, save last deleted region or rectangle to register 0."
:type 'boolean
:group 'cua)
@@ -601,8 +601,6 @@ a cons (TYPE . COLOR), then both properties are affected."
cua--last-killed-rectangle nil))
;; All behind cua--rectangle tests.
-(declare-function cua-copy-rectangle "cua-rect" (arg))
-(declare-function cua-cut-rectangle "cua-rect" (arg))
(declare-function cua--rectangle-left "cua-rect" (&optional val))
(declare-function cua--delete-rectangle "cua-rect" ())
(declare-function cua--insert-rectangle "cua-rect"
@@ -631,13 +629,6 @@ a cons (TYPE . COLOR), then both properties are affected."
;;; Aux. variables
-;; Current region was started using cua-set-mark.
-(defvar cua--explicit-region-start nil)
-(make-variable-buffer-local 'cua--explicit-region-start)
-
-;; Latest region was started using shifted movement command.
-(defvar cua--last-region-shifted nil)
-
;; buffer + point prior to current command when rectangle is active
;; checked in post-command hook to see if point was moved
(defvar cua--buffer-and-point-before-command nil)
@@ -694,7 +685,7 @@ a cons (TYPE . COLOR), then both properties are affected."
(defvar cua--prefix-override-timer nil)
(defvar cua--prefix-override-length nil)
-(defun cua--prefix-override-replay (arg repeat)
+(defun cua--prefix-override-replay (repeat)
(let* ((keys (this-command-keys))
(i (length keys))
(key (aref keys (1- i))))
@@ -714,28 +705,28 @@ a cons (TYPE . COLOR), then both properties are affected."
;; Don't record this command
(setq this-command last-command)
;; Restore the prefix arg
- (setq prefix-arg arg)
- (reset-this-command-lengths)
+ ;; This should make it so that exchange-point-and-mark gets the prefix when
+ ;; you do C-u C-x C-x C-x work (where the C-u is properly passed to the C-x
+ ;; C-x binding after the first C-x C-x was rewritten to just C-x).
+ (prefix-command-preserve-state)
;; Push the key back on the event queue
(setq unread-command-events (cons key unread-command-events))))
-(defun cua--prefix-override-handler (arg)
+(defun cua--prefix-override-handler ()
"Start timer waiting for prefix key to be followed by another key.
Repeating prefix key when region is active works as a single prefix key."
- (interactive "P")
- (cua--prefix-override-replay arg 0))
+ (interactive)
+ (cua--prefix-override-replay 0))
-(defun cua--prefix-repeat-handler (arg)
+(defun cua--prefix-repeat-handler ()
"Repeating prefix key when region is active works as a single prefix key."
- (interactive "P")
- (cua--prefix-override-replay arg 1))
+ (interactive)
+ (cua--prefix-override-replay 1))
(defun cua--prefix-copy-handler (arg)
"Copy region/rectangle, then replay last key."
(interactive "P")
- (if cua--rectangle
- (cua-copy-rectangle arg)
- (cua-copy-region arg))
+ (cua-copy-region arg)
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
@@ -743,9 +734,7 @@ Repeating prefix key when region is active works as a single prefix key."
(defun cua--prefix-cut-handler (arg)
"Cut region/rectangle, then replay last key."
(interactive "P")
- (if cua--rectangle
- (cua-cut-rectangle arg)
- (cua-cut-region arg))
+ (cua-cut-region arg)
(let ((keys (this-single-command-keys)))
(setq unread-command-events
(cons (aref keys (1- (length keys))) unread-command-events))))
@@ -755,7 +744,8 @@ Repeating prefix key when region is active works as a single prefix key."
(when (= (length (this-command-keys)) cua--prefix-override-length)
(setq unread-command-events (cons 'timeout unread-command-events))
(if prefix-arg
- (reset-this-command-lengths)
+ nil
+ ;; FIXME: Why?
(setq overriding-terminal-local-map nil))
(cua--select-keymaps)))
@@ -768,15 +758,14 @@ Repeating prefix key when region is active works as a single prefix key."
(call-interactively this-command))
(defun cua--keep-active ()
- (setq mark-active t
- deactivate-mark nil))
+ (when (mark t)
+ (setq mark-active t
+ deactivate-mark nil)))
(defun cua--deactivate (&optional now)
- (setq cua--explicit-region-start nil)
(if (not now)
(setq deactivate-mark t)
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook)))
+ (deactivate-mark)))
(defun cua--filter-buffer-noprops (start end)
(let ((str (filter-buffer-substring start end)))
@@ -805,37 +794,14 @@ Repeating prefix key when region is active works as a single prefix key."
;;; Region specific commands
-(defvar cua--last-deleted-region-pos nil)
-(defvar cua--last-deleted-region-text nil)
+(declare-function delete-active-region "delsel" (&optional killp))
(defun cua-delete-region ()
"Delete the active region.
Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
(interactive)
- (let ((start (mark)) (end (point)))
- (or (<= start end)
- (setq start (prog1 end (setq end start))))
- (setq cua--last-deleted-region-text (filter-buffer-substring start end))
- (if cua-delete-copy-to-register-0
- (set-register ?0 cua--last-deleted-region-text))
- (delete-region start end)
- (setq cua--last-deleted-region-pos
- (cons (current-buffer)
- (and (consp buffer-undo-list)
- (car buffer-undo-list))))
- (cua--deactivate)
- (/= start end)))
-
-(defun cua-replace-region ()
- "Replace the active region with the character you type."
- (interactive)
- (let ((not-empty (and cua-delete-selection (cua-delete-region))))
- (unless (eq this-original-command this-command)
- (let ((overwrite-mode
- (and overwrite-mode
- not-empty
- (not (eq this-original-command 'self-insert-command)))))
- (cua--fallback)))))
+ (require 'delsel)
+ (delete-active-region))
(defun cua-copy-region (arg)
"Copy the region to the kill ring.
@@ -848,11 +814,11 @@ With numeric prefix arg, copy to register 0-9 instead."
(setq start (prog1 end (setq end start))))
(cond
(cua--register
- (copy-to-register cua--register start end nil))
+ (copy-to-register cua--register start end nil 'region))
((eq this-original-command 'clipboard-kill-ring-save)
- (clipboard-kill-ring-save start end))
+ (clipboard-kill-ring-save start end 'region))
(t
- (copy-region-as-kill start end)))
+ (copy-region-as-kill start end 'region)))
(if cua-keep-region-after-copy
(cua--keep-active)
(cua--deactivate))))
@@ -870,11 +836,11 @@ With numeric prefix arg, copy to register 0-9 instead."
(setq start (prog1 end (setq end start))))
(cond
(cua--register
- (copy-to-register cua--register start end t))
+ (copy-to-register cua--register start end t 'region))
((eq this-original-command 'clipboard-kill-region)
- (clipboard-kill-region start end))
+ (clipboard-kill-region start end 'region))
(t
- (kill-region start end))))
+ (kill-region start end 'region))))
(cua--deactivate)))
;;; Generic commands for regions, rectangles, and global marks
@@ -883,12 +849,12 @@ With numeric prefix arg, copy to register 0-9 instead."
"Cancel the active region, rectangle, or global mark."
(interactive)
(setq mark-active nil)
- (setq cua--explicit-region-start nil)
(if (fboundp 'cua--cancel-rectangle)
(cua--cancel-rectangle)))
(declare-function x-clipboard-yank "../term/x-win" ())
+(put 'cua-paste 'delete-selection 'yank)
(defun cua-paste (arg)
"Paste last cut or copied region or rectangle.
An active region is deleted before executing the command.
@@ -897,8 +863,7 @@ If global mark is active, copy from register or one character."
(interactive "P")
(setq arg (cua--prefix-arg arg))
(let ((regtxt (and cua--register (get-register cua--register)))
- (count (prefix-numeric-value arg))
- paste-column paste-lines)
+ (count (prefix-numeric-value arg)))
(cond
((and cua--register (not regtxt))
(message "Nothing in register %c" cua--register))
@@ -906,30 +871,12 @@ If global mark is active, copy from register or one character."
(if regtxt
(cua--insert-at-global-mark regtxt)
(when (not (eobp))
- (cua--insert-at-global-mark (filter-buffer-substring (point) (+ (point) count)))
+ (cua--insert-at-global-mark
+ (filter-buffer-substring (point) (+ (point) count)))
(forward-char count))))
(buffer-read-only
(error "Cannot paste into a read-only buffer"))
(t
- ;; Must save register here, since delete may override reg 0.
- (if mark-active
- (if cua--rectangle
- (progn
- (goto-char (min (mark) (point)))
- (setq paste-column (cua--rectangle-left))
- (setq paste-lines (cua--delete-rectangle))
- (if (= paste-lines 1)
- (setq paste-lines nil))) ;; paste all
- ;; Before a yank command, make sure we don't yank the
- ;; head of the kill-ring that really comes from the
- ;; currently active region we are going to delete.
- ;; That would make yank a no-op.
- (if (and (string= (filter-buffer-substring (point) (mark))
- (car kill-ring))
- (fboundp 'mouse-region-match)
- (mouse-region-match))
- (current-kill 1))
- (cua-delete-region)))
(cond
(regtxt
(cond
@@ -937,16 +884,6 @@ If global mark is active, copy from register or one character."
((consp regtxt) (cua--insert-rectangle regtxt))
((stringp regtxt) (insert-for-yank regtxt))
(t (message "Unknown data in register %c" cua--register))))
- ((and cua--last-killed-rectangle
- (eq (and kill-ring (car kill-ring)) (car cua--last-killed-rectangle)))
- (let ((pt (point)))
- (when (not (eq buffer-undo-list t))
- (setq this-command 'cua--paste-rectangle)
- (undo-boundary)
- (setq buffer-undo-list (cons pt buffer-undo-list)))
- (cua--insert-rectangle (cdr cua--last-killed-rectangle)
- nil paste-column paste-lines)
- (if arg (goto-char pt))))
((eq this-original-command 'clipboard-yank)
(clipboard-yank))
((eq this-original-command 'x-clipboard-yank)
@@ -1011,53 +948,12 @@ See also `exchange-point-and-mark'."
(cond ((null cua-enable-cua-keys)
(exchange-point-and-mark arg))
(arg
- (setq mark-active t))
+ (when (mark t) (setq mark-active t)))
(t
(let (mark-active)
(exchange-point-and-mark)
- (if cua--rectangle
- (cua--rectangle-corner 0))))))
-
-;; Typed text that replaced the highlighted region.
-(defvar cua--repeat-replace-text nil)
-
-(defun cua-repeat-replace-region (arg)
- "Repeat replacing text of highlighted region with typed text.
-Searches for the next stretch of text identical to the region last
-replaced by typing text over it and replaces it with the same stretch
-of text."
- (interactive "P")
- (when cua--last-deleted-region-pos
- (save-excursion
- (save-restriction
- (set-buffer (car cua--last-deleted-region-pos))
- (widen)
- ;; Find the text that replaced the region via the undo list.
- (let ((ul buffer-undo-list)
- (elt (cdr cua--last-deleted-region-pos))
- u s e)
- (when elt
- (while (consp ul)
- (setq u (car ul) ul (cdr ul))
- (cond
- ((eq u elt) ;; got it
- (setq ul nil))
- ((and (consp u) (integerp (car u)) (integerp (cdr u)))
- (if (and s (= (cdr u) s))
- (setq s (car u))
- (setq s (car u) e (cdr u)))))))
- (cond ((and s e (<= s e) (= s (mark t)))
- (setq cua--repeat-replace-text (cua--filter-buffer-noprops s e)))
- ((and (null s) (eq u elt)) ;; nothing inserted
- (setq cua--repeat-replace-text
- ""))
- (t
- (message "Cannot locate replacement text"))))))
- (setq cua--last-deleted-region-pos nil))
- (if (and cua--last-deleted-region-text
- cua--repeat-replace-text
- (search-forward cua--last-deleted-region-text nil t nil))
- (replace-match cua--repeat-replace-text arg t)))
+ (if cua--rectangle
+ (cua--rectangle-corner 0))))))
(defun cua-help-for-region (&optional help)
"Show region specific help in echo area."
@@ -1125,19 +1021,17 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
(or (and cua-auto-mark-last-change
(cua-pop-to-last-change))
(pop-to-mark-command)))
- ((and cua-toggle-set-mark mark-active)
+ ((and cua-toggle-set-mark (region-active-p))
(cua--deactivate)
(message "Mark cleared"))
(t
(push-mark-command nil nil)
- (setq cua--explicit-region-start t)
- (setq cua--last-region-shifted nil)
(if cua-enable-region-auto-help
(cua-help-for-region t)))))
-;;; Scrolling commands which does not signal errors at top/bottom
-;;; of buffer at first key-press (instead moves to top/bottom
-;;; of buffer).
+;; Scrolling commands which do not signal errors at top/bottom
+;; of buffer at first key-press (instead moves to top/bottom
+;; of buffer).
(defun cua-scroll-up (&optional arg)
"Scroll text of current window upward ARG lines; or near full screen if no ARG.
@@ -1145,7 +1039,7 @@ If window cannot be scrolled further, move cursor to bottom line instead.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll downward.
If ARG is the atom `-', scroll downward by nearly full screen."
- (interactive "P")
+ (interactive "^P")
(cond
((eq arg '-) (cua-scroll-down nil))
((< (prefix-numeric-value arg) 0)
@@ -1166,7 +1060,7 @@ If window cannot be scrolled further, move cursor to top line instead.
A near full screen is `next-screen-context-lines' less than a full screen.
Negative ARG means scroll upward.
If ARG is the atom `-', scroll upward by nearly full screen."
- (interactive "P")
+ (interactive "^P")
(cond
((eq arg '-) (cua-scroll-up nil))
((< (prefix-numeric-value arg) 0)
@@ -1216,59 +1110,6 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(cancel-timer cua--prefix-override-timer))
(setq cua--prefix-override-timer nil))
- (cond
- ;; Only symbol commands can have necessary properties
- ((not (symbolp this-command))
- nil)
-
- ;; Handle delete-selection property on non-movement commands
- ((not (eq (get this-command 'CUA) 'move))
- (when (and mark-active (not deactivate-mark))
- (let* ((ds (or (get this-command 'delete-selection)
- (get this-command 'pending-delete)))
- (nc (cond
- ((not ds) nil)
- ((eq ds 'yank)
- 'cua-paste)
- ((eq ds 'kill)
- (if cua--rectangle
- 'cua-copy-rectangle
- 'cua-copy-region))
- ((eq ds 'supersede)
- (if cua--rectangle
- 'cua-delete-rectangle
- 'cua-delete-region))
- (t
- (if cua--rectangle
- 'cua-delete-rectangle ;; replace?
- 'cua-replace-region)))))
- (if nc
- (setq this-original-command this-command
- this-command nc)))))
-
- ;; Handle shifted cursor keys and other movement commands.
- ;; If region is not active, region is activated if key is shifted.
- ;; If region is active, region is canceled if key is unshifted
- ;; (and region not started with C-SPC).
- ;; If rectangle is active, expand rectangle in specified direction and
- ;; ignore the movement.
- (this-command-keys-shift-translated
- (unless mark-active
- (push-mark-command nil t))
- (setq cua--last-region-shifted t)
- (setq cua--explicit-region-start nil))
-
- ;; Set mark if user explicitly said to do so
- ((or cua--explicit-region-start cua--rectangle)
- (unless mark-active
- (push-mark-command nil nil)))
-
- ;; Else clear mark after this command.
- (t
- ;; If we set mark-active to nil here, the region highlight will not be
- ;; removed by the direct_output_ commands.
- (setq deactivate-mark t)))
-
;; Detect extension of rectangles by mouse or other movement
(setq cua--buffer-and-point-before-command
(if cua--rectangle (cons (current-buffer) (point)))))
@@ -1287,22 +1128,13 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(when (fboundp 'cua--rectangle-post-command)
(cua--rectangle-post-command))
(setq cua--buffer-and-point-before-command nil)
- (if (or (not mark-active) deactivate-mark)
- (setq cua--explicit-region-start nil))
;; Debugging
(if cua--debug
(cond
(cua--rectangle (cua--rectangle-assert))
- (mark-active (message "Mark=%d Point=%d Expl=%s"
- (mark t) (point) cua--explicit-region-start))))
-
- ;; Disable transient-mark-mode if rectangle active in current buffer.
- (if (not (window-minibuffer-p))
- (setq transient-mark-mode (and (not cua--rectangle)
- (if cua-highlight-region-shift-only
- (not cua--explicit-region-start)
- t))))
+ ((region-active-p) (message "Mark=%d Point=%d" (mark t) (point)))))
+
(if cua-enable-cursor-indications
(cua--update-indications))
@@ -1329,7 +1161,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
;; Return DEF if current key sequence is self-inserting in
;; global-map.
(if (memq (global-key-binding (this-single-command-keys))
- '(self-insert-command self-insert-iso))
+ '(self-insert-command))
def nil))
(defvar cua-global-keymap (make-sparse-keymap)
@@ -1360,13 +1192,13 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(defun cua--select-keymaps ()
;; Setup conditions for selecting the proper keymaps in cua--keymap-alist.
(setq cua--ena-region-keymap
- (and mark-active (not deactivate-mark)))
+ (and (region-active-p) (not deactivate-mark)))
(setq cua--ena-prefix-override-keymap
(and cua--ena-region-keymap
cua-enable-cua-keys
(not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t)
- (not cua--explicit-region-start))
+ (region-active-p))
(not executing-kbd-macro)
(not cua--prefix-override-timer)))
(setq cua--ena-prefix-repeat-keymap
@@ -1377,32 +1209,35 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(and cua-enable-cua-keys
(not cua-inhibit-cua-keys)
(or (eq cua-enable-cua-keys t)
- cua--last-region-shifted)))
+ (region-active-p))))
(setq cua--ena-global-mark-keymap
(and cua--global-mark-active
(not (window-minibuffer-p)))))
(defvar cua--keymaps-initialized nil)
-(defun cua--shift-control-prefix (prefix arg)
+(defun cua--shift-control-prefix (prefix)
;; handle S-C-x and S-C-c by emulating the fast double prefix function.
;; Don't record this command
(setq this-command last-command)
;; Restore the prefix arg
- (setq prefix-arg arg)
- (reset-this-command-lengths)
+ ;; This should make it so that exchange-point-and-mark gets the prefix when
+ ;; you do C-u S-C-x C-x work (where the C-u is properly passed to the C-x
+ ;; C-x binding after the first S-C-x was rewritten to just C-x).
+ (prefix-command-preserve-state)
;; Activate the cua--prefix-repeat-keymap
(setq cua--prefix-override-timer 'shift)
;; Push duplicate keys back on the event queue
- (setq unread-command-events (cons prefix (cons prefix unread-command-events))))
+ (setq unread-command-events
+ (cons prefix (cons prefix unread-command-events))))
-(defun cua--shift-control-c-prefix (arg)
- (interactive "P")
- (cua--shift-control-prefix ?\C-c arg))
+(defun cua--shift-control-c-prefix ()
+ (interactive)
+ (cua--shift-control-prefix ?\C-c))
-(defun cua--shift-control-x-prefix (arg)
- (interactive "P")
- (cua--shift-control-prefix ?\C-x arg))
+(defun cua--shift-control-x-prefix ()
+ (interactive)
+ (cua--shift-control-prefix ?\C-x))
(defun cua--init-keymaps ()
;; Cache actual rectangle modifier key.
@@ -1442,7 +1277,8 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(define-key cua--cua-keys-keymap [(control z)] 'undo))
(when cua-remap-control-v
(define-key cua--cua-keys-keymap [(control v)] 'yank)
- (define-key cua--cua-keys-keymap [(meta v)] 'cua-repeat-replace-region))
+ (define-key cua--cua-keys-keymap [(meta v)]
+ 'delete-selection-repeat-replace-region))
(define-key cua--prefix-override-keymap [(control x)] 'cua--prefix-override-handler)
(define-key cua--prefix-override-keymap [(control c)] 'cua--prefix-override-handler)
@@ -1457,13 +1293,6 @@ If ARG is the atom `-', scroll upward by nearly full screen."
(define-key cua--region-keymap [(shift control x)] 'cua--shift-control-x-prefix)
(define-key cua--region-keymap [(shift control c)] 'cua--shift-control-c-prefix)
- ;; replace current region
- (define-key cua--region-keymap [remap self-insert-command] 'cua-replace-region)
- (define-key cua--region-keymap [remap self-insert-iso] 'cua-replace-region)
- (define-key cua--region-keymap [remap insert-register] 'cua-replace-region)
- (define-key cua--region-keymap [remap newline-and-indent] 'cua-replace-region)
- (define-key cua--region-keymap [remap newline] 'cua-replace-region)
- (define-key cua--region-keymap [remap open-line] 'cua-replace-region)
;; delete current region
(define-key cua--region-keymap [remap delete-backward-char] 'cua-delete-region)
(define-key cua--region-keymap [remap backward-delete-char] 'cua-delete-region)
@@ -1483,43 +1312,12 @@ If ARG is the atom `-', scroll upward by nearly full screen."
)
-;; Setup standard movement commands to be recognized by CUA.
-
-(dolist (cmd
- '(forward-char backward-char
- right-char left-char
- right-word left-word
- next-line previous-line
- forward-word backward-word
- end-of-line beginning-of-line
- end-of-visual-line beginning-of-visual-line
- move-end-of-line move-beginning-of-line
- end-of-buffer beginning-of-buffer
- scroll-up scroll-down
- scroll-up-command scroll-down-command
- up-list down-list backward-up-list
- end-of-defun beginning-of-defun
- forward-sexp backward-sexp
- forward-list backward-list
- forward-sentence backward-sentence
- forward-paragraph backward-paragraph
- ;; CC mode motion commands
- c-forward-conditional c-backward-conditional
- c-down-conditional c-up-conditional
- c-down-conditional-with-else c-up-conditional-with-else
- c-beginning-of-statement c-end-of-statement))
- (put cmd 'CUA 'move))
-
-;; Only called if pc-selection-mode is t, which means pc-select is loaded.
-(declare-function pc-selection-mode "pc-select" (&optional arg))
-
;; State prior to enabling cua-mode
;; Value is a list with the following elements:
-;; transient-mark-mode
;; delete-selection-mode
-;; pc-selection-mode
(defvar cua--saved-state nil)
+(defvar delete-selection-save-to-register)
;;;###autoload
(define-minor-mode cua-mode
@@ -1544,12 +1342,7 @@ options:
You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
-the prefix fallback behavior.
-
-CUA mode manages Transient Mark mode internally. Trying to disable
-Transient Mark mode while CUA mode is enabled does not work; if you
-only want to highlight the region when it is selected using a
-shifted movement key, set `cua-highlight-region-shift-only'."
+the prefix fallback behavior."
:global t
:group 'cua
:set-after '(cua-enable-modeline-indications
@@ -1577,7 +1370,8 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(remove-hook 'post-command-hook 'cua--post-command-handler))
(if (not cua-mode)
- (setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists))
+ (setq emulation-mode-map-alists
+ (delq 'cua--keymap-alist emulation-mode-map-alists))
(add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400)
(cua--select-keymaps))
@@ -1585,33 +1379,23 @@ shifted movement key, set `cua-highlight-region-shift-only'."
(cua-mode
(setq cua--saved-state
(list
- transient-mark-mode
- (and (boundp 'delete-selection-mode) delete-selection-mode)
- (and (boundp 'pc-selection-mode) pc-selection-mode)
- shift-select-mode))
- (if (and (boundp 'delete-selection-mode) delete-selection-mode)
- (delete-selection-mode -1))
- (if (and (boundp 'pc-selection-mode) pc-selection-mode)
- (pc-selection-mode -1))
- (cua--deactivate)
- (setq shift-select-mode nil)
- (setq transient-mark-mode (and cua-mode
- (if cua-highlight-region-shift-only
- (not cua--explicit-region-start)
- t))))
+ (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)
+ (delete-selection-mode -1)))
+ (if cua-highlight-region-shift-only (transient-mark-mode -1))
+ (if cua-delete-copy-to-register-0
+ (setq delete-selection-save-to-register ?0))
+ (cua--deactivate))
(cua--saved-state
- (setq transient-mark-mode (car cua--saved-state))
- (if (nth 1 cua--saved-state)
- (delete-selection-mode 1))
- (if (nth 2 cua--saved-state)
- (pc-selection-mode 1))
- (setq shift-select-mode (nth 3 cua--saved-state))
+ (if (nth 0 cua--saved-state)
+ (delete-selection-mode 1)
+ (if (and (boundp 'delete-selection-mode) delete-selection-mode)
+ (delete-selection-mode -1)))
(if (called-interactively-p 'interactive)
- (message "CUA mode disabled.%s%s%s%s"
- (if (nth 1 cua--saved-state) " Delete-Selection" "")
- (if (and (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " and" "")
- (if (nth 2 cua--saved-state) " PC-Selection" "")
- (if (or (nth 1 cua--saved-state) (nth 2 cua--saved-state)) " enabled" "")))
+ (message "CUA mode disabled.%s"
+ (if (nth 0 cua--saved-state) " Delete-Selection enabled" "")))
(setq cua--saved-state nil))))
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index 78665624946..79fdd65efda 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -1,6 +1,6 @@
;;; cua-gmrk.el --- CUA unified global mark support
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience cua mark
@@ -321,7 +321,7 @@ With prefix argument, don't jump to global mark when canceling it."
(defun cua-cancel-global-mark ()
"Cancel the global mark."
(interactive)
- (if mark-active
+ (if (region-active-p)
(cua-cancel)
(if (cua--global-mark-active)
(cua--deactivate-global-mark t)))
@@ -362,7 +362,6 @@ With prefix argument, don't jump to global mark when canceling it."
(define-key cua--global-mark-keymap [remap backward-delete-char] 'cua-delete-backward-char-at-global-mark)
(define-key cua--global-mark-keymap [remap backward-delete-char-untabify] 'cua-delete-backward-char-at-global-mark)
(define-key cua--global-mark-keymap [remap self-insert-command] 'cua-insert-char-at-global-mark)
- (define-key cua--global-mark-keymap [remap self-insert-iso] 'cua-insert-char-at-global-mark)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--global-mark-keymap [t]
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 16d109c6360..ea8b52476f7 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1,6 +1,6 @@
;;; cua-rect.el --- CUA unified rectangle support
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard emulations convenience CUA
@@ -78,7 +78,7 @@
(push (list 'apply 0 s e
'cua--rect-undo-handler
(copy-sequence cua--rectangle) t s e)
- buffer-undo-list))))
+ buffer-undo-list))))
(defun cua--rect-undo-handler (rect on s e)
(if (setq on (not on))
@@ -89,6 +89,21 @@
'cua--rect-undo-handler rect on s e)
buffer-undo-list))
+;;;###autoload
+(define-minor-mode cua-rectangle-mark-mode
+ "Toggle the region as rectangular.
+Activates the region if needed. Only lasts until the region is deactivated."
+ :keymap cua--rectangle-keymap
+ (cond
+ (cua-rectangle-mark-mode
+ (add-hook 'deactivate-mark-hook
+ (lambda () (cua-rectangle-mark-mode -1)))
+ (add-hook 'post-command-hook #'cua--rectangle-post-command nil t)
+ (cua-set-rectangle-mark))
+ (t
+ (cua--deactivate-rectangle)
+ (remove-hook 'post-command-hook #'cua--rectangle-post-command t))))
+
;;; Rectangle geometry
(defun cua--rectangle-top (&optional val)
@@ -461,7 +476,7 @@ If command is repeated at same position, delete the rectangle."
(cua--deactivate))
(cua-mouse-resize-rectangle event)
(let ((cua-keep-region-after-copy t))
- (cua-copy-rectangle arg)
+ (cua-copy-region arg)
(setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle)))))
(defun cua--mouse-ignore (_event)
@@ -708,30 +723,34 @@ If command is repeated at same position, delete the rectangle."
killed-rectangle "")))))
(defun cua--activate-rectangle ()
- ;; Turn on rectangular marking mode by disabling transient mark mode
- ;; and manually handling highlighting from a post command hook.
+ ;; Set cua--rectangle to indicate we're marking a rectangle.
;; Be careful if we are already marking a rectangle.
(setq cua--rectangle
- (if (and cua--last-rectangle
+ (or (and cua--last-rectangle
(eq (car cua--last-rectangle) (current-buffer))
- (eq (car (cdr cua--last-rectangle)) (point)))
- (cdr (cdr cua--last-rectangle))
- (cua--rectangle-get-corners))
+ (eq (car (cdr cua--last-rectangle)) (point))
+ (cdr (cdr cua--last-rectangle)))
+ (cua--rectangle-get-corners))
cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "")
- cua--last-rectangle nil))
+ cua--last-rectangle nil)
+ (activate-mark))
;; (defvar cua-save-point nil)
(defun cua--deactivate-rectangle ()
;; This is used to clean up after `cua--activate-rectangle'.
- (mapc (function delete-overlay) cua--rectangle-overlays)
+ (mapc #'delete-overlay cua--rectangle-overlays)
(setq cua--last-rectangle (cons (current-buffer)
(cons (point) ;; cua-save-point
cua--rectangle))
cua--rectangle nil
cua--rectangle-overlays nil
cua--status-string nil
- cua--mouse-last-pos nil))
+ cua--mouse-last-pos nil)
+ ;; FIXME: This call to cua-rectangle-mark-mode is a workaround.
+ ;; Deactivation can happen in various different ways, and we
+ ;; currently don't handle them all in a coherent way.
+ (if cua-rectangle-mark-mode (cua-rectangle-mark-mode -1)))
(defun cua--highlight-rectangle ()
;; This function is used to highlight the rectangular region.
@@ -775,7 +794,7 @@ If command is repeated at same position, delete the rectangle."
(make-string
(- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
(if cua--virtual-edges-debug ?. ?\s))
- 'face (or (get-text-property (1- s) 'face) 'default)))
+ 'face (or (get-text-property (max (1- s) (point-min)) 'face) 'default)))
(if (/= pl le)
(setq s (1- s))))
(cond
@@ -877,8 +896,6 @@ With prefix argument, activate previous rectangle if possible."
(push-mark nil nil t)))
(cua--activate-rectangle)
(cua--rectangle-set-corners)
- (setq mark-active t
- cua--explicit-region-start t)
(if cua-enable-rectangle-auto-help
(cua-help-for-rectangle t))))
@@ -886,8 +903,7 @@ With prefix argument, activate previous rectangle if possible."
"Cancel current rectangle."
(interactive)
(when cua--rectangle
- (setq mark-active nil
- cua--explicit-region-start nil)
+ (setq mark-active nil)
(cua--deactivate-rectangle)))
(defun cua-toggle-rectangle-mark ()
@@ -945,32 +961,6 @@ With prefix argument, toggle restriction."
(interactive)
(cua--rectangle-move 'right))
-(defun cua-copy-rectangle (arg)
- (interactive "P")
- (setq arg (cua--prefix-arg arg))
- (cua--copy-rectangle-as-kill arg)
- (if cua-keep-region-after-copy
- (cua--keep-active)
- (cua--deactivate)))
-
-(defun cua-cut-rectangle (arg)
- (interactive "P")
- (if buffer-read-only
- (cua-copy-rectangle arg)
- (setq arg (cua--prefix-arg arg))
- (goto-char (min (mark) (point)))
- (cua--copy-rectangle-as-kill arg)
- (cua--delete-rectangle))
- (cua--deactivate))
-
-(defun cua-delete-rectangle ()
- (interactive)
- (goto-char (min (point) (mark)))
- (if cua-delete-copy-to-register-0
- (set-register ?0 (cua--extract-rectangle)))
- (cua--delete-rectangle)
- (cua--deactivate))
-
(defun cua-rotate-rectangle ()
(interactive)
(cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1))
@@ -1402,6 +1392,38 @@ With prefix arg, indent to that column."
(goto-char cua--rect-undo-set-point)
(setq cua--rect-undo-set-point nil)))
+(add-function :around region-extract-function
+ #'cua--rectangle-region-extract)
+(add-function :around redisplay-highlight-region-function
+ #'cua--rectangle-highlight-for-redisplay)
+
+(defun cua--rectangle-highlight-for-redisplay (orig &rest args)
+ (if (not cua--rectangle) (apply orig args)
+ ;; When cua--rectangle is active, just don't highlight at all, since we
+ ;; already do it elsewhere.
+ (funcall redisplay-unhighlight-region-function (nth 3 args))))
+
+(defun cua--rectangle-region-extract (orig &optional delete)
+ (cond
+ ((not cua--rectangle) (funcall orig delete))
+ ((eq delete 'delete-only) (cua--delete-rectangle))
+ (t
+ (let* ((strs (cua--extract-rectangle))
+ (str (mapconcat #'identity strs "\n")))
+ (if delete (cua--delete-rectangle))
+ (setq killed-rectangle strs)
+ (setq cua--last-killed-rectangle
+ (cons (and kill-ring (car kill-ring)) killed-rectangle))
+ (when (eq last-command 'kill-region)
+ ;; Try to prevent kill-region from appending this to some
+ ;; earlier element.
+ (setq last-command 'kill-region-dont-append))
+ (when strs
+ (put-text-property 0 (length str) 'yank-handler
+ `(rectangle--insert-for-yank ,strs t)
+ str)
+ str)))))
+
;;; Initialization
(defun cua--rect-M/H-key (key cmd)
@@ -1414,11 +1436,6 @@ With prefix arg, indent to that column."
(cua--rect-M/H-key ?\s 'cua-clear-rectangle-mark)
(cua--M/H-key cua--region-keymap ?\s 'cua-toggle-rectangle-mark))
- (define-key cua--rectangle-keymap [remap copy-region-as-kill] 'cua-copy-rectangle)
- (define-key cua--rectangle-keymap [remap kill-ring-save] 'cua-copy-rectangle)
- (define-key cua--rectangle-keymap [remap kill-region] 'cua-cut-rectangle)
- (define-key cua--rectangle-keymap [remap delete-char] 'cua-delete-rectangle)
- (define-key cua--rectangle-keymap [remap delete-forward-char] 'cua-delete-rectangle)
(define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
(define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
@@ -1440,7 +1457,6 @@ With prefix arg, indent to that column."
(define-key cua--rectangle-keymap [remap backward-delete-char] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap backward-delete-char-untabify] 'cua-delete-char-rectangle)
(define-key cua--rectangle-keymap [remap self-insert-command] 'cua-insert-char-rectangle)
- (define-key cua--rectangle-keymap [remap self-insert-iso] 'cua-insert-char-rectangle)
;; Catch self-inserting characters which are "stolen" by other modes
(define-key cua--rectangle-keymap [t]
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index 3f96d7392f0..a32ca560b8c 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -1,6 +1,6 @@
;;; edt-lk201.el --- enhanced EDT keypad mode emulation for LK-201 keyboards
-;; Copyright (C) 1986, 1992-1993, 1995, 2001-2013 Free Software
+;; Copyright (C) 1986, 1992-1993, 1995, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 138e3e6d0da..c002ecfd2ff 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -1,6 +1,6 @@
;;; edt-mapper.el --- create an EDT LK-201 map file for X-Windows Emacs
-;; Copyright (C) 1994-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
@@ -105,7 +105,7 @@
;;; Determine Window System, and X Server Vendor (if appropriate).
;;;
(defconst edt-window-system (if (featurep 'xemacs) (console-type) window-system)
- "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")
+ "Indicates window system (in GNU Emacs) or console type (in XEmacs).")
(declare-function x-server-vendor "xfns.c" (&optional terminal))
@@ -297,26 +297,26 @@
Here's a picture of the standard LK-201 keypad for reference:
- _______________________ _______________________________
- | HELP | DO | | F17 | F18 | F19 | F20 |
- | | | | | | | |
- |_______|_______________| |_______|_______|_______|_______|
- _______________________ _______________________________
- | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 |
- | | | | | | | | |
- |_______|_______|_______| |_______|_______|_______|_______|
- |SELECT |PREVIOU| NEXT | | KP7 | KP8 | KP9 | KP- |
- | | | | | | | | |
- |_______|_______|_______| |_______|_______|_______|_______|
- | UP | | KP4 | KP5 | KP6 | KP, |
- | | | | | | |
- _______|_______|_______ |_______|_______|_______|_______|
- | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | |
- | | | | | | | | |
- |_______|_______|_______| |_______|_______|_______| KPE |
- | KP0 | KPP | |
- | | | |
- |_______________|_______|_______|
+ ________________________ _______________________________
+ | HELP | DO | | F17 | F18 | F19 | F20 |
+ | | | | | | | |
+ |_______|________________| |_______|_______|_______|_______|
+ ________________________ _______________________________
+ | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 |
+ | | | | | | | | |
+ |_______|________|_______| |_______|_______|_______|_______|
+ |SELECT |PREVIOUS|NEXT | | KP7 | KP8 | KP9 | KP- |
+ | | | | | | | | |
+ |_______|________|_______| |_______|_______|_______|_______|
+ | UP | | KP4 | KP5 | KP6 | KP, |
+ | | | | | | |
+ _______|________|_______ |_______|_______|_______|_______|
+ | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | |
+ | | | | | | | | |
+ |_______|________|_______| |_______|_______|_______| KPE |
+ | KP0 | KPP | |
+ | | | |
+ |_______________|_______|_______|
REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY.
@@ -329,20 +329,20 @@
PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW.
- _______________________ _______________________________
- | HELP | DO | | F17 | F18 | F19 | F20 |
- |_______|_______________| |_______|_______|_______|_______|
- _______________________ _______________________________
- | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 |
- |_______|_______|_______| |_______|_______|_______|_______|
- |SELECT |PREVIOU| NEXT | | KP7 | KP8 | KP9 | KP- |
- |_______|_______|_______| |_______|_______|_______|_______|
- | UP | | KP4 | KP5 | KP6 | KP, |
- _______|_______|_______ |_______|_______|_______|_______|
- | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | |
- |_______|_______|_______| |_______|_______|_______| KPE |
- | KP0 | KPP | |
- |_______________|_______|_______|
+ ________________________ _______________________________
+ | HELP | DO | | F17 | F18 | F19 | F20 |
+ |_______|________________| |_______|_______|_______|_______|
+ ________________________ _______________________________
+ | FIND |INSERT |REMOVE | | PF1 | PF2 | PF3 | PF4 |
+ |_______|________|_______| |_______|_______|_______|_______|
+ |SELECT |PREVIOUS| NEXT | | KP7 | KP8 | KP9 | KP- |
+ |_______|________|_______| |_______|_______|_______|_______|
+ | UP | | KP4 | KP5 | KP6 | KP, |
+ _______|________|_______ |_______|_______|_______|_______|
+ | LEFT | DOWN | RIGHT | | KP1 | KP2 | KP3 | |
+ |_______|________|_______| |_______|_______|_______| KPE |
+ | KP0 | KPP | |
+ |_______________|_______|_______|
REMEMBER: JUST PRESS RETURN TO SKIP MAPPING A KEY.")))
@@ -353,7 +353,7 @@
(defun edt-map-key (ident descrip)
(interactive)
(if (featurep 'xemacs)
- (progn
+ (progn
(setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
(setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]"))
(cond ((not (equal edt-key edt-return))
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index 19b0fd00b4b..47a7f25ffa3 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -1,6 +1,6 @@
;;; edt-pc.el --- enhanced EDT keypad mode emulation for PC 101 keyboards
-;; Copyright (C) 1986, 1994-1995, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1986, 1994-1995, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index 3ed0bb8cddd..8704cbdf6b8 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -1,6 +1,6 @@
;;; edt-vt100.el --- enhanced EDT keypad mode emulation for VT series terminals
-;; Copyright (C) 1986, 1992-1993, 1995, 2002-2013 Free Software
+;; Copyright (C) 1986, 1992-1993, 1995, 2002-2015 Free Software
;; Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index 11a1c7f03b6..0c089698752 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -1,6 +1,6 @@
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
-;; Copyright (C) 1986, 1992-1995, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1986, 1992-1995, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
@@ -51,7 +51,7 @@
;; you initiate a GNU Emacs session, by adding the following line to
;; your init file:
;;
-;; (add-hook term-setup-hook 'edt-emulation-on)
+;; (add-hook 'emacs-startup-hook 'edt-emulation-on)
;; IMPORTANT: Be sure to read the Info node `edt' for more details.
;; It contains very helpful user information.
@@ -213,23 +213,23 @@ use within the EDT emulation."
(defcustom edt-word-entities '(?\t)
"Specifies the list of EDT word entity characters.
-The default list, (\?\\t), contains just the TAB character, which
+The default list, (?\\t), contains just the TAB character, which
emulates EDT. Characters are specified in the list using their
decimal ASCII values. A question mark, followed by the actual
character, can be used to indicate the numerical value of the
character, instead of the actual decimal value. So, ?A means the
-numerical value for the letter A, \?/ means the numerical value for /,
+numerical value for the letter A, ?/ means the numerical value for /,
etc. Several unprintable and special characters have special
representations, which you can also use:
- \?\\b specifies BS, C-h
- \?\\t specifies TAB, C-i
- \?\\n specifies LFD, C-j
- \?\\v specifies VTAB, C-k
- \?\\f specifies FF, C-l
- \?\\r specifies CR, C-m
- \?\\e specifies ESC, C-[
- \?\\\\ specifies \\
+ ?\\b specifies BS, C-h
+ ?\\t specifies TAB, C-i
+ ?\\n specifies LFD, C-j
+ ?\\v specifies VTAB, C-k
+ ?\\f specifies FF, C-l
+ ?\\r specifies CR, C-m
+ ?\\e specifies ESC, C-[
+ ?\\\\ specifies \\
In EDT Emulation movement-by-word commands, each character in the list
will be treated as if it were a separate word."
@@ -311,10 +311,10 @@ This means that an edt-user.el file was found in the user's `load-path'.")
;;; o edt-emulation-on o edt-load-keys
;;;
(defconst edt-emacs-variant (if (featurep 'emacs) "gnu" "xemacs")
- "Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).")
+ "Indicates Emacs variant: GNU Emacs or XEmacs (aka Lucid Emacs).")
(defconst edt-window-system (if (featurep 'emacs) window-system (console-type))
- "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")
+ "Indicates window system (in GNU Emacs) or console type (in XEmacs).")
(declare-function x-server-vendor "xfns.c" (&optional terminal))
@@ -1984,7 +1984,8 @@ created."
(if (edt-y-or-n-p "Do you want to run it now? ")
(load-file path)
(error "EDT Emulation not configured")))
- (insert "Nope, I can't seem to find it. :-(\n\n")
+ (insert (substitute-command-keys
+ "Nope, I can't seem to find it. :-(\n\n"))
(sit-for 20)
(error "EDT Emulation not configured"))))))
@@ -2034,7 +2035,8 @@ created."
;; Make highlighting of selected text work properly for EDT commands.
(if (featurep 'emacs)
(progn
- (setq edt-orig-transient-mark-mode transient-mark-mode)
+ (setq edt-orig-transient-mark-mode
+ (default-value 'transient-mark-mode))
(add-hook 'activate-mark-hook
(function
(lambda ()
@@ -2069,7 +2071,7 @@ created."
(edt-reset)
(force-mode-line-update t)
(if (featurep 'emacs)
- (setq transient-mark-mode edt-orig-transient-mark-mode))
+ (setq-default transient-mark-mode edt-orig-transient-mark-mode))
(message "Original key bindings restored; EDT Emulation disabled"))
(defun edt-default-menu-bar-update-buffers ()
diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el
index 83719378e10..8d5e6cf9b5b 100644
--- a/lisp/emulation/keypad.el
+++ b/lisp/emulation/keypad.el
@@ -1,6 +1,6 @@
;;; keypad.el --- simplified keypad bindings
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index c39d896f3d3..960ccedd4dd 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -1,6 +1,6 @@
;;; viper-cmd.el --- Vi command support for Viper
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -961,11 +961,11 @@ Suffixes such as .el or .elc should be stripped."
(defun viper-ESC (arg)
"Emulate ESC key in Emacs.
Prevents multiple escape keystrokes if viper-no-multiple-ESC is true.
-If viper-no-multiple-ESC is 'twice double ESC would ding in vi-state.
+If `viper-no-multiple-ESC' is `twice' double ESC would ding in vi-state.
Other ESC sequences are emulated via the current Emacs's major mode
keymap. This is more convenient on TTYs, since this won't block
function keys such as up, down, etc. ESC will also will also work as
-a Meta key in this case. When viper-no-multiple-ESC is nil, ESC works
+a Meta key in this case. When `viper-no-multiple-ESC' is nil, ESC works
as a Meta key and any number of multiple escapes are allowed."
(interactive "P")
(let (char)
@@ -1536,7 +1536,7 @@ as a Meta key and any number of multiple escapes are allowed."
(defun viper-repeat (arg)
"Re-execute last destructive command.
Use the info in viper-d-com, which has the form
-\(com val ch reg inserted-text command-keys\),
+\(com val ch reg inserted-text command-keys),
where `com' is the command to be re-executed, `val' is the
argument to `com', `ch' is a flag for repeat, and `reg' is optional;
if it exists, it is the name of the register for `com'.
@@ -1751,8 +1751,8 @@ invokes the command before that, etc."
(setq this-command 'viper-display-current-destructive-command)
- (message " `.' runs %s%s"
- (concat "`" (viper-array-to-string keys) "'")
+ (message " `.' runs `%s'%s"
+ (viper-array-to-string keys)
(viper-abbreviate-string
(if (featurep 'xemacs)
(replace-in-string ; xemacs
@@ -1763,7 +1763,8 @@ invokes the command before that, etc."
text ; emacs
)
max-text-len
- " inserting `" "'" " ......."))
+ (format-message " inserting `") (format-message "'")
+ " ......."))
))
@@ -1896,7 +1897,7 @@ Undo previous insertion and inserts new."
;; Quote region by each line with a user supplied string.
(defun viper-quote-region ()
(let ((quote-str viper-quote-string)
- (donot-change-default t))
+ (do-not-change-default t))
(setq quote-str
(viper-read-string-with-history
"Quote string: "
@@ -1908,9 +1909,9 @@ Undo previous insertion and inserts new."
((string-match "lisp.*-mode" (symbol-name major-mode)) ";;")
((memq major-mode '(c-mode cc-mode c++-mode)) "//")
((memq major-mode '(sh-mode shell-mode)) "#")
- (t (setq donot-change-default nil)
+ (t (setq do-not-change-default nil)
quote-str))))
- (or donot-change-default
+ (or do-not-change-default
(setq viper-quote-string quote-str))
(viper-enlarge-region (point) (mark t))
(if (> (point) (mark t)) (exchange-point-and-mark))
@@ -3423,7 +3424,7 @@ controlled by the sign of prefix numeric value."
((re-search-backward "[][(){}]" beg-lim t))
(t
(error "No matching character on line"))))
- (cond ((looking-at "[\(\[{]")
+ (cond ((looking-at "[([{]")
(if com (viper-move-marker-locally 'viper-com-point (point)))
(forward-sexp 1)
(if com
@@ -3447,7 +3448,7 @@ controlled by the sign of prefix numeric value."
(interactive)
(setq viper-parse-sexp-ignore-comments
(not viper-parse-sexp-ignore-comments))
- (princ (format
+ (princ (format-message
"From now on, `%%' will %signore parentheses inside comment fields"
(if viper-parse-sexp-ignore-comments "" "NOT "))))
@@ -3639,24 +3640,26 @@ the Emacs binding of `/'."
(let (msg)
(cond ((or (eq arg 1)
(and (null arg)
- (y-or-n-p (format "Search style: '%s'. Want '%s'? "
- (if viper-case-fold-search
- "case-insensitive" "case-sensitive")
- (if viper-case-fold-search
- "case-sensitive"
- "case-insensitive")))))
+ (y-or-n-p (format-message
+ "Search style: `%s'. Want `%s'? "
+ (if viper-case-fold-search
+ "case-insensitive" "case-sensitive")
+ (if viper-case-fold-search
+ "case-sensitive"
+ "case-insensitive")))))
(setq viper-case-fold-search (null viper-case-fold-search))
(if viper-case-fold-search
(setq msg "Search becomes case-insensitive")
(setq msg "Search becomes case-sensitive")))
((or (eq arg 2)
(and (null arg)
- (y-or-n-p (format "Search style: '%s'. Want '%s'? "
- (if viper-re-search
- "regexp-search" "vanilla-search")
- (if viper-re-search
- "vanilla-search"
- "regexp-search")))))
+ (y-or-n-p (format-message
+ "Search style: `%s'. Want `%s'? "
+ (if viper-re-search
+ "regexp-search" "vanilla-search")
+ (if viper-re-search
+ "vanilla-search"
+ "regexp-search")))))
(setq viper-re-search (null viper-re-search))
(if viper-re-search
(setq msg "Search becomes regexp-style")
@@ -3730,7 +3733,7 @@ With a prefix argument, this function unsets the macros.
If the optional prefix argument is non-nil and specifies a valid major mode,
this sets the macros only in the macros in that major mode. Otherwise,
the macros are set in the current major mode.
-\(When unsetting the macros, the second argument has no effect.\)"
+\(When unsetting the macros, the second argument has no effect.)"
(interactive "P")
(or noninteractive
(if (not unset)
@@ -3977,7 +3980,7 @@ Null string will repeat previous search."
(let (buffer buffer-name)
(setq buffer-name
(funcall viper-read-buffer-function
- (format "Kill buffer \(%s\): "
+ (format "Kill buffer (%s): "
(buffer-name (current-buffer)))))
(setq buffer
(if (null buffer-name)
@@ -3986,7 +3989,7 @@ Null string will repeat previous search."
(if (null buffer) (error "`%s': No such buffer" buffer-name))
(if (or (not (buffer-modified-p buffer))
(y-or-n-p
- (format
+ (format-message
"Buffer `%s' is modified, are you sure you want to kill it? "
buffer-name)))
(kill-buffer buffer)
@@ -4339,7 +4342,7 @@ and regexp replace."
(query-replace-regexp
str
(viper-read-string-with-history
- (format "Query replace regexp `%s' with: " str)
+ (format-message "Query replace regexp `%s' with: " str)
nil ; no initial
'viper-replace1-history
(car viper-replace1-history) ; default
@@ -4347,7 +4350,7 @@ and regexp replace."
(query-replace
str
(viper-read-string-with-history
- (format "Query replace `%s' with: " str)
+ (format-message "Query replace `%s' with: " str)
nil ; no initial
'viper-replace1-history
(car viper-replace1-history) ; default
@@ -4400,7 +4403,7 @@ and regexp replace."
;; etc.
(defun viper-cycle-through-mark-ring ()
"Visit previous locations on the mark ring.
-One can use `` and '' to temporarily jump 1 step back."
+One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
(let* ((sv-pt (point)))
;; if repeated `m,' command, pop the previously saved mark.
;; Prev saved mark is actually prev saved point. It is used if the
@@ -4533,7 +4536,7 @@ One can use `` and '' to temporarily jump 1 step back."
(interactive)
(if viper-cted
(let ((p (point)) (c (current-column)) bol (indent t))
- (if (looking-back "[0^]")
+ (if (looking-back "[0^]" (1- (point)))
(progn
(if (eq ?^ (preceding-char))
(setq viper-preserve-indent t))
@@ -4545,7 +4548,7 @@ One can use `` and '' to temporarily jump 1 step back."
(delete-region (point) p)
(if indent
(indent-to (- c viper-shift-width)))
- (if (or (bolp) (looking-back "[^ \t]"))
+ (if (or (bolp) (looking-back "[^ \t]" (1- (point))))
(setq viper-cted nil)))))
;; do smart indent
@@ -4585,7 +4588,7 @@ One can use `` and '' to temporarily jump 1 step back."
;; Viewing registers
(defun viper-ket-function (arg)
- "Function called by \], the ket. View registers and call \]\]."
+ "Function called by ], the ket. View registers and call ]]."
(interactive "P")
(let ((reg (read-char)))
(cond ((viper-valid-register reg '(letter Letter))
@@ -4602,7 +4605,7 @@ One can use `` and '' to temporarily jump 1 step back."
viper-InvalidRegister reg)))))
(defun viper-brac-function (arg)
- "Function called by \[, the brac. View textmarkers and call \[\[."
+ "Function called by [, the brac. View textmarkers and call [[."
(interactive "P")
(let ((reg (read-char)))
(cond ((viper= ?\[ reg)
@@ -4636,12 +4639,12 @@ One can use `` and '' to temporarily jump 1 step back."
(substring text 0 (- pos s))
reg (substring text (- pos s)))))
(princ
- (format
+ (format-message
"Textmarker `%c' is in buffer `%s' at line %d.\n"
reg (buffer-name buf) line-no))
(princ (format "Here is some text around %c:\n\n %s"
reg text)))
- (princ (format viper-EmptyTextmarker reg))))
+ (princ (format-message viper-EmptyTextmarker reg))))
))
(t (error viper-InvalidTextmarker reg)))))
@@ -4782,10 +4785,10 @@ sensitive for VI-style look-and-feel."
(setq repeated t))
(setq dont-change-unless t
level-changed t)
- (insert "
+ (insert (substitute-command-keys "
Please specify your level of familiarity with the venomous VI PERil
\(and the VI Plan for Emacs Rescue).
-You can change it at any time by typing `M-x viper-set-expert-level RET'
+You can change it at any time by typing `\\[viper-set-expert-level]'
1 -- BEGINNER: Almost all Emacs features are suppressed.
Feels almost like straight Vi. File name completion and
@@ -4803,7 +4806,7 @@ You can change it at any time by typing `M-x viper-set-expert-level RET'
viper-electric-mode, viper-want-ctl-h-help, viper-want-emacs-keys-in-vi,
and viper-want-emacs-keys-in-insert. Adjust these to your taste.
-Please, specify your level now: ")
+Please, specify your level now: "))
(setq viper-expert-level (- (viper-read-char-exclusive) ?0))
) ; end while
@@ -4831,6 +4834,7 @@ Please, specify your level now: ")
(beep 1))
+;; FIXME Use register-read-with-preview?
;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer
(defun viper-register-to-point (char &optional enforce-buffer)
"Like `jump-to-register', but switches to another buffer in another window."
@@ -4977,7 +4981,7 @@ back trace of the execution that leads to the error. Please include this
trace in your bug report.
If you believe that one of Viper's commands goes into an infinite loop
-\(e.g., Emacs freezes\), type:
+\(e.g., Emacs freezes), type:
M-x set-variable <Return> debug-on-quit <Return> t <Return>
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index f4fcdfd1199..6e55ac5b5d6 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,6 +1,6 @@
;;; viper-ex.el --- functions implementing the Ex commands for Viper
-;; Copyright (C) 1994-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -396,7 +396,7 @@ reversed."
))
;; Get an ex-token which is either an address or a command.
-;; A token has a type, \(command, address, end-mark\), and a value
+;; A token has a type, (command, address, end-mark), and a value
(defun viper-get-ex-token ()
(save-window-excursion
(setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
@@ -455,7 +455,8 @@ reversed."
(while (and (not (eolp)) cont)
;;(re-search-forward "[^/]*/")
(re-search-forward "[^/]*\\(/\\|\n\\)")
- (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
+ (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"
+ (line-beginning-position 0)))
(setq cont nil))))
(backward-char 1)
(setq ex-token (buffer-substring (point) (mark t)))
@@ -468,7 +469,8 @@ reversed."
(while (and (not (eolp)) cont)
;;(re-search-forward "[^\\?]*\\?")
(re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
- (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
+ (if (not (looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"
+ (line-beginning-position 0)))
(setq cont nil))
(backward-char 1)
(if (not (looking-at "\n")) (forward-char 1))))
@@ -489,7 +491,7 @@ reversed."
(forward-char 1)
(cond ((looking-at "'") (setq ex-token nil))
((looking-at "[a-z]") (setq ex-token (following-char)))
- (t (error "Marks are ' and a-z")))
+ (t (error "%s" "Marks are ' and a-z")))
(forward-char 1))
((looking-at "\n")
(setq ex-token-type 'end-mark)
@@ -563,14 +565,18 @@ reversed."
save-pos (point)))
(if (or (= dist 0)
- (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
+ (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)"
+ (line-beginning-position))
(looking-back
- "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
+ "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"
+ (line-beginning-position)))
;; Preceding characters are not the ones allowed in an Ex command
;; or we have typed past command name.
;; Note: we didn't do parsing, so there can be surprises.
- (if (or (looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
- (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
+ (if (or (looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*"
+ (line-beginning-position))
+ (looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)"
+ (line-beginning-position))
(looking-at "[^ \t\n\C-m]"))
nil
(with-output-to-temp-buffer "*Completions*"
@@ -747,7 +753,8 @@ reversed."
(error "Missing closing delimiter for global regexp")
(goto-char (point-max))))
(if (not (looking-back
- (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
+ (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)
+ (line-beginning-position 0)))
(setq cont nil)
;; we are at an escaped delimiter: unescape it and continue
(delete-char -2)
@@ -963,7 +970,7 @@ reversed."
(while (re-search-forward "%\\|#" nil t)
(let ((data (match-data))
(char (buffer-substring (match-beginning 0) (match-end 0))))
- (if (looking-back (concat "\\\\" char))
+ (if (looking-back "\\\\." (- (point) 2))
(replace-match char)
(store-match-data data)
(if (string= char "%")
@@ -989,7 +996,7 @@ reversed."
(get-buffer-create viper-ex-work-buf-name))
(skip-chars-forward " \t")
(if (looking-at "!")
- (if (and (not (looking-back "[ \t]"))
+ (if (and (not (looking-back "[ \t]" (1- (point))))
;; read doesn't have a corresponding :r! form, so ! is
;; immediately interpreted as a shell command.
(not (string= ex-token "read")))
@@ -1066,7 +1073,7 @@ reversed."
(cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer))
;; apparently the argument to an Ex command is
;; supposed to be a shell command
- ((looking-back "^[ \t]*!.*")
+ ((looking-back "^[ \t]*!.*" (line-beginning-position))
(setq ex-cmdfile t)
(insert " "))
(t
@@ -1651,7 +1658,7 @@ reversed."
(if (and (not (string= ex-file (buffer-file-name)))
(buffer-modified-p)
(not ex-variant))
- (error "No write since last change \(:rec! overrides\)"))
+ (error "No write since last change (:rec! overrides)"))
(recover-file ex-file))
;; Tell that `rewind' is obsolete and to use `:next count' instead
@@ -1887,7 +1894,8 @@ Please contact your system administrator. "
(if (featurep 'xemacs) "X" "")
))))))
-;; Ex source command. Loads the file specified as argument or `~/.viper'
+;; Ex source command.
+;; Loads the file specified as argument or viper-custom-file-name.
(defun ex-source ()
(viper-get-ex-file)
(if (string= ex-file "")
@@ -2182,7 +2190,7 @@ Please contact your system administrator. "
(defun ex-compile ()
"Reads args from the command line, then runs make with the args.
If no args are given, then it runs the last compile command.
-Type 'mak ' (including the space) to run make with no args."
+Type `mak ' (including the space) to run make with no args."
(let (args)
(with-current-buffer (setq viper-ex-work-buf
(get-buffer-create viper-ex-work-buf-name))
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index aa90344d195..f422a1354a9 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -1,6 +1,6 @@
;;; viper-init.el --- some common definitions for Viper
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -102,7 +102,7 @@ docstring. The variable becomes buffer-local whenever set."
(declare (indent defun))
`(progn
(defvar ,var ,default-value
- ,(format "%s\n\(buffer local\)" documentation))
+ ,(format "%s\n(buffer local)" documentation))
(make-variable-buffer-local ',var)))
;; (viper-loop COUNT BODY) Execute BODY COUNT times.
@@ -279,7 +279,7 @@ The minor mode viper-vi-diehard-minor-mode is in effect when
viper-expert-level is 1 or 2 or when viper-want-emacs-keys-in-vi is t.
The minor mode viper-insert-diehard-minor-mode is in effect when
viper-expert-level is 1 or 2 or if viper-want-emacs-keys-in-insert is t.
-Use `M-x viper-set-expert-level' to change this.")
+Use `\\[viper-set-expert-level]' to change this.")
;; Max expert level supported by Viper. This is NOT a user option.
;; It is here to make it hard for the user from resetting it.
@@ -463,7 +463,7 @@ color displays. By default, the delimiters are used only on TTYs."
:type 'boolean
:group 'viper)
-(defcustom viper-read-buffer-function 'read-buffer
+(defcustom viper-read-buffer-function #'read-buffer
"Function to use for prompting the user for a buffer name."
:type 'symbol
:group 'viper)
@@ -583,7 +583,7 @@ the Insert state."
(defcustom viper-keep-point-on-repeat t
"If t, don't move point when repeating previous command.
-This is useful for doing repeated changes with the '.' key.
+This is useful for doing repeated changes with the `.' key.
The user can change this to nil, if she likes when the cursor moves
to a new place after repeating previous Vi command."
:type 'boolean
@@ -778,7 +778,7 @@ Related buffers can be cycled through via :R and :P commands."
"^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex
"^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo
"^.+:-") ; prolog
- "Regexps for Headings. Used by \[\[ and \]\].")
+ "Regexps for Headings. Used by [[ and ]].")
(defvar viper-heading-end
(concat "^}\\|" ; C/C++
@@ -786,7 +786,7 @@ Related buffers can be cycled through via :R and :P commands."
"^@end \\|" ; texinfo
")\n\n[ \t\n]*\\|" ; lisp
"\\.\\s-*$") ; prolog
- "*Regexps to end Headings/Sections. Used by \[\].")
+ "*Regexps to end Headings/Sections. Used by [].")
;; These two vars control the interaction of jumps performed by ' and `.
@@ -922,7 +922,7 @@ value refers to the number of characters affected."
(defcustom viper-vi-style-in-minibuffer t
"If t, use vi-style editing in minibuffer.
-Should be set in `~/.viper' file."
+Should be set in `viper-custom-file-name'."
:type 'boolean
:group 'viper)
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index d33b5f4ed58..272556d3bae 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -1,6 +1,6 @@
;;; viper-keym.el --- Viper keymaps
-;; Copyright (C) 1994-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -60,13 +60,13 @@ Full Vi compatibility is not recommended for power use of Viper."
:group 'viper)
(defcustom viper-no-multiple-ESC t
- "If true, multiple ESC in Vi mode will cause bell to ring.
-This is set to t on a windowing terminal and to 'twice on a dumb
+ "If non-nil, multiple ESC in Vi mode will cause bell to ring.
+This is set to t on a windowing terminal and to `twice' on a dumb
terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
enables cursor keys and is generally more convenient, as terminals usually
don't have a convenient Meta key.
-Setting viper-no-multiple-ESC to nil will allow as many multiple ESC,
-as is allowed by the major mode in effect."
+Setting it to nil will allow as many multiple ESC, as is allowed by the
+major mode in effect."
:type 'boolean
:group 'viper)
@@ -147,8 +147,8 @@ viper-insert-basic-map. Not recommended, except for novice users.")
(defvar viper-empty-keymap (make-sparse-keymap))
;; This was the main Vi mode in old versions of VIP which may have been
-;; extensively used by VIP users. We declare it as a global var
-;; and, after .viper is loaded, we add this keymap to viper-vi-basic-map.
+;; extensively used by VIP users. We declare it as a global var and, after
+;; viper-custom-file-name is loaded, we add this keymap to viper-vi-basic-map.
(defvar viper-mode-map (make-sparse-keymap))
;; Some important keys used in viper
@@ -502,7 +502,7 @@ ALIST is of the form ((key . func) (key . func) ...)
Normally, this would be called from a hook to a major mode or
on a per buffer basis.
Usage:
- (viper-add-local-keys state '((key-str . func) (key-str . func)...)) "
+ (viper-add-local-keys state \\='((key-str . func) (key-str . func)...)) "
(let (map)
(cond ((eq state 'vi-state)
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index de0155d8158..3aff0628b5f 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -1,6 +1,6 @@
;;; viper-macs.el --- functions implementing keyboard macros for Viper
-;; Copyright (C) 1994-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -322,12 +322,13 @@ a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
;; More general definitions are inherited by more specific scopes:
;; global->major mode->buffer. More specific definitions override more general
(defun viper-record-kbd-macro (macro-name state macro-body &optional scope)
- "Record a Vi macro. Can be used in `.viper' file to define permanent macros.
+ "Record a Vi macro.
+Can be used in `viper-custom-file-name' to define permanent macros.
MACRO-NAME is a string of characters or a vector of keys. STATE is
either `vi-state' or `insert-state'. It specifies the Viper state in which to
define the macro. MACRO-BODY is a string that represents the keyboard macro.
-Optional SCOPE says whether the macro should be global \(t\), mode-specific
-\(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
+Optional SCOPE says whether the macro should be global \(t), mode-specific
+\(a major-mode symbol), or buffer-specific \(buffer name, a string).
If SCOPE is nil, the user is asked to specify the scope."
(let* (state-name keymap
(macro-alist-var
@@ -351,8 +352,8 @@ If SCOPE is nil, the user is asked to specify the scope."
(error "Can't map an empty macro name"))
;; Macro-name is usually a vector. However, command history or macros
- ;; recorded in ~/.viper may be recorded as strings. So, convert to
- ;; vectors.
+ ;; recorded in viper-custom-file-name may be recorded as strings.
+ ;; So, convert to vectors.
(setq macro-name (viper-fixup-macro macro-name))
(if (viper-char-array-p macro-name)
(setq macro-name (viper-char-array-to-macro macro-name)))
@@ -368,11 +369,11 @@ If SCOPE is nil, the user is asked to specify the scope."
(setq scope
(cond
((y-or-n-p
- (format
+ (format-message
"Map this macro for buffer `%s' only? "
(buffer-name)))
(setq msg
- (format
+ (format-message
"%S is mapped to %s for %s in `%s'"
(viper-display-macro macro-name)
(viper-abbreviate-string
@@ -384,11 +385,11 @@ If SCOPE is nil, the user is asked to specify the scope."
state-name (buffer-name)))
(buffer-name))
((y-or-n-p
- (format
+ (format-message
"Map this macro for the major mode `%S' only? "
major-mode))
(setq msg
- (format
+ (format-message
"%S is mapped to %s for %s in `%S'"
(viper-display-macro macro-name)
(viper-abbreviate-string
@@ -422,7 +423,7 @@ If SCOPE is nil, the user is asked to specify the scope."
;; if we don't let vector macro-body through %S,
;; the symbols `\.' `\[' etc will be converted into
;; characters, causing invalid read error on recorded
- ;; macros in .viper.
+ ;; macros in viper-custom-file-name.
;; I am not sure is macro-body can still be a string at
;; this point, but I am preserving this option anyway.
(if (vectorp macro-body)
@@ -483,11 +484,11 @@ If SCOPE is nil, the user is asked to specify the scope."
;; in effect
(defun viper-unrecord-kbd-macro (macro-name state)
"Delete macro MACRO-NAME from Viper STATE.
-MACRO-NAME must be a vector of viper-style keys. This command is used by Viper
-internally, but the user can also use it in ~/.viper to delete pre-defined
-macros supplied with Viper. The best way to avoid mistakes in macro names to
-be passed to this function is to use viper-describe-kbd-macros and copy the
-name from there."
+MACRO-NAME must be a vector of viper-style keys. This command is used
+by Viper internally, but you can also use it in `viper-custom-file-name'
+to delete pre-defined macros supplied with Viper. The best way to avoid
+mistakes in macro names to be passed to this function is to use
+`viper-describe-kbd-macros' and copy the name from there."
(let* (state-name keymap
(macro-alist-var
(cond ((eq state 'vi-state)
@@ -507,7 +508,8 @@ name from there."
macro-pair macro-entry)
;; Macro-name is usually a vector. However, command history or macros
- ;; recorded in ~/.viper may appear as strings. So, convert to vectors.
+ ;; recorded in viper-custom-file-name may appear as strings.
+ ;; So, convert to vectors.
(setq macro-name (viper-fixup-macro macro-name))
(if (viper-char-array-p macro-name)
(setq macro-name (viper-char-array-to-macro macro-name)))
@@ -527,9 +529,9 @@ name from there."
(cond ((and (cdr buf-mapping)
(or (and (not (cdr mode-mapping)) (not (cdr global-mapping)))
(y-or-n-p
- (format "Unmap %S for `%s' only? "
- (viper-display-macro macro-name)
- (buffer-name)))))
+ (format-message "Unmap %S for `%s' only? "
+ (viper-display-macro macro-name)
+ (buffer-name)))))
(setq macro-pair buf-mapping)
(message "%S is unmapped for %s in `%s'"
(viper-display-macro macro-name)
@@ -537,9 +539,9 @@ name from there."
((and (cdr mode-mapping)
(or (not (cdr global-mapping))
(y-or-n-p
- (format "Unmap %S for the major mode `%S' only? "
- (viper-display-macro macro-name)
- major-mode))))
+ (format-message "Unmap %S for the major mode `%S' only? "
+ (viper-display-macro macro-name)
+ major-mode))))
(setq macro-pair mode-mapping)
(message "%S is unmapped for %s in %S"
(viper-display-macro macro-name) state-name major-mode))
@@ -892,7 +894,7 @@ name from there."
(set-register reg last-kbd-macro))
(defun viper-register-macro (count)
- "Keyboard macros in registers - a modified \@ command."
+ "Keyboard macros in registers - a modified @ command."
(interactive "P")
(let ((reg (downcase (read-char))))
(cond ((or (and (<= ?a reg) (<= reg ?z)))
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 8d54571b3f4..5c82bf1f55d 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -1,6 +1,6 @@
;;; viper-mous.el --- mouse support for Viper
-;; Copyright (C) 1994-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -145,7 +145,7 @@ If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
If the character clicked on is a non-separator and is non-alphanumeric but
is adjacent to an alphanumeric symbol, then it is considered alphanumeric
for the purpose of this command. If this character has a matching
-character, such as `\(' is a match for `\)', then the matching character is
+character, such as `(' is a match for `)', then the matching character is
also considered alphanumeric.
For convenience, in Lisp modes, `-' is considered alphanumeric.
@@ -250,7 +250,7 @@ On single or double click, returns the word as determined by
With prefix argument, N, insert that many words.
This command must be bound to a mouse click.
The double-click action of the same mouse button must not be bound
-\(or it must be bound to the same function\).
+\(or it must be bound to the same function).
See `viper-surrounding-word' for the definition of a word in this case."
(interactive "e\nP")
(if viper-frame-of-focus ;; to handle clicks in another frame
@@ -339,7 +339,7 @@ See `viper-surrounding-word' for the definition of a word in this case."
"Find the word clicked or double-clicked on. Word may be in another window.
With prefix argument, N, search for N-th occurrence.
This command must be bound to a mouse click. The double-click action of the
-same button must not be bound \(or it must be bound to the same function\).
+same button must not be bound \(or it must be bound to the same function).
See `viper-surrounding-word' for the details on what constitutes a word for
this command."
(interactive "e\nP")
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 476128518bb..8c2ad581a75 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -1,6 +1,6 @@
;;; viper-util.el --- Utilities used by viper.el
-;; Copyright (C) 1994-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 1999-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: viper
@@ -379,7 +379,7 @@ Otherwise return the normal value."
;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
;; LIS2 is modified by filtering it: deleting its members of the form
-;; \(car elt\) such that (car elt') is in LIS1.
+;; (car elt) such that (car elt') is in LIS1.
(defun viper-append-filter-alist (lis1 lis2)
(let ((temp lis1)
elt)
@@ -426,7 +426,7 @@ Otherwise return the normal value."
;; Issue an error, if no match.
(unless (eq 0 status)
(save-excursion
- (skip-chars-forward " \t\n\j")
+ (skip-chars-forward " \t\n")
(if (looking-at "ls:")
(viper-forward-Word 1))
(error "%s: %s"
@@ -859,7 +859,7 @@ Otherwise return the normal value."
(defsubst viper-is-in-minibuffer ()
(save-match-data
- (string-match "\*Minibuf-" (buffer-name))))
+ (string-match "\\*Minibuf-" (buffer-name))))
@@ -984,7 +984,7 @@ Otherwise return the normal value."
;; macros, since it enables certain macros to be shared between X and TTY modes
;; by correctly mapping key sequences for Left/Right/... (on an ascii
;; terminal) into logical keys left, right, etc.
-(defun viper-read-key ()
+(defun viper-read-key () ;; FIXME: Use `read-key'?
(let ((overriding-local-map viper-overriding-map)
(inhibit-quit t)
help-char key)
@@ -1301,7 +1301,7 @@ Usually contains ` ', linefeed, TAB or formfeed.")
))
;; SYMBOL is used because customize requires it, but it is ignored, unless it
-;; is `nil'. If nil, use setq.
+;; is nil. If nil, use setq.
(defun viper-set-syntax-preference (&optional symbol value)
"Set Viper syntax preference.
If called interactively or if SYMBOL is nil, sets syntax preference in current
@@ -1330,7 +1330,7 @@ Works best when set in the hooks to various major modes.
`strict-vi' means Viper words are (hopefully) exactly as in Vi.
`reformed-vi' means Viper words are like Emacs words \(as determined using
-Emacs syntax tables, which are different for different major modes\) with two
+Emacs syntax tables, which are different for different major modes) with two
exceptions: the symbol `_' is always part of a word and typical Vi non-word
symbols, such as `,',:,\",),{, etc., are excluded.
This behaves very close to `strict-vi', but also works well with non-ASCII
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 266af1abf2b..6398b476fad 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -3,7 +3,7 @@
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations
@@ -107,7 +107,7 @@
;; ----------------
;; Bug reports and ideas contributed by many users have helped
;; improve Viper and the various versions of VIP.
-;; See the on-line manual for a complete list of contributors.
+;; See the manual for a complete list of contributors.
;;
;;
;;; Notes:
@@ -153,9 +153,9 @@
;;
;; The last viper-vi-basic-minor-mode contains most of the usual Vi bindings
;; in its edit mode. This mode provides access to all Emacs facilities.
-;; Novice users, however, may want to set their viper-expert-level to 1
-;; in their .viper file. This will enable viper-vi-diehard-minor-mode. This
-;; minor mode's bindings make Viper simulate the usual Vi very closely.
+;; Novice users, however, may want to set their viper-expert-level to 1 in
+;; their viper-custom-file-name. This will enable viper-vi-diehard-minor-mode.
+;; This minor mode's bindings make Viper simulate the usual Vi very closely.
;; For instance, C-c will not have its standard Emacs binding
;; and so many of the goodies of Emacs are not available.
;;
@@ -165,12 +165,12 @@
;;
;; Viper gurus should have at least
;; (setq viper-expert-level 4)
-;; in their ~/.viper files. This will unsuppress all Emacs keys that are not
-;; essential for VI-style editing.
+;; in their viper-custom-file-name. This will unsuppress all Emacs keys
+;; that are not essential for VI-style editing.
;; Pick-and-choose users may want to put
;; (setq viper-expert-level 5)
-;; in ~/.viper. Viper will then leave it up to the user to set the variables
-;; viper-want-* See viper-set-expert-level for details.
+;; in viper-custom-file-name. Viper will then leave it up to the user to
+;; set the variables viper-want-* See viper-set-expert-level for details.
;;
;; The very first minor mode, viper-vi-intercept-minor-mode, is of no
;; concern for the user. It is needed to bind Viper's vital keys, such as
@@ -319,8 +319,7 @@ If set by the user, this must be done _before_ Viper is loaded in `~/.emacs'.")
(defgroup viper nil
"Vi emulation within Emacs.
-NOTE: Viper customization should be saved in `viper-custom-file-name', which
-defaults to `~/.viper'."
+NOTE: Viper customization should be saved in `viper-custom-file-name'."
:prefix "viper-"
:group 'emulations)
@@ -532,6 +531,7 @@ If Viper is enabled, turn it off. Otherwise, turn it on."
(if viper-mode
()
(setq viper-mode t)
+ ;; FIXME: Don't reload!
(load-library "viper"))
(if viper-first-time ; Important check. Prevents mix-up of startup
@@ -819,7 +819,7 @@ It also can't undo some Viper settings."
;; fundamental
(defun viper-major-mode-change-sentinel ()
(save-match-data
- (or (string-match "\*Minibuf-" (buffer-name))
+ (or (string-match "\\*Minibuf-" (buffer-name))
(setq viper-new-major-mode-buffer-list
(cons (current-buffer) viper-new-major-mode-buffer-list))))
;; change the global value of hook
@@ -888,6 +888,7 @@ Two differences:
;; When viper-mode is executed in such a case, it will set the major mode
;; back to fundamental-mode.
(if (eq (default-value 'major-mode) 'fundamental-mode)
+ ;; FIXME: We should use after-change-major-mode-hook instead!
(setq-default major-mode 'viper-mode))
(viper-setup-ESC-to-escape t)
@@ -937,6 +938,7 @@ Two differences:
(defadvice self-insert-command (around viper-self-insert-ad activate)
"Ignore all self-inserting keys in the vi-state."
+ ;; FIXME: Use remapping?
(if (and (eq viper-current-state 'vi-state)
;; Do not use called-interactively-p here. XEmacs does not have it
;; and interactive-p is just fine.
@@ -1222,11 +1224,7 @@ If you wish to Viperize AND make this your way of life, please put
(require 'viper)
in your init file (preferably, close to the top).
-These two lines must come in the order given.
-
-** Viper users:
- **** The startup file name has been changed from .vip to .viper
- **** All vip-* style names have been converted to viper-* style."))
+These two lines must come in the order given."))
(if (y-or-n-p "Viperize? ")
(setq viper-mode t)
(setq viper-mode nil))
@@ -1268,8 +1266,8 @@ These two lines must come in the order given.
;; Set some useful macros, advices
-;; These must be BEFORE ~/.viper is loaded,
-;; so the user can unrecord them in ~/.viper.
+;; These must be BEFORE viper-custom-file-name is loaded,
+;; so the user can unrecord them in viper-custom-file-name.
(if viper-mode
(progn
;; set advices and some variables that give emacs Vi look.
@@ -1289,7 +1287,7 @@ These two lines must come in the order given.
;; Make %%% toggle parsing comments for matching parentheses
(viper-set-parsing-style-toggling-macro nil)
- ;; ~/.viper is loaded if exists
+ ;; viper-custom-file-name is loaded if exists
(viper-load-custom-file)
;; should be after loading custom file to avoid the pesky msg that
@@ -1300,7 +1298,7 @@ These two lines must come in the order given.
-;; Applying Viper customization -- runs after (load .viper)
+;; Applying Viper customization -- runs after (load viper-custom-file-name)
;; Save user settings or Viper defaults for vars controlled by
;; viper-expert-level
@@ -1350,7 +1348,7 @@ These two lines must come in the order given.
;; Intercept maps could go in viper-keym.el
-;; We keep them here in case someone redefines them in ~/.viper
+;; We keep them here in case someone redefines them in viper-custom-file-name
(define-key viper-vi-intercept-map viper-ESC-key 'viper-intercept-ESC-key)
(define-key viper-insert-intercept-map viper-ESC-key 'viper-intercept-ESC-key)
diff --git a/lisp/env.el b/lisp/env.el
index 5618404cb67..3966ab14f7e 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -1,8 +1,8 @@
-;;; env.el --- functions to manipulate environment variables
+;;; env.el --- functions to manipulate environment variables -*- lexical-binding:t -*-
-;; Copyright (C) 1991, 1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes, unix
;; Package: emacs
@@ -60,30 +60,46 @@ If it is also not t, RET does not exit if it does non-null completion."
(defconst env--substitute-vars-regexp
"\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)")
-(defun substitute-env-vars (string &optional only-defined)
+(defun substitute-env-vars (string &optional when-undefined)
"Substitute environment variables referred to in STRING.
`$FOO' where FOO is an environment variable name means to substitute
the value of that variable. The variable name should be terminated
with a character not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces. For instance, in `ab$cd-x',
`$cd' is treated as an environment variable.
-If ONLY-DEFINED is nil, references to undefined environment variables
-are replaced by the empty string; if it is non-nil, they are left unchanged.
+
+If WHEN-DEFINED is nil, references to undefined environment variables
+are replaced by the empty string; if it is a function, the function is called
+with the variable name as argument and should return the text with which
+to replace it or nil to leave it unchanged.
+If it is non-nil and not a function, references to undefined variables are
+left unchanged.
Use `$$' to insert a single dollar sign."
(let ((start 0))
(while (string-match env--substitute-vars-regexp string start)
(cond ((match-beginning 1)
- (let ((value (getenv (match-string 1 string))))
- (if (and (null value) only-defined)
+ (let* ((var (match-string 1 string))
+ (value (getenv var)))
+ (if (and (null value)
+ (if (functionp when-undefined)
+ (null (setq value (funcall when-undefined var)))
+ when-undefined))
(setq start (match-end 0))
- (setq string (replace-match (or value "") t t string)
+ (setq string (replace-match (or value "") t t string)
start (+ (match-beginning 0) (length value))))))
(t
(setq string (replace-match "$" t t string)
start (+ (match-beginning 0) 1)))))
string))
+(defun substitute-env-in-file-name (filename)
+ (substitute-env-vars filename
+ ;; How 'bout we lookup other tables than the env?
+ ;; E.g. we could accept bookmark names as well!
+ (if (memq system-type '(windows-nt ms-dos))
+ (lambda (var) (getenv (upcase var)))
+ t)))
(defun setenv-internal (env variable value keep-empty)
"Set VARIABLE to VALUE in ENV, adding empty entries if KEEP-EMPTY.
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index a01f0642b11..042dc6e625f 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -1,5 +1,5 @@
;;; epa-dired.el --- the EasyPG Assistant, dired extension -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index 5de768b426e..88d25a570b3 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -1,5 +1,5 @@
;;; epa-file.el --- the EasyPG Assistant, transparent file encryption -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -29,9 +29,11 @@
"If non-nil, cache passphrase for symmetric encryption.
For security reasons, this option is turned off by default and
-not recommended to use. Instead, consider using public-key
-encryption with gpg-agent which does the same job in a safer
-way."
+not recommended to use. Instead, consider using gpg-agent which
+does the same job in a safer way. See Info node `(epa) Caching
+Passphrases' for more information.
+
+Note that this option has no effect if you use GnuPG 2.0."
:type 'boolean
:group 'epa-file)
@@ -80,12 +82,15 @@ encryption is used."
passphrase))))
(epa-passphrase-callback-function context key-id file)))
+(defvar epa-inhibit nil
+ "Non-nil means don't try to decrypt .gpg files when operating on them.")
+
;;;###autoload
(defun epa-file-handler (operation &rest args)
(save-match-data
(let ((op (get operation 'epa-file)))
- (if op
- (apply op args)
+ (if (and op (not epa-inhibit))
+ (apply op args)
(epa-file-run-real-handler operation args)))))
(defun epa-file-run-real-handler (operation args)
@@ -103,9 +108,9 @@ encryption is used."
(insert (if enable-multibyte-characters
(string-to-multibyte string)
string))
- (decode-coding-inserted-region
- (point-min) (point-max)
- (substring file 0 (string-match epa-file-name-regexp file))
+ (decode-coding-inserted-region
+ (point-min) (point-max)
+ (substring file 0 (string-match epa-file-name-regexp file))
visit beg end replace))
(insert (epa-file--decode-coding-string string (or coding-system-for-read
'undecided)))))
@@ -130,6 +135,7 @@ encryption is used."
(error)))
(local-file (or local-copy file))
(context (epg-make-context))
+ (buf (current-buffer))
string length entry)
(if visit
(setq buffer-file-name file))
@@ -141,6 +147,7 @@ encryption is used."
context
(cons #'epa-progress-callback-function
(format "Decrypting %s" file)))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(unwind-protect
(progn
(if replace
@@ -150,21 +157,30 @@ encryption is used."
(error
(if (setq entry (assoc file epa-file-passphrase-alist))
(setcdr entry nil))
- ;; 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'.
+ ;; If the decryption program can't be found,
+ ;; signal that as a non-file error
+ ;; so that find-file-noselect-1 won't handle it.
+ ;; Borrowed from jka-compr.el.
+ (if (and (eq (car error) 'file-error)
+ (equal (cadr error) "Searching for program"))
+ (error "Decryption program `%s' not found"
+ (nth 3 error)))
(when (file-exists-p local-file)
- (make-local-variable 'epa-file-error)
- (setq epa-file-error error)
+ ;; 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))
+ nil t)
+ (epa-display-error context))
(signal 'file-error
(cons "Opening input file" (cdr error)))))
- (make-local-variable 'epa-file-encrypt-to)
- (setq epa-file-encrypt-to
- (mapcar #'car (epg-context-result-for context 'encrypted-to)))
+ (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!
+ (setq-local epa-file-encrypt-to
+ (mapcar #'car (epg-context-result-for
+ context 'encrypted-to)))
(if (or beg end)
(setq string (substring string (or beg 0) end)))
(save-excursion
@@ -208,7 +224,8 @@ encryption is used."
(recipients
(cond
((listp epa-file-encrypt-to) epa-file-encrypt-to)
- ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to)))))
+ ((stringp epa-file-encrypt-to) (list epa-file-encrypt-to))))
+ buffer)
(epg-context-set-passphrase-callback
context
(cons #'epa-file-passphrase-callback-function
@@ -217,7 +234,8 @@ encryption is used."
context
(cons #'epa-progress-callback-function
(format "Encrypting %s" file)))
- (epg-context-set-armor context epa-armor)
+ (setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(condition-case error
(setq string
(epg-encrypt-string
@@ -227,8 +245,18 @@ encryption is used."
(unless start
(setq start (point-min)
end (point-max)))
- (epa-file--encode-coding-string (buffer-substring start end)
- coding-system))
+ (setq buffer (current-buffer))
+ (with-temp-buffer
+ (insert-buffer-substring buffer start end)
+ ;; Translate the region according to
+ ;; `buffer-file-format', as `write-region' would.
+ ;; We can't simply do `write-region' (into a
+ ;; temporary file) here, since it writes out
+ ;; decrypted contents.
+ (format-encode-buffer (with-current-buffer buffer
+ buffer-file-format))
+ (epa-file--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
@@ -241,6 +269,7 @@ If no one is selected, symmetric encryption will be performed. "
(if epa-file-encrypt-to
(epg-list-keys context recipients)))))
(error
+ (epa-display-error context)
(if (setq entry (assoc file epa-file-passphrase-alist))
(setcdr entry nil))
(signal 'file-error (cons "Opening output file" (cdr error)))))
@@ -266,14 +295,13 @@ If no one is selected, symmetric encryption will be performed. "
(defun epa-file-select-keys ()
"Select recipients for encryption."
(interactive)
- (make-local-variable 'epa-file-encrypt-to)
- (setq epa-file-encrypt-to
- (mapcar
- (lambda (key)
- (epg-sub-key-id (car (epg-key-sub-key-list key))))
- (epa-select-keys
- (epg-make-context)
- "Select recipients for encryption.
+ (setq-local epa-file-encrypt-to
+ (mapcar
+ (lambda (key)
+ (epg-sub-key-id (car (epg-key-sub-key-list key))))
+ (epa-select-keys
+ (epg-make-context)
+ "Select recipients for encryption.
If no one is selected, symmetric encryption will be performed. "))))
;;;###autoload
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index fc0aa3677bf..efffb3529cf 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -1,5 +1,5 @@
;;; epa-hook.el --- preloaded code to enable epa-file.el -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -53,15 +53,15 @@ does that automatically."
May either be a string or a list of strings.")
(put 'epa-file-encrypt-to 'safe-local-variable
- (lambda (val)
- (or (stringp val)
- (and (listp val)
- (catch 'safe
- (mapc (lambda (elt)
- (unless (stringp elt)
- (throw 'safe nil)))
- val)
- t)))))
+ #'(lambda (val)
+ (or (stringp val)
+ (and (listp val)
+ (catch 'safe
+ (mapc (lambda (elt)
+ (unless (stringp elt)
+ (throw 'safe nil)))
+ val)
+ t)))))
(put 'epa-file-encrypt-to 'permanent-local t)
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 896fc2a954e..5a39c28d747 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -1,5 +1,5 @@
;;; epa-mail.el --- the EasyPG Assistant, minor-mode for mail composer -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG, mail, message
@@ -70,27 +70,24 @@ USAGE would be `sign' or `encrypt'."
;;;###autoload
(defun epa-mail-decrypt ()
"Decrypt OpenPGP armors in the current buffer.
-The buffer is expected to contain a mail message.
-
-Don't use this command in Lisp programs!"
+The buffer is expected to contain a mail message."
+ (declare (interactive-only t))
(interactive)
(epa-decrypt-armor-in-region (point-min) (point-max)))
;;;###autoload
(defun epa-mail-verify ()
"Verify OpenPGP cleartext signed messages in the current buffer.
-The buffer is expected to contain a mail message.
-
-Don't use this command in Lisp programs!"
+The buffer is expected to contain a mail message."
+ (declare (interactive-only t))
(interactive)
(epa-verify-cleartext-in-region (point-min) (point-max)))
;;;###autoload
(defun epa-mail-sign (start end signers mode)
"Sign the current buffer.
-The buffer is expected to contain a mail message.
-
-Don't use this command in Lisp programs!"
+The buffer is expected to contain a mail message."
+ (declare (interactive-only t))
(interactive
(save-excursion
(goto-char (point-min))
@@ -234,9 +231,8 @@ If no one is selected, symmetric encryption will be performed. "
;;;###autoload
(defun epa-mail-import-keys ()
"Import keys in the OpenPGP armor format in the current buffer.
-The buffer is expected to contain a mail message.
-
-Don't use this command in Lisp programs!"
+The buffer is expected to contain a mail message."
+ (declare (interactive-only t))
(interactive)
(epa-import-armor-in-region (point-min) (point-max)))
diff --git a/lisp/epa.el b/lisp/epa.el
index a99fb9230e1..9f112c4eb83 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -1,6 +1,6 @@
;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -31,6 +31,7 @@
(defgroup epa nil
"The EasyPG Assistant"
:version "23.1"
+ :link '(custom-manual "(epa) Top")
:group 'epg)
(defcustom epa-popup-info-window t
@@ -43,6 +44,25 @@
:type 'integer
:group 'epa)
+(defcustom epa-pinentry-mode nil
+ "The pinentry mode.
+
+GnuPG 2.1 or later has an option to control the behavior of
+Pinentry invocation. Possible modes are: `ask', `cancel',
+`error', and `loopback'. See the GnuPG manual for the meanings.
+
+In epa commands, a particularly useful mode is `loopback', which
+redirects all Pinentry queries to the caller, so Emacs can query
+passphrase through the minibuffer, instead of external Pinentry
+program."
+ :type '(choice (const nil)
+ (const ask)
+ (const cancel)
+ (const error)
+ (const loopback))
+ :group 'epa
+ :version "25.1")
+
(defgroup epa-faces nil
"Faces for epa-mode."
:version "23.1"
@@ -50,13 +70,16 @@
(defcustom epa-mail-aliases nil
"Alist of aliases of email addresses that stand for encryption keys.
-Each element is (ALIAS EXPANSIONS...).
-It means that when a message is addressed to ALIAS,
+Each element is a list of email addresses (ALIAS EXPANSIONS...).
+When one of the recipients of a message being encrypted is ALIAS,
instead of encrypting it for ALIAS, encrypt it for EXPANSIONS...
+
If EXPANSIONS is empty, ignore ALIAS as regards encryption.
-That is a handy way to avoid warnings about addresses
-that you don't have any key for."
- :type '(repeat (cons (string :tag "Alias") (repeat '(string :tag "Expansion"))))
+This is a handy way to avoid warnings about addresses that you don't
+have any key for.
+
+The command `epa-mail-encrypt' uses this."
+ :type '(repeat (cons (string :tag "Alias") (repeat (string :tag "Expansion"))))
:group 'epa
:version "24.4")
@@ -162,6 +185,7 @@ You should bind this variable with `let', but do not set it globally.")
(defvar epa-key nil)
(defvar epa-list-keys-arguments nil)
(defvar epa-info-buffer nil)
+(defvar epa-error-buffer nil)
(defvar epa-last-coding-system-specified nil)
(defvar epa-key-list-mode-map
@@ -225,7 +249,7 @@ You should bind this variable with `let', but do not set it globally.")
(define-key keymap "q" 'delete-window)
keymap))
-(defvar epa-exit-buffer-function #'bury-buffer)
+(defvar epa-exit-buffer-function #'quit-window)
(define-widget 'epa-key 'push-button
"Button for representing a epg-key object."
@@ -268,62 +292,40 @@ You should bind this variable with `let', but do not set it globally.")
(epg-sub-key-id (car (epg-key-sub-key-list
(widget-get widget :value))))))
-(eval-and-compile
- (if (fboundp 'encode-coding-string)
- (defalias 'epa--encode-coding-string 'encode-coding-string)
- (defalias 'epa--encode-coding-string 'identity)))
+(defalias 'epa--encode-coding-string
+ (if (fboundp 'encode-coding-string) #'encode-coding-string #'identity))
-(eval-and-compile
- (if (fboundp 'decode-coding-string)
- (defalias 'epa--decode-coding-string 'decode-coding-string)
- (defalias 'epa--decode-coding-string 'identity)))
+(defalias 'epa--decode-coding-string
+ (if (fboundp 'decode-coding-string) #'decode-coding-string #'identity))
-(defun epa-key-list-mode ()
+(define-derived-mode epa-key-list-mode special-mode "Keys"
"Major mode for `epa-list-keys'."
- (kill-all-local-variables)
(buffer-disable-undo)
- (setq major-mode 'epa-key-list-mode
- mode-name "Keys"
- truncate-lines t
+ (setq truncate-lines t
buffer-read-only t)
- (use-local-map epa-key-list-mode-map)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(epa-font-lock-keywords t))
+ (setq-local font-lock-defaults '(epa-font-lock-keywords t))
;; In XEmacs, auto-initialization of font-lock is not effective
;; if buffer-file-name is not set.
(font-lock-set-defaults)
(make-local-variable 'epa-exit-buffer-function)
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'epa--key-list-revert-buffer)
- (run-mode-hooks 'epa-key-list-mode-hook))
+ (setq-local revert-buffer-function #'epa--key-list-revert-buffer))
-(defun epa-key-mode ()
+(define-derived-mode epa-key-mode special-mode "Key"
"Major mode for a key description."
- (kill-all-local-variables)
(buffer-disable-undo)
- (setq major-mode 'epa-key-mode
- mode-name "Key"
- truncate-lines t
+ (setq truncate-lines t
buffer-read-only t)
- (use-local-map epa-key-mode-map)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(epa-font-lock-keywords t))
+ (setq-local font-lock-defaults '(epa-font-lock-keywords t))
;; In XEmacs, auto-initialization of font-lock is not effective
;; if buffer-file-name is not set.
(font-lock-set-defaults)
- (make-local-variable 'epa-exit-buffer-function)
- (run-mode-hooks 'epa-key-mode-hook))
+ (make-local-variable 'epa-exit-buffer-function))
-(defun epa-info-mode ()
+(define-derived-mode epa-info-mode special-mode "Info"
"Major mode for `epa-info-buffer'."
- (kill-all-local-variables)
(buffer-disable-undo)
- (setq major-mode 'epa-info-mode
- mode-name "Info"
- truncate-lines t
- buffer-read-only t)
- (use-local-map epa-info-mode-map)
- (run-mode-hooks 'epa-info-mode-hook))
+ (setq truncate-lines t
+ buffer-read-only t))
(defun epa-mark-key (&optional arg)
"Mark a key on the current line.
@@ -460,14 +462,12 @@ If ARG is non-nil, mark the key."
(widget-create 'link
:notify (lambda (&rest _ignore) (abort-recursive-edit))
:help-echo
- (substitute-command-keys
- "Click here or \\[abort-recursive-edit] to cancel")
+ "Click here or \\[abort-recursive-edit] to cancel"
"Cancel")
(widget-create 'link
:notify (lambda (&rest _ignore) (exit-recursive-edit))
:help-echo
- (substitute-command-keys
- "Click here or \\[exit-recursive-edit] to finish")
+ "Click here or \\[exit-recursive-edit] to finish"
"OK")
(insert "\n\n")
(epa--insert-keys keys)
@@ -596,6 +596,34 @@ If SECRET is non-nil, list secret keys instead of public keys."
(shrink-window (- (window-height) epa-info-window-height)))))
(message "%s" info)))
+(defun epa-display-error (context)
+ (unless (equal (epg-context-error-output context) "")
+ (let ((buffer (get-buffer-create "*Error*")))
+ (save-selected-window
+ (unless (and epa-error-buffer (buffer-live-p epa-error-buffer))
+ (setq epa-error-buffer (generate-new-buffer "*Error*")))
+ (if (get-buffer-window epa-error-buffer)
+ (delete-window (get-buffer-window epa-error-buffer)))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (insert (format
+ (pcase (epg-context-operation context)
+ (`decrypt "Error while decrypting with \"%s\":")
+ (`verify "Error while verifying with \"%s\":")
+ (`sign "Error while signing with \"%s\":")
+ (`encrypt "Error while encrypting with \"%s\":")
+ (`import-keys "Error while importing keys with \"%s\":")
+ (`export-keys "Error while exporting keys with \"%s\":")
+ (_ "Error while executing \"%s\":\n\n"))
+ epg-gpg-program)
+ "\n\n"
+ (epg-context-error-output context)))
+ (epa-info-mode)
+ (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)))
@@ -611,14 +639,14 @@ If SECRET is non-nil, list secret keys instead of public keys."
(eq (epg-context-operation context) 'encrypt))
(read-passwd
(if (eq key-id 'PIN)
- "Passphrase for 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)))))))
(defun epa-progress-callback-function (_context what _char current total
- handback)
+ handback)
(let ((prompt (or handback
(format "Processing %s: " what))))
;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
@@ -628,7 +656,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
(if (= current total)
(message "%s...done" prompt)
(message "%s...%d%%" prompt
- (floor (* (/ current (float total)) 100))))
+ (floor (* 100.0 current) total)))
(message "%s..." prompt))))
(defun epa-read-file-name (input)
@@ -659,7 +687,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use."
(format "Decrypting %s..."
(file-name-nondirectory decrypt-file))))
(message "Decrypting %s..." (file-name-nondirectory decrypt-file))
- (epg-decrypt-file context decrypt-file plain-file)
+ (condition-case error
+ (epg-decrypt-file context decrypt-file plain-file)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file)
(file-name-nondirectory plain-file))
(if (epg-context-result-for context 'verify)
@@ -680,7 +712,11 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use."
(format "Verifying %s..."
(file-name-nondirectory file))))
(message "Verifying %s..." (file-name-nondirectory file))
- (epg-verify-file context file plain)
+ (condition-case error
+ (epg-verify-file context file plain)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Verifying %s...done" (file-name-nondirectory file))
(if (epg-context-result-for context 'verify)
(epa-display-info (epg-verify-result-to-string
@@ -735,9 +771,9 @@ If no one is selected, default secret key is used. "
".p7s"
".p7m"))))
(context (epg-make-context epa-protocol)))
- (epg-context-set-armor context epa-armor)
- (epg-context-set-textmode context epa-textmode)
- (epg-context-set-signers context signers)
+ (setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-textmode context) epa-textmode)
+ (setf (epg-context-signers context) signers)
(epg-context-set-passphrase-callback context
#'epa-passphrase-callback-function)
(epg-context-set-progress-callback context
@@ -745,8 +781,13 @@ If no one is selected, default secret key is used. "
#'epa-progress-callback-function
(format "Signing %s..."
(file-name-nondirectory file))))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Signing %s..." (file-name-nondirectory file))
- (epg-sign-file context file signature mode)
+ (condition-case error
+ (epg-sign-file context file signature mode)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Signing %s...wrote %s" (file-name-nondirectory file)
(file-name-nondirectory signature))))
@@ -762,8 +803,8 @@ If no one is selected, symmetric encryption will be performed. ")))
(if epa-armor ".asc" ".gpg")
".p7m")))
(context (epg-make-context epa-protocol)))
- (epg-context-set-armor context epa-armor)
- (epg-context-set-textmode context epa-textmode)
+ (setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-textmode context) epa-textmode)
(epg-context-set-passphrase-callback context
#'epa-passphrase-callback-function)
(epg-context-set-progress-callback context
@@ -771,8 +812,13 @@ If no one is selected, symmetric encryption will be performed. ")))
#'epa-progress-callback-function
(format "Encrypting %s..."
(file-name-nondirectory file))))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Encrypting %s..." (file-name-nondirectory file))
- (epg-encrypt-file context file recipients cipher)
+ (condition-case error
+ (epg-encrypt-file context file recipients cipher)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Encrypting %s...wrote %s" (file-name-nondirectory file)
(file-name-nondirectory cipher))))
@@ -795,10 +841,10 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-decrypt-string context (buffer-substring start end))
- 'utf-8))"
+ \\='utf-8))"
(interactive "r")
(save-excursion
(let ((context (epg-make-context epa-protocol))
@@ -809,8 +855,13 @@ For example:
(cons
#'epa-progress-callback-function
"Decrypting..."))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Decrypting...")
- (setq plain (epg-decrypt-string context (buffer-substring start end)))
+ (condition-case error
+ (setq plain (epg-decrypt-string context (buffer-substring start end)))
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Decrypting...done")
(setq plain (epa--decode-coding-string
plain
@@ -828,8 +879,8 @@ For example:
(insert plain))
(with-output-to-temp-buffer "*Temp*"
(set-buffer standard-output)
- (insert plain)
- (epa-info-mode))))
+ (insert plain)
+ (epa-info-mode))))
(if (epg-context-result-for context 'verify)
(epa-display-info (epg-verify-result-to-string
(epg-context-result-for context 'verify)))))))
@@ -852,6 +903,7 @@ For example:
Don't use this command in Lisp programs!
See the reason described in the `epa-decrypt-region' documentation."
+ (declare (interactive-only t))
(interactive "r")
(save-excursion
(save-restriction
@@ -887,24 +939,29 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-verify-string context (buffer-substring start end))
- 'utf-8))"
+ \\='utf-8))"
+ (declare (interactive-only t))
(interactive "r")
(let ((context (epg-make-context epa-protocol))
plain)
- (epg-context-set-progress-callback context
- (cons
- #'epa-progress-callback-function
- "Verifying..."))
+ (setf (epg-context-progress-callback context)
+ (cons
+ #'epa-progress-callback-function
+ "Verifying..."))
(message "Verifying...")
- (setq plain (epg-verify-string
- context
- (epa--encode-coding-string
- (buffer-substring start end)
- (or coding-system-for-write
- (get-text-property start 'epa-coding-system-used)))))
+ (condition-case error
+ (setq plain (epg-verify-string
+ context
+ (epa--encode-coding-string
+ (buffer-substring start end)
+ (or coding-system-for-write
+ (get-text-property start 'epa-coding-system-used)))))
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Verifying...done")
(setq plain (epa--decode-coding-string
plain
@@ -932,6 +989,7 @@ between START and END.
Don't use this command in Lisp programs!
See the reason described in the `epa-verify-region' documentation."
+ (declare (interactive-only t))
(interactive "r")
(save-excursion
(save-restriction
@@ -942,19 +1000,19 @@ See the reason described in the `epa-verify-region' documentation."
nil t)
(setq cleartext-start (match-beginning 0))
(unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
- nil t)
+ nil t)
(error "Invalid cleartext signed message"))
(setq cleartext-end (re-search-forward
- "^-----END PGP SIGNATURE-----$"
- nil t))
+ "^-----END PGP SIGNATURE-----$"
+ nil t))
(unless cleartext-end
(error "No cleartext tail"))
(epa-verify-region cleartext-start cleartext-end))))))
-(eval-and-compile
+(defalias 'epa--select-safe-coding-system
(if (fboundp 'select-safe-coding-system)
- (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
- (defun epa--select-safe-coding-system (_from _to)
+ #'select-safe-coding-system
+ (lambda (_from _to)
buffer-file-coding-system)))
;;;###autoload
@@ -970,10 +1028,11 @@ based counterpart `epg-sign-file' instead.
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(epg-sign-string
context
- (encode-coding-string (buffer-substring start end) 'utf-8)))"
+ (encode-coding-string (buffer-substring start end) \\='utf-8)))"
+ (declare (interactive-only t))
(interactive
(let ((verbose current-prefix-arg))
(setq epa-last-coding-system-specified
@@ -992,23 +1051,28 @@ If no one is selected, default secret key is used. "
(save-excursion
(let ((context (epg-make-context epa-protocol))
signature)
- ;;(epg-context-set-armor context epa-armor)
- (epg-context-set-armor context t)
- ;;(epg-context-set-textmode context epa-textmode)
- (epg-context-set-textmode context t)
- (epg-context-set-signers context signers)
+ ;;(setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-armor context) t)
+ ;;(setf (epg-context-textmode context) epa-textmode)
+ (setf (epg-context-textmode context) t)
+ (setf (epg-context-signers context) signers)
(epg-context-set-passphrase-callback context
#'epa-passphrase-callback-function)
(epg-context-set-progress-callback context
(cons
#'epa-progress-callback-function
"Signing..."))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Signing...")
- (setq signature (epg-sign-string context
- (epa--encode-coding-string
- (buffer-substring start end)
- epa-last-coding-system-specified)
- mode))
+ (condition-case error
+ (setq signature (epg-sign-string context
+ (epa--encode-coding-string
+ (buffer-substring start end)
+ epa-last-coding-system-specified)
+ mode))
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Signing...done")
(delete-region start end)
(goto-char start)
@@ -1026,16 +1090,16 @@ If no one is selected, default secret key is used. "
'start-open t
'end-open t)))))
-(eval-and-compile
+(defalias 'epa--derived-mode-p
(if (fboundp 'derived-mode-p)
- (defalias 'epa--derived-mode-p 'derived-mode-p)
- (defun epa--derived-mode-p (&rest modes)
+ #'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))))
+ (while (and (not (memq parent modes))
+ (setq parent (get parent 'derived-mode-parent))))
+ parent))))
;;;###autoload
(defun epa-encrypt-region (start end recipients sign signers)
@@ -1050,11 +1114,12 @@ file based counterpart `epg-encrypt-file' instead.
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(epg-encrypt-string
context
- (encode-coding-string (buffer-substring start end) 'utf-8)
+ (encode-coding-string (buffer-substring start end) \\='utf-8)
nil))"
+ (declare (interactive-only t))
(interactive
(let ((verbose current-prefix-arg)
(context (epg-make-context epa-protocol))
@@ -1074,25 +1139,30 @@ If no one is selected, symmetric encryption will be performed. ")
(save-excursion
(let ((context (epg-make-context epa-protocol))
cipher)
- ;;(epg-context-set-armor context epa-armor)
- (epg-context-set-armor context t)
- ;;(epg-context-set-textmode context epa-textmode)
- (epg-context-set-textmode context t)
+ ;;(setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-armor context) t)
+ ;;(setf (epg-context-textmode context) epa-textmode)
+ (setf (epg-context-textmode context) t)
(if sign
- (epg-context-set-signers context signers))
+ (setf (epg-context-signers context) signers))
(epg-context-set-passphrase-callback context
#'epa-passphrase-callback-function)
(epg-context-set-progress-callback context
(cons
#'epa-progress-callback-function
"Encrypting..."))
+ (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
(message "Encrypting...")
- (setq cipher (epg-encrypt-string context
- (epa--encode-coding-string
- (buffer-substring start end)
- epa-last-coding-system-specified)
- recipients
- sign))
+ (condition-case error
+ (setq cipher (epg-encrypt-string context
+ (epa--encode-coding-string
+ (buffer-substring start end)
+ epa-last-coding-system-specified)
+ recipients
+ sign))
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Encrypting...done")
(delete-region start end)
(goto-char start)
@@ -1118,7 +1188,11 @@ If no one is selected, symmetric encryption will be performed. ")
(eq (nth 1 epa-list-keys-arguments) t))))
(let ((context (epg-make-context epa-protocol)))
(message "Deleting...")
- (epg-delete-keys context keys allow-secret)
+ (condition-case error
+ (epg-delete-keys context keys allow-secret)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Deleting...done")
(apply #'epa--list-keys epa-list-keys-arguments)))
@@ -1134,10 +1208,12 @@ If no one is selected, symmetric encryption will be performed. ")
(epg-import-keys-from-file context file)
(message "Importing %s...done" (file-name-nondirectory file)))
(error
+ (epa-display-error context)
(message "Importing %s...failed" (file-name-nondirectory file))))
(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?
(if (eq major-mode 'epa-key-list-mode)
(apply #'epa--list-keys epa-list-keys-arguments))))
@@ -1152,6 +1228,7 @@ If no one is selected, symmetric encryption will be performed. ")
(epg-import-keys-from-string context (buffer-substring start end))
(message "Importing...done"))
(error
+ (epa-display-error context)
(message "Importing...failed")))
(if (epg-context-result-for context 'import)
(epa-display-info (epg-import-result-to-string
@@ -1200,9 +1277,13 @@ between START and END."
(file-name-directory default-name)
default-name)))))
(let ((context (epg-make-context epa-protocol)))
- (epg-context-set-armor context epa-armor)
+ (setf (epg-context-armor context) epa-armor)
(message "Exporting to %s..." (file-name-nondirectory file))
- (epg-export-keys-to-file context keys file)
+ (condition-case error
+ (epg-export-keys-to-file context keys file)
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))
(message "Exporting to %s...done" (file-name-nondirectory file))))
;;;###autoload
@@ -1210,18 +1291,23 @@ between START and END."
"Insert selected KEYS after the point."
(interactive
(list (epa-select-keys (epg-make-context epa-protocol)
- "Select keys to export.
+ "Select keys to export.
If no one is selected, default public key is exported. ")))
(let ((context (epg-make-context epa-protocol)))
- ;;(epg-context-set-armor context epa-armor)
- (epg-context-set-armor context t)
- (insert (epg-export-keys-to-string context keys))))
+ ;;(setf (epg-context-armor context) epa-armor)
+ (setf (epg-context-armor context) t)
+ (condition-case error
+ (insert (epg-export-keys-to-string context keys))
+ (error
+ (epa-display-error context)
+ (signal (car error) (cdr error))))))
;; (defun epa-sign-keys (keys &optional local)
;; "Sign selected KEYS.
;; If a prefix-arg is specified, the signature is marked as non exportable.
;; Don't use this command in Lisp programs!"
+;; (declare (interactive-only t))
;; (interactive
;; (let ((keys (epa--marked-keys)))
;; (unless keys
@@ -1229,11 +1315,12 @@ If no one is selected, default public key is exported. ")))
;; (list keys current-prefix-arg)))
;; (let ((context (epg-make-context epa-protocol)))
;; (epg-context-set-passphrase-callback context
-;; #'epa-passphrase-callback-function)
+;; #'epa-passphrase-callback-function)
;; (epg-context-set-progress-callback context
-;; (cons
-;; #'epa-progress-callback-function
-;; "Signing keys..."))
+;; (cons
+;; #'epa-progress-callback-function
+;; "Signing keys..."))
+;; (setf (epg-context-pinentry-mode context) epa-pinentry-mode)
;; (message "Signing keys...")
;; (epg-sign-keys context keys local)
;; (message "Signing keys...done")))
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 2dbef64ecf9..db2951306d0 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -1,6 +1,6 @@
;;; epg-config.el --- configuration of the EasyPG Library
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -39,9 +39,9 @@
:group 'data
:group 'external)
-(defcustom epg-gpg-program (or (executable-find "gpg")
- (executable-find "gpg2")
- "gpg")
+(defcustom epg-gpg-program (cond ((executable-find "gpg") "gpg")
+ ((executable-find "gpg2") "gpg2")
+ (t "gpg"))
"The `gpg' executable."
:group 'epg
:type 'string)
@@ -51,6 +51,11 @@
:group 'epg
:type 'string)
+(defcustom epg-gpgconf-program "gpgconf"
+ "The `gpgconf' executable."
+ :group 'epg
+ :type 'string)
+
(defcustom epg-gpg-home-directory nil
"The directory which contains the configuration files of `epg-gpg-program'."
:group 'epg
diff --git a/lisp/epg.el b/lisp/epg.el
index 33c0443dd91..aa79c7d0fc2 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1,5 +1,5 @@
;;; epg.el --- the EasyPG Library -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -23,6 +23,7 @@
;;; Code:
(require 'epg-config)
+(eval-when-compile (require 'cl-lib))
(defvar epg-user-id nil
"GnuPG ID of your default identity.")
@@ -135,7 +136,7 @@
(?f . full)
(?u . ultimate)))
-(defvar epg-key-capablity-alist
+(defvar epg-key-capability-alist
'((?e . encrypt)
(?s . sign)
(?c . certify)
@@ -164,210 +165,76 @@
(define-error 'epg-error "GPG error")
-(defun epg-make-data-from-file (file)
- "Make a data object from FILE."
- (cons 'epg-data (vector file nil)))
-
-(defun epg-make-data-from-string (string)
- "Make a data object from STRING."
- (cons 'epg-data (vector nil string)))
-
-(defun epg-data-file (data)
- "Return the file of DATA."
- (unless (eq (car-safe data) 'epg-data)
- (signal 'wrong-type-argument (list 'epg-data-p data)))
- (aref (cdr data) 0))
-
-(defun epg-data-string (data)
- "Return the string of DATA."
- (unless (eq (car-safe data) 'epg-data)
- (signal 'wrong-type-argument (list 'epg-data-p data)))
- (aref (cdr data) 1))
-
+(cl-defstruct (epg-data
+ (:constructor nil)
+ (:constructor epg-make-data-from-file (file))
+ (:constructor epg-make-data-from-string (string))
+ (:copier nil)
+ (:predicate nil))
+ (file nil :read-only t)
+ (string nil :read-only t))
+
+(defmacro epg--gv-nreverse (place)
+ (gv-letplace (getter setter) place
+ (funcall setter `(nreverse ,getter))))
+
+(cl-defstruct (epg-context
+ (:constructor nil)
+ (:constructor epg-context--make
+ (protocol &optional armor textmode include-certs
+ cipher-algorithm digest-algorithm
+ compress-algorithm
+ &aux
+ (program
+ (pcase protocol
+ (`OpenPGP epg-gpg-program)
+ (`CMS epg-gpgsm-program)
+ (_ (signal 'epg-error
+ (list "unknown protocol" protocol)))))))
+ (:copier nil)
+ (:predicate nil))
+ protocol
+ program
+ (home-directory epg-gpg-home-directory)
+ armor
+ textmode
+ include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm
+ (passphrase-callback (list #'epg-passphrase-callback-function))
+ progress-callback
+ edit-callback
+ signers
+ sig-notations
+ process
+ output-file
+ result
+ operation
+ pinentry-mode
+ (error-output "")
+ error-buffer)
+
+;; This is not an alias, just so we can mark it as autoloaded.
;;;###autoload
(defun epg-make-context (&optional protocol armor textmode include-certs
cipher-algorithm digest-algorithm
compress-algorithm)
"Return a context object."
- (unless protocol
- (setq protocol 'OpenPGP))
- (unless (memq protocol '(OpenPGP CMS))
- (signal 'epg-error (list "unknown protocol" protocol)))
- (cons 'epg-context
- (vector protocol
- (if (eq protocol 'OpenPGP)
- epg-gpg-program
- epg-gpgsm-program)
- epg-gpg-home-directory
- armor textmode include-certs
- cipher-algorithm digest-algorithm compress-algorithm
- (list #'epg-passphrase-callback-function)
- nil
- nil nil nil nil nil nil nil)))
-
-(defun epg-context-protocol (context)
- "Return the protocol used within CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 0))
-
-(defun epg-context-program (context)
- "Return the gpg or gpgsm executable used within CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 1))
-
-(defun epg-context-home-directory (context)
- "Return the GnuPG home directory used in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 2))
-
-(defun epg-context-armor (context)
- "Return t if the output should be ASCII armored in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 3))
-
-(defun epg-context-textmode (context)
- "Return t if canonical text mode should be used in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 4))
-
-(defun epg-context-include-certs (context)
- "Return how many certificates should be included in an S/MIME signed message."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 5))
-
-(defun epg-context-cipher-algorithm (context)
- "Return the cipher algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 6))
-
-(defun epg-context-digest-algorithm (context)
- "Return the digest algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 7))
-
-(defun epg-context-compress-algorithm (context)
- "Return the compress algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 8))
-
-(defun epg-context-passphrase-callback (context)
- "Return the function used to query passphrase."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 9))
-
-(defun epg-context-progress-callback (context)
- "Return the function which handles progress update."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 10))
-
-(defun epg-context-signers (context)
- "Return the list of key-id for signing."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 11))
-
-(defun epg-context-sig-notations (context)
- "Return the list of notations for signing."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 12))
-
-(defun epg-context-process (context)
- "Return the process object of `epg-gpg-program'.
-This function is for internal use only."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 13))
-
-(defun epg-context-output-file (context)
- "Return the output file of `epg-gpg-program'.
-This function is for internal use only."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 14))
-
-(defun epg-context-result (context)
- "Return the result of the previous cryptographic operation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 15))
-
-(defun epg-context-operation (context)
- "Return the name of the current cryptographic operation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 16))
-
-(defun epg-context-pinentry-mode (context)
- "Return the mode of pinentry invocation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aref (cdr context) 17))
-
-(defun epg-context-set-protocol (context protocol)
- "Set the protocol used within CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 0 protocol))
-
-(defun epg-context-set-program (context protocol)
- "Set the gpg or gpgsm executable used within CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 1 protocol))
-
-(defun epg-context-set-home-directory (context directory)
- "Set the GnuPG home directory."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 2 directory))
+ (epg-context--make (or protocol 'OpenPGP)
+ armor textmode include-certs
+ cipher-algorithm digest-algorithm
+ compress-algorithm))
(defun epg-context-set-armor (context armor)
"Specify if the output should be ASCII armored in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 3 armor))
+ (declare (obsolete setf "25.1"))
+ (setf (epg-context-armor context) armor))
(defun epg-context-set-textmode (context textmode)
"Specify if canonical text mode should be used in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 4 textmode))
-
-(defun epg-context-set-include-certs (context include-certs)
- "Set how many certificates should be included in an S/MIME signed message."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 5 include-certs))
-
-(defun epg-context-set-cipher-algorithm (context cipher-algorithm)
- "Set the cipher algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 6 cipher-algorithm))
-
-(defun epg-context-set-digest-algorithm (context digest-algorithm)
- "Set the digest algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 7 digest-algorithm))
-
-(defun epg-context-set-compress-algorithm (context compress-algorithm)
- "Set the compress algorithm in CONTEXT."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 8 compress-algorithm))
+ (declare (obsolete setf "25.1"))
+ (setf (epg-context-textmode context) textmode))
(defun epg-context-set-passphrase-callback (context
passphrase-callback)
@@ -384,11 +251,11 @@ on the external program called `gpg-agent' for passphrase query.
If you really want to intercept passphrase query, consider
installing GnuPG 1.x _along with_ GnuPG 2.x, which does passphrase
query by itself and Emacs can intercept them."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 9 (if (consp passphrase-callback)
- passphrase-callback
- (list passphrase-callback))))
+ ;; (declare (obsolete setf "25.1"))
+ (setf (epg-context-passphrase-callback context)
+ (if (functionp passphrase-callback)
+ (list passphrase-callback)
+ passphrase-callback)))
(defun epg-context-set-progress-callback (context
progress-callback)
@@ -401,607 +268,119 @@ The function gets six arguments: the context, the operation
description, the character to display a progress unit, the
current amount done, the total amount to be done, and the
callback data (if any)."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 10 (if (consp progress-callback)
- progress-callback
- (list progress-callback))))
+ (setf (epg-context-progress-callback context)
+ (if (functionp progress-callback)
+ (list progress-callback)
+ progress-callback)))
(defun epg-context-set-signers (context signers)
"Set the list of key-id for signing."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 11 signers))
-
-(defun epg-context-set-sig-notations (context notations)
- "Set the list of notations for signing."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 12 notations))
-
-(defun epg-context-set-process (context process)
- "Set the process object of `epg-gpg-program'.
-This function is for internal use only."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 13 process))
-
-(defun epg-context-set-output-file (context output-file)
- "Set the output file of `epg-gpg-program'.
-This function is for internal use only."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 14 output-file))
-
-(defun epg-context-set-result (context result)
- "Set the result of the previous cryptographic operation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 15 result))
-
-(defun epg-context-set-operation (context operation)
- "Set the name of the current cryptographic operation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (aset (cdr context) 16 operation))
-
-(defun epg-context-set-pinentry-mode (context mode)
- "Set the mode of pinentry invocation."
- (unless (eq (car-safe context) 'epg-context)
- (signal 'wrong-type-argument (list 'epg-context-p context)))
- (unless (memq mode '(nil ask cancel error loopback))
- (signal 'epg-error (list "Unknown pinentry mode" mode)))
- (aset (cdr context) 17 mode))
-
-(defun epg-make-signature (status &optional key-id)
- "Return a signature object."
- (cons 'epg-signature (vector status key-id nil nil nil nil nil nil nil nil
- nil)))
-
-(defun epg-signature-status (signature)
- "Return the status code of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 0))
-
-(defun epg-signature-key-id (signature)
- "Return the key-id of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 1))
-
-(defun epg-signature-validity (signature)
- "Return the validity of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 2))
-
-(defun epg-signature-fingerprint (signature)
- "Return the fingerprint of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 3))
-
-(defun epg-signature-creation-time (signature)
- "Return the creation time of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 4))
-
-(defun epg-signature-expiration-time (signature)
- "Return the expiration time of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 5))
-
-(defun epg-signature-pubkey-algorithm (signature)
- "Return the public key algorithm of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 6))
-
-(defun epg-signature-digest-algorithm (signature)
- "Return the digest algorithm of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 7))
-
-(defun epg-signature-class (signature)
- "Return the class of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 8))
-
-(defun epg-signature-version (signature)
- "Return the version of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 9))
-
-(defun epg-sig-notations (signature)
- "Return the list of notations of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aref (cdr signature) 10))
-
-(defun epg-signature-set-status (signature status)
- "Set the status code of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 0 status))
-
-(defun epg-signature-set-key-id (signature key-id)
- "Set the key-id of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 1 key-id))
-
-(defun epg-signature-set-validity (signature validity)
- "Set the validity of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 2 validity))
-
-(defun epg-signature-set-fingerprint (signature fingerprint)
- "Set the fingerprint of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 3 fingerprint))
-
-(defun epg-signature-set-creation-time (signature creation-time)
- "Set the creation time of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 4 creation-time))
-
-(defun epg-signature-set-expiration-time (signature expiration-time)
- "Set the expiration time of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 5 expiration-time))
-
-(defun epg-signature-set-pubkey-algorithm (signature pubkey-algorithm)
- "Set the public key algorithm of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 6 pubkey-algorithm))
-
-(defun epg-signature-set-digest-algorithm (signature digest-algorithm)
- "Set the digest algorithm of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 7 digest-algorithm))
-
-(defun epg-signature-set-class (signature class)
- "Set the class of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 8 class))
-
-(defun epg-signature-set-version (signature version)
- "Set the version of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 9 version))
-
-(defun epg-signature-set-notations (signature notations)
- "Set the list of notations of SIGNATURE."
- (unless (eq (car-safe signature) 'epg-signature)
- (signal 'wrong-type-argument (list 'epg-signature-p signature)))
- (aset (cdr signature) 10 notations))
-
-(defun epg-make-new-signature (type pubkey-algorithm digest-algorithm
- class creation-time fingerprint)
- "Return a new signature object."
- (cons 'epg-new-signature (vector type pubkey-algorithm digest-algorithm
- class creation-time fingerprint)))
-
-(defun epg-new-signature-type (new-signature)
- "Return the type of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 0))
-
-(defun epg-new-signature-pubkey-algorithm (new-signature)
- "Return the public key algorithm of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 1))
-
-(defun epg-new-signature-digest-algorithm (new-signature)
- "Return the digest algorithm of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 2))
-
-(defun epg-new-signature-class (new-signature)
- "Return the class of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 3))
-
-(defun epg-new-signature-creation-time (new-signature)
- "Return the creation time of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 4))
-
-(defun epg-new-signature-fingerprint (new-signature)
- "Return the fingerprint of NEW-SIGNATURE."
- (unless (eq (car-safe new-signature) 'epg-new-signature)
- (signal 'wrong-type-argument (list 'epg-new-signature-p new-signature)))
- (aref (cdr new-signature) 5))
-
-(defun epg-make-key (owner-trust)
- "Return a key object."
- (cons 'epg-key (vector owner-trust nil nil)))
-
-(defun epg-key-owner-trust (key)
- "Return the owner trust of KEY."
- (unless (eq (car-safe key) 'epg-key)
- (signal 'wrong-type-argument (list 'epg-key-p key)))
- (aref (cdr key) 0))
-
-(defun epg-key-sub-key-list (key)
- "Return the sub key list of KEY."
- (unless (eq (car-safe key) 'epg-key)
- (signal 'wrong-type-argument (list 'epg-key-p key)))
- (aref (cdr key) 1))
-
-(defun epg-key-user-id-list (key)
- "Return the user ID list of KEY."
- (unless (eq (car-safe key) 'epg-key)
- (signal 'wrong-type-argument (list 'epg-key-p key)))
- (aref (cdr key) 2))
-
-(defun epg-key-set-sub-key-list (key sub-key-list)
- "Set the sub key list of KEY."
- (unless (eq (car-safe key) 'epg-key)
- (signal 'wrong-type-argument (list 'epg-key-p key)))
- (aset (cdr key) 1 sub-key-list))
-
-(defun epg-key-set-user-id-list (key user-id-list)
- "Set the user ID list of KEY."
- (unless (eq (car-safe key) 'epg-key)
- (signal 'wrong-type-argument (list 'epg-key-p key)))
- (aset (cdr key) 2 user-id-list))
-
-(defun epg-make-sub-key (validity capability secret-p algorithm length id
- creation-time expiration-time)
- "Return a sub key object."
- (cons 'epg-sub-key
- (vector validity capability secret-p algorithm length id creation-time
- expiration-time nil)))
-
-(defun epg-sub-key-validity (sub-key)
- "Return the validity of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 0))
-
-(defun epg-sub-key-capability (sub-key)
- "Return the capability of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 1))
-
-(defun epg-sub-key-secret-p (sub-key)
- "Return non-nil if SUB-KEY is a secret key."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 2))
-
-(defun epg-sub-key-algorithm (sub-key)
- "Return the algorithm of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 3))
-
-(defun epg-sub-key-length (sub-key)
- "Return the length of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 4))
-
-(defun epg-sub-key-id (sub-key)
- "Return the ID of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 5))
-
-(defun epg-sub-key-creation-time (sub-key)
- "Return the creation time of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 6))
-
-(defun epg-sub-key-expiration-time (sub-key)
- "Return the expiration time of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 7))
-
-(defun epg-sub-key-fingerprint (sub-key)
- "Return the fingerprint of SUB-KEY."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aref (cdr sub-key) 8))
-
-(defun epg-sub-key-set-fingerprint (sub-key fingerprint)
- "Set the fingerprint of SUB-KEY.
-This function is for internal use only."
- (unless (eq (car-safe sub-key) 'epg-sub-key)
- (signal 'wrong-type-argument (list 'epg-sub-key-p sub-key)))
- (aset (cdr sub-key) 8 fingerprint))
-
-(defun epg-make-user-id (validity string)
- "Return a user ID object."
- (cons 'epg-user-id (vector validity string nil)))
-
-(defun epg-user-id-validity (user-id)
- "Return the validity of USER-ID."
- (unless (eq (car-safe user-id) 'epg-user-id)
- (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
- (aref (cdr user-id) 0))
-
-(defun epg-user-id-string (user-id)
- "Return the name of USER-ID."
- (unless (eq (car-safe user-id) 'epg-user-id)
- (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
- (aref (cdr user-id) 1))
-
-(defun epg-user-id-signature-list (user-id)
- "Return the signature list of USER-ID."
- (unless (eq (car-safe user-id) 'epg-user-id)
- (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
- (aref (cdr user-id) 2))
-
-(defun epg-user-id-set-signature-list (user-id signature-list)
- "Set the signature list of USER-ID."
- (unless (eq (car-safe user-id) 'epg-user-id)
- (signal 'wrong-type-argument (list 'epg-user-id-p user-id)))
- (aset (cdr user-id) 2 signature-list))
-
-(defun epg-make-key-signature (validity pubkey-algorithm key-id creation-time
- expiration-time user-id class
- exportable-p)
- "Return a key signature object."
- (cons 'epg-key-signature
- (vector validity pubkey-algorithm key-id creation-time expiration-time
- user-id class exportable-p)))
-
-(defun epg-key-signature-validity (key-signature)
- "Return the validity of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 0))
-
-(defun epg-key-signature-pubkey-algorithm (key-signature)
- "Return the public key algorithm of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 1))
-
-(defun epg-key-signature-key-id (key-signature)
- "Return the key-id of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 2))
-
-(defun epg-key-signature-creation-time (key-signature)
- "Return the creation time of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 3))
-
-(defun epg-key-signature-expiration-time (key-signature)
- "Return the expiration time of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 4))
-
-(defun epg-key-signature-user-id (key-signature)
- "Return the user-id of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 5))
-
-(defun epg-key-signature-class (key-signature)
- "Return the class of KEY-SIGNATURE."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 6))
-
-(defun epg-key-signature-exportable-p (key-signature)
- "Return t if KEY-SIGNATURE is exportable."
- (unless (eq (car-safe key-signature) 'epg-key-signature)
- (signal 'wrong-type-argument (list 'epg-key-signature-p key-signature)))
- (aref (cdr key-signature) 7))
-
-(defun epg-make-sig-notation (name value &optional human-readable
- critical)
- "Return a notation object."
- (cons 'epg-sig-notation (vector name value human-readable critical)))
-
-(defun epg-sig-notation-name (sig-notation)
- "Return the name of SIG-NOTATION."
- (unless (eq (car-safe sig-notation) 'epg-sig-notation)
- (signal 'wrong-type-argument (list 'epg-sig-notation-p
- sig-notation)))
- (aref (cdr sig-notation) 0))
-
-(defun epg-sig-notation-value (sig-notation)
- "Return the value of SIG-NOTATION."
- (unless (eq (car-safe sig-notation) 'epg-sig-notation)
- (signal 'wrong-type-argument (list 'epg-sig-notation-p
- sig-notation)))
- (aref (cdr sig-notation) 1))
-
-(defun epg-sig-notation-human-readable (sig-notation)
- "Return the human-readable of SIG-NOTATION."
- (unless (eq (car-safe sig-notation) 'epg-sig-notation)
- (signal 'wrong-type-argument (list 'epg-sig-notation-p
- sig-notation)))
- (aref (cdr sig-notation) 2))
-
-(defun epg-sig-notation-critical (sig-notation)
- "Return the critical of SIG-NOTATION."
- (unless (eq (car-safe sig-notation) 'epg-sig-notation)
- (signal 'wrong-type-argument (list 'epg-sig-notation-p
- sig-notation)))
- (aref (cdr sig-notation) 3))
-
-(defun epg-sig-notation-set-value (sig-notation value)
- "Set the value of SIG-NOTATION."
- (unless (eq (car-safe sig-notation) 'epg-sig-notation)
- (signal 'wrong-type-argument (list 'epg-sig-notation-p
- sig-notation)))
- (aset (cdr sig-notation) 1 value))
-
-(defun epg-make-import-status (fingerprint &optional reason new user-id
- signature sub-key secret)
- "Return an import status object."
- (cons 'epg-import-status (vector fingerprint reason new user-id signature
- sub-key secret)))
-
-(defun epg-import-status-fingerprint (import-status)
- "Return the fingerprint of the key that was considered."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 0))
-
-(defun epg-import-status-reason (import-status)
- "Return the reason code for import failure."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 1))
-
-(defun epg-import-status-new (import-status)
- "Return t if the imported key was new."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 2))
-
-(defun epg-import-status-user-id (import-status)
- "Return t if the imported key contained new user IDs."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 3))
-
-(defun epg-import-status-signature (import-status)
- "Return t if the imported key contained new signatures."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 4))
-
-(defun epg-import-status-sub-key (import-status)
- "Return t if the imported key contained new sub keys."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 5))
-
-(defun epg-import-status-secret (import-status)
- "Return t if the imported key contained a secret key."
- (unless (eq (car-safe import-status) 'epg-import-status)
- (signal 'wrong-type-argument (list 'epg-import-status-p import-status)))
- (aref (cdr import-status) 6))
-
-(defun epg-make-import-result (considered no-user-id imported imported-rsa
- unchanged new-user-ids new-sub-keys
- new-signatures new-revocations
- secret-read secret-imported
- secret-unchanged not-imported
- imports)
- "Return an import result object."
- (cons 'epg-import-result (vector considered no-user-id imported imported-rsa
- unchanged new-user-ids new-sub-keys
- new-signatures new-revocations secret-read
- secret-imported secret-unchanged
- not-imported imports)))
-
-(defun epg-import-result-considered (import-result)
- "Return the total number of considered keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 0))
-
-(defun epg-import-result-no-user-id (import-result)
- "Return the number of keys without user ID."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 1))
-
-(defun epg-import-result-imported (import-result)
- "Return the number of imported keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 2))
-
-(defun epg-import-result-imported-rsa (import-result)
- "Return the number of imported RSA keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 3))
-
-(defun epg-import-result-unchanged (import-result)
- "Return the number of unchanged keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 4))
-
-(defun epg-import-result-new-user-ids (import-result)
- "Return the number of new user IDs."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 5))
-
-(defun epg-import-result-new-sub-keys (import-result)
- "Return the number of new sub keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 6))
-
-(defun epg-import-result-new-signatures (import-result)
- "Return the number of new signatures."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 7))
-
-(defun epg-import-result-new-revocations (import-result)
- "Return the number of new revocations."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 8))
-
-(defun epg-import-result-secret-read (import-result)
- "Return the total number of secret keys read."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 9))
-
-(defun epg-import-result-secret-imported (import-result)
- "Return the number of imported secret keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 10))
-
-(defun epg-import-result-secret-unchanged (import-result)
- "Return the number of unchanged secret keys."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 11))
-
-(defun epg-import-result-not-imported (import-result)
- "Return the number of keys not imported."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 12))
-
-(defun epg-import-result-imports (import-result)
- "Return the list of `epg-import-status' objects."
- (unless (eq (car-safe import-result) 'epg-import-result)
- (signal 'wrong-type-argument (list 'epg-import-result-p import-result)))
- (aref (cdr import-result) 13))
+ (declare (obsolete setf "25.1"))
+ (setf (epg-context-signers context) signers))
+
+(cl-defstruct (epg-signature
+ (:constructor nil)
+ (:constructor epg-make-signature
+ (status &optional key-id))
+ (:copier nil)
+ (:predicate nil))
+ status
+ key-id
+ validity
+ fingerprint
+ creation-time
+ expiration-time
+ pubkey-algorithm
+ digest-algorithm
+ class
+ version
+ notations)
+
+(cl-defstruct (epg-new-signature
+ (:constructor nil)
+ (:constructor epg-make-new-signature
+ (type pubkey-algorithm digest-algorithm
+ class creation-time fingerprint))
+ (:copier nil)
+ (:predicate nil))
+ (type nil :read-only t)
+ (pubkey-algorithm nil :read-only t)
+ (digest-algorithm nil :read-only t)
+ (class nil :read-only t)
+ (creation-time nil :read-only t)
+ (fingerprint nil :read-only t))
+
+(cl-defstruct (epg-key
+ (:constructor nil)
+ (:constructor epg-make-key (owner-trust))
+ (:copier nil)
+ (:predicate nil))
+ (owner-trust nil :read-only t)
+ sub-key-list user-id-list)
+
+(cl-defstruct (epg-sub-key
+ (:constructor nil)
+ (:constructor epg-make-sub-key
+ (validity capability secret-p algorithm length id
+ creation-time expiration-time))
+ (:copier nil)
+ (:predicate nil))
+ validity capability secret-p algorithm length id
+ creation-time expiration-time fingerprint)
+
+(cl-defstruct (epg-user-id
+ (:constructor nil)
+ (:constructor epg-make-user-id (validity string))
+ (:copier nil)
+ (:predicate nil))
+ validity string signature-list)
+
+(cl-defstruct (epg-key-signature
+ (:constructor nil)
+ (:constructor epg-make-key-signature
+ (validity pubkey-algorithm key-id creation-time
+ expiration-time user-id class
+ exportable-p))
+ (:copier nil)
+ (:predicate nil))
+ validity pubkey-algorithm key-id creation-time
+ expiration-time user-id class
+ exportable-p)
+
+(cl-defstruct (epg-sig-notation
+ (:constructor nil)
+ (:constructor epg-make-sig-notation
+ (name value &optional human-readable critical))
+ (:copier nil)
+ (:predicate nil))
+ name value human-readable critical)
+
+(cl-defstruct (epg-import-status
+ (:constructor nil)
+ (:constructor epg-make-import-status
+ (fingerprint
+ &optional reason new user-id signature sub-key secret))
+ (:copier nil)
+ (:predicate nil))
+ fingerprint reason new user-id signature sub-key secret)
+
+(cl-defstruct (epg-import-result
+ (:constructor nil)
+ (:constructor epg-make-import-result
+ (considered no-user-id imported imported-rsa
+ unchanged new-user-ids new-sub-keys
+ new-signatures new-revocations
+ secret-read secret-imported
+ secret-unchanged not-imported
+ imports))
+ (:copier nil)
+ (:predicate nil))
+ considered no-user-id imported imported-rsa
+ unchanged new-user-ids new-sub-keys
+ new-signatures new-revocations
+ secret-read secret-imported
+ secret-unchanged not-imported
+ imports)
(defun epg-context-result-for (context name)
"Return the result of CONTEXT associated with NAME."
@@ -1013,7 +392,7 @@ This function is for internal use only."
(entry (assq name result)))
(if entry
(setcdr entry value)
- (epg-context-set-result context (cons (cons name value) result)))))
+ (setf (epg-context-result context) (cons (cons name value) result)))))
(defun epg-signature-to-string (signature)
"Convert SIGNATURE to a human readable string."
@@ -1124,7 +503,7 @@ This function is for internal use only."
((eq (car error) 'exit)
"Exit")
((eq (car error) 'quit)
- "Cancelled")
+ "Canceled")
((eq (car error) 'no-data)
(let ((entry (assq (cdr error) epg-no-data-reason-alist)))
(if entry
@@ -1202,12 +581,9 @@ This function is for internal use only."
(symbol-name (epg-context-pinentry-mode
context))))
args))
- (coding-system-for-write 'binary)
- (coding-system-for-read 'binary)
- process-connection-type
(process-environment process-environment)
- (orig-mode (default-file-modes))
(buffer (generate-new-buffer " *epg*"))
+ error-process
process
terminal-name
agent-file
@@ -1226,6 +602,22 @@ This function is for internal use only."
(setq process-environment
(cons (concat "GPG_TTY=" terminal-name)
(cons "TERM=xterm" process-environment))))
+ ;; Start the Emacs Pinentry server if allow-emacs-pinentry is set
+ ;; in ~/.gnupg/gpg-agent.conf.
+ (when (and (fboundp 'pinentry-start)
+ (executable-find epg-gpgconf-program)
+ (with-temp-buffer
+ (when (= (call-process epg-gpgconf-program nil t nil
+ "--list-options" "gpg-agent")
+ 0)
+ (goto-char (point-min))
+ (re-search-forward
+ "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1"
+ nil t))))
+ (pinentry-start))
+ (setq process-environment
+ (cons (format "INSIDE_EMACS=%s,epg" emacs-version)
+ process-environment))
;; Record modified time of gpg-agent socket to restore the Emacs
;; frame on text terminal in `epg-wait-for-completion'.
;; See
@@ -1265,50 +657,67 @@ This function is for internal use only."
(setq epg-agent-file agent-file)
(make-local-variable 'epg-agent-mtime)
(setq epg-agent-mtime agent-mtime))
- (unwind-protect
- (progn
- (set-default-file-modes 448)
- (setq process
- (apply #'start-process "epg" buffer
- (epg-context-program context)
- args)))
- (set-default-file-modes orig-mode))
- (set-process-filter process #'epg--process-filter)
- (epg-context-set-process context process)))
+ (setq error-process
+ (make-pipe-process :name "epg-error"
+ :buffer (generate-new-buffer " *epg-error*")
+ ;; Suppress "XXX finished" line.
+ :sentinel #'ignore
+ :noquery t))
+ (setf (epg-context-error-buffer context) (process-buffer error-process))
+ (with-file-modes 448
+ (setq process (make-process :name "epg"
+ :buffer buffer
+ :command (cons (epg-context-program context)
+ args)
+ :connection-type 'pipe
+ :coding '(binary . binary)
+ :filter #'epg--process-filter
+ :stderr error-process
+ :noquery t)))
+ (setf (epg-context-process context) process)))
(defun epg--process-filter (process input)
(if epg-debug
- (save-excursion
- (unless epg-debug-buffer
- (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
- (set-buffer epg-debug-buffer)
+ (with-current-buffer
+ (or epg-debug-buffer
+ (setq epg-debug-buffer (generate-new-buffer " *epg-debug*")))
(goto-char (point-max))
(insert input)))
(if (buffer-live-p (process-buffer process))
(with-current-buffer (process-buffer process)
- (goto-char (point-max))
- (insert input)
- (unless epg-process-filter-running
- (unwind-protect
- (progn
- (setq epg-process-filter-running t)
- (goto-char epg-read-point)
- (beginning-of-line)
- (while (looking-at ".*\n") ;the input line finished
- (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
- (let* ((status (match-string 1))
- (string (match-string 2))
- (symbol (intern-soft (concat "epg--status-"
- status))))
- (if (member status epg-pending-status-list)
- (setq epg-pending-status-list nil))
+ (save-excursion
+ (goto-char (point-max))
+ (insert input)
+ (unless epg-process-filter-running
+ (let ((epg-process-filter-running t))
+ (goto-char epg-read-point)
+ (beginning-of-line)
+ (while (looking-at ".*\n") ;the input line finished
+ (if (looking-at "\\[GNUPG:] \\([A-Z_]+\\) ?\\(.*\\)")
+ (let ((status (match-string 1))
+ (string (match-string 2))
+ symbol)
+ (if (member status epg-pending-status-list)
+ (setq epg-pending-status-list nil))
+ ;; When editing a key, delegate all interaction
+ ;; to edit-callback.
+ (if (eq (epg-context-operation epg-context) 'edit-key)
+ (funcall (car (epg-context-edit-callback
+ epg-context))
+ epg-context
+ status
+ string
+ (cdr (epg-context-edit-callback
+ epg-context)))
+ ;; Otherwise call epg--status-STATUS function.
+ (setq symbol (intern-soft (concat "epg--status-"
+ status)))
(if (and symbol
(fboundp symbol))
- (funcall symbol epg-context string))
- (setq epg-last-status (cons status string))))
- (forward-line)
- (setq epg-read-point (point))))
- (setq epg-process-filter-running nil))))))
+ (funcall symbol epg-context string)))
+ (setq epg-last-status (cons status string))))
+ (forward-line)
+ (setq epg-read-point (point)))))))))
(defun epg-read-output (context)
"Read the output file CONTEXT and return the content as a string."
@@ -1348,14 +757,20 @@ This function is for internal use only."
(redraw-frame))
(epg-context-set-result-for
context 'error
- (nreverse (epg-context-result-for context 'error))))
+ (nreverse (epg-context-result-for context 'error)))
+ (setf (epg-context-error-output context)
+ (with-current-buffer (epg-context-error-buffer context)
+ (buffer-string))))
(defun epg-reset (context)
"Reset the CONTEXT."
(if (and (epg-context-process context)
(buffer-live-p (process-buffer (epg-context-process context))))
(kill-buffer (process-buffer (epg-context-process context))))
- (epg-context-set-process context nil))
+ (if (buffer-live-p (epg-context-error-buffer context))
+ (kill-buffer (epg-context-error-buffer context)))
+ (setf (epg-context-process context) nil)
+ (setf (epg-context-edit-callback context) nil))
(defun epg-delete-output-file (context)
"Delete the output file of CONTEXT."
@@ -1549,7 +964,7 @@ This function is for internal use only."
(if (and signature
(eq (epg-signature-status signature) 'error)
(equal (epg-signature-key-id signature) string))
- (epg-signature-set-status signature 'no-pubkey)))
+ (setf (epg-signature-status signature) 'no-pubkey)))
(epg-context-set-result-for
context 'error
(cons (cons 'no-pubkey string)
@@ -1576,21 +991,16 @@ This function is for internal use only."
'verify
(cons signature
(epg-context-result-for context 'verify)))
- (epg-signature-set-key-id
- signature
- (match-string 1 string))
- (epg-signature-set-pubkey-algorithm
- signature
- (string-to-number (match-string 2 string)))
- (epg-signature-set-digest-algorithm
- signature
- (string-to-number (match-string 3 string)))
- (epg-signature-set-class
- signature
- (string-to-number (match-string 4 string) 16))
- (epg-signature-set-creation-time
- signature
- (epg--time-from-seconds (match-string 5 string))))))
+ (setf (epg-signature-key-id signature)
+ (match-string 1 string))
+ (setf (epg-signature-pubkey-algorithm signature)
+ (string-to-number (match-string 2 string)))
+ (setf (epg-signature-digest-algorithm signature)
+ (string-to-number (match-string 3 string)))
+ (setf (epg-signature-class signature)
+ (string-to-number (match-string 4 string) 16))
+ (setf (epg-signature-creation-time signature)
+ (epg--time-from-seconds (match-string 5 string))))))
(defun epg--status-VALIDSIG (context string)
(let ((signature (car (epg-context-result-for context 'verify))))
@@ -1600,81 +1010,70 @@ This function is for internal use only."
\\([0-9]+\\) [^ ]+ \\([0-9]+\\) \\([0-9]+\\) \\([0-9A-Fa-f][0-9A-Fa-f]\\) \
\\(.*\\)"
string))
- (epg-signature-set-fingerprint
- signature
- (match-string 1 string))
- (epg-signature-set-creation-time
- signature
- (epg--time-from-seconds (match-string 2 string)))
+ (setf (epg-signature-fingerprint signature)
+ (match-string 1 string))
+ (setf (epg-signature-creation-time signature)
+ (epg--time-from-seconds (match-string 2 string)))
(unless (equal (match-string 3 string) "0")
- (epg-signature-set-expiration-time
- signature
- (epg--time-from-seconds (match-string 3 string))))
- (epg-signature-set-version
- signature
- (string-to-number (match-string 4 string)))
- (epg-signature-set-pubkey-algorithm
- signature
- (string-to-number (match-string 5 string)))
- (epg-signature-set-digest-algorithm
- signature
- (string-to-number (match-string 6 string)))
- (epg-signature-set-class
- signature
- (string-to-number (match-string 7 string) 16)))))
+ (setf (epg-signature-expiration-time signature)
+ (epg--time-from-seconds (match-string 3 string))))
+ (setf (epg-signature-version signature)
+ (string-to-number (match-string 4 string)))
+ (setf (epg-signature-pubkey-algorithm signature)
+ (string-to-number (match-string 5 string)))
+ (setf (epg-signature-digest-algorithm signature)
+ (string-to-number (match-string 6 string)))
+ (setf (epg-signature-class signature)
+ (string-to-number (match-string 7 string) 16)))))
(defun epg--status-TRUST_UNDEFINED (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
(eq (epg-signature-status signature) 'good))
- (epg-signature-set-validity signature 'undefined))))
+ (setf (epg-signature-validity signature) 'undefined))))
(defun epg--status-TRUST_NEVER (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
(eq (epg-signature-status signature) 'good))
- (epg-signature-set-validity signature 'never))))
+ (setf (epg-signature-validity signature) 'never))))
(defun epg--status-TRUST_MARGINAL (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
(eq (epg-signature-status signature) 'marginal))
- (epg-signature-set-validity signature 'marginal))))
+ (setf (epg-signature-validity signature) 'marginal))))
(defun epg--status-TRUST_FULLY (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
(eq (epg-signature-status signature) 'good))
- (epg-signature-set-validity signature 'full))))
+ (setf (epg-signature-validity signature) 'full))))
(defun epg--status-TRUST_ULTIMATE (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
(eq (epg-signature-status signature) 'good))
- (epg-signature-set-validity signature 'ultimate))))
+ (setf (epg-signature-validity signature) 'ultimate))))
(defun epg--status-NOTATION_NAME (context string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if signature
- (epg-signature-set-notations
- signature
- (cons (epg-make-sig-notation string nil t nil)
- (epg-sig-notations signature))))))
+ (push (epg-make-sig-notation string nil t nil)
+ (epg-signature-notations signature)))))
(defun epg--status-NOTATION_DATA (context string)
(let ((signature (car (epg-context-result-for context 'verify)))
notation)
(if (and signature
- (setq notation (car (epg-sig-notations signature))))
- (epg-sig-notation-set-value notation string))))
+ (setq notation (car (epg-signature-notations signature))))
+ (setf (epg-sig-notation-value notation) string))))
(defun epg--status-POLICY_URL (context string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if signature
- (epg-signature-set-notations
- signature
- (cons (epg-make-sig-notation nil string t nil)
- (epg-sig-notations signature))))))
+ (push (epg-make-sig-notation nil string t nil)
+ (epg-signature-notations signature)))))
(defun epg--status-PROGRESS (context string)
(if (and (epg-context-progress-callback context)
@@ -1913,8 +1312,9 @@ This function is for internal use only."
string (match-string 0)
index 0
field 0)
- (while (eq index
- (string-match "\\([^:]+\\)?:" string index))
+ (while (and (< field (length (car keys)))
+ (eq index
+ (string-match "\\([^:]+\\)?:" string index)))
(setq index (match-end 0))
(aset (car keys) field (match-string 1 string))
(setq field (1+ field))))
@@ -1925,7 +1325,7 @@ This function is for internal use only."
(if (aref line 1)
(cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
(delq nil
- (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
+ (mapcar (lambda (char) (cdr (assq char epg-key-capability-alist)))
(aref line 11)))
(member (aref line 0) '("sec" "ssb"))
(string-to-number (aref line 3))
@@ -1953,15 +1353,11 @@ NAME is either a string or a list of strings."
(cdr (assq (string-to-char (aref (car lines) 8))
epg-key-validity-alist))))
keys))
- (epg-key-set-sub-key-list
- (car keys)
- (cons (epg--make-sub-key-1 (car lines))
- (epg-key-sub-key-list (car keys)))))
+ (push (epg--make-sub-key-1 (car lines))
+ (epg-key-sub-key-list (car keys))))
((member (aref (car lines) 0) '("sub" "ssb"))
- (epg-key-set-sub-key-list
- (car keys)
- (cons (epg--make-sub-key-1 (car lines))
- (epg-key-sub-key-list (car keys)))))
+ (push (epg--make-sub-key-1 (car lines))
+ (epg-key-sub-key-list (car keys))))
((equal (aref (car lines) 0) "uid")
;; Decode the UID name as a backslash escaped UTF-8 string,
;; generated by GnuPG/GpgSM.
@@ -1976,52 +1372,42 @@ NAME is either a string or a list of strings."
'utf-8))
(error
(setq string (aref (car lines) 9))))
- (epg-key-set-user-id-list
- (car keys)
- (cons (epg-make-user-id
- (if (aref (car lines) 1)
- (cdr (assq (string-to-char (aref (car lines) 1))
- epg-key-validity-alist)))
- (if cert
- (condition-case nil
- (epg-dn-from-string string)
- (error string))
- string))
- (epg-key-user-id-list (car keys)))))
+ (push (epg-make-user-id
+ (if (aref (car lines) 1)
+ (cdr (assq (string-to-char (aref (car lines) 1))
+ epg-key-validity-alist)))
+ (if cert
+ (condition-case nil
+ (epg-dn-from-string string)
+ (error string))
+ string))
+ (epg-key-user-id-list (car keys))))
((equal (aref (car lines) 0) "fpr")
- (epg-sub-key-set-fingerprint (car (epg-key-sub-key-list (car keys)))
- (aref (car lines) 9)))
+ (setf (epg-sub-key-fingerprint (car (epg-key-sub-key-list (car keys))))
+ (aref (car lines) 9)))
((equal (aref (car lines) 0) "sig")
- (epg-user-id-set-signature-list
- (car (epg-key-user-id-list (car keys)))
- (cons
- (epg-make-key-signature
- (if (aref (car lines) 1)
- (cdr (assq (string-to-char (aref (car lines) 1))
- epg-key-validity-alist)))
- (string-to-number (aref (car lines) 3))
- (aref (car lines) 4)
- (epg--time-from-seconds (aref (car lines) 5))
- (epg--time-from-seconds (aref (car lines) 6))
- (aref (car lines) 9)
- (string-to-number (aref (car lines) 10) 16)
- (eq (aref (aref (car lines) 10) 2) ?x))
- (epg-user-id-signature-list
- (car (epg-key-user-id-list (car keys))))))))
+ (push
+ (epg-make-key-signature
+ (if (aref (car lines) 1)
+ (cdr (assq (string-to-char (aref (car lines) 1))
+ epg-key-validity-alist)))
+ (string-to-number (aref (car lines) 3))
+ (aref (car lines) 4)
+ (epg--time-from-seconds (aref (car lines) 5))
+ (epg--time-from-seconds (aref (car lines) 6))
+ (aref (car lines) 9)
+ (string-to-number (aref (car lines) 10) 16)
+ (eq (aref (aref (car lines) 10) 2) ?x))
+ (epg-user-id-signature-list
+ (car (epg-key-user-id-list (car keys)))))))
(setq lines (cdr lines)))
(setq keys (nreverse keys)
pointer keys)
(while pointer
- (epg-key-set-sub-key-list
- (car pointer)
- (nreverse (epg-key-sub-key-list (car pointer))))
- (setq pointer-1 (epg-key-set-user-id-list
- (car pointer)
- (nreverse (epg-key-user-id-list (car pointer)))))
+ (epg--gv-nreverse (epg-key-sub-key-list (car pointer)))
+ (setq pointer-1 (epg--gv-nreverse (epg-key-user-id-list (car pointer))))
(while pointer-1
- (epg-user-id-set-signature-list
- (car pointer-1)
- (nreverse (epg-user-id-signature-list (car pointer-1))))
+ (epg--gv-nreverse (epg-user-id-signature-list (car pointer-1)))
(setq pointer-1 (cdr pointer-1)))
(setq pointer (cdr pointer)))
keys))
@@ -2123,8 +1509,8 @@ If you are unsure, use synchronous version of this function
`epg-decrypt-file' or `epg-decrypt-string' instead."
(unless (epg-data-file cipher)
(error "Not a file"))
- (epg-context-set-operation context 'decrypt)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'decrypt)
+ (setf (epg-context-result context) nil)
(epg--start context (list "--decrypt" "--" (epg-data-file cipher)))
;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
(unless (eq (epg-context-protocol context) 'CMS)
@@ -2144,10 +1530,8 @@ If you are unsure, use synchronous version of this function
If PLAIN is nil, it returns the result as a string."
(unwind-protect
(progn
- (if plain
- (epg-context-set-output-file context plain)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output")))
+ (setf (epg-context-output-file context)
+ (or plain (epg--make-temp-file "epg-output")))
(epg-start-decrypt context (epg-make-data-from-file cipher))
(epg-wait-for-completion context)
(epg--check-error-for-decrypt context)
@@ -2164,8 +1548,8 @@ If PLAIN is nil, it returns the result as a string."
(unwind-protect
(progn
(write-region cipher nil input-file nil 'quiet)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output"))
+ (setf (epg-context-output-file context)
+ (epg--make-temp-file "epg-output"))
(epg-start-decrypt context (epg-make-data-from-file input-file))
(epg-wait-for-completion context)
(epg--check-error-for-decrypt context)
@@ -2187,8 +1571,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-verify-file' or `epg-verify-string' instead."
- (epg-context-set-operation context 'verify)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'verify)
+ (setf (epg-context-result context) nil)
(if signed-text
;; Detached signature.
(if (epg-data-file signed-text)
@@ -2222,13 +1606,21 @@ SIGNED-TEXT and PLAIN are also a file if they are specified.
For a detached signature, both SIGNATURE and SIGNED-TEXT should be
string. For a normal or a cleartext signature, SIGNED-TEXT should be
nil. In the latter case, if PLAIN is specified, the plaintext is
-stored into the file after successful verification."
+stored into the file after successful verification.
+
+Note that this function does not return verification result as t
+or nil, nor signal error on failure. That's a design decision to
+handle the case where SIGNATURE has multiple signature.
+
+To check the verification results, use `epg-context-result-for' as follows:
+
+\(epg-context-result-for context \\='verify)
+
+which will return a list of `epg-signature' object."
(unwind-protect
(progn
- (if plain
- (epg-context-set-output-file context plain)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output")))
+ (setf (epg-context-output-file context)
+ (or plain (epg--make-temp-file "epg-output")))
(if signed-text
(epg-start-verify context
(epg-make-data-from-file signature)
@@ -2249,13 +1641,23 @@ SIGNED-TEXT is a string if it is specified.
For a detached signature, both SIGNATURE and SIGNED-TEXT should be
string. For a normal or a cleartext signature, SIGNED-TEXT should be
nil. In the latter case, this function returns the plaintext after
-successful verification."
+successful verification.
+
+Note that this function does not return verification result as t
+or nil, nor signal error on failure. That's a design decision to
+handle the case where SIGNATURE has multiple signature.
+
+To check the verification results, use `epg-context-result-for' as follows:
+
+\(epg-context-result-for context \\='verify)
+
+which will return a list of `epg-signature' object."
(let ((coding-system-for-write 'binary)
input-file)
(unwind-protect
(progn
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output"))
+ (setf (epg-context-output-file context)
+ (epg--make-temp-file "epg-output"))
(if signed-text
(progn
(setq input-file (epg--make-temp-file "epg-signature"))
@@ -2285,8 +1687,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-sign-file' or `epg-sign-string' instead."
- (epg-context-set-operation context 'sign)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'sign)
+ (setf (epg-context-result context) nil)
(unless (memq mode '(t detached nil normal)) ;i.e. cleartext
(epg-context-set-armor context nil)
(epg-context-set-textmode context nil))
@@ -2325,10 +1727,8 @@ If it is nil or 'normal, it makes a normal signature.
Otherwise, it makes a cleartext signature."
(unwind-protect
(progn
- (if signature
- (epg-context-set-output-file context signature)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output")))
+ (setf (epg-context-output-file context)
+ (or signature (epg--make-temp-file "epg-output")))
(epg-start-sign context (epg-make-data-from-file plain) mode)
(epg-wait-for-completion context)
(unless (epg-context-result-for context 'sign)
@@ -2357,8 +1757,8 @@ Otherwise, it makes a cleartext signature."
(coding-system-for-write 'binary))
(unwind-protect
(progn
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output"))
+ (setf (epg-context-output-file context)
+ (epg--make-temp-file "epg-output"))
(if input-file
(write-region plain nil input-file nil 'quiet))
(epg-start-sign context
@@ -2389,8 +1789,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-encrypt-file' or `epg-encrypt-string' instead."
- (epg-context-set-operation context 'encrypt)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'encrypt)
+ (setf (epg-context-result context) nil)
(epg--start context
(append (if always-trust '("--always-trust"))
(if recipients '("--encrypt") '("--symmetric"))
@@ -2418,9 +1818,8 @@ If you are unsure, use synchronous version of this function
(list "--" (epg-data-file plain)))))
;; `gpgsm' does not read passphrase from stdin, so waiting is not needed.
(unless (eq (epg-context-protocol context) 'CMS)
- (if sign
- (epg-wait-for-status context '("BEGIN_SIGNING"))
- (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
+ (epg-wait-for-status context
+ (if sign '("BEGIN_SIGNING") '("BEGIN_ENCRYPTION"))))
(when (epg-data-string plain)
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
@@ -2435,10 +1834,8 @@ If CIPHER is nil, it returns the result as a string.
If RECIPIENTS is nil, it performs symmetric encryption."
(unwind-protect
(progn
- (if cipher
- (epg-context-set-output-file context cipher)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output")))
+ (setf (epg-context-output-file context)
+ (or cipher (epg--make-temp-file "epg-output")))
(epg-start-encrypt context (epg-make-data-from-file plain)
recipients sign always-trust)
(epg-wait-for-completion context)
@@ -2472,8 +1869,8 @@ If RECIPIENTS is nil, it performs symmetric encryption."
(coding-system-for-write 'binary))
(unwind-protect
(progn
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output"))
+ (setf (epg-context-output-file context)
+ (epg--make-temp-file "epg-output"))
(if input-file
(write-region plain nil input-file nil 'quiet))
(epg-start-encrypt context
@@ -2504,8 +1901,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-export-keys-to-file' or `epg-export-keys-to-string' instead."
- (epg-context-set-operation context 'export-keys)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'export-keys)
+ (setf (epg-context-result context) nil)
(epg--start context (cons "--export"
(mapcar
(lambda (key)
@@ -2517,10 +1914,8 @@ If you are unsure, use synchronous version of this function
"Extract public KEYS."
(unwind-protect
(progn
- (if file
- (epg-context-set-output-file context file)
- (epg-context-set-output-file context
- (epg--make-temp-file "epg-output")))
+ (setf (epg-context-output-file context)
+ (or file (epg--make-temp-file "epg-output")))
(epg-start-export-keys context keys)
(epg-wait-for-completion context)
(let ((errors (epg-context-result-for context 'error)))
@@ -2547,8 +1942,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-import-keys-from-file' or `epg-import-keys-from-string' instead."
- (epg-context-set-operation context 'import-keys)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'import-keys)
+ (setf (epg-context-result context) nil)
(epg--start context (if (epg-data-file keys)
(list "--import" "--" (epg-data-file keys))
(list "--import")))
@@ -2588,8 +1983,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-receive-keys' instead."
- (epg-context-set-operation context 'receive-keys)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'receive-keys)
+ (setf (epg-context-result context) nil)
(epg--start context (cons "--recv-keys" key-id-list)))
(defun epg-receive-keys (context keys)
@@ -2616,8 +2011,8 @@ If you use this function, you will need to wait for the completion of
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-delete-keys' instead."
- (epg-context-set-operation context 'delete-keys)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'delete-keys)
+ (setf (epg-context-result context) nil)
(epg--start context (cons (if allow-secret
"--delete-secret-key"
"--delete-key")
@@ -2649,8 +2044,8 @@ If you use this function, you will need to wait for the completion of
If you are unsure, use synchronous version of this function
`epg-sign-keys' instead."
(declare (obsolete nil "23.1"))
- (epg-context-set-operation context 'sign-keys)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'sign-keys)
+ (setf (epg-context-result context) nil)
(epg--start context (cons (if local
"--lsign-key"
"--sign-key")
@@ -2676,19 +2071,21 @@ If you are unsure, use synchronous version of this function
(defun epg-start-generate-key (context parameters)
"Initiate a key generation.
-PARAMETERS specifies parameters for the key.
+PARAMETERS is a string which specifies parameters of the generated key.
+See Info node `(gnupg) Unattended GPG key generation' in the
+GnuPG manual for the format.
If you use this function, you will need to wait for the completion of
`epg-gpg-program' by using `epg-wait-for-completion' and call
`epg-reset' to clear a temporary output file.
If you are unsure, use synchronous version of this function
`epg-generate-key-from-file' or `epg-generate-key-from-string' instead."
- (epg-context-set-operation context 'generate-key)
- (epg-context-set-result context nil)
+ (setf (epg-context-operation context) 'generate-key)
+ (setf (epg-context-result context) nil)
(if (epg-data-file parameters)
- (epg--start context (list "--batch" "--genkey" "--"
+ (epg--start context (list "--batch" "--gen-key" "--"
(epg-data-file parameters)))
- (epg--start context '("--batch" "--genkey"))
+ (epg--start context '("--batch" "--gen-key"))
(if (eq (process-status (epg-context-process context)) 'run)
(process-send-string (epg-context-process context)
(epg-data-string parameters)))
@@ -2723,6 +2120,38 @@ PARAMETERS is a string which tells how to create the key."
(epg-errors-to-string errors))))))
(epg-reset context)))
+(defun epg-start-edit-key (context key edit-callback handback)
+ "Initiate an edit operation on KEY.
+
+EDIT-CALLBACK is called from process filter and takes 3
+arguments: the context, a status, an argument string, and the
+handback argument.
+
+If you use this function, you will need to wait for the completion of
+`epg-gpg-program' by using `epg-wait-for-completion' and call
+`epg-reset' to clear a temporary output file.
+If you are unsure, use synchronous version of this function
+`epg-edit-key' instead."
+ (setf (epg-context-operation context) 'edit-key)
+ (setf (epg-context-result context) nil)
+ (setf (epg-context-edit-callback context) (cons edit-callback handback))
+ (epg--start context (list "--edit-key"
+ (epg-sub-key-id
+ (car (epg-key-sub-key-list key))))))
+
+(defun epg-edit-key (context key edit-callback handback)
+ "Edit KEY in the keyring."
+ (unwind-protect
+ (progn
+ (epg-start-edit-key context key edit-callback handback)
+ (epg-wait-for-completion context)
+ (let ((errors (epg-context-result-for context 'error)))
+ (if errors
+ (signal 'epg-error
+ (list "Edit key failed"
+ (epg-errors-to-string errors))))))
+ (epg-reset context)))
+
(defun epg--decode-percent-escape (string)
(let ((index 0))
(while (string-match "%\\(\\(%\\)\\|\\([0-9A-Fa-f][0-9A-Fa-f]\\)\\)"
@@ -2770,7 +2199,7 @@ The return value is an alist mapping from types to values."
(if (eq index (string-match "[ \t\n\r]*" string index))
(setq index (match-end 0)))
(if (eq index (string-match
- "\\([0-9]+\\(\\.[0-9]+\\)*\\)\[ \t\n\r]*=[ \t\n\r]*"
+ "\\([0-9]+\\(\\.[0-9]+\\)*\\)[ \t\n\r]*=[ \t\n\r]*"
string index))
(setq type (match-string 1 string)
index (match-end 0))
diff --git a/lisp/erc/.gitignore b/lisp/erc/.gitignore
deleted file mode 100644
index 7053c310135..00000000000
--- a/lisp/erc/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-{arch}
-.arch-ids
-*.elc
diff --git a/lisp/erc/ChangeLog.01 b/lisp/erc/ChangeLog.01
deleted file mode 100644
index 16ccd68043e..00000000000
--- a/lisp/erc/ChangeLog.01
+++ /dev/null
@@ -1,1056 +0,0 @@
-2001-12-18 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Added missing 747 numreply (banned)
-
-2001-12-15 Gergely Nagy <algernon@debian.org>
-
- * debian/scripts/install, debian/rules:
- updated to 2.1.cvs.20011215-1
-
- * debian/changelog: Debian version 2.1.cvs.20011215-1
-
-2001-12-11 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * applied a nicer version of mhp's patch to remove the last prompt from
- saved logs
-
- * erc-replace.el: * Initial checkin
-
-2001-12-11 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * fixed bug triggered when reuse-buffer was enabled (the default).
- Another silly port type problem. Maybe we should unify that once and for all sometimes...
-
-2001-12-10 Mario Lang <mlang@delysid.org>
-
- * erc.el: * erc-message-english: New QUIT and s004 entries.
- * (erc-save-buffer-on-part): New variable.
- * (erc-kill-buffer-on-part): New variable.
- * (erc-server-PART): Use above variables.
- * (erc-join-channel): Use DEF argument instead of initial input for completing-read.
-
-2001-12-08 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el: added defcustom erc-nick-uniquifier ^ (i prefer _)
-
-2001-12-07 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: changelog for version 2.1.cvs.20011208-1
-
-2001-12-07 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el:
- Added erc-scroll-to-bottom as an erc-insert-hook function. It still bugs a bit, so please test it, thanks
-
-2001-12-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Fixed silly bug in erc-server-TOPIC (thanks mhp)
-
- * erc-speak.el:
- * Fix non-greedy matching bug. That one somehow swallowed text
-
- * erc.el:
- Fix Emacs20 problem. For now, we disable erc-track-modified-channels-minor-mode in emacs20
-
-2001-12-07 Andreas Fuchs <asf@void.at>
-
- * erc-fill.el:
- * Fix another stupid one-off error. This time it really works!
- (Until I find the next bug. I guess you can hold your breath) (-:
-
-2001-12-06 Andreas Fuchs <asf@void.at>
-
- * erc-fill.el: * Fixed static filling:
- ** No more \ed (continued on next line) lines anymore
- ** Fixed bug with previous version where longer lines wouldn't get
- filled correctly (i.e. at all)
-
-2001-12-06 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: changelog for 2.1.cvs.20011206-1 added
-
-2001-12-06 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * Don't discard away status when identifying to NickServ
- * Modify `erc-already-logged-in': check for port, too.
-
- * erc-fill.el:
- * Fix stupid loop non-termination error in erc-fill-static when filling
- one-line regions.
- * Make erc-count-lines return meaningful values
-
-2001-12-05 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-process-input): Make ' /command' work for quoting /commands
-
- * erc-speak.el: see changelog
-
- * erc-fill.el: see erc.el changelog
-
- * erc.el:
- * erc-insert-hook: Changed strategy completely, no start end parameters any more.
- We narrow-to-region now, that's much cleaner.
- * rename erc-fill-region to erc-fill and change the autoload
- ** You'll probably need to restart Emacs
-
-2001-12-04 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-send-current-line): Fixed long outstanding bug. XEmacs users with erc-fill-region on erc-insert-hook knew that one a long time.
-
- * erc.el: fix order of attack
-
- * erc.el: * macroexpanded define-minor-mode for XEmacs
-
- * erc.el: First try to make channel tracking mouse sensitive
-
- * erc.el: * More erc-message-format conversion.
- erc-format-message-english-PART as an example on how to use functions to format message
- * (erc-format-message): Fallback mechanism to use english catalog if variable is not bound
-
-2001-12-03 Mario Lang <mlang@delysid.org>
-
- * erc.el: * (erc-iswitchb): Rewrite, docfix.
- Make it use erc-modified-channels as default if available.
-
- * erc-menu.el:
- * Fixage related to erc-track-modified-channels-minor-mode rewrite
-
- * erc.el:
- * (erc-track-modified-channels-minor-mode): Use buffer objects instead of erc-default-target return value for internal state keeping.
-
- * erc.el: * Made reconnect behave nicer (erc-process-sentinel)
- * Rewrote erc-modified-channels-tracking completely.
- Its now a minor mode (erc-track-modified-channels-minor-mode)
- It uses a list as internal representation now, so all silly string-parsing
- related bugs should be gone.
- Use (erc-track-modified-channels-minor-mode t) now to toggle this functionality.
- Don't set the erc-track-modified-channels-minor-mode variable yourself, use the toggle function
-
-2001-11-29 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: final version
-
-2001-11-29 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-channel-p): Make it work with string and buffer as parameter. buffer.
- * (erc-format-message): Add a check for functionp. This allows a format-specifier also to be a function name, which gets called with args applied and needs to return the actual format string.
- * Converted some formats, JOIN, JOIN-you, MODE, ...
-
-2001-11-28 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-prepare-mode-line-format): Added sanity checks to prevent it from having problems with server buffers where the connection failed
-
- * erc-bbdb.el:
- * (erc-bbdb-JOIN): regexp-quote the fingerhost before searching, some people have really strange characters as their user names
-
- * erc.el: Remove a stupid debug like (message ...) call
-
-2001-11-28 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: draft of 2.1.cvs.20011128-1
-
- * debian/rules: simplify for the all-in-one erc package
-
- * debian/control: integrated erc-speak back into erc
-
- * debian/maint/conffiles, debian/maint/conffiles.in, debian/maint/postinst,
- debian/maint/postinst.in, debian/maint/prerm, debian/maint/prerm.in,
- debian/scripts/install, debian/scripts/install.in, debian/scripts/remove,
- debian/scripts/remove.in, debian/scripts/startup.erc-speak:
- since erc-speak is gone, resurrect the static files, and update them to support the latest erc
-
-2001-11-28 Mario Lang <mlang@delysid.org>
-
- * erc.el: * (erc-mode): Shouldn't be interactive.
- * (erc-info-mode): Ditto.
-
- * erc.el: * (erc-server-352): Added hopcount parsing.
- Added call to erc-update-channel-member to fill in channel-members information
- on /WHO if the channel is joined.
-
-2001-11-27 Mario Lang <mlang@delysid.org>
-
- * erc-speedbar.el: *** empty log message ***
-
- * erc-speedbar.el: * (erc-speedbar-expand-user): New function.
- Used when more information than just the nick name is available about a dude.
-
- * erc.el: * Fixed stupid edit,checkin,save cycle error :)
-
- * erc.el:
- * (erc-generate-log-file-name-default): Renamed to -long
- Doc fix.
- * (erc-generate-log-file-name-old): Renamed to -long
- Doc fix.
- * (erc-generate-log-file-name-function): Set default to ...-long
- Doc fixes
-
- * erc-speedbar.el: *** empty log message ***
-
-2001-11-26 Mario Lang <mlang@delysid.org>
-
- * erc-speedbar.el: * Integrated channel names list
- what else do we need to replace info buffers???
- please test that code and comment on erc-ehlp, thanks
-
- * erc-speedbar.el:
- * Added erc-speedbar-goto-buffer and therefore enable switching to the buffers from speedbar
-
- * erc-speedbar.el:
- I had to check this in, it works !! sort of,, megaalphagammaversion, first version. test, play, submit ideas/patches
-
-2001-11-26 Gergely Nagy <algernon@debian.org>
-
- * erc.el(erc-mode): moved erc-last-saved-position here
- moved buffer naming code from here..
- (erc): ...to here
- (erc-generate-log-file-name-old): only prepend target if it exists
-
- made erc-log-insert-log-on-open a defcustom
-
-2001-11-26 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Applied antifuchs/mhp patches, the latest on erc-help, unmodified
- * New variable: erc-reuse-buffers default to t.
- * Modified erc-generate-new-buffer-name to use it. it checks if server and port are the same,
- then one can assume that's the same channel/query target again.
-
-2001-11-23 Mario Lang <mlang@delysid.org>
-
- * erc-bbdb.el:
- * new function erc-BBDB-NICK to handle nickname annotation on a nick-change event of a known record
-
- * erc.el: * Remove erc-rename-buffer, its no longer necessary
- * Remove erc-autoop-*. it was broken, and needed rewrite anyway
- * write erc-already-logged-in in terms of erc-buffer-list and make the duplicate login check work again
-
- * erc.el: * Fixed stupid typo
-
-2001-11-22 Mario Lang <mlang@delysid.org>
-
- * erc.el: * New local variable, erc-announced-server-name
- * erc-mode-line-format supports a new symbol, target-and/or-server
- * The mode-line displays the announced server name now (for autojoin later...,
- greets Adam)
- * New macro, erc-server-hook-list for a nice way to define the defcustoms of the erc-server-*-hook's
- Thanks go to the guy from #emacs who helped with that
- * erc-fill-region is now autoloaded from erc-fill.el
- * erc-fill.el implements a new fill method, erc-fill-static
- (setq erc-fill-function 'erc-fill-static)
- * Some other things I forgot right now
-
- * erc-bbdb.el: *** empty log message ***
-
- * erc-fill.el: Initial version.
-
- * erc-complete.el:
- Applied antifuchs patch to make completion work with (string= erc-prompt "")
-
- * erc-complete.el:
- added function erc-nick-completion-exclude-myself
- you can set erc-nick-completion to 'erc-nick-completion-exclude-myself to use it
-
-2001-11-21 Mario Lang <mlang@delysid.org>
-
- * erc-bbdb.el:
- * Changed usage of 'finger-host to bbdb-finger-host-field
-
- * erc-bbdb.el:
- * Changed WHOIS to use finger-host instead of net field.
- * Added 'visible as option to erc-bbdb-popup-p to only pop-up the bbdb buffer if a join happened in a visible buffer on any visible frame.
- * Added (regexp-quote ...) for nickname search in erc-bbdb-JOIN
-
-2001-11-20 Mario Lang <mlang@delysid.org>
-
- * erc-bbdb.el: * Added JOIN support
-
-2001-11-19 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Initial message catalog code. converted erc-action-format usage to use it
-
- * erc.el: * erc-play-sound: Added XEmacs related check
-
- * erc-bbdb.el: * Initial version, many thanks to Andreas Fuchs
-
- * erc.el: * Fixed silly problem with whois/was handling
-
- * erc.el: * Renamed prev-rd to erc-previous-read
- * Removed erc-next-line-add-newlines and s next-line-add-newlines to nil in defun erc by default
-
- * erc.el:
- fixed xemacs compatibility prob with delete, thanks Adam
-
-2001-11-18 Mario Lang <mlang@delysid.org>
-
- * erc.el: numreplies 301 & 461
-
-2001-11-13 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el:
- Added code for error reply 421 "Unknown command", to test the new server parsing system.
- This was really easy! Thanks ZenIRC guys & delysid :-)
-
-2001-11-13 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Allow connecting to SSL enabled irc servers.
- Ugly hack, but it works for now. Be sure to use the numeric irc port 994 so that erc can recognize what you want
- good example is
- irc server: ircs.segfault.net
- port: 994
-
- meet me there, I am still delYsid :)
-
- * erc.el: * some more numreply handlers
- * cleanup in erc-process-away-p
- * new function erc-display-error-notice
-
- * erc.el: * numreply 501 and 221
-
- * erc.el:
- removed obsolete old hook variables. Your functions may break, but it is easy to hook them up to the new hooks.
- erc-part-hook: use erc-server-PART-hook instead
- erc-kick-hook: use erc-server-KICK-hook instead
- and so on
-
- * erc.el:
- fixed serious bug which cause privmsgs vanishing when erc-auto-query was set to nil
-
- * erc.el: cleaned up erc-process-filter
-
- * erc.el: * 401 and 320 numreplies implemented
-
- * erc.el: * Removed old/now obsolete code
-
- * erc.el: * Fixed bug in erc-server-MODE
-
-2001-11-12 Mario Lang <mlang@delysid.org>
-
- * erc.el: fixed it
-
- * erc.el:
- *** We switched over. New server message parsing/handling is running now. Thanks to the zenirc developers for the great ideas I got from the code!!!!! Go and test it, poke at it, bug me on irc about problems
-
- * erc.el: *** empty log message ***
-
-2001-11-12 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el:
- Fixed bug in erc-get-buffer, now channel names are compared in
- a case-insensitive way.
-
-2001-11-12 Mario Lang <mlang@delysid.org>
-
- * erc.el: erc-server-353
-
-2001-11-12 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el: Fixed docstring for erc-get-buffer.
- Added erc-process to a lot of calls to erc-get-buffer, so
- that only the local process is searched.
-
-2001-11-12 Mario Lang <mlang@delysid.org>
-
- * erc.el: * erc-buffer-filter: do it differently
-
- * erc.el: ugly but working fix for mhp's query problem
-
- * erc.el: * erc-server-PRIVMSG-or-NOTICE
- Now, all the server word replies are finished. Going to numreplies now
-
- * erc.el:
- * debugging facilities for the transition. C-x 2 C-x o M-x ielm RET erc-server-vectors RET ; to get a list of all server messages currently not handled in the new code. Feel free to pick one and implement it
-
- * erc.el: * erc-server-KICK and erc-server-TOPIC. new functions
- * erc-server-305-or-306 and erc-server-311-or-314
-
- * erc.el:
- * ported PART and QUIT msgs to the new scheme, many to go. but it is a easy task. does someone wanna try and start with numreplies?
-
- * erc.el: * erc-server-JOIN
-
- * erc.el: * Ported erc-server-INVITE code
-
- * erc.el: * erc-server-ERROR and erc-server-MODE
-
-2001-11-11 Mario Lang <mlang@delysid.org>
-
- * erc.el: * zen
-
- * erc.el: * New variable erc-connect-function.
-
- * erc.el:
- * New function erc-channel-p and use it where appropriate
-
- * erc.el: * Removed the variable erc-buffer-list completely now
- * Moved erc-dbuf around a bit
-
- * erc.el: * Fix silly change in quit/rename msg handling
-
- * erc.el: thanks mhp, fixed
-
- * erc.el: * Tijs van Bakel's work from 10th Nov. merged in
- * My additions to that idea merged in too
- Basically, this is a major rewrite, if you are scared and want avoid problems,
- stay at your current version. It seems fairly stable though.
- That changed? erc-buffer-name handling was completely rewritten,
- and erc-buffer-list local variable handling removed.
- Simplifies alot of code. Poke at it. read the diff. report bug/send patches!
-
- * erc.el: * Added variable listing when /set is used without args
-
-2001-11-10 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Comment/structure cleanup, removal of unnecessary code
-
- * erc.el: only some code beautification
-
- * erc-imenu.el:
- remove add-hook call, that's done in erc.el now for autoloadability
-
- * erc.el: * Make erc-imenu autoloadable
-
- * erc.el:
- * The long promised erc-mode-line-format handling rewrite
- Poke at it, try it, play with it, report bugs
-
- * erc.el:
- some regex-quote fixes, new function erc-cmd-set, and minor things
-
-2001-11-08 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * added second timestamp-format (erc-away-timestamp-format) for marking msgs when being away
-
- * erc-complete.el: fixed silly defun
-
- * erc.el: * Rewrote erc-load-irc-script (simplified)
- * Removed deprecated code
-
- * erc-speak.el: * reflect changes in erc.el
-
- * erc.el:
- * Moved completion related functions into erc-complete.el
- placed an autoload instead into erc.el. That quite cool,
- because erc-complete.el only gets loaded when you use
- TAB first time in erc.
-
- * erc-complete.el: _ Initial checkin
-
- * erc.el: * New function: erc-chain-hook-with-args
- * Changed calls to erc-insert-hook to use it
-
-2001-11-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Patch from Fabien Penso
- Make completion case insensitive. try it! its cool
-
- * erc.el: * Reduction patch 2
- This time, we move the input ring handling into erc-ring.el
- Remember that you need (require 'erc-ring) in your .emacs to get the input handling as a feature
- And remember, that you don't need it if you don't use input ring :-)
-
- * erc-ring.el: * Initial checkin
-
- * erc.el: * The great reduction patch :-)
- moved relevant function from erc.el to new file erc-menu.el and erc-imenu.el
-
- * erc-imenu.el: Initial version
-
- * erc-menu.el: * Initial version
-
- * erc.el: * wording change suggested by Benjamin Drieu
-
-2001-11-07 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el: Added Emacs version to /SV
-
-2001-11-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Hookification patch, read the diff
-
- * erc.el: too tired for a changelog :)
-
-2001-11-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * make erc-cmd-op and erc-cmd-deop take multiple nicknames as argument
-
-2001-11-06 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: sync
-
- * debian/rules: fixed a typo: PKGDIR, not PKIDR
-
-2001-11-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Changed timestamping when away to use erc-timestamp-format and append the timestamp instead of prepending it..
- * minor cleanup, s/(if (not /(unless/ and the like
-
-2001-11-06 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el: Fixed OP and DEOP commands to return T.
- Added SV say-version command.
- Added erc-send-message utility function, but it's not used everywhere yet.
-
-2001-11-05 Mario Lang <mlang@delysid.org>
-
- * erc.el: stupid delYsid, forgot require 'format-spec. good nite
-
- * erc.el:
- * new variable erc-action-format. Some erc-notice-prefix fixes again
-
- * erc.el: * erc-minibuffer-privmsg defaults to t
-
- * erc.el:
- * Small fix in relation to the transition to erc-make-notice
-
-2001-11-05 Tijs van Bakel <smoke@wanadoo.nl>
-
- * erc.el:
- Renamed erc-message-notices to erc-minibuffer-notice, and renamed erc-prevent-minibuffer-privmsg to erc-minibuffer-privmsg, inverting its functionality
-
- * erc.el: Added support for channel names starting with & + and !.
- Also, many changes partially discussed on the mailing list:
-
- * erc.el (cl): Add requirement for cl package.
- (erc-buffer-list): Make this variable global again.
- (erc-default-face): Fix typo.
- (erc-timestamp-face): Add face for timestamps.
- (erc-join-buffer, erc): Add a 'bury option.
- (erc-send-action): Add timestamp.
- (erc-command-table): Add /CLEAR, /DEOP, /OP, /Q.
- (erc-send-current-line): Add timestamp.
- (erc-send-current-line): Add call to erc-insert-hook.
- (erc-cmd-clear): New command to clear buffer contents.
- (erc-cmd-whois): Fix cut'n'paste-o.
- (erc-cmd-deop): New command to deop a user.
- (erc-cmd-op): New command to op a user.
- (erc-make-notice): Moved a lot of duplicate code here. Perhaps
- this should also be done for erc-highlight-error.
- (erc-parse-line-from-server): Now NOTICE will also open a new
- query, just as PRIVMSG.
- (erc-parse-line-from-server): Call erc-put-text-property on a
- channel message/notice first, before concatenating nick and
- timestamp &c.
- (erc-message-notices): Add option to display notices in
- minibuffer.
- (erc-fill-region): No longer strip spaces in front of incoming
- messages.
- (erc-parse-current-line): No longer strip spaces in front of text
- input by user.
-
- Hopefully I didn't break too much :(
-
-2001-11-05 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * New function erc-nickserv-identify-autodetect for erc-insert-hook. Added by default currently.
-
- * erc.el:
- * Mini-fix in erc-process-num-reply (= n 353): Added @ as prefix character to make certain channels on opn work again nicely
-
-2001-10-31 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: updated to reflect changes
-
- * debian/scripts/install.in:
- moved #PKGFLAG# before -f batch-byte-compile
-
-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
-
-2001-10-26 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: sigh. -2
-
-2001-10-25 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: updated to reflect changes
-
- * debian/rules: handle conffiles.in too
-
- * debian/maint/conffiles.in: new file
-
- * debian/maint/conffiles: superseded by conffiles.in
-
- * debian/scripts/startup: superseded by startup.erc
-
-2001-10-25 Mario Lang <mlang@delysid.org>
-
- * debian/scripts/startup.erc-speak: * Initial version
-
- * debian/scripts/startup.erc: * Added and fixes minimal typo
-
-2001-10-25 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: updated to reflect changes
-
- * debian/rules:
- modified to be able to build the erc-speak package too
-
- * debian/control: added the new erc-speak package
-
- * debian/README.erc-speak, debian/maint/postinst.in, debian/maint/prerm.in,
- debian/scripts/install.in, debian/scripts/remove.in:
- new file
-
- * debian/maint/postinst, debian/maint/prerm, debian/scripts/install,
- debian/scripts/remove:
- removed, superseded by its .in counterpart
-
-2001-10-25 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Fixed some defcustom :type 's
- * Added erc-before-connect hook which gets called with server port and nick.
- Use this hook to e.g. setup a tunnel before actually connecting.
- something like (when (string= server "localhost") ...)
-
-2001-10-24 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Patch by smoke: fix erc-cmd-* commands and add aliases
-
-2001-10-23 Mario Lang <mlang@delysid.org>
-
- * erc-speak.el:
- * Added a new personality for channel name announcement, This makes streams of flooded channels much easier to listen to,
- especially if you are on more than one channel simultaneously.
-
- * erc.el:
- * Made the completion postfix customizable through erc-nick-completion-postfix
-
- * erc-speak.el, erc.el:
- * Added erc-prevent-minibuffer-privmsg
-
- * erc-speak.el:
- * Quickish hack to allow exclusion of timestamps from speaking. see erc-speak-filter-timestamps
-
-2001-10-21 Mario Lang <mlang@delysid.org>
-
- * erc-speak.el:
- * Removed now really obsolete code. Package size reduced by 50%
-
- * 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!!!
-
- * erc-speak.el: *** empty log message ***
-
- * erc-speak.el: * Major simplification. depends on my 2001-10-21 changes to erc.el.
- * Things removed, read diff
-
-2001-10-21 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: oops, silly typo
-
- * debian/changelog, debian/control, debian/copyright,
- debian/maint/conffiles, debian/maint/postinst, debian/maint/prerm,
- debian/rules, debian/scripts/install, debian/scripts/remove,
- debian/scripts/startup:
- initial check-in
-
-2001-10-21 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Changed erc-insert-hook to get two arguments, START and END of the region
- which got inserted. CAREFUL! This could break stuff, but it makes the hook
- much more usable.
-
- * erc.el:
- * Made erc-smiley a new option, currently set to t to showoff this feature. :)
-
-2001-10-20 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Add missing erc-mode-hook variable
- * Add smiley-support (preliminary test)
-
-2001-10-20 Alex Schroeder <alex@gnu.org>
-
- * erc.el:
- Replaced all occurrences of put-text-property with a call to
- erc-put-text-property.
- (erc-put-text-property): New function.
- (erc-tracking-modified-channels): Moved to the front of the file such
- that it is already defined when the menu is being defined.
- (erc-modified-channel-string): Ditto.
-
-2001-10-18 Alex Schroeder <alex@gnu.org>
-
- * erc.el: Removed some commentary. The wiki page is the place to
- put such information.
- (erc-fill-prefix): Doc change.
- (erc-notice-highlight-type): Doc change, now a user option.
- (erc-pal-highlight-type): Doc change, now a user option.
- (erc-fool-highlight-type): New option.
- (erc-keyword-highlight-type): New option.
- (erc-dangerous-host-highlight-type): New option.
- (erc-uncontrol-input-line): Doc change.
- (erc-interpret-controls-p): Doc change, now a user option.
- (erc-multiline-input): Doc change.
- (erc-auto-discard-away): Doc change.
- (erc-pals): Changed from string to regexp.
- (erc-fools): New option.
- (erc-keywords): Renamed from erc-highlight-strings. WATCH OUT:
- Not backwards compatible change!
- (erc-dangerous-hosts): Renamed from erc-host-danger-highlight.
- WATCH OUT: Not backwards compatible change!
- (erc-menu-definition): Added menu entries for fools, keywords and
- dangerous hosts.
- (erc-mode-map): Changed keybindings from C-c <plain ascii> to
- various C-c <C-ascii> combinations.
- (erc-dangerous-host-face): Renamed from erc-host-danger-face.
- WATCH OUT: Not backwards compatible change!
- (erc-fool-face): New face.
- (erc-keyword-face): Renamed from erc-highlight-face. WATCH OUT:
- Not backwards compatible change!
- (erc-parse-line-from-server): Fixed highlighting in the cases
- where (equal erc-pal-highlight-type 'all), added code to handle
- erc-fool-highlight-type, erc-dangerous-host-highlight-type
- (erc-update-modes): Replaced erc-delete-string with delete.
- (erc-keywords): Renamed from erc-highlight-strings, handle
- erc-keyword-highlight-type.
- (erc-delete-string): Removed.
- (erc-list-match): New function.
- (erc-pal-p): Use erc-list-match.
- (erc-fool-p): New function.
- (erc-keyword-p): New function.
- (erc-dangerous-host-p): Renamed from erc-host-danger-p, use
- erc-list-match.
- (erc-directed-at-fool-p): New function.
- (erc-add-entry-to-list): New function.
- (erc-remove-entry-from-list): New function.
- (erc-add-pal): Use erc-add-entry-to-list.
- (erc-delete-pal): Use erc-remove-entry-from-list.
- (erc-add-fool): New function.
- (erc-delete-fool): New function.
- (erc-add-keyword): New function.
- (erc-delete-keyword): New function.
- (erc-add-dangerous-host): New function.
- (erc-delete-dangerous-host): New function.
-
-2001-10-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: * irc vs ircd default port fixed
-
- * erc.el: * Added topic-change to imenu
-
- * erc.el: * More imenu spiffyness
-
- * erc.el: * Added imenu support
-
- * erc.el:
- * Fix to /topic to show topic instead of setting it to null :)
-
-2001-10-05 Mario Lang <mlang@delysid.org>
-
- * erc.el: * First version of erc-rename-buffer
-
- * erc.el: * more header-line tricks.
-
- * erc.el:
- * Small fix to do erc-update-mode-line-buffer in erc-update-channel-topic
-
- * erc.el: * Added erc-header-line-format
-
-2001-10-04 Mario Lang <mlang@delysid.org>
-
- * erc.el: * mini-fix, add msgp to auto-query code
-
- * erc.el: * Added command-names to completion (erc-command-table)
- * New variable erc-auto-query. When set, every arriving message to you
- will open a query buffer for that sender if not already open.
- * Compatibility function fo non-existing line-beginning|end-position functions in XEmacs.
-
-2001-10-03 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Removed alot of (progn ...) where they were not necessary
- * Changed some (if ...) without else part to (when ...)
- * Some (while ...) to use (dolist ...)
- * Fix for completion popup generating tracebacks.
- * New function erc-arrange-session-in-multiple-windows
- * Lots of other stuff, read the diff
-
-2001-10-02 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Added erc-kill-input and keybinding C-c C-u for it
-
-2001-10-01 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Another fix to nick-completion
- * Additional checks in erc-track-modified-channels
-
-2001-09-26 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Fixed completion (alex)
- * Now popup buffer doesn't destroy your window configuration.
- * Fixed away handling (incomplete)
-
-2001-09-24 Mario Lang <mlang@delysid.org>
-
- * erc.el: Fixed silly quoting-escape error
-
-2001-09-23 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Added auto-op support (unfinished)
- * Added erc-latest-version.
- * Added erc-ediff-latest-version.
-
-2001-09-21 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Minor menu additions (invite only mode is now a checkbox)
-
-2001-09-20 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Fix (erc-cmd-names): This should fix C-c C-n too, hopefully it was the right fix and doesn't break anything else.
-
- * erc.el: * Fixes XEmacs easymenu usage (2nd time).
-
-2001-09-19 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-complete-nick): Add ": " only if one completes directly after the erc-prompt, otherwise, add just one space
-
- * erc.el:
- * Changed menu-definition to use easymenu (hopefully this now works under XEmacs)
- * Fix for custom problem with :must-match on XEmacs (thanks shapr)
- * Added /COUNTRY command using (what-domain) from package mail-extr (shapr)
- * Fix for case-sensitivity problem with pals (they are now all downcased)
- * Different (erc-version) function which now can take prefix argument to insert the version information into the current buffer,
- instead of just displaying it in the minibuffer.
-
-2001-09-10 Mario Lang <mlang@delysid.org>
-
- * erc.el: Updated erc-version-string
-
- * erc.el: Version number change and last read-through...
-
-2001-09-04 Mario Lang <mlang@delysid.org>
-
- * erc.el: Added some asterisks
-
-2001-08-24 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fixed hidden channel buffer tracking (sort of), now using switch-to-buffer for advice.
- This version is unofficially named 2.1prebeta1. Please test it and send
- fixes to various problems you may encounter so that we can eventually
- release 2.1 soon.
-
-2001-08-14 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Added function erc-bol and keybinding C-c C-a for it (contributed by Benjamin Rutt <brutt@bloomington.in.us)
-
-2001-08-07 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Checked in lathis code and modified it slightly. Still unsure about set-window-buffer advice, current attempt doesn't seem to work.
- Removed (nick -> #channel) from mode-line. (CLOSED) and (AWAY...) should still be displayed when appropriate
-
-2001-08-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- added local-variable channel-list in session-buffers and make /LIST use it.
- erc-join-channel can now do completion after /LIST was executed
-
-2001-08-05 Mario Lang <mlang@delysid.org>
-
- * erc.el: Tweaked erc-join-channel and erc-part-from-channel
-
-2001-07-27 Mario Lang <mlang@delysid.org>
-
- * erc.el: some more defcustom stuff
-
- * erc.el: Patch from Henrik Enberg <henrik@enberg.org>:
- Adds variables erc-frame-alist and erc-frame-dedicated-p.
-
- * erc.el: fixed erc-part-from-channel
-
- * erc.el:
- fixed match-string problem and added interactive topic setting function.
-
- * erc.el: fixed silly string-match bug
-
- * erc.el:
- Added erc-join-channel and erc-part-from-channel (interactive prompts), as well as keybindings. C-c C-j #emacs RET is now enough :)
-
-2001-07-27 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-display-line-buffer): Simplified filling.
- (erc-fill-region): New function.
-
-2001-07-27 Mario Lang <mlang@delysid.org>
-
- * erc.el: Added redundancy check in output
-
-2001-07-26 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-send-action): Add text-property stuff.
- (erc-input-action): Removed text-property stuff.
- (erc-command-table): Corrected command for DESCRIBE. Still
- doesn't work though. No idea what it should do. Looks like a no op.
- (erc-cmd-me): Doc change.
-
-2001-07-26 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- fixed one occurrence of a setq with only one argument (XEmacs didn't like that)
-
- * erc.el:
- Added erc-next-line-add-newlines customization possibility.
-
- * erc.el:
- added erc-fill-prefix for defining your own way of filling and fixed filling somehow
-
- * erc.el:
- fixed small incompatibility in erc-parse-line-from-server at (and (= n 353) regexp
-
-2001-07-25 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Added erc-filling and filling code to erc-display-line-buffer.
-
-2001-07-08 Alex Schroeder <alex@gnu.org>
-
- * erc.el(try-complete-erc-nick): Make the ": " part of the
- expansion
-
- * erc.el: require ring
-
-2001-07-08 Mario Lang <mlang@delysid.org>
-
- * erc.el: *** empty log message ***
-
-2001-07-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: typo
-
- * erc.el: omit
-
-2001-07-06 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-mode): Call erc-input-ring-setup.
- (erc-send-current-line): Call erc-add-to-input-ring.
- (erc-input-ring): New variable. Currently not buffer local.
- (erc-input-ring-index): New variable. Currently not buffer local.
- (erc-input-ring-setup): New function.
- (erc-add-to-input-ring): New function.
- (erc-previous-command): New function.
- (erc-next-command): New function.
- (erc-mode-map): Uncommented keybindings for erc-next-command and
- erc-previous-command.
-
-2001-07-05 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-highlight-strings): Removed debug message.
-
- * erc.el(erc-join-buffer): Changed default to 'buffer.
- (erc-join-info-buffer): Changed default to 'disable.
- (erc-nick-completion): Changed default to 'all.
-
-2001-07-04 uid31117 <uid31117@confusibombus>
-
- * erc.el: Resolved...
-
-2001-07-03 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-highlight-strings): New option and new function.
- (erc-parse-line-from-server): Use it.
- Various empty lines removed. Various doc strings fixed.
-
- * erc.el: Removed more empty lines.
-
- * erc.el(erc-member-string): replaced by plain member
- Otherwise, lots of deleting of empty lines... I'm not too happy with that
- but I feel better when the code is "cleaned up".
-
-2001-07-03 Mario Lang <mlang@delysid.org>
-
- * erc.el: Ugly hack, but looks nicer when giving commands
-
- * erc-speak.el: ugly hack, but looks nicer now
-
-2001-07-03 Alex Schroeder <alex@gnu.org>
-
- * erc.el(try-complete-erc-nick): New function.
- (erc-try-complete-nick): New function.
- (erc-nick-completion): New option.
- (erc-complete): Call hippie-expand such that erc-try-complete-nick
- will be called eventually. Based on erc-nick-completion
- try-complete-erc-nick will then complete on the nick at point.
-
-2001-07-02 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Insert (erc-current-nick) instead of (erc-display-prompt). good night :)
-
- * erc.el:
- small, but it was annoying, so I just did it (defcustom for erc-join-buffer and erc-join-info-buffer)
-
-2001-06-29 Alex Schroeder <alex@gnu.org>
-
- * erc.el: Use defface to define all faces.
- Removed some history from the commentary, as well as some other
- commentary editing.
-
-2001-06-28 Mario Lang <mlang@delysid.org>
-
- * erc.el: hmm, defcustom for erc-user-full-name
-
- * erc-speak.el, erc.el: *** empty log message ***
-
-2001-06-27 Mario Lang <mlang@delysid.org>
-
- * erc.el: typo
-
- * erc.el: Some more defcustom
-
- * erc-speak.el: nothing, really
-
-2001-06-26 Mario Lang <mlang@delysid.org>
-
- * erc.el: Some defcustom stuff. Still no defgroup though :)
-
- * erc.el:
- Initial change to erc.el (2.0). Mainly list of ideas and features
- and syntax-table entries.
-
- * erc-speak.el, erc.el: Initial Import
-
- * erc-speak.el, erc.el: New file.
-
- Copyright (C) 2001, 2006-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
diff --git a/lisp/erc/ChangeLog.02 b/lisp/erc/ChangeLog.02
deleted file mode 100644
index ae70a1b6a4f..00000000000
--- a/lisp/erc/ChangeLog.02
+++ /dev/null
@@ -1,2618 +0,0 @@
-2002-12-31 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-split-command):
- Removed assignment to free variable "continue".
- (erc-strip-controls): New function. Takes a string, returns the string with
- all IRC color/bold/underline/etc. control codes stripped out.
- (erc-interpret-controls): If variable erc-interpret-controls-p is nil, now
- uses erc-strip-controls to strip control codes.
- (erc-ctcp-reply-ECHO): Changed reference and assignment to free variable "s"
- into reference/assignment to "msg", which appears to be the original author's
- intent.
-
- * erc-list.el(erc-chanlist):
- Changed to use the new erc-once-with-server-event function
- instead of the old macro of the same name.
-
- * erc-notify.el(erc-notify-timer):
- Changed to use the new erc-once-with-server-event function
- instead of the old macro of the same name. Also fixed a bug were variable
- erc-last-ison was being read from a non-server buffer (thus giving its default
- value instead of its per-server value).
-
- * erc.el(erc-once-with-server-event):
- This is now a function. It was a macro with a
- bug (the call to gensym happened at byte-compile-time not macro-call-time).
- (erc-toggle-debug-irc-protocol): Now [return] is bound to this function in
- the *erc-protocol* buffer.
-
-2002-12-30 Alex Schroeder <alex@gnu.org>
-
- * erc-autoaway.el(erc-autoaway-idletimer): Doc,
- ref. erc-autoaway-use-emacs-idle.
- (autoaway): Doc, explain different idle definitions. Reestablish
- the idletimer only when erc-autoaway-use-emacs-idle is non-nil.
- (erc-auto-set-away): Doc, ref erc-auto-discard-away.
- (erc-auto-discard-away): Doc, ref erc-auto-set-away.
- (erc-autoaway-use-emacs-idle): Doc, ref erc-autoaway-mode, and
- added a note that this feature is currently broken.
- (erc-autoaway-reestablish-idletimer): Doc.
- (erc-autoaway-possibly-set-away): Split test such that
- erc-time-diff is only computed when necessary, add a comment why
- erc-process-alive is not necessary.
- (erc-autoaway-set-away): Test for erc-process-alive.
-
-2002-12-29 Alex Schroeder <alex@gnu.org>
-
- * erc-autoaway.el:
- Changed the order of defcustoms to avoid errors in the :set property
- of erc-autoaway-idle-seconds.
-
-2002-12-29 Damien Elmes <erc@repose.cx>
-
- * erc-track.el:
- * (erc-track-get-active-buffer): remove superfluous (+ arg 0)
-
-2002-12-29 Alex Schroeder <alex@gnu.org>
-
- * erc-autoaway.el(erc-autoaway): Moved the defgroup up to the
- top, before the define-erc-module call.
- (autoaway): Extended doc.
- (erc-autoaway-idle-seconds): Use a :set property to handle
- erc-autoaway-use-emacs-idle.
- (erc-auto-set-away): Set default to t. Added doc strings where
- necessary, reformatted doc strings such that the first line can
- stand on its own. This is important for the output of M-x
- apropos.
-
-2002-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-auto.in:
- added (provide 'erc-auto), which is required for (require 'erc-auto) :)
-
- * erc.el(erc-display-prompt):
- Set the face property of the prompt to
- everything but the last character.
-
- * erc.el(erc-send-current-line):
- Check whether point is in the input line. If
- not, just beep and do nothing.
-
-2002-12-28 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-bol):
- Fixed bug when there is only a prompt, and no property
- change.
-
- * erc.el(erc-display-prompt): Rewrote using a save-excursion
- and erc-propertize. No longer use a field for the prompt, but a
- plain text property called erc-prompt.
- (erc-bol): Use the erc-prompt text property instead of a field.
- Return point instead of t.
- (erc-parse-current-line): No need to call point here, then, since
- erc-bol now returns point.
-
- * Makefile:
- make ChangeLog .PHONY, thus forcing it always to be rebuilt.
-
-2002-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-log-irc-protocol):
- Removed check whether get-buffer-create
- returned nil. "The value is never nil", says the docstring.
-
- * erc.el: Day Of The Small Changes
-
- (erc-display-prompt): Make the prompt 'front-sticky, which prevents it
- from being modified. It *should* also make end-of-line move to the
- end of the field (i.e. the end of the prompt) when point is at the
- beginning of the prompt, but it doesn't. Dunno why. :(
-
-2002-12-27 Francis Litterio <franl@users.sourceforge.net>
-
- * Makefile:
- Added "-f" to "rm" command in rule for target "realclean".
-
- * erc.el:
- New function: erc-log-irc-protocol. Consolidates nearly duplicate code
- from functions erc-send-command and erc-process-filter into one function.
-
- * erc.el(erc-toggle-debug-irc-protocol):
- Removed unneeded argument PREFIX and code
- which referenced it at end of function.
- (erc-send-command): Now we only append a newline to the logged copy
- of output protocol text if it doesn't have one.
-
-2002-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-toggle-debug-irc-protocol):
- Display buffer if it's not shown
- already, and use view-mode.
- (erc-toggle-debug-irc-protocol), (erc-send-command),
- (erc-process-filter): inhibit-only t to insert into the
- *erc-protocol* buffer (view-mode)
-
-2002-12-27 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-mode-map):
- Removed keybinding for erc-toggle-debug-irc-protocol.
- (erc-toggle-debug-irc-protocol): Now used erc-make-notice to propertize the
- face of the enabled/disabled messages in the *erc-protocol* buffer.
- (erc-send-command): Now outgoing IRC protocol traffic is logged too.
-
- * erc.el:
- Added user-customizable variable erc-debug-irc-protocol.
- Added function erc-toggle-debug-irc-protocol.
- (erc-process-filter): Now supports IRC protocol logging. If variable
- erc-debug-irc-protocol is non-nil, all IRC protocol traffic is appended
- to buffer *erc-protocol*, which is created if necessary.
-
-2002-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-display-prompt):
- Don't make the prompt intangible; that didn't
- make things that much better for the user, but confused ispell,
- which checked the prompt when it should check the first word
-
-2002-12-27 Alex Schroeder <alex@gnu.org>
-
- * AUTHORS: fixed resolve's email add
-
- * AUTHORS: added damien
-
- * erc.el(erc-truncate-buffer-on-save):
- Removed documentation that
- described behavior now changed. It used to say "When nil, no
- buffer is ever truncated." This is no longer true; even when
- buffers are NOT truncated on save, they can be truncated, eg. by
- adding erc-truncate-buffer to the hook.
- (erc-logging-enabled): New function.
- (erc-current-logfile): New function.
- (erc): Use erc-logging-enabled and erc-current-logfile.
- (erc-truncate-buffer-to-size): Rewrote it, and made sure to use a
- (save-restriction (widen) ...) such that the truncation actually
- runs in the whole buffer, not in the last message only (as
- erc-insert-post-hook will do!). This should fix rw's
- out-of-bounds error.
- (erc-generate-log-file-name-short): Made all but the BUFFER
- argument optional. Doc: Mention
- erc-generate-log-file-name-function.
- (erc-generate-log-file-name-long): Doc: Mention
- erc-generate-log-file-name-function.
- (erc-save-buffer-in-logs): Use erc-logging-enabled and
- erc-current-logfile. Doc: Mention erc-logging-enabled.
-
- (erc-encode-string-for-target): Only do the real work when
- featurep mule; else just return the string unchanged.
-
-2002-12-27 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- erc-encoding-default: check for (coding-system-p) for older emacs versions
-
- * erc.el(erc-connect): missing ()s added. "don't commit at 2am"
-
- * erc.el(erc-connect):
- check if (set-process-coding-system) is available before use
-
-2002-12-27 Alex Schroeder <alex@gnu.org>
-
- * AUTHORS: added franl
-
-2002-12-26 Alex Schroeder <alex@gnu.org>
-
- * erc-pcomplete.el(pcomplete-parse-erc-arguments):
- Reworked, and fixed a bug that had
- caused completions to corrupt preceding text under some circumstances.
-
- * erc.el(erc-encoding-default): New.
- (erc-encode-string-for-target): Use it instead of a hard-coded ctext.
- (erc-encoding-coding-alist): Doc.
-
-2002-12-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- Removed fix for bug 658552 recently checked-in, because it doesn't work.
-
- * erc.el(erc-kill-buffer-function):
- Removed check that connection is up
- before running erc-kill-server-hook hooks. Those hooks should use
- erc-process-alive to avoid interacting with the process.
-
- * erc.el:
- Fixed erc-send-current-line so it no longer assigns the free variable "s", and
- it doesn't move point to end-of-buffer in non-ERC buffers. Fixed
- erc-kill-buffer-function so it doesn't run the erc-kill-server-hook hooks if the
- server connection is closed. Fixed bug 658552, which is described in detail at
- http://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
-
-2002-12-26 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-cmd-SMV): Bug, now call erc-version-modules.
-
- * erc-pcomplete.el(erc-pcomplete-version): New.
-
-2002-12-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-pcomplete.el:
- Fix for bug where you could not complete a nick when there was text following
- the nick.
-
-2002-12-25 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-already-logged-in): Use erc-process-alive.
- (erc-prepare-mode-line-format): Use erc-process-alive.
- (erc-process-alive): Check erc-process for boundp and processp.
-
- * erc.el(erc-kill-buffer-function):
- Do not check whether the process is
- alive before running the hook, because there might be functions on
- the hook that need to run even when the process is dead. And
- function that wants to check this, should use (erc-process-alive).
- (erc-process-alive): New function.
- (erc-kill-server): Use it.
- (erc-kill-channel): Use it.
-
- * erc.el(erc-kill-buffer-function):
- Reverted ignore-error change.
- ignore-error is dangerous because we might miss bugs in functions
- on erc-kill-server-hook.
-
- * erc.el(erc-kill-buffer-function): Use memq instead of member
- when checking process-status. Added doc string with references to
- the other hooks.
- (erc-kill-server): Only send the command when the erc-process is
- still alive. This prevents the error: "Process
- erc-irc.openprojects.net-6667 not running" when killing the buffer
- after having used /QUIT.
-
-2002-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-server-ERROR):
- Show the error reason, not only the originating host.
-
- * erc.el(erc-kill-buffer-function):
- (ignore-errors ...) in 'erc-kill-server-hook.
- When the process for this server does not exist anymore, the hook
- will cause an error, effectively preventing the buffer from being
- killed.
-
-2002-12-24 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-notify.el:
- Fixed erc-notify-timer so that it passes the correct nick to
- the functions on erc-notify-signoff-hook.
-
-2002-12-24 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el: Doc
-
- * erc-track.el(erc-make-mode-line-buffer-name): Removed a
- superfluous if construct around erc-track-showcount-string.
- (erc-track-modified-channels): Use 1+.
- Plus some doc and comment changes.
-
-2002-12-23 Mario Lang <mlang@delysid.org>
-
- * erc.el: Fix (erc-version) string
-
-2002-12-23 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- Removed unnecessary assignment to free-variable "p" in erc-downcase.
-
- * erc.el:
- Now /PART reason strings are generated the same way /QUIT reason strings
- are generated (see variable erc-part-reason). Also, when a server buffer
- is killed, a QUIT command is automatically sent to the server.
-
- * erc.el:
- Changed erc-string-no-properties so that it is more efficient. Now it uses
- set-text-properties instead of creating and deleting a temporary buffer.
-
-2002-12-21 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-kill-input: added a check to prevent a (ding) and an error when
- there's nothing to kill (thanks to Francis Litterio, franl on IRC)
-
-2002-12-21 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- AWAY notice duplication prevention. erc-prevent-duplicates now set to ("301") by default, and timeout to 60
-
- * erc.el: erc-prevent-duplicates: New variable, see docstring
-
-2002-12-20 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el:
- erc-track-modified-channels: Use cddr of cell for old-face. cdr of
- cell is '(1 . face-name), i have no idea why :)
-
-2002-12-20 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-current-nick):
- check the server buffer is active before using
-
- Also tabified and cleaned up some trailing whitespace
-
-2002-12-15 Mario Lang <mlang@delysid.org>
-
- * erc-track.el: erc-track-count patch by az
-
-2002-12-14 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- last-peers: initialize to a cons. thanks to Francis Litterio
- <franl@world.std.com> for the patch
-
- * erc.el:
- erc-kill-channel-hook, erc-kill-buffer-hook, (erc-kill-channel):
- both hooks now call erc-save-buffer-in-logs, so that query buffers are
- saved properly now, and not just channel buffers.
-
-2002-12-13 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-unique-channel-names): Fix another #hurd
- vs. #hurd-bunny bug.
-
- * erc-match.el(match): No longer modify erc-send-modify-hook,
- since it does not work without a parsed text property, anyway.
- (erc-keywords): Allow cons cells.
- (erc-remove-entry-from-list): Deal with cons cells.
- (erc-keyword-p): Ditto.
- (erc-match-message): Ditto.
-
- Moved nil to the beginning of the list, removed :tags for the
- -type variables:
- (erc-current-nick-highlight-type): Ditto.
- (erc-pal-highlight-type): Ditto.
- (erc-fool-highlight-type): Ditto.
- (erc-keyword-highlight-type): Ditto.
- (erc-dangerous-host-highlight-type): Ditto.
- (erc-log-matches-flag): Moved nil to the beginning.
-
-2002-12-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-beg-of-input-line: Don't do (goto-char (beginning-of-line)), since
- beginning-of-line always moves point and returns nil. Thanks to
- franl on IRC for noting this.
-
- * erc-stamp.el:
- erc-insert-timestamp-left, erc-insert-timestamp-right: Made the
- timestamp a 'field named 'erc-timestamp. Now end-of-line and
- beginning-of-line will move over the timestamp.
-
-2002-12-10 Damien Elmes <erc@repose.cx>
-
- * erc-button.el(erc-button-add-button):
- make the created button rear-nonsticky, to allow
- cutting and pasting of buttons without worrying about the button properties
- being inherited by the text typed afterwards.
-
- * erc.el: save logfile when killing buffer
-
-2002-12-09 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-modified-channels-display): Reworked.
- (erc-track-face-more-important-p): Removed.
- (erc-track-find-face): Return only one face.
- (erc-track-modified-channels): Reworked.
- (erc-modified-channels-string): Changed from (BUFFER FACE...) to
- (BUFFER . FACE)
-
- * erc-stamp.el(erc-insert-timestamp-right): Do not assume
- erc-fill-column is available.
-
-2002-12-09 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-ech-notices-in-minibuffer-flag, erc-minibuffer-notice: Clarified
- the difference in the docstrings.
-
-2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: erc-noncommands-list: added erc-cmd-SM and erc-cmd-SMV
-
-2002-12-08 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-cmd-SM): New.
- (erc-cmd-SMV): New.
-
- * erc.el(erc-modes): New.
-
-2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-compat.el:
- field-end: use (not (fboundp 'field-end)) instead of (featurep 'xemacs)
-
-2002-12-08 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-version-modules): New.
-
-2002-12-08 Mario Lang <mlang@delysid.org>
-
- * debian/changelog, debian/control, debian/scripts/startup.erc:
- debian release 3.0.cvs.20021208
-
-2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-split-command): Do the right thing with CTCPs.
-
-2002-12-08 Mario Lang <mlang@delysid.org>
-
- * erc-stamp.el: Be a bit more functional
-
-2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-compat.el:
- XEmacs doesn't seem to have field-end, so we provide our own version here.
-
-2002-12-08 Mario Lang <mlang@delysid.org>
-
- * Makefile: Small fixes to debrelease target
-
-2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- make-obsolete-variable: xemacs doesn't have the WHEN parameter, remove it.
-
-2002-12-07 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-imenu.el(erc-create-imenu-index):
- Use (forward-line 0) instead of
- (beginning-of-line) now, sine the latter ignores fields (used in the
- prompt).
-
- * erc.el:
- Rewrite of the prompt stuff to use a field named 'erc-prompt:
-
- erc-prompt: Removed getter and setter functions. The properties were
- already set (and overwritten) in erc-display-prompt.
- (erc-prompt): Add the trailing space here, not all over the code.
- (erc-display-prompt): Cleaned up a bit. The text-properties now are
- valid on the whole prompt. Also, made the prompt 'intangible to
- avoid confused users.
- (erc-bol): Now use the field 'erc-prompt for finding the prompt
- (erc-parse-current-line): Cleaned up considerably. Uses (erc-bol) now.
- (erc-load-irc-script-lines): Adjusted for the new (erc-prompt).
- (erc-save-buffer-in-logs): Adjusted for the new (erc-prompt).
-
- * erc.el:
- erc-uncontrol-input-line: The comment said "Consider it deprecated",
- so I removed it now.
- erc-prompt-interactive-input: Marked obsolete as of previous change.
-
- * erc.el:
- erc-smiley, erc-unmorse: Put at the end to separate it from the
- important parts of erc.el.
-
-2002-12-07 Alex Schroeder <alex@gnu.org>
-
- * erc-stamp.el(erc-insert-timestamp-right): New algorithm.
-
-2002-12-07 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- last-peers, erc-message: Explained what last-peers is used for.
-
-2002-12-07 Alex Schroeder <alex@gnu.org>
-
- * erc-page.el(erc-cmd-PAGE): New function.
- (erc-ctcp-query-PAGE): Use the catalog entry for the message, too.
- (erc-ctcp-query-PAGE-hook): Added custom type.
- (erc-page-function): Changed custom type from ... function-item to
- ... function.
- As well as doc strings.
-
-2002-12-06 Alex Schroeder <alex@gnu.org>
-
- * erc-page.el: provide feature at the end
-
-2002-12-06 Brian P Templeton <bpt@tunes.org>
-
- * erc-nickserv.el:
- Added austnet in erc-nickserv.el (thanks to Damien Elmes
- <resolve@repose.cx>)
-
-2002-12-05 Mario Lang <mlang@delysid.org>
-
- * erc-complete.el: Add autoload cookie
-
- * erc-speak.el: Small fix to make proper voice-changes
-
-2002-12-05 Alex Schroeder <alex@gnu.org>
-
- * erc-lang.el: New
-
-2002-12-03 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-mode-map: Put back C-c C-p (PART) and C-c C-q (QUIT)
-
-2002-12-02 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-insert-post-hook: Add :options erc-make-read-only, erc-save-buffer-in-logs
- erc-send-post-hook: Add :options erc-make-read-only
-
- * erc.el: erc-insert-hook: Removed ("this hook is obsolescent")
- erc-insert-post-hook: Added :options '(erc-truncate-buffer)
-
-2002-12-02 Mario Lang <mlang@delysid.org>
-
- * erc.el: Add missing requires
-
-2002-11-29 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-quit-reason-normal):
- Remove v before %s so it's "Version ..." not
- "vVersion ..."
-
-2002-11-26 Alex Schroeder <alex@gnu.org>
-
- * erc-compat.el(erc-encode-coding-string): Add second argument
- coding-system, and for non-mule xemacsen, use a new defun instead
- of identity.
-
- * erc.el: (define-erc-module): Use the appropriate group.
- (erc-port): Changed custom type.
- (erc-insert-hook): Custom group changed to erc-hooks.
- (erc-after-connect): ditto
- (erc-before-connect): ditto
- (erc-disconnected-hook): ditto
-
- * erc-button.el(erc-button): New group, changed all custom groups
- from erc to erc-button, but left all erc-faces as-is.
-
- * erc-track.el(erc-track): New group, changed all custom groups
- from erc to erc-track.
-
-2002-11-26 Mario Lang <mlang@delysid.org>
-
- * erc-macs.el:
- Macros for erc-victim handling. Primary idea is to use setf and some fancy things to get nice syntax. have a look
-
-2002-11-26 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- pings, erc-cmd-PING, erc-ctcp-reply-PING, catalog entry CTCP-PING:
- Cleaned up. Removed buffer-local variable pings which stored a list of
- all sent CTCP PING requests. Now send our full time with the CTCP PING
- request and interpret the answer.
-
-2002-11-25 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: nick-stk: replaced by the local variable current-nick.
-
-2002-11-25 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-send-command): Use erc-encode-string-for-target.
- (erc-encode-string-for-target): New.
-
- * erc-compat.el(erc-encode-coding-string): Add second argument
- coding-system, and for non-mule xemacsen, use a new defun instead
- of identity.
-
- * erc-nickserv.el(erc-nickserv-version): New.
-
-2002-11-25 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * Makefile:
- UNCOMPILED: erc-chess.el depends on chess-network.el, which might not
- be installed. Don't compile it.
-
- * erc.el:
- erc-mode-map: Added C-a as erc-bol (no reason why it shouldn't be),
- and removed C-c C-p (part channel) and C-c C-q (quite server) as these
- are a bit drastic in their consequences and easy to mistype.
-
-2002-11-24 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el: erc-track-faces-priority-list: Extended list
-
- * erc.el:
- channel-members: Updated docstring: We have a VOICE predicate, too.
-
- * erc-track.el(erc-unique-substrings):
- Don't shorten a single channel to "#", but
- always give at least 2 chars (except when there are no two chars).
-
-2002-11-23 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-nickserv.el:
- support for BrasNET. Thanks to rw on IRC for the settings.
-
-2002-11-23 Alex Schroeder <alex@gnu.org>
-
- * erc.el: (erc-default-recipients, erc-session-user-full-name)
- (nick-stk, pings, erc-announced-server-name, erc-connected)
- (channel-user-limit, last-peers, invitation, away, channel-list)
- (last-sent-time, last-ping-time, last-ctcp-time, erc-lines-sent)
- (erc-bytes-sent, quitting, bad-nick, erc-logged-in)
- (erc-default-nicks): Defvars.
-
- * erc-compat.el: Switched tests to iso-8859-1 instead of latin-1.
-
- * erc-compat.el(erc-compat-version): New.
-
-2002-11-22 Alex Schroeder <alex@gnu.org>
-
- * erc.el(smiley): Smileys are a very small module, now.
-
-2002-11-22 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-event-to-hook, erc-event-to-hook-name: eval-and-compile these,
- since we need them in a macro. ERC now compiles again!
-
- * erc-speak.el:
- erc-minibuffer-privmsg: Removed setting this variable to nil, since it
- was removed from erc.el.
-
- * erc.el(erc-interactive-input-map): Added docstring.
- (erc-wash-quit-reason): Extended docstring.
- (erc-server-ERROR): Added docstring.
- (erc-server-321): buffer-local variable channel-list probably
- shouldn't be renamed erc-channel-list - removed FIXME.
-
- * erc.el: small cleanup.
- ("was not used anymore" here means "not used in erc/*.el nor in
- fsbot", thanks to deego for checking that.)
-
- erc-minibuffer-privmsg: Removed (was not used anymore)
- (erc-reformat-command): Removed (was not used anymore)
- (erc-strip-erc-parsed-property): Removed (was not used anymore)
- (erc-process-ctcp-response): Removed (replaced by ctcp-query-XXX-hook)
- (erc-send-paragraph): Removed ("Note that this function is obsolete,
- erc-send-current-line handles multiline input.")
- (erc-input-hook): Removed ("This hook is obsolete. See
- `erc-send-pre-hook', `erc-send-modify-hook' and
- `erc-send-post-hook' instead.")
- (erc-message-hook): Removed ("This hook is obsolete. See
- `erc-server-PRIVMSG-hook' and `erc-server-NOTICE-hook'.")
- (erc-cmd-default-channel): Removed ("FIXME: no clue what this is
- supposed to do." - it was supposed to prepend the default channel
- to a command before sending it. E.g. typing "/FOO now!" would send
- the IRC command "FOO #mycurrentchannel now!")
-
- * erc.el:
- erc-ctcp-query-PING: Send the whole argument back, not just the first
- number. This is required for many clients (e.g. irssi, BitchX, ...)
- which send their ping times in two different numbers for microsecond
- accuracy.
-
-2002-11-22 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-track-shorten-function): Allow nil.
-
-2002-11-21 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-unique-channel-names): Fixed bug that appeared
- if one target name was a substring of another -- eg. #hurd and
- #hurd-bunny. Added appropriate test.
-
-2002-11-20 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el:
- erc-unique-channel-names: Don't take a substring of channel that could
- be longer than the channel, but at most (min (length candidate)
- (length channel). (thanks to deego for noticing this)
-
-2002-11-19 Mario Lang <mlang@delysid.org>
-
- * erc-notify.el: * (require pcomplete): Only when compiling.
-
-2002-11-19 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el:
- erc-track-faces-priority-list: New variable, defines what faces will
- be shown in the modeline. If set to nil, the old behavior ("all")
- remains.
- erc-track-face-more-important-p: new function
- erc-track-find-face: new function
-
-2002-11-19 Alex Schroeder <alex@gnu.org>
-
- * erc-fill.el(erc-stamp): Require it.
-
- * erc-match.el(away): devar for the compiler.
-
- * erc-stamp.el(stamp): Moved.
-
- * erc.el(erc-version-string): New version.
-
- * erc-autoaway.el(erc-autoaway-idletimer): Moved to the front of
- the file.
-
- * erc-auto.in: (generated-autoload-file, command-line-args-left):
- Added defvar without value to silence byte compiler.
-
- * Makefile(realclean): renamed fullclean to realclean.
- (UNCOMPILED): New list, for erc-bbdb.el, erc-ibuffer.el,
- erc-speak.el.
- (SOURCE): Do not compile UNCOMPILED.
- (release): New target.
- (ChangeLog): New target.
- (todo): New target.
-
- * erc-complete.el(erc-match): Require it.
- (hippie-exp): Require it.
-
- * erc-ezbounce.el(erc): Require it.
-
- * erc-imenu.el(imenu): Require it.
-
- * erc-nickserv.el(erc-networks): Moved up.
-
- * erc-notify.el(pcomplete): Require it.
-
- * erc-replace.el(erc): Require it.
-
- * erc-sound.el(sound): Typo -- define-key in erc-mode-map.
-
- * erc-speedbar.el(dframe): Require it.
- (speedbar): Require it.
-
- * erc-track.el(erc-default-recipients): devar for the compiler.
-
- * README: New file.
-
-2002-11-18 Mario Lang <mlang@delysid.org>
-
- * AUTHORS: File needed for mkChangeLog
-
- * mkChangeLog: Original code by mhp
-
-2002-11-18 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-button-list): Renamed to erc-list and moved
- to erc.el.
-
- * erc.el(erc-list): New.
-
- * erc-track.el(erc-make-mode-line-buffer-name): Simplified.
- (erc-modified-channels-display): Simplified. Now works with all
- faces, and fixes the bug that when two faces where used (bold
- erc-current-nick-face), then no faces was added.
-
- * erc-track.el: Lots of new tests. Moved some defuns around in
- the file.
- (erc-all-channel-names): Renamed.
- (erc-all-buffer-names): New name, now include query buffers as
- well.
- (erc-modified-channels-update-inside): New variable.
- (erc-modified-channels-update): Use it to prevent running display
- if already inside it. This prevented debugging of
- `erc-modified-channels-display'.
- (erc-make-mode-line-buffer-name): Moved.
- (erc-track-shorten-names): Don't test using erc-channel-p as that
- failed with query buffers.
- (erc-unique-substrings): Move setq i + 1 to the end of the while
- loop, so that start is used as a default value instead of start +
- 1.
-
-2002-11-18 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el:
- erc-unique-substrings: define this before using it in assert
-
- * erc.el:
- with-erc-channel-buffer: Define *before* using this macro. This
- hopefully fixes a bug noted on IRC.
-
- * erc-notify.el:
- erc-notify-signon-hook, erc-notify-signoff-hook: New hooks. They're
- even run when their name suggests!
-
-2002-11-18 Alex Schroeder <alex@gnu.org>
-
- * erc-list.el: Typo.
-
- * erc-speedbar.el: Whitespace only.
-
- * erc.el(define-erc-module): Avoid defining an alias if name and
- alias are the same.
-
- * erc-ibuffer.el: URL
-
- * erc-imenu.el(erc-imenu-version): New constant.
-
- * erc-ibuffer.el(erc-ibuffer-version): New constant.
-
- * erc-ibuffer.el: File header, comments.
-
- * erc-fill.el(erc-fill-version): New constant.
-
- * erc-ezbounce.el(erc-ezb-version): New constant.
-
- * erc-complete.el(erc-complete-version): New constant.
-
- * erc-chess.el(erc-chess-version): New constant.
-
- * erc-chess.el: Whitespace only.
-
- * erc-bbdb.el(erc-bbdb-version): Typo.
-
- * erc-bbdb.el(erc-bbdb-version): New constant.
- Lots of whitespace changes. Changes to the header.
-
- * erc-track.el(erc-track-shorten-aggressively): Doc.
- (erc-all-channel-names): New function.
- (erc-unique-channel-names): New function.
- (unique-substrings): Renamed.
- (erc-unique-substrings): New name
- (unique-substrings-1): Renamed.
- (erc-unique-substring-1): New name. Added lots of tests.
- (erc-track-shorten-names): Call erc-unique-channel-names instead
-
- * erc-match.el(match): Rewrote a as module.
-
-2002-11-17 Alex Schroeder <alex@gnu.org>
-
- * erc-netsplit.el(erc-netsplit-version): New.
- (netsplit): Defined as a module, replacing erc-netsplit-initialize
- and erc-netsplit-destroy.
-
-2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el(erc-track-switch-buffer):
- define-erc-module defines erc-track-mode,
- not erc-track-modified-channels-mode.
-
- * erc.el:
- Variables erc-play-sound, erc-sound-path, erc-default-sound,
- erc-play-command, erc-ctcp-query-SOUND-hook and functions
- erc-cmd-SOUND, erc-ctcp-query-SOUND, erc-play-sound, erc-toggle-sound
- moved to erc-sound.el
-
- Variables erc-page-function, erc-ctcp-query-PAGE-hook and function
- erc-ctcp-query-PAGE moved to erc-page.el
-
- * erc-page.el:
- erc-page.el: New file. CTCP PAGE support for ERC, extracted from erc.el.
-
- * erc-sound.el:
- defin-erc-module: Typo. Autoload should do erc-sound-mode and "erc-sound".
-
- * erc-sound.el:
- erc-sound.el: New file. Contains all the CTCP SOUND stuff from erc.el.
-
- * erc.el(erc-process-ctcp-request):
- Removed (old-style CTCP handling)
- (erc-join-autogreet): Removed (was broken anyways)
-
-2002-11-17 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-button-version): New constant.
-
- * erc-button.el(button): rewrote as a module.
-
-2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: New functions:
- (erc-event-to-hook), (erc-event-to-hook-name): Convert an event to the
- corresponding hook. The latter only returns the name, while the former
- interns the hook symbol and returns it.
-
-2002-11-17 Alex Schroeder <alex@gnu.org>
-
- * erc-replace.el:
- Practically total rewrite. All smiley stuff deleted.
-
- * erc-track.el(track): typo.
-
- * erc.el(define-erc-module): Doc change.
-
-2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-autoaway.el: Changed to use define-erc-module.
-
- * erc.el(define-erc-module):
- Make the enable/disable functions interactive.
-
- * erc.el(erc):
- Don't use switch-to-buffer when we're in the minibuffer,
- because that does not work. Use display-buffer instead. This leaves
- two problems: The point does not advance to the end of the buffer for
- whatever reason, and after leaving the minibuffer, the new window gets
- buried.
-
-2002-11-17 Alex Schroeder <alex@gnu.org>
-
- * erc-stamp.el(stamp): Doc change.
-
- * erc-stamp.el(erc-stamp-version): New constant.
- (stamp): downcase alias name of the mode.
-
- * erc.el(define-erc-module): Added defalias option, renamed
- parameters again.
-
- * erc-track.el: erc-track-modified-channels-mode is now only an
- alias to erc-track-mode. Only erc-track-mode is autoloaded.
- (track): Rewrote call to define-erc-module.
-
-2002-11-16 Mario Lang <mlang@delysid.org>
-
- * debian/README.Debian: * Spelling fix
-
- * erc-fill.el: * Fix autoload definition for erc-fill-mode
-
- * debian/control, debian/maint/postinst, debian/maint/prerm:
- * Remove /usr/doc -> /usr/share/doc link handling
-
- * debian/changelog: * Sync with reality
-
- * debian/scripts/startup.erc:
- * Add /usr/share/emacs/site-lisp/erc/ to load-path
- * (load "erc-auto")
-
- * debian/README.Debian:
- * Info about the changes since last release updated
-
- * erc-pcomplete.el: * Fix emacs/xemacs compatibility
-
- * debian/scripts/install: * Don't compile erc-compat, fix ELCDIR
-
- * debian/control: * Change maintainer field
-
- * erc.el:
- * (defin-erc-module): Renamed argument mode-name to mname because silly byte-compiler thought we were talking about `mode-name'.
-
- * Makefile: * Added debrelease target
-
- * erc-bbdb.el, erc-pcomplete.el, erc-stamp.el, erc.el:
- * (define-erc-module): Added mode-name argument.
- * Converted erc-bbdb, erc-pcomplete and erc-stamp to new macro.
- * autoload fixes
-
- * erc-bbdb.el:
- * Create a global-minor-mode (i.e., make it a proper erc-module)
-
- * erc.el: * (define-erc-module): New defmacro
-
-2002-11-16 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-autoaway.el(erc-autoaway-idle-seconds):
- t in docstrings should be non-nil
-
-2002-11-16 Alex Schroeder <alex@gnu.org>
-
- * erc-autoaway.el, erc-button.el, erc-fill.el, erc-match.el,
- erc-menu.el, erc-ring.el, erc-track.el:
- Cleanup of file headers: copyright years, GPL mumbo-jumbo, commentaries.
-
- * erc-stamp.el(erc-insert-away-timestamp-function):
- New custom type.
- (erc-insert-timestamp-function): New custom type.
-
- * erc-fill.el(erc-fill-function): Doc, new custom type.
- (erc-fill-static): Doc.
- (erc-fill-enable): New function.
- (erc-fill-disable): New function.
- (erc-fill-mode): New function.
-
- * erc-match.el(erc-match-enable): add-hook for both
- erc-insert-modify-hook and erc-send-modify-hook.
- (erc-match-disable): remove-hook for both
- erc-insert-modify-hook and erc-send-modify-hook.
-
-2002-11-15 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-autoaway.el:
- - Added a way to use auto-away using emacs idle timers
- - Renamed erc-set-autoaway to erc-autoaway-possibly-set-away for consistency
-
-2002-11-14 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: erc-mode-map: Removed the C-c C-g binding for erc-grab
-
- * erc.el:
- (erc-server-341) Another instance of the channel/chnl problem i didn't
- see last time
-
-2002-11-14 Alex Schroeder <alex@gnu.org>
-
- * erc-compat.el(erc-decode-coding-string): typo
-
-2002-11-14 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-server-341):
- variable name should be chnl not channel, as it is
- used this way in this function, and the other erc-server-[0-9]* use
- chnl too.
-
- * erc-autoaway.el:
- Set back on all servers, not just the current one, since we're set
- away on all servers as well.
-
- * HISTORY: Fixed typo (ngu.org => gnu.org)
-
- * erc-autoaway.el, erc-fill.el, erc.el: erc-autoaway.el:
- * new file
-
- erc.el:
- * Removed auto-discard-away facility (now included in erc-autoaway.el)
- * (erc-away-p): new function
-
- erc-fill.el:
- * (erc-fill-variable): Check whether erc-timestamp-format is bound before
- using it (erc-fill.el does not require erc-stamp).
-
-2002-11-10 Alex Schroeder <alex@gnu.org>
-
- * TODO:
- TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO
-
- * erc.el(with-erc-channel-buffer): Rudimentary doc string.
-
-2002-11-09 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-nick-popup-alist): Made a defcustom.
-
- * erc-button.el(erc-button-disable): New function.
- (erc-button-enable): New function, replaces the add-hook calls at top-level.
- (erc-button-mode): New minor mode.
-
-2002-11-08 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-button-entry): Use erc-button-syntax-table.
-
- * erc.el, erc-stamp.el: Doc changes.
-
- * erc-match.el(erc-match-mode): New function, replacing the
- add-hook.
- (erc-match-enable): New function.
- (erc-match-disable): New function.
- (erc-current-nick-highlight-type): Changed from 'nickname to 'nick
- to make it consistent with the others.
- (erc-match-message): Ditto.
-
- * erc-button.el(erc-button-syntax-table): New variable.
- (erc-button-add-buttons): Use it.
-
-2002-11-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- 1) (bug) ERC pops up a new buffer and window when being messaged
- from an ignored person. fixed
- 2) (misfeature) ERC notices the user in the minibuffer when it
- ignores something - this can get very annoying, since the
- minibuffer is also visible when not looking at ERC buffers.
- Added a customizable variable for this, the default is nil.
- 3) (wishlist) There is no IGNORE or UNIGNORE command.
- Added.
- 4) (wishlist) Some IRC clients, notably irssi, allow the user to
- ignore "replies" to ignored people. A reply is defined as a
- line starting with "nick:", where nick is the nick of an
- ignored person. Added that functionality.
- Done by Jorgen Schaefer <forcer@forcix.cx>
-
-2002-11-02 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-connect): set-process-coding-system to raw-text.
-
-2002-11-01 Brian P Templeton <bpt@tunes.org>
-
- * erc-pcomplete.el, erc-stamp.el, erc-track.el:
- Fixed more autoloads
-
- * erc-compat.el: Added autoload for erc-define-minor-mode
-
-2002-11-01 Mario Lang <mlang@delysid.org>
-
- * erc.el: * (erc-send-command): will break long messages into
- a bunch of smaller ones, to prevent them from being truncated by the server.
- The patch also axes some trailing whitespace. :-) <resolve>
-
-2002-10-31 Alex Schroeder <alex@gnu.org>
-
- * erc-pcomplete.el(erc-compat): Require.
- (erc-completion-mode): Use erc-define-minor-mode.
-
- * erc-track.el(erc-compat): Require.
- (erc-track-modified-channels-mode): Use erc-define-minor-mode.
-
- * erc-stamp.el(erc-compat): Require.
- (erc-timestamp-mode): Use erc-define-minor-mode.
-
- * erc-compat.el: New file with the code for erc-define-minor-mode,
- erc-encode-coding-string and erc-decode-coding-string. Essentially
- all the stuff that cannot be tested for using a simple boundp or
- fboundp -- eg. because the number of arguments are wrong.
-
- * erc.el(erc-compat): Require.
- (erc-process-coding-system): Moved to erc-compat.el.
- (erc-connect): Do not set-process-coding-system.
- (encode-coding-string): Compatibility code moved to erc-compat.el.
- (decode-coding-string): Compatibility code moved to erc-compat.el.
- (erc-encode-coding-string): Compatibility code moved to erc-compat.el.
- (erc-decode-coding-string): Compatibility code moved to erc-compat.el.
-
-2002-10-27 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-display-line-1): Removed call to
- erc-decode-coding-string.
- (erc-parse-line-from-server): Added call to
- erc-decode-coding-string before anything gets parsed at all.
- (erc-decode-coding-string): Use undecided coding system.
-
-2002-10-24 Sandra Jean Chua <sacha@free.net.ph>
-
- * erc-button.el, erc.el:
- Added LASTLOG command and action for nick-button
-
-2002-10-22 Sandra Jean Chua <sacha@free.net.ph>
-
- * erc-pcomplete.el:
- Fixed nopruning bug, added /MODE channel (mode) [nicks...] completion - mode not completed yet.
-
-2002-10-16 Sandra Jean Chua <sacha@free.net.ph>
-
- * erc-pcomplete.el:
- Fixed 'Hi delysid:' bug in SAY completion after realizing that pcomplete on commands already took care of completing the initial nick:
-
-2002-10-15 Mario Lang <mlang@delysid.org>
-
- * erc-pcomplete.el: update from sachac
-
-2002-10-13 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-emacs-time-to-erc-time): Catch when tm is nil.
-
-2002-10-11 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * Fixed `erc-scroll-to-bottom' to scroll to the bottom even when
- in the middle of a line. Might also fix the Magic ECHAN Bug[tm]. (-:
-
-2002-10-11 Mario Lang <mlang@delysid.org>
-
- * erc-nickserv.el: Fixed erc-networks for the opn->freenode change
-
-2002-10-08 Mario Lang <mlang@delysid.org>
-
- * erc-pcomplete.el:
- Make erc-completion-mode work interactively with already joined channel buffers
-
- * erc-chess.el: Add autoload cookies
-
- * erc-notify.el: Add pcomplete support
-
- * erc.el:
- Remove autoload statements, remove autoload cookie from erc-mode and erc-info-mode
-
- * erc-fill.el, erc-match.el: add/remove autoload cookies
-
-2002-10-06 Alex Schroeder <alex@gnu.org>
-
- * erc-pcomplete.el(erc-completion-mode): New global minor mode
- with autoload cookie.
- (erc-pcomplete-enable): Renamed erc-pcomplete-initialize.
- (erc-pcomplete-disable): New function.
-
- * erc-complete.el: Doc changes.
-
- * erc-stamp.el(erc-stamp-enable): Renamed erc-stamp-initialize.
- (erc-stamp-disable): Renamed erc-stamp-destroy.
- (erc-timestamp-mode): Use new names.
-
- * erc.el: Removed autoload for erc-complete and
- erc-track-modified-channels-mode -- the autoload cookie should do
- that instead.
- (erc-input-message): Doc string, removed binding for erc-complete.
- (erc-mode-map): Removed binding for erc-complete.
-
-2002-10-03 Mario Lang <mlang@delysid.org>
-
- * erc-notify.el:
- New functions erc-notify-JOIN and erc-notify-QUIT to catch some common cases (warning, untested)
-
-2002-10-01 Alex Schroeder <alex@gnu.org>
-
- * erc-stamp.el(erc-timestamp-mode): New function. Removed call
- to erc-stamp-initialize at the end.
-
-2002-09-25 Brian P Templeton <bpt@tunes.org>
-
- * erc.el:
- Added customizable `erc-process-coding-system' variable.
-
-2002-09-22 Brian P Templeton <bpt@tunes.org>
-
- * erc-fill.el:
- `erc-fill-variable' now does the right thing when `erc-hide-timestamps' is non-nil
-
-2002-09-21 Mario Lang <mlang@delysid.org>
-
- * erc-fill.el:
- patch from Peter Solodov <peter@alcor.concordia.ca> (note, its slightly broken still
-
-2002-09-05 Mario Lang <mlang@delysid.org>
-
- * erc-pcomplete.el: Added LEAVE as alias for PART
-
-2002-09-04 Mario Lang <mlang@delysid.org>
-
- * erc-pcomplete.el:
- By sachac (good work!) keep up doing such things
-
-2002-08-31 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- A fix for Bug#133267: now you can put (erc-save-buffer-in-logs) on erc-insert-post-hook to save *every* incoming message.
-
-2002-08-30 Brian P Templeton <bpt@tunes.org>
-
- * erc.el:
- Changed default value of erc-common-server-suffixes because of the OPN
- name change
-
-2002-08-28 Mario Lang <mlang@delysid.org>
-
- * erc-stamp.el: Try to reactivate isearch in xemacs
-
- * erc-stamp.el:
- fixes issues related to comparative emacsology and a silly bug
-
-2002-08-27 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- New hook erc-send-completed-hook (for robot stuff), changed alexanders email address to reflect reality, little fix to erc-auto-query to get a bit of a speedup
-
-2002-08-22 Mario Lang <mlang@delysid.org>
-
- * erc-button.el:
- Fixed case-fold-search (thanks sachac), now lambda works in erc-button-alist, added wardwiki+google+symvar+rfc+itime regexps from the wiki
-
-2002-08-19 Mario Lang <mlang@delysid.org>
-
- * erc-button.el:
- erc-nick-popup-alist: New variable to make erc-nick-popup configurable
-
-2002-08-16 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-recompute-nick-regexp): Fixed regexp.
-
- * erc-button.el(erc-button-buttonize-nicks): Changed custom type
- to integer.
- (erc-button-add-buttons): Moved button removal code to new
- function.
- (erc-button-remove-old-buttons): New function.
- (erc-button-add-button): Removed use of overlays and used
- erc-button-add-face instead.
- (erc-button-add-face): New function to merge faces as text
- properties. This should be much faster when lots of buttons
- appear.
- (erc-button-list): New helper function.
-
- * erc.el(erc-display-message): Fixed argument list.
- (erc-display-prompt): Reduced calls to length, use start-open
- property for XEmacs to prevent a little box of erc-prompt-face at
- the end of messages other people send.
- (erc-refresh-channel-members): Fix XEmacs calls to split-string,
- which may return an empty string at the end of the list. This
- would cause hangups in erc-button in re-search-forward loops.
- (erc-get-channel-mode-from-keypress): Replaced control codes with
- octal escape sequences.
-
-2002-08-14 Mario Lang <mlang@delysid.org>
-
- * erc-button.el:
- Try to be compatible to XEmacs regexp-opt. (Im going to quit this job if I find more of those damn differencies
-
- * debian/README.Debian, debian/scripts/install:
- * Added info to README.Debian
- * Finished debian/scripts/install
-
-2002-08-13 Mario Lang <mlang@delysid.org>
-
- * debian/scripts/install: First attempt to fix it
-
- * debian/README.Debian, debian/changelog, debian/scripts/install:
- changelog: Changed maintainer and added new entry
- README.Debian: Re-explained the byte-compile issue
- scripts/install: Exclude erc-bbdb|chess|ibuffer|speedbar from
- byte-compiling
-
- * erc-track.el: Added C-c C-SPC in addition to C-c C-@
-
- * erc-notify.el: Little docstring change
-
-2002-08-09 Mario Lang <mlang@delysid.org>
-
- * erc-stamp.el:
- Change one use of set-text-properties to add-text-properties (tnx Lathi)
-
-2002-08-02 Mario Lang <mlang@delysid.org>
-
- * erc-stamp.el: added erc-timestamp-only-if-changed-flag
-
-2002-07-22 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Removed timestamp related code and moved into erc-stamp.el
-
- * erc-stamp.el:
- Timestamping code moved out of erc.el. Additional, now we can timestamp either on the left or on the right side
-
-2002-07-16 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Make ctcp ping return its message in the active buffer, instead of the server buffer
- * Corrected minimal typo in catalog
- * Added var and variable as alias for /set
-
-2002-07-08 Mario Lang <mlang@delysid.org>
-
- * erc-track.el:
- * New function erc-track-switch-buffer (by resolve)
- Bound to C-c C-SPC, enjoy!
-
-2002-07-08 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: New snapshot deb
-
- * debian/scripts/install: Rewrote in make.
- Does not byte-compile erc-speak.el at all, and excludes erc-track.el too, if
- ran for xemacs.
-
- * debian/control: Added dependency on make
-
- * debian/copyright: Updated copyright info
-
- * debian/rules: Use $(wildcard *.el) instead of a hardcoded list
-
-2002-07-03 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- erc-iswitchb now works correctly if erc-modified-channels-alist is non-nil
-
-2002-07-01 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el:
- * changed how we check if we should activate "Track hidden channels" and
- whether it should be selected - fixes a bug XEmacs where whole menu bar
- does not work if menu is loaded
-
- * erc-menu.el:
- * added "Disconnect from server", only selectable if erc-connected is non-nil
-
- * topic is allowed to be set by normal users if channel mode is not +t
-
- * add " ..." after description if arguments needed after selecting menu item
-
- * only allow selecting of menu points needing a channel if current buffer is
- a channel buffer - done by testing if channel-members is non-nil
-
- * put erc-match functions in new group "Pals, fools and other keywords"
-
- * erc.el:
- * moved definition of erc-show-my-nick to GUI variables section
-
- * erc-connected variable now defined with defvar
- now set in channel and query buffers, was only in server buffer before
- upon disconnect, set erc-connected to nil in all the server's buffers
-
- * added erc-cmd-GQUIT and its alias erc-cmd-GQ - quit all servers at once
-
- * added interactive function erc-quit-server, bound to C-c C-q
-
- * added erc-server-WALLOPS
-
- * added WALLOPS to english catalog, fixed s461 (was showing message twice)
-
- * typo fixes, spacing change
-
-2002-06-29 Mario Lang <mlang@delysid.org>
-
- * erc.el: Use pp-to-string in /set (without args)
-
- * erc-netsplit.el:
- Make /set anonymous-lign set erc-anonymous-login, also report
- which var was set to which val.
-
-2002-06-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el: added "Customize ERC"
-
-2002-06-25 Mario Lang <mlang@delysid.org>
-
- * erc.el: New variable: erc-use-info-buffers, defaults to nil.
- This prevents info-buffers from being created/updated.
- Set to t if you use :INFO buffers.
- (by rw)
- Delete (erc-display-prompt) from reconnect to avoid clutter
-
-2002-06-23 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- erc-get-channel-mode-from-keypress is now bound to C-c C-m
- erc-insert-mode-command is taken care of by this function as well
-
-2002-06-21 Mario Lang <mlang@delysid.org>
-
- * erc-track.el:
- Fixed bug where buffer-names suddenly had text-properties.
-
-2002-06-19 Diane Murray <disumu@x3y2z1.net>
-
- * Makefile: changed erc-auto.el to $(SPECIAL) in make fullclean
-
- * Makefile: remove erc-auto.el on make fullclean
-
-2002-06-18 Diane Murray <disumu@x3y2z1.net>
-
- * erc-match.el: fixed spelling error
-
- * erc-track.el, erc-match.el: * erc-match.el:
- highlight current nickname in its own face (inactive by default):
- - added erc-current-nick-highlight-type, erc-current-nick-face,
- erc-current-nick-p
-
- * erc-track.el:
- added support for erc-current-nick-face
-
-2002-06-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: * added beginning support for 005 numerics:
- - added buffer local variable erc-server-parameters
- - added erc-server-005, which sets erc-server-parameters if the server has
- used this code to show its parameters
-
-2002-06-16 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- * bugfix: when pasting lines with blank lines in between, remove the blank lines
- but send the rest
-
- * since we know the command, use it when checking what's in erc-hide-list
- added check to erc-server-KICK
-
- * added some blank lines for better readability
-
-2002-06-16 Alex Schroeder <alex@gnu.org>
-
- * erc-nickserv.el(erc-nickserv-alist): Fixed typo.
-
-2002-06-15 Alex Schroeder <alex@gnu.org>
-
- * erc-nickserv.el(erc-networks): Added doc string.
- (erc-nickserv-alist): Added doc string.
-
-2002-06-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-ring.el:
- fixed bug so that the prompt and command always get put at the end of the buffer
-
-2002-06-10 Mario Lang <mlang@delysid.org>
-
- * erc-nickserv.el: Added iip support.
- Added :type for erc-nickserv-passwords custom.
- Fixed hook usage.
-
-2002-06-07 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nickserv.el: * added GalaxyNet
-
- * erc-nickserv-alist:
- - sorting networks alphabetically
- - added two more pieces of information in erc-nickserv-alist:
- word to use for identification and whether to use the nickname
-
- * erc-current-network:
- - made regex case insensitive, downcase server to match
- - uses the new information
- - now uses new variable erc-networks instead of doing checking manually
-
- * added variable erc-networks
-
- * fixed some indentation, documentation
-
-2002-06-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: Fix for kill-buffer hook stuff
-
-2002-06-06 Mario Lang <mlang@delysid.org>
-
- * erc.el: Added /squery command
-
-2002-06-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el: * made group Channel modes
- - moved change mode and invite only mode to here
- - added secret, moderated, no external send, topic lock, limit, key
-
- * check that user is in a channel buffer and user is a channel operator
- for all op-related actions
-
- * "Identify to nickserv" needs erc-nickserv-identify defined
-
- * added "Show ERC version"
-
- * erc.el:
- * added erc-set-channel-limit, erc-set-channel-key, erc-toggle-channel-mode
-
- * added erc-get-channel-mode-from-keypress, which is bound to C-c m
- sends the next character which is typed to one of the 3 new functions
- - did not remove erc-invite-only-mode and it's key binding in case
- people are used to it, although it probably should be removed...
-
- * in erc-server-MODE:
- added check if tgt equal to user's nick
- removed erc-display-line, only using the erc-display-message
-
- * added s461 to english catalog
-
- * fixed bug where XEmacs would not quit if erc-quit-reason was
- set to erc-quit-reason-various and assoc-default was not defined
-
-2002-06-04 Andreas Fuchs <asf@void.at>
-
- * erc-ezbounce.el, erc-match.el:
- * erc-ezbounce.el: Added. Provides support for ezbouncer; automatic login,
- session management implemented. I've contacted the author
- about stuff in EZBounce's logging.
- * erc-match.el: Fixed a stupid mistake where
- "*** Your new nick is <foo>" would trigger an error.
-
-2002-06-04 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nickserv.el, erc.el: * added erc-nickserv.el
- * moved nickserv identification variables and functions to the new file
- (require 'erc-nickserv) is now necessary for this to work
-
- * erc.el:
- * results of /COUNTRY now formatted as notice; errors are ignored,
- fixing
- bug which made prompt disappear
-
- * added undefined-ctcp error message to english catalog
-
- * changed some (when (not erc-disable-ctcp-replies) to use unless instead
- and some if's without else statements to use when or use
-
- * CTCP replies now use erc-display-message, formatted as notices
-
- * added following to english catalog:
- - undefined-ctcp
- - CTCP-CLIENTINFO, CTCP-ECHO, CTCP-FINGER, CTCP-PAGE, CTCP-PING,
- CTCP-SOUND, CTCP-TIME, CTCP-UNKNOWN, CTCP-VERSION
- - s303, s305, s306, s353
-
- * split erc-server-305-or-306 into erc-server-305 and erc-server-306
-
- * KICK already had buffer set, using it
-
- * erc.el:
- * erc-format-timestamp now only called from erc-display-message and
- erc-send-current-line
-
- * all instances of erc-display-line with erc-highlight-error
- changed to use erc-display-message
-
- * added following error messages to english catalog:
- bad-ping-response, bad-syntax, cannot-find-file, cannot-read-file,
- ctcp-request, flood-ctcp-off, flood-strict-mode, no-default-channel,
- no-target, variable-not-bound
-
- * added following server related messages to english catalog:
- s324, s329, s331, s332, s333, s341, s406, KICK, KICK-you, KICK-by-you, MODE-nick
-
- * ignoring server codes 315, 369
-
- * added erc-server-341, erc-server-406
-
- * channel topic and mode notices displayed in respective channel buffers if they
- exist
-
- * erc-server-KICK: display the message before removing this channel so that we
- can track the kick
-
- * send parsed to erc-ctcp-query-ACTION-hook so that actions can be checked
- by erc-match
-
- * fixed bug where nil was shown if no reason was given by users on /PART
-
-2002-06-03 Diane Murray <disumu@x3y2z1.net>
-
- * erc-match.el:
- * fixed bug where erc-log-matches produced an error when the value of
- (erc-default-target) was not a channel
- * use erc-format-timestamp, if it's non-nil, for %t in erc-log-match-format
-
-2002-06-01 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el:
- * made action case insensitive in erc-nick-popup and added a more descriptive
- error message
-
-2002-05-30 Brian P Templeton <bpt@tunes.org>
-
- * erc.el:
- Removed multiple calls of `erc-prompt' in `erc-display-prompt'
-
-2002-05-29 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- First step timestampkiller cleanup. I'm tired, do the rest tomorrow.
-
- * erc.el:
- New functionality: Catch channel/server buffer kills through kill-buffer-hook.
- Currently, it only does a PART if you kill a channel buffer.
-
-2002-05-28 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- defvar'ed some buffer-local variables to make elint at least a bit more happy.
- Moved comments into docstrings.
- Changed some instances of member to memq.
-
- * erc-track.el, erc.el:
- erc.el: (erc-message-type-member): New function, used to test
- for message type. Require erc-parsed text-property.
- erc-track.el: erc-track-exclude-types: New variable. Defaults to ("JOIN" "PART") right now for testing, it should eventually set to nil soon again.
- (erc-track-modified-channels): Use above fun and var to optionally exclude certain message types from channel tracking.
-
-2002-05-28 Diane Murray <disumu@x3y2z1.net>
-
- * CREDITS: added myself, vain as it sounds ;)
-
-2002-05-25 Mario Lang <mlang@delysid.org>
-
- * erc.el: * Some small docstring fixes
- * (erc-display-line): Now takes also a process object in the buffer argument.
- Used for easy sending to the server buffer.
- * Several places: Just pass proc, not (process-buffer proc)
-
-2002-05-24 Mario Lang <mlang@delysid.org>
-
- * erc.el: Mostly docstring fixes/additions
-
- * erc-netsplit.el: Doc fixes, and a new netjoin-done message.
-
- * erc-fill.el: Doc fixes, erc-fill custom group, autoloads.
-
- * erc-netsplit.el: Fix to erc-netsplit-timer.
-
- * erc-netsplit.el: Fixed a silly typo
-
- * erc-maint.el: is this really necessary?
-
- * erc.el: Added new variable erc-hide-list.
- It affects erc globally right now, and is used to hide certain IRC type messages like JOIN and PART.
-
- * Makefile: Doh, I should really test this before checkin :)
-
- * Makefile: Silly cut&paste bug fixed
-
- * erc-list.el: Added autoload cookie
-
- * erc-match.el: Added missing require erc.
-
- * erc-notify.el: Autoload cookies and a -initialize function.
-
- * erc-chess.el: Added autoload cookies
-
- * Makefile: Finally, we have a Makefile.
- Primarily used for autoload definition generation right now.
-
- * erc-auto.in: First version.
-
- * erc-track.el: Added autoload cookie
-
- * erc-netsplit.el:
- New module, used to autodetect and hide netsplits.
- (Untested, no netsplit happened yet :) )
-
- * erc-nets.el: Added some old code I once worked on.
- Added autoload cookie
-
-2002-05-24 Diane Murray <disumu@x3y2z1.net>
-
- * erc-fill.el:
- removed reference in documentation to old variable, changed it to the new one
-
- * erc.el:
- * added new function erc-connection-established which is called after receiving
- end of MOTD (does nothing if it's been called before)
-
- * added new hook erc-after-connect which is called from
- erc-connection-established with the arguments server (the announced server)
- and nick - which other arguments should be sent??
-
- * added buffer variable erc-connected which is set to t the first time
- erc-connection-established is called, set to nil again if we've been
- disconnected
-
- * set initial user mode
- - added custom variable erc-user-mode which can be a string or a function
- which returns a string
- - new function erc-set-initial-user-mode gets called from
- erc-connection-established
-
-2002-05-22 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: fixed bug where prompt was missing after reconnect
-
-2002-05-21 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- in erc-nickserv-identify: if network is unknown, just use "Nickserv"
-
- * erc.el: * fixed some typos
-
- * timestamping
- - ctcp request messages and replies now have timestamp
- - timestamps in front of error messages now in timestamp face
- - added timestamp to more error messages
-
- * ctcp reply messages, server ping message updated
-
- * added variable erc-verbose-server-ping - check this instead of erc-paranoid
-
- * added whowas on no such nick:
- - added variable erc-whowas-on-nosuchnick
- - in erc-server-401 do WHOWAS if erc-whowas-on-nosuchnick is non-nil
-
- * erc.el: forgot documentation for erc-nickserv-alist
-
- * erc.el: NickServ identification changed and enhanced:
- - erc-nickserv-identify-autodetect now called from erc-server-NOTICE-hook
- - now possible to identify automatically without prompt:
- - added custom variables erc-prompt-for-nickserv-password and
- erc-nickserv-passwords
- - added erc-nickserv-alist containing the different networks' nickserv details
- - added function erc-current-network to determine the network symbol
- - fixed bug where identification on dalnet didn't work, because they now
- require NickServ@services.dal.net
- now sends to all NickServ with nick@server where possible
-
-2002-05-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc-fill.el:
- * filling with erc-fill-variable now works with custom defined fill width:
- - changed erc-fill-column from defvar to defcustom
- - in erc-fill-variable: set fill-column to value of erc-fill-column
-
- * erc.el: erc.el:
- * fixed bug where topic wasn't being set when channel name was provided
-
- erc-fill.el:
- * filling with erc-fill-variable now works with custom defined fill width:
- - changed erc-fill-column from defvar to defcustom
- - in erc-fill-variable: set fill-column to value of erc-fill-column
-
-2002-05-16 John Wiegley <johnw@gnu.org>
-
- * erc.el: whitespace fix
-
-2002-05-15 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- * added explanation of empty string working in erc-quit-reason-various-alist
- * removed the text property from erc-send-message, it caused problems
- with /SV (as noticed by gbvb on IRC) and is obviously not needed
- * when receiving a ctcp query, convert type to uppercase to allow for
- "/ctcp nick time" and not just "/ctcp nick TIME"
- * timestamp in front of server notices now shown in the timestamp face
-
-2002-05-13 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el:
- - in erc-format-privmessage: `erc-format-timestamp' added to message after
- message's text properties are applied so that it doesn't lose its face
-
- - /quit without reason now works when `erc-quit-reason' is set to
- `erc-quit-reason-various' and the empty string "" is defined in
- `erc-quit-reason-various-alist'
-
-2002-05-13 Andreas Fuchs <asf@void.at>
-
- * erc-bbdb.el:
- * Applied Drewies patch to pop-up on nick changes when -popup-type is 'visible
-
-2002-05-12 Andreas Fuchs <asf@void.at>
-
- * erc-bbdb.el, erc.el:
- * erc-bbdb.el: pop up the buffer on /whois when erc-bbdb-popup-type is 'visible
- * erc.el: fix for empty quit reason problem by drewie.
-
-2002-05-12 Mario Lang <mlang@delysid.org>
-
- * erc.el: disumu nick patch
- - added erc-show-my-nick (default t)
- if t, show nickname like <nickname>
- if nil, only show a > character before the message
- - added faces erc-nick-default-face and erc-nick-msg-face
- - nicknames (channel, msgs, notices) are now in bold face by default
- - the msg face matches the erc-direct-msg-face color
-
-2002-05-10 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-send-pre-hook): Doc change.
-
- * CREDITS: Alexander L. Belikoff is confirmed original author.
-
-2002-05-10 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- timestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumu
-
-2002-05-09 Mario Lang <mlang@delysid.org>
-
- * erc.el: *** empty log message ***
-
-2002-05-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- New var: erc-echo-notices-in-minibuffer-flag. defaults to t.
-
-2002-05-04 John Wiegley <johnw@gnu.org>
-
- * TODO: *** empty log message ***
-
-2002-05-03 Alex Schroeder <alex@gnu.org>
-
- * erc.el: Copyright notice, version string updates.
-
-2002-05-02 Alex Schroeder <alex@gnu.org>
-
- * erc.el: Comment: dme is David Edmondson
-
-2002-05-01 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-warn-about-blank-lines): New option.
- (erc-send-current-line): Use it.
- (erc-quit-reason-various-alist): New option.
- (erc-quit-reason): New option.
- (erc-quit-reason-normal): New function.
- (erc-quit-reason-zippy): New function.
- (erc-quit-reason-various): New function.
- (erc-cmd-QUIT): Use them.
-
-2002-04-30 Alex Schroeder <alex@gnu.org>
-
- * erc.el: Version 2.92
-
- * erc.el(erc-send-modify-hook): Default value is nil.
-
-2002-04-27 John Wiegley <johnw@gnu.org>
-
- * erc.el:
- Don't redisplay the prompt if the ERC buffer is no longer alive.
-
-2002-04-26 John Wiegley <johnw@gnu.org>
-
- * erc.el:
- Don't call `set-buffer' on old-buf unless the buffer is valid. It's
- often not when separate frames are being used.
-
-2002-04-23 Mario Lang <mlang@delysid.org>
-
- * erc-button.el: fixed up erc-nick-regexp
-
-2002-04-22 Brian P Templeton <bpt@tunes.org>
-
- * erc.el:
- `erc-prompt' may now be a function that returns a string (which is
- used as the prompt). I don't use Customize but I think customization
- of it may be broken if it's not a string.
-
- There is a new `erc-prompt' function that returns the prompt as a
- string (e.g., returning either the result of `(funcall erc-prompt)' or
- `erc-prompt').
-
- This allows for dynamic prompts, such as a LispWorks-like prompt, or
- one containing simply the current channel name. It was requested by
- Mojo Nichols (nick michols) in #emacs today, 21-Apr-2002; cf. the
- #emacs logs at <URL:http://www.tunes.org/~nef/logs/emacs/02.04.21.
-
-2002-04-17 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- fix erc-send-current-line to work on empty lines again (without sending the prompt)
- Fix C-c C-t to not include the nick/time info
- (both from antifuchs)
-
- * erc-complete.el: Fix for xemacs elt behavior
-
-2002-04-17 John Wiegley <johnw@gnu.org>
-
- * erc-chess.el:
- Added a missing arg in a call to erc-chess-handler.
-
-2002-04-15 John Wiegley <johnw@gnu.org>
-
- * erc-chess.el: *** empty log message ***
-
-2002-04-14 John Wiegley <johnw@gnu.org>
-
- * erc-chess.el: *** empty log message ***
-
-2002-04-12 John Wiegley <johnw@gnu.org>
-
- * erc-chess.el: *** empty log message ***
-
- * erc-chess.el: bug fixes
-
- * erc-chess.el: *** empty log message ***
-
-2002-04-12 Mario Lang <mlang@delysid.org>
-
- * erc-chess.el: change order.
-
- * erc-chess.el: more fixing.
-
- Now, the 'match question works. It sends an accept back.
- But display popup doesn't work..
-
- * erc-chess.el: fixup (still far from working)
-
-2002-04-11 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Added :options entry for erc-mode-hook (erc-add-scroll-to-bottom)
-
-2002-04-11 John Wiegley <johnw@gnu.org>
-
- * erc.el: remove trailing \n from any sent text
-
- * servers.pl, erc-bbdb.el, erc-button.el, erc-chess.el,
- erc-complete.el, erc-fill.el, erc-ibuffer.el, erc-list.el,
- erc-match.el, erc-menu.el, erc-nets.el, erc-replace.el,
- erc-speak.el, erc-speedbar.el, erc-track.el, erc.el:
- clean whitespace
-
- * erc.el: Replaced erc-scroll-to-bottom.
-
-2002-04-11 Mario Lang <mlang@delysid.org>
-
- * erc-track.el:
- try to fix behavior when used with different frames.
-
-2002-04-09 Mario Lang <mlang@delysid.org>
-
- * erc-chess.el:
- fixup release, far from ready for real usage, but it appears to work.
-
- * erc.el:
- speed improvements based on elp-instrument-package RET erc- RET results
-
- * erc-chess.el: initial version.
- please test it
- Get chess.el from johnw's cvs:
- cvs -d:pserver:anonymous@alice.dynodns.net:/usr/local/cvsroot login
- cvs -d:pserver:anonymous@alice.dynodns.net:/usr/local/cvsroot co chess
-
- (as usual, blank password)
-
- Add the resulting dir to your load-path and require erc-chess.
-
- Usage: Just do /chess nickname
- The remote end much use erc, as no other irc client I know of supports this ...
-
- See erc-chess-default-display and maybe set it to chess-images or chess-ics1 if you prefer those over chess-plain.
- Also, see erc-chess-user-full-name to set the name you use in chess games.
-
-2002-04-04 Mario Lang <mlang@delysid.org>
-
- * erc.el: New hackery latenightwise
-
- * erc.el: upupadowndowncase
-
-2002-04-04 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog: Updated for the new snapshot
-
- * debian/rules: Install README.Debian into the package
-
- * debian/README.Debian: Initial check-in
-
-2002-04-04 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fixed that /me in query buffers ended up in server buffer
-
- * erc.el: * Implemented joining +k channels
-
-2002-03-14 Mario Lang <mlang@delysid.org>
-
- * erc.el: New utility function: erc-channel-list
- minor fix to erc-get-buffer. hopefully that helps shapr
-
-2002-03-12 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- New /command: /QUOTE for sending directly to the IRC server
- Removed erc-fill from erc-insert-modify-hook. To activate filling, simply customize that var.
-
-2002-03-09 Brian P Templeton <bpt@tunes.org>
-
- * CREDITS: *** empty log message ***
-
-2002-03-09 Mario Lang <mlang@delysid.org>
-
- * erc-complete.el:
- New variable: erc-nick-completion-ignore-case. Defaults to t.
-
- * erc-track.el:
- * erc-track-shorten-name-function can now be set to nil to avoid treating of channel names at all.
-
-2002-03-06 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog, debian/rules: update to new snapshot
-
-2002-03-06 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fixed nasty bug which prevented channel limit from correctly display/handling
-
- * erc-track.el: Made shortening code highly customizable.
- Now, there is the variable erc-track-shorten-function which holds
- a function which gets called with one argument, CHANNEL-NAMES, which is a list
- of strings of the channel names.
- It needs to return a list of strings of the same length with the modified values...
-
- * erc-track.el:
- Added erc-track-shorten-aggressively, default to nil
- if it is set to t, erc will shorten a bit more.
- if nil, erc will shorten the name only if it would get shorter than just
- one char...
-
- * erc-speak.el: added iirc to the abbreviation expansion list.
-
- * erc-track.el:
- Added customization variable: erc-track-use-faces. defaults to t.
-
- * erc-track.el: *** empty log message ***
-
- * erc-track.el:
- experimental: Added face support to mode-line channel activity tracker.
- Currently we use the faces used for indicating in the buffer (erc-pal-face for channels with pal activity...)
-
-2002-03-05 Mario Lang <mlang@delysid.org>
-
- * erc-complete.el: * added docfixes (thanks ore)
-
- * erc-track.el: Fixed channel-name reduction.
- thanks again alex.
- Renamed the vars to erc-track-opt-start and erc-track-opt-cutoff.
-
- * erc.el: fixed another silly error
-
- * erc-track.el: Implemented channel name shortening.
- Vars erc-track-cutoff says: all channel names longer than this will be shortened.
- Var erc-track-minimum-channel-length says: don't make names shorten than this.
- (Thanks go out to kensanata for the nice unique-substrings utility function).
-
- * erc.el 2002-07-15T00:01:34Z!raeburn@raeburn.org: silly typo corrected
-
- * erc.el: * erc.el: * New variable: erc-common-server-name-suffixes
- This alist can be used to change the server names displayed in mode-line
- to a shorter version..
- * New function: erc-shorten-server-name (uses var above)
- * Changed erc-prepare-mode-line to use erc-shorten-server-name.
-
-2002-02-25 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- CTCP handling rewritten. Seems to work. please test and report probs.
-
-2002-02-24 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fixed emacs20 backward compatibility (new defun/alias: erc-propertize)
-
-2002-02-22 Mario Lang <mlang@delysid.org>
-
- * erc-button.el: *** empty log message ***
-
-2002-02-21 Mario Lang <mlang@delysid.org>
-
- * erc-button.el, erc.el:
- minor fixup related to read-only prompts and command renaming.
-
-2002-02-21 Andreas Fuchs <asf@void.at>
-
- * erc.el: * modify `erc-remove-text-properties-region' to work.
- Could even be a little faster now. (-:
-
-2002-02-21 Mario Lang <mlang@delysid.org>
-
- * erc-ring.el:
- fixed erc-replace-command to behave right when text is read-only.
- Also, use erc-insert-marker and (point-max) now.
-
- * erc.el: * Made erc-prompt read-only
- * new function: erc-make-read-only. Can be used on erc-insert-post-hook and erc-send-post-hook to ensure read-only buffer text too
-
-2002-02-19 Mario Lang <mlang@delysid.org>
-
- * erc-list.el: added comment to docstring
-
- * erc-speak.el: minor updates, use erc-nick-regexp now
-
- * erc.el:
- ensure that erc-timer-hook is called inside the server-buffer.
-
-2002-02-19 Andreas Fuchs <asf@void.at>
-
- * erc-match.el:
- * Probably fixed the "number-char-or-marker-p: nil" bug.
-
-2002-02-19 Mario Lang <mlang@delysid.org>
-
- * erc-notify.el: Initial release.
-
- * erc.el: added #303 handling
- moved timer and added an arg (erc-current-time)
-
- * erc-list.el, erc.el:
- slightly changed the erc-once-with-server-event macro
-
- * erc-button.el: erc-button-alist: doc fix and custom type fix
-
-2002-02-18 Mario Lang <mlang@delysid.org>
-
- * erc-list.el, erc.el: new macro: erc-once-with-server-event
- erc-list.el: use it
-
- * erc-match.el:
- Minor fix related to hook call method change (-until-seccess now)
-
- * erc.el: fixed ctcp behavior abit (with auto-query on)
-
- * erc-list.el: ChanList mode.
- Load it, and type M-x erc-chanlist RET
- Demonstrates how the new hook system can be nicely used.
-
- * erc.el:
- new hook: erc-default-server-hook. This one gets called if we don't have anything defined for a certain IRC server message.
- New function: erc-default-server-handler. (used by above hook).
- New function: erc-debug-missing-hooks: Used by above hook to save a list of unimplemented server messages.
- New function: erc-server-buffer, erc-server-buffer-p.
- Various places: use it.
- Minor fixup.
-
- * erc-button.el: fix regexp to not buttonize ~user@host hostnames
-
-2002-02-17 Mario Lang <mlang@delysid.org>
-
- * erc-complete.el, erc.el: Eliminated erc-command-table
- 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!)
- e.g. /help auto-q
- fixed autoloads for erc-add-pal and so on to be interactive.
-
-2002-02-17 Andreas Fuchs <asf@void.at>
-
- * erc-match.el:
- * Fix unfunctional code in `erc-get-parsed-vector-type'.
-
- * erc-bbdb.el, erc-button.el, erc-match.el, erc.el:
- * Be careful: MANY changes ahead. I won't go into too much details.
-
- * erc.el, new file erc-match.el: split out all pattern-matching code.
- * erc.el: removed all defcusts for erc-{...}-highlight-props. They are
- quite useless, anyway.
- * moved erc-add-entry-to-list and -remove- over to erc-match. changed
- their arg list.
- * erc.el: add autoloads for erc-{add,delete}-{keyword,pal,fool,dangerous-host}
- * erc.el: erc-server-PRIVMSG-or-NOTICE:
- - remove all the highlighting crap
- - add a (when (eq s nil) ...) so that untreated CTCP messages don't
- get misdisplayed.
- * erc.el: erc-mark-message: removed this function, it's useless
- * erc.el: minor bugfixes.
-
- * erc-match.el: first checkin. This file now contains all the pattern
- matching stuff. there is now another defcust group, erc-match,
- containing all match related stuff (erc-keywords, ...)
- * erc-match.el: added functionality to log matching lines. Quite
- customizable, check out the docstring of defun erc-log-matches
- * erc-match.el: added functionality to make foolish messages
- invisible/intangible. This could replace erc-ignore-list
- sometime. it's more powerful right now, anyway.
- * erc-match.el erc-text-matched-hook: new hook. run when Text matches
- anything (pal, fool, etc.).
-
- * erc-button.el: Make nick buttonization customizable.
- * erc-button.el: Give nick buttonization a lower priority so that it
- does not break url buttons.
-
- * erc-bbdb.el: Add \n to the separators by which we split nicknames.
-
-2002-02-17 Mario Lang <mlang@delysid.org>
-
- * TODO: Added item
-
-2002-02-17 Brian P Templeton <bpt@tunes.org>
-
- * CREDITS, erc.el: Added invisible timestamp support.
-
-2002-02-16 Gergely Nagy <algernon@debian.org>
-
- * debian/changelog, debian/rules, debian/scripts/install:
- updated to new snapshot
-
-2002-02-16 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fixed channel limit format overflow in mode-line display.
- (Having to use floats if integers are to large is quite strange, isn't it?)
-
- * TODO: TODO list created.
- Add comments and expand it.
-
- * erc.el:
- Fixed bug in query buffer handling (only happend in mixed-case situations)
-
- * erc.el: shapr checkdoc patch #1
- massive docfixes! yay, keep going!
-
-2002-02-15 Mario Lang <mlang@delysid.org>
-
- * erc.el: various other fixes
- make s301 a catalog entry
-
-2002-02-15 Andreas Fuchs <asf@void.at>
-
- * erc.el: * erc-server-NICK and erc-server-INVITE: fixed to use
- `erc-display-message'. These I missed in the first checkin. I
- didn't say it in the last log message, but please test these.
-
- * erc-fill.el, erc.el:
- * erc.el: updated many functions to use `erc-display-message'. Now, we
- should go for getting highlighting out of
- erc-server-PRIVMSG-or-NOTICE. The part I want to attack has been
- marked.
- * erc-fill.el: updated static filling to leave the erc-parsed property alone.
-
-2002-02-15 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- first step, new function: erc-display-message
-
- * erc.el: added numreply 379 and 405.
-
- * erc.el: stupid typo fixed
-
- * erc.el:
- Finally renamed erc-frame-dedicated-p to erc-frame-dedicated-flag
- Removed usage of erc-interpret-controls from info buffer drawing (major speedup)
- Other speedups based on the results from elp.
- ERC is now about 300%-500% faster in some situations with very full channels!!!!!
-
-2002-02-14 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * erc-downcase now downcases {}|^ with []\~ -- 'stolen' from zenirc.
- * various checkdoc fixes. Just the upper third of the file, but that
- should help a little, too. (-: Again, if you have any writing
- skills, take out that dusty keyboard and tap it to the beat of M-x
- checkdoc!
-
-2002-02-14 Gergely Nagy <algernon@debian.org>
-
- * erc.el(erc-format-privmessage):
- fix it, so timestamp-coloring works again (patch from antifuchs)
-
-2002-02-14 Mario Lang <mlang@delysid.org>
-
- * erc.el: Many fixes based on M-x checkdoc RET.
- If you have write access, and some english knowledge, help document erc too!
- M-x checkdoc RET, and follow the instructions.
-
- * erc-button.el, erc-ibuffer.el: minor fixes
-
- * erc.el: Use nreverse instead of reverse.
- Use eq instead of equal where possible.
- Rewrote erc-get-buffer to not use find-if (find-if does very deep function-call nesting, which isn't good in a defun which is called so often)
-
-2002-02-13 Mario Lang <mlang@delysid.org>
-
- * erc-button.el, erc.el:
- In erc.el, new hook: erc-channel-members-changed-hook.
- erc-button.el: Now highlight all nicknames. uses regexp-opt.
-
-2002-02-04 Mario Lang <mlang@delysid.org>
-
- * erc-nets.el:
- Database of irc networks. Use erc-server-select to interactively select one.
-
- * erc.el: * erc-format-nick-function: New variable.
- * (erc-format-nick): The default for above var. Just return the nick.
- * (erc-format-@nick): Prefix NICK with @ or + if OP or VOICE.
- * Removed erc-track-modified-channels related code and moved into erc-track.el
- Its auto-loaded now
-
- * erc-track.el: Split code from erc.el
-
-2002-02-01 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el:
- * erc-target now uses erc-port-to-string
-
- * servers.pl:
- Script to convert mircs servers.ini to a elisp salist kind of thing.
- (development tool, it doesn't help you much as a user)
-
- * erc.el:
- * erc-display-line-buffer: renamed to erc-display-line-1
- * erc-port-equal: New function.
- * erc-normalize-port: Used by erc-port-equal
- * minor docstring fixes
-
-2002-02-01 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * erc-already-logged-in-p: compare ports is more robust now.
-
- * erc-button.el: * Add buttonization to erc-send-modify-hook, too
-
-2002-01-31 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Use insert-before-markers instead of insert in erc-display-line-buffer
- This fixed point@column 0 problem and gives us some speedup! yay
-
- * erc-ibuffer.el, erc.el: minor fixes
-
- * erc.el:
- * (erc-line-beginning-position): Renamed to erc-beg-of-input-line.
- * (erc-line-end-position): Renamed to erc-end-of-input-line.
- * erc-multiline-input-p: Variable removed.
-
- * erc.el:
- Minor docstring fixes (using M-x checkdoc-current-buffer)
- If you find time, and you are native english speaker, do that too!!
-
- * erc.el: fixed macro-invocation
-
-2002-01-31 Andreas Fuchs <asf@void.at>
-
- * erc.el: * erc-with-all-buffers-of-server: use erc-list-buffers
- * erc-process-away, erc-{save,kill}-query-buffers: use it.
- * erc-cmd-away-all: new command. Set away/back on all servers.
-
- * erc.el:
- * Fix last multiline bug in erc-send-distinguish-noncommands.
-
-2002-01-31 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el, erc.el: minor fixes
-
-2002-01-30 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el, erc-menu.el, erc-speak.el, erc.el:
- Renamed erc-track-modified-channels-minor-mode to erc-track-modified-channels-mode (at least, its a bit shorter)
- Added docstring to erc-server-hooks (through the macro)
- Minor docfix in obsolete hook
-
-2002-01-30 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * erc-send-current-line: fix behavior where buffer changes.
- * erc-mark-message: fix stupid face bug. highlighting of pals should work now.
-
- * erc-ring.el, erc.el:
- * new hooks: erc-send-pre-hook, erc-send-modify-hook, erc-send-post-hook
- * erc-send-this: new variable
- * erc-noncommands-list: new constant.
- * erc-send-distinguish-noncommands: use it. (First filter function for sending! yay!)
- * erc-send-current-line: nearly completely rewritten.
- - now handles multiline input. (yay!)
- - now uses the three hooks from above.
- * erc-process-line: new arg, no-command: don't process this line as a command.
-
-2002-01-30 Mario Lang <mlang@delysid.org>
-
- * erc-bbdb.el, erc-button.el, erc-speak.el, erc.el:
- hook handling rewrite phase 1.
-
-2002-01-30 Andreas Fuchs <asf@void.at>
-
- * erc.el: * Rework erc-server-PRIVMSG-or-NOTICE
- * New function: erc-is-message-ctcp-p
- * New function: erc-format-privmessage
- * New function: erc-mark-message
- * erc-server-PRIVMSG-or-NOTICE: use them.
-
-2002-01-30 Mario Lang <mlang@delysid.org>
-
- * CREDITS, HISTORY:
- Initial checkin.
-
-2002-01-29 Andreas Fuchs <asf@void.at>
-
- * erc.el: * erc-put-text-properties: make OBJECT optional
- * erc-put-text-property: same
- * erc-server-PRIVMSG-or-NOTICE: use them.
- * Make erc-display-line-buffer: add the "\n" even when the string would be invisible.
- * same: make the \n invisible, too (:
-
-2002-01-29 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el, erc.el:
- Rewrote channel tracking using window-configuration-change-hook instead of defadvices.
-
-2002-01-28 Andreas Fuchs <asf@void.at>
-
- * erc-fill.el, erc.el:
- * Macro define-erc-highlight-customization: Ease up defining
- erc-{fool,pal,..}-highlight-props defcusts.
- * defcusts:
- - erc-fool-highlight-props
- - erc-pal-highlight-props
- - erc-dangerous-host-highlight-props
- - erc-keyword-highlight-props
-
- Customizable to either nil or "Hide message".
- * erc-string-invisible-p: check for invisible chars in string
- * erc-display-line-buffer: use it.
- * erc-put-text-properties: put a list of props into a piece of text.
- * erc-server-PRIVMSG-or-NOTICE: use it; set appropriate
- highlight-props for entire incoming message. This set of changes
- allows you to e.g. auto-ignore fools.
-
-2002-01-28 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el:
- Added highlight detection support to the Mark column.
- Now p, k, f, and d indicate pal, keyword, fool and dangerous-host related activity.
-
- * erc.el:
- Highlight tracking finished. All necessary info should now be in erc-modified-channels.
-
- * erc.el, erc-ibuffer.el, erc-speedbar.el:
- Added highlight tracking to track-modified-channels
- no display code yet, the info is just kept in erc-modified-channels
- Added erc-modified column to ibuffer
- speedbar update
-
- * erc-ibuffer.el: Added erc-members column
-
- * erc-ibuffer.el: *** empty log message ***
-
-2002-01-28 Andreas Fuchs <asf@void.at>
-
- * erc-bbdb.el:
- * Fix a slight typo. The hook function should be called in
- erc-server-376-hook (-:
-
-2002-01-28 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el: *** empty log message ***
-
-2002-01-27 Mario Lang <mlang@delysid.org>
-
- * erc-ibuffer.el: Fixup, it sort of works now. Try it
-
- * erc-ibuffer.el: Initial version
-
-2002-01-26 Mario Lang <mlang@delysid.org>
-
- * erc.el: *** empty log message ***
-
-2002-01-25 Andreas Fuchs <asf@void.at>
-
- * erc-bbdb.el: * fix two bad things:
- - fix the "proc trick": pass proc as an arg through
- ...-insinuate-... to ...-show-entry
- - hook highlighting into the 376 hook. This one is bound to get
- called (-:
- * We now only append to hooks only.
- * Highlighting of changing records gets updated automatically.
-
-2002-01-25 Mario Lang <mlang@delysid.org>
-
- * erc.el: *** empty log message ***
-
-2002-01-25 Andreas Fuchs <asf@void.at>
-
- * erc-bbdb.el: * nearly complete rewrite of erc-bbdb:
- - Removed code duplication in erc-bbdb-NICK and -JOIN.
- - Made erc-bbdb-show-entry more general and intelligent.
- - erc-bbdb-insinuate-entry is now erc-bbdb-insinuate-and-show-entry
- (note the different arglist!):
- - erc-search-name-and-create now creates "John Doe" users if name
- is not specified.
- - No sign of "mail" anywhere anymore. It's all finger-host. (-:
- - erc-bbdb-popup-p is now called erc-bbdb-popup-type.
- - New customize values:
- . erc-bbdb-irc-channel-field channel field name
- . erc-bbdb-irc-highlight-field (see below)
- . erc-bbdb-auto-create-on-nick-p auto-create record on join
-
- * Highlighting based on BBDB is now here! Specify which type of
- highlighting a person in the BBDB (whose nick you know) and have
- fun! Read help to erc-bbdb-init-highlighting for details. Changes:
- - new function erc-bbdb-init-highlighting: gets called on server
- connect.
- - new function erc-bbdb-highlight-record: highlights a person's
- nick names.
-
-2002-01-24 Andreas Fuchs <asf@void.at>
-
- * erc-button.el:
- * Fix the erc-button-alist regexp for EmacsWiki stuff. delYsid's version
- is better (-:
-
- * erc-button.el: * Added an Ewiki: specifier to the url-regexp.
- <nickname> EmacsWiki: EmacsIRCClient tells you <bla>
- should highlight "EmacsWiki: EmacsIRCClient" and allow you to
- browse to the wiki when the button is activated.
- * new custom: erc-emacswiki-url.
- * new function: erc-browse-emacswiki: use it.
-
-2002-01-23 Mario Lang <mlang@delysid.org>
-
- * erc-bbdb.el:
- erc-bbdb-NICK: Added regexp-quote around fingerhost search.
-
-2002-01-10 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * Channel saving/killing on quit from server implemented:
- - defcust erc-save-queries-on-quit: Save server's channel buffers on quitting from server
- - defcust erc-kill-queries-on-quit: Kill server's channel buffers on quitting from server
- - Macro erc-with-all-buffers-of-server: Run a form inside all the server's query buffers
- - Functions erc-{kill,save}-query-buffers: use it.
- * Added indent-tabs-mode: t to Local Variables section.
-
-2002-01-07 Andreas Fuchs <asf@void.at>
-
- * erc-replace.el: * fix stupid documentation errors.
-
-2002-01-07 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (toplevel): Revert previous change. This resulted ina recursive load...
- You have to put (require 'erc-button) into your .emacs for now
-
-2002-01-05 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * Added require for erc-button. This is devel. so I need testers :)
-
- * erc-button.el: * Added proper file headers (GPL).
-
-2002-01-04 Mario Lang <mlang@delysid.org>
-
- * erc-button.el: * erc-button-alist: Added entry for finger
-
- * erc-button.el: * Removed bogus usage of :button-keymap.
- P
- Does anyone know what this was supposed to do anyway?
-
- * erc-button.el: * Initial version.
- * This module allows a way of buttonizing text in IRC buffers.
- Default it is used for URLs, but other things could be added.
- see if you can find another use, erc-button-alist
-
-See ChangeLog.01 for earlier changes.
-
- Copyright (C) 2002, 2006-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
diff --git a/lisp/erc/ChangeLog.03 b/lisp/erc/ChangeLog.03
deleted file mode 100644
index c8dd1a3811c..00000000000
--- a/lisp/erc/ChangeLog.03
+++ /dev/null
@@ -1,2163 +0,0 @@
-2003-12-30 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-cmd-HELP):
- Changed to prefer giving help for erc-cmd-* functions over
- similarly-named Elisp functions (e.g., erc-cmd-LIST vs. list).
-
-2003-12-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-query-buffer-p): Added this function.
-
-2003-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-cmd-SV): Use erc-emacs-build-time.
-
- * erc-compat.el: erc-emacs-build-time: New variable.
-
- * erc.el(erc-cmd-SAY):
- Reintroduced the feature where the spaces between
- "/SAY" and the rest of the line were being sent with the message.
-
-2003-12-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-server-buffer-p):
- Fixed a bug where this function sometimes would return
- nil when it should return t.
-
-2003-12-27 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-generate-new-buffer-name):
- Really fixed a bug where ERC would reuse
- a connected server buffer when erc-reuse-buffers is non-nil.
- (erc-cmd-JOIN): Now we tell the user when he attempts to join the same
- channel twice on the same server.
-
- * erc.el(erc-generate-new-buffer-name):
- Fixed a bug where ERC would reuse a connected server buffer when erc-reuse-buffers is non-nil.
-
- * erc.el(erc-cmd-SAY):
- Fixed a bug where the spaces between "/SAY" and the rest of the
- line were being sent with the message.
-
- * erc-list.el: Fixed another typo.
-
- * erc-list.el: Fixed a typo.
-
- * erc-list.el:
- Added text to the top of the channel list buffer describing the keybinding for
- function erc-chanlist-join-channel.
-
- * erc-list.el: Minor appearance changes. No functional change.
-
- * erc-list.el:
- Implemented function erc-chanlist-join-channel. Added variable
- erc-chanlist-channel-line-regexp. Got rid of function
- erc-chanlist-pre-command-hook. Changed the logic for how channel lines are
- highlighted.
-
-2003-12-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el:
- Removed a bunch of unused code. No semantic change.
-
- * erc-list.el: Added lots of functionality.
-
-2003-12-15 Mario Lang <mlang@delysid.org>
-
- * erc-track.el, erc.el:
- New custom type erc-message-type, use it in erc-hide-list and erc-track-exclude-types
-
-2003-12-14 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(track-when-inactive): New module.
- (erc-track-visibility): New option.
- (erc-buffer-activity): New variable.
- (erc-buffer-activity-timeout): New variable.
- (erc-user-is-active): New function.
- (erc-buffer-visible): New function.
- (erc-modified-channels-update): Replace get-buffer-window call
- with call to erc-buffer-visible.
- (erc-track-modified-channels): Ditto.
-
-2003-12-14 Lawrence Mitchell <wence@gmx.li>
-
- * erc-track.el(erc-modified-channels-update):
- Force update of modeline. Makes sure
- that the tracked channels disappear in other buffers too.
-
-2003-12-06 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el(define-erc-module):
- New optional argument LOCAL-P. If non-nil, then
- mode will be created as buffer-local rather than a global mode.
- (erc-cmd-CTCP): Fix indentation from last commit.
-
- * erc-compat.el(erc-define-minor-mode):
- Deal with :global and :group keywords.
-
- * erc-nickserv.el(erc-current-network):
- Make server regex more permissive.
-
- * erc.el(erc-cmd-CTCP):
- Don't add a space to end of command when ARGS are
- empty. This fixes a bug whereby requests of the form "VERSION " were
- being sent, and ignored.
-
-2003-11-27 Lawrence Mitchell <wence@gmx.li>
-
- * erc-log.el: From Adrian Aichner <adrian@xemacs.org>
- * erc-log.el (erc-log-file-coding-system): Use 'binary
- coding-system under XEmacs (instead of 'emacs-mule).
- * erc-log.el (erc-w32-invalid-file-characters): Removed as no
- longer needed.
- * erc-log.el (erc-generate-log-file-name-long): Use
- `convert-standard-filename', which exists in XEmacs too.
-
-2003-11-16 Mario Lang <mlang@delysid.org>
-
- * erc-identd.el: Code provided by johnw, thanks!
-
-2003-11-09 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el(erc-latest-version): Clean up docstring.
- Remove requirement for w3, wrap REQUIRE statement in IGNORE-ERRORS.
- Update viewcvs url to correct location.
- (erc-ediff-latest-version): Make sure that we find the uncompiled
- erc.el, error if not.
-
-2003-11-07 Mario Lang <mlang@delysid.org>
-
- * erc.el: Add more info to /sv
-
-2003-11-06 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el: Added optional argument BUFFER to erc-server-buffer-p.
-
-2003-11-04 Mario Lang <mlang@delysid.org>
-
- * AUTHORS: Add sachac
-
-2003-11-02 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el(erc-server-366):
- chnl is 4th element of parsed, not fifth.
- (erc-channel-end-receiving-names): Pass correct number of arguments
- to delete-if-not.
-
- * erc.el(erc-update-current-channel-member):
- Use erc-downcase when comparing
- nick entries. Cleanup indentation.
-
-2003-11-01 Lawrence Mitchell <wence@gmx.li>
-
- * erc-sound.el: Added a (provide 'erc-sound) line.
-
- * erc.el(erc-cmd-NAMES): send to TGT, not CHANNEL.
-
-2003-10-29 Sandra Jean Chua <sacha@free.net.ph>
-
- * erc-pcomplete.el, erc.el, CREDITS:
- Merged Jeremy Maitin-Shepard's patch for time-sensitive nick completion.
-
-2003-10-27 Mario Lang <mlang@delysid.org>
-
- * Makefile, debian/changelog:
- New Debian package 4.0.cvs.20031027
-
-2003-10-25 Mario Lang <mlang@delysid.org>
-
- * erc.el: Fix typo tuncate->truncate
-
-2003-10-24 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: From Stephan Stahl <stl@isogmbh.de>:
- (erc-dcc-send-block): Kill buffer if transfer completed correctly.
-
-2003-10-22 Mario Lang <mlang@delysid.org>
-
- * erc-track.el(erc-track-disable):
- Do not deactivate all advices for `switch-to-buffer',
- just disable the erc specific one. (Bug#217022).
-
-2003-10-18 Lawrence Mitchell <wence@gmx.li>
-
- * erc-log.el(erc-log-file-coding-system): New variable.
- (erc-save-buffer-in-logs): Use it.
-
-2003-10-17 Mario Lang <mlang@delysid.org>
-
- * erc.el(erc-interpret-mirc-color): New boolean defcustom
-
- * erc.el: Do not use -nowait on darwin (thanks johnw)
-
-2003-10-15 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el(define-erc-module):
- Set erc-FOO-mode appropriately in erc-FOO-enable
- and erc-FOO-disable.
-
-2003-10-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-autoaway.el(erc-mode):
- Reset idletime on connect. Fixes an annoying bug which
- flooded the server with always on reconnect.
- (erc-autoway-reset-idletime): Accept optional args so we can hook it
- onto erc-server-001-hook.
-
-2003-10-10 Mario Lang <mlang@delysid.org>
-
- * erc.el(erc-hide-list): Add a nice defcustom type
-
-2003-10-08 Mario Lang <mlang@delysid.org>
-
- * Makefile, debian/changelog, debian/control:
- Debian snapshot 20031008
-
- * erc-speedbar.el:
- Patch from Eric M. Ludlam <eric@siege-engine.com>:
- - (erc-install-speedbar-variables): Add functions list (needs new speedbar?)
- - (erc-speedbar-buttons): Add doc. Clear the buffer
- - (erc-speedbar-sort-channel-members): New function.
- - (erc-speedbar-expand-channel): Call new sort function. Change some visuals.
- - (erc-speedbar-insert-user): Change some visuals based on channel data.
- - (erc-speedbar-line-text, erc-speedbar-item-info): New functions
- Add proper elisp file header.
-
-2003-10-02 Lawrence Mitchell <wence@gmx.li>
-
- * erc-match.el(erc-match-syntax-table): New variable.
- (erc-match-current-nick-p): Use it.
-
- * erc.el(erc-quit-reason-zippy, erc-part-reason-zippy): Use
- `erc-replace-regexp-in-string' rather than
- `replace-regexp-in-string'.
- (erc-command-indicator-face): New face, used to show commands if
- `erc-hide-prompt' is nil and `erc-command-indicator' is non-nil.
- (erc-command-indicator): Clean up doc-string.
- (erc-display-prompt): New optional argument FACE, use this rather
- than `erc-prompt-face' to fontify the prompt if non-nil.
- (erc-send-current-line): Pass in `erc-command-indicator-face' to
- `erc-display-prompt'.
-
- * erc-compat.el(erc-replace-regexp-in-string): New function.
- Alias for `replace-regexp-in-string' on Emacs 21.
- Argument massaging for `replace-in-string' for XEmacs.
-
-2003-09-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-keywords): Removed. Wasn't used by anything.
-
-2003-09-25 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el: ERC-HIDE-PROMPT: add custom group
- ERC-COMMAND-INDICATOR: new variable.
- ERC-COMMAND-INDICATOR: new function.
- ERC-DISPLAY-PROMPT: new argument, PROMPT, used to override default
- prompt.
- ERC-SEND-CURRENT-LINE: pass ERC-COMMAND-INDICATOR to ERC-DISPLAY-PROMPT.
-
-2003-09-24 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-parse-line-from-server):
- Ignore empty lines as required by RFC.
-
-2003-09-17 Mario Lang <mlang@delysid.org>
-
- * erc.el: Add lag time calculation
-
-2003-09-13 Mario Lang <mlang@delysid.org>
-
- * Makefile, debian/README.Debian, debian/changelog:
- New debian release
-
- * erc-notify.el:
- Call erc-notify-install-message-catalogs on load, not on module init
-
- * erc.el(erc-update-modules):
- Use `load' instead of `require'. XEmacs appears
- to have the NOERROR arg only sometimes... Strange
-
- * erc.el: No fboundp if we have a defvar
-
- * erc.el: Properly defvar erc-ping-handler
-
-2003-09-11 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-setup-periodical-server-ping):
- check if erc-ping-handler is
- bound before referencing it
-
-2003-09-10 Mario Lang <mlang@delysid.org>
-
- * erc.el(erc-cmd-NICK):
- Warn about exceeded NICKLEN if we know it.
-
- * erc.el: Make erc-server-PONG obey erc-verbose-server-ping.
- Cancel old `erc-ping-handler' timer when restablishing connection in the same
- buffer.
-
- * debian/changelog, Makefile: New debian snapshot
-
- * erc-dcc.el, erc-xdcc.el:
- Use new function erc-dcc-file-to-name to convert spaces to underscores
-
- * erc-xdcc.el: Add autoload for erc-xdcc-add-file
-
-2003-09-08 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: indent fixes and copyright update
-
- * erc.el:
- erc-send-ping-interval: New defcustom which defaults to 60.
- Every 60 seconds, we send PING now.
- This should fix the "connection silently lost" bug.
- Please test this change extensively, and report problems.
-
-2003-09-07 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-default-coding-system):
- Test for undecided and utf-8
- before setting.
-
-2003-09-01 Mario Lang <mlang@delysid.org>
-
- * erc.el(erc-modules): Add some more symbols to the set
-
- * erc.el(erc-modules): * erc.el(erc-modules): Add :greedy t to the set in
-
- * erc-dcc.el:
- More autoloads which make dcc autoload upon ctcp dcc query received.
-
- * erc-dcc.el(erc-cmd-DCC): Add Autoload.
- (pcomplete/erc-mode/DCC): Ditto, makes DCC autoloadable just by using
- completion.
- Also only offer "send" if fboundp make-network-process.
-
- * erc-autojoin.el: Update copyright
-
- * erc-autojoin.el(erc-autojoin-add):
- Only add the channel if it is not already there.
-
- * erc-notify.el:
- Use `define-erc-module' instead of old `erc-notify-initialize'.
- Now defines the global minor mode erc-notify-mode, and should also
- be controllable via `erc-modules' with symbol `notify'.
-
- * erc.el(erc-modules):
- Fix paren-in-column-zero bug in docstring.
- Add a sort of bogus, but still better :type.
- Add autojoin and netsplit by default.
- (erc-update-modules): Don't barf with an error if `require' fails.
- We can still error out if the mode is not defined.
-
-2003-08-31 Andreas Fuchs <asf@void.at>
-
- * erc.el:
- * make 353 (NAMES reply) output go into the appropriate channel buffer
- (if it exists) or into the active erc buffer (if not).
-
-2003-08-29 mtoledo <mtoledo@confusibombus>
-
- * erc.el:
- Added the variable erc-echo-notices-in-current-buffer to make possible display notices in the current buffer (queries to nickserv/chanserv/memoserv). Defaults to nil so nothing changes from what we have today.
-
-2003-08-29 Mario Lang <mlang@delysid.org>
-
- * erc.el: Fix typo in varname which led to a compiler warning
-
- * AUTHORS: Added lawrence
-
-2003-08-27 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el:
- Set process and file-coding system to 'binary (for Windows)
-
- * erc-stamp.el: Rename custom group erc-timestamp to erc-stamp.
-
-2003-08-07 Lawrence Mitchell <wence@gmx.li>
-
- * erc-fill.el(erc-fill-disable):
- Remove erc-fill, not erc-fill-static from
- erc-insert-modify-hook.
-
-2003-08-05 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-send-current-line):
- Now we display the prompt for previously entered commands
- based on the value of customization variable erc-hide-prompt. This change is
- closely related to the immediate previous version by wencem.
-
-2003-08-04 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el(erc-send-current-line):
- If we're sending a command, don't display
- the prompt.
-
-2003-08-04 Damien Elmes <erc@repose.cx>
-
- * erc-track.el: patch from David Edmondson (dme AT dme DOT org)
-
- This patch makes button 3 on the erc-track buffer names in the
- modeline show the selected buffer in another window. It's analogous to
- button 2 which shows the buffer in the current window.
-
-2003-07-31 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-display-line-1):
- Fixed bad indentation on one line. No semantic change.
-
-2003-07-29 Lawrence Mitchell <wence@gmx.li>
-
- * erc-match.el:
- Quote open paren in docstring of erc-text-matched-hook
-
- * erc.el: Anchor match only at beginning in erc-ignored-user-p.
-
- * erc-button.el: New variable erc-button-wrap-long-urls.
- Modified erc-button-add-buttons:
- New optional argument REGEXP.
- If we're buttonizing a URL and erc-button-wrap-long-urls is
- non-nil, try and wrap them
-
- Modified erc-button-add-buttons-1:
- Pass regexp to erc-button-add-buttons.
-
-2003-07-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-network-name):
- Improved docstring. Removed an unnecessary call to erc-server-buffer.
-
-2003-07-28 Mario Lang <mlang@delysid.org>
-
- * erc.el: By lawrence:
- (erc-ignored-user-p): Use anchored regexp.
- (smiley): Fix missing quote in `remove-hook' call.
-
-2003-07-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-nets.el, erc-nickserv.el, erc.el:
- Changed all references to Openprojects into references to Freenode.
-
-2003-07-25 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- Now variable erc-debug-irc-protocol is defvar'ed instead of defcustom'ed.
- Made the docstring clearer too.
-
- * erc.el: Fixed a wrong-type-argument error from window-live-p.
-
-2003-07-15 Damien Elmes <erc@repose.cx>
-
- * erc-log.el(erc-log-setup-logging):
- set buffer-file-name to "", as (basic-save-buffer)
- will prompt for a buffer name before invoking hooks. the buffer-file-name
- will be overridden by (erc-save-buffer-in-logs) anyway - the main danger
- of doing this is write-file-contents hooks. Let's see if anyone complains.
- (erc-save-buffer-in-logs): return t, so that further write hooks are not run
-
-2003-07-09 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el(erc-dcc-open-network-stream):
- -nowait still crashes emacs cvs - disable for now
-
-2003-07-02 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc): Minor docstring modification.
-
-2003-07-01 Damien Elmes <erc@repose.cx>
-
- * erc-match.el(erc-match-current-nick-p):
- match only on word boundaries
-
- * erc-log.el(erc-log-setup-logging):
- not sure how this crept in again - make sure we set
- buffer-file-name to nil, since otherwise it is not possible to open
- previous correspondence in another buffer while a conversation is open
-
-2003-06-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-network-name):
- Now makes some intelligent guesses if the server didn't tell
- us the network name.
-
-2003-06-28 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-default-coding-system): Use utf-8 as the default
- encoding for outgoing stuff and undecided as the default for
- incoming stuff.
- (erc-coding-sytem-for-target): New.
- (erc-encode-string-for-target): Use it.
- (erc-decode-string-from-target): Use it. Removed the flet
- erc-default-target hack and documented the dynamically bound
- variable `target' instead.
-
-2003-06-25 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-log-irc-protocol):
- Now we keep point on the bottom line of the window
- displaying the *erc-protocol* buffer if it is at the end of the
- *erc-protocol* buffer.
-
- * erc.el:
- Added some text to the docstring for variable erc-debug-irc-protocol.
-
-2003-06-23 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-dcc.el(erc-dcc-auto-mask-p):
- Fixed a docstring typo that caused a load-time error.
-
- * erc-dcc.el(erc-dcc-auto-mask-p):
- Changed reference to undefined variable erc-dcc-auto-mask-list
- to erc-dcc-auto-masks.
- Changed default value of variable erc-dcc-auto-masks to nil and added text to its
- docstring.
-
- * erc-notify.el(erc-notify-timer and erc-notify-QUIT):
- Added network name to notify_off message.
-
- * erc.el(erc-network-name):
- Now returns the name of the IRC server if the network name
- cannot be determined.
-
- * erc-notify.el(erc-notify-JOIN and erc-notify-NICK):
- Added argument ?m to call to erc-display-message.
-
- * erc-dcc.el(erc-dcc-do-LIST-command):
- Fixed a bug where I assumed (plist-get elt :type)
- returns a string -- it really returns a symbol.
-
- * erc-notify.el(erc-notify-timer):
- Now we include the network name in the notify_on message.
-
- * erc.el:
- New function: erc-network-name. Returns the name of the network that the
- current buffer is associate with. Not every server sends the 005 messages
- that enable the network name to be known. If the network name is
- not known, the string "UNKNOWN" is returned.
-
- * erc-dcc.el(erc-dcc-chat-setup):
- Added a comment. Fixed a bug where a DCC CHAT buffer has no
- prompt when it first appears.
-
- * erc-dcc.el(erc-dcc-chat-parse-output):
- Now a DCC chat buffer displays the nick using
- erc-nick-default-face just like in a channel buffer.
-
-2003-06-22 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-display-prompt):
- Fixed incorrect indentation. No semantic change.
-
- * erc.el(erc-strip-controls):
- Minor change to regexp that matches IRC color control
- codes. I was seeing usage as follows: ^C07colored text^C^C04other color.
- Now we strip a ^C followed by zero, one, or two digits. Before this change,
- we stripped a ^C followed by one or two digits.
-
- * erc-dcc.el(erc-dcc-do-LIST-command):
- Improved format of output of /DCC LIST. Now the
- "Size" column for a DCC GET includes the percentage of the file that has
- been retrieved.
- (erc-dcc-do-GET-command): Now it works if erc-dcc-default-directory is set.
-
-2003-06-19 Damien Elmes <erc@repose.cx>
-
- * erc-log.el:
- * added quickstart information to the comments up the top
-
-2003-06-16 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Default to open-network-stream on MS Windows. (thanks lawrence)
-
-2003-06-11 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-process-input-line):
- refactor so that wrong-number-of-arguments is
- caught when using do-not-parse-args - this lets do-not-parse-args
- commands display help messages on incorrect syntax in a uniform manner.
- This no longer raises a bad-syntax error - was this a catch-all to stop a
- backtrace? Does it belong?
- (erc-cmd-APPENDTOPIC): the correct way to display help when you want to
- accept an arbitrary string is to (signal 'wrong-number-of-arguments nil).
- This fixes a bug where people could not /at topics with a space in them.
-
-2003-06-09 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- Re-add the last few changes which weren't merged for some reason.
-
- * erc.el(erc-cmd-APPENDTOPIC): show help when given no arguments
-
- Patch from MrBump. Fixes problem with erc-set-topic inserting ^C characters
- into the topic. Also removes dependency on CL.
-
-2003-06-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- Added comment to explain (eval-after-load "erc" '(erc-update-modules)).
-
-2003-06-01 Mario Lang <mlang@delysid.org>
-
- * erc-pcomplete.el: Add completion for /unignore
-
-2003-05-31 Alex Schroeder <alex@gnu.org>
-
- * erc-compat.el(erc-encode-coding-string): The default binding,
- if encode-coding-string was not available, must be a defun that
- takes multiple arguments. Did that.
-
-2003-05-30 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Add handlers for 313 and 330 (by arne@rfc2549.org, thanks)
-
-2003-05-30 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- patch from MrBump to make /mode #foo +b work again (erc-cmd-BANLIST only
- temporarily changes them now)
-
-2003-05-29 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-select):
- server is now defaulted with erc-compute-server.
- A few cosmetic fixes.
- (erc-default-coding-system): Renamed from erc-encoding-default.
- (erc-encoding-default): Renamed to erc-default-coding-system.
- (erc-encoding-coding-alist): Documentation updated to cover regexps.
- (erc-encode-string-for-target): Now considers keys of
- erc-encoding-coding-alist to be regexps. Rely on erc-compat
- wrt. MULE support.
- (erc-decode-string-from-target): New function.
- (erc-send-current-line): eq -> char-equal fix.
- (erc-server-TOPIC): topic is now decoded with
- erc-decode-string-from-target.
- (erc-parse-line-from-server): Line from server is no longer decoded
- here.
- (erc-server-PRIVMSG-or-NOTICE): Message from a user is decoded here,
- sspec -> sender-spec for clarity. Cosmetic if -> when fix.
- (erc-server-TOPIC): sspec -> sender-spec
- (erc-server-WALLOPS): Ditto.
-
- * erc-compat.el(erc-decode-coding-string):
- Now requires coding-system as an argument.
-
-2003-05-15 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- erc-part|quit-hook is only run on a part|quit directed to our nick, reflect that in the docstring to avoid confusion
-
-2003-05-01 Andreas Fuchs <asf@void.at>
-
- * erc-truncate.el:
- * erc-truncate-buffer-to-size: use fboundp. Scheme takes its toll...
-
-2003-05-01 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-truncate.el: remove require of erc-log
- (erc-truncate-buffer-to-size): use erc-save-buffer-in-logs when it's
- there, else, don't.
-
-2003-04-29 Andreas Fuchs <asf@void.at>
-
- * erc-log.el, erc-truncate.el, erc.el: erc.el:
- * erc-cmd-QUIT: Remove references to code in erc-log.el, to
- not force autoloading of erc-log.el
- * erc-server-PART: ditto.
- * erc-quit-hook: new hook, run when /quit command is
- processed.
- * erc-cmd-QUIT: use it.
- * erc-part-hook: new hook, run then PART message is
- processed.
- * erc-cmd-PART: use it.
- * erc-connect-pre-hook: new hook, run before connection to IRC
- server is started.
- * erc: use it.
- * erc-max-buffer-size: Move truncation variables and functions
- to erc-truncate.el
- * erc-truncate-buffer-on-save: moved to erc-log.el
- * erc-initialize-log-marker: new function.
- erc-log.el:
- * erc-truncate-buffer-on-save: New defcust here; from erc.el
- * erc-truncate-buffer-on-save: Put it in group `erc-log'
- * erc-log-channels-directory: Remove trailing slash from
- default value.
- * Add functions to erc-connect-pre-hook, erc-part-hook and
- erc-quit-hook to avoid getting autoloaded.
-
- erc-truncate.el:
- * Contains the truncation functions and defcusts from erc.el.
- * define-erc-module clause added; new erc-truncate-mode.
-
-2003-04-29 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc):
- Check whether erc-save-buffer-in-logs is bound, too
-
- * erc.el(erc):
- Check whether erc-logging-enabled is bound before using it - not
- everyone is using erc-log.el!
-
-2003-04-28 Andreas Fuchs <asf@void.at>
-
- * erc-log.el:
- * while we're at it, remove the (declare (ignore ignore)) statements.
-
- * erc-log.el:
- * add autoload statement for erc-log-mode/etc. Sorry for the delay.
-
- * erc-log.el, erc.el: * erc.el:
- - move variables and functions to erc-log.el:
- defgroup `erc-log'
- defcustom `erc-log-channels-directory'
- defcustom `erc-log-insert-log-on-open'
- defcustom `erc-generate-log-file-name-function'
- defun `erc-save-buffer-in-logs' (autoloads from erc-log.el)
- defuns `erc-generate-log-file-name-*'
- defun `erc-current-logfile'
- defun `erc-logging-enabled' (autoloads from erc-log.el)
- - erc-truncate-buffer-to-size: fix for double-saving bug when
- writing out truncated buffer contents. Thanks, lawrence mitchell <wence@gmx.li>!
- - erc-remove-text-properties-region: Fix case for read-only text.
- - erc-send-current-line: update insert-marker before calling the hooks.
- also, wrap (erc-display-prompt) so that it doesn't toggle
- buffer-modified-p.
- - erc-interpret-controls: remove /very/ old commented-out function
- - erc-last-saved-position: make it a marker
- - erc: use it.
-
- * erc-log.el: (thanks, lawrence mitchell <wence@gmx.li>!)
- - Move logging code from erc.el here
- - define-erc-module log: add; minor mode erc-log-mode is the
- same as adding the `erc-save-buffer-in-logs' to
- erc-send-post-hook and `erc-insert-post-hook'.
- - erc-w32-invalid-file-characters: add.
- - erc-enable-logging: add.
- - erc-logging-enabled: use it.
- - erc-logging-enabled: autoload.
- - erc-save-buffer-in-logs: fix for truncating saved buffer with read-only text.
- - erc-save-buffer-in-logs: use erc-last-saved-position.
- - erc-save-buffer-in-logs: fix saving half-written messages on
- the prompt when saving the log file. (simply uses
- erc-insert-marker as an upper bound for saving).
-
-2003-04-27 Damien Elmes <erc@repose.cx>
-
- * erc.el: * erc.el: erc-modules: added
-
-2003-04-27 Alex Schroeder <alex@gnu.org>
-
- * Makefile(UNCOMPILED): Added erc-compat.el.
- (clean): Remove .elc files, too.
- Patch by Hynek Schlawack <hynek+erc@hys.in-berlin.de>
-
-2003-04-22 Damien Elmes <erc@repose.cx>
-
- * erc-button.el:
- erc-button-keymap: set the parent keymap to erc-mode-map
-
-2003-04-20 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- erc-official-location: shouldn't the official location be the base URL of erc?
-
- * erc.el:
- erc-modules: updated the docstring to make the semantics clearer
-
-2003-04-19 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fix problem where % in NOTICE produced errors (from mmc)
-
-2003-04-18 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-toggle-debug-irc-protocol):
- moved a reference to 'buf' inside the let
- statement which defines it. it's difficult to tell what the original
- intentions were here - at the moment the debug window is displayed when
- toggling either way.
-
- * README, erc.el:
- (erc-update-modules: added a condition in for erc-nickserv -> erc-services
-
- * erc-pcomplete.el:
- - that change to erc-update-modules making it require the modules first means
- we don't need any special case handling here, so i reverted the previous
- change
-
- * erc.el:
- - don't require 'erc-auto, since windows users don't have access to make.
- instead, we handle it in (erc-update-modules)
-
-2003-04-17 Damien Elmes <erc@repose.cx>
-
- * README, Makefile:
- Updated Makefile and documentation to reflect the new release
-
- * erc.el:
- - note the previous change also updated the release number to erc 4.0!
- (erc-connect): fix a bug introduced by the previous release
-
- * erc.el:
- fixed about 20 instances of (message (format ...)) which will break if the
- format returns a string with %s in it
-
- * erc.el: erc-error-face: make it red, not pink
-
- * erc-pcomplete.el:
- since pcomplete is autoloaded via erc-completion-mode, and completion is in
- erc-modules by default, we remove completion when pcomplete is added
-
- * erc.el(define-erc-module): no need for delete, use delq
-
- * erc-members.el(erc-nick-channels):
- (erc-person-channels) takes one arg
- (erc-format-user): again, they all take an arg
-
- * erc.el:
- - require erc-auto when loading, so the default `erc-modules' can be loaded.
- this makes erc-auto no longer a convenience but a necessity - all the name
- of user friendliness.
- (define-erc-module): the enable and disable routines now update erc-modules
- accordingly
- erc-modules: new variable controlling the modules which erc has loaded/will
- load. when customizing, it will automatically enable modules. it won't
- automatically disable modules which are removed, yet.
- (erc-update-modules): enable all modules in `erc-modules'
-
- * erc-dcc.el(erc-dcc-open-network-stream):
- use the -nowait equiv if available
- erc-dcc-server-port: removed
- erc-dcc-port-range: allows a range of values, so you can have more than one
- dcc
- (erc-dcc-server): support erc-dcc-port-range
- (erc-dcc-chat): use OCHAT for outgoing chat for now. we need to fix the
- issues with allowing more than one chat with the same person
-
- * erc.el:
- erc-log-channels: removed; set the directory to start logging
- (erc-directory-writeable-p): create directory if it doesn't exist, check if
- it's writable
- (erc-logging-enabled): don't reference erc-log-channels
-
-2003-04-07 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc):
- but when inserting the contents of a previous logfile, use the logfile
- name, not ""!
-
- * erc.el(erc):
- set buffer-file-name to "", since we have a custom saving function and
- it's not needed. this enables one to open a log file with previous
- correspondence, while talking to the person at the same time
-
-2003-03-29 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-prepare-mode-line-format):
- Now strips all text properties from the target before
- putting it in the mode line. Keeps the mode line looking consistent.
- (erc-channel-p): Improved docstring.
-
-2003-03-28 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-generate-log-file-name-with-date): New function.
- (erc-generate-log-file-name-function): Make it available.
-
-2003-03-24 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fix erc-prompt and erc-user-mode custom :type (Closes: #185794)
-
-2003-03-20 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- erc-server-hook-list: correct documentation of ordering of (proc parsed)
-
-2003-03-16 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-modified-channels-string):
- Make it a risky-local-variable.
-
-2003-03-16 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el(erc-track-modified-channels):
- Use (point-min) if we don't find a
- parsed-property, so it won't error out with nil...
-
-2003-03-16 Damien Elmes <erc@repose.cx>
-
- * erc-track.el(erc-track-switch-buffer):
- removed call to erc-modified-channels-update, as
- this is done correctly on buffer switching in both emacs and xemacs now
-
-2003-03-15 Damien Elmes <erc@repose.cx>
-
- * erc-track.el(erc-find-parsed-property):
- simplified a little, so it shouldn't return nil anymore
-
- * erc.el: erc-send-post-hook: document narrowing which occurs
-
-2003-03-14 Alex Schroeder <alex@gnu.org>
-
- * erc-track.el(erc-find-parsed-property): New function.
- (erc-track-modified-channels): Use it instead of relying on
- point-min.
-
-2003-03-12 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- Fix erc-set-topic to accept a channel name as first word
-
-2003-03-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-dcc.el:
- Small patch (<10 lines, also slightly modified by Jorgen Schäfer) from
- David Spreen <netzwurm@debian.org> to add hostmask-authentication to
- DCC auto-accept.
-
- erc-dcc-auto-mask-list: New variable
- (erc-dcc-handle-ctcp-send): Check erc-dcc-auto-mask-list
- (erc-dcc-auto-mask-p): New function
- erc-dcc-send-request: Docstring now mentions erc-dcc-auto-mask-list
-
-2003-03-10 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-ring.el(erc-clear-input-ring):
- New function. Erases the contents of the input ring for
- the current ERC buffer.
-
-2003-03-08 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- (erc-display-line-1) and (erc-send-current-line): Now these functions reset erc-insert-this
- to t as soon as possible after consuming the value of that variable. See the comments in
- the code for the strange symptom this fixes.
- (erc-bol): Changed to call point-at-eol instead of line-end-position. This increases XEmacs
- portability, since XEmacs doesn't have line-end-position. Patch suggested by Scott Evans
- on the ERC mailing list.
-
-2003-03-04 Damien Elmes <erc@repose.cx>
-
- * erc.el: banlist*: patch from mrbump to avoid using cl packages
-
-2003-03-04 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- Changed erc-noncommands-list from a constant to variable, so that users can
- add their own erc-cmd-* functions to the list. Improved the docstring too.
-
-2003-03-02 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-server-353):
- Now the output of "/NAMES #channel" appears in the currently
- active ERC buffer, even if the user is not a member of #channel.
-
- * erc.el(erc-cmd-DEOP):
- Fixed a syntax error: invalid read syntax ")" caused by my last change.
-
-2003-03-01 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-cmd-DEOP):
- Fixed a wrong-type-argument error caused by calling split-string
- on a list instead of on a string. Removed the call to split-string entirely,
- because it wasn't needed.
-
- * erc.el(erc-cmd-HELP):
- Changed to use intern-soft instead of intern. Now "/HELP floob"
- doesn't create a void function symbol erc-cmd-FLOOB.
-
-2003-02-25 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-SERVER):
- remove erroneous references to line, use server instead
-
-2003-02-23 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-toggle-debug-irc-protocol):
- Fixed a bug where the global value of
- kill-buffer-hook was being modified instead of the buffer-local value.
-
-2003-02-22 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-cmd-KICK):
- Now supports any number of words in the REASON string. Examples
- of the /KICK command are:
- /KICK franl You don't belong here
- /KICK franl Bye
- /KICK franl
- /KICK #channel franl Go away now
- /KICK #channel franl Bye
- /KICK #channel franl
-
-2003-02-16 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-stamp.el(erc-insert-timestamp-right):
- Make the timestamp rear-nonsticky, so
- C-e works at the beginning of the next line.
-
-2003-02-16 Andreas Fuchs <asf@void.at>
-
- * erc-stamp.el:
- * s/choose/choice/ in customize options, as kensanata requested.
-
-2003-02-15 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-toggle-debug-irc-protocol):
- Now if the *erc-protocol* buffer is killed,
- logging is turned off. Prior to this change, the buffer would come back
- into existence (generally unbeknownst to the user) after being killed.
-
-2003-02-11 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-send-current-line):
- we can't inhibit everything here when not connected,
- as the user will expect commands like /server still to work. the
- erc-cmd-handler should recover from errors instead
-
-2003-02-10 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- * we now run erc-after-connect on 422 (no motd) messages as well as the motd
- messages
- (erc-login): revert the previous change
-
- * erc.el(erc-login): register that we're connected
-
-2003-02-10 Mario Lang <mlang@delysid.org>
-
- * erc-members.el: * Provide erc-members
- * Fix excessive )
- * Comment out broken self-tests
-
-2003-02-07 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-connect):
- notify the user we're trying to connect when using asych
- connections
-
- * erc.el(erc-connect): support an asynchronous connection
- (erc-process-sentinel): ditto
-
- * erc-track.el:
- * advise switch-to-buffer in the case of xemacs, since it doesn't have
- window-configuration-change-hook
-
- * erc.el(erc-send-current-line):
- if not connected, refuse to send either a message or
- a command
-
- * erc.el: (erc-save-buffer-in-logs):
- - check for a sensible region before saving the buffer. if the
- connection process is killed early on, there is not a sensible region
- to save
- - don't set buffer-file-name on save. we don't need it, and it means we
- can now find-file a log while an existing query is open with that
- user
-
- * erc.el(erc-process-input-line):
- when displaying the help for a function, if no
- documentation exists, don't fall over
- (erc-cmd-SAY): new function for quoting lines beginning with /
- (erc-server-NICK):
- - fix a bug where the "is now known as" message doesn't appear on newly
- created /query buffers
- - when a user changes their nick, update the query to point to the new
- nick
-
- * erc.el(erc-send-current-command):
- don't reject multi-line commands. since
- multiline-p is used as the no-command arg to erc-process-current-line,
- multi-line text is never interpreted as a command. i believe this is the
- correct behavior - it allows people to post the output of things like df
- (sans header). if you want to change this, please provide a rationale
- in the changelog
-
- * erc.el(erc-send-current-line):
- only match the first line when determining if a
- multi-line command is allowed
-
-2003-02-07 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-bbdb.el(erc-bbdb-highlight-record):
- Use alternate strings, not character
- classes to split the nick-field.
-
-2003-02-06 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-process-sentinel):
- Now we set erc-connected to nil every time we disconnect
- from a server, not just when an unexpected disconnect happens.
-
- * erc.el(erc-connected):
- Removed redundant defvar of this variable. Improved the
- docstring.
- (erc-login): Changed to send a correct RFC2812 USER message (see section
- 3.1.3 of RFC2812 for the documentation of the semantics of each argument
- of the USER message.
-
-2003-02-02 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-NOTICE): fix from mrbump
-
-2003-01-31 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-cmd-JOIN):
- Now we only send one JOIN command to the server when a channel
- key is provided.
-
-2003-01-30 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-remove-channel-member):
- Fixed so that it runs erc-channel-members-changed-hook
- with the channel buffer current, as is documented in the docstring for variable
- erc-channel-members-changed-hook: "The buffer where the change happened is
- current while this hook is called."
-
-2003-01-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- (erc-ignored-user-p),(erc-cmd-IGNORE),(erc-cmd-UNIGNORE): Now nicks are ignored
- on a per-server basis. Now, erc-ignore-list is only valid in server
- buffers! Do not reference it in channel buffers.
-
- * erc.el(erc-cmd-IGNORE):
- Now says "Ignore list is empty" if it erc-ignore-list is empty
- instead of showing an empty list.
-
-2003-01-25 Alex Schroeder <alex@gnu.org>
-
- * erc-nickserv.el(services): Defined a module
-
-2003-01-25 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-process-ctcp-query):
- Display recipient of CTCP query if it's not
- our current nick.
-
- * erc.el(erc-cmd-WHOIS):
- Accept an optional second argument SERVER.
-
-2003-01-25 Alex Schroeder <alex@gnu.org>
-
- * erc-stamp.el(stamp): erc-add-timestamp must always be added
- with the APPEND parameter -- not only when adding it on the right.
-
-2003-01-24 Alex Schroeder <alex@gnu.org>
-
- * erc-members.el(erc-channel-members-changed-hook): Obsolete, use
- erc-members-changed-hook instead. When it is set, add its content
- to erc-members-changed-hook.
- (erc-update-channel-member): Obsolete, use erc-update-member
- instead. Defalias to that effect.
- (erc-remove-channel-member): New and already obsolete. Use
- erc-remove-nick-from-channel instead.
- (erc-update-channel-info-buffer): Obsolete, use ignore instead.
- Yes, these have to go.
- (erc-channel-member-to-user-spec): Obsolete, use erc-format-user
- instead.
- (erc-format-user): New.
- (erc-ignored-reply-p): New, use it.
-
- * erc-members.el:
- Further along the way. Any function from erc.el that uses
- channel-members should end up in this file, rewritten to use
- erc-members.
-
- (erc-person): Call erc-downcase before getting
- something from the hash.
- (erc-nick-in-channel): Checking whether erc-process must be used is
- unnecessary -- this will be done in erc-person.
- (erc-nick-channels): New.
- (erc-add-nick-to-channel, erc-update-member): Call erc-downcase
- before putting something into the hash.
- (erc-buffer-list-with-nick): New.
- (erc-format-nick, erc-format-@nick): New, backwards incompatible.
- Must check for other places that call these!
- (erc-server-PRIVMSG-or-NOTICE): Use the new version.
-
- * erc-compat.el(view-mode-enter): defalias to view-mode, if
- view-mode-enter is not fboundp and view-mode is -- as is the case
- in XEmacs. We need view-mode-enter in erc-match.el.
-
-2003-01-23 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-default-server-handler):
- Minor performance improvement: allow the lambda
- expression to be byte-compiled.
-
-2003-01-23 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-BANLIST):
- in the absence of a fill-column, use the screen width
-
-2003-01-22 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- patch from MrBump to delay fetching the banlist until /bl is run, so we don't
- fetch it when joining a channel anymore
-
- * erc-ring.el:
- * instead of adjusting hooks when loaded, provide (erc-ring-mode). you'll
- need to run (erc-ring-mode 1) now to get the ring
- * (erc-previous-command), (erc-next-command):
- - check if the ring exists and create it if necessary
- - don't do anything if the ring is empty
-
- * erc-pcomplete.el:
- Put "how to use" documentation in the comments up the top
-
-2003-01-21 Alex Schroeder <alex@gnu.org>
-
- * erc-autojoin.el(erc-autojoin-version): New.
-
- * erc-autojoin.el(erc-autojoin-add): Added body.
- (erc-autojoin-remove): Added body.
- (erc-autojoin): Provide it.
-
-2003-01-21 Damien Elmes <erc@repose.cx>
-
- * erc.el: erc-cmd-*: removed a bunch of references to force
-
-2003-01-21 Alex Schroeder <alex@gnu.org>
-
- * erc-autojoin.el(erc-autojoin-channels-alist): More doc.
-
-2003-01-20 Alex Schroeder <alex@gnu.org>
-
- * erc-autojoin.el:
- new, based on resolve's mail, and the stuff on the wiki
-
- * erc-members.el: new
-
-2003-01-19 Mario Lang <mlang@delysid.org>
-
- * debian/README.Debian, debian/changelog, debian/scripts/install,
- debian/scripts/startup.erc, Makefile:
- Prepare for 20030119 debian package
-
- * erc-dcc.el: <rant>
- * (erc-decimal-to-ip): Since XEmacs decides that return a completely
- and utterly wrong number from string-to-number if it is larger than
- the integer boundary, instead of sanely converting the thing to
- a float, we now (concat dec ".0").
- </rant>
-
- * erc.el:
- * (erc-log-irc-protocol): Use erc-propertize, not propertize
-
-2003-01-19 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-button-add-buttons): Added regexp-quote for
- the list case, too.
-
-2003-01-19 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el(erc-dcc-member): fix for case where a prop is nil
-
- * erc-dcc.el(erc-dcc-member):
- fix for xemacs's version of plist-member
-
-2003-01-19 Mario Lang <mlang@delysid.org>
-
- * erc-notify.el: Delete empty strings from the ison-list
-
- * erc-track.el:
- * (erc-track-switch-buffer): Call erc-modified-channels-update here.
-
- * erc-track.el: * toplevel: require 'erc-match
-
- * erc-track.el: * (erc-track-mode): Make autoload interactive
-
- * erc-button.el: * (button): Make the autoload interactive
-
- * erc.el:
- * (erc-mode): Comment out the case-table stuff, breaks xemacs
- * (erc-downcase): Revert.
-
- * erc-dcc.el:
- * (erc-dcc-handle-ctcp-send): Use erc-decimal-to-ip on the ip we get...
-
- * erc-speak.el:
- Eliminate reference to erc-nick-regexp, which no longer exists
-
-2003-01-19 Alex Schroeder <alex@gnu.org>
-
- * erc-stamp.el(erc-timestamp-right-column): New, default nil.
- (erc-insert-timestamp-right): Use it, if non-nil. Verbose
- doc string.
-
-2003-01-18 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-downcase): Use the old behavior in non-CVS Emacs.
-
- * erc.el(erc-cmd-QUIT): Remove &rest. The correct fix follows.
- (erc-cmd-GQUIT): Pass "" to erc-cmd-QUIT.
- (erc-mode): Use the case-table only in CVS Emacs. See comment.
-
- * erc.el(erc-cmd-QUIT): make reason optional.
-
- * erc.el(erc-cmd-GQUIT): Fixed typo.
-
-2003-01-17 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-current-logfile): call expand-file-name, so that downcase doesn't mess up ~
-
- * erc.el: * (erc-mode): Define a proper case-table.
- * (erc-downcase): just call downcase for now, let's see if the case-table is portable, if yes, we'll remove all erc-downcase references anyway...
-
- * erc-button.el: * (erc-button-add-buttons): regex-quote the nick
-
-2003-01-17 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(button): erc-channel-members-changed-hook no
- longer has erc-recompute-nick-regexp.
- (erc-button-alist): Use channel-members instead of
- erc-nick-regexp.
- (erc-button-add-buttons): Split some code into
- erc-button-add-buttons-1, and now handle strings, lists, and
- alists. Regular expressions in lists and alists are enclosed in
- < and >.
- (erc-button-add-buttons-1): New.
- (erc-nick-regexp): Deleted.
- (erc-recompute-nick-regexp): Deleted.
-
- * erc-button.el: Remove require cl again.
- (erc-mode-map): No longer bind widget-backward and widget-forward.
- (erc-button-alist): Explain why byte-compiling makes no sense, and
- remove all calls to byte-compile.
- (erc-button-keymap): Define it the standard way, without exposing
- the list nature of the keymap.
- (erc-button-marker-list): Deleted.
- (erc-button-add-buttons): Simplify. In particular, create the
- button using the real callback, instead of using the intermediate
- erc-button-push, and only store the data as described for
- erc-button-alist.
- (erc-button-remove-old-buttons): Simplify. No more list munging.
- Instead, just remove all the properties that we add in
- erc-button-add-button.
- (erc-widget-press-button): Deleted.
- (erc-button-click-button): New, for mouse clicks. Moves point to
- where the mouse is, and calls erc-button-push.
- (erc-button-push): Instead of matching again, just use the
- erc-callback and erc-data properties at point to do the right
- thing.
- (erc-button-entry): Deleted.
- (erc-button-next): Use error instead of the beep plus message
- combo.
-
-2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-autoaway.el(erc-autoaway-set-back):
- Don't pass a force argument to erc-cmd-GAWAY.
-
- * erc.el(erc-cmd-AWAY): Removed usage of the force variable.
-
-2003-01-17 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(button):
- erc-recompute-nick-regexp is no longer added to
- erc-channel-members-changed-hook unconditionally, but only if
- erc-button-mode is enabled, and if it is disabled, it is removed
- 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,
- so another solution needs to be found.
-
-2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-banlist-store):
- Don't assume there's always a setter in the banlist reply.
-
-2003-01-17 Alex Schroeder <alex@gnu.org>
-
- * erc-button.el(erc-button-url-regexp): Changed regexp according
- to a suggestion by Max Froumentin <mf@w3.org>.
-
-2003-01-17 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- fix erc-remove-channel-member again to not error out on nil as first arg...
-
- * erc.el: * (erc-occur): New function
-
-2003-01-17 Damien Elmes <erc@repose.cx>
-
- * erc.el: erc-banlist-*: return nil so further hooks are called
-
- * erc.el(erc-server-368):
- suppress "end of ban list" messages - use /listbans now
-
- * erc.el(erc-send-current-line):
- removed the check for leading whitespace again - the
- only time we want to prohibit multi-line commands is if / is the first
- thing on the line
- (erc-get-arglist): new defun for reading a function's arglist which should
- work with older copies of emacs. we use help-function-arglist if it's
- available, though, since that has support for reading subrs, etc
-
- * erc.el(erc-cmd-JOIN): fixed (again)
-
- * erc.el: * fixed call to erc-cmd-NICK when connecting
- * support for listing bans and mass unbanning, again thanks to MrBump
-
- * erc.el(erc-set-topic):
- patch from MrBump (Mark Triggs, mst@dishvelled.net) to strip
- control chars and topic attribution in C-c C-t
-
-2003-01-16 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-remove-channel-member): Do not use delq, modify the list using setcdr like delq does.
- In theory, this should be way faster since the list doesn't get traverse two times.
- Measurement didn't show any real difference though :(, this system is flawed for channels with >300 users it seems...
- Also moved some defcustoms up.
-
-2003-01-16 Brian P Templeton <bpt@tunes.org>
-
- * erc.el: moved misplaced paren
-
-2003-01-16 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-UNIGNORE):
- reference argument directly - no string matching
-
- * erc.el(erc-extract-command-from-line):
- hmm, thinko in the canonicalization. should
- be fixed
-
-2003-01-16 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-send-current-line):
- Changed the regexp used to match /COMMANDs so that leading
- whitespace is taken into account.
-
-2003-01-16 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: * (erc-dcc-do-SEND-command): Fix it
-
- * erc-ezbounce.el, erc-lang.el: Arglist changes...
-
- * erc.el: Various docstring fixes and additions.
-
- * erc-notify.el:
- * (erc-cmd-NOTIFY): Change the function arglist to (&rest args)
-
- * erc-netsplit.el: * (erc-cmd-WHOLEFT): Has no args...
-
-2003-01-16 Damien Elmes <erc@repose.cx>
-
- * erc-fill.el:
- erc-fill-column: default to 78, so things like docstrings don't get wrapped
- in an ugly manner
-
-2003-01-16 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-cmd-default): Take a substring, now /mode works again.
- * (erc-cmd-AWAY): Put do-not-parse-args t
- * (erc-cmd-GAWAY): Ditto, and fix it.
- * (erc-cmd-CTCP): Switch to argument system.
- * (erc-cmd-KICK): Do the same.
-
-2003-01-15 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el:
- * (erc-cmd-DCC): Fixed for the new scheme, simplified.
- * (erc-dcc-do-CHAT-command): Ditto.
- * (erc-dcc-do-CLOSE-command): Ditto.
- * (erc-dcc-do-LIST-command): Ditto.
-
-2003-01-15 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- erc-error-face: setting a background doesn't work so well with multi-line
- messages, so we don't. fg color is negotiable ;-)
- (erc-cmd-QUERY): fixed, new doco, suppress (erc-delete-query) until we fix it
- (erc-send-current-line): allow multi-line messages provided they don't start
- with a slash - there's no need to prohibit them if the slash isn't the
- first character
-
- * erc.el: * bad-syntax now reports like incorrect-args
- * bunch of extra cmds fixed, nick, sv etc.
-
- * erc.el(erc-cmd-HELP): fixed
- (erc-extract-command-from-line): when determining canon-defun, make sure we
- have a valid symbol
- (erc-cmd-KICK): fixed
-
- * erc.el:
- * removed duplicate do-no-parse-args properties for the defaliased defuns
- (erc-process-input-line): show function signature when incorrect args
- (erc-extract-command-from-line): canonicalize defaliases before extracting
- plist
- (erc-cmd-CLEAR): fixed
- (erc-cmd-UNIGNORE): fixed again
-
- * erc.el(erc-cmd-SET): fixed
- (erc-cmd-UNIGNORE): fixed
- (erc-process-input-line): report when incorrect arguments are provided to a
- command, and show the command's docstring
-
- * erc.el(erc-cmd-APPENDTOPIC): fixed
- (erc-process-input-line): more informative error message than 'bad syntax'
-
-2003-01-15 Mario Lang <mlang@delysid.org>
-
- * erc.el: * (erc-cmd-IGNORE): fixed
-
- * erc.el: * (erc-cmd-NAMES): fixed
-
- * erc.el:
- * (erc-cmd-CLEARTOPIC): Simplify, fix doc, make interactive
-
-2003-01-15 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-JOIN):
- correct invite behavior, and document it.
-
-2003-01-15 Mario Lang <mlang@delysid.org>
-
- * erc.el: * (erc-cmd-PART): Put 'do-not-parse-args t
-
-2003-01-15 Damien Elmes <erc@repose.cx>
-
- * erc.el(erc-cmd-JOIN): new cmd argument syntax
- (erc-process-input-line): check if (erc-extract-command-from-line) returned a
- list, and apply if that's the case
-
- * erc.el:
- erc-cmd-*: remove optional force and references to `force' in the code
- (erc-cmd-AMSG): call erc-trim-string, not trim-string
-
-2003-01-15 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-cmd-CLEARTOPIC): LINE is now ARGS and already parsed.
- Set erc-cmd-TOPIC to 'do-not-parse-args for now.
- (comment: I think we should have 'first, so that only first word is parsed...
- Or we could autodetect erc-channel-p in the parser before that somehow...)
-
- * erc.el: * (erc-cmd-OP): LINE is PEOPLE now, and already parsed.
-
- * erc-notify.el:
- * (erc-cmd-NOTIFY): Arg LINE is now ARGS, and already parsed.
-
-2003-01-15 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-stamp.el(erc-insert-timestamp-right):
- Prefer erc-fill-column to window-width,
- because on wide screens the timestamp could wander off too far to the
- right.
-
-2003-01-15 Mario Lang <mlang@delysid.org>
-
- * erc.el: This is the "everything is suddenly broken!" release
- You know, this is CVS, you can still go back, and wait until the transition
- is finished, but here is patch one, which basically breaks every command
- which is typed on the prompt.
- Hit me, we can still revert, but something needs to be done about this.
- * (erc-extract-command-from-line): intern-soft the function here.
- If the function symbol has a property 'do-not-parse-args, operate as before,
- otherwise, split the arguments prior to calling the command handler.
- * (erc-process-input-line): Updated to accommodate the change above.
- * (erc-send-distinguish-noncommands): Ditto.
- * (erc-cmd-NAMES): Ditto.
- * (erc-cmd-ME): Put 'do-not-parse-args property.
-
- * erc-dcc.el:nick: * erc-dcc.el: * erc-dcc-list: Renamed
- * (erc-dcc-member). Treat :nick as either a nick!user@host or nick,
- do appropriate comparisons, simplified.
- * (erc-dcc-list-add): New functions
- various callers of (cons (list ...) erc-dcc-list) updated.
- Other stuff I'm too bored to document now
-
-2003-01-15 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-stamp.el(erc-insert-timestamp-right):
- Removed redundant code that overrid the
- window-width. Now subtracts (length string) from every found
- indentation positions.
-
-2003-01-14 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * (erc-cmd-AMSG): Remove useless call to erc-display-message.
-
- * erc-dcc.el:
- * erc-dcc-chat/send-request: New variables, control how to treat
- incoming dcc chat or send requests. Can be set to 'ask, which behaves
- like it did before, 'auto, which accepts automatically, and
- 'ignore, which ignores those type of requests completely.
- * (erc-cmd-CREQ): New user-level command.
- * (erc-cmd-SREQ): Ditto.
-
- * erc.el: * (erc-cmd-AMSG). New command.
-
- * erc-xdcc.el: * (erc-xdcc): delete empty strings from ARGS
-
- * erc-dcc.el: * erc-dcc-ipv4-regexp: New constant
- * (erc-ip-to-decimal): Use it.
- * erc-dcc-host:valid-regexp erc-dcc-ipv4-regexp:
- * erc-dcc-host: :type
- * (pcomplete/erc-mode/DCC): Add completion for GET and CLOSE.
- * Some docstring/comment fixes.
-
- * erc-stamp.el:
- * (erc-insert-timestamp-right): Subtract (length string) from
- POS in any case, otherwise, linewrap occurs.
-
- * erc-dcc.el:
- * Fixed the unibyte-multibyte problem (now a dcc get buffer is (set-buffer-multibyte nil),
- and saves correctly (tried with 21.3.50)). Thanks to Eli for suggesting it!
- * Added :start-time plist property/value to GET handling so that we can calculate elapsed-time.
- * Some (unwind-protect (progn (set-buffer ...) ...)) constructs replaced with (with-current-buffer ...)
-
-2003-01-13 Mario Lang <mlang@delysid.org>
-
- * erc-xdcc.el:
- * erc-xdcc-help-text: New variable which makes replies to the originator
- much more flexible.
- * erc-xdcc-help-format: Removed.
- * (erc-xdcc-help): Handle the new variable.
- * (erc-xdcc): Simplified
-
- * erc-xdcc.el: * erc-xdcc-handler-alist: New variable.
- * (erc-xdcc): Move code for list and send sub-commands into
- * (erc-xdcc-help): New function.
- * (erc-xdcc-list): New function.
- * (erc-xdcc-send): New function.
-
-2003-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-server-JOIN):
- Oops, send MODE command only when *we* joined a channel.
-
- * erc.el:
- Fixing ERCs behavior wrt IRCnet's !channels have a different name for
- JOIN than in reality (e.g. you can join !forcertest or !!forcertest
- and really get to !ABCDEforcertest)
-
- (erc-cmd-JOIN): Removed erc-send-command MODE.
- (erc-server-JOIN): Ask for MODE now.
-
-2003-01-12 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el:
- (erc-dcc-get-filter), (erc-dcc-get-file): store size as a string, not an
- integer. check size > 0 for the case where a size wasn't provided, since
- string-to-int will return 0 on an empty string
-
-2003-01-12 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: * Use RAWFILE arg with find-file-noselect
- * Fix alist/plist conversion left-over
- * Add verbose-info about sending blocks.
-
-2003-01-11 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: * (pcomplete-erc-mode/DCC): Fixes
-
- * erc-xdcc.el: Initial version.
-
- * erc-pcomplete.el:
- * (erc-pcomplete): Fix so that cycle-completion works again.
- * (pcomplete-parse-erc-arguments): If there is a space after the last word
- before point, we need to return a "" arg, and it's position.
-
- * erc-dcc.el: Fix to pcomplete/erc-mode/DCC
-
- * erc-dcc.el: * (pcomplete/erc-mode/DCC): New function
-
- * erc-dcc.el: *** empty log message ***
-
- * erc-dcc.el: Move code around, just basic changes
-
-2003-01-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-stamp.el(erc-insert-timestamp-right):
- Check whether erc-fill-column is
- available before using it. Else default to fill-column or if
- everything else fails, the window width of the current window. For the
- fill-columns, use them directly as the starting position for the
- timestamp.
-
-2003-01-11 Andreas Fuchs <asf@void.at>
-
- * erc-stamp.el:
- erc-insert-timestamp-right: use correct window's window-width. If
- buffer is not in a window, use erc-fill-column.
-
-2003-01-11 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: * erc-dcc.el: * (erc-dcc-do-LIST-command): Fix
-
- * erc-dcc.el:
- * buffer-local variables erc-dcc-sent-marker and erc-dcc-send-confirmed marker removed
- Keep This info in erc-dcc-member :sent and :confirmed plist values
- * : * :buffer plist for :type 'SEND removed, since we can get this with (marker-buffer
- * erc-dcc-send-connect-hook: New hook, defaults to erc-dcc-send-block and erc-dcc-send-connected, which now prints a msg...
-
- * erc-dcc.el:
- * (erc-dcc-chat-accept): Renamed from erc-dcc-chat. Callers updated.
- * (erc-dcc-chat): Renamed from erc-dcc-chat-request.
- Callers updated, and interactive form added.
- * (erc-dcc-server-accept): No longer do any type-specific stuff.
- * (erc-dcc-chat-sentinel): Call erc-dcc-chat-setup if event is "open from "
- from here, otherwise call erc-dcc-chat-close.
-
- * (
-
- * erc-dcc.el: *** empty log message ***
-
- * erc-dcc.el: Moved some functions around.
- Doc string fixes.
- "/dcc send nick filename" works now
-
-2003-01-11 Alex Schroeder <alex@gnu.org>
-
- * erc.el(erc-send-command): Fixed flood protect message.
-
- * erc-button.el(erc-button-syntax-table): Make `-' a legal nick
- constituent.
-
-2003-01-10 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: Some more steps toward dcc send.
-
-2003-01-10 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-notify.el(erc-notify-timer):
- Changed to make it IRC-case-insensitive when comparing nicks.
- (erc-notify-JOIN): Changed to make it IRC-case-insensitive when comparing nicks.
- (erc-notify-NICK): Changed to make it IRC-case-insensitive when comparing nicks.
- (erc-notify-QUIT): Changed to make it IRC-case-insensitive when comparing nicks.
- (erc-cmd-NOTIFY): Now "/notify -l" lists the nicks on your notify list. Now
- when you remove a nick from your notify list, you no longer receive a spurious
- signoff notification for that nick. Changed to make it IRC-case-insensitive when
- comparing nicks.
-
- * erc.el(erc-ison-p):
- Fixed so it calls erc-member-ignore-case instead of member.
-
- * erc.el(erc-member-ignore-case):
- New function. Just like member-ignore-case, but obeys
- the IRC protocol case matching rules.
-
-2003-01-10 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el:
- (erc-dcc-do-GET-command), (erc-dcc-get-file): use the plist syntax, this
- fixes dcc get again
-
-2003-01-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: erc-complete-functions: New variable.
- erc-mode-map: Bind \t to 'erc-complete-word
- erc-complete-word: New function.
-
- * erc-pcomplete.el(erc-pcomplete-mode):
- Use new erc-complete-functions
- (erc-pcomplete): Check that we're in the input line, else return nil.
-
- * erc-button.el(erc-button-mode): Use new erc-complete-functions
- erc-button-old-tab-command: Removed.
- (erc-button-next-or-old): Removed
- (erc-button-next): check that we're not in the input line, else just return nil.
-
-2003-01-10 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: cleanup
-
- * erc-dcc.el:
- * (erc-dcc-chat-request): No longer use erc-send-ctcp-message.
-
- * erc-dcc.el:
- * (erc-dcc-no-such-nick): Also call delete-process if we have a peer already
-
- * erc-dcc.el:
- * (erc-dcc-no-such-nick): New function, server event handler for event 401.
- If we send a CTCP message requesting something dcc related, we set up an
- entry in erc-dcc-list before sending the request (for the server proc object
- for listening conns for example). But if that nick does not exist
- on that server, we now nicely cleanup erc-dcc-list again.
-
-2003-01-09 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: Moved code around a bit, and doc fixes
-
- * erc-dcc.el: *** empty log message ***
-
- * erc-dcc.el: Rename erc-dcc-plist to erc-dcc-list
-
-2003-01-09 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el(erc-dcc-server (erc-dcc-chat-setup):
- use erc's (erc-setup-buffer) to determine how to
- display new DCC windows
- (erc-dcc-chat-buffer-killed): buffer-local hook for DCC buffers to close the
- process
- (erc-dcc-chat-close): code common to a killed buffer or a disconnection from
- the other side
- (erc-dcc-chat-sentinel): use (erc-dcc-chat-close)
- (erc-dcc-server-accept): use (erc-log) instead of (message)
-
- * erc.el:
- (erc), (erc-setup-buffer): factor out window generation code so DCC can use
- it too
-
- * erc-dcc.el:
- (erc-dcc-do-CLOSE-command), (erc-dcc-do-LIST-command): work with erc-dcc-plist
-
- * erc-dcc.el:
- erc-dcc-alist: became erc-dcc-plist, so we can more easily grab particular
- properties
- dcc catalog: unify use of DCC: and [dcc] (either's fine, but let's be
- consistent)
- (erc-dcc-member): takes an arbitrary list of constraints now
- (erc-dcc-proc-member): removed, as (erc-dcc-member) can be used for this
- (erc-dcc-do-CHAT-command): use the catalog to show the user what's going on
- (erc-dcc-chat-server): removed
- (erc-dcc-server): takes name sentinel and filter arguments, can be used for
- both send and chat now
-
- .. this release means all send/get support is broken until we fix up the
- things that still expect to be using an alist. this include /dcc list, /dcc
- close
-
-2003-01-09 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-ring.el(erc-previous-command):
- If you have a partially typed input line and press M-p,
- you lose what you typed. Now we save it so you can come back to it.
-
-2003-01-09 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-ring.el(erc-add-to-input-ring): s/nullp/null/
-
-2003-01-09 Damien Elmes <erc@repose.cx>
-
- * erc-ring.el(erc-add-to-input-ring):
- set up the ring if it's not already setup
-
- * erc-dcc.el(erc-dcc-member): case insensitive match of nicknames
- (erc-dcc-do-CHAT-command): echo what we're doing (at least for now)
-
-2003-01-09 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el: (temporarily) fix erc-process setting...
-
- * erc-dcc.el: * (erc-dcc-chat-send-line): Removed
-
- * erc.el:
- Check if target is stringp (we can now also have 'dcc as value...)
-
- * erc-dcc.el(erc-dcc-chat-send-input-line):
- New function, used for
- erc-send-input-line-function.
- Use erc-send-current-line now.
-
- * erc-dcc.el: evt to elt...
-
- * erc-dcc.el: Remove () from a var (how silly!)
-
- * erc-dcc.el: * (erc-dcc-get-host): Use format-network-address.
- * (erc-dcc-host): Change semantic. If erc-dcc-host is set, use it.
- Otherwise, try to figure out the host by calling erc-dcc-get-host.
- * (erc-dcc-server-port): New variable.
- * erc-dcc-chat-log: Renamed to erc-dcc-server-accept
-
- * erc-dcc.el(erc-dcc-do-CHAT-command):
- Change arg of call to erc-dcc-chat-request from elt to nick
-
-2003-01-09 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-send-current-line):
- Now rejects multi-line commands (i.e., lines that
- start with "/" and contain newlines).
-
-2003-01-09 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-button.el:
- Functionality to use TAB to jump to the next button:
-
- (erc-button-next-or-old): New function.
- (erc-button-next): New function.
- erc-button-keymap: added erc-button-next
- erc-button-old-tab-command: New variable.
- define-erc-module button: Add and remove 'erc-button-next-or-old as
- appropriate.
-
-2003-01-09 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el:
- New variable: erc-auto-reconnect (defaults to t). If non-nil, ERC will
- automatically reconnect to a server after an unexpected disconnection.
- (erc-process-sentinel): Changed to refer to variable erc-auto-reconnect.
-
-2003-01-08 Mario Lang <mlang@delysid.org>
-
- * erc.el:
- * erc-send-input-line-function: New variable, used for dispatch...
-
-2003-01-08 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el(erc-dcc-chat-sentinel):
- check event type before killing process
- (erc-dcc-chat-log): new, handles the setup of dcc chats for incoming
- connections
- (erc-dcc-chat): use (erc-dcc-chat-setup)
- (erc-dcc-chat-setup): code common to incoming and outgoing DCC chats
- (erc-dcc-chat-request): request a DCC chat with another user
- (erc-dcc-proc-member): locate a member in erc-dcc-alist by process
-
- The very first ERC to ERC DCC chat was held between delysid and resolve today!
-
-2003-01-08 Mario Lang <mlang@delysid.org>
-
- * erc-track.el(erc-all-buffer-names):
- Check for erc-dcc-chat-mode too
-
-2003-01-08 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-ring.el, erc.el(erc-kill-input):
- Resets erc-input-ring-index to nil, so that invoking this
- command conceptually puts you after your most recent input in the input
- history.
- (erc-previous-command and erc-next-command): Changed so that history movement
- is more intuitive. Also preserves the blank input line that marks the
- place after the newest command in the history ring (i.e., you'll see a
- blank command once every trip around the ring in either direction).
-
-2003-01-08 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el(erc-dcc-chat): Add docstring
- Add self-test.
- Fix error if /dcc chat nick doesn't find the nick
-
-2003-01-08 Francis Litterio <franl@users.sourceforge.net>
-
- * Makefile:
- Changed so that "make" works correctly under Cygwin. Before this change, the
- pathname passed to Emacs on the command line under Cygwin had the form
- "/cygwin/c/...", which prevented emacs from finding the file. Now the pathname
- has the form "c:/...". This works for any drive letter.
-
-2003-01-08 Mario Lang <mlang@delysid.org>
-
- * erc-button.el: reindent some code, and add TODO to comments
-
- * erc-dcc.el: *** empty log message ***
-
- * erc-dcc.el: Make dcc-chat-ended a notice
- Remove now bogus comment
-
-2003-01-08 Damien Elmes <erc@repose.cx>
-
- * erc-dcc.el(erc-pack-int): from erc-packed-int
- (erc-unpack-int): new
-
- * erc-dcc.el(erc-unpack-str): added
-
-2003-01-08 Mario Lang <mlang@delysid.org>
-
- * erc.el(erc-server-482):
- New handler, handles KICK reply if you're not channel-op
-
- * erc-dcc.el: Document SEND in erc-dcc-alist.
- Move sproc, parent-proc and file into erc-dcc-alist
-
- * erc-dcc.el: stubs
-
- * erc-dcc.el(erc-dcc-get-host):
- Change :iface to :local since Kim committed it now to CVS emacs
-
- * erc-dcc.el(erc-dcc-get-host):
- New function, requires the not-yet-in-CVS-emacs local-address.patch to process.c.
- Some other minor additions
-
-2003-01-08 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc-cmd-IGNORE):
- Now returns t to prevent "Bad syntax" error.
- (erc-cmd-UNIGNORE): Now returns t to prevent "Bad syntax" error.
- (erc-server-PRIVMSG-or-NOTICE): Capitalized first word in message to user.
-
- * erc.el(erc-scroll-to-bottom):
- Temporarily bind resize-mini-windows to nil so that
- users who have it set to a non-nil value will not suffer from premature
- minibuffer shrinkage due to the below recenter call. I have no idea why
- this works, but it solves the problem, and has no negative side effects.
-
-2003-01-07 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-dcc.el:
- erc-dcc-ctcp-query-chat-regexp: The IP is not really an IP, but a
- number (no . allowed there).
- (erc-dcc-send-ctcp-string): use let* here to avoid cluttering up the
- match data.
- Also, use erc-decimal-to-ip to get the IP.
- (erc-ip-to-decimal): Removed some pasted ERC timestamps
- (erc-decimal-to-ip): New function.
- erc-dcc-chat-mode-map: Return map in the initialization.
-
-2003-01-07 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-match.el(erc-match-fool-p):
- Changed to call erc-match-directed-at-fool-p instead of
- erc-directed-at-fool-p.
-
-2003-01-07 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el(erc-cmd-DCC):
- Change (cond ... (t nil)) to (when ...)
-
- * erc-dcc.el: Use erc-current-nick-p
-
-2003-01-07 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el:
- erc-join-buffer: Added 'window-noselect to docstring and :type.
- erc-auto-query: Added 'window-noselect to :type.
- (erc): Treat erc-join-buffer being 'window-noselect appropriately.
-
- * erc.el(erc-current-nick-p): New function.
- (erc-nick-equal-p): New function.
- (erc-already-logged-in), (erc-server-JOIN), (erc-auto-query),
- (erc-server-PRIVMSG-or-NOTICE): Use erc-current-nick-p.
- (erc-update-channel-member): Use erc-nick-equal-p.
-
- * erc-match.el(erc-match-current-nick-p):
- Renamed from erc-current-nick-p
- (erc-match-pal-p): Renamed from erc-pal-p
- (erc-match-fool-p): Renamed from erc-fool-p
- (erc-match-keyword-p): Renamed from erc-keyword-p
- (erc-match-dangerous-host-p): Renamed from erc-dangerous-host-p
- (erc-match-directed-at-fool-p): Renamed from erc-directed-at-fool-p
- (erc-match-message): Use erc-match-TYPE-p instead of erc-TYPE-p
-
- * erc.el:
- Support for IRCnets' "nick/channel temporarily unavailable"
-
- (erc-nickname-in-use): New function (mostly copied from erc-server-433).
- (erc-server-433): Use erc-nickname-in-use
- (erc-server-437): New function.
- erc-server-hook-list: Added (437 erc-server-437).
-
-2003-01-07 Mario Lang <mlang@delysid.org>
-
- * erc-fill.el: Add autoload cookie
-
- * erc-notify.el:
- Now also pass SERVER argument to signon/off hooks, and provide a erc-notify-signon/off function for echo-area printing
-
- * erc-notify.el(erc-notiy-QUIT):
- Change use of delq to delete, delq does not work with strings
-
-2003-01-06 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-ctcp-query-VERSION):
- v%s -> %s, so we are no longer vVersion...
-
-2003-01-06 Mario Lang <mlang@delysid.org>
-
- * erc.el: Small change to erc-ison-p, and fixme tag
-
-2003-01-06 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el(erc):
- Fixed bug where variable "away" would be nil in new channel buffers
- even if the user is away when joining the channel.
- (erc-strip-controls): Fixed a bug where erc-strip-controls accidentally
- removed all text properties from the string.
-
-2003-01-06 Mario Lang <mlang@delysid.org>
-
- * erc-dcc.el:
- Some stub functions, some code, nothing really works yet
-
- * erc.el(erc-ison-p): New function
-
- * erc-dcc.el: Some functions which will be needed for dcc send
-
- * erc-dcc.el(erc-ip-address-to-decimal):
- New function, thanks lawrence
-
- * erc-dcc.el: Again, simplify code, fix stuff, DCC CHAT works now
-
- * erc-dcc.el: Many fixes, chat nearly works now
-
- * erc-netsplit.el: Also detect fast netsplit/joins
-
- * erc-dcc.el: some more fixes
-
- * erc-dcc.el: Fixup stage 1, now dcc get works
-
- * erc-dcc.el: make /dcc LIST work
-
- * erc-dcc.el:
- Initial checkin, don't use it! its really far from complete. Hackers: help!
-
- * erc-notify.el:
- New function erc-notify-NICK, and added signon/off hooks which were missing
-
-2003-01-05 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el(erc-truncate-buffer-to-size):
- set inhibit-read-only to t for the
- deletion. This is usually done by the function calling the hook, but
- not if it's called interactively. Also, rewrote some weird if/if
- combination.
-
- * erc-track.el(erc-track-shortennames):
- Documentation fix (erc-all-buffers is really
- erc-all-buffer-names)
-
- These changes make server buffers be tracked as well, as there are
- quite a few interesting things going on there (e.g. CTCP etc.)
- (erc-all-buffer-names): Check for (eq major-mode 'erc-mode) instead of
- erc-default-recipients.
- (erc-track-modified-channels): Don't require a default target (e.g.,
- this-channel being non-nil)
-
-2003-01-03 Damien Elmes <erc@repose.cx>
-
- * erc.el:
- erc-auto-query: can now be set to a symbol to control how new messages should
- be popped up (or not popped up, as the case may be)
- (erc-query): new function which handles the bulk of what (erc-cmd-QUERY) did
- previously
- (erc-cmd-QUERY): use (erc-query)
- (erc-auto-query): use (erc-query)
-
- * erc.el(erc-current-logfile):
- Downcase result of log generation function, as IRC is
- case insensitive. Fixes problems where "/query user" results in a different
- log file to a query from "User". Avoided adding an extra flag to control this
- behavior - if you think this was the wrong decision, please correct it and
- I'll remember it for next time.
-
-See ChangeLog.02 for earlier changes.
-
- Copyright (C) 2003, 2006-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
diff --git a/lisp/erc/ChangeLog.04 b/lisp/erc/ChangeLog.04
deleted file mode 100644
index 0d0e17f5d4f..00000000000
--- a/lisp/erc/ChangeLog.04
+++ /dev/null
@@ -1,2094 +0,0 @@
-2004-12-29 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-goodies.el (erc-interpret-controls-p): Changed docstring to
- reflect the new meaning if this is set to 'remove.
- (erc-controls-interpret): Rephrased docstring to be more accurate.
- (erc-controls-strip): New function that behaves like the
- recently-removed erc-strip-controls -- it removes all IRC color
- and highlighting control characters.
- (erc-controls-highlight): Changed to support the new 'remove value
- that variable erc-interpret-controls-p might have.
-
-2004-12-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-ibuffer.el, erc-list.el, erc-page.el, erc-speedbar.el:
- Changed all calls to erc-interpret-controls (which no longer
- exists) to call erc-controls-interpret (the new name of the same
- function).
-
-2004-12-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-goodies.el (erc-controls-interpret): Added this function to
- replace the recently-removed erc-interpret-controls. Also added
- a (require 'erc) to solve a byte-compile problem.
-
-2004-12-28 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-controls-interpret): Added this function to replace
- the recently-removed erc-interpret-controls.
-
-2004-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-truncate.el (erc-truncate-buffer-to-size): Check for
- logging even better (via lawrence).
-
-2004-12-26 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-truncate.el (erc-truncate-buffer-to-size): Much saner
- logging detection (via lawrence).
-
-2004-12-25 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-goodies.el (erc-controls-highlight): Treat single C-c
- correctly.
-
-2004-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-goodies.el, erc.el: Deleted IRC control character processing
- and implemented a sane version in erc-goodies.el as a module.
-
- * erc.el (erc-merge-controls, erc-interpret-controls,
- erc-decode-controls, erc-strip-controls, erc-make-property-list,
- erc-prepend-properties): Removed.
-
- (erc-interpret-controls-p, erc-interpret-mirc-color, erc-bold-face
- erc-inverse-face, erc-underline-face, fg:erc-color-face0,
- fg:erc-color-face1, fg:erc-color-face2, fg:erc-color-face3,
- fg:erc-color-face4, fg:erc-color-face5, fg:erc-color-face6,
- fg:erc-color-face7, fg:erc-color-face8, fg:erc-color-face9,
- fg:erc-color-face10, fg:erc-color-face11, fg:erc-color-face2,
- fg:erc-color-face13, fg:erc-color-face14, fg:erc-color-face15,
- bg:erc-color-face1, bg:erc-color-face2, bg:erc-color-face3,
- bg:erc-color-face4, bg:erc-color-face5, bg:erc-color-face6,
- bg:erc-color-face7, bg:erc-color-face8, bg:erc-color-face9,
- bg:erc-color-face10, bg:erc-color-face11, bg:erc-color-face2,
- bg:erc-color-face13, bg:erc-color-face14, bg:erc-color-face15,
- erc-get-bg-color-face, erc-get-fg-color-face,
- erc-toggle-interpret-controls): Moved.
-
- * erc-goodies.el (erc-beep-p, irccontrols, erc-controls-highlight,
- erc-controls-propertize): New.
-
-2004-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-goodies.el, erc.el: The Small Extraction of Stuff[tm] commit.
- Moved some functions from erc.el to erc-goodies.el, and
- transformed them to erc modules in the process.
- - imenu autoload stuff moved. I don't know why it is here at all.
- - Moved: scroll-to-bottom, make-read-only, distinguish-noncommands,
- smiley, unmorse, erc-occur (the last isn't a module, but still
- moved)
- (erc-input-line-position, erc-add-scroll-to-bottom,
- erc-scroll-to-bottom, erc-make-read-only, erc-noncommands-list,
- erc-send-distinguish-noncommands, erc-smiley, erc-unmorse,
- erc-occur): Moved from erc.el to erc-goodies.el.
- (smiley): Module moved from erc.el to erc-goodies.el.
- (scrolltobottom, readonly, noncommands, unmorse): New modules.
-
-2004-12-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-format-away-status): Use `a', not `away' - that's
- why it's there.
- (erc-update-mode-line-buffer): The values of `mode-line-process'
- and `mode-line-buffer-identification' are normally lists.
- Conform.
-
-2004-12-18 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-process-ctcp-query, erc-process-ctcp-reply): Display
- message in the active window, not the server window.
-
-2004-12-16 Edward O'Connor <ted@oconnor.cx>
-
- * erc-track.el (erc-track-position-in-mode-line): Check for
- 'erc-track-mode variable with boundp. From Adrian Aichner
- <adrian@xemacs.org>.
-
-2004-12-16 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-upcase-first-word): New function. The old way used
- in erc-send-ctcp-message would eat consecutive whitespace etc.
- (erc-send-ctcp-message, erc-send-ctcp-notice): Use it.
-
-2004-12-15 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el (erc-send-ctcp-message): Fix braino with my previous
- patch. It always helps to C-x C-s before `cvs commit'.
-
-2004-12-15 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el (erc-send-ctcp-message): Only upcase the ctcp command,
- and not the entire message. Brian Palmer's change of 2004-12-12 had broken /me.
- Shouting is bad! :)
-
-2004-12-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nets.el (erc-networks-alist): Change undernet to Undernet as
- is used in `erc-server-alist', so that completion works when using
- `erc-server-select'. This should fix Debian bug #282003 (erc:
- cannot connect to Undernet).
-
-2004-12-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (def-edebug-spec): Only run this if 'edebug is
- available.
-
-2004-12-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: The last change to `erc-mode-line-format' introduced a
- bug in XEmacs - it can't handle the #(" "...) strings at all. The
- following changes fix the bug and simplify the mode-line handling
- considerably. (erc-mode-line-format): Now defined as a string
- which will be formatted using `format-spec' and take the place of
- `mode-line-buffer-identification' in the mode line.
- (erc-header-line-format): Now defined as a string to be formatted
- using `format-spec'.
- (erc-prepare-mode-line-format): Removed.
- (erc-format-target, erc-format-target-and/or-server,
- erc-format-away-status, erc-format-channel-modes): New functions.
- Basically the old `erc-prepare-mode-line-format' split apart.
- (erc-update-mode-line-buffer): Set
- `mode-line-buffer-identification' to the formatted
- `erc-mode-line-format', set `mode-line-process' to ": CLOSED" if
- the connection has been terminated, and set `header-line-format'
- (if it is bound) to the formatted `erc-header-line-format', then
- do a `force-mode-line-update'.
-
-2004-12-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-modules): Disable modules removed with `customize'.
- (erc-update-modules): Try to give a more descriptive error
- message.
-
-2004-12-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc-complete.el, erc.el, erc-list.el, erc-nets.el,
- * erc-nicklist.el, erc-pcomplete.el, erc-replace.el, erc-speak.el,
- * erc-truncate.el (erc-buffers, erc-coding-systems, erc-display,
- erc-mode-line-and-header, erc-ignore, erc-query,
- erc-quit-and-part, erc-paranoia, erc-scripts, erc-old-complete,
- erc-list, erc-networks, erc-nicklist, erc-pcomplete, erc-replace,
- erc-truncate): New customization groups.
- (erc-join-buffer, erc-frame-alist, erc-frame-dedicated-flag,
- erc-reuse-buffers): Use 'erc-buffers as `:group'.
- (erc-default-coding-system, erc-encoding-coding-alist):
- Use 'erc-coding-systems as `:group'.
- (erc-hide-prompt, erc-show-my-nick, erc-prompt,
- erc-input-line-position, erc-command-indicator, erc-notice-prefix,
- erc-notice-highlight-type, erc-interpret-controls-p,
- erc-interpret-mirc-color, erc-minibuffer-notice,
- erc-format-nick-function): Use 'erc-display as `:group'.
- (erc-mode-line-format, erc-header-line-format,
- erc-header-line-uses-help-echo-p, erc-common-server-suffixes,
- erc-mode-line-away-status-format): Use 'erc-mode-line-and-header
- as `:group'.
- (erc-hide-list, erc-ignore-list, erc-ignore-reply-list,
- erc-minibuffer-ignored): Use 'erc-ignore as `:group'.
- (erc-auto-query, erc-query-on-unjoined-chan-privmsg,
- erc-format-query-as-channel-p): Use 'erc-query as `:group'.
- (erc-kill-buffer-on-part, erc-kill-queries-on-quit,
- erc-kill-server-buffer-on-quit, erc-quit-reason-various-alist,
- erc-part-reason-various-alist, erc-quit-reason, erc-part-reason):
- Use 'erc-quit-and-part as `:group'.
- (erc-verbose-server-ping, erc-paranoid, erc-disable-ctcp-replies,
- erc-anonymous-login, erc-show-channel-key-p): Use 'erc-paranoia as
- `:group'.
- (erc-startup-file-list, erc-script-path, erc-script-echo): Use
- 'erc-scripts as `:group'.
- (erc-nick-completion, erc-nick-completion-ignore-case,
- erc-nick-completion-postfix): Use 'erc-old-complete as `:group'.
- (erc-chanlist-progress-message, erc-no-list-networks,
- erc-chanlist-frame-parameters, erc-chanlist-hide-modeline,
- erc-chanlist-mode-hook): Use 'erc-list as `:group'.
- (erc-server-alist, erc-networks-alist): Use 'erc-networks as
- `:group'.
- (erc-settings): Use `defvar' instead of `defcustom' since this is
- only a draft which doesn't work.
- (erc-nicklist-window-size): Use 'erc-nicklist as `:group'.
- (erc-pcomplete-nick-postfix,
- erc-pcomplete-order-nickname-completions): Use 'erc-pcomplete as
- `:group'.
- (erc-replace-alist): Use 'erc-replace as `:group'.
- (erc-speak-filter-timestamp): Use 'erc-speak as `:group'.
- (erc-max-buffer-size): Use 'erc-truncate as `:group'.
-
-2004-12-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-scroll-to-bottom): Go to the end of the buffer
- before recentering. This allows editing multiple lines more
- conveniently in CVS Emacs. This also undos a change by antifuchs
- who said this goto-char would mess up redisplay. Extensive testing
- couldn't reproduce that problem.
-
-2004-12-12 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-send-ctcp-message): upcase the ctcp message (so that
- version becomes VERSION, for example).
- (erc-iswitchb): Make the argument optional in non-interactive
- invocation, so erc-iswitchb can be substituted directly for
- iswitchb in code.
-
-2004-12-11 Diane Murray <disumu@x3y2z1.net>
-
- * erc-track.el (erc-track-position-in-mode-line): Allow for the
- fact that `erc-track-mode' isn't bound when file is loaded.
-
-2004-12-11 Diane Murray <disumu@x3y2z1.net>
-
- * erc-track.el (erc-track-position-in-mode-line): New customizable
- variable. (erc-track-remove-from-mode-line): New function.
- Remove `erc-modified-channels-string' from the mode-line.
- (erc-track-add-to-mode-line): New function. Add
- `erc-modified-channels-string' to the mode-line using the value of
- `erc-track-position-in-mode-line' to determine whether to add it
- to the beginning or the end of `mode-line-modes' (only available
- with GNU Emacs versions above 21.3) or to the end of
- `global-mode-string'.
- (erc-track-mode, erc-track-when-inactive-mode): Use the new
- functions.
-
-2004-12-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-cmd-BANLIST): Use (buffer-name) and not
- (erc-default-target) for the buffer name - buffer names are case
- sensitive.
-
-2004-12-11 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-message-type): Added the message "MODE" to the known
- erc-message-type widget, so that (for example) people can tell
- erc-track-exclude-types to ignore mode changes. The others tag
- also needed to be made an inline list, so that it's merged with
- the given constants, instead of being inserted as a list.
-
-2004-12-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el, erc.el: Update to get ERC look nicely in CVS Emacs.
-
- * erc.el (erc-mode-line-format): When on CVS emacs, use the new
- format.
-
- * erc-track.el (track module): When on CVS emacs, modify
- mode-line-modes instead of global-mode-string. The latter is way
- to far too the right.
-
-2004-11-18 Mario Lang <mlang@delysid.org>
-
- * Makefile, debian/changelog: debian release 20041118-1
-
-2004-11-03 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-buttonize-nicks): Set default value to
- `t'. Updated documentation and customization `:type' to reflect
- usage.
-
-2004-10-29 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * AUTHORS: Added self.
-
-2004-10-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list.el: Added local variables for this file.
- (erc-list-version): New.
- (erc-cmd-LIST): Take &rest rather than &optional arguments, as was
- done in revision 1.21. Allow for input when called interactively.
- (erc-prettify-channel-list, erc-chanlist-toggle-sort-state): Use
- `unless' instead of when not.
-
-2004-10-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (erc-handle-unknown-server-response): Fixed so
- that the contents are only shown once.
- (MOTD): Display lines in the server buffer if it's the first MOTD
- sent upon connection. This is to avoid the problem of having the
- MOTD of one server showing up in another server's buffer if it took
- a while to get connected.
- (004): Fixed to show the user modes and channel modes correctly.
- (303): Now displays the nicknames returned by ISON instead of the
- user's nickname.
- (367, 368): Moved up into 300's section of the code. Added
- documentation. Use `multiple-value-bind' to set variables in 367.
- (391): Fixed so that the server name is shown correctly.
-
-2004-10-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-process-sentinel): Use CPROC instead of
- `erc-process' in debug message. Should fix a bug where an error
- saying "Buffer *scratch* has no process" would occur when
- disconnected.
- (erc-cmd-SV): Check for X toolkit after checking for more specific
- features. (erc--kill-server): Set `quitting' to non-nil so that
- we don't automatically reconnect.
-
-2004-10-05 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-ignored-user-p): Don't require regexes to match the
- beginning.
-
-2004-09-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: group erc: Moved to 'applications (patch by bojohan)
-
-2004-09-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-button.el (erc-button-remove-old-buttons): Remove 'keymap
- not 'local-map.
-
-2004-09-03 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el: JOIN response handler: Typo fix of the last
- commit.
-
-2004-09-03 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el: JOIN response handler: Run `erc-join-hook'
- without arguments as specified in the docstring.
-
-2004-08-27 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-send-current-line): Removed unused variable SENTP.
-
-2004-08-19 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: ERC-SEND-COMPLETED-HOOK used to be run when the prompt
- was already displayed. We restore this behavior (thanks to bojohan
- and TerryP for noticing). We also fix the docstring of
- ERC-SEND-COMPLETED-HOOK, since the hook is (and used to be) called
- even if nothing was sent to the server.
- (erc-send-completed-hook): Fixed docstring.
- (erc-send-current-line): Add incantation for
- erc-send-completed-hook.
- (erc-send-input): Remove incantation for erc-send-completed-hook.
-
-2004-08-18 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el: response-handler 368: Use s368, not s367.
-
-2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-scroll-to-bottom): Don't scroll when we're not
- connected anymore.
-
-2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el, erc.el: Handle /mode #emacs b output without
- errors and such. First, handle unknown format specs gracefully
- (that is, give a useful error). Then, provide handlers for the
- banlist replies.
-
- * erc-backend.el: New handler for 367 and 368. Removed from default
- handler.
-
- * erc.el: Provide english catalog for s367 and s368.
- (erc-format-message): Give an error message when we don't find an
- entry.
-
-2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-fill.el: erc-fill-variable could be confused about really
- long nicks. We put an upper limit on the length of the fill prefix.
- (erc-fill-variable): Adjust fill-prefix.
- erc-fill-variable-maximum-indentation: New variable.
-
-2004-08-17 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-send-input): Fixed a bug where this function
- referenced variable "input" instead of variable "str".
-
-2004-08-16 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el (erc-chanlist-highlight-line): Fixed a bug where
- this function failed to set the correct face for highlighting the
- current line.
-
-2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-fill.el (erc-fill-variable): Don't fuck up when the
- looking-at didn't work.
-
-2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-send-single-line): Call the hooks to change the
- appearance for something only if we actually inserted something,
- doh.
- (erc-display-command): Display the prompt outside of the area that
- set the text properties on.
-
-2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: Refactored erc-send-current-line. This should fix some
- dormant bugs, and make the whole thing actually readable. Yay.
- Some changes in behavior were made. Whitespace at the end of lines
- sent is not removed anymore, but that shouldn't bother anyone.
- Additionally, errors in commands or hooks shouldn't prevent the
- prompt from showing up again now.
- (erc-parse-current-line): Removed.
- (erc-send-current-line): Refactored.
- (erc-send-input): New function.
- (erc-send-single-line): New function.
- (erc-display-command): New function.
- (erc-display-msg): New function.
- (erc-user-input): New function.
-
-2004-08-13 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-cmd-SERVER): Use newer keyword call interface to
- erc-select, and handle the error if it can't resolve the host.
-
-2004-08-11 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el, erc.el: erc-backend.el (404 response handler):
- New function. We now support "cannot send to channel".
-
- * erc.el (erc-define-catalog call): Added s404.
- (erc-ctcp-ECHO-reply, erc-ctcp-CLIENTINFO-reply,
- erc-ctcp-FINGER-reply, erc-ctcp-PING-reply, erc-ctcp-TIME-reply,
- erc-ctcp-VERSION-reply): Display reply in the active window, not
- the server window.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-with-all-buffers-of-server): Actually make it left
- to right, doh.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-with-all-buffers-of-server): Evaluate left-to-right
- so we don't surprise a user.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-process-input-line): Parentophobia! Another
- paren-fix.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el: PRIVMSG NOTICE response handler: Killed one paren
- too much. Poor paren. Got resurrected.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-track.el: Make server buffers showing up in the mode line
- optional. Thanks to Daniel Knapp on the EmacsWiki for this patch.
-
- erc-track-exclude-server-buffer: New variable.
- (erc-track-modified-channels): Return a server buffer only if
- erc-track-exclude-server-buffer is nil.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-cmd-DESCRIBE): Don't parse arguments.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-truncate.el (erc-truncate-buffer-to-size): Use
- erc-insert-marker, not (point-max), to decide the length of the
- buffer. A long input line shouldn't make the buffer smaller.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-macs.el, erc-members.el: The change to hashes for channel
- members has been made some time ago. Clean up the various tries to
- do this in the past.
-
- erc-macs.el: Removed. erc-members.el: Removed.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-backend.el, erc-ibuffer.el, erc-members.el, erc.el: Nothing
- big changed here. Really. Uhm, maybe the info-buffers are gone or
- so. Can't really remember. Don't worry, nothing important is
- missing.
-
- erc-speedbar.el looks nice btw, did you know?
-
- Adjusted various places in erc.el, erc-backend.el, erc-ibuffer.el
- and erc-members.el - too numerous to list here, sorry.
-
- * erc.el: erc-use-info-buffers: Removed. erc-info-mode-map:
- Removed.
- (erc-info-mode): Removed.
- (erc-find-channel-info-buffer): Removed.
- (erc-update-channel-info-buffer): Removed.
- (erc-update-channel-info-buffers): Removed.
-
- * erc-members.el: erc-update-member renamed to
- erc-update-channel-member for better clarity.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: This change improves the help output on a bogus command
- invocation. We display the command as it would be typed by the
- user, not as it is seen by Emacs.
-
- (erc-get-arglist): Is now called erc-function-arglist, and returns
- now an arglist without the enclosing parens.
- (erc-command-name): New function.
- (erc-process-input-line): Pass the command name, not the function
- name.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-process-input-line): Fix bug when the command
- doesn't have an arglist or no documentation. Thanks bojohan again
- :)
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el (erc-add-entry-to-list),
- (erc-remove-entry-from-list): Update docstring, a TEST argument is
- not given.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-with-buffer): Really fix this docstring.
-
-2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-with-buffer): Fix double evaluation in macro, and
- fix docstring.
-
-2004-08-10 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-cmd-JOIN): Use erc-member-ignore-case instead of
- member-ignore-case.
-
-2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-backend.el: Define an "Edebug specification" for the
- `define-erc-response-handler' macro. This means that one can step
- through response handlers defined by this macro with edebug. Maybe
- more macros would benefit from this?
-
-2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-pcomplete.el (pcomplete/erc-mode/CTCP): New function.
- Completion for the /CTCP command. (erc-pcomplete-ctcp-commands):
- New variable. List of ctcp commands.
-
-2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-list.el: Clean up docstrings.
- (erc-prettify-channel-list): Extend properties to cover the entire
- line, including the newline, to make it look
- better.
- (erc-chanlist-highlight-line): Ditto.
- (erc-chanlist-mode-hook): Make it a defcustom.
-
-2004-08-09 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-compute-full-name): Typo fix, should be full-name,
- not name.
-
-2004-08-09 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc): Setup the buffer to be shown in a window at the
- end of this function. This enables 'window-noselect to work
- properly.
- (erc, erc-send-current-line): Fix some
- goto-char/open-line/goto-char to goto-char/insert.
-
-2004-08-08 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-parse-user): Live with bogus info from bouncers.
-
-2004-07-31 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-select): Change the docstring to reflect the new
- arguments; include the arguments in the docstring for non-cvs
- emacs. Change the parameters to call erc-compute-* instead of
- using the erc-* variables directly.
- (erc-compute-server): Made argument optional.
- (erc-compute-nick): ditto.
- (erc-compute-full-name): ditto. (erc-compute-port): ditto.
-
-2004-07-30 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-cmd-BANLIST): Fixed a bug where channel-banlist was
- not reset to nil before fetching an updated banlist from the
- server.
-
-2004-07-30 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-cmd-BANLIST): Fixed a bug where the
- 'received-from-server property on variable channel-banlist was not
- being reset to nil. This fixes the symptom where one types
- /BANLIST and sees "No bans for channel: #whatever" when you know
- there are bans.
-
-2004-07-23 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-select-read-args): Use erc-compute-nick to
- calculate the default nickname
-
-2004-07-20 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-process-sentinel-1): New function. This is an
- auxiliary function refactored out of erc-process-sentinel to
- decide a server buffer's fate (whether it should be killed, and
- whether erc should attempt to auto-reconnect). Michael Olson
- <mwolson@gnu.org> helped with this.
- (erc-kill-server-buffer-on-quit): New variable. Used in
- erc-process-sentinel-1 to decide whether to kill a server buffer
- when the user quit normally.
- (erc-process-sentinel): Auxiliary function erc-process-sentinel-1
- split out. The function body has `with-current-buffer' wrapped
- around it, to ensure separation of messages if multiple
- connections were being made. Use `if' instead of `cond' in places
- where the decision is binary. The last (useless, since the server
- connection is closed) prompt in the server buffer is removed.
- Color "erc terminated" and "erc finished" messages with
- erc-error-face. Mark the buffer unmodified so that, if not killed
- automatically, the user is not prompted to save it.
-
-2004-07-16 Brian Palmer <bpalmer@gmail.com>
-
- * erc.el (erc-select-read-args): New function. Prompts the user
- for arguments to pass to erc-select and erc-select-ssl.
- (erc-select): Use (erc-select-read-args) when called interactively
- to get its arguments. When non-interactively, use keyword
- arguments.
- (erc-select-ssl): Ditto.
- (erc-compute-port): New function. Parallel to erc-compute-server,
- but comes up with a default value for an IRC server's port.
-
-2004-07-16 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el (erc-match-message): Quote the current nickname.
-
-2004-07-12 Brian Palmer <bpalmer@gmail.com>
-
- * erc-list.el (erc-chanlist-mode): Remove explicit invocation of
- erc-chanlist-mode-hook, since it's automatically invoked by
- define-derived-mode
-
-2004-07-03 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el (erc-match-current-nick-p): Quote current nick for
- regexp parsing.
-
-2004-06-27 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-nickserv.el (erc-nickserv-identify-mode): Fix erroneous
- parentheses in call to `completing-read'.
-
-2004-06-23 Alex Schroeder <alex@gnu.org>
-
- * Makefile (release): Depend on autoloads, and copy erc-auto.el
- into the tarball.
-
-2004-06-14 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-log-irc-protocol): Fixed minor bug where each line
- received from a server was logged as two lines (one with text and
- one blank).
-
-2004-06-08 Brian Palmer <bpalmer@gmail.com>
-
- * erc-list.el (erc-chanlist-frame-parameters): Made customizable.
- (erc-chanlist-header-face): Changed to use defface with some
- reasonable defaults instead of make-face, and removed the
- associated -face variable.
- (erc-chanlist-odd-line-face): Ditto.
- (erc-chanlist-even-line-face): Ditto.
- (erc-chanlist-highlight-face): New variable. Holds a face used for
- highlighting the current line.
- (erc-cmd-LIST): Use erc-member-ignore-case instead of
- member-ignore-case.
- (erc-chanlist-post-command-hook): Change to move the highlight
- overlay instead of refontifying the entire buffer.
- (erc-chanlist-dehighlight-line): Added to detach the highlight
- overlay from the buffer.
-
-2004-05-31 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: erc-mode-line-format: Add column numbers.
-
-2004-05-31 Adrian Aichner <adrian@xemacs.org>
-
- * erc-autojoin.el: Typo fix.
-
- * erc-dcc.el (erc-dcc-do-GET-command): Use expand-file-name.
- (erc-dcc-get-file): XEmacs set-buffer-multibyte compatibility.
-
- * erc-log.el: Append `erc-log-setup-logging' to
- `erc-connect-pre-hook' so that `erc-initialize-log-marker' is run
- first (markers are needed by `erc-log-setup-logging').
- (erc-enable-logging): Docstring fix.
- (erc-log-setup-logging): Move `erc-log-insert-log-on-open' to (1-
- (point-max)) when doing `erc-log-insert-log-on-open'. Modified
- version of a patch by Lawrence Mitchell.
- (erc-log-all-but-server-buffers): Do `save-excursion' as well.
- (erc-current-logfile): Pass buffer name as target
- argument to `erc-generate-log-file-name-function' if
- `erc-default-target' is nil.
- (erc-generate-log-file-name-with-date): Use expand-file-name.
- (erc-generate-log-file-name-short): Ditto.
- (erc-save-buffer-in-logs): Do `save-excursion' and test whether
- erc-last-saved-position is a marker.
-
- * erc-members.el: Avoid miscompiling macro `erc-log' and
- `with-erc-channel-buffer' by requiring 'erc at compile time.
-
- * erc-sound.el: Use expand-file-name.
-
- * erc.el (erc-debug-log-file): Ditto.
- (erc-find-file): Ditto.
-
-2004-05-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el, erc-backend.el (erc-cmd-BANLIST): Added a missing "'"
- that was preventing /BANLIST from working. In erc-backend.el,
- added server response handler for 367 and 368 responses to get
- /BANLIST working.
-
-2004-05-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el: Removed an eval-when-compile that was preventing the
- byte-compiled version of this file from loading.
-
-2004-05-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el: Undid part of my last change. I suspect it was wrong.
-
-2004-05-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el: Silenced several byte-compiler warnings.
-
-2004-05-26 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-log-irc-protocol): Fixed problem where this function
- misformatted IRC protocol text if multiple lines were received from
- the server at one time.
-
-2004-05-25 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-toggle-debug-irc-protocol): Cosmetic changes to the
- informational text in the *erc-protocol* buffer.
-
-2004-05-24 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-log-irc-protocol, erc-process-filter): Now the lines
- inserted in the *erc-protocol* buffer are prefixed with the name
- of the network to/from which the data is going/coming. This makes
- reading the *erc-protocol* buffer much easier when connected to
- multiple networks.
-
-2004-05-23 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * erc-backend.el: Fixes server message parsing so that command
- arguments specified after the colon are not treated specially. All
- arguments are added to the `command-args' field, and the
- `contents' points to the last element in the `command-args' list.
- This allows ERC to connect to networks such as Undernet. Although
- keeping `contents' allows many of the response handlers to
- continue to work as-is, many other are probably broken by this
- patch.
-
-2004-05-20 Lawrence Mitchell <wence@gmx.li>
-
- * HACKING: Add comment that C-c C-a can be useful if you write
- ChangeLog entries using Emacs' standard functions.
-
-2004-05-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc-speedbar.el: Ignore errors when attempting to require dframe
- (there are a couple implementations of speedbar, one of which uses
- of dframe).
- (erc-speedbar-version): New.
- (erc-speedbar-goto-buffer): Use dframe functions if dframe is
- available.
-
-2004-05-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autojoin.el: Added local variables for this file.
- (erc-autojoin-add): The channel name is in `erc-response.contents'.
-
-2004-05-17 Mario Lang <mlang@delysid.org>
-
- * erc-log.el: Don't autoload a define-key statement, erc-mode-map
- might not be known yet
-
-2004-05-16 Lawrence Mitchell <wence@gmx.li>
-
- * erc-backend.el (erc-parse-server-response): Revert to original
- `erc-parse-line-from-server' version, since new version breaks for
- a number of edge cases.
-
-2004-05-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (erc-handle-unknown-server-response): New
- function. Added to `erc-default-server-functions'. Display
- unknown responses to the user.
- (221): Don't show nickname in modes list.
- (254): Fixed to use 's254.
- (303): Added docstring.
- (315, 318, 323, 369): Ignored responses grouped together.
- (391): New.
- (406, 432): Use ?n, not ?c in `erc-display-message'.
- (431, 445, 446, 451, 462, 463, 464, 465, 481, 483, 485, 491, 501,
- 502): All error responses with no arguments grouped together.
-
-2004-05-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-message-type-member): Use `erc-response.command'.
- `erc-track-exclude-types' should be respected again.
- (erc-cmd-TIME): Fixed to work with and without server given as
- argument.
- (erc-define-catalog): Added, s391, s431, s445, s446, s451, s462,
- s463, s464, s465, s483, s484, s485, s491, s501, s502.
-
-2004-05-14 Lawrence Mitchell <wence@gmx.li>
-
- * HACKING: Typo fix.
-
-2004-05-14 Lawrence Mitchell <wence@gmx.li>
-
- * Makefile (erc-auto.el): Pass -f flag to rm so that we don't fail
- if erc-auto.elc doesn't exist.
-
-2004-05-14 Lawrence Mitchell <wence@gmx.li>
-
- * erc-backend.el (erc-with-buffer): Autoload.
- (erc-parse-server-response): XEmacs' `replace-match' only replaces
- subexpressions when operating on buffers, not strings, work around
- it.
- (461): Command with invalid arguments is `second', not `third'.
-
-2004-05-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-notify.el (erc-notify-NICK): Use `erc-response.contents' to
- get nickname.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-track.el: Indentation fixes.
- (track-when-inactive): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-notify.el (notify): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
- (erc-notify-timer, erc-notify-JOIN, erc-notify-NICK)
- (erc-notify-QUIT): Use new accessors for PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nickserv.el (services, erc-nickserv-identify-mode): Use
- `erc-server-FOO-functions', not `erc-server-FOO-hook.
- (erc-nickserv-identify-autodetect): Use new accessors for PARSED
- argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-netsplit.el (netsplit): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
- (erc-netsplit-JOIN, erc-netsplit-MODE, erc-netsplit-QUIT): Use new
- accessors for PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nets.el: Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-menu.el (erc-menu-definition): Only allow listing of
- channels if `erc-cmd-LIST' is fboundp.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-match.el: Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
- (erc-get-parsed-vector-nick, erc-get-parsed-vector-type): Use new
- accessors for PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-list.el (erc-chanlist, erc-chanlist-322): Use new accessors
- for PARSED argument. Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-ezbounce.el (erc-ezb-notice-autodetect): Use new accessors
- for PARSED argument.
- (erc-ezb-initialize): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-dcc.el: Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
- (erc-dcc-no-such-nick): Use new accessors for PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-bbdb.el (erc-bbdb-whois, erc-bbdb-JOIN, erc-bbdb-NICK): Use
- new accessors for PARSED argument.
- (BBDB): Use `erc-server-FOO-functions', not `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-autojoin.el (autojoin): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
- (erc-autojoin-add, erc-autojoin-remove): Use new accessors for
- PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-autoaway.el (autoaway): Use `erc-server-FOO-functions', not
- `erc-server-FOO-hook.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-backend): Require.
- (erc-disconnected-hook, erc-join-hook, erc-quit-hook)
- (erc-part-hook, erc-kick-hook): Docstring fix, we now use
- `erc-server-FOO-functions', rather than `erc-server-FOO-hook'.
- (erc-event-to-hook-name, erc-event-to-hook): Remove.
- (erc-once-with-server-event)
- (erc-once-with-server-event-global): Use `erc-get-hook'
- (erc-process-filter): Use `erc-parse-server-response'.
- (erc-cmd-IDLE, erc-cmd-BANLIST, erc-cmd-MASSUNBAN): New accessors
- for PARSED argument. Rename all `erc-server-FOO-hook' to
- `erc-server-FOO-functions'.
- (erc-server-364-hook, erc-server-365-hook, erc-server-367-hook)
- (erc-server-368-hook, erc-server-KILL-hook)
- (erc-server-PONG-hook, erc-server-200-hook, erc-server-201-hook)
- (erc-server-202-hook, erc-server-203-hook, erc-server-204-hook)
- (erc-server-205-hook, erc-server-206-hook, erc-server-208-hook)
- (erc-server-209-hook, erc-server-211-hook, erc-server-212-hook)
- (erc-server-213-hook, erc-server-214-hook, erc-server-215-hook)
- (erc-server-216-hook, erc-server-217-hook, erc-server-218-hook)
- (erc-server-219-hook, erc-server-241-hook, erc-server-242-hook)
- (erc-server-243-hook, erc-server-244-hook, erc-server-249-hook)
- (erc-server-261-hook, erc-server-262-hook, erc-server-302-hook)
- (erc-server-323-hook, erc-server-342-hook, erc-server-351-hook)
- (erc-server-381-hook, erc-server-382-hook, erc-server-391-hook)
- (erc-server-392-hook, erc-server-393-hook, erc-server-394-hook)
- (erc-server-395-hook, erc-server-402-hook, erc-server-404-hook)
- (erc-server-407-hook, erc-server-409-hook, erc-server-411-hook)
- (erc-server-413-hook, erc-server-414-hook, erc-server-415-hook)
- (erc-server-422-hook, erc-server-423-hook, erc-server-424-hook)
- (erc-server-431-hook, erc-server-436-hook, erc-server-437-hook)
- (erc-server-441-hook, erc-server-443-hook, erc-server-444-hook)
- (erc-server-445-hook, erc-server-446-hook, erc-server-451-hook)
- (erc-server-462-hook, erc-server-463-hook, erc-server-464-hook)
- (erc-server-465-hook, erc-server-467-hook, erc-server-471-hook)
- (erc-server-472-hook, erc-server-473-hook, erc-server-483-hook)
- (erc-server-491-hook, erc-server-502-hook): Remove.
- (erc-call-hooks, erc-parse-line-from-server): Remove
- (erc-server-hook-list): Remove. Remove top-level call too.
- (erc-server-ERROR, erc-server-INVITE, erc-server-JOIN)
- (erc-server-KICK, erc-server-MODE, erc-server-NICK)
- (erc-server-PART, erc-server-PING, erc-server-PONG)
- (erc-server-PRIVMSG-or-NOTICE, erc-server-QUIT)
- (erc-server-TOPIC, erc-server-WALLOPS, erc-server-001)
- (erc-server-004, erc-server-005, erc-server-221, erc-server-252)
- (erc-server-253, erc-server-254, erc-server-301, erc-server-303)
- (erc-server-305, erc-server-306, erc-server-311-or-314)
- (erc-server-312, erc-server-313, erc-server-317, erc-server-319)
- (erc-server-320, erc-server-321, erc-server-322, erc-server-324)
- (erc-server-329, erc-server-330, erc-server-331, erc-server-332)
- (erc-server-333, erc-server-341, erc-server-352, erc-server-353)
- (erc-server-366, erc-server-MOTD, erc-server-379)
- (erc-server-401, erc-server-403, erc-server-405, erc-server-406)
- (erc-server-412, erc-server-421, erc-server-432, erc-server-433)
- (erc-server-437, erc-server-442, erc-server-461, erc-server-474)
- (erc-server-475, erc-server-477, erc-server-481, erc-server-482)
- (erc-server-501): Move to erc-backend.el
- (erc-auto-query, erc-banlist-store, erc-banlist-finished)
- (erc-banlist-update, erc-connection-established)
- (erc-process-ctcp-query, erc-display-server-message): Use new
- accessors for PARSED argument.
-
-2004-05-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc-backend.el (erc-parse-server-response)
- (erc-handle-parsed-server-response, erc-get-hook)
- (define-erc-response-handler): New functions.
- (erc-response): New struct for server responses.
- (erc-server-responses): New variable.
- (erc-call-hooks): Move from erc.el and rework.
- (ERROR, INVITE, JOIN, KICK, MODE, NICK, PART, PING, PONG)
- (PRIVMSG, NOTICE, QUIT, TOPIC, WALLOPS, 001, MOTD, 376, 004)
- (252, 253, 254, 250, 301, 303, 305, 306, 311, 312, 313, 315)
- (317, 318, 319, 320, 321, 322, 324, 329, 330, 331, 332, 333)
- (341, 352, 353, 366, 369, 379, 401, 403, 405, 406, 412, 421)
- (432, 433, 437, 442, 461, 474, 477, 481, 482, 501, 323, 221)
- (002, 003, 371, 372, 374, 375, 422, 251, 255, 256, 257, 258)
- (259, 265, 266, 377, 378, 314, 475, 364, 365, 367, 368, 381)
- (382, 391, 392, 393, 394, 395, 200, 201, 202, 203, 204, 205)
- (206, 208, 209, 211, 212, 213, 214, 215, 216, 217, 218, 219)
- (241, 242, 243, 244, 249, 261, 262, 302, 342, 351, 402, 404)
- (407, 409, 411, 413, 414, 415, 423, 424, 431, 436, 441, 443)
- (444, 445, 446, 451, 462, 463, 464, 465, 467, 471, 472, 473)
- (483, 491, 502, 005, KILL): Move from erc.el and rework using
- `define-erc-response-handler' and erc-response struct.
-
-2004-05-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: A few bug fixes to avoid errors after disconnect,
- including the "Selecting deleted buffer" bug.
- (erc-channel-user-op-p, erc-channel-user-voice-p): Make sure NICK
- is non-nil (`erc-current-nick' can return nil).
- (erc-server-buffer): Make sure the buffer isn't a #<killed
- buffer>.
- (erc-server-buffer-live-p): New function.
- (erc-display-line, erc-join-channel, erc-prepare-mode-line-format,
- erc-away-p): Use `erc-server-buffer-live-p' to make sure process
- buffer exists.
- (erc-send-current-line): If there is no server buffer, let the
- user know.
-
-2004-05-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-log.el: C-c C-l keybinding now defined in
- erc-log.el.
- (erc-log-version): New.
- (erc-cmd-JOIN): Fix applied for bug where /join -invite causes
- errors when there's no `invitation'.
-
-2004-05-11 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-cmd-JOIN): Make sure `chnl' is non-nil before trying
- to join anything (chnl is not set if /join -invite is used but
- there's no `invitation').
-
-2004-05-10 Diane Murray <disumu@x3y2z1.net>
-
- * erc-log.el: Define C-c C-l keybinding outside of `erc-log-mode',
- making it available all the time; autoload definition.
- (erc-log-version): New.
-
-2004-05-09 Diane Murray <disumu@x3y2z1.net>
-
- * AUTHORS, CREDITS, Makefile, erc-autoaway.el, erc-autojoin.el,
- erc-button.el, erc-chess.el, erc-dcc.el, erc-ezbounce.el,
- erc-fill.el, erc-ibuffer.el, erc-imenu.el, erc-lang.el,
- erc-list.el, erc-log.el, erc-macs.el, erc-match.el, erc-members.el,
- erc-menu.el, erc-nets.el, erc-netsplit.el, erc-nickserv.el,
- erc-notify.el, erc-page.el, erc-ring.el, erc-speak.el,
- erc-speedbar.el, erc-stamp.el, erc-track.el, erc-truncate.el,
- erc-xdcc.el, erc.el: Applied all relevant bug fixes and code
- cleanup made between the time of the ERC_4_0_RELEASE tag until now.
-
-2004-05-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el: Updated copyright years.
-
-2004-05-09 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-channel-info-buffer): Correct bug in sorting
- of channel users. Tiny change from Andreas Schwab
- <schwab@suse.de>.
-
-2004-05-09 Lawrence Mitchell <wence@gmx.li>
-
- * erc-fill.el (erc-fill-variable): Fix docstring.
-
-2004-05-09 Lawrence Mitchell <wence@gmx.li>
-
- * erc-button.el (erc-button-add-button): Use 'keymap
- text-property, rather than 'local-map, since it's cross-emacs
- compatible. Pass :mouse-down-action into `widget-convert-button'
- as 'erc-button-click-button, to make XEmacs happy. Replace bogus
- reference to erc-widget-press-button with erc-button-press-button.
- (erc-button-click-button): New (ignored) first argument, to make
- XEmacs behave when pressing buttons.
- (erc-button-press-button): New (ignored) &rest argument.
-
-2004-05-09 Adrian Aichner <adrian@xemacs.org>
-
- * erc-log.el (erc-conditional-save-buffer): Fix docstring
- reference to erc-save-queries-on-quit.
- (erc-conditional-save-queries): Ditto.
-
-2004-05-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-speedbar.el: Updated copyright years. Added local variables
- for this file; fixed indenting.
- (erc-speedbar): New group.
- (erc-speedbar-sort-users-type): New variable.
- (erc-speedbar-buttons): Handle query buffers (fixes a bug where an
- error would be thrown if the current buffer was a query). Ignore
- unknown buffers.
- (erc-speedbar-expand-channel): Show limit and key with channel
- modes. Sort users according to `erc-speedbar-sort-users-type'.
- (erc-speedbar-insert-user): Fixed bug where only nicks with more
- info were being listed, and those were shown twice.
- (erc-speedbar-goto-buffer): Don't use dframe functions, as dframe
- isn't available with the default speedbar.
-
-2004-05-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-sort-channel-users-alphabetically): New function.
- (erc-server-412, erc-server-432, erc-server-475): New functions.
- (erc-server-412-hook, erc-server-432-hook, erc-server-475-hook):
- Use them.
- (erc-server-401, erc-server-403, erc-server-405)
- (erc-server-421, erc-server-474, erc-server-481): Use catalog
- messages.
- (erc-define-catalog): Added s401, s403, s405, s412, s421, s432,
- s474, s475, and s481.
-
-2004-05-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nickserv.el: Added documentation to Commentary, Usage.
- Removed `outline-mode' from file local variables.
- (erc-services-mode): Use `erc-nickserv-identify-mode' to add
- hooks.
- (erc-nickserv-identify-mode): New function.
- (erc-nickserv-identify-mode): New variable.
- (erc-prompt-for-nickserv-password, erc-nickserv-passwords):
- Changed docstring.
- (erc-nickserv-identify-autodetect): Use
- `erc-nickserv-call-identify-function'. Docstring change.
- (erc-nickserv-identify-on-connect,
- erc-nickserv-identify-on-nick-change,
- erc-nickserv-call-identify-function): New functions.
- (erc-nickserv-identify): PASSWORD is not optional. Autoload
- function.
-
-2004-05-05 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-join-hook, erc-quit-hook, erc-part-hook,
- erc-kick-hook, erc-connect-pre-hook): Now customizable.
- (erc-nick-changed-functions): New hook.
- (erc-server-NICK): Run `erc-nick-changed-functions' with the
- arguments NEW-NICK and OLD-NICK.
- (erc-channel-user-voice-p, erc-channel-user-voice-p): Shortened
- docstring.
-
-2004-05-05 Lawrence Mitchell <wence@gmx.li>
-
- * HACKING: New section on function/variable naming and coding
- conventions.
-
-2004-05-05 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-wash-quit-reason): Quote regexp special characters
- in NICK, LOGIN and HOST.
-
-2004-05-04 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-server-parameters): Typo fix in docstring.
- (erc-input-line-position): `:type' is now a choice between integer
- and nil. (erc-mode-map): Bind `erc-get-channel-mode-from-keypress'
- to C-c C-o instead of C-c RET (C-c C-m). (erc-cmd-GQUIT): Use
- REASON as argument when calling `erc-cmd-QUIT'.
-
-2004-05-03 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nicklist.el: Initial version.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el: Added local variables for file, fixed indenting.
- (erc-menu-version): New variable.
- (erc-menu-definition): "List channels": New. "Join channel": Use
- `erc-connected' as test. "Start a query": New. "List channel
- operators": New. "Input action": Moved up. "Set topic": Fixed
- test so it's only active in channels. "Leave this channel": Moved
- down. "Track hidden channel buffers": Removed. "Enable/Disable
- ERC Modules": New.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-mode-map): Removed binding for
- `erc-save-buffer-in-logs' (moved to erc-log.el).
- (erc-cmd-QUERY, erc-cmd-OPS): Now interactive.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-log.el: Added local variables for this file.
- (erc-log-channels-directory): Added directory as a choice in
- `:type'.
- (define-erc-module): Define and undefine key binding (C-c
- C-l) for `erc-save-buffer-in-logs' here.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nets.el: Added local variables for this file.
- (erc-networks-alist): Fixed `:type' to work better in
- customization.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-match.el: Added local variables for file. (erc-keywords):
- Use `list' instead of `cons' in `:type'. Fixes bug where mismatch
- was shown in customization. (erc-current-nick-highlight-type):
- Escape parentheses in docstring. Added keyword, nick-or-keyword as
- options in `:type'.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-stamp.el: Added local variables for file.
- (erc-away-timestamp-format): Allow nil as a choice in `:type'.
- (erc-timestamp-intangible): Changed `:type' to boolean.
- (erc-timestamp-right-column): Added `:group' and `:type'.
-
-2004-04-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-modules): Added bbdb, log, match, sound, and stamp
- as `:type' options; changed documentation for autojoin, fill,
- pcomplete, track. (erc-prompt-for-channel-key): New variable.
- (erc-join-channel): Only prompt for key if
- `erc-prompt-for-channel-key' is non-nil. (erc-format-my-nick): New
- function. (erc-send-message, erc-send-current-line): Use it.
-
-2004-04-24 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-track.el (erc-track-modified-channels): Fix indentation.
-
-2004-04-24 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-match.el (erc-hide-fools): Docstring fix.
- (erc-log-matches-types-alist): Added `current-nick' to valid
- choices.
-
-2004-04-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-page.el, erc-ezbounce.el, erc-speak.el, erc-match.el,
- erc-track.el (erc-ezbounce, erc-page, erc-speak): Groups defined.
- (erc-match, erc-track): `erc' is parent group.
- (erc-ezb-regexp, erc-ezb-login-alist): Added `:group'.
-
-2004-04-20 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-fill.el: Fixed erc-fill-static so it breaks the lines at the
- right column and respects timestamps. Patch by Simon Siegler
- <simon@trz-kril.de>
- (erc-fill-static): Major rewrite and split up into some functions.
- (erc-count-lines): Removed.
- (erc-fill-regarding-timestamp): New function.
- (erc-timestamp-offset): New function.
- (erc-restore-text-properties): New function.
- (erc-fill-variable): Respect leftbound timestamp. This is still
- broken if someone has both erc-timestamp-only-if-changed-flag set
- and erc-insert-timestamp-function set to
- 'erc-insert-timestamp-left, but otherwise it works now.
-
-2004-04-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-cmd-SV): Show features gtk, mac-carbon, multi-tty.
- Fixed so that arguments fit the format (build date was not being
- shown).
-
-2004-04-19 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-channel-topic): Error if `channel-topic' is
- unbound. Remove %-sign substitution.
- (erc-update-mode-line-buffer): Escape %-signs in `channel-topic'
- here.
-
-2004-04-19 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-send-action, erc-ctcp-query-ACTION,
- erc-ctcp-reply-ECHO-hook): Let `erc-display-message-highlight'
- propertize the message.
- (erc-display-message-highlight): Allow for any erc-TYPE-face.
- (erc-cmd-JOIN): Display error message instead of throwing an error
- if there's no `invitation'.
- (erc-cmd-PART): Allow for no reason if channel is provided. Fixes
- bug where user would part the current channel with the other
- channel's name as reason when no reason was given.
- (erc-server-vectors, erc-debug-missing-hooks): Added docstring.
- (erc-server-JOIN): Moved `erc-join-hook' to JOIN-you section.
- `erc-join-hook' called by `run-hook-with-args', sending the ARGS
- `chnl' and the channel's buffer. Changed an instance of if
- without else to when.
- (erc-server-477): New function.
- (erc-server-477-hook): Use `erc-server-477'.
- (erc-define-catalog): Added `no-invitation'.
-
-2004-04-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nickserv.el: Local variables for file added.
- (erc-nickserv-passwords): Customization: Network symbols updated
- to reflect `erc-nickserv-alist'. Allow user to type in network
- symbol.
- (erc-nickserv-alist): Now customizable variable.
-
-2004-04-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autoaway.el (erc-autoaway-reset-idletime): Make sure `line'
- is a string to avoid errors upon startup.
-
-2004-04-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autoaway.el (erc-autoaway-version): New variable.
- (erc-auto-discard-away): Updated docstring.
- (erc-autoaway-no-auto-back-regexp): New variable.
- (erc-autoaway-reset-idletime): Use it. Hopefully a better solution
- which allows for aliases to "/away" and any other text that the
- user wants to ignore when `erc-auto-discard-away' is non-nil.
-
-2004-04-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autoaway.el (erc-autoaway-reset-idletime): Forgot /gaway in
- regexp.
-
-2004-04-06 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autoaway.el (erc-autoaway-reset-idletime): If the user sends
- an "/away" command, don't call `erc-autoaway-set-back', fixes bug
- where ERC would send "/away" when user was already away and sent an
- "/away reason". Changed `l' to `line' for better understanding.
- (erc-autoaway-set-back): Changed `l' to `line' for better
- understanding.
-
-2004-04-05 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-set-channel-key): Now able to remove key.
- (erc-set-channel-limit): Now able to remove limit.
- (erc-get-channel-mode-from-keypress): Fixed docstring.
-
-2004-04-04 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-join-channel): Allow for optional channel key.
- (erc-set-modes): Need to set `channel-key' to nil in case of mode
- changes during split.
- (erc-show-channel-key-p): New variable.
- (erc-prepare-mode-line-format): Only show key if
- `erc-show-channel-key-p' is non-nil.
-
-2004-04-04 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (channel-key): New variable.
- (erc-update-channel-key): New function.
- (erc-set-modes, erc-parse-modes, erc-update-modes, erc,
- erc-update-channel-info-buffer): Deal with channel keys.
- (erc-prepare-mode-line-format): Show channel key in header-line.
- (erc-server-NICK): Show nick change in server buffer as well.
- (erc, erc-send-command, erc-banlist-store, erc-banlist-update,
- erc-load-irc-script-lines,
- erc-arrange-session-in-multiple-windows, erc-handle-login,
- erc-find-channel-info-buffer): Changed when not to unless.
- (erc-server-MODE): Changed if without else to when.
-
-2004-03-27 Adrian Aichner <adrian@xemacs.org>
-
- * erc.el (erc-cmd-BANLIST): Use `truncate-string-to-width'
- instead of `truncate-string' alias.
- (erc-nickname-in-use): Ditto.
-
-2004-03-27 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el (erc-cmd-list): Fixed error caused by erc-cmd-LIST
- passing a non-sequence to erc-chanlist.
-
-2004-03-22 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * erc.el: Add new hook `erc-join-hook', which is run when we join a
- channel.
-
-2004-03-22 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * erc.el: Replaced existing notice user notification system and
- the configuration options, which consisted of
- `erc-echo-notices-in-minibuffer-flag' and
- `erc-echo-notices-in-current-buffer' with two new hooks,
- `erc-echo-notice-hook' and `erc-echo-notice-always-hook'.
-
- When user notification is needed, `erc-echo-notice-always-hook' is
- first run using `run-hook-with-args', then `erc-echo-notice-hook'
- is run using `run-hook-with-args-until-success'.
-
- In addition to these hooks, a large number of functions, which are
- described in the documentation strings of those hooks, were added
- which can be used to achieve a large variety of different
- behaviors.
-
- The current default behavior, which is identical to the existing
- default behavior, is for `erc-echo-notice-always-hook' to be set to
- `(erc-echo-notice-in-default-buffer).
-
-2004-03-21 Diane Murray <disumu@x3y2z1.net>
-
- * erc-track.el (erc-modified-channels-display): Added a space
- before opening bracket.
-
-2004-03-21 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-format-query-as-channel-p): New variable.
- (erc-server-PRIVMSG-or-NOTICE): If `erc-format-query-as-channel-p'
- is nil, messages in the query buffer are formatted like private
- messages.
-
- (erc-server-252-hook, erc-server-253-hook, erc-server-254-hook,
- erc-server-256-hook, erc-server-257-hook, erc-server-258-hook,
- erc-server-259-hook, erc-server-371-hook, erc-server-372-hook,
- erc-server-374-hook, erc-server-374-hook, erc-server-442-hook,
- erc-server-477-hook): Removed, now defined in
- `erc-server-hook-list'.
- (erc-display-server-message): New function.
- (erc-server-252, erc-server-253, erc-server-254, erc-server-442):
- New functions.
- (erc-server-hook-list): Added 250, 256, 257, 258, 259, 265, 266,
- 377, 378, 477 - using `erc-display-server-message'. 251, 255 now
- use `erc-display-server-message'. Added 252, 253, 254, 442 -
- using respective erc-server-* functions. 371, 372, 374, 375 now
- defined here.
- (erc-define-catalog): Added s252, s253, s254, s442.
- (erc-server-001, erc-server-004, erc-server-005): Fixed
- documentation.
-
-2004-03-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-stamp.el: Commentary: Changed `erc-stamp-mode' to
- `erc-timestamp-mode'.
- (erc-insert-timestamp-left): Use `erc-timestamp-face' on filler
- spaces as well.
-
-2004-03-19 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-send-action): Use `erc-input-face'.
- (erc-display-message-highlight): If the requested highlighting
- type doesn't match, just display the string with no highlighting
- and warn about it with `erc-log'.
- (erc-cmd-JOIN): If user is already on the requested channel,
- switch to that channel's buffer.
- (erc-ctcp-query-ACTION): Use `erc-action-face' for nick as well.
- (erc-header-line-use-help-echo-p): New variable.
- (erc-update-mode-line-buffer): Use `help-echo' for header-line if
- `erc-header-line-use-help-echo-p' is non-nil.
-
-2004-03-18 Adrian Aichner <adrian@xemacs.org>
-
- * erc-nets.el: Use two arguments version of `make-obsolete', if
- third argument is not supported (for XEmacs).
-
-2004-03-18 Andreas Fuchs <asf@void.at>
-
- * CREDITS: added CREDITS entry for Adrian Aichner
-
-2004-03-18 Andreas Fuchs <asf@void.at>
-
- * erc-xdcc.el, erc.el, erc-autoaway.el, erc-autojoin.el,
- erc-button.el, erc-dcc.el, erc-ezbounce.el, erc-imenu.el,
- erc-list.el, erc-log.el, erc-match.el, erc-members.el,
- erc-menu.el, erc-netsplit.el, erc-notify.el, erc-speedbar.el,
- erc-stamp.el, erc-track.el, erc-truncate.el:
- (erc-coding-sytem-for-target): Removed.
- (erc-coding-system-for-target): New.
- (erc-autoaway-use-emacs-idle): Typo fix.
- (erc-auto-set-away): Ditto.
- (erc-auto-discard-away): Ditto.
- (autojoin): Ditto.
- (erc-button-alist): Ditto.
- (erc-dcc-auto-masks): Ditto.
- (erc-dcc-chat-send-input-line): Ditto.
- (erc-ezb-get-login): Ditto.
- (erc-unfill-notice): Ditto.
- (erc-save-buffer-in-logs): Ditto.
- (match): Ditto.
- (erc-log-matches-types-alist): Ditto.
- (erc-match-directed-at-fool-p): Ditto.
- (erc-match-message): Ditto.
- (erc-update-member): Ditto.
- (erc-ignored-reply-p): Ditto.
- (erc-menu-definition): Ditto.
- (erc-netsplit-QUIT): Ditto.
- (erc-notify-list): Ditto.
- (erc-speedbar-update-channel): Ditto.
- (erc-speedbar-item-info): Ditto.
- (erc-stamp): Ditto.
- (erc-timestamp-intangible): Ditto.
- (erc-add-timestamp): Ditto.
- (erc-timestamp-only-if-changed-flag): Ditto.
- (erc-show-timestamps): Ditto.
- (erc-track-priority-faces-only): Ditto.
- (erc-modified-channels-alist): Ditto.
- (erc-unique-substrings): Ditto.
- (erc-find-parsed-property): Ditto.
- (erc-track-switch-direction): Ditto.
- (erc-truncate-buffer-to-size): Ditto.
- (erc-xdcc): Ditto.
- (erc-auto-reconnect): Ditto.
- (erc-startup-file-list): Ditto.
- (erc-once-with-server-event): Ditto.
- (erc-once-with-server-event-global): Ditto.
- (erc-mode): Ditto.
- (erc-generate-new-buffer-name): Ditto.
- (erc): Ditto.
- (erc-open-ssl-stream): Ditto.
- (erc-default-coding-system): Ditto.
- (erc-encode-string-for-target): Ditto.
- (erc-decode-string-from-target): Ditto.
- (erc-scroll-to-bottom): Ditto.
- (erc-decode-controls): Ditto.
- (erc-channel-members-changed-hook): Ditto.
- (erc-put-text-property): Ditto.
- (erc-add-default-channel): Ditto.
-
-2004-03-17 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-process-sentinel): Cancel ping timer upon
- disconnect.
- (erc-cmd-PART): Use same regexp as `erc-cmd-QUIT' when no #channel
- is provided.
- (erc-nick-uniquifier, erc-manual-set-nick-on-bad-nick-p): `:group'
- was missing, added.
- (erc-part-reason-zippy, erc-part-reason-zippy): Removed FIXME
- comments. I see no problem allowing typed in reasons.
-
-2004-03-16 Diane Murray <disumu@x3y2z1.net>
-
- * erc-stamp.el (erc-insert-timestamp-left): Added support for
- `erc-timestamp-only-if-changed-flag' and added docstring.
- (erc-timestamp-only-if-changed-flag): Updated documentation.
-
-2004-03-13 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-nets.el (erc-network-name): No longer marked as obsolete.
- Why was this function made obsolete? There is no other function
- that performs this task. Some of us use these functions in our
- personal ERC configs.
-
-2004-03-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-buffer-filter): Use `with-current-buffer'.
- (erc-process-input-line): Append newline to documentation. Fixes a
- bug whereby the prompt would be put on the same line as the output.
- (erc-cmd-GQUIT): Only try and send QUIT if the process is alive.
-
-2004-03-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc-log.el: Only add top-level hooks if `erc-enable-logging' is
- non-nil.
-
-2004-03-10 Damien Elmes <erc@repose.cx>
-
- * erc-nets.el: From Adrian Aichner (adrian /at/ xemacs /dot/ org)
- * erc-nets.el: XEmacs make-obsolete only takes two arguments.
-
-2004-03-10 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nets.el (erc-determine-network): Use `erc-session-server' if
- `erc-announced-server' is nil to avoid error if server does not
- send 004 (RPL_MYINFO) message.
-
-2004-03-10 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nets.el (erc-server-alistm erc-settings): Use lowercase
- "freenode", as in `erc-networks-alist'.
-
-2004-03-10 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nickserv.el (erc-nickserv-alist): Use lowercase "freenode",
- as in `erc-networks-alist'.
-
-2004-03-10 Lawrence Mitchell <wence@gmx.li>
-
- * erc-dcc.el (pcomplete/erc-mode/DCC): Append "send" as a list.
-
-2004-03-10 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-nets.el (erc-networks-alist): Changed "Freenode" to
- "freenode".
-
-2004-03-10 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el (erc-cmd-LIST): Improved the docstring. Made
- message to user more accurate depending on whether a single
- channel is being listed or not.
-
-2004-03-10 Lawrence Mitchell <wence@gmx.li>
-
- * erc-nets.el (erc-determine-network): Make matching logic simpler
- (suggested by Damian Elmes).
- (erc-current-network, erc-network-name): Add `make-obsolete' form.
- (erc-set-network-name): Indentation fix.
- (erc-ports-list): Add docstring. Rework function body to use
- `nconc'.
-
-2004-03-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list.el, erc-notify.el (require 'erc-nets): Added.
-
-2004-03-08 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-network-name): Function definition moved to
- erc-nets.el. The functions `erc-determine-network' and
- `erc-network' in erc-nets.el do what this did before. Deprecated.
- Use (erc-network) instead.
-
-2004-03-08 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nickserv.el: Changed copyright notice. Now require
- erc-nets. erc-nets.el now takes care of network-related functions
- and variables.
- (erc-nickserv-alist): Changed network symbols to match those in
- `erc-networks-alist' in erc-nets.el.
- (erc-nickserv-identify-autodetect): Use `erc-network'.
- (erc-nickserv-identify): Use `erc-network'. Changed wording for
- interactive use, now shows current nick.
- (erc-networks): Removed. Use `erc-networks-alist' as defined in
- erc-nets.el.
- (erc-current-network): Function definition moved to erc-nets.el.
- The functions `erc-determine-network' and `erc-network' in
- erc-nets.el do what this did before. Deprecated. Use
- (erc-network) instead.
-
-2004-03-08 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nets.el: Added commentary, `erc-nets-version'.
- (erc-server-alist): Changed Brasnet to BRASnet.
- (erc-networks-alist): All networks (except EFnet and IRCnet) now
- have a MATCHER. (erc-network): New variable.
- (erc-determine-network): New function. Determine the network the
- user is on. Use the server parameter NETWORK, if provided, else
- parse the server name and search for a match (regexp and loop by
- wencem) in `erc-networks-alist'. Return the name of the network
- or "Unknown" as a symbol.
- (erc-network): New function. Returns value of `erc-network'. Use
- this when the current buffer is not the server process buffer.
- (erc-current-network): Returns the value of `erc-network' as
- expected by users who used the function as it was defined in
- erc-nickserv.el. Deprecated.
- (erc-network-name): Returns the value of `erc-network' as expected
- by users who used the function as it was defined in erc.el.
- Deprecated.
- (erc-set-network-name): New function. Added to
- `erc-server-375-hook' and `erc-server-422-hook'.
- (erc-unset-network-name): New function. Added to
- `erc-disconnected-hook'.
- (erc-server-select): Small documentation word change.
-
-2004-03-07 Diane Murray <disumu@x3y2z1.net>
-
- * AUTHORS, CREDITS: disumu info updated
-
-2004-03-06 Lawrence Mitchell <wence@gmx.li>
-
- * erc-list.el (erc-cmd-LIST): Take &rest rather than &optional
- arguments.
- (erc-chanlist): Construct correct LIST command from list of
- channels.
-
-2004-03-06 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-mode-line-buffer): Add 'help-echo property to
- header-line text. This allows header lines longer than the width
- of the current window to be seen.
-
-2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el (erc-match-directed-at-fool-p): Also check for
- "FOOL, "
-
-2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el (erc-match-message): Only use nick-or-keyword if
- we're matching our nick.
-
-2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-match.el: The highlight type for the current nickname can
- now also be 'nick-or-keyword, to highlight the nick of the sender
- if that is available, but fall back to highlighting your nickname
- in the whole message otherwise.
- (erc-current-nick-highlight-type): Adapted docstring accordingly.
- (erc-match-message): Added new condition. Also added some comments
- to this monster of a function.
-
-2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-is-valid-nick-p): Don't check for length less or
- equal to 9.
-
-2004-03-06 Damien Elmes <erc@repose.cx>
-
- * erc-nickserv.el (erc-current-network): the last change resulted
- in this function failing when a network identifies itself as
- anything other than var.netname.com, so for instance
- 'vic.au.austnet.org' fails. This version is only a marginal
- improvement over the original, but if we want to be more flexible
- we'll probably have to do the iteration ourselves instead of using
- assoc.
-
-2004-03-05 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: Added erc-server-001 which runs when the server sends
- its welcome message. It sets the current-nick to reflect the
- server's settings. This fixes a bug where nicks that were too long
- and got truncated by the server were still set to the old value.
- (nickname-in-use): If user wants to try again manually, let user
- know that the nick is taken. If not, go through erc-default-nicks
- until none are left, and then try one last time with
- erc-nick-uniquifier. If it's still a bad-nick, make the user
- change nick manually. When applying uniquifier, use NICKLEN if
- it's in the server parameters, otherwise use what RFC 2812 says is
- the max nick length (9 chars). Added custom variable
- erc-manual-set-nick-on-bad-nick-p, which is set to nil and
- erc-nick-change-attempt-count. Reset erc-default-nicks and
- erc-nick-change-attempt-count when the nick has been changed
- successfully. This fixes the bug where ERC would get caught in a
- neverending loop of trying to set the same nick if the nick was
- too long and the uniquified nick was not available.
-
- * added erc-cmd-WHOAMI
-
- * added custom variable erc-mode-line-away-status-format, use this
- instead of the previous hard-coded setting
-
- * erc-server-315|318|369-hook defvar lines removed - they're
- already defined in erc-server-hook-list
-
-2004-03-04 Lawrence Mitchell <wence@gmx.li>
-
- * HACKING: Initial commit. Some thoughts on coding standards.
-
-2004-03-03 Diane Murray <disumu@x3y2z1.net>
-
- * erc-track.el: added the variable erc-track-priority-faces-only
- which adds the option to ignore changes in a channel unless there
- are faces from the erc-track-faces-priority-list in the message
- options are nil, 'all, or a list of channel name strings
-
-2004-03-01 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-ibuffer.el, erc-menu.el: Changed erc-is-channel-op
- and erc-is-channel-voice to erc-channel-user-op-p and
- erc-channel-user-voice-p to better match erc-channel-user
- structure (and emacs lisp usage)
-
-2004-03-01 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-ibuffer.el, erc-menu.el:
- erc-track-modified-channels-mode is now erc-track-mode
-
-2004-02-29 Diane Murray <disumu@x3y2z1.net>
-
- * erc-match.el: Added 'keyword option to
- erc-current-nick-highlight-type highlights all instances of
- current-nick in the message ('nickname option in cvs revisions 1.9
- - 1.11 had same effect)
-
-2004-02-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-button.el: Add Lisp: prefix for the EmacsWiki Elisp area.
- (erc-button-alist): Added Lisp: prefix.
- (erc-emacswiki-lisp-url): New variable.
- (erc-browse-emacswiki-lisp): New function.
-
-2004-02-27 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-get-arglist): Use `substitute-command-keys', rather
- than hard-coding C-h f for `describe-function'.
-
-2004-02-26 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-log.el (erc-save-buffer-in-logs): bind `inhibit-read-only'
- to t around call to `erase-buffer'.
-
-2004-02-23 Edward O'Connor <ted@oconnor.cx>
-
- * erc-chess.el, erc-dcc.el, erc-ezbounce.el, erc-list.el,
- erc-macs.el, erc-ring.el, erc-stamp.el, erc.el: Normalized buffer
- local variable creation.
-
-2004-02-17 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-scroll-to-bottom, erc-add-scroll-to-bottom): Mention
- `erc-input-line-position' in docstring.
-
-2004-02-13 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-kick-hook): Typo fix.
-
-2004-02-13 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * erc.el: Added `erc-kick-hook', which is called when the local
- user is kicked from a channel. Fixed a bug in `erc-cmd-OPS', such
- that the command now works. Added `erc-remove-channel-users', in
- order to fix a number of significant bugs relating to channel
- parting.
-
-2004-02-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-display-prompt): Remove last change. This caused a
- lot of trouble :(
-
-2004-02-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-display-prompt): Also set 'field property, so C-j
- works on an empty prompt.
-
-2004-02-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-channel-topic): Ensure that `channel-topic'
- does not contain any bare format controls.
-
-2004-02-10 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc-stamp.el (erc-timestamp-intangible): New variable (user
- feature request)
- (erc-format-timestamp): Use erc-timestamp-intangible.
-
-2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * erc-button.el: Fixed bug related to nickname buttonizing and text
- fields due to erc-stamp.
-
-2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * CREDITS: Added mention of my change of ERC to use hash tables.
-
-2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
-
- * AUTHORS: Added myself to the list.
-
-2004-02-05 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el: From Jeremy Maitin-Shepard <jbms@attbi.com>:
- (erc-remove-channel-user): Use `delq' not `delete'.
- (erc-get-buffer): Pass PROC through to `erc-buffer-filter'.
- (erc-process-sentinel): Use `erc' rather than `erc-reconnect' for
- auto-reconnection.
-
-2004-02-02 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-buffer-list-with-nick): Apply `erc-downcase' NICK.
-
-2004-01-30 Alex Schroeder <alex@gnu.org>
-
- * erc.el (erc-get-buffer): Use erc-buffer-filter.
-
-2004-01-30 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el: From jbms:
- (erc-get-channel-nickname-list): New function.
- (erc-get-server-nickname-list): New function.
- (erc-get-server-nickname-alist): New function.
- (erc-get-channel-nickname-alist): New function.
-
-2004-01-30 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-match.el (erc-add-entry-to-list,
- erc-remove-entry-from-list): Use `erc-member-ignore-case' to
- compare entries.
- (erc-add-pal, erc-add-fool): Fix type bug. Use
- `erc-get-server-nickname-alist'.
-
-2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el: From jbms: Adds xemacs compatibility to hash table
- channel-members patch.
-
-2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (erc-update-undo-list): Rewritten. Update
- buffer-undo-list in place. Deal with XEmacsesque
- entries (extents) in the list.
- (erc-channel-users): Fix unescaped open-paren in left column in
- docstring.
-
-2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-ring.el (erc-replace-current-command): Exclude the prompt
- from the deleted region and don't redisplay the prompt (because
- `erc-display-prompt' flushes `buffer-undo-list').
-
-2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-match.el (erc-add-entry-to-list): Use `symbol-value' instead
- of `eval'.
-
-2004-01-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-kill-buffer-function): maphash was missing an
- argument.
-
-2004-01-28 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * Makefile, erc-autoaway.el, erc-button.el, erc-ibuffer.el,
- erc-lang.el, erc-list.el, erc-match.el, erc-menu.el, erc-page.el,
- erc-pcomplete.el, erc-speedbar.el, erc.el: HUGE change by jbms.
- This makes channel-members a hash, erc-channel-users.
-
- Modified files: Makefile erc-autoaway.el erc-button.el
- erc-ibuffer.el erc-lang.el erc-list.el erc-match.el erc-menu.el
- erc-page.el erc-pcomplete.el erc-speedbar.el erc.el
-
- The changes are too numerous to document properly. Have fun with
- the breakage.
-
-2004-01-27 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-send-input-line): Add a space to empty lines so the
- server likes them.
-
-2004-01-25 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: erc-send-whitespace-lines: New variable.
- (erc-send-current-line): Use erc-send-whitespace-lines. Also,
- removed superfluous test for empty line in the mapc, since the
- blank line test should find all. I do like to be able to send an
- empty line when i want to!
- (erc-send-current-line): Check for point being in input line
- before checking for blank lines.
-
-2004-01-21 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-display-line-1): Move `erc-update-undo-list' outside
- `save-restriction'. Removing need for temporary variable.
- (erc-send-current-line): Fix bug introduced by last change, remove
- complement in blank line regexp.
-
-2004-01-20 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-undo-list): Add logic to catch the case when
- `buffer-undo-list' is t, indentation cleanup.
- (erc-send-current-line): Reverse logic for matching blank lines.
-
-2004-01-20 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-input-line-position): New variable. If non-nil,
- specifies the argument to `recenter' in `erc-scroll-to-bottom'.
- (erc-scroll-to-bottom): Use it.
-
-2004-01-20 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el: From Johan Bockgård <bojohan+news@dd.chalmers.se>:
- (erc-update-undo-list): New function. Update `buffer-undo-list'
- so that calling `undo' in an ERC buffer doesn't mess up the
- existing text.
- (erc-display-line-1): Use it.
-
-2004-01-19 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-beg-of-input-line): Use `forward-line' rather than
- `beginning-of-line'. Docstring fix.
- (erc-end-of-input-line): Docstring fix.
-
-2004-01-13 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-display-prompt): Remove the undo list after
- displaying the prompt, so the user can't undo ERC changes, which
- breaks some stuff anyways. This way the user can still undo his
- editing, but not ours.
-
-2004-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-scroll-to-bottom): Should recenter on the bottom
- line, not the second-to-last one.
-
-2004-01-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-bol): Fix bug introduced in my changes from 2004-01-11.
-
-2004-01-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el: From Brian Palmer <bpalmer@gmail.com>
- (erc-cmd-JOIN): Use `erc-member-ignore-case', rather than
- `member-ignore-case'.
-
-2004-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el: There was an inconsistency where the values of op and
- voice in channel-names could be 'on or 'off after an update, t and
- nil before. The intended version was to have t or nil, so i fixed
- it to do so.
- (channel-names): Updated docstring.
- (erc-update-current-channel-member): Clarified docstring, fixed so
- it sets t or nil on an update as well, not only on an add.
- (erc-cmd-OPS): Updated not to check for 'on (the only function that
- did this!)
-
-2004-01-12 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-part-reason-various-alist,
- erc-update-mode-line-buffer): Fix docstring
-
-2004-01-11 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-update-mode-line): Fix typo.
-
-2004-01-11 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-prompt-interactive-input): Removed.
- (erc-display-prompt): Removed `erc-prompt-interactive-input'
- option. (erc-interactive-input-map): Removed.
-
- Major docstring fixes.
-
-2004-01-07 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-cmd-OPS): Added this function.
- (erc-cmd-IDLE): Switched from using erc-display-message-highlight
- to erc-make-notice.
-
-2004-01-07 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el (erc-cmd-LIST): Switched from using
- erc-display-message-highlight to erc-make-notice.
-
-2004-01-07 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-once-with-server-event): Added a sentence to the
- docstring. Now returns the uninterned symbol that is added to the
- server hook.
- (erc-cmd-IDLE): Changed to use erc-once-with-server-event instead
- of erc-once-with-server-event-global.
-
-2004-01-06 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el (erc-chanlist-hide-modeline): New variable.
- (erc-chanlist): Now displays message as a notice. Also hides the
- modeline if erc-chanlist-hide-modeline is non-nil.
-
-2004-01-05 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-server-PRIVMSG-or-NOTICE): Now nicks appear as
- <nick> in query buffers, instead of as *nick*.
-
-2004-01-03 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-once-with-server-event-global): Changed to return
- the uninterned symbol that it creates.
- (erc-cmd-LIST): Changed to clean up hooks that don't run.
-
-2004-01-03 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-pcomplete.el (pcomplete/erc-mode/IDLE): Added to support new
- /IDLE command.
-
-2004-01-03 Francis Litterio <franl@users.sourceforge.net>
-
- * erc.el (erc-once-with-server-event-global): New function. Like
- erc-once-with-server-event, except it modifies the global value of
- the event hook.
- (erc-cmd-IDLE): New function. Implements the new /IDLE command.
- Usage: /IDLE NICK (erc-seconds-to-string): New function. Converts
- a number of seconds to an English phrase.
-
-2004-01-02 Francis Litterio <franl@users.sourceforge.net>
-
- * erc-list.el: Added variable erc-chanlist-mode-hook.
-
-See ChangeLog.03 for earlier changes.
-
- Copyright (C) 2004, 2006-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
diff --git a/lisp/erc/ChangeLog.05 b/lisp/erc/ChangeLog.05
deleted file mode 100644
index f5f6f616f0c..00000000000
--- a/lisp/erc/ChangeLog.05
+++ /dev/null
@@ -1,1240 +0,0 @@
-2005-11-23 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (erc-cmd-SAY): Strip leading space in input line.
-
-2005-10-29 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE: Add stuff that needs to be done before the 5.1
- release. Longer-term items can be added to the 5.2 section.
-
- * Makefile (SITEFLAG): New variable that indicates what variant of
- "--site-flag" to use. XEmacs needs "-site-flag".
- (INSTALLINFO): New variable indicating how we should call
- install-info when installing documentation.
- (erc-auto.el, .elc.el): Use $(SITEFLAG).
-
- * NEWS: Note that last release was 5.0.4.
-
- * erc.texi: Initial and incomplete draft of ERC documentation.
- Commence collaborate-documentation-hack-mode :^) .
-
-2005-10-29 Diane Murray <disumu@x3y2z1.net>
-
- * erc-ring.el (erc-replace-current-command): Revert last change
- since it made the prompt disappear when using `erc-next-command'
- and `erc-previous-command'.
-
-2005-10-28 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-input-marker): New variable that indicates the
- position where text from the user begins, after the prompt.
- (erc-mode-map): Bind <HOME> to erc-bol, just like C-a.
- (erc): Initialize erc-input-marker.
- (erc-display-prompt): Even in case where no prompt is desired by
- the user, clear the undo buffer and set the input marker.
- (erc-bol, erc-user-input): Simplify by using erc-input-marker.
-
- * erc-pcomplete.el (pcomplete-parse-erc-arguments): Use
- erc-insert-marker.
-
- * erc-ring.el (erc-previous-command)
- (erc-replace-current-command): Use erc-insert-marker.
-
- * erc-spelling.el (erc-spelling-init): Make sure that even Emacs21
- obeys erc-spelling-flyspell-verify.
- (erc-spelling-flyspell-verify): Use erc-input-marker. This should
- make it considerably faster when switching to a buffer that has
- seen a lot of activity since last viewed.
-
-2005-10-25 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (erc-server-version, 004): Re-added setting of
- `erc-server-version'. It doesn't hurt to set, and it could be
- used in modules or users' settings.
-
- * NEWS: Added descriptions of some new features.
-
-2005-10-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-match.el (erc-current-nick-highlight-type): Set to `keyword'
- as default.
- (erc-beep-match-types): New variable.
- (erc-text-matched-hook): Doc fix. Added `erc-beep-on-match' to
- customization options.
- (erc-beep-on-match): New function. If the MATCH-TYPE is found in
- `erc-beep-match-types', beep.
-
- * erc-compat.el (erc-make-obsolete, erc-make-obsolete-variable):
- New functions to deal with the difference in the number of
- arguments accepted by `make-obsolete' and `make-obsolete-variable'
- in Emacs and XEmacs.
-
- * erc.el, erc-nets.el: Use `erc-make-obsolete' and
- `erc-make-obsolete-variable'.
-
- * erc-compat.el (erc-make-obsolete, erc-make-obsolete-variable):
- Handle `wrong-number-of-arguments' error instead of checking for
- xemacs feature as future versions of XEmacs might accept three
- arguments.
-
-2005-10-18 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el: Tell emacs-lisp-mode how to font-lock define-erc-module
- docstrings.
-
-2005-10-08 Diane Murray <disumu@x3y2z1.net>
-
- * AUTHORS, CREDITS, ChangeLog, ChangeLog.2002, ChangeLog.2004:
- Updated my email address.
-
-2005-10-06 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-send-input-line, erc-cmd-KICK, erc-cmd-PART)
- (erc-cmd-QUIT, erc-cmd-TOPIC, erc-kill-server, erc-kill-channel):
- Adapt to new TARGET parameter of erc-server-send.
-
- * erc-backend.el (erc-server-connect): Don't specify encoding for
- erc-server-process, since we set this each time we send a line to
- the server.
- (erc-encode-string-for-target): Remove.
- (erc-server-send): Allow TARGET to be specified. This was how it
- used to be before my more-backend work. Set encoding of server
- process just before sending text to it. Associate encoding with
- text if we are using the queue.
- (erc-server-send-queue): Pull encoding from queue.
- (erc-message, erc-send-ctcp-message, erc-send-ctcp-notice): Adapt
- to new TARGET parameter of erc-server-send.
-
-2005-10-05 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-toggle-debug-irc-protocol): Use erc-view-mode-enter
- rather than view-mode.
-
- * erc-backend.el (erc-encode-string-for-target): If given a nil or
- empty string, return "".
- (erc-server-send-queue): XEmacs fix: Use erc-cancel-timer rather
- than cancel-timer.
-
- * erc-compat.el (erc-view-mode-enter): New function that is
- aliased to the correct way of entering view-mode.
-
- * erc-match.el (erc-log-matches-make-buffer): Use
- erc-view-mode-enter rather than view-mode-enter.
-
-2005-10-05 Edward O'Connor <ted@oconnor.cx>
-
- * erc-backend.el (erc-encode-string-for-target): If str is nil,
- pass the empty string to erc-encode-coding-string instead, which
- allows one to /part and /quit without providing a reason again.
-
-2005-10-03 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-message, erc-send-ctcp-message)
- (erc-send-ctcp-notice): Encode string for target before sending.
-
- * erc.el (erc-cmd-KICK, erc-cmd-PART, erc-cmd-QUIT, erc-cmd-TOPIC)
- (erc-kill-server, erc-kill-channel): Ditto.
-
-2005-09-05 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-page.el (erc-ctcp-query-PAGE): (message text) -> (message
- "%s" text).
- (erc-cmd-PAGE): Simplify regexp. Put `do-not-parse-args' t.
-
-2005-09-05 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-flood-limit, erc-flood-limit2): Remove since they
- are no longer needed.
- (erc-send-input): Detect whether we want flood control to be
- active. The previous behavior was to always force the message.
- (erc-toggle-flood-control): Adapt to new flood control method. No
- more 'strict.
- (erc-cmd-SV): Use concat rather than
- format-time-string.
- (erc-format-target, erc-format-target-and/or-server): Shorten
- logic statements.
-
- * erc-compat.el (erc-emacs-build-time): Use a string
- representation rather than trying to coerce a time out of a string
- on XEmacs.
-
- * erc-identd.el (erc-identd-start): Use make-network-process
- instead of open-network-stream. Error out if this is not defined.
-
- * erc-backend.el (erc-send-line): New command that sends a line
- using flood control, using a callback for display. It isn't used
- yet.
-
-2005-09-04 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Add defvaralias and make-obsolete-variable for
- erc-default-coding-system.
- (channel-topic, channel-modes, channel-user-limit, channel-key,
- invitation, away, channel-list, bad-nick): Rename globally to
- erc-{name-of-variable}.
-
-2005-09-03 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (erc-message): Simplify regexp.
- (erc-cmd-DEOP, erc-cmd-OP): Simplify.
-
-2005-08-29 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Alias erc-send-command to erc-server-send. ErBot needs
- this to work without modification. Add defvaralias for
- erc-process. Make this and the other backwards-compatibility
- functions and variables be marked obsolete as of ERC 5.1.
-
- * erc-backend.el: Add autoload for erc-log macro.
- (erc-server-connect): Set some variables before defining process
- handlers. It probably doesn't make any difference.
-
-2005-08-26 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Add defvaralias for erc-announced-server-name, since
- this seems to be widely used.
-
-2005-08-17 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc): Remove unnecessary boundp check.
-
- * erc-autoaway.el: Fix compiler warning.
-
- * erc-backend.el (erc-server-version): Since this isn't used by
- any code, and isn't generally useful, remove it.
- (erc-server-send-queue): Use erc-current-time rather than
- float-time.
- (004): Don't set erc-server-version.
-
- * erc-dcc.el (erc-dcc-chat-request, erc-dcc-get-parent): Move to
- fix a compiler warning.
-
- * erc-ibuffer.el (erc-server): Remove unnecessary boundp check.
-
- * erc-identd.el (erc-identd-start): Use read-string instead of
- read-input.
-
- * erc-imenu.el (erc-unfill-notice): Use a while loop instead of
- replace-regexp.
-
- * erc-nicklist.el: Add conditional dependency on erc-bbdb.
- (erc-nicklist-insert-contents): Tighten some regexps.
-
- * erc-notify.el (erc-notify-list): Docfix.
-
- * erc-spelling.el (erc-spelling-dictionaries): Add :type and
- :group to silence a compiler warning.
-
-2005-08-14 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-session-server, erc-session-port)
- (erc-announced-server-name, erc-server-version)
- (erc-server-parameters): Moved here from erc.el.
- (erc-server-last-peers): Moved, renamed from last-peers.
- (erc-server-lag): Moved, renamed from erc-lag.
- (erc-server-duplicates): Moved, renamed from erc-duplicates.
- (erc-server-duplicate-timeout): Moved, renamed from
- erc-duplicate-timeout.
- (erc-server): New customization group hosting all options from
- this file.
- (erc-server-prevent-duplicates): Moved, renamed from
- erc-prevent-duplicates.
- (erc-server-duplicate-timeout): Moved, renamed from
- erc-duplicate-timeout.
- (erc-server-auto-reconnect, erc-split-line-length)
- (erc-server-coding-system, erc-encoding-coding-alist)
- (erc-server-connect-function, erc-server-flood-margin)
- (erc-server-flood-penalty): Change group to 'erc-server.
- (erc-server-send-ping-interval): Moved, renamed from
- erc-ping-interval.
- (erc-server-ping-handler): Moved, renamed from erc-ping-handler.
- (erc-server-setup-periodical-server-ping): Moved, renamed from
- erc-setup-periodical-server-ping.
- (erc-server-connect): Add to docstring. Move more initialization
- here.
- (erc-server-processing-p): Docfix.
- (erc-server-connect): Use 'raw-text like in the original version.
- (erc-server-filter-function): Don't reset process coding system.
-
- * erc-stamp.el (erc-add-timestamp): If the text at point is
- invisible, don't insert a timestamp. Thanks to Pascal
- J. Bourguignon for the suggestion.
-
- * erc-match.el (erc-text-matched-hook): Don't hide fools by
- default, but include it in the available options.
-
-2005-08-13 Michael Olson <mwolson@gnu.org>
-
- * erc-*.el: s/erc-send-command/erc-server-send/g.
- s/erc-process/erc-server-process/g (sort of). Occasional
- whitespace and indentation fixes.
-
- * erc-backend.el: Specify a few local variables for indentation.
- Take one item off of the TODO list.
- (erc-server-filter-data): Renamed from erc-previous-read. From
- circe.
- (erc-server-processing-p): New variable that indicates when we're
- currently processing a message. From circe.
- (erc-split-line-length): New option that gives the maximum line
- length of a single message. From circe.
- (erc-default-coding-system): Moved here from erc.el.
- (erc-split-line): Renamed from erc-split-command and taken from
- circe.
- (erc-connect-function, erc-connect, erc-process-sentinel-1)
- (erc-process-sentinel, erc-flood-exceeded-p, erc-send-command)
- (erc-message, erc-upcase-first-word, erc-send-ctcp-message)
- (erc-send-ctcp-notice): Moved here from erc.el.
- (erc-server-filter-function): Renamed from erc-process-filter.
- From circe.
- (erc-server-process): Renamed from `erc-process' and moved here
- from erc.el.
- (erc-server-coding-system): Renamed from
- `erc-default-coding-system'.
- (erc-encoding-coding-alist): Moved here from erc.el.
- (erc-server-flood-margin, erc-server-flood-penalty):
- (erc-server-flood-last-message, erc-server-flood-queue):
- (erc-server-flood-timer): New options from circe that allow
- tweaking of flood control.
- (erc-server-connect-function): Renamed from erc-connect-function.
- (erc-flood-exceeded-p): Removed.
- (erc-coding-system-for-target)
- (erc-encode-string-for-target, erc-decode-string-from-target):
- Moved here from erc.el
- (erc-server-send): Renamed from erc-send-command. Adapted from
- the circe function by the same name.
- (erc-server-send-queue): New function from circe that implements
- handling of a flood queue.
- (erc-server-current-nick): Renamed from current-nick.
- (erc-server-quitting): Renamed from `quitting'.
- (erc-server-last-sent-time): Renamed from `last-sent-time'.
- (erc-server-last-ping-time): Renamed from `last-ping-time'.
- (erc-server-lines-sent): Renamed from `lines-sent'.
- (erc-server-auto-reconnect): Renamed from `erc-auto-reconnect'.
- (erc-server-coding-system): Docfix.
- (erc-server-connect): Renamed from `erc-connect'. Require SERVER
- and PORT parameters. Initialize several variables here. Don't
- set `erc-insert-marker'. Use a per-server coding system via
- erc-server-default-encoding.
-
- * erc.el (erc-version-string): Changed to indicate we are running
- the `more-backend' branch.
- (erc-send-single-line): Implement flood control using
- erc-split-line.
- (erc-send-input): Move functionality of erc-send-single-line in
- here.
- (erc-send-single-line): Assimilated!
- (erc-display-command, erc-display-msg): Handle display hooks.
- (erc-auto-reconnect, current-nick, last-sent-time)
- (last-ping-time, last-ctcp-time, erc-lines-sent, erc-bytes-sent)
- (quitting): Moved to erc-backend.el.
- (erc): Docfix. Don't initialize quite so many things here.
-
-2005-08-10 Michael Olson <mwolson@gnu.org>
-
- * debian/copyright (Copyright): Remove notices for 4 people, since
- they didn't contribute legally-significant changes, or have had
- these changes overwritten.
-
- * erc-log.el: Remove copyright notice.
-
- * erc.el: Remove 3 copyright notices.
-
-2005-08-09 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: Create 5.0.4-3 package. This doesn't serve
- any purpose other than to thank Romain Francoise for some advice.
-
- * Makefile (debrelease): Allow last upload and extra build options
- to be specified.
-
-2005-08-08 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: Create 5.0.4-2 package.
-
- * debian/control (Uploaders): Add Romain Francoise.
- (Standards-Version): Update to 3.6.2.
- (Depends): Add `emacsen'.
-
- * debian/scripts/startup.erc (load-path): Minor whitespace fixup.
-
- * Makefile (clean): Split target from realclean and make it remove
- files that aren't packaged in releases.
- (clean, release): Minor cleanups.
- (debrelease): Use debuild rather than dpkg-buildpackage since the
- former calls lintian. Minor cleanups.
- (debrelease-mwolson): New target that removes old Debian packages,
- calls debrelease, and copies the resulting package to my dist dir.
- (upload): New target that automates the process of uploading an
- ERC release to sourceforge.
-
- * erc.el (erc-mode): Use `make-local-variable' instead of
- `make-variable-buffer-local'.
-
-2005-07-12 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: Build 5.0.4-1.
-
- * Makefile (release): Prepare zip file in addition to tarball.
-
- * NEWS: Add item for the undo fix.
-
-2005-07-09 Michael Olson <mwolson@gnu.org>
-
- * erc-nicklist.el (erc-nicklist-insert-contents): Check
- erc-announced-name before erc-session-server. Make sure that we
- can never get a stringp (nil) error.
- (erc-nicklist-call-erc-command): If given no command, do nothing.
- This fixes an error that used to occur when a stray mouse click
- was made outside of the popup window, but on the erc-nicklist
- menu.
-
- * erc-bbdb.el (erc-bbdb-search-name-and-create): Get rid of the
- infinite input loop when you want to create a new record. Replace
- most of that with a completing read of existing nicks. If no nick
- is chosen, create a new John Doe record. The net effect of this
- is that the old behavior is re-instated, with the addition of one
- completing read that happens when you do a /whois.
-
-2005-07-09 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (erc-process-input-line): Docfix.
- (erc-update-mode-line-buffer): Use `erc-propertize' instead of
- `propertize'.
- (erc-propertize): Move to erc-compat.el.
-
- * erc-compat.el (erc-propertize): Move here from erc.el. Always
- return a copy of the string (like `propertize' in GNU Emacs).
-
- * erc-nicklist.el (erc-nicklist-icons-directory)
- (erc-nicklist-voiced-position)
- (erc-nicklist-insert-medium-name-or-icon): Docfix.
- (erc-nicklist-insert-contents): Simplify.
- (erc-nicklist-mode-map): Bind RET instead of `return'. Bind
- `down-mouse-3' instead of `mouse-3'.
- (erc-nicklist-kbd-cmd-QUERY): Cleanup regexp.
- (erc-nicklist-channel-users-info): Docfix. Simplify.
-
-2005-07-02 Michael Olson <mwolson@gnu.org>
-
- * images: New directory containing the images that are used by
- erc-nicklist.el. These are from Gaim, and are thought to be
- available under the terms of the GPL.
-
- * erc-bbdb.el: Add local variables section to preserve tabs, since
- that is the style used throughout this file. Apply patch from
- Edgar Gonçalves as follows.
- (erc-bbdb-bitlbee-name-field): New variable that indicates the
- field name to use for annotating the "displayed name" of a bitlbee
- contact.
- (erc-bbdb-irc-highlight-field): Docfix.
- (erc-bbdb-search-name-and-create): Prompt the user for the name of
- a contact if none was found. Merge the new entries into the
- specified contact. If new arg SILENT is non-nil, do not prompt
- the user for a name or offer to merge the new entry.
- (erc-bbdb-insinuate-and-show-entry): New arg SILENT is accepted,
- which is passed on to erc-bbdb-search-name-and-create.
- (erc-bbdb-whois): Tell erc-bbdb-search-name-and-create to prompt
- for name if necessary.
- (erc-bbdb-JOIN, erb-bbdb-NICK): Forbid
- erc-bbdb-search-name-and-create from prompting for a name.
-
- * erc-nicklist.el: Add local variables section to preserve tabs,
- since that is the style used throughout this file. Apply patch
- from Edgar Gonçalves as follows.
- (erc-nicklist-use-icons): New option; if non-nil, display an icon
- instead of the name of the chat medium.
- (erc-nicklist-icons-directory): New option indicating the path to
- the PNG files that are used for chat icons.
- (erc-nicklist-use-icons): New option indicating whether to put
- voiced nicks on top, bottom, or not to differentiate them. The
- default is to put them on the bottom.
- (erc-nicklist-bitlbee-connected-p): New variable that indicates
- whether or not we are currently using bitlbee. An attempt will be
- made to auto-detect the proper value. This is bound in the
- `erc-nicklist-insert-contents' function.
- (erc-nicklist-nicklist-images-alist): New variable that maps a
- host type to its icon. This is set by `erc-nicklist'.
- (erc-nicklist-insert-medium-name-or-icon): New function that
- inserts an icon or string that identifies the current host type.
- (erc-nicklist-search-for-nick): New function that attempts to find
- a BBDB record that corresponds with this contact given its
- finger-host. If found, return its bitlbee-nick field.
- (erc-nicklist-insert-contents): New function that inserts the
- contents of the nick list, including text properties and images.
- (erc-nicklist): Populate `erc-nicklist-images-alist'. Move
- nicklist content generation code to
- `erc-nicklist-insert-contents'.
- (erc-nicklist-mode-map): Map C-j to erc-nicklist-kbd-menu and RET
- to erc-nicklist-kbd-cmd-QUERY.
- (erc-nicklist-call-erc-command): Make use of
- `switch-to-buffer-other-window'.
- (erc-nicklist-cmd-QUERY): New function that opens a query buffer
- for the given contact.
- (erc-nicklist-kbd-cmd-QUERY): Ditto; contains most of the code.
- (erc-nicklist-kbd-menu): New function that shows the nicklist
- action menu.
- (erc-nicklist-channel-users-info): Renamed from
- `erc-nicklist-channel-nicks'. Implement sorting voiced users.
-
-2005-06-29 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc-nickserv.el (erc-nickserv-alist): Fix regexp for Azzurra.
-
-2005-06-26 Michael Olson <mwolson@gnu.org>
-
- * erc-autojoin.el (erc-autojoin-add, erc-autojoin-remove): Use
- `erc-session-server' if `erc-announced-server-name' is nil. This
- happens when servers don't send a 004 message.
-
- * erc.el (erc-quit-server): Ditto.
-
- * erc-ibuffer.el (erc-server, erc-server-name): Ditto.
-
- * erc-notify.el (erc-notify-JOIN, erc-notify-NICK)
- (erc-notify-QUIT): Ditto.
-
-2005-06-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (erc-default-coding-system)
- (erc-handle-user-status-change): Docstring fix.
- (with-erc-channel-buffer): Removed.
- (erc-ignored-reply-p): Replace `with-erc-channel-buffer' with
- `erc-with-buffer'.
- (erc-display-line-1): Fix broken undo.
-
-2005-06-23 Michael Olson <mwolson@gnu.org>
-
- * CREDITS: Add entries for Luigi Panzeri and Andreas Schwab.
-
- * erc-nickserv.el (erc-nickserv-alist): Add entries for Azzurra
- and OFTC. Thanks to Luigi Panzeri and Andreas Schwab for
- providing these.
-
-2005-06-16 Michael Olson <mwolson@gnu.org>
-
- * CREDITS: Add John Paul Wallington.
-
- * erc.el: Thanks to John Paul Wallington for the following.
- (erc-nickname-in-use): Use `string-to-number' instead of
- `string-to-int'.
-
- * erc-dcc.el (erc-dcc-handle-ctcp-send)
- (erc-dcc-handle-ctcp-chat, erc-dcc-get-file)
- (erc-dcc-chat-accept): Ditto.
-
- * erc-identd.el (erc-identd-start): Ditto.
-
-2005-06-16 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (erc-mode-map): Suppress `font-lock-fontify-block' key
- binding since it destroys face properties.
-
-2005-06-08 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-cmd-UNIGNORE): Use `erc-member-ignore-case' instead
- of `member-ignore-case'. Thanks to bpalmer for the heads up.
-
-2005-06-06 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-modules): Fix a mistake I made when editing this a
- few days ago. Modes should now be disabled properly.
- (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Remove unnecessary call to
- `format'. Thanks to Andreas Schwab for reporting this.
-
- * debian/changelog: Close "README file missing" bug.
-
- * debian/rules (binary-erc): Install README file.
-
-2005-06-03 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-with-buffer): Set `lisp-indent-function' so Emacs
- Lisp mode knows how to indent erc-with-buffer blocks.
- (with-erc-channel-buffer): Ditto.
- (erc-with-all-buffers-of-server): Ditto.
- (erc-modules): Use pcomplete by default, not completion, since
- erc-complete.el is deprecated. Use `fboundp' instead of
- `symbol-value' to check for existence of a function before calling
- it. This was causing an error when untoggling the `completion'
- option and trying to save via the customize interface.
-
- * erc-track.el (erc-modified-channels-update): If a buffer is not
- currently connected, remove it from the modified channels list.
- This should fix the problem where residue was left on the mode
- line after quitting ERC.
-
- * erc-list.el (erc-prettify-channel-list): Docfix; thanks to John
- Paul Wallington for reporting this.
-
-2005-05-31 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: First draft of entries for the 5.0.3 release.
-
- * debian/README.Debian: Note that ERC will now install correctly
- on versions of Emacs or XEmacs that do not have the `format-spec'
- library. Correct some grammar and prune the content a bit.
-
- * debian/scripts/install (emacs20): Remove line since we no longer
- need to deal with format-spec.el.
-
- * NEWS: Add entries for the upcoming 5.0.3 release.
-
- * erc.el: Don't require format-spec since this is provided in
- erc-compat.el now.
- (erc-process-sentinel, erc-setup-periodical-server-ping): Use
- `erc-cancel-timer' instead of `cancel-timer'.
- (erc-version-string): Update to 5.0.3.
-
- * erc-autoaway.el (autoaway, erc-autoaway-reestablish-idletimer):
- Use `erc-cancel-timer' instead of `cancel-timer'.
-
- * erc-compat.el (format-spec, format-spec-make): If we cannot load
- the `format-spec' library, provide versions of these functions.
- This should keep problems from surfacing with Emacs21 Debian
- builds.
- (erc-cancel-timer): New function created to take the place of
- `cancel-timer' since XEmacs calls it something else.
-
- * erc-track.el (erc-modified-channels-update): Accept any number
- of arguments, which are ignored. This allows it to be run from
- `erc-disconnected-hook' without extra bother.
- (track): Add `erc-modified-channels-update' to
- `erc-disconnected-hook' so that the indicators are removed
- correctly in some edge cases.
- (erc-modified-channels-display): Make sure that we never pass nil
- to the function in `erc-track-shorten-function'. This happens
- when we have deleted buffers in `erc-modified-channels-alist'.
- Also, make sure that the buffer has a non-nil short-name before
- adding it to the string list. This should fix some XEmacs
- warnings when running /quit with unchecked buffers, as well as get
- rid of a stray buffer problem (or so it is hoped).
-
-2005-05-31 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc-replace.el, erc-speak.el: Clean up comment formatting.
-
- * erc-ring.el (ring, erc-input-ring-index, erc-clear-input-ring):
- Clean up docstring formatting.
-
-2005-05-30 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Delete superfluous
- arg to `format'.
- (erc-load-irc-script): Use `insert-file-contents' instead of
- `insert-file'. Simplify.
-
-2005-05-29 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Move this up so that it is
- evaluated before the `require' statements. Not a major change.
-
-2005-04-27 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (erc-complete-word): Simplify.
-
-2005-04-27 Michael Olson <mwolson@gnu.org>
-
- * Makefile (debrelease): Use a slightly different approach when
- removing CVS and Arch cruft.
-
- * debian/changelog: Update for 5.0.2-1 package.
-
-2005-04-25 Michael Olson <mwolson@gnu.org>
-
- * erc-autoaway.el (erc-autoaway-reestablish-idletimer): Move code
- block higher in file to fix a load failure when using Emacs21.
- Thanks to Daniel Brockman for the report and fix.
-
-2005-04-24 Adrian Aichner <adrian@xemacs.org>
-
- * erc-backend.el (JOIN): save-excursion so that
- `erc-current-logfile' inserts into the correct channel buffers
- when using erc-log-insert-log-on-open in combination with autojoin
- to multiple channels.
-
-2005-04-17 Adrian Aichner <adrian@xemacs.org>
-
- * erc-log.el: Remove stray whitespace.
- * erc.el: Ditto.
-
-2005-04-09 Aidan Kehoe <kehoea@parhasard.net>
-
- * erc.el: autoload erc-select-read-args, which, because it parses
- erc-select's args, can be called before erc.el is loaded.
-
-2005-04-07 Edward O'Connor <ted@oconnor.cx>
-
- * erc-viper.el: Remove final newlines from previously-existing ERC
- buffers. (Minor bug fix.)
-
-2005-04-06 Michael Olson <mwolson@gnu.org>
-
- * Makefile (debrelease): Ignore errors from deleting Arch and CVS
- metadata.
-
-2005-04-05 Michael Olson <mwolson@gnu.org>
-
- * ChangeLog, CREDITS, AUTHORS: Correct name and email address of
- Marcelo Toledo.
-
-2005-04-04 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-modules): Add entry for spelling module.
-
- * erc-spelling.el: Add autoload line.
-
- * erc-backend.el: Apply latest non-ascii patch from Kai Fan.
- (erc-decode-parsed-server-response): Search
- erc-response.command-args for channel name. Decode the
- erc-response struct using this channel name as key according to
- the `erc-encoding-coding-alist'.
-
- * erc-track.el: Apply patch from Henrik Enberg.
- (erc-modified-channels-object): Use optimal amount of whitespace
- around modified channels indicator.
-
-2005-04-02 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (define-erc-module, erc-with-buffer)
- (erc-with-all-buffers-of-server, with-erc-channel-buffer): Add
- edebug-form-spec.
-
- * erc-compat.el (erc-define-minor-mode): Ditto.
-
-2005-03-29 Jorgen Schaefer <forcer@forcix.cx>
-
- * erc-spelling.el: New file.
-
-2005-03-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc-backend.el (define-erc-response-handler): Add
- `definition-name' property to constructed symbols so that
- find-function and find-variable will find them.
-
-2005-03-21 Michael Olson <mwolson@gnu.org>
-
- * erc-dcc.el, erc-goodies.el, erc-list.el, erc-notify.el,
- erc-ring.el, erc.el: Copyright assignment occurred.
-
- * debian/scripts/install: Make a shell wrapper around the original
- Makefile and inline the Makefile. The problem is that Debian
- passes all the Emacs variants at once, rotating them at every
- invocation of the install script, which happens once per variant.
- This caused each installation to happen N-1 times more often than
- it should have. As a result, we need to only deal with the first
- argument.
- (ELFILES): Only add format-spec.el if we are compiling for
- emacs21. Don't filter out erc-compat.el.
- (SITEFLAG): New variable that indicates that the "nosite" option
- should look like.
- (.DEFAULT): Use $(FLAVOUR) instead of $@ for clarity.
-
- * debian/rules: Install NEWS file and compress it.
-
- * debian/maint/postinst: Be more cautious about configuration
- step.
-
- * debian/copyright (Copyright): Another assignment came in.
-
- * debian/control (Standards-Version): Update to a newer version as
- recommended by lintian.
-
- * debian/changelog: Changes made for the Debian package.
-
- * debian/README.Debian: Keep only the General Notes section.
-
- * NEWS: Move old history items here from debian/README.Debian.
-
- * Makefile (SNAPSHOTDATE): Deprecate this option since we hope to
- release more often.
-
-2005-03-20 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-define-catalog, `ctcp-request-to'): Fix typo (%: ->
- %t:).
-
-2005-03-01 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-save-buffer-in-logs): Replace tabs with spaces
- in code indentation.
-
-2005-02-28 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-display-message): Apply corrected patch from Henrik
- Enberg.
-
-2005-02-27 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-display-message): Apply patch from Henrik Enberg.
- Check here to see if a message should be hidden, rather than
- relying on code in each individual command.
- (erc-version-string): Add "(CVS)" to the version string for
- clarity.
-
- * erc-backend.el (JOIN, KICK, MODE, NICK, PART, QUIT, TOPIC):
- Don't check `erc-hide-list' here.
-
- * erc-list.el, erc-match.el, erc.el, debian/copyright: Update
- copyright information as a few more people have assignments
- registered.
-
-2005-02-06 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el: Apply patch from Kai Fan for non-ASCII character
- support.
- (erc-parse-server-response): Add call to
- `erc-decode-parsed-server-response'.
- (erc-decode-parsed-server-response): New function that decodes a
- pre-parsed server response before it can be handled.
- (PRIVMSG): Comment out call to `erc-decode-string-from-target'.
- (TOPIC): Ditto.
-
-2005-02-01 Jorgen Schaefer <forcer@users.sourceforge.net>
-
- * erc.el (erc-process-sentinel-1): Don't reconnect on connection
- refused. This error is reported differently when using
- open-network-stream-nowait.
-
-2005-01-26 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-cmd-APPENDTOPIC, erc-set-topic): The control
- character in `channel-topic' was changed to \C-o - replaced \C-c
- with \C-o so that these functions work as expected again.
- (erc-get-channel-mode-from-keypress): Doc fix.
-
-2005-01-25 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-button.el, erc-compat.el, erc-goodies.el,
- erc-match.el, erc-nets.el, ChangeLog, NEWS: Merged bug fixes made
- on release_5_0_branch since 5.0.1 release.
-
-2005-01-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc.el (erc-input-action): Quote `erc-action-history-list' so
- that input history actually works.
- (erc-process-ctcp-query): Fix and simplify logic.
- (erc-get-channel-mode-from-keypress): Use `C-' string syntax.
- (erc-load-irc-script-lines): Use `erc-command-indicator' instead
- of `erc-prompt'.
-
-2005-01-23 Edward O'Connor <ted@oconnor.cx>
-
- * erc-viper.el: Ensure that `viper-comint-mode-hook' runs in
- buffers whose `erc-mode-hook' has already run when this file is
- loaded.
- Explicitly `require' erc.el.
-
-2005-01-22 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el (erc-mode): Remove frobbing of `require-final-newline'.
-
- * erc-log.el (erc-save-buffer-in-logs): Remove frobbing of
- `require-final-newline'.
-
- * erc-viper.el: New file. This is where all ERC/Viper
- compatibility code should live. When and if ERC is bundled with
- Emacs, some of the hacks in this file should be merged into Viper
- itself.
-
-2005-01-21 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el (erc-mode): Set `require-final-newline' to nil in ERC
- buffers. This prevents a Viper misfeature whereby extraneous
- newlines are inserted into the ERC buffer when switching between
- viper states.
-
- * erc-log.el (erc-save-buffer-in-logs): Bind `require-final-newline'
- to t when calling `write-region' to ensure that further log
- entries start on fresh lines.
-
-2005-01-21 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-add-face): Reverted my change to the
- order faces since it had the unwanted effect of putting the button
- face after all others.
- (erc-button-face-has-priority): Removed this variable as it is not
- necessary anymore - it was used to compensate for the above
- mentioned change.
-
- * NEWS: Added the latest fixes.
-
-2005-01-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el, erc-match.el:
- (erc-button-syntax-table, erc-match-syntax-table): Added \ as a
- legal character for nicknames.
-
- * erc-nets.el (erc-server-select): Fixed so that only networks
- with servers found in `erc-server-alist' are available as choices.
-
- * erc.el, erc-compat.el, erc-goodies.el:
- (erc-replace-match-subexpression-in-string): New function. Needed
- because `replace-match' in XEmacs doesn't replace regular
- expression subexpressions in strings, only in buffers.
- (erc-seconds-to-string, erc-controls-interpret): Use the new
- function.
-
- * erc-button.el (erc-button-add-button): Use the `:button-face'
- key combined with an `erc-mode' local `widget-button-face' set to
- nil to get the widget overlay face suppressed in XEmacs.
-
-2005-01-19 Francis Litterio <franl@world.std.com>
-
- * erc-button.el (erc-button-add-face): The face added by this
- function is more important than the existing text's face, so we
- now prepend erc-button-face to the list of existing faces when
- adding a button. To instead append erc-button-face to existing
- faces, set variable `erc-button-face-has-priority' to nil.
- (erc-button-face-has-priority): New variable to control how
- erc-button-add-face adds erc-button-face to existing faces.
- (erc-button-press-button): Silenced a byte-compiler warning about
- too few arguments in a call to `error'.
-
-2005-01-19 Diane Murray <disumu@x3y2z1.net>
-
- * NEWS: Added list of 5.0.1 fixes.
-
-2005-01-19 Michael Olson <mwolson@gnu.org>
-
- * AUTHORS: Move to format that cscvs can understand. As an added
- perk, entries line up nicer.
-
- * erc.el, erc-fill.el, erc-pcomplete.el, debian/copyright: Merge a
- few more copyright lines thanks to Alex Schroeder's BBDB file.
-
- * Makefile: Change version to correspond with our new scheme.
-
-2005-01-18 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list.el (erc-chanlist-channel-line-regexp): Now matches
- private channels, the channels `#' and `&', and channels with
- names including non-ascii characters.
- (erc-chanlist-join-channel): Don't attempt to join private
- channels since the channel name is unknown.
-
- * erc-goodies.el (erc-make-read-only): Add `rear-nonsticky'
- property to avoid `Text is read-only' errors during connection.
- `front-nonsticky' does not exist, changed to `front-sticky'.
- (erc-controls-interpret, erc-controls-strip): Just work on the
- string, don't open a temporary buffer.
- (erc-controls-propertize): Now accepts optional argument STR.
-
-2005-01-17 Michael Olson <mwolson@gnu.org>
-
- * Makefile: Version is 5.01, but only in the Makefile. It has not
- been released yet.
-
- * erc-auto.in, erc-autojoin.el, erc-bbdb.el, erc-button.el,
- erc-chess.el, erc-complete.el, erc-dcc.el, erc-fill.el,
- erc-goodies.el, erc-ibuffer.el, erc-identd.el, erc-imenu.el,
- erc-list.el, erc-match.el, erc-menu.el, erc-nets.el,
- erc-netsplit.el, erc-nickserv.el, erc-notify.el, erc-pcomplete.el,
- erc-ring.el, erc-speak.el, erc-speedbar.el, erc-stamp.el,
- erc-track.el, erc-xdcc.el, erc.el, debian/copyright: Update
- copyright notices. If anyone has signed papers for Emacs in
- general, merge them with the FSF's entry.
-
-2005-01-16 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc): `erc-set-active-buffer' was being called before
- `erc-process' was set, so that channels weren't being marked
- active correctly upon join; fixed.
-
-2005-01-15 Johan Bockgård <bojohan+sf@dd.chalmers.se>
-
- * erc-backend.el (def-edebug-spec): This macro caused problems (in
- XEmacs). Use its expansion directly.
-
-2005-01-15 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-add-button): Reverted previous change
- since `:suppress-face' doesn't seem to be checked for a certain
- face.
- (erc-button-add-face): FACE is now appended to the `old' face.
- This should fix the problem of faces being "covered" by
- `erc-button-face'.
-
-2005-01-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-backend.el (erc-cmd-OPS, erc-cmd-COUNTRY,
- erc-cmd-NICK, erc-process-ctcp-query, ERROR, PONG, 311, 312, 313,
- 314, 317, 319, 320, 321, 322, 330, 352): Use catalog entries
- instead of hard-coded text messages.
- (english): Added new catalog entries `country', `country-unknown',
- `ctcp-empty', `ctcp-request-to', `ctcp-too-many', `nick-too-long',
- `ops', `ops-none', `ERROR', `PONG', `s311', `s312', `s313',
- `s314', `s317', `s317-on-since', `s319', `s320', `s321', `s322',
- `s330', and `s352'.
- (erc-send-current-line): Use `erc-set-active-buffer' (change was
- lost in previous bug fix).
-
-2005-01-14 Francis Litterio <franl@world.std.com>
-
- * erc-button.el (erc-button-add-button): Fixed a bug where the
- overlay created by widget-convert-button has a `face' property
- that hides the `face' property set on the underlying button text.
-
- * erc-goodies.el: Docstring fix.
-
- * erc-button.el: Improved docstring for variable erc-button-face.
-
-2005-01-13 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el (erc-menu-definition): "Topic set by channel
- operator": Small word change. "Identify to NickServ...": Check
- that we're connected to the server. Added "Save buffer in log"
- and "Truncate buffer".
-
-2005-01-13 Lawrence Mitchell <wence@gmx.li>
-
- * erc.el (erc-display-line-1): Widen before we try to insert
- anything, this makes sure input isn't broken when the buffer is
- narrowed by the user.
- (erc-beg-of-input-line): Simplify, just return the position of
- `erc-insert-marker' or error if does not exist.
- (erc-send-current-line): Widen before trying to send anything.
-
-2005-01-13 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el, erc-backend.el, erc-list.el:
- (erc-update-mode-line-buffer): Strip controls characters from
- `channel-topic' since we add our own control character to it.
- (TOPIC, 332): Use \C-o instead of \C-c to force an end of IRC
- control characters as it also ends bold, underline, and inverse -
- \C-c only ends colors.
- (erc-chanlist-322): Strip control characters from channel and
- topic. No need to interpret controls when we're applying overlays
- to the lines.
-
- * erc.el, erc-backend.el, erc-button.el, erc-netsplit.el,
- erc-nicklist.el: Fixed so that each server has an active buffer.
- (erc-active-buffer): Now a buffer-local variable.
- (erc-active-buffer, erc-set-active-buffer): New functions.
- (erc-display-line, erc-echo-notice-in-active-non-server-buffer,
- erc-process-away, MODE): Call `erc-active-buffer' to get the
- active buffer for the current server.
- (erc, erc-process-sentinel-1, erc-grab-region, erc-input-action,
- erc-send-current-line, erc-invite-only-mode,
- erc-toggle-channel-mode, erc-channel-names, MODE, erc-nick-popup,
- erc-nicklist-call-erc-command): Use `erc-set-active-buffer' to set
- the active buffer for the current server.
- (erc-cmd-WHOLEFT): Use 'active as BUFFER in `erc-display-message'.
-
- * erc-track.el (erc-track-modified-channels): Server buffers are
- now treated the same as channels and queries. This means that
- `erc-track-priority-faces-only', `erc-track-exclude', and
- `erc-track-exclude-types' now work with server buffers.
-
-2005-01-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (475): Prompt for the channel's key if
- `erc-prompt-for-channel-key' is non-nil. Send a new JOIN message
- with the key if a key is provided.
-
- * erc.el (erc-command-indicator): Fixed customization choices so
- that there's no `mismatch' message when nil is the value.
-
-2005-01-11 Michael Olson <mwolson@gnu.org>
-
- * erc-bbdb.el (bbdb): Lowercase the name of the module. This
- fixes a bug which caused an error to occur when trying to enable
- the module using the customization interface.
-
-2005-01-08 Edward O'Connor <ted@oconnor.cx>
-
- * erc-track.el: Support using faces to indicate channel activity
- in the modeline under XEmacs.
- (erc-modified-channels-object): New function.
- (erc-modified-channels-display): Use it.
- `erc-modified-channels-string' renamed to
- `erc-modified-channels-object' (because it's no longer a string on
- XEmacs). The new function `erc-modified-channels-object' is used
- to generate updated values for the same-named variable.
-
-2005-01-08 Diane Murray <disumu@x3y2z1.net>
-
- * ChangeLog.2002: Changed instances of my sourceforge username and
- email address to real name and email.
-
- * erc.el (erc-modules): Changed customization tag descriptions, so
- that they all start with a verb; added new modules to choices.
-
-2005-01-08 Mario Lang <mlang@delysid.org>
-
- * debian/rules: Introduce new variable DOCDIR to simplify stuff a
- bit.
-
-2005-01-08 Michael Olson <mwolson@gnu.org>
-
- * AUTHORS, ChangeLog.2004: Change bpalmer's email address as
- requested.
-
- * CREDITS: Add everyone who is mentioned in the ChangeLogs.
-
- * debian/copyright (Copyright): Add last few people. This can now
- be considered a complete list, as far as CVS entries are
- concerned. If people have assigned copyright to the FSF, merge
- them with the entry for the FSF.
-
- * debian/README.Debian: Add entry for XEmacs-related change in
- `erc-track.el'.
-
- * erc.el (erc-cmd-MODE): New command that changes or displays the
- mode for a channel or user. The functionality was present before
- this change, but there was no documentation for it.
-
- * erc-auto.in, erc-*.el: Fully investigate copyright headers and
- change them appropriately. If a file has been pulled off of
- erc.el at one time, keep track of copyright from the time of
- separation, but not before. If a file has been derived from a
- work outside of erc, keep copyright statements in place.
-
- * Makefile (VERSION): Change to 5.0! :^) Congrats on all the great
- work. I'll wait until hober commits his XEmacs compatibility
- patch to erc-track.el, and then release.
- (distclean): Alias for `realclean' target.
-
-2005-01-07 Michael Olson <mwolson@gnu.org>
-
- * AUTHORS: Add Marcelo Toledo, who has CVS access to this project.
-
- * ChangeLog.2004: Add my name to my one contribution to erc last
- year.
-
- * CREDITS: Add people that were discovered while scouring
- ChangeLogs.
-
- * debian/copyright: Add everyone from `AUTHORS' to Upstream
- Authors. Anyone who has contributed 15 or more lines of
- code (according to ChangeLogs) is listed in Copyright section.
- Accurate years are included.
-
- * debian/README.Debian: Paste content of NEWS and reformat
- slightly.
-
- * debian/rules: Concatenate the ChangeLogs during the Debian
- install process and then gzip them.
-
- * Makefile (MISC): Add ChangeLog.yyyy files to list.
- (ChangeLog): Remove rule since we do not dynamically generate the
- ChangeLog anymore.
-
- * MkChangeLog: Removed since we do not use it to generate the
- ChangeLog anymore. cvs2cl does a much better job anyway.
-
- * NEWS: Use 3rd level heading instead of bullets for lists that
- contain descriptions.
-
-2005-01-07 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list.el: Require 'sort.
- (erc-chanlist): Disable undo in the channel list buffer.
-
- * erc.el, erc-menu.el: The `IRC' menu is now automatically added
- to the menu-bar. Add the call to `easy-menu-add' to
- `erc-mode-hook' when running in XEmacs (without this the menu
- doesn't appear).
-
- * NEWS: Added the information from
- http://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
- changes which weren't yet documented on that page.
-
-2005-01-06 Hoan Ton-That <hoan@ton-that.org>
-
- * erc-log.el (erc-current-logfile): Only downcase the logfile
- name, not the whole filename. Also expand relative to
- `erc-log-channels-directory'.
- (erc-generate-log-file-name-with-date)
- (erc-generate-log-file-name-short)
- (erc-generate-log-file-name-long): Don't expand filename, done in
- `erc-current-logfile'.
-
-2005-01-06 Lawrence Mitchell <wence@gmx.li>
-
- * NEWS: New file, details user visible changes from version to
- version.
-
- * HACKING (NEWS entries): Mention NEWS file, and what its purpose
- is.
-
-2005-01-05 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE: New file containing the list of release-critical
- tasks. Feel free to add to it.
-
- * debian/rules (binary-erc): Add ChangeLog files.
-
-2005-01-04 Michael Olson <mwolson@gnu.org>
-
- * ChangeLog.2001, ChangeLog.2002, ChangeLog.2003, ChangeLog.2004:
- ChangeLog entries from previous years.
-
- * ChangeLog: New file containing ChangeLog entries for the current
- year. Please update this file manually whenever a change is
- committed. This is a new policy.
-
- * AUTHORS: Add myself to list. Some entries were space-delimited
- instead of TAB-delimited, and since the latter seemed to be the
- default, make the other entries conform.
-
- * HACKING (ChangeLog Entries): Update section to reflect new
- policy toward ChangeLog entries, which is that they should be
- manually updated whenever a change is committed.
-
-2005-01-04 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-connection-established, erc-login): Update the
- mode-line.
- (erc-update-mode-line-buffer): If `erc-current-nick' returns nil,
- use an empty string for ?n character in format spec. Set
- `mode-line-process' to ":connecting" while the connection is being
- established.
-
-2005-01-04 Lawrence Mitchell <wence@gmx.li>
-
- * AUTHORS: Update list of authors.
-
-2005-01-02 Diane Murray <disumu@x3y2z1.net>
-
- * erc-goodies.el (erc-control-characters): New customization
- group.
- (erc-interpret-controls-p): Small fix, addition to
- documentation. Updated customization to allow 'remove as a value.
- Use 'erc-control-characters as `:group'.
- (erc-interpret-mirc-color): Use 'erc-control-characters as
- `:group'.
- (erc-beep-p): Updated documentation. Use 'erc-control-characters
- as `:group'.
- (define-erc-module irccontrols): Add `erc-controls-highlight' to
- `erc-insert-modify-hook' and `erc-send-modify-hook' since it
- changes the text's appearance.
- (erc-controls-remove-regexp, erc-controls-interpret-regexp): New
- variables.
- (erc-controls-highlight): Fixed so that highlighting works even if
- there is no following control character. Fixed mirc color
- highlighting; now respecting `erc-interpret-mirc-color'. Fixed a
- bug where emacs would get stuck in a loop when \C-g was in a
- message and `erc-beep-p' was set to nil (default setting).
-
-See ChangeLog.04 for earlier changes.
-
- Copyright (C) 2005-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
diff --git a/lisp/erc/ChangeLog.06 b/lisp/erc/ChangeLog.06
deleted file mode 100644
index a9261303702..00000000000
--- a/lisp/erc/ChangeLog.06
+++ /dev/null
@@ -1,1454 +0,0 @@
-2006-12-28 Michael Olson <mwolson@gnu.org>
-
- * erc-list.el: Change header to mention that this is part of ERC,
- rather than GNU Emacs.
-
- * erc-networks.el (erc-server-alist): Add Ars OpenIRC and
- LinuxChix networks. Thanks to Angelina Carlton for mentioning
- them. Properly escape periods in Konfido.Net and Kewl.Org.
- (erc-networks-alist): Add entries for Ars and LinuxChix, though
- the latter does not actually provide an announced network name.
-
- * erc-services.el (erc-nickserv-identify-mode): Add 'both method,
- which waits for a NickServ message if the network supports it,
- otherwise sends the password after connecting.
- (erc-nickserv-identify-mode): Default to 'both.
- (erc-nickserv-passwords): Add OFTC and Azzurra to custom options.
- (erc-nickserv-alist): Indentation fix.
- (erc-nickserv-identify-on-connect)
- (erc-nickserv-identify-on-nick-change): Handle 'both method.
-
-2006-12-28 Leo Liu <sdl.web@gmail.com> (tiny change)
-
- * erc.el (erc-iswitchb): Wrap body in unwind-protect so that
- hitting C-g does not leave iswitchb-mode on.
-
-2006-12-27 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-cmd-RECONNECT): New command that calls
- erc-server-reconnect.
-
- * erc-backend.el (erc-server-reconnect-count): New server variable
- that keeps track of reconnection attempts.
- (erc-server-reconnect-attempts): New option that determines the
- number of reconnection attempts that ERC will make per server.
- (erc-server-reconnect-timeout): New option that determines the
- amount of time, in seconds, that ERC will wait between successive
- reconnect attempts.
- (erc-server-reconnect): New function that reestablishes the
- current IRC connection. Move some commands from
- erc-process-sentinel-1 here.
- (erc-process-sentinel-1): If we have been disconnected, loop until
- we either reconnect or run out of attempts.
- (erc-server-reconnect-p): Move higher and make this a defsubst,
- since I'm worried about the current buffer changing from
- underneath us. Implement limit of number of reconnect attempts..
-
- * erc.texi (Getting Started): Update for /RECONNECT command.
-
-2006-12-26 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-open): Restore old point correctly, or at least get
- closer to doing so than before.
-
-2006-12-13 Leo Liu <sdl.web@gmail.com> (tiny change)
-
- * erc.el (erc-iswitchb): Temporarily enable iswitchb mode if it
- isn't active already, instead of leaving it on.
-
-2006-12-10 Juanma Barranquero <lekktu@gmail.com>
-
- * erc-ezbounce.el (erc-ezb-init-session-list): Doc fix.
-
-2006-12-08 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Re-evaluate contributions from a contributor, and found
- them under 15 lines of non-obvious code, so it is safe to remove
- the copyright notice.
- (erc-modules): Remove list module.
-
- * erc-list.el: Remove, since a contributor who has not completed
- their assignment has contributed significantly more than 15 lines
- of code to this file.
-
-2006-11-28 Juanma Barranquero <lekktu@gmail.com>
-
- * erc.el (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Simplify.
- (erc-prompt-for-channel-key, erc-ignore-reply-list, erc-send-post-hook)
- (erc-active-buffer, erc-join-buffer, erc-frame-alist, erc-with-buffer)
- (erc-modules, erc-display-message-highlight, erc-process-input-line)
- (erc-cmd-HELP, erc-server-hooks, erc-echo-notice-in-user-buffers)
- (erc-format-my-nick, erc-echo-notice-in-user-and-target-buffers)
- (erc-echo-notice-in-first-user-buffer, erc-connection-established)
- (erc-update-user-nick, erc-update-channel-member, erc-highlight-notice)
- (erc-command-symbol, erc-add-query, erc-process-script-line)
- (erc-determine-parameters, erc-client-info, erc-popup-input-buffer):
- (erc-script-echo): Fix typos in docstrings.
- (erc-channel-user-op-p, erc-channel-user-voice-p, erc-startup-file-list)
- (define-erc-module, erc-once-with-server-event)
- (erc-once-with-server-event-global, erc-debug-irc-protocol)
- (erc-log-irc-protocol, erc-cmd-LOAD, erc-update-user)
- (erc-update-current-channel-member, erc-load-script):
- (erc-mode-line-away-status-format): Doc fixes.
-
-2006-11-20 Andrea Russo <rastandy@inventati.org> (tiny change)
-
- * erc-dcc.el (erc-dcc-chat-setup): Initialize `erc-input-marker'
- before calling `erc-display-prompt'.
-
-2006-11-24 Juanma Barranquero <lekktu@gmail.com>
-
- * erc.el (erc-after-connect, erc-open-ssl-stream)
- (erc-display-line-1, erc-display-line):
- * erc-backend.el (005): Fix space/tab mixup in docstrings.
-
-2006-11-20 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Call this Version 5.2 stable
- pre-release, since it diverges slightly from our 5.2 branch, in
- that unstable features are not included.
- (erc-update-modules): Display better error message when module not
- found.
-
-2006-11-12 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el: Save all log buffers when Emacs exits, in case
- someone ignores the warning about open processes. Remove the
- advice code in the commentary.
- (erc-save-query-buffers): Docfix.
- (erc-log-save-all-buffers): New function that saves all ERC
- buffers to logs.
- (erc-current-logfile): Fix bug in filename selection, where the
- current buffer was erroneously being preferred over the given
- buffer.
-
-2006-11-08 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-string-to-port): Avoid error when a numerical port
- is passed. Thanks to Zekeriya KOÇ for the report.
-
-2006-11-08 Łukasz Demianiuk <ldemianiuk@gmail.com> (tiny change)
-
- * erc.el (erc-header-line): Fix typo.
-
-2006-11-06 Juanma Barranquero <lekktu@gmail.com>
-
- * erc-dcc.el (erc-dcc-send-file): Fix typo in error message.
-
- * erc.el (read-passwd):
- * erc-autoaway.el (erc-autoaway-reestablish-idletimer):
- * erc-truncate.el (truncate): Fix typo in docstring.
-
-2006-10-21 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-iswitchb): Fix bug when hitting C-c C-b without
- first loading iswitchb. Thanks to Leo for the report.
-
-2006-10-10 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-default-port): Make the default be 6667 instead of
- ircd. since Mac OS X apparently has problems with looking up that
- port name.
-
- * erc-backend.el (353): Receive names after displaying the initial
- message, instead of before.
-
-2006-10-05 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-my-nick-face): New face.
- (erc): Use FULL-NAME argument, not `erc-user-full-name'. This
- fixes a bug where the :full-name argument passed to the function
- was not respected.
- (erc-format-my-nick): Use `erc-my-nick-face'. This should help
- make it easier to find messages you sent in conversations when
- `erc-show-my-nick' is non-nil.
- (erc-compute-server): Doc fix.
-
-2006-10-01 John J Foerch <jjfoerch@earthlink.net> (tiny change)
-
- * erc-stamp.el (erc-insert-timestamp-right): Exclude the newline
- from the erc-timestamp field.
-
-2006-09-11 Michael Olson <mwolson@gnu.org>
-
- * erc-nicklist.el (erc-nicklist-insert-contents): Add missing
- parenthesis. Thanks to Stephan Stahl for the report.
-
-2006-09-10 Eric Hanchrow <offby1@blarg.net>
-
- * erc.el (erc-cmd-IGNORE): Prompt user if this might be a regexp
- instead of a single user.
-
-2006-09-10 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-generate-new-buffer-name): If this is a server
- buffer and a process exists already, create a new buffer.
- (erc-open): If the IRC session was continued, restore the old
- point. Thanks to Stephan Stahl for the report.
- (erc-member-ignore-case): Coding style tweak.
- (erc-cmd-UNIGNORE): Quote the user before comparison. If we don't
- find the user listed verbatim, try to match them against the list
- using string-match. In this case, prompt as to whether the regexp
- should be removed.
- (erc-ignored-user-p): Remove CL-ism.
-
- * erc-autoaway.el (erc-autoaway-possibly-set-away): Check to see
- whether we are already away.
-
- * erc-menu.el: Fix potential compiler warning.
-
-2006-09-07 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: Updated Commentary and URL.
- (erc-iswitchb, erc-display-line, erc-set-modes, erc-update-modes)
- (erc-arrange-session-in-multiple-windows): No need to check if
- `erc-server-process' is bound.
- (erc-server-buffer-live-p): Doc fix.
- (erc-part-from-channel): Don't use any initial contents at prompt.
- (erc-format-nick, erc-format-@nick): Doc fix. Use `when'.
- (s367): Fixed to support only banmask and channel which is the
- standard. Also, there's no reason to add a message to each banned
- user entry trying to persuade the user to use /banlist instead of
- /mode #channel +b. That part of the message was a little
- confusing, anyways.
- (s367-set-by): New catalog entry. The user who set the ban and
- the time of ban seem to be specific to only certain servers such
- as freenode.
-
- * erc-autoaway.el (erc-autoaway-idletimer): Doc fix.
-
- * erc-backend.el (erc-server-process-alive): No need to check if
- `erc-server-process' is bound.
- (367): Use s367 or s367-set-by where appropriate.
-
- * erc-compat.el: Fixed URL.
-
- * erc-dcc.el: Updated copyright years. Added Usage section.
- Changed supported Emacs version number from 21.3.50 to 22 in
- Commentary.
-
- * erc-ibuffer.el (erc-server-name, erc-target, erc-away): No need
- to check if `erc-server-process' is bound.
-
- * erc-nicklist.el: Added to the Commentary section an explanation
- that `erc-nicklist-quit' should be called from within the nicklist
- buffer. Set file coding to utf-8 so a contributor's name is
- displayed correctly.
- (erc-nicklist-icons-directory): Use customize type directory
- instead of string.
- (erc-nicklist-insert-contents): Set bbdb-nick to an empty string
- if it wasn't found. This fixes a bug where an error would occur
- when using `string=' on bbdb-nick if it was nil.
-
- * erc-replace.el: Removed URL from file information since it
- doesn't exist.
-
- * erc-sound.el: Updated copyright years. Fixed Commentary and
- added Usage section.
- (define-erc-module): Add and remove `erc-ctcp-query-SOUND' to
- `erc-ctcp-query-SOUND-hook' here. Removed the keybinding
- definitions.
- (erc-play-sound, erc-default-sound, erc-cmd-SOUND)
- (erc-ctcp-query-SOUND): Doc fix.
- (erc-play-command): Removed, not necessary anymore.
- (erc-ctcp-query-SOUND-hook): Set to nil as default. Moved up
- higher in code, added docstring.
- (erc-play-sound): Use `play-sound-file'. It exists in GNU Emacs
- as well since version 21 or earlier. Removed commented-out older
- version of function.
-
- * NEWS: Fixed formatting, added channel tracking change.
-
-2006-09-03 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el: M-x erc RET can now be used to start ERC.
- (erc-open): Renamed from `erc'.
- (erc-before-connect): Change erc-select to erc.
- (erc): Renamed from `erc-select'. Use `erc-open'.
- (erc-select): Defined as alias of `erc'.
- (erc-ssl): Renamed from `erc-select-ssl'. Use `erc'.
- (erc-select-ssl): Defined as alias of `erc-ssl'.
- (erc-cmd-SERVER): Use `erc'.
- (erc-query, erc-handle-irc-url): Use `erc-open'.
-
- * erc-backend.el (erc-process-sentinel-1, JOIN): Use `erc-open'.
-
- * erc-menu.el (erc-menu-definition): Use `erc'.
-
- * erc-networks.el: Updated copyright years.
- (erc-server-select): Use keyword arguments when calling `erc'.
-
- * erc.texi (Getting Started, Connecting): Changed erc-select to
- erc.
-
- * README: Changed erc-select to erc.
-
- * NEWS: Added note about these changes.
-
- * FOR-RELEASE: Marked this item as done.
-
-2006-08-21 Diane Murray <disumu@x3y2z1.net>
-
- * erc-track.el (erc-track-mode-line-mouse-face): New variable.
- (erc-make-mode-line-buffer-name): Add help-echo and mouse-face
- properties to channel name.
-
-2006-08-20 Michael Olson <mwolson@gnu.org>
-
- * erc-identd.el (erc-identd): New customization group.
- (erc-identd-port): New option that specifies the port to use if
- none is given as an argument to erc-identd-start.
- (identd): Place erc-identd-quickstart in erc-connect-pre-hook
- instead of erc-identd-start so that we deal with the different
- meaning of the first argument.
- (erc-identd-start): Use erc-identd-port.
- (erc-identd-quickstart): New function that ignores any arguments
- and calls erc-identd-start.
-
- * erc.el (erc-with-server-buffer): New macro that switches to the
- current ERC server buffer and runs some code. If no server buffer
- is available, return nil. This is a useful way to access
- variables in the server buffer.
- (erc-get-server-user, erc-add-server-user)
- (erc-remove-server-user, erc-change-user-nickname)
- (erc-get-server-nickname-list, erc-get-server-nickname-alist)
- (erc-ison-p, erc-active-buffer, erc-cmd-IGNORE)
- (erc-cmd-UNIGNORE, erc-cmd-IDLE, erc-cmd-NICK, erc-cmd-BANLIST)
- (erc-cmd-MASSUNBAN, erc-nickname-in-use, erc-ignored-user-p)
- (erc-format-channel-modes): Use it.
- (erc-once-with-server-event, erc-once-with-server-event-global)
- (erc-with-buffer, erc-with-all-buffers-of-server): Use make-symbol
- instead of gensym.
- (erc-open-server-buffer-p): New function that returns non-nil if
- the given buffer is an ERC server buffer that has an open IRC
- process.
- (erc-with-buffer): Use buffer-live-p here to set a good example,
- though it isn't really needed here.
- (erc-away): Mention erc-away-time.
- (erc): Don't propagate the erc-away setting, since it makes more
- sense to access it from the server buffer. Set up the prompt
- before connecting rather than after. Run erc-connect-pre-hook
- with the buffer as an argument, instead of no arguments.
- (erc-cmd-GAWAY): Use erc-open-server-buffer-p instead of
- erc-server-buffer-p so that only open connections are set away.
- (erc-cmd-GQUIT): Use erc-open-server-buffer-p.
- (erc-process-away): Docfix. Don't set erc-away in channel
- buffers.
- (erc-set-current-nick): Make this uniform with the style used in
- erc-current-nick.
- (erc-away-time): Rename from erc-away-p, since this is no longer a
- boolean-style predicate.
- (erc-format-away-status): Use it.
- (erc-initialize-log-marker): Accept a `buffer' argument.
- (erc-connect-pre-hook): Docfix.
- (erc-connection-established): Make sure this runs in the correct
- buffer.
- (erc-set-initial-user-mode): Accept a `buffer' argument.
-
- * erc-stamp.el (erc-add-timestamp): Use erc-away-time.
-
- * erc-spelling.el (erc-spelling-init): Use
- erc-with-server-buffer. Accept `buffer' argument.
- (spelling): Call erc-spelling-init with the `buffer' argument.
-
- * erc-speedbar.el (erc-speedbar-buttons): Use erc-server-buffer-p.
-
- * erc-pcomplete.el (pcomplete/erc-mode/UNIGNORE)
- (pcomplete-erc-all-nicks): Use erc-with-server-buffer.
-
- * erc-notify.el (erc-notify-timer, erc-cmd-NOTIFY): Use
- erc-with-server-buffer.
-
- * erc-networks.el (erc-network, erc-current-network)
- (erc-network-name): Use erc-with-server-buffer.
-
- * erc-netsplit.el (erc-cmd-WHOLEFT): Use erc-with-server-buffer.
-
- * erc-match.el (erc-log-matches, erc-log-matches-come-back): Use
- erc-away-time.
-
- * erc-log.el (log): Use erc-away-time. Remove unnecessary check.
- Pass `buffer' argument to erc-log-setup-logging instead of setting
- the current buffer. Ditto for erc-log-disable-logging.
- (erc-log-setup-logging, erc-log-disable-logging): Accept a `buffer'
- argument.
-
- * erc-list.el (erc-chanlist): Use erc-with-server-buffer.
-
- * erc-ibuffer.el (erc-away): Use erc-away-time.
-
- * erc-dcc.el (erc-dcc-get-filter): Temporarily make the buffer
- read only instead of permanently doing so.
-
- * erc-compat.el (erc-gensym, *erc-sym-counter*): Remove, since
- Emacs Lisp has make-symbol, which is better.
-
- * erc-chess.el (erc-chess-handler, erc-cmd-CHESS): Use
- erc-with-server-buffer.
-
- * erc-capab.el (capab-identify): Only deal with server buffers
- that have an open IRC process.
- (erc-capab-identify-add-prefix): Use erc-with-server-buffer.
-
- * erc-backend.el (erc-server-connected): Docfix. Recommend the
- `erc-server-process-alive' function.
- (erc-coding-system-for-target): Supply a default target if one is
- not given.
- (erc-server-send): Simplify slightly.
- (erc-call-hooks): Use erc-with-server-buffer.
- (erc-server-connect, erc-server-setup-periodical-ping): Accept
- `buffer' argument.
-
- * erc-autoaway.el (erc-autoaway-reestablish-idletimer): Move
- higher to avoid an automatic load snafu.
- (erc-autoaway-some-server-buffer): New function that returns an
- ERC server buffer with a live connection, or nil otherwise.
- (erc-autoaway-insinuate-maybe): New function that adds the
- autoaway reset function to post-command-hook if at least one ERC
- process is alive.
- (erc-autoaway-remove-maybe): New function that removes the
- autoaway reset function from post-command-hook if no ERC process
- is alive.
- (autoaway): Don't touch post-command-hook unless an IRC process is
- already open. Remove our addition to post-command-hook as soon as
- there are no more IRC processes open. Reset the indicators before
- connecting to an IRC server, which fixes a bug when re-connecting.
- (erc-autoaway-reset-idle-user): Call erc-autoaway-remove-maybe if
- there are no more IRC processes open.
- (erc-autoaway-set-back): Pick an open IRC process. Accept an
- argument which is a function call if we can't find one.
- (erc-autoaway-some-open-server-buffer): New function which returns
- an ERC server buffer with an open connection and a user that is
- not away.
- (erc-autoaway-possibly-set-away, erc-autoaway-set-away): Use it.
- (erc-autoaway-set-away): Accept a `notest' argument which is used
- to avoid testing the same thing twice.
- (erc-autoaway-last-sent-time, erc-autoaway-caused-away): Move
- higher in file to fix byte-compile warning.
-
-2006-08-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (erc-process-sentinel-1): Doc fix. Let
- `erc-server-reconnect-p' check all condition cases.
- (erc-server-reconnect-p): Moved rest of checks from
- `erc-process-sentinel-1' to here. Now takes an argument, EVENT.
-
-2006-08-14 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el: Updated copyright years. Removed EmacsWiki URL.
- (erc-menu-definition): Name the menu "ERC" instead of "IRC" to
- avoid confusion with rcirc and other clients.
-
- * erc-backend.el (erc-server-banned): New variable.
- (erc-server-connect): Set `erc-server-banned' to nil.
- (erc-process-sentinel-1): Use `erc-server-reconnect-p'.
- (erc-server-reconnect-p): New function. Return non-nil if the
- user wants automatic reconnects and if the user has not been
- banned from the server. This should fix a bug where ERC gets into
- a loop trying to reconnect with no way to stop it when the user is
- denied access to the server due to a server ban. It might also
- help when Tor users are blocked from freenode if freenode servers
- send the 465 message before disconnecting.
- (465): Handle "banned from server" error notices.
-
-2006-08-13 Romain Francoise <romain@orebokech.com>
-
- * erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p'
- prompt with a space.
-
-2006-08-13 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-timed-out): New variable that
- indicates whether the current connection has timed out due to
- failure to respond to a ping.
- (erc-server-send-ping): Set erc-server-timed-out to t.
- (erc-server-connect): Initialize erc-server-timed-out to nil.
- (erc-process-sentinel-1): Consult erc-server-timed-out.
-
-2006-08-11 Michael Olson <mwolson@gnu.org>
-
- * erc-fill.el (erc-fill): Skip any initial empty lines so that we
- avoid errors when inserting disconnect messages and other messages
- that begin with newlines.
-
-2006-08-07 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-process-sentinel-1): Use erc-display-message
- in several places instead of inserting text.
- (erc-process-sentinel): Move to the input-marker before removing
- the prompt.
-
- * erc.el (erc-port): Fix customization options.
- (erc-display-message): Handle null type explicitly. Previously,
- this was relying on a chance side-effect. Cosmetic indentation
- tweak.
- (english): Add 'finished and 'terminated entries to the catalog.
- Add initial and terminal newlines to 'disconnected and
- 'disconnected-noreconnect entries. Avoid long lines.
- (erc-cmd-QUIT): Bind the current erc-server-process to
- server-proc. If the IRC server responds quickly, it is possible
- for the connection to close, and hence server buffer to be killed,
- if erc-kill-server-buffer-on-quit is non-nil. This avoids that
- problem.
-
-2006-08-06 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-send-queue): Update from Circe
- version of this function.
- (erc-server-ping-timer-alist): New variable that keeps track of
- ping timers according to their associated server.
- (erc-server-last-received-time): New variable that specifies the
- time of the last message we received from the server. This is
- used to detect hung processes.
- (erc-server-send-ping): New function that sends a ping to the IRC
- process corresponding with the given buffer. Split from
- erc-server-setup-periodical-ping. If the server buffer no longer
- exists, cancel the timer. If the server process has not given us
- a message, including PING responses, since the last PING, kill it.
- This is necessary to deal with some aberrant freenode behavior.
- Idea taken from rcirc.
- (erc-server-setup-periodical-ping): Rename from
- erc-server-setup-periodical-server-ping.
- (erc-server-filter-function): Use erc-current-time instead of
- current-time.
-
- * erc.el (erc-arrange-session-in-multiple-windows): Fix bug with
- multi-tty Emacs.
- (erc-select-startup-file): Fix bug introduced by recent change.
- (erc-cmd-QUIT): If the IRC process has not terminated itself
- within 4 seconds of completing our quit-hook, kill it manually.
- Freenode in particular needs this.
- (erc-connection-established): Use erc-server-setup-periodical-ping
- instead of erc-server-setup-periodical-server-ping.
-
-2006-08-05 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-log-standardize-name): New function that returns
- a filename that is safe for use for a log file.
- (erc-current-logfile): Use it.
-
- * erc.el (erc-startup-file-list): Search in ~/.emacs.d first,
- since that is a fairly standard directory.
- (erc-select-startup-file): Re-write to use
- convert-standard-filename, which will ensure that MS-DOS systems
- look for the _ercrc.el file.
-
-2006-08-02 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Release ERC 5.1.4.
-
- * Makefile, NEWS, erc.texi: Update for the 5.1.4 release.
-
- * erc.el (erc-active-buffer): Fix bug that caused messages to go
- to the wrong buffer. Thanks to offby1 for the report.
-
- * erc-backend.el (erc-coding-system-for-target): Handle case where
- target is nil. Thanks to Kai Fan for the patch.
-
-2006-07-29 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-log-setup-logging): Don't offer to save the
- buffer. It will be saved automatically killed. Thanks to Johan
- Bockgård and Tassilo Horn for pointing this out.
-
-2006-07-27 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (define-erc-module): Make find-function and find-variable
- find the names constructed by `define-erc-module' in Emacs 22.
-
-2006-07-14 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (log): Make sure that we enable logging on
- already-opened buffers as well, in case the user toggles this
- module after loading ERC. Also be sure to remove logging ability
- from all ERC buffers when the module is disabled.
- (erc-log-setup-logging): Set buffer-file-name to nil rather than
- the empty string. This should fix some errors that occur when
- quitting Emacs without first killing all ERC buffers.
- (erc-log-disable-logging): New function that removes the logging
- ability from the current buffer.
-
- * erc-spelling.el (spelling): Use dolist and buffer-live-p.
-
-2006-07-12 Michael Olson <mwolson@gnu.org>
-
- * erc-match.el (erc-log-matches): Bind inhibit-read-only rather
- than call toggle-read-only.
-
- * erc.el (erc-handle-irc-url): Move here from erc-goodies.el and
- add autoload cookie.
-
-2006-07-09 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Release ERC 5.1.3.
-
- * erc.texi: Update for the 5.1.3 release.
-
- * erc-autoaway.el (erc-autoaway-set-back): Fix bug after returning
- from being set automatically away and current buffer is not an ERC
- buffer.
-
- * erc-identd.el: Fix compiler error.
-
- * erc.texi (Development): Use @subheading instead of @subsection.
- (Advanced Usage): Add menu.
- (Connecting): Fully document how to connect to an IRC server.
- (Options, Tips and Tricks, Sample Configuration): New unwritten
- sections.
-
- * erc.el (erc-server, erc-port, erc-nick, erc-nick-uniquifier)
- (erc-user-full-name, erc-password): Docfixes and customization
- interface tweaks.
- (erc-try-new-nick-p): Rename from
- `erc-manual-set-nick-on-bad-nick-p' and invert meaning.
- (erc-nickname-in-use): Use `erc-try-new-nick-p'. Check the length
- of `erc-nick-uniquifier', in case someone wants multiple
- characters.
- (erc-compute-server, erc-compute-nick, erc-compute-full-name)
- (erc-compute-port): Docfixes.
-
- * erc-log.el (log): Move all add-hook calls here, rather than
- executing them immediately, and also cause them to be un-hooked
- when the module is removed.
- (erc-save-buffer-on-part): Move next to
- `erc-save-queries-on-quit'.
- (erc-save-buffer-on-quit, erc-save-queries-on-quit): Default to t.
- (erc-log-write-after-send, erc-log-write-after-insert): Default to
- nil. This makes things fast, but reasonably failsafe, by default.
-
-2006-07-08 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-log-insert-log-on-open): Make this nil by
- default, since most IRC clients don't do this.
- (erc-log-write-after-send): New option that determines whether the
- log file will be written to after every sent message.
- (erc-log-write-after-insert): New option that determines whether
- the log file will be written to when new text is added to a logged
- ERC buffer.
- (log): Use the aforementioned options.
-
- * erc.texi (Modules): Document the "completion" module.
-
- * erc-pcomplete.el (pcomplete-erc-nicks): Make sure that we don't
- have a nil element in the list when ignore-self is non-nil.
-
-2006-07-05 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-modules): Use `set' instead of `set-default', since
- this setting should never be buffer-local. Add the `page' module
- to the list.
-
- * erc.texi (Modules): Add entries for `list' and `page' modules.
- Change "spell" to "spelling".
- (History): Use past tense throughout.
-
-2006-07-02 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-call-hooks): Fix (stringp nil) error that
- can happen when doing /PART.
-
- * erc.el (erc-quit-reason-various-alist)
- (erc-part-reason-various-alist): In the example, use "^$" as an
- example, since "" matches anything.
- (erc-quit-reason-various, erc-part-reason-various): If no argument
- is given, and no matches are found, use our default reason instead
- of "nil".
-
-2006-06-30 Michael Olson <mwolson@gnu.org>
-
- * erc.texi (Modules): Mention identd.
- (Releases): Update mailing list address and download location.
- (Development): Refactor. Provide updated directions for Arch.
- Make URLs clickable.
- (Keystroke Summary): Typo fix. Use more Texinfo syntax.
- (Getting Started): Give simpler example. We do not need to
- explicitly load every module.
- (History): Update.
-
- * erc-autoaway.el, erc-join.el, erc-backend.el, erc-bbdb.el:
- erc-button.el, erc-chess.el, erc-compat.el, erc-hecomplete.el:
- erc-dcc.el, erc-ezbounce.el, erc-fill.el, erc-ibuffer.el:
- erc-imenu.el, erc-list.el, erc-log.el, erc-match.el, erc-menu.el:
- erc-networks.el, erc-netsplit.el, erc-nicklist.el:
- erc-services.el, erc-pcomplete.el, erc-replace.el, erc-ring.el:
- erc-speedbar.el, erc-spelling.el, erc-stamp.el, erc-track.el:
- erc.el: Remove version strings.
-
- * erc.el (erc-cmd-SMV): Remove, since we do not have meaningful
- module versions anymore.
- (erc-version-modules): Remove, since we do not use this function
- anymore.
- (erc-latest-version, erc-ediff-latest-version): Remove, since this
- was only useful back when ERC consisted of one file.
- (erc-modules): Add line for identd.
- (erc-get-channel-mode-from-keypress): Typo fix.
-
- * erc-imenu.el: Remove unnecessary lines in header.
-
- * erc-goodies.el (erc-handle-irc-url): Docfix.
-
- * erc-identd.el: Define an ERC module for this.
- (erc-identd-start): Don't create a process buffer if possible.
- Otherwise, use conventional hidden names for process buffers.
-
-2006-06-29 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-coding-system-for-target): Match
- case-insensitively. Use a pattern match instead of `assoc', as
- per the documentation for `erc-encoding-coding-alist'.
-
- * erc-track.el (erc-track-shorten-aggressively): Fix typo.
-
-2006-06-27 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Update maintainer information and URLs.
-
-2006-06-14 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-active-buffer): If the active buffer has been
- deleted, default to the server buffer.
- (erc-toggle-flood-control): When the user hits C-c C-f, make flood
- control really toggle, not unconditionally turn off.
-
-2006-06-12 Michael Olson <mwolson@gnu.org>
-
- * NEWS: Add items since the 5.1.2 release.
-
- * erc-autoaway.el (erc-autoaway-caused-away): New variable that
- indicates whether the current away status was caused by this
- module.
- (erc-autoaway-set-back): Only set back if this module set the user
- away.
- (erc-autoaway-set-away): Update `erc-autoaway-caused-away'.
- (erc-autoaway-reset-indicators): New function that resets some
- indicators when the user is no longer away.
- (autoaway): Add the above function to the 305 hook.
-
-2006-06-05 Romain Francoise <romain@orebokech.com>
-
- * erc.texi (History): Fix various typos.
-
-2006-06-04 Michael Olson <mwolson@gnu.org>
-
- * erc-autoaway.el (erc-autoaway-idle-method): Move after the
- definition of the autoaway module.
- (autoaway): Don't do anything if erc-autoaway-idle-method is
- unbound. This prevents an error on startup.
-
-2006-06-03 Michael Olson <mwolson@gnu.org>
-
- * erc-autoaway.el: Thanks to Mark Plaksin for the ideas and patch.
- (erc-autoaway-idle-method): Renamed from
- `erc-autoaway-use-emacs-idle'. We have more than two choices for
- how to do this, so it's best to make this take symbol values.
- Improve documentation. Remove warning against Emacs idle-time;
- the point is moot now that we get user idle time via a different
- method. Make sure we disable and re-enable the module when
- changing this value.
- (autoaway): Conditionalize on the above option. If using the idle
- timer or user idle methods, don't add anything to the
- send-completed or server-001 hooks, since it is unnecessary.
- (erc-autoaway-reestablish-idletimer, erc-autoaway-message):
- Docfix.
- (erc-autoaway-idle-seconds): Use erc-autoaway-idle-method.
- (erc-autoaway-reset-idle-irc): Renamed from
- `erc-autoaway-reset-idle'. Don't pass line to
- `erc-autoaway-set-away', since it is not used.
- (erc-autoaway-reset-idle-user): New function that resets the idle
- state for user idle time.
- (erc-autoaway-set-back): Remove line argument, since it is not
- used.
-
-2006-06-01 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-buffer-filter): Make sure all buffers returned from
- this are live.
-
-2006-05-01 Edward O'Connor <ted@oconnor.cx>
-
- * erc-goodies.el (erc-handle-irc-url): New function, suitable as
- a value for `url-irc-function'.
-
-2006-04-18 Diane Murray <disumu@x3y2z1.net>
-
- * erc-pcomplete.el (pcomplete-erc-nicks): Added new optional
- argument IGNORE-SELF. If this is non-nil, don't return the user's
- current nickname. Doc fix.
- (pcomplete/erc-mode/complete-command): Don't complete the current
- nickname.
-
-2006-04-05 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-cmd-SV): Removed the exclamation point. Show the
- build date as it's shown in `emacs-version'.
-
- * erc-capab.el (erc-capab-identify-add-prefix): Insert the prefix
- with the same face property as the previous character.
-
-2006-04-02 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el, erc-ezbounce.el, erc-join.el, erc-netsplit.el,
- erc.el: Make sure to include a newline inside of negated classes,
- so that a newline is not matched.
-
-2006-04-01 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-connect-function): Don't try to
- detect the existence of the `open-network-stream-nowait' function,
- since I can't find it in Emacs21, XEmacs21, or Emacs22.
-
-2006-03-27 Michael Olson <mwolson@gnu.org>
-
- * erc.texi: Update direntry. Remove unneeded local variables.
-
-2006-03-26 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-header-line): New face that will be used to colorize
- the text of the header-line, provided that
- `erc-header-line-face-method' is non-nil.
- (erc-prompt-face): Fix formatting.
- (erc-header-line-face-method): New option that determines the
- method used for colorizing header-line text. This may be a
- function, nil, or non-nil.
- (erc-update-mode-line-buffer): Use the aforementioned option and
- face to colorize the header-line text, if that is what the user
- wants.
- (erc-send-input): If flood control is not activated, don't split
- the input line.
-
-2006-03-25 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-cmd-QUOTE): Install patch from Aravind Gottipati
- that fixes the case where there is no leading whitespace. Only
- remove the first space character, though.
-
- * erc-identd.el (erc-identd-start): Fix a bug by making sure that
- erc-identd-process is set properly.
- (erc-identd-start, erc-identd-stop): Add autoload cookies.
- (erc-identd-start): Pass :host parameter so this works with Emacs
- 22.
-
-2006-03-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-keymap): Use <backtab> rather than
- <C-tab> for `erc-button-previous' as it is a more standard key
- binding for this type of function.
-
-2006-02-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-capab.el: Removed things that were accidentally committed on
- 2006-02-20. Removed Todo section.
- (erc-capab-unidentified): Removed.
-
-2006-02-26 Michael Olson <mwolson@gnu.org>
-
- * erc-capab.el: Use (eval-when-compile (require 'cl)).
- (erc-capab-unidentified): Fix compiler warning by specifying
- group.
-
-2006-02-20 Diane Murray <disumu@x3y2z1.net>
-
- * erc-capab.el (erc-capab-send-identify-messages): Fixed comment
- to explain thoughts better. `erc-server-parameters' is an
- associated list when it's set, not a string.
-
-2006-02-19 Michael Olson <mwolson@gnu.org>
-
- * erc-capab.el (erc-capab-send-identify-messages): Make sure some
- parameters are strings before using them. Thanks to Alejandro
- Benitez for the report.
-
- * erc.el (erc-version-string): Release ERC 5.1.2.
-
-2006-02-19 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-keymap): Bind `erc-button-previous' to
- <C-tab>.
- (erc-button-previous): New function.
-
-2006-02-15 Michael Olson <mwolson@gnu.org>
-
- * NEWS: Add category for ERC 5.2.
-
- * erc.el (erc): Move to the end of the buffer when a continued
- session is detected. Thanks to e1f and indio for the report and
- testing a potential fix.
-
-2006-02-14 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: Prepare a new Debian package.
-
- * Makefile (debprepare): New rule that creates an ERC snapshot
- directory for use in both new Debian releases and revisions for
- Debian packages.
- (debrelease, debrevision-mwolson): Use debprepare.
-
- * NEWS: Bring up-to-date.
-
- * erc-stamp.el (erc-insert-timestamp-right): For now, put
- timestamps before rather than after erc-fill-column when
- erc-timestamp-right-column is nil. This way we won't surprise
- anyone unpleasantly, or so it is hoped.
-
-2006-02-13 Michael Olson <mwolson@gnu.org>
-
- * erc-dcc.el: Use (eval-when-compile (require 'cl)).
-
-2006-02-12 Michael Olson <mwolson@gnu.org>
-
- * erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el
- * erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el
- * erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el
- * erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el
- * erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el
- * erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el
- * erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el:
- Add 2006 to copyright years, to comply with the changed guidelines.
-
-2006-02-11 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-update-modules): Handle erc-capab-identify
- correctly. Make some requirements shorter, so that it's easier to
- see why they are needed.
-
- * erc-capab.el: Add autoload cookie for capab-identify.
- (erc-capab-send-identify-messages, erc-capab-identify-activate):
- Minor whitespace fix in code.
-
- * erc-stamp.el (erc-timestamp-use-align-to): Renamed from
- `erc-timestamp-right-align-by-pixel'. Set the default based on
- whether we are in Emacs 22, and using X. Improve documentation.
- (erc-insert-aligned): Remove calculation of offset, since
- :align-to pos works after all. Unlike the previous solution, this
- one works when erc-stamp.el is compiled.
- (erc-insert-timestamp-right): Don't add length of string, and then
- later remove its displayed width. This puts timestamps after
- erc-fill-column when erc-timestamp-right-column is nil, rather
- than before it. It also fixes a subtle bug. Remove use of
- `current-window', since there is no variable by that name in
- Emacs21, Emacs22, or XEmacs21 beta. Check to see whether
- `erc-fill-column' is non-nil before using it.
-
-2006-02-11 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list.el: Define `list' module which sets the alias
- `erc-cmd-LIST' to `erc-list-channels' when enabled and
- `erc-list-channels-simple' when disabled.
- (erc-list-channels): Was `erc-cmd-LIST', renamed.
- (erc-list-channels-simple): New function.
-
- * erc.el (erc-modules): Added `list' to enabled modules. Changed
- `capab-identify' description. Moved customization options left in
- source code.
-
- * erc-menu.el (erc-menu-definition): Use `erc-list-channels'.
-
- * erc-capab.el: Put a little more detail into Usage section.
- (define-erc-module): Run `erc-capab-identify-setup' in all open
- server buffers when enabling.
- (erc-capab-identify-setup): Make PROC and PARSED optional
- arguments.
- (erc-capab-identify-add-prefix): Simplified nickname regexp. This
- should now also match nicknames that are formatted differently
- than the default.
-
- * erc-spelling.el (define-erc-module): Make sure there's a buffer
- before calling `with-current-buffer'.
-
-2006-02-10 Michael Olson <mwolson@gnu.org>
-
- * Makefile (debbuild): Split from debrelease.
- (debrevision-mwolson): New rule that causes a Debian revision to
- be built.
-
- * erc.el (erc-migrate-modules): Use a better algorithm. Thanks to
- Johan Bockgård.
- (erc-modules): Change use of 'pcomplete to 'completion.
-
-2006-02-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-get-parsed-vector, erc-get-parsed-vector-nick)
- * erc-capab.el: Require erc.
- (erc-capab-send-identify-messages): Use `erc-server-send'.
- (erc-capab-identify-remove/set-identified-flag): Use 1 and 0 as
- the flags so we can also check whether the `erc-identified' text
- property is there at all.
- (erc-capab-identify-add-prefix): Use `erc-capab-find-parsed'.
- This fixes a bug where the prefix wasn't inserted when timestamps
- are inserted on the right. Tweaked nickname regexp.
- (erc-capab-find-parsed): New function.
- (erc-capab-get-unidentified-nickname): Updated to check for 0
- flag. Only get nickname if there's a nickuserhost associated with
- this message.
-
- * erc-capab.el: New file. Adds the new module
- `erc-capab-identify', which allows flagging of unidentified users
- on servers running an ircd based on dancer - irc.freenode.net, for
- example.
-
- * erc.el (erc-modules): Added `capab-identify' to options.
- (erc-get-parsed-vector, erc-get-parsed-vector-nick)
- (erc-get-parsed-vector-type): Moved here from erc-match.el.
-
- * erc-match.el (erc-get-parsed-vector, erc-get-parsed-vector-nick)
- (erc-get-parsed-vector-type): Moved these functions to erc.el
- since they can be useful outside of the text matching module.
-
- * NEWS: Added erc-capab.el.
-
- * erc-dcc.el, erc-stamp.el, erc-xdcc.el: Changed "Emacs IRC Client"
- to "ERC".
-
-2006-02-07 Michael Olson <mwolson@gnu.org>
-
- * ChangeLog.01, ChangeLog.02, ChangeLog.03, ChangeLog.04,
- ChangeLog.05: Rename from ChangeLog.NNNN in order to disambiguate
- the filenames in DOS.
-
- * erc-goodies.el: Comment fix.
-
- * erc-hecomplete.el: Rename from erc-complete.el. Update
- commentary. Use define-erc-module so that it's possible to
- actually use this.
- (erc-hecomplete): Rename function from `erc-complete'.
- (erc-hecomplete): Rename group from `erc-old-complete'. Docfix.
-
- * erc-join.el: Rename from erc-autojoin.el.
-
- * erc-networks.el: Rename from erc-nets.el.
-
- * erc-services.el: Rename from erc-nickserv.el.
-
- * erc-stamp.el (erc-insert-aligned): Don't take 3rd argument. Use
- the simpler `indent-to' function when
- `erc-timestamp-right-align-by-pixel' is nil.
- (erc-insert-timestamp-right): If the timestamp goes on the
- following line, don't add timestamp properties to the spaces in
- front of it.
-
- * erc.el (erc-migrate-modules): New function that eases migration
- of module names.
- (erc-modules): Call erc-migrate-modules in the :get accessor.
- (erc-modules, erc-update-modules): Update for new modules names.
- (erc-cmd-SMV): Remove, since this does not give useful output due
- to the version strings being removed from ERC modules.
-
-2006-02-05 Michael Olson <mwolson@gnu.org>
-
- * erc-spelling.el (erc-spelling-init): If
- `erc-spelling-dictionaries' is nil, do not set
- ispell-local-dictionary. Before, it was being set to nil, which
- was causing a long delay while the ispell process restarted.
- (erc-spelling-unhighlight-word): New function that removes
- flyspell properties from a spell-checked word.
- (erc-spelling-flyspell-verify): Don't spell-check nicks or words
- that have '/' before them.
-
-2006-02-04 Michael Olson <mwolson@gnu.org>
-
- * erc-autojoin.el: Use (eval-when-compile (require 'cl)).
-
- * erc-complete.el (erc-nick-completion-exclude-myself)
- (erc-try-complete-nick): Use better function for getting list of
- channel users.
-
- * erc-goodies.el: Docfix.
-
- * erc-stamp.el: Use new arch tagline, since the other one wasn't
- being treated properly.
-
- * erc.el (erc-version-string): Release ERC 5.1.1.
-
-2006-02-03 Zhang Wei <id.brep@gmail.com>
-
- * erc.el (erc-version-string): Don't hard-code Emacs version.
- (erc-version): Use emacs-version.
-
-2006-01-31 Michael Olson <mwolson@gnu.org>
-
- * erc-stamp.el: Update copyright years.
-
-2006-01-30 Simon Josefsson <jas@extundo.com>
-
- * erc.el (erc-open-ssl-stream): Use tls.el.
-
-2006-01-30 Michael Olson <mwolson@gnu.org>
-
- * erc-stamp.el (erc-timestamp-right-align-by-pixel): New option
- that determines whether to use pixel values to align right
- timestamps. The default is not to do so, since it only works with
- Emacs22 on X, and even then some people have trouble.
- (erc-insert-aligned): Use `erc-timestamp-right-align-by-pixel'.
-
-2006-01-29 Michael Olson <mwolson@gnu.org>
-
- * ChangeLog, ChangeLog.2005, ChangeLog.2004, ChangeLog.2003,
- ChangeLog.2002, ChangeLog.2001: Add "See ChangeLog.NNNN" line for
- earlier changes. Use utf-8 encoding. Fix some accent typos.
-
- * erc-speedbar.el (erc-speedbar-buttons): Fix reference to free
- variable.
- (erc-speedbar-goto-buffer): Fix compiler warning.
-
- * erc-ibuffer.el: Use `define-ibuffer-filter' instead of
- `ibuffer-define-limiter'. Use `define-ibuffer-column' instead of
- `ibuffer-define-column'. Require 'ibuf-ext so that the macros
- work without compiler warnings.
-
- * man/erc.texi (Obtaining ERC, Installation): Note that these
- sections may be skipped if using the version of ERC that comes
- with Emacs.
-
-2006-01-29 Edward O'Connor <ted@oconnor.cx>
-
- * erc-viper.el: Remove. Now that ERC is included in Emacs, these
- work-arounds live in Viper itself.
-
-2006-01-28 Michael Olson <mwolson@gnu.org>
-
- * erc-*.el, erc.texi, NEWS: Add Arch taglines as per Emacs
- guidelines.
-
- * erc-*.el: Space out copyright years like the rest of Emacs. Use
- the Emacs copyright statement. Refer to ourselves as ERC rather
- than "Emacs IRC Client", since there are now several IRC clients
- for Emacs.
-
- * erc-compat.el (erc-emacs-build-time): Define as a variable.
-
- * erc-log.el (erc-log-setup-logging): Use write-file-functions.
-
- * erc-ibuffer.el: Require 'erc.
-
- * erc-stamp.el (erc-insert-aligned): Only use the special text
- property when window-system is X.
-
- * erc.texi: Adapt for inclusion in Emacs.
-
-2006-01-28 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc.el (erc-format-message): More `cl' breakage; don't use
- `oddp'.
-
-2006-01-27 Michael Olson <mwolson@gnu.org>
-
- * debian/changelog: Update for new release.
-
- * debian/control (Description): Update.
-
- * debian/rules: Concatenate ChangeLog for 2005.
-
- * Makefile (MISC): Include ChangeLog.2005 and erc.texi.
- (debrelease, release): Copy images directory.
-
- * NEWS: Spelling fixes. Add items for recent changes.
-
- * erc.el (erc): Move call to erc-update-modules before the call to
- erc-mode. This should fix a timestamp display issue.
- (erc-version-string): Release ERC 5.1.
-
-2006-01-26 Michael Olson <mwolson@gnu.org>
-
- * erc-stamp.el (erc-insert-aligned): New function that inserts
- text in an perfectly-aligned way relative to the right margin. It
- only works well with Emacs22. A sane fallback is provided for
- other versions of Emacs.
- (erc-insert-timestamp-right): Use the new function.
-
-2006-01-25 Edward O'Connor <ted@oconnor.cx>
-
- * erc.el (erc-modules): Ensure that `erc-button-mode' gets enabled
- before `erc-match-mode'.
-
- * erc-match.el (match): Append `erc-match-message' to
- `erc-insert-modify-hook'.
-
-2006-01-25 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE: Mark last release requirement as done.
-
- * Makefile (realclean, distclean): Remove docs.
-
- * erc.texi: Take care of all pre-5.1 items.
-
- * erc-backend.el (erc-server-send, erc-server-send-queue): Wrap
- `process-send-string' in `condition-case' to avoid an error when
- quitting ERC.
-
- * erc-stamp.el (erc-insert-timestamp-right): Try to deal with
- variable-width characters in the timestamp and on the same line.
- The latter is a kludge, but it seems to work with most of the
- input I've thrown at it so far. It's certainly better than going
- past the end of line consistently when we have variable-width
- characters on the same line. When `erc-timestamp-intangible' is
- non-nil, add intangible properties to the whitespace as well, so
- that hitting <end> does what you'd expect.
-
- * erc.el (erc-flood-protect, erc-toggle-flood-control): Update
- this to only use boolean values for `erc-flood-protect'. Update
- documentation.
- (erc-cmd-QUIT): Set the active buffer to be the server buffer, so
- that any QUIT-related messages go there.
- (erc): Try to be more clever about re-using channel buffers when
- automatically re-connecting. Thanks to e1f for noticing.
-
-2006-01-23 Michael Olson <mwolson@gnu.org>
-
- * ChangeLog.2005: Remove erroneous line.
-
- * FOR-RELEASE: Make that the Makefile tweaking is complete.
- (NEWS): Mark as done.
-
- * Makefile (MANUAL): New option indicating the name of the manual.
- (PREFIX, ELISPDIR, INFODIR): New options that specify the
- directories to install lisp code and info manuals to. PREFIX is
- used only by ELISPDIR and INFODIR.
- (all): Call `lisp' and create the manual.
- (lisp): Compile lisp code.
- (%.info, %.html): New rules that make Info files and HTML files,
- respectively, from a TexInfo source.
- (doc): Create both the Info and HTML versions of the manual. This
- is for the user -- we never call it automatically.
- (install-info): Install Info files.
- (install-bin): Install compiled and source Lisp files.
- (todo): Remove, since it seems pointless.
-
- * NEWS: Update.
-
- * README: Add Installation instructions. Tweak layout.
-
- * erc.texi: Work on some pre-5.1 items.
-
- * erc-stamp.el, erc-track.el: Move some functions and options in
- order to get rid of a few compiler warnings.
-
- * erc.el (erc-modules): Enable readonly by default. This will
- prevent new users from accidentally removing old messages, which
- could be disconcerting. Also enable stamp by default, since
- timestamps are a fairly standard feature among IRC clients.
-
- * erc-button.el: Munge whitespace.
-
- * erc-identd.el (erc-identd-start): Instead of throwing an error,
- just try to use the obsolete function.
-
-2006-01-22 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-decode-string-from-target): Make sure that
- we have a string as an argument. If not, coerce it to the empty
- string. Hopefully, this will work painlessly around an edge case
- related to quitting ERC around the same time a message comes in.
-
-2006-01-22 Johan Bockgård <bojohan@users.sourceforge.net>
-
- * erc-track.el: Use `(eval-when-compile (require 'cl))' (for
- `case'). Doc fixes.
- (erc-find-parsed-property): Simplify.
- (erc-track-get-active-buffer): Fix logic. Simplify.
- (erc-track-switch-buffer): Remove unused variable `dir'. Simplify.
-
- * erc-speak.el: Doc fixes.
- (erc-speak-region): `propertize' --> `erc-propertize'.
-
- * erc-dcc.el (erc-dcc-chat-parse-output): `propertize' -->
- `erc-propertize'.
-
- * erc-button.el (erc-button-add-button): Take erc-fill-prefix into
- account when wrapping URLs.
-
- * erc-bbdb.el (erc-bbdb-elide-display): Doc fix.
-
- * erc-backend.el (define-erc-response-handler): Doc fix.
-
-2006-01-22 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-update-modules): Use `require' instead of `load',
- but prevent it from causing errors, in order to preserve the
- previous behavior.
-
-2006-01-21 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE (Source): Mark cl task as done.
-
- * Makefile (erc-auto.el): Call erc-generate-autoloads rather than
- generate-autoloads.
- (erc-auto.el, %.elc): Don't show command, just its output.
-
- * NEWS: Add items from 2005-01-01 to 2005-08-13.
-
- * debian/copyright (Copyright): Update.
-
- * erc-auto.in (erc-generate-autoloads): Rename from
- generate-autoloads.
-
- * erc.el, erc-autoaway.el, erc-backend.el: Use
- erc-server-process-alive instead of erc-process-alive.
-
- * erc.el, erc-backend.el, erc-ezbounce.el, erc-list.el,
- erc-log.el, erc-match.el, erc-nets.el, erc-netsplit.el,
- erc-nicklist.el, erc-nickserv.el, erc-notify.el, erc-pcomplete.el:
- Use (eval-when-compile (require 'cl)), so that compilation doesn't
- fail.
-
- * erc-fill.el, erc-truncate.el: Whitespace munging.
-
- * erc.el: Update copyright notice. Remove eval-after-load code.
- (erc-with-buffer): Docfix.
- (erc-once-with-server-event, erc-once-with-server-event-global)
- (erc-with-buffer, erc-with-all-buffers-of-server): Use erc-gensym
- instead of gensym.
- (erc-banlist-update): Use erc-delete-if instead of delete-if.
- (erc): Call `erc-update-modules' here.
-
- * erc-backend.el: Require 'erc-compat to minimize compiler
- warnings.
- (erc-decode-parsed-server-response): Docfix.
- (erc-server-process-alive): Move here from erc.el and rename from
- `erc-process-alive'.
- (erc-server-send, erc-remove-channel-users): Make sure process is
- alive before sending data to it.
-
- * erc-bbdb.el: Update copyright years.
- (erc-bbdb-whois): Remove overexuberant comment.
-
- * erc-button.el: Require erc-fill, since we make liberal use of
- `erc-fill-column'.
-
- * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): New
- functions, the latter of which provides an `assert' equivalent.
- (erc-remove-if-not): New function that provides a simple
- implementation of `remove-if-not'.
- (erc-gensym): New function that provides a simple implementation
- of `gensym'.
- (erc-delete-if): New function that provides a simple
- implementation of `delete-if'.
- (erc-member-if): New function that provides a simple
- implementation of `member-if'.
- (field-end): Remove this, since it is unused, and later versions
- of XEmacs have this function already.
- (erc-function-arglist): Moved here from erc.el.
- (erc-delete-dups): New compatibility function for dealing with
- XEmacs.
- (erc-subseq): New function copied from cl-extra.el.
-
- * erc-dcc.el: Require pcomplete during compilation to avoid
- compiler warnings.
- (erc-unpack-int, erc-dcc-send-filter)
- (erc-dcc-get-filter): Use erc-assert instead of assert.
- (pcomplete/erc-mode/DCC): Use erc-remove-if-not instead of
- remove-if-not.
-
- * erc-match.el (erc-log-matches): Fix compiler warning.
-
- * erc-nicklist.el: Update copyright notice.
- (erc-nicklist-menu): Change use of caadr to (car (cadr ...)).
- (erc-nicklist-bitlbee-connected-p): Remove.
- (erc-nicklist-insert-medium-name-or-icon): Accept channel
- argument. Use it to determine whether we are on bitlbee. Now
- that bitlbee names its channel "&bitlbee", this is trivial.
- (erc-nicklist-insert-contents): Pass channel as specified above.
- Don't try to determine whether we are on bitlbee here.
- (erc-nicklist-channel-users-info): Use erc-remove-if-not instead
- of remove-if-not.
- (erc-nicklist-search-for-nick): Use erc-member-if instead of
- member-if.
-
- * erc-notify.el (erc-notify-QUIT): Use erc-delete-if with a
- partially-evaluated lambda expression instead of `delete' and
- `find'.
-
- * erc-track.el: Use erc-assert.
- (erc-track-modified-channels): Remove use of `return'.
- (erc-track-modified-channels): Use `cadr' instead of `second',
- since otherwise we would need yet another eval-when-compile line.
-
-2006-01-19 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-process-sentinel-1): Remove attempt to
- detect SIGPIPE, since it doesn't work.
-
-2006-01-10 Diane Murray <disumu@x3y2z1.net>
-
- * erc-spelling.el: Updated copyright years.
- (define-erc-module): Enable/disable `flyspell-mode' for all open
- ERC buffers as well.
- (erc-spelling-dictionaries): Reworded customize description.
-
- * erc.el (erc-command-symbol): New function.
- (erc-extract-command-from-line): Use `erc-command-symbol'. This
- fixes a bug where "Symbol's function definition is void:
- erc-cmd-LIST" would be shown after typing /list at the prompt (the
- command was interned because erc-menu.el uses it and is enabled by
- default whereas erc-list.el is not).
-
- * NEWS: Started a list of renamed variables.
-
- * erc.el: Reworded the message sent when defining variable
- aliases.
- (erc-command-indicator-face): Doc fix.
- (erc-modules): Enable the match module by default which makes
- current nickname highlighting on as the default.
-
- * erc-button.el: Updated copyright years.
- (erc-button): New face.
- (erc-button-face): Use `erc-button'.
- (erc-button-nickname-face): New customizable variable.
- (erc-button-add-nickname-buttons, erc-button-add-buttons-1): Send
- new argument to `erc-button-add-button'.
- (erc-button-add-button): Doc fix. Added new argument to function
- definition, NICK-P. If it's a nickname, use
- `erc-button-nickname-face', otherwise use `erc-button-face'. This
- makes channel tracking and buttons work better together when
- `erc-button-buttonize-nicks' is enabled, since there is a nickname
- on just about every line.
-
- * erc-track.el (erc-track-use-faces): Doc fix.
- (erc-track-faces-priority-list): Added `erc-button' to list.
- (erc-track-priority-faces-only): Doc fix.
-
-2006-01-09 Diane Murray <disumu@x3y2z1.net>
-
- * erc-button.el (erc-button-url-regexp): Use `concat' so the
- regexp is not one long line.
- (erc-button-alist): Fixed so that customizing works correctly.
- Reorganized. Removed lambda functions with more than two lines.
- Doc fix.
- (erc-button-describe-symbol, erc-button-beats-to-time): New
- functions. Moved from `erc-button-alist'.
-
-2006-01-07 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-process-sentinel-1): Don't try to re-open a
- process if a SIGPIPE occurs. This happens when a new message
- comes in at the same time a /quit is requested.
- (erc-process-sentinel): Use string-match rather than string= to do
- these comparisons. Matching literal newlines makes me nervous.
-
- * erc-track.el (erc-track-remove-from-mode-line): Handle case
- where global-mode-string is not a list. Emacs22 permits this.
-
-
-See ChangeLog.05 for earlier changes.
-
- Copyright (C) 2006-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; add-log-time-zone-rule: t
-;; End:
-
diff --git a/lisp/erc/ChangeLog.07 b/lisp/erc/ChangeLog.07
deleted file mode 100644
index ab080420dd7..00000000000
--- a/lisp/erc/ChangeLog.07
+++ /dev/null
@@ -1,836 +0,0 @@
-2007-12-16 Diane Murray <disumu@x3y2z1.net>
-
- * erc-services.el (erc-nickserv-alist): Removed autodetect regexp,
- added identified regexp for OFTC.
- (erc-nickserv-identification-autodetect): Make sure success-regex
- is non-nil.
- (erc-nickserv-identify-autodetect): Make sure identify-regex is
- non-nil. Doc fix.
-
-2007-12-13 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (PRIVMSG, QUIT, TOPIC, WALLOPS, 376, 004, 221)
- (312, 315, 319, 330, 331, 333, 367, 368, 391, 405, 406, 412)
- (421, 432, 433, 437, 442, 461, 474, 477, 482, 431): Doc fix.
-
-2007-12-09 Michael Olson <mwolson@gnu.org>
-
- * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet.
-
-2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
-
- * erc-backend.el, erc.el:
- Parse 275 (secure connection) responses.
-
- * erc-services.el: Add identification hooks for GRnet, the Greek
- IRC network <http://www.irc.gr>.
-
-2007-12-08 David Kastrup <dak@gnu.org>
-
- * erc-stamp.el (erc-echo-timestamp):
- * erc-lang.el (language):
- * erc-backend.el (erc-server-connect): Fix buggy call to `message'.
-
-2007-12-07 Edward O'Connor <ted@oconnor.cx>
-
- * erc-services.el: Provide a hook that runs when nickserv confirms
- that the user has successfully identified.
- (services, erc-nickserv-identify-mode): Add and remove
- erc-nickserv-identification-autodetect from
- erc-server-NOTICE-functions.
- (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry.
- (erc-nickserv-alist-identified-regexp)
- (erc-nickserv-identification-autodetect): New functions.
- (erc-nickserv-identified-hook): New hook.
-
-2007-12-06 Deepak Goel <deego3@gmail.com>
-
- * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'.
-
-2007-12-01 Glenn Morris <rgm@gnu.org>
-
- * erc-backend.el (erc-server-send-ping): Move after definition of
- erc-server-send.
-
-2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
-
- * erc-backend.el, erc.el:
- Parse 307 (nick has identified) responses.
-
-2007-11-15 Juanma Barranquero <lekktu@gmail.com>
-
- * erc.el (erc-open):
- * erc-backend.el (define-erc-response-handler):
- * erc-log.el (log):
- * erc-match.el (erc-log-matches): Fix typos in docstrings.
-
-2007-11-11 Michael Olson <mwolson@gnu.org>
-
- * erc-autoaway.el (erc-autoaway-possibly-set-away):
- * erc-netsplit.el (erc-netsplit-timer):
- * erc-notify.el (erc-notify-timer):
- * erc-track.el (erc-user-is-active): Only run if we have
- successfully established a connection to the server and have
- logged in. I suspect that sending messages too soon may make some
- IRC servers not respond well, particularly when the network
- connection is iffy or subject to traffic-shaping.
-
-2007-11-01 Michael Olson <mwolson@gnu.org>
-
- * erc-compat.el (erc-set-write-file-functions): New compatibility
- function to set the write hooks appropriately.
-
- * erc-log.el (erc-log-setup-logging): Use
- erc-set-write-file-functions. This fixes a byte-compiler warning.
-
- * erc-stamp.el: Silence byte-compiler warning about
- erc-fill-column.
-
- * erc.el (erc-with-all-buffers-of-server): Bind the result of
- mapcar to a variable in order to silence a byte-compiler warning.
-
-2007-10-29 Michael Olson <mwolson@gnu.org>
-
- * erc-ibuffer.el (erc-modified-channels-alist): Use
- eval-when-compile, and explain why we are doing this.
-
-2007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
-
- * erc-ibuffer.el (erc-modified-channels-alist): Pacify
- byte-compiler.
-
-2007-10-13 Glenn Morris <rgm@gnu.org>
-
- * erc-track.el (erc-modified-channels-update): Use mapc rather
- than mapcar.
-
-2007-10-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-join-channel): Prompt for channel key if C-u or
- another prefix-arg was typed.
-
- * NEWS: Noted this change.
-
-2007-10-07 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-cmd-ME'S): New command that handles the case where
- someone types "/me's". It concatenates the text " 's" to the
- beginning of the input and then sends the result like a normal
- "/me" command.
- (erc-command-regexp): Permit single-quote character.
-
-2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change)
-
- * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings
- when looking at a log file and concurrently saving to it.
-
-2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
-
- * erc.texi (Special-Features): Fix small typo.
-
-2007-09-16 Michael Olson <mwolson@gnu.org>
-
- * erc-track.el (erc-track-switch-direction): Mention
- erc-track-faces-priority-list. Thanks to Leo for the suggestion.
-
-2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
-
- * erc-sound.el: Fix typo in setting up instructions.
-
-2007-09-10 Michael Olson <mwolson@gnu.org>
-
- * Makefile (elpa): Copy dir template rather than echoing a few
- lines. The reason for this is that the ELPA package for ERC was
- getting a corrupt dir entry.
-
- * dir-template: Template for the ELPA dir file.
-
-2007-09-08 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-log-filter-function): New option that specifies
- the function to call for filtering text before writing it to a log
- file. Thanks to David O'Toole for the suggestion.
- (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure
- we carry along the value of coding-system-for-write, because this
- could potentially be shadowed by the temporary buffer.
-
- * erc.el (erc-version-string): Update to 5.3, development version.
-
-2007-09-07 Glenn Morris <rgm@gnu.org>
-
- * erc.el (erc-toggle-debug-irc-protocol): Fix call to
- erc-view-mode-enter.
-
-2007-08-08 Glenn Morris <rgm@gnu.org>
-
- * erc-log.el, erc.el: Replace `iff' in doc-strings and comments.
-
-2007-09-03 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-default-port): Make this an integer value rather
- than a string. Thanks to Luca Capello for the report.
-
-2007-08-27 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil,
- kill all query buffers after 4 seconds.
-
-2007-08-16 Michael Olson <mwolson@gnu.org>
-
- * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track
- compatibility note.
-
- * erc-track.el (erc-track-list-changed-hook): Turn this into a
- customizable option.
- (erc-track-switch-direction): Add 'importance option.
- (erc-modified-channels-display): If erc-track-switch-direction is
- 'importance, call erc-track-sort-by-importance.
- (erc-track-face-priority): New function that returns a number
- indicating the position of a face in erc-track-faces-priority-list.
- (erc-track-sort-by-importance): New function that sorts
- erc-modified-channels-list according to erc-track-face-priority.
- (erc-track-get-active-buffer): Make 'oldest a rough opposite of
- 'importance.
-
-2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu>
-
- * erc-track.el (erc-track-remove-disconnected-buffers): New
- variable which controls whether buffers associated with a server
- that is disconnected should be removed from
- `erc-modified-channels-alist'. Existing behavior is to
- unconditionally remove such buffers, which is achieved by setting
- `erc-track-removed-disconnected-buffers' to t. When set to t,
- which is the new default value, such buffers remain in the list,
- which I think is often the desired behavior, since the user may
- likely wish to find out about activity that occurred in a channel
- prior to it being disconnected.
- (erc-track-list-changed-hook): New hook that is run whenever the
- contents of `erc-modified-channels-alist' changes; it is useful
- for users such as myself that don't use the default mode-line
- notification but instead use a separate mechanism (which is tied
- to my window manager) to provide notification of channel activity.
- (erc-track-get-buffer-window): New function that acts as a wrapper
- around `get-buffer-window' that handles the `selected-visible'
- option of `erc-track-visibility'; previously, the value of
- `erc-track-visibility' was passed directly to `get-buffer-window',
- which does not support `selected-visible'; consequently,
- `selected-visible' was not properly supported.
- (erc-track-modified-channels): Fix a bug in the logic for removing
- buffers from the list in certain cases.
- (erc-track-position-in-mode-line): Add a supported value that
- specifies that the tracking information should not be added to the
- mode line at all. The value of nil is used to indicate that the
- information should not be added at all to the mode line.
- (erc-track-add-to-mode-line): Check for position eq to t, rather
- than non-nil.
- (erc-buffer-visible): Use erc-track-get-buffer-window.
- (erc-modified-channels-update): Take
- erc-track-remove-disconnected-buffers into account.
- (erc-modified-channels-display): Run `erc-track-list-changed-hook'.
-
- * erc.el (erc-reuse-frames): New option that determines whether
- new frames are always created. Defaults to t. This only has an
- effect when erc-join-buffer is set to 'frame.
- (erc-setup-buffer): Use it.
-
-2007-08-14 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-reconnect): If the server buffer has
- been killed, use the current buffer instead. If the current
- buffer is not an ERC buffer, give an error. This fixes a bug when
- /reconnect is run from a channel buffer whose server buffer has
- been deleted. Thanks to jbms for the report.
- (erc-process-sentinel-1): Take server buffer as an argument, so
- that we can make sure that it is current.
- (erc-process-sentinel): Pass buffer to erc-process-sentinel-1.
- (erc-process-sentinel-2): New function split from
- erc-process-sentinel-1. If server buffer is deleted during a
- reconnect attempt, stop trying to reconnect. Fix bug where
- reconnect was not happening when erc-server-reconnect-attempts was
- t. Call erc-server-reconnect-p only once each time. If we are
- instructed to try connecting indefinitely, tell the user that they
- can stop this by killing the server buffer. Call the process
- sentinel by means of run-at-time, so that there is time to kill
- the buffer if need be; this also removes the need for a while
- loop. Refuse to reconnect again if erc-server-reconnect-timeout
- is not an number.
-
- * erc.el (erc-command-no-process-p): Fix bug: the return value of
- erc-extract-command-from-line is a list rather than a single
- symbol. Thanks to jbms for the report.
- (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p
- rather than bufferp.
- (erc-send-current-line, erc-display-command, erc-display-msg):
- Handle case where erc-server-process is nil, so that /reconnect
- works.
-
-2007-08-12 Michael Olson <mwolson@gnu.org>
-
- * erc-identd.el (erc-identd-filter): Instead of sending an EOF
- character, which now confuses freenode, stop the server process,
- so that no new connections are accepted, and kill the current
- client process.
-
-2007-07-29 Michael Olson <mwolson@gnu.org>
-
- * erc-list.el: Relicense to GPLv3. Since the file was already
- licensed under version 2 or later, it turns out that we do not
- need the permission of all of the authors in order to proceed.
-
-2007-07-13 Michael Olson <mwolson@gnu.org>
-
- * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face):
- Use erc-error rather than message and beep.
-
- * erc-sound.el: Indentation fix.
-
- * erc.el (erc-command-no-process-p): New function that determines
- if its argument is an ERC command that can be run when the server
- process is not alive.
- (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP)
- (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT)
- (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands
- can be run even when the server process is not alive.
- (erc-send-current-line): Call erc-command-no-process-p if the
- server process is not alive, to determine if we have a command
- that can be run anyway. Thanks to Tom Tromey for the bug report.
- (erc-error): New function that either displays a message or throws
- an error, depending on whether debug-on-error is non-nil.
- (erc-cmd-SERVER, erc-send-current-line): Use it.
-
-2007-07-10 Michael Olson <mwolson@gnu.org>
-
- * Relicense all FSF-assigned code to GPLv3.
-
-2007-06-25 Michael Olson <mwolson@gnu.org>
-
- * erc.texi (Options): Fix typo.
- (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane
- part more readable.
-
-2007-06-20 Michael Olson <mwolson@gnu.org>
-
- * erc-stamp.el (erc-timestamp-format-left): New option that
- specifies the left timestamp to use for
- erc-insert-timestamp-left-and-right.
- (erc-timestamp-format-right): New option that specifies the right
- timestamp to use for erc-insert-timestamp-left-and-right.
- (erc-insert-timestamp-function): Change default to
- erc-insert-timestamp-left-and-right.
- (erc-insert-away-timestamp-function): Ditto.
- (erc-timestamp-last-inserted-left)
- (erc-timestamp-last-inserted-right): New variables to keep track
- of data for erc-insert-timestamp-left-and-right.
- (erc-insert-timestamp-left-and-right): New function that places
- timestamps on both the left and right sides of the screen, but
- only if each timestamp has changed since it was last computed.
- Thanks to offby1 for urging me to merge this.
-
- * erc.el (erc-open-ssl-stream): Display informative error when
- ssl.el not found.
- (erc-tls): New function to connect using tls.el.
- (erc-open-tls-stream): New function to initiate tls connection.
- Display informative error when tls.el not found.
-
-2007-06-19 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el: Update header with accurate instructions.
-
-2007-06-17 Michael Olson <mwolson@gnu.org>
-
- * erc-pkg.el: Update description to match what is currently in ELPA.
-
-2007-06-14 Juanma Barranquero <lekktu@gmail.com>
-
- * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check.
-
-2007-06-13 Michael Olson <mwolson@gnu.org>
-
- * erc-compat.el (erc-with-selected-window): New compatibility
- macro that implements `with-selected-window'.
-
- * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug
- with buffer ordering where ERC buffers would move to the top.
- Thanks to Ivan Kanis for the patch.
-
-2007-06-10 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-logging-enabled): Fix a bug that occurred when
- `erc-log-channels-directory' had the name of a function.
-
-2007-06-06 Juanma Barranquero <lekktu@gmail.com>
-
- * erc.el (erc-show-channel-key-p, erc-startup-file-list):
- Fix typo in docstring.
-
-2007-06-03 Michael Olson <mwolson@gnu.org>
-
- * erc-compat.el (erc-view-mode-enter): Make this its own function,
- in order to document what we do, and provide sane fallback
- behavior.
-
- * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments
- to erc-view-mode-enter, since we don't do anything special with
- the exit function. This fixes a bug with Emacs 21 and Emacs 22.
- Thanks to Leo for noticing.
-
-2007-05-30 Michael Olson <mwolson@gnu.org>
-
- * erc-compat.el (erc-user-emacs-directory): New variable that
- determines where to find user-specific Emacs settings. For Emacs,
- this is usually ~/.emacs.d, and for XEmacs this is usually
- ~/.xemacs.
-
- * erc.el (erc-startup-file-list): Use erc-user-emacs-directory.
-
-2007-05-28 Michael Olson <mwolson@gnu.org>
-
- * erc-button.el (erc-button-url-regexp): Recognize parentheses as
- part of URLs. Thanks to Lawrence Mitchell for the fix.
-
-2007-05-26 Michael Olson <mwolson@gnu.org>
-
- * erc.texi (Modules): Fix references to completion modules.
-
-2007-05-21 Michael Olson <mwolson@gnu.org>
-
- * Makefile (SOURCE): Remove erc-pkg.el.
- (debclean): New rule to clean old Debian packages of ERC.
- (debprepare): Don't modify the released tarball, but copy it as
- the .orig.tar.gz file.
- (debrelease, debrevision): Remove.
- (debinstall): New target that copies the generated Debian file to
- a distro-specific location.
- (deb): New rule that chains together the stages in building a
- Debian package.
- (EXTRAS): Add erc-nicklist.el, since it is not release-quality.
- (extras): Copy images directory.
-
- * erc-nicklist.el (erc-nicklist-icons-directory): Use
- locate-library to find the "images" directory. This should be
- more failsafe. Thanks to Tom Tromey for the idea.
-
-2007-05-19 Michael Olson <mwolson@gnu.org>
-
- * Makefile (ELPA): New variable that contains the location of my
- local ELPA repository.
- (elpa): New rule that makes an ELPA package for ERC.
-
-2007-04-19 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-parse-prefix): New function that retrieves the
- PREFIX server parameter from the current server and returns an
- alist of prefix type to prefix character.
- (erc-channel-receive-names): Use `erc-parse-prefix' to determine
- whether the first character of a nick is a prefix character or
- not. This should fix a bug reported by bromine about needing to
- type "%" first to complete nicks of people who are "hops" on
- Slashnet. This should also support for very exotic IRC server
- setups, if any exist.
- (erc-update-current-channel-member): Indentation.
-
-2007-04-15 Michael Olson <mwolson@gnu.org>
-
- * erc-log.el (erc-generate-log-file-name-function): Docfix.
- Mention how to deal with the case for putting log files in
- different directories. Change a customization type from `symbol'
- to `function'.
- (erc-log-channels-directory): Allow this to contain a function
- name, which is called with the same args as in
- `erc-generate-log-file-name-function'. Thanks to andrewy for the
- report and use case.
- (erc-current-logfile): Detect if `erc-log-channels-directory' is a
- function and call it with arguments if so.
-
-2007-04-12 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (define-erc-response-handler): Mention that hook
- processing stops when the function returns non-nil. This should
- help avoid a nasty "gotcha" when making custom functions. Thanks
- to John Sullivan for the report.
-
-2007-04-08 Diane Murray <disumu@x3y2z1.net>
-
- * erc-nicklist.el (erc-nicklist-voiced-position): Fixed
- customization mismatch.
-
-2007-04-01 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Release ERC 5.2.
-
- * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el:
- * erc-viper.el: Update copyright notices.
-
- * erc.texi: Make Emacs Lisp source code in this document
- essentially public domain. Update version to 5.2.
- (Obtaining ERC): Mention extras tarball.
- (Releases): Mention local GNU mirror.
- (Sample Configuration): Remove notice.
-
- * FOR-RELEASE (5.3): Add item for erc-nicklist.
- Mark NEWS as done. Mark extras tarball as done.
-
- * Makefile (VERSION): Increment to 5.2.
- (TESTING): Remove.
- (EXTRAS): New variable containing the contents of our "Emacs 22
- extras" tarball.
- (SOURCE): Remove $(TESTING).
- (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN ->
- ChangeLog.NN.
- (release): Use $(SNAPDIR) instead of erc-$(VERSION).
- (extras): New rule which implements the building of the extras
- tarball.
- (upload-extras): New rule to upload the extras tarball. It's
- yucky to replicate upload, but oh well.
- (DISTRIBUTOR): New variable used to differentiate between building
- packages for Ubuntu and Debian.
- (debrelease, debrevision): Use it.
- (debbuild): Run linda in addition to lintian.
-
- * NEWS: Mention extras tarball. Note which files have been
- renamed. Note that erc-list is enabled by default, except in
- Emacs 22.
-
- * README.extras: New file which serves as a README for the extras
- tarball.
-
-2007-03-31 Michael Olson <mwolson@gnu.org>
-
- * NEWS: Update for the 5.2 release.
-
- * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item
- for 5.3.
-
- * erc.texi (Sample Session): Flesh out. Mention #erc.
- (Modules): Defer to 5.3 release.
- (Advanced Usage): Move Sample Configuration chapter ahead of
- unfinished chapters.
- (Sample Configuration): Write.
- (Options): Mention how to see available ERC options. Defer to 5.3
- release.
- (Tips and Tricks): Remove, since it seems better to just include
- tips and tricks in the sample configuration, commented out.
-
- * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more
- informative about how to skip merging.
- (erc-bbdb-insinuate-and-show-entry-1): Move contents of
- erc-bbdb-insinuate-and-show-entry here.
- (erc-bbdb-insinuate-and-show-entry): Run
- erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling
- function, so that we can avoid triggering a process-filter error
- if the user hits C-g.
-
-2007-03-30 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma.
-
- * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than
- `cond' and `set' rather than `set-default'.
-
- * erc-log.el: Avoid compiler warning by requiring erc-network
- during compilation.
- (erc-generate-log-file-name-function): Add tag to each option.
- Add erc-generate-log-file-name-network.
- (erc-generate-log-file-name-network): New function which generates
- a log file name that uses network name rather than server name,
- when possible.
-
- * erc-track.el (track): Assimilate track-when-inactive module,
- since there's no need to have two modules in one file -- an option
- will do. Remove track-modified-channels alias. Call
- erc-track-minor-mode-maybe, and tear down the minor mode when
- disabling.
- (erc-track-when-inactive): New option which determines whether to
- track visible buffers when inactive. The default is not to do so.
- (erc-track-visibility): Mention erc-track-when-inactive.
- (erc-buffer-visible): Use erc-track-when-inactive.
- (erc-track-enable-keybindings): New option which determines
- whether to enable the global-level tracking keybindings. The
- default is to do so, unless they would override another binding,
- in which case we prompt the user about it.
- (erc-track-minor-mode-map): Move global keybindings here.
- (erc-track-minor-mode): New minor mode which only enables the
- keybindings and does nothing else.
- (erc-track-minor-mode-maybe): New function which starts
- erc-track-minor-mode, but only if it hasn't already been started,
- an ERC buffer exists, and the user OK's it, depending on the value
- of `erc-track-enable-keybindings'.
- (erc-track-switch-buffer): Display a message if someone calls this
- without first enabling erc-track-mode.
-
-2007-03-17 Michael Olson <mwolson@gnu.org>
-
- * erc.texi (Development): Mention ErcDevelopment page on
- emacswiki.
- (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize
- interface.
- (Sample Session): New section that has a very rough draft for a
- sample ERC session.
- (Special Features): New section that explains some of the special
- features of ERC. Taken from ErcFeatures on emacswiki, with
- enhancements.
-
-2007-03-12 Diane Murray <disumu@x3y2z1.net>
-
- * erc-autoaway.el (erc-autoaway-idle-method): When setting the new
- value, disable and re-enable `erc-autoaway-mode' only if it was
- already enabled. This fixes a bug where autoaway was enabled just
- by loading the file.
-
-2007-03-10 Diane Murray <disumu@x3y2z1.net>
-
- * erc-capab.el: Added more information to the Usage section.
- (erc-capab-identify-prefix): Doc fix.
- (erc-capab-identify-unidentified): New face.
- (290): Removed. Definition moved to erc-backend.el.
- (erc-capab-identify-send-messages): Renamed from
- `erc-capab-send-identify-messages'.
- (erc-capab-identify-setup): Use it.
- (erc-capab-identify-get-unidentified-nickname): Renamed from
- `erc-capab-get-unidentified-nickname'.
- (erc-capab-identify-add-prefix): Use it. Use
- `erc-capab-identify-unidentified' as the face.
-
- * erc-backend.el (290): Moved here from erc-capab.el.
-
- * erc.el (erc-select): Added an autoload cookie.
- (erc-message-type-member, erc-restore-text-properties): Use
- `erc-get-parsed-vector'.
- (erc-auto-query): Set the default to 'bury since many new users
- expect private messages from others to be in dedicated query
- buffers, not the server buffer.
- (erc-common-server-suffixes): Use "freenode" for freenode.net, not
- "OPN". Added oftc.net.
-
- * NEWS: Added note about erc-auto-query's new default setting.
-
-2007-03-03 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-open, erc): Docfixes.
-
-2007-03-02 Michael Olson <mwolson@gnu.org>
-
- * FOR-RELEASE: Make section for 5.3 release and move erc-backend
- cleanup there. Awaiting discussion before doing other things.
- Add tasks for merging filename changes from the 5.2 release
- branch, and for making a tarball of modules not in Emacs 22. Add
- item to remind me to update NEWS. Mark backtab entry as done.
-
- * erc-button.el (button): Add call to `erc-button-add-keys'.
- (erc-button-keys-added): New variable tracking whether we've added
- the keys yet.
- (erc-button-add-keys): New function that adds the <backtab> key to
- erc-mode-map.
-
- * erc.texi: Change version to 5.2 (pre-release).
-
-2007-02-15 Michael Olson <mwolson@gnu.org>
-
- * CREDITS: Update.
-
- * erc-backend.el (erc-server-send-ping-interval): Change to use a
- default of 30 seconds. Improve customize interface.
- (erc-server-send-ping-timeout): New option that determines when to
- consider a connection stalled and restart it. The default is
- after 120 seconds.
- (erc-server-send-ping): Use erc-server-send-ping-timeout instead
- of erc-server-send-ping-interval. If
- erc-server-send-ping-timeout is nil, do not ever kill and restart
- a hung IRC process.
-
- * erc.el (erc-modules): Include the name of the module in its
- description. This should make it easier for people to find and
- enable a particular module.
-
-2007-02-15 Vivek Dasmohapatra <vivek@etla.org>
-
- * erc.el (erc-cmd-RECONNECT): Kill old process if it is still
- alive.
- (erc-message-english-PART): Properly escape "%" characters in
- reason.
-
- * erc-backend.el (erc-server-reconnecting): New variable that is
- set when the user requests a reconnect, but the old process is
- still alive. This forces the reconnect to work even though the
- process is killed manually during reconnect.
- (erc-server-connect): Initialize it.
- (erc-server-reconnect-p): Use it.
- (erc-process-sentinel-1): Set it to nil after the first reconnect
- attempt.
-
-2007-02-07 Diane Murray <disumu@x3y2z1.net>
-
- * erc-menu.el (erc-menu-definition): Fixed so that the separator
- is between "Current channel" and "Pals, fools and other keywords",
- not at the bottom of the "Current channel" submenu.
-
-2007-01-25 Diane Murray <disumu@x3y2z1.net>
-
- * erc-networks.el (erc-server-alist): Removed SSL server for now
- since `erc-server-select' doesn't know to use `erc-ssl'.
-
- * erc-networks.el (erc-server-alist, erc-networks-alist): Added
- definitions for oftc.net.
-
- * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp.
-
-2007-01-22 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-error-occurred): New variable that
- indicates when an error has been signaled by the server. This
- should fix an infinite reconnect bug when giving some servers a
- bogus :full-name. Thanks to Angelina Carlton for the report.
- (erc-server-connect): Initialize erc-server-error-occurred.
- (erc-server-reconnect-p): Use it.
- (ERROR): Set it.
-
- * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars
- and QuakeNet. Standardize look of entries. Fix type mismatch
- error in customize interface.
- (erc-nickserv-passwords): Alphabetize and add missing entries from
- erc-nickserv-alist.
-
-2007-01-21 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-header-line-format): Document how to disable the
- header line, and add a customization type for it. Also, make the
- changes take effect immediately.
-
-2007-01-19 Michael Olson <mwolson@gnu.org>
-
- * erc.texi (Modules): Document new menu module. Thanks to Leo
- for noticing.
-
-2007-01-16 Diane Murray <disumu@x3y2z1.net>
-
- * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the
- whitespace string filler is hidden correctly when timestamps are
- hidden.
- (erc-toggle-timestamps): New function to use instead of
- `erc-show-timestamps' and `erc-hide-timestamps'.
-
- * erc.el (erc-restore-text-properties): Moved here from
- erc-fill.el since it could be useful in general.
-
- * erc-fill.el (erc-restore-text-properties): Removed.
-
-2007-01-13 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-command-regexp): New variable that is used to match
- a command.
- (erc-send-input): Use it. This fixes a bug where paths --
- "/usr/bin/foo", for example -- were being displayed as commands,
- but still sent correctly.
- (erc-extract-command-from-line): Use it.
-
- * erc.texi (Modules): Document erc-capab-identify.
-
-2007-01-11 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-find-parsed-property): Moved here from erc-track.el
- since it can be useful in general.
-
- * erc-track.el (erc-find-parsed-property): Removed.
-
- * erc-capab.el (erc-capab-find-parsed): Removed.
- (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'.
-
- * erc.el (erc-open): Run `erc-before-connect' hook here. This
- makes sure the hook always gets called before a connection is
- made, as some functions, like `erc-handle-irc-url', use `erc-open'
- instead of `erc'.
- (erc): Removed `erc-before-connect' hook.
-
- * erc-menu.el (erc-menu-definition): Put items specific to
- channels in a "Current channel" submenu.
-
- * erc-backend.el (321, 323): Display channel list in server buffer
- when not using the channel list module.
-
- * erc.el: Updated copyright years.
- (erc-version-string): Set to 5.2 (devel).
- (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil.
- (erc-update-mode-line-buffer): Set the header face.
-
-2007-01-11 Michael Olson <mwolson@gnu.org>
-
- * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and
- documentation.
-
- * erc-services.el (erc-nickserv-identify-mode): Improve
- documentation for nick-change option and move higher to fix
- compiler warning. Avoid a recursive load error.
- (erc-nickserv-alist): Add simple entry for BitlBee, to avoid
- "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee
- was smart enough to recognize that as an authentication request
- and log in regardless, which is why I didn't notice this earlier.
- (erc-nickserv-alist-sender, erc-nickserv-alist-regexp)
- (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword)
- (erc-nickserv-alist-use-nick-p)
- (erc-nickserv-alist-ident-command): New accessors for
- erc-nickserv-alist. Using nth is unwieldy.
- (erc-nickserv-identify-autodetect)
- (erc-nickserv-identify-on-connect)
- (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use
- the new accessors.
-
-2007-01-11 Diane Murray <disumu@x3y2z1.net>
-
- * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify
- wording.
-
-2007-01-10 Diane Murray <disumu@x3y2z1.net>
-
- * erc.el (erc-mode-line-format): Added %l to documentation.
- (erc-header-line-format): Removed "[IRC]". Use the new %l
- replacement character. Doc fix.
- (erc-format-channel-modes): Removed lag code. Removed parentheses
- from mode string.
- (erc-format-lag-time): New function.
- (erc-update-mode-line-buffer): Use it.
-
-2007-01-10 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Fix typo in url-irc-function instructions.
-
-2007-01-09 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-system-name): New option that determines the system
- name to use when logging in. The default is to figure this out by
- calling `system-name'.
- (erc-login): Use it.
-
-2007-01-07 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-modules): Add the menu module. This should fix a
- bug with incorrect ERC submenus being displayed.
-
- * erc-menu.el: Turn this into a module.
- (erc-menu-add, erc-menu-remove): New functions that add and remove
- the ERC menu.
-
-
-See ChangeLog.06 for earlier changes.
-
- Copyright (C) 2007-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; add-log-time-zone-rule: t
-;; End:
-
diff --git a/lisp/erc/ChangeLog.08 b/lisp/erc/ChangeLog.08
deleted file mode 100644
index 3c847acd60a..00000000000
--- a/lisp/erc/ChangeLog.08
+++ /dev/null
@@ -1,429 +0,0 @@
-2008-11-19 Andy Stewart <lazycat.manatee@gmail.com>
-
- * erc.el (erc-header-line-uses-tabbar-p): New option that makes
- tabbar mode usable with ERC if set to non-nil.
- (erc-update-mode-line-buffer): Use it.
-
-2008-11-19 Glenn Morris <rgm@gnu.org>
-
- * erc-compat.el (help-function-arglist): Autoload it.
-
-2008-10-03 Michael Olson <mwolson@gnu.org>
-
- * erc-dcc.el (english): Increase size heading by two places.
- (erc-dcc-byte-count): Move higher.
- (erc-dcc-do-LIST-command): Use erc-dcc-byte-count to get accurate
- count. Coerce byte total to floating point before performing
- computation, otherwise division will truncate to 0.
- (erc-dcc-append-contents): Update erc-dcc-byte-count.
- (erc-dcc-get-filter): Don't update erc-dcc-byte-count, because
- that will give incorrect size totals. Instead, figure out how
- much we have by summing byte count and current buffer size.
- (erc-dcc-get-sentinel): Don't update erc-dcc-byte-count.
-
-2008-10-01 Michael Olson <mwolson@gnu.org>
-
- * erc-dcc.el (erc-pack-int): Make sure returned string is within 4
- bytes. Always return a 4-byte string, so that we conform to the
- CTCP spec.
- (erc-most-positive-int-bytes): New constant representing the
- number of bytes that most-positive-fixnum can be stored in.
- (erc-most-positive-int-msb): New constant representing the
- contents of the most significant byte of most-positive-fixnum.
- (erc-unpack-int): Make sure that the integer we get back can be
- represented in Emacs.
- (erc-dcc-do-CLOSE-command): Update docstring. Don't use the line
- variable. Try to disambiguate between type and nick when only one
- is provided. Validate both type and nick arguments. Allow
- matching by just nick.
- (erc-dcc-append-contents): Set inhibit-read-only to t. Prevent
- auto-compression from triggering when we write the contents to a
- file.
- (erc-dcc-get-file): Prevent auto-compression from triggering when
- we truncate a file.
-
-2008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
-
- * erc.el: Remove code for Carbon.
-
-2008-06-07 Glenn Morris <rgm@gnu.org>
-
- * erc/erc-autoaway.el, erc/erc-ibuffer.el, erc/erc-menu.el:
- * erc/erc-stamp.el, erc/erc.el: Remove unnecessary eval-when-compiles.
-
-2008-05-30 Diane Murray <disumu@x3y2z1.net>
-
- * erc-backend.el (328): New response handler.
-
- * erc.el (english): Add 328 to catalog.
-
-2008-05-29 Diane Murray <disumu@x3y2z1.net>
-
- * erc-services.el (erc-nickserv-alist): Update REGEXP and
- SUCCESS-REGEXP for freenode.
-
-2008-05-05 Juanma Barranquero <lekktu@gmail.com>
-
- * erc-goodies.el (erc-noncommands-list, noncommands)
- (erc-control-characters, erc-interpret-controls-p)
- (erc-interpret-mirc-color): Fix typos in docstrings.
- (erc-controls-highlight): Reflow docstring.
-
-2008-04-26 Johan Bockgård <bojohan@gnu.org>
-
- * erc.el (erc-put-text-properties): Don't use mapcar*.
- (erc-display-line-1): Fix argument order in call to
- erc-put-text-properties.
-
-2008-04-14 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-remove-text-properties-region): Disable this command
- by default. Thanks to e1f for the suggestion.
-
-2008-02-20 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-notice-face): Fix this face for Emacs 21 users.
-
-2008-02-05 Juanma Barranquero <lekktu@gmail.com>
-
- * erc.el (erc-valid-nick-regexp):
- * erc-button.el (erc-button-syntax-table):
- * erc-match.el (erc-match-syntax-table): Replace `legal' with `valid'.
-
-2008-02-04 Jeremy Maitin-Shepard <jbms@cmu.edu>
-
- * erc.el (erc-cmd-QUERY): Bind the value of `erc-auto-query' to
- `erc-query-display' rather than `erc-join-buffer'. This fixes a
- bug where the value of erc-auto-query was being ignored.
-
-2008-01-31 Michael Olson <mwolson@gnu.org>
-
- * erc-dcc.el (erc-dcc-do-GET-command, erc-dcc-do-SEND-command):
- Improve docstring. If FILE argument is split into multiple
- arguments, re-join them into a single string, separated by a
- space. This fixes an issue where the user wants to send or
- receive a file with spaces in its name. It is assumed that no one
- will try sending or receiving a file with multiple consecutive
- spaces in its name, otherwise this fix will fail.
-
- * erc.el (erc-mode-map): Add binding for C-c C-x to
- erc-quit-server, since rcirc.el binds its quit command in a
- similar manner. Thanks to Jari Aalto for the suggestion.
-
-2008-01-28 Diane Murray <disumu@x3y2z1.net>
-
- * erc-list-old.el (list-old): Define module as list-old, not list.
- This fixes a bug where an unknown module error would occur when
- starting ERC and using the list-old module.
-
- * erc-track.el (erc-track-find-face): If no choice was found
- return nil to use the default mode-line faces.
-
-2008-01-26 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-version-string): Release ERC 5.3.
-
- * Makefile (VERSION): Update.
- (EXTRAS): Remove erc-list.el after all, because this is mainly for
- users of the version that comes with Emacs, and they will have
- erc-list.el by Emacs 23.
- (MISC): Add ChangeLog.07.
- (elpa): Fix build issue. Add proper version to erc-pkg.el.
-
- * README.extras: Mention Emacs 23.
-
- * erc-pkg.el: Make the version string a template.
-
- * erc.texi (Obtaining ERC): Update extras URLs for 5.3.
- (Development): Write instructions for git, and remove those for Arch.
- (History): Mention the switch to git.
-
-2008-01-25 Michael Olson <mwolson@gnu.org>
-
- * NEWS: Update.
-
- * erc-goodies.el (keep-place): New module which keeps your place
- in unvisited ERC buffers when new messages arrive. This is mostly
- taken from Johan Bockgård's init file.
- (erc-noncommands-list): Move to correct place.
-
- * erc-networks.el: Add a module definition.
-
- * erc-services.el (erc-nickserv-identify-mode): Force-enable the
- networks module, because we need it to set erc-network for us.
-
- * erc-track.el (erc-track-faces-normal-list): Indicate in the
- docstring that this variable can be set to nil.
-
- * erc.el: On second thought, don't load erc-networks. Just enable
- the networks module by default.
- (erc-modules): Add option for keep-place and networks. Enable
- networks by default.
- (erc-version-string): Make release candidate 1 available.
-
-2008-01-24 Michael Olson <mwolson@gnu.org>
-
- * erc.el: Load erc-networks.el so that functions get access to the
- `erc-network-name' function.
-
- * erc-track.el (erc-track-faces-normal-list): Add
- erc-dangerous-host-face.
- (erc-track-exclude-types): Add 333 and 353 to the default list of
- things to ignore, and explain what they are in the docstring.
-
-2008-01-23 Michael Olson <mwolson@gnu.org>
-
- * erc-track.el (erc-track-faces-priority-list): Move
- erc-nick-default-face higher, so that it can be used for the
- activity indication effect. Add erc-current-nick-face,
- erc-pal-face, erc-dangerous-host-face, and erc-fool-face by
- themselves.
- (erc-track-faces-normal-list): New option that contains a list of
- faces to consider "normal".
- (erc-track-position-in-mode-line): Minor docfix.
- (erc-track-find-face): Use erc-track-faces-normal-list to produce
- a sort of blinking activity effect.
-
-2008-01-22 Michael Olson <mwolson@gnu.org>
-
- * erc-button.el (erc-button-add-nickname-buttons): When in a
- channel buffer, only look at nicks from the current channel.
- Thanks to e1f for the report.
-
-2008-01-21 Michael Olson <mwolson@gnu.org>
-
- * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): Remove,
- since we can use the default `assert' function without it causing
- us any problems, even in Emacs 21. Thanks to bojohan for the
- suggestion.
-
- * erc-goodies.el (move-to-prompt): Use the "XEmacs" method
- instead, because the [remap ...] method interferes with
- delete-selection-mode.
- (erc-move-to-prompt): Rename from erc-move-to-prompt-xemacs.
- Deactivate mark and call push-mark before moving point. Thanks to
- bojohan for the suggestion.
- (erc-move-to-prompt-setup): Rename from
- erc-move-to-prompt-init-xemacs.
-
- * erc-track.el (erc-track-faces-priority-list): Replace erc-button
- with '(erc-button erc-default-face) so that we only care about
- buttons that are part of normal text. Adjust customization type
- to handle this case. Make erc-nick-default-face a list. Handle
- pals, fools, current nick, and dangerous hosts.
- (erc-track-find-face): Simplify. Adapt for list of faces case.
- (erc-faces-in): Don't deflate lists of faces. Add them as-is.
- (erc-track-face-priority): Use equal instead of eq.
-
-2008-01-20 Michael Olson <mwolson@gnu.org>
-
- * erc-goodies.el (erc-move-to-prompt, erc-move-to-prompt-xemacs):
- Fix off-by-one error that caused the point to move when placed at
- the beginning of some already-typed text. Thanks to e1f for the
- report.
-
- * erc-dcc.el, erc-xdcc.el: Add simple module definitions.
-
- * erc.el (erc-modules): Add dcc and xdcc.
-
-2008-01-19 Michael Olson <mwolson@gnu.org>
-
- * erc-bbdb.el (erc-bbdb-insinuate-and-show-entry): Work around bug
- in XEmacs 21.4 that throws an error when the first argument to
- run-at-time is nil.
-
- * erc-button.el (button): Undo XEmacs-specific change to all ERC
- buffers when module is removed.
- (erc-button-setup): Rename from erc-button-add-keys, and move
- XEmacs-specific stuff here.
-
- * erc-goodies.el (erc-unmorse): Improve regexp for detecting
- morse. Deal with the morse style that has "/ " at the end of
- every letter.
- (erc-imenu-setup): New function that sets up Imenu support. Add
- it instead of a lambda form to erc-mode-hook.
- (scrolltobottom): Remove erc-scroll-to-bottom from all ERC buffers
- when module is removed. Activate the functionality in all ERC
- buffers when the module is activated, rather than leaving it up to
- the user.
- (move-to-prompt): New module that moves to the ERC prompt if a
- user tries to type elsewhere in the buffer, and then inserts their
- keystrokes there. This is mostly taken from Johan Bockgård's init
- file.
- (erc-move-to-prompt): New function that implements this.
- (erc-move-to-prompt-xemacs): New function that implements this for
- XEmacs.
- (erc-move-to-prompt-init-xemacs): New function to perform the
- extra initialization step needed for XEmacs.
-
- * erc-page.el, erc-replace.el: Fix header and footer.
-
- * erc-track.el (erc-track-minor-mode-maybe): Take an optional
- buffer arg so that we can put this in erc-connect-pre-hook. If
- given this argument, include it in the check to determine whether
- to activate erc-track-minor-mode.
- (track): Add erc-track-minor-mode-maybe to erc-connect-pre-hook,
- so that we can use it as soon as a connection is attempted.
-
- * erc.el (erc-format-network, erc-format-target-and/or-network):
- Use erc-network-name function instead, and check to see whether
- that function is bound. This fixes an error in process filter for
- people who did not have erc-services or erc-networks loaded.
- (erc-modules): Add move-to-prompt module and enable it by
- default. Thanks to e1f for the suggestion.
-
-2008-01-18 Michael Olson <mwolson@gnu.org>
-
- * Makefile (EXTRAS): Include erc-list-old.el.
-
- * erc-dcc.el (erc-dcc-verbose): Rename from erc-verbose-dcc.
- (erc-pack-int): Rewrite to not depend on a count argument.
- (erc-unpack-int): Rewrite to remove 4-character limitation.
- (erc-dcc-server): Call set-process-coding-system and
- set-process-filter-multibyte so that the contents get sent out
- without modification.
- (erc-dcc-send-filter): Don't take a substring -- just pass the
- whole string to erc-unpack-int.
- (erc-dcc-receive-cache): New option that indicates the number of
- bytes to let the receive buffer grow before flushing it.
- (erc-dcc-file-name): New buffer-local variable to keep track of
- the filename of the currently-received file.
- (erc-dcc-get-file): Disable undo for a speed increase. Set
- erc-dcc-file-name. Truncate the file before writing to it.
- (erc-dcc-append-contents): New function to append the contents of
- a buffer to a file and then erase the contents of the buffer.
- (erc-dcc-get-filter): Flush buffer contents after exceeding
- erc-dcc-receive-cache. This allows large files to be downloaded
- without storing the whole thing in memory.
- (erc-dcc-get-sentinel): Flush any remaining contents before
- closing. No need to save buffer.
- (erc-dcc-listen-host): New option that determines which IP address
- to listen on.
- (erc-dcc-public-host): New option that determines which IP address
- to advertise when sending a file. This is useful for people who
- are on a local subnet. Together, these two options replace
- erc-dcc-host.
-
- * erc.el (erc-mode-line-format): Add %N and %S. %N is the name of
- the network, and %S is much like %s but with the network name
- trumping the server name. Default to "%S %a". Thanks to e1f for
- the suggestion.
- (erc-format-network): New function that formats the network name.
- (erc-format-target-and/or-network): New function that formats both
- the network name and target, falling back on the server name if
- the network name is not available.
- (erc-update-mode-line-buffer): Add the new format spec items.
-
-2008-01-17 Michael Olson <mwolson@gnu.org>
-
- * erc.el (erc-join-buffer): Improve documentation.
- (erc-query-display): New option indicating how to display a query
- buffer that is made by using the /QUERY command. The default is
- to display the query in a new window.
- (erc-cmd-QUERY): Use it. Improve docstring.
- (erc-auto-query): Default this to 'window-noselect instead,
- because I've already seen bug reports about new users thinking
- that ERC didn't display their test messages. Improve
- customization type.
- (erc-notice-face): Make this work with XEmacs.
- (erc-join-buffer): Mention 'buffer in docstring. Improve
- customization type.
-
- * erc-dcc.el (erc-dcc-send-sentinel): Better handle case where elt
- is nil, in order to avoid an error. Thanks to Brent Goodrick for
- the initial patch.
- (erc-dcc-display-send): New function split from erc-dcc-send-hook.
- (erc-dcc-send-connect-hook): Use it -- we don't like lambda forms
- in hooks.
- (erc-dcc-send-filter): Display byte count if the client confirmed
- too much, and kill the buffer. Otherwise a DoS might be possible
- by making Emacs run out of RAM.
-
- * erc-backend.el (erc-server-connect): Detect early on whether the
- connection attempt has failed in order to avoid confusing error
- messages.
-
- * erc-networks.el (erc-server-alist): Add Rizon network.
-
- * erc-services.el (erc-nickserv-passwords): Add Rizon to options.
- (erc-nickserv-alist): Add support for Rizon.
-
- * erc-track.el (erc-track-find-face): Don't let buttons in notices
- trump default text. Use catch/throw. Default to first element of
- FACES is nothing is found.
-
- * erc-xdcc.el: Add local variables for proper indentation setup.
-
-2008-01-15 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (erc-server-coding-system): Docfix.
- (erc-coding-system-for-target): Pass the `target' argument along
- as the first and only argument. It's not good to just depend on a
- dynamic binding.
-
-2008-01-10 Michael Olson <mwolson@gnu.org>
-
- * erc-backend.el (321, 322): Split message-displaying parts into
- new functions, which are added to each response's respective
- hook. This makes them easier to disable.
-
- * erc-list.el: New file from Tom Tromey. Use erc-propertize
- instead of propertize. Require 'erc.
- (list): New module definition. Remove message-displaying
- functions for 321 and 322 response handlers when enabling the
- module, and restore them when disabling. As a sanity check,
- remove the erc-list-handle-322 function when disabling the module.
- (erc-list-handle-322): Handle the case where we run the LIST
- command, but do not go through the normal steps.
- (erc-cmd-LIST): Add docstring. Strip initial space from line if
- it is non-nil. Use make-local-variable to silence compiler
- warning. Capture current buffer and pass it to
- erc-list-install-322-handler.
- (erc-list-install-322-handler): Take server-buffer argument, so
- that we are certain of being in the right buffer. Use 4th
- argument to add-hook, so that erc-server-322-functions is only
- modified in one buffer.
-
- * erc-list-old.el: Renamed from old erc-list.el.
-
- * erc.el (erc-modules): Add list-old.
- (erc-set-topic): Handle case where there are no newlines in the
- existing topic, which happens when /LIST is run.
- (erc-notice-face): If we have less than 88 colors, make this
- blue. Otherwise the text will be pink in a tty, which looks
- dreadful. Thanks to e1f for the report.
- (erc-remove-parsed-property): New option that determines whether
- to remove the erc-parsed property after displaying a message.
- This should have the effect of making ERC take up less memory.
- (erc-display-line-1): Use it.
-
-2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * erc-ibuffer.el (erc-channel-modes):
- Pass mode-name through format-mode-line
-
-
-See ChangeLog.07 for earlier changes.
-
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
-
- This file is part of GNU Emacs.
-
- GNU Emacs is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- (at your option) any later version.
-
- GNU Emacs is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;; Local Variables:
-;; coding: utf-8
-;; add-log-time-zone-rule: t
-;; End:
-
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
new file mode 100644
index 00000000000..790d049f422
--- /dev/null
+++ b/lisp/erc/ChangeLog.1
@@ -0,0 +1,11729 @@
+2008-11-19 Andy Stewart <lazycat.manatee@gmail.com>
+
+ * erc.el (erc-header-line-uses-tabbar-p): New option that makes
+ tabbar mode usable with ERC if set to non-nil.
+ (erc-update-mode-line-buffer): Use it.
+
+2008-11-19 Glenn Morris <rgm@gnu.org>
+
+ * erc-compat.el (help-function-arglist): Autoload it.
+
+2008-10-03 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el (english): Increase size heading by two places.
+ (erc-dcc-byte-count): Move higher.
+ (erc-dcc-do-LIST-command): Use erc-dcc-byte-count to get accurate
+ count. Coerce byte total to floating point before performing
+ computation, otherwise division will truncate to 0.
+ (erc-dcc-append-contents): Update erc-dcc-byte-count.
+ (erc-dcc-get-filter): Don't update erc-dcc-byte-count, because
+ that will give incorrect size totals. Instead, figure out how
+ much we have by summing byte count and current buffer size.
+ (erc-dcc-get-sentinel): Don't update erc-dcc-byte-count.
+
+2008-10-01 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el (erc-pack-int): Make sure returned string is within 4
+ bytes. Always return a 4-byte string, so that we conform to the
+ CTCP spec.
+ (erc-most-positive-int-bytes): New constant representing the
+ number of bytes that most-positive-fixnum can be stored in.
+ (erc-most-positive-int-msb): New constant representing the
+ contents of the most significant byte of most-positive-fixnum.
+ (erc-unpack-int): Make sure that the integer we get back can be
+ represented in Emacs.
+ (erc-dcc-do-CLOSE-command): Update docstring. Don't use the line
+ variable. Try to disambiguate between type and nick when only one
+ is provided. Validate both type and nick arguments. Allow
+ matching by just nick.
+ (erc-dcc-append-contents): Set inhibit-read-only to t. Prevent
+ auto-compression from triggering when we write the contents to a
+ file.
+ (erc-dcc-get-file): Prevent auto-compression from triggering when
+ we truncate a file.
+
+2008-07-27 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * erc.el: Remove code for Carbon.
+
+2008-06-07 Glenn Morris <rgm@gnu.org>
+
+ * erc-autoaway.el, erc-ibuffer.el, erc-menu.el:
+ * erc-stamp.el, erc.el: Remove unnecessary eval-when-compiles.
+
+2008-05-30 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (328): New response handler.
+
+ * erc.el (english): Add 328 to catalog.
+
+2008-05-29 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-services.el (erc-nickserv-alist): Update REGEXP and
+ SUCCESS-REGEXP for freenode.
+
+2008-05-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc-goodies.el (erc-noncommands-list, noncommands)
+ (erc-control-characters, erc-interpret-controls-p)
+ (erc-interpret-mirc-color): Fix typos in docstrings.
+ (erc-controls-highlight): Reflow docstring.
+
+2008-04-26 Johan Bockgård <bojohan@gnu.org>
+
+ * erc.el (erc-put-text-properties): Don't use mapcar*.
+ (erc-display-line-1): Fix argument order in call to
+ erc-put-text-properties.
+
+2008-04-14 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-remove-text-properties-region): Disable this command
+ by default. Thanks to e1f for the suggestion.
+
+2008-02-20 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-notice-face): Fix this face for Emacs 21 users.
+
+2008-02-05 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc.el (erc-valid-nick-regexp):
+ * erc-button.el (erc-button-syntax-table):
+ * erc-match.el (erc-match-syntax-table): Replace `legal' with `valid'.
+
+2008-02-04 Jeremy Maitin-Shepard <jbms@cmu.edu>
+
+ * erc.el (erc-cmd-QUERY): Bind the value of `erc-auto-query' to
+ `erc-query-display' rather than `erc-join-buffer'. This fixes a
+ bug where the value of erc-auto-query was being ignored.
+
+2008-01-31 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el (erc-dcc-do-GET-command, erc-dcc-do-SEND-command):
+ Improve docstring. If FILE argument is split into multiple
+ arguments, re-join them into a single string, separated by a
+ space. This fixes an issue where the user wants to send or
+ receive a file with spaces in its name. It is assumed that no one
+ will try sending or receiving a file with multiple consecutive
+ spaces in its name, otherwise this fix will fail.
+
+ * erc.el (erc-mode-map): Add binding for C-c C-x to
+ erc-quit-server, since rcirc.el binds its quit command in a
+ similar manner. Thanks to Jari Aalto for the suggestion.
+
+2008-01-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list-old.el (list-old): Define module as list-old, not list.
+ This fixes a bug where an unknown module error would occur when
+ starting ERC and using the list-old module.
+
+ * erc-track.el (erc-track-find-face): If no choice was found
+ return nil to use the default mode-line faces.
+
+2008-01-26 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Release ERC 5.3.
+
+ * Makefile (VERSION): Update.
+ (EXTRAS): Remove erc-list.el after all, because this is mainly for
+ users of the version that comes with Emacs, and they will have
+ erc-list.el by Emacs 23.
+ (MISC): Add ChangeLog.07.
+ (elpa): Fix build issue. Add proper version to erc-pkg.el.
+
+ * README.extras: Mention Emacs 23.
+
+ * erc-pkg.el: Make the version string a template.
+
+ * erc.texi (Obtaining ERC): Update extras URLs for 5.3.
+ (Development): Write instructions for git, and remove those for Arch.
+ (History): Mention the switch to git.
+
+2008-01-25 Michael Olson <mwolson@gnu.org>
+
+ * NEWS: Update.
+
+ * erc-goodies.el (keep-place): New module which keeps your place
+ in unvisited ERC buffers when new messages arrive. This is mostly
+ taken from Johan Bockgård's init file.
+ (erc-noncommands-list): Move to correct place.
+
+ * erc-networks.el: Add a module definition.
+
+ * erc-services.el (erc-nickserv-identify-mode): Force-enable the
+ networks module, because we need it to set erc-network for us.
+
+ * erc-track.el (erc-track-faces-normal-list): Indicate in the
+ docstring that this variable can be set to nil.
+
+ * erc.el: On second thought, don't load erc-networks. Just enable
+ the networks module by default.
+ (erc-modules): Add option for keep-place and networks. Enable
+ networks by default.
+ (erc-version-string): Make release candidate 1 available.
+
+2008-01-24 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Load erc-networks.el so that functions get access to the
+ `erc-network-name' function.
+
+ * erc-track.el (erc-track-faces-normal-list): Add
+ erc-dangerous-host-face.
+ (erc-track-exclude-types): Add 333 and 353 to the default list of
+ things to ignore, and explain what they are in the docstring.
+
+2008-01-23 Michael Olson <mwolson@gnu.org>
+
+ * erc-track.el (erc-track-faces-priority-list): Move
+ erc-nick-default-face higher, so that it can be used for the
+ activity indication effect. Add erc-current-nick-face,
+ erc-pal-face, erc-dangerous-host-face, and erc-fool-face by
+ themselves.
+ (erc-track-faces-normal-list): New option that contains a list of
+ faces to consider "normal".
+ (erc-track-position-in-mode-line): Minor docfix.
+ (erc-track-find-face): Use erc-track-faces-normal-list to produce
+ a sort of blinking activity effect.
+
+2008-01-22 Michael Olson <mwolson@gnu.org>
+
+ * erc-button.el (erc-button-add-nickname-buttons): When in a
+ channel buffer, only look at nicks from the current channel.
+ Thanks to e1f for the report.
+
+2008-01-21 Michael Olson <mwolson@gnu.org>
+
+ * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): Remove,
+ since we can use the default `assert' function without it causing
+ us any problems, even in Emacs 21. Thanks to bojohan for the
+ suggestion.
+
+ * erc-goodies.el (move-to-prompt): Use the "XEmacs" method
+ instead, because the [remap ...] method interferes with
+ delete-selection-mode.
+ (erc-move-to-prompt): Rename from erc-move-to-prompt-xemacs.
+ Deactivate mark and call push-mark before moving point. Thanks to
+ bojohan for the suggestion.
+ (erc-move-to-prompt-setup): Rename from
+ erc-move-to-prompt-init-xemacs.
+
+ * erc-track.el (erc-track-faces-priority-list): Replace erc-button
+ with '(erc-button erc-default-face) so that we only care about
+ buttons that are part of normal text. Adjust customization type
+ to handle this case. Make erc-nick-default-face a list. Handle
+ pals, fools, current nick, and dangerous hosts.
+ (erc-track-find-face): Simplify. Adapt for list of faces case.
+ (erc-faces-in): Don't deflate lists of faces. Add them as-is.
+ (erc-track-face-priority): Use equal instead of eq.
+
+2008-01-20 Michael Olson <mwolson@gnu.org>
+
+ * erc-goodies.el (erc-move-to-prompt, erc-move-to-prompt-xemacs):
+ Fix off-by-one error that caused the point to move when placed at
+ the beginning of some already-typed text. Thanks to e1f for the
+ report.
+
+ * erc-dcc.el, erc-xdcc.el: Add simple module definitions.
+
+ * erc.el (erc-modules): Add dcc and xdcc.
+
+2008-01-19 Michael Olson <mwolson@gnu.org>
+
+ * erc-bbdb.el (erc-bbdb-insinuate-and-show-entry): Work around bug
+ in XEmacs 21.4 that throws an error when the first argument to
+ run-at-time is nil.
+
+ * erc-button.el (button): Undo XEmacs-specific change to all ERC
+ buffers when module is removed.
+ (erc-button-setup): Rename from erc-button-add-keys, and move
+ XEmacs-specific stuff here.
+
+ * erc-goodies.el (erc-unmorse): Improve regexp for detecting
+ morse. Deal with the morse style that has "/ " at the end of
+ every letter.
+ (erc-imenu-setup): New function that sets up Imenu support. Add
+ it instead of a lambda form to erc-mode-hook.
+ (scrolltobottom): Remove erc-scroll-to-bottom from all ERC buffers
+ when module is removed. Activate the functionality in all ERC
+ buffers when the module is activated, rather than leaving it up to
+ the user.
+ (move-to-prompt): New module that moves to the ERC prompt if a
+ user tries to type elsewhere in the buffer, and then inserts their
+ keystrokes there. This is mostly taken from Johan Bockgård's init
+ file.
+ (erc-move-to-prompt): New function that implements this.
+ (erc-move-to-prompt-xemacs): New function that implements this for
+ XEmacs.
+ (erc-move-to-prompt-init-xemacs): New function to perform the
+ extra initialization step needed for XEmacs.
+
+ * erc-page.el, erc-replace.el: Fix header and footer.
+
+ * erc-track.el (erc-track-minor-mode-maybe): Take an optional
+ buffer arg so that we can put this in erc-connect-pre-hook. If
+ given this argument, include it in the check to determine whether
+ to activate erc-track-minor-mode.
+ (track): Add erc-track-minor-mode-maybe to erc-connect-pre-hook,
+ so that we can use it as soon as a connection is attempted.
+
+ * erc.el (erc-format-network, erc-format-target-and/or-network):
+ Use erc-network-name function instead, and check to see whether
+ that function is bound. This fixes an error in process filter for
+ people who did not have erc-services or erc-networks loaded.
+ (erc-modules): Add move-to-prompt module and enable it by
+ default. Thanks to e1f for the suggestion.
+
+2008-01-18 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (EXTRAS): Include erc-list-old.el.
+
+ * erc-dcc.el (erc-dcc-verbose): Rename from erc-verbose-dcc.
+ (erc-pack-int): Rewrite to not depend on a count argument.
+ (erc-unpack-int): Rewrite to remove 4-character limitation.
+ (erc-dcc-server): Call set-process-coding-system and
+ set-process-filter-multibyte so that the contents get sent out
+ without modification.
+ (erc-dcc-send-filter): Don't take a substring -- just pass the
+ whole string to erc-unpack-int.
+ (erc-dcc-receive-cache): New option that indicates the number of
+ bytes to let the receive buffer grow before flushing it.
+ (erc-dcc-file-name): New buffer-local variable to keep track of
+ the filename of the currently-received file.
+ (erc-dcc-get-file): Disable undo for a speed increase. Set
+ erc-dcc-file-name. Truncate the file before writing to it.
+ (erc-dcc-append-contents): New function to append the contents of
+ a buffer to a file and then erase the contents of the buffer.
+ (erc-dcc-get-filter): Flush buffer contents after exceeding
+ erc-dcc-receive-cache. This allows large files to be downloaded
+ without storing the whole thing in memory.
+ (erc-dcc-get-sentinel): Flush any remaining contents before
+ closing. No need to save buffer.
+ (erc-dcc-listen-host): New option that determines which IP address
+ to listen on.
+ (erc-dcc-public-host): New option that determines which IP address
+ to advertise when sending a file. This is useful for people who
+ are on a local subnet. Together, these two options replace
+ erc-dcc-host.
+
+ * erc.el (erc-mode-line-format): Add %N and %S. %N is the name of
+ the network, and %S is much like %s but with the network name
+ trumping the server name. Default to "%S %a". Thanks to e1f for
+ the suggestion.
+ (erc-format-network): New function that formats the network name.
+ (erc-format-target-and/or-network): New function that formats both
+ the network name and target, falling back on the server name if
+ the network name is not available.
+ (erc-update-mode-line-buffer): Add the new format spec items.
+
+2008-01-17 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-join-buffer): Improve documentation.
+ (erc-query-display): New option indicating how to display a query
+ buffer that is made by using the /QUERY command. The default is
+ to display the query in a new window.
+ (erc-cmd-QUERY): Use it. Improve docstring.
+ (erc-auto-query): Default this to 'window-noselect instead,
+ because I've already seen bug reports about new users thinking
+ that ERC didn't display their test messages. Improve
+ customization type.
+ (erc-notice-face): Make this work with XEmacs.
+ (erc-join-buffer): Mention 'buffer in docstring. Improve
+ customization type.
+
+ * erc-dcc.el (erc-dcc-send-sentinel): Better handle case where elt
+ is nil, in order to avoid an error. Thanks to Brent Goodrick for
+ the initial patch.
+ (erc-dcc-display-send): New function split from erc-dcc-send-hook.
+ (erc-dcc-send-connect-hook): Use it -- we don't like lambda forms
+ in hooks.
+ (erc-dcc-send-filter): Display byte count if the client confirmed
+ too much, and kill the buffer. Otherwise a DoS might be possible
+ by making Emacs run out of RAM.
+
+ * erc-backend.el (erc-server-connect): Detect early on whether the
+ connection attempt has failed in order to avoid confusing error
+ messages.
+
+ * erc-networks.el (erc-server-alist): Add Rizon network.
+
+ * erc-services.el (erc-nickserv-passwords): Add Rizon to options.
+ (erc-nickserv-alist): Add support for Rizon.
+
+ * erc-track.el (erc-track-find-face): Don't let buttons in notices
+ trump default text. Use catch/throw. Default to first element of
+ FACES is nothing is found.
+
+ * erc-xdcc.el: Add local variables for proper indentation setup.
+
+2008-01-15 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-coding-system): Docfix.
+ (erc-coding-system-for-target): Pass the `target' argument along
+ as the first and only argument. It's not good to just depend on a
+ dynamic binding.
+
+2008-01-10 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (321, 322): Split message-displaying parts into
+ new functions, which are added to each response's respective
+ hook. This makes them easier to disable.
+
+ * erc-list.el: New file from Tom Tromey. Use erc-propertize
+ instead of propertize. Require 'erc.
+ (list): New module definition. Remove message-displaying
+ functions for 321 and 322 response handlers when enabling the
+ module, and restore them when disabling. As a sanity check,
+ remove the erc-list-handle-322 function when disabling the module.
+ (erc-list-handle-322): Handle the case where we run the LIST
+ command, but do not go through the normal steps.
+ (erc-cmd-LIST): Add docstring. Strip initial space from line if
+ it is non-nil. Use make-local-variable to silence compiler
+ warning. Capture current buffer and pass it to
+ erc-list-install-322-handler.
+ (erc-list-install-322-handler): Take server-buffer argument, so
+ that we are certain of being in the right buffer. Use 4th
+ argument to add-hook, so that erc-server-322-functions is only
+ modified in one buffer.
+
+ * erc-list-old.el: Renamed from old erc-list.el.
+
+ * erc.el (erc-modules): Add list-old.
+ (erc-set-topic): Handle case where there are no newlines in the
+ existing topic, which happens when /LIST is run.
+ (erc-notice-face): If we have less than 88 colors, make this
+ blue. Otherwise the text will be pink in a tty, which looks
+ dreadful. Thanks to e1f for the report.
+ (erc-remove-parsed-property): New option that determines whether
+ to remove the erc-parsed property after displaying a message.
+ This should have the effect of making ERC take up less memory.
+ (erc-display-line-1): Use it.
+
+2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-ibuffer.el (erc-channel-modes):
+ Pass mode-name through format-mode-line
+
+2007-12-16 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-services.el (erc-nickserv-alist): Removed autodetect regexp,
+ added identified regexp for OFTC.
+ (erc-nickserv-identification-autodetect): Make sure success-regex
+ is non-nil.
+ (erc-nickserv-identify-autodetect): Make sure identify-regex is
+ non-nil. Doc fix.
+
+2007-12-13 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (PRIVMSG, QUIT, TOPIC, WALLOPS, 376, 004, 221)
+ (312, 315, 319, 330, 331, 333, 367, 368, 391, 405, 406, 412)
+ (421, 432, 433, 437, 442, 461, 474, 477, 482, 431): Doc fix.
+
+2007-12-09 Michael Olson <mwolson@gnu.org>
+
+ * erc-services.el (erc-nickserv-alist): Fix regexps for GRnet.
+
+2007-12-09 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
+
+ * erc-backend.el, erc.el:
+ Parse 275 (secure connection) responses.
+
+ * erc-services.el: Add identification hooks for GRnet, the Greek
+ IRC network <http://www.irc.gr>.
+
+2007-12-08 David Kastrup <dak@gnu.org>
+
+ * erc-stamp.el (erc-echo-timestamp):
+ * erc-lang.el (language):
+ * erc-backend.el (erc-server-connect): Fix buggy call to `message'.
+
+2007-12-07 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-services.el: Provide a hook that runs when nickserv confirms
+ that the user has successfully identified.
+ (services, erc-nickserv-identify-mode): Add and remove
+ erc-nickserv-identification-autodetect from
+ erc-server-NOTICE-functions.
+ (erc-nickserv-alist): Add SUCCESS-REGEXP to each entry.
+ (erc-nickserv-alist-identified-regexp)
+ (erc-nickserv-identification-autodetect): New functions.
+ (erc-nickserv-identified-hook): New hook.
+
+2007-12-06 Deepak Goel <deego3@gmail.com>
+
+ * erc-match.el (erc-add-entry-to-list): Fix buggy call to `error'.
+
+2007-12-01 Glenn Morris <rgm@gnu.org>
+
+ * erc-backend.el (erc-server-send-ping): Move after definition of
+ erc-server-send.
+
+2007-11-29 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change)
+
+ * erc-backend.el, erc.el:
+ Parse 307 (nick has identified) responses.
+
+2007-11-15 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc.el (erc-open):
+ * erc-backend.el (define-erc-response-handler):
+ * erc-log.el (log):
+ * erc-match.el (erc-log-matches): Fix typos in docstrings.
+
+2007-11-11 Michael Olson <mwolson@gnu.org>
+
+ * erc-autoaway.el (erc-autoaway-possibly-set-away):
+ * erc-netsplit.el (erc-netsplit-timer):
+ * erc-notify.el (erc-notify-timer):
+ * erc-track.el (erc-user-is-active): Only run if we have
+ successfully established a connection to the server and have
+ logged in. I suspect that sending messages too soon may make some
+ IRC servers not respond well, particularly when the network
+ connection is iffy or subject to traffic-shaping.
+
+2007-11-01 Michael Olson <mwolson@gnu.org>
+
+ * erc-compat.el (erc-set-write-file-functions): New compatibility
+ function to set the write hooks appropriately.
+
+ * erc-log.el (erc-log-setup-logging): Use
+ erc-set-write-file-functions. This fixes a byte-compiler warning.
+
+ * erc-stamp.el: Silence byte-compiler warning about
+ erc-fill-column.
+
+ * erc.el (erc-with-all-buffers-of-server): Bind the result of
+ mapcar to a variable in order to silence a byte-compiler warning.
+
+2007-10-29 Michael Olson <mwolson@gnu.org>
+
+ * erc-ibuffer.el (erc-modified-channels-alist): Use
+ eval-when-compile, and explain why we are doing this.
+
+2007-10-25 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * erc-ibuffer.el (erc-modified-channels-alist): Pacify
+ byte-compiler.
+
+2007-10-13 Glenn Morris <rgm@gnu.org>
+
+ * erc-track.el (erc-modified-channels-update): Use mapc rather
+ than mapcar.
+
+2007-10-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-join-channel): Prompt for channel key if C-u or
+ another prefix-arg was typed.
+
+ * NEWS: Noted this change.
+
+2007-10-07 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-cmd-ME'S): New command that handles the case where
+ someone types "/me's". It concatenates the text " 's" to the
+ beginning of the input and then sends the result like a normal
+ "/me" command.
+ (erc-command-regexp): Permit single-quote character.
+
+2007-09-30 Aidan Kehoe <kehoea@parhasard.net> (tiny change)
+
+ * erc-log.el (erc-save-buffer-in-logs): Prevent spurious warnings
+ when looking at a log file and concurrently saving to it.
+
+2007-09-18 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
+
+ * erc.texi (Special-Features): Fix small typo.
+
+2007-09-16 Michael Olson <mwolson@gnu.org>
+
+ * erc-track.el (erc-track-switch-direction): Mention
+ erc-track-faces-priority-list. Thanks to Leo for the suggestion.
+
+2007-09-11 Exal de Jesus Garcia Carrillo <exal@gnu.org> (tiny change)
+
+ * erc-sound.el: Fix typo in setting up instructions.
+
+2007-09-10 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (elpa): Copy dir template rather than echoing a few
+ lines. The reason for this is that the ELPA package for ERC was
+ getting a corrupt dir entry.
+
+ * dir-template: Template for the ELPA dir file.
+
+2007-09-08 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-log-filter-function): New option that specifies
+ the function to call for filtering text before writing it to a log
+ file. Thanks to David O'Toole for the suggestion.
+ (erc-save-buffer-in-logs): Use erc-log-filter-function. Make sure
+ we carry along the value of coding-system-for-write, because this
+ could potentially be shadowed by the temporary buffer.
+
+ * erc.el (erc-version-string): Update to 5.3, development version.
+
+2007-09-07 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-toggle-debug-irc-protocol): Fix call to
+ erc-view-mode-enter.
+
+2007-08-08 Glenn Morris <rgm@gnu.org>
+
+ * erc-log.el, erc.el: Replace `iff' in doc-strings and comments.
+
+2007-09-03 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-default-port): Make this an integer value rather
+ than a string. Thanks to Luca Capello for the report.
+
+2007-08-27 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-cmd-GQUIT): If erc-kill-queries-on-quit is non-nil,
+ kill all query buffers after 4 seconds.
+
+2007-08-16 Michael Olson <mwolson@gnu.org>
+
+ * NEWS: Add ERC 5.3 changes section, and mention jbms' erc-track
+ compatibility note.
+
+ * erc-track.el (erc-track-list-changed-hook): Turn this into a
+ customizable option.
+ (erc-track-switch-direction): Add 'importance option.
+ (erc-modified-channels-display): If erc-track-switch-direction is
+ 'importance, call erc-track-sort-by-importance.
+ (erc-track-face-priority): New function that returns a number
+ indicating the position of a face in erc-track-faces-priority-list.
+ (erc-track-sort-by-importance): New function that sorts
+ erc-modified-channels-list according to erc-track-face-priority.
+ (erc-track-get-active-buffer): Make 'oldest a rough opposite of
+ 'importance.
+
+2007-08-14 Jeremy Maitin-Shepard <jbms@cmu.edu>
+
+ * erc-track.el (erc-track-remove-disconnected-buffers): New
+ variable which controls whether buffers associated with a server
+ that is disconnected should be removed from
+ `erc-modified-channels-alist'. Existing behavior is to
+ unconditionally remove such buffers, which is achieved by setting
+ `erc-track-removed-disconnected-buffers' to t. When set to t,
+ which is the new default value, such buffers remain in the list,
+ which I think is often the desired behavior, since the user may
+ likely wish to find out about activity that occurred in a channel
+ prior to it being disconnected.
+ (erc-track-list-changed-hook): New hook that is run whenever the
+ contents of `erc-modified-channels-alist' changes; it is useful
+ for users such as myself that don't use the default mode-line
+ notification but instead use a separate mechanism (which is tied
+ to my window manager) to provide notification of channel activity.
+ (erc-track-get-buffer-window): New function that acts as a wrapper
+ around `get-buffer-window' that handles the `selected-visible'
+ option of `erc-track-visibility'; previously, the value of
+ `erc-track-visibility' was passed directly to `get-buffer-window',
+ which does not support `selected-visible'; consequently,
+ `selected-visible' was not properly supported.
+ (erc-track-modified-channels): Fix a bug in the logic for removing
+ buffers from the list in certain cases.
+ (erc-track-position-in-mode-line): Add a supported value that
+ specifies that the tracking information should not be added to the
+ mode line at all. The value of nil is used to indicate that the
+ information should not be added at all to the mode line.
+ (erc-track-add-to-mode-line): Check for position eq to t, rather
+ than non-nil.
+ (erc-buffer-visible): Use erc-track-get-buffer-window.
+ (erc-modified-channels-update): Take
+ erc-track-remove-disconnected-buffers into account.
+ (erc-modified-channels-display): Run `erc-track-list-changed-hook'.
+
+ * erc.el (erc-reuse-frames): New option that determines whether
+ new frames are always created. Defaults to t. This only has an
+ effect when erc-join-buffer is set to 'frame.
+ (erc-setup-buffer): Use it.
+
+2007-08-14 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-reconnect): If the server buffer has
+ been killed, use the current buffer instead. If the current
+ buffer is not an ERC buffer, give an error. This fixes a bug when
+ /reconnect is run from a channel buffer whose server buffer has
+ been deleted. Thanks to jbms for the report.
+ (erc-process-sentinel-1): Take server buffer as an argument, so
+ that we can make sure that it is current.
+ (erc-process-sentinel): Pass buffer to erc-process-sentinel-1.
+ (erc-process-sentinel-2): New function split from
+ erc-process-sentinel-1. If server buffer is deleted during a
+ reconnect attempt, stop trying to reconnect. Fix bug where
+ reconnect was not happening when erc-server-reconnect-attempts was
+ t. Call erc-server-reconnect-p only once each time. If we are
+ instructed to try connecting indefinitely, tell the user that they
+ can stop this by killing the server buffer. Call the process
+ sentinel by means of run-at-time, so that there is time to kill
+ the buffer if need be; this also removes the need for a while
+ loop. Refuse to reconnect again if erc-server-reconnect-timeout
+ is not an number.
+
+ * erc.el (erc-command-no-process-p): Fix bug: the return value of
+ erc-extract-command-from-line is a list rather than a single
+ symbol. Thanks to jbms for the report.
+ (erc-cmd-RECONNECT): Use simpler logic, and use buffer-live-p
+ rather than bufferp.
+ (erc-send-current-line, erc-display-command, erc-display-msg):
+ Handle case where erc-server-process is nil, so that /reconnect
+ works.
+
+2007-08-12 Michael Olson <mwolson@gnu.org>
+
+ * erc-identd.el (erc-identd-filter): Instead of sending an EOF
+ character, which now confuses freenode, stop the server process,
+ so that no new connections are accepted, and kill the current
+ client process.
+
+2007-07-29 Michael Olson <mwolson@gnu.org>
+
+ * erc-list.el: Relicense to GPLv3. Since the file was already
+ licensed under version 2 or later, it turns out that we do not
+ need the permission of all of the authors in order to proceed.
+
+2007-07-13 Michael Olson <mwolson@gnu.org>
+
+ * erc-goodies.el (erc-get-bg-color-face, erc-get-fg-color-face):
+ Use erc-error rather than message and beep.
+
+ * erc-sound.el: Indentation fix.
+
+ * erc.el (erc-command-no-process-p): New function that determines
+ if its argument is an ERC command that can be run when the server
+ process is not alive.
+ (erc-cmd-SET, erc-cmd-CLEAR, erc-cmd-COUNTRY, erc-cmd-HELP)
+ (erc-cmd-LASTLOG, erc-cmd-QUIT, erc-cmd-GQUIT)
+ (erc-cmd-RECONNECT, erc-cmd-SERVER): Denote that these commands
+ can be run even when the server process is not alive.
+ (erc-send-current-line): Call erc-command-no-process-p if the
+ server process is not alive, to determine if we have a command
+ that can be run anyway. Thanks to Tom Tromey for the bug report.
+ (erc-error): New function that either displays a message or throws
+ an error, depending on whether debug-on-error is non-nil.
+ (erc-cmd-SERVER, erc-send-current-line): Use it.
+
+2007-07-10 Michael Olson <mwolson@gnu.org>
+
+ * Relicense all FSF-assigned code to GPLv3.
+
+2007-06-25 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi (Options): Fix typo.
+ (Getting Help and Reporting Bugs): Update webpage URL. Make Gmane
+ part more readable.
+
+2007-06-20 Michael Olson <mwolson@gnu.org>
+
+ * erc-stamp.el (erc-timestamp-format-left): New option that
+ specifies the left timestamp to use for
+ erc-insert-timestamp-left-and-right.
+ (erc-timestamp-format-right): New option that specifies the right
+ timestamp to use for erc-insert-timestamp-left-and-right.
+ (erc-insert-timestamp-function): Change default to
+ erc-insert-timestamp-left-and-right.
+ (erc-insert-away-timestamp-function): Ditto.
+ (erc-timestamp-last-inserted-left)
+ (erc-timestamp-last-inserted-right): New variables to keep track
+ of data for erc-insert-timestamp-left-and-right.
+ (erc-insert-timestamp-left-and-right): New function that places
+ timestamps on both the left and right sides of the screen, but
+ only if each timestamp has changed since it was last computed.
+ Thanks to offby1 for urging me to merge this.
+
+ * erc.el (erc-open-ssl-stream): Display informative error when
+ ssl.el not found.
+ (erc-tls): New function to connect using tls.el.
+ (erc-open-tls-stream): New function to initiate tls connection.
+ Display informative error when tls.el not found.
+
+2007-06-19 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el: Update header with accurate instructions.
+
+2007-06-17 Michael Olson <mwolson@gnu.org>
+
+ * erc-pkg.el: Update description to match what is currently in ELPA.
+
+2007-06-14 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check.
+
+2007-06-13 Michael Olson <mwolson@gnu.org>
+
+ * erc-compat.el (erc-with-selected-window): New compatibility
+ macro that implements `with-selected-window'.
+
+ * erc-goodies.el (erc-scroll-to-bottom): Use it. This fixes a bug
+ with buffer ordering where ERC buffers would move to the top.
+ Thanks to Ivan Kanis for the patch.
+
+2007-06-10 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-logging-enabled): Fix a bug that occurred when
+ `erc-log-channels-directory' had the name of a function.
+
+2007-06-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc.el (erc-show-channel-key-p, erc-startup-file-list):
+ Fix typo in docstring.
+
+2007-06-03 Michael Olson <mwolson@gnu.org>
+
+ * erc-compat.el (erc-view-mode-enter): Make this its own function,
+ in order to document what we do, and provide sane fallback
+ behavior.
+
+ * erc.el (erc-toggle-debug-irc-protocol): Don't pass any arguments
+ to erc-view-mode-enter, since we don't do anything special with
+ the exit function. This fixes a bug with Emacs 21 and Emacs 22.
+ Thanks to Leo for noticing.
+
+2007-05-30 Michael Olson <mwolson@gnu.org>
+
+ * erc-compat.el (erc-user-emacs-directory): New variable that
+ determines where to find user-specific Emacs settings. For Emacs,
+ this is usually ~/.emacs.d, and for XEmacs this is usually
+ ~/.xemacs.
+
+ * erc.el (erc-startup-file-list): Use erc-user-emacs-directory.
+
+2007-05-28 Michael Olson <mwolson@gnu.org>
+
+ * erc-button.el (erc-button-url-regexp): Recognize parentheses as
+ part of URLs. Thanks to Lawrence Mitchell for the fix.
+
+2007-05-26 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi (Modules): Fix references to completion modules.
+
+2007-05-21 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (SOURCE): Remove erc-pkg.el.
+ (debclean): New rule to clean old Debian packages of ERC.
+ (debprepare): Don't modify the released tarball, but copy it as
+ the .orig.tar.gz file.
+ (debrelease, debrevision): Remove.
+ (debinstall): New target that copies the generated Debian file to
+ a distro-specific location.
+ (deb): New rule that chains together the stages in building a
+ Debian package.
+ (EXTRAS): Add erc-nicklist.el, since it is not release-quality.
+ (extras): Copy images directory.
+
+ * erc-nicklist.el (erc-nicklist-icons-directory): Use
+ locate-library to find the "images" directory. This should be
+ more failsafe. Thanks to Tom Tromey for the idea.
+
+2007-05-19 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (ELPA): New variable that contains the location of my
+ local ELPA repository.
+ (elpa): New rule that makes an ELPA package for ERC.
+
+2007-04-19 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-parse-prefix): New function that retrieves the
+ PREFIX server parameter from the current server and returns an
+ alist of prefix type to prefix character.
+ (erc-channel-receive-names): Use `erc-parse-prefix' to determine
+ whether the first character of a nick is a prefix character or
+ not. This should fix a bug reported by bromine about needing to
+ type "%" first to complete nicks of people who are "hops" on
+ Slashnet. This should also support for very exotic IRC server
+ setups, if any exist.
+ (erc-update-current-channel-member): Indentation.
+
+2007-04-15 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-generate-log-file-name-function): Docfix.
+ Mention how to deal with the case for putting log files in
+ different directories. Change a customization type from `symbol'
+ to `function'.
+ (erc-log-channels-directory): Allow this to contain a function
+ name, which is called with the same args as in
+ `erc-generate-log-file-name-function'. Thanks to andrewy for the
+ report and use case.
+ (erc-current-logfile): Detect if `erc-log-channels-directory' is a
+ function and call it with arguments if so.
+
+2007-04-12 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (define-erc-response-handler): Mention that hook
+ processing stops when the function returns non-nil. This should
+ help avoid a nasty "gotcha" when making custom functions. Thanks
+ to John Sullivan for the report.
+
+2007-04-08 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nicklist.el (erc-nicklist-voiced-position): Fixed
+ customization mismatch.
+
+2007-04-01 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Release ERC 5.2.
+
+ * erc-auto.in, erc-chess.el, erc-list.el, erc-speak.el:
+ * erc-viper.el: Update copyright notices.
+
+ * erc.texi: Make Emacs Lisp source code in this document
+ essentially public domain. Update version to 5.2.
+ (Obtaining ERC): Mention extras tarball.
+ (Releases): Mention local GNU mirror.
+ (Sample Configuration): Remove notice.
+
+ * FOR-RELEASE (5.3): Add item for erc-nicklist.
+ Mark NEWS as done. Mark extras tarball as done.
+
+ * Makefile (VERSION): Increment to 5.2.
+ (TESTING): Remove.
+ (EXTRAS): New variable containing the contents of our "Emacs 22
+ extras" tarball.
+ (SOURCE): Remove $(TESTING).
+ (MISC): Add COPYING and ChangeLog.06. Fix ChangeLog.NNNN ->
+ ChangeLog.NN.
+ (release): Use $(SNAPDIR) instead of erc-$(VERSION).
+ (extras): New rule which implements the building of the extras
+ tarball.
+ (upload-extras): New rule to upload the extras tarball. It's
+ yucky to replicate upload, but oh well.
+ (DISTRIBUTOR): New variable used to differentiate between building
+ packages for Ubuntu and Debian.
+ (debrelease, debrevision): Use it.
+ (debbuild): Run linda in addition to lintian.
+
+ * NEWS: Mention extras tarball. Note which files have been
+ renamed. Note that erc-list is enabled by default, except in
+ Emacs 22.
+
+ * README.extras: New file which serves as a README for the extras
+ tarball.
+
+2007-03-31 Michael Olson <mwolson@gnu.org>
+
+ * NEWS: Update for the 5.2 release.
+
+ * FOR-RELEASE: Finish up 5.2 manual item. Add documentation item
+ for 5.3.
+
+ * erc.texi (Sample Session): Flesh out. Mention #erc.
+ (Modules): Defer to 5.3 release.
+ (Advanced Usage): Move Sample Configuration chapter ahead of
+ unfinished chapters.
+ (Sample Configuration): Write.
+ (Options): Mention how to see available ERC options. Defer to 5.3
+ release.
+ (Tips and Tricks): Remove, since it seems better to just include
+ tips and tricks in the sample configuration, commented out.
+
+ * erc-bbdb.el (erc-bbdb-search-name-and-create): Make prompt more
+ informative about how to skip merging.
+ (erc-bbdb-insinuate-and-show-entry-1): Move contents of
+ erc-bbdb-insinuate-and-show-entry here.
+ (erc-bbdb-insinuate-and-show-entry): Run
+ erc-bbdb-insinuate-and-show-entry-1 "outside" of the calling
+ function, so that we can avoid triggering a process-filter error
+ if the user hits C-g.
+
+2007-03-30 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE: Solve C-c C-SPC keybinding dilemma.
+
+ * erc-autoaway.el (erc-autoaway-idle-method): Use `if' rather than
+ `cond' and `set' rather than `set-default'.
+
+ * erc-log.el: Avoid compiler warning by requiring erc-network
+ during compilation.
+ (erc-generate-log-file-name-function): Add tag to each option.
+ Add erc-generate-log-file-name-network.
+ (erc-generate-log-file-name-network): New function which generates
+ a log file name that uses network name rather than server name,
+ when possible.
+
+ * erc-track.el (track): Assimilate track-when-inactive module,
+ since there's no need to have two modules in one file -- an option
+ will do. Remove track-modified-channels alias. Call
+ erc-track-minor-mode-maybe, and tear down the minor mode when
+ disabling.
+ (erc-track-when-inactive): New option which determines whether to
+ track visible buffers when inactive. The default is not to do so.
+ (erc-track-visibility): Mention erc-track-when-inactive.
+ (erc-buffer-visible): Use erc-track-when-inactive.
+ (erc-track-enable-keybindings): New option which determines
+ whether to enable the global-level tracking keybindings. The
+ default is to do so, unless they would override another binding,
+ in which case we prompt the user about it.
+ (erc-track-minor-mode-map): Move global keybindings here.
+ (erc-track-minor-mode): New minor mode which only enables the
+ keybindings and does nothing else.
+ (erc-track-minor-mode-maybe): New function which starts
+ erc-track-minor-mode, but only if it hasn't already been started,
+ an ERC buffer exists, and the user OK's it, depending on the value
+ of `erc-track-enable-keybindings'.
+ (erc-track-switch-buffer): Display a message if someone calls this
+ without first enabling erc-track-mode.
+
+2007-03-17 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi (Development): Mention ErcDevelopment page on
+ emacswiki.
+ (Getting Started): Mention ~/.emacs.d/.ercrc.el and the Customize
+ interface.
+ (Sample Session): New section that has a very rough draft for a
+ sample ERC session.
+ (Special Features): New section that explains some of the special
+ features of ERC. Taken from ErcFeatures on emacswiki, with
+ enhancements.
+
+2007-03-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autoaway.el (erc-autoaway-idle-method): When setting the new
+ value, disable and re-enable `erc-autoaway-mode' only if it was
+ already enabled. This fixes a bug where autoaway was enabled just
+ by loading the file.
+
+2007-03-10 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-capab.el: Added more information to the Usage section.
+ (erc-capab-identify-prefix): Doc fix.
+ (erc-capab-identify-unidentified): New face.
+ (290): Removed. Definition moved to erc-backend.el.
+ (erc-capab-identify-send-messages): Renamed from
+ `erc-capab-send-identify-messages'.
+ (erc-capab-identify-setup): Use it.
+ (erc-capab-identify-get-unidentified-nickname): Renamed from
+ `erc-capab-get-unidentified-nickname'.
+ (erc-capab-identify-add-prefix): Use it. Use
+ `erc-capab-identify-unidentified' as the face.
+
+ * erc-backend.el (290): Moved here from erc-capab.el.
+
+ * erc.el (erc-select): Added an autoload cookie.
+ (erc-message-type-member, erc-restore-text-properties): Use
+ `erc-get-parsed-vector'.
+ (erc-auto-query): Set the default to 'bury since many new users
+ expect private messages from others to be in dedicated query
+ buffers, not the server buffer.
+ (erc-common-server-suffixes): Use "freenode" for freenode.net, not
+ "OPN". Added oftc.net.
+
+ * NEWS: Added note about erc-auto-query's new default setting.
+
+2007-03-03 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-open, erc): Docfixes.
+
+2007-03-02 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE: Make section for 5.3 release and move erc-backend
+ cleanup there. Awaiting discussion before doing other things.
+ Add tasks for merging filename changes from the 5.2 release
+ branch, and for making a tarball of modules not in Emacs 22. Add
+ item to remind me to update NEWS. Mark backtab entry as done.
+
+ * erc-button.el (button): Add call to `erc-button-add-keys'.
+ (erc-button-keys-added): New variable tracking whether we've added
+ the keys yet.
+ (erc-button-add-keys): New function that adds the <backtab> key to
+ erc-mode-map.
+
+ * erc.texi: Change version to 5.2 (pre-release).
+
+2007-02-15 Michael Olson <mwolson@gnu.org>
+
+ * CREDITS: Update.
+
+ * erc-backend.el (erc-server-send-ping-interval): Change to use a
+ default of 30 seconds. Improve customize interface.
+ (erc-server-send-ping-timeout): New option that determines when to
+ consider a connection stalled and restart it. The default is
+ after 120 seconds.
+ (erc-server-send-ping): Use erc-server-send-ping-timeout instead
+ of erc-server-send-ping-interval. If
+ erc-server-send-ping-timeout is nil, do not ever kill and restart
+ a hung IRC process.
+
+ * erc.el (erc-modules): Include the name of the module in its
+ description. This should make it easier for people to find and
+ enable a particular module.
+
+2007-02-15 Vivek Dasmohapatra <vivek@etla.org>
+
+ * erc.el (erc-cmd-RECONNECT): Kill old process if it is still
+ alive.
+ (erc-message-english-PART): Properly escape "%" characters in
+ reason.
+
+ * erc-backend.el (erc-server-reconnecting): New variable that is
+ set when the user requests a reconnect, but the old process is
+ still alive. This forces the reconnect to work even though the
+ process is killed manually during reconnect.
+ (erc-server-connect): Initialize it.
+ (erc-server-reconnect-p): Use it.
+ (erc-process-sentinel-1): Set it to nil after the first reconnect
+ attempt.
+
+2007-02-07 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el (erc-menu-definition): Fixed so that the separator
+ is between "Current channel" and "Pals, fools and other keywords",
+ not at the bottom of the "Current channel" submenu.
+
+2007-01-25 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-networks.el (erc-server-alist): Removed SSL server for now
+ since `erc-server-select' doesn't know to use `erc-ssl'.
+
+ * erc-networks.el (erc-server-alist, erc-networks-alist): Added
+ definitions for oftc.net.
+
+ * erc-services.el (erc-nickserv-alist): Fixed OFTC message regexp.
+
+2007-01-22 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-error-occurred): New variable that
+ indicates when an error has been signaled by the server. This
+ should fix an infinite reconnect bug when giving some servers a
+ bogus :full-name. Thanks to Angelina Carlton for the report.
+ (erc-server-connect): Initialize erc-server-error-occurred.
+ (erc-server-reconnect-p): Use it.
+ (ERROR): Set it.
+
+ * erc-services.el (erc-nickserv-alist): Alphabetize and add Ars
+ and QuakeNet. Standardize look of entries. Fix type mismatch
+ error in customize interface.
+ (erc-nickserv-passwords): Alphabetize and add missing entries from
+ erc-nickserv-alist.
+
+2007-01-21 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-header-line-format): Document how to disable the
+ header line, and add a customization type for it. Also, make the
+ changes take effect immediately.
+
+2007-01-19 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi (Modules): Document new menu module. Thanks to Leo
+ for noticing.
+
+2007-01-16 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-stamp.el (erc-insert-timestamp-left): Fixed so that the
+ whitespace string filler is hidden correctly when timestamps are
+ hidden.
+ (erc-toggle-timestamps): New function to use instead of
+ `erc-show-timestamps' and `erc-hide-timestamps'.
+
+ * erc.el (erc-restore-text-properties): Moved here from
+ erc-fill.el since it could be useful in general.
+
+ * erc-fill.el (erc-restore-text-properties): Removed.
+
+2007-01-13 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-command-regexp): New variable that is used to match
+ a command.
+ (erc-send-input): Use it. This fixes a bug where paths --
+ "/usr/bin/foo", for example -- were being displayed as commands,
+ but still sent correctly.
+ (erc-extract-command-from-line): Use it.
+
+ * erc.texi (Modules): Document erc-capab-identify.
+
+2007-01-11 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-find-parsed-property): Moved here from erc-track.el
+ since it can be useful in general.
+
+ * erc-track.el (erc-find-parsed-property): Removed.
+
+ * erc-capab.el (erc-capab-find-parsed): Removed.
+ (erc-capab-identify-add-prefix): Use `erc-find-parsed-property'.
+
+ * erc.el (erc-open): Run `erc-before-connect' hook here. This
+ makes sure the hook always gets called before a connection is
+ made, as some functions, like `erc-handle-irc-url', use `erc-open'
+ instead of `erc'.
+ (erc): Removed `erc-before-connect' hook.
+
+ * erc-menu.el (erc-menu-definition): Put items specific to
+ channels in a "Current channel" submenu.
+
+ * erc-backend.el (321, 323): Display channel list in server buffer
+ when not using the channel list module.
+
+ * erc.el: Updated copyright years.
+ (erc-version-string): Set to 5.2 (devel).
+ (erc-format-lag-time): Fixed to work when `erc-server-lag' is nil.
+ (erc-update-mode-line-buffer): Set the header face.
+
+2007-01-11 Michael Olson <mwolson@gnu.org>
+
+ * erc-bbdb.el (erc-bbdb-popup-type): Fix customization type and
+ documentation.
+
+ * erc-services.el (erc-nickserv-identify-mode): Improve
+ documentation for nick-change option and move higher to fix
+ compiler warning. Avoid a recursive load error.
+ (erc-nickserv-alist): Add simple entry for BitlBee, to avoid
+ "NickServ is AWAY: User is offline" error. Oddly enough, bitlbee
+ was smart enough to recognize that as an authentication request
+ and log in regardless, which is why I didn't notice this earlier.
+ (erc-nickserv-alist-sender, erc-nickserv-alist-regexp)
+ (erc-nickserv-alist-nickserv, erc-nickserv-alist-ident-keyword)
+ (erc-nickserv-alist-use-nick-p)
+ (erc-nickserv-alist-ident-command): New accessors for
+ erc-nickserv-alist. Using nth is unwieldy.
+ (erc-nickserv-identify-autodetect)
+ (erc-nickserv-identify-on-connect)
+ (erc-nickserv-identify-on-nick-change, erc-nickserv-identify): Use
+ the new accessors.
+
+2007-01-11 Diane Murray <disumu@x3y2z1.net>
+
+ * NEWS: Added note for `erc-my-nick-face'. Fixed capab-identify
+ wording.
+
+2007-01-10 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-mode-line-format): Added %l to documentation.
+ (erc-header-line-format): Removed "[IRC]". Use the new %l
+ replacement character. Doc fix.
+ (erc-format-channel-modes): Removed lag code. Removed parentheses
+ from mode string.
+ (erc-format-lag-time): New function.
+ (erc-update-mode-line-buffer): Use it.
+
+2007-01-10 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Fix typo in url-irc-function instructions.
+
+2007-01-09 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-system-name): New option that determines the system
+ name to use when logging in. The default is to figure this out by
+ calling `system-name'.
+ (erc-login): Use it.
+
+2007-01-07 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-modules): Add the menu module. This should fix a
+ bug with incorrect ERC submenus being displayed.
+
+ * erc-menu.el: Turn this into a module.
+ (erc-menu-add, erc-menu-remove): New functions that add and remove
+ the ERC menu.
+
+2006-12-28 Michael Olson <mwolson@gnu.org>
+
+ * erc-list.el: Change header to mention that this is part of ERC,
+ rather than GNU Emacs.
+
+ * erc-networks.el (erc-server-alist): Add Ars OpenIRC and
+ LinuxChix networks. Thanks to Angelina Carlton for mentioning
+ them. Properly escape periods in Konfido.Net and Kewl.Org.
+ (erc-networks-alist): Add entries for Ars and LinuxChix, though
+ the latter does not actually provide an announced network name.
+
+ * erc-services.el (erc-nickserv-identify-mode): Add 'both method,
+ which waits for a NickServ message if the network supports it,
+ otherwise sends the password after connecting.
+ (erc-nickserv-identify-mode): Default to 'both.
+ (erc-nickserv-passwords): Add OFTC and Azzurra to custom options.
+ (erc-nickserv-alist): Indentation fix.
+ (erc-nickserv-identify-on-connect)
+ (erc-nickserv-identify-on-nick-change): Handle 'both method.
+
+2006-12-28 Leo Liu <sdl.web@gmail.com> (tiny change)
+
+ * erc.el (erc-iswitchb): Wrap body in unwind-protect so that
+ hitting C-g does not leave iswitchb-mode on.
+
+2006-12-27 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-cmd-RECONNECT): New command that calls
+ erc-server-reconnect.
+
+ * erc-backend.el (erc-server-reconnect-count): New server variable
+ that keeps track of reconnection attempts.
+ (erc-server-reconnect-attempts): New option that determines the
+ number of reconnection attempts that ERC will make per server.
+ (erc-server-reconnect-timeout): New option that determines the
+ amount of time, in seconds, that ERC will wait between successive
+ reconnect attempts.
+ (erc-server-reconnect): New function that reestablishes the
+ current IRC connection. Move some commands from
+ erc-process-sentinel-1 here.
+ (erc-process-sentinel-1): If we have been disconnected, loop until
+ we either reconnect or run out of attempts.
+ (erc-server-reconnect-p): Move higher and make this a defsubst,
+ since I'm worried about the current buffer changing from
+ underneath us. Implement limit of number of reconnect attempts..
+
+ * erc.texi (Getting Started): Update for /RECONNECT command.
+
+2006-12-26 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-open): Restore old point correctly, or at least get
+ closer to doing so than before.
+
+2006-12-13 Leo Liu <sdl.web@gmail.com> (tiny change)
+
+ * erc.el (erc-iswitchb): Temporarily enable iswitchb mode if it
+ isn't active already, instead of leaving it on.
+
+2006-12-10 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc-ezbounce.el (erc-ezb-init-session-list): Doc fix.
+
+2006-12-08 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Re-evaluate contributions from a contributor, and found
+ them under 15 lines of non-obvious code, so it is safe to remove
+ the copyright notice.
+ (erc-modules): Remove list module.
+
+ * erc-list.el: Remove, since a contributor who has not completed
+ their assignment has contributed significantly more than 15 lines
+ of code to this file.
+
+2006-11-28 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc.el (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Simplify.
+ (erc-prompt-for-channel-key, erc-ignore-reply-list, erc-send-post-hook)
+ (erc-active-buffer, erc-join-buffer, erc-frame-alist, erc-with-buffer)
+ (erc-modules, erc-display-message-highlight, erc-process-input-line)
+ (erc-cmd-HELP, erc-server-hooks, erc-echo-notice-in-user-buffers)
+ (erc-format-my-nick, erc-echo-notice-in-user-and-target-buffers)
+ (erc-echo-notice-in-first-user-buffer, erc-connection-established)
+ (erc-update-user-nick, erc-update-channel-member, erc-highlight-notice)
+ (erc-command-symbol, erc-add-query, erc-process-script-line)
+ (erc-determine-parameters, erc-client-info, erc-popup-input-buffer):
+ (erc-script-echo): Fix typos in docstrings.
+ (erc-channel-user-op-p, erc-channel-user-voice-p, erc-startup-file-list)
+ (define-erc-module, erc-once-with-server-event)
+ (erc-once-with-server-event-global, erc-debug-irc-protocol)
+ (erc-log-irc-protocol, erc-cmd-LOAD, erc-update-user)
+ (erc-update-current-channel-member, erc-load-script):
+ (erc-mode-line-away-status-format): Doc fixes.
+
+2006-11-20 Andrea Russo <rastandy@inventati.org> (tiny change)
+
+ * erc-dcc.el (erc-dcc-chat-setup): Initialize `erc-input-marker'
+ before calling `erc-display-prompt'.
+
+2006-11-24 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc.el (erc-after-connect, erc-open-ssl-stream)
+ (erc-display-line-1, erc-display-line):
+ * erc-backend.el (005): Fix space/tab mixup in docstrings.
+
+2006-11-20 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Call this Version 5.2 stable
+ pre-release, since it diverges slightly from our 5.2 branch, in
+ that unstable features are not included.
+ (erc-update-modules): Display better error message when module not
+ found.
+
+2006-11-12 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el: Save all log buffers when Emacs exits, in case
+ someone ignores the warning about open processes. Remove the
+ advice code in the commentary.
+ (erc-save-query-buffers): Docfix.
+ (erc-log-save-all-buffers): New function that saves all ERC
+ buffers to logs.
+ (erc-current-logfile): Fix bug in filename selection, where the
+ current buffer was erroneously being preferred over the given
+ buffer.
+
+2006-11-08 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-string-to-port): Avoid error when a numerical port
+ is passed. Thanks to Zekeriya KOÇ for the report.
+
+2006-11-08 Łukasz Demianiuk <ldemianiuk@gmail.com> (tiny change)
+
+ * erc.el (erc-header-line): Fix typo.
+
+2006-11-06 Juanma Barranquero <lekktu@gmail.com>
+
+ * erc-dcc.el (erc-dcc-send-file): Fix typo in error message.
+
+ * erc.el (read-passwd):
+ * erc-autoaway.el (erc-autoaway-reestablish-idletimer):
+ * erc-truncate.el (truncate): Fix typo in docstring.
+
+2006-10-21 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-iswitchb): Fix bug when hitting C-c C-b without
+ first loading iswitchb. Thanks to Leo for the report.
+
+2006-10-10 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-default-port): Make the default be 6667 instead of
+ ircd. since Mac OS X apparently has problems with looking up that
+ port name.
+
+ * erc-backend.el (353): Receive names after displaying the initial
+ message, instead of before.
+
+2006-10-05 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-my-nick-face): New face.
+ (erc): Use FULL-NAME argument, not `erc-user-full-name'. This
+ fixes a bug where the :full-name argument passed to the function
+ was not respected.
+ (erc-format-my-nick): Use `erc-my-nick-face'. This should help
+ make it easier to find messages you sent in conversations when
+ `erc-show-my-nick' is non-nil.
+ (erc-compute-server): Doc fix.
+
+2006-10-01 John J Foerch <jjfoerch@earthlink.net> (tiny change)
+
+ * erc-stamp.el (erc-insert-timestamp-right): Exclude the newline
+ from the erc-timestamp field.
+
+2006-09-11 Michael Olson <mwolson@gnu.org>
+
+ * erc-nicklist.el (erc-nicklist-insert-contents): Add missing
+ parenthesis. Thanks to Stephan Stahl for the report.
+
+2006-09-10 Eric Hanchrow <offby1@blarg.net>
+
+ * erc.el (erc-cmd-IGNORE): Prompt user if this might be a regexp
+ instead of a single user.
+
+2006-09-10 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-generate-new-buffer-name): If this is a server
+ buffer and a process exists already, create a new buffer.
+ (erc-open): If the IRC session was continued, restore the old
+ point. Thanks to Stephan Stahl for the report.
+ (erc-member-ignore-case): Coding style tweak.
+ (erc-cmd-UNIGNORE): Quote the user before comparison. If we don't
+ find the user listed verbatim, try to match them against the list
+ using string-match. In this case, prompt as to whether the regexp
+ should be removed.
+ (erc-ignored-user-p): Remove CL-ism.
+
+ * erc-autoaway.el (erc-autoaway-possibly-set-away): Check to see
+ whether we are already away.
+
+ * erc-menu.el: Fix potential compiler warning.
+
+2006-09-07 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: Updated Commentary and URL.
+ (erc-iswitchb, erc-display-line, erc-set-modes, erc-update-modes)
+ (erc-arrange-session-in-multiple-windows): No need to check if
+ `erc-server-process' is bound.
+ (erc-server-buffer-live-p): Doc fix.
+ (erc-part-from-channel): Don't use any initial contents at prompt.
+ (erc-format-nick, erc-format-@nick): Doc fix. Use `when'.
+ (s367): Fixed to support only banmask and channel which is the
+ standard. Also, there's no reason to add a message to each banned
+ user entry trying to persuade the user to use /banlist instead of
+ /mode #channel +b. That part of the message was a little
+ confusing, anyways.
+ (s367-set-by): New catalog entry. The user who set the ban and
+ the time of ban seem to be specific to only certain servers such
+ as freenode.
+
+ * erc-autoaway.el (erc-autoaway-idletimer): Doc fix.
+
+ * erc-backend.el (erc-server-process-alive): No need to check if
+ `erc-server-process' is bound.
+ (367): Use s367 or s367-set-by where appropriate.
+
+ * erc-compat.el: Fixed URL.
+
+ * erc-dcc.el: Updated copyright years. Added Usage section.
+ Changed supported Emacs version number from 21.3.50 to 22 in
+ Commentary.
+
+ * erc-ibuffer.el (erc-server-name, erc-target, erc-away): No need
+ to check if `erc-server-process' is bound.
+
+ * erc-nicklist.el: Added to the Commentary section an explanation
+ that `erc-nicklist-quit' should be called from within the nicklist
+ buffer. Set file coding to utf-8 so a contributor's name is
+ displayed correctly.
+ (erc-nicklist-icons-directory): Use customize type directory
+ instead of string.
+ (erc-nicklist-insert-contents): Set bbdb-nick to an empty string
+ if it wasn't found. This fixes a bug where an error would occur
+ when using `string=' on bbdb-nick if it was nil.
+
+ * erc-replace.el: Removed URL from file information since it
+ doesn't exist.
+
+ * erc-sound.el: Updated copyright years. Fixed Commentary and
+ added Usage section.
+ (define-erc-module): Add and remove `erc-ctcp-query-SOUND' to
+ `erc-ctcp-query-SOUND-hook' here. Removed the keybinding
+ definitions.
+ (erc-play-sound, erc-default-sound, erc-cmd-SOUND)
+ (erc-ctcp-query-SOUND): Doc fix.
+ (erc-play-command): Removed, not necessary anymore.
+ (erc-ctcp-query-SOUND-hook): Set to nil as default. Moved up
+ higher in code, added docstring.
+ (erc-play-sound): Use `play-sound-file'. It exists in GNU Emacs
+ as well since version 21 or earlier. Removed commented-out older
+ version of function.
+
+ * NEWS: Fixed formatting, added channel tracking change.
+
+2006-09-03 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: M-x erc RET can now be used to start ERC.
+ (erc-open): Renamed from `erc'.
+ (erc-before-connect): Change erc-select to erc.
+ (erc): Renamed from `erc-select'. Use `erc-open'.
+ (erc-select): Defined as alias of `erc'.
+ (erc-ssl): Renamed from `erc-select-ssl'. Use `erc'.
+ (erc-select-ssl): Defined as alias of `erc-ssl'.
+ (erc-cmd-SERVER): Use `erc'.
+ (erc-query, erc-handle-irc-url): Use `erc-open'.
+
+ * erc-backend.el (erc-process-sentinel-1, JOIN): Use `erc-open'.
+
+ * erc-menu.el (erc-menu-definition): Use `erc'.
+
+ * erc-networks.el: Updated copyright years.
+ (erc-server-select): Use keyword arguments when calling `erc'.
+
+ * erc.texi (Getting Started, Connecting): Changed erc-select to
+ erc.
+
+ * README: Changed erc-select to erc.
+
+ * NEWS: Added note about these changes.
+
+ * FOR-RELEASE: Marked this item as done.
+
+2006-08-21 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-track.el (erc-track-mode-line-mouse-face): New variable.
+ (erc-make-mode-line-buffer-name): Add help-echo and mouse-face
+ properties to channel name.
+
+2006-08-20 Michael Olson <mwolson@gnu.org>
+
+ * erc-identd.el (erc-identd): New customization group.
+ (erc-identd-port): New option that specifies the port to use if
+ none is given as an argument to erc-identd-start.
+ (identd): Place erc-identd-quickstart in erc-connect-pre-hook
+ instead of erc-identd-start so that we deal with the different
+ meaning of the first argument.
+ (erc-identd-start): Use erc-identd-port.
+ (erc-identd-quickstart): New function that ignores any arguments
+ and calls erc-identd-start.
+
+ * erc.el (erc-with-server-buffer): New macro that switches to the
+ current ERC server buffer and runs some code. If no server buffer
+ is available, return nil. This is a useful way to access
+ variables in the server buffer.
+ (erc-get-server-user, erc-add-server-user)
+ (erc-remove-server-user, erc-change-user-nickname)
+ (erc-get-server-nickname-list, erc-get-server-nickname-alist)
+ (erc-ison-p, erc-active-buffer, erc-cmd-IGNORE)
+ (erc-cmd-UNIGNORE, erc-cmd-IDLE, erc-cmd-NICK, erc-cmd-BANLIST)
+ (erc-cmd-MASSUNBAN, erc-nickname-in-use, erc-ignored-user-p)
+ (erc-format-channel-modes): Use it.
+ (erc-once-with-server-event, erc-once-with-server-event-global)
+ (erc-with-buffer, erc-with-all-buffers-of-server): Use make-symbol
+ instead of gensym.
+ (erc-open-server-buffer-p): New function that returns non-nil if
+ the given buffer is an ERC server buffer that has an open IRC
+ process.
+ (erc-with-buffer): Use buffer-live-p here to set a good example,
+ though it isn't really needed here.
+ (erc-away): Mention erc-away-time.
+ (erc): Don't propagate the erc-away setting, since it makes more
+ sense to access it from the server buffer. Set up the prompt
+ before connecting rather than after. Run erc-connect-pre-hook
+ with the buffer as an argument, instead of no arguments.
+ (erc-cmd-GAWAY): Use erc-open-server-buffer-p instead of
+ erc-server-buffer-p so that only open connections are set away.
+ (erc-cmd-GQUIT): Use erc-open-server-buffer-p.
+ (erc-process-away): Docfix. Don't set erc-away in channel
+ buffers.
+ (erc-set-current-nick): Make this uniform with the style used in
+ erc-current-nick.
+ (erc-away-time): Rename from erc-away-p, since this is no longer a
+ boolean-style predicate.
+ (erc-format-away-status): Use it.
+ (erc-initialize-log-marker): Accept a `buffer' argument.
+ (erc-connect-pre-hook): Docfix.
+ (erc-connection-established): Make sure this runs in the correct
+ buffer.
+ (erc-set-initial-user-mode): Accept a `buffer' argument.
+
+ * erc-stamp.el (erc-add-timestamp): Use erc-away-time.
+
+ * erc-spelling.el (erc-spelling-init): Use
+ erc-with-server-buffer. Accept `buffer' argument.
+ (spelling): Call erc-spelling-init with the `buffer' argument.
+
+ * erc-speedbar.el (erc-speedbar-buttons): Use erc-server-buffer-p.
+
+ * erc-pcomplete.el (pcomplete/erc-mode/UNIGNORE)
+ (pcomplete-erc-all-nicks): Use erc-with-server-buffer.
+
+ * erc-notify.el (erc-notify-timer, erc-cmd-NOTIFY): Use
+ erc-with-server-buffer.
+
+ * erc-networks.el (erc-network, erc-current-network)
+ (erc-network-name): Use erc-with-server-buffer.
+
+ * erc-netsplit.el (erc-cmd-WHOLEFT): Use erc-with-server-buffer.
+
+ * erc-match.el (erc-log-matches, erc-log-matches-come-back): Use
+ erc-away-time.
+
+ * erc-log.el (log): Use erc-away-time. Remove unnecessary check.
+ Pass `buffer' argument to erc-log-setup-logging instead of setting
+ the current buffer. Ditto for erc-log-disable-logging.
+ (erc-log-setup-logging, erc-log-disable-logging): Accept a `buffer'
+ argument.
+
+ * erc-list.el (erc-chanlist): Use erc-with-server-buffer.
+
+ * erc-ibuffer.el (erc-away): Use erc-away-time.
+
+ * erc-dcc.el (erc-dcc-get-filter): Temporarily make the buffer
+ read only instead of permanently doing so.
+
+ * erc-compat.el (erc-gensym, *erc-sym-counter*): Remove, since
+ Emacs Lisp has make-symbol, which is better.
+
+ * erc-chess.el (erc-chess-handler, erc-cmd-CHESS): Use
+ erc-with-server-buffer.
+
+ * erc-capab.el (capab-identify): Only deal with server buffers
+ that have an open IRC process.
+ (erc-capab-identify-add-prefix): Use erc-with-server-buffer.
+
+ * erc-backend.el (erc-server-connected): Docfix. Recommend the
+ `erc-server-process-alive' function.
+ (erc-coding-system-for-target): Supply a default target if one is
+ not given.
+ (erc-server-send): Simplify slightly.
+ (erc-call-hooks): Use erc-with-server-buffer.
+ (erc-server-connect, erc-server-setup-periodical-ping): Accept
+ `buffer' argument.
+
+ * erc-autoaway.el (erc-autoaway-reestablish-idletimer): Move
+ higher to avoid an automatic load snafu.
+ (erc-autoaway-some-server-buffer): New function that returns an
+ ERC server buffer with a live connection, or nil otherwise.
+ (erc-autoaway-insinuate-maybe): New function that adds the
+ autoaway reset function to post-command-hook if at least one ERC
+ process is alive.
+ (erc-autoaway-remove-maybe): New function that removes the
+ autoaway reset function from post-command-hook if no ERC process
+ is alive.
+ (autoaway): Don't touch post-command-hook unless an IRC process is
+ already open. Remove our addition to post-command-hook as soon as
+ there are no more IRC processes open. Reset the indicators before
+ connecting to an IRC server, which fixes a bug when re-connecting.
+ (erc-autoaway-reset-idle-user): Call erc-autoaway-remove-maybe if
+ there are no more IRC processes open.
+ (erc-autoaway-set-back): Pick an open IRC process. Accept an
+ argument which is a function call if we can't find one.
+ (erc-autoaway-some-open-server-buffer): New function which returns
+ an ERC server buffer with an open connection and a user that is
+ not away.
+ (erc-autoaway-possibly-set-away, erc-autoaway-set-away): Use it.
+ (erc-autoaway-set-away): Accept a `notest' argument which is used
+ to avoid testing the same thing twice.
+ (erc-autoaway-last-sent-time, erc-autoaway-caused-away): Move
+ higher in file to fix byte-compile warning.
+
+2006-08-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (erc-process-sentinel-1): Doc fix. Let
+ `erc-server-reconnect-p' check all condition cases.
+ (erc-server-reconnect-p): Moved rest of checks from
+ `erc-process-sentinel-1' to here. Now takes an argument, EVENT.
+
+2006-08-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el: Updated copyright years. Removed EmacsWiki URL.
+ (erc-menu-definition): Name the menu "ERC" instead of "IRC" to
+ avoid confusion with rcirc and other clients.
+
+ * erc-backend.el (erc-server-banned): New variable.
+ (erc-server-connect): Set `erc-server-banned' to nil.
+ (erc-process-sentinel-1): Use `erc-server-reconnect-p'.
+ (erc-server-reconnect-p): New function. Return non-nil if the
+ user wants automatic reconnects and if the user has not been
+ banned from the server. This should fix a bug where ERC gets into
+ a loop trying to reconnect with no way to stop it when the user is
+ denied access to the server due to a server ban. It might also
+ help when Tor users are blocked from freenode if freenode servers
+ send the 465 message before disconnecting.
+ (465): Handle "banned from server" error notices.
+
+2006-08-13 Romain Francoise <romain@orebokech.com>
+
+ * erc-match.el (erc-log-matches-make-buffer): End `y-or-n-p'
+ prompt with a space.
+
+2006-08-13 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-timed-out): New variable that
+ indicates whether the current connection has timed out due to
+ failure to respond to a ping.
+ (erc-server-send-ping): Set erc-server-timed-out to t.
+ (erc-server-connect): Initialize erc-server-timed-out to nil.
+ (erc-process-sentinel-1): Consult erc-server-timed-out.
+
+2006-08-11 Michael Olson <mwolson@gnu.org>
+
+ * erc-fill.el (erc-fill): Skip any initial empty lines so that we
+ avoid errors when inserting disconnect messages and other messages
+ that begin with newlines.
+
+2006-08-07 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-process-sentinel-1): Use erc-display-message
+ in several places instead of inserting text.
+ (erc-process-sentinel): Move to the input-marker before removing
+ the prompt.
+
+ * erc.el (erc-port): Fix customization options.
+ (erc-display-message): Handle null type explicitly. Previously,
+ this was relying on a chance side-effect. Cosmetic indentation
+ tweak.
+ (english): Add 'finished and 'terminated entries to the catalog.
+ Add initial and terminal newlines to 'disconnected and
+ 'disconnected-noreconnect entries. Avoid long lines.
+ (erc-cmd-QUIT): Bind the current erc-server-process to
+ server-proc. If the IRC server responds quickly, it is possible
+ for the connection to close, and hence server buffer to be killed,
+ if erc-kill-server-buffer-on-quit is non-nil. This avoids that
+ problem.
+
+2006-08-06 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-send-queue): Update from Circe
+ version of this function.
+ (erc-server-ping-timer-alist): New variable that keeps track of
+ ping timers according to their associated server.
+ (erc-server-last-received-time): New variable that specifies the
+ time of the last message we received from the server. This is
+ used to detect hung processes.
+ (erc-server-send-ping): New function that sends a ping to the IRC
+ process corresponding with the given buffer. Split from
+ erc-server-setup-periodical-ping. If the server buffer no longer
+ exists, cancel the timer. If the server process has not given us
+ a message, including PING responses, since the last PING, kill it.
+ This is necessary to deal with some aberrant freenode behavior.
+ Idea taken from rcirc.
+ (erc-server-setup-periodical-ping): Rename from
+ erc-server-setup-periodical-server-ping.
+ (erc-server-filter-function): Use erc-current-time instead of
+ current-time.
+
+ * erc.el (erc-arrange-session-in-multiple-windows): Fix bug with
+ multi-tty Emacs.
+ (erc-select-startup-file): Fix bug introduced by recent change.
+ (erc-cmd-QUIT): If the IRC process has not terminated itself
+ within 4 seconds of completing our quit-hook, kill it manually.
+ Freenode in particular needs this.
+ (erc-connection-established): Use erc-server-setup-periodical-ping
+ instead of erc-server-setup-periodical-server-ping.
+
+2006-08-05 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-log-standardize-name): New function that returns
+ a filename that is safe for use for a log file.
+ (erc-current-logfile): Use it.
+
+ * erc.el (erc-startup-file-list): Search in ~/.emacs.d first,
+ since that is a fairly standard directory.
+ (erc-select-startup-file): Re-write to use
+ convert-standard-filename, which will ensure that MS-DOS systems
+ look for the _ercrc.el file.
+
+2006-08-02 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Release ERC 5.1.4.
+
+ * Makefile, NEWS, erc.texi: Update for the 5.1.4 release.
+
+ * erc.el (erc-active-buffer): Fix bug that caused messages to go
+ to the wrong buffer. Thanks to offby1 for the report.
+
+ * erc-backend.el (erc-coding-system-for-target): Handle case where
+ target is nil. Thanks to Kai Fan for the patch.
+
+2006-07-29 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-log-setup-logging): Don't offer to save the
+ buffer. It will be saved automatically killed. Thanks to Johan
+ Bockgård and Tassilo Horn for pointing this out.
+
+2006-07-27 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (define-erc-module): Make find-function and find-variable
+ find the names constructed by `define-erc-module' in Emacs 22.
+
+2006-07-14 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (log): Make sure that we enable logging on
+ already-opened buffers as well, in case the user toggles this
+ module after loading ERC. Also be sure to remove logging ability
+ from all ERC buffers when the module is disabled.
+ (erc-log-setup-logging): Set buffer-file-name to nil rather than
+ the empty string. This should fix some errors that occur when
+ quitting Emacs without first killing all ERC buffers.
+ (erc-log-disable-logging): New function that removes the logging
+ ability from the current buffer.
+
+ * erc-spelling.el (spelling): Use dolist and buffer-live-p.
+
+2006-07-12 Michael Olson <mwolson@gnu.org>
+
+ * erc-match.el (erc-log-matches): Bind inhibit-read-only rather
+ than call toggle-read-only.
+
+ * erc.el (erc-handle-irc-url): Move here from erc-goodies.el and
+ add autoload cookie.
+
+2006-07-09 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Release ERC 5.1.3.
+
+ * erc.texi: Update for the 5.1.3 release.
+
+ * erc-autoaway.el (erc-autoaway-set-back): Fix bug after returning
+ from being set automatically away and current buffer is not an ERC
+ buffer.
+
+ * erc-identd.el: Fix compiler error.
+
+ * erc.texi (Development): Use @subheading instead of @subsection.
+ (Advanced Usage): Add menu.
+ (Connecting): Fully document how to connect to an IRC server.
+ (Options, Tips and Tricks, Sample Configuration): New unwritten
+ sections.
+
+ * erc.el (erc-server, erc-port, erc-nick, erc-nick-uniquifier)
+ (erc-user-full-name, erc-password): Docfixes and customization
+ interface tweaks.
+ (erc-try-new-nick-p): Rename from
+ `erc-manual-set-nick-on-bad-nick-p' and invert meaning.
+ (erc-nickname-in-use): Use `erc-try-new-nick-p'. Check the length
+ of `erc-nick-uniquifier', in case someone wants multiple
+ characters.
+ (erc-compute-server, erc-compute-nick, erc-compute-full-name)
+ (erc-compute-port): Docfixes.
+
+ * erc-log.el (log): Move all add-hook calls here, rather than
+ executing them immediately, and also cause them to be un-hooked
+ when the module is removed.
+ (erc-save-buffer-on-part): Move next to
+ `erc-save-queries-on-quit'.
+ (erc-save-buffer-on-quit, erc-save-queries-on-quit): Default to t.
+ (erc-log-write-after-send, erc-log-write-after-insert): Default to
+ nil. This makes things fast, but reasonably failsafe, by default.
+
+2006-07-08 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-log-insert-log-on-open): Make this nil by
+ default, since most IRC clients don't do this.
+ (erc-log-write-after-send): New option that determines whether the
+ log file will be written to after every sent message.
+ (erc-log-write-after-insert): New option that determines whether
+ the log file will be written to when new text is added to a logged
+ ERC buffer.
+ (log): Use the aforementioned options.
+
+ * erc.texi (Modules): Document the "completion" module.
+
+ * erc-pcomplete.el (pcomplete-erc-nicks): Make sure that we don't
+ have a nil element in the list when ignore-self is non-nil.
+
+2006-07-05 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-modules): Use `set' instead of `set-default', since
+ this setting should never be buffer-local. Add the `page' module
+ to the list.
+
+ * erc.texi (Modules): Add entries for `list' and `page' modules.
+ Change "spell" to "spelling".
+ (History): Use past tense throughout.
+
+2006-07-02 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-call-hooks): Fix (stringp nil) error that
+ can happen when doing /PART.
+
+ * erc.el (erc-quit-reason-various-alist)
+ (erc-part-reason-various-alist): In the example, use "^$" as an
+ example, since "" matches anything.
+ (erc-quit-reason-various, erc-part-reason-various): If no argument
+ is given, and no matches are found, use our default reason instead
+ of "nil".
+
+2006-06-30 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi (Modules): Mention identd.
+ (Releases): Update mailing list address and download location.
+ (Development): Refactor. Provide updated directions for Arch.
+ Make URLs clickable.
+ (Keystroke Summary): Typo fix. Use more Texinfo syntax.
+ (Getting Started): Give simpler example. We do not need to
+ explicitly load every module.
+ (History): Update.
+
+ * erc-autoaway.el, erc-join.el, erc-backend.el, erc-bbdb.el:
+ erc-button.el, erc-chess.el, erc-compat.el, erc-hecomplete.el:
+ erc-dcc.el, erc-ezbounce.el, erc-fill.el, erc-ibuffer.el:
+ erc-imenu.el, erc-list.el, erc-log.el, erc-match.el, erc-menu.el:
+ erc-networks.el, erc-netsplit.el, erc-nicklist.el:
+ erc-services.el, erc-pcomplete.el, erc-replace.el, erc-ring.el:
+ erc-speedbar.el, erc-spelling.el, erc-stamp.el, erc-track.el:
+ erc.el: Remove version strings.
+
+ * erc.el (erc-cmd-SMV): Remove, since we do not have meaningful
+ module versions anymore.
+ (erc-version-modules): Remove, since we do not use this function
+ anymore.
+ (erc-latest-version, erc-ediff-latest-version): Remove, since this
+ was only useful back when ERC consisted of one file.
+ (erc-modules): Add line for identd.
+ (erc-get-channel-mode-from-keypress): Typo fix.
+
+ * erc-imenu.el: Remove unnecessary lines in header.
+
+ * erc-goodies.el (erc-handle-irc-url): Docfix.
+
+ * erc-identd.el: Define an ERC module for this.
+ (erc-identd-start): Don't create a process buffer if possible.
+ Otherwise, use conventional hidden names for process buffers.
+
+2006-06-29 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-coding-system-for-target): Match
+ case-insensitively. Use a pattern match instead of `assoc', as
+ per the documentation for `erc-encoding-coding-alist'.
+
+ * erc-track.el (erc-track-shorten-aggressively): Fix typo.
+
+2006-06-27 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Update maintainer information and URLs.
+
+2006-06-14 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-active-buffer): If the active buffer has been
+ deleted, default to the server buffer.
+ (erc-toggle-flood-control): When the user hits C-c C-f, make flood
+ control really toggle, not unconditionally turn off.
+
+2006-06-12 Michael Olson <mwolson@gnu.org>
+
+ * NEWS: Add items since the 5.1.2 release.
+
+ * erc-autoaway.el (erc-autoaway-caused-away): New variable that
+ indicates whether the current away status was caused by this
+ module.
+ (erc-autoaway-set-back): Only set back if this module set the user
+ away.
+ (erc-autoaway-set-away): Update `erc-autoaway-caused-away'.
+ (erc-autoaway-reset-indicators): New function that resets some
+ indicators when the user is no longer away.
+ (autoaway): Add the above function to the 305 hook.
+
+2006-06-05 Romain Francoise <romain@orebokech.com>
+
+ * erc.texi (History): Fix various typos.
+
+2006-06-04 Michael Olson <mwolson@gnu.org>
+
+ * erc-autoaway.el (erc-autoaway-idle-method): Move after the
+ definition of the autoaway module.
+ (autoaway): Don't do anything if erc-autoaway-idle-method is
+ unbound. This prevents an error on startup.
+
+2006-06-03 Michael Olson <mwolson@gnu.org>
+
+ * erc-autoaway.el: Thanks to Mark Plaksin for the ideas and patch.
+ (erc-autoaway-idle-method): Renamed from
+ `erc-autoaway-use-emacs-idle'. We have more than two choices for
+ how to do this, so it's best to make this take symbol values.
+ Improve documentation. Remove warning against Emacs idle-time;
+ the point is moot now that we get user idle time via a different
+ method. Make sure we disable and re-enable the module when
+ changing this value.
+ (autoaway): Conditionalize on the above option. If using the idle
+ timer or user idle methods, don't add anything to the
+ send-completed or server-001 hooks, since it is unnecessary.
+ (erc-autoaway-reestablish-idletimer, erc-autoaway-message):
+ Docfix.
+ (erc-autoaway-idle-seconds): Use erc-autoaway-idle-method.
+ (erc-autoaway-reset-idle-irc): Renamed from
+ `erc-autoaway-reset-idle'. Don't pass line to
+ `erc-autoaway-set-away', since it is not used.
+ (erc-autoaway-reset-idle-user): New function that resets the idle
+ state for user idle time.
+ (erc-autoaway-set-back): Remove line argument, since it is not
+ used.
+
+2006-06-01 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-buffer-filter): Make sure all buffers returned from
+ this are live.
+
+2006-05-01 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-goodies.el (erc-handle-irc-url): New function, suitable as
+ a value for `url-irc-function'.
+
+2006-04-18 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-pcomplete.el (pcomplete-erc-nicks): Added new optional
+ argument IGNORE-SELF. If this is non-nil, don't return the user's
+ current nickname. Doc fix.
+ (pcomplete/erc-mode/complete-command): Don't complete the current
+ nickname.
+
+2006-04-05 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-cmd-SV): Removed the exclamation point. Show the
+ build date as it's shown in `emacs-version'.
+
+ * erc-capab.el (erc-capab-identify-add-prefix): Insert the prefix
+ with the same face property as the previous character.
+
+2006-04-02 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el, erc-ezbounce.el, erc-join.el, erc-netsplit.el,
+ erc.el: Make sure to include a newline inside of negated classes,
+ so that a newline is not matched.
+
+2006-04-01 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-server-connect-function): Don't try to
+ detect the existence of the `open-network-stream-nowait' function,
+ since I can't find it in Emacs21, XEmacs21, or Emacs22.
+
+2006-03-27 Michael Olson <mwolson@gnu.org>
+
+ * erc.texi: Update direntry. Remove unneeded local variables.
+
+2006-03-26 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-header-line): New face that will be used to colorize
+ the text of the header-line, provided that
+ `erc-header-line-face-method' is non-nil.
+ (erc-prompt-face): Fix formatting.
+ (erc-header-line-face-method): New option that determines the
+ method used for colorizing header-line text. This may be a
+ function, nil, or non-nil.
+ (erc-update-mode-line-buffer): Use the aforementioned option and
+ face to colorize the header-line text, if that is what the user
+ wants.
+ (erc-send-input): If flood control is not activated, don't split
+ the input line.
+
+2006-03-25 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-cmd-QUOTE): Install patch from Aravind Gottipati
+ that fixes the case where there is no leading whitespace. Only
+ remove the first space character, though.
+
+ * erc-identd.el (erc-identd-start): Fix a bug by making sure that
+ erc-identd-process is set properly.
+ (erc-identd-start, erc-identd-stop): Add autoload cookies.
+ (erc-identd-start): Pass :host parameter so this works with Emacs
+ 22.
+
+2006-03-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-keymap): Use <backtab> rather than
+ <C-tab> for `erc-button-previous' as it is a more standard key
+ binding for this type of function.
+
+2006-02-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-capab.el: Removed things that were accidentally committed on
+ 2006-02-20. Removed Todo section.
+ (erc-capab-unidentified): Removed.
+
+2006-02-26 Michael Olson <mwolson@gnu.org>
+
+ * erc-capab.el: Use (eval-when-compile (require 'cl)).
+ (erc-capab-unidentified): Fix compiler warning by specifying
+ group.
+
+2006-02-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-capab.el (erc-capab-send-identify-messages): Fixed comment
+ to explain thoughts better. `erc-server-parameters' is an
+ associated list when it's set, not a string.
+
+2006-02-19 Michael Olson <mwolson@gnu.org>
+
+ * erc-capab.el (erc-capab-send-identify-messages): Make sure some
+ parameters are strings before using them. Thanks to Alejandro
+ Benitez for the report.
+
+ * erc.el (erc-version-string): Release ERC 5.1.2.
+
+2006-02-19 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-keymap): Bind `erc-button-previous' to
+ <C-tab>.
+ (erc-button-previous): New function.
+
+2006-02-15 Michael Olson <mwolson@gnu.org>
+
+ * NEWS: Add category for ERC 5.2.
+
+ * erc.el (erc): Move to the end of the buffer when a continued
+ session is detected. Thanks to e1f and indio for the report and
+ testing a potential fix.
+
+2006-02-14 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: Prepare a new Debian package.
+
+ * Makefile (debprepare): New rule that creates an ERC snapshot
+ directory for use in both new Debian releases and revisions for
+ Debian packages.
+ (debrelease, debrevision-mwolson): Use debprepare.
+
+ * NEWS: Bring up-to-date.
+
+ * erc-stamp.el (erc-insert-timestamp-right): For now, put
+ timestamps before rather than after erc-fill-column when
+ erc-timestamp-right-column is nil. This way we won't surprise
+ anyone unpleasantly, or so it is hoped.
+
+2006-02-13 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el: Use (eval-when-compile (require 'cl)).
+
+2006-02-12 Michael Olson <mwolson@gnu.org>
+
+ * erc-autoaway.el, erc-dcc.el, erc-ezbounce.el, erc-fill.el
+ * erc-goodies.el, erc-hecomplete.el, erc-ibuffer.el, erc-identd.el
+ * erc-imenu.el, erc-join.el, erc-lang.el, erc-list.el, erc-log.el
+ * erc-match.el, erc-menu.el, erc-netsplit.el, erc-networks.el
+ * erc-notify.el, erc-page.el, erc-pcomplete.el, erc-replace.el
+ * erc-ring.el, erc-services.el, erc-sound.el, erc-speedbar.el
+ * erc-spelling.el, erc-track.el, erc-truncate.el, erc-xdcc.el:
+ Add 2006 to copyright years, to comply with the changed guidelines.
+
+2006-02-11 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-update-modules): Handle erc-capab-identify
+ correctly. Make some requirements shorter, so that it's easier to
+ see why they are needed.
+
+ * erc-capab.el: Add autoload cookie for capab-identify.
+ (erc-capab-send-identify-messages, erc-capab-identify-activate):
+ Minor whitespace fix in code.
+
+ * erc-stamp.el (erc-timestamp-use-align-to): Renamed from
+ `erc-timestamp-right-align-by-pixel'. Set the default based on
+ whether we are in Emacs 22, and using X. Improve documentation.
+ (erc-insert-aligned): Remove calculation of offset, since
+ :align-to pos works after all. Unlike the previous solution, this
+ one works when erc-stamp.el is compiled.
+ (erc-insert-timestamp-right): Don't add length of string, and then
+ later remove its displayed width. This puts timestamps after
+ erc-fill-column when erc-timestamp-right-column is nil, rather
+ than before it. It also fixes a subtle bug. Remove use of
+ `current-window', since there is no variable by that name in
+ Emacs21, Emacs22, or XEmacs21 beta. Check to see whether
+ `erc-fill-column' is non-nil before using it.
+
+2006-02-11 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list.el: Define `list' module which sets the alias
+ `erc-cmd-LIST' to `erc-list-channels' when enabled and
+ `erc-list-channels-simple' when disabled.
+ (erc-list-channels): Was `erc-cmd-LIST', renamed.
+ (erc-list-channels-simple): New function.
+
+ * erc.el (erc-modules): Added `list' to enabled modules. Changed
+ `capab-identify' description. Moved customization options left in
+ source code.
+
+ * erc-menu.el (erc-menu-definition): Use `erc-list-channels'.
+
+ * erc-capab.el: Put a little more detail into Usage section.
+ (define-erc-module): Run `erc-capab-identify-setup' in all open
+ server buffers when enabling.
+ (erc-capab-identify-setup): Make PROC and PARSED optional
+ arguments.
+ (erc-capab-identify-add-prefix): Simplified nickname regexp. This
+ should now also match nicknames that are formatted differently
+ than the default.
+
+ * erc-spelling.el (define-erc-module): Make sure there's a buffer
+ before calling `with-current-buffer'.
+
+2006-02-10 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (debbuild): Split from debrelease.
+ (debrevision-mwolson): New rule that causes a Debian revision to
+ be built.
+
+ * erc.el (erc-migrate-modules): Use a better algorithm. Thanks to
+ Johan Bockgård.
+ (erc-modules): Change use of 'pcomplete to 'completion.
+
+2006-02-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-get-parsed-vector, erc-get-parsed-vector-nick)
+ * erc-capab.el: Require erc.
+ (erc-capab-send-identify-messages): Use `erc-server-send'.
+ (erc-capab-identify-remove/set-identified-flag): Use 1 and 0 as
+ the flags so we can also check whether the `erc-identified' text
+ property is there at all.
+ (erc-capab-identify-add-prefix): Use `erc-capab-find-parsed'.
+ This fixes a bug where the prefix wasn't inserted when timestamps
+ are inserted on the right. Tweaked nickname regexp.
+ (erc-capab-find-parsed): New function.
+ (erc-capab-get-unidentified-nickname): Updated to check for 0
+ flag. Only get nickname if there's a nickuserhost associated with
+ this message.
+
+ * erc-capab.el: New file. Adds the new module
+ `erc-capab-identify', which allows flagging of unidentified users
+ on servers running an ircd based on dancer - irc.freenode.net, for
+ example.
+
+ * erc.el (erc-modules): Added `capab-identify' to options.
+ (erc-get-parsed-vector, erc-get-parsed-vector-nick)
+ (erc-get-parsed-vector-type): Moved here from erc-match.el.
+
+ * erc-match.el (erc-get-parsed-vector, erc-get-parsed-vector-nick)
+ (erc-get-parsed-vector-type): Moved these functions to erc.el
+ since they can be useful outside of the text matching module.
+
+ * NEWS: Added erc-capab.el.
+
+ * erc-dcc.el, erc-stamp.el, erc-xdcc.el: Changed "Emacs IRC Client"
+ to "ERC".
+
+2006-02-07 Michael Olson <mwolson@gnu.org>
+
+ * ChangeLog.01, ChangeLog.02, ChangeLog.03, ChangeLog.04,
+ ChangeLog.05: Rename from ChangeLog.NNNN in order to disambiguate
+ the filenames in DOS.
+
+ * erc-goodies.el: Comment fix.
+
+ * erc-hecomplete.el: Rename from erc-complete.el. Update
+ commentary. Use define-erc-module so that it's possible to
+ actually use this.
+ (erc-hecomplete): Rename function from `erc-complete'.
+ (erc-hecomplete): Rename group from `erc-old-complete'. Docfix.
+
+ * erc-join.el: Rename from erc-autojoin.el.
+
+ * erc-networks.el: Rename from erc-nets.el.
+
+ * erc-services.el: Rename from erc-nickserv.el.
+
+ * erc-stamp.el (erc-insert-aligned): Don't take 3rd argument. Use
+ the simpler `indent-to' function when
+ `erc-timestamp-right-align-by-pixel' is nil.
+ (erc-insert-timestamp-right): If the timestamp goes on the
+ following line, don't add timestamp properties to the spaces in
+ front of it.
+
+ * erc.el (erc-migrate-modules): New function that eases migration
+ of module names.
+ (erc-modules): Call erc-migrate-modules in the :get accessor.
+ (erc-modules, erc-update-modules): Update for new modules names.
+ (erc-cmd-SMV): Remove, since this does not give useful output due
+ to the version strings being removed from ERC modules.
+
+2006-02-05 Michael Olson <mwolson@gnu.org>
+
+ * erc-spelling.el (erc-spelling-init): If
+ `erc-spelling-dictionaries' is nil, do not set
+ ispell-local-dictionary. Before, it was being set to nil, which
+ was causing a long delay while the ispell process restarted.
+ (erc-spelling-unhighlight-word): New function that removes
+ flyspell properties from a spell-checked word.
+ (erc-spelling-flyspell-verify): Don't spell-check nicks or words
+ that have '/' before them.
+
+2006-02-04 Michael Olson <mwolson@gnu.org>
+
+ * erc-autojoin.el: Use (eval-when-compile (require 'cl)).
+
+ * erc-complete.el (erc-nick-completion-exclude-myself)
+ (erc-try-complete-nick): Use better function for getting list of
+ channel users.
+
+ * erc-goodies.el: Docfix.
+
+ * erc-stamp.el: Use new arch tagline, since the other one wasn't
+ being treated properly.
+
+ * erc.el (erc-version-string): Release ERC 5.1.1.
+
+2006-02-03 Zhang Wei <id.brep@gmail.com>
+
+ * erc.el (erc-version-string): Don't hard-code Emacs version.
+ (erc-version): Use emacs-version.
+
+2006-01-31 Michael Olson <mwolson@gnu.org>
+
+ * erc-stamp.el: Update copyright years.
+
+2006-01-30 Simon Josefsson <jas@extundo.com>
+
+ * erc.el (erc-open-ssl-stream): Use tls.el.
+
+2006-01-30 Michael Olson <mwolson@gnu.org>
+
+ * erc-stamp.el (erc-timestamp-right-align-by-pixel): New option
+ that determines whether to use pixel values to align right
+ timestamps. The default is not to do so, since it only works with
+ Emacs22 on X, and even then some people have trouble.
+ (erc-insert-aligned): Use `erc-timestamp-right-align-by-pixel'.
+
+2006-01-29 Michael Olson <mwolson@gnu.org>
+
+ * ChangeLog, ChangeLog.2005, ChangeLog.2004, ChangeLog.2003,
+ ChangeLog.2002, ChangeLog.2001: Add "See ChangeLog.NNNN" line for
+ earlier changes. Use utf-8 encoding. Fix some accent typos.
+
+ * erc-speedbar.el (erc-speedbar-buttons): Fix reference to free
+ variable.
+ (erc-speedbar-goto-buffer): Fix compiler warning.
+
+ * erc-ibuffer.el: Use `define-ibuffer-filter' instead of
+ `ibuffer-define-limiter'. Use `define-ibuffer-column' instead of
+ `ibuffer-define-column'. Require 'ibuf-ext so that the macros
+ work without compiler warnings.
+
+ * erc.texi (Obtaining ERC, Installation): Note that these
+ sections may be skipped if using the version of ERC that comes
+ with Emacs.
+
+2006-01-29 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-viper.el: Remove. Now that ERC is included in Emacs, these
+ work-arounds live in Viper itself.
+
+2006-01-28 Michael Olson <mwolson@gnu.org>
+
+ * erc-*.el, erc.texi, NEWS: Add Arch taglines as per Emacs
+ guidelines.
+
+ * erc-*.el: Space out copyright years like the rest of Emacs. Use
+ the Emacs copyright statement. Refer to ourselves as ERC rather
+ than "Emacs IRC Client", since there are now several IRC clients
+ for Emacs.
+
+ * erc-compat.el (erc-emacs-build-time): Define as a variable.
+
+ * erc-log.el (erc-log-setup-logging): Use write-file-functions.
+
+ * erc-ibuffer.el: Require 'erc.
+
+ * erc-stamp.el (erc-insert-aligned): Only use the special text
+ property when window-system is X.
+
+ * erc.texi: Adapt for inclusion in Emacs.
+
+2006-01-28 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (erc-format-message): More `cl' breakage; don't use
+ `oddp'.
+
+2006-01-27 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: Update for new release.
+
+ * debian/control (Description): Update.
+
+ * debian/rules: Concatenate ChangeLog for 2005.
+
+ * Makefile (MISC): Include ChangeLog.2005 and erc.texi.
+ (debrelease, release): Copy images directory.
+
+ * NEWS: Spelling fixes. Add items for recent changes.
+
+ * erc.el (erc): Move call to erc-update-modules before the call to
+ erc-mode. This should fix a timestamp display issue.
+ (erc-version-string): Release ERC 5.1.
+
+2006-01-26 Michael Olson <mwolson@gnu.org>
+
+ * erc-stamp.el (erc-insert-aligned): New function that inserts
+ text in an perfectly-aligned way relative to the right margin. It
+ only works well with Emacs22. A sane fallback is provided for
+ other versions of Emacs.
+ (erc-insert-timestamp-right): Use the new function.
+
+2006-01-25 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el (erc-modules): Ensure that `erc-button-mode' gets enabled
+ before `erc-match-mode'.
+
+ * erc-match.el (match): Append `erc-match-message' to
+ `erc-insert-modify-hook'.
+
+2006-01-25 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE: Mark last release requirement as done.
+
+ * Makefile (realclean, distclean): Remove docs.
+
+ * erc.texi: Take care of all pre-5.1 items.
+
+ * erc-backend.el (erc-server-send, erc-server-send-queue): Wrap
+ `process-send-string' in `condition-case' to avoid an error when
+ quitting ERC.
+
+ * erc-stamp.el (erc-insert-timestamp-right): Try to deal with
+ variable-width characters in the timestamp and on the same line.
+ The latter is a kludge, but it seems to work with most of the
+ input I've thrown at it so far. It's certainly better than going
+ past the end of line consistently when we have variable-width
+ characters on the same line. When `erc-timestamp-intangible' is
+ non-nil, add intangible properties to the whitespace as well, so
+ that hitting <end> does what you'd expect.
+
+ * erc.el (erc-flood-protect, erc-toggle-flood-control): Update
+ this to only use boolean values for `erc-flood-protect'. Update
+ documentation.
+ (erc-cmd-QUIT): Set the active buffer to be the server buffer, so
+ that any QUIT-related messages go there.
+ (erc): Try to be more clever about re-using channel buffers when
+ automatically re-connecting. Thanks to e1f for noticing.
+
+2006-01-23 Michael Olson <mwolson@gnu.org>
+
+ * ChangeLog.2005: Remove erroneous line.
+
+ * FOR-RELEASE: Make that the Makefile tweaking is complete.
+ (NEWS): Mark as done.
+
+ * Makefile (MANUAL): New option indicating the name of the manual.
+ (PREFIX, ELISPDIR, INFODIR): New options that specify the
+ directories to install lisp code and info manuals to. PREFIX is
+ used only by ELISPDIR and INFODIR.
+ (all): Call `lisp' and create the manual.
+ (lisp): Compile lisp code.
+ (%.info, %.html): New rules that make Info files and HTML files,
+ respectively, from a TexInfo source.
+ (doc): Create both the Info and HTML versions of the manual. This
+ is for the user -- we never call it automatically.
+ (install-info): Install Info files.
+ (install-bin): Install compiled and source Lisp files.
+ (todo): Remove, since it seems pointless.
+
+ * NEWS: Update.
+
+ * README: Add Installation instructions. Tweak layout.
+
+ * erc.texi: Work on some pre-5.1 items.
+
+ * erc-stamp.el, erc-track.el: Move some functions and options in
+ order to get rid of a few compiler warnings.
+
+ * erc.el (erc-modules): Enable readonly by default. This will
+ prevent new users from accidentally removing old messages, which
+ could be disconcerting. Also enable stamp by default, since
+ timestamps are a fairly standard feature among IRC clients.
+
+ * erc-button.el: Munge whitespace.
+
+ * erc-identd.el (erc-identd-start): Instead of throwing an error,
+ just try to use the obsolete function.
+
+2006-01-22 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-decode-string-from-target): Make sure that
+ we have a string as an argument. If not, coerce it to the empty
+ string. Hopefully, this will work painlessly around an edge case
+ related to quitting ERC around the same time a message comes in.
+
+2006-01-22 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-track.el: Use `(eval-when-compile (require 'cl))' (for
+ `case'). Doc fixes.
+ (erc-find-parsed-property): Simplify.
+ (erc-track-get-active-buffer): Fix logic. Simplify.
+ (erc-track-switch-buffer): Remove unused variable `dir'. Simplify.
+
+ * erc-speak.el: Doc fixes.
+ (erc-speak-region): `propertize' --> `erc-propertize'.
+
+ * erc-dcc.el (erc-dcc-chat-parse-output): `propertize' -->
+ `erc-propertize'.
+
+ * erc-button.el (erc-button-add-button): Take erc-fill-prefix into
+ account when wrapping URLs.
+
+ * erc-bbdb.el (erc-bbdb-elide-display): Doc fix.
+
+ * erc-backend.el (define-erc-response-handler): Doc fix.
+
+2006-01-22 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-update-modules): Use `require' instead of `load',
+ but prevent it from causing errors, in order to preserve the
+ previous behavior.
+
+2006-01-21 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE (Source): Mark cl task as done.
+
+ * Makefile (erc-auto.el): Call erc-generate-autoloads rather than
+ generate-autoloads.
+ (erc-auto.el, %.elc): Don't show command, just its output.
+
+ * NEWS: Add items from 2005-01-01 to 2005-08-13.
+
+ * debian/copyright (Copyright): Update.
+
+ * erc-auto.in (erc-generate-autoloads): Rename from
+ generate-autoloads.
+
+ * erc.el, erc-autoaway.el, erc-backend.el: Use
+ erc-server-process-alive instead of erc-process-alive.
+
+ * erc.el, erc-backend.el, erc-ezbounce.el, erc-list.el,
+ erc-log.el, erc-match.el, erc-nets.el, erc-netsplit.el,
+ erc-nicklist.el, erc-nickserv.el, erc-notify.el, erc-pcomplete.el:
+ Use (eval-when-compile (require 'cl)), so that compilation doesn't
+ fail.
+
+ * erc-fill.el, erc-truncate.el: Whitespace munging.
+
+ * erc.el: Update copyright notice. Remove eval-after-load code.
+ (erc-with-buffer): Docfix.
+ (erc-once-with-server-event, erc-once-with-server-event-global)
+ (erc-with-buffer, erc-with-all-buffers-of-server): Use erc-gensym
+ instead of gensym.
+ (erc-banlist-update): Use erc-delete-if instead of delete-if.
+ (erc): Call `erc-update-modules' here.
+
+ * erc-backend.el: Require 'erc-compat to minimize compiler
+ warnings.
+ (erc-decode-parsed-server-response): Docfix.
+ (erc-server-process-alive): Move here from erc.el and rename from
+ `erc-process-alive'.
+ (erc-server-send, erc-remove-channel-users): Make sure process is
+ alive before sending data to it.
+
+ * erc-bbdb.el: Update copyright years.
+ (erc-bbdb-whois): Remove overexuberant comment.
+
+ * erc-button.el: Require erc-fill, since we make liberal use of
+ `erc-fill-column'.
+
+ * erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): New
+ functions, the latter of which provides an `assert' equivalent.
+ (erc-remove-if-not): New function that provides a simple
+ implementation of `remove-if-not'.
+ (erc-gensym): New function that provides a simple implementation
+ of `gensym'.
+ (erc-delete-if): New function that provides a simple
+ implementation of `delete-if'.
+ (erc-member-if): New function that provides a simple
+ implementation of `member-if'.
+ (field-end): Remove this, since it is unused, and later versions
+ of XEmacs have this function already.
+ (erc-function-arglist): Moved here from erc.el.
+ (erc-delete-dups): New compatibility function for dealing with
+ XEmacs.
+ (erc-subseq): New function copied from cl-extra.el.
+
+ * erc-dcc.el: Require pcomplete during compilation to avoid
+ compiler warnings.
+ (erc-unpack-int, erc-dcc-send-filter)
+ (erc-dcc-get-filter): Use erc-assert instead of assert.
+ (pcomplete/erc-mode/DCC): Use erc-remove-if-not instead of
+ remove-if-not.
+
+ * erc-match.el (erc-log-matches): Fix compiler warning.
+
+ * erc-nicklist.el: Update copyright notice.
+ (erc-nicklist-menu): Change use of caadr to (car (cadr ...)).
+ (erc-nicklist-bitlbee-connected-p): Remove.
+ (erc-nicklist-insert-medium-name-or-icon): Accept channel
+ argument. Use it to determine whether we are on bitlbee. Now
+ that bitlbee names its channel "&bitlbee", this is trivial.
+ (erc-nicklist-insert-contents): Pass channel as specified above.
+ Don't try to determine whether we are on bitlbee here.
+ (erc-nicklist-channel-users-info): Use erc-remove-if-not instead
+ of remove-if-not.
+ (erc-nicklist-search-for-nick): Use erc-member-if instead of
+ member-if.
+
+ * erc-notify.el (erc-notify-QUIT): Use erc-delete-if with a
+ partially-evaluated lambda expression instead of `delete' and
+ `find'.
+
+ * erc-track.el: Use erc-assert.
+ (erc-track-modified-channels): Remove use of `return'.
+ (erc-track-modified-channels): Use `cadr' instead of `second',
+ since otherwise we would need yet another eval-when-compile line.
+
+2006-01-19 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-process-sentinel-1): Remove attempt to
+ detect SIGPIPE, since it doesn't work.
+
+2006-01-10 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-spelling.el: Updated copyright years.
+ (define-erc-module): Enable/disable `flyspell-mode' for all open
+ ERC buffers as well.
+ (erc-spelling-dictionaries): Reworded customize description.
+
+ * erc.el (erc-command-symbol): New function.
+ (erc-extract-command-from-line): Use `erc-command-symbol'. This
+ fixes a bug where "Symbol's function definition is void:
+ erc-cmd-LIST" would be shown after typing /list at the prompt (the
+ command was interned because erc-menu.el uses it and is enabled by
+ default whereas erc-list.el is not).
+
+ * NEWS: Started a list of renamed variables.
+
+ * erc.el: Reworded the message sent when defining variable
+ aliases.
+ (erc-command-indicator-face): Doc fix.
+ (erc-modules): Enable the match module by default which makes
+ current nickname highlighting on as the default.
+
+ * erc-button.el: Updated copyright years.
+ (erc-button): New face.
+ (erc-button-face): Use `erc-button'.
+ (erc-button-nickname-face): New customizable variable.
+ (erc-button-add-nickname-buttons, erc-button-add-buttons-1): Send
+ new argument to `erc-button-add-button'.
+ (erc-button-add-button): Doc fix. Added new argument to function
+ definition, NICK-P. If it's a nickname, use
+ `erc-button-nickname-face', otherwise use `erc-button-face'. This
+ makes channel tracking and buttons work better together when
+ `erc-button-buttonize-nicks' is enabled, since there is a nickname
+ on just about every line.
+
+ * erc-track.el (erc-track-use-faces): Doc fix.
+ (erc-track-faces-priority-list): Added `erc-button' to list.
+ (erc-track-priority-faces-only): Doc fix.
+
+2006-01-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-url-regexp): Use `concat' so the
+ regexp is not one long line.
+ (erc-button-alist): Fixed so that customizing works correctly.
+ Reorganized. Removed lambda functions with more than two lines.
+ Doc fix.
+ (erc-button-describe-symbol, erc-button-beats-to-time): New
+ functions. Moved from `erc-button-alist'.
+
+2006-01-07 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-process-sentinel-1): Don't try to re-open a
+ process if a SIGPIPE occurs. This happens when a new message
+ comes in at the same time a /quit is requested.
+ (erc-process-sentinel): Use string-match rather than string= to do
+ these comparisons. Matching literal newlines makes me nervous.
+
+ * erc-track.el (erc-track-remove-from-mode-line): Handle case
+ where global-mode-string is not a list. Emacs22 permits this.
+
+2005-11-23 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (erc-cmd-SAY): Strip leading space in input line.
+
+2005-10-29 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE: Add stuff that needs to be done before the 5.1
+ release. Longer-term items can be added to the 5.2 section.
+
+ * Makefile (SITEFLAG): New variable that indicates what variant of
+ "--site-flag" to use. XEmacs needs "-site-flag".
+ (INSTALLINFO): New variable indicating how we should call
+ install-info when installing documentation.
+ (erc-auto.el, .elc.el): Use $(SITEFLAG).
+
+ * NEWS: Note that last release was 5.0.4.
+
+ * erc.texi: Initial and incomplete draft of ERC documentation.
+ Commence collaborate-documentation-hack-mode :^) .
+
+2005-10-29 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-ring.el (erc-replace-current-command): Revert last change
+ since it made the prompt disappear when using `erc-next-command'
+ and `erc-previous-command'.
+
+2005-10-28 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-input-marker): New variable that indicates the
+ position where text from the user begins, after the prompt.
+ (erc-mode-map): Bind <HOME> to erc-bol, just like C-a.
+ (erc): Initialize erc-input-marker.
+ (erc-display-prompt): Even in case where no prompt is desired by
+ the user, clear the undo buffer and set the input marker.
+ (erc-bol, erc-user-input): Simplify by using erc-input-marker.
+
+ * erc-pcomplete.el (pcomplete-parse-erc-arguments): Use
+ erc-insert-marker.
+
+ * erc-ring.el (erc-previous-command)
+ (erc-replace-current-command): Use erc-insert-marker.
+
+ * erc-spelling.el (erc-spelling-init): Make sure that even Emacs21
+ obeys erc-spelling-flyspell-verify.
+ (erc-spelling-flyspell-verify): Use erc-input-marker. This should
+ make it considerably faster when switching to a buffer that has
+ seen a lot of activity since last viewed.
+
+2005-10-25 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (erc-server-version, 004): Re-added setting of
+ `erc-server-version'. It doesn't hurt to set, and it could be
+ used in modules or users' settings.
+
+ * NEWS: Added descriptions of some new features.
+
+2005-10-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-match.el (erc-current-nick-highlight-type): Set to `keyword'
+ as default.
+ (erc-beep-match-types): New variable.
+ (erc-text-matched-hook): Doc fix. Added `erc-beep-on-match' to
+ customization options.
+ (erc-beep-on-match): New function. If the MATCH-TYPE is found in
+ `erc-beep-match-types', beep.
+
+ * erc-compat.el (erc-make-obsolete, erc-make-obsolete-variable):
+ New functions to deal with the difference in the number of
+ arguments accepted by `make-obsolete' and `make-obsolete-variable'
+ in Emacs and XEmacs.
+
+ * erc.el, erc-nets.el: Use `erc-make-obsolete' and
+ `erc-make-obsolete-variable'.
+
+ * erc-compat.el (erc-make-obsolete, erc-make-obsolete-variable):
+ Handle `wrong-number-of-arguments' error instead of checking for
+ xemacs feature as future versions of XEmacs might accept three
+ arguments.
+
+2005-10-18 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el: Tell emacs-lisp-mode how to font-lock define-erc-module
+ docstrings.
+
+2005-10-08 Diane Murray <disumu@x3y2z1.net>
+
+ * AUTHORS, CREDITS, ChangeLog, ChangeLog.2002, ChangeLog.2004:
+ Updated my email address.
+
+2005-10-06 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-send-input-line, erc-cmd-KICK, erc-cmd-PART)
+ (erc-cmd-QUIT, erc-cmd-TOPIC, erc-kill-server, erc-kill-channel):
+ Adapt to new TARGET parameter of erc-server-send.
+
+ * erc-backend.el (erc-server-connect): Don't specify encoding for
+ erc-server-process, since we set this each time we send a line to
+ the server.
+ (erc-encode-string-for-target): Remove.
+ (erc-server-send): Allow TARGET to be specified. This was how it
+ used to be before my more-backend work. Set encoding of server
+ process just before sending text to it. Associate encoding with
+ text if we are using the queue.
+ (erc-server-send-queue): Pull encoding from queue.
+ (erc-message, erc-send-ctcp-message, erc-send-ctcp-notice): Adapt
+ to new TARGET parameter of erc-server-send.
+
+2005-10-05 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-toggle-debug-irc-protocol): Use erc-view-mode-enter
+ rather than view-mode.
+
+ * erc-backend.el (erc-encode-string-for-target): If given a nil or
+ empty string, return "".
+ (erc-server-send-queue): XEmacs fix: Use erc-cancel-timer rather
+ than cancel-timer.
+
+ * erc-compat.el (erc-view-mode-enter): New function that is
+ aliased to the correct way of entering view-mode.
+
+ * erc-match.el (erc-log-matches-make-buffer): Use
+ erc-view-mode-enter rather than view-mode-enter.
+
+2005-10-05 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-backend.el (erc-encode-string-for-target): If str is nil,
+ pass the empty string to erc-encode-coding-string instead, which
+ allows one to /part and /quit without providing a reason again.
+
+2005-10-03 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-message, erc-send-ctcp-message)
+ (erc-send-ctcp-notice): Encode string for target before sending.
+
+ * erc.el (erc-cmd-KICK, erc-cmd-PART, erc-cmd-QUIT, erc-cmd-TOPIC)
+ (erc-kill-server, erc-kill-channel): Ditto.
+
+2005-09-05 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-page.el (erc-ctcp-query-PAGE): (message text) -> (message
+ "%s" text).
+ (erc-cmd-PAGE): Simplify regexp. Put `do-not-parse-args' t.
+
+2005-09-05 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-flood-limit, erc-flood-limit2): Remove since they
+ are no longer needed.
+ (erc-send-input): Detect whether we want flood control to be
+ active. The previous behavior was to always force the message.
+ (erc-toggle-flood-control): Adapt to new flood control method. No
+ more 'strict.
+ (erc-cmd-SV): Use concat rather than
+ format-time-string.
+ (erc-format-target, erc-format-target-and/or-server): Shorten
+ logic statements.
+
+ * erc-compat.el (erc-emacs-build-time): Use a string
+ representation rather than trying to coerce a time out of a string
+ on XEmacs.
+
+ * erc-identd.el (erc-identd-start): Use make-network-process
+ instead of open-network-stream. Error out if this is not defined.
+
+ * erc-backend.el (erc-send-line): New command that sends a line
+ using flood control, using a callback for display. It isn't used
+ yet.
+
+2005-09-04 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Add defvaralias and make-obsolete-variable for
+ erc-default-coding-system.
+ (channel-topic, channel-modes, channel-user-limit, channel-key,
+ invitation, away, channel-list, bad-nick): Rename globally to
+ erc-{name-of-variable}.
+
+2005-09-03 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (erc-message): Simplify regexp.
+ (erc-cmd-DEOP, erc-cmd-OP): Simplify.
+
+2005-08-29 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Alias erc-send-command to erc-server-send. ErBot needs
+ this to work without modification. Add defvaralias for
+ erc-process. Make this and the other backwards-compatibility
+ functions and variables be marked obsolete as of ERC 5.1.
+
+ * erc-backend.el: Add autoload for erc-log macro.
+ (erc-server-connect): Set some variables before defining process
+ handlers. It probably doesn't make any difference.
+
+2005-08-26 Michael Olson <mwolson@gnu.org>
+
+ * erc.el: Add defvaralias for erc-announced-server-name, since
+ this seems to be widely used.
+
+2005-08-17 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc): Remove unnecessary boundp check.
+
+ * erc-autoaway.el: Fix compiler warning.
+
+ * erc-backend.el (erc-server-version): Since this isn't used by
+ any code, and isn't generally useful, remove it.
+ (erc-server-send-queue): Use erc-current-time rather than
+ float-time.
+ (004): Don't set erc-server-version.
+
+ * erc-dcc.el (erc-dcc-chat-request, erc-dcc-get-parent): Move to
+ fix a compiler warning.
+
+ * erc-ibuffer.el (erc-server): Remove unnecessary boundp check.
+
+ * erc-identd.el (erc-identd-start): Use read-string instead of
+ read-input.
+
+ * erc-imenu.el (erc-unfill-notice): Use a while loop instead of
+ replace-regexp.
+
+ * erc-nicklist.el: Add conditional dependency on erc-bbdb.
+ (erc-nicklist-insert-contents): Tighten some regexps.
+
+ * erc-notify.el (erc-notify-list): Docfix.
+
+ * erc-spelling.el (erc-spelling-dictionaries): Add :type and
+ :group to silence a compiler warning.
+
+2005-08-14 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el (erc-session-server, erc-session-port)
+ (erc-announced-server-name, erc-server-version)
+ (erc-server-parameters): Moved here from erc.el.
+ (erc-server-last-peers): Moved, renamed from last-peers.
+ (erc-server-lag): Moved, renamed from erc-lag.
+ (erc-server-duplicates): Moved, renamed from erc-duplicates.
+ (erc-server-duplicate-timeout): Moved, renamed from
+ erc-duplicate-timeout.
+ (erc-server): New customization group hosting all options from
+ this file.
+ (erc-server-prevent-duplicates): Moved, renamed from
+ erc-prevent-duplicates.
+ (erc-server-duplicate-timeout): Moved, renamed from
+ erc-duplicate-timeout.
+ (erc-server-auto-reconnect, erc-split-line-length)
+ (erc-server-coding-system, erc-encoding-coding-alist)
+ (erc-server-connect-function, erc-server-flood-margin)
+ (erc-server-flood-penalty): Change group to 'erc-server.
+ (erc-server-send-ping-interval): Moved, renamed from
+ erc-ping-interval.
+ (erc-server-ping-handler): Moved, renamed from erc-ping-handler.
+ (erc-server-setup-periodical-server-ping): Moved, renamed from
+ erc-setup-periodical-server-ping.
+ (erc-server-connect): Add to docstring. Move more initialization
+ here.
+ (erc-server-processing-p): Docfix.
+ (erc-server-connect): Use 'raw-text like in the original version.
+ (erc-server-filter-function): Don't reset process coding system.
+
+ * erc-stamp.el (erc-add-timestamp): If the text at point is
+ invisible, don't insert a timestamp. Thanks to Pascal
+ J. Bourguignon for the suggestion.
+
+ * erc-match.el (erc-text-matched-hook): Don't hide fools by
+ default, but include it in the available options.
+
+2005-08-13 Michael Olson <mwolson@gnu.org>
+
+ * erc-*.el: s/erc-send-command/erc-server-send/g.
+ s/erc-process/erc-server-process/g (sort of). Occasional
+ whitespace and indentation fixes.
+
+ * erc-backend.el: Specify a few local variables for indentation.
+ Take one item off of the TODO list.
+ (erc-server-filter-data): Renamed from erc-previous-read. From
+ circe.
+ (erc-server-processing-p): New variable that indicates when we're
+ currently processing a message. From circe.
+ (erc-split-line-length): New option that gives the maximum line
+ length of a single message. From circe.
+ (erc-default-coding-system): Moved here from erc.el.
+ (erc-split-line): Renamed from erc-split-command and taken from
+ circe.
+ (erc-connect-function, erc-connect, erc-process-sentinel-1)
+ (erc-process-sentinel, erc-flood-exceeded-p, erc-send-command)
+ (erc-message, erc-upcase-first-word, erc-send-ctcp-message)
+ (erc-send-ctcp-notice): Moved here from erc.el.
+ (erc-server-filter-function): Renamed from erc-process-filter.
+ From circe.
+ (erc-server-process): Renamed from `erc-process' and moved here
+ from erc.el.
+ (erc-server-coding-system): Renamed from
+ `erc-default-coding-system'.
+ (erc-encoding-coding-alist): Moved here from erc.el.
+ (erc-server-flood-margin, erc-server-flood-penalty):
+ (erc-server-flood-last-message, erc-server-flood-queue):
+ (erc-server-flood-timer): New options from circe that allow
+ tweaking of flood control.
+ (erc-server-connect-function): Renamed from erc-connect-function.
+ (erc-flood-exceeded-p): Removed.
+ (erc-coding-system-for-target)
+ (erc-encode-string-for-target, erc-decode-string-from-target):
+ Moved here from erc.el
+ (erc-server-send): Renamed from erc-send-command. Adapted from
+ the circe function by the same name.
+ (erc-server-send-queue): New function from circe that implements
+ handling of a flood queue.
+ (erc-server-current-nick): Renamed from current-nick.
+ (erc-server-quitting): Renamed from `quitting'.
+ (erc-server-last-sent-time): Renamed from `last-sent-time'.
+ (erc-server-last-ping-time): Renamed from `last-ping-time'.
+ (erc-server-lines-sent): Renamed from `lines-sent'.
+ (erc-server-auto-reconnect): Renamed from `erc-auto-reconnect'.
+ (erc-server-coding-system): Docfix.
+ (erc-server-connect): Renamed from `erc-connect'. Require SERVER
+ and PORT parameters. Initialize several variables here. Don't
+ set `erc-insert-marker'. Use a per-server coding system via
+ erc-server-default-encoding.
+
+ * erc.el (erc-version-string): Changed to indicate we are running
+ the `more-backend' branch.
+ (erc-send-single-line): Implement flood control using
+ erc-split-line.
+ (erc-send-input): Move functionality of erc-send-single-line in
+ here.
+ (erc-send-single-line): Assimilated!
+ (erc-display-command, erc-display-msg): Handle display hooks.
+ (erc-auto-reconnect, current-nick, last-sent-time)
+ (last-ping-time, last-ctcp-time, erc-lines-sent, erc-bytes-sent)
+ (quitting): Moved to erc-backend.el.
+ (erc): Docfix. Don't initialize quite so many things here.
+
+2005-08-10 Michael Olson <mwolson@gnu.org>
+
+ * debian/copyright (Copyright): Remove notices for 4 people, since
+ they didn't contribute legally-significant changes, or have had
+ these changes overwritten.
+
+ * erc-log.el: Remove copyright notice.
+
+ * erc.el: Remove 3 copyright notices.
+
+2005-08-09 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: Create 5.0.4-3 package. This doesn't serve
+ any purpose other than to thank Romain Francoise for some advice.
+
+ * Makefile (debrelease): Allow last upload and extra build options
+ to be specified.
+
+2005-08-08 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: Create 5.0.4-2 package.
+
+ * debian/control (Uploaders): Add Romain Francoise.
+ (Standards-Version): Update to 3.6.2.
+ (Depends): Add `emacsen'.
+
+ * debian/scripts/startup.erc (load-path): Minor whitespace fixup.
+
+ * Makefile (clean): Split target from realclean and make it remove
+ files that aren't packaged in releases.
+ (clean, release): Minor cleanups.
+ (debrelease): Use debuild rather than dpkg-buildpackage since the
+ former calls lintian. Minor cleanups.
+ (debrelease-mwolson): New target that removes old Debian packages,
+ calls debrelease, and copies the resulting package to my dist dir.
+ (upload): New target that automates the process of uploading an
+ ERC release to sourceforge.
+
+ * erc.el (erc-mode): Use `make-local-variable' instead of
+ `make-variable-buffer-local'.
+
+2005-07-12 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: Build 5.0.4-1.
+
+ * Makefile (release): Prepare zip file in addition to tarball.
+
+ * NEWS: Add item for the undo fix.
+
+2005-07-09 Michael Olson <mwolson@gnu.org>
+
+ * erc-nicklist.el (erc-nicklist-insert-contents): Check
+ erc-announced-name before erc-session-server. Make sure that we
+ can never get a stringp (nil) error.
+ (erc-nicklist-call-erc-command): If given no command, do nothing.
+ This fixes an error that used to occur when a stray mouse click
+ was made outside of the popup window, but on the erc-nicklist
+ menu.
+
+ * erc-bbdb.el (erc-bbdb-search-name-and-create): Get rid of the
+ infinite input loop when you want to create a new record. Replace
+ most of that with a completing read of existing nicks. If no nick
+ is chosen, create a new John Doe record. The net effect of this
+ is that the old behavior is re-instated, with the addition of one
+ completing read that happens when you do a /whois.
+
+2005-07-09 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (erc-process-input-line): Docfix.
+ (erc-update-mode-line-buffer): Use `erc-propertize' instead of
+ `propertize'.
+ (erc-propertize): Move to erc-compat.el.
+
+ * erc-compat.el (erc-propertize): Move here from erc.el. Always
+ return a copy of the string (like `propertize' in GNU Emacs).
+
+ * erc-nicklist.el (erc-nicklist-icons-directory)
+ (erc-nicklist-voiced-position)
+ (erc-nicklist-insert-medium-name-or-icon): Docfix.
+ (erc-nicklist-insert-contents): Simplify.
+ (erc-nicklist-mode-map): Bind RET instead of `return'. Bind
+ `down-mouse-3' instead of `mouse-3'.
+ (erc-nicklist-kbd-cmd-QUERY): Cleanup regexp.
+ (erc-nicklist-channel-users-info): Docfix. Simplify.
+
+2005-07-02 Michael Olson <mwolson@gnu.org>
+
+ * images: New directory containing the images that are used by
+ erc-nicklist.el. These are from Gaim, and are thought to be
+ available under the terms of the GPL.
+
+ * erc-bbdb.el: Add local variables section to preserve tabs, since
+ that is the style used throughout this file. Apply patch from
+ Edgar Gonçalves as follows.
+ (erc-bbdb-bitlbee-name-field): New variable that indicates the
+ field name to use for annotating the "displayed name" of a bitlbee
+ contact.
+ (erc-bbdb-irc-highlight-field): Docfix.
+ (erc-bbdb-search-name-and-create): Prompt the user for the name of
+ a contact if none was found. Merge the new entries into the
+ specified contact. If new arg SILENT is non-nil, do not prompt
+ the user for a name or offer to merge the new entry.
+ (erc-bbdb-insinuate-and-show-entry): New arg SILENT is accepted,
+ which is passed on to erc-bbdb-search-name-and-create.
+ (erc-bbdb-whois): Tell erc-bbdb-search-name-and-create to prompt
+ for name if necessary.
+ (erc-bbdb-JOIN, erb-bbdb-NICK): Forbid
+ erc-bbdb-search-name-and-create from prompting for a name.
+
+ * erc-nicklist.el: Add local variables section to preserve tabs,
+ since that is the style used throughout this file. Apply patch
+ from Edgar Gonçalves as follows.
+ (erc-nicklist-use-icons): New option; if non-nil, display an icon
+ instead of the name of the chat medium.
+ (erc-nicklist-icons-directory): New option indicating the path to
+ the PNG files that are used for chat icons.
+ (erc-nicklist-use-icons): New option indicating whether to put
+ voiced nicks on top, bottom, or not to differentiate them. The
+ default is to put them on the bottom.
+ (erc-nicklist-bitlbee-connected-p): New variable that indicates
+ whether or not we are currently using bitlbee. An attempt will be
+ made to auto-detect the proper value. This is bound in the
+ `erc-nicklist-insert-contents' function.
+ (erc-nicklist-nicklist-images-alist): New variable that maps a
+ host type to its icon. This is set by `erc-nicklist'.
+ (erc-nicklist-insert-medium-name-or-icon): New function that
+ inserts an icon or string that identifies the current host type.
+ (erc-nicklist-search-for-nick): New function that attempts to find
+ a BBDB record that corresponds with this contact given its
+ finger-host. If found, return its bitlbee-nick field.
+ (erc-nicklist-insert-contents): New function that inserts the
+ contents of the nick list, including text properties and images.
+ (erc-nicklist): Populate `erc-nicklist-images-alist'. Move
+ nicklist content generation code to
+ `erc-nicklist-insert-contents'.
+ (erc-nicklist-mode-map): Map C-j to erc-nicklist-kbd-menu and RET
+ to erc-nicklist-kbd-cmd-QUERY.
+ (erc-nicklist-call-erc-command): Make use of
+ `switch-to-buffer-other-window'.
+ (erc-nicklist-cmd-QUERY): New function that opens a query buffer
+ for the given contact.
+ (erc-nicklist-kbd-cmd-QUERY): Ditto; contains most of the code.
+ (erc-nicklist-kbd-menu): New function that shows the nicklist
+ action menu.
+ (erc-nicklist-channel-users-info): Renamed from
+ `erc-nicklist-channel-nicks'. Implement sorting voiced users.
+
+2005-06-29 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc-nickserv.el (erc-nickserv-alist): Fix regexp for Azzurra.
+
+2005-06-26 Michael Olson <mwolson@gnu.org>
+
+ * erc-autojoin.el (erc-autojoin-add, erc-autojoin-remove): Use
+ `erc-session-server' if `erc-announced-server-name' is nil. This
+ happens when servers don't send a 004 message.
+
+ * erc.el (erc-quit-server): Ditto.
+
+ * erc-ibuffer.el (erc-server, erc-server-name): Ditto.
+
+ * erc-notify.el (erc-notify-JOIN, erc-notify-NICK)
+ (erc-notify-QUIT): Ditto.
+
+2005-06-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (erc-default-coding-system)
+ (erc-handle-user-status-change): Docstring fix.
+ (with-erc-channel-buffer): Removed.
+ (erc-ignored-reply-p): Replace `with-erc-channel-buffer' with
+ `erc-with-buffer'.
+ (erc-display-line-1): Fix broken undo.
+
+2005-06-23 Michael Olson <mwolson@gnu.org>
+
+ * CREDITS: Add entries for Luigi Panzeri and Andreas Schwab.
+
+ * erc-nickserv.el (erc-nickserv-alist): Add entries for Azzurra
+ and OFTC. Thanks to Luigi Panzeri and Andreas Schwab for
+ providing these.
+
+2005-06-16 Michael Olson <mwolson@gnu.org>
+
+ * CREDITS: Add John Paul Wallington.
+
+ * erc.el: Thanks to John Paul Wallington for the following.
+ (erc-nickname-in-use): Use `string-to-number' instead of
+ `string-to-int'.
+
+ * erc-dcc.el (erc-dcc-handle-ctcp-send)
+ (erc-dcc-handle-ctcp-chat, erc-dcc-get-file)
+ (erc-dcc-chat-accept): Ditto.
+
+ * erc-identd.el (erc-identd-start): Ditto.
+
+2005-06-16 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (erc-mode-map): Suppress `font-lock-fontify-block' key
+ binding since it destroys face properties.
+
+2005-06-08 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-cmd-UNIGNORE): Use `erc-member-ignore-case' instead
+ of `member-ignore-case'. Thanks to bpalmer for the heads up.
+
+2005-06-06 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-modules): Fix a mistake I made when editing this a
+ few days ago. Modes should now be disabled properly.
+ (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Remove unnecessary call to
+ `format'. Thanks to Andreas Schwab for reporting this.
+
+ * debian/changelog: Close "README file missing" bug.
+
+ * debian/rules (binary-erc): Install README file.
+
+2005-06-03 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-with-buffer): Set `lisp-indent-function' so Emacs
+ Lisp mode knows how to indent erc-with-buffer blocks.
+ (with-erc-channel-buffer): Ditto.
+ (erc-with-all-buffers-of-server): Ditto.
+ (erc-modules): Use pcomplete by default, not completion, since
+ erc-complete.el is deprecated. Use `fboundp' instead of
+ `symbol-value' to check for existence of a function before calling
+ it. This was causing an error when untoggling the `completion'
+ option and trying to save via the customize interface.
+
+ * erc-track.el (erc-modified-channels-update): If a buffer is not
+ currently connected, remove it from the modified channels list.
+ This should fix the problem where residue was left on the mode
+ line after quitting ERC.
+
+ * erc-list.el (erc-prettify-channel-list): Docfix; thanks to John
+ Paul Wallington for reporting this.
+
+2005-05-31 Michael Olson <mwolson@gnu.org>
+
+ * debian/changelog: First draft of entries for the 5.0.3 release.
+
+ * debian/README.Debian: Note that ERC will now install correctly
+ on versions of Emacs or XEmacs that do not have the `format-spec'
+ library. Correct some grammar and prune the content a bit.
+
+ * debian/scripts/install (emacs20): Remove line since we no longer
+ need to deal with format-spec.el.
+
+ * NEWS: Add entries for the upcoming 5.0.3 release.
+
+ * erc.el: Don't require format-spec since this is provided in
+ erc-compat.el now.
+ (erc-process-sentinel, erc-setup-periodical-server-ping): Use
+ `erc-cancel-timer' instead of `cancel-timer'.
+ (erc-version-string): Update to 5.0.3.
+
+ * erc-autoaway.el (autoaway, erc-autoaway-reestablish-idletimer):
+ Use `erc-cancel-timer' instead of `cancel-timer'.
+
+ * erc-compat.el (format-spec, format-spec-make): If we cannot load
+ the `format-spec' library, provide versions of these functions.
+ This should keep problems from surfacing with Emacs21 Debian
+ builds.
+ (erc-cancel-timer): New function created to take the place of
+ `cancel-timer' since XEmacs calls it something else.
+
+ * erc-track.el (erc-modified-channels-update): Accept any number
+ of arguments, which are ignored. This allows it to be run from
+ `erc-disconnected-hook' without extra bother.
+ (track): Add `erc-modified-channels-update' to
+ `erc-disconnected-hook' so that the indicators are removed
+ correctly in some edge cases.
+ (erc-modified-channels-display): Make sure that we never pass nil
+ to the function in `erc-track-shorten-function'. This happens
+ when we have deleted buffers in `erc-modified-channels-alist'.
+ Also, make sure that the buffer has a non-nil short-name before
+ adding it to the string list. This should fix some XEmacs
+ warnings when running /quit with unchecked buffers, as well as get
+ rid of a stray buffer problem (or so it is hoped).
+
+2005-05-31 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc-replace.el, erc-speak.el: Clean up comment formatting.
+
+ * erc-ring.el (ring, erc-input-ring-index, erc-clear-input-ring):
+ Clean up docstring formatting.
+
+2005-05-30 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (erc-cmd-BANLIST, erc-cmd-MASSUNBAN): Delete superfluous
+ arg to `format'.
+ (erc-load-irc-script): Use `insert-file-contents' instead of
+ `insert-file'. Simplify.
+
+2005-05-29 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-version-string): Move this up so that it is
+ evaluated before the `require' statements. Not a major change.
+
+2005-04-27 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (erc-complete-word): Simplify.
+
+2005-04-27 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (debrelease): Use a slightly different approach when
+ removing CVS and Arch cruft.
+
+ * debian/changelog: Update for 5.0.2-1 package.
+
+2005-04-25 Michael Olson <mwolson@gnu.org>
+
+ * erc-autoaway.el (erc-autoaway-reestablish-idletimer): Move code
+ block higher in file to fix a load failure when using Emacs21.
+ Thanks to Daniel Brockman for the report and fix.
+
+2005-04-24 Adrian Aichner <adrian@xemacs.org>
+
+ * erc-backend.el (JOIN): save-excursion so that
+ `erc-current-logfile' inserts into the correct channel buffers
+ when using erc-log-insert-log-on-open in combination with autojoin
+ to multiple channels.
+
+2005-04-17 Adrian Aichner <adrian@xemacs.org>
+
+ * erc-log.el: Remove stray whitespace.
+ * erc.el: Ditto.
+
+2005-04-09 Aidan Kehoe <kehoea@parhasard.net>
+
+ * erc.el: autoload erc-select-read-args, which, because it parses
+ erc-select's args, can be called before erc.el is loaded.
+
+2005-04-07 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-viper.el: Remove final newlines from previously-existing ERC
+ buffers. (Minor bug fix.)
+
+2005-04-06 Michael Olson <mwolson@gnu.org>
+
+ * Makefile (debrelease): Ignore errors from deleting Arch and CVS
+ metadata.
+
+2005-04-05 Michael Olson <mwolson@gnu.org>
+
+ * ChangeLog, CREDITS, AUTHORS: Correct name and email address of
+ Marcelo Toledo.
+
+2005-04-04 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-modules): Add entry for spelling module.
+
+ * erc-spelling.el: Add autoload line.
+
+ * erc-backend.el: Apply latest non-ascii patch from Kai Fan.
+ (erc-decode-parsed-server-response): Search
+ erc-response.command-args for channel name. Decode the
+ erc-response struct using this channel name as key according to
+ the `erc-encoding-coding-alist'.
+
+ * erc-track.el: Apply patch from Henrik Enberg.
+ (erc-modified-channels-object): Use optimal amount of whitespace
+ around modified channels indicator.
+
+2005-04-02 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (define-erc-module, erc-with-buffer)
+ (erc-with-all-buffers-of-server, with-erc-channel-buffer): Add
+ edebug-form-spec.
+
+ * erc-compat.el (erc-define-minor-mode): Ditto.
+
+2005-03-29 Jorgen Schaefer <forcer@forcix.cx>
+
+ * erc-spelling.el: New file.
+
+2005-03-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc-backend.el (define-erc-response-handler): Add
+ `definition-name' property to constructed symbols so that
+ find-function and find-variable will find them.
+
+2005-03-21 Michael Olson <mwolson@gnu.org>
+
+ * erc-dcc.el, erc-goodies.el, erc-list.el, erc-notify.el,
+ erc-ring.el, erc.el: Copyright assignment occurred.
+
+ * debian/scripts/install: Make a shell wrapper around the original
+ Makefile and inline the Makefile. The problem is that Debian
+ passes all the Emacs variants at once, rotating them at every
+ invocation of the install script, which happens once per variant.
+ This caused each installation to happen N-1 times more often than
+ it should have. As a result, we need to only deal with the first
+ argument.
+ (ELFILES): Only add format-spec.el if we are compiling for
+ emacs21. Don't filter out erc-compat.el.
+ (SITEFLAG): New variable that indicates that the "nosite" option
+ should look like.
+ (.DEFAULT): Use $(FLAVOUR) instead of $@ for clarity.
+
+ * debian/rules: Install NEWS file and compress it.
+
+ * debian/maint/postinst: Be more cautious about configuration
+ step.
+
+ * debian/copyright (Copyright): Another assignment came in.
+
+ * debian/control (Standards-Version): Update to a newer version as
+ recommended by lintian.
+
+ * debian/changelog: Changes made for the Debian package.
+
+ * debian/README.Debian: Keep only the General Notes section.
+
+ * NEWS: Move old history items here from debian/README.Debian.
+
+ * Makefile (SNAPSHOTDATE): Deprecate this option since we hope to
+ release more often.
+
+2005-03-20 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-define-catalog, `ctcp-request-to'): Fix typo (%: ->
+ %t:).
+
+2005-03-01 Michael Olson <mwolson@gnu.org>
+
+ * erc-log.el (erc-save-buffer-in-logs): Replace tabs with spaces
+ in code indentation.
+
+2005-02-28 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-display-message): Apply corrected patch from Henrik
+ Enberg.
+
+2005-02-27 Michael Olson <mwolson@gnu.org>
+
+ * erc.el (erc-display-message): Apply patch from Henrik Enberg.
+ Check here to see if a message should be hidden, rather than
+ relying on code in each individual command.
+ (erc-version-string): Add "(CVS)" to the version string for
+ clarity.
+
+ * erc-backend.el (JOIN, KICK, MODE, NICK, PART, QUIT, TOPIC):
+ Don't check `erc-hide-list' here.
+
+ * erc-list.el, erc-match.el, erc.el, debian/copyright: Update
+ copyright information as a few more people have assignments
+ registered.
+
+2005-02-06 Michael Olson <mwolson@gnu.org>
+
+ * erc-backend.el: Apply patch from Kai Fan for non-ASCII character
+ support.
+ (erc-parse-server-response): Add call to
+ `erc-decode-parsed-server-response'.
+ (erc-decode-parsed-server-response): New function that decodes a
+ pre-parsed server response before it can be handled.
+ (PRIVMSG): Comment out call to `erc-decode-string-from-target'.
+ (TOPIC): Ditto.
+
+2005-02-01 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-process-sentinel-1): Don't reconnect on connection
+ refused. This error is reported differently when using
+ open-network-stream-nowait.
+
+2005-01-26 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-cmd-APPENDTOPIC, erc-set-topic): The control
+ character in `channel-topic' was changed to \C-o - replaced \C-c
+ with \C-o so that these functions work as expected again.
+ (erc-get-channel-mode-from-keypress): Doc fix.
+
+2005-01-25 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-button.el, erc-compat.el, erc-goodies.el,
+ erc-match.el, erc-nets.el, ChangeLog, NEWS: Merged bug fixes made
+ on release_5_0_branch since 5.0.1 release.
+
+2005-01-24 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc.el (erc-input-action): Quote `erc-action-history-list' so
+ that input history actually works.
+ (erc-process-ctcp-query): Fix and simplify logic.
+ (erc-get-channel-mode-from-keypress): Use `C-' string syntax.
+ (erc-load-irc-script-lines): Use `erc-command-indicator' instead
+ of `erc-prompt'.
+
+2005-01-23 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-viper.el: Ensure that `viper-comint-mode-hook' runs in
+ buffers whose `erc-mode-hook' has already run when this file is
+ loaded.
+ Explicitly `require' erc.el.
+
+2005-01-22 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el (erc-mode): Remove frobbing of `require-final-newline'.
+
+ * erc-log.el (erc-save-buffer-in-logs): Remove frobbing of
+ `require-final-newline'.
+
+ * erc-viper.el: New file. This is where all ERC/Viper
+ compatibility code should live. When and if ERC is bundled with
+ Emacs, some of the hacks in this file should be merged into Viper
+ itself.
+
+2005-01-21 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el (erc-mode): Set `require-final-newline' to nil in ERC
+ buffers. This prevents a Viper misfeature whereby extraneous
+ newlines are inserted into the ERC buffer when switching between
+ viper states.
+
+ * erc-log.el (erc-save-buffer-in-logs): Bind `require-final-newline'
+ to t when calling `write-region' to ensure that further log
+ entries start on fresh lines.
+
+2005-01-21 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-add-face): Reverted my change to the
+ order faces since it had the unwanted effect of putting the button
+ face after all others.
+ (erc-button-face-has-priority): Removed this variable as it is not
+ necessary anymore - it was used to compensate for the above
+ mentioned change.
+
+ * NEWS: Added the latest fixes.
+
+2005-01-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el, erc-match.el:
+ (erc-button-syntax-table, erc-match-syntax-table): Added \ as a
+ legal character for nicknames.
+
+ * erc-nets.el (erc-server-select): Fixed so that only networks
+ with servers found in `erc-server-alist' are available as choices.
+
+ * erc.el, erc-compat.el, erc-goodies.el:
+ (erc-replace-match-subexpression-in-string): New function. Needed
+ because `replace-match' in XEmacs doesn't replace regular
+ expression subexpressions in strings, only in buffers.
+ (erc-seconds-to-string, erc-controls-interpret): Use the new
+ function.
+
+ * erc-button.el (erc-button-add-button): Use the `:button-face'
+ key combined with an `erc-mode' local `widget-button-face' set to
+ nil to get the widget overlay face suppressed in XEmacs.
+
+2005-01-19 Francis Litterio <franl@world.std.com>
+
+ * erc-button.el (erc-button-add-face): The face added by this
+ function is more important than the existing text's face, so we
+ now prepend erc-button-face to the list of existing faces when
+ adding a button. To instead append erc-button-face to existing
+ faces, set variable `erc-button-face-has-priority' to nil.
+ (erc-button-face-has-priority): New variable to control how
+ erc-button-add-face adds erc-button-face to existing faces.
+ (erc-button-press-button): Silenced a byte-compiler warning about
+ too few arguments in a call to `error'.
+
+2005-01-19 Diane Murray <disumu@x3y2z1.net>
+
+ * NEWS: Added list of 5.0.1 fixes.
+
+2005-01-19 Michael Olson <mwolson@gnu.org>
+
+ * AUTHORS: Move to format that cscvs can understand. As an added
+ perk, entries line up nicer.
+
+ * erc.el, erc-fill.el, erc-pcomplete.el, debian/copyright: Merge a
+ few more copyright lines thanks to Alex Schroeder's BBDB file.
+
+ * Makefile: Change version to correspond with our new scheme.
+
+2005-01-18 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list.el (erc-chanlist-channel-line-regexp): Now matches
+ private channels, the channels `#' and `&', and channels with
+ names including non-ascii characters.
+ (erc-chanlist-join-channel): Don't attempt to join private
+ channels since the channel name is unknown.
+
+ * erc-goodies.el (erc-make-read-only): Add `rear-nonsticky'
+ property to avoid `Text is read-only' errors during connection.
+ `front-nonsticky' does not exist, changed to `front-sticky'.
+ (erc-controls-interpret, erc-controls-strip): Just work on the
+ string, don't open a temporary buffer.
+ (erc-controls-propertize): Now accepts optional argument STR.
+
+2005-01-17 Michael Olson <mwolson@gnu.org>
+
+ * Makefile: Version is 5.01, but only in the Makefile. It has not
+ been released yet.
+
+ * erc-auto.in, erc-autojoin.el, erc-bbdb.el, erc-button.el,
+ erc-chess.el, erc-complete.el, erc-dcc.el, erc-fill.el,
+ erc-goodies.el, erc-ibuffer.el, erc-identd.el, erc-imenu.el,
+ erc-list.el, erc-match.el, erc-menu.el, erc-nets.el,
+ erc-netsplit.el, erc-nickserv.el, erc-notify.el, erc-pcomplete.el,
+ erc-ring.el, erc-speak.el, erc-speedbar.el, erc-stamp.el,
+ erc-track.el, erc-xdcc.el, erc.el, debian/copyright: Update
+ copyright notices. If anyone has signed papers for Emacs in
+ general, merge them with the FSF's entry.
+
+2005-01-16 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc): `erc-set-active-buffer' was being called before
+ `erc-process' was set, so that channels weren't being marked
+ active correctly upon join; fixed.
+
+2005-01-15 Johan Bockgård <bojohan+sf@dd.chalmers.se>
+
+ * erc-backend.el (def-edebug-spec): This macro caused problems (in
+ XEmacs). Use its expansion directly.
+
+2005-01-15 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-add-button): Reverted previous change
+ since `:suppress-face' doesn't seem to be checked for a certain
+ face.
+ (erc-button-add-face): FACE is now appended to the `old' face.
+ This should fix the problem of faces being "covered" by
+ `erc-button-face'.
+
+2005-01-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-backend.el (erc-cmd-OPS, erc-cmd-COUNTRY,
+ erc-cmd-NICK, erc-process-ctcp-query, ERROR, PONG, 311, 312, 313,
+ 314, 317, 319, 320, 321, 322, 330, 352): Use catalog entries
+ instead of hard-coded text messages.
+ (english): Added new catalog entries `country', `country-unknown',
+ `ctcp-empty', `ctcp-request-to', `ctcp-too-many', `nick-too-long',
+ `ops', `ops-none', `ERROR', `PONG', `s311', `s312', `s313',
+ `s314', `s317', `s317-on-since', `s319', `s320', `s321', `s322',
+ `s330', and `s352'.
+ (erc-send-current-line): Use `erc-set-active-buffer' (change was
+ lost in previous bug fix).
+
+2005-01-14 Francis Litterio <franl@world.std.com>
+
+ * erc-button.el (erc-button-add-button): Fixed a bug where the
+ overlay created by widget-convert-button has a `face' property
+ that hides the `face' property set on the underlying button text.
+
+ * erc-goodies.el: Docstring fix.
+
+ * erc-button.el: Improved docstring for variable erc-button-face.
+
+2005-01-13 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el (erc-menu-definition): "Topic set by channel
+ operator": Small word change. "Identify to NickServ...": Check
+ that we're connected to the server. Added "Save buffer in log"
+ and "Truncate buffer".
+
+2005-01-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-display-line-1): Widen before we try to insert
+ anything, this makes sure input isn't broken when the buffer is
+ narrowed by the user.
+ (erc-beg-of-input-line): Simplify, just return the position of
+ `erc-insert-marker' or error if does not exist.
+ (erc-send-current-line): Widen before trying to send anything.
+
+2005-01-13 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-backend.el, erc-list.el:
+ (erc-update-mode-line-buffer): Strip controls characters from
+ `channel-topic' since we add our own control character to it.
+ (TOPIC, 332): Use \C-o instead of \C-c to force an end of IRC
+ control characters as it also ends bold, underline, and inverse -
+ \C-c only ends colors.
+ (erc-chanlist-322): Strip control characters from channel and
+ topic. No need to interpret controls when we're applying overlays
+ to the lines.
+
+ * erc.el, erc-backend.el, erc-button.el, erc-netsplit.el,
+ erc-nicklist.el: Fixed so that each server has an active buffer.
+ (erc-active-buffer): Now a buffer-local variable.
+ (erc-active-buffer, erc-set-active-buffer): New functions.
+ (erc-display-line, erc-echo-notice-in-active-non-server-buffer,
+ erc-process-away, MODE): Call `erc-active-buffer' to get the
+ active buffer for the current server.
+ (erc, erc-process-sentinel-1, erc-grab-region, erc-input-action,
+ erc-send-current-line, erc-invite-only-mode,
+ erc-toggle-channel-mode, erc-channel-names, MODE, erc-nick-popup,
+ erc-nicklist-call-erc-command): Use `erc-set-active-buffer' to set
+ the active buffer for the current server.
+ (erc-cmd-WHOLEFT): Use 'active as BUFFER in `erc-display-message'.
+
+ * erc-track.el (erc-track-modified-channels): Server buffers are
+ now treated the same as channels and queries. This means that
+ `erc-track-priority-faces-only', `erc-track-exclude', and
+ `erc-track-exclude-types' now work with server buffers.
+
+2005-01-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (475): Prompt for the channel's key if
+ `erc-prompt-for-channel-key' is non-nil. Send a new JOIN message
+ with the key if a key is provided.
+
+ * erc.el (erc-command-indicator): Fixed customization choices so
+ that there's no `mismatch' message when nil is the value.
+
+2005-01-11 Michael Olson <mwolson@gnu.org>
+
+ * erc-bbdb.el (bbdb): Lowercase the name of the module. This
+ fixes a bug which caused an error to occur when trying to enable
+ the module using the customization interface.
+
+2005-01-08 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-track.el: Support using faces to indicate channel activity
+ in the modeline under XEmacs.
+ (erc-modified-channels-object): New function.
+ (erc-modified-channels-display): Use it.
+ `erc-modified-channels-string' renamed to
+ `erc-modified-channels-object' (because it's no longer a string on
+ XEmacs). The new function `erc-modified-channels-object' is used
+ to generate updated values for the same-named variable.
+
+2005-01-08 Diane Murray <disumu@x3y2z1.net>
+
+ * ChangeLog.2002: Changed instances of my sourceforge username and
+ email address to real name and email.
+
+ * erc.el (erc-modules): Changed customization tag descriptions, so
+ that they all start with a verb; added new modules to choices.
+
+2005-01-08 Mario Lang <mlang@delysid.org>
+
+ * debian/rules: Introduce new variable DOCDIR to simplify stuff a
+ bit.
+
+2005-01-08 Michael Olson <mwolson@gnu.org>
+
+ * AUTHORS, ChangeLog.2004: Change bpalmer's email address as
+ requested.
+
+ * CREDITS: Add everyone who is mentioned in the ChangeLogs.
+
+ * debian/copyright (Copyright): Add last few people. This can now
+ be considered a complete list, as far as CVS entries are
+ concerned. If people have assigned copyright to the FSF, merge
+ them with the entry for the FSF.
+
+ * debian/README.Debian: Add entry for XEmacs-related change in
+ `erc-track.el'.
+
+ * erc.el (erc-cmd-MODE): New command that changes or displays the
+ mode for a channel or user. The functionality was present before
+ this change, but there was no documentation for it.
+
+ * erc-auto.in, erc-*.el: Fully investigate copyright headers and
+ change them appropriately. If a file has been pulled off of
+ erc.el at one time, keep track of copyright from the time of
+ separation, but not before. If a file has been derived from a
+ work outside of erc, keep copyright statements in place.
+
+ * Makefile (VERSION): Change to 5.0! :^) Congrats on all the great
+ work. I'll wait until hober commits his XEmacs compatibility
+ patch to erc-track.el, and then release.
+ (distclean): Alias for `realclean' target.
+
+2005-01-07 Michael Olson <mwolson@gnu.org>
+
+ * AUTHORS: Add Marcelo Toledo, who has CVS access to this project.
+
+ * ChangeLog.2004: Add my name to my one contribution to erc last
+ year.
+
+ * CREDITS: Add people that were discovered while scouring
+ ChangeLogs.
+
+ * debian/copyright: Add everyone from `AUTHORS' to Upstream
+ Authors. Anyone who has contributed 15 or more lines of
+ code (according to ChangeLogs) is listed in Copyright section.
+ Accurate years are included.
+
+ * debian/README.Debian: Paste content of NEWS and reformat
+ slightly.
+
+ * debian/rules: Concatenate the ChangeLogs during the Debian
+ install process and then gzip them.
+
+ * Makefile (MISC): Add ChangeLog.yyyy files to list.
+ (ChangeLog): Remove rule since we do not dynamically generate the
+ ChangeLog anymore.
+
+ * MkChangeLog: Removed since we do not use it to generate the
+ ChangeLog anymore. cvs2cl does a much better job anyway.
+
+ * NEWS: Use 3rd level heading instead of bullets for lists that
+ contain descriptions.
+
+2005-01-07 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list.el: Require 'sort.
+ (erc-chanlist): Disable undo in the channel list buffer.
+
+ * erc.el, erc-menu.el: The `IRC' menu is now automatically added
+ to the menu-bar. Add the call to `easy-menu-add' to
+ `erc-mode-hook' when running in XEmacs (without this the menu
+ doesn't appear).
+
+ * NEWS: Added the information from
+ http://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
+ changes which weren't yet documented on that page.
+
+2005-01-06 Hoan Ton-That <hoan@ton-that.org>
+
+ * erc-log.el (erc-current-logfile): Only downcase the logfile
+ name, not the whole filename. Also expand relative to
+ `erc-log-channels-directory'.
+ (erc-generate-log-file-name-with-date)
+ (erc-generate-log-file-name-short)
+ (erc-generate-log-file-name-long): Don't expand filename, done in
+ `erc-current-logfile'.
+
+2005-01-06 Lawrence Mitchell <wence@gmx.li>
+
+ * NEWS: New file, details user visible changes from version to
+ version.
+
+ * HACKING (NEWS entries): Mention NEWS file, and what its purpose
+ is.
+
+2005-01-05 Michael Olson <mwolson@gnu.org>
+
+ * FOR-RELEASE: New file containing the list of release-critical
+ tasks. Feel free to add to it.
+
+ * debian/rules (binary-erc): Add ChangeLog files.
+
+2005-01-04 Michael Olson <mwolson@gnu.org>
+
+ * ChangeLog.2001, ChangeLog.2002, ChangeLog.2003, ChangeLog.2004:
+ ChangeLog entries from previous years.
+
+ * ChangeLog: New file containing ChangeLog entries for the current
+ year. Please update this file manually whenever a change is
+ committed. This is a new policy.
+
+ * AUTHORS: Add myself to list. Some entries were space-delimited
+ instead of TAB-delimited, and since the latter seemed to be the
+ default, make the other entries conform.
+
+ * HACKING (ChangeLog Entries): Update section to reflect new
+ policy toward ChangeLog entries, which is that they should be
+ manually updated whenever a change is committed.
+
+2005-01-04 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-connection-established, erc-login): Update the
+ mode-line.
+ (erc-update-mode-line-buffer): If `erc-current-nick' returns nil,
+ use an empty string for ?n character in format spec. Set
+ `mode-line-process' to ":connecting" while the connection is being
+ established.
+
+2005-01-04 Lawrence Mitchell <wence@gmx.li>
+
+ * AUTHORS: Update list of authors.
+
+2005-01-02 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-goodies.el (erc-control-characters): New customization
+ group.
+ (erc-interpret-controls-p): Small fix, addition to
+ documentation. Updated customization to allow 'remove as a value.
+ Use 'erc-control-characters as `:group'.
+ (erc-interpret-mirc-color): Use 'erc-control-characters as
+ `:group'.
+ (erc-beep-p): Updated documentation. Use 'erc-control-characters
+ as `:group'.
+ (define-erc-module irccontrols): Add `erc-controls-highlight' to
+ `erc-insert-modify-hook' and `erc-send-modify-hook' since it
+ changes the text's appearance.
+ (erc-controls-remove-regexp, erc-controls-interpret-regexp): New
+ variables.
+ (erc-controls-highlight): Fixed so that highlighting works even if
+ there is no following control character. Fixed mirc color
+ highlighting; now respecting `erc-interpret-mirc-color'. Fixed a
+ bug where emacs would get stuck in a loop when \C-g was in a
+ message and `erc-beep-p' was set to nil (default setting).
+
+2004-12-29 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-goodies.el (erc-interpret-controls-p): Changed docstring to
+ reflect the new meaning if this is set to 'remove.
+ (erc-controls-interpret): Rephrased docstring to be more accurate.
+ (erc-controls-strip): New function that behaves like the
+ recently-removed erc-strip-controls -- it removes all IRC color
+ and highlighting control characters.
+ (erc-controls-highlight): Changed to support the new 'remove value
+ that variable erc-interpret-controls-p might have.
+
+2004-12-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-ibuffer.el, erc-list.el, erc-page.el, erc-speedbar.el:
+ Changed all calls to erc-interpret-controls (which no longer
+ exists) to call erc-controls-interpret (the new name of the same
+ function).
+
+2004-12-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-goodies.el (erc-controls-interpret): Added this function to
+ replace the recently-removed erc-interpret-controls. Also added
+ a (require 'erc) to solve a byte-compile problem.
+
+2004-12-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-controls-interpret): Added this function to replace
+ the recently-removed erc-interpret-controls.
+
+2004-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-truncate.el (erc-truncate-buffer-to-size): Check for
+ logging even better (via lawrence).
+
+2004-12-26 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-truncate.el (erc-truncate-buffer-to-size): Much saner
+ logging detection (via lawrence).
+
+2004-12-25 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-goodies.el (erc-controls-highlight): Treat single C-c
+ correctly.
+
+2004-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-goodies.el, erc.el: Deleted IRC control character processing
+ and implemented a sane version in erc-goodies.el as a module.
+
+ * erc.el (erc-merge-controls, erc-interpret-controls,
+ erc-decode-controls, erc-strip-controls, erc-make-property-list,
+ erc-prepend-properties): Removed.
+
+ (erc-interpret-controls-p, erc-interpret-mirc-color, erc-bold-face
+ erc-inverse-face, erc-underline-face, fg:erc-color-face0,
+ fg:erc-color-face1, fg:erc-color-face2, fg:erc-color-face3,
+ fg:erc-color-face4, fg:erc-color-face5, fg:erc-color-face6,
+ fg:erc-color-face7, fg:erc-color-face8, fg:erc-color-face9,
+ fg:erc-color-face10, fg:erc-color-face11, fg:erc-color-face2,
+ fg:erc-color-face13, fg:erc-color-face14, fg:erc-color-face15,
+ bg:erc-color-face1, bg:erc-color-face2, bg:erc-color-face3,
+ bg:erc-color-face4, bg:erc-color-face5, bg:erc-color-face6,
+ bg:erc-color-face7, bg:erc-color-face8, bg:erc-color-face9,
+ bg:erc-color-face10, bg:erc-color-face11, bg:erc-color-face2,
+ bg:erc-color-face13, bg:erc-color-face14, bg:erc-color-face15,
+ erc-get-bg-color-face, erc-get-fg-color-face,
+ erc-toggle-interpret-controls): Moved.
+
+ * erc-goodies.el (erc-beep-p, irccontrols, erc-controls-highlight,
+ erc-controls-propertize): New.
+
+2004-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-goodies.el, erc.el: The Small Extraction of Stuff[tm] commit.
+ Moved some functions from erc.el to erc-goodies.el, and
+ transformed them to erc modules in the process.
+ - imenu autoload stuff moved. I don't know why it is here at all.
+ - Moved: scroll-to-bottom, make-read-only, distinguish-noncommands,
+ smiley, unmorse, erc-occur (the last isn't a module, but still
+ moved)
+ (erc-input-line-position, erc-add-scroll-to-bottom,
+ erc-scroll-to-bottom, erc-make-read-only, erc-noncommands-list,
+ erc-send-distinguish-noncommands, erc-smiley, erc-unmorse,
+ erc-occur): Moved from erc.el to erc-goodies.el.
+ (smiley): Module moved from erc.el to erc-goodies.el.
+ (scrolltobottom, readonly, noncommands, unmorse): New modules.
+
+2004-12-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-format-away-status): Use `a', not `away' - that's
+ why it's there.
+ (erc-update-mode-line-buffer): The values of `mode-line-process'
+ and `mode-line-buffer-identification' are normally lists.
+ Conform.
+
+2004-12-18 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-process-ctcp-query, erc-process-ctcp-reply): Display
+ message in the active window, not the server window.
+
+2004-12-16 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-track.el (erc-track-position-in-mode-line): Check for
+ 'erc-track-mode variable with boundp. From Adrian Aichner
+ <adrian@xemacs.org>.
+
+2004-12-16 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-upcase-first-word): New function. The old way used
+ in erc-send-ctcp-message would eat consecutive whitespace etc.
+ (erc-send-ctcp-message, erc-send-ctcp-notice): Use it.
+
+2004-12-15 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el (erc-send-ctcp-message): Fix braino with my previous
+ patch. It always helps to C-x C-s before `cvs commit'.
+
+2004-12-15 Edward O'Connor <ted@oconnor.cx>
+
+ * erc.el (erc-send-ctcp-message): Only upcase the ctcp command,
+ and not the entire message. Brian Palmer's change of 2004-12-12 had broken /me.
+ Shouting is bad! :)
+
+2004-12-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nets.el (erc-networks-alist): Change undernet to Undernet as
+ is used in `erc-server-alist', so that completion works when using
+ `erc-server-select'. This should fix Debian bug #282003 (erc:
+ cannot connect to Undernet).
+
+2004-12-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (def-edebug-spec): Only run this if 'edebug is
+ available.
+
+2004-12-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: The last change to `erc-mode-line-format' introduced a
+ bug in XEmacs - it can't handle the #(" "...) strings at all. The
+ following changes fix the bug and simplify the mode-line handling
+ considerably. (erc-mode-line-format): Now defined as a string
+ which will be formatted using `format-spec' and take the place of
+ `mode-line-buffer-identification' in the mode line.
+ (erc-header-line-format): Now defined as a string to be formatted
+ using `format-spec'.
+ (erc-prepare-mode-line-format): Removed.
+ (erc-format-target, erc-format-target-and/or-server,
+ erc-format-away-status, erc-format-channel-modes): New functions.
+ Basically the old `erc-prepare-mode-line-format' split apart.
+ (erc-update-mode-line-buffer): Set
+ `mode-line-buffer-identification' to the formatted
+ `erc-mode-line-format', set `mode-line-process' to ": CLOSED" if
+ the connection has been terminated, and set `header-line-format'
+ (if it is bound) to the formatted `erc-header-line-format', then
+ do a `force-mode-line-update'.
+
+2004-12-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-modules): Disable modules removed with `customize'.
+ (erc-update-modules): Try to give a more descriptive error
+ message.
+
+2004-12-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-complete.el, erc.el, erc-list.el, erc-nets.el,
+ * erc-nicklist.el, erc-pcomplete.el, erc-replace.el, erc-speak.el,
+ * erc-truncate.el (erc-buffers, erc-coding-systems, erc-display,
+ erc-mode-line-and-header, erc-ignore, erc-query,
+ erc-quit-and-part, erc-paranoia, erc-scripts, erc-old-complete,
+ erc-list, erc-networks, erc-nicklist, erc-pcomplete, erc-replace,
+ erc-truncate): New customization groups.
+ (erc-join-buffer, erc-frame-alist, erc-frame-dedicated-flag,
+ erc-reuse-buffers): Use 'erc-buffers as `:group'.
+ (erc-default-coding-system, erc-encoding-coding-alist):
+ Use 'erc-coding-systems as `:group'.
+ (erc-hide-prompt, erc-show-my-nick, erc-prompt,
+ erc-input-line-position, erc-command-indicator, erc-notice-prefix,
+ erc-notice-highlight-type, erc-interpret-controls-p,
+ erc-interpret-mirc-color, erc-minibuffer-notice,
+ erc-format-nick-function): Use 'erc-display as `:group'.
+ (erc-mode-line-format, erc-header-line-format,
+ erc-header-line-uses-help-echo-p, erc-common-server-suffixes,
+ erc-mode-line-away-status-format): Use 'erc-mode-line-and-header
+ as `:group'.
+ (erc-hide-list, erc-ignore-list, erc-ignore-reply-list,
+ erc-minibuffer-ignored): Use 'erc-ignore as `:group'.
+ (erc-auto-query, erc-query-on-unjoined-chan-privmsg,
+ erc-format-query-as-channel-p): Use 'erc-query as `:group'.
+ (erc-kill-buffer-on-part, erc-kill-queries-on-quit,
+ erc-kill-server-buffer-on-quit, erc-quit-reason-various-alist,
+ erc-part-reason-various-alist, erc-quit-reason, erc-part-reason):
+ Use 'erc-quit-and-part as `:group'.
+ (erc-verbose-server-ping, erc-paranoid, erc-disable-ctcp-replies,
+ erc-anonymous-login, erc-show-channel-key-p): Use 'erc-paranoia as
+ `:group'.
+ (erc-startup-file-list, erc-script-path, erc-script-echo): Use
+ 'erc-scripts as `:group'.
+ (erc-nick-completion, erc-nick-completion-ignore-case,
+ erc-nick-completion-postfix): Use 'erc-old-complete as `:group'.
+ (erc-chanlist-progress-message, erc-no-list-networks,
+ erc-chanlist-frame-parameters, erc-chanlist-hide-modeline,
+ erc-chanlist-mode-hook): Use 'erc-list as `:group'.
+ (erc-server-alist, erc-networks-alist): Use 'erc-networks as
+ `:group'.
+ (erc-settings): Use `defvar' instead of `defcustom' since this is
+ only a draft which doesn't work.
+ (erc-nicklist-window-size): Use 'erc-nicklist as `:group'.
+ (erc-pcomplete-nick-postfix,
+ erc-pcomplete-order-nickname-completions): Use 'erc-pcomplete as
+ `:group'.
+ (erc-replace-alist): Use 'erc-replace as `:group'.
+ (erc-speak-filter-timestamp): Use 'erc-speak as `:group'.
+ (erc-max-buffer-size): Use 'erc-truncate as `:group'.
+
+2004-12-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-scroll-to-bottom): Go to the end of the buffer
+ before recentering. This allows editing multiple lines more
+ conveniently in CVS Emacs. This also undos a change by antifuchs
+ who said this goto-char would mess up redisplay. Extensive testing
+ couldn't reproduce that problem.
+
+2004-12-12 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-send-ctcp-message): upcase the ctcp message (so that
+ version becomes VERSION, for example).
+ (erc-iswitchb): Make the argument optional in non-interactive
+ invocation, so erc-iswitchb can be substituted directly for
+ iswitchb in code.
+
+2004-12-11 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-track.el (erc-track-position-in-mode-line): Allow for the
+ fact that `erc-track-mode' isn't bound when file is loaded.
+
+2004-12-11 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-track.el (erc-track-position-in-mode-line): New customizable
+ variable. (erc-track-remove-from-mode-line): New function.
+ Remove `erc-modified-channels-string' from the mode-line.
+ (erc-track-add-to-mode-line): New function. Add
+ `erc-modified-channels-string' to the mode-line using the value of
+ `erc-track-position-in-mode-line' to determine whether to add it
+ to the beginning or the end of `mode-line-modes' (only available
+ with GNU Emacs versions above 21.3) or to the end of
+ `global-mode-string'.
+ (erc-track-mode, erc-track-when-inactive-mode): Use the new
+ functions.
+
+2004-12-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-cmd-BANLIST): Use (buffer-name) and not
+ (erc-default-target) for the buffer name - buffer names are case
+ sensitive.
+
+2004-12-11 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-message-type): Added the message "MODE" to the known
+ erc-message-type widget, so that (for example) people can tell
+ erc-track-exclude-types to ignore mode changes. The others tag
+ also needed to be made an inline list, so that it's merged with
+ the given constants, instead of being inserted as a list.
+
+2004-12-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el, erc.el: Update to get ERC look nicely in CVS Emacs.
+
+ * erc.el (erc-mode-line-format): When on CVS emacs, use the new
+ format.
+
+ * erc-track.el (track module): When on CVS emacs, modify
+ mode-line-modes instead of global-mode-string. The latter is way
+ to far too the right.
+
+2004-11-18 Mario Lang <mlang@delysid.org>
+
+ * Makefile, debian/changelog: debian release 20041118-1
+
+2004-11-03 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el (erc-button-buttonize-nicks): Set default value to
+ `t'. Updated documentation and customization `:type' to reflect
+ usage.
+
+2004-10-29 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * AUTHORS: Added self.
+
+2004-10-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list.el: Added local variables for this file.
+ (erc-list-version): New.
+ (erc-cmd-LIST): Take &rest rather than &optional arguments, as was
+ done in revision 1.21. Allow for input when called interactively.
+ (erc-prettify-channel-list, erc-chanlist-toggle-sort-state): Use
+ `unless' instead of when not.
+
+2004-10-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (erc-handle-unknown-server-response): Fixed so
+ that the contents are only shown once.
+ (MOTD): Display lines in the server buffer if it's the first MOTD
+ sent upon connection. This is to avoid the problem of having the
+ MOTD of one server showing up in another server's buffer if it took
+ a while to get connected.
+ (004): Fixed to show the user modes and channel modes correctly.
+ (303): Now displays the nicknames returned by ISON instead of the
+ user's nickname.
+ (367, 368): Moved up into 300's section of the code. Added
+ documentation. Use `multiple-value-bind' to set variables in 367.
+ (391): Fixed so that the server name is shown correctly.
+
+2004-10-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-process-sentinel): Use CPROC instead of
+ `erc-process' in debug message. Should fix a bug where an error
+ saying "Buffer *scratch* has no process" would occur when
+ disconnected.
+ (erc-cmd-SV): Check for X toolkit after checking for more specific
+ features. (erc--kill-server): Set `quitting' to non-nil so that
+ we don't automatically reconnect.
+
+2004-10-05 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-ignored-user-p): Don't require regexes to match the
+ beginning.
+
+2004-09-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: group erc: Moved to 'applications (patch by bojohan)
+
+2004-09-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-button.el (erc-button-remove-old-buttons): Remove 'keymap
+ not 'local-map.
+
+2004-09-03 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el: JOIN response handler: Typo fix of the last
+ commit.
+
+2004-09-03 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el: JOIN response handler: Run `erc-join-hook'
+ without arguments as specified in the docstring.
+
+2004-08-27 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-send-current-line): Removed unused variable SENTP.
+
+2004-08-19 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: ERC-SEND-COMPLETED-HOOK used to be run when the prompt
+ was already displayed. We restore this behavior (thanks to bojohan
+ and TerryP for noticing). We also fix the docstring of
+ ERC-SEND-COMPLETED-HOOK, since the hook is (and used to be) called
+ even if nothing was sent to the server.
+ (erc-send-completed-hook): Fixed docstring.
+ (erc-send-current-line): Add incantation for
+ erc-send-completed-hook.
+ (erc-send-input): Remove incantation for erc-send-completed-hook.
+
+2004-08-18 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el: response-handler 368: Use s368, not s367.
+
+2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-scroll-to-bottom): Don't scroll when we're not
+ connected anymore.
+
+2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el, erc.el: Handle /mode #emacs b output without
+ errors and such. First, handle unknown format specs gracefully
+ (that is, give a useful error). Then, provide handlers for the
+ banlist replies.
+
+ * erc-backend.el: New handler for 367 and 368. Removed from default
+ handler.
+
+ * erc.el: Provide english catalog for s367 and s368.
+ (erc-format-message): Give an error message when we don't find an
+ entry.
+
+2004-08-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-fill.el: erc-fill-variable could be confused about really
+ long nicks. We put an upper limit on the length of the fill prefix.
+ (erc-fill-variable): Adjust fill-prefix.
+ erc-fill-variable-maximum-indentation: New variable.
+
+2004-08-17 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-send-input): Fixed a bug where this function
+ referenced variable "input" instead of variable "str".
+
+2004-08-16 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el (erc-chanlist-highlight-line): Fixed a bug where
+ this function failed to set the correct face for highlighting the
+ current line.
+
+2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-fill.el (erc-fill-variable): Don't fuck up when the
+ looking-at didn't work.
+
+2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-send-single-line): Call the hooks to change the
+ appearance for something only if we actually inserted something,
+ doh.
+ (erc-display-command): Display the prompt outside of the area that
+ set the text properties on.
+
+2004-08-14 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: Refactored erc-send-current-line. This should fix some
+ dormant bugs, and make the whole thing actually readable. Yay.
+ Some changes in behavior were made. Whitespace at the end of lines
+ sent is not removed anymore, but that shouldn't bother anyone.
+ Additionally, errors in commands or hooks shouldn't prevent the
+ prompt from showing up again now.
+ (erc-parse-current-line): Removed.
+ (erc-send-current-line): Refactored.
+ (erc-send-input): New function.
+ (erc-send-single-line): New function.
+ (erc-display-command): New function.
+ (erc-display-msg): New function.
+ (erc-user-input): New function.
+
+2004-08-13 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-cmd-SERVER): Use newer keyword call interface to
+ erc-select, and handle the error if it can't resolve the host.
+
+2004-08-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el, erc.el: erc-backend.el (404 response handler):
+ New function. We now support "cannot send to channel".
+
+ * erc.el (erc-define-catalog call): Added s404.
+ (erc-ctcp-ECHO-reply, erc-ctcp-CLIENTINFO-reply,
+ erc-ctcp-FINGER-reply, erc-ctcp-PING-reply, erc-ctcp-TIME-reply,
+ erc-ctcp-VERSION-reply): Display reply in the active window, not
+ the server window.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-with-all-buffers-of-server): Actually make it left
+ to right, doh.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-with-all-buffers-of-server): Evaluate left-to-right
+ so we don't surprise a user.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-process-input-line): Parentophobia! Another
+ paren-fix.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el: PRIVMSG NOTICE response handler: Killed one paren
+ too much. Poor paren. Got resurrected.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el: Make server buffers showing up in the mode line
+ optional. Thanks to Daniel Knapp on the EmacsWiki for this patch.
+
+ erc-track-exclude-server-buffer: New variable.
+ (erc-track-modified-channels): Return a server buffer only if
+ erc-track-exclude-server-buffer is nil.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-cmd-DESCRIBE): Don't parse arguments.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-truncate.el (erc-truncate-buffer-to-size): Use
+ erc-insert-marker, not (point-max), to decide the length of the
+ buffer. A long input line shouldn't make the buffer smaller.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-macs.el, erc-members.el: The change to hashes for channel
+ members has been made some time ago. Clean up the various tries to
+ do this in the past.
+
+ * erc-macs.el, erc-members.el: Removed.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-backend.el, erc-ibuffer.el, erc-members.el, erc.el: Nothing
+ big changed here. Really. Uhm, maybe the info-buffers are gone or
+ so. Can't really remember. Don't worry, nothing important is
+ missing.
+
+ erc-speedbar.el looks nice btw, did you know?
+
+ Adjusted various places in erc.el, erc-backend.el, erc-ibuffer.el
+ and erc-members.el - too numerous to list here, sorry.
+
+ * erc.el: erc-use-info-buffers: Removed. erc-info-mode-map:
+ Removed.
+ (erc-info-mode): Removed.
+ (erc-find-channel-info-buffer): Removed.
+ (erc-update-channel-info-buffer): Removed.
+ (erc-update-channel-info-buffers): Removed.
+
+ * erc-members.el: erc-update-member renamed to
+ erc-update-channel-member for better clarity.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: This change improves the help output on a bogus command
+ invocation. We display the command as it would be typed by the
+ user, not as it is seen by Emacs.
+
+ (erc-get-arglist): Is now called erc-function-arglist, and returns
+ now an arglist without the enclosing parens.
+ (erc-command-name): New function.
+ (erc-process-input-line): Pass the command name, not the function
+ name.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-process-input-line): Fix bug when the command
+ doesn't have an arglist or no documentation. Thanks bojohan again
+ :)
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el (erc-add-entry-to-list),
+ (erc-remove-entry-from-list): Update docstring, a TEST argument is
+ not given.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-with-buffer): Really fix this docstring.
+
+2004-08-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-with-buffer): Fix double evaluation in macro, and
+ fix docstring.
+
+2004-08-10 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-cmd-JOIN): Use erc-member-ignore-case instead of
+ member-ignore-case.
+
+2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-backend.el: Define an "Edebug specification" for the
+ `define-erc-response-handler' macro. This means that one can step
+ through response handlers defined by this macro with edebug. Maybe
+ more macros would benefit from this?
+
+2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-pcomplete.el (pcomplete/erc-mode/CTCP): New function.
+ Completion for the /CTCP command. (erc-pcomplete-ctcp-commands):
+ New variable. List of ctcp commands.
+
+2004-08-09 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-list.el: Clean up docstrings.
+ (erc-prettify-channel-list): Extend properties to cover the entire
+ line, including the newline, to make it look
+ better.
+ (erc-chanlist-highlight-line): Ditto.
+ (erc-chanlist-mode-hook): Make it a defcustom.
+
+2004-08-09 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-compute-full-name): Typo fix, should be full-name,
+ not name.
+
+2004-08-09 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc): Setup the buffer to be shown in a window at the
+ end of this function. This enables 'window-noselect to work
+ properly.
+ (erc, erc-send-current-line): Fix some
+ goto-char/open-line/goto-char to goto-char/insert.
+
+2004-08-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-parse-user): Live with bogus info from bouncers.
+
+2004-07-31 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-select): Change the docstring to reflect the new
+ arguments; include the arguments in the docstring for non-cvs
+ emacs. Change the parameters to call erc-compute-* instead of
+ using the erc-* variables directly.
+ (erc-compute-server): Made argument optional.
+ (erc-compute-nick): ditto.
+ (erc-compute-full-name): ditto. (erc-compute-port): ditto.
+
+2004-07-30 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-cmd-BANLIST): Fixed a bug where channel-banlist was
+ not reset to nil before fetching an updated banlist from the
+ server.
+
+2004-07-30 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-cmd-BANLIST): Fixed a bug where the
+ 'received-from-server property on variable channel-banlist was not
+ being reset to nil. This fixes the symptom where one types
+ /BANLIST and sees "No bans for channel: #whatever" when you know
+ there are bans.
+
+2004-07-23 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-select-read-args): Use erc-compute-nick to
+ calculate the default nickname
+
+2004-07-20 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-process-sentinel-1): New function. This is an
+ auxiliary function refactored out of erc-process-sentinel to
+ decide a server buffer's fate (whether it should be killed, and
+ whether erc should attempt to auto-reconnect). Michael Olson
+ <mwolson@gnu.org> helped with this.
+ (erc-kill-server-buffer-on-quit): New variable. Used in
+ erc-process-sentinel-1 to decide whether to kill a server buffer
+ when the user quit normally.
+ (erc-process-sentinel): Auxiliary function erc-process-sentinel-1
+ split out. The function body has `with-current-buffer' wrapped
+ around it, to ensure separation of messages if multiple
+ connections were being made. Use `if' instead of `cond' in places
+ where the decision is binary. The last (useless, since the server
+ connection is closed) prompt in the server buffer is removed.
+ Color "erc terminated" and "erc finished" messages with
+ erc-error-face. Mark the buffer unmodified so that, if not killed
+ automatically, the user is not prompted to save it.
+
+2004-07-16 Brian Palmer <bpalmer@gmail.com>
+
+ * erc.el (erc-select-read-args): New function. Prompts the user
+ for arguments to pass to erc-select and erc-select-ssl.
+ (erc-select): Use (erc-select-read-args) when called interactively
+ to get its arguments. When non-interactively, use keyword
+ arguments.
+ (erc-select-ssl): Ditto.
+ (erc-compute-port): New function. Parallel to erc-compute-server,
+ but comes up with a default value for an IRC server's port.
+
+2004-07-16 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el (erc-match-message): Quote the current nickname.
+
+2004-07-12 Brian Palmer <bpalmer@gmail.com>
+
+ * erc-list.el (erc-chanlist-mode): Remove explicit invocation of
+ erc-chanlist-mode-hook, since it's automatically invoked by
+ define-derived-mode
+
+2004-07-03 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el (erc-match-current-nick-p): Quote current nick for
+ regexp parsing.
+
+2004-06-27 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-nickserv.el (erc-nickserv-identify-mode): Fix erroneous
+ parentheses in call to `completing-read'.
+
+2004-06-23 Alex Schroeder <alex@gnu.org>
+
+ * Makefile (release): Depend on autoloads, and copy erc-auto.el
+ into the tarball.
+
+2004-06-14 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-log-irc-protocol): Fixed minor bug where each line
+ received from a server was logged as two lines (one with text and
+ one blank).
+
+2004-06-08 Brian Palmer <bpalmer@gmail.com>
+
+ * erc-list.el (erc-chanlist-frame-parameters): Made customizable.
+ (erc-chanlist-header-face): Changed to use defface with some
+ reasonable defaults instead of make-face, and removed the
+ associated -face variable.
+ (erc-chanlist-odd-line-face): Ditto.
+ (erc-chanlist-even-line-face): Ditto.
+ (erc-chanlist-highlight-face): New variable. Holds a face used for
+ highlighting the current line.
+ (erc-cmd-LIST): Use erc-member-ignore-case instead of
+ member-ignore-case.
+ (erc-chanlist-post-command-hook): Change to move the highlight
+ overlay instead of refontifying the entire buffer.
+ (erc-chanlist-dehighlight-line): Added to detach the highlight
+ overlay from the buffer.
+
+2004-05-31 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: erc-mode-line-format: Add column numbers.
+
+2004-05-31 Adrian Aichner <adrian@xemacs.org>
+
+ * erc-autojoin.el: Typo fix.
+
+ * erc-dcc.el (erc-dcc-do-GET-command): Use expand-file-name.
+ (erc-dcc-get-file): XEmacs set-buffer-multibyte compatibility.
+
+ * erc-log.el: Append `erc-log-setup-logging' to
+ `erc-connect-pre-hook' so that `erc-initialize-log-marker' is run
+ first (markers are needed by `erc-log-setup-logging').
+ (erc-enable-logging): Docstring fix.
+ (erc-log-setup-logging): Move `erc-log-insert-log-on-open' to (1-
+ (point-max)) when doing `erc-log-insert-log-on-open'. Modified
+ version of a patch by Lawrence Mitchell.
+ (erc-log-all-but-server-buffers): Do `save-excursion' as well.
+ (erc-current-logfile): Pass buffer name as target
+ argument to `erc-generate-log-file-name-function' if
+ `erc-default-target' is nil.
+ (erc-generate-log-file-name-with-date): Use expand-file-name.
+ (erc-generate-log-file-name-short): Ditto.
+ (erc-save-buffer-in-logs): Do `save-excursion' and test whether
+ erc-last-saved-position is a marker.
+
+ * erc-members.el: Avoid miscompiling macro `erc-log' and
+ `with-erc-channel-buffer' by requiring 'erc at compile time.
+
+ * erc-sound.el: Use expand-file-name.
+
+ * erc.el (erc-debug-log-file): Ditto.
+ (erc-find-file): Ditto.
+
+2004-05-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el, erc-backend.el (erc-cmd-BANLIST): Added a missing "'"
+ that was preventing /BANLIST from working. In erc-backend.el,
+ added server response handler for 367 and 368 responses to get
+ /BANLIST working.
+
+2004-05-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el: Removed an eval-when-compile that was preventing the
+ byte-compiled version of this file from loading.
+
+2004-05-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el: Undid part of my last change. I suspect it was wrong.
+
+2004-05-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el: Silenced several byte-compiler warnings.
+
+2004-05-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-log-irc-protocol): Fixed problem where this function
+ misformatted IRC protocol text if multiple lines were received from
+ the server at one time.
+
+2004-05-25 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-toggle-debug-irc-protocol): Cosmetic changes to the
+ informational text in the *erc-protocol* buffer.
+
+2004-05-24 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-log-irc-protocol, erc-process-filter): Now the lines
+ inserted in the *erc-protocol* buffer are prefixed with the name
+ of the network to/from which the data is going/coming. This makes
+ reading the *erc-protocol* buffer much easier when connected to
+ multiple networks.
+
+2004-05-23 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * erc-backend.el: Fixes server message parsing so that command
+ arguments specified after the colon are not treated specially. All
+ arguments are added to the `command-args' field, and the
+ `contents' points to the last element in the `command-args' list.
+ This allows ERC to connect to networks such as Undernet. Although
+ keeping `contents' allows many of the response handlers to
+ continue to work as-is, many other are probably broken by this
+ patch.
+
+2004-05-20 Lawrence Mitchell <wence@gmx.li>
+
+ * HACKING: Add comment that C-c C-a can be useful if you write
+ ChangeLog entries using Emacs' standard functions.
+
+2004-05-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-speedbar.el: Ignore errors when attempting to require dframe
+ (there are a couple implementations of speedbar, one of which uses
+ of dframe).
+ (erc-speedbar-version): New.
+ (erc-speedbar-goto-buffer): Use dframe functions if dframe is
+ available.
+
+2004-05-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autojoin.el: Added local variables for this file.
+ (erc-autojoin-add): The channel name is in `erc-response.contents'.
+
+2004-05-17 Mario Lang <mlang@delysid.org>
+
+ * erc-log.el: Don't autoload a define-key statement, erc-mode-map
+ might not be known yet
+
+2004-05-16 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-backend.el (erc-parse-server-response): Revert to original
+ `erc-parse-line-from-server' version, since new version breaks for
+ a number of edge cases.
+
+2004-05-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-backend.el (erc-handle-unknown-server-response): New
+ function. Added to `erc-default-server-functions'. Display
+ unknown responses to the user.
+ (221): Don't show nickname in modes list.
+ (254): Fixed to use 's254.
+ (303): Added docstring.
+ (315, 318, 323, 369): Ignored responses grouped together.
+ (391): New.
+ (406, 432): Use ?n, not ?c in `erc-display-message'.
+ (431, 445, 446, 451, 462, 463, 464, 465, 481, 483, 485, 491, 501,
+ 502): All error responses with no arguments grouped together.
+
+2004-05-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-message-type-member): Use `erc-response.command'.
+ `erc-track-exclude-types' should be respected again.
+ (erc-cmd-TIME): Fixed to work with and without server given as
+ argument.
+ (erc-define-catalog): Added, s391, s431, s445, s446, s451, s462,
+ s463, s464, s465, s483, s484, s485, s491, s501, s502.
+
+2004-05-14 Lawrence Mitchell <wence@gmx.li>
+
+ * HACKING: Typo fix.
+
+2004-05-14 Lawrence Mitchell <wence@gmx.li>
+
+ * Makefile (erc-auto.el): Pass -f flag to rm so that we don't fail
+ if erc-auto.elc doesn't exist.
+
+2004-05-14 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-backend.el (erc-with-buffer): Autoload.
+ (erc-parse-server-response): XEmacs' `replace-match' only replaces
+ subexpressions when operating on buffers, not strings, work around
+ it.
+ (461): Command with invalid arguments is `second', not `third'.
+
+2004-05-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-notify.el (erc-notify-NICK): Use `erc-response.contents' to
+ get nickname.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-track.el: Indentation fixes.
+ (track-when-inactive): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-notify.el (notify): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+ (erc-notify-timer, erc-notify-JOIN, erc-notify-NICK)
+ (erc-notify-QUIT): Use new accessors for PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nickserv.el (services, erc-nickserv-identify-mode): Use
+ `erc-server-FOO-functions', not `erc-server-FOO-hook.
+ (erc-nickserv-identify-autodetect): Use new accessors for PARSED
+ argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-netsplit.el (netsplit): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+ (erc-netsplit-JOIN, erc-netsplit-MODE, erc-netsplit-QUIT): Use new
+ accessors for PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nets.el: Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-menu.el (erc-menu-definition): Only allow listing of
+ channels if `erc-cmd-LIST' is fboundp.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-match.el: Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+ (erc-get-parsed-vector-nick, erc-get-parsed-vector-type): Use new
+ accessors for PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-list.el (erc-chanlist, erc-chanlist-322): Use new accessors
+ for PARSED argument. Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-ezbounce.el (erc-ezb-notice-autodetect): Use new accessors
+ for PARSED argument.
+ (erc-ezb-initialize): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-dcc.el: Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+ (erc-dcc-no-such-nick): Use new accessors for PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-bbdb.el (erc-bbdb-whois, erc-bbdb-JOIN, erc-bbdb-NICK): Use
+ new accessors for PARSED argument.
+ (BBDB): Use `erc-server-FOO-functions', not `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-autojoin.el (autojoin): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+ (erc-autojoin-add, erc-autojoin-remove): Use new accessors for
+ PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-autoaway.el (autoaway): Use `erc-server-FOO-functions', not
+ `erc-server-FOO-hook.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-backend): Require.
+ (erc-disconnected-hook, erc-join-hook, erc-quit-hook)
+ (erc-part-hook, erc-kick-hook): Docstring fix, we now use
+ `erc-server-FOO-functions', rather than `erc-server-FOO-hook'.
+ (erc-event-to-hook-name, erc-event-to-hook): Remove.
+ (erc-once-with-server-event)
+ (erc-once-with-server-event-global): Use `erc-get-hook'
+ (erc-process-filter): Use `erc-parse-server-response'.
+ (erc-cmd-IDLE, erc-cmd-BANLIST, erc-cmd-MASSUNBAN): New accessors
+ for PARSED argument. Rename all `erc-server-FOO-hook' to
+ `erc-server-FOO-functions'.
+ (erc-server-364-hook, erc-server-365-hook, erc-server-367-hook)
+ (erc-server-368-hook, erc-server-KILL-hook)
+ (erc-server-PONG-hook, erc-server-200-hook, erc-server-201-hook)
+ (erc-server-202-hook, erc-server-203-hook, erc-server-204-hook)
+ (erc-server-205-hook, erc-server-206-hook, erc-server-208-hook)
+ (erc-server-209-hook, erc-server-211-hook, erc-server-212-hook)
+ (erc-server-213-hook, erc-server-214-hook, erc-server-215-hook)
+ (erc-server-216-hook, erc-server-217-hook, erc-server-218-hook)
+ (erc-server-219-hook, erc-server-241-hook, erc-server-242-hook)
+ (erc-server-243-hook, erc-server-244-hook, erc-server-249-hook)
+ (erc-server-261-hook, erc-server-262-hook, erc-server-302-hook)
+ (erc-server-323-hook, erc-server-342-hook, erc-server-351-hook)
+ (erc-server-381-hook, erc-server-382-hook, erc-server-391-hook)
+ (erc-server-392-hook, erc-server-393-hook, erc-server-394-hook)
+ (erc-server-395-hook, erc-server-402-hook, erc-server-404-hook)
+ (erc-server-407-hook, erc-server-409-hook, erc-server-411-hook)
+ (erc-server-413-hook, erc-server-414-hook, erc-server-415-hook)
+ (erc-server-422-hook, erc-server-423-hook, erc-server-424-hook)
+ (erc-server-431-hook, erc-server-436-hook, erc-server-437-hook)
+ (erc-server-441-hook, erc-server-443-hook, erc-server-444-hook)
+ (erc-server-445-hook, erc-server-446-hook, erc-server-451-hook)
+ (erc-server-462-hook, erc-server-463-hook, erc-server-464-hook)
+ (erc-server-465-hook, erc-server-467-hook, erc-server-471-hook)
+ (erc-server-472-hook, erc-server-473-hook, erc-server-483-hook)
+ (erc-server-491-hook, erc-server-502-hook): Remove.
+ (erc-call-hooks, erc-parse-line-from-server): Remove
+ (erc-server-hook-list): Remove. Remove top-level call too.
+ (erc-server-ERROR, erc-server-INVITE, erc-server-JOIN)
+ (erc-server-KICK, erc-server-MODE, erc-server-NICK)
+ (erc-server-PART, erc-server-PING, erc-server-PONG)
+ (erc-server-PRIVMSG-or-NOTICE, erc-server-QUIT)
+ (erc-server-TOPIC, erc-server-WALLOPS, erc-server-001)
+ (erc-server-004, erc-server-005, erc-server-221, erc-server-252)
+ (erc-server-253, erc-server-254, erc-server-301, erc-server-303)
+ (erc-server-305, erc-server-306, erc-server-311-or-314)
+ (erc-server-312, erc-server-313, erc-server-317, erc-server-319)
+ (erc-server-320, erc-server-321, erc-server-322, erc-server-324)
+ (erc-server-329, erc-server-330, erc-server-331, erc-server-332)
+ (erc-server-333, erc-server-341, erc-server-352, erc-server-353)
+ (erc-server-366, erc-server-MOTD, erc-server-379)
+ (erc-server-401, erc-server-403, erc-server-405, erc-server-406)
+ (erc-server-412, erc-server-421, erc-server-432, erc-server-433)
+ (erc-server-437, erc-server-442, erc-server-461, erc-server-474)
+ (erc-server-475, erc-server-477, erc-server-481, erc-server-482)
+ (erc-server-501): Move to erc-backend.el
+ (erc-auto-query, erc-banlist-store, erc-banlist-finished)
+ (erc-banlist-update, erc-connection-established)
+ (erc-process-ctcp-query, erc-display-server-message): Use new
+ accessors for PARSED argument.
+
+2004-05-13 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-backend.el (erc-parse-server-response)
+ (erc-handle-parsed-server-response, erc-get-hook)
+ (define-erc-response-handler): New functions.
+ (erc-response): New struct for server responses.
+ (erc-server-responses): New variable.
+ (erc-call-hooks): Move from erc.el and rework.
+ (ERROR, INVITE, JOIN, KICK, MODE, NICK, PART, PING, PONG)
+ (PRIVMSG, NOTICE, QUIT, TOPIC, WALLOPS, 001, MOTD, 376, 004)
+ (252, 253, 254, 250, 301, 303, 305, 306, 311, 312, 313, 315)
+ (317, 318, 319, 320, 321, 322, 324, 329, 330, 331, 332, 333)
+ (341, 352, 353, 366, 369, 379, 401, 403, 405, 406, 412, 421)
+ (432, 433, 437, 442, 461, 474, 477, 481, 482, 501, 323, 221)
+ (002, 003, 371, 372, 374, 375, 422, 251, 255, 256, 257, 258)
+ (259, 265, 266, 377, 378, 314, 475, 364, 365, 367, 368, 381)
+ (382, 391, 392, 393, 394, 395, 200, 201, 202, 203, 204, 205)
+ (206, 208, 209, 211, 212, 213, 214, 215, 216, 217, 218, 219)
+ (241, 242, 243, 244, 249, 261, 262, 302, 342, 351, 402, 404)
+ (407, 409, 411, 413, 414, 415, 423, 424, 431, 436, 441, 443)
+ (444, 445, 446, 451, 462, 463, 464, 465, 467, 471, 472, 473)
+ (483, 491, 502, 005, KILL): Move from erc.el and rework using
+ `define-erc-response-handler' and erc-response struct.
+
+2004-05-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: A few bug fixes to avoid errors after disconnect,
+ including the "Selecting deleted buffer" bug.
+ (erc-channel-user-op-p, erc-channel-user-voice-p): Make sure NICK
+ is non-nil (`erc-current-nick' can return nil).
+ (erc-server-buffer): Make sure the buffer isn't a #<killed
+ buffer>.
+ (erc-server-buffer-live-p): New function.
+ (erc-display-line, erc-join-channel, erc-prepare-mode-line-format,
+ erc-away-p): Use `erc-server-buffer-live-p' to make sure process
+ buffer exists.
+ (erc-send-current-line): If there is no server buffer, let the
+ user know.
+
+2004-05-12 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-log.el: C-c C-l keybinding now defined in
+ erc-log.el.
+ (erc-log-version): New.
+ (erc-cmd-JOIN): Fix applied for bug where /join -invite causes
+ errors when there's no `invitation'.
+
+2004-05-11 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-cmd-JOIN): Make sure `chnl' is non-nil before trying
+ to join anything (chnl is not set if /join -invite is used but
+ there's no `invitation').
+
+2004-05-10 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-log.el: Define C-c C-l keybinding outside of `erc-log-mode',
+ making it available all the time; autoload definition.
+ (erc-log-version): New.
+
+2004-05-09 Diane Murray <disumu@x3y2z1.net>
+
+ * AUTHORS, CREDITS, Makefile, erc-autoaway.el, erc-autojoin.el,
+ erc-button.el, erc-chess.el, erc-dcc.el, erc-ezbounce.el,
+ erc-fill.el, erc-ibuffer.el, erc-imenu.el, erc-lang.el,
+ erc-list.el, erc-log.el, erc-macs.el, erc-match.el, erc-members.el,
+ erc-menu.el, erc-nets.el, erc-netsplit.el, erc-nickserv.el,
+ erc-notify.el, erc-page.el, erc-ring.el, erc-speak.el,
+ erc-speedbar.el, erc-stamp.el, erc-track.el, erc-truncate.el,
+ erc-xdcc.el, erc.el: Applied all relevant bug fixes and code
+ cleanup made between the time of the ERC_4_0_RELEASE tag until now.
+
+2004-05-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el: Updated copyright years.
+
+2004-05-09 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-channel-info-buffer): Correct bug in sorting
+ of channel users. Tiny change from Andreas Schwab
+ <schwab@suse.de>.
+
+2004-05-09 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-fill.el (erc-fill-variable): Fix docstring.
+
+2004-05-09 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-button.el (erc-button-add-button): Use 'keymap
+ text-property, rather than 'local-map, since it's cross-emacs
+ compatible. Pass :mouse-down-action into `widget-convert-button'
+ as 'erc-button-click-button, to make XEmacs happy. Replace bogus
+ reference to erc-widget-press-button with erc-button-press-button.
+ (erc-button-click-button): New (ignored) first argument, to make
+ XEmacs behave when pressing buttons.
+ (erc-button-press-button): New (ignored) &rest argument.
+
+2004-05-09 Adrian Aichner <adrian@xemacs.org>
+
+ * erc-log.el (erc-conditional-save-buffer): Fix docstring
+ reference to erc-save-queries-on-quit.
+ (erc-conditional-save-queries): Ditto.
+
+2004-05-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-speedbar.el: Updated copyright years. Added local variables
+ for this file; fixed indenting.
+ (erc-speedbar): New group.
+ (erc-speedbar-sort-users-type): New variable.
+ (erc-speedbar-buttons): Handle query buffers (fixes a bug where an
+ error would be thrown if the current buffer was a query). Ignore
+ unknown buffers.
+ (erc-speedbar-expand-channel): Show limit and key with channel
+ modes. Sort users according to `erc-speedbar-sort-users-type'.
+ (erc-speedbar-insert-user): Fixed bug where only nicks with more
+ info were being listed, and those were shown twice.
+ (erc-speedbar-goto-buffer): Don't use dframe functions, as dframe
+ isn't available with the default speedbar.
+
+2004-05-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-sort-channel-users-alphabetically): New function.
+ (erc-server-412, erc-server-432, erc-server-475): New functions.
+ (erc-server-412-hook, erc-server-432-hook, erc-server-475-hook):
+ Use them.
+ (erc-server-401, erc-server-403, erc-server-405)
+ (erc-server-421, erc-server-474, erc-server-481): Use catalog
+ messages.
+ (erc-define-catalog): Added s401, s403, s405, s412, s421, s432,
+ s474, s475, and s481.
+
+2004-05-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nickserv.el: Added documentation to Commentary, Usage.
+ Removed `outline-mode' from file local variables.
+ (erc-services-mode): Use `erc-nickserv-identify-mode' to add
+ hooks.
+ (erc-nickserv-identify-mode): New function.
+ (erc-nickserv-identify-mode): New variable.
+ (erc-prompt-for-nickserv-password, erc-nickserv-passwords):
+ Changed docstring.
+ (erc-nickserv-identify-autodetect): Use
+ `erc-nickserv-call-identify-function'. Docstring change.
+ (erc-nickserv-identify-on-connect,
+ erc-nickserv-identify-on-nick-change,
+ erc-nickserv-call-identify-function): New functions.
+ (erc-nickserv-identify): PASSWORD is not optional. Autoload
+ function.
+
+2004-05-05 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-join-hook, erc-quit-hook, erc-part-hook,
+ erc-kick-hook, erc-connect-pre-hook): Now customizable.
+ (erc-nick-changed-functions): New hook.
+ (erc-server-NICK): Run `erc-nick-changed-functions' with the
+ arguments NEW-NICK and OLD-NICK.
+ (erc-channel-user-voice-p, erc-channel-user-voice-p): Shortened
+ docstring.
+
+2004-05-05 Lawrence Mitchell <wence@gmx.li>
+
+ * HACKING: New section on function/variable naming and coding
+ conventions.
+
+2004-05-05 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-wash-quit-reason): Quote regexp special characters
+ in NICK, LOGIN and HOST.
+
+2004-05-04 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-server-parameters): Typo fix in docstring.
+ (erc-input-line-position): `:type' is now a choice between integer
+ and nil. (erc-mode-map): Bind `erc-get-channel-mode-from-keypress'
+ to C-c C-o instead of C-c RET (C-c C-m). (erc-cmd-GQUIT): Use
+ REASON as argument when calling `erc-cmd-QUIT'.
+
+2004-05-03 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nicklist.el: Initial version.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el: Added local variables for file, fixed indenting.
+ (erc-menu-version): New variable.
+ (erc-menu-definition): "List channels": New. "Join channel": Use
+ `erc-connected' as test. "Start a query": New. "List channel
+ operators": New. "Input action": Moved up. "Set topic": Fixed
+ test so it's only active in channels. "Leave this channel": Moved
+ down. "Track hidden channel buffers": Removed. "Enable/Disable
+ ERC Modules": New.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-mode-map): Removed binding for
+ `erc-save-buffer-in-logs' (moved to erc-log.el).
+ (erc-cmd-QUERY, erc-cmd-OPS): Now interactive.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-log.el: Added local variables for this file.
+ (erc-log-channels-directory): Added directory as a choice in
+ `:type'.
+ (define-erc-module): Define and undefine key binding (C-c
+ C-l) for `erc-save-buffer-in-logs' here.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nets.el: Added local variables for this file.
+ (erc-networks-alist): Fixed `:type' to work better in
+ customization.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-match.el: Added local variables for file. (erc-keywords):
+ Use `list' instead of `cons' in `:type'. Fixes bug where mismatch
+ was shown in customization. (erc-current-nick-highlight-type):
+ Escape parentheses in docstring. Added keyword, nick-or-keyword as
+ options in `:type'.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-stamp.el: Added local variables for file.
+ (erc-away-timestamp-format): Allow nil as a choice in `:type'.
+ (erc-timestamp-intangible): Changed `:type' to boolean.
+ (erc-timestamp-right-column): Added `:group' and `:type'.
+
+2004-04-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-modules): Added bbdb, log, match, sound, and stamp
+ as `:type' options; changed documentation for autojoin, fill,
+ pcomplete, track. (erc-prompt-for-channel-key): New variable.
+ (erc-join-channel): Only prompt for key if
+ `erc-prompt-for-channel-key' is non-nil. (erc-format-my-nick): New
+ function. (erc-send-message, erc-send-current-line): Use it.
+
+2004-04-24 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-track.el (erc-track-modified-channels): Fix indentation.
+
+2004-04-24 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-match.el (erc-hide-fools): Docstring fix.
+ (erc-log-matches-types-alist): Added `current-nick' to valid
+ choices.
+
+2004-04-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-page.el, erc-ezbounce.el, erc-speak.el, erc-match.el,
+ erc-track.el (erc-ezbounce, erc-page, erc-speak): Groups defined.
+ (erc-match, erc-track): `erc' is parent group.
+ (erc-ezb-regexp, erc-ezb-login-alist): Added `:group'.
+
+2004-04-20 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-fill.el: Fixed erc-fill-static so it breaks the lines at the
+ right column and respects timestamps. Patch by Simon Siegler
+ <simon@trz-kril.de>
+ (erc-fill-static): Major rewrite and split up into some functions.
+ (erc-count-lines): Removed.
+ (erc-fill-regarding-timestamp): New function.
+ (erc-timestamp-offset): New function.
+ (erc-restore-text-properties): New function.
+ (erc-fill-variable): Respect leftbound timestamp. This is still
+ broken if someone has both erc-timestamp-only-if-changed-flag set
+ and erc-insert-timestamp-function set to
+ 'erc-insert-timestamp-left, but otherwise it works now.
+
+2004-04-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-cmd-SV): Show features gtk, mac-carbon, multi-tty.
+ Fixed so that arguments fit the format (build date was not being
+ shown).
+
+2004-04-19 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-channel-topic): Error if `channel-topic' is
+ unbound. Remove %-sign substitution.
+ (erc-update-mode-line-buffer): Escape %-signs in `channel-topic'
+ here.
+
+2004-04-19 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-send-action, erc-ctcp-query-ACTION,
+ erc-ctcp-reply-ECHO-hook): Let `erc-display-message-highlight'
+ propertize the message.
+ (erc-display-message-highlight): Allow for any erc-TYPE-face.
+ (erc-cmd-JOIN): Display error message instead of throwing an error
+ if there's no `invitation'.
+ (erc-cmd-PART): Allow for no reason if channel is provided. Fixes
+ bug where user would part the current channel with the other
+ channel's name as reason when no reason was given.
+ (erc-server-vectors, erc-debug-missing-hooks): Added docstring.
+ (erc-server-JOIN): Moved `erc-join-hook' to JOIN-you section.
+ `erc-join-hook' called by `run-hook-with-args', sending the ARGS
+ `chnl' and the channel's buffer. Changed an instance of if
+ without else to when.
+ (erc-server-477): New function.
+ (erc-server-477-hook): Use `erc-server-477'.
+ (erc-define-catalog): Added `no-invitation'.
+
+2004-04-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nickserv.el: Local variables for file added.
+ (erc-nickserv-passwords): Customization: Network symbols updated
+ to reflect `erc-nickserv-alist'. Allow user to type in network
+ symbol.
+ (erc-nickserv-alist): Now customizable variable.
+
+2004-04-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autoaway.el (erc-autoaway-reset-idletime): Make sure `line'
+ is a string to avoid errors upon startup.
+
+2004-04-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autoaway.el (erc-autoaway-version): New variable.
+ (erc-auto-discard-away): Updated docstring.
+ (erc-autoaway-no-auto-back-regexp): New variable.
+ (erc-autoaway-reset-idletime): Use it. Hopefully a better solution
+ which allows for aliases to "/away" and any other text that the
+ user wants to ignore when `erc-auto-discard-away' is non-nil.
+
+2004-04-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autoaway.el (erc-autoaway-reset-idletime): Forgot /gaway in
+ regexp.
+
+2004-04-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-autoaway.el (erc-autoaway-reset-idletime): If the user sends
+ an "/away" command, don't call `erc-autoaway-set-back', fixes bug
+ where ERC would send "/away" when user was already away and sent an
+ "/away reason". Changed `l' to `line' for better understanding.
+ (erc-autoaway-set-back): Changed `l' to `line' for better
+ understanding.
+
+2004-04-05 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-set-channel-key): Now able to remove key.
+ (erc-set-channel-limit): Now able to remove limit.
+ (erc-get-channel-mode-from-keypress): Fixed docstring.
+
+2004-04-04 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-join-channel): Allow for optional channel key.
+ (erc-set-modes): Need to set `channel-key' to nil in case of mode
+ changes during split.
+ (erc-show-channel-key-p): New variable.
+ (erc-prepare-mode-line-format): Only show key if
+ `erc-show-channel-key-p' is non-nil.
+
+2004-04-04 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (channel-key): New variable.
+ (erc-update-channel-key): New function.
+ (erc-set-modes, erc-parse-modes, erc-update-modes, erc,
+ erc-update-channel-info-buffer): Deal with channel keys.
+ (erc-prepare-mode-line-format): Show channel key in header-line.
+ (erc-server-NICK): Show nick change in server buffer as well.
+ (erc, erc-send-command, erc-banlist-store, erc-banlist-update,
+ erc-load-irc-script-lines,
+ erc-arrange-session-in-multiple-windows, erc-handle-login,
+ erc-find-channel-info-buffer): Changed when not to unless.
+ (erc-server-MODE): Changed if without else to when.
+
+2004-03-27 Adrian Aichner <adrian@xemacs.org>
+
+ * erc.el (erc-cmd-BANLIST): Use `truncate-string-to-width'
+ instead of `truncate-string' alias.
+ (erc-nickname-in-use): Ditto.
+
+2004-03-27 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el (erc-cmd-list): Fixed error caused by erc-cmd-LIST
+ passing a non-sequence to erc-chanlist.
+
+2004-03-22 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * erc.el: Add new hook `erc-join-hook', which is run when we join a
+ channel.
+
+2004-03-22 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * erc.el: Replaced existing notice user notification system and
+ the configuration options, which consisted of
+ `erc-echo-notices-in-minibuffer-flag' and
+ `erc-echo-notices-in-current-buffer' with two new hooks,
+ `erc-echo-notice-hook' and `erc-echo-notice-always-hook'.
+
+ When user notification is needed, `erc-echo-notice-always-hook' is
+ first run using `run-hook-with-args', then `erc-echo-notice-hook'
+ is run using `run-hook-with-args-until-success'.
+
+ In addition to these hooks, a large number of functions, which are
+ described in the documentation strings of those hooks, were added
+ which can be used to achieve a large variety of different
+ behaviors.
+
+ The current default behavior, which is identical to the existing
+ default behavior, is for `erc-echo-notice-always-hook' to be set to
+ `(erc-echo-notice-in-default-buffer).
+
+2004-03-21 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-track.el (erc-modified-channels-display): Added a space
+ before opening bracket.
+
+2004-03-21 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-format-query-as-channel-p): New variable.
+ (erc-server-PRIVMSG-or-NOTICE): If `erc-format-query-as-channel-p'
+ is nil, messages in the query buffer are formatted like private
+ messages.
+
+ (erc-server-252-hook, erc-server-253-hook, erc-server-254-hook,
+ erc-server-256-hook, erc-server-257-hook, erc-server-258-hook,
+ erc-server-259-hook, erc-server-371-hook, erc-server-372-hook,
+ erc-server-374-hook, erc-server-374-hook, erc-server-442-hook,
+ erc-server-477-hook): Removed, now defined in
+ `erc-server-hook-list'.
+ (erc-display-server-message): New function.
+ (erc-server-252, erc-server-253, erc-server-254, erc-server-442):
+ New functions.
+ (erc-server-hook-list): Added 250, 256, 257, 258, 259, 265, 266,
+ 377, 378, 477 - using `erc-display-server-message'. 251, 255 now
+ use `erc-display-server-message'. Added 252, 253, 254, 442 -
+ using respective erc-server-* functions. 371, 372, 374, 375 now
+ defined here.
+ (erc-define-catalog): Added s252, s253, s254, s442.
+ (erc-server-001, erc-server-004, erc-server-005): Fixed
+ documentation.
+
+2004-03-20 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-stamp.el: Commentary: Changed `erc-stamp-mode' to
+ `erc-timestamp-mode'.
+ (erc-insert-timestamp-left): Use `erc-timestamp-face' on filler
+ spaces as well.
+
+2004-03-19 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-send-action): Use `erc-input-face'.
+ (erc-display-message-highlight): If the requested highlighting
+ type doesn't match, just display the string with no highlighting
+ and warn about it with `erc-log'.
+ (erc-cmd-JOIN): If user is already on the requested channel,
+ switch to that channel's buffer.
+ (erc-ctcp-query-ACTION): Use `erc-action-face' for nick as well.
+ (erc-header-line-use-help-echo-p): New variable.
+ (erc-update-mode-line-buffer): Use `help-echo' for header-line if
+ `erc-header-line-use-help-echo-p' is non-nil.
+
+2004-03-18 Adrian Aichner <adrian@xemacs.org>
+
+ * erc-nets.el: Use two arguments version of `make-obsolete', if
+ third argument is not supported (for XEmacs).
+
+2004-03-18 Andreas Fuchs <asf@void.at>
+
+ * CREDITS: added CREDITS entry for Adrian Aichner
+
+2004-03-18 Andreas Fuchs <asf@void.at>
+
+ * erc-xdcc.el, erc.el, erc-autoaway.el, erc-autojoin.el,
+ erc-button.el, erc-dcc.el, erc-ezbounce.el, erc-imenu.el,
+ erc-list.el, erc-log.el, erc-match.el, erc-members.el,
+ erc-menu.el, erc-netsplit.el, erc-notify.el, erc-speedbar.el,
+ erc-stamp.el, erc-track.el, erc-truncate.el:
+ (erc-coding-sytem-for-target): Removed.
+ (erc-coding-system-for-target): New.
+ (erc-autoaway-use-emacs-idle): Typo fix.
+ (erc-auto-set-away): Ditto.
+ (erc-auto-discard-away): Ditto.
+ (autojoin): Ditto.
+ (erc-button-alist): Ditto.
+ (erc-dcc-auto-masks): Ditto.
+ (erc-dcc-chat-send-input-line): Ditto.
+ (erc-ezb-get-login): Ditto.
+ (erc-unfill-notice): Ditto.
+ (erc-save-buffer-in-logs): Ditto.
+ (match): Ditto.
+ (erc-log-matches-types-alist): Ditto.
+ (erc-match-directed-at-fool-p): Ditto.
+ (erc-match-message): Ditto.
+ (erc-update-member): Ditto.
+ (erc-ignored-reply-p): Ditto.
+ (erc-menu-definition): Ditto.
+ (erc-netsplit-QUIT): Ditto.
+ (erc-notify-list): Ditto.
+ (erc-speedbar-update-channel): Ditto.
+ (erc-speedbar-item-info): Ditto.
+ (erc-stamp): Ditto.
+ (erc-timestamp-intangible): Ditto.
+ (erc-add-timestamp): Ditto.
+ (erc-timestamp-only-if-changed-flag): Ditto.
+ (erc-show-timestamps): Ditto.
+ (erc-track-priority-faces-only): Ditto.
+ (erc-modified-channels-alist): Ditto.
+ (erc-unique-substrings): Ditto.
+ (erc-find-parsed-property): Ditto.
+ (erc-track-switch-direction): Ditto.
+ (erc-truncate-buffer-to-size): Ditto.
+ (erc-xdcc): Ditto.
+ (erc-auto-reconnect): Ditto.
+ (erc-startup-file-list): Ditto.
+ (erc-once-with-server-event): Ditto.
+ (erc-once-with-server-event-global): Ditto.
+ (erc-mode): Ditto.
+ (erc-generate-new-buffer-name): Ditto.
+ (erc): Ditto.
+ (erc-open-ssl-stream): Ditto.
+ (erc-default-coding-system): Ditto.
+ (erc-encode-string-for-target): Ditto.
+ (erc-decode-string-from-target): Ditto.
+ (erc-scroll-to-bottom): Ditto.
+ (erc-decode-controls): Ditto.
+ (erc-channel-members-changed-hook): Ditto.
+ (erc-put-text-property): Ditto.
+ (erc-add-default-channel): Ditto.
+
+2004-03-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-process-sentinel): Cancel ping timer upon
+ disconnect.
+ (erc-cmd-PART): Use same regexp as `erc-cmd-QUIT' when no #channel
+ is provided.
+ (erc-nick-uniquifier, erc-manual-set-nick-on-bad-nick-p): `:group'
+ was missing, added.
+ (erc-part-reason-zippy, erc-part-reason-zippy): Removed FIXME
+ comments. I see no problem allowing typed in reasons.
+
+2004-03-16 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-stamp.el (erc-insert-timestamp-left): Added support for
+ `erc-timestamp-only-if-changed-flag' and added docstring.
+ (erc-timestamp-only-if-changed-flag): Updated documentation.
+
+2004-03-13 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-nets.el (erc-network-name): No longer marked as obsolete.
+ Why was this function made obsolete? There is no other function
+ that performs this task. Some of us use these functions in our
+ personal ERC configs.
+
+2004-03-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-buffer-filter): Use `with-current-buffer'.
+ (erc-process-input-line): Append newline to documentation. Fixes a
+ bug whereby the prompt would be put on the same line as the output.
+ (erc-cmd-GQUIT): Only try and send QUIT if the process is alive.
+
+2004-03-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-log.el: Only add top-level hooks if `erc-enable-logging' is
+ non-nil.
+
+2004-03-10 Damien Elmes <erc@repose.cx>
+
+ * erc-nets.el: From Adrian Aichner (adrian /at/ xemacs /dot/ org)
+ * erc-nets.el: XEmacs make-obsolete only takes two arguments.
+
+2004-03-10 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nets.el (erc-determine-network): Use `erc-session-server' if
+ `erc-announced-server' is nil to avoid error if server does not
+ send 004 (RPL_MYINFO) message.
+
+2004-03-10 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nets.el (erc-server-alistm erc-settings): Use lowercase
+ "freenode", as in `erc-networks-alist'.
+
+2004-03-10 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nickserv.el (erc-nickserv-alist): Use lowercase "freenode",
+ as in `erc-networks-alist'.
+
+2004-03-10 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-dcc.el (pcomplete/erc-mode/DCC): Append "send" as a list.
+
+2004-03-10 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-nets.el (erc-networks-alist): Changed "Freenode" to
+ "freenode".
+
+2004-03-10 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el (erc-cmd-LIST): Improved the docstring. Made
+ message to user more accurate depending on whether a single
+ channel is being listed or not.
+
+2004-03-10 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-nets.el (erc-determine-network): Make matching logic simpler
+ (suggested by Damian Elmes).
+ (erc-current-network, erc-network-name): Add `make-obsolete' form.
+ (erc-set-network-name): Indentation fix.
+ (erc-ports-list): Add docstring. Rework function body to use
+ `nconc'.
+
+2004-03-09 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-list.el, erc-notify.el (require 'erc-nets): Added.
+
+2004-03-08 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el (erc-network-name): Function definition moved to
+ erc-nets.el. The functions `erc-determine-network' and
+ `erc-network' in erc-nets.el do what this did before. Deprecated.
+ Use (erc-network) instead.
+
+2004-03-08 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nickserv.el: Changed copyright notice. Now require
+ erc-nets. erc-nets.el now takes care of network-related functions
+ and variables.
+ (erc-nickserv-alist): Changed network symbols to match those in
+ `erc-networks-alist' in erc-nets.el.
+ (erc-nickserv-identify-autodetect): Use `erc-network'.
+ (erc-nickserv-identify): Use `erc-network'. Changed wording for
+ interactive use, now shows current nick.
+ (erc-networks): Removed. Use `erc-networks-alist' as defined in
+ erc-nets.el.
+ (erc-current-network): Function definition moved to erc-nets.el.
+ The functions `erc-determine-network' and `erc-network' in
+ erc-nets.el do what this did before. Deprecated. Use
+ (erc-network) instead.
+
+2004-03-08 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nets.el: Added commentary, `erc-nets-version'.
+ (erc-server-alist): Changed Brasnet to BRASnet.
+ (erc-networks-alist): All networks (except EFnet and IRCnet) now
+ have a MATCHER. (erc-network): New variable.
+ (erc-determine-network): New function. Determine the network the
+ user is on. Use the server parameter NETWORK, if provided, else
+ parse the server name and search for a match (regexp and loop by
+ wencem) in `erc-networks-alist'. Return the name of the network
+ or "Unknown" as a symbol.
+ (erc-network): New function. Returns value of `erc-network'. Use
+ this when the current buffer is not the server process buffer.
+ (erc-current-network): Returns the value of `erc-network' as
+ expected by users who used the function as it was defined in
+ erc-nickserv.el. Deprecated.
+ (erc-network-name): Returns the value of `erc-network' as expected
+ by users who used the function as it was defined in erc.el.
+ Deprecated.
+ (erc-set-network-name): New function. Added to
+ `erc-server-375-hook' and `erc-server-422-hook'.
+ (erc-unset-network-name): New function. Added to
+ `erc-disconnected-hook'.
+ (erc-server-select): Small documentation word change.
+
+2004-03-07 Diane Murray <disumu@x3y2z1.net>
+
+ * AUTHORS, CREDITS: disumu info updated
+
+2004-03-06 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-list.el (erc-cmd-LIST): Take &rest rather than &optional
+ arguments.
+ (erc-chanlist): Construct correct LIST command from list of
+ channels.
+
+2004-03-06 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-mode-line-buffer): Add 'help-echo property to
+ header-line text. This allows header lines longer than the width
+ of the current window to be seen.
+
+2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el (erc-match-directed-at-fool-p): Also check for
+ "FOOL, "
+
+2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el (erc-match-message): Only use nick-or-keyword if
+ we're matching our nick.
+
+2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-match.el: The highlight type for the current nickname can
+ now also be 'nick-or-keyword, to highlight the nick of the sender
+ if that is available, but fall back to highlighting your nickname
+ in the whole message otherwise.
+ (erc-current-nick-highlight-type): Adapted docstring accordingly.
+ (erc-match-message): Added new condition. Also added some comments
+ to this monster of a function.
+
+2004-03-06 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-is-valid-nick-p): Don't check for length less or
+ equal to 9.
+
+2004-03-06 Damien Elmes <erc@repose.cx>
+
+ * erc-nickserv.el (erc-current-network): the last change resulted
+ in this function failing when a network identifies itself as
+ anything other than var.netname.com, so for instance
+ 'vic.au.austnet.org' fails. This version is only a marginal
+ improvement over the original, but if we want to be more flexible
+ we'll probably have to do the iteration ourselves instead of using
+ assoc.
+
+2004-03-05 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: Added erc-server-001 which runs when the server sends
+ its welcome message. It sets the current-nick to reflect the
+ server's settings. This fixes a bug where nicks that were too long
+ and got truncated by the server were still set to the old value.
+ (nickname-in-use): If user wants to try again manually, let user
+ know that the nick is taken. If not, go through erc-default-nicks
+ until none are left, and then try one last time with
+ erc-nick-uniquifier. If it's still a bad-nick, make the user
+ change nick manually. When applying uniquifier, use NICKLEN if
+ it's in the server parameters, otherwise use what RFC 2812 says is
+ the max nick length (9 chars). Added custom variable
+ erc-manual-set-nick-on-bad-nick-p, which is set to nil and
+ erc-nick-change-attempt-count. Reset erc-default-nicks and
+ erc-nick-change-attempt-count when the nick has been changed
+ successfully. This fixes the bug where ERC would get caught in a
+ neverending loop of trying to set the same nick if the nick was
+ too long and the uniquified nick was not available.
+
+ * added erc-cmd-WHOAMI
+
+ * added custom variable erc-mode-line-away-status-format, use this
+ instead of the previous hard-coded setting
+
+ * erc-server-315|318|369-hook defvar lines removed - they're
+ already defined in erc-server-hook-list
+
+2004-03-04 Lawrence Mitchell <wence@gmx.li>
+
+ * HACKING: Initial commit. Some thoughts on coding standards.
+
+2004-03-03 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-track.el: added the variable erc-track-priority-faces-only
+ which adds the option to ignore changes in a channel unless there
+ are faces from the erc-track-faces-priority-list in the message
+ options are nil, 'all, or a list of channel name strings
+
+2004-03-01 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-ibuffer.el, erc-menu.el: Changed erc-is-channel-op
+ and erc-is-channel-voice to erc-channel-user-op-p and
+ erc-channel-user-voice-p to better match erc-channel-user
+ structure (and emacs lisp usage)
+
+2004-03-01 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el, erc-ibuffer.el, erc-menu.el:
+ erc-track-modified-channels-mode is now erc-track-mode
+
+2004-02-29 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-match.el: Added 'keyword option to
+ erc-current-nick-highlight-type highlights all instances of
+ current-nick in the message ('nickname option in cvs revisions 1.9
+ - 1.11 had same effect)
+
+2004-02-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-button.el: Add Lisp: prefix for the EmacsWiki Elisp area.
+ (erc-button-alist): Added Lisp: prefix.
+ (erc-emacswiki-lisp-url): New variable.
+ (erc-browse-emacswiki-lisp): New function.
+
+2004-02-27 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-get-arglist): Use `substitute-command-keys', rather
+ than hard-coding C-h f for `describe-function'.
+
+2004-02-26 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-log.el (erc-save-buffer-in-logs): bind `inhibit-read-only'
+ to t around call to `erase-buffer'.
+
+2004-02-23 Edward O'Connor <ted@oconnor.cx>
+
+ * erc-chess.el, erc-dcc.el, erc-ezbounce.el, erc-list.el,
+ erc-macs.el, erc-ring.el, erc-stamp.el, erc.el: Normalized buffer
+ local variable creation.
+
+2004-02-17 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-scroll-to-bottom, erc-add-scroll-to-bottom): Mention
+ `erc-input-line-position' in docstring.
+
+2004-02-13 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-kick-hook): Typo fix.
+
+2004-02-13 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * erc.el: Added `erc-kick-hook', which is called when the local
+ user is kicked from a channel. Fixed a bug in `erc-cmd-OPS', such
+ that the command now works. Added `erc-remove-channel-users', in
+ order to fix a number of significant bugs relating to channel
+ parting.
+
+2004-02-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-display-prompt): Remove last change. This caused a
+ lot of trouble :(
+
+2004-02-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-display-prompt): Also set 'field property, so C-j
+ works on an empty prompt.
+
+2004-02-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-channel-topic): Ensure that `channel-topic'
+ does not contain any bare format controls.
+
+2004-02-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-stamp.el (erc-timestamp-intangible): New variable (user
+ feature request)
+ (erc-format-timestamp): Use erc-timestamp-intangible.
+
+2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * erc-button.el: Fixed bug related to nickname buttonizing and text
+ fields due to erc-stamp.
+
+2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * CREDITS: Added mention of my change of ERC to use hash tables.
+
+2004-02-07 Jeremy Bertram Maitin-Shepard <jbms@gentoo.org>
+
+ * AUTHORS: Added myself to the list.
+
+2004-02-05 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el: From Jeremy Maitin-Shepard <jbms@attbi.com>:
+ (erc-remove-channel-user): Use `delq' not `delete'.
+ (erc-get-buffer): Pass PROC through to `erc-buffer-filter'.
+ (erc-process-sentinel): Use `erc' rather than `erc-reconnect' for
+ auto-reconnection.
+
+2004-02-02 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-buffer-list-with-nick): Apply `erc-downcase' NICK.
+
+2004-01-30 Alex Schroeder <alex@gnu.org>
+
+ * erc.el (erc-get-buffer): Use erc-buffer-filter.
+
+2004-01-30 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el: From jbms:
+ (erc-get-channel-nickname-list): New function.
+ (erc-get-server-nickname-list): New function.
+ (erc-get-server-nickname-alist): New function.
+ (erc-get-channel-nickname-alist): New function.
+
+2004-01-30 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-match.el (erc-add-entry-to-list,
+ erc-remove-entry-from-list): Use `erc-member-ignore-case' to
+ compare entries.
+ (erc-add-pal, erc-add-fool): Fix type bug. Use
+ `erc-get-server-nickname-alist'.
+
+2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el: From jbms: Adds xemacs compatibility to hash table
+ channel-members patch.
+
+2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc.el (erc-update-undo-list): Rewritten. Update
+ buffer-undo-list in place. Deal with XEmacsesque
+ entries (extents) in the list.
+ (erc-channel-users): Fix unescaped open-paren in left column in
+ docstring.
+
+2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-ring.el (erc-replace-current-command): Exclude the prompt
+ from the deleted region and don't redisplay the prompt (because
+ `erc-display-prompt' flushes `buffer-undo-list').
+
+2004-01-29 Johan Bockgård <bojohan@users.sourceforge.net>
+
+ * erc-match.el (erc-add-entry-to-list): Use `symbol-value' instead
+ of `eval'.
+
+2004-01-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-kill-buffer-function): maphash was missing an
+ argument.
+
+2004-01-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * Makefile, erc-autoaway.el, erc-button.el, erc-ibuffer.el,
+ erc-lang.el, erc-list.el, erc-match.el, erc-menu.el, erc-page.el,
+ erc-pcomplete.el, erc-speedbar.el, erc.el: HUGE change by jbms.
+ This makes channel-members a hash, erc-channel-users.
+
+ Modified files: Makefile erc-autoaway.el erc-button.el
+ erc-ibuffer.el erc-lang.el erc-list.el erc-match.el erc-menu.el
+ erc-page.el erc-pcomplete.el erc-speedbar.el erc.el
+
+ The changes are too numerous to document properly. Have fun with
+ the breakage.
+
+2004-01-27 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-send-input-line): Add a space to empty lines so the
+ server likes them.
+
+2004-01-25 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: erc-send-whitespace-lines: New variable.
+ (erc-send-current-line): Use erc-send-whitespace-lines. Also,
+ removed superfluous test for empty line in the mapc, since the
+ blank line test should find all. I do like to be able to send an
+ empty line when i want to!
+ (erc-send-current-line): Check for point being in input line
+ before checking for blank lines.
+
+2004-01-21 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-display-line-1): Move `erc-update-undo-list' outside
+ `save-restriction'. Removing need for temporary variable.
+ (erc-send-current-line): Fix bug introduced by last change, remove
+ complement in blank line regexp.
+
+2004-01-20 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-undo-list): Add logic to catch the case when
+ `buffer-undo-list' is t, indentation cleanup.
+ (erc-send-current-line): Reverse logic for matching blank lines.
+
+2004-01-20 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-input-line-position): New variable. If non-nil,
+ specifies the argument to `recenter' in `erc-scroll-to-bottom'.
+ (erc-scroll-to-bottom): Use it.
+
+2004-01-20 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el: From Johan Bockgård <bojohan+news@dd.chalmers.se>:
+ (erc-update-undo-list): New function. Update `buffer-undo-list'
+ so that calling `undo' in an ERC buffer doesn't mess up the
+ existing text.
+ (erc-display-line-1): Use it.
+
+2004-01-19 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-beg-of-input-line): Use `forward-line' rather than
+ `beginning-of-line'. Docstring fix.
+ (erc-end-of-input-line): Docstring fix.
+
+2004-01-13 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-display-prompt): Remove the undo list after
+ displaying the prompt, so the user can't undo ERC changes, which
+ breaks some stuff anyways. This way the user can still undo his
+ editing, but not ours.
+
+2004-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el (erc-scroll-to-bottom): Should recenter on the bottom
+ line, not the second-to-last one.
+
+2004-01-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-bol): Fix bug introduced in my changes from 2004-01-11.
+
+2004-01-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el: From Brian Palmer <bpalmer@gmail.com>
+ (erc-cmd-JOIN): Use `erc-member-ignore-case', rather than
+ `member-ignore-case'.
+
+2004-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: There was an inconsistency where the values of op and
+ voice in channel-names could be 'on or 'off after an update, t and
+ nil before. The intended version was to have t or nil, so i fixed
+ it to do so.
+ (channel-names): Updated docstring.
+ (erc-update-current-channel-member): Clarified docstring, fixed so
+ it sets t or nil on an update as well, not only on an add.
+ (erc-cmd-OPS): Updated not to check for 'on (the only function that
+ did this!)
+
+2004-01-12 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-part-reason-various-alist,
+ erc-update-mode-line-buffer): Fix docstring
+
+2004-01-11 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-update-mode-line): Fix typo.
+
+2004-01-11 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el (erc-prompt-interactive-input): Removed.
+ (erc-display-prompt): Removed `erc-prompt-interactive-input'
+ option. (erc-interactive-input-map): Removed.
+
+ Major docstring fixes.
+
+2004-01-07 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-cmd-OPS): Added this function.
+ (erc-cmd-IDLE): Switched from using erc-display-message-highlight
+ to erc-make-notice.
+
+2004-01-07 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el (erc-cmd-LIST): Switched from using
+ erc-display-message-highlight to erc-make-notice.
+
+2004-01-07 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-once-with-server-event): Added a sentence to the
+ docstring. Now returns the uninterned symbol that is added to the
+ server hook.
+ (erc-cmd-IDLE): Changed to use erc-once-with-server-event instead
+ of erc-once-with-server-event-global.
+
+2004-01-06 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el (erc-chanlist-hide-modeline): New variable.
+ (erc-chanlist): Now displays message as a notice. Also hides the
+ modeline if erc-chanlist-hide-modeline is non-nil.
+
+2004-01-05 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-server-PRIVMSG-or-NOTICE): Now nicks appear as
+ <nick> in query buffers, instead of as *nick*.
+
+2004-01-03 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-once-with-server-event-global): Changed to return
+ the uninterned symbol that it creates.
+ (erc-cmd-LIST): Changed to clean up hooks that don't run.
+
+2004-01-03 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-pcomplete.el (pcomplete/erc-mode/IDLE): Added to support new
+ /IDLE command.
+
+2004-01-03 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el (erc-once-with-server-event-global): New function. Like
+ erc-once-with-server-event, except it modifies the global value of
+ the event hook.
+ (erc-cmd-IDLE): New function. Implements the new /IDLE command.
+ Usage: /IDLE NICK (erc-seconds-to-string): New function. Converts
+ a number of seconds to an English phrase.
+
+2004-01-02 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el: Added variable erc-chanlist-mode-hook.
+
+2003-12-30 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-cmd-HELP):
+ Changed to prefer giving help for erc-cmd-* functions over
+ similarly-named Elisp functions (e.g., erc-cmd-LIST vs. list).
+
+2003-12-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-query-buffer-p): Added this function.
+
+2003-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-cmd-SV): Use erc-emacs-build-time.
+
+ * erc-compat.el: erc-emacs-build-time: New variable.
+
+ * erc.el(erc-cmd-SAY):
+ Reintroduced the feature where the spaces between
+ "/SAY" and the rest of the line were being sent with the message.
+
+2003-12-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-server-buffer-p):
+ Fixed a bug where this function sometimes would return
+ nil when it should return t.
+
+2003-12-27 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-generate-new-buffer-name):
+ Really fixed a bug where ERC would reuse
+ a connected server buffer when erc-reuse-buffers is non-nil.
+ (erc-cmd-JOIN): Now we tell the user when he attempts to join the same
+ channel twice on the same server.
+
+ * erc.el(erc-generate-new-buffer-name):
+ Fixed a bug where ERC would reuse a connected server buffer when erc-reuse-buffers is non-nil.
+
+ * erc.el(erc-cmd-SAY):
+ Fixed a bug where the spaces between "/SAY" and the rest of the
+ line were being sent with the message.
+
+ * erc-list.el: Fixed another typo.
+
+ * erc-list.el: Fixed a typo.
+
+ * erc-list.el:
+ Added text to the top of the channel list buffer describing the keybinding for
+ function erc-chanlist-join-channel.
+
+ * erc-list.el: Minor appearance changes. No functional change.
+
+ * erc-list.el:
+ Implemented function erc-chanlist-join-channel. Added variable
+ erc-chanlist-channel-line-regexp. Got rid of function
+ erc-chanlist-pre-command-hook. Changed the logic for how channel lines are
+ highlighted.
+
+2003-12-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-list.el:
+ Removed a bunch of unused code. No semantic change.
+
+ * erc-list.el: Added lots of functionality.
+
+2003-12-15 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el, erc.el:
+ New custom type erc-message-type, use it in erc-hide-list and erc-track-exclude-types
+
+2003-12-14 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(track-when-inactive): New module.
+ (erc-track-visibility): New option.
+ (erc-buffer-activity): New variable.
+ (erc-buffer-activity-timeout): New variable.
+ (erc-user-is-active): New function.
+ (erc-buffer-visible): New function.
+ (erc-modified-channels-update): Replace get-buffer-window call
+ with call to erc-buffer-visible.
+ (erc-track-modified-channels): Ditto.
+
+2003-12-14 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-track.el(erc-modified-channels-update):
+ Force update of modeline. Makes sure
+ that the tracked channels disappear in other buffers too.
+
+2003-12-06 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el(define-erc-module):
+ New optional argument LOCAL-P. If non-nil, then
+ mode will be created as buffer-local rather than a global mode.
+ (erc-cmd-CTCP): Fix indentation from last commit.
+
+ * erc-compat.el(erc-define-minor-mode):
+ Deal with :global and :group keywords.
+
+ * erc-nickserv.el(erc-current-network):
+ Make server regex more permissive.
+
+ * erc.el(erc-cmd-CTCP):
+ Don't add a space to end of command when ARGS are
+ empty. This fixes a bug whereby requests of the form "VERSION " were
+ being sent, and ignored.
+
+2003-11-27 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-log.el: From Adrian Aichner <adrian@xemacs.org>
+ * erc-log.el (erc-log-file-coding-system): Use 'binary
+ coding-system under XEmacs (instead of 'emacs-mule).
+ * erc-log.el (erc-w32-invalid-file-characters): Removed as no
+ longer needed.
+ * erc-log.el (erc-generate-log-file-name-long): Use
+ `convert-standard-filename', which exists in XEmacs too.
+
+2003-11-16 Mario Lang <mlang@delysid.org>
+
+ * erc-identd.el: Code provided by johnw, thanks!
+
+2003-11-09 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el(erc-latest-version): Clean up docstring.
+ Remove requirement for w3, wrap REQUIRE statement in IGNORE-ERRORS.
+ Update viewcvs url to correct location.
+ (erc-ediff-latest-version): Make sure that we find the uncompiled
+ erc.el, error if not.
+
+2003-11-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Add more info to /sv
+
+2003-11-06 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el: Added optional argument BUFFER to erc-server-buffer-p.
+
+2003-11-04 Mario Lang <mlang@delysid.org>
+
+ * AUTHORS: Add sachac
+
+2003-11-02 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el(erc-server-366):
+ chnl is 4th element of parsed, not fifth.
+ (erc-channel-end-receiving-names): Pass correct number of arguments
+ to delete-if-not.
+
+ * erc.el(erc-update-current-channel-member):
+ Use erc-downcase when comparing
+ nick entries. Cleanup indentation.
+
+2003-11-01 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-sound.el: Added a (provide 'erc-sound) line.
+
+ * erc.el(erc-cmd-NAMES): send to TGT, not CHANNEL.
+
+2003-10-29 Sandra Jean Chua <sacha@free.net.ph>
+
+ * erc-pcomplete.el, erc.el, CREDITS:
+ Merged Jeremy Maitin-Shepard's patch for time-sensitive nick completion.
+
+2003-10-27 Mario Lang <mlang@delysid.org>
+
+ * Makefile, debian/changelog:
+ New Debian package 4.0.cvs.20031027
+
+2003-10-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Fix typo tuncate->truncate
+
+2003-10-24 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: From Stephan Stahl <stl@isogmbh.de>:
+ (erc-dcc-send-block): Kill buffer if transfer completed correctly.
+
+2003-10-22 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el(erc-track-disable):
+ Do not deactivate all advices for `switch-to-buffer',
+ just disable the erc specific one. (Bug#217022).
+
+2003-10-18 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-log.el(erc-log-file-coding-system): New variable.
+ (erc-save-buffer-in-logs): Use it.
+
+2003-10-17 Mario Lang <mlang@delysid.org>
+
+ * erc.el(erc-interpret-mirc-color): New boolean defcustom
+
+ * erc.el: Do not use -nowait on darwin (thanks johnw)
+
+2003-10-15 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el(define-erc-module):
+ Set erc-FOO-mode appropriately in erc-FOO-enable
+ and erc-FOO-disable.
+
+2003-10-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-autoaway.el(erc-mode):
+ Reset idletime on connect. Fixes an annoying bug which
+ flooded the server with always on reconnect.
+ (erc-autoway-reset-idletime): Accept optional args so we can hook it
+ onto erc-server-001-hook.
+
+2003-10-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el(erc-hide-list): Add a nice defcustom type
+
+2003-10-08 Mario Lang <mlang@delysid.org>
+
+ * Makefile, debian/changelog, debian/control:
+ Debian snapshot 20031008
+
+ * erc-speedbar.el:
+ Patch from Eric M. Ludlam <eric@siege-engine.com>:
+ - (erc-install-speedbar-variables): Add functions list (needs new speedbar?)
+ - (erc-speedbar-buttons): Add doc. Clear the buffer
+ - (erc-speedbar-sort-channel-members): New function.
+ - (erc-speedbar-expand-channel): Call new sort function. Change some visuals.
+ - (erc-speedbar-insert-user): Change some visuals based on channel data.
+ - (erc-speedbar-line-text, erc-speedbar-item-info): New functions
+ Add proper elisp file header.
+
+2003-10-02 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-match.el(erc-match-syntax-table): New variable.
+ (erc-match-current-nick-p): Use it.
+
+ * erc.el(erc-quit-reason-zippy, erc-part-reason-zippy): Use
+ `erc-replace-regexp-in-string' rather than
+ `replace-regexp-in-string'.
+ (erc-command-indicator-face): New face, used to show commands if
+ `erc-hide-prompt' is nil and `erc-command-indicator' is non-nil.
+ (erc-command-indicator): Clean up doc-string.
+ (erc-display-prompt): New optional argument FACE, use this rather
+ than `erc-prompt-face' to fontify the prompt if non-nil.
+ (erc-send-current-line): Pass in `erc-command-indicator-face' to
+ `erc-display-prompt'.
+
+ * erc-compat.el(erc-replace-regexp-in-string): New function.
+ Alias for `replace-regexp-in-string' on Emacs 21.
+ Argument massaging for `replace-in-string' for XEmacs.
+
+2003-09-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-keywords): Removed. Wasn't used by anything.
+
+2003-09-25 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el: ERC-HIDE-PROMPT: add custom group
+ ERC-COMMAND-INDICATOR: new variable.
+ ERC-COMMAND-INDICATOR: new function.
+ ERC-DISPLAY-PROMPT: new argument, PROMPT, used to override default
+ prompt.
+ ERC-SEND-CURRENT-LINE: pass ERC-COMMAND-INDICATOR to ERC-DISPLAY-PROMPT.
+
+2003-09-24 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-parse-line-from-server):
+ Ignore empty lines as required by RFC.
+
+2003-09-17 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Add lag time calculation
+
+2003-09-13 Mario Lang <mlang@delysid.org>
+
+ * Makefile, debian/README.Debian, debian/changelog:
+ New debian release
+
+ * erc-notify.el:
+ Call erc-notify-install-message-catalogs on load, not on module init
+
+ * erc.el(erc-update-modules):
+ Use `load' instead of `require'. XEmacs appears
+ to have the NOERROR arg only sometimes... Strange
+
+ * erc.el: No fboundp if we have a defvar
+
+ * erc.el: Properly defvar erc-ping-handler
+
+2003-09-11 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-setup-periodical-server-ping):
+ check if erc-ping-handler is
+ bound before referencing it
+
+2003-09-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el(erc-cmd-NICK):
+ Warn about exceeded NICKLEN if we know it.
+
+ * erc.el: Make erc-server-PONG obey erc-verbose-server-ping.
+ Cancel old `erc-ping-handler' timer when restablishing connection in the same
+ buffer.
+
+ * debian/changelog, Makefile: New debian snapshot
+
+ * erc-dcc.el, erc-xdcc.el:
+ Use new function erc-dcc-file-to-name to convert spaces to underscores
+
+ * erc-xdcc.el: Add autoload for erc-xdcc-add-file
+
+2003-09-08 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: indent fixes and copyright update
+
+ * erc.el:
+ erc-send-ping-interval: New defcustom which defaults to 60.
+ Every 60 seconds, we send PING now.
+ This should fix the "connection silently lost" bug.
+ Please test this change extensively, and report problems.
+
+2003-09-07 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-default-coding-system):
+ Test for undecided and utf-8
+ before setting.
+
+2003-09-01 Mario Lang <mlang@delysid.org>
+
+ * erc.el(erc-modules): Add some more symbols to the set
+
+ * erc.el(erc-modules): Add :greedy t to the set in
+
+ * erc-dcc.el:
+ More autoloads which make dcc autoload upon ctcp dcc query received.
+
+ * erc-dcc.el(erc-cmd-DCC): Add Autoload.
+ (pcomplete/erc-mode/DCC): Ditto, makes DCC autoloadable just by using
+ completion.
+ Also only offer "send" if fboundp make-network-process.
+
+ * erc-autojoin.el: Update copyright
+
+ * erc-autojoin.el(erc-autojoin-add):
+ Only add the channel if it is not already there.
+
+ * erc-notify.el:
+ Use `define-erc-module' instead of old `erc-notify-initialize'.
+ Now defines the global minor mode erc-notify-mode, and should also
+ be controllable via `erc-modules' with symbol `notify'.
+
+ * erc.el(erc-modules):
+ Fix paren-in-column-zero bug in docstring.
+ Add a sort of bogus, but still better :type.
+ Add autojoin and netsplit by default.
+ (erc-update-modules): Don't barf with an error if `require' fails.
+ We can still error out if the mode is not defined.
+
+2003-08-31 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * make 353 (NAMES reply) output go into the appropriate channel buffer
+ (if it exists) or into the active erc buffer (if not).
+
+2003-08-29 mtoledo <mtoledo@confusibombus>
+
+ * erc.el:
+ Added the variable erc-echo-notices-in-current-buffer to make possible display notices in the current buffer (queries to nickserv/chanserv/memoserv). Defaults to nil so nothing changes from what we have today.
+
+2003-08-29 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Fix typo in varname which led to a compiler warning
+
+ * AUTHORS: Added lawrence
+
+2003-08-27 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el:
+ Set process and file-coding system to 'binary (for Windows)
+
+ * erc-stamp.el: Rename custom group erc-timestamp to erc-stamp.
+
+2003-08-07 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-fill.el(erc-fill-disable):
+ Remove erc-fill, not erc-fill-static from
+ erc-insert-modify-hook.
+
+2003-08-05 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-send-current-line):
+ Now we display the prompt for previously entered commands
+ based on the value of customization variable erc-hide-prompt. This change is
+ closely related to the immediate previous version by wencem.
+
+2003-08-04 Lawrence Mitchell <wence@gmx.li>
+
+ * erc.el(erc-send-current-line):
+ If we're sending a command, don't display
+ the prompt.
+
+2003-08-04 Damien Elmes <erc@repose.cx>
+
+ * erc-track.el: patch from David Edmondson (dme AT dme DOT org)
+
+ This patch makes button 3 on the erc-track buffer names in the
+ modeline show the selected buffer in another window. It's analogous to
+ button 2 which shows the buffer in the current window.
+
+2003-07-31 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-display-line-1):
+ Fixed bad indentation on one line. No semantic change.
+
+2003-07-29 Lawrence Mitchell <wence@gmx.li>
+
+ * erc-match.el:
+ Quote open paren in docstring of erc-text-matched-hook
+
+ * erc.el: Anchor match only at beginning in erc-ignored-user-p.
+
+ * erc-button.el: New variable erc-button-wrap-long-urls.
+ Modified erc-button-add-buttons:
+ New optional argument REGEXP.
+ If we're buttonizing a URL and erc-button-wrap-long-urls is
+ non-nil, try and wrap them
+
+ Modified erc-button-add-buttons-1:
+ Pass regexp to erc-button-add-buttons.
+
+2003-07-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-network-name):
+ Improved docstring. Removed an unnecessary call to erc-server-buffer.
+
+2003-07-28 Mario Lang <mlang@delysid.org>
+
+ * erc.el: By lawrence:
+ (erc-ignored-user-p): Use anchored regexp.
+ (smiley): Fix missing quote in `remove-hook' call.
+
+2003-07-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-nets.el, erc-nickserv.el, erc.el:
+ Changed all references to Openprojects into references to Freenode.
+
+2003-07-25 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ Now variable erc-debug-irc-protocol is defvar'ed instead of defcustom'ed.
+ Made the docstring clearer too.
+
+ * erc.el: Fixed a wrong-type-argument error from window-live-p.
+
+2003-07-15 Damien Elmes <erc@repose.cx>
+
+ * erc-log.el(erc-log-setup-logging):
+ set buffer-file-name to "", as (basic-save-buffer)
+ will prompt for a buffer name before invoking hooks. the buffer-file-name
+ will be overridden by (erc-save-buffer-in-logs) anyway - the main danger
+ of doing this is write-file-contents hooks. Let's see if anyone complains.
+ (erc-save-buffer-in-logs): return t, so that further write hooks are not run
+
+2003-07-09 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el(erc-dcc-open-network-stream):
+ -nowait still crashes emacs cvs - disable for now
+
+2003-07-02 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc): Minor docstring modification.
+
+2003-07-01 Damien Elmes <erc@repose.cx>
+
+ * erc-match.el(erc-match-current-nick-p):
+ match only on word boundaries
+
+ * erc-log.el(erc-log-setup-logging):
+ not sure how this crept in again - make sure we set
+ buffer-file-name to nil, since otherwise it is not possible to open
+ previous correspondence in another buffer while a conversation is open
+
+2003-06-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-network-name):
+ Now makes some intelligent guesses if the server didn't tell
+ us the network name.
+
+2003-06-28 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-default-coding-system): Use utf-8 as the default
+ encoding for outgoing stuff and undecided as the default for
+ incoming stuff.
+ (erc-coding-sytem-for-target): New.
+ (erc-encode-string-for-target): Use it.
+ (erc-decode-string-from-target): Use it. Removed the flet
+ erc-default-target hack and documented the dynamically bound
+ variable `target' instead.
+
+2003-06-25 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-log-irc-protocol):
+ Now we keep point on the bottom line of the window
+ displaying the *erc-protocol* buffer if it is at the end of the
+ *erc-protocol* buffer.
+
+ * erc.el:
+ Added some text to the docstring for variable erc-debug-irc-protocol.
+
+2003-06-23 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-dcc.el(erc-dcc-auto-mask-p):
+ Fixed a docstring typo that caused a load-time error.
+
+ * erc-dcc.el(erc-dcc-auto-mask-p):
+ Changed reference to undefined variable erc-dcc-auto-mask-list
+ to erc-dcc-auto-masks.
+ Changed default value of variable erc-dcc-auto-masks to nil and added text to its
+ docstring.
+
+ * erc-notify.el(erc-notify-timer and erc-notify-QUIT):
+ Added network name to notify_off message.
+
+ * erc.el(erc-network-name):
+ Now returns the name of the IRC server if the network name
+ cannot be determined.
+
+ * erc-notify.el(erc-notify-JOIN and erc-notify-NICK):
+ Added argument ?m to call to erc-display-message.
+
+ * erc-dcc.el(erc-dcc-do-LIST-command):
+ Fixed a bug where I assumed (plist-get elt :type)
+ returns a string -- it really returns a symbol.
+
+ * erc-notify.el(erc-notify-timer):
+ Now we include the network name in the notify_on message.
+
+ * erc.el:
+ New function: erc-network-name. Returns the name of the network that the
+ current buffer is associate with. Not every server sends the 005 messages
+ that enable the network name to be known. If the network name is
+ not known, the string "UNKNOWN" is returned.
+
+ * erc-dcc.el(erc-dcc-chat-setup):
+ Added a comment. Fixed a bug where a DCC CHAT buffer has no
+ prompt when it first appears.
+
+ * erc-dcc.el(erc-dcc-chat-parse-output):
+ Now a DCC chat buffer displays the nick using
+ erc-nick-default-face just like in a channel buffer.
+
+2003-06-22 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-display-prompt):
+ Fixed incorrect indentation. No semantic change.
+
+ * erc.el(erc-strip-controls):
+ Minor change to regexp that matches IRC color control
+ codes. I was seeing usage as follows: ^C07colored text^C^C04other color.
+ Now we strip a ^C followed by zero, one, or two digits. Before this change,
+ we stripped a ^C followed by one or two digits.
+
+ * erc-dcc.el(erc-dcc-do-LIST-command):
+ Improved format of output of /DCC LIST. Now the
+ "Size" column for a DCC GET includes the percentage of the file that has
+ been retrieved.
+ (erc-dcc-do-GET-command): Now it works if erc-dcc-default-directory is set.
+
+2003-06-19 Damien Elmes <erc@repose.cx>
+
+ * erc-log.el:
+ * added quickstart information to the comments up the top
+
+2003-06-16 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Default to open-network-stream on MS Windows. (thanks lawrence)
+
+2003-06-11 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-process-input-line):
+ refactor so that wrong-number-of-arguments is
+ caught when using do-not-parse-args - this lets do-not-parse-args
+ commands display help messages on incorrect syntax in a uniform manner.
+ This no longer raises a bad-syntax error - was this a catch-all to stop a
+ backtrace? Does it belong?
+ (erc-cmd-APPENDTOPIC): the correct way to display help when you want to
+ accept an arbitrary string is to (signal 'wrong-number-of-arguments nil).
+ This fixes a bug where people could not /at topics with a space in them.
+
+2003-06-09 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ Re-add the last few changes which weren't merged for some reason.
+
+ * erc.el(erc-cmd-APPENDTOPIC): show help when given no arguments
+
+ Patch from MrBump. Fixes problem with erc-set-topic inserting ^C characters
+ into the topic. Also removes dependency on CL.
+
+2003-06-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ Added comment to explain (eval-after-load "erc" '(erc-update-modules)).
+
+2003-06-01 Mario Lang <mlang@delysid.org>
+
+ * erc-pcomplete.el: Add completion for /unignore
+
+2003-05-31 Alex Schroeder <alex@gnu.org>
+
+ * erc-compat.el(erc-encode-coding-string): The default binding,
+ if encode-coding-string was not available, must be a defun that
+ takes multiple arguments. Did that.
+
+2003-05-30 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Add handlers for 313 and 330 (by arne@rfc2549.org, thanks)
+
+2003-05-30 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ patch from MrBump to make /mode #foo +b work again (erc-cmd-BANLIST only
+ temporarily changes them now)
+
+2003-05-29 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-select):
+ server is now defaulted with erc-compute-server.
+ A few cosmetic fixes.
+ (erc-default-coding-system): Renamed from erc-encoding-default.
+ (erc-encoding-default): Renamed to erc-default-coding-system.
+ (erc-encoding-coding-alist): Documentation updated to cover regexps.
+ (erc-encode-string-for-target): Now considers keys of
+ erc-encoding-coding-alist to be regexps. Rely on erc-compat
+ wrt. MULE support.
+ (erc-decode-string-from-target): New function.
+ (erc-send-current-line): eq -> char-equal fix.
+ (erc-server-TOPIC): topic is now decoded with
+ erc-decode-string-from-target.
+ (erc-parse-line-from-server): Line from server is no longer decoded
+ here.
+ (erc-server-PRIVMSG-or-NOTICE): Message from a user is decoded here,
+ sspec -> sender-spec for clarity. Cosmetic if -> when fix.
+ (erc-server-TOPIC): sspec -> sender-spec
+ (erc-server-WALLOPS): Ditto.
+
+ * erc-compat.el(erc-decode-coding-string):
+ Now requires coding-system as an argument.
+
+2003-05-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ erc-part|quit-hook is only run on a part|quit directed to our nick, reflect that in the docstring to avoid confusion
+
+2003-05-01 Andreas Fuchs <asf@void.at>
+
+ * erc-truncate.el:
+ * erc-truncate-buffer-to-size: use fboundp. Scheme takes its toll...
+
+2003-05-01 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-truncate.el: remove require of erc-log
+ (erc-truncate-buffer-to-size): use erc-save-buffer-in-logs when it's
+ there, else, don't.
+
+2003-04-29 Andreas Fuchs <asf@void.at>
+
+ * erc-log.el, erc-truncate.el, erc.el: erc.el:
+ * erc-cmd-QUIT: Remove references to code in erc-log.el, to
+ not force autoloading of erc-log.el
+ * erc-server-PART: ditto.
+ * erc-quit-hook: new hook, run when /quit command is
+ processed.
+ * erc-cmd-QUIT: use it.
+ * erc-part-hook: new hook, run then PART message is
+ processed.
+ * erc-cmd-PART: use it.
+ * erc-connect-pre-hook: new hook, run before connection to IRC
+ server is started.
+ * erc: use it.
+ * erc-max-buffer-size: Move truncation variables and functions
+ to erc-truncate.el
+ * erc-truncate-buffer-on-save: moved to erc-log.el
+ * erc-initialize-log-marker: new function.
+ * erc-log.el:
+ * erc-truncate-buffer-on-save: New defcust here; from erc.el
+ * erc-truncate-buffer-on-save: Put it in group `erc-log'
+ * erc-log-channels-directory: Remove trailing slash from
+ default value.
+ * Add functions to erc-connect-pre-hook, erc-part-hook and
+ erc-quit-hook to avoid getting autoloaded.
+
+ * erc-truncate.el:
+ * Contains the truncation functions and defcusts from erc.el.
+ * define-erc-module clause added; new erc-truncate-mode.
+
+2003-04-29 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc):
+ Check whether erc-save-buffer-in-logs is bound, too
+
+ * erc.el(erc):
+ Check whether erc-logging-enabled is bound before using it - not
+ everyone is using erc-log.el!
+
+2003-04-28 Andreas Fuchs <asf@void.at>
+
+ * erc-log.el:
+ * while we're at it, remove the (declare (ignore ignore)) statements.
+
+ * erc-log.el:
+ * add autoload statement for erc-log-mode/etc. Sorry for the delay.
+
+ * erc-log.el, erc.el: * erc.el:
+ - move variables and functions to erc-log.el:
+ defgroup `erc-log'
+ defcustom `erc-log-channels-directory'
+ defcustom `erc-log-insert-log-on-open'
+ defcustom `erc-generate-log-file-name-function'
+ defun `erc-save-buffer-in-logs' (autoloads from erc-log.el)
+ defuns `erc-generate-log-file-name-*'
+ defun `erc-current-logfile'
+ defun `erc-logging-enabled' (autoloads from erc-log.el)
+ - erc-truncate-buffer-to-size: fix for double-saving bug when
+ writing out truncated buffer contents. Thanks, lawrence mitchell <wence@gmx.li>!
+ - erc-remove-text-properties-region: Fix case for read-only text.
+ - erc-send-current-line: update insert-marker before calling the hooks.
+ also, wrap (erc-display-prompt) so that it doesn't toggle
+ buffer-modified-p.
+ - erc-interpret-controls: remove /very/ old commented-out function
+ - erc-last-saved-position: make it a marker
+ - erc: use it.
+
+ * erc-log.el: (thanks, lawrence mitchell <wence@gmx.li>!)
+ - Move logging code from erc.el here
+ - define-erc-module log: add; minor mode erc-log-mode is the
+ same as adding the `erc-save-buffer-in-logs' to
+ erc-send-post-hook and `erc-insert-post-hook'.
+ - erc-w32-invalid-file-characters: add.
+ - erc-enable-logging: add.
+ - erc-logging-enabled: use it.
+ - erc-logging-enabled: autoload.
+ - erc-save-buffer-in-logs: fix for truncating saved buffer with read-only text.
+ - erc-save-buffer-in-logs: use erc-last-saved-position.
+ - erc-save-buffer-in-logs: fix saving half-written messages on
+ the prompt when saving the log file. (simply uses
+ erc-insert-marker as an upper bound for saving).
+
+2003-04-27 Damien Elmes <erc@repose.cx>
+
+ * erc.el: erc-modules: added
+
+2003-04-27 Alex Schroeder <alex@gnu.org>
+
+ * Makefile(UNCOMPILED): Added erc-compat.el.
+ (clean): Remove .elc files, too.
+ Patch by Hynek Schlawack <hynek+erc@hys.in-berlin.de>
+
+2003-04-22 Damien Elmes <erc@repose.cx>
+
+ * erc-button.el:
+ erc-button-keymap: set the parent keymap to erc-mode-map
+
+2003-04-20 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ erc-official-location: shouldn't the official location be the base URL of erc?
+
+ * erc.el:
+ erc-modules: updated the docstring to make the semantics clearer
+
+2003-04-19 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fix problem where % in NOTICE produced errors (from mmc)
+
+2003-04-18 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-toggle-debug-irc-protocol):
+ moved a reference to 'buf' inside the let
+ statement which defines it. it's difficult to tell what the original
+ intentions were here - at the moment the debug window is displayed when
+ toggling either way.
+
+ * README, erc.el:
+ (erc-update-modules: added a condition in for erc-nickserv -> erc-services
+
+ * erc-pcomplete.el:
+ - that change to erc-update-modules making it require the modules first means
+ we don't need any special case handling here, so i reverted the previous
+ change
+
+ * erc.el:
+ - don't require 'erc-auto, since windows users don't have access to make.
+ instead, we handle it in (erc-update-modules)
+
+2003-04-17 Damien Elmes <erc@repose.cx>
+
+ * README, Makefile:
+ Updated Makefile and documentation to reflect the new release
+
+ * erc.el:
+ - note the previous change also updated the release number to erc 4.0!
+ (erc-connect): fix a bug introduced by the previous release
+
+ * erc.el:
+ fixed about 20 instances of (message (format ...)) which will break if the
+ format returns a string with %s in it
+
+ * erc.el: erc-error-face: make it red, not pink
+
+ * erc-pcomplete.el:
+ since pcomplete is autoloaded via erc-completion-mode, and completion is in
+ erc-modules by default, we remove completion when pcomplete is added
+
+ * erc.el(define-erc-module): no need for delete, use delq
+
+ * erc-members.el(erc-nick-channels):
+ (erc-person-channels) takes one arg
+ (erc-format-user): again, they all take an arg
+
+ * erc.el:
+ - require erc-auto when loading, so the default `erc-modules' can be loaded.
+ this makes erc-auto no longer a convenience but a necessity - all the name
+ of user friendliness.
+ (define-erc-module): the enable and disable routines now update erc-modules
+ accordingly
+ erc-modules: new variable controlling the modules which erc has loaded/will
+ load. when customizing, it will automatically enable modules. it won't
+ automatically disable modules which are removed, yet.
+ (erc-update-modules): enable all modules in `erc-modules'
+
+ * erc-dcc.el(erc-dcc-open-network-stream):
+ use the -nowait equiv if available
+ erc-dcc-server-port: removed
+ erc-dcc-port-range: allows a range of values, so you can have more than one
+ dcc
+ (erc-dcc-server): support erc-dcc-port-range
+ (erc-dcc-chat): use OCHAT for outgoing chat for now. we need to fix the
+ issues with allowing more than one chat with the same person
+
+ * erc.el:
+ erc-log-channels: removed; set the directory to start logging
+ (erc-directory-writeable-p): create directory if it doesn't exist, check if
+ it's writable
+ (erc-logging-enabled): don't reference erc-log-channels
+
+2003-04-07 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc):
+ but when inserting the contents of a previous logfile, use the logfile
+ name, not ""!
+
+ * erc.el(erc):
+ set buffer-file-name to "", since we have a custom saving function and
+ it's not needed. this enables one to open a log file with previous
+ correspondence, while talking to the person at the same time
+
+2003-03-29 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-prepare-mode-line-format):
+ Now strips all text properties from the target before
+ putting it in the mode line. Keeps the mode line looking consistent.
+ (erc-channel-p): Improved docstring.
+
+2003-03-28 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-generate-log-file-name-with-date): New function.
+ (erc-generate-log-file-name-function): Make it available.
+
+2003-03-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fix erc-prompt and erc-user-mode custom :type (Closes: #185794)
+
+2003-03-20 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ erc-server-hook-list: correct documentation of ordering of (proc parsed)
+
+2003-03-16 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-modified-channels-string):
+ Make it a risky-local-variable.
+
+2003-03-16 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el(erc-track-modified-channels):
+ Use (point-min) if we don't find a
+ parsed-property, so it won't error out with nil...
+
+2003-03-16 Damien Elmes <erc@repose.cx>
+
+ * erc-track.el(erc-track-switch-buffer):
+ removed call to erc-modified-channels-update, as
+ this is done correctly on buffer switching in both emacs and xemacs now
+
+2003-03-15 Damien Elmes <erc@repose.cx>
+
+ * erc-track.el(erc-find-parsed-property):
+ simplified a little, so it shouldn't return nil anymore
+
+ * erc.el: erc-send-post-hook: document narrowing which occurs
+
+2003-03-14 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-find-parsed-property): New function.
+ (erc-track-modified-channels): Use it instead of relying on
+ point-min.
+
+2003-03-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fix erc-set-topic to accept a channel name as first word
+
+2003-03-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-dcc.el:
+ Small patch (<10 lines, also slightly modified by Jorgen Schäfer) from
+ David Spreen <netzwurm@debian.org> to add hostmask-authentication to
+ DCC auto-accept.
+
+ erc-dcc-auto-mask-list: New variable
+ (erc-dcc-handle-ctcp-send): Check erc-dcc-auto-mask-list
+ (erc-dcc-auto-mask-p): New function
+ erc-dcc-send-request: Docstring now mentions erc-dcc-auto-mask-list
+
+2003-03-10 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-ring.el(erc-clear-input-ring):
+ New function. Erases the contents of the input ring for
+ the current ERC buffer.
+
+2003-03-08 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ (erc-display-line-1) and (erc-send-current-line): Now these functions reset erc-insert-this
+ to t as soon as possible after consuming the value of that variable. See the comments in
+ the code for the strange symptom this fixes.
+ (erc-bol): Changed to call point-at-eol instead of line-end-position. This increases XEmacs
+ portability, since XEmacs doesn't have line-end-position. Patch suggested by Scott Evans
+ on the ERC mailing list.
+
+2003-03-04 Damien Elmes <erc@repose.cx>
+
+ * erc.el: banlist*: patch from mrbump to avoid using cl packages
+
+2003-03-04 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ Changed erc-noncommands-list from a constant to variable, so that users can
+ add their own erc-cmd-* functions to the list. Improved the docstring too.
+
+2003-03-02 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-server-353):
+ Now the output of "/NAMES #channel" appears in the currently
+ active ERC buffer, even if the user is not a member of #channel.
+
+ * erc.el(erc-cmd-DEOP):
+ Fixed a syntax error: invalid read syntax ")" caused by my last change.
+
+2003-03-01 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-cmd-DEOP):
+ Fixed a wrong-type-argument error caused by calling split-string
+ on a list instead of on a string. Removed the call to split-string entirely,
+ because it wasn't needed.
+
+ * erc.el(erc-cmd-HELP):
+ Changed to use intern-soft instead of intern. Now "/HELP floob"
+ doesn't create a void function symbol erc-cmd-FLOOB.
+
+2003-02-25 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-SERVER):
+ remove erroneous references to line, use server instead
+
+2003-02-23 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-toggle-debug-irc-protocol):
+ Fixed a bug where the global value of
+ kill-buffer-hook was being modified instead of the buffer-local value.
+
+2003-02-22 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-cmd-KICK):
+ Now supports any number of words in the REASON string. Examples
+ of the /KICK command are:
+ /KICK franl You don't belong here
+ /KICK franl Bye
+ /KICK franl
+ /KICK #channel franl Go away now
+ /KICK #channel franl Bye
+ /KICK #channel franl
+
+2003-02-16 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-stamp.el(erc-insert-timestamp-right):
+ Make the timestamp rear-nonsticky, so
+ C-e works at the beginning of the next line.
+
+2003-02-16 Andreas Fuchs <asf@void.at>
+
+ * erc-stamp.el:
+ * s/choose/choice/ in customize options, as kensanata requested.
+
+2003-02-15 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-toggle-debug-irc-protocol):
+ Now if the *erc-protocol* buffer is killed,
+ logging is turned off. Prior to this change, the buffer would come back
+ into existence (generally unbeknownst to the user) after being killed.
+
+2003-02-11 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-send-current-line):
+ we can't inhibit everything here when not connected,
+ as the user will expect commands like /server still to work. the
+ erc-cmd-handler should recover from errors instead
+
+2003-02-10 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ * we now run erc-after-connect on 422 (no motd) messages as well as the motd
+ messages
+ (erc-login): revert the previous change
+
+ * erc.el(erc-login): register that we're connected
+
+2003-02-10 Mario Lang <mlang@delysid.org>
+
+ * erc-members.el: * Provide erc-members
+ * Fix excessive )
+ * Comment out broken self-tests
+
+2003-02-07 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-connect):
+ notify the user we're trying to connect when using asych
+ connections
+
+ * erc.el(erc-connect): support an asynchronous connection
+ (erc-process-sentinel): ditto
+
+ * erc-track.el:
+ * advise switch-to-buffer in the case of xemacs, since it doesn't have
+ window-configuration-change-hook
+
+ * erc.el(erc-send-current-line):
+ if not connected, refuse to send either a message or
+ a command
+
+ * erc.el: (erc-save-buffer-in-logs):
+ - check for a sensible region before saving the buffer. if the
+ connection process is killed early on, there is not a sensible region
+ to save
+ - don't set buffer-file-name on save. we don't need it, and it means we
+ can now find-file a log while an existing query is open with that
+ user
+
+ * erc.el(erc-process-input-line):
+ when displaying the help for a function, if no
+ documentation exists, don't fall over
+ (erc-cmd-SAY): new function for quoting lines beginning with /
+ (erc-server-NICK):
+ - fix a bug where the "is now known as" message doesn't appear on newly
+ created /query buffers
+ - when a user changes their nick, update the query to point to the new
+ nick
+
+ * erc.el(erc-send-current-command):
+ don't reject multi-line commands. since
+ multiline-p is used as the no-command arg to erc-process-current-line,
+ multi-line text is never interpreted as a command. i believe this is the
+ correct behavior - it allows people to post the output of things like df
+ (sans header). if you want to change this, please provide a rationale
+ in the changelog
+
+ * erc.el(erc-send-current-line):
+ only match the first line when determining if a
+ multi-line command is allowed
+
+2003-02-07 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-bbdb.el(erc-bbdb-highlight-record):
+ Use alternate strings, not character
+ classes to split the nick-field.
+
+2003-02-06 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-process-sentinel):
+ Now we set erc-connected to nil every time we disconnect
+ from a server, not just when an unexpected disconnect happens.
+
+ * erc.el(erc-connected):
+ Removed redundant defvar of this variable. Improved the
+ docstring.
+ (erc-login): Changed to send a correct RFC2812 USER message (see section
+ 3.1.3 of RFC2812 for the documentation of the semantics of each argument
+ of the USER message.
+
+2003-02-02 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-NOTICE): fix from mrbump
+
+2003-01-31 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-cmd-JOIN):
+ Now we only send one JOIN command to the server when a channel
+ key is provided.
+
+2003-01-30 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-remove-channel-member):
+ Fixed so that it runs erc-channel-members-changed-hook
+ with the channel buffer current, as is documented in the docstring for variable
+ erc-channel-members-changed-hook: "The buffer where the change happened is
+ current while this hook is called."
+
+2003-01-28 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ (erc-ignored-user-p),(erc-cmd-IGNORE),(erc-cmd-UNIGNORE): Now nicks are ignored
+ on a per-server basis. Now, erc-ignore-list is only valid in server
+ buffers! Do not reference it in channel buffers.
+
+ * erc.el(erc-cmd-IGNORE):
+ Now says "Ignore list is empty" if it erc-ignore-list is empty
+ instead of showing an empty list.
+
+2003-01-25 Alex Schroeder <alex@gnu.org>
+
+ * erc-nickserv.el(services): Defined a module
+
+2003-01-25 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-process-ctcp-query):
+ Display recipient of CTCP query if it's not
+ our current nick.
+
+ * erc.el(erc-cmd-WHOIS):
+ Accept an optional second argument SERVER.
+
+2003-01-25 Alex Schroeder <alex@gnu.org>
+
+ * erc-stamp.el(stamp): erc-add-timestamp must always be added
+ with the APPEND parameter -- not only when adding it on the right.
+
+2003-01-24 Alex Schroeder <alex@gnu.org>
+
+ * erc-members.el(erc-channel-members-changed-hook): Obsolete, use
+ erc-members-changed-hook instead. When it is set, add its content
+ to erc-members-changed-hook.
+ (erc-update-channel-member): Obsolete, use erc-update-member
+ instead. Defalias to that effect.
+ (erc-remove-channel-member): New and already obsolete. Use
+ erc-remove-nick-from-channel instead.
+ (erc-update-channel-info-buffer): Obsolete, use ignore instead.
+ Yes, these have to go.
+ (erc-channel-member-to-user-spec): Obsolete, use erc-format-user
+ instead.
+ (erc-format-user): New.
+ (erc-ignored-reply-p): New, use it.
+
+ * erc-members.el:
+ Further along the way. Any function from erc.el that uses
+ channel-members should end up in this file, rewritten to use
+ erc-members.
+
+ (erc-person): Call erc-downcase before getting
+ something from the hash.
+ (erc-nick-in-channel): Checking whether erc-process must be used is
+ unnecessary -- this will be done in erc-person.
+ (erc-nick-channels): New.
+ (erc-add-nick-to-channel, erc-update-member): Call erc-downcase
+ before putting something into the hash.
+ (erc-buffer-list-with-nick): New.
+ (erc-format-nick, erc-format-@nick): New, backwards incompatible.
+ Must check for other places that call these!
+ (erc-server-PRIVMSG-or-NOTICE): Use the new version.
+
+ * erc-compat.el(view-mode-enter): defalias to view-mode, if
+ view-mode-enter is not fboundp and view-mode is -- as is the case
+ in XEmacs. We need view-mode-enter in erc-match.el.
+
+2003-01-23 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-default-server-handler):
+ Minor performance improvement: allow the lambda
+ expression to be byte-compiled.
+
+2003-01-23 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-BANLIST):
+ in the absence of a fill-column, use the screen width
+
+2003-01-22 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ patch from MrBump to delay fetching the banlist until /bl is run, so we don't
+ fetch it when joining a channel anymore
+
+ * erc-ring.el:
+ * instead of adjusting hooks when loaded, provide (erc-ring-mode). you'll
+ need to run (erc-ring-mode 1) now to get the ring
+ * (erc-previous-command), (erc-next-command):
+ - check if the ring exists and create it if necessary
+ - don't do anything if the ring is empty
+
+ * erc-pcomplete.el:
+ Put "how to use" documentation in the comments up the top
+
+2003-01-21 Alex Schroeder <alex@gnu.org>
+
+ * erc-autojoin.el(erc-autojoin-version): New.
+
+ * erc-autojoin.el(erc-autojoin-add): Added body.
+ (erc-autojoin-remove): Added body.
+ (erc-autojoin): Provide it.
+
+2003-01-21 Damien Elmes <erc@repose.cx>
+
+ * erc.el: erc-cmd-*: removed a bunch of references to force
+
+2003-01-21 Alex Schroeder <alex@gnu.org>
+
+ * erc-autojoin.el(erc-autojoin-channels-alist): More doc.
+
+2003-01-20 Alex Schroeder <alex@gnu.org>
+
+ * erc-autojoin.el:
+ new, based on resolve's mail, and the stuff on the wiki
+
+ * erc-members.el: new
+
+2003-01-19 Mario Lang <mlang@delysid.org>
+
+ * debian/README.Debian, debian/changelog, debian/scripts/install,
+ debian/scripts/startup.erc, Makefile:
+ Prepare for 20030119 debian package
+
+ * erc-dcc.el: <rant>
+ * (erc-decimal-to-ip): Since XEmacs decides that return a completely
+ and utterly wrong number from string-to-number if it is larger than
+ the integer boundary, instead of sanely converting the thing to
+ a float, we now (concat dec ".0").
+ </rant>
+
+ * erc.el:
+ * (erc-log-irc-protocol): Use erc-propertize, not propertize
+
+2003-01-19 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-button-add-buttons): Added regexp-quote for
+ the list case, too.
+
+2003-01-19 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el(erc-dcc-member): fix for case where a prop is nil
+
+ * erc-dcc.el(erc-dcc-member):
+ fix for xemacs's version of plist-member
+
+2003-01-19 Mario Lang <mlang@delysid.org>
+
+ * erc-notify.el: Delete empty strings from the ison-list
+
+ * erc-track.el:
+ * (erc-track-switch-buffer): Call erc-modified-channels-update here.
+
+ * erc-track.el: * toplevel: require 'erc-match
+
+ * erc-track.el: * (erc-track-mode): Make autoload interactive
+
+ * erc-button.el: * (button): Make the autoload interactive
+
+ * erc.el:
+ * (erc-mode): Comment out the case-table stuff, breaks xemacs
+ * (erc-downcase): Revert.
+
+ * erc-dcc.el:
+ * (erc-dcc-handle-ctcp-send): Use erc-decimal-to-ip on the ip we get...
+
+ * erc-speak.el:
+ Eliminate reference to erc-nick-regexp, which no longer exists
+
+2003-01-19 Alex Schroeder <alex@gnu.org>
+
+ * erc-stamp.el(erc-timestamp-right-column): New, default nil.
+ (erc-insert-timestamp-right): Use it, if non-nil. Verbose
+ doc string.
+
+2003-01-18 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-downcase): Use the old behavior in non-CVS Emacs.
+
+ * erc.el(erc-cmd-QUIT): Remove &rest. The correct fix follows.
+ (erc-cmd-GQUIT): Pass "" to erc-cmd-QUIT.
+ (erc-mode): Use the case-table only in CVS Emacs. See comment.
+
+ * erc.el(erc-cmd-QUIT): make reason optional.
+
+ * erc.el(erc-cmd-GQUIT): Fixed typo.
+
+2003-01-17 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-current-logfile): call expand-file-name, so that downcase doesn't mess up ~
+
+ * erc.el: * (erc-mode): Define a proper case-table.
+ * (erc-downcase): just call downcase for now, let's see if the case-table is portable, if yes, we'll remove all erc-downcase references anyway...
+
+ * erc-button.el: * (erc-button-add-buttons): regex-quote the nick
+
+2003-01-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(button): erc-channel-members-changed-hook no
+ longer has erc-recompute-nick-regexp.
+ (erc-button-alist): Use channel-members instead of
+ erc-nick-regexp.
+ (erc-button-add-buttons): Split some code into
+ erc-button-add-buttons-1, and now handle strings, lists, and
+ alists. Regular expressions in lists and alists are enclosed in
+ < and >.
+ (erc-button-add-buttons-1): New.
+ (erc-nick-regexp): Deleted.
+ (erc-recompute-nick-regexp): Deleted.
+
+ * erc-button.el: Remove require cl again.
+ (erc-mode-map): No longer bind widget-backward and widget-forward.
+ (erc-button-alist): Explain why byte-compiling makes no sense, and
+ remove all calls to byte-compile.
+ (erc-button-keymap): Define it the standard way, without exposing
+ the list nature of the keymap.
+ (erc-button-marker-list): Deleted.
+ (erc-button-add-buttons): Simplify. In particular, create the
+ button using the real callback, instead of using the intermediate
+ erc-button-push, and only store the data as described for
+ erc-button-alist.
+ (erc-button-remove-old-buttons): Simplify. No more list munging.
+ Instead, just remove all the properties that we add in
+ erc-button-add-button.
+ (erc-widget-press-button): Deleted.
+ (erc-button-click-button): New, for mouse clicks. Moves point to
+ where the mouse is, and calls erc-button-push.
+ (erc-button-push): Instead of matching again, just use the
+ erc-callback and erc-data properties at point to do the right
+ thing.
+ (erc-button-entry): Deleted.
+ (erc-button-next): Use error instead of the beep plus message
+ combo.
+
+2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-autoaway.el(erc-autoaway-set-back):
+ Don't pass a force argument to erc-cmd-GAWAY.
+
+ * erc.el(erc-cmd-AWAY): Removed usage of the force variable.
+
+2003-01-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(button):
+ erc-recompute-nick-regexp is no longer added to
+ erc-channel-members-changed-hook unconditionally, but only if
+ erc-button-mode is enabled, and if it is disabled, it is removed
+ 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,
+ so another solution needs to be found.
+
+2003-01-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-banlist-store):
+ Don't assume there's always a setter in the banlist reply.
+
+2003-01-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-button-url-regexp): Changed regexp according
+ to a suggestion by Max Froumentin <mf@w3.org>.
+
+2003-01-17 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ fix erc-remove-channel-member again to not error out on nil as first arg...
+
+ * erc.el: * (erc-occur): New function
+
+2003-01-17 Damien Elmes <erc@repose.cx>
+
+ * erc.el: erc-banlist-*: return nil so further hooks are called
+
+ * erc.el(erc-server-368):
+ suppress "end of ban list" messages - use /listbans now
+
+ * erc.el(erc-send-current-line):
+ removed the check for leading whitespace again - the
+ only time we want to prohibit multi-line commands is if / is the first
+ thing on the line
+ (erc-get-arglist): new defun for reading a function's arglist which should
+ work with older copies of emacs. we use help-function-arglist if it's
+ available, though, since that has support for reading subrs, etc
+
+ * erc.el(erc-cmd-JOIN): fixed (again)
+
+ * erc.el: * fixed call to erc-cmd-NICK when connecting
+ * support for listing bans and mass unbanning, again thanks to MrBump
+
+ * erc.el(erc-set-topic):
+ patch from MrBump (Mark Triggs, mst@dishvelled.net) to strip
+ control chars and topic attribution in C-c C-t
+
+2003-01-16 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-remove-channel-member): Do not use delq, modify the list using setcdr like delq does.
+ In theory, this should be way faster since the list doesn't get traverse two times.
+ Measurement didn't show any real difference though :(, this system is flawed for channels with >300 users it seems...
+ Also moved some defcustoms up.
+
+2003-01-16 Brian P Templeton <bpt@tunes.org>
+
+ * erc.el: moved misplaced paren
+
+2003-01-16 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-UNIGNORE):
+ reference argument directly - no string matching
+
+ * erc.el(erc-extract-command-from-line):
+ hmm, thinko in the canonicalization. should
+ be fixed
+
+2003-01-16 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-send-current-line):
+ Changed the regexp used to match /COMMANDs so that leading
+ whitespace is taken into account.
+
+2003-01-16 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: * (erc-dcc-do-SEND-command): Fix it
+
+ * erc-ezbounce.el, erc-lang.el: Arglist changes...
+
+ * erc.el: Various docstring fixes and additions.
+
+ * erc-notify.el:
+ * (erc-cmd-NOTIFY): Change the function arglist to (&rest args)
+
+ * erc-netsplit.el: * (erc-cmd-WHOLEFT): Has no args...
+
+2003-01-16 Damien Elmes <erc@repose.cx>
+
+ * erc-fill.el:
+ erc-fill-column: default to 78, so things like docstrings don't get wrapped
+ in an ugly manner
+
+2003-01-16 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-cmd-default): Take a substring, now /mode works again.
+ * (erc-cmd-AWAY): Put do-not-parse-args t
+ * (erc-cmd-GAWAY): Ditto, and fix it.
+ * (erc-cmd-CTCP): Switch to argument system.
+ * (erc-cmd-KICK): Do the same.
+
+2003-01-15 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el:
+ * (erc-cmd-DCC): Fixed for the new scheme, simplified.
+ * (erc-dcc-do-CHAT-command): Ditto.
+ * (erc-dcc-do-CLOSE-command): Ditto.
+ * (erc-dcc-do-LIST-command): Ditto.
+
+2003-01-15 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ erc-error-face: setting a background doesn't work so well with multi-line
+ messages, so we don't. fg color is negotiable ;-)
+ (erc-cmd-QUERY): fixed, new doco, suppress (erc-delete-query) until we fix it
+ (erc-send-current-line): allow multi-line messages provided they don't start
+ with a slash - there's no need to prohibit them if the slash isn't the
+ first character
+
+ * erc.el: * bad-syntax now reports like incorrect-args
+ * bunch of extra cmds fixed, nick, sv etc.
+
+ * erc.el(erc-cmd-HELP): fixed
+ (erc-extract-command-from-line): when determining canon-defun, make sure we
+ have a valid symbol
+ (erc-cmd-KICK): fixed
+
+ * erc.el:
+ * removed duplicate do-no-parse-args properties for the defaliased defuns
+ (erc-process-input-line): show function signature when incorrect args
+ (erc-extract-command-from-line): canonicalize defaliases before extracting
+ plist
+ (erc-cmd-CLEAR): fixed
+ (erc-cmd-UNIGNORE): fixed again
+
+ * erc.el(erc-cmd-SET): fixed
+ (erc-cmd-UNIGNORE): fixed
+ (erc-process-input-line): report when incorrect arguments are provided to a
+ command, and show the command's docstring
+
+ * erc.el(erc-cmd-APPENDTOPIC): fixed
+ (erc-process-input-line): more informative error message than 'bad syntax'
+
+2003-01-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * (erc-cmd-IGNORE): fixed
+
+ * erc.el: * (erc-cmd-NAMES): fixed
+
+ * erc.el:
+ * (erc-cmd-CLEARTOPIC): Simplify, fix doc, make interactive
+
+2003-01-15 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-JOIN):
+ correct invite behavior, and document it.
+
+2003-01-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * (erc-cmd-PART): Put 'do-not-parse-args t
+
+2003-01-15 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-cmd-JOIN): new cmd argument syntax
+ (erc-process-input-line): check if (erc-extract-command-from-line) returned a
+ list, and apply if that's the case
+
+ * erc.el:
+ erc-cmd-*: remove optional force and references to `force' in the code
+ (erc-cmd-AMSG): call erc-trim-string, not trim-string
+
+2003-01-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-cmd-CLEARTOPIC): LINE is now ARGS and already parsed.
+ Set erc-cmd-TOPIC to 'do-not-parse-args for now.
+ (comment: I think we should have 'first, so that only first word is parsed...
+ Or we could autodetect erc-channel-p in the parser before that somehow...)
+
+ * erc.el: * (erc-cmd-OP): LINE is PEOPLE now, and already parsed.
+
+ * erc-notify.el:
+ * (erc-cmd-NOTIFY): Arg LINE is now ARGS, and already parsed.
+
+2003-01-15 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-stamp.el(erc-insert-timestamp-right):
+ Prefer erc-fill-column to window-width,
+ because on wide screens the timestamp could wander off too far to the
+ right.
+
+2003-01-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el: This is the "everything is suddenly broken!" release
+ You know, this is CVS, you can still go back, and wait until the transition
+ is finished, but here is patch one, which basically breaks every command
+ which is typed on the prompt.
+ Hit me, we can still revert, but something needs to be done about this.
+ * (erc-extract-command-from-line): intern-soft the function here.
+ If the function symbol has a property 'do-not-parse-args, operate as before,
+ otherwise, split the arguments prior to calling the command handler.
+ * (erc-process-input-line): Updated to accommodate the change above.
+ * (erc-send-distinguish-noncommands): Ditto.
+ * (erc-cmd-NAMES): Ditto.
+ * (erc-cmd-ME): Put 'do-not-parse-args property.
+
+ * erc-dcc-list: Renamed
+ * (erc-dcc-member). Treat :nick as either a nick!user@host or nick,
+ do appropriate comparisons, simplified.
+ * (erc-dcc-list-add): New functions
+ various callers of (cons (list ...) erc-dcc-list) updated.
+ Other stuff I'm too bored to document now
+
+2003-01-15 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-stamp.el(erc-insert-timestamp-right):
+ Removed redundant code that overrid the
+ window-width. Now subtracts (length string) from every found
+ indentation positions.
+
+2003-01-14 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-cmd-AMSG): Remove useless call to erc-display-message.
+
+ * erc-dcc.el:
+ * erc-dcc-chat/send-request: New variables, control how to treat
+ incoming dcc chat or send requests. Can be set to 'ask, which behaves
+ like it did before, 'auto, which accepts automatically, and
+ 'ignore, which ignores those type of requests completely.
+ * (erc-cmd-CREQ): New user-level command.
+ * (erc-cmd-SREQ): Ditto.
+
+ * erc.el: * (erc-cmd-AMSG). New command.
+
+ * erc-xdcc.el: * (erc-xdcc): delete empty strings from ARGS
+
+ * erc-dcc.el: * erc-dcc-ipv4-regexp: New constant
+ * (erc-ip-to-decimal): Use it.
+ * erc-dcc-host:valid-regexp erc-dcc-ipv4-regexp:
+ * erc-dcc-host: :type
+ * (pcomplete/erc-mode/DCC): Add completion for GET and CLOSE.
+ * Some docstring/comment fixes.
+
+ * erc-stamp.el:
+ * (erc-insert-timestamp-right): Subtract (length string) from
+ POS in any case, otherwise, linewrap occurs.
+
+ * erc-dcc.el:
+ * Fixed the unibyte-multibyte problem (now a dcc get buffer is (set-buffer-multibyte nil),
+ and saves correctly (tried with 21.3.50)). Thanks to Eli for suggesting it!
+ * Added :start-time plist property/value to GET handling so that we can calculate elapsed-time.
+ * Some (unwind-protect (progn (set-buffer ...) ...)) constructs replaced with (with-current-buffer ...)
+
+2003-01-13 Mario Lang <mlang@delysid.org>
+
+ * erc-xdcc.el:
+ * erc-xdcc-help-text: New variable which makes replies to the originator
+ much more flexible.
+ * erc-xdcc-help-format: Removed.
+ * (erc-xdcc-help): Handle the new variable.
+ * (erc-xdcc): Simplified
+
+ * erc-xdcc.el: * erc-xdcc-handler-alist: New variable.
+ * (erc-xdcc): Move code for list and send sub-commands into
+ * (erc-xdcc-help): New function.
+ * (erc-xdcc-list): New function.
+ * (erc-xdcc-send): New function.
+
+2003-01-12 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-server-JOIN):
+ Oops, send MODE command only when *we* joined a channel.
+
+ * erc.el:
+ Fixing ERCs behavior wrt IRCnet's !channels have a different name for
+ JOIN than in reality (e.g. you can join !forcertest or !!forcertest
+ and really get to !ABCDEforcertest)
+
+ (erc-cmd-JOIN): Removed erc-send-command MODE.
+ (erc-server-JOIN): Ask for MODE now.
+
+2003-01-12 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el:
+ (erc-dcc-get-filter), (erc-dcc-get-file): store size as a string, not an
+ integer. check size > 0 for the case where a size wasn't provided, since
+ string-to-int will return 0 on an empty string
+
+2003-01-12 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: * Use RAWFILE arg with find-file-noselect
+ * Fix alist/plist conversion left-over
+ * Add verbose-info about sending blocks.
+
+2003-01-11 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: * (pcomplete-erc-mode/DCC): Fixes
+
+ * erc-xdcc.el: Initial version.
+
+ * erc-pcomplete.el:
+ * (erc-pcomplete): Fix so that cycle-completion works again.
+ * (pcomplete-parse-erc-arguments): If there is a space after the last word
+ before point, we need to return a "" arg, and it's position.
+
+ * erc-dcc.el: Fix to pcomplete/erc-mode/DCC
+
+ * erc-dcc.el: * (pcomplete/erc-mode/DCC): New function
+
+ * erc-dcc.el: *** empty log message ***
+
+ * erc-dcc.el: Move code around, just basic changes
+
+2003-01-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-stamp.el(erc-insert-timestamp-right):
+ Check whether erc-fill-column is
+ available before using it. Else default to fill-column or if
+ everything else fails, the window width of the current window. For the
+ fill-columns, use them directly as the starting position for the
+ timestamp.
+
+2003-01-11 Andreas Fuchs <asf@void.at>
+
+ * erc-stamp.el:
+ erc-insert-timestamp-right: use correct window's window-width. If
+ buffer is not in a window, use erc-fill-column.
+
+2003-01-11 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el (erc-dcc-do-LIST-command): Fix
+
+ * erc-dcc.el:
+ * buffer-local variables erc-dcc-sent-marker and erc-dcc-send-confirmed marker removed
+ Keep This info in erc-dcc-member :sent and :confirmed plist values
+ :buffer plist for :type 'SEND removed, since we can get this with (marker-buffer
+ * erc-dcc-send-connect-hook: New hook, defaults to erc-dcc-send-block and erc-dcc-send-connected, which now prints a msg...
+
+ * erc-dcc.el:
+ * (erc-dcc-chat-accept): Renamed from erc-dcc-chat. Callers updated.
+ * (erc-dcc-chat): Renamed from erc-dcc-chat-request.
+ Callers updated, and interactive form added.
+ * (erc-dcc-server-accept): No longer do any type-specific stuff.
+ * (erc-dcc-chat-sentinel): Call erc-dcc-chat-setup if event is "open from "
+ from here, otherwise call erc-dcc-chat-close.
+
+ * (
+
+ * erc-dcc.el: *** empty log message ***
+
+ * erc-dcc.el: Moved some functions around.
+ Doc string fixes.
+ "/dcc send nick filename" works now
+
+2003-01-11 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-send-command): Fixed flood protect message.
+
+ * erc-button.el(erc-button-syntax-table): Make `-' a legal nick
+ constituent.
+
+2003-01-10 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: Some more steps toward dcc send.
+
+2003-01-10 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-notify.el(erc-notify-timer):
+ Changed to make it IRC-case-insensitive when comparing nicks.
+ (erc-notify-JOIN): Changed to make it IRC-case-insensitive when comparing nicks.
+ (erc-notify-NICK): Changed to make it IRC-case-insensitive when comparing nicks.
+ (erc-notify-QUIT): Changed to make it IRC-case-insensitive when comparing nicks.
+ (erc-cmd-NOTIFY): Now "/notify -l" lists the nicks on your notify list. Now
+ when you remove a nick from your notify list, you no longer receive a spurious
+ signoff notification for that nick. Changed to make it IRC-case-insensitive when
+ comparing nicks.
+
+ * erc.el(erc-ison-p):
+ Fixed so it calls erc-member-ignore-case instead of member.
+
+ * erc.el(erc-member-ignore-case):
+ New function. Just like member-ignore-case, but obeys
+ the IRC protocol case matching rules.
+
+2003-01-10 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el:
+ (erc-dcc-do-GET-command), (erc-dcc-get-file): use the plist syntax, this
+ fixes dcc get again
+
+2003-01-10 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: erc-complete-functions: New variable.
+ erc-mode-map: Bind \t to 'erc-complete-word
+ erc-complete-word: New function.
+
+ * erc-pcomplete.el(erc-pcomplete-mode):
+ Use new erc-complete-functions
+ (erc-pcomplete): Check that we're in the input line, else return nil.
+
+ * erc-button.el(erc-button-mode): Use new erc-complete-functions
+ erc-button-old-tab-command: Removed.
+ (erc-button-next-or-old): Removed
+ (erc-button-next): check that we're not in the input line, else just return nil.
+
+2003-01-10 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: cleanup
+
+ * erc-dcc.el:
+ * (erc-dcc-chat-request): No longer use erc-send-ctcp-message.
+
+ * erc-dcc.el:
+ * (erc-dcc-no-such-nick): Also call delete-process if we have a peer already
+
+ * erc-dcc.el:
+ * (erc-dcc-no-such-nick): New function, server event handler for event 401.
+ If we send a CTCP message requesting something dcc related, we set up an
+ entry in erc-dcc-list before sending the request (for the server proc object
+ for listening conns for example). But if that nick does not exist
+ on that server, we now nicely cleanup erc-dcc-list again.
+
+2003-01-09 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: Moved code around a bit, and doc fixes
+
+ * erc-dcc.el: *** empty log message ***
+
+ * erc-dcc.el: Rename erc-dcc-plist to erc-dcc-list
+
+2003-01-09 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el(erc-dcc-server (erc-dcc-chat-setup):
+ use erc's (erc-setup-buffer) to determine how to
+ display new DCC windows
+ (erc-dcc-chat-buffer-killed): buffer-local hook for DCC buffers to close the
+ process
+ (erc-dcc-chat-close): code common to a killed buffer or a disconnection from
+ the other side
+ (erc-dcc-chat-sentinel): use (erc-dcc-chat-close)
+ (erc-dcc-server-accept): use (erc-log) instead of (message)
+
+ * erc.el:
+ (erc), (erc-setup-buffer): factor out window generation code so DCC can use
+ it too
+
+ * erc-dcc.el:
+ (erc-dcc-do-CLOSE-command), (erc-dcc-do-LIST-command): work with erc-dcc-plist
+
+ * erc-dcc.el:
+ erc-dcc-alist: became erc-dcc-plist, so we can more easily grab particular
+ properties
+ dcc catalog: unify use of DCC: and [dcc] (either's fine, but let's be
+ consistent)
+ (erc-dcc-member): takes an arbitrary list of constraints now
+ (erc-dcc-proc-member): removed, as (erc-dcc-member) can be used for this
+ (erc-dcc-do-CHAT-command): use the catalog to show the user what's going on
+ (erc-dcc-chat-server): removed
+ (erc-dcc-server): takes name sentinel and filter arguments, can be used for
+ both send and chat now
+
+ .. this release means all send/get support is broken until we fix up the
+ things that still expect to be using an alist. this include /dcc list, /dcc
+ close
+
+2003-01-09 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-ring.el(erc-previous-command):
+ If you have a partially typed input line and press M-p,
+ you lose what you typed. Now we save it so you can come back to it.
+
+2003-01-09 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-ring.el(erc-add-to-input-ring): s/nullp/null/
+
+2003-01-09 Damien Elmes <erc@repose.cx>
+
+ * erc-ring.el(erc-add-to-input-ring):
+ set up the ring if it's not already setup
+
+ * erc-dcc.el(erc-dcc-member): case insensitive match of nicknames
+ (erc-dcc-do-CHAT-command): echo what we're doing (at least for now)
+
+2003-01-09 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el: (temporarily) fix erc-process setting...
+
+ * erc-dcc.el: * (erc-dcc-chat-send-line): Removed
+
+ * erc.el:
+ Check if target is stringp (we can now also have 'dcc as value...)
+
+ * erc-dcc.el(erc-dcc-chat-send-input-line):
+ New function, used for
+ erc-send-input-line-function.
+ Use erc-send-current-line now.
+
+ * erc-dcc.el: evt to elt...
+
+ * erc-dcc.el: Remove () from a var (how silly!)
+
+ * erc-dcc.el: * (erc-dcc-get-host): Use format-network-address.
+ * (erc-dcc-host): Change semantic. If erc-dcc-host is set, use it.
+ Otherwise, try to figure out the host by calling erc-dcc-get-host.
+ * (erc-dcc-server-port): New variable.
+ * erc-dcc-chat-log: Renamed to erc-dcc-server-accept
+
+ * erc-dcc.el(erc-dcc-do-CHAT-command):
+ Change arg of call to erc-dcc-chat-request from elt to nick
+
+2003-01-09 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-send-current-line):
+ Now rejects multi-line commands (i.e., lines that
+ start with "/" and contain newlines).
+
+2003-01-09 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-button.el:
+ Functionality to use TAB to jump to the next button:
+
+ (erc-button-next-or-old): New function.
+ (erc-button-next): New function.
+ erc-button-keymap: added erc-button-next
+ erc-button-old-tab-command: New variable.
+ define-erc-module button: Add and remove 'erc-button-next-or-old as
+ appropriate.
+
+2003-01-09 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ New variable: erc-auto-reconnect (defaults to t). If non-nil, ERC will
+ automatically reconnect to a server after an unexpected disconnection.
+ (erc-process-sentinel): Changed to refer to variable erc-auto-reconnect.
+
+2003-01-08 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * erc-send-input-line-function: New variable, used for dispatch...
+
+2003-01-08 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el(erc-dcc-chat-sentinel):
+ check event type before killing process
+ (erc-dcc-chat-log): new, handles the setup of dcc chats for incoming
+ connections
+ (erc-dcc-chat): use (erc-dcc-chat-setup)
+ (erc-dcc-chat-setup): code common to incoming and outgoing DCC chats
+ (erc-dcc-chat-request): request a DCC chat with another user
+ (erc-dcc-proc-member): locate a member in erc-dcc-alist by process
+
+ The very first ERC to ERC DCC chat was held between delysid and resolve today!
+
+2003-01-08 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el(erc-all-buffer-names):
+ Check for erc-dcc-chat-mode too
+
+2003-01-08 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-ring.el, erc.el(erc-kill-input):
+ Resets erc-input-ring-index to nil, so that invoking this
+ command conceptually puts you after your most recent input in the input
+ history.
+ (erc-previous-command and erc-next-command): Changed so that history movement
+ is more intuitive. Also preserves the blank input line that marks the
+ place after the newest command in the history ring (i.e., you'll see a
+ blank command once every trip around the ring in either direction).
+
+2003-01-08 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el(erc-dcc-chat): Add docstring
+ Add self-test.
+ Fix error if /dcc chat nick doesn't find the nick
+
+2003-01-08 Francis Litterio <franl@users.sourceforge.net>
+
+ * Makefile:
+ Changed so that "make" works correctly under Cygwin. Before this change, the
+ pathname passed to Emacs on the command line under Cygwin had the form
+ "/cygwin/c/...", which prevented emacs from finding the file. Now the pathname
+ has the form "c:/...". This works for any drive letter.
+
+2003-01-08 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el: reindent some code, and add TODO to comments
+
+ * erc-dcc.el: *** empty log message ***
+
+ * erc-dcc.el: Make dcc-chat-ended a notice
+ Remove now bogus comment
+
+2003-01-08 Damien Elmes <erc@repose.cx>
+
+ * erc-dcc.el(erc-pack-int): from erc-packed-int
+ (erc-unpack-int): new
+
+ * erc-dcc.el(erc-unpack-str): added
+
+2003-01-08 Mario Lang <mlang@delysid.org>
+
+ * erc.el(erc-server-482):
+ New handler, handles KICK reply if you're not channel-op
+
+ * erc-dcc.el: Document SEND in erc-dcc-alist.
+ Move sproc, parent-proc and file into erc-dcc-alist
+
+ * erc-dcc.el: stubs
+
+ * erc-dcc.el(erc-dcc-get-host):
+ Change :iface to :local since Kim committed it now to CVS emacs
+
+ * erc-dcc.el(erc-dcc-get-host):
+ New function, requires the not-yet-in-CVS-emacs local-address.patch to process.c.
+ Some other minor additions
+
+2003-01-08 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-cmd-IGNORE):
+ Now returns t to prevent "Bad syntax" error.
+ (erc-cmd-UNIGNORE): Now returns t to prevent "Bad syntax" error.
+ (erc-server-PRIVMSG-or-NOTICE): Capitalized first word in message to user.
+
+ * erc.el(erc-scroll-to-bottom):
+ Temporarily bind resize-mini-windows to nil so that
+ users who have it set to a non-nil value will not suffer from premature
+ minibuffer shrinkage due to the below recenter call. I have no idea why
+ this works, but it solves the problem, and has no negative side effects.
+
+2003-01-07 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-dcc.el:
+ erc-dcc-ctcp-query-chat-regexp: The IP is not really an IP, but a
+ number (no . allowed there).
+ (erc-dcc-send-ctcp-string): use let* here to avoid cluttering up the
+ match data.
+ Also, use erc-decimal-to-ip to get the IP.
+ (erc-ip-to-decimal): Removed some pasted ERC timestamps
+ (erc-decimal-to-ip): New function.
+ erc-dcc-chat-mode-map: Return map in the initialization.
+
+2003-01-07 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-match.el(erc-match-fool-p):
+ Changed to call erc-match-directed-at-fool-p instead of
+ erc-directed-at-fool-p.
+
+2003-01-07 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el(erc-cmd-DCC):
+ Change (cond ... (t nil)) to (when ...)
+
+ * erc-dcc.el: Use erc-current-nick-p
+
+2003-01-07 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-join-buffer: Added 'window-noselect to docstring and :type.
+ erc-auto-query: Added 'window-noselect to :type.
+ (erc): Treat erc-join-buffer being 'window-noselect appropriately.
+
+ * erc.el(erc-current-nick-p): New function.
+ (erc-nick-equal-p): New function.
+ (erc-already-logged-in), (erc-server-JOIN), (erc-auto-query),
+ (erc-server-PRIVMSG-or-NOTICE): Use erc-current-nick-p.
+ (erc-update-channel-member): Use erc-nick-equal-p.
+
+ * erc-match.el(erc-match-current-nick-p):
+ Renamed from erc-current-nick-p
+ (erc-match-pal-p): Renamed from erc-pal-p
+ (erc-match-fool-p): Renamed from erc-fool-p
+ (erc-match-keyword-p): Renamed from erc-keyword-p
+ (erc-match-dangerous-host-p): Renamed from erc-dangerous-host-p
+ (erc-match-directed-at-fool-p): Renamed from erc-directed-at-fool-p
+ (erc-match-message): Use erc-match-TYPE-p instead of erc-TYPE-p
+
+ * erc.el:
+ Support for IRCnets' "nick/channel temporarily unavailable"
+
+ (erc-nickname-in-use): New function (mostly copied from erc-server-433).
+ (erc-server-433): Use erc-nickname-in-use
+ (erc-server-437): New function.
+ erc-server-hook-list: Added (437 erc-server-437).
+
+2003-01-07 Mario Lang <mlang@delysid.org>
+
+ * erc-fill.el: Add autoload cookie
+
+ * erc-notify.el:
+ Now also pass SERVER argument to signon/off hooks, and provide a erc-notify-signon/off function for echo-area printing
+
+ * erc-notify.el(erc-notiy-QUIT):
+ Change use of delq to delete, delq does not work with strings
+
+2003-01-06 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-ctcp-query-VERSION):
+ v%s -> %s, so we are no longer vVersion...
+
+2003-01-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Small change to erc-ison-p, and fixme tag
+
+2003-01-06 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc):
+ Fixed bug where variable "away" would be nil in new channel buffers
+ even if the user is away when joining the channel.
+ (erc-strip-controls): Fixed a bug where erc-strip-controls accidentally
+ removed all text properties from the string.
+
+2003-01-06 Mario Lang <mlang@delysid.org>
+
+ * erc-dcc.el:
+ Some stub functions, some code, nothing really works yet
+
+ * erc.el(erc-ison-p): New function
+
+ * erc-dcc.el: Some functions which will be needed for dcc send
+
+ * erc-dcc.el(erc-ip-address-to-decimal):
+ New function, thanks lawrence
+
+ * erc-dcc.el: Again, simplify code, fix stuff, DCC CHAT works now
+
+ * erc-dcc.el: Many fixes, chat nearly works now
+
+ * erc-netsplit.el: Also detect fast netsplit/joins
+
+ * erc-dcc.el: some more fixes
+
+ * erc-dcc.el: Fixup stage 1, now dcc get works
+
+ * erc-dcc.el: make /dcc LIST work
+
+ * erc-dcc.el:
+ Initial checkin, don't use it! its really far from complete. Hackers: help!
+
+ * erc-notify.el:
+ New function erc-notify-NICK, and added signon/off hooks which were missing
+
+2003-01-05 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-truncate-buffer-to-size):
+ set inhibit-read-only to t for the
+ deletion. This is usually done by the function calling the hook, but
+ not if it's called interactively. Also, rewrote some weird if/if
+ combination.
+
+ * erc-track.el(erc-track-shortennames):
+ Documentation fix (erc-all-buffers is really
+ erc-all-buffer-names)
+
+ These changes make server buffers be tracked as well, as there are
+ quite a few interesting things going on there (e.g. CTCP etc.)
+ (erc-all-buffer-names): Check for (eq major-mode 'erc-mode) instead of
+ erc-default-recipients.
+ (erc-track-modified-channels): Don't require a default target (e.g.,
+ this-channel being non-nil)
+
+2003-01-03 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ erc-auto-query: can now be set to a symbol to control how new messages should
+ be popped up (or not popped up, as the case may be)
+ (erc-query): new function which handles the bulk of what (erc-cmd-QUERY) did
+ previously
+ (erc-cmd-QUERY): use (erc-query)
+ (erc-auto-query): use (erc-query)
+
+ * erc.el(erc-current-logfile):
+ Downcase result of log generation function, as IRC is
+ case insensitive. Fixes problems where "/query user" results in a different
+ log file to a query from "User". Avoided adding an extra flag to control this
+ behavior - if you think this was the wrong decision, please correct it and
+ I'll remember it for next time.
+
+2002-12-31 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-split-command):
+ Removed assignment to free variable "continue".
+ (erc-strip-controls): New function. Takes a string, returns the string with
+ all IRC color/bold/underline/etc. control codes stripped out.
+ (erc-interpret-controls): If variable erc-interpret-controls-p is nil, now
+ uses erc-strip-controls to strip control codes.
+ (erc-ctcp-reply-ECHO): Changed reference and assignment to free variable "s"
+ into reference/assignment to "msg", which appears to be the original author's
+ intent.
+
+ * erc-list.el(erc-chanlist):
+ Changed to use the new erc-once-with-server-event function
+ instead of the old macro of the same name.
+
+ * erc-notify.el(erc-notify-timer):
+ Changed to use the new erc-once-with-server-event function
+ instead of the old macro of the same name. Also fixed a bug were variable
+ erc-last-ison was being read from a non-server buffer (thus giving its default
+ value instead of its per-server value).
+
+ * erc.el(erc-once-with-server-event):
+ This is now a function. It was a macro with a
+ bug (the call to gensym happened at byte-compile-time not macro-call-time).
+ (erc-toggle-debug-irc-protocol): Now [return] is bound to this function in
+ the *erc-protocol* buffer.
+
+2002-12-30 Alex Schroeder <alex@gnu.org>
+
+ * erc-autoaway.el(erc-autoaway-idletimer): Doc,
+ ref. erc-autoaway-use-emacs-idle.
+ (autoaway): Doc, explain different idle definitions. Reestablish
+ the idletimer only when erc-autoaway-use-emacs-idle is non-nil.
+ (erc-auto-set-away): Doc, ref erc-auto-discard-away.
+ (erc-auto-discard-away): Doc, ref erc-auto-set-away.
+ (erc-autoaway-use-emacs-idle): Doc, ref erc-autoaway-mode, and
+ added a note that this feature is currently broken.
+ (erc-autoaway-reestablish-idletimer): Doc.
+ (erc-autoaway-possibly-set-away): Split test such that
+ erc-time-diff is only computed when necessary, add a comment why
+ erc-process-alive is not necessary.
+ (erc-autoaway-set-away): Test for erc-process-alive.
+
+2002-12-29 Alex Schroeder <alex@gnu.org>
+
+ * erc-autoaway.el:
+ Changed the order of defcustoms to avoid errors in the :set property
+ of erc-autoaway-idle-seconds.
+
+2002-12-29 Damien Elmes <erc@repose.cx>
+
+ * erc-track.el:
+ * (erc-track-get-active-buffer): remove superfluous (+ arg 0)
+
+2002-12-29 Alex Schroeder <alex@gnu.org>
+
+ * erc-autoaway.el(erc-autoaway): Moved the defgroup up to the
+ top, before the define-erc-module call.
+ (autoaway): Extended doc.
+ (erc-autoaway-idle-seconds): Use a :set property to handle
+ erc-autoaway-use-emacs-idle.
+ (erc-auto-set-away): Set default to t. Added doc strings where
+ necessary, reformatted doc strings such that the first line can
+ stand on its own. This is important for the output of M-x
+ apropos.
+
+2002-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-auto.in:
+ added (provide 'erc-auto), which is required for (require 'erc-auto) :)
+
+ * erc.el(erc-display-prompt):
+ Set the face property of the prompt to
+ everything but the last character.
+
+ * erc.el(erc-send-current-line):
+ Check whether point is in the input line. If
+ not, just beep and do nothing.
+
+2002-12-28 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-bol):
+ Fixed bug when there is only a prompt, and no property
+ change.
+
+ * erc.el(erc-display-prompt): Rewrote using a save-excursion
+ and erc-propertize. No longer use a field for the prompt, but a
+ plain text property called erc-prompt.
+ (erc-bol): Use the erc-prompt text property instead of a field.
+ Return point instead of t.
+ (erc-parse-current-line): No need to call point here, then, since
+ erc-bol now returns point.
+
+ * Makefile:
+ make ChangeLog .PHONY, thus forcing it always to be rebuilt.
+
+2002-12-28 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-log-irc-protocol):
+ Removed check whether get-buffer-create
+ returned nil. "The value is never nil", says the docstring.
+
+ * erc.el: Day Of The Small Changes
+
+ (erc-display-prompt): Make the prompt 'front-sticky, which prevents it
+ from being modified. It *should* also make end-of-line move to the
+ end of the field (i.e. the end of the prompt) when point is at the
+ beginning of the prompt, but it doesn't. Dunno why. :(
+
+2002-12-27 Francis Litterio <franl@users.sourceforge.net>
+
+ * Makefile:
+ Added "-f" to "rm" command in rule for target "realclean".
+
+ * erc.el:
+ New function: erc-log-irc-protocol. Consolidates nearly duplicate code
+ from functions erc-send-command and erc-process-filter into one function.
+
+ * erc.el(erc-toggle-debug-irc-protocol):
+ Removed unneeded argument PREFIX and code
+ which referenced it at end of function.
+ (erc-send-command): Now we only append a newline to the logged copy
+ of output protocol text if it doesn't have one.
+
+2002-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-toggle-debug-irc-protocol):
+ Display buffer if it's not shown
+ already, and use view-mode.
+ (erc-toggle-debug-irc-protocol), (erc-send-command),
+ (erc-process-filter): inhibit-only t to insert into the
+ *erc-protocol* buffer (view-mode)
+
+2002-12-27 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el(erc-mode-map):
+ Removed keybinding for erc-toggle-debug-irc-protocol.
+ (erc-toggle-debug-irc-protocol): Now used erc-make-notice to propertize the
+ face of the enabled/disabled messages in the *erc-protocol* buffer.
+ (erc-send-command): Now outgoing IRC protocol traffic is logged too.
+
+ * erc.el:
+ Added user-customizable variable erc-debug-irc-protocol.
+ Added function erc-toggle-debug-irc-protocol.
+ (erc-process-filter): Now supports IRC protocol logging. If variable
+ erc-debug-irc-protocol is non-nil, all IRC protocol traffic is appended
+ to buffer *erc-protocol*, which is created if necessary.
+
+2002-12-27 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-display-prompt):
+ Don't make the prompt intangible; that didn't
+ make things that much better for the user, but confused ispell,
+ which checked the prompt when it should check the first word
+
+2002-12-27 Alex Schroeder <alex@gnu.org>
+
+ * AUTHORS: fixed resolve's email add
+
+ * AUTHORS: added damien
+
+ * erc.el(erc-truncate-buffer-on-save):
+ Removed documentation that
+ described behavior now changed. It used to say "When nil, no
+ buffer is ever truncated." This is no longer true; even when
+ buffers are NOT truncated on save, they can be truncated, eg. by
+ adding erc-truncate-buffer to the hook.
+ (erc-logging-enabled): New function.
+ (erc-current-logfile): New function.
+ (erc): Use erc-logging-enabled and erc-current-logfile.
+ (erc-truncate-buffer-to-size): Rewrote it, and made sure to use a
+ (save-restriction (widen) ...) such that the truncation actually
+ runs in the whole buffer, not in the last message only (as
+ erc-insert-post-hook will do!). This should fix rw's
+ out-of-bounds error.
+ (erc-generate-log-file-name-short): Made all but the BUFFER
+ argument optional. Doc: Mention
+ erc-generate-log-file-name-function.
+ (erc-generate-log-file-name-long): Doc: Mention
+ erc-generate-log-file-name-function.
+ (erc-save-buffer-in-logs): Use erc-logging-enabled and
+ erc-current-logfile. Doc: Mention erc-logging-enabled.
+
+ (erc-encode-string-for-target): Only do the real work when
+ featurep mule; else just return the string unchanged.
+
+2002-12-27 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ erc-encoding-default: check for (coding-system-p) for older emacs versions
+
+ * erc.el(erc-connect): missing ()s added. "don't commit at 2am"
+
+ * erc.el(erc-connect):
+ check if (set-process-coding-system) is available before use
+
+2002-12-27 Alex Schroeder <alex@gnu.org>
+
+ * AUTHORS: added franl
+
+2002-12-26 Alex Schroeder <alex@gnu.org>
+
+ * erc-pcomplete.el(pcomplete-parse-erc-arguments):
+ Reworked, and fixed a bug that had
+ caused completions to corrupt preceding text under some circumstances.
+
+ * erc.el(erc-encoding-default): New.
+ (erc-encode-string-for-target): Use it instead of a hard-coded ctext.
+ (erc-encoding-coding-alist): Doc.
+
+2002-12-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ Removed fix for bug 658552 recently checked-in, because it doesn't work.
+
+ * erc.el(erc-kill-buffer-function):
+ Removed check that connection is up
+ before running erc-kill-server-hook hooks. Those hooks should use
+ erc-process-alive to avoid interacting with the process.
+
+ * erc.el:
+ Fixed erc-send-current-line so it no longer assigns the free variable "s", and
+ it doesn't move point to end-of-buffer in non-ERC buffers. Fixed
+ erc-kill-buffer-function so it doesn't run the erc-kill-server-hook hooks if the
+ server connection is closed. Fixed bug 658552, which is described in detail at
+ http://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
+
+2002-12-26 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-cmd-SMV): Bug, now call erc-version-modules.
+
+ * erc-pcomplete.el(erc-pcomplete-version): New.
+
+2002-12-26 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-pcomplete.el:
+ Fix for bug where you could not complete a nick when there was text following
+ the nick.
+
+2002-12-25 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-already-logged-in): Use erc-process-alive.
+ (erc-prepare-mode-line-format): Use erc-process-alive.
+ (erc-process-alive): Check erc-process for boundp and processp.
+
+ * erc.el(erc-kill-buffer-function):
+ Do not check whether the process is
+ alive before running the hook, because there might be functions on
+ the hook that need to run even when the process is dead. And
+ function that wants to check this, should use (erc-process-alive).
+ (erc-process-alive): New function.
+ (erc-kill-server): Use it.
+ (erc-kill-channel): Use it.
+
+ * erc.el(erc-kill-buffer-function):
+ Reverted ignore-error change.
+ ignore-error is dangerous because we might miss bugs in functions
+ on erc-kill-server-hook.
+
+ * erc.el(erc-kill-buffer-function): Use memq instead of member
+ when checking process-status. Added doc string with references to
+ the other hooks.
+ (erc-kill-server): Only send the command when the erc-process is
+ still alive. This prevents the error: "Process
+ erc-irc.openprojects.net-6667 not running" when killing the buffer
+ after having used /QUIT.
+
+2002-12-24 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-server-ERROR):
+ Show the error reason, not only the originating host.
+
+ * erc.el(erc-kill-buffer-function):
+ (ignore-errors ...) in 'erc-kill-server-hook.
+ When the process for this server does not exist anymore, the hook
+ will cause an error, effectively preventing the buffer from being
+ killed.
+
+2002-12-24 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc-notify.el:
+ Fixed erc-notify-timer so that it passes the correct nick to
+ the functions on erc-notify-signoff-hook.
+
+2002-12-24 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el: Doc
+
+ * erc-track.el(erc-make-mode-line-buffer-name): Removed a
+ superfluous if construct around erc-track-showcount-string.
+ (erc-track-modified-channels): Use 1+.
+ Plus some doc and comment changes.
+
+2002-12-23 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Fix (erc-version) string
+
+2002-12-23 Francis Litterio <franl@users.sourceforge.net>
+
+ * erc.el:
+ Removed unnecessary assignment to free-variable "p" in erc-downcase.
+
+ * erc.el:
+ Now /PART reason strings are generated the same way /QUIT reason strings
+ are generated (see variable erc-part-reason). Also, when a server buffer
+ is killed, a QUIT command is automatically sent to the server.
+
+ * erc.el:
+ Changed erc-string-no-properties so that it is more efficient. Now it uses
+ set-text-properties instead of creating and deleting a temporary buffer.
+
+2002-12-21 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-kill-input: added a check to prevent a (ding) and an error when
+ there's nothing to kill (thanks to Francis Litterio, franl on IRC)
+
+2002-12-21 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ AWAY notice duplication prevention. erc-prevent-duplicates now set to ("301") by default, and timeout to 60
+
+ * erc.el: erc-prevent-duplicates: New variable, see docstring
+
+2002-12-20 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el:
+ erc-track-modified-channels: Use cddr of cell for old-face. cdr of
+ cell is '(1 . face-name), i have no idea why :)
+
+2002-12-20 Damien Elmes <erc@repose.cx>
+
+ * erc.el(erc-current-nick):
+ check the server buffer is active before using
+
+ Also tabified and cleaned up some trailing whitespace
+
+2002-12-15 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el: erc-track-count patch by az
+
+2002-12-14 Damien Elmes <erc@repose.cx>
+
+ * erc.el:
+ last-peers: initialize to a cons. thanks to Francis Litterio
+ <franl@world.std.com> for the patch
+
+ * erc.el:
+ erc-kill-channel-hook, erc-kill-buffer-hook, (erc-kill-channel):
+ both hooks now call erc-save-buffer-in-logs, so that query buffers are
+ saved properly now, and not just channel buffers.
+
+2002-12-13 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-unique-channel-names): Fix another #hurd
+ vs. #hurd-bunny bug.
+
+ * erc-match.el(match): No longer modify erc-send-modify-hook,
+ since it does not work without a parsed text property, anyway.
+ (erc-keywords): Allow cons cells.
+ (erc-remove-entry-from-list): Deal with cons cells.
+ (erc-keyword-p): Ditto.
+ (erc-match-message): Ditto.
+
+ Moved nil to the beginning of the list, removed :tags for the
+ -type variables:
+ (erc-current-nick-highlight-type): Ditto.
+ (erc-pal-highlight-type): Ditto.
+ (erc-fool-highlight-type): Ditto.
+ (erc-keyword-highlight-type): Ditto.
+ (erc-dangerous-host-highlight-type): Ditto.
+ (erc-log-matches-flag): Moved nil to the beginning.
+
+2002-12-11 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-beg-of-input-line: Don't do (goto-char (beginning-of-line)), since
+ beginning-of-line always moves point and returns nil. Thanks to
+ franl on IRC for noting this.
+
+ * erc-stamp.el:
+ erc-insert-timestamp-left, erc-insert-timestamp-right: Made the
+ timestamp a 'field named 'erc-timestamp. Now end-of-line and
+ beginning-of-line will move over the timestamp.
+
+2002-12-10 Damien Elmes <erc@repose.cx>
+
+ * erc-button.el(erc-button-add-button):
+ make the created button rear-nonsticky, to allow
+ cutting and pasting of buttons without worrying about the button properties
+ being inherited by the text typed afterwards.
+
+ * erc.el: save logfile when killing buffer
+
+2002-12-09 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-modified-channels-display): Reworked.
+ (erc-track-face-more-important-p): Removed.
+ (erc-track-find-face): Return only one face.
+ (erc-track-modified-channels): Reworked.
+ (erc-modified-channels-string): Changed from (BUFFER FACE...) to
+ (BUFFER . FACE)
+
+ * erc-stamp.el(erc-insert-timestamp-right): Do not assume
+ erc-fill-column is available.
+
+2002-12-09 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-ech-notices-in-minibuffer-flag, erc-minibuffer-notice: Clarified
+ the difference in the docstrings.
+
+2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: erc-noncommands-list: added erc-cmd-SM and erc-cmd-SMV
+
+2002-12-08 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-cmd-SM): New.
+ (erc-cmd-SMV): New.
+
+ * erc.el(erc-modes): New.
+
+2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-compat.el:
+ field-end: use (not (fboundp 'field-end)) instead of (featurep 'xemacs)
+
+2002-12-08 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-version-modules): New.
+
+2002-12-08 Mario Lang <mlang@delysid.org>
+
+ * debian/changelog, debian/control, debian/scripts/startup.erc:
+ debian release 3.0.cvs.20021208
+
+2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-split-command): Do the right thing with CTCPs.
+
+2002-12-08 Mario Lang <mlang@delysid.org>
+
+ * erc-stamp.el: Be a bit more functional
+
+2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-compat.el:
+ XEmacs doesn't seem to have field-end, so we provide our own version here.
+
+2002-12-08 Mario Lang <mlang@delysid.org>
+
+ * Makefile: Small fixes to debrelease target
+
+2002-12-08 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ make-obsolete-variable: xemacs doesn't have the WHEN parameter, remove it.
+
+2002-12-07 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-imenu.el(erc-create-imenu-index):
+ Use (forward-line 0) instead of
+ (beginning-of-line) now, sine the latter ignores fields (used in the
+ prompt).
+
+ * erc.el:
+ Rewrite of the prompt stuff to use a field named 'erc-prompt:
+
+ erc-prompt: Removed getter and setter functions. The properties were
+ already set (and overwritten) in erc-display-prompt.
+ (erc-prompt): Add the trailing space here, not all over the code.
+ (erc-display-prompt): Cleaned up a bit. The text-properties now are
+ valid on the whole prompt. Also, made the prompt 'intangible to
+ avoid confused users.
+ (erc-bol): Now use the field 'erc-prompt for finding the prompt
+ (erc-parse-current-line): Cleaned up considerably. Uses (erc-bol) now.
+ (erc-load-irc-script-lines): Adjusted for the new (erc-prompt).
+ (erc-save-buffer-in-logs): Adjusted for the new (erc-prompt).
+
+ * erc.el:
+ erc-uncontrol-input-line: The comment said "Consider it deprecated",
+ so I removed it now.
+ erc-prompt-interactive-input: Marked obsolete as of previous change.
+
+ * erc.el:
+ erc-smiley, erc-unmorse: Put at the end to separate it from the
+ important parts of erc.el.
+
+2002-12-07 Alex Schroeder <alex@gnu.org>
+
+ * erc-stamp.el(erc-insert-timestamp-right): New algorithm.
+
+2002-12-07 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ last-peers, erc-message: Explained what last-peers is used for.
+
+2002-12-07 Alex Schroeder <alex@gnu.org>
+
+ * erc-page.el(erc-cmd-PAGE): New function.
+ (erc-ctcp-query-PAGE): Use the catalog entry for the message, too.
+ (erc-ctcp-query-PAGE-hook): Added custom type.
+ (erc-page-function): Changed custom type from ... function-item to
+ ... function.
+ As well as doc strings.
+
+2002-12-06 Alex Schroeder <alex@gnu.org>
+
+ * erc-page.el: provide feature at the end
+
+2002-12-06 Brian P Templeton <bpt@tunes.org>
+
+ * erc-nickserv.el:
+ Added austnet in erc-nickserv.el (thanks to Damien Elmes
+ <resolve@repose.cx>)
+
+2002-12-05 Mario Lang <mlang@delysid.org>
+
+ * erc-complete.el: Add autoload cookie
+
+ * erc-speak.el: Small fix to make proper voice-changes
+
+2002-12-05 Alex Schroeder <alex@gnu.org>
+
+ * erc-lang.el: New
+
+2002-12-03 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-mode-map: Put back C-c C-p (PART) and C-c C-q (QUIT)
+
+2002-12-02 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-insert-post-hook: Add :options erc-make-read-only, erc-save-buffer-in-logs
+ erc-send-post-hook: Add :options erc-make-read-only
+
+ * erc.el: erc-insert-hook: Removed ("this hook is obsolescent")
+ erc-insert-post-hook: Added :options '(erc-truncate-buffer)
+
+2002-12-02 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Add missing requires
+
+2002-11-29 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-quit-reason-normal):
+ Remove v before %s so it's "Version ..." not
+ "vVersion ..."
+
+2002-11-26 Alex Schroeder <alex@gnu.org>
+
+ * erc-compat.el(erc-encode-coding-string): Add second argument
+ coding-system, and for non-mule xemacsen, use a new defun instead
+ of identity.
+
+ * erc.el: (define-erc-module): Use the appropriate group.
+ (erc-port): Changed custom type.
+ (erc-insert-hook): Custom group changed to erc-hooks.
+ (erc-after-connect): ditto
+ (erc-before-connect): ditto
+ (erc-disconnected-hook): ditto
+
+ * erc-button.el(erc-button): New group, changed all custom groups
+ from erc to erc-button, but left all erc-faces as-is.
+
+ * erc-track.el(erc-track): New group, changed all custom groups
+ from erc to erc-track.
+
+2002-11-26 Mario Lang <mlang@delysid.org>
+
+ * erc-macs.el:
+ Macros for erc-victim handling. Primary idea is to use setf and some fancy things to get nice syntax. have a look
+
+2002-11-26 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ pings, erc-cmd-PING, erc-ctcp-reply-PING, catalog entry CTCP-PING:
+ Cleaned up. Removed buffer-local variable pings which stored a list of
+ all sent CTCP PING requests. Now send our full time with the CTCP PING
+ request and interpret the answer.
+
+2002-11-25 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: nick-stk: replaced by the local variable current-nick.
+
+2002-11-25 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-send-command): Use erc-encode-string-for-target.
+ (erc-encode-string-for-target): New.
+
+ * erc-compat.el(erc-encode-coding-string): Add second argument
+ coding-system, and for non-mule xemacsen, use a new defun instead
+ of identity.
+
+ * erc-nickserv.el(erc-nickserv-version): New.
+
+2002-11-25 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * Makefile:
+ UNCOMPILED: erc-chess.el depends on chess-network.el, which might not
+ be installed. Don't compile it.
+
+ * erc.el:
+ erc-mode-map: Added C-a as erc-bol (no reason why it shouldn't be),
+ and removed C-c C-p (part channel) and C-c C-q (quite server) as these
+ are a bit drastic in their consequences and easy to mistype.
+
+2002-11-24 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el: erc-track-faces-priority-list: Extended list
+
+ * erc.el:
+ channel-members: Updated docstring: We have a VOICE predicate, too.
+
+ * erc-track.el(erc-unique-substrings):
+ Don't shorten a single channel to "#", but
+ always give at least 2 chars (except when there are no two chars).
+
+2002-11-23 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-nickserv.el:
+ support for BrasNET. Thanks to rw on IRC for the settings.
+
+2002-11-23 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: (erc-default-recipients, erc-session-user-full-name)
+ (nick-stk, pings, erc-announced-server-name, erc-connected)
+ (channel-user-limit, last-peers, invitation, away, channel-list)
+ (last-sent-time, last-ping-time, last-ctcp-time, erc-lines-sent)
+ (erc-bytes-sent, quitting, bad-nick, erc-logged-in)
+ (erc-default-nicks): Defvars.
+
+ * erc-compat.el: Switched tests to iso-8859-1 instead of latin-1.
+
+ * erc-compat.el(erc-compat-version): New.
+
+2002-11-22 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(smiley): Smileys are a very small module, now.
+
+2002-11-22 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el:
+ erc-event-to-hook, erc-event-to-hook-name: eval-and-compile these,
+ since we need them in a macro. ERC now compiles again!
+
+ * erc-speak.el:
+ erc-minibuffer-privmsg: Removed setting this variable to nil, since it
+ was removed from erc.el.
+
+ * erc.el(erc-interactive-input-map): Added docstring.
+ (erc-wash-quit-reason): Extended docstring.
+ (erc-server-ERROR): Added docstring.
+ (erc-server-321): buffer-local variable channel-list probably
+ shouldn't be renamed erc-channel-list - removed FIXME.
+
+ * erc.el: small cleanup.
+ ("was not used anymore" here means "not used in erc/*.el nor in
+ fsbot", thanks to deego for checking that.)
+
+ erc-minibuffer-privmsg: Removed (was not used anymore)
+ (erc-reformat-command): Removed (was not used anymore)
+ (erc-strip-erc-parsed-property): Removed (was not used anymore)
+ (erc-process-ctcp-response): Removed (replaced by ctcp-query-XXX-hook)
+ (erc-send-paragraph): Removed ("Note that this function is obsolete,
+ erc-send-current-line handles multiline input.")
+ (erc-input-hook): Removed ("This hook is obsolete. See
+ `erc-send-pre-hook', `erc-send-modify-hook' and
+ `erc-send-post-hook' instead.")
+ (erc-message-hook): Removed ("This hook is obsolete. See
+ `erc-server-PRIVMSG-hook' and `erc-server-NOTICE-hook'.")
+ (erc-cmd-default-channel): Removed ("FIXME: no clue what this is
+ supposed to do." - it was supposed to prepend the default channel
+ to a command before sending it. E.g. typing "/FOO now!" would send
+ the IRC command "FOO #mycurrentchannel now!")
+
+ * erc.el:
+ erc-ctcp-query-PING: Send the whole argument back, not just the first
+ number. This is required for many clients (e.g. irssi, BitchX, ...)
+ which send their ping times in two different numbers for microsecond
+ accuracy.
+
+2002-11-22 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-track-shorten-function): Allow nil.
+
+2002-11-21 Alex Schroeder <alex@gnu.org>
+
+ * erc-track.el(erc-unique-channel-names): Fixed bug that appeared
+ if one target name was a substring of another -- eg. #hurd and
+ #hurd-bunny. Added appropriate test.
+
+2002-11-20 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el:
+ erc-unique-channel-names: Don't take a substring of channel that could
+ be longer than the channel, but at most (min (length candidate)
+ (length channel). (thanks to deego for noticing this)
+
+2002-11-19 Mario Lang <mlang@delysid.org>
+
+ * erc-notify.el: * (require pcomplete): Only when compiling.
+
+2002-11-19 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el:
+ erc-track-faces-priority-list: New variable, defines what faces will
+ be shown in the modeline. If set to nil, the old behavior ("all")
+ remains.
+ erc-track-face-more-important-p: new function
+ erc-track-find-face: new function
+
+2002-11-19 Alex Schroeder <alex@gnu.org>
+
+ * erc-fill.el(erc-stamp): Require it.
+
+ * erc-match.el(away): devar for the compiler.
+
+ * erc-stamp.el(stamp): Moved.
+
+ * erc.el(erc-version-string): New version.
+
+ * erc-autoaway.el(erc-autoaway-idletimer): Moved to the front of
+ the file.
+
+ * erc-auto.in: (generated-autoload-file, command-line-args-left):
+ Added defvar without value to silence byte compiler.
+
+ * Makefile(realclean): renamed fullclean to realclean.
+ (UNCOMPILED): New list, for erc-bbdb.el, erc-ibuffer.el,
+ erc-speak.el.
+ (SOURCE): Do not compile UNCOMPILED.
+ (release): New target.
+ (ChangeLog): New target.
+ (todo): New target.
+
+ * erc-complete.el(erc-match): Require it.
+ (hippie-exp): Require it.
+
+ * erc-ezbounce.el(erc): Require it.
+
+ * erc-imenu.el(imenu): Require it.
+
+ * erc-nickserv.el(erc-networks): Moved up.
+
+ * erc-notify.el(pcomplete): Require it.
+
+ * erc-replace.el(erc): Require it.
+
+ * erc-sound.el(sound): Typo -- define-key in erc-mode-map.
+
+ * erc-speedbar.el(dframe): Require it.
+ (speedbar): Require it.
+
+ * erc-track.el(erc-default-recipients): devar for the compiler.
+
+ * README: New file.
+
+2002-11-18 Mario Lang <mlang@delysid.org>
+
+ * AUTHORS: File needed for mkChangeLog
+
+ * mkChangeLog: Original code by mhp
+
+2002-11-18 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-button-list): Renamed to erc-list and moved
+ to erc.el.
+
+ * erc.el(erc-list): New.
+
+ * erc-track.el(erc-make-mode-line-buffer-name): Simplified.
+ (erc-modified-channels-display): Simplified. Now works with all
+ faces, and fixes the bug that when two faces where used (bold
+ erc-current-nick-face), then no faces was added.
+
+ * erc-track.el: Lots of new tests. Moved some defuns around in
+ the file.
+ (erc-all-channel-names): Renamed.
+ (erc-all-buffer-names): New name, now include query buffers as
+ well.
+ (erc-modified-channels-update-inside): New variable.
+ (erc-modified-channels-update): Use it to prevent running display
+ if already inside it. This prevented debugging of
+ `erc-modified-channels-display'.
+ (erc-make-mode-line-buffer-name): Moved.
+ (erc-track-shorten-names): Don't test using erc-channel-p as that
+ failed with query buffers.
+ (erc-unique-substrings): Move setq i + 1 to the end of the while
+ loop, so that start is used as a default value instead of start +
+ 1.
+
+2002-11-18 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el:
+ erc-unique-substrings: define this before using it in assert
+
+ * erc.el:
+ with-erc-channel-buffer: Define *before* using this macro. This
+ hopefully fixes a bug noted on IRC.
+
+ * erc-notify.el:
+ erc-notify-signon-hook, erc-notify-signoff-hook: New hooks. They're
+ even run when their name suggests!
+
+2002-11-18 Alex Schroeder <alex@gnu.org>
+
+ * erc-list.el: Typo.
+
+ * erc-speedbar.el: Whitespace only.
+
+ * erc.el(define-erc-module): Avoid defining an alias if name and
+ alias are the same.
+
+ * erc-ibuffer.el: URL
+
+ * erc-imenu.el(erc-imenu-version): New constant.
+
+ * erc-ibuffer.el(erc-ibuffer-version): New constant.
+
+ * erc-ibuffer.el: File header, comments.
+
+ * erc-fill.el(erc-fill-version): New constant.
+
+ * erc-ezbounce.el(erc-ezb-version): New constant.
+
+ * erc-complete.el(erc-complete-version): New constant.
+
+ * erc-chess.el(erc-chess-version): New constant.
+
+ * erc-chess.el: Whitespace only.
+
+ * erc-bbdb.el(erc-bbdb-version): Typo.
+
+ * erc-bbdb.el(erc-bbdb-version): New constant.
+ Lots of whitespace changes. Changes to the header.
+
+ * erc-track.el(erc-track-shorten-aggressively): Doc.
+ (erc-all-channel-names): New function.
+ (erc-unique-channel-names): New function.
+ (unique-substrings): Renamed.
+ (erc-unique-substrings): New name
+ (unique-substrings-1): Renamed.
+ (erc-unique-substring-1): New name. Added lots of tests.
+ (erc-track-shorten-names): Call erc-unique-channel-names instead
+
+ * erc-match.el(match): Rewrote a as module.
+
+2002-11-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-netsplit.el(erc-netsplit-version): New.
+ (netsplit): Defined as a module, replacing erc-netsplit-initialize
+ and erc-netsplit-destroy.
+
+2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-track.el(erc-track-switch-buffer):
+ define-erc-module defines erc-track-mode,
+ not erc-track-modified-channels-mode.
+
+ * erc.el:
+ Variables erc-play-sound, erc-sound-path, erc-default-sound,
+ erc-play-command, erc-ctcp-query-SOUND-hook and functions
+ erc-cmd-SOUND, erc-ctcp-query-SOUND, erc-play-sound, erc-toggle-sound
+ moved to erc-sound.el
+
+ Variables erc-page-function, erc-ctcp-query-PAGE-hook and function
+ erc-ctcp-query-PAGE moved to erc-page.el
+
+ * erc-page.el:
+ erc-page.el: New file. CTCP PAGE support for ERC, extracted from erc.el.
+
+ * erc-sound.el:
+ defin-erc-module: Typo. Autoload should do erc-sound-mode and "erc-sound".
+
+ * erc-sound.el:
+ erc-sound.el: New file. Contains all the CTCP SOUND stuff from erc.el.
+
+ * erc.el(erc-process-ctcp-request):
+ Removed (old-style CTCP handling)
+ (erc-join-autogreet): Removed (was broken anyways)
+
+2002-11-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-button-version): New constant.
+
+ * erc-button.el(button): rewrote as a module.
+
+2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: New functions:
+ (erc-event-to-hook), (erc-event-to-hook-name): Convert an event to the
+ corresponding hook. The latter only returns the name, while the former
+ interns the hook symbol and returns it.
+
+2002-11-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-replace.el:
+ Practically total rewrite. All smiley stuff deleted.
+
+ * erc-track.el(track): typo.
+
+ * erc.el(define-erc-module): Doc change.
+
+2002-11-17 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-autoaway.el: Changed to use define-erc-module.
+
+ * erc.el(define-erc-module):
+ Make the enable/disable functions interactive.
+
+ * erc.el(erc):
+ Don't use switch-to-buffer when we're in the minibuffer,
+ because that does not work. Use display-buffer instead. This leaves
+ two problems: The point does not advance to the end of the buffer for
+ whatever reason, and after leaving the minibuffer, the new window gets
+ buried.
+
+2002-11-17 Alex Schroeder <alex@gnu.org>
+
+ * erc-stamp.el(stamp): Doc change.
+
+ * erc-stamp.el(erc-stamp-version): New constant.
+ (stamp): downcase alias name of the mode.
+
+ * erc.el(define-erc-module): Added defalias option, renamed
+ parameters again.
+
+ * erc-track.el: erc-track-modified-channels-mode is now only an
+ alias to erc-track-mode. Only erc-track-mode is autoloaded.
+ (track): Rewrote call to define-erc-module.
+
+2002-11-16 Mario Lang <mlang@delysid.org>
+
+ * debian/README.Debian: * Spelling fix
+
+ * erc-fill.el: * Fix autoload definition for erc-fill-mode
+
+ * debian/control, debian/maint/postinst, debian/maint/prerm:
+ * Remove /usr/doc -> /usr/share/doc link handling
+
+ * debian/changelog: * Sync with reality
+
+ * debian/scripts/startup.erc:
+ * Add /usr/share/emacs/site-lisp/erc/ to load-path
+ * (load "erc-auto")
+
+ * debian/README.Debian:
+ * Info about the changes since last release updated
+
+ * erc-pcomplete.el: * Fix emacs/xemacs compatibility
+
+ * debian/scripts/install: * Don't compile erc-compat, fix ELCDIR
+
+ * debian/control: * Change maintainer field
+
+ * erc.el:
+ * (defin-erc-module): Renamed argument mode-name to mname because silly byte-compiler thought we were talking about `mode-name'.
+
+ * Makefile: * Added debrelease target
+
+ * erc-bbdb.el, erc-pcomplete.el, erc-stamp.el, erc.el:
+ * (define-erc-module): Added mode-name argument.
+ * Converted erc-bbdb, erc-pcomplete and erc-stamp to new macro.
+ * autoload fixes
+
+ * erc-bbdb.el:
+ * Create a global-minor-mode (i.e., make it a proper erc-module)
+
+ * erc.el: * (define-erc-module): New defmacro
+
+2002-11-16 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-autoaway.el(erc-autoaway-idle-seconds):
+ t in docstrings should be non-nil
+
+2002-11-16 Alex Schroeder <alex@gnu.org>
+
+ * erc-autoaway.el, erc-button.el, erc-fill.el, erc-match.el,
+ erc-menu.el, erc-ring.el, erc-track.el:
+ Cleanup of file headers: copyright years, GPL mumbo-jumbo, commentaries.
+
+ * erc-stamp.el(erc-insert-away-timestamp-function):
+ New custom type.
+ (erc-insert-timestamp-function): New custom type.
+
+ * erc-fill.el(erc-fill-function): Doc, new custom type.
+ (erc-fill-static): Doc.
+ (erc-fill-enable): New function.
+ (erc-fill-disable): New function.
+ (erc-fill-mode): New function.
+
+ * erc-match.el(erc-match-enable): add-hook for both
+ erc-insert-modify-hook and erc-send-modify-hook.
+ (erc-match-disable): remove-hook for both
+ erc-insert-modify-hook and erc-send-modify-hook.
+
+2002-11-15 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc-autoaway.el:
+ - Added a way to use auto-away using emacs idle timers
+ - Renamed erc-set-autoaway to erc-autoaway-possibly-set-away for consistency
+
+2002-11-14 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el: erc-mode-map: Removed the C-c C-g binding for erc-grab
+
+ * erc.el:
+ (erc-server-341) Another instance of the channel/chnl problem i didn't
+ see last time
+
+2002-11-14 Alex Schroeder <alex@gnu.org>
+
+ * erc-compat.el(erc-decode-coding-string): typo
+
+2002-11-14 Jorgen Schaefer <forcer@users.sourceforge.net>
+
+ * erc.el(erc-server-341):
+ variable name should be chnl not channel, as it is
+ used this way in this function, and the other erc-server-[0-9]* use
+ chnl too.
+
+ * erc-autoaway.el:
+ Set back on all servers, not just the current one, since we're set
+ away on all servers as well.
+
+ * HISTORY: Fixed typo (ngu.org => gnu.org)
+
+ * erc-autoaway.el, erc-fill.el, erc.el: erc-autoaway.el:
+ * new file
+
+ * erc.el: Removed auto-discard-away facility (now included in
+ erc-autoaway.el)
+ (erc-away-p): new function
+
+ * erc-fill.el (erc-fill-variable): Check whether erc-timestamp-format
+ is bound before using it (erc-fill.el does not require erc-stamp).
+
+2002-11-10 Alex Schroeder <alex@gnu.org>
+
+ * TODO:
+ TODO: moved it to http://www.emacswiki.org/cgi-bin/wiki.pl?ErcTODO
+
+ * erc.el(with-erc-channel-buffer): Rudimentary doc string.
+
+2002-11-09 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-nick-popup-alist): Made a defcustom.
+
+ * erc-button.el(erc-button-disable): New function.
+ (erc-button-enable): New function, replaces the add-hook calls at top-level.
+ (erc-button-mode): New minor mode.
+
+2002-11-08 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-button-entry): Use erc-button-syntax-table.
+
+ * erc.el, erc-stamp.el: Doc changes.
+
+ * erc-match.el(erc-match-mode): New function, replacing the
+ add-hook.
+ (erc-match-enable): New function.
+ (erc-match-disable): New function.
+ (erc-current-nick-highlight-type): Changed from 'nickname to 'nick
+ to make it consistent with the others.
+ (erc-match-message): Ditto.
+
+ * erc-button.el(erc-button-syntax-table): New variable.
+ (erc-button-add-buttons): Use it.
+
+2002-11-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ 1) (bug) ERC pops up a new buffer and window when being messaged
+ from an ignored person. fixed
+ 2) (misfeature) ERC notices the user in the minibuffer when it
+ ignores something - this can get very annoying, since the
+ minibuffer is also visible when not looking at ERC buffers.
+ Added a customizable variable for this, the default is nil.
+ 3) (wishlist) There is no IGNORE or UNIGNORE command.
+ Added.
+ 4) (wishlist) Some IRC clients, notably irssi, allow the user to
+ ignore "replies" to ignored people. A reply is defined as a
+ line starting with "nick:", where nick is the nick of an
+ ignored person. Added that functionality.
+ Done by Jorgen Schaefer <forcer@forcix.cx>
+
+2002-11-02 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-connect): set-process-coding-system to raw-text.
+
+2002-11-01 Brian P Templeton <bpt@tunes.org>
+
+ * erc-pcomplete.el, erc-stamp.el, erc-track.el:
+ Fixed more autoloads
+
+ * erc-compat.el: Added autoload for erc-define-minor-mode
+
+2002-11-01 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * (erc-send-command): will break long messages into
+ a bunch of smaller ones, to prevent them from being truncated by the server.
+ The patch also axes some trailing whitespace. :-) <resolve>
+
+2002-10-31 Alex Schroeder <alex@gnu.org>
+
+ * erc-pcomplete.el(erc-compat): Require.
+ (erc-completion-mode): Use erc-define-minor-mode.
+
+ * erc-track.el(erc-compat): Require.
+ (erc-track-modified-channels-mode): Use erc-define-minor-mode.
+
+ * erc-stamp.el(erc-compat): Require.
+ (erc-timestamp-mode): Use erc-define-minor-mode.
+
+ * erc-compat.el: New file with the code for erc-define-minor-mode,
+ erc-encode-coding-string and erc-decode-coding-string. Essentially
+ all the stuff that cannot be tested for using a simple boundp or
+ fboundp -- eg. because the number of arguments are wrong.
+
+ * erc.el(erc-compat): Require.
+ (erc-process-coding-system): Moved to erc-compat.el.
+ (erc-connect): Do not set-process-coding-system.
+ (encode-coding-string): Compatibility code moved to erc-compat.el.
+ (decode-coding-string): Compatibility code moved to erc-compat.el.
+ (erc-encode-coding-string): Compatibility code moved to erc-compat.el.
+ (erc-decode-coding-string): Compatibility code moved to erc-compat.el.
+
+2002-10-27 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-display-line-1): Removed call to
+ erc-decode-coding-string.
+ (erc-parse-line-from-server): Added call to
+ erc-decode-coding-string before anything gets parsed at all.
+ (erc-decode-coding-string): Use undecided coding system.
+
+2002-10-24 Sandra Jean Chua <sacha@free.net.ph>
+
+ * erc-button.el, erc.el:
+ Added LASTLOG command and action for nick-button
+
+2002-10-22 Sandra Jean Chua <sacha@free.net.ph>
+
+ * erc-pcomplete.el:
+ Fixed nopruning bug, added /MODE channel (mode) [nicks...] completion - mode not completed yet.
+
+2002-10-16 Sandra Jean Chua <sacha@free.net.ph>
+
+ * erc-pcomplete.el:
+ Fixed 'Hi delysid:' bug in SAY completion after realizing that pcomplete on commands already took care of completing the initial nick:
+
+2002-10-15 Mario Lang <mlang@delysid.org>
+
+ * erc-pcomplete.el: update from sachac
+
+2002-10-13 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-emacs-time-to-erc-time): Catch when tm is nil.
+
+2002-10-11 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * Fixed `erc-scroll-to-bottom' to scroll to the bottom even when
+ in the middle of a line. Might also fix the Magic ECHAN Bug[tm]. (-:
+
+2002-10-11 Mario Lang <mlang@delysid.org>
+
+ * erc-nickserv.el: Fixed erc-networks for the opn->freenode change
+
+2002-10-08 Mario Lang <mlang@delysid.org>
+
+ * erc-pcomplete.el:
+ Make erc-completion-mode work interactively with already joined channel buffers
+
+ * erc-chess.el: Add autoload cookies
+
+ * erc-notify.el: Add pcomplete support
+
+ * erc.el:
+ Remove autoload statements, remove autoload cookie from erc-mode and erc-info-mode
+
+ * erc-fill.el, erc-match.el: add/remove autoload cookies
+
+2002-10-06 Alex Schroeder <alex@gnu.org>
+
+ * erc-pcomplete.el(erc-completion-mode): New global minor mode
+ with autoload cookie.
+ (erc-pcomplete-enable): Renamed erc-pcomplete-initialize.
+ (erc-pcomplete-disable): New function.
+
+ * erc-complete.el: Doc changes.
+
+ * erc-stamp.el(erc-stamp-enable): Renamed erc-stamp-initialize.
+ (erc-stamp-disable): Renamed erc-stamp-destroy.
+ (erc-timestamp-mode): Use new names.
+
+ * erc.el: Removed autoload for erc-complete and
+ erc-track-modified-channels-mode -- the autoload cookie should do
+ that instead.
+ (erc-input-message): Doc string, removed binding for erc-complete.
+ (erc-mode-map): Removed binding for erc-complete.
+
+2002-10-03 Mario Lang <mlang@delysid.org>
+
+ * erc-notify.el:
+ New functions erc-notify-JOIN and erc-notify-QUIT to catch some common cases (warning, untested)
+
+2002-10-01 Alex Schroeder <alex@gnu.org>
+
+ * erc-stamp.el(erc-timestamp-mode): New function. Removed call
+ to erc-stamp-initialize at the end.
+
+2002-09-25 Brian P Templeton <bpt@tunes.org>
+
+ * erc.el:
+ Added customizable `erc-process-coding-system' variable.
+
+2002-09-22 Brian P Templeton <bpt@tunes.org>
+
+ * erc-fill.el:
+ `erc-fill-variable' now does the right thing when `erc-hide-timestamps' is non-nil
+
+2002-09-21 Mario Lang <mlang@delysid.org>
+
+ * erc-fill.el:
+ patch from Peter Solodov <peter@alcor.concordia.ca> (note, its slightly broken still
+
+2002-09-05 Mario Lang <mlang@delysid.org>
+
+ * erc-pcomplete.el: Added LEAVE as alias for PART
+
+2002-09-04 Mario Lang <mlang@delysid.org>
+
+ * erc-pcomplete.el:
+ By sachac (good work!) keep up doing such things
+
+2002-08-31 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ A fix for Bug#133267: now you can put (erc-save-buffer-in-logs) on erc-insert-post-hook to save *every* incoming message.
+
+2002-08-30 Brian P Templeton <bpt@tunes.org>
+
+ * erc.el:
+ Changed default value of erc-common-server-suffixes because of the OPN
+ name change
+
+2002-08-28 Mario Lang <mlang@delysid.org>
+
+ * erc-stamp.el: Try to reactivate isearch in xemacs
+
+ * erc-stamp.el:
+ fixes issues related to comparative emacsology and a silly bug
+
+2002-08-27 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ New hook erc-send-completed-hook (for robot stuff), changed alexanders email address to reflect reality, little fix to erc-auto-query to get a bit of a speedup
+
+2002-08-22 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el:
+ Fixed case-fold-search (thanks sachac), now lambda works in erc-button-alist, added wardwiki+google+symvar+rfc+itime regexps from the wiki
+
+2002-08-19 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el:
+ erc-nick-popup-alist: New variable to make erc-nick-popup configurable
+
+2002-08-16 Alex Schroeder <alex@gnu.org>
+
+ * erc-button.el(erc-recompute-nick-regexp): Fixed regexp.
+
+ * erc-button.el(erc-button-buttonize-nicks): Changed custom type
+ to integer.
+ (erc-button-add-buttons): Moved button removal code to new
+ function.
+ (erc-button-remove-old-buttons): New function.
+ (erc-button-add-button): Removed use of overlays and used
+ erc-button-add-face instead.
+ (erc-button-add-face): New function to merge faces as text
+ properties. This should be much faster when lots of buttons
+ appear.
+ (erc-button-list): New helper function.
+
+ * erc.el(erc-display-message): Fixed argument list.
+ (erc-display-prompt): Reduced calls to length, use start-open
+ property for XEmacs to prevent a little box of erc-prompt-face at
+ the end of messages other people send.
+ (erc-refresh-channel-members): Fix XEmacs calls to split-string,
+ which may return an empty string at the end of the list. This
+ would cause hangups in erc-button in re-search-forward loops.
+ (erc-get-channel-mode-from-keypress): Replaced control codes with
+ octal escape sequences.
+
+2002-08-14 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el:
+ Try to be compatible to XEmacs regexp-opt. (Im going to quit this job if I find more of those damn differencies
+
+ * debian/README.Debian, debian/scripts/install:
+ * Added info to README.Debian
+ * Finished debian/scripts/install
+
+2002-08-13 Mario Lang <mlang@delysid.org>
+
+ * debian/scripts/install: First attempt to fix it
+
+ * debian/README.Debian, debian/changelog, debian/scripts/install:
+ changelog: Changed maintainer and added new entry
+ README.Debian: Re-explained the byte-compile issue
+ scripts/install: Exclude erc-bbdb|chess|ibuffer|speedbar from
+ byte-compiling
+
+ * erc-track.el: Added C-c C-SPC in addition to C-c C-@
+
+ * erc-notify.el: Little docstring change
+
+2002-08-09 Mario Lang <mlang@delysid.org>
+
+ * erc-stamp.el:
+ Change one use of set-text-properties to add-text-properties (tnx Lathi)
+
+2002-08-02 Mario Lang <mlang@delysid.org>
+
+ * erc-stamp.el: added erc-timestamp-only-if-changed-flag
+
+2002-07-22 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Removed timestamp related code and moved into erc-stamp.el
+
+ * erc-stamp.el:
+ Timestamping code moved out of erc.el. Additional, now we can timestamp either on the left or on the right side
+
+2002-07-16 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Make ctcp ping return its message in the active buffer, instead of the server buffer
+ * Corrected minimal typo in catalog
+ * Added var and variable as alias for /set
+
+2002-07-08 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el:
+ * New function erc-track-switch-buffer (by resolve)
+ Bound to C-c C-SPC, enjoy!
+
+2002-07-08 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: New snapshot deb
+
+ * debian/scripts/install: Rewrote in make.
+ Does not byte-compile erc-speak.el at all, and excludes erc-track.el too, if
+ ran for xemacs.
+
+ * debian/control: Added dependency on make
+
+ * debian/copyright: Updated copyright info
+
+ * debian/rules: Use $(wildcard *.el) instead of a hardcoded list
+
+2002-07-03 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ erc-iswitchb now works correctly if erc-modified-channels-alist is non-nil
+
+2002-07-01 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el:
+ * changed how we check if we should activate "Track hidden channels" and
+ whether it should be selected - fixes a bug XEmacs where whole menu bar
+ does not work if menu is loaded
+
+ * erc-menu.el:
+ * added "Disconnect from server", only selectable if erc-connected is non-nil
+
+ * topic is allowed to be set by normal users if channel mode is not +t
+
+ * add " ..." after description if arguments needed after selecting menu item
+
+ * only allow selecting of menu points needing a channel if current buffer is
+ a channel buffer - done by testing if channel-members is non-nil
+
+ * put erc-match functions in new group "Pals, fools and other keywords"
+
+ * erc.el:
+ * moved definition of erc-show-my-nick to GUI variables section
+
+ * erc-connected variable now defined with defvar
+ now set in channel and query buffers, was only in server buffer before
+ upon disconnect, set erc-connected to nil in all the server's buffers
+
+ * added erc-cmd-GQUIT and its alias erc-cmd-GQ - quit all servers at once
+
+ * added interactive function erc-quit-server, bound to C-c C-q
+
+ * added erc-server-WALLOPS
+
+ * added WALLOPS to english catalog, fixed s461 (was showing message twice)
+
+ * typo fixes, spacing change
+
+2002-06-29 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Use pp-to-string in /set (without args)
+
+ * erc-netsplit.el:
+ Make /set anonymous-lign set erc-anonymous-login, also report
+ which var was set to which val.
+
+2002-06-28 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el: added "Customize ERC"
+
+2002-06-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el: New variable: erc-use-info-buffers, defaults to nil.
+ This prevents info-buffers from being created/updated.
+ Set to t if you use :INFO buffers.
+ (by rw)
+ Delete (erc-display-prompt) from reconnect to avoid clutter
+
+2002-06-23 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ erc-get-channel-mode-from-keypress is now bound to C-c C-m
+ erc-insert-mode-command is taken care of by this function as well
+
+2002-06-21 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el:
+ Fixed bug where buffer-names suddenly had text-properties.
+
+2002-06-19 Diane Murray <disumu@x3y2z1.net>
+
+ * Makefile: changed erc-auto.el to $(SPECIAL) in make fullclean
+
+ * Makefile: remove erc-auto.el on make fullclean
+
+2002-06-18 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-match.el: fixed spelling error
+
+ * erc-track.el, erc-match.el: * erc-match.el:
+ highlight current nickname in its own face (inactive by default):
+ - added erc-current-nick-highlight-type, erc-current-nick-face,
+ erc-current-nick-p
+
+ * erc-track.el:
+ added support for erc-current-nick-face
+
+2002-06-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: * added beginning support for 005 numerics:
+ - added buffer local variable erc-server-parameters
+ - added erc-server-005, which sets erc-server-parameters if the server has
+ used this code to show its parameters
+
+2002-06-16 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ * bugfix: when pasting lines with blank lines in between, remove the blank lines
+ but send the rest
+
+ * since we know the command, use it when checking what's in erc-hide-list
+ added check to erc-server-KICK
+
+ * added some blank lines for better readability
+
+2002-06-16 Alex Schroeder <alex@gnu.org>
+
+ * erc-nickserv.el(erc-nickserv-alist): Fixed typo.
+
+2002-06-15 Alex Schroeder <alex@gnu.org>
+
+ * erc-nickserv.el(erc-networks): Added doc string.
+ (erc-nickserv-alist): Added doc string.
+
+2002-06-14 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-ring.el:
+ fixed bug so that the prompt and command always get put at the end of the buffer
+
+2002-06-10 Mario Lang <mlang@delysid.org>
+
+ * erc-nickserv.el: Added iip support.
+ Added :type for erc-nickserv-passwords custom.
+ Fixed hook usage.
+
+2002-06-07 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nickserv.el: * added GalaxyNet
+
+ * erc-nickserv-alist:
+ - sorting networks alphabetically
+ - added two more pieces of information in erc-nickserv-alist:
+ word to use for identification and whether to use the nickname
+
+ * erc-current-network:
+ - made regex case insensitive, downcase server to match
+ - uses the new information
+ - now uses new variable erc-networks instead of doing checking manually
+
+ * added variable erc-networks
+
+ * fixed some indentation, documentation
+
+2002-06-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Fix for kill-buffer hook stuff
+
+2002-06-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Added /squery command
+
+2002-06-06 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-menu.el: * made group Channel modes
+ - moved change mode and invite only mode to here
+ - added secret, moderated, no external send, topic lock, limit, key
+
+ * check that user is in a channel buffer and user is a channel operator
+ for all op-related actions
+
+ * "Identify to nickserv" needs erc-nickserv-identify defined
+
+ * added "Show ERC version"
+
+ * erc.el:
+ * added erc-set-channel-limit, erc-set-channel-key, erc-toggle-channel-mode
+
+ * added erc-get-channel-mode-from-keypress, which is bound to C-c m
+ sends the next character which is typed to one of the 3 new functions
+ - did not remove erc-invite-only-mode and it's key binding in case
+ people are used to it, although it probably should be removed...
+
+ * in erc-server-MODE:
+ added check if tgt equal to user's nick
+ removed erc-display-line, only using the erc-display-message
+
+ * added s461 to english catalog
+
+ * fixed bug where XEmacs would not quit if erc-quit-reason was
+ set to erc-quit-reason-various and assoc-default was not defined
+
+2002-06-04 Andreas Fuchs <asf@void.at>
+
+ * erc-ezbounce.el, erc-match.el:
+ * erc-ezbounce.el: Added. Provides support for ezbouncer; automatic login,
+ session management implemented. I've contacted the author
+ about stuff in EZBounce's logging.
+ * erc-match.el: Fixed a stupid mistake where
+ "*** Your new nick is <foo>" would trigger an error.
+
+2002-06-04 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-nickserv.el, erc.el: * added erc-nickserv.el
+ * moved nickserv identification variables and functions to the new file
+ (require 'erc-nickserv) is now necessary for this to work
+
+ * erc.el:
+ * results of /COUNTRY now formatted as notice; errors are ignored,
+ fixing
+ bug which made prompt disappear
+
+ * added undefined-ctcp error message to english catalog
+
+ * changed some (when (not erc-disable-ctcp-replies) to use unless instead
+ and some if's without else statements to use when or use
+
+ * CTCP replies now use erc-display-message, formatted as notices
+
+ * added following to english catalog:
+ - undefined-ctcp
+ - CTCP-CLIENTINFO, CTCP-ECHO, CTCP-FINGER, CTCP-PAGE, CTCP-PING,
+ CTCP-SOUND, CTCP-TIME, CTCP-UNKNOWN, CTCP-VERSION
+ - s303, s305, s306, s353
+
+ * split erc-server-305-or-306 into erc-server-305 and erc-server-306
+
+ * KICK already had buffer set, using it
+
+ * erc.el:
+ * erc-format-timestamp now only called from erc-display-message and
+ erc-send-current-line
+
+ * all instances of erc-display-line with erc-highlight-error
+ changed to use erc-display-message
+
+ * added following error messages to english catalog:
+ bad-ping-response, bad-syntax, cannot-find-file, cannot-read-file,
+ ctcp-request, flood-ctcp-off, flood-strict-mode, no-default-channel,
+ no-target, variable-not-bound
+
+ * added following server related messages to english catalog:
+ s324, s329, s331, s332, s333, s341, s406, KICK, KICK-you, KICK-by-you, MODE-nick
+
+ * ignoring server codes 315, 369
+
+ * added erc-server-341, erc-server-406
+
+ * channel topic and mode notices displayed in respective channel buffers if they
+ exist
+
+ * erc-server-KICK: display the message before removing this channel so that we
+ can track the kick
+
+ * send parsed to erc-ctcp-query-ACTION-hook so that actions can be checked
+ by erc-match
+
+ * fixed bug where nil was shown if no reason was given by users on /PART
+
+2002-06-03 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-match.el:
+ * fixed bug where erc-log-matches produced an error when the value of
+ (erc-default-target) was not a channel
+ * use erc-format-timestamp, if it's non-nil, for %t in erc-log-match-format
+
+2002-06-01 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-button.el:
+ * made action case insensitive in erc-nick-popup and added a more descriptive
+ error message
+
+2002-05-30 Brian P Templeton <bpt@tunes.org>
+
+ * erc.el:
+ Removed multiple calls of `erc-prompt' in `erc-display-prompt'
+
+2002-05-29 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ First step timestampkiller cleanup. I'm tired, do the rest tomorrow.
+
+ * erc.el:
+ New functionality: Catch channel/server buffer kills through kill-buffer-hook.
+ Currently, it only does a PART if you kill a channel buffer.
+
+2002-05-28 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ defvar'ed some buffer-local variables to make elint at least a bit more happy.
+ Moved comments into docstrings.
+ Changed some instances of member to memq.
+
+ * erc-track.el, erc.el:
+ * erc.el (erc-message-type-member): New function, used to test
+ for message type. Require erc-parsed text-property.
+ * erc-track.el (erc-track-exclude-types): New variable. Defaults
+ to ("JOIN" "PART") right now for testing, it should eventually set
+ to nil soon again.
+ (erc-track-modified-channels): Use above fun and var to optionally
+ exclude certain message types from channel tracking.
+
+2002-05-28 Diane Murray <disumu@x3y2z1.net>
+
+ * CREDITS: added myself, vain as it sounds ;)
+
+2002-05-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Some small docstring fixes
+ * (erc-display-line): Now takes also a process object in the buffer argument.
+ Used for easy sending to the server buffer.
+ * Several places: Just pass proc, not (process-buffer proc)
+
+2002-05-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Mostly docstring fixes/additions
+
+ * erc-netsplit.el: Doc fixes, and a new netjoin-done message.
+
+ * erc-fill.el: Doc fixes, erc-fill custom group, autoloads.
+
+ * erc-netsplit.el: Fix to erc-netsplit-timer.
+
+ * erc-netsplit.el: Fixed a silly typo
+
+ * erc-maint.el: is this really necessary?
+
+ * erc.el: Added new variable erc-hide-list.
+ It affects erc globally right now, and is used to hide certain IRC type messages like JOIN and PART.
+
+ * Makefile: Doh, I should really test this before checkin :)
+
+ * Makefile: Silly cut&paste bug fixed
+
+ * erc-list.el: Added autoload cookie
+
+ * erc-match.el: Added missing require erc.
+
+ * erc-notify.el: Autoload cookies and a -initialize function.
+
+ * erc-chess.el: Added autoload cookies
+
+ * Makefile: Finally, we have a Makefile.
+ Primarily used for autoload definition generation right now.
+
+ * erc-auto.in: First version.
+
+ * erc-track.el: Added autoload cookie
+
+ * erc-netsplit.el:
+ New module, used to autodetect and hide netsplits.
+ (Untested, no netsplit happened yet :) )
+
+ * erc-nets.el: Added some old code I once worked on.
+ Added autoload cookie
+
+2002-05-24 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-fill.el:
+ removed reference in documentation to old variable, changed it to the new one
+
+ * erc.el:
+ * added new function erc-connection-established which is called after receiving
+ end of MOTD (does nothing if it's been called before)
+
+ * added new hook erc-after-connect which is called from
+ erc-connection-established with the arguments server (the announced server)
+ and nick - which other arguments should be sent??
+
+ * added buffer variable erc-connected which is set to t the first time
+ erc-connection-established is called, set to nil again if we've been
+ disconnected
+
+ * set initial user mode
+ - added custom variable erc-user-mode which can be a string or a function
+ which returns a string
+ - new function erc-set-initial-user-mode gets called from
+ erc-connection-established
+
+2002-05-22 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el: fixed bug where prompt was missing after reconnect
+
+2002-05-21 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ in erc-nickserv-identify: if network is unknown, just use "Nickserv"
+
+ * erc.el: * fixed some typos
+
+ * timestamping
+ - ctcp request messages and replies now have timestamp
+ - timestamps in front of error messages now in timestamp face
+ - added timestamp to more error messages
+
+ * ctcp reply messages, server ping message updated
+
+ * added variable erc-verbose-server-ping - check this instead of erc-paranoid
+
+ * added whowas on no such nick:
+ - added variable erc-whowas-on-nosuchnick
+ - in erc-server-401 do WHOWAS if erc-whowas-on-nosuchnick is non-nil
+
+ * erc.el: forgot documentation for erc-nickserv-alist
+
+ * erc.el: NickServ identification changed and enhanced:
+ - erc-nickserv-identify-autodetect now called from erc-server-NOTICE-hook
+ - now possible to identify automatically without prompt:
+ - added custom variables erc-prompt-for-nickserv-password and
+ erc-nickserv-passwords
+ - added erc-nickserv-alist containing the different networks' nickserv details
+ - added function erc-current-network to determine the network symbol
+ - fixed bug where identification on dalnet didn't work, because they now
+ require NickServ@services.dal.net
+ now sends to all NickServ with nick@server where possible
+
+2002-05-17 Diane Murray <disumu@x3y2z1.net>
+
+ * erc-fill.el:
+ * filling with erc-fill-variable now works with custom defined fill width:
+ - changed erc-fill-column from defvar to defcustom
+ - in erc-fill-variable: set fill-column to value of erc-fill-column
+
+ * erc.el: erc.el:
+ * fixed bug where topic wasn't being set when channel name was provided
+
+ erc-fill.el:
+ * filling with erc-fill-variable now works with custom defined fill width:
+ - changed erc-fill-column from defvar to defcustom
+ - in erc-fill-variable: set fill-column to value of erc-fill-column
+
+2002-05-16 John Wiegley <johnw@gnu.org>
+
+ * erc.el: whitespace fix
+
+2002-05-15 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ * added explanation of empty string working in erc-quit-reason-various-alist
+ * removed the text property from erc-send-message, it caused problems
+ with /SV (as noticed by gbvb on IRC) and is obviously not needed
+ * when receiving a ctcp query, convert type to uppercase to allow for
+ "/ctcp nick time" and not just "/ctcp nick TIME"
+ * timestamp in front of server notices now shown in the timestamp face
+
+2002-05-13 Diane Murray <disumu@x3y2z1.net>
+
+ * erc.el:
+ - in erc-format-privmessage: `erc-format-timestamp' added to message after
+ message's text properties are applied so that it doesn't lose its face
+
+ - /quit without reason now works when `erc-quit-reason' is set to
+ `erc-quit-reason-various' and the empty string "" is defined in
+ `erc-quit-reason-various-alist'
+
+2002-05-13 Andreas Fuchs <asf@void.at>
+
+ * erc-bbdb.el:
+ * Applied Drewies patch to pop-up on nick changes when -popup-type is 'visible
+
+2002-05-12 Andreas Fuchs <asf@void.at>
+
+ * erc-bbdb.el, erc.el:
+ * erc-bbdb.el: pop up the buffer on /whois when erc-bbdb-popup-type is 'visible
+ * erc.el: fix for empty quit reason problem by drewie.
+
+2002-05-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el: disumu nick patch
+ - added erc-show-my-nick (default t)
+ if t, show nickname like <nickname>
+ if nil, only show a > character before the message
+ - added faces erc-nick-default-face and erc-nick-msg-face
+ - nicknames (channel, msgs, notices) are now in bold face by default
+ - the msg face matches the erc-direct-msg-face color
+
+2002-05-10 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-send-pre-hook): Doc change.
+
+ * CREDITS: Alexander L. Belikoff is confirmed original author.
+
+2002-05-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ timestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumutimestamp fix by disumu
+
+2002-05-09 Mario Lang <mlang@delysid.org>
+
+ * erc.el: *** empty log message ***
+
+2002-05-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ New var: erc-echo-notices-in-minibuffer-flag. defaults to t.
+
+2002-05-04 John Wiegley <johnw@gnu.org>
+
+ * TODO: *** empty log message ***
+
+2002-05-03 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: Copyright notice, version string updates.
+
+2002-05-02 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: Comment: dme is David Edmondson
+
+2002-05-01 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-warn-about-blank-lines): New option.
+ (erc-send-current-line): Use it.
+ (erc-quit-reason-various-alist): New option.
+ (erc-quit-reason): New option.
+ (erc-quit-reason-normal): New function.
+ (erc-quit-reason-zippy): New function.
+ (erc-quit-reason-various): New function.
+ (erc-cmd-QUIT): Use them.
+
+2002-04-30 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: Version 2.92
+
+ * erc.el(erc-send-modify-hook): Default value is nil.
+
+2002-04-27 John Wiegley <johnw@gnu.org>
+
+ * erc.el:
+ Don't redisplay the prompt if the ERC buffer is no longer alive.
+
+2002-04-26 John Wiegley <johnw@gnu.org>
+
+ * erc.el:
+ Don't call `set-buffer' on old-buf unless the buffer is valid. It's
+ often not when separate frames are being used.
+
+2002-04-23 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el: fixed up erc-nick-regexp
+
+2002-04-22 Brian P Templeton <bpt@tunes.org>
+
+ * erc.el:
+ `erc-prompt' may now be a function that returns a string (which is
+ used as the prompt). I don't use Customize but I think customization
+ of it may be broken if it's not a string.
+
+ There is a new `erc-prompt' function that returns the prompt as a
+ string (e.g., returning either the result of `(funcall erc-prompt)' or
+ `erc-prompt').
+
+ This allows for dynamic prompts, such as a LispWorks-like prompt, or
+ one containing simply the current channel name. It was requested by
+ Mojo Nichols (nick michols) in #emacs today, 21-Apr-2002; cf. the
+ #emacs logs at <URL:http://www.tunes.org/~nef/logs/emacs/02.04.21.
+
+2002-04-17 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ fix erc-send-current-line to work on empty lines again (without sending the prompt)
+ Fix C-c C-t to not include the nick/time info
+ (both from antifuchs)
+
+ * erc-complete.el: Fix for xemacs elt behavior
+
+2002-04-17 John Wiegley <johnw@gnu.org>
+
+ * erc-chess.el:
+ Added a missing arg in a call to erc-chess-handler.
+
+2002-04-15 John Wiegley <johnw@gnu.org>
+
+ * erc-chess.el: *** empty log message ***
+
+2002-04-14 John Wiegley <johnw@gnu.org>
+
+ * erc-chess.el: *** empty log message ***
+
+2002-04-12 John Wiegley <johnw@gnu.org>
+
+ * erc-chess.el: *** empty log message ***
+
+ * erc-chess.el: bug fixes
+
+ * erc-chess.el: *** empty log message ***
+
+2002-04-12 Mario Lang <mlang@delysid.org>
+
+ * erc-chess.el: change order.
+
+ * erc-chess.el: more fixing.
+
+ Now, the 'match question works. It sends an accept back.
+ But display popup doesn't work..
+
+ * erc-chess.el: fixup (still far from working)
+
+2002-04-11 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Added :options entry for erc-mode-hook (erc-add-scroll-to-bottom)
+
+2002-04-11 John Wiegley <johnw@gnu.org>
+
+ * erc.el: remove trailing \n from any sent text
+
+ * servers.pl, erc-bbdb.el, erc-button.el, erc-chess.el,
+ erc-complete.el, erc-fill.el, erc-ibuffer.el, erc-list.el,
+ erc-match.el, erc-menu.el, erc-nets.el, erc-replace.el,
+ erc-speak.el, erc-speedbar.el, erc-track.el, erc.el:
+ clean whitespace
+
+ * erc.el: Replaced erc-scroll-to-bottom.
+
+2002-04-11 Mario Lang <mlang@delysid.org>
+
+ * erc-track.el:
+ try to fix behavior when used with different frames.
+
+2002-04-09 Mario Lang <mlang@delysid.org>
+
+ * erc-chess.el:
+ fixup release, far from ready for real usage, but it appears to work.
+
+ * erc.el:
+ speed improvements based on elp-instrument-package RET erc- RET results
+
+ * erc-chess.el: initial version.
+ please test it
+ Get chess.el from johnw's cvs:
+ cvs -d:pserver:anonymous@alice.dynodns.net:/usr/local/cvsroot login
+ cvs -d:pserver:anonymous@alice.dynodns.net:/usr/local/cvsroot co chess
+
+ (as usual, blank password)
+
+ Add the resulting dir to your load-path and require erc-chess.
+
+ Usage: Just do /chess nickname
+ The remote end much use erc, as no other irc client I know of supports this ...
+
+ See erc-chess-default-display and maybe set it to chess-images or chess-ics1 if you prefer those over chess-plain.
+ Also, see erc-chess-user-full-name to set the name you use in chess games.
+
+2002-04-04 Mario Lang <mlang@delysid.org>
+
+ * erc.el: New hackery latenightwise
+
+ * erc.el: upupadowndowncase
+
+2002-04-04 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: Updated for the new snapshot
+
+ * debian/rules: Install README.Debian into the package
+
+ * debian/README.Debian: Initial check-in
+
+2002-04-04 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fixed that /me in query buffers ended up in server buffer
+
+ * erc.el: * Implemented joining +k channels
+
+2002-03-14 Mario Lang <mlang@delysid.org>
+
+ * erc.el: New utility function: erc-channel-list
+ minor fix to erc-get-buffer. hopefully that helps shapr
+
+2002-03-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ New /command: /QUOTE for sending directly to the IRC server
+ Removed erc-fill from erc-insert-modify-hook. To activate filling, simply customize that var.
+
+2002-03-09 Brian P Templeton <bpt@tunes.org>
+
+ * CREDITS: *** empty log message ***
+
+2002-03-09 Mario Lang <mlang@delysid.org>
+
+ * erc-complete.el:
+ New variable: erc-nick-completion-ignore-case. Defaults to t.
+
+ * erc-track.el:
+ * erc-track-shorten-name-function can now be set to nil to avoid treating of channel names at all.
+
+2002-03-06 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog, debian/rules: update to new snapshot
+
+2002-03-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fixed nasty bug which prevented channel limit from correctly display/handling
+
+ * erc-track.el: Made shortening code highly customizable.
+ Now, there is the variable erc-track-shorten-function which holds
+ a function which gets called with one argument, CHANNEL-NAMES, which is a list
+ of strings of the channel names.
+ It needs to return a list of strings of the same length with the modified values...
+
+ * erc-track.el:
+ Added erc-track-shorten-aggressively, default to nil
+ if it is set to t, erc will shorten a bit more.
+ if nil, erc will shorten the name only if it would get shorter than just
+ one char...
+
+ * erc-speak.el: added iirc to the abbreviation expansion list.
+
+ * erc-track.el:
+ Added customization variable: erc-track-use-faces. defaults to t.
+
+ * erc-track.el: *** empty log message ***
+
+ * erc-track.el:
+ experimental: Added face support to mode-line channel activity tracker.
+ Currently we use the faces used for indicating in the buffer (erc-pal-face for channels with pal activity...)
+
+2002-03-05 Mario Lang <mlang@delysid.org>
+
+ * erc-complete.el: * added docfixes (thanks ore)
+
+ * erc-track.el: Fixed channel-name reduction.
+ thanks again alex.
+ Renamed the vars to erc-track-opt-start and erc-track-opt-cutoff.
+
+ * erc.el: fixed another silly error
+
+ * erc-track.el: Implemented channel name shortening.
+ Vars erc-track-cutoff says: all channel names longer than this will be shortened.
+ Var erc-track-minimum-channel-length says: don't make names shorten than this.
+ (Thanks go out to kensanata for the nice unique-substrings utility function).
+
+ * erc.el 2002-07-15T00:01:34Z!raeburn@raeburn.org: silly typo corrected
+
+ * erc.el: New variable: erc-common-server-name-suffixes
+ This alist can be used to change the server names displayed in mode-line
+ to a shorter version..
+ * New function: erc-shorten-server-name (uses var above)
+ * Changed erc-prepare-mode-line to use erc-shorten-server-name.
+
+2002-02-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ CTCP handling rewritten. Seems to work. please test and report probs.
+
+2002-02-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fixed emacs20 backward compatibility (new defun/alias: erc-propertize)
+
+2002-02-22 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el: *** empty log message ***
+
+2002-02-21 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el, erc.el:
+ minor fixup related to read-only prompts and command renaming.
+
+2002-02-21 Andreas Fuchs <asf@void.at>
+
+ * erc.el: * modify `erc-remove-text-properties-region' to work.
+ Could even be a little faster now. (-:
+
+2002-02-21 Mario Lang <mlang@delysid.org>
+
+ * erc-ring.el:
+ fixed erc-replace-command to behave right when text is read-only.
+ Also, use erc-insert-marker and (point-max) now.
+
+ * erc.el: * Made erc-prompt read-only
+ * new function: erc-make-read-only. Can be used on erc-insert-post-hook and erc-send-post-hook to ensure read-only buffer text too
+
+2002-02-19 Mario Lang <mlang@delysid.org>
+
+ * erc-list.el: added comment to docstring
+
+ * erc-speak.el: minor updates, use erc-nick-regexp now
+
+ * erc.el:
+ ensure that erc-timer-hook is called inside the server-buffer.
+
+2002-02-19 Andreas Fuchs <asf@void.at>
+
+ * erc-match.el:
+ * Probably fixed the "number-char-or-marker-p: nil" bug.
+
+2002-02-19 Mario Lang <mlang@delysid.org>
+
+ * erc-notify.el: Initial release.
+
+ * erc.el: added #303 handling
+ moved timer and added an arg (erc-current-time)
+
+ * erc-list.el, erc.el:
+ slightly changed the erc-once-with-server-event macro
+
+ * erc-button.el: erc-button-alist: doc fix and custom type fix
+
+2002-02-18 Mario Lang <mlang@delysid.org>
+
+ * erc-list.el, erc.el: new macro: erc-once-with-server-event
+ erc-list.el: use it
+
+ * erc-match.el:
+ Minor fix related to hook call method change (-until-seccess now)
+
+ * erc.el: fixed ctcp behavior abit (with auto-query on)
+
+ * erc-list.el: ChanList mode.
+ Load it, and type M-x erc-chanlist RET
+ Demonstrates how the new hook system can be nicely used.
+
+ * erc.el:
+ new hook: erc-default-server-hook. This one gets called if we don't have anything defined for a certain IRC server message.
+ New function: erc-default-server-handler. (used by above hook).
+ New function: erc-debug-missing-hooks: Used by above hook to save a list of unimplemented server messages.
+ New function: erc-server-buffer, erc-server-buffer-p.
+ Various places: use it.
+ Minor fixup.
+
+ * erc-button.el: fix regexp to not buttonize ~user@host hostnames
+
+2002-02-17 Mario Lang <mlang@delysid.org>
+
+ * erc-complete.el, erc.el: Eliminated erc-command-table
+ 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!)
+ e.g. /help auto-q
+ fixed autoloads for erc-add-pal and so on to be interactive.
+
+2002-02-17 Andreas Fuchs <asf@void.at>
+
+ * erc-match.el:
+ * Fix unfunctional code in `erc-get-parsed-vector-type'.
+
+ * erc-bbdb.el, erc-button.el, erc-match.el, erc.el:
+ * Be careful: MANY changes ahead. I won't go into too much details.
+
+ * erc.el, new file erc-match.el: split out all pattern-matching code.
+ * erc.el: removed all defcusts for erc-{...}-highlight-props. They are
+ quite useless, anyway.
+ * moved erc-add-entry-to-list and -remove- over to erc-match. changed
+ their arg list.
+ * erc.el: add autoloads for erc-{add,delete}-{keyword,pal,fool,dangerous-host}
+ * erc.el: erc-server-PRIVMSG-or-NOTICE:
+ - remove all the highlighting crap
+ - add a (when (eq s nil) ...) so that untreated CTCP messages don't
+ get misdisplayed.
+ * erc.el: erc-mark-message: removed this function, it's useless
+ * erc.el: minor bugfixes.
+
+ * erc-match.el: first checkin. This file now contains all the pattern
+ matching stuff. there is now another defcust group, erc-match,
+ containing all match related stuff (erc-keywords, ...)
+ * erc-match.el: added functionality to log matching lines. Quite
+ customizable, check out the docstring of defun erc-log-matches
+ * erc-match.el: added functionality to make foolish messages
+ invisible/intangible. This could replace erc-ignore-list
+ sometime. it's more powerful right now, anyway.
+ * erc-match.el erc-text-matched-hook: new hook. run when Text matches
+ anything (pal, fool, etc.).
+
+ * erc-button.el: Make nick buttonization customizable.
+ * erc-button.el: Give nick buttonization a lower priority so that it
+ does not break url buttons.
+
+ * erc-bbdb.el: Add \n to the separators by which we split nicknames.
+
+2002-02-17 Mario Lang <mlang@delysid.org>
+
+ * TODO: Added item
+
+2002-02-17 Brian P Templeton <bpt@tunes.org>
+
+ * CREDITS, erc.el: Added invisible timestamp support.
+
+2002-02-16 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog, debian/rules, debian/scripts/install:
+ updated to new snapshot
+
+2002-02-16 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fixed channel limit format overflow in mode-line display.
+ (Having to use floats if integers are to large is quite strange, isn't it?)
+
+ * TODO: TODO list created.
+ Add comments and expand it.
+
+ * erc.el:
+ Fixed bug in query buffer handling (only happend in mixed-case situations)
+
+ * erc.el: shapr checkdoc patch #1
+ massive docfixes! yay, keep going!
+
+2002-02-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el: various other fixes
+ make s301 a catalog entry
+
+2002-02-15 Andreas Fuchs <asf@void.at>
+
+ * erc.el: * erc-server-NICK and erc-server-INVITE: fixed to use
+ `erc-display-message'. These I missed in the first checkin. I
+ didn't say it in the last log message, but please test these.
+
+ * erc-fill.el, erc.el:
+ * erc.el: updated many functions to use `erc-display-message'. Now, we
+ should go for getting highlighting out of
+ erc-server-PRIVMSG-or-NOTICE. The part I want to attack has been
+ marked.
+ * erc-fill.el: updated static filling to leave the erc-parsed property alone.
+
+2002-02-15 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ first step, new function: erc-display-message
+
+ * erc.el: added numreply 379 and 405.
+
+ * erc.el: stupid typo fixed
+
+ * erc.el:
+ Finally renamed erc-frame-dedicated-p to erc-frame-dedicated-flag
+ Removed usage of erc-interpret-controls from info buffer drawing (major speedup)
+ Other speedups based on the results from elp.
+ ERC is now about 300%-500% faster in some situations with very full channels!!!!!
+
+2002-02-14 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * erc-downcase now downcases {}|^ with []\~ -- 'stolen' from zenirc.
+ * various checkdoc fixes. Just the upper third of the file, but that
+ should help a little, too. (-: Again, if you have any writing
+ skills, take out that dusty keyboard and tap it to the beat of M-x
+ checkdoc!
+
+2002-02-14 Gergely Nagy <algernon@debian.org>
+
+ * erc.el(erc-format-privmessage):
+ fix it, so timestamp-coloring works again (patch from antifuchs)
+
+2002-02-14 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Many fixes based on M-x checkdoc RET.
+ If you have write access, and some english knowledge, help document erc too!
+ M-x checkdoc RET, and follow the instructions.
+
+ * erc-button.el, erc-ibuffer.el: minor fixes
+
+ * erc.el: Use nreverse instead of reverse.
+ Use eq instead of equal where possible.
+ Rewrote erc-get-buffer to not use find-if (find-if does very deep function-call nesting, which isn't good in a defun which is called so often)
+
+2002-02-13 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el, erc.el:
+ In erc.el, new hook: erc-channel-members-changed-hook.
+ erc-button.el: Now highlight all nicknames. uses regexp-opt.
+
+2002-02-04 Mario Lang <mlang@delysid.org>
+
+ * erc-nets.el:
+ Database of irc networks. Use erc-server-select to interactively select one.
+
+ * erc.el: * erc-format-nick-function: New variable.
+ * (erc-format-nick): The default for above var. Just return the nick.
+ * (erc-format-@nick): Prefix NICK with @ or + if OP or VOICE.
+ * Removed erc-track-modified-channels related code and moved into erc-track.el
+ Its auto-loaded now
+
+ * erc-track.el: Split code from erc.el
+
+2002-02-01 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el:
+ * erc-target now uses erc-port-to-string
+
+ * servers.pl:
+ Script to convert mircs servers.ini to a elisp salist kind of thing.
+ (development tool, it doesn't help you much as a user)
+
+ * erc.el:
+ * erc-display-line-buffer: renamed to erc-display-line-1
+ * erc-port-equal: New function.
+ * erc-normalize-port: Used by erc-port-equal
+ * minor docstring fixes
+
+2002-02-01 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * erc-already-logged-in-p: compare ports is more robust now.
+
+ * erc-button.el: * Add buttonization to erc-send-modify-hook, too
+
+2002-01-31 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Use insert-before-markers instead of insert in erc-display-line-buffer
+ This fixed point@column 0 problem and gives us some speedup! yay
+
+ * erc-ibuffer.el, erc.el: minor fixes
+
+ * erc.el:
+ * (erc-line-beginning-position): Renamed to erc-beg-of-input-line.
+ * (erc-line-end-position): Renamed to erc-end-of-input-line.
+ * erc-multiline-input-p: Variable removed.
+
+ * erc.el:
+ Minor docstring fixes (using M-x checkdoc-current-buffer)
+ If you find time, and you are native english speaker, do that too!!
+
+ * erc.el: fixed macro-invocation
+
+2002-01-31 Andreas Fuchs <asf@void.at>
+
+ * erc.el: * erc-with-all-buffers-of-server: use erc-list-buffers
+ * erc-process-away, erc-{save,kill}-query-buffers: use it.
+ * erc-cmd-away-all: new command. Set away/back on all servers.
+
+ * erc.el:
+ * Fix last multiline bug in erc-send-distinguish-noncommands.
+
+2002-01-31 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el, erc.el: minor fixes
+
+2002-01-30 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el, erc-menu.el, erc-speak.el, erc.el:
+ Renamed erc-track-modified-channels-minor-mode to erc-track-modified-channels-mode (at least, its a bit shorter)
+ Added docstring to erc-server-hooks (through the macro)
+ Minor docfix in obsolete hook
+
+2002-01-30 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * erc-send-current-line: fix behavior where buffer changes.
+ * erc-mark-message: fix stupid face bug. highlighting of pals should work now.
+
+ * erc-ring.el, erc.el:
+ * new hooks: erc-send-pre-hook, erc-send-modify-hook, erc-send-post-hook
+ * erc-send-this: new variable
+ * erc-noncommands-list: new constant.
+ * erc-send-distinguish-noncommands: use it. (First filter function for sending! yay!)
+ * erc-send-current-line: nearly completely rewritten.
+ - now handles multiline input. (yay!)
+ - now uses the three hooks from above.
+ * erc-process-line: new arg, no-command: don't process this line as a command.
+
+2002-01-30 Mario Lang <mlang@delysid.org>
+
+ * erc-bbdb.el, erc-button.el, erc-speak.el, erc.el:
+ hook handling rewrite phase 1.
+
+2002-01-30 Andreas Fuchs <asf@void.at>
+
+ * erc.el: * Rework erc-server-PRIVMSG-or-NOTICE
+ * New function: erc-is-message-ctcp-p
+ * New function: erc-format-privmessage
+ * New function: erc-mark-message
+ * erc-server-PRIVMSG-or-NOTICE: use them.
+
+2002-01-30 Mario Lang <mlang@delysid.org>
+
+ * CREDITS, HISTORY:
+ Initial checkin.
+
+2002-01-29 Andreas Fuchs <asf@void.at>
+
+ * erc.el: * erc-put-text-properties: make OBJECT optional
+ * erc-put-text-property: same
+ * erc-server-PRIVMSG-or-NOTICE: use them.
+ * Make erc-display-line-buffer: add the "\n" even when the string would be invisible.
+ * same: make the \n invisible, too (:
+
+2002-01-29 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el, erc.el:
+ Rewrote channel tracking using window-configuration-change-hook instead of defadvices.
+
+2002-01-28 Andreas Fuchs <asf@void.at>
+
+ * erc-fill.el, erc.el:
+ * Macro define-erc-highlight-customization: Ease up defining
+ erc-{fool,pal,..}-highlight-props defcusts.
+ * defcusts:
+ - erc-fool-highlight-props
+ - erc-pal-highlight-props
+ - erc-dangerous-host-highlight-props
+ - erc-keyword-highlight-props
+
+ Customizable to either nil or "Hide message".
+ * erc-string-invisible-p: check for invisible chars in string
+ * erc-display-line-buffer: use it.
+ * erc-put-text-properties: put a list of props into a piece of text.
+ * erc-server-PRIVMSG-or-NOTICE: use it; set appropriate
+ highlight-props for entire incoming message. This set of changes
+ allows you to e.g. auto-ignore fools.
+
+2002-01-28 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el:
+ Added highlight detection support to the Mark column.
+ Now p, k, f, and d indicate pal, keyword, fool and dangerous-host related activity.
+
+ * erc.el:
+ Highlight tracking finished. All necessary info should now be in erc-modified-channels.
+
+ * erc.el, erc-ibuffer.el, erc-speedbar.el:
+ Added highlight tracking to track-modified-channels
+ no display code yet, the info is just kept in erc-modified-channels
+ Added erc-modified column to ibuffer
+ speedbar update
+
+ * erc-ibuffer.el: Added erc-members column
+
+ * erc-ibuffer.el: *** empty log message ***
+
+2002-01-28 Andreas Fuchs <asf@void.at>
+
+ * erc-bbdb.el:
+ * Fix a slight typo. The hook function should be called in
+ erc-server-376-hook (-:
+
+2002-01-28 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el: *** empty log message ***
+
+2002-01-27 Mario Lang <mlang@delysid.org>
+
+ * erc-ibuffer.el: Fixup, it sort of works now. Try it
+
+ * erc-ibuffer.el: Initial version
+
+2002-01-26 Mario Lang <mlang@delysid.org>
+
+ * erc.el: *** empty log message ***
+
+2002-01-25 Andreas Fuchs <asf@void.at>
+
+ * erc-bbdb.el: * fix two bad things:
+ - fix the "proc trick": pass proc as an arg through
+ ...-insinuate-... to ...-show-entry
+ - hook highlighting into the 376 hook. This one is bound to get
+ called (-:
+ * We now only append to hooks only.
+ * Highlighting of changing records gets updated automatically.
+
+2002-01-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el: *** empty log message ***
+
+2002-01-25 Andreas Fuchs <asf@void.at>
+
+ * erc-bbdb.el: * nearly complete rewrite of erc-bbdb:
+ - Removed code duplication in erc-bbdb-NICK and -JOIN.
+ - Made erc-bbdb-show-entry more general and intelligent.
+ - erc-bbdb-insinuate-entry is now erc-bbdb-insinuate-and-show-entry
+ (note the different arglist!):
+ - erc-search-name-and-create now creates "John Doe" users if name
+ is not specified.
+ - No sign of "mail" anywhere anymore. It's all finger-host. (-:
+ - erc-bbdb-popup-p is now called erc-bbdb-popup-type.
+ - New customize values:
+ . erc-bbdb-irc-channel-field channel field name
+ . erc-bbdb-irc-highlight-field (see below)
+ . erc-bbdb-auto-create-on-nick-p auto-create record on join
+
+ * Highlighting based on BBDB is now here! Specify which type of
+ highlighting a person in the BBDB (whose nick you know) and have
+ fun! Read help to erc-bbdb-init-highlighting for details. Changes:
+ - new function erc-bbdb-init-highlighting: gets called on server
+ connect.
+ - new function erc-bbdb-highlight-record: highlights a person's
+ nick names.
+
+2002-01-24 Andreas Fuchs <asf@void.at>
+
+ * erc-button.el:
+ * Fix the erc-button-alist regexp for EmacsWiki stuff. delYsid's version
+ is better (-:
+
+ * erc-button.el: * Added an Ewiki: specifier to the url-regexp.
+ <nickname> EmacsWiki: EmacsIRCClient tells you <bla>
+ should highlight "EmacsWiki: EmacsIRCClient" and allow you to
+ browse to the wiki when the button is activated.
+ * new custom: erc-emacswiki-url.
+ * new function: erc-browse-emacswiki: use it.
+
+2002-01-23 Mario Lang <mlang@delysid.org>
+
+ * erc-bbdb.el:
+ erc-bbdb-NICK: Added regexp-quote around fingerhost search.
+
+2002-01-10 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * Channel saving/killing on quit from server implemented:
+ - defcust erc-save-queries-on-quit: Save server's channel buffers on quitting from server
+ - defcust erc-kill-queries-on-quit: Kill server's channel buffers on quitting from server
+ - Macro erc-with-all-buffers-of-server: Run a form inside all the server's query buffers
+ - Functions erc-{kill,save}-query-buffers: use it.
+ * Added indent-tabs-mode: t to Local Variables section.
+
+2002-01-07 Andreas Fuchs <asf@void.at>
+
+ * erc-replace.el: * fix stupid documentation errors.
+
+2002-01-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (toplevel): Revert previous change. This resulted ina recursive load...
+ You have to put (require 'erc-button) into your .emacs for now
+
+2002-01-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Added require for erc-button. This is devel. so I need testers :)
+
+ * erc-button.el: * Added proper file headers (GPL).
+
+2002-01-04 Mario Lang <mlang@delysid.org>
+
+ * erc-button.el: * erc-button-alist: Added entry for finger
+
+ * erc-button.el: * Removed bogus usage of :button-keymap.
+ P
+ Does anyone know what this was supposed to do anyway?
+
+ * erc-button.el: * Initial version.
+ * This module allows a way of buttonizing text in IRC buffers.
+ Default it is used for URLs, but other things could be added.
+ see if you can find another use, erc-button-alist
+
+2001-12-18 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Added missing 747 numreply (banned)
+
+2001-12-15 Gergely Nagy <algernon@debian.org>
+
+ * debian/scripts/install, debian/rules:
+ updated to 2.1.cvs.20011215-1
+
+ * debian/changelog: Debian version 2.1.cvs.20011215-1
+
+2001-12-11 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * applied a nicer version of mhp's patch to remove the last prompt from
+ saved logs
+
+ * erc-replace.el: * Initial checkin
+
+2001-12-11 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * fixed bug triggered when reuse-buffer was enabled (the default).
+ Another silly port type problem. Maybe we should unify that once and for all sometimes...
+
+2001-12-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * erc-message-english: New QUIT and s004 entries.
+ * (erc-save-buffer-on-part): New variable.
+ * (erc-kill-buffer-on-part): New variable.
+ * (erc-server-PART): Use above variables.
+ * (erc-join-channel): Use DEF argument instead of initial input for completing-read.
+
+2001-12-08 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el: added defcustom erc-nick-uniquifier ^ (i prefer _)
+
+2001-12-07 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: changelog for version 2.1.cvs.20011208-1
+
+2001-12-07 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el:
+ Added erc-scroll-to-bottom as an erc-insert-hook function. It still bugs a bit, so please test it, thanks
+
+2001-12-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Fixed silly bug in erc-server-TOPIC (thanks mhp)
+
+ * erc-speak.el:
+ * Fix non-greedy matching bug. That one somehow swallowed text
+
+ * erc.el:
+ Fix Emacs20 problem. For now, we disable erc-track-modified-channels-minor-mode in emacs20
+
+2001-12-07 Andreas Fuchs <asf@void.at>
+
+ * erc-fill.el:
+ * Fix another stupid one-off error. This time it really works!
+ (Until I find the next bug. I guess you can hold your breath) (-:
+
+2001-12-06 Andreas Fuchs <asf@void.at>
+
+ * erc-fill.el: * Fixed static filling:
+ ** No more \ed (continued on next line) lines anymore
+ ** Fixed bug with previous version where longer lines wouldn't get
+ filled correctly (i.e. at all)
+
+2001-12-06 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: changelog for 2.1.cvs.20011206-1 added
+
+2001-12-06 Andreas Fuchs <asf@void.at>
+
+ * erc.el:
+ * Don't discard away status when identifying to NickServ
+ * Modify `erc-already-logged-in': check for port, too.
+
+ * erc-fill.el:
+ * Fix stupid loop non-termination error in erc-fill-static when filling
+ one-line regions.
+ * Make erc-count-lines return meaningful values
+
+2001-12-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-process-input): Make ' /command' work for quoting /commands
+
+ * erc-speak.el: see changelog
+
+ * erc-fill.el: see erc.el changelog
+
+ * erc.el:
+ * erc-insert-hook: Changed strategy completely, no start end parameters any more.
+ We narrow-to-region now, that's much cleaner.
+ * rename erc-fill-region to erc-fill and change the autoload
+ ** You'll probably need to restart Emacs
+
+2001-12-04 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-send-current-line): Fixed long outstanding bug. XEmacs users with erc-fill-region on erc-insert-hook knew that one a long time.
+
+ * erc.el: fix order of attack
+
+ * erc.el: * macroexpanded define-minor-mode for XEmacs
+
+ * erc.el: First try to make channel tracking mouse sensitive
+
+ * erc.el: * More erc-message-format conversion.
+ erc-format-message-english-PART as an example on how to use functions to format message
+ * (erc-format-message): Fallback mechanism to use english catalog if variable is not bound
+
+2001-12-03 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * (erc-iswitchb): Rewrite, docfix.
+ Make it use erc-modified-channels as default if available.
+
+ * erc-menu.el:
+ * Fixage related to erc-track-modified-channels-minor-mode rewrite
+
+ * erc.el:
+ * (erc-track-modified-channels-minor-mode): Use buffer objects instead of erc-default-target return value for internal state keeping.
+
+ * erc.el: * Made reconnect behave nicer (erc-process-sentinel)
+ * Rewrote erc-modified-channels-tracking completely.
+ Its now a minor mode (erc-track-modified-channels-minor-mode)
+ It uses a list as internal representation now, so all silly string-parsing
+ related bugs should be gone.
+ Use (erc-track-modified-channels-minor-mode t) now to toggle this functionality.
+ Don't set the erc-track-modified-channels-minor-mode variable yourself, use the toggle function
+
+2001-11-29 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: final version
+
+2001-11-29 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-channel-p): Make it work with string and buffer as parameter. buffer.
+ * (erc-format-message): Add a check for functionp. This allows a format-specifier also to be a function name, which gets called with args applied and needs to return the actual format string.
+ * Converted some formats, JOIN, JOIN-you, MODE, ...
+
+2001-11-28 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-prepare-mode-line-format): Added sanity checks to prevent it from having problems with server buffers where the connection failed
+
+ * erc-bbdb.el:
+ * (erc-bbdb-JOIN): regexp-quote the fingerhost before searching, some people have really strange characters as their user names
+
+ * erc.el: Remove a stupid debug like (message ...) call
+
+2001-11-28 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: draft of 2.1.cvs.20011128-1
+
+ * debian/rules: simplify for the all-in-one erc package
+
+ * debian/control: integrated erc-speak back into erc
+
+ * debian/maint/conffiles, debian/maint/conffiles.in, debian/maint/postinst,
+ debian/maint/postinst.in, debian/maint/prerm, debian/maint/prerm.in,
+ debian/scripts/install, debian/scripts/install.in, debian/scripts/remove,
+ debian/scripts/remove.in, debian/scripts/startup.erc-speak:
+ since erc-speak is gone, resurrect the static files, and update them to support the latest erc
+
+2001-11-28 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * (erc-mode): Shouldn't be interactive.
+ * (erc-info-mode): Ditto.
+
+ * erc.el: * (erc-server-352): Added hopcount parsing.
+ Added call to erc-update-channel-member to fill in channel-members information
+ on /WHO if the channel is joined.
+
+2001-11-27 Mario Lang <mlang@delysid.org>
+
+ * erc-speedbar.el: *** empty log message ***
+
+ * erc-speedbar.el: * (erc-speedbar-expand-user): New function.
+ Used when more information than just the nick name is available about a dude.
+
+ * erc.el: * Fixed stupid edit,checkin,save cycle error :)
+
+ * erc.el:
+ * (erc-generate-log-file-name-default): Renamed to -long
+ Doc fix.
+ * (erc-generate-log-file-name-old): Renamed to -long
+ Doc fix.
+ * (erc-generate-log-file-name-function): Set default to ...-long
+ Doc fixes
+
+ * erc-speedbar.el: *** empty log message ***
+
+2001-11-26 Mario Lang <mlang@delysid.org>
+
+ * erc-speedbar.el: * Integrated channel names list
+ what else do we need to replace info buffers???
+ please test that code and comment on erc-ehlp, thanks
+
+ * erc-speedbar.el:
+ * Added erc-speedbar-goto-buffer and therefore enable switching to the buffers from speedbar
+
+ * erc-speedbar.el:
+ I had to check this in, it works !! sort of,, megaalphagammaversion, first version. test, play, submit ideas/patches
+
+2001-11-26 Gergely Nagy <algernon@debian.org>
+
+ * erc.el(erc-mode): moved erc-last-saved-position here
+ moved buffer naming code from here..
+ (erc): ...to here
+ (erc-generate-log-file-name-old): only prepend target if it exists
+
+ made erc-log-insert-log-on-open a defcustom
+
+2001-11-26 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Applied antifuchs/mhp patches, the latest on erc-help, unmodified
+ * New variable: erc-reuse-buffers default to t.
+ * Modified erc-generate-new-buffer-name to use it. it checks if server and port are the same,
+ then one can assume that's the same channel/query target again.
+
+2001-11-23 Mario Lang <mlang@delysid.org>
+
+ * erc-bbdb.el:
+ * new function erc-BBDB-NICK to handle nickname annotation on a nick-change event of a known record
+
+ * erc.el: * Remove erc-rename-buffer, its no longer necessary
+ * Remove erc-autoop-*. it was broken, and needed rewrite anyway
+ * write erc-already-logged-in in terms of erc-buffer-list and make the duplicate login check work again
+
+ * erc.el: * Fixed stupid typo
+
+2001-11-22 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * New local variable, erc-announced-server-name
+ * erc-mode-line-format supports a new symbol, target-and/or-server
+ * The mode-line displays the announced server name now (for autojoin later...,
+ greets Adam)
+ * New macro, erc-server-hook-list for a nice way to define the defcustoms of the erc-server-*-hook's
+ Thanks go to the guy from #emacs who helped with that
+ * erc-fill-region is now autoloaded from erc-fill.el
+ * erc-fill.el implements a new fill method, erc-fill-static
+ (setq erc-fill-function 'erc-fill-static)
+ * Some other things I forgot right now
+
+ * erc-bbdb.el: *** empty log message ***
+
+ * erc-fill.el: Initial version.
+
+ * erc-complete.el:
+ Applied antifuchs patch to make completion work with (string= erc-prompt "")
+
+ * erc-complete.el:
+ added function erc-nick-completion-exclude-myself
+ you can set erc-nick-completion to 'erc-nick-completion-exclude-myself to use it
+
+2001-11-21 Mario Lang <mlang@delysid.org>
+
+ * erc-bbdb.el:
+ * Changed usage of 'finger-host to bbdb-finger-host-field
+
+ * erc-bbdb.el:
+ * Changed WHOIS to use finger-host instead of net field.
+ * Added 'visible as option to erc-bbdb-popup-p to only pop-up the bbdb buffer if a join happened in a visible buffer on any visible frame.
+ * Added (regexp-quote ...) for nickname search in erc-bbdb-JOIN
+
+2001-11-20 Mario Lang <mlang@delysid.org>
+
+ * erc-bbdb.el: * Added JOIN support
+
+2001-11-19 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Initial message catalog code. converted erc-action-format usage to use it
+
+ * erc.el: * erc-play-sound: Added XEmacs related check
+
+ * erc-bbdb.el: * Initial version, many thanks to Andreas Fuchs
+
+ * erc.el: * Fixed silly problem with whois/was handling
+
+ * erc.el: * Renamed prev-rd to erc-previous-read
+ * Removed erc-next-line-add-newlines and s next-line-add-newlines to nil in defun erc by default
+
+ * erc.el:
+ fixed xemacs compatibility prob with delete, thanks Adam
+
+2001-11-18 Mario Lang <mlang@delysid.org>
+
+ * erc.el: numreplies 301 & 461
+
+2001-11-13 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el:
+ Added code for error reply 421 "Unknown command", to test the new server parsing system.
+ This was really easy! Thanks ZenIRC guys & delysid :-)
+
+2001-11-13 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Allow connecting to SSL enabled irc servers.
+ Ugly hack, but it works for now. Be sure to use the numeric irc port 994 so that erc can recognize what you want
+ good example is
+ irc server: ircs.segfault.net
+ port: 994
+
+ meet me there, I am still delYsid :)
+
+ * erc.el: * some more numreply handlers
+ * cleanup in erc-process-away-p
+ * new function erc-display-error-notice
+
+ * erc.el: * numreply 501 and 221
+
+ * erc.el:
+ removed obsolete old hook variables. Your functions may break, but it is easy to hook them up to the new hooks.
+ erc-part-hook: use erc-server-PART-hook instead
+ erc-kick-hook: use erc-server-KICK-hook instead
+ and so on
+
+ * erc.el:
+ fixed serious bug which cause privmsgs vanishing when erc-auto-query was set to nil
+
+ * erc.el: cleaned up erc-process-filter
+
+ * erc.el: * 401 and 320 numreplies implemented
+
+ * erc.el: * Removed old/now obsolete code
+
+ * erc.el: * Fixed bug in erc-server-MODE
+
+2001-11-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el: fixed it
+
+ * erc.el:
+ *** We switched over. New server message parsing/handling is running now. Thanks to the zenirc developers for the great ideas I got from the code!!!!! Go and test it, poke at it, bug me on irc about problems
+
+ * erc.el: *** empty log message ***
+
+2001-11-12 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el:
+ Fixed bug in erc-get-buffer, now channel names are compared in
+ a case-insensitive way.
+
+2001-11-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el: erc-server-353
+
+2001-11-12 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el: Fixed docstring for erc-get-buffer.
+ Added erc-process to a lot of calls to erc-get-buffer, so
+ that only the local process is searched.
+
+2001-11-12 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * erc-buffer-filter: do it differently
+
+ * erc.el: ugly but working fix for mhp's query problem
+
+ * erc.el: * erc-server-PRIVMSG-or-NOTICE
+ Now, all the server word replies are finished. Going to numreplies now
+
+ * erc.el:
+ * debugging facilities for the transition. C-x 2 C-x o M-x ielm RET erc-server-vectors RET ; to get a list of all server messages currently not handled in the new code. Feel free to pick one and implement it
+
+ * erc.el: * erc-server-KICK and erc-server-TOPIC. new functions
+ * erc-server-305-or-306 and erc-server-311-or-314
+
+ * erc.el:
+ * ported PART and QUIT msgs to the new scheme, many to go. but it is a easy task. does someone wanna try and start with numreplies?
+
+ * erc.el: * erc-server-JOIN
+
+ * erc.el: * Ported erc-server-INVITE code
+
+ * erc.el: * erc-server-ERROR and erc-server-MODE
+
+2001-11-11 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * zen
+
+ * erc.el: * New variable erc-connect-function.
+
+ * erc.el:
+ * New function erc-channel-p and use it where appropriate
+
+ * erc.el: * Removed the variable erc-buffer-list completely now
+ * Moved erc-dbuf around a bit
+
+ * erc.el: * Fix silly change in quit/rename msg handling
+
+ * erc.el: thanks mhp, fixed
+
+ * erc.el: * Tijs van Bakel's work from 10th Nov. merged in
+ * My additions to that idea merged in too
+ Basically, this is a major rewrite, if you are scared and want avoid problems,
+ stay at your current version. It seems fairly stable though.
+ That changed? erc-buffer-name handling was completely rewritten,
+ and erc-buffer-list local variable handling removed.
+ Simplifies alot of code. Poke at it. read the diff. report bug/send patches!
+
+ * erc.el: * Added variable listing when /set is used without args
+
+2001-11-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Comment/structure cleanup, removal of unnecessary code
+
+ * erc.el: only some code beautification
+
+ * erc-imenu.el:
+ remove add-hook call, that's done in erc.el now for autoloadability
+
+ * erc.el: * Make erc-imenu autoloadable
+
+ * erc.el:
+ * The long promised erc-mode-line-format handling rewrite
+ Poke at it, try it, play with it, report bugs
+
+ * erc.el:
+ some regex-quote fixes, new function erc-cmd-set, and minor things
+
+2001-11-08 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * added second timestamp-format (erc-away-timestamp-format) for marking msgs when being away
+
+ * erc-complete.el: fixed silly defun
+
+ * erc.el: * Rewrote erc-load-irc-script (simplified)
+ * Removed deprecated code
+
+ * erc-speak.el: * reflect changes in erc.el
+
+ * erc.el:
+ * Moved completion related functions into erc-complete.el
+ placed an autoload instead into erc.el. That quite cool,
+ because erc-complete.el only gets loaded when you use
+ TAB first time in erc.
+
+ * erc-complete.el: _ Initial checkin
+
+ * erc.el: * New function: erc-chain-hook-with-args
+ * Changed calls to erc-insert-hook to use it
+
+2001-11-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Patch from Fabien Penso
+ Make completion case insensitive. try it! its cool
+
+ * erc.el: * Reduction patch 2
+ This time, we move the input ring handling into erc-ring.el
+ Remember that you need (require 'erc-ring) in your .emacs to get the input handling as a feature
+ And remember, that you don't need it if you don't use input ring :-)
+
+ * erc-ring.el: * Initial checkin
+
+ * erc.el: * The great reduction patch :-)
+ moved relevant function from erc.el to new file erc-menu.el and erc-imenu.el
+
+ * erc-imenu.el: Initial version
+
+ * erc-menu.el: * Initial version
+
+ * erc.el: * wording change suggested by Benjamin Drieu
+
+2001-11-07 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el: Added Emacs version to /SV
+
+2001-11-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Hookification patch, read the diff
+
+ * erc.el: too tired for a changelog :)
+
+2001-11-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * make erc-cmd-op and erc-cmd-deop take multiple nicknames as argument
+
+2001-11-06 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: sync
+
+ * debian/rules: fixed a typo: PKGDIR, not PKIDR
+
+2001-11-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Changed timestamping when away to use erc-timestamp-format and append the timestamp instead of prepending it..
+ * minor cleanup, s/(if (not /(unless/ and the like
+
+2001-11-06 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el: Fixed OP and DEOP commands to return T.
+ Added SV say-version command.
+ Added erc-send-message utility function, but it's not used everywhere yet.
+
+2001-11-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el: stupid delYsid, forgot require 'format-spec. good nite
+
+ * erc.el:
+ * new variable erc-action-format. Some erc-notice-prefix fixes again
+
+ * erc.el: * erc-minibuffer-privmsg defaults to t
+
+ * erc.el:
+ * Small fix in relation to the transition to erc-make-notice
+
+2001-11-05 Tijs van Bakel <smoke@wanadoo.nl>
+
+ * erc.el:
+ Renamed erc-message-notices to erc-minibuffer-notice, and renamed erc-prevent-minibuffer-privmsg to erc-minibuffer-privmsg, inverting its functionality
+
+ * erc.el: Added support for channel names starting with & + and !.
+ Also, many changes partially discussed on the mailing list:
+
+ * erc.el (cl): Add requirement for cl package.
+ (erc-buffer-list): Make this variable global again.
+ (erc-default-face): Fix typo.
+ (erc-timestamp-face): Add face for timestamps.
+ (erc-join-buffer, erc): Add a 'bury option.
+ (erc-send-action): Add timestamp.
+ (erc-command-table): Add /CLEAR, /DEOP, /OP, /Q.
+ (erc-send-current-line): Add timestamp.
+ (erc-send-current-line): Add call to erc-insert-hook.
+ (erc-cmd-clear): New command to clear buffer contents.
+ (erc-cmd-whois): Fix cut'n'paste-o.
+ (erc-cmd-deop): New command to deop a user.
+ (erc-cmd-op): New command to op a user.
+ (erc-make-notice): Moved a lot of duplicate code here. Perhaps
+ this should also be done for erc-highlight-error.
+ (erc-parse-line-from-server): Now NOTICE will also open a new
+ query, just as PRIVMSG.
+ (erc-parse-line-from-server): Call erc-put-text-property on a
+ channel message/notice first, before concatenating nick and
+ timestamp &c.
+ (erc-message-notices): Add option to display notices in
+ minibuffer.
+ (erc-fill-region): No longer strip spaces in front of incoming
+ messages.
+ (erc-parse-current-line): No longer strip spaces in front of text
+ input by user.
+
+ Hopefully I didn't break too much :(
+
+2001-11-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * New function erc-nickserv-identify-autodetect for erc-insert-hook. Added by default currently.
+
+ * erc.el:
+ * Mini-fix in erc-process-num-reply (= n 353): Added @ as prefix character to make certain channels on opn work again nicely
+
+2001-10-31 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: updated to reflect changes
+
+ * debian/scripts/install.in:
+ moved #PKGFLAG# before -f batch-byte-compile
+
+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
+
+2001-10-26 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: sigh. -2
+
+2001-10-25 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: updated to reflect changes
+
+ * debian/rules: handle conffiles.in too
+
+ * debian/maint/conffiles.in: new file
+
+ * debian/maint/conffiles: superseded by conffiles.in
+
+ * debian/scripts/startup: superseded by startup.erc
+
+2001-10-25 Mario Lang <mlang@delysid.org>
+
+ * debian/scripts/startup.erc-speak: * Initial version
+
+ * debian/scripts/startup.erc: * Added and fixes minimal typo
+
+2001-10-25 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: updated to reflect changes
+
+ * debian/rules:
+ modified to be able to build the erc-speak package too
+
+ * debian/control: added the new erc-speak package
+
+ * debian/README.erc-speak, debian/maint/postinst.in, debian/maint/prerm.in,
+ debian/scripts/install.in, debian/scripts/remove.in:
+ new file
+
+ * debian/maint/postinst, debian/maint/prerm, debian/scripts/install,
+ debian/scripts/remove:
+ removed, superseded by its .in counterpart
+
+2001-10-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Fixed some defcustom :type 's
+ * Added erc-before-connect hook which gets called with server port and nick.
+ Use this hook to e.g. setup a tunnel before actually connecting.
+ something like (when (string= server "localhost") ...)
+
+2001-10-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Patch by smoke: fix erc-cmd-* commands and add aliases
+
+2001-10-23 Mario Lang <mlang@delysid.org>
+
+ * erc-speak.el:
+ * Added a new personality for channel name announcement, This makes streams of flooded channels much easier to listen to,
+ especially if you are on more than one channel simultaneously.
+
+ * erc.el:
+ * Made the completion postfix customizable through erc-nick-completion-postfix
+
+ * erc-speak.el, erc.el:
+ * Added erc-prevent-minibuffer-privmsg
+
+ * erc-speak.el:
+ * Quickish hack to allow exclusion of timestamps from speaking. see erc-speak-filter-timestamps
+
+2001-10-21 Mario Lang <mlang@delysid.org>
+
+ * erc-speak.el:
+ * Removed now really obsolete code. Package size reduced by 50%
+
+ * 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!!!
+
+ * erc-speak.el: *** empty log message ***
+
+ * erc-speak.el: * Major simplification. depends on my 2001-10-21 changes to erc.el.
+ * Things removed, read diff
+
+2001-10-21 Gergely Nagy <algernon@debian.org>
+
+ * debian/changelog: oops, silly typo
+
+ * debian/changelog, debian/control, debian/copyright,
+ debian/maint/conffiles, debian/maint/postinst, debian/maint/prerm,
+ debian/rules, debian/scripts/install, debian/scripts/remove,
+ debian/scripts/startup:
+ initial check-in
+
+2001-10-21 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Changed erc-insert-hook to get two arguments, START and END of the region
+ which got inserted. CAREFUL! This could break stuff, but it makes the hook
+ much more usable.
+
+ * erc.el:
+ * Made erc-smiley a new option, currently set to t to showoff this feature. :)
+
+2001-10-20 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Add missing erc-mode-hook variable
+ * Add smiley-support (preliminary test)
+
+2001-10-20 Alex Schroeder <alex@gnu.org>
+
+ * erc.el:
+ Replaced all occurrences of put-text-property with a call to
+ erc-put-text-property.
+ (erc-put-text-property): New function.
+ (erc-tracking-modified-channels): Moved to the front of the file such
+ that it is already defined when the menu is being defined.
+ (erc-modified-channel-string): Ditto.
+
+2001-10-18 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: Removed some commentary. The wiki page is the place to
+ put such information.
+ (erc-fill-prefix): Doc change.
+ (erc-notice-highlight-type): Doc change, now a user option.
+ (erc-pal-highlight-type): Doc change, now a user option.
+ (erc-fool-highlight-type): New option.
+ (erc-keyword-highlight-type): New option.
+ (erc-dangerous-host-highlight-type): New option.
+ (erc-uncontrol-input-line): Doc change.
+ (erc-interpret-controls-p): Doc change, now a user option.
+ (erc-multiline-input): Doc change.
+ (erc-auto-discard-away): Doc change.
+ (erc-pals): Changed from string to regexp.
+ (erc-fools): New option.
+ (erc-keywords): Renamed from erc-highlight-strings. WATCH OUT:
+ Not backwards compatible change!
+ (erc-dangerous-hosts): Renamed from erc-host-danger-highlight.
+ WATCH OUT: Not backwards compatible change!
+ (erc-menu-definition): Added menu entries for fools, keywords and
+ dangerous hosts.
+ (erc-mode-map): Changed keybindings from C-c <plain ascii> to
+ various C-c <C-ascii> combinations.
+ (erc-dangerous-host-face): Renamed from erc-host-danger-face.
+ WATCH OUT: Not backwards compatible change!
+ (erc-fool-face): New face.
+ (erc-keyword-face): Renamed from erc-highlight-face. WATCH OUT:
+ Not backwards compatible change!
+ (erc-parse-line-from-server): Fixed highlighting in the cases
+ where (equal erc-pal-highlight-type 'all), added code to handle
+ erc-fool-highlight-type, erc-dangerous-host-highlight-type
+ (erc-update-modes): Replaced erc-delete-string with delete.
+ (erc-keywords): Renamed from erc-highlight-strings, handle
+ erc-keyword-highlight-type.
+ (erc-delete-string): Removed.
+ (erc-list-match): New function.
+ (erc-pal-p): Use erc-list-match.
+ (erc-fool-p): New function.
+ (erc-keyword-p): New function.
+ (erc-dangerous-host-p): Renamed from erc-host-danger-p, use
+ erc-list-match.
+ (erc-directed-at-fool-p): New function.
+ (erc-add-entry-to-list): New function.
+ (erc-remove-entry-from-list): New function.
+ (erc-add-pal): Use erc-add-entry-to-list.
+ (erc-delete-pal): Use erc-remove-entry-from-list.
+ (erc-add-fool): New function.
+ (erc-delete-fool): New function.
+ (erc-add-keyword): New function.
+ (erc-delete-keyword): New function.
+ (erc-add-dangerous-host): New function.
+ (erc-delete-dangerous-host): New function.
+
+2001-10-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * irc vs ircd default port fixed
+
+ * erc.el: * Added topic-change to imenu
+
+ * erc.el: * More imenu spiffyness
+
+ * erc.el: * Added imenu support
+
+ * erc.el:
+ * Fix to /topic to show topic instead of setting it to null :)
+
+2001-10-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * First version of erc-rename-buffer
+
+ * erc.el: * more header-line tricks.
+
+ * erc.el:
+ * Small fix to do erc-update-mode-line-buffer in erc-update-channel-topic
+
+ * erc.el: * Added erc-header-line-format
+
+2001-10-04 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * mini-fix, add msgp to auto-query code
+
+ * erc.el: * Added command-names to completion (erc-command-table)
+ * New variable erc-auto-query. When set, every arriving message to you
+ will open a query buffer for that sender if not already open.
+ * Compatibility function fo non-existing line-beginning|end-position functions in XEmacs.
+
+2001-10-03 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Removed alot of (progn ...) where they were not necessary
+ * Changed some (if ...) without else part to (when ...)
+ * Some (while ...) to use (dolist ...)
+ * Fix for completion popup generating tracebacks.
+ * New function erc-arrange-session-in-multiple-windows
+ * Lots of other stuff, read the diff
+
+2001-10-02 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Added erc-kill-input and keybinding C-c C-u for it
+
+2001-10-01 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Another fix to nick-completion
+ * Additional checks in erc-track-modified-channels
+
+2001-09-26 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Fixed completion (alex)
+ * Now popup buffer doesn't destroy your window configuration.
+ * Fixed away handling (incomplete)
+
+2001-09-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Fixed silly quoting-escape error
+
+2001-09-23 Mario Lang <mlang@delysid.org>
+
+ * erc.el: * Added auto-op support (unfinished)
+ * Added erc-latest-version.
+ * Added erc-ediff-latest-version.
+
+2001-09-21 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Minor menu additions (invite only mode is now a checkbox)
+
+2001-09-20 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * Fix (erc-cmd-names): This should fix C-c C-n too, hopefully it was the right fix and doesn't break anything else.
+
+ * erc.el: * Fixes XEmacs easymenu usage (2nd time).
+
+2001-09-19 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ * (erc-complete-nick): Add ": " only if one completes directly after the erc-prompt, otherwise, add just one space
+
+ * erc.el:
+ * Changed menu-definition to use easymenu (hopefully this now works under XEmacs)
+ * Fix for custom problem with :must-match on XEmacs (thanks shapr)
+ * Added /COUNTRY command using (what-domain) from package mail-extr (shapr)
+ * Fix for case-sensitivity problem with pals (they are now all downcased)
+ * Different (erc-version) function which now can take prefix argument to insert the version information into the current buffer,
+ instead of just displaying it in the minibuffer.
+
+2001-09-10 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Updated erc-version-string
+
+ * erc.el: Version number change and last read-through...
+
+2001-09-04 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Added some asterisks
+
+2001-08-24 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Fixed hidden channel buffer tracking (sort of), now using switch-to-buffer for advice.
+ This version is unofficially named 2.1prebeta1. Please test it and send
+ fixes to various problems you may encounter so that we can eventually
+ release 2.1 soon.
+
+2001-08-14 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Added function erc-bol and keybinding C-c C-a for it (contributed by Benjamin Rutt <brutt@bloomington.in.us)
+
+2001-08-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Checked in lathis code and modified it slightly. Still unsure about set-window-buffer advice, current attempt doesn't seem to work.
+ Removed (nick -> #channel) from mode-line. (CLOSED) and (AWAY...) should still be displayed when appropriate
+
+2001-08-06 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ added local-variable channel-list in session-buffers and make /LIST use it.
+ erc-join-channel can now do completion after /LIST was executed
+
+2001-08-05 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Tweaked erc-join-channel and erc-part-from-channel
+
+2001-07-27 Mario Lang <mlang@delysid.org>
+
+ * erc.el: some more defcustom stuff
+
+ * erc.el: Patch from Henrik Enberg <henrik@enberg.org>:
+ Adds variables erc-frame-alist and erc-frame-dedicated-p.
+
+ * erc.el: fixed erc-part-from-channel
+
+ * erc.el:
+ fixed match-string problem and added interactive topic setting function.
+
+ * erc.el: fixed silly string-match bug
+
+ * erc.el:
+ Added erc-join-channel and erc-part-from-channel (interactive prompts), as well as keybindings. C-c C-j #emacs RET is now enough :)
+
+2001-07-27 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-display-line-buffer): Simplified filling.
+ (erc-fill-region): New function.
+
+2001-07-27 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Added redundancy check in output
+
+2001-07-26 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-send-action): Add text-property stuff.
+ (erc-input-action): Removed text-property stuff.
+ (erc-command-table): Corrected command for DESCRIBE. Still
+ doesn't work though. No idea what it should do. Looks like a no op.
+ (erc-cmd-me): Doc change.
+
+2001-07-26 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ fixed one occurrence of a setq with only one argument (XEmacs didn't like that)
+
+ * erc.el:
+ Added erc-next-line-add-newlines customization possibility.
+
+ * erc.el:
+ added erc-fill-prefix for defining your own way of filling and fixed filling somehow
+
+ * erc.el:
+ fixed small incompatibility in erc-parse-line-from-server at (and (= n 353) regexp
+
+2001-07-25 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Added erc-filling and filling code to erc-display-line-buffer.
+
+2001-07-08 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(try-complete-erc-nick): Make the ": " part of the
+ expansion
+
+ * erc.el: require ring
+
+2001-07-08 Mario Lang <mlang@delysid.org>
+
+ * erc.el: *** empty log message ***
+
+2001-07-07 Mario Lang <mlang@delysid.org>
+
+ * erc.el: typo
+
+ * erc.el: omit
+
+2001-07-06 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-mode): Call erc-input-ring-setup.
+ (erc-send-current-line): Call erc-add-to-input-ring.
+ (erc-input-ring): New variable. Currently not buffer local.
+ (erc-input-ring-index): New variable. Currently not buffer local.
+ (erc-input-ring-setup): New function.
+ (erc-add-to-input-ring): New function.
+ (erc-previous-command): New function.
+ (erc-next-command): New function.
+ (erc-mode-map): Uncommented keybindings for erc-next-command and
+ erc-previous-command.
+
+2001-07-05 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-highlight-strings): Removed debug message.
+
+ * erc.el(erc-join-buffer): Changed default to 'buffer.
+ (erc-join-info-buffer): Changed default to 'disable.
+ (erc-nick-completion): Changed default to 'all.
+
+2001-07-04 uid31117 <uid31117@confusibombus>
+
+ * erc.el: Resolved...
+
+2001-07-03 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(erc-highlight-strings): New option and new function.
+ (erc-parse-line-from-server): Use it.
+ Various empty lines removed. Various doc strings fixed.
+
+ * erc.el: Removed more empty lines.
+
+ * erc.el(erc-member-string): replaced by plain member
+ Otherwise, lots of deleting of empty lines... I'm not too happy with that
+ but I feel better when the code is "cleaned up".
+
+2001-07-03 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Ugly hack, but looks nicer when giving commands
+
+ * erc-speak.el: ugly hack, but looks nicer now
+
+2001-07-03 Alex Schroeder <alex@gnu.org>
+
+ * erc.el(try-complete-erc-nick): New function.
+ (erc-try-complete-nick): New function.
+ (erc-nick-completion): New option.
+ (erc-complete): Call hippie-expand such that erc-try-complete-nick
+ will be called eventually. Based on erc-nick-completion
+ try-complete-erc-nick will then complete on the nick at point.
+
+2001-07-02 Mario Lang <mlang@delysid.org>
+
+ * erc.el:
+ Insert (erc-current-nick) instead of (erc-display-prompt). good night :)
+
+ * erc.el:
+ small, but it was annoying, so I just did it (defcustom for erc-join-buffer and erc-join-info-buffer)
+
+2001-06-29 Alex Schroeder <alex@gnu.org>
+
+ * erc.el: Use defface to define all faces.
+ Removed some history from the commentary, as well as some other
+ commentary editing.
+
+2001-06-28 Mario Lang <mlang@delysid.org>
+
+ * erc.el: hmm, defcustom for erc-user-full-name
+
+ * erc-speak.el, erc.el: *** empty log message ***
+
+2001-06-27 Mario Lang <mlang@delysid.org>
+
+ * erc.el: typo
+
+ * erc.el: Some more defcustom
+
+ * erc-speak.el: nothing, really
+
+2001-06-26 Mario Lang <mlang@delysid.org>
+
+ * erc.el: Some defcustom stuff. Still no defgroup though :)
+
+ * erc.el:
+ Initial change to erc.el (2.0). Mainly list of ideas and features
+ and syntax-table entries.
+
+ * erc-speak.el, erc.el: Initial Import
+
+ * erc-speak.el, erc.el: New file.
+
+ Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+ This file is part of GNU Emacs.
+
+ GNU Emacs is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ GNU Emacs is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;; Local Variables:
+;; coding: utf-8
+;; add-log-time-zone-rule: t
+;; End:
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog.2
index e0628dbb80a..8dce5084ec9 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog.2
@@ -1,3 +1,220 @@
+2015-03-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-switch-to-buffer): Fix last change (bug#20187).
+
+2015-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-switch-to-buffer): Rename from erc-iswitchb and rewrite
+ using read-buffer (bug#20116).
+ (erc--buffer-p): New function, extracted from erc-buffer-filter.
+ (erc-buffer-filter): Use it.
+ (erc-with-all-buffers-of-server): Silence compile warning if the return
+ value is unused.
+ (erc-is-valid-nick-p, erc-common-server-suffixes, erc-get-arglist)
+ (erc-command-name, erc-popup-input-buffer): Use \` and \' to match
+ beg/end of string.
+
+2015-03-03 Kelvin White <kwhite@gnu.org>
+
+ * erc.el: Add old version string back to file header for
+ package.el compatibility
+
+2015-03-03 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-rename-buffers): Doc fix. Add :version.
+
+2015-03-03 Dima Kogan <dima@secretsauce.net>
+
+ * erc-backend.el (define-erc-response-handler): Give hook-name
+ default value of nil and add-to-list (bug#19363).
+2015-02-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-spelling.el (erc-spelling-init):
+ Use flyspell-generic-check-word-predicate.
+
+2015-01-28 Dima Kogan <dima@secretsauce.net>
+
+ * erc-backend.el (define-erc-response-handler): Give hook-name
+ default value of nil and add-to-list (bug#19363).
+
+2015-01-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't downcase system diagnostics' first letters
+ * erc-dcc.el (erc-dcc-server): Ignore case while comparing diagnostics.
+
+2014-11-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * erc-desktop-notifications.el (erc-notifications-bus):
+ New customer option. Supports cases when Emacs hasn't been
+ invoked in the same environment where the notifications shall go to.
+ (erc-notifications-notify): Use it.
+
+2014-11-10 Kelvin White <kwhite@gnu.org>
+
+ * erc-stamp.el (erc-timestamp-intangible): Change version tag to 24.5.
+
+2014-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-send-input): Bind `str' dynamically (bug#18936).
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * erc-backend.el (TOPIC): Omit unnecessary call to current-time.
+ * erc.el (erc-emacs-time-to-erc-time): Simplify by using float-time.
+ (erc-current-time): Simplify by using erc-emacs-time-to-erc-time.
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-15 Ivan Shmakov <ivan@siamics.net>
+
+ * erc-track.el (erc-modified-channels-display): Update mode line
+ more frequently (bug#18510).
+
+2014-10-10 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-initialize-log-marker): Only initialize
+ erc-last-saved-position if not already a marker.
+
+2014-10-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-channel-receive-names): Silence compiler warning.
+ (erc-format-@nick, erc-update-modes): Idem.
+
+2014-10-03 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-rename-buffers): Use defcustom instead of defvar for
+ buffer renaming configuration option.
+
+2014-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * erc.el (erc-nick-at-point): Fix format-string typo (Bug#17755).
+
+2014-10-02 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-rename-buffer-p): When set to t buffers will be
+ renamed to the current irc network.
+ (erc-format-target-and/or-network): Use `erc-rename-buffer-p' when
+ renaming buffers.
+
+ * erc-ring.el (erc-input-ring-setup): Fixes Bug #18599
+
+2014-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-track.el (erc-modified-channels-display): Update all mode lines
+ if needed (bug#18510). Remove call to erc-modified-channels-object
+ where we ignored the return value.
+ (erc-modified-channels-update): Don't force-mode-line-update here
+ any more.
+
+2014-09-26 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-format-nick): Fix code regression - Bug #18551
+
+2014-09-25 Kelvin White <kwhite@gnu.org>
+
+ * erc.el: Follow Emacs version instead of tracking it seperately.
+ (erc-quit/part-reason-default) : Clean up quit/part message
+ functions by abstracting repetitive code, change version string.
+ (erc-quit-reason-various, erc-quit-reason-normal, erc-quit-reason-zippy)
+ (erc-part-reason-normal, erc-part-reason-zippy, erc-part-reason-various)
+ (erc-cmd-SV, erc-ctcp-query-VERSION, erc-version, erc-version-string):
+ Change version string.
+
+2014-08-13 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-send-input): Disable display commands in current buffer
+ (erc-format-target-and/or-network): Fix cases when buffer name is set
+
+2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-stamp.el (erc-timestamp-intangible): Disable by default because
+ `intangible' is evil.
+
+2014-08-07 Kelvin White <kwhite@gnu.org>
+
+ * erc.el (erc-channel-receive-names): Fix variable names
+ (erc-format-target-and/or-network): Rename server-buffers to
+ network name if possible
+
+2014-07-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-channel-receive-names): Reduce redundancy.
+
+2014-06-19 Kelvin White <kwhite@gnu.org>
+
+ * erc-backend.el: Handle user modes in relevant server responses
+ * erc.el: Better user mode support.
+ (erc-channel-user): Add members for new modes.
+ (erc-channel-member-halfop-p, erc-channel-user-admin-p)
+ (erc-channel-user-owner-p): Use new struct members.
+ (erc-format-nick, erc-format-@nick): Display user modes as nick prefix.
+ (erc-nick-prefix-face, erc-my-nick-prefix-face): Add new faces
+ (erc-get-user-mode-prefix): Return symbol for mode prefix.
+ (erc-update-channel-member, erc-update-current-channel-member)
+ (erc-channel-receive-names): Update channel users.
+ (erc-nick-at-point): Return correct user info.
+
+2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc.el (erc-invite-only-mode, erc-toggle-channel-mode): Simplify.
+ (erc-load-script): Tighten a regexp.
+
+2014-02-25 Julien Danjou <julien@danjou.info>
+
+ * erc-networks.el (erc-determine-network): Check that NETWORK as a
+ value, some servers set it to nothing.
+
+2014-01-31 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-accidental-paste-threshold-seconds): Doc tweak.
+
+2014-01-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * erc.el (erc): Link to info manual.
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * erc-log.el (erc-log-file-coding-system): Specify custom type.
+
+2013-11-25 Glenn Morris <rgm@gnu.org>
+
+ * erc-button.el (erc-nick-popup): Make `nick' available in the
+ eval environment. (Bug#15969)
+
+2013-11-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * erc-pcomplete.el (erc-pcomplete): Set this-command.
+
+2013-09-21 Glenn Morris <rgm@gnu.org>
+
+ * erc.el (erc-invite-only-mode, erc-toggle-channel-mode):
+ Remove unused local variable `erc-force-send'.
+
+2013-09-19 Glenn Morris <rgm@gnu.org>
+
+ * erc-button.el (erc-button-click-button, erc-button-press-button):
+ * erc-list.el (erc-list-handle-322):
+ Mark unused arguments.
+
+ * erc.el (erc-open-server-buffer-p): Actually use the `buffer' arg.
+ * erc-backend.el (erc-server-process-alive): Take optional `buffer' arg.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * erc-button.el (erc-button-add-buttons): Remove unused local vars.
+
+2013-09-14 Vivek Dasmohapatra <vivek@etla.org>
+
+ * erc.el (erc-update-mode-line-buffer):
+ Handle absent topic. (Bug#15377)
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * erc-desktop-notifications.el (dbus-debug): Declare.
+
2013-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
* erc.el: Use lexical-binding.
@@ -160,7 +377,7 @@
2012-10-04 Julien Danjou <julien@danjou.info>
- * erc-desktop-notifications.el: Rename from erc-notifications to
+ * erc-desktop-notifications.el: Rename from erc-notifications.el to
avoid clash with 8+3 filename format and erc-notify.el.
2012-09-25 Chong Yidong <cyd@gnu.org>
@@ -292,9 +509,9 @@
2011-11-28 Mike Kazantsev <mk.fraggod@gmail.com> (tiny change)
- * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Updated regexp to
+ * erc-dcc.el (erc-dcc-ctcp-query-send-regexp): Update regexp to
match quoted filenames with spaces inside.
- (erc-dcc-handle-ctcp-send): Updated regexp match group numbers,
+ (erc-dcc-handle-ctcp-send): Update regexp match group numbers,
added processing of escaped quotes and backslashes if filename
itself was in quotes.
@@ -394,6 +611,10 @@
(erc-modified-channels-update): Remove
erc-modified-channels-update from post-command-hook after update.
+2011-02-01 Sam Steingold <sds@gnu.org>
+
+ * erc-list.el (erc-list-menu-mode): Inherit from `special-mode'.
+
2011-01-31 Antoine Levitt <antoine.levitt@gmail.com> (tiny change)
* erc-track.el (track): Don't reset erc-modified-channels-object
@@ -496,7 +717,7 @@
2009-07-22 Kevin Ryde <user42@zip.com.au>
- * erc/erc.el (erc-cmd-MODE): Hyperlink urls in docstring with URL `...'.
+ * erc.el (erc-cmd-MODE): Hyperlink urls in docstring with URL `...'.
2009-03-13 D. Goel <deego3@gmail.com>
@@ -529,10 +750,9 @@
* erc.el (erc-user-input): Do not include text properties when
returning user input.
+See ChangeLog.1 for earlier changes.
-See ChangeLog.08 for earlier changes.
-
- Copyright (C) 2009-2013 Free Software Foundation, Inc.
+ Copyright (C) 2009-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -553,4 +773,3 @@ See ChangeLog.08 for earlier changes.
;; coding: utf-8
;; add-log-time-zone-rule: t
;; End:
-
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index cc908577781..c01cb3a4878 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -1,9 +1,9 @@
;;; erc-autoaway.el --- Provides autoaway for ERC
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoAway
;; This file is part of GNU Emacs.
@@ -270,7 +270,7 @@ active server buffer available."
;; existing process.
(when (or notest (erc-autoaway-some-open-server-buffer))
(setq erc-autoaway-caused-away t)
- (erc-cmd-GAWAY (format erc-autoaway-message idle-time))))
+ (erc-cmd-GAWAY (format-message erc-autoaway-message idle-time))))
(defun erc-autoaway-reset-indicators (&rest stuff)
"Reset indicators used by the erc-autoaway module."
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4200d4aff7f..ec45dcfcf24 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -1,10 +1,10 @@
;;; erc-backend.el --- Backend network communication for ERC
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Filename: erc-backend.el
;; Author: Lawrence Mitchell <wence@gmx.li>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 2004-05-7
;; Keywords: IRC chat client internet
@@ -497,11 +497,12 @@ The current buffer is given by BUFFER."
erc-server-ping-handler)
erc-server-ping-timer-alist)))))
-(defun erc-server-process-alive ()
- "Return non-nil when `erc-server-process' is open or running."
- (and erc-server-process
- (processp erc-server-process)
- (memq (process-status erc-server-process) '(run open))))
+(defun erc-server-process-alive (&optional buffer)
+ "Return non-nil when BUFFER has an `erc-server-process' open or running."
+ (with-current-buffer (or buffer (current-buffer))
+ (and erc-server-process
+ (processp erc-server-process)
+ (memq (process-status erc-server-process) '(run open)))))
;;;; Connecting to a server
@@ -651,7 +652,7 @@ EVENT is the message received from the closed connection process."
(run-at-time erc-server-reconnect-timeout nil
#'erc-process-sentinel-2
event buffer)
- (error (concat "`erc-server-reconnect-timeout`"
+ (error (concat "`erc-server-reconnect-timeout'"
" must be a number")))))))))))
(defun erc-process-sentinel-1 (event buffer)
@@ -678,7 +679,7 @@ Conditionally try to reconnect and take appropriate action."
(when (buffer-live-p buf)
(with-current-buffer buf
(erc-log (format
- "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
+ "SENTINEL: proc: %S status: %S event: %S (quitting: %S)"
cproc (process-status cproc) event erc-server-quitting))
(if (string-match "^open" event)
;; newly opened connection (no wait)
@@ -1081,7 +1082,7 @@ As an example:
Would expand to:
(prog2
- (defvar erc-server-311-functions 'erc-server-311
+ (defvar erc-server-311-functions \\='erc-server-311
\"Some non-generic variable documentation.
Hook called upon receiving a 311 server response.
@@ -1099,12 +1100,12 @@ Would expand to:
add things to `erc-server-311-functions' instead.\"
(do-stuff-with-whois proc parsed))
- (puthash \"311\" 'erc-server-311-functions erc-server-responses)
- (puthash \"WHOIS\" 'erc-server-WHOIS-functions erc-server-responses)
- (puthash \"WI\" 'erc-server-WI-functions erc-server-responses)
+ (puthash \"311\" \\='erc-server-311-functions erc-server-responses)
+ (puthash \"WHOIS\" \\='erc-server-WHOIS-functions erc-server-responses)
+ (puthash \"WI\" \\='erc-server-WI-functions erc-server-responses)
- (defalias 'erc-server-WHOIS 'erc-server-311)
- (defvar erc-server-WHOIS-functions 'erc-server-311
+ (defalias \\='erc-server-WHOIS \\='erc-server-311)
+ (defvar erc-server-WHOIS-functions \\='erc-server-311
\"Some non-generic variable documentation.
Hook called upon receiving a WHOIS server response.
@@ -1115,8 +1116,8 @@ Would expand to:
See also `erc-server-311'.\")
- (defalias 'erc-server-WI 'erc-server-311)
- (defvar erc-server-WI-functions 'erc-server-311
+ (defalias \\='erc-server-WI \\='erc-server-311)
+ (defvar erc-server-WI-functions \\='erc-server-311
\"Some non-generic variable documentation.
Hook called upon receiving a WI server response.
@@ -1135,7 +1136,8 @@ Would expand to:
aliases))
(let* ((hook-name (intern (format "erc-server-%s-functions" name)))
(fn-name (intern (format "erc-server-%s" name)))
- (hook-doc (format "%sHook called upon receiving a %%s server response.
+ (hook-doc (format-message "\
+%sHook called upon receiving a %%s server response.
Each function is called with two arguments, the process associated
with the response and the parsed response. If the function returns
non-nil, stop processing the hook. Otherwise, continue.
@@ -1145,7 +1147,8 @@ See also `%s'."
(concat extra-var-doc "\n\n")
"")
fn-name))
- (fn-doc (format "%sHandler for a %s server response.
+ (fn-doc (format-message "\
+%sHandler for a %s server response.
PROC is the server process which returned the response.
PARSED is the actual response as an `erc-response' struct.
If you want to add responses don't modify this function, but rather
@@ -1161,8 +1164,11 @@ add things to `%s' instead."
(cl-loop for alias in aliases
collect (intern (format "erc-server-%s-functions" alias)))))
`(prog2
- ;; Normal hook variable.
- (defvar ,hook-name ',fn-name ,(format hook-doc name))
+ ;; Normal hook variable. The variable may already have a
+ ;; value at this point, so I default to nil, and (add-hook)
+ ;; unconditionally
+ (defvar ,hook-name nil ,(format hook-doc name))
+ (add-to-list ',hook-name ',fn-name)
;; Handler function
(defun ,fn-name (proc parsed)
,fn-doc
@@ -1207,7 +1213,6 @@ add things to `%s' instead."
parsed 'notice 'active
'INVITE ?n nick ?u login ?h host ?c chnl)))))
-
(define-erc-response-handler (JOIN)
"Handle join messages."
nil
@@ -1243,7 +1248,7 @@ add things to `%s' instead."
(erc-format-message
'JOIN ?n nick ?u login ?h host ?c chnl))))))
(when buffer (set-buffer buffer))
- (erc-update-channel-member chnl nick nick t nil nil host login)
+ (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login)
;; on join, we want to stay in the new channel buffer
;;(set-buffer ob)
(erc-display-message parsed nil buffer str))))))
@@ -1412,7 +1417,7 @@ add things to `%s' instead."
;; message. We will accumulate private identities indefinitely
;; at this point.
(erc-update-channel-member (if privp nick tgt) nick nick
- privp nil nil host login nil nil t)
+ privp nil nil nil nil nil host login nil nil t)
(let ((cdata (erc-get-channel-user nick)))
(setq fnick (funcall erc-format-nick-function
(car cdata) (cdr cdata))))))
@@ -1465,11 +1470,10 @@ add things to `%s' instead."
"The channel topic has changed." nil
(let* ((ch (car (erc-response.command-args parsed)))
(topic (erc-trim-string (erc-response.contents parsed)))
- (time (format-time-string erc-server-timestamp-format
- (current-time))))
+ (time (format-time-string erc-server-timestamp-format)))
(pcase-let ((`(,nick ,login ,host)
(erc-parse-user (erc-response.sender parsed))))
- (erc-update-channel-member ch nick nick nil nil nil host login)
+ (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login)
(erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
(erc-display-message parsed 'notice (erc-get-buffer ch proc)
'TOPIC ?n nick ?u login ?h host
@@ -1537,7 +1541,7 @@ A server may send more than one 005 message."
(while (erc-response.command-args parsed)
(let ((section (pop (erc-response.command-args parsed))))
;; fill erc-server-parameters
- (when (string-match "^\\([A-Z]+\\)\=\\(.*\\)$\\|^\\([A-Z]+\\)$"
+ (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$"
section)
(add-to-list 'erc-server-parameters
`(,(or (match-string 1 section)
@@ -1799,8 +1803,7 @@ See `erc-display-server-message'." nil
(when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
(setq hopcount (match-string 1 full-name))
(setq full-name (match-string 2 full-name)))
- (erc-update-channel-member channel nick nick nil nil nil host
- user full-name)
+ (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name)
(erc-display-message parsed 'notice 'active 's352
?c channel ?n nick ?a away-flag
?u user ?h host ?f full-name))))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index ac8600c57fd..0e4c70944bb 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -1,9 +1,9 @@
;; erc-button.el --- A way of buttonizing certain things in ERC buffers -*- lexical-binding:t -*-
-;; Copyright (C) 1996-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: irc, button, url, regexp
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton
@@ -183,12 +183,14 @@ PAR is a number of a regexp grouping whose text will be passed to
'nicknames, these are ignored, and CALLBACK will be called with
the nickname matched as the argument."
:group 'erc-button
- :version "24.3" ; remove finger (bug#4443)
+ :version "24.1" ; remove finger (bug#4443)
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
regexp
(variable :tag "Variable containing regexp")
+ ;; FIXME It really does mean 'nicknames
+ ;; rather than just nicknames.
(const :tag "Nicknames" 'nicknames))
(integer :tag "Number of the regexp section that matches")
(choice :tag "When to buttonize"
@@ -267,7 +269,7 @@ specified by `erc-button-alist'."
(inhibit-point-motion-hooks t)
(inhibit-field-text-motion t)
(alist erc-button-alist)
- entry regexp data)
+ regexp)
(erc-button-remove-old-buttons)
(dolist (entry alist)
(if (equal (car entry) (quote (quote nicknames)))
@@ -407,7 +409,7 @@ REGEXP is the regular expression which matched for this button."
;; Since Emacs runs this directly, rather than with
;; widget-button-click, we need to fake an extra arg in the
;; interactive spec.
-(defun erc-button-click-button (ignore event)
+(defun erc-button-click-button (_ignore event)
"Call `erc-button-press-button'."
(interactive "P\ne")
(save-excursion
@@ -416,7 +418,7 @@ REGEXP is the regular expression which matched for this button."
;; XEmacs calls this via widget-button-press with a bunch of arguments
;; which we don't care about.
-(defun erc-button-press-button (&rest ignore)
+(defun erc-button-press-button (&rest _ignore)
"Check text at point for a callback function.
If the text at point has a `erc-callback' property,
call it with the value of the `erc-data' text property."
@@ -509,12 +511,13 @@ Examples:
(defun erc-nick-popup (nick)
(let* ((completion-ignore-case t)
- (action (completing-read (concat "What action to take on '" nick "'? ")
+ (action (completing-read (format-message
+ "What action to take on `%s'? " nick)
erc-nick-popup-alist))
(code (cdr (assoc action erc-nick-popup-alist))))
(when code
(erc-set-active-buffer (current-buffer))
- (eval code))))
+ (eval code `((nick . ,nick))))))
;;; Callback functions
(defun erc-button-describe-symbol (symbol-name)
@@ -535,8 +538,8 @@ and `apropos' for other symbols."
(- (car (current-time-zone)))))
(hours (mod (floor seconds 3600) 24))
(minutes (mod (round seconds 60) 60)))
- (message (format "@%s is %d:%02d local time"
- beats hours minutes))))
+ (message "@%s is %d:%02d local time"
+ beats hours minutes)))
(provide 'erc-button)
@@ -544,4 +547,3 @@ and `apropos' for other symbols."
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
-
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 4d22b2c5f50..4ddd88d5d5e 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -1,8 +1,8 @@
;;; erc-capab.el --- support for dancer-ircd and hyperion's CAPAB
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index b949f9a22cc..d8af692470e 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -1,9 +1,9 @@
;;; erc-compat.el --- ERC compatibility code for XEmacs
-;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; URL: http://www.emacswiki.org/cgi-bin/wiki/ERC
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index acb8febea80..0a9932ddc95 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -1,12 +1,12 @@
;;; erc-dcc.el --- CTCP DCC module for ERC
-;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2013 Free Software
+;; Copyright (C) 1993-1995, 1998, 2002-2004, 2006-2015 Free Software
;; Foundation, Inc.
;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
;; Noah Friedman <friedman@prep.ai.mit.edu>
;; Per Persson <pp@sno.pp.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, processes
;; Created: 1994-01-23
@@ -166,7 +166,7 @@ All values of the list must be uppercase strings.")
"Return the first matching entry in `erc-dcc-list' which satisfies the
constraints given as a plist in ARGS. Returns nil on no match.
-The property :nick is treated specially, if it contains a '!' character,
+The property :nick is treated specially, if it contains a `!' character,
it is treated as a nick!user@host string, and compared with the :nick property
value of the individual elements using string-equal. Otherwise it is
compared with `erc-nick-equal-p' which is IRC case-insensitive."
@@ -315,10 +315,10 @@ Should be set to a string or nil. If nil, use the value of
(defcustom erc-dcc-send-request 'ask
"How to treat incoming DCC Send requests.
-'ask - Report the Send request, and wait for the user to manually accept it
- You might want to set `erc-dcc-auto-masks' for this.
-'auto - Automatically accept the request and begin downloading the file
-'ignore - Ignore incoming DCC Send requests completely."
+`ask' - Report the Send request, and wait for the user to manually accept it
+ You might want to set `erc-dcc-auto-masks' for this.
+`auto' - Automatically accept the request and begin downloading the file
+`ignore' - Ignore incoming DCC Send requests completely."
:group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
@@ -379,7 +379,7 @@ created subprocess, or nil."
(set-process-filter-multibyte process nil)))))
(file-error
(unless (and (string= "Cannot bind server socket" (nth 1 err))
- (string= "address already in use" (nth 2 err)))
+ (string= "address already in use" (downcase (nth 2 err))))
(signal (car err) (cdr err)))
(setq port (1+ port))
(unless (< port upper)
@@ -594,14 +594,9 @@ It lists the current state of `erc-dcc-list' in an easy to read manner."
(get-buffer (plist-get elt :file))
(+ (buffer-size) 0.0
erc-dcc-byte-count))))
- (concat " ("
- (if (= byte-count 0)
- "0"
- (number-to-string
- (truncate
- (* 100
- (/ byte-count (plist-get elt :size))))))
- "%)"))))
+ (format " (%d%%)"
+ (floor (* 100.0 byte-count)
+ (plist-get elt :size))))))
?f (or (and (plist-member elt :file) (plist-get elt :file)) "")))
(erc-display-message
nil 'notice 'active
@@ -718,9 +713,9 @@ match, returns that regexp and nil otherwise."
(defcustom erc-dcc-chat-request 'ask
"How to treat incoming DCC Chat requests.
-'ask - Report the Chat request, and wait for the user to manually accept it
-'auto - Automatically accept the request and open a new chat window
-'ignore - Ignore incoming DCC chat requests completely."
+`ask' - Report the Chat request, and wait for the user to manually accept it
+`auto' - Automatically accept the request and open a new chat window
+`ignore' - Ignore incoming DCC chat requests completely."
:group 'erc-dcc
:type '(choice (const ask) (const auto) (const ignore)))
@@ -1264,4 +1259,3 @@ other client."
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
-
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index ac6c202b18a..f987597325b 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -1,6 +1,6 @@
;; erc-desktop-notifications.el -- Send notification on PRIVMSG or mentions
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm
@@ -46,12 +46,21 @@
:group 'erc-notifications
:type '(choice (const :tag "No icon" nil) file))
+(defcustom erc-notifications-bus :session
+ "D-Bus bus to use for notification."
+ :version "25.1"
+ :group 'erc-notifications
+ :type '(choice (const :tag "Session bus" :session) string))
+
+(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+
(defun erc-notifications-notify (nick msg)
"Notify that NICK send some MSG.
This will replace the last notification sent with this function."
(dbus-ignore-errors
(setq erc-notifications-last-notification
- (notifications-notify :title (xml-escape-string nick)
+ (notifications-notify :bus erc-notifications-bus
+ :title (xml-escape-string nick)
:body (xml-escape-string msg)
:replaces-id erc-notifications-last-notification
:app-icon erc-notifications-icon))))
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 32a4f39305a..de2a2ff6e76 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -1,9 +1,9 @@
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -78,7 +78,7 @@ The alist's format is as follows:
(defun erc-ezb-get-login (server port)
"Return an appropriate EZBounce login for SERVER and PORT.
Look up entries in `erc-ezb-login-alist'. If the username or password
-in the alist is `nil', prompt for the appropriate values."
+in the alist is nil, prompt for the appropriate values."
(let ((login (cdr (assoc (cons server port) erc-ezb-login-alist))))
(when login
(let ((username (car login))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 343143dc7b4..84816f80854 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -1,10 +1,10 @@
;;; erc-fill.el --- Filling IRC messages in various ways
-;; Copyright (C) 2001-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
;; Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling
;; This file is part of GNU Emacs.
@@ -101,7 +101,7 @@ function is called."
(defcustom erc-fill-static-center 27
"Column around which all statically filled messages will be
-centered. This column denotes the point where the ' ' character
+centered. This column denotes the point where the ` ' character
between <nickname> and the entered text will be put, thus aligning
nick names right and text left."
:group 'erc-fill
@@ -195,4 +195,3 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
-
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index e259c70b162..ca2d14a4675 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -1,9 +1,9 @@
;; erc-goodies.el --- Collection of ERC modules
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Most code is taken verbatim from erc.el, see there for the original
;; authors.
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 6810ab20b77..a2c43f2c385 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -1,9 +1,9 @@
;;; erc-ibuffer.el --- ibuffer integration with ERC
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcIbuffer
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index 4d624554a93..e79163fab55 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -1,9 +1,9 @@
;;; erc-identd.el --- RFC1413 (identd authentication protocol) server
-;; Copyright (C) 2003, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2006-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index 5e678b8bdd2..ccecc3b9070 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -1,10 +1,10 @@
;;; erc-imenu.el -- Imenu support for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2013 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2015 Free Software Foundation,
;; Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcImenu
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index b6e6dfc5253..4c99898bc41 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -1,9 +1,9 @@
;;; erc-join.el --- autojoin channels on connect and reconnects
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: irc
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoJoin
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index b6876da0ba8..d97abe9c05f 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -1,10 +1,10 @@
;;; erc-lang.el --- provide the LANG command to ERC
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
-;; Version: 1.0.0
+;; Maintainer: emacs-devel@gnu.org
+;; Old-Version: 1.0.0
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcLang
;; Keywords: comm languages processes
@@ -32,6 +32,9 @@
(require 'erc)
+;; FIXME: It's ISO 639-1, not ISO 638. ISO 638 is for paper, board and pulps.
+;; The Lisp variable should be renamed.
+
(defvar iso-638-languages
'(("aa" . "Afar")
("ab" . "Abkhazian")
@@ -42,7 +45,7 @@
("ay" . "Aymara")
("az" . "Azerbaijani")
("ba" . "Bashkir")
- ("be" . "Byelorussian")
+ ("be" . "Belarusian")
("bg" . "Bulgarian")
("bh" . "Bihari")
("bi" . "Bislama")
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index c243073790e..022895a93cf 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -1,10 +1,10 @@
;;; erc-list.el --- /list support for ERC -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
-;; Maintainer: FSF
-;; Version: 0.1
+;; Maintainer: emacs-devel@gnu.org
+;; Old-Version: 0.1
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -164,7 +164,8 @@
;; Handle a "322" response. This response tells us about a single
;; channel.
-(defun erc-list-handle-322 (proc parsed)
+;; Called via erc-once-with-server-event with two arguments.
+(defun erc-list-handle-322 (_proc parsed)
(let* ((args (cdr (erc-response.command-args parsed)))
(channel (car args))
(nusers (car (cdr args)))
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index c6ff8fa5bfe..f022284450a 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -1,9 +1,9 @@
;;; erc-log.el --- Logging facilities for ERC.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Lawrence Mitchell <wence@gmx.li>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: IRC, chat, client, Internet, logging
;; Created 2003-04-26
@@ -202,6 +202,7 @@ If you set this to nil, you may want to enable both
This should ideally, be a \"catch-all\" coding system, like
`emacs-mule', or `iso-2022-7bit'."
+ :type 'coding-system
:group 'erc-log)
(defcustom erc-log-filter-function nil
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 63683890226..0622b18ca7f 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -1,9 +1,9 @@
;;; erc-match.el --- Highlight messages matching certain regexps
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, faces
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch
@@ -84,17 +84,17 @@ Useful to mark nicks from dangerous hosts."
(defcustom erc-current-nick-highlight-type 'keyword
"Determines how to highlight text in which your current nickname appears
-\(does not apply to text sent by you\).
+\(does not apply to text sent by you).
The following values are allowed:
- nil - do not highlight the message at all
- 'keyword - highlight all instances of current nickname in message
- 'nick - highlight the nick of the user who typed your nickname
- '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
+ nil - do not highlight the message at all
+ `keyword' - highlight all instances of current nickname in message
+ `nick' - highlight the nick of the user who typed your nickname
+ `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
Any other value disables highlighting of current nickname altogether."
:group 'erc-match
@@ -110,9 +110,9 @@ 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
+ `all' - highlight the entire message from pal
Any other value disables pal highlighting altogether."
:group 'erc-match
@@ -126,9 +126,9 @@ 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
+ `all' - highlight the entire message from fool
Any other value disables fool highlighting altogether."
:group 'erc-match
@@ -142,8 +142,8 @@ See variable `erc-keywords'.
The following values are allowed:
- 'keyword - highlight keyword only
- 'all - highlight the entire message containing keyword
+ `keyword' - highlight keyword only
+ `all' - highlight the entire message containing keyword
Any other value disables keyword highlighting altogether."
:group 'erc-match
@@ -157,8 +157,8 @@ 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
+ `all' - highlight the entire message from dangerous-host
Any other value disables dangerous-host highlighting altogether."
:group 'erc-match
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index ab11df92063..0832fb891d5 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -1,9 +1,9 @@
;; erc-menu.el -- Menu-bar definitions for ERC
-;; Copyright (C) 2001-2002, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2002, 2004-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, processes, menu
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 7afbcd94273..35fa84f4176 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -1,9 +1,9 @@
;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 177f3714ae2..2891fe17be6 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1,9 +1,9 @@
;;; erc-networks.el --- IRC networks
-;; Copyright (C) 2002, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -588,7 +588,7 @@ PORTS is either a number, a list of numbers, or a list of port ranges."
(LagNet "lagnet.org.za")
(Librenet "librenet.net")
(LinkNet "link-net.org")
- (LinuxChix "cats\.meow\.at\\|linuxchix\.org")
+ (LinuxChix "cats\\.meow\\.at\\|linuxchix\\.org")
(Liquidized "liquidized.net")
(M-IRC "m-sys.org")
(MagicStar "magicstar.net")
@@ -724,16 +724,17 @@ MATCHER is used to find a corresponding network to a server while connected to
server parameter NETWORK if provided, otherwise parse the server name and
search for a match in `erc-networks-alist'."
;; The server made it easy for us and told us the name of the NETWORK
- (if (assoc "NETWORK" erc-server-parameters)
- (intern (cdr (assoc "NETWORK" erc-server-parameters)))
- (or
- ;; Loop through `erc-networks-alist' looking for a match.
- (let ((server (or erc-server-announced-name erc-session-server)))
- (cl-loop for (name matcher) in erc-networks-alist
- when (and matcher
- (string-match (concat matcher "\\'") server))
- do (cl-return name)))
- 'Unknown)))
+ (let ((network-name (cdr (assoc "NETWORK" erc-server-parameters))))
+ (if network-name
+ (intern network-name)
+ (or
+ ;; Loop through `erc-networks-alist' looking for a match.
+ (let ((server (or erc-server-announced-name erc-session-server)))
+ (cl-loop for (name matcher) in erc-networks-alist
+ when (and matcher
+ (string-match (concat matcher "\\'") server))
+ do (cl-return name)))
+ 'Unknown))))
(defun erc-network ()
"Return the value of `erc-network' for the current server."
@@ -781,9 +782,9 @@ PORTS should be a list of either:
numbers between LOW and HIGH (inclusive) is returned.
As an example:
- (erc-ports-list '(1)) => (1)
- (erc-ports-list '((1 5))) => (1 2 3 4 5)
- (erc-ports-list '(1 (3 5))) => (1 3 4 5)"
+ (erc-ports-list \\='(1)) => (1)
+ (erc-ports-list \\='((1 5))) => (1 2 3 4 5)
+ (erc-ports-list \\='(1 (3 5))) => (1 3 4 5)"
(let (result)
(dolist (p ports)
(cond ((numberp p)
@@ -865,4 +866,3 @@ VALUE is the options value.")
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 064bb53f215..24f44716f58 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -1,9 +1,9 @@
;;; erc-notify.el --- Online status change notification -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@lexx.delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index e667627cb01..b2083bebd4f 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -1,8 +1,8 @@
;; erc-page.el - CTCP PAGE support for ERC
-;; Copyright (C) 2002, 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2004, 2006-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 410a3c6d04c..e46ac68b259 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -1,9 +1,9 @@
;;; erc-pcomplete.el --- Provides programmable completion for ERC
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Sacha Chua <sacha@free.net.ph>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, convenience
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
@@ -33,7 +33,7 @@
;;
;; If you want nickname completions ordered such that the most recent
;; speakers are listed first, set
-;; `erc-pcomplete-order-nickname-completions' to `t'.
+;; `erc-pcomplete-order-nickname-completions' to t.
;;
;; See CREDITS for other contributors.
;;
@@ -80,13 +80,11 @@ for use on `completion-at-point-function'."
(defun erc-pcomplete ()
"Complete the nick before point."
+ (declare (obsolete completion-at-point "25.1"))
(interactive)
(when (> (point) (erc-beg-of-input-line))
- (let ((last-command (if (eq last-command 'erc-complete-word)
- 'pcomplete
- last-command)))
- (call-interactively 'pcomplete))
- t))
+ (let ((completion-at-point-functions '(erc-pcompletions-at-point)))
+ (completion-at-point))))
;;; Setup function
@@ -239,7 +237,7 @@ If optional argument IGNORE-SELF is non-nil, don't return the current nick."
"Returns a list of all nicks on the current server."
(let (nicks)
(erc-with-server-buffer
- (maphash (lambda (nick user)
+ (maphash (lambda (nick _user)
(setq nicks (cons (concat nick postfix) nicks)))
erc-server-users))
nicks))
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index c64fe479581..db9ac9dfc58 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -1,10 +1,10 @@
;; erc-replace.el -- wash and massage messages inserted into the buffer
-;; Copyright (C) 2001-2002, 2004, 2006-2013 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2015 Free Software Foundation,
;; Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: IRC, client, Internet
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index b4244eaa4a6..de988cc8275 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -1,9 +1,9 @@
;; erc-ring.el -- Command history handling for erc using ring.el
-;; Copyright (C) 2001-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcHistory
@@ -67,7 +67,8 @@ variable.")
(defun erc-input-ring-setup ()
"Do the setup required so that we can use comint style input rings.
Call this function when setting up the mode."
- (setq erc-input-ring (make-ring comint-input-ring-size))
+ (unless (ring-p erc-input-ring)
+ (setq erc-input-ring (make-ring comint-input-ring-size)))
(setq erc-input-ring-index nil))
(defun erc-add-to-input-ring (s)
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 1e3c3b17a23..274b01ffbd1 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -1,8 +1,8 @@
;;; erc-services.el --- Identify to NickServ
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -83,11 +83,11 @@ communication with those Services."
Possible settings are:.
-'autodetect - Identify when the real Nickserv sends an identify request.
-'nick-change - Identify when you log in or change your nickname.
-'both - Do the former if the network supports it, otherwise do the
- latter.
-nil - Disables automatic Nickserv identification.
+`autodetect' - Identify when the real Nickserv sends an identify request.
+`nick-change' - Identify when you log in or change your nickname.
+`both' - Do the former if the network supports it, otherwise do the
+ latter.
+nil - Disables automatic Nickserv identification.
You can also use M-x erc-nickserv-identify-mode to change modes."
:group 'erc-services
@@ -172,7 +172,7 @@ You can also use M-x erc-nickserv-identify-mode to change modes."
Example of use:
(setq erc-nickserv-passwords
- '((freenode ((\"nick-one\" . \"password\")
+ \\='((freenode ((\"nick-one\" . \"password\")
(\"nick-two\" . \"password\")))
(DALnet ((\"nick\" . \"password\")))))"
:group 'erc-services
@@ -280,7 +280,7 @@ Example of use:
"IDENTIFY" nil nil nil))
"Alist of NickServer details, sorted by network.
Every element in the list has the form
- \(SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP)
+ (SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER SUCCESS-REGEXP)
SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'.
NICKSERV is the description of the nickserv in the form nick!user@host.
@@ -447,4 +447,3 @@ When called interactively, read the password using `read-passwd'."
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index b0dd99955c4..06d96be2573 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -1,8 +1,8 @@
;;; erc-sound.el --- CTCP SOUND support for ERC
-;; Copyright (C) 2002-2003, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2006-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index af043bdb2c1..6015a6ac9fb 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -1,10 +1,10 @@
;;; erc-speedbar.el --- Speedbar support for ERC
-;; Copyright (C) 2001-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -48,9 +48,9 @@
(defcustom erc-speedbar-sort-users-type 'activity
"How channel nicknames are sorted.
-'activity - Sort users by channel activity
-'alphabetical - Sort users alphabetically
-nil - Do not sort users"
+`activity' - Sort users by channel activity
+`alphabetical' - Sort users alphabetically
+nil - Do not sort users"
:group 'erc-speedbar
:type '(choice (const :tag "Sort users by channel activity" activity)
(const :tag "Sort users alphabetically" alphabetical)
@@ -364,4 +364,3 @@ The INDENT level is ignored."
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 4866cacb99f..0cba956c429 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -1,9 +1,9 @@
;;; erc-spelling.el --- use flyspell in ERC
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Jorgen Schaefer <forcer@forcix.cx>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: irc
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcSpelling
@@ -71,7 +71,7 @@ The current buffer is given by BUFFER."
(if dicts
(cadr (car dicts))
(erc-with-server-buffer ispell-local-dictionary)))))
- (setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify)
+ (setq flyspell-generic-check-word-predicate #'erc-spelling-flyspell-verify)
(flyspell-mode 1)))
(defun erc-spelling-unhighlight-word (word)
@@ -85,6 +85,7 @@ The cadr is the beginning and the caddr is the end."
(defun erc-spelling-flyspell-verify ()
"Flyspell only the input line, nothing else."
+ ;; FIXME: Don't use `flyspell-word'!
(let ((word-data (and (boundp 'flyspell-word)
flyspell-word)))
(when word-data
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index b7306f9bcb3..d264c5960fe 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -1,9 +1,9 @@
;;; erc-stamp.el --- Timestamping for ERC messages
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, processes, timestamp
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp
@@ -114,7 +114,7 @@ If `erc-timestamp-format' is set, this will not be used."
(string)))
(defcustom erc-insert-away-timestamp-function
- 'erc-insert-timestamp-left-and-right
+ #'erc-insert-timestamp-left-and-right
"Function to use to insert the away timestamp.
See `erc-insert-timestamp-function' for details."
@@ -147,10 +147,11 @@ the minibuffer."
:group 'erc-stamp
:type 'string)
-(defcustom erc-timestamp-intangible t
+(defcustom erc-timestamp-intangible nil
"Whether the timestamps should be intangible, i.e. prevent the point
from entering them and instead jump over them."
:group 'erc-stamp
+ :version "24.5"
:type 'boolean)
(defface erc-timestamp-face '((t :weight bold :foreground "green"))
@@ -160,12 +161,12 @@ from entering them and instead jump over them."
;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
- ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
- (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t)
- (add-hook 'erc-send-modify-hook 'erc-add-timestamp t))
- ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
- (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp)
- (remove-hook 'erc-send-modify-hook 'erc-add-timestamp)))
+ ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
+ (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t)
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp t))
+ ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
+ (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
+ (remove-hook 'erc-send-modify-hook #'erc-add-timestamp)))
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
@@ -187,7 +188,8 @@ or `erc-send-modify-hook'."
(add-text-properties (point-min) (point-max)
(list 'timestamp ct))
(add-text-properties (point-min) (point-max)
- (list 'point-entered 'erc-echo-timestamp)))))
+ (list 'cursor-sensor-functions
+ (list #'erc-echo-timestamp))))))
(defvar erc-timestamp-last-inserted nil
"Last timestamp inserted into the buffer.")
@@ -288,8 +290,7 @@ be printed just before the window-width."
(setq erc-timestamp-last-inserted string)
(goto-char (point-max))
(forward-char -1);; before the last newline
- (let* ((current-window (get-buffer-window (current-buffer)))
- (str-width (string-width string))
+ (let* ((str-width (string-width string))
(pos (cond
(erc-timestamp-right-column erc-timestamp-right-column)
((and (boundp 'erc-fill-mode)
@@ -302,8 +303,7 @@ be printed just before the window-width."
(t
(- (window-width) str-width 1))))
(from (point))
- (col (current-column))
- indent)
+ (col (current-column)))
;; The following is a kludge used to calculate whether to move
;; to the next line before inserting a stamp. It allows for
;; some margin of error if what is displayed on the line differs
@@ -318,9 +318,9 @@ be printed just before the window-width."
(erc-put-text-property from (point) 'field 'erc-timestamp)
(erc-put-text-property from (point) 'rear-nonsticky t)
(when erc-timestamp-intangible
- (erc-put-text-property from (1+ (point)) 'intangible t)))))
+ (erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defun erc-insert-timestamp-left-and-right (string)
+(defun erc-insert-timestamp-left-and-right (_string)
"This is another function that can be assigned to
`erc-insert-timestamp-function'. If the date is changed, it will
print a blank line, the date, and another blank line. If the time is
@@ -355,7 +355,7 @@ Return the empty string if FORMAT is nil."
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
(not erc-hide-timestamps) ; bug#11706
- (erc-put-text-property 0 (length ts) 'intangible t ts))
+ (erc-put-text-property 0 (length ts) 'cursor-intangible t ts))
ts)
""))
@@ -365,15 +365,13 @@ Return the empty string if FORMAT is nil."
;; please modify this function and move it to a more appropriate
;; location.
(defun erc-munge-invisibility-spec ()
+ (and erc-timestamp-intangible (not (bound-and-true-p cursor-intangible-mode))
+ (cursor-intangible-mode 1))
+ (and erc-echo-timestamps (not (bound-and-true-p cursor-sensor-mode))
+ (cursor-sensor-mode 1))
(if erc-hide-timestamps
- (setq buffer-invisibility-spec
- (if (listp buffer-invisibility-spec)
- (cons 'timestamp buffer-invisibility-spec)
- (list 't 'timestamp)))
- (setq buffer-invisibility-spec
- (if (listp buffer-invisibility-spec)
- (remove 'timestamp buffer-invisibility-spec)
- (list 't)))))
+ (add-to-invisibility-spec 'timestamp)
+ (remove-from-invisibility-spec 'timestamp)))
(defun erc-hide-timestamps ()
"Hide timestamp information from display."
@@ -404,12 +402,11 @@ enabled when the message was inserted."
(erc-munge-invisibility-spec)))
(erc-buffer-list)))
-(defun erc-echo-timestamp (before now)
- "Print timestamp text-property of an IRC message.
-Argument BEFORE is where point was before it got moved and
-NOW is position of point currently."
- (when erc-echo-timestamps
- (let ((stamp (get-text-property now 'timestamp)))
+(defun erc-echo-timestamp (window _before dir)
+ "Print timestamp text-property of an IRC message."
+ (when (and erc-echo-timestamps (eq 'entered dir))
+ (let* ((now (window-point window))
+ (stamp (get-text-property now 'timestamp)))
(when stamp
(message "%s" (format-time-string erc-echo-timestamp-format
stamp))))))
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index e6d5b3119a2..2ebc1f22c09 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -1,9 +1,9 @@
;;; erc-track.el --- Track modified channel buffers -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, faces
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
@@ -248,10 +248,10 @@ The effect may be disabled by setting this variable to nil."
Setting this variable only has effects in GNU Emacs versions above 21.3.
Choices are:
-'before-modes - add to the beginning of `mode-line-modes',
-'after-modes - add to the end of `mode-line-modes',
-t - add to the end of `global-mode-string',
-nil - don't add to mode line."
+`before-modes' - add to the beginning of `mode-line-modes',
+`after-modes' - add to the end of `mode-line-modes',
+t - add to the end of `global-mode-string',
+nil - don't add to mode line."
:group 'erc-track
:type '(choice (const :tag "Just before mode information" before-modes)
(const :tag "Just after mode information" after-modes)
@@ -265,9 +265,7 @@ nil - don't add to mode line."
(erc-track-add-to-mode-line val))))
(defun erc-modified-channels-object (strings)
- "Generate a new `erc-modified-channels-object' based on STRINGS.
-If STRINGS is nil, we initialize `erc-modified-channels-object' to
-an appropriate initial value for this flavor of Emacs."
+ "Generate a new `erc-modified-channels-object' based on STRINGS."
(if strings
(if (featurep 'xemacs)
(let ((e-m-c-s '("[")))
@@ -743,7 +741,7 @@ only consider active buffers visible.")
(defvar erc-modified-channels-update-inside nil
"Variable to prevent running `erc-modified-channels-update' multiple
times. Without it, you cannot debug `erc-modified-channels-display',
-because the debugger also cases changes to the window-configuration.")
+because the debugger also causes changes to the window-configuration.")
(defun erc-modified-channels-update (&rest _args)
"This function updates the information in `erc-modified-channels-alist'
@@ -767,8 +765,7 @@ ARGS are ignored."
(erc-modified-channels-remove-buffer buffer))))
erc-modified-channels-alist)
(when removed-channel
- (erc-modified-channels-display)
- (force-mode-line-update t)))
+ (erc-modified-channels-display)))
(remove-hook 'post-command-hook 'erc-modified-channels-update)))
(defvar erc-track-mouse-face (if (featurep 'xemacs)
@@ -825,43 +822,45 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
((eq 'importance erc-track-switch-direction)
(erc-track-sort-by-importance)))
(run-hooks 'erc-track-list-changed-hook)
- (unless (eq erc-track-position-in-mode-line nil)
- (if (null erc-modified-channels-alist)
- (setq erc-modified-channels-object (erc-modified-channels-object nil))
- ;; erc-modified-channels-alist contains all the data we need. To
- ;; better understand what is going on, we split things up into
- ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
- ;; four lists we use to create a new
- ;; `erc-modified-channels-object' using
- ;; `erc-make-mode-line-buffer-name'.
- (let* ((buffers (mapcar 'car erc-modified-channels-alist))
- (counts (mapcar 'cadr erc-modified-channels-alist))
- (faces (mapcar 'cddr erc-modified-channels-alist))
- (long-names (mapcar #'(lambda (buf)
- (or (buffer-name buf)
- ""))
- buffers))
- (short-names (if (functionp erc-track-shorten-function)
- (funcall erc-track-shorten-function
- long-names)
- long-names))
- strings)
- (while buffers
- (when (car short-names)
- (setq strings (cons (erc-make-mode-line-buffer-name
- (car short-names)
- (car buffers)
- (car faces)
- (car counts))
- strings)))
- (setq short-names (cdr short-names)
- buffers (cdr buffers)
- counts (cdr counts)
- faces (cdr faces)))
- (when (featurep 'xemacs)
- (erc-modified-channels-object nil))
- (setq erc-modified-channels-object
- (erc-modified-channels-object strings))))))
+ (when erc-track-position-in-mode-line
+ (let* ((oldobject erc-modified-channels-object)
+ (strings
+ (when erc-modified-channels-alist
+ ;; erc-modified-channels-alist contains all the data we need. To
+ ;; better understand what is going on, we split things up into
+ ;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
+ ;; four lists we use to create a new
+ ;; `erc-modified-channels-object' using
+ ;; `erc-make-mode-line-buffer-name'.
+ (let* ((buffers (mapcar 'car erc-modified-channels-alist))
+ (counts (mapcar 'cadr erc-modified-channels-alist))
+ (faces (mapcar 'cddr erc-modified-channels-alist))
+ (long-names (mapcar #'(lambda (buf)
+ (or (buffer-name buf)
+ ""))
+ buffers))
+ (short-names (if (functionp erc-track-shorten-function)
+ (funcall erc-track-shorten-function
+ long-names)
+ long-names))
+ strings)
+ (while buffers
+ (when (car short-names)
+ (setq strings (cons (erc-make-mode-line-buffer-name
+ (car short-names)
+ (car buffers)
+ (car faces)
+ (car counts))
+ strings)))
+ (setq short-names (cdr short-names)
+ buffers (cdr buffers)
+ counts (cdr counts)
+ faces (cdr faces)))
+ strings)))
+ (newobject (erc-modified-channels-object strings)))
+ (unless (equal-including-properties oldobject newobject)
+ (setq erc-modified-channels-object newobject)
+ (force-mode-line-update t)))))
(defun erc-modified-channels-remove-buffer (buffer)
"Remove BUFFER from `erc-modified-channels-alist'."
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index f17968fc59d..9a58288a4f5 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -1,9 +1,9 @@
;;; erc-truncate.el --- Functions for truncating ERC buffers
-;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Andreas Fuchs <asf@void.at>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: IRC, chat, client, Internet, logging
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 74a6943023f..c129336f1ed 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -1,9 +1,9 @@
;;; erc-xdcc.el --- XDCC file-server support for ERC
-;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, processes
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0bfd21d6c3a..8e26db1d9d3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1,6 +1,6 @@
;; erc.el --- An Emacs Internet Relay Chat client -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Alexander L. Belikoff (alexander@belikoff.net)
;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
@@ -9,8 +9,10 @@
;; Andreas Fuchs (afs@void.at)
;; Gergely Nagy (algernon@midgard.debian.net)
;; David Edmondson (dme@dme.org)
-;; Maintainer: FSF
+;; Kelvin White (kwhite@gnu.org)
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: IRC, chat, client, Internet
+
;; Version: 5.3
;; This file is part of GNU Emacs.
@@ -36,15 +38,13 @@
;; * http://sv.gnu.org/projects/erc/
;; * http://www.emacswiki.org/cgi-bin/wiki/ERC
+
+
;; As of 2006-06-13, ERC development is now hosted on Savannah
;; (http://sv.gnu.org/projects/erc). I invite everyone who wants to
;; hack on it to contact me <mwolson@gnu.org> in order to get write
;; access to the shared Arch archive.
-;; Installation:
-
-;; Put erc.el in your load-path, and put (require 'erc) in your .emacs.
-
;; Configuration:
;; Use M-x customize-group RET erc RET to get an overview
@@ -62,11 +62,11 @@
;;; History:
;;
-;;; Code:
-
-(defconst erc-version-string "Version 5.3"
+(defconst erc-version-string (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version)
"ERC version. This is used by function `erc-version'.")
+;;; Code:
+
(eval-when-compile (require 'cl-lib))
(require 'font-lock)
(require 'pp)
@@ -81,6 +81,7 @@
(defgroup erc nil
"Emacs Internet Relay Chat client."
:link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/ERC")
+ :link '(custom-manual "(erc) Top")
:prefix "erc-"
:group 'applications)
@@ -142,7 +143,7 @@ See function `erc-compute-server' for more details on connection
parameters and authentication."
:group 'erc
:type '(choice (const :tag "None" nil)
- (string :tag "Server")))
+ (string :tag "Server")))
(defcustom erc-port nil
"IRC port to use if not specified.
@@ -150,8 +151,8 @@ parameters and authentication."
This can be either a string or a number."
:group 'erc
:type '(choice (const :tag "None" nil)
- (integer :tag "Port number")
- (string :tag "Port string")))
+ (integer :tag "Port number")
+ (string :tag "Port string")))
(defcustom erc-nick nil
"Nickname to use if one is not provided.
@@ -164,8 +165,8 @@ See function `erc-compute-nick' for more details on connection
parameters and authentication."
:group 'erc
:type '(choice (const :tag "None" nil)
- (string :tag "Nickname")
- (repeat (string :tag "Nickname"))))
+ (string :tag "Nickname")
+ (repeat (string :tag "Nickname"))))
(defcustom erc-nick-uniquifier "`"
"The string to append to the nick if it is already in use."
@@ -189,10 +190,16 @@ See function `erc-compute-full-name' for more details on connection
parameters and authentication."
:group 'erc
:type '(choice (const :tag "No name" nil)
- (string :tag "Name")
- (function :tag "Get from function"))
+ (string :tag "Name")
+ (function :tag "Get from function"))
:set (lambda (sym val)
- (set sym (if (functionp val) (funcall val) val))))
+ (set sym (if (functionp val) (funcall val) val))))
+
+(defcustom erc-rename-buffers nil
+ "Non-nil means rename buffers with network name, if available."
+ :version "24.5"
+ :group 'erc
+ :type 'boolean)
(defvar erc-password nil
"Password to use when authenticating to an IRC server.
@@ -223,7 +230,7 @@ prompt you for it.")
(defcustom erc-hide-prompt nil
"If non-nil, do not display the prompt for commands.
-\(A command is any input starting with a '/').
+\(A command is any input starting with a `/').
See also the variables `erc-prompt' and `erc-command-indicator'."
:group 'erc-display
@@ -242,16 +249,30 @@ If nil, only \"> \" will be shown."
(define-widget 'erc-message-type 'set
"A set of standard IRC Message types."
:args '((const "JOIN")
- (const "KICK")
- (const "NICK")
- (const "PART")
- (const "QUIT")
- (const "MODE")
- (repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
+ (const "KICK")
+ (const "NICK")
+ (const "PART")
+ (const "QUIT")
+ (const "MODE")
+ (repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
(defcustom erc-hide-list nil
- "List of IRC type messages to hide.
-A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")."
+ "A global list of IRC message types to hide.
+A typical value would be \(\"JOIN\" \"PART\" \"QUIT\")."
+ :group 'erc-ignore
+ :type 'erc-message-type)
+
+(defcustom erc-network-hide-list nil
+ "A list of IRC networks to hide message types from.
+A typical value would be \((\"freenode\" \"MODE\")
+(\"OFTC\" \"JOIN\" \"QUIT\"))."
+ :group 'erc-ignore
+ :type 'erc-message-type)
+
+(defcustom erc-channel-hide-list nil
+ "A list of IRC channels to hide message types from.
+A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\")
+(\"#erc\" \"NICK\")."
:group 'erc-ignore
:type 'erc-message-type)
@@ -338,14 +359,14 @@ nicknames with erc-server-user struct instances.")
(defun erc-downcase (string)
"Convert STRING to IRC standard conforming downcase."
(let ((s (downcase string))
- (c '((?\[ . ?\{)
- (?\] . ?\})
- (?\\ . ?\|)
- (?~ . ?^))))
+ (c '((?\[ . ?\{)
+ (?\] . ?\})
+ (?\\ . ?\|)
+ (?~ . ?^))))
(save-match-data
(while (string-match "[]\\[~]" s)
- (aset s (match-beginning 0)
- (cdr (assq (aref s (match-beginning 0)) c)))))
+ (aset s (match-beginning 0)
+ (cdr (assq (aref s (match-beginning 0)) c)))))
s))
(defmacro erc-with-server-buffer (&rest body)
@@ -355,8 +376,8 @@ If no server buffer exists, return nil."
(let ((buffer (make-symbol "buffer")))
`(let ((,buffer (erc-server-buffer)))
(when (buffer-live-p ,buffer)
- (with-current-buffer ,buffer
- ,@body)))))
+ (with-current-buffer ,buffer
+ ,@body)))))
(cl-defstruct (erc-server-user (:type vector) :named)
;; User data
@@ -369,7 +390,7 @@ If no server buffer exists, return nil."
)
(cl-defstruct (erc-channel-user (:type vector) :named)
- op voice
+ voice halfop op admin owner
;; Last message time (in the form of the return value of
;; (current-time)
;;
@@ -418,11 +439,11 @@ other buffers are also changed."
(puthash (erc-downcase new-nick) user erc-server-users))
(dolist (buf (erc-server-user-buffers user))
(if (buffer-live-p buf)
- (with-current-buffer buf
- (let ((cdata (erc-get-channel-user nick)))
- (remhash (erc-downcase nick) erc-channel-users)
- (puthash (erc-downcase new-nick) cdata
- erc-channel-users)))))))
+ (with-current-buffer buf
+ (let ((cdata (erc-get-channel-user nick)))
+ (remhash (erc-downcase nick) erc-channel-users)
+ (puthash (erc-downcase new-nick) cdata
+ erc-channel-users)))))))
(defun erc-remove-channel-user (nick)
"This function is for internal use only.
@@ -436,12 +457,12 @@ See also: `erc-remove-server-user' and `erc-remove-user'."
(let ((channel-data (erc-get-channel-user nick)))
(when channel-data
(let ((user (car channel-data)))
- (setf (erc-server-user-buffers user)
- (delq (current-buffer)
- (erc-server-user-buffers user)))
- (remhash (erc-downcase nick) erc-channel-users)
- (if (null (erc-server-user-buffers user))
- (erc-remove-server-user nick))))))
+ (setf (erc-server-user-buffers user)
+ (delq (current-buffer)
+ (erc-server-user-buffers user)))
+ (remhash (erc-downcase nick) erc-channel-users)
+ (if (null (erc-server-user-buffers user))
+ (erc-remove-server-user nick))))))
(defun erc-remove-user (nick)
"This function is for internal use only.
@@ -454,11 +475,11 @@ See also: `erc-remove-server-user' and
(let ((user (erc-get-server-user nick)))
(when user
(let ((buffers (erc-server-user-buffers user)))
- (dolist (buf buffers)
- (if (buffer-live-p buf)
- (with-current-buffer buf
- (remhash (erc-downcase nick) erc-channel-users)
- (run-hooks 'erc-channel-members-changed-hook)))))
+ (dolist (buf buffers)
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (remhash (erc-downcase nick) erc-channel-users)
+ (run-hooks 'erc-channel-members-changed-hook)))))
(erc-remove-server-user nick))))
(defun erc-remove-channel-users ()
@@ -467,28 +488,52 @@ See also: `erc-remove-server-user' and
Removes all users in the current channel. This is called by
`erc-server-PART' and `erc-server-QUIT'."
(when (and erc-server-connected
- (erc-server-process-alive)
- (hash-table-p erc-channel-users))
+ (erc-server-process-alive)
+ (hash-table-p erc-channel-users))
(maphash (lambda (nick _cdata)
- (erc-remove-channel-user nick))
- erc-channel-users)
+ (erc-remove-channel-user nick))
+ erc-channel-users)
(clrhash erc-channel-users)))
+(defsubst erc-channel-user-owner-p (nick)
+ "Return non-nil if NICK is an owner of the current channel."
+ (and nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-owner (cdr cdata))))))
+
+(defsubst erc-channel-user-admin-p (nick)
+ "Return non-nil if NICK is an admin in the current channel."
+ (and nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-admin (cdr cdata))))))
+
(defsubst erc-channel-user-op-p (nick)
- "Return t if NICK is an operator in the current channel."
+ "Return non-nil if NICK is an operator in the current channel."
+ (and nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-op (cdr cdata))))))
+
+(defsubst erc-channel-user-halfop-p (nick)
+ "Return non-nil if NICK is a half-operator in the current channel."
(and nick
(hash-table-p erc-channel-users)
(let ((cdata (erc-get-channel-user nick)))
- (and cdata (cdr cdata)
- (erc-channel-user-op (cdr cdata))))))
+ (and cdata (cdr cdata)
+ (erc-channel-user-halfop (cdr cdata))))))
(defsubst erc-channel-user-voice-p (nick)
- "Return t if NICK has voice in the current channel."
+ "Return non-nil if NICK has voice in the current channel."
(and nick
(hash-table-p erc-channel-users)
(let ((cdata (erc-get-channel-user nick)))
- (and cdata (cdr cdata)
- (erc-channel-user-voice (cdr cdata))))))
+ (and cdata (cdr cdata)
+ (erc-channel-user-voice (cdr cdata))))))
(defun erc-get-channel-user-list ()
"Return a list of users in the current channel. Each element
@@ -499,9 +544,9 @@ erc-channel-user struct.
See also: `erc-sort-channel-users-by-activity'"
(let (users)
(if (hash-table-p erc-channel-users)
- (maphash (lambda (_nick cdata)
- (setq users (cons cdata users)))
- erc-channel-users))
+ (maphash (lambda (_nick cdata)
+ (setq users (cons cdata users)))
+ erc-channel-users))
users))
(defun erc-get-server-nickname-list ()
@@ -509,22 +554,22 @@ See also: `erc-sort-channel-users-by-activity'"
(erc-with-server-buffer
(let (nicks)
(when (hash-table-p erc-server-users)
- (maphash (lambda (_n user)
- (setq nicks
- (cons (erc-server-user-nickname user)
- nicks)))
- erc-server-users)
- nicks))))
+ (maphash (lambda (_n user)
+ (setq nicks
+ (cons (erc-server-user-nickname user)
+ nicks)))
+ erc-server-users)
+ nicks))))
(defun erc-get-channel-nickname-list ()
"Return a list of known nicknames on the current channel."
(let (nicks)
(when (hash-table-p erc-channel-users)
(maphash (lambda (_n cdata)
- (setq nicks
- (cons (erc-server-user-nickname (car cdata))
- nicks)))
- erc-channel-users)
+ (setq nicks
+ (cons (erc-server-user-nickname (car cdata))
+ nicks)))
+ erc-channel-users)
nicks)))
(defun erc-get-server-nickname-alist ()
@@ -532,22 +577,22 @@ See also: `erc-sort-channel-users-by-activity'"
(erc-with-server-buffer
(let (nicks)
(when (hash-table-p erc-server-users)
- (maphash (lambda (_n user)
- (setq nicks
- (cons (cons (erc-server-user-nickname user) nil)
- nicks)))
- erc-server-users)
- nicks))))
+ (maphash (lambda (_n user)
+ (setq nicks
+ (cons (cons (erc-server-user-nickname user) nil)
+ nicks)))
+ erc-server-users)
+ nicks))))
(defun erc-get-channel-nickname-alist ()
"Return an alist of known nicknames on the current channel."
(let (nicks)
(when (hash-table-p erc-channel-users)
(maphash (lambda (_n cdata)
- (setq nicks
- (cons (cons (erc-server-user-nickname (car cdata)) nil)
- nicks)))
- erc-channel-users)
+ (setq nicks
+ (cons (cons (erc-server-user-nickname (car cdata)) nil)
+ nicks)))
+ erc-channel-users)
nicks)))
(defun erc-sort-channel-users-by-activity (list)
@@ -556,13 +601,13 @@ LIST must be of the form (USER . CHANNEL-DATA).
See also: `erc-get-channel-user-list'."
(sort list
- (lambda (x y)
- (when (and (cdr x) (cdr y))
- (let ((tx (erc-channel-user-last-message-time (cdr x)))
- (ty (erc-channel-user-last-message-time (cdr y))))
- (and tx
- (or (not ty)
- (time-less-p ty tx))))))))
+ (lambda (x y)
+ (when (and (cdr x) (cdr y))
+ (let ((tx (erc-channel-user-last-message-time (cdr x)))
+ (ty (erc-channel-user-last-message-time (cdr y))))
+ (and tx
+ (or (not ty)
+ (time-less-p ty tx))))))))
(defun erc-sort-channel-users-alphabetically (list)
"Sort LIST so that users' nicknames are in alphabetical order.
@@ -570,13 +615,13 @@ LIST must be of the form (USER . CHANNEL-DATA).
See also: `erc-get-channel-user-list'."
(sort list
- (lambda (x y)
- (when (and (cdr x) (cdr y))
- (let ((nickx (downcase (erc-server-user-nickname (car x))))
- (nicky (downcase (erc-server-user-nickname (car y)))))
- (and nickx
- (or (not nicky)
- (string-lessp nickx nicky))))))))
+ (lambda (x y)
+ (when (and (cdr x) (cdr y))
+ (let ((nickx (downcase (erc-server-user-nickname (car x))))
+ (nicky (downcase (erc-server-user-nickname (car y)))))
+ (and nickx
+ (or (not nicky)
+ (string-lessp nickx nicky))))))))
(defvar erc-channel-topic nil
"A topic string for the channel. Should only be used in channel-buffers.")
@@ -612,17 +657,17 @@ E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\")
See also the variable `erc-prompt'."
(let ((prompt (if (functionp erc-prompt)
- (funcall erc-prompt)
- erc-prompt)))
+ (funcall erc-prompt)
+ erc-prompt)))
(if (> (length prompt) 0)
- (concat prompt " ")
+ (concat prompt " ")
prompt)))
(defcustom erc-command-indicator nil
"Indicator used by ERC for showing commands.
If non-nil, this will be used in the ERC buffer to indicate
-commands (i.e., input starting with a '/').
+commands (i.e., input starting with a `/').
If nil, the prompt will be constructed from the variable `erc-prompt'."
:group 'erc-display
@@ -634,11 +679,11 @@ If nil, the prompt will be constructed from the variable `erc-prompt'."
This only has any meaning if the variable `erc-command-indicator' is non-nil."
(and erc-command-indicator
(let ((prompt (if (functionp erc-command-indicator)
- (funcall erc-command-indicator)
- erc-command-indicator)))
- (if (> (length prompt) 0)
- (concat prompt " ")
- prompt))))
+ (funcall erc-command-indicator)
+ erc-command-indicator)))
+ (if (> (length prompt) 0)
+ (concat prompt " ")
+ prompt))))
(defcustom erc-notice-prefix "*** "
"Prefix for all notices."
@@ -651,14 +696,14 @@ See `erc-notice-prefix'.
The following values are allowed:
- 'prefix - highlight notice prefix only
- 'all - highlight the entire notice
+ `prefix' - highlight notice prefix only
+ `all' - highlight the entire notice
Any other value disables notice's highlighting altogether."
:group 'erc-display
:type '(choice (const :tag "highlight notice prefix only" prefix)
- (const :tag "highlight the entire notice" all)
- (const :tag "don't highlight notices at all" nil)))
+ (const :tag "highlight the entire notice" all)
+ (const :tag "don't highlight notices at all" nil)))
(defcustom erc-echo-notice-hook nil
"List of functions to call to echo a private notice.
@@ -681,14 +726,14 @@ See also: `erc-echo-notice-always-hook',
:group 'erc-hooks
:type 'hook
:options '(erc-echo-notice-in-default-buffer
- erc-echo-notice-in-target-buffer
- erc-echo-notice-in-minibuffer
- erc-echo-notice-in-server-buffer
- erc-echo-notice-in-active-non-server-buffer
- erc-echo-notice-in-active-buffer
- erc-echo-notice-in-user-buffers
- erc-echo-notice-in-user-and-target-buffers
- erc-echo-notice-in-first-user-buffer))
+ erc-echo-notice-in-target-buffer
+ erc-echo-notice-in-minibuffer
+ erc-echo-notice-in-server-buffer
+ erc-echo-notice-in-active-non-server-buffer
+ erc-echo-notice-in-active-buffer
+ erc-echo-notice-in-user-buffers
+ erc-echo-notice-in-user-and-target-buffers
+ erc-echo-notice-in-first-user-buffer))
(defcustom erc-echo-notice-always-hook
'(erc-echo-notice-in-default-buffer)
@@ -712,14 +757,14 @@ See also: `erc-echo-notice-hook',
:group 'erc-hooks
:type 'hook
:options '(erc-echo-notice-in-default-buffer
- erc-echo-notice-in-target-buffer
- erc-echo-notice-in-minibuffer
- erc-echo-notice-in-server-buffer
- erc-echo-notice-in-active-non-server-buffer
- erc-echo-notice-in-active-buffer
- erc-echo-notice-in-user-buffers
- erc-echo-notice-in-user-and-target-buffers
- erc-echo-notice-in-first-user-buffer))
+ erc-echo-notice-in-target-buffer
+ erc-echo-notice-in-minibuffer
+ erc-echo-notice-in-server-buffer
+ erc-echo-notice-in-active-non-server-buffer
+ erc-echo-notice-in-active-buffer
+ erc-echo-notice-in-user-buffers
+ erc-echo-notice-in-user-and-target-buffers
+ erc-echo-notice-in-first-user-buffer))
;; other tunable parameters
@@ -746,7 +791,7 @@ Many consider it impolite to do so automatically."
"The nickname to take when you are marked as being away."
:group 'erc
:type '(choice (const nil)
- string))
+ string))
(defcustom erc-paranoid nil
"If non-nil, then all incoming CTCP requests will be shown."
@@ -781,7 +826,7 @@ set if some hacker is trying to flood you away."
If nil, ERC will call `system-name' to get this information."
:group 'erc
:type '(choice (const :tag "Default system name" nil)
- string))
+ string))
(defcustom erc-ignore-list nil
"List of regexps matching user identifiers to ignore.
@@ -823,8 +868,8 @@ See `erc-server-flood-margin' for other flood-related parameters.")
(defcustom erc-startup-file-list
(list (concat erc-user-emacs-directory ".ercrc.el")
- (concat erc-user-emacs-directory ".ercrc")
- "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
+ (concat erc-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.
@@ -882,10 +927,10 @@ If no elements match, then the empty string is used.
As an example:
(setq erc-quit-reason-various-alist
- '((\"xmms\" dme:now-playing)
- (\"version\" erc-quit-reason-normal)
- (\"home\" \"Gone home !\")
- (\"^$\" \"Default Reason\")))
+ \\='((\"xmms\" dme:now-playing)
+ (\"version\" erc-quit-reason-normal)
+ (\"home\" \"Gone home !\")
+ (\"^$\" \"Default Reason\")))
If the user types \"/quit home\", then \"Gone home !\" will be used
as the quit message."
:group 'erc-quit-and-part
@@ -905,10 +950,10 @@ If no elements match, then the empty string is used.
As an example:
(setq erc-part-reason-various-alist
- '((\"xmms\" dme:now-playing)
- (\"version\" erc-part-reason-normal)
- (\"home\" \"Gone home !\")
- (\"^$\" \"Default Reason\")))
+ \\='((\"xmms\" dme:now-playing)
+ (\"version\" erc-part-reason-normal)
+ (\"home\" \"Gone home !\")
+ (\"^$\" \"Default Reason\")))
If the user types \"/part home\", then \"Gone home !\" will be used
as the part message."
:group 'erc-quit-and-part
@@ -921,8 +966,8 @@ The function is passed a single argument, the string typed by the
user after \"/quit\"."
:group 'erc-quit-and-part
:type '(choice (const erc-quit-reason-normal)
- (const erc-quit-reason-various)
- (symbol)))
+ (const erc-quit-reason-various)
+ (symbol)))
(defcustom erc-part-reason 'erc-part-reason-normal
"A function which returns the reason for parting a channel.
@@ -931,8 +976,8 @@ The function is passed a single argument, the string typed by the
user after \"/PART\"."
:group 'erc-quit-and-part
:type '(choice (const erc-part-reason-normal)
- (const erc-part-reason-various)
- (symbol)))
+ (const erc-part-reason-various)
+ (symbol)))
(defvar erc-grab-buffer-name "*erc-grab*"
"The name of the buffer created by `erc-grab-region'.")
@@ -974,7 +1019,7 @@ display of that particular string at all."
"Hook called first when some text is sent through `erc-send-current-line'.
It gets called with one argument, STRING.
-To change the text that will be sent, set the variable STR which is
+To change the text that will be sent, set the variable `str' which is
used in `erc-send-current-line'.
To change the text inserted into the buffer without changing the text
@@ -1016,8 +1061,8 @@ At this point, all modifications from prior hook functions are done."
:group 'erc-hooks
:type 'hook
:options '(erc-truncate-buffer
- erc-make-read-only
- erc-save-buffer-in-logs))
+ erc-make-read-only
+ erc-save-buffer-in-logs))
(defcustom erc-send-modify-hook nil
"Sending hook for functions that will change the text's appearance.
@@ -1047,8 +1092,8 @@ This function is called with narrowing, ala `erc-send-modify-hook'."
(defcustom erc-send-completed-hook
(when (fboundp 'emacspeak-auditory-icon)
(list (byte-compile
- (lambda (_str)
- (emacspeak-auditory-icon 'select-object)))))
+ (lambda (_str)
+ (emacspeak-auditory-icon 'select-object)))))
"Hook called after a message has been parsed by ERC.
The single argument to the functions is the unmodified string
@@ -1078,7 +1123,7 @@ which the local user typed."
(define-key map "\C-a" 'erc-bol)
(define-key map [home] 'erc-bol)
(define-key map "\C-c\C-a" 'erc-bol)
- (define-key map "\C-c\C-b" 'erc-iswitchb)
+ (define-key map "\C-c\C-b" 'erc-switch-to-buffer)
(define-key map "\C-c\C-c" 'erc-toggle-interpret-controls)
(define-key map "\C-c\C-d" 'erc-input-action)
(define-key map "\C-c\C-e" 'erc-toggle-ctcp-autoresponse)
@@ -1117,10 +1162,19 @@ which the local user typed."
"Faces for ERC."
:group 'erc)
+;; FIXME faces should not end in "-face".
(defface erc-default-face '((t))
"ERC default face."
:group 'erc-faces)
+(defface erc-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold))
+ "ERC face used for user mode prefix."
+ :group 'erc-faces)
+
+(defface erc-my-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold))
+ "ERC face used for my user mode prefix."
+ :group 'erc-faces)
+
(defface erc-direct-msg-face '((t :foreground "IndianRed"))
"ERC face used for messages you receive in the main erc buffer."
:group 'erc-faces)
@@ -1188,7 +1242,7 @@ See also `erc-show-my-nick'."
(make-variable-buffer-local 'erc-dbuf)
(defmacro define-erc-module (name alias doc enable-body disable-body
- &optional local-p)
+ &optional local-p)
"Define a new minor mode using ERC conventions.
Symbol NAME is the name of the module.
Symbol ALIAS is the alias to use, or nil.
@@ -1204,54 +1258,54 @@ erc-NAME-enable, and erc-NAME-disable.
Example:
- ;;;###autoload (autoload 'erc-replace-mode \"erc-replace\")
+ ;;;###autoload (autoload \\='erc-replace-mode \"erc-replace\")
(define-erc-module replace nil
\"This mode replaces incoming text according to `erc-replace-alist'.\"
- ((add-hook 'erc-insert-modify-hook
- 'erc-replace-insert))
- ((remove-hook 'erc-insert-modify-hook
- 'erc-replace-insert)))"
+ ((add-hook \\='erc-insert-modify-hook
+ \\='erc-replace-insert))
+ ((remove-hook \\='erc-insert-modify-hook
+ \\='erc-replace-insert)))"
(declare (doc-string 3))
(let* ((sn (symbol-name name))
- (mode (intern (format "erc-%s-mode" (downcase sn))))
- (group (intern (format "erc-%s" (downcase sn))))
- (enable (intern (format "erc-%s-enable" (downcase sn))))
- (disable (intern (format "erc-%s-disable" (downcase sn)))))
+ (mode (intern (format "erc-%s-mode" (downcase sn))))
+ (group (intern (format "erc-%s" (downcase sn))))
+ (enable (intern (format "erc-%s-enable" (downcase sn))))
+ (disable (intern (format "erc-%s-disable" (downcase sn)))))
`(progn
(erc-define-minor-mode
- ,mode
- ,(format "Toggle ERC %S mode.
+ ,mode
+ ,(format "Toggle ERC %S mode.
With a prefix argument ARG, enable %s if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
%s" name name doc)
- nil nil nil
- :global ,(not local-p) :group (quote ,group)
- (if ,mode
- (,enable)
- (,disable)))
+ nil nil nil
+ :global ,(not local-p) :group (quote ,group)
+ (if ,mode
+ (,enable)
+ (,disable)))
(defun ,enable ()
- ,(format "Enable ERC %S mode."
- name)
- (interactive)
- (add-to-list 'erc-modules (quote ,name))
- (setq ,mode t)
- ,@enable-body)
+ ,(format "Enable ERC %S mode."
+ name)
+ (interactive)
+ (add-to-list 'erc-modules (quote ,name))
+ (setq ,mode t)
+ ,@enable-body)
(defun ,disable ()
- ,(format "Disable ERC %S mode."
- name)
- (interactive)
- (setq erc-modules (delq (quote ,name) erc-modules))
- (setq ,mode nil)
- ,@disable-body)
+ ,(format "Disable ERC %S mode."
+ name)
+ (interactive)
+ (setq erc-modules (delq (quote ,name) erc-modules))
+ (setq ,mode nil)
+ ,@disable-body)
,(when (and alias (not (eq name alias)))
- `(defalias
- (quote
- ,(intern
- (format "erc-%s-mode"
- (downcase (symbol-name alias)))))
- (quote
- ,mode)))
+ `(defalias
+ (quote
+ ,(intern
+ (format "erc-%s-mode"
+ (downcase (symbol-name alias)))))
+ (quote
+ ,mode)))
;; For find-function and find-variable.
(put ',mode 'definition-name ',name)
(put ',enable 'definition-name ',name)
@@ -1277,13 +1331,13 @@ capabilities."
(error
"You should only run `erc-once-with-server-event' in a server buffer"))
(let ((fun (make-symbol "fun"))
- (hook (erc-get-hook event)))
+ (hook (erc-get-hook event)))
(put fun 'erc-original-buffer (current-buffer))
(fset fun (lambda (proc parsed)
- (with-current-buffer (get fun 'erc-original-buffer)
- (remove-hook hook fun t))
- (fmakunbound fun)
- (funcall f proc parsed)))
+ (with-current-buffer (get fun 'erc-original-buffer)
+ (remove-hook hook fun t))
+ (fmakunbound fun)
+ (funcall f proc parsed)))
(add-hook hook fun nil t)
fun))
@@ -1310,15 +1364,15 @@ the process buffer."
If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(and (eq major-mode 'erc-mode)
- (null (erc-default-target)))))
+ (null (erc-default-target)))))
-(defun erc-open-server-buffer-p (&optional buffer) ;FIXME: `buffer' is ignored!
+(defun erc-open-server-buffer-p (&optional buffer)
"Return non-nil if argument BUFFER is an ERC server buffer that
has an open IRC process.
If BUFFER is nil, the current buffer is used."
- (and (erc-server-buffer-p)
- (erc-server-process-alive)))
+ (and (erc-server-buffer-p buffer)
+ (erc-server-process-alive buffer)))
(defun erc-query-buffer-p (&optional buffer)
"Return non-nil if BUFFER is an ERC query buffer.
@@ -1326,8 +1380,8 @@ If BUFFER is nil, the current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(let ((target (erc-default-target)))
(and (eq major-mode 'erc-mode)
- target
- (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
+ target
+ (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
@@ -1337,39 +1391,39 @@ If BUFFER is nil, the current buffer is used."
(erc-once-with-server-event
303
(lambda (_proc parsed)
- (let ((ison (split-string (aref parsed 3))))
- (setq erc-online-p (car (erc-member-ignore-case nick ison)))
- t)))
+ (let ((ison (split-string (aref parsed 3))))
+ (setq erc-online-p (car (erc-member-ignore-case nick ison)))
+ t)))
(erc-server-send (format "ISON %s" nick))
(while (eq erc-online-p 'unknown) (accept-process-output))
(if (called-interactively-p 'interactive)
- (message "%s is %sonline"
- (or erc-online-p nick)
- (if erc-online-p "" "not "))
- erc-online-p))))
+ (message "%s is %sonline"
+ (or erc-online-p nick)
+ (if erc-online-p "" "not "))
+ erc-online-p))))
(defun erc-log-aux (string)
"Do the debug logging of STRING."
(let ((cb (current-buffer))
- (point 1)
- (was-eob nil)
- (session-buffer (erc-server-buffer)))
+ (point 1)
+ (was-eob nil)
+ (session-buffer (erc-server-buffer)))
(if session-buffer
- (progn
- (set-buffer session-buffer)
- (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
- (progn
- (setq erc-dbuf (get-buffer-create
- (concat "*ERC-DEBUG: "
- erc-session-server "*")))))
- (set-buffer erc-dbuf)
- (setq point (point))
- (setq was-eob (eobp))
- (goto-char (point-max))
- (insert (concat "** " string "\n"))
- (if was-eob (goto-char (point-max))
- (goto-char point))
- (set-buffer cb))
+ (progn
+ (set-buffer session-buffer)
+ (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
+ (progn
+ (setq erc-dbuf (get-buffer-create
+ (concat "*ERC-DEBUG: "
+ erc-session-server "*")))))
+ (set-buffer erc-dbuf)
+ (setq point (point))
+ (setq was-eob (eobp))
+ (goto-char (point-max))
+ (insert (concat "** " string "\n"))
+ (if was-eob (goto-char (point-max))
+ (goto-char point))
+ (set-buffer cb))
(message "ERC: ** %s" string))))
;; Last active buffer, to print server messages in the right place
@@ -1385,15 +1439,15 @@ server buffer.")
Defaults to the server buffer."
(erc-with-server-buffer
(if (buffer-live-p erc-active-buffer)
- erc-active-buffer
+ erc-active-buffer
(setq erc-active-buffer (current-buffer)))))
(defun erc-set-active-buffer (buffer)
"Set the value of `erc-active-buffer' to BUFFER."
(cond ((erc-server-buffer)
- (with-current-buffer (erc-server-buffer)
- (setq erc-active-buffer buffer)))
- (t (setq erc-active-buffer buffer))))
+ (with-current-buffer (erc-server-buffer)
+ (setq erc-active-buffer buffer)))
+ (t (setq erc-active-buffer buffer))))
;; Mode activation routines
@@ -1422,27 +1476,27 @@ Defaults to the server buffer."
The available choices are:
- 'window - in another window,
- 'window-noselect - in another window, but don't select that one,
- 'frame - in another frame,
- 'bury - bury it in a new buffer,
- 'buffer - in place of the current buffer,
+ `window' - in another window,
+ `window-noselect' - in another window, but don't select that one,
+ `frame' - in another frame,
+ `bury' - bury it in a new buffer,
+ `buffer' - in place of the current buffer,
any other value - in place of the current buffer."
:group 'erc-buffers
:type '(choice (const :tag "Split window and select" window)
- (const :tag "Split window, don't select" window-noselect)
- (const :tag "New frame" frame)
- (const :tag "Bury in new buffer" bury)
- (const :tag "Use current buffer" buffer)
- (const :tag "Use current buffer" t)))
+ (const :tag "Split window, don't select" window-noselect)
+ (const :tag "New frame" frame)
+ (const :tag "Bury in new buffer" bury)
+ (const :tag "Use current buffer" buffer)
+ (const :tag "Use current buffer" t)))
(defcustom erc-frame-alist nil
"Alist of frame parameters for creating erc frames.
A value of nil means to use `default-frame-alist'."
:group 'erc-buffers
:type '(repeat (cons :format "%v"
- (symbol :tag "Parameter")
- (sexp :tag "Value"))))
+ (symbol :tag "Parameter")
+ (sexp :tag "Value"))))
(defcustom erc-frame-dedicated-flag nil
"Non-nil means the erc frames are dedicated to that buffer.
@@ -1461,11 +1515,11 @@ effect when `erc-join-buffer' is set to `frame'."
(defun erc-channel-p (channel)
"Return non-nil if CHANNEL seems to be an IRC channel name."
(cond ((stringp channel)
- (memq (aref channel 0) '(?# ?& ?+ ?!)))
- ((and (bufferp channel) (buffer-live-p channel))
- (with-current-buffer channel
- (erc-channel-p (erc-default-target))))
- (t nil)))
+ (memq (aref channel 0) '(?# ?& ?+ ?!)))
+ ((and (bufferp channel) (buffer-live-p channel))
+ (with-current-buffer channel
+ (erc-channel-p (erc-default-target))))
+ (t nil)))
(defcustom erc-reuse-buffers t
"If nil, create new buffers on joining a channel/query.
@@ -1491,17 +1545,17 @@ symbol, it may have these values:
(let ((port-nr (string-to-number port)))
(cond
((> port-nr 0)
- port-nr)
+ port-nr)
((string-equal port "irc")
- 194)
+ 194)
((string-equal port "ircs")
- 994)
+ 994)
((string-equal port "ircd")
- 6667)
+ 6667)
((string-equal port "ircd-dalnet")
- 7000)
+ 7000)
(t
- nil))))
+ nil))))
((numberp port)
port)
(t
@@ -1556,8 +1610,8 @@ All strings are compared according to IRC protocol case rules, see
(catch 'result
(while list
(if (string= string (erc-downcase (car list)))
- (throw 'result list)
- (setq list (cdr list))))))
+ (throw 'result list)
+ (setq list (cdr list))))))
(defmacro erc-with-buffer (spec &rest body)
"Execute BODY in the buffer associated with SPEC.
@@ -1577,21 +1631,21 @@ See also `with-current-buffer'.
\(fn (TARGET [PROCESS]) BODY...)"
(declare (indent 1) (debug ((form &optional form) body)))
(let ((buf (make-symbol "buf"))
- (proc (make-symbol "proc"))
- (target (make-symbol "target"))
- (process (make-symbol "process")))
+ (proc (make-symbol "proc"))
+ (target (make-symbol "target"))
+ (process (make-symbol "process")))
`(let* ((,target ,(car spec))
- (,process ,(cadr spec))
- (,buf (if (bufferp ,target)
- ,target
- (let ((,proc (or ,process
- (and (processp erc-server-process)
- erc-server-process))))
- (if (and ,target ,proc)
- (erc-get-buffer ,target ,proc))))))
+ (,process ,(cadr spec))
+ (,buf (if (bufferp ,target)
+ ,target
+ (let ((,proc (or ,process
+ (and (processp erc-server-process)
+ erc-server-process))))
+ (if (and ,target ,proc)
+ (erc-get-buffer ,target ,proc))))))
(when (buffer-live-p ,buf)
- (with-current-buffer ,buf
- ,@body)))))
+ (with-current-buffer ,buf
+ ,@body)))))
(defun erc-get-buffer (target &optional proc)
"Return the buffer matching TARGET in the process PROC.
@@ -1600,12 +1654,20 @@ If PROC is not supplied, all processes are searched."
(catch 'buffer
(erc-buffer-filter
(lambda ()
- (let ((current (erc-default-target)))
- (and (stringp current)
- (string-equal downcased-target (erc-downcase current))
- (throw 'buffer (current-buffer)))))
+ (let ((current (erc-default-target)))
+ (and (stringp current)
+ (string-equal downcased-target (erc-downcase current))
+ (throw 'buffer (current-buffer)))))
proc))))
+(defun erc--buffer-p (buf predicate proc)
+ (with-current-buffer buf
+ (and (derived-mode-p 'erc-mode)
+ (or (not proc)
+ (eq proc erc-server-process))
+ (funcall predicate)
+ buf)))
+
(defun erc-buffer-filter (predicate &optional proc)
"Return a list of `erc-mode' buffers matching certain criteria.
PREDICATE is a function executed with each buffer, if it returns t, that buffer
@@ -1617,14 +1679,9 @@ server connection, or nil which means all open connections."
(delq
nil
(mapcar (lambda (buf)
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (and (eq major-mode 'erc-mode)
- (or (not proc)
- (eq proc erc-server-process))
- (funcall predicate)
- buf))))
- (buffer-list)))))
+ (when (buffer-live-p buf)
+ (erc--buffer-p buf predicate proc)))
+ (buffer-list)))))
(defun erc-buffer-list (&optional predicate proc)
"Return a list of ERC buffers.
@@ -1644,52 +1701,43 @@ nil."
(declare (indent 1) (debug (form form body)))
;; Make the evaluation have the correct order
(let ((pre (make-symbol "pre"))
- (pro (make-symbol "pro")))
+ (pro (make-symbol "pro")))
`(let* ((,pro ,process)
- (,pre ,pred)
- (res (mapcar (lambda (buffer)
- (with-current-buffer buffer
- ,@forms))
- (erc-buffer-list ,pre
- ,pro))))
+ (,pre ,pred)
+ (res (mapcar (lambda (buffer)
+ (with-current-buffer buffer
+ ,@forms))
+ (erc-buffer-list ,pre
+ ,pro))))
;; Silence the byte-compiler by binding the result of mapcar to
;; a variable.
+ (ignore res)
res)))
-;; (iswitchb-mode) will autoload iswitchb.el
-(defvar iswitchb-temp-buflist)
-(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional default require-match start matches-set))
-(defvar iswitchb-make-buflist-hook)
-
-(defun erc-iswitchb (&optional arg)
- "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to.
+(define-obsolete-function-alias 'erc-iswitchb 'erc-switch-to-buffer "25.1")
+(defun erc-switch-to-buffer (&optional arg)
+ "Prompt for a ERC buffer to switch to.
When invoked with prefix argument, use all erc buffers. Without prefix
ARG, allow only buffers related to same session server.
If `erc-track-mode' is in enabled, put the last element of
-`erc-modified-channels-alist' in front of the buffer list.
-
-Due to some yet unresolved reason, global function `iswitchb-mode'
-needs to be active for this function to work."
+`erc-modified-channels-alist' in front of the buffer list."
(interactive "P")
- (let ((enabled (bound-and-true-p iswitchb-mode)))
- (or enabled (iswitchb-mode 1))
- (unwind-protect
- (let ((iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist
- (mapcar 'buffer-name
- (erc-buffer-list
- nil
- (when arg erc-server-process)))))))
- (switch-to-buffer
- (iswitchb-read-buffer
- "Switch-to: "
- (if (boundp 'erc-modified-channels-alist)
- (buffer-name (caar (last erc-modified-channels-alist)))
- nil)
- t)))
- (or enabled (iswitchb-mode -1)))))
+ (switch-to-buffer
+ (read-buffer "Switch to ERC buffer: "
+ (when (boundp 'erc-modified-channels-alist)
+ (buffer-name (caar (last erc-modified-channels-alist))))
+ t
+ ;; Only allow ERC buffers in the same session.
+ (let ((proc (unless arg erc-server-process)))
+ (lambda (bufname)
+ (let ((buf (if (consp bufname)
+ (cdr bufname) (get-buffer bufname))))
+ (when buf
+ (erc--buffer-p buf (lambda () t) proc)
+ (with-current-buffer buf
+ (and (derived-mode-p 'erc-mode)
+ (or (null proc)
+ (eq proc erc-server-process)))))))))))
(defun erc-channel-list (proc)
"Return a list of channel buffers.
@@ -1698,7 +1746,7 @@ all channel buffers on all servers."
(erc-buffer-filter
(lambda ()
(and (erc-default-target)
- (erc-channel-p (erc-default-target))))
+ (erc-channel-p (erc-default-target))))
proc))
(defun erc-buffer-list-with-nick (nick proc)
@@ -1706,8 +1754,8 @@ all channel buffers on all servers."
(with-current-buffer (process-buffer proc)
(let ((user (gethash (erc-downcase nick) erc-server-users)))
(if user
- (erc-server-user-buffers user)
- nil))))
+ (erc-server-user-buffers user)
+ nil))))
;; Some local variables
@@ -1765,31 +1813,31 @@ buffer rather than a server buffer.")
(let ((transforms '((pcomplete . completion))))
(erc-delete-dups
(mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
- mods))))
+ mods))))
(defcustom erc-modules '(netsplit fill button match track completion readonly
- networks ring autojoin noncommands irccontrols
- move-to-prompt stamp menu list)
+ networks ring autojoin noncommands irccontrols
+ move-to-prompt stamp menu list)
"A list of modules which ERC should enable.
If you set the value of this without using `customize' remember to call
\(erc-update-modules) after you change it. When using `customize', modules
removed from the list will be disabled."
:get (lambda (sym)
- ;; replace outdated names with their newer equivalents
- (erc-migrate-modules (symbol-value sym)))
+ ;; replace outdated names with their newer equivalents
+ (erc-migrate-modules (symbol-value sym)))
:set (lambda (sym val)
- ;; disable modules which have just been removed
- (when (and (boundp 'erc-modules) erc-modules val)
- (dolist (module erc-modules)
- (unless (member module val)
- (let ((f (intern-soft (format "erc-%s-mode" module))))
- (when (and (fboundp f) (boundp f) (symbol-value f))
- (message "Disabling `erc-%s'" module)
- (funcall f 0))))))
- (set sym val)
- ;; this test is for the case where erc hasn't been loaded yet
- (when (fboundp 'erc-update-modules)
- (erc-update-modules)))
+ ;; disable modules which have just been removed
+ (when (and (boundp 'erc-modules) erc-modules val)
+ (dolist (module erc-modules)
+ (unless (member module val)
+ (let ((f (intern-soft (format "erc-%s-mode" module))))
+ (when (and (fboundp f) (boundp f) (symbol-value f))
+ (message "Disabling `erc-%s'" module)
+ (funcall f 0))))))
+ (set sym val)
+ ;; this test is for the case where erc hasn't been loaded yet
+ (when (fboundp 'erc-update-modules)
+ (erc-update-modules)))
:type
'(set
:greedy t
@@ -1797,42 +1845,42 @@ removed from the list will be disabled."
(const :tag "autojoin: Join channels automatically" autojoin)
(const :tag "button: Buttonize URLs, nicknames, and other text" button)
(const :tag "capab: Mark unidentified users on servers supporting CAPAB"
- capab-identify)
+ capab-identify)
(const :tag "completion: Complete nicknames and commands (programmable)"
- completion)
+ completion)
(const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
(const :tag "fill: Wrap long lines" fill)
(const :tag "identd: Launch an identd server on port 8113" identd)
(const :tag "irccontrols: Highlight or remove IRC control characters"
- irccontrols)
+ irccontrols)
(const :tag "keep-place: Leave point above un-viewed text" keep-place)
(const :tag "list: List channels in a separate buffer" list)
(const :tag "log: Save buffers in logs" log)
(const :tag "match: Highlight pals, fools, and other keywords" match)
(const :tag "menu: Display a menu in ERC buffers" menu)
(const :tag "move-to-prompt: Move to the prompt when typing text"
- move-to-prompt)
+ move-to-prompt)
(const :tag "netsplit: Detect netsplits" netsplit)
(const :tag "networks: Provide data about IRC networks" networks)
(const :tag "noncommands: Don't display non-IRC commands after evaluation"
- noncommands)
+ noncommands)
(const :tag
- "notify: Notify when the online status of certain users changes"
- notify)
+ "notify: Notify when the online status of certain users changes"
+ notify)
(const :tag "notifications: Send notifications on PRIVMSG or nickname mentions"
- notifications)
+ notifications)
(const :tag "page: Process CTCP PAGE requests from IRC" page)
(const :tag "readonly: Make displayed lines read-only" readonly)
(const :tag "replace: Replace text in messages" replace)
(const :tag "ring: Enable an input history" ring)
(const :tag "scrolltobottom: Scroll to the bottom of the buffer"
- scrolltobottom)
+ scrolltobottom)
(const :tag "services: Identify to Nickserv (IRC Services) automatically"
- services)
+ services)
(const :tag "smiley: Convert smileys to pretty icons" smiley)
(const :tag "sound: Play sounds when you receive CTCP SOUND requests"
- sound)
+ sound)
(const :tag "stamp: Add timestamps to messages" stamp)
(const :tag "spelling: Check spelling" spelling)
(const :tag "track: Track channel activity in the mode-line" track)
@@ -1850,27 +1898,27 @@ removed from the list will be disabled."
(cond
;; yuck. perhaps we should bring the filenames into sync?
((string= req "erc-capab-identify")
- (setq req "erc-capab"))
+ (setq req "erc-capab"))
((string= req "erc-completion")
- (setq req "erc-pcomplete"))
+ (setq req "erc-pcomplete"))
((string= req "erc-pcomplete")
- (setq mod 'completion))
+ (setq mod 'completion))
((string= req "erc-autojoin")
- (setq req "erc-join")))
+ (setq req "erc-join")))
(condition-case nil
- (require (intern req))
- (error nil))
+ (require (intern req))
+ (error nil))
(let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode"))))
- (if (fboundp sym)
- (funcall sym 1)
- (error "`%s' is not a known ERC module" mod))))))
+ (if (fboundp sym)
+ (funcall sym 1)
+ (error "`%s' is not a known ERC module" mod))))))
(defun erc-setup-buffer (buffer)
"Consults `erc-join-buffer' to find out how to display `BUFFER'."
(pcase erc-join-buffer
(`window
(if (active-minibuffer-window)
- (display-buffer buffer)
+ (display-buffer buffer)
(switch-to-buffer-other-window buffer)))
(`window-noselect
(display-buffer buffer))
@@ -1878,21 +1926,21 @@ removed from the list will be disabled."
nil)
(`frame
(when (or (not erc-reuse-frames)
- (not (get-buffer-window buffer t)))
+ (not (get-buffer-window buffer t)))
(let ((frame (make-frame (or erc-frame-alist
- default-frame-alist))))
- (raise-frame frame)
- (select-frame frame))
+ default-frame-alist))))
+ (raise-frame frame)
+ (select-frame frame))
(switch-to-buffer buffer)
(when erc-frame-dedicated-flag
- (set-window-dedicated-p (selected-window) t))))
+ (set-window-dedicated-p (selected-window) t))))
(_
(if (active-minibuffer-window)
- (display-buffer buffer)
+ (display-buffer buffer)
(switch-to-buffer buffer)))))
(defun erc-open (&optional server port nick full-name
- connect passwd tgt-list channel process)
+ connect passwd tgt-list channel process)
"Connect to SERVER on PORT as NICK with FULL-NAME.
If CONNECT is non-nil, connect to the server. Otherwise assume
@@ -1904,13 +1952,13 @@ non-nil, use it to initialize `erc-default-recipients'.
Returns the buffer for the given server or channel."
(let ((server-announced-name (when (and (boundp 'erc-session-server)
- (string= server erc-session-server))
- erc-server-announced-name))
- (connected-p (unless connect erc-server-connected))
- (buffer (erc-get-buffer-create server port channel))
- (old-buffer (current-buffer))
- old-point
- continued-session)
+ (string= server erc-session-server))
+ erc-server-announced-name))
+ (connected-p (unless connect erc-server-connected))
+ (buffer (erc-get-buffer-create server port channel))
+ (old-buffer (current-buffer))
+ old-point
+ continued-session)
(when connect (run-hook-with-args 'erc-before-connect server port nick))
(erc-update-modules)
(set-buffer buffer)
@@ -1929,8 +1977,8 @@ Returns the buffer for the given server or channel."
(when (get-text-property (point) 'erc-prompt)
(setq continued-session t)
(set-marker erc-input-marker
- (or (next-single-property-change (point) 'erc-prompt)
- (point-max))))
+ (or (next-single-property-change (point) 'erc-prompt)
+ (point-max))))
(unless continued-session
(goto-char (point-max))
(insert "\n"))
@@ -1940,14 +1988,14 @@ Returns the buffer for the given server or channel."
(setq erc-server-current-nick nil)
;; Initialize erc-server-users and erc-channel-users
(if connect
- (progn ;; server buffer
- (setq erc-server-users
- (make-hash-table :test 'equal))
- (setq erc-channel-users nil))
+ (progn ;; server buffer
+ (setq erc-server-users
+ (make-hash-table :test 'equal))
+ (setq erc-channel-users nil))
(progn ;; target buffer
- (setq erc-server-users nil)
- (setq erc-channel-users
- (make-hash-table :test 'equal))))
+ (setq erc-server-users nil)
+ (setq erc-channel-users
+ (make-hash-table :test 'equal))))
;; clear last incomplete line read
(setq erc-server-filter-data nil)
(setq erc-channel-topic "")
@@ -1968,29 +2016,29 @@ Returns the buffer for the given server or channel."
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
;; password stuff
(setq erc-session-password
- (or passwd
- (let ((secret
- (plist-get
- (nth 0
- (auth-source-search :host server
- :max 1
- :user nick
- :port port
- :require '(:secret)))
- :secret)))
- (if (functionp secret)
- (funcall secret)
- secret))))
+ (or passwd
+ (let ((secret
+ (plist-get
+ (nth 0
+ (auth-source-search :host server
+ :max 1
+ :user nick
+ :port port
+ :require '(:secret)))
+ :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))))
;; debug output buffer
(setq erc-dbuf
- (when erc-log-p
- (get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
+ (when erc-log-p
+ (get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
;; set up prompt
(unless continued-session
(goto-char (point-max))
(insert "\n"))
(if continued-session
- (goto-char old-point)
+ (goto-char old-point)
(set-marker erc-insert-marker (point))
(erc-display-prompt)
(goto-char (point-max)))
@@ -2007,9 +2055,9 @@ Returns the buffer for the given server or channel."
;; Now display the buffer in a window as per user wishes.
(unless (eq buffer old-buffer)
(when erc-log-p
- ;; we can't log to debug buffer, it may not exist yet
- (message "erc: old buffer %s, switching to %s"
- old-buffer buffer))
+ ;; we can't log to debug buffer, it may not exist yet
+ (message "erc: old buffer %s, switching to %s"
+ old-buffer buffer))
(erc-setup-buffer buffer))
buffer))
@@ -2018,9 +2066,10 @@ Returns the buffer for the given server or channel."
"Initialize the `erc-last-saved-position' marker to a sensible position.
BUFFER is the current buffer."
(with-current-buffer buffer
- (setq erc-last-saved-position (make-marker))
- (move-marker erc-last-saved-position
- (1- (marker-position erc-insert-marker)))))
+ (unless (markerp erc-last-saved-position)
+ (setq erc-last-saved-position (make-marker))
+ (move-marker erc-last-saved-position
+ (1- (marker-position erc-insert-marker))))))
;; interactive startup
@@ -2038,9 +2087,9 @@ If no buffer matches, return nil."
(erc-buffer-list
(lambda ()
(and (erc-server-process-alive)
- (string= erc-session-server server)
- (erc-port-equal erc-session-port port)
- (erc-current-nick-p nick)))))
+ (string= erc-session-server server)
+ (erc-port-equal erc-session-port port)
+ (erc-current-nick-p nick)))))
(defcustom erc-before-connect nil
"Hook called before connecting to a server.
@@ -2062,38 +2111,38 @@ functions in here get called with the parameters SERVER and NICK."
"Prompt the user for values of nick, server, port, and password."
(let (user-input server port nick passwd)
(setq user-input (read-from-minibuffer
- "IRC server: "
- (erc-compute-server) nil nil 'erc-server-history-list))
+ "IRC server: "
+ (erc-compute-server) nil nil 'erc-server-history-list))
(if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
- (setq port (erc-string-to-port (match-string 2 user-input))
- user-input (match-string 1 user-input))
+ (setq port (erc-string-to-port (match-string 2 user-input))
+ user-input (match-string 1 user-input))
(setq port
- (erc-string-to-port (read-from-minibuffer
- "IRC port: " (erc-port-to-string
- (erc-compute-port))))))
+ (erc-string-to-port (read-from-minibuffer
+ "IRC port: " (erc-port-to-string
+ (erc-compute-port))))))
(if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
- (setq nick (match-string 1 user-input)
- user-input (match-string 2 user-input))
+ (setq nick (match-string 1 user-input)
+ user-input (match-string 2 user-input))
(setq nick
- (if (erc-already-logged-in server port nick)
- (read-from-minibuffer
- (erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)
- (read-from-minibuffer
- "Nickname: " (erc-compute-nick nick)
- nil nil 'erc-nick-history-list))))
+ (if (erc-already-logged-in server port nick)
+ (read-from-minibuffer
+ (erc-format-message 'nick-in-use ?n nick)
+ nick
+ nil nil 'erc-nick-history-list)
+ (read-from-minibuffer
+ "Nickname: " (erc-compute-nick nick)
+ nil nil 'erc-nick-history-list))))
(setq server user-input)
(setq passwd (if erc-prompt-for-password
- (if (and erc-password
- (y-or-n-p "Use the default password? "))
- erc-password
- (read-passwd "Password: "))
- erc-password))
+ (if (and erc-password
+ (y-or-n-p "Use the default password? "))
+ erc-password
+ (read-passwd "Password: "))
+ erc-password))
(when (and passwd (string= "" passwd))
(setq passwd nil))
@@ -2104,17 +2153,17 @@ functions in here get called with the parameters SERVER and NICK."
;; bncs transparent, so that erc-compute-buffer-name displays
;; the server one is connected to.
(setq nick (read-from-minibuffer
- (erc-format-message 'nick-in-use ?n nick)
- nick
- nil nil 'erc-nick-history-list)))
+ (erc-format-message 'nick-in-use ?n nick)
+ nick
+ nil nil 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
(cl-defun erc (&key (server (erc-compute-server))
- (port (erc-compute-port))
- (nick (erc-compute-nick))
- password
- (full-name (erc-compute-full-name)))
+ (port (erc-compute-port))
+ (nick (erc-compute-nick))
+ password
+ (full-name (erc-compute-full-name)))
"ERC is a powerful, modular, and extensible IRC client.
This function is the main entry point for ERC.
@@ -2147,14 +2196,14 @@ be invoked for the values of the other parameters."
Arguments are the same as for `erc'."
(interactive (erc-select-read-args))
(let ((erc-server-connect-function 'erc-open-tls-stream))
- (apply 'erc r)))
+ (apply #'erc r)))
(defun erc-open-tls-stream (name buffer host port)
"Open an TLS stream to an IRC server.
The process will be given the name NAME, its target buffer will be
BUFFER. HOST and PORT specify the connection target."
(open-network-stream name buffer host port
- :type 'tls))
+ :type 'tls))
;;; Displaying error messages
@@ -2194,36 +2243,36 @@ If OUTBOUND is non-nil, STRING is being sent to the IRC server
and appears in face `erc-input-face' in the buffer."
(when erc-debug-irc-protocol
(let ((network-name (or (ignore-errors (erc-network-name))
- "???")))
+ "???")))
(with-current-buffer (get-buffer-create "*erc-protocol*")
- (save-excursion
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (insert (if (not outbound)
- ;; Cope with the fact that string might
- ;; contain multiple lines of text.
- (let ((lines (delete "" (split-string string
- "\n\\|\r\n")))
- (result ""))
- (dolist (line lines)
- (setq result (concat result network-name
- " << " line "\n")))
- result)
- (erc-propertize
- (concat network-name " >> " string
- (if (/= ?\n
- (aref string
- (1- (length string))))
- "\n"))
- 'face 'erc-input-face)))))
- (let ((orig-win (selected-window))
- (debug-buffer-window (get-buffer-window (current-buffer) t)))
- (when debug-buffer-window
- (select-window debug-buffer-window)
- (when (= 1 (count-lines (point) (point-max)))
- (goto-char (point-max))
- (recenter -1))
- (select-window orig-win)))))))
+ (save-excursion
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (if (not outbound)
+ ;; Cope with the fact that string might
+ ;; contain multiple lines of text.
+ (let ((lines (delete "" (split-string string
+ "\n\\|\r\n")))
+ (result ""))
+ (dolist (line lines)
+ (setq result (concat result network-name
+ " << " line "\n")))
+ result)
+ (erc-propertize
+ (concat network-name " >> " string
+ (if (/= ?\n
+ (aref string
+ (1- (length string))))
+ "\n"))
+ 'face 'erc-input-face)))))
+ (let ((orig-win (selected-window))
+ (debug-buffer-window (get-buffer-window (current-buffer) t)))
+ (when debug-buffer-window
+ (select-window debug-buffer-window)
+ (when (= 1 (count-lines (point) (point-max)))
+ (goto-char (point-max))
+ (recenter -1))
+ (select-window orig-win)))))))
(defun erc-toggle-debug-irc-protocol (&optional arg)
"Toggle the value of `erc-debug-irc-protocol'.
@@ -2234,26 +2283,26 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(with-current-buffer buf
(erc-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"))
- (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
- (use-local-map (make-sparse-keymap))
- (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
+ (let ((inhibit-read-only t))
+ (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
+ (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
+ (use-local-map (make-sparse-keymap))
+ (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
(add-hook 'kill-buffer-hook
- #'(lambda () (setq erc-debug-irc-protocol nil))
- nil 'local)
+ #'(lambda () (setq erc-debug-irc-protocol nil))
+ nil 'local)
(goto-char (point-max))
(let ((inhibit-read-only t))
- (insert (erc-make-notice
- (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
- (if erc-debug-irc-protocol "disabled" "enabled")
- (current-time-string))))))
+ (insert (erc-make-notice
+ (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
+ (if erc-debug-irc-protocol "disabled" "enabled")
+ (current-time-string))))))
(setq erc-debug-irc-protocol (not erc-debug-irc-protocol))
(if (and arg
- (not (get-buffer-window "*erc-protocol*" t)))
- (display-buffer buf t))
+ (not (get-buffer-window "*erc-protocol*" t)))
+ (display-buffer buf t))
(message "IRC protocol traffic logging %s (see buffer *erc-protocol*)."
- (if erc-debug-irc-protocol "enabled" "disabled"))))
+ (if erc-debug-irc-protocol "enabled" "disabled"))))
;;; I/O interface
@@ -2292,76 +2341,76 @@ If STRING is nil, the function does nothing."
(when string
(with-current-buffer (or buffer (process-buffer erc-server-process))
(let ((insert-position (or (marker-position erc-insert-marker)
- (point-max))))
- (let ((string string) ;; FIXME! Can this be removed?
- (buffer-undo-list t)
- (inhibit-read-only t))
- (unless (string-match "\n$" string)
- (setq string (concat string "\n"))
- (when (erc-string-invisible-p string)
- (erc-put-text-properties 0 (length string)
- '(invisible intangible) string)))
- (erc-log (concat "erc-display-line: " string
- (format "(%S)" string) " in buffer "
- (format "%s" buffer)))
- (setq erc-insert-this t)
- (run-hook-with-args 'erc-insert-pre-hook string)
- (if (null erc-insert-this)
- ;; Leave erc-insert-this set to t as much as possible. Fran
- ;; Litterio <franl> has seen erc-insert-this set to nil while
- ;; erc-send-pre-hook is running, which should never happen. This
- ;; may cure it.
- (setq erc-insert-this t)
- (save-excursion ;; to restore point in the new buffer
- (save-restriction
- (widen)
- (goto-char insert-position)
- (insert-before-markers string)
- ;; run insertion hook, with point at restored location
- (save-restriction
- (narrow-to-region insert-position (point))
- (run-hooks 'erc-insert-modify-hook)
- (run-hooks 'erc-insert-post-hook)
- (when erc-remove-parsed-property
- (remove-text-properties (point-min) (point-max)
- '(erc-parsed nil))))))))
- (erc-update-undo-list (- (or (marker-position erc-insert-marker)
- (point-max))
- insert-position))))))
+ (point-max))))
+ (let ((string string) ;; FIXME! Can this be removed?
+ (buffer-undo-list t)
+ (inhibit-read-only t))
+ (unless (string-match "\n$" string)
+ (setq string (concat string "\n"))
+ (when (erc-string-invisible-p string)
+ (erc-put-text-properties 0 (length string)
+ '(invisible intangible) string)))
+ (erc-log (concat "erc-display-line: " string
+ (format "(%S)" string) " in buffer "
+ (format "%s" buffer)))
+ (setq erc-insert-this t)
+ (run-hook-with-args 'erc-insert-pre-hook string)
+ (if (null erc-insert-this)
+ ;; Leave erc-insert-this set to t as much as possible. Fran
+ ;; Litterio <franl> has seen erc-insert-this set to nil while
+ ;; erc-send-pre-hook is running, which should never happen. This
+ ;; may cure it.
+ (setq erc-insert-this t)
+ (save-excursion ;; to restore point in the new buffer
+ (save-restriction
+ (widen)
+ (goto-char insert-position)
+ (insert-before-markers string)
+ ;; run insertion hook, with point at restored location
+ (save-restriction
+ (narrow-to-region insert-position (point))
+ (run-hooks 'erc-insert-modify-hook)
+ (run-hooks 'erc-insert-post-hook)
+ (when erc-remove-parsed-property
+ (remove-text-properties (point-min) (point-max)
+ '(erc-parsed nil))))))))
+ (erc-update-undo-list (- (or (marker-position erc-insert-marker)
+ (point-max))
+ insert-position))))))
(defun erc-update-undo-list (shift)
;; Translate buffer positions in buffer-undo-list by SHIFT.
(unless (or (zerop shift) (atom buffer-undo-list))
(let ((list buffer-undo-list) elt)
(while list
- (setq elt (car list))
- (cond ((integerp elt) ; POSITION
- (cl-incf (car list) shift))
- ((or (atom elt) ; nil, EXTENT
- ;; (eq t (car elt)) ; (t . TIME)
- (markerp (car elt))) ; (MARKER . DISTANCE)
- nil)
- ((integerp (car elt)) ; (BEGIN . END)
- (cl-incf (car elt) shift)
- (cl-incf (cdr elt) shift))
- ((stringp (car elt)) ; (TEXT . POSITION)
- (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
- ((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
- (let ((cons (nthcdr 3 elt)))
- (cl-incf (car cons) shift)
- (cl-incf (cdr cons) shift)))
- ((and (featurep 'xemacs)
- (extentp (car elt))) ; (EXTENT START END)
- (cl-incf (nth 1 elt) shift)
- (cl-incf (nth 2 elt) shift)))
- (setq list (cdr list))))))
+ (setq elt (car list))
+ (cond ((integerp elt) ; POSITION
+ (cl-incf (car list) shift))
+ ((or (atom elt) ; nil, EXTENT
+ ;; (eq t (car elt)) ; (t . TIME)
+ (markerp (car elt))) ; (MARKER . DISTANCE)
+ nil)
+ ((integerp (car elt)) ; (BEGIN . END)
+ (cl-incf (car elt) shift)
+ (cl-incf (cdr elt) shift))
+ ((stringp (car elt)) ; (TEXT . POSITION)
+ (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
+ ((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
+ (let ((cons (nthcdr 3 elt)))
+ (cl-incf (car cons) shift)
+ (cl-incf (cdr cons) shift)))
+ ((and (featurep 'xemacs)
+ (extentp (car elt))) ; (EXTENT START END)
+ (cl-incf (nth 1 elt) shift)
+ (cl-incf (nth 2 elt) shift)))
+ (setq list (cdr list))))))
(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
"Regexp which matches all valid characters in a IRC nickname.")
(defun erc-is-valid-nick-p (nick)
"Check if NICK is a valid IRC nickname."
- (string-match (concat "^" erc-valid-nick-regexp "$") nick))
+ (string-match (concat "\\`" erc-valid-nick-regexp "\\'") nick))
(defun erc-display-line (string &optional buffer)
"Display STRING in the ERC BUFFER.
@@ -2375,41 +2424,41 @@ buffer is used. `erc-display-line-1' is used to display STRING.
If STRING is nil, the function does nothing."
(let ((inhibit-point-motion-hooks t)
- new-bufs)
+ new-bufs)
(dolist (buf (cond
- ((bufferp buffer) (list buffer))
- ((listp buffer) buffer)
- ((processp buffer) (list (process-buffer buffer)))
- ((eq 'all buffer)
- ;; Hmm, or all of the same session server?
- (erc-buffer-list nil erc-server-process))
- ((and (eq 'active buffer) (erc-active-buffer))
- (list (erc-active-buffer)))
- ((erc-server-buffer-live-p)
- (list (process-buffer erc-server-process)))
- (t (list (current-buffer)))))
+ ((bufferp buffer) (list buffer))
+ ((listp buffer) buffer)
+ ((processp buffer) (list (process-buffer buffer)))
+ ((eq 'all buffer)
+ ;; Hmm, or all of the same session server?
+ (erc-buffer-list nil erc-server-process))
+ ((and (eq 'active buffer) (erc-active-buffer))
+ (list (erc-active-buffer)))
+ ((erc-server-buffer-live-p)
+ (list (process-buffer erc-server-process)))
+ (t (list (current-buffer)))))
(when (buffer-live-p buf)
- (erc-display-line-1 string buf)
- (push buf new-bufs)))
+ (erc-display-line-1 string buf)
+ (push buf new-bufs)))
(when (null new-bufs)
(erc-display-line-1 string (if (erc-server-buffer-live-p)
- (process-buffer erc-server-process)
- (current-buffer))))))
+ (process-buffer erc-server-process)
+ (current-buffer))))))
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
See also `erc-make-notice'."
(cond ((eq type 'notice)
- (erc-make-notice string))
- (t
- (erc-put-text-property
- 0 (length string)
- 'face (or (intern-soft
- (concat "erc-" (symbol-name type) "-face"))
- "erc-default-face")
- string)
- string)))
+ (erc-make-notice string))
+ (t
+ (erc-put-text-property
+ 0 (length string)
+ 'face (or (intern-soft
+ (concat "erc-" (symbol-name type) "-face"))
+ "erc-default-face")
+ string)
+ string)))
(defvar erc-lurker-state nil
"Track the time of the last PRIVMSG for each (server,nick) pair.
@@ -2424,7 +2473,7 @@ on the given server.")
(defcustom erc-lurker-trim-nicks t
"If t, trim trailing `erc-lurker-ignore-chars' from nicks.
-This causes e.g. nick and nick` to be considered as the same
+This causes e.g. nick and nick\\=` to be considered as the same
individual for activity tracking and lurkiness detection
purposes."
:group 'erc-lurker
@@ -2454,7 +2503,7 @@ non-nil."
(defcustom erc-lurker-hide-list nil
"List of IRC type messages to hide when sent by lurkers.
-A typical value would be '(\"JOIN\" \"PART\" \"QUIT\").
+A typical value would be \(\"JOIN\" \"PART\" \"QUIT\").
See also `erc-lurker-p' and `erc-hide-list'."
:group 'erc-lurker
:type 'erc-message-type)
@@ -2486,15 +2535,15 @@ consumption for long-lived IRC or Emacs sessions."
(lambda (server hash)
(maphash
(lambda (nick last-PRIVMSG-time)
- (when
- (> (float-time (time-subtract
- (current-time)
- last-PRIVMSG-time))
- erc-lurker-threshold-time)
- (remhash nick hash)))
+ (when
+ (> (float-time (time-subtract
+ (current-time)
+ last-PRIVMSG-time))
+ erc-lurker-threshold-time)
+ (remhash nick hash)))
hash)
(if (zerop (hash-table-count hash))
- (remhash server erc-lurker-state)))
+ (remhash server erc-lurker-state)))
erc-lurker-state))
(defvar erc-lurker-cleanup-count 0
@@ -2534,7 +2583,7 @@ updates of `erc-lurker-state'."
(erc-canonicalize-server-name erc-server-announced-name)))
(when (equal command "PRIVMSG")
(when (>= (cl-incf erc-lurker-cleanup-count)
- erc-lurker-cleanup-interval)
+ erc-lurker-cleanup-interval)
(setq erc-lurker-cleanup-count 0)
(erc-lurker-cleanup))
(unless (gethash server erc-lurker-state)
@@ -2549,20 +2598,20 @@ Lurking is the condition where NICK has issued no PRIVMSG on this
server within `erc-lurker-threshold-time'. See also
`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'."
(unless erc-lurker-state (erc-lurker-initialize))
- (let* ((server
- (erc-canonicalize-server-name erc-server-announced-name))
- (last-PRIVMSG-time
- (gethash (erc-lurker-maybe-trim nick)
- (gethash server erc-lurker-state (make-hash-table)))))
- (or (null last-PRIVMSG-time)
- (> (float-time
- (time-subtract (current-time) last-PRIVMSG-time))
+ (let* ((server
+ (erc-canonicalize-server-name erc-server-announced-name))
+ (last-PRIVMSG-time
+ (gethash (erc-lurker-maybe-trim nick)
+ (gethash server erc-lurker-state (make-hash-table)))))
+ (or (null last-PRIVMSG-time)
+ (> (float-time
+ (time-subtract (current-time) last-PRIVMSG-time))
erc-lurker-threshold-time))))
(defcustom erc-common-server-suffixes
- '(("openprojects.net$" . "OPN")
- ("freenode.net$" . "freenode")
- ("oftc.net$" . "OFTC"))
+ '(("openprojects.net\\'" . "OPN")
+ ("freenode.net\\'" . "freenode")
+ ("oftc.net\\'" . "OFTC"))
"Alist of common server name suffixes.
This variable is used in mode-line display to save screen
real estate. Set it to nil if you want to avoid changing
@@ -2576,19 +2625,40 @@ otherwise `erc-server-announced-name'. SERVER is matched against
`erc-common-server-suffixes'."
(when server
(or (cdar (erc-remove-if-not
- (lambda (net) (string-match (car net) server))
- erc-common-server-suffixes))
+ (lambda (net) (string-match (car net) server))
+ erc-common-server-suffixes))
erc-server-announced-name)))
+(defun erc-add-targets (scope target-list)
+ (let ((targets
+ (mapcar (lambda (targets) (member scope targets)) target-list)))
+ (cdr (apply 'append (delete nil targets)))))
+
(defun erc-hide-current-message-p (parsed)
"Predicate indicating whether the parsed ERC response PARSED should be hidden.
Messages are always hidden if the message type of PARSED appears in
-`erc-hide-list'. In addition, messages whose type is a member of
-`erc-lurker-hide-list' are hidden if `erc-lurker-p' returns true."
+`erc-hide-list'. Message types that appear in `erc-network-hide-list'
+or `erc-channel-hide-list' are are only hidden if the target matches
+the network or channel in the list. In addition, messages whose type
+is a member of `erc-lurker-hide-list' are hidden if `erc-lurker-p'
+returns non-nil."
(let* ((command (erc-response.command parsed))
- (sender (car (erc-parse-user (erc-response.sender parsed)))))
+ (sender (car (erc-parse-user (erc-response.sender parsed))))
+ (channel (nth 1 (erc-response.command-args parsed)))
+ (network (or (and (fboundp 'erc-network-name) (erc-network-name))
+ (erc-shorten-server-name
+ (or erc-server-announced-name
+ erc-session-server))))
+ (current-hide-list
+ (when erc-network-hide-list
+ (erc-add-targets network erc-network-hide-list)))
+ (current-hide-list
+ (apply 'append current-hide-list
+ (when erc-channel-hide-list
+ (erc-add-targets channel erc-channel-hide-list)))))
(or (member command erc-hide-list)
+ (member command current-hide-list)
(and (member command erc-lurker-hide-list) (erc-lurker-p sender)))))
(defun erc-display-message (parsed type buffer msg &rest args)
@@ -2598,27 +2668,27 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly.
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
- (apply 'erc-format-message msg args)
- msg)))
+ (apply #'erc-format-message msg args)
+ msg)))
(setq string
- (cond
- ((null type)
- string)
- ((listp type)
- (mapc (lambda (type)
- (setq string
- (erc-display-message-highlight type string)))
- type)
- string)
- ((symbolp type)
- (erc-display-message-highlight type string))))
+ (cond
+ ((null type)
+ string)
+ ((listp type)
+ (mapc (lambda (type)
+ (setq string
+ (erc-display-message-highlight type string)))
+ type)
+ string)
+ ((symbolp type)
+ (erc-display-message-highlight type string))))
(if (not (erc-response-p parsed))
- (erc-display-line string buffer)
+ (erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
- (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (erc-put-text-property 0 (length string) 'rear-sticky t string)
- (erc-display-line string buffer)))))
+ (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
+ (erc-put-text-property 0 (length string) 'rear-sticky t string)
+ (erc-display-line string buffer)))))
(defun erc-message-type-member (position list)
"Return non-nil if the erc-parsed text-property at POSITION is in LIST.
@@ -2636,19 +2706,19 @@ present."
See also `erc-server-send'."
(setq line (format "PRIVMSG %s :%s"
- target
- ;; If the line is empty, we still want to
- ;; send it - i.e. an empty pasted line.
- (if (string= line "\n")
- " \n"
- line)))
+ target
+ ;; If the line is empty, we still want to
+ ;; send it - i.e. an empty pasted line.
+ (if (string= line "\n")
+ " \n"
+ line)))
(erc-server-send line force target))
(defun erc-get-arglist (fun)
"Return the argument list of a function without the parens."
(let ((arglist (format "%S" (erc-function-arglist fun))))
- (if (string-match "^(\\(.*\\))$" arglist)
- (match-string 1 arglist)
+ (if (string-match "\\`(\\(.*\\))\\'" arglist)
+ (match-string 1 arglist)
arglist)))
(defun erc-command-no-process-p (str)
@@ -2656,15 +2726,15 @@ See also `erc-server-send'."
is not alive, nil otherwise."
(let ((fun (erc-extract-command-from-line str)))
(and fun
- (symbolp (car fun))
- (get (car fun) 'process-not-needed))))
+ (symbolp (car fun))
+ (get (car fun) 'process-not-needed))))
(defun erc-command-name (cmd)
"For CMD being the function name of a ERC command, something like
erc-cmd-FOO, this returns a string /FOO."
(let ((command-name (symbol-name cmd)))
- (if (string-match "^erc-cmd-\\(.*\\)$" command-name)
- (concat "/" (match-string 1 command-name))
+ (if (string-match "\\`erc-cmd-\\(.*\\)\\'" command-name)
+ (concat "/" (match-string 1 command-name))
command-name)))
(defun erc-process-input-line (line &optional force no-command)
@@ -2680,30 +2750,30 @@ An optional FORCE argument forces sending the line when flood
protection is in effect. The optional NO-COMMAND argument prohibits
this function from interpreting the line as a command."
(let ((command-list (erc-extract-command-from-line line)))
- (if (and command-list
- (not no-command))
- (let* ((cmd (nth 0 command-list))
- (args (nth 1 command-list)))
- (condition-case nil
- (if (listp args)
- (apply cmd args)
- (funcall cmd args))
- (wrong-number-of-arguments
- (erc-display-message nil 'error (current-buffer) 'incorrect-args
- ?c (erc-command-name cmd)
- ?u (or (erc-get-arglist cmd)
- "")
- ?d (format "%s\n"
- (or (documentation cmd) "")))
- nil)))
+ (if (and command-list
+ (not no-command))
+ (let* ((cmd (nth 0 command-list))
+ (args (nth 1 command-list)))
+ (condition-case nil
+ (if (listp args)
+ (apply cmd args)
+ (funcall cmd args))
+ (wrong-number-of-arguments
+ (erc-display-message nil 'error (current-buffer) 'incorrect-args
+ ?c (erc-command-name cmd)
+ ?u (or (erc-get-arglist cmd)
+ "")
+ ?d (format "%s\n"
+ (or (documentation cmd) "")))
+ nil)))
(let ((r (erc-default-target)))
- (if r
- (funcall erc-send-input-line-function r line force)
- (erc-display-message nil 'error (current-buffer) 'no-target)
- nil)))))
+ (if r
+ (funcall erc-send-input-line-function r line force)
+ (erc-display-message nil 'error (current-buffer) 'no-target)
+ nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Input commands handlers
+;; Input commands handlers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun erc-cmd-AMSG (line)
@@ -2711,15 +2781,15 @@ this function from interpreting the line as a command."
(interactive "sSend to all channels you're on: ")
(setq line (erc-trim-string line))
(erc-with-all-buffers-of-server nil
- (lambda ()
- (erc-channel-p (erc-default-target)))
- (erc-send-message line)))
+ (lambda ()
+ (erc-channel-p (erc-default-target)))
+ (erc-send-message line)))
(put 'erc-cmd-AMSG 'do-not-parse-args t)
(defun erc-cmd-SAY (line)
"Send LINE to the current query or channel as a message, not a command.
-Use this when you want to send a message with a leading '/'. Note
+Use this when you want to send a message with a leading `/'. Note
that since multi-line messages are never a command, you don't
need this when pasting multiple lines of text."
(if (string-match "^\\s-*$" line)
@@ -2734,36 +2804,37 @@ VALUE is computed by evaluating the rest of LINE in Lisp."
(cond
((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line)
(let ((var (read (concat "erc-" (match-string 1 line))))
- (val (read (match-string 2 line))))
+ (val (read (match-string 2 line))))
(if (boundp var)
- (progn
- (set var (eval val))
- (erc-display-message
- nil nil 'active (format "Set %S to %S" var val))
- t)
- (setq var (read (match-string 1 line)))
- (if (boundp var)
- (progn
- (set var (eval val))
- (erc-display-message
- nil nil 'active (format "Set %S to %S" var val))
- t)
- (erc-display-message nil 'error 'active 'variable-not-bound)
- nil))))
+ (progn
+ (set var (eval val))
+ (erc-display-message
+ nil nil 'active (format "Set %S to %S" var val))
+ t)
+ (setq var (read (match-string 1 line)))
+ (if (boundp var)
+ (progn
+ (set var (eval val))
+ (erc-display-message
+ nil nil 'active (format "Set %S to %S" var val))
+ t)
+ (erc-display-message nil 'error 'active 'variable-not-bound)
+ nil))))
((string-match "^\\s-*$" line)
(erc-display-line
(concat "Available user variables:\n"
- (apply
- 'concat
- (mapcar
- (lambda (var)
- (let ((val (symbol-value var)))
- (concat (format "%S:" var)
- (if (consp val)
- (concat "\n" (pp-to-string val))
- (format " %S\n" val)))))
- (apropos-internal "^erc-" 'custom-variable-p))))
- (current-buffer)) t)
+ (apply
+ #'concat
+ (mapcar
+ (lambda (var)
+ (let ((val (symbol-value var)))
+ (concat (format "%S:" var)
+ (if (consp val)
+ (concat "\n" (pp-to-string val))
+ (format " %S\n" val)))))
+ (apropos-internal "^erc-" 'custom-variable-p))))
+ (current-buffer))
+ t)
(t nil)))
(defalias 'erc-cmd-VAR 'erc-cmd-SET)
(defalias 'erc-cmd-VARIABLE 'erc-cmd-SET)
@@ -2785,42 +2856,42 @@ therefore has to contain the command itself as well."
If no USER argument is specified, list the contents of `erc-ignore-list'."
(if user
(let ((quoted (regexp-quote user)))
- (when (and (not (string= user quoted))
- (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)))
+ (when (and (not (string= user quoted))
+ (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)))
(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 is empty") 'active)
(erc-display-line (erc-make-notice "Ignore list:") 'active)
(mapc #'(lambda (item)
- (erc-display-line (erc-make-notice item)
- 'active))
- (erc-with-server-buffer erc-ignore-list))))
+ (erc-display-line (erc-make-notice item)
+ 'active))
+ (erc-with-server-buffer erc-ignore-list))))
t)
(defun erc-cmd-UNIGNORE (user)
"Remove the user specified in USER from the ignore list."
(let ((ignored-nick (car (erc-with-server-buffer
- (erc-member-ignore-case (regexp-quote user)
- erc-ignore-list)))))
+ (erc-member-ignore-case (regexp-quote user)
+ erc-ignore-list)))))
(unless ignored-nick
(if (setq ignored-nick (erc-ignored-user-p user))
- (unless (y-or-n-p (format "Remove this regexp (%s)? "
- ignored-nick))
- (setq ignored-nick nil))
- (erc-display-line
- (erc-make-notice (format "%s is not currently ignored!" user))
- 'active)))
+ (unless (y-or-n-p (format "Remove this regexp (%s)? "
+ ignored-nick))
+ (setq ignored-nick nil))
+ (erc-display-line
+ (erc-make-notice (format "%s is not currently ignored!" user))
+ 'active)))
(when ignored-nick
(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)))))
+ (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
t)
(defun erc-cmd-CLEAR ()
@@ -2834,20 +2905,20 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(interactive)
(let ((ops nil))
(if erc-channel-users
- (maphash (lambda (_nick user-data)
- (let ((cuser (cdr user-data)))
- (if (and cuser
- (erc-channel-user-op cuser))
- (setq ops (cons (erc-server-user-nickname
- (car user-data))
- ops)))))
- erc-channel-users))
+ (maphash (lambda (_nick user-data)
+ (let ((cuser (cdr user-data)))
+ (if (and cuser
+ (erc-channel-user-op cuser))
+ (setq ops (cons (erc-server-user-nickname
+ (car user-data))
+ ops)))))
+ erc-channel-users))
(setq ops (sort ops 'string-lessp))
(if ops
- (erc-display-message
- nil 'notice (current-buffer) 'ops
- ?i (length ops) ?s (if (> (length ops) 1) "s" "")
- ?o (mapconcat 'identity ops " "))
+ (erc-display-message
+ nil 'notice (current-buffer) 'ops
+ ?i (length ops) ?s (if (> (length ops) 1) "s" "")
+ ?o (mapconcat 'identity ops " "))
(erc-display-message nil 'notice (current-buffer) 'ops-none)))
t)
@@ -2856,11 +2927,11 @@ If no USER argument is specified, list the contents of `erc-ignore-list'."
(require 'mail-extr)
(let ((co (ignore-errors (what-domain tld))))
(if co
- (erc-display-message
- nil 'notice 'active 'country ?c co ?d tld)
+ (erc-display-message
+ nil 'notice 'active 'country ?c co ?d tld)
(erc-display-message
nil 'notice 'active 'country-unknown ?d tld))
- t))
+ t))
(put 'erc-cmd-COUNTRY 'process-not-needed t)
(defun erc-cmd-AWAY (line)
@@ -2871,8 +2942,8 @@ If no reason is given, unset away status."
(erc-log (format "cmd: AWAY: %s" reason))
(erc-server-send
(if (string= reason "")
- "AWAY"
- (concat "AWAY :" reason))))
+ "AWAY"
+ (concat "AWAY :" reason))))
t))
(put 'erc-cmd-AWAY 'do-not-parse-args t)
@@ -2890,8 +2961,8 @@ If no reason is given, unset away status."
CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME,
VERSION and so on. It is called with ARGS."
(let ((str (concat cmd
- (when args
- (concat " " (mapconcat #'identity args " "))))))
+ (when args
+ (concat " " (mapconcat #'identity args " "))))))
(erc-log (format "cmd: CTCP [%s]: [%s]" nick str))
(erc-send-ctcp-message nick str)
t))
@@ -2902,7 +2973,7 @@ VERSION and so on. It is called with ARGS."
If FUNC contains a valid function or variable, help about that
will be displayed. If FUNC is empty, display an apropos about
ERC commands. Otherwise, do `apropos' in the ERC namespace
-\(\"erc-.*LINE\"\).
+\(\"erc-.*LINE\").
Examples:
To find out about erc and bbdb, do
@@ -2914,29 +2985,29 @@ For help about the WHOIS command, do:
For a list of user commands (/join /part, ...):
/help."
(if func
- (let* ((sym (or (let ((sym (intern-soft
- (concat "erc-cmd-" (upcase func)))))
- (if (and sym (or (boundp sym) (fboundp sym)))
- sym
- nil))
- (let ((sym (intern-soft func)))
- (if (and sym (or (boundp sym) (fboundp sym)))
- sym
- nil))
- (let ((sym (intern-soft (concat "erc-" func))))
- (if (and sym (or (boundp sym) (fboundp sym)))
- sym
- nil)))))
- (if sym
- (cond
- ((boundp sym) (describe-variable sym))
- ((fboundp sym) (describe-function sym))
- (t nil))
- (apropos-command (concat "erc-.*" func) nil
- (lambda (x)
- (or (commandp x)
- (get x 'custom-type))))
- t))
+ (let* ((sym (or (let ((sym (intern-soft
+ (concat "erc-cmd-" (upcase func)))))
+ (if (and sym (or (boundp sym) (fboundp sym)))
+ sym
+ nil))
+ (let ((sym (intern-soft func)))
+ (if (and sym (or (boundp sym) (fboundp sym)))
+ sym
+ nil))
+ (let ((sym (intern-soft (concat "erc-" func))))
+ (if (and sym (or (boundp sym) (fboundp sym)))
+ sym
+ nil)))))
+ (if sym
+ (cond
+ ((boundp sym) (describe-variable sym))
+ ((fboundp sym) (describe-function sym))
+ (t nil))
+ (apropos-command (concat "erc-.*" func) nil
+ (lambda (x)
+ (or (commandp x)
+ (get x 'custom-type))))
+ t))
(apropos "erc-cmd-")
(message "Type C-h m to get additional information about keybindings.")
t))
@@ -2950,23 +3021,23 @@ If CHANNEL is specified as \"-invite\", join the channel to which you
were most recently invited. See also `invitation'."
(let (chnl)
(if (string= (upcase channel) "-INVITE")
- (if erc-invitation
- (setq chnl erc-invitation)
- (erc-display-message nil 'error (current-buffer) 'no-invitation))
+ (if erc-invitation
+ (setq chnl erc-invitation)
+ (erc-display-message nil 'error (current-buffer) 'no-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)))
- (erc-log (format "cmd: JOIN: %s" chnl))
- (erc-server-send (if (and chnl key)
- (format "JOIN %s %s" chnl key)
- (format "JOIN %s" chnl)))))))
+ (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)))
+ (erc-log (format "cmd: JOIN: %s" chnl))
+ (erc-server-send (if (and chnl key)
+ (format "JOIN %s %s" chnl key)
+ (format "JOIN %s" chnl)))))))
t)
(defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
@@ -2985,14 +3056,14 @@ If CHANNEL is not specified, display the users in the current channel.
This function clears the channel name list first, then sends the
command."
(let ((tgt (or (and (erc-channel-p channel) channel)
- (erc-default-target))))
+ (erc-default-target))))
(if (and tgt (erc-channel-p tgt))
- (progn
- (erc-log (format "cmd: DEFAULT: NAMES %s" tgt))
- (erc-with-buffer
- (tgt)
- (erc-channel-begin-receiving-names))
- (erc-server-send (concat "NAMES " tgt)))
+ (progn
+ (erc-log (format "cmd: DEFAULT: NAMES %s" tgt))
+ (erc-with-buffer
+ (tgt)
+ (erc-channel-begin-receiving-names))
+ (erc-server-send (concat "NAMES " tgt)))
(erc-display-message nil 'error (current-buffer) 'no-default-channel)))
t)
(defalias 'erc-cmd-N 'erc-cmd-NAMES)
@@ -3002,27 +3073,27 @@ command."
LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
(let ((reasonstring (mapconcat 'identity reasonwords " ")))
(if (string= "" reasonstring)
- (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
+ (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
(if (erc-channel-p target)
- (let ((nick reason-or-nick))
- (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring))
- (erc-server-send (format "KICK %s %s :%s" target nick reasonstring)
- nil target)
- t)
+ (let ((nick reason-or-nick))
+ (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring))
+ (erc-server-send (format "KICK %s %s :%s" target nick reasonstring)
+ nil target)
+ t)
(when target
- (let ((ch (erc-default-target)))
- (setq reasonstring (concat
- (if reason-or-nick (concat reason-or-nick " "))
- reasonstring))
- (if ch
- (progn
- (erc-log
- (format "cmd: KICK: %s/%s: %s" target ch reasonstring))
- (erc-server-send
- (format "KICK %s %s :%s" ch target reasonstring) nil ch))
- (erc-display-message nil 'error (current-buffer)
- 'no-default-channel))
- t)))))
+ (let ((ch (erc-default-target)))
+ (setq reasonstring (concat
+ (if reason-or-nick (concat reason-or-nick " "))
+ reasonstring))
+ (if ch
+ (progn
+ (erc-log
+ (format "cmd: KICK: %s/%s: %s" target ch reasonstring))
+ (erc-server-send
+ (format "KICK %s %s :%s" ch target reasonstring) nil ch))
+ (erc-display-message nil 'error (current-buffer)
+ 'no-default-channel))
+ t)))))
(defvar erc-script-args nil)
@@ -3037,20 +3108,20 @@ a script after exceeding the flood threshold."
(cond
((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line)
(let* ((file-to-find (match-string 1 line))
- (erc-script-args (match-string 2 line))
- (file (erc-find-file file-to-find erc-script-path)))
+ (erc-script-args (match-string 2 line))
+ (file (erc-find-file file-to-find erc-script-path)))
(erc-log (format "cmd: LOAD: %s" file-to-find))
(cond
((not file)
- (erc-display-message nil 'error (current-buffer)
- 'cannot-find-file ?f file-to-find))
+ (erc-display-message nil 'error (current-buffer)
+ 'cannot-find-file ?f file-to-find))
((not (file-readable-p file))
- (erc-display-message nil 'error (current-buffer)
- 'cannot-read-file ?f file))
+ (erc-display-message nil 'error (current-buffer)
+ 'cannot-read-file ?f file))
(t
- (message "Loading \'%s\'..." file)
- (erc-load-script file)
- (message "Loading \'%s\'...done" file))))
+ (message "Loading `%s'..." file)
+ (erc-load-script file)
+ (message "Loading `%s'...done" file))))
t)
(t nil)))
@@ -3060,11 +3131,11 @@ a script after exceeding the flood threshold."
If SERVER is non-nil, use that, rather than the current server."
;; FIXME: is the above docstring correct? -- Lawrence 2004-01-08
(let ((send (if server
- (format "WHOIS %s %s" user server)
- (format "WHOIS %s" user))))
+ (format "WHOIS %s %s" user server)
+ (format "WHOIS %s" user))))
(erc-log (format "cmd: %s" send))
(erc-server-send send)
- t))
+ t))
(defalias 'erc-cmd-WI 'erc-cmd-WHOIS)
(defun erc-cmd-WHOAMI ()
@@ -3075,78 +3146,78 @@ If SERVER is non-nil, use that, rather than the current server."
(defun erc-cmd-IDLE (nick)
"Show the length of time NICK has been idle."
(let ((origbuf (current-buffer))
- symlist)
+ symlist)
(erc-with-server-buffer
- (push (cons (erc-once-with-server-event
- 311 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-311-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 312 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-312-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 318 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-318-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 319 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-319-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 320 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-320-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 330 (lambda (_proc parsed)
- (string= nick
- (nth 1 (erc-response.command-args
- parsed)))))
- 'erc-server-330-functions)
- symlist)
- (push (cons (erc-once-with-server-event
- 317
- (lambda (_proc parsed)
- (let ((idleseconds
- (string-to-number
- (cl-third
- (erc-response.command-args parsed)))))
- (erc-display-line
- (erc-make-notice
- (format "%s has been idle for %s."
- (erc-string-no-properties nick)
- (erc-seconds-to-string idleseconds)))
- origbuf)
- t)))
- 'erc-server-317-functions)
- symlist)
-
- ;; Send the WHOIS command.
- (erc-cmd-WHOIS nick)
-
- ;; Remove the uninterned symbols from the server hooks that did not run.
- (run-at-time 20 nil (lambda (buf symlist)
- (with-current-buffer buf
- (dolist (sym symlist)
- (let ((hooksym (cdr sym))
- (funcsym (car sym)))
- (remove-hook hooksym funcsym t)))))
- (current-buffer) symlist)))
+ (push (cons (erc-once-with-server-event
+ 311 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-311-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 312 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-312-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 318 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-318-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 319 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-319-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 320 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-320-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 330 (lambda (_proc parsed)
+ (string= nick
+ (nth 1 (erc-response.command-args
+ parsed)))))
+ 'erc-server-330-functions)
+ symlist)
+ (push (cons (erc-once-with-server-event
+ 317
+ (lambda (_proc parsed)
+ (let ((idleseconds
+ (string-to-number
+ (cl-third
+ (erc-response.command-args parsed)))))
+ (erc-display-line
+ (erc-make-notice
+ (format "%s has been idle for %s."
+ (erc-string-no-properties nick)
+ (erc-seconds-to-string idleseconds)))
+ origbuf)
+ t)))
+ 'erc-server-317-functions)
+ symlist)
+
+ ;; Send the WHOIS command.
+ (erc-cmd-WHOIS nick)
+
+ ;; Remove the uninterned symbols from the server hooks that did not run.
+ (run-at-time 20 nil (lambda (buf symlist)
+ (with-current-buffer buf
+ (dolist (sym symlist)
+ (let ((hooksym (cdr sym))
+ (funcsym (car sym)))
+ (remove-hook hooksym funcsym t)))))
+ (current-buffer) symlist)))
t)
(defun erc-cmd-DESCRIBE (line)
@@ -3156,7 +3227,7 @@ LINE has the format \"USER ACTION\"."
((string-match
"^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line)
(let ((dst (match-string 1 line))
- (s (match-string 2 line)))
+ (s (match-string 2 line)))
(erc-log (format "cmd: DESCRIBE: [%s] %s" dst s))
(erc-send-action dst s))
t)
@@ -3188,7 +3259,7 @@ The lines are shown in a buffer named `*Occur*'.
It serves as a menu to find any of the occurrences in this buffer.
\\[describe-mode] in that buffer will explain how.
-If LINE contains upper case characters (excluding those preceded by `\'),
+If LINE contains upper case characters (excluding those preceded by `\\'),
the matching is case-sensitive."
(occur line)
t)
@@ -3202,7 +3273,7 @@ See also `erc-message' and `erc-display-line'."
(erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
(erc-display-line
(concat (erc-format-my-nick) line)
- (current-buffer))
+ (current-buffer))
;; FIXME - treat multiline, run hooks, or remove me?
t)
@@ -3228,7 +3299,7 @@ URL `http://freenode.net/using_the_network.shtml'."
"Send a notice to the channel or user given as the first word.
The rest is the message to send."
(erc-message "NOTICE" (concat channel-or-user " "
- (mapconcat #'identity message " "))))
+ (mapconcat #'identity message " "))))
(defun erc-cmd-MSG (line)
"Send a message to the channel or user given as the first word in LINE.
@@ -3249,16 +3320,16 @@ The rest of LINE is the message to send."
"Change current nickname to NICK."
(erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
(let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
- erc-server-parameters)))))
+ erc-server-parameters)))))
(and nicklen (> (length nick) (string-to-number nicklen))
- (erc-display-message
- nil 'notice 'active 'nick-too-long
- ?i (length nick) ?l nicklen)))
+ (erc-display-message
+ nil 'notice 'active 'nick-too-long
+ ?i (length nick) ?l nicklen)))
(erc-server-send (format "NICK %s" nick))
(cond (erc-bad-nick
- (erc-set-current-nick nick)
- (erc-update-mode-line)
- (setq erc-bad-nick nil)))
+ (erc-set-current-nick nick)
+ (erc-update-mode-line)
+ (setq erc-bad-nick nil)))
t)
(defun erc-cmd-PART (line)
@@ -3267,26 +3338,26 @@ Otherwise leave the channel indicated by LINE."
(cond
((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line)
(let* ((ch (match-string 1 line))
- (msg (match-string 2 line))
- (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
+ (msg (match-string 2 line))
+ (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
(erc-log (format "cmd: PART: %s: %s" ch reason))
(erc-server-send (if (string= reason "")
- (format "PART %s" ch)
- (format "PART %s :%s" ch reason))
- nil ch))
+ (format "PART %s" ch)
+ (format "PART %s :%s" ch reason))
+ nil ch))
t)
((string-match "^\\s-*\\(.*\\)$" line)
(let* ((ch (erc-default-target))
- (msg (match-string 1 line))
- (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
+ (msg (match-string 1 line))
+ (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
(if (and ch (erc-channel-p ch))
- (progn
- (erc-log (format "cmd: PART: %s: %s" ch reason))
- (erc-server-send (if (string= reason "")
- (format "PART %s" ch)
- (format "PART %s :%s" ch reason))
- nil ch))
- (erc-display-message nil 'error (current-buffer) 'no-target)))
+ (progn
+ (erc-log (format "cmd: PART: %s: %s" ch reason))
+ (erc-server-send (if (string= reason "")
+ (format "PART %s" ch)
+ (format "PART %s :%s" ch reason))
+ nil ch))
+ (erc-display-message nil 'error (current-buffer) 'no-target)))
t)
(t nil)))
(put 'erc-cmd-PART 'do-not-parse-args t)
@@ -3321,11 +3392,11 @@ See also `erc-auto-query' to decide how private messages from
other people should be displayed."
:group 'erc-query
:type '(choice (const :tag "Split window and select" window)
- (const :tag "Split window, don't select" window-noselect)
- (const :tag "New frame" frame)
- (const :tag "Bury in new buffer" bury)
- (const :tag "Use current buffer" buffer)
- (const :tag "Use current buffer" t)))
+ (const :tag "Split window, don't select" window-noselect)
+ (const :tag "New frame" frame)
+ (const :tag "Bury in new buffer" bury)
+ (const :tag "Use current buffer" buffer)
+ (const :tag "Use current buffer" t)))
(defun erc-cmd-QUERY (&optional user)
"Open a query with USER.
@@ -3337,22 +3408,24 @@ If USER is omitted, close the current query buffer if one exists
(interactive
(list (read-from-minibuffer "Start a query with: " nil)))
(let ((session-buffer (erc-server-buffer))
- (erc-join-buffer erc-query-display))
+ (erc-join-buffer erc-query-display))
(if user
- (erc-query user session-buffer)
+ (erc-query user session-buffer)
;; currently broken, evil hack to display help anyway
- ;(erc-delete-query))))
+ ;(erc-delete-query))))
(signal 'wrong-number-of-arguments ""))))
(defalias 'erc-cmd-Q 'erc-cmd-QUERY)
+(defun erc-quit/part-reason-default ()
+ "Default quit/part message."
+ (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version))
+
+
(defun erc-quit-reason-normal (&optional s)
"Normal quit message.
If S is non-nil, it will be used as the quit reason."
- (or s
- (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
- erc-version-string) ; erc-official-location)
- ))
+ (or s (erc-quit/part-reason-default)))
(defun erc-quit-reason-zippy (&optional s)
"Zippy quit message.
@@ -3360,8 +3433,8 @@ 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))
- (erc-quit-reason-normal))))
+ (erc-replace-regexp-in-string "\n" "" (yow))
+ (erc-quit/part-reason-default))))
(make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4")
@@ -3369,21 +3442,18 @@ If S is non-nil, it will be used as the quit reason."
"Choose a quit reason based on S (a string)."
(when (featurep 'xemacs) (require 'poe))
(let ((res (car (assoc-default (or s "")
- erc-quit-reason-various-alist 'string-match))))
+ erc-quit-reason-various-alist 'string-match))))
(cond
((functionp res) (funcall res))
((stringp res) res)
(s s)
- (t (erc-quit-reason-normal)))))
+ (t (erc-quit/part-reason-default)))))
(defun erc-part-reason-normal (&optional s)
"Normal part message.
-If S is non-nil, it will be used as the quit reason."
- (or s
- (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
- erc-version-string) ; erc-official-location)
- ))
+If S is non-nil, it will be used as the part reason."
+ (or s (erc-quit/part-reason-default)))
(defun erc-part-reason-zippy (&optional s)
"Zippy part message.
@@ -3391,8 +3461,8 @@ 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))
- (erc-part-reason-normal))))
+ (erc-replace-regexp-in-string "\n" "" (yow))
+ (erc-quit/part-reason-default))))
(make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4")
@@ -3400,12 +3470,12 @@ If S is non-nil, it will be used as the quit reason."
"Choose a part reason based on S (a string)."
(when (featurep 'xemacs) (require 'poe))
(let ((res (car (assoc-default (or s "")
- erc-part-reason-various-alist 'string-match))))
+ erc-part-reason-various-alist 'string-match))))
(cond
((functionp res) (funcall res))
((stringp res) res)
(s s)
- (t (erc-part-reason-normal)))))
+ (t (erc-quit/part-reason-default)))))
(defun erc-cmd-QUIT (reason)
"Disconnect from the current server.
@@ -3416,28 +3486,28 @@ the message given by REASON."
(cond
((string-match "^\\s-*\\(.*\\)$" reason)
(let* ((s (match-string 1 reason))
- (buffer (erc-server-buffer))
- (reason (funcall erc-quit-reason (if (equal s "") nil s)))
- server-proc)
+ (buffer (erc-server-buffer))
+ (reason (funcall erc-quit-reason (if (equal s "") nil s)))
+ server-proc)
(with-current-buffer (if (and buffer
- (bufferp buffer))
- buffer
- (current-buffer))
- (erc-log (format "cmd: QUIT: %s" reason))
- (setq erc-server-quitting t)
- (erc-set-active-buffer (erc-server-buffer))
- (setq server-proc erc-server-process)
- (erc-server-send (format "QUIT :%s" reason)))
+ (bufferp buffer))
+ buffer
+ (current-buffer))
+ (erc-log (format "cmd: QUIT: %s" reason))
+ (setq erc-server-quitting t)
+ (erc-set-active-buffer (erc-server-buffer))
+ (setq server-proc erc-server-process)
+ (erc-server-send (format "QUIT :%s" reason)))
(run-hook-with-args 'erc-quit-hook server-proc)
(when erc-kill-queries-on-quit
- (erc-kill-query-buffers server-proc))
+ (erc-kill-query-buffers server-proc))
;; if the process has not been killed within 4 seconds, kill it
(run-at-time 4 nil
- (lambda (proc)
- (when (and (processp proc)
- (memq (process-status proc) '(run open)))
- (delete-process proc)))
- server-proc))
+ (lambda (proc)
+ (when (and (processp proc)
+ (memq (process-status proc) '(run open)))
+ (delete-process proc)))
+ server-proc))
t)
(t nil)))
@@ -3450,7 +3520,7 @@ the message given by REASON."
(defun erc-cmd-GQUIT (reason)
"Disconnect from all servers at once with the same quit REASON."
(erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p
- (erc-cmd-QUIT reason))
+ (erc-cmd-QUIT reason))
(when erc-kill-queries-on-quit
;; if the query buffers have not been killed within 4 seconds,
;; kill them
@@ -3458,8 +3528,8 @@ the message given by REASON."
4 nil
(lambda ()
(dolist (buffer (erc-buffer-list (lambda (buf)
- (not (erc-server-buffer-p buf)))))
- (kill-buffer buffer)))))
+ (not (erc-server-buffer-p buf)))))
+ (kill-buffer buffer)))))
t)
(defalias 'erc-cmd-GQ 'erc-cmd-GQUIT)
@@ -3469,7 +3539,7 @@ the message given by REASON."
(defun erc-cmd-RECONNECT ()
"Try to reconnect to the current IRC server."
(let ((buffer (erc-server-buffer))
- (process nil))
+ (process nil))
(unless (buffer-live-p buffer)
(setq buffer (current-buffer)))
(with-current-buffer buffer
@@ -3478,8 +3548,8 @@ the message given by REASON."
(setq erc-server-reconnect-count 0)
(setq process (get-buffer-process (erc-server-buffer)))
(if process
- (delete-process process)
- (erc-server-reconnect))
+ (delete-process process)
+ (erc-server-reconnect))
(setq erc-server-reconnecting nil)))
t)
(put 'erc-cmd-RECONNECT 'process-not-needed t)
@@ -3499,55 +3569,54 @@ the message given by REASON."
(defun erc-cmd-SV ()
"Say the current ERC and Emacs version into channel."
- (erc-send-message (format "I'm using ERC %s with %s %s (%s%s) of %s."
- erc-version-string
- (if (featurep 'xemacs) "XEmacs" "GNU Emacs")
- emacs-version
- system-configuration
- (concat
- (cond ((featurep 'motif)
- (concat ", " (substring
- motif-version-string 4)))
- ((featurep 'gtk)
- (concat ", GTK+ Version "
- gtk-version-string))
- ((featurep 'x-toolkit) ", X toolkit")
- (t ""))
- (if (and (boundp 'x-toolkit-scroll-bars)
- (memq x-toolkit-scroll-bars
- '(xaw xaw3d)))
- (format ", %s scroll bars"
- (capitalize (symbol-name
- x-toolkit-scroll-bars)))
- "")
- (if (featurep 'multi-tty) ", multi-tty" ""))
- erc-emacs-build-time))
+ (erc-send-message (format "I'm using ERC with %s %s (%s%s) of %s."
+ (if (featurep 'xemacs) "XEmacs" "GNU Emacs")
+ emacs-version
+ system-configuration
+ (concat
+ (cond ((featurep 'motif)
+ (concat ", " (substring
+ motif-version-string 4)))
+ ((featurep 'gtk)
+ (concat ", GTK+ Version "
+ gtk-version-string))
+ ((featurep 'x-toolkit) ", X toolkit")
+ (t ""))
+ (if (and (boundp 'x-toolkit-scroll-bars)
+ (memq x-toolkit-scroll-bars
+ '(xaw xaw3d)))
+ (format ", %s scroll bars"
+ (capitalize (symbol-name
+ x-toolkit-scroll-bars)))
+ "")
+ (if (featurep 'multi-tty) ", multi-tty" ""))
+ erc-emacs-build-time))
t)
(defun erc-cmd-SM ()
"Say the current ERC modes into channel."
(erc-send-message (format "I'm using the following modules: %s!"
- (erc-modes)))
+ (erc-modes)))
t)
(defun erc-cmd-DEOP (&rest people)
"Remove the operator setting from user(s) given in PEOPLE."
(when (> (length people) 0)
(erc-server-send (concat "MODE " (erc-default-target)
- " -"
- (make-string (length people) ?o)
- " "
- (mapconcat 'identity people " ")))
+ " -"
+ (make-string (length people) ?o)
+ " "
+ (mapconcat 'identity people " ")))
t))
(defun erc-cmd-OP (&rest people)
"Add the operator setting to users(s) given in PEOPLE."
(when (> (length people) 0)
(erc-server-send (concat "MODE " (erc-default-target)
- " +"
- (make-string (length people) ?o)
- " "
- (mapconcat 'identity people " ")))
+ " +"
+ (make-string (length people) ?o)
+ " "
+ (mapconcat 'identity people " ")))
t))
(defun erc-cmd-TIME (&optional line)
@@ -3573,7 +3642,7 @@ be displayed."
;; /topic #channel TOPIC
((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic)
(let ((ch (match-string 1 topic))
- (topic (match-string 2 topic)))
+ (topic (match-string 2 topic)))
(erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
(erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
t)
@@ -3590,12 +3659,12 @@ be displayed."
;; /topic TOPIC
((string-match "^\\s-*\\(.*\\)$" topic)
(let ((ch (erc-default-target))
- (topic (match-string 1 topic)))
+ (topic (match-string 1 topic)))
(if (and ch (erc-channel-p ch))
- (progn
- (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
- (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
- (erc-display-message nil 'error (current-buffer) 'no-target)))
+ (progn
+ (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
+ (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
+ (erc-display-message nil 'error (current-buffer) 'no-target)))
t)
(t nil)))
(defalias 'erc-cmd-T 'erc-cmd-TOPIC)
@@ -3640,69 +3709,69 @@ or not the ban list has been requested from the server.")
The ban list is fetched from the server if necessary."
(let ((chnl (erc-default-target))
- (chnl-name (buffer-name)))
+ (chnl-name (buffer-name)))
(cond
((not (erc-channel-p chnl))
(erc-display-line (erc-make-notice "You're not on a channel\n")
- 'active))
+ 'active))
((not (get 'erc-channel-banlist 'received-from-server))
(let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store
- erc-channel-banlist nil)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl-name
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-BANLIST)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
+ (setq erc-server-367-functions 'erc-banlist-store
+ erc-channel-banlist nil)
+ ;; fetch the ban list then callback
+ (erc-with-server-buffer
+ (erc-once-with-server-event
+ 368
+ (lambda (_proc _parsed)
+ (with-current-buffer chnl-name
+ (put 'erc-channel-banlist 'received-from-server t)
+ (setq erc-server-367-functions old-367-hook)
+ (erc-cmd-BANLIST)
+ t)))
+ (erc-server-send (format "MODE %s b" chnl)))))
((null erc-channel-banlist)
(erc-display-line (erc-make-notice
- (format "No bans for channel: %s\n" chnl))
- 'active)
+ (format "No bans for channel: %s\n" chnl))
+ 'active)
(put 'erc-channel-banlist 'received-from-server nil))
(t
(let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
- erc-fill-column)
- (and (boundp 'fill-column)
- fill-column)
- (1- (window-width))))
- (separator (make-string erc-fill-column ?=))
- (fmt (concat
- "%-" (number-to-string (/ erc-fill-column 2)) "s"
- "%" (number-to-string (/ erc-fill-column 2)) "s")))
-
- (erc-display-line
- (erc-make-notice (format "Ban list for channel: %s\n"
- (erc-default-target)))
- 'active)
-
- (erc-display-line separator 'active)
- (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
- (erc-display-line separator 'active)
-
- (mapc
- (lambda (x)
- (erc-display-line
- (format fmt
- (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
- (if (car x)
- (truncate-string-to-width (car x) (/ erc-fill-column 2))
- ""))
- 'active))
- erc-channel-banlist)
-
- (erc-display-line (erc-make-notice "End of Ban list")
- 'active)
- (put 'erc-channel-banlist 'received-from-server nil)))))
+ erc-fill-column)
+ (and (boundp 'fill-column)
+ fill-column)
+ (1- (window-width))))
+ (separator (make-string erc-fill-column ?=))
+ (fmt (concat
+ "%-" (number-to-string (/ erc-fill-column 2)) "s"
+ "%" (number-to-string (/ erc-fill-column 2)) "s")))
+
+ (erc-display-line
+ (erc-make-notice (format "Ban list for channel: %s\n"
+ (erc-default-target)))
+ 'active)
+
+ (erc-display-line separator 'active)
+ (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
+ (erc-display-line separator 'active)
+
+ (mapc
+ (lambda (x)
+ (erc-display-line
+ (format fmt
+ (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
+ (if (car x)
+ (truncate-string-to-width (car x) (/ erc-fill-column 2))
+ ""))
+ 'active))
+ erc-channel-banlist)
+
+ (erc-display-line (erc-make-notice "End of Ban list")
+ 'active)
+ (put 'erc-channel-banlist 'received-from-server nil)))))
t)
(defalias 'erc-cmd-BL 'erc-cmd-BANLIST)
@@ -3721,31 +3790,31 @@ Unban all currently banned users in the current channel."
((not (get 'erc-channel-banlist 'received-from-server))
(let ((old-367-hook erc-server-367-functions))
- (setq erc-server-367-functions 'erc-banlist-store)
- ;; fetch the ban list then callback
- (erc-with-server-buffer
- (erc-once-with-server-event
- 368
- (lambda (_proc _parsed)
- (with-current-buffer chnl
- (put 'erc-channel-banlist 'received-from-server t)
- (setq erc-server-367-functions old-367-hook)
- (erc-cmd-MASSUNBAN)
- t)))
- (erc-server-send (format "MODE %s b" chnl)))))
-
- (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
- (when bans
- ;; Glob the bans into groups of three, and carry out the unban.
- ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
- (mapc
- (lambda (x)
- (erc-server-send
- (format "MODE %s -%s %s" (erc-default-target)
- (make-string (length x) ?b)
- (mapconcat 'identity x " "))))
- (erc-group-list bans 3))))
- t))))
+ (setq erc-server-367-functions 'erc-banlist-store)
+ ;; fetch the ban list then callback
+ (erc-with-server-buffer
+ (erc-once-with-server-event
+ 368
+ (lambda (_proc _parsed)
+ (with-current-buffer chnl
+ (put 'erc-channel-banlist 'received-from-server t)
+ (setq erc-server-367-functions old-367-hook)
+ (erc-cmd-MASSUNBAN)
+ t)))
+ (erc-server-send (format "MODE %s b" chnl)))))
+
+ (t (let ((bans (mapcar #'cdr erc-channel-banlist)))
+ (when bans
+ ;; Glob the bans into groups of three, and carry out the unban.
+ ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
+ (mapc
+ (lambda (x)
+ (erc-server-send
+ (format "MODE %s -%s %s" (erc-default-target)
+ (make-string (length x) ?b)
+ (mapconcat 'identity x " "))))
+ (erc-group-list bans 3))))
+ t))))
(defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
@@ -3769,12 +3838,12 @@ text again."
(erc-set-active-buffer (current-buffer))
(save-excursion
(let* ((cb (current-buffer))
- (buf (generate-new-buffer erc-grab-buffer-name))
- (region (buffer-substring start end))
- (lines (erc-split-multiline-safe region)))
+ (buf (generate-new-buffer erc-grab-buffer-name))
+ (region (buffer-substring start end))
+ (lines (erc-split-multiline-safe region)))
(set-buffer buf)
(dolist (line lines)
- (insert (concat line "\n")))
+ (insert (concat line "\n")))
(set-buffer cb)
(switch-to-buffer-other-window buf)))
(message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.")
@@ -3790,8 +3859,8 @@ If POS is nil, PROMPT will be displayed at `point'.
If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
`erc-prompt-face' will be used."
(let* ((prompt (or prompt (erc-prompt)))
- (l (length prompt))
- (ob (current-buffer)))
+ (l (length prompt))
+ (ob (current-buffer)))
;; We cannot use save-excursion because we move point, therefore
;; we resort to the ol' ob trick to restore this.
(when (and buffer (bufferp buffer))
@@ -3803,20 +3872,20 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
(setq pos (or pos (point)))
(goto-char pos)
(when (> l 0)
- ;; 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))
- (erc-put-text-property 0 (1- (length prompt))
- 'face (or face 'erc-prompt-face)
- prompt)
- (insert prompt))
+ ;; 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))
+ (erc-put-text-property 0 (1- (length prompt))
+ 'face (or face 'erc-prompt-face)
+ prompt)
+ (insert prompt))
;; Set the input marker
(set-marker erc-input-marker (point)))
@@ -3836,11 +3905,12 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
"Read input from the minibuffer."
(interactive)
(let ((minibuffer-allow-text-properties t)
- (read-map minibuffer-local-map))
+ (read-map minibuffer-local-map))
(insert (read-from-minibuffer "Message: "
- (string (if (featurep 'xemacs)
- last-command-char
- last-command-event)) read-map))
+ (string (if (featurep 'xemacs)
+ last-command-char
+ last-command-event))
+ read-map))
(erc-send-current-line)))
(defvar erc-action-history-list ()
@@ -3851,9 +3921,9 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
(interactive "")
(erc-set-active-buffer (current-buffer))
(let ((action (read-from-minibuffer
- "Action: " nil nil nil 'erc-action-history-list)))
+ "Action: " nil nil nil 'erc-action-history-list)))
(if (not (string-match "^\\s-*$" action))
- (erc-send-action (erc-default-target) action))))
+ (erc-send-action (erc-default-target) action))))
(defun erc-join-channel (channel &optional key)
"Join CHANNEL.
@@ -3862,9 +3932,9 @@ If `point' is at the beginning of a channel name, use that as default."
(interactive
(list
(let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) ""))
- (table (when (erc-server-buffer-live-p)
- (set-buffer (process-buffer erc-server-process))
- erc-channel-list)))
+ (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))
(when (or current-prefix-arg erc-prompt-for-channel-key)
(read-from-minibuffer "Channel key (RET for none): " nil))))
@@ -3875,9 +3945,9 @@ If `point' is at the beginning of a channel name, use that as default."
(interactive
(list
(if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
- reason
+ reason
(read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
- ": ")))))
+ ": ")))))
(erc-cmd-PART (concat (erc-default-target)" " reason)))
(defun erc-set-topic (topic)
@@ -3888,8 +3958,8 @@ If `point' is at the beginning of a channel name, use that as default."
(concat "Set topic of " (erc-default-target) ": ")
(when erc-channel-topic
(let ((ss (split-string erc-channel-topic "\C-o")))
- (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
- 0))))))
+ (cons (apply #'concat (if (cdr ss) (butlast ss) ss))
+ 0))))))
(let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
(erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
@@ -3897,31 +3967,31 @@ If `point' is at the beginning of a channel name, use that as default."
"Set a LIMIT for the current channel. Remove limit if nil.
Prompt for one if called interactively."
(interactive (list (read-from-minibuffer
- (format "Limit for %s (RET to remove limit): "
- (erc-default-target)))))
+ (format "Limit for %s (RET to remove limit): "
+ (erc-default-target)))))
(let ((tgt (erc-default-target)))
(erc-server-send (if (and limit (>= (length limit) 1))
- (format "MODE %s +l %s" tgt limit)
- (format "MODE %s -l" tgt)))))
+ (format "MODE %s +l %s" tgt limit)
+ (format "MODE %s -l" tgt)))))
(defun erc-set-channel-key (&optional key)
"Set a KEY for the current channel. Remove key if nil.
Prompt for one if called interactively."
(interactive (list (read-from-minibuffer
- (format "Key for %s (RET to remove key): "
- (erc-default-target)))))
+ (format "Key for %s (RET to remove key): "
+ (erc-default-target)))))
(let ((tgt (erc-default-target)))
(erc-server-send (if (and key (>= (length key) 1))
- (format "MODE %s +k %s" tgt key)
- (format "MODE %s -k" tgt)))))
+ (format "MODE %s +k %s" tgt key)
+ (format "MODE %s -k" tgt)))))
(defun erc-quit-server (reason)
"Disconnect from current server after prompting for REASON.
`erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
(interactive (list (read-from-minibuffer
- (format "Reason for quitting %s: "
- (or erc-server-announced-name
- erc-session-server)))))
+ (format "Reason for quitting %s: "
+ (or erc-server-announced-name
+ erc-session-server)))))
(erc-cmd-QUIT reason))
;; Movement of point
@@ -3940,10 +4010,10 @@ This places `point' just after the prompt, or at the beginning of the line."
"Kill current input line using `erc-bol' followed by `kill-line'."
(interactive)
(when (and (erc-bol)
- (/= (point) (point-max))) ;; Prevent a (ding) and an error when
- ;; there's nothing to kill
+ (/= (point) (point-max))) ;; Prevent a (ding) and an error when
+ ;; there's nothing to kill
(if (boundp 'erc-input-ring-index)
- (setq erc-input-ring-index nil))
+ (setq erc-input-ring-index nil))
(kill-line)))
(defun erc-complete-word-at-point ()
@@ -3953,7 +4023,7 @@ This places `point' just after the prompt, or at the beginning of the line."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; IRC SERVER INPUT HANDLING
+;; IRC SERVER INPUT HANDLING
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3963,7 +4033,7 @@ This places `point' just after the prompt, or at the beginning of the line."
; experiment area.
(defcustom erc-default-server-hook '(erc-debug-missing-hooks
- erc-default-server-handler)
+ erc-default-server-handler)
"Default for server messages which aren't covered by `erc-server-hooks'."
:group 'erc-server-hooks
:type 'hook)
@@ -3978,9 +4048,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'."
'identity
(let (res)
(mapc #'(lambda (x)
- (if (stringp x)
- (setq res (append res (list x)))))
- parsed)
+ (if (stringp x)
+ (setq res (append res (list x)))))
+ parsed)
res)
" ")))
@@ -4002,18 +4072,18 @@ See `erc-default-server-hook'."
To change how this query window is displayed, use `let' to bind
`erc-join-buffer' before calling this."
(unless (and server
- (buffer-live-p server)
- (set-buffer server))
+ (buffer-live-p server)
+ (set-buffer server))
(error "Couldn't switch to server buffer"))
(let ((buf (erc-open erc-session-server
- erc-session-port
- (erc-current-nick)
- erc-session-user-full-name
- nil
- nil
- (list target)
- target
- erc-server-process)))
+ erc-session-port
+ (erc-current-nick)
+ erc-session-user-full-name
+ nil
+ nil
+ (list target)
+ target
+ erc-server-process)))
(unless buf
(error "Couldn't open query window"))
(erc-update-mode-line)
@@ -4029,12 +4099,12 @@ a new window, but not to select it. See the documentation for
`erc-join-buffer' for a description of the available choices."
:group 'erc-query
:type '(choice (const :tag "Don't create query window" nil)
- (const :tag "Split window and select" window)
- (const :tag "Split window, don't select" window-noselect)
- (const :tag "New frame" frame)
- (const :tag "Bury in new buffer" bury)
- (const :tag "Use current buffer" buffer)
- (const :tag "Use current buffer" t)))
+ (const :tag "Split window and select" window)
+ (const :tag "Split window, don't select" window-noselect)
+ (const :tag "New frame" frame)
+ (const :tag "Bury in new buffer" bury)
+ (const :tag "Use current buffer" buffer)
+ (const :tag "Use current buffer" t)))
(defcustom erc-query-on-unjoined-chan-privmsg t
"If non-nil create query buffer on receiving any PRIVMSG at all.
@@ -4068,15 +4138,17 @@ unmodified if nothing can be removed.
E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
\"Read error: 110\". The same applies for \"Ping Timeout\"."
(setq nick (regexp-quote nick)
- login (regexp-quote login)
- host (regexp-quote host))
+ login (regexp-quote login)
+ host (regexp-quote host))
(or (when (string-match (concat "^\\(Read error\\) to "
- nick "\\[" host "\\]: "
- "\\(.+\\)$") reason)
- (concat (match-string 1 reason) ": " (match-string 2 reason)))
+ nick "\\[" host "\\]: "
+ "\\(.+\\)$")
+ reason)
+ (concat (match-string 1 reason) ": " (match-string 2 reason)))
(when (string-match (concat "^\\(Ping timeout\\) for "
- nick "\\[" host "\\]$") reason)
- (match-string 1 reason))
+ nick "\\[" host "\\]$")
+ reason)
+ (match-string 1 reason))
reason))
(defun erc-nickname-in-use (nick reason)
@@ -4084,40 +4156,40 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
See also `erc-display-error-notice'."
(if (or (not erc-try-new-nick-p)
- ;; how many default-nicks are left + one more try...
- (eq erc-nick-change-attempt-count
- (if (consp erc-nick)
- (+ (length erc-nick) 1)
- 1)))
+ ;; how many default-nicks are left + one more try...
+ (eq erc-nick-change-attempt-count
+ (if (consp erc-nick)
+ (+ (length erc-nick) 1)
+ 1)))
(erc-display-error-notice
nil
(format "Nickname %s is %s, try another." nick reason))
(setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
(let ((newnick (nth 1 erc-default-nicks))
- (nicklen (cdr (assoc "NICKLEN"
- (erc-with-server-buffer
- erc-server-parameters)))))
+ (nicklen (cdr (assoc "NICKLEN"
+ (erc-with-server-buffer
+ erc-server-parameters)))))
(setq erc-bad-nick t)
;; try to use a different nick
(if erc-default-nicks
- (setq erc-default-nicks (cdr erc-default-nicks)))
+ (setq erc-default-nicks (cdr erc-default-nicks)))
(if (not newnick)
- (setq newnick (concat (truncate-string-to-width
- nick
- (if (and erc-server-connected nicklen)
- (- (string-to-number nicklen)
- (length erc-nick-uniquifier))
- ;; rfc2812 max nick length = 9
- ;; we must assume this is the
- ;; server's setting if we haven't
- ;; established a connection yet
- (- 9 (length erc-nick-uniquifier))))
+ (setq newnick (concat (truncate-string-to-width
+ nick
+ (if (and erc-server-connected nicklen)
+ (- (string-to-number nicklen)
+ (length erc-nick-uniquifier))
+ ;; rfc2812 max nick length = 9
+ ;; we must assume this is the
+ ;; server's setting if we haven't
+ ;; established a connection yet
+ (- 9 (length erc-nick-uniquifier))))
erc-nick-uniquifier)))
(erc-cmd-NICK newnick)
(erc-display-error-notice
nil
(format "Nickname %s is %s, trying %s"
- nick reason newnick)))))
+ nick reason newnick)))))
;;; Server messages
@@ -4141,21 +4213,21 @@ and as second argument the event parsed as a vector."
"Put this on `erc-server-PRIVMSG-functions'."
(when erc-auto-query
(let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
- (target (car (erc-response.command-args parsed)))
- (msg (erc-response.contents parsed))
- (query (if (not erc-query-on-unjoined-chan-privmsg)
- nick
- (if (erc-current-nick-p target)
- nick
- target))))
+ (target (car (erc-response.command-args parsed)))
+ (msg (erc-response.contents parsed))
+ (query (if (not erc-query-on-unjoined-chan-privmsg)
+ nick
+ (if (erc-current-nick-p target)
+ nick
+ target))))
(and (not (erc-ignored-user-p (erc-response.sender parsed)))
- (or erc-query-on-unjoined-chan-privmsg
- (string= target (erc-current-nick)))
- (not (erc-get-buffer query proc))
- (not (erc-is-message-ctcp-and-not-action-p msg))
- (let ((erc-query-display erc-auto-query))
- (erc-cmd-QUERY query))
- nil))))
+ (or erc-query-on-unjoined-chan-privmsg
+ (string= target (erc-current-nick)))
+ (not (erc-get-buffer query proc))
+ (not (erc-is-message-ctcp-and-not-action-p msg))
+ (let ((erc-query-display erc-auto-query))
+ (erc-cmd-QUERY query))
+ nil))))
(defun erc-is-message-ctcp-p (message)
"Check if MESSAGE is a CTCP message or not."
@@ -4169,16 +4241,16 @@ and as second argument the event parsed as a vector."
(defun erc-format-privmessage (nick msg privp msgp)
"Format a PRIVMSG in an insertable fashion."
(let* ((mark-s (if msgp (if privp "*" "<") "-"))
- (mark-e (if msgp (if privp "*" ">") "-"))
- (str (format "%s%s%s %s" mark-s nick mark-e msg))
- (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
- (msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
+ (mark-e (if msgp (if privp "*" ">") "-"))
+ (str (format "%s%s%s %s" mark-s nick mark-e msg))
+ (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
+ (msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
;; add text properties to text before the nick, the nick and after the nick
(erc-put-text-property 0 (length mark-s) 'face msg-face str)
(erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
- 'face nick-face str)
+ 'face nick-face str)
(erc-put-text-property (+ (length mark-s) (length nick)) (length str)
- 'face msg-face str)
+ 'face msg-face str)
str))
(defcustom erc-format-nick-function 'erc-format-nick
@@ -4191,26 +4263,45 @@ and as second argument the event parsed as a vector."
See also `erc-format-nick-function'."
(when user (erc-server-user-nickname user)))
-(defun erc-format-@nick (&optional user channel-data)
- "Format the nickname of USER showing if USER is an operator or has voice.
-Operators have \"@\" and users with voice have \"+\" as a prefix.
-Use CHANNEL-DATA to determine op and voice status.
-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"))
+ ((erc-channel-user-admin-p user)
+ (erc-propertize "&" 'help-echo "admin"))
+ ((erc-channel-user-op-p user)
+ (erc-propertize "@" 'help-echo "operator"))
+ ((erc-channel-user-halfop-p user)
+ (erc-propertize "%" 'help-echo "half-op"))
+ ((erc-channel-user-voice-p user)
+ (erc-propertize "+" 'help-echo "voice"))
+ (t ""))))
+
+(defun erc-format-@nick (&optional user _channel-data)
+ "Format the nickname of USER showing if USER has a voice, is an
+operator, half-op, admin or owner. Owners have \"~\", admins have
+\"&\", operators have \"@\" and users with voice have \"+\" as a
+prefix. Use CHANNEL-DATA to determine op and voice status. See
+also `erc-format-nick-function'."
(when user
- (let ((op (and channel-data (erc-channel-user-op channel-data) "@"))
- (voice (and channel-data (erc-channel-user-voice channel-data) "+")))
- (concat voice op (erc-server-user-nickname user)))))
+ (let ((nick (erc-server-user-nickname user)))
+ (concat (erc-propertize
+ (erc-get-user-mode-prefix nick)
+ 'face 'erc-nick-prefix-face)
+ nick))))
(defun erc-format-my-nick ()
"Return the beginning of this user's message, correctly propertized."
(if erc-show-my-nick
- (let ((open "<")
- (close "> ")
- (nick (erc-current-nick)))
- (concat
- (erc-propertize open 'face 'erc-default-face)
- (erc-propertize nick 'face 'erc-my-nick-face)
- (erc-propertize close 'face 'erc-default-face)))
+ (let* ((open "<")
+ (close "> ")
+ (nick (erc-current-nick))
+ (mode (erc-get-user-mode-prefix nick)))
+ (concat
+ (erc-propertize open 'face 'erc-default-face)
+ (erc-propertize mode 'face 'erc-my-nick-prefix-face)
+ (erc-propertize nick 'face 'erc-my-nick-face)
+ (erc-propertize close 'face 'erc-default-face)))
(let ((prefix "> "))
(erc-propertize prefix 'face 'erc-default-face))))
@@ -4274,7 +4365,7 @@ See also: `erc-echo-notice-in-first-user-buffer',
`erc-buffer-list-with-nick'."
(let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
(if buffers
- (progn (erc-display-message parsed nil buffers s) t)
+ (progn (erc-display-message parsed nil buffers s) t)
nil)))
(defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender)
@@ -4289,8 +4380,8 @@ See also: `erc-echo-notice-in-user-buffers',
`erc-buffer-list-with-nick'."
(let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
(unless (memq buffer buffers) (push buffer buffers))
- (if buffers ;FIXME: How could it be nil?
- (progn (erc-display-message parsed nil buffers s) t)
+ (if buffers ;FIXME: How could it be nil?
+ (progn (erc-display-message parsed nil buffers s) t)
nil)))
(defun erc-echo-notice-in-first-user-buffer (s parsed _buffer sender)
@@ -4304,7 +4395,7 @@ See also: `erc-echo-notice-in-user-buffers',
`erc-buffer-list-with-nick'."
(let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
(if buffers
- (progn (erc-display-message parsed nil (car buffers) s) t)
+ (progn (erc-display-message parsed nil (car buffers) s) t)
nil)))
;;; Ban manipulation
@@ -4312,61 +4403,61 @@ See also: `erc-echo-notice-in-user-buffers',
(defun erc-banlist-store (proc parsed)
"Record ban entries for a channel."
(pcase-let ((`(,channel ,mask ,whoset)
- (cdr (erc-response.command-args parsed))))
+ (cdr (erc-response.command-args parsed))))
;; Determine to which buffer the message corresponds
(let ((buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
- (unless (member (cons whoset mask) erc-channel-banlist)
- (setq erc-channel-banlist (cons (cons whoset mask)
- erc-channel-banlist))))))
+ (unless (member (cons whoset mask) erc-channel-banlist)
+ (setq erc-channel-banlist (cons (cons whoset mask)
+ erc-channel-banlist))))))
nil)
(defun erc-banlist-finished (proc parsed)
"Record that we have received the banlist."
(let* ((channel (nth 1 (erc-response.command-args parsed)))
- (buffer (erc-get-buffer channel proc)))
+ (buffer (erc-get-buffer channel proc)))
(with-current-buffer buffer
(put 'erc-channel-banlist 'received-from-server t)))
- t) ; suppress the 'end of banlist' message
+ t) ; suppress the 'end of banlist' message
(defun erc-banlist-update (proc parsed)
"Check MODE commands for bans and update the banlist appropriately."
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
(let* ((tgt (car (erc-response.command-args parsed)))
- (mode (erc-response.contents parsed))
- (whoset (erc-response.sender parsed))
- (buffer (erc-get-buffer tgt proc)))
+ (mode (erc-response.contents parsed))
+ (whoset (erc-response.sender parsed))
+ (buffer (erc-get-buffer tgt proc)))
(when buffer
(with-current-buffer buffer
- (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil)
- ((string-match "^\\([+-]\\)b" mode)
- ;; This is a ban
- (cond
- ((string-match "^-" mode)
- ;; Remove the unbanned masks from the ban list
- (setq erc-channel-banlist
- (erc-delete-if
- #'(lambda (y)
- (member (upcase (cdr y))
- (mapcar #'upcase
- (cdr (split-string mode)))))
- erc-channel-banlist)))
- ((string-match "^+" mode)
- ;; Add the banned mask(s) to the ban list
- (mapc
- (lambda (mask)
- (unless (member (cons whoset mask) erc-channel-banlist)
- (setq erc-channel-banlist
- (cons (cons whoset mask) erc-channel-banlist))))
- (cdr (split-string mode))))))))))
+ (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil)
+ ((string-match "^\\([+-]\\)b" mode)
+ ;; This is a ban
+ (cond
+ ((string-match "^-" mode)
+ ;; Remove the unbanned masks from the ban list
+ (setq erc-channel-banlist
+ (erc-delete-if
+ #'(lambda (y)
+ (member (upcase (cdr y))
+ (mapcar #'upcase
+ (cdr (split-string mode)))))
+ erc-channel-banlist)))
+ ((string-match "^+" mode)
+ ;; Add the banned mask(s) to the ban list
+ (mapc
+ (lambda (mask)
+ (unless (member (cons whoset mask) erc-channel-banlist)
+ (setq erc-channel-banlist
+ (cons (cons whoset mask) erc-channel-banlist))))
+ (cdr (split-string mode))))))))))
nil)
;; used for the banlist cmds
(defun erc-group-list (list n)
"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)))))
+ ((null (nthcdr n list)) (list list))
+ (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
;;; MOTD numreplies
@@ -4375,11 +4466,11 @@ See also: `erc-echo-notice-in-user-buffers',
"Handle the logging in process of connection."
(unless erc-logged-in
(setq erc-logged-in t)
- (message "Logging in as \'%s\'... done" (erc-current-nick))
+ (message "Logging in as `%s'... done" (erc-current-nick))
;; execute a startup script
(let ((f (erc-select-startup-file)))
(when f
- (erc-load-script f)))))
+ (erc-load-script f)))))
(defun erc-connection-established (proc parsed)
"Run just after connection.
@@ -4388,14 +4479,14 @@ Set user modes and run `erc-after-connect' hook."
(with-current-buffer (process-buffer proc)
(unless erc-server-connected ; only once per session
(let ((server (or erc-server-announced-name
- (erc-response.sender parsed)))
- (nick (car (erc-response.command-args parsed)))
- (buffer (process-buffer proc)))
- (setq erc-server-connected t)
- (erc-update-mode-line)
- (erc-set-initial-user-mode nick buffer)
- (erc-server-setup-periodical-ping buffer)
- (run-hook-with-args 'erc-after-connect server nick)))))
+ (erc-response.sender parsed)))
+ (nick (car (erc-response.command-args parsed)))
+ (buffer (process-buffer proc)))
+ (setq erc-server-connected t)
+ (erc-update-mode-line)
+ (erc-set-initial-user-mode nick buffer)
+ (erc-server-setup-periodical-ping buffer)
+ (run-hook-with-args 'erc-after-connect server nick)))))
(defun erc-set-initial-user-mode (nick buffer)
"If `erc-user-mode' is non-nil for NICK, set the user modes.
@@ -4403,11 +4494,11 @@ The server buffer is given by BUFFER."
(with-current-buffer buffer
(when erc-user-mode
(let ((mode (if (functionp erc-user-mode)
- (funcall erc-user-mode)
- erc-user-mode)))
- (when (stringp mode)
- (erc-log (format "changing mode for %s to %s" nick mode))
- (erc-server-send (format "MODE %s %s" nick mode)))))))
+ (funcall erc-user-mode)
+ erc-user-mode)))
+ (when (stringp mode)
+ (erc-log (format "changing mode for %s to %s" nick mode))
+ (erc-server-send (format "MODE %s %s" nick mode)))))))
(defun erc-display-error-notice (parsed string)
"Display STRING as an error notice.
@@ -4420,41 +4511,41 @@ See also `erc-display-message'."
;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08
"Process a CTCP query."
(let ((queries (delete "" (split-string (erc-response.contents parsed)
- "\C-a"))))
+ "\C-a"))))
(if (> (length queries) 4)
- (erc-display-message
- parsed (list 'notice 'error) proc 'ctcp-too-many)
+ (erc-display-message
+ parsed (list 'notice 'error) proc 'ctcp-too-many)
(if (= 0 (length queries))
- (erc-display-message
- parsed (list 'notice 'error) proc
- 'ctcp-empty ?n nick)
- (while queries
- (let* ((type (upcase (car (split-string (car queries)))))
- (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
- (if (and hook (boundp hook))
- (if (string-equal type "ACTION")
- (run-hook-with-args-until-success
- hook proc parsed nick login host
- (car (erc-response.command-args parsed))
- (car queries))
- (when erc-paranoid
- (if (erc-current-nick-p
- (car (erc-response.command-args parsed)))
- (erc-display-message
- parsed 'error 'active 'ctcp-request
- ?n nick ?u login ?h host ?r (car queries))
- (erc-display-message
- parsed 'error 'active 'ctcp-request-to
- ?n nick ?u login ?h host ?r (car queries)
- ?t (car (erc-response.command-args parsed)))))
- (run-hook-with-args-until-success
- hook proc nick login host
- (car (erc-response.command-args parsed))
- (car queries)))
- (erc-display-message
- parsed (list 'notice 'error) proc
- 'undefined-ctcp)))
- (setq queries (cdr queries)))))))
+ (erc-display-message
+ parsed (list 'notice 'error) proc
+ 'ctcp-empty ?n nick)
+ (while queries
+ (let* ((type (upcase (car (split-string (car queries)))))
+ (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
+ (if (and hook (boundp hook))
+ (if (string-equal type "ACTION")
+ (run-hook-with-args-until-success
+ hook proc parsed nick login host
+ (car (erc-response.command-args parsed))
+ (car queries))
+ (when erc-paranoid
+ (if (erc-current-nick-p
+ (car (erc-response.command-args parsed)))
+ (erc-display-message
+ parsed 'error 'active 'ctcp-request
+ ?n nick ?u login ?h host ?r (car queries))
+ (erc-display-message
+ parsed 'error 'active 'ctcp-request-to
+ ?n nick ?u login ?h host ?r (car queries)
+ ?t (car (erc-response.command-args parsed)))))
+ (run-hook-with-args-until-success
+ hook proc nick login host
+ (car (erc-response.command-args parsed))
+ (car queries)))
+ (erc-display-message
+ parsed (list 'notice 'error) proc
+ 'undefined-ctcp)))
+ (setq queries (cdr queries)))))))
(defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION))
@@ -4462,9 +4553,9 @@ See also `erc-display-message'."
"Respond to a CTCP ACTION query."
(when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg)
(let ((s (match-string 1 msg))
- (buf (or (erc-get-buffer to proc)
- (erc-get-buffer nick proc)
- (process-buffer proc))))
+ (buf (or (erc-get-buffer to proc)
+ (erc-get-buffer nick proc)
+ (process-buffer proc))))
(erc-display-message
parsed 'action buf
'ACTION ?n nick ?u login ?h host ?a s))))
@@ -4476,7 +4567,7 @@ See also `erc-display-message'."
(when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg)
(let ((s (erc-client-info (erc-trim-string (match-string 1 msg)))))
(unless erc-disable-ctcp-replies
- (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s)))))
+ (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s)))))
nil)
(defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO))
@@ -4485,7 +4576,7 @@ See also `erc-display-message'."
(when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
(let ((s (match-string 1 msg)))
(unless erc-disable-ctcp-replies
- (erc-send-ctcp-notice nick (format "ECHO %s" s)))))
+ (erc-send-ctcp-notice nick (format "ECHO %s" s)))))
nil)
(defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER))
@@ -4493,15 +4584,15 @@ See also `erc-display-message'."
"Respond to a CTCP FINGER query."
(unless erc-disable-ctcp-replies
(let ((s (if erc-anonymous-login
- (format "FINGER I'm %s." (erc-current-nick))
- (format "FINGER %s (%s@%s)."
- (user-full-name)
- (user-login-name)
- (system-name))))
- (ns (erc-time-diff erc-server-last-sent-time (erc-current-time))))
- (when (> ns 0)
- (setq s (concat s " Idle for " (erc-sec-to-time ns))))
- (erc-send-ctcp-notice nick s)))
+ (format "FINGER I'm %s." (erc-current-nick))
+ (format "FINGER %s (%s@%s)."
+ (user-full-name)
+ (user-login-name)
+ (system-name))))
+ (ns (erc-time-diff erc-server-last-sent-time (erc-current-time))))
+ (when (> ns 0)
+ (setq s (concat s " Idle for " (erc-sec-to-time ns))))
+ (erc-send-ctcp-notice nick s)))
nil)
(defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING))
@@ -4510,7 +4601,7 @@ See also `erc-display-message'."
(when (string-match "^PING\\s-+\\(.*\\)" msg)
(unless erc-disable-ctcp-replies
(let ((arg (match-string 1 msg)))
- (erc-send-ctcp-notice nick (format "PING %s" arg)))))
+ (erc-send-ctcp-notice nick (format "PING %s" arg)))))
nil)
(defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME))
@@ -4533,19 +4624,19 @@ See also `erc-display-message'."
(unless erc-disable-ctcp-replies
(erc-send-ctcp-notice
nick (format
- "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)"
- erc-version-string
- erc-official-location)))
+ "VERSION \C-bERC\C-b - an IRC client for Emacs %s (\C-b%s\C-b)"
+ emacs-version
+ erc-official-location)))
nil)
(defun erc-process-ctcp-reply (proc parsed nick login host msg)
"Process MSG as a CTCP reply."
(let* ((type (car (split-string msg)))
- (hook (intern (concat "erc-ctcp-reply-" type "-hook"))))
+ (hook (intern (concat "erc-ctcp-reply-" type "-hook"))))
(if (boundp hook)
- (run-hook-with-args-until-success
- hook proc nick login host
- (car (erc-response.command-args parsed)) msg)
+ (run-hook-with-args-until-success
+ hook proc nick login host
+ (car (erc-response.command-args parsed)) msg)
(erc-display-message
parsed 'notice 'active
'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg))))
@@ -4587,16 +4678,16 @@ See also `erc-display-message'."
nil
(let ((time (match-string 1 msg)))
(condition-case nil
- (let ((delta (erc-time-diff (string-to-number time)
- (erc-current-time))))
- (erc-display-message
- nil 'notice 'active
- 'CTCP-PING ?n nick
- ?t (erc-sec-to-time delta)))
- (range-error
- (erc-display-message
- nil 'error 'active
- 'bad-ping-response ?n nick ?t time))))))
+ (let ((delta (erc-time-diff (string-to-number time)
+ (erc-current-time))))
+ (erc-display-message
+ nil 'notice 'active
+ 'CTCP-PING ?n nick
+ ?t (erc-sec-to-time delta)))
+ (range-error
+ (erc-display-message
+ nil 'error 'active
+ 'bad-ping-response ?n nick ?t time))))))
(defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME))
(defun erc-ctcp-reply-TIME (_proc nick _login _host _to msg)
@@ -4626,31 +4717,31 @@ If non-nil, return from being away."
(let ((sessionbuf (process-buffer proc)))
(when sessionbuf
(with-current-buffer sessionbuf
- (when erc-away-nickname
- (erc-log (format "erc-process-away: away-nick: %s, away-p: %s"
- erc-away-nickname away-p))
- (erc-cmd-NICK (if away-p
- erc-away-nickname
- erc-nick)))
- (cond
- (away-p
- (setq erc-away (current-time)))
- (t
- (let ((away-time erc-away))
- ;; away must be set to NIL BEFORE sending anything to prevent
- ;; an infinite recursion
- (setq erc-away nil)
- (with-current-buffer (erc-active-buffer)
- (when erc-public-away-p
- (erc-send-action
- (erc-default-target)
- (if away-time
- (format "is back (gone for %s)"
- (erc-sec-to-time
- (erc-time-diff
- (erc-emacs-time-to-erc-time away-time)
- (erc-current-time))))
- "is back")))))))))
+ (when erc-away-nickname
+ (erc-log (format "erc-process-away: away-nick: %s, away-p: %s"
+ erc-away-nickname away-p))
+ (erc-cmd-NICK (if away-p
+ erc-away-nickname
+ erc-nick)))
+ (cond
+ (away-p
+ (setq erc-away (current-time)))
+ (t
+ (let ((away-time erc-away))
+ ;; away must be set to NIL BEFORE sending anything to prevent
+ ;; an infinite recursion
+ (setq erc-away nil)
+ (with-current-buffer (erc-active-buffer)
+ (when erc-public-away-p
+ (erc-send-action
+ (erc-default-target)
+ (if away-time
+ (format "is back (gone for %s)"
+ (erc-sec-to-time
+ (erc-time-diff
+ (erc-emacs-time-to-erc-time away-time)
+ (erc-current-time))))
+ "is back")))))))))
(erc-update-mode-line)))
;;;; List of channel members handling
@@ -4673,30 +4764,30 @@ channel buffer.
See also `erc-channel-begin-receiving-names'."
(maphash (lambda (nick _user)
- (if (null (gethash nick erc-channel-new-member-names))
- (erc-remove-channel-user nick)))
- erc-channel-users)
+ (if (null (gethash nick erc-channel-new-member-names))
+ (erc-remove-channel-user nick)))
+ erc-channel-users)
(setq erc-channel-new-member-names nil))
(defun erc-parse-prefix ()
"Return an alist of valid prefix character types and their representations.
Example: (operator) o => @, (voiced) v => +."
(let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
- erc-server-parameters)))
- ;; provide a sane default
- "(ov)@+"))
- types chars)
+ erc-server-parameters)))
+ ;; provide a sane default
+ "(qaohv)~&@%+"))
+ types chars)
(when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
(setq types (match-string 1 str)
- chars (match-string 2 str))
+ chars (match-string 2 str))
(let ((len (min (length types) (length chars)))
- (i 0)
- (alist nil))
- (while (< i len)
- (setq alist (cons (cons (elt types i) (elt chars i))
- alist))
- (setq i (1+ i)))
- alist))))
+ (i 0)
+ (alist nil))
+ (while (< i len)
+ (setq alist (cons (cons (elt types i) (elt chars i))
+ alist))
+ (setq i (1+ i)))
+ alist))))
(defun erc-channel-receive-names (names-string)
"This function is for internal use only.
@@ -4704,40 +4795,39 @@ Example: (operator) o => @, (voiced) v => +."
Update `erc-channel-users' according to NAMES-STRING.
NAMES-STRING is a string listing some of the names on the
channel."
- (let (prefix op-ch voice-ch names name op voice)
- (setq prefix (erc-parse-prefix))
- (setq op-ch (cdr (assq ?o prefix))
- voice-ch (cdr (assq ?v prefix)))
- ;; We need to delete "" because in XEmacs, (split-string "a ")
- ;; returns ("a" "").
- (setq names (delete "" (split-string names-string)))
+ (let* ((prefix (erc-parse-prefix))
+ (voice-ch (cdr (assq ?v prefix)))
+ (op-ch (cdr (assq ?o prefix)))
+ (hop-ch (cdr (assq ?h prefix)))
+ (adm-ch (cdr (assq ?a prefix)))
+ (own-ch (cdr (assq ?q prefix)))
+ (names (delete "" (split-string names-string)))
+ name op voice halfop admin owner)
(let ((erc-channel-members-changed-hook nil))
(dolist (item names)
- (let ((updatep t))
- (if (rassq (elt item 0) prefix)
- (cond ((= (length item) 1)
- (setq updatep nil))
- ((eq (elt item 0) op-ch)
- (setq name (substring item 1)
- op 'on
- voice 'off))
- ((eq (elt item 0) voice-ch)
- (setq name (substring item 1)
- op 'off
- voice 'on))
- (t (setq name (substring item 1)
- op 'off
- voice 'off)))
- (setq name item
- op 'off
- voice 'off))
- (when updatep
- (puthash (erc-downcase name) t
- erc-channel-new-member-names)
- (erc-update-current-channel-member
- name name t op voice)))))
+ (let ((updatep t)
+ (ch (aref item 0)))
+ (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off)
+ (if (rassq ch prefix)
+ (if (= (length item) 1)
+ (setq updatep nil)
+ (setq name (substring item 1))
+ (setf (pcase ch
+ ((pred (eq voice-ch)) voice)
+ ((pred (eq hop-ch)) halfop)
+ ((pred (eq op-ch)) op)
+ ((pred (eq adm-ch)) admin)
+ ((pred (eq own-ch)) owner)
+ (_ (error "Unknown prefix char `%S'" ch) voice))
+ 'on)))
+ (when updatep
+ (puthash (erc-downcase name) t
+ erc-channel-new-member-names)
+ (erc-update-current-channel-member
+ name name t voice halfop op admin owner)))))
(run-hooks 'erc-channel-members-changed-hook)))
+
(defcustom erc-channel-members-changed-hook nil
"This hook is called every time the variable `channel-members' changes.
The buffer where the change happened is current while this hook is called."
@@ -4745,15 +4835,15 @@ The buffer where the change happened is current while this hook is called."
:type 'hook)
(defun erc-update-user-nick (nick &optional new-nick
- host login full-name info)
+ host login full-name info)
"Update the stored user information for the user with nickname NICK.
See also: `erc-update-user'."
(erc-update-user (erc-get-server-user nick) new-nick
- host login full-name info))
+ host login full-name info))
(defun erc-update-user (user &optional new-nick
- host login full-name info)
+ host login full-name info)
"Update user info for USER. USER must be an erc-server-user
struct. Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are
non-nil and not equal to the existing values for USER are used to
@@ -4765,45 +4855,44 @@ which USER is a member, and t is returned."
(let (changed)
(when user
(when (and new-nick
- (not (equal (erc-server-user-nickname user)
- new-nick)))
- (setq changed t)
- (erc-change-user-nickname user new-nick))
+ (not (equal (erc-server-user-nickname user)
+ new-nick)))
+ (setq changed t)
+ (erc-change-user-nickname user new-nick))
(when (and host
- (not (equal (erc-server-user-host user) host)))
- (setq changed t)
- (setf (erc-server-user-host user) host))
+ (not (equal (erc-server-user-host user) host)))
+ (setq changed t)
+ (setf (erc-server-user-host user) host))
(when (and login
- (not (equal (erc-server-user-login user) login)))
- (setq changed t)
- (setf (erc-server-user-login user) login))
+ (not (equal (erc-server-user-login user) login)))
+ (setq changed t)
+ (setf (erc-server-user-login user) login))
(when (and full-name
- (not (equal (erc-server-user-full-name user)
- full-name)))
- (setq changed t)
- (setf (erc-server-user-full-name user) full-name))
+ (not (equal (erc-server-user-full-name user)
+ full-name)))
+ (setq changed t)
+ (setf (erc-server-user-full-name user) full-name))
(when (and info
- (not (equal (erc-server-user-info user) info)))
- (setq changed t)
- (setf (erc-server-user-info user) info))
+ (not (equal (erc-server-user-info user) info)))
+ (setq changed t)
+ (setf (erc-server-user-info user) info))
(if changed
- (dolist (buf (erc-server-user-buffers user))
- (if (buffer-live-p buf)
- (with-current-buffer buf
- (run-hooks 'erc-channel-members-changed-hook))))))
+ (dolist (buf (erc-server-user-buffers user))
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (run-hooks 'erc-channel-members-changed-hook))))))
changed))
(defun erc-update-current-channel-member
- (nick new-nick &optional add op voice host login full-name info
- update-message-time)
+ (nick new-nick &optional add voice halfop op admin owner host login full-name info
+ update-message-time)
"Update the stored user information for the user with nickname NICK.
`erc-update-user' is called to handle changes to nickname,
-HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil,
-they must be equal to either `on' or `off', in which case the
-operator or voice status of the user in the current channel is
-changed accordingly. If UPDATE-MESSAGE-TIME is non-nil, the
-last-message-time of the user in the current channel is set
-to (current-time).
+HOST, LOGIN, FULL-NAME, and INFO. If VOICE HALFOP OP ADMIN or OWNER
+are non-nil, they must be equal to either `on' or `off', in which
+case the status of the user in the current channel is changed accordingly.
+If UPDATE-MESSAGE-TIME is non-nil, the last-message-time of the user
+ in the current channel is set to (current-time).
If ADD is non-nil, the user will be added with the specified
information if it is not already present in the user or channel
@@ -4814,74 +4903,104 @@ If, and only if, changes are made, or the user is added,
See also: `erc-update-user' and `erc-update-channel-member'."
(let* (changed user-changed
- (channel-data (erc-get-channel-user nick))
- (cuser (cdr channel-data))
- (user (if channel-data (car channel-data)
- (erc-get-server-user nick))))
+ (channel-data (erc-get-channel-user nick))
+ (cuser (cdr channel-data))
+ (user (if channel-data (car channel-data)
+ (erc-get-server-user nick))))
(if cuser
- (progn
- (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
- (when (and op
- (not (eq (erc-channel-user-op cuser) op)))
- (setq changed t)
- (setf (erc-channel-user-op cuser)
- (cond ((eq op 'on) t)
- ((eq op 'off) nil)
- (t op))))
- (when (and voice
- (not (eq (erc-channel-user-voice cuser) voice)))
- (setq changed t)
- (setf (erc-channel-user-voice cuser)
- (cond ((eq voice 'on) t)
- ((eq voice 'off) nil)
- (t voice))))
- (when update-message-time
- (setf (erc-channel-user-last-message-time cuser) (current-time)))
- (setq user-changed
- (erc-update-user user new-nick
- host login full-name info)))
+ (progn
+ (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
+ (when (and voice
+ (not (eq (erc-channel-user-voice cuser) voice)))
+ (setq changed t)
+ (setf (erc-channel-user-voice cuser)
+ (cond ((eq voice 'on) t)
+ ((eq voice 'off) nil)
+ (t voice))))
+ (when (and halfop
+ (not (eq (erc-channel-user-halfop cuser) halfop)))
+ (setq changed t)
+ (setf (erc-channel-user-halfop cuser)
+ (cond ((eq halfop 'on) t)
+ ((eq halfop 'off) nil)
+ (t halfop))))
+ (when (and op
+ (not (eq (erc-channel-user-op cuser) op)))
+ (setq changed t)
+ (setf (erc-channel-user-op cuser)
+ (cond ((eq op 'on) t)
+ ((eq op 'off) nil)
+ (t op))))
+ (when (and admin
+ (not (eq (erc-channel-user-admin cuser) admin)))
+ (setq changed t)
+ (setf (erc-channel-user-admin cuser)
+ (cond ((eq admin 'on) t)
+ ((eq admin 'off) nil)
+ (t admin))))
+ (when (and owner
+ (not (eq (erc-channel-user-owner cuser) owner)))
+ (setq changed t)
+ (setf (erc-channel-user-owner cuser)
+ (cond ((eq owner 'on) t)
+ ((eq owner 'off) nil)
+ (t owner))))
+ (when update-message-time
+ (setf (erc-channel-user-last-message-time cuser) (current-time)))
+ (setq user-changed
+ (erc-update-user user new-nick
+ host login full-name info)))
(when add
- (if (null user)
- (progn
- (setq user (make-erc-server-user
- :nickname nick
- :host host
- :full-name full-name
- :login login
- :info info
- :buffers (list (current-buffer))))
- (erc-add-server-user nick user))
- (setf (erc-server-user-buffers user)
- (cons (current-buffer)
- (erc-server-user-buffers user))))
- (setq cuser (make-erc-channel-user
- :op (cond ((eq op 'on) t)
- ((eq op 'off) nil)
- (t op))
- :voice (cond ((eq voice 'on) t)
- ((eq voice 'off) nil)
- (t voice))
- :last-message-time
- (if update-message-time (current-time))))
- (puthash (erc-downcase nick) (cons user cuser)
- erc-channel-users)
- (setq changed t)))
+ (if (null user)
+ (progn
+ (setq user (make-erc-server-user
+ :nickname nick
+ :host host
+ :full-name full-name
+ :login login
+ :info info
+ :buffers (list (current-buffer))))
+ (erc-add-server-user nick user))
+ (setf (erc-server-user-buffers user)
+ (cons (current-buffer)
+ (erc-server-user-buffers user))))
+ (setq cuser (make-erc-channel-user
+ :voice (cond ((eq voice 'on) t)
+ ((eq voice 'off) nil)
+ (t voice))
+ :halfop (cond ((eq halfop 'on) t)
+ ((eq halfop 'off) nil)
+ (t halfop))
+ :op (cond ((eq op 'on) t)
+ ((eq op 'off) nil)
+ (t op))
+ :admin (cond ((eq admin 'on) t)
+ ((eq admin 'off) nil)
+ (t admin))
+ :owner (cond ((eq owner 'on) t)
+ ((eq owner 'off) nil)
+ (t owner))
+ :last-message-time
+ (if update-message-time (current-time))))
+ (puthash (erc-downcase nick) (cons user cuser)
+ erc-channel-users)
+ (setq changed t)))
(when (and changed (null user-changed))
(run-hooks 'erc-channel-members-changed-hook))
(or changed user-changed add)))
(defun erc-update-channel-member (channel nick new-nick
- &optional add op voice host login
- full-name info update-message-time)
+ &optional add voice halfop op admin owner host login
+ full-name info update-message-time)
"Update user and channel information for the user with
nickname NICK in channel CHANNEL.
See also: `erc-update-current-channel-member'."
(erc-with-buffer
- (channel)
- (erc-update-current-channel-member nick new-nick add op voice host
- login full-name info
- update-message-time)))
+ (channel)
+ (erc-update-current-channel-member nick new-nick add voice halfop op admin owner host
+ login full-name info
+ update-message-time)))
(defun erc-remove-current-channel-member (nick)
"Remove NICK from current channel membership list.
@@ -4896,8 +5015,8 @@ Runs `erc-channel-members-changed-hook'."
See also `erc-remove-current-channel-member'."
(erc-with-buffer
- (channel)
- (erc-remove-current-channel-member nick)))
+ (channel)
+ (erc-remove-current-channel-member nick)))
(defun erc-update-channel-topic (channel topic &optional modify)
"Find a buffer for CHANNEL and set the TOPIC for it.
@@ -4906,40 +5025,40 @@ If optional MODIFY is 'append or 'prepend, then append or prepend the
TOPIC string to the current topic."
(erc-with-buffer (channel)
(cond ((eq modify 'append)
- (setq erc-channel-topic (concat erc-channel-topic topic)))
- ((eq modify 'prepend)
- (setq erc-channel-topic (concat topic erc-channel-topic)))
- (t (setq erc-channel-topic topic)))
+ (setq erc-channel-topic (concat erc-channel-topic topic)))
+ ((eq modify 'prepend)
+ (setq erc-channel-topic (concat topic erc-channel-topic)))
+ (t (setq erc-channel-topic topic)))
(erc-update-mode-line-buffer (current-buffer))))
(defun erc-set-modes (tgt mode-string)
"Set the modes for the TGT provided as MODE-STRING."
(let* ((modes (erc-parse-modes mode-string))
- (add-modes (nth 0 modes))
- ;; list of triples: (mode-char 'on/'off argument)
- (arg-modes (nth 2 modes)))
+ (add-modes (nth 0 modes))
+ ;; list of triples: (mode-char 'on/'off argument)
+ (arg-modes (nth 2 modes)))
(cond ((erc-channel-p tgt); channel modes
- (let ((buf (and erc-server-process
- (erc-get-buffer tgt erc-server-process))))
- (when buf
- (with-current-buffer buf
- (setq erc-channel-modes add-modes)
- (setq erc-channel-user-limit nil)
- (setq erc-channel-key nil)
- (while arg-modes
- (let ((mode (nth 0 (car arg-modes)))
- (onoff (nth 1 (car arg-modes)))
- (arg (nth 2 (car arg-modes))))
- (cond ((string-match "^[Ll]" mode)
- (erc-update-channel-limit tgt onoff arg))
- ((string-match "^[Kk]" mode)
- (erc-update-channel-key tgt onoff arg))
- (t nil)))
- (setq arg-modes (cdr arg-modes)))
- (erc-update-mode-line-buffer buf)))))
- ;; we do not keep our nick's modes yet
- ;;(t (setq erc-user-modes add-modes))
- )
+ (let ((buf (and erc-server-process
+ (erc-get-buffer tgt erc-server-process))))
+ (when buf
+ (with-current-buffer buf
+ (setq erc-channel-modes add-modes)
+ (setq erc-channel-user-limit nil)
+ (setq erc-channel-key nil)
+ (while arg-modes
+ (let ((mode (nth 0 (car arg-modes)))
+ (onoff (nth 1 (car arg-modes)))
+ (arg (nth 2 (car arg-modes))))
+ (cond ((string-match "^[Ll]" mode)
+ (erc-update-channel-limit tgt onoff arg))
+ ((string-match "^[Kk]" mode)
+ (erc-update-channel-key tgt onoff arg))
+ (t nil)))
+ (setq arg-modes (cdr arg-modes)))
+ (erc-update-mode-line-buffer buf)))))
+ ;; we do not keep our nick's modes yet
+ ;;(t (setq erc-user-modes add-modes))
+ )
))
(defun erc-sort-strings (list-of-strings)
@@ -4961,110 +5080,115 @@ arg-modes is a list of triples of the form:
(MODE-CHAR ON/OFF ARGUMENT)."
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
- (let ((chars (mapcar 'char-to-string (match-string 1 mode-string)))
- ;; arguments in channel modes
- (args-str (match-string 2 mode-string))
- (args nil)
- (add-modes nil)
- (remove-modes nil)
- (arg-modes nil); list of triples: (mode-char 'on/'off argument)
- (add-p t))
- ;; make the argument list
- (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str)
- (setq args (cons (match-string 1 args-str) args))
- (setq args-str (match-string 2 args-str)))
- (setq args (nreverse args))
- ;; collect what modes changed, and match them with arguments
- (while chars
- (cond ((string= (car chars) "+") (setq add-p t))
- ((string= (car chars) "-") (setq add-p nil))
- ((string-match "^[ovbOVB]" (car chars))
- (setq arg-modes (cons (list (car chars)
- (if add-p 'on 'off)
- (if args (car args) nil))
- arg-modes))
- (if args (setq args (cdr args))))
- ((string-match "^[LlKk]" (car chars))
- (setq arg-modes (cons (list (car chars)
- (if add-p 'on 'off)
- (if (and add-p args)
- (car args) nil))
- arg-modes))
- (if (and add-p args) (setq args (cdr args))))
- (add-p (setq add-modes (cons (car chars) add-modes)))
- (t (setq remove-modes (cons (car chars) remove-modes))))
- (setq chars (cdr chars)))
- (setq add-modes (nreverse add-modes))
- (setq remove-modes (nreverse remove-modes))
- (setq arg-modes (nreverse arg-modes))
- (list add-modes remove-modes arg-modes))
+ (let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
+ ;; arguments in channel modes
+ (args-str (match-string 2 mode-string))
+ (args nil)
+ (add-modes nil)
+ (remove-modes nil)
+ (arg-modes nil); list of triples: (mode-char 'on/'off argument)
+ (add-p t))
+ ;; make the argument list
+ (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str)
+ (setq args (cons (match-string 1 args-str) args))
+ (setq args-str (match-string 2 args-str)))
+ (setq args (nreverse args))
+ ;; collect what modes changed, and match them with arguments
+ (while chars
+ (cond ((string= (car chars) "+") (setq add-p t))
+ ((string= (car chars) "-") (setq add-p nil))
+ ((string-match "^[qaovhbQAOVHB]" (car chars))
+ (setq arg-modes (cons (list (car chars)
+ (if add-p 'on 'off)
+ (if args (car args) nil))
+ arg-modes))
+ (if args (setq args (cdr args))))
+ ((string-match "^[LlKk]" (car chars))
+ (setq arg-modes (cons (list (car chars)
+ (if add-p 'on 'off)
+ (if (and add-p args)
+ (car args) nil))
+ arg-modes))
+ (if (and add-p args) (setq args (cdr args))))
+ (add-p (setq add-modes (cons (car chars) add-modes)))
+ (t (setq remove-modes (cons (car chars) remove-modes))))
+ (setq chars (cdr chars)))
+ (setq add-modes (nreverse add-modes))
+ (setq remove-modes (nreverse remove-modes))
+ (setq arg-modes (nreverse arg-modes))
+ (list add-modes remove-modes arg-modes))
nil))
-(defun erc-update-modes (tgt mode-string &optional nick host login)
+(defun erc-update-modes (tgt mode-string &optional _nick _host _login)
"Update the mode information for TGT, provided as MODE-STRING.
Optional arguments: NICK, HOST and LOGIN - the attributes of the
person who changed the modes."
;; FIXME: neither of nick, host, and login are used!
(let* ((modes (erc-parse-modes mode-string))
- (add-modes (nth 0 modes))
- (remove-modes (nth 1 modes))
- ;; list of triples: (mode-char 'on/'off argument)
- (arg-modes (nth 2 modes)))
+ (add-modes (nth 0 modes))
+ (remove-modes (nth 1 modes))
+ ;; list of triples: (mode-char 'on/'off argument)
+ (arg-modes (nth 2 modes)))
;; now parse the modes changes and do the updates
(cond ((erc-channel-p tgt); channel modes
- (let ((buf (and erc-server-process
- (erc-get-buffer tgt erc-server-process))))
- (when buf
- ;; FIXME! This used to have an original buffer
- ;; variable, but it never switched back to the original
- ;; buffer. Is this wanted behavior?
- (set-buffer buf)
- (if (not (boundp 'erc-channel-modes))
- (setq erc-channel-modes nil))
- (while remove-modes
- (setq erc-channel-modes (delete (car remove-modes)
- erc-channel-modes)
- remove-modes (cdr remove-modes)))
- (while add-modes
- (setq erc-channel-modes (cons (car add-modes)
- erc-channel-modes)
- add-modes (cdr add-modes)))
- (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
- (while arg-modes
- (let ((mode (nth 0 (car arg-modes)))
- (onoff (nth 1 (car arg-modes)))
- (arg (nth 2 (car arg-modes))))
- (cond ((string-match "^[oO]" mode)
- (erc-update-channel-member tgt arg arg nil onoff))
- ((string-match "^[Vv]" mode)
- (erc-update-channel-member tgt arg arg nil nil
- onoff))
- ((string-match "^[Ll]" mode)
- (erc-update-channel-limit tgt onoff arg))
- ((string-match "^[Kk]" mode)
- (erc-update-channel-key tgt onoff arg))
- (t nil)); only ops are tracked now
- (setq arg-modes (cdr arg-modes))))
- (erc-update-mode-line buf))))
- ;; nick modes - ignored at this point
- (t nil))))
+ (let ((buf (and erc-server-process
+ (erc-get-buffer tgt erc-server-process))))
+ (when buf
+ ;; FIXME! This used to have an original buffer
+ ;; variable, but it never switched back to the original
+ ;; buffer. Is this wanted behavior?
+ (set-buffer buf)
+ (if (not (boundp 'erc-channel-modes))
+ (setq erc-channel-modes nil))
+ (while remove-modes
+ (setq erc-channel-modes (delete (car remove-modes)
+ erc-channel-modes)
+ remove-modes (cdr remove-modes)))
+ (while add-modes
+ (setq erc-channel-modes (cons (car add-modes)
+ erc-channel-modes)
+ add-modes (cdr add-modes)))
+ (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
+ (while arg-modes
+ (let ((mode (nth 0 (car arg-modes)))
+ (onoff (nth 1 (car arg-modes)))
+ (arg (nth 2 (car arg-modes))))
+ (cond ((string-match "^[Vv]" mode)
+ (erc-update-channel-member tgt arg arg nil onoff))
+ ((string-match "^[hH]" mode)
+ (erc-update-channel-member tgt arg arg nil nil onoff))
+ ((string-match "^[oO]" mode)
+ (erc-update-channel-member tgt arg arg nil nil nil onoff))
+ ((string-match "^[aA]" mode)
+ (erc-update-channel-member tgt arg arg nil nil nil nil onoff))
+ ((string-match "^[qQ]" mode)
+ (erc-update-channel-member tgt arg arg nil nil nil nil nil onoff))
+ ((string-match "^[Ll]" mode)
+ (erc-update-channel-limit tgt onoff arg))
+ ((string-match "^[Kk]" mode)
+ (erc-update-channel-key tgt onoff arg))
+ (t nil)); only ops are tracked now
+ (setq arg-modes (cdr arg-modes))))
+ (erc-update-mode-line buf))))
+ ;; nick modes - ignored at this point
+ (t nil))))
(defun erc-update-channel-limit (channel onoff n)
;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
"Update CHANNEL's user limit to N."
(if (or (not (eq onoff 'on))
- (and (stringp n) (string-match "^[0-9]+$" n)))
+ (and (stringp n) (string-match "^[0-9]+$" n)))
(erc-with-buffer
- (channel)
- (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n)))
- (t (setq erc-channel-user-limit nil))))))
+ (channel)
+ (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n)))
+ (t (setq erc-channel-user-limit nil))))))
(defun erc-update-channel-key (channel onoff key)
"Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off."
(erc-with-buffer
- (channel)
- (cond ((eq onoff 'on) (setq erc-channel-key key))
- (t (setq erc-channel-key nil)))))
+ (channel)
+ (cond ((eq onoff 'on) (setq erc-channel-key key))
+ (t (setq erc-channel-key nil)))))
(defun erc-handle-user-status-change (type nlh &optional l)
"Handle changes in any user's status.
@@ -5077,9 +5201,9 @@ and L is a list containing additional TYPE-specific arguments.
So far the following TYPE/L pairs are supported:
- Event TYPE L
+ Event TYPE L
- nickname change 'nick (NEW-NICK)"
+ nickname change `nick' (NEW-NICK)"
(erc-log (format "user-change: type: %S nlh: %S l: %S" type nlh l))
(cond
;; nickname change
@@ -5094,7 +5218,7 @@ See also variable `erc-notice-highlight-type'."
(cond
((eq erc-notice-highlight-type 'prefix)
(erc-put-text-property 0 (length erc-notice-prefix)
- 'face 'erc-notice-face s)
+ 'face 'erc-notice-face s)
s)
((eq erc-notice-highlight-type 'all)
(erc-put-text-property 0 (length s) 'face 'erc-notice-face s)
@@ -5138,13 +5262,13 @@ Return a list of the three separate tokens."
(cond
((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string)
(list (match-string 1 string)
- (match-string 2 string)
- (match-string 3 string)))
+ (match-string 2 string)
+ (match-string 3 string)))
;; Some bogus bouncers send Nick!(null), try to live with that.
((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string)
(list (match-string 1 string)
- ""
- (match-string 2 string)))
+ ""
+ (match-string 2 string)))
(t
(list string "" ""))))
@@ -5155,7 +5279,7 @@ See also `erc-parse-user'."
(car (erc-parse-user string)))
(defun erc-put-text-properties (start end properties
- &optional object value-list)
+ &optional object value-list)
"Set text-properties for OBJECT.
START and END describe positions in OBJECT.
@@ -5163,7 +5287,7 @@ If VALUE-LIST is nil, set each property in PROPERTIES to t, else set
each property to the corresponding value in VALUE-LIST."
(unless value-list
(setq value-list (mapcar (lambda (_x) t)
- properties)))
+ properties)))
(while (and properties value-list)
(erc-put-text-property
start end (pop properties) (pop value-list) object)))
@@ -5175,7 +5299,7 @@ each property to the corresponding value in VALUE-LIST."
Specifically, return the position of `erc-insert-marker'."
(or (and (boundp 'erc-insert-marker)
- (markerp erc-insert-marker))
+ (markerp erc-insert-marker))
(error "erc-insert-marker has no value, please report a bug"))
(marker-position erc-insert-marker))
@@ -5189,11 +5313,10 @@ If that function has never been called, the value is 0.")
(defcustom erc-accidental-paste-threshold-seconds nil
"Minimum time, in seconds, before sending new lines via IRC.
-If the value is a number, `erc-send-current-line' signals an
-error if its previous invocation was less than this much time
-ago. This is useful so that if you accidentally enter large
-amounts of text into the ERC buffer, that text is not sent to the
-IRC server.
+If the value is a number, `erc-send-current-line' signals an error
+if its previous invocation was fewer than this many seconds ago.
+This is useful so that if you accidentally enter large amounts of text
+into the ERC buffer, that text is not sent to the IRC server.
If the value is nil, `erc-send-current-line' always considers any
submitted line to be intentional."
@@ -5206,43 +5329,43 @@ submitted line to be intentional."
(interactive)
(let ((now (float-time)))
(if (or (not erc-accidental-paste-threshold-seconds)
- (< erc-accidental-paste-threshold-seconds
- (- now erc-last-input-time)))
- (save-restriction
- (widen)
- (if (< (point) (erc-beg-of-input-line))
- (erc-error "Point is not in the input area")
- (let ((inhibit-read-only t)
- (str (erc-user-input))
- (old-buf (current-buffer)))
- (if (and (not (erc-server-buffer-live-p))
- (not (erc-command-no-process-p str)))
- (erc-error "ERC: No process running")
- (erc-set-active-buffer (current-buffer))
- ;; Kill the input and the prompt
- (delete-region (erc-beg-of-input-line)
- (erc-end-of-input-line))
- (unwind-protect
- (erc-send-input str)
- ;; Fix the buffer if the command didn't kill it
- (when (buffer-live-p old-buf)
- (with-current-buffer old-buf
- (save-restriction
- (widen)
- (goto-char (point-max))
- (when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
- (set-marker erc-insert-marker (point))
- (let ((buffer-modified (buffer-modified-p)))
- (erc-display-prompt)
- (set-buffer-modified-p buffer-modified))))))
-
- ;; Only when last hook has been run...
- (run-hook-with-args 'erc-send-completed-hook str))))
- (setq erc-last-input-time now))
+ (< erc-accidental-paste-threshold-seconds
+ (- now erc-last-input-time)))
+ (save-restriction
+ (widen)
+ (if (< (point) (erc-beg-of-input-line))
+ (erc-error "Point is not in the input area")
+ (let ((inhibit-read-only t)
+ (str (erc-user-input))
+ (old-buf (current-buffer)))
+ (if (and (not (erc-server-buffer-live-p))
+ (not (erc-command-no-process-p str)))
+ (erc-error "ERC: No process running")
+ (erc-set-active-buffer (current-buffer))
+ ;; Kill the input and the prompt
+ (delete-region (erc-beg-of-input-line)
+ (erc-end-of-input-line))
+ (unwind-protect
+ (erc-send-input str)
+ ;; Fix the buffer if the command didn't kill it
+ (when (buffer-live-p old-buf)
+ (with-current-buffer old-buf
+ (save-restriction
+ (widen)
+ (goto-char (point-max))
+ (when (processp erc-server-process)
+ (set-marker (process-mark erc-server-process) (point)))
+ (set-marker erc-insert-marker (point))
+ (let ((buffer-modified (buffer-modified-p)))
+ (erc-display-prompt)
+ (set-buffer-modified-p buffer-modified))))))
+
+ ;; Only when last hook has been run...
+ (run-hook-with-args 'erc-send-completed-hook str))))
+ (setq erc-last-input-time now))
(switch-to-buffer "*ERC Accidental Paste Overflow*")
(lwarn 'erc :warning
- "You seem to have accidentally pasted some text!"))))
+ "You seem to have accidentally pasted some text!"))))
(defun erc-user-input ()
"Return the input of the user in the current buffer."
@@ -5261,56 +5384,55 @@ This returns non-nil only if we actually send anything."
(cond
;; Ignore empty input
((if erc-send-whitespace-lines
- (string= input "")
+ (string= input "")
(string-match "\\`[ \t\r\f\n]*\\'" input))
(when erc-warn-about-blank-lines
(message "Blank line - ignoring...")
(beep))
nil)
(t
+ (defvar str) ;; FIXME: Make it obey the "erc-" prefix convention.
(let ((str input)
- (erc-insert-this t))
+ (erc-insert-this t))
(setq erc-send-this t)
(run-hook-with-args 'erc-send-pre-hook input)
(when erc-send-this
- (if (or (string-match "\n" str)
- (not (string-match erc-command-regexp str)))
- (mapc
- (lambda (line)
- (mapc
- (lambda (line)
- ;; Insert what has to be inserted for this.
- (erc-display-msg line)
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect) t))
- (or (and erc-flood-protect (erc-split-line line))
- (list line))))
- (split-string str "\n"))
- ;; Insert the prompt along with the command.
- (erc-display-command str)
- (erc-process-input-line (concat str "\n") t nil))
- t)))))
+ (if (or (string-match "\n" str)
+ (not (string-match erc-command-regexp str)))
+ (mapc
+ (lambda (line)
+ (mapc
+ (lambda (line)
+ ;; Insert what has to be inserted for this.
+ (erc-display-msg line)
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect) t))
+ (or (and erc-flood-protect (erc-split-line line))
+ (list line))))
+ (split-string str "\n"))
+ (erc-process-input-line (concat str "\n") t nil))
+ t)))))
(defun erc-display-command (line)
(when erc-insert-this
(let ((insert-position (point)))
(unless erc-hide-prompt
- (erc-display-prompt nil nil (erc-command-indicator)
- (and (erc-command-indicator)
- 'erc-command-indicator-face)))
+ (erc-display-prompt nil nil (erc-command-indicator)
+ (and (erc-command-indicator)
+ 'erc-command-indicator-face)))
(let ((beg (point)))
- (insert line)
- (erc-put-text-property beg (point)
- 'face 'erc-command-indicator-face)
- (insert "\n"))
+ (insert line)
+ (erc-put-text-property beg (point)
+ 'face 'erc-command-indicator-face)
+ (insert "\n"))
(when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
+ (set-marker (process-mark erc-server-process) (point)))
(set-marker erc-insert-marker (point))
(save-excursion
- (save-restriction
- (narrow-to-region insert-position (point))
- (run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))))))
+ (save-restriction
+ (narrow-to-region insert-position (point))
+ (run-hooks 'erc-send-modify-hook)
+ (run-hooks 'erc-send-post-hook))))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at the
@@ -5319,18 +5441,18 @@ current position."
(let ((insert-position (point)))
(insert (erc-format-my-nick))
(let ((beg (point)))
- (insert line)
- (erc-put-text-property beg (point)
- 'face 'erc-input-face))
+ (insert line)
+ (erc-put-text-property beg (point)
+ 'face 'erc-input-face))
(insert "\n")
(when (processp erc-server-process)
- (set-marker (process-mark erc-server-process) (point)))
+ (set-marker (process-mark erc-server-process) (point)))
(set-marker erc-insert-marker (point))
(save-excursion
- (save-restriction
- (narrow-to-region insert-position (point))
- (run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))))))
+ (save-restriction
+ (narrow-to-region insert-position (point))
+ (run-hooks 'erc-send-modify-hook)
+ (run-hooks 'erc-send-post-hook))))))
(defun erc-command-symbol (command)
"Return the ERC command symbol for COMMAND if it exists and is bound."
@@ -5343,16 +5465,16 @@ If no command was given, return nil. If command matches, return a
list of the form: (command args) where both elements are strings."
(when (string-match erc-command-regexp line)
(let* ((cmd (erc-command-symbol (match-string 1 line)))
- ;; note: return is nil, we apply this simply for side effects
- (_canon-defun (while (and cmd (symbolp (symbol-function cmd)))
- (setq cmd (symbol-function cmd))))
- (cmd-fun (or cmd #'erc-cmd-default))
- (arg (if cmd
- (if (get cmd-fun 'do-not-parse-args)
- (format "%s" (match-string 2 line))
- (delete "" (split-string (erc-trim-string
- (match-string 2 line)) " ")))
- line)))
+ ;; note: return is nil, we apply this simply for side effects
+ (_canon-defun (while (and cmd (symbolp (symbol-function cmd)))
+ (setq cmd (symbol-function cmd))))
+ (cmd-fun (or cmd #'erc-cmd-default))
+ (arg (if cmd
+ (if (get cmd-fun 'do-not-parse-args)
+ (format "%s" (match-string 2 line))
+ (delete "" (split-string (erc-trim-string
+ (match-string 2 line)) " ")))
+ line)))
(list cmd-fun arg))))
(defun erc-split-multiline-safe (string)
@@ -5360,16 +5482,16 @@ list of the form: (command args) where both elements are strings."
Do it only for STRING as the complete input, do not carry unfinished
strings over to the next call."
(let ((l ())
- (i0 0)
- (doit t))
+ (i0 0)
+ (doit t))
(while doit
(let ((i (string-match "\r?\n" string i0))
- (s (substring string i0)))
- (cond (i (setq l (cons (substring string i0 i) l))
- (setq i0 (match-end 0)))
- ((> (length s) 0)
- (setq l (cons s l))(setq doit nil))
- (t (setq doit nil)))))
+ (s (substring string i0)))
+ (cond (i (setq l (cons (substring string i0 i) l))
+ (setq i0 (match-end 0)))
+ ((> (length s) 0)
+ (setq l (cons s l))(setq doit nil))
+ (t (setq doit nil)))))
(nreverse l)))
;; nick handling
@@ -5377,15 +5499,15 @@ strings over to the next call."
(defun erc-set-current-nick (nick)
"Set the current nickname to NICK."
(with-current-buffer (if (buffer-live-p (erc-server-buffer))
- (erc-server-buffer)
- (current-buffer))
+ (erc-server-buffer)
+ (current-buffer))
(setq erc-server-current-nick nick)))
(defun erc-current-nick ()
"Return the current nickname."
(with-current-buffer (if (buffer-live-p (erc-server-buffer))
- (erc-server-buffer)
- (current-buffer))
+ (erc-server-buffer)
+ (current-buffer))
erc-server-current-nick))
(defun erc-current-nick-p (nick)
@@ -5399,7 +5521,7 @@ This matches strings according to the IRC protocol's case convention.
See also `erc-downcase'."
(string= (erc-downcase nick1)
- (erc-downcase nick2)))
+ (erc-downcase nick2)))
;; default target handling
@@ -5414,38 +5536,38 @@ See also `erc-downcase'."
(defun erc-add-default-channel (channel)
"Add CHANNEL to the default channel list."
(let ((chl (downcase channel)))
- (setq erc-default-recipients
- (cons chl erc-default-recipients))))
+ (setq erc-default-recipients
+ (cons chl erc-default-recipients))))
(defun erc-delete-default-channel (channel &optional buffer)
"Delete CHANNEL from the default channel list."
(with-current-buffer (if (and buffer
- (bufferp buffer))
- buffer
- (current-buffer))
+ (bufferp buffer))
+ buffer
+ (current-buffer))
(setq erc-default-recipients (delete (downcase channel)
- erc-default-recipients))))
+ erc-default-recipients))))
(defun erc-add-query (nickname)
"Add QUERY'd NICKNAME to the default channel list.
The previous default target of QUERY type gets removed."
(let ((d1 (car erc-default-recipients))
- (d2 (cdr erc-default-recipients))
- (qt (cons 'QUERY (downcase nickname))))
+ (d2 (cdr erc-default-recipients))
+ (qt (cons 'QUERY (downcase nickname))))
(setq erc-default-recipients (cons qt (if (and (listp d1)
- (eq (car d1) 'QUERY))
- d2
- erc-default-recipients)))))
+ (eq (car d1) 'QUERY))
+ d2
+ erc-default-recipients)))))
(defun erc-delete-query ()
"Delete the topmost target if it is a QUERY."
(let ((d1 (car erc-default-recipients))
- (d2 (cdr erc-default-recipients)))
+ (d2 (cdr erc-default-recipients)))
(if (and (listp d1)
- (eq (car d1) 'QUERY))
- (setq erc-default-recipients d2)
+ (eq (car d1) 'QUERY))
+ (setq erc-default-recipients d2)
(error "Current target is not a QUERY"))))
(defun erc-ignored-user-p (spec)
@@ -5457,7 +5579,7 @@ match, returns that regexp."
(catch 'found
(dolist (ignored (erc-with-server-buffer erc-ignore-list))
(if (string-match ignored spec)
- (throw 'found ignored)))))
+ (throw 'found ignored)))))
(defun erc-ignored-reply-p (msg tgt proc)
;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08
@@ -5467,12 +5589,12 @@ Takes a message MSG to a channel and returns non-nil if the addressed
user matches any regexp in `erc-ignore-reply-list'."
(let ((target-nick (erc-message-target msg)))
(if (not target-nick)
- nil
+ nil
(erc-with-buffer (tgt proc)
- (let ((user (erc-get-server-user target-nick)))
- (when user
- (erc-list-match erc-ignore-reply-list
- (erc-user-spec user))))))))
+ (let ((user (erc-get-server-user target-nick)))
+ (when user
+ (erc-list-match erc-ignore-reply-list
+ (erc-user-spec user))))))))
(defun erc-message-target (msg)
"Return the addressed target in MSG.
@@ -5485,19 +5607,19 @@ The addressed target is the string before the first colon in MSG."
(defun erc-user-spec (user)
"Create a nick!user@host spec from a user struct."
(let ((nick (erc-server-user-nickname user))
- (host (erc-server-user-host user))
- (login (erc-server-user-login user)))
- (concat (or nick "")
- "!"
- (or login "")
- "@"
- (or host ""))))
+ (host (erc-server-user-host user))
+ (login (erc-server-user-login user)))
+ (concat (or nick "")
+ "!"
+ (or login "")
+ "@"
+ (or host ""))))
(defun erc-list-match (lst str)
"Return non-nil if any regexp in LST matches STR."
(memq nil (mapcar (lambda (regexp)
- (not (string-match regexp str)))
- lst)))
+ (not (string-match regexp str)))
+ lst)))
;; other "toggles"
@@ -5509,9 +5631,9 @@ If ARG is positive, turns CTCP replies on.
If ARG is non-nil and not positive, turns CTCP replies off."
(interactive "P")
(cond ((and (numberp arg) (> arg 0))
- (setq erc-disable-ctcp-replies t))
- (arg (setq erc-disable-ctcp-replies nil))
- (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies))))
+ (setq erc-disable-ctcp-replies t))
+ (arg (setq erc-disable-ctcp-replies nil))
+ (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies))))
(message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON")))
(defun erc-toggle-flood-control (&optional arg)
@@ -5524,12 +5646,12 @@ See `erc-server-flood-margin' for an explanation of the available
flood control parameters."
(interactive "P")
(cond ((and (numberp arg) (> arg 0))
- (setq erc-flood-protect t))
- (arg (setq erc-flood-protect nil))
- (t (setq erc-flood-protect (not erc-flood-protect))))
+ (setq erc-flood-protect t))
+ (arg (setq erc-flood-protect nil))
+ (t (setq erc-flood-protect (not erc-flood-protect))))
(message "ERC flood control is %s"
- (cond (erc-flood-protect "ON")
- (t "OFF"))))
+ (cond (erc-flood-protect "ON")
+ (t "OFF"))))
;; Some useful channel and nick commands for fast key bindings
@@ -5541,14 +5663,12 @@ If ARG is non-nil, turn this mode off (-i).
This command is sent even if excess flood is detected."
(interactive "P")
(erc-set-active-buffer (current-buffer))
- (let ((tgt (erc-default-target))
- (erc-force-send t)) ;FIXME: Not used anywhere!
- (cond ((or (not tgt) (not (erc-channel-p tgt)))
- (erc-display-message nil 'error (current-buffer) 'no-target))
- (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i"))
- t))
- (t (erc-load-irc-script-lines (list (concat "/mode " tgt " +i"))
- t)))))
+ (let ((tgt (erc-default-target)))
+ (if (or (not tgt) (not (erc-channel-p tgt)))
+ (erc-display-message nil 'error (current-buffer) 'no-target)
+ (erc-load-irc-script-lines
+ (list (concat "/mode " tgt (if arg " -i" " +i")))
+ t))))
(defun erc-get-channel-mode-from-keypress (key)
"Read a key sequence and call the corresponding channel mode function.
@@ -5563,14 +5683,14 @@ Anything else will be sent to `erc-toggle-channel-mode'."
(when (featurep 'xemacs)
(setq key (char-to-string (event-to-character (aref key 0)))))
(cond ((equal key "\C-g")
- (keyboard-quit))
- ((equal key "\C-m")
- (erc-insert-mode-command))
- ((equal key "l")
- (call-interactively 'erc-set-channel-limit))
- ((equal key "k")
- (call-interactively 'erc-set-channel-key))
- (t (erc-toggle-channel-mode key))))
+ (keyboard-quit))
+ ((equal key "\C-m")
+ (erc-insert-mode-command))
+ ((equal key "l")
+ (call-interactively 'erc-set-channel-limit))
+ ((equal key "k")
+ (call-interactively 'erc-set-channel-key))
+ (t (erc-toggle-channel-mode key))))
(defun erc-toggle-channel-mode (mode &optional channel)
"Toggle channel MODE.
@@ -5579,17 +5699,15 @@ If CHANNEL is non-nil, toggle MODE for that channel, otherwise use
`erc-default-target'."
(interactive "P")
(erc-set-active-buffer (current-buffer))
- (let ((tgt (or channel (erc-default-target)))
- (erc-force-send t)) ;FIXME: Not used anywhere!
- (cond ((or (null tgt) (null (erc-channel-p tgt)))
- (erc-display-message nil 'error 'active 'no-target))
- ((member mode erc-channel-modes)
- (erc-log (format "%s: Toggle mode %s OFF" tgt mode))
- (message "Toggle channel mode %s OFF" mode)
- (erc-server-send (format "MODE %s -%s" tgt mode)))
- (t (erc-log (format "%s: Toggle channel mode %s ON" tgt mode))
- (message "Toggle channel mode %s ON" mode)
- (erc-server-send (format "MODE %s +%s" tgt mode))))))
+ (let ((tgt (or channel (erc-default-target))))
+ (if (or (null tgt) (null (erc-channel-p tgt)))
+ (erc-display-message nil 'error 'active 'no-target)
+ (let* ((active (member mode erc-channel-modes))
+ (newstate (if active "OFF" "ON")))
+ (erc-log (format "%s: Toggle mode %s %s" tgt mode newstate))
+ (message "Toggle channel mode %s %s" mode newstate)
+ (erc-server-send (format "MODE %s %s%s"
+ tgt (if active "-" "+") mode))))))
(defun erc-insert-mode-command ()
"Insert the line \"/mode <current target> \" at `point'."
@@ -5625,9 +5743,9 @@ If FILE is found, return the path to it."
(let ((filepath file))
(if (file-readable-p filepath) filepath
(while (and path
- (progn (setq filepath (expand-file-name file (car path)))
- (not (file-readable-p filepath))))
- (setq path (cdr path)))
+ (progn (setq filepath (expand-file-name file (car path)))
+ (not (file-readable-p filepath))))
+ (setq path (cdr path)))
(if path filepath nil))))
(defun erc-select-startup-file ()
@@ -5637,7 +5755,7 @@ See also `erc-startup-file-list'."
(dolist (f erc-startup-file-list)
(setq f (convert-standard-filename f))
(when (file-readable-p f)
- (throw 'found f)))))
+ (throw 'found f)))))
(defun erc-find-script-file (file)
"Search for FILE in `default-directory', and any in `erc-script-path'."
@@ -5652,7 +5770,7 @@ as an Emacs Lisp program. Otherwise, treat it as a regular IRC
script."
(erc-log (concat "erc-load-script: " file))
(cond
- ((string-match "\\.el$" file)
+ ((string-match "\\.el\\'" file)
(load file))
(t
(erc-load-irc-script file))))
@@ -5670,15 +5788,15 @@ $* = the entire argument string, $1 = the first argument, $2 = the second,
and so on."
(if (not args) (setq args ""))
(let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)")
- (percent-regexp "\\(%.\\)")
- (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp))
- (tgt (erc-default-target))
- (server (and (boundp 'erc-session-server) erc-session-server))
- (nick (erc-current-nick))
- (res "")
- (tmp nil)
- (arg-list nil)
- (arg-num 0))
+ (percent-regexp "\\(%.\\)")
+ (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp))
+ (tgt (erc-default-target))
+ (server (and (boundp 'erc-session-server) erc-session-server))
+ (nick (erc-current-nick))
+ (res "")
+ (tmp nil)
+ (arg-list nil)
+ (arg-num 0))
(if (not tgt) (setq tgt ""))
(if (not server) (setq server ""))
(if (not nick) (setq nick ""))
@@ -5694,36 +5812,36 @@ and so on."
(while tmp
;;(message "beginning of while: tmp=%S" tmp)
(let* ((hd (substring line 0 tmp))
- (esc "")
- (subst "")
- (tail (substring line tmp)))
- (cond ((string-match (concat "^" arg-esc-regexp) tail)
- (setq esc (match-string 1 tail))
- (setq tail (substring tail (match-end 1))))
- ((string-match (concat "^" percent-regexp) tail)
- (setq esc (match-string 1 tail))
- (setq tail (substring tail (match-end 1)))))
- ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num)
- (setq res (concat res hd))
- (setq subst
- (cond ((string= esc "") "")
- ((string-match "^\\$\\*$" esc) args)
- ((string-match "^\\$\\([0-9]+\\)$" esc)
- (let ((n (string-to-number (match-string 1 esc))))
- (message "n = %S, integerp(n)=%S" n (integerp n))
- (if (<= n arg-num) (nth (1- n) arg-list) "")))
- ((string-match "^%[Cc]$" esc) tgt)
- ((string-match "^%[Ss]$" esc) server)
- ((string-match "^%[Nn]$" esc) nick)
- ((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
- (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
- (message "BUG IN ERC: esc=%S" esc)
- "")))
- (setq line tail)
- (setq tmp (string-match esc-regexp line))
- (setq res (concat res subst))
- ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp)
- ))
+ (esc "")
+ (subst "")
+ (tail (substring line tmp)))
+ (cond ((string-match (concat "^" arg-esc-regexp) tail)
+ (setq esc (match-string 1 tail))
+ (setq tail (substring tail (match-end 1))))
+ ((string-match (concat "^" percent-regexp) tail)
+ (setq esc (match-string 1 tail))
+ (setq tail (substring tail (match-end 1)))))
+ ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num)
+ (setq res (concat res hd))
+ (setq subst
+ (cond ((string= esc "") "")
+ ((string-match "^\\$\\*$" esc) args)
+ ((string-match "^\\$\\([0-9]+\\)$" esc)
+ (let ((n (string-to-number (match-string 1 esc))))
+ (message "n = %S, integerp(n)=%S" n (integerp n))
+ (if (<= n arg-num) (nth (1- n) arg-list) "")))
+ ((string-match "^%[Cc]$" esc) tgt)
+ ((string-match "^%[Ss]$" esc) server)
+ ((string-match "^%[Nn]$" esc) nick)
+ ((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
+ (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
+ (message "BUG IN ERC: esc=%S" esc)
+ "")))
+ (setq line tail)
+ (setq tmp (string-match esc-regexp line))
+ (setq res (concat res subst))
+ ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp)
+ ))
(setq res (concat res line))
res))
@@ -5731,8 +5849,8 @@ and so on."
"Load an IRC script from FILE."
(erc-log (concat "erc-load-script: " file))
(let ((str (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))))
+ (insert-file-contents file)
+ (buffer-string))))
(erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
(defun erc-load-irc-script-lines (lines &optional force noexpand)
@@ -5742,25 +5860,25 @@ If optional NOEXPAND is non-nil, do not expand script-specific
sequences, process the lines verbatim. Use this for multiline
user input."
(let* ((cb (current-buffer))
- (s "")
- (sp (or (erc-command-indicator) (erc-prompt)))
- (args (and (boundp 'erc-script-args) erc-script-args)))
+ (s "")
+ (sp (or (erc-command-indicator) (erc-prompt)))
+ (args (and (boundp 'erc-script-args) erc-script-args)))
(if (and args (string-match "^ " args))
- (setq args (substring args 1)))
+ (setq args (substring args 1)))
;; prepare the prompt string for echo
(erc-put-text-property 0 (length sp)
- 'face 'erc-command-indicator-face sp)
+ 'face 'erc-command-indicator-face sp)
(while lines
(setq s (car lines))
(erc-log (concat "erc-load-script: CMD: " s))
(unless (string-match "^\\s-*$" s)
- (let ((line (if noexpand s (erc-process-script-line s args))))
- (if (and (erc-process-input-line line force)
- erc-script-echo)
- (progn
- (erc-put-text-property 0 (length line)
- 'face 'erc-input-face line)
- (erc-display-line (concat sp line) cb)))))
+ (let ((line (if noexpand s (erc-process-script-line s args))))
+ (if (and (erc-process-input-line line force)
+ erc-script-echo)
+ (progn
+ (erc-put-text-property 0 (length line)
+ 'face 'erc-input-face line)
+ (erc-display-line (concat sp line) cb)))))
(setq lines (cdr lines)))))
;; authentication
@@ -5768,21 +5886,21 @@ user input."
(defun erc-login ()
"Perform user authentication at the IRC server."
(erc-log (format "login: nick: %s, user: %s %s %s :%s"
- (erc-current-nick)
- (user-login-name)
- (or erc-system-name (system-name))
- erc-session-server
- erc-session-user-full-name))
+ (erc-current-nick)
+ (user-login-name)
+ (or erc-system-name (system-name))
+ erc-session-server
+ erc-session-user-full-name))
(if erc-session-password
(erc-server-send (format "PASS %s" erc-session-password))
(message "Logging in without password"))
(erc-server-send (format "NICK %s" (erc-current-nick)))
(erc-server-send
(format "USER %s %s %s :%s"
- ;; hacked - S.B.
- (if erc-anonymous-login erc-email-userid (user-login-name))
- "0" "*"
- erc-session-user-full-name))
+ ;; hacked - S.B.
+ (if erc-anonymous-login erc-email-userid (user-login-name))
+ "0" "*"
+ erc-session-user-full-name))
(erc-update-mode-line))
;; connection properties' heuristics
@@ -5798,8 +5916,8 @@ Sets the buffer local variables:
- `erc-server-current-nick'"
(setq erc-session-connector erc-server-connect-function
erc-session-server (erc-compute-server server)
- erc-session-port (or port erc-default-port)
- erc-session-user-full-name (erc-compute-full-name name))
+ erc-session-port (or port erc-default-port)
+ erc-session-user-full-name (erc-compute-full-name name))
(erc-set-current-nick (erc-compute-nick nick)))
(defun erc-compute-server (&optional server)
@@ -5867,19 +5985,12 @@ non-nil value is found.
Returns a list of the form (HIGH LOW), compatible with Emacs time format."
(let* ((n (string-to-number (concat string ".0"))))
(list (truncate (/ n 65536))
- (truncate (mod n 65536)))))
+ (truncate (mod n 65536)))))
-(defun erc-emacs-time-to-erc-time (time)
- "Convert Emacs TIME to a number of seconds since the epoch."
- (when time
- (+ (* (nth 0 time) 65536.0) (nth 1 time))))
-; (round (+ (* (nth 0 tm) 65536.0) (nth 1 tm))))
+(defalias 'erc-emacs-time-to-erc-time
+ (if (featurep 'xemacs) 'time-to-seconds 'float-time))
-(defun erc-current-time ()
- "Return the `current-time' as a number of seconds since the epoch.
-
-See also `erc-emacs-time-to-erc-time'."
- (erc-emacs-time-to-erc-time (current-time)))
+(defalias 'erc-current-time 'erc-emacs-time-to-erc-time)
(defun erc-time-diff (t1 t2)
"Return the time difference in seconds between T1 and T2."
@@ -5893,33 +6004,33 @@ See also `erc-emacs-time-to-erc-time'."
"Convert NS to a time string HH:MM.SS."
(setq ns (truncate ns))
(format "%02d:%02d.%02d"
- (/ ns 3600)
- (/ (% ns 3600) 60)
- (% ns 60)))
+ (/ ns 3600)
+ (/ (% ns 3600) 60)
+ (% ns 60)))
(defun erc-seconds-to-string (seconds)
"Convert a number of SECONDS into an English phrase."
(let (days hours minutes format-args output)
- (setq days (/ seconds 86400)
- seconds (% seconds 86400)
- hours (/ seconds 3600)
- seconds (% seconds 3600)
- minutes (/ seconds 60)
- seconds (% seconds 60)
- format-args (if (> days 0)
- `("%d days, %d hours, %d minutes, %d seconds"
- ,days ,hours ,minutes ,seconds)
- (if (> hours 0)
- `("%d hours, %d minutes, %d seconds"
- ,hours ,minutes ,seconds)
- (if (> minutes 0)
- `("%d minutes, %d seconds" ,minutes ,seconds)
- `("%d seconds" ,seconds))))
- output (apply 'format format-args))
+ (setq days (/ seconds 86400)
+ seconds (% seconds 86400)
+ hours (/ seconds 3600)
+ seconds (% seconds 3600)
+ minutes (/ seconds 60)
+ seconds (% seconds 60)
+ format-args (if (> days 0)
+ `("%d days, %d hours, %d minutes, %d seconds"
+ ,days ,hours ,minutes ,seconds)
+ (if (> hours 0)
+ `("%d hours, %d minutes, %d seconds"
+ ,hours ,minutes ,seconds)
+ (if (> minutes 0)
+ `("%d minutes, %d seconds" ,minutes ,seconds)
+ `("%d seconds" ,seconds))))
+ 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))))
+ "" output (match-string 2 output) 2 (match-beginning 2))))
output))
@@ -5942,14 +6053,14 @@ If S is nil or an empty string then return general CLIENTINFO."
(if (or (not s) (string= s ""))
(concat
(apply #'concat
- (mapcar (lambda (e)
- (concat (car e) " "))
- erc-clientinfo-alist))
+ (mapcar (lambda (e)
+ (concat (car e) " "))
+ erc-clientinfo-alist))
": use CLIENTINFO <COMMAND> to get more specific information")
(let ((h (assoc (upcase s) erc-clientinfo-alist)))
(if h
- (concat s " " (cdr h))
- (concat s ": unknown command")))))
+ (concat s " " (cdr h))
+ (concat s ": unknown command")))))
;; Hook functions
@@ -5964,9 +6075,9 @@ If it doesn't exist, create it."
;; here, we only want to match the channel buffers, to avoid
;; "selecting killed buffers" b0rkage.
(erc-with-all-buffers-of-server process
- (lambda ()
- (not (erc-server-buffer-p)))
- (kill-buffer (current-buffer))))
+ (lambda ()
+ (not (erc-server-buffer-p)))
+ (kill-buffer (current-buffer))))
(defun erc-nick-at-point ()
"Give information about the nickname at `point'.
@@ -5977,31 +6088,37 @@ entry of `channel-members'."
(interactive)
(require 'thingatpt)
(let* ((word (word-at-point))
- (channel-data (erc-get-channel-user word))
- (cuser (cdr channel-data))
- (user (if channel-data
- (car channel-data)
- (erc-get-server-user word)))
- host login full-name nick op voice)
+ (channel-data (erc-get-channel-user word))
+ (cuser (cdr channel-data))
+ (user (if channel-data
+ (car channel-data)
+ (erc-get-server-user word)))
+ host login full-name nick voice halfop op admin owner)
(when user
(setq nick (erc-server-user-nickname user)
- host (erc-server-user-host user)
- login (erc-server-user-login user)
- full-name (erc-server-user-full-name user))
+ host (erc-server-user-host user)
+ login (erc-server-user-login user)
+ full-name (erc-server-user-full-name user))
(if cuser
- (setq op (erc-channel-user-op cuser)
- voice (erc-channel-user-voice cuser)))
- (if (called-interactively-p 'interactive)
- (message "%s is %s@%s%s%s"
- nick login host
- (if full-name (format " (%s)" full-name) "")
- (if (or op voice)
- (format " and is +%s%s on %s"
- (if op "o" "")
- (if voice "v" "")
- (erc-default-target))
- ""))
- user))))
+ (setq voice (erc-channel-user-voice cuser)
+ halfop (erc-channel-user-halfop cuser)
+ op (erc-channel-user-op cuser)
+ admin (erc-channel-user-admin cuser)
+ owner (erc-channel-user-owner cuser))))
+ (if (called-interactively-p 'interactive)
+ (message "%s is %s@%s%s%s"
+ nick login host
+ (if full-name (format " (%s)" full-name) "")
+ (if (or voice halfop op admin owner)
+ (format " and is +%s%s%s%s%s on %s"
+ (if voice "v" "")
+ (if halfop "h" "")
+ (if op "o" "")
+ (if admin "a" "")
+ (if owner "q" "")
+ (erc-default-target))
+ ""))
+ user)))
(defun erc-away-time ()
"Return non-nil if the current ERC process is set away.
@@ -6046,11 +6163,11 @@ displayed.
See `erc-mode-line-format' for which characters are can be used."
:group 'erc-mode-line-and-header
:set (lambda (sym val)
- (set sym val)
- (when (fboundp 'erc-update-mode-line)
- (erc-update-mode-line nil)))
+ (set sym val)
+ (when (fboundp 'erc-update-mode-line)
+ (erc-update-mode-line nil)))
:type '(choice (const :tag "Disabled" nil)
- string))
+ string))
(defcustom erc-header-line-uses-tabbar-p nil
"Use tabbar mode instead of the header line to display the header."
@@ -6071,8 +6188,8 @@ If given a function, call it and use the resulting face name.
Otherwise, use the `erc-header-line' face."
:group 'erc-mode-line-and-header
:type '(choice (const :tag "Don't colorize" nil)
- (const :tag "Use the erc-header-line face" t)
- (function :tag "Call a function")))
+ (const :tag "Use the erc-header-line face" t)
+ (function :tag "Call a function")))
(defcustom erc-show-channel-key-p t
"Show the channel key in the header line."
@@ -6091,40 +6208,40 @@ This should be a string with substitution variables recognized by
"Shorten SERVER-NAME according to `erc-common-server-suffixes'."
(if (stringp server-name)
(with-temp-buffer
- (insert server-name)
- (let ((alist erc-common-server-suffixes))
- (while alist
- (goto-char (point-min))
- (if (re-search-forward (caar alist) nil t)
- (replace-match (cdar alist)))
- (setq alist (cdr alist))))
- (buffer-string))))
+ (insert server-name)
+ (let ((alist erc-common-server-suffixes))
+ (while alist
+ (goto-char (point-min))
+ (if (re-search-forward (caar alist) nil t)
+ (replace-match (cdar alist)))
+ (setq alist (cdr alist))))
+ (buffer-string))))
(defun erc-format-target ()
"Return the name of the target (channel or nickname or servername:port)."
(let ((target (erc-default-target)))
(or target
- (concat (erc-shorten-server-name
- (or erc-server-announced-name
- erc-session-server))
- ":" (erc-port-to-string erc-session-port)))))
+ (concat (erc-shorten-server-name
+ (or erc-server-announced-name
+ erc-session-server))
+ ":" (erc-port-to-string erc-session-port)))))
(defun erc-format-target-and/or-server ()
"Return the server name or the current target and server name combined."
(let ((server-name (erc-shorten-server-name
- (or erc-server-announced-name
- erc-session-server))))
+ (or erc-server-announced-name
+ erc-session-server))))
(cond ((erc-default-target)
- (concat (erc-string-no-properties (erc-default-target))
- "@" server-name))
- (server-name server-name)
- (t (buffer-name (current-buffer))))))
+ (concat (erc-string-no-properties (erc-default-target))
+ "@" server-name))
+ (server-name server-name)
+ (t (buffer-name (current-buffer))))))
(defun erc-format-network ()
"Return the name of the network we are currently on."
(let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
(if (and network (symbolp network))
- (symbol-name network)
+ (symbol-name network)
"")))
(defun erc-format-target-and/or-network ()
@@ -6132,48 +6249,52 @@ This should be a string with substitution variables recognized by
If the name of the network is not available, then use the
shortened server name instead."
(let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
- (erc-shorten-server-name
- (or erc-server-announced-name
- erc-session-server)))))
+ (erc-shorten-server-name
+ (or erc-server-announced-name
+ erc-session-server)))))
(when (and network-name (symbolp network-name))
(setq network-name (symbol-name network-name)))
(cond ((erc-default-target)
- (concat (erc-string-no-properties (erc-default-target))
- "@" network-name))
- (network-name network-name)
- (t (buffer-name (current-buffer))))))
+ (concat (erc-string-no-properties (erc-default-target))
+ "@" network-name))
+ ((and network-name
+ (not (get-buffer network-name)))
+ (when erc-rename-buffers
+ (rename-buffer network-name))
+ network-name)
+ (t (buffer-name (current-buffer))))))
(defun erc-format-away-status ()
"Return a formatted `erc-mode-line-away-status-format'
if `erc-away' is non-nil."
(let ((a (erc-away-time)))
(if a
- (format-time-string erc-mode-line-away-status-format a)
+ (format-time-string erc-mode-line-away-status-format a)
"")))
(defun erc-format-channel-modes ()
"Return the current channel's modes."
- (concat (apply 'concat
- "+" erc-channel-modes)
- (cond ((and erc-channel-user-limit erc-channel-key)
- (if erc-show-channel-key-p
- (format "lk %.0f %s" erc-channel-user-limit
- erc-channel-key)
- (format "kl %.0f" erc-channel-user-limit)))
- (erc-channel-user-limit
- ;; Emacs has no bignums
- (format "l %.0f" erc-channel-user-limit))
- (erc-channel-key
- (if erc-show-channel-key-p
- (format "k %s" erc-channel-key)
- "k"))
- (t nil))))
+ (concat (apply #'concat
+ "+" erc-channel-modes)
+ (cond ((and erc-channel-user-limit erc-channel-key)
+ (if erc-show-channel-key-p
+ (format "lk %.0f %s" erc-channel-user-limit
+ erc-channel-key)
+ (format "kl %.0f" erc-channel-user-limit)))
+ (erc-channel-user-limit
+ ;; Emacs has no bignums
+ (format "l %.0f" erc-channel-user-limit))
+ (erc-channel-key
+ (if erc-show-channel-key-p
+ (format "k %s" erc-channel-key)
+ "k"))
+ (t nil))))
(defun erc-format-lag-time ()
"Return the estimated lag time to server, `erc-server-lag'."
(let ((lag (erc-with-server-buffer erc-server-lag)))
(cond (lag (format "lag:%.0f" lag))
- (t ""))))
+ (t ""))))
;; erc-goodies is required at end of this file.
(declare-function erc-controls-strip "erc-goodies" (str))
@@ -6184,66 +6305,66 @@ if `erc-away' is non-nil."
"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 (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")
- ((erc-server-process-alive)
- "")
- (t
- ": CLOSED")))
- (face (cond ((eq erc-header-line-face-method nil)
- nil)
- ((functionp erc-header-line-face-method)
- (funcall erc-header-line-face-method))
- (t
- 'erc-header-line))))
+ ?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")
+ ((erc-server-process-alive)
+ "")
+ (t
+ ": CLOSED")))
+ (face (cond ((eq erc-header-line-face-method nil)
+ nil)
+ ((functionp erc-header-line-face-method)
+ (funcall erc-header-line-face-method))
+ (t
+ 'erc-header-line))))
(cond ((featurep 'xemacs)
- (setq modeline-buffer-identification
- (list (format-spec erc-mode-line-format spec)))
- (setq modeline-process (list process-status)))
- (t
- (setq mode-line-buffer-identification
- (list (format-spec erc-mode-line-format spec)))
- (setq mode-line-process (list process-status))))
+ (setq modeline-buffer-identification
+ (list (format-spec erc-mode-line-format spec)))
+ (setq modeline-process (list process-status)))
+ (t
+ (setq mode-line-buffer-identification
+ (list (format-spec erc-mode-line-format spec)))
+ (setq mode-line-process (list process-status))))
(when (boundp 'header-line-format)
- (let ((header (if erc-header-line-format
- (format-spec erc-header-line-format spec)
- nil)))
- (cond (erc-header-line-uses-tabbar-p
- (set (make-local-variable 'tabbar--local-hlf)
- header-line-format)
- (kill-local-variable 'header-line-format))
- ((null header)
- (setq header-line-format nil))
- (erc-header-line-uses-help-echo-p
- (let ((help-echo (with-temp-buffer
- (insert header)
- (fill-region (point-min) (point-max))
- (buffer-string))))
- (setq header-line-format
- (erc-replace-regexp-in-string
- "%"
- "%%"
- (if face
- (erc-propertize header 'help-echo help-echo
- 'face face)
- (erc-propertize header 'help-echo help-echo))))))
- (t (setq header-line-format
- (if face
- (erc-propertize header 'face face)
- header)))))))
+ (let ((header (if erc-header-line-format
+ (format-spec erc-header-line-format spec)
+ nil)))
+ (cond (erc-header-line-uses-tabbar-p
+ (set (make-local-variable 'tabbar--local-hlf)
+ header-line-format)
+ (kill-local-variable 'header-line-format))
+ ((null header)
+ (setq header-line-format nil))
+ (erc-header-line-uses-help-echo-p
+ (let ((help-echo (with-temp-buffer
+ (insert header)
+ (fill-region (point-min) (point-max))
+ (buffer-string))))
+ (setq header-line-format
+ (erc-replace-regexp-in-string
+ "%"
+ "%%"
+ (if face
+ (erc-propertize header 'help-echo help-echo
+ 'face face)
+ (erc-propertize header 'help-echo help-echo))))))
+ (t (setq header-line-format
+ (if face
+ (erc-propertize header 'face face)
+ header)))))))
(if (featurep 'xemacs)
- (redraw-modeline)
+ (redraw-modeline)
(force-mode-line-update))))
(defun erc-update-mode-line (&optional buffer)
@@ -6254,7 +6375,7 @@ If BUFFER is nil, update the mode line in all ERC buffers."
(erc-update-mode-line-buffer buffer)
(dolist (buf (erc-buffer-list))
(when (buffer-live-p buf)
- (erc-update-mode-line-buffer buf)))))
+ (erc-update-mode-line-buffer buf)))))
;; Miscellaneous
@@ -6271,40 +6392,40 @@ P may be an integer or a service name."
s
(let ((n (string-to-number s)))
(if (= n 0)
- s
- n))))
+ s
+ n))))
(defun erc-version (&optional here)
"Show the version number of ERC in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
- (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
+ (format "ERC (IRC client for Emacs %s)" emacs-version)))
(if here
- (insert version-string)
+ (insert version-string)
(if (called-interactively-p 'interactive)
- (message "%s" version-string)
- version-string))))
+ (message "%s" version-string)
+ version-string))))
(defun erc-modes (&optional here)
"Show the active ERC modes in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((string
- (mapconcat 'identity
- (let (modes (case-fold-search nil))
- (dolist (var (apropos-internal "^erc-.*mode$"))
- (when (and (boundp var)
- (symbol-value var))
- (setq modes (cons (symbol-name var)
- modes))))
- modes)
- ", ")))
+ (mapconcat 'identity
+ (let (modes (case-fold-search nil))
+ (dolist (var (apropos-internal "^erc-.*mode$"))
+ (when (and (boundp var)
+ (symbol-value var))
+ (setq modes (cons (symbol-name var)
+ modes))))
+ modes)
+ ", ")))
(if here
- (insert string)
+ (insert string)
(if (called-interactively-p 'interactive)
- (message "%s" string)
- string))))
+ (message "%s" string)
+ string))))
(defun erc-trim-string (s)
"Trim leading and trailing spaces off S."
@@ -6330,34 +6451,34 @@ All windows are opened in the current frame."
(switch-to-buffer (car bufs))
(setq bufs (cdr bufs))
(while bufs
- (split-window)
- (other-window 1)
- (switch-to-buffer (car bufs))
- (setq bufs (cdr bufs))
- (balance-windows)))))
+ (split-window)
+ (other-window 1)
+ (switch-to-buffer (car bufs))
+ (setq bufs (cdr bufs))
+ (balance-windows)))))
(defun erc-popup-input-buffer ()
"Provide an input buffer."
- (interactive)
- (let ((buffer-name (generate-new-buffer-name "*ERC input*"))
- (mode (intern
- (completing-read
- "Mode: "
- (mapcar (lambda (e)
- (list (symbol-name e)))
- (apropos-internal "-mode$" 'commandp))
- nil t))))
- (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
- (funcall mode)
- (narrow-to-region (point) (point))
- (shrink-window-if-larger-than-buffer)))
+ (interactive)
+ (let ((buffer-name (generate-new-buffer-name "*ERC input*"))
+ (mode (intern
+ (completing-read
+ "Mode: "
+ (mapcar (lambda (e)
+ (list (symbol-name e)))
+ (apropos-internal "-mode\\'" 'commandp))
+ nil t))))
+ (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
+ (funcall mode)
+ (narrow-to-region (point) (point))
+ (shrink-window-if-larger-than-buffer)))
;;; Message catalog
(defun erc-make-message-variable-name (catalog entry)
"Create a variable name corresponding to CATALOG's ENTRY."
(intern (concat "erc-message-"
- (symbol-name catalog) "-" (symbol-name entry))))
+ (symbol-name catalog) "-" (symbol-name entry))))
(defun erc-define-catalog-entry (catalog entry format-spec)
"Set CATALOG's ENTRY to FORMAT-SPEC."
@@ -6391,7 +6512,7 @@ All windows are opened in the current frame."
. "\n\nConnection failed! Not re-establishing connection.\n")
(finished . "\n\n*** ERC finished ***\n")
(terminated . "\n\n*** ERC terminated: %e\n")
- (login . "Logging in as \'%n\'...")
+ (login . "Logging in as `%n'...")
(nick-in-use . "%n is in use. Choose new nickname: ")
(nick-too-long
. "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
@@ -6499,18 +6620,18 @@ All windows are opened in the current frame."
This function is an example on what could be done with formatting
functions."
(let ((nick (cadr (memq ?n args)))
- (user (cadr (memq ?u args)))
- (host (cadr (memq ?h args)))
- (channel (cadr (memq ?c args)))
- (reason (cadr (memq ?r args))))
+ (user (cadr (memq ?u args)))
+ (host (cadr (memq ?h args)))
+ (channel (cadr (memq ?c args)))
+ (reason (cadr (memq ?r args))))
(if (string= nick (erc-current-nick))
- (format "You have left channel %s" channel)
+ (format "You have left channel %s" channel)
(format "%s (%s@%s) has left channel %s%s"
- nick user host channel
- (if (not (string= reason ""))
- (format ": %s"
- (erc-replace-regexp-in-string "%" "%%" reason))
- "")))))
+ nick user host channel
+ (if (not (string= reason ""))
+ (format ": %s"
+ (erc-replace-regexp-in-string "%" "%%" reason))
+ "")))))
(defvar erc-current-message-catalog 'english)
@@ -6526,22 +6647,22 @@ english, catalog."
(unless catalog (setq catalog erc-current-message-catalog))
(let ((var (erc-make-message-variable-name catalog entry)))
(if (boundp var)
- (symbol-value var)
+ (symbol-value var)
(when (boundp (erc-make-message-variable-name 'english entry))
- (symbol-value (erc-make-message-variable-name 'english entry))))))
+ (symbol-value (erc-make-message-variable-name 'english entry))))))
(defun erc-format-message (msg &rest args)
"Format MSG according to ARGS.
See also `format-spec'."
- (when (eq (logand (length args) 1) 1) ; oddp
+ (when (eq (logand (length args) 1) 1) ; oddp
(error "Obscure usage of this function appeared"))
(let ((entry (erc-retrieve-catalog-entry msg)))
(when (not entry)
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply 'format-spec-make args))))
+ (format-spec entry (apply #'format-spec-make args))))
;;; Various hook functions
@@ -6595,8 +6716,8 @@ This function should be on `erc-kill-channel-hook'."
(when (erc-server-process-alive)
(let ((tgt (erc-default-target)))
(erc-server-send (format "PART %s :%s" tgt
- (funcall erc-part-reason nil))
- nil tgt))))
+ (funcall erc-part-reason nil))
+ nil tgt))))
;;; Dealing with `erc-parsed'
@@ -6618,10 +6739,10 @@ This function should be on `erc-kill-channel-hook'."
(defun erc-get-parsed-vector-nick (vect)
"Return nickname in the parsed vector VECT."
(let* ((untreated-nick (and vect (erc-response.sender vect)))
- (maybe-nick (when untreated-nick
- (car (split-string untreated-nick "!")))))
+ (maybe-nick (when untreated-nick
+ (car (split-string untreated-nick "!")))))
(when (and (not (null maybe-nick))
- (erc-is-valid-nick-p maybe-nick))
+ (erc-is-valid-nick-p maybe-nick))
untreated-nick)))
(defun erc-get-parsed-vector-type (vect)
@@ -6638,18 +6759,18 @@ This function should be on `erc-kill-channel-hook'."
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
(let ((server-buffer
- (car (erc-buffer-filter
- (lambda ()
- (and (string-equal erc-session-server host)
- (= erc-session-port port)
- (erc-open-server-buffer-p)))))))
+ (car (erc-buffer-filter
+ (lambda ()
+ (and (string-equal erc-session-server host)
+ (= erc-session-port port)
+ (erc-open-server-buffer-p)))))))
(with-current-buffer (or server-buffer (current-buffer))
(if (and server-buffer channel)
- (erc-cmd-JOIN channel)
- (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name)
- (not server-buffer) password nil channel
- (when server-buffer
- (get-buffer-process server-buffer)))))))
+ (erc-cmd-JOIN channel)
+ (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name)
+ (not server-buffer) password nil channel
+ (when server-buffer
+ (get-buffer-process server-buffer)))))))
(provide 'erc)
diff --git a/lisp/eshell/.gitignore b/lisp/eshell/.gitignore
deleted file mode 100644
index 2abf84ba3ee..00000000000
--- a/lisp/eshell/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-esh-groups.el
-
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index a46b48c01b3..b76cb7c1005 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -1,6 +1,6 @@
-;;; em-alias.el --- creation and management of command aliases
+;;; em-alias.el --- creation and management of command aliases -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -221,18 +221,11 @@ file named by `eshell-aliases-file'.")
(let ((alias (eshell-lookup-alias command)))
(if alias
(throw 'eshell-replace-command
- (list
- 'let
- (list
- (list 'eshell-command-name
- (list 'quote eshell-last-command-name))
- (list 'eshell-command-arguments
- (list 'quote eshell-last-arguments))
- (list 'eshell-prevent-alias-expansion
- (list 'quote
- (cons command
- eshell-prevent-alias-expansion))))
- (eshell-parse-command (nth 1 alias))))))))
+ `(let ((eshell-command-name ',eshell-last-command-name)
+ (eshell-command-arguments ',eshell-last-arguments)
+ (eshell-prevent-alias-expansion
+ ',(cons command eshell-prevent-alias-expansion)))
+ ,(eshell-parse-command (nth 1 alias))))))))
(defun eshell-alias-completions (name)
"Find all possible completions for NAME.
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index 8c3eebf3510..522ff43e18d 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -1,6 +1,6 @@
-;;; em-banner.el --- sample module that displays a login banner
+;;; em-banner.el --- sample module that displays a login banner -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index c440bd0a928..05cd994c36f 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -1,6 +1,6 @@
-;;; em-basic.el --- basic shell builtin commands
+;;; em-basic.el --- basic shell builtin commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 7120f639a70..93b275e2ffb 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -1,6 +1,6 @@
-;;; em-cmpl.el --- completion using the TAB key
+;;; em-cmpl.el --- completion using the TAB key -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -370,7 +370,7 @@ to writing a completion function."
(cl-assert (= (length args) (length posns)))
(let ((a args)
(i 0)
- l final)
+ l)
(while a
(if (and (consp (car a))
(eq (caar a) 'eshell-operator))
@@ -405,7 +405,9 @@ to writing a completion function."
"Generate list of applicable, visible commands."
(let ((filename (pcomplete-arg)) glob-name)
(if (file-name-directory filename)
- (pcomplete-executables)
+ (if eshell-force-execution
+ (pcomplete-dirs-or-entries nil 'file-readable-p)
+ (pcomplete-executables))
(if (and (> (length filename) 0)
(eq (aref filename 0) eshell-explicit-command-char))
(setq filename (substring filename 1)
@@ -416,6 +418,8 @@ to writing a completion function."
(expand-file-name default-directory)))
(path "") (comps-in-path ())
(file "") (filepath "") (completions ()))
+ (if (eshell-under-windows-p)
+ (push "." paths))
;; Go thru each path in the search path, finding completions.
(while paths
(setq path (file-name-as-directory
@@ -431,7 +435,9 @@ to writing a completion function."
(if (and (not (member file completions)) ;
(or (string-equal path cwd)
(not (file-directory-p filepath)))
- (file-executable-p filepath))
+ (if eshell-force-execution
+ (file-readable-p filepath)
+ (file-executable-p filepath)))
(setq completions (cons file completions)))
(setq comps-in-path (cdr comps-in-path)))
(setq paths (cdr paths)))
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index e8fbe0518ac..3960cd7b229 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -1,6 +1,6 @@
-;;; em-dirs.el --- directory navigation commands
+;;; em-dirs.el --- directory navigation commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -71,7 +71,7 @@ they lack somewhat in feel from the typical shell equivalents."
"The function used to normalize the value of Eshell's `pwd'.
The value returned by `pwd' is also used when recording the
last-visited directory in the last-dir-ring, so it will affect the
-form of the list used by 'cd ='."
+form of the list used by `cd ='."
:type '(radio (function-item file-truename)
(function-item expand-file-name)
(function-item identity)
@@ -115,7 +115,7 @@ calls \"ls\" and references `eshell-last-arguments'."
:group 'eshell-dirs)
(defcustom eshell-pushd-tohome nil
- "If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd').
+ "If non-nil, make pushd with no arg behave as `pushd ~' (like `cd').
This mirrors the optional behavior of tcsh."
:type 'boolean
:group 'eshell-dirs)
@@ -150,11 +150,11 @@ If it is nil, the last-dir-ring will not be written to disk."
"If non-nil, the size of the directory history ring.
This ring is added to every time `cd' or `pushd' is used. It simply
stores the most recent directory locations Eshell has been in. To
-return to the most recent entry, use 'cd -' (equivalent to 'cd -0').
-To return to an older entry, use 'cd -N', where N is an integer less
+return to the most recent entry, use `cd -' (equivalent to `cd -0').
+To return to an older entry, use `cd -N', where N is an integer less
than `eshell-last-dir-ring-size'. To return to the last directory
-matching a particular regexp, use 'cd =REGEXP'. To display the
-directory history list, use 'cd ='.
+matching a particular regexp, use `cd =REGEXP'. To display the
+directory history list, use `cd ='.
This mechanism is very similar to that provided by `pushd', except
it's far more automatic. `pushd' allows the user to decide which
@@ -243,8 +243,9 @@ Thus, this does not include the current directory.")
eshell-ask-to-save-last-dir
(or (eq eshell-ask-to-save-last-dir 'always)
(y-or-n-p
- (format "Save last dir ring for Eshell buffer `%s'? "
- (buffer-name buf)))))
+ (format-message
+ "Save last dir ring for Eshell buffer `%s'? "
+ (buffer-name buf)))))
(eshell-write-last-dir-ring))))))
(defun eshell-lone-directory-p (file)
@@ -300,7 +301,7 @@ Thus, this does not include the current directory.")
eshell-user-names)))))))
(defun eshell/pwd (&rest args)
- "Change output from `pwd` to be cleaner."
+ "Change output from `pwd' to be cleaner."
(let* ((path default-directory)
(len (length path)))
(if (and (> len 1)
@@ -313,7 +314,7 @@ Thus, this does not include the current directory.")
path)))
(defun eshell-expand-multiple-dots (path)
- "Convert '...' to '../..', '....' to '../../..', etc..
+ "Convert `...' to `../..', `....' to `../../..', etc..
With the following piece of advice, you can make this functionality
available in most of Emacs, with the exception of filename completion
@@ -348,8 +349,6 @@ in the minibuffer:
index (1+ index)))))
oldpath))
-(defvar dired-directory)
-
(defun eshell/cd (&rest args) ; all but first ignored
"Alias to extend the behavior of `cd'."
(setq args (eshell-flatten-list args))
@@ -366,7 +365,7 @@ in the minibuffer:
(let ((curdir (eshell/pwd)))
(if (string-match path curdir)
(setq path (replace-match subpath nil nil curdir))
- (error "Path substring '%s' not found" path))))
+ (error "Path substring `%s' not found" path))))
((and path (string-match "^-\\([0-9]*\\)$" path))
(let ((index (match-string 1 path)))
(setq path
@@ -394,11 +393,11 @@ in the minibuffer:
(path
(setq path (eshell-expand-multiple-dots path))))
(unless handled
- (setq dired-directory (or path "~"))
- (let ((curdir (eshell/pwd)))
- (unless (equal curdir dired-directory)
+ (let ((curdir (eshell/pwd))
+ (newdir (or path "~")))
+ (unless (equal curdir newdir)
(eshell-add-to-dir-ring curdir))
- (let ((result (cd dired-directory)))
+ (let ((result (cd newdir)))
(and eshell-cd-shows-directory
(eshell-printn result)))
(run-hooks 'eshell-directory-change-hook)
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index a58c7730ded..f0a85152382 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -1,6 +1,6 @@
-;;; em-glob.el --- extended file name globbing
+;;; em-glob.el --- extended file name globbing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -180,6 +180,8 @@ interpretation."
(goto-char (1+ end))))))))))
(defvar eshell-glob-chars-regexp nil)
+(defvar eshell-glob-matches)
+(defvar message-shown)
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
@@ -191,8 +193,8 @@ The basic syntax is:
* .* matches any group of characters (or none)
# * matches zero or more occurrences of preceding
## + matches one or more occurrences of preceding
- (x) \(x\) makes 'x' a regular expression group
- | \| boolean OR within an expression group
+ (x) \\(x\\) makes `x' a regular expression group
+ | \\| boolean OR within an expression group
[a-b] [a-b] matches a character or range
[^a] [^a] excludes a character or range
@@ -218,7 +220,7 @@ resulting regular expression."
matched-in-pattern (1+ op-begin))
(let ((xlat (assq op-char eshell-glob-translate-alist)))
(if (not xlat)
- (error "Unrecognized globbing character '%c'" op-char)
+ (error "Unrecognized globbing character `%c'" op-char)
(if (stringp (cdr xlat))
(setq regexp (concat regexp (cdr xlat))
matched-in-pattern (1+ op-begin))
@@ -230,6 +232,8 @@ 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
@@ -262,9 +266,6 @@ the form:
(error "No matches found: %s" glob)
glob))))
-(defvar eshell-glob-matches)
-(defvar message-shown)
-
;; FIXME does this really need to abuse eshell-glob-matches, message-shown?
(defun eshell-glob-entries (path globs &optional recurse-p)
"Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
@@ -288,7 +289,7 @@ the form:
glob (car globs)
len (length glob)))))
(if (and recurse-p (not glob))
- (error "'**' cannot end a globbing pattern"))
+ (error "`**' cannot end a globbing pattern"))
(let ((index 1))
(setq incl glob)
(while (and (eq incl glob)
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 694fe71a95c..90dec596701 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -1,6 +1,6 @@
-;;; em-hist.el --- history list management
+;;; em-hist.el --- history list management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -306,8 +306,9 @@ element, regardless of any text on the command line. In that case,
eshell-save-history-on-exit
(or (eq eshell-save-history-on-exit t)
(y-or-n-p
- (format "Save input history for Eshell buffer `%s'? "
- (buffer-name buf)))))
+ (format-message
+ "Save input history for Eshell buffer `%s'? "
+ (buffer-name buf)))))
(eshell-write-history))))))
(defun eshell/history (&rest args)
@@ -330,7 +331,7 @@ unless a different file is specified on the command line.")
(and (or (not (ring-p eshell-history-ring))
(ring-empty-p eshell-history-ring))
(error "No history"))
- (let (length command file)
+ (let (length file)
(when (and args (string-match "^[0-9]+$" (car args)))
(setq length (min (eshell-convert (car args))
(ring-length eshell-history-ring))
@@ -346,8 +347,7 @@ unless a different file is specified on the command line.")
(write-history (eshell-write-history file))
(append-history (eshell-write-history file t))
(t
- (let* ((history nil)
- (index (1- (or length (ring-length eshell-history-ring))))
+ (let* ((index (1- (or length (ring-length eshell-history-ring))))
(ref (- (ring-length eshell-history-ring) index)))
;; We have to build up a list ourselves from the ring vector.
(while (>= index 0)
@@ -510,7 +510,8 @@ See also `eshell-read-history'."
;; Change "completion" to "history reference"
;; to make the display accurate.
(with-output-to-temp-buffer history-buffer
- (display-completion-list history prefix)
+ (display-completion-list
+ (completion-hilit-commonality history (length prefix)))
(set-buffer history-buffer)
(forward-line 3)
(while (search-backward "completion" nil 'move)
@@ -520,7 +521,7 @@ See also `eshell-read-history'."
(let ((ch (read-event)))
(if (eq ch ?\ )
(set-window-configuration conf)
- (setq unread-command-events (list ch))))))))
+ (push ch unread-command-events)))))))
(defun eshell-hist-word-reference (ref)
"Return the word designator index referred to by REF."
@@ -532,7 +533,7 @@ See also `eshell-read-history'."
((string= "%" ref)
(error "`%%' history word designator not yet implemented"))))
-(defun eshell-hist-parse-arguments (&optional silent b e)
+(defun eshell-hist-parse-arguments (&optional b e)
"Parse current command arguments in a history-code-friendly way."
(let ((end (or e (point)))
(begin (or b (save-excursion (eshell-bol) (point))))
@@ -572,7 +573,7 @@ See also `eshell-read-history'."
(defun eshell-expand-history-references (beg end)
"Parse and expand any history references in current input."
- (let ((result (eshell-hist-parse-arguments t beg end)))
+ (let ((result (eshell-hist-parse-arguments beg end)))
(when result
(let ((textargs (nreverse (nth 0 result)))
(posb (nreverse (nth 1 result)))
@@ -638,7 +639,7 @@ matched."
;; `!'
;; Start a history substitution, except when followed by a
;; space, tab, the end of the line, = or (.
- (if (not (string-match "^![^ \t\n=\(]" reference))
+ (if (not (string-match "^![^ \t\n=(]" reference))
reference
(setq eshell-history-index nil)
(let ((event (eshell-hist-parse-event-designator reference)))
@@ -700,7 +701,7 @@ matched."
(here (point))
textargs)
(insert hist)
- (setq textargs (car (eshell-hist-parse-arguments nil here (point))))
+ (setq textargs (car (eshell-hist-parse-arguments here (point))))
(delete-region here (point))
(if (string= nth "*")
(if mth
@@ -724,7 +725,7 @@ matched."
(setq nth (eshell-hist-word-reference nth)))
(unless (numberp mth)
(setq mth (eshell-hist-word-reference mth)))
- (cons (mapconcat 'identity (eshell-sublist textargs nth mth) "")
+ (cons (mapconcat 'identity (eshell-sublist textargs nth mth) " ")
end))))
(defun eshell-hist-parse-modifier (hist reference)
@@ -737,7 +738,7 @@ matched."
(goto-char (point-min))
(let ((modifiers (cdr (eshell-parse-modifiers))))
(dolist (mod modifiers)
- (setq hist (funcall mod hist)))
+ (setq hist (car (funcall mod (list hist)))))
hist))
(delete-region here (point)))))
@@ -945,7 +946,7 @@ If N is negative, search backwards for the -Nth previous match."
(defun eshell-isearch-backward (&optional invert)
"Do incremental regexp search backward through past commands."
(interactive)
- (let ((inhibit-read-only t) end)
+ (let ((inhibit-read-only t))
(eshell-prepare-for-search)
(goto-char (point-max))
(set-marker eshell-last-output-end (point))
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 41db4cd03d1..ae6e0d3e886 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -1,6 +1,6 @@
-;;; em-ls.el --- implementation of ls in Lisp
+;;; em-ls.el --- implementation of ls in Lisp -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -44,127 +44,102 @@ properties to colorize its output based on the setting of
;;; User Variables:
-(defvar eshell-ls-orig-insert-directory
- (symbol-function 'insert-directory)
- "Preserve the original definition of `insert-directory'.")
-
-(defcustom eshell-ls-unload-hook
- (list
- (function
- (lambda ()
- (fset 'insert-directory eshell-ls-orig-insert-directory))))
- "When unloading `eshell-ls', restore the definition of `insert-directory'."
- :type 'hook
- :group 'eshell-ls)
-
(defcustom eshell-ls-date-format "%Y-%m-%d"
"How to display time information in `eshell-ls-file'.
This is passed to `format-time-string' as a format string.
-To display the date using the current locale, use \"%b \%e\"."
+To display the date using the current locale, use \"%b \ %e\"."
:version "24.1"
- :type 'string
- :group 'eshell-ls)
+ :type 'string)
(defcustom eshell-ls-initial-args nil
"If non-nil, this list of args is included before any call to `ls'.
This is useful for enabling human-readable format (-h), for example."
- :type '(repeat :tag "Arguments" string)
- :group 'eshell-ls)
+ :type '(repeat :tag "Arguments" string))
(defcustom eshell-ls-dired-initial-args nil
"If non-nil, args is included before any call to `ls' in Dired.
This is useful for enabling human-readable format (-h), for example."
- :type '(repeat :tag "Arguments" string)
- :group 'eshell-ls)
+ :type '(repeat :tag "Arguments" string))
(defcustom eshell-ls-use-in-dired nil
- "If non-nil, use `eshell-ls' to read directories in Dired."
+ "If non-nil, use `eshell-ls' to read directories in Dired.
+Changing this without using customize has no effect."
:set (lambda (symbol value)
(if value
- (unless (and (boundp 'eshell-ls-use-in-dired)
- eshell-ls-use-in-dired)
- (fset 'insert-directory 'eshell-ls-insert-directory))
- (when (and (boundp 'eshell-ls-insert-directory)
- eshell-ls-use-in-dired)
- (fset 'insert-directory eshell-ls-orig-insert-directory)))
- (setq eshell-ls-use-in-dired value))
+ (advice-add 'insert-directory :around
+ #'eshell-ls--insert-directory)
+ (advice-remove 'insert-directory
+ #'eshell-ls--insert-directory))
+ (set symbol value))
:type 'boolean
- :require 'em-ls
- :group 'eshell-ls)
+ :require 'em-ls)
+(add-hook 'eshell-ls-unload-hook
+ (lambda () (advice-remove 'insert-directory
+ #'eshell-ls--insert-directory)))
+
(defcustom eshell-ls-default-blocksize 1024
"The default blocksize to use when display file sizes with -s."
- :type 'integer
- :group 'eshell-ls)
+ :type 'integer)
(defcustom eshell-ls-exclude-regexp nil
"Unless -a is specified, files matching this regexp will not be shown."
- :type '(choice regexp (const nil))
- :group 'eshell-ls)
+ :type '(choice regexp (const nil)))
(defcustom eshell-ls-exclude-hidden t
"Unless -a is specified, files beginning with . will not be shown.
Using this boolean, instead of `eshell-ls-exclude-regexp', is both
faster and conserves more memory."
- :type 'boolean
- :group 'eshell-ls)
+ :type 'boolean)
(defcustom eshell-ls-use-colors t
"If non-nil, use colors in file listings."
- :type 'boolean
- :group 'eshell-ls)
+ :type 'boolean)
(defface eshell-ls-directory
'((((class color) (background light)) (:foreground "Blue" :weight bold))
(((class color) (background dark)) (:foreground "SkyBlue" :weight bold))
(t (:weight bold)))
- "The face used for highlight directories."
- :group 'eshell-ls)
+ "The face used for highlighting directories.")
(define-obsolete-face-alias 'eshell-ls-directory-face
'eshell-ls-directory "22.1")
(defface eshell-ls-symlink
'((((class color) (background light)) (:foreground "Dark Cyan" :weight bold))
(((class color) (background dark)) (:foreground "Cyan" :weight bold)))
- "The face used for highlight symbolic links."
- :group 'eshell-ls)
+ "The face used for highlighting symbolic links.")
(define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1")
(defface eshell-ls-executable
'((((class color) (background light)) (:foreground "ForestGreen" :weight bold))
(((class color) (background dark)) (:foreground "Green" :weight bold)))
- "The face used for highlighting executables (not directories, though)."
- :group 'eshell-ls)
+ "The face used for highlighting executables (not directories, though).")
(define-obsolete-face-alias 'eshell-ls-executable-face
'eshell-ls-executable "22.1")
(defface eshell-ls-readonly
'((((class color) (background light)) (:foreground "Brown"))
(((class color) (background dark)) (:foreground "Pink")))
- "The face used for highlighting read-only files."
- :group 'eshell-ls)
+ "The face used for highlighting read-only files.")
(define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1")
(defface eshell-ls-unreadable
'((((class color) (background light)) (:foreground "Grey30"))
(((class color) (background dark)) (:foreground "DarkGrey")))
- "The face used for highlighting unreadable files."
- :group 'eshell-ls)
+ "The face used for highlighting unreadable files.")
(define-obsolete-face-alias 'eshell-ls-unreadable-face
'eshell-ls-unreadable "22.1")
(defface eshell-ls-special
'((((class color) (background light)) (:foreground "Magenta" :weight bold))
(((class color) (background dark)) (:foreground "Magenta" :weight bold)))
- "The face used for highlighting non-regular files."
- :group 'eshell-ls)
+ "The face used for highlighting non-regular files.")
(define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1")
(defface eshell-ls-missing
'((((class color) (background light)) (:foreground "Red" :weight bold))
(((class color) (background dark)) (:foreground "Red" :weight bold)))
- "The face used for highlighting non-existent file names."
- :group 'eshell-ls)
+ "The face used for highlighting non-existent file names.")
(define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1")
(defcustom eshell-ls-archive-regexp
@@ -174,27 +149,23 @@ faster and conserves more memory."
This typically includes both traditional archives and compressed
files."
:version "24.1" ; added xz
- :type 'regexp
- :group 'eshell-ls)
+ :type 'regexp)
(defface eshell-ls-archive
'((((class color) (background light)) (:foreground "Orchid" :weight bold))
(((class color) (background dark)) (:foreground "Orchid" :weight bold)))
- "The face used for highlighting archived and compressed file names."
- :group 'eshell-ls)
+ "The face used for highlighting archived and compressed file names.")
(define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1")
(defcustom eshell-ls-backup-regexp
"\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
"A regular expression that matches names of backup files."
- :type 'regexp
- :group 'eshell-ls)
+ :type 'regexp)
(defface eshell-ls-backup
'((((class color) (background light)) (:foreground "OrangeRed"))
(((class color) (background dark)) (:foreground "LightSalmon")))
- "The face used for highlighting backup file names."
- :group 'eshell-ls)
+ "The face used for highlighting backup file names.")
(define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1")
(defcustom eshell-ls-product-regexp
@@ -202,14 +173,12 @@ files."
"A regular expression that matches names of product files.
Products are files that get generated from a source file, and hence
ought to be recreatable if they are deleted."
- :type 'regexp
- :group 'eshell-ls)
+ :type 'regexp)
(defface eshell-ls-product
'((((class color) (background light)) (:foreground "OrangeRed"))
(((class color) (background dark)) (:foreground "LightSalmon")))
- "The face used for highlighting files that are build products."
- :group 'eshell-ls)
+ "The face used for highlighting files that are build products.")
(define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1")
(defcustom eshell-ls-clutter-regexp
@@ -217,14 +186,12 @@ ought to be recreatable if they are deleted."
"A regular expression that matches names of junk files.
These are mainly files that get created for various reasons, but don't
really need to stick around for very long."
- :type 'regexp
- :group 'eshell-ls)
+ :type 'regexp)
(defface eshell-ls-clutter
'((((class color) (background light)) (:foreground "OrangeRed" :weight bold))
(((class color) (background dark)) (:foreground "OrangeRed" :weight bold)))
- "The face used for highlighting junk file names."
- :group 'eshell-ls)
+ "The face used for highlighting junk file names.")
(define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1")
(defsubst eshell-ls-filetype-p (attrs type)
@@ -265,13 +232,31 @@ The format of the members of this alist is
If TEST-SEXP evals to non-nil, that face will be used to highlight the
name of the file. The first match wins. `file' and `attrs' are in
scope during the evaluation of TEST-SEXP."
- :type '(repeat (cons function face))
- :group 'eshell-ls)
+ :type '(repeat (cons function face)))
+
+(defvar block-size)
+(defvar dereference-links)
+(defvar dir-literal)
+(defvar error-func)
+(defvar flush-func)
+(defvar human-readable)
+(defvar ignore-pattern)
+(defvar insert-func)
+(defvar listing-style)
+(defvar numeric-uid-gid)
+(defvar reverse-list)
+(defvar show-all)
+(defvar show-almost-all)
+(defvar show-recursive)
+(defvar show-size)
+(defvar sort-method)
+(defvar ange-cache)
+(defvar dired-flag)
;;; Functions:
-(defun eshell-ls-insert-directory
- (file switches &optional wildcard full-directory-p)
+(defun eshell-ls--insert-directory
+ (orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings.
@@ -282,29 +267,31 @@ switches do not contain `d', so that a full listing is expected.
This version of the function uses `eshell/ls'. If any of the switches
passed are not recognized, the operating system's version will be used
instead."
- (let ((handler (find-file-name-handler file 'insert-directory)))
- (if handler
- (funcall handler 'insert-directory file switches
- wildcard full-directory-p)
- (if (stringp switches)
- (setq switches (split-string switches)))
- (let (eshell-current-handles
- eshell-current-subjob-p
- font-lock-mode)
- ;; use the fancy highlighting in `eshell-ls' rather than font-lock
- (when (and eshell-ls-use-colors
- (featurep 'font-lock))
- (font-lock-mode -1)
- (setq font-lock-defaults nil)
- (if (boundp 'font-lock-buffers)
- (set 'font-lock-buffers
- (delq (current-buffer)
- (symbol-value 'font-lock-buffers)))))
- (let ((insert-func 'insert)
- (error-func 'insert)
- (flush-func 'ignore)
- eshell-ls-dired-initial-args)
- (eshell-do-ls (append switches (list file))))))))
+ (if (not eshell-ls-use-in-dired)
+ (funcall orig-fun file switches wildcard full-directory-p)
+ (let ((handler (find-file-name-handler file 'insert-directory)))
+ (if handler
+ (funcall handler 'insert-directory file switches
+ wildcard full-directory-p)
+ (if (stringp switches)
+ (setq switches (split-string switches)))
+ (let (eshell-current-handles
+ eshell-current-subjob-p
+ font-lock-mode)
+ ;; use the fancy highlighting in `eshell-ls' rather than font-lock
+ (when (and eshell-ls-use-colors
+ (featurep 'font-lock))
+ (font-lock-mode -1)
+ (setq font-lock-defaults nil)
+ (if (boundp 'font-lock-buffers)
+ (set 'font-lock-buffers
+ (delq (current-buffer)
+ (symbol-value 'font-lock-buffers)))))
+ (let ((insert-func 'insert)
+ (error-func 'insert)
+ (flush-func 'ignore)
+ eshell-ls-dired-initial-args)
+ (eshell-do-ls (append switches (list file)))))))))
(defsubst eshell/ls (&rest args)
"An alias version of `eshell-do-ls'."
@@ -315,25 +302,6 @@ instead."
(put 'eshell/ls 'eshell-no-numeric-conversions t)
-(defvar block-size)
-(defvar dereference-links)
-(defvar dir-literal)
-(defvar error-func)
-(defvar flush-func)
-(defvar human-readable)
-(defvar ignore-pattern)
-(defvar insert-func)
-(defvar listing-style)
-(defvar numeric-uid-gid)
-(defvar reverse-list)
-(defvar show-all)
-(defvar show-almost-all)
-(defvar show-recursive)
-(defvar show-size)
-(defvar sort-method)
-(defvar ange-cache)
-(defvar dired-flag)
-
(declare-function eshell-glob-regexp "em-glob" (pattern))
(defun eshell-do-ls (&rest args)
@@ -522,7 +490,7 @@ whose cdr is the list of file attributes."
" " (format-time-string
(concat
eshell-ls-date-format " "
- (if (= (nth 5 (decode-time (current-time)))
+ (if (= (nth 5 (decode-time))
(nth 5 (decode-time
(nth (cond
((eq sort-method 'by-atime) 4)
@@ -951,7 +919,7 @@ to use, and each member of which is the width of that column
value)))))
(if face
(add-text-properties 0 (length (car file))
- (list 'face face)
+ (list 'font-lock-face face)
(car file)))))
(car file))
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 3a7f46ebe83..102795fc16b 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -1,6 +1,6 @@
-;;; em-pred.el --- argument predicates and modifiers (ala zsh)
+;;; em-pred.el --- argument predicates and modifiers (ala zsh) -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -119,7 +119,8 @@ The format of each entry is
(function
(lambda (str)
(eshell-stringify
- (car (eshell-parse-argument str))))) lst)))
+ (car (eshell-parse-argument str)))))
+ lst)))
(?L . #'(lambda (lst) (mapcar 'downcase lst)))
(?U . #'(lambda (lst) (mapcar 'upcase lst)))
(?C . #'(lambda (lst) (mapcar 'capitalize lst)))
@@ -171,18 +172,18 @@ PERMISSION BITS (for owner/group/world):
OWNERSHIP:
U owned by effective uid
- u(UID|'user') owned by UID/user
- g(GID|'group') owned by GID/group
+ u(UID|\\='user\\=') owned by UID/user
+ g(GID|\\='group\\=') owned by GID/group
FILE ATTRIBUTES:
l[+-]N +/-/= N links
- a[Mwhms][+-](N|'FILE') access time +/-/= N months/weeks/hours/mins/secs
+ a[Mwhms][+-](N|\\='FILE\\=') access time +/-/= N months/weeks/hours/mins/secs
(days if unspecified) if FILE specified,
- use as comparison basis; so a+'file.c'
+ use as comparison basis; so a+\\='file.c\\='
shows files accessed before file.c was
last accessed
- m[Mwhms][+-](N|'FILE') modification time...
- c[Mwhms][+-](N|'FILE') change time...
+ m[Mwhms][+-](N|\\='FILE\\=') modification time...
+ c[Mwhms][+-](N|\\='FILE\\=') change time...
L[kmp][+-]N file size +/-/= N Kb/Mb/blocks
EXAMPLES:
@@ -192,7 +193,7 @@ EXAMPLES:
***/*~f*(-/) recursively (though not traversing symlinks),
find all directories (or symlinks referring to
directories) whose names do not begin with f.
- e*(*Lk+50) executables 50k or larger beginning with 'e'")
+ e*(*Lk+50) executables 50k or larger beginning with `e'")
(defvar eshell-modifier-help-string
"Eshell modifier quick reference:
@@ -296,18 +297,17 @@ This function is specially for adding onto `eshell-parse-argument-hook'."
(defun eshell-parse-modifiers ()
"Parse value modifiers and predicates at point.
-If ALLOW-PREDS is non-nil, predicates will be parsed as well.
Return a cons cell of the form
(PRED-FUNC-LIST . MOD-FUNC-LIST)
-NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of
-predicate functions. MOD-FUNC-LIST is a list of result modifier
-functions. PRED-FUNCS take a filename and return t if the test
-succeeds; MOD-FUNCS take any string and preform a modification,
-returning the resultant string."
- (let (result negate follow preds mods)
- (condition-case err
+PRED-FUNC-LIST is a list of predicate functions. MOD-FUNC-LIST
+is a list of result modifier functions. PRED-FUNCS take a
+filename and return t if the test succeeds; MOD-FUNCS take any
+list of strings and perform a modification, returning the
+resultant list of strings."
+ (let (negate follow preds mods)
+ (condition-case nil
(while (not (eobp))
(let ((char (char-after)))
(cond
@@ -318,7 +318,7 @@ returning the resultant string."
(if (and func (functionp func))
(setq preds (eshell-add-pred-func func preds
negate follow))
- (error "Invalid function predicate '%s'"
+ (error "Invalid function predicate `%s'"
(eshell-stringify func))))
(error "Invalid function predicate")))
((eq char ?^)
@@ -336,20 +336,20 @@ returning the resultant string."
(cons `(lambda (lst)
(mapcar (function ,func) lst))
mods))
- (error "Invalid function modifier '%s'"
+ (error "Invalid function modifier `%s'"
(eshell-stringify func))))
(error "Invalid function modifier")))
((eq char ?:)
(forward-char)
(let ((mod (assq (char-after) eshell-modifier-alist)))
(if (not mod)
- (error "Unknown modifier character '%c'" (char-after))
+ (error "Unknown modifier character `%c'" (char-after))
(forward-char)
(setq mods (cons (eval (cdr mod)) mods)))))
(t
(let ((pred (assq char eshell-predicate-alist)))
(if (not pred)
- (error "Unknown predicate character '%c'" char)
+ (error "Unknown predicate character `%c'" char)
(forward-char)
(setq preds
(eshell-add-pred-func (eval (cdr pred)) preds
@@ -399,7 +399,7 @@ returning the resultant string."
(defun eshell-pred-file-time (mod-char mod-type attr-index)
"Return a predicate to test whether a file matches a certain time."
(let* ((quantum 86400)
- qual amount when open close end)
+ qual when open close end)
(when (memq (char-after) '(?M ?w ?h ?m ?s))
(setq quantum (char-after))
(cond
@@ -451,7 +451,7 @@ returning the resultant string."
(defun eshell-pred-file-type (type)
"Return a test which tests that the file is of a certain TYPE.
TYPE must be a character, and should be one of the possible options
-that 'ls -l' will show in the first column of its display. "
+that `ls -l' will show in the first column of its display. "
(when (eq type ?%)
(setq type (char-after))
(if (memq type '(?b ?c))
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 18731121c4e..69c5bd62259 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -1,6 +1,6 @@
-;;; em-prompt.el --- command prompts
+;;; em-prompt.el --- command prompts -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -45,6 +45,8 @@ as is common with most shells."
:type 'hook
:group 'eshell-prompt)
+(autoload 'eshell/pwd "em-dirs")
+
(defcustom eshell-prompt-function
(function
(lambda ()
@@ -122,9 +124,9 @@ arriving, or after."
(and eshell-highlight-prompt
(add-text-properties 0 (length prompt)
'(read-only t
- face eshell-prompt
- front-sticky (face read-only)
- rear-nonsticky (face read-only))
+ font-lock-face eshell-prompt
+ front-sticky (font-lock-face read-only)
+ rear-nonsticky (font-lock-face read-only))
prompt))
(eshell-interactive-print prompt)))
(run-hooks 'eshell-after-prompt-hook))
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 341191fc62f..3ac74647409 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -1,6 +1,6 @@
-;;; em-rebind.el --- rebind keys when point is at current input
+;;; em-rebind.el --- rebind keys when point is at current input -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -218,7 +218,7 @@ lock it at that."
(cdar bindings))
(setq bindings (cdr bindings)))))
-(defun eshell-delete-backward-char (n &optional killflag)
+(defun eshell-delete-backward-char (n)
"Delete the last character, unless it's part of the output."
(interactive "P")
(let ((count (prefix-numeric-value n)))
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index b073928738f..1a16e5e7a0f 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -1,6 +1,6 @@
-;;; em-script.el --- Eshell script files
+;;; em-script.el --- Eshell script files -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -45,7 +45,7 @@ commands, as a script file."
(defcustom eshell-login-script (expand-file-name "login" eshell-directory-name)
"If non-nil, a file to invoke when starting up Eshell interactively.
This file should be a file containing Eshell commands, where comment
-lines begin with '#'."
+lines begin with `#'."
:type 'file
:group 'eshell-script)
@@ -89,7 +89,7 @@ This includes when running `eshell-command'."
(defun eshell-source-file (file &optional args subcommand-p)
"Execute a series of Eshell commands in FILE, passing ARGS.
-Comments begin with '#'."
+Comments begin with `#'."
(interactive "f")
(let ((orig (point))
(here (point-max))
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index aa9038aafb9..ed6cfb55177 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -1,6 +1,6 @@
-;;; em-smart.el --- smart display of output
+;;; em-smart.el --- smart display of output -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -188,19 +188,20 @@ The options are `begin', `after' or `end'."
(add-hook 'eshell-post-command-hook
(function
(lambda ()
- (setq eshell-smart-command-done t))) t t)
+ (setq eshell-smart-command-done t)))
+ t t)
(unless (eq eshell-review-quick-commands t)
(add-hook 'eshell-post-command-hook
'eshell-smart-maybe-jump-to-end nil t))))
-(defun eshell-smart-scroll-window (wind start)
+;; This is called by window-scroll-functions with two arguments.
+(defun eshell-smart-scroll-window (wind _start)
"Scroll the given Eshell window accordingly."
(unless eshell-currently-handling-window
(let ((inhibit-point-motion-hooks t)
(eshell-currently-handling-window t))
- (save-selected-window
- (select-window wind)
+ (with-selected-window wind
(eshell-smart-redisplay)))))
(defun eshell-refresh-windows (&optional frame)
@@ -211,12 +212,12 @@ The options are `begin', `after' or `end'."
(lambda (wind)
(with-current-buffer (window-buffer wind)
(if eshell-mode
- (let (window-scroll-functions)
+ (let (window-scroll-functions) ;;FIXME: Why?
(eshell-smart-scroll-window wind (window-start))
(setq affected t))))))
0 frame)
(if affected
- (let (window-scroll-functions)
+ (let (window-scroll-functions) ;;FIXME: Why?
(eshell-redisplay)))))
(defun eshell-smart-display-setup ()
@@ -237,7 +238,8 @@ The options are `begin', `after' or `end'."
(add-hook 'pre-command-hook 'eshell-smart-display-move nil t)
(eshell-refresh-windows))
-(defun eshell-disable-after-change (b e l)
+;; Called from after-change-functions with 3 arguments.
+(defun eshell-disable-after-change (_b _e _l)
"Disable smart display mode if the buffer changes in any way."
(when eshell-smart-command-done
(remove-hook 'pre-command-hook 'eshell-smart-display-move t)
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index 2932f443e4f..a8fa9733b42 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -1,6 +1,6 @@
-;;; em-term.el --- running visual commands
+;;; em-term.el --- running visual commands -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -40,7 +40,7 @@
;;;###autoload
(progn
(defgroup eshell-term nil
- "This module causes visual commands (e.g., 'vi') to be executed by
+ "This module causes visual commands (e.g., `vi') to be executed by
the `term' package, which comes with Emacs. This package handles most
of the ANSI control codes, allowing curses-based applications to run
within an Emacs window. The variable `eshell-visual-commands' defines
@@ -132,6 +132,13 @@ character to the invoked process."
:type 'boolean
:group 'eshell-term)
+(defcustom eshell-destroy-buffer-when-process-dies nil
+ "If non-nil, term buffers are destroyed after their processes die.
+WARNING: Setting this to non-nil may result in unexpected
+behavior for short-lived processes, see bug#18108."
+ :type 'boolean
+ :group 'eshell-term)
+
;;; Internal Variables:
(defvar eshell-parent-buffer)
@@ -189,20 +196,25 @@ allowed."
(term-set-escape-char ?\C-x))))
nil)
-(defun eshell-term-sentinel (proc string)
- "Destroy the buffer visiting PROC."
- (let ((proc-buf (process-buffer proc)))
- (when (and proc-buf (buffer-live-p proc-buf)
- (not (eq 'run (process-status proc)))
- (= (process-exit-status proc) 0))
- (if (eq (current-buffer) proc-buf)
- (let ((buf (and (boundp 'eshell-parent-buffer)
- eshell-parent-buffer
- (buffer-live-p eshell-parent-buffer)
- eshell-parent-buffer)))
- (if buf
- (switch-to-buffer buf))))
- (kill-buffer proc-buf))))
+;; Process sentinels receive two arguments.
+(defun eshell-term-sentinel (proc msg)
+ "Clean up the buffer visiting PROC.
+If `eshell-destroy-buffer-when-process-dies' is non-nil, destroy
+the buffer."
+ (term-sentinel proc msg) ;; First call the normal term sentinel.
+ (when eshell-destroy-buffer-when-process-dies
+ (let ((proc-buf (process-buffer proc)))
+ (when (and proc-buf (buffer-live-p proc-buf)
+ (not (eq 'run (process-status proc)))
+ (= (process-exit-status proc) 0))
+ (if (eq (current-buffer) proc-buf)
+ (let ((buf (and (boundp 'eshell-parent-buffer)
+ eshell-parent-buffer
+ (buffer-live-p eshell-parent-buffer)
+ eshell-parent-buffer)))
+ (if buf
+ (switch-to-buffer buf))))
+ (kill-buffer proc-buf)))))
;; jww (1999-09-17): The code below will allow Eshell to send input
;; characters directly to the currently running interactive process.
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index fb816b76a7d..92547edc79d 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -1,6 +1,6 @@
-;;; em-tramp.el --- Eshell features that require TRAMP
+;;; em-tramp.el --- Eshell features that require TRAMP -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Aidan Gauland <aidalgol@no8wireless.co.nz>
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index af54d875cb0..19597dfbc1f 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -1,6 +1,6 @@
-;;; em-unix.el --- UNIX command aliases
+;;; em-unix.el --- UNIX command aliases -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -168,10 +168,10 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
(defun eshell/info (&rest args)
"Run the info command in-frame with the same behavior as command-line `info', ie:
- 'info' => goes to top info window
- 'info arg1' => IF arg1 is a file, then visits arg1
- 'info arg1' => OTHERWISE goes to top info window and then menu item arg1
- 'info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and then menu item arg2
+ `info' => goes to top info window
+ `info arg1' => IF arg1 is a file, then visits arg1
+ `info arg1' => OTHERWISE goes to top info window and then menu item arg1
+ `info arg1 arg2' => does action for arg1 (either visit-file or menu-item) and then menu item arg2
etc."
(eval-and-compile (require 'info))
(let ((file (cond
@@ -195,34 +195,34 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
(Info-menu (car args))
(setq args (cdr args)))))
-(defun eshell-remove-entries (path files &optional top-level)
- "From PATH, remove all of the given FILES, perhaps interactively."
+(defun eshell-remove-entries (files &optional toplevel)
+ "Remove all of the given FILES, perhaps interactively."
(while files
(if (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory (car files)))
- (if top-level
+ (if toplevel
(eshell-error "rm: cannot remove `.' or `..'\n"))
(if (and (file-directory-p (car files))
(not (file-symlink-p (car files))))
(progn
(if em-verbose
- (eshell-printn (format "rm: removing directory `%s'"
- (car files))))
+ (eshell-printn (format-message "rm: removing directory `%s'"
+ (car files))))
(unless
(or em-preview
(and em-interactive
(not (y-or-n-p
- (format "rm: remove directory `%s'? "
- (car files))))))
+ (format-message "rm: remove directory `%s'? "
+ (car files))))))
(eshell-funcalln 'delete-directory (car files) t t)))
(if em-verbose
- (eshell-printn (format "rm: removing file `%s'"
- (car files))))
+ (eshell-printn (format-message "rm: removing file `%s'"
+ (car files))))
(unless (or em-preview
(and em-interactive
(not (y-or-n-p
- (format "rm: remove `%s'? "
- (car files))))))
+ (format-message "rm: remove `%s'? "
+ (car files))))))
(eshell-funcalln 'delete-file (car files) t))))
(setq files (cdr files))))
@@ -260,42 +260,49 @@ Remove (unlink) the FILE(s).")
(cond
((bufferp entry)
(if em-verbose
- (eshell-printn (format "rm: removing buffer `%s'" entry)))
+ (eshell-printn (format-message "rm: removing buffer `%s'" entry)))
(unless (or em-preview
(and em-interactive
- (not (y-or-n-p (format "rm: delete buffer `%s'? "
- entry)))))
+ (not (y-or-n-p (format-message
+ "rm: delete buffer `%s'? "
+ entry)))))
(eshell-funcalln 'kill-buffer entry)))
((eshell-processp entry)
(if em-verbose
- (eshell-printn (format "rm: killing process `%s'" entry)))
+ (eshell-printn (format-message "rm: killing process `%s'" entry)))
(unless (or em-preview
(and em-interactive
- (not (y-or-n-p (format "rm: kill process `%s'? "
- entry)))))
+ (not (y-or-n-p (format-message
+ "rm: kill process `%s'? "
+ entry)))))
(eshell-funcalln 'kill-process entry)))
((symbolp entry)
(if em-verbose
- (eshell-printn (format "rm: uninterning symbol `%s'" entry)))
+ (eshell-printn (format-message
+ "rm: uninterning symbol `%s'" entry)))
(unless
(or em-preview
(and em-interactive
- (not (y-or-n-p (format "rm: unintern symbol `%s'? "
- entry)))))
+ (not (y-or-n-p (format-message
+ "rm: unintern symbol `%s'? "
+ entry)))))
(eshell-funcalln 'unintern entry)))
((stringp entry)
- (if (and (file-directory-p entry)
- (not (file-symlink-p entry)))
- (if (or em-recursive
- eshell-rm-removes-directories)
- (if (or em-preview
- (not em-interactive)
- (y-or-n-p
- (format "rm: descend into directory `%s'? "
- entry)))
- (eshell-remove-entries nil (list entry) t))
- (eshell-error (format "rm: %s: is a directory\n" entry)))
- (eshell-remove-entries nil (list entry) t)))))
+ ;; -f should silently ignore missing files (bug#15373).
+ (unless (and force-removal
+ (not (file-exists-p entry)))
+ (if (and (file-directory-p entry)
+ (not (file-symlink-p entry)))
+ (if (or em-recursive
+ eshell-rm-removes-directories)
+ (if (or em-preview
+ (not em-interactive)
+ (y-or-n-p
+ (format-message "rm: descend into directory `%s'? "
+ entry)))
+ (eshell-remove-entries (list entry) t))
+ (eshell-error (format "rm: %s: is a directory\n" entry)))
+ (eshell-remove-entries (list entry) t))))))
(setq args (cdr args)))
nil))
@@ -366,8 +373,8 @@ Remove the DIRECTORY(ies), if they are empty.")
(equal (nth 10 attr-target) (nth 10 attr))
(nth 11 attr-target) (nth 11 attr)
(equal (nth 11 attr-target) (nth 11 attr)))
- (eshell-error (format "%s: `%s' and `%s' are the same file\n"
- command (car files) target)))
+ (eshell-error (format-message "%s: `%s' and `%s' are the same file\n"
+ command (car files) target)))
(t
(let ((source (car files))
(target (if is-dir
@@ -458,6 +465,8 @@ 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)
@@ -508,7 +517,7 @@ Remove the DIRECTORY(ies), if they are empty.")
:usage "[OPTION]... SOURCE DEST
or: mv [OPTION]... SOURCE... DIRECTORY
Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
-\[OPTION] DIRECTORY...")
+[OPTION] DIRECTORY...")
(let ((no-dereference t))
(eshell-mvcpln-template "mv" "moving" 'rename-file
eshell-mv-interactive-query
@@ -574,7 +583,7 @@ Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
Create a link to the specified TARGET with optional LINK_NAME. If there is
more than one TARGET, the last argument must be a directory; create links
in DIRECTORY to each TARGET. Create hard links by default, symbolic links
-with '--symbolic'. When creating hard links, each TARGET must exist.")
+with `--symbolic'. When creating hard links, each TARGET must exist.")
(let ((no-dereference t))
(eshell-mvcpln-template "ln" "linking"
(if symbolic
@@ -714,6 +723,8 @@ available..."
(goto-char (point-min))
(resize-temp-buffer-window))))))
+(defvar compilation-scroll-output)
+
(defun eshell-grep (command args &optional maybe-use-occur)
"Generic service function for the various grep aliases.
It calls Emacs's grep utility if the command is not redirecting output,
@@ -989,7 +1000,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
(setq args nil)
(setcdr (last args 3) nil))
(with-current-buffer
- (condition-case err
+ (condition-case nil
(diff-no-select
old new
(nil-blank-string (eshell-flatten-and-stringify args)))
@@ -1014,6 +1025,8 @@ Show wall-clock time elapsed during execution of COMMAND.")
(put 'eshell/diff 'eshell-no-numeric-conversions t)
+(defvar locate-history-list)
+
(defun eshell/locate (&rest args)
"Alias \"locate\" to call Emacs `locate' function."
(if (or eshell-plain-locate-behavior
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index c4cab522cf2..b2af974d983 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -1,6 +1,6 @@
-;;; em-xtra.el --- extra alias functions
+;;; em-xtra.el --- extra alias functions -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index d7dfd27d8d3..93d795b1351 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -1,6 +1,6 @@
-;;; esh-arg.el --- argument processing
+;;; esh-arg.el --- argument processing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -89,7 +89,7 @@ yield the values intended."
(goto-char (match-end 0))
(eshell-finish-arg)))))
- ;; backslash before a special character means escape it
+ ;; parse backslash and the character after
'eshell-parse-backslash
;; text beginning with ' is a literally quoted
@@ -237,7 +237,7 @@ Point is left at the end of the arguments."
(let* ((here (point))
(arg (eshell-parse-argument)))
(if (= (point) here)
- (error "Failed to parse argument '%s'"
+ (error "Failed to parse argument `%s'"
(buffer-substring here (point-max))))
(and arg (nconc args (list arg)))))))
(throw 'eshell-incomplete (if (listp delim)
@@ -278,7 +278,7 @@ Point is left at the end of the arguments."
(eshell-resolve-current-argument)
eshell-current-argument))
-(defsubst eshell-operator (&rest args)
+(defsubst eshell-operator (&rest _args)
"A stub function that generates an error if a floating operator is found."
(error "Unhandled operator in input text"))
@@ -305,34 +305,27 @@ If the character is itself a backslash, it needs no escaping."
(string ?\\ char)))))
(defun eshell-parse-backslash ()
- "Parse a single backslash (\) character, which might mean escape.
-It only means escape if the character immediately following is a
-special character that is not itself a backslash."
+ "Parse a single backslash (\\) character and the character after.
+If the character after the backslash is special, always ignore
+the backslash and return the escaped character.
+
+Otherwise, if the backslash is not in quoted string, the
+backslash is ignored and the character after is returned. If the
+backslash is in a quoted string, the backslash and the character
+after are both returned."
(when (eq (char-after) ?\\)
- (if (eshell-looking-at-backslash-return (point))
- (throw 'eshell-incomplete ?\\)
- (if (and (not (eq (char-after (1+ (point))) ?\\))
- (if eshell-current-quoted
- (memq (char-after (1+ (point)))
- eshell-special-chars-inside-quoting)
- (memq (char-after (1+ (point)))
- eshell-special-chars-outside-quoting)))
- (progn
- (forward-char 2)
- (list 'eshell-escape-arg
- (char-to-string (char-before))))
- ;; allow \\<RET> to mean a literal "\" character followed by a
- ;; normal return, rather than a backslash followed by a line
- ;; continuation (i.e., "\\ + \n" rather than "\ + \\n"). This
- ;; is necessary because backslashes in Eshell are not special
- ;; unless they either precede something special, or precede a
- ;; backslash that precedes something special. (Mainly this is
- ;; done to make using backslash on Windows systems more
- ;; natural-feeling).
- (if (eshell-looking-at-backslash-return (1+ (point)))
- (forward-char))
- (forward-char)
- "\\"))))
+ (when (eshell-looking-at-backslash-return (point))
+ (throw 'eshell-incomplete ?\\))
+ (forward-char 2) ; Move one char past the backslash.
+ ;; If the char is in a quote, backslash only has special meaning
+ ;; if it is escaping a special char.
+ (if eshell-current-quoted
+ (if (memq (char-before) eshell-special-chars-inside-quoting)
+ (list 'eshell-escape-arg (char-to-string (char-before)))
+ (concat "\\" (char-to-string (char-before))))
+ (if (memq (char-before) eshell-special-chars-outside-quoting)
+ (list 'eshell-escape-arg (char-to-string (char-before)))
+ (char-to-string (char-before))))))
(defun eshell-parse-literal-quote ()
"Parse a literally quoted string. Nothing has special meaning!"
@@ -364,22 +357,31 @@ special character that is not itself a backslash."
(goto-char (1+ end)))))))
(defun eshell-parse-special-reference ()
- "Parse a special syntax reference, of the form '#<type arg>'."
- (if (and (not eshell-current-argument)
- (not eshell-current-quoted)
- (looking-at "#<\\(buffer\\|process\\)\\s-"))
- (let ((here (point)))
- (goto-char (match-end 0))
- (let* ((buffer-p (string= (match-string 1) "buffer"))
- (end (eshell-find-delimiter ?\< ?\>)))
- (if (not end)
- (throw 'eshell-incomplete ?\<)
- (if (eshell-arg-delimiter (1+ end))
- (prog1
- (list (if buffer-p 'get-buffer-create 'get-process)
- (buffer-substring-no-properties (point) end))
- (goto-char (1+ end)))
- (ignore (goto-char here))))))))
+ "Parse a special syntax reference, of the form `#<args>'.
+
+args := `type' `whitespace' `arbitrary-args' | `arbitrary-args'
+type := \"buffer\" or \"process\"
+arbitrary-args := any string of characters.
+
+If the form has no `type', the syntax is parsed as if `type' were
+\"buffer\"."
+ (when (and (not eshell-current-argument)
+ (not eshell-current-quoted)
+ (looking-at "#<\\(\\(buffer\\|process\\)\\s-\\)?"))
+ (let ((here (point)))
+ (goto-char (match-end 0)) ;; Go to the end of the match.
+ (let ((buffer-p (if (match-string 1)
+ (string= (match-string 2) "buffer")
+ t)) ;; buffer-p is non-nil by default.
+ (end (eshell-find-delimiter ?\< ?\>)))
+ (when (not end)
+ (throw 'eshell-incomplete ?\<))
+ (if (eshell-arg-delimiter (1+ end))
+ (prog1
+ (list (if buffer-p 'get-buffer-create 'get-process)
+ (buffer-substring-no-properties (point) end))
+ (goto-char (1+ end)))
+ (ignore (goto-char here)))))))
(defun eshell-parse-delimiter ()
"Parse an argument delimiter, which is essentially a command operator."
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index ef8a53f3c0b..535e169bcb3 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -1,6 +1,6 @@
-;;; esh-cmd.el --- command invocation
+;;; esh-cmd.el --- command invocation -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -165,13 +165,13 @@ In order to substitute an alternate command form for execution, the
hook function should throw it using the tag `eshell-replace-command'.
For example:
- (add-hook 'eshell-named-command-hook 'subst-with-cd)
+ (add-hook \\='eshell-named-command-hook \\='subst-with-cd)
(defun subst-with-cd (command args)
- (throw 'eshell-replace-command
+ (throw \\='eshell-replace-command
(eshell-parse-command \"cd\" args)))
Although useless, the above code will cause any non-glob, non-Lisp
-command (i.e., 'ls' as opposed to '*ls' or '(ls)') to be replaced by a
+command (i.e., `ls' as opposed to `*ls' or `(ls)') to be replaced by a
call to `cd' using the arguments that were passed to the function."
:type 'hook
:group 'eshell-cmd)
@@ -205,12 +205,16 @@ forms or strings)."
:type 'hook
:group 'eshell-cmd)
-(defcustom eshell-post-rewrite-command-hook nil
+(defvar eshell-post-rewrite-command-function #'identity
+ "Function run after command rewriting is finished.
+Takes the (rewritten) command, modifies it as it sees fit and returns
+the new result to use instead.")
+(defvar eshell-post-rewrite-command-hook nil
"A hook run after command rewriting is finished.
Each function is passed the symbol containing the rewritten command,
-which may be modified directly. Any return value is ignored."
- :type 'hook
- :group 'eshell-cmd)
+which may be modified directly. Any return value is ignored.")
+(make-obsolete-variable 'eshell-post-rewrite-command-hook
+ 'eshell-post-rewrite-command-function "24.4")
(defcustom eshell-complex-commands '("ls")
"A list of commands names or functions, that determine complexity.
@@ -239,7 +243,7 @@ return non-nil if the command is complex."
"If non-nil, enable Eshell debugging code.
This is slow, and only useful for debugging problems with Eshell.
If you change this without using customize after Eshell has loaded,
-you must re-load 'esh-cmd.el'."
+you must re-load `esh-cmd.el'."
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(set symbol value)
@@ -335,13 +339,15 @@ otherwise t.")
;; Command parsing
-(defun eshell-parse-command (command &optional args top-level)
+(defvar eshell--sep-terms)
+
+(defun eshell-parse-command (command &optional args toplevel)
"Parse the COMMAND, adding ARGS if given.
COMMAND can either be a string, or a cons cell demarcating a buffer
-region. TOP-LEVEL, if non-nil, means that the outermost command (the
+region. TOPLEVEL, if non-nil, means that the outermost command (the
user's input command) is being parsed, and that pre and post command
hooks should be run before and after the command."
- (let* (sep-terms
+ (let* (eshell--sep-terms
(terms
(append
(if (consp command)
@@ -361,35 +367,30 @@ hooks should be run before and after the command."
(function
(lambda (cmd)
(setq cmd
- (if (or (not (car sep-terms))
- (string= (car sep-terms) ";"))
- (eshell-parse-pipeline cmd (not (car sep-terms)))
+ (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 sep-terms (cdr sep-terms))
+ (setq eshell--sep-terms (cdr eshell--sep-terms))
(if eshell-in-pipeline-p
cmd
`(eshell-trap-errors ,cmd))))
- (eshell-separate-commands terms "[&;]" nil 'sep-terms))))
+ (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
(if (cdr cmd)
(setcar cmd `(eshell-commands ,(car cmd))))
(setq cmd (cdr cmd))))
- (setq commands
- `(progn
- ,@(if top-level
- '((run-hooks 'eshell-pre-command-hook)))
- ,@(if (not top-level)
- commands
- `((catch 'top-level (progn ,@commands))
- (run-hooks 'eshell-post-command-hook)))))
- (if top-level
- `(eshell-commands ,commands)
- commands)))
+ (if toplevel
+ `(eshell-commands (progn
+ (run-hooks 'eshell-pre-command-hook)
+ (catch 'top-level (progn ,@commands))
+ (run-hooks 'eshell-post-command-hook)))
+ (macroexp-progn commands))))
(defun eshell-debug-command (tag subform)
- "Output a debugging message to '*eshell last cmd*'."
+ "Output a debugging message to `*eshell last cmd*'."
(let ((buf (get-buffer-create "*eshell last cmd*"))
(text (eshell-stringify eshell-current-command)))
(with-current-buffer buf
@@ -423,14 +424,14 @@ hooks should be run before and after the command."
(setq terms (cdr terms))))
(defun eshell-rewrite-sexp-command (terms)
- "Rewrite a sexp in initial position, such as '(+ 1 2)'."
+ "Rewrite a sexp in initial position, such as `(+ 1 2)'."
;; this occurs when a Lisp expression is in first position
(if (and (listp (car terms))
(eq (caar terms) 'eshell-command-to-value))
(car (cdar terms))))
(defun eshell-rewrite-initial-subcommand (terms)
- "Rewrite a subcommand in initial position, such as '{+ 1 2}'."
+ "Rewrite a subcommand in initial position, such as `{+ 1 2}'."
(if (and (listp (car terms))
(eq (caar terms) 'eshell-as-subcommand))
(car terms)))
@@ -473,6 +474,8 @@ the second is ignored."
arg))
(defvar eshell-last-command-status) ;Define in esh-io.el.
+(defvar eshell--local-vars nil
+ "List of locally bound vars that should take precedence over env-vars.")
(defun eshell-rewrite-for-command (terms)
"Rewrite a `for' command into its equivalent Eshell command form.
@@ -495,7 +498,9 @@ implemented via rewriting, rather than as a function."
(eshell-command-body '(nil))
(eshell-test-body '(nil)))
(while (car for-items)
- (let ((,(intern (cadr terms)) (car for-items)))
+ (let ((,(intern (cadr terms)) (car for-items))
+ (eshell--local-vars (cons ',(intern (cadr terms))
+ eshell--local-vars)))
(eshell-protect
,(eshell-invokify-arg body t)))
(setcar for-items (cadr for-items))
@@ -505,14 +510,11 @@ implemented via rewriting, rather than as a function."
(list 'quote eshell-last-command-result))))))
(defun eshell-structure-basic-command (func names keyword test body
- &optional else vocal-test)
+ &optional else)
"With TERMS, KEYWORD, and two NAMES, structure a basic command.
The first of NAMES should be the positive form, and the second the
negative. It's not likely that users should ever need to call this
-function.
-
-If VOCAL-TEST is non-nil, it means output from the test should be
-shown, as well as output from the body."
+function."
;; If the test form begins with `eshell-convert', it means
;; something data-wise will be returned, and we should let
;; that determine the truth of the statement.
@@ -582,11 +584,13 @@ For an external command, it means an exit code of 0."
eshell-last-command-result
(= eshell-last-command-status 0)))
-(defun eshell-parse-pipeline (terms &optional final-p)
+(defvar eshell--cmd)
+
+(defun eshell-parse-pipeline (terms)
"Parse a pipeline from TERMS, return the appropriate Lisp forms."
- (let* (sep-terms
+ (let* (eshell--sep-terms
(bigpieces (eshell-separate-commands terms "\\(&&\\|||\\)"
- nil 'sep-terms))
+ nil 'eshell--sep-terms))
(bp bigpieces)
(results (list t))
final)
@@ -599,8 +603,11 @@ For an external command, it means an exit code of 0."
(run-hook-with-args 'eshell-pre-rewrite-command-hook cmd)
(setq cmd (run-hook-with-args-until-success
'eshell-rewrite-command-hook cmd))
- (run-hook-with-args 'eshell-post-rewrite-command-hook 'cmd)
- (setcar p cmd))
+ (let ((eshell--cmd cmd))
+ (run-hook-with-args 'eshell-post-rewrite-command-hook
+ 'eshell--cmd)
+ (setq cmd eshell--cmd))
+ (setcar p (funcall eshell-post-rewrite-command-function cmd)))
(setq p (cdr p)))
(nconc results
(list
@@ -615,20 +622,19 @@ For an external command, it means an exit code of 0."
results (nreverse results)
final (car results)
results (cdr results)
- sep-terms (nreverse sep-terms))
+ eshell--sep-terms (nreverse eshell--sep-terms))
(while results
- (cl-assert (car sep-terms))
+ (cl-assert (car eshell--sep-terms))
(setq final (eshell-structure-basic-command
- 'if (string= (car sep-terms) "&&") "if"
+ 'if (string= (car eshell--sep-terms) "&&") "if"
`(eshell-protect ,(car results))
- `(eshell-protect ,final)
- nil t)
+ `(eshell-protect ,final))
results (cdr results)
- sep-terms (cdr sep-terms)))
+ eshell--sep-terms (cdr eshell--sep-terms)))
final))
(defun eshell-parse-subcommand-argument ()
- "Parse a subcommand argument of the form '{command}'."
+ "Parse a subcommand argument of the form `{command}'."
(if (and (not eshell-current-argument)
(not eshell-current-quoted)
(eq (char-after) ?\{)
@@ -650,7 +656,7 @@ For an external command, it means an exit code of 0."
(looking-at eshell-lisp-regexp))
(let* ((here (point))
(obj
- (condition-case err
+ (condition-case nil
(read (current-buffer))
(end-of-file
(throw 'eshell-incomplete ?\()))))
@@ -912,7 +918,7 @@ at the moment are:
"Completion for the `debug' command."
(while (pcomplete-here '("errors" "commands"))))
-(defun eshell-invoke-directly (command input)
+(defun eshell-invoke-directly (command)
(let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
(if (and (eq (car base) 'eshell-trap-errors)
(eq (car (cadr base)) 'eshell-named-command))
@@ -1010,8 +1016,8 @@ be finished later after the completion of an asynchronous subprocess."
;; we can modify any `let' forms to evaluate only once.
(if (macrop (car form))
(let ((exp (eshell-copy-tree (macroexpand form))))
- (eshell-manipulate (format "expanding macro `%s'"
- (symbol-name (car form)))
+ (eshell-manipulate (format-message "expanding macro `%s'"
+ (symbol-name (car form)))
(setcar form (car exp))
(setcdr form (cdr exp)))))
(let ((args (cdr form)))
@@ -1089,8 +1095,8 @@ be finished later after the completion of an asynchronous subprocess."
(t
(if (and args (not (memq (car form) '(run-hooks))))
(eshell-manipulate
- (format "evaluating arguments to `%s'"
- (symbol-name (car form)))
+ (format-message "evaluating arguments to `%s'"
+ (symbol-name (car form)))
(while args
(setcar args (eshell-do-eval (car args) synchronous-p))
(setq args (cdr args)))))
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 474e536de2e..81ffaa713da 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -1,6 +1,6 @@
-;;; esh-ext.el --- commands external to Eshell
+;;; esh-ext.el --- commands external to Eshell -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -60,14 +60,15 @@ loaded into memory, thus beginning a new process."
:type '(repeat string)
:group 'eshell-ext)
-(defcustom eshell-force-execution nil
- "If non-nil, try to execute binary files regardless of permissions.
+(defcustom eshell-force-execution
+ (not (null (memq system-type '(windows-nt ms-dos))))
+ "If non-nil, try to execute files regardless of execute permissions.
This can be useful on systems like Windows, where the operating system
-doesn't happen to honor the permission bits in certain cases; or in
-cases where you want to associate an interpreter with a particular
-kind of script file, but the language won't let you but a '#!'
-interpreter line in the file, and you don't want to make it executable
-since nothing else but Eshell will be able to understand
+doesn't support the execution bit for shell scripts; or in cases where
+you want to associate an interpreter with a particular kind of script
+file, but the language won't let you but a `#!' interpreter line in
+the file, and you don't want to make it executable since nothing else
+but Eshell will be able to understand
`eshell-interpreter-alist'."
:type 'boolean
:group 'eshell-ext)
@@ -78,6 +79,8 @@ since nothing else but Eshell will be able to understand
name
(let ((list (eshell-parse-colon-path eshell-path-env))
suffixes n1 n2 file)
+ (if (eshell-under-windows-p)
+ (push "." list))
(while list
(setq n1 (concat (car list) name))
(setq suffixes eshell-binary-suffixes)
@@ -92,6 +95,10 @@ since nothing else but Eshell will be able to understand
(setq list (cdr list)))
file)))
+;; This file provides itself then eval-when-compile loads files that require it.
+;; This causes spurious "might not be defined at runtime" warnings.
+(declare-function eshell-search-path "esh-ext" (name))
+
(defcustom eshell-windows-shell-file
(if (eshell-under-windows-p)
(if (string-match "\\(cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
@@ -292,6 +299,11 @@ line of the form #!<interp>."
(let ((fullname (if (file-name-directory file) file
(eshell-search-path file)))
(suffixes eshell-binary-suffixes))
+ (if (and fullname
+ (not (file-remote-p fullname))
+ (file-remote-p default-directory))
+ (setq fullname (expand-file-name
+ (concat "./" fullname) default-directory)))
(if (and fullname (not (or eshell-force-execution
(file-executable-p fullname))))
(while suffixes
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 4edb47e4758..749c481da3e 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -1,6 +1,6 @@
-;;; esh-io.el --- I/O management
+;;; esh-io.el --- I/O management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -31,6 +31,18 @@
;; consistent with most shells. Therefore, only unique features are
;; mentioned here.
;;
+;;;_* Redirect to a Buffer or Process
+;;
+;; Buffers and processes can be named with '#<buffer buffer-name>' and
+;; '#<process process-name>', respectively. As a shorthand,
+;; '#<buffer-name>' without the explicit "buffer" arg is equivalent to
+;; '#<buffer buffer-name>'.
+;;
+;; echo hello > #<buffer *scratch*> # Overwrite '*scratch*' with 'hello'.
+;; echo hello > #<*scratch*> # Same as the command above.
+;;
+;; echo hello > #<process shell> # Pipe "hello" into the shell process.
+;;
;;;_* Insertion
;;
;; To insert at the location of point in a buffer, use '>>>':
@@ -98,19 +110,6 @@ other buffers) ."
:type 'integer
:group 'eshell-io)
-(defcustom eshell-buffer-shorthand nil
- "If non-nil, a symbol name can be used for a buffer in redirection.
-If nil, redirecting to a buffer requires buffer name syntax. If this
-variable is set, redirection directly to Lisp symbols will be
-impossible.
-
-Example:
-
- echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t
- echo hello > #<buffer *scratch*> ; always works"
- :type 'boolean
- :group 'eshell-io)
-
(defcustom eshell-print-queue-size 5
"The size of the print queue, for doing buffered printing.
This is basically a speed enhancement, to avoid blocking the Lisp code
@@ -126,7 +125,7 @@ from executing while Emacs is redisplaying."
'eshell-kill-append) t)
("/dev/clip" (lambda (mode)
(if (eq mode 'overwrite)
- (let ((x-select-enable-clipboard t))
+ (let ((gui-select-enable-clipboard t))
(kill-new "")))
'eshell-clipboard-append) t))
"Map virtual devices name to Emacs Lisp functions.
@@ -179,11 +178,11 @@ not be added to this variable."
(make-local-variable 'eshell-current-redirections)
(add-hook 'eshell-pre-rewrite-command-hook
'eshell-strip-redirections nil t)
- (add-hook 'eshell-post-rewrite-command-hook
- 'eshell-apply-redirections nil t))
+ (add-function :filter-return (local 'eshell-post-rewrite-command-function)
+ #'eshell--apply-redirections))
(defun eshell-parse-redirection ()
- "Parse an output redirection, such as '2>'."
+ "Parse an output redirection, such as `2>'."
(if (and (not eshell-current-quoted)
(looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
(if eshell-current-argument
@@ -223,28 +222,27 @@ not be added to this variable."
(setq eshell-current-redirections
(cdr eshell-current-redirections))))
-(defun eshell-apply-redirections (cmdsym)
+(defun eshell--apply-redirections (cmd)
"Apply any redirection which were specified for COMMAND."
(if eshell-current-redirections
- (set cmdsym
- (append (list 'progn)
- eshell-current-redirections
- (list (symbol-value cmdsym))))))
+ `(progn
+ ,@eshell-current-redirections
+ ,cmd)
+ cmd))
(defun eshell-create-handles
- (standard-output output-mode &optional standard-error error-mode)
+ (stdout output-mode &optional stderr error-mode)
"Create a new set of file handles for a command.
The default location for standard output and standard error will go to
-STANDARD-OUTPUT and STANDARD-ERROR, respectively.
+STDOUT and STDERR, respectively.
OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert';
a nil value of mode defaults to `insert'."
(let ((handles (make-vector eshell-number-of-handles nil))
- (output-target (eshell-get-target standard-output output-mode))
- (error-target (eshell-get-target standard-error error-mode)))
+ (output-target (eshell-get-target stdout output-mode))
+ (error-target (eshell-get-target stderr error-mode)))
(aset handles eshell-output-handle (cons output-target 1))
- (if standard-error
- (aset handles eshell-error-handle (cons error-target 1))
- (aset handles eshell-error-handle (cons output-target 1)))
+ (aset handles eshell-error-handle
+ (cons (if stderr error-target output-target) 1))
handles))
(defun eshell-protect-handles (handles)
@@ -327,7 +325,7 @@ last execution result should not be changed."
(defun eshell-clipboard-append (string)
"Call `kill-append' with STRING, if it is indeed a string."
(if (stringp string)
- (let ((x-select-enable-clipboard t))
+ (let ((gui-select-enable-clipboard t))
(kill-append string nil))))
(defun eshell-get-target (target &optional mode)
@@ -356,21 +354,14 @@ it defaults to `insert'."
(goto-char (point-max))))
(point-marker))))))
- ((or (bufferp target)
- (and (boundp 'eshell-buffer-shorthand)
- (symbol-value 'eshell-buffer-shorthand)
- (symbolp target)
- (not (memq target '(t nil)))))
- (let ((buf (if (bufferp target)
- target
- (get-buffer-create
- (symbol-name target)))))
- (with-current-buffer buf
- (cond ((eq mode 'overwrite)
- (erase-buffer))
- ((eq mode 'append)
- (goto-char (point-max))))
- (point-marker))))
+
+ ((bufferp target)
+ (with-current-buffer target
+ (cond ((eq mode 'overwrite)
+ (erase-buffer))
+ ((eq mode 'append)
+ (goto-char (point-max))))
+ (point-marker)))
((functionp target) nil)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index ed5fecf09ff..9cc9d34eafd 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -1,6 +1,6 @@
-;;; esh-mode.el --- user interface
+;;; esh-mode.el --- user interface -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -182,7 +182,7 @@ inserted. They return the string as it should be inserted."
:group 'eshell-mode)
(defcustom eshell-password-prompt-regexp
- "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'"
+ (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
@@ -206,7 +206,7 @@ This is used by `eshell-watch-for-password-prompt'."
;; Internal Variables:
-;; these are only set to `nil' initially for the sake of the
+;; 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)
@@ -220,74 +220,67 @@ This is used by `eshell-watch-for-password-prompt'."
(defvar eshell-last-output-end nil)
(defvar eshell-currently-handling-window nil)
-(defvar eshell-mode-syntax-table nil)
-(defvar eshell-mode-abbrev-table nil)
(define-abbrev-table 'eshell-mode-abbrev-table ())
-(if (not eshell-mode-syntax-table)
- (let ((i 0))
- (setq eshell-mode-syntax-table (make-syntax-table))
- (while (< i ?0)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?9))
- (while (< i ?A)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?Z))
- (while (< i ?a)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (setq i (1+ ?z))
- (while (< i 128)
- (modify-syntax-entry i "_ " eshell-mode-syntax-table)
- (setq i (1+ i)))
- (modify-syntax-entry ? " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\t " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\f " " eshell-mode-syntax-table)
- (modify-syntax-entry ?\n "> " eshell-mode-syntax-table)
- ;; Give CR the same syntax as newline, for selective-display.
- (modify-syntax-entry ?\^m "> " eshell-mode-syntax-table)
-;;; (modify-syntax-entry ?\; "< " eshell-mode-syntax-table)
- (modify-syntax-entry ?` "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?' "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?, "' " eshell-mode-syntax-table)
- ;; Used to be singlequote; changed for flonums.
- (modify-syntax-entry ?. "_ " eshell-mode-syntax-table)
- (modify-syntax-entry ?- "_ " eshell-mode-syntax-table)
- (modify-syntax-entry ?| ". " eshell-mode-syntax-table)
- (modify-syntax-entry ?# "' " eshell-mode-syntax-table)
- (modify-syntax-entry ?\" "\" " eshell-mode-syntax-table)
- (modify-syntax-entry ?\\ "/ " eshell-mode-syntax-table)
- (modify-syntax-entry ?\( "() " eshell-mode-syntax-table)
- (modify-syntax-entry ?\) ")( " eshell-mode-syntax-table)
- (modify-syntax-entry ?\{ "(} " eshell-mode-syntax-table)
- (modify-syntax-entry ?\} "){ " eshell-mode-syntax-table)
- (modify-syntax-entry ?\[ "(] " eshell-mode-syntax-table)
- (modify-syntax-entry ?\] ")[ " eshell-mode-syntax-table)
- ;; All non-word multibyte characters should be `symbol'.
- (if (featurep 'xemacs)
- (map-char-table
- (function
- (lambda (key val)
- (and (characterp key)
- (>= (char-int key) 256)
- (/= (char-syntax key) ?w)
- (modify-syntax-entry key "_ "
- eshell-mode-syntax-table))))
- (standard-syntax-table))
- (map-char-table
- (function
- (lambda (key val)
- (and (if (consp key)
- (and (>= (car key) 128)
- (/= (char-syntax (car key)) ?w))
- (and (>= key 256)
- (/= (char-syntax key) ?w)))
- (modify-syntax-entry key "_ "
- eshell-mode-syntax-table))))
- (standard-syntax-table)))))
+(defvar eshell-mode-syntax-table
+ (let ((st (make-syntax-table))
+ (i 0))
+ (while (< i ?0)
+ (modify-syntax-entry i "_ " st)
+ (setq i (1+ i)))
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "_ " st)
+ (setq i (1+ i)))
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "_ " st)
+ (setq i (1+ i)))
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "_ " st)
+ (setq i (1+ i)))
+ (modify-syntax-entry ? " " st)
+ (modify-syntax-entry ?\t " " st)
+ (modify-syntax-entry ?\f " " st)
+ (modify-syntax-entry ?\n "> " st)
+ ;; Give CR the same syntax as newline, for selective-display.
+ (modify-syntax-entry ?\^m "> " st)
+ ;; (modify-syntax-entry ?\; "< " st)
+ (modify-syntax-entry ?` "' " st)
+ (modify-syntax-entry ?' "' " st)
+ (modify-syntax-entry ?, "' " st)
+ ;; Used to be singlequote; changed for flonums.
+ (modify-syntax-entry ?. "_ " st)
+ (modify-syntax-entry ?- "_ " st)
+ (modify-syntax-entry ?| ". " st)
+ (modify-syntax-entry ?# "' " st)
+ (modify-syntax-entry ?\" "\" " st)
+ (modify-syntax-entry ?\\ "/ " st)
+ (modify-syntax-entry ?\( "() " st)
+ (modify-syntax-entry ?\) ")( " st)
+ (modify-syntax-entry ?\{ "(} " st)
+ (modify-syntax-entry ?\} "){ " st)
+ (modify-syntax-entry ?\[ "(] " st)
+ (modify-syntax-entry ?\] ")[ " st)
+ ;; All non-word multibyte characters should be `symbol'.
+ (map-char-table
+ (if (featurep 'xemacs)
+ (lambda (key _val)
+ (and (characterp key)
+ (>= (char-int key) 256)
+ (/= (char-syntax key) ?w)
+ (modify-syntax-entry key "_ " st)))
+ (lambda (key _val)
+ (and (if (consp key)
+ (and (>= (car key) 128)
+ (/= (char-syntax (car key)) ?w))
+ (and (>= key 256)
+ (/= (char-syntax key) ?w)))
+ (modify-syntax-entry key "_ " st))))
+ (standard-syntax-table))
+ st))
;;; User Functions:
@@ -303,25 +296,18 @@ and the hook `eshell-exit-hook'."
(run-hooks 'eshell-exit-hook))
;;;###autoload
-(defun eshell-mode ()
- "Emacs shell interactive mode.
-
-\\{eshell-mode-map}"
- (kill-all-local-variables)
+(define-derived-mode eshell-mode fundamental-mode "EShell"
+ "Emacs shell interactive mode."
+ (setq-local eshell-mode t)
- (setq major-mode 'eshell-mode)
- (setq mode-name "EShell")
- (set (make-local-variable 'eshell-mode) t)
-
- (make-local-variable 'eshell-mode-map)
- (setq eshell-mode-map (make-sparse-keymap))
+ ;; 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)))
- (make-local-variable 'mode-line-format)
- (setq mode-line-format fmt))
+ (setq-local mode-line-format fmt))
(let ((mode-line-elt (memq 'mode-line-modified mode-line-format)))
(if mode-line-elt
(setcar mode-line-elt 'eshell-command-running-string))))
@@ -331,11 +317,9 @@ and the hook `eshell-exit-hook'."
(define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output)
(define-key eshell-mode-map [(control ?a)] 'eshell-bol)
- (set (make-local-variable 'eshell-command-prefix)
- (make-symbol "eshell-command-prefix"))
+ (setq-local eshell-command-prefix (make-symbol "eshell-command-prefix"))
(fset eshell-command-prefix (make-sparse-keymap))
- (set (make-local-variable 'eshell-command-map)
- (symbol-function eshell-command-prefix))
+ (setq-local eshell-command-map (symbol-function eshell-command-prefix))
(define-key eshell-mode-map [(control ?c)] eshell-command-prefix)
;; without this, find-tag complains about read-only text being
@@ -359,9 +343,7 @@ and the hook `eshell-exit-hook'."
(define-key eshell-command-map [(control ?y)] 'eshell-repeat-argument)
(setq local-abbrev-table eshell-mode-abbrev-table)
- (set-syntax-table eshell-mode-syntax-table)
- (set (make-local-variable 'dired-directory) default-directory)
(set (make-local-variable 'list-buffers-directory)
(expand-file-name default-directory))
@@ -442,7 +424,6 @@ and the hook `eshell-exit-hook'."
(if eshell-first-time-p
(run-hooks 'eshell-first-time-mode-hook))
- (run-mode-hooks 'eshell-mode-hook)
(run-hooks 'eshell-post-command-hook))
(put 'eshell-mode 'mode-class 'special)
@@ -470,8 +451,8 @@ and the hook `eshell-exit-hook'."
(add-hook 'pre-command-hook 'eshell-intercept-commands t t)
(message "Sending subprocess input directly")))
-(defun eshell-self-insert-command (N)
- (interactive "i")
+(defun eshell-self-insert-command ()
+ (interactive)
(process-send-string
(eshell-interactive-process)
(char-to-string (if (symbolp last-command-event)
@@ -500,7 +481,7 @@ and the hook `eshell-exit-hook'."
(declare-function find-tag-interactive "etags" (prompt &optional no-default))
(defun eshell-find-tag (&optional tagname next-p regexp-p)
- "A special version of `find-tag' that ignores read-onlyness."
+ "A special version of `find-tag' that ignores whether the text is read-only."
(interactive)
(require 'etags)
(let ((inhibit-read-only t)
@@ -646,10 +627,11 @@ newline."
(let ((proc-running-p (and (eshell-interactive-process)
(not queue-p)))
(inhibit-point-motion-hooks t)
- after-change-functions)
+ (inhibit-modification-hooks t))
(unless (and proc-running-p
(not (eq (process-status
- (eshell-interactive-process)) 'run)))
+ (eshell-interactive-process))
+ 'run)))
(if (or proc-running-p
(>= (point) eshell-last-output-end))
(goto-char (point-max))
@@ -689,7 +671,7 @@ newline."
(run-hooks 'eshell-input-filter-functions)
(and (catch 'eshell-terminal
(ignore
- (if (eshell-invoke-directly cmd input)
+ (if (eshell-invoke-directly cmd)
(eval cmd)
(eshell-eval-command cmd input))))
(eshell-life-is-too-much)))))
@@ -716,7 +698,7 @@ This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
(current-buffer)))
(inhibit-point-motion-hooks t)
- after-change-functions)
+ (inhibit-modification-hooks t))
(let ((functions eshell-preoutput-filter-functions))
(while (and functions string)
(setq string (funcall (car functions) string))
@@ -889,6 +871,20 @@ When run interactively, widen the buffer first."
(goto-char (point-max))
(recenter -1))
+(defun eshell/clear (&optional scrollback)
+ "Scroll contents of eshell window out of sight, leaving a blank window.
+If SCROLLBACK is non-nil, clear the scrollback contents."
+ (interactive)
+ (if scrollback
+ (eshell/clear-scrollback)
+ (insert (make-string (window-size) ?\n))
+ (eshell-send-input)))
+
+(defun eshell/clear-scrollback ()
+ "Clear the scrollback content of the eshell window."
+ (let ((inhibit-read-only t))
+ (erase-buffer)))
+
(defun eshell-get-old-input (&optional use-current-region)
"Return the command input on the current line."
(if use-current-region
@@ -944,10 +940,10 @@ a key."
(custom-add-option 'eshell-output-filter-functions
'eshell-truncate-buffer)
-(defun eshell-send-invisible (str)
+(defun eshell-send-invisible ()
"Read a string without echoing.
Then send it to the process running in the current buffer."
- (interactive "P") ; Defeat snooping via C-x ESC ESC
+ (interactive) ; Don't pass str as argument, to avoid snooping via C-x ESC ESC
(let ((str (read-passwd
(format "%s Password: "
(process-name (eshell-interactive-process))))))
@@ -965,11 +961,12 @@ buffer's process if STRING contains a password prompt defined by
This function could be in the list `eshell-output-filter-functions'."
(when (eshell-interactive-process)
(save-excursion
- (goto-char eshell-last-output-block-begin)
- (beginning-of-line)
- (if (re-search-forward eshell-password-prompt-regexp
- eshell-last-output-end t)
- (eshell-send-invisible nil)))))
+ (let ((case-fold-search t))
+ (goto-char eshell-last-output-block-begin)
+ (beginning-of-line)
+ (if (re-search-forward eshell-password-prompt-regexp
+ eshell-last-output-end t)
+ (eshell-send-invisible))))))
(custom-add-option 'eshell-output-filter-functions
'eshell-watch-for-password-prompt)
@@ -977,32 +974,30 @@ This function could be in the list `eshell-output-filter-functions'."
(defun eshell-handle-control-codes ()
"Act properly when certain control codes are seen."
(save-excursion
- (let ((orig (point)))
- (goto-char eshell-last-output-block-begin)
- (unless (eolp)
- (beginning-of-line))
- (while (< (point) eshell-last-output-end)
- (let ((char (char-after)))
- (cond
- ((eq char ?\r)
- (if (< (1+ (point)) eshell-last-output-end)
- (if (memq (char-after (1+ (point)))
- '(?\n ?\r))
- (delete-char 1)
- (let ((end (1+ (point))))
- (beginning-of-line)
- (delete-region (point) end)))
- (add-text-properties (point) (1+ (point))
- '(invisible t))
- (forward-char)))
- ((eq char ?\a)
- (delete-char 1)
- (beep))
- ((eq char ?\C-h)
- (delete-backward-char 1)
- (delete-char 1))
- (t
- (forward-char))))))))
+ (goto-char eshell-last-output-block-begin)
+ (unless (eolp)
+ (beginning-of-line))
+ (while (< (point) eshell-last-output-end)
+ (let ((char (char-after)))
+ (cond
+ ((eq char ?\r)
+ (if (< (1+ (point)) eshell-last-output-end)
+ (if (memq (char-after (1+ (point)))
+ '(?\n ?\r))
+ (delete-char 1)
+ (let ((end (1+ (point))))
+ (beginning-of-line)
+ (delete-region (point) end)))
+ (add-text-properties (point) (1+ (point))
+ '(invisible t))
+ (forward-char)))
+ ((eq char ?\a)
+ (delete-char 1)
+ (beep))
+ ((eq char ?\C-h)
+ (delete-region (1- (point)) (1+ (point))))
+ (t
+ (forward-char)))))))
(custom-add-option 'eshell-output-filter-functions
'eshell-handle-control-codes)
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index 5008ef705db..47b23aeb27f 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -1,6 +1,6 @@
-;;; esh-module.el --- Eshell modules
+;;; esh-module.el --- Eshell modules -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index 33625433022..96d485beca1 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -1,6 +1,6 @@
-;;; esh-opt.el --- command options processing
+;;; esh-opt.el --- command options processing -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -28,11 +28,11 @@
(require 'esh-ext)
;; Unused.
-;;; (defgroup eshell-opt nil
-;;; "The options processing code handles command argument parsing for
-;;; Eshell commands implemented in Lisp."
-;;; :tag "Command options processing"
-;;; :group 'eshell)
+;; (defgroup eshell-opt nil
+;; "The options processing code handles command argument parsing for
+;; Eshell commands implemented in Lisp."
+;; :tag "Command options processing"
+;; :group 'eshell)
;;; User Functions:
@@ -82,7 +82,7 @@ and `eshell-stringify-list'.
For example, OPTIONS might look like:
- '((?C nil nil multi-column \"multi-column display\")
+ ((?C nil nil multi-column \"multi-column display\")
(nil \"help\" nil nil \"show this usage display\")
(?r \"reverse\" nil reverse-list \"reverse order while sorting\")
:external \"ls\"
@@ -98,50 +98,44 @@ the new process for its value.
Lastly, any remaining arguments will be available in a locally
interned variable `args' (created using a `let' form)."
(declare (debug (form form sexp body)))
- `(let ((temp-args
- ,(if (memq ':preserve-args (cadr options))
- macro-args
- (list 'eshell-stringify-list
- (list 'eshell-flatten-list macro-args)))))
- (let ,(append (delq nil (mapcar (lambda (opt)
- (and (listp opt) (nth 3 opt)))
- (cadr options)))
- '(usage-msg last-value ext-command args))
- ;; FIXME: `options' ends up hiding some variable names under `quote',
- ;; which is incompatible with lexical scoping!!
- (eshell-do-opt ,name ,options (lambda () ,@body-forms)))))
+ `(let* ((temp-args
+ ,(if (memq ':preserve-args (cadr options))
+ macro-args
+ (list 'eshell-stringify-list
+ (list 'eshell-flatten-list macro-args))))
+ (processed-args (eshell--do-opts ,name ,options temp-args))
+ ,@(delete-dups
+ (delq nil (mapcar (lambda (opt)
+ (and (listp opt) (nth 3 opt)
+ `(,(nth 3 opt) (pop processed-args))))
+ ;; `options' is of the form (quote OPTS).
+ (cadr options))))
+ (args processed-args))
+ ,@body-forms))
;;; Internal Functions:
-(defvar temp-args)
-(defvar last-value)
-(defvar usage-msg)
-(defvar ext-command)
;; Documented part of the interface; see eshell-eval-using-options.
-(defvar args)
+(defvar eshell--args)
-(defun eshell-do-opt (name options body-fun)
+(defun eshell--do-opts (name options args)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
- (setq args temp-args)
- (if (setq
- ext-command
- (catch 'eshell-ext-command
- (when (setq
- usage-msg
- (catch 'eshell-usage
- (setq last-value nil)
- (if (and (= (length args) 0)
- (memq ':show-usage options))
- (throw 'eshell-usage
- (eshell-show-usage name options)))
- (setq args (eshell-process-args name args options)
- last-value (funcall body-fun))
- nil))
- (error "%s" usage-msg))))
- (throw 'eshell-external
- (eshell-external-command ext-command args))
- last-value))
+ (let ((ext-command
+ (catch 'eshell-ext-command
+ (let ((usage-msg
+ (catch 'eshell-usage
+ (if (and (= (length args) 0)
+ (memq ':show-usage options))
+ (eshell-show-usage name options)
+ (setq args (eshell--process-args name args options))
+ nil))))
+ (when usage-msg
+ (error "%s" usage-msg))))))
+ (if ext-command
+ (throw 'eshell-external
+ (eshell-external-command ext-command args))
+ args)))
(defun eshell-show-usage (name options)
"Display the usage message for NAME, using OPTIONS."
@@ -184,28 +178,30 @@ This code doesn't really need to be macro expanded everywhere."
(if extcmd
(setq usage
(concat usage
- (format "
+ (format-message "
This command is implemented in Lisp. If an unrecognized option is
-passed to this command, the external version '%s'
+passed to this command, the external version `%s'
will be called instead." extcmd)))))
(throw 'eshell-usage usage)))
-(defun eshell-set-option (name ai opt options)
+(defun eshell--set-option (name ai opt options opt-vals)
"Using NAME's remaining args (index AI), set the OPT within OPTIONS.
If the option consumes an argument for its value, the argument list
will be modified."
(if (not (nth 3 opt))
(eshell-show-usage name options)
- (if (eq (nth 2 opt) t)
- (if (> ai (length args))
- (error "%s: missing option argument" name)
- (set (nth 3 opt) (nth ai args))
- (if (> ai 0)
- (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))
- (setq args (cdr args))))
- (set (nth 3 opt) (or (nth 2 opt) t)))))
-
-(defun eshell-process-option (name switch kind ai options)
+ (setcdr (assq (nth 3 opt) opt-vals)
+ (if (eq (nth 2 opt) t)
+ (if (> ai (length eshell--args))
+ (error "%s: missing option argument" name)
+ (prog1 (nth ai eshell--args)
+ (if (> ai 0)
+ (setcdr (nthcdr (1- ai) eshell--args)
+ (nthcdr (1+ ai) eshell--args))
+ (setq eshell--args (cdr eshell--args)))))
+ (or (nth 2 opt) t)))))
+
+(defun eshell--process-option (name switch kind ai options opt-vals)
"For NAME, process SWITCH (of type KIND), from args at index AI.
The SWITCH will be looked up in the set of OPTIONS.
@@ -223,7 +219,7 @@ switch is unrecognized."
(nth kind (car opts))
(equal switch (nth kind (car opts))))
(progn
- (eshell-set-option name ai (car opts) options)
+ (eshell--set-option name ai (car opts) options opt-vals)
(setq found t opts nil))
(setq opts (cdr opts))))
(unless found
@@ -232,14 +228,22 @@ switch is unrecognized."
(setq extcmd (eshell-search-path (cadr extcmd)))
(if extcmd
(throw 'eshell-ext-command extcmd)
- (if (characterp switch)
- (error "%s: unrecognized option -%c" name switch)
- (error "%s: unrecognized option --%s" name switch))))))))
-
-(defun eshell-process-args (name args options)
- "Process the given ARGS using OPTIONS.
-This assumes that symbols have been intern'd by `eshell-eval-using-options'."
- (let ((ai 0) arg)
+ (error (if (characterp switch) "%s: unrecognized option -%c"
+ "%s: unrecognized option --%s")
+ name switch)))))))
+
+(defun eshell--process-args (name args options)
+ "Process the given ARGS using OPTIONS."
+ (let* ((seen ())
+ (opt-vals (delq nil (mapcar (lambda (opt)
+ (when (listp opt)
+ (let ((sym (nth 3 opt)))
+ (when (and sym (not (memq sym seen)))
+ (push sym seen)
+ (list sym)))))
+ options)))
+ (ai 0) arg
+ (eshell--args args))
(while (< ai (length args))
(setq arg (nth ai args))
(if (not (and (stringp arg)
@@ -252,13 +256,14 @@ This assumes that symbols have been intern'd by `eshell-eval-using-options'."
(setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
(if dash
(if (> (length switch) 0)
- (eshell-process-option name switch 1 ai options)
+ (eshell--process-option name switch 1 ai options opt-vals)
(setq ai (length args)))
(let ((len (length switch))
(index 0))
(while (< index len)
- (eshell-process-option name (aref switch index) 0 ai options)
- (setq index (1+ index)))))))))
- args)
+ (eshell--process-option name (aref switch index)
+ 0 ai options opt-vals)
+ (setq index (1+ index))))))))
+ (nconc (mapcar #'cdr opt-vals) args)))
;;; esh-opt.el ends here
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 171d70c0772..867d3b9145d 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -1,6 +1,6 @@
-;;; esh-proc.el --- process management
+;;; esh-proc.el --- process management -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -116,9 +116,11 @@ information, for example."
(defun eshell-kill-process-function (proc status)
"Function run when killing a process.
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
-PROC and STATUS to both."
- (or (memq 'eshell-reset-after-proc eshell-kill-hook)
- (eshell-reset-after-proc proc status))
+PROC and STATUS to functions on the latter."
+ ;; Was there till 24.1, but it is not optional.
+ (if (memq 'eshell-reset-after-proc eshell-kill-hook)
+ (setq eshell-kill-hook (delq 'eshell-reset-after-proc eshell-kill-hook)))
+ (eshell-reset-after-proc status)
(run-hook-with-args 'eshell-kill-hook proc status))
(defun eshell-proc-initialize ()
@@ -133,7 +135,7 @@ PROC and STATUS to both."
; (define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
(define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
-(defun eshell-reset-after-proc (proc status)
+(defun eshell-reset-after-proc (status)
"Reset the command input location after a process terminates.
The signals which will cause this to happen are matched by
`eshell-reset-signals'."
@@ -407,7 +409,8 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC."
(or all
(not (nth 2 entry)))
(or (not query)
- (y-or-n-p (format query (process-name (car entry))))))
+ (y-or-n-p (format-message query
+ (process-name (car entry))))))
(setq result (funcall func (car entry))))
(unless (memq (process-status (car entry))
'(run stop open closed))
@@ -478,11 +481,11 @@ See the variable `eshell-kill-processes-on-exit'."
(save-window-excursion
(list-processes)
(if (or (not (eq eshell-kill-processes-on-exit 'ask))
- (y-or-n-p (format "Kill processes owned by `%s'? "
- (buffer-name))))
+ (y-or-n-p (format-message "Kill processes owned by `%s'? "
+ (buffer-name))))
(eshell-round-robin-kill
(if (eq eshell-kill-processes-on-exit 'every)
- "Kill Eshell child process `%s'? ")))
+ (format-message "Kill Eshell child process `%s'? "))))
(let ((buf (get-buffer "*Process List*")))
(if (and buf (buffer-live-p buf))
(kill-buffer buf)))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index dd344eb50a2..f645702ac2b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -1,6 +1,6 @@
-;;; esh-util.el --- general utilities
+;;; esh-util.el --- general utilities -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -23,6 +23,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup eshell-util nil
"This is general utility code, meant for use by Eshell itself."
:tag "General utilities"
@@ -31,7 +33,7 @@
;;; User Variables:
(defcustom eshell-stringify-t t
- "If non-nil, the string representation of t is 't'.
+ "If non-nil, the string representation of t is \"t\".
If nil, t will be represented only in the exit code of the function,
and not printed as a string. This causes Lisp functions to behave
similarly to external commands, as far as successful result output."
@@ -86,7 +88,7 @@ specification of filenames (for example, in calling `find-file', or
some other Lisp function that deals with files, not numbers), add the
following in your init file:
- (put 'find-file 'eshell-no-numeric-conversions t)
+ (put \\='find-file \\='eshell-no-numeric-conversions t)
Any function with the property `eshell-no-numeric-conversions' set to
a non-nil value, will be passed strings, not numbers, even when an
@@ -142,7 +144,7 @@ function `string-to-number'."
Otherwise, evaluates FORM with no error handling."
(declare (indent 2))
(if eshell-handle-errors
- `(condition-case ,tag
+ `(condition-case-unless-debug ,tag
,form
,@handlers)
form))
@@ -215,8 +217,7 @@ then quoting is done by a backslash, rather than a doubled delimiter."
(defun eshell-sublist (l &optional n m)
"Return from LIST the N to M elements.
If N or M is nil, it means the end of the list."
- (let* ((a (copy-sequence l))
- result)
+ (let ((a (copy-sequence l)))
(if (and m (consp (nthcdr m a)))
(setcdr (nthcdr m a) nil))
(if n
@@ -227,7 +228,7 @@ If N or M is nil, it means the end of the list."
(defvar eshell-path-env (getenv "PATH")
"Content of $PATH.
-It might be different from \(getenv \"PATH\"\), when
+It might be different from \(getenv \"PATH\"), when
`default-directory' points to a remote host.")
(make-variable-buffer-local 'eshell-path-env)
@@ -476,20 +477,20 @@ list."
(defalias 'eshell-user-name 'user-login-name)
(defun eshell-read-hosts-file (filename)
- "Read in the hosts from the /etc/hosts file."
+ "Read in the hosts from FILENAME, default `eshell-hosts-file'."
(let (hosts)
(with-temp-buffer
- (insert-file-contents eshell-hosts-file)
+ (insert-file-contents (or filename eshell-hosts-file))
(goto-char (point-min))
(while (re-search-forward
"^\\([^#[:space:]]+\\)\\s-+\\(\\S-+\\)\\(\\s-*\\(\\S-+\\)\\)?" nil t)
(if (match-string 1)
- (add-to-list 'hosts (match-string 1)))
+ (cl-pushnew (match-string 1) hosts :test #'equal))
(if (match-string 2)
- (add-to-list 'hosts (match-string 2)))
+ (cl-pushnew (match-string 2) hosts :test #'equal))
(if (match-string 4)
- (add-to-list 'hosts (match-string 4)))))
- (sort hosts 'string-lessp)))
+ (cl-pushnew (match-string 4) hosts :test #'equal))))
+ (sort hosts #'string-lessp)))
(defun eshell-read-hosts (file result-var timestamp-var)
"Read the contents of /etc/passwd for user names."
@@ -538,20 +539,17 @@ Unless optional argument INPLACE is non-nil, return a new string."
(defmacro eshell-with-file-modes (modes &rest forms)
"Evaluate, with file-modes set to MODES, the given FORMS."
- `(let ((modes (default-file-modes)))
- (set-default-file-modes ,modes)
- (unwind-protect
- (progn ,@forms)
- (set-default-file-modes modes))))
+ (declare (obsolete with-file-modes "25.1"))
+ `(with-file-modes ,modes ,@forms))
(defmacro eshell-with-private-file-modes (&rest forms)
"Evaluate FORMS with private file modes set."
- `(eshell-with-file-modes ,eshell-private-file-modes ,@forms))
+ `(with-file-modes ,eshell-private-file-modes ,@forms))
(defsubst eshell-make-private-directory (dir &optional parents)
"Make DIR with file-modes set to `eshell-private-directory-modes'."
- (eshell-with-file-modes eshell-private-directory-modes
- (make-directory dir parents)))
+ (with-file-modes eshell-private-directory-modes
+ (make-directory dir parents)))
(defsubst eshell-substring (string sublen)
"Return the beginning of STRING, up to SUBLEN bytes."
@@ -560,9 +558,13 @@ Unless optional argument INPLACE is non-nil, return a new string."
(substring string 0 sublen)
string)))
+(defvar ange-cache)
+
+;; Partial reimplementation of Emacs's builtin directory-files-and-attributes.
+;; id-format not implemented.
(and (featurep 'xemacs)
(not (fboundp 'directory-files-and-attributes))
- (defun directory-files-and-attributes (directory &optional full match nosort id-format)
+ (defun directory-files-and-attributes (directory &optional full match nosort _id-format)
"Return a list of names of files and their attributes in DIRECTORY.
There are three optional arguments:
If FULL is non-nil, return absolute file names. Otherwise return names
@@ -577,8 +579,6 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(cons file (eshell-file-attributes (expand-file-name file directory)))))
(directory-files directory full match nosort)))))
-(defvar ange-cache)
-
(defun eshell-directory-files-and-attributes (dir &optional full match nosort id-format)
"Make sure to use the handler for `directory-file-and-attributes'."
(let* ((dir (expand-file-name dir)))
@@ -653,7 +653,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(match-string 6))))
(if (nth 0 moment)
(setcar (nthcdr 5 moment)
- (nth 5 (decode-time (current-time))))
+ (nth 5 (decode-time)))
(setcar (nthcdr 0 moment) 0)
(setcar (nthcdr 1 moment) 0)
(setcar (nthcdr 2 moment) 0))
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 188b8165248..0d94186cb9a 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -1,6 +1,6 @@
-;;; esh-var.el --- handling of variables
+;;; esh-var.el --- handling of variables -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
@@ -116,7 +116,7 @@
(require 'ring)
(defgroup eshell-var nil
- "Variable interpolation is introduced whenever the '$' character
+ "Variable interpolation is introduced whenever the `$' character
appears unquoted in any argument (except when that argument is
surrounded by single quotes). It may be used to interpolate a
variable value, a subcommand, or even the result of a Lisp form."
@@ -148,7 +148,7 @@ variable value, a subcommand, or even the result of a Lisp form."
(defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+"
"A regexp identifying what constitutes a variable name reference.
-Note that this only applies for '$NAME'. If the syntax '$<NAME>' is
+Note that this only applies for `$NAME'. If the syntax `$<NAME>' is
used, then NAME can contain any character, including angle brackets,
if they are quoted with a backslash."
:type 'regexp
@@ -184,14 +184,14 @@ if they are quoted with a backslash."
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 defines the name of a
-command, and the Lisp value to return for that variable if it is
-accessed via the syntax '$NAME'.
+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
+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."
@@ -231,7 +231,7 @@ function), and the arguments passed to this function would be the list
'eshell-complete-variable-assignment nil t)))
(defun eshell-handle-local-variables ()
- "Allow for the syntax 'VAR=val <command> <args>'."
+ "Allow for the syntax `VAR=val <command> <args>'."
;; strip off any null commands, which can only happen if a variable
;; evaluates to nil, such as "$var x", where `var' is nil. The
;; command name in that case becomes `x', for compatibility with
@@ -395,12 +395,9 @@ process any indices that come after the variable reference."
indices (and (not (eobp))
(eq (char-after) ?\[)
(eshell-parse-indices))
- value (list 'let
- (list (list 'indices
- (list 'quote indices)))
- value))
+ value `(let ((indices ',indices)) ,value))
(if get-len
- (list 'length value)
+ `(length ,value)
value)))
(defun eshell-parse-variable-ref ()
@@ -414,67 +411,68 @@ Possible options are:
<LONG-NAME> disambiguates the length of the name
{COMMAND} result of command is variable's value
(LISP-FORM) result of Lisp form is variable's value"
- (let (end)
- (cond
- ((eq (char-after) ?{)
- (let ((end (eshell-find-delimiter ?\{ ?\})))
- (if (not end)
- (throw 'eshell-incomplete ?\{)
- (prog1
- (list 'eshell-convert
- (list 'eshell-command-to-value
- (list 'eshell-as-subcommand
- (eshell-parse-command
- (cons (1+ (point)) end)))))
- (goto-char (1+ end))))))
- ((memq (char-after) '(?\' ?\"))
- (let ((name (if (eq (char-after) ?\')
- (eshell-parse-literal-quote)
- (eshell-parse-double-quote))))
- (if name
+ (cond
+ ((eq (char-after) ?{)
+ (let ((end (eshell-find-delimiter ?\{ ?\})))
+ (if (not end)
+ (throw 'eshell-incomplete ?\{)
+ (prog1
+ (list 'eshell-convert
+ (list 'eshell-command-to-value
+ (list 'eshell-as-subcommand
+ (eshell-parse-command
+ (cons (1+ (point)) end)))))
+ (goto-char (1+ end))))))
+ ((memq (char-after) '(?\' ?\"))
+ (let ((name (if (eq (char-after) ?\')
+ (eshell-parse-literal-quote)
+ (eshell-parse-double-quote))))
+ (if name
(list 'eshell-get-variable (eval name) 'indices))))
- ((eq (char-after) ?\<)
- (let ((end (eshell-find-delimiter ?\< ?\>)))
- (if (not end)
- (throw 'eshell-incomplete ?\<)
- (let* ((temp (make-temp-file temporary-file-directory))
- (cmd (concat (buffer-substring (1+ (point)) end)
- " > " temp)))
- (prog1
- (list
- 'let (list (list 'eshell-current-handles
- (list 'eshell-create-handles temp
- (list 'quote 'overwrite))))
- (list
- 'progn
- (list 'eshell-as-subcommand
- (eshell-parse-command cmd))
- (list 'ignore
- (list 'nconc 'eshell-this-command-hook
- (list 'list
- (list 'function
- (list 'lambda nil
- (list 'delete-file temp))))))
- (list 'quote temp)))
- (goto-char (1+ end)))))))
- ((eq (char-after) ?\()
- (condition-case err
- (list 'eshell-command-to-value
- (list 'eshell-lisp-command
- (list 'quote (read (current-buffer)))))
- (end-of-file
- (throw 'eshell-incomplete ?\())))
- ((assoc (char-to-string (char-after))
- eshell-variable-aliases-list)
- (forward-char)
- (list 'eshell-get-variable
- (char-to-string (char-before)) 'indices))
- ((looking-at eshell-variable-name-regexp)
- (prog1
- (list 'eshell-get-variable (match-string 0) 'indices)
- (goto-char (match-end 0))))
- (t
- (error "Invalid variable reference")))))
+ ((eq (char-after) ?\<)
+ (let ((end (eshell-find-delimiter ?\< ?\>)))
+ (if (not end)
+ (throw 'eshell-incomplete ?\<)
+ (let* ((temp (make-temp-file temporary-file-directory))
+ (cmd (concat (buffer-substring (1+ (point)) end)
+ " > " temp)))
+ (prog1
+ (list
+ 'let (list (list 'eshell-current-handles
+ (list 'eshell-create-handles temp
+ (list 'quote 'overwrite))))
+ (list
+ 'progn
+ (list 'eshell-as-subcommand
+ (eshell-parse-command cmd))
+ (list 'ignore
+ (list 'nconc 'eshell-this-command-hook
+ (list 'list
+ (list 'function
+ (list 'lambda nil
+ (list 'delete-file temp))))))
+ (list 'quote temp)))
+ (goto-char (1+ end)))))))
+ ((eq (char-after) ?\()
+ (condition-case nil
+ (list 'eshell-command-to-value
+ (list 'eshell-lisp-command
+ (list 'quote (read (current-buffer)))))
+ (end-of-file
+ (throw 'eshell-incomplete ?\())))
+ ((assoc (char-to-string (char-after))
+ eshell-variable-aliases-list)
+ (forward-char)
+ (list 'eshell-get-variable
+ (char-to-string (char-before)) 'indices))
+ ((looking-at eshell-variable-name-regexp)
+ (prog1
+ (list 'eshell-get-variable (match-string 0) 'indices)
+ (goto-char (match-end 0))))
+ (t
+ (error "Invalid variable reference"))))
+
+(defvar eshell-glob-function)
(defun eshell-parse-indices ()
"Parse and return a list of list of indices."
@@ -504,6 +502,7 @@ Possible options are:
(let ((sym (intern-soft var)))
(if (and sym (boundp sym)
(or eshell-prefer-lisp-variables
+ (memq sym eshell--local-vars) ; bug#15372
(not (getenv var))))
(symbol-value sym)
(getenv var))))
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 9bdf8b3eb68..553955155ef 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -1,6 +1,6 @@
-;;; eshell.el --- the Emacs command shell
+;;; eshell.el --- the Emacs command shell -*- lexical-binding:t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Version: 2.4.2
@@ -170,56 +170,7 @@
;; @ 4nt
;; @ csh
-;;;_* Speeding up load time
-;;
-;; If you find that Eshell loads too slowly, there is something you
-;; can do to speed it up.
-;;
-;; Create a file, named /tmp/elc, containing this filelist:
-;;
-;; esh-util.elc
-;; eshell.elc
-;; esh-module.elc
-;; esh-var.elc
-;; esh-proc.elc
-;; esh-arg.elc
-;; esh-io.elc
-;; esh-ext.elc
-;; esh-cmd.elc
-;; esh-mode.elc
-;; esh-opt.elc
-;; em-alias.elc
-;; em-banner.elc
-;; em-basic.elc
-;; em-cmpl.elc
-;; em-dirs.elc
-;; em-pred.elc
-;; em-glob.elc
-;; em-hist.elc
-;; em-ls.elc
-;; em-prompt.elc
-;; em-rebind.elc
-;; em-script.elc
-;; em-smart.elc
-;; em-term.elc
-;; em-unix.elc
-;; em-xtra.elc
-;;
-;; The order is very important. Remove from the filelist any features
-;; you don't use. These all begin with "em-". If you don't use
-;; Eshell's key rebinding module, you can remove "em-rebind.elc" from
-;; the filelist. The modules you are currently using are listed in
-;; `eshell-modules-list'.
-;;
-;; Now, concatenating all of the above mentioned .elc files, in that
-;; order, to another file. Here is how to do this on UNIX:
-;;
-;; cat `cat /tmp/elc` > tmp.elc ; mv tmp.elc eshell.elc
-;;
-;; Now your eshell.elc file contains all of the .elc files that make
-;; up Eshell, in the right load order. When you next load Eshell, it
-;; will only have to read in this one file, which will greatly speed
-;; things up.
+;;; Code:
(eval-when-compile
(require 'cl-lib))
@@ -300,7 +251,7 @@ buffer selected (or created)."
(get-buffer-create eshell-buffer-name)))))
(cl-assert (and buf (buffer-live-p buf)))
(pop-to-buffer-same-window buf)
- (unless (eq major-mode 'eshell-mode)
+ (unless (derived-mode-p 'eshell-mode)
(eshell-mode))
buf))
diff --git a/lisp/expand.el b/lisp/expand.el
index 81ad1495527..97c8a259459 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -1,6 +1,6 @@
;;; expand.el --- make abbreviations more usable
-;; Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
;; Maintainer: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
@@ -213,7 +213,7 @@
"for" ; foreach
(concat
"for ( )\n"
- "{\n\n\}"
+ "{\n\n}"
)
(list 7 12))
@@ -221,7 +221,7 @@
"whi" ; foreach
(concat
"while ( )\n"
- "{\n\n\}"
+ "{\n\n}"
)
(list 9 15))
@@ -233,7 +233,7 @@
"iff"
(concat
"if ( )\n"
- "{\n\n\}"
+ "{\n\n}"
)
(list 6 12))
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index 6459e5ee68c..542e5e9dce3 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -1,6 +1,6 @@
;;; ezimage --- Generalized Image management
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index e4ec602efe7..3a8aba566dc 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -1,6 +1,6 @@
;;; face-remap.el --- Functions for managing `face-remapping-alist' -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: faces, face remapping, display, user commands
@@ -135,7 +135,9 @@ other than the normal definition of FACE via `face-remap-set-base'."
(let ((faces (cdr entry)))
(if (symbolp faces)
(setq faces (list faces)))
- (setcdr entry (face-remap-order (cons specs faces))))
+ (setcdr entry (face-remap-order (cons specs faces)))
+ ;; Force redisplay of this buffer.
+ (force-mode-line-update))
(cons face specs)))
(defun face-remap-remove-relative (cookie)
@@ -150,7 +152,9 @@ COOKIE should be the return value from that function."
(and (eq (car-safe updated-entries) (car cookie))
(null (cdr updated-entries))))
(setq face-remapping-alist
- (remq remapping face-remapping-alist)))
+ (remq remapping face-remapping-alist))
+ ;; Force redisplay of this buffer.
+ (force-mode-line-update))
(cdr cookie))))))
;;;###autoload
@@ -167,7 +171,9 @@ to apply on top of the normal definition of FACE."
(if (null (cddr entry)) ; nothing except base remapping
(setq face-remapping-alist ; so remove entire entry
(remq entry face-remapping-alist))
- (setcar (last entry) face))))) ; otherwise, just inherit global def
+ (setcar (last entry) face))
+ ;; Force redisplay of this buffer.
+ (force-mode-line-update)))) ; otherwise, just inherit global def
;;;###autoload
(defun face-remap-set-base (face &rest specs)
@@ -181,7 +187,7 @@ of face attribute/value pairs, like in a `face' text property.
If SPECS is empty, call `face-remap-reset-base' to use the normal
definition of FACE as the base remapping; note that this is
-different from SPECS containing a single value `nil', which means
+different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all."
(while (and (consp specs) (not (null (car specs))) (null (cdr specs)))
(setq specs (car specs)))
@@ -194,7 +200,9 @@ not to inherit from the global definition of FACE at all."
(let ((entry (assq face face-remapping-alist)))
(if entry
(setcar (last entry) specs) ; overwrite existing base entry
- (push (list face specs) face-remapping-alist)))))
+ (push (list face specs) face-remapping-alist)))
+ ;; Force redisplay of this buffer.
+ (force-mode-line-update)))
;; ----------------------------------------------------------------
@@ -299,11 +307,9 @@ key-binding used to invoke the command, with all modifiers removed:
- Decrease the default face height by one step
0 Reset the default face height to the global default
-When adjusting with `+' or `-', continue to read input events and
-further adjust the face height as long as the input event read
-\(with all modifiers removed) is `+' or `-'.
-
-When adjusting with `0', immediately finish.
+After adjusting, continue to read input events and further adjust
+the face height as long as the input event read
+\(with all modifiers removed) is one of the above characters.
Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number of steps decreases the
@@ -324,11 +330,11 @@ a top-level keymap, `text-scale-increase' or
((or ?+ ?=) inc)
(?- (- inc))
(?0 0)
- (t inc))))
+ (_ inc))))
(text-scale-increase step)
;; (unless (zerop step)
(message "Use +,-,0 for further adjustment")
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(dolist (mods '(() (control)))
(dolist (key '(?- ?+ ?= ?0)) ;; = is often unshifted +.
@@ -345,6 +351,9 @@ a top-level keymap, `text-scale-increase' or
It may contain any value suitable for a `face' text property,
including a face name, a list of face names, a face-attribute
plist, etc."
+ :type '(choice (face)
+ (repeat :tag "List of faces" face)
+ (plist :tag "Face property list"))
:group 'display
:version "23.1")
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index eb4554585a8..3d5894309df 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -1,6 +1,6 @@
;;; facemenu.el --- create a face menu for interactively adding fonts to text
-;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: faces
@@ -458,7 +458,7 @@ These special properties include `invisible', `intangible' and `read-only'."
(defcustom list-colors-sort nil
"Color sort order for `list-colors-display'.
-`nil' means default implementation-dependent order (defined in `x-colors').
+nil means default implementation-dependent order (defined in `x-colors').
`name' sorts by color name.
`rgb' sorts by red, green, blue components.
`(rgb-dist . COLOR)' sorts by the RGB distance to the specified color.
@@ -620,7 +620,7 @@ color. The function should accept a single argument, the color name."
'help-echo
(let ((hsv (apply 'color-rgb-to-hsv
(color-name-to-rgb (car color)))))
- (format "H:%d S:%d V:%d"
+ (format "H:%.2f S:%.2f V:%.2f"
(nth 0 hsv) (nth 1 hsv) (nth 2 hsv)))))
(when callback
(make-text-button
@@ -732,7 +732,7 @@ effect. See `facemenu-remove-face-function'."
face
(facemenu-active-faces
(cons face
- (if (listp prev)
+ (if (face-list-p prev)
prev
(list prev)))
;; Specify the selected frame
diff --git a/lisp/faces.el b/lisp/faces.el
index 9a34aec2549..f96df057cbd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1,8 +1,8 @@
;;; faces.el --- Lisp faces
-;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -35,6 +35,26 @@ the terminal-initialization file to be loaded."
(string :tag "Name of directory with term files"))
:group 'terminals)
+(defcustom term-file-aliases
+ '(("apollo" . "vt100")
+ ("vt102" . "vt100")
+ ("vt125" . "vt100")
+ ("vt201" . "vt200")
+ ("vt220" . "vt200")
+ ("vt240" . "vt200")
+ ("vt300" . "vt200")
+ ("vt320" . "vt200")
+ ("vt400" . "vt200")
+ ("vt420" . "vt200")
+ )
+ "Alist of terminal type aliases.
+Entries are of the form (TYPE . ALIAS), where both elements are strings.
+This means to treat a terminal of type TYPE as if it were of type ALIAS."
+ :type '(alist :key-type (string :tag "Terminal")
+ :value-type (string :tag "Alias"))
+ :group 'terminals
+ :version "25.1")
+
(declare-function xw-defined-colors "term/common-win" (&optional frame))
(defvar help-xref-stack-item)
@@ -129,13 +149,11 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc."
"Return a list of all defined faces."
(mapcar #'car face-new-frame-defaults))
-(defun make-face (face &optional no-init-from-resources)
+(defun make-face (face)
"Define a new face with name FACE, a symbol.
Do not call this directly from Lisp code; use `defface' instead.
-If NO-INIT-FROM-RESOURCES is non-nil, don't initialize face
-attributes from X resources. If FACE is already known as a face,
-leave it unmodified. Return FACE."
+If FACE is already known as a face, leave it unmodified. Return FACE."
(interactive (list (read-from-minibuffer
"Make face: " nil nil t 'face-name-history)))
(unless (facep face)
@@ -146,8 +164,7 @@ leave it unmodified. Return FACE."
(when (fboundp 'facemenu-add-new-face)
(facemenu-add-new-face face))
;; Define frame-local faces for all frames from X resources.
- (unless no-init-from-resources
- (make-face-x-resource-internal face)))
+ (make-face-x-resource-internal face))
face)
(defun make-empty-face (face)
@@ -155,7 +172,7 @@ leave it unmodified. Return FACE."
Do not call this directly from Lisp code; use `defface' instead."
(interactive (list (read-from-minibuffer
"Make empty face: " nil nil t 'face-name-history)))
- (make-face face 'no-init-from-resources))
+ (make-face face))
(defun copy-face (old-face new-face &optional frame new-frame)
"Define a face named NEW-FACE, which is a copy of OLD-FACE.
@@ -256,6 +273,17 @@ If FRAME is omitted or nil, use the selected frame."
(not (internal-lisp-face-empty-p face frame)))
+(defun face-list-p (face-or-list)
+ "True if FACE-OR-LIST is a list of faces.
+Return nil if FACE-OR-LIST is a non-nil atom, or a cons cell whose car
+is either 'foreground-color, 'background-color, or a keyword."
+ ;; The logic of merge_face_ref (xfaces.c) is recreated here.
+ (and (listp face-or-list)
+ (not (memq (car face-or-list)
+ '(foreground-color background-color)))
+ (not (keywordp (car face-or-list)))))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Setting face attributes from X resources.
@@ -274,6 +302,8 @@ If FRAME is omitted or nil, use the selected frame."
(:weight (".attributeWeight" . "Face.AttributeWeight"))
(:slant (".attributeSlant" . "Face.AttributeSlant"))
(:foreground (".attributeForeground" . "Face.AttributeForeground"))
+ (:distant-foreground
+ (".attributeDistantForeground" . "Face.AttributeDistantForeground"))
(:background (".attributeBackground" . "Face.AttributeBackground"))
(:overline (".attributeOverline" . "Face.AttributeOverline"))
(:strike-through (".attributeStrikeThrough" . "Face.AttributeStrikeThrough"))
@@ -332,11 +362,16 @@ specifies an invalid attribute."
(defun make-face-x-resource-internal (face &optional frame)
"Fill frame-local FACE on FRAME from X resources.
-FRAME nil or not specified means do it for all frames."
- (if (null frame)
- (dolist (frame (frame-list))
- (set-face-attributes-from-resources face frame))
- (set-face-attributes-from-resources face frame)))
+FRAME nil or not specified means do it for all frames.
+
+If `inhibit-x-resources' is non-nil, this function does nothing."
+ (unless inhibit-x-resources
+ (dolist (frame (if (null frame) (frame-list) (list frame)))
+ ;; `x-create-frame' already took care of correctly handling
+ ;; the reverse video case-- do _not_ touch the default face
+ (unless (and (eq face 'default)
+ (frame-parameter frame 'reverse))
+ (set-face-attributes-from-resources face frame)))))
@@ -398,7 +433,7 @@ completely specified)."
(defun face-attribute-merged-with (attribute value faces &optional frame)
"Merges ATTRIBUTE, initially VALUE, with faces from FACES until absolute.
FACES may be either a single face or a list of faces.
-\[This is an internal function.]"
+[This is an internal function.]"
(cond ((not (face-attribute-relative-p attribute value))
value)
((null faces)
@@ -584,7 +619,7 @@ VALUE must be a string specifying the font family
`:foundry'
VALUE must be a string specifying the font foundry,
-e.g. ``adobe''. If a font foundry is specified, wild-cards `*'
+e.g., \"adobe\". If a font foundry is specified, wild-cards `*'
and `?' are allowed.
`:width'
@@ -718,7 +753,7 @@ is specified, `:italic' is ignored."
(setq args (purecopy args))
(let ((where (if (null frame) 0 frame))
(spec args)
- family foundry)
+ family foundry orig-family orig-foundry)
;; If we set the new-frame defaults, this face is modified outside Custom.
(if (memq where '(0 t))
(put (or (get face 'face-alias) face) 'face-modified t))
@@ -734,9 +769,16 @@ is specified, `:italic' is ignored."
(when (or family foundry)
(when (and (stringp family)
(string-match "\\([^-]*\\)-\\([^-]*\\)" family))
+ (setq orig-foundry foundry
+ orig-family family)
(unless foundry
(setq foundry (match-string 1 family)))
- (setq family (match-string 2 family)))
+ (setq family (match-string 2 family))
+ ;; Reject bogus "families" that are all-digits -- those are some
+ ;; weird font names, like Foobar-12, that end in a number.
+ (when (string-match "\\`[0-9]*\\'" family)
+ (setq family orig-family)
+ (setq foundry orig-foundry)))
(when (or (stringp family) (eq family 'unspecified))
(internal-set-lisp-face-attribute face :family (purecopy family)
where))
@@ -857,7 +899,7 @@ where COLOR is a string or `foreground-color', and STYLE is either
foreground color. :style may be omitted, which means to use a line.
FRAME nil or not specified means change face on all frames.
-Use `set-face-attribute' to ``unspecify'' underlining."
+Use `set-face-attribute' to \"unspecify\" underlining."
(interactive (read-face-and-attribute :underline))
(set-face-attribute face frame :underline underline))
@@ -870,7 +912,7 @@ Use `set-face-attribute' to ``unspecify'' underlining."
INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video.
INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video.
FRAME nil or not specified means change face on all frames.
-Use `set-face-attribute' to ``unspecify'' the inverse video attribute."
+Use `set-face-attribute' to \"unspecify\" the inverse video attribute."
(interactive
(let ((list (read-face-and-attribute :inverse-video)))
(list (car list) (if (cadr list) t))))
@@ -956,13 +998,14 @@ a single face name."
;; If we only want one, and the default is more than one,
;; discard the unwanted ones.
(t (symbol-name (car default))))))
- (if (and default (not multiple))
- ;; For compatibility with `completing-read-multiple' use `crm-separator'
- ;; to define DEFAULT if MULTIPLE is nil.
- (setq default (car (split-string default crm-separator t))))
+ (when (and default (not multiple))
+ (require 'crm)
+ ;; For compatibility with `completing-read-multiple' use `crm-separator'
+ ;; to define DEFAULT if MULTIPLE is nil.
+ (setq default (car (split-string default crm-separator t))))
(let ((prompt (if default
- (format "%s (default `%s'): " prompt default)
+ (format-message "%s (default `%s'): " prompt default)
(format "%s: " prompt)))
aliasfaces nonaliasfaces faces)
;; Build up the completion tables.
@@ -1093,10 +1136,10 @@ 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
- (if default
- (format "%s for face `%s' (default %s): "
- name face default)
- (format "%s for face `%s': " name face))
+ (format-message (if default
+ "%s for face `%s' (default %s): "
+ "%s for face `%s': ")
+ name face default)
completion-alist nil nil nil nil default)))
(if (equal value "") default value)))
@@ -1181,7 +1224,8 @@ of a global face. Value is the new attribute value."
"Read the name of a font for FACE on FRAME.
If optional argument FRAME is nil or omitted, use the selected frame."
(let ((completion-ignore-case t))
- (completing-read (format "Set font attributes of face `%s' from font: " face)
+ (completing-read (format-message
+ "Set font attributes of face `%s' from font: " face)
(append (fontset-list) (x-list-fonts "*" nil frame)))))
@@ -1257,7 +1301,7 @@ The sample text is a string that comes from the variable
If REGEXP is non-nil, list only those faces with names matching
this regular expression. When called interactively with a prefix
-arg, prompt for a regular expression."
+argument, prompt for a regular expression using `read-regexp'."
(interactive (list (and current-prefix-arg
(read-regexp "List faces matching regexp"))))
(let ((all-faces (zerop (length regexp)))
@@ -1348,6 +1392,7 @@ If FRAME is omitted or nil, use the selected frame."
(:weight . "Weight")
(:slant . "Slant")
(:foreground . "Foreground")
+ (:distant-foreground . "DistantForeground")
(:background . "Background")
(:underline . "Underline")
(:overline . "Overline")
@@ -1391,18 +1436,21 @@ If FRAME is omitted or nil, use the selected frame."
(when alias
(setq face alias)
(insert
- (format "\n %s is an alias for the face `%s'.\n%s"
- f alias
- (if (setq obsolete (get f 'obsolete-face))
- (format " This face is obsolete%s; use `%s' instead.\n"
- (if (stringp obsolete)
- (format " since %s" obsolete)
- "")
- alias)
- ""))))
+ (format-message
+ "\n %s is an alias for the face `%s'.\n%s"
+ f alias
+ (if (setq obsolete (get f 'obsolete-face))
+ (format-message
+ " This face is obsolete%s; use `%s' instead.\n"
+ (if (stringp obsolete)
+ (format " since %s" obsolete)
+ "")
+ alias)
+ ""))))
(insert "\nDocumentation:\n"
- (or (face-documentation face)
- "Not documented as a face.")
+ (substitute-command-keys
+ (or (face-documentation face)
+ "Not documented as a face."))
"\n\n"))
(with-current-buffer standard-output
(save-excursion
@@ -1411,12 +1459,13 @@ If FRAME is omitted or nil, use the selected frame."
(help-xref-button 1 'help-customize-face f)))
(setq file-name (find-lisp-object-file-name f 'defface))
(when file-name
- (princ "Defined in `")
+ (princ (substitute-command-keys "Defined in `"))
(princ (file-name-nondirectory file-name))
- (princ "'")
+ (princ (substitute-command-keys "'"))
;; Make a hyperlink to the library.
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward
+ (substitute-command-keys "`\\([^`']+\\)'") nil t)
(help-xref-button 1 'help-face-def f file-name))
(princ ".")
(terpri)
@@ -1508,13 +1557,15 @@ If FRAME is nil, the current FRAME is used."
match))
-(defun face-spec-choose (spec &optional frame)
- "Choose the proper attributes for FRAME, out of SPEC.
-If SPEC is nil, return nil."
+(defun face-spec-choose (spec &optional frame no-match-retval)
+ "Return the proper attributes for FRAME, out of SPEC.
+
+If no match is found or SPEC is nil, return nil, unless NO-MATCH-RETVAL
+is given, in which case return its value instead."
(unless frame
(setq frame (selected-frame)))
(let ((tail spec)
- result defaults)
+ result defaults match-found)
(while tail
(let* ((entry (pop tail))
(display (car entry))
@@ -1534,10 +1585,26 @@ If SPEC is nil, return nil."
(setq defaults thisval)
;; Otherwise, if it matches, use it.
(when (face-spec-set-match-display display frame)
- (setq result thisval)
- (setq tail nil)))))
- (if defaults (append result defaults) result)))
-
+ (setq result thisval
+ tail nil
+ match-found t)))))
+ ;; If defaults have been found, it's safe to just append those to the result
+ ;; list (which at this point will be either nil or contain actual specs) and
+ ;; 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)
+ (if match-found
+ result
+ no-match-retval))))
+
+;; When over 80 faces get processed at frame creation time, all but
+;; one specifying all attributes as "unspecified", generating this
+;; list every time means a lot of consing.
+(defconst face--attributes-unspecified
+ (apply 'append
+ (mapcar (lambda (x) (list (car x) 'unspecified))
+ face-attribute-name-alist)))
(defun face-spec-reset-face (face &optional frame)
"Reset all attributes of FACE on FRAME to unspecified."
@@ -1551,28 +1618,30 @@ If SPEC is nil, return nil."
:box nil :inverse-video nil :stipple nil :inherit nil)
;; `display-graphic-p' is unavailable when running
;; temacs, prior to loading frame.el.
- (unless (and (fboundp 'display-graphic-p)
- (display-graphic-p frame))
- `(:family "default" :foundry "default" :width normal
- :height 1 :weight normal :slant normal
- :foreground ,(if (frame-parameter nil 'reverse)
- "unspecified-bg"
- "unspecified-fg")
- :background ,(if (frame-parameter nil 'reverse)
- "unspecified-fg"
- "unspecified-bg"))))
+ (when (fboundp 'display-graphic-p)
+ (unless (display-graphic-p frame)
+ `(:family "default" :foundry "default" :width normal
+ :height 1 :weight normal :slant normal
+ :foreground ,(if (frame-parameter nil 'reverse)
+ "unspecified-bg"
+ "unspecified-fg")
+ :background ,(if (frame-parameter nil 'reverse)
+ "unspecified-fg"
+ "unspecified-bg")))))
;; For all other faces, unspecify all attributes.
- (apply 'append
- (mapcar (lambda (x) (list (car x) 'unspecified))
- face-attribute-name-alist)))))
+ face--attributes-unspecified)))
(defun face-spec-set (face spec &optional spec-type)
"Set the face spec SPEC for FACE.
See `defface' for the format of SPEC.
-The appearance of each face is controlled by its spec, and by the
-internal face attributes (which can be frame-specific and can be
-set via `set-face-attribute').
+The appearance of each face is controlled by its specs (set via
+this function), and by the internal frame-specific face
+attributes (set via `set-face-attribute').
+
+This function also defines FACE as a valid face name if it is not
+already one, and (re)calculates its attributes on existing
+frames.
The argument SPEC-TYPE determines which spec to set:
nil or `face-override-spec' means the override spec (which is
@@ -1585,11 +1654,7 @@ The argument SPEC-TYPE determines which spec to set:
`reset' means to ignore SPEC, but clear the `customized-face'
and `face-override-spec' specs;
Any other value means not to set any spec, but to run the
-function for its other effects.
-
-In addition to setting the face spec, this function defines FACE
-as a valid face name if it is not already one, and (re)calculates
-the face's attributes on existing frames."
+function for its other effects."
(if (get face 'face-alias)
(setq face (get face 'face-alias)))
;; Save SPEC to the relevant symbol property.
@@ -1608,42 +1673,54 @@ the face's attributes on existing frames."
;; as far as Custom is concerned.
(unless (eq face 'face-override-spec)
(put face 'face-modified nil))
- (if (facep face)
- ;; If the face already exists, recalculate it.
- (dolist (frame (frame-list))
- (face-spec-recalc face frame))
- ;; Otherwise, initialize it on all frames.
- (make-empty-face face)
- (let ((value (face-user-default-spec face))
- (have-window-system (memq initial-window-system '(x w32 ns))))
- (dolist (frame (frame-list))
- (face-spec-set-2 face frame value)
- (when (memq (window-system frame) '(x w32 ns))
- (setq have-window-system t)))
- (if have-window-system
- (make-face-x-resource-internal face)))))
+ ;; Initialize the face if it does not exist, then recalculate.
+ (make-empty-face face)
+ (dolist (frame (frame-list))
+ (face-spec-recalc face frame)))
(defun face-spec-recalc (face frame)
"Reset the face attributes of FACE on FRAME according to its specs.
-This applies the defface/custom spec first, then the custom theme specs,
-then the override spec."
+The following sources are applied in this order:
+
+ face reset to default values if it's the default face, otherwise set
+ to unspecified (through `face-spec-reset-face')
+ |
+ (theme and user customization)
+ or: if none of the above exist, and none match the current frame or
+ inherited from the defface spec instead of overwriting it
+ entirely, the following is applied instead:
+ (defface default spec)
+ (X resources (if applicable))
+ |
+ defface override spec"
(while (get face 'face-alias)
(setq face (get face 'face-alias)))
(face-spec-reset-face face frame)
;; If FACE is customized or themed, set the custom spec from
- ;; `theme-face' records, which completely replace the defface spec
- ;; rather than inheriting from it.
- (let ((theme-faces (get face 'theme-face)))
+ ;; `theme-face' records.
+ (let ((theme-faces (get face 'theme-face))
+ (no-match-found 0)
+ spec theme-face-applied)
(if theme-faces
- (dolist (spec (reverse theme-faces))
- (face-spec-set-2 face frame (cadr spec)))
- (face-spec-set-2 face frame (face-default-spec face))))
- (face-spec-set-2 face frame (get face 'face-override-spec)))
+ (dolist (elt (reverse theme-faces))
+ (setq spec (face-spec-choose (cadr elt) frame no-match-found))
+ (unless (eq spec no-match-found)
+ (face-spec-set-2 face frame spec)
+ (setq theme-face-applied t))))
+ ;; If there was a spec applicable to FRAME, that overrides the
+ ;; defface spec entirely (rather than inheriting from it). If
+ ;; there was no spec applicable to FRAME, apply the defface spec
+ ;; as well as any applicable X resources.
+ (unless theme-face-applied
+ (setq spec (face-spec-choose (face-default-spec face) frame))
+ (face-spec-set-2 face frame spec)
+ (make-face-x-resource-internal face frame))
+ (setq spec (face-spec-choose (get face 'face-override-spec) frame))
+ (face-spec-set-2 face frame spec)))
(defun face-spec-set-2 (face frame spec)
"Set the face attributes of FACE on FRAME according to SPEC."
- (let* ((spec (face-spec-choose spec frame))
- attrs)
+ (let (attrs)
(while spec
(when (assq (car spec) face-x-resources)
(push (car spec) attrs)
@@ -1776,7 +1853,9 @@ If omitted or nil, that stands for the selected frame's display."
(declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
(defun display-grayscale-p (&optional display)
- "Return non-nil if frames on DISPLAY can display shades of gray."
+ "Return non-nil if frames on DISPLAY can display shades of gray.
+DISPLAY should be either a frame or a display name (a string).
+If omitted or nil, that stands for the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1833,7 +1912,7 @@ resulting color name in the echo area."
(if (color-defined-p string)
(list string))))
((eq flag 'lambda) ; Test completion.
- (or (memq string colors)
+ (or (member string colors)
(color-defined-p string)))))
nil t)))
@@ -1871,56 +1950,61 @@ Return nil if there is no face."
(get-char-property (point) 'face))))
(cond ((facep faceprop)
(push faceprop faces))
- ((and (listp faceprop)
- ;; Don't treat an attribute spec as a list of faces.
- (not (keywordp (car faceprop)))
- (not (memq (car faceprop)
- '(foreground-color background-color))))
+ ((face-list-p faceprop)
(dolist (face faceprop)
(if (facep face)
(push face faces))))))
- (setq faces (delete-dups (nreverse faces)))
- (if multiple faces (car faces))))
+ (if multiple
+ (delete-dups (nreverse faces))
+ (car (last faces)))))
+
+(defun faces--attribute-at-point (attribute &optional attribute-unnamed)
+ "Return the face ATTRIBUTE at point.
+ATTRIBUTE is a keyword.
+If ATTRIBUTE-UNNAMED is non-nil, it is a symbol to look for in
+unnamed faces (e.g, `foreground-color')."
+ ;; `face-at-point' alone is not sufficient. It only gets named faces.
+ ;; Need also pick up any face properties that are not associated with named faces.
+ (let ((faces (or (get-char-property (point) 'read-face-name)
+ ;; If `font-lock-mode' is on, `font-lock-face' takes precedence.
+ (and font-lock-mode
+ (get-char-property (point) 'font-lock-face))
+ (get-char-property (point) 'face)))
+ (found nil))
+ (dolist (face (if (listp faces) faces (list faces)))
+ (cond (found)
+ ((and face (symbolp face))
+ (let ((value (face-attribute-specified-or
+ (face-attribute face attribute nil t)
+ nil)))
+ (unless (member value '(nil "unspecified-fg" "unspecified-bg"))
+ (setq found value))))
+ ((consp face)
+ (setq found (cond ((and attribute-unnamed
+ (memq attribute-unnamed face))
+ (cdr (memq attribute-unnamed face)))
+ ((memq attribute face) (cadr (memq attribute face))))))))
+ (or found
+ (face-attribute 'default attribute))))
(defun foreground-color-at-point ()
"Return the foreground color of the character after point."
- ;; `face-at-point' alone is not sufficient. It only gets named faces.
- ;; Need also pick up any face properties that are not associated with named faces.
- (let ((face (or (face-at-point)
- (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face))))
- (cond ((and face (symbolp face))
- (let ((value (face-foreground face nil 'default)))
- (if (member value '("unspecified-fg" "unspecified-bg"))
- nil
- value)))
- ((consp face)
- (cond ((memq 'foreground-color face) (cdr (memq 'foreground-color face)))
- ((memq ':foreground face) (cadr (memq ':foreground face)))))
- (t nil)))) ; Invalid face value.
+ (faces--attribute-at-point :foreground 'foreground-color))
(defun background-color-at-point ()
"Return the background color of the character after point."
- ;; `face-at-point' alone is not sufficient. It only gets named faces.
- ;; Need also pick up any face properties that are not associated with named faces.
- (let ((face (or (face-at-point)
- (get-char-property (point) 'read-face-name)
- (get-char-property (point) 'face))))
- (cond ((and face (symbolp face))
- (let ((value (face-background face nil 'default)))
- (if (member value '("unspecified-fg" "unspecified-bg"))
- nil
- value)))
- ((consp face)
- (cond ((memq 'background-color face) (cdr (memq 'background-color face)))
- ((memq ':background face) (cadr (memq ':background face)))))
- (t nil)))) ; Invalid face value.
+ (faces--attribute-at-point :background 'background-color))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Frame creation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(declare-function x-display-list "xfns.c" ())
+(declare-function x-open-connection "xfns.c"
+ (display &optional xrm-string must-succeed))
+(declare-function x-get-resource "frame.c"
+ (attribute class &optional component subclass))
(declare-function x-parse-geometry "frame.c" (string))
(defvar x-display-name)
@@ -1979,7 +2063,7 @@ Value is the new parameter list."
"Create and return a frame with frame parameters PARAMETERS.
If PARAMETERS specify a frame name, handle X geometry resources
for that name. If PARAMETERS includes a `reverse' parameter, or
-the X resource ``reverseVideo'' is present, handle that."
+the X resource \"reverseVideo\" is present, handle that."
(setq parameters (x-handle-named-frame-geometry parameters))
(let* ((params (copy-tree parameters))
(visibility-spec (assq 'visibility parameters))
@@ -2011,21 +2095,16 @@ Calculate the face definitions using the face specs, custom theme
settings, X resources, and `face-new-frame-defaults'.
Finally, apply any relevant face attributes found amongst the
frame parameters in PARAMETERS."
- (let ((window-system-p (memq (window-system frame) '(x w32))))
- ;; The `reverse' is so that `default' goes first.
- (dolist (face (nreverse (face-list)))
- (condition-case ()
- (progn
- ;; Initialize faces from face spec and custom theme.
- (face-spec-recalc face frame)
- ;; X resources for the default face are applied during
- ;; `x-create-frame'.
- (and (not (eq face 'default)) window-system-p
- (make-face-x-resource-internal face frame))
- ;; Apply attributes specified by face-new-frame-defaults
- (internal-merge-in-global-face face frame))
- ;; Don't let invalid specs prevent frame creation.
- (error nil))))
+ ;; The `reverse' is so that `default' goes first.
+ (dolist (face (nreverse (face-list)))
+ (condition-case ()
+ (progn
+ ;; Initialize faces from face spec and custom theme.
+ (face-spec-recalc face frame)
+ ;; Apply attributes specified by face-new-frame-defaults
+ (internal-merge-in-global-face face frame))
+ ;; Don't let invalid specs prevent frame creation.
+ (error nil)))
;; Apply attributes specified by frame parameters.
(let ((face-params '((foreground-color default :foreground)
@@ -2072,7 +2151,7 @@ If PARAMETERS contains a `reverse' parameter, handle that."
(unless (terminal-parameter frame 'terminal-initted)
(set-terminal-parameter frame 'terminal-initted t)
(set-locale-environment nil frame)
- (tty-run-terminal-initialization frame))
+ (tty-run-terminal-initialization frame nil t))
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
(setq success t))
@@ -2099,13 +2178,24 @@ the above example."
(defvar tty-setup-hook nil
"Hook run after running the initialization function of a new text terminal.
+Specifically, `tty-run-terminal-initialization' runs this.
This can be used to fine tune the `input-decode-map', for example.")
-(defun tty-run-terminal-initialization (frame &optional type)
+(defun tty-run-terminal-initialization (frame &optional type run-hook)
"Run the special initialization code for the terminal type of FRAME.
The optional TYPE parameter may be used to override the autodetected
-terminal type to a different value."
+terminal type to a different value.
+
+This consults `term-file-aliases' to map terminal types to their aliases.
+
+If optional argument RUN-HOOK is non-nil, then as a final step,
+this runs the hook `tty-setup-hook'.
+
+If you set `term-file-prefix' to nil, this function does nothing."
(setq type (or type (tty-type frame)))
+ (let ((alias (tty-find-type
+ (lambda (typ) (assoc typ term-file-aliases)) type)))
+ (if alias (setq type (cdr (assoc alias term-file-aliases)))))
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
(with-selected-frame frame
@@ -2127,7 +2217,7 @@ terminal type to a different value."
(when (fboundp term-init-func)
(funcall term-init-func))
(set-terminal-parameter frame 'terminal-initted term-init-func)
- (run-hooks 'tty-setup-hook)))))
+ (if run-hook (run-hooks 'tty-setup-hook))))))
;; Called from C function init_display to initialize faces of the
;; dumped terminal frame on startup.
@@ -2137,7 +2227,6 @@ terminal type to a different value."
(frame-set-background-mode frame t)
(face-set-after-frame-default frame)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Standard faces.
@@ -2251,10 +2340,11 @@ terminal type to a different value."
'((((class color) (min-colors 88) (background dark))
:background "blue3")
(((class color) (min-colors 88) (background light) (type gtk))
- :foreground "gtk_selection_fg_color"
+ :distant-foreground "gtk_selection_fg_color"
:background "gtk_selection_bg_color")
(((class color) (min-colors 88) (background light) (type ns))
- :background "ns_selection_color")
+ :distant-foreground "ns_selection_fg_color"
+ :background "ns_selection_bg_color")
(((class color) (min-colors 88) (background light))
:background "lightgoldenrod2")
(((class color) (min-colors 16) (background dark))
@@ -2417,6 +2507,39 @@ Use the face `mode-line-highlight' for features that can be selected."
:version "22.1"
:group 'basic-faces)
+(defface window-divider '((t :foreground "gray60"))
+ "Basic face for window dividers.
+When a divider is less than 3 pixels wide, it is drawn solidly
+with the foreground of this face. For larger dividers this face
+is used for the inner part while the first pixel line/column is
+drawn with the `window-divider-first-pixel' face and the last
+pixel line/column with the `window-divider-last-pixel' face."
+ :version "24.4"
+ :group 'window-divider
+ :group 'basic-faces)
+
+(defface window-divider-first-pixel
+ '((t :foreground "gray80"))
+ "Basic face for first pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its first pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the first pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'window-divider
+ :group 'basic-faces)
+
+(defface window-divider-last-pixel
+ '((t :foreground "gray40"))
+ "Basic face for last pixel line/column of window dividers.
+When a divider is at least 3 pixels wide, its last pixel
+line/column is drawn with the foreground of this face. If you do
+not want to accentuate the last pixel line/column, set this to
+the same as `window-divider' face."
+ :version "24.4"
+ :group 'window-divider
+ :group 'basic-faces)
+
(defface minibuffer-prompt
'((((background dark)) :foreground "cyan")
;; Don't use blue because many users of the MS-DOS port customize
@@ -2545,6 +2668,52 @@ It is used for characters of no fonts too."
:version "24.1"
:group 'basic-faces)
+;; Faces for TTY menus.
+(defface tty-menu-enabled-face
+ '((t
+ :foreground "yellow" :background "blue" :weight bold))
+ "Face for displaying enabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-disabled-face
+ '((((class color) (min-colors 16))
+ :foreground "lightgray" :background "blue")
+ (t
+ :foreground "white" :background "blue"))
+ "Face for displaying disabled items in TTY menus."
+ :group 'basic-faces)
+
+(defface tty-menu-selected-face
+ '((t :background "red"))
+ "Face for displaying the currently selected item in TTY menus."
+ :group 'basic-faces)
+
+(defgroup paren-showing-faces nil
+ "Faces used to highlight paren matches."
+ :group 'paren-showing
+ :group 'faces
+ :version "22.1")
+
+(defface show-paren-match
+ '((((class color) (background light))
+ :background "turquoise") ; looks OK on tty (becomes cyan)
+ (((class color) (background dark))
+ :background "steelblue3") ; looks OK on tty (becomes blue)
+ (((background dark) (min-colors 4))
+ :background "grey50")
+ (((background light) (min-colors 4))
+ :background "gray")
+ (t
+ :inherit underline))
+ "Face used for a matching paren."
+ :group 'paren-showing-faces)
+
+(defface show-paren-mismatch
+ '((((class color)) (:foreground "white" :background "purple"))
+ (t (:inverse-video t)))
+ "Face used for a mismatching paren."
+ :group 'paren-showing-faces)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Manipulating font names.
@@ -2609,8 +2778,6 @@ If PATTERN is nil, return the name of the frame's base font, which never
contains wildcards.
Given optional arguments FACE and FRAME, return a font which is
also the same size as FACE on FRAME, or fail."
- (or (symbolp face)
- (setq face (face-name face)))
(and (eq frame t)
(setq frame nil))
(if pattern
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 737de8b5991..8d3f8bfc37d 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1,9 +1,9 @@
;;; ffap.el --- find file (or url) at point
-;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
@@ -90,7 +90,6 @@
;;; Todo list:
-;; * use kpsewhich
;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
;; * find file of symbol if TAGS is loaded (like above)
;; * break long menus into multiple panes (like imenu?)
@@ -163,10 +162,16 @@ schemes (e.g. \"ftp\"); in that case, only convert those URLs."
:group 'ffap
:version "24.3")
+(defcustom ffap-lax-url nil
+ "If non-nil, allow lax URL matching."
+ :type 'boolean
+ :group 'ffap
+ :version "25.1")
+
(defcustom ffap-ftp-default-user "anonymous"
- "User name in ftp file names generated by `ffap-host-to-path'.
+ "User name in FTP file names generated by `ffap-host-to-path'.
Note this name may be omitted if it equals the default
-\(either `efs-default-user' or `ange-ftp-default-user'\)."
+\(either `efs-default-user' or `ange-ftp-default-user')."
:type 'string
:group 'ffap)
@@ -185,7 +190,7 @@ Note this name may be omitted if it equals the default
"\\|"
"\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
"\\)")
- "Regexp matching the beginning of a URI, for FFAP.
+ "Regexp matching the beginning of a URI, for ffap.
If the value is nil, disable URL-matching features in ffap.")
(defcustom ffap-foo-at-bar-prefix "mailto"
@@ -228,7 +233,7 @@ it passes it on to `dired'."
:group 'ffap)
(defcustom ffap-pass-wildcards-to-dired nil
- "If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
+ "If non-nil, pass filenames matching `ffap-dired-wildcards' to Dired."
:type 'boolean
:group 'ffap)
@@ -259,20 +264,10 @@ ffap most of the time."
:group 'ffap
:risky t)
-(defcustom ffap-url-fetcher
- (if (fboundp 'browse-url)
- 'browse-url ; rely on browse-url-browser-function
- 'w3-fetch)
- ;; Remote control references:
- ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
- ;; http://home.netscape.com/newsref/std/x-remote.html
+(defcustom ffap-url-fetcher 'browse-url
"A function of one argument, called by ffap to fetch an URL.
-Reasonable choices are `w3-fetch' or a `browse-url-*' function.
For a fancy alternative, get `ffap-url.el'."
- :type '(choice (const w3-fetch)
- (const browse-url) ; in recent versions of browse-url
- (const browse-url-netscape)
- (const browse-url-mosaic)
+ :type '(choice (const browse-url)
function)
:group 'ffap
:risky t)
@@ -291,8 +286,8 @@ For a fancy alternative, get `ffap-url.el'."
(defcustom dired-at-point-require-prefix nil
"If non-nil, reverse the prefix argument to `dired-at-point'.
-This is nil so neophytes notice FFAP. Experts may prefer to
-disable FFAP most of the time."
+This is nil so neophytes notice ffap. Experts may prefer to
+disable ffap most of the time."
:type 'boolean
:group 'ffap
:version "20.3")
@@ -343,7 +338,7 @@ Only considers strings that match `ffap-next-regexp'."
"Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
+Interactively: use a single prefix \\[universal-argument] to search backwards,
double prefix to wrap forward, triple to wrap backwards.
Actual search is done by the function `ffap-next-guess'."
(interactive
@@ -413,13 +408,13 @@ See `mail-extr.el' for the known domains."
Depending on the domain (none, known, or unknown), follow the strategy
named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'.
-Optional SERVICE specifies the port used \(default \"discard\"\).
+Optional SERVICE specifies the port used (default \"discard\").
Optional QUIET flag suppresses the \"Pinging...\" message.
Optional STRATEGY overrides the three variables above.
Returned values:
- t means that HOST answered.
-'accept means the relevant variable told us to accept.
-\"mesg\" means HOST exists, but does not respond for some reason."
+ t means that HOST answered.
+`accept' means the relevant variable told us to accept.
+\"mesg\" means HOST exists, but does not respond for some reason."
;; Try some (Emory local):
;; (ffap-machine-p "ftp" nil nil 'ping)
;; (ffap-machine-p "nonesuch" nil nil 'ping)
@@ -470,7 +465,7 @@ Returned values:
;; (file-error "connection failed" "address already in use"
;; "ftp.uu.net" "ffap-machine-p")
((equal mesg "connection failed")
- (if (equal (nth 2 error) "permission denied")
+ (if (string= (downcase (nth 2 error)) "permission denied")
nil ; host does not exist
;; Other errors mean the host exists:
(nth 2 error)))
@@ -642,7 +637,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
(defun ffap-list-env (env &optional empty)
"Return a list of strings parsed from environment variable ENV.
-Optional EMPTY is the default list if \(getenv ENV\) is undefined, and
+Optional EMPTY is the default list if (getenv ENV) is undefined, and
also is substituted for the first empty-string component, if there is one.
Uses `path-separator' to separate the path into substrings."
;; We cannot use parse-colon-path (files.el), since it kills
@@ -769,7 +764,7 @@ This uses `ffap-file-exists-string', which may try adding suffixes from
;; (lisp-interaction-mode . ffap-el-mode) ; maybe
(finder-mode . ffap-el-mode) ; type {C-h p} and try it
(help-mode . ffap-el-mode) ; maybe useful
- (c++-mode . ffap-c-mode) ; search ffap-c-path
+ (c++-mode . ffap-c++-mode) ; search ffap-c++-path
(cc-mode . ffap-c-mode) ; same
("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h
(fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB
@@ -787,12 +782,12 @@ This uses `ffap-file-exists-string', which may try adding suffixes from
. ffap-rfc) ; "100% RFC2100 compliant"
(dired-mode . ffap-dired) ; maybe in a subdirectory
)
- "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
+ "Alist of (KEY . FUNCTION) pairs parsed by `ffap-file-at-point'.
If string NAME at point (maybe \"\") is not a file or URL, these pairs
specify actions to try creating such a string. A pair matches if either
KEY is a symbol, and it equals `major-mode', or
KEY is a string, it should match NAME as a regexp.
-On a match, \(FUNCTION NAME\) is called and should return a file, an
+On a match, (FUNCTION NAME) is called and should return a file, an
URL, or nil. If nil, search the alist for further matches.")
(put 'ffap-alist 'risky-local-variable t)
@@ -866,6 +861,28 @@ URL, or nil. If nil, search the alist for further matches.")
(defun ffap-c-mode (name)
(ffap-locate-file name t ffap-c-path))
+(defvar ffap-c++-path
+ (let ((c++-include-dir (with-temp-buffer
+ (when (eq 0 (ignore-errors
+ (call-process "g++" nil t nil "-v")))
+ (goto-char (point-min))
+ (if (re-search-forward "--with-gxx-include-dir=\
+\\([^[:space:]]+\\)"
+ nil 'noerror)
+ (match-string 1)
+ (when (re-search-forward "gcc version \
+\\([[:digit:]]+.[[:digit:]]+.[[:digit:]]+\\)"
+ nil 'noerror)
+ (expand-file-name (match-string 1)
+ "/usr/include/c++/")))))))
+ (if c++-include-dir
+ (cons c++-include-dir ffap-c-path)
+ ffap-c-path))
+ "List of directories to search for include files.")
+
+(defun ffap-c++-mode (name)
+ (ffap-locate-file name t ffap-c++-path))
+
(defvar ffap-fortran-path '("../include" "/usr/include"))
(defun ffap-fortran-mode (name)
@@ -876,6 +893,24 @@ URL, or nil. If nil, search the alist for further matches.")
"Path where `ffap-tex-mode' looks for TeX files.
If t, `ffap-tex-init' will initialize this when needed.")
+(defvar ffap-latex-guess-rules '(("" . ".sty")
+ ("" . ".cls")
+ ("" . ".ltx")
+ ("" . ".tex")
+ ("" . "") ;; in some rare cases the
+ ;; extension is already in
+ ;; the buffer.
+ ("beamertheme" . ".sty")
+ ("beamercolortheme". ".sty")
+ ("beamerfonttheme". ".sty")
+ ("beamerinnertheme". ".sty")
+ ("beameroutertheme". ".sty")
+ ("" . ".ldf"))
+ "List of rules for guessing a filename.
+Each rule is a cons (PREFIX . SUFFIX) used for guessing a
+filename from the word at point by prepending PREFIX and
+appending SUFFIX.")
+
(defun ffap-tex-init ()
;; Compute ffap-tex-path if it is now t.
(and (eq t ffap-tex-path)
@@ -899,9 +934,56 @@ If t, `ffap-tex-init' will initialize this when needed.")
(ffap-locate-file name '(".tex" "") ffap-tex-path))
(defun ffap-latex-mode (name)
- (ffap-tex-init)
- ;; only rare need for ""
- (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
+ "`ffap' function suitable for latex buffers.
+This uses the program kpsewhich if available. In this case, the
+variable `ffap-latex-guess-rules' is used for building a filename
+out of NAME."
+ (cond ((file-exists-p name)
+ name)
+ ((not (executable-find "kpsewhich"))
+ (ffap-tex-init)
+ (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path))
+ (t
+ (let ((curbuf (current-buffer))
+ (guess-rules ffap-latex-guess-rules)
+ (preferred-suffix-rules '(("input" . ".tex")
+ ("include" . ".tex")
+ ("usepackage" . ".sty")
+ ("RequirePackageWithOptions" . ".sty")
+ ("RequirePackage" . ".sty")
+ ("documentclass" . ".cls")
+ ("documentstyle" . ".cls")
+ ("LoadClass" . ".cls")
+ ("LoadClassWithOptions" . ".cls")
+ ("bibliography" . ".bib")
+ ("addbibresource" . ""))))
+ ;; We now add preferred suffix in front of suffixes.
+ (when
+ ;; The condition is essentially:
+ ;; (assoc (TeX-current-macro)
+ ;; (mapcar 'car preferred-suffix-rules))
+ ;; but (TeX-current-macro) can take time, so we just
+ ;; check if one of the `car' in preferred-suffix-rules
+ ;; is found before point on the current line. It
+ ;; should cover most cases.
+ (save-excursion
+ (re-search-backward (regexp-opt
+ (mapcar 'car preferred-suffix-rules))
+ (point-at-bol)
+ t))
+ (push (cons "" (cdr (assoc (match-string 0) ; i.e. "(TeX-current-macro)"
+ preferred-suffix-rules)))
+ guess-rules))
+ (setq kpsewhich-args (mapcar (lambda (rule)
+ (concat (car rule) name (cdr rule)))
+ guess-rules))
+ (with-temp-buffer
+ (let ((process-environment (buffer-local-value
+ 'process-environment curbuf))
+ (exec-path (buffer-local-value 'exec-path curbuf)))
+ (apply #'call-process "kpsewhich" nil t nil kpsewhich-args))
+ (when (< (point-min) (point-max))
+ (buffer-substring (goto-char (point-min)) (point-at-eol))))))))
(defun ffap-tex (name)
(ffap-tex-init)
@@ -958,7 +1040,7 @@ If t, `ffap-tex-init' will initialize this when needed.")
(defcustom ffap-rfc-path
(concat (ffap-host-to-filename "ftp.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
+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'."
:type 'string
@@ -986,7 +1068,7 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
;; Slightly controversial decisions:
;; * strip trailing "@" and ":"
;; * no commas (good for latex)
- (file "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
+ (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
;; An url, or maybe a email/news message-id:
(url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?")
;; Find a string that does *not* contain a colon:
@@ -995,14 +1077,19 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered."
(machine "-[:alnum:]." "" ".")
;; Mathematica paths: allow backquotes
(math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
+ ;; (La)TeX: don't allow braces
+ (latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
+ (tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
)
- "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
-possibly a major-mode name, or one of the symbol
+ "Alist of (MODE CHARS BEG END), where MODE is a symbol,
+possibly a major-mode name, or one of the symbols
`file', `url', `machine', and `nocolon'.
Function `ffap-string-at-point' uses the data fields as follows:
1. find a maximal string of CHARS around point,
2. strip BEG chars before point from the beginning,
-3. strip END chars after point from the end.")
+3. strip END chars after point from the end.
+The arguments CHARS, BEG and END are handled as described in
+`skip-chars-forward'.")
(defvar ffap-string-at-point nil
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
@@ -1010,8 +1097,8 @@ Function `ffap-string-at-point' uses the data fields as follows:
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
-MODE (defaults to value of `major-mode') is a symbol used to look up string
-syntax parameters in `ffap-string-at-point-mode-alist'.
+MODE (defaults to value of `major-mode') is a symbol used to look up
+string syntax parameters in `ffap-string-at-point-mode-alist'.
If MODE is not found, we use `file' instead of MODE.
If the region is active, return a string from the region.
Sets the variable `ffap-string-at-point' and the variable
@@ -1068,16 +1155,25 @@ Assumes the buffer has not changed."
(declare-function w3-view-this-url "ext:w3" (&optional no-show))
(defun ffap-url-at-point ()
- "Return URL from around point if it exists, or nil."
+ "Return URL from around point if it exists, or nil.
+
+Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
(when ffap-url-regexp
(or (and (eq major-mode 'w3-mode) ; In a w3 buffer button?
(w3-view-this-url t))
(let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp)
- (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix))
- (thing-at-point-url-at-point t
- (if (use-region-p)
- (cons (region-beginning)
- (region-end))))))))
+ (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)
+ val)
+ (setq val (thing-at-point-url-at-point ffap-lax-url
+ (if (use-region-p)
+ (cons (region-beginning)
+ (region-end)))))
+ (if val
+ (let ((bounds (thing-at-point-bounds-of-url-at-point
+ ffap-lax-url)))
+ (setq ffap-string-at-point-region
+ (list (car bounds) (cdr bounds)))))
+ val))))
(defvar ffap-gopher-regexp
"^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
@@ -1085,7 +1181,9 @@ Assumes the buffer has not changed."
The two subexpressions are the KEY and VALUE.")
(defun ffap-gopher-at-point ()
- "If point is inside a gopher bookmark block, return its URL."
+ "If point is inside a gopher bookmark block, return its URL.
+
+Sets the variable `ffap-string-at-point-region' to the bounds of URL, if any."
;; `gopher-parse-bookmark' from gopher.el is not so robust
(save-excursion
(beginning-of-line)
@@ -1094,6 +1192,7 @@ The two subexpressions are the KEY and VALUE.")
(while (and (looking-at ffap-gopher-regexp) (not (bobp)))
(forward-line -1))
(or (looking-at ffap-gopher-regexp) (forward-line 1))
+ (setq ffap-string-at-point-region (list (point) (point)))
(let ((type "1") path host (port "70"))
(while (looking-at ffap-gopher-regexp)
(let ((var (intern
@@ -1104,6 +1203,7 @@ The two subexpressions are the KEY and VALUE.")
(match-end 2))))
(set var val)
(forward-line 1)))
+ (setcdr ffap-string-at-point-region (list (point)))
(if (and path (string-match "^ftp:.*@" path))
(concat "ftp://"
(substring path 4 (1- (match-end 0)))
@@ -1121,7 +1221,7 @@ The two subexpressions are the KEY and VALUE.")
;; Icky regexp avoids: default: 123: foo::bar cs:pub
;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
"\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
- "Strings matching this are coerced to ftp file names by ffap.
+ "Strings matching this are coerced to FTP file names by ffap.
That is, ffap just prepends \"/\". Set to nil to disable.")
(defun ffap-file-at-point ()
@@ -1231,7 +1331,8 @@ which may actually result in an URL rather than a filename."
(not (ffap-file-exists-string dir))
(not (equal dir (setq dir (file-name-directory
(directory-file-name dir)))))))
- (ffap-file-exists-string dir)))
+ (and (not (string= dir "/"))
+ (ffap-file-exists-string dir))))
)
(set-match-data data))))
@@ -1269,7 +1370,7 @@ which may actually result in an URL rather than a filename."
nil
nil
(if dir (cons guess (length dir)) guess)
- (list 'file-name-history)
+ 'file-name-history
(and buffer-file-name
(abbreviate-file-name buffer-file-name)))))
;; Remove the special handler manually. We used to just let-bind
@@ -1410,7 +1511,7 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'."
(expand-file-name filename)))
;; User does not want to find a non-existent file:
((signal 'file-error (list "Opening file buffer"
- "no such file or directory"
+ "No such file or directory"
filename)))))))
;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}.
@@ -1423,7 +1524,7 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'."
(defcustom ffap-menu-regexp nil
"If non-nil, regexp overriding `ffap-next-regexp' in `ffap-menu'.
Make this more restrictive for faster menu building.
-For example, try \":/\" for URL (and some ftp) references."
+For example, try \":/\" for URL (and some FTP) references."
:type '(choice (const nil) regexp)
:group 'ffap)
@@ -1443,7 +1544,7 @@ These properties may be used to fontify the menu references.")
"Put up a menu of files and URLs mentioned in this buffer.
Then set mark, jump to choice, and try to fetch it. The menu is
cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
-The optional RESCAN argument \(a prefix, interactively\) forces
+The optional RESCAN argument (a prefix, interactively) forces
a rebuild. Searches with `ffap-menu-regexp'."
(interactive "P")
;; (require 'imenu) -- no longer used, but roughly emulated
@@ -1476,7 +1577,7 @@ a rebuild. Searches with `ffap-menu-regexp'."
(defun ffap-menu-ask (title alist cont)
"Prompt from a menu of choices, and then apply some action.
-Arguments are TITLE, ALIST, and CONT \(a continuation function\).
+Arguments are TITLE, ALIST, and CONT (a continuation function).
This uses either a menu or the minibuffer depending on invocation.
The TITLE string is used as either the prompt or menu title.
Each ALIST entry looks like (STRING . DATA) and defines one choice.
@@ -1536,7 +1637,7 @@ Applies `ffap-menu-text-plist' text properties at all matches."
(add-text-properties (car ffap-string-at-point-region) (point)
ffap-menu-text-plist)
(message "Scanning...%2d%% <%s>"
- (/ (* 100 (- (point) (point-min))) range) item)))
+ (floor (* 100.0 (- (point) (point-min))) range) item)))
(or mod (restore-buffer-modified-p nil))))
(message "Scanning...done")
;; Remove duplicates.
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 69649e105bc..fd99ee0fb93 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -1,6 +1,6 @@
;;; filecache.el --- find files using a pre-loaded cache
-;; Copyright (C) 1996, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2000-2015 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Nov 10 1996
@@ -154,11 +154,12 @@
;; These are also used in buffers containing lines of file names,
;; so the end-of-name is matched with $ rather than \\'.
(list "~$" "\\.o$" "\\.exe$" "\\.a$" "\\.elc$" ",v$" "\\.output$"
- "\\.$" "#$" "\\.class$")
+ "\\.$" "#$" "\\.class$" "/\\.#")
"List of regular expressions used as filters by the file cache.
File names which match these expressions will not be added to the cache.
Note that the functions `file-cache-add-file' and `file-cache-add-file-list'
do not use this variable."
+ :version "25.1" ; added "/\\.#"
:type '(repeat regexp)
:group 'file-cache)
@@ -613,7 +614,9 @@ the name is considered already unique; only the second substitution
(append completion-setup-hook
(list 'file-cache-completion-setup-function))))
(with-output-to-temp-buffer file-cache-completions-buffer
- (display-completion-list completion-list string))))
+ (display-completion-list
+ (completion-hilit-commonality completion-list
+ (length string))))))
(setq file-cache-string (file-cache-file-name completion-string))
(if (string= file-cache-string (minibuffer-contents))
(minibuffer-message file-cache-sole-match-message)
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 5a5435bb4cb..6a180a86570 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -1,6 +1,6 @@
-;;; filenotify.el --- watch files for changes on disk
+;;; filenotify.el --- watch files for changes on disk -*- lexical-binding:t -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
@@ -41,25 +41,62 @@ could use another implementation.")
"Hash table for registered file notification descriptors.
A key in this hash table is the descriptor as returned from
`gfilenotify', `inotify', `w32notify' or a file name handler.
-The value in the hash table is the cons cell (DIR FILE CALLBACK).")
+The value in the hash table is a list
+
+ (DIR (FILE . CALLBACK) (FILE . CALLBACK) ...)
+
+Several values for a given DIR happen only for `inotify', when
+different files from the same directory are watched.")
+
+(defun file-notify--rm-descriptor (descriptor &optional what)
+ "Remove DESCRIPTOR from `file-notify-descriptors'.
+DESCRIPTOR should be an object returned by `file-notify-add-watch'.
+If it is registered in `file-notify-descriptors', a stopped event is sent.
+WHAT is a file or directory name to be removed, needed just for `inotify'."
+ (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
+ (file (if (consp descriptor) (cdr descriptor)))
+ (registered (gethash desc file-notify-descriptors))
+ (dir (car registered)))
+
+ (when (and (consp registered) (or (null what) (string-equal dir what)))
+ ;; Send `stopped' event.
+ (dolist (entry (cdr registered))
+ (funcall (cdr entry)
+ `(,(file-notify--descriptor desc) stopped
+ ,(or (and (stringp (car entry))
+ (expand-file-name (car entry) dir))
+ dir))))
+
+ ;; Modify `file-notify-descriptors'.
+ (if (not file)
+ (remhash desc file-notify-descriptors)
+ (setcdr registered
+ (delete (assoc file (cdr registered)) (cdr registered)))
+ (if (null (cdr registered))
+ (remhash desc file-notify-descriptors)
+ (puthash desc registered file-notify-descriptors))))))
;; This function is used by `gfilenotify', `inotify' and `w32notify' events.
;;;###autoload
(defun file-notify-handle-event (event)
"Handle file system monitoring event.
-If EVENT is a filewatch event, call its callback.
+If EVENT is a filewatch event, call its callback. It has the format
+
+ (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
+
Otherwise, signal a `file-notify-error'."
(interactive "e")
+ ;;(message "file-notify-handle-event %S" event)
(if (and (eq (car event) 'file-notify)
(>= (length event) 3))
(funcall (nth 2 event) (nth 1 event))
(signal 'file-notify-error
(cons "Not a valid file-notify event" event))))
-(defvar file-notify--pending-events nil
- "List of pending file notification events for a future `renamed' action.
-The entries are a list (DESCRIPTOR ACTION FILE COOKIE). ACTION
-is either `moved-from' or `renamed-from'.")
+;; Needed for `inotify' and `w32notify'. In the latter case, COOKIE is nil.
+(defvar file-notify--pending-event nil
+ "A pending file notification events for a future `renamed' action.
+It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
(defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil."
@@ -81,115 +118,155 @@ This is available in case a file has been moved."
This is available in case a file has been moved."
(nth 3 event))
+;; `inotify' returns the same descriptor when the file (directory)
+;; uses the same inode. We want to distinguish, and apply a virtual
+;; descriptor which make the difference.
+(defun file-notify--descriptor (descriptor)
+ "Return the descriptor to be used in `file-notify-*-watch'.
+For `gfilenotify' and `w32notify' it is the same descriptor as
+used in the low-level file notification package."
+ (if (and (natnump descriptor) (eq file-notify--library 'inotify))
+ (cons descriptor
+ (car (cadr (gethash descriptor file-notify-descriptors))))
+ descriptor))
+
;; The callback function used to map between specific flags of the
;; respective file notifications, and the ones we return.
(defun file-notify-callback (event)
"Handle an EVENT returned from file notification.
-EVENT is the same one as in `file-notify-handle-event' except the
-car of that event, which is the symbol `file-notify'."
+EVENT is the cadr of the event in `file-notify-handle-event'
+\(DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE])."
(let* ((desc (car event))
(registered (gethash desc file-notify-descriptors))
- (pending-event (assoc desc file-notify--pending-events))
(actions (nth 1 event))
(file (file-notify--event-file-name event))
- file1 callback)
+ file1 callback pending-event stopped)
;; Make actions a list.
(unless (consp actions) (setq actions (cons actions nil)))
- ;; Check, that event is meant for us.
- (unless (setq callback (nth 2 registered))
- (setq actions nil))
-
- ;; Loop over actions. In fact, more than one action happens only
- ;; for `inotify'.
- (dolist (action actions)
-
- ;; Send pending event, if it doesn't match.
- (when (and pending-event
- ;; The cookie doesn't match.
- (not (eq (file-notify--event-cookie pending-event)
- (file-notify--event-cookie event)))
- (or
- ;; inotify.
- (and (eq (nth 1 pending-event) 'moved-from)
- (not (eq action 'moved-to)))
- ;; w32notify.
- (and (eq (nth 1 pending-event) 'renamed-from)
- (not (eq action 'renamed-to)))))
- (funcall callback
- (list desc 'deleted
- (file-notify--event-file-name pending-event)))
- (setq file-notify--pending-events
- (delete pending-event file-notify--pending-events)))
-
- ;; Map action. We ignore all events which cannot be mapped.
- (setq action
- (cond
- ;; gfilenotify.
- ((memq action '(attribute-changed changed created deleted)) action)
- ((eq action 'moved)
- (setq file1 (file-notify--event-file1-name event))
- 'renamed)
-
- ;; inotify.
- ((eq action 'attrib) 'attribute-changed)
- ((eq action 'create) 'created)
- ((eq action 'modify) 'changed)
- ((memq action '(delete 'delete-self move-self)) 'deleted)
- ;; Make the event pending.
- ((eq action 'moved-from)
- (add-to-list 'file-notify--pending-events
- (list desc action file
- (file-notify--event-cookie event)))
- nil)
- ;; Look for pending event.
- ((eq action 'moved-to)
- (if (null pending-event)
- 'created
- (setq file1 file
- file (file-notify--event-file-name pending-event)
- file-notify--pending-events
- (delete pending-event file-notify--pending-events))
- 'renamed))
-
- ;; w32notify.
- ((eq action 'added) 'created)
- ((eq action 'modified) 'changed)
- ((eq action 'removed) 'deleted)
- ;; Make the event pending.
- ((eq 'renamed-from action)
- (add-to-list 'file-notify--pending-events
- (list desc action file
- (file-notify--event-cookie event)))
- nil)
- ;; Look for pending event.
- ((eq 'renamed-to action)
- (if (null pending-event)
- 'created
- (setq file1 file
- file (file-notify--event-file-name pending-event)
- file-notify--pending-events
- (delete pending-event file-notify--pending-events))
- 'renamed))))
-
- ;; Apply callback.
- (when (and action
- (or
- ;; If there is no relative file name for that watch,
- ;; we watch the whole directory.
- (null (nth 1 registered))
- ;; File matches.
- (string-equal
- (nth 1 registered) (file-name-nondirectory file))
- ;; File1 matches.
- (and (stringp file1)
- (string-equal
- (nth 1 registered) (file-name-nondirectory file1)))))
- (if file1
- (funcall callback (list desc action file file1))
- (funcall callback (list desc action file)))))))
-
+ ;; Loop over registered entries. In fact, more than one entry
+ ;; happens only for `inotify'.
+ (dolist (entry (cdr registered))
+
+ ;; Check, that event is meant for us.
+ (unless (setq callback (cdr entry))
+ (setq actions nil))
+
+ ;; Loop over actions. In fact, more than one action happens only
+ ;; for `inotify'.
+ (dolist (action actions)
+
+ ;; Send pending event, if it doesn't match.
+ (when (and file-notify--pending-event
+ ;; The cookie doesn't match.
+ (not (eq (file-notify--event-cookie
+ (car file-notify--pending-event))
+ (file-notify--event-cookie event)))
+ (or
+ ;; inotify.
+ (and (eq (nth 1 (car file-notify--pending-event))
+ 'moved-from)
+ (not (eq action 'moved-to)))
+ ;; w32notify.
+ (and (eq (nth 1 (car file-notify--pending-event))
+ 'renamed-from)
+ (not (eq action 'renamed-to)))))
+ (setq pending-event file-notify--pending-event
+ file-notify--pending-event nil)
+ (setcar (cdar pending-event) 'deleted))
+
+ ;; Map action. We ignore all events which cannot be mapped.
+ (setq action
+ (cond
+ ;; gfilenotify.
+ ((memq action '(attribute-changed changed created deleted))
+ action)
+ ((eq action 'moved)
+ (setq file1 (file-notify--event-file1-name event))
+ 'renamed)
+
+ ;; inotify, w32notify.
+ ((eq action 'ignored)
+ (setq stopped t actions nil))
+ ((eq action 'attrib) 'attribute-changed)
+ ((memq action '(create added)) 'created)
+ ((memq action '(modify modified)) 'changed)
+ ((memq action '(delete delete-self move-self removed)) 'deleted)
+ ;; Make the event pending.
+ ((memq action '(moved-from renamed-from))
+ (setq file-notify--pending-event
+ `((,desc ,action ,file ,(file-notify--event-cookie event))
+ ,callback))
+ nil)
+ ;; Look for pending event.
+ ((memq action '(moved-to renamed-to))
+ (if (null file-notify--pending-event)
+ 'created
+ (setq file1 file
+ file (file-notify--event-file-name
+ (car file-notify--pending-event)))
+ ;; If the source is handled by another watch, we
+ ;; must fire the rename event there as well.
+ (when (not (equal (file-notify--descriptor desc)
+ (file-notify--descriptor
+ (caar file-notify--pending-event))))
+ (setq pending-event
+ `((,(caar file-notify--pending-event)
+ renamed ,file ,file1)
+ ,(cadr file-notify--pending-event))))
+ (setq file-notify--pending-event nil)
+ 'renamed))))
+
+ ;; Apply pending callback.
+ (when pending-event
+ (setcar
+ (car pending-event) (file-notify--descriptor (caar pending-event)))
+ (funcall (cadr pending-event) (car pending-event))
+ (setq pending-event nil))
+
+ ;; Check for stopped.
+ ;;(message "file-notify-callback %S %S" file registered)
+ (setq
+ stopped
+ (or
+ stopped
+ (and
+ (memq action '(deleted renamed))
+ (= (length (cdr registered)) 1)
+ (string-equal
+ (file-name-nondirectory file)
+ (or (file-name-nondirectory (car registered))
+ (car (cadr registered)))))))
+
+ ;; Apply callback.
+ (when (and action
+ (or
+ ;; If there is no relative file name for that watch,
+ ;; we watch the whole directory.
+ (null (nth 0 entry))
+ ;; File matches.
+ (string-equal
+ (nth 0 entry) (file-name-nondirectory file))
+ ;; File1 matches.
+ (and (stringp file1)
+ (string-equal
+ (nth 0 entry) (file-name-nondirectory file1)))))
+ (if file1
+ (funcall
+ callback
+ `(,(file-notify--descriptor desc) ,action ,file ,file1))
+ (funcall
+ callback
+ `(,(file-notify--descriptor desc) ,action ,file)))))
+
+ ;; Modify `file-notify-descriptors'.
+ (when stopped
+ (file-notify--rm-descriptor (file-notify--descriptor desc) file)))))
+
+;; `gfilenotify' and `w32notify' return a unique descriptor for every
+;; `file-notify-add-watch', while `inotify' returns a unique
+;; descriptor per inode only.
(defun file-notify-add-watch (file flags callback)
"Add a watch for filesystem events pertaining to FILE.
This arranges for filesystem events pertaining to FILE to be reported
@@ -206,8 +283,8 @@ include the following symbols:
`attribute-change' -- watch for file attributes changes, like
permissions or modification time
-If FILE is a directory, 'change' watches for file creation or
-deletion in that directory.
+If FILE is a directory, `change' watches for file creation or
+deletion in that directory. This does not work recursively.
When any event happens, Emacs will call the CALLBACK function passing
it a single argument EVENT, which is of the form
@@ -223,100 +300,140 @@ following:
`changed' -- FILE has changed
`renamed' -- FILE has been renamed to FILE1
`attribute-changed' -- a FILE attribute was changed
+ `stopped' -- watching FILE has been stopped
FILE is the name of the file whose event is being reported."
;; Check arguments.
(unless (stringp file)
- (signal 'wrong-type-argument (list file)))
+ (signal 'wrong-type-argument `(,file)))
(setq file (expand-file-name file))
(unless (and (consp flags)
(null (delq 'change (delq 'attribute-change (copy-tree flags)))))
- (signal 'wrong-type-argument (list flags)))
+ (signal 'wrong-type-argument `(,flags)))
(unless (functionp callback)
- (signal 'wrong-type-argument (list callback)))
+ (signal 'wrong-type-argument `(,callback)))
(let* ((handler (find-file-name-handler file 'file-notify-add-watch))
(dir (directory-file-name
- (if (or (and (not handler) (eq file-notify--library 'w32notify))
- (file-directory-p file))
+ (if (file-directory-p file)
file
(file-name-directory file))))
- desc func l-flags)
-
- ;; Check, whether this has been registered already.
-; (maphash
-; (lambda (key value)
-; (when (equal (cons file callback) value) (setq desc key)))
-; file-notify-descriptors)
-
- (unless desc
- (if handler
- ;; A file name handler could exist even if there is no local
- ;; file notification support.
- (setq desc (funcall
- handler 'file-notify-add-watch dir flags callback))
-
- ;; Check, whether Emacs has been compiled with file
- ;; notification support.
- (unless file-notify--library
- (signal 'file-notify-error
- '("No file notification package available")))
-
- ;; Determine low-level function to be called.
- (setq func
- (cond
- ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
- ((eq file-notify--library 'inotify) 'inotify-add-watch)
- ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
-
- ;; Determine respective flags.
- (if (eq file-notify--library 'gfilenotify)
- (setq l-flags '(watch-mounts send-moved))
- (when (memq 'change flags)
- (setq
- l-flags
- (cond
- ((eq file-notify--library 'inotify) '(create modify move delete))
- ((eq file-notify--library 'w32notify)
- '(file-name directory-name size last-write-time)))))
- (when (memq 'attribute-change flags)
- (add-to-list
- 'l-flags
- (cond
- ((eq file-notify--library 'inotify) 'attrib)
- ((eq file-notify--library 'w32notify) 'attributes)))))
-
- ;; Call low-level function.
- (setq desc (funcall func dir l-flags 'file-notify-callback))))
+ desc func l-flags registered)
+
+ (unless (file-directory-p dir)
+ (signal 'file-notify-error `("Directory does not exist" ,dir)))
+
+ (if handler
+ ;; A file name handler could exist even if there is no local
+ ;; file notification support.
+ (setq desc (funcall
+ handler 'file-notify-add-watch dir flags callback))
+
+ ;; Check, whether Emacs has been compiled with file notification
+ ;; support.
+ (unless file-notify--library
+ (signal 'file-notify-error
+ '("No file notification package available")))
+
+ ;; Determine low-level function to be called.
+ (setq func
+ (cond
+ ((eq file-notify--library 'gfilenotify) 'gfile-add-watch)
+ ((eq file-notify--library 'inotify) 'inotify-add-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-add-watch)))
+
+ ;; Determine respective flags.
+ (if (eq file-notify--library 'gfilenotify)
+ (setq l-flags (append '(watch-mounts send-moved) flags))
+ (when (memq 'change flags)
+ (setq
+ l-flags
+ (cond
+ ((eq file-notify--library 'inotify)
+ '(create delete delete-self modify move-self move))
+ ((eq file-notify--library 'w32notify)
+ '(file-name directory-name size last-write-time)))))
+ (when (memq 'attribute-change flags)
+ (push (cond
+ ((eq file-notify--library 'inotify) 'attrib)
+ ((eq file-notify--library 'w32notify) 'attributes))
+ l-flags)))
+
+ ;; Call low-level function.
+ (setq desc (funcall func dir l-flags 'file-notify-callback)))
+
+ ;; Modify `file-notify-descriptors'.
+ (setq registered (gethash desc file-notify-descriptors))
+ (puthash
+ desc
+ `(,dir
+ (,(unless (file-directory-p file) (file-name-nondirectory file))
+ . ,callback)
+ . ,(cdr registered))
+ file-notify-descriptors)
;; Return descriptor.
- (puthash desc
- (list (directory-file-name
- (if (file-directory-p dir) dir (file-name-directory dir)))
- (unless (file-directory-p file)
- (file-name-nondirectory file))
- callback)
- file-notify-descriptors)
- desc))
+ (file-notify--descriptor desc)))
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
- (let ((file (car (gethash descriptor file-notify-descriptors)))
- handler)
-
- (when (stringp file)
- (setq handler (find-file-name-handler file 'file-notify-rm-watch))
- (if handler
- (funcall handler 'file-notify-rm-watch descriptor)
- (funcall
- (cond
- ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
- ((eq file-notify--library 'inotify) 'inotify-rm-watch)
- ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
- descriptor)))
-
- (remhash descriptor file-notify-descriptors)))
+ (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
+ (file (if (consp descriptor) (cdr descriptor)))
+ (registered (gethash desc file-notify-descriptors))
+ (dir (car registered))
+ (handler (and (stringp dir)
+ (find-file-name-handler dir 'file-notify-rm-watch))))
+
+ (when (stringp dir)
+ ;; Call low-level function.
+ (when (or (not file)
+ (and (= (length (cdr registered)) 1)
+ (assoc file (cdr registered))))
+ (condition-case nil
+ (if handler
+ ;; A file name handler could exist even if there is no local
+ ;; file notification support.
+ (funcall handler 'file-notify-rm-watch desc)
+
+ (funcall
+ (cond
+ ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch)
+ ((eq file-notify--library 'inotify) 'inotify-rm-watch)
+ ((eq file-notify--library 'w32notify) 'w32notify-rm-watch))
+ desc))
+ (file-notify-error nil)))
+
+ ;; Modify `file-notify-descriptors'.
+ (file-notify--rm-descriptor descriptor))))
+
+(defun file-notify-valid-p (descriptor)
+ "Check a watch specified by its DESCRIPTOR.
+DESCRIPTOR should be an object returned by `file-notify-add-watch'."
+ (let* ((desc (if (consp descriptor) (car descriptor) descriptor))
+ (file (if (consp descriptor) (cdr descriptor)))
+ (registered (gethash desc file-notify-descriptors))
+ (dir (car registered))
+ handler)
+
+ (when (stringp dir)
+ (setq handler (find-file-name-handler dir 'file-notify-valid-p))
+
+ (and (or ;; It is a directory.
+ (not file)
+ ;; The file is registered.
+ (assoc file (cdr registered)))
+ (if handler
+ ;; A file name handler could exist even if there is no
+ ;; local file notification support.
+ (funcall handler 'file-notify-valid-p descriptor)
+ (funcall
+ (cond
+ ((eq file-notify--library 'gfilenotify) 'gfile-valid-p)
+ ((eq file-notify--library 'inotify) 'inotify-valid-p)
+ ((eq file-notify--library 'w32notify) 'w32notify-valid-p))
+ desc))
+ t))))
;; The end:
(provide 'filenotify)
diff --git a/lisp/files-x.el b/lisp/files-x.el
index adc2b8b3bf3..a130ffcf928 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -1,9 +1,9 @@
;;; files-x.el --- extended file handling commands
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Package: emacs
@@ -247,7 +247,14 @@ then this function adds the first line containing the string
`Local Variables:' and the last line containing the string `End:'."
(interactive
(let ((variable (read-file-local-variable "Add file-local variable")))
+ ;; Error before reading value.
+ (if (equal variable 'lexical-binding)
+ (user-error "The `%s' variable must be set at the start of the file"
+ variable))
(list variable (read-file-local-variable-value variable) t)))
+ (if (equal variable 'lexical-binding)
+ (user-error "The `%s' variable must be set at the start of the file"
+ variable))
(modify-file-local-variable variable value 'add-or-replace interactive))
;;;###autoload
diff --git a/lisp/files.el b/lisp/files.el
index f9ff3c936bd..b25994c0c92 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,8 +1,8 @@
;;; files.el --- file input and output commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
@@ -55,7 +55,7 @@ FROM with TO when it appears in a directory name. This replacement is
done when setting up the default directory of a newly visited file.
FROM is matched against directory names anchored at the first
-character, so it should start with a \"\\\\`\", or, if directory
+character, so it should start with a \"\\\\\\=`\", or, if directory
names cannot have embedded newlines, with a \"^\".
FROM and TO should be equivalent names, which refer to the
@@ -96,9 +96,9 @@ The choice of renaming or copying is controlled by the variables
;; Do this so that local variables based on the file name
;; are not overridden by the major mode.
(defvar backup-inhibited nil
- "Non-nil means don't make a backup, regardless of the other parameters.
-This variable is intended for use by making it local to a buffer.
-But it is local only if you make it local.")
+ "If non-nil, backups will be inhibited.
+This variable is intended for use by making it local to a buffer,
+but it is not an automatically buffer-local variable.")
(put 'backup-inhibited 'permanent-local t)
(defcustom backup-by-copying nil
@@ -159,9 +159,11 @@ under another name, you get the existing buffer instead of a new buffer."
:group 'find-file)
(defcustom find-file-visit-truename nil
- "Non-nil means visit a file under its truename.
-The truename of a file is found by chasing all links
-both at the file level and at the levels of the containing directories."
+ "Non-nil means visiting a file uses its truename as the visited-file name.
+That is, the buffer visiting the file has the truename as the
+value of `buffer-file-name'. The truename of a file is found by
+chasing all links both at the file level and at the levels of the
+containing directories."
:type 'boolean
:group 'find-file)
(put 'find-file-visit-truename 'safe-local-variable 'booleanp)
@@ -248,10 +250,12 @@ See also: `break-hardlink-on-save'."
:group 'backup)
(defcustom break-hardlink-on-save nil
- "Non-nil means when saving a file that exists under several names
-\(i.e., has multiple hardlinks), break the hardlink associated with
-`buffer-file-name' and write to a new file, so that the other
-instances of the file are not affected by the save.
+ "Whether to allow breaking hardlinks when saving files.
+If non-nil, then when saving a file that exists under several
+names \(i.e., has multiple hardlinks), break the hardlink
+associated with `buffer-file-name' and write to a new file, so
+that the other instances of the file are not affected by the
+save.
If `buffer-file-name' refers to a symlink, do not break the symlink.
@@ -555,20 +559,12 @@ A value of nil means ignore them; anything else means query."
(other :tag "Query" other))
:group 'find-file)
-;; Avoid losing in versions where CLASH_DETECTION is disabled.
-(or (fboundp 'lock-buffer)
- (defalias 'lock-buffer 'ignore))
-(or (fboundp 'unlock-buffer)
- (defalias 'unlock-buffer 'ignore))
-(or (fboundp 'file-locked-p)
- (defalias 'file-locked-p 'ignore))
-
(defcustom view-read-only nil
"Non-nil means buffers visiting files read-only do so in view mode.
In fact, this means that all read-only buffers normally have
View mode enabled, including buffers that are read-only because
you visit a file you cannot alter, and buffers you make read-only
-using \\[toggle-read-only]."
+using \\[read-only-mode]."
:type 'boolean
:group 'view)
@@ -577,6 +573,12 @@ using \\[toggle-read-only]."
Maximum length of the history list is determined by the value
of `history-length', which see.")
+
+(defvar save-silently nil
+ "If non-nil, avoid messages when saving files.
+Error-related messages will still be printed, but all other
+messages will not.")
+
(put 'ange-ftp-completion-hook-function 'safe-magic t)
(defun ange-ftp-completion-hook-function (op &rest args)
@@ -652,10 +654,14 @@ the value of `default-directory'."
'file-directory-p))
-(defun pwd ()
- "Show the current default directory."
- (interactive nil)
- (message "Directory %s" default-directory))
+(defun pwd (&optional insert)
+ "Show the current default directory.
+With prefix argument INSERT, insert the current default directory
+at point instead."
+ (interactive "P")
+ (if insert
+ (insert default-directory)
+ (message "Directory %s" default-directory)))
(defvar cd-path nil
"Value of the CDPATH environment variable, as a list.
@@ -689,7 +695,7 @@ nil (meaning `default-directory') as the associated list element."
(if (file-exists-p dir)
(error "%s is not a directory" dir)
(error "%s: no such directory" dir))
- (unless (file-executable-p dir)
+ (unless (file-accessible-directory-p dir)
(error "Cannot cd to %s: Permission denied" dir))
(setq default-directory dir)
(setq list-buffers-directory dir)))
@@ -733,6 +739,39 @@ The path separator is colon in GNU and GNU-like systems."
(lambda (f) (and (file-directory-p f) 'dir-ok)))
(error "No such directory found via CDPATH environment variable"))))
+(defsubst directory-name-p (name)
+ "Return non-nil if NAME ends with a slash character."
+ (and (> (length name) 0)
+ (char-equal (aref name (1- (length name))) ?/)))
+
+(defun directory-files-recursively (dir match &optional include-directories)
+ "Return all files under DIR that have file names matching MATCH (a regexp).
+This function works recursively. Files are returned in \"depth first\"
+and alphabetical order.
+If INCLUDE-DIRECTORIES, also include directories that have matching names."
+ (let ((result nil)
+ (files nil)
+ ;; When DIR is "/", remote file names like "/method:" could
+ ;; also be offered. We shall suppress them.
+ (tramp-mode (and tramp-mode (file-remote-p dir))))
+ (dolist (file (sort (file-name-all-completions "" dir)
+ 'string<))
+ (unless (member file '("./" "../"))
+ (if (directory-name-p file)
+ (let* ((leaf (substring file 0 (1- (length file))))
+ (full-file (expand-file-name leaf dir)))
+ ;; Don't follow symlinks to other directories.
+ (unless (file-symlink-p full-file)
+ (setq result
+ (nconc result (directory-files-recursively
+ full-file match include-directories))))
+ (when (and include-directories
+ (string-match match leaf))
+ (setq result (nconc result (list full-file)))))
+ (when (string-match match file)
+ (push (expand-file-name file dir) files)))))
+ (nconc result (nreverse files))))
+
(defun load-file (file)
"Load the Lisp file named FILE."
;; This is a case where .elc makes a lot of sense.
@@ -743,8 +782,8 @@ The path separator is colon in GNU and GNU-like systems."
(defun locate-file (filename path &optional suffixes predicate)
"Search for FILENAME through PATH.
-If found, return the absolute file name of FILENAME, with its suffixes;
-otherwise return nil.
+If found, return the absolute file name of FILENAME; otherwise
+return nil.
PATH should be a list of directories to look in, like the lists in
`exec-path' or `load-path'.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
@@ -887,7 +926,7 @@ which we're looking."
;;
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /.
- (setq file (abbreviate-file-name file))
+ (setq file (abbreviate-file-name (expand-file-name file)))
(let ((root nil)
;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the
@@ -916,6 +955,53 @@ which we're looking."
(setq file nil))))
(if root (file-name-as-directory root))))
+(defcustom user-emacs-directory-warning t
+ "Non-nil means warn if cannot access `user-emacs-directory'.
+Set this to nil at your own risk..."
+ :type 'boolean
+ :group 'initialization
+ :version "24.4")
+
+(defun locate-user-emacs-file (new-name &optional old-name)
+ "Return an absolute per-user Emacs-specific file name.
+If NEW-NAME exists in `user-emacs-directory', return it.
+Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
+Else return NEW-NAME in `user-emacs-directory', creating the
+directory if it does not exist."
+ (convert-standard-filename
+ (let* ((home (concat "~" (or init-file-user "")))
+ (at-home (and old-name (expand-file-name old-name home)))
+ (bestname (abbreviate-file-name
+ (expand-file-name new-name user-emacs-directory))))
+ (if (and at-home (not (file-readable-p bestname))
+ (file-readable-p at-home))
+ at-home
+ ;; Make sure `user-emacs-directory' exists,
+ ;; unless we're in batch mode or dumping Emacs.
+ (or noninteractive
+ purify-flag
+ (let (errtype)
+ (if (file-directory-p user-emacs-directory)
+ (or (file-accessible-directory-p user-emacs-directory)
+ (setq errtype "access"))
+ (with-file-modes ?\700
+ (condition-case nil
+ (make-directory user-emacs-directory)
+ (error (setq errtype "create")))))
+ (when (and errtype
+ user-emacs-directory-warning
+ (not (get 'user-emacs-directory-warning 'this-session)))
+ ;; Only warn once per Emacs session.
+ (put 'user-emacs-directory-warning 'this-session t)
+ (display-warning 'initialization
+ (format "\
+Unable to %s `user-emacs-directory' (%s).
+Any data that would normally be written there may be lost!
+If you never want to see this message again,
+customize the variable `user-emacs-directory-warning'."
+ errtype user-emacs-directory)))))
+ bestname))))
+
(defun executable-find (command)
"Search for COMMAND in `exec-path' and return the absolute file name.
@@ -971,7 +1057,7 @@ Tip: You can use this expansion of remote identifier components
to derive a new remote file name from an existing one. For
example, if FILE is \"/sudo::/path/to/file\" then
- \(concat \(file-remote-p FILE) \"/bin/sh\")
+ (concat (file-remote-p FILE) \"/bin/sh\")
returns a remote file name for file \"/bin/sh\" that has the
same remote identifier as FILE but expanded; a name such as
@@ -1006,14 +1092,14 @@ Tip: You can use this expansion of remote identifier components
(defcustom remote-file-name-inhibit-cache 10
"Whether to use the remote file-name cache for read access.
-When `nil', never expire cached values (caution)
-When `t', never use the cache (safe, but may be slow)
+When nil, never expire cached values (caution)
+When t, never use the cache (safe, but may be slow)
A number means use cached values for that amount of seconds since caching.
The attributes of remote files are cached for better performance.
If they are changed outside of Emacs's control, the cached values
become invalid, and must be reread. If you are sure that nothing
-other than Emacs changes the files, you can set this variable to `nil'.
+other than Emacs changes the files, you can set this variable to nil.
If a remote file is checked regularly, it might be a good idea to
let-bind this variable to a value less than the interval between
@@ -1116,7 +1202,7 @@ containing it, until no links are left at any level.
(setq dirfile (directory-file-name dir))
;; If these are equal, we have the (or a) root directory.
(or (string= dir dirfile)
- (and (memq system-type '(windows-nt ms-dos cygwin))
+ (and (memq system-type '(windows-nt ms-dos cygwin nacl))
(eq (compare-strings dir 0 nil dirfile 0 nil t) t))
;; If this is the same dir we last got the truename for,
;; save time--don't recalculate.
@@ -1226,36 +1312,31 @@ You can then use `write-region' to write new data into the file.
If DIR-FLAG is non-nil, create a new empty directory instead of a file.
If SUFFIX is non-nil, add that at the end of the file name."
- (let ((umask (default-file-modes))
- file)
- (unwind-protect
- (progn
- ;; 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.
- (set-default-file-modes ?\700)
- (while (condition-case ()
- (progn
- (setq file
- (make-temp-name
- (if (zerop (length prefix))
- (file-name-as-directory
- temporary-file-directory)
- (expand-file-name prefix
- temporary-file-directory))))
- (if suffix
- (setq file (concat file suffix)))
- (if dir-flag
- (make-directory file)
- (write-region "" nil file nil 'silent nil 'excl))
- nil)
- (file-already-exists t))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- file)
- ;; Reset the umask.
- (set-default-file-modes umask))))
+ ;; 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.
+ (with-file-modes ?\700
+ (let (file)
+ (while (condition-case ()
+ (progn
+ (setq file
+ (make-temp-name
+ (if (zerop (length prefix))
+ (file-name-as-directory
+ temporary-file-directory)
+ (expand-file-name prefix
+ temporary-file-directory))))
+ (if suffix
+ (setq file (concat file suffix)))
+ (if dir-flag
+ (make-directory file)
+ (write-region "" nil file nil 'silent nil 'excl))
+ nil)
+ (file-already-exists t))
+ ;; the file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ file)))
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
@@ -1337,6 +1418,9 @@ return value, which may be passed as the REQUIRE-MATCH arg to
(defmacro minibuffer-with-setup-hook (fun &rest body)
"Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
+FUN can also be (:append FUN1), in which case FUN1 is appended to
+`minibuffer-setup-hook'.
+
BODY should use the minibuffer at most once.
Recursive uses of the minibuffer are unaffected (FUN is not
called additional times).
@@ -1344,19 +1428,24 @@ called additional times).
This macro actually adds an auxiliary function that calls FUN,
rather than FUN itself, to `minibuffer-setup-hook'."
(declare (indent 1) (debug t))
- (let ((hook (make-symbol "setup-hook")))
- `(let (,hook)
+ (let ((hook (make-symbol "setup-hook"))
+ (funsym (make-symbol "fun"))
+ (append nil))
+ (when (eq (car-safe fun) :append)
+ (setq append '(t) fun (cadr fun)))
+ `(let ((,funsym ,fun)
+ ,hook)
(setq ,hook
- (lambda ()
- ;; Clear out this hook so it does not interfere
- ;; with any recursive minibuffer usage.
- (remove-hook 'minibuffer-setup-hook ,hook)
- (funcall ,fun)))
+ (lambda ()
+ ;; Clear out this hook so it does not interfere
+ ;; with any recursive minibuffer usage.
+ (remove-hook 'minibuffer-setup-hook ,hook)
+ (funcall ,funsym)))
(unwind-protect
- (progn
- (add-hook 'minibuffer-setup-hook ,hook)
- ,@body)
- (remove-hook 'minibuffer-setup-hook ,hook)))))
+ (progn
+ (add-hook 'minibuffer-setup-hook ,hook ,@append)
+ ,@body)
+ (remove-hook 'minibuffer-setup-hook ,hook)))))
(defun find-file-read-args (prompt mustmatch)
(list (read-file-name prompt nil default-directory mustmatch)
@@ -1374,7 +1463,7 @@ You can visit files on remote machines by specifying something
like /ssh:SOME_REMOTE_MACHINE:FILE for the file name. You can
also visit local files as a different user by specifying
/sudo::FILE for the file name.
-See the Info node `(tramp)Filename Syntax' in the Tramp Info
+See the Info node `(tramp)File name Syntax' in the Tramp Info
manual, for more about this.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
@@ -1410,8 +1499,9 @@ expand wildcards (if any) and visit multiple files."
(if (listp value)
(progn
(setq value (nreverse value))
- (cons (switch-to-buffer-other-window (car value))
- (mapcar 'switch-to-buffer (cdr value))))
+ (switch-to-buffer-other-window (car value))
+ (mapc 'switch-to-buffer (cdr value))
+ value)
(switch-to-buffer-other-window value))))
(defun find-file-other-frame (filename &optional wildcards)
@@ -1433,8 +1523,9 @@ expand wildcards (if any) and visit multiple files."
(if (listp value)
(progn
(setq value (nreverse value))
- (cons (switch-to-buffer-other-frame (car value))
- (mapcar 'switch-to-buffer (cdr value))))
+ (switch-to-buffer-other-frame (car value))
+ (mapc 'switch-to-buffer (cdr value))
+ value)
(switch-to-buffer-other-frame value))))
(defun find-file-existing (filename)
@@ -1462,7 +1553,7 @@ file names with wildcards."
(defun find-file-read-only (filename &optional wildcards)
"Edit file FILENAME but don't allow changes.
Like \\[find-file], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
+Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only: "
(confirm-nonexistent-file-or-buffer)))
@@ -1471,7 +1562,7 @@ Use \\[toggle-read-only] to permit editing."
(defun find-file-read-only-other-window (filename &optional wildcards)
"Edit file FILENAME in another window but don't allow changes.
Like \\[find-file-other-window], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
+Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only other window: "
(confirm-nonexistent-file-or-buffer)))
@@ -1480,7 +1571,7 @@ Use \\[toggle-read-only] to permit editing."
(defun find-file-read-only-other-frame (filename &optional wildcards)
"Edit file FILENAME in another frame but don't allow changes.
Like \\[find-file-other-frame], but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
+Use \\[read-only-mode] to permit editing."
(interactive
(find-file-read-args "Find file read-only other frame: "
(confirm-nonexistent-file-or-buffer)))
@@ -1547,10 +1638,12 @@ killed."
(confirm-nonexistent-file-or-buffer) file-name)
t)))
(unless (run-hook-with-args-until-failure 'kill-buffer-query-functions)
- (error "Aborted"))
+ (user-error "Aborted"))
(and (buffer-modified-p) buffer-file-name
- (not (yes-or-no-p "Kill and replace the buffer without saving it? "))
- (error "Aborted"))
+ (not (yes-or-no-p
+ (format-message "Kill and replace buffer `%s' without saving it? "
+ (buffer-name))))
+ (user-error "Aborted"))
(let ((obuf (current-buffer))
(ofile buffer-file-name)
(onum buffer-file-number)
@@ -1599,6 +1692,8 @@ killed."
(let (kill-buffer-query-functions kill-buffer-hook)
(kill-buffer obuf))))))
+;; FIXME we really need to fold the uniquify stuff in here by default,
+;; not using advice, and add it to the doc string.
(defun create-file-buffer (filename)
"Create a suitably named buffer for visiting FILENAME, and return it.
FILENAME (sans directory) is used unchanged if that name is free;
@@ -1744,6 +1839,15 @@ When nil, never request confirmation."
:version "22.1"
:type '(choice integer (const :tag "Never request confirmation" nil)))
+(defcustom out-of-memory-warning-percentage nil
+ "Warn if file size exceeds this percentage of available free memory.
+When nil, never issue warning. Beware: This probably doesn't do what you
+think it does, because \"free\" is pretty hard to define in practice."
+ :group 'files
+ :group 'find-file
+ :version "25.1"
+ :type '(choice integer (const :tag "Never issue warning" nil)))
+
(defun abort-if-file-too-large (size op-type filename)
"If file SIZE larger than `large-file-warning-threshold', allow user to abort.
OP-TYPE specifies the file operation being performed (for message to user)."
@@ -1752,7 +1856,33 @@ OP-TYPE specifies the file operation being performed (for message to user)."
(not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
(file-size-human-readable size) op-type))))
- (error "Aborted")))
+ (user-error "Aborted")))
+
+(defun warn-maybe-out-of-memory (size)
+ "Warn if an attempt to open file of SIZE bytes may run out of memory."
+ (when (and (numberp size) (not (zerop size))
+ (integerp out-of-memory-warning-percentage))
+ (let ((meminfo (memory-info)))
+ (when (consp meminfo)
+ (let ((total-free-memory (float (+ (nth 1 meminfo) (nth 3 meminfo)))))
+ (when (> (/ size 1024)
+ (/ (* total-free-memory out-of-memory-warning-percentage)
+ 100.0))
+ (warn
+ "You are trying to open a file whose size (%s)
+exceeds the %S%% of currently available free memory (%s).
+If that fails, try to open it with `find-file-literally'
+\(but note that some characters might be displayed incorrectly)."
+ (file-size-human-readable size)
+ out-of-memory-warning-percentage
+ (file-size-human-readable (* total-free-memory 1024)))))))))
+
+(defun files--message (format &rest args)
+ "Like `message', except sometimes don't print to minibuffer.
+If the variable `save-silently' is non-nil, the message is not
+displayed on the minibuffer."
+ (apply #'message format args)
+ (when save-silently (message nil)))
(defun find-file-noselect (filename &optional nowarn rawfile wildcards)
"Read file FILENAME into a buffer and return the buffer.
@@ -1799,14 +1929,15 @@ the various files."
(or nowarn
find-file-suppress-same-file-warnings
(string-equal filename (buffer-file-name other))
- (message "%s and %s are the same file"
- filename (buffer-file-name other)))
+ (files--message "%s and %s are the same file"
+ filename (buffer-file-name other)))
;; Optionally also find that buffer.
(if (or find-file-existing-other-name find-file-visit-truename)
(setq buf other))))
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
- (abort-if-file-too-large (nth 7 attributes) "open" filename))
+ (abort-if-file-too-large (nth 7 attributes) "open" filename)
+ (warn-maybe-out-of-memory (nth 7 attributes)))
(if buf
;; We are using an existing buffer.
(let (nonexistent)
@@ -1855,10 +1986,12 @@ the various files."
(eq read-only buffer-file-read-only)
(eq read-only buffer-read-only))
(when (or nowarn
- (let ((question
- (format "File %s is %s on disk. Change buffer mode? "
- buffer-file-name
- (if read-only "read-only" "writable"))))
+ (let* ((new-status
+ (if read-only "read-only" "writable"))
+ (question
+ (format "File %s is %s on disk. Make buffer %s, too? "
+ buffer-file-name
+ new-status new-status)))
(y-or-n-p question)))
(setq buffer-read-only read-only)))
(setq buffer-file-read-only read-only))
@@ -1996,7 +2129,7 @@ Do you want to revisit the file normally now? ")
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', but only reads in the file literally.
A buffer may be modified in several ways after reading into the buffer,
-to Emacs features such as format decoding, character code
+due to Emacs features such as format decoding, character code
conversion, `find-file-hook', automatic uncompression, etc.
This function ensures that none of these modifications will take place."
@@ -2014,7 +2147,7 @@ This function ensures that none of these modifications will take place."
(defun insert-file-1 (filename insert-func)
(if (file-directory-p filename)
- (signal 'file-error (list "Opening input file" "file is a directory"
+ (signal 'file-error (list "Opening input file" "Is a directory"
filename)))
;; Check whether the file is uncommonly large
(abort-if-file-too-large (nth 7 (file-attributes filename)) "insert" filename)
@@ -2032,6 +2165,7 @@ This function ensures that none of these modifications will take place."
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents-literally' instead.
\(Its calling sequence is different; see its documentation)."
+ (declare (interactive-only insert-file-contents-literally))
(interactive "*fInsert file literally: ")
(insert-file-1 filename #'insert-file-contents-literally))
@@ -2269,11 +2403,15 @@ since only a single case-insensitive search through the alist is made."
;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files
;; don't interfere with each other.
("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode)
+ ;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file
+ ;; named 'emacs-gdb.gdb', if it exists, will be automatically
+ ;; loaded when GDB reads an objfile called 'emacs'.
+ ("-gdb\\.gdb" . gdb-script-mode)
("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode)
("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
("\\.scm\\.[0-9]*\\'" . scheme-mode)
- ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
+ ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
("\\.bash\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
@@ -2329,17 +2467,16 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.dbk\\'" . xml-mode)
("\\.dtd\\'" . sgml-mode)
("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
- ("\\.js\\'" . javascript-mode)
+ ("\\.jsm?\\'" . javascript-mode)
("\\.json\\'" . javascript-mode)
("\\.[ds]?vh?\\'" . verilog-mode)
("\\.by\\'" . bovine-grammar-mode)
("\\.wy\\'" . wisent-grammar-mode)
;; .emacs or .gnus or .viper following a directory delimiter in
- ;; Unix, MSDOG or VMS syntax.
- ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
+ ;; Unix or MS-DOS syntax.
+ ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
("\\`\\..*emacs\\'" . emacs-lisp-mode)
- ;; _emacs following a directory delimiter
- ;; in MsDos syntax
+ ;; _emacs following a directory delimiter in MS-DOS syntax
("[:/]_emacs\\'" . emacs-lisp-mode)
("/crontab\\.X*[0-9]+\\'" . shell-script-mode)
("\\.ml\\'" . lisp-mode)
@@ -2362,7 +2499,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode)
("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode)
("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode)
- ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG
+ ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS
("\\.[eE]?[pP][sS]\\'" . ps-mode)
("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe)
("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode)
@@ -2388,12 +2525,12 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode)
;; this has lower priority to avoid matching changelog.sgml etc.
("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
;; either user's dot-files or under /etc or some such
- ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
+ ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
;; alas not all ~/.*rc files are like this
("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode)
("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode)
("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode)
- ("/X11.+app-defaults/" . conf-xdefaults-mode)
+ ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode)
("/X11.+locale/.+/Compose\\'" . conf-colon-mode)
;; this contains everything twice, with space and with colon :-(
("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode)
@@ -2447,35 +2584,23 @@ and `magic-mode-alist', which determines modes based on file contents.")
(mapcar
(lambda (l)
(cons (purecopy (car l)) (cdr l)))
- '(("perl" . perl-mode)
- ("perl5" . perl-mode)
- ("miniperl" . perl-mode)
- ("wish" . tcl-mode)
- ("wishx" . tcl-mode)
- ("tcl" . tcl-mode)
- ("tclsh" . tcl-mode)
+ '(("\\(mini\\)?perl5?" . perl-mode)
+ ("wishx?" . tcl-mode)
+ ("tcl\\(sh\\)?" . tcl-mode)
("expect" . tcl-mode)
+ ("octave" . octave-mode)
("scm" . scheme-mode)
- ("ash" . sh-mode)
- ("bash" . sh-mode)
- ("bash2" . sh-mode)
- ("csh" . sh-mode)
- ("dtksh" . sh-mode)
+ ("[acjkwz]sh" . sh-mode)
+ ("r?bash2?" . sh-mode)
+ ("dash" . sh-mode)
+ ("mksh" . sh-mode)
+ ("\\(dt\\|pd\\|w\\)ksh" . sh-mode)
("es" . sh-mode)
- ("itcsh" . sh-mode)
- ("jsh" . sh-mode)
- ("ksh" . sh-mode)
+ ("i?tcsh" . sh-mode)
("oash" . sh-mode)
- ("pdksh" . sh-mode)
- ("rbash" . sh-mode)
("rc" . sh-mode)
("rpm" . sh-mode)
- ("sh" . sh-mode)
- ("sh5" . sh-mode)
- ("tcsh" . sh-mode)
- ("wksh" . sh-mode)
- ("wsh" . sh-mode)
- ("zsh" . sh-mode)
+ ("sh5?" . sh-mode)
("tail" . text-mode)
("more" . text-mode)
("less" . text-mode)
@@ -2486,9 +2611,10 @@ and `magic-mode-alist', which determines modes based on file contents.")
("emacs" . emacs-lisp-mode)))
"Alist mapping interpreter names to major modes.
This is used for files whose first lines match `auto-mode-interpreter-regexp'.
-Each element looks like (INTERPRETER . MODE).
-If INTERPRETER matches the name of the interpreter specified in the first line
-of a script, mode MODE is enabled.
+Each element looks like (REGEXP . MODE).
+If REGEXP matches the entire name (minus any directory part) of
+the interpreter specified in the first line of a script, enable
+major mode MODE.
See also `auto-mode-alist'.")
@@ -2683,19 +2809,23 @@ we don't actually set it to the same mode the buffer already has."
;; If we didn't, look for an interpreter specified in the first line.
;; As a special case, allow for things like "#!/bin/env perl", which
;; finds the interpreter anywhere in $PATH.
- (unless done
- (setq mode (save-excursion
- (goto-char (point-min))
- (if (looking-at auto-mode-interpreter-regexp)
- (match-string 2)
- ""))
- ;; Map interpreter name to a mode, signaling we're done at the
- ;; same time.
- done (assoc (file-name-nondirectory mode)
- interpreter-mode-alist))
- ;; If we found an interpreter mode to use, invoke it now.
- (if done
- (set-auto-mode-0 (cdr done) keep-mode-if-same)))
+ (and (not done)
+ (setq mode (save-excursion
+ (goto-char (point-min))
+ (if (looking-at auto-mode-interpreter-regexp)
+ (match-string 2))))
+ ;; Map interpreter name to a mode, signaling we're done at the
+ ;; same time.
+ (setq done (assoc-default
+ (file-name-nondirectory mode)
+ (mapcar (lambda (e)
+ (cons
+ (format "\\`%s\\'" (car e))
+ (cdr e)))
+ interpreter-mode-alist)
+ #'string-match-p))
+ ;; If we found an interpreter mode to use, invoke it now.
+ (set-auto-mode-0 done keep-mode-if-same))
;; Next try matching the buffer beginning against magic-mode-alist.
(unless done
(if (setq done (save-excursion
@@ -3159,6 +3289,9 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil."
(assq-delete-all (car elt) file-local-variables-alist)))
(push elt file-local-variables-alist)))))
+;; TODO? Warn once per file rather than once per session?
+(defvar hack-local-variables--warned-lexical nil)
+
(defun hack-local-variables (&optional mode-only)
"Parse and put into effect this buffer's local variables spec.
Uses `hack-local-variables-apply' to apply the variables.
@@ -3248,7 +3381,7 @@ local variables, but directory-local variables may still be applied."
(error "Local variables entry is missing the prefix"))
(end-of-line)
;; Discard the suffix.
- (if (looking-back suffix)
+ (if (looking-back suffix (line-beginning-position))
(delete-region (match-beginning 0) (point))
(error "Local variables entry is missing the suffix"))
(forward-line 1))
@@ -3280,13 +3413,22 @@ local variables, but directory-local variables may still be applied."
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
(setq result (intern (concat val2 "-mode"))))
- (unless (eq var 'coding)
- (condition-case nil
- (push (cons (if (eq var 'eval)
- 'eval
- (indirect-variable var))
- val) result)
- (error nil)))))
+ (cond ((eq var 'coding))
+ ((eq var 'lexical-binding)
+ (unless hack-local-variables--warned-lexical
+ (setq hack-local-variables--warned-lexical t)
+ (display-warning
+ :warning
+ (format-message
+ "%s: `lexical-binding' at end of file unreliable"
+ (file-name-nondirectory
+ (or buffer-file-name ""))))))
+ (t
+ (ignore-errors
+ (push (cons (if (eq var 'eval)
+ 'eval
+ (indirect-variable var))
+ val) result))))))
(forward-line 1))))))))
;; Now we've read all the local variables.
;; If MODE-ONLY is non-nil, return whether the mode was specified.
@@ -3413,8 +3555,9 @@ It is dangerous if either of these conditions are met:
(since (nth 2 o)))
(message "%s is obsolete%s; %s"
var (if since (format " (since %s)" since))
- (if (stringp instead) instead
- (format "use `%s' instead" instead)))))))
+ (if (stringp instead)
+ (substitute-command-keys instead)
+ (format-message "use `%s' instead" instead)))))))
(defun hack-one-local-variable (var val)
"Set local variable VAR with value VAL.
@@ -3480,7 +3623,9 @@ Returns the new list."
"Collect entries from CLASS-VARIABLES into VARIABLES.
ROOT is the root directory of the project.
Return the new variables list."
- (let* ((file-name (buffer-file-name))
+ (let* ((file-name (or (buffer-file-name)
+ ;; Handle non-file buffers, too.
+ (expand-file-name default-directory)))
(sub-file-name (if file-name
;; FIXME: Why not use file-relative-name?
(substring file-name (length root)))))
@@ -3562,10 +3707,7 @@ VARIABLES list of the class. The list is processed in order.
* If the element is of the form (DIRECTORY . LIST), and DIRECTORY
is an initial substring of the file's directory, then LIST is
applied by recursively following these rules."
- (let ((elt (assq class dir-locals-class-alist)))
- (if elt
- (setcdr elt variables)
- (push (cons class variables) dir-locals-class-alist))))
+ (setf (alist-get class dir-locals-class-alist) variables))
(defconst dir-locals-file ".dir-locals.el"
"File that contains directory-local variables.
@@ -3608,10 +3750,9 @@ of no valid cache entry."
;;; (setq locals-file nil))
;; Find the best cached value in `dir-locals-directory-cache'.
(dolist (elt dir-locals-directory-cache)
- (when (and (eq t (compare-strings file nil (length (car elt))
- (car elt) nil nil
- (memq system-type
- '(windows-nt cygwin ms-dos))))
+ (when (and (string-prefix-p (car elt) file
+ (memq system-type
+ '(windows-nt cygwin ms-dos)))
(> (length (car elt)) (length (car dir-elt))))
(setq dir-elt elt)))
(if (and dir-elt
@@ -3647,21 +3788,17 @@ FILE is the name of the file holding the variables to apply.
The new class name is the same as the directory in which FILE
is found. Returns the new class name."
(with-temp-buffer
- ;; This is with-demoted-errors, but we want to mention dir-locals
- ;; in any error message.
- (condition-case err
- (progn
- (insert-file-contents file)
- (unless (zerop (buffer-size))
- (let* ((dir-name (file-name-directory file))
- (class-name (intern dir-name))
- (variables (let ((read-circle nil))
- (read (current-buffer)))))
- (dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class dir-name class-name
- (nth 5 (file-attributes file)))
- class-name)))
- (error (message "Error reading dir-locals: %S" err) nil))))
+ (with-demoted-errors "Error reading dir-locals: %S"
+ (insert-file-contents file)
+ (unless (zerop (buffer-size))
+ (let* ((dir-name (file-name-directory file))
+ (class-name (intern dir-name))
+ (variables (let ((read-circle nil))
+ (read (current-buffer)))))
+ (dir-locals-set-class-variables class-name variables)
+ (dir-locals-set-directory-class dir-name class-name
+ (nth 5 (file-attributes file)))
+ class-name)))))
(defcustom enable-remote-dir-locals nil
"Non-nil means dir-local variables will be applied to remote files."
@@ -3726,7 +3863,7 @@ directories."
However, the mode will not be changed if
\(1) a local variables list or the `-*-' line specifies a major mode, or
\(2) the current major mode is a \"special\" mode,
-\ not suitable for ordinary files, or
+ not suitable for ordinary files, or
\(3) the new file name does not particularly specify any mode."
:type 'boolean
:group 'editing-basics)
@@ -3767,7 +3904,7 @@ the old visited file has been renamed to the new name FILENAME."
(not no-query)
(not (y-or-n-p (format "A buffer is visiting %s; proceed? "
filename)))
- (error "Aborted")))
+ (user-error "Aborted")))
(or (equal filename buffer-file-name)
(progn
(and filename (lock-buffer filename))
@@ -3815,17 +3952,19 @@ the old visited file has been renamed to the new name FILENAME."
(make-local-variable 'backup-inhibited)
(setq backup-inhibited t)))
(let ((oauto buffer-auto-save-file-name))
- ;; If auto-save was not already on, turn it on if appropriate.
- (if (not buffer-auto-save-file-name)
- (and buffer-file-name auto-save-default
- (auto-save-mode t))
- ;; If auto save is on, start using a new name.
- ;; We deliberately don't rename or delete the old auto save
- ;; for the old visited file name. This is because perhaps
- ;; the user wants to save the new state and then compare with the
- ;; previous state from the auto save file.
- (setq buffer-auto-save-file-name
- (make-auto-save-file-name)))
+ (cond ((null filename)
+ (setq buffer-auto-save-file-name nil))
+ ((not buffer-auto-save-file-name)
+ ;; If auto-save was not already on, turn it on if appropriate.
+ (and buffer-file-name auto-save-default (auto-save-mode t)))
+ (t
+ ;; If auto save is on, start using a new name. We
+ ;; deliberately don't rename or delete the old auto save
+ ;; for the old visited file name. This is because
+ ;; perhaps the user wants to save the new state and then
+ ;; compare with the previous state from the auto save
+ ;; file.
+ (setq buffer-auto-save-file-name (make-auto-save-file-name))))
;; Rename the old auto save file if any.
(and oauto buffer-auto-save-file-name
(file-exists-p oauto)
@@ -3890,8 +4029,9 @@ Interactively, confirmation is required unless you supply a prefix argument."
(not (and (eq (framep-on-display) 'ns)
(listp last-nonmenu-event)
use-dialog-box))
- (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
- (error "Canceled")))
+ (or (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " filename))
+ (user-error "Canceled")))
(set-visited-file-name filename (not confirm))))
(set-buffer-modified-p t)
;; Make buffer writable if file is writable.
@@ -3901,7 +4041,7 @@ Interactively, confirmation is required unless you supply a prefix argument."
(save-buffer)
;; It's likely that the VC status at the new location is different from
;; the one at the old location.
- (vc-find-file-hook))
+ (vc-refresh-state))
(defun file-extended-attributes (filename)
"Return an alist of extended attributes of file FILENAME.
@@ -3915,14 +4055,19 @@ such as SELinux context, list of ACL entries, etc."
"Set extended attributes of file FILENAME to ATTRIBUTES.
ATTRIBUTES must be an alist of file attributes as returned by
-`file-extended-attributes'."
- (dolist (elt attributes)
- (let ((attr (car elt))
- (val (cdr elt)))
- (cond ((eq attr 'acl)
- (set-file-acl filename val))
- ((eq attr 'selinux-context)
- (set-file-selinux-context filename val))))))
+`file-extended-attributes'.
+Value is t if the function succeeds in setting the attributes."
+ (let (result rv)
+ (dolist (elt attributes)
+ (let ((attr (car elt))
+ (val (cdr elt)))
+ (cond ((eq attr 'acl)
+ (setq rv (set-file-acl filename val)))
+ ((eq attr 'selinux-context)
+ (setq rv (set-file-selinux-context filename val))))
+ (setq result (or result rv))))
+
+ result))
(defun backup-buffer ()
"Make a backup of the disk file visited by the current buffer, if appropriate.
@@ -3942,107 +4087,97 @@ on the original file; this means that the caller, after saving
the buffer, should change the extended attributes of the new file
to agree with the old attributes.
BACKUPNAME is the backup file name, which is the old file renamed."
- (if (and make-backup-files (not backup-inhibited)
- (not buffer-backed-up)
- (file-exists-p buffer-file-name)
- (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
- '(?- ?l)))
- (let ((real-file-name buffer-file-name)
- backup-info backupname targets setmodes)
+ (when (and make-backup-files (not backup-inhibited) (not buffer-backed-up))
+ (let ((attributes (file-attributes buffer-file-name)))
+ (when (and attributes (memq (aref (elt attributes 8) 0) '(?- ?l)))
;; If specified name is a symbolic link, chase it to the target.
- ;; Thus we make the backups in the directory where the real file is.
- (setq real-file-name (file-chase-links real-file-name))
- (setq backup-info (find-backup-file-name real-file-name)
- backupname (car backup-info)
- targets (cdr backup-info))
- ;; (if (file-directory-p buffer-file-name)
- ;; (error "Cannot save buffer in directory %s" buffer-file-name))
- (if backup-info
- (condition-case ()
- (let ((delete-old-versions
- ;; If have old versions to maybe delete,
- ;; ask the user to confirm now, before doing anything.
- ;; But don't actually delete til later.
- (and targets
- (or (eq delete-old-versions t) (eq delete-old-versions nil))
- (or delete-old-versions
- (y-or-n-p (format "Delete excess backup versions of %s? "
- real-file-name)))))
- (modes (file-modes buffer-file-name))
- (extended-attributes
- (file-extended-attributes buffer-file-name)))
- ;; Actually write the back up file.
- (condition-case ()
- (if (or file-precious-flag
- ; (file-symlink-p buffer-file-name)
- backup-by-copying
- ;; Don't rename a suid or sgid file.
- (and modes (< 0 (logand modes #o6000)))
- (not (file-writable-p (file-name-directory real-file-name)))
- (and backup-by-copying-when-linked
- (> (file-nlinks real-file-name) 1))
- (and (or backup-by-copying-when-mismatch
- (integerp backup-by-copying-when-privileged-mismatch))
- (let ((attr (file-attributes real-file-name)))
- (and (or backup-by-copying-when-mismatch
- (and (integerp (nth 2 attr))
- (integerp backup-by-copying-when-privileged-mismatch)
- (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch)))
- (not (file-ownership-preserved-p
- real-file-name t))))))
- (backup-buffer-copy real-file-name
- backupname modes
- extended-attributes)
- ;; rename-file should delete old backup.
- (rename-file real-file-name backupname t)
- (setq setmodes (list modes extended-attributes
- backupname)))
- (file-error
- ;; If trouble writing the backup, write it in
- ;; .emacs.d/%backup%.
- (setq backupname (locate-user-emacs-file "%backup%~"))
- (message "Cannot write backup file; backing up in %s"
- backupname)
- (sleep-for 1)
- (backup-buffer-copy real-file-name backupname
- modes extended-attributes)))
- (setq buffer-backed-up t)
- ;; Now delete the old versions, if desired.
- (if delete-old-versions
- (while targets
- (condition-case ()
- (delete-file (car targets))
- (file-error nil))
- (setq targets (cdr targets))))
- setmodes)
- (file-error nil))))))
+ ;; This makes backups in the directory where the real file is.
+ (let* ((real-file-name (file-chase-links buffer-file-name))
+ (backup-info (find-backup-file-name real-file-name)))
+ (when backup-info
+ (let* ((backupname (car backup-info))
+ (targets (cdr backup-info))
+ (old-versions
+ ;; If have old versions to maybe delete,
+ ;; ask the user to confirm now, before doing anything.
+ ;; But don't actually delete til later.
+ (and targets
+ (booleanp delete-old-versions)
+ (or delete-old-versions
+ (y-or-n-p
+ (format "Delete excess backup versions of %s? "
+ real-file-name)))
+ targets))
+ (modes (file-modes buffer-file-name))
+ (extended-attributes
+ (file-extended-attributes buffer-file-name))
+ (copy-when-priv-mismatch
+ backup-by-copying-when-privileged-mismatch)
+ (make-copy
+ (or file-precious-flag backup-by-copying
+ ;; Don't rename a suid or sgid file.
+ (and modes (< 0 (logand modes #o6000)))
+ (not (file-writable-p
+ (file-name-directory real-file-name)))
+ (and backup-by-copying-when-linked
+ (< 1 (file-nlinks real-file-name)))
+ (and (or backup-by-copying-when-mismatch
+ (and (integerp copy-when-priv-mismatch)
+ (let ((attr (file-attributes
+ real-file-name
+ 'integer)))
+ (<= (nth 2 attr)
+ copy-when-priv-mismatch))))
+ (not (file-ownership-preserved-p real-file-name
+ t)))))
+ setmodes)
+ (condition-case ()
+ (progn
+ ;; Actually make the backup file.
+ (if make-copy
+ (backup-buffer-copy real-file-name backupname
+ modes extended-attributes)
+ ;; rename-file should delete old backup.
+ (rename-file real-file-name backupname t)
+ (setq setmodes (list modes extended-attributes
+ backupname)))
+ (setq buffer-backed-up t)
+ ;; Now delete the old versions, if desired.
+ (dolist (old-version old-versions)
+ (delete-file old-version)))
+ (file-error nil))
+ ;; If trouble writing the backup, write it in .emacs.d/%backup%.
+ (when (not buffer-backed-up)
+ (setq backupname (locate-user-emacs-file "%backup%~"))
+ (message "Cannot write backup file; backing up in %s"
+ backupname)
+ (sleep-for 1)
+ (backup-buffer-copy real-file-name backupname
+ modes extended-attributes)
+ (setq buffer-backed-up t))
+ setmodes)))))))
(defun backup-buffer-copy (from-name to-name modes extended-attributes)
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- ;; 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.
- (set-default-file-modes ?\700)
- (when (condition-case nil
- ;; Try to overwrite old backup first.
- (copy-file from-name to-name t t t)
- (error t))
- (while (condition-case nil
- (progn
- (when (file-exists-p to-name)
- (delete-file to-name))
- (copy-file from-name to-name nil t t)
- nil)
- (file-already-exists t))
- ;; The file was somehow created by someone else between
- ;; `delete-file' and `copy-file', so let's try again.
- ;; rms says "I think there is also a possible race
- ;; condition for making backup files" (emacs-devel 20070821).
- nil)))
- ;; Reset the umask.
- (set-default-file-modes umask)))
+ ;; 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.
+ (with-file-modes ?\700
+ (when (condition-case nil
+ ;; Try to overwrite old backup first.
+ (copy-file from-name to-name t t t)
+ (error t))
+ (while (condition-case nil
+ (progn
+ (when (file-exists-p to-name)
+ (delete-file to-name))
+ (copy-file from-name to-name nil t t)
+ nil)
+ (file-already-exists t))
+ ;; The file was somehow created by someone else between
+ ;; `delete-file' and `copy-file', so let's try again.
+ ;; rms says "I think there is also a possible race
+ ;; condition for making backup files" (emacs-devel 20070821).
+ nil)))
;; If set-file-extended-attributes fails, fall back on set-file-modes.
(unless (and extended-attributes
(with-demoted-errors
@@ -4154,15 +4289,22 @@ FILENAME defaults to `buffer-file-name'."
(defcustom make-backup-file-name-function
#'make-backup-file-name--default-function
- "A function to use instead of the default `make-backup-file-name'.
+ "A function that `make-backup-file-name' uses to create backup file names.
+The function receives a single argument, the original file name.
+
+If you change this, you may need to change `backup-file-name-p' and
+`file-name-sans-versions' too.
+
+You could make this buffer-local to do something special for specific files.
-This could be buffer-local to do something special for specific
-files. If you define it, you may need to change `backup-file-name-p'
-and `file-name-sans-versions' too.
+For historical reasons, a value of nil means to use the default function.
+This should not be relied upon.
See also `backup-directory-alist'."
+ :version "24.4" ; nil -> make-backup-file-name--default-function
:group 'backup
- :type '(function :tag "Your function"))
+ :type '(choice (const :tag "Deprecated way to get the default function" nil)
+ (function :tag "Function")))
(defcustom backup-directory-alist nil
"Alist of filename patterns and backup directory names.
@@ -4219,20 +4361,17 @@ Checks for files in `temporary-file-directory',
(defun make-backup-file-name (file)
"Create the non-numeric backup file name for FILE.
-Normally this will just be the file's name with `~' appended.
-Customization hooks are provided as follows.
-
-The value of `make-backup-file-name-function' should be a function which
-will be called with FILE as its argument; the resulting name is used.
-
-By default, a match for FILE is sought in `backup-directory-alist'; see
-the documentation of that variable. If the directory for the backup
-doesn't exist, it is created."
+This calls the function that `make-backup-file-name-function' specifies,
+with a single argument FILE."
(funcall (or make-backup-file-name-function
#'make-backup-file-name--default-function)
file))
(defun make-backup-file-name--default-function (file)
+ "Default function for `make-backup-file-name'.
+Normally this just returns FILE's name with `~' appended.
+It searches for a match for FILE in `backup-directory-alist'.
+If the directory for the backup doesn't exist, it is created."
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
(let ((fn (file-name-nondirectory file)))
@@ -4244,7 +4383,8 @@ doesn't exist, it is created."
(concat (make-backup-file-name-1 file) "~")))
(defun make-backup-file-name-1 (file)
- "Subroutine of `make-backup-file-name' and `find-backup-file-name'."
+ "Subroutine of `make-backup-file-name--default-function'.
+The function `find-backup-file-name' also uses this."
(let ((alist backup-directory-alist)
elt backup-directory abs-backup-directory)
(while alist
@@ -4321,8 +4461,8 @@ the index in the name where the version number begins."
Value is a list whose car is the name for the backup file
and whose cdr is a list of old versions to consider deleting now.
If the value is nil, don't make a backup.
-Uses `backup-directory-alist' in the same way as does
-`make-backup-file-name'."
+Uses `backup-directory-alist' in the same way as
+`make-backup-file-name--default-function' does."
(let ((handler (find-file-name-handler fn 'find-backup-file-name)))
;; Run a handler for this function so that ange-ftp can refuse to do it.
(if handler
@@ -4416,6 +4556,8 @@ Uses `backup-directory-alist' in the same way as does
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name which is equivalent to FILENAME
when used with that default directory as the default.
+If FILENAME is a relative file name, it will be interpreted as existing in
+`default-directory'.
If FILENAME and DIRECTORY lie on different machines or on different drives
on a DOS/Windows machine, it returns FILENAME in expanded form."
(save-match-data
@@ -4458,18 +4600,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
(let ((ancestor ".")
(filename-dir (file-name-as-directory filename)))
(while (not
- (or
- (eq t (compare-strings filename-dir nil (length directory)
- directory nil nil fold-case))
- (eq t (compare-strings filename nil (length directory)
- directory nil nil fold-case))))
+ (or (string-prefix-p directory filename-dir fold-case)
+ (string-prefix-p directory filename fold-case)))
(setq directory (file-name-directory (substring directory 0 -1))
ancestor (if (equal ancestor ".")
".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
- (if (eq t (compare-strings filename nil (length directory)
- directory nil nil fold-case))
+ (if (string-prefix-p directory filename fold-case)
;; We matched within FILENAME's directory part.
;; Add the rest of FILENAME onto ANCESTOR.
(let ((rest (substring filename (length directory))))
@@ -4480,7 +4618,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
;; We matched FILENAME's directory equivalent.
ancestor))))))
-(defun save-buffer (&optional args)
+(defun save-buffer (&optional arg)
"Save current buffer in visited file if modified.
Variations are described below.
@@ -4494,7 +4632,7 @@ Prefixed with three \\[universal-argument]'s, marks this version
to become a backup when the next save is done,
and unconditionally makes the previous version into a backup file.
-With a numeric argument of 0, never make the previous version
+With a numeric prefix argument of 0, never make the previous version
into a backup file.
If a file's name is FOO, the names of its numbered backup versions are
@@ -4518,17 +4656,20 @@ If `vc-make-backup-files' is nil, which is the default,
See the subroutine `basic-save-buffer' for more information."
(interactive "p")
(let ((modp (buffer-modified-p))
- (make-backup-files (or (and make-backup-files (not (eq args 0)))
- (memq args '(16 64)))))
- (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
+ (make-backup-files (or (and make-backup-files (not (eq arg 0)))
+ (memq arg '(16 64)))))
+ (and modp (memq arg '(16 64)) (setq buffer-backed-up nil))
;; We used to display the message below only for files > 50KB, but
;; then Rmail-mbox never displays it due to buffer swapping. If
;; the test is ever re-introduced, be sure to handle saving of
;; Rmail files.
- (if (and modp (buffer-file-name))
+ (if (and modp
+ (buffer-file-name)
+ (not noninteractive)
+ (not save-silently))
(message "Saving file %s..." (buffer-file-name)))
- (basic-save-buffer)
- (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
+ (basic-save-buffer (called-interactively-p 'any))
+ (and modp (memq arg '(4 64)) (setq buffer-backed-up nil))))
(defun delete-auto-save-file-if-necessary (&optional force)
"Delete auto-save file for current buffer if `delete-auto-save-files' is t.
@@ -4569,14 +4710,14 @@ in such cases.")
(make-variable-buffer-local 'save-buffer-coding-system)
(put 'save-buffer-coding-system 'permanent-local t)
-(defun basic-save-buffer ()
+(defun basic-save-buffer (&optional called-interactively)
"Save the current buffer in its visited file, if it has been modified.
The hooks `write-contents-functions' and `write-file-functions' get a chance
to do the job of saving; if they do not, then the buffer is saved in
the visited file in the usual way.
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
- (interactive)
+ (interactive '(called-interactively))
(save-current-buffer
;; In an indirect buffer, save its base buffer instead.
(if (buffer-base-buffer)
@@ -4599,8 +4740,9 @@ Before and after saving the buffer, this function runs
;; Signal an error if the user specified the name of an
;; existing directory.
(error "%s is a directory" filename)
- (unless (y-or-n-p (format "File `%s' exists; overwrite? "
- filename))
+ (unless (y-or-n-p (format-message
+ "File `%s' exists; overwrite? "
+ filename))
(error "Canceled"))))
(set-visited-file-name filename)))
(or (verify-visited-file-modtime (current-buffer))
@@ -4640,7 +4782,8 @@ Before and after saving the buffer, this function runs
(expand-file-name buffer-file-name))))
(unless (file-exists-p dir)
(if (y-or-n-p
- (format "Directory `%s' does not exist; create? " dir))
+ (format-message
+ "Directory `%s' does not exist; create? " dir))
(make-directory dir t)
(error "Canceled")))
(setq setmodes (basic-save-buffer-1))))
@@ -4667,7 +4810,9 @@ Before and after saving the buffer, this function runs
;; Support VC `implicit' locking.
(vc-after-save)
(run-hooks 'after-save-hook))
- (message "(No changes need to be saved)"))))
+ (or noninteractive
+ (not called-interactively)
+ (files--message "(No changes need to be saved)")))))
;; This does the "real job" of writing a buffer into its visited file
;; and making a backup file. This is what is normally done
@@ -4686,7 +4831,7 @@ Before and after saving the buffer, this function runs
;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like
;; backup-buffer.
(defun basic-save-buffer-2 ()
- (let (tempsetmodes setmodes writecoding)
+ (let (tempsetmodes setmodes)
(if (not (file-writable-p buffer-file-name))
(let ((dir (file-name-directory buffer-file-name)))
(if (not (file-directory-p dir))
@@ -4702,14 +4847,6 @@ Before and after saving the buffer, this function runs
buffer-file-name)))
(setq tempsetmodes t)
(error "Attempt to save to a file which you aren't allowed to write"))))))
- ;; This may involve prompting, so do it now before backing up the file.
- ;; Otherwise there can be a delay while the user answers the
- ;; prompt during which the original file has been renamed. (Bug#13522)
- (setq writecoding
- ;; Args here should match write-region call below around
- ;; which we use writecoding.
- (choose-write-coding-system nil nil buffer-file-name nil t
- buffer-file-truename))
(or buffer-backed-up
(setq setmodes (backup-buffer)))
(let* ((dir (file-name-directory buffer-file-name))
@@ -4719,9 +4856,9 @@ Before and after saving the buffer, this function runs
(file-exists-p buffer-file-name)
(> (file-nlinks buffer-file-name) 1)
(or dir-writable
- (error (concat (format
- "Directory %s write-protected; " dir)
- "cannot break hardlink when saving")))))
+ (error (concat "Directory %s write-protected; "
+ "cannot break hardlink when saving")
+ dir))))
;; Write temp name, then rename it.
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
@@ -4748,9 +4885,10 @@ Before and after saving the buffer, this function runs
;; Pass in nil&nil rather than point-min&max
;; cause we're saving the whole buffer.
;; write-region-annotate-functions may use it.
- (write-region nil nil
- tempname nil realname
- buffer-file-truename 'excl)
+ (write-region nil nil
+ tempname nil realname
+ buffer-file-truename 'excl)
+ (when save-silently (message nil))
nil)
(file-already-exists t))
;; The file was somehow created by someone else between
@@ -4791,13 +4929,13 @@ Before and after saving the buffer, this function runs
(logior (car setmodes) 128))))))
(let (success)
(unwind-protect
+ (progn
;; Pass in nil&nil rather than point-min&max to indicate
;; we're saving the buffer rather than just a region.
;; write-region-annotate-functions may make us of it.
- (let ((coding-system-for-write writecoding)
- (coding-system-require-warning nil))
- (write-region nil nil
- buffer-file-name nil t buffer-file-truename)
+ (write-region nil nil
+ buffer-file-name nil t buffer-file-truename)
+ (when save-silently (message nil))
(setq success t))
;; If we get an error writing the new file, and we made
;; the backup by renaming, undo the backing-up.
@@ -4917,13 +5055,14 @@ change the additional actions you can take on files."
(or queried (> files-done 0) abbrevs-done
(cond
((null autosaved-buffers)
- (message "(No files need saving)"))
+ (when (called-interactively-p 'any)
+ (files--message "(No files need saving)")))
((= (length autosaved-buffers) 1)
- (message "(Saved %s)" (car autosaved-buffers)))
+ (files--message "(Saved %s)" (car autosaved-buffers)))
(t
- (message "(Saved %d files: %s)"
- (length autosaved-buffers)
- (mapconcat 'identity autosaved-buffers ", "))))))))
+ (files--message "(Saved %d files: %s)"
+ (length autosaved-buffers)
+ (mapconcat 'identity autosaved-buffers ", "))))))))
(defun clear-visited-file-modtime ()
"Clear out records of last mod time of visited file.
@@ -4936,12 +5075,14 @@ With prefix ARG, mark buffer as modified, so \\[save-buffer] will save.
It is not a good idea to use this function in Lisp programs, because it
prints a message in the minibuffer. Instead, use `set-buffer-modified-p'."
+ (declare (interactive-only set-buffer-modified-p))
(interactive "P")
- (message (if arg "Modification-flag set"
- "Modification-flag cleared"))
+ (files--message (if arg "Modification-flag set"
+ "Modification-flag cleared"))
(set-buffer-modified-p arg))
(defun toggle-read-only (&optional arg interactive)
+ "Change whether this buffer is read-only."
(declare (obsolete read-only-mode "24.3"))
(interactive (list current-prefix-arg t))
(if interactive
@@ -4955,6 +5096,7 @@ Set mark after the inserted text.
This function is meant for the user to run interactively.
Don't call it from programs! Use `insert-file-contents' instead.
\(Its calling sequence is different; see its documentation)."
+ (declare (interactive-only insert-file-contents))
(interactive "*fInsert file: ")
(insert-file-1 filename #'insert-file-contents))
@@ -4970,7 +5112,8 @@ instead of any buffer contents; END is ignored.
This does character code conversion and applies annotations
like `write-region' does."
(interactive "r\nFAppend to file: ")
- (write-region start end filename t))
+ (prog1 (write-region start end filename t)
+ (when save-silently (message nil))))
(defun file-newest-backup (filename)
"Return most recent backup file for FILENAME or nil if no backups exist."
@@ -5083,8 +5226,8 @@ given. With a prefix argument, TRASH is nil."
(list dir
(if (directory-files dir nil directory-files-no-dot-files-regexp)
(y-or-n-p
- (format "Directory `%s' is not empty, really %s? "
- dir (if trashing "trash" "delete")))
+ (format-message "Directory `%s' is not empty, really %s? "
+ dir (if trashing "trash" "delete")))
nil)
(null current-prefix-arg))))
;; If default-directory is a remote directory, make sure we find its
@@ -5146,7 +5289,12 @@ Return nil if DIR is not an existing directory."
dir (file-truename dir))
(let ((ls1 (split-string file "/" t))
(ls2 (split-string dir "/" t))
- (root (if (string-match "\\`/" file) "/" ""))
+ (root
+ (cond
+ ;; A UNC on Windows systems, or a "super-root" on Apollo.
+ ((string-match "\\`//" file) "//")
+ ((string-match "\\`/" file) "/")
+ (t "")))
(mismatch nil))
(while (and ls1 ls2 (not mismatch))
(if (string-equal (car ls1) (car ls2))
@@ -5255,28 +5403,42 @@ comparison."
(put 'revert-buffer-function 'permanent-local t)
(defvar revert-buffer-function #'revert-buffer--default
- "Function to use to revert this buffer, or nil to do the default.
+ "Function to use to revert this buffer.
The function receives two arguments IGNORE-AUTO and NOCONFIRM,
which are the arguments that `revert-buffer' received.
It also has access to the `preserve-modes' argument of `revert-buffer'
-via the `revert-buffer-preserve-modes' dynamic variable.")
+via the `revert-buffer-preserve-modes' dynamic variable.
+
+For historical reasons, a value of nil means to use the default function.
+This should not be relied upon.")
(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
(defvar revert-buffer-insert-file-contents-function
#'revert-buffer-insert-file-contents--default-function
"Function to use to insert contents when reverting this buffer.
-Gets two args, first the nominal file name to use,
-and second, t if reading the auto-save file.
+The function receives two arguments: the first the nominal file name to use;
+the second is t if reading the auto-save file.
+
+The function is responsible for updating (or preserving) point.
-The function you specify is responsible for updating (or preserving) point.")
+For historical reasons, a value of nil means to use the default function.
+This should not be relied upon.")
(defun buffer-stale--default-function (&optional _noconfirm)
+ "Default function to use for `buffer-stale-function'.
+This function ignores its argument.
+This returns non-nil if the current buffer is visiting a readable file
+whose modification time does not match that of the buffer.
+
+This function only handles buffers that are visiting files.
+Non-file buffers need a custom function"
(and buffer-file-name
(file-readable-p buffer-file-name)
+ (not (buffer-modified-p (current-buffer)))
(not (verify-visited-file-modtime (current-buffer)))))
(defvar buffer-stale-function #'buffer-stale--default-function
- "Function to check whether a non-file buffer needs reverting.
+ "Function to check whether a buffer needs reverting.
This should be a function with one optional argument NOCONFIRM.
Auto Revert Mode passes t for NOCONFIRM. The function should return
non-nil if the buffer should be reverted. A return value of
@@ -5289,13 +5451,16 @@ non-nil if the buffer is going to be reverted without asking the
user. In such situations, one has to be careful with potentially
time consuming operations.
+For historical reasons, a value of nil means to use the default function.
+This should not be relied upon.
+
For more information on how this variable is used by Auto Revert mode,
see Info node `(emacs)Supporting additional buffers'.")
(defvar before-revert-hook nil
"Normal hook for `revert-buffer' to run before reverting.
-If `revert-buffer-function' is used to override the normal revert
-mechanism, this hook is not used.")
+The function `revert-buffer--default' runs this.
+A customized `revert-buffer-function' need not run this hook.")
(defvar after-revert-hook nil
"Normal hook for `revert-buffer' to run after reverting.
@@ -5303,12 +5468,11 @@ Note that the hook value that it runs is the value that was in effect
before reverting; that makes a difference if you have buffer-local
hook functions.
-If `revert-buffer-function' is used to override the normal revert
-mechanism, this hook is not used.")
+The function `revert-buffer--default' runs this.
+A customized `revert-buffer-function' need not run this hook.")
(defvar revert-buffer-in-progress-p nil
- "Non-nil if a `revert-buffer' operation is in progress, nil otherwise.
-This is true even if a `revert-buffer-function' is being used.")
+ "Non-nil if a `revert-buffer' operation is in progress, nil otherwise.")
(defvar revert-buffer-internal-hook)
@@ -5345,12 +5509,10 @@ the files modes. Normally we reinitialize them using `normal-mode'.
This function binds `revert-buffer-in-progress-p' non-nil while it operates.
-If the value of `revert-buffer-function' is non-nil, it is called to
-do all the work for this command. Otherwise, the hooks
-`before-revert-hook' and `after-revert-hook' are run at the beginning
-and the end, and if `revert-buffer-insert-file-contents-function' is
-non-nil, it is called instead of rereading visited file contents."
-
+This function calls the function that `revert-buffer-function' specifies
+to do the work, with arguments IGNORE-AUTO and NOCONFIRM.
+The default function runs the hooks `before-revert-hook' and
+`after-revert-hook'."
;; I admit it's odd to reverse the sense of the prefix argument, but
;; there is a lot of code out there which assumes that the first
;; argument should be t to avoid consulting the auto-save file, and
@@ -5362,7 +5524,19 @@ non-nil, it is called instead of rereading visited file contents."
(revert-buffer-preserve-modes preserve-modes))
(funcall (or revert-buffer-function #'revert-buffer--default)
ignore-auto noconfirm)))
+
(defun revert-buffer--default (ignore-auto noconfirm)
+ "Default function for `revert-buffer'.
+The arguments IGNORE-AUTO and NOCONFIRM are as described for `revert-buffer'.
+Runs the hooks `before-revert-hook' and `after-revert-hook' at the
+start and end.
+
+Calls `revert-buffer-insert-file-contents-function' to reread the
+contents of the visited file, with two arguments: the first is the file
+name, the second is non-nil if reading an auto-save file.
+
+This function only handles buffers that are visiting files.
+Non-file buffers need a custom function."
(with-current-buffer (or (buffer-base-buffer (current-buffer))
(current-buffer))
(let* ((auto-save-p (and (not ignore-auto)
@@ -5416,6 +5590,10 @@ non-nil, it is called instead of rereading visited file contents."
t)))))
(defun revert-buffer-insert-file-contents--default-function (file-name auto-save-p)
+ "Default function for `revert-buffer-insert-file-contents-function'.
+The function `revert-buffer--default' calls this.
+FILE-NAME is the name of the file. AUTO-SAVE-P is non-nil if this is
+an auto-save file."
(cond
((not (file-exists-p file-name))
(error (if buffer-file-number
@@ -5516,7 +5694,7 @@ non-nil, it is called instead of rereading visited file contents."
(insert-file-contents file-name nil)
(set-buffer-file-coding-system coding-system))
(after-find-file nil nil t))
- (t (user-error "Recover-file cancelled")))))
+ (t (user-error "Recover-file canceled")))))
(defun recover-session ()
"Recover auto save files from a previous Emacs session.
@@ -5527,13 +5705,14 @@ Then you'll be asked about a number of files to recover."
(interactive)
(if (null auto-save-list-file-prefix)
(error "You set `auto-save-list-file-prefix' to disable making session files"))
- (let ((dir (file-name-directory auto-save-list-file-prefix)))
+ (let ((dir (file-name-directory auto-save-list-file-prefix))
+ (nd (file-name-nondirectory auto-save-list-file-prefix)))
(unless (file-directory-p dir)
(make-directory dir t))
(unless (directory-files dir nil
- (concat "\\`" (regexp-quote
- (file-name-nondirectory
- auto-save-list-file-prefix)))
+ (if (string= "" nd)
+ directory-files-no-dot-files-regexp
+ (concat "\\`" (regexp-quote nd)))
t)
(error "No previous sessions to recover")))
(let ((ls-lisp-support-shell-wildcards t))
@@ -5896,10 +6075,9 @@ default directory. However, if FULL is non-nil, they are absolute."
(file-expand-wildcards (directory-file-name dirpart)))
(list dirpart)))
contents)
- (while dirs
- (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
- (and (file-directory-p (directory-file-name (car dirs)))
- (file-readable-p (car dirs))))
+ (dolist (dir dirs)
+ (when (or (null dir) ; Possible if DIRPART is not wild.
+ (file-accessible-directory-p dir))
(let ((this-dir-contents
;; Filter out "." and ".."
(delq nil
@@ -5907,16 +6085,15 @@ default directory. However, if FULL is non-nil, they are absolute."
(unless (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory name))
name))
- (directory-files (or (car dirs) ".") full
+ (directory-files (or dir ".") full
(wildcard-to-regexp nondir))))))
(setq contents
(nconc
- (if (and (car dirs) (not full))
- (mapcar (function (lambda (name) (concat (car dirs) name)))
+ (if (and dir (not full))
+ (mapcar #'(lambda (name) (concat dir name))
this-dir-contents)
this-dir-contents)
- contents))))
- (setq dirs (cdr dirs)))
+ contents)))))
contents)))
;; Let Tramp know that `file-expand-wildcards' does not need an advice.
@@ -5959,7 +6136,7 @@ and `list-directory-verbose-switches'."
PATTERN is assumed to represent a file-name wildcard suitable for the
underlying filesystem. For Unix and GNU/Linux, each character from the
-set [ \\t\\n;<>&|()'\"#$] is quoted with a backslash; for DOS/Windows, all
+set [ \\t\\n;<>&|()`'\"#$] is quoted with a backslash; for DOS/Windows, all
the parts of the pattern which don't include wildcard characters are
quoted with double quotes.
@@ -5973,12 +6150,12 @@ need to be passed verbatim to shell commands."
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
(if (or (string-match "[\"]" pattern)
- ;; We quote [&()#$'] in case their shell is a port of a
+ ;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
;; passing arguments to batch files that use positional
;; arguments like %1.
- (not (string-match "[ \t;&()#$',=+]" pattern)))
+ (not (string-match "[ \t;&()#$`',=+]" pattern)))
pattern
(let ((result "\"")
(beg 0)
@@ -5993,7 +6170,7 @@ need to be passed verbatim to shell commands."
(concat result (substring pattern beg) "\""))))
(t
(let ((beg 0))
- (while (string-match "[ \t\n;<>&|()'\"#$]" pattern beg)
+ (while (string-match "[ \t\n;<>&|()`'\"#$]" pattern beg)
(setq pattern
(concat (substring pattern 0 (match-beginning 0))
"\\"
@@ -6438,10 +6615,11 @@ the low level primitive, does not. See also `kill-emacs-hook'.")
(defcustom confirm-kill-emacs nil
"How to ask for confirmation when leaving Emacs.
If nil, the default, don't ask at all. If the value is non-nil, it should
-be a predicate function such as `yes-or-no-p'."
+be a predicate function; for example `yes-or-no-p'."
:type '(choice (const :tag "Ask with yes-or-no-p" yes-or-no-p)
(const :tag "Ask with y-or-n-p" y-or-n-p)
- (const :tag "Don't confirm" nil))
+ (const :tag "Don't confirm" nil)
+ (function :tag "Predicate function"))
:group 'convenience
:version "21.1")
@@ -6454,35 +6632,40 @@ Runs the members of `kill-emacs-query-functions' in turn and stops
if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
- (and (or (not (memq t (mapcar (function
- (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))
- ;; process-list is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (with-temp-buffer-window
- (get-buffer-create "*Process List*") nil
- #'(lambda (window _value)
- (with-selected-window window
- (unwind-protect
- (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)))))
- ;; Query the user for other things, perhaps.
- (run-hook-with-args-until-failure 'kill-emacs-query-functions)
- (or (null confirm-kill-emacs)
- (funcall confirm-kill-emacs "Really exit Emacs? "))
- (kill-emacs)))
+ (let ((confirm confirm-kill-emacs))
+ (and
+ (or (not (memq t (mapcar (function
+ (lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf))))
+ (buffer-list))))
+ (progn (setq confirm nil)
+ (yes-or-no-p "Modified buffers exist; exit anyway? ")))
+ (or (not (fboundp 'process-list))
+ ;; process-list is not defined on MSDOS.
+ (let ((processes (process-list))
+ active)
+ (while processes
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
+ (setq active t))
+ (setq processes (cdr processes)))
+ (or (not active)
+ (with-current-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (progn
+ (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)))))
+ ;; Query the user for other things, perhaps.
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
+ (or (null confirm)
+ (funcall confirm "Really exit Emacs? "))
+ (kill-emacs))))
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
@@ -6571,7 +6754,7 @@ only these files will be asked to be saved."
(`add (concat "/:" (apply operation arguments)))
(`insert-file-contents
(let ((visit (nth 1 arguments)))
- (prog1
+ (unwind-protect
(apply operation arguments)
(when (and visit buffer-file-name)
(setq buffer-file-name (concat "/:" buffer-file-name))))))
@@ -6773,15 +6956,11 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
trash-info-dir filename))
;; Ensure that the trash directory exists; otherwise, create it.
- (let ((saved-default-file-modes (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes #o700)
- (unless (file-exists-p trash-files-dir)
- (make-directory trash-files-dir t))
- (unless (file-exists-p trash-info-dir)
- (make-directory trash-info-dir t)))
- (set-default-file-modes saved-default-file-modes)))
+ (with-file-modes #o700
+ (unless (file-exists-p trash-files-dir)
+ (make-directory trash-files-dir t))
+ (unless (file-exists-p trash-info-dir)
+ (make-directory trash-info-dir t)))
;; Try to move to trash with .trashinfo undo information
(save-excursion
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 82891770f12..28d0cd85582 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -1,9 +1,9 @@
-;;; filesets.el --- handle group of files -*- coding: utf-8 -*-
+;;; filesets.el --- handle group of files
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Thomas Link <sanobast-emacs@yahoo.de>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: filesets convenience
;; This file is part of GNU Emacs.
@@ -415,10 +415,10 @@ at the last position.
Possible uses: If you don't want to save `filesets-data' in your normal
configuration file, you can add a something like this
- \(lambda ()
- \(insert (format \"(setq-default filesets-data '%S)\"
+ (lambda ()
+ (insert (format \"(setq-default filesets-data \\='%S)\"
filesets-data))
- \(newline 2))
+ (newline 2))
to this hook.
@@ -550,14 +550,14 @@ will be recursively added to the menu. `filesets-tree-max-level' tells up
to which level the directory structure should be scanned/listed,
i.e. how deep the menu should be. Try something like
- \(\"HOME -- only one level\"
- \(:tree \"~\" \"^[^.].*[^~]$\")
- \(:tree-max-level 1)
- \(:filter-dirs-flag t))
- \(\"HOME -- up to 3 levels\"
- \(:tree \"~\" \"^[^.].*[^~]$\")
- \(:tree-max-level 3)
- \(:filter-dirs-flag t))
+ (\"HOME -- only one level\"
+ (:tree \"~\" \"^[^.].*[^~]$\")
+ (:tree-max-level 1)
+ (:filter-dirs-flag t))
+ (\"HOME -- up to 3 levels\"
+ (:tree \"~\" \"^[^.].*[^~]$\")
+ (:tree-max-level 3)
+ (:filter-dirs-flag t))
and it should become clear what this option is about. In any case,
including directory trees to the menu can take a lot of memory."
@@ -679,20 +679,20 @@ variables my-ps-viewer, my-pdf-viewer, my-dvi-viewer, my-pic-viewer.
In order to view pdf or rtf files in an Emacs buffer, you could use these:
- \(\"^.+\\\\.pdf\\\\'\" \"pdftotext\"
- \((:capture-output t)
- \(:args (\"%S - | fmt -w \" window-width))
- \(:ignore-on-read-text t)
- \(:constraintp (lambda ()
- \(and \(filesets-which-command-p \"pdftotext\")
- \(filesets-which-command-p \"fmt\"))))))
- \(\"^.+\\\\.rtf\\\\'\" \"rtf2htm\"
- \((:capture-output t)
- \(:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
- \(:ignore-on-read-text t)
- \(:constraintp (lambda ()
- \(and (filesets-which-command-p \"rtf2htm\")
- \(filesets-which-command-p \"w3m\"))))))"
+ (\"^.+\\\\.pdf\\\\\\='\" \"pdftotext\"
+ ((:capture-output t)
+ (:args (\"%S - | fmt -w \" window-width))
+ (:ignore-on-read-text t)
+ (:constraintp (lambda ()
+ (and (filesets-which-command-p \"pdftotext\")
+ (filesets-which-command-p \"fmt\"))))))
+ (\"^.+\\\\.rtf\\\\\\='\" \"rtf2htm\"
+ ((:capture-output t)
+ (:args (\"%S 2> /dev/null | w3m -dump -T text/html\"))
+ (:ignore-on-read-text t)
+ (:constraintp (lambda ()
+ (and (filesets-which-command-p \"rtf2htm\")
+ (filesets-which-command-p \"w3m\"))))))"
:set (function filesets-set-default)
:type '(repeat :tag "Viewer"
(list :tag "Definition"
@@ -756,7 +756,7 @@ In order to view pdf or rtf files in an Emacs buffer, you could use these:
(defcustom filesets-ingroup-patterns
'(("^.+\\.tex$" t
(((:name "Package")
- (:pattern "\\\\usepackage\\W*\\(\\[[^\]]*\\]\\W*\\)?{\\W*\\(.+\\)\\W*}")
+ (:pattern "\\\\usepackage\\W*\\(\\[[^]]*\\]\\W*\\)?{\\W*\\(.+\\)\\W*}")
(:match-number 2)
(:stub-flag t)
(:get-file-name (lambda (master file)
@@ -951,18 +951,18 @@ variable will take effect after rebuilding the menu.
Caveat: Fileset names have to be unique.
Example definition:
- '\(\(\"My Wiki\"
- \(:ingroup \"~/Etc/My-Wiki/WikiContents\"))
- \(\"My Homepage\"
- \(:pattern \"~/public_html/\" \"^.+\\\\.html$\")
- \(:open filesets-find-file))
- \(\"User Configuration\"
- \(:files \"~/.xinitrc\"
+ \\='((\"My Wiki\"
+ (:ingroup \"~/Etc/My-Wiki/WikiContents\"))
+ (\"My Homepage\"
+ (:pattern \"~/public_html/\" \"^.+\\\\.html$\")
+ (:open filesets-find-file))
+ (\"User Configuration\"
+ (:files \"~/.xinitrc\"
\"~/.bashrc\"
\"~/.bash_profile\"))
- \(\"HOME\"
- \(:tree \"~\" \"^[^.].*[^~]$\")
- \(:filter-dirs-flag t)))
+ (\"HOME\"
+ (:tree \"~\" \"^[^.].*[^~]$\")
+ (:filter-dirs-flag t)))
`filesets-data' is a list of (NAME-AS-STRING . DEFINITION), DEFINITION
being an association list with the fields:
@@ -975,7 +975,7 @@ being an association list with the fields:
:pattern DIR PATTERN ... a base directory and a regexp matching
files in that directory. Usually,
- PATTERN has the form '^REGEXP$'. Unlike
+ PATTERN has the form `^REGEXP$'. Unlike
:tree, this form does not descend
recursively into subdirectories.
@@ -1767,7 +1767,7 @@ Use LOOKUP-NAME for searching additional data if provided."
n name)))
(dolist (this files nil)
(filesets-file-open open-function this))
- (message "Filesets: cancelled")))
+ (message "Filesets: canceled")))
(filesets-error 'error "Filesets: Unknown fileset: " name))))
(defun filesets-close (&optional mode name lookup-name)
@@ -1799,7 +1799,7 @@ User will be queried, if no fileset name is provided."
(current-buffer)))
(name (or name
(completing-read
- (format "Add '%s' to fileset: " buffer)
+ (format-message "Add `%s' to fileset: " buffer)
filesets-data nil)))
(entry (or (assoc name filesets-data)
(when (y-or-n-p
@@ -1808,7 +1808,8 @@ User will be queried, if no fileset name is provided."
(progn
(add-to-list 'filesets-data (list name '(:files)))
(message
- "Fileset %s created. Call `M-x filesets-save-config' to save."
+ (substitute-command-keys
+ "Fileset %s created. Call `\\[filesets-save-config]' to save.")
name)
(car filesets-data))))))
(if entry
@@ -1818,13 +1819,13 @@ User will be queried, if no fileset name is provided."
:test 'filesets-files-equalp)))
(cond
(inlist
- (message "Filesets: '%s' is already in '%s'" this name))
+ (message "Filesets: `%s' is already in `%s'" this name))
((and (equal (filesets-entry-mode entry) ':files)
this)
(filesets-entry-set-files entry (cons this files) t)
(filesets-set-config name 'filesets-data filesets-data))
(t
- (message "Filesets: Can't add '%s' to fileset '%s'" this name)))))))
+ (message "Filesets: Can't add `%s' to fileset `%s'" this name)))))))
(defun filesets-remove-buffer (&optional name buffer)
"Remove BUFFER (or current buffer) to fileset NAME.
@@ -1834,7 +1835,7 @@ User will be queried, if no fileset name is provided."
(current-buffer)))
(name (or name
(completing-read
- (format "Remove '%s' from fileset: " buffer)
+ (format-message "Remove `%s' from fileset: " buffer)
filesets-data nil t)))
(entry (assoc name filesets-data)))
(if entry
@@ -1847,7 +1848,7 @@ User will be queried, if no fileset name is provided."
(let ((new (list (cons ':files (delete (car inlist) files)))))
(setcdr entry new)
(filesets-set-config name 'filesets-data filesets-data))
- (message "Filesets: Can't remove '%s' from fileset '%s'"
+ (message "Filesets: Can't remove `%s' from fileset `%s'"
this
name))))))
@@ -2436,11 +2437,11 @@ fileset thinks this is necessary or not."
(filesets-menu-cache-file-load))
(defun filesets-update-pre010505 ()
- (let ((msg
+ (let ((msg (format-message
"Filesets: manual editing of user data required!
Filesets has detected that you were using an older version before,
-which requires some manual updating. Type 'y' for editing the startup
+which requires some manual updating. Type `y' for editing the startup
file now.
The layout of `filesets-data' has changed. Please delete your cache file
@@ -2449,13 +2450,13 @@ and edit your startup file as shown below:
1. `filesets-data': Edit all :pattern filesets in your startup file and
transform all entries as shown in this example:
- \(\"Test\" (:pattern \"~/dir/^pattern$\"))
- --> \(\"Test\" (:pattern \"~/dir/\" \"^pattern$\"))
+ (\"Test\" (:pattern \"~/dir/^pattern$\"))
+ --> (\"Test\" (:pattern \"~/dir/\" \"^pattern$\"))
2. `filesets-data': Change all occurrences of \":document\" to \":ingroup\":
- \(\(\"Test\" \(:document \"~/dir/file\"))
- --> \(\(\"Test\" \(:ingroup \"~/dir/file\"))
+ ((\"Test\" (:document \"~/dir/file\"))
+ --> ((\"Test\" (:ingroup \"~/dir/file\"))
3. `filesets-subdocument-patterns': If you already modified the variable
previously called `filesets-subdocument-patterns', change its name to
@@ -2467,7 +2468,7 @@ variable, change the entry `filesets-subdocument--cache' to
5. Type M-x filesets-update-cleanup and restart Emacs.
-We apologize for the inconvenience."))
+We apologize for the inconvenience.")))
(let* ((cf (or custom-file user-init-file)))
(switch-to-buffer-other-frame "*Filesets update*")
(insert msg)
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index a41a32762dc..71c7a9b9c77 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -1,6 +1,6 @@
;;; find-cmd.el --- Build a valid find(1) command with sexps
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.6
@@ -39,6 +39,8 @@
;;; Code:
+(require 'grep)
+
(defconst find-constituents
'((and . find-and)
(not . find-not)
@@ -138,63 +140,65 @@ the string will be quoted).")
"Initiate the building of a find command.
For example:
-\(find-cmd '\(prune \(name \".svn\" \".git\" \".CVS\"\)\)
- '\(and \(or \(name \"*.pl\" \"*.pm\" \"*.t\"\)
- \(mtime \"+1\"\)\)
- \(fstype \"nfs\" \"ufs\"\)\)\)\)
+\(find-cmd \\='(prune (name \".svn\" \".git\" \".CVS\"))
+ \\='(and (or (name \"*.pl\" \"*.pm\" \"*.t\")
+ (mtime \"+1\"))
+ (fstype \"nfs\" \"ufs\"))))
`default-directory' is used as the initial search path. The
result is a string that should be ready for the command line."
- (concat
- "find " (shell-quote-argument (expand-file-name default-directory)) " "
- (cond
- ((cdr subfinds)
- (mapconcat 'find-to-string subfinds ""))
- (t
- (find-to-string (car subfinds))))))
+ ;; FIXME: Provide a version that returns a list of strings (ready to pass to
+ ;; call-process).
+ (concat find-program " "
+ (shell-quote-argument (expand-file-name default-directory)) " "
+ (cond
+ ((cdr subfinds)
+ (mapconcat #'find-to-string subfinds ""))
+ (t
+ (find-to-string (car subfinds))))))
(defun find-and (form)
"And FORMs together, so:
- \(and \(mtime \"+1\"\) \(name \"something\"\)\)
+ (and (mtime \"+1\") (name \"something\"))
will produce:
- find . \\\( -mtime '+1' -and -name 'something' \\\)"
+ find . \\( -mtime +1 -and -name something \\)"
(if (< (length form) 2)
(find-to-string (car form))
(concat "\\( "
- (mapconcat 'find-to-string form "-and ")
+ (mapconcat #'find-to-string form "-and ")
"\\) ")))
(defun find-or (form)
"Or FORMs together, so:
- \(or \(mtime \"+1\"\) \(name \"something\"\)\)
+ (or (mtime \"+1\") (name \"something\"))
will produce:
- find . \\\( -mtime '+1' -or -name 'something' \\\)"
+ find . \\( -mtime +1 -or -name something \\)"
(if (< (length form) 2)
(find-to-string (car form))
(concat "\\( "
- (mapconcat 'find-to-string form "-or ")
+ (mapconcat #'find-to-string form "-or ")
"\\) ")))
(defun find-not (form)
"Or FORMs together and prefix with a -not, so:
- \(not \(mtime \"+1\"\) \(name \"something\"\)\)
+ (not (mtime \"+1\") (name \"something\"))
will produce:
- -not \\\( -mtime '+1' -or -name 'something' \\\)
+ -not \\( -mtime +1 -or -name something \\)
If you wanted the FORMs -and(ed) together instead then this would
suffice:
- \(not \(and \(mtime \"+1\"\) \(name \"something\"\)\)\)"
- (concat "-not " (find-or (mapcar 'find-to-string form))))
+ (not (and (mtime \"+1\") (name \"something\")))"
+ (concat "-not " (find-or (mapcar #'find-to-string form))))
(defun find-prune (form)
- "-or together FORMs postfix '-prune' and then -or that with a
+ "-or together FORMs postfix `-prune' and then -or that with a
-true, so:
- \(prune \(name \".svn\" \".git\"\)\) \(name \"*.pm\"\)
+ ((prune (name \".svn\" \".git\")) (name \"*.pm\"))
will produce (unwrapped):
- \\\( \\\( \\\( -name '.svn' -or -name '.git' \\\) /
- -prune -or -true \\\) -and -name '*.pm' \\\)"
+ \\( \\( \\( -name .svn -or -name .git \\) /
+ -prune -or -true \\) -and -name *.pm \\)"
(find-or
(list
- (concat (find-or (mapcar 'find-to-string form)) (find-generic "prune"))
+ (concat (find-or (mapcar #'find-to-string form)) (find-generic "prune"))
(find-generic "true"))))
(defun find-generic (option &optional oper argcount args dont-quote)
@@ -205,7 +209,7 @@ args that OPTION can receive and ARGS are the arguments for OPTION.
If DONT-QUOTE is non-nil, arguments are quoted for passing them to
the shell."
(when (and (numberp argcount) (< (length args) argcount))
- (error "'%s' needs at least %d arguments" option argcount))
+ (error "`%s' needs at least %d arguments" option argcount))
(let ((oper (or oper 'find-or)))
(if (and args (length args))
(funcall oper (mapcar (lambda (x)
@@ -243,7 +247,7 @@ them into valid switches. The result is -and(ed) together."
(find-to-string
(find-generic option oper argcnt (cdr form) dont-quote))))
(t
- (error "Sorry I don't know how to handle '%s'" (car form))))))))
+ (error "Sorry I don't know how to handle `%s'" (car form))))))))
(provide 'find-cmd)
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index f9a0c015bf7..c4ef0fef229 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,11 +1,11 @@
;;; find-dired.el --- run a `find' command and dired the output
-;; Copyright (C) 1992, 1994-1995, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994-1995, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Roland McGrath <roland@gnu.org>,
;; Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix
;; This file is part of GNU Emacs.
@@ -30,7 +30,7 @@
(require 'dired)
(defgroup find-dired nil
- "Run a `find' command and dired the output."
+ "Run a `find' command and Dired the output."
:group 'dired
:prefix "find-")
@@ -72,10 +72,10 @@ a file listing in the desired format. LS-SWITCHES is a set of
The two options must be set to compatible values.
For example, to use human-readable file sizes with GNU ls:
- \(\"-exec ls -ldh {} +\" . \"-ldh\")
+ (\"-exec ls -ldh {} +\" . \"-ldh\")
To use GNU find's inbuilt \"-ls\" option to list files:
- \(\"-ls\" . \"-dilsb\")
+ (\"-ls\" . \"-dilsb\")
since GNU find's output has the same format as using GNU ls with
the options \"-dilsb\"."
:version "24.1" ; add tests for -ls and -exec + support
@@ -151,7 +151,8 @@ use in place of \"-ls\" as the final argument."
(let ((find (get-buffer-process (current-buffer))))
(when find
(if (or (not (eq (process-status find) 'run))
- (yes-or-no-p "A `find' process is running; kill it? "))
+ (yes-or-no-p
+ (format-message "A `find' process is running; kill it? ")))
(condition-case nil
(progn
(interrupt-process find)
@@ -234,11 +235,13 @@ use in place of \"-ls\" as the final argument."
;;;###autoload
(defun find-name-dired (dir pattern)
"Search DIR recursively for files matching the globbing pattern PATTERN,
-and run dired on those files.
+and run Dired on those files.
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
-The command run (after changing into DIR) is
+The default command run (after changing into DIR) is
+
+ find . -name \\='PATTERN\\=' -ls
- find . -name 'PATTERN' -ls"
+See `find-name-arg' to customize the arguments."
(interactive
"DFind-name (directory): \nsFind-name (filename wildcard): ")
(find-dired dir (concat find-name-arg " " (shell-quote-argument pattern))))
@@ -252,7 +255,7 @@ The command run (after changing into DIR) is
(defalias 'lookfor-dired 'find-grep-dired)
;;;###autoload
(defun find-grep-dired (dir regexp)
- "Find files in DIR containing a regexp REGEXP and start Dired on output.
+ "Find files in DIR matching a regexp REGEXP and start Dired on output.
The command run (after changing into DIR) is
find . \\( -type f -exec `grep-program' `find-grep-options' \\
diff --git a/lisp/find-file.el b/lisp/find-file.el
index d9a9f08f19b..5c2c5064453 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -1,10 +1,10 @@
;;; find-file.el --- find a file corresponding to this one given a pattern
;; Author: Henry Guillaume <henri@tibco.com, henry@c032.aone.net.au>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: c, matching, tools
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -183,7 +183,7 @@ To override this, give an argument to `ff-find-other-file'."
;;;###autoload
(defcustom ff-special-constructs
;; C/C++ include, for NeXTstep too
- `((,(purecopy "^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
+ `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") .
(lambda ()
(buffer-substring (match-beginning 2) (match-end 2)))))
;; We include `ff-treat-as-special' documentation here so that autoload
@@ -678,7 +678,7 @@ name of the first file found."
(setq suffixes suffix-list)
;; if dir does not contain '/*', look for the file
- (if (and dir (not (string-match "\\([^*]*\\)/\\\*\\(/.*\\)*" dir)))
+ (if (and dir (not (string-match "\\([^*]*\\)/\\*\\(/.*\\)*" dir)))
(progn
;; suffixes is nil => fname-stub is the file we are looking for
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index 0eea918dc48..2c8faa281ab 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -4,7 +4,7 @@
;; Created: Fri Mar 26 1999
;; Keywords: unix
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/finder.el b/lisp/finder.el
index e07c6a241ab..715dd9499fa 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,6 +1,6 @@
;;; finder.el --- topic & keyword-based code finder
-;; Copyright (C) 1992, 1997-1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1997-1999, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
@@ -53,7 +53,7 @@
(frames . "Emacs frames and window systems")
(games . "games, jokes and amusements")
(hardware . "interfacing with system hardware")
- (help . "on-line help systems")
+ (help . "Emacs help systems")
(hypermedia . "links between text or other media types")
(i18n . "internationalization and character-set support")
(internal . "code for Emacs internals, build process, defaults")
@@ -73,7 +73,9 @@
(tools . "programming tools")
(unix . "UNIX feature interfaces and emulators")
(vc . "version control")
- (wp . "word processing")))
+ (wp . "word processing"))
+ "Association list of the standard \"Keywords:\" headers.
+Each element has the form (KEYWORD . DESCRIPTION).")
(defvar finder-mode-map
(let ((map (make-sparse-keymap))
@@ -103,7 +105,8 @@
(define-key menu-map [finder-select]
'(menu-item "Select" finder-select
:help "Select item on current line in a finder buffer"))
- map))
+ map)
+ "Keymap used in `finder-mode'.")
(defvar finder-mode-syntax-table
(let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
@@ -111,12 +114,8 @@
st)
"Syntax table used while in `finder-mode'.")
-(defvar finder-font-lock-keywords
- '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
- "Font-lock keywords for Finder mode.")
-
(defvar finder-headmark nil
- "Internal finder-mode variable, local in finder buffer.")
+ "Internal Finder mode variable, local in Finder buffer.")
;;; Code for regenerating the keyword list.
@@ -133,11 +132,22 @@ Keywords and package names both should be symbols.")
;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
;; ldefs-boot is not auto-generated, but has nothing useful.
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
-cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
+cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
"Regexp matching file names not to scan for keywords.")
(autoload 'autoload-rubric "autoload")
+(defconst finder--builtins-descriptions
+ ;; I have no idea whether these are supposed to be capitalized
+ ;; and/or end in a full-stop. Existing file headers are inconsistent,
+ ;; but mainly seem to not do so.
+ '((emacs . "the extensible text editor")
+ (nxml . "a new XML mode"))
+ "Alist of built-in package descriptions.
+Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
+When generating `package--builtins', this overrides what the description
+would otherwise be.")
+
(defvar finder--builtins-alist
'(("calc" . calc)
("ede" . ede)
@@ -153,6 +163,10 @@ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
("decorate" . semantic)
("symref" . semantic)
("wisent" . semantic)
+ ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
+ ;; is the main file for the package. Then we would not need an
+ ;; entry in finder--builtins-descriptions. But I do not know if
+ ;; it is safe to change this, in case it is already in use.
("nxml" . nxml)
("org" . org)
("srecode" . srecode)
@@ -175,11 +189,11 @@ from; the default is `load-path'."
(setq package--builtins nil)
(setq finder-keywords-hash (make-hash-table :test 'eq))
(let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
- package-override files base-name processed
+ package-override files base-name ; processed
summary keywords package version entry desc)
(dolist (d (or dirs load-path))
(when (file-exists-p (directory-file-name d))
- (message "Directory %s" d)
+ (message "Scanning %s for finder" d)
(setq package-override
(intern-soft
(cdr-safe
@@ -190,17 +204,29 @@ from; the default is `load-path'."
(unless (or (string-match finder-no-scan-regexp f)
(null (setq base-name
(and (string-match el-file-regexp f)
- (intern (match-string 1 f)))))
- (memq base-name processed))
- (push base-name processed)
+ (intern (match-string 1 f))))))
+;; (memq base-name processed))
+;; There are multiple files in the tree with the same basename.
+;; So skipping files based on basename means you randomly (depending
+;; on which order the files are traversed in) miss some packages.
+;; http://debbugs.gnu.org/14010
+;; You might think this could lead to two files providing the same package,
+;; but it does not, because the duplicates are (at time of writing)
+;; all due to files in cedet, which end up with package-override set.
+;; FIXME this is obviously fragile.
+;; Make the (eq base-name package) case below issue a warning if
+;; package-override is nil?
+;; (push base-name processed)
(with-temp-buffer
(insert-file-contents (expand-file-name f d))
- (setq summary (lm-synopsis)
- keywords (mapcar 'intern (lm-keywords-list))
+ (setq keywords (mapcar 'intern (lm-keywords-list))
package (or package-override
(let ((str (lm-header "package")))
(if str (intern str)))
base-name)
+ summary (or (cdr
+ (assq package finder--builtins-descriptions))
+ (lm-synopsis))
version (lm-header "version")))
(when summary
(setq version (ignore-errors (version-to-list version)))
@@ -209,6 +235,9 @@ from; the default is `load-path'."
(push (cons package
(package-make-builtin version summary))
package--builtins))
+ ;; The idea here is that eg calc.el gets to define
+ ;; the description of the calc package.
+ ;; This does not work for eg nxml-mode.el.
((eq base-name package)
(setq desc (cdr entry))
(aset desc 0 version)
@@ -225,8 +254,8 @@ from; the default is `load-path'."
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
- (save-excursion
- (find-file generated-finder-keywords-file)
+ (with-current-buffer
+ (find-file-noselect generated-finder-keywords-file)
(setq buffer-undo-list t)
(erase-buffer)
(insert (autoload-rubric generated-finder-keywords-file
@@ -321,7 +350,8 @@ not `finder-known-keywords'."
(packages (gethash id finder-keywords-hash)))
(unless packages
(error "No packages matching key `%s'" key))
- (package-show-package-list packages)))
+ (let ((package-list-unversioned t))
+ (package-show-package-list packages))))
(define-button-type 'finder-xref 'action #'finder-goto-xref)
@@ -382,7 +412,7 @@ FILE should be in a form suitable for passing to `locate-library'."
key)))
(defun finder-select ()
- "Select item on current line in a finder buffer."
+ "Select item on current line in a Finder buffer."
(interactive)
(let ((key (finder-current-item)))
(if (string-match "\\.el$" key)
@@ -390,7 +420,7 @@ FILE should be in a form suitable for passing to `locate-library'."
(finder-list-matches key))))
(defun finder-mouse-select (event)
- "Select item in a finder buffer with the mouse."
+ "Select item in a Finder buffer with the mouse."
(interactive "e")
(with-current-buffer (window-buffer (posn-window (event-start event)))
(goto-char (posn-point (event-start event)))
@@ -429,6 +459,12 @@ Delete the window and kill all Finder-related buffers."
(let ((buf "*Finder*"))
(and (get-buffer buf) (kill-buffer buf))))
+(defun finder-unload-function ()
+ "Unload the Finder library."
+ (with-demoted-errors (unload-feature 'finder-inf t))
+ ;; continue standard unloading
+ nil)
+
(provide 'finder)
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index 4a67cc422ca..41eab80a19d 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -1,10 +1,10 @@
;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
-;; Copyright (C) 1990-1991, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1990-1991, 1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Kevin Gallagher
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR
;; Keywords: hardware
diff --git a/lisp/foldout.el b/lisp/foldout.el
index 7b66a8c8aaf..0a401c77ddf 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -1,9 +1,9 @@
;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 27 Jan 1994
;; Version: 1.10
;; Keywords: folding, outlines
@@ -250,7 +250,7 @@ An end marker of nil means the fold ends after (point-max).")
"Open the subtree under the current heading and narrow to it.
Normally the body and the immediate subheadings are exposed, but
-optional arg EXPOSURE \(interactively with prefix arg\) changes this:-
+optional arg EXPOSURE \(interactively with prefix arg) changes this:-
EXPOSURE > 0 exposes n levels of subheadings (c.f. show-children)
EXPOSURE < 0 exposes only the body
@@ -280,16 +280,16 @@ optional arg EXPOSURE \(interactively with prefix arg\) changes this:-
(goto-char start)
(cond
((null exposure)
- (show-entry)
- (show-children))
+ (outline-show-entry)
+ (outline-show-children))
((< exposure-value 0)
- (show-entry))
+ (outline-show-entry))
((consp exposure)
- (show-children))
+ (outline-show-children))
((> exposure-value 0)
- (show-children exposure-value))
+ (outline-show-children exposure-value))
(t
- (show-subtree))
+ (outline-show-subtree))
)
;; save the location of the fold we are entering
@@ -366,7 +366,7 @@ exited and text is left visible."
;; hide the subtree
(when hide-fold
(goto-char start-marker)
- (hide-subtree))
+ (outline-hide-subtree))
;; make sure the next heading is exposed
(if end-marker
@@ -454,10 +454,10 @@ What gets exposed depends on the number of mouse clicks:-
(foldout-mouse-goto-heading event)
(let ((nclicks (event-click-count event)))
(cond
- ((= nclicks 1) (show-entry))
- ((= nclicks 2) (show-children))
- ((= nclicks 3) (show-entry) (show-children))
- (t (show-subtree)))))
+ ((= nclicks 1) (outline-show-entry))
+ ((= nclicks 2) (outline-show-children))
+ ((= nclicks 3) (outline-show-entry) (outline-show-children))
+ (t (outline-show-subtree)))))
(defun foldout-mouse-hide-or-exit (event)
"Hide the subtree under the heading clicked on, or exit a fold.
@@ -478,7 +478,7 @@ What happens depends on the number of mouse clicks:-
(if (= nclicks 1)
(progn
(foldout-mouse-goto-heading event)
- (hide-subtree))
+ (outline-hide-subtree))
(foldout-exit-fold
(cond
((= nclicks 2) 1) ; exit and hide
diff --git a/lisp/follow.el b/lisp/follow.el
index 2c9365b2ba6..938c59e8506 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1,9 +1,10 @@
;;; follow.el --- synchronize windows showing the same buffer
-;; Copyright (C) 1995-1997, 1999, 2001-2013 Free Software Foundation,
+
+;; Copyright (C) 1995-1997, 1999, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
-;; Maintainer: FSF (Anders' email bounces, Sep 2005)
+;; Maintainer: emacs-devel@gnu.org (Anders' email bounces, Sep 2005)
;; Created: 1995-05-25
;; Keywords: display, window, minor-mode, convenience
@@ -34,7 +35,7 @@
;; This means that whenever one window is moved, all the
;; others will follow. (Hence the name Follow mode.)
;;
-;; * Should the point (cursor) end up outside a window, another
+;; * Should point (cursor) end up outside a window, another
;; window displaying that point is selected, if possible. This
;; makes it possible to walk between windows using normal cursor
;; movement commands.
@@ -143,7 +144,7 @@
;; this command be added to the global keymap.
;;
;; follow-recenter C-c . C-l
-;; Place the point in the center of the middle window,
+;; Place point in the center of the middle window,
;; or a specified number of lines from either top or bottom.
;;
;; follow-switch-to-buffer C-c . b
@@ -201,6 +202,7 @@
;;; Code:
(require 'easymenu)
+(eval-when-compile (require 'cl-lib))
;;; Variables
@@ -310,7 +312,7 @@ are \" Fw\", or simply \"\"."
(set-default symbol value)))
(defvar follow-cache-command-list
- '(next-line previous-line forward-char backward-char)
+ '(next-line previous-line forward-char backward-char right-char left-char)
"List of commands that don't require recalculation.
In order to be able to use the cache, a command should not change the
@@ -345,6 +347,9 @@ Used by `follow-window-size-change'.")
(defvar follow-windows-start-end-cache nil
"Cache used by `follow-window-start-end'.")
+(defvar follow-fixed-window nil
+ "If non-nil, the current window must not be scrolled.
+This is typically set by explicit scrolling commands.")
;;; Debug messages
;; This inline function must be as small as possible!
@@ -389,7 +394,7 @@ virtual window. This is accomplished by two main techniques:
This means that whenever one window is moved, all the
others will follow. (Hence the name Follow mode.)
-* Should the point (cursor) end up outside a window, another
+* Should point (cursor) end up outside a window, another
window displaying that point is selected, if possible. This
makes it possible to walk between windows using normal cursor
movement commands.
@@ -403,7 +408,7 @@ mileage may vary).
To split one large window into two side-by-side windows, the commands
`\\[split-window-right]' or \
-`M-x follow-delete-other-windows-and-split' can be used.
+`\\[follow-delete-other-windows-and-split]' can be used.
Only windows displayed in the same frame follow each other.
@@ -437,6 +442,54 @@ Keys specific to Follow mode:
;;; Scroll
+(defun follow-get-scrolled-point (dest windows)
+ "Calculate the correct value for point after a scrolling operation.
+
+DEST is our default position, typically where point was before the scroll.
+If `scroll-preserve-screen-position' is non-nil and active, DEST will be
+in the same screen position as before the scroll. WINDOWS is the list of
+windows in the follow chain.
+
+This function attempts to duplicate the point placing from
+`window_scroll_line_based' in the Emacs core source window.c.
+
+Return the new position."
+ (if (and scroll-preserve-screen-position
+ (get this-command 'scroll-command))
+ dest
+ (let ((dest-column
+ (save-excursion
+ (goto-char dest)
+ (- (current-column)
+ (progn (vertical-motion 0) (current-column)))))
+ (limit0
+ (with-selected-window (car windows)
+ (save-excursion
+ (goto-char (window-start))
+ (vertical-motion 0)
+ (point))))
+ (limitn
+ (with-selected-window (car (reverse windows))
+ (save-excursion
+ (goto-char (window-end nil t))
+ (if (pos-visible-in-window-p)
+ (point) ; i.e. (point-max)
+ (1- (point)))))))
+ (cond
+ ((< dest limit0)
+ (with-selected-window (car windows)
+ (save-excursion
+ (goto-char limit0)
+ (vertical-motion (cons dest-column 0))
+ (point))))
+ ((> dest limitn)
+ (with-selected-window (car (reverse windows))
+ (save-excursion
+ (goto-char limitn)
+ (vertical-motion (cons dest-column 0))
+ (point))))
+ (t dest)))))
+
;; `scroll-up' and `-down', but for windows in Follow mode.
;;
;; Almost like the real thing, except when the cursor ends up outside
@@ -452,6 +505,7 @@ Keys specific to Follow mode:
;; position... (This would also be corrected if we would have had a
;; good redisplay abstraction.)
+;;;###autoload
(defun follow-scroll-up (&optional arg)
"Scroll text in a Follow mode window chain up.
@@ -465,22 +519,26 @@ Works like `scroll-up' when not in Follow mode."
(interactive "P")
(cond ((not follow-mode)
(scroll-up arg))
- (arg
- (save-excursion (scroll-up arg))
- (setq follow-internal-force-redisplay t))
+ ((eq arg '-)
+ (follow-scroll-down))
(t
- (let* ((windows (follow-all-followers))
- (end (window-end (car (reverse windows)))))
- (if (eq end (point-max))
- (signal 'end-of-buffer nil)
- (select-window (car windows))
- ;; `window-end' might return nil.
- (if end
- (goto-char end))
- (vertical-motion (- next-screen-context-lines))
- (set-window-start (car windows) (point)))))))
-
+ (let ((opoint (point)) (owin (selected-window)))
+ (while
+ ;; If we are too near EOB, try scrolling the previous window.
+ (condition-case nil (progn (scroll-up arg) nil)
+ (end-of-buffer
+ (condition-case nil (progn (follow-previous-window) t)
+ (error
+ (select-window owin)
+ (goto-char opoint)
+ (signal 'end-of-buffer nil))))))
+ (unless (and scroll-preserve-screen-position
+ (get this-command 'scroll-command))
+ (goto-char opoint))
+ (setq follow-fixed-window t)))))
+(put 'follow-scroll-up 'scroll-command t)
+;;;###autoload
(defun follow-scroll-down (&optional arg)
"Scroll text in a Follow mode window chain down.
@@ -490,27 +548,20 @@ the top window in the chain will be visible in the bottom window.
If called with an argument, scroll ARG lines down.
Negative ARG means scroll upward.
-Works like `scroll-up' when not in Follow mode."
+Works like `scroll-down' when not in Follow mode."
(interactive "P")
(cond ((not follow-mode)
- (scroll-up arg))
- (arg
- (save-excursion (scroll-down arg)))
+ (scroll-down arg))
+ ((eq arg '-)
+ (follow-scroll-up))
(t
- (let* ((windows (follow-all-followers))
- (win (car (reverse windows)))
- (start (window-start (car windows))))
- (if (eq start (point-min))
- (signal 'beginning-of-buffer nil)
- (select-window win)
- (goto-char start)
- (vertical-motion (- (- (window-height win)
- (if header-line-format 2 1)
- next-screen-context-lines)))
- (set-window-start win (point))
- (goto-char start)
- (vertical-motion (- next-screen-context-lines 1))
- (setq follow-internal-force-redisplay t))))))
+ (let ((opoint (point)))
+ (scroll-down arg)
+ (unless (and scroll-preserve-screen-position
+ (get this-command 'scroll-command))
+ (goto-char opoint))
+ (setq follow-fixed-window t)))))
+(put 'follow-scroll-down 'scroll-command t)
(declare-function comint-adjust-point "comint" (window))
(defvar comint-scroll-show-maximum-output)
@@ -531,7 +582,7 @@ This is to be called by `comint-postoutput-scroll-to-bottom'."
(select-window win)
(goto-char pos)
(setq follow-windows-start-end-cache nil)
- (follow-adjust-window win pos)
+ (follow-adjust-window win)
(unless is-selected
(select-window selected)
(set-buffer buffer))))))
@@ -743,12 +794,9 @@ contains only windows in the same frame as WIN. If WIN is nil,
it defaults to the selected window."
(unless (window-live-p win)
(setq win (selected-window)))
- (let ((buffer (window-buffer win))
- windows)
- (dolist (w (window-list (window-frame win) 'no-minibuf win))
- (if (eq (window-buffer w) buffer)
- (push w windows)))
- (sort windows 'follow--window-sorter)))
+ (let ((windows (get-buffer-window-list
+ (window-buffer win) 'no-minibuf (window-frame win))))
+ (sort windows #'follow--window-sorter)))
(defun follow-split-followers (windows &optional win)
"Split WINDOWS into two sets: predecessors and successors.
@@ -767,15 +815,16 @@ from the selected window."
Return (END-POS END-OF-BUFFER).
Actually, the position returned is the start of the line after
-the last fully-visible line in WIN. If WIN is nil, the selected
-window is used."
+the last fully-visible line in WIN. END-OF-BUFFER is t when EOB
+is fully-visible in WIN. If WIN is nil, the selected window is
+used."
(let* ((win (or win (selected-window)))
(edges (window-inside-pixel-edges win))
(ht (- (nth 3 edges) (nth 1 edges)))
(last-line-pos (posn-point (posn-at-x-y 0 (1- ht) win))))
(if (pos-visible-in-window-p last-line-pos win)
(let ((end (window-end win t)))
- (list end (= end (point-max))))
+ (list end (pos-visible-in-window-p (point-max) win)))
(list last-line-pos nil))))
(defun follow-calc-win-start (windows pos win)
@@ -846,7 +895,7 @@ returned by `follow-windows-start-end'."
(setq win-start-end (cdr win-start-end)))
result))
-;; Check if the point is visible in all windows. (So that
+;; Check if point is visible in all windows. (So that
;; no one will be recentered.)
(defun follow-point-visible-all-windows-p (win-start-end)
@@ -865,7 +914,7 @@ returned by `follow-windows-start-end'."
;; will lead to a redisplay of the screen later on.
;;
;; This is used with the first window in a follow chain. The reason
-;; is that we want to detect that the point is outside the window.
+;; is that we want to detect that point is outside the window.
;; (Without the update, the start of the window will move as the
;; user presses BackSpace, and the other window redisplay routines
;; will move the start of the window in the wrong direction.)
@@ -897,7 +946,7 @@ Return the selected window."
;; Lets select a window showing the end. Make sure we only select it if
;; it wasn't just moved here. (I.e. M-> shall not unconditionally place
-;; the point in the selected window.)
+;; point in the selected window.)
;;
;; (Compatibility kludge: in Emacs `window-end' is equal to `point-max';
;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
@@ -923,10 +972,10 @@ Return the selected window."
win))
-;; Select a window that will display the point if the windows would
+;; Select a window that will display point if the windows would
;; be redisplayed with the first window fixed. This is useful for
;; example when the user has pressed return at the bottom of a window
-;; as the point is not visible in any window.
+;; as point is not visible in any window.
(defun follow-select-if-visible-from-first (dest windows)
"Try to select one of WINDOWS without repositioning the topmost window.
@@ -968,7 +1017,7 @@ Otherwise, return nil."
(defun follow-redisplay (&optional windows win preserve-win)
"Reposition the WINDOWS around WIN.
-Should the point be too close to the roof we redisplay everything
+Should point be too close to the roof we redisplay everything
from the top. WINDOWS should contain a list of windows to
redisplay; it is assumed that WIN is a member of the list.
Should WINDOWS be nil, the windows displaying the
@@ -1009,7 +1058,7 @@ should be a member of WINDOWS, starts at position START."
(goto-char start)
(vertical-motion 0 win)
(dolist (w windows-before)
- (vertical-motion (- 1 (window-text-height w)) w))
+ (vertical-motion (- (window-text-height w)) w))
(point))))
@@ -1123,15 +1172,22 @@ non-first windows in Follow mode."
(with-current-buffer (window-buffer win)
(unless (and (symbolp this-command)
(get this-command 'follow-mode-use-cache))
- (setq follow-windows-start-end-cache nil)))
- (follow-adjust-window win (point)))))
+ (setq follow-windows-start-end-cache nil))
+ (follow-adjust-window win)))))
-(defun follow-adjust-window (win dest)
+(defun follow-adjust-window (win)
;; Adjust the window WIN and its followers.
- (with-current-buffer (window-buffer win)
- (when (and follow-mode
- (not (window-minibuffer-p win)))
- (let* ((windows (follow-all-followers win))
+ (cl-assert (eq (window-buffer win) (current-buffer)))
+ (when (and follow-mode
+ (not (window-minibuffer-p win)))
+ (let ((windows (follow-all-followers win)))
+ ;; If we've explicitly scrolled, align the windows first.
+ (when follow-fixed-window
+ (follow-debug-message "fixed")
+ (follow-redisplay windows win)
+ (goto-char (follow-get-scrolled-point (point) windows))
+ (setq follow-fixed-window nil))
+ (let* ((dest (point))
(win-start-end (progn
(follow-update-window-start (car windows))
(follow-windows-start-end windows)))
@@ -1213,7 +1269,7 @@ non-first windows in Follow mode."
(setq visible nil aligned nil))))
;; If a new window was selected, make sure that the old is
- ;; not scrolled when the point is outside the window.
+ ;; not scrolled when point is outside the window.
(unless (eq win (selected-window))
(let ((p (window-point win)))
(set-window-start win (window-start win) nil)
@@ -1246,7 +1302,7 @@ non-first windows in Follow mode."
selected-window-up-to-date)
(setq win-start-end (follow-windows-start-end windows)
follow-windows-start-end-cache nil)
- ;; The point can ends up in another window when DEST is at
+ ;; Point can end up in another window when DEST is at
;; the beginning of the buffer and the selected window is
;; not the first. It can also happen when long lines are
;; used and there is a big difference between the width of
@@ -1259,22 +1315,20 @@ non-first windows in Follow mode."
;; If the region is visible, make it look good when spanning
;; multiple windows.
-
- ;; FIXME: Why not use `use-region-p' here?
(when (region-active-p)
(follow-maximize-region
- (selected-window) windows win-start-end)))
+ (selected-window) windows win-start-end))))
- ;; Whether or not the buffer was in follow mode, update windows
- ;; displaying the tail so that Emacs won't recenter them.
- (follow-avoid-tail-recenter))))
+ ;; Whether or not the buffer was in follow mode, update windows
+ ;; displaying the tail so that Emacs won't recenter them.
+ (follow-avoid-tail-recenter)))
;;; The region
;; Tries to make the highlighted area representing the region look
;; good when spanning several windows.
;;
-;; Not perfect, as the point can't be placed at window end, only at
+;; Not perfect, as point can't be placed at window end, only at
;; end-1. This will highlight a little bit in windows above
;; the current.
@@ -1299,6 +1353,12 @@ non-first windows in Follow mode."
;; This handles the case where the user drags the scroll bar of a
;; non-selected window whose buffer is in Follow mode.
+(declare-function scroll-bar-toolkit-scroll "scroll-bar" (event))
+(declare-function scroll-bar-drag "scroll-bar" (event))
+(declare-function scroll-bar-scroll-up "scroll-bar" (event))
+(declare-function scroll-bar-scroll-down "scroll-bar" (event))
+(declare-function mwheel-scroll "mwheel" (event))
+
(defun follow-scroll-bar-toolkit-scroll (event)
(interactive "e")
(scroll-bar-toolkit-scroll event)
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 17bfa29617c..2253204d9f7 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -1,8 +1,8 @@
;;; font-core.el --- Core interface to font-lock
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, faces
;; Package: emacs
@@ -30,7 +30,7 @@
"Defaults for Font Lock mode specified by the major mode.
Defaults should be of the form:
- (KEYWORDS [KEYWORDS-ONLY [CASE-FOLD [SYNTAX-ALIST [SYNTAX-BEGIN ...]]]])
+ (KEYWORDS [KEYWORDS-ONLY [CASE-FOLD [SYNTAX-ALIST ...]]])
KEYWORDS may be a symbol (a variable or function whose value is the keywords
to use for fontification) or a list of symbols (specifying different levels
@@ -45,20 +45,9 @@ If SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form
\(CHAR-OR-STRING . STRING) used to set the local Font Lock syntax table, for
keyword and syntactic fontification (see `modify-syntax-entry').
-If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move
-backwards outside any enclosing syntactic block, for syntactic fontification.
-Typical values are `beginning-of-line' (i.e., the start of the line is known to
-be outside a syntactic block), or `beginning-of-defun' for programming modes or
-`backward-paragraph' for textual modes (i.e., the mode-dependent function is
-known to move outside a syntactic block). If nil, the beginning of the buffer
-is used as a position outside of a syntactic block, in the worst case.
-
-\(See also Info node `(elisp)Font Lock Basics'.)
-
These item elements are used by Font Lock mode to set the variables
`font-lock-keywords', `font-lock-keywords-only',
-`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
-`font-lock-beginning-of-syntax-function', respectively.
+`font-lock-keywords-case-fold-search', `font-lock-syntax-table'.
Further item elements are alists of the form (VARIABLE . VALUE) and are in no
particular order. Each VARIABLE is made buffer-local before set to VALUE.
@@ -106,7 +95,7 @@ fontifying different parts of buffer text, use \\[customize-face].
You can enable Font Lock mode in any major mode automatically by turning on in
the major mode's hook. For example, put in your ~/.emacs:
- (add-hook 'c-mode-hook 'turn-on-font-lock)
+ (add-hook \\='c-mode-hook \\='turn-on-font-lock)
Alternatively, you can use Global Font Lock mode to automagically turn on Font
Lock mode in buffers whose major mode supports it and whose major mode is one
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 70ed73eb5ab..21cf3aec785 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1,11 +1,11 @@
;;; font-lock.el --- Electric font lock mode
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: Jamie Zawinski
;; Richard Stallman
;; Stefan Monnier
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, faces
;; Package: emacs
@@ -458,7 +458,7 @@ This variable is set by major modes via the variable `font-lock-defaults'.
Be careful when composing regexps for this list; a poorly written pattern can
dramatically slow things down!
-A compiled keywords list starts with t. It is produced internal
+A compiled keywords list starts with t. It is produced internally
by `font-lock-compile-keywords' from a user-level keywords list.
Its second element is the user-level keywords list that was
compiled. The remaining elements have the same form as
@@ -538,12 +538,13 @@ and what they do:
dollar-sign character. Hash characters in other contexts will still
follow whatever the syntax table says about the hash character.
- (\"\\\\('\\\\).\\\\('\\\\)\"
+ (\"\\\\(\\='\\\\).\\\\(\\='\\\\)\"
(1 \"\\\"\")
(2 \"\\\"\"))
- gives a pair single-quotes, which surround a single character, a SYNTAX of
- \"\\\"\" (meaning string quote syntax). Single-quote characters in other
+ gives a pair of apostrophes, which surround a single character, a
+ SYNTAX of \"\\\"\" (meaning string quote syntax). Apostrophes in other
+
contexts will not be affected.
This is normally set via `font-lock-defaults'.")
@@ -555,21 +556,6 @@ This is normally set via `font-lock-defaults'.")
If this is nil, the major mode's syntax table is used.
This is normally set via `font-lock-defaults'.")
-(defvar font-lock-beginning-of-syntax-function nil
- "Non-nil means use this function to move back outside all constructs.
-When called with no args it should move point backward to a place which
-is not in a string or comment and not within any bracket-pairs (or else,
-a place such that any bracket-pairs outside it can be ignored for Emacs
-syntax analysis and fontification).
-
-If this is nil, Font Lock uses `syntax-begin-function' to move back
-outside of any comment, string, or sexp. This variable is semi-obsolete;
-we recommend setting `syntax-begin-function' instead.
-
-This is normally set via `font-lock-defaults'.")
-(make-obsolete-variable 'font-lock-beginning-of-syntax-function
- 'syntax-begin-function "23.3" 'set)
-
(defvar font-lock-mark-block-function nil
"Non-nil means use this function to mark a block of text.
When called with no args it should leave point at the beginning of any
@@ -585,11 +571,14 @@ This is normally set via `font-lock-defaults'.")
This is used when turning off Font Lock mode.
This is normally set via `font-lock-defaults'.")
-(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region
+(defvar font-lock-fontify-region-function #'font-lock-default-fontify-region
"Function to use for fontifying a region.
It should take two args, the beginning and end of the region, and an optional
third arg VERBOSE. If VERBOSE is non-nil, the function should print status
-messages. This is normally set via `font-lock-defaults'.")
+messages. This is normally set via `font-lock-defaults'.
+If it fontifies a larger region, it should ideally return a list of the form
+\(jit-lock-bounds BEG . END) indicating the bounds of the region actually
+fontified.")
(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region
"Function to use for unfontifying a region.
@@ -600,15 +589,16 @@ This is normally set via `font-lock-defaults'.")
"List of Font Lock mode related modes that should not be turned on.
Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and
`lazy-lock-mode'. This is normally set via `font-lock-defaults'.")
+(make-obsolete-variable 'font-lock-inhibit-thing-lock nil "25.1")
-(defvar font-lock-multiline nil
+(defvar-local font-lock-multiline nil
"Whether font-lock should cater to multiline keywords.
If nil, don't try to handle multiline patterns.
If t, always handle multiline patterns.
If `undecided', don't try to handle multiline patterns until you see one.
Major/minor modes can set this variable if they know which option applies.")
-(defvar font-lock-fontified nil) ; Whether we have fontified the buffer.
+(defvar-local font-lock-fontified nil) ; Whether we have fontified the buffer.
;; Font Lock mode.
@@ -626,6 +616,8 @@ Major/minor modes can set this variable if they know which option applies.")
;; Shut up the byte compiler.
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
+(defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults.
+
(defun font-lock-specified-p (mode)
"Return non-nil if the current buffer is ready for fontification.
The MODE argument, if non-nil, means Font Lock mode is about to
@@ -634,7 +626,6 @@ be enabled."
(and (boundp 'font-lock-keywords)
font-lock-keywords)
(and mode
- (boundp 'font-lock-set-defaults)
font-lock-set-defaults
font-lock-major-mode
(not (eq font-lock-major-mode major-mode)))))
@@ -678,9 +669,9 @@ end of the current highlighting list.
For example:
- (font-lock-add-keywords 'c-mode
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
- (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . 'font-lock-keyword-face)))
+ (font-lock-add-keywords \\='c-mode
+ \\='((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 \\='font-lock-warning-face prepend)
+ (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . \\='font-lock-keyword-face)))
adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
comments, and to fontify `and', `or' and `not' words as keywords.
@@ -691,12 +682,12 @@ pass nil for MODE and add the call to c-mode-hook.
For example:
- (add-hook 'c-mode-hook
+ (add-hook \\='c-mode-hook
(lambda ()
(font-lock-add-keywords nil
- '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 'font-lock-warning-face prepend)
+ \\='((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 \\='font-lock-warning-face prepend)
(\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
- 'font-lock-keyword-face)))))
+ \\='font-lock-keyword-face)))))
The above procedure may fail to add keywords to derived modes if
some involved major mode does not follow the standard conventions.
@@ -921,12 +912,20 @@ The value of this variable is used when Font Lock mode is turned on."
;; Prepare for jit-lock
(remove-hook 'after-change-functions
'font-lock-after-change-function t)
+ (set (make-local-variable 'font-lock-flush-function)
+ 'jit-lock-refontify)
+ (set (make-local-variable 'font-lock-ensure-function)
+ 'jit-lock-fontify-now)
+ ;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole
+ ;; buffer. This is important for things like CWarn mode which
+ ;; adds/removes a few keywords and does a refontify (which takes ages on
+ ;; large files).
(set (make-local-variable 'font-lock-fontify-buffer-function)
'jit-lock-refontify)
;; Don't fontify eagerly (and don't abort if the buffer is large).
(set (make-local-variable 'font-lock-fontified) t)
;; Use jit-lock.
- (jit-lock-register 'font-lock-fontify-region
+ (jit-lock-register #'font-lock-fontify-region
(not font-lock-keywords-only))
;; Tell jit-lock how we extend the region to refontify.
(add-hook 'jit-lock-after-change-extend-region-functions
@@ -1025,12 +1024,23 @@ This function should preserve the match-data.
The region it returns may start or end in the middle of a line.")
(make-variable-buffer-local 'font-lock-extend-after-change-region-function)
-(defun font-lock-fontify-buffer ()
+(defun font-lock-fontify-buffer (&optional interactively)
"Fontify the current buffer the way the function `font-lock-mode' would."
- (interactive)
+ (declare
+ ;; When called from Lisp, this function is a big mess. The caller usually
+ ;; expects one of the following behaviors:
+ ;; - refresh the highlighting (because the font-lock-keywords have been
+ ;; changed).
+ ;; - apply font-lock highlighting even if font-lock-mode is not enabled.
+ ;; - reset the highlighting rules because font-lock-defaults
+ ;; has been changed (and then rehighlight everything).
+ ;; Of course, this function doesn't do all of the above in all situations
+ ;; (e.g. depending on whether jit-lock is in use) and it can't guess what
+ ;; the caller wants.
+ (interactive-only "use `font-lock-ensure' or `font-lock-flush' instead."))
+ (interactive "p")
(font-lock-set-defaults)
- (let ((font-lock-verbose (or font-lock-verbose
- (called-interactively-p 'interactive))))
+ (let ((font-lock-verbose (or font-lock-verbose interactively)))
(funcall font-lock-fontify-buffer-function)))
(defun font-lock-unfontify-buffer ()
@@ -1049,6 +1059,31 @@ This works by calling `font-lock-unfontify-region-function'."
(save-buffer-state
(funcall font-lock-unfontify-region-function beg end)))
+(defvar font-lock-flush-function #'font-lock-after-change-function
+ "Function to use to mark a region for refontification.
+Called with two arguments BEG and END.")
+
+(defun font-lock-flush (&optional beg end)
+ "Declare the region BEG...END's fontification as out-of-date.
+If the region is not specified, it defaults to the whole buffer."
+ (and font-lock-mode
+ font-lock-fontified
+ (funcall font-lock-flush-function
+ (or beg (point-min)) (or end (point-max)))))
+
+(defvar font-lock-ensure-function
+ (lambda (_beg _end)
+ (unless font-lock-fontified (font-lock-default-fontify-buffer)))
+ "Function to make sure a region has been fontified.
+Called with two arguments BEG and END.")
+
+(defun font-lock-ensure (&optional beg end)
+ "Make sure the region BEG...END has been fontified.
+If the region is not specified, it defaults to the whole buffer."
+ (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'."
(let ((verbose (if (numberp font-lock-verbose)
@@ -1059,7 +1094,7 @@ This works by calling `font-lock-unfontify-region-function'."
(format "Fontifying %s..." (buffer-name)))
;; Make sure we fontify etc. in the whole buffer.
(save-restriction
- (widen)
+ (unless font-lock-dont-widen (widen))
(condition-case nil
(save-excursion
(save-match-data
@@ -1131,7 +1166,9 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(let ((changed nil))
(goto-char font-lock-beg)
(unless (bolp)
- (setq changed t font-lock-beg (line-beginning-position)))
+ (setq changed t font-lock-beg
+ (let ((inhibit-field-text-motion t))
+ (line-beginning-position))))
(goto-char font-lock-end)
(unless (bolp)
(unless (eq font-lock-end
@@ -1175,7 +1212,8 @@ This function is the default `font-lock-fontify-region-function'."
(font-lock-fontify-syntactic-keywords-region start end)))
(unless font-lock-keywords-only
(font-lock-fontify-syntactically-region beg end loudly))
- (font-lock-fontify-keywords-region beg end loudly)))))
+ (font-lock-fontify-keywords-region beg end loudly)
+ `(jit-lock-bounds ,beg . ,end)))))
;; The following must be rethought, since keywords can override fontification.
;; ;; Now scan for keywords, but not if we are inside a comment now.
@@ -1201,7 +1239,7 @@ This function is the default `font-lock-unfontify-region-function'."
'(face font-lock-multiline)))))
;; Called when any modification is made to buffer text.
-(defun font-lock-after-change-function (beg end old-len)
+(defun font-lock-after-change-function (beg end &optional old-len)
(save-excursion
(let ((inhibit-point-motion-hooks t)
(inhibit-quit t)
@@ -1280,11 +1318,13 @@ This function does 2 things:
(when (memq 'font-lock-extend-region-wholelines
font-lock-extend-region-functions)
(goto-char beg)
- (setq jit-lock-start (min jit-lock-start (line-beginning-position)))
+ (setq beg (min jit-lock-start (line-beginning-position)))
(goto-char end)
- (setq jit-lock-end
+ (setq end
(max jit-lock-end
- (if (bolp) (point) (line-beginning-position 2))))))))
+ (if (bolp) (point) (line-beginning-position 2)))))
+ (setq jit-lock-start beg
+ jit-lock-end end))))
(defun font-lock-fontify-block (&optional arg)
"Fontify some lines the way `font-lock-fontify-buffer' would.
@@ -1294,11 +1334,11 @@ no ARG is given and `font-lock-mark-block-function' is nil.
If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to
delimit the region to fontify."
(interactive "P")
- (let ((inhibit-point-motion-hooks t) font-lock-beginning-of-syntax-function
+ (let ((inhibit-point-motion-hooks t)
deactivate-mark)
;; Make sure we have the right `font-lock-keywords' etc.
(if (not font-lock-mode) (font-lock-set-defaults))
- (save-excursion
+ (save-mark-and-excursion
(save-match-data
(condition-case error-data
(if (or arg (not font-lock-mark-block-function))
@@ -1371,37 +1411,33 @@ Optional argument OBJECT is the string or buffer containing the text."
(put-text-property start next prop value object)
(setq start (text-property-any next end prop nil object)))))
-;; For completeness: this is to `remove-text-properties' as `put-text-property'
-;; is to `add-text-properties', etc.
-;;(defun remove-text-property (start end property &optional object)
-;; "Remove a property from text from START to END.
-;;Argument PROPERTY is the property to remove.
-;;Optional argument OBJECT is the string or buffer containing the text.
-;;Return t if the property was actually removed, nil otherwise."
-;; (remove-text-properties start end (list property) object))
-
-;; For consistency: maybe this should be called `remove-single-property' like
-;; `next-single-property-change' (not `next-single-text-property-change'), etc.
-;;(defun remove-single-text-property (start end prop value &optional object)
-;; "Remove a specific property value from text from START to END.
-;;Arguments PROP and VALUE specify the property and value to remove. The
-;;resulting property values are not equal to VALUE nor lists containing VALUE.
-;;Optional argument OBJECT is the string or buffer containing the text."
-;; (let ((start (text-property-not-all start end prop nil object)) next prev)
-;; (while start
-;; (setq next (next-single-property-change start prop object end)
-;; prev (get-text-property start prop object))
-;; (cond ((and (symbolp prev) (eq value prev))
-;; (remove-text-property start next prop object))
-;; ((and (listp prev) (memq value prev))
-;; (let ((new (delq value prev)))
-;; (cond ((null new)
-;; (remove-text-property start next prop object))
-;; ((= (length new) 1)
-;; (put-text-property start next prop (car new) object))
-;; (t
-;; (put-text-property start next prop new object))))))
-;; (setq start (text-property-not-all next end prop nil object)))))
+(defun font-lock--remove-face-from-text-property (start
+ end
+ prop value &optional object)
+ "Remove a specific property value from text from START to END.
+Arguments PROP and VALUE specify the property and value to remove. The
+resulting property values are not `eq' to VALUE nor lists containing VALUE.
+Optional argument OBJECT is the string or buffer containing the text."
+ (let ((start (text-property-not-all start end prop nil object)) next prev)
+ (while start
+ (setq next (next-single-property-change start prop object end)
+ prev (get-text-property start prop object))
+ (cond ((or (atom prev)
+ (keywordp (car prev))
+ (eq (car prev) 'foreground-color)
+ (eq (car prev) 'background-color))
+ (when (eq value prev)
+ (remove-list-of-text-properties start next (list prop) object)))
+ ((memq value prev) ;Assume prev is not dotted.
+ (let ((new (remq value prev)))
+ (cond ((null new)
+ (remove-list-of-text-properties start next (list prop)
+ object))
+ ((= (length new) 1)
+ (put-text-property start next prop (car new) object))
+ (t
+ (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.
@@ -1714,13 +1750,12 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
keywords
(setq keywords
(cons t (cons keywords
- (mapcar 'font-lock-compile-keyword keywords))))
+ (mapcar #'font-lock-compile-keyword keywords))))
(if (and (not syntactic-keywords)
- (let ((beg-function
- (or font-lock-beginning-of-syntax-function
- syntax-begin-function)))
+ (let ((beg-function syntax-begin-function))
(or (eq beg-function 'beginning-of-defun)
- (get beg-function 'font-lock-syntax-paren-check)))
+ (if (symbolp beg-function)
+ (get beg-function 'font-lock-syntax-paren-check))))
(not beginning-of-defun-function))
;; Try to detect when a string or comment contains something that
;; looks like a defun and would thus confuse font-lock.
@@ -1738,7 +1773,7 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
keywords))
(defun font-lock-compile-keyword (keyword)
- (cond ((nlistp keyword) ; MATCHER
+ (cond ((or (functionp keyword) (nlistp keyword)) ; MATCHER
(list keyword '(0 font-lock-keyword-face)))
((eq (car keyword) 'eval) ; (eval . FORM)
(font-lock-compile-keyword (eval (cdr keyword))))
@@ -1764,12 +1799,14 @@ If SYNTACTIC-KEYWORDS is non-nil, it means these keywords are used for
(funcall keywords)
(eval keywords)))))
-(defun font-lock-value-in-major-mode (alist)
- "Return value in ALIST for `major-mode', or ALIST if it is not an alist.
-Structure is ((MAJOR-MODE . VALUE) ...) where MAJOR-MODE may be t."
- (if (consp alist)
- (cdr (or (assq major-mode alist) (assq t alist)))
- alist))
+(defun font-lock-value-in-major-mode (values)
+ "If VALUES is an list, use `major-mode' as a key and return the `assq' value.
+VALUES should then be an alist on the form ((MAJOR-MODE . VALUE) ...) where
+MAJOR-MODE may be t.
+If VALUES isn't a list, return VALUES."
+ (if (consp values)
+ (cdr (or (assq major-mode values) (assq t values)))
+ values))
(defun font-lock-choose-keywords (keywords level)
"Return LEVELth element of KEYWORDS.
@@ -1784,8 +1821,6 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to
(t
(car keywords))))
-(defvar font-lock-set-defaults nil) ; Whether we have set up defaults.
-
(defun font-lock-refresh-defaults ()
"Restart fontification in current buffer after recomputing from defaults.
Recompute fontification variables using `font-lock-defaults' and
@@ -1813,9 +1848,7 @@ Sets various variables using `font-lock-defaults' and
(unless (and font-lock-set-defaults
(eq font-lock-major-mode major-mode))
(setq font-lock-major-mode major-mode)
- (set (make-local-variable 'font-lock-set-defaults) t)
- (make-local-variable 'font-lock-fontified)
- (make-local-variable 'font-lock-multiline)
+ (setq font-lock-set-defaults t)
(let* ((defaults font-lock-defaults)
(keywords
(font-lock-choose-keywords (nth 0 defaults)
@@ -1823,7 +1856,6 @@ Sets various variables using `font-lock-defaults' and
(local (cdr (assq major-mode font-lock-keywords-alist)))
(removed-keywords
(cdr-safe (assq major-mode font-lock-removed-keywords-alist))))
- (set (make-local-variable 'font-lock-defaults) defaults)
;; Syntactic fontification?
(if (nth 1 defaults)
(set (make-local-variable 'font-lock-keywords-only) t)
@@ -1844,17 +1876,14 @@ Sets various variables using `font-lock-defaults' and
(list (car selem))
(mapcar 'identity (car selem))))
(modify-syntax-entry char syntax font-lock-syntax-table)))))
- ;; Syntax function for syntactic fontification?
- (if (nth 4 defaults)
- (set (make-local-variable 'font-lock-beginning-of-syntax-function)
- (nth 4 defaults))
- (kill-local-variable 'font-lock-beginning-of-syntax-function))
+ ;; (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.
;; Variable alist?
- (dolist (x (nthcdr 5 defaults))
+ (dolist (x (nthcdr (if (consp (nth 4 defaults)) 4 5) defaults))
(set (make-local-variable (car x)) (cdr x)))
;; Set up `font-lock-keywords' last because its value might depend
- ;; on other settings (e.g. font-lock-compile-keywords uses
- ;; font-lock-beginning-of-syntax-function).
+ ;; on other settings.
(set (make-local-variable 'font-lock-keywords)
(font-lock-eval-keywords keywords))
;; Local fontification?
@@ -1866,7 +1895,8 @@ Sets various variables using `font-lock-defaults' and
;; Now compile the keywords.
(unless (eq (car font-lock-keywords) t)
(setq font-lock-keywords
- (font-lock-compile-keywords font-lock-keywords))))))
+ (font-lock-compile-keywords font-lock-keywords))))
+ (font-lock-flush)))
;;; Color etc. support.
@@ -2240,131 +2270,6 @@ Used in `cpp-font-lock-keywords'.")
for C preprocessor directives. This definition is for the other modes
in which C preprocessor directives are used. e.g. `asm-mode' and
`ld-script-mode'.")
-
-
-;; Lisp.
-
-(defconst lisp-font-lock-keywords-1
- (eval-when-compile
- `(;; Definitions.
- (,(concat "(\\(def\\("
- ;; Function declarations.
- "\\(advice\\|alias\\|generic\\|macro\\*?\\|method\\|"
- "setf\\|subst\\*?\\|un\\*?\\|"
- "ine-\\(condition\\|"
- "\\(?:derived\\|\\(?:global\\(?:ized\\)?-\\)?minor\\|generic\\)-mode\\|"
- "method-combination\\|setf-expander\\|skeleton\\|widget\\|"
- "function\\|\\(compiler\\|modify\\|symbol\\)-macro\\)\\)\\|"
- ;; Variable declarations.
- "\\(const\\(ant\\)?\\|custom\\|varalias\\|face\\|parameter\\|var\\(?:-local\\)?\\)\\|"
- ;; Structure declarations.
- "\\(class\\|group\\|theme\\|package\\|struct\\|type\\)"
- "\\)\\)\\_>"
- ;; Any whitespace and defined object.
- "[ \t'\(]*"
- "\\(setf[ \t]+\\(?:\\sw\\|\\s_\\)+\\|\\(?:\\sw\\|\\s_\\)+\\)?")
- (1 font-lock-keyword-face)
- (9 (cond ((match-beginning 3) font-lock-function-name-face)
- ((match-beginning 6) font-lock-variable-name-face)
- (t font-lock-type-face))
- nil t))
- ;; Emacs Lisp autoload cookies. Supports the slightly different
- ;; forms used by mh-e, calendar, etc.
- ("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend)
- ;; Regexp negated char group.
- ("\\[\\(\\^\\)" 1 font-lock-negation-char-face prepend)))
- "Subdued level highlighting for Lisp modes.")
-
-(defconst lisp-font-lock-keywords-2
- (append lisp-font-lock-keywords-1
- (eval-when-compile
- `(;; Control structures. Emacs Lisp forms.
- (,(concat
- "(" (regexp-opt
- '("cond" "if" "while" "while-no-input" "let" "let*" "letrec"
- "pcase" "pcase-let" "pcase-let*" "prog" "progn" "progv"
- "prog1" "prog2" "prog*" "inline" "lambda"
- "save-restriction" "save-excursion" "save-selected-window"
- "save-window-excursion" "save-match-data" "save-current-buffer"
- "combine-after-change-calls" "unwind-protect"
- "condition-case" "condition-case-unless-debug"
- "track-mouse" "eval-after-load" "eval-and-compile"
- "eval-when-compile" "eval-when" "eval-next-after-load"
- "with-case-table" "with-category-table" "with-coding-priority"
- "with-current-buffer" "with-demoted-errors"
- "with-electric-help" "with-eval-after-load"
- "with-local-quit" "with-no-warnings"
- "with-output-to-string" "with-output-to-temp-buffer"
- "with-selected-window" "with-selected-frame"
- "with-silent-modifications" "with-syntax-table"
- "with-temp-buffer" "with-temp-file" "with-temp-message"
- "with-timeout" "with-timeout-handler") t)
- "\\_>")
- . 1)
- ;; Control structures. Common Lisp forms.
- (,(concat
- "(" (regexp-opt
- '("when" "unless" "case" "ecase" "typecase" "etypecase"
- "ccase" "ctypecase" "handler-case" "handler-bind"
- "restart-bind" "restart-case" "in-package"
- "break" "ignore-errors"
- "loop" "do" "do*" "dotimes" "dolist" "the" "locally"
- "proclaim" "declaim" "declare" "symbol-macrolet" "letf"
- "lexical-let" "lexical-let*" "flet" "labels" "compiler-let"
- "destructuring-bind" "macrolet" "tagbody" "block" "go"
- "multiple-value-bind" "multiple-value-prog1"
- "return" "return-from"
- "with-accessors" "with-compilation-unit"
- "with-condition-restarts" "with-hash-table-iterator"
- "with-input-from-string" "with-open-file"
- "with-open-stream" "with-output-to-string"
- "with-package-iterator" "with-simple-restart"
- "with-slots" "with-standard-io-syntax") t)
- "\\_>")
- . 1)
- ;; Exit/Feature symbols as constants.
- (,(concat "(\\(catch\\|throw\\|featurep\\|provide\\|require\\)\\_>"
- "[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
- (1 font-lock-keyword-face)
- (2 font-lock-constant-face nil t))
- ;; Erroneous structures.
- ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|\\(?:user-\\)?error\\|signal\\)\\_>" 1 font-lock-warning-face)
- ;; Words inside \\[] tend to be for `substitute-command-keys'.
- ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
- (1 font-lock-constant-face prepend))
- ;; Words inside `' tend to be symbol names.
- ("`\\(\\(?:\\sw\\|\\s_\\)\\(?:\\sw\\|\\s_\\)+\\)'"
- (1 font-lock-constant-face prepend))
- ;; Constant values.
- ("\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" 0 font-lock-builtin-face)
- ;; ELisp and CLisp `&' keywords as types.
- ("\\_<\\&\\(?:\\sw\\|\\s_\\)+\\_>" . font-lock-type-face)
- ;; ELisp regexp grouping constructs
- ((lambda (bound)
- (catch 'found
- ;; The following loop is needed to continue searching after matches
- ;; that do not occur in strings. The associated regexp matches one
- ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'. `\\\\' has been included to
- ;; avoid highlighting, for example, `\\(' in `\\\\('.
- (while (re-search-forward "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)" bound t)
- (unless (match-beginning 2)
- (let ((face (get-text-property (1- (point)) 'face)))
- (when (or (and (listp face)
- (memq 'font-lock-string-face face))
- (eq 'font-lock-string-face face))
- (throw 'found t)))))))
- (1 'font-lock-regexp-grouping-backslash prepend)
- (3 'font-lock-regexp-grouping-construct prepend))
- ;; This is too general -- rms.
- ;; A user complained that he has functions whose names start with `do'
- ;; and that they get the wrong color.
- ;; ;; CL `with-' and `do-' constructs
- ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
- )))
- "Gaudy level highlighting for Lisp modes.")
-
-(defvar lisp-font-lock-keywords lisp-font-lock-keywords-1
- "Default expressions to highlight in Lisp modes.")
(provide 'font-lock)
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 6bb0fe9178a..e61978e009b 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,6 +1,6 @@
;;; format-spec.el --- functions for formatting arbitrary formatting strings
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: tools
diff --git a/lisp/format.el b/lisp/format.el
index fc8dcb97b01..8a756e3396c 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -1,6 +1,6 @@
;;; format.el --- read and save files in multiple formats
-;; Copyright (C) 1994-1995, 1997, 1999, 2001-2013 Free Software
+;; Copyright (C) 1994-1995, 1997, 1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
@@ -395,8 +395,8 @@ unless you supply a prefix argument."
(cdr (assq 'default-directory
(buffer-local-variables)))
nil nil (buffer-name))))
- (fmt (format-read (format "Write file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Write file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt (not current-prefix-arg))))
(let ((old-formats buffer-file-format)
preserve-formats)
@@ -416,8 +416,8 @@ If FORMAT is nil then do not do any format conversion."
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
- (fmt (format-read (format "Read file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt)))
(let ((format-alist nil))
(find-file filename))
@@ -435,8 +435,8 @@ a list (ABSOLUTE-FILE-NAME SIZE)."
(interactive
;; Same interactive spec as write-file, plus format question.
(let* ((file (read-file-name "Find file: "))
- (fmt (format-read (format "Read file `%s' in format: "
- (file-name-nondirectory file)))))
+ (fmt (format-read (format-message "Read file `%s' in format: "
+ (file-name-nondirectory file)))))
(list file fmt)))
(let (value size old-undo)
;; Record only one undo entry for the insertion. Inhibit point-motion and
@@ -513,7 +513,7 @@ Optional args BEG and END specify a region of the buffer on which to operate."
(defun format-delq-cons (cons list)
"Remove the given CONS from LIST by side effect and return the new LIST.
Since CONS could be the first element of LIST, write
-`\(setq foo \(format-delq-cons element foo))' to be sure of changing
+\(setq foo \(format-delq-cons element foo)) to be sure of changing
the value of `foo'."
(if (eq cons list)
(cdr list)
@@ -619,7 +619,7 @@ the rest of the arguments are any PARAMETERs found in that region.
Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
are saved as values of the `unknown' text-property \(which is list-valued).
The TRANSLATIONS list should usually contain an entry of the form
- \(unknown \(nil format-annotate-value))
+ (unknown (nil format-annotate-value))
to write these unknown annotations back into the file."
(save-excursion
(save-restriction
@@ -827,7 +827,7 @@ in the region, it is treated as though it were DEFAULT."
Insert each element of the given LIST of buffer annotations at its
appropriate place. Use second arg OFFSET if the annotations' locations are
not relative to the beginning of the buffer: annotations will be inserted
-at their location-OFFSET+1 \(ie, the offset is treated as the position of
+at their location-OFFSET+1 \(i.e., the offset is treated as the position of
the first character in the buffer)."
(if (not offset)
(setq offset 0)
@@ -839,7 +839,7 @@ the first character in the buffer)."
(setq l (cdr l)))))
(defun format-annotate-value (old new)
- "Return OLD and NEW as a \(CLOSE . OPEN) annotation pair.
+ "Return OLD and NEW as a (CLOSE . OPEN) annotation pair.
Useful as a default function for TRANSLATIONS alist when the value of the text
property is the name of the annotation that you want to use, as it is for the
`unknown' text property."
diff --git a/lisp/forms.el b/lisp/forms.el
index 38fc0b320dd..e7e399fd436 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1,6 +1,6 @@
;;; forms.el --- Forms mode: edit a file as a form to fill in
-;; Copyright (C) 1991, 1994-1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1991, 1994-1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Johan Vromans <jvromans@squirrel.nl>
@@ -297,9 +297,6 @@
;;; Global variables and constants:
-(provide 'forms) ;;; official
-(provide 'forms-mode) ;;; for compatibility
-
(defcustom forms-mode-hook nil
"Hook run upon entering Forms mode."
:group 'forms
@@ -443,6 +440,7 @@ Also, initial position is at last record."
;;;###autoload
(defun forms-mode (&optional primary)
+ ;; FIXME: use define-derived-mode
"Major mode to visit files in a field-structured manner using a form.
Commands: Equivalent keys in read-only mode:
@@ -637,6 +635,8 @@ Commands: Equivalent keys in read-only mode:
(setq major-mode 'forms-mode)
(setq mode-name "Forms")
+ (cursor-intangible-mode 1)
+
;; find the data file
(setq forms--file-buffer (find-file-noselect forms-file))
@@ -647,7 +647,7 @@ Commands: Equivalent keys in read-only mode:
(with-current-buffer forms--file-buffer
(let ((inhibit-read-only t)
(file-modified (buffer-modified-p)))
- (run-hooks 'read-file-filter)
+ (mapc #'funcall read-file-filter)
(if (not file-modified) (set-buffer-modified-p nil)))
(if write-file-filter
(add-hook 'write-file-functions write-file-filter nil t)))
@@ -692,10 +692,12 @@ Commands: Equivalent keys in read-only mode:
(insert
"GNU Emacs Forms Mode\n\n"
(if (file-exists-p forms-file)
- (concat "No records available in file `" forms-file "'\n\n")
- (format "Creating new file `%s'\nwith %d field%s per record\n\n"
- forms-file forms-number-of-fields
- (if (= 1 forms-number-of-fields) "" "s")))
+ (format-message
+ "No records available in file `%s'\n\n" forms-file)
+ (format-message
+ "Creating new file `%s'\nwith %d field%s per record\n\n"
+ forms-file forms-number-of-fields
+ (if (= 1 forms-number-of-fields) "" "s")))
"Use " (substitute-command-keys "\\[forms-insert-record]")
" to create new records.\n")
(setq forms--current-record 1)
@@ -921,7 +923,7 @@ Commands: Equivalent keys in read-only mode:
,@(if (numberp (car forms-format-list))
nil
'((add-text-properties (point-min) (1+ (point-min))
- '(front-sticky (read-only intangible)))))
+ '(front-sticky (read-only cursor-intangible)))))
;; Prevent insertion after the last text.
(remove-text-properties (1- (point)) (point)
'(rear-nonsticky)))
@@ -1005,10 +1007,10 @@ Commands: Equivalent keys in read-only mode:
(point))
(list 'face forms--ro-face ; read-only appearance
'read-only ,@(list (1+ forms--marker))
- 'intangible ,@(list (1+ forms--marker))
+ 'cursor-intangible ,@(list (1+ forms--marker))
'insert-in-front-hooks '(forms--iif-hook)
'rear-nonsticky '(face read-only insert-in-front-hooks
- intangible)))))
+ cursor-intangible)))))
((numberp el)
`((let ((here (point)))
@@ -1034,10 +1036,10 @@ Commands: Equivalent keys in read-only mode:
(point))
(list 'face forms--ro-face
'read-only ,@(list (1+ forms--marker))
- 'intangible ,@(list (1+ forms--marker))
+ 'cursor-intangible ,@(list (1+ forms--marker))
'insert-in-front-hooks '(forms--iif-hook)
'rear-nonsticky '(read-only face insert-in-front-hooks
- intangible)))))
+ cursor-intangible)))))
;; end of cond
))
@@ -1755,7 +1757,7 @@ Otherwise enables edit mode if the visited file is writable."
With ARG: store the record after the current one.
If `forms-new-record-filter' contains the name of a function,
it is called to fill (some of) the fields with default values.
-If `forms-insert-after is non-nil, the default behavior is to insert
+If `forms-insert-after' is non-nil, the default behavior is to insert
after the current record."
(interactive "P")
@@ -2055,4 +2057,6 @@ Usage: (setq forms-number-of-fields
(goto-char (point-max))
(insert ret)))))
+(provide 'forms-mode) ; for compatibility
+(provide 'forms)
;;; forms.el ends here
diff --git a/lisp/frame.el b/lisp/frame.el
index 79394bd305b..f5508517dc6 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1,9 +1,9 @@
-;;; frame.el --- multi-frame management independent of window systems
+;;; frame.el --- multi-frame management independent of window systems -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 1996-1997, 2000-2013 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -27,21 +27,28 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(defvar frame-creation-function-alist
- (list (cons nil
- (if (fboundp 'tty-create-frame-with-faces)
- 'tty-create-frame-with-faces
- (lambda (_parameters)
- (error "Can't create multiple frames without a window system")))))
- "Alist of window-system dependent functions to call to create a new frame.
+(cl-defgeneric frame-creation-function (params)
+ "Method for window-system dependent functions to create a new frame.
The window system startup file should add its frame creation
-function to this list, which should take an alist of parameters
+function to this method, which should take an alist of parameters
as its argument.")
+(cl-generic-define-context-rewriter window-system (value)
+ ;; If `value' is a `consp', it's probably an old-style specializer,
+ ;; so just use it, and anyway `eql' isn't very useful on cons cells.
+ `(window-system ,(if (consp value) value `(eql ,value))))
+
+(cl-defmethod frame-creation-function (params &context (window-system nil))
+ ;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
+ ;; this method (i.e. move this method to faces.el), but faces.el is loaded
+ ;; much earlier from loadup.el (before cl-generic and even before
+ ;; cl-preloaded), so we'd first have to reorder that part.
+ (tty-create-frame-with-faces params))
+
(defvar window-system-default-frame-alist nil
"Window-system dependent default frame parameters.
The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
-where WINDOW-SYSTEM is a window system symbol (see `window-system')
+where WINDOW-SYSTEM is a window system symbol (as returned by `framep')
and ALIST is a frame parameter alist like `default-frame-alist'.
Then, for frames on WINDOW-SYSTEM, any parameters specified in
ALIST supersede the corresponding parameters specified in
@@ -120,6 +127,23 @@ appended when the minibuffer frame is created."
(delete-frame frame t)
;; Gildea@x.org says it is ok to ask questions before terminating.
(save-buffers-kill-emacs))))
+
+(defun handle-focus-in (_event)
+ "Handle a focus-in event.
+Focus-in events are usually bound to this function.
+Focus-in events occur when a frame has focus, but a switch-frame event
+is not generated.
+This function runs the hook `focus-in-hook'."
+ (interactive "e")
+ (run-hooks 'focus-in-hook))
+
+(defun handle-focus-out (_event)
+ "Handle a focus-out event.
+Focus-out events are usually bound to this function.
+Focus-out events occur when no frame has focus.
+This function runs the hook `focus-out-hook'."
+ (interactive "e")
+ (run-hooks 'focus-out-hook))
;;;; Arrangement of frames at startup
@@ -132,12 +156,6 @@ appended when the minibuffer frame is created."
;; 3) Once the init file is done, we apply any newly set parameters
;; in initial-frame-alist to the frame.
-;; These are now called explicitly at the proper times,
-;; since that is easier to understand.
-;; Actually using hooks within Emacs is bad for future maintenance. --rms.
-;; (add-hook 'before-init-hook 'frame-initialize)
-;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
-
;; If we create the initial frame, this is it.
(defvar frame-initial-frame nil)
@@ -164,10 +182,6 @@ appended when the minibuffer frame is created."
(progn
(setq frame-initial-frame-alist
(append initial-frame-alist default-frame-alist nil))
- (or (assq 'horizontal-scroll-bars frame-initial-frame-alist)
- (setq frame-initial-frame-alist
- (cons '(horizontal-scroll-bars . t)
- frame-initial-frame-alist)))
(setq frame-initial-frame-alist
(cons (cons 'window-system initial-window-system)
frame-initial-frame-alist))
@@ -192,6 +206,9 @@ appended when the minibuffer frame is created."
"Non-nil means function `frame-notice-user-settings' wasn't run yet.")
(declare-function tool-bar-mode "tool-bar" (&optional arg))
+(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
+
+(defalias 'tool-bar-lines-needed 'tool-bar-height)
;; startup.el calls this function after loading the user's init
;; file. Now default-frame-alist and initial-frame-alist contain
@@ -232,6 +249,10 @@ there (in decreasing order of priority)."
(let ((newparms (frame-parameters))
(frame (selected-frame)))
(tty-handle-reverse-video frame newparms)
+ ;; tty-handle-reverse-video might change the frame's
+ ;; color parameters, and we need to use the updated
+ ;; value below.
+ (setq newparms (frame-parameters))
;; If we changed the background color, we need to update
;; the background-mode parameter, and maybe some faces,
;; too.
@@ -239,64 +260,50 @@ there (in decreasing order of priority)."
(unless (or (assq 'background-mode initial-frame-alist)
(assq 'background-mode default-frame-alist))
(frame-set-background-mode frame))
- (face-set-after-frame-default frame))))))
+ (face-set-after-frame-default frame newparms))))))
;; If the initial frame is still around, apply initial-frame-alist
;; and default-frame-alist to it.
(when (frame-live-p frame-initial-frame)
-
;; When tool-bar has been switched off, correct the frame size
;; by the lines added in x-create-frame for the tool-bar and
;; switch `tool-bar-mode' off.
(when (display-graphic-p)
- (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
- (assq 'tool-bar-lines window-system-frame-alist)
- (assq 'tool-bar-lines default-frame-alist))))
- (when (and tool-bar-originally-present
- (or (null tool-bar-lines)
- (null (cdr tool-bar-lines))
- (eq 0 (cdr tool-bar-lines))))
- (let* ((char-height (frame-char-height frame-initial-frame))
- (image-height tool-bar-images-pixel-height)
- (margin (cond ((and (consp tool-bar-button-margin)
- (integerp (cdr tool-bar-button-margin))
- (> tool-bar-button-margin 0))
- (cdr tool-bar-button-margin))
- ((and (integerp tool-bar-button-margin)
- (> tool-bar-button-margin 0))
- tool-bar-button-margin)
- (t 0)))
- (relief (if (and (integerp tool-bar-button-relief)
- (> tool-bar-button-relief 0))
- tool-bar-button-relief 3))
- (lines (/ (+ image-height
- (* 2 margin)
- (* 2 relief)
- (1- char-height))
- char-height))
- (height (frame-parameter frame-initial-frame 'height))
- (newparms (list (cons 'height (- height lines))))
- (initial-top (cdr (assq 'top
- frame-initial-geometry-arguments)))
+ (let* ((init-lines
+ (assq 'tool-bar-lines initial-frame-alist))
+ (other-lines
+ (or (assq 'tool-bar-lines window-system-frame-alist)
+ (assq 'tool-bar-lines default-frame-alist)))
+ (lines (or init-lines other-lines))
+ (height (tool-bar-height frame-initial-frame t)))
+ ;; Adjust frame top if either zero (nil) tool bar lines have
+ ;; been requested in the most relevant of the frame's alists
+ ;; or tool bar mode has been explicitly turned off in the
+ ;; user's init file.
+ (when (and (> height 0)
+ (or (and lines
+ (or (null (cdr lines))
+ (eq 0 (cdr lines))))
+ (not tool-bar-mode)))
+ (let* ((initial-top
+ (cdr (assq 'top frame-initial-geometry-arguments)))
(top (frame-parameter frame-initial-frame 'top)))
(when (and (consp initial-top) (eq '- (car initial-top)))
(let ((adjusted-top
- (cond ((and (consp top)
- (eq '+ (car top)))
- (list '+
- (+ (cadr top)
- (* lines char-height))))
- ((and (consp top)
- (eq '- (car top)))
- (list '-
- (- (cadr top)
- (* lines char-height))))
- (t (+ top (* lines char-height))))))
- (setq newparms
- (append newparms
- `((top . ,adjusted-top))
- nil))))
- (modify-frame-parameters frame-initial-frame newparms)
+ (cond
+ ((and (consp top) (eq '+ (car top)))
+ (list '+ (+ (cadr top) height)))
+ ((and (consp top) (eq '- (car top)))
+ (list '- (- (cadr top) height)))
+ (t (+ top height)))))
+ (modify-frame-parameters
+ frame-initial-frame `((top . ,adjusted-top))))))
+ ;; Reset `tool-bar-mode' when zero tool bar lines have been
+ ;; requested for the window-system or default frame alists.
+ (when (and tool-bar-mode
+ (and other-lines
+ (or (null (cdr other-lines))
+ (eq 0 (cdr other-lines)))))
(tool-bar-mode -1)))))
;; The initial frame we create above always has a minibuffer.
@@ -452,6 +459,16 @@ there (in decreasing order of priority)."
(frame-set-background-mode frame-initial-frame))
(face-set-after-frame-default frame-initial-frame)
(setq newparms (delq new-bg newparms)))
+
+ (when (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons
+ (list frame-initial-frame
+ "FRAME-NOTICE-USER"
+ nil newparms)
+ (cdr frame-size-history)))))
+
(modify-frame-parameters frame-initial-frame newparms)))))
;; Restore the original buffer.
@@ -521,10 +538,15 @@ is not considered (see `next-frame')."
(defun window-system-for-display (display)
"Return the window system for DISPLAY.
Return nil if we don't know how to interpret DISPLAY."
- (cl-loop for descriptor in display-format-alist
- for pattern = (car descriptor)
- for system = (cdr descriptor)
- when (string-match-p pattern display) return system))
+ ;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
+ (if (and (eq system-type 'windows-nt)
+ (null (window-system))
+ (not (daemonp)))
+ nil
+ (cl-loop for descriptor in display-format-alist
+ for pattern = (car descriptor)
+ for system = (cdr descriptor)
+ when (string-match-p pattern display) return system)))
(defun make-frame-on-display (display &optional parameters)
"Make a frame on display DISPLAY.
@@ -587,9 +609,10 @@ The functions are run with one arg, the newly created frame.")
(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
(defvar frame-inherited-parameters '()
- ;; FIXME: Shouldn't we add `font' here as well?
"Parameters `make-frame' copies from the `selected-frame' to the new frame.")
+(defvar x-display-name)
+
(defun make-frame (&optional parameters)
"Return a newly created frame displaying the current buffer.
Optional argument PARAMETERS is an alist of frame parameters for
@@ -633,29 +656,28 @@ the new frame according to its own rules."
(interactive)
(let* ((display (cdr (assq 'display parameters)))
(w (cond
- ((assq 'terminal parameters)
- (let ((type (terminal-live-p (cdr (assq 'terminal parameters)))))
- (cond
- ((eq type t) nil)
- ((eq type nil) (error "Terminal %s does not exist"
- (cdr (assq 'terminal parameters))))
- (t type))))
- ((assq 'window-system parameters)
- (cdr (assq 'window-system parameters)))
+ ((assq 'terminal parameters)
+ (let ((type (terminal-live-p
+ (cdr (assq 'terminal parameters)))))
+ (cond
+ ((eq t type) nil)
+ ((null type) (error "Terminal %s does not exist"
+ (cdr (assq 'terminal parameters))))
+ (t type))))
+ ((assq 'window-system parameters)
+ (cdr (assq 'window-system parameters)))
(display
(or (window-system-for-display display)
- (error "Don't know how to interpret display \"%S\""
+ (error "Don't know how to interpret display %S"
display)))
- (t window-system)))
- (frame-creation-function (cdr (assq w frame-creation-function-alist)))
+ (t window-system)))
(oldframe (selected-frame))
(params parameters)
frame)
- (unless frame-creation-function
- (error "Don't know how to create a frame on window system %s" w))
(unless (get w 'window-system-initialized)
- (funcall (cdr (assq w window-system-initialization-alist)) display)
+ (let ((window-system w)) ;Hack attack!
+ (window-system-initialization display))
(setq x-display-name display)
(put w 'window-system-initialized t))
@@ -669,13 +691,26 @@ the new frame according to its own rules."
(push p params)))
;; Now make the frame.
(run-hooks 'before-make-frame-hook)
- (setq frame (funcall frame-creation-function params))
+
+;; (setq frame-size-history '(1000))
+
+ (setq frame (let ((window-system w)) ;Hack attack!
+ (frame-creation-function params)))
(normal-erase-is-backspace-setup-frame frame)
;; Inherit the original frame's parameters.
(dolist (param frame-inherited-parameters)
(unless (assq param parameters) ;Overridden by explicit parameters.
(let ((val (frame-parameter oldframe param)))
(when val (set-frame-parameter frame param val)))))
+
+ (when (numberp (car frame-size-history))
+ (setq frame-size-history
+ (cons (1- (car frame-size-history))
+ (cons (list frame "MAKE-FRAME")
+ (cdr frame-size-history)))))
+
+ ;; We can run `window-configuration-change-hook' for this frame now.
+ (frame-after-make-frame frame t)
(run-hook-with-args 'after-make-frame-functions frame)
frame))
@@ -759,7 +794,7 @@ the user during startup."
(nreverse frame-initial-geometry-arguments))
(cdr param-list))
-(declare-function x-focus-frame "xfns.c" (frame))
+(declare-function x-focus-frame "frame.c" (frame))
(defun select-frame-set-input-focus (frame &optional norecord)
"Select FRAME, raise it, and set input focus, if possible.
@@ -872,8 +907,11 @@ If there is no frame by that name, signal an error."
"The brightness of the background.
Set this to the symbol `dark' if your background color is dark,
`light' if your background is light, or nil (automatic by default)
-if you want Emacs to examine the brightness for you. Don't set this
-variable with `setq'; this won't have the expected effect."
+if you want Emacs to examine the brightness for you.
+
+If you change this without using customize, you should use
+`frame-set-background-mode' to update existing frames;
+e.g. (mapc 'frame-set-background-mode (frame-list))."
:group 'faces
:set #'(lambda (var value)
(set-default var value)
@@ -886,6 +924,9 @@ variable with `setq'; this won't have the expected effect."
(declare-function x-get-resource "frame.c"
(attribute class &optional component subclass))
+;; Only used if window-system is not null.
+(declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
+
(defvar inhibit-frame-set-background-mode nil)
(defun frame-set-background-mode (frame &optional keep-face-specs)
@@ -1077,10 +1118,10 @@ number of lines and columns.
If FRAMES is nil, apply the font to the selected frame only.
If FRAMES is non-nil, it should be a list of frames to act upon,
-or t meaning all graphical frames. Also, if FRAME is non-nil,
-alter the user's Customization settings 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."
+or t meaning all existing graphical frames.
+Also, if FRAMES is non-nil, alter the user's Customization settings
+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: "
@@ -1155,7 +1196,15 @@ To get the frame's current background color, use `frame-parameters'."
(modify-frame-parameters (selected-frame)
(list (cons 'background-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'background-color color-name)
+ ;; Pass the foreground-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'foreground-color
+ (frame-parameters))))))
(defun set-foreground-color (color-name)
"Set the foreground color of the selected frame to COLOR-NAME.
@@ -1165,7 +1214,15 @@ To get the frame's current foreground color, use `frame-parameters'."
(modify-frame-parameters (selected-frame)
(list (cons 'foreground-color color-name)))
(or window-system
- (face-set-after-frame-default (selected-frame))))
+ (face-set-after-frame-default (selected-frame)
+ (list
+ (cons 'foreground-color color-name)
+ ;; Pass the background-color as
+ ;; well, if defined, to avoid
+ ;; losing it when faces are reset
+ ;; to their defaults.
+ (assq 'background-color
+ (frame-parameters))))))
(defun set-cursor-color (color-name)
"Set the text cursor color of the selected frame to COLOR-NAME.
@@ -1246,20 +1303,173 @@ On graphical displays, it is displayed on the frame's title bar."
(list (cons 'name name))))
(defun frame-current-scroll-bars (&optional frame)
- "Return the current scroll-bar settings in frame FRAME.
-Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
-current location of the vertical scroll-bars (left, right, or nil),
-and HORIZONTAL specifies the current location of the horizontal scroll
-bars (top, bottom, or nil)."
- (let ((vert (frame-parameter frame 'vertical-scroll-bars))
- (hor nil))
- (unless (memq vert '(left right nil))
- (setq vert default-frame-scroll-bars))
- (cons vert hor)))
+ "Return the current scroll-bar types for frame FRAME.
+Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies
+the current location of the vertical scroll-bars (`left', `right'
+or nil), and HORIZONTAL specifies the current location of the
+horizontal scroll bars (`bottom' or nil). FRAME must specify a
+live frame and defaults to the selected one."
+ (let* ((frame (window-normalize-frame frame))
+ (vertical (frame-parameter frame 'vertical-scroll-bars))
+ (horizontal (frame-parameter frame 'horizontal-scroll-bars)))
+ (unless (memq vertical '(left right nil))
+ (setq vertical default-frame-scroll-bars))
+ (cons vertical (and horizontal 'bottom))))
+
+(declare-function x-frame-geometry "xfns.c" (&optional frame))
+(declare-function w32-frame-geometry "w32fns.c" (&optional frame))
+(declare-function ns-frame-geometry "nsfns.m" (&optional frame))
+
+(defun frame-geometry (&optional frame)
+ "Return geometric attributes of FRAME.
+FRAME must be a live frame and defaults to the selected one. The return
+value is an association list of the attributes listed below. All height
+and width values are in pixels.
+
+`outer-position' is a cons of the outer left and top edges of FRAME
+ relative to the origin - the position (0, 0) - of FRAME's display.
+
+`outer-size' is a cons of the outer width and height of FRAME. The
+ outer size includes the title bar and the external borders as well as
+ any menu and/or tool bar of frame.
+
+`external-border-size' is a cons of the horizontal and vertical width of
+ FRAME's external borders as supplied by the window manager.
+
+`title-bar-size' is a cons of the width and height of the title bar of
+ FRAME as supplied by the window manager. If both of them are zero,
+ FRAME has no title bar. If only the width is zero, Emacs was not
+ able to retrieve the width information.
+
+`menu-bar-external', if non-nil, means the menu bar is external (never
+ included in the inner edges of FRAME).
+
+`menu-bar-size' is a cons of the width and height of the menu bar of
+ FRAME.
+
+`tool-bar-external', if non-nil, means the tool bar is external (never
+ included in the inner edges of FRAME).
+
+`tool-bar-position' tells on which side the tool bar on FRAME is and can
+ be one of `left', `top', `right' or `bottom'. If this is nil, FRAME
+ has no tool bar.
+
+`tool-bar-size' is a cons of the width and height of the tool bar of
+ FRAME.
+
+`internal-border-width' is the width of the internal border of
+ FRAME."
+ (let* ((frame (window-normalize-frame frame))
+ (frame-type (framep-on-display frame)))
+ (cond
+ ((eq frame-type 'x)
+ (x-frame-geometry frame))
+ ((eq frame-type 'w32)
+ (w32-frame-geometry frame))
+ ((eq frame-type 'ns)
+ (ns-frame-geometry frame))
+ (t
+ (list
+ '(outer-position 0 . 0)
+ (cons 'outer-size (cons (frame-width frame) (frame-height frame)))
+ '(external-border-size 0 . 0)
+ '(title-bar-size 0 . 0)
+ '(menu-bar-external . nil)
+ (let ((menu-bar-lines (frame-parameter frame 'menu-bar-lines)))
+ (cons 'menu-bar-size
+ (if menu-bar-lines
+ (cons (frame-width frame) 1)
+ 1 0)))
+ '(tool-bar-external . nil)
+ '(tool-bar-position . nil)
+ '(tool-bar-size 0 . 0)
+ (cons 'internal-border-width
+ (frame-parameter frame 'internal-border-width)))))))
+
+(defun frame--size-history (&optional frame)
+ "Print history of resize operations for FRAME.
+Print prettified version of `frame-size-history' into a buffer
+called *frame-size-history*. Optional argument FRAME denotes the
+frame whose history will be printed. FRAME defaults to the
+selected frame."
+ (let ((history (reverse frame-size-history))
+ entry)
+ (setq frame (window-normalize-frame frame))
+ (with-current-buffer (get-buffer-create "*frame-size-history*")
+ (erase-buffer)
+ (insert (format "Frame size history of %s\n" frame))
+ (while (listp (setq entry (pop history)))
+ (when (eq (car entry) frame)
+ (pop entry)
+ (insert (format "%s" (pop entry)))
+ (move-to-column 24 t)
+ (while entry
+ (insert (format " %s" (pop entry))))
+ (insert "\n"))))))
+
+(declare-function x-frame-edges "xfns.c" (&optional frame type))
+(declare-function w32-frame-edges "w32fns.c" (&optional frame type))
+(declare-function ns-frame-edges "nsfns.m" (&optional frame type))
+
+(defun frame-edges (&optional frame type)
+ "Return coordinates of FRAME's edges.
+FRAME must be a live frame and defaults to the selected one. The
+list returned has the form (LEFT TOP RIGHT BOTTOM) where all
+values are in pixels relative to the origin - the position (0, 0)
+- of FRAME's display. For terminal frames all values are
+relative to LEFT and TOP which are both zero.
+
+Optional argument TYPE specifies the type of the edges. TYPE
+`outer-edges' means to return the outer edges of FRAME. TYPE
+`native-edges' (or nil) means to return the native edges of
+FRAME. TYPE `inner-edges' means to return the inner edges of
+FRAME."
+ (let* ((frame (window-normalize-frame frame))
+ (frame-type (framep-on-display frame)))
+ (cond
+ ((eq frame-type 'x)
+ (x-frame-edges frame type))
+ ((eq frame-type 'w32)
+ (w32-frame-edges frame type))
+ ((eq frame-type 'ns)
+ (ns-frame-edges frame type))
+ (t
+ (list 0 0 (frame-width frame) (frame-height frame))))))
+
+(declare-function w32-mouse-absolute-pixel-position "w32fns.c")
+(declare-function x-mouse-absolute-pixel-position "xfns.c")
+
+(defun mouse-absolute-pixel-position ()
+ "Return absolute position of mouse cursor in pixels.
+The position is returned as a cons cell (X . Y) of the
+coordinates of the mouse cursor position in pixels relative to a
+position (0, 0) of the selected frame's terminal."
+ (let ((frame-type (framep-on-display)))
+ (cond
+ ((eq frame-type 'x)
+ (x-mouse-absolute-pixel-position))
+ ((eq frame-type 'w32)
+ (w32-mouse-absolute-pixel-position))
+ (t
+ (cons 0 0)))))
+
+(declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y))
+(declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y))
+
+(defun set-mouse-absolute-pixel-position (x y)
+ "Move mouse pointer to absolute pixel position (X, Y).
+The coordinates X and Y are interpreted in pixels relative to a
+position (0, 0) of the selected frame's terminal."
+ (let ((frame-type (framep-on-display)))
+ (cond
+ ((eq frame-type 'x)
+ (x-set-mouse-absolute-pixel-position x y))
+ ((eq frame-type 'w32)
+ (w32-set-mouse-absolute-pixel-position x y)))))
(defun frame-monitor-attributes (&optional frame)
"Return the attributes of the physical monitor dominating FRAME.
-If FRAME is omitted, describe the currently selected frame.
+If FRAME is omitted or nil, describe the currently selected frame.
A frame is dominated by a physical monitor when either the
largest area of the frame resides in the monitor, or the monitor
@@ -1296,17 +1506,17 @@ frame's display)."
xterm-mouse-mode)
;; t-mouse is distributed with the GPM package. It doesn't have
;; a toggle.
- (featurep 't-mouse))))))
+ (featurep 't-mouse)
+ ;; No way to check whether a w32 console has a mouse, assume
+ ;; it always does.
+ (boundp 'w32-use-full-screen-buffer))))))
(defun display-popup-menus-p (&optional display)
"Return non-nil if popup menus are supported on DISPLAY.
DISPLAY can be a display name, a frame, or nil (meaning the selected
frame's display).
Support for popup menus requires that the mouse be available."
- (and
- (let ((frame-type (framep-on-display display)))
- (memq frame-type '(x w32 pc ns)))
- (display-mouse-p display)))
+ (display-mouse-p display))
(defun display-graphic-p (&optional display)
"Return non-nil if DISPLAY is a graphic display.
@@ -1338,19 +1548,21 @@ frame's display)."
(let ((frame-type (framep-on-display display)))
(cond
((eq frame-type 'pc)
- ;; MS-DOG frames support selections when Emacs runs inside
- ;; the Windows' DOS Box.
+ ;; MS-DOS frames support selections when Emacs runs inside
+ ;; a Windows DOS Box.
(with-no-warnings
(not (null dos-windows-version))))
((memq frame-type '(x w32 ns))
- t) ;; FIXME?
+ t)
(t
nil))))
(declare-function x-display-screens "xfns.c" (&optional terminal))
(defun display-screens (&optional display)
- "Return the number of screens associated with DISPLAY."
+ "Return the number of screens associated with DISPLAY.
+DISPLAY should be either a frame or a display name (a string).
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1362,7 +1574,11 @@ frame's display)."
(defun display-pixel-height (&optional display)
"Return the height of DISPLAY's screen in pixels.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+
For character terminals, each character counts as a single pixel.
+
For graphical terminals, note that on \"multi-monitor\" setups this
refers to the pixel height for all physical monitors associated
with DISPLAY. To get information for each physical monitor, use
@@ -1378,7 +1594,11 @@ with DISPLAY. To get information for each physical monitor, use
(defun display-pixel-width (&optional display)
"Return the width of DISPLAY's screen in pixels.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+
For character terminals, each character counts as a single pixel.
+
For graphical terminals, note that on \"multi-monitor\" setups this
refers to the pixel width for all physical monitors associated
with DISPLAY. To get information for each physical monitor, use
@@ -1392,14 +1612,14 @@ with DISPLAY. To get information for each physical monitor, use
(defcustom display-mm-dimensions-alist nil
"Alist for specifying screen dimensions in millimeters.
-The dimensions will be used for `display-mm-height' and
-`display-mm-width' if defined for the respective display.
+The functions `display-mm-height' and `display-mm-width' consult
+this list before asking the system.
-Each element of the alist has the form (display . (width . height)),
-e.g. (\":0.0\" . (287 . 215)).
+Each element has the form (DISPLAY . (WIDTH . HEIGHT)), e.g.
+\(\":0.0\" . (287 . 215)).
-If `display' equals t, it specifies dimensions for all graphical
-displays not explicitly specified."
+If `display' is t, it specifies dimensions for all graphical displays
+not explicitly specified."
:version "22.1"
:type '(alist :key-type (choice (string :tag "Display name")
(const :tag "Default" t))
@@ -1412,8 +1632,13 @@ displays not explicitly specified."
(defun display-mm-height (&optional display)
"Return the height of DISPLAY's screen in millimeters.
-System values can be overridden by `display-mm-dimensions-alist'.
-If the information is unavailable, value is nil.
+If the information is unavailable, this function returns nil.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+
+You can override what the system thinks the result should be by
+adding an entry to `display-mm-dimensions-alist'.
+
For graphical terminals, note that on \"multi-monitor\" setups this
refers to the height in millimeters for all physical monitors
associated with DISPLAY. To get information for each physical
@@ -1428,8 +1653,13 @@ monitor, use `display-monitor-attributes-list'."
(defun display-mm-width (&optional display)
"Return the width of DISPLAY's screen in millimeters.
-System values can be overridden by `display-mm-dimensions-alist'.
-If the information is unavailable, value is nil.
+If the information is unavailable, this function returns nil.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+
+You can override what the system thinks the result should be by
+adding an entry to `display-mm-dimensions-alist'.
+
For graphical terminals, note that on \"multi-monitor\" setups this
refers to the width in millimeters for all physical monitors
associated with DISPLAY. To get information for each physical
@@ -1447,7 +1677,9 @@ monitor, use `display-monitor-attributes-list'."
(defun display-backing-store (&optional display)
"Return the backing store capability of DISPLAY's screen.
The value may be `always', `when-mapped', `not-useful', or nil if
-the question is inapplicable to a certain kind of display."
+the question is inapplicable to a certain kind of display.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1458,7 +1690,9 @@ the question is inapplicable to a certain kind of display."
(declare-function x-display-save-under "xfns.c" (&optional terminal))
(defun display-save-under (&optional display)
- "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
+ "Return non-nil if DISPLAY's screen supports the SaveUnder feature.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1469,7 +1703,9 @@ the question is inapplicable to a certain kind of display."
(declare-function x-display-planes "xfns.c" (&optional terminal))
(defun display-planes (&optional display)
- "Return the number of planes supported by DISPLAY."
+ "Return the number of planes supported by DISPLAY.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1482,7 +1718,9 @@ the question is inapplicable to a certain kind of display."
(declare-function x-display-color-cells "xfns.c" (&optional terminal))
(defun display-color-cells (&optional display)
- "Return the number of color cells supported by DISPLAY."
+ "Return the number of color cells supported by DISPLAY.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1497,7 +1735,9 @@ the question is inapplicable to a certain kind of display."
(defun display-visual-class (&optional display)
"Return the visual class of DISPLAY.
The value is one of the symbols `static-gray', `gray-scale',
-`static-color', `pseudo-color', `true-color', or `direct-color'."
+`static-color', `pseudo-color', `true-color', or `direct-color'.
+DISPLAY can be a display name or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display."
(let ((frame-type (framep-on-display display)))
(cond
((memq frame-type '(x w32 ns))
@@ -1517,29 +1757,40 @@ The value is one of the symbols `static-gray', `gray-scale',
(defun display-monitor-attributes-list (&optional display)
"Return a list of physical monitor attributes on DISPLAY.
-Each element of the list represents the attributes of each
-physical monitor. The first element corresponds to the primary
-monitor.
+DISPLAY can be a display name, a terminal name, or a frame.
+If DISPLAY is omitted or nil, it defaults to the selected frame's display.
+Each element of the list represents the attributes of a physical
+monitor. The first element corresponds to the primary monitor.
-Attributes for a physical monitor is represented as an alist of
-attribute keys and values as follows:
+The attributes for a physical monitor are represented as an alist
+of attribute keys and values as follows:
- geometry -- Position and size in pixels in the form of
- (X Y WIDTH HEIGHT)
- workarea -- Position and size of the workarea in pixels in the
+ geometry -- Position and size in pixels in the form of (X Y WIDTH HEIGHT)
+ workarea -- Position and size of the work area in pixels in the
form of (X Y WIDTH HEIGHT)
mm-size -- Width and height in millimeters in the form of
(WIDTH HEIGHT)
frames -- List of frames dominated by the physical monitor
name (*) -- Name of the physical monitor as a string
+ source (*) -- Source of multi-monitor information as a string
+
+where X, Y, WIDTH, and HEIGHT are integers. X and Y are coordinates
+of the top-left corner, and might be negative for monitors other than
+the primary one. Keys labeled with (*) are optional.
-where X, Y, WIDTH, and HEIGHT are integers. Keys labeled
-with (*) are optional.
+The \"work area\" is a measure of the \"usable\" display space.
+It may be less than the total screen size, owing to space taken up
+by window manager features (docks, taskbars, etc.). The precise
+details depend on the platform and environment.
+
+The `source' attribute describes the source from which the information
+was obtained. On X, this may be one of: \"Gdk\", \"XRandr\", \"Xinerama\",
+or \"fallback\".
A frame is dominated by a physical monitor when either the
largest area of the frame resides in the monitor, or the monitor
is the closest to the frame if the frame does not intersect any
-physical monitors. Every non-tip frame (including invisible one)
+physical monitors. Every (non-tooltip) frame (including invisible ones)
in a graphical display is dominated by exactly one physical
monitor at a time, though it can span multiple (or no) physical
monitors."
@@ -1653,6 +1904,122 @@ left untouched. FRAME nil or omitted means use the selected frame."
'delete-frame-functions "22.1")
+;;; Window dividers.
+(defgroup window-divider nil
+ "Window dividers."
+ :version "25.1"
+ :group 'frames
+ :group 'windows)
+
+(defcustom window-divider-default-places 'right-only
+ "Default positions of window dividers.
+Possible values are `bottom-only' (dividers on the bottom of each
+window only), `right-only' (dividers on the right of each window
+only), and t (dividers on the bottom and on the right of each
+window). The default is `right-only'.
+
+The value takes effect if and only if dividers are enabled by
+`window-divider-mode'.
+
+To position dividers on frames individually, use the frame
+parameters `bottom-divider-width' and `right-divider-width'."
+ :type '(choice (const :tag "Bottom only" bottom-only)
+ (const :tag "Right only" right-only)
+ (const :tag "Bottom and right" t))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when window-divider-mode
+ (window-divider-mode-apply t)))
+ :version "25.1")
+
+(defun window-divider-width-valid-p (value)
+ "Return non-nil if VALUE is a positive number."
+ (and (numberp value) (> value 0)))
+
+(defcustom window-divider-default-bottom-width 6
+ "Default width of dividers on bottom of windows.
+The value must be a positive integer and takes effect when bottom
+dividers are displayed by `window-divider-mode'.
+
+To adjust bottom dividers for frames individually, use the frame
+parameter `bottom-divider-width'."
+ :type '(restricted-sexp
+ :tag "Default width of bottom dividers"
+ :match-alternatives (frame-window-divider-width-valid-p))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when window-divider-mode
+ (window-divider-mode-apply t)))
+ :version "25.1")
+
+(defcustom window-divider-default-right-width 6
+ "Default width of dividers on the right of windows.
+The value must be a positive integer and takes effect when right
+dividers are displayed by `window-divider-mode'.
+
+To adjust right dividers for frames individually, use the frame
+parameter `right-divider-width'."
+ :type '(restricted-sexp
+ :tag "Default width of right dividers"
+ :match-alternatives (frame-window-divider-width-valid-p))
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when window-divider-mode
+ (window-divider-mode-apply t)))
+ :version "25.1")
+
+(defun window-divider-mode-apply (enable)
+ "Apply window divider places and widths to all frames.
+If ENABLE is nil, apply default places and widths. Else reset
+all divider widths to zero."
+ (let ((bottom (if (and enable
+ (memq window-divider-default-places
+ '(bottom-only t)))
+ window-divider-default-bottom-width
+ 0))
+ (right (if (and enable
+ (memq window-divider-default-places
+ '(right-only t)))
+ window-divider-default-right-width
+ 0)))
+ (modify-all-frames-parameters
+ (list (cons 'bottom-divider-width bottom)
+ (cons 'right-divider-width right)))
+ (setq default-frame-alist
+ (assq-delete-all
+ 'bottom-divider-width default-frame-alist))
+ (setq default-frame-alist
+ (assq-delete-all
+ 'right-divider-width default-frame-alist))
+ (when (> bottom 0)
+ (setq default-frame-alist
+ (cons
+ (cons 'bottom-divider-width bottom)
+ default-frame-alist)))
+ (when (> right 0)
+ (setq default-frame-alist
+ (cons
+ (cons 'right-divider-width right)
+ default-frame-alist)))))
+
+(define-minor-mode window-divider-mode
+ "Display dividers between windows (Window Divider mode).
+With a prefix argument ARG, enable Window Divider mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+The option `window-divider-default-places' specifies on which
+side of a window dividers are displayed. The options
+`window-divider-default-bottom-width' and
+`window-divider-default-right-width' specify their respective
+widths."
+ :group 'window-divider
+ :global t
+ (window-divider-mode-apply window-divider-mode))
+
;; Blinking cursor
(defgroup cursor nil
@@ -1671,14 +2038,14 @@ left untouched. FRAME nil or omitted means use the selected frame."
:group 'cursor)
(defcustom blink-cursor-blinks 10
- "How many times to blink before using a solid cursor on NS and X.
+ "How many times to blink before using a solid cursor on NS, X, and MS-Windows.
Use 0 or negative value to blink forever."
:version "24.4"
:type 'integer
:group 'cursor)
(defvar blink-cursor-blinks-done 1
- "Number of blinks done since we started blinking on NS and X")
+ "Number of blinks done since we started blinking on NS, X, and MS-Windows.")
(defvar blink-cursor-idle-timer nil
"Timer started after `blink-cursor-delay' seconds of Emacs idle time.
@@ -1707,13 +2074,16 @@ command starts, by installing a pre-command hook."
(defun blink-cursor-timer-function ()
"Timer function of timer `blink-cursor-timer'."
(internal-show-cursor nil (not (internal-show-cursor-p)))
+ ;; Suspend counting blinks when the w32 menu-bar menu is displayed,
+ ;; since otherwise menu tooltips will behave erratically.
+ (or (and (fboundp 'w32--menu-bar-in-use)
+ (w32--menu-bar-in-use))
+ (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)))
;; Each blink is two calls to this function.
- (when (memq window-system '(x ns w32))
- (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done))
- (when (and (> blink-cursor-blinks 0)
- (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
- (blink-cursor-suspend)
- (add-hook 'post-command-hook 'blink-cursor-check))))
+ (when (and (> blink-cursor-blinks 0)
+ (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
+ (blink-cursor-suspend)
+ (add-hook 'post-command-hook 'blink-cursor-check)))
(defun blink-cursor-end ()
@@ -1728,15 +2098,14 @@ itself as a pre-command hook."
(setq blink-cursor-timer nil)))
(defun blink-cursor-suspend ()
- "Suspend cursor blinking on NS, X and W32.
+ "Suspend cursor blinking.
This is called when no frame has focus and timers can be suspended.
Timers are restarted by `blink-cursor-check', which is called when a
frame receives focus."
- (when (memq window-system '(x ns w32))
- (blink-cursor-end)
- (when blink-cursor-idle-timer
- (cancel-timer blink-cursor-idle-timer)
- (setq blink-cursor-idle-timer nil))))
+ (blink-cursor-end)
+ (when blink-cursor-idle-timer
+ (cancel-timer blink-cursor-idle-timer)
+ (setq blink-cursor-idle-timer nil)))
(defun blink-cursor-check ()
"Check if cursor blinking shall be restarted.
@@ -1758,6 +2127,12 @@ With a prefix argument ARG, enable Blink Cursor mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
+If the value of `blink-cursor-blinks' is positive (10 by default),
+the cursor stops blinking after that number of blinks, if Emacs
+gets no input during that time.
+
+See also `blink-cursor-interval' and `blink-cursor-delay'.
+
This command is effective only on graphical frames. On text-only
terminals, cursor blinking is controlled by the terminal."
:init-value (not (or noninteractive
@@ -1767,62 +2142,71 @@ terminals, cursor blinking is controlled by the terminal."
:initialize 'custom-initialize-delay
:group 'cursor
:global t
- (if blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
- (setq blink-cursor-idle-timer nil)
- (blink-cursor-end)
+ (blink-cursor-suspend)
+ (remove-hook 'focus-in-hook #'blink-cursor-check)
+ (remove-hook 'focus-out-hook #'blink-cursor-suspend)
(when blink-cursor-mode
- ;; Hide the cursor.
- ;;(internal-show-cursor nil nil)
+ (add-hook 'focus-in-hook #'blink-cursor-check)
+ (add-hook 'focus-out-hook #'blink-cursor-suspend)
(setq blink-cursor-idle-timer
(run-with-idle-timer blink-cursor-delay
blink-cursor-delay
- 'blink-cursor-start))))
+ #'blink-cursor-start))))
;; Frame maximization/fullscreen
(defun toggle-frame-maximized ()
- "Toggle maximization state of the selected frame.
-Maximize the selected frame or un-maximize if it is already maximized.
-Respect window manager screen decorations.
-If the frame is in fullscreen mode, don't change its mode,
-just toggle the temporary frame parameter `maximized',
-so the frame will go to the right maximization state
-after disabling fullscreen mode.
+ "Toggle maximization state of selected frame.
+Maximize selected frame or un-maximize if it is already maximized.
+
+If the frame is in fullscreen state, don't change its state, but
+set the frame's `fullscreen-restore' parameter to `maximized', so
+the frame will be maximized after disabling fullscreen state.
+
+Note that with some window managers you may have to set
+`frame-resize-pixelwise' to non-nil in order to make a frame
+appear truly maximized. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
+
See also `toggle-frame-fullscreen'."
(interactive)
- (if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized))))
- (modify-frame-parameters
- nil
- `((fullscreen
- . ,(unless (eq (frame-parameter nil 'fullscreen) 'maximized)
- 'maximized))))))
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (cond
+ ((memq fullscreen '(fullscreen fullboth))
+ (set-frame-parameter nil 'fullscreen-restore 'maximized))
+ ((eq fullscreen 'maximized)
+ (set-frame-parameter nil 'fullscreen nil))
+ (t
+ (set-frame-parameter nil 'fullscreen 'maximized)))))
(defun toggle-frame-fullscreen ()
- "Toggle fullscreen mode of the selected frame.
-Enable fullscreen mode of the selected frame or disable if it is
-already fullscreen. Ignore window manager screen decorations.
-When turning on fullscreen mode, remember the previous value of the
-maximization state in the temporary frame parameter `maximized'.
-Restore the maximization state when turning off fullscreen mode.
+ "Toggle fullscreen state of selected frame.
+Make selected frame fullscreen or restore its previous size if it
+is already fullscreen.
+
+Before making the frame fullscreen remember the current value of
+the frame's `fullscreen' parameter in the `fullscreen-restore'
+parameter of the frame. That value is used to restore the
+frame's fullscreen state when toggling fullscreen the next time.
+
+Note that with some window managers you may have to set
+`frame-resize-pixelwise' to non-nil in order to make a frame
+appear truly fullscreen. In addition, you may have to set
+`x-frame-normalize-before-maximize' in order to enable
+transitions from one fullscreen state to another.
+
See also `toggle-frame-maximized'."
(interactive)
- (modify-frame-parameters
- nil
- `((maximized
- . ,(unless (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (frame-parameter nil 'fullscreen)))
- (fullscreen
- . ,(if (memq (frame-parameter nil 'fullscreen) '(fullscreen fullboth))
- (if (eq (frame-parameter nil 'maximized) 'maximized)
- 'maximized)
- 'fullscreen)))))
-
+ (let ((fullscreen (frame-parameter nil 'fullscreen)))
+ (if (memq fullscreen '(fullscreen fullboth))
+ (let ((fullscreen-restore (frame-parameter nil 'fullscreen-restore)))
+ (if (memq fullscreen-restore '(maximized fullheight fullwidth))
+ (set-frame-parameter nil 'fullscreen fullscreen-restore)
+ (set-frame-parameter nil 'fullscreen nil)))
+ (modify-frame-parameters
+ nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
;;;; Key bindings
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 53ab0a5f081..17fe39be844 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -1,6 +1,6 @@
;;; frameset.el --- save and restore frame and window setup -*- lexical-binding: t -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Juanma Barranquero <lekktu@gmail.com>
;; Keywords: convenience
@@ -417,11 +417,11 @@ Properties can be set with
;; `frameset-filter-params' can be useful, even if you're not using
;; framesets. The interface of `frameset-filter-params' is generic
;; and does not depend of global state, with one exception: it uses
-;; the internal variable `frameset--target-display' to decide if, and
-;; how, to modify the `display' parameter of FILTERED. But that
-;; should not represent any problem, because it's only meaningful
-;; when restoring, and customized uses of `frameset-filter-params'
-;; are likely to use their own filter alist and just call
+;; the dynamically bound variable `frameset--target-display' to decide
+;; if, and how, to modify the `display' parameter of FILTERED. That
+;; should not represent a problem, because it's only meaningful when
+;; restoring, and customized uses of `frameset-filter-params' are
+;; likely to use their own filter alist and just call
;;
;; (setq my-filtered (frameset-filter-params my-params my-filters t))
;;
@@ -522,14 +522,13 @@ It must return:
Frame parameters not on this alist are passed intact, as if they were
defined with ACTION = nil.")
-
-(defvar frameset--target-display nil
- ;; Either (minibuffer . VALUE) or nil.
- ;; This refers to the current frame config being processed inside
- ;; `frameset-restore' and its auxiliary functions (like filtering).
- ;; If nil, there is no need to change the display.
- ;; If non-nil, display parameter to use when creating the frame.
- "Internal use only.")
+;; Dynamically bound in `frameset-save', `frameset-restore'.
+(defvar frameset--target-display)
+;; Either (display . VALUE) or nil.
+;; This refers to the current frame config being processed with
+;; `frameset-filter-params' and its auxiliary filtering functions.
+;; If nil, there is no need to change the display.
+;; If non-nil, display parameter to use when creating the frame.
(defun frameset-switch-to-gui-p (parameters)
"True when switching to a graphic display.
@@ -665,10 +664,7 @@ nil while the filtering is done to restore it."
;; Set the display parameter after filtering, so that filter functions
;; have access to its original value.
(when frameset--target-display
- (let ((display (assq 'display filtered)))
- (if display
- (setcdr display (cdr frameset--target-display))
- (push frameset--target-display filtered))))
+ (setf (alist-get 'display filtered) (cdr frameset--target-display)))
filtered))
@@ -683,6 +679,11 @@ Internal use only."
(mapconcat (lambda (n) (format "%04X" n))
(cl-loop repeat 4 collect (random 65536))
"-"))))
+
+(defun frameset-cfg-id (frame-cfg)
+ "Return the frame id for frame configuration FRAME-CFG."
+ (cdr (assq 'frameset--id frame-cfg)))
+
;;;###autoload
(defun frameset-frame-id (frame)
"Return the frame id of FRAME, if it has one; else, return nil.
@@ -756,6 +757,7 @@ PREDICATE is a predicate function, which must return non-nil for frames that
should be saved; if PREDICATE is nil, all frames from FRAME-LIST are saved.
PROPERTIES is a user-defined property list to add to the frameset."
(let* ((list (or (copy-sequence frame-list) (frame-list)))
+ (frameset--target-display nil)
(frames (cl-delete-if-not #'frame-live-p
(if predicate
(cl-delete-if-not predicate list)
@@ -782,10 +784,9 @@ PROPERTIES is a user-defined property list to add to the frameset."
;; Restoring framesets
-(defvar frameset--reuse-list nil
- "The list of frames potentially reusable.
-Its value is only meaningful during execution of `frameset-restore'.
-Internal use only.")
+;; Dynamically bound in `frameset-restore'.
+(defvar frameset--reuse-list)
+(defvar frameset--action-map)
(defun frameset-compute-pos (value left/top right/bottom)
"Return an absolute positioning value for a frame.
@@ -867,7 +868,7 @@ NOTE: This only works for non-iconified frames."
(modify-frame-parameters frame params))))))
(defun frameset--find-frame-if (predicate display &rest args)
- "Find a frame in `frameset--reuse-list' satisfying PREDICATE.
+ "Find a reusable frame satisfying PREDICATE.
Look through available frames whose display property matches DISPLAY
and return the first one for which (PREDICATE frame ARGS) returns t.
If PREDICATE is nil, it is always satisfied. Internal use only."
@@ -901,7 +902,7 @@ is the parameter alist of the frame being restored. Internal use only."
(setq frame (frameset--find-frame-if
(lambda (f id)
(frameset-frame-id-equal-p f id))
- display (cdr (assq 'frameset--id parameters))))
+ display (frameset-cfg-id parameters)))
;; If it has not been loaded, and it is not a minibuffer-only frame,
;; let's look for an existing non-minibuffer-only frame to reuse.
(unless (or frame (eq (cdr (assq 'minibuffer parameters)) 'only))
@@ -922,8 +923,7 @@ is the parameter alist of the frame being restored. Internal use only."
(frameset-frame-id-equal-p
(window-frame (minibuffer-window f))
mini-id))))
- display
- (cdr (assq 'frameset--id parameters)) (cdr mini))))
+ display (frameset-cfg-id parameters) (cdr mini))))
(t
;; Default to just finding a frame in the same display.
(setq frame (frameset--find-frame-if nil display))))
@@ -937,8 +937,8 @@ is the parameter alist of the frame being restored. Internal use only."
Setting position and size parameters as soon as possible helps reducing
flickering; other parameters, like `minibuffer' and `border-width', can
not be changed once the frame has been created. Internal use only."
- (cl-loop for param in '(left top with height border-width minibuffer)
- collect (assq param parameters)))
+ (cl-loop for param in '(left top width height border-width minibuffer)
+ when (assq param parameters) collect it))
(defun frameset--restore-frame (parameters window-state filters force-onscreen)
"Set up and return a frame according to its saved state.
@@ -947,15 +947,10 @@ PARAMETERS is the frame's parameter alist; WINDOW-STATE is its window state.
For the meaning of FILTERS and FORCE-ONSCREEN, see `frameset-restore'.
Internal use only."
(let* ((fullscreen (cdr (assq 'fullscreen parameters)))
- (lines (assq 'tool-bar-lines parameters))
(filtered-cfg (frameset-filter-params parameters filters nil))
(display (cdr (assq 'display filtered-cfg))) ;; post-filtering
alt-cfg frame)
- ;; This works around bug#14795 (or feature#14795, if not a bug :-)
- (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
- (push '(tool-bar-lines . 0) filtered-cfg)
-
(when fullscreen
;; Currently Emacs has the limitation that it does not record the size
;; and position of a frame before maximizing it, so we cannot save &
@@ -979,16 +974,20 @@ Internal use only."
(push visible alt-cfg)
(push (cons 'fullscreen fullscreen) alt-cfg)))
- ;; Time to find or create a frame an apply the big bunch of parameters.
- ;; If a frame needs to be created and it falls partially or fully offscreen,
- ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is
- ;; allowed. So we create the frame as invisible and then reapply the full
- ;; parameter alist (including position and size parameters).
- (setq frame (or (and frameset--reuse-list
- (frameset--reuse-frame display filtered-cfg))
- (make-frame-on-display display
- (cons '(visibility)
- (frameset--initial-params filtered-cfg)))))
+ ;; Time to find or create a frame and apply the big bunch of parameters.
+ (setq frame (and frameset--reuse-list
+ (frameset--reuse-frame display filtered-cfg)))
+ (if frame
+ (puthash frame :reused frameset--action-map)
+ ;; If a frame needs to be created and it falls partially or fully offscreen,
+ ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is
+ ;; allowed. So we create the frame as invisible and then reapply the full
+ ;; parameter alist (including position and size parameters).
+ (setq frame (make-frame-on-display display
+ (cons '(visibility)
+ (frameset--initial-params filtered-cfg))))
+ (puthash frame :created frameset--action-map))
+
(modify-frame-parameters frame
(if (eq (frame-parameter frame 'fullscreen) fullscreen)
;; Workaround for bug#14949
@@ -1002,8 +1001,7 @@ Internal use only."
(not (eq (frame-parameter frame 'visibility) 'icon)))
(frameset-move-onscreen frame force-onscreen))
- ;; Let's give the finishing touches (visibility, tool-bar, maximization).
- (when lines (push lines alt-cfg))
+ ;; Let's give the finishing touches (visibility, maximization).
(when alt-cfg (modify-frame-parameters frame alt-cfg))
;; Now restore window state.
(window-state-put window-state (frame-root-window frame) 'safe)
@@ -1024,8 +1022,8 @@ Internal use only."
(defun frameset-keep-original-display-p (force-display)
"True if saved frames' displays should be honored.
For the meaning of FORCE-DISPLAY, see `frameset-restore'."
- (cond ((daemonp) t)
- ((eq system-type 'windows-nt) nil) ;; Does ns support more than one display?
+ (cond ((eq system-type 'windows-nt) nil) ;; Does ns support more than one display?
+ ((daemonp) t)
(t (not force-display))))
(defun frameset-minibufferless-first-p (frame1 _frame2)
@@ -1035,7 +1033,8 @@ For the meaning of FORCE-DISPLAY, see `frameset-restore'."
;;;###autoload
(cl-defun frameset-restore (frameset
&key predicate filters reuse-frames
- force-display force-onscreen)
+ force-display force-onscreen
+ cleanup-frames)
"Restore a FRAMESET into the current display(s).
PREDICATE is a function called with two arguments, the parameter alist
@@ -1047,58 +1046,79 @@ and window-state is not restored.
FILTERS is an alist of parameter filters; if nil, the value of
`frameset-filter-alist' is used instead.
-REUSE-FRAMES selects the policy to use to reuse frames when restoring:
- t Reuse existing frames if possible, and delete those not reused.
- nil Restore frameset in new frames and delete existing frames.
- :keep Restore frameset in new frames and keep the existing ones.
- LIST A list of frames to reuse; only these are reused (if possible).
- Remaining frames in this list are deleted; other frames not
- included on the list are left untouched.
+REUSE-FRAMES selects the policy to reuse frames when restoring:
+ t All existing frames can be reused.
+ nil No existing frame can be reused.
+ match Only frames with matching frame ids can be reused.
+ PRED A predicate function; it receives as argument a live frame,
+ and must return non-nil to allow reusing it, nil otherwise.
FORCE-DISPLAY can be:
t Frames are restored in the current display.
nil Frames are restored, if possible, in their original displays.
- :delete Frames in other displays are deleted instead of restored.
+ delete Frames in other displays are deleted instead of restored.
PRED A function called with two arguments, the parameter alist and
the window state (in that order). It must return t, nil or
- `:delete', as above but affecting only the frame that will
+ `delete', as above but affecting only the frame that will
be created from that parameter alist.
FORCE-ONSCREEN can be:
t Force onscreen only those frames that are fully offscreen.
nil Do not force any frame back onscreen.
- :all Force onscreen any frame fully or partially offscreen.
+ all Force onscreen any frame fully or partially offscreen.
PRED A function called with three arguments,
- the live frame just restored,
- a list (LEFT TOP WIDTH HEIGHT), describing the frame,
- a list (LEFT TOP WIDTH HEIGHT), describing the workarea.
It must return non-nil to force the frame onscreen, nil otherwise.
+CLEANUP-FRAMES allows to \"clean up\" the frame list after restoring a frameset:
+ t Delete all frames that were not created or restored upon.
+ nil Keep all frames.
+ FUNC A function called with two arguments:
+ - FRAME, a live frame.
+ - ACTION, which can be one of
+ :rejected Frame existed, but was not a candidate for reuse.
+ :ignored Frame existed, was a candidate, but wasn't reused.
+ :reused Frame existed, was a candidate, and restored upon.
+ :created Frame didn't exist, was created and restored upon.
+ Return value is ignored.
+
Note the timing and scope of the operations described above: REUSE-FRAMES
affects existing frames; PREDICATE, FILTERS and FORCE-DISPLAY affect the frame
-being restored before that happens; and FORCE-ONSCREEN affects the frame once
-it has been restored.
+being restored before that happens; FORCE-ONSCREEN affects the frame once
+it has been restored; and CLEANUP-FRAMES affects all frames alive after the
+restoration, including those that have been reused or created anew.
All keyword parameters default to nil."
(cl-assert (frameset-valid-p frameset))
- (let (other-frames)
-
- ;; frameset--reuse-list is a list of frames potentially reusable. Later we
- ;; will decide which ones can be reused, and how to deal with any leftover.
- (pcase reuse-frames
- ((or `nil `:keep)
- (setq frameset--reuse-list nil
- other-frames (frame-list)))
- ((pred consp)
- (setq frameset--reuse-list (copy-sequence reuse-frames)
- other-frames (cl-delete-if (lambda (frame)
- (memq frame frameset--reuse-list))
- (frame-list))))
- (_
- (setq frameset--reuse-list (frame-list)
- other-frames nil)))
+ (let* ((frames (frame-list))
+ (frameset--action-map (make-hash-table :test #'eq))
+ ;; frameset--reuse-list is a list of frames potentially reusable. Later we
+ ;; will decide which ones can be reused, and how to deal with any leftover.
+ (frameset--reuse-list
+ (pcase reuse-frames
+ (`t
+ frames)
+ (`nil
+ nil)
+ (`match
+ (cl-loop for (state) in (frameset-states frameset)
+ when (frameset-frame-with-id (frameset-cfg-id state) frames)
+ collect it))
+ ((pred functionp)
+ (cl-remove-if-not reuse-frames frames))
+ (_
+ (error "Invalid arg :reuse-frames %s" reuse-frames)))))
+
+ ;; Mark existing frames in the map; candidates to reuse are marked as :ignored;
+ ;; they will be reassigned later, if chosen.
+ (dolist (frame frames)
+ (puthash frame
+ (if (memq frame frameset--reuse-list) :ignored :rejected)
+ frameset--action-map))
;; Sort saved states to guarantee that minibufferless frames will be created
;; after the frames that contain their minibuffer windows.
@@ -1113,34 +1133,29 @@ All keyword parameters default to nil."
(force-display (if (functionp force-display)
(funcall force-display frame-cfg window-cfg)
force-display))
- frame to-tty)
+ (frameset--target-display nil)
+ frame to-tty duplicate)
;; Only set target if forcing displays and the target display is different.
- (cond ((frameset-keep-original-display-p force-display)
- (setq frameset--target-display nil))
- ((eq (frame-parameter nil 'display) (cdr (assq 'display frame-cfg)))
- (setq frameset--target-display nil))
- (t
- (setq frameset--target-display (cons 'display
- (frame-parameter nil 'display))
- to-tty (null (cdr frameset--target-display)))))
+ (unless (or (frameset-keep-original-display-p force-display)
+ (equal (frame-parameter nil 'display)
+ (cdr (assq 'display frame-cfg))))
+ (setq frameset--target-display (cons 'display
+ (frame-parameter nil 'display))
+ to-tty (null (cdr frameset--target-display))))
;; Time to restore frames and set up their minibuffers as they were.
;; We only skip a frame (thus deleting it) if either:
;; - we're switching displays, and the user chose the option to delete, or
;; - we're switching to tty, and the frame to restore is minibuffer-only.
(unless (and frameset--target-display
- (or (eq force-display :delete)
+ (or (eq force-display 'delete)
(and to-tty
(eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
- ;; If keeping non-reusable frames, and the frameset--id of one of them
- ;; matches the id of a frame being restored (because, for example, the
- ;; frameset has already been read in the same session), remove the
- ;; frameset--id from the non-reusable frame, which is not useful anymore.
- (when (and other-frames
- (or (eq reuse-frames :keep) (consp reuse-frames)))
- (let ((dup (frameset-frame-with-id (cdr (assq 'frameset--id frame-cfg))
- other-frames)))
- (when dup
- (set-frame-parameter dup 'frameset--id nil))))
+ ;; To avoid duplicating frame ids after restoration, we note any
+ ;; existing frame whose id matches a frame configuration in the
+ ;; frameset. Once the frame config is properly restored, we can
+ ;; reset the old frame's id to nil.
+ (setq duplicate (frameset-frame-with-id (frameset-cfg-id frame-cfg)
+ frames))
;; Restore minibuffers. Some of this stuff could be done in a filter
;; function, but it would be messy because restoring minibuffers affects
;; global state; it's best to do it here than add a bunch of global
@@ -1174,6 +1189,9 @@ All keyword parameters default to nil."
(setq frame (frameset--restore-frame frame-cfg window-cfg
(or filters frameset-filter-alist)
force-onscreen))
+ ;; Now reset any duplicate frameset--id
+ (when (and duplicate (not (eq frame duplicate)))
+ (set-frame-parameter duplicate 'frameset--id nil))
;; Set default-minibuffer if required.
(when default (setq default-minibuffer-frame frame))))
(error
@@ -1183,48 +1201,86 @@ All keyword parameters default to nil."
;; other frames are already visible (discussed in thread for bug#14841).
(sit-for 0 t)
- ;; Delete remaining frames, but do not fail if some resist being deleted.
- (unless (eq reuse-frames :keep)
- (dolist (frame (sort (nconc (if (listp reuse-frames) nil other-frames)
- frameset--reuse-list)
- ;; Minibufferless frames must go first to avoid
- ;; errors when attempting to delete a frame whose
- ;; minibuffer window is used by another frame.
- #'frameset-minibufferless-first-p))
- (condition-case err
- (delete-frame frame)
- (error
- (delay-warning 'frameset (error-message-string err))))))
- (setq frameset--reuse-list nil
- frameset--target-display nil)
+ ;; Clean up the frame list
+ (when cleanup-frames
+ (let ((map nil)
+ (cleanup (if (eq cleanup-frames t)
+ (lambda (frame action)
+ (when (memq action '(:rejected :ignored))
+ (delete-frame frame)))
+ cleanup-frames)))
+ (maphash (lambda (frame _action) (push frame map)) frameset--action-map)
+ (dolist (frame (sort map
+ ;; Minibufferless frames must go first to avoid
+ ;; errors when attempting to delete a frame whose
+ ;; minibuffer window is used by another frame.
+ #'frameset-minibufferless-first-p))
+ (condition-case-unless-debug err
+ (funcall cleanup frame (gethash frame frameset--action-map))
+ (error
+ (delay-warning 'frameset (error-message-string err) :warning))))))
;; Make sure there's at least one visible frame.
- (unless (or (daemonp) (visible-frame-list))
- (make-frame-visible (car (frame-list))))))
+ (unless (or (daemonp)
+ (catch 'visible
+ (maphash (lambda (frame _)
+ (and (frame-live-p frame) (frame-visible-p frame)
+ (throw 'visible t)))
+ frameset--action-map)))
+ (make-frame-visible (selected-frame)))))
;; Register support
+;;;###autoload
(defun frameset--jump-to-register (data)
"Restore frameset from DATA stored in register.
Called from `jump-to-register'. Internal use only."
- (let* ((delete (and current-prefix-arg t))
- (iconify-list (if delete nil (frame-list))))
- (frameset-restore (aref data 0)
- :filters frameset-session-filter-alist
- :reuse-frames (if delete t :keep))
- (mapc #'iconify-frame iconify-list)
- (let ((frame (frameset-frame-with-id (aref data 1))))
- (when frame
- (select-frame-set-input-focus frame)
- (goto-char (aref data 2))))))
+ (frameset-restore
+ (aref data 0)
+ :filters frameset-session-filter-alist
+ :reuse-frames (if current-prefix-arg t 'match)
+ :cleanup-frames (if current-prefix-arg
+ ;; delete frames
+ nil
+ ;; iconify frames
+ (lambda (frame action)
+ (pcase action
+ (`rejected (iconify-frame frame))
+ ;; In the unexpected case that a frame was a candidate
+ ;; (matching frame id) and yet not restored, remove it
+ ;; because it is in fact a duplicate.
+ (`ignored (delete-frame frame))))))
+
+ ;; Restore selected frame, buffer and point.
+ (let ((frame (frameset-frame-with-id (aref data 1)))
+ buffer window)
+ (when frame
+ (select-frame-set-input-focus frame)
+ (when (and (buffer-live-p (setq buffer (marker-buffer (aref data 2))))
+ (window-live-p (setq window (get-buffer-window buffer frame))))
+ (set-frame-selected-window frame window)
+ (with-current-buffer buffer (goto-char (aref data 2)))))))
;;;###autoload
-(defun frameset-to-register (register &optional _arg)
+(defun frameset--print-register (data)
+ "Print basic info about frameset stored in DATA.
+Called from `list-registers' and `view-register'. Internal use only."
+ (let* ((fs (aref data 0))
+ (ns (length (frameset-states fs))))
+ (princ (format "a frameset (%d frame%s, saved on %s)."
+ ns
+ (if (= 1 ns) "" "s")
+ (format-time-string "%c" (frameset-timestamp fs))))))
+
+;;;###autoload
+(defun frameset-to-register (register)
"Store the current frameset in register REGISTER.
Use \\[jump-to-register] to restore the frameset.
-Argument is a character, naming the register."
- (interactive "cFrameset to register: \nP")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Frameset to register: ")))
(set-register register
(registerv-make
(vector (frameset-save nil
@@ -1234,7 +1290,7 @@ Argument is a character, naming the register."
;; in the current buffer, so record that separately.
(frameset-frame-id nil)
(point-marker))
- :print-func (lambda (_data) (princ "a frameset."))
+ :print-func #'frameset--print-register
:jump-func #'frameset--jump-to-register)))
(provide 'frameset)
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 66ea980e3dc..8524f2ad2a2 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -1,9 +1,9 @@
-;;; fringe.el --- fringe setup and control -*- coding: utf-8 -*-
+;;; fringe.el --- fringe setup and control
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: frames
;; Package: emacs
@@ -83,9 +83,9 @@
(hollow-small . hollow-square))))
-(defmacro fringe-bitmap-p (symbol)
+(defun fringe-bitmap-p (symbol)
"Return non-nil if SYMBOL is a fringe bitmap."
- `(get ,symbol 'fringe))
+ (get symbol 'fringe))
;; Control presence of fringes
@@ -152,12 +152,11 @@ See `fringe-mode' for possible values and their effect."
("minimal" . (1 . 1)))
"Alist mapping fringe mode names to fringe widths.
Each list element has the form (NAME . WIDTH), where NAME is a
-mnemonic fringe mode name (a symbol) and WIDTH is one of the
-following:
+mnemonic fringe mode name and WIDTH is one of the following:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
respectively the left and right fringe widths in pixels, or
- nil (meaning to disable that fringe).
+ nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
fringes.")
@@ -167,7 +166,7 @@ The Lisp value should be one of the following:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
respectively the left and right fringe widths in pixels, or
- nil (meaning to disable that fringe).
+ nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
fringes.
Note that the actual width may be rounded up to ensure that the
@@ -238,7 +237,7 @@ When used in a Lisp program, MODE should be one of these:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
respectively the left and right fringe widths in pixels, or
- nil (meaning to disable that fringe).
+ nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
fringes.
This command may round up the left and right width specifications
@@ -263,7 +262,7 @@ When used in a Lisp program, MODE should be one of these:
- nil, which means the default width (8 pixels).
- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are
respectively the left and right fringe widths in pixels, or
- nil (meaning to disable that fringe).
+ nil (meaning the default width).
- a single integer, which specifies the pixel widths of both
fringes.
This command may round up the left and right width specifications
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index c964b53952e..56e1761ae51 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1,6 +1,6 @@
;;; generic-x.el --- A collection of generic modes
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Tue Oct 08 1996
@@ -1283,18 +1283,22 @@ like an INI file. You can add this hook to `find-file-hook'."
"WIN32SMINOR")
"Function argument constants used in InstallShield 3 and 5."))
-(defvar rul-generic-mode-syntax-table nil
+;; c++-mode-syntax-table used to be autoloaded, with an initial nil value.
+;; This file did not load cc-mode, and therefore rul-generic-mode-syntax-table
+;; would have different values according to whether or not cc-mode
+;; happened to be loaded before this file was.
+(require 'cc-mode)
+(defvar c++-mode-syntax-table)
+
+(defvar rul-generic-mode-syntax-table
+ (let ((table (make-syntax-table c++-mode-syntax-table)))
+ (modify-syntax-entry ?\r "> b" table)
+ (modify-syntax-entry ?\n "> b" table)
+ (modify-syntax-entry ?/ ". 124b" table)
+ (modify-syntax-entry ?* ". 23" table)
+ table)
"Syntax table to use in `rul-generic-mode' buffers.")
-(setq rul-generic-mode-syntax-table
- (make-syntax-table c++-mode-syntax-table))
-
-(modify-syntax-entry ?\r "> b" rul-generic-mode-syntax-table)
-(modify-syntax-entry ?\n "> b" rul-generic-mode-syntax-table)
-
-(modify-syntax-entry ?/ ". 124b" rul-generic-mode-syntax-table)
-(modify-syntax-entry ?* ". 23" rul-generic-mode-syntax-table)
-
;; here manually instead
(defun generic-rul-mode-setup-function ()
(make-local-variable 'parse-sexp-ignore-comments)
@@ -1646,7 +1650,7 @@ like an INI file. You can add this hook to `find-file-hook'."
(defun named-database-print-serial ()
"Print a serial number based on the current date."
(interactive)
- (insert (format-time-string named-database-time-string (current-time)))))
+ (insert (format-time-string named-database-time-string))))
(when (memq 'resolve-conf-generic-mode generic-extras-enable-list)
diff --git a/lisp/gnus/.gitignore b/lisp/gnus/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/gnus/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index 9a71bc35b41..1e37e44717e 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -277,8 +277,8 @@
1998-08-26 Mike McEwan <mike@lotusland.demon.co.uk>
* gnus-sum.el (gnus-build-all-threads): `save-excursion' and
- `set-buffer' back to `gnus-summary-buffer' in order to access
- buffer-local variables.
+ `set-buffer' back to `gnus-summary-buffer' in order to access
+ buffer-local variables.
1998-08-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -386,11 +386,11 @@
* gnus-start.el (gnus-save-newsrc-file): Use coding system.
-1980-06-08 Mike McEwan <mike@lotusland.demon.co.uk>
+1998-08-18 Mike McEwan <mike@lotusland.demon.co.uk>
* gnus-agent.el (gnus-agent-braid-nov): Go to right place.
-1980-06-08 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+1998-08-18 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
* gnus-group.el (gnus-group-suspend): Fix.
@@ -638,7 +638,7 @@
1998-08-09 Simon Josefsson <jas@pdc.kth.se>
- * gnus-srvr.el (gnus-browse-make-menu-bar): select did read
+ * gnus-srvr.el (gnus-browse-make-menu-bar): select did read
1998-08-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -794,7 +794,7 @@
1998-07-19 16:59 Simon Josefsson <jas@pdc.kth.se>
- * gnus-util.el (gnus-netrc-syntax-table): @ is whitespace
+ * gnus-util.el (gnus-netrc-syntax-table): @ is whitespace
1998-07-17 Gordon Matzigkeit <gord@fig.org>
@@ -910,10 +910,10 @@
1998-07-11 Mike McEwan <mike@lotusland.demon.co.uk>
* gnus-agent.el (gnus-agent-fetch-headers): Note last fetched
- headers per sesion to aid expiry in `headers only' groups.
+ headers per sesion to aid expiry in `headers only' groups.
* gnus-agent.el (gnus-agent-expire): Update group info to add
- expired articles to list of read articles and prevent
+ expired articles to list of read articles and prevent
re-fetching.
1998-07-12 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -972,7 +972,7 @@
1998-07-01 Simon Josefsson <jas@pdc.kth.se>
* gnus-int.el (gnus-get-function): returned non-nil when
- function wasn't bound, if noerror=t
+ function wasn't bound, if noerror=t
1998-07-01 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -1260,13 +1260,13 @@
1998-06-09 Sam Steingold <sds@goems.com>
- * gnus-uu.el (gnus-uu-default-view-rules): make sed kill ^M only
- at the end of line.
+ * gnus-uu.el (gnus-uu-default-view-rules): make sed kill ^M only
+ at the end of line.
1998-06-05 Hrvoje Niksic <hniksic@srce.hr>
* nnmail.el (nnmail-get-split-group): Don't regexp-quote
- nnmail-procmail-suffix.
+ nnmail-procmail-suffix.
1998-06-24 Kim-Minh Kaplan <kaplan@sky.fr>
@@ -1798,7 +1798,7 @@
1998-03-18 Simon Josefsson <jas@pdc.kth.se>
- * nndoc.el: dummy request-accept-article
+ * nndoc.el: dummy request-accept-article
1998-03-19 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -1959,12 +1959,6 @@
* nntp.el: Check whether the connection died.
-1998-03-01 Kim-Minh Kaplan <KimMinh.Kaplan@utopia.eunet.fr>
-
- * gnus.texi (Easy Picons): Removed references to
- `gnus-group-display-picons'.
- (Hard Picons): Ditto.
-
1998-03-02 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* gnus-sum.el (gnus-summary-exit-no-update): Run
@@ -1999,9 +1993,9 @@
(gnus-picons-setup-buffer): New function.
(gnus-picons-set-buffer): Use them.
(gnus-picons-display-x-face): Put back the `buf' binding: it is
- needed when `gnus-picons-display-where' is not set to article.
- Also move the X-Face to the left, near the address. It seems more
- logical.
+ needed when `gnus-picons-display-where' is not set to article.
+ Also move the X-Face to the left, near the address. It seems more
+ logical.
1998-02-28 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
@@ -2322,9 +2316,9 @@
1998-01-17 Simon Josefsson <jas@pdc.kth.se>
- * gnus-sum.el (gnus-summary-work-articles): change buffer
- before looking at marked articles
- (gnus-summary-work-articles): better check of marked articles
+ * gnus-sum.el (gnus-summary-work-articles): change buffer
+ before looking at marked articles
+ (gnus-summary-work-articles): better check of marked articles
1998-02-14 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -2613,7 +2607,7 @@
1997-12-22 Simon Josefsson <jas@faun.nada.kth.se>
- * nnmail.el (nnmail-get-new-mail): Make nnmail-tmp-directory
+ * nnmail.el (nnmail-get-new-mail): Make nnmail-tmp-directory
1997-12-28 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -2651,7 +2645,7 @@
(gnus-split-methods): Add default values for choices.
* gnus-score.el (gnus-home-score-file): Add non-nil default for
- function.
+ function.
(gnus-home-adapt-file): Ditto.
* gnus-sum.el (gnus-move-split-methods): Add default values for
@@ -2717,7 +2711,7 @@
1997-12-05 Danny Siu <dsiu@adobe.com>
* nndoc.el (nndoc-babyl-body-begin): quote the regexp for the
- string "*** EOOH ***" properly.
+ string "*** EOOH ***" properly.
(nndoc-babyl-head-begin): Same as above.
1997-12-14 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -2765,10 +2759,10 @@
1997-11-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* nnmail.el (nnmail-file-coding-system): Use `raw-text' in
- default.
+ default.
* nnheader.el (nnheader-file-coding-system): Use `raw-text' in
- default.
+ default.
1997-12-06 Kim-Minh Kaplan <KimMinh.Kaplan@utopia.eunet.fr>
@@ -3226,7 +3220,7 @@
1997-10-16 Colin Rafferty <craffert@ml.com>
* message.el (message-make-fqdn): Made certain that user-mail is
- not nil.
+ not nil.
1997-10-25 David S. Goldberg <dsg@linus.mitre.org>
@@ -3708,7 +3702,7 @@
* gnus.el: Quassia Gnus v0.1 is released.
- Copyright (C) 1997-2013 Free Software Foundation, Inc.
+ Copyright (C) 1997-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index df223bd332b..29ab9788bba 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -41,20 +41,20 @@
* message.el (message-header-synonyms): Defcustom.
(message-get-reply-headers): Catch `Original-To'.
- (message-carefully-insert-headers): Added comment.
+ (message-carefully-insert-headers): Add comment.
- * gnus-sum.el (gnus-summary-make-menu-bar): Improved "Washing" menu.
+ * gnus-sum.el (gnus-summary-make-menu-bar): Improve "Washing" menu.
2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-select-newsgroup): Use cat.
- * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New
- cat.
+ * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces):
+ New cat.
- * gnus.el (gnus-user-agent): Moved here.
+ * gnus.el (gnus-user-agent): Move here.
- * gnus-msg.el (gnus-user-agent): Moved from here.
+ * gnus-msg.el (gnus-user-agent): Move from here.
* gnus.el (gnus-version-number): Bump.
@@ -104,20 +104,19 @@
topic lines.
(gnus-group-set-current-level): Fix fix.
-2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com>
+2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com> (tiny change)
- * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny
- change).
+ * mml.el (mml-generate-mime-1): Use mml-compute-boundary.
2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-group.el: Removed `(when t ...)' around `gnus-define-keys'.
- (gnus-group-group-map): Added `gnus-group-read-ephemeral-group'
+ * gnus-group.el: Remove `(when t ...)' around `gnus-define-keys'.
+ (gnus-group-group-map): Add `gnus-group-read-ephemeral-group'
(already in previous commit inadvertently).
- (gnus-group-make-menu-bar): Added `gnus-group-read-ephemeral-group'.
+ (gnus-group-make-menu-bar): Add `gnus-group-read-ephemeral-group'.
(gnus-group-read-ephemeral-group): Made interactive.
- * gnus-score.el (gnus-score-find-trace): Added comment on sync
+ * gnus-score.el (gnus-score-find-trace): Add comment on sync
with `gnus-score-edit-file-at-point'.
* gnus-logic.el (gnus-score-advanced): Ditto.
@@ -127,8 +126,8 @@
2003-12-30 Simon Josefsson <jas@extundo.com>
- * gnus-score.el (gnus-score-edit-file-at-point): Use
- gnus-point-at-*, for portability.
+ * gnus-score.el (gnus-score-edit-file-at-point):
+ Use gnus-point-at-*, for portability.
2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
@@ -136,8 +135,8 @@
custom type.
(gnus-button-mid-or-mail-regexp): Don't be too restrictive.
Suggested by Felix Wiemann <Felix.Wiemann@gmx.net>.
- (gnus-button-alist): Added "M-x ... RET" and "mid:" buttons.
- Added comments about relevant RFCs.
+ (gnus-button-alist): Add "M-x ... RET" and "mid:" buttons.
+ Add comments about relevant RFCs.
* gnus-sum.el (gnus-summary-mode): Untabify doc-string.
(gnus-summary-goto-article): Allow `%40'.
@@ -150,15 +149,15 @@
2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
- (gnus-score-find-trace): Use gnus-score-edit-file-at-point. Added
- `f' and `t' commands, added quick help. With some suggestions
+ (gnus-score-find-trace): Use gnus-score-edit-file-at-point.
+ Add `f' and `t' commands, added quick help. With some suggestions
from Karl Pflästerer <sigurd@12move.de>.
- * gnus-util.el (gnus-emacs-version): Added doc-string.
+ * gnus-util.el (gnus-emacs-version): Add doc-string.
* mml.el (mml-minibuffer-read-disposition): New function.
(mml-attach-file): Use it.
- (mml-preview): Added MIME preview to gnus-buffers.
+ (mml-preview): Add MIME preview to gnus-buffers.
2003-12-30 Karl Pflästerer <sigurd@12move.de>
@@ -190,7 +189,7 @@
(gnus-agent-auto-agentize-methods): Customize.
2003-12-29 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22
+ * gnus.el (gnus-server-to-method): Fix bug in 2003-12-22
check-in.
2003-12-28 Adrian Lanz <lanz@fowi.ethz.ch>
@@ -202,8 +201,8 @@
2003-12-28 Jesper Harder <harder@ifa.au.dk>
- * mm-view.el (mm-text-html-washer-alist): Use
- mm-inline-wash-with-stdin for w3m-standalone.
+ * mm-view.el (mm-text-html-washer-alist):
+ Use mm-inline-wash-with-stdin for w3m-standalone.
* mm-decode.el (mm-text-html-renderer): Add w3m-standalone.
@@ -226,16 +225,16 @@
2003-12-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-int.el (gnus-open-server): Fixed the server status such
+ * gnus-int.el (gnus-open-server): Fix the server status such
that an agentized server, when opened offline, has a status of
offline. Also fixes bug whereby the agent's backend was called
twice to open each server.
- * gnus-start.el (gnus-get-unread-articles-in-group): Autoload
- gnus-agent-possibly-alter-active rather than inline to resolve
+ * gnus-start.el (gnus-get-unread-articles-in-group):
+ Autoload gnus-agent-possibly-alter-active rather than inline to resolve
compiler warnings.
- * gnus.el (gnus-server-to-method): Added fallback of iterating
+ * gnus.el (gnus-server-to-method): Add fallback of iterating
over gnus-newsrc-alist to resolve names of foreign servers.
Should fix recent agent bug.
@@ -247,8 +246,8 @@
2003-12-21 Jesper Harder <harder@ifa.au.dk>
- * gnus-agent.el (gnus-agent-read-agentview): Use
- car-less-than-car.
+ * gnus-agent.el (gnus-agent-read-agentview):
+ Use car-less-than-car.
2003-12-20 Artem Chuprina <ran@ran.pp.ru> (tiny change)
@@ -267,17 +266,17 @@
2003-12-18 Reiner Steib <Reiner.Steib@gmx.de>
* mm-url.el (mm-url-insert-file-contents-external)
- (mm-url-insert-file-contents): Added doc-strings. Autoload.
+ (mm-url-insert-file-contents): Add doc-strings. Autoload.
2003-12-18 Jesper Harder <harder@ifa.au.dk>
- * gnus-cus.el (defvar): Defvar
- gnus-agent-cat-disable-undownloaded-faces.
+ * gnus-cus.el (defvar):
+ Defvar gnus-agent-cat-disable-undownloaded-faces.
2003-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
- * message.el (message-forward-subject-name-subject): Use
- gnus-extract-address-components instead of
+ * message.el (message-forward-subject-name-subject):
+ Use gnus-extract-address-components instead of
mail-header-parse-address because it may be called with non-ascii
text.
@@ -320,7 +319,7 @@
2003-12-13 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el: Added some gnus-registry autoloads.
+ * spam.el: Add some gnus-registry autoloads.
(spam-split-symbolic-return): Makes spam-split return 'spam
instead of the value of spam-split-group when spam is detected.
(spam-split-symbolic-return-positive): Makes spam-split return
@@ -345,8 +344,8 @@
(spam-unload-hook): Remove spam-find-spam from
gnus-summary-prepare-hook.
- * gnus.el (spam-autodetect, spam-autodetect-methods): New
- configuration items for spam autodetection.
+ * gnus.el (spam-autodetect, spam-autodetect-methods):
+ New configuration items for spam autodetection.
2003-12-12 Reiner Steib <Reiner.Steib@gmx.de>
@@ -367,16 +366,16 @@
(gnus-agent-regenerate-group): When necessary, alter the group's
active range to include articles newly recognized as being
downloaded.
- (gnus-agent-regenerate): Removed code that updated the agent's
+ (gnus-agent-regenerate): Remove code that updated the agent's
active file as the new gnus-agent-possibly-alter-active function
obsolesced it.
- * gnus-cus.el (gnus-agent-customize-category): Added missing
+ * gnus-cus.el (gnus-agent-customize-category): Add missing
agent-disable-undownloaded-faces parameter.
* gnus-start.el (gnus-activate-group): Backed out my 2003-11-29
patch as it was too late at adjusting the active range.
- (gnus-get-unread-articles-in-group): Added call to new
+ (gnus-get-unread-articles-in-group): Add call to new
gnus-agent-possibly-alter-active to adjust the active range.
2003-12-10 Jesper Harder <harder@ifa.au.dk>
@@ -385,10 +384,10 @@
2003-12-10 Lőrentey Károly <lorentey@elte.hu>
- * spam.el (spam-disable-spam-split-during-ham-respool): New
- variable.
- (spam-ham-copy-or-move-routine): Respect
- spam-disable-spam-split-during-ham-respool.
+ * spam.el (spam-disable-spam-split-during-ham-respool):
+ New variable.
+ (spam-ham-copy-or-move-routine):
+ Respect spam-disable-spam-split-during-ham-respool.
(spam-split-disabled): New variable.
(spam-split): Respect spam-split-disabled.
@@ -412,8 +411,8 @@
2003-12-09 Xavier Maillard <zedek@gnu-rox.org>
- * spam.el (spam-bogofilter-database-directory): Correct
- customization group.
+ * spam.el (spam-bogofilter-database-directory):
+ Correct customization group.
2003-12-09 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -459,8 +458,8 @@
2003-12-07 Jesper Harder <harder@ifa.au.dk>
- * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't
- use = or zerop to test the return value of call-process, because
+ * spam.el (spam-check-spamoracle, spam-spamoracle-learn):
+ Don't use = or zerop to test the return value of call-process, because
it can be a string.
* mail-source.el (mail-source-fetch-with-program): Do.
@@ -505,10 +504,10 @@
2003-12-01 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-consider-all-articles): Updated
- docstring.
+ * gnus-agent.el (gnus-agent-consider-all-articles):
+ Update docstring.
(gnus-predicate-implies-unread, gnus-predicate-implies-unread-1):
- Fixed implementation such that the predicate `true' no longer
+ Fix implementation such that the predicate `true' no longer
evaluates to t.
2003-12-01 Adrian Lanz <lanz@fowi.ethz.ch> (tiny change)
@@ -558,14 +557,14 @@
2003-11-29 Jesper Harder <harder@ifa.au.dk>
- * gnus-group.el (gnus-group-make-menu-bar): Add
- gnus-group-make-rss-group.
+ * gnus-group.el (gnus-group-make-menu-bar):
+ Add gnus-group-make-rss-group.
2003-11-28 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el: Added custom-manual links to all variables that have
+ * message.el: Add custom-manual links to all variables that have
an index entry in the message manual.
- (message-generate-headers-first): Fixed doc-string.
+ (message-generate-headers-first): Fix doc-string.
2003-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -611,15 +610,15 @@
(spam-classification-valid-p, spam-process-type-valid-p)
(spam-registration-check-valid-p)
(spam-unregistration-check-valid-p): Convenience functions.
- (spam-registration-function, spam-unregistration-function): Look
- up the registration/unregistration function based on a
+ (spam-registration-function, spam-unregistration-function):
+ Look up the registration/unregistration function based on a
classification and the check (spam-use-* symbol).
(spam-list-articles): Generate list of spam/ham articles from a
given list of articles.
(spam-register-routine): Do the heavy work of registering and
unregistering articles, using all the articles in the group or
specific ones as needed.
- (spam-generic-register-routine): Removed, no longer used.
+ (spam-generic-register-routine): Remove, no longer used.
(spam-log-unregistration-needed-p, spam-log-undo-registration):
Handle article registration/unregistration with a given spam/ham
processor and group.
@@ -642,7 +641,7 @@
parameter is specified.
(spam-stat-load): Clear spam-stat-dirty.
- * gnus.el (gnus-install-group-spam-parameters): Marked the
+ * gnus.el (gnus-install-group-spam-parameters): Mark the
old-style exit processors as obsolete in the docs, added the
new-style exit processors while the old ones are still allowed.
@@ -666,23 +665,23 @@
2003-11-20 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus.el (gnus-agent-covered-methods): Documented use of
+ * gnus.el (gnus-agent-covered-methods): Document use of
named servers, not methods, to identity agentized groups.
Users may now change their server configurations without having
the server become "unagentized".
- (gnus-agent-covered-methods): Removed from gnus-variable-list to
+ (gnus-agent-covered-methods): Remove from gnus-variable-list to
avoid storing two copies of gnus-agent-covered-methods, one in
.newsrc.eld and the other in agent/lib/servers.
(gnus-server-to-method): Do not cache server for the nil method.
(gnus-method-to-server): New function. Associate named server
with all, even foreign, methods.
- (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated
+ (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporate
simple last-response cache to offset performance lose of having to
always convert methods to named servers.
- * gnus-agent.el (gnus-agent-expire-days): Removed obsolete
+ * gnus-agent.el (gnus-agent-expire-days): Remove obsolete
documentation.
(gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server):
- Modified to support new definition of gnus-agent-covered-method.
+ Modify to support new definition of gnus-agent-covered-method.
(gnus-agent-read-servers): Rewritten to convert old method data
into server names.
(gnus-agent-read-servers-validate)
@@ -701,17 +700,17 @@
(gnus-agent-expire-done-message): New function.
(gnus-agent-unread-articles): Bug fix. No longer drops last
unread article onto read list.
- (gnus-agent-regenerate-group): Changed prompt to use typical
+ (gnus-agent-regenerate-group): Change prompt to use typical
style.
(gnus-agent-group-covered-p): Rewrote to internally use
gnus-agent-method-p.
* gnus-int.el (gnus-start-news-server): Partially convert old
gnus-agent-covered-methods to new format so that gnus-open-server
functions correctly.
- * gnus-srvr.el (gnus-server-insert-server-line): Replaced
- gnus-agent-covered-methods with gnus-agent-method-p.
- * gnus-start.el (gnus-clear-system): Added
- gnus-agent-covered-methods to compensate for removing it from
+ * gnus-srvr.el (gnus-server-insert-server-line):
+ Replace gnus-agent-covered-methods with gnus-agent-method-p.
+ * gnus-start.el (gnus-clear-system):
+ Add gnus-agent-covered-methods to compensate for removing it from
gnus-variable-list.
(gnus-setup-news): Complete conversion of old
gnus-agent-covered-methods to new format so that secondary and
@@ -831,9 +830,9 @@
2003-11-10 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-mode-field-menu): Moved some entries, added
+ * message.el (message-mode-field-menu): Move some entries, added
`message-insert-wide-reply'.
- (message-change-subject): Fixed comment.
+ (message-change-subject): Fix comment.
2003-11-10 Sam Steingold <sds@gnu.org>
@@ -876,15 +875,15 @@
requested.
(gnus-registry-split-fancy-with-parent): When long names are in use,
strip the name if we're in the native server, or else return nothing.
- (gnus-registry-spool-action, gnus-registry-action): Use
- gnus-group-guess-full-name-from-command-method instead of
+ (gnus-registry-spool-action, gnus-registry-action):
+ Use gnus-group-guess-full-name-from-command-method instead of
gnus-group-guess-full-name.
* spam.el (spam-mark-spam-as-expired-and-move-routine)
(spam-ham-copy-or-move-routine): Prevent article deletions or
moves unless the backend allows it.
- * gnus.el (gnus-install-group-spam-parameters): Fixed parameters
+ * gnus.el (gnus-install-group-spam-parameters): Fix parameters
to list spamoracle as well, suggested by Jean-Marc Lasgouttes
<Jean-Marc.Lasgouttes@inria.fr>.
@@ -899,7 +898,7 @@
2003-10-31 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el
- (spam-log-processing-to-registry): Improved message and comments.
+ (spam-log-processing-to-registry): Improve message and comments.
(spam-log-unregistration-needed-p): New function.
(spam-ifile-register-spam-routine)
(spam-ifile-register-ham-routine, spam-stat-register-spam-routine)
@@ -908,8 +907,8 @@
(spam-whitelist-register-routine)
(spam-bogofilter-register-spam-routine)
(spam-bogofilter-register-ham-routine)
- (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): Change
- spam-log-processing-to-registry invocations appropriately.
+ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam):
+ Change spam-log-processing-to-registry invocations appropriately.
2003-10-31 Derek Atkins <warlord@MIT.EDU> (tiny change)
@@ -936,8 +935,8 @@
(spam-whitelist-register-routine)
(spam-bogofilter-register-spam-routine)
(spam-bogofilter-register-ham-routine)
- (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): Add
- spam-log-processing-to-registry invocations.
+ (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam):
+ Add spam-log-processing-to-registry invocations.
* gnus-registry.el: Fixed docs in the preface to mention
gnus-registry-initialize.
@@ -1002,7 +1001,7 @@
* spam.el (spam-mark-spam-as-expired-and-move-routine)
(spam-ham-copy-or-move-routine): Don't ask when deleting copied
articles, and use move instead of copy when possible.
- (spam-split): Added the option of specifying a string as a
+ (spam-split): Add the option of specifying a string as a
spam-split parameter; such a string will override
spam-split-group temporarily.
@@ -1017,8 +1016,8 @@
* gnus-art.el (gnus-button-alist): Allow & in mailto URLs.
(gnus-header-button-alist): Likewise.
(gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n.
- Reverse parameter list to use same order as in the URL. Reported
- by f95-msv@f.kth.se (Mårten Svantesson).
+ Reverse parameter list to use same order as in the URL.
+ Reported by f95-msv@f.kth.se (Mårten Svantesson).
2003-10-25 Teodor Zlatanov <tzz@lifelogs.com>
@@ -1036,8 +1035,8 @@
2003-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
- * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested
- by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
+ * nndoc.el (nndoc-guess-type): Reverse the sort order.
+ Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
(nndoc-dissect-buffer): Don't miss even-numbered articles.
2003-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -1054,7 +1053,7 @@
requirement, now just "IP address" is enough for detection for
blackhole checking.
(spam-check-blackholes): Oops, the dots were not escaped.
- (spam-mark-spam-as-expired-and-move-routine): Added multiple group
+ (spam-mark-spam-as-expired-and-move-routine): Add multiple group
support (multiple copies, then delete).
(spam-ham-copy-routine): New function.
(spam-ham-move-routine): New function.
@@ -1086,8 +1085,8 @@
* gnus-art.el (gnus-narrow-to-page): Clear as well as set the
value for gnus-page-broken.
- * gnus-sum.el (gnus-summary-beginning-of-article): Use
- gnus-break-pages instead of gnus-page-broken.
+ * gnus-sum.el (gnus-summary-beginning-of-article):
+ Use gnus-break-pages instead of gnus-page-broken.
(gnus-summary-end-of-article): Use gnus-break-pages instead of
gnus-page-broken; narrow to the end of a page beforehand.
(gnus-summary-toggle-header): Use gnus-break-pages instead of
@@ -1113,15 +1112,15 @@
* gnus-msg.el (gnus-extended-version): Use it.
- * gnus-util.el (gnus-emacs-version): Separated out into own
+ * gnus-util.el (gnus-emacs-version): Separate out into own
function.
2003-10-19 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-mode-field-menu): Added
- message-generate-unsubscribed-mail-followup-to.
+ * message.el (message-mode-field-menu):
+ Add message-generate-unsubscribed-mail-followup-to.
(message-forward-subject-fwd): Avoid double "Fwd: ".
- (message-change-subject): Added comment.
+ (message-change-subject): Add comment.
2003-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -1131,8 +1130,8 @@
2003-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-sum.el (gnus-remove-odd-characters): Use
- mm-subst-char-in-string instead of subst-char-in-string.
+ * gnus-sum.el (gnus-remove-odd-characters):
+ Use mm-subst-char-in-string instead of subst-char-in-string.
(gnus-summary-refer-article): Use gnus-replace-in-string instead
of replace-regexp-in-string.
@@ -1143,22 +1142,19 @@
2003-10-18 Jesper Harder <harder@ifa.au.dk>
- * gnus-sum.el (gnus-summary-save-parts-last-directory): Default
- to mm-default-directory.
+ * gnus-sum.el (gnus-summary-save-parts-last-directory):
+ Default to mm-default-directory.
(gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions.
2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * pop3.el (pop3-read-response): Check whether the process is
- alive.
+ * pop3.el (pop3-read-response): Check whether the process is alive.
* gnus-sum.el (gnus-summary-refer-article): Strip spaces.
- * rfc2047.el (rfc2047-encode-region): Do error out on invalid
- strings.
+ * rfc2047.el (rfc2047-encode-region): Do error out on invalid strings.
- * nntp.el (nntp-retrieve-headers-with-xover): Get error messages
- right.
+ * nntp.el (nntp-retrieve-headers-with-xover): Get error messages right.
* gnus-agent.el (gnus-agent-read-servers): Remove sit-for.
@@ -1244,8 +1240,8 @@
name for gcc-self.
(gnus-inews-insert-archive-gcc): Paren mistake.
- * gnus-sum.el (gnus-summary-enter-digest-group): Add
- parent-group.
+ * gnus-sum.el (gnus-summary-enter-digest-group):
+ Add parent-group.
* gnus-art.el (gnus-ignored-headers): Add more headers.
@@ -1329,8 +1325,8 @@
2003-10-06 Jesper Harder <harder@ifa.au.dk>
- * gnus.el (gnus-group-faq-directory): Update .tw entry. From
- Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw>
+ * gnus.el (gnus-group-faq-directory): Update .tw entry.
+ From Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw>
2003-10-03 Teodor Zlatanov <tzz@lifelogs.com>
@@ -1355,7 +1351,7 @@
2003-10-02 Reiner Steib <Reiner.Steib@gmx.de>
- * spam.el (spam-install-hooks-function): Added Autoload cookie.
+ * spam.el (spam-install-hooks-function): Add Autoload cookie.
2003-10-02 Michael Shields <shields@msrl.com>
@@ -1369,8 +1365,7 @@
2003-10-01 Jesper Harder <harder@ifa.au.dk>
- * message.el (message-send): Fix reversed logic of supersedes
- check.
+ * message.el (message-send): Fix reversed logic of supersedes check.
2003-09-30 Reiner Steib <Reiner.Steib@gmx.de>
@@ -1464,8 +1459,8 @@
2003-09-05 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus-registry.el (gnus-registry-split-fancy-with-parent): Yet
- another error. *sigh*
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent):
+ Yet another error. *sigh*
* gnus-registry.el (gnus-registry-fetch-extra-entry): Don't use
puthash unless gnus-registry-entry-caching is on.
@@ -1495,10 +1490,10 @@
(gnus-registry-register-message-ids): Pass subject to
gnus-registry-add-group.
(gnus-registry-simplify-subject)
- (gnus-registry-fetch-simplified-message-subject-fast): New
- functions.
- (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): Add
- extra data entry caching.
+ (gnus-registry-fetch-simplified-message-subject-fast):
+ New functions.
+ (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry):
+ Add extra data entry caching.
(gnus-registry-add-group): Handle the extra subject parameter.
(gnus-registry-install-hooks, gnus-registry-unload-hook): Fix the
gnus-register-* function names.
@@ -1506,27 +1501,27 @@
* nnmail.el (nnmail-cache-insert): Add subject parameter, pass it
on to the nnmail-spool-hook.
- * nnbabyl.el (nnbabyl-request-accept-article): Added subject to
+ * nnbabyl.el (nnbabyl-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nndiary.el (nndiary-request-accept-article): Added subject to
+ * nndiary.el (nndiary-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nnfolder.el (nnfolder-request-accept-article): Added subject to
+ * nnfolder.el (nnfolder-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nnimap.el (nnimap-split-articles): Added subject to
+ * nnimap.el (nnimap-split-articles): Add subject to
nnmail-cache-insert call.
- (nnimap-request-accept-article): Added subject to
+ (nnimap-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nnmbox.el (nnmbox-request-accept-article): Added subject to
+ * nnmbox.el (nnmbox-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nnmh.el (nnmh-request-accept-article): Added subject to
+ * nnmh.el (nnmh-request-accept-article): Add subject to
nnmail-cache-insert call.
- * nnml.el (nnml-request-accept-article): Added subject to
+ * nnml.el (nnml-request-accept-article): Add subject to
nnmail-cache-insert call.
2003-09-04 Jesper Harder <harder@ifa.au.dk>
@@ -1557,8 +1552,8 @@
2003-08-29 Simon Josefsson <jas@extundo.com>
- * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by
- Jochen Küpper <jochen@jochen-kuepper.de>.
+ * gnus-group.el (gnus-group-delete-group): Doc fix.
+ Suggested by Jochen Küpper <jochen@jochen-kuepper.de>.
2003-08-29 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -1592,13 +1587,13 @@
2003-08-24 Jesper Harder <harder@ifa.au.dk>
- * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix
- type.
+ * gnus-art.el (gnus-header-button-alist, gnus-button-alist):
+ Fix type.
2003-08-22 Jesper Harder <harder@ifa.au.dk>
- * message.el (message-make-forward-subject-function): Fix
- customize mismatch.
+ * message.el (message-make-forward-subject-function):
+ Fix customize mismatch.
* gnus.el (gnus-message-archive-method): Do.
@@ -1608,7 +1603,7 @@
char is `/' and add more information for the user.
* gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man).
- (gnus-header-button-alist): Added `In-Reply-To'.
+ (gnus-header-button-alist): Add `In-Reply-To'.
* nnimap.el (nnimap-open-connection): Allow different user names
on the same server (and in the same authinfo file).
@@ -1617,15 +1612,15 @@
* gnus-sieve.el (gnus-sieve-crosspost): Fix type.
- * message.el (message-make-forward-subject-function): Add
- message-forward-subject-name-subject to choices.
+ * message.el (message-make-forward-subject-function):
+ Add message-forward-subject-name-subject to choices.
* gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit):
Redisplay article after editing.
2003-08-20 Jari Aalto <jari.aalto@poboxes.com>
- * gnus.el (gnus-read-group): Added check to ask confirmation if
+ * gnus.el (gnus-read-group): Add check to ask confirmation if
Group name contains invalid character. You can use '/' in IMAP,
but not in filenames. G m cannot know what the user is creating,
so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org.
@@ -1645,8 +1640,8 @@
2003-08-07 Jesper Harder <harder@ifa.au.dk>
- * pgg-gpg.el (pgg-gpg-process-region): Bind
- default-enable-multibyte-characters to nil.
+ * pgg-gpg.el (pgg-gpg-process-region):
+ Bind default-enable-multibyte-characters to nil.
2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -1729,11 +1724,11 @@
* spam.el (spam-use-regex-body, spam-regex-body-spam)
(spam-regex-body-ham): New variables, default to nil/empty/empty.
- (spam-install-hooks): Added spam-use-regex-body to list or
+ (spam-install-hooks): Add spam-use-regex-body to list or
pre-install conditions.
- (spam-list-of-checks): Added spam-use-regex-body and
+ (spam-list-of-checks): Add spam-use-regex-body and
spam-check-regex-body to list of checks.
- (spam-list-of-statistical-checks): Added spam-use-regex-body to
+ (spam-list-of-statistical-checks): Add spam-use-regex-body to
list of statistical checks.
(spam-check-regex-body): Invokes spam-check-regex-headers with
appropriate variable masking.
@@ -1754,8 +1749,8 @@
(gnus-registry-clean-empty): New variable to enable cleaning the
registry when saving it by calling gnus-registry-clean-empty-function.
- * spam.el (spam-summary-prepare-exit): Use
- spam-process-ham-in-spam-groups.
+ * spam.el (spam-summary-prepare-exit):
+ Use spam-process-ham-in-spam-groups.
(spam-process-ham-in-spam-groups): New variable.
2003-07-24 Jesper Harder <harder@ifa.au.dk>
@@ -1763,8 +1758,8 @@
* pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options.
* pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes
- from 2003-04-03 to fix security problem. See
- http://www.debian.org/security/2003/dsa-339.
+ from 2003-04-03 to fix security problem.
+ See http://www.debian.org/security/2003/dsa-339.
2003-07-23 Teodor Zlatanov <tzz@lifelogs.com>
@@ -1806,8 +1801,7 @@
2003-07-10 Kai Großjohann <kai.grossjohann@gmx.net>
- * imap.el (imap-arrival-filter): Fix test for missing process
- buffer.
+ * imap.el (imap-arrival-filter): Fix test for missing process buffer.
2003-07-09 Gaute B Strokkenes <gs234@cam.ac.uk> (tiny change)
@@ -1881,8 +1875,8 @@
2003-07-06 Jesper Harder <harder@ifa.au.dk>
- * message.el (message-send-mail-with-sendmail): Handle
- non-numeric return values.
+ * message.el (message-send-mail-with-sendmail):
+ Handle non-numeric return values.
* gnus-start.el (gnus-clear-system): Revert change from
2003-06-19.
@@ -1928,8 +1922,8 @@
2003-06-23 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-from-listed-p, spam-parse-list): Use
- ietf-drums-parse-addresses to extract the address portion of the
+ * spam.el (spam-from-listed-p, spam-parse-list):
+ Use ietf-drums-parse-addresses to extract the address portion of the
whitelist/blacklist file if it looks like an address can be found.
2003-06-23 Didier Verna <didier@xemacs.org>
@@ -1942,8 +1936,8 @@
(gnus-xmas-remove-image): Ditto, with extents.
* gnus-art.el (gnus-delete-images): Pass CATEGORY argument to
gnus-[xmas-]remove-image.
- (article-display-face): Don't always act as a toggle. Call
- `gnus-put-image' with CATEGORY argument.
+ (article-display-face): Don't always act as a toggle.
+ Call `gnus-put-image' with CATEGORY argument.
(article-display-x-face): Call `gnus-put-image' with CATEGORY
argument.
* smiley.el (smiley-region): Ditto.
@@ -1959,11 +1953,11 @@
2003-06-20 Jesper Harder <harder@ifa.au.dk>
- * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by
- Dan Jacobson <jidanni@jidanni.org>.
+ * mm-util.el (mm-append-to-file): Say "Appended to".
+ Suggested by Dan Jacobson <jidanni@jidanni.org>.
- * mm-view.el (mm-inline-message): Bind
- gnus-original-article-buffer to the buffer in the mml handle
+ * mm-view.el (mm-inline-message):
+ Bind gnus-original-article-buffer to the buffer in the mml handle
holding the message.
2003-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -1994,8 +1988,8 @@
2003-06-19 Jesper Harder <harder@ifa.au.dk>
- * nnheader.el (nnheader-init-server-buffer): Add
- nntp-server-buffer to gnus-buffers.
+ * nnheader.el (nnheader-init-server-buffer):
+ Add nntp-server-buffer to gnus-buffers.
* gnus-start.el (gnus-clear-system): Now we don't need to kill
nntp-server-buffer separately.
@@ -2016,8 +2010,8 @@
2003-06-17 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-util.el (gnus-extract-address-components): Added
- doc-string.
+ * gnus-util.el (gnus-extract-address-components):
+ Add doc-string.
2003-06-16 Michael Albinus <Michael.Albinus@alcatel.de>
@@ -2026,8 +2020,8 @@
2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-sum.el (gnus-summary-refer-parent-article): Extract
- Message-ID from In-Reply-To header.
+ * gnus-sum.el (gnus-summary-refer-parent-article):
+ Extract Message-ID from In-Reply-To header.
2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -2037,14 +2031,14 @@
2003-06-15 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind
- `gnus-article-emulate-mime'.
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt):
+ Bind `gnus-article-emulate-mime'.
2003-06-15 Tommi Vainikainen <thv+gnus@iki.fi>
- * message.el (message-is-yours-p): New function. Separated common
- code from message-cancel-news and message-supersede. Added
- matching code which uses message-alternative-emails regexp as last
+ * message.el (message-is-yours-p): New function. Separate common
+ code from message-cancel-news and message-supersede.
+ Add matching code which uses message-alternative-emails regexp as last
resort.
(message-cancel-news, message-supersede): Use message-is-yours-p.
@@ -2055,11 +2049,11 @@
2003-06-12 Dave Love <fx@gnu.org>
- * nnheader.el (nnheader-functionp): Deleted.
+ * nnheader.el (nnheader-functionp): Delete.
* nnmail.el (nnmail-split-fancy-syntax-table): Define all in
defvar.
- (nnmail-version): Deleted.
+ (nnmail-version): Delete.
(nnmail-check-duplication, nnmail-expiry-target-group): Don't use
nnheader-functionp.
@@ -2077,15 +2071,15 @@
(spam-spamoracle, spam-spamoracle): New variables.
(spam-group-spam-processor-spamoracle-p)
(spam-group-ham-processor-spamoracle-p): New functions.
- (spam-summary-prepare-exit): Added spamoracle ham/spam exit processing.
- (spam-list-of-checks, spam-list-of-statistical-checks): Add
- spam-use-spamoracle.
+ (spam-summary-prepare-exit): Add spamoracle ham/spam exit processing.
+ (spam-list-of-checks, spam-list-of-statistical-checks):
+ Add spam-use-spamoracle.
(spam-check-spamoracle, spam-spamoracle-learn)
(spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): New functions.
* gnus.el (gnus-group-spam-exit-processor-spamoracle)
(gnus-group-ham-exit-processor-spamoracle): New variables for SpamOracle.
- (spam-process, ham-process): Added spamoracle spam/ham processors.
+ (spam-process, ham-process): Add spamoracle spam/ham processors.
2003-06-08 Jesper Harder <harder@ifa.au.dk>
@@ -2094,7 +2088,7 @@
2003-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons"
+ * gnus-sum.el (gnus-summary-make-menu-bar): Remove ["Add buttons"
gnus-summary-display-buttonized t].
2003-06-07 Kai Großjohann <kai.grossjohann@gmx.net>
@@ -2150,9 +2144,9 @@
(gnus-other-frame): Quote lambda used as hook.
* message.el: Doc fixes.
- (message-functionp): Deleted. Callers changed.
- (message-fix-before-sending): Highlight with overlays. Clarify
- `illegible text' messages.
+ (message-functionp): Delete. Callers changed.
+ (message-fix-before-sending): Highlight with overlays.
+ Clarify `illegible text' messages.
(rmail-enable-mime-composing, gnus-message-group-art): Defvar when
compiling.
(gnus-find-method-for-group, nnvirtual-find-group-art): Autoload.
@@ -2168,8 +2162,8 @@
2003-06-03 Eric Eide <eeide@cs.utah.edu>
- * gnus-xmas.el (gnus-xmas-create-image): Use
- insert-file-contents-literally.
+ * gnus-xmas.el (gnus-xmas-create-image):
+ Use insert-file-contents-literally.
2003-06-02 Teodor Zlatanov <tzz@lifelogs.com>
@@ -2195,8 +2189,8 @@
(gnus-registry-delete-group): Use it.
(gnus-registry-unload-hook): Uninstall all the hooks.
- * spam.el (spam-install-hooks-function, spam-unload-hook): New
- functions so users that load spam.el for customization don't get
+ * spam.el (spam-install-hooks-function, spam-unload-hook):
+ New functions so users that load spam.el for customization don't get
all the hooks installed.
(spam-install-hooks): New variable, set to t by default if user
has one of the spam-use-* variables set.
@@ -2210,8 +2204,8 @@
* rfc2047.el (rfc2047-decode): Don't use
mm-with-unibyte-current-buffer.
- * qp.el (quoted-printable-decode-string): Use
- mm-with-unibyte-buffer.
+ * qp.el (quoted-printable-decode-string):
+ Use mm-with-unibyte-buffer.
2003-05-29 Teodor Zlatanov <tzz@lifelogs.com>
@@ -2250,7 +2244,7 @@
2003-05-20 Dave Love <fx@gnu.org>
- * rfc2047.el (rfc2047-q-encoding-alist): Deleted.
+ * rfc2047.el (rfc2047-q-encoding-alist): Delete.
(rfc2047-q-encode-region): Don't use it.
(rfc2047-encode-message-header) <(eq method 'mime)>: Bind
rfc2047-encoding-type to `mime'.
@@ -2268,11 +2262,11 @@
2003-05-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agentize): Updated documentation to match
+ * gnus-agent.el (gnus-agentize): Update documentation to match
usage.
(gnus-agent-expire-group-1): Do not skip over a group when the
force argument is set.
- * gnus.el (gnus-agent): Updated documentation to reflect that
+ * gnus.el (gnus-agent): Update documentation to reflect that
gnus-agent now defaults to t.
2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -2285,24 +2279,24 @@
2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * mail-source.el (mail-source-delete-incoming): Changed to t.
+ * mail-source.el (mail-source-delete-incoming): Change to t.
* rfc2047.el (rfc2047-syntax-table): Funcall.
* rfc2047.el (rfc2047-encodable-p): Use the header charset.
- * gnus-sum.el (gnus-summary-reselect-current-group): Supply
- leave-hidden.
+ * gnus-sum.el (gnus-summary-reselect-current-group):
+ Supply leave-hidden.
2003-05-14 Jonathan I. Kamens <jik@kamens.brookline.ma.us>
- * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny
+ * gnus-sum.el (gnus-summary-exit): Add `leave-hidden'. (Tiny
patch.)
2003-05-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-registry.el (gnus-registry-store-extra-entry): Use
- gnus-assq-delete-all.
+ * gnus-registry.el (gnus-registry-store-extra-entry):
+ Use gnus-assq-delete-all.
* gnus-xmas.el (gnus-xmas-assq-delete-all): New function.
@@ -2341,10 +2335,10 @@
(gnus-agent-cat-disable-undownloaded-faces): New function.
Accessor for new agent property
'agent-disable-undownloaded-faces'.
- gnus-cus.el (gnus-agent-parameters): Added
- agent-disable-undownloaded-faces and corrected documentation.
+ gnus-cus.el (gnus-agent-parameters):
+ Add agent-disable-undownloaded-faces and corrected documentation.
(gnus-agent-cat-prepare-category-field,
- gnus-agent-customize-category): Changed to avoid creating free
+ gnus-agent-customize-category): Change to avoid creating free
references to each field's symbol.
gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable.
(gnus-select-newgroup): Initialize it.
@@ -2352,15 +2346,15 @@
2003-05-12 Dave Love <fx@gnu.org>
- * mm-util.el (mm-read-charset): Deleted.
+ * mm-util.el (mm-read-charset): Delete.
(mm-coding-system-mime-charset): New.
(mm-read-coding-system, mm-mule-charset-to-mime-charset)
(mm-charset-to-coding-system, mm-mime-charset)
(mm-find-mime-charset-region): Use it.
(mm-default-multibyte-p): Fix non-mule case.
- * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval
- and compile.
+ * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol):
+ Eval and compile.
(rfc2047-syntax-table): Fix building table to work in Emacs 22.
(rfc2047-unfold-region): Delete unused var `leading'.
@@ -2371,8 +2365,8 @@
2003-05-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added
- space.
+ * gnus-agent.el (gnus-agent-expire-unagentized-dirs):
+ Add space.
2003-05-11 Jesper Harder <harder@ifa.au.dk>
@@ -2390,7 +2384,7 @@
2003-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.el (gnus-logo-color-alist): Added no colors.
+ * gnus.el (gnus-logo-color-alist): Add no colors.
2003-05-09 Dave Love <fx@gnu.org>
@@ -2415,12 +2409,12 @@
* gnus-registry.el (gnus-registry-unregistered-group-regex):
removed in favor of the group/topic/global variables.
- (gnus-registry-register-message-ids): Fixed test to omit
+ (gnus-registry-register-message-ids): Fix test to omit
gnus-registry-unregistered-group-regex.
- * gnus.el (gnus-variable-list): Removed gnus-registry-alist and
+ * gnus.el (gnus-variable-list): Remove gnus-registry-alist and
gnus-registry-headers-alist from the list.
- (gnus-registry-headers-alist): Removed.
+ (gnus-registry-headers-alist): Remove.
(registry-ignore): New parameter, with accompanying
gnus-registry-ignored-groups global variable.
@@ -2430,12 +2424,12 @@
used by gnus-registry.el.
* gnus-registry.el (gnus-registry-cache-file): New file variable.
- (gnus-registry-cache-read, gnus-registry-cache-save): New
- functions.
+ (gnus-registry-cache-read, gnus-registry-cache-save):
+ New functions.
(gnus-registry-save, gnus-registry-read): Use the new
gnus-registry-cache-{read|save} functions, and change the name
from gnus-registry-translate-{from|to}-alist.
- (gnus-registry-clear): Fixed so it doesn't refer to old function name.
+ (gnus-registry-clear): Fix so it doesn't refer to old function name.
2003-05-09 Dan Christensen <jdc@chow.mat.jhu.edu>
@@ -2448,7 +2442,7 @@
2003-05-08 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus-start.el (gnus-clear-system): Added gnus-registry-alist to
+ * gnus-start.el (gnus-clear-system): Add gnus-registry-alist to
the list of cleared variables.
* gnus-registry.el (gnus-registry-split-fancy-with-parent):
@@ -2461,8 +2455,8 @@
2003-05-08 Kai Großjohann <kai.grossjohann@gmx.net>
- * gnus-sum.el (gnus-summary-next-page): Mention
- `gnus-article-skip-boring' in docstring.
+ * gnus-sum.el (gnus-summary-next-page):
+ Mention `gnus-article-skip-boring' in docstring.
2003-05-08 Jesper Harder <harder@ifa.au.dk>
@@ -2546,13 +2540,13 @@
* rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New.
Callers of gnus- versions changed to use them.
- (rfc2047-header-encoding-alist): Add `address-mime' part. Doc
- fixes.
+ (rfc2047-header-encoding-alist): Add `address-mime' part.
+ Doc fixes.
(rfc2047-encoding-type): New.
(rfc2047-encode-message-header): Use mm-charset-to-coding-system.
Don't include header name field in encoding. Add `address-mime'
case and bind rfc2047-encoding-type for `mime' case.
- (rfc2047-encodable-p): Deleted.
+ (rfc2047-encodable-p): Delete.
(rfc2047-syntax-table): New.
(rfc2047-encode-region, rfc2047-encode): Rewritten to take account
of rfc2047 rules with respect to rfc2822 tokens and to do encoding
@@ -2566,8 +2560,8 @@
2003-05-02 Dave Love <fx@gnu.org>
- * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use
- mm-with-unibyte-current-buffer.
+ * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode):
+ Use mm-with-unibyte-current-buffer.
(ietf-drums, gnus-util): Don't require.
* sieve.el (sieve-manage-mode-menu): Define before use.
@@ -2577,9 +2571,9 @@
* mm-util.el (mm-coding-system-p): Don't override nil from
coding-system-p.
(mm-mule4-p, mm-disable-multibyte-mule4)
- (mm-with-unibyte-current-buffer-mule4): Deleted.
+ (mm-with-unibyte-current-buffer-mule4): Delete.
(mm-multibyte-p): Use defun, not defalias.
- (mm-make-temp-file): Moved to group at top of file.
+ (mm-make-temp-file): Move to group at top of file.
(mm-point-at-eol, mm-point-at-bol): New.
* gnus-cite.el (gnus-art): Require.
@@ -2599,29 +2593,29 @@
(gnus-output-to-rmail): Require mm-util.
* mail-source.el (mail-source-callback): Use mm-make-temp-file.
- (mail-source-make-complex-temp-name): Deleted.
+ (mail-source-make-complex-temp-name): Delete.
* message.el (message-use-idna): Use mm-coding-system-p.
(message-tokenize-header, message-make-organization)
(message-make-from): Use with-temp-buffer.
- (message-set-work-buffer): Deleted.
+ (message-set-work-buffer): Delete.
(message-fill-paragraph): Use `if' not `and' for compiler warning.
(message-check-news-header-syntax): Remove useless lambda.
(message-forward-make-body): Use mm-disable-multibyte,
mm-with-unibyte-current-buffer, mm-enable-multibyte.
- (message-replace-chars-in-string): Deleted.
+ (message-replace-chars-in-string): Delete.
* mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte.
(mm-extern-url): Use mm-with-unibyte-current-buffer,
mm-disable-multibyte.
(mm-extern-anon-ftp): Use mm-disable-multibyte.
- * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use
- mm-with-unibyte-current-buffer.
+ * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt):
+ Use mm-with-unibyte-current-buffer.
* mml2015.el (mml): Require.
- (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use
- mm-with-unibyte-current-buffer.
+ (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt):
+ Use mm-with-unibyte-current-buffer.
* nnheader.el (gnus-util): Require.
@@ -2656,7 +2650,7 @@
* gnus-registry.el (gnus-registry-fetch-extra)
(gnus-registry-store-extra, gnus-registry-group-count): New functions.
(gnus-registry-fetch-group, gnus-registry-delete-group)
- (gnus-registry-add-group): Changed to work with extra data element
+ (gnus-registry-add-group): Change to work with extra data element
if present.
2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
@@ -2693,8 +2687,8 @@
2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * message.el (message-forward-subject-name-subject): Decode
- string when forwarding.
+ * message.el (message-forward-subject-name-subject):
+ Decode string when forwarding.
2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -2756,7 +2750,7 @@
2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in
+ * gnus-art.el (gnus-button-prefer-mid-or-mail): Fix typo in
doc-string.
2003-05-01 Steve Youngs <youngs@xemacs.org>
@@ -2778,20 +2772,20 @@
2003-04-30 Teodor Zlatanov <tzz@lifelogs.com>
- * gnus-registry.el (gnus-registry-split-fancy-with-parent): Added
- diagnostic message.
+ * gnus-registry.el (gnus-registry-split-fancy-with-parent):
+ Add diagnostic message.
(gnus-registry-grep-in-list): Don't run when word is nil.
(gnus-registry-fetch-message-id-fast): New function.
(gnus-registry-delete-group, gnus-registry-add-group): Make sure
the id and group are not nil.
(gnus-registry-register-message-ids): New function.
- (gnus-register-action): Optimized logical flow.
- (gnus-summary-prepare-hook): Added gnus-registry-register-message-ids.
+ (gnus-register-action): Optimize logical flow.
+ (gnus-summary-prepare-hook): Add gnus-registry-register-message-ids.
2003-04-30 Kai Großjohann <kai.grossjohann@gmx.net>
- * gnus-delay.el (gnus-delay-article): Call
- `gnus-agent-queue-setup' to create the delay group.
+ * gnus-delay.el (gnus-delay-article):
+ Call `gnus-agent-queue-setup' to create the delay group.
* gnus-agent.el (gnus-agent-queue-setup): Support optional arg
for the (queue) group name.
@@ -2804,17 +2798,17 @@
2003-04-30 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name):
- Wrapped in eval-when-compile.
+ Wrap in eval-when-compile.
(gnus-agent-mode): Bind gnus-agent-go-online to nil as you
shouldn't be asked twice to go online with each server.
(gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles,
gnus-agent-crosspost, gnus-agent-flush-cache,
gnus-agent-fetch-session, gnus-agent-unread-articles,
gnus-agent-uncached-articles, gnus-agent-regenerate-group,
- gnus-agent-group-covered-p): Expanded pop macros used for
+ gnus-agent-group-covered-p): Expand pop macros used for
effect. Avoids compilation warning in emacs 21.3.
- * gnus-int.el (gnus-open-server): Restructured to only open
+ * gnus-int.el (gnus-open-server): Restructure to only open
nnagent when gnus-plugged is nil.
2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
@@ -2830,7 +2824,7 @@
2003-04-29 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-alist): Fixed CTAN regexp.
+ * gnus-art.el (gnus-button-alist): Fix CTAN regexp.
2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
@@ -2892,7 +2886,7 @@
* gnus-art.el (gnus-mime-display-multipart-as-mixed)
(gnus-mime-display-multipart-alternative-as-mixed)
- (gnus-mime-display-multipart-related-as-mixed): Added doc-strings,
+ (gnus-mime-display-multipart-related-as-mixed): Add doc-strings,
allow customization.
2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -2909,7 +2903,7 @@
2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-registry.el (gnus-register-spool-action): Replaced literal
+ * gnus-registry.el (gnus-register-spool-action): Replace literal
carriage-return character with its escape sequence.
2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -2921,7 +2915,7 @@
* gnus.el: Remove gnus-functionp throughout.
- * gnus-util.el (gnus-functionp): Removed.
+ * gnus-util.el (gnus-functionp): Remove.
* gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix.
@@ -2985,8 +2979,8 @@
* gnus-start.el (message-make-date): Autoload rather than
requiring message.
- * gnus-group.el (gnus-group-name-charset-group-alist): Use
- mm-coding-system-p.
+ * gnus-group.el (gnus-group-name-charset-group-alist):
+ Use mm-coding-system-p.
(gnus-cache-active-altered): Defvar when compiling.
(gnus-group-delete-group): Re-write to help avoid warnings.
@@ -3032,12 +3026,12 @@
2003-04-22 Paul Jarc <prj@po.cwru.edu>
- * gnus-util.el (gnus-merge): Added "type" argument to match CL
+ * gnus-util.el (gnus-merge): Add "type" argument to match CL
merge and gnus-sum.el's expectations.
2003-04-21 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-url-regexp): Added nntp.
+ * gnus-art.el (gnus-button-url-regexp): Add nntp.
* message.el (message-generate-headers-first): Default to
'(references).
@@ -3089,8 +3083,8 @@
* spam.el (spam-split): Allow a particular check as a parameter,
e.g. (: spam-split 'spam-use-bogofilter).
(spam-mark-only-unseen-as-spam): New parameter, see doc.
- (spam-mark-junk-as-spam-routine): Use
- spam-mark-only-unseen-as-spam, simplify routine to take advantage
+ (spam-mark-junk-as-spam-routine):
+ Use spam-mark-only-unseen-as-spam, simplify routine to take advantage
of gnus-newsgroup-unread as well as gnus-newsgroup-unseen.
2003-04-17 Teodor Zlatanov <tzz@lifelogs.com>
@@ -3103,7 +3097,7 @@
* gnus-registry.el (gnus-registry-clear)
(gnus-registry-fetch-group, gnus-registry-grep-in-list)
(gnus-registry-split-fancy-with-parent): New functions.
- (gnus-register-spool-action, gnus-register-action): Simplified the
+ (gnus-register-spool-action, gnus-register-action): Simplify the
format.
(gnus-registry): New customization group.
(gnus-registry-unfollowed-groups): New variable.
@@ -3154,9 +3148,9 @@
* spam-report.el (Module): New module for spam reporting.
- * gnus.el (spam-process): Added
- gnus-group-spam-exit-processor-report-gmane to the list of choices.
- (gnus-install-group-spam-parameters): Defined new spam exit processor.
+ * gnus.el (spam-process):
+ Add gnus-group-spam-exit-processor-report-gmane to the list of choices.
+ (gnus-install-group-spam-parameters): Define new spam exit processor.
* spam.el (autoload): Autoload spam-report-gmane when needed.
(spam-report-gmane-register-routine): Glue for spam-report.el.
@@ -3200,7 +3194,7 @@
2003-04-16 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to
+ * gnus-agent.el (gnus-agent-make-cat): Add optional parameter to
specify a predicate other than false.
(gnus-category-read): Use the new feature to create a 'default'
category with a 'short' predicate.
@@ -3214,7 +3208,7 @@
2003-04-15 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-split): Added save-restriction to save-excursion.
+ * spam.el (spam-split): Add save-restriction to save-excursion.
2003-04-15 Julien Avarre <julien@avarre.com>
@@ -3276,8 +3270,8 @@
2003-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-group-pathname): Bind
- gnus-command-method so that gnus-agent-directory will always
+ * gnus-agent.el (gnus-agent-group-pathname):
+ Bind gnus-command-method so that gnus-agent-directory will always
return a valid directory.
* gnus-cache.el (gnus-cache-enter-article): Remove article from
gnus-newsgroup-undownloaded so that the summary will display the
@@ -3300,13 +3294,13 @@
2003-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-article-next-page): Use
- gnus-article-over-scroll.
+ * gnus-art.el (gnus-article-next-page):
+ Use gnus-article-over-scroll.
(gnus-article-over-scroll): New variable.
* message.el (message-newline-and-reformat): Place a boundary
before filling.
- (message-make-forward-subject-function): Changed default to
+ (message-make-forward-subject-function): Change default to
message-forward-subject-name-subject.
(message-forward-subject-name-subject): New function.
@@ -3314,16 +3308,15 @@
* gnus-sum.el (gnus-summary-line-message-size): Ditto.
- * gnus-cus.el (gnus-group-parameters): Removed "which see".
+ * gnus-cus.el (gnus-group-parameters): Remove "which see".
- * mml.el (mml-minibuffer-read-file): Bind
- completion-ignored-extensions to nil.
+ * mml.el (mml-minibuffer-read-file):
+ Bind completion-ignored-extensions to nil.
* message.el (message-fix-before-sending): Comment fix.
(message-fix-before-sending): Make hidden headers visible.
(message-hide-headers): Bind after-change-functions to nil.
- (message-forbidden-properties): Put invisible and intangible
- back.
+ (message-forbidden-properties): Put invisible and intangible back.
(message-strip-forbidden-properties): Ignore message-hidden text.
* gnus-msg.el: Hide headers.
@@ -3332,8 +3325,7 @@
(message-hide-headers): New function.
(message-hide-header-p): New function.
(message-hide-header-p): Change logic.
- (message-forbidden-properties): Remove intangible nil invisible
- nil.
+ (message-forbidden-properties): Remove intangible nil invisible nil.
(message-hide-headers): Narrow to headers.
2003-04-12 Jesper Harder <harder@ifa.au.dk>
@@ -3348,7 +3340,7 @@
* gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in
the CACHE are now detected and handled the same as an article
downloaded into the agent.
- (gnus-agent-group-path): Modified to match nnmail-group-pathname
+ (gnus-agent-group-path): Modify to match nnmail-group-pathname
so that the agent front-end and back-end (nnagent) always use the
same directory.
(gnus-agent-group-pathname): New function. Wrapper for
@@ -3371,7 +3363,7 @@
2003-04-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-write-active): Added option of
+ * gnus-agent.el (gnus-agent-write-active): Add option of
replacing, rather than updating, the agent's active file. Do NOT
use the fully qualified group name as gnus-active-to-gnus-format
blindly prefixes group names with server names.
@@ -3384,9 +3376,9 @@
(gnus-agent-expire-unagentized-dirs): Avoid asking to delete the
same ancestor multiple times.
- * gnus-async.el (gnus-asynchronous): Moved defcustom of
- gnus-asynchronous away from defgroup of gnus-asynchronous. This
- seems to fix an intermittant error in which loading gnus-async
+ * 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
fails to define gnus-asynchronous (the variable).
* gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is
@@ -3395,7 +3387,7 @@
group's active range to include fetched articles that are no
longer in the server's active range.
- * gnus-util.el (gnus-with-output-to-file): Removed all of the
+ * gnus-util.el (gnus-with-output-to-file): Remove all of the
print-* bindings as they should be handled by the function doing
the printing.
@@ -3443,8 +3435,8 @@
2003-04-06 Jesper Harder <harder@ifa.au.dk>
- * mm-uu.el (mm-uu-copy-to-buffer): Copy
- `buffer-file-coding-system' to the new buffer.
+ * mm-uu.el (mm-uu-copy-to-buffer):
+ Copy `buffer-file-coding-system' to the new buffer.
(mm-uu-pgp-signed-extract-1): Don't copy
`buffer-file-coding-system' here.
@@ -3452,8 +3444,8 @@
exist in XEmacs.
(mm-decode-body): Add missing quote.
- * mm-uu.el (mm-uu-pgp-signed-extract-1): Set
- buffer-file-coding-system.
+ * mm-uu.el (mm-uu-pgp-signed-extract-1):
+ Set buffer-file-coding-system.
* mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to
last-coding-system-used.
@@ -3484,8 +3476,8 @@
2003-04-05 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-escape-nonascii to fix more characters in compiled format
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format):
+ Bound print-escape-nonascii to fix more characters in compiled format
specs.
2003-04-05 Jesper Harder <harder@ifa.au.dk>
@@ -3495,8 +3487,8 @@
2003-04-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-quoted, print-readably, print-escape-multibyte, and
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format):
+ Bound print-quoted, print-readably, print-escape-multibyte, and
print-level to match original behavior of gnus-prin1. This should
repair the format of .newsrc.eld when using compiled format specs.
@@ -3514,7 +3506,7 @@
2003-04-03 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning
+ * gnus-art.el (gnus-button-ctan-directory-regexp): Change meaning
and value.
(gnus-button-alist): Use it.
@@ -3534,9 +3526,9 @@
2003-04-02 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-util.el (gnus-message): Added doc-string.
+ * gnus-util.el (gnus-message): Add doc-string.
- * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'.
+ * gnus-score.el (gnus-score-find-trace): Change behavior of `q'.
(gnus-score-edit-file-at-point): Goto first match when using `e'.
2003-04-01 Reiner Steib <Reiner.Steib@gmx.de>
@@ -3551,22 +3543,22 @@
2003-03-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-escape-newlines to print escape sequences rather than
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format):
+ Bound print-escape-newlines to print escape sequences rather than
literal newline characters.
2003-03-31 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-valid-fqdn-regexp): Use
- `message-valid-fqdn-regexp' for initialization.
- (gnus-button-handle-info-url): Renamed and extended version of
+ * gnus-art.el (gnus-button-valid-fqdn-regexp):
+ Use `message-valid-fqdn-regexp' for initialization.
+ (gnus-button-handle-info-url): Rename and extended version of
`gnus-button-handle-info'.
- (gnus-button-message-level): Renamed from `gnus-button-mail-level'.
+ (gnus-button-message-level): Rename from `gnus-button-mail-level'.
(gnus-button-handle-symbol, gnus-button-handle-library)
(gnus-button-handle-info-keystrokes): New functions.
(gnus-button-browse-level): New variable.
(gnus-button-alist): Use them. Added levels.
- (gnus-header-button-alist): Added levels.
+ (gnus-header-button-alist): Add levels.
2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -3578,10 +3570,10 @@
2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-start.el (gnus-unload): Removed.
+ * gnus-start.el (gnus-unload): Remove.
- * pop3.el (pop3-read-response): Use
- nnheader-accept-process-output.
+ * pop3.el (pop3-read-response):
+ Use nnheader-accept-process-output.
(pop3-retr): Ditto.
* mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx.
@@ -3601,7 +3593,7 @@
* nnheader.el (nnheader-read-timeout): New variable.
(nnheader-accept-process-output): New function.
- * nntp.el (nntp-read-timeout): Removed.
+ * nntp.el (nntp-read-timeout): Remove.
* gnus-sum.el (gnus-summary-prepare-threads): Add comment.
@@ -3622,8 +3614,8 @@
2003-03-28 Vasily Korytov <deskpot@myrealbox.com>
- * message.el (message-make-in-reply-to): Use
- mail-extract-address-components to determine sender's
+ * message.el (message-make-in-reply-to):
+ Use mail-extract-address-components to determine sender's
name/address.
2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -3634,8 +3626,8 @@
valid lambda.
(gnus-registry-translate-from-alist): Ditto.
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
- print-length to nil.
+ * gnus-start.el (gnus-gnus-to-quick-newsrc-format):
+ Bind print-length to nil.
* gnus-sum.el (gnus-summary-highlight-line-0): Indent.
@@ -3658,14 +3650,14 @@
(gnus-registry-translate-from-alist): New functions.
(gnus-register-spool-action): Add a spool item to the registry.
- * gnus.el (gnus-variable-list): Added gnus-registry-alist to the
+ * gnus.el (gnus-variable-list): Add gnus-registry-alist to the
list of saved variables.
(gnus-registry-alist): New variable.
2003-03-28 Andreas Fuchs <asf@void.at>
- * gnus-registry.el (alist-to-hashtable, hashtable-to-alist): New
- functions.
+ * gnus-registry.el (alist-to-hashtable, hashtable-to-alist):
+ New functions.
2003-03-27 Simon Josefsson <jas@extundo.com>
@@ -3683,7 +3675,7 @@
2003-03-26 Kevin Ryde <user42@zip.com.au>
- * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from
+ * gnus-sum.el (gnus-summary-find-for-reselect): Rename from
gnus-summary-find-uncancelled, skip temporary articles inserted by
"refer" functions.
@@ -3693,7 +3685,7 @@
2003-03-26 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Replace
gnus-summary-update-line (which updated the article's face) with
gnus-summary-update-download-mark (which updates the article's
face by calling gnus-summary-update-line AND updates the download
@@ -3717,8 +3709,8 @@
* rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To
same as Newsgroups.
- * nntp.el (nntp-open-connection-function): Mention
- nntp-open-tls-stream.
+ * nntp.el (nntp-open-connection-function):
+ Mention nntp-open-tls-stream.
(nntp-open-tls-stream): New function.
* tls.el: New file.
@@ -3769,10 +3761,10 @@
* gnus-int.el (gnus-open-server): Catch errors in backend's
open-server method. Returns nil rather than crashing startup.
- * gnus-sum.el (eval-when-compile): Modified to resolve
+ * gnus-sum.el (eval-when-compile): Modify to resolve
compile-time warnings.
- * gnus-uu.el (gnus-uu-mark-series): Added informative msg.
+ * gnus-uu.el (gnus-uu-mark-series): Add informative msg.
Reports length of series so that the user can compare N with a
subject that should, if the entire series is present, contain
'(.../N)'.
@@ -3801,7 +3793,7 @@
2003-03-20 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-check-news-header-syntax): Fixed regexp.
+ * message.el (message-check-news-header-syntax): Fix regexp.
2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -3860,7 +3852,7 @@
* spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
(spam-group-ham-marks, spam-group-spam-marks): New functions.
- (spam-spam-marks, spam-ham-marks): Removed in favor of the
+ (spam-spam-marks, spam-ham-marks): Remove in favor of the
spam-marks and ham-marks parameters.
(spam-generic-register-routine, spam-ham-move-routine): Use the
new spam-group-{spam,ham}-mark-p functions.
@@ -4030,23 +4022,23 @@
2003-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just
- fixing the code to match the documentation.
- (gnus-agent-fetch-selected-article): Replaced
+ * gnus-agent.el (gnus-agent-fetched-hook): New variable.
+ Just fixing the code to match the documentation.
+ (gnus-agent-fetch-selected-article): Replace
gnus-summary-update-article-line with gnus-summary-update-line as
the former did not correctly recalculate the thread indentation.
(gnus-agent-find-parameter): The agent-predicate, if not found
anywhere else, defaults to the value of gnus-agent-predicate.
- (gnus-agent-fetch-session): Fixed typo; now executes
+ (gnus-agent-fetch-session): Fix typo; now executes
gnus-agent-fetched-hook rather than the undocumented
gnus-agent-fetch-hook.
- (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The
- default agent predicate is now provided by
+ (gnus-agent-fetch-group-1): Remove part of 2003-03-06 fix.
+ The default agent predicate is now provided by
gnus-agent-find-parameter.
(gnus-agent-message): New macro. This macro avoids potentially
costly parameter evaluation when the message's level is too high
to display.
- (gnus-agent-expire-group-1): Disabled undo tracking in temp
+ (gnus-agent-expire-group-1): Disable undo tracking in temp
overview buffer. Uses new gnus-agent-message macro to reduce
overhead of optional messages. Reversed message levels to
emphasize percent completion messages. Detailed messages of
@@ -4054,8 +4046,8 @@
2003-03-08 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-ham-move-routine): Use
- spam-mark-ham-unread-before-move-from-spam-group.
+ * spam.el (spam-ham-move-routine):
+ Use spam-mark-ham-unread-before-move-from-spam-group.
(spam-mark-ham-unread-before-move-from-spam-group): New variable.
2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
@@ -4074,7 +4066,7 @@
2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el (spam-use-hashcash): New variable.
- (spam-list-of-checks): Added spam-use-hashcash with associated
+ (spam-list-of-checks): Add spam-use-hashcash with associated
spam-check-hashcash.
(spam-check-hashcash): New function, installed iff hashcash.el is
loaded.
@@ -4082,7 +4074,7 @@
2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetch-group-1): Added default
+ * gnus-agent.el (gnus-agent-fetch-group-1): Add default
predicate of `false' to avoid an error when a group defines no
predicate. Fixed typo that disabled agent scoring (i.e. the
low/high predicates should now work).
@@ -4091,10 +4083,10 @@
* spam.el: Add spam-maybe-spam-stat-load to
gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook.
- (spam-bogofilter-register-with-bogofilter): Use
- spam-bogofilter-spam-switch and spam-bogofilter-ham-switch.
- (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): New
- custom variables to replace "-s" and "-n".
+ (spam-bogofilter-register-with-bogofilter):
+ Use spam-bogofilter-spam-switch and spam-bogofilter-ham-switch.
+ (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch):
+ New custom variables to replace "-s" and "-n".
* gnus-group.el (gnus-group-get-new-news): Call the new
gnus-get-top-new-news-hook hook.
@@ -4113,9 +4105,9 @@
2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding
+ * gnus-agent.el (gnus-agent-fetch-group-1): Add missing binding
on gnus-agent-short-article.
- (gnus-category-read): Replaced CL function mapcar* with new macro:
+ (gnus-category-read): Replace CL function mapcar* with new macro:
gnus-mapcar.
* gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to
support functions that accept multiple parameters. A separate
@@ -4144,19 +4136,19 @@
2003-03-04 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-agent.el (gnus-function-implies-unread-1): Grok
- byte-compiled functions.
+ * gnus-agent.el (gnus-function-implies-unread-1):
+ Grok byte-compiled functions.
2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides
- customization between new maneuvering (which permits selecting
+ * gnus-sum.el (gnus-auto-goto-ignores): New variable.
+ Provides customization between new maneuvering (which permits selecting
undownloaded articles) and old maneuvering (which skipped over
undownloaded articles) behaviors.
(gnus-summary-find-next): Pass through the unread and subject
parameters when calling gnus-summary-find-prev.
- (gnus-summary-find-next, gnus-summary-find-prev): Apply
- gnus-auto-goto-ignores to filter out unacceptable articles.
+ (gnus-summary-find-next, gnus-summary-find-prev):
+ Apply gnus-auto-goto-ignores to filter out unacceptable articles.
2003-03-04 Jesper Harder <harder@ifa.au.dk>
@@ -4167,8 +4159,8 @@
(mail-source-fetch-webmail): Use read-passwd.
* nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo)
- (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use
- read-passwd.
+ (nntp-open-telnet, nntp-open-via-telnet-and-telnet):
+ Use read-passwd.
* nnwarchive.el (nnwarchive-open-server): Use read-passwd.
@@ -4182,14 +4174,14 @@
(sieve-manage-interactive-login): Use read-passwd.
* pop3.el (pop3-read-passwd): Remove.
- (pop3-movemail, pop3-get-message-count, pop3-apop): Use
- read-passwd.
+ (pop3-movemail, pop3-get-message-count, pop3-apop):
+ Use read-passwd.
* pgg.el (pgg-read-passphrase): Simplify.
2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports
+ * gnus-agent.el (gnus-agent-mode): Fix the mode line reports
'plugged' when actually 'unplugged' bug.
(gnus-category-read): Ignore nil values when converting an
old-format category so that the new-format category will default
@@ -4197,8 +4189,8 @@
2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
- * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed
- doc-string.
+ * mail-source.el (mail-source-delete-old-incoming-confirm):
+ Fix doc-string.
2003-03-03 Jesper Harder <harder@ifa.au.dk>
@@ -4226,12 +4218,12 @@
2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config.
- (gnus-user-agent): Fixed typo.
+ (gnus-user-agent): Fix typo.
2003-03-03 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation.
- (gnus-agent-expire-group-1): Removed invalid (interactive) specifier.
+ * gnus-agent.el (gnus-agent-enable-expiration): Fix documentation.
+ (gnus-agent-expire-group-1): Remove invalid (interactive) specifier.
2003-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -4241,8 +4233,8 @@
2003-03-03 Jesper Harder <harder@ifa.au.dk>
* gnus-sum.el (gnus-highlight-selected-summary)
- (gnus-article-get-xrefs, gnus-summary-show-thread): Use
- `gnus-point-at-bol' and `gnus-point-at-eol' instead of
+ (gnus-article-get-xrefs, gnus-summary-show-thread):
+ Use `gnus-point-at-bol' and `gnus-point-at-eol' instead of
`(progn (beginning-of-line) (point))'. It's shorter, faster,
and makes it clear that we don't need the side effect.
* gnus-util.el (gnus-delete-line): Do.
@@ -4280,8 +4272,8 @@
2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-enable-expiration): New
- variable. Either ENABLE or DISABLE. Sets default behavior for
+ * gnus-agent.el (gnus-agent-enable-expiration):
+ New variable. Either ENABLE or DISABLE. Sets default behavior for
selecting which groups are expired.
(gnus-agent-cat-set-property, gnus-agent-cat-defaccessor,
gnus-agent-set-cat-groups): Provides abstract interface for
@@ -4289,8 +4281,8 @@
(gnus-agent-add-group, gnus-agent-remove-group,
gnus-category-insert-line, gnus-category-edit-predicate,
gnus-category-edit-score, gnus-category-edit-groups,
- gnus-category-copy, gnus-category-add, gnus-group-category): Use
- new agent category abstraction.
+ gnus-category-copy, gnus-category-add, gnus-group-category):
+ Use new agent category abstraction.
(gnus-agent-find-parameter): New function. Search for agent
configuration parameter first in the group's parameters, then its
topics (if any), and then the group's category. If not found
@@ -4310,11 +4302,11 @@
(gnus-category-write): Writes category file compatible with
current, and previous, versions of gnus-agent.
(gnus-category-make-function, gnus-category-make-function-1):
- Corrected documentation; parameter is predicate NOT category.
+ Correct documentation; parameter is predicate NOT category.
(gnus-predicate-implies-unread): Now works in more cases per the
todo comment.
- (gnus-function-implies-unread-1): New function. Supports
- gnus-predicate-implies-unread.
+ (gnus-function-implies-unread-1): New function.
+ Supports gnus-predicate-implies-unread.
(gnus-agent-expire-group): Command now provides default of group
under point.
(gnus-agent-expire-group-1): Obeys new agent-enable-expiration and
@@ -4323,12 +4315,12 @@
(gnus-agent-request-article): Now performs its own checks of
gnus-agent, gnus-agent-cache, and gnus-plugged rather than
assuming that the caller will do them correctly.
- (): Added one-time hook to gnus-group-prepare-hook. Detects when
+ (): Add one-time hook to gnus-group-prepare-hook. Detects when
gnus-agent-expire-days is set to an alist. Converts said alist
into group parameter so that gnus-agent-expire-days will not be
needed.
- * gnus-art.el (gnus-request-article-this-buffer): Conditional
- checks surrounding gnus-agent-request-article removed; now
+ * gnus-art.el (gnus-request-article-this-buffer):
+ Conditional checks surrounding gnus-agent-request-article removed; now
performed by gnus-agent-request-article.
* gnus-cus.el (gnus-agent-parameters): New variable. List of
customizable group/topic parameters that regulate the agent.
@@ -4351,8 +4343,8 @@
warnings.
(gnus-long-file-names): New function. Isolates platform dependent
msdos-long-file-names.
- (gnus-save-startup-file-via-temp-buffer): New variable. Provides
- option of writing directly to file. Avoids memory exhausted
+ (gnus-save-startup-file-via-temp-buffer): New variable.
+ Provides option of writing directly to file. Avoids memory exhausted
errors when .newsrc.eld is huge.
(gnus-save-newsrc-file): Uses new
gnus-save-startup-file-via-temp-buffer.
@@ -4419,12 +4411,11 @@
nnimap-split-download-body, we add it to gnus-get-new-news-hook.
(spam-list-of-statistical-checks): List of statistical splitter
checks.
- (spam-split): Added a widen call when a statistical check is
- enabled.
+ (spam-split): Add a widen call when a statistical check is enabled.
2003-02-28 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-msg.el (gnus-user-agent): Changed default to
+ * gnus-msg.el (gnus-user-agent): Change default to
'emacs-gnus-type, renamed 'full.
2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -4444,8 +4435,8 @@
2003-02-26 Simon Josefsson <jas@extundo.com>
- * gnus-sum.el (gnus-summary-toggle-header): Run
- gnus-article-decode-hook instead of calling a-decode-encoded-words
+ * gnus-sum.el (gnus-summary-toggle-header):
+ Run gnus-article-decode-hook instead of calling a-decode-encoded-words
directly (the latter is run as part of the former).
2003-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -4460,13 +4451,13 @@
2003-02-25 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added
- compensation for TDMA addresses.
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist):
+ Add compensation for TDMA addresses.
2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-msg.el (gnus-user-agent): New variable.
- (gnus-version-expose-system): Removed. Obsoleted by
+ (gnus-version-expose-system): Remove. Obsoleted by
`gnus-user-agent'.
(gnus-extended-version): Use `gnus-user-agent'.
@@ -4478,17 +4469,17 @@
2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-group.el (gnus-topic-mode-p): Fixed free variable
+ * gnus-group.el (gnus-topic-mode-p): Fix free variable
reference.
2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * nnheader.el (nnheader-find-nov-line): Changed midpoint
+ * nnheader.el (nnheader-find-nov-line): Change midpoint
calculation to avoid integer overflow.
2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-start.el (gnus-backup-startup-file): Fixed custom type.
+ * gnus-start.el (gnus-backup-startup-file): Fix custom type.
2003-02-24 Teodor Zlatanov <tzz@lifelogs.com>
@@ -4528,10 +4519,10 @@
clause of the condition-case statement. Errors connecting to a
server no longer terminate gnus.
- * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to
+ * gnus-agent.el (gnus-agent-toggle-plugged): Rename parameter to
make its use obvious. Added no-nothing case to avoid
opening(closing) servers when already open(closed).
- (gnus-agent-while-plugged): Added macro to facilitate internal use
+ (gnus-agent-while-plugged): Add macro to facilitate internal use
of gnus-agent-toggle-plugged.
(gnus-agent-fetch-group): Use new gnus-agent-while-plugged to
temporarily open servers.
@@ -4565,8 +4556,8 @@
2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-user-fqdn, message-valid-fqdn-regexp): New
- variables.
+ * message.el (message-user-fqdn, message-valid-fqdn-regexp):
+ New variables.
(message-make-fqdn): Use it. Improved validity check.
2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -4592,7 +4583,7 @@
2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-button-url-regexp): Removed `.
+ * gnus-art.el (gnus-button-url-regexp): Remove `.
2003-02-23 Max Froumentin <mf@w3.org>
@@ -4603,13 +4594,13 @@
* gnus-art.el (gnus-mime-action-on-part): Require a match
interactively.
- * gnus-start.el (gnus-save-newsrc-file): Use
- gnus-backup-startup-file.
+ * gnus-start.el (gnus-save-newsrc-file):
+ Use gnus-backup-startup-file.
(gnus-backup-startup-file): New variable.
2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.el (gnus-summary-buffer-name): Moved function here.
+ * gnus.el (gnus-summary-buffer-name): Move function here.
* gnus-draft.el (defun): Remove debug.
@@ -4631,8 +4622,8 @@
2003-02-22 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort
- `gnus-newsgroup-headers'.
+ * gnus-agent.el (gnus-agent-get-undownloaded-list):
+ Sort `gnus-newsgroup-headers'.
2003-02-22 Karl Pflästerer <sigurd@12move.de>
@@ -4651,18 +4642,18 @@
just article ID.
* gnus-registry.el (gnus-registry-hashtb, gnus-register-action)
- (gnus-register-spool-action): Added hashtable of message ID keys
+ (gnus-register-spool-action): Add hashtable of message ID keys
with message motion data.
2003-02-21 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New
- variable, used in `gnus-button-mid-or-mail-heuristic'.
+ * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist):
+ New variable, used in `gnus-button-mid-or-mail-heuristic'.
(gnus-button-mid-or-mail-heuristic): New function derived from
Florian Weimer's Perl script.
(gnus-button-handle-mid-or-mail): Allow a function instead of
'guess.
- (gnus-button-guessed-mid-regexp): Removed.
+ (gnus-button-guessed-mid-regexp): Remove.
2003-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -4700,7 +4691,7 @@
2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-cite.el (gnus-cite-unsightly-citation-regexp)
- (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to
+ (gnus-cite-parse): Rename `gnus-unsightly-citation-regexp' to
`gnus-cite-unsightly-citation-regexp'.
2003-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -4723,8 +4714,8 @@
2003-02-18 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el (spam-ham-move-routine)
- (spam-mark-spam-as-expired-and-move-routine): Use
- gnus-summary-kill-process-mark and gnus-summary-yank-process-mark
+ (spam-mark-spam-as-expired-and-move-routine):
+ Use gnus-summary-kill-process-mark and gnus-summary-yank-process-mark
around process-mark manipulation on the group.
2003-02-17 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
@@ -4739,8 +4730,8 @@
2003-02-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nndraft.el (nndraft-request-move-article): Bind
- nnmh-allow-delete-final to t.
+ * nndraft.el (nndraft-request-move-article):
+ Bind nnmh-allow-delete-final to t.
2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -4821,8 +4812,8 @@
* gnus-art.el (gnus-article-only-boring-p): New.
(gnus-article-skip-boring): New.
* gnus-cite.el (gnus-article-boring-faces): New.
- * gnus-sum.el (gnus-summary-next-page): Use
- gnus-article-only-boring-p.
+ * gnus-sum.el (gnus-summary-next-page):
+ Use gnus-article-only-boring-p.
2003-02-12 Teodor Zlatanov <tzz@lifelogs.com>
@@ -4842,7 +4833,7 @@
2003-02-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-summary-set-agent-mark): Added call to
+ * gnus-agent.el (gnus-summary-set-agent-mark): Add call to
gnus-summary-goto-subject as gnus-summary-update-mark operates on
the current LINE.
(gnus-agent-summary-fetch-group): Minimized the number of times
@@ -4868,8 +4859,8 @@
2003-02-10 Jesper Harder <harder@ifa.au.dk>
- * mm-util.el (mm-mule-charset-to-mime-charset): Use
- sort-coding-systems to prefer utf-8 over utf-16.
+ * mm-util.el (mm-mule-charset-to-mime-charset):
+ Use sort-coding-systems to prefer utf-8 over utf-16.
2003-02-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
@@ -4880,9 +4871,9 @@
If you don't want to run gnus-agent-expire, don't call it.
(gnus-agent-expire): The broken test to disable gnus-agent-expire
when g-a-e-d was NOT nil was removed.
- (gnus-agent-article-name): Removed unnecessary input test as
+ (gnus-agent-article-name): Remove unnecessary input test as
article IDs are always strings.
- (gnus-agent-regenerate-group): Added check to protect against
+ (gnus-agent-regenerate-group): Add check to protect against
servers that generate absurdly long article IDs. Valid IDs are
less than 10 digits to avoid overflow errors. Fixed logic error
when ensuring that the final article ID is present in the new
@@ -4918,8 +4909,8 @@
2003-02-08 Jesper Harder <harder@ifa.au.dk>
- * gnus-art.el (gnus-article-refer-article): Use
- gnus-replace-in-string.
+ * gnus-art.el (gnus-article-refer-article):
+ Use gnus-replace-in-string.
* gnus-util.el (gnus-map-function): Remove unneeded let-binding.
(gnus-remove-duplicates): Do.
@@ -4928,12 +4919,12 @@
* gnus-int.el (gnus-internal-registry-spool-current-method):
New variable.
- (gnus-request-scan): Set
- gnus-internal-registry-spool-current-method to gnus-command-method
+ (gnus-request-scan):
+ Set gnus-internal-registry-spool-current-method to gnus-command-method
before a request-scan operation.
- * gnus-registry.el (regtest-nnmail): Use
- gnus-internal-registry-spool-current-method.
+ * gnus-registry.el (regtest-nnmail):
+ Use gnus-internal-registry-spool-current-method.
2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -4946,7 +4937,7 @@
* gnus-registry.el: New file with examples of using the hooks.
- * gnus.el (gnus-registry): Added registry customization group.
+ * gnus.el (gnus-registry): Add registry customization group.
(gnus-group-prefixed-name): Improve function to return full group
name optionally.
(gnus-group-guess-prefixed-name): Shortcut to
@@ -4990,8 +4981,8 @@
2003-02-07 Simon Josefsson <jas@extundo.com>
- * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny
- patch from deskpot@myrealbox.com (Vasily Korytov).
+ * mml-sec.el (mml-unsecure-message): Don't use kill-region.
+ Tiny patch from deskpot@myrealbox.com (Vasily Korytov).
2003-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5000,8 +4991,8 @@
2003-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-art.el (gnus-mime-view-part-internally): Bind
- buffer-read-only to nil.
+ * gnus-art.el (gnus-mime-view-part-internally):
+ Bind buffer-read-only to nil.
2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -5120,14 +5111,14 @@
* gnus-util.el (gnus-prin1-to-string): Bind print-length and
print-level.
- * gnus-art.el (article-display-x-face): Removed gray x-face stuff.
- (gnus-treat-display-grey-xface): Removed.
+ * gnus-art.el (article-display-x-face): Remove gray x-face stuff.
+ (gnus-treat-display-grey-xface): Remove.
* gnus-fun.el (gnus-grab-cam-face): New.
- (gnus-convert-image-to-gray-x-face): Removed.
- (gnus-convert-gray-x-face-to-xpm): Removed.
- (gnus-convert-gray-x-face-region): Removed.
- (gnus-grab-gray-x-face): Removed.
+ (gnus-convert-image-to-gray-x-face): Remove.
+ (gnus-convert-gray-x-face-to-xpm): Remove.
+ (gnus-convert-gray-x-face-region): Remove.
+ (gnus-grab-gray-x-face): Remove.
* nnmail.el (nnmail-expiry-wait-function): Doc indent.
@@ -5179,7 +5170,7 @@
* gnus-fun.el (gnus-face-encode): New function.
(gnus-convert-png-to-face): Use it.
- * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks.
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add M-& to marks.
2003-01-26 Jesper Harder <harder@ifa.au.dk>
@@ -5201,16 +5192,16 @@
* mm-encode.el (mm-qp-or-base64): Always QP iff
mm-use-ultra-safe-encoding and cleartext PGP.
- * gnus-sum.el (gnus-summary-select-article): Inhibit
- redisplay (mainly for secured messages).
+ * gnus-sum.el (gnus-summary-select-article):
+ Inhibit redisplay (mainly for secured messages).
* nnmail.el (nnmail-article-group): Copy body too (but don't
process it).
2003-01-25 Jesper Harder <harder@ifa.au.dk>
- * gnus-art.el (gnus-article-setup-buffer): Reset
- gnus-button-marker-list.
+ * gnus-art.el (gnus-article-setup-buffer):
+ Reset gnus-button-marker-list.
2003-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5219,8 +5210,8 @@
2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nnheader.el (nnheader-directory-separator-character): New
- variable.
+ * nnheader.el (nnheader-directory-separator-character):
+ New variable.
2003-01-24 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
@@ -5257,8 +5248,8 @@
2003-01-24 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el (spam-check-blackholes, spam-split)
- (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): Added
- gnus-message calls to show to users what spam.el is doing.
+ (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit):
+ Add gnus-message calls to show to users what spam.el is doing.
2003-01-24 Jesper Harder <harder@ifa.au.dk>
@@ -5282,7 +5273,7 @@
* gnus-async.el (gnus-async-wait-for-article): Don't use a
timeout.
- * nntp.el (nntp-accept-process-output): Removed timeout.
+ * nntp.el (nntp-accept-process-output): Remove timeout.
(nntp-read-timeout): New variable.
(nntp-accept-process-output): Use it.
@@ -5290,14 +5281,14 @@
2003-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I
+ * gnus-sum.el (gnus-summary-first-subject): Fix bug that I
introduced on 2002-01-22.
(gnus-summary-first-unseen-or-unread-subject): Ditto.
2003-01-23 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el (spam-check-regex-headers, spam-list-of-checks)
- (spam-regex-headers-spam, spam-regex-headers-ham): Added spam/ham
+ (spam-regex-headers-spam, spam-regex-headers-ham): Add spam/ham
checks of incoming mail based on simple header regexp matching.
2003-01-22 Teodor Zlatanov <tzz@lifelogs.com>
@@ -5310,16 +5301,16 @@
gnus-newsgroup-unfetched, the list of articles whose headers have
not been fetched from the server.
- * gnus-sum.el (gnus-summary-find-next): Removed undownloaded
+ * gnus-sum.el (gnus-summary-find-next): Remove undownloaded
parameter as it never worked due to a bug. Added check to prevent
selection of any article in the gnus-newsgroup-unfetched list.
- (gnus-summary-find-prev): Added check to prevent selection of any
+ (gnus-summary-find-prev): Add check to prevent selection of any
article in the gnus-newsgroup-unfetched list.
- (gnus-summary-first-subject): Documented API. Modified
- implementation so that constraints are handled independently.
+ (gnus-summary-first-subject): Document API.
+ Modified implementation so that constraints are handled independently.
Added check to prevent selection of any article in the
gnus-newsgroup-unfetched list.
- (gnus-summary-first-unseen-subject): Updated parameters in
+ (gnus-summary-first-unseen-subject): Update parameters in
gnus-summary-first-subject call to match new API.
(gnus-summary-first-unseen-or-unread-subject): Ditto.
(gnus-summary-catchup): Do not mark unfetched articles as read.
@@ -5330,8 +5321,8 @@
make-obsolete-variable allows only two arguments in XEmacs and
Emacs 20.
- * gnus-sum.el (gnus-summary-wash-hide-map): Remove
- gnus-article-hide-pgp.
+ * gnus-sum.el (gnus-summary-wash-hide-map):
+ Remove gnus-article-hide-pgp.
(gnus-summary-make-menu-bar): Do.
* gnus-art.el (gnus-treat-strip-pgp): Make obsolete.
@@ -5348,21 +5339,21 @@
2003-01-21 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-group-ham-processor-bogofilter-p): Fixed bug.
- (spam-ifile-register-ham-routine, spam-ifile-ham-category): New
- option to make ifile a purely binary classifier.
+ * spam.el (spam-group-ham-processor-bogofilter-p): Fix bug.
+ (spam-ifile-register-ham-routine, spam-ifile-ham-category):
+ New option to make ifile a purely binary classifier.
2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * mml-sec.el (mml-secure-sign-pgpauto): Renamed.
- (mml-secure-encrypt-pgpmime): Removed double.
+ * mml-sec.el (mml-secure-sign-pgpauto): Rename.
+ (mml-secure-encrypt-pgpmime): Remove double.
- * gnus-sum.el (gnus-summary-mark-article-as-replied): Added
- debugging statements.
+ * gnus-sum.el (gnus-summary-mark-article-as-replied):
+ Add debugging statements.
2003-01-21 Andreas Fuchs <asf@void.at>
- * mml-sec.el (mml-sign-alist): Added pgpauto.
+ * mml-sec.el (mml-sign-alist): Add pgpauto.
2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5374,7 +5365,7 @@
2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-button-url-regexp): Removed |.
+ * gnus-art.el (gnus-button-url-regexp): Remove |.
* message.el (message-send-hook): Doc fix.
@@ -5394,10 +5385,10 @@
2003-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form.
+ * gnus-agent.el (gnus-agent-regenerate-group): Add interactive form.
- * gnus-sum.el (gnus-summary-update-article-line): Fixed
- calculation of net characters added for use in the gnus-data
+ * gnus-sum.el (gnus-summary-update-article-line):
+ Fix calculation of net characters added for use in the gnus-data
structure.
2003-01-18 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
@@ -5431,8 +5422,8 @@
avoid encoding problems.
* mailcap.el (mailcap-ps-command): New variable.
- (mailcap-mime-data): Add print entry where applicable. Use
- pdftotext on a tty.
+ (mailcap-mime-data): Add print entry where applicable.
+ Use pdftotext on a tty.
2003-01-16 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -5449,7 +5440,7 @@
* spam.el (spam-get-article-as-filename): New function (unused for now).
(spam-get-article-as-buffer): New function.
(spam-get-article-as-string): Use spam-get-article-as-buffer.
- (spam-summary-prepare-exit): Fixed bug, noticed by Malcolm Purvis.
+ (spam-summary-prepare-exit): Fix bug, noticed by Malcolm Purvis.
2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -5500,7 +5491,7 @@
(spam-group-ham-processor-bogofilter-p): New functions for the new
Bogofilter interface.
(spam-summary-prepare-exit): Use the new Bogofilter functions.
- (spam-list-of-checks): Added spam-use-bogofilter-headers.
+ (spam-list-of-checks): Add spam-use-bogofilter-headers.
(spam-bogofilter-score): Rewrote function.
(spam-check-bogofilter): Optional score parameter, uses
spam-check-bogofilter-headers better.
@@ -5518,11 +5509,6 @@
* gnus-ems.el (gnus-mark-active-p): Do.
-2003-01-15 Kevin Ryde <user42@zip.com.au>
-
- * gnus.texi (Using MIME): Mention auto-compression-mode with
- gnus-mime-copy-part.
-
2003-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.el (message-send): Don't warn about duplicates when
@@ -5551,9 +5537,9 @@
2003-01-13 Jhair Tocancipa Triana <jhair_tocancipa@gmx.net>
- * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use
- /usr/bin/play as default player.
- (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play.
+ * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player):
+ Use /usr/bin/play as default player.
+ (gnus-audio-play): Add ARG-DESCRIPTOR to prompt for a file to play.
2003-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -5565,7 +5551,7 @@
fictitious headers generated by nnagent (ie. Undownloaded Article
####) in the list of articles that have not been downloaded.
- * gnus-int.el (): Added require declarations to resolve
+ * gnus-int.el (): Add require declarations to resolve
compile-time warnings.
(gnus-open-server): If the server status is set to offline,
recursively execute gnus-open-server to open the offline backend
@@ -5573,8 +5559,8 @@
2003-01-14 Jesper Harder <harder@ifa.au.dk>
- * gnus-art.el (gnus-article-reply-with-original): Use
- gnus-mark-active-p.
+ * gnus-art.el (gnus-article-reply-with-original):
+ Use gnus-mark-active-p.
(gnus-article-followup-with-original): Do.
2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
@@ -5601,8 +5587,8 @@
* deuglify.el (gnus-article-outlook-unwrap-lines)
(gnus-article-outlook-repair-attribution)
(gnus-article-outlook-rearrange-citation): New function names,
- renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed
- doc-string.
+ renamed from "gnus-outlook-" to "gnus-article-outlook-".
+ Changed doc-string.
* gnus-sum.el (gnus-summary-mode-map): Use new function names,
removed `W k' key binding (use `W Y f' instead).
@@ -5637,7 +5623,7 @@
2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * mail-source.el (mail-sources): Removed autoload to make it
+ * mail-source.el (mail-sources): Remove autoload to make it
compile under XEmacs.
2003-01-12 Raymond Scholz <ray-2003@zonix.de>
@@ -5665,8 +5651,8 @@
2003-01-12 Simon Josefsson <jas@extundo.com>
- * sieve.el (sieve-upload-and-bury): New. Suggested by
- kai.grossjohann@uni-duisburg.de (Kai Großjohann).
+ * sieve.el (sieve-upload-and-bury): New.
+ Suggested by kai.grossjohann@uni-duisburg.de (Kai Großjohann).
* sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c.
Suggested by kai.grossjohann@uni-duisburg.de (Kai Großjohann).
@@ -5711,8 +5697,8 @@
2003-01-10 Reiner Steib <Reiner.Steib@gmx.de>
- * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added
- castellano.
+ * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp):
+ Add castellano.
(gnus-outlook-display-hook): New variable.
(gnus-outlook-display-article-buffer): New function.
(gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution)
@@ -5721,8 +5707,8 @@
(gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'.
* gnus-sum.el: Added autoloads.
- (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map.
- (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu.
+ (gnus-summary-mode-map): Add gnus-summary-wash-deuglify-map.
+ (gnus-summary-make-menu-bar): Add "(Outlook) Deuglify" menu.
2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5770,7 +5756,7 @@
* gnus-fun.el (gnus-face-from-file): New function.
(gnus-convert-face-to-png): Ditto.
- * gnus-art.el (gnus-ignored-headers): Added Face.
+ * gnus-art.el (gnus-ignored-headers): Add Face.
2003-01-10 Simon Josefsson <jas@extundo.com>
@@ -5792,13 +5778,13 @@
* spam-stat.el (spam-stat): Typo fix.
(spam-stat-install-hooks): New variable.
- (spam-stat-split-fancy-spam-group): Added documentation clarification.
+ (spam-stat-split-fancy-spam-group): Add documentation clarification.
(spam-stat-split-fancy-spam-threshhold): New variable.
(spam-stat-install-hooks): Make hooks conditional.
(spam-stat-split-fancy): Use spam-stat-split-fancy-spam-threshhold.
- * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): Add
- spam-stat ham/spam processor symbols.
+ * gnus.el (gnus-group-ham-exit-processor-stat, spam-process):
+ Add spam-stat ham/spam processor symbols.
2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5816,7 +5802,7 @@
2003-01-09 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-check-ifile): Fixed call-process-region to use the
+ * spam.el (spam-check-ifile): Fix call-process-region to use the
db parameter only if it's set.
(spam-ifile-register-with-ifile): Ditto.
@@ -5862,17 +5848,17 @@
* spam.el: Fixed the BBDB autoloads again, using
bbdb-search-simple now (which is not a macro, thank god).
- * gnus.el (ham-process-destination): Added new parameter for
+ * gnus.el (ham-process-destination): Add new parameter for
destination of ham articles found in spam groups at summary exit.
* spam.el (spam-get-ifile-database-parameter):
use spam-ifile-database-path.
(spam-check-ifile, spam-ifile-register-with-ifile):
use spam-get-ifile-database-parameter.
- (spam-ifile-database-path): Added new parameter for ifile's database.
+ (spam-ifile-database-path): Add new parameter for ifile's database.
(spam-move-spam-nonspam-groups-only): New parameter to determine
if spam should be moved from all groups or only some.
- (spam-summary-prepare-exit): Fixed logic to use
+ (spam-summary-prepare-exit): Fix logic to use
spam-move-spam-nonspam-groups-only when deciding to invoke
spam-mark-spam-as-expired-and-move-routine; always invoke that
routine after the spam has been expired-or-moved in case there's
@@ -5884,8 +5870,8 @@
* gnus-spec.el (gnus-parse-complex-format): %~ => ~*.
- * gnus-agent.el (gnus-agent-fetch-selected-article): Use
- gnus-summary-update-article-line.
+ * gnus-agent.el (gnus-agent-fetch-selected-article):
+ Use gnus-summary-update-article-line.
2003-01-08 Simon Josefsson <jas@extundo.com>
@@ -5894,7 +5880,7 @@
2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-check-ifile): Fixed the spam-ifile-all-categories
+ * spam.el (spam-check-ifile): Fix the spam-ifile-all-categories
logic, finally.
2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -5919,21 +5905,21 @@
* message.el (message-make-mail-followup-to,
message-generate-unsubscribed-mail-followup-to): New function
names. Renamed functions: "-mft" -> "-mail-followup-to".
- (message-make-mft, message-gen-unsubscribed-mft): Removed function
+ (message-make-mft, message-gen-unsubscribed-mft): Remove function
names.
* mml.el (mml-preview-insert-mail-followup-to): New function name.
- (mml-preview-insert-mft): Removed function name.
+ (mml-preview-insert-mft): Remove function name.
(mml-preview): Use new function names.
* gnus-art.el (gnus-article-edit-mode-map): Use new function names.
- * message.el (message-mode-field-menu): Moved header related
+ * message.el (message-mode-field-menu): Move header related
commands from "Message" to "Field" menu.
2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-generate-headers-first): Added customization
+ * message.el (message-generate-headers-first): Add customization
if variable is a list.
2003-01-07 Michael Shields <shields@msrl.com>
@@ -5945,8 +5931,8 @@
* gnus-msg.el (gnus-debug): Use ignore-errors.
- * gnus-agent.el (gnus-agent-fetch-selected-article): Use
- `gnus-summary-update-line'.
+ * gnus-agent.el (gnus-agent-fetch-selected-article):
+ Use `gnus-summary-update-line'.
2003-01-08 Simon Josefsson <jas@extundo.com>
@@ -5974,8 +5960,8 @@
2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-sum.el (gnus-summary-make-menu-bar): Added
- gnus-summary-refer-thread to thread menu.
+ * gnus-sum.el (gnus-summary-make-menu-bar):
+ Add gnus-summary-refer-thread to thread menu.
2003-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
@@ -5991,16 +5977,16 @@
* spam.el (spam-check-ifile, spam-ifile-register-with-ifile)
(spam-ifile-register-spam-routine)
- (spam-ifile-register-ham-routine): Added ifile functionality that
+ (spam-ifile-register-ham-routine): Add ifile functionality that
does not use ifile-gnus.el to classify and register articles.
(spam-get-article-as-string): Convenience function.
- (spam-summary-prepare-exit): Added ifile spam and ham registration.
+ (spam-summary-prepare-exit): Add ifile spam and ham registration.
(spam-ifile-all-categories, spam-ifile-spam-category)
- (spam-ifile-path, spam-ifile): Added customization options.
+ (spam-ifile-path, spam-ifile): Add customization options.
- * gnus.el (gnus-group-ham-exit-processor-ifile): Added ifile ham
+ * gnus.el (gnus-group-ham-exit-processor-ifile): Add ifile ham
exit processor.
- (spam-process): Added gnus-group-ham-exit-processor-ifile to the
+ (spam-process): Add gnus-group-ham-exit-processor-ifile to the
list of choices.
2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6010,7 +5996,7 @@
2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nnweb.el (nnweb-asynchronous-p): Changed to nil.
+ * nnweb.el (nnweb-asynchronous-p): Change to nil.
2003-01-07 Simon Josefsson <jas@extundo.com>
@@ -6038,14 +6024,14 @@
2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution
+ * gnus-agent.el (gnus-agent-fetch-group): Modify to permit execution
in either the group or summary buffer.
New command "JS", in summary buffer, will fetch articles per the
group's category, predicate, and processable flags.
(gnus-agent-summary-fetch-series): Rewritten to call
gnus-agent-session-fetch-group once with all articles in the
series.
- (gnus-agent-summary-fetch-group): Fixed bug and modified code to
+ (gnus-agent-summary-fetch-group): Fix bug and modified code to
return list of fetched articles.
(gnus-agent-fetch-articles): Split fetch list into sublists such
that the article buffer is only slightly larger than
@@ -6060,9 +6046,9 @@
When called in the group buffer, articles that can not be fetched
are AUTOMATICALLY MARKED AS READ.
- * gnus-sum.el (): Modified eval-when-compile to minimize
+ * gnus-sum.el (): Modify eval-when-compile to minimize
misleading compilation warnings.
- (gnus-update-summary-mark-positions): Changed code to use
+ (gnus-update-summary-mark-positions): Change code to use
gnus-undownloaded-mark rather than gnus-downloaded-mark.
* nnheader.el (nnheader-insert-nov-file): Do not try to insert an
@@ -6076,18 +6062,18 @@
determine the appropriate course of action. Instead, two function
implementations are provided and the nntp-report function value is
bound to the appropriate implementation.
- (nntp-retrieve-data): Moved nntp-report call to end of implementation.
+ (nntp-retrieve-data): Move nntp-report call to end of implementation.
(nntp-with-open-group): Now binds nntp-report's function cell
rather than binding gnus-with-open-group-first-pass. Added a
condition-case to detect a quit during a nntp command. When the
quit occurs, the current connection is closed as a fetch articles
request could have several megabytes queued up for reading.
- (nntp-retrieve-headers): Bind articles to itself. If
- nntp-with-open-group repeats this command, I must have access to
+ (nntp-retrieve-headers): Bind articles to itself.
+ If nntp-with-open-group repeats this command, I must have access to
the original list of articles.
(nntp-retrieve-groups): Ditto for groups.
(nntp-retrieve-articles): Ditto for articles.
- (*): Replaced nntp-possibly-change-group calls to
+ (*): Replace nntp-possibly-change-group calls to
nntp-with-open-group forms in all, but one, occurrence.
(nntp-accept-process-output): Bug fix. Detect when called with
null process.
@@ -6111,8 +6097,8 @@
* mm-url.el (mm-url-program): Doc fix.
- * message.el (message-mode-map): Rebound
- message-insert-wide-reply.
+ * message.el (message-mode-map):
+ Rebound message-insert-wide-reply.
2003-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -6123,9 +6109,9 @@
* spam.el: Fixed line lengths to 80 chars or less.
- * gnus-sum.el (gnus-read-mark-p): Added the spam-mark as a
+ * gnus-sum.el (gnus-read-mark-p): Add the spam-mark as a
"not-read" mark.
- (gnus-summary-mark-forward): Added the spam-mark to the list of
+ (gnus-summary-mark-forward): Add the spam-mark to the list of
marks not to be marked as "read" when viewed.
2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6175,8 +6161,8 @@
2003-01-04 Kevin Ryde <user42@zip.com.au>
- * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New
- function.
+ * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress):
+ New function.
2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6220,7 +6206,7 @@
(spam-generic-register-routine, spam-BBDB-register-routine)
(spam-ifile-register-routine, spam-blacklist-register-routine)
(spam-whitelist-register-routine): New functions.
- (spam-summary-prepare-exit): Added summary exit processing (expire
+ (spam-summary-prepare-exit): Add summary exit processing (expire
or move) of spam-marked articles for spam groups; added slots for
all the spam-*-register-routine functions.
@@ -6259,8 +6245,8 @@
2003-01-02 Jesper Harder <harder@ifa.au.dk>
- * gnus-group.el (gnus-group-fetch-charter): Use
- http://TLH.news-admin.org/charters/GROUPNAME as a fallback.
+ * gnus-group.el (gnus-group-fetch-charter):
+ Use http://TLH.news-admin.org/charters/GROUPNAME as a fallback.
2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6321,13 +6307,13 @@
* gnus.el (nnheader): Require nnheader.
- * nndraft.el (nndraft-request-associate-buffer): Use
- make-local-variable.
+ * nndraft.el (nndraft-request-associate-buffer):
+ Use make-local-variable.
2003-01-02 Michael Shields <shields@msrl.com>
- * nndraft.el (nndraft-request-associate-buffer): Make
- write-contents-hooks buffer-local before setting it.
+ * nndraft.el (nndraft-request-associate-buffer):
+ Make write-contents-hooks buffer-local before setting it.
2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6349,11 +6335,11 @@
2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-summary-prepare-exit): Added slots for spam- and
+ * spam.el (spam-summary-prepare-exit): Add slots for spam- and
ham-processing of articles; use the new
spam-group-(spam|ham)-contents-p functions.
- (spam-group-spam-contents-p, spam-group-ham-contents-p): New
- convenience functions.
+ (spam-group-spam-contents-p, spam-group-ham-contents-p):
+ New convenience functions.
(spam-mark-junk-as-spam-routine): Use the new
spam-group-spam-contents-p function.
@@ -6365,13 +6351,13 @@
(gnus-group-spam-exit-processor-whitelist)
(gnus-group-spam-exit-processor-BBDB)
(gnus-group-spam-classification-spam)
- (gnus-group-spam-classification-ham): Added new symbols for the
+ (gnus-group-spam-classification-ham): Add new symbols for the
spam-process and spam-contents parameters.
- * spam.el (spam-ham-marks, spam-spam-marks): Changed list
+ * spam.el (spam-ham-marks, spam-spam-marks): Change list
customization and list itself to store mark symbol rather than
mark character.
- (spam-bogofilter-register-routine): Added logic to generate mark
+ (spam-bogofilter-register-routine): Add logic to generate mark
values list from spam-ham-marks and spam-spam-marks, so (member)
would work.
@@ -6381,10 +6367,10 @@
2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-ham-marks, spam-spam-marks): Changed list
+ * spam.el (spam-ham-marks, spam-spam-marks): Change list
customization and list itself to store mark symbol rather than
mark character.
- (spam-bogofilter-register-routine): Added logic to generate mark
+ (spam-bogofilter-register-routine): Add logic to generate mark
values list from spam-ham-marks and spam-spam-marks, so (member)
would work.
@@ -6401,16 +6387,16 @@
message-cross-post-note-function): New variables names.
(message-xpost-old-target, message-xpost-default,
message-xpost-note, message-fup2-note,
- message-xpost-note-function): Removed variable names.
+ message-xpost-note-function): Remove variable names.
(message-cross-post-followup-to-header,
message-cross-post-insert-note, message-cross-post-followup-to):
New function names.
(message-xpost-fup2-header, message-xpost-insert-note,
- message-xpost-fup2): Removed function names.
+ message-xpost-fup2): Remove function names.
2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-send-mail): Added message-cleanup-headers to
+ * message.el (message-send-mail): Add message-cleanup-headers to
prevent newlines in headers.
2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6422,8 +6408,8 @@
2003-01-01 Wes Hardaker <wes@hardakers.net>
- * gnus-sum.el (gnus-summary-display-while-building): New
- variable.
+ * gnus-sum.el (gnus-summary-display-while-building):
+ New variable.
2003-01-01 Raymond Scholz <ray-2003@zonix.de>
@@ -6440,8 +6426,8 @@
lambda form.
(message-draft-headers): New variable.
- * gnus-msg.el (gnus-inews-make-draft-meta-information): New
- function.
+ * gnus-msg.el (gnus-inews-make-draft-meta-information):
+ New function.
(gnus-setup-message): Use it.
* message.el (message-generate-headers-first): Doc fix.
@@ -6460,8 +6446,8 @@
2002-12-31 Raymond Scholz <ray-2002@zonix.de>
- * deuglify.el (gnus-outlook-rearrange-article): Use
- `transpose-regions' instead of tempering the kill-ring.
+ * deuglify.el (gnus-outlook-rearrange-article):
+ Use `transpose-regions' instead of tempering the kill-ring.
(gnus-article-outlook-deuglify-article): Rehighlight article
instead of a complete redisplay.
@@ -6520,7 +6506,7 @@
2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
- * message.el (message-completion-alist): Added "Mail-Followup-To"
+ * message.el (message-completion-alist): Add "Mail-Followup-To"
and "Mail-Copies-To".
2002-07-21 Jesper Harder <harder@ifa.au.dk>
@@ -6529,20 +6515,14 @@
gnus-group-sort-groups-by-real-name and
gnus-group-sort-selected-groups-by-real-name.
-2002-07-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Sorting Groups): Add key bindings for
- gnus-group-sort-groups-by-real-name and
- gnus-group-sort-selected-groups-by-real-name.
-
2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
* spam.el (spam-use-dig): New variable for blackhole checking
through dig.el.
- (spam-check-blackholes): Added dig.el checking functionality and
+ (spam-check-blackholes): Add dig.el checking functionality and
more verbose reporting; query-dig is autoloaded from dig.el.
(spam-use-blackholes): Disabled by default.
- (spam-blackhole-servers): Removed rbl.maps.vix.com from the
+ (spam-blackhole-servers): Remove rbl.maps.vix.com from the
blackhole servers list.
2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -6566,7 +6546,7 @@
2002-08-10 Jari Aalto <jari.aalto@poboxes.com>
- * nnmail.el (nnmail-split-it): Added tracing to
+ * nnmail.el (nnmail-split-it): Add tracing to
`:' split rule.
2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
@@ -6592,7 +6572,7 @@
* gnus-topic.el (gnus-topic-display-missing-topic): New function.
(gnus-topic-goto-missing-group): Use it.
- * message.el (message-required-news-headers): Removed Lines.
+ * message.el (message-required-news-headers): Remove Lines.
(message-reply): Don't insert References first.
(message-followup): Ditto.
(message-make-references): New function.
@@ -6713,7 +6693,7 @@
2002-12-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to
+ * gnus-agent.el (gnus-agent-fetch-selected-article): Add call to
gnus-summary-update-download-mark to update the article in the
summary.
@@ -6723,14 +6703,14 @@
gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face)
New faces.
- * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I
- added this on 2002-11-23 but it just wasn't working out as
+ * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED.
+ I added this on 2002-11-23 but it just wasn't working out as
intended. The idea isn't entirely dead, three new faces
gnus-summary-*-uncached-face are being added to gnus.el to provide
the basis for an improved implementation.
- (gnus-agent-read-servers): Undo the change made on 2002-11-23. The
- proper file to open is lib/servers.
- (gnus-summary-set-agent-mark): Expanded documentation. Unmarking
+ (gnus-agent-read-servers): Undo the change made on 2002-11-23.
+ The proper file to open is lib/servers.
+ (gnus-summary-set-agent-mark): Expand documentation. Unmarking
(i.e. removing the article from gnus-newsgroup-downloadable) will
now restore the article's default mark rather than simply setting
no mark.
@@ -6741,8 +6721,8 @@
(gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded
up to date. Call new gnus-summary-update-download-mark to keep
summary buffer up-to-date.
- (gnus-agent-fetch-selected-article): Keep
- gnus-newsgroup-undownloaded up to date.
+ (gnus-agent-fetch-selected-article):
+ Keep gnus-newsgroup-undownloaded up to date.
(gnus-agent-fetch-articles): Return list of articles that were
successfully fetched.
(gnus-agent-check-overview-buffer): No more thingatpt.
@@ -6760,14 +6740,14 @@
downloaded/undownloaded mark is no longer stored as the article's
mark.
- * gnus-salt.el (gnus-tree-highlight-node): Added uncached as
+ * gnus-salt.el (gnus-tree-highlight-node): Add uncached as
gnus-summary-highlight may use it. Added downloaded as
gnus-summary-highlight was using it.
- * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as
+ * gnus-sum.el (gnus-undownloaded-mark): Change from ?@ to ?- as
the download mark now follows Kai's +/- convention.
- (gnus-downloaded-mark): Added ?+ mark.
- (gnus-summary-highlight): Added rules to select
+ (gnus-downloaded-mark): Add ?+ mark.
+ (gnus-summary-highlight): Add rules to select
gnus-summary-high-uncached-face,
gnus-summary-normal-uncached-face, and
gnus-summary-low-uncached-face. Removed the
@@ -6781,7 +6761,7 @@
you don't have to agentize every server that you use.
(gnus-update-summary-mark-positions): Completed support for the
download type of mark.
- (gnus-summary-insert-line): Added undownloaded to the parameters.
+ (gnus-summary-insert-line): Add undownloaded to the parameters.
(gnus-summary-prepare-threads): Set gnus-tmp-downloaded for
reference by the gnus-summary-line-format-spec.
@@ -6827,8 +6807,8 @@
2002-12-09 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * nntp.el (nntp-send-command): Braino in last commit. Replace
- `and' with `or'.
+ * nntp.el (nntp-send-command): Braino in last commit.
+ Replace `and' with `or'.
2002-12-08 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
@@ -6861,7 +6841,7 @@
2002-11-29 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from
+ * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Move here from
gnus-sum. Made into a user option.
* gnus-sum.el (gnus-simplify-ignored-prefixes)
@@ -6922,7 +6902,7 @@
(gnus-summary-mark-article-as-unread)
(gnus-mark-article-as-unread, gnus-summary-highlight-line):
Reformatting to avoid long lines.
- (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art.
+ (gnus-inhibit-mime-unbuttonizing): Move to gnus-art.
2002-11-28 Daiki Ueno <ueno@unixuser.org>
@@ -6944,15 +6924,15 @@
2002-11-26 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-agent.el (gnus-agent-uncached-articles): If
- gnus-agent-load-alist fails, return ARTICLES.
+ * gnus-agent.el (gnus-agent-uncached-articles):
+ If gnus-agent-load-alist fails, return ARTICLES.
* nnrss.el (nnrss-group-alist): Update the link of Jabber.
2002-11-26 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-sum.el (gnus-summary-insert-old-articles): Remove
- superfluous function call.
+ * gnus-sum.el (gnus-summary-insert-old-articles):
+ Remove superfluous function call.
(gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit):
Add warning to docstring.
@@ -6963,8 +6943,8 @@
2002-11-26 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly
- require thingatpt (for number-at-point) and protect against
+ * gnus-agent.el (gnus-agent-check-overview-buffer):
+ Explicitly require thingatpt (for number-at-point) and protect against
deactivate-mark being unbound (on XEmacs).
2002-11-25 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
@@ -6979,8 +6959,8 @@
2002-11-24 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-sum.el (gnus-summary-insert-old-articles): Use
- gnus-remove-from-range instead of gnus-range-difference which
+ * gnus-sum.el (gnus-summary-insert-old-articles):
+ Use gnus-remove-from-range instead of gnus-range-difference which
doesn't exist.
2002-11-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
@@ -6990,11 +6970,11 @@
(gnus-agent-article-alist): Format change. Add documentation.
(gnus-agent-summary-mode-map): New keybinding `J s' for fetching
process-marked articles.
- (gnus-agent-summary-fetch-series): Command for `J s'. Articles
- in the series are individually fetched to minimize lose of
+ (gnus-agent-summary-fetch-series): Command for `J s'.
+ Articles in the series are individually fetched to minimize lose of
content due to an error/quit.
- (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use
- gnus-message instead of message.
+ (gnus-agent-synchronize-flags-server, gnus-agent-add-server):
+ Use gnus-message instead of message.
(gnus-agent-read-servers): Use file lib/methods instead of
lib/servers. TODO: Why?
(gnus-summary-set-agent-mark): Adapt to new agent-alist format.
@@ -7003,7 +6983,7 @@
(gnus-agent-fetch-selected-article): Don't use history.
(gnus-agent-save-history, gnus-agent-enter-history)
(gnus-agent-article-in-history-p, gnus-agent-history-path):
- Removed function; history is not used anymore.
+ Remove function; history is not used anymore.
(gnus-agent-fetch-articles): Fix handling of crossposted articles.
(gnus-agent-crosspost): Started rewrite then realized that a typo
in gnus-agent-fetch-articles ensures that this function is never
@@ -7033,8 +7013,8 @@
(gnus-agent-regenerate-group): No longer needs to be called from
gnus-agent-regenerate. Individual groups may be regenerated. The
regeneration code now fixes duplicate, and mis-ordered, NOV entries.
- The article fetch dates are validated in the article alist. The
- article alist is pruned of entries that do not reference existing
+ The article fetch dates are validated in the article alist.
+ The article alist is pruned of entries that do not reference existing
NOV entries. All changes are computed then applied with
inhibit-quit bound to t. As a result, it is now safe to quit out of
regeneration. The optional clean parameter has been replaced with
@@ -7042,11 +7022,11 @@
regeneration gets the appropriate setting from
gnus-agent-consider-all-articles. The new reread parameter will
result in fetched, or all, articles being marked as unread.
- (gnus-agent-regenerate): Removed code to regenerate the history
+ (gnus-agent-regenerate): Remove code to regenerate the history
file as it is no longer used.
- * gnus-start.el (gnus-make-ascending-articles-unread): New
- function, for efficient mass-marking.
+ * gnus-start.el (gnus-make-ascending-articles-unread):
+ New function, for efficient mass-marking.
* gnus-sum.el (gnus-summary-highlight): Use new face for
downloaded articles.
@@ -7056,7 +7036,7 @@
line.
(gnus-summary-highlight-line): Use new face for downloaded
articles.
- (gnus-summary-insert-old-articles): Improved performance by
+ (gnus-summary-insert-old-articles): Improve performance by
replacing the initial LIST of older articles with a compressed
RANGE of older articles. Some servers appear to lie about
their active range so the original list could contain millions
@@ -7080,8 +7060,8 @@
2002-11-19 Simon Josefsson <jas@extundo.com>
- * gnus-sum.el (gnus-summary-morse-message): Load
- morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs).
+ * gnus-sum.el (gnus-summary-morse-message):
+ Load morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs).
(unmorse-region): Autoload it instead.
2002-11-18 Simon Josefsson <jas@extundo.com>
@@ -7108,13 +7088,13 @@
2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
- * message.el (message-set-auto-save-file-name): Use
- make-directory, to avoid the dependence on gnus-util.
+ * message.el (message-set-auto-save-file-name):
+ Use make-directory, to avoid the dependence on gnus-util.
2002-11-16 Simon Josefsson <jas@extundo.com>
* nnimap.el (nnimap-callback-callback-function):
- (nnimap-callback-buffer): Removed, these cannot be global but must
+ (nnimap-callback-buffer): Remove, these cannot be global but must
be embedded into the callback.
(nnimap-make-callback): New. Embedd article number, callback and
buffer in function.
@@ -7130,8 +7110,8 @@
2002-11-11 Simon Josefsson <jas@extundo.com>
- * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display
- output when called interactively.
+ * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify):
+ Display output when called interactively.
2002-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -7212,15 +7192,15 @@
works better.
(gnus-agent-fetch-headers): New implementation from Kevin
Greiner. Uses gnus-agent-article-alist to store information
- about fetched messages which aren't on the server anymore. The
- trick is to return a list of considered messages to the caller,
+ about fetched messages which aren't on the server anymore.
+ The trick is to return a list of considered messages to the caller,
but to only fetch those which haven't been fetched yet.
2002-10-30 Simon Josefsson <jas@extundo.com>
* pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom.
- * pgg.el (pgg-passphrase-cache-expiry): Removed.
+ * pgg.el (pgg-passphrase-cache-expiry): Remove.
2002-10-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
@@ -7228,14 +7208,14 @@
versions of emacs-w3m than 1.3.3.
* mm-view.el (mm-w3m-mode-command-alist)
- (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed.
+ (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Remove.
(mm-w3m-mode-map): Undefined for Emacs21 and XEmacs.
- (mm-setup-w3m): Simplified.
+ (mm-setup-w3m): Simplify.
(mm-w3m-local-map-property): New function.
(mm-inline-text-html-render-with-w3m): Use it.
- * gnus-art.el (gnus-article-wash-html-with-w3m): Use
- mm-w3m-local-map-property.
+ * gnus-art.el (gnus-article-wash-html-with-w3m):
+ Use mm-w3m-local-map-property.
2002-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -7251,7 +7231,7 @@
2002-10-28 Josh Huber <huber@alum.wpi.edu>
- * mml.el (mml-mode-map): Fixed keybindings for mml-secure-*
+ * mml.el (mml-mode-map): Fix keybindings for mml-secure-*
functions.
2002-10-28 Mark A. Hershberger <mah@everybody.org>
@@ -7267,8 +7247,8 @@
2002-10-25 Kai Großjohann <kai.grossjohann@uni-duisburg.de>
- * gnus-agent.el (gnus-agent-save-fetched-headers): Create
- directory if it doesn't exist.
+ * gnus-agent.el (gnus-agent-save-fetched-headers):
+ Create directory if it doesn't exist.
(gnus-agent-fetch-headers): Remove old cruft that tried to
abstain from downloading articles more than once if
gnus-agent-consider-all-articles was true. This is now done
@@ -7300,8 +7280,8 @@
* gnus-agent.el (gnus-agent-fetched-headers): New variable,
contains range of headers that have been fetched by the agent
already. Compare gnus-agent-article-alist.
- (gnus-agent-file-header-cache): Like
- gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
+ (gnus-agent-file-header-cache):
+ Like gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
(gnus-agent-fetch-headers): Improve comment. Revert to old
seen/recent logic.
Remember which headers have been fetched before and don't fetch
@@ -7362,7 +7342,7 @@
* gnus-group.el (gnus-fetch-group): Allow an optional
specification of the articles to select.
- * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr.
+ * gnus-srvr.el (gnus-server-prepare): Remove superfluous cdr.
2002-10-20 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -7374,8 +7354,8 @@
2002-10-20 Steve Youngs <youngs@xemacs.org>
- * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs
- doesn't have the 'alist custom type, use cons cells instead.
+ * pgg-parse.el (pgg-parse-public-key-algorithm-alist):
+ XEmacs doesn't have the 'alist custom type, use cons cells instead.
(pgg-parse-symmetric-key-algorithm-alist): Ditto.
(pgg-parse-hash-algorithm-alist): Ditto.
(pgg-parse-compression-algorithm-alist): Ditto.
@@ -7452,8 +7432,8 @@
(nnheader-remove-cr-followed-by-lf): New function.
(nnheader-ms-strip-cr): Use the above function.
- * gnus-agent.el (gnus-agent-regenerate-group): Call
- `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of
+ * gnus-agent.el (gnus-agent-regenerate-group):
+ Call `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of
`nnheader-parse-head'.
* gnus-cache.el (gnus-cache-possibly-enter-article): Ditto.
@@ -7474,8 +7454,8 @@
2002-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
* spam-stat.el: Check for the existence of hash functions instead
- of the Emacs version to decide whether to load cl. Suggested by
- Kai Großjohann.
+ of the Emacs version to decide whether to load cl.
+ Suggested by Kai Großjohann.
2002-10-15 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -7498,7 +7478,7 @@
2002-10-11 Teodor Zlatanov <tzz@lifelogs.com>
- * spam.el (spam-check-ifile): Added ifile as a spam checking
+ * spam.el (spam-check-ifile): Add ifile as a spam checking
backend, and spam-use-ifle as the variable to toggle that check.
2002-10-12 Simon Josefsson <jas@extundo.com>
@@ -7537,7 +7517,7 @@
* mml2015.el (mml2015-pgg-decrypt): Set gnus details even when
decrypt failed.
- (mml2015-trust-boundaries-alist): Removed.
+ (mml2015-trust-boundaries-alist): Remove.
(mml2015-gpg-extract-signature-details): Don't use it.
(mml2015-unabbrev-trust-alist): New.
(mml2015-gpg-extract-signature-details): Use it.
@@ -7558,8 +7538,8 @@
* pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output
buffer and error buffer depending on type of information.
- * mml2015.el (mml2015-gpg-extract-signature-details): Parse
- --status-fd stuff even if gpg.el is not used (revert earlier
+ * mml2015.el (mml2015-gpg-extract-signature-details):
+ Parse --status-fd stuff even if gpg.el is not used (revert earlier
change).
(mml2015-pgg-{clear-,}verify): Store both output and errors as
gnus details.
@@ -7605,8 +7585,8 @@
2002-10-08 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- * gnus-agent.el (gnus-agent-fetch-selected-article): Bind
- gnus-agent-current-history.
+ * gnus-agent.el (gnus-agent-fetch-selected-article):
+ Bind gnus-agent-current-history.
2002-10-06 Simon Josefsson <jas@extundo.com>
@@ -7634,8 +7614,8 @@
* pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work.
- * pgg-pgp.el (pgg-pgp-verify-region): Inline
- binary-write-decoded-region from MEL.
+ * pgg-pgp.el (pgg-pgp-verify-region):
+ Inline binary-write-decoded-region from MEL.
* pgg.el (pgg-encrypt-region): Support sign.
@@ -7690,13 +7670,13 @@
(pgg-string-as-unibyte): Defalias.
(pgg-parse-armor-region): Use it.
- * pgg-gpg.el (pgg-gpg-process-region): Use
- pgg-temporary-file-directory.
+ * pgg-gpg.el (pgg-gpg-process-region):
+ Use pgg-temporary-file-directory.
* luna.el: Don't def-edebug.
- * pgg-pgp5.el (pgg-scheme-verify-region): Inline
- binary-write-decoded-region from MEL.
+ * pgg-pgp5.el (pgg-scheme-verify-region):
+ Inline binary-write-decoded-region from MEL.
* pgg-pgp5.el, pgg-gpg.el: Don't require mel.
@@ -7731,7 +7711,7 @@
(gnus-agent-fetch-selected-article): New function for
gnus-select-article-hook or gnus-mark-article-hook.
-2002-10-02 Peter von der Ahe <nospam2159@daimi.au.dk>
+2002-10-02 Peter von der Ahé <nospam2159@daimi.au.dk>
* gnus-ems.el (gnus-x-splash): Set coding-system-for-read to
raw-text.
@@ -7801,8 +7781,8 @@
* gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in
article buffers.
- * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload
- it just in case.
+ * nnimap.el (nnimap-fixup-unread-after-getting-new-news):
+ Autoload it just in case.
(nnimap-update-unseen): New function; update unseen count in
`n-m-info'.
(nnimap-close-group): Call it.
@@ -7935,8 +7915,8 @@
* gnus-art.el (gnus-button-handle-apropos-variable): Fall back to
apropos if apropos-variable does not exist.
(gnus-button-guessed-mid-regexp)
- (gnus-button-handle-describe-prefix, gnus-button-alist): Better
- regexes.
+ (gnus-button-handle-describe-prefix, gnus-button-alist):
+ Better regexes.
(gnus-button-handle-describe-function)
(gnus-button-handle-describe-variable): Doc fix.
(gnus-button-handle-describe-key, gnus-button-handle-apropos)
@@ -7971,8 +7951,8 @@
2002-09-23 Reiner Steib <Reiner.Steib@gmx.de>
- * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp.
- (gnus-button-alist): Improved regexp for
+ * gnus-art.el (gnus-button-guessed-mid-regexp): Improve regexp.
+ (gnus-button-alist): Improve regexp for
gnus-button-handle-mid-or-mail (false positives), fixed
gnus-button-handle-man entries.
@@ -7983,8 +7963,8 @@
2002-09-23 Paul Jarc <prj@po.cwru.edu>
- * nnmaildir.el: Store article numbers persistently. General
- revision.
+ * nnmaildir.el: Store article numbers persistently.
+ General revision.
(nnmaildir-request-expire-articles): Handle 'immediate and 'never
for nnmail-expiry-wait; delete instead of moving if 'force is
given.
@@ -8026,8 +8006,8 @@
* gnus-msg.el (gnus-configure-posting-styles): Sort results.
- * gnus-art.el (gnus-article-reply-with-original): Correct
- with-current-buffer scope.
+ * gnus-art.el (gnus-article-reply-with-original):
+ Correct with-current-buffer scope.
* message.el (message-completion-alist): Add Reply-To, From, etc.
@@ -8054,7 +8034,7 @@
describtion and menu.
(message-change-subject, message-xpost-fup2): Signal error if
current header is empty.
- (message-xpost-insert-note): Changed insert position.
+ (message-xpost-insert-note): Change insert position.
(message-archive-note): Ensure to insert note in message body (not
in head).
(message-archive-header, message-archive-note)
@@ -8067,7 +8047,7 @@
(message-subject-trailing-was-query)
(message-subject-trailing-was-ask-regexp)
(message-subject-trailing-was-regexp): New variables.
- (message-to-list-only): Added doc-string and menu entry.
+ (message-to-list-only): Add doc-string and menu entry.
* message-utils.el: Removed. Functions are now in message.el.
@@ -8188,8 +8168,8 @@
2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-util.el (gnus-frame-or-window-display-name): Exclude
- invalid display names.
+ * gnus-util.el (gnus-frame-or-window-display-name):
+ Exclude invalid display names.
2002-08-30 Reiner Steib <Reiner.Steib@gmx.de>
@@ -8231,8 +8211,8 @@
2002-08-27 Simon Josefsson <jas@extundo.com>
- * gnus-msg.el (posting-charset-alist): Use
- gnus-define-group-parameter instead of defcustom.
+ * gnus-msg.el (posting-charset-alist):
+ Use gnus-define-group-parameter instead of defcustom.
(gnus-put-message): Handle SPC in GCC.
(gnus-inews-insert-gcc): Ditto.
(gnus-inews-insert-archive-gcc): Ditto.
@@ -8337,12 +8317,12 @@
2002-08-11 Reiner Steib <Reiner.Steib@gmx.de>
* message-utils.el (message-xpost-default)
- (message-xpost-fup2-header, message-xpost-fup2): Fixed Typos.
+ (message-xpost-fup2-header, message-xpost-fup2): Fix Typos.
2002-08-09 Simon Josefsson <jas@extundo.com>
- * message.el (message-canlock-password): Set
- canlock-password-for-verify to newly generated canlock-password.
+ * message.el (message-canlock-password):
+ Set canlock-password-for-verify to newly generated canlock-password.
When Emacs is restarted, Custom makes sure this is set, but during
the same session we must set it manually.
@@ -8400,7 +8380,7 @@
* nnweb.el (nnweb-type, nnweb-type-definition)
(nnweb-gmane-create-mapping, nnweb-gmane-wash-article)
- (nnweb-gmane-search, nnweb-gmane-identity): Added gmane
+ (nnweb-gmane-search, nnweb-gmane-identity): Add gmane
functionality.
* nnweb.el: Removed old non-functioning search engines.
@@ -8412,8 +8392,8 @@
* flow-fill.el (fill-flowed): Disable filladapt-mode.
- * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't
- regexp-quote, Cyrus Sieve is fixed.
+ * gnus-sieve.el (gnus-sieve-guess-rule-for-article):
+ Don't regexp-quote, Cyrus Sieve is fixed.
* sieve-manage.el (sieve-manage-deletescript): New function.
@@ -8431,13 +8411,13 @@
* mm-decode.el (mm-inline-text-html-with-images): Doc fix.
(mm-w3m-safe-url-regexp): New user option.
- * mm-view.el (mm-inline-text-html-render-with-w3m): Use
- `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'.
+ * mm-view.el (mm-inline-text-html-render-with-w3m):
+ Use `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'.
2002-07-23 Karl Kleinpaste <karl@charcoal.com>
- * gnus-sum.el (gnus-summary-delete-article): Force
- nnmail-expiry-target to 'delete, so that absolute deletion
+ * gnus-sum.el (gnus-summary-delete-article):
+ Force nnmail-expiry-target to 'delete, so that absolute deletion
happens when absolute deletion is requested.
2002-07-21 Nevin Kapur <nevin@jhu.edu>
@@ -8498,8 +8478,8 @@
2002-07-06 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change
- cdaar to cdar and car.
+ * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent):
+ Change cdaar to cdar and car.
* nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type)
(nnsoup-read-active-file, nnsoup-article-to-area): Ditto.
@@ -8585,8 +8565,8 @@
2002-06-17 Simon Josefsson <jas@extundo.com>
- * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make
- sure to write byte-compiled versions of gnus-*-format-alist to
+ * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file):
+ Make sure to write byte-compiled versions of gnus-*-format-alist to
.newsrc.eld.
2002-06-16 Bjørn Mork <bmork@dod.no>
@@ -8605,7 +8585,7 @@
* nnheader.el (nnheader-file-name-translation-alist): Set the
default value for MS Windows systems.
- * gnus-ems.el (nnheader-file-name-translation-alist): Removed.
+ * gnus-ems.el (nnheader-file-name-translation-alist): Remove.
2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -8671,8 +8651,8 @@
* gnus-msg.el (gnus-group-mail, gnus-group-news)
(gnus-group-post-news, gnus-summary-mail-other-window)
- (gnus-summary-news-other-window, gnus-summary-post-news): Bind
- gnus-article-copy to nil, thereby inhibiting the `header' posting
+ (gnus-summary-news-other-window, gnus-summary-post-news):
+ Bind gnus-article-copy to nil, thereby inhibiting the `header' posting
style match to use data from last viewed article.
Suggested by Hrvoje Niksic.
@@ -8764,8 +8744,8 @@
2002-05-20 Jason Baker <jbaker@cs.utah.edu> (tiny change)
- * gnus-art.el (gnus-request-article-this-buffer): Try
- reconnecting if you don't get the message.
+ * gnus-art.el (gnus-request-article-this-buffer):
+ Try reconnecting if you don't get the message.
2002-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -8851,7 +8831,7 @@
2002-05-06 Josh Huber <huber@alum.wpi.edu>
- * mml2015.el (mml2015-gpg-encrypt): Changed name of optional
+ * mml2015.el (mml2015-gpg-encrypt): Change name of optional
argument, and fixed compiler warning. (Added autoload for
gpg-encrypt).
@@ -8875,10 +8855,10 @@
* mml-sec.el (mml-signencrypt-style): New.
* mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional
argument `sign'.
- * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to
+ * mml-sec.el (mml-secure-message-encrypt-pgp): Change default to
signencrypt.
* mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto.
- * mml.el (mml-generate-mime-1): Changed logic so a part which is
+ * mml.el (mml-generate-mime-1): Change logic so a part which is
both signed & encryped is processed in one operation (rather than
two separate ops: sign, then encrypt).
* mml2015.el (mml2015-gpg-extract-signature-details): Give some
@@ -8914,8 +8894,8 @@
2002-05-01 Simon Josefsson <jas@extundo.com>
- * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat
- UIDNEXT as a string.
+ * imap.el (imap-parse-resp-text-code, imap-parse-status):
+ Treat UIDNEXT as a string.
* nnimap.el (nnimap-string-lessp-numerical): New function.
(nnimap-retrieve-groups): Compare UIDNEXT as strings instead of
@@ -8938,8 +8918,8 @@
(nnimap-mailbox-info): New internal variable.
(nnimap-retrieve-groups): Implement faster new mail check.
- * nnimap.el (nnimap-split-articles): Support
- nnmail-cache-accepted-message-ids.
+ * nnimap.el (nnimap-split-articles):
+ Support nnmail-cache-accepted-message-ids.
(nnimap-request-accept-article): Ditto.
* imap.el (imap-mailbox-status-asynch): New command.
@@ -9024,8 +9004,8 @@
2002-04-23 Matthieu Moy <Matthieu.Moy@imag.fr>
- * gnus-msg.el (gnus-summary-resend-message-edit): Remove
- message-ignored-resent-headers, too.
+ * gnus-msg.el (gnus-summary-resend-message-edit):
+ Remove message-ignored-resent-headers, too.
2002-04-22 Björn Torkelsson <torkel@acc.umu.se>
@@ -9059,7 +9039,7 @@
(message-mode): Add description for
`message-to-list-only'.
(message-to-list-only): New.
- (message-make-mft): Changed to use the cl loop macro, and added
+ (message-make-mft): Change to use the cl loop macro, and added
optional flag to return only the matched list (for use in new
message-to-list-only function).
@@ -9093,11 +9073,11 @@
2002-04-13 Josh Huber <huber@alum.wpi.edu>
- * mml-sec.el (mml-secure-message): Changed to support arbritrary
+ * mml-sec.el (mml-secure-message): Change to support arbritrary
modes.
* mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)):
changed to support "signencrypt" mode.
- * mml.el (mml-parse-1): Changed to support different secure modes
+ * mml.el (mml-parse-1): Change to support different secure modes
more easily (for signencrypt).
2002-04-11 Stefan Monnier <monnier@cs.yale.edu>
@@ -9118,13 +9098,13 @@
2002-04-12 Daiki Ueno <ueno@unixuser.org>
- * gnus-srvr.el (gnus-server-set-info): Clear
- `gnus-server-method-cache' when `gnus-server-alist' is changed.
+ * gnus-srvr.el (gnus-server-set-info):
+ Clear `gnus-server-method-cache' when `gnus-server-alist' is changed.
2002-04-11 Simon Josefsson <jas@extundo.com>
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force
- viewing of security buttons. Thanks to Nicolas Kowalski
+ * gnus-sum.el (gnus-summary-force-verify-and-decrypt):
+ Force viewing of security buttons. Thanks to Nicolas Kowalski
<Nicolas.Kowalski@imag.fr>.
* smime.el (smime-CA-directory): Fix doc. Thanks to Arne
@@ -9153,7 +9133,7 @@
2002-04-07 Josh Huber <huber@alum.wpi.edu>
- * message.el (message-make-mft): Changed MFT code from using
+ * message.el (message-make-mft): Change MFT code from using
message-recipients (which included Bcc) to use only the To and CC
headers.
@@ -9213,8 +9193,8 @@
* nnmaildir.el: Use defstruct. Use a single copy of
nnmail-extra-headers to save memory. Store server's group name
prefix instead of each group's prefixed name.
- * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase
- nntp-server-buffer.
+ * nnnil.el (nnnil-retrieve-headers, nnnil-request-list):
+ Erase nntp-server-buffer.
2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -9283,7 +9263,7 @@
2002-03-22 Josh Huber <huber@alum.wpi.edu>
- * mml.el (mml-mode-map): Added a keybinding for
+ * mml.el (mml-mode-map): Add a keybinding for
`mml-unsecure-message'. Also, added a menu entry for said
function in the Attachments menu.
@@ -9351,8 +9331,8 @@
2002-03-12 Faried Nawaz <fn@hungry.org> (tiny change)
- * message.el (message-qmail-inject-args): May be function. Adjust
- doc string and custom type.
+ * message.el (message-qmail-inject-args): May be function.
+ Adjust doc string and custom type.
(message-send-mail-with-qmail): Call function if m-q-i-a is a
function.
@@ -9378,8 +9358,8 @@
2002-03-09 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
- * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove
- duplication.
+ * gnus-sum.el (gnus-summary-save-parts-default-mime):
+ Remove duplication.
(gnus-summary-save-parts-type-history): Ditto.
(gnus-summary-save-parts-last-directory): Ditto.
@@ -9419,8 +9399,8 @@
* qp.el (quoted-printable-decode-region): Doc addition.
From: Eli Zaretskii <eliz@is.elta.co.il>
- * mail-source.el (make-source-make-complex-temp-name): Use
- make-temp-file.
+ * mail-source.el (make-source-make-complex-temp-name):
+ Use make-temp-file.
* mm-util.el (mm-make-temp-file): New function.
* nneething.el (nneething-file-name): Use it.
@@ -9435,8 +9415,8 @@
2002-03-04 Paul Jarc <prj@po.cwru.edu>
- * message.el (nnmaildir-article-number-to-base-name): New
- function.
+ * message.el (nnmaildir-article-number-to-base-name):
+ New function.
(nnmaildir-base-name-to-article-number): New function.
2002-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -9488,7 +9468,7 @@
* gnus-util.el (gnus-multiple-choice): New function.
- * gnus-kill.el (gnus-score-insert-help): Removed, because it is
+ * gnus-kill.el (gnus-score-insert-help): Remove, because it is
also defined in gnus-score.el.
2002-03-01 Paul Jarc <prj@po.cwru.edu>
@@ -9555,8 +9535,8 @@
2002-02-22 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
- * mm-decode.el (mm-display-external): Use
- mm-file-name-rewrite-functions.
+ * mm-decode.el (mm-display-external):
+ Use mm-file-name-rewrite-functions.
2002-02-22 Paul Jarc <prj@po.cwru.edu>
@@ -9570,13 +9550,13 @@
2002-02-21 Paul Jarc <prj@po.cwru.edu>
- * nnmaildir.el (nnmaildir-request-expire-articles): Use
- nnmail-expiry-wait* if expire-age parameter is not set.
+ * nnmaildir.el (nnmaildir-request-expire-articles):
+ Use nnmail-expiry-wait* if expire-age parameter is not set.
2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-group.el (gnus-group-sort-groups-by-real-name): New
- function.
+ * gnus-group.el (gnus-group-sort-groups-by-real-name):
+ New function.
(gnus-group-sort-selected-groups-by-real-name): New function.
(gnus-group-make-menu-bar): Add sort by real name.
@@ -9608,7 +9588,7 @@
2002-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
- * many files: Remove trailing whitespaces, replace spc+tab with
+ * Many files: Remove trailing whitespaces, replace spc+tab with
tab, replace leading whitespaces with tabs.
2002-02-19 Paul Jarc <prj@po.cwru.edu>
@@ -9626,8 +9606,8 @@
* rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
- * gnus-art.el (gnus-article-wash-html-with-w3): Remove
- w3-delay-image-loads.
+ * gnus-art.el (gnus-article-wash-html-with-w3):
+ Remove w3-delay-image-loads.
* mm-view.el (mm-inline-text-html-render-with-w3): Ditto.
(mm-w3-prepare-buffer): Ditto.
@@ -9697,7 +9677,7 @@
2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improve to speed
up. Suggested by Yuuichi Teranishi <teranisi@gohome.org>.
* gnus-art.el (article-display-x-face): Sort gray X-Faces.
@@ -9795,8 +9775,8 @@
* gnus-agent.el (gnus-get-predicate): Use nconc.
- * gnus-sum.el (gnus-summary-display-make-predicate): Use
- gnus-summary-display-cache as cache.
+ * gnus-sum.el (gnus-summary-display-make-predicate):
+ Use gnus-summary-display-cache as cache.
* nndoc.el (nndoc-type-alist): Add mail-in-mail type.
(nndoc-mail-in-mail-type-p): New function.
@@ -9806,8 +9786,8 @@
* mailcap.el (mailcap-mime-data): Use enriched-decode.
- * gnus-cite.el (gnus-article-fill-cited-article): Bind
- use-hard-newlines to nil.
+ * gnus-cite.el (gnus-article-fill-cited-article):
+ Bind use-hard-newlines to nil.
* gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that
image is not available if window-system is not available.
@@ -9824,8 +9804,8 @@
* gnus-soup.el (gnus-soup-send-packet): Send news and mail
directly instead of calling message-send-mail.
- * gnus-start.el (gnus-read-descriptions-file): Use
- gnus-default-charset.
+ * gnus-start.el (gnus-read-descriptions-file):
+ Use gnus-default-charset.
* mm-util.el (mm-guess-mime-charset): New function.
@@ -9868,16 +9848,16 @@
2002-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (gnus-article-treat-body-boundary): Add
- gnus-decoration property.
+ * gnus-art.el (gnus-article-treat-body-boundary):
+ Add gnus-decoration property.
* gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration.
* gnus-art.el (gnus-article-treat-unfold-headers): Don't remove
too many spaces.
* rfc2047.el (rfc2047-unfold-region): Ditto.
- (rfc2047-decode-region): Don't unfold. Let
- gnus-article-treat-unfold-headers do it.
+ (rfc2047-decode-region): Don't unfold.
+ Let gnus-article-treat-unfold-headers do it.
2002-02-07 Matt Armstrong <matt@lickey.com>
@@ -9957,8 +9937,8 @@
force, prevent errors when following up from article buffer.
(gnus-article-reply-with-original): Ditto.
- * binhex.el (binhex-decoder-switches): Fix doc. From
- Pavel@Janik.cz (Pavel Janík).
+ * binhex.el (binhex-decoder-switches): Fix doc.
+ From Pavel@Janik.cz (Pavel Janík).
2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -9995,11 +9975,11 @@
* gnus-cache.el (gnus-summary-insert-cached-articles):
(gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted.
- * gnus-group.el (gnus-group-mark-article-read): Nreverse
- gnus-newsgroups-unselected.
+ * gnus-group.el (gnus-group-mark-article-read):
+ Nreverse gnus-newsgroups-unselected.
- * gnus-agent.el (gnus-summary-set-agent-mark): Use
- gnus-add-to-sorted-list.
+ * gnus-agent.el (gnus-summary-set-agent-mark):
+ Use gnus-add-to-sorted-list.
* gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads
gnus-newsgroup-unselected are sorted. Use gnus-sorted-union.
@@ -10014,8 +9994,8 @@
directories.
(gnus-dired-print): New function.
- * gnus-art.el (gnus-mime-print-part): Add argument filename. Call
- ps-despool.
+ * gnus-art.el (gnus-mime-print-part): Add argument filename.
+ Call ps-despool.
2002-02-02 Simon Josefsson <jas@extundo.com>
@@ -10059,11 +10039,11 @@
2002-01-31 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't
- use mail-header-unfold-field.
+ * nnfolder.el (nnfolder-request-replace-article): Unfold.
+ Don't use mail-header-unfold-field.
- * gnus-cache.el (gnus-summary-insert-cached-articles): Use
- gnus-summary-limit.
+ * gnus-cache.el (gnus-summary-insert-cached-articles):
+ Use gnus-summary-limit.
* gnus-range.el (gnus-add-to-sorted-list): New function.
* gnus-sum.el (gnus-mark-article-as-read): Use it.
@@ -10079,8 +10059,8 @@
* gnus-msg.el (gnus-posting-styles): Add new format of header.
(gnus-configure-posting-styles): Support the new format.
- * mail-source.el (mail-source-bind, mail-source-bind-common): Set
- edebug-form-spec to (sexp body).
+ * mail-source.el (mail-source-bind, mail-source-bind-common):
+ Set edebug-form-spec to (sexp body).
Suggested by Joe Wells <jbw@izanami.cee.hw.ac.uk>.
* message.el (message-reply-headers): Add doc.
@@ -10106,19 +10086,19 @@
* nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference.
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- gnus-sorted-difference.
+ * gnus-agent.el (gnus-agent-retrieve-headers):
+ Use gnus-sorted-difference.
- * nnsoup.el (nnsoup-request-expire-articles): Use
- gnus-sorted-difference.
+ * nnsoup.el (nnsoup-request-expire-articles):
+ Use gnus-sorted-difference.
* nnheader.el: Autoload gnus-sorted-difference.
- * nnfolder.el (nnfolder-request-expire-articles): Use
- gnus-sorted-difference.
+ * nnfolder.el (nnfolder-request-expire-articles):
+ Use gnus-sorted-difference.
- * gnus-cache.el (gnus-cache-retrieve-headers): Use
- gnus-sorted-difference.
+ * gnus-cache.el (gnus-cache-retrieve-headers):
+ Use gnus-sorted-difference.
* gnus-range.el: Autoload cookies.
(gnus-sorted-difference): New function.
@@ -10133,8 +10113,8 @@
* gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference,
gnus-sorted-ndifference, and gnus-sorted-nintersection.
(gnus-articles-to-read): Use gnus-sorted-difference.
- (gnus-summary-limit-mark-excluded-as-read): Use
- gnus-sorted-intersection and gnus-sorted-ndifference.
+ (gnus-summary-limit-mark-excluded-as-read):
+ Use gnus-sorted-intersection and gnus-sorted-ndifference.
(gnus-list-of-read-articles): Use gnus-list-range-difference.
(gnus-summary-insert-articles): Use gnus-sorted-difference.
@@ -10150,7 +10130,7 @@
* mm-view.el (mm-w3m-mode-map): New variable.
(mm-w3m-mode-command-alist): New variable.
- (mm-w3m-minor-mode): Removed.
+ (mm-w3m-minor-mode): Remove.
(mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode.
(mm-inline-text-html-render-with-w3m): Add keymap property to the
buffer for using emacs-w3m command keys.
@@ -10161,11 +10141,11 @@
(message-cite-prefix-regexp): Auto detect non word constituents.
(message-cite-prefix-regexp): Don't use with-syntax-table.
- * gnus-sum.el (gnus-summary-update-info): Use
- gnus-list-range-intersection.
+ * gnus-sum.el (gnus-summary-update-info):
+ Use gnus-list-range-intersection.
- * gnus-agent.el (gnus-agent-fetch-headers): Use
- gnus-list-range-intersection.
+ * gnus-agent.el (gnus-agent-fetch-headers):
+ Use gnus-list-range-intersection.
* gnus-range.el (gnus-range-normalize): Use correct predicate.
(gnus-list-range-intersection): Use it.
@@ -10200,8 +10180,8 @@
Don't split when the window is small, e.g. when a small *BBDB*
window is the lowest one.
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- nnheader-find-nov-line to speed up. Use nreverse, because it is
+ * gnus-agent.el (gnus-agent-retrieve-headers):
+ Use nnheader-find-nov-line to speed up. Use nreverse, because it is
sorted. Use nnheader-insert-nov-file.
2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -10219,7 +10199,7 @@
* time-date.el: Add autoload cookies. Many doc fixes.
(time-add): New function.
- (time-subtract): Renamed from subtract-time.
+ (time-subtract): Rename from subtract-time.
(subtract-time): New alias for time-subtract.
2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -10265,7 +10245,7 @@
2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnml.el (nnml-use-compressed-files): New variable.
- (nnml-filenames-are-evil): Removed.
+ (nnml-filenames-are-evil): Remove.
(nnml-current-group-article-to-file-alist): Don't use.
(nnml-update-file-alist): Inhibit.
(nnml-article-to-file): Use new var.
@@ -10330,7 +10310,7 @@
2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-agent.el (gnus-agent-save-alist): Optimized.
+ * gnus-agent.el (gnus-agent-save-alist): Optimize.
2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10341,15 +10321,15 @@
(gnus-server-method-cache): New variable.
(gnus-server-to-method): Use it.
(gnus-group-method-cache): New variable.
- (gnus-find-method-for-group-1): Renamed.
+ (gnus-find-method-for-group-1): Rename.
(gnus-find-method-for-group): New function.
- (gnus-group-method-cache): Removed.
+ (gnus-group-method-cache): Remove.
* gnus-sum.el (gnus-compute-unseen-list): Use new optimized
function.
* gnus-range.el (gnus-members-of-range): New function.
- (gnus-list-range-intersection): Renamed.
+ (gnus-list-range-intersection): Rename.
(gnus-inverse-list-range-intersection): New function.
* gnus-sum.el (gnus-compute-unseen-list): Made into own function.
@@ -10361,8 +10341,8 @@
2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
- * mm-view.el (mm-inline-text-html-render-with-w3m): Decode
- charset-encoded html contents.
+ * mm-view.el (mm-inline-text-html-render-with-w3m):
+ Decode charset-encoded html contents.
2002-01-24 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -10412,12 +10392,12 @@
2002-01-22 Josh Huber <huber@alum.wpi.edu>
- * mml.el (mml-parse-1): Fixed usage of recipients in the secure
+ * mml.el (mml-parse-1): Fix usage of recipients in the secure
tag.
2002-01-22 Josh Huber <huber@alum.wpi.edu>
- * message.el (message-font-lock-keywords): Added the secure tag.
+ * message.el (message-font-lock-keywords): Add the secure tag.
* mml-sec.el: Added functions to generate/modify/remove the secure
tag while in message mode.
* mml-sec.el (mml-secure-message): New.
@@ -10428,12 +10408,12 @@
* mml-sec.el (mml-secure-message-encrypt-smime): New.
* mml-sec.el (mml-secure-message-encrypt-pgp): New.
* mml-sec.el (mml-secure-message-encrypt-pgpmime): New.
- * mml.el (mml-parse-1): Added code to recognize the secure tag and
+ * mml.el (mml-parse-1): Add code to recognize the secure tag and
convert it to either a part or multipart depending on if there are
other parts in the message.
- * mml.el (mml-mode-map): Changed default sign/encrypt keybindings
+ * mml.el (mml-mode-map): Change default sign/encrypt keybindings
to use the secure tag, rather than the part tag.
- * mml.el (mml-preview): Added a save-excursion to keep cursor
+ * mml.el (mml-preview): Add a save-excursion to keep cursor
position after doing an MML preview.
2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10473,8 +10453,8 @@
2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nnfolder.el (nnfolder-request-accept-article): Unfold
- x-from-line.
+ * nnfolder.el (nnfolder-request-accept-article):
+ Unfold x-from-line.
(nnfolder-request-replace-article): Ditto.
2002-01-20 Nevin Kapur <nevin@jhu.edu>
@@ -10498,8 +10478,8 @@
* message.el (message-dont-send): Doc fix.
- * gnus-util.el (gnus-completing-read): Remove
- inherit-input-method.
+ * gnus-util.el (gnus-completing-read):
+ Remove inherit-input-method.
* gnus-art.el (gnus-treat-smiley): Doc fix.
@@ -10552,8 +10532,8 @@
2002-01-19 Daniel Pittman <daniel@rimspace.net>
- * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New
- functions.
+ * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject):
+ New functions.
2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10562,7 +10542,7 @@
* gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical
articles.
- * gnus-util.el (gnus-completing-read-with-default): Renamed.
+ * gnus-util.el (gnus-completing-read-with-default): Rename.
* nnmail.el (nnmail-article-group): Clean up.
@@ -10582,17 +10562,17 @@
* smiley-ems.el (smiley-region): Register smiley.
(smiley-toggle-buffer): Rewrite the function.
- (smiley-active): Removed.
+ (smiley-active): Remove.
2002-01-19 Simon Josefsson <jas@extundo.com>
- * gnus-util.el (gnus-parent-id): Optimize null n case. From
- Jesper Harder <harder@ifa.au.dk>.
+ * gnus-util.el (gnus-parent-id): Optimize null n case.
+ From Jesper Harder <harder@ifa.au.dk>.
2002-01-18 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
- * gnus-art.el (gnus-request-article-this-buffer): Call
- `nneething-get-file-name' to extract the file name from the
+ * gnus-art.el (gnus-request-article-this-buffer):
+ Call `nneething-get-file-name' to extract the file name from the
message id.
* nneething.el (nneething-encode-file-name): New function.
@@ -10660,21 +10640,21 @@
2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer.
- (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove
- duplications.
+ (gnus-agent-braid-nov): Switch back to nntp-server-buffer.
+ Remove duplications.
(gnus-agent-batch): Bind gnus-agent-confirmation-function.
2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-sum.el (gnus-summary-initial-limit): Inline
- gnus-summary-limit-children.
+ * gnus-sum.el (gnus-summary-initial-limit):
+ Inline gnus-summary-limit-children.
(gnus-summary-initial-limit): Don't limit if
gnus-newsgroup-display is nil.
(gnus-summary-initial-limit): No, don't.
* gnus-util.el
- (gnus-put-text-property-excluding-characters-with-faces): Inline
- gnus-put-text-property.
+ (gnus-put-text-property-excluding-characters-with-faces):
+ Inline gnus-put-text-property.
* gnus-spec.el (gnus-default-format-specs): New variable.
@@ -10691,8 +10671,8 @@
* gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some
functions.
- (gnus-gather-threads-by-references): Inline
- `gnus-split-references'.
+ (gnus-gather-threads-by-references):
+ Inline `gnus-split-references'.
* gnus-spec.el (gnus-summary-line-format-spec): New, optimized
default value of gnus-summary-line-format-spec.
@@ -10702,7 +10682,7 @@
* nnslashdot.el (nnslashdot-retrieve-headers-1): A better error
message.
(nnslashdot-request-list): Ditto.
- (nnslashdot-sid-strip): Removed.
+ (nnslashdot-sid-strip): Remove.
2002-01-15 Simon Josefsson <jas@extundo.com>
@@ -10716,14 +10696,14 @@
2002-01-15 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
- * nneething.el (nneething-request-article): Set
- `nnmail-file-coding-system' to `binary' locally, in order to read
+ * nneething.el (nneething-request-article):
+ Set `nnmail-file-coding-system' to `binary' locally, in order to read
files without any conversion.
2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- nnheader-file-coding-system and nnmail-active-file-coding-system.
+ * gnus-agent.el (gnus-agent-retrieve-headers):
+ Use nnheader-file-coding-system and nnmail-active-file-coding-system.
(gnus-agent-regenerate-group): Ditto.
(gnus-agent-regenerate): Ditto.
(gnus-agent-write-active): Ditto.
@@ -10758,19 +10738,19 @@
* imap.el (imap-close): Keep going if quit.
- * gnus-agent.el (gnus-agent-retrieve-headers): Erase
- nntp-server-buffer.
+ * gnus-agent.el (gnus-agent-retrieve-headers):
+ Erase nntp-server-buffer.
2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mm-view.el (mm-display-inline-fontify): Require font-lock to
avoid unbinding shadowed variables.
- * gnus-art.el (gnus-picon-databases): Moved here.
- (gnus-picons-installed-p): Moved here.
+ * gnus-art.el (gnus-picon-databases): Move here.
+ (gnus-picons-installed-p): Move here.
(gnus-article-reply-with-original): Use `mark'.
- * gnus.el (gnus-picon): Moved here and renamed.
+ * gnus.el (gnus-picon): Move here and renamed.
* gnus-art.el (gnus-treat-from-picon): Only be on if picons are
installed.
@@ -10793,8 +10773,8 @@
2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-article-reply-with-original): Use
- `mark-active'.
+ * gnus-art.el (gnus-article-reply-with-original):
+ Use `mark-active'.
* gnus-msg.el (gnus-summary-reply): Don't bug out on regions.
@@ -10805,16 +10785,16 @@
2002-01-12 Simon Josefsson <jas@extundo.com>
* flow-fill.el (fill-flowed-display-column)
- (fill-flowed-encode-columnq): New variables. Suggested by
- Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann).
+ (fill-flowed-encode-columnq): New variables.
+ Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann).
(fill-flowed-encode, fill-flowed): Use them.
- * message.el (message-send-news, message-send-mail): Use
- m-b-s-n-p-e-h-n.
+ * message.el (message-send-news, message-send-mail):
+ Use m-b-s-n-p-e-h-n.
* mml.el (autoload): Autoload fill-flowed-encode.
- (mml-buffer-substring-no-properties-except-hard-newlines): New
- function.
+ (mml-buffer-substring-no-properties-except-hard-newlines):
+ New function.
(mml-read-part): Use it.
(mml-generate-mime-1): Encode format=flowed if appropriate.
(mml-insert-mime-headers): Insert format=flowed.
@@ -10854,8 +10834,8 @@
gnus-article-prepare-hook.
* gnus-agent.el (gnus-agent-retrieve-headers): Load agentview.
- (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move
- gnus-agent-possibly-synchronize-flags to the last.
+ (gnus-agent-toggle-plugged): Use gnus-agent-go-online.
+ Move gnus-agent-possibly-synchronize-flags to the last.
(gnus-agent-go-online): New function. New variable.
2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -10915,8 +10895,8 @@
2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnkiboze.el (nnkiboze-request-article): Use
- gnus-agent-request-article.
+ * nnkiboze.el (nnkiboze-request-article):
+ Use gnus-agent-request-article.
* nnagent.el (nnagent-retrieve-headers): Don't use nnml
function. Insert undownloaded NOV.
@@ -10926,13 +10906,13 @@
* gnus.el (gnus-agent-cache): New variable.
- * gnus-int.el (gnus-retrieve-headers): Use
- gnus-agent-retrieve-headers.
+ * gnus-int.el (gnus-retrieve-headers):
+ Use gnus-agent-retrieve-headers.
(gnus-request-head): Use gnus-agent-request-article.
(gnus-request-body): Ditto.
- * gnus-art.el (gnus-request-article-this-buffer): Use
- gnus-agent-request-article.
+ * gnus-art.el (gnus-request-article-this-buffer):
+ Use gnus-agent-request-article.
* gnus-sum.el (gnus-summary-read-group-1): Don't show the first
article if it is undownloaded.
@@ -10953,8 +10933,8 @@
2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu>
- * mm-encode.el (mm-content-transfer-encoding-defaults): Add
- application/x-emacs-lisp.
+ * mm-encode.el (mm-content-transfer-encoding-defaults):
+ Add application/x-emacs-lisp.
* gnus-msg.el (gnus-bug): Use application/emacs-lisp.
@@ -10997,8 +10977,8 @@
2002-01-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
* nneething.el (nneething-request-article): When a non-text file
- is converted to an article, its data is encoded in base64. Call
- `nneething-make-head' with options to specify MIME types.
+ is converted to an article, its data is encoded in base64.
+ Call `nneething-make-head' with options to specify MIME types.
(nneething-make-head): Add optional arguments to specify MIME
types.
@@ -11018,13 +10998,13 @@
2002-01-06 Simon Josefsson <jas@extundo.com>
- * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use
- condition-case, not ignore-errors.
+ * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch):
+ Use condition-case, not ignore-errors.
2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-sum.el (gnus-summary-insert-old-articles): Bind
- gnus-fetch-old-headers.
+ * gnus-sum.el (gnus-summary-insert-old-articles):
+ Bind gnus-fetch-old-headers.
* gnus-art.el (article-display-x-face): Use the current buffer
unless `W f'. Otherwise, X-Face may be shown in the header of a
@@ -11034,8 +11014,8 @@
2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-group.el (gnus-group-read-ephemeral-group): Fix
- parameters.
+ * gnus-group.el (gnus-group-read-ephemeral-group):
+ Fix parameters.
2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -11045,8 +11025,8 @@
(mm-detect-coding-region): New function.
(mm-detect-mime-charset-region): New function.
- * gnus-sum.el (gnus-summary-show-article): Use
- mm-detect-coding-region.
+ * gnus-sum.el (gnus-summary-show-article):
+ Use mm-detect-coding-region.
2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -11082,7 +11062,7 @@
2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus.el (gnus-logo-color-alist): Added more colors from Luis.
+ * gnus.el (gnus-logo-color-alist): Add more colors from Luis.
2002-01-05 Keiichi Suzuki <keiichi@nanap.org> (tiny change)
@@ -11107,7 +11087,7 @@
2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-thread-latest-date): New function.
- (gnus-thread-sort-by-most-recent-number): Renamed.
+ (gnus-thread-sort-by-most-recent-number): Rename.
(gnus-thread-sort-functions): Doc fix.
(gnus-select-group-hook): Don't use setq on a hook.
(gnus-thread-latest-date): Use date, not number.
@@ -11115,14 +11095,14 @@
* gnus-agent.el (gnus-agent-expire-days): Doc fix.
(gnus-agent-expire): Allow regexp of expire-days.
- * gnus-art.el (gnus-article-reply-with-original): Deactivate
- region.
+ * gnus-art.el (gnus-article-reply-with-original):
+ Deactivate region.
(gnus-article-followup-with-original): Ditto.
* gnus-sum.el (gnus-thread-highest-number): Doc fix.
- * gnus-art.el (gnus-mime-display-alternative): Use
- gnus-local-map-property.
+ * gnus-art.el (gnus-mime-display-alternative):
+ Use gnus-local-map-property.
(gnus-mime-display-alternative): Ditto.
(gnus-insert-mime-security-button): Ditto.
(gnus-insert-next-page-button): Ditto.
@@ -11141,7 +11121,7 @@
"X-Face: " to the data in the built-in scenario.
* gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form.
- (gnus-correct-pad-form): Renamed.
+ (gnus-correct-pad-form): Rename.
(gnus-tilde-max-form): Clean up.
(gnus-pad-form): Use gnus-use-correct-string-widths.
@@ -11172,30 +11152,30 @@
* gnus-fun.el (gnus-display-x-face-in-from): Use face.
- * gnus-ems.el (gnus-article-xface-ring-internal): Removed.
- (gnus-article-xface-ring-size): Removed.
- (gnus-article-display-xface): Removed.
+ * gnus-ems.el (gnus-article-xface-ring-internal): Remove.
+ (gnus-article-xface-ring-size): Remove.
+ (gnus-article-display-xface): Remove.
(gnus-remove-image): Cleaned up.
* gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm.
(gnus-xmas-create-image): Take pbm files.
- (gnus-x-face): Removed.
- (gnus-xmas-article-display-xface): Removed.
+ (gnus-x-face): Remove.
+ (gnus-xmas-article-display-xface): Remove.
- * gnus-fun.el (gnus-display-x-face-in-from): Bind
- default-enable-multibyte-characters.
+ * gnus-fun.el (gnus-display-x-face-in-from):
+ Bind default-enable-multibyte-characters.
* compface.el (uncompface): Doc fix.
- * gnus-art.el (gnus-article-x-face-command): Use
- gnus-display-x-face-in-from.
+ * gnus-art.el (gnus-article-x-face-command):
+ Use gnus-display-x-face-in-from.
* gnus-xmas.el (gnus-xmas-put-image): Return the image.
* gnus-ems.el (gnus-put-image): Return the image.
* gnus-fun.el (gnus-display-x-face-in-from): New function.
- (gnus-x-face): Moved here.
+ (gnus-x-face): Move here.
2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -11229,9 +11209,9 @@
* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface.
- * compface.el (compface-xbm-p): Removed.
+ * compface.el (compface-xbm-p): Remove.
- * gnus-ems.el (gnus-article-compface-xbm): Removed.
+ * gnus-ems.el (gnus-article-compface-xbm): Remove.
(gnus-article-display-xface): Use compface.
* compface.el: New file.
@@ -11243,8 +11223,8 @@
2002-01-03 Paul Jarc <prj@po.cwru.edu>
- * nnmaildir.el (nnmaildir-request-expire-articles): Evaluate
- the expire-group parameter once per article rather than once
+ * nnmaildir.el (nnmaildir-request-expire-articles):
+ Evaluate the expire-group parameter once per article rather than once
per group; bind `nnmaildir-article-file-name' and `article'
for convenience. Leave article alone when expire-group
specifies the current group.
@@ -11257,7 +11237,7 @@
2002-01-03 Dave Love <d.love@dl.ac.uk>
- * gnus-start.el (gnus-startup-file-coding-system): Removed.
+ * gnus-start.el (gnus-startup-file-coding-system): Remove.
(gnus-read-init-file): Don't use it.
2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -11279,7 +11259,7 @@
2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus.el (gnus-summary-line-format): Added :link.
+ * gnus.el (gnus-summary-line-format): Add :link.
* gnus-topic.el (gnus-topic-line-format): Ditto.
* gnus-sum.el (gnus-summary-dummy-line-format): Ditto.
* gnus-srvr.el (gnus-server-line-format): Ditto.
@@ -11347,7 +11327,7 @@
2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed.
+ * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Rename.
* gnus-art.el (gnus-ignored-headers): Hide all X-Faces.
(article-display-x-face): Display gray X-Faces.
@@ -11400,10 +11380,10 @@
* gnus-fun.el: New file.
(gnus-convert-image-to-x-face-command): New variable.
(gnus-insert-x-face): New function.
- (gnus-random-x-face): Renamed.
- (gnus-x-face-from-file): Renamed.
+ (gnus-random-x-face): Rename.
+ (gnus-x-face-from-file): Rename.
- * gnus-art.el (gnus-body-boundary-delimiter): Changed default to
+ * gnus-art.el (gnus-body-boundary-delimiter): Change default to
"_".
(gnus-body-boundary-delimiter): Typo fix.
@@ -11453,7 +11433,7 @@
* gnus-picon.el (gnus-picon-find-face): Search MISC for all types.
(gnus-picon-transform-address): Search for unknown faces as well.
(gnus-picon-find-face): Don't search "news" for MISC.
- (gnus-picon-user-directories): Changed default back to exclude
+ (gnus-picon-user-directories): Change default back to exclude
"unknown".
* gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic.
@@ -11466,13 +11446,13 @@
keystroke.
(gnus-topic-goto-next-topic): Ditto.
- * gnus.el (gnus-summary-line-format): Changed default.
+ * gnus.el (gnus-summary-line-format): Change default.
* nnmail.el (nnmail-extra-headers): Change default.
* gnus-sum.el (gnus-extra-headers): Change default.
- * message.el (message-news-other-window): Changed "news" to
+ * message.el (message-news-other-window): Change "news" to
"posting".
(message-news-other-frame): Ditto.
(message-do-send-housekeeping): Ditto.
@@ -11510,8 +11490,8 @@
2002-01-01 Steve Youngs <youngs@xemacs.org>
- * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment
- 'set-glyph-face' so x-face back/foreground can be set.
+ * gnus-xmas.el (gnus-xmas-article-display-xface):
+ Uncomment 'set-glyph-face' so x-face back/foreground can be set.
2001-12-31 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -11519,16 +11499,16 @@
2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-treat-smiley): Renamed command.
+ * gnus-art.el (gnus-treat-smiley): Rename command.
(gnus-article-remove-images): New command and keystroke.
- * gnus-sum.el (gnus-summary-toggle-smiley): Removed.
+ * gnus-sum.el (gnus-summary-toggle-smiley): Remove.
- * smiley-ems.el (gnus-smiley-display): Removed.
+ * smiley-ems.el (gnus-smiley-display): Remove.
* gnus.el (gnus-version-number): Update version.
- * message.el (message-text-with-property): Renamed and moved
+ * message.el (message-text-with-property): Rename and moved
here.
(message-fix-before-sending): Highlight invisible text and place
point there.
@@ -11539,7 +11519,7 @@
2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-delay.el (gnus-delay-send-queue): Renamed.
+ * gnus-delay.el (gnus-delay-send-queue): Rename.
* gnus-art.el (gnus-ignored-headers): More headers.
@@ -11569,7 +11549,7 @@
2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-group.el (gnus-group-line-format): Added %O to the default
+ * gnus-group.el (gnus-group-line-format): Add %O to the default
value.
* gnus-util.el (gnus-text-with-property): The smallest point is
@@ -11602,7 +11582,7 @@
* gnus-ems.el (gnus-article-display-xface): Mark and store image.
- * gnus-art.el (gnus-article-wash-status-entry): Renamed.
+ * gnus-art.el (gnus-article-wash-status-entry): Rename.
(gnus-article-wash-status): Use it.
(gnus-signature-toggle): Clean up.
(gnus-add-wash-status): New function.
@@ -11626,7 +11606,7 @@
* smiley-ems.el (gnus-smiley-file-types): New variable.
(smiley-update-cache): Use it.
(smiley-regexp-alist): Suffix-less smiley names.
- (smiley-regexp-alist): Added more smileys.
+ (smiley-regexp-alist): Add more smileys.
* gnus-sum.el (gnus-print-buffer): Made into own function.
(gnus-summary-print-article): Use it.
@@ -11641,8 +11621,8 @@
2001-12-31 Simon Josefsson <jas@extundo.com>
- * imap.el (imap-parse-fetch): Notice empty flags responses. From
- Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>.
+ * imap.el (imap-parse-fetch): Notice empty flags responses.
+ From Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>.
2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -11655,15 +11635,15 @@
2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't
- infloop.
+ * gnus-art.el (gnus-article-treat-fold-newsgroups):
+ Don't infloop.
* gnus-sum.el (t): New `W D' map.
* gnus-art.el (gnus-treat-fold-newsgroups): New variable.
(gnus-article-treat-body-boundary): Clean up.
- (gnus-body-boundary-face): Removed.
- (gnus-article-goto-header): Moved here.
+ (gnus-body-boundary-face): Remove.
+ (gnus-article-goto-header): Move here.
(gnus-article-goto-header): Allow better regexps.
(gnus-article-treat-fold-newsgroups): New command.
@@ -11678,7 +11658,7 @@
* mail-parse.el (mail-header-fold-line): New alias.
(mail-header-unfold-line): Ditto.
- * gnus-art.el (gnus-body-boundary-face): Renamed.
+ * gnus-art.el (gnus-body-boundary-face): Rename.
(gnus-article-treat-body-boundary): Use it.
(gnus-article-treat-body-boundary): Use an invisible header and a
line of underline characters.
@@ -11693,8 +11673,8 @@
(gnus-picon-transform-address): Use it. Set first to t for each
address.
- * gnus-art.el (gnus-with-article-headers): Move to here. Define
- the macro then use it.
+ * gnus-art.el (gnus-with-article-headers): Move to here.
+ Define the macro then use it.
(gnus-treatment-function-alist): Treat picons earlier.
2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -11715,7 +11695,7 @@
* gnus-xmas.el (gnus-xmas-group-startup-message): Use general
colors.
- * gnus.el (gnus-logo-color-alist): Moved here and renamed.
+ * gnus.el (gnus-logo-color-alist): Move here and renamed.
(gnus-logo-color-style): Ditto.
(gnus-logo-colors): Ditto.
@@ -11729,26 +11709,26 @@
* ietf-drums.el (ietf-drums-parse-addresses): Accept a nil
string.
- * gnus-picon.el (gnus-treat-mail-picon): Renamed.
+ * gnus-picon.el (gnus-treat-mail-picon): Rename.
* gnus-art.el (gnus-treat-cc-picon): New variable.
- (gnus-treat-mail-picon): Renamed.
+ (gnus-treat-mail-picon): Rename.
* gnus-picon.el: New implementation.
- (gnus-picon-find-face): Renamed.
+ (gnus-picon-find-face): Rename.
(gnus-treat-from-picon): Use it.
- (gnus-picon-transform-address): Renamed.
+ (gnus-picon-transform-address): Rename.
(gnus-treat-from-picon): Use it.
- (gnus-picon-create-glyph): Renamed.
+ (gnus-picon-create-glyph): Rename.
(gnus-picon-transform-address): Use it.
(gnus-treat-cc-picon): New command.
- * mm-decode.el (mm-create-image-xemacs): Separated out into
+ * mm-decode.el (mm-create-image-xemacs): Separate out into
function.
(mm-get-image): Use it.
* gnus-art.el (gnus-treat-display-picons): Simplify.
- (gnus-treat-from-picon): Renamed.
+ (gnus-treat-from-picon): Rename.
* gnus-ems.el (gnus-create-image): New function.
(gnus-put-image): New function.
@@ -11775,7 +11755,7 @@
2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-art.el (gnus-treat-unfold-lines): New variable.
- (gnus-treat-unfold-headers): Renamed.
+ (gnus-treat-unfold-headers): Rename.
(gnus-article-treat-unfold-headers): New command and keystroke.
* rfc2047.el (rfc2047-encode-message-header): Clean up.
@@ -11792,7 +11772,7 @@
2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-picon.el (gnus-picons-news-directories): Removed obsolete
+ * gnus-picon.el (gnus-picons-news-directories): Remove obsolete
alias.
(gnus-picons-database): Default to list.
(gnus-picons-lookup-internal): Use it.
@@ -11830,8 +11810,8 @@
* gnus-art.el (gnus-treatment-function-alist): Emphasize after
other treatments.
- * gnus-util.el (gnus-put-overlay-excluding-newlines): New
- function.
+ * gnus-util.el (gnus-put-overlay-excluding-newlines):
+ New function.
* gnus-art.el (gnus-article-show-hidden-text): Remove the type
from the list of hidden types.
@@ -11844,7 +11824,7 @@
2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-art.el (gnus-ignored-headers): Added more headers.
+ * gnus-art.el (gnus-ignored-headers): Add more headers.
2001-12-29 Jesper Harder <harder@ifa.au.dk>
@@ -11857,13 +11837,13 @@
2001-12-28 Simon Josefsson <jas@extundo.com>
- * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From
- Jesper Harder <harder@ifa.au.dk>.
+ * gnus-srvr.el (gnus-browse-foreign-server): Fix typo.
+ From Jesper Harder <harder@ifa.au.dk>.
2001-12-27 Simon Josefsson <jas@extundo.com>
- * gnus-sum.el (gnus-select-newsgroup): Make
- `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen'
+ * gnus-sum.el (gnus-select-newsgroup):
+ Make `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen'
contain all articles (instead of none) when no seen marks have
been set for the group.
(gnus-update-marks): Use `gnus-range-add' on a uncompressed list
@@ -11871,8 +11851,8 @@
2001-12-26 11:00:00 Jesper Harder <harder@ifa.au.dk>
- * mm-util.el (mm-iso-8859-x-to-15-region): Use
- insert-before-markers.
+ * mm-util.el (mm-iso-8859-x-to-15-region):
+ Use insert-before-markers.
2001-12-26 Paul Jarc <prj@po.cwru.edu>
@@ -11885,8 +11865,8 @@
2001-12-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-group.el (gnus-group-read-ephemeral-group): Call
- gnus-group-real-name.
+ * gnus-group.el (gnus-group-read-ephemeral-group):
+ Call gnus-group-real-name.
* gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren.
(gnus-newsgroup-variables): Ditto.
@@ -11915,8 +11895,8 @@
* nnimap.el (top-level): Don't require cl. Suggested by ShengHuo
ZHU <zsh@cs.rochester.edu>.
- (nnimap-close-group): Don't quote KEYLIST items. Suggested by
- Brian P Templeton <bpt@tunes.org>.
+ (nnimap-close-group): Don't quote KEYLIST items.
+ Suggested by Brian P Templeton <bpt@tunes.org>.
2001-12-19 17:00:00 Paul Jarc <prj@po.cwru.edu>
@@ -11957,8 +11937,8 @@
* gnus-salt.el (gnus-tree-recenter, gnus-generate-tree)
(gnus-generate-tree, gnus-highlight-selected-tree)
- (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use
- it.
+ (gnus-highlight-selected-tree, gnus-tree-highlight-article):
+ Use it.
* gnus-art.el (gnus-article-set-window-start)
(gnus-mm-display-part, gnus-request-article-this-buffer)
@@ -12015,7 +11995,7 @@
2001-12-13 Josh Huber <huber@alum.wpi.edu>
- * gnus-cus.el (gnus-extra-topic-parameters): Added topic parameter
+ * gnus-cus.el (gnus-extra-topic-parameters): Add topic parameter
subscribe-level
* gnus-topic.el (gnus-subscribe-topics): Use it.
@@ -12121,8 +12101,8 @@
2001-12-07 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnrss.el (nnrss-decode-entities-unibyte-string): Use
- mm-url-decode-entities-nbsp.
+ * nnrss.el (nnrss-decode-entities-unibyte-string):
+ Use mm-url-decode-entities-nbsp.
* nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el:
* webmail.el, nnwfm.el: Use mm-url.
@@ -12142,7 +12122,7 @@
2001-12-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnweb.el (nnweb-replace-in-string): Removed.
+ * nnweb.el (nnweb-replace-in-string): Remove.
* gnus-util.el (gnus-replace-in-string): New function.
(gnus-mode-string-quote): Use it.
@@ -12190,8 +12170,8 @@
2001-12-01 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-sum.el (gnus-summary-save-article): Nix
- gnus-display-mime-function and gnus-article-prepare-hook.
+ * gnus-sum.el (gnus-summary-save-article):
+ Nix gnus-display-mime-function and gnus-article-prepare-hook.
* gnus-spec.el (gnus-parse-complex-format): Properly handle %C at
the beginning of lines.
@@ -12227,8 +12207,8 @@
2001-11-29 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
* message.el (message-newgroups-header-regexp)
- (message-completion-alist, message-tab-body-function): Use
- defcustom rather than defvar.
+ (message-completion-alist, message-tab-body-function):
+ Use defcustom rather than defvar.
(message-tab): Mention `message-tab-body-function' in doc.
Suggested by Karl Eichwalder.
@@ -12263,8 +12243,8 @@
* message.el (message-mode): make-local-hook is harmless in Emacs 21.
- * gnus-msg.el (gnus-configure-posting-styles): Use
- make-local-hook. Add LOCAL for add-hook.
+ * gnus-msg.el (gnus-configure-posting-styles):
+ Use make-local-hook. Add LOCAL for add-hook.
2001-11-27 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -12430,8 +12410,8 @@
2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus-art.el (gnus-article-wash-status-strings): Use
- `copy-sequence', not `copy-seq'.
+ * gnus-art.el (gnus-article-wash-status-strings):
+ Use `copy-sequence', not `copy-seq'.
2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -12446,7 +12426,7 @@
2001-11-12 Simon Josefsson <jas@extundo.com>
* mml1991.el (mml1991-use, mml1991-function-alist): New variables.
- (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from
+ (mml1991-gpg-sign, mml1991-gpg-encrypt): Rename, from
`mml1991-sign' and `mml1991-encrypt'.
(mml1991-encrypt, mml1991-sign): New glue functions.
(mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions.
@@ -12477,8 +12457,8 @@
* message.el (top-level): Autoload sha1.
(message-canlock-generate): Use sha1 instead of md5 (sha1 used by
- canlock, no need to require two different hash algs). Suggested
- by Ferenc Wagner <wferi@bolyai1.elte.hu>.
+ canlock, no need to require two different hash algs).
+ Suggested by Ferenc Wagner <wferi@bolyai1.elte.hu>.
2001-11-09 Pavel Janík <Pavel@Janik.cz>
@@ -12504,13 +12484,13 @@
* sieve-mode.el (sieve-control-commands-face)
(sieve-control-commands-face, sieve-action-commands-face)
- (sieve-test-commands-face, sieve-tagged-arguments-face): New
- faces.
+ (sieve-test-commands-face, sieve-tagged-arguments-face):
+ New faces.
(sieve-font-lock-keywords): Use them.
(sieve-mode): Only set font-lock-defaults in emacs.
- * gnus-art.el (gnus-default-article-saver): Add
- gnus-summary-save-body-in-file.
+ * gnus-art.el (gnus-default-article-saver):
+ Add gnus-summary-save-body-in-file.
(gnus-summary-write-to-file): Fix doc.
2001-11-07 Simon Josefsson <jas@extundo.com>
@@ -12543,7 +12523,7 @@
2001-11-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * many files: Fix copyright lines.
+ * Many files: Fix copyright lines.
2001-11-05 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -12599,7 +12579,7 @@
(nnimap-expunge): Don't use it.
* imap.el (imap-callbacks): New variable.
- (imap-remassoc): Copied from `gnus-remassoc'.
+ (imap-remassoc): Copy from `gnus-remassoc'.
(imap-add-callback): New function.
(imap-mailbox-expunge, imap-mailbox-close): Support asynchronous
behavior.
@@ -12644,8 +12624,8 @@
* smiley-ems.el (smiley-update-cache): Auto detect file type.
- * message.el (message-forward-rmail-make-body): Use
- save-window-excursion.
+ * message.el (message-forward-rmail-make-body):
+ Use save-window-excursion.
(message-encode-message-body): Search with noerror.
(message-setup-1): Convert compose-mail send-actions to
message-send-actions.
@@ -12726,8 +12706,8 @@
(mm-charset-synonym-alist): Remove windows-125[02]. Make other
entries conditional on not having a coding system defined for
them.
- (mm-mule-charset-to-mime-charset): Use
- find-coding-systems-for-charsets if defined.
+ (mm-mule-charset-to-mime-charset):
+ Use find-coding-systems-for-charsets if defined.
(mm-charset-to-coding-system): Don't use
mm-get-coding-system-list. Look in mm-charset-synonym-alist
later. Add last resort search of coding systems.
@@ -12753,8 +12733,8 @@
2001-10-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-spec.el (gnus-parse-simple-format): Use
- buffer-substring-no-properties.
+ * gnus-spec.el (gnus-parse-simple-format):
+ Use buffer-substring-no-properties.
2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -12857,8 +12837,8 @@
2001-10-22 Simon Josefsson <jas@extundo.com>
- * gnus-msg.el (gnus-extended-version): Include
- system-configuration.
+ * gnus-msg.el (gnus-extended-version):
+ Include system-configuration.
Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann).
2001-10-22 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -12871,8 +12851,8 @@
2001-10-21 Simon Josefsson <jas@extundo.com>
* nnimap.el (nnimap): Defgroup.
- (nnimap-strict-function, nnimap-strict-function-match): New
- widget, from Per Abrahamsen <abraham@dina.kvl.dk>.
+ (nnimap-strict-function, nnimap-strict-function-match):
+ New widget, from Per Abrahamsen <abraham@dina.kvl.dk>.
(nnimap-split-crosspost, nnimap-split-inbox)
(nnimap-split-rule, nnimap-split-predicate)
(nnimap-split-predicate): Defcustom.
@@ -12918,9 +12898,9 @@
* message.el (message-do-auto-fill): New version that does not
rely on text properties, by Simon Josefsson <jas@extundo.com>.
- (message-setup-1): Removed the `message-field' property.
+ (message-setup-1): Remove the `message-field' property.
- * gnus-draft.el (gnus-draft-edit-message): Removed the
+ * gnus-draft.el (gnus-draft-edit-message): Remove the
`message-field' property.
2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -12956,8 +12936,8 @@
* message.el (message-check-news-header-syntax): Special case
nnvirtual groups.
- * gnus-sum.el (gnus-summary-respool-default-method): Changed
- customize type to `symbol'.
+ * gnus-sum.el (gnus-summary-respool-default-method):
+ Change customize type to `symbol'.
2001-10-17 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -12979,13 +12959,13 @@
2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus-msg.el (gnus-post-method): Changed two instances of
+ * gnus-msg.el (gnus-post-method): Change two instances of
`active' to `current' and one `null' to `not'.
2001-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
- * message.el (message-setup-fill-variables): Use
- `normal-auto-fill-function' instead of `auto-fill-function'.
+ * message.el (message-setup-fill-variables):
+ Use `normal-auto-fill-function' instead of `auto-fill-function'.
2001-10-16 Simon Josefsson <jas@extundo.com>
@@ -13051,8 +13031,8 @@
2001-10-12 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
Suggested by Oliver Scholz <epameinondas@gmx.de>.
- * message.el (message-do-auto-fill): New function. Like
- `do-auto-fill' but don't fill when in the message header.
+ * message.el (message-do-auto-fill): New function.
+ Like `do-auto-fill' but don't fill when in the message header.
(message-setup-1): Put a text property on the message header.
(message-setup-fill-variables): Use `message-do-auto-fill'.
@@ -13074,8 +13054,8 @@
2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-group.el (gnus-group-name-charset-group-alist): Use
- `find-coding-system' for XEmacs to check whether the coding-system
+ * gnus-group.el (gnus-group-name-charset-group-alist):
+ Use `find-coding-system' for XEmacs to check whether the coding-system
`utf-8' is available.
2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -13085,8 +13065,8 @@
2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
- * message.el (message-send-news): Allow
- `gnus-group-name-charset-group-alist' to affect encoding of the
+ * message.el (message-send-news):
+ Allow `gnus-group-name-charset-group-alist' to affect encoding of the
"Newsgroups" and "Followup-To" headers.
2001-10-07 Per Abrahamsen <abraham@dina.kvl.dk>
@@ -13107,7 +13087,7 @@
default charset for newsgroup names in accordance with USEFOR.
* gnus-group.el (gnus-group-name-charset-method-alist,
- gnus-group-name-charset-group-alist): Removed "*" from doc
+ gnus-group-name-charset-group-alist): Remove "*" from doc
strings, "*" should not be used for complex variables.
2001-10-06 Simon Josefsson <jas@extundo.com>
@@ -13121,18 +13101,18 @@
`gnus-article-decode-hook's except `article-decode-charset'
instead of hardcoding call to one of them.
- * gnus-art.el (gnus-article-decode-hook): Add
- `article-decode-group-name'.
+ * gnus-art.el (gnus-article-decode-hook):
+ Add `article-decode-group-name'.
(article-decode-group-name): New function, use `g-d-n'.
- * gnus-group.el (gnus-group-insert-group-line): Decode
- gnus-tmp-group using `g-d-n'.
+ * gnus-group.el (gnus-group-insert-group-line):
+ Decode gnus-tmp-group using `g-d-n'.
* gnus-util.el (gnus-decode-newsgroups): New function.
2001-10-06 Per Abrahamsen <abraham@dina.kvl.dk>
- * gnus-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil
+ * gnus-srvr.el (gnus-browse-foreign-server): Fix bug non-nil
`gnus-group-name-charset-group-alist'.
2001-10-05 Simon Josefsson <jas@extundo.com>
@@ -13294,8 +13274,8 @@
2001-09-19 Sam Steingold <sds@gnu.org>
- * gnus-win.el (gnus-buffer-configuration): Respect
- `gnus-bug-create-help-buffer'.
+ * gnus-win.el (gnus-buffer-configuration):
+ Respect `gnus-bug-create-help-buffer'.
2001-09-18 Simon Josefsson <jas@extundo.com>
@@ -13349,7 +13329,7 @@
2001-09-14 Simon Josefsson <jas@extundo.com>
- * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group
+ * gnus-start.el (gnus-group-mode-hook): Move from gnus-group
(otherwise e.g. gnus-agentize in .gnus overrides the customized
default before gnus-group is loaded and the variable set.)
@@ -13380,11 +13360,11 @@
* nndiary.el (nndiary-request-accept-article-hooks): New.
* nndiary.el (nndiary-request-accept-article): Use it, check
message validity.
- * nndiary.el (nndiary-get-new-mail): Changed default to nil.
+ * nndiary.el (nndiary-get-new-mail): Change default to nil.
* nndiary.el (nndiary-schedule): Fix bug (misplaced
condition-case): it didn't return nil on error.
* gnus-diary.el: New version.
- * gnus-diary.el (gnus-diary-summary-line-format): Removed %I.
+ * gnus-diary.el (gnus-diary-summary-line-format): Remove %I.
* gnus-diary.el (gnus-diary-header-value-history): New.
* gnus-diary.el (gnus-diary-narrow-to-headers): New.
* gnus-diary.el (gnus-diary-add-header): New.
@@ -13394,11 +13374,11 @@
2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
- * gnus-sum.el (gnus-select-newsgroup): Make
- `gnus-current-select-method' buffer-local.
+ * gnus-sum.el (gnus-select-newsgroup):
+ Make `gnus-current-select-method' buffer-local.
- * gnus-art.el (gnus-request-article-this-buffer): Refer
- `gnus-current-select-method' in the current summary buffer.
+ * gnus-art.el (gnus-request-article-this-buffer):
+ Refer `gnus-current-select-method' in the current summary buffer.
2001-09-10 Daniel Pittman <daniel@rimspace.net>
@@ -13406,10 +13386,10 @@
2001-09-09 Simon Josefsson <jas@extundo.com>
- * mm-decode.el (mm-inline-media-tests): Add
- application/x-emacs-lisp.
- (mm-attachment-override-types): Add
- application/{x-,}pkcs7-signature.
+ * mm-decode.el (mm-inline-media-tests):
+ Add application/x-emacs-lisp.
+ (mm-attachment-override-types):
+ Add application/{x-,}pkcs7-signature.
* gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook)
(gnus-server-line-format, gnus-server-mode-line-format)
@@ -13442,8 +13422,8 @@
(nnml-request-update-info): Don't update if marks didn't change.
* gnus-agent.el (gnus-agent-any-covered-gcc)
- (gnus-agent-add-server, gnus-agent-remove-server): Use
- gnus-agent-method-p.
+ (gnus-agent-add-server, gnus-agent-remove-server):
+ Use gnus-agent-method-p.
* gnus-art.el (gnus-buttonized-mime-types): New variable.
(gnus-unbuttonized-mime-type-p): Use it.
@@ -13645,8 +13625,8 @@
* gnus-spec.el (gnus-compile): Don't compile gnus-version.
- * gnus-group.el (gnus-update-group-mark-positions): Bind
- gnus-group-update-hook to nil.
+ * gnus-group.el (gnus-update-group-mark-positions):
+ Bind gnus-group-update-hook to nil.
2001-08-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -13666,8 +13646,8 @@
2001-08-24 Simon Josefsson <jas@extundo.com>
- * gnus-group.el (gnus-info-clear-data): Call
- nnfoo-request-set-mark to propagate marks. Fix bug:
+ * gnus-group.el (gnus-info-clear-data):
+ Call nnfoo-request-set-mark to propagate marks. Fix bug:
`gnus-group-update-line' doesn't update read range unless we call
`gnus-get-unread-articles-in-group' first.
@@ -13743,8 +13723,8 @@
2001-08-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace
- nnslashdot-*-retrieve-headers.
+ * nnslashdot.el (nnslashdot-retrieve-headers-1):
+ Replace nnslashdot-*-retrieve-headers.
(nnslashdot-request-article): Fix for slashcode 2.2.
(nnslashdot-make-tuple): New function.
(nnslashdot-read-groups): Use it.
@@ -13786,15 +13766,15 @@
* mm-view.el (mm-inline-text): Ignore vcard errors.
- * gnus-art.el (gnus-ignored-headers): Added more junk headers.
+ * gnus-art.el (gnus-ignored-headers): Add more junk headers.
* gnus-score.el (gnus-all-score-files): Use append instead of
nconc.
* gnus.el (gnus-splash-face): Doc fix.
- * mm-decode.el (mm-mailcap-command): Use
- mm-path-name-rewrite-functions.
+ * mm-decode.el (mm-mailcap-command):
+ Use mm-path-name-rewrite-functions.
(mm-path-name-rewrite-functions): New variable.
* gnus-spec.el (gnus-parse-complex-format): React to ?=.
@@ -13808,10 +13788,10 @@
the positional spec.
(gnus-parse-complex-format): React to %C.
- * gnus-ems.el (gnus-char-width): Moved here.
+ * gnus-ems.el (gnus-char-width): Move here.
- * gnus-sum.el (gnus-select-newsgroup): Set
- gnus-newsgroup-articles.
+ * gnus-sum.el (gnus-select-newsgroup):
+ Set gnus-newsgroup-articles.
(gnus-unseen-mark): New variable.
(gnus-newsgroup-unseen): Ditto.
(gnus-newsgroup-seen): Ditto.
@@ -13869,15 +13849,15 @@
2001-08-18 Simon Josefsson <jas@extundo.com>
- * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from
+ * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Move from
nnimap.
- * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to
+ * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Move to
gnus-util.
(nnimap-request-update-info-internal): Use new functions.
- * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use
- new functions.
+ * nnml.el (nnml-request-set-mark, nnml-request-update-info):
+ Use new functions.
2001-08-18 Simon Josefsson <jas@extundo.com>
@@ -13974,7 +13954,7 @@
* gnus-start.el (gnus-setup-news): Push the archive server only
the server list.
- * mml.el (mml-menu): Changed name to "Attachments".
+ * mml.el (mml-menu): Change name to "Attachments".
* mm-decode.el (mm-destroy-postponed-undisplay-list): Only message
when there is something to destroy.
@@ -14010,8 +13990,8 @@
`nnmail-split-history' if recent is > 0.
(nnimap-request-update-info-internal): Update `recent' marks.
(nnimap-request-set-mark): Never set `recent' marks.
- (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add
- recent.
+ (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist):
+ Add recent.
* gnus-sum.el (gnus-recent-mark): New mark.
(gnus-newsgroup-recent): New variable.
@@ -14024,8 +14004,8 @@
2001-08-12 Simon Josefsson <jas@extundo.com>
- * mm-bodies.el (mm-decode-content-transfer-encoding): Returns
- whether successful decoding took place. Add doc.
+ * mm-bodies.el (mm-decode-content-transfer-encoding):
+ Returns whether successful decoding took place. Add doc.
2001-08-12 Simon Josefsson <jas@extundo.com>
Suggested by Per Abrahamsen <abraham@dina.kvl.dk>
@@ -14062,8 +14042,8 @@
2001-08-10 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use
- gnus-group-find-parameter. Suggested by Janne Rinta-Manty
+ * gnus-ml.el (turn-on-gnus-mailing-list-mode):
+ Use gnus-group-find-parameter. Suggested by Janne Rinta-Manty
<rintaman@cs.Helsinki.FI>.
* mail-source.el (mail-source-movemail): The error buffer is
@@ -14076,8 +14056,8 @@
2001-08-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nndraft.el (nndraft-request-group): Use
- nndraft-auto-save-file-name.
+ * nndraft.el (nndraft-request-group):
+ Use nndraft-auto-save-file-name.
2001-08-09 Simon Josefsson <jas@extundo.com>
@@ -14102,8 +14082,8 @@
2001-08-09 Simon Josefsson <jas@extundo.com>
- * message.el (message-get-reply-headers): Fix string. Suggested by
- Christoph Conrad <cc@cli.de>.
+ * message.el (message-get-reply-headers): Fix string.
+ Suggested by Christoph Conrad <cc@cli.de>.
2001-08-08 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -14118,8 +14098,8 @@
2001-08-04 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
- * gnus-sum.el (gnus-summary-show-article): Call
- gnus-summary-update-secondary-secondary-mark.
+ * gnus-sum.el (gnus-summary-show-article):
+ Call gnus-summary-update-secondary-secondary-mark.
* gnus-sum.el (gnus-summary-edit-article-done): Ditto.
* gnus-sum.el (gnus-summary-reparent-thread): Ditto.
@@ -14142,8 +14122,8 @@
2001-08-06 Florian Weimer <fw@deneb.enyo.de>
- * message.el (message-indent-citation): Use
- `message-yank-cited-prefix' for empty lines.
+ * message.el (message-indent-citation):
+ Use `message-yank-cited-prefix' for empty lines.
2001-08-05 Florian Weimer <fw@deneb.enyo.de>
@@ -14152,8 +14132,8 @@
2001-08-05 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com> (tiny change)
- * gnus-cache.el (gnus-cache-possibly-enter-article): Use
- gnus-cache-fully-p.
+ * gnus-cache.el (gnus-cache-possibly-enter-article):
+ Use gnus-cache-fully-p.
2001-08-04 Simon Josefsson <jas@extundo.com>
@@ -14163,7 +14143,7 @@
2001-08-04 Simon Josefsson <jas@extundo.com>
* gnus-cache.el (gnus-cache-possibly-enter-article): Revert.
- (gnus-cache-passively-or-fully-p): Removed.
+ (gnus-cache-passively-or-fully-p): Remove.
(gnus-cache-fully-p): Fix it.
* mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths.
@@ -14191,8 +14171,8 @@
2001-08-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert
- before remove.
+ * gnus-art.el (gnus-mime-security-verify-or-decrypt):
+ Insert before remove.
(gnus-mime-security-show-details): Ditto.
2001-08-04 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -14239,7 +14219,7 @@
2001-08-02 Simon Josefsson <jas@extundo.com>
- * smime.el (smime-extra-arguments): Removed.
+ * smime.el (smime-extra-arguments): Remove.
(smime-call-openssl-region): Don't use it.
2001-08-02 Simon Josefsson <jas@extundo.com>
@@ -14247,8 +14227,8 @@
* smime.el (smime-sign-region): Handle stderr.
(smime-encrypt-region): Ditto.
- * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't
- match the ASN.1 length bytes.
+ * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp.
+ Don't match the ASN.1 length bytes.
(mm-pkcs7-enveloped-magic): Ditto.
(mm-view-pkcs7-get-type): Don't regexp quote.
@@ -14316,8 +14296,8 @@
* smime.el (smime-call-openssl-region): Revert previous change,
just pass on buf to `call-process-region'.
- (smime-verify-region): Doc fix. Don't message stuff. Use
- `smime-new-details-buffer'. Inserts error messages into buffer.
+ (smime-verify-region): Doc fix. Don't message stuff.
+ Use `smime-new-details-buffer'. Inserts error messages into buffer.
(smime-noverify-region): Ditto.
(smime-decrypt-region): Ditto. Handles stderr separately.
(smime-verify-buffer, smime-noverify-buffer)
@@ -14332,8 +14312,8 @@
2001-07-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (gnus-mime-save-part-and-strip): Save
- gnus-article-mime-handles.
+ * gnus-art.el (gnus-mime-save-part-and-strip):
+ Save gnus-article-mime-handles.
2001-07-29 Simon Josefsson <jas@extundo.com>
@@ -14391,8 +14371,8 @@
* gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*'
for %B spec.
- * gnus-sum.el (gnus-summary-prepare-threads): If
- gnus-sum-thread-tree-root is nil, use subject instead.
+ * gnus-sum.el (gnus-summary-prepare-threads):
+ If gnus-sum-thread-tree-root is nil, use subject instead.
(gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent)
(gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
(gnus-sum-thread-tree-leaf-with-other)
@@ -14418,16 +14398,16 @@
2001-07-27 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnfolder.el (nnfolder-request-accept-article): Bind
- nntp-server-buffer.
+ * nnfolder.el (nnfolder-request-accept-article):
+ Bind nntp-server-buffer.
* nnmail.el (nnmail-parse-active): Read from buffer instead of
nntp-server-buffer.
2001-07-27 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * message.el (message-check-news-header-syntax): Use
- message-post-method.
+ * message.el (message-check-news-header-syntax):
+ Use message-post-method.
(message-send-news): Bind message-post-method.
2001-07-27 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -14439,8 +14419,8 @@
2001-07-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnfolder.el (nnfolder-request-accept-article): Replace
- nnfolder-request-list.
+ * nnfolder.el (nnfolder-request-accept-article):
+ Replace nnfolder-request-list.
2001-07-27 Simon Josefsson <jas@extundo.com>
@@ -14455,8 +14435,8 @@
* gnus-art.el (gnus-mm-display-part): Narrow to point if eobp.
- * message.el (message-set-auto-save-file-name): More
- poor-system-types.
+ * message.el (message-set-auto-save-file-name):
+ More poor-system-types.
* mailcap.el (mailcap-parse-mimetypes): poor-system-types.
@@ -14500,8 +14480,8 @@
2001-07-25 22:22:22 Raymond Scholz <rscholz@zonix.de>
- * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New
- variable.
+ * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups):
+ New variable.
(nnmail-split-fancy-with-parent): Ignore certain groups.
2001-07-25 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -14585,8 +14565,8 @@
2001-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
- * gnus-start.el (gnus-setup-news): Call
- `gnus-check-bogus-newsgroups' just after the native server is
+ * gnus-start.el (gnus-setup-news):
+ Call `gnus-check-bogus-newsgroups' just after the native server is
opened.
2001-07-23 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -14625,8 +14605,8 @@
* mm-util.el (mm-read-coding-system): Take two arguments.
- * gnus-sum.el (gnus-summary-show-article): Use
- mm-read-coding-system.
+ * gnus-sum.el (gnus-summary-show-article):
+ Use mm-read-coding-system.
* gnus-art.el (article-de-quoted-unreadable):
(article-de-base64-unreadable, article-wash-html):
@@ -14642,8 +14622,8 @@
* nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS
command.
- * gnus-start.el (gnus-find-new-newsgroups): Use
- `message-make-date' instead of `current-time-string'.
+ * gnus-start.el (gnus-find-new-newsgroups):
+ Use `message-make-date' instead of `current-time-string'.
(gnus-ask-server-for-new-groups): Ditto.
(gnus-check-first-time-used): Ditto.
@@ -14703,6 +14683,15 @@
* gnus-art.el, ...: Error convention changes.
+ * binhex.el, earcon.el, gnus-agent.el, gnus-art.el, gnus-audio.el:
+ * gnus-logic.el, gnus-ml.el, gnus-mlspl.el, gnus-setup.el:
+ * gnus-srvr.el, gnus-sum.el, gnus-uu.el, gnus-vm.el, ietf-drums.el:
+ * mail-parse.el, mail-prsvr.el, mail-source.el, mm-bodies.el:
+ * mm-decode.el, mm-encode.el, mm-partial.el, mm-util.el, mm-uu.el:
+ * mm-view.el, mml.el, nnimap.el, nnoo.el, parse-time.el, rfc1843.el:
+ * rfc2045.el, rfc2047.el, rfc2104.el, rfc2231.el, time-date.el:
+ * uudecode.el: Some fixes to follow coding conventions.
+
2001-07-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el (gnus-rebuild-thread): Count hidden lines too.
@@ -14759,7 +14748,7 @@
2001-07-12 Björn Torkelsson <torkel@hpc2n.umu.se>
- * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the
+ * gnus-srvr.el (gnus-browse-make-menu-bar): Change one of the
Browse->Next entries to Browse->Prev.
2001-07-11 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -15080,8 +15069,8 @@
2001-06-15 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (article-strip-multiple-blank-lines): Use
- delete-region instead of replace-match.
+ * gnus-art.el (article-strip-multiple-blank-lines):
+ Use delete-region instead of replace-match.
2001-06-14 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -15162,8 +15151,8 @@
2001-06-05 Alex Schroeder <alex@gnu.org>
- * mm-decode.el (mm-handle-set-external-undisplayer): Don't
- generate compiler warnings.
+ * mm-decode.el (mm-handle-set-external-undisplayer):
+ Don't generate compiler warnings.
2001-06-04 Hrvoje Niksic <hniksic@arsdigita.com>
@@ -15348,7 +15337,7 @@
2001-04-25 Per Abrahamsen <abraham@dina.kvl.dk>
- * mm-uu.el (mm-uu-configure-list): Fixed customize type.
+ * mm-uu.el (mm-uu-configure-list): Fix customize type.
2001-04-24 Hrvoje Niksic <hniksic@arsdigita.com>
@@ -15418,7 +15407,7 @@
2001-04-02 Nevin Kapur <nevin@jhu.edu>
- * nnmail.el (nnmail-split-it): Added check for .* at the end of
+ * nnmail.el (nnmail-split-it): Add check for .* at the end of
regexp in nnmail-split-fancy.
2001-04-10 Simon Josefsson <simon@josefsson.org>
@@ -15547,8 +15536,8 @@
2001-03-31 00:03:42 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow
- lists of articles.
+ * gnus-msg.el (gnus-inews-insert-draft-meta-information):
+ Allow lists of articles.
* gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded.
@@ -15565,7 +15554,7 @@
forwarded.
(gnus-summary-mail-forward): Clean up.
- * gnus.el (gnus-article-mark-lists): Added forward.
+ * gnus.el (gnus-article-mark-lists): Add forward.
* gnus-sum.el (gnus-forwarded-mark): New variable.
(gnus-summary-prepare-threads): Use it.
@@ -15595,14 +15584,14 @@
2001-03-15 09:47:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nnultimate.el (nnultimate-retrieve-headers): Understand
- long-form month names.
+ * nnultimate.el (nnultimate-retrieve-headers):
+ Understand long-form month names.
2001-03-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el (gnus-summary-show-all-headers):
- gnus-article-show-all-headers is broken. Use
- gnus-summary-toggle-header instead.
+ gnus-article-show-all-headers is broken.
+ Use gnus-summary-toggle-header instead.
* mml2015.el (mml2015-gpg-extract-from): No error.
@@ -15614,8 +15603,8 @@
2001-03-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * message.el (message-setup-fill-variables): Use
- fill-paragraph-function.
+ * message.el (message-setup-fill-variables):
+ Use fill-paragraph-function.
(message-fill-paragraph): Take an argument.
(message-newline-and-reformat): Take another argument.
@@ -15630,7 +15619,7 @@
2001-03-16 Simon Josefsson <simon@josefsson.org>
- * nnimap.el (nnimap-dont-use-nov-p): Renamed from
+ * nnimap.el (nnimap-dont-use-nov-p): Rename from
`nnimap-use-nov-p' (it really tested the negative).
(nnimap-retrieve-headers): Use it.
@@ -15663,16 +15652,16 @@
* mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el:
Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100).
-;;Has been fixed -- zsh.
-;;2001-03-05 Dave Love <fx@gnu.org>
-;;
-;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case.
-;; Move it after definition of mm-coding-system-p.
-;;
+ ;;Has been fixed -- zsh.
+ ;;2001-03-05 Dave Love <fx@gnu.org>
+ ;;
+ ;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case.
+ ;; Move it after definition of mm-coding-system-p.
+ ;;
2001-03-01 Dave Love <fx@gnu.org>
- * mm-util.el (mm-inhibit-file-name-handlers): Add
- image-file-handler.
+ * mm-util.el (mm-inhibit-file-name-handlers):
+ Add image-file-handler.
2001-02-11 Dave Love <fx@gnu.org>
@@ -15706,8 +15695,8 @@
* gnus-score.el (gnus-score-find-bnews): Print messages on illegal
SCORE paths.
- * mm-decode.el (mm-dissect-buffer): Call
- mail-extract-address-components only if necessary.
+ * mm-decode.el (mm-dissect-buffer):
+ Call mail-extract-address-components only if necessary.
2001-03-06 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -15717,8 +15706,8 @@
2001-03-06 13:00:00 Adrian Aichner <adrian@xemacs.org>
- * gnus-score.el (gnus-score-score-files-1): Use
- gnus-kill-files-directory.
+ * gnus-score.el (gnus-score-score-files-1):
+ Use gnus-kill-files-directory.
2001-03-05 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -15728,8 +15717,8 @@
* mml.el (mml-preview): Disable local map.
- * gnus-sum.el (gnus-summary-make-menu-bar): Make
- gnus-article-post-menu here.
+ * gnus-sum.el (gnus-summary-make-menu-bar):
+ Make gnus-article-post-menu here.
* gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar
if it has not been made.
@@ -15826,8 +15815,8 @@
* smiley.el (gnus-smiley-display): Don't do widening.
- * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley
- within body.
+ * smiley-ems.el (gnus-smiley-display): Don't do widening.
+ Smiley within body.
* gnus-msg.el (gnus-inews-do-gcc): Activate group anyway.
@@ -15913,7 +15902,7 @@
2001-02-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus.el (gnus-define-group-parameter): Improved.
+ * gnus.el (gnus-define-group-parameter): Improve.
* gnus-sum.el (charset): Define parameter.
(ignored-charsets): Ditto.
@@ -15929,8 +15918,8 @@
2001-02-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-sum.el (gnus-summary-read-group-1): Remove
- gnus-summary-set-local-parameters.
+ * gnus-sum.el (gnus-summary-read-group-1):
+ Remove gnus-summary-set-local-parameters.
(gnus-summary-setup-buffer): Put it here.
2001-02-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -15982,8 +15971,8 @@
(article-remove-leading-whitespace): New function.
(gnus-article-make-menu-bar): Use it.
- * gnus-sum.el (gnus-summary-wash-empty-map): Add
- remove-leading-whitespace.
+ * gnus-sum.el (gnus-summary-wash-empty-map):
+ Add remove-leading-whitespace.
(gnus-summary-wash-map): Bind strip-headers-in-body to `W a',
because of conflict.
@@ -16014,13 +16003,13 @@
2001-02-08 Tommi Vainikainen <thv@iki.fi> (tiny change)
- * gnus-sum.el (gnus-simplify-subject-re): Use
- message-subject-re-regexp.
+ * gnus-sum.el (gnus-simplify-subject-re):
+ Use message-subject-re-regexp.
2001-02-08 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * nnmail.el (nnmail-expiry-target-group): Bind
- nnmail-cache-accepted-message-ids to nil.
+ * nnmail.el (nnmail-expiry-target-group):
+ Bind nnmail-cache-accepted-message-ids to nil.
* gnus-xmas.el (gnus-xmas-article-display-xface): Use binary
coding system.
@@ -16074,34 +16063,34 @@
2001-02-06 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-xmas.el (gnus-xmas-article-menu-add): Add
- gnus-article-commands-menu.
+ * gnus-xmas.el (gnus-xmas-article-menu-add):
+ Add gnus-article-commands-menu.
* gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar
in Emacs.
- * gnus-start.el (gnus-read-descriptions-file): Use
- gnus-group-name-charset and gnus-group-charset-alist.
+ * gnus-start.el (gnus-read-descriptions-file):
+ Use gnus-group-name-charset and gnus-group-charset-alist.
2001-02-04 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-sum.el (gnus-summary-mark-as-processable): Understand
- active region.
+ * gnus-sum.el (gnus-summary-mark-as-processable):
+ Understand active region.
* gnus-start.el (gnus-group-change-level): Remove from both
gnus-zombie-list and gnus-killed-list.
2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add
- gnus-subscribe-topics.
+ * gnus-start.el (gnus-subscribe-options-newsgroup-method):
+ Add gnus-subscribe-topics.
* gnus-cus.el (gnus-extra-topic-parameters): Fix doc.
2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (gnus-article-make-menu-bar): Make
- gnus-article-post-menu.
+ * gnus-art.el (gnus-article-make-menu-bar):
+ Make gnus-article-post-menu.
* gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu.
@@ -16133,16 +16122,16 @@
2001-01-31 Dave Love <fx@gnu.org>
* gnus-art.el (gnus-article-x-face-command)
- (gnus-treat-display-xface, gnus-treat-display-smileys): Add
- :version.
+ (gnus-treat-display-xface, gnus-treat-display-smileys):
+ Add :version.
2001-01-26 Dave Love <fx@gnu.org>
* mm-util.el (mm-multibyte-string-p): New.
-;; * qp.el: Remove un-logged bogus changes from 2000-12-20.
-;; (quoted-printable-encode-region): Doc fix. Don't call
-;; string-as-multibyte on class. Clarify line-folding.
+ ;; * qp.el: Remove un-logged bogus changes from 2000-12-20.
+ ;; (quoted-printable-encode-region): Doc fix. Don't call
+ ;; string-as-multibyte on class. Clarify line-folding.
(quoted-printable-encode-string): Make temp buffer inherit
string's multibyteness.
@@ -16172,7 +16161,7 @@
2001-01-31 Karl Kleinpaste <karl@charcoal.com>
- * nnmail.el (nnmail-remove-list-identifiers): Improved.
+ * nnmail.el (nnmail-remove-list-identifiers): Improve.
2001-01-31 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -16319,8 +16308,8 @@
2001-01-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * message.el (message-yank-original): Understand
- universal-argument.
+ * message.el (message-yank-original):
+ Understand universal-argument.
2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -16351,8 +16340,8 @@
2001-01-15 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (article-display-x-face): Use
- gnus-original-article-buffer.
+ * gnus-art.el (article-display-x-face):
+ Use gnus-original-article-buffer.
2001-01-15 Jack Twilley <jmt@tbe.net>
@@ -16410,8 +16399,8 @@
(message-make-forward-subject-function)
(message-send-mail-function, message-reply-to-function)
(message-wide-reply-to-function, message-followup-to-function)
- (message-distribution-function, message-auto-save-directory): Fix
- :type.
+ (message-distribution-function, message-auto-save-directory):
+ Fix :type.
* mml.el (mml-parse-1): Frob mml-confirmation-set when
proceeding after warnings. Amend multipart warning message.
@@ -16422,8 +16411,8 @@
compiling.
(gnus-make-directory): Require nnmail.
- * mm-decode.el (mm-inline-media-tests): Add
- image/x-portable-bitmap.
+ * mm-decode.el (mm-inline-media-tests):
+ Add image/x-portable-bitmap.
(mm-get-image): Grok pbm.
2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk>
@@ -16576,8 +16565,8 @@
2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * gnus-sum.el (gnus-summary-limit-include-expunged): Really
- include the expunged articles.
+ * gnus-sum.el (gnus-summary-limit-include-expunged):
+ Really include the expunged articles.
* gnus-group.el (gnus-group-sort-by-server): New function.
@@ -16597,7 +16586,7 @@
* gnus-cite.el (gnus-article-fill-cited-article): Add a space
after the fill prefix.
- * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter
+ * gnus-sum.el (gnus-summary-make-menu-bar): Remove "Enter
score...".
* gnus-art.el (gnus-ignored-headers): Hide more headers.
@@ -16614,12 +16603,12 @@
2000-12-29 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * mm-util.el (mm-enable-multibyte): Use
- default-enable-multibyte-characters.
+ * mm-util.el (mm-enable-multibyte):
+ Use default-enable-multibyte-characters.
(mm-enable-multibyte-mule4): Ditto.
(mm-disable-multibyte): Test XEmacs.
(mm-disable-multibyte-mule4): Ditto.
- (mm-with-unibyte-current-buffer): Simplified.
+ (mm-with-unibyte-current-buffer): Simplify.
(mm-with-unibyte-current-buffer-mule4): Ditto.
2000-12-28 19:44:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -16674,8 +16663,8 @@
2000-12-24 Simon Josefsson <sj@extundo.com>
- * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve
- mailing list junk at end of part.
+ * mm-bodies.el (mm-decode-content-transfer-encoding):
+ Preserve mailing list junk at end of part.
2000-12-23 Simon Josefsson <sj@extundo.com>
@@ -16770,7 +16759,7 @@
* mml.el (gnus-ems): Don't require.
- * gnus.el (gnus-decode-rfc1522): Removed.
+ * gnus.el (gnus-decode-rfc1522): Remove.
(gnus-set-text-properties): Define.
2000-12-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -16793,8 +16782,8 @@
2000-12-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* message.el (message-mail-user-agent): New variable.
- (message-setup): Renamed to message-setup-1. Support
- mail-user-agent.
+ (message-setup): Rename to message-setup-1.
+ Support mail-user-agent.
(message-mail-user-agent): New function.
(message-mail): Use it.
(message-reply): Use it.
@@ -16847,8 +16836,8 @@
2000-12-20 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * mm-decode.el (mm-possibly-verify-or-decrypt): Use
- mail-extract-a-c instead. Don't depend on Gnus.
+ * mm-decode.el (mm-possibly-verify-or-decrypt):
+ Use mail-extract-a-c instead. Don't depend on Gnus.
* mml.el (gnus-ems): Require it.
@@ -16961,11 +16950,11 @@
2000-11-30 Dave Love <fx@gnu.org>
- * message.el (message-auto-save-directory): Use
- file-name-as-directory.
- (message-set-auto-save-file-name): Create
- message-auto-save-directory if necessary.
- (message-replace-chars-in-string): Removed -- unused.
+ * message.el (message-auto-save-directory):
+ Use file-name-as-directory.
+ (message-set-auto-save-file-name):
+ Create message-auto-save-directory if necessary.
+ (message-replace-chars-in-string): Remove -- unused.
(message-mail-alias-type): Customize.
(message-headers): Remove duplicate defgroup.
@@ -16983,17 +16972,17 @@
* nnlistserv.el: Ignore errors when requiring nnweb and avoid a
compiler warning.
-;2000-11-26 Dave Love <fx@gnu.org>
-;
-; * mm-uu.el (mm-uu-configure-list): Fix typo in :type.
-;
+ ;2000-11-26 Dave Love <fx@gnu.org>
+ ;
+ ; * mm-uu.el (mm-uu-configure-list): Fix typo in :type.
+ ;
2000-11-23 Dave Love <fx@gnu.org>
* uu-post.pbm, uu-decode.pbm: New files from XPMs.
* mm-uu.el (uudecode): Require.
- (uudecode-decode-region, uudecode-decode-region-external): Don't
- autoload.
+ (uudecode-decode-region, uudecode-decode-region-external):
+ Don't autoload.
(mm-uu-copy-to-buffer): Doc fix.
(mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom
type fix.
@@ -17003,7 +16992,7 @@
(mailcap): New group.
(mailcap-download-directory): Customize.
(mailcap-generate-unique-filename, mailcap-binary-suffixes)
- (mailcap-temporary-directory): Deleted (unused).
+ (mailcap-temporary-directory): Delete (unused).
(mailcap-unescape-mime-test): Simplify slightly.
(mailcap-viewer-passes-test): Use functionp.
(mailcap-command-p): Aliased to executable-find.
@@ -17019,7 +17008,7 @@
* gnus-art.el (gnus-mime-button-map): Don't inherit from
gnus-article-mode-map.
-; (gnus-mime-button-menu): Use mouse-set-point.
+ ; (gnus-mime-button-menu): Use mouse-set-point.
(gnus-insert-mime-button, gnus-mime-display-alternative)
(gnus-mime-display-alternative): Don't use local-map property.
@@ -17041,11 +17030,11 @@
* gnus-agent.el (gnus-agent-confirmation-function): Add :version.
(gnus-agent-lib-file, gnus-agent-load-alist)
- (gnus-agent-save-alist, gnus-agent-article-name): Use
- expand-file-name.
+ (gnus-agent-save-alist, gnus-agent-article-name):
+ Use expand-file-name.
- * gnus-group.el (gnus-group-name-charset-method-alist): Add
- :version.
+ * gnus-group.el (gnus-group-name-charset-method-alist):
+ Add :version.
(nnkiboze-score-file): Defvar when compiling.
* gnus-start.el (gnus-read-newsrc-file): Add :version.
@@ -17077,15 +17066,15 @@
* gnus-cache.el (gnus-cache-active-file): Don't use
file-name-as-directory on directory.
- (gnus-cache-file-name): Use expand-file-name, not concat. Don't
- use file-name-as-directory on directory.
+ (gnus-cache-file-name): Use expand-file-name, not concat.
+ Don't use file-name-as-directory on directory.
* time-date.el (timezone-make-date-arpa-standard): Autoload.
(date-to-time): Use it.
-; * message.el (message-mode) <adaptive-fill-regexp>:
-; <adaptive-fill-first-line-regexp>: Use [:alnum:] in regexp range.
-; (message-newline-and-reformat): Likewise.
+ ; * message.el (message-mode) <adaptive-fill-regexp>:
+ ; <adaptive-fill-first-line-regexp>: Use [:alnum:] in regexp range.
+ ; (message-newline-and-reformat): Likewise.
(message-forward-as-mime, message-forward-ignored-headers)
(message-buffer-naming-style, message-default-charset)
(message-dont-reply-to-names, message-send-mail-partially-limit):
@@ -17100,7 +17089,7 @@
* gnus-int.el (gnus-start-news-server): Use expand-file-name, not
concat.
- * pop3.el (pop3-version): Deleted.
+ * pop3.el (pop3-version): Delete.
(pop3-make-date): New function, avoiding message-make-date.
(pop3-munge-message-separator): Use it.
@@ -17116,12 +17105,12 @@
* message.el (tool-bar-map): Defvar when compiling.
* gnus-setup.el (running-xemacs, gnus-use-installed-tm)
- (gnus-tm-lisp-directory): Deleted.
- (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use
- (featurep 'xemacs).
+ (gnus-tm-lisp-directory): Delete.
+ (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory):
+ Use (featurep 'xemacs).
(gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory)
- (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove
- version numbers from file names.
+ (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory):
+ Remove version numbers from file names.
2000-11-08 Dave Love <fx@gnu.org>
@@ -17190,16 +17179,16 @@
(uudecode-char-int): New alias, replacing char-int.
(uudecode-decode-region): Don't call buffer-disable-undo.
-; * mm-uu.el (mm-uu-configure): Unquote lambda.
-; (mm-uu-configure-list): Doc fix.
-;
-; * earcon.el (running-xemacs): Don't define.
-;
-;2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
-;
-; * message.el (message-font-lock-keywords): Match a final newline
-; to help font-lock's multiline support.
-;
+ ; * mm-uu.el (mm-uu-configure): Unquote lambda.
+ ; (mm-uu-configure-list): Doc fix.
+ ;
+ ; * earcon.el (running-xemacs): Don't define.
+ ;
+ ;2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
+ ;
+ ; * message.el (message-font-lock-keywords): Match a final newline
+ ; to help font-lock's multiline support.
+ ;
2000-11-03 Dave Love <fx@gnu.org>
* gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500.
@@ -17213,17 +17202,17 @@
* mm-decode.el (mm-display-external): Space-prefix temp buffer
name. Don't disable undo explicitly.
-;2000-11-02 Dave Love <fx@gnu.org>
-;
-; * message.el (message-font-lock-keywords): Use [:alpha:] for
-; cite-prefix.
+ ;2000-11-02 Dave Love <fx@gnu.org>
+ ;
+ ; * message.el (message-font-lock-keywords): Use [:alpha:] for
+ ; cite-prefix.
2000-11-01 Dave Love <fx@gnu.org>
* rfc2047.el (base64): Require unconditionally.
(message-posting-charset): Defvar when compiling.
- (rfc2047-encode-message-header, rfc2047-encodable-p): Require
- message.
+ (rfc2047-encode-message-header, rfc2047-encodable-p):
+ Require message.
* gnus-sum.el (nnoo): Require.
(mm-uu-dissect): Autoload.
@@ -17320,8 +17309,8 @@
2000-10-09 Dave Love <fx@gnu.org>
- * mail-source.el (mail-source-fetch-imap): Bind
- default-enable-multibyte-characters rather than using
+ * mail-source.el (mail-source-fetch-imap):
+ Bind default-enable-multibyte-characters rather than using
mm-disable-multibyte.
2000-10-05 Dave Love <fx@gnu.org>
@@ -17358,8 +17347,8 @@
2000-10-04 Dave Love <fx@gnu.org>
- * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use
- pbm images.
+ * smiley-ems.el (smiley-regexp-alist, smiley-update-cache):
+ Use pbm images.
* frown.pbm, smile.pbm, wry.pbm: New files.
@@ -17454,7 +17443,7 @@
2000-12-15 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
* pop3.el (pop3-movemail): Use binary.
- (pop3-movemail-file-coding-system): Removed.
+ (pop3-movemail-file-coding-system): Remove.
2000-12-14 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -17514,8 +17503,8 @@
2000-12-04 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * mail-source.el (mail-source-report-new-mail): Use
- nnheader-run-at-time.
+ * mail-source.el (mail-source-report-new-mail):
+ Use nnheader-run-at-time.
2000-02-15 Andrew Innes <andrewi@gnu.org>
@@ -17559,8 +17548,8 @@
2000-12-01 Simon Josefsson <sj@extundo.com>
- * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle
- more than one certificate inside PKCS#7 blob. Better security
+ * mml-smime.el (mml-smime-verify): Don't modify MM buffer.
+ Handle more than one certificate inside PKCS#7 blob. Better security
information (clamed / actual sender, openssl output, certificates
inside message).
@@ -17569,8 +17558,8 @@
2000-11-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-art.el (gnus-mime-security-button-line-format-alist): Add
- ?d and ?D.
+ * gnus-art.el (gnus-mime-security-button-line-format-alist):
+ Add ?d and ?D.
(gnus-mime-security-show-details-inline): New variable.
(gnus-mime-security-show-details): Use them.
(gnus-insert-mime-security-button): Ditto.
@@ -17616,8 +17605,8 @@
2000-11-22 Jan Nieuwenhuizen <janneke@gnu.org>
- * nnmh.el (nnmh-request-expire-articles): Implemented
- expiry-target for nnmh backend.
+ * nnmh.el (nnmh-request-expire-articles):
+ Implemented expiry-target for nnmh backend.
2000-11-30 Simon Josefsson <sj@extundo.com>
@@ -17683,8 +17672,8 @@
2000-11-22 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-xmas.el (gnus-xmas-article-display-xface): Use
- insert-buffer-substring.
+ * gnus-xmas.el (gnus-xmas-article-display-xface):
+ Use insert-buffer-substring.
* message.el (message-send-mail): Use buffer-substring-no-properties.
(message-send-news): Ditto.
@@ -17779,13 +17768,13 @@
* mml-sec.el (mml-sign-alist): Update names.
(mml-encrypt-alist): Ditto.
- (mml-secure-part-smime-sign): Moved to mml-smime.el
+ (mml-secure-part-smime-sign): Move to mml-smime.el
as `mml-smime-sign-query'.
- (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as
+ (mml-secure-part-smime-encrypt-by-file): Move to mml-smime.el as
`mml-smime-get-file-cert'.
- (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as
+ (mml-secure-part-smime-encrypt-by-dns): Move to mml-smime.el as
`mml-smime-get-dns-cert'.
- (mml-secure-part-smime-encrypt): Moved to mml-smime.el as
+ (mml-secure-part-smime-encrypt): Move to mml-smime.el as
`mml-smime-encrypt-query'.
(mml-smime-sign-buffer): Use mml-smime-sign.
(mml-smime-encrypt-buffer): Use mml-smime-encrypt.
@@ -17795,7 +17784,7 @@
(mml-smime-sign-query):
(mml-smime-get-file-cert):
(mml-smime-get-dns-cert):
- (mml-smime-encrypt-query): Moved from mml-sec.el.
+ (mml-smime-encrypt-query): Move from mml-sec.el.
2000-11-16 Simon Josefsson <sj@extundo.com>
@@ -17804,8 +17793,8 @@
2000-11-17 14:21 ShengHuo ZHU <zsh@cs.rochester.edu>
- * message.el (message-setup-fill-variables): Use
- message-cite-prefix-regexp.
+ * message.el (message-setup-fill-variables):
+ Use message-cite-prefix-regexp.
(message-newline-and-reformat): Check the end of citation, leading
WSP, break in the cite prefix.
(message-fill-paragraph): New function.
@@ -17846,8 +17835,8 @@
2000-11-12 David Edmondson <dme@dme.org>
- * message.el (message-font-lock-keywords): Use
- message-cite-prefix-regexp.
+ * message.el (message-font-lock-keywords):
+ Use message-cite-prefix-regexp.
2000-11-15 Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
@@ -17941,15 +17930,15 @@
2000-11-12 David Edmondson <dme@dme.org>
- * message.el (message-cite-prefix-regexp): Moved from gnus-cite.el
+ * message.el (message-cite-prefix-regexp): Move from gnus-cite.el
and replace `.' with `\w' to allow for different syntax tables
(from Vladimir Volovich).
- * message.el (message-newline-and-reformat): Use
- `message-cite-prefix-regexp'.
- * gnus-cite.el (gnus-supercite-regexp): Use
- `message-cite-prefix-regexp'.
- * gnus-cite.el (gnus-cite-parse): Use
- `message-cite-prefix-regexp'.
+ * message.el (message-newline-and-reformat):
+ Use `message-cite-prefix-regexp'.
+ * gnus-cite.el (gnus-supercite-regexp):
+ Use `message-cite-prefix-regexp'.
+ * gnus-cite.el (gnus-cite-parse):
+ Use `message-cite-prefix-regexp'.
2000-11-12 08:52:46 ShengHuo ZHU <zsh@cs.rochester.edu>
@@ -18126,8 +18115,8 @@
Verify S/MIME signature support.
- * mm-decode.el (mm-inline-media-tests): Add
- application/{x-,}pkcs7-signature.
+ * mm-decode.el (mm-inline-media-tests):
+ Add application/{x-,}pkcs7-signature.
(mm-inlined-types): Ditto.
(mm-automatic-display): Ditto.
(mm-verify-function-alist): Ditto. Add name of method.
@@ -18156,10 +18145,6 @@
* nnheader.el (nnheader-replace-chars-in-string): Use it.
* gnus-mh.el (mh-lib-progs): Shut up.
-2000-11-04 ShengHuo Zhu <zsh@cs.rochester.edu>
-
- * base64.el, md5.el: Moved to contrib directory.
-
2000-11-04 11:13:56 ShengHuo ZHU <zsh@cs.rochester.edu>
* gnus-sum.el (gnus-summary-search-article-forward): Don't move
@@ -18343,8 +18328,8 @@
* qp.el (quoted-printable-encode-region): Replace leading - when
ultra safe.
- * mml.el (mml-generate-mime-postprocess-function): Removed.
- (mml-postprocess-alist): Removed.
+ * mml.el (mml-generate-mime-postprocess-function): Remove.
+ (mml-postprocess-alist): Remove.
(mml-generate-mime-1): Use ultra-safe when sign.
* mml2015.el (mml2015-fix-micalg): Uppercase.
(mml2015-verify): Insert LF.
@@ -18372,14 +18357,14 @@
2000-10-30 08:17:46 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus.el (gnus-server-browse-hashtb): Removed.
+ * gnus.el (gnus-server-browse-hashtb): Remove.
* gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active.
(gnus-group-insert-group-line-info): Use simplified method.
* gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active.
2000-10-30 01:52:40 ShengHuo ZHU <zsh@cs.rochester.edu>
- * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and
+ * gnus-util.el (gnus-union): Rename from gnus-agent-union, and
moved here.
* gnus-agent.el (gnus-agent-fetch-headers): Use it.
* gnus-group.el (gnus-group-prepare-flat): Use it.
@@ -18456,9 +18441,9 @@
* mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored
in buffers.
- (mml-secure-dns-server): Removed.
- (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't
- write certificates to files.
+ (mml-secure-dns-server): Remove.
+ (mml-secure-part-smime-encrypt-by-dns): Use DIG interface.
+ Don't write certificates to files.
* smime.el (smime-dns-server): New variable.
(smime-mail-to-domain):
@@ -18553,7 +18538,7 @@
See ChangeLog.1 for earlier changes.
- Copyright (C) 2000-2002, 2004-2013 Free Software Foundation, Inc.
+ Copyright (C) 2000-2002, 2004-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog.3
index 950b73666e2..442326cc7f0 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog.3
@@ -1,3 +1,1290 @@
+2015-04-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use American spelling for 'normalize'
+ * rtree.el (rtree-normalize-range): Rename from rtree-normalise-range.
+ All uses changed. Add an alias for obsolete usages.
+
+2015-04-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content):
+ Always return relative file name.
+ (gnus-article-browse-html-parts):
+ Make external links absolute and cid file names relative.
+
+2015-04-01 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-prune): Re-use `registry-full' in
+ `registry-prune'. It's a bit of redundant work, but safer.
+ Also ensure that target-size is an integer.
+
+2015-03-31 Daiki Ueno <ueno@gnu.org>
+
+ * plstore.el (plstore--decrypt): Clear entry in
+ `plstore-passphrase-alist' if decryption failed (bug#20030).
+
+2015-03-28 Adam Sjøgren <asjo@koldfront.dk>
+
+ * gnus-sum.el (gnus-summary-make-menu-bar): Add "Display HTML images"
+ to "Display" menu.
+
+2015-03-24 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnimap.el (nnimap-split-incoming-mail): If a message is already
+ in the group it should be split to, don't re-copy it into the group.
+
+2015-03-23 Ben Bacarisse <ben.lists@bsb.me.uk> (tiny change)
+
+ * nnmh.el (nnmh-request-expire-articles):
+ Work for the case nnmail-expiry-target is an nnmh group (bug#20170).
+
+2015-03-21 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-lookup-secondary, registry-full)
+ (registry-prune, registry-collect-prune-candidates):
+ * gnus-registry.el (gnus-registry-load): Use slot names rather than
+ initarg names in `oref' and `oset'.
+
+2015-03-19 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-prune): Allow registry to reach full size
+ before pruning.
+
+2015-03-19 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-collect-prune-candidates): Fix call to
+ cl-subseq.
+
+2015-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-registry.el (gnus-registry-handle-action)
+ (gnus-registry-post-process-groups): Don't add-to-list on a local var.
+ (gnus-registry-keywords): Make it do something.
+ (gnus-registry-import-eld): Remove unused var `new-entry'.
+ (gnus-registry-action): Remove unused var `to-name'.
+ (gnus-registry-make-db): Prefer `make-instance' to avoid
+ compiler warnings.
+ (gnus-registry-load, gnus-registry-fixup-registry): Avoid `oset'.
+
+ * registry.el (registry-db): Don't oset-default an instance-allocated
+ slot.
+
+2015-03-10 Glenn Morris <rgm@gnu.org>
+
+ * message.el (message-valid-fqdn-regexp): Bump :version for
+ 2014-11-17 change.
+
+2015-03-08 Rasmus Pank Roulund <rasmus@pank.eu>
+
+ * gnus-notifications.el (gnus-notifications-action): Raise window
+ frame.
+ (gnus-notifications-action): Allow mark as read.
+ (gnus-notifications-notify): Show uption to mark as read.
+
+2015-03-08 Adam Sjøgren <asjo@koldfront.dk>
+
+ * message.el (message-insert-formatted-citation-line): Change %F to
+ fall back to email address if no first name could be determined.
+
+2015-03-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * registry.el (registry-lookup-breaks-before-lexbind, registry-lookup)
+ (registry-search, registry-delete, registry-size, registry-insert)
+ (registry-reindex, registry-collect-prune-candidates):
+ * gnus-registry.el (gnus-registry-fixup-registry)
+ (gnus-registry-remove-extra-data): Use slot names rather than initarg
+ names in `oref' and `oset'.
+
+2015-02-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part):
+ Fix point motion when removing displayed MIME part.
+ (gnus-article-edit-part): Make jumping to the next part really work
+ when deleting or stripping.
+ (gnus-mime-buttonize-attachments-in-header): Make header attachment
+ buttons identical to the ones in the article body so as to work deleting
+ and stripping.
+
+2015-02-25 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-shr)
+ * mm-view.el (mm-inline-text-html-render-with-w3m):
+ Revert my bogus change that made the start marker of a part
+ the "moves after insertion" type.
+
+2015-02-23 Tassilo Horn <tsdh@gnu.org>
+
+ * mailcap.el (mailcap-mime-data): Support `pdf-view-mode' (from PDF
+ Tools: https://github.com/politza/pdf-tools) for viewing PDF
+ attachments in emacs.
+
+2015-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-display-single): Avoid "End of buffer" error.
+
+2015-02-18 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnimap.el (nnimap-get-groups): Correctly read unquoted group names
+ from the server LIST response.
+
+2015-02-14 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-retrieve-headers): If the server closes connection
+ during header retrieval, error out instead of interpreting the data in
+ the buffer as the only messages there. This way, we don't mark
+ articles as read on a server hangup (bug#19035).
+
+ * mm-decode.el (mm-head-p): New function.
+ (mm-display-part): Go to a blank line when inserting parts internally.
+
+2015-02-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-msg-mail): Don't let-bind `gnus-newsgroup-name' so
+ that we don't get a warning when setting the buffer-local variable
+ (bug#19573).
+
+ * nnmail.el (nnmail-expiry-target-group): Supply the info structure to
+ `gnus-request-group'.
+
+2015-02-12 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content)
+ (gnus-article-browse-html-parts): Make cid file names relative if and
+ only if html doesn't specify <base> directory.
+
+2015-02-11 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-treat-buttonize): Don't re-buttonize URLs in HTML
+ parts, because that breaks filling (since buttons are in a bold face).
+
+2015-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-convert-shr-links): Delete useless variable `face';
+ use gnus-overlays-at and gnus-overlay-put.
+
+2015-02-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-shr): Only pass the fill column when not using
+ fonts, because limiting the width to what's appropriate for followups
+ doesn't really help when not using proportional fonts.
+
+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.
+ (mm-shr): Don't shorten the width when using fonts.
+
+2015-02-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-start.el (gnus-save-newsrc-file-check-timestamp): Remove
+ variable; always check the newrc timestamp.
+ (gnus-save-newsrc-file): Always check timestamp.
+
+2015-02-05 Timo Lilja <timo.lilja@iki.fi> (tiny change)
+
+ * mail-source.el (mail-source-call-script): If scripts exit with an
+ error, pop up an error buffer.
+
+2015-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-extra-headers): Add the popular Gmail X-GM-LABELS
+ as a default.
+
+ * nnimap.el (nnimap-request-group-scan): Ensure that we've selected the
+ correct server.
+
+2015-02-05 Vincent Bernat <bernat@luffy.cx> (tiny change)
+
+ * nnimap.el (nnimap-request-group-scan): Fix the function name.
+
+ * gnus-int.el (gnus-request-group-scan): Use the correct function name.
+
+2015-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-select-newsgroup): Pass the group info along so
+ that nnimap works for non-activated backends.
+
+2015-02-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mm-util.el (mm-with-unibyte-current-buffer): Don't emit a warning
+ message, since we already get an obsolescence message. Use `declare'.
+
+2015-02-04 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnir.el: Revert "Enable non-ASCII IMAP searches".
+
+2015-01-30 Glenn Morris <rgm@gnu.org>
+
+ * gnus-registry.el (gnus-registry-max-pruned-entries)
+ (gnus-registry-prune-factor, gnus-registry-default-sort-function):
+ Fix :version.
+ (gnus-registry-default-sort-function): Improve :type.
+
+2015-01-29 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-group): Allow running this function on
+ groups that don't exist in Gnus yet.
+ (nnimap-request-group): Revert previous patch since that made it
+ impossible to enter nnimap groups.
+
+ * message.el (message-smtpmail-send-it): Remove the mail header
+ separator before sending.
+
+2015-01-28 Elias Oltmanns <eo@nebensachen.de>
+
+ * nnimap.el (nnimap-find-expired-articles): Fix handling of
+ (expiry-wait . never).
+
+2015-01-28 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-group): Clear the buffer before returning
+ the data.
+
+2015-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnir.el (nnir-imap-expr-to-imap): Check for literal+ capability in
+ IMAP.
+
+2015-01-27 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * nnir.el (nnir-run-imap): Enable non-ASCII IMAP searches.
+
+ * nnmairix.el ("nnmairix"): Declare nnmairix as virtual.
+
+ * gnus-bcklg.el (gnus-backlog-enter-article): No virtual groups should
+ be added to the backlog.
+
+2015-01-26 Trevor Murphy <trevor.m.murphy@gmail.com>
+
+ * nnimap.el (nnimap-header-parameters): Refactor and request
+ X-GM-LABELS if it's been announced.
+ (nnimap-transform-headers): Gather and output GM-LABELS.
+
+2015-01-26 Peder O. Klingenberg <peder@klingenberg.no>
+
+ * mm-decode.el (mm-display-part): Make non-string methods work.
+ Non-string methods are funcalled and work just fine, the test was
+ bogus.
+ * mm-decode.el (mm-display-external): Show "external" lisp viewers in
+ whole frame.
+
+2015-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-accept-article): Allow respooling using
+ nnimap.
+
+ * gnus-group.el (gnus-group-get-new-news-this-group): Explicitly
+ request rescans when being run interactively.
+
+ * nnimap.el (nnimap-request-group): Don't rescan the group here,
+ because that can be very slow in large groups.
+
+ * gnus-int.el (gnus-request-group-scan): New backend function.
+
+ * nnimap.el (nnimap-request-scan-group): Implement in on IMAP.
+
+2015-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-suspend): Close all backends.
+
+2015-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nntp.el (nntp-send-authinfo): Error out if the password is wrong.
+
+2015-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * registry.el: Don't use <class> as a variable.
+
+2014-12-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * message.el (message-make-fqdn):
+ * nnvirtual.el (nnvirtual-retrieve-headers)
+ (nnvirtual-update-xref-header): Prefer (system-name) to system-name,
+ and avoid naming locals 'system-name'.
+
+2014-12-29 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-decode.el (mm-shr): Bind `shr-width' to `fill-column' so that
+ lines don't get overlong when responding.
+
+2014-12-19 Andreas Schwab <schwab@linux-m68k.org>
+
+ * gnus-group.el (gnus-read-ephemeral-bug-group):
+ Bind coding-system-for-read and coding-system-for-write only around
+ with-temp-file, and make buffer unibyte. Don't write temp file twice.
+
+2014-12-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * registry.el (registry-db): Set default slot later.
+ This is because its value is not a literal integer.
+
+2014-12-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mm-util.el (mm-with-unibyte-current-buffer): Mark obsolete and
+ add warning.
+
+ * gnus-art.el: Fix up compiler warnings.
+ (article-display-face, article-display-x-face): Remove unused `face'.
+ (gnus-article-browse-html-save-cid-content): Remove unused var `type'.
+ (article-date-ut): Remove unused var `first'.
+ (gnus-article-prepare): Remove unused var `gnus-article'.
+ (gnus-mime-save-part-and-strip): Remove unused var `param'.
+ (gnus-mime-inline-part): Remove unused vars `charset', `contents', and
+ `coding-system' along with corresponding dead code.
+ (gnus-mime-view-part-externally): Remove unused var
+ `mm-user-display-methods'.
+ (gnus-insert-mime-button): Let-bind gnus-tmp-id explicitly.
+ (gnus-display-mime): Remove unused var `handle'.
+ (gnus-mime-display-alternative): Remove unused var `props'.
+ (gnus-article-read-summary-keys): Remove unused var `up-to-top'.
+ (gnus-article-edit-done): Remove unused var `p'.
+ (gnus-url-mailto): Remove unused var `to'.
+ (gnus-treat-article): Let-bind gnus-treat-condition, part-number,
+ total-parts, and gnus-treat-type explicitly. Remove unused var `elem'.
+
+2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * registry.el (registry-db): Consolidate the :max-hard and :max-soft
+ slots into a :max-size slot.
+ (registry-db-version): Add new variable for database version number.
+ (registry-prune): Use :max-size slot. Accept and use a sort-function
+ argument.
+ (registry-collect-prune-candidates): Add new function for finding
+ non-precious pruning candidates.
+ (registry-prune-hard-candidates, registry-prune-soft-candidates):
+ Remove obsolete functions.
+ (initialize-instance): Upgrade registry version when starting.
+
+ * gnus-registry.el (gnus-registry-prune-factor): Add new variable.
+ (gnus-registry-max-pruned-entries): Remove obsolete variable.
+ (gnus-registry-cache-file): Change default
+ filename extension to "eieio".
+ (gnus-registry-read): Add new function, split out from
+ `gnus-registry-load', that does the actual object reading.
+ (gnus-registry-load): Use it. Add condition case handler to check for
+ old filename extension and rename to the new one.
+ (gnus-registry-default-sort-function): New variable to specify a sort
+ function to use when pruning.
+ (gnus-registry-save, gnus-registry-insert): Use it.
+ (gnus-registry-sort-by-creation-time): Define a default sort function.
+
+2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-mime-handles): Refactor out into own
+ function for reuse.
+ (gnus-mime-buttonize-attachments-in-header): Adjust.
+
+2014-12-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-change-subject): Really check whether the subject
+ changed.
+
+2014-12-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mailcap.el (mailcap-mime-data): Add doc-view-mode as a viewer for
+ PDFs.
+ (mailcap-view-mime): New function.
+
+2014-12-01 Glenn Morris <rgm@gnu.org>
+
+ * gnus-cloud.el (gnus-cloud): Add :version tag.
+
+2014-11-29 John Mastro <john.b.mastro@gmail.com> (tiny change)
+
+ * auth-source.el (auth-source-macos-keychain-search-items): Return
+ result of `auth-source-macos-keychain-result-append' (bug#19074).
+
+2014-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-use-idna):
+ * gnus-sum.el (gnus-summary-idna-message):
+ * message.el (message-use-idna):
+ Protect against nil value for idna-program.
+
+ * message.el (message-use-idna): Load Mule-UCS for XEmacs 21.4.
+
+2014-11-25 Glenn Morris <rgm@gnu.org>
+
+ * gnus-start.el (gnus-save-newsrc-file-check-timestamp):
+ Add :version tag.
+
+2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * pop3.el (pop3-open-server): Warn unless encrypted.
+
+ * nnimap.el (nnimap-open-connection-1): Warn unless encrypted.
+
+2014-11-17 Albert Krewinkel <albert@zeitkraut.de>
+
+ * message.el (message-valid-fqdn-regexp): Add non-internaional new
+ TLDs.
+
+2014-11-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit-no-update): Don't query about
+ discarding changes in ephemeral groups.
+
+ * ietf-drums.el (ietf-drums-parse-address): Don't issue warnings about
+ things the user isn't interested in.
+
+2014-11-13 Julien Danjou <jd@abydos>
+
+ * gnus-notifications.el (gnus-notifications-notify): Provide both
+ app-icon and image-path.
+
+2014-11-10 Kenjiro NAKAYAMA <nakayamakenjiro@gmail.com>
+
+ * gnus/mm-url.el (mm-url-encode-multipart-form-data):
+ Restore to handle "multipart/form-data" by eww.
+
+2014-11-07 Tassilo Horn <tsdh@gnu.org>
+
+ * gnus-start.el (gnus-activate-group): Fix typo reported by Tim
+ Landscheidt.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * gnus-delay.el (gnus-delay-article):
+ * gnus-sum.el (gnus-summary-read-document):
+ * gnus-util.el (gnus-seconds-today, gnus-seconds-month):
+ * message.el (message-make-expires-date):
+ Omit unnecessary call to current-time.
+ * gnus-util.el (gnus-float-time): Simplify to an alias because
+ time-to-seconds now behaves like float-time with respect to nil arg.
+ (gnus-seconds-year): Don't call current-time twice to get the current
+ time stamp, as this can lead to inconsistent results.
+
+2014-10-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-mode-line-buffer-identification):
+ Don't add image data for a non-graphic display (bug#18813).
+
+2014-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-mode-line-buffer-identification): Don't shadow
+ load-path, it blocks autoloading of find-image (bug#18813).
+
+2014-10-24 enami tsugutomo <tsugutomo.enami@jp.sony.com>
+
+ * nnimap.el (nnimap-wait-for-response): Ignore NOOP response requested
+ to keep connection open (bug#18728).
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-15 Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu> (tiny change)
+
+ * message.el (message-insert-signature): Use `newline' instead of
+ inserting explicit "\n".
+
+2014-10-15 Sylvain Chouleur <sylvain.chouleur@gmail.com>
+
+ * gnus-icalendar.el: Support vcal format timezones.
+ (gnus-icalendar-event--decode-datefield): Use icalendar functions to
+ compute dates with associated timezone.
+ (gnus-icalendar-event-from-ical): Compute all timezones.
+
+2014-10-14 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * gnus-start.el (gnus-save-newsrc-file-check-timestamp): New option to
+ check the newsrc.eld file's timestamp before saving it.
+ (gnus-save-newsrc-file): Use it, with a prompt when the newsrc.eld
+ timestamp has changed to be newer.
+
+2014-10-06 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-identities):
+ Include message-alternative-emails.
+
+2014-10-04 Alan Schmitt <alan.schmitt@polytechnique.org> (tiny change)
+
+ * nnimap.el (nnimap-process-expiry-targets): Reverse the list of
+ expired messages only when it was built in reverse order.
+
+2014-10-04 Peter Münster <pmlists@free.fr> (tiny change)
+
+ * gnus-delay.el (gnus-delay-send-queue): Remove `gnus-delay-header'
+ last so it can be used in `message-send-hook'.
+
+2014-10-02 Daiki Ueno <ueno@gnu.org>
+
+ * mml.el (mml-parse-1): Error out if unknown mode is specified in
+ <#secure> tag (bug#18513).
+
+2014-09-29 Daiki Ueno <ueno@gnu.org>
+
+ * mml.el (mml-parse-1): Error out if unknown mode is specified in
+ <#secure> tag (bug#18513).
+
+2014-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ * gnus-cloud.el (gnus-cloud-parse-version-1): Fix misspelling
+ of ":delete".
+
+2014-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content)
+ (gnus-article-browse-html-parts):
+ Revert last change that breaks links other than cid contents.
+
+2014-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content)
+ (gnus-article-browse-html-parts): Make cid file names relative.
+
+2014-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-view.el (mm-display-inline-fontify): Make the working buffer
+ temporarily displayed when running a mode function (at least org-mode
+ requires it).
+
+2014-08-14 Alan Schmitt <alan.schmitt@polytechnique.org>
+
+ * gnus-sum.el (gnus-summary-expire-articles): Functions registered to
+ the gnus-summary-article-expire-hook should be told where the function
+ is going. In particular, the Gnus registry might want to know.
+
+2014-08-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-art.el (gnus-hidden-properties): Drop the evil `intangible'.
+
+2014-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-expire-articles): Revert.
+
+2014-08-05 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * gnus-sum.el (gnus-summary-expire-articles): Functions registered to
+ the gnus-summary-article-expire-hook should be told where the function
+ is going. In particular, the Gnus registry might want to know.
+
+2014-07-31 Tassilo Horn <tsdh@gnu.org>
+
+ * gnus-msg.el (gnus-inews-insert-gcc): Allow `gcc-self' to be a list of
+ groups and t.
+
+2014-07-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-utils.el (gnus-recursive-directory-files):
+ Unify hard or symbolic links (bug#18063).
+
+2013-07-17 Albert Krewinkel <albert@zeitkraut.de>
+
+ * gnus-msg.el (gnus-configure-posting-style):
+ Allow string replacements in values when matching against a header.
+
+2014-07-07 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-start.el (gnus-dribble-read-file): Don't stop the auto-saving of
+ the dribble buffer even when it is shrunk a lot.
+ <http://thread.gmane.org/gmane.emacs.gnus.user/16923>
+
+2014-06-26 Glenn Morris <rgm@gnu.org>
+
+ * mm-util.el (help-function-arglist): Remove outdated declaration.
+
+2014-06-24 Andreas Schwab <schwab@linux-m68k.org>
+
+ * html2text.el (html2text-get-attr): Rewrite to handle spaces in quoted
+ attribute values. (Bug#17834)
+
+2013-06-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * gnus-sum.el (gnus-summary-edit-article-done):
+ Prefer point-marker to copy-marker of point.
+
+2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-edit-part): Don't modifiy 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):
+ Improve criterion that finds parts to display.
+
+ * gnus-art.el (gnus-mm-display-part):
+ * mm-decode.el (mm-shr):
+ * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text)
+ (mm-insert-inline): Revert last changes.
+
+2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mm-display-part):
+ * mm-decode.el (mm-shr):
+ * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text)
+ (mm-insert-inline): Set insertion type of end-marker, not only
+ start-marker, of undisplayer so as to stay after inserted text.
+
+2014-06-02 Andreas Schwab <schwab@linux-m68k.org>
+
+ * html2text.el (html2text-get-attr): Fix typo when splitting value from
+ attribute. (Bug#17613)
+
+2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mm-view.el (mm-display-inline-fontify): Use font-lock-ensure.
+ * gnus-cite.el (gnus-message-citation-mode): Use font-lock-flush.
+
+2014-05-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part):
+ Don't delete next part button; keep spacing between buttons.
+
+2014-05-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part):
+ Work for the last MIME part in an article.
+ (gnus-mime-display-single): Suppress excessive newlines between parts.
+
+ * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied
+ by leading or trailing newline.
+
+2014-05-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mm-display-part): Don't put article out of sight
+ while prompting a user for a file name, etc.
+ (gnus-mime-display-single): Display part with a common appearance no
+ matter whether MIME button is omitted or not; don't add duplicate entry
+ to gnus-article-mime-handle-alist.
+ (gnus-mime-buttonize-attachments-in-header): Use copied buttons.
+
+2014-05-08 Adam Sjøgren <asjo@koldfront.dk>
+
+ * mml2015.el (mml2015-display-key-image): New variable.
+
+2014-05-08 Glenn Morris <rgm@gnu.org>
+
+ * gnus-fun.el (gnus-grab-cam-face):
+ Do not use predictable temp-file name. (http://bugs.debian.org/747100)
+ This is CVE-2014-3421.
+
+2014-05-04 Glenn Morris <rgm@gnu.org>
+
+ * gnus-registry.el (gnus-registry-install-p): Doc fix.
+
+2014-05-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-inline-part): Redisplay a button so as to show
+ the displaying state of a part.
+ (gnus-mm-display-part): Don't insert a newline in the beginning of
+ a part like gnus-mime-inline-part doesn't; work for XEmacs.
+
+ * mm-decode.el (mm-display-part): Don't insert a newline in the top.
+ (mm-shr): Make undisplayer unbreakable.
+
+ * mm-view.el (mm-inline-image-emacs, mm-inline-image-xemacs):
+ Don't insert excessive newline.
+ (mm-inline-text-html-render-with-w3m, mm-inline-text)
+ (mm-insert-inline): Make undisplayer unbreakable.
+
+2014-05-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mm-display-part):
+ Highlight header attachment buttons.
+
+2014-04-30 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mm-display-part): Don't move point while toggling
+ a part; redisplay a button (enbugged in 2014-03-23).
+
+2014-04-27 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-source-search, auth-source-search-backends):
+ Treat :max 0 as an indicator that a boolean return is wanted, as
+ documented. Reported by Joe Bloggs.
+
+2014-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-icalendar.el: Require gnus-art.
+
+2014-04-20 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-event->org-entry)
+ (gnus-icalendar--update-org-event): put event timestamp in
+ the org entry body instead of the drawer.
+ (gnus-icalendar-event--get-attendee-names): list of participants should
+ contain even attendees without common name attribute.
+ (gnus-icalendar--update-org-event): don't generate duplicates of empty
+ property tags in org drawers.
+
+2014-04-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gmm-utils.el (gmm-format-time-string): New function.
+
+ * message.el (message-insert-formatted-citation-line): Use the original
+ author's time zone to express a date string.
+
+2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where)
+ (gnus-tmp-status, gnus-tmp-agent, gnus-tmp-cloud)
+ (gnus-tmp-news-server, gnus-tmp-news-method, gnus-tmp-user-defined):
+ Silence compiler warnings.
+ (gnus-server-insert-server-line): Don't use dyn-bind var as argument.
+
+2014-03-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mml.el: Require url when compiling.
+
+ * gnus-cloud.el (gnus-cloud-parse-version-1):
+ Use plist-get rather than CL's getf.
+ (gnus-activate-group, gnus-subscribe-group): Declare.
+
+ * gnus-sum.el (gnus-mime-buttonize-attachments-in-header): Declare.
+
+2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Display header attachment
+ buttons when toggling the header off.
+
+2014-03-23 Daiki Ueno <ueno@gnu.org>
+
+ * mml2015.el (mml2015-use): Don't check the availability of GnuPG
+ commands here; instead, only check if epg-config.el is available.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-expand-html-into-multipart-related): Allow sending HTML
+ messages with embedded images.
+ (mml-generate-mime): Don't bug out if you don't have libxml.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-make-html-message-with-image-files): New command.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
+
+2014-03-23 David Engster <deng@randomsample.de>
+
+ * auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib'
+ to stay compatible with older Emacsen, so replace `cl-loop' with
+ `loop'.
+
+2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-prepare, gnus-article-prepare-display):
+ Display header attachment buttons by gnus-article-prepare-display
+ rather than gnus-article-prepare so as to view in mml-preview as well.
+
+2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-article-goto-part): Find a button in the body first.
+ (gnus-mime-buttonize-attachments-in-header): Number hidden buttons.
+
+2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (gnus-mime-buttonize-attachments-in-header):
+ Display buttons that are hidden in unselected alternative part as well.
+ (gnus-mime-display-alternative): Redraw attachment buttons in header.
+
+ * gmm-utils.el (gmm-labels): Add edebug spec.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and
+ keystroke.
+ (gnus-server-toggle-cloud-server): Only allow clouding applicable
+ types.
+
+2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions.
+
+ * gnus-art.el (gnus-mime-display-attachment-buttons-in-header):
+ New user option.
+ (gnus-mime-buttonize-attachments-in-header): New function.
+ (gnus-article-prepare): Use it.
+ (gnus-mime-inline-part): Suppress extra newline.
+ (gnus-mm-display-part): Save excursion;
+ remove useless deleting and adding of buttons.
+ (gnus-insert-mime-button): Allow insertion in the middle of a line.
+
+ * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu):
+ Add gnus-mime-buttonize-attachments-in-header.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-articles): New command to download several
+ articles at once.
+
+ * gnus.el (gnus-variable-list): Save Cloud variables.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-cloud.el: New file to provide the Emacs Cloud.
+
+ * gravatar.el (gravatar-retrieve-synchronously): XEmacs also has
+ `url-retrieve-synchronously', apparently.
+
+ * gnus-notifications.el (gravatar-retrieve-synchronously): Declare for
+ XEmacs.
+
+ * nnrss.el (libxml-parse-html-region): Silence compilation error.
+
+2014-03-23 Daniel Dehennin <daniel.dehennin@baby-gnu.org>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
+ `gnus-group-split-fancy'.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-remove-header): Doc fix.
+ (message-forward-included-headers): New variable.
+ (message-remove-ignored-headers): Use it.
+
+2014-03-23 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-sum.el (gnus-summary-open-group-with-article): New command.
+
+2014-03-23 Rasmus Pank Roulund <emacs@pank.eu>
+
+ * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results
+ from random face commands.
+ (gnus-face-directory): Like `gnus-x-face-directory` for png files and
+ Face.
+ (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face.
+ (gnus--random-face-with-type): Generic function returning a face-type
+ as a string.
+ (gnus--insert-random-face-with-type): Generic function inserting a face
+ in a message buffer header.
+ (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`.
+ (gnus-insert-random-x-face-header): Rewritten to use
+ `gnus--insert-random-face-with-type`.
+ (gnus-random-face): Return random (png) Face as string.
+ (nus-insert-random-face-header): Insert random (png) Face in a message
+ buffer.
+
+2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * mm-url.el: Remove all usage of w3.
+
+ * nnrss.el: Ditto.
+
+ * mm-decode.el: Ditto.
+
+ * mm-view.el: Ditto.
+
+ * gnus-setup.el: Remove outdated file.
+
+2014-03-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap
+ groups work again.
+
+2014-03-07 George McNinch <gmcninch@gmail.com> (tiny change)
+
+ * nnir.el (nnir-run-namazu): Parse namazu results that are larger than
+ 999 correctly (i.e. "1,342").
+
+2014-03-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-update-files-total-fetched-for): Don't bug
+ out if the directory doesn't exist.
+
+2014-03-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-make-group): Clarify prompt.
+
+2014-02-22 Daniel Colascione <dancol@dancol.org>
+
+ * auth-source.el (auth-source-secrets-listify-pattern): New function.
+ (auth-source-secrets-search): Don't pass invalid patterns to secrets.el;
+ instead, build list of patterns.
+
+2014-02-13 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * auth-source.el (auth-sources): Add pointer to what the .gpg extension
+ in `auth-sources' means and link to EPA docs.
+
+2014-02-12 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-expand-newtext): Further sub-match fixups
+ (bug#12375).
+
+2014-02-09 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-tab): Mention what happens on normal tabs
+ (bug#11297).
+
+2014-02-08 Glenn Morris <rgm@gnu.org>
+
+ * auth-source.el (auth-sources): Doc fix. (Bug#16642)
+
+2014-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * ietf-drums.el (ietf-drums-parse-address): Don't bug out when called
+ with an empty string.
+
+2014-02-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-summary-cancel-article): `user-mail-address' is
+ buffer-local in some buffers, so bind it explicitly in the buffer we're
+ trying to cancel the article in (bug#10808).
+
+2014-02-05 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-int.el (gnus-request-accept-article): Doc fix.
+
+2014-02-01 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnir.el (nnir-request-update-mark): Don't try to update the source
+ group if we can't find it (bug#16611).
+
+2014-01-31 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnimap.el (nnimap-transform-headers): Fix Davmail header parsing.
+
+2014-01-31 Dave Abrahams <dave@boostpro.com>
+
+ * gnus-salt.el (gnus-tree-highlight-article): Don't move point around
+ in the summary buffer (bug#13769).
+
+2014-01-31 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-article-setup-buffer): Refresh the summary buffer
+ name if we're using a single article buffer. Otherwise, it may point
+ to a killed buffer (bug#13756).
+
+2014-01-30 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-split-it): Instead of redoing the search to restore
+ the match data, just save and restore it explicitly (bug#12375).
+
+ * gnus-sum.el (gnus-summary-read-group-1): Initialize the spam code if
+ that's needed.
+
+ * spam.el (spam-initialize): Allow calling repeatedly, but only run the
+ the code once (bug#9069).
+
+2014-01-18 Steinar Bang <sb@dod.no>
+
+ * gnus-setup.el (gnus-use-sendmail): We never use sendmail for mail
+ reading.
+
+2014-01-09 Ken Olum <kdo@cosmos.phy.tufts.edu>
+
+ * message.el (message-bury): Call bury-buffer with no argument
+ in the message-return-action case too.
+
+2014-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-sum.el (gnus-article-stop-animations): Declare it before using.
+ (nnimap-split-fancy, nnimap-split-methods): Declare.
+
+ * mm-util.el (help-function-arglist): Declare.
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * gnus-sieve.el (gnus-sieve-select-method):
+ * gravatar.el (gravatar-automatic-caching, gravatar-cache-ttl)
+ (gravatar-rating, gravatar-size):
+ * message.el (message-minibuffer-local-map):
+ * sieve-manage.el (sieve-manage-authenticators)
+ (sieve-manage-authenticator-alist): Specify custom types.
+
+ * gnus-icalendar.el (gnus-icalendar-org, gnus-icalendar):
+ * gnus-sum.el (gnus-subthread-sort-functions): Add version.
+ * gnus-sync.el (gnus-sync-file-encrypt-to): Add type and version.
+
+ * auth-source.el (auth-sources):
+ * nnmairix.el (nnmairix-propagate-marks-upon-close):
+ Fix custom types.
+
+2013-12-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-respool-query): Special-case nnimap so that
+ we get proper traces there, too.
+
+2013-12-26 Sean Connor <sconnor005@allyinics.org> (tiny change)
+
+ * gnus-sum.el (gnus-summary-enter-digest-group): Don't discard previous
+ value of the parameters if the current article has a Reply-To or From
+ field.
+
+2013-12-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.el (gnus-group-buffer): Remove duplicate definition.
+
+2013-12-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-sum.el (gnus-summary-exit): Stop animations.
+
+2013-12-19 Juri Linkov <juri@jurta.org>
+
+ * gnus.el (gnus-suppress-keymap):
+ * gnus-art.el (gnus-article-mode-map):
+ * gnus-group.el (gnus-group-mode-map):
+ * gnus-sum.el (gnus-summary-mode-map, gnus-summary-backend-map):
+ Remove [backspace] key binding because it shadows DEL (bug#16035).
+
+ * mm-decode.el (mm-viewer-completion-map): Remove duplicate definition.
+
+2013-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view):
+ Make sure work directory exists.
+ (gnus-uu-digest-mail-forward): Store temporary files in work directory
+ rather than tmp directory.
+ (gnus-summary-prepare-exit-hook): Replace gnus-exit-group-hook, that is
+ not necessarily always run, with it.
+
+2013-12-18 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-identities): Make changing the
+ value of gnus-icalendar-additional-identities work without restart.
+
+2013-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-util.el (mm-make-temp-file):
+ Alias to make-temp-file for modern Emacsen.
+
+2013-12-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-msg.el (gnus-setup-message): Fix the type of argument passed to
+ nnir-article-number and nnir-article-group.
+
+2013-12-03 Vitalie Spinu <spinuvit@gmail.com>
+
+ * message.el (message-send-mail-with-sendmail):
+ Don't kill error buffer if sending fails.
+
+2013-11-28 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-event-from-ical)
+ (gnus-icalendar-event->org-entry)
+ (gnus-icalendar--update-org-event)
+ (gnus-icalendar-event->gnus-calendar): Distinguish between
+ required/optional/non-participant attendee status. Fix bug causing
+ the first required event participant to be omitted.
+
+2013-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-art.el (article-de-quoted-unreadable)
+ (article-de-base64-unreadable, gnus-mime-copy-part)
+ * gnus-html.el (gnus-article-html)
+ * mm-view.el (mm-inline-text-html-render-with-w3)
+ (mm-inline-text-html-render-with-w3m-standalone)
+ * rfc2231.el (rfc2231-decode-encoded-string):
+ Allow overriding charset by mm-charset-override-alist.
+
+ * gnus-art.el (gnus-article-browse-html-parts):
+ Replace LWSPs with `&nbsp;'s in header.
+
+ Work for broken Chinese articles.
+
+ * gnus-art.el (gnus-article-browse-html-save-cid-content):
+ Exclude broken handles that gnus-summary-enter-digest-group may create.
+ (gnus-article-browse-html-parts):
+ Allow overriding charset by mm-charset-override-alist.
+
+2013-11-21 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-additional-identities): New.
+ (gnus-icalendar-identities): Support additional-identities.
+
+ * gnus-icalendar.el (gnus-icalendar-event:org-timestamp):
+ Fix org-timestamp for events ending at midnight.
+
+2013-11-21 Ivan Shmakov <ivan@siamics.net>
+
+ * nndoc.el (nndoc-type-alist, nndoc-debbugs-db-type-p):
+ Support debbugs .log files.
+
+2013-11-20 Dave Goldberg <david.goldberg6@verizon.net>
+
+ * message.el (message-beginning-of-line):
+ Use beginning-of-visual-line when visual-line-mode is turned on.
+
+2013-11-15 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-event->gnus-calendar)
+ (gnus-icalendar-event-from-ical)
+ (gnus-icalendar-event->org-entry)
+ (gnus-icalendar--update-org-event): Required/optional participation,
+ list of attendees synced to org.
+
+2013-11-13 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-event:sync-to-org)
+ (gnus-icalendar-event:inline-org-buttons): Allow for appointment
+ cancellations to be synced to org if the original appt has an org
+ outline.
+
+2013-11-13 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar--format-summary-line)
+ (gnus-icalendar-event->org-entry)
+ (gnus-icalendar--update-org-event)
+ (gnus-icalendar-event->gnus-calendar): Fix empty location handling.
+
+2013-11-12 Jan Tatarik <jan.tatarik@gmail.com>
+
+ * gnus-icalendar.el (gnus-icalendar-event-from-ical):
+ Fix timezone handling in gnus-icalendar export to org.
+
+2013-11-05 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-cite.el (gnus-cite-add-face): Make non-sticky overlays.
+
+2013-10-30 Glenn Morris <rgm@gnu.org>
+
+ * gnus-group.el (gnus-group-browse-foreign-server):
+ * gnus-int.el (gnus-start-news-server):
+ Silence compiler obsolescence warning.
+
+2013-10-29 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * nnimap.el (nnimap-open-connection-1): `auth-source-search' for the
+ `nnoo-current-server' first, then for the actual `nnimap-address' to
+ allow netrc entries for the nnoo server to coexist with netrc entries
+ for the `nnimap-address'.
+
+2013-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-dissect-buffer): Revert last change.
+ * nndoc.el (nndoc-dissect-mime-parts-sub): Ditto.
+ The problem that motivated those changes was attributed to a broken
+ mail sender, and has been fixed.
+
+2013-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-dissect-buffer): Guess content-type if the first
+ token is missing in the Content-Type header.
+
+ * nndoc.el (nndoc-dissect-mime-parts-sub): Ditto.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * gnus-util.el (image-size): Declare.
+
+2013-09-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-icalendar.el (gnus-icalendar-event--find-attendee)
+ (gnus-icalendar-event-from-ical)
+ (gnus-icalendar-event--build-reply-event-body)
+ (gnus-icalendar-event-reply-from-buffer)
+ (gnus-icalendar-find-org-event-file)
+ (gnus-icalendar-event->gnus-calendar, gnus-icalendar-reply)
+ (gnus-icalendar-mm-inline): Use gmm-labels instead of labels or flet.
+
+ * mm-util.el (mm-special-display-p): Isolate XEmacs stuff.
+
+2013-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * gnus-salt.el (gnus-tree-mode): Use define-derived-mode.
+ Use save-current-buffer.
+ (gnus-tree-mode-map): Initialize in the declaration.
+ (gnus-pick-mouse-pick-region): Remove unused var `fun'.
+ (scroll-in-place): Defvar it.
+ (gnus-tmp-*): Defvar them.
+ (gnus-get-tree-buffer): Use derived-mode-p.
+ (gnus--let-eval): New macro.
+ (gnus-tree-highlight-node): Use it to avoid dynamic binding of
+ non-prefixed variables.
+ (gnus-tree-open, gnus-tree-close): Remove unused arg `group'.
+
+ * gnus-sum.el (gnus-summary-highlight): Remove `below' from the list of
+ vars since it doesn't seem to be available.
+ (gnus-set-global-variables, gnus-summary-read-group-1)
+ (gnus-select-newsgroup, gnus-handle-ephemeral-exit)
+ (gnus-summary-display-article, gnus-summary-select-article)
+ (gnus-summary-next-article, gnus-offer-save-summaries)
+ (gnus-summary-generic-mark): Use derived-mode-p.
+ (gnus-summary-read-group-1, gnus-summary-exit)
+ (gnus-summary-exit-no-update, gnus-kill-or-deaden-summary):
+ Adjust calls to gnus-tree-close and gnus-tree-open.
+
+ * gnus-eform.el (gnus-edit-form-mode): Use define-derived-mode.
+
+ * gnus-agent.el (gnus-category-mode): Use define-derived-mode.
+ (gnus-agent-mode): Use derived-mode-p.
+ (gnus-agent-rename-group, gnus-agent-delete-group): Don't bind
+ gnus-command-method and *-command-method to nil, but bind
+ gnus-command-method to *-command-method instead!
+ (gnus-agent-fetch-articles): Remove unused var `id'.
+ (gnus-agent-fetch-headers): Remove unused arg `force'.
+ (gnus-agent-braid-nov): Remove unused arg `group'. Adjust callers.
+ (gnus-agent-save-alist, gnus-agent-save-local): Remove unused `item'.
+ (gnus-agent-short-article, gnus-agent-long-article)
+ (gnus-agent-low-score, gnus-agent-high-score): Move declaration before
+ first use.
+ (gnus-agent-fetch-group-1): Remove unused vars `arts', `category',
+ `score-param'.
+ (gnus-tmp-name, gnus-tmp-groups): Defvar them.
+ (gnus-get-predicate): Push in front of the cache, rather than end.
+ (gnus-agent-expire-current-dirs, gnus-agent-expire-stats): Defvar them.
+ (gnus-agent-expire-group-1): Use push. Don't abuse dyn-binding.
+ (gnus-agent-expire-unagentized-dirs): Don't rebind
+ gnus-agent-expire-current-dirs since the defvar silences the warning.
+ (gnus-agent-retrieve-headers): Remove unused var `cached-articles'.
+ (gnus-agent-regenerate-group): Remove unused vars `point' and `dl'.
+ (gnus-agent-regenerate): Simplify interactive spec and doc.
+
+2013-09-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * gnus-int.el (gnus-open-server): Silence compiler.
+
+ * mm-decode.el (mm-add-meta-html-tag): Fix regexp matching meta tag.
+
+ * message.el (message-display-completion-list): Abolish.
+ (message-completion-in-region): Use display-completion-list.
+
+2013-09-17 Glenn Morris <rgm@gnu.org>
+
+ * gnus-util.el (gnus-message-with-timestamp-1):
+ Use `messages-buffer' function if available. Ignore read-only.
+
+2013-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * message.el (message-expand-group, message-completion-in-region):
+ Correct the order of start and end of a region.
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * mml2015.el (gnus-create-image): Autoload it.
+
+ * gnus-spec.el (gnus-xmas-format): Fix weird error call.
+
+ * gnus-html.el (declare-function): Add compat stub for ancient Emacs.
+ (image-size): Declare.
+
+2013-09-12 Glenn Morris <rgm@gnu.org>
+
+ * gnus-icalendar.el (gnus-icalendar-event--build-reply-event-body):
+ Avoid using `find', which i) might not be defined at runtime;
+ ii) does not work, since its default test is eql, not equal.
+ (gnus-mime-action-alist): Declare.
+
+2013-09-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * score-mode.el (gnus-score-mode-map): Move initialization
+ into declaration.
+ (gnus-score-mode): Use define-derived-mode.
+ * gnus-srvr.el (gnus-browse-mode): Use define-derived-mode.
+ * gnus-kill.el (gnus-kill-file-mode-map): Move initialization
+ into declaration.
+ (gnus-kill-file-mode): Use define-derived-mode.
+ (gnus-kill-file-edit-file, gnus-kill-file-enter-kill, gnus-kill):
+ Use derived-mode-p.
+ * gnus-group.el (gnus-group-mode): Use define-derived-mode.
+ (gnus-group-setup-buffer, gnus-group-name-at-point)
+ (gnus-group-make-web-group, gnus-group-enter-directory)
+ (gnus-group-suspend): Use derived-mode-p.
+ * gnus-cus.el (gnus-custom-mode): Use define-derived-mode.
+ * gnus-bookmark.el (gnus-bookmark-bmenu-mode): Use define-derived-mode.
+ * gnus-art.el (gnus-article-mode): Use define-derived-mode.
+ (gnus-article-setup-buffer, gnus-article-prepare)
+ (gnus-article-prepare-display, gnus-sticky-article)
+ (gnus-kill-sticky-article-buffer, gnus-kill-sticky-article-buffers)
+ (gnus-bind-safe-url-regexp, gnus-article-check-buffer)
+ (gnus-article-read-summary-keys): Use derived-mode-p.
+
+2013-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mm-decode.el (mm-temp-files-delete): Fix file deletion logic.
+
2013-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-util.el (mm-coding-system-priorities): Exclude iso-2022-jp-2 and
@@ -173,15 +1460,15 @@
2013-07-10 David Engster <deng@randomsample.de>
* gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks
- if `gnus-newsrc-file-version' does not match `gnus-version'. This
- fixes a bug in Emacs trunk where the 'unexist' marks were always
+ if `gnus-newsrc-file-version' does not match `gnus-version'.
+ This fixes a bug in Emacs trunk where the 'unexist' marks were always
removed at startup because "Gnus v5.13" was considered smaller than "Ma
Gnus v0.03".
2013-07-10 Tassilo Horn <tsdh@gnu.org>
- * gnus.el (gnus-summary-line-format): Reference
- `gnus-user-date-format-alist' for the &user-date; format, not
+ * gnus.el (gnus-summary-line-format):
+ Reference `gnus-user-date-format-alist' for the &user-date; format, not
`gnus-summary-user-date-format-alist'.
2013-07-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -257,7 +1544,7 @@
* nnimap.el (nnimap-request-head): Remove to-buffer argument.
* gnus-int.el (gnus-request-head): Remove to-buffer argument, only
- supported by nnimap actually. Reverts previous change.
+ supported by nnimap actually. Reverts previous change.
* gnus-int.el (gnus-request-head): Add an optional to-buffer parameter
to mimic `gnus-request-article' and enjoy backends the nn*-request-head
@@ -405,7 +1692,7 @@
2013-06-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-tag-table): Insert the images after the table, so that
- they're not covered by the table colourisation, which often looked
+ they're not covered by the table colorization, which often looked
awkward.
(shr-tag-dl, shr-tag-dt, shr-tag-dd): Add support for <dl>, <dt> and
<dd>.
@@ -463,7 +1750,7 @@
* shr.el (shr-render-td): Support horizontal alignment.
- * eww.el (eww-put-color): Removed.
+ * eww.el (eww-put-color): Remove.
(eww-colorize-region): Use `add-face-text-property'.
* shr.el (shr-add-font): Append face data, so that we get the correct
@@ -518,7 +1805,7 @@
2013-06-16 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
- * shr.el (shr-dom-to-xml): Fixed function call.
+ * shr.el (shr-dom-to-xml): Fix function call.
* eww.el (eww): New group.
(eww-header-line-format): New custom variable.
@@ -554,8 +1841,8 @@
(auth-source-netrc-parse): Refactor and improve netrc parser to support
single-quoted strings and multiline entries.
(auth-source-netrc-parse-next-interesting)
- (auth-source-netrc-parse-one, auth-source-netrc-parse-entries): New
- functions to support parser.
+ (auth-source-netrc-parse-one, auth-source-netrc-parse-entries):
+ New functions to support parser.
2013-06-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -625,7 +1912,7 @@
the work. Has the nice benefit of enabling STARTTLS.
Wait for capabilities after STARTTLS: following RFC5804, the server
sends new capabilities after successfully establishing a TLS connection
- with the client. The client should update the cached list of
+ with the client. The client should update the cached list of
capabilities, but we just ignore the answer for now.
(sieve-manage-network-p, sieve-manage-network-open)
(sieve-manage-starttls-p, sieve-manage-starttls-open)
@@ -675,7 +1962,7 @@
* sieve.el: Put point at beginning of buffer when viewing a script.
(sieve-open-server): Respect the PORT parameter. Show the correct port
number in sieve-buffer's header. Fixed code to also work with a string
- as port specifier. Properly close the connection on pressing 'q'. Make
+ as port specifier. Properly close the connection on pressing 'q'. Make
sieve-manage-quit close the connection and process buffer. Also, remove
duplicate keybinding for 'q'.
@@ -703,8 +1990,8 @@
* registry.el (initialize-instance, registry-lookup)
(registry-lookup-breaks-before-lexbind, registry-lookup-secondary)
(registry-lookup-secondary-value, registry-search, registry-delete)
- (registry-insert, registry-reindex, registry-size, registry-prune): Do
- not wrap methods in `eval-and-compile'. This breaks due to latest
+ (registry-insert, registry-reindex, registry-size, registry-prune):
+ Do not wrap methods in `eval-and-compile'. This breaks due to latest
changes in EIEIO (introduction of eieio-core.el).
2013-05-30 Glenn Morris <rgm@gnu.org>
@@ -984,8 +2271,8 @@
2013-03-26 Andrew Cohen <cohen@bu.edu>
* nnir.el: Major rewrite. Cleaner separation between searches and group
- management. Marks are now shown in nnir summary buffers. Rudimentary
- support for real (i.e. not ephemeral) nnir groups.
+ management. Marks are now shown in nnir summary buffers.
+ Rudimentary support for real (i.e. not ephemeral) nnir groups.
(gnus-summary-make-nnir-group): New function for initiating searches
from a summary buffer.
@@ -1008,14 +2295,14 @@
2013-02-25 Adam Sjøgren <asjo@koldfront.dk>
- * mml2015-el (mml2015-epg-key-image): Wrap epg-gpg-program in
+ * mml2015.el (mml2015-epg-key-image): Wrap epg-gpg-program in
shell-quote-argument.
2013-02-22 David Engster <deng@randomsample.de>
* gnus-registry.el (gnus-registry-save): Provide class name when
- calling `eieio-persistent-read' to avoid "unsafe call" warning. Use
- `condition-case' to stay compatible with older EIEIO versions which
+ calling `eieio-persistent-read' to avoid "unsafe call" warning.
+ Use `condition-case' to stay compatible with older EIEIO versions which
only accept one argument.
2013-02-17 Daiki Ueno <ueno@gnu.org>
@@ -5160,7 +6447,7 @@
2011-02-22 Andrew Cohen <cohen@andy.bu.edu>
- * nnir.el (nnir-imap-search-arguments,nnir-imap-default-search-key):
+ * nnir.el (nnir-imap-search-arguments, nnir-imap-default-search-key):
Lower case names of search constraints.
(nnir-run-query): Cache and reuse search constraints for all imap
servers.
@@ -5291,7 +6578,7 @@
a creation default, pass the whole port list down. It will be
completed.
- * auth-source.el (auth-source-search): Updated docs to talk about
+ * auth-source.el (auth-source-search): Update docs to talk about
multiple creation choices.
(auth-source-netrc-create): Accept a list as a value (from the search
parameters) and do completion on that list. Keep a separate netrc line
@@ -5358,7 +6645,7 @@
(gnus-summary-exit): Kill the correct article buffer on exit from a
`C-d' group.
- * gnus-start.el (gnus-use-backend-marks): Removed, since it duplicates
+ * gnus-start.el (gnus-use-backend-marks): Remove, since it duplicates
gnus-propagate-marks.
* gnus-sum.el (gnus-summary-exit-no-update): Restore the group conf
@@ -6463,7 +7750,7 @@
customizable.
(nnir-retrieve-headers): Remove obsolete subject-mangling code.
- * gnus-sum.el (nnir-article-group,nnir-article-rsv): Autoload macros
+ * gnus-sum.el (nnir-article-group, nnir-article-rsv): Autoload macros
from nnir.el.
2010-12-03 Julien Danjou <julien@danjou.info>
@@ -6490,7 +7777,7 @@
* nnir.el (nnir-summary-line-format): New variable.
(nnir-mode): Use it.
- (nnir-artlist-*,nnir-aritem-*): Reimplement as macros.
+ (nnir-artlist-*, nnir-aritem-*): Reimplement as macros.
(nnir-article-ids): Reimplement as defsubst.
(nnir-retrieve-headers): Don't mangle the subject header.
(nnir-run-imap): Use 100 as RSV score.
@@ -6521,7 +7808,7 @@
(nnir-mode): Install nnir-specific hooks for updating the registry.
* gnus-sum.el
- (gnus-article-original-subject,gnus-newsgroup-original-name):
+ (gnus-article-original-subject, gnus-newsgroup-original-name):
Remove obsolete variables.
(gnus-summary-move-article): Remove use of obsolete variables.
(gnus-summary-local-variables): Make move and delete hooks local to
@@ -7317,7 +8604,7 @@
long-lines case by only filling the long lines.
* nnimap.el (nnimap-parse-line): Don't bug out oddly formed replies
- (bug #7311).
+ (bug#7311).
2010-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -7397,7 +8684,7 @@
2010-10-31 Andrew Cohen <cohen@andy.bu.edu>
- * nnir.el (gnus-group-make-nnir-group,nnir-run-query): Allow searching
+ * nnir.el (gnus-group-make-nnir-group, nnir-run-query): Allow searching
an entire server.
(nnir-get-active): New function.
(nnir-run-imap): Use it.
@@ -7479,13 +8766,13 @@
* nnir.el: General clean up. Allow searching with multiple engines.
Allow separate extra-parameters for each engine.
Batch queries when possible.
- (nnir-imap-default-search-key,nnir-method-default-engines):
+ (nnir-imap-default-search-key, nnir-method-default-engines):
Add customize interface.
(nnir-run-gmane): New engine.
(nnir-engines): Use it. Qualify all prompts with engine name.
(nnir-search-engine): Remove global variable.
(nnir-run-hyrex): Restore for now.
- (nnir-extra-parms,nnir-search-history): New variables.
+ (nnir-extra-parms, nnir-search-history): New variables.
(gnus-group-make-nnir-group): Use them.
(nnir-group-server): Remove in favor of gnus-group-server.
(nnir-request-group): Avoid searching twice.
@@ -7819,7 +9106,7 @@
* gnus-agent.el (gnus-agent-toggle-plugged): Use the right minor mode
name in the mode line spec so that the mode line menu works
- (bug #2431).
+ (bug#2431).
* message.el (message-get-reply-headers): If we're fed `to-address',
then always use that.
@@ -7828,7 +9115,7 @@
aren't so wide as to need to switch off the edit menu.
* gnus-delay.el (gnus-delay-article): Remove superfluous `group'
- binding. Suggested by Leo <sdl.web@gmail.com> (bug #6613).
+ binding. Suggested by Leo <sdl.web@gmail.com> (bug#6613).
* nnimap.el (nnimap-request-group): Don't SELECT the group twice on
`M-g'.
@@ -8674,7 +9961,7 @@
2010-09-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * nnir.el: Use the server names without suffixes (bug #7009).
+ * nnir.el: Use the server names without suffixes (bug#7009).
* nnimap.el (nnimap-open-connection): Reinstate the auto-upgrade from
unencrypted to STARTTLS, if possible.
@@ -10660,7 +11947,7 @@
2010-07-13 Thierry Volpiatto <thierry.volpiatto@gmail.com>
- Allow bookmarks to be set from Gnus Article buffers (Bug #5975).
+ Allow bookmarks to be set from Gnus Article buffers (Bug#5975).
Patch applied (with minor tweaks) by Karl Fogel. Note this leaves
C-w still not working correctly from Article buffers; Thierry's
patch to fix that will be applied after this.
@@ -10884,7 +12171,7 @@
2010-05-01 Andreas Seltenreich <seltenreich@gmx.de>
- * mml.el (mml-generate-mime-1,mml-compute-boundary-1): Update 'mml
+ * mml.el (mml-generate-mime-1, mml-compute-boundary-1): Update 'mml
handles on recursive mml-to-mime translation and check them for
boundary delimiter collisions. Reported by Greg Troxel.
@@ -10946,7 +12233,7 @@
2010-03-30 Chong Yidong <cyd@stupidchicken.com>
- * message.el (message-default-mail-headers):
+ * message.el (message-default-mail-headers)
(message-default-headers): Carry the value mail-default-headers over
into message-default-mail-headers, rather than message-default-headers.
@@ -18295,7 +19582,7 @@
2005-12-12 Reiner Steib <Reiner.Steib@gmx.de>
* mm-uu.el (mm-uu-type-alist): Don't depend on message.el for
- message-marks (Debian bug #342521).
+ message-marks (Debian bug#342521).
2005-12-12 Simon Josefsson <jas@extundo.com>
@@ -18395,7 +19682,7 @@
2005-11-19 Kevin Greiner <kevin.greiner@compsol.cc>
- * gnus-sum.el (gnus-fetch-old-headers): Updated docs to warn that
+ * gnus-sum.el (gnus-fetch-old-headers): Update docs to warn that
it can seriously impact performance as it bypasses the agent's
local caches.
@@ -22920,7 +24207,7 @@
(spam-ham-copy-or-move-routine): Return the number of processed
ham messages.
(spam-summary-prepare-exit): Use the above values to decide
- whether status messages shouled be displayed.
+ whether status messages should be displayed.
2004-05-20 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -23474,10 +24761,10 @@
* gnus-group.el: Require gnus-sum and autoload functions to
resolve warnings when gnus-group.el compiled alone.
- (gnus-group-line-format): Documented new %F.
+ (gnus-group-line-format): Document new %F.
(size of Fetched data) group line format; identifies disk space
used by agent and cache.
- (gnus-group-line-format-alist): Defined new F format.
+ (gnus-group-line-format-alist): Define new F format.
(gnus-total-fetched-for): New function.
(gnus-group-delete-group): No longer update
gnus-cache-active-altered as gnus-request-delete-group now keeps
@@ -24966,10 +26253,10 @@
2002-08-07 Simon Josefsson <jas@extundo.com>
* sieve-manage.el (require): Use SASL, not RFC2104/MD5.
- (sieve-manage-authenticators):
+ (sieve-manage-authenticators)
(sieve-manage-authenticator-alist): Add some SASL mechs.
(sieve-sasl-auth): New function.
- (sieve-manage-cram-md5-auth):
+ (sieve-manage-cram-md5-auth)
(sieve-manage-plain-auth): Rewrite using SASL library.
(sieve-manage-digest-md5-p, sieve-manage-digest-md5-auth)
(sieve-manage-scram-md5-p, sieve-manage-scram-md5-auth)
@@ -25038,7 +26325,7 @@
See ChangeLog.2 for earlier changes.
- Copyright (C) 2004-2013 Free Software Foundation, Inc.
+ Copyright (C) 2004-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index 54429b5cfda..9d842c04f64 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -1,6 +1,6 @@
;;; auth-source.el --- authentication sources for Gnus and Emacs
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
@@ -63,10 +63,10 @@
(autoload 'plstore-save "plstore")
(autoload 'plstore-get-file "plstore")
+(eval-when-compile (require 'epg)) ;; setf-method for `epg-context-armor'
(autoload 'epg-make-context "epg")
(autoload 'epg-context-set-passphrase-callback "epg")
(autoload 'epg-decrypt-string "epg")
-(autoload 'epg-context-set-armor "epg")
(autoload 'epg-encrypt-string "epg")
(autoload 'help-mode "help-mode" nil t)
@@ -159,6 +159,7 @@ let-binding."
auth-source-protocols))
(defvar auth-source-creation-defaults nil
+ ;; FIXME: AFAICT this is not set (or let-bound) anywhere!
"Defaults for creating token values. Usually let-bound.")
(defvar auth-source-creation-prompts nil
@@ -176,7 +177,7 @@ let-binding."
(const :tag "Never save" nil)
(const :tag "Ask" ask)))
-;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") never) (t gpg)))
+;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") never) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
(defcustom auth-source-netrc-use-gpg-tokens 'never
@@ -194,8 +195,7 @@ Note that if EPA/EPG is not available, this should NOT be used."
(const :tag "Match anything" t)
(const :tag "The EPA encrypted file extensions"
,(if (boundp 'epa-file-auto-mode-alist-entry)
- (car (symbol-value
- 'epa-file-auto-mode-alist-entry))
+ (car epa-file-auto-mode-alist-entry)
"\\.gpg\\'"))
(regexp :tag "Regular expression"))
(choice :tag "What to do"
@@ -233,25 +233,23 @@ If the value is a function, debug messages are logged by calling
(defcustom auth-sources '("~/.authinfo" "~/.authinfo.gpg" "~/.netrc")
"List of authentication sources.
-
-The default will get login and password information from
-\"~/.authinfo.gpg\", which you should set up with the EPA/EPG
-packages to be encrypted. If that file doesn't exist, it will
-try the unencrypted version \"~/.authinfo\" and the famous
-\"~/.netrc\" file.
-
-See the auth.info manual for details.
-
Each entry is the authentication type with optional properties.
+Entries are tried in the order in which they appear.
+See Info node `(auth)Help for users' for details.
+
+If an entry names a file with the \".gpg\" extension and you have
+EPA/EPG set up, the file will be encrypted and decrypted
+automatically. See Info node `(epa)Encrypting/decrypting gpg files'
+for details.
-It's best to customize this with `M-x customize-variable' because the choices
+It's best to customize this with `\\[customize-variable]' because the choices
can get pretty complex."
:group 'auth-source
:version "24.1" ;; No Gnus
:type `(repeat :tag "Authentication Sources"
(choice
(string :tag "Just a file")
- (const :tag "Default Secrets API Collection" 'default)
+ (const :tag "Default Secrets API Collection" default)
(const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
@@ -270,7 +268,7 @@ can get pretty complex."
(const :format "" :value :secrets)
(choice :tag "Collection to use"
(string :tag "Collection name")
- (const :tag "Default" 'default)
+ (const :tag "Default" default)
(const :tag "Login" "Login")
(const
:tag "Temporary" "session")))
@@ -280,14 +278,14 @@ can get pretty complex."
:value :macos-keychain-internet)
(choice :tag "Collection to use"
(string :tag "internet Keychain path")
- (const :tag "default" 'default)))
+ (const :tag "default" default)))
(list
:tag "Mac OS generic Keychain"
(const :format ""
:value :macos-keychain-generic)
(choice :tag "Collection to use"
(string :tag "generic Keychain path")
- (const :tag "default" 'default))))
+ (const :tag "default" default))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list
@@ -342,12 +340,12 @@ If the value is not a list, symmetric encryption will be used."
;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
(defun auth-source-do-debug (&rest msg)
(when auth-source-debug
- (apply 'auth-source-do-warn msg)))
+ (apply #'auth-source-do-warn msg)))
(defun auth-source-do-trivia (&rest msg)
(when (or (eq auth-source-debug 'trivia)
(functionp auth-source-debug))
- (apply 'auth-source-do-warn msg)))
+ (apply #'auth-source-do-warn msg)))
(defun auth-source-do-warn (&rest msg)
(apply
@@ -364,10 +362,10 @@ If the value is not a list, symmetric encryption will be used."
"Read one of CHOICES by `read-char-choice', or `read-char'.
`dropdown-list' support is disabled because it doesn't work reliably.
Only one of CHOICES will be returned. The PROMPT is augmented
-with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
+with \"[a/b/c] \" if CHOICES is \(?a ?b ?c)."
(when choices
(let* ((prompt-choices
- (apply 'concat (loop for c in choices
+ (apply #'concat (loop for c in choices
collect (format "%c/" c))))
(prompt-choices (concat "[" (substring prompt-choices 0 -1) "] "))
(full-prompt (concat prompt prompt-choices))
@@ -450,15 +448,15 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
(plist-get entry :source)
:source (plist-get entry :source)
:type 'plstore
- :search-function 'auth-source-plstore-search
- :create-function 'auth-source-plstore-create
+ :search-function #'auth-source-plstore-search
+ :create-function #'auth-source-plstore-create
:data (plstore-open (plist-get entry :source)))
(auth-source-backend
(plist-get entry :source)
:source (plist-get entry :source)
:type 'netrc
- :search-function 'auth-source-netrc-search
- :create-function 'auth-source-netrc-create)))
+ :search-function #'auth-source-netrc-search
+ :create-function #'auth-source-netrc-create)))
;; the MacOS Keychain
((and
@@ -484,8 +482,8 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
(format "Mac OS Keychain (%s)" source)
:source source
:type keychain-type
- :search-function 'auth-source-macos-keychain-search
- :create-function 'auth-source-macos-keychain-create)))
+ :search-function #'auth-source-macos-keychain-search
+ :create-function #'auth-source-macos-keychain-create)))
;; the Secrets API. We require the package, in order to have a
;; defined value for `secrets-enabled'.
@@ -511,8 +509,8 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
(format "Secrets API (%s)" source)
:source source
:type 'secrets
- :search-function 'auth-source-secrets-search
- :create-function 'auth-source-secrets-create)
+ :search-function #'auth-source-secrets-search
+ :create-function #'auth-source-secrets-create)
(auth-source-do-warn
"auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
(auth-source-backend
@@ -524,8 +522,7 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
(t
(auth-source-do-warn
"auth-source-backend-parse: invalid backend spec: %S" entry)
- (auth-source-backend
- "Empty"
+ (make-instance 'auth-source-backend
:source ""
:type 'ignore)))))
@@ -548,7 +545,7 @@ parameters."
;; (mapcar 'auth-source-backend-parse auth-sources)
(defun* auth-source-search (&rest spec
- &key type max host user port secret
+ &key max
require create delete
&allow-other-keys)
"Search or modify authentication backends according to SPEC.
@@ -562,7 +559,7 @@ other properties will always hold scalar values.
Typically the :secret property, if present, contains a password.
Common search keys are :max, :host, :port, and :user. In
-addition, :create specifies how tokens will be or created.
+addition, :create specifies if and how tokens will be created.
Finally, :type can specify which backend types you want to check.
A string value is always matched literally. A symbol is matched
@@ -579,25 +576,25 @@ port keys.
Here's an example:
-\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\"))))
- (auth-source-search :host \"mine\" :type 'netrc :max 1
+ (auth-source-search :host \"mine\" :type \\='netrc :max 1
:P \"pppp\" :Q \"qqqq\"
:create t))
which says:
-\"Search for any entry matching host 'mine' in backends of type
- 'netrc', maximum one result.
+\"Search for any entry matching host `mine' in backends of type
+ `netrc', maximum one result.
Create a new entry if you found none. The netrc backend will
automatically require host, user, and port. The host will be
- 'mine'. We prompt for the user with default 'defaultUser' and
+ `mine'. We prompt for the user with default `defaultUser' and
for the port without a default. We will not prompt for A, Q,
or P. The resulting token will only have keys user, host, and
port.\"
-:create '(A B C) also means to create a token if possible.
+:create \\='(A B C) also means to create a token if possible.
The behavior is like :create t but if the list contains any
parameter, that parameter will be required in the resulting
@@ -606,32 +603,32 @@ search parameters or from user input. If any queries are needed,
the alist `auth-source-creation-defaults' will be checked for the
default value. If the user, host, or port are missing, the alist
`auth-source-creation-prompts' will be used to look up the
-prompts IN THAT ORDER (so the 'user prompt will be queried first,
-then 'host, then 'port, and finally 'secret). Each prompt string
+prompts IN THAT ORDER (so the `user' prompt will be queried first,
+then `host', then `port', and finally `secret'). Each prompt string
can use %u, %h, and %p to show the user, host, and port.
Here's an example:
-\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+\(let ((auth-source-creation-defaults \\='((user . \"defaultUser\")
(A . \"default A\")))
(auth-source-creation-prompts
- '((password . \"Enter IMAP password for %h:%p: \"))))
- (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
+ \\='((password . \"Enter IMAP password for %h:%p: \"))))
+ (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1
:P \"pppp\" :Q \"qqqq\"
- :create '(A B Q)))
+ :create \\='(A B Q)))
which says:
-\"Search for any entry matching host 'nonesuch'
- or 'twosuch' in backends of type 'netrc', maximum one result.
+\"Search for any entry matching host `nonesuch'
+ or `twosuch' in backends of type `netrc', maximum one result.
Create a new entry if you found none. The netrc backend will
automatically require host, user, and port. The host will be
- 'nonesuch' and Q will be 'qqqq'. We prompt for the password
+ `nonesuch' and Q will be `qqqq'. We prompt for the password
with the shown prompt. We will not prompt for Q. The resulting
token will have keys user, host, port, A, B, and Q. It will not
have P with any value, even though P is used in the search to
- find only entries that have P set to 'pppp'.\"
+ find only entries that have P set to `pppp'.\"
When multiple values are specified in the search parameter, the
user is prompted for which one. So :host (X Y Z) would ask the
@@ -652,13 +649,15 @@ property.
Use `auth-source-delete' in ELisp code instead of calling
`auth-source-search' directly with this parameter.
-:type (X Y Z) will check only those backend types. 'netrc and
-'secrets are the only ones supported right now.
+:type (X Y Z) will check only those backend types. `netrc' and
+`secrets' are the only ones supported right now.
:max N means to try to return at most N items (defaults to 1).
-When 0 the function will return just t or nil to indicate if any
-matches were found. More than N items may be returned, depending
-on the search and the backend.
+More than N items may be returned, depending on the search and
+the backend.
+
+When :max is 0 the function will return just t or nil to indicate
+if any matches were found.
:host (X Y Z) means to match only hosts X, Y, or Z according to
the match rules above. Defaults to t.
@@ -685,7 +684,7 @@ actually useful. So the caller must arrange to call this function.
The token's :secret key can hold a function. In that case you
must call it to obtain the actual value."
- (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
+ (let* ((backends (mapcar #'auth-source-backend-parse auth-sources))
(max (or max 1))
(ignored-keys '(:require :create :delete :max))
(keys (loop for i below (length spec) by 2
@@ -695,7 +694,7 @@ must call it to obtain the actual value."
;; note that we may have cached results but found is still nil
;; (there were no results from the search)
(found (auth-source-recall spec))
- filtered-backends accessor-key backend)
+ filtered-backends)
(if (and cached auth-source-do-cache)
(auth-source-do-debug
@@ -714,13 +713,13 @@ must call it to obtain the actual value."
(dolist (backend backends)
(dolist (key keys)
;; ignore invalid slots
- (condition-case signal
- (unless (eval `(auth-source-search-collection
- (plist-get spec key)
- (oref backend ,key)))
+ (condition-case nil
+ (unless (auth-source-search-collection
+ (plist-get spec key)
+ (slot-value backend key))
(setq filtered-backends (delq backend filtered-backends))
(return))
- (invalid-slot-name))))
+ (invalid-slot-name nil))))
(auth-source-do-trivia
"auth-source-search: found %d backends matching %S"
@@ -759,18 +758,22 @@ must call it to obtain the actual value."
(when auth-source-do-cache
(auth-source-remember spec found)))
- found))
+ (if (zerop max)
+ (not (null found))
+ found)))
(defun auth-source-search-backends (backends spec max create delete require)
- (let (matches)
+ (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero
+ matches)
(dolist (backend backends)
- (when (> max (length matches)) ; when we need more matches...
+ (when (> max (length matches)) ; if we need more matches...
(let* ((bmatches (apply
(slot-value backend 'search-function)
:backend backend
- :type (slot-value backend :type)
+ :type (slot-value backend 'type)
;; note we're overriding whatever the spec
- ;; has for :require, :create, and :delete
+ ;; has for :max, :require, :create, and :delete
+ :max max
:require require
:create create
:delete delete
@@ -779,20 +782,19 @@ must call it to obtain the actual value."
(auth-source-do-trivia
"auth-source-search-backend: got %d (max %d) in %s:%s matching %S"
(length bmatches) max
- (slot-value backend :type)
- (slot-value backend :source)
+ (slot-value backend 'type)
+ (slot-value backend 'source)
spec)
(setq matches (append matches bmatches))))))
matches))
+;; (auth-source-search :max 0)
;; (auth-source-search :max 1)
;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
;; (auth-source-search :host "nonesuch" :type 'secrets)
-(defun* auth-source-delete (&rest spec
- &key delete
- &allow-other-keys)
+(defun auth-source-delete (&rest spec)
"Delete entries from the authentication backends according to SPEC.
Calls `auth-source-search' with the :delete property in SPEC set to t.
The backend may not actually delete the entries.
@@ -861,7 +863,7 @@ Returns t or nil for forgotten or not found."
;; (auth-source-recall '(:host t))
;; (auth-source-forget+ :host t)
-(defun* auth-source-forget+ (&rest spec &allow-other-keys)
+(defun auth-source-forget+ (&rest spec)
"Forget any cached data matching SPEC. Returns forgotten count.
This is not a full `auth-source-search' spec but works similarly.
@@ -897,7 +899,7 @@ while \(:host t) would find all host entries."
;; (auth-source-pick-first-password :port "imap")
(defun auth-source-pick-first-password (&rest spec)
"Pick the first secret found from applying SPEC to `auth-source-search'."
- (let* ((result (nth 0 (apply 'auth-source-search (plist-put spec :max 1))))
+ (let* ((result (nth 0 (apply #'auth-source-search (plist-put spec :max 1))))
(secret (plist-get result :secret)))
(if (functionp secret)
@@ -943,9 +945,7 @@ while \(:host t) would find all host entries."
(cdr (assoc key alist)))
;; (auth-source-netrc-parse :file "~/.authinfo.gpg")
-(defun* auth-source-netrc-parse (&rest
- spec
- &key file max host user port delete require
+(defun* auth-source-netrc-parse (&key file max host user port require
&allow-other-keys)
"Parse FILE and return a list of all entries in the file.
Note that the MAX parameter is used so we can exit the parse early."
@@ -1006,8 +1006,8 @@ Note that the MAX parameter is used so we can exit the parse early."
(auth-source--aput
auth-source-netrc-cache file
(list :mtime (nth 5 (file-attributes file))
- :secret (lexical-let ((v (mapcar '1+ (buffer-string))))
- (lambda () (apply 'string (mapcar '1- v)))))))
+ :secret (lexical-let ((v (mapcar #'1+ (buffer-string))))
+ (lambda () (apply #'string (mapcar #'1- v)))))))
(goto-char (point-min))
(let ((entries (auth-source-netrc-parse-entries check max))
alist)
@@ -1092,7 +1092,7 @@ Note that the MAX parameter is used so we can exit the parse early."
(if (equal item2 "machine")
(progn
(gnus-error 1
- "%s: Unexpected 'machine' token at line %d"
+ "%s: Unexpected `machine' token at line %d"
"auth-source-netrc-parse-entries"
(auth-source-current-line))
(forward-line 1))
@@ -1108,7 +1108,7 @@ Note that the MAX parameter is used so we can exit the parse early."
(defvar auth-source-passphrase-alist nil)
-(defun auth-source-token-passphrase-callback-function (context key-id file)
+(defun auth-source-token-passphrase-callback-function (_context _key-id file)
(let* ((file (file-truename file))
(entry (assoc file auth-source-passphrase-alist))
passphrase)
@@ -1134,20 +1134,21 @@ Note that the MAX parameter is used so we can exit the parse early."
FILE is the file from which we obtained this token."
(when (string-match "^gpg:\\(.+\\)" secret)
(setq secret (base64-decode-string (match-string 1 secret))))
- (let ((context (epg-make-context 'OpenPGP))
- plain)
+ (let ((context (epg-make-context 'OpenPGP)))
(epg-context-set-passphrase-callback
context
(cons #'auth-source-token-passphrase-callback-function
file))
(epg-decrypt-string context secret)))
+(defvar pp-escape-newlines)
+
;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
(defun auth-source-epa-make-gpg-token (secret file)
(let ((context (epg-make-context 'OpenPGP))
(pp-escape-newlines nil)
cipher)
- (epg-context-set-armor context t)
+ (setf (epg-context-armor context) t)
(epg-context-set-passphrase-callback
context
(cons #'auth-source-token-passphrase-callback-function
@@ -1160,6 +1161,9 @@ FILE is the file from which we obtained this token."
(point-min)
(point-max))))))
+(defun auto-source--symbol-keyword (symbol)
+ (intern (format ":%s" symbol)))
+
(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
(let (ret item)
@@ -1193,7 +1197,7 @@ FILE is the file from which we obtained this token."
(setq lexv (funcall token-decoder lexv)))
lexv))))
(setq ret (plist-put ret
- (intern (concat ":" k))
+ (auto-source--symbol-keyword k)
v))))
ret))
alist))
@@ -1203,7 +1207,7 @@ FILE is the file from which we obtained this token."
(defun* auth-source-netrc-search (&rest
spec
- &key backend require create delete
+ &key backend require create
type max host user port
&allow-other-keys)
"Given a property list SPEC, return search matches from the :backend.
@@ -1216,7 +1220,6 @@ See `auth-source-search' for details on SPEC."
(auth-source-netrc-parse
:max max
:require require
- :delete delete
:file (oref backend source)
:host (or host t)
:user (or user t)
@@ -1236,7 +1239,7 @@ See `auth-source-search' for details on SPEC."
;; to get the updated data.
;; the result will be returned, even if the search fails
- (apply 'auth-source-netrc-search
+ (apply #'auth-source-netrc-search
(plist-put spec :create nil)))))
results))
@@ -1250,7 +1253,7 @@ See `auth-source-search' for details on SPEC."
(defun* auth-source-netrc-create (&rest spec
&key backend
- secret host user port create
+ host port create
&allow-other-keys)
(let* ((base-required '(host user port secret))
;; we know (because of an assertion in auth-source-search) that the
@@ -1271,23 +1274,23 @@ See `auth-source-search' for details on SPEC."
;; fill in the valist with whatever data we may have from the search
;; we complete the first value if it's a list and use the value otherwise
(dolist (br base-required)
- (when (symbol-value br)
- (let ((br-choice (cond
- ;; all-accepting choice (predicate is t)
- ((eq t (symbol-value br)) nil)
- ;; just the value otherwise
- (t (symbol-value br)))))
- (when br-choice
- (auth-source--aput valist br br-choice)))))
+ (let ((val (plist-get spec (auto-source--symbol-keyword br))))
+ (when val
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t val) nil)
+ ;; just the value otherwise
+ (t val))))
+ (when br-choice
+ (auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
- (let ((name (concat ":" (symbol-name er)))
+ (let ((k (auto-source--symbol-keyword er))
(keys (loop for i below (length spec) by 2
collect (nth i spec))))
- (dolist (k keys)
- (when (equal (symbol-name k) name)
- (auth-source--aput valist er (plist-get spec k))))))
+ (when (memq k keys)
+ (auth-source--aput valist er (plist-get spec k)))))
;; for each required element
(dolist (r required)
@@ -1295,7 +1298,7 @@ See `auth-source-search' for details on SPEC."
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
- (intern (format ":%s" r) obarray))))
+ (auto-source--symbol-keyword r))))
;; this is the default to be offered
(given-default (auth-source--aget
auth-source-creation-defaults r))
@@ -1342,7 +1345,7 @@ See `auth-source-search' for details on SPEC."
(setq data (or data
(if (eq r 'secret)
;; Special case prompt for passwords.
- ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
+ ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car epa-file-auto-mode-alist-entry) "\\.gpg\\'") nil) (t gpg)))
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
(let* ((ep (format "Use GPG password tokens in %s?" file))
(gpg-encrypt
@@ -1358,7 +1361,10 @@ See `auth-source-search' for details on SPEC."
(when (or (eq (car item) t)
(string-match (car item) file))
(setq ret (cdr item))
- (setq check nil)))))
+ (setq check nil)))
+ ;; FIXME: `ret' unused.
+ ;; Should we return it here?
+ ))
(t 'never)))
(plain (or (eval default) (read-passwd prompt))))
;; ask if we don't know what to do (in which case
@@ -1382,7 +1388,7 @@ See `auth-source-search' for details on SPEC."
(when data
(setq artificial (plist-put artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
(if (eq r 'secret)
(lexical-let ((data data))
(lambda () data))
@@ -1508,10 +1514,34 @@ Respects `auth-source-save-behavior'. Uses
;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
+(defun auth-source-secrets-listify-pattern (pattern)
+ "Convert a pattern with lists to a list of string patterns.
+
+auth-source patterns can have values of the form :foo (\"bar\"
+\"qux\"), which means to match any secret with :foo equal to
+\"bar\" or :foo equal to \"qux\". The secrets backend supports
+only string values for patterns, so this routine returns a list
+of patterns that is equivalent to the single original pattern
+when interpreted such that if a secret matches any pattern in the
+list, it matches the original pattern."
+ (if (null pattern)
+ '(nil)
+ (let* ((key (pop pattern))
+ (value (pop pattern))
+ (tails (auth-source-secrets-listify-pattern pattern))
+ (heads (if (stringp value)
+ (list (list key value))
+ (mapcar (lambda (v) (list key v)) value))))
+ (loop
+ for h in heads
+ nconc
+ (loop
+ for tl in tails
+ collect (append h tl))))))
+
(defun* auth-source-secrets-search (&rest
spec
- &key backend create delete label
- type max host user port
+ &key backend create delete label max
&allow-other-keys)
"Search the Secrets API; spec is like `auth-source'.
@@ -1524,23 +1554,23 @@ matching, do a wider search and narrow it down yourself.
You'll get back all the properties of the token as a plist.
-Here's an example that looks for the first item in the 'Login'
+Here's an example that looks for the first item in the `Login'
Secrets collection:
- \(let ((auth-sources '(\"secrets:Login\")))
+ (let ((auth-sources \\='(\"secrets:Login\")))
(auth-source-search :max 1)
-Here's another that looks for the first item in the 'Login'
-Secrets collection whose label contains 'gnus':
+Here's another that looks for the first item in the `Login'
+Secrets collection whose label contains `gnus':
- \(let ((auth-sources '(\"secrets:Login\")))
+ (let ((auth-sources \\='(\"secrets:Login\")))
(auth-source-search :max 1 :label \"gnus\")
-And this one looks for the first item in the 'Login' Secrets
+And this one looks for the first item in the `Login' Secrets
collection that's a Google Chrome entry for the git.gnus.org site
authentication tokens:
- \(let ((auth-sources '(\"secrets:Login\")))
+ (let ((auth-sources \\='(\"secrets:Login\")))
(auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
"
@@ -1560,21 +1590,25 @@ authentication tokens:
collect (nth i spec)))
;; build a search spec without the ignored keys
;; if a search key is nil or t (match anything), we skip it
- (search-spec (apply 'append (mapcar
+ (search-specs (auth-source-secrets-listify-pattern
+ (apply #'append (mapcar
(lambda (k)
(if (or (null (plist-get spec k))
(eq t (plist-get spec k)))
nil
(list k (plist-get spec k))))
- search-keys)))
+ search-keys))))
;; needed keys (always including host, login, port, and secret)
(returned-keys (mm-delete-duplicates (append
'(:host :login :port :secret)
search-keys)))
- (items (loop for item in (apply 'secrets-search-items coll search-spec)
- unless (and (stringp label)
- (not (string-match label item)))
- collect item))
+ (items
+ (loop for search-spec in search-specs
+ nconc
+ (loop for item in (apply #'secrets-search-items coll search-spec)
+ unless (and (stringp label)
+ (not (string-match label item)))
+ collect item)))
;; TODO: respect max in `secrets-search-items', not after the fact
(items (butlast items (- (length items) max)))
;; convert the item name to a full plist
@@ -1586,7 +1620,7 @@ authentication tokens:
(lexical-let ((v (secrets-get-secret coll item)))
(lambda () v)))
;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
- (apply 'append
+ (apply #'append
(mapcar (lambda (entry)
(list (car entry) (cdr entry)))
(secrets-get-attributes coll item)))))
@@ -1594,7 +1628,7 @@ authentication tokens:
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
@@ -1604,10 +1638,7 @@ authentication tokens:
items)))
items))
-(defun* auth-source-secrets-create (&rest
- spec
- &key backend type max host user port
- &allow-other-keys)
+(defun auth-source-secrets-create (&rest spec)
;; TODO
;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec)
(debug spec))
@@ -1626,11 +1657,12 @@ authentication tokens:
;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1))
;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org"))
+;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1))
(defun* auth-source-macos-keychain-search (&rest
spec
- &key backend create delete label
- type max host user port
+ &key backend create delete
+ type max
&allow-other-keys)
"Search the MacOS Keychain; spec is like `auth-source'.
@@ -1639,14 +1671,14 @@ matching, do a wider search and narrow it down yourself.
You'll get back all the properties of the token as a plist.
-The :type key is either 'macos-keychain-internet or
-'macos-keychain-generic.
+The :type key is either `macos-keychain-internet' or
+`macos-keychain-generic'.
For the internet keychain type, the :label key searches the
item's labels (\"-l LABEL\" passed to \"/usr/bin/security\").
Similarly, :host maps to \"-s HOST\", :user maps to \"-a USER\",
and :port maps to \"-P PORT\" or \"-r PROT\"
-(note PROT has to be a 4-character string).
+\(note PROT has to be a 4-character string).
For the generic keychain type, the :label key searches the item's
labels (\"-l LABEL\" passed to \"/usr/bin/security\").
@@ -1656,19 +1688,19 @@ field), :user maps to \"-a USER\", and :port maps to \"-s PORT\".
Here's an example that looks for the first item in the default
generic MacOS Keychain:
- \(let ((auth-sources '(macos-keychain-generic)))
+ (let ((auth-sources \\='(macos-keychain-generic)))
(auth-source-search :max 1)
Here's another that looks for the first item in the internet
-MacOS Keychain collection whose label is 'gnus':
+MacOS Keychain collection whose label is `gnus':
- \(let ((auth-sources '(macos-keychain-internet)))
+ (let ((auth-sources \\='(macos-keychain-internet)))
(auth-source-search :max 1 :label \"gnus\")
And this one looks for the first item in the internet keychain
entries for git.gnus.org:
- \(let ((auth-sources '(macos-keychain-internet\")))
+ (let ((auth-sources \\='(macos-keychain-internet\")))
(auth-source-search :max 1 :host \"git.gnus.org\"))
"
;; TODO
@@ -1687,7 +1719,7 @@ entries for git.gnus.org:
collect (nth i spec)))
;; build a search spec without the ignored keys
;; if a search key is nil or t (match anything), we skip it
- (search-spec (apply 'append (mapcar
+ (search-spec (apply #'append (mapcar
(lambda (k)
(if (or (null (plist-get spec k))
(eq t (plist-get spec k)))
@@ -1698,7 +1730,7 @@ entries for git.gnus.org:
(returned-keys (mm-delete-duplicates (append
'(:host :login :port :secret)
search-keys)))
- (items (apply 'auth-source-macos-keychain-search-items
+ (items (apply #'auth-source-macos-keychain-search-items
coll
type
max
@@ -1707,7 +1739,7 @@ entries for git.gnus.org:
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
@@ -1717,8 +1749,7 @@ entries for git.gnus.org:
items)))
items))
-(defun* auth-source-macos-keychain-search-items (coll type max
- &rest spec
+(defun* auth-source-macos-keychain-search-items (coll _type _max
&key label type
host user port
&allow-other-keys)
@@ -1747,55 +1778,52 @@ entries for git.gnus.org:
(setq args (append args (list coll))))
(with-temp-buffer
- (apply 'call-process "/usr/bin/security" nil t nil args)
+ (apply #'call-process "/usr/bin/security" nil t nil args)
(goto-char (point-min))
(while (not (eobp))
(cond
((looking-at "^password: \"\\(.+\\)\"$")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "secret"
- (lexical-let ((v (match-string 1)))
- (lambda () v))))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "secret"
+ (lexical-let ((v (match-string 1)))
+ (lambda () v)))))
;; TODO: check if this is really the label
;; match 0x00000007 <blob>="AppleID"
((looking-at "^[ ]+0x00000007 <blob>=\"\\(.+\\)\"")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "label"
- (match-string 1)))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "label"
+ (match-string 1))))
;; match "crtr"<uint32>="aapl"
;; match "svce"<blob>="AppleID"
((looking-at "^[ ]+\"\\([a-z]+\\)\"[^=]+=\"\\(.+\\)\"")
- (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- (match-string 1)
- (match-string 2))))
- (forward-line)))
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ (match-string 1)
+ (match-string 2)))))
+ (forward-line)))
;; return `ret' iff it has the :secret key
(and (plist-get ret :secret) (list ret))))
(defun auth-source-macos-keychain-result-append (result generic k v)
(push v result)
- (setq k (cond
- ((equal k "acct") "user")
- ;; for generic keychains, creator is host, service is port
- ((and generic (equal k "crtr")) "host")
- ((and generic (equal k "svce")) "port")
- ;; for internet keychains, protocol is port, server is host
- ((and (not generic) (equal k "ptcl")) "port")
- ((and (not generic) (equal k "srvr")) "host")
- (t k)))
-
- (push (intern (format ":%s" k)) result))
-
-(defun* auth-source-macos-keychain-create (&rest
- spec
- &key backend type max host user port
- &allow-other-keys)
+ (push (auto-source--symbol-keyword
+ (cond
+ ((equal k "acct") "user")
+ ;; for generic keychains, creator is host, service is port
+ ((and generic (equal k "crtr")) "host")
+ ((and generic (equal k "svce")) "port")
+ ;; for internet keychains, protocol is port, server is host
+ ((and (not generic) (equal k "ptcl")) "port")
+ ((and (not generic) (equal k "srvr")) "host")
+ (t k)))
+ result))
+
+(defun auth-source-macos-keychain-create (&rest spec)
;; TODO
(debug spec))
@@ -1803,8 +1831,8 @@ entries for git.gnus.org:
(defun* auth-source-plstore-search (&rest
spec
- &key backend create delete label
- type max host user port
+ &key backend create delete
+ max
&allow-other-keys)
"Search the PLSTORE; spec is like `auth-source'."
(let* ((store (oref backend data))
@@ -1815,7 +1843,7 @@ entries for git.gnus.org:
collect (nth i spec)))
;; build a search spec without the ignored keys
;; if a search key is nil or t (match anything), we skip it
- (search-spec (apply 'append (mapcar
+ (search-spec (apply #'append (mapcar
(lambda (k)
(let ((v (plist-get spec k)))
(if (or (null v)
@@ -1846,7 +1874,7 @@ entries for git.gnus.org:
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (apply 'append
+ (apply #'append
(mapcar (lambda (req)
(if (plist-get plist req)
nil
@@ -1868,7 +1896,7 @@ entries for git.gnus.org:
;; to get the updated data.
;; the result will be returned, even if the search fails
- (apply 'auth-source-plstore-search
+ (apply #'auth-source-plstore-search
(plist-put spec :create nil)))))
((and delete
item-names)
@@ -1879,7 +1907,7 @@ entries for git.gnus.org:
(defun* auth-source-plstore-create (&rest spec
&key backend
- secret host user port create
+ host port create
&allow-other-keys)
(let* ((base-required '(host user port secret))
(base-secret '(secret))
@@ -1890,8 +1918,6 @@ entries for git.gnus.org:
:host host
:port port)))
(required (append base-required create-extra))
- (file (oref backend source))
- (add "")
;; `valist' is an alist
valist
;; `artificial' will be returned if no creation is needed
@@ -1902,23 +1928,23 @@ entries for git.gnus.org:
;; fill in the valist with whatever data we may have from the search
;; we complete the first value if it's a list and use the value otherwise
(dolist (br base-required)
- (when (symbol-value br)
- (let ((br-choice (cond
- ;; all-accepting choice (predicate is t)
- ((eq t (symbol-value br)) nil)
- ;; just the value otherwise
- (t (symbol-value br)))))
- (when br-choice
- (auth-source--aput valist br br-choice)))))
+ (let ((val (plist-get spec (auto-source--symbol-keyword br))))
+ (when val
+ (let ((br-choice (cond
+ ;; all-accepting choice (predicate is t)
+ ((eq t val) nil)
+ ;; just the value otherwise
+ (t val))))
+ (when br-choice
+ (auth-source--aput valist br br-choice))))))
;; for extra required elements, see if the spec includes a value for them
(dolist (er create-extra)
- (let ((name (concat ":" (symbol-name er)))
+ (let ((k (auto-source--symbol-keyword er))
(keys (loop for i below (length spec) by 2
collect (nth i spec))))
- (dolist (k keys)
- (when (equal (symbol-name k) name)
- (auth-source--aput valist er (plist-get spec k))))))
+ (when (memq k keys)
+ (auth-source--aput valist er (plist-get spec k)))))
;; for each required element
(dolist (r required)
@@ -1926,7 +1952,7 @@ entries for git.gnus.org:
;; take the first element if the data is a list
(data (or (auth-source-netrc-element-or-first data)
(plist-get current-data
- (intern (format ":%s" r) obarray))))
+ (auto-source--symbol-keyword r))))
;; this is the default to be offered
(given-default (auth-source--aget
auth-source-creation-defaults r))
@@ -1986,10 +2012,10 @@ entries for git.gnus.org:
(if (member r base-secret)
(setq secret-artificial
(plist-put secret-artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
data))
(setq artificial (plist-put artificial
- (intern (concat ":" (symbol-name r)))
+ (auto-source--symbol-keyword r)
data))))))
(plstore-put (oref backend data)
(sha1 (format "%s@%s:%s"
@@ -2040,9 +2066,9 @@ MODE can be \"login\" or \"password\"."
(let* ((listy (listp mode))
(mode (if listy mode (list mode)))
- (cname (if username
- (format "%s %s:%s %s" mode host port username)
- (format "%s %s:%s" mode host port)))
+ ;; (cname (if username
+ ;; (format "%s %s:%s %s" mode host port username)
+ ;; (format "%s %s:%s" mode host port)))
(search (list :host host :port port))
(search (if username (append search (list :user username)) search))
(search (if create-missing
@@ -2068,7 +2094,7 @@ MODE can be \"login\" or \"password\"."
host port username)
found) ; return the found data
;; else, if not found, search with a max of 1
- (let ((choice (nth 0 (apply 'auth-source-search
+ (let ((choice (nth 0 (apply #'auth-source-search
(append '(:max 1) search)))))
(when choice
(dolist (m mode)
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index 0c5de352a77..6ebd5338087 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -1,6 +1,6 @@
;;; canlock.el --- functions for Cancel-Lock feature
-;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
@@ -35,8 +35,9 @@
;; Verifying Cancel-Lock is mainly a function of news servers, however,
;; you can verify your own article using the command `canlock-verify' in
;; the (raw) article buffer. You will be prompted for the password for
-;; each time if the option `canlock-password' or `canlock-password-for-
-;; verify' is nil. Note that setting these options is a bit unsafe.
+;; each time if the option `canlock-password' or
+;; `canlock-password-for-verify' is nil. Note that setting these
+;; options is a bit unsafe.
;;; Code:
diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el
index e0a09a4c603..713770d7bcc 100644
--- a/lisp/gnus/compface.el
+++ b/lisp/gnus/compface.el
@@ -1,6 +1,6 @@
;;; compface.el --- functions for converting X-Face headers
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index 36e91980ba2..b2a725b5402 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -1,6 +1,6 @@
;;; deuglify.el --- deuglify broken Outlook (Express) articles
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Raymond Scholz <rscholz@zonix.de>
;; Thomas Steffen
@@ -78,7 +78,7 @@
;; `gnus-outlook-deuglify-unwrap-stop-chars'. Setting this to ".?!"
;; inhibits unwrapping if the cited line ends with a full stop,
;; question mark or exclamation mark. Note that this variable
-;; defaults to `nil', triggering a few false positives but generally
+;; defaults to nil, triggering a few false positives but generally
;; giving you better results.
;;
;; Unwrapping works on every level of citation. Thus you will be able
@@ -110,7 +110,7 @@
;; > Bye, John
;;
;; Repairing the attribution line will be done by function
-;; `gnus-article-outlook-repair-attribution which calls other function that
+;; `gnus-article-outlook-repair-attribution' which calls other function that
;; try to recognize and repair broken attribution lines. See variable
;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be
;; cut off from the beginning of an attribution line and variable
@@ -121,7 +121,7 @@
;; Rearranging the article so that the cited text appears above the
;; new text will be done by function
;; `gnus-article-outlook-rearrange-citation'. This function calls
-;; `gnus-article-outlook-repair-attribution to find and repair an attribution
+;; `gnus-article-outlook-repair-attribution' to find and repair an attribution
;; line.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -177,18 +177,18 @@
;; As I said before there may (or will) be a few false positives on
;; unwrapping cited lines with `gnus-article-outlook-unwrap-lines'.
;;
-;; `gnus-article-outlook-repair-attribution will only fix the first
+;; `gnus-article-outlook-repair-attribution' will only fix the first
;; attribution line found in the article. Furthermore it fixed to
;; certain kinds of attributions. And there may be horribly many
;; false positives, vanishing lines and so on -- so don't trust your
;; eyes. Again I recommend manual invocation.
;;
;; `gnus-article-outlook-rearrange-citation' carries all the limitations of
-;; `gnus-article-outlook-repair-attribution.
+;; `gnus-article-outlook-repair-attribution'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
-;; See ChangeLog for other changes.
+;; See commit log for other changes.
;;
;; Revision 1.5 2002/01/27 14:39:17 rscholz
;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
index 63e74a4c14b..329681f19eb 100644
--- a/lisp/gnus/ecomplete.el
+++ b/lisp/gnus/ecomplete.el
@@ -1,6 +1,6 @@
;;; ecomplete.el --- electric completion of addresses and the like
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index 2c36095f181..ff5316e782e 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -1,6 +1,6 @@
;;; flow-fill.el --- interpret RFC2646 "flowed" text
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 8bafb7d0f6b..ab22ab8b88a 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -1,6 +1,6 @@
;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Reiner Steib <reiner.steib@gmx.de>
;; Keywords: news
@@ -99,7 +99,7 @@ ARGS are passed to `message'."
;; Copy of the `nnmail-lazy' code from `nnmail.el':
(define-widget 'gmm-lazy 'default
- "Base widget for recursive datastructures.
+ "Base widget for recursive data structures.
This is a copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
:format "%{%t%}: %v"
@@ -328,7 +328,7 @@ compatibility with versions of Emacs that lack the variable
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
(image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
+ (when (boundp \\='image-load-path)
image-load-path))))
(mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
@@ -441,6 +441,39 @@ rather than relying on `lexical-binding'.
`(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels))
,bindings ,@body))
(put 'gmm-labels 'lisp-indent-function 1)
+(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
+
+(defun gmm-format-time-string (format-string &optional time tz)
+ "Use FORMAT-STRING to format the time TIME, or now if omitted.
+The optional TZ specifies the time zone in a number of seconds; any
+other non-nil value will be treated as 0. Note that both the format
+specifiers `%Z' and `%z' will be replaced with a numeric form. "
+;; FIXME: is there a smart way to replace %Z with a time zone name?
+ (if (and (numberp tz) (not (zerop tz)))
+ (let ((st 0)
+ (case-fold-search t)
+ ls nd rest)
+ (setq time (if time
+ (copy-sequence time)
+ (current-time)))
+ (if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0)
+ (setcar (cdr time) ls)
+ (setcar (cdr time) (+ ls 65536))
+ (setcar time (1- (car time))))
+ (setq tz (format "%s%02d%02d"
+ (if (>= tz 0) "+" "-")
+ (/ (abs tz) 3600)
+ (/ (% (abs tz) 3600) 60)))
+ (while (string-match "%+z" format-string st)
+ (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2))
+ (progn
+ (push (substring format-string st (- nd 2)) rest)
+ (push tz rest))
+ (push (substring format-string st nd) rest))
+ (setq st nd))
+ (push (substring format-string st) rest)
+ (format-time-string (apply 'concat (nreverse rest)) time))
+ (format-time-string format-string time tz)))
(provide 'gmm-utils)
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 1d0f346e10f..fc75586ccd8 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -492,7 +492,7 @@ manipulated as follows:
(push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
buffer))))
minor-mode-map-alist))
- (when (eq major-mode 'gnus-group-mode)
+ (when (derived-mode-p 'gnus-group-mode)
(let ((init-plugged gnus-plugged)
(gnus-agent-go-online nil))
;; g-a-t-p does nothing when gnus-plugged isn't changed.
@@ -868,8 +868,9 @@ be a select method."
(not (eq gnus-agent-synchronize-flags 'ask)))
(and (eq gnus-agent-synchronize-flags 'ask)
(gnus-y-or-n-p
- (format "Synchronize flags on server `%s'? "
- (cadr method))))))
+ (gnus-format-message
+ "Synchronize flags on server `%s'? "
+ (cadr method))))))
(gnus-agent-synchronize-flags-server method)))
;;;###autoload
@@ -881,11 +882,11 @@ Depends upon the caller to determine whether group renaming is
supported."
(let* ((old-command-method (gnus-find-method-for-group old-group))
(old-path (directory-file-name
- (let (gnus-command-method old-command-method)
+ (let ((gnus-command-method old-command-method))
(gnus-agent-group-pathname old-group))))
(new-command-method (gnus-find-method-for-group new-group))
(new-path (directory-file-name
- (let (gnus-command-method new-command-method)
+ (let ((gnus-command-method new-command-method))
(gnus-agent-group-pathname new-group))))
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-rename-file old-path new-path t)
@@ -914,19 +915,18 @@ Depends upon the caller to determine whether group deletion is
supported."
(let* ((command-method (gnus-find-method-for-group group))
(path (directory-file-name
- (let (gnus-command-method command-method)
+ (let ((gnus-command-method command-method))
(gnus-agent-group-pathname group))))
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-delete-directory path)
(let* ((real-group (gnus-group-real-name group)))
(gnus-agent-save-group-info command-method real-group nil)
-
- (let ((local (gnus-agent-get-local group
- real-group command-method)))
- (gnus-agent-set-local group
- nil nil
- real-group command-method)))))
+ ;; FIXME: Does gnus-agent-get-local have any useful side-effect?
+ (gnus-agent-get-local group real-group command-method)
+ (gnus-agent-set-local group
+ nil nil
+ real-group command-method))))
;;;
;;; Server mode commands
@@ -1549,7 +1549,7 @@ downloaded into the agent."
(dir (gnus-agent-group-pathname group))
(date (time-to-days (current-time)))
(case-fold-search t)
- pos crosses id
+ pos crosses
(file-name-coding-system nnmail-pathname-coding-system))
(setcar selected-sets (nreverse (car selected-sets)))
@@ -1603,11 +1603,6 @@ downloaded into the agent."
(goto-char (match-end 0)))
(gnus-agent-crosspost crosses (caar pos) date)))
(goto-char (point-min))
- (if (not (re-search-forward
- "^Message-ID: *<\\([^>\n]+\\)>" nil t))
- (setq id "No-Message-ID-in-article")
- (setq id (buffer-substring
- (match-beginning 1) (match-end 1))))
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(write-region (point-min) (point-max)
@@ -1727,7 +1722,7 @@ and that there are no duplicates."
(or backed-up
(setq backed-up (gnus-agent-backup-overview-buffer)))
(gnus-message 1
- "Overview buffer contains garbage '%s'."
+ "Overview buffer contains garbage `%s'."
(buffer-substring
p (point-at-eol))))
((= cur prev-num)
@@ -1832,7 +1827,7 @@ variables. Returns the first non-nil value found."
. gnus-agent-enable-expiration)
(agent-predicate . gnus-agent-predicate)))))))
-(defun gnus-agent-fetch-headers (group &optional force)
+(defun gnus-agent-fetch-headers (group)
"Fetch interesting headers into the agent. The group's overview
file will be updated to include the headers while a list of available
article numbers will be returned."
@@ -1907,7 +1902,7 @@ article numbers will be returned."
(when articles
(gnus-message
- 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
+ 10 "gnus-agent-fetch-headers: undownloaded articles are `%s'"
(gnus-compress-sequence articles t)))
(with-current-buffer nntp-server-buffer
@@ -1931,7 +1926,7 @@ article numbers will be returned."
;; NOTE: Call g-a-brand-nov even when the file does not
;; exist. As a minimum, it will validate the article
;; numbers already in the buffer.
- (gnus-agent-braid-nov group articles file)
+ (gnus-agent-braid-nov articles file)
(let ((coding-system-for-write
gnus-agent-file-coding-system))
(gnus-agent-check-overview-buffer)
@@ -1980,7 +1975,7 @@ article numbers will be returned."
(set-buffer nntp-server-buffer)
(insert-buffer-substring gnus-agent-overview-buffer b e))))
-(defun gnus-agent-braid-nov (group articles file)
+(defun gnus-agent-braid-nov (articles file)
"Merge agent overview data with given file.
Takes unvalidated headers for ARTICLES from
`gnus-agent-overview-buffer' and validated headers from the given
@@ -2154,7 +2149,7 @@ doesn't exist, to valid the overview buffer."
(let* ((file-name-coding-system nnmail-pathname-coding-system)
(prev (cons nil gnus-agent-article-alist))
(all prev)
- print-level print-length item article)
+ print-level print-length article)
(while (setq article (pop articles))
(while (and (cdr prev)
(< (caadr prev) article))
@@ -2288,7 +2283,7 @@ modified) original contents, they are first saved to their own file."
(file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file dest
(let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
- print-level print-length item article
+ print-level print-length
(standard-output (current-buffer)))
(mapatoms (lambda (symbol)
(cond ((not (boundp symbol))
@@ -2411,6 +2406,18 @@ modified) original contents, they are first saved to their own file."
(gnus-run-hooks 'gnus-agent-fetched-hook)
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
+(defvar gnus-agent-short-article 500
+ "Articles that have fewer lines than this are short.")
+
+(defvar gnus-agent-long-article 1000
+ "Articles that have more lines than this are long.")
+
+(defvar gnus-agent-low-score 0
+ "Articles that have a score lower than this have a low score.")
+
+(defvar gnus-agent-high-score 0
+ "Articles that have a score higher than this have a high score.")
+
(defun gnus-agent-fetch-group-1 (group method)
"Fetch GROUP."
(let ((gnus-command-method method)
@@ -2427,8 +2434,8 @@ modified) original contents, they are first saved to their own file."
gnus-headers
gnus-score
- articles arts
- category predicate info marks score-param
+ articles
+ predicate info marks
)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
@@ -2471,9 +2478,6 @@ modified) original contents, they are first saved to their own file."
;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)
- ;; Figure out how to select articles in this group
- (setq category (gnus-group-category group))
-
(setq predicate
(gnus-get-predicate
(gnus-agent-find-parameter group 'agent-predicate)))
@@ -2624,23 +2628,14 @@ General format specifiers can also be used. See Info node
(defvar gnus-agent-predicate 'false
"The selection predicate used when no other source is available.")
-(defvar gnus-agent-short-article 500
- "Articles that have fewer lines than this are short.")
-
-(defvar gnus-agent-long-article 1000
- "Articles that have more lines than this are long.")
-
-(defvar gnus-agent-low-score 0
- "Articles that have a score lower than this have a low score.")
-
-(defvar gnus-agent-high-score 0
- "Articles that have a score higher than this have a high score.")
-
;;; Internal variables.
(defvar gnus-category-buffer "*Agent Category*")
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-groups)
+
(defvar gnus-category-line-format-alist
`((?c gnus-tmp-name ?s)
(?g gnus-tmp-groups ?d)))
@@ -2692,7 +2687,7 @@ General format specifiers can also be used. See Info node
(gnus-run-hooks 'gnus-category-menu-hook)))
-(defun gnus-category-mode ()
+(define-derived-mode gnus-category-mode fundamental-mode "Category"
"Major mode for listing and editing agent categories.
All normal editing commands are switched off.
@@ -2703,20 +2698,14 @@ For more in-depth information on this mode, read the manual
The following commands are available:
\\{gnus-category-mode-map}"
- (interactive)
(when (gnus-visual-p 'category-menu 'menu)
(gnus-category-make-menu-bar))
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-category-mode)
- (setq mode-name "Category")
(gnus-set-default-directory)
(setq mode-line-process nil)
- (use-local-map gnus-category-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-category-mode-hook))
+ (setq buffer-read-only t))
(defalias 'gnus-category-position-point 'gnus-goto-colon)
@@ -2992,9 +2981,7 @@ The following commands are available:
"Return the function implementing PREDICATE."
(or (cdr (assoc predicate gnus-category-predicate-cache))
(let ((func (gnus-category-make-function predicate)))
- (setq gnus-category-predicate-cache
- (nconc gnus-category-predicate-cache
- (list (cons predicate func))))
+ (push (cons predicate func) gnus-category-predicate-cache)
func)))
(defun gnus-predicate-implies-unread (predicate)
@@ -3066,6 +3053,9 @@ articles."
(or (gnus-gethash group gnus-category-group-cache)
(assq 'default gnus-category-alist)))
+(defvar gnus-agent-expire-current-dirs)
+(defvar gnus-agent-expire-stats)
+
(defun gnus-agent-expire-group (group &optional articles force)
"Expire all old articles in GROUP.
If you want to force expiring of certain articles, this function can
@@ -3080,7 +3070,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(if (not group)
(gnus-agent-expire articles group force)
- (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
+ (let (;; Bind gnus-agent-expire-stats to enable tracking of
;; expiration statistics of this single group
(gnus-agent-expire-stats (list 0 0 0.0)))
(if (or (not (eq articles t))
@@ -3117,9 +3107,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(gnus-agent-with-refreshed-group
group
(when (boundp 'gnus-agent-expire-current-dirs)
- (set 'gnus-agent-expire-current-dirs
- (cons dir
- (symbol-value 'gnus-agent-expire-current-dirs))))
+ (push dir gnus-agent-expire-current-dirs))
(if (and (not force)
(eq 'DISABLE (gnus-agent-find-parameter group
@@ -3263,24 +3251,24 @@ line." (point) nov-file)))
;; only problem is that much of it is spread across multiple
;; entries. Sort then MERGE!!
(gnus-message 7 "gnus-agent-expire: Sorting entries... ")
- ;; If two entries have the same article-number then sort by
- ;; ascending keep_flag.
- (let ((special 0)
- (marked 1)
- (unread 2))
- (setq dlist
- (sort dlist
- (lambda (a b)
- (cond ((< (nth 0 a) (nth 0 b))
- t)
- ((> (nth 0 a) (nth 0 b))
- nil)
- (t
- (let ((a (or (symbol-value (nth 2 a))
- 3))
- (b (or (symbol-value (nth 2 b))
- 3)))
- (<= a b))))))))
+ (setq dlist
+ (sort dlist
+ (lambda (a b)
+ (cond ((< (nth 0 a) (nth 0 b))
+ t)
+ ((> (nth 0 a) (nth 0 b))
+ nil)
+ (t
+ ;; If two entries have the same article-number
+ ;; then sort by ascending keep_flag.
+ (let* ((kf-score '((special . 0)
+ (marked . 1)
+ (unread . 2)))
+ (a (or (cdr (assq (nth 2 a) kf-score))
+ 3))
+ (b (or (cdr (assq (nth 2 b) kf-score))
+ 3)))
+ (<= a b)))))))
(gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
(gnus-message 7 "gnus-agent-expire: Merging entries... ")
(let ((dlist dlist))
@@ -3474,7 +3462,7 @@ expiration tests failed." decoded article-number)
(gnus-summary-update-info))))
(when (boundp 'gnus-agent-expire-stats)
- (let ((stats (symbol-value 'gnus-agent-expire-stats)))
+ (let ((stats gnus-agent-expire-stats))
(incf (nth 2 stats) bytes-freed)
(incf (nth 1 stats) files-deleted)
(incf (nth 0 stats) nov-entries-deleted)))
@@ -3534,7 +3522,7 @@ articles in every agentized group? "))
(defun gnus-agent-expire-done-message ()
(if (and (> gnus-verbose 4)
(boundp 'gnus-agent-expire-stats))
- (let* ((stats (symbol-value 'gnus-agent-expire-stats))
+ (let* ((stats gnus-agent-expire-stats)
(size (nth 2 stats))
(units '(B KB MB GB)))
(while (and (> size 1024.0)
@@ -3553,16 +3541,10 @@ articles in every agentized group? "))
(when (and gnus-agent-expire-unagentized-dirs
(boundp 'gnus-agent-expire-current-dirs))
(let* ((keep (gnus-make-hashtable))
- ;; Formally bind gnus-agent-expire-current-dirs so that the
- ;; compiler will not complain about free references.
- (gnus-agent-expire-current-dirs
- (symbol-value 'gnus-agent-expire-current-dirs))
- dir
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-sethash gnus-agent-directory t keep)
- (while gnus-agent-expire-current-dirs
- (setq dir (pop gnus-agent-expire-current-dirs))
+ (dolist (dir gnus-agent-expire-current-dirs)
(when (and (stringp dir)
(file-directory-p dir))
(while (not (gnus-gethash dir keep))
@@ -3715,7 +3697,7 @@ has been fetched."
(let ((gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
- cached-articles uncached-articles
+ uncached-articles
(file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@@ -3812,7 +3794,7 @@ has been fetched."
;; Merge the temp buffer with the known headers (found on
;; disk in FILE) into the nntp-server-buffer
(when uncached-articles
- (gnus-agent-braid-nov group uncached-articles file))
+ (gnus-agent-braid-nov uncached-articles file))
;; Save the new set of known headers to FILE
(set-buffer nntp-server-buffer)
@@ -3907,7 +3889,6 @@ If REREAD is not nil, downloaded articles are marked as unread."
(gnus-find-method-for-group group)))
(file (gnus-agent-article-name ".overview" group))
(dir (file-name-directory file))
- point
(file-name-coding-system nnmail-pathname-coding-system)
(downloaded (if (file-exists-p dir)
(sort (delq nil (mapcar (lambda (name)
@@ -3916,7 +3897,7 @@ If REREAD is not nil, downloaded articles are marked as unread."
(directory-files dir nil "^[0-9]+$" t)))
'>)
(progn (gnus-make-directory dir) nil)))
- dl nov-arts
+ nov-arts
alist header
regenerated)
@@ -4099,16 +4080,16 @@ If REREAD is not nil, downloaded articles are marked as unread."
regenerated)))
;;;###autoload
-(defun gnus-agent-regenerate (&optional clean reread)
+(defun gnus-agent-regenerate (&optional _clean reread)
"Regenerate all agent covered files.
-If CLEAN, obsolete (ignore)."
- (interactive "P")
+CLEAN is obsolete and ignored."
+ (interactive)
(let (regenerated)
(gnus-message 4 "Regenerating Gnus agent files...")
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (dolist (group (gnus-groups-from-server gnus-command-method))
- (setq regenerated (or (gnus-agent-regenerate-group group reread)
- regenerated))))
+ (dolist (group (gnus-groups-from-server gnus-command-method))
+ (setq regenerated (or (gnus-agent-regenerate-group group reread)
+ regenerated))))
(gnus-message 4 "Regenerating Gnus agent files...done")
regenerated))
@@ -4141,8 +4122,8 @@ If CLEAN, obsolete (ignore)."
(defun gnus-agent-group-covered-p (group)
(gnus-agent-method-p (gnus-group-method group)))
-(defun gnus-agent-update-files-total-fetched-for
- (group delta &optional method path)
+(defun gnus-agent-update-files-total-fetched-for (group delta
+ &optional method path)
"Update, or set, the total disk space used by the articles that the
agent has fetched."
(when gnus-agent-total-fetched-hashtb
@@ -4155,27 +4136,29 @@ agent has fetched."
(gnus-sethash path (make-list 3 0)
gnus-agent-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system))
- (when (listp delta)
- (if delta
- (let ((sum 0.0)
+ (when (file-exists-p path)
+ (when (listp delta)
+ (if delta
+ (let ((sum 0.0)
+ file)
+ (while (setq file (pop delta))
+ (incf sum (float (or (nth 7 (file-attributes
+ (nnheader-concat
+ path
+ (if (numberp file)
+ (number-to-string file)
+ file)))) 0))))
+ (setq delta sum))
+ (let ((sum (- (nth 2 entry)))
+ (info (directory-files-and-attributes
+ path nil "^-?[0-9]+$" t))
file)
- (while (setq file (pop delta))
- (incf sum (float (or (nth 7 (file-attributes
- (nnheader-concat
- path
- (if (numberp file)
- (number-to-string file)
- file)))) 0))))
- (setq delta sum))
- (let ((sum (- (nth 2 entry)))
- (info (directory-files-and-attributes path nil "^-?[0-9]+$" t))
- file)
- (while (setq file (pop info))
- (incf sum (float (or (nth 8 file) 0))))
- (setq delta sum))))
+ (while (setq file (pop info))
+ (incf sum (float (or (nth 8 file) 0))))
+ (setq delta sum))))
- (setq gnus-agent-need-update-total-fetched-for t)
- (incf (nth 2 entry) delta)))))
+ (setq gnus-agent-need-update-total-fetched-for t)
+ (incf (nth 2 entry) delta))))))
(defun gnus-agent-update-view-total-fetched-for
(group agent-over &optional method path)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e65b9fb99e4..44aff772402 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1,6 +1,6 @@
;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(defvar tool-bar-map)
@@ -53,6 +50,7 @@
(autoload 'ansi-color-apply-on-region "ansi-color")
(autoload 'mm-url-insert-file-contents-external "mm-url")
(autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
(defgroup gnus-article nil
"Article display."
@@ -197,16 +195,16 @@ this list."
"Headers that are only to be displayed if they have interesting data.
Possible values in this list are:
- 'empty Headers with no content.
- 'newsgroups Newsgroup identical to Gnus group.
- 'to-address To identical to To-address.
- 'to-list To identical to To-list.
- 'cc-list CC identical to To-list.
- 'followup-to Followup-to identical to Newsgroups.
- 'reply-to Reply-to identical to From.
- 'date Date less than four days old.
- 'long-to To and/or Cc longer than 1024 characters.
- 'many-to Multiple To and/or Cc."
+ `empty' Headers with no content.
+ `newsgroups' Newsgroup identical to Gnus group.
+ `to-address' To identical to To-address.
+ `to-list' To identical to To-list.
+ `cc-list' CC identical to To-list.
+ `followup-to' Followup-to identical to Newsgroups.
+ `reply-to' Reply-to identical to From.
+ `date' Date less than four days old.
+ `long-to' To and/or Cc longer than 1024 characters.
+ `many-to' Multiple To and/or Cc."
:type '(set (const :tag "Headers with no content." empty)
(const :tag "Newsgroups identical to Gnus group." newsgroups)
(const :tag "To identical to To-address." to-address)
@@ -256,7 +254,11 @@ This can also be a list of the above values."
(regexp :value ".*"))
:group 'gnus-article-signature)
-(defcustom gnus-hidden-properties '(invisible t intangible t)
+(defcustom gnus-hidden-properties
+ ;; We use to have `intangible' here as well, but Emacs's command loop moves
+ ;; point out of invisible text anyway, so `intangible' is clearly not
+ ;; needed there. And XEmacs doesn't handle `intangible' anyway.
+ '(invisible t)
"Property list to use for hiding text."
:type 'sexp
:group 'gnus-article-hiding)
@@ -328,7 +330,7 @@ to match a mail address in the From: header, BANNER is one of a symbol
If ADDRESS matches author's mail address, it will remove things like
advertisements. For example:
-\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\\\='\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
"
:type '(repeat
(cons
@@ -397,7 +399,7 @@ advertisements. For example:
"*Alist that says how to fontify certain phrases.
Each item looks like this:
- (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
+ (\"_\\\\(\\\\w+\\\\)_\" 0 1 \\='underline)
The first element is a regular expression to be matched. The second
is a number that says what regular expression grouping used to find
@@ -659,7 +661,7 @@ For instance, if you would like to save articles related to Gnus in
the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
you could set this variable to something like:
- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
+ ((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
(\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
This variable is an alist where the key is the match and the
@@ -884,12 +886,12 @@ Here are examples:
;; Specify the altitude of Face images in the From header.
\(setq gnus-face-properties-alist
- '((pbm . (:face gnus-x-face :ascent 80))
+ \\='((pbm . (:face gnus-x-face :ascent 80))
(png . (:ascent 80))))
;; Show Face images as pressed buttons.
\(setq gnus-face-properties-alist
- '((pbm . (:face gnus-x-face :relief -2))
+ \\='((pbm . (:face gnus-x-face :relief -2))
(png . (:relief -2))))
See the manual for the valid properties for various image types.
@@ -1136,7 +1138,7 @@ predicate. See Info node `(gnus)Customizing Articles'."
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
-(defcustom gnus-treat-buttonize 100000
+(defcustom gnus-treat-buttonize '(and 100000 (typep "text/plain"))
"Add buttons.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
@@ -1254,7 +1256,7 @@ how to control what it hides."
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
- "Strip list identifiers from `gnus-list-identifiers`.
+ "Strip list identifiers from `gnus-list-identifiers'.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
:version "21.1"
@@ -1623,8 +1625,14 @@ It is a string, such as \"PGP\". If nil, ask user."
:type 'string
:group 'mime-security)
-(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
- (mm-coding-system-p 'utf-8)
+(defvar idna-program)
+
+(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8)
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
+ idna-program
(executable-find idna-program))
"Whether IDNA decoding of headers is used when viewing messages.
This requires GNU Libidn, and by default only enabled if it is found."
@@ -1727,7 +1735,7 @@ regexp."
(modify-syntax-entry ?` " " table)
table)
"Syntax table used in article mode buffers.
-Initialized from `text-mode-syntax-table.")
+Initialized from `text-mode-syntax-table'.")
(defvar gnus-save-article-buffer nil)
@@ -1765,19 +1773,12 @@ Initialized from `text-mode-syntax-table.")
(re-search-forward (concat "^\\(" header "\\):") nil t))
(defsubst gnus-article-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (gnus-add-text-properties-when 'article-type nil b e props)
- (when (memq 'intangible props)
- (put-text-property
- (max (1- b) (point-min))
- b 'intangible (cddr (memq 'intangible props)))))
+ "Set text PROPS on the B to E region."
+ (gnus-add-text-properties-when 'article-type nil b e props))
(defsubst gnus-article-unhide-text (b e)
"Remove hidden text properties from region between B and E."
- (remove-text-properties b e gnus-hidden-properties)
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ (remove-text-properties b e gnus-hidden-properties))
(defun gnus-article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
@@ -1789,10 +1790,7 @@ Initialized from `text-mode-syntax-table.")
"Unhide text of TYPE between B and E."
(gnus-delete-wash-type type)
(remove-text-properties
- b e (cons 'article-type (cons type gnus-hidden-properties)))
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
@@ -1837,7 +1835,7 @@ Initialized from `text-mode-syntax-table.")
(incf i)))
i))
-(defun article-hide-headers (&optional arg delete)
+(defun article-hide-headers (&optional _arg _delete)
"Hide unwanted headers and possibly sort them as well."
(interactive)
;; This function might be inhibited.
@@ -2322,7 +2320,7 @@ long lines if and only if arg is positive."
(goto-char (point-max))
(let ((start (point)))
(insert "X-Boundary: ")
- (gnus-add-text-properties start (point) '(invisible t intangible t))
+ (gnus-add-text-properties start (point) gnus-hidden-properties)
(insert (let (str (max (window-width)))
(if (featurep 'xemacs)
(setq max (1- max)))
@@ -2407,7 +2405,7 @@ long lines if and only if arg is positive."
(if (and wash-face-p (memq 'face gnus-article-wash-types))
(gnus-delete-images 'face)
(let ((from (message-fetch-field "from"))
- face faces)
+ faces)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
@@ -2430,7 +2428,7 @@ long lines if and only if arg is positive."
(unless (setq from (gnus-article-goto-header "from"))
(insert "From:")
(setq from (point))
- (insert " [no `from' set]\n"))
+ (insert " [no 'from' set]\n"))
(while faces
(when (setq png (gnus-convert-face-to-png (pop faces)))
(setq image
@@ -2457,7 +2455,7 @@ long lines if and only if arg is positive."
(gnus-delete-images 'xface)
;; Display X-Faces.
(let ((from (message-fetch-field "from"))
- x-faces face)
+ x-faces)
(save-current-buffer
(when (and wash-face-p
(gnus-buffer-live-p gnus-original-article-buffer)
@@ -2665,7 +2663,7 @@ If READ-CHARSET, ask for a coding system."
(string-match "quoted-printable" type))))
(article-goto-body)
(quoted-printable-decode-region
- (point) (point-max) (mm-charset-to-coding-system charset))))))
+ (point) (point-max) (mm-charset-to-coding-system charset nil t))))))
(defun article-de-base64-unreadable (&optional force read-charset)
"Translate a base64 article.
@@ -2696,7 +2694,8 @@ If READ-CHARSET, ask for a coding system."
(narrow-to-region (point) (point-max))
(base64-decode-region (point-min) (point-max))
(mm-decode-coding-region
- (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
+ (point-min) (point-max)
+ (mm-charset-to-coding-system charset nil t)))))))
(eval-when-compile
(require 'rfc1843))
@@ -2771,7 +2770,7 @@ summary buffer."
(cond ((file-directory-p file)
(when (or (not (eq how 'file))
(gnus-y-or-n-p
- (format
+ (gnus-format-message
"Delete temporary HTML file(s) in directory `%s'? "
(file-name-as-directory file))))
(gnus-delete-directory file)))
@@ -2787,27 +2786,31 @@ summary buffer."
(defun gnus-article-browse-html-save-cid-content (cid handles directory)
"Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return file name."
+Return file name relative to the parent of DIRECTORY."
(save-match-data
- (let (file type)
+ (let (file afile)
(catch 'found
(dolist (handle handles)
(cond
((not (listp handle)))
+ ;; Exclude broken handles that `gnus-summary-enter-digest-group'
+ ;; may create.
+ ((not (or (bufferp (car handle)) (stringp (car handle)))))
((equal (mm-handle-media-supertype handle) "multipart")
(when (setq file (gnus-article-browse-html-save-cid-content
cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
- (concat
- (make-temp-name "cid")
- (car (rassoc (car (mm-handle-type handle)) mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ (setq file (or (mm-handle-filename handle)
+ (concat
+ (make-temp-name "cid")
+ (car (rassoc (car (mm-handle-type handle))
+ mailcap-mime-extensions))))
+ afile (expand-file-name file directory))
+ (mm-save-part-to-file handle afile)
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
@@ -2843,8 +2846,32 @@ message header will be added to the bodies of the \"text/html\" parts."
(insert content)
;; resolve cid contents
(let ((case-fold-search t)
- cid-file)
+ st base regexp cid-file)
(goto-char (point-min))
+ (when (and (re-search-forward "<head[\t\n >]" nil t)
+ (progn
+ (setq st (match-end 0))
+ (re-search-forward "</head[\t\n >]" nil t))
+ (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+ (setq base (match-string 1))
+ (replace-match "<!--\\&-->")
+ (setq st (point))
+ (dolist (tag '(("a" . "href") ("form" . "action")
+ ("img" . "src")))
+ (setq regexp (concat "<" (car tag)
+ "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+ (cdr tag) "=\"\\([^\"]+\\)"))
+ (while (re-search-forward regexp nil t)
+ (insert (prog1
+ (condition-case nil
+ (save-match-data
+ (url-expand-file-name (match-string 1)
+ base))
+ (error (match-string 1)))
+ (delete-region (match-beginning 1)
+ (match-end 1)))))
+ (goto-char st)))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
@@ -2859,16 +2886,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
- (when (eq system-type 'cygwin)
- (setq cid-file
- (concat "/" (substring
- (with-output-to-string
- (call-process "cygpath" nil
- standard-output
- nil "-m" cid-file))
- 0 -1))))
- (replace-match (concat "file://" cid-file)
- nil nil nil 1))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
@@ -2891,6 +2909,13 @@ message header will be added to the bodies of the \"text/html\" parts."
((match-beginning 3) "&amp;")
(t "<br>\n"))))
(goto-char (point-min))
+ (while (re-search-forward "^[\t ]+" nil t)
+ (dotimes (i (prog1
+ (current-column)
+ (delete-region (match-beginning 0)
+ (match-end 0))))
+ (insert "&nbsp;")))
+ (goto-char (point-min))
(insert "<div align=\"left\">\n")
(goto-char (point-max))
(insert "</div>\n<hr>\n")
@@ -2908,7 +2933,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(cond ((= (length hcharset) 1)
(setq hcharset (car hcharset)
coding (mm-charset-to-coding-system
- hcharset)))
+ hcharset nil t)))
((> (length hcharset) 1)
(setq hcharset 'utf-8
coding hcharset)))
@@ -2916,7 +2941,8 @@ message header will be added to the bodies of the \"text/html\" parts."
(if charset
(progn
(setq body
- (mm-charset-to-coding-system charset))
+ (mm-charset-to-coding-system charset
+ nil t))
(if (eq coding body)
(setq eheader (mm-encode-coding-string
(buffer-string) coding)
@@ -3065,7 +3091,7 @@ images if any to the browser, and deletes them when exiting the group
(gnus-summary-show-article)))))
(defun article-hide-list-identifiers ()
- "Remove list identifies from the Subject header.
+ "Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(interactive)
(let ((inhibit-point-motion-hooks t)
@@ -3379,7 +3405,7 @@ means show, 0 means toggle."
'hidden
nil)))
-(defun gnus-article-show-hidden-text (type &optional dummy)
+(defun gnus-article-show-hidden-text (type &optional _dummy)
"Show all hidden text of type TYPE.
Originally it is hide instead of DUMMY."
(let ((inhibit-read-only t)
@@ -3418,7 +3444,7 @@ lines forward."
gnus-article-date-headers)
t))
-(defun article-date-ut (&optional type highlight date-position)
+(defun article-date-ut (&optional type _highlight date-position)
"Convert DATE date to TYPE in the current article.
The default type is `ut'. See `gnus-article-date-headers' for
possible values."
@@ -3426,7 +3452,6 @@ possible values."
(let* ((case-fold-search t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
- (first t)
(visible-date (mail-fetch-field "Date"))
pos date bface eface)
(save-excursion
@@ -3683,7 +3708,7 @@ function and want to see what the date was before converting."
(walk-windows
(lambda (w)
(set-buffer (window-buffer w))
- (when (eq major-mode 'gnus-article-mode)
+ (when (derived-mode-p 'gnus-article-mode)
(let ((old-line (count-lines (point-min) (point)))
(old-column (- (point) (line-beginning-position)))
(window-start (window-start w))
@@ -3965,7 +3990,7 @@ This format is defined by the `gnus-article-time-format' variable."
(set dir-var (file-name-directory result)))
result))
-(defun gnus-article-archive-name (group)
+(defun gnus-article-archive-name (_group)
"Return the first instance of an \"Archive-name\" in the current buffer."
(let ((case-fold-search t))
(when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
@@ -4197,7 +4222,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
default
(or last-file default))))
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
+(defun gnus-plain-save-name (newsgroup _headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
If variable `gnus-use-long-file-name' is non-nil, it is
~/News/news.group. Otherwise, it is like ~/News/news/group/news."
@@ -4210,7 +4235,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
default-directory))
gnus-article-save-directory)))
-(defun gnus-sender-save-name (newsgroup headers &optional last-file)
+(defun gnus-sender-save-name (_newsgroup headers &optional _last-file)
"Generate file name from sender."
(let ((from (mail-header-from headers)))
(expand-file-name
@@ -4382,7 +4407,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
[?\S-\ ] gnus-article-goto-prev-page
"\177" gnus-article-goto-prev-page
[delete] gnus-article-goto-prev-page
- [backspace] gnus-article-goto-prev-page
"\C-c^" gnus-article-refer-article
"h" gnus-article-show-summary
"s" gnus-article-show-summary
@@ -4408,6 +4432,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(substitute-key-definition
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
+(defvar gnus-article-send-map)
+
(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
"W" gnus-article-wide-reply-with-original)
(if (featurep 'xemacs)
@@ -4455,7 +4481,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defvar bookmark-make-record-function)
(defvar shr-put-image-function)
-(defun gnus-article-mode ()
+(define-derived-mode gnus-article-mode fundamental-mode "Article"
"Major mode for displaying an article.
All normal editing commands are switched off.
@@ -4470,13 +4496,8 @@ commands:
\\[gnus-article-mail]\t Send a reply to the address near point
\\[gnus-article-describe-briefly]\t Describe the current mode briefly
\\[gnus-info-find-node]\t Go to the Gnus info node"
- (interactive)
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq mode-name "Article")
- (setq major-mode 'gnus-article-mode)
(make-local-variable 'minor-mode-alist)
- (use-local-map gnus-article-mode-map)
(when (gnus-visual-p 'article-menu 'menu)
(gnus-article-make-menu-bar)
(when gnus-summary-tool-bar-map
@@ -4504,9 +4525,7 @@ commands:
(buffer-disable-undo)
(setq buffer-read-only t
show-trailing-whitespace nil)
- (set-syntax-table gnus-article-mode-syntax-table)
- (mm-enable-multibyte)
- (gnus-run-mode-hooks 'gnus-article-mode-hook))
+ (mm-enable-multibyte))
(defun gnus-article-setup-buffer ()
"Initialize the article buffer."
@@ -4544,20 +4563,22 @@ commands:
nil)
(error "Action aborted"))
t)))
- (with-current-buffer name
- (set (make-local-variable 'gnus-article-edit-mode) nil)
- (gnus-article-stop-animations)
- (when gnus-article-mime-handles
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles nil))
- ;; Set it to nil in article-buffer!
- (setq gnus-article-mime-handle-alist nil)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (unless (eq major-mode 'gnus-article-mode)
- (gnus-article-mode))
- (setq truncate-lines gnus-article-truncate-lines)
- (current-buffer))
+ (let ((summary gnus-summary-buffer))
+ (with-current-buffer name
+ (set (make-local-variable 'gnus-article-edit-mode) nil)
+ (gnus-article-stop-animations)
+ (when gnus-article-mime-handles
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles nil))
+ ;; Set it to nil in article-buffer!
+ (setq gnus-article-mime-handle-alist nil)
+ (buffer-disable-undo)
+ (setq buffer-read-only t)
+ (unless (derived-mode-p 'gnus-article-mode)
+ (gnus-article-mode))
+ (set (make-local-variable 'gnus-summary-buffer) summary)
+ (setq truncate-lines gnus-article-truncate-lines)
+ (current-buffer)))
(let ((summary gnus-summary-buffer))
(with-current-buffer (gnus-get-buffer-create name)
(gnus-article-mode)
@@ -4596,18 +4617,19 @@ commands:
(forward-line line)
(point)))))))
-(defun gnus-article-prepare (article &optional all-headers header)
+(defvar gnus-tmp-internal-hook)
+
+(defun gnus-article-prepare (article &optional all-headers _header)
"Prepare ARTICLE in article mode buffer.
ARTICLE should either be an article number or a Message-ID.
If ARTICLE is an id, HEADER should be the article headers.
If ALL-HEADERS is non-nil, no headers are hidden."
- (save-excursion
+ (save-excursion ;FIXME: Shouldn't that be save-current-buffer?
;; Make sure we start in a summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(setq gnus-summary-buffer (current-buffer))
- (let* ((gnus-article (if header (mail-header-number header) article))
- (summary-buffer (current-buffer))
+ (let* ((summary-buffer (current-buffer))
(gnus-tmp-internal-hook gnus-article-internal-prepare-hook)
(group gnus-newsgroup-name)
result)
@@ -4706,6 +4728,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(gnus-run-hooks 'gnus-article-prepare-hook)
t))))))
+(defvar gnus-mime-display-attachment-buttons-in-header)
+
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
@@ -4714,14 +4738,17 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(let ((gnus-article-buffer (current-buffer))
buffer-read-only
(inhibit-read-only t))
- (unless (eq major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(gnus-article-mode))
(setq buffer-read-only nil
gnus-article-wash-types nil
gnus-article-image-alist nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
- (funcall gnus-display-mime-function))))
+ (funcall gnus-display-mime-function))
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header))))
;;;
;;; Gnus Sticky Article Mode
@@ -4776,7 +4803,7 @@ If a prefix ARG is given, ask for a name for this sticky article buffer."
"*"))
(if (and (gnus-buffer-live-p new-art-buf-name)
(with-current-buffer new-art-buf-name
- (eq major-mode 'gnus-sticky-article-mode)))
+ (derived-mode-p 'gnus-sticky-article-mode)))
(switch-to-buffer new-art-buf-name)
(setq new-art-buf-name (rename-buffer new-art-buf-name t)))
(gnus-sticky-article-mode))
@@ -4792,7 +4819,7 @@ If none is given, assume the current buffer and kill it if it has
(unless buffer
(setq buffer (current-buffer)))
(with-current-buffer buffer
- (when (eq major-mode 'gnus-sticky-article-mode)
+ (when (derived-mode-p 'gnus-sticky-article-mode)
(gnus-kill-buffer buffer))))
(defun gnus-kill-sticky-article-buffers (arg)
@@ -4801,11 +4828,11 @@ If a prefix ARG is given, ask for confirmation."
(interactive "P")
(dolist (buf (gnus-buffers))
(with-current-buffer buf
- (when (eq major-mode 'gnus-sticky-article-mode)
- (if (not arg)
- (gnus-kill-buffer buf)
- (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
- (gnus-kill-buffer buf)))))))
+ (when (derived-mode-p 'gnus-sticky-article-mode)
+ (if (not arg)
+ (gnus-kill-buffer buf)
+ (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? "))
+ (gnus-kill-buffer buf)))))))
;;;
;;; Gnus MIME viewing functions
@@ -4826,6 +4853,16 @@ Valid specifiers include:
General format specifiers can also be used. See Info node
`(gnus)Formatting Variables'.")
+(defvar gnus-tmp-type)
+(defvar gnus-tmp-type-long)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-description)
+(defvar gnus-tmp-id)
+(defvar gnus-tmp-length)
+(defvar gnus-tmp-dots)
+(defvar gnus-tmp-info)
+(defvar gnus-tmp-pressed-details)
+
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(?T gnus-tmp-type-long ?s)
@@ -4893,7 +4930,7 @@ General format specifiers can also be used. See Info node
(defmacro gnus-bind-safe-url-regexp (&rest body)
"Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
`(let ((mm-w3m-safe-url-regexp
- (let ((group (if (and (eq major-mode 'gnus-article-mode)
+ (let ((group (if (and (derived-mode-p 'gnus-article-mode)
(gnus-buffer-live-p
gnus-article-current-summary))
(with-current-buffer gnus-article-current-summary
@@ -4980,7 +5017,6 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(gnus-article-edit-article
`(lambda ()
(buffer-disable-undo)
- (erase-buffer)
(let ((mail-parse-charset (or gnus-article-charset
',gnus-newsgroup-charset))
(mail-parse-ignored-charsets
@@ -4988,7 +5024,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
',gnus-newsgroup-ignored-charsets))
(mbl mml-buffer-list))
(setq mml-buffer-list nil)
- (insert-buffer-substring gnus-original-article-buffer)
+ ;; A new text must be inserted before deleting existing ones
+ ;; at the end so as not to move existing markers of which
+ ;; the insertion type is t.
+ (delete-region
+ (point-min)
+ (prog1
+ (goto-char (point-max))
+ (insert-buffer-substring gnus-original-article-buffer)))
(mime-to-mml ',handles)
(setq gnus-article-mime-handles nil)
(let ((mbl1 mml-buffer-list))
@@ -5018,6 +5061,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(let ((gnus-mime-buttonized-part-id current-id))
(gnus-article-edit-done))
(gnus-configure-windows 'article)
+ (sit-for 0)
(when (and current-id (integerp gnus-auto-select-part))
(gnus-article-jump-to-part
(min (max (+ current-id gnus-auto-select-part) 1)
@@ -5046,7 +5090,6 @@ If FILE is given, use it for the external part."
The current article has a complicated MIME structure, giving up..."))
(let* ((data (get-text-property (point) 'gnus-data))
(id (get-text-property (point) 'gnus-part))
- param
(handles gnus-article-mime-handles))
(unless file
(setq file
@@ -5242,7 +5285,8 @@ are decompressed."
(switch-to-buffer (generate-new-buffer filename))
(if (or coding-system
(and charset
- (setq coding-system (mm-charset-to-coding-system charset))
+ (setq coding-system (mm-charset-to-coding-system
+ charset nil t))
(not (eq coding-system 'ascii))))
(progn
(mm-enable-multibyte)
@@ -5292,40 +5336,86 @@ are decompressed."
Compressed files like .gz and .bz2 are decompressed."
(interactive (list nil current-prefix-arg))
(gnus-article-check-buffer)
- (unless handle
- (setq handle (get-text-property (point) 'gnus-data)))
- (when handle
- (let ((b (point))
- (inhibit-read-only t)
- contents charset coding-system)
+ (let* ((inhibit-read-only t)
+ (b (point))
+ (btn ;; position where the MIME button exists
+ (if handle
+ (if (eq handle (get-text-property b 'gnus-data))
+ b
+ (article-goto-body)
+ (or (text-property-any (point) (point-max) 'gnus-data handle)
+ (text-property-any (point-min) (point) 'gnus-data handle)))
+ (setq handle (get-text-property b 'gnus-data))
+ b))
+ start)
+ (when handle
+ (when (= b (prog1
+ btn
+ (setq start (next-single-property-change btn 'gnus-data
+ nil (point-max))
+ btn (previous-single-property-change start
+ 'gnus-data))))
+ (setq b btn))
(if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (setq contents
- (or (mm-decompress-buffer (mm-handle-filename handle) nil t)
- (buffer-string))))
+ (progn
+ (setq b (copy-marker b)
+ btn (copy-marker btn))
+ (mm-remove-part handle))
(cond
- ((not arg)
- (unless (setq charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- (unless (setq coding-system
- (mm-with-unibyte-buffer
- (insert contents)
- (mm-find-buffer-file-coding-system)))
- (setq charset gnus-newsgroup-charset))))
+ ((not arg) nil)
((numberp arg)
(if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: "))))
+ (mm-remove-part handle)))
((mm-handle-undisplayer handle)
(mm-remove-part handle)))
- (forward-line 2)
- (mm-display-inline handle)
- (goto-char b)))))
+ (goto-char start)
+ (unless (bolp)
+ ;; This is a header button.
+ (forward-line 1))
+ (mm-display-inline handle))
+ ;; Toggle the button appearance between `[button]...' and `[button]'.
+ (when (markerp btn)
+ (setq btn (prog1 (marker-position btn)
+ (set-marker btn nil))))
+ (goto-char btn)
+ (let ((displayed-p (mm-handle-displayed-p handle)))
+ (gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
+ (list displayed-p))
+ (if (featurep 'emacs)
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
+ (let* ((end (next-single-property-change (point) 'gnus-data))
+ (annots (annotations-at (or end (point-max)))))
+ (delete-region (point)
+ (if end
+ (if annots (1+ end) end)
+ (point-max)))
+ (dolist (annot annots)
+ (set-extent-endpoints annot (point) (point)))))
+ (setq start (point))
+ (if (search-backward "\n\n" nil t)
+ (progn
+ (goto-char start)
+ (unless (or displayed-p (eolp))
+ ;; Add extra newline.
+ (insert (propertize (buffer-substring (1- start) start)
+ 'gnus-undeletable t))))
+ ;; We're in the article header.
+ (delete-char -1)
+ (dolist (ovl (overlays-in btn (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (overlay-put ovl 'face nil))
+ (save-restriction
+ (message-narrow-to-field)
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head)))))
+ (when (markerp b)
+ (setq b (prog1 (marker-position b)
+ (set-marker b nil))))
+ (goto-char b))))
(defun gnus-mime-set-charset-parameters (handle charset)
"Set CHARSET to parameters in HANDLE.
@@ -5391,7 +5481,6 @@ specified charset."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-user-display-methods nil)
(mm-inlined-types nil)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
@@ -5423,10 +5512,11 @@ If no internal viewer is available, use an external viewer."
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-safe-url-regexp (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp
+ (mm-display-part handle nil t))))))
(defun gnus-mime-action-on-part (&optional action)
- "Do something with the MIME attachment at \(point\)."
+ "Do something with the MIME attachment at (point)."
(interactive
(list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
(gnus-article-check-buffer)
@@ -5627,54 +5717,110 @@ all parts."
"Display HANDLE and fix MIME button."
(let ((id (get-text-property (point) 'gnus-part))
(point (point))
- (inhibit-read-only t))
- (forward-line 1)
- (prog1
- (let ((window (selected-window))
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (if (gnus-buffer-live-p gnus-summary-buffer)
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets)
- nil)))
- (save-excursion
- (unwind-protect
- (let ((win (gnus-get-buffer-window (current-buffer) t))
- (beg (point)))
- (when win
- (select-window win))
- (goto-char point)
- (forward-line)
- (if (mm-handle-displayed-p handle)
- ;; This will remove the part.
- (mm-display-part handle)
- (save-restriction
- (narrow-to-region (point)
- (if (eobp) (point) (1+ (point))))
- (gnus-bind-safe-url-regexp (mm-display-part handle))
- ;; We narrow to the part itself and
- ;; then call the treatment functions.
- (goto-char (point-min))
- (forward-line 1)
- (narrow-to-region (point) (point-max))
- (gnus-treat-article
- nil id
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))
- (if (window-live-p window)
- (select-window window)))))
+ (inhibit-read-only t)
+ (window (selected-window))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (if (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets)
+ nil))
+ start retval)
+ (unwind-protect
+ (progn
+ (let ((win (gnus-get-buffer-window (current-buffer) t)))
+ (when win
+ (select-window win)
+ (goto-char point)))
+ (setq start (next-single-property-change point 'gnus-data
+ nil (point-max))
+ point (previous-single-property-change start 'gnus-data))
+ (if (mm-handle-displayed-p handle)
+ ;; This will remove the part.
+ (setq point (copy-marker point)
+ retval (mm-display-part handle))
+ (let ((part (or (and (mm-inlinable-p handle)
+ (mm-inlined-p handle)
+ t)
+ (with-temp-buffer
+ (gnus-bind-safe-url-regexp
+ (setq retval (mm-display-part handle)))
+ (unless (zerop (buffer-size))
+ (buffer-string))))))
+ (goto-char start)
+ (unless (bolp)
+ ;; This is a header button.
+ (forward-line 1))
+ (cond ((stringp part)
+ (save-restriction
+ (narrow-to-region (point)
+ (progn
+ (insert part)
+ (unless (bolp) (insert "\n"))
+ (point)))
+ (gnus-treat-article nil id
+ (gnus-article-mime-total-parts)
+ (mm-handle-media-type handle))
+ (mm-handle-set-undisplayer
+ handle
+ `(lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region ,(copy-marker (point-min) t)
+ ,(point-max-marker)))))))
+ (part
+ (mm-display-inline handle))))))
+ (when (markerp point)
+ (setq point (prog1 (marker-position point)
+ (set-marker point nil))))
(goto-char point)
- (gnus-delete-line)
- (gnus-insert-mime-button
- handle id (list (mm-handle-displayed-p handle)))
- (goto-char point))))
+ ;; Toggle the button appearance between `[button]...' and `[button]'.
+ (let ((displayed-p (mm-handle-displayed-p handle)))
+ (gnus-insert-mime-button handle id (list displayed-p))
+ (if (featurep 'emacs)
+ (delete-region
+ (point)
+ (next-single-property-change (point) 'gnus-data nil (point-max)))
+ (let* ((end (next-single-property-change (point) 'gnus-data))
+ (annots (annotations-at (or end (point-max)))))
+ (delete-region (point)
+ (if end
+ (if annots (1+ end) end)
+ (point-max)))
+ (dolist (annot annots)
+ (set-extent-endpoints annot (point) (point)))))
+ (setq start (point))
+ (if (search-backward "\n\n" nil t)
+ (progn
+ (goto-char start)
+ (unless (or displayed-p (eolp))
+ ;; Add extra newline.
+ (insert (propertize (buffer-substring (1- start) start)
+ 'gnus-undeletable t))))
+ ;; We're in the article header.
+ (delete-char -1)
+ (dolist (ovl (overlays-in point (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (overlay-put ovl 'face nil))
+ (save-restriction
+ (message-narrow-to-field)
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head)))))
+ (goto-char point)
+ (if (window-live-p window)
+ (select-window window)))
+ retval))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
(when gnus-break-pages
(widen))
+ (article-goto-body)
(prog1
- (let ((start (text-property-any (point-min) (point-max) 'gnus-part n))
+ (let ((start (or (text-property-any (point) (point-max) 'gnus-part n)
+ ;; There may be header buttons.
+ (text-property-any (point-min) (point) 'gnus-part n)))
part handle end next handles)
(when start
(goto-char start)
@@ -5707,11 +5853,12 @@ all parts."
(when gnus-break-pages
(gnus-narrow-to-page))))
-(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
+(defun gnus-insert-mime-button (handle id &optional displayed)
(let ((gnus-tmp-name
(or (mm-handle-filename handle)
(mail-content-type-get (mm-handle-type handle) 'url)
""))
+ (gnus-tmp-id id)
(gnus-tmp-type (mm-handle-media-type handle))
(gnus-tmp-description (or (mm-handle-description handle) ""))
(gnus-tmp-dots
@@ -5728,8 +5875,6 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
- (unless (bolp)
- (insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5744,8 +5889,8 @@ all parts."
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:mime-handle handle
@@ -5764,7 +5909,7 @@ all parts."
"hide" "show")
(aref gnus-down-mouse-3 0))))))
-(defun gnus-widget-press-button (elems el)
+(defun gnus-widget-press-button (elems _el)
(goto-char (widget-get elems :from))
(gnus-article-press-button))
@@ -5782,8 +5927,7 @@ all parts."
;; may change the point. So we set the window point.
(set-window-point window point)))
(let ((handles ihandles)
- (inhibit-read-only t)
- handle)
+ (inhibit-read-only t))
(cond (handles)
((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
(when gnus-article-emulate-mime
@@ -5848,12 +5992,22 @@ If t, it overrides nil values of
"Display \"multipart/related\" parts as \"multipart/mixed\".
If displaying \"text/html\" is discouraged \(see
-`mm-discouraged-alternatives'\) images or other material inside a
+`mm-discouraged-alternatives') images or other material inside a
\"multipart/related\" part might be overlooked when this variable is nil."
:version "22.1"
:group 'gnus-article-mime
:type 'boolean)
+(defcustom gnus-mime-display-attachment-buttons-in-header t
+ "Add attachment buttons in the end of the header of an article.
+Since MIME attachments tend to be put at the end of an article, we may
+overlook them if there is a huge body. This option offers you a copy
+of all non-inlinable MIME parts as buttons shown in front of an article.
+If nil, don't show those extra buttons."
+ :version "25.1"
+ :group 'gnus-article-mime
+ :type 'boolean)
+
(defun gnus-mime-display-part (handle)
(cond
;; Maybe a broken MIME message.
@@ -5876,14 +6030,6 @@ If displaying \"text/html\" is discouraged \(see
((and (equal (car handle) "multipart/related")
(not (or gnus-mime-display-multipart-as-mixed
gnus-mime-display-multipart-related-as-mixed)))
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
(gnus-mime-display-part (cadr handle)))
((equal (car handle) "multipart/signed")
(gnus-add-wash-type 'signed)
@@ -5907,7 +6053,6 @@ If displaying \"text/html\" is discouraged \(see
(let ((type (mm-handle-media-type handle))
(ignored gnus-ignored-mime-types)
(not-attachment t)
- (move nil)
display text)
(catch 'ignored
(progn
@@ -5933,9 +6078,11 @@ If displaying \"text/html\" is discouraged \(see
(setq display t)
(when (equal (mm-handle-media-supertype handle) "text")
(setq text t)))
- (let ((id (1+ (length gnus-article-mime-handle-alist)))
+ (let ((id (car (rassq handle gnus-article-mime-handle-alist)))
beg)
- (push (cons id handle) gnus-article-mime-handle-alist)
+ (unless id
+ (setq id (1+ (length gnus-article-mime-handle-alist)))
+ (push (cons id handle) gnus-article-mime-handle-alist))
(when (and display
(equal (mm-handle-media-supertype handle) "message"))
(insert-char
@@ -5947,31 +6094,28 @@ If displaying \"text/html\" is discouraged \(see
(not (gnus-unbuttonized-mime-type-p type))
(eq id gnus-mime-buttonized-part-id))
(gnus-insert-mime-button
- handle id (list (or display (and not-attachment text))))
- (gnus-article-insert-newline)
- ;; Remember modify the number of forward lines.
- (setq move t))
+ handle id (list (or display (and not-attachment text)))))
(setq beg (point))
(cond
(display
- (when move
- (forward-line -1)
- (setq beg (point)))
(let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case ()
(set-buffer gnus-summary-buffer)
(error))
gnus-newsgroup-ignored-charsets)))
- (gnus-bind-safe-url-regexp (mm-display-part handle t)))
- (goto-char (point-max)))
+ (gnus-bind-safe-url-regexp (mm-display-part handle t))))
((and text not-attachment)
- (when move
- (forward-line -1)
- (setq beg (point)))
- (gnus-article-insert-newline)
- (mm-display-inline handle)
- (goto-char (point-max))))
+ (mm-display-inline handle)))
+ (goto-char (point-max))
+ (if (string-match "\\`image/" type)
+ (gnus-article-insert-newline)
+ (if (prog1
+ (= (skip-chars-backward "\n") -1)
+ (unless (eobp) (forward-char 1)))
+ (gnus-article-insert-newline)
+ (put-text-property (point) (point-max) 'gnus-undeletable t))
+ (goto-char (point-max)))
;; Do highlighting.
(save-excursion
(save-restriction
@@ -6015,7 +6159,7 @@ If displaying \"text/html\" is discouraged \(see
(let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
- handle (inhibit-read-only t) from props begend not-pref)
+ handle (inhibit-read-only t) from begend not-pref)
(save-window-excursion
(save-restriction
(when ibegend
@@ -6102,7 +6246,10 @@ If displaying \"text/html\" is discouraged \(see
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
- (goto-char point))))
+ (goto-char point)))
+ ;; Redraw attachment buttons in the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(defconst gnus-article-wash-status-strings
(let ((alist '((cite "c" "Possible hidden citation text"
@@ -6208,6 +6355,111 @@ Provided for backwards compatibility."
(when image
(gnus-add-image 'shr image))))
+(defun gnus-article-mime-handles (&optional alist id all)
+ (if alist
+ (let ((i 1) newid flat)
+ (dolist (handle alist flat)
+ (setq newid (append id (list i))
+ i (1+ i))
+ (if (stringp (car handle))
+ (setq flat (nconc flat (gnus-article-mime-handles
+ (cdr handle) newid all)))
+ (delq (rassq handle all) all)
+ (setq flat (nconc flat (list (cons newid handle)))))))
+ (let ((flat (list nil)))
+ ;; Assume that elements of `gnus-article-mime-handle-alist'
+ ;; are in the decreasing order, but unnumbered subsidiaries
+ ;; in each element are in the increasing order.
+ (dolist (handle (reverse gnus-article-mime-handle-alist))
+ (if (stringp (cadr handle))
+ (setq flat (nconc flat (gnus-article-mime-handles
+ (cddr handle) (list (car handle)) flat)))
+ (delq (rassq (cdr handle) flat) flat)
+ (setq flat (nconc flat (list (cons (list (car handle))
+ (cdr handle)))))))
+ (setq flat (cdr flat))
+ (mapc (lambda (handle)
+ (if (cdar handle)
+ ;; This is a hidden (i.e. unnumbered) handle.
+ (progn
+ (setcar handle
+ (1+ (caar gnus-article-mime-handle-alist)))
+ (push handle gnus-article-mime-handle-alist))
+ (setcar handle (caar handle))))
+ flat)
+ flat)))
+
+(defun gnus-mime-buttonize-attachments-in-header (&optional interactive)
+ "Show attachments as buttons in the end of the header of an article.
+This function toggles the display when called interactively. Note that
+buttons to be added to the header are only the ones that aren't inlined
+in the body. Use `gnus-header-face-alist' to highlight buttons."
+ (interactive (list t))
+ (gnus-with-article-buffer
+ (let ((case-fold-search t) buttons handle type st)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ ;; Header buttons exist?
+ (while (and (not buttons)
+ (re-search-forward "^attachments?:[\n ]+" nil t))
+ (when (get-char-property (match-end 0)
+ 'gnus-button-attachment-extra)
+ (setq buttons (match-beginning 0))))
+ (widen)
+ (when buttons
+ ;; Delete header buttons.
+ (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max))))
+ (unless (and interactive buttons)
+ ;; Find buttons.
+ (setq buttons nil)
+ (dolist (button (gnus-article-mime-handles))
+ (setq handle (cdr button)
+ type (mm-handle-media-type handle))
+ (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-inhibit-images)
+ gnus-inhibit-images)
+ (string-match "\\`image/" type))
+ (mm-inline-override-p handle)
+ (and (mm-handle-disposition handle)
+ (not (equal (car (mm-handle-disposition handle))
+ "inline"))
+ (not (mm-attachment-override-p handle)))
+ (not (mm-automatic-display-p handle))
+ (not (or (and (mm-inlinable-p handle)
+ (mm-inlined-p handle))
+ (mm-automatic-external-display-p type))))
+ (push button buttons)))
+ (when buttons
+ ;; Add header buttons.
+ (article-goto-body)
+ (forward-line -1)
+ (narrow-to-region (point) (point))
+ (insert "Attachment" (if (cdr buttons) "s" "") ":")
+ (dolist (button (nreverse buttons))
+ (setq st (point))
+ (insert " ")
+ (mm-handle-set-undisplayer (setq handle (cdr button)) nil)
+ (gnus-insert-mime-button handle (car button))
+ (skip-chars-backward "\t\n ")
+ (delete-region (point) (point-max))
+ (when (> (current-column) (window-width))
+ (goto-char st)
+ (insert "\n")
+ (end-of-line)))
+ (insert "\n")
+ (dolist (ovl (overlays-in (point-min) (point)))
+ (overlay-put ovl 'gnus-button-attachment-extra t)
+ (overlay-put ovl 'face nil))
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head)))))))))
+
;;; Article savers.
(defun gnus-output-to-file (file-name)
@@ -6393,6 +6645,8 @@ specifies."
(if header-line-format 1 0)
2)))))))
+(defvar scroll-in-place)
+
(defun gnus-article-next-page-1 (lines)
(condition-case ()
(let ((scroll-in-place nil)
@@ -6477,10 +6731,12 @@ not have a face in `gnus-article-boring-faces'."
(defun gnus-article-check-buffer ()
"Beep if not in an article buffer."
- (unless (equal major-mode 'gnus-article-mode)
+ (unless (derived-mode-p 'gnus-article-mode)
(error "Command invoked outside of a Gnus article buffer")))
-(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
+(defvar gnus-pick-mode)
+
+(defun gnus-article-read-summary-keys (&optional _arg key not-restore-window)
"Read a summary buffer key sequence and execute it from the article buffer."
(interactive "P")
(gnus-article-check-buffer)
@@ -6493,8 +6749,6 @@ not have a face in `gnus-article-boring-faces'."
"An" "Ap" [?A (meta return)] [?A delete]))
(nosave-in-article
'("AS" "\C-d"))
- (up-to-top
- '("n" "Gn" "p" "Gp"))
keys new-sum-point)
(with-current-buffer gnus-article-current-summary
(let (gnus-pick-mode)
@@ -6576,7 +6830,7 @@ not have a face in `gnus-article-boring-faces'."
(when (eq obuf (current-buffer))
(set-buffer in-buffer)
t))
- (setq selected (gnus-summary-select-article))
+ (setq selected (ignore-errors (gnus-summary-select-article)))
(set-buffer obuf)
(unless not-restore-window
(set-window-configuration owin))
@@ -6592,7 +6846,7 @@ not have a face in `gnus-article-boring-faces'."
new-sum-point
(window-live-p win)
(with-current-buffer (window-buffer win)
- (eq major-mode 'gnus-summary-mode)))
+ (derived-mode-p 'gnus-summary-mode)))
(set-window-point win new-sum-point)
(set-window-start win new-sum-start)
(set-window-hscroll win new-sum-hscroll))))
@@ -6617,11 +6871,13 @@ KEY is a string or a vector."
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
- (append key nil)
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)))
+ (append key unread-command-events)
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events)))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key (read-key-sequence nil t))))
@@ -6639,11 +6895,13 @@ KEY is a string or a vector."
(with-current-buffer gnus-article-current-summary
(setq unread-command-events
(if (featurep 'xemacs)
- (append key nil)
- (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
- (list 'meta (- x 128))
- x))
- key)))
+ (append key unread-command-events)
+ (nconc
+ (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+ (list 'meta (- x 128))
+ x))
+ key)
+ unread-command-events)))
(let ((cursor-in-echo-area t)
gnus-pick-mode)
(describe-key-briefly (read-key-sequence nil t) insert)))
@@ -6653,6 +6911,7 @@ KEY is a string or a vector."
(defvar gnus-agent-summary-mode)
(defvar gnus-draft-mode)
(defvar help-xref-stack-item)
+(defvar help-xref-following)
(defun gnus-article-describe-bindings (&optional prefix)
"Show a list of all defined keys, and their definitions.
@@ -6772,8 +7031,7 @@ If given a prefix, show the hidden text instead."
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
-(eval-when-compile
- (autoload 'nneething-get-file-name "nneething"))
+(declare-function nneething-get-file-name "nneething" (id))
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
@@ -6952,6 +7210,8 @@ If given a prefix, show the hidden text instead."
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
+ "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))
;; Block nothing in news groups.
@@ -7097,7 +7357,6 @@ groups."
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
(start (window-start))
- (p (point))
(winconf gnus-prev-winconf))
(widen) ;; Widen it in case that users narrowed the buffer.
(funcall func arg)
@@ -7286,7 +7545,7 @@ must return `mid', `mail', `invalid' or `ask'."
(10.0 . "^[^0-9]+@")
(3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@")
;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
- (3.0 . "\@stud")
+ (3.0 . "@stud")
;;
(2.0 . "[a-z][a-z][._-][A-Z][a-z].*@")
;;
@@ -7294,7 +7553,7 @@ must return `mid', `mail', `invalid' or `ask'."
(0.5 . "^[A-Z][a-z][a-z]")
(1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3}
(2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4}
- "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
+ "An alist of (RATE . REGEXP) pairs for `gnus-button-mid-or-mail-heuristic'.
A negative RATE indicates a message IDs, whereas a positive indicates a mail
address. The REGEXP is processed with `case-fold-search' set to nil."
@@ -7353,9 +7612,9 @@ address, `ask' if unsure and `invalid' if the string is invalid."
(gnus-message
9 "Many digits in `%s', rate `%s', result `%s'."
mid-or-mail rate result))
- ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@"
+ ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*@"
mid-or-mail)
- ;; Too few vowels [^aeiouy]{4,}.*\@
+ ;; Too few vowels [^aeiouy]{4,}.*@
(setq result (+ result -5.0))
(gnus-message
9 "Few vowels in `%s', rate `%s', result `%s'."
@@ -7465,7 +7724,7 @@ Calls `describe-variable' or `describe-function'."
"Call `locate-library' when pushing the corresponding URL button."
(gnus-message 9 "url=`%s'" url)
(let* ((lib (locate-library url))
- (file (gnus-replace-in-string (or lib "") "\.elc" ".el")))
+ (file (gnus-replace-in-string (or lib "") "\\.elc" ".el")))
(if (not lib)
(gnus-message 1 "Cannot locale library `%s'." url)
(find-file-read-only file))))
@@ -7572,11 +7831,11 @@ positives are possible."
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
;; Exclude [.?] for URLs in gmane.emacs.cvs
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][-a-z0-9]+\\.el\\)'"
+ ("['`‘]\\([a-z][-a-z0-9]+\\.el\\)['’]"
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
- ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
+ ("['`‘]\\([a-z][a-z0-9]+-[a-z]+\\)['’]"
0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
@@ -7586,7 +7845,7 @@ positives are possible."
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
- ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+ ("['`‘]\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^'’]+\\)\\)['’]"
;; 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)
@@ -7726,7 +7985,7 @@ do the highlighting. See the documentation for those functions."
(gnus-article-add-buttons)
(gnus-article-add-buttons-to-head))
-(defun gnus-article-highlight-some (&optional force)
+(defun gnus-article-highlight-some (&optional _force)
"Highlight current article.
This function calls `gnus-article-highlight-headers',
`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
@@ -7778,8 +8037,8 @@ It does this by highlighting everything after
(save-restriction
(when (and gnus-signature-face
(gnus-article-narrow-to-signature))
- (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
- 'face gnus-signature-face)
+ (overlay-put (make-overlay (point-min) (point-max) nil t)
+ 'face gnus-signature-face)
(widen)
(gnus-article-search-signature)
(let ((start (match-beginning 0))
@@ -7854,7 +8113,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(< (match-end 0) start))
(regexp-quote (match-string 0)))
"\
-\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
+[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
delim "\\)"))
(while (progn
(forward-line 1)
@@ -7877,12 +8136,12 @@ url is put as the `gnus-button-url' overlay property on the button."
'gnus-button-push
(list beg (assq 'gnus-button-url-regexp
gnus-button-alist)))))
- (let ((overlay (gnus-make-overlay start end)))
- (gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'gnus-button-url
- (list (mapconcat 'identity (nreverse url) "")))
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'evaporate t)
+ (overlay-put overlay 'gnus-button-url
+ (list (mapconcat 'identity (nreverse url) "")))
(when gnus-article-mouse-face
- (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
+ (overlay-put overlay 'mouse-face gnus-article-mouse-face)))
t)
(goto-char opoint))))
@@ -7921,8 +8180,8 @@ url is put as the `gnus-button-url' overlay property on the button."
(defun gnus-article-add-button (from to fun &optional data text)
"Create a button between FROM and TO with callback FUN and data DATA."
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay from to nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay from to nil t)
+ 'face gnus-article-button-face))
(gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
@@ -8029,9 +8288,11 @@ url is put as the `gnus-button-url' overlay property on the button."
(error "Unknown news URL syntax"))))
(list scheme server port group message-id articles)))
+(defvar nntp-port-number)
+
(defun gnus-button-handle-news (url)
"Fetch a news URL."
- (destructuring-bind (scheme server port group message-id articles)
+ (destructuring-bind (_scheme server port group message-id _articles)
(gnus-parse-news-url url)
(cond
(message-id
@@ -8153,7 +8414,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(with-current-buffer gnus-summary-buffer
(gnus-summary-refer-article message-id)))
-(defun gnus-button-fetch-group (address &rest ignore)
+(defun gnus-button-fetch-group (address &rest _ignore)
"Fetch GROUP specified by ADDRESS."
(when (string-match "\\`\\(nntp\\|news\\):\\(//\\)?\\(.*\\)\\'"
address)
@@ -8201,15 +8462,15 @@ url is put as the `gnus-button-url' overlay property on the button."
(setq url (replace-regexp-in-string "\n" " " url))
(when (string-match "mailto:/*\\(.*\\)" url)
(setq url (substring url (match-beginning 1) nil)))
- (let (to args subject func)
- (setq args (gnus-url-parse-query-string
+ (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)))
+ (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)))))
@@ -8259,14 +8520,14 @@ url is put as the `gnus-button-url' overlay property on the button."
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:action 'gnus-button-prev-page
:button-keymap gnus-prev-page-map)))
-(defun gnus-button-next-page (&optional args more-args)
+(defun gnus-button-next-page (&optional _args _more-args)
"Go to the next page."
(interactive)
(let ((win (selected-window)))
@@ -8274,7 +8535,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(gnus-article-next-page)
(select-window win)))
-(defun gnus-button-prev-page (&optional args more-args)
+(defun gnus-button-prev-page (&optional _args _more-args)
"Go to the prev page."
(interactive)
(let ((win (selected-window)))
@@ -8295,14 +8556,14 @@ url is put as the `gnus-button-url' overlay property on the button."
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:action 'gnus-button-next-page
:button-keymap gnus-next-page-map)))
-(defun gnus-article-button-next-page (arg)
+(defun gnus-article-button-next-page (_arg)
"Go to the next page."
(interactive "P")
(let ((win (selected-window)))
@@ -8310,7 +8571,7 @@ url is put as the `gnus-button-url' overlay property on the button."
(gnus-article-next-page)
(select-window win)))
-(defun gnus-article-button-prev-page (arg)
+(defun gnus-article-button-prev-page (_arg)
"Go to the prev page."
(interactive "P")
(let ((win (selected-window)))
@@ -8361,20 +8622,31 @@ For example:
(defvar gnus-inhibit-article-treatments nil)
-(defun gnus-treat-article (gnus-treat-condition
- &optional part-number total-parts gnus-treat-type)
- (let ((gnus-treat-length (- (point-max) (point-min)))
+;; Dynamic variables.
+(defvar part-number) ;FIXME: Lacks a "gnus-" prefix.
+(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix.
+(defvar gnus-treat-type)
+(defvar gnus-treat-condition)
+(defvar gnus-treat-length)
+
+(defun gnus-treat-article (condition
+ &optional part-num total type)
+ (let ((gnus-treat-condition condition)
+ (part-number part-num)
+ (total-parts total)
+ (gnus-treat-type type)
+ (gnus-treat-length (- (point-max) (point-min)))
(alist gnus-treatment-function-alist)
(article-goto-body-goes-to-point-min-p t)
(treated-type
- (or (not gnus-treat-type)
+ (or (not type)
(catch 'found
(let ((list gnus-article-treat-types))
(while list
- (when (string-match (pop list) gnus-treat-type)
+ (when (string-match (pop list) type)
(throw 'found t)))))))
(highlightp (gnus-visual-p 'article-highlight 'highlight))
- val elem)
+ val)
(gnus-run-hooks 'gnus-part-display-hook)
(dolist (elem alist)
(setq val
@@ -8392,13 +8664,6 @@ For example:
(save-restriction
(funcall (cadr elem)))))))
-;; Dynamic variables.
-(defvar part-number)
-(defvar total-parts)
-(defvar gnus-treat-type)
-(defvar gnus-treat-condition)
-(defvar gnus-treat-length)
-
(defun gnus-treat-predicate (val)
(cond
((null val)
@@ -8647,7 +8912,7 @@ For example:
(gnus-mime-security-show-details handle)
(gnus-mime-security-verify-or-decrypt handle))))
-(defun gnus-insert-mime-security-button (handle &optional displayed)
+(defun gnus-insert-mime-security-button (handle &optional _displayed)
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(gnus-tmp-type
(concat
@@ -8687,15 +8952,15 @@ For example:
(1- (point))
(point)))
(when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay b e nil t)
- 'face gnus-article-button-face))
+ (overlay-put (make-overlay b e nil t)
+ 'face gnus-article-button-face))
(widget-convert-button
'link b e
:mime-handle handle
:action 'gnus-widget-press-button
:button-keymap gnus-mime-security-button-map
:help-echo
- (lambda (widget)
+ (lambda (_widget)
;; Needed to properly clear the message due to a bug in
;; wid-edit (XEmacs only).
(when (boundp 'help-echo-owns-message)
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index d0afd1aa932..d4d3dba2417 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -1,6 +1,6 @@
;;; gnus-async.el --- asynchronous support for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -226,9 +226,6 @@ that was fetched."
`(lambda (arg)
(gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
-(eval-when-compile
- (autoload 'gnus-html-prefetch-images "gnus-html"))
-
(defun gnus-async-article-callback (arg group article mark summary next)
"Function called when an async article is done being fetched."
(save-excursion
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index e4d87151432..e0c457a8829 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -1,6 +1,6 @@
;;; gnus-bcklg.el --- backlog functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -61,7 +61,7 @@
(defun gnus-backlog-enter-article (group number buffer)
(when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
+ (not (gnus-virtual-group-p group)))
(gnus-backlog-setup)
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
@@ -126,7 +126,7 @@
(defun gnus-backlog-request-article (group number &optional buffer)
(when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
+ (not (gnus-virtual-group-p group)))
(gnus-backlog-setup)
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 7a3d273622a..3e4807cd7ce 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -1,6 +1,6 @@
;;; gnus-bookmark.el --- Bookmarks in Gnus
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Keywords: news
@@ -101,7 +101,7 @@ List of details is defined in `gnus-bookmark-bookmark-inline-details'.
This may result in truncated bookmark names. To disable this, put the
following in your `.emacs' file:
-\(setq gnus-bookmark-bmenu-toggle-infos nil\)"
+\(setq gnus-bookmark-bmenu-toggle-infos nil)"
:type 'boolean
:group 'gnus-bookmark)
@@ -118,7 +118,7 @@ You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\
(defcustom gnus-bookmark-bookmark-inline-details '(author)
"Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
-The default value is \(subject\)."
+The default value is \(subject)."
:type '(list :tag "Gnus bookmark details"
(set :inline t
(const :tag "Author" author)
@@ -131,7 +131,7 @@ The default value is \(subject\)."
(defcustom gnus-bookmark-bookmark-details
'(author subject date group annotation)
"Details to be shown with `gnus-bookmark-bmenu-show-details'.
-The default value is \(author subject date group annotation\)."
+The default value is \(author subject date group annotation)."
:type '(list :tag "Gnus bookmark details"
(set :inline t
(const :tag "Author" author)
@@ -160,17 +160,17 @@ You should never need to change this.")
"Association list of Gnus bookmarks and their records.
The format of the alist is
- \(BMK1 BMK2 ...\)
+ (BMK1 BMK2 ...)
where each BMK is of the form
\(NAME
- \(group . GROUP\)
- \(message-id . MESSAGE-ID\)
- \(author . AUTHOR\)
- \(date . DATE\)
- \(subject . SUBJECT\)
- \(annotation . ANNOTATION\)\)
+ (group . GROUP)
+ (message-id . MESSAGE-ID)
+ (author . AUTHOR)
+ (date . DATE)
+ (subject . SUBJECT)
+ (annotation . ANNOTATION))
So the cdr of each bookmark is an alist too.")
@@ -190,7 +190,7 @@ So the cdr of each bookmark is an alist too.")
"Set a bookmark for this article."
(interactive)
(gnus-bookmark-maybe-load-default-file)
- (if (or (not (eq major-mode 'gnus-summary-mode))
+ (if (or (not (derived-mode-p 'gnus-summary-mode))
(not gnus-article-current))
(error "Please select an article in the Gnus summary buffer")
(let* ((group (car gnus-article-current))
@@ -251,7 +251,7 @@ So the cdr of each bookmark is an alist too.")
(interactive)
(save-excursion
(save-window-excursion
- ;; Avoir warnings?
+ ;; Avoid warnings?
;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
(set-buffer (get-buffer-create " *Gnus bookmarks*"))
(erase-buffer)
@@ -432,7 +432,7 @@ That is, all information but the name."
(car (cdr (gnus-bookmark-get-bookmark bookmark))))
(defun gnus-bookmark-name-from-full-record (full-record)
- "Return name of FULL-RECORD \(an alist element instead of a string\)."
+ "Return name of FULL-RECORD (an alist element instead of a string)."
(car full-record))
(defvar gnus-bookmark-bmenu-bookmark-column nil)
@@ -473,7 +473,7 @@ That is, all information but the name."
;; Been to lazy to use gnus-bookmark-save...
(defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
-(defun gnus-bookmark-bmenu-mode ()
+(define-derived-mode gnus-bookmark-bmenu-mode fundamental-mode "Bookmark Menu"
"Major mode for editing a list of Gnus bookmarks.
Each line describes one of the bookmarks in Gnus.
Letters do not insert themselves; instead, they are commands.
@@ -484,7 +484,7 @@ Gnus bookmarks names preceded by a \"*\" have annotations.
Also show bookmarks marked using m in other windows.
\\[gnus-bookmark-bmenu-toggle-infos] -- toggle displaying of details (they may obscure long bookmark names).
\\[gnus-bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
-\\[gnus-bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
+\\[gnus-bookmark-bmenu-rename] -- rename this bookmark (prompts for new name).
\\[gnus-bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
\\[gnus-bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
\\[gnus-bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[gnus-bookmark-bmenu-delete]'.
@@ -497,13 +497,8 @@ Gnus bookmarks names preceded by a \"*\" have annotations.
in another buffer.
\\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
- (kill-all-local-variables)
- (use-local-map gnus-bookmark-bmenu-mode-map)
(setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'gnus-bookmark-bmenu-mode)
- (setq mode-name "Bookmark Menu")
- (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
+ (setq buffer-read-only t))
;; avoid compilation warnings
(defvar gnus-bookmark-bmenu-toggle-infos nil)
@@ -811,7 +806,7 @@ command."
Removes only the first instance of a bookmark with that name. If
there are one or more other bookmarks with the same name, they will
not be deleted. Defaults to the \"current\" bookmark \(that is, the
-one most recently used in this file, if any\).
+one most recently used in this file, if any).
Optional second arg BATCH means don't update the bookmark list buffer,
probably because we were called from there."
(gnus-bookmark-maybe-load-default-file)
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index b3cdb3b2b17..2e8b2dbbe9f 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -1,6 +1,6 @@
;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 22e97cd8f4f..57fc2816155 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -1,6 +1,6 @@
;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Per Abhiddenware
@@ -786,12 +786,12 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-cite-delete-overlays ()
(dolist (overlay gnus-cite-overlay-list)
(ignore-errors
- (when (or (not (gnus-overlay-end overlay))
- (and (>= (gnus-overlay-end overlay) (point-min))
- (<= (gnus-overlay-end overlay) (point-max))))
+ (when (or (not (overlay-end overlay))
+ (and (>= (overlay-end overlay) (point-min))
+ (<= (overlay-end overlay) (point-max))))
(setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
(ignore-errors
- (gnus-delete-overlay overlay))))))
+ (delete-overlay overlay))))))
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
@@ -1096,10 +1096,10 @@ See also the documentation for `gnus-article-highlight-citation'."
(skip-chars-backward " \t")
(setq to (point))
(when (< from to)
- (push (setq overlay (gnus-make-overlay from to))
+ (push (setq overlay (make-overlay from to nil t))
gnus-cite-overlay-list)
- (gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'face face))))))
+ (overlay-put overlay 'evaporate t)
+ (overlay-put overlay 'face face))))))
(defun gnus-cite-toggle (prefix)
(with-current-buffer gnus-article-buffer
@@ -1204,7 +1204,8 @@ When enabled, it automatically turns on `font-lock-mode'."
nil ;; init-value
"" ;; lighter
nil ;; keymap
- (when (eq major-mode 'message-mode)
+ (when (eq major-mode 'message-mode) ;FIXME: Use derived-mode-p.
+ ;; FIXME: Use font-lock-add-keywords!
(let ((defaults (car (if (featurep 'xemacs)
(get 'message-mode 'font-lock-defaults)
font-lock-defaults)))
@@ -1233,8 +1234,10 @@ When enabled, it automatically turns on `font-lock-mode'."
font-lock-keywords nil))
(setq font-lock-set-defaults nil))
(font-lock-set-defaults)
- (cond ((symbol-value 'font-lock-mode)
- (font-lock-fontify-buffer))
+ (cond (font-lock-mode
+ (if (fboundp 'font-lock-flush)
+ (font-lock-flush)
+ (font-lock-fontify-buffer)))
(gnus-message-citation-mode
(font-lock-mode 1)))))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
new file mode 100644
index 00000000000..f965f989b71
--- /dev/null
+++ b/lisp/gnus/gnus-cloud.el
@@ -0,0 +1,343 @@
+;;; gnus-cloud.el --- storing and retrieving data via IMAP
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'parse-time)
+(require 'nnimap)
+
+(defgroup gnus-cloud nil
+ "Syncing Gnus data via IMAP."
+ :version "25.1"
+ :group 'gnus)
+
+(defcustom gnus-cloud-synced-files
+ '(;;"~/.authinfo"
+ "~/.authinfo.gpg"
+ "~/.gnus.el"
+ (:directory "~/News" :match ".*.SCORE\\'"))
+ "List of file regexps that should be kept up-to-date via the cloud."
+ :group 'gnus-cloud
+ ;; FIXME this type does not match the default. Nor does the documentation.
+ :type '(repeat regexp))
+
+(defvar gnus-cloud-group-name "*Emacs Cloud*")
+(defvar gnus-cloud-covered-servers nil)
+
+(defvar gnus-cloud-version 1)
+(defvar gnus-cloud-sequence 1)
+
+(defvar gnus-cloud-method nil
+ "The IMAP select method used to store the cloud data.")
+
+(defun gnus-cloud-make-chunk (elems)
+ (with-temp-buffer
+ (insert (format "Version %s\n" gnus-cloud-version))
+ (insert (gnus-cloud-insert-data elems))
+ (buffer-string)))
+
+(defun gnus-cloud-insert-data (elems)
+ (mm-with-unibyte-buffer
+ (dolist (elem elems)
+ (cond
+ ((eq (plist-get elem :type) :file)
+ (let (length data)
+ (mm-with-unibyte-buffer
+ (insert-file-contents-literally (plist-get elem :file-name))
+ (setq length (buffer-size)
+ data (buffer-string)))
+ (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n"
+ (plist-get elem :file-name)
+ (plist-get elem :timestamp)
+ length))
+ (insert data)
+ (insert "\n")))
+ ((eq (plist-get elem :type) :data)
+ (insert (format "(:type :data :name %S :length %d)\n"
+ (plist-get elem :name)
+ (with-current-buffer (plist-get elem :buffer)
+ (buffer-size))))
+ (insert-buffer-substring (plist-get elem :buffer))
+ (insert "\n"))
+ ((eq (plist-get elem :type) :delete)
+ (insert (format "(:type :delete :file-name %S)\n"
+ (plist-get elem :file-name))))))
+ (gnus-cloud-encode-data)
+ (buffer-string)))
+
+(defun gnus-cloud-encode-data ()
+ (call-process-region (point-min) (point-max) "gzip"
+ t (current-buffer) nil
+ "-c")
+ (base64-encode-region (point-min) (point-max)))
+
+(defun gnus-cloud-decode-data ()
+ (base64-decode-region (point-min) (point-max))
+ (call-process-region (point-min) (point-max) "gunzip"
+ t (current-buffer) nil
+ "-c"))
+
+(defun gnus-cloud-parse-chunk ()
+ (save-excursion
+ (goto-char (point-min))
+ (unless (looking-at "Version \\([0-9]+\\)")
+ (error "Not a valid Cloud chunk in the current buffer"))
+ (forward-line 1)
+ (let ((version (string-to-number (match-string 1)))
+ (data (buffer-substring (point) (point-max))))
+ (mm-with-unibyte-buffer
+ (insert data)
+ (cond
+ ((= version 1)
+ (gnus-cloud-decode-data)
+ (goto-char (point-min))
+ (gnus-cloud-parse-version-1))
+ (t
+ (error "Unsupported Cloud chunk version %s" version)))))))
+
+(defun gnus-cloud-parse-version-1 ()
+ (let ((elems nil))
+ (while (not (eobp))
+ (while (and (not (eobp))
+ (not (looking-at "(:type")))
+ (forward-line 1))
+ (unless (eobp)
+ (let ((spec (ignore-errors (read (current-buffer))))
+ length)
+ (when (and (consp spec)
+ (memq (plist-get spec :type) '(:file :data :delete)))
+ (setq length (plist-get spec :length))
+ (push (append spec
+ (list
+ :contents (buffer-substring (1+ (point))
+ (+ (point) 1 length))))
+ elems)
+ (goto-char (+ (point) 1 length))))))
+ (nreverse elems)))
+
+(defun gnus-cloud-update-data (elems)
+ (dolist (elem elems)
+ (let ((type (plist-get elem :type)))
+ (cond
+ ((eq type :data)
+ )
+ ((eq type :delete)
+ (gnus-cloud-delete-file (plist-get elem :file-name))
+ )
+ ((eq type :file)
+ (gnus-cloud-update-file elem))
+ (t
+ (message "Unknown type %s; ignoring" type))))))
+
+(defun gnus-cloud-update-file (elem)
+ (let ((file-name (plist-get elem :file-name))
+ (date (plist-get elem :timestamp))
+ (contents (plist-get elem :contents)))
+ (unless (gnus-cloud-file-covered-p file-name)
+ (message "%s isn't covered by the cloud; ignoring" file-name))
+ (when (or (not (file-exists-p file-name))
+ (and (file-exists-p file-name)
+ (mm-with-unibyte-buffer
+ (insert-file-contents-literally file-name)
+ (not (equal (buffer-string) contents)))))
+ (gnus-cloud-replace-file file-name date contents))))
+
+(defun gnus-cloud-replace-file (file-name date new-contents)
+ (mm-with-unibyte-buffer
+ (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))))
+
+(defun gnus-cloud-delete-file (file-name)
+ (unless (gnus-cloud-file-covered-p file-name)
+ (message "%s isn't covered by the cloud; ignoring" file-name))
+ (when (file-exists-p file-name)
+ (rename-file file-name (car (find-backup-file-name file-name)))))
+
+(defun gnus-cloud-file-covered-p (file-name)
+ (let ((matched nil))
+ (dolist (elem gnus-cloud-synced-files)
+ (cond
+ ((stringp elem)
+ (when (equal elem file-name)
+ (setq matched t)))
+ ((consp elem)
+ (when (and (equal (directory-file-name (plist-get elem :directory))
+ (directory-file-name (file-name-directory file-name)))
+ (string-match (plist-get elem :match)
+ (file-name-nondirectory file-name)))
+ (setq matched t)))))
+ matched))
+
+(defun gnus-cloud-all-files ()
+ (let ((files nil))
+ (dolist (elem gnus-cloud-synced-files)
+ (cond
+ ((stringp elem)
+ (push elem files))
+ ((consp elem)
+ (dolist (file (directory-files (plist-get elem :directory)
+ nil
+ (plist-get elem :match)))
+ (push (format "%s/%s"
+ (directory-file-name (plist-get elem :directory))
+ file)
+ files)))))
+ (nreverse files)))
+
+(defvar gnus-cloud-file-timestamps nil)
+
+(defun gnus-cloud-files-to-upload (&optional full)
+ (let ((files nil)
+ timestamp)
+ (dolist (file (gnus-cloud-all-files))
+ (if (file-exists-p file)
+ (when (setq timestamp (gnus-cloud-file-new-p file full))
+ (push `(:type :file :file-name ,file :timestamp ,timestamp) files))
+ (when (assoc file gnus-cloud-file-timestamps)
+ (push `(:type :delete :file-name ,file) files))))
+ (nreverse files)))
+
+(defun gnus-cloud-file-new-p (file full)
+ (let ((timestamp (format-time-string
+ "%FT%T%z" (nth 5 (file-attributes file))))
+ (old (cadr (assoc file gnus-cloud-file-timestamps))))
+ (when (or full
+ (null old)
+ (string< old timestamp))
+ timestamp)))
+
+(declare-function gnus-activate-group "gnus-start"
+ (group &optional scan dont-check method dont-sub-check))
+(declare-function gnus-subscribe-group "gnus-start"
+ (group &optional previous method))
+
+(defun gnus-cloud-ensure-cloud-group ()
+ (let ((method (if (stringp gnus-cloud-method)
+ (gnus-server-to-method gnus-cloud-method)
+ gnus-cloud-method)))
+ (unless (or (gnus-active gnus-cloud-group-name)
+ (gnus-activate-group gnus-cloud-group-name nil nil
+ gnus-cloud-method))
+ (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method)
+ (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
+ (gnus-subscribe-group gnus-cloud-group-name)))))
+
+(defun gnus-cloud-upload-data (&optional full)
+ (gnus-cloud-ensure-cloud-group)
+ (with-temp-buffer
+ (let ((elems (gnus-cloud-files-to-upload full)))
+ (insert (format "Subject: (sequence: %d type: %s)\n"
+ gnus-cloud-sequence
+ (if full :full :partial)))
+ (insert "From: nobody@invalid.com\n")
+ (insert "\n")
+ (insert (gnus-cloud-make-chunk elems))
+ (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method
+ t t)
+ (setq gnus-cloud-sequence (1+ gnus-cloud-sequence))
+ (gnus-cloud-add-timestamps elems)))))
+
+(defun gnus-cloud-add-timestamps (elems)
+ (dolist (elem elems)
+ (let* ((file-name (plist-get elem :file-name))
+ (old (assoc file-name gnus-cloud-file-timestamps)))
+ (when old
+ (setq gnus-cloud-file-timestamps
+ (delq old gnus-cloud-file-timestamps)))
+ (push (list file-name (plist-get elem :timestamp))
+ gnus-cloud-file-timestamps))))
+
+(defun gnus-cloud-available-chunks ()
+ (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)
+ (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))
+ (active (gnus-active group))
+ headers head)
+ (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)))
+ (push head headers))))
+ (sort (nreverse headers)
+ (lambda (h1 h2)
+ (> (gnus-cloud-chunk-sequence (mail-header-subject h1))
+ (gnus-cloud-chunk-sequence (mail-header-subject h2)))))))
+
+(defun gnus-cloud-chunk-sequence (string)
+ (if (string-match "sequence: \\([0-9]+\\)" string)
+ (string-to-number (match-string 1 string))
+ 0))
+
+(defun gnus-cloud-prune-old-chunks (headers)
+ (let ((headers (reverse headers))
+ (found nil))
+ (while (and headers
+ (not found))
+ (when (string-match "type: :full" (mail-header-subject (car headers)))
+ (setq found t))
+ (pop headers))
+ ;; All the chunks that are older than the newest :full chunk can be
+ ;; deleted.
+ (when headers
+ (gnus-request-expire-articles
+ (mapcar (lambda (h)
+ (mail-header-number h))
+ (nreverse headers))
+ (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)))))
+
+(defun gnus-cloud-download-data ()
+ (let ((articles nil)
+ chunks)
+ (dolist (header (gnus-cloud-available-chunks))
+ (when (> (gnus-cloud-chunk-sequence (mail-header-subject header))
+ gnus-cloud-sequence)
+ (push (mail-header-number header) articles)))
+ (when articles
+ (nnimap-request-articles (nreverse articles) gnus-cloud-group-name)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^Version " nil t)
+ (beginning-of-line)
+ (push (gnus-cloud-parse-chunk) chunks)
+ (forward-line 1))))))
+
+(defun gnus-cloud-server-p (server)
+ (member server gnus-cloud-covered-servers))
+
+(defun gnus-cloud-collect-full-newsrc ()
+ (let ((infos nil))
+ (dolist (info (cdr gnus-newsrc-alist))
+ (when (gnus-cloud-server-p
+ (gnus-method-to-server
+ (gnus-find-method-for-group (gnus-info-group info))))
+ (push info infos)))
+ ))
+
+(provide 'gnus-cloud)
+
+;;; gnus-cloud.el ends here
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index c8fb5b5dc73..9b8cbc3589d 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1,6 +1,6 @@
;;; gnus-cus.el --- customization commands for Gnus
-;; Copyright (C) 1996, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1999-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: news
@@ -33,7 +33,7 @@
;;; Widgets:
-(defun gnus-custom-mode ()
+(define-derived-mode gnus-custom-mode fundamental-mode "Gnus Customize"
"Major mode for editing Gnus customization buffers.
The following commands are available:
@@ -45,9 +45,6 @@ The following commands are available:
Entry to this mode calls the value of `gnus-custom-mode-hook'
if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'gnus-custom-mode
- mode-name "Gnus Customize")
(use-local-map widget-keymap)
;; Emacs stuff:
(when (and (facep 'custom-button-face)
@@ -63,8 +60,7 @@ if that value is non-nil."
(set (make-local-variable 'widget-push-button-prefix) "")
(set (make-local-variable 'widget-push-button-suffix) "")
(set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) ""))
- (gnus-run-mode-hooks 'gnus-custom-mode-hook))
+ (set (make-local-variable 'widget-link-suffix) "")))
;;; Group Customization:
@@ -276,7 +272,7 @@ DOC is a documentation string for the parameter.")
(repeat (list (string :format "%v" :tag "File name"))))
"Which score files to use when using score to select articles to fetch.
- `nil'
+ nil
All articles will be scored to zero (0).
`file'
@@ -440,7 +436,7 @@ to the groups in this topic, then edit the value to suit your taste."
:greedy t
:tag "Agent Parameters"
:format "%t:\n%h%v"
- :doc "\ These agent parameters are
+ :doc "These agent parameters are
recognized by Gnus. They control article selection and expiration for
use in the unplugged cache. Check the [ ] for the parameters you want
to apply to this group or to the groups in this topic, then edit the
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 2cdafe1565b..424f2c09e59 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -1,6 +1,6 @@
;;; gnus-delay.el --- Delayed posting of articles
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Keywords: mail, news, extensions
@@ -98,7 +98,7 @@ DELAY is a string, giving the length of the time. Possible values are:
(setq hour (string-to-number (match-string 1 delay))
minute (string-to-number (match-string 2 delay)))
;; Use current time, except...
- (setq deadline (apply 'vector (decode-time (current-time))))
+ (setq deadline (apply 'vector (decode-time)))
;; ... for minute and hour.
(aset deadline 1 minute)
(aset deadline 2 hour)
@@ -153,7 +153,7 @@ DELAY is a string, giving the length of the time. Possible values are:
(when (gnus-group-entry group)
(gnus-activate-group group)
(add-hook 'message-send-hook
- (lambda () (message-remove-header gnus-delay-header)))
+ (lambda () (message-remove-header gnus-delay-header)) t)
(setq articles (nndraft-articles))
(while (setq article (pop articles))
(gnus-request-head article group)
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 9150988af5d..d6412cd4153 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -1,6 +1,6 @@
;;; gnus-demon.el --- daemonic Gnus behavior
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index fbd04a29e0b..0f5c613ee96 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -1,6 +1,6 @@
;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@xemacs.org>
;; Maintainer: Didier Verna <didier@xemacs.org>
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 1592d73684c..49dcc3862db 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -1,6 +1,6 @@
;;; gnus-dired.el --- utility functions where gnus and dired meet
-;; Copyright (C) 1996-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2015 Free Software Foundation, Inc.
;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
;; Shenghuo Zhu <zsh@cs.rochester.edu>
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 10a34712550..aebf1183051 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -1,6 +1,6 @@
;;; gnus-draft.el --- draft message support for Gnus
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 7e6679a0c05..b6686a30b85 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -1,6 +1,6 @@
;;; gnus-dup.el --- suppression of duplicate articles in Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 6790803305a..c870385840c 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -1,6 +1,6 @@
;;; gnus-eform.el --- a mode for editing forms for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -67,21 +67,15 @@
["Exit" gnus-edit-form-exit t]))
(gnus-run-hooks 'gnus-edit-form-menu-hook)))
-(defun gnus-edit-form-mode ()
+(define-derived-mode gnus-edit-form-mode fundamental-mode "Edit Form"
"Major mode for editing forms.
It is a slightly enhanced emacs-lisp-mode.
\\{gnus-edit-form-mode-map}"
- (interactive)
(when (gnus-visual-p 'group-menu 'menu)
(gnus-edit-form-make-menu-bar))
- (kill-all-local-variables)
- (setq major-mode 'gnus-edit-form-mode)
- (setq mode-name "Edit Form")
- (use-local-map gnus-edit-form-mode-map)
(make-local-variable 'gnus-edit-form-done-function)
- (make-local-variable 'gnus-prev-winconf)
- (gnus-run-mode-hooks 'gnus-edit-form-mode-hook))
+ (make-local-variable 'gnus-prev-winconf))
(defun gnus-edit-form (form documentation exit-func &optional layout)
"Edit FORM in a new buffer.
@@ -102,7 +96,8 @@ The optional LAYOUT overrides the `edit-form' window layout."
(while (not (eobp))
(insert ";;; ")
(forward-line 1))
- (insert ";; Type `C-c C-c' after you've finished editing.\n")
+ (insert (substitute-command-keys
+ ";; Type `C-c C-c' after you've finished editing.\n"))
(insert "\n")
(let ((p (point)))
(gnus-pp form)
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index f9ef70f9580..f1d43475b42 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -1,6 +1,6 @@
;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 1c9b4ceaf94..2a535cb71dd 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -1,6 +1,6 @@
;;; gnus-fun.el --- various frivolous extension functions to Gnus
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
@@ -44,6 +40,24 @@
:group 'gnus-fun
:type 'directory)
+(defcustom gnus-x-face-omit-files nil
+ "Regexp to match faces in `gnus-x-face-directory' to be omitted."
+ :version "25.1"
+ :group 'gnus-fun
+ :type 'string)
+
+(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory)
+ "*Directory where Face PNG files are stored."
+ :version "25.1"
+ :group 'gnus-fun
+ :type 'directory)
+
+(defcustom gnus-face-omit-files nil
+ "Regexp to match faces in `gnus-face-directory' to be omitted."
+ :version "25.1"
+ :group 'gnus-fun
+ :type 'string)
+
(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
"Command for converting a PBM to an X-Face."
:version "22.1"
@@ -86,35 +100,57 @@ PNG format."
nil shell-command-switch command)))
;;;###autoload
-(defun gnus-random-x-face ()
- "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
- (interactive)
- (when (file-exists-p gnus-x-face-directory)
- (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
- (file (nth (random (length files)) files)))
+(defun gnus--random-face-with-type (dir ext omit fun)
+ "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN."
+ (when (file-exists-p dir)
+ (let* ((files
+ (remove nil (mapcar
+ (lambda (f) (unless (string-match (or omit "^$") f) f))
+ (directory-files dir t ext))))
+ (file (nth (random (length files)) files)))
(when file
- (gnus-shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command
- (shell-quote-argument file)))))))
+ (funcall fun file)))))
+;;;###autoload
(autoload 'message-goto-eoh "message" nil t)
+(autoload 'message-insert-header "message" nil t)
+
+(defun gnus--insert-random-face-with-type (fun type)
+ "Get a random face using FUN and insert it as a header TYPE.
+
+For instance, to insert an X-Face use `gnus-random-x-face' as FUN
+ and \"X-Face\" as TYPE."
+ (let ((data (funcall fun)))
+ (save-excursion
+ (if data
+ (progn (message-goto-eoh)
+ (insert type ": " data "\n"))
+ (message
+ "No face returned by the function %s." (symbol-name fun))))))
+
+
+
+;;;###autoload
+(defun gnus-random-x-face ()
+ "Return X-Face header data chosen randomly from `gnus-x-face-directory'.
+
+Files matching `gnus-x-face-omit-files' are not considered."
+ (interactive)
+ (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files
+ (lambda (file)
+ (gnus-shell-command-to-string
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file))))))
;;;###autoload
(defun gnus-insert-random-x-face-header ()
"Insert a random X-Face header from `gnus-x-face-directory'."
(interactive)
- (let ((data (gnus-random-x-face)))
- (save-excursion
- (message-goto-eoh)
- (if data
- (insert "X-Face: " data)
- (message
- "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
- gnus-x-face-directory)))))
+ (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face))
;;;###autoload
(defun gnus-x-face-from-file (file)
- "Insert an X-Face header based on an image file.
+ "Insert an X-Face header based on an image FILE.
Depending on `gnus-convert-image-to-x-face-command' it may accept
different input formats."
@@ -126,7 +162,7 @@ different input formats."
;;;###autoload
(defun gnus-face-from-file (file)
- "Return a Face header based on an image file.
+ "Return a Face header based on an image FILE.
Depending on `gnus-convert-image-to-face-command' it may accept
different input formats."
@@ -191,6 +227,21 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to
(buffer-size)))
(gnus-face-encode)))
+;;;###autoload
+(defun gnus-random-face ()
+ "Return randomly chosen Face from `gnus-face-directory'.
+
+Files matching `gnus-face-omit-files' are not considered."
+ (interactive)
+ (gnus--random-face-with-type gnus-face-directory "\\.png$"
+ gnus-face-omit-files
+ 'gnus-convert-png-to-face))
+
+;;;###autoload
+(defun gnus-insert-random-face-header ()
+ "Insert a random Face header from `gnus-face-directory'."
+ (gnus--insert-random-face-with-type 'gnus-random-face 'Face))
+
(defface gnus-x-face '((t (:foreground "black" :background "white")))
"Face to show X-Face.
The colors from this face are used as the foreground and background
@@ -214,7 +265,7 @@ colors of the displayed X-Faces."
(article-narrow-to-head)
(gnus-article-goto-header "from")
(when (bobp)
- (insert "From: [no `from' set]\n")
+ (insert "From: [no 'from' set]\n")
(forward-char -17))
(gnus-add-image
'xface
@@ -250,20 +301,21 @@ colors of the displayed X-Faces."
(interactive)
(shell-command "xawtv-remote snap ppm")
(let ((file nil)
+ (tempfile (make-temp-file "gnus-face-" nil ".ppm"))
result)
(while (null (setq file (directory-files "/tftpboot/sparky/tmp"
t "snap.*ppm")))
(sleep-for 1))
(setq file (car file))
(shell-command
- (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > /tmp/gnus.face.ppm"
- file))
+ (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm >> %s"
+ file tempfile))
(let ((gnus-convert-image-to-face-command
(format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng"
(gnus-fun-ppm-change-string))))
- (setq result (gnus-face-from-file "/tmp/gnus.face.ppm")))
+ (setq result (gnus-face-from-file tempfile)))
(delete-file file)
- ;;(delete-file "/tmp/gnus.face.ppm")
+ ;;(delete-file tempfile) ; FIXME why are we not deleting it?!
result))
(defun gnus-fun-ppm-change-string ()
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index 33bcb6b1598..c331b018de8 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -1,6 +1,6 @@
;;; gnus-gravatar.el --- Gnus Gravatar support
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 9533f5819a4..b1a4933ebf1 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1,6 +1,6 @@
;;; gnus-group.el --- group mode commands for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
(defvar tool-bar-mode)
@@ -159,7 +155,7 @@ list."
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil))))
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n"
+(defcustom gnus-group-line-format "%M\ %S\ %p\ %P\ %5y:%B%(%g%)\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -217,7 +213,7 @@ See Info node `(gnus)Formatting Variables'."
:group 'gnus-group-visual
:type 'string)
-(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
+(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\ %:%S}"
"*The format specification for the group mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
@@ -449,7 +445,7 @@ If non-nil, the value should be a string or an alist. If it is a string,
e.g. \"nnml:\", in which case `gnus-group-jump-to-group' offers \"Group:
nnml:\" in the minibuffer prompt.
-If it is an alist, it must consist of \(NUMBER . PROMPT\) pairs, for example:
+If it is an alist, it must consist of \(NUMBER . PROMPT) pairs, for example:
\((1 . \"\") (2 . \"nnfolder+archive:\")). The element with number 0 is
used when no prefix argument is given to `gnus-group-jump-to-group'."
:version "22.1"
@@ -482,6 +478,26 @@ simple manner.")
(defvar gnus-group-edit-buffer nil)
+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-colon)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-decoded-group)
+(defvar gnus-tmp-header)
+(defvar gnus-tmp-process-marked)
+(defvar gnus-tmp-summary-live)
+(defvar gnus-tmp-news-method-string)
+(defvar gnus-tmp-group-icon)
+(defvar gnus-tmp-moderated-string)
+(defvar gnus-tmp-newsgroup-description)
+(defvar gnus-tmp-comment)
+(defvar gnus-tmp-qualified-group)
+(defvar gnus-tmp-subscribed)
+(defvar gnus-tmp-number-of-read)
+(defvar gnus-inhibit-demon)
+(defvar gnus-pick-mode)
+(defvar gnus-tmp-marked-mark)
+(defvar gnus-tmp-number-of-unread)
+
(defvar gnus-group-line-format-alist
`((?M gnus-tmp-marked-mark ?c)
(?S gnus-tmp-subscribed ?c)
@@ -571,7 +587,6 @@ simple manner.")
"p" gnus-group-prev-unread-group
"\177" gnus-group-prev-unread-group
[delete] gnus-group-prev-unread-group
- [backspace] gnus-group-prev-unread-group
"N" gnus-group-next-group
"P" gnus-group-prev-group
"\M-n" gnus-group-next-unread-group-same-level
@@ -1105,7 +1120,7 @@ When FORCE, rebuild the tool bar."
(set (make-local-variable 'tool-bar-map) map))))
gnus-group-tool-bar-map)
-(defun gnus-group-mode ()
+(define-derived-mode gnus-group-mode fundamental-mode "Group"
"Major mode for reading news.
All normal editing commands are switched off.
@@ -1122,17 +1137,12 @@ For more in-depth information on this mode, read the manual (`\\[gnus-info-find-
The following commands are available:
\\{gnus-group-mode-map}"
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'group-menu 'menu)
(gnus-group-make-menu-bar)
(gnus-group-make-tool-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-group-mode)
- (setq mode-name "Group")
(gnus-group-set-mode-line)
(setq mode-line-process nil)
- (use-local-map gnus-group-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t
@@ -1143,16 +1153,14 @@ The following commands are available:
(when gnus-use-undo
(gnus-undo-mode 1))
(when gnus-slave
- (gnus-slave-mode))
- (gnus-run-mode-hooks 'gnus-group-mode-hook))
+ (gnus-slave-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
(let ((gnus-process-mark ?\200)
(gnus-group-update-hook nil)
(gnus-group-marked '("dummy.group"))
- (gnus-active-hashtb (make-vector 10 0))
- (topic ""))
+ (gnus-active-hashtb (make-vector 10 0)))
(gnus-set-active "dummy.group" '(0 . 0))
(gnus-set-work-buffer)
(gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
@@ -1193,7 +1201,7 @@ The following commands are available:
(defun gnus-group-setup-buffer ()
(set-buffer (gnus-get-buffer-create gnus-group-buffer))
- (unless (eq major-mode 'gnus-group-mode)
+ (unless (derived-mode-p 'gnus-group-mode)
(gnus-group-mode)))
(defun gnus-group-name-charset (method group)
@@ -1585,7 +1593,7 @@ if it is a string, only list groups matching REGEXP."
gnus-process-mark ? ))
(buffer-read-only nil)
beg end
- header gnus-tmp-header) ; passed as parameter to user-funcs.
+ gnus-tmp-header) ; passed as parameter to user-funcs.
(beginning-of-line)
(setq beg (point))
(gnus-add-text-properties
@@ -1603,20 +1611,31 @@ if it is a string, only list groups matching REGEXP."
gnus-indentation ,gnus-group-indentation
gnus-level ,gnus-tmp-level))
(setq end (point))
- (when gnus-group-update-tool-bar
- (gnus-put-text-property beg end 'point-entered
- 'gnus-tool-bar-update)
- (gnus-put-text-property beg end 'point-left
- 'gnus-tool-bar-update))
+ (gnus-group--setup-tool-bar-update beg end)
(forward-line -1)
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-group-highlight-line gnus-tmp-group beg end))
(gnus-run-hooks 'gnus-group-update-hook)
(forward-line)))
+(defun gnus-group--setup-tool-bar-update (beg end)
+ (when gnus-group-update-tool-bar
+ (if (fboundp 'cursor-sensor-mode)
+ (progn
+ (unless (bound-and-true-p cursor-sensor-mode)
+ (cursor-sensor-mode 1))
+ (gnus-put-text-property beg end 'cursor-sensor-functions
+ '(gnus-tool-bar-update)))
+ (gnus-put-text-property beg end 'point-entered
+ #'gnus-tool-bar-update)
+ (gnus-put-text-property beg end 'point-left
+ #'gnus-tool-bar-update))))
+
(defun gnus-group-update-eval-form (group list)
"Eval `car' of each element of LIST, and return the first that return t.
Some value are bound so the form can use them."
+ (defvar group-age) (defvar ticked) (defvar score) (defvar level)
+ (defvar mailp) (defvar total) (defvar unread)
(when list
(let* ((entry (gnus-group-entry group))
(unread (if (numberp (car entry)) (car entry) 0))
@@ -1795,7 +1814,9 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated."
"Get the name of the newsgroup on the current line."
(let ((group (get-text-property (point-at-bol) 'gnus-group)))
(when group
- (symbol-name group))))
+ (if (stringp group)
+ group
+ (symbol-name group)))))
(defun gnus-group-group-level ()
"Get the level of the newsgroup on the current line."
@@ -2147,13 +2168,13 @@ be permanent."
(defun gnus-group-name-at-point ()
"Return a group name from around point if it exists, or nil."
- (if (eq major-mode 'gnus-group-mode)
+ (if (derived-mode-p 'gnus-group-mode)
(let ((group (gnus-group-group-name)))
(when group
(gnus-group-decoded-name group)))
(let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\
\\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\
-\[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
+[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\
\\|[^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)+\\)")
(start (point))
(case-fold-search nil))
@@ -2414,7 +2435,7 @@ Valid input formats include:
;; URLs providing `group', `start' and `range':
((string-match
;; http://thread.gmane.org/gmane.emacs.devel/86326/focus=86525
- "^http://thread\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
+ "^http://thread\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)/focus=\\([0-9]+\\)$"
url)
(setq group (match-string 1 url)
start (string-to-number (match-string 2 url))
@@ -2425,15 +2446,15 @@ Valid input formats include:
;; URLs providing `group' and `start':
((or (string-match
;; http://article.gmane.org/gmane.comp.gnu.make.bugs/3584
- "^http://\\(?:thread\\|article\\|permalink\\)\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+ "^http://\\(?:thread\\|article\\|permalink\\)\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)"
url)
(string-match
;; Don't advertise these in the doc string yet:
- "^\\(?:nntp\\|news\\)://news\.gmane\.org/\\([^/]+\\)/\\([0-9]+\\)"
+ "^\\(?:nntp\\|news\\)://news\\.gmane\\.org/\\([^/]+\\)/\\([0-9]+\\)"
url)
(string-match
;; http://news.gmane.org/group/gmane.emacs.gnus.general/thread=65099/force_load=t
- "^http://news\.gmane\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
+ "^http://news\\.gmane\\.org/group/\\([^/]+\\)/thread=\\([0-9]+\\)"
url))
(setq group (match-string 1 url)
start (string-to-number (match-string 2 url))))
@@ -2466,27 +2487,27 @@ the bug number, and browsing the URL must return mbox output."
(setq ids (string-to-number ids)))
(unless (listp ids)
(setq ids (list ids)))
- (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))
- (coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
- (with-temp-file tmpfile
- (dolist (id ids)
- (url-insert-file-contents (format mbox-url id)))
- (goto-char (point-min))
- ;; Add the debbugs address so that we can respond to reports easily.
- (while (re-search-forward "^To: " nil t)
- (end-of-line)
- (insert (format ", %s@%s" (car ids)
- (gnus-replace-in-string
- (gnus-replace-in-string mbox-url "^http://" "")
- "/.*$" ""))))
- (write-region (point-min) (point-max) tmpfile)
- (gnus-group-read-ephemeral-group
- (format "nndoc+ephemeral:bug#%s"
- (mapconcat 'number-to-string ids ","))
- `(nndoc ,tmpfile
- (nndoc-article-type mbox))
- nil window-conf))
+ (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")))
+ (let ((coding-system-for-write 'binary)
+ (coding-system-for-read 'binary))
+ (with-temp-file tmpfile
+ (mm-disable-multibyte)
+ (dolist (id ids)
+ (url-insert-file-contents (format mbox-url id)))
+ (goto-char (point-min))
+ ;; Add the debbugs address so that we can respond to reports easily.
+ (while (re-search-forward "^To: " nil t)
+ (end-of-line)
+ (insert (format ", %s@%s" (car ids)
+ (gnus-replace-in-string
+ (gnus-replace-in-string mbox-url "^http://" "")
+ "/.*$" ""))))))
+ (gnus-group-read-ephemeral-group
+ (format "nndoc+ephemeral:bug#%s"
+ (mapconcat 'number-to-string ids ","))
+ `(nndoc ,tmpfile
+ (nndoc-article-type mbox))
+ nil window-conf)
(delete-file tmpfile)))
(defun gnus-read-ephemeral-debian-bug-group (number)
@@ -2735,7 +2756,7 @@ server."
(interactive
(list
(gnus-read-group "Group name: ")
- (gnus-read-method "From method")))
+ (gnus-read-method "Select method for new group (use tab for completion)")))
(when (stringp method)
(setq method (or (gnus-server-to-method method) method)))
@@ -2929,7 +2950,7 @@ and NEW-NAME will be prompted for."
(gnus-info-params info))
(t info))
;; The proper documentation.
- (format
+ (gnus-format-message
"Editing the %s for `%s'."
(cond
((eq part 'method) "select method")
@@ -3114,12 +3135,12 @@ If SOLID (the prefix), create a solid group."
(gnus-group-read-ephemeral-group
group method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
+ (if (derived-mode-p 'gnus-summary-mode) 'summary 'group))))))
(defvar nnrss-group-alist)
(eval-when-compile
- (defun nnrss-discover-feed (arg))
- (defun nnrss-save-server-data (arg)))
+ (defun nnrss-discover-feed (_arg))
+ (defun nnrss-save-server-data (_arg)))
(defun gnus-group-make-rss-group (&optional url)
"Given a URL, discover if there is an RSS feed.
If there is, use Gnus to create an nnrss group"
@@ -3229,7 +3250,7 @@ mail messages or news articles in files that have numeric names."
(unless (gnus-group-read-ephemeral-group
name method t
(cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode)
+ (if (derived-mode-p 'gnus-summary-mode)
'summary 'group)))
(error "Couldn't enter %s" dir))))
@@ -3257,7 +3278,8 @@ mail messages or news articles in files that have numeric names."
(error "%s is not an nnimap group" group))
(unless (setq acl (nnimap-acl-get mailbox (cadr method)))
(error "Server does not support ACL's"))
- (gnus-edit-form acl (format "Editing the access control list for `%s'.
+ (gnus-edit-form acl (gnus-format-message "\
+Editing the access control list for `%s'.
An access control list is a list of (identifier . rights) elements.
@@ -3266,7 +3288,7 @@ mail messages or news articles in files that have numeric names."
Rights is a string listing a (possibly empty) set of alphanumeric
characters, each character listing a set of operations which is being
- controlled. Letters are reserved for ``standard'' rights, listed
+ controlled. Letters are reserved for \"standard\" rights, listed
below. Digits are reserved for implementation or site defined rights.
l - lookup (mailbox is visible to LIST/LSUB commands)
@@ -3768,7 +3790,7 @@ group line."
nil nil (gnus-read-active-file-p))))
(let ((newsrc (gnus-group-entry group)))
(cond
- ((string-match "^[ \t]*$" group)
+ ((string-match "\\`[ \t]*\\'" group)
(error "Empty group name"))
(newsrc
;; Toggle subscription flag.
@@ -4086,7 +4108,9 @@ If DONT-SCAN is non-nil, scan non-activated groups as well."
(gnus-group-remove-mark group)
;; Bypass any previous denials from the server.
(gnus-remove-denial (setq method (gnus-find-method-for-group group)))
- (if (gnus-activate-group group (if dont-scan nil 'scan) nil method)
+ (if (or (and (not dont-scan)
+ (gnus-request-group-scan group (gnus-get-info group)))
+ (gnus-activate-group group (if dont-scan nil 'scan) nil method))
(let ((info (gnus-get-info group))
(active (gnus-active group)))
(when info
@@ -4319,10 +4343,15 @@ The hook `gnus-suspend-gnus-hook' is called before actually suspending."
(unless (or (eq buf group-buf)
(eq buf gnus-dribble-buffer)
(with-current-buffer buf
- (eq major-mode 'message-mode)))
+ (derived-mode-p 'message-mode)))
(gnus-kill-buffer buf)))
(setq gnus-backlog-articles nil)
(gnus-kill-gnus-frames)
+ ;; 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))
(when group-buf
(bury-buffer group-buf)
(delete-windows-on group-buf t))))
@@ -4404,7 +4433,12 @@ and the second element is the address."
;; Suggested by mapjph@bath.ac.uk.
(gnus-completing-read
"Address"
- gnus-secondary-servers))
+ ;; FIXME? gnus-secondary-servers is obsolete,
+ ;; and it is not obvious that there is anything
+ ;; sensible to use instead in this particular case.
+ (if (boundp 'gnus-secondary-servers)
+ gnus-secondary-servers
+ (cdr gnus-select-method))))
;; We got a server name.
how))))
(gnus-browse-foreign-server method))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index a5625dfed80..bedf7e40b10 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -1,6 +1,6 @@
;;; gnus-html.el --- Render HTML in a buffer.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html, web
@@ -139,7 +139,8 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
(charset (mail-content-type-get (mm-handle-type handle)
'charset)))
(when (and charset
- (setq charset (mm-charset-to-coding-system charset))
+ (setq charset (mm-charset-to-coding-system
+ charset nil t))
(not (eq charset 'ascii)))
(insert (prog1
(mm-decode-coding-string (buffer-string) charset)
@@ -306,12 +307,12 @@ Use ALT-TEXT for the image string."
(gnus-article-add-button start end
'browse-url (mm-url-decode-entities-string url)
url)
- (let ((overlay (gnus-make-overlay start end)))
- (gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'gnus-button-url url)
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'evaporate t)
+ (overlay-put overlay 'gnus-button-url url)
(gnus-put-text-property start end 'gnus-string url)
(when gnus-article-mouse-face
- (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))))
+ (overlay-put overlay 'mouse-face gnus-article-mouse-face)))))
;; The upper-case IMG_ALT is apparently just an artifact that
;; should be deleted.
((equal tag "IMG_ALT")
@@ -319,19 +320,19 @@ Use ALT-TEXT for the image string."
;; w3m does not normalize the case
((or (equal tag "b")
(equal tag "B"))
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-bold))
+ (overlay-put (make-overlay start end) 'face 'gnus-emphasis-bold))
((or (equal tag "u")
(equal tag "U"))
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
+ (overlay-put (make-overlay start end) 'face 'gnus-emphasis-underline))
((or (equal tag "i")
(equal tag "I"))
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-italic))
+ (overlay-put (make-overlay start end) 'face 'gnus-emphasis-italic))
((or (equal tag "s")
(equal tag "S"))
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-strikethru))
+ (overlay-put (make-overlay start end) 'face 'gnus-emphasis-strikethru))
((or (equal tag "ins")
(equal tag "INS"))
- (gnus-overlay-put (gnus-make-overlay start end) 'face 'gnus-emphasis-underline))
+ (overlay-put (make-overlay start end) 'face 'gnus-emphasis-underline))
;; Handle different UL types
((equal tag "_SYMBOL")
(when (string-match "TYPE=\\(.+\\)" parameters)
@@ -438,6 +439,9 @@ Return a string with image data."
(truncate (* gnus-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))))
+;; Behind display-graphic-p test.
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(defun gnus-html-put-image (data url &optional alt-text)
"Put an image with DATA from URL and optional ALT-TEXT."
(when (gnus-graphic-display-p)
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index a946a586033..dc423d85d19 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -1,6 +1,6 @@
;;; gnus-icalendar.el --- reply to iCalendar meeting requests
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Jan Tatarik <Jan.Tatarik@gmail.com>
;; Keywords: mail, icalendar, org
@@ -35,8 +35,10 @@
(require 'icalendar)
(require 'eieio)
+(require 'gmm-utils)
(require 'mm-decode)
(require 'gnus-sum)
+(require 'gnus-art)
(eval-when-compile (require 'cl))
@@ -68,14 +70,14 @@
:accessor gnus-icalendar-event:location
:initform ""
:type (or null string))
- (start :initarg :start
- :accessor gnus-icalendar-event:start
+ (start-time :initarg :start-time
+ :accessor gnus-icalendar-event:start-time
:initform ""
- :type (or null string))
- (end :initarg :end
- :accessor gnus-icalendar-event:end
+ :type (or null t))
+ (end-time :initarg :end-time
+ :accessor gnus-icalendar-event:end-time
:initform ""
- :type (or null string))
+ :type (or null t))
(recur :initarg :recur
:accessor gnus-icalendar-event:recur
:initform ""
@@ -90,7 +92,19 @@
(rsvp :initarg :rsvp
:accessor gnus-icalendar-event:rsvp
:initform nil
- :type (or null boolean)))
+ :type (or null boolean))
+ (participation-type :initarg :participation-type
+ :accessor gnus-icalendar-event:participation-type
+ :initform 'non-participant
+ :type (or null t))
+ (req-participants :initarg :req-participants
+ :accessor gnus-icalendar-event:req-participants
+ :initform nil
+ :type (or null t))
+ (opt-participants :initarg :opt-participants
+ :accessor gnus-icalendar-event:opt-participants
+ :initform nil
+ :type (or null t)))
"generic iCalendar Event class")
(defclass gnus-icalendar-event-request (gnus-icalendar-event)
@@ -124,32 +138,21 @@
(or (match-string 1 rrule)
default-interval)))
-(defmethod gnus-icalendar-event:start-time ((event gnus-icalendar-event))
- "Return time value of the EVENT start date."
- (date-to-time (gnus-icalendar-event:start event)))
-
-(defmethod gnus-icalendar-event:end-time ((event gnus-icalendar-event))
- "Return time value of the EVENT end date."
- (date-to-time (gnus-icalendar-event:end event)))
+(defmethod gnus-icalendar-event:start ((event gnus-icalendar-event))
+ (format-time-string "%Y-%m-%d %H:%M" (gnus-icalendar-event:start-time event)))
-
-(defun gnus-icalendar-event--decode-datefield (ical field zone-map &optional date-style)
- (let* ((calendar-date-style (or date-style 'european))
- (date (icalendar--get-event-property ical field))
- (date-zone (icalendar--find-time-zone
- (icalendar--get-event-property-attributes
- ical field)
- zone-map))
- (date-decoded (icalendar--decode-isodatetime date nil date-zone)))
-
- (concat (icalendar--datetime-to-iso-date date-decoded "-")
- " "
- (icalendar--datetime-to-colontime date-decoded))))
+(defun gnus-icalendar-event--decode-datefield (event field zone-map)
+ (let* ((dtdate (icalendar--get-event-property event field))
+ (dtdate-zone (icalendar--find-time-zone
+ (icalendar--get-event-property-attributes
+ event field) zone-map))
+ (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone)))
+ (apply 'encode-time dtdate-dec)))
(defun gnus-icalendar-event--find-attendee (ical name-or-email)
(let* ((event (car (icalendar--all-events ical)))
(event-props (caddr event)))
- (labels ((attendee-name (att) (plist-get (cadr att) 'CN))
+ (gmm-labels ((attendee-name (att) (plist-get (cadr att) 'CN))
(attendee-email (att)
(replace-regexp-in-string "^.*MAILTO:" "" (caddr att)))
(attendee-prop-matches-p (prop)
@@ -162,10 +165,29 @@
(gnus-icalendar-find-if #'attendee-prop-matches-p event-props))))
+(defun gnus-icalendar-event--get-attendee-names (ical)
+ (let* ((event (car (icalendar--all-events ical)))
+ (attendee-props (gnus-remove-if-not
+ (lambda (p) (eq (car p) 'ATTENDEE))
+ (caddr event))))
+
+ (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE))
+ (attendee-name (prop)
+ (or (plist-get (cadr prop) 'CN)
+ (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop))))
+ (attendees-by-type (type)
+ (gnus-remove-if-not
+ (lambda (p) (string= (attendee-role p) type))
+ attendee-props))
+ (attendee-names-by-type (type)
+ (mapcar #'attendee-name (attendees-by-type type))))
+
+ (list
+ (attendee-names-by-type "REQ-PARTICIPANT")
+ (attendee-names-by-type "OPT-PARTICIPANT")))))
(defun gnus-icalendar-event-from-ical (ical &optional attendee-name-or-email)
(let* ((event (car (icalendar--all-events ical)))
- (zone-map (icalendar--convert-all-timezones ical))
(organizer (replace-regexp-in-string
"^.*MAILTO:" ""
(or (icalendar--get-event-property event 'ORGANIZER) "")))
@@ -177,19 +199,28 @@
(method (caddr (assoc 'METHOD (caddr (car (nreverse ical))))))
(attendee (when attendee-name-or-email
(gnus-icalendar-event--find-attendee ical attendee-name-or-email)))
+ (attendee-names (gnus-icalendar-event--get-attendee-names ical))
+ (role (plist-get (cadr attendee) 'ROLE))
+ (participation-type (pcase role
+ ("REQ-PARTICIPANT" 'required)
+ ("OPT-PARTICIPANT" 'optional)
+ (_ 'non-participant)))
+ (zone-map (icalendar--convert-all-timezones ical))
(args (list :method method
:organizer organizer
- :start (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map)
- :end (gnus-icalendar-event--decode-datefield event 'DTEND zone-map)
- :rsvp (string= (plist-get (cadr attendee) 'RSVP)
- "TRUE")))
+ :start-time (gnus-icalendar-event--decode-datefield event 'DTSTART zone-map)
+ :end-time (gnus-icalendar-event--decode-datefield event 'DTEND zone-map)
+ :rsvp (string= (plist-get (cadr attendee) 'RSVP) "TRUE")
+ :participation-type participation-type
+ :req-participants (car attendee-names)
+ :opt-participants (cadr attendee-names)))
(event-class (cond
((string= method "REQUEST") 'gnus-icalendar-event-request)
((string= method "CANCEL") 'gnus-icalendar-event-cancel)
((string= method "REPLY") 'gnus-icalendar-event-reply)
(t 'gnus-icalendar-event))))
- (labels ((map-property (prop)
+ (gmm-labels ((map-property (prop)
(let ((value (icalendar--get-event-property event prop)))
(when value
;; ugly, but cannot get
@@ -233,7 +264,7 @@ status will be retrieved from the first matching attendee record."
(let ((summary-status (capitalize (symbol-name status)))
(attendee-status (upcase (symbol-name status)))
reply-event-lines)
- (labels ((update-summary (line)
+ (gmm-labels ((update-summary (line)
(if (string-match "^[^:]+:" line)
(replace-match (format "\\&%s: " summary-status) t nil line)
line))
@@ -257,9 +288,9 @@ status will be retrieved from the first matching attendee record."
((string= key "ATTENDEE") (update-attendee-status line))
((string= key "SUMMARY") (update-summary line))
((string= key "DTSTAMP") (update-dtstamp))
- ((find key '("ORGANIZER" "DTSTART" "DTEND"
- "LOCATION" "DURATION" "SEQUENCE"
- "RECURRENCE-ID" "UID")) line)
+ ((member key '("ORGANIZER" "DTSTART" "DTEND"
+ "LOCATION" "DURATION" "SEQUENCE"
+ "RECURRENCE-ID" "UID")) line)
(t nil))))
(when new-line
(push new-line reply-event-lines))))))
@@ -280,7 +311,7 @@ status will be retrieved from the first matching attendee record."
The reply will have STATUS (`accepted', `tentative' or `declined').
The reply will be composed for attendees matching any entry
on the IDENTITIES list."
- (flet ((extract-block (blockname)
+ (gmm-labels ((extract-block (blockname)
(save-excursion
(let ((block-start-re (format "^BEGIN:%s" blockname))
(block-end-re (format "^END:%s" blockname))
@@ -318,6 +349,7 @@ on the IDENTITIES list."
(defgroup gnus-icalendar-org nil
"Settings for Calendar Event gnus/org integration."
+ :version "24.4"
:group 'gnus-icalendar
:prefix "gnus-icalendar-org-")
@@ -362,16 +394,57 @@ Return nil for non-recurring 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 %a" start t))
- (start-time (format-time-string "%H:%M" start t))
- (end-date (format-time-string "%Y-%m-%d %a" end t))
- (end-time (format-time-string "%H:%M" end t))
+ (start-date (format-time-string "%Y-%m-%d %a" 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 %a" end))
+ (end-time (format-time-string "%H:%M" end))
+ (end-at-midnight (string= end-time "00:00"))
+ (start-end-date-diff (/ (float-time (time-subtract
+ (date-to-time end-date)
+ (date-to-time start-date)))
+ 86400))
(org-repeat (gnus-icalendar-event:org-repeat event))
- (repeat (if org-repeat (concat " " org-repeat) "")))
-
- (if (equal start-date end-date)
- (format "<%s %s-%s%s>" start-date start-time end-time repeat)
- (format "<%s %s>--<%s %s>" start-date start-time end-date end-time))))
+ (repeat (if org-repeat (concat " " org-repeat) ""))
+ (time-1-day '(0 86400)))
+
+ ;; NOTE: special care is needed with appointments ending at midnight
+ ;; (typically all-day events): the end time has to be changed to 23:59 to
+ ;; prevent org agenda showing the event on one additional day
+ (cond
+ ;; start/end midnight
+ ;; A 0:0 - A+1 0:0 -> A
+ ;; A 0:0 - A+n 0:0 -> A - A+n-1
+ ((and start-at-midnight end-at-midnight) (if (> start-end-date-diff 1)
+ (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day))))
+ (format "<%s>--<%s>" start-date end-ts))
+ (format "<%s%s>" start-date repeat)))
+ ;; end midnight
+ ;; A .:. - A+1 0:0 -> A .:.-23:59
+ ;; A .:. - A+n 0:0 -> A .:. - A_n-1
+ (end-at-midnight (if (= start-end-date-diff 1)
+ (format "<%s %s-23:59%s>" start-date start-time repeat)
+ (let ((end-ts (format-time-string "%Y-%m-%d %a" (time-subtract end time-1-day))))
+ (format "<%s %s>--<%s>" start-date start-time end-ts))))
+ ;; start midnight
+ ;; A 0:0 - A .:. -> A 0:0-.:. (default 1)
+ ;; A 0:0 - A+n .:. -> A - A+n .:.
+ ((and start-at-midnight
+ (plusp start-end-date-diff)) (format "<%s>--<%s %s>" start-date end-date end-time))
+ ;; default
+ ;; 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)))))
+
+(defun gnus-icalendar--format-summary-line (summary &optional location)
+ (if location
+ (format "%s (%s)" summary location)
+ (format "%s" summary)))
+
+
+(defun gnus-icalendar--format-participant-list (participants)
+ (mapconcat #'identity participants ", "))
;; TODO: make the template customizable
(defmethod gnus-icalendar-event->org-entry ((event gnus-icalendar-event) reply-status)
@@ -384,13 +457,16 @@ Return nil for non-recurring EVENT."
"Not replied yet"))
(props `(("ICAL_EVENT" . "t")
("ID" . ,uid)
- ("DT" . ,(gnus-icalendar-event:org-timestamp event))
("ORGANIZER" . ,(gnus-icalendar-event:organizer event))
("LOCATION" . ,(gnus-icalendar-event:location event))
+ ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event)))
+ ("REQ_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:req-participants event)))
+ ("OPT_PARTICIPANTS" . ,(gnus-icalendar--format-participant-list (gnus-icalendar-event:opt-participants event)))
("RRULE" . ,(gnus-icalendar-event:recur event))
("REPLY" . ,reply))))
- (insert (format "* %s (%s)\n\n" summary location))
+ (insert (format "* %s\n\n"
+ (gnus-icalendar--format-summary-line summary location)))
(mapc (lambda (prop)
(org-entry-put (point) (car prop) (cdr prop)))
props))
@@ -398,7 +474,9 @@ Return nil for non-recurring EVENT."
(when description
(save-restriction
(narrow-to-region (point) (point))
- (insert description)
+ (insert (gnus-icalendar-event:org-timestamp event)
+ "\n\n"
+ description)
(indent-region (point-min) (point-max) 2)
(fill-region (point-min) (point-max))))
@@ -419,7 +497,7 @@ the optional ORG-FILE argument is specified, only that one file
is searched."
(let ((uid (gnus-icalendar-event:uid event))
(files (or org-file (org-agenda-files t 'ifmode))))
- (flet
+ (gmm-labels
((find-event-in (file)
(org-check-agenda-file file)
(with-current-buffer (find-file-noselect file)
@@ -444,7 +522,8 @@ is searched."
(let ((file (gnus-icalendar-find-org-event-file event org-file)))
(when file
(with-current-buffer (find-file-noselect file)
- (with-slots (uid summary description organizer location recur) event
+ (with-slots (uid summary description organizer location recur
+ participation-type req-participants opt-participants) event
(let ((event-pos (org-find-entry-with-id uid)))
(when event-pos
(goto-char event-pos)
@@ -455,7 +534,7 @@ is searched."
(headline (delq nil (list
(org-entry-get (point) "TODO")
(when priority (format "[#%s]" priority))
- (format "%s (%s)" summary location)
+ (gnus-icalendar--format-summary-line summary location)
(org-entry-get (point) "TAGS")))))
(re-search-forward "^\\*+ " (line-end-position))
@@ -478,17 +557,31 @@ is searched."
(when description
(save-restriction
(narrow-to-region (point) (point))
- (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n")
+ (insert "\n"
+ (gnus-icalendar-event:org-timestamp event)
+ "\n\n"
+ (replace-regexp-in-string "[\n]+$" "\n" description)
+ "\n")
(indent-region (point-min) (point-max) (1+ entry-outline-level))
(fill-region (point-min) (point-max))))
;; update entry properties
- (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event))
- (org-entry-put event-pos "ORGANIZER" organizer)
- (org-entry-put event-pos "LOCATION" location)
- (org-entry-put event-pos "RRULE" recur)
- (when reply-status (org-entry-put event-pos "REPLY"
- (capitalize (symbol-name reply-status))))
+ (gmm-labels
+ ((update-org-entry (position property value)
+ (if (or (null value)
+ (string= value ""))
+ (org-entry-delete position property)
+ (org-entry-put position property value))))
+
+ (update-org-entry event-pos "ORGANIZER" organizer)
+ (update-org-entry event-pos "LOCATION" location)
+ (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type))
+ (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants))
+ (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants))
+ (update-org-entry event-pos "RRULE" recur)
+ (update-org-entry event-pos "REPLY"
+ (if reply-status (capitalize (symbol-name reply-status))
+ "Not replied yet")))
(save-buffer)))))))))
@@ -552,7 +645,7 @@ is searched."
(gnus-icalendar--update-org-event event reply-status)
(gnus-icalendar:org-event-save event reply-status)))
-(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel))
+(defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status)
(when (gnus-icalendar-find-org-event-file event)
(gnus-icalendar--cancel-org-event event)))
@@ -569,6 +662,7 @@ is searched."
(defgroup gnus-icalendar nil
"Settings for inline display of iCalendar invitations."
+ :version "24.4"
:group 'gnus-article
:prefix "gnus-icalendar-")
@@ -577,6 +671,23 @@ is searched."
:type '(string)
:group 'gnus-icalendar)
+(defcustom gnus-icalendar-additional-identities nil
+ "We need to know your identity to make replies to calendar requests work.
+
+Gnus will only offer you the Accept/Tentative/Decline buttons for
+calendar events if any of your identities matches at least one
+RSVP participant.
+
+Your identity is guessed automatically from the variables
+`user-full-name', `user-mail-address',
+`gnus-ignored-from-addresses' and `message-alternative-emails'.
+
+If you need even more aliases you can define them here. It really
+only makes sense to define names or email addresses."
+
+ :type '(repeat string)
+ :group 'gnus-icalendar)
+
(make-variable-buffer-local
(defvar gnus-icalendar-reply-status nil))
@@ -586,26 +697,35 @@ is searched."
(make-variable-buffer-local
(defvar gnus-icalendar-handle nil))
-(defvar gnus-icalendar-identities
+(defun gnus-icalendar-identities ()
+ "Return list of regexp-quoted names and email addresses belonging to the user.
+
+These will be used to retrieve the RSVP information from ical events."
(apply #'append
(mapcar (lambda (x) (if (listp x) x (list x)))
(list user-full-name (regexp-quote user-mail-address)
- ; NOTE: this one can be a list
- gnus-ignored-from-addresses))))
+ ; NOTE: these can be lists
+ gnus-ignored-from-addresses ; already regexp-quoted
+ message-alternative-emails ;
+ (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
;; TODO: make the template customizable
(defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status)
"Format an overview of EVENT details."
- (flet ((format-header (x)
+ (gmm-labels ((format-header (x)
(format "%-12s%s"
(propertize (concat (car x) ":") 'face 'bold)
(cadr x))))
- (with-slots (organizer summary description location recur uid method rsvp) event
+ (with-slots (organizer summary description location recur uid
+ method rsvp participation-type) event
(let ((headers `(("Summary" ,summary)
- ("Location" ,location)
+ ("Location" ,(or location ""))
("Time" ,(gnus-icalendar-event:org-timestamp event))
("Organizer" ,organizer)
+ ("Attendance" ,(if (eq participation-type 'non-participant)
+ "You are not listed as an attendee"
+ (capitalize (symbol-name participation-type))))
("Method" ,method))))
(when (and (not (gnus-icalendar-event-reply-p event)) rsvp)
@@ -670,10 +790,10 @@ is searched."
(event (caddr data))
(reply (gnus-icalendar-with-decoded-handle handle
(gnus-icalendar-event-reply-from-buffer
- (current-buffer) status gnus-icalendar-identities))))
+ (current-buffer) status (gnus-icalendar-identities)))))
(when reply
- (flet ((fold-icalendar-buffer ()
+ (gmm-labels ((fold-icalendar-buffer ()
(goto-char (point-min))
(while (re-search-forward "^\\(.\\{72\\}\\)\\(.+\\)$" nil t)
(replace-match "\\1\n \\2")
@@ -729,13 +849,25 @@ is searched."
(when org-entry-exists-p
`("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
+
+(defmethod gnus-icalendar-event:inline-org-buttons ((event gnus-icalendar-event-cancel))
+ (let ((org-entry-exists-p (gnus-icalendar-find-org-event-file event)))
+
+ (delq nil (list
+ `("Show Agenda" gnus-icalendar-show-org-agenda ,event)
+ (when org-entry-exists-p
+ `("Update Org Entry" gnus-icalendar-sync-event-to-org ,event))
+ (when org-entry-exists-p
+ `("Show Org Entry" gnus-icalendar--show-org-event ,event))))))
+
+
(defun gnus-icalendar-mm-inline (handle)
- (let ((event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities)))
+ (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities))))
(setq gnus-icalendar-reply-status nil)
(when event
- (flet ((insert-button-group (buttons)
+ (gmm-labels ((insert-button-group (buttons)
(when buttons
(mapc (lambda (x)
(apply 'gnus-icalendar-insert-button x)
@@ -759,7 +891,7 @@ is searched."
(defun gnus-icalendar-save-part (handle)
(let (event)
(when (and (equal (car (mm-handle-type handle)) "text/calendar")
- (setq event (gnus-icalendar-event-from-handle handle gnus-icalendar-identities)))
+ (setq event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities))))
(gnus-icalendar-event:sync-to-org event))))
@@ -816,6 +948,8 @@ is searched."
(gnus-icalendar-show-org-agenda
(with-current-buffer gnus-article-buffer gnus-icalendar-event)))
+(defvar gnus-mime-action-alist) ; gnus-art
+
(defun gnus-icalendar-setup ()
(add-to-list 'mm-inlined-types "text/calendar")
(add-to-list 'mm-automatic-display "text/calendar")
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index f0cf0daed01..4f8f17f18f3 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -1,6 +1,6 @@
;;; gnus-int.el --- backend interface functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -113,7 +113,8 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
(setq gnus-nntp-server
(gnus-completing-read "NNTP server"
(cons gnus-nntp-server
- gnus-secondary-servers)
+ (if (boundp 'gnus-secondary-servers)
+ gnus-secondary-servers))
nil gnus-nntp-server)))
(when (and gnus-nntp-server
@@ -163,8 +164,8 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
(gnus-open-server gnus-select-method)
gnus-batch-mode
(gnus-y-or-n-p
- (format
- "%s (%s) open error: '%s'. Continue? "
+ (gnus-format-message
+ "%s (%s) open error: `%s'. Continue? "
(car gnus-select-method) (cadr gnus-select-method)
(gnus-status-message gnus-select-method)))
(gnus-error 1 "Couldn't open server on %s"
@@ -302,7 +303,7 @@ If it is down, start it up (again)."
(setcar
(cdr elem)
(cond (result
- (if (eq open-server-function #'nnagent-open-server)
+ (if (eq open-server-function 'nnagent-open-server)
;; The agent's backend has a "special" status
'offline
'ok))
@@ -438,6 +439,14 @@ If it is down, start it up (again)."
(funcall (gnus-get-function gnus-command-method func)
(gnus-group-real-name group) (nth 1 gnus-command-method)))))
+(defun gnus-request-group-scan (group info)
+ "Request that GROUP get a complete rescan."
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ (func 'request-group-scan))
+ (when (gnus-check-backend-function func group)
+ (funcall (gnus-get-function gnus-command-method func)
+ (gnus-group-real-name group) (nth 1 gnus-command-method) info))))
+
(defun gnus-close-group (group)
"Request the GROUP be closed."
(let ((gnus-command-method (inline (gnus-find-method-for-group group))))
@@ -546,7 +555,7 @@ the group's summary.
(let ((saved-display
(gnus-group-get-parameter group 'display :allow-list)))
- ;; Tell gnus we really don't want any articles
+ ;; Tell gnus we really don't want any articles
(gnus-group-set-parameter group 'display 0)
(unwind-protect
@@ -564,7 +573,7 @@ the group's summary.
;; Create it now and insert the message
(let ((group-is-new (gnus-summary-setup-buffer group)))
(condition-case err
- (let ((article-number
+ (let ((article-number
(gnus-summary-insert-subject message-id)))
(unless article-number
(signal 'error "message-id not in group"))
@@ -753,7 +762,6 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(defun gnus-request-accept-article (group &optional gnus-command-method last
no-encode)
- ;; Make sure there's a newline at the end of the article.
(when (stringp gnus-command-method)
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (and (not gnus-command-method)
@@ -761,6 +769,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(setq gnus-command-method (or (gnus-find-method-for-group group)
(gnus-group-name-to-method group))))
(goto-char (point-max))
+ ;; Make sure there's a newline at the end of the article.
(unless (bolp)
(insert "\n"))
(unless no-encode
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index b3f06de0868..2eb702a1b5d 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -1,6 +1,6 @@
;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -75,20 +75,20 @@ of time."
;;; Gnus Kill File Mode
;;;
-(defvar gnus-kill-file-mode-map nil)
-
-(unless gnus-kill-file-mode-map
- (gnus-define-keymap (setq gnus-kill-file-mode-map
- (copy-keymap emacs-lisp-mode-map))
- "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
- "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
- "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
- "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
- "\C-c\C-a" gnus-kill-file-apply-buffer
- "\C-c\C-e" gnus-kill-file-apply-last-sexp
- "\C-c\C-c" gnus-kill-file-exit))
-
-(defun gnus-kill-file-mode ()
+(defvar gnus-kill-file-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (gnus-define-keymap map
+ "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
+ "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
+ "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
+ "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
+ "\C-c\C-a" gnus-kill-file-apply-buffer
+ "\C-c\C-e" gnus-kill-file-apply-last-sexp
+ "\C-c\C-c" gnus-kill-file-exit)
+ map))
+
+(define-derived-mode gnus-kill-file-mode emacs-lisp-mode "Kill"
"Major mode for editing kill files.
If you are using this mode - you probably shouldn't. Kill files
@@ -151,15 +151,7 @@ which are marked as read in the previous Gnus sessions. Marks other
than `D' should be used for articles which should really be deleted.
Entry to this mode calls emacs-lisp-mode-hook and
-gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-kill-file-mode-map)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (setq major-mode 'gnus-kill-file-mode)
- (setq mode-name "Kill")
- (lisp-mode-variables nil)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+gnus-kill-file-mode-hook with no arguments, if that value is non-nil.")
(defun gnus-kill-file-edit-file (newsgroup)
"Begin editing a kill file for NEWSGROUP.
@@ -175,10 +167,10 @@ If NEWSGROUP is nil, the global kill file is selected."
(let ((buffer (find-file-noselect file)))
(cond ((get-buffer-window buffer)
(pop-to-buffer buffer))
- ((eq major-mode 'gnus-group-mode)
+ ((derived-mode-p 'gnus-group-mode)
(gnus-configure-windows 'group) ;Take all windows.
(pop-to-buffer buffer))
- ((eq major-mode 'gnus-summary-mode)
+ ((derived-mode-p 'gnus-summary-mode)
(gnus-configure-windows 'article)
(pop-to-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer)
@@ -201,7 +193,7 @@ If NEWSGROUP is nil, the global kill file is selected."
;; REGEXP: The string to kill.
(save-excursion
(let (string)
- (unless (eq major-mode 'gnus-kill-file-mode)
+ (unless (derived-mode-p 'gnus-kill-file-mode)
(gnus-kill-set-kill-buffer))
(unless dont-move
(goto-char (point-max)))
@@ -520,7 +512,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence."
(setq kill-list (cdr kill-list))))
(gnus-execute field kill-list command nil (not all))))))
(switch-to-buffer old-buffer)
- (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
+ (when (and (derived-mode-p 'gnus-kill-file-mode) regexp (not silent))
(gnus-pp-gnus-kill
(nconc (list 'gnus-kill field
(if (consp regexp) (list 'quote regexp) regexp))
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 3216d9f2d20..63218214c87 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -1,6 +1,6 @@
;;; gnus-logic.el --- advanced scoring code for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index c52592c8aaa..21c61ddc2c9 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -1,6 +1,6 @@
;;; gnus-mh.el --- mh-e interface for Gnus
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index c84946cb10e..b4228f30103 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -1,6 +1,6 @@
;;; gnus-ml.el --- Mailing list minor mode for Gnus
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Julien Gilles <jgilles@free.fr>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index 3947c6788b7..37a5d6150db 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -1,6 +1,6 @@
;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
;; Keywords: news, mail
@@ -100,7 +100,7 @@ See `gnus-group-split-fancy' for more information.
"Uses information from group parameters in order to split mail.
It can be embedded into `nnmail-split-fancy' lists with the SPLIT
-\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
+\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL)
GROUPS may be a regular expression or a list of group names, that will
be used to select candidate groups. If it is omitted or nil, all
@@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
\"mail.others\")"
- (let* ((newsrc (cdr gnus-newsrc-alist))
- split)
- (dolist (info newsrc)
- (let ((group (gnus-info-group info))
- (params (gnus-info-params info)))
- ;; For all GROUPs that match the specified GROUPS
- (when (or (not groups)
- (and (listp groups)
- (memq group groups))
- (and (stringp groups)
- (string-match groups group)))
- (let ((split-spec (assoc 'split-spec params)) group-clean)
- ;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ (let ((group-names (if (and (listp groups)
+ (not (null groups)))
+ groups
+ (delete-dups
+ (delq nil
+ (mapcar
+ (lambda (info)
+ (let ((group (gnus-info-group info)))
+ (if (or (not groups)
+ (and (stringp groups)
+ (string-match groups group)))
+ group)))
+ (append gnus-newsrc-alist gnus-parameters))))))
+ split)
+ (dolist (group group-names)
+ (let ((params (gnus-group-find-parameter group)))
+ ;; Skip groups without param (or nonexistent)
+ (when (not (null params))
+ (let ((split-spec (assoc 'split-spec params)) group-clean)
+ ;; Remove backend from group name
+ (setq group-clean (string-match ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 0f78f2edc5f..bfd3da2e69d 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1,6 +1,6 @@
;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -433,12 +433,14 @@ Thank you for your help in stamping out bugs.
(,buffer (buffer-name (current-buffer)))
(,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
gnus-article-reply)
- (nnir-article-number gnus-article-reply)
+ (nnir-article-number (or (car-safe gnus-article-reply)
+ gnus-article-reply))
gnus-article-reply))
(,yanked gnus-article-yanked-articles)
(,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
gnus-article-reply)
- (nnir-article-group gnus-article-reply)
+ (nnir-article-group (or (car-safe gnus-article-reply)
+ gnus-article-reply))
gnus-newsgroup-name))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
@@ -446,7 +448,7 @@ Thank you for your help in stamping out bugs.
(message-mode-hook (copy-sequence message-mode-hook)))
(setq mml-buffer-list nil)
(add-hook 'message-header-setup-hook (lambda ()
- (gnus-inews-insert-gcc ,group)))
+ (gnus-inews-insert-gcc ,group)))
;; message-newsreader and message-mailer were formerly set in
;; gnus-inews-add-send-actions, but this is too late when
;; message-generate-headers-first is used. --ansel
@@ -539,11 +541,15 @@ instead."
nil yank-action send-actions return-action))
(let ((buf (current-buffer))
;; Don't use posting styles corresponding to any existing group.
- (gnus-newsgroup-name "")
+ (group-name gnus-newsgroup-name)
mail-buf)
- (gnus-setup-message 'message
- (message-mail to subject other-headers continue
- nil yank-action send-actions return-action))
+ (unwind-protect
+ (progn
+ (setq gnus-newsgroup-name "")
+ (gnus-setup-message 'message
+ (message-mail to subject other-headers continue
+ nil yank-action send-actions return-action)))
+ (setq gnus-newsgroup-name group-name))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
@@ -860,7 +866,7 @@ post using the current select method."
(let ((message-post-method
`(lambda (arg)
(gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
- (user-mail-address user-mail-address))
+ (custom-address user-mail-address))
(dolist (article (gnus-summary-work-articles n))
(when (gnus-summary-select-article t nil nil article)
;; Pretend that we're doing a followup so that we can see what
@@ -870,12 +876,13 @@ post using the current select method."
(gnus-summary-followup nil)
(let ((from (message-fetch-field "from")))
(when from
- (setq user-mail-address
+ (setq custom-address
(car (mail-header-parse-address from)))))
(kill-buffer (current-buffer))))
;; Now cancel the article using the From header we got.
(when (gnus-eval-in-buffer-window gnus-original-article-buffer
- (message-cancel-news))
+ (let ((user-mail-address (or custom-address user-mail-address)))
+ (message-cancel-news)))
(gnus-summary-mark-as-read article gnus-canceled-mark)
(gnus-cache-remove-article 1))
(gnus-article-hide-headers-if-wanted))
@@ -1723,7 +1730,20 @@ this is a reply."
(var (or gnus-outgoing-message-group gnus-message-archive-group))
(gcc-self-val
(and group (not (gnus-virtual-group-p group))
- (gnus-group-find-parameter group 'gcc-self)))
+ (gnus-group-find-parameter group 'gcc-self t)))
+ (gcc-self-get (lambda (gcc-self-val group)
+ (if (stringp gcc-self-val)
+ (if (string-match " " gcc-self-val)
+ (concat "\"" gcc-self-val "\"")
+ gcc-self-val)
+ ;; In nndoc groups, we use the parent group name
+ ;; instead of the current group.
+ (let ((group (or (gnus-group-find-parameter
+ gnus-newsgroup-name 'parent-group)
+ group)))
+ (if (string-match " " group)
+ (concat "\"" group "\"")
+ group)))))
result
(groups
(cond
@@ -1774,19 +1794,11 @@ this is a reply."
(if gcc-self-val
;; Use the `gcc-self' param value instead.
(progn
- (insert
- (if (stringp gcc-self-val)
- (if (string-match " " gcc-self-val)
- (concat "\"" gcc-self-val "\"")
- gcc-self-val)
- ;; In nndoc groups, we use the parent group name
- ;; instead of the current group.
- (let ((group (or (gnus-group-find-parameter
- gnus-newsgroup-name 'parent-group)
- group)))
- (if (string-match " " group)
- (concat "\"" group "\"")
- group))))
+ (insert (if (listp gcc-self-val)
+ (mapconcat (lambda (val)
+ (funcall gcc-self-get val group))
+ gcc-self-val ", ")
+ (funcall gcc-self-get gcc-self-val group)))
(if (not (eq gcc-self-val 'none))
(insert "\n")
(gnus-delete-line)))
@@ -1823,7 +1835,7 @@ this is a reply."
(with-current-buffer gnus-summary-buffer
gnus-posting-styles)
gnus-posting-styles))
- style match attribute value v results
+ style match attribute value v results matched-string
filep name address element)
;; If the group has a posting-style parameter, add it at the end with a
;; regexp matching everything, to be sure it takes precedence over all
@@ -1843,7 +1855,9 @@ this is a reply."
(when (cond
((stringp match)
;; Regexp string match on the group name.
- (string-match match group))
+ (when (string-match match group)
+ (setq matched-string group)
+ t))
((eq match 'header)
;; Obsolete format of header match.
(and (gnus-buffer-live-p gnus-article-copy)
@@ -1872,7 +1886,8 @@ this is a reply."
(nnheader-narrow-to-headers)
(let ((header (message-fetch-field (nth 1 match))))
(and header
- (string-match (nth 2 match) header)))))))
+ (string-match (nth 2 match) header)
+ (setq matched-string header)))))))
(t
;; This is a form to be evalled.
(eval match)))))
@@ -1893,10 +1908,11 @@ this is a reply."
(setq v
(cond
((stringp value)
- (if (and (stringp match)
+ (if (and matched-string
(gnus-string-match-p "\\\\[&[:digit:]]" value)
(match-beginning 1))
- (gnus-match-substitute-replacement value nil nil group)
+ (gnus-match-substitute-replacement value nil nil
+ matched-string)
value))
((or (symbolp value)
(functionp value))
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 93220ed8ddf..f73aac1f5b3 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -1,6 +1,6 @@
;; gnus-notifications.el -- Send notification on new message in Gnus
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
@@ -75,12 +75,19 @@ not get notifications."
"Map notifications ids to messages.")
(defun gnus-notifications-action (id key)
- (when (string= key "read")
- (let ((group-article (assoc id gnus-notifications-id-to-msg)))
- (when group-article
- (let ((group (cadr group-article))
- (article (nth 2 group-article)))
- (gnus-fetch-group group (list article)))))))
+ (let ((group-article (assoc id gnus-notifications-id-to-msg)))
+ (when group-article
+ (let ((group (cadr group-article))
+ (article (nth 2 group-article)))
+ (cond ((string= key "read")
+ (gnus-fetch-group group (list article))
+ (gnus-select-frame-set-input-focus (selected-frame)))
+ ((string= key "mark-read")
+ (gnus-update-read-articles
+ group
+ (delq article (gnus-list-of-unread-articles group)))
+ ;; gnus-group-refresh-group
+ (gnus-group-update-group group)))))))
(defun gnus-notifications-notify (from subject photo-file)
"Send a notification about a new mail.
@@ -90,11 +97,11 @@ Return a notification id if any, or t on success."
'notifications-notify
:title from
:body subject
- :actions '("read" "Read")
+ :actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
- :app-icon (or photo-file
- (gnus-funcall-no-warning
- 'image-search-load-path "gnus/gnus.png"))
+ :app-icon (gnus-funcall-no-warning
+ 'image-search-load-path "gnus/gnus.png")
+ :image-path photo-file
:app-name "Gnus"
:category "email.arrived"
:timeout gnus-notifications-timeout)
@@ -102,6 +109,9 @@ Return a notification id if any, or t on success."
;; Don't return an id
t))
+(declare-function gravatar-retrieve-synchronously "gravatar.el"
+ (mail-address))
+
(defun gnus-notifications-get-photo (mail-address)
"Get photo for mail address."
(let ((google-photo (when (and gnus-notifications-use-google-contacts
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 5402982b965..62b18b40453 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -1,6 +1,6 @@
;;; gnus-picon.el --- displaying pretty icons in Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news xpm annotation glyph faces
@@ -37,10 +37,6 @@
;;
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index b71da2d7769..809f8b1260e 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -1,6 +1,6 @@
;;; gnus-range.el --- range and sequence functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 6f2fe78c3d8..77ff428e1f1 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,6 +1,6 @@
;;; gnus-registry.el --- article registry for Gnus
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news registry
@@ -176,6 +176,8 @@ nnmairix groups are specifically excluded because they are ephemeral."
(make-obsolete-variable 'gnus-registry-max-track-groups nil "23.4")
(make-obsolete-variable 'gnus-registry-entry-caching nil "23.4")
(make-obsolete-variable 'gnus-registry-trim-articles-without-groups nil "23.4")
+;; FIXME it was simply deleted.
+(make-obsolete-variable 'gnus-registry-max-pruned-entries nil "25.1")
(defcustom gnus-registry-track-extra '(subject sender recipient)
"Whether the registry should track extra data about a message.
@@ -192,17 +194,17 @@ are tracked this way by default."
"The splitting strategy applied to the keys in `gnus-registry-track-extra'.
Given a set of unique found groups G and counts for each element
-of G, and a key K (typically 'sender or 'subject):
+of G, and a key K (typically `sender' or `subject'):
When nil, if G has only one element, use it. Otherwise give up.
This is the fastest but also least useful strategy.
-When 'majority, use the majority by count. So if there is a
+When `majority', use the majority by count. So if there is a
group with the most articles counted by K, use that. Ties are
resolved in no particular order, simply the first one found wins.
This is the slowest strategy but also the most accurate one.
-When 'first, the first element of G wins. This is fast and
+When `first', the first element of G wins. This is fast and
should be OK if your senders and subjects don't \"bleed\" across
groups."
:group 'gnus-registry
@@ -231,7 +233,7 @@ the Bit Bucket."
(defcustom gnus-registry-cache-file
(nnheader-concat
(or gnus-dribble-directory gnus-home-directory "~/")
- ".gnus.registry.eioio")
+ ".gnus.registry.eieio")
"File where the Gnus registry will be stored."
:group 'gnus-registry
:type 'file)
@@ -242,31 +244,52 @@ the Bit Bucket."
:type '(radio (const :format "Unlimited " nil)
(integer :format "Maximum number: %v")))
-(defcustom gnus-registry-max-pruned-entries nil
- "Maximum number of pruned entries in the registry, nil for unlimited."
- :version "24.1"
+(defcustom gnus-registry-prune-factor 0.1
+ "When pruning, try to prune back to this factor less than the maximum size.
+
+In order to prevent constant pruning, we prune back to a number
+somewhat less than the maximum size. This option controls
+exactly how much less. For example, given a maximum size of
+50000 and a prune factor of 0.1, the pruning process will try to
+cut the registry back to \(- 50000 \(* 50000 0.1)) -> 45000
+entries. The pruning process is constrained by the presence of
+\"precious\" entries."
+ :version "25.1"
:group 'gnus-registry
- :type '(radio (const :format "Unlimited " nil)
- (integer :format "Maximum number: %v")))
+ :type 'float)
+
+(defcustom gnus-registry-default-sort-function
+ #'gnus-registry-sort-by-creation-time
+ "Sort function to use when pruning the registry.
+Entries that sort to the front of the list are pruned first.
+This can slow pruning down. Set to nil to perform no sorting."
+ :version "25.1"
+ :group 'gnus-registry
+ :type '(choice (const :tag "No sorting" nil) function))
+
+(defun gnus-registry-sort-by-creation-time (l r)
+ "Sort older entries to front of list."
+ ;; Pruning starts from the front of the list.
+ (time-less-p
+ (cadr (assq 'creation-time r))
+ (cadr (assq 'creation-time l))))
(defun gnus-registry-fixup-registry (db)
(when db
- (let ((old (oref db :tracked)))
- (oset db :precious
+ (let ((old (oref db tracked)))
+ (setf (oref db precious)
(append gnus-registry-extra-entries-precious
'()))
- (oset db :max-hard
+ (setf (oref db max-size)
(or gnus-registry-max-entries
most-positive-fixnum))
- (oset db :prune-factor
- 0.1)
- (oset db :max-soft
- (or gnus-registry-max-pruned-entries
- most-positive-fixnum))
- (oset db :tracked
+ (setf (oref db prune-factor)
+ (or gnus-registry-prune-factor
+ 0.1))
+ (setf (oref db tracked)
(append gnus-registry-track-extra
'(mark group keyword)))
- (when (not (equal old (oref db :tracked)))
+ (when (not (equal old (oref db tracked)))
(gnus-message 9 "Reindexing the Gnus registry (tracked change)")
(registry-reindex db))))
db)
@@ -274,14 +297,13 @@ the Bit Bucket."
(defun gnus-registry-make-db (&optional file)
(interactive "fGnus registry persistence file: \n")
(gnus-registry-fixup-registry
- (registry-db
- "Gnus Registry"
- :file (or file gnus-registry-cache-file)
- ;; these parameters are set in `gnus-registry-fixup-registry'
- :max-hard most-positive-fixnum
- :max-soft most-positive-fixnum
- :precious nil
- :tracked nil)))
+ (make-instance 'registry-db
+ :file (or file gnus-registry-cache-file)
+ ;; these parameters are set in `gnus-registry-fixup-registry'
+ :max-size most-positive-fixnum
+ :version registry-db-version
+ :precious nil
+ :tracked nil)))
(defvar gnus-registry-db (gnus-registry-make-db)
"The article registry by Message ID. See `registry-db'.")
@@ -295,22 +317,27 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-message 4 "Remaking the Gnus registry")
(setq gnus-registry-db (gnus-registry-make-db))))
-(defun gnus-registry-read ()
- "Read the registry cache file."
+(defun gnus-registry-load ()
+ "Load the registry from the cache file."
(interactive)
(let ((file gnus-registry-cache-file))
(condition-case nil
- (progn
- (gnus-message 5 "Reading Gnus registry from %s..." file)
- (setq gnus-registry-db
- (gnus-registry-fixup-registry
- (condition-case nil
- (with-no-warnings
- (eieio-persistent-read file 'registry-db))
- ;; Older EIEIO versions do not check the class name.
- ('wrong-number-of-arguments
- (eieio-persistent-read file)))))
- (gnus-message 5 "Reading Gnus registry from %s...done" file))
+ (gnus-registry-read file)
+ (file-error
+ ;; Fix previous mis-naming of the registry file.
+ (let ((old-file-name
+ (concat (file-name-sans-extension
+ gnus-registry-cache-file)
+ ".eioio")))
+ (if (and (file-exists-p old-file-name)
+ (yes-or-no-p
+ (format "Rename registry file from %s to %s? "
+ old-file-name file)))
+ (progn
+ (gnus-registry-read old-file-name)
+ (setf (oref gnus-registry-db file) file)
+ (gnus-message 1 "Registry filename changed to %s" file))
+ (gnus-registry-remake-db t))))
(error
(gnus-message
1
@@ -318,6 +345,19 @@ This is not required after changing `gnus-registry-cache-file'."
file)
(gnus-registry-remake-db t)))))
+(defun gnus-registry-read (file)
+ "Do the actual reading of the registry persistence file."
+ (gnus-message 5 "Reading Gnus registry from %s..." file)
+ (setq gnus-registry-db
+ (gnus-registry-fixup-registry
+ (condition-case nil
+ (with-no-warnings
+ (eieio-persistent-read file 'registry-db))
+ ;; Older EIEIO versions do not check the class name.
+ ('wrong-number-of-arguments
+ (eieio-persistent-read file)))))
+ (gnus-message 5 "Reading Gnus registry from %s...done" file))
+
(defun gnus-registry-save (&optional file db)
"Save the registry cache file."
(interactive)
@@ -325,7 +365,8 @@ This is not required after changing `gnus-registry-cache-file'."
(db (or db gnus-registry-db)))
(gnus-message 5 "Saving Gnus registry (%d entries) to %s..."
(registry-size db) file)
- (registry-prune db)
+ (registry-prune
+ db gnus-registry-default-sort-function)
;; TODO: call (gnus-string-remove-all-properties v) on all elements?
(eieio-persistent-save db file)
(gnus-message 5 "Saving Gnus registry (size %d) to %s...done"
@@ -356,8 +397,7 @@ This is not required after changing `gnus-registry-cache-file'."
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
(from (gnus-group-guess-full-name-from-command-method from))
- (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
- (to-name (if to to "the Bit Bucket")))
+ (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)
@@ -413,7 +453,8 @@ This is not required after changing `gnus-registry-cache-file'."
(let ((new (or (assq (first kv) entry)
(list (first kv)))))
(dolist (toadd (cdr kv))
- (add-to-list 'new toadd t))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
(setq entry (cons new
(assq-delete-all (first kv) entry))))))
(gnus-message 10 "Gnus registry: new entry for %s is %S"
@@ -517,7 +558,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced subject '%s' to %s"
+ "%s (extra tracking) traced subject `%s' to %s"
log-agent subject group)
and collect group))
;; filter the found groups and return them
@@ -544,7 +585,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced sender '%s' to %s"
+ "%s (extra tracking) traced sender `%s' to %s"
log-agent sender group)
and collect group)))
@@ -574,7 +615,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
- "%s (extra tracking) traced recipient '%s' to %s"
+ "%s (extra tracking) traced recipient `%s' to %s"
log-agent recp group)
and collect group)))))
@@ -589,7 +630,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(defun gnus-registry-post-process-groups (mode key groups)
"Inspects GROUPS found by MODE for KEY to determine which ones to follow.
-MODE can be 'subject' or 'sender' for example. The KEY is the
+MODE can be `subject' or `sender' for example. The KEY is the
value by which MODE was searched.
Transforms each group name to the equivalent short name.
@@ -657,7 +698,7 @@ possible. Uses `gnus-registry-split-strategy'."
10
"%s: stripped group %s to %s"
log-agent group short-name))
- (add-to-list 'out short-name))
+ (pushnew short-name out :test #'equal))
;; else...
(gnus-message
7
@@ -671,12 +712,12 @@ possible. Uses `gnus-registry-split-strategy'."
((null out)
(gnus-message
5
- "%s: no matches for %s '%s'."
+ "%s: no matches for %s `%s'."
log-agent mode key)
nil)
(t (gnus-message
5
- "%s: too many extra matches (%s) for %s '%s'. Returning none."
+ "%s: too many extra matches (%s) for %s `%s'. Returning none."
log-agent out mode key)
nil))))
@@ -743,8 +784,9 @@ Overrides existing keywords with FORCE set non-nil."
(gnus-registry-set-id-key id 'keyword words)))))
(defun gnus-registry-keywords ()
- (let ((table (registry-lookup-secondary gnus-registry-db 'keyword)))
- (when table (maphash (lambda (k v) k) table))))
+ (let ((table (registry-lookup-secondary gnus-registry-db 'keyword))
+ (ks ()))
+ (when table (maphash (lambda (k _v) (push k ks)) table) ks)))
(defun gnus-registry-find-keywords (keyword)
(interactive (list
@@ -839,7 +881,7 @@ FUNCTION should take two parameters, a mark symbol and the cell value."
;; FIXME: Why not merge gnus-registry--set/remove-mark and
;; gnus-registry-set-article-mark-internal?
-(defun gnus-registry--set/remove-mark (remove mark articles)
+(defun gnus-registry--set/remove-mark (mark remove articles)
"Set/remove the MARK over process-marked ARTICLES."
;; If this is called and the user doesn't want the
;; registry enabled, we'll ask anyhow.
@@ -1032,7 +1074,8 @@ only the last one's marks are returned."
"Just like `registry-insert' but tries to prune on error."
(when (registry-full db)
(message "Trying to prune the registry because it's full")
- (registry-prune db))
+ (registry-prune
+ db gnus-registry-default-sort-function))
(registry-insert db id entry)
entry)
@@ -1057,11 +1100,10 @@ only the last one's marks are returned."
(when (and (< 0 expected)
(= 0 (mod count 100)))
(message "importing: %d of %d (%.2f%%)"
- count expected (/ (* 100 count) expected)))
+ count expected (/ (* 100.0 count) expected)))
(setq entry (car-safe old)
old (cdr-safe old))
(let* ((id (car-safe entry))
- (new-entry (gnus-registry-get-or-make-entry id))
(rest (cdr-safe entry))
(groups (loop for p in rest
when (stringp p)
@@ -1090,7 +1132,7 @@ only the last one's marks are returned."
(gnus-message 5 "Initializing the registry")
(gnus-registry-install-hooks)
(gnus-registry-install-shortcuts)
- (gnus-registry-read))
+ (gnus-registry-load))
;; FIXME: Why autoload this function?
;;;###autoload
@@ -1104,7 +1146,7 @@ only the last one's marks are returned."
(add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
(add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
+ (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
(add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
@@ -1117,7 +1159,7 @@ only the last one's marks are returned."
(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-read)
+ (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-load)
(remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)
(setq gnus-registry-enabled nil))
@@ -1125,9 +1167,9 @@ only the last one's marks are returned."
(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
(defun gnus-registry-install-p ()
- "If the registry is not already enabled, and `gnus-registry-install' is t,
-the registry is enabled. If `gnus-registry-install' is `ask',
-the user is asked first. Returns non-nil iff the registry is enabled."
+ "Return non-nil if the registry is enabled (and maybe enable it first).
+If the registry is not already enabled, then if `gnus-registry-install'
+is `ask', ask the user; or if `gnus-registry-install' is non-nil, enable it."
(interactive)
(unless gnus-registry-enabled
(when (if (eq gnus-registry-install 'ask)
@@ -1199,7 +1241,7 @@ from your existing entries."
(when extra
(let ((db gnus-registry-db))
(registry-reindex db)
- (loop for k being the hash-keys of (oref db :data)
+ (loop for k being the hash-keys of (oref db data)
using (hash-value v)
do (let ((newv (delq nil (mapcar #'(lambda (entry)
(unless (member (car entry) extra)
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 6b8e105e6b8..bca5f43cd5f 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1,6 +1,6 @@
;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -62,7 +62,7 @@
:group 'gnus-summary-pick)
(defcustom gnus-summary-pick-line-format
- "%-5P %U\%R\%z\%I\%(%[%4L: %-23,23n%]%) %s\n"
+ "%-5P %U\ %R\ %z\ %I\ %(%[%4L: %-23,23n%]%) %s\n"
"*The format specification of the lines in pick buffers.
It accepts the same format specs that `gnus-summary-line-format' does."
:type 'string
@@ -292,22 +292,25 @@ This must be bound to a button-down mouse event."
(mouse-scroll-subr start-window
(1+ (- mouse-row bottom)))))))))))
(when (consp event)
- (let ((fun (key-binding (vector (car event)))))
+ (let (;; (fun (key-binding (vector (car event))))
+ )
;; Run the binding of the terminating up-event, if possible.
- ;; In the case of a multiple click, it gives the wrong results,
+ ;; In the case of a multiple click, it gives the wrong results,
;; because it would fail to set up a region.
(when nil
- ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
- ;; In this case, we can just let the up-event execute normally.
+ ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
+ ;; In this case, we can just let the up-event execute normally.
(let ((end (event-end event)))
;; Set the position in the event before we replay it,
;; because otherwise it may have a position in the wrong
;; buffer.
(setcar (cdr end) end-of-range)
;; Delete the overlay before calling the function,
- ;; because delete-overlay increases buffer-modified-tick.
+ ;; because delete-overlay increases buffer-modified-tick.
(push event unread-command-events))))))))
+(defvar scroll-in-place)
+
(defun gnus-pick-next-page ()
"Go to the next page. If at the end of the buffer, start reading articles."
(interactive)
@@ -356,7 +359,7 @@ This must be bound to a button-down mouse event."
(when (gnus-visual-p 'binary-menu 'menu)
(gnus-binary-make-menu-bar)))))
-(defun gnus-binary-display-article (article &optional all-header)
+(defun gnus-binary-display-article (article &optional _all-header)
"Run ARTICLE through the binary decode functions."
(when (gnus-summary-goto-subject article)
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
@@ -423,6 +426,13 @@ Two predefined functions are available:
;;; Internal variables.
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-from)
+(defvar gnus-tmp-number)
+(defvar gnus-tmp-open-bracket)
+(defvar gnus-tmp-close-bracket)
+(defvar gnus-tmp-subject)
+
(defvar gnus-tree-line-format-alist
`((?n gnus-tmp-name ?s)
(?f gnus-tmp-from ?s)
@@ -442,23 +452,23 @@ Two predefined functions are available:
(defvar gnus-tree-displayed-thread nil)
(defvar gnus-tree-inhibit nil)
-(defvar gnus-tree-mode-map nil)
-(put 'gnus-tree-mode 'mode-class 'special)
+(defvar gnus-tree-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (gnus-define-keys
+ map
+ "\r" gnus-tree-select-article
+ gnus-mouse-2 gnus-tree-pick-article
+ "\C-?" gnus-tree-read-summary-keys
+ "h" gnus-tree-show-summary
-(unless gnus-tree-mode-map
- (setq gnus-tree-mode-map (make-keymap))
- (suppress-keymap gnus-tree-mode-map)
- (gnus-define-keys
- gnus-tree-mode-map
- "\r" gnus-tree-select-article
- gnus-mouse-2 gnus-tree-pick-article
- "\C-?" gnus-tree-read-summary-keys
- "h" gnus-tree-show-summary
+ "\C-c\C-i" gnus-info-find-node)
- "\C-c\C-i" gnus-info-find-node)
+ (substitute-key-definition
+ 'undefined 'gnus-tree-read-summary-keys map)
+ map))
- (substitute-key-definition
- 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
+(put 'gnus-tree-mode 'mode-class 'special)
(defun gnus-tree-make-menu-bar ()
(unless (boundp 'gnus-tree-menu)
@@ -467,26 +477,20 @@ Two predefined functions are available:
'("Tree"
["Select article" gnus-tree-select-article t]))))
-(defun gnus-tree-mode ()
+(define-derived-mode gnus-tree-mode fundamental-mode "Tree"
"Major mode for displaying thread trees."
- (interactive)
(gnus-set-format 'tree-mode)
(gnus-set-format 'tree t)
(when (gnus-visual-p 'tree-menu 'menu)
(gnus-tree-make-menu-bar))
- (kill-all-local-variables)
(gnus-simplify-mode-line)
- (setq mode-name "Tree")
- (setq major-mode 'gnus-tree-mode)
- (use-local-map gnus-tree-mode-map)
(buffer-disable-undo)
(setq buffer-read-only t)
(setq truncate-lines t)
- (save-excursion
+ (save-current-buffer
(gnus-set-work-buffer)
(gnus-tree-node-insert (make-mail-header "") nil)
- (setq gnus-tree-node-length (1- (point))))
- (gnus-run-mode-hooks 'gnus-tree-mode-hook))
+ (setq gnus-tree-node-length (1- (point)))))
(defun gnus-tree-read-summary-keys (&optional arg)
"Read a summary buffer key sequence and execute it."
@@ -500,7 +504,7 @@ Two predefined functions are available:
(when (setq win (get-buffer-window buf))
(select-window win)
(when gnus-selected-tree-overlay
- (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (goto-char (or (overlay-end gnus-selected-tree-overlay) 1)))
(gnus-tree-minimize)))))
(defun gnus-tree-show-summary ()
@@ -543,7 +547,7 @@ Two predefined functions are available:
(when tree-window
(select-window tree-window)
(when gnus-selected-tree-overlay
- (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
+ (goto-char (or (overlay-end gnus-selected-tree-overlay) 1)))
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
(t 2)))
@@ -562,7 +566,7 @@ Two predefined functions are available:
(defun gnus-get-tree-buffer ()
"Return the tree buffer properly initialized."
(with-current-buffer (gnus-get-buffer-create gnus-tree-buffer)
- (unless (eq major-mode 'gnus-tree-mode)
+ (unless (derived-mode-p 'gnus-tree-mode)
(gnus-tree-mode))
(current-buffer)))
@@ -571,7 +575,7 @@ Two predefined functions are available:
(not (one-window-p)))
(let ((windows 0)
tot-win-height)
- (walk-windows (lambda (window) (incf windows)))
+ (walk-windows (lambda (_window) (incf windows)))
(setq tot-win-height
(- (frame-height)
(* window-min-height (1- windows))
@@ -642,23 +646,41 @@ Two predefined functions are available:
(when (or t (gnus-visual-p 'tree-highlight 'highlight))
(gnus-tree-highlight-node gnus-tmp-number beg end))))
+(defmacro gnus--let-eval (bindings evalsym &rest body)
+ "Build an environment in which to evaluate expressions.
+BINDINGS is a `let'-style list of bindings to use for the environment.
+EVALSYM is then bound in BODY to a function that takes a sexp and evaluates
+it in the environment specified by BINDINGS."
+ (declare (indent 2) (debug ((&rest (sym form)) sym body)))
+ (if (ignore-errors (let ((x 3)) (eq (eval '(- x 1) '((x . 4))) x)))
+ ;; Use lexical vars if possible.
+ `(let* ((env (list ,@(mapcar (lambda (binding)
+ `(cons ',(car binding) ,(cadr binding)))
+ bindings)))
+ (,evalsym (lambda (exp) (eval exp env))))
+ ,@body)
+ `(let (,@bindings (,evalsym #'eval)) ,@body)))
+
(defun gnus-tree-highlight-node (article beg end)
"Highlight current line according to `gnus-summary-highlight'."
(let ((list gnus-summary-highlight)
face)
(with-current-buffer gnus-summary-buffer
- (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
+ (let ((uncached (memq article gnus-newsgroup-undownloaded)))
+ (gnus--let-eval
+ ((score (or (cdr (assq article gnus-newsgroup-scored))
gnus-summary-default-score 0))
(default gnus-summary-default-score)
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
- (uncached (memq article gnus-newsgroup-undownloaded))
+ (uncached uncached)
(downloaded (not uncached))
(mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
- ;; Eval the cars of the lists until we find a match.
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))))
+ evalfun
+ ;; Eval the cars of the lists until we find a match.
+ (while (and list
+ (not (funcall evalfun (caar list))))
+ (setq list (cdr list))))))
(unless (eq (setq face (cdar list)) (gnus-get-text-property-excluding-characters-with-faces beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
beg end 'face
@@ -814,10 +836,10 @@ Two predefined functions are available:
(gnus-generate-tree top)
(setq gnus-tree-displayed-thread top))))))
-(defun gnus-tree-open (group)
+(defun gnus-tree-open ()
(gnus-get-tree-buffer))
-(defun gnus-tree-close (group)
+(defun gnus-tree-close ()
(gnus-kill-buffer gnus-tree-buffer))
(defun gnus-tree-perhaps-minimize ()
@@ -836,12 +858,12 @@ Two predefined functions are available:
(when (or (not gnus-selected-tree-overlay)
(gnus-extent-detached-p gnus-selected-tree-overlay))
;; Create a new overlay.
- (gnus-overlay-put
+ (overlay-put
(setq gnus-selected-tree-overlay
- (gnus-make-overlay (point-min) (1+ (point-min))))
+ (make-overlay (point-min) (1+ (point-min))))
'face gnus-selected-tree-face))
;; Move the overlay to the article.
- (gnus-move-overlay
+ (move-overlay
gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
(gnus-tree-minimize)
(gnus-tree-recenter)
@@ -857,12 +879,15 @@ Two predefined functions are available:
(set-buffer buf))))
(defun gnus-tree-highlight-article (article face)
- (with-current-buffer (gnus-get-tree-buffer)
- (let (region)
- (when (setq region (gnus-tree-article-region article))
- (gnus-put-text-property (car region) (cdr region) 'face face)
- (set-window-point
- (gnus-get-buffer-window (current-buffer) t) (cdr region))))))
+ ;; The save-excursion here is apparently necessary because
+ ;; `set-window-point' somehow manages to alter the buffer position.
+ (save-excursion
+ (with-current-buffer (gnus-get-tree-buffer)
+ (let (region)
+ (when (setq region (gnus-tree-article-region article))
+ (gnus-put-text-property (car region) (cdr region) 'face face)
+ (set-window-point
+ (gnus-get-buffer-window (current-buffer) t) (cdr region)))))))
;;; Allow redefinition of functions.
(gnus-ems-redefine)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 5f91246761e..4840af1281f 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1,6 +1,6 @@
;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -626,7 +626,7 @@ current score file."
(if mimic
(progn
(sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
+ (message "%s header `%s' with match type (%s?): "
(if increase "Increase" "Lower")
(nth 1 entry)
(mapconcat (lambda (s) (char-to-string (car s)))
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el
deleted file mode 100644
index 010fddfa9b8..00000000000
--- a/lisp/gnus/gnus-setup.el
+++ /dev/null
@@ -1,191 +0,0 @@
-;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-
-;; Copyright (C) 1995-1996, 2000-2013 Free Software Foundation, Inc.
-
-;; Author: Steven L. Baur <steve@miranova.com>
-;; Keywords: news
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; My head is starting to spin with all the different mail/news packages.
-;; Stop The Madness!
-
-;; Given that Emacs Lisp byte codes may be diverging, it is probably best
-;; not to byte compile this, and just arrange to have the .el loaded out
-;; of .emacs.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-use-installed-gnus t
- "*If non-nil use installed version of Gnus.")
-
-(defvar gnus-use-installed-mailcrypt (featurep 'xemacs)
- "*If non-nil use installed version of mailcrypt.")
-
-(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs)
- "/usr/local/lib/xemacs/"
- "/usr/local/share/emacs/")
- "Directory where Emacs site lisp is located.")
-
-(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
- "gnus/lisp/")
- "Directory where Gnus Emacs lisp is found.")
-
-(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/mailcrypt/")
- "Directory where Mailcrypt Emacs Lisp is found.")
-
-(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/bbdb/")
- "Directory where Big Brother Database is found.")
-
-(defvar gnus-use-mhe nil
- "Set this if you want to use MH-E for mail reading.")
-(defvar gnus-use-rmail nil
- "Set this if you want to use RMAIL for mail reading.")
-(defvar gnus-use-sendmail t
- "Set this if you want to use SENDMAIL for mail reading.")
-(defvar gnus-use-vm nil
- "Set this if you want to use the VM package for mail reading.")
-(defvar gnus-use-sc nil
- "Set this if you want to use Supercite.")
-(defvar gnus-use-mailcrypt t
- "Set this if you want to use Mailcrypt for dealing with PGP messages.")
-(defvar gnus-use-bbdb nil
- "Set this if you want to use the Big Brother DataBase.")
-
-(when (and (not gnus-use-installed-gnus)
- (null (member gnus-gnus-lisp-directory load-path)))
- (push gnus-gnus-lisp-directory load-path))
-
-;;; We can't do this until we know where Gnus is.
-(require 'message)
-
-;;; Mailcrypt by
-;;; Jin Choi <jin@atype.com>
-;;; Patrick LoPresti <patl@lcs.mit.edu>
-
-(when gnus-use-mailcrypt
- (when (and (not gnus-use-installed-mailcrypt)
- (null (member gnus-mailcrypt-lisp-directory load-path)))
- (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
- (autoload 'mc-install-write-mode "mailcrypt" nil t)
- (autoload 'mc-install-read-mode "mailcrypt" nil t)
-;;; (add-hook 'message-mode-hook 'mc-install-write-mode)
-;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
- (when gnus-use-mhe
- (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
- (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))
-
-;;; BBDB by
-;;; Jamie Zawinski <jwz@lucid.com>
-
-(when gnus-use-bbdb
- ;; bbdb will never be installed with emacs.
- (when (null (member gnus-bbdb-lisp-directory load-path))
- (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
- (autoload 'bbdb "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-name "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-company "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-net "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-notes "bbdb-com"
- "Insidious Big Brother Database" t)
-
- (when gnus-use-vm
- (autoload 'bbdb-insinuate-vm "bbdb-vm"
- "Hook BBDB into VM" t))
-
- (when gnus-use-rmail
- (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
- "Hook BBDB into RMAIL" t)
- (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))
-
- (when gnus-use-mhe
- (autoload 'bbdb-insinuate-mh "bbdb-mh"
- "Hook BBDB into MH-E" t)
- (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))
-
- (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
- "Hook BBDB into Gnus" t)
- (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
-
- (when gnus-use-sendmail
- (autoload 'bbdb-insinuate-sendmail "bbdb"
- "Insidious Big Brother Database" t)
- (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
- (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))
-
-(when gnus-use-sc
- (add-hook 'mail-citation-hook 'sc-cite-original)
- (setq message-cite-function 'sc-cite-original))
-
-;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137))
-;;; Generated autoloads from lisp/gnus.el
-
-;; Don't redo this if autoloads already exist
-(unless (fboundp 'gnus)
- (autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave without connecting to local server." t nil)
-
- (autoload 'gnus-no-server "gnus" "\
-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 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." t nil)
-
- (autoload 'gnus-slave "gnus" "\
-Read news as a slave." t nil)
-
- (autoload 'gnus "gnus" "\
-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
-prompt the user for the name of an NNTP server to use." t nil)
-
-;;;***
-
-;;; These have moved out of gnus.el into other files.
-;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it?
- (autoload 'gnus-update-format "gnus-spec" "\
-Update the format specification near point." t nil)
-
- (autoload 'gnus-fetch-group "gnus-group" "\
-Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not." t nil)
-
- (defalias 'gnus-batch-kill 'gnus-batch-score)
-
- (autoload 'gnus-batch-score "gnus-kill" "\
-Run batched scoring.
-Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
-Newsgroups is a list of strings in Bnews format. If you want to score
-the comp hierarchy, you'd say \"comp.all\". If you would not like to
-score the alt hierarchy, you'd say \"!alt.all\"." t nil))
-
-(provide 'gnus-setup)
-
-(run-hooks 'gnus-setup-load-hook)
-
-;;; gnus-setup.el ends here
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index ee3cdf48e45..2a8ea3ed201 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -1,6 +1,6 @@
;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: NAGY Andras <nagya@inf.elte.hu>,
;; Simon Josefsson <simon@josefsson.org>
@@ -46,21 +46,20 @@
:group 'gnus-sieve)
(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n"
- "Line indicating the start of the autogenerated region in
-your Sieve script."
+ "Line indicating the start of the autogenerated region in your Sieve script."
:type 'string
:group 'gnus-sieve)
(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n"
- "Line indicating the end of the autogenerated region in
-your Sieve script."
+ "Line indicating the end of the autogenerated region in your Sieve script."
:type 'string
:group 'gnus-sieve)
(defcustom gnus-sieve-select-method nil
"Which select method we generate the Sieve script for.
-
For example: \"nnimap:mailbox\""
+ ;; FIXME? gnus-select-method?
+ :type '(choice (const nil) string)
:group 'gnus-sieve)
(defcustom gnus-sieve-crosspost t
@@ -81,7 +80,7 @@ formatting characters are recognized:
(defun gnus-sieve-update ()
"Update the Sieve script in gnus-sieve-file, by replacing the region
between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost), then
execute gnus-sieve-update-shell-command.
See the documentation for these variables and functions for details."
(interactive)
@@ -98,7 +97,7 @@ See the documentation for these variables and functions for details."
(defun gnus-sieve-generate ()
"Generate the Sieve script in gnus-sieve-file, by replacing the region
between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\).
+\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost).
See the documentation for these variables and functions for details."
(interactive)
(require 'sieve)
@@ -140,7 +139,7 @@ Return nil if no rule could be guessed."
"Convert an elisp string list to a Sieve string list.
For example:
-\(gnus-sieve-string-list '(\"to\" \"cc\"))
+\(gnus-sieve-string-list \\='(\"to\" \"cc\"))
=> \"[\\\"to\\\", \\\"cc\\\"]\"
"
(concat "[\"" (mapconcat 'identity list "\", \"") "\"]"))
@@ -149,7 +148,7 @@ For example:
"Convert an elisp test list to a Sieve test list.
For example:
-\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K)))
+\(gnus-sieve-test-list \\='((address \"sender\" \"boss@company.com\") (size :over 4K)))
=> \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\""
(concat "(" (mapconcat 'gnus-sieve-test list ", ") ")"))
@@ -158,13 +157,13 @@ For example:
"Convert an elisp test token to a Sieve test token.
For example:
-\(gnus-sieve-test-token 'address)
+\(gnus-sieve-test-token \\='address)
=> \"address\"
\(gnus-sieve-test-token \"sender\")
=> \"\\\"sender\\\"\"
-\(gnus-sieve-test-token '(\"to\" \"cc\"))
+\(gnus-sieve-test-token \\='(\"to\" \"cc\"))
=> \"[\\\"to\\\", \\\"cc\\\"]\""
(cond
((symbolp token) ;; Keyword
@@ -185,10 +184,10 @@ For example:
"Convert an elisp test to a Sieve test.
For example:
-\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\"))
+\(gnus-sieve-test \\='(address \"sender\" \"sieve-admin@extundo.com\"))
=> \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\"
-\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\")
+\(gnus-sieve-test \\='(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\")
(size :over 100K))))
=> \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\",
size :over 100K)\""
@@ -196,9 +195,9 @@ For example:
(defun gnus-sieve-script (&optional method crosspost)
"Generate a Sieve script based on groups with select method METHOD
-\(or all groups if nil\). Only groups having a `sieve' parameter are
+\(or all groups if nil). Only groups having a `sieve' parameter are
considered. This parameter should contain an elisp test
-\(see the documentation of gnus-sieve-test for details\). For each
+\(see the documentation of gnus-sieve-test for details). For each
such group, a Sieve IF control structure is generated, having the
test as the condition and { fileinto \"group.name\"; } as the body.
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 0ff8ec89ac1..035a5901e69 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -1,6 +1,6 @@
;;; gnus-spec.el --- format spec functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(defvar gnus-newsrc-file-version)
@@ -81,7 +78,6 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway."
(defvar gnus-tmp-unread-and-unselected)
(defvar gnus-tmp-news-method)
(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-article-number)
(defvar gnus-mouse-face)
(defvar gnus-mouse-face-prop)
(defvar gnus-tmp-header)
@@ -512,7 +508,8 @@ are supported for %s."
(delete-char -1))
(t
(if (null args)
- (error 'wrong-number-of-arguments #'my-format n fstring))
+ (signal 'wrong-number-of-arguments
+ (list #'gnus-xmas-format n fstring)))
(let* ((minlen (string-to-number (or (match-string 2) "")))
(arg (car args))
(str (if (stringp arg) arg (format "%s" arg)))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 69774587d80..d32f7cad3db 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1,6 +1,6 @@
;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -45,7 +45,7 @@
:group 'gnus-server
:type 'hook)
-(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
+(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a%c\n"
"Format of server lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -78,6 +78,16 @@ If nil, a faster, but more primitive, buffer is used instead."
;;; Internal variables.
+(defvar gnus-tmp-how)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-where)
+(defvar gnus-tmp-status)
+(defvar gnus-tmp-agent)
+(defvar gnus-tmp-cloud)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-user-defined)
+
(defvar gnus-inserted-opened-servers nil)
(defvar gnus-server-line-format-alist
@@ -85,7 +95,8 @@ If nil, a faster, but more primitive, buffer is used instead."
(?n gnus-tmp-name ?s)
(?w gnus-tmp-where ?s)
(?s gnus-tmp-status ?s)
- (?a gnus-tmp-agent ?s)))
+ (?a gnus-tmp-agent ?s)
+ (?c gnus-tmp-cloud ?s)))
(defvar gnus-server-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
@@ -127,6 +138,7 @@ If nil, a faster, but more primitive, buffer is used instead."
["Close" gnus-server-close-server t]
["Offline" gnus-server-offline-server t]
["Deny" gnus-server-deny-server t]
+ ["Toggle Cloud" gnus-server-toggle-cloud-server t]
"---"
["Open All" gnus-server-open-all-servers t]
["Close All" gnus-server-close-all-servers t]
@@ -172,6 +184,8 @@ If nil, a faster, but more primitive, buffer is used instead."
"z" gnus-server-compact-server
+ "i" gnus-server-toggle-cloud-server
+
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
@@ -185,6 +199,13 @@ If nil, a faster, but more primitive, buffer is used instead."
(put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
(put 'gnus-server-agent-face 'obsolete-face "22.1")
+(defface gnus-server-cloud
+ '((((class color) (background light)) (:foreground "ForestGreen" :bold t))
+ (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
+ (t (:bold t)))
+ "Face used for displaying AGENTIZED servers"
+ :group 'gnus-server-visual)
+
(defface gnus-server-opened
'((((class color) (background light)) (:foreground "Green3" :bold t))
(((class color) (background dark)) (:foreground "Green1" :bold t))
@@ -228,6 +249,7 @@ If nil, a faster, but more primitive, buffer is used instead."
(defvar gnus-server-font-lock-keywords
'(("(\\(agent\\))" 1 'gnus-server-agent)
+ ("(\\(cloud\\))" 1 'gnus-server-cloud)
("(\\(opened\\))" 1 'gnus-server-opened)
("(\\(closed\\))" 1 'gnus-server-closed)
("(\\(offline\\))" 1 'gnus-server-offline)
@@ -244,6 +266,7 @@ For more in-depth information on this mode, read the manual
The following commands are available:
\\{gnus-server-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(interactive)
(when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
@@ -263,8 +286,9 @@ The following commands are available:
'(gnus-server-font-lock-keywords t)))
(gnus-run-mode-hooks 'gnus-server-mode-hook))
-(defun gnus-server-insert-server-line (gnus-tmp-name method)
- (let* ((gnus-tmp-how (car method))
+(defun gnus-server-insert-server-line (name method)
+ (let* ((gnus-tmp-name name)
+ (gnus-tmp-how (car method))
(gnus-tmp-where (nth 1 method))
(elem (assoc method gnus-opened-servers))
(gnus-tmp-status
@@ -281,6 +305,9 @@ The following commands are available:
(gnus-tmp-agent (if (and gnus-agent
(gnus-agent-method-p method))
" (agent)"
+ ""))
+ (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name)
+ " (cloud)"
"")))
(beginning-of-line)
(gnus-add-text-properties
@@ -869,7 +896,7 @@ claim them."
(gnus-message 5 "Connecting to %s...done" (nth 1 method))
t))))
-(defun gnus-browse-mode ()
+(define-derived-mode gnus-browse-mode fundamental-mode "Browse Server"
"Major mode for browsing a foreign server.
All normal editing commands are switched off.
@@ -884,20 +911,14 @@ buffer.
2) `\\[gnus-browse-read-group]' to read a group ephemerally.
3) `\\[gnus-browse-exit]' to return to the group buffer."
- (interactive)
- (kill-all-local-variables)
(when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
- (setq major-mode 'gnus-browse-mode)
- (setq mode-name "Browse Server")
(setq mode-line-process nil)
- (use-local-map gnus-browse-mode-map)
(buffer-disable-undo)
(setq truncate-lines t)
(gnus-set-default-directory)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-browse-mode-hook))
+ (setq buffer-read-only t))
(defun gnus-browse-read-group (&optional no-article number)
"Enter the group at the current line.
@@ -1022,7 +1043,7 @@ doing the deletion."
(defun gnus-browse-exit ()
"Quit browsing and return to the group buffer."
(interactive)
- (when (eq major-mode 'gnus-browse-mode)
+ (when (derived-mode-p 'gnus-browse-mode)
(gnus-kill-buffer (current-buffer)))
;; Insert the newly subscribed groups in the group buffer.
(with-current-buffer gnus-group-buffer
@@ -1089,6 +1110,27 @@ Requesting compaction of %s... (this may take a long time)"
(let ((original (get-buffer gnus-original-article-buffer)))
(and original (gnus-kill-buffer original))))))
+(defun gnus-server-toggle-cloud-server ()
+ "Make the server under point be replicated in the Emacs Cloud."
+ (interactive)
+ (let ((server (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+
+ (unless (gnus-method-option-p server 'cloud)
+ (error "The server under point doesn't support cloudiness"))
+
+ (if (gnus-cloud-server-p server)
+ (setq gnus-cloud-covered-servers
+ (delete server gnus-cloud-covered-servers))
+ (push server gnus-cloud-covered-servers))
+
+ (gnus-server-update-server server)
+ (gnus-message 1 (if (gnus-cloud-server-p server)
+ "Replication of %s in the cloud will start"
+ "Replication of %s in the cloud will stop")
+ server)))
+
(provide 'gnus-srvr)
;;; gnus-srvr.el ends here
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 9f3f469ad43..e267b6ae30c 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1,6 +1,6 @@
;;; gnus-start.el --- startup functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -30,6 +30,7 @@
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-util)
+(require 'gnus-cloud)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
@@ -121,9 +122,10 @@ This variable can be a list of select methods which Gnus will query with
the `ask-server' method in addition to the primary, secondary, and archive
servers.
+
E.g.:
(setq gnus-check-new-newsgroups
- '((nntp \"some.server\") (nntp \"other.server\")))
+ \\='((nntp \"some.server\") (nntp \"other.server\")))
If this variable is nil, then you have to tell Gnus explicitly to
check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
@@ -888,6 +890,11 @@ If REGEXP is given, lines that match it will be deleted."
(setq buffer-save-without-query t)
(erase-buffer)
(setq buffer-file-name dribble-file)
+ ;; The buffer may be shrunk a lot when deleting old entries.
+ ;; It caused the auto-saving to stop.
+ (if (featurep 'emacs)
+ (set (make-local-variable 'auto-save-include-big-deletions) t)
+ (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil))
(auto-save-mode t)
(buffer-disable-undo)
(bury-buffer (current-buffer))
@@ -1461,7 +1468,7 @@ newsgroup."
"Check whether a group has been activated or not.
If SCAN, request a scan of that group as well. If METHOD, use
that select method instead of determining the method based on the
-group name. If DONT-CHECK, don't check check whether the group
+group name. If DONT-CHECK, don't check whether the group
actually exists. If DONT-SUB-CHECK or DONT-CHECK, don't let the
backend check whether the group actually exists."
(let ((method (or method (inline (gnus-find-method-for-group group))))
@@ -2363,7 +2370,7 @@ If FORCE is non-nil, the .newsrc file is read."
(while (let (c
(cursor-in-echo-area t)
(echo-keystrokes 0))
- (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
+ (message "Convert gnus from version `%s' to `%s'? (n/y/?)"
gnus-newsrc-file-version gnus-version)
(setq c (read-char-exclusive))
@@ -2384,8 +2391,8 @@ If FORCE is non-nil, the .newsrc file is read."
(funcall func convert-to)))
(gnus-dribble-enter
- (format ";Converted gnus from version '%s' to '%s'."
- gnus-newsrc-file-version gnus-version)))))))
+ (gnus-format-message ";Converted gnus from version `%s' to `%s'."
+ gnus-newsrc-file-version gnus-version)))))))
(defun gnus-convert-mark-converter-prompt (converter no-prompt)
"Indicate whether CONVERTER requires gnus-convert-old-newsrc to
@@ -2777,6 +2784,7 @@ If FORCE is non-nil, the .newsrc file is read."
'msdos-long-file-names
(lambda () t))))
+(defvar gnus-save-newsrc-file-last-timestamp nil)
(defun gnus-save-newsrc-file (&optional force)
"Save .newsrc file."
;; Note: We cannot save .newsrc file if all newsgroups are removed
@@ -2815,12 +2823,29 @@ If FORCE is non-nil, the .newsrc file is read."
(erase-buffer)
(gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+ ;; check timestamp of `gnus-current-startup-file'.eld against
+ ;; `gnus-save-newsrc-file-last-timestamp'
+ (let* ((checkfile (concat gnus-current-startup-file ".eld"))
+ (mtime (nth 5 (file-attributes checkfile))))
+ (when (and gnus-save-newsrc-file-last-timestamp
+ (time-less-p gnus-save-newsrc-file-last-timestamp
+ mtime))
+ (unless (y-or-n-p
+ (format "%s was updated externally after %s, save?"
+ checkfile
+ (format-time-string
+ "%c"
+ gnus-save-newsrc-file-last-timestamp)))
+ (error "Couldn't save %s: updated externally" checkfile))))
+
(if gnus-save-startup-file-via-temp-buffer
(let ((coding-system-for-write gnus-ding-file-coding-system)
(standard-output (current-buffer)))
(gnus-gnus-to-quick-newsrc-format)
(gnus-run-hooks 'gnus-save-quick-newsrc-hook)
- (save-buffer))
+ (save-buffer)
+ (setq gnus-save-newsrc-file-last-timestamp
+ (nth 5 (file-attributes buffer-file-name))))
(let ((coding-system-for-write gnus-ding-file-coding-system)
(version-control gnus-backup-startup-file)
(startup-file (concat gnus-current-startup-file ".eld"))
@@ -2855,7 +2880,9 @@ If FORCE is non-nil, the .newsrc file is read."
;; Replace the existing startup file with the temp file.
(rename-file working-file startup-file t)
- (gnus-set-file-modes startup-file setmodes)))
+ (gnus-set-file-modes startup-file setmodes)
+ (setq gnus-save-newsrc-file-last-timestamp
+ (nth 5 (file-attributes startup-file)))))
(condition-case nil
(delete-file working-file)
(file-error nil)))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 94f4e703180..d4ca6555b66 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1,6 +1,6 @@
;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(eval-when-compile
@@ -897,6 +894,7 @@ subthreads, customize `gnus-subthread-sort-functions'."
"*List of functions used for sorting subthreads in the summary buffer.
By default, subthreads are sorted the same as threads, i.e.,
according to the value of `gnus-thread-sort-functions'."
+ :version "24.4"
:group 'gnus-summary-sort
:type '(choice
(const :tag "Sort subthreads like threads" gnus-thread-sort-functions)
@@ -999,7 +997,7 @@ following hook:
(mail-header-set-subject
header
(gnus-simplify-subject
- (mail-header-subject header) 're-only)))
+ (mail-header-subject header) \\='re-only)))
gnus-newsgroup-headers)))"
:group 'gnus-group-select
:type 'hook)
@@ -1140,7 +1138,6 @@ score: The article's score.
default: The default article score.
default-high: The default score for high scored articles.
default-low: The default score for low scored articles.
-below: The score below which articles are automatically marked as read.
mark: The article's mark.
uncached: Non-nil if the article is uncached."
:group 'gnus-summary-visual
@@ -1163,9 +1160,9 @@ which it may alter in any way."
'mail-decode-encoded-address-string
"Function used to decode addresses with encoded words.")
-(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups)
+(defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS)
"*Extra headers to parse."
- :version "24.1" ; added Cc Keywords Gcc
+ :version "25.1"
:group 'gnus-summary
:type '(repeat symbol))
@@ -1659,7 +1656,7 @@ while still allowing them to affect operations done in other buffers.
For example:
\(setq gnus-newsgroup-variables
- '(message-use-followup-to
+ \\='(message-use-followup-to
(gnus-visible-headers .
\"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
")
@@ -1851,7 +1848,6 @@ increase the score of each group you read."
[?\S-\ ] gnus-summary-prev-page
"\177" gnus-summary-prev-page
[delete] gnus-summary-prev-page
- [backspace] gnus-summary-prev-page
"\r" gnus-summary-scroll-up
"\M-\r" gnus-summary-scroll-down
"n" gnus-summary-next-unread-article
@@ -2189,6 +2185,7 @@ increase the score of each group you read."
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
"c" gnus-article-decode-charset
+ "h" gnus-mime-buttonize-attachments-in-header
"v" gnus-mime-view-all-parts
"b" gnus-article-view-part)
@@ -2223,7 +2220,6 @@ increase the score of each group you read."
"\M-\C-e" gnus-summary-expire-articles-now
"\177" gnus-summary-delete-article
[delete] gnus-summary-delete-article
- [backspace] gnus-summary-delete-article
"m" gnus-summary-move-article
"r" gnus-summary-respool-article
"w" gnus-summary-edit-article
@@ -2396,6 +2392,8 @@ increase the score of each group you read."
["QP" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
["View MIME buttons" gnus-summary-display-buttonized t]
+ ["View MIME buttons in header"
+ gnus-mime-buttonize-attachments-in-header t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
["Encrypt body" gnus-article-encrypt-body
@@ -2426,6 +2424,7 @@ increase the score of each group you read."
["Lapsed" gnus-article-date-lapsed t]
["User-defined" gnus-article-date-user t])
("Display"
+ ["Display HTML images" gnus-article-show-images t]
["Remove images" gnus-article-remove-images t]
["Toggle smiley" gnus-treat-smiley t]
["Show X-Face" gnus-article-display-x-face t]
@@ -3104,6 +3103,7 @@ buffer; read the info pages for more information (`\\[gnus-info-find-node]').
The following commands are available:
\\{gnus-summary-mode-map}"
+ ;; FIXME: Use define-derived-mode.
(interactive)
(kill-all-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
@@ -3542,7 +3542,7 @@ If the setup was successful, non-nil is returned."
"Set the global equivalents of the buffer-local variables.
They are set to the latest values they had. These reflect the summary
buffer that was in action when the last article was fetched."
- (when (eq major-mode 'gnus-summary-mode)
+ (when (derived-mode-p 'gnus-summary-mode)
(setq gnus-summary-buffer (current-buffer))
(let ((name gnus-newsgroup-name)
(marked gnus-newsgroup-marked)
@@ -3990,7 +3990,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
t)
;; We couldn't select this group.
((null did-select)
- (when (and (eq major-mode 'gnus-summary-mode)
+ (when (and (derived-mode-p 'gnus-summary-mode)
(not (equal (current-buffer) kill-buffer)))
(kill-buffer (current-buffer))
(if (not quit-config)
@@ -4009,7 +4009,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; The user did a `C-g' while prompting for number of articles,
;; so we exit this group.
((eq did-select 'quit)
- (and (eq major-mode 'gnus-summary-mode)
+ (and (derived-mode-p 'gnus-summary-mode)
(not (equal (current-buffer) kill-buffer))
(kill-buffer (current-buffer)))
(when kill-buffer
@@ -4025,6 +4025,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; The group was successfully selected.
(t
(gnus-set-global-variables)
+ (when (boundp 'spam-install-hooks)
+ (spam-initialize))
;; Save the active value in effect when the group was entered.
(setq gnus-newsgroup-active
(gnus-copy-sequence
@@ -4052,7 +4054,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(unless no-display
(gnus-summary-prepare))
(when gnus-use-trees
- (gnus-tree-open group)
+ (gnus-tree-open)
(setq gnus-summary-highlight-line-function
'gnus-tree-highlight-article))
;; If the summary buffer is empty, but there are some low-scored
@@ -4374,7 +4376,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
;; The last case ignores an existing entry, except it adds any
;; additional Xrefs (in case the two articles came from different
;; servers.
- ;; Also sets `header' to `nil' meaning that the `dependencies'
+ ;; Also sets `header' to nil meaning that the `dependencies'
;; table was *not* modified.
(t
(mail-header-set-xref
@@ -5612,15 +5614,15 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
- (when (equal major-mode 'gnus-summary-mode)
+ (when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
(error
"Couldn't activate group %s: %s"
(mm-decode-coding-string group charset)
(mm-decode-coding-string (gnus-status-message group) charset))))
- (unless (gnus-request-group group t)
- (when (equal major-mode 'gnus-summary-mode)
+ (unless (gnus-request-group group t nil (gnus-get-info group))
+ (when (derived-mode-p 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
(mm-decode-coding-string group charset)
@@ -7217,6 +7219,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-dribble-save)))
(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
+(declare-function gnus-article-stop-animations "gnus-art" ())
(defun gnus-summary-exit (&optional temporary leave-hidden)
"Exit reading current newsgroup, and then return to group selection mode.
@@ -7257,7 +7260,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(when gnus-suppress-duplicates
(gnus-dup-enter-articles))
(when gnus-use-trees
- (gnus-tree-close group))
+ (gnus-tree-close))
(when gnus-use-cache
(gnus-cache-write-active))
;; Remove entries for this group.
@@ -7280,6 +7283,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(not (string= group (gnus-group-group-name))))
(gnus-group-next-unread-group 1))
(setq group-point (point))
+ (gnus-article-stop-animations)
(if temporary
nil ;Nothing to do.
(set-buffer buf)
@@ -7320,7 +7324,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(unless quit-config
(setq gnus-newsgroup-name nil)))))
-(declare-function gnus-article-stop-animations "gnus-art" ())
(declare-function gnus-stop-downloads "gnus-art" ())
(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
@@ -7332,6 +7335,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-is-exiting-without-update-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
+ (gnus-ephemeral-group-p group)
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
@@ -7360,7 +7364,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(when gnus-use-trees
- (gnus-tree-close group))
+ (gnus-tree-close))
(gnus-async-prefetch-remove-group group)
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
@@ -7370,6 +7374,7 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-update-group group nil t))
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
+ (gnus-article-stop-animations)
(when quit-config
(gnus-handle-ephemeral-exit quit-config)))))
@@ -7383,9 +7388,9 @@ The state which existed when entering the ephemeral is reset."
(unless (eq (cdr quit-config) 'group)
(setq gnus-current-select-method
(gnus-find-method-for-group gnus-newsgroup-name)))
- (cond ((eq major-mode 'gnus-summary-mode)
+ (cond ((derived-mode-p 'gnus-summary-mode)
(gnus-set-global-variables))
- ((eq major-mode 'gnus-article-mode)
+ ((derived-mode-p 'gnus-article-mode)
(save-current-buffer
;; The `gnus-summary-buffer' variable may point
;; to the old summary buffer when using a single
@@ -7400,7 +7405,7 @@ The state which existed when entering the ephemeral is reset."
(gnus-configure-windows 'pick 'force)
(gnus-configure-windows (cdr quit-config) 'force))
(gnus-configure-windows (cdr quit-config) 'force))
- (when (eq major-mode 'gnus-summary-mode)
+ (when (derived-mode-p 'gnus-summary-mode)
(if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
next-unread-noselect))
(when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
@@ -7470,7 +7475,7 @@ The state which existed when entering the ephemeral is reset."
(when (and gnus-use-trees
(gnus-buffer-exists-p buffer))
(with-current-buffer buffer
- (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-tree-close)))
(gnus-kill-buffer buffer))
;; Deaden the buffer.
((gnus-buffer-exists-p buffer)
@@ -7699,7 +7704,7 @@ Given a prefix, will force an `article' buffer configuration."
"Display ARTICLE in article buffer."
(unless (and (gnus-buffer-live-p gnus-article-buffer)
(with-current-buffer gnus-article-buffer
- (eq major-mode 'gnus-article-mode)))
+ (derived-mode-p 'gnus-article-mode)))
(gnus-article-setup-buffer))
(gnus-set-global-variables)
(with-current-buffer gnus-article-buffer
@@ -7731,7 +7736,7 @@ non-nil, the article will be re-fetched even if it already present in
the article buffer. If PSEUDO is non-nil, pseudo-articles will also
be displayed."
;; Make sure we are in the summary buffer to work around bbdb bug.
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
(all-headers (not (not all-headers))) ;Must be t or nil.
@@ -7783,7 +7788,7 @@ If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
;; Make sure we are in the summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(set-buffer gnus-summary-buffer))
(cond
;; Is there such an article?
@@ -8424,7 +8429,7 @@ articles that are younger than AGE days."
(gnus-summary-position-point)))
(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
- "Limit the summary buffer to articles that match an 'extra' header."
+ "Limit the summary buffer to articles that match an `extra' header."
(interactive
(let ((header
(intern
@@ -9063,25 +9068,62 @@ non-numeric or nil fetch the number specified by the
(regexp-opt ',(append refs (list id subject)))))))
(gnus-fetch-headers (list last) (if (numberp limit)
(* 2 limit) limit) t))))
- article-ids)
+ article-ids new-unreads)
(when (listp new-headers)
(dolist (header new-headers)
- (push (mail-header-number header) article-ids)
- (when (member (mail-header-number header) gnus-newsgroup-unselected)
- (push (mail-header-number header) gnus-newsgroup-unreads)
- (setq gnus-newsgroup-unselected
- (delete (mail-header-number header)
- gnus-newsgroup-unselected))))
+ (push (mail-header-number header) article-ids))
+ (setq article-ids (nreverse article-ids))
+ (setq new-unreads
+ (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
+ (setq gnus-newsgroup-unselected
+ (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
(setq gnus-newsgroup-headers
(gnus-delete-duplicate-headers
(gnus-merge
'list gnus-newsgroup-headers new-headers
'gnus-article-sort-by-number)))
(setq gnus-newsgroup-articles
- (gnus-sorted-nunion gnus-newsgroup-articles (nreverse article-ids)))
+ (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
(gnus-summary-limit-include-thread id)))
(gnus-summary-show-thread))
+(defun gnus-summary-open-group-with-article (message-id)
+ "Open a group containing the article with the given MESSAGE-ID."
+ (interactive "sMessage-ID: ")
+ (require 'nndoc)
+ (with-temp-buffer
+ ;; Prepare a dummy article
+ (erase-buffer)
+ (insert "From nobody Tue Sep 13 22:05:34 2011\n\n")
+
+ ;; Prepare pretty modelines for summary and article buffers
+ (let ((gnus-summary-mode-line-format "Found %G")
+ (gnus-article-mode-line-format
+ ;; Group names just get in the way here, especially the
+ ;; abbreviated ones
+ (if (string-match "%[gG]" gnus-article-mode-line-format)
+ (concat (substring gnus-article-mode-line-format
+ 0 (match-beginning 0))
+ (substring gnus-article-mode-line-format (match-end 0)))
+ gnus-article-mode-line-format)))
+
+ ;; Build an ephemeral group containing the dummy article (hidden)
+ (gnus-group-read-ephemeral-group
+ message-id
+ `(nndoc ,message-id
+ (nndoc-address ,(current-buffer))
+ (nndoc-article-type mbox))
+ :activate
+ (cons (current-buffer) gnus-current-window-configuration)
+ (not :request-only)
+ '(-1) ; :select-articles
+ (not :parameters)
+ 0)) ; :number
+ ;; Fetch the desired article
+ (gnus-summary-refer-article message-id)))
+
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
(interactive "sMessage-ID: ")
@@ -9202,6 +9244,7 @@ To control what happens when you exit the group, see the
(gnus-fetch-field "from")))
(setq params
(append
+ params
(list (cons 'to-address
(funcall gnus-decode-encoded-address-function
to-address))))))
@@ -9294,7 +9337,7 @@ Obeys the standard process/prefix convention."
((gnus-group-read-ephemeral-group
(setq vgroup (format
"nnvirtual:%s-%s" gnus-newsgroup-name
- (format-time-string "%Y%m%dT%H%M%S" (current-time))))
+ (format-time-string "%Y%m%dT%H%M%S")))
`(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
t
(cons (current-buffer) 'summary)))
@@ -9446,6 +9489,7 @@ Optional argument BACKWARD means do search for backward.
;; Return whether we found the regexp.
(when (eq found 'found)
(goto-char point)
+ (sit-for 0) ;; Ensure that the point is visible in the summary window.
(gnus-summary-show-thread)
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point)
@@ -9744,6 +9788,8 @@ If ARG is a negative number, turn header display off."
(declare-function article-narrow-to-head "gnus-art" ())
(declare-function gnus-article-hidden-text-p "gnus-art" (type))
(declare-function gnus-delete-wash-type "gnus-art" (type))
+(declare-function gnus-mime-buttonize-attachments-in-header
+ "gnus-art" (&optional interactive))
(defun gnus-summary-toggle-header (&optional arg)
"Show the headers if they are hidden, or hide them if they are shown.
@@ -9775,7 +9821,10 @@ If ARG is a negative number, hide the unwanted header lines."
(gnus-treat-hide-boring-headers nil))
(gnus-delete-wash-type 'headers)
(gnus-treat-article 'head))
- (gnus-treat-article 'head))
+ (gnus-treat-article 'head)
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(widen)
(if window
(set-window-start window (goto-char (point-min))))
@@ -9822,9 +9871,12 @@ invalid IDNA string (`xn--bar' is invalid).
You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
- (if (not (and (condition-case nil (require 'idna)
- (file-error))
- (mm-coding-system-p 'utf-8)
+ (if (not (and (mm-coding-system-p 'utf-8)
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
+ (symbol-value 'idna-program)
(executable-find (symbol-value 'idna-program))))
(gnus-message
5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
@@ -10400,13 +10452,19 @@ This will be the case if the article has both been mailed and posted."
(when (and (not (memq article es))
(gnus-data-find article))
(gnus-summary-mark-article article gnus-canceled-mark)
- (run-hook-with-args 'gnus-summary-article-expire-hook
- 'delete
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- nil
- nil)))))))
+ (run-hook-with-args
+ 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ (cond
+ ((stringp nnmail-expiry-target) nnmail-expiry-target)
+ ((eq nnmail-expiry-target 'delete) nil)
+ (t
+ (let ((rescall (funcall nnmail-expiry-target
+ gnus-newsgroup-name)))
+ (if (stringp rescall) rescall nil))))
+ nil)))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
@@ -10569,7 +10627,7 @@ groups."
(let ((lines (count-lines (point) (point-max)))
(length (- (point-max) (point)))
(case-fold-search t)
- (body (copy-marker (point))))
+ (body (point-marker)))
(goto-char (point-min))
(when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
(delete-region (match-beginning 1) (match-end 1))
@@ -10657,13 +10715,31 @@ groups."
;;; Respooling
+(defvar nnimap-split-fancy)
+(defvar nnimap-split-methods)
+
(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
(interactive)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
(with-current-buffer gnus-original-article-buffer
- (let ((groups (nnmail-article-group 'identity trace)))
+ (let ((groups
+ (if (eq (car (gnus-find-method-for-group gnus-newsgroup-name))
+ 'nnimap)
+ ;; nnimap has its own splitting variables.
+ (let ((nnmail-split-methods
+ (cond
+ ((eq nnimap-split-methods 'default)
+ nnmail-split-methods)
+ (nnimap-split-methods
+ nnimap-split-methods)
+ (nnimap-split-fancy
+ 'nnmail-split-fancy)))
+ (nnmail-split-fancy (or nnimap-split-fancy
+ nnmail-split-fancy)))
+ (nnmail-article-group 'identity trace))
+ (nnmail-article-group 'identity trace))))
(unless silent
(if groups
(message "This message would go to %s"
@@ -11620,20 +11696,10 @@ If ARG is positive number, turn showing conversation threads on."
(gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
(gnus-summary-position-point)))
-(eval-and-compile
- (if (fboundp 'remove-overlays)
- (defalias 'gnus-remove-overlays 'remove-overlays)
- (defun gnus-remove-overlays (beg end name val)
- "Clear BEG and END of overlays whose property NAME has value VAL.
-For compatibility with XEmacs."
- (dolist (ov (gnus-overlays-in beg end))
- (when (eq (gnus-overlay-get ov name) val)
- (gnus-delete-overlay ov))))))
-
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
+ (remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
(defsubst gnus-summary--inv (p)
@@ -11660,7 +11726,7 @@ Returns nil if no thread was there to be shown."
'gnus-sum))))
(point)))))
(when eoi
- (gnus-remove-overlays beg eoi 'invisible 'gnus-sum)
+ (remove-overlays beg eoi 'invisible 'gnus-sum)
(goto-char orig)
(gnus-summary-position-point)
eoi)))
@@ -11729,10 +11795,10 @@ Returns nil if no threads were there to be hidden."
(search-backward "\n" start t))
(progn
(when (> (point) starteol)
- (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum)
- (let ((ol (gnus-make-overlay starteol (point) nil t nil)))
- (gnus-overlay-put ol 'invisible 'gnus-sum)
- (gnus-overlay-put ol 'evaporate t)))
+ (remove-overlays starteol (point) 'invisible 'gnus-sum)
+ (let ((ol (make-overlay starteol (point) nil t nil)))
+ (overlay-put ol 'invisible 'gnus-sum)
+ (overlay-put ol 'evaporate t)))
(gnus-summary-goto-subject article)
(when (> start (point))
(message "Hiding the thread moved us backwards, aborting!")
@@ -12551,11 +12617,11 @@ If REVERSE, save parts that do not match TYPE."
(setq to end))
(if gnus-newsgroup-selected-overlay
;; Move old overlay.
- (gnus-move-overlay
+ (move-overlay
gnus-newsgroup-selected-overlay from to (current-buffer))
;; Create new overlay.
- (gnus-overlay-put
- (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
+ (overlay-put
+ (setq gnus-newsgroup-selected-overlay (make-overlay from to))
'face gnus-summary-selected-face))))))
(defvar gnus-summary-highlight-line-cached nil)
@@ -12680,7 +12746,7 @@ UNREAD is a sorted list."
(string-match "Summary" buffer)
(with-current-buffer buffer
;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
+ (and (derived-mode-p 'gnus-summary-mode)
;; Also make sure this isn't bogus.
gnus-newsgroup-prepared
;; Also make sure that this isn't a
@@ -12815,7 +12881,7 @@ returned."
(defun gnus-summary-generic-mark (n mark move unread)
"Mark N articles with MARK."
- (unless (eq major-mode 'gnus-summary-mode)
+ (unless (derived-mode-p 'gnus-summary-mode)
(error "This command can only be used in the summary buffer"))
(gnus-summary-show-thread)
(let ((nummove
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
index 8cf92df5b91..c9ccc3ec69d 100644
--- a/lisp/gnus/gnus-sync.el
+++ b/lisp/gnus/gnus-sync.el
@@ -1,6 +1,6 @@
;;; gnus-sync.el --- synchronization facility for Gnus
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news synchronization nntp nnrss
@@ -90,10 +90,7 @@
(require 'gnus-util)
(defvar gnus-topic-alist) ;; gnus-group.el
-(eval-when-compile
- (autoload 'gnus-group-topic "gnus-topic")
- (autoload 'gnus-topic-create-topic "gnus-topic" nil t)
- (autoload 'gnus-topic-enter-dribble "gnus-topic"))
+(autoload 'gnus-group-topic "gnus-topic")
(defgroup gnus-sync nil
"The Gnus synchronization facility."
@@ -139,8 +136,9 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'."
"Carrier for newsrc data")
(defcustom gnus-sync-file-encrypt-to nil
- "If non-nil, `epa-file-encrypt-to' is set from this for encrypting the Sync
- file."
+ "If non-nil, set `epa-file-encrypt-to' from this for encrypting the Sync file."
+ :version "24.4"
+ :type '(choice string (repeat string))
:group 'gnus-sync)
(defcustom gnus-sync-lesync-name (system-name)
@@ -604,6 +602,10 @@ unwanted groups via the LeSync URL."
loc name gnus-sync-lesync-name (or sources "")))
nil)))
+(declare-function gnus-topic-create-topic "gnus-topic"
+ (topic parent &optional previous full-topic))
+(declare-function gnus-topic-enter-dribble "gnus-topic" ())
+
(defun gnus-sync-lesync-install-group-entry (name)
(let* ((master (assoc name gnus-newsrc-alist))
(old-topic-name (gnus-group-topic name))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index dbad79650c4..b9897832517 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1,6 +1,6 @@
;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -154,7 +154,7 @@ See Info node `(gnus)Formatting Variables'."
"Go to TOPIC."
(interactive
(list (gnus-completing-read "Go to topic" (gnus-topic-list) t)))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(dolist (topic (gnus-current-topics topic))
(unless (gnus-topic-goto-topic topic)
(gnus-topic-goto-missing-topic topic)
@@ -427,7 +427,7 @@ If PREDICATE is a function, list groups that the function returns non-nil;
if it is t, list groups that have no unread articles.
If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(lowest (or lowest 1))
(not-in-list
(and gnus-group-listed-groups
@@ -508,7 +508,6 @@ articles in the topic and its subtopics."
(all-entries entries)
(point-max (point-max))
(unread 0)
- (topic (car type))
info entry end active tick)
;; Insert any sub-topics.
(while topicl
@@ -582,15 +581,11 @@ articles in the topic and its subtopics."
(not (eq (nth 2 type) 'hidden))
level all-entries unread))
(gnus-topic-update-unreads (car type) unread)
- (when gnus-group-update-tool-bar
- (gnus-put-text-property beg end 'point-entered
- 'gnus-tool-bar-update)
- (gnus-put-text-property beg end 'point-left
- 'gnus-tool-bar-update))
+ (gnus-group--setup-tool-bar-update beg end)
(goto-char end)
unread))
-(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
+(defun gnus-topic-remove-topic (&optional insert total-remove _hide in-level)
"Remove the current topic."
(let ((topic (gnus-group-topic-name))
(level (gnus-group-topic-level))
@@ -635,6 +630,8 @@ articles in the topic and its subtopics."
(or insert (not (gnus-topic-visible-p))) nil nil 9)
(gnus-topic-enter-dribble)))))))
+(defvar gnus-tmp-header)
+
(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
&optional unread)
(let* ((visible (if visiblep "" "..."))
@@ -684,7 +681,7 @@ articles in the topic and its subtopics."
gnus-topic-mode)
(let ((group (gnus-group-group-name))
(m (point-marker))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (and group
(gnus-get-info group)
(gnus-topic-goto-topic (gnus-current-topic)))
@@ -698,8 +695,7 @@ articles in the topic and its subtopics."
(let* ((topic (gnus-group-topic group))
(groups (cdr (assoc topic gnus-topic-alist)))
(g (cdr (member group groups)))
- (unfound t)
- entry)
+ (unfound t))
;; Try to jump to a visible group.
(while (and g
(not (gnus-group-goto-group (car g) t)))
@@ -902,7 +898,7 @@ articles in the topic and its subtopics."
(defun gnus-topic-change-level (group level oldlevel &optional previous)
"Run when changing levels to enter/remove groups from topics."
(with-current-buffer gnus-group-buffer
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(unless gnus-topic-inhibit-change-level
(gnus-group-goto-group (or (car (nth 2 previous)) group))
(when (and gnus-topic-mode
@@ -1131,22 +1127,17 @@ articles in the topic and its subtopics."
["Edit parameters" gnus-topic-edit-parameters t])
["List active" gnus-topic-list-active t]))))
-(defun gnus-topic-mode (&optional arg redisplay)
+(define-minor-mode gnus-topic-mode
"Minor mode for topicsifying Gnus group buffers."
- ;; FIXME: Use define-minor-mode.
- (interactive (list current-prefix-arg t))
- (when (eq major-mode 'gnus-group-mode)
- (make-local-variable 'gnus-topic-mode)
- (setq gnus-topic-mode
- (if (null arg) (not gnus-topic-mode)
- (> (prefix-numeric-value arg) 0)))
+ :lighter " Topic" :keymap gnus-topic-mode-map
+ (if (not (derived-mode-p 'gnus-group-mode))
+ (setq gnus-topic-mode nil)
;; Infest Gnus with topics.
(if (not gnus-topic-mode)
(setq gnus-goto-missing-group-function nil)
(when (gnus-visual-p 'topic-menu 'menu)
(gnus-topic-make-menu-bar))
(gnus-set-format 'topic t)
- (add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
(add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
(set (make-local-variable 'gnus-group-prepare-function)
'gnus-group-prepare-topics)
@@ -1168,8 +1159,7 @@ articles in the topic and its subtopics."
(setq gnus-topology-checked-p nil)
;; We check the topology.
(when gnus-newsrc-alist
- (gnus-topic-check-topology))
- (gnus-run-hooks 'gnus-topic-mode-hook))
+ (gnus-topic-check-topology)))
;; Remove topic infestation.
(unless gnus-topic-mode
(remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
@@ -1177,7 +1167,7 @@ articles in the topic and its subtopics."
(remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
(setq gnus-group-prepare-function 'gnus-group-prepare-flat)
(setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
- (when redisplay
+ (when (gmm-called-interactively-p 'any)
(gnus-group-list-groups))))
(defun gnus-topic-select-group (&optional all)
@@ -1229,10 +1219,10 @@ Also see `gnus-group-catchup'."
(call-interactively 'gnus-group-catchup-current)
(save-excursion
(let* ((groups
- (mapcar (lambda (entry) (car (nth 2 entry)))
- (gnus-topic-find-groups topic gnus-level-killed t
- nil t)))
- (buffer-read-only nil)
+ (mapcar (lambda (entry) (car (nth 2 entry)))
+ (gnus-topic-find-groups topic gnus-level-killed t
+ nil t)))
+ (inhibit-read-only t)
(gnus-group-marked groups))
(gnus-group-catchup-current)
(mapcar 'gnus-topic-update-topics-containing-group groups)))))
@@ -1336,7 +1326,7 @@ If COPYP, copy the groups instead."
(lambda (group)
(gnus-group-remove-mark group use-marked)
(let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (and topicl group)
(gnus-delete-line)
(gnus-delete-first group topicl))
@@ -1464,7 +1454,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics."
(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
(gnus-info-group (nth 2 (pop groups)))))))))
-(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive)
+(defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive)
"Remove the process mark from all groups in the TOPIC.
If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(interactive (list (gnus-group-topic-name)
@@ -1498,15 +1488,14 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(gnus-group-mark-regexp regexp)
(gnus-topic-move-group nil topic copyp))
-(defun gnus-topic-copy-matching (regexp topic &optional copyp)
+(defun gnus-topic-copy-matching (regexp topic &optional _copyp)
"Copy all groups that match REGEXP to some topic."
(interactive
- (let (topic)
+ (let ((topic (gnus-completing-read "Copy to topic"
+ (mapcar #'car gnus-topic-alist) t)))
(nreverse
- (list
- (setq topic (gnus-completing-read "Copy to topic"
- (mapcar 'car gnus-topic-alist) t))
- (read-string (format "Copy to %s (regexp): " topic))))))
+ (list topic
+ (read-string (format "Copy to %s (regexp): " topic))))))
(gnus-topic-move-matching regexp topic t))
(defun gnus-topic-delete (topic)
@@ -1515,7 +1504,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(unless topic
(error "No topic to be deleted"))
(let ((entry (assoc topic gnus-topic-alist))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (cdr entry)
(error "Topic not empty"))
;; Delete if visible.
@@ -1535,7 +1524,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
(read-string (format "Rename %s to: " topic) topic))))
;; Check whether the new name exists.
(when (gnus-topic-find-topology new-name)
- (error "Topic '%s' already exists" new-name))
+ (error "Topic `%s' already exists" new-name))
;; "nil" is an invalid name, for reasons I'd rather not go
;; into here. Trust me.
(when (equal new-name "nil")
@@ -1560,7 +1549,7 @@ If UNINDENT, remove an indentation."
(gnus-topic-unindent)
(let* ((topic (gnus-current-topic))
(parent (gnus-topic-previous-topic topic))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(unless parent
(error "Nothing to indent %s into" topic))
(when topic
@@ -1626,8 +1615,8 @@ If performed on a topic, edit the topic parameters instead."
(let ((topic (gnus-group-topic-name)))
(gnus-edit-form
(gnus-topic-parameters topic)
- (format "Editing the topic parameters for `%s'."
- (or group topic))
+ (gnus-format-message "Editing the topic parameters for `%s'."
+ (or group topic))
`(lambda (form)
(gnus-topic-set-parameters ,topic form)))))))
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 0854b5435f7..c9d1444a436 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -1,6 +1,6 @@
;;; gnus-undo.el --- minor mode for undoing in Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 1d2ab2da248..40e2dcf92fd 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1,6 +1,6 @@
;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -32,9 +32,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
@@ -316,14 +313,10 @@ Symbols are also allowed; their print names are used instead."
;; Every version of Emacs Gnus supports has built-in float-time.
;; The featurep test silences an irritating compiler warning.
-(eval-and-compile
+(defalias 'gnus-float-time
(if (or (featurep 'emacs)
(fboundp 'float-time))
- (defalias 'gnus-float-time 'float-time)
- (defun gnus-float-time (&optional time)
- "Convert time value TIME to a floating point number.
-TIME defaults to the current time."
- (time-to-seconds (or time (current-time))))))
+ 'float-time 'time-to-seconds))
;;; Keymap macros.
@@ -392,19 +385,20 @@ TIME defaults to the current time."
(defun gnus-seconds-today ()
"Return the number of seconds passed today."
- (let ((now (decode-time (current-time))))
+ (let ((now (decode-time)))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
(defun gnus-seconds-month ()
"Return the number of seconds passed this month."
- (let ((now (decode-time (current-time))))
+ (let ((now (decode-time)))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
(* (- (car (nthcdr 3 now)) 1) 3600 24))))
(defun gnus-seconds-year ()
"Return the number of seconds passed this year."
- (let ((now (decode-time (current-time)))
- (days (format-time-string "%j" (current-time))))
+ (let* ((current (current-time))
+ (now (decode-time current))
+ (days (format-time-string "%j" current)))
(+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
(* (- (string-to-number days) 1) 3600 24))))
@@ -514,11 +508,14 @@ but also to the ones displayed in the echo area."
(> message-log-max 0)
(/= (length str) 0))
(setq time (current-time))
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (if (fboundp 'messages-buffer)
+ (messages-buffer)
+ (get-buffer-create "*Messages*"))
(goto-char (point-max))
- (insert ,timestamp str "\n")
- (forward-line (- message-log-max))
- (delete-region (point-min) (point))
+ (let ((inhibit-read-only t))
+ (insert ,timestamp str "\n")
+ (forward-line (- message-log-max))
+ (delete-region (point-min) (point)))
(goto-char (point-max))))
str)
(gnus-add-timestamp-to-message
@@ -856,10 +853,6 @@ If there's no subdirectory, delete DIRECTORY as well."
(setq beg (point)))
(gnus-put-text-property beg (point) prop val)))))
-(declare-function gnus-overlay-put "gnus" (overlay prop value))
-(declare-function gnus-make-overlay "gnus"
- (beg end &optional buffer front-advance rear-advance))
-
(defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
"The same as `put-text-property', but don't put this prop on any newlines in the region."
(save-match-data
@@ -867,11 +860,9 @@ If there's no subdirectory, delete DIRECTORY as well."
(save-restriction
(goto-char beg)
(while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
- (gnus-overlay-put
- (gnus-make-overlay beg (match-beginning 0))
- prop val)
+ (overlay-put (make-overlay beg (match-beginning 0)) prop val)
(setq beg (point)))
- (gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
+ (overlay-put (make-overlay beg (point)) prop val)))))
(defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val)
"The same as `put-text-property', except where `gnus-face' is set.
@@ -934,7 +925,7 @@ Otherwise, return the value."
'previous-extent-change 'previous-char-property-change))
;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996
-;; The primary idea here is to try to protect internal datastructures
+;; The primary idea here is to try to protect internal data structures
;; from becoming corrupted when the user hits C-g, or if a hook or
;; similar blows up. Often in Gnus multiple tables/lists need to be
;; updated at the same time, or information can be lost.
@@ -1495,7 +1486,7 @@ sure of changing the value of `foo'."
(defvar gnus-directory-sep-char-regexp "/"
"The regexp of directory separator character.
If you find some problem with the directory separator character, try
-\"[/\\\\\]\" for some systems.")
+\"[/\\\\]\" for some systems.")
(defun gnus-url-unhex (x)
(if (> x ?9)
@@ -1578,8 +1569,10 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional default require-match start matches-set))
+ (prompt &optional default require-match
+ _predicate start matches-set))
(defvar iswitchb-temp-buflist)
+(defvar iswitchb-mode)
(defun gnus-iswitchb-completing-read (prompt collection &optional require-match
initial-input history def)
@@ -1888,6 +1881,8 @@ empty directories from OLD-PATH."
(get-char-table ,character ,display-table)))
`(aref ,display-table ,character)))
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(defun gnus-rescale-image (image size)
"Rescale IMAGE to SIZE if possible.
SIZE is in format (WIDTH . HEIGHT). Return a new image.
@@ -1908,17 +1903,25 @@ Sizes are in pixels."
image)))
image)))
+(eval-when-compile (require 'gmm-utils))
(defun gnus-recursive-directory-files (dir)
- "Return all regular files below DIR."
- (let (files)
- (dolist (file (directory-files dir t))
- (when (and (not (member (file-name-nondirectory file) '("." "..")))
- (file-readable-p file))
- (cond
- ((file-regular-p file)
- (push file files))
- ((file-directory-p file)
- (setq files (append (gnus-recursive-directory-files file) files))))))
+ "Return all regular files below DIR.
+The first found will be returned if a file has hard or symbolic links."
+ (let (files attr attrs)
+ (gmm-labels
+ ((fn (directory)
+ (dolist (file (directory-files directory t))
+ (setq attr (file-attributes (file-truename file)))
+ (when (and (not (member attr attrs))
+ (not (member (file-name-nondirectory file)
+ '("." "..")))
+ (file-readable-p file))
+ (push attr attrs)
+ (cond ((file-regular-p file)
+ (push file files))
+ ((file-directory-p file)
+ (fn file)))))))
+ (fn dir))
files))
(defun gnus-list-memq-of-list (elements list)
@@ -1971,6 +1974,11 @@ to case differences."
(string-equal (downcase str1) (downcase prefix))
(string-equal str1 prefix))))))
+(defalias 'gnus-format-message
+ (if (fboundp 'format-message) 'format-message
+ ;; for Emacs < 25, and XEmacs, don't worry about quote translation.
+ 'format))
+
;; Simple check: can be a macro but this way, although slow, it's really clear.
;; We don't use `bound-and-true-p' because it's not in XEmacs.
(defun gnus-bound-and-true-p (sym)
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 16ed4f17801..f2164665529 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1,6 +1,6 @@
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985-1987, 1993-1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -79,10 +79,10 @@ To change the behavior, you can either edit this variable or set
For example:
-To make gnus-uu use 'xli' to display JPEG and GIF files, put the
+To make gnus-uu use `xli' to display JPEG and GIF files, put the
following in your .emacs file:
- (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
+ (setq gnus-uu-user-view-rules \\='((\"jpg$\\\\|gif$\" \"xli\")))
Both these variables are lists of lists with two string elements. The
first string is a regular expression. If the file name matches this
@@ -140,10 +140,10 @@ details."
(defcustom gnus-uu-user-archive-rules nil
"A list that can be set to override the default archive unpacking commands.
-To use, for instance, 'untar' to unpack tar files and 'zip -x' to
+To use, for instance, `untar' to unpack tar files and `zip -x' to
unpack zip files, say the following:
(setq gnus-uu-user-archive-rules
- '((\"\\\\.tar$\" \"untar\")
+ \\='((\"\\\\.tar$\" \"untar\")
(\"\\\\.zip$\" \"zip -x\")))"
:group 'gnus-extract-archive
:type '(repeat (group regexp (string :tag "Command"))))
@@ -406,6 +406,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(read-directory-name "Unbinhex and save in dir: "
gnus-uu-default-dir
gnus-uu-default-dir))))
+ (gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
@@ -471,6 +472,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
+ (gnus-uu-initialize)
(setq gnus-uu-binhex-article-name
(mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
@@ -482,8 +484,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time."
(defun gnus-uu-digest-mail-forward (&optional n post)
"Digests and forwards all articles in this series."
(interactive "P")
+ (gnus-uu-initialize)
(let ((gnus-uu-save-in-digest t)
- (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
+ (file (mm-make-temp-file (nnheader-concat gnus-uu-work-dir "forward")))
(message-forward-as-mime message-forward-as-mime)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
@@ -870,10 +873,9 @@ When called interactively, prompt for REGEXP."
(setq state (list 'middle))))
(with-current-buffer "*gnus-uu-body*"
(goto-char (setq beg (point-max)))
- (save-excursion
+ (with-current-buffer buffer
(save-restriction
- (set-buffer buffer)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(set-text-properties (point-min) (point-max) nil)
;; These two are necessary for XEmacs 19.12 fascism.
(put-text-property (point-min) (point-max) 'invisible nil)
@@ -907,8 +909,7 @@ When called interactively, prompt for REGEXP."
(match-beginning 0)
(or (and (re-search-forward "^[^ \t]" nil t)
(1- (point)))
- (progn (forward-line 1) (point)))))))))
- (widen)))
+ (progn (forward-line 1) (point)))))))))))
(if (and message-forward-as-mime gnus-uu-digest-buffer)
(if message-forward-show-mml
(progn
@@ -1836,8 +1837,8 @@ Gnus might fail to display all of it.")
;; Initializing
-(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
+(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-clean-up)
+(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-delete-work-dir)
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 55f99653cc4..3777a906d09 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -1,6 +1,6 @@
;;; gnus-vm.el --- vm interface for Gnus
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Per Persson <pp@gnu.ai.mit.edu>
;; Keywords: news, mail
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 2de6cdf4896..ac48440c7ec 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -1,6 +1,6 @@
;;; gnus-win.el --- window configuration functions for Gnus
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 266ee0fe7cb..a2913ac9fdd 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,6 +1,6 @@
;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2013 Free Software
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -29,10 +29,6 @@
(eval '(run-hooks 'gnus-load-hook))
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'wid-edit)
(require 'mm-util)
@@ -308,15 +304,6 @@ be set in `.emacs' instead."
:type 'boolean)
(unless (featurep 'gnus-xmas)
- (defalias 'gnus-make-overlay 'make-overlay)
- (defalias 'gnus-delete-overlay 'delete-overlay)
- (defalias 'gnus-overlay-get 'overlay-get)
- (defalias 'gnus-overlay-put 'overlay-put)
- (defalias 'gnus-move-overlay 'move-overlay)
- (defalias 'gnus-overlay-buffer 'overlay-buffer)
- (defalias 'gnus-overlay-start 'overlay-start)
- (defalias 'gnus-overlay-end 'overlay-end)
- (defalias 'gnus-overlays-in 'overlays-in)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
@@ -328,8 +315,9 @@ be set in `.emacs' instead."
(if (fboundp 'find-image)
(defun gnus-mode-line-buffer-identification (line)
(let ((str (car-safe line))
- (load-path (mm-image-load-path)))
- (if (and (stringp str)
+ (load-path (append (mm-image-load-path) load-path)))
+ (if (and (display-graphic-p)
+ (stringp str)
(string-match "^Gnus:" str))
(progn (add-text-properties
0 5
@@ -1320,11 +1308,11 @@ news is to be fetched, the second is the address.
For instance, if you want to get your news via \"flab.flab.edu\" using
NNTP, you could say:
-\(setq gnus-select-method '(nntp \"flab.flab.edu\"))
+\(setq gnus-select-method \\='(nntp \"flab.flab.edu\"))
If you want to use your local spool, say:
-\(setq gnus-select-method (list 'nnspool (system-name)))
+\(setq gnus-select-method (list \\='nnspool (system-name)))
If you use this variable, you must set `gnus-nntp-server' to nil.
@@ -1373,8 +1361,8 @@ group (or nil) as a parameter.
If you want to save your mail in one group and the news articles you
write in another group, you could say something like:
- \(setq gnus-message-archive-group
- '((if (message-news-p)
+ (setq gnus-message-archive-group
+ \\='((if (message-news-p)
\"misc-news\"
\"misc-mail\")))
@@ -1409,7 +1397,7 @@ This is a list where each element is a complete select method (see
If, for instance, you want to read your mail with the nnml back end,
you could set this variable:
-\(setq gnus-secondary-select-methods '((nnml \"\")))"
+\(setq gnus-secondary-select-methods \\='((nnml \"\")))"
:group 'gnus-server
:type '(repeat gnus-select-method))
@@ -1614,7 +1602,7 @@ slower."
:type 'string)
(defcustom gnus-valid-select-methods
- '(("nntp" post address prompt-address physical-address)
+ '(("nntp" post address prompt-address physical-address cloud)
("nnspool" post address)
("nnvirtual" post-mail virtual prompt-address)
("nnmbox" mail respool address)
@@ -1631,7 +1619,7 @@ slower."
("nnrss" none global)
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address respool
- server-marks)
+ server-marks cloud)
("nnmaildir" mail respool address server-marks)
("nnnil" none))
"*An alist of valid select methods.
@@ -2408,7 +2396,7 @@ less space and be faster as a result.
This variable can also be a list of visual elements to switch on. For
instance, to switch off all visual things except menus, you can say:
- (setq gnus-visual '(menu))
+ (setq gnus-visual \\='(menu))
Valid elements include `summary-highlight', `group-highlight',
`article-highlight', `mouse-face', `summary-menu', `group-menu',
@@ -2529,10 +2517,10 @@ This should be an alist for Emacs, or a plist for XEmacs."
"Which information should be exposed in the User-Agent header.
Can be a list of symbols or a string. Valid symbols are `gnus'
-\(show Gnus version\) and `emacs' \(show Emacs version\). In
+\(show Gnus version) and `emacs' \(show Emacs version). In
addition to the Emacs version, you can add `codename' \(show
-\(S\)XEmacs codename\) or either `config' \(show system
-configuration\) or `type' \(show system type\). If you set it to
+\(S)XEmacs codename) or either `config' \(show system
+configuration) or `type' \(show system type). If you set it to
a string, be sure to use a valid format, see RFC 2616."
:version "22.1"
@@ -2688,7 +2676,6 @@ such as a mark that says whether an article is stored in the cache
(gnus-tree-mode "(gnus)Tree Display"))
"Alist of major modes and related Info nodes.")
-(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
(defvar gnus-article-buffer "*Article*")
(defvar gnus-server-buffer "*Server*")
@@ -2704,7 +2691,10 @@ such as a mark that says whether an article is stored in the cache
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist)
+ gnus-topic-topology gnus-topic-alist
+ gnus-cloud-sequence
+ gnus-cloud-covered-servers
+ gnus-cloud-file-timestamps)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
@@ -3035,7 +3025,7 @@ See Info node `(gnus)Formatting Variables'."
(defun gnus-suppress-keymap (keymap)
(suppress-keymap keymap)
- (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
(while keys
(define-key keymap (pop keys) 'undefined))))
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el
index 985ed2c7b0d..fc536495a0b 100644
--- a/lisp/gnus/gravatar.el
+++ b/lisp/gnus/gravatar.el
@@ -1,6 +1,6 @@
;;; gravatar.el --- Get Gravatars
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: news
@@ -33,19 +33,25 @@
:group 'comm)
(defcustom gravatar-automatic-caching t
- "Whether cache retrieved gravatar."
+ "Whether to cache retrieved gravatars."
+ :type 'boolean
:group 'gravatar)
+;; FIXME a time value is not the nicest format for a custom variable.
(defcustom gravatar-cache-ttl (days-to-time 30)
"Time to live for gravatar cache entries."
+ :type '(repeat integer)
:group 'gravatar)
+;; FIXME Doc is tautological. What are the options?
(defcustom gravatar-rating "g"
"Default rating for gravatar."
+ :type 'string
:group 'gravatar)
(defcustom gravatar-size 32
"Default size in pixels for gravatars."
+ :type 'integer
:group 'gravatar)
(defconst gravatar-base-url
@@ -132,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS."
"Retrieve MAIL-ADDRESS gravatar and returns it."
(let ((url (gravatar-build-url mail-address)))
(if (gravatar-cache-expired url)
- (with-current-buffer (if (featurep 'xemacs)
- (url-retrieve url)
- (url-retrieve-synchronously url))
+ (with-current-buffer (url-retrieve-synchronously url)
(when gravatar-automatic-caching
(url-store-in-cache (current-buffer)))
(let ((data (gravatar-data->image)))
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index b5c99098b37..d6893dcf4b8 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -1,6 +1,6 @@
;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
index 68e75196c87..aef80636841 100644
--- a/lisp/gnus/html2text.el
+++ b/lisp/gnus/html2text.el
@@ -1,6 +1,6 @@
;;; html2text.el --- a simple html to plain text converter -*- coding: utf-8 -*-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Joakim Hove <hove@phys.ntnu.no>
@@ -179,72 +179,20 @@ formatting, and then moved afterward.")
(defun html2text-get-attr (p1 p2)
(goto-char p1)
- (re-search-forward " +[^ ]" p2 t)
- (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
- (tmp-list (split-string attr-string))
- (attr-list)
- (counter 0)
- (prev (car tmp-list))
- (this (nth 1 tmp-list))
- (next (nth 2 tmp-list))
- (index 1))
-
- (cond
- ;; size=3
- ((string-match "[^ ]=[^ ]" prev)
- (let ((attr (nth 0 (split-string prev "=")))
- (value (substring prev (1+ (string-match "=" prev)))))
- (setq attr-list (cons (list attr value) attr-list))))
- ;; size= 3
- ((string-match "[^ ]=\\'" prev)
- (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
-
- (while (< index (length tmp-list))
- (cond
- ;; size=3
- ((string-match "[^ ]=[^ ]" this)
- (let ((attr (nth 0 (split-string this "=")))
- (value (substring prev (1+ (string-match "=" this)))))
- (setq attr-list (cons (list attr value) attr-list))))
- ;; size =3
- ((string-match "\\`=[^ ]" this)
- (setq attr-list (cons (list prev (substring this 1)) attr-list)))
- ;; size= 3
- ((string-match "[^ ]=\\'" this)
- (setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
- ;; size = 3
- ((string= "=" this)
- (setq attr-list (cons (list prev next) attr-list))))
- (setq index (1+ index))
- (setq prev this)
- (setq this next)
- (setq next (nth (1+ index) tmp-list)))
- ;;
- ;; Tags with no accompanying "=" i.e. value=nil
- ;;
- (setq prev (car tmp-list))
- (setq this (nth 1 tmp-list))
- (setq next (nth 2 tmp-list))
- (setq index 1)
-
- (when (and (not (string-match "=" prev))
- (not (string= (substring this 0 1) "=")))
- (setq attr-list (cons (list prev nil) attr-list)))
- (while (< index (1- (length tmp-list)))
- (when (and (not (string-match "=" this))
- (not (or (string= (substring next 0 1) "=")
- (string= (substring prev -1) "="))))
- (setq attr-list (cons (list this nil) attr-list)))
- (setq index (1+ index))
- (setq prev this)
- (setq this next)
- (setq next (nth (1+ index) tmp-list)))
-
- (when (and this
- (not (string-match "=" this))
- (not (string= (substring prev -1) "=")))
- (setq attr-list (cons (list this nil) attr-list)))
- ;; return - value
+ (re-search-forward "\\s-+" p2 t)
+ (let (attr-list)
+ (while (re-search-forward "[-a-z0-9._]+" p2 t)
+ (setq attr-list
+ (cons
+ (list (match-string 0)
+ (when (looking-at "\\s-*=")
+ (goto-char (match-end 0))
+ (skip-chars-forward "[:space:]")
+ (when (or (looking-at "\"[^\"]*\"\\|'[^']*'")
+ (looking-at "[-a-z0-9._:]+"))
+ (goto-char (match-end 0))
+ (match-string 0))))
+ attr-list)))
attr-list))
;;
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el
index ff2222a6075..e681ecfb3d6 100644
--- a/lisp/gnus/ietf-drums.el
+++ b/lisp/gnus/ietf-drums.el
@@ -1,6 +1,6 @@
;;; ietf-drums.el --- Functions for parsing RFC822bis headers
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -206,7 +206,6 @@ backslash and doublequote.")
(1+ (point))
(progn (forward-sexp 1) (1- (point))))))))
(t
- (message "Unknown symbol: %c" c)
(forward-char 1))))
;; If we found no display-name, then we look for comments.
(if display-name
@@ -214,7 +213,8 @@ backslash and doublequote.")
(mapconcat 'identity (reverse display-name) " "))
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
- (when (string-match "@" display-string)
+ (when (and display-string
+ (string-match "@" display-string))
(cons
(mapconcat 'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 762574e7ec2..ed66fec3ac5 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -1,6 +1,6 @@
;;; gnus-agent.el --- Legacy unplugged support for Gnus
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
;; Keywords: news
@@ -147,14 +147,19 @@ converted to the compressed format."
(insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ")
(gnus-pp gnus-agent-expire-days)
- (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
+ (insert
+ (gnus-format-message
+ "\nIn order to use version `%s' of gnus, you will need to set\n"
+ converting-to))
(insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
(insert "expiration days to individual groups, you must instead set the\n")
- (insert "'agent-days-until-old group and/or topic parameter.\n")
+ (insert (gnus-format-message
+ "`agent-days-until-old' group and/or topic parameter.\n"))
(insert "\n")
(insert "If you would like, gnus can iterate over every group comparing its name to the\n")
(insert "regular expressions that you currently have in gnus-agent-expire-days. When\n")
- (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
+ (insert (gnus-format-message
+ "gnus finds a match, it will update that group's `agent-days-until-old' group\n"))
(insert "parameter to the value associated with the regular expression.\n")
(insert "\n")
(insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index fd3b43f7965..8f47604e732 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -1,6 +1,6 @@
;;; mail-parse.el --- Interface functions for parsing mail
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mail-prsvr.el b/lisp/gnus/mail-prsvr.el
index a474654e76f..25a272b854e 100644
--- a/lisp/gnus/mail-prsvr.el
+++ b/lisp/gnus/mail-prsvr.el
@@ -1,6 +1,6 @@
;;; mail-prsvr.el --- Interface variables for parsing mail
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 7da2a0a441d..cf18fbea17d 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -1,6 +1,6 @@
;;; mail-source.el --- functions for fetching mail
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'format-spec)
(eval-when-compile
(require 'cl)
@@ -616,7 +612,7 @@ If CONFIRM is non-nil, ask for confirmation before removing a file."
(when (and (> (- currday fileday) diff)
(if confirm
(y-or-n-p
- (format "\
+ (gnus-format-message "\
Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile))
(gnus-message 8 "\
Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
@@ -754,13 +750,16 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(setq script (substring script 0 (match-beginning 0))
background 0))
(setq result
- (call-process shell-file-name nil background nil
+ (call-process shell-file-name nil stderr nil
shell-command-switch script))
- (when (and result
- (not (zerop result)))
- (set-buffer stderr)
- (message "Mail source error: %s" (buffer-string)))
- (kill-buffer stderr)))
+ (if (and result
+ (not (zerop result)))
+ (progn
+ (split-window-vertically)
+ (other-window 1)
+ (switch-to-buffer stderr)
+ (message "Mail source error: %s " (buffer-string)))
+ (kill-buffer stderr))))
;;;
;;; Different fetchers
@@ -935,7 +934,7 @@ authentication. To do that, you need to set the
`message-send-mail-function' variable as `message-smtpmail-send-it'
and put the following line in your ~/.gnus.el file:
-\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
+\(add-hook \\='message-send-mail-hook \\='mail-source-touch-pop)
See the Gnus manual for details."
(let ((sources (if mail-source-primary-source
@@ -1091,10 +1090,13 @@ This only works when `display-time' is enabled."
(if (and (imap-open server port stream authentication buf)
(imap-authenticate
user (or (cdr (assoc from mail-source-password-cache))
- password) buf)
- (imap-mailbox-select mailbox nil buf))
+ password) buf))
+ (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox))))
+ (dolist (mailbox mailbox-list)
+ (when (imap-mailbox-select mailbox nil buf)
(let ((coding-system-for-write mail-source-imap-file-coding-system)
str)
+ (message "Fetching from %s..." mailbox)
(with-temp-file mail-source-crash-box
;; Avoid converting 8-bit chars from inserted strings to
;; multibyte.
@@ -1129,8 +1131,8 @@ This only works when `display-time' is enabled."
fetchflag nil buf))
(if dontexpunge
(imap-mailbox-unselect buf)
- (imap-mailbox-close nil buf))
- (imap-close buf))
+ (imap-mailbox-close nil buf)))))
+ (imap-close buf))
(imap-close buf)
;; We nix out the password in case the error
;; was because of a wrong password being given.
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 0e55e003de9..11a071b2542 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -1,6 +1,6 @@
;;; mailcap.el --- MIME media types configuration
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -96,11 +96,9 @@ This is a compatibility function for different Emacsen."
(type . "application/vnd.ms-excel"))
("x-x509-ca-cert"
(viewer . ssl-view-site-cert)
- (test . (fboundp 'ssl-view-site-cert))
(type . "application/x-x509-ca-cert"))
("x-x509-user-cert"
(viewer . ssl-view-user-cert)
- (test . (fboundp 'ssl-view-user-cert))
(type . "application/x-x509-user-cert"))
("octet-stream"
(viewer . mailcap-save-binary-file)
@@ -129,23 +127,18 @@ This is a compatibility function for different Emacsen."
(type . "application/x-tar"))
("x-latex"
(viewer . tex-mode)
- (test . (fboundp 'tex-mode))
(type . "application/x-latex"))
("x-tex"
(viewer . tex-mode)
- (test . (fboundp 'tex-mode))
(type . "application/x-tex"))
("latex"
(viewer . tex-mode)
- (test . (fboundp 'tex-mode))
(type . "application/latex"))
("tex"
(viewer . tex-mode)
- (test . (fboundp 'tex-mode))
(type . "application/tex"))
("texinfo"
(viewer . texinfo-mode)
- (test . (fboundp 'texinfo-mode))
(type . "application/tex"))
("zip"
(viewer . mailcap-save-binary-file)
@@ -153,6 +146,14 @@ This is a compatibility function for different Emacsen."
(type . "application/zip")
("copiousoutput"))
("pdf"
+ (viewer . pdf-view-mode)
+ (type . "application/pdf")
+ (test . (eq window-system 'x)))
+ ("pdf"
+ (viewer . doc-view-mode)
+ (type . "application/pdf")
+ (test . (eq window-system 'x)))
+ ("pdf"
(viewer . "gv -safer %s")
(type . "application/pdf")
(test . window-system)
@@ -192,7 +193,6 @@ This is a compatibility function for different Emacsen."
("copiousoutput"))
("sieve"
(viewer . sieve-mode)
- (test . (fboundp 'sieve-mode))
(type . "application/sieve"))
("pgp-keys"
(viewer . "gpg --import --interactive --verbose")
@@ -213,11 +213,6 @@ This is a compatibility function for different Emacsen."
(type . "message/rfc822"))
("rfc-*822"
(viewer . vm-mode)
- (test . (fboundp 'vm-mode))
- (type . "message/rfc822"))
- ("rfc-*822"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
(type . "message/rfc822"))
("rfc-*822"
(viewer . view-mode)
@@ -253,27 +248,16 @@ This is a compatibility function for different Emacsen."
("needsx11")))
("text"
("plain"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "text/plain"))
- ("plain"
(viewer . view-mode)
- (test . (fboundp 'view-mode))
(type . "text/plain"))
("plain"
(viewer . fundamental-mode)
(type . "text/plain"))
("enriched"
(viewer . enriched-decode)
- (test . (fboundp 'enriched-decode))
(type . "text/enriched"))
- ("html"
- (viewer . mm-w3-prepare-buffer)
- (test . (fboundp 'w3-prepare-buffer))
- (type . "text/html"))
("dns"
(viewer . dns-mode)
- (test . (fboundp 'dns-mode))
(type . "text/dns")))
("video"
("mpeg"
@@ -290,8 +274,7 @@ This is a compatibility function for different Emacsen."
("archive"
("tar"
(viewer . tar-mode)
- (type . "archive/tar")
- (test . (fboundp 'tar-mode)))))
+ (type . "archive/tar"))))
"The mailcap structure is an assoc list of assoc lists.
1st assoc list is keyed on the major content-type
2nd assoc list is keyed on the minor content-type (which can be a regexp)
@@ -312,9 +295,9 @@ attribute name (viewer, test, etc). This looks like:
FLAG)
Where VIEWERINFO specifies how the content-type is viewed. Can be
-a string, in which case it is run through a shell, with
-appropriate parameters, or a symbol, in which case the symbol is
-`funcall'ed, with the buffer as an argument.
+a string, in which case it is run through a shell, with appropriate
+parameters, or a symbol, in which case the symbol is `funcall'ed if
+and only if it exists as a function, with the buffer as an argument.
TESTINFO is a test for the viewer's applicability, or nil. If nil, it
means the viewer is always valid. If it is a Lisp function, it is
@@ -558,8 +541,11 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
results)))
(defun mailcap-mailcap-entry-passes-test (info)
- "Return non-nil if mailcap entry INFO passes its test clause.
-Also return non-nil if no test clause is present."
+ "Replace the test clause of INFO itself with a boolean for some cases.
+This function supports only `test -n $DISPLAY' and `test -z $DISPLAY',
+replaces them with t or nil. As for others or if INFO has a interactive
+spec (needsterm, needsterminal, or needsx11) but DISPLAY is not set,
+the test clause will be unchanged."
(let ((test (assq 'test info)) ; The test clause
status)
(setq status (and test (split-string (cdr test) " ")))
@@ -657,10 +643,12 @@ to supply to the test."
(let* ((test-info (assq 'test viewer-info))
(test (cdr test-info))
(otest test)
- (viewer (cdr (assoc 'viewer viewer-info)))
+ (viewer (cdr (assq 'viewer viewer-info)))
(default-directory (expand-file-name "~/"))
status parsed-test cache result)
- (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+ (cond ((not (or (stringp viewer) (fboundp viewer)))
+ nil) ; Non-existent Lisp function
+ ((setq cache (assoc test mailcap-viewer-test-cache))
(cadr cache))
((not test-info) t) ; No test clause
(t
@@ -1072,6 +1060,18 @@ If FORCE, re-parse even if already parsed."
common-mime-info)))))
commands))
+(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."
+ (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)
+ (funcall method))))
+
(provide 'mailcap)
;;; mailcap.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index d6d6b3f8bed..1b693d77983 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1,6 +1,6 @@
;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
@@ -28,9 +28,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
@@ -50,6 +47,7 @@
(require 'mml)
(require 'rfc822)
(require 'format-spec)
+(require 'dired)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
@@ -369,7 +367,7 @@ few false positives here."
(defcustom message-archive-header "X-No-Archive: Yes\n"
"Header to insert when you don't want your article to be archived.
-Archives \(such as groups.google.com\) respect this header."
+Archives \(such as groups.google.com) respect this header."
:version "22.1"
:type 'string
:link '(custom-manual "(message)Header Commands")
@@ -543,7 +541,7 @@ The provided functions are:
newsgroup), in brackets followed by the subject
* `message-forward-subject-name-subject' Source of article (name of author
or newsgroup), in brackets followed by the subject
-* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
+* `message-forward-subject-fwd' Subject of article with `Fwd:' prepended
to it."
:group 'message-forwarding
:link '(custom-manual "(message)Forwarding")
@@ -606,7 +604,8 @@ Done before generating the new subject of a forward."
regexp))
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
- "*All headers that match this regexp will be deleted when forwarding a message."
+ "*All headers that match this regexp will be deleted when forwarding a message.
+This may also be a list of regexps."
:version "21.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
@@ -616,6 +615,19 @@ Done before generating the new subject of a forward."
(widget-editable-list-match widget value)))
regexp))
+(defcustom message-forward-included-headers nil
+ "If non-nil, delete non-matching headers when forwarding a message.
+Only headers that match this regexp will be included. This
+variable should be a regexp or a list of regexps."
+ :version "25.1"
+ :group 'message-forwarding
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
@@ -944,6 +956,8 @@ the signature is inserted."
(set-keymap-parent map minibuffer-local-map)
map)
"Keymap for `message-read-from-minibuffer'."
+ ;; FIXME improve type.
+ :type '(restricted-sexp :match-alternatives (symbolp keymapp))
:version "22.1"
:group 'message-various)
@@ -968,20 +982,24 @@ configuration. See the variable `gnus-cite-attribution-suffix'."
(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
"Format of the \"Whomever writes:\" line.
-The string is formatted using `format-spec'. The following
-constructs are replaced:
+The string is formatted using `format-spec'. The following constructs
+are replaced:
%f The full From, e.g. \"John Doe <john.doe@example.invalid>\".
%n The mail address, e.g. \"john.doe@example.invalid\".
%N The real name if present, e.g.: \"John Doe\", else fall
back to the mail address.
- %F The first name if present, e.g.: \"John\".
+ %F The first name if present, e.g.: \"John\", else fall
+ back to the mail address.
%L The last name if present, e.g.: \"Doe\".
+ %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
All other format specifiers are passed to `format-time-string'
-which is called using the date from the article your replying to.
-Extracting the first (%F) and last name (%L) is done
-heuristically, so you should always check it yourself.
+which is called using the date from the article your replying to, but
+the date in the formatted string will be expressed in the author's
+time zone as much as possible.
+Extracting the first (%F) and last name (%L) is done heuristically,
+so you should always check it yourself.
Please also read the note in the documentation of
`message-citation-line-function'."
@@ -1105,7 +1123,7 @@ e.g. using `gnus-posting-styles':
(defcustom message-cite-style nil
"*The overall style to be used when yanking cited text.
-Value is either `nil' (no variable overrides) or a let-style list
+Value is either nil (no variable overrides) or a let-style list
of pairs (VARIABLE VALUE) that will be bound in
`message-yank-original' to do the quoting.
@@ -1113,7 +1131,7 @@ Presets to impersonate popular mail agents are found in the
message-cite-style-* variables. This variable is intended for
use in `gnus-posting-styles', such as:
- ((posting-from-work-p) (eval (set (make-local-variable 'message-cite-style) message-cite-style-outlook)))"
+ ((posting-from-work-p) (eval (set (make-local-variable \\='message-cite-style) message-cite-style-outlook)))"
:version "24.1"
:group 'message-insertion
:type '(choice (const :tag "Do not override variables" :value nil)
@@ -1182,7 +1200,7 @@ If stringp, use this; if non-nil, use no host name (user name only)."
(defvar message-reply-headers nil
"The headers of the current replied article.
It is a vector of the following headers:
-\[number subject from date id references chars lines xref extra].")
+[number subject from date id references chars lines xref extra].")
(defvar message-newsreader nil)
(defvar message-mailer nil)
(defvar message-sent-message-via nil)
@@ -1285,7 +1303,7 @@ actually occur."
"Alist of ways to send outgoing messages.
Each element has the form
- \(TYPE PREDICATE FUNCTION)
+ (TYPE PREDICATE FUNCTION)
where TYPE is a symbol that names the method; PREDICATE is a function
called without any parameters to determine whether the message is
@@ -1739,13 +1757,20 @@ no, only reply back to the author."
:type '(radio (const :format "%v " nil)
(string :format "FQDN: %v")))
-(defcustom message-use-idna (and (condition-case nil (require 'idna)
- (file-error))
- (mm-coding-system-p 'utf-8)
- (executable-find idna-program)
- (string= (idna-to-ascii "räksmörgås")
- "xn--rksmrgs-5wao1o")
- t)
+(defcustom message-use-idna
+ (and (or (mm-coding-system-p 'utf-8)
+ (condition-case nil
+ (let (mucs-ignore-version-incompatibilities)
+ (require 'un-define))
+ (error)))
+ (condition-case nil
+ (require 'idna)
+ (file-error)
+ (invalid-operation))
+ idna-program
+ (executable-find idna-program)
+ (string= (idna-to-ascii "räksmörgås") "xn--rksmrgs-5wao1o")
+ t)
"Whether to encode non-ASCII in domain names into ASCII according to IDNA.
GNU Libidn, and in particular the elisp package \"idna.el\" and
the external program \"idn\", must be installed for this
@@ -1902,14 +1927,52 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
"cat\\|com\\|coop\\|edu\\|gov\\|"
"info\\|int\\|jobs\\|"
"mil\\|mobi\\|museum\\|name\\|net\\|"
- "org\\|pro\\|tel\\|travel\\|uucp\\)")
+ "org\\|pro\\|tel\\|travel\\|uucp\\|"
+ ;; ICANN-era generic top-level domains
+ "academy\\|actor\\|agency\\|airforce\\|archi\\|associates\\|axa\\|"
+ "bar\\|bargains\\|bayern\\|beer\\|berlin\\|best\\|bid\\|bike\\|"
+ "biz\\|black\\|blackfriday\\|blue\\|boutique\\|build\\|builders\\|"
+ "buzz\\|cab\\|camera\\|camp\\|capital\\|cards\\|care\\|career\\|"
+ "careers\\|cash\\|catering\\|center\\|ceo\\|cheap\\|christmas\\|"
+ "church\\|citic\\|cleaning\\|clinic\\|clothing\\|club\\|codes\\|"
+ "coffee\\|college\\|cologne\\|com\\|community\\|company\\|computer\\|"
+ "construction\\|contractors\\|cooking\\|cool\\|country\\|creditcard\\|"
+ "cruises\\|dance\\|dating\\|democrat\\|dental\\|desi\\|design\\|"
+ "diamonds\\|directory\\|discount\\|domains\\|education\\|email\\|"
+ "engineering\\|enterprises\\|equipment\\|estate\\|eus\\|events\\|"
+ "exchange\\|expert\\|exposed\\|fail\\|farm\\|feedback\\|finance\\|"
+ "financial\\|fish\\|fishing\\|fitness\\|flights\\|florist\\|foo\\|"
+ "foundation\\|frogans\\|fund\\|furniture\\|futbol\\|gal\\|"
+ "gallery\\|gift\\|glass\\|globo\\|gmo\\|gop\\|graphics\\|gratis\\|"
+ "gripe\\|guide\\|guitars\\|guru\\|hamburg\\|haus\\|hiphop\\|"
+ "holdings\\|holiday\\|homes\\|horse\\|house\\|immobilien\\|"
+ "industries\\|info\\|ink\\|institute\\|insure\\|international\\|"
+ "investments\\|jetzt\\|juegos\\|kaufen\\|kim\\|kitchen\\|kiwi\\|"
+ "koeln\\|kred\\|land\\|lat\\|latino\\|lease\\|life\\|lighting\\|"
+ "limited\\|limo\\|link\\|loans\\|london\\|luxe\\|luxury\\|"
+ "management\\|mango\\|marketing\\|media\\|meet\\|menu\\|miami\\|"
+ "moda\\|moe\\|monash\\|moscow\\|motorcycles\\|nagoya\\|name\\|"
+ "net\\|neustar\\|ninja\\|nyc\\|okinawa\\|onl\\|org\\|paris\\|"
+ "partners\\|parts\\|photo\\|photography\\|photos\\|pics\\|"
+ "pictures\\|pink\\|plumbing\\|pro\\|productions\\|properties\\|"
+ "pub\\|qpon\\|quebec\\|recipes\\|red\\|reisen\\|ren\\|rentals\\|"
+ "repair\\|report\\|rest\\|reviews\\|rich\\|rocks\\|rodeo\\|"
+ "ruhr\\|ryukyu\\|saarland\\|schule\\|scot\\|services\\|sexy\\|"
+ "shiksha\\|shoes\\|singles\\|social\\|sohu\\|solar\\|solutions\\|"
+ "soy\\|supplies\\|supply\\|support\\|surgery\\|systems\\|tattoo\\|"
+ "tax\\|technology\\|tienda\\|tips\\|today\\|tokyo\\|tools\\|"
+ "town\\|toys\\|trade\\|training\\|university\\|uno\\|vacations\\|"
+ "vegas\\|ventures\\|viajes\\|villas\\|vision\\|vodka\\|vote\\|"
+ "voting\\|voto\\|voyage\\|wang\\|watch\\|webcam\\|wed\\|wien\\|"
+ "wiki\\|works\\|wtc\\|wtf\\|xyz\\|yachts\\|yokohama\\|you\\|"
+ "zone\\)")
;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
;; http://en.wikipedia.org/wiki/GTLD
;; `approved, but not yet in operation': .xxx
;; "dead" nato bitnet uucp
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
- :version "22.1"
+ :version "25.1"
:group 'message-headers
:type 'regexp)
@@ -1942,6 +2005,17 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(unless (fboundp 'mail-dont-reply-to)
(defalias 'mail-dont-reply-to 'rmail-dont-reply-to))
+(eval-and-compile
+ (if (featurep 'emacs)
+ (progn
+ (defun message-kill-all-overlays ()
+ (mapcar #'delete-overlay (overlays-in (point-min) (point-max))))
+ (defalias 'message-window-inside-pixel-edges
+ 'window-inside-pixel-edges))
+ (defun message-kill-all-overlays ()
+ (map-extents (lambda (extent ignore) (delete-extent extent))))
+ (defalias 'message-window-inside-pixel-edges 'ignore)))
+
;;;
@@ -2161,7 +2235,7 @@ contains a valid encoded word. Decode again? "
(unless cs-coding
(setq cs-coding
(mm-read-coding-system
- (format "\
+ (gnus-format-message "\
Decoded Subject \"%s\"
contains an encoded word. The charset `%s' is unknown or invalid.
Hit RET to replace non-decodable characters with \"%s\" or enter replacement
@@ -2247,7 +2321,7 @@ Leading \"Re: \" is not stripped by this function. Use the function
((not (string-match
(concat "^[ \t]*"
(regexp-quote new-subject)
- " \t]*$")
+ "[ \t]*$")
old-subject)) ; yes, it really is a new subject
;; delete eventual Re: prefix
(setq old-subject
@@ -2449,6 +2523,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.
+If REVERSE, remove headers that doesn't match HEADER.
Return the number of headers removed."
(goto-char (point-min))
(let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
@@ -2900,6 +2975,30 @@ See also `message-forbidden-properties'."
(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
+(defvar message-smileys '(":-)" ":)"
+ ":-(" ":("
+ ";-)" ";)")
+ "A list of recognized smiley faces in `message-mode'.")
+
+(defun message--syntax-propertize (beg end)
+ "Syntax-propertize certain message text specially."
+ (let ((citation-regexp (concat "^" message-cite-prefix-regexp ".*$"))
+ (smiley-regexp (regexp-opt message-smileys)))
+ (goto-char beg)
+ (while (search-forward-regexp citation-regexp
+ end 'noerror)
+ (let ((start (match-beginning 0))
+ (end (match-end 0)))
+ (add-text-properties start (1+ start)
+ `(syntax-table ,(string-to-syntax "<")))
+ (add-text-properties end (min (1+ end) (point-max))
+ `(syntax-table ,(string-to-syntax ">")))))
+ (goto-char beg)
+ (while (search-forward-regexp smiley-regexp
+ end 'noerror)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ `(syntax-table ,(string-to-syntax "."))))))
+
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
@@ -3002,7 +3101,13 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
;; multibyte is not necessary at all. -- zsh
(mm-enable-multibyte))
(set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
- (mml-mode))
+ (mml-mode)
+ ;; Syntactic fontification. Helps `show-paren-mode',
+ ;; `electric-pair-mode', and C-M-* navigation by syntactically
+ ;; excluding citations and other artifacts.
+ ;;
+ (set (make-local-variable 'syntax-propertize-function) 'message--syntax-propertize)
+ (set (make-local-variable 'parse-sexp-ignore-comments) t))
(defun message-setup-fill-variables ()
"Setup message fill variables."
@@ -3513,15 +3618,16 @@ Message buffers and is not meant to be called directly."
(goto-char (point-max))
;; Insert the signature.
(unless (bolp)
- (insert "\n"))
+ (newline))
(when message-signature-insert-empty-line
- (insert "\n"))
- (insert "-- \n")
+ (newline))
+ (insert "-- ")
+ (newline)
(if (eq signature t)
(insert-file-contents signature-file)
(insert signature))
(goto-char (point-max))
- (or (bolp) (insert "\n")))))
+ (or (bolp) (newline)))))
(defun message-insert-importance-high ()
"Insert header to mark message as important."
@@ -3902,12 +4008,14 @@ This function uses `mail-citation-hook' if that is non-nil."
"Cite function in the standard Message manner."
(message-cite-original-1 nil))
-(defvar gnus-extract-address-components)
-
(autoload 'format-spec "format-spec")
+(autoload 'gnus-date-get-time "gnus-util")
-(defun message-insert-formatted-citation-line (&optional from date)
+(defun message-insert-formatted-citation-line (&optional from date tz)
"Function that inserts a formatted citation line.
+The optional FROM, and DATE are strings containing the contents of
+the From header and the Date header respectively. The optional TZ
+is a number of seconds, overrides the time zone of DATE.
See `message-citation-line-format'."
;; The optional args are for testing/debugging. They will disappear later.
@@ -3915,13 +4023,13 @@ See `message-citation-line-format'."
;; (with-temp-buffer
;; (message-insert-formatted-citation-line
;; "John Doe <john.doe@example.invalid>"
- ;; (current-time))
+ ;; (message-make-date))
;; (buffer-string))
(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)
+ (funcall (if (boundp 'gnus-extract-address-components)
gnus-extract-address-components
'mail-extract-address-components)
from)
@@ -3932,34 +4040,49 @@ See `message-citation-line-format'."
(net (car (cdr data)))
(name-or-net (or (car data)
(car (cdr data)) from))
- (replydate
- (or
- date
- ;; We need Gnus functionality if the user wants date or time from
- ;; the original article:
- (when (string-match "%[^fnNFL]" message-citation-line-format)
- (autoload 'gnus-date-get-time "gnus-util")
- (gnus-date-get-time (mail-header-date message-reply-headers)))))
+ (time
+ (when (string-match "%[^fnNFL]" message-citation-line-format)
+ (cond ((numberp (car-safe date)) date) ;; backward compatibility
+ (date (gnus-date-get-time date))
+ (t
+ (gnus-date-get-time
+ (setq date (mail-header-date message-reply-headers)))))))
+ (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) " "))) )
+ (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 fname 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)
@@ -3983,7 +4106,7 @@ See `message-citation-line-format'."
(>= i ?a)))
(push i lst)
(push (condition-case nil
- (format-time-string (format "%%%c" i) replydate)
+ (gmm-format-time-string (format "%%%c" i) time tz)
(error (format ">%c<" i)))
lst))
(setq i (1+ i)))
@@ -4097,11 +4220,12 @@ Instead, just auto-save the buffer and then bury it."
(defun message-bury (buffer)
"Bury this mail BUFFER."
+ ;; Note that this is not quite the same as (bury-buffer buffer),
+ ;; since bury-buffer does extra stuff with a nil argument.
+ ;; Eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00539.html
+ (with-current-buffer buffer (bury-buffer))
(if message-return-action
- (progn
- (bury-buffer buffer)
- (apply (car message-return-action) (cdr message-return-action)))
- (with-current-buffer buffer (bury-buffer))))
+ (apply (car message-return-action) (cdr message-return-action))))
(defun message-send (&optional arg)
"Send the message in the current buffer.
@@ -4267,8 +4391,7 @@ conformance."
to (cdar regions)
regions (cdr regions))
(put-text-property from to 'invisible nil)
- (message-overlay-put (message-make-overlay from to)
- 'face 'highlight))
+ (overlay-put (make-overlay from to) 'face 'highlight))
(unless (yes-or-no-p
"Invisible text found and made visible; continue sending? ")
(error "Invisible text found and made visible")))))
@@ -4295,8 +4418,7 @@ conformance."
control-1))
(not (get-text-property
(point) 'untranslated-utf-8))))
- (message-overlay-put (message-make-overlay (point) (1+ (point)))
- 'face 'highlight)
+ (overlay-put (make-overlay (point) (1+ (point))) 'face 'highlight)
(setq found t))
(forward-char))
(when found
@@ -4388,7 +4510,7 @@ This function could be useful in `message-setup-hook'."
(dolist (bog (message-bogus-recipient-p addr))
(and bog
(not (y-or-n-p
- (format
+ (gnus-format-message
"Address `%s'%s might be bogus. Continue? "
bog
;; If the encoded version of the email address
@@ -4739,7 +4861,9 @@ that instead."
(list resend-to-addresses)
'("-t"))))))
(unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
- (if errbuf (pop-to-buffer errbuf))
+ (when errbuf
+ (pop-to-buffer errbuf)
+ (setq errbuf nil))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
(with-current-buffer errbuf
@@ -4823,6 +4947,11 @@ evaluates `message-send-mail-hook' just before sending a message.
It is useful if your ISP requires the POP-before-SMTP
authentication. See the Gnus manual for details."
(run-hooks 'message-send-mail-hook)
+ ;; Change header-delimiter to be what smtpmail expects.
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n"))
(smtpmail-send-it))
(defun message-send-mail-with-mailclient ()
@@ -5509,7 +5638,7 @@ If NOW, use that time instead."
"Make date string for the Expires header. Expiry in DAYS days.
In posting styles use `(\"Expires\" (make-expires-date 30))'."
- (let* ((cur (decode-time (current-time)))
+ (let* ((cur (decode-time))
(nday (+ days (nth 3 cur))))
(setf (nth 3 cur) nday)
(message-make-date (apply 'encode-time cur))))
@@ -5766,7 +5895,7 @@ give as trustworthy answer as possible."
(defun message-make-fqdn ()
"Return user's fully qualified domain name."
- (let* ((system-name (system-name))
+ (let* ((sysname (system-name))
(user-mail (message-user-mail-address))
(user-domain
(if (and user-mail
@@ -5780,10 +5909,10 @@ give as trustworthy answer as possible."
(not (string-match message-bogus-system-names message-user-fqdn)))
;; `message-user-fqdn' seems to be valid
message-user-fqdn)
- ((and (string-match message-valid-fqdn-regexp system-name)
- (not (string-match message-bogus-system-names system-name)))
+ ((and (string-match message-valid-fqdn-regexp sysname)
+ (not (string-match message-bogus-system-names sysname)))
;; `system-name' returned the right result.
- system-name)
+ sysname)
;; Try `mail-host-address'.
((and (boundp 'mail-host-address)
(stringp mail-host-address)
@@ -5798,7 +5927,7 @@ give as trustworthy answer as possible."
user-domain)
;; Default to this bogus thing.
(t
- (concat system-name
+ (concat sysname
".i-did-not-set--mail-host-address--so-tickle-me")))))
(defun message-make-domain ()
@@ -6271,6 +6400,9 @@ they are."
:link '(custom-manual "(message)Movement")
:type 'boolean)
+(defvar visual-line-mode)
+(declare-function beginning-of-visual-line "simple" (&optional n))
+
(defun message-beginning-of-line (&optional n)
"Move point to beginning of header value or to beginning of line.
The prefix argument N is passed directly to `beginning-of-line'.
@@ -6297,7 +6429,9 @@ between beginning of field and beginning of line."
(goto-char
(if (and eoh (or (< eoh here) (= bol here)))
eoh bol)))
- (beginning-of-line n)))
+ (if (and (boundp 'visual-line-mode) visual-line-mode)
+ (beginning-of-visual-line n)
+ (beginning-of-line n))))
(defun message-buffer-name (type &optional to group)
"Return a new (unique) buffer name based on TYPE and TO."
@@ -7076,7 +7210,7 @@ want to get rid of this query permanently."))
(defun message-is-yours-p ()
"Non-nil means current article is yours.
-If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
+If you have added `cancel-messages' to `message-shoot-gnksa-feet', all articles
are yours except those that have Cancel-Lock header not belonging to you.
Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
regexp to match all of yours addresses."
@@ -7205,7 +7339,7 @@ header line with the old Message-ID."
(let ((buffer-read-only nil))
(erase-buffer)
(insert-file-contents file-name nil)))
- (t (error "message-recover cancelled")))))
+ (t (error "message-recover canceled")))))
;;; Washing Subject:
@@ -7364,17 +7498,25 @@ Optional DIGEST will use digest to forward."
(message-remove-ignored-headers b e)))
(defun message-remove-ignored-headers (b e)
- (when message-forward-ignored-headers
+ (when (or message-forward-ignored-headers
+ message-forward-included-headers)
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
- (let ((ignored (if (stringp message-forward-ignored-headers)
- (list message-forward-ignored-headers)
- message-forward-ignored-headers)))
- (dolist (elem ignored)
- (message-remove-header elem t))))))
+ (when message-forward-ignored-headers
+ (let ((ignored (if (stringp message-forward-ignored-headers)
+ (list message-forward-ignored-headers)
+ message-forward-ignored-headers)))
+ (dolist (elem ignored)
+ (message-remove-header elem t))))
+ (when message-forward-included-headers
+ (message-remove-header
+ (if (listp message-forward-included-headers)
+ (regexp-opt message-forward-included-headers)
+ message-forward-included-headers)
+ t nil t)))))
(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(let ((b (point)))
@@ -7422,8 +7564,7 @@ Optional DIGEST will use digest to forward."
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\n")
- (when (and (not message-forward-decoded-p)
- message-forward-ignored-headers)
+ (when (not message-forward-decoded-p)
(message-remove-ignored-headers b e))))
(defun message-forward-make-body-digest-plain (forward-buffer)
@@ -7753,14 +7894,6 @@ which specify the range to operate on."
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)))))
-(defalias 'message-make-overlay 'make-overlay)
-(defalias 'message-delete-overlay 'delete-overlay)
-(defalias 'message-overlay-put 'overlay-put)
-(defun message-kill-all-overlays ()
- (if (featurep 'xemacs)
- (map-extents (lambda (extent ignore) (delete-extent extent)))
- (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
-
;; Support for toolbar
(defvar tool-bar-mode)
@@ -7918,8 +8051,9 @@ If nil, the function bound in `text-mode-map' or `global-map' is executed."
(defun message-tab ()
"Complete names according to `message-completion-alist'.
-Execute function specified by `message-tab-body-function' when not in
-those headers."
+Execute function specified by `message-tab-body-function' when
+not in those headers. If that variable is nil, indent with the
+regular text mode tabbing command."
(interactive)
(cond
((if (and (boundp 'completion-fail-discreetly)
@@ -7947,17 +8081,6 @@ those headers."
;; falling back to message-tab-body-function.
(lambda () (funcall fun) 'completion-attempted)))))
-(eval-and-compile
- (condition-case nil
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (eval '(display-completion-list nil "")))
- (defalias 'message-display-completion-list 'display-completion-list))
- (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
- (defun message-display-completion-list (completions &optional ignore)
- "Display the list of completions, COMPLETIONS, using `standard-output'."
- (display-completion-list completions)))))
-
(defun message-expand-group ()
"Expand the group name under point."
(let ((b (save-excursion
@@ -7982,12 +8105,12 @@ those headers."
group)
collection))
gnus-active-hashtb))
- (message-completion-in-region e b collection)))
+ (message-completion-in-region b e collection)))
(defalias 'message-completion-in-region
(if (fboundp 'completion-in-region)
'completion-in-region
- (lambda (e b hashtb)
+ (lambda (b e hashtb)
(let* ((string (buffer-substring b e))
(completions (all-completions string hashtb))
comp)
@@ -8012,8 +8135,7 @@ those headers."
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (message-display-completion-list (sort completions 'string<)
- string))
+ (display-completion-list (sort completions 'string<)))
(setq buffer-read-only nil)
(goto-char (point-min))
(delete-region (point)
@@ -8055,7 +8177,7 @@ The following arguments may contain lists of values."
(defun message-flatten-list (list)
"Return a new, flat list that contains all elements of LIST.
-\(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
+\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7))
=> (1 2 3 4 5 6 7)"
(cond ((consp list)
(apply 'append (mapcar 'message-flatten-list list)))
@@ -8207,7 +8329,7 @@ From headers in the original article."
(list message-hidden-headers)
message-hidden-headers))
(inhibit-point-motion-hooks t)
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(end-of-headers (point-min)))
(when regexps
(save-excursion
@@ -8362,11 +8484,11 @@ Header and body are separated by `mail-header-separator'."
(when force
(sit-for message-send-form-letter-delay))
(if (or force
- (y-or-n-p (format "Send message to `%s'? " to)))
+ (y-or-n-p (gnus-format-message "Send message to `%s'? " to)))
(progn
(setq sent (1+ sent))
(message-send-and-exit))
- (message (format "Message to `%s' skipped." to))
+ (message "Message to `%s' skipped." to)
(setq skipped (1+ skipped)))
(when (buffer-live-p buff)
(kill-buffer buff))))
@@ -8422,6 +8544,47 @@ Used in `message-simplify-recipients'."
(message-fetch-field hdr) t))
", "))))
+;;; multipart/related and HTML support.
+
+(defun message-make-html-message-with-image-files (files)
+ "Make a message containing the current dired-marked image files."
+ (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+ (message-mail)
+ (message-goto-body)
+ (insert "<#part type=text/html>\n\n")
+ (dolist (file files)
+ (insert (format "<img src=%S>\n\n" file)))
+ (message-toggle-image-thumbnails)
+ (message-goto-to))
+
+(defun message-toggle-image-thumbnails ()
+ "For any included image files, insert a thumbnail of that image."
+ (interactive)
+ (let ((overlays (overlays-in (point-min) (point-max)))
+ (displayed nil))
+ (while overlays
+ (let ((overlay (car overlays)))
+ (when (overlay-get overlay 'put-image)
+ (delete-overlay overlay)
+ (setq displayed t)))
+ (setq overlays (cdr overlays)))
+ (unless displayed
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "<img.*src=\"\\([^\"]+\\)" nil t)
+ (let ((file (match-string 1))
+ (edges (message-window-inside-pixel-edges
+ (get-buffer-window (current-buffer)))))
+ (put-image
+ (create-image
+ file 'imagemagick nil
+ :max-width (truncate
+ (* 0.7 (- (nth 2 edges) (nth 0 edges))))
+ :max-height (truncate
+ (* 0.5 (- (nth 3 edges) (nth 1 edges)))))
+ (match-beginning 0)
+ " ")))))))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el
index 93b235ea8eb..3543ffe6df6 100644
--- a/lisp/gnus/messcompat.el
+++ b/lisp/gnus/messcompat.el
@@ -1,6 +1,6 @@
;;; messcompat.el --- making message mode compatible with mail mode
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 97da8823819..9c86c4ac4f3 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -1,6 +1,6 @@
;;; mm-archive.el --- Functions for parsing archive files as MIME
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -23,9 +23,8 @@
;;; Code:
(require 'mm-decode)
-(eval-when-compile
- (autoload 'gnus-recursive-directory-files "gnus-util")
- (autoload 'mailcap-extension-to-mime "mailcap"))
+(autoload 'gnus-recursive-directory-files "gnus-util")
+(autoload 'mailcap-extension-to-mime "mailcap")
(defvar mm-archive-decoders
'(("application/ms-tnef" t "tnef" "-f" "-" "-C")
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 06d5208e5e1..4a25c1486a8 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -1,6 +1,6 @@
;;; mm-bodies.el --- Functions for decoding MIME things
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mm-util)
(require 'rfc2047)
(require 'mm-encode)
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index dbbf0befe60..327b0e6e86f 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1,6 +1,6 @@
;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mail-parse)
(require 'mm-bodies)
(eval-when-compile (require 'cl))
@@ -124,7 +120,6 @@
((executable-find "w3m") 'gnus-w3m)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
- ((locate-library "w3") 'w3)
((locate-library "html2text") 'html2text)
(t nil))
"Render of HTML contents.
@@ -136,13 +131,11 @@ The defined renderer types are:
`w3m-standalone': use plain w3m;
`links': use links;
`lynx': use lynx;
-`w3': use Emacs/W3;
`html2text': use html2text;
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const shr)
(const gnus-w3m)
- (const w3)
(const w3m :tag "emacs-w3m")
(const w3m-standalone :tag "standalone w3m" )
(const links)
@@ -153,9 +146,9 @@ nil : use external viewer (default web browser)."
:group 'mime-display)
(defcustom mm-inline-text-html-with-images nil
- "If non-nil, Gnus will allow retrieving images in HTML contents with
-the <img> tags. It has no effect on Emacs/w3. See also the
-documentation for the `mm-w3m-safe-url-regexp' variable."
+ "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags.
+See also the documentation for the `mm-w3m-safe-url-regexp'
+variable."
:version "22.1"
:type 'boolean
:group 'mime-display)
@@ -538,14 +531,6 @@ result of the verification."
map)
"Keymap for input viewer with completion.")
-(defvar mm-viewer-completion-map
- (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
- (set-keymap-parent map minibuffer-local-completion-map)
- ;; Should we bind other key to minibuffer-complete-word?
- (define-key map " " 'self-insert-command)
- map)
- "Keymap for input viewer with completion.")
-
;;; The functions.
(defun mm-alist-to-plist (alist)
@@ -607,19 +592,19 @@ files left at the next time."
(split-string (buffer-string) "\n" t))))
fails)
(dolist (temp (append cache mm-temp-files-to-be-deleted))
- (unless (and (file-exists-p temp)
- (if (file-directory-p temp)
- ;; A parent directory left at the previous time.
+ (when (and (file-exists-p temp)
+ (if (file-directory-p temp)
+ ;; A parent directory left at the previous time.
+ (progn
+ (ignore-errors (delete-directory temp))
+ (file-exists-p temp))
+ ;; Delete a temporary file and its parent directory.
+ (ignore-errors (delete-file temp))
+ (or (file-exists-p temp)
(progn
+ (setq temp (file-name-directory temp))
(ignore-errors (delete-directory temp))
- (not (file-exists-p temp)))
- ;; Delete a temporary file and its parent directory.
- (ignore-errors (delete-file temp))
- (and (not (file-exists-p temp))
- (progn
- (setq temp (file-name-directory temp))
- (ignore-errors (delete-directory temp))
- (not (file-exists-p temp))))))
+ (file-exists-p temp)))))
(push temp fails)))
(if fails
;; Schedule the deletion of the files left at the next time.
@@ -662,7 +647,7 @@ MIME-Version header before proceeding."
(unless from
(setq from (mail-fetch-field "from")))
;; FIXME: In some circumstances, this code is running within
- ;; an unibyte macro. mail-extract-address-components
+ ;; a unibyte macro. mail-extract-address-components
;; creates unibyte buffers. This `if', though not a perfect
;; solution, avoids most of them.
(if from
@@ -672,9 +657,9 @@ MIME-Version header before proceeding."
description)))))
(if (or (not ctl)
(not (string-match "/" (car ctl))))
- (mm-dissect-singlepart
+ (mm-dissect-singlepart
(list mm-dissect-default-type)
- (and cte (intern (downcase (mail-header-strip cte))))
+ (and cte (intern (downcase (mail-header-strip cte))))
no-strict-mime
(and cd (mail-header-parse-content-disposition cd))
description)
@@ -803,6 +788,14 @@ MIME-Version header before proceeding."
(autoload 'mailcap-parse-mailcaps "mailcap")
(autoload 'mailcap-mime-info "mailcap")
+(defun mm-head-p (&optional point)
+ "Return non-nil if point is in the article header."
+ (let ((point (or point (point))))
+ (save-excursion
+ (goto-char point)
+ (and (not (re-search-backward "^$" nil t))
+ (re-search-forward "^$" nil t)))))
+
(defun mm-display-part (handle &optional no-default force)
"Display the MIME part represented by HANDLE.
Returns nil if the part is removed; inline if displayed inline;
@@ -836,7 +829,10 @@ external if displayed external."
'inline)
((and (mm-inlinable-p ehandle)
(mm-inlined-p ehandle))
- (forward-line 1)
+ (when force
+ (if (mm-head-p)
+ (re-search-forward "^$" nil t)
+ (forward-line 1)))
(mm-display-inline handle)
'inline)
((or method
@@ -849,18 +845,18 @@ external if displayed external."
'inline)
(setq external
(and method ;; If nil, we always use "save".
- (stringp method) ;; 'mailcap-save-binary-file
(or (eq mm-enable-external t)
(and (eq mm-enable-external 'ask)
(y-or-n-p
(concat
"Display part (" type
- ") using external program"
- ;; Can non-string method ever happen?
+ ") "
(if (stringp method)
(concat
- " \"" (format method filename) "\"")
- "")
+ "using external program \""
+ (format method filename) "\"")
+ (gnus-format-message
+ "by calling `%s' on the contents)" method))
"? "))))))
(if external
(mm-display-external
@@ -901,7 +897,15 @@ external if displayed external."
(mm-handle-media-type handle) t))))
(unwind-protect
(if method
- (funcall method)
+ (progn
+ (when (and (boundp 'gnus-summary-buffer)
+ (bufferp gnus-summary-buffer)
+ (buffer-name gnus-summary-buffer))
+ ;; So that we pop back to the right place, sort of.
+ (switch-to-buffer gnus-summary-buffer)
+ (switch-to-buffer mm))
+ (delete-other-windows)
+ (funcall method))
(mm-save-part handle))
(when (and (not non-viewer)
method)
@@ -1415,7 +1419,7 @@ Return t if meta tag is added or replaced."
(goto-char (point-min))
(if (re-search-forward "\
<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
-text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+\\)\\)?[\"'][^>]*>" nil t)
+text/\\(\\sw+\\)\\(?:;\\s-*charset=\\([^\"'>]+\\)\\)?[^>]*>" nil t)
(if (and (not force-charset)
(match-beginning 2)
(string-match "\\`html\\'" (match-string 1)))
@@ -1820,9 +1824,10 @@ If RECURSIVE, search recursively."
(not (mm-long-lines-p 76))))))
(declare-function libxml-parse-html-region "xml.c"
- (start end &optional base-url))
+ (start end &optional base-url discard-comments))
(declare-function shr-insert-document "shr" (dom))
(defvar shr-blocked-images)
+(defvar shr-use-fonts)
(defvar gnus-inhibit-images)
(autoload 'gnus-blocked-images "gnus-art")
@@ -1830,6 +1835,10 @@ If RECURSIVE, search recursively."
;; Require since we bind its variables.
(require 'shr)
(let ((article-buffer (current-buffer))
+ (shr-width (if (and (boundp 'shr-use-fonts)
+ shr-use-fonts)
+ nil
+ fill-column))
(shr-content-function (lambda (id)
(let ((handle (mm-get-content-id id)))
(when handle
@@ -1903,6 +1912,8 @@ If RECURSIVE, search recursively."
:keymap shr-map
(get-text-property start 'shr-url))
(put-text-property start end 'local-map nil)
+ (dolist (overlay (overlays-at start))
+ (overlay-put overlay 'face nil))
(setq start end)))))
(defun mm-handle-filename (handle)
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index 6b6313bb501..4901ff10277 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -1,6 +1,6 @@
;;; mm-encode.el --- Functions for encoding MIME things
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index 8f7b9a2458d..1ddcf0df556 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -1,6 +1,6 @@
;;; mm-extern.el --- showing message/external-body
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message external-body
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mm-util)
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index 44b7d73f93d..f9f217357a2 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -1,6 +1,6 @@
;;; mm-partial.el --- showing message/partial
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: message partial
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 6e83b18a02c..6d5f2a34c79 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -1,6 +1,6 @@
;;; mm-url.el --- a wrapper of url functions/commands for Gnus
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Some codes are stolen from w3 and url packages. Some are moved from
+;; Some code is stolen from w3 and url packages. Some are moved from
;; nnweb.
;; TODO: Support POST, cookie.
@@ -264,8 +264,6 @@ This is taken from RFC 2396.")
(require 'url-parse)
(require 'url-vars))
(error nil))
- ;; w3-4.0pre0.46 or earlier version.
- (require 'w3-vars)
(require 'url)))
;;;###autoload
@@ -416,13 +414,51 @@ spaces. Die Die Die."
(autoload 'mml-compute-boundary "mml")
+(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
+ "Return PAIRS encoded in multipart/form-data."
+ ;; RFC1867
+ ;; Get a good boundary
+ (unless boundary
+ (setq boundary (mml-compute-boundary '())))
+ (concat
+ ;; Start with the boundary
+ "--" boundary "\r\n"
+ ;; Create name value pairs
+ (mapconcat
+ 'identity
+ ;; Delete any returned items that are empty
+ (delq nil
+ (mapcar (lambda (data)
+ (cond ((equal (car data) "file")
+ ;; For each pair
+ (format
+ ;; Encode the name
+ "Content-Disposition: form-data; name=%S; filename=%S\r\nContent-Type: text/plain; charset=utf-8\r\nContent-Transfer-Encoding: binary\r\n\r\n%s"
+ (cdr (assoc "name" (cdr data))) (cdr (assoc "filename" (cdr data)))
+ (cond ((stringp (cdr (assoc "filedata" (cdr data))))
+ (cdr (assoc "filedata" (cdr data))))
+ ((integerp (cdr (assoc "filedata" (cdr data))))
+ (number-to-string (cdr (assoc "filedata" (cdr data))))))))
+ ((equal (car data) "submit")
+ "Content-Disposition: form-data; name=\"submit\"\r\n\r\nSubmit\r\n")
+ (t
+ (format
+ "Content-Disposition: form-data;name=%S\r\n\r\n%s\r\n"
+ (car data) (concat (mm-url-form-encode-xwfu (cdr data)))
+ ))))
+ pairs))
+ ;; use the boundary as a separator
+ (concat "\r\n--" boundary "\r\n"))
+ ;; put a boundary at the end.
+ "--" boundary "--\r\n"))
+
(defun mm-url-remove-markup ()
"Remove all HTML markup, leaving just plain text."
(goto-char (point-min))
(while (search-forward "<!--" nil t)
(delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
+ (or (search-forward "-->" nil t)
+ (point-max))))
(goto-char (point-min))
(while (re-search-forward "<[^>]+>" nil t)
(replace-match "" t t)))
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 9c2f0df5f59..ab9145f8b1c 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -1,6 +1,6 @@
;;; mm-util.el --- Utility functions for Mule and low level things
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mail-prsvr)
@@ -129,22 +125,6 @@
(multibyte-char-to-unibyte . identity)
;; `set-buffer-multibyte' is an Emacs function, not available in XEmacs.
(set-buffer-multibyte . ignore)
- ;; `special-display-p' is an Emacs function, not available in XEmacs.
- (special-display-p
- . ,(lambda (buffer-name)
- "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
- (and special-display-function
- (or (and (member buffer-name special-display-buffer-names) t)
- (cdr (assoc buffer-name special-display-buffer-names))
- (catch 'return
- (dolist (elem special-display-regexps)
- (and (stringp elem)
- (string-match elem buffer-name)
- (throw 'return t))
- (and (consp elem)
- (stringp (car elem))
- (string-match (car elem) buffer-name)
- (throw 'return (cdr elem)))))))))
;; `substring-no-properties' is available only in Emacs 22.1 or greater.
(substring-no-properties
. ,(lambda (string &optional from to)
@@ -174,6 +154,25 @@ to the contents of the accessible portion of the buffer."
(forward-line 0)
(1+ (count-lines start (point))))))))))
+;; `special-display-p' is an Emacs function, not available in XEmacs.
+(defalias 'mm-special-display-p
+ (if (featurep 'emacs)
+ 'special-display-p
+ (lambda (buffer-name)
+ "Returns non-nil if a buffer named BUFFER-NAME gets a special frame."
+ (and special-display-function
+ (or (and (member buffer-name special-display-buffer-names) t)
+ (cdr (assoc buffer-name special-display-buffer-names))
+ (catch 'return
+ (dolist (elem special-display-regexps)
+ (and (stringp elem)
+ (string-match elem buffer-name)
+ (throw 'return t))
+ (and (consp elem)
+ (stringp (car elem))
+ (string-match (car elem) buffer-name)
+ (throw 'return (cdr elem))))))))))
+
;; `decode-coding-string', `encode-coding-string', `decode-coding-region'
;; and `encode-coding-region' are available in Emacs and XEmacs built with
;; the `file-coding' feature, but the XEmacs versions treat nil, that is
@@ -1059,11 +1058,10 @@ This affects whether coding conversion should be attempted generally."
(length (memq (coding-system-base b) priorities)))
t))))
-(eval-when-compile
- (autoload 'latin-unity-massage-name "latin-unity")
- (autoload 'latin-unity-maybe-remap "latin-unity")
- (autoload 'latin-unity-representations-feasible-region "latin-unity")
- (autoload 'latin-unity-representations-present-region "latin-unity"))
+(declare-function latin-unity-massage-name "ext:latin-unity")
+(declare-function latin-unity-maybe-remap "ext:latin-unity")
+(declare-function latin-unity-representations-feasible-region "ext:latin-unity")
+(declare-function latin-unity-representations-present-region "ext:latin-unity")
(defvar latin-unity-coding-systems)
(defvar latin-unity-ucs-list)
@@ -1242,6 +1240,7 @@ better ways to do a similar thing. The previous version of this macro
bound the default value of `enable-multibyte-characters' to nil while
evaluating FORMS but it is no longer done. So, some programs assuming
it if any may malfunction."
+ (declare (obsolete nil "25.1") (indent 0) (debug t))
(if (featurep 'xemacs)
`(progn ,@forms)
(let ((multibyte (make-symbol "multibyte")))
@@ -1252,8 +1251,6 @@ it if any may malfunction."
(progn ,@forms)
(when ,multibyte
(set-buffer-multibyte t)))))))
-(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
-(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
(defun mm-find-charset-region (b e)
"Return a list of Emacs charsets in the region B to E."
@@ -1379,13 +1376,12 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
;; It is not a MIME function, but some MIME functions use it.
(if (and (fboundp 'make-temp-file)
(ignore-errors
- (let ((def (symbol-function 'make-temp-file)))
- (and (byte-code-function-p def)
- (setq def (if (fboundp 'compiled-function-arglist)
- ;; XEmacs
- (eval (list 'compiled-function-arglist def))
- (aref def 0)))
- (>= (length def) 4)
+ (let ((def (if (fboundp 'compiled-function-arglist) ;; XEmacs
+ (eval (list 'compiled-function-arglist
+ (symbol-function 'make-temp-file)))
+ (require 'help-fns)
+ (help-function-arglist 'make-temp-file t))))
+ (and (>= (length def) 4)
(eq (nth 3 def) 'suffix)))))
(defalias 'mm-make-temp-file 'make-temp-file)
;; Stolen (and modified for XEmacs) from Emacs 22.
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 1109742665a..3d1515e8473 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -1,6 +1,6 @@
;;; mm-uu.el --- Return uu stuff as mm handles
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
@@ -118,7 +118,7 @@ This can be either \"inline\" or \"attachment\".")
mm-uu-shar-extract)
(forward
;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
- ;; Peter von der Ah\'e <pahe@daimi.au.dk>
+ ;; Peter von der Ahé <pahe@daimi.au.dk>
"^-+ \\(Start of \\)?Forwarded message"
"^-+ End \\(of \\)?forwarded message"
mm-uu-forward-extract
@@ -523,7 +523,8 @@ apply the face `mm-uu-extract'."
(when (and mml2015-use (null (mml2015-clear-verify-function)))
(mm-set-handle-multipart-parameter
mm-security-handle 'gnus-details
- (format "Clear verification not supported by `%s'.\n" mml2015-use)))
+ (gnus-format-message
+ "Clear verification not supported by `%s'.\n" mml2015-use)))
(mml2015-extract-cleartext-signature))
(list (mm-make-handle buf mm-uu-text-plain-type)))))
@@ -673,22 +674,34 @@ value of `mm-uu-text-plain-type'."
(goto-char text-start)
(re-search-forward "." start-point t)))
(push
- (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
- mm-uu-text-plain-type)
+ (mm-make-handle
+ (mm-uu-copy-to-buffer
+ text-start
+ ;; A start-separator is likely accompanied by
+ ;; a leading newline.
+ (if (and (eq (char-before start-point) ?\n)
+ (eq (char-before (1- start-point)) ?\n))
+ (1- start-point)
+ start-point))
+ mm-uu-text-plain-type)
result))
(push
(funcall (mm-uu-function-extract entry))
result)
(goto-char (setq text-start end-point))))
(when result
- (if (and (> (point-max) (1+ text-start))
- (save-excursion
- (goto-char text-start)
- (re-search-forward "." nil t)))
- (push
- (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
- mm-uu-text-plain-type)
- result))
+ (goto-char text-start)
+ (when (re-search-forward "." nil t)
+ (push (mm-make-handle
+ (mm-uu-copy-to-buffer
+ ;; An end-separator is likely accompanied by
+ ;; a trailing newline.
+ (if (eq (char-after text-start) ?\n)
+ (1+ text-start)
+ text-start)
+ (point-max))
+ mm-uu-text-plain-type)
+ result))
(setq result (cons "multipart/mixed" (nreverse result))))
result)))
@@ -758,4 +771,8 @@ Assume text has been decoded if DECODED is non-nil."
(provide 'mm-uu)
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; mm-uu.el ends here
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 9512a411d81..edc2d39cd0f 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -1,6 +1,6 @@
;;; mm-view.el --- functions for viewing MIME objects
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -22,9 +22,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(require 'mail-parse)
(require 'mailcap)
@@ -51,7 +48,6 @@
(defvar mm-text-html-renderer-alist
'((shr . mm-shr)
- (w3 . mm-inline-text-html-render-with-w3)
(w3m . mm-inline-text-html-render-with-w3m)
(w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
(gnus-w3m . gnus-article-html)
@@ -100,19 +96,19 @@
(- (nth 3 edges) (nth 1 edges)))))))
image))
b)
- (insert "\n\n")
+ (insert "\n")
(mm-handle-set-undisplayer
handle
`(lambda ()
(let ((b ,b)
(inhibit-read-only t))
(remove-images b b)
- (delete-region b (+ b 2)))))))
+ (delete-region b (1+ b)))))))
(defun mm-inline-image-xemacs (handle)
(when (featurep 'xemacs)
- (insert "\n\n")
- (forward-char -2)
+ (insert "\n")
+ (forward-char -1)
(let ((annot (make-annotation (mm-get-image handle) nil 'text))
(inhibit-read-only t))
(mm-handle-set-undisplayer
@@ -121,7 +117,7 @@
(let ((b ,(point-marker))
(inhibit-read-only t))
(delete-annotation ,annot)
- (delete-region (- b 2) b))))
+ (delete-region (1- b) b))))
(set-extent-property annot 'mm t)
(set-extent-property annot 'duplicable t))))
@@ -130,91 +126,6 @@
(defalias 'mm-inline-image 'mm-inline-image-xemacs)
(defalias 'mm-inline-image 'mm-inline-image-emacs)))
-;; External.
-(declare-function w3-do-setup "ext:w3" ())
-(declare-function w3-region "ext:w3-display" (st nd))
-(declare-function w3-prepare-buffer "ext:w3-display" (&rest args))
-
-(defvar mm-w3-setup nil)
-(defun mm-setup-w3 ()
- (unless mm-w3-setup
- (require 'w3)
- (w3-do-setup)
- (require 'url)
- (require 'w3-vars)
- (require 'url-vars)
- (setq mm-w3-setup t)))
-
-(defun mm-inline-text-html-render-with-w3 (handle)
- (mm-setup-w3)
- (let ((text (mm-get-part handle))
- (b (point))
- (url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil)
- (url-current-object
- (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
- (width (window-width))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (save-excursion
- (insert (if charset (mm-decode-string text charset) text))
- (save-restriction
- (narrow-to-region b (point))
- (unless charset
- (goto-char (point-min))
- (when (or (and (boundp 'w3-meta-content-type-charset-regexp)
- (re-search-forward
- w3-meta-content-type-charset-regexp nil t))
- (and (boundp 'w3-meta-charset-content-type-regexp)
- (re-search-forward
- w3-meta-charset-content-type-regexp nil t)))
- (setq charset
- (let ((bsubstr (buffer-substring-no-properties
- (match-beginning 2)
- (match-end 2))))
- (if (fboundp 'w3-coding-system-for-mime-charset)
- (w3-coding-system-for-mime-charset bsubstr)
- (mm-charset-to-coding-system bsubstr))))
- (delete-region (point-min) (point-max))
- (insert (mm-decode-string text charset))))
- (save-window-excursion
- (save-restriction
- (let ((w3-strict-width width)
- ;; Don't let w3 set the global version of
- ;; this variable.
- (fill-column fill-column))
- (if (or debug-on-error debug-on-quit)
- (w3-region (point-min) (point-max))
- (condition-case ()
- (w3-region (point-min) (point-max))
- (error
- (delete-region (point-min) (point-max))
- (let ((b (point))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (if (or (eq charset 'gnus-decoded)
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle)
- charset))))
- (message
- "Error while rendering html; showing as text/plain")))))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let ((inhibit-read-only t))
- ,@(if (functionp 'remove-specifier)
- '((dolist (prop '(background background-pixmap foreground))
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
-
(defvar mm-w3m-setup nil
"Whether gnus-article-mode has been setup to use emacs-w3m.")
@@ -343,9 +254,10 @@
'charset)
(symbol-name mail-parse-charset)))
cs)
- (unless (and charset
- (setq cs (mm-charset-to-coding-system charset))
- (not (eq cs 'ascii)))
+ (if (and charset
+ (setq cs (mm-charset-to-coding-system charset nil t))
+ (not (eq cs 'ascii)))
+ (setq charset (format "%s" (mm-coding-system-to-mime-charset cs)))
;; The default.
(setq charset "iso-8859-1"
cs 'iso-8859-1))
@@ -479,7 +391,7 @@
handle
`(lambda ()
(let ((inhibit-read-only t))
- (delete-region ,(point-min-marker)
+ (delete-region ,(copy-marker (point-min) t)
,(point-max-marker))))))))
(defun mm-insert-inline (handle text)
@@ -492,19 +404,12 @@
handle
`(lambda ()
(let ((inhibit-read-only t))
- (delete-region ,(copy-marker b)
- ,(copy-marker (point))))))))
+ (delete-region ,(copy-marker b t)
+ ,(point-marker)))))))
(defun mm-inline-audio (handle)
(message "Not implemented"))
-(defun mm-w3-prepare-buffer ()
- (require 'w3)
- (let ((url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil))
- (w3-prepare-buffer)))
-
(defun mm-view-message ()
(mm-enable-multibyte)
(let (handles)
@@ -608,16 +513,20 @@ If MODE is not set, try to find mode automatically."
(set (make-local-variable 'enable-local-variables) nil)
(with-demoted-errors
(if mode
- (funcall mode)
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (funcall mode))
(let ((auto-mode-alist
(delq (rassq 'doc-view-mode-maybe auto-mode-alist)
(copy-sequence auto-mode-alist))))
(set-auto-mode)))
;; The mode function might have already turned on font-lock.
;; Do not fontify if the guess mode is fundamental.
- (unless (or (symbol-value 'font-lock-mode)
+ (unless (or font-lock-mode
(eq major-mode 'fundamental-mode))
- (font-lock-fontify-buffer))))
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (font-lock-fontify-buffer)))))
;; By default, XEmacs font-lock uses non-duplicable text
;; properties. This code forces all the text properties
;; to be copied along with the text.
@@ -720,6 +629,8 @@ If MODE is not set, try to find mode automatically."
(replace-match "\n"))
t)
+(autoload 'epg-decrypt-string "epg")
+
(defun mm-view-pkcs7-decrypt (handle &optional from)
(insert-buffer-substring (mm-handle-buffer handle))
(goto-char (point-min))
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 3f1efacebf1..45da9371a41 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -1,6 +1,6 @@
;;; mml-sec.el --- A package with security functions for MML documents
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 6ea55377e02..0bcc9c53c48 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -1,6 +1,6 @@
;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: Gnus, MIME, S/MIME, MML
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'smime)
@@ -206,7 +202,7 @@ Whether the passphrase is cached at all is controlled by
"")))))
(if (setq cert (smime-cert-by-dns who))
(setq result (list 'certfile (buffer-name cert)))
- (setq bad (format "`%s' not found. " who))))
+ (setq bad (gnus-format-message "`%s' not found. " who))))
(quit))
result))
@@ -225,7 +221,7 @@ Whether the passphrase is cached at all is controlled by
"")))))
(if (setq cert (smime-cert-by-ldap who))
(setq result (list 'certfile (buffer-name cert)))
- (setq bad (format "`%s' not found. " who))))
+ (setq bad (gnus-format-message "`%s' not found. " who))))
(quit))
result))
@@ -321,24 +317,25 @@ Whether the passphrase is cached at all is controlled by
(defvar inhibit-redisplay)
(defvar password-cache-expiry)
-(eval-when-compile
- (autoload 'epg-make-context "epg")
- (autoload 'epg-context-set-armor "epg")
- (autoload 'epg-context-set-signers "epg")
- (autoload 'epg-context-result-for "epg")
- (autoload 'epg-new-signature-digest-algorithm "epg")
- (autoload 'epg-verify-result-to-string "epg")
- (autoload 'epg-list-keys "epg")
- (autoload 'epg-decrypt-string "epg")
- (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")
- (autoload 'epg-expand-group "epg-config")
- (autoload 'epa-select-keys "epa"))
+(autoload 'epg-make-context "epg")
+(autoload 'epg-passphrase-callback-function "epg")
+(declare-function epg-context-set-signers "epg" (context signers))
+(declare-function epg-context-result-for "epg" (context name))
+(declare-function epg-new-signature-digest-algorithm "epg" (cl-x) t)
+(declare-function epg-verify-result-to-string "epg" (verify-result))
+(declare-function epg-list-keys "epg" (context &optional name mode))
+(declare-function epg-verify-string "epg"
+ (context signature &optional signed-text))
+(declare-function epg-sign-string "epg" (context plain &optional mode))
+(declare-function epg-encrypt-string "epg"
+ (context plain recipients &optional sign always-trust))
+(declare-function epg-context-set-passphrase-callback "epg"
+ (context passphrase-callback))
+(declare-function epg-sub-key-fingerprint "epg" (cl-x) t)
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-expand-group "epg-config" (config group))
+(declare-function epa-select-keys "epa"
+ (context prompt &optional names secret))
(defvar mml-smime-epg-secret-key-id-list nil)
@@ -363,9 +360,9 @@ Whether the passphrase is cached at all is controlled by
(cons key-id mml-smime-epg-secret-key-id-list))
(copy-sequence passphrase)))))
-(declare-function epg-key-sub-key-list "ext:epg" (key))
-(declare-function epg-sub-key-capability "ext:epg" (sub-key))
-(declare-function epg-sub-key-validity "ext:epg" (sub-key))
+(declare-function epg-key-sub-key-list "epg" (key) t)
+(declare-function epg-sub-key-capability "epg" (sub-key) t)
+(declare-function epg-sub-key-validity "epg" (sub-key) t)
(defun mml-smime-epg-find-usable-key (keys usage)
(catch 'found
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 91f0e325182..57544758597 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1,6 +1,6 @@
;;; mml.el --- A package for parsing and validating MML documents
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -22,16 +22,13 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mm-util)
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
(require 'mml-sec)
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'url))
(eval-when-compile
(when (featurep 'xemacs)
(require 'easy-mmode))) ; for `define-minor-mode'
@@ -260,7 +257,9 @@ part. This is for the internal use, you should never modify the value.")
((string= mode "encrypt")
(setq tags (list "encrypt" method)))
((string= mode "signencrypt")
- (setq tags (list "sign" method "encrypt" method))))
+ (setq tags (list "sign" method "encrypt" method)))
+ (t
+ (error "Unknown secure mode %s" mode)))
(eval `(mml-insert-tag ,secure-mode
,@tags
,(if keyfile "keyfile")
@@ -463,6 +462,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
(defvar mml-multipart-number 0)
(defvar mml-inhibit-compute-boundary nil)
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url discard-comments))
+
(defun mml-generate-mime (&optional multipart-type)
"Generate a MIME message based on the current MML document.
MULTIPART-TYPE defaults to \"mixed\", but can also
@@ -472,19 +474,69 @@ be \"related\" or \"alternate\"."
(options message-options))
(if (not cont)
nil
+ (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))))
(prog1
(mm-with-multibyte-buffer
(setq message-options options)
- (if (and (consp (car cont))
- (= (length cont) 1))
- (mml-generate-mime-1 (car cont))
+ (cond
+ ((and (consp (car cont))
+ (= (length cont) 1))
+ (mml-generate-mime-1 (car cont)))
+ ((eq (car cont) 'multipart)
+ (mml-generate-mime-1 cont))
+ (t
(mml-generate-mime-1
(nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
- cont)))
+ cont))))
(setq options message-options)
(buffer-string))
(setq message-options options)))))
+(defun mml-expand-html-into-multipart-related (cont)
+ (let ((new-parts nil)
+ (cid 1))
+ (mm-with-multibyte-buffer
+ (insert (cdr (assq 'contents cont)))
+ (goto-char (point-min))
+ (with-syntax-table mml-syntax-table
+ (while (re-search-forward "<img\\b" nil t)
+ (goto-char (match-beginning 0))
+ (let* ((start (point))
+ (img (nth 2
+ (nth 2
+ (libxml-parse-html-region
+ (point) (progn (forward-sexp) (point))))))
+ (end (point))
+ (parsed (url-generic-parse-url (cdr (assq 'src (cadr img))))))
+ (when (and (null (url-type parsed))
+ (url-filename parsed)
+ (file-exists-p (url-filename parsed)))
+ (goto-char start)
+ (when (search-forward (url-filename parsed) end t)
+ (let ((cid (format "fsf.%d" cid)))
+ (replace-match (concat "cid:" cid) t t)
+ (push (list cid (url-filename parsed)) new-parts))
+ (setq cid (1+ cid)))))))
+ ;; We have local images that we want to include.
+ (if (not new-parts)
+ (list cont)
+ (setcdr (assq 'contents cont) (buffer-string))
+ (setq cont
+ (nconc (list 'multipart (cons 'type "related"))
+ (list cont)))
+ (dolist (new-part (nreverse new-parts))
+ (setq cont
+ (nconc cont
+ (list `(part (type . "image/png")
+ (filename . ,(nth 1 new-part))
+ (id . ,(concat "<" (nth 0 new-part)
+ ">")))))))
+ cont))))
+
(defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding
(or mm-use-ultra-safe-encoding (assq 'sign cont))))
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 52b8e347edf..47d4407f689 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -1,6 +1,6 @@
;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Sascha Lüdecke <sascha@meta-x.de>,
;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
@@ -26,9 +26,6 @@
;;; Code:
(eval-and-compile
- ;; For Emacs <22.2 and XEmacs.
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password)))
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 3efa5c23bb3..5104cea5abb 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -1,6 +1,6 @@
;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: PGP MIME MML
@@ -28,9 +28,6 @@
;;; Code:
(eval-and-compile
- ;; For Emacs <22.2 and XEmacs.
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password)))
@@ -51,12 +48,10 @@
;; Then mml1991 would not need to require mml2015, and mml1991-use
;; could be removed.
(defvar mml2015-use (or
- (condition-case nil
- (progn
- (require 'epg-config)
- (epg-check-configuration (epg-configuration))
- 'epg)
- (error))
+ (progn
+ (ignore-errors (require 'epg-config))
+ (and (fboundp 'epg-check-configuration)
+ 'epg))
(progn
(let ((abs-file (locate-library "pgg")))
;; Don't load PGG if it is marked as obsolete
@@ -152,6 +147,12 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
:group 'mime-security
:type 'integer)
+(defcustom mml2015-display-key-image t
+ "If t, try to display key images."
+ :version "24.5"
+ :group 'mime-security
+ :type 'boolean)
+
;; Extract plaintext from cleartext signature. IMO, this kind of task
;; should be done by GnuPG rather than Elisp, but older PGP backends
;; (such as Mailcrypt, and PGG) discard the output from GnuPG.
@@ -866,6 +867,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(setq secret-keys (cdr secret-keys))))
secret-key))
+(autoload 'gnus-create-image "gnus-ems")
+
(defun mml2015-epg-key-image (key-id)
"Return the image of a key, if any"
(with-temp-buffer
@@ -901,7 +904,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'."
(defun mml2015-epg-signature-to-string (signature)
(concat (epg-signature-to-string signature)
- (mml2015-epg-key-image-to-string (epg-signature-key-id signature))))
+ (when mml2015-display-key-image
+ (mml2015-epg-key-image-to-string (epg-signature-key-id signature)))))
(defun mml2015-epg-verify-result-to-string (verify-result)
(mapconcat #'mml2015-epg-signature-to-string verify-result "\n"))
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 7630db85ef3..9c828a3f073 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -1,6 +1,6 @@
;;; nnagent.el --- offline backend for Gnus
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 4e82b1427b2..ae417a0ffe8 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -1,6 +1,6 @@
;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -105,7 +105,7 @@
(> number nnmail-large-newsgroup)
(zerop (% (incf count) 20))
(nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index c92952e7a0c..a6e75b739dd 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1,6 +1,6 @@
;;; nndiary.el --- A diary back end for Gnus
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Didier Verna <didier@xemacs.org>
;; Maintainer: Didier Verna <didier@xemacs.org>
@@ -151,15 +151,15 @@ maximum in the reminder is not that painful, I think. Although this
scheme might appear somewhat weird at a first glance, it is very powerful.
In order to make this clear, here are some examples:
-- '(0 . day): this is the default value of `nndiary-reminders'. It means
+- (0 . day): this is the default value of `nndiary-reminders'. It means
pop up the appointments of the day each morning at 00:00.
-- '(1 . day): this means pop up the appointments the day before, at 00:00.
+- (1 . day): this means pop up the appointments the day before, at 00:00.
-- '(6 . hour): for an appointment at 18:30, this would pop up the
+- (6 . hour): for an appointment at 18:30, this would pop up the
appointment message at 12:00.
-- '(360 . minute): for an appointment at 18:30 and 15 seconds, this would
+- (360 . minute): for an appointment at 18:30 and 15 seconds, this would
pop up the appointment message at 12:30."
:group 'nndiary
:type '(repeat (cons :format "%v\n"
@@ -423,7 +423,7 @@ all. This may very well take some time.")
(> number nnmail-large-newsgroup)
(zerop (% count 20))
(nnheader-message 6 "nndiary: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
@@ -1314,6 +1314,8 @@ all. This may very well take some time.")
res))
(sort res 'time-less-p)))
+;; FIXME: "occurrence" is misspelled in this function name.
+
(defun nndiary-last-occurence (sched)
;; Returns the last occurrence of schedule SCHED as an Emacs time struct, or
;; nil for permanent schedule or errors.
@@ -1394,6 +1396,8 @@ all. This may very well take some time.")
nil))
))))
+;; FIXME: "occurrence" is misspelled in this function name.
+
(defun nndiary-next-occurence (sched now)
;; Returns the next occurrence of schedule SCHED, starting from time NOW.
;; If there's no next occurrence, returns the last one (if any) which is then
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index 5e68779e977..469e026d73b 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -1,6 +1,6 @@
;;; nndir.el --- single directory newsgroup access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index b17a7a6ecd8..cca341875e0 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -1,6 +1,6 @@
;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -56,6 +56,10 @@ from the document.")
`((mmdf
(article-begin . "^\^A\^A\^A\^A\n")
(body-end . "^\^A\^A\^A\^A\n"))
+ (debbugs-db
+ (file-begin . "^\005")
+ (article-begin . "^[\005\007]\n")
+ (body-end . "^\003"))
(mime-digest
(article-begin . "")
(head-begin . "^ ?\n")
@@ -195,7 +199,7 @@ from the document.")
;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and
;; SUMMARY-INSERT [6] give headers to insert for full article or summary line
;; generation, respectively. Other headers usually follow directly from the
-;; buffer. Value `nil' means no insert.
+;; buffer. Value nil means no insert.
(defvoo nndoc-dissection-alist nil)
(defvoo nndoc-prepare-body-function nil)
(defvoo nndoc-generate-head-function nil)
@@ -460,6 +464,10 @@ from the document.")
(when (looking-at "\^A\^A\^A\^A$")
t))
+(defun nndoc-debbugs-db-type-p ()
+ (when (looking-at "\006$")
+ t))
+
(defun nndoc-news-type-p ()
(when (looking-at "^Path:.*\n")
t))
@@ -734,7 +742,7 @@ from the document.")
nil t)
(setq subject (concat (match-string 1) subject))
(setq from (concat (match-string 2) " " from))))))
- (while (and from (string-match "(\[^)\]*)" from))
+ (while (and from (string-match "([^)]*)" from))
(setq from (replace-match "" t t from)))
(insert "From: " (or from "unknown")
"\nSubject: " (or subject "(no subject)") "\n")
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index c9625f4c447..0af547dfa1b 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -1,6 +1,6 @@
;;; nndraft.el --- draft article access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'nnmail)
(require 'gnus-start)
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 57475b9bb86..0d9044fb712 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -1,6 +1,6 @@
;;; nneething.el --- arbitrary file access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -106,7 +106,7 @@ included.")
(and large
(zerop (% count 20))
(nnheader-message 5 "nneething: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(when large
(nnheader-message 5 "nneething: Receiving headers...done"))
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index e189ab531f0..2901d294242 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -1,6 +1,6 @@
;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
@@ -28,10 +28,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'message)
(require 'nnmail)
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 067523d704a..808a21c6b6a 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -1,6 +1,6 @@
;;; nngateway.el --- posting news via mail gateways
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 1197ac81941..0d2d453df3e 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -1,6 +1,6 @@
;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987-1990, 1993-1998, 2000-2013 Free Software
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -26,9 +26,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(defvar nnmail-extra-headers)
@@ -69,7 +66,7 @@ they will keep on jabbering all the time."
"*Max length of the head of articles.
Value is an integer, nil, or t. nil means read in chunks of a file
-indefinitely until a complete head is found\; t means always read the
+indefinitely until a complete head is found; t means always read the
entire file immediately, disregarding `nnheader-head-chop-length'.
Integer values will in effect be rounded up to the nearest multiple of
@@ -117,7 +114,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
For instance, if \":\" is invalid as a file character in file names
on your system, you could say something like:
-\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
+\(setq nnheader-file-name-translation-alist \\='((?: . ?_)))")
(defvar nnheader-directory-separator-character
(string-to-char (substring (file-name-as-directory ".") -1))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index f8c2b24cc9f..ac228f9c04e 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,6 +1,6 @@
;;; nnimap.el --- IMAP interface for Gnus
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Simon Josefsson <simon@josefsson.org>
@@ -26,10 +26,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-and-compile
(require 'nnheader)
;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
@@ -95,7 +91,7 @@ Uses the same syntax as `nnmail-split-methods'.")
(defvoo nnimap-unsplittable-articles '(%Deleted %Seen)
"Articles with the flags in the list will not be considered when splitting.")
-(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
+(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'."
"Emacs 24.1")
(defvoo nnimap-authenticator nil
@@ -170,16 +166,23 @@ textual parts.")
(nnimap-find-process-buffer nntp-server-buffer))
(defun nnimap-header-parameters ()
- (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
- (format
+ (let (params)
+ (push "UID" params)
+ (push "RFC822.SIZE" params)
+ (when (nnimap-capability "X-GM-EXT-1")
+ (push "X-GM-LABELS" params))
+ (push "BODYSTRUCTURE" params)
+ (push (format
(if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
References In-Reply-To Xref)
- nnmail-extra-headers))))
+ nnmail-extra-headers))
+ params)
+ (format "%s" (nreverse params))))
-(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
+(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old)
(when group
(setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
@@ -193,6 +196,8 @@ textual parts.")
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-header-parameters))
t)
+ (unless (process-live-p (get-buffer-process (current-buffer)))
+ (error "Server closed connection"))
(nnimap-transform-headers)
(nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
@@ -201,7 +206,7 @@ textual parts.")
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article lines size string)
+ (let (article lines size string labels)
(block nil
(while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH"))
@@ -230,12 +235,16 @@ textual parts.")
t)
(match-string 1)))
(setq lines nil)
+ (beginning-of-line)
(setq size
(and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
(line-end-position)
t)
(match-string 1)))
(beginning-of-line)
+ (when (search-forward "X-GM-LABELS" (line-end-position) t)
+ (setq labels (ignore-errors (read (current-buffer)))))
+ (beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
(let ((structure (ignore-errors
(read (current-buffer)))))
@@ -255,7 +264,11 @@ textual parts.")
(insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
- (unless (re-search-forward "^\r$" nil t)
+ (when labels
+ (insert (format "X-GM-LABELS: %s\n" labels)))
+ ;; Most servers have a blank line after the headers, but
+ ;; Davmail doesn't.
+ (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
(goto-char (point-max)))
(delete-region (line-beginning-position) (line-end-position))
(insert ".")
@@ -318,6 +331,8 @@ textual parts.")
(push (current-buffer) nnimap-process-buffers)
(current-buffer)))
+(defvar auth-source-creation-prompts)
+
(defun nnimap-credentials (address ports user)
(let* ((auth-source-creation-prompts
'((user . "IMAP user at %h: ")
@@ -407,9 +422,11 @@ textual parts.")
"*nnimap*" (current-buffer) nnimap-address
(nnimap-map-port (car ports))
:type nnimap-stream
+ :warn-unless-encrypted t
:return-list t
:shell-command nnimap-shell-program
:capability-command "1 CAPABILITY\r\n"
+ :always-query-capabilities t
:end-of-command "\r\n"
:success " OK "
:starttls-function
@@ -456,8 +473,8 @@ textual parts.")
(nnimap-credentials
(gnus-delete-duplicates
(list
- nnimap-address
- (nnoo-current-server 'nnimap)))
+ (nnoo-current-server 'nnimap)
+ nnimap-address))
ports
nnimap-user))))
(setq nnimap-object nil)
@@ -473,7 +490,7 @@ textual parts.")
(funcall (nth 2 credentials)))
;; See if CAPABILITY is set as part of login
;; response.
- (dolist (response (cddr login-result))
+ (dolist (response (cddr (nnimap-command "CAPABILITY")))
(when (string= "CAPABILITY" (upcase (car response)))
(setf (nnimap-capabilities nnimap-object)
(mapcar #'upcase (cdr response))))))
@@ -571,7 +588,7 @@ textual parts.")
(gnus-buffer-live-p nntp-server-buffer)
(nnimap-find-connection nntp-server-buffer)))
-(deffoo nnimap-status-message (&optional server)
+(deffoo nnimap-status-message (&optional _server)
nnimap-status-string)
(deffoo nnimap-request-article (article &optional group server to-buffer)
@@ -626,6 +643,26 @@ textual parts.")
(nnheader-ms-strip-cr)
(cons group article)))))))
+(deffoo nnimap-request-articles (articles &optional group server)
+ (when group
+ (setq group (nnimap-decode-gnus-group group)))
+ (with-current-buffer nntp-server-buffer
+ (let ((result (nnimap-change-group group server)))
+ (when result
+ (erase-buffer)
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (when (nnimap-command
+ (if (nnimap-ver4-p)
+ "UID FETCH %s BODY.PEEK[]"
+ "UID FETCH %s RFC822.PEEK")
+ (nnimap-article-ranges (gnus-compress-sequence articles)))
+ (let ((buffer (current-buffer)))
+ (with-current-buffer nntp-server-buffer
+ (nnheader-insert-buffer-substring buffer)
+ (nnheader-ms-strip-cr)))
+ t))))))
+
(defun nnimap-get-whole-article (article &optional command)
(let ((result
(nnimap-command
@@ -770,53 +807,69 @@ textual parts.")
nil
group)
server))
- articles active marks high low)
+ (info (when info (list info)))
+ active)
(with-current-buffer nntp-server-buffer
(when result
- (if (and dont-check
- (setq active (nth 2 (assoc group nnimap-current-infos))))
- (insert (format "211 %d %d %d %S\n"
- (- (cdr active) (car active))
- (car active)
- (cdr active)
- group))
- (with-current-buffer (nnimap-buffer)
- (erase-buffer)
- (let ((group-sequence
- (nnimap-send-command "SELECT %S" (utf7-encode group t)))
- (flag-sequence
- (nnimap-send-command "UID FETCH 1:* FLAGS")))
- (setf (nnimap-group nnimap-object) group)
- (nnimap-wait-for-response flag-sequence)
- (setq marks
- (nnimap-flags-to-marks
- (nnimap-parse-flags
- (list (list group-sequence flag-sequence
- 1 group "SELECT")))))
- (when (and info
- marks)
- (nnimap-update-infos marks (list info))
- (nnimap-store-info info (gnus-active (gnus-info-group info))))
- (goto-char (point-max))
- (let ((uidnext (nth 5 (car marks))))
- (setq high (or (if uidnext
- (1- uidnext)
- (nth 3 (car marks)))
- 0)
- low (or (nth 4 (car marks)) uidnext 1)))))
- (erase-buffer)
- (insert
- (format
- "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
+ (when (or (not dont-check)
+ (not (setq active
+ (nth 2 (assoc group nnimap-current-infos)))))
+ (let ((sequences (nnimap-retrieve-group-data-early
+ server info)))
+ (nnimap-finish-retrieve-group-infos server info sequences
+ t)
+ (setq active (nth 2 (assoc group nnimap-current-infos)))))
+ (setq active (or active '(0 . 1)))
+ (erase-buffer)
+ (insert (format "211 %d %d %d %S\n"
+ (- (cdr active) (car active))
+ (car active)
+ (cdr active)
+ group))
t))))
-(deffoo nnimap-request-create-group (group &optional server args)
+(deffoo nnimap-request-group-scan (group &optional server info)
+ (setq group (nnimap-decode-gnus-group group))
+ (when (nnimap-change-group nil server)
+ (let (marks high low)
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (let ((group-sequence
+ (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+ (flag-sequence
+ (nnimap-send-command "UID FETCH 1:* FLAGS")))
+ (setf (nnimap-group nnimap-object) group)
+ (nnimap-wait-for-response flag-sequence)
+ (setq marks
+ (nnimap-flags-to-marks
+ (nnimap-parse-flags
+ (list (list group-sequence flag-sequence
+ 1 group "SELECT")))))
+ (when (and info
+ marks)
+ (nnimap-update-infos marks (list info))
+ (nnimap-store-info info (gnus-active (gnus-info-group info))))
+ (goto-char (point-max))
+ (let ((uidnext (nth 5 (car marks))))
+ (setq high (or (if uidnext
+ (1- uidnext)
+ (nth 3 (car marks)))
+ 0)
+ low (or (nth 4 (car marks)) uidnext 1)))))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert
+ (format
+ "211 %d %d %d %S\n" (1+ (- high low)) low high group))
+ t))))
+
+(deffoo nnimap-request-create-group (group &optional server _args)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "CREATE %S" (utf7-encode group t))))))
-(deffoo nnimap-request-delete-group (group &optional force server)
+(deffoo nnimap-request-delete-group (group &optional _force server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
@@ -861,11 +914,11 @@ textual parts.")
articles)))
(nreverse articles)))
-(deffoo nnimap-close-group (group &optional server)
+(deffoo nnimap-close-group (_group &optional _server)
t)
(deffoo nnimap-request-move-article (article group server accept-form
- &optional last internal-move-group)
+ &optional _last internal-move-group)
(setq group (nnimap-decode-gnus-group group))
(when internal-move-group
(setq internal-move-group (nnimap-decode-gnus-group internal-move-group)))
@@ -879,17 +932,19 @@ textual parts.")
;; way.
(let ((message-id (message-field-value "message-id")))
(if internal-move-group
- (let ((result
- (with-current-buffer (nnimap-buffer)
- (nnimap-command "UID COPY %d %S"
- article
- (utf7-encode internal-move-group t)))))
- (when (car result)
- (nnimap-delete-article article)
- (cons internal-move-group
- (or (nnimap-find-uid-response "COPYUID" (cadr result))
- (nnimap-find-article-by-message-id
- internal-move-group server message-id
+ (with-current-buffer (nnimap-buffer)
+ (let* ((can-move (nnimap-capability "MOVE"))
+ (command (if can-move
+ "UID MOVE %d %S"
+ "UID COPY %d %S"))
+ (result (nnimap-command command article
+ (utf7-encode internal-move-group t))))
+ (when (and (car result) (not can-move))
+ (nnimap-delete-article article))
+ (cons internal-move-group
+ (or (nnimap-find-uid-response "COPYUID" (caddr result))
+ (nnimap-find-article-by-message-id
+ internal-move-group server message-id
nnimap-request-articles-find-limit)))))
;; Move the article to a different method.
(let ((result (eval accept-form)))
@@ -929,11 +984,12 @@ textual parts.")
(gnus-sorted-complement articles deletable-articles))))))
(defun nnimap-process-expiry-targets (articles group server)
- (let ((deleted-articles nil))
+ (let ((deleted-articles nil)
+ (articles-to-delete nil))
(cond
;; shortcut further processing if we're going to delete the articles
((eq nnmail-expiry-target 'delete)
- (setq deleted-articles articles)
+ (setq articles-to-delete articles)
t)
;; or just move them to another folder on the same IMAP server
((and (not (functionp nnmail-expiry-target))
@@ -943,11 +999,14 @@ textual parts.")
(and (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(nnheader-message 7 "Expiring articles from %s: %s" group articles)
- (nnimap-command
- "UID COPY %s %S"
- (nnimap-article-ranges (gnus-compress-sequence articles))
- (utf7-encode (gnus-group-real-name nnmail-expiry-target) t))
- (setq deleted-articles articles)))
+ (let ((can-move (nnimap-capability "MOVE")))
+ (nnimap-command
+ (if can-move
+ "UID MOVE %s %S"
+ "UID COPY %s %S")
+ (nnimap-article-ranges (gnus-compress-sequence articles))
+ (utf7-encode (gnus-group-real-name nnmail-expiry-target) t))
+ (set (if can-move 'deleted-articles 'articles-to-delete) articles))))
t)
(t
(dolist (article articles)
@@ -968,29 +1027,31 @@ textual parts.")
(setq target nil))
(nnheader-message 7 "Expiring article %s:%d" group article))
(when target
- (push article deleted-articles))))))))
+ (push article articles-to-delete))))))
+ (setq articles-to-delete (nreverse articles-to-delete))))
;; Change back to the current group again.
(nnimap-change-group group server)
- (setq deleted-articles (nreverse deleted-articles))
- (nnimap-delete-article (gnus-compress-sequence deleted-articles))
+ (when articles-to-delete
+ (nnimap-delete-article (gnus-compress-sequence articles-to-delete))
+ (setq deleted-articles articles-to-delete))
deleted-articles))
(defun nnimap-find-expired-articles (group)
(let ((cutoff (nnmail-expired-article-p group nil nil)))
- (with-current-buffer (nnimap-buffer)
- (let ((result
- (nnimap-command
- "UID SEARCH SENTBEFORE %s"
- (format-time-string
- (format "%%d-%s-%%Y"
- (upcase
- (car (rassoc (nth 4 (decode-time cutoff))
- parse-time-months))))
- cutoff))))
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result))))))))))
-
+ (when cutoff
+ (with-current-buffer (nnimap-buffer)
+ (let ((result
+ (nnimap-command
+ "UID SEARCH SENTBEFORE %s"
+ (format-time-string
+ (format "%%d-%s-%%Y"
+ (upcase
+ (car (rassoc (nth 4 (decode-time cutoff))
+ parse-time-months))))
+ cutoff))))
+ (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result)))))))))))
(defun nnimap-find-article-by-message-id (group server message-id
&optional limit)
@@ -1096,7 +1157,18 @@ If LIMIT, first try to limit the search to the N last articles."
(when sequence
(nnimap-wait-for-response sequence))))))
-(deffoo nnimap-request-accept-article (group &optional server last)
+(deffoo nnimap-request-accept-article (group &optional server _last)
+ (unless group
+ ;; We're respooling. Find out where mail splitting would place
+ ;; this article.
+ (setq group
+ (caar
+ (nnmail-article-group
+ ;; We don't really care about the article number, because
+ ;; that's determined by the IMAP server later. So just
+ ;; return the group name.
+ `(lambda (group)
+ (list (list group)))))))
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(nnmail-check-syntax)
@@ -1203,12 +1275,18 @@ If LIMIT, first try to limit the search to the N last articles."
(goto-char (point-min))
(while (search-forward "* LIST " nil t)
(let ((flags (read (current-buffer)))
- (separator (read (current-buffer)))
- (group (read (current-buffer))))
+ (_separator (read (current-buffer)))
+ (group (buffer-substring-no-properties
+ (progn (skip-chars-forward " \"")
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \r\"")
+ (point)))))
(unless (member '%NoSelect flags)
(push (utf7-decode (if (stringp group)
group
- (format "%s" group)) t)
+ (format "%s" group))
+ t)
groups))))
(nreverse groups)))
@@ -1268,7 +1346,7 @@ If LIMIT, first try to limit the search to the N last articles."
(or highest exists)))))))))
t)))))
-(deffoo nnimap-request-newgroups (date &optional server)
+(deffoo nnimap-request-newgroups (_date &optional server)
(when (nnimap-change-group nil server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -1287,7 +1365,7 @@ If LIMIT, first try to limit the search to the N last articles."
(setf (nnimap-group nnimap-object) nil)
(setf (nnimap-initial-resync nnimap-object) 0)
(let ((qresyncp (nnimap-capability "QRESYNC"))
- params groups sequences active uidvalidity modseq group
+ params sequences active uidvalidity modseq group
unexist)
;; Go through the infos and gather the data needed to know
;; what and how to request the data.
@@ -1344,7 +1422,8 @@ If LIMIT, first try to limit the search to the N last articles."
command
(nth 2 quirk))))
-(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
+(deffoo nnimap-finish-retrieve-group-infos (server infos sequences
+ &optional dont-insert)
(when (and sequences
(nnimap-change-group nil server t)
;; Check that the process is still alive.
@@ -1364,19 +1443,20 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-parse-flags
(nreverse sequences)))
infos)
- ;; Finally, just return something resembling an active file in
- ;; the nntp buffer, so that the agent can save the info, too.
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (dolist (info infos)
- (let* ((group (gnus-info-group info))
- (active (gnus-active group)))
- (when active
- (insert (format "%S %d %d y\n"
- (decode-coding-string
- (gnus-group-real-name group) 'utf-8)
- (cdr active)
- (car active)))))))))))
+ (unless dont-insert
+ ;; Finally, just return something resembling an active file in
+ ;; the nntp buffer, so that the agent can save the info, too.
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (info infos)
+ (let* ((group (gnus-info-group info))
+ (active (gnus-active group)))
+ (when active
+ (insert (format "%S %d %d y\n"
+ (decode-coding-string
+ (gnus-group-real-name group) 'utf-8)
+ (cdr active)
+ (car active))))))))))))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)
@@ -1599,7 +1679,7 @@ If LIMIT, first try to limit the search to the N last articles."
(push (list group info active) nnimap-current-infos))))
(defun nnimap-flags-to-marks (groups)
- (let (data group totalp uidnext articles start-article mark permanent-flags
+ (let (data group uidnext articles start-article mark permanent-flags
uidvalidity vanished highestmodseq)
(dolist (elem groups)
(setq group (car elem)
@@ -1690,7 +1770,7 @@ If LIMIT, first try to limit the search to the N last articles."
(setq start (point))
(goto-char end))
(while (re-search-forward "^\\* [0-9]+ FETCH " start t)
- (let ((p (point)))
+ (progn
(setq elems (read (current-buffer)))
(push (cons (cadr (memq 'UID elems))
(cadr (memq 'FLAGS elems)))
@@ -1708,7 +1788,7 @@ If LIMIT, first try to limit the search to the N last articles."
(defun nnimap-find-process-buffer (buffer)
(cadr (assoc buffer nnimap-connection-alist)))
-(deffoo nnimap-request-post (&optional server)
+(deffoo nnimap-request-post (&optional _server)
(setq nnimap-status-string "Read-only server")
nil)
@@ -1862,7 +1942,7 @@ Return the server's response to the SELECT or EXAMINE command."
(while (and (not (bobp))
(progn
(forward-line -1)
- (looking-at "\\*"))))
+ (looking-at "\\*\\|[0-9]+ OK NOOP"))))
(not (looking-at (format "%d .*\n" sequence)))))
(when messagep
(nnheader-message-maybe
@@ -1990,6 +2070,7 @@ Return the server's response to the SELECT or EXAMINE command."
nnmail-split-fancy))
(nnmail-inhibit-default-split-group t)
(groups (nnimap-get-groups))
+ (can-move (nnimap-capability "MOVE"))
new-articles)
(erase-buffer)
(nnimap-command "SELECT %S" nnimap-inbox)
@@ -2021,14 +2102,19 @@ Return the server's response to the SELECT or EXAMINE command."
(ranges (cdr spec)))
(if (eq group 'junk)
(setq junk-articles ranges)
- (push (list (nnimap-send-command
- "UID COPY %s %S"
- (nnimap-article-ranges ranges)
- (utf7-encode group t))
- ranges)
- sequences))))
+ ;; Don't copy if the message is already in its
+ ;; target group.
+ (unless (string= group nnimap-inbox)
+ (push (list (nnimap-send-command
+ (if can-move
+ "UID MOVE %s %S"
+ "UID COPY %s %S")
+ (nnimap-article-ranges ranges)
+ (utf7-encode group t))
+ ranges)
+ sequences)))))
;; Wait for the last COPY response...
- (when sequences
+ (when (and (not can-move) sequences)
(nnimap-wait-for-response (caar sequences))
;; And then mark the successful copy actions as deleted,
;; and possibly expunge them.
@@ -2107,10 +2193,10 @@ Return the server's response to the SELECT or EXAMINE command."
(forward-char (1+ bytes))
(delete-region (line-beginning-position) (line-end-position)))))))
-(defun nnimap-dummy-active-number (group &optional server)
+(defun nnimap-dummy-active-number (_group &optional _server)
1)
-(defun nnimap-save-mail-spec (group-art &optional server full-nov)
+(defun nnimap-save-mail-spec (group-art &optional _server _full-nov)
(let (article)
(goto-char (point-min))
(if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 4dd123bf2c7..9784f1bd879 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -1,6 +1,6 @@
;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
@@ -171,10 +171,6 @@
;;; Setup:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnoo)
(require 'gnus-group)
(require 'message)
@@ -285,16 +281,6 @@ is `(valuefunc member)'."
(require 'gnus-sum)
-(eval-when-compile
- (autoload 'nnimap-buffer "nnimap")
- (autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-change-group "nnimap")
- (autoload 'nnimap-make-thread-query "nnimap")
- (autoload 'gnus-registry-action "gnus-registry")
- (autoload 'gnus-registry-get-id-key "gnus-registry")
- (autoload 'gnus-group-topic-name "gnus-topic"))
-
-
(nnoo-declare nnir)
(nnoo-define-basics nnir)
@@ -364,10 +350,10 @@ result, `gnus-retrieve-headers' will be called instead."
(defcustom nnir-swish++-additional-switches '()
"*A list of strings, to be given as additional arguments to swish++.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-swish++-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))"
:type '(repeat (string))
:group 'nnir)
@@ -413,10 +399,10 @@ This cannot be a server parameter."
(defcustom nnir-swish-e-additional-switches '()
"*A list of strings, to be given as additional arguments to swish-e.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))
+ (setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\"))
This could be a server parameter."
:type '(repeat (string))
@@ -443,10 +429,10 @@ This could be a server parameter."
(defcustom nnir-hyrex-additional-switches '()
"*A list of strings, to be given as additional arguments for nnir-search.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong !
Instead, use this:
- (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
+ (setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
:type '(repeat (string))
:group 'nnir)
@@ -485,10 +471,10 @@ arrive at the correct group name, \"mail.misc\"."
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. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-namazu-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))"
:type '(repeat (string))
:group 'nnir)
@@ -514,10 +500,10 @@ arrive at the correct group name, \"mail.misc\"."
(defcustom nnir-notmuch-additional-switches '()
"*A list of strings, to be given as additional arguments to notmuch.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-notmuch-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))"
:version "24.1"
:type '(repeat (string))
:group 'nnir)
@@ -590,6 +576,8 @@ Add an entry here when adding a new search engine.")
;; Gnus glue.
+(declare-function gnus-group-topic-name "gnus-topic" ())
+
(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*
@@ -834,7 +822,8 @@ skips all prompting."
(deffoo nnir-request-update-mark (group article mark)
(let ((artgroup (nnir-article-group article))
(artnumber (nnir-article-number article)))
- (gnus-request-update-mark artgroup artnumber mark)))
+ (when (and artgroup artnumber)
+ (gnus-request-update-mark artgroup artnumber mark))))
(deffoo nnir-request-set-mark (group actions &optional server)
(nnir-possibly-change-group group server)
@@ -951,6 +940,10 @@ ready to be added to the list of search results."
;;; Search Engine Interfaces:
+(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.
@@ -1486,7 +1479,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(goto-char (point-min))
(while (re-search-forward
- "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
nil t)
(setq score (match-string 3)
group (file-name-directory (match-string 4))
@@ -1777,6 +1770,9 @@ environment unless `not-global' is non-nil."
(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
@@ -1844,6 +1840,10 @@ article came from is also searched."
(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
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 5be449e9a6b..f3ba169b58c 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1,6 +1,6 @@
;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus) ; for macro gnus-kill-buffer, at least
@@ -40,8 +36,7 @@
(autoload 'gnus-add-buffer "gnus")
(autoload 'gnus-kill-buffer "gnus")
-(eval-when-compile
- (autoload 'mail-send-and-exit "sendmail" nil t))
+(autoload 'mail-send-and-exit "sendmail" nil t)
(defgroup nnmail nil
"Reading mail with Gnus."
@@ -88,7 +83,7 @@ If you'd like, for instance, one mail group for mail from the
else, you could do something like this:
(setq nnmail-split-methods
- '((\"mail.4ad\" \"From:.*4ad\")
+ \\='((\"mail.4ad\" \"From:.*4ad\")
(\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
(\"mail.misc\" \"\")))
@@ -185,7 +180,7 @@ E.g.:
(lambda (newsgroup)
(cond ((string-match \"private\" newsgroup) 31)
((string-match \"junk\" newsgroup) 1)
- ((string-match \"important\" newsgroup) 'never)
+ ((string-match \"important\" newsgroup) \\='never)
(t 7))))"
:group 'nnmail-expire
:type '(choice (const :tag "nnmail-expiry-wait" nil)
@@ -222,7 +217,7 @@ will try to match against both the From and the To header.
Example:
\(setq nnmail-fancy-expiry-targets
- '((to-from \"boss\" \"nnfolder:Work\")
+ \\='((to-from \"boss\" \"nnfolder:Work\")
(\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
(\"from\" \".*\" \"nnfolder:Archive-%Y\")))
@@ -293,7 +288,7 @@ running (\"xwatch\", etc.)
E.g.:
-\(add-hook 'nnmail-read-incoming-hook
+\(add-hook \\='nnmail-read-incoming-hook
(lambda ()
(call-process \"/local/bin/mailsend\" nil nil nil
\"read\"
@@ -306,11 +301,11 @@ read.
If you use `display-time', you could use something like this:
-\(add-hook 'nnmail-read-incoming-hook
+\(add-hook \\='nnmail-read-incoming-hook
(lambda ()
;; Update the displayed time, since that will clear out
;; the flag that says you have mail.
- (when (eq (process-status \"display-time\") 'run)
+ (when (eq (process-status \"display-time\") \\='run)
(display-time-filter display-time-process \"\"))))"
:group 'nnmail-prepare
:type 'hook)
@@ -374,7 +369,7 @@ messages will be shown to indicate the current status."
(number :tag "count")))
(define-widget 'nnmail-lazy 'default
- "Base widget for recursive datastructures.
+ "Base widget for recursive data structures.
This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
:format "%{%t%}: %v"
@@ -470,7 +465,7 @@ GROUP: Mail will be stored in GROUP (a string).
junk: Mail will be deleted. Use with care! Do not submerge in water!
Example:
(setq nnmail-split-fancy
- '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
+ \\='(| (\"Subject\" \"MAKE MONEY FAST\" junk)
...other.rules.omitted...))
FIELD must match a complete field name. VALUE must match a complete
@@ -485,12 +480,12 @@ GROUP can contain \\& and \\N which will substitute from matching
Example:
-\(setq nnmail-split-methods 'nnmail-split-fancy
+\(setq nnmail-split-methods \\='nnmail-split-fancy
nnmail-split-fancy
;; Messages from the mailer daemon are not crossposted to any of
;; the ordinary groups. Warnings are put in a separate group
;; from real errors.
- '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
+ \\='(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
\"mail.misc\"))
;; Non-error messages are crossposted to all relevant
;; groups, but we don't crosspost between the group for the
@@ -1397,7 +1392,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
((stringp split)
(when nnmail-split-tracing
(push split nnmail-split-trace))
- (list (nnmail-expand-newtext split)))
+ (list (nnmail-expand-newtext split t)))
;; Junk the message.
((eq split 'junk)
@@ -1430,12 +1425,14 @@ See the documentation for the variable `nnmail-split-fancy' for details."
;; Check the cache for the regexp for this split.
((setq cached-pair (assq split nnmail-split-cache))
(let (split-result
+ match-data
(end-point (point-max))
(value (nth 1 split)))
(if (symbolp value)
(setq value (cdr (assq value nnmail-split-abbrev-alist))))
(while (and (goto-char end-point)
(re-search-backward (cdr cached-pair) nil t))
+ (setq match-data (match-data))
(when nnmail-split-tracing
(push split nnmail-split-trace))
(let ((split-rest (cddr split))
@@ -1464,12 +1461,9 @@ See the documentation for the variable `nnmail-split-fancy' for details."
(setq split-rest (cddr split-rest))))
(when split-rest
(goto-char end)
- (let ((value (nth 1 split)))
- (if (symbolp value)
- (setq value (cdr (assq value nnmail-split-abbrev-alist))))
- ;; Someone might want to do a \N sub on this match, so get the
- ;; correct match positions.
- (re-search-backward value start-of-value))
+ ;; Someone might want to do a \N sub on this match, so
+ ;; restore the match data.
+ (set-match-data match-data)
(dolist (sp (nnmail-split-it (car split-rest)))
(unless (member sp split-result)
(push sp split-result))))))
@@ -1518,7 +1512,7 @@ See the documentation for the variable `nnmail-split-fancy' for details."
;; on the same split, which will find it immediately in the cache.
(nnmail-split-it split))))))
-(defun nnmail-expand-newtext (newtext)
+(defun nnmail-expand-newtext (newtext &optional fancyp)
(let ((len (length newtext))
(pos 0)
c expanded beg N did-expand)
@@ -1543,6 +1537,10 @@ See the documentation for the variable `nnmail-split-fancy' for details."
(if (= c ?\&)
(setq N 0)
(setq N (- c ?0)))
+ ;; We wrapped the searches in parentheses, so we have to
+ ;; add some parentheses here...
+ (when fancyp
+ (setq N (+ N 3)))
(when (match-beginning N)
(push (if nnmail-split-lowercase-expanded
(downcase (buffer-substring (match-beginning N)
@@ -1794,6 +1792,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
"Read new incoming mail."
(nnmail-get-new-mail-1 method exit-func temp group nil spool-func))
+(defun nnmail-get-new-mail-per-group ()
+ "Tell us whether the mail-sources specify that `nnmail-get-new-mail' should
+be called once per group or once for all groups."
+ (or (assq 'group mail-sources)
+ (assq 'directory mail-sources)))
+
(defun nnmail-get-new-mail-1 (method exit-func temp
group in-group spool-func)
(let* ((sources mail-sources)
@@ -1806,7 +1810,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
sources)
(while (setq source (pop sources))
;; Use group's parameter
- (when (eq (car source) 'group)
+ (when (and (eq (car source) 'group)
+ group)
(let ((mail-sources
(list
(gnus-group-find-parameter
@@ -1922,7 +1927,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
(when (functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (when (or (gnus-request-group target)
+ (when (or (gnus-request-group target nil nil (gnus-get-info target))
(gnus-request-create-group target))
(let ((group-art (gnus-request-accept-article target nil nil t)))
(when (and (consp group-art)
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 7d33e511baa..3d8926b6925 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -59,10 +59,6 @@
)
]
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'gnus)
(require 'gnus-util)
@@ -79,6 +75,7 @@
(defconst nnmaildir-flag-mark-mapping
'((?F . tick)
+ (?P . forward)
(?R . reply)
(?S . read))
"Alist mapping Maildir filename flags to Gnus marks.
@@ -88,13 +85,13 @@ Some of the FLAGS correspond to Gnus marks.")
(defsubst nnmaildir--mark-to-flag (mark)
"Find the Maildir flag that corresponds to MARK (an atom).
-Return a character, or `nil' if not found.
+Return a character, or nil if not found.
See `nnmaildir-flag-mark-mapping'."
(car (rassq mark nnmaildir-flag-mark-mapping)))
(defsubst nnmaildir--flag-to-mark (flag)
"Find the Gnus mark that corresponds to FLAG (a character).
-Return an atom, or `nil' if not found.
+Return an atom, or nil if not found.
See `nnmaildir-flag-mark-mapping'."
(cdr (assq flag nnmaildir-flag-mark-mapping)))
@@ -150,7 +147,7 @@ by nnmaildir-request-article.")
;; A NOV structure looks like this (must be prin1-able, so no defstruct):
["subject\tfrom\tdate"
- "references\tchars\lines"
+ "references\tchars\tlines"
"To: you\tIn-Reply-To: <your.mess@ge>"
(12345 67890) ;; modtime of the corresponding article file
(to in-reply-to)] ;; contemporary value of nnmail-extra-headers
@@ -337,29 +334,24 @@ by nnmaildir-request-article.")
;; given group, if non-nil, be the current group of the current server. Then
;; return the group object for the current group.
(defun nnmaildir--prepare (server group)
- (let (x groups)
- (catch 'return
- (if (null server)
- (unless (setq server nnmaildir--cur-server)
- (throw 'return nil))
- (unless (setq server (intern-soft server nnmaildir--servers))
+ (catch 'return
+ (if (null server)
+ (unless (setq server nnmaildir--cur-server)
(throw 'return nil))
- (setq server (symbol-value server)
- nnmaildir--cur-server server))
- (unless (setq groups (nnmaildir--srv-groups server))
+ (unless (setq server (intern-soft server nnmaildir--servers))
(throw 'return nil))
- (unless (nnmaildir--srv-method server)
- (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
- x (gnus-server-to-method x))
- (unless x (throw 'return nil))
- (setf (nnmaildir--srv-method server) x))
- (if (null group)
- (unless (setq group (nnmaildir--srv-curgrp server))
- (throw 'return nil))
- (unless (setq group (intern-soft group groups))
- (throw 'return nil))
- (setq group (symbol-value group)))
- group)))
+ (setq server (symbol-value server)
+ nnmaildir--cur-server server))
+ (let ((groups (nnmaildir--srv-groups server)))
+ (when groups
+ (unless (nnmaildir--srv-method server)
+ (setf (nnmaildir--srv-method server)
+ (or (gnus-server-to-method
+ (concat "nnmaildir:" (nnmaildir--srv-address server)))
+ (throw 'return nil))))
+ (if (null group)
+ (nnmaildir--srv-curgrp server)
+ (symbol-value (intern-soft group groups)))))))
(defun nnmaildir--tab-to-space (string)
(let ((pos 0))
@@ -432,7 +424,7 @@ by nnmaildir-request-article.")
(srv-dir (nnmaildir--srv-dir server))
(storage-version 1) ;; [version article-number msgid [...nov...]]
dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
- nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
+ nov msgid nov-beg nov-mid nov-end field val old-extra num
deactivate-mark)
(catch 'return
(setq gname (nnmaildir--grp-name group)
@@ -672,7 +664,7 @@ by nnmaildir-request-article.")
"/" "\\057" 'literal)
":" "\\072" 'literal))
-(defun nnmaildir-request-type (group &optional article)
+(defun nnmaildir-request-type (_group &optional _article)
'mail)
(defun nnmaildir-status-message (&optional server)
@@ -772,7 +764,7 @@ by nnmaildir-request-article.")
(if (> (aref a 1) (aref b 1)) (throw 'return nil))
(string-lessp (aref a 2) (aref b 2))))
-(defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
+(defun nnmaildir--scan (gname scan-msgs groups _method srv-dir srv-ls)
(catch 'return
(let ((36h-ago (- (car (current-time)) 2))
absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
@@ -887,6 +879,10 @@ by nnmaildir-request-article.")
(setf (nnmaildir--grp-cur group) cattr)))
t))
+(defvar nnmaildir-get-new-mail)
+(defvar nnmaildir-group-alist)
+(defvar nnmaildir-active-file)
+
(defun nnmaildir-request-scan (&optional scan-group server)
(let ((coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
@@ -894,7 +890,7 @@ by nnmaildir-request-article.")
(nnmaildir-get-new-mail t)
(nnmaildir-group-alist nil)
(nnmaildir-active-file nil)
- x srv-ls srv-dir method groups target-prefix group dirs grp-dir seen
+ x srv-ls srv-dir method groups target-prefix dirs seen
deactivate-mark)
(nnmaildir--prepare server nil)
(setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server)
@@ -970,7 +966,7 @@ by nnmaildir-request-article.")
(nnmaildir--srv-groups nnmaildir--cur-server))))
t)
-(defun nnmaildir-request-newgroups (date &optional server)
+(defun nnmaildir-request-newgroups (_date &optional server)
(nnmaildir-request-list server))
(defun nnmaildir-retrieve-groups (groups &optional server)
@@ -999,9 +995,9 @@ by nnmaildir-request-article.")
(nnmaildir--srvgrp-dir
(nnmaildir--srv-dir nnmaildir--cur-server) gname)))
(curdir-mtime (nth 5 (file-attributes curdir)))
- pgname flist always-marks never-marks old-marks dotfile num dir
- all-marks marks mark ranges markdir read end new-marks ls
- old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
+ pgname flist always-marks never-marks old-marks dir
+ all-marks marks ranges markdir read ls
+ old-mmth new-mmth mtime existing missing deactivate-mark)
(catch 'return
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
@@ -1100,7 +1096,7 @@ by nnmaildir-request-article.")
(setf (nnmaildir--grp-mmth group) new-mmth)
info)))
-(defun nnmaildir-request-group (gname &optional server fast info)
+(defun nnmaildir-request-group (gname &optional server fast _info)
(let ((group (nnmaildir--prepare server gname))
deactivate-mark)
(catch 'return
@@ -1123,7 +1119,7 @@ by nnmaildir-request-article.")
(insert " " (gnus-replace-in-string gname " " "\\ " t) "\n")
t))))
-(defun nnmaildir-request-create-group (gname &optional server args)
+(defun nnmaildir-request-create-group (gname &optional server _args)
(nnmaildir--prepare server nil)
(catch 'return
(let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
@@ -1269,7 +1265,7 @@ by nnmaildir-request-article.")
(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
(let ((group (nnmaildir--prepare server gname))
- srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov
+ nlist mlist article num start stop nov insert-nov
deactivate-mark)
(setq insert-nov
(lambda (article)
@@ -1294,9 +1290,7 @@ by nnmaildir-request-article.")
(erase-buffer)
(setq mlist (nnmaildir--grp-mlist group)
nlist (nnmaildir--grp-nlist group)
- gname (nnmaildir--grp-name group)
- srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir srv-dir gname))
+ gname (nnmaildir--grp-name group))
(cond
((null nlist))
((and fetch-old (not (numberp fetch-old)))
@@ -1367,7 +1361,7 @@ by nnmaildir-request-article.")
(nnheader-insert-file-contents nnmaildir-article-file-name))
(cons gname num-msgid))))
-(defun nnmaildir-request-post (&optional server)
+(defun nnmaildir-request-post (&optional _server)
(let (message-required-mail-headers)
(funcall message-send-mail-function)))
@@ -1409,7 +1403,7 @@ by nnmaildir-request-article.")
t)))
(defun nnmaildir-request-move-article (article gname server accept-form
- &optional last move-is-internal)
+ &optional _last _move-is-internal)
(let ((group (nnmaildir--prepare server gname))
pgname suffix result nnmaildir--file deactivate-mark)
(catch 'return
@@ -1446,7 +1440,7 @@ by nnmaildir-request-article.")
(nnmaildir--expired-article group article))
result)))
-(defun nnmaildir-request-accept-article (gname &optional server last)
+(defun nnmaildir-request-accept-article (gname &optional server _last)
(let ((group (nnmaildir--prepare server gname))
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
@@ -1550,7 +1544,7 @@ by nnmaildir-request-article.")
ga))
group-art)))))
-(defun nnmaildir-active-number (gname)
+(defun nnmaildir-active-number (_gname)
0)
(declare-function gnus-group-mark-article-read "gnus-group" (group article))
@@ -1558,8 +1552,8 @@ 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 bound-iter high low target dir nlist nlist2
- stop article didnt nnmaildir--file nnmaildir-article-file-name
+ pgname time boundary bound-iter high low target dir nlist
+ didnt nnmaildir--file nnmaildir-article-file-name
deactivate-mark)
(catch 'return
(unless group
@@ -1641,6 +1635,8 @@ by nnmaildir-request-article.")
(erase-buffer))
didnt)))
+(defvar nnmaildir--article)
+
(defun nnmaildir-request-set-mark (gname actions &optional server)
(let* ((group (nnmaildir--prepare server gname))
(curdir (nnmaildir--cur
@@ -1650,27 +1646,30 @@ by nnmaildir-request-article.")
(coding-system-for-write nnheader-file-coding-system)
(buffer-file-coding-system nil)
(file-coding-system-alist nil)
- del-mark del-action add-action set-action marksdir nlist
- ranges begin end article all-marks todo-marks mdir mfile
- pgname ls permarkfile deactivate-mark)
- (setq del-mark
+ marksdir nlist
+ ranges all-marks todo-marks mdir mfile
+ pgname ls permarkfile deactivate-mark
+ (del-mark
(lambda (mark)
- (let ((prefix (nnmaildir--art-prefix article))
- (suffix (nnmaildir--art-suffix article))
+ (let ((prefix (nnmaildir--art-prefix nnmaildir--article))
+ (suffix (nnmaildir--art-suffix nnmaildir--article))
(flag (nnmaildir--mark-to-flag mark)))
(when flag
;; If this mark corresponds to a flag, remove the flag from
;; the file name.
(nnmaildir--article-set-flags
- article (nnmaildir--remove-flag flag suffix) curdir))
+ nnmaildir--article (nnmaildir--remove-flag flag suffix)
+ curdir))
;; We still want to delete the hardlink in the marks dir if
;; present, regardless of whether this mark has a maildir flag or
;; not, to avoid getting out of sync.
(setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
mfile (concat mfile prefix))
- (nnmaildir--unlink mfile)))
- del-action (lambda (article) (mapcar del-mark todo-marks))
- add-action
+ (nnmaildir--unlink mfile))))
+ (del-action (lambda (article)
+ (let ((nnmaildir--article article))
+ (mapcar del-mark todo-marks))))
+ (add-action
(lambda (article)
(mapcar
(lambda (mark)
@@ -1699,13 +1698,14 @@ by nnmaildir-request-article.")
(rename-file permarkfilenew permarkfile 'replace)
(add-name-to-file permarkfile mfile)))
(t (signal (car err) (cdr err))))))))
- todo-marks))
- set-action (lambda (article)
+ todo-marks)))
+ (set-action (lambda (article)
(funcall add-action article)
- (mapcar (lambda (mark)
- (unless (memq mark todo-marks)
- (funcall del-mark mark)))
- all-marks)))
+ (let ((nnmaildir--article article))
+ (mapcar (lambda (mark)
+ (unless (memq mark todo-marks)
+ (funcall del-mark mark)))
+ all-marks)))))
(catch 'return
(unless group
(setf (nnmaildir--srv-error nnmaildir--cur-server)
@@ -1732,7 +1732,7 @@ by nnmaildir-request-article.")
(setq ranges (car action)
todo-marks (caddr action))
(dolist (mark todo-marks)
- (add-to-list 'all-marks mark))
+ (pushnew mark all-marks :test #'equal))
(if (numberp (cdr ranges)) (setq ranges (list ranges)))
(nnmaildir--nlist-iterate nlist ranges
(cond ((eq 'del (cadr action)) del-action)
@@ -1779,6 +1779,8 @@ by nnmaildir-request-article.")
t)))
(defun nnmaildir-close-server (&optional server)
+ (defvar flist) (defvar ls) (defvar dirs) (defvar dir)
+ (defvar files) (defvar file) (defvar x)
(let (flist ls dirs dir files file x)
(nnmaildir--prepare server nil)
(when nnmaildir--cur-server
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index 8c73b40047f..ccfc5996e79 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1,10 +1,10 @@
;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
-;; Version: 0.6
+;; Old-Version: 0.6
;; This file is part of GNU Emacs.
@@ -243,7 +243,7 @@ unused nnmairix groups on the back end using
(defcustom nnmairix-mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
-The default is '-F' and '-Q' for making updates faster. You
+The default is \"-F\" and \"-Q\" for making updates faster. You
should call mairix without these options from time to
time (e.g. via cron job)."
:version "23.1"
@@ -252,7 +252,7 @@ time (e.g. via cron job)."
(defcustom nnmairix-mairix-search-options '("-Q")
"Options when calling mairix for searching.
-The default is '-Q' for making searching faster."
+The default is \"-Q\" for making searching faster."
:version "23.1"
:type '(repeat string)
:group 'nnmairix)
@@ -308,13 +308,13 @@ The default chooses the largest window in the current frame."
(defcustom nnmairix-propagate-marks-upon-close t
"Flag if marks should be propagated upon closing a group.
-The default of this variable is t. If set to 'ask, the
+The default of this variable is t. If set to 'ask, the
user will be asked if the flags should be propagated when the
group is closed. If set to nil, the user will have to manually
-call 'nnmairix-propagate-marks'."
+call `nnmairix-propagate-marks'."
:version "23.1"
:type '(choice (const :tag "always" t)
- (const :tag "ask" 'ask)
+ (const :tag "ask" ask)
(const :tag "never" nil))
:group 'nnmairix)
@@ -417,7 +417,7 @@ Other back ends might or might not work.")
(nnoo-define-basics nnmairix)
-(gnus-declare-backend "nnmairix" 'mail 'address)
+(gnus-declare-backend "nnmairix" 'mail 'address 'virtual)
(deffoo nnmairix-open-server (server &optional definitions)
;; just set server variables
@@ -1943,7 +1943,9 @@ Fill in VALUES if based on an article."
(kill-all-local-variables)
(erase-buffer)
(widget-insert "Specify your query for Mairix (check boxes for activating fields):\n\n")
- (widget-insert "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
+ (widget-insert
+ (substitute-command-keys
+ "(Whitespaces will be converted to `,' (i.e. AND). Use `/' for OR.)\n\n"))
; (make-local-variable 'nnmairix-widgets)
(setq nnmairix-widgets (nnmairix-widget-build-editable-fields values))
(when (member 'flags nnmairix-widget-other)
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index c605541e7f1..a70a0395f37 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -1,6 +1,6 @@
;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -106,7 +106,7 @@
(> number nnmail-large-newsgroup)
(zerop (% count 20))
(nnheader-message 5 "nnmbox: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 87f093e42f8..cdbf38ae62d 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -1,6 +1,6 @@
;;; nnmh.el --- mhspool access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -109,7 +109,7 @@ as unread by Gnus.")
(and large
(zerop (% count 20))
(nnheader-message 5 "nnmh: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(when large
(nnheader-message 5 "nnmh: Receiving headers...done"))
@@ -259,12 +259,12 @@ as unread by Gnus.")
&optional server force)
(nnmh-possibly-change-directory newsgroup server)
(let ((is-old t)
+ (dir nnmh-current-directory)
article rest mod-time)
(nnheader-init-server-buffer)
(while (and articles is-old)
- (setq article (concat nnmh-current-directory
- (int-to-string (car articles))))
+ (setq article (concat dir (int-to-string (car articles))))
(when (setq mod-time (nth 5 (file-attributes article)))
(if (and (nnmh-deletable-article-p newsgroup (car articles))
(setq is-old
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 05d0c902340..33eae1c166e 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -1,6 +1,6 @@
;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Authors: Didier Verna <didier@xemacs.org> (adding compaction)
;; Simon Josefsson <simon@josefsson.org>
@@ -178,7 +178,7 @@ non-nil.")
(> number nnmail-large-newsgroup)
(zerop (% count 20))
(nnheader-message 6 "nnml: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)
@@ -268,10 +268,35 @@ non-nil.")
(max (1+ (- (cdr active) (car active))) 0)
(car active) (cdr active) group)))))))
+(deffoo nnml-retrieve-groups (groups &optional server)
+ (when nnml-get-new-mail
+ (if (nnmail-get-new-mail-per-group)
+ (dolist (group groups)
+ (nnml-request-scan group server))
+ (nnml-request-scan nil server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (group groups)
+ (let* ((entry (assoc group nnml-group-alist))
+ (active (nth 1 entry)))
+ (if (consp active)
+ (insert (format "211 %d %d %d %s\n"
+ (max (1+ (- (cdr active) (car active))) 0)
+ (car active) (cdr active) group))))))
+ 'group)
+
(deffoo nnml-request-scan (&optional group server)
(setq nnml-article-file-alist nil)
(nnml-possibly-change-directory group server)
- (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group))
+ (cond
+ (group
+ (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group))
+ ((nnmail-get-new-mail-per-group)
+ (nnml-request-list)
+ (dolist (entry nnml-group-alist)
+ (nnml-request-scan (car entry) server)))
+ (t
+ (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory nil))))
(deffoo nnml-close-group (group &optional server)
(setq nnml-article-file-alist nil)
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index 7558dc50d2f..8fe83a4c144 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -1,6 +1,6 @@
;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index 677bb698136..8147d8e7e48 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -1,7 +1,7 @@
;;; nnregistry.el --- access to articles via Gnus' message-id registry
;;; -*- coding: utf-8 -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Authors: Ludovic Courtès <ludo@gnu.org>
;; Keywords: news, mail
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 80bb7c4f7df..1546f922e7a 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -1,6 +1,6 @@
;;; nnrss.el --- interfacing with RSS
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: RSS
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
@@ -398,8 +394,8 @@ otherwise return nil."
nnrss-compatible-encoding-alist)))))
(mm-coding-system-p 'utf-8)))
-(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff))
-
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url discard-comments))
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
(mm-with-unibyte-buffer
@@ -426,22 +422,14 @@ otherwise return nil."
(mm-enable-multibyte))))
(goto-char (point-min))
- ;; Because xml-parse-region can't deal with anything that isn't
- ;; xml and w3-parse-buffer can't deal with some xml, we have to
- ;; parse with xml-parse-region first and, if that fails, parse
- ;; with w3-parse-buffer. Yuck. Eventually, someone should find out
- ;; why w3-parse-buffer fails to parse some well-formed xml and
- ;; fix it.
-
(condition-case err1
(setq xmlform (xml-parse-region (point-min) (point-max)))
(error
(condition-case err2
- (setq htmlform (caddar (w3-parse-buffer
- (current-buffer))))
+ (setq htmlform (libxml-parse-html-region (point-min) (point-max)))
(error
(message "\
-nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
+nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
url err1 err2)))))
(if htmlform
htmlform
@@ -599,7 +587,7 @@ which RSS 2.0 allows."
(defun nnrss-no-cache (url)
"")
-(defun nnrss-insert-w3 (url)
+(defun nnrss-insert (url)
(mm-with-unibyte-current-buffer
(condition-case err
(mm-url-insert url)
@@ -614,8 +602,6 @@ which RSS 2.0 allows."
(mm-url-decode-entities-nbsp)
(buffer-string))))
-(defalias 'nnrss-insert 'nnrss-insert-w3)
-
(defun nnrss-mime-encode-string (string)
(mm-with-multibyte-buffer
(insert string)
@@ -880,8 +866,7 @@ Careful with this on large documents!"
(defun nnrss-extract-hrefs (data)
"Recursively extract hrefs from a page's source.
-DATA should be the output of `xml-parse-region' or
-`w3-parse-buffer'."
+DATA should be the output of `xml-parse-region'."
(mapcar (lambda (ahref)
(cdr (assoc 'href (cadr ahref))))
(nnrss-find-el 'a data)))
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index b20eb3f1848..f10b1ad6c54 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -1,6 +1,6 @@
;;; nnspool.el --- spool access for GNU Emacs
-;; Copyright (C) 1988-1990, 1993-1998, 2000-2013 Free Software
+;; Copyright (C) 1988-1990, 1993-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
@@ -174,7 +174,7 @@ there.")
(and do-message
(zerop (% (incf count) 20))
(nnheader-message 5 "nnspool: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (floor (* count 100.0) number))))
(when do-message
(nnheader-message 5 "nnspool: Receiving headers...done"))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 58135a1e598..ec9a66614b4 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1,6 +1,6 @@
;;; nntp.el --- nntp access for Gnus
-;; Copyright (C) 1987-1990, 1992-1998, 2000-2013 Free Software
+;; Copyright (C) 1987-1990, 1992-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -25,9 +25,7 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
;; `make-network-stream'.
(unless (fboundp 'open-protocol-stream)
@@ -74,7 +72,7 @@ For instance, if you want Gnus to beep every time you connect
to innd, you could say something like:
\(setq nntp-server-action-alist
- '((\"innd\" (ding))))
+ \\='((\"innd\" (ding))))
You probably don't want to do that, though.")
@@ -177,7 +175,7 @@ This variable is used by the various nntp-open-via-* methods.")
"*Whether both telnet client and server support the ENVIRON option.
If non-nil, there will be no prompt for a login name.")
-(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+(defvoo nntp-via-shell-prompt "bash\\|[$>] *\r?$"
"*Regular expression to match the shell prompt on an intermediate host.
This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
@@ -293,7 +291,7 @@ update their active files often, this can help.")
(defvar nntp-async-process-list nil)
(defvar nntp-authinfo-rejected nil
-"A custom error condition used to report 'Authentication Rejected' errors.
+"A custom error condition used to report `Authentication Rejected' errors.
Condition handlers that match just this condition ensure that the nntp
backend doesn't catch this error.")
(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
@@ -730,7 +728,7 @@ command whose response triggered the error."
(> number nntp-large-newsgroup)
(zerop (% received 20))
(nnheader-message 6 "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
+ (floor (* received 100.0) number)))
(nntp-accept-response))))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
@@ -967,7 +965,7 @@ command whose response triggered the error."
(> number nntp-large-newsgroup)
(zerop (% received 20))
(nnheader-message 6 "NNTP: Receiving articles... %d%%"
- (/ (* received 100) number)))
+ (floor (* received 100.0) number)))
(nntp-accept-response))))
(and (numberp nntp-large-newsgroup)
(> number nntp-large-newsgroup)
@@ -1221,14 +1219,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the
nntp-authinfo-user user))
(unless (member user '(nil ""))
(nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (or passwd
- nntp-authinfo-password
- (setq nntp-authinfo-password
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
+ (let ((result
+ (nntp-send-command
+ "^2.*\r?\n" "AUTHINFO PASS"
+ (or passwd
+ nntp-authinfo-password
+ (setq nntp-authinfo-password
+ (read-passwd (format "NNTP (%s@%s) password: "
+ user nntp-address)))))))
+ (if (not result)
+ (signal 'nntp-authinfo-rejected "Password rejected")
+ result))))))
;;; Internal functions.
@@ -1763,7 +1764,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(defvoo nntp-open-telnet-envuser nil
"*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
-(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
+(defvoo nntp-telnet-shell-prompt "bash\\|[$>] *\r?$"
"*Regular expression to match the shell prompt on the remote machine.")
(defvoo nntp-rlogin-program "rsh"
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index eacfe01b65d..a3d950aa2b5 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -1,6 +1,6 @@
;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -99,7 +99,7 @@ component group will show up when you enter the virtual group.")
(let ((vbuf (nnheader-set-temp-buffer
(get-buffer-create " *virtual headers*")))
(carticles (nnvirtual-partition-sequence articles))
- (system-name (system-name))
+ (sysname (system-name))
cgroup carticle article result prefix)
(while carticles
(setq cgroup (caar carticles))
@@ -151,7 +151,7 @@ component group will show up when you enter the virtual group.")
;; and clean up the xrefs.
(princ article nntp-server-buffer)
(nnvirtual-update-xref-header cgroup carticle
- prefix system-name)
+ prefix sysname)
(forward-line 1))
)
@@ -378,7 +378,7 @@ component group will show up when you enter the virtual group.")
(mapc 'nnheader-insert-nov headers))))
-(defun nnvirtual-update-xref-header (group article prefix system-name)
+(defun nnvirtual-update-xref-header (group article prefix sysname)
"Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
;; Move to beginning of Xref field, creating a slot if needed.
(beginning-of-line)
@@ -393,7 +393,7 @@ component group will show up when you enter the virtual group.")
(forward-char -1)
(delete-char 1))
- (insert "Xref: " system-name " " group ":")
+ (insert "Xref: " sysname " " group ":")
(princ article (current-buffer))
(insert " ")
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index f21d9d1dc4b..f53e314d1d8 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -1,6 +1,6 @@
;;; nnweb.el --- retrieving articles via web search engines
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
@@ -22,8 +22,6 @@
;;; Commentary:
-;; Note: You need to have `w3' installed for some functions to work.
-
;;; Code:
(eval-when-compile (require 'cl))
@@ -38,7 +36,6 @@
(eval-and-compile
(ignore-errors
(require 'url)))
-(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnweb)
@@ -441,7 +438,7 @@ Valid types include `google', `dejanews', and `gmane'.")
t)
(defun nnweb-google-identity (url)
- "Return an unique identifier based on URL."
+ "Return a unique identifier based on URL."
(if (string-match "selm=\\([^ &>]+\\)" url)
(match-string 1 url)
url))
@@ -527,7 +524,7 @@ Valid types include `google', `dejanews', and `gmane'.")
url))
;;;
-;;; General web/w3 interface utility functions
+;;; General web interface utility functions
;;;
(defun nnweb-insert-html (parse)
diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el
index 5612bee73b6..175e272cb9a 100644
--- a/lisp/gnus/plstore.el
+++ b/lisp/gnus/plstore.el
@@ -1,5 +1,5 @@
;;; plstore.el --- secure plist store -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: PGP, GnuPG
@@ -270,9 +270,16 @@ symmetric encryption will be used.")
context
(cons #'plstore-progress-callback-function
(format "Decrypting %s" (plstore-get-file plstore))))
- (setq plain
- (epg-decrypt-string context
- (plstore--get-encrypted-data plstore)))
+ (condition-case error
+ (setq plain
+ (epg-decrypt-string context
+ (plstore--get-encrypted-data plstore)))
+ (error
+ (let ((entry (assoc (plstore-get-file plstore)
+ plstore-passphrase-alist)))
+ (if entry
+ (setcdr entry nil)))
+ (signal (car error) (cdr error))))
(plstore--set-secret-alist plstore (car (read-from-string plain)))
(plstore--merge-secret plstore)
(plstore--set-encrypted-data plstore nil))))
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 5ccbd197ff0..696c6e46b70 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -1,9 +1,9 @@
;;; pop3.el --- Post Office Protocol (RFC 1460) interface
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -82,7 +82,7 @@
(defcustom pop3-authentication-scheme 'pass
"*POP3 authentication scheme.
Defaults to `pass', for the standard USER/PASS authentication. The other
-valid value is 'apop'."
+valid value is `apop'."
:type '(choice (const :tag "Normal user/password" pass)
(const :tag "APOP" apop))
:version "22.1" ;; Oort Gnus
@@ -107,7 +107,7 @@ days since you first checked new mails. If this is nil, mails will be
deleted on the server right after fetching.
Gnus users should use the `:leave' keyword in a mail source to direct
-the behaviour per server, rather than directly modifying this value.
+the behavior per server, rather than directly modifying this value.
Note that POP servers maintain no state information between sessions,
so what the client believes is there and what is actually there may
@@ -561,6 +561,7 @@ Returns the process associated with the connection."
'tls)
(t
(or pop3-stream-type 'network)))
+ :warn-unless-encrypted t
:capability-command "CAPA\r\n"
:end-of-command "^\\(-ERR\\|+OK\\).*\n"
:end-of-capability "^\\.\r?\n\\|^-ERR"
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 54ab60e851d..6c48f0fc9a4 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -1,6 +1,6 @@
;;; qp.el --- Quoted-Printable functions
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, extensions
diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el
index b056ac5e7f3..9f3f38175bc 100644
--- a/lisp/gnus/registry.el
+++ b/lisp/gnus/registry.el
@@ -1,6 +1,6 @@
;;; registry.el --- Track and remember data items by various fields
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -25,11 +25,11 @@
;; This library provides a general-purpose EIEIO-based registry
;; database with persistence, initialized with these fields:
-;; version: a float, 0.1 currently (don't change it)
+;; version: a float
-;; max-hard: an integer, default 5000000
+;; max-size: an integer, default most-positive-fixnum
-;; max-soft: an integer, default 50000
+;; prune-factor: a float between 0 and 1, default 0.1
;; precious: a list of symbols
@@ -57,14 +57,15 @@
;; Note that whether a field has one or many pieces of data, the data
;; is always a list of values.
-;; The user decides which fields are "precious", F2 for example. At
-;; PRUNE TIME (when the :prune-function is called), the registry will
-;; trim any entries without the F2 field until the size is :max-soft
-;; or less. No entries with the F2 field will be removed at PRUNE
-;; TIME.
+;; The user decides which fields are "precious", F2 for example. When
+;; the registry is pruned, any entries without the F2 field will be
+;; removed until the size is :max-size * :prune-factor _less_ than the
+;; maximum database size. No entries with the F2 field will be removed
+;; at PRUNE TIME, which means it may not be possible to prune back all
+;; the way to the target size.
-;; When an entry is inserted, the registry will reject new entries
-;; if they bring it over the max-hard limit, even if they have the F2
+;; When an entry is inserted, the registry will reject new entries if
+;; they bring it over the :max-size limit, even if they have the F2
;; field.
;; The user decides which fields are "tracked", F1 for example. Any
@@ -82,28 +83,37 @@
(require 'eieio)
(require 'eieio-base)
+;; The version number needs to be kept outside of the class definition
+;; itself. The persistent-save process does *not* write to file any
+;; slot values that are equal to the default :initform value. If a
+;; database object is at the most recent version, therefore, its
+;; version number will not be written to file. That makes it
+;; difficult to know when a database needs to be upgraded.
+(defvar registry-db-version 0.2
+ "The current version of the registry format.")
+
(defclass registry-db (eieio-persistent)
((version :initarg :version
- :initform 0.1
- :type float
- :custom float
+ :initform nil
+ :type (or null float)
:documentation "The registry version.")
- (max-hard :initarg :max-hard
- :initform 5000000
+ (max-size :initarg :max-size
+ ;; EIEIO's :initform is not 100% compatible with CLOS in
+ ;; that if the form is an atom, it assumes it's constant
+ ;; value rather than an expression, so in order to get the value
+ ;; of `most-positive-fixnum', we need to use an
+ ;; expression that's not just a symbol.
+ :initform (symbol-value 'most-positive-fixnum)
:type integer
:custom integer
- :documentation "Never accept more than this many elements.")
- (max-soft :initarg :max-soft
- :initform 50000
- :type integer
- :custom integer
- :documentation "Prune as much as possible to get to this size.")
+ :documentation "The maximum number of registry entries.")
(prune-factor
:initarg :prune-factor
:initform 0.1
:type float
:custom float
- :documentation "At the max-hard limit, prune size * this entries.")
+ :documentation "Prune to (:max-size * :prune-factor) less
+ than the :max-size limit. Should be a float between 0 and 1.")
(tracked :initarg :tracked
:initform nil
:type t
@@ -119,6 +129,23 @@
:type hash-table
:documentation "The data hashtable.")))
+(defmethod initialize-instance :BEFORE ((this registry-db) slots)
+ "Check whether a registry object needs to be upgraded."
+ ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the
+ ;; :max-soft slot to disappear, and the :max-hard slot to be renamed
+ ;; :max-size.
+ (let ((current-version
+ (and (plist-member slots :version)
+ (plist-get slots :version))))
+ (when (or (null current-version)
+ (eql current-version 0.1))
+ (setq slots
+ (plist-put slots :max-size (plist-get slots :max-hard)))
+ (setq slots
+ (plist-put slots :version registry-db-version))
+ (cl-remf slots :max-hard)
+ (cl-remf slots :max-soft))))
+
(defmethod initialize-instance :AFTER ((this registry-db) slots)
"Set value of data slot of THIS after initialization."
(with-slots (data tracker) this
@@ -131,7 +158,7 @@
(defmethod registry-lookup ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
- (let ((data (oref db :data)))
+ (let ((data (oref db data)))
(delq nil
(mapcar
(lambda (k)
@@ -142,7 +169,7 @@ Returns an alist of the key followed by the entry in a list, not a cons cell."
(defmethod registry-lookup-breaks-before-lexbind ((db registry-db) keys)
"Search for KEYS in the registry-db THIS.
Returns an alist of the key followed by the entry in a list, not a cons cell."
- (let ((data (oref db :data)))
+ (let ((data (oref db data)))
(delq nil
(loop for key in keys
when (gethash key data)
@@ -158,8 +185,8 @@ When CREATE is not nil, create the secondary index hashtable if needed."
(when create
(puthash tracksym
(make-hash-table :size 800 :rehash-size 2.0 :test 'equal)
- (oref db :tracker))
- (gethash tracksym (oref db :tracker))))))
+ (oref db tracker))
+ (gethash tracksym (oref db tracker))))))
(defmethod registry-lookup-secondary-value ((db registry-db) tracksym val
&optional set)
@@ -195,15 +222,15 @@ When SET is not nil, set it for VAL (use t for an empty list)."
(defmethod registry-search ((db registry-db) &rest spec)
"Search for SPEC across the registry-db THIS.
-For example calling with :member '(a 1 2) will match entry '((a 3 1)).
-Calling with :all t (any non-nil value) will match all.
-Calling with :regex '\(a \"h.llo\") will match entry '((a \"hullo\" \"bye\").
+For example calling with `:member \\='(a 1 2)' will match entry \((a 3 1)).
+Calling with `:all t' (any non-nil value) will match all.
+Calling with `:regex \\='(a \"h.llo\")' will match entry \(a \"hullo\" \"bye\").
The test order is to check :all first, then :member, then :regex."
(when db
(let ((all (plist-get spec :all))
(member (plist-get spec :member))
(regex (plist-get spec :regex)))
- (loop for k being the hash-keys of (oref db :data)
+ (loop for k being the hash-keys of (oref db data)
using (hash-values v)
when (or
;; :all non-nil returns all
@@ -219,10 +246,10 @@ The test order is to check :all first, then :member, then :regex."
If KEYS is nil, use SPEC to do a search.
Updates the secondary ('tracked') indices as well.
With assert non-nil, errors out if the key does not exist already."
- (let* ((data (oref db :data))
+ (let* ((data (oref db data))
(keys (or keys
(apply 'registry-search db spec)))
- (tracked (oref db :tracked)))
+ (tracked (oref db tracked)))
(dolist (key keys)
(let ((entry (gethash key data)))
@@ -249,31 +276,31 @@ With assert non-nil, errors out if the key does not exist already."
(defmethod registry-size ((db registry-db))
"Returns the size of the registry-db object THIS.
-This is the key count of the :data slot."
- (hash-table-count (oref db :data)))
+This is the key count of the `data' slot."
+ (hash-table-count (oref db data)))
(defmethod registry-full ((db registry-db))
"Checks if registry-db THIS is full."
(>= (registry-size db)
- (oref db :max-hard)))
+ (oref db max-size)))
(defmethod registry-insert ((db registry-db) key entry)
"Insert ENTRY under KEY into the registry-db THIS.
Updates the secondary ('tracked') indices as well.
Errors out if the key exists already."
- (assert (not (gethash key (oref db :data))) nil
+ (assert (not (gethash key (oref db data))) nil
"Key already exists in database")
(assert (not (registry-full db))
nil
- "registry max-hard size limit reached")
+ "registry max-size limit reached")
;; store the entry
- (puthash key entry (oref db :data))
+ (puthash key entry (oref db data))
;; store the secondary indices
- (dolist (tr (oref db :tracked))
+ (dolist (tr (oref db tracked))
;; for every value in the entry under that key...
(dolist (val (cdr-safe (assq tr entry)))
(let* ((value-keys (registry-lookup-secondary-value db tr val)))
@@ -284,8 +311,8 @@ Errors out if the key exists already."
(defmethod registry-reindex ((db registry-db))
"Rebuild the secondary indices of registry-db THIS."
(let ((count 0)
- (expected (* (length (oref db :tracked)) (registry-size db))))
- (dolist (tr (oref db :tracked))
+ (expected (* (length (oref db tracked)) (registry-size db))))
+ (dolist (tr (oref db tracked))
(let (values)
(maphash
(lambda (key v)
@@ -293,65 +320,59 @@ Errors out if the key exists already."
(when (and (< 0 expected)
(= 0 (mod count 1000)))
(message "reindexing: %d of %d (%.2f%%)"
- count expected (/ (* 100 count) expected)))
+ count expected (/ (* 100.0 count) expected)))
(dolist (val (cdr-safe (assq tr v)))
(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))))))
-
-(defmethod registry-prune ((db registry-db) &optional sortfun)
- "Prunes the registry-db object THIS.
-Removes only entries without the :precious keys if it can,
-then removes oldest entries first.
-Returns the number of deleted entries.
-If SORTFUN is given, tries to keep entries that sort *higher*.
-SORTFUN is passed only the two keys so it must look them up directly."
- (dolist (collector '(registry-prune-soft-candidates
- registry-prune-hard-candidates))
- (let* ((size (registry-size db))
- (collected (funcall collector db))
- (limit (nth 0 collected))
- (candidates (nth 1 collected))
- ;; sort the candidates if SORTFUN was given
- (candidates (if sortfun (sort candidates sortfun) candidates))
- (candidates-count (length candidates))
- ;; are we over max-soft?
- (prune-needed (> size limit)))
-
- ;; while we have more candidates than we need to remove...
- (while (and (> candidates-count (- size limit)) candidates)
- (decf candidates-count)
- (setq candidates (cdr candidates)))
-
- (registry-delete db candidates nil)
- (length candidates))))
-
-(defmethod registry-prune-soft-candidates ((db registry-db))
- "Collects pruning candidates from the registry-db object THIS.
-Proposes only entries without the :precious keys."
- (let* ((precious (oref db :precious))
+ (oref db data))))))
+
+(defmethod registry-prune ((db registry-db) &optional sortfunc)
+ "Prunes the registry-db object DB.
+
+Attempts to prune the number of entries down to \(*
+:max-size :prune-factor) less than the max-size limit, so
+pruning doesn't need to happen on every save. Removes only
+entries without the :precious keys, so it may not be possible to
+reach the target limit.
+
+Entries to be pruned are first sorted using SORTFUNC. Entries
+from the front of the list are deleted first.
+
+Returns the number of deleted entries."
+ (let ((size (registry-size db))
+ (target-size
+ (floor (- (oref db max-size)
+ (* (oref db max-size)
+ (oref db prune-factor)))))
+ candidates)
+ (if (registry-full db)
+ (progn
+ (setq candidates
+ (registry-collect-prune-candidates
+ db (- size target-size) sortfunc))
+ (length (registry-delete db candidates nil)))
+ 0)))
+
+(defmethod registry-collect-prune-candidates ((db registry-db) limit sortfunc)
+ "Collects pruning candidates from the registry-db object DB.
+
+Proposes only entries without the :precious keys, and attempts to
+return LIMIT such candidates. If SORTFUNC is provided, sort
+entries first and return candidates from beginning of list."
+ (let* ((precious (oref db precious))
(precious-p (lambda (entry-key)
(cdr (memq (car entry-key) precious))))
- (data (oref db :data))
- (limit (oref db :max-soft))
- (candidates (loop for k being the hash-keys of data
- using (hash-values v)
- when (notany precious-p v)
- collect k)))
- (list limit candidates)))
-
-(defmethod registry-prune-hard-candidates ((db registry-db))
- "Collects pruning candidates from the registry-db object THIS.
-Proposes any entries over the max-hard limit minus size * prune-factor."
- (let* ((data (oref db :data))
- ;; prune to (size * prune-factor) below the max-hard limit so
- ;; we're not pruning all the time
- (limit (max 0 (- (oref db :max-hard)
- (* (registry-size db) (oref db :prune-factor)))))
- (candidates (loop for k being the hash-keys of data
- collect k)))
- (list limit candidates)))
+ (data (oref db data))
+ (candidates (cl-loop for k being the hash-keys of data
+ using (hash-values v)
+ when (notany precious-p v)
+ collect (cons k v))))
+ ;; We want the full entries for sorting, but should only return a
+ ;; list of entry keys.
+ (when sortfunc
+ (setq candidates (sort candidates sortfunc)))
+ (cl-subseq (mapcar #'car candidates) 0 (min limit (length candidates)))))
(provide 'registry)
;;; registry.el ends here
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index 688ba6bbba6..83bda2af8a9 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -1,6 +1,6 @@
;;; rfc1843.el --- HZ (rfc1843) decoding
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: news HZ HZ+ mail i18n
@@ -31,10 +31,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mm-util)
@@ -50,11 +46,11 @@
(defvar rfc1843-hzp-word-regexp
"~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\
-\[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
+[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
(defvar rfc1843-hzp-word-regexp-strictly
"~\\({\\([\041-\167][\041-\176]\\)+\\|\
-\[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
+[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
(defcustom rfc1843-decode-loosely nil
"Loosely check HZ encoding if non-nil.
diff --git a/lisp/gnus/rfc2045.el b/lisp/gnus/rfc2045.el
index 728e3416bcb..5a814e8854f 100644
--- a/lisp/gnus/rfc2045.el
+++ b/lisp/gnus/rfc2045.el
@@ -1,6 +1,6 @@
;;; rfc2045.el --- Functions for decoding rfc2045 headers
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index ebf597423b8..e8a377979ff 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -1,6 +1,6 @@
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -102,7 +102,7 @@ quoted-printable and base64 respectively.")
(eval-and-compile ;; Necessary to hard code them in `rfc2047-decode-region'.
(defconst rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
+ "=\\?\\([^][\000-\040()<>@,;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
\\(B\\?[+/0-9A-Za-z]*=*\
\\|Q\\?[ ->@-~]*\
\\)\\?="
@@ -112,7 +112,7 @@ quoted-printable and base64 respectively.")
;; the characters that those encodings may generally use.
)
(defconst rfc2047-encoded-word-regexp-loose
- "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
+ "=\\?\\([^][\000-\040()<>@,;:*\\\"/?.=]+\\)\\(?:\\*[^?]+\\)?\\?\
\\(B\\?[+/0-9A-Za-z]*=*\
\\|Q\\?\\(?:\\?+[ -<>@-~]\\)?\\(?:[ ->@-~]+\\?+[ -<>@-~]\\)*[ ->@-~]*\\?*\
\\)\\?="
@@ -1136,7 +1136,7 @@ other than `\"' and `\\' in quoted strings."
;; `decode-coding-string' in Emacs offers a third optional
;; arg NOCOPY to avoid consing a new string if the decoding
;; is "trivial". Unfortunately it currently doesn't
- ;; consider anything else than a `nil' coding system
+ ;; consider anything else than a nil coding system
;; trivial.
;; `rfc2047-decode-string' is called multiple times for each
;; article during summary buffer generation, and we really
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index e8d7075bc65..2bc23334199 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -1,6 +1,6 @@
;;; rfc2231.el --- Functions for decoding rfc2231 headers
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
@@ -209,13 +209,14 @@ must never cause a Lisp error."
(defun rfc2231-decode-encoded-string (string)
"Decode an RFC2231-encoded string.
These look like:
- \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
+ \"us-ascii\\='en-us\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"us-ascii\\='\\='This%20is%20%2A%2A%2Afun%2A%2A%2A\",
+ \"\\='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)))
+ (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
diff --git a/lisp/gnus/rtree.el b/lisp/gnus/rtree.el
index a79f7057d07..50a860a5061 100644
--- a/lisp/gnus/rtree.el
+++ b/lisp/gnus/rtree.el
@@ -1,6 +1,6 @@
;;; rtree.el --- functions for manipulating range trees
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -79,11 +79,14 @@
(defmacro rtree-range (node)
`(car ,node))
-(defsubst rtree-normalise-range (range)
+(defsubst rtree-normalize-range (range)
(when (numberp range)
(setq range (cons range range)))
range)
+(define-obsolete-function-alias 'rtree-normalise-range
+ 'rtree-normalize-range "25.1")
+
(defun rtree-make (range)
"Make an rtree from RANGE."
;; Normalize the range.
@@ -96,7 +99,7 @@
(node (rtree-make-node)))
(when (> mid 0)
(rtree-set-left node (rtree-make-1 range mid)))
- (rtree-set-range node (rtree-normalise-range (cadr range)))
+ (rtree-set-range node (rtree-normalize-range (cadr range)))
(setcdr range (cddr range))
(when (> (- length mid 1) 0)
(rtree-set-right node (rtree-make-1 range (- length mid 1))))
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index ec24f1f9670..9fde82c191f 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -1,6 +1,6 @@
;;; score-mode.el --- mode for editing Gnus score files
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
@@ -40,13 +40,13 @@
(defvar gnus-score-edit-exit-function nil
"Function run on exit from the score buffer.")
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
- (setq gnus-score-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map)
- (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
- (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
- (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
+(defvar gnus-score-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map emacs-lisp-mode-map)
+ (define-key map "\C-c\C-c" 'gnus-score-edit-exit)
+ (define-key map "\C-c\C-d" 'gnus-score-edit-insert-date)
+ (define-key map "\C-c\C-p" 'gnus-score-pretty-print)
+ map))
(defvar score-mode-syntax-table
(let ((table (copy-syntax-table lisp-mode-syntax-table)))
@@ -58,21 +58,13 @@
(defvar score-mode-coding-system mm-universal-coding-system)
;;;###autoload
-(defun gnus-score-mode ()
+(define-derived-mode gnus-score-mode emacs-lisp-mode "Score"
"Mode for editing Gnus score files.
This mode is an extended emacs-lisp mode.
\\{gnus-score-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-score-mode-map)
(gnus-score-make-menu-bar)
- (set-syntax-table score-mode-syntax-table)
- (setq major-mode 'gnus-score-mode)
- (setq mode-name "Score")
- (lisp-mode-variables nil)
- (make-local-variable 'gnus-score-edit-exit-function)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
+ (make-local-variable 'gnus-score-edit-exit-function))
(defun gnus-score-make-menu-bar ()
(unless (boundp 'gnus-score-menu)
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index 4221276e2ec..72f22e76b8f 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -1,6 +1,6 @@
;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Albert Krewinkel <tarleb@moltkeplatz.de>
@@ -71,10 +71,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password))
@@ -115,6 +111,10 @@
plain
login)
"Priority of authenticators to consider when authenticating to server."
+ ;; FIXME Improve this. It's not `set'.
+ ;; It's like (repeat (choice (const ...))), where each choice can
+ ;; only appear once.
+ :type '(repeat symbol)
:group 'sieve-manage)
(defcustom sieve-manage-authenticator-alist
@@ -131,6 +131,8 @@
NAME names the authenticator. CHECK is a function returning non-nil if
the server support the authenticator and AUTHENTICATE is a function
for doing the actual authentication."
+ :type '(repeat (list (symbol :tag "Name") (function :tag "Check function")
+ (function :tag "Authentication function")))
:group 'sieve-manage)
(defcustom sieve-manage-default-port "sieve"
diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el
index 64768370488..ffa50e6caa9 100644
--- a/lisp/gnus/sieve-mode.el
+++ b/lisp/gnus/sieve-mode.el
@@ -1,6 +1,6 @@
;;; sieve-mode.el --- Sieve code editing commands for Emacs
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -140,7 +140,8 @@
'sieve-action-commands-face)
;; test commands
(cons (regexp-opt '("address" "allof" "anyof" "exists" "false"
- "true" "header" "not" "size" "envelope")
+ "true" "header" "not" "size" "envelope"
+ "body")
'words)
'sieve-test-commands-face)
(cons "\\Sw+:\\sw+"
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index 42e6330273a..8d40fa455bd 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -1,6 +1,6 @@
;;; sieve.el --- Utilities to manage sieve scripts
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
@@ -275,21 +275,9 @@ Used to bracket operations which move point in the sieve-buffer."
(interactive "d")
(get-char-property (or pos (point)) 'script-name))
-(eval-and-compile
- (defalias 'sieve-make-overlay (if (featurep 'xemacs)
- 'make-extent
- 'make-overlay))
- (defalias 'sieve-overlay-put (if (featurep 'xemacs)
- 'set-extent-property
- 'overlay-put))
- (defalias 'sieve-overlays-at (if (featurep 'xemacs)
- 'extents-at
- 'overlays-at)))
-
(defun sieve-highlight (on)
"Turn ON or off highlighting on the current language overlay."
- (sieve-overlay-put (car (sieve-overlays-at (point)))
- 'face (if on 'highlight 'default)))
+ (overlay-put (car (overlays-at (point))) 'face (if on 'highlight 'default)))
(defun sieve-insert-scripts (scripts)
"Format and insert LANGUAGE-LIST strings into current buffer at point."
@@ -300,11 +288,11 @@ Used to bracket operations which move point in the sieve-buffer."
(if (consp script)
(insert (format " ACTIVE %s" (cdr script)))
(insert (format " %s" script)))
- (setq ext (sieve-make-overlay p (point)))
- (sieve-overlay-put ext 'mouse-face 'highlight)
- (sieve-overlay-put ext 'script-name (if (consp script)
- (cdr script)
- script))
+ (setq ext (make-overlay p (point)))
+ (overlay-put ext 'mouse-face 'highlight)
+ (overlay-put ext 'script-name (if (consp script)
+ (cdr script)
+ script))
(insert "\n"))))
(defun sieve-open-server (server &optional port)
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index eb71134457c..8b8cad71904 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -1,6 +1,6 @@
;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: news mail multimedia
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 2c2775dfbd7..76d58f77354 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -1,6 +1,6 @@
;;; smime.el --- S/MIME support library
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: SMIME X.509 PEM OpenSSL
@@ -118,9 +118,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(require 'dig)
(if (locate-library "password-cache")
@@ -161,7 +158,7 @@ certificates to be sent with every message to each address."
Directory should contain files (in PEM format) named to the X.509
hash of the certificate. This can be done using OpenSSL such as:
-$ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0
+$ ln -s ca.pem \\=`openssl x509 -noout -hash -in ca.pem\\=`.0
where `ca.pem' is the file containing a PEM encoded X.509 CA
certificate."
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 24e1ca7bdab..5871b08b35a 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -1,6 +1,6 @@
;;; spam-report.el --- Reporting spam
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: network, spam, mail, gmane, report
@@ -43,7 +43,7 @@ If you are using spam.el, consider setting gnus-spam-process-newsgroups
or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
instead."
:type '(radio (const nil)
- (regexp :value "^nntp\+.*:gmane\."))
+ (regexp :value "^nntp\\+.*:gmane\\."))
:group 'spam-report)
(defcustom spam-report-gmane-use-article-number t
@@ -307,7 +307,7 @@ symbol `ask', query before flushing the queue file."
(if (or (eq keep nil)
(and (eq keep 'ask)
(y-or-n-p
- (format
+ (gnus-format-message
"Flush requests from `%s'? " (current-buffer)))))
(progn
(gnus-message 7 "Flushing request file `%s'"
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 135bfd48e5f..a8270dc33f2 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -1,6 +1,6 @@
;;; spam-stat.el --- detecting spam based on statistics
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Keywords: network
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index 596c8de683a..515472d0dca 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -1,6 +1,6 @@
;;; spam-wash.el --- wash spam before analysis
-;; Copyright (C) 2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2015 Free Software Foundation, Inc.
;; Author: Andrew Cohen <cohen@andy.bu.edu>
;; Keywords: mail
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 8d689bf26bd..4ebd8a9f838 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -1,6 +1,6 @@
;;; spam.el --- Identifying spam
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
@@ -38,10 +38,6 @@
;;{{{ compilation directives and autoloads/requires
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'message) ;for the message-fetch-field functions
@@ -2058,7 +2054,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(if spam-use-dig
(let ((query-result (query-dig query-string)))
(when query-result
- (gnus-message 6 "(DIG): positive blackhole check '%s'"
+ (gnus-message 6 "(DIG): positive blackhole check `%s'"
query-result)
(push (list ip server query-result)
matches)))
@@ -2236,15 +2232,6 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
;;{{{ spam-stat
-(eval-when-compile
- (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
- (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
- (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
- (autoload 'spam-stat-buffer-is-spam "spam-stat")
- (autoload 'spam-stat-load "spam-stat")
- (autoload 'spam-stat-save "spam-stat")
- (autoload 'spam-stat-split-fancy "spam-stat"))
-
(require 'spam-stat)
(defun spam-check-stat ()
@@ -2903,25 +2890,27 @@ explicitly, and matters only if you need the extra headers
installed through `spam-necessary-extra-headers'."
(interactive)
- (dolist (var symbols)
- (set var t))
-
- (dolist (header (spam-necessary-extra-headers))
- (add-to-list 'nnmail-extra-headers header)
- (add-to-list 'gnus-extra-headers header))
-
- (setq spam-install-hooks t)
- ;; TODO: How do we redo this every time the `spam' face is customized?
- (push '((eq mark gnus-spam-mark) . spam)
- gnus-summary-highlight)
- ;; Add hooks for loading and saving the spam stats
- (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
- (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
- (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
- (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
- (add-hook 'gnus-summary-prepared-hook 'spam-find-spam))
+ (when spam-install-hooks
+ (dolist (var symbols)
+ (set var t))
+
+ (dolist (header (spam-necessary-extra-headers))
+ (add-to-list 'nnmail-extra-headers header)
+ (add-to-list 'gnus-extra-headers header))
+
+ ;; TODO: How do we redo this every time the `spam' face is customized?
+ (push '((eq mark gnus-spam-mark) . spam)
+ gnus-summary-highlight)
+ ;; Add hooks for loading and saving the spam stats
+ (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
+ (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
+ (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
+ (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
+ (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
+ (add-hook 'gnus-summary-prepared-hook 'spam-find-spam)
+ ;; Don't install things more than once.
+ (setq spam-install-hooks nil)))
(defun spam-unload-hook ()
"Uninstall the spam.el hooks."
@@ -2936,8 +2925,6 @@ installed through `spam-necessary-extra-headers'."
(add-hook 'spam-unload-hook 'spam-unload-hook)
-(when spam-install-hooks
- (spam-initialize))
;;}}}
(provide 'spam)
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el
index db6a0f8fd12..cc7192b1aea 100644
--- a/lisp/gnus/starttls.el
+++ b/lisp/gnus/starttls.el
@@ -1,6 +1,6 @@
;;; starttls.el --- STARTTLS functions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Author: Simon Josefsson <simon@josefsson.org>
diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el
index b55b77a383b..c2f8c0e5087 100644
--- a/lisp/gnus/utf7.el
+++ b/lisp/gnus/utf7.el
@@ -1,6 +1,6 @@
;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: utf-8;-*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Jon K Hellan <hellan@acm.org>
;; Maintainer: bugs@gnus.org
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
index 9a5974f2091..cfe9f2ea382 100644
--- a/lisp/gnus/yenc.el
+++ b/lisp/gnus/yenc.el
@@ -1,6 +1,6 @@
;;; yenc.el --- elisp native yenc decoder
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jesper Harder <harder@ifa.au.dk>
;; Keywords: yenc news
diff --git a/lisp/gs.el b/lisp/gs.el
index c773da71ab6..2c232310a42 100644
--- a/lisp/gs.el
+++ b/lisp/gs.el
@@ -1,8 +1,8 @@
;;; gs.el --- interface to Ghostscript
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index f3bcabf0a18..82ca09daa07 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -1,6 +1,6 @@
;;; help-at-pt.el --- local help through the keyboard
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Luc Teirlinck <teirllm@auburn.edu>
;; Keywords: help
@@ -61,13 +61,18 @@ property, or nil, is returned.
If KBD is non-nil, `kbd-help' is used instead, and any
`help-echo' property is ignored. In this case, the return value
can also be t, if that is the value of the `kbd-help' property."
- (let* ((prop (if kbd 'kbd-help 'help-echo))
- (pair (get-char-property-and-overlay (point) prop))
- (val (car pair))
- (ov (cdr pair)))
- (if (functionp val)
- (funcall val (selected-window) (if ov ov (current-buffer)) (point))
- (eval val))))
+ (save-excursion
+ (let* ((prop (if kbd 'kbd-help 'help-echo))
+ (pair (get-char-property-and-overlay (point) prop))
+ (pair (if (car pair) pair
+ (unless (bobp)
+ (backward-char)
+ (get-char-property-and-overlay (point) prop))))
+ (val (car pair))
+ (ov (cdr pair)))
+ (if (functionp val)
+ (funcall val (selected-window) (if ov ov (current-buffer)) (point))
+ (eval val)))))
;;;###autoload
(defun help-at-pt-kbd-string ()
@@ -235,7 +240,13 @@ properties, to enable buffer local values."
(catch 'found
(dolist (prop help-at-pt-display-when-idle)
(if (get-char-property (point) prop)
- (throw 'found t))))))
+ (throw 'found t)))
+ (unless (bobp)
+ (save-excursion
+ (backward-char)
+ (dolist (prop help-at-pt-display-when-idle)
+ (if (get-char-property (point) prop)
+ (throw 'found t))))))))
(or (not (current-message))
(string= (current-message) "Quit"))
(display-local-help t)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 52aa0517fa8..958a0754946 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1,9 +1,9 @@
;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2013 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
;; Package: emacs
@@ -32,8 +32,22 @@
;;; Code:
+(require 'cl-lib)
+(require 'help-mode)
+
+(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.")
+
;; Functions
+(defvar describe-function-orig-buffer nil
+ "Buffer that was current when `describe-function' was invoked.
+Functions on `help-fns-describe-function-functions' can use this
+to get buffer-local values.")
+
;;;###autoload
(defun describe-function (function)
"Display the full documentation of FUNCTION (a symbol)."
@@ -48,124 +62,40 @@
(and fn (symbol-name fn))))
(list (if (equal val "")
fn (intern val)))))
- (if (null function)
- (message "You didn't specify a function")
- (help-setup-xref (list #'describe-function function)
- (called-interactively-p 'interactive))
+ (or (and function (symbolp function))
+ (user-error "You didn't specify a function symbol"))
+ (or (fboundp function)
+ (user-error "Symbol's function definition is void: %s" function))
+
+ ;; We save describe-function-orig-buffer on the help xref stack, so
+ ;; it is restored by the back/forward buttons. 'help-buffer'
+ ;; expects (current-buffer) to be a help buffer when processing
+ ;; those buttons, so we can't change the current buffer before
+ ;; calling that.
+ (let ((describe-function-orig-buffer
+ (or describe-function-orig-buffer
+ (current-buffer))))
+
+ (help-setup-xref
+ (list (lambda (function buffer)
+ (let ((describe-function-orig-buffer
+ (if (buffer-live-p buffer) buffer)))
+ (describe-function function)))
+ function describe-function-orig-buffer)
+ (called-interactively-p 'interactive))
+
(save-excursion
(with-help-window (help-buffer)
- (prin1 function)
- ;; Use " is " instead of a colon so that
- ;; it is easier to get out the function name using forward-sexp.
- (princ " is ")
- (describe-function-1 function)
- (with-current-buffer standard-output
- ;; Return the text we displayed.
- (buffer-string))))))
-
-(defun help-split-fundoc (docstring def)
- "Split a function DOCSTRING into the actual doc and the usage info.
-Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
-is a string describing the argument list of DEF, such as
-\"(apply FUNCTION &rest ARGUMENTS)\".
-DEF is the function whose usage we're looking for in DOCSTRING."
- ;; Functions can get the calling sequence at the end of the doc string.
- ;; In cases where `function' has been fset to a subr we can't search for
- ;; function's name in the doc string so we use `fn' as the anonymous
- ;; function name instead.
- (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
- (cons (format "(%s%s"
- ;; Replace `fn' with the actual function name.
- (if (symbolp def) def "anonymous")
- (match-string 1 docstring))
- (unless (zerop (match-beginning 0))
- (substring docstring 0 (match-beginning 0))))))
-
-;; FIXME: Move to subr.el?
-(defun help-add-fundoc-usage (docstring arglist)
- "Add the usage info to DOCSTRING.
-If DOCSTRING already has a usage info, then just return it unchanged.
-The usage info is built from ARGLIST. DOCSTRING can be nil.
-ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
- (unless (stringp docstring) (setq docstring ""))
- (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)
- (eq arglist t))
- docstring
- (concat docstring
- (if (string-match "\n?\n\\'" docstring)
- (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
- "\n\n")
- (if (and (stringp arglist)
- (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
- (concat "(fn" (match-string 1 arglist) ")")
- (format "%S" (help-make-usage 'fn arglist))))))
-
-;; FIXME: Move to subr.el?
-(defun help-function-arglist (def &optional preserve-names)
- "Return a formal argument list for the function DEF.
-IF PRESERVE-NAMES is non-nil, return a formal arglist that uses
-the same names as used in the original source code, when possible."
- ;; Handle symbols aliased to other symbols.
- (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
- ;; If definition is a macro, find the function inside it.
- (if (eq (car-safe def) 'macro) (setq def (cdr def)))
- (cond
- ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
- ((eq (car-safe def) 'lambda) (nth 1 def))
- ((eq (car-safe def) 'closure) (nth 2 def))
- ((or (and (byte-code-function-p def) (integerp (aref def 0)))
- (subrp def))
- (or (when preserve-names
- (let* ((doc (condition-case nil (documentation def) (error nil)))
- (docargs (if doc (car (help-split-fundoc doc nil))))
- (arglist (if docargs
- (cdar (read-from-string (downcase docargs)))))
- (valid t))
- ;; Check validity.
- (dolist (arg arglist)
- (unless (and (symbolp arg)
- (let ((name (symbol-name arg)))
- (if (eq (aref name 0) ?&)
- (memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
- (setq valid nil)))
- (when valid arglist)))
- (let* ((args-desc (if (not (subrp def))
- (aref def 0)
- (let ((a (subr-arity def)))
- (logior (car a)
- (if (numberp (cdr a))
- (lsh (cdr a) 8)
- (lsh 1 7))))))
- (max (lsh args-desc -8))
- (min (logand args-desc 127))
- (rest (logand args-desc 128))
- (arglist ()))
- (dotimes (i min)
- (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
- (when (> max min)
- (push '&optional arglist)
- (dotimes (i (- max min))
- (push (intern (concat "arg" (number-to-string (+ 1 i min))))
- arglist)))
- (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
- (nreverse arglist))))
- ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
- "[Arg list not available until function definition is loaded.]")
- (t t)))
-
-;; FIXME: Move to subr.el?
-(defun help-make-usage (function arglist)
- (cons (if (symbolp function) function 'anonymous)
- (mapcar (lambda (arg)
- (if (not (symbolp arg)) arg
- (let ((name (symbol-name arg)))
- (cond
- ((string-match "\\`&" name) arg)
- ((string-match "\\`_" name)
- (intern (upcase (substring name 1))))
- (t (intern (upcase name)))))))
- arglist)))
+ (prin1 function)
+ ;; Use " is " instead of a colon so that
+ ;; it is easier to get out the function name using forward-sexp.
+ (princ " is ")
+ (describe-function-1 function)
+ (with-current-buffer standard-output
+ ;; Return the text we displayed.
+ (buffer-string))))
+ ))
+
;; Could be this, if we make symbol-file do the work below.
;; (defun help-C-file-name (subr-or-var kind)
@@ -181,7 +111,7 @@ KIND should be `var' for a variable or `subr' for a subroutine."
(let ((docbuf (get-buffer-create " *DOC*"))
(name (if (eq 'var kind)
(concat "V" (symbol-name subr-or-var))
- (concat "F" (subr-name subr-or-var)))))
+ (concat "F" (subr-name (advice--cd*r subr-or-var))))))
(with-current-buffer docbuf
(goto-char (point-min))
(if (eobp)
@@ -230,7 +160,7 @@ if the variable `help-downcase-arguments' is non-nil."
"\\)"
"\\(?:es\\|s\\|th\\)?" ; for ARGth, ARGs
"\\(?:-[a-z0-9-]+\\)?" ; for ARG-xxx, ARG-n
- "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
+ "\\(?:-[{([<`\"‘].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x', ‘x’
"\\>") ; end of word
(help-highlight-arg arg)
doc t t 1)))
@@ -248,7 +178,7 @@ if the variable `help-downcase-arguments' is non-nil."
(skip-chars-forward "^ ")
(while next
(or opt (not (looking-at " &")) (setq opt t))
- (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &)\.]+\\)" nil t))
+ (if (not (re-search-forward " \\([\\[(]*\\)\\([^] &).]+\\)" nil t))
(setq next nil)
(setq args (cons (match-string 2) args))
(when (and opt (string= (match-string 1) "("))
@@ -280,8 +210,7 @@ OBJECT should be a symbol associated with a function, variable, or face;
alternatively, it can be a function definition.
If TYPE is `defvar', search for a variable definition.
If TYPE is `defface', search for a face definition.
-If TYPE is the value returned by `symbol-function' for a function symbol,
- search for a function definition.
+If TYPE is not a symbol, search for a function definition.
The return value is the absolute name of a readable file where OBJECT is
defined. If several such files exist, preference is given to a file
@@ -291,9 +220,10 @@ suitable file is found, return nil."
(let* ((autoloaded (autoloadp type))
(file-name (or (and autoloaded (nth 1 type))
(symbol-file
- object (if (memq type (list 'defvar 'defface))
- type
- 'defun)))))
+ ;; FIXME: Why do we have this weird "If TYPE is the
+ ;; value returned by `symbol-function' for a function
+ ;; symbol" exception?
+ object (or (if (symbolp type) type) 'defun)))))
(cond
(autoloaded
;; An autoloaded function: Locate the file since `symbol-function'
@@ -367,23 +297,9 @@ suitable file is found, return nil."
lib-name)
file-name))
;; The next three forms are from `find-source-lisp-file'.
- (elc-file (locate-file
- (concat file-name
- (if (string-match "\\.el\\'" file-name)
- "c"
- ".elc"))
- load-path nil 'readable))
- (str (when elc-file
- (with-temp-buffer
- (insert-file-contents-literally elc-file nil 0 256)
- (buffer-string))))
- (src-file (and str
- (string-match ";;; from file \\(.*\\.el\\)" str)
- (match-string 1 str))))
+ (src-file (locate-library file-name t nil 'readable)))
(and src-file (file-readable-p src-file) src-file))))))
-(declare-function ad-get-advice-info "advice" (function))
-
(defun help-fns--key-bindings (function)
(when (commandp function)
(let ((pt2 (with-current-buffer standard-output (point)))
@@ -403,7 +319,7 @@ suitable file is found, return nil."
(when remapped
(princ "Its keys are remapped to ")
(princ (if (symbolp remapped)
- (concat "`" (symbol-name remapped) "'")
+ (format-message "`%s'" remapped)
"an anonymous command"))
(princ ".\n"))
@@ -428,7 +344,7 @@ suitable file is found, return nil."
(with-current-buffer standard-output
(fill-region-as-paragraph pt2 (point))
- (unless (looking-back "\n\n")
+ (unless (looking-back "\n\n" (- (point) 2))
(terpri))))))
(defun help-fns--compiler-macro (function)
@@ -437,21 +353,25 @@ suitable file is found, return nil."
(insert "\nThis function has a compiler macro")
(if (symbolp handler)
(progn
- (insert (format " `%s'" handler))
+ (insert (format-message " `%s'" handler))
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function handler)))
;; FIXME: Obsolete since 24.4.
(let ((lib (get function 'compiler-macro-file)))
(when (stringp lib)
- (insert (format " in `%s'" lib))
+ (insert (format-message " in `%s'" lib))
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function-cmacro function lib)))))
(insert ".\n"))))
-(defun help-fns--signature (function doc real-def real-function)
- (unless (keymapp function) ; If definition is a keymap, skip arglist note.
+(defun help-fns--signature (function doc real-def real-function buffer)
+ "Insert usage at point and return docstring. With highlighting."
+ (if (keymapp function)
+ doc ; If definition is a keymap, skip arglist note.
(let* ((advertised (gethash real-def advertised-signature-table t))
(arglist (if (listp advertised)
advertised (help-function-arglist real-def)))
@@ -460,7 +380,7 @@ suitable file is found, return nil."
(let* ((use (cond
((and usage (not (listp advertised))) (car usage))
((listp arglist)
- (format "%S" (help-make-usage function arglist)))
+ (help--make-usage-docstring function arglist))
((stringp arglist) arglist)
;; Maybe the arglist is in the docstring of a symbol
;; this one is aliased to.
@@ -474,13 +394,27 @@ suitable file is found, return nil."
(car usage))
((or (stringp real-def)
(vectorp real-def))
- (format "\nMacro: %s" (format-kbd-macro real-def)))
+ (format "\nMacro: %s"
+ (help--docstring-quote
+ (format-kbd-macro real-def))))
(t "[Missing arglist. Please make a bug report.]")))
- (high (help-highlight-arguments use doc)))
- (let ((fill-begin (point)))
- (insert (car high) "\n")
- (fill-region fill-begin (point)))
- (cdr high)))))
+ ;; Insert "`X", not "(\` X)", when documenting `X.
+ (use1 (replace-regexp-in-string
+ "\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'"
+ "\\\\=`\\1" use t))
+ (high (if buffer
+ (let (subst-use1 subst-doc)
+ (with-current-buffer buffer
+ (setq subst-use1 (substitute-command-keys use1))
+ (setq subst-doc (substitute-command-keys doc)))
+ (help-highlight-arguments subst-use1 subst-doc))
+ (cons use1 doc))))
+ (let ((fill-begin (point))
+ (high-usage (car high))
+ (high-doc (cdr high)))
+ (insert high-usage "\n")
+ (fill-region fill-begin (point))
+ high-doc)))))
(defun help-fns--parent-mode (function)
;; If this is a derived mode, link to the parent.
@@ -488,13 +422,13 @@ suitable file is found, return nil."
(get function
'derived-mode-parent))))
(when parent-mode
- (insert "\nParent mode: `")
+ (insert (substitute-command-keys "\nParent mode: `"))
(let ((beg (point)))
(insert (format "%s" parent-mode))
(make-text-button beg (point)
'type 'help-function
'help-args (list parent-mode)))
- (insert "'.\n"))))
+ (insert (substitute-command-keys "'.\n")))))
(defun help-fns--obsolete (function)
;; Ignore lambda constructs, keyboard macros, etc.
@@ -510,7 +444,7 @@ suitable file is found, return nil."
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
(insert (cond ((stringp use) (concat ";\n" use))
- (use (format ";\nuse `%s' instead." use))
+ (use (format-message ";\nuse `%s' instead." use))
(t "."))
"\n"))))
@@ -529,35 +463,76 @@ FILE is the file where FUNCTION was probably defined."
(setq load-hist (cdr load-hist)))
found))
+(defun help-fns--interactive-only (function)
+ "Insert some help blurb if FUNCTION should only be used interactively."
+ ;; Ignore lambda constructs, keyboard macros, etc.
+ (and (symbolp function)
+ (not (eq (car-safe (symbol-function function)) 'macro))
+ (let* ((interactive-only
+ (or (get function 'interactive-only)
+ (if (boundp 'byte-compile-interactive-only-functions)
+ (memq function
+ byte-compile-interactive-only-functions)))))
+ (when interactive-only
+ (insert "\nThis function is for interactive use only"
+ ;; Cf byte-compile-form.
+ (cond ((stringp interactive-only)
+ (format ";\nin Lisp code %s" interactive-only))
+ ((and (symbolp 'interactive-only)
+ (not (eq interactive-only t)))
+ (format-message ";\nin Lisp code use `%s' instead."
+ interactive-only))
+ (t "."))
+ "\n")))))
+
+(defun help-fns-short-filename (filename)
+ (let* ((abbrev (abbreviate-file-name filename))
+ (short abbrev))
+ (dolist (dir load-path)
+ (let ((rel (file-relative-name filename dir)))
+ (if (< (length rel) (length short))
+ (setq short rel)))
+ (let ((rel (file-relative-name abbrev dir)))
+ (if (< (length rel) (length short))
+ (setq short rel))))
+ short))
+
;;;###autoload
(defun describe-function-1 (function)
- (let* ((advised (and (symbolp function) (featurep 'advice)
- (ad-get-advice-info function)))
+ (let* ((advised (and (symbolp function)
+ (featurep 'nadvice)
+ (advice--p (advice--symbol-function function))))
;; If the function is advised, use the symbol that has the
;; real definition, if that symbol is already set up.
(real-function
(or (and advised
- (let ((origname (cdr (assq 'origname advised))))
- (and (fboundp origname) origname)))
+ (advice--cd*r (advice--symbol-function function)))
function))
;; Get the real definition.
(def (if (symbolp real-function)
- (symbol-function real-function)
- function))
- (aliased (symbolp def))
- (real-def (if aliased
- (let ((f def))
- (while (and (fboundp f)
- (symbolp (symbol-function f)))
- (setq f (symbol-function f)))
- f)
- def))
+ (or (symbol-function real-function)
+ (signal 'void-function (list real-function)))
+ real-function))
+ (aliased (or (symbolp def)
+ ;; Advised & aliased function.
+ (and advised (symbolp real-function))))
+ (real-def (cond
+ (aliased (let ((f real-function))
+ (while (and (fboundp f)
+ (symbolp (symbol-function f)))
+ (setq f (symbol-function f)))
+ f))
+ ((subrp def) (intern (subr-name def)))
+ (t def)))
+ (sig-key (if (subrp def)
+ (indirect-function real-def)
+ real-def))
(file-name (find-lisp-object-file-name function def))
(pt1 (with-current-buffer (help-buffer) (point)))
(beg (if (and (or (byte-code-function-p def)
(keymapp def)
(memq (car-safe def) '(macro lambda closure)))
- file-name
+ (stringp file-name)
(help-fns--autoloaded-p function file-name))
(if (commandp def)
"an interactive autoloaded "
@@ -571,21 +546,27 @@ FILE is the file where FUNCTION was probably defined."
(if (eq 'unevalled (cdr (subr-arity def)))
(concat beg "special form")
(concat beg "built-in function")))
- ((byte-code-function-p def)
- (concat beg "compiled Lisp function"))
+ ;; Aliases are Lisp functions, so we need to check
+ ;; aliases before functions.
(aliased
- (format "an alias for `%s'" real-def))
- ((eq (car-safe def) 'lambda)
- (concat beg "Lisp function"))
- ((eq (car-safe def) 'macro)
- (concat beg "Lisp macro"))
- ((eq (car-safe def) 'closure)
- (concat beg "Lisp closure"))
+ (format-message "an alias for `%s'" real-def))
((autoloadp def)
(format "%s autoloaded %s"
(if (commandp def) "an interactive" "an")
(if (eq (nth 4 def) 'keymap) "keymap"
(if (nth 4 def) "Lisp macro" "Lisp function"))))
+ ((or (eq (car-safe def) 'macro)
+ ;; For advised macros, def is a lambda
+ ;; expression or a byte-code-function-p, so we
+ ;; need to check macros before functions.
+ (macrop function))
+ (concat beg "Lisp macro"))
+ ((byte-code-function-p def)
+ (concat beg "compiled Lisp function"))
+ ((eq (car-safe def) 'lambda)
+ (concat beg "Lisp function"))
+ ((eq (car-safe def) 'closure)
+ (concat beg "Lisp closure"))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
@@ -602,21 +583,23 @@ FILE is the file where FUNCTION was probably defined."
(with-current-buffer standard-output
(save-excursion
(save-match-data
- (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
+ (when (re-search-backward (substitute-command-keys
+ "alias for `\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function real-def)))))
(when file-name
- (princ " in `")
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
- (princ (if (eq file-name 'C-source)
- "C source code"
- (file-name-nondirectory file-name)))
- (princ "'")
+ (princ (format-message " in `%s'"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (help-fns-short-filename file-name))))
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(with-current-buffer (help-buffer)
@@ -624,27 +607,34 @@ FILE is the file where FUNCTION was probably defined."
(point)))
(terpri)(terpri)
- (let* ((doc-raw (documentation function t))
- ;; If the function is autoloaded, and its docstring has
- ;; key substitution constructs, load the library.
- (doc (progn
- (and (autoloadp real-def) doc-raw
- help-enable-auto-load
- (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]"
- doc-raw)
- (load (cadr real-def) t))
- (substitute-command-keys doc-raw))))
+ (let ((doc-raw (documentation function t))
+ (key-bindings-buffer (current-buffer)))
+
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (and (autoloadp real-def) doc-raw
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+ (autoload-do-load real-def))
(help-fns--key-bindings function)
(with-current-buffer standard-output
- (setq doc (help-fns--signature function doc real-def real-function))
-
- (help-fns--compiler-macro function)
- (help-fns--parent-mode function)
- (help-fns--obsolete function)
-
- (insert "\n"
- (or doc "Not documented.")))))))
+ (let ((doc (help-fns--signature function doc-raw sig-key
+ real-function key-bindings-buffer)))
+ (run-hook-with-args 'help-fns-describe-function-functions function)
+ (insert "\n"
+ (or doc "Not documented."))
+ ;; Avoid asking the user annoying questions if she decides
+ ;; to save the help buffer, when her locale's codeset
+ ;; isn't UTF-8.
+ (unless (memq text-quoting-style '(straight grave))
+ (set-buffer-file-coding-system 'utf-8))))))))
+
+;; Add defaults to `help-fns-describe-function-functions'.
+(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
+(add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only)
+(add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode)
+(add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro)
;; Variables
@@ -748,14 +738,16 @@ it is displayed along with the global value."
(if file-name
(progn
- (princ " is a variable defined in `")
- (princ (if (eq file-name 'C-source)
- "C source code"
- (file-name-nondirectory file-name)))
- (princ "'.\n")
+ (princ (format-message
+ " is a variable defined in `%s'.\n"
+ (if (eq file-name 'C-source)
+ "C source code"
+ (file-name-nondirectory file-name))))
(with-current-buffer standard-output
(save-excursion
- (re-search-backward "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys
+ "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-variable-def
variable file-name)))
(if valvoid
@@ -763,7 +755,7 @@ it is displayed along with the global value."
(princ "Its ")))
(if valvoid
(princ " is void as a variable.")
- (princ "'s "))))
+ (princ (substitute-command-keys "'s ")))))
(unless valvoid
(with-current-buffer standard-output
(setq val-start-pos (point))
@@ -876,16 +868,21 @@ it is displayed along with the global value."
((not permanent-local))
((bufferp locus)
(setq extra-line t)
- (princ " This variable's buffer-local value is permanent.\n"))
+ (princ
+ (substitute-command-keys
+ " This variable's buffer-local value is permanent.\n")))
(t
(setq extra-line t)
- (princ " This variable's value is permanent \
-if it is given a local binding.\n")))
+ (princ (substitute-command-keys
+ " This variable's value is permanent \
+if it is given a local binding.\n"))))
;; Mention if it's an alias.
(unless (eq alias variable)
(setq extra-line t)
- (princ (format " This variable is an alias for `%s'.\n" alias)))
+ (princ (format-message
+ " This variable is an alias for `%s'.\n"
+ alias)))
(when obsolete
(setq extra-line t)
@@ -893,19 +890,26 @@ if it is given a local binding.\n")))
(if (nth 2 obsolete)
(princ (format " since %s" (nth 2 obsolete))))
(princ (cond ((stringp use) (concat ";\n " use))
- (use (format ";\n use `%s' instead." (car obsolete)))
+ (use (format-message ";\n use `%s' instead."
+ (car obsolete)))
(t ".")))
(terpri))
- (when (member (cons variable val) file-local-variables-alist)
+ (when (member (cons variable val)
+ (with-current-buffer buffer
+ file-local-variables-alist))
(setq extra-line t)
- (if (member (cons variable val) dir-local-variables-alist)
- (let ((file (and (buffer-file-name)
- (not (file-remote-p (buffer-file-name)))
+ (if (member (cons variable val)
+ (with-current-buffer buffer
+ dir-local-variables-alist))
+ (let ((file (and (buffer-file-name buffer)
+ (not (file-remote-p
+ (buffer-file-name buffer)))
(dir-locals-find-file
- (buffer-file-name))))
+ (buffer-file-name buffer))))
(dir-file t))
- (princ " This variable's value is directory-local")
+ (princ (substitute-command-keys
+ " This variable's value is directory-local"))
(if (null file)
(princ ".\n")
(princ ", set ")
@@ -916,16 +920,19 @@ if it is given a local binding.\n")))
(setq file (expand-file-name
dir-locals-file (car file)))
;; Otherwise, assume it was set directly.
- (setq dir-file nil)))
- (princ (if dir-file
- "by the file\n `"
- "for the directory\n `"))
+ (setq file (car file)
+ dir-file nil)))
+ (princ (substitute-command-keys
+ (if dir-file
+ "by the file\n `"
+ "for the directory\n `")))
(with-current-buffer standard-output
(insert-text-button
file 'type 'help-dir-local-var-def
'help-args (list variable file)))
- (princ "'.\n")))
- (princ " This variable's value is file-local.\n")))
+ (princ (substitute-command-keys "'.\n"))))
+ (princ (substitute-command-keys
+ " This variable's value is file-local.\n"))))
(when (memq variable ignored-local-variables)
(setq extra-line t)
@@ -938,8 +945,9 @@ variable.\n"))
(princ " This variable may be risky if used as a \
file-local variable.\n")
(when (assq variable safe-local-variable-values)
- (princ " However, you have added it to \
-`safe-local-variable-values'.\n")))
+ (princ (substitute-command-keys
+ " However, you have added it to \
+`safe-local-variable-values'.\n"))))
(when safe-var
(setq extra-line t)
@@ -947,7 +955,7 @@ file-local variable.\n")
(princ "if its value\n satisfies the predicate ")
(princ (if (byte-code-function-p safe-var)
"which is a byte-compiled expression.\n"
- (format "`%s'.\n" safe-var))))
+ (format-message "`%s'.\n" safe-var))))
(if extra-line (terpri))
(princ "Documentation:\n")
@@ -965,7 +973,7 @@ file-local variable.\n")
(re-search-backward
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-variable variable))))
- ;; Note variable's version or package version
+ ;; Note variable's version or package version.
(let ((output (describe-variable-custom-version-info variable)))
(when output
(terpri)
@@ -977,6 +985,70 @@ file-local variable.\n")
(buffer-string))))))))
+(defvar help-xref-stack-item)
+
+;;;###autoload
+(defun describe-symbol (symbol &optional buffer frame)
+ "Display the full documentation of SYMBOL.
+Will show the info of SYMBOL as a function, variable, and/or face."
+ (interactive
+ (let* ((v-or-f (symbol-at-point))
+ (found (cl-some (lambda (x) (funcall (nth 1 x) v-or-f))
+ describe-symbol-backends))
+ (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: ")
+ obarray
+ (lambda (vv)
+ (cl-some (lambda (x) (funcall (nth 1 x) vv))
+ describe-symbol-backends))
+ t nil nil
+ (if found (symbol-name v-or-f)))))
+ (list (if (equal val "")
+ 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)))
+ (unless (frame-live-p frame) (setq frame (selected-frame)))
+ (with-current-buffer (help-buffer)
+ ;; Push the previous item on the stack before clobbering the output buffer.
+ (help-setup-xref nil nil)
+ (let* ((docs
+ (nreverse
+ (delq nil
+ (mapcar (pcase-lambda (`(,name ,testfn ,descfn))
+ (when (funcall testfn symbol)
+ ;; Don't record the current entry in the stack.
+ (setq help-xref-stack-item nil)
+ (cons name
+ (funcall descfn symbol buffer frame))))
+ describe-symbol-backends))))
+ (single (null (cdr docs))))
+ (while (cdr docs)
+ (goto-char (point-min))
+ (let ((inhibit-read-only t)
+ (name (caar docs)) ;Name of doc currently at BOB.
+ (doc (cdr (cadr docs)))) ;Doc to add at BOB.
+ (insert doc)
+ (delete-region (point) (progn (skip-chars-backward " \t\n") (point)))
+ (insert "\n\n"
+ (eval-when-compile
+ (propertize "\n" 'face '(:height 0.1 :inverse-video t)))
+ "\n")
+ (when name
+ (insert (symbol-name symbol)
+ " is also a " name "." "\n\n")))
+ (setq docs (cdr docs)))
+ (unless single
+ ;; Don't record the `describe-variable' item in the stack.
+ (setq help-xref-stack-item nil)
+ (help-setup-xref (list #'describe-symbol symbol) nil))
+ (goto-char (point-min)))))
+
;;;###autoload
(defun describe-syntax (&optional buffer)
"Describe the syntax specifications in the syntax table of BUFFER.
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index f0fda357705..c3ec9682e53 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -1,9 +1,9 @@
;;; help-macro.el --- makes command line help such as help-for-help
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Lynn Slater <lrs@indetech.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: Mon Oct 1 11:42:39 1990
;; Adapted-By: ESR
;; Package: emacs
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 5553556e03c..22e5386bedc 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,9 +1,9 @@
;;; help-mode.el --- `help-mode' used by *Help* buffers
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2013 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
;; Package: emacs
@@ -30,6 +30,7 @@
;;; Code:
(require 'button)
+(require 'cl-lib)
(eval-when-compile (require 'easymenu))
(defvar help-mode-map
@@ -37,6 +38,8 @@
(set-keymap-parent map (make-composed-keymap button-buffer-map
special-mode-map))
(define-key map [mouse-2] 'help-follow-mouse)
+ (define-key map "l" 'help-go-back)
+ (define-key map "r" 'help-go-forward)
(define-key map "\C-c\C-b" 'help-go-back)
(define-key map "\C-c\C-f" 'help-go-forward)
(define-key map [XF86Back] 'help-go-back)
@@ -146,7 +149,7 @@ The format is (FUNCTION ARGS...).")
(define-button-type 'help-symbol
:supertype 'help-xref
- 'help-function #'help-xref-interned
+ 'help-function #'describe-symbol
'help-echo (purecopy "mouse-2, RET: describe this symbol"))
(define-button-type 'help-back
@@ -189,7 +192,7 @@ The format is (FUNCTION ARGS...).")
(define-button-type 'help-function-def
:supertype 'help-xref
- 'help-function (lambda (fun file)
+ 'help-function (lambda (fun file &optional type)
(require 'find-func)
(when (eq file 'C-source)
(setq file
@@ -197,7 +200,7 @@ The format is (FUNCTION ARGS...).")
;; Don't use find-function-noselect because it follows
;; aliases (which fails for built-in functions).
(let ((location
- (find-function-search-for-symbol fun nil file)))
+ (find-function-search-for-symbol fun type file)))
(pop-to-buffer (car location))
(if (cdr location)
(goto-char (cdr location))
@@ -214,7 +217,8 @@ The format is (FUNCTION ARGS...).")
(goto-char (point-min))
(if (re-search-forward
(format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s"
- (regexp-quote (symbol-name fun))) nil t)
+ (regexp-quote (symbol-name fun)))
+ nil t)
(forward-line 0)
(message "Unable to find location in file")))
(message "Unable to find file")))
@@ -290,21 +294,15 @@ Commands:
;;;###autoload
(defun help-mode-setup ()
+ "Enter Help Mode in the current buffer."
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
- (when (eq major-mode 'help-mode)
+ "Finalize Help Mode setup in current buffer."
+ (when (derived-mode-p 'help-mode)
(setq buffer-read-only t)
- (save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (when (re-search-forward "^This [^[:space:]]+ is advised.$" nil t)
- (put-text-property (match-beginning 0)
- (match-end 0)
- 'face 'font-lock-warning-face))))
-
(help-make-xrefs (current-buffer))))
;; Grokking cross-reference information in doc strings and
@@ -328,7 +326,7 @@ Commands:
"\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)"
"[ \t\n]+\\)?"
;; Note starting with word-syntax character:
- "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'"))
+ "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))
"Regexp matching doc string references to symbols.
The words preceding the quoted symbol can be used in doc strings to
@@ -343,11 +341,12 @@ when help commands related to multilingual environment (e.g.,
(defconst help-xref-info-regexp
- (purecopy "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+`\\([^']+\\)'")
+ (purecopy
+ "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]")
"Regexp matching doc string references to an Info node.")
(defconst help-xref-url-regexp
- (purecopy "\\<[Uu][Rr][Ll][ \t\n]+`\\([^']+\\)'")
+ (purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]")
"Regexp matching doc string references to a URL.")
;;;###autoload
@@ -390,6 +389,15 @@ it does not already exist."
(error "Current buffer is not in Help mode"))
(current-buffer))))
+(defvar describe-symbol-backends
+ `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
+ ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
+ (nil
+ ,(lambda (symbol)
+ (or (and (boundp symbol) (not (keywordp symbol)))
+ (get symbol 'variable-documentation)))
+ ,#'describe-variable)))
+
;;;###autoload
(defun help-make-xrefs (&optional buffer)
"Parse and hyperlink documentation cross-references in the given BUFFER.
@@ -492,28 +500,9 @@ that."
;; (pop-to-buffer (car location))
;; (goto-char (cdr location))))
(help-xref-button 8 'help-function-def sym))
- ((and
- (facep sym)
- (save-match-data (looking-at "[ \t\n]+face\\W")))
- (help-xref-button 8 'help-face sym))
- ((and (or (boundp sym)
- (get sym 'variable-documentation))
- (fboundp sym))
- ;; We can't intuit whether to use the
- ;; variable or function doc -- supply both.
- (help-xref-button 8 'help-symbol sym))
- ((and
- (or (boundp sym)
- (get sym 'variable-documentation))
- (or
- (documentation-property
- sym 'variable-documentation)
- (documentation-property
- (indirect-variable sym)
- 'variable-documentation)))
- (help-xref-button 8 'help-variable sym))
- ((fboundp sym)
- (help-xref-button 8 'help-function sym)))))))
+ ((cl-some (lambda (x) (funcall (nth 1 x) sym))
+ describe-symbol-backends)
+ (help-xref-button 8 'help-symbol sym)))))))
;; An obvious case of a key substitution:
(save-excursion
(while (re-search-forward
@@ -627,57 +616,9 @@ See `help-make-xrefs'."
;; Additional functions for (re-)creating types of help buffers.
-(defun help-xref-interned (symbol)
- "Follow a hyperlink which appeared to be an arbitrary interned SYMBOL.
-Both variable, function and face documentation are extracted into a single
-help buffer."
- (with-current-buffer (help-buffer)
- ;; Push the previous item on the stack before clobbering the output buffer.
- (help-setup-xref nil nil)
- (let ((facedoc (when (facep symbol)
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (describe-face symbol)))
- (fdoc (when (fboundp symbol)
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (describe-function symbol)))
- (sdoc (when (or (boundp symbol)
- (get symbol 'variable-documentation))
- ;; Don't record the current entry in the stack.
- (setq help-xref-stack-item nil)
- (describe-variable symbol))))
- (cond
- (sdoc
- ;; We now have a help buffer on the variable.
- ;; Insert the function and face text before it.
- (when (or fdoc facedoc)
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (when fdoc
- (insert fdoc "\n\n")
- (when facedoc
- (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
- " is also a " "face." "\n\n")))
- (when facedoc
- (insert facedoc "\n\n"))
- (insert (make-string 30 ?-) "\n\n" (symbol-name symbol)
- " is also a " "variable." "\n\n"))
- ;; Don't record the `describe-variable' item in the stack.
- (setq help-xref-stack-item nil)
- (help-setup-xref (list #'help-xref-interned symbol) nil)))
- (fdoc
- ;; We now have a help buffer on the function.
- ;; Insert face text before it.
- (when facedoc
- (goto-char (point-max))
- (let ((inhibit-read-only t))
- (insert "\n\n" (make-string 30 ?-) "\n\n" (symbol-name symbol)
- " is also a " "face." "\n\n" facedoc))
- ;; Don't record the `describe-function' item in the stack.
- (setq help-xref-stack-item nil)
- (help-setup-xref (list #'help-xref-interned symbol) nil))))
- (goto-char (point-min)))))
+
+;;;###autoload
+(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
;; Navigation/hyperlinking with xrefs
@@ -727,14 +668,14 @@ help buffer."
(interactive)
(if help-xref-stack
(help-xref-go-back (current-buffer))
- (error "No previous help buffer")))
+ (user-error "No previous help buffer")))
(defun help-go-forward ()
- "Go back to next topic in this help buffer."
+ "Go to the next topic in this help buffer."
(interactive)
(if help-xref-forward-stack
(help-xref-go-forward (current-buffer))
- (error "No next help buffer")))
+ (user-error "No next help buffer")))
(defun help-do-xref (_pos function args)
"Call the help cross-reference function FUNCTION with args ARGS.
@@ -742,7 +683,8 @@ Things are set up properly so that the resulting help-buffer has
a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
- (apply function args)))
+ (apply function (if (eq function 'info)
+ (append args (list (generate-new-buffer-name "*info*"))) args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
@@ -756,7 +698,7 @@ a proper [back] button."
For the cross-reference format, see `help-make-xrefs'."
(interactive)
- (error "No cross-reference here"))
+ (user-error "No cross-reference here"))
(defun help-follow-symbol (&optional pos)
"In help buffer, show docs for symbol at POS, defaulting to point.
@@ -775,7 +717,7 @@ Show all docs for that symbol as either a variable, function or face."
(when (or (boundp sym)
(get sym 'variable-documentation)
(fboundp sym) (facep sym))
- (help-do-xref pos #'help-xref-interned (list sym)))))
+ (help-do-xref pos #'describe-symbol (list sym)))))
(defun help-mode-revert-buffer (_ignore-auto noconfirm)
(when (or noconfirm (yes-or-no-p "Revert help buffer? "))
diff --git a/lisp/help.el b/lisp/help.el
index 4ec0b99a593..c558b652b7e 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,9 +1,9 @@
;;; help.el --- help commands for Emacs
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2013 Free Software
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
;; Package: emacs
@@ -24,7 +24,7 @@
;;; Commentary:
-;; This code implements GNU Emacs's on-line help system, the one invoked by
+;; This code implements GNU Emacs's built-in help system, the one invoked by
;; `M-x help-for-help'.
;;; Code:
@@ -47,6 +47,9 @@
(defvar help-window-point-marker (make-marker)
"Marker to override default `window-point' in help windows.")
+(defvar help-window-old-frame nil
+ "Frame selected at the time `with-help-window' is invoked.")
+
(defvar help-map
(let ((map (make-sparse-keymap)))
(define-key map (char-to-string help-char) 'help-for-help)
@@ -92,6 +95,7 @@
(define-key map "k" 'describe-key)
(define-key map "l" 'view-lossage)
(define-key map "m" 'describe-mode)
+ (define-key map "o" 'describe-symbol)
(define-key map "n" 'view-emacs-news)
(define-key map "p" 'finder-by-keyword)
(define-key map "P" 'describe-package)
@@ -133,7 +137,9 @@ This function assumes that `standard-output' is the help buffer.
It computes a message, and applies the optional argument FUNCTION to it.
If FUNCTION is nil, it applies `message', thus displaying the message.
In addition, this function sets up `help-return-method', which see, that
-specifies what to do when the user exits the help buffer."
+specifies what to do when the user exits the help buffer.
+
+Do not call this in the scope of `with-help-window'."
(and (not (get-buffer-window standard-output))
(let ((first-message
(cond ((or
@@ -201,22 +207,24 @@ d PATTERN Show a list of functions, variables, and other items whose
documentation matches the PATTERN (a list of words or a regexp).
e Go to the *Messages* buffer which logs echo-area messages.
f FUNCTION Display documentation for the given function.
-F COMMAND Show the on-line manual's section that describes the command.
+F COMMAND Show the Emacs manual's section that describes the command.
g Display information about the GNU project.
h Display the HELLO file which illustrates various scripts.
-i Start the Info documentation reader: read on-line manuals.
+i Start the Info documentation reader: read included manuals.
I METHOD Describe a specific input method, or RET for current.
k KEYS Display the full documentation for the key sequence.
-K KEYS Show the on-line manual's section for the command bound to KEYS.
+K KEYS Show the Emacs manual's section for the command bound to KEYS.
l Show last 300 input keystrokes (lossage).
L LANG-ENV Describes a specific language environment, or RET for current.
m Display documentation of current minor modes and current major mode,
including their special commands.
n Display news of recent Emacs changes.
+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.
s Display contents of current syntax table, plus explanations.
-S SYMBOL Show the section for the given symbol in the on-line manual
+S SYMBOL Show the section for the given symbol in the Info manual
for the programming language used in this buffer.
t Start the Emacs learn-by-doing tutorial.
v VARIABLE Display the given variable's documentation and value.
@@ -294,10 +302,11 @@ If that doesn't give a function, return nil."
(interactive)
(view-help-file "COPYING"))
+;; Maybe this command should just be removed.
(defun describe-gnu-project ()
- "Display info on the GNU project."
+ "Browse online information on the GNU project."
(interactive)
- (view-help-file "THE-GNU-PROJECT"))
+ (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
(define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2")
@@ -346,12 +355,12 @@ With argument, display info only for the selected version."
(while (re-search-forward
(if (member file '("NEWS.18" "NEWS.1-17"))
"Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
- "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
+ "^\\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
(setq res (cons (match-string-no-properties 1) res)))))
(cons "NEWS"
(directory-files data-directory nil
"^NEWS\\.[0-9][-0-9]*$" nil)))
- (sort (delete-dups res) (lambda (a b) (string< b a)))))
+ (sort (delete-dups res) #'string>)))
(current (car all-versions)))
(setq version (completing-read
(format "Read NEWS for the version (default %s): " current)
@@ -383,7 +392,7 @@ With argument, display info only for the selected version."
(when (re-search-forward
(concat (if (< vn 19)
"Changes in Emacs[ \t]*"
- "^\* [^0-9\n]*") version "$")
+ "^\\* [^0-9\n]*") version "$")
nil t)
(beginning-of-line)
(narrow-to-region
@@ -393,7 +402,7 @@ With argument, display info only for the selected version."
(re-search-forward
(if (< vn 19)
"Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
- "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
+ "^\\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
(equal (match-string-no-properties 1) version)))
(or res (goto-char (point-max)))
(beginning-of-line)
@@ -412,14 +421,15 @@ With argument, display info only for the selected version."
The number of messages retained in that buffer
is specified by the variable `message-log-max'."
(interactive)
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (messages-buffer)
(goto-char (point-max))
(display-buffer (current-buffer))))
(defun view-order-manuals ()
- "Display the Emacs ORDERS file."
+ "Display information on how to buy printed copies of Emacs manuals."
(interactive)
- (view-help-file "ORDERS"))
+;; (view-help-file "ORDERS")
+ (info "(emacs)Printed Books"))
(defun view-emacs-FAQ ()
"Display the Emacs Frequently Asked Questions (FAQ) file."
@@ -437,31 +447,39 @@ is specified by the variable `message-log-max'."
(interactive)
(view-help-file "DEBUG"))
+;; This used to visit MORE.STUFF; maybe it should just be removed.
(defun view-external-packages ()
- "Display external packages and information about Emacs."
+ "Display info on where to get more Emacs packages."
(interactive)
- (view-help-file "MORE.STUFF"))
+ (info "(efaq)Packages that do not come with Emacs"))
(defun view-lossage ()
- "Display last 300 input keystrokes.
+ "Display last few input keystrokes and the commands run.
-To record all your input on a file, use `open-dribble-file'."
+To record all your input, use `open-dribble-file'."
(interactive)
(help-setup-xref (list #'view-lossage)
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
+ (princ " ")
(princ (mapconcat (lambda (key)
- (if (or (integerp key) (symbolp key) (listp key))
- (single-key-description key)
- (prin1-to-string key nil)))
- (recent-keys)
+ (cond
+ ((and (consp key) (null (car key)))
+ (format "[%s]\n" (if (symbolp (cdr key)) (cdr key)
+ "anonymous-command")))
+ ((or (integerp key) (symbolp key) (listp key))
+ (single-key-description key))
+ (t
+ (prin1-to-string key nil))))
+ (recent-keys 'include-cmds)
" "))
(with-current-buffer standard-output
(goto-char (point-min))
- (while (progn (move-to-column 50) (not (eobp)))
- (when (search-forward " " nil t)
- (delete-char -1))
- (insert "\n"))
+ (while (not (eobp))
+ (move-to-column 50)
+ (unless (eolp)
+ (fill-region (line-beginning-position) (line-end-position)))
+ (forward-line 1))
;; jidanni wants to see the last keystrokes immediately.
(set-marker help-window-point-marker (point)))))
@@ -469,8 +487,8 @@ To record all your input on a file, use `open-dribble-file'."
;; Key bindings
(defun describe-bindings (&optional prefix buffer)
- "Show a list of all defined keys, and their definitions.
-We put that list in a buffer, and display the buffer.
+ "Display a buffer showing a list of all defined keys, and their definitions.
+The keys are displayed in order of precedence.
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix.
@@ -481,8 +499,11 @@ or a buffer name."
(or buffer (setq buffer (current-buffer)))
(help-setup-xref (list #'describe-bindings prefix buffer)
(called-interactively-p 'interactive))
- (with-current-buffer buffer
- (describe-bindings-internal nil prefix)))
+ (with-help-window (help-buffer)
+ ;; Be aware that `describe-buffer-bindings' puts its output into
+ ;; the current buffer.
+ (with-current-buffer (help-buffer)
+ (describe-buffer-bindings buffer prefix))))
;; This function used to be in keymap.c.
(defun describe-bindings-internal (&optional menus prefix)
@@ -493,9 +514,12 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
\(Ordinarily these are omitted from the output.)
The optional argument PREFIX, if non-nil, should be a key sequence;
then we display only bindings that start with that prefix."
+ (declare (obsolete describe-buffer-bindings "24.4"))
(let ((buf (current-buffer)))
- (with-help-window "*Help*"
- (with-current-buffer standard-output
+ (with-help-window (help-buffer)
+ ;; Be aware that `describe-buffer-bindings' puts its output into
+ ;; the current buffer.
+ (with-current-buffer (help-buffer)
(describe-buffer-bindings buf prefix menus)))))
(defun where-is (definition &optional insert)
@@ -510,8 +534,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
(if fn
(format "Where is command (default %s): " fn)
"Where is command: ")
- obarray 'commandp t))
- (list (if (equal val "") fn (intern val)) current-prefix-arg)))
+ obarray 'commandp t nil nil
+ (and fn (symbol-name fn))))
+ (list (unless (equal val "") (intern val))
+ current-prefix-arg)))
(unless definition (error "No command"))
(let ((func (indirect-function definition))
(defs nil)
@@ -637,6 +663,69 @@ temporarily enables it to allow getting help on disabled items and buttons."
(princ (format "%s%s is undefined" key-desc mouse-msg))
(princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
+(defun help--key-binding-keymap (key &optional accept-default no-remap position)
+ "Return a keymap holding a binding for KEY within current keymaps.
+The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
+POSITION is as documented in the function `key-binding'."
+ (let* ((active-maps (current-active-maps t position))
+ map found)
+ ;; We loop over active maps like key-binding does.
+ (while (and
+ (not found)
+ (setq map (pop active-maps)))
+ (setq found (lookup-key map key accept-default))
+ (when (integerp found)
+ ;; The first `found' characters of KEY were found but not the
+ ;; whole sequence.
+ (setq found nil)))
+ (when found
+ (if (and (symbolp found)
+ (not no-remap)
+ (command-remapping found))
+ ;; The user might want to know in which map the binding is
+ ;; found, or in which map the remapping is found. The
+ ;; default is to show the latter.
+ (help--key-binding-keymap (vector 'remap found))
+ map))))
+
+(defun help--binding-locus (key position)
+ "Describe in which keymap KEY is defined.
+Return a symbol pointing to that keymap if one exists ; otherwise
+return nil. The argument POSITION is as documented in the
+function `key-binding'."
+ (let ((map (help--key-binding-keymap key t nil position)))
+ (when map
+ (catch 'found
+ (let ((advertised-syms (nconc
+ (list 'overriding-terminal-local-map
+ 'overriding-local-map)
+ (delq nil
+ (mapcar
+ (lambda (mode-and-map)
+ (let ((mode (car mode-and-map)))
+ (when (symbol-value mode)
+ (intern-soft
+ (format "%s-map" mode)))))
+ minor-mode-map-alist))
+ (list 'global-map
+ (intern-soft (format "%s-map" major-mode)))))
+ found)
+ ;; Look into these advertised symbols first.
+ (dolist (sym advertised-syms)
+ (when (and
+ (boundp sym)
+ (eq map (symbol-value sym)))
+ (throw 'found sym)))
+ ;; Only look in other symbols otherwise.
+ (mapatoms
+ (lambda (x)
+ (when (and (boundp x)
+ ;; Avoid let-bound symbols.
+ (special-variable-p x)
+ (eq (symbol-value x) map))
+ (throw 'found x))))
+ nil)))))
+
(defun describe-key (&optional key untranslated up-event)
"Display documentation of the function invoked by KEY.
KEY can be any kind of a key sequence; it can include keyboard events,
@@ -699,6 +788,7 @@ temporarily enables it to allow getting help on disabled items and buttons."
(mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
(memq 'drag modifiers)) " at that spot" ""))
(defn (key-binding key t))
+ key-locus key-locus-up key-locus-up-tricky
defn-up defn-up-tricky ev-type
mouse-1-remapped mouse-1-tricky)
@@ -737,15 +827,19 @@ temporarily enables it to allow getting help on disabled items and buttons."
(setcar up-event (elt mouse-1-remapped 0)))
(t (setcar up-event 'mouse-2))))
(setq defn-up (key-binding sequence nil nil (event-start up-event)))
+ (setq key-locus-up (help--binding-locus sequence (event-start up-event)))
(when mouse-1-tricky
(setq sequence (vector up-event))
(aset sequence 0 'mouse-1)
- (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
+ (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
+ (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
+ (setq key-locus (help--binding-locus key (event-start event)))
(with-help-window (help-buffer)
(princ (help-key-description key untranslated))
- (princ (format "\
-%s runs the command %S, which is "
- mouse-msg defn))
+ (princ (format "%s runs the command %S%s, which is "
+ mouse-msg defn (if key-locus
+ (format " (found in %s)" key-locus)
+ "")))
(describe-function-1 defn)
(when up-event
(unless (or (null defn-up)
@@ -755,13 +849,15 @@ temporarily enables it to allow getting help on disabled items and buttons."
----------------- up-event %s----------------
-%s%s%s runs the command %S, which is "
+%s%s%s runs the command %S%s, which is "
(if mouse-1-tricky "(short click) " "")
(key-description (vector up-event))
mouse-msg
(if mouse-1-remapped
" is remapped to <mouse-2>, which" "")
- defn-up))
+ defn-up (if key-locus-up
+ (format " (found in %s)" key-locus-up)
+ "")))
(describe-function-1 defn-up))
(unless (or (null defn-up-tricky)
(integerp defn-up-tricky)
@@ -771,10 +867,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
----------------- up-event (long click) ----------------
Pressing <%S>%s for longer than %d milli-seconds
-runs the command %S, which is "
+runs the command %S%s, which is "
ev-type mouse-msg
mouse-1-click-follows-link
- defn-up-tricky))
+ defn-up-tricky (if key-locus-up-tricky
+ (format " (found in %s)" key-locus-up-tricky)
+ "")))
(describe-function-1 defn-up-tricky)))))))
(defun describe-mode (&optional buffer)
@@ -866,11 +964,13 @@ documentation for the major and minor modes of that buffer."
(let* ((mode major-mode)
(file-name (find-lisp-object-file-name mode nil)))
(when file-name
- (princ (concat " defined in `" (file-name-nondirectory 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 "`\\([^`']+\\)'" nil t)
+ (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
+ nil t)
(help-xref-button 1 'help-function-def mode file-name)))))
(princ ":\n")
(princ (documentation major-mode)))))
@@ -984,6 +1084,23 @@ function is called, the window to be resized is selected."
:group 'help
:version "24.3")
+(defcustom temp-buffer-max-width
+ (lambda (buffer)
+ (if (eq (selected-window) (frame-root-window))
+ (/ (x-display-pixel-width) (frame-char-width) 2)
+ (/ (- (frame-width) 2) 2)))
+ "Maximum width of a window displaying a temporary buffer.
+This is effective only when Temp Buffer Resize mode is enabled.
+The value is the maximum width (in columns) which
+`resize-temp-buffer-window' will give to a window displaying a
+temporary buffer. It can also be a function to be called to
+choose the width for such a buffer. It gets one argument, the
+buffer, and should return a positive integer. At the time the
+function is called, the window to be resized is selected."
+ :type '(choice integer function)
+ :group 'help
+ :version "24.4")
+
(define-minor-mode temp-buffer-resize-mode
"Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
@@ -1011,46 +1128,66 @@ and some others."
(defun resize-temp-buffer-window (&optional window)
"Resize WINDOW to fit its contents.
-WINDOW can be any live window and defaults to the selected one.
+WINDOW must be a live window and defaults to the selected one.
+Do not resize if WINDOW was not created by `display-buffer'.
+
+If WINDOW is part of a vertical combination, restrain its new
+size by `temp-buffer-max-height' and do not resize if its minimum
+accessible position is scrolled out of view. If WINDOW is part
+of a horizontal combination, restrain its new size by
+`temp-buffer-max-width'. In both cases, the value of the option
+`fit-window-to-buffer-horizontally' can inhibit resizing.
+
+If WINDOW is the root window of its frame, resize the frame
+provided `fit-frame-to-buffer' is non-nil.
-Do not make WINDOW higher than `temp-buffer-max-height' nor
-smaller than `window-min-height'. Do nothing if WINDOW is not
-vertically combined, some of its contents are scrolled out of
-view, or WINDOW was not created by `display-buffer'."
+This function may call `preserve-window-size' to preserve the
+size of WINDOW."
(setq window (window-normalize-window window t))
(let ((height (if (functionp temp-buffer-max-height)
(with-selected-window window
(funcall temp-buffer-max-height (window-buffer)))
temp-buffer-max-height))
+ (width (if (functionp temp-buffer-max-width)
+ (with-selected-window window
+ (funcall temp-buffer-max-width (window-buffer)))
+ temp-buffer-max-width))
(quit-cadr (cadr (window-parameter window 'quit-restore))))
- (cond
- ;; Resize WINDOW iff it was split off by `display-buffer'.
- ((and (eq quit-cadr 'window)
- (pos-visible-in-window-p (point-min) window)
- (window-combined-p window))
- (fit-window-to-buffer window height))
- ;; Resize FRAME iff it was created by `display-buffer'.
- ((and fit-frame-to-buffer
- (eq quit-cadr 'frame)
- (eq window (frame-root-window window)))
- (let ((frame (window-frame window)))
- (fit-frame-to-buffer
- frame (+ (frame-height frame)
- (- (window-total-size window))
- height)))))))
+ ;; Resize WINDOW iff it was made by `display-buffer'.
+ (when (or (and (eq quit-cadr 'window)
+ (or (and (window-combined-p window)
+ (not (eq fit-window-to-buffer-horizontally
+ 'only))
+ (pos-visible-in-window-p (point-min) window))
+ (and (window-combined-p window t)
+ fit-window-to-buffer-horizontally)))
+ (and (eq quit-cadr 'frame)
+ fit-frame-to-buffer
+ (eq window (frame-root-window window))))
+ (fit-window-to-buffer window height nil width nil t))))
;;; Help windows.
-(defcustom help-window-select 'other
- "Non-nil means select help window for viewing.
+(defcustom help-window-select nil
+ "Non-nil means select help window for viewing.
Choices are:
+
never (nil) Select help window only if there is no other window
on its frame.
- other Select help window unless the selected window is the
- only other window on the help window's frame.
+
+ other Select help window if and only if it appears on the
+ previously selected frame, that frame contains at
+ least two other windows and the help window is
+ either new or showed a different buffer before.
+
always (t) Always select the help window.
+If this option is non-nil and the help window appears on another
+frame, then give that frame input focus too. Note also that if
+the help window appears on another frame, it may get selected and
+its frame get input focus even if this option is nil.
+
This option has effect if and only if the help window was created
-by `with-help-window'"
+by `with-help-window'."
:type '(choice (const :tag "never (nil)" nil)
(const :tag "other" other)
(const :tag "always (t)" t))
@@ -1090,28 +1227,45 @@ window."
(message "%s"
(substitute-command-keys (concat quit-part scroll-part)))))
-(defun help-window-setup (help-window)
- "Set up help window for `with-help-window'.
-HELP-WINDOW is the window used for displaying the help buffer."
- (let* ((help-buffer (when (window-live-p help-window)
- (window-buffer help-window)))
- (help-setup (when (window-live-p help-window)
- (car (window-parameter help-window 'quit-restore)))))
+(defun help-window-setup (window &optional value)
+ "Set up help window WINDOW for `with-help-window'.
+WINDOW is the window used for displaying the help buffer.
+Return VALUE."
+ (let* ((help-buffer (when (window-live-p window)
+ (window-buffer window)))
+ (help-setup (when (window-live-p window)
+ (car (window-parameter window 'quit-restore))))
+ (frame (window-frame window)))
+
(when help-buffer
;; Handle `help-window-point-marker'.
(when (eq (marker-buffer help-window-point-marker) help-buffer)
- (set-window-point help-window help-window-point-marker)
+ (set-window-point window help-window-point-marker)
;; Reset `help-window-point-marker'.
(set-marker help-window-point-marker nil))
+ ;; If the help window appears on another frame, select it if
+ ;; `help-window-select' is non-nil and give that frame input focus
+ ;; too. See also Bug#19012.
+ (when (and help-window-select
+ (frame-live-p help-window-old-frame)
+ (not (eq frame help-window-old-frame)))
+ (select-window window)
+ (select-frame-set-input-focus frame))
+
(cond
- ((or (eq help-window (selected-window))
- (and (or (eq help-window-select t)
- (eq help-setup 'frame)
+ ((or (eq window (selected-window))
+ ;; If the help window is on the selected frame, select
+ ;; it if `help-window-select' is t or `help-window-select'
+ ;; is 'other, the frame contains at least three windows, and
+ ;; the help window did show another buffer before. See also
+ ;; Bug#11039.
+ (and (eq frame (selected-frame))
+ (or (eq help-window-select t)
(and (eq help-window-select 'other)
- (eq (window-frame help-window) (selected-frame))
- (> (length (window-list nil 'no-mini)) 2)))
- (select-window help-window)))
+ (> (length (window-list nil 'no-mini)) 2)
+ (not (eq help-setup 'same))))
+ (select-window window)))
;; The help window is or gets selected ...
(help-window-display-message
(cond
@@ -1119,12 +1273,13 @@ HELP-WINDOW is the window used for displaying the help buffer."
;; ... and is new, ...
"Type \"q\" to delete help window")
((eq help-setup 'frame)
- "Type \"q\" to delete help frame")
+ ;; ... on a new frame, ...
+ "Type \"q\" to quit the help frame")
((eq help-setup 'other)
;; ... or displayed some other buffer before.
"Type \"q\" to restore previous buffer"))
- help-window t))
- ((and (eq (window-frame help-window) (selected-frame))
+ window t))
+ ((and (eq (window-frame window) help-window-old-frame)
(= (length (window-list nil 'no-mini)) 2))
;; There are two windows on the help window's frame and the
;; other one is the selected one.
@@ -1134,7 +1289,7 @@ HELP-WINDOW is the window used for displaying the help buffer."
"Type \\[delete-other-windows] to delete the help window")
((eq help-setup 'other)
"Type \"q\" in help window to restore its previous buffer"))
- help-window 'other))
+ window 'other))
(t
;; The help window is not selected ...
(help-window-display-message
@@ -1145,40 +1300,45 @@ HELP-WINDOW is the window used for displaying the help buffer."
((eq help-setup 'other)
;; ... or displayed some other buffer before.
"Type \"q\" in help window to restore previous buffer"))
- help-window))))))
+ window))))
+ ;; Return VALUE.
+ value))
-;; `with-help-window' is a wrapper for `with-output-to-temp-buffer'
+;; `with-help-window' is a wrapper for `with-temp-buffer-window'
;; providing the following additional twists:
-;; (1) Issue more accurate messages telling how to scroll and quit the
-;; help window.
+;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
+;; adds cross references (via `help-mode-finish').
-;; (2) An option (customizable via `help-window-select') to select the
-;; help window automatically.
+;; (2) It issues a message telling how to scroll and quit the help
+;; window (via `help-window-setup').
-;; (3) A marker (`help-window-point-marker') to move point in the help
-;; window to an arbitrary buffer position.
+;; (3) An option (customizable via `help-window-select') to select the
+;; help window automatically.
-;; Note: It's usually always wrong to use `help-print-return-message' in
-;; the body of `with-help-window'.
+;; (4) A marker (`help-window-point-marker') to move point in the help
+;; window to an arbitrary buffer position.
(defmacro with-help-window (buffer-name &rest body)
- "Display buffer with name BUFFER-NAME in a help window evaluating BODY.
-Select help window if the actual value of the user option
+ "Display buffer named BUFFER-NAME in a help window.
+Evaluate the forms in BODY with standard output bound to a buffer
+called BUFFER-NAME (creating it if it does not exist), put that
+buffer in `help-mode', display the buffer in a window (see
+`with-temp-buffer-window' for details) and issue a message how to
+deal with that \"help\" window when it's no more needed. Select
+the help window if the current value of the user option
`help-window-select' says so. Return last value in BODY."
(declare (indent 1) (debug t))
`(progn
;; Make `help-window-point-marker' point nowhere. The only place
;; where this should be set to a buffer position is within BODY.
(set-marker help-window-point-marker nil)
- (let* (help-window
- (temp-buffer-show-hook
- (cons (lambda () (setq help-window (selected-window)))
- temp-buffer-show-hook)))
- ;; Return value returned by `with-output-to-temp-buffer'.
- (prog1
- (with-output-to-temp-buffer ,buffer-name
- (progn ,@body))
- (help-window-setup help-window)))))
+ (let ((temp-buffer-window-setup-hook
+ (cons 'help-mode-setup temp-buffer-window-setup-hook))
+ (temp-buffer-window-show-hook
+ (cons 'help-mode-finish temp-buffer-window-show-hook)))
+ (setq help-window-old-frame (selected-frame))
+ (with-temp-buffer-window
+ ,buffer-name nil 'help-window-setup (progn ,@body)))))
;; Called from C, on encountering `help-char' when reading a char.
;; Don't print to *Help*; that would clobber Help history.
@@ -1188,6 +1348,128 @@ Select help window if the actual value of the user option
(if (stringp msg)
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
+
+
+(defun help--docstring-quote (string)
+ "Return a doc string that represents STRING.
+The result, when formatted by `substitute-command-keys', should equal STRING."
+ (replace-regexp-in-string "['\\`‘’]" "\\\\=\\&" string))
+
+;; The following functions used to be in help-fns.el, which is not preloaded.
+;; But for various reasons, they are more widely needed, so they were
+;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001
+
+(defun help-split-fundoc (docstring def)
+ "Split a function DOCSTRING into the actual doc and the usage info.
+Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
+is a string describing the argument list of DEF, such as
+\"(apply FUNCTION &rest ARGUMENTS)\".
+DEF is the function whose usage we're looking for in DOCSTRING."
+ ;; Functions can get the calling sequence at the end of the doc string.
+ ;; In cases where `function' has been fset to a subr we can't search for
+ ;; function's name in the doc string so we use `fn' as the anonymous
+ ;; function name instead.
+ (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
+ (let ((doc (unless (zerop (match-beginning 0))
+ (substring docstring 0 (match-beginning 0))))
+ (usage-tail (match-string 1 docstring)))
+ (cons (format "(%s%s"
+ ;; Replace `fn' with the actual function name.
+ (if (symbolp def)
+ (help--docstring-quote (format "%S" def))
+ 'anonymous)
+ usage-tail)
+ doc))))
+
+(defun help-add-fundoc-usage (docstring arglist)
+ "Add the usage info to DOCSTRING.
+If DOCSTRING already has a usage info, then just return it unchanged.
+The usage info is built from ARGLIST. DOCSTRING can be nil.
+ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
+ (unless (stringp docstring) (setq docstring ""))
+ (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)
+ (eq arglist t))
+ docstring
+ (concat docstring
+ (if (string-match "\n?\n\\'" docstring)
+ (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
+ "\n\n")
+ (if (stringp arglist)
+ (if (string-match "\\`[^ ]+\\(.*\\))\\'" arglist)
+ (concat "(fn" (match-string 1 arglist) ")")
+ (error "Unrecognized usage format"))
+ (help--make-usage-docstring 'fn arglist)))))
+
+(defun help-function-arglist (def &optional preserve-names)
+ "Return a formal argument list for the function DEF.
+IF PRESERVE-NAMES is non-nil, return a formal arglist that uses
+the same names as used in the original source code, when possible."
+ ;; Handle symbols aliased to other symbols.
+ (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
+ ;; If definition is a macro, find the function inside it.
+ (if (eq (car-safe def) 'macro) (setq def (cdr def)))
+ (cond
+ ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
+ ((eq (car-safe def) 'lambda) (nth 1 def))
+ ((eq (car-safe def) 'closure) (nth 2 def))
+ ((or (and (byte-code-function-p def) (integerp (aref def 0)))
+ (subrp def))
+ (or (when preserve-names
+ (let* ((doc (condition-case nil (documentation def) (error nil)))
+ (docargs (if doc (car (help-split-fundoc doc nil))))
+ (arglist (if docargs
+ (cdar (read-from-string (downcase docargs)))))
+ (valid t))
+ ;; Check validity.
+ (dolist (arg arglist)
+ (unless (and (symbolp arg)
+ (let ((name (symbol-name arg)))
+ (if (eq (aref name 0) ?&)
+ (memq arg '(&rest &optional))
+ (not (string-match "\\." name)))))
+ (setq valid nil)))
+ (when valid arglist)))
+ (let* ((args-desc (if (not (subrp def))
+ (aref def 0)
+ (let ((a (subr-arity def)))
+ (logior (car a)
+ (if (numberp (cdr a))
+ (lsh (cdr a) 8)
+ (lsh 1 7))))))
+ (max (lsh args-desc -8))
+ (min (logand args-desc 127))
+ (rest (logand args-desc 128))
+ (arglist ()))
+ (dotimes (i min)
+ (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
+ (when (> max min)
+ (push '&optional arglist)
+ (dotimes (i (- max min))
+ (push (intern (concat "arg" (number-to-string (+ 1 i min))))
+ arglist)))
+ (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
+ (nreverse arglist))))
+ ((and (autoloadp def) (not (eq (nth 4 def) 'keymap)))
+ "[Arg list not available until function definition is loaded.]")
+ (t t)))
+
+(defun help--make-usage (function arglist)
+ (cons (if (symbolp function) function 'anonymous)
+ (mapcar (lambda (arg)
+ (if (not (symbolp arg)) arg
+ (let ((name (symbol-name arg)))
+ (cond
+ ((string-match "\\`&" name) arg)
+ ((string-match "\\`_." name)
+ (intern (upcase (substring name 1))))
+ (t (intern (upcase name)))))))
+ arglist)))
+
+(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+
+(defun help--make-usage-docstring (fn arglist)
+ (help--docstring-quote (format "%S" (help--make-usage fn arglist))))
+
(provide 'help)
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index 3334260ba8f..e3938b1f703 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -1,6 +1,6 @@
;;; hex-util.el --- Functions to encode/decode hexadecimal string.
-;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: data
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 2ee492b4c5e..499253e931f 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -1,10 +1,10 @@
;;; hexl.el --- edit a file in a hex dump format using the hexl filter -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1994, 1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1994, 1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: data
;; This file is part of GNU Emacs.
@@ -91,17 +91,17 @@ as that will override any bit grouping options set here."
(defcustom hexl-mode-hook '(hexl-follow-line hexl-activate-ruler)
"Normal hook run when entering Hexl mode."
:type 'hook
- :options '(hexl-follow-line hexl-activate-ruler turn-on-eldoc-mode)
+ :options '(hexl-follow-line hexl-activate-ruler eldoc-mode)
:group 'hexl)
(defface hexl-address-region
'((t (:inherit header-line)))
- "Face used in address area of hexl-mode buffer."
+ "Face used in address area of Hexl mode buffer."
:group 'hexl)
(defface hexl-ascii-region
'((t (:inherit header-line)))
- "Face used in ascii area of hexl-mode buffer."
+ "Face used in ASCII area of Hexl mode buffer."
:group 'hexl)
(defvar hexl-max-address 0
@@ -283,10 +283,10 @@ using the function `hexlify-buffer'.
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every `hexl-bits' bits) and as their ASCII values.
+values grouped every `hexl-bits' bits, and as their ASCII values).
If any of the characters (displayed as ASCII characters) are
-unprintable (control or meta characters) they will be replaced as
+unprintable (control or meta characters) they will be replaced by
periods.
If `hexl-mode' is invoked with an argument the buffer is assumed to be
@@ -310,8 +310,8 @@ A sample format:
000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
000000c0: 7265 6769 6f6e 2e0a region..
-Movement is as simple as movement in a normal Emacs text buffer. Most
-cursor movement bindings are the same: use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
+Movement is as simple as movement in a normal Emacs text buffer.
+Most cursor movement bindings are the same: use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
to move the cursor left, right, down, and up.
Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
@@ -336,7 +336,7 @@ into the buffer at the current point.
\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
into the buffer at the current point.
-\\[hexl-mode-exit] will exit hexl-mode.
+\\[hexl-mode-exit] will exit `hexl-mode'.
Note: saving the file with any of the usual Emacs commands
will actually convert it back to binary format while saving.
@@ -395,8 +395,8 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)
;; Set a callback function for eldoc.
- (hexl-mode--setq-local 'eldoc-documentation-function
- #'hexl-print-current-point-info)
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'hexl-print-current-point-info)
(eldoc-add-command-completions "hexl-")
(eldoc-remove-command "hexl-save-buffer"
"hexl-current-address")
@@ -406,7 +406,7 @@ You can use \\[hexl-find-file] to visit a file in Hexl mode.
(defun hexl-isearch-search-function ()
- (if (and (not isearch-regexp) (not isearch-word))
+ (if (and (not isearch-regexp) (not isearch-regexp-function))
(lambda (string &optional bound noerror count)
(funcall
(if isearch-forward 're-search-forward 're-search-backward)
@@ -566,7 +566,7 @@ This function is intended to be used as eldoc callback."
(format "Current address is %d/0x%08x" addr addr)))
(defun hexl-ascii-start-column ()
- "Column at which the ascii portion of the hexl display starts."
+ "Column at which the ASCII portion of the hexl display starts."
(+ 43 (/ 128 hexl-bits)))
(defun hexl-address-to-marker (address)
@@ -587,7 +587,7 @@ Signal error if ADDRESS is out of range."
(goto-char (hexl-address-to-marker address)))
(defun hexl-goto-hex-address (hex-address)
- "Go to hexl-mode address (hex string) HEX-ADDRESS.
+ "Go to Hexl mode address (hex string) HEX-ADDRESS.
Signal error if HEX-ADDRESS is out of range."
(interactive "sHex Address: ")
(hexl-goto-address (hexl-hex-string-to-integer hex-address)))
@@ -616,17 +616,17 @@ Signal error if HEX-ADDRESS is out of range."
;; move point functions
(defun hexl-backward-char (arg)
- "Move to left ARG bytes (right if ARG negative) in hexl-mode."
+ "Move to left ARG bytes (right if ARG negative) in Hexl mode."
(interactive "p")
(hexl-goto-address (- (hexl-current-address) arg)))
(defun hexl-forward-char (arg)
- "Move to right ARG bytes (left if ARG negative) in hexl-mode."
+ "Move to right ARG bytes (left if ARG negative) in Hexl mode."
(interactive "p")
(hexl-goto-address (+ (hexl-current-address) arg)))
(defun hexl-backward-short (arg)
- "Move to left ARG shorts (right if ARG negative) in hexl-mode."
+ "Move to left ARG shorts (right if ARG negative) in Hexl mode."
(interactive "p")
(hexl-goto-address (let ((address (hexl-current-address)))
(if (< arg 0)
@@ -658,12 +658,12 @@ Signal error if HEX-ADDRESS is out of range."
address)))
(defun hexl-forward-short (arg)
- "Move to right ARG shorts (left if ARG negative) in hexl-mode."
+ "Move to right ARG shorts (left if ARG negative) in Hexl mode."
(interactive "p")
(hexl-backward-short (- arg)))
(defun hexl-backward-word (arg)
- "Move to left ARG words (right if ARG negative) in hexl-mode."
+ "Move to left ARG words (right if ARG negative) in Hexl mode."
(interactive "p")
(hexl-goto-address (let ((address (hexl-current-address)))
(if (< arg 0)
@@ -695,18 +695,18 @@ Signal error if HEX-ADDRESS is out of range."
address)))
(defun hexl-forward-word (arg)
- "Move to right ARG words (left if ARG negative) in hexl-mode."
+ "Move to right ARG words (left if ARG negative) in Hexl mode."
(interactive "p")
(hexl-backward-word (- arg)))
(defun hexl-previous-line (arg)
- "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
+ "Move vertically up ARG lines [16 bytes] (down if ARG negative) in Hexl mode.
If there is no byte at the target address move to the last byte in that line."
(interactive "p")
(hexl-next-line (- arg)))
(defun hexl-next-line (arg)
- "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
+ "Move vertically down ARG lines [16 bytes] (up if ARG negative) in Hexl mode.
If there is no byte at the target address move to the last byte in that line."
(interactive "p")
(hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
@@ -740,12 +740,12 @@ With prefix arg N, puts point N bytes of the way from the true beginning."
(hexl-goto-address (- hexl-max-address (1- arg))))
(defun hexl-beginning-of-line ()
- "Goto beginning of line in hexl mode."
+ "Goto beginning of line in Hexl mode."
(interactive)
(goto-char (+ (* (/ (point) (hexl-line-displen)) (hexl-line-displen)) 11)))
(defun hexl-end-of-line ()
- "Goto end of line in hexl mode."
+ "Goto end of line in Hexl mode."
(interactive)
(hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
(if (> address hexl-max-address)
@@ -935,13 +935,14 @@ and their encoded form is inserted byte by byte."
(mapconcat (function (lambda (c) (format "%x" c)))
internal " "))
(if (yes-or-no-p
- (format
+ (format-message
"Insert char 0x%x's internal representation \"%s\"? "
ch internal-hex))
(setq encoded internal)
(error
- "Can't encode `0x%x' with this buffer's coding system; try \\[hexl-insert-hex-string]"
- ch)))
+ "Can't encode `0x%x' with this buffer's coding system; %s"
+ ch
+ (substitute-command-keys "try \\[hexl-insert-hex-string]"))))
(while (> num 0)
(mapc
(function (lambda (c) (hexl-insert-char c 1))) encoded)
@@ -1100,7 +1101,7 @@ This function is assumed to be used as callback function for `hl-line-mode'."
))
(defun hexl-mode-ruler ()
- "Return a string ruler for hexl mode."
+ "Return a string ruler for Hexl mode."
(let* ((highlight (mod (hexl-current-address) 16))
(s (cdr (assq hexl-bits hexl-rulers)))
(pos 0))
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index bc4f89955bc..6b7f2caed1e 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -1,11 +1,10 @@
;;; hfy-cmap.el --- Fallback colour name -> rgb mapping for `htmlfontify'
-;; Copyright (C) 2002-2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2015 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
;; Filename: hfy-cmap.el
-;; Version: 0.20
;; Keywords: colour, rgb
;; Author: Vivek Dasmohapatra <vivek@etla.org>
;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
@@ -13,7 +12,6 @@
;; Description: fallback code for colour name -> rgb mapping
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Last-Updated: Sat 2003-02-15 03:49:32 +0000
-;; Package: htmlfontify
;; This file is part of GNU Emacs.
@@ -812,7 +810,7 @@ Loads the variable `hfy-rgb-txt-colour-map', which is used by
`hfy-fallback-colour-values'."
(interactive
(list
- (read-file-name "rgb.txt \(equivalent\) file: " "" nil t (hfy-rgb-file))))
+ (read-file-name "rgb.txt (equivalent) file: " "" nil t (hfy-rgb-file))))
(let ((rgb-buffer nil)
(end-of-rgb 0)
(rgb-txt nil))
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index d0a82cd97b0..89b1204ad11 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -1,6 +1,6 @@
;;; hi-lock.el --- minor mode for interactive automatic highlighting -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: David M. Koppelman <koppel@ece.lsu.edu>
;; Keywords: faces, minor-mode, matching, display
@@ -136,9 +136,9 @@ patterns."
(put 'hi-lock-file-patterns-policy 'risky-local-variable t)
(defcustom hi-lock-auto-select-face nil
- "Non-nil if highlighting commands should not prompt for face names.
-When non-nil, each hi-lock command will cycle through faces in
-`hi-lock-face-defaults' without prompting."
+ "Non-nil means highlighting commands do not prompt for the face to use.
+Instead, each hi-lock command will cycle through the faces in
+`hi-lock-face-defaults'."
:type 'boolean
:version "24.4")
@@ -164,9 +164,9 @@ When non-nil, each hi-lock command will cycle through faces in
(defface hi-green
'((((min-colors 88) (background dark))
- (:background "green1" :foreground "black"))
+ (:background "light green" :foreground "black"))
(((background dark)) (:background "green" :foreground "black"))
- (((min-colors 88)) (:background "green1"))
+ (((min-colors 88)) (:background "light green"))
(t (:background "green")))
"Face for hi-lock mode."
:group 'hi-lock-faces)
@@ -284,26 +284,6 @@ a library is being loaded.")
map)
"Key map for hi-lock.")
-(defvar hi-lock-read-regexp-defaults-function
- 'hi-lock-read-regexp-defaults
- "Function that provides default regexp(s) for highlighting commands.
-This function should take no arguments and return one of nil, a
-regexp or a list of regexps for use with highlighting commands -
-`hi-lock-face-phrase-buffer', `hi-lock-line-face-buffer' and
-`hi-lock-face-buffer'. The return value of this function is used
-as DEFAULTS param of `read-regexp' while executing the
-highlighting command. This function is called only during
-interactive use.
-
-For example, to highlight at symbol at point use
-
- \(setq hi-lock-read-regexp-defaults-function
- 'find-tag-default-as-regexp\)
-
-If you need different defaults for different highlighting
-operations, use `this-command' to identify the command under
-execution.")
-
;; Visible Functions
;;;###autoload
@@ -382,7 +362,7 @@ Hi-lock: end is found. A mode is excluded if it's in the list
(setq hi-lock-archaic-interface-message-used t)
(if hi-lock-archaic-interface-deduce
(global-hi-lock-mode hi-lock-mode)
- (warn
+ (warn "%s"
"Possible archaic use of (hi-lock-mode).
Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs
@@ -411,7 +391,7 @@ versions before 22 use the following in your init file:
(font-lock-remove-keywords nil hi-lock-file-patterns)
(setq hi-lock-file-patterns nil))
(remove-overlays nil nil 'hi-lock-overlay t)
- (when font-lock-fontified (font-lock-fontify-buffer)))
+ (font-lock-flush))
(define-key-after menu-bar-edit-menu [hi-lock] nil)
(remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t)))
@@ -430,9 +410,8 @@ versions before 22 use the following in your init file:
;;;###autoload
(defun hi-lock-line-face-buffer (regexp &optional face)
"Set face of all lines containing a match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) of REGEXP. Use the global history list for FACE.
+Interactively, prompt for REGEXP using `read-regexp', then FACE.
+Use the global history list for FACE.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -440,8 +419,7 @@ highlighting will not update as you type."
(interactive
(list
(hi-lock-regexp-okay
- (read-regexp "Regexp to highlight line"
- (funcall hi-lock-read-regexp-defaults-function)))
+ (read-regexp "Regexp to highlight line" 'regexp-history-last))
(hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
@@ -456,9 +434,8 @@ highlighting will not update as you type."
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face)
"Set face of each match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) REGEXP. Use the global history list for FACE.
+Interactively, prompt for REGEXP using `read-regexp', then FACE.
+Use the global history list for FACE.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -466,8 +443,7 @@ highlighting will not update as you type."
(interactive
(list
(hi-lock-regexp-okay
- (read-regexp "Regexp to highlight"
- (funcall hi-lock-read-regexp-defaults-function)))
+ (read-regexp "Regexp 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))
@@ -478,12 +454,12 @@ highlighting will not update as you type."
;;;###autoload
(defun hi-lock-face-phrase-buffer (regexp &optional face)
"Set face of each match of phrase REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) of REGEXP. 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'.
+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'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -492,8 +468,7 @@ highlighting will not update as you type."
(list
(hi-lock-regexp-okay
(hi-lock-process-phrase
- (read-regexp "Phrase to highlight"
- (funcall hi-lock-read-regexp-defaults-function))))
+ (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))
@@ -503,17 +478,16 @@ highlighting will not update as you type."
(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
;;;###autoload
(defun hi-lock-face-symbol-at-point ()
- "Set face of each match of the symbol at point.
-Use `find-tag-default-as-regexp' to retrieve the symbol at point.
-Use non-nil `hi-lock-auto-select-face' to retrieve the next face
-from `hi-lock-face-defaults' automatically.
-
-Use Font lock mode, if enabled, to highlight symbol at point.
-Otherwise, use overlays for highlighting. If overlays are used,
-the highlighting will not update as you type."
+ "Highlight each instance of the symbol at point.
+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.
+
+This uses Font lock mode if it is enabled; otherwise it uses overlays,
+in which case the highlighting will not update as you type."
(interactive)
(let* ((regexp (hi-lock-regexp-okay
- (find-tag-default-as-regexp)))
+ (find-tag-default-as-symbol-regexp)))
(hi-lock-auto-select-face t)
(face (hi-lock-read-face-name)))
(or (facep face) (setq face 'hi-yellow))
@@ -622,12 +596,17 @@ then remove all hi-lock highlighting."
;; Make `face' the next one to use by default.
(when (symbolp face) ;Don't add it if it's a list (bug#13297).
(add-to-list 'hi-lock--unused-faces (face-name face))))
- (font-lock-remove-keywords nil (list keyword))
+ ;; FIXME: Calling `font-lock-remove-keywords' causes
+ ;; `font-lock-specified-p' to go from nil to non-nil (because it
+ ;; calls font-lock-set-defaults). This is yet-another bug in
+ ;; font-lock-add/remove-keywords, which we circumvent here by
+ ;; testing `font-lock-fontified' (bug#19796).
+ (if font-lock-fontified (font-lock-remove-keywords nil (list keyword)))
(setq hi-lock-interactive-patterns
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword)))
- (when font-lock-fontified (font-lock-fontify-buffer)))))
+ (font-lock-flush))))
;;;###autoload
(defun hi-lock-write-interactive-patterns ()
@@ -676,19 +655,18 @@ and initial lower-case letters made case insensitive."
Otherwise signal an error. A pattern that matches the null string is
not suitable."
- (if (string-match regexp "")
- (error "Regexp cannot match an empty string")
- regexp))
-
-(defun hi-lock-read-regexp-defaults ()
- "Return the latest regexp from `regexp-history'.
-See `hi-lock-read-regexp-defaults-function' for details."
- (car regexp-history))
+ (cond
+ ((null regexp)
+ (error "Regexp cannot match nil"))
+ ((string-match regexp "")
+ (error "Regexp cannot match an empty string"))
+ (t regexp)))
(defun hi-lock-read-face-name ()
"Return face for interactive highlighting.
When `hi-lock-auto-select-face' is non-nil, just return the next face.
-Otherwise, read face name from minibuffer with completion and history."
+Otherwise, or with a prefix argument, read a face from the minibuffer
+with completion and history."
(unless hi-lock-interactive-patterns
(setq hi-lock--unused-faces hi-lock-face-defaults))
(let* ((last-used-face
@@ -715,14 +693,14 @@ Otherwise, read face name from minibuffer with completion and history."
"Highlight REGEXP with face FACE."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
- (let ((pattern (list regexp (list 0 (list 'quote face) t))))
+ (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))))
;; Refuse to highlight a text that is already highlighted.
(unless (assoc regexp hi-lock-interactive-patterns)
(push pattern hi-lock-interactive-patterns)
- (if font-lock-mode
+ (if (and font-lock-mode (font-lock-specified-p major-mode))
(progn
(font-lock-add-keywords nil (list pattern) t)
- (font-lock-fontify-buffer))
+ (font-lock-flush))
(let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
(range-max (+ (point) (/ hi-lock-highlight-range 2)))
(search-start
@@ -746,7 +724,7 @@ Otherwise, read face name from minibuffer with completion and history."
(font-lock-remove-keywords nil hi-lock-file-patterns)
(setq hi-lock-file-patterns patterns)
(font-lock-add-keywords nil hi-lock-file-patterns t)
- (font-lock-fontify-buffer)))
+ (font-lock-flush)))
(defun hi-lock-find-patterns ()
"Find patterns in current buffer for hi-lock."
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 1da3d68e131..2f69bbc104b 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -1,6 +1,6 @@
;;; hilit-chg.el --- minor mode displaying buffer changes with special face
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Richard Sharman <rsharman@pobox.com>
;; Keywords: faces
@@ -333,7 +333,7 @@ enable the mode if ARG is omitted or nil.
When Highlight Changes is enabled, changes are marked with a text
property. Normally they are displayed in a distinctive face, but
-command \\[highlight-changes-visible-mode] can be used to toggles
+command \\[highlight-changes-visible-mode] can be used to toggle
this on and off.
Other functions for buffers in this mode include:
@@ -379,7 +379,7 @@ in a distinctive face.
The default value can be customized with variable
`highlight-changes-visibility-initial-state'.
-This command does not itself set highlight-changes mode."
+This command does not itself set Highlight Changes mode."
t ;; init-value
nil ;; lighter
@@ -455,7 +455,7 @@ Otherwise, this list will be constructed when needed from
"Call function FUNC for each region used by Highlight Changes mode.
If START-POSITION is nil, (point-min) is used.
If END-POSITION is nil, (point-max) is used.
-FUNC is called with 3 params: PROPERTY START STOP."
+FUNC is called with three params: PROPERTY START STOP."
(let ((start (or start-position (point-min)))
(limit (or end-position (point-max)))
prop end)
@@ -470,8 +470,8 @@ FUNC is called with 3 params: PROPERTY START STOP."
(defun hilit-chg-display-changes (&optional beg end)
"Display face information for Highlight Changes mode.
-An overlay from BEG to END containing a change face is added from the
-information in the text property of type `hilit-chg'.
+An overlay from BEG to END containing a change face is added
+from the information in the text property of type `hilit-chg'.
This is the opposite of `hilit-chg-hide-changes'."
(hilit-chg-map-changes 'hilit-chg-make-ov beg end))
@@ -731,7 +731,7 @@ You can automatically rotate colors when the buffer is saved by adding
this function to `write-file-functions' as a buffer-local value. To do
this, eval the following in the buffer to be saved:
- \(add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)"
+ (add-hook \\='write-file-functions \\='highlight-changes-rotate-faces nil t)"
(interactive)
(when (and highlight-changes-mode highlight-changes-visible-mode)
(let ((modified (buffer-modified-p))
@@ -1022,6 +1022,12 @@ This is called when `global-highlight-changes-mode' is turned on."
;;
;; ================== end of debug ===============
+(defun hilit-chg-unload-function ()
+ "Unload the Highlight Changes library."
+ (global-hi-lock-mode -1)
+ ;; continue standard unloading
+ nil)
+
(provide 'hilit-chg)
;;; hilit-chg.el ends here
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index ad233b2a507..a19ff32f1da 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -1,9 +1,9 @@
;;; hippie-exp.el --- expand text trying various ways to find its expansion
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Anders Holst <aho@sans.kth.se>
-;; Last change: 3 March 1998
+;; Maintainer: emacs-devel@gnu.org
;; Version: 1.6
;; Keywords: abbrev convenience
@@ -99,10 +99,10 @@
;; from the kill ring. May be good if you don't know how far up in
;; the kill-ring the required entry is, and don't want to mess with
;; "Choose Next Paste".
-;; `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
+;; `try-complete-lisp-symbol' : like `elisp-completion-at-point', but goes
;; through all possibilities instead of completing what is unique.
;; Might be tedious (usually a lot of possible completions) and
-;; since its function is much like `lisp-complete-symbol', which
+;; since its function is much like `completion-at-point', which
;; already has a key of its own, you might want to remove this.
;; `try-complete-lisp-symbol-partially' : To insert in the list just
;; before `try-complete-lisp-symbol' for those who first want to get
@@ -637,15 +637,27 @@ string). It returns t if a new completion is found, nil otherwise."
The argument OLD has to be nil the first call of this function, and t
for subsequent calls (for further possible completions of the same
string). It returns t if a new completion is found, nil otherwise."
+ (he--all-buffers
+ old
+ (lambda () (he-line-beg (and (get-buffer-process (current-buffer))
+ comint-use-prompt-regexp
+ comint-prompt-regexp)))
+ (lambda (string)
+ (he-line-search string
+ (and (get-buffer-process (current-buffer))
+ comint-use-prompt-regexp
+ comint-prompt-regexp)
+ nil))))
+
+(defun he--all-buffers (old beg-function search-function)
(let ((expansion ())
- (strip-prompt (and (get-buffer-process (current-buffer))
- comint-use-prompt-regexp
- comint-prompt-regexp))
- (buf (current-buffer))
- (orig-case-fold-search case-fold-search))
+ (buf (current-buffer))
+ (only-buffers hippie-expand-only-buffers)
+ (ignore-buffers hippie-expand-ignore-buffers)
+ (orig-case-fold-search case-fold-search))
(if (not old)
- (progn
- (he-init-string (he-line-beg strip-prompt) (point))
+ (progn
+ (he-init-string (funcall beg-function) (point))
(setq he-search-bufs (buffer-list))
(setq he-searched-n-bufs 0)
(set-marker he-search-loc 1 (car he-search-bufs))))
@@ -654,24 +666,20 @@ string). It returns t if a new completion is found, nil otherwise."
(while (and he-search-bufs
(not expansion)
(or (not hippie-expand-max-buffers)
- (< he-searched-n-bufs hippie-expand-max-buffers)))
- (set-buffer (car he-search-bufs))
- (if (and (not (eq (current-buffer) buf))
- (if hippie-expand-only-buffers
- (he-buffer-member hippie-expand-only-buffers)
- (not (he-buffer-member hippie-expand-ignore-buffers))))
- (save-excursion
- (save-restriction
- (if hippie-expand-no-restriction
+ (< he-searched-n-bufs hippie-expand-max-buffers)))
+ (set-buffer (car he-search-bufs))
+ (if (and (not (eq (current-buffer) buf))
+ (if only-buffers
+ (he-buffer-member only-buffers)
+ (not (he-buffer-member ignore-buffers))))
+ (save-excursion
+ (save-restriction
+ (if hippie-expand-no-restriction
(widen))
(goto-char he-search-loc)
- (setq strip-prompt (and (get-buffer-process (current-buffer))
- comint-use-prompt-regexp
- comint-prompt-regexp))
(setq expansion
(let ((case-fold-search orig-case-fold-search))
- (he-line-search he-search-string
- strip-prompt nil)))
+ (funcall search-function he-search-string)))
(set-marker he-search-loc (point))
(if (not expansion)
(progn
@@ -686,9 +694,9 @@ string). It returns t if a new completion is found, nil otherwise."
(progn
(if old (he-reset-string))
())
- (progn
- (he-substitute-string expansion t)
- t))))
+ (progn
+ (he-substitute-string expansion t)
+ t))))
(defun he-line-search (str strip-prompt reverse)
(let ((result ()))
@@ -715,7 +723,7 @@ string). It returns t if a new completion is found, nil otherwise."
(defun he-line-search-regexp (pat strip-prompt)
(if strip-prompt
- (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
+ (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(?2:"
(regexp-quote pat)
"[^\n]*[^ \t\n]\\)")
(concat "^\\(\\s-*\\)\\("
@@ -769,53 +777,9 @@ string). It returns t if a new completion is found, nil otherwise."
The argument OLD has to be nil the first call of this function, and t
for subsequent calls (for further possible completions of the same
string). It returns t if a new completion is found, nil otherwise."
- (let ((expansion ())
- (buf (current-buffer))
- (orig-case-fold-search case-fold-search))
- (if (not old)
- (progn
- (he-init-string (he-list-beg) (point))
- (setq he-search-bufs (buffer-list))
- (setq he-searched-n-bufs 0)
- (set-marker he-search-loc 1 (car he-search-bufs))))
-
- (if (not (equal he-search-string ""))
- (while (and he-search-bufs
- (not expansion)
- (or (not hippie-expand-max-buffers)
- (< he-searched-n-bufs hippie-expand-max-buffers)))
- (set-buffer (car he-search-bufs))
- (if (and (not (eq (current-buffer) buf))
- (if hippie-expand-only-buffers
- (he-buffer-member hippie-expand-only-buffers)
- (not (he-buffer-member hippie-expand-ignore-buffers))))
- (save-excursion
- (save-restriction
- (if hippie-expand-no-restriction
- (widen))
- (goto-char he-search-loc)
- (setq expansion
- (let ((case-fold-search orig-case-fold-search))
- (he-list-search he-search-string nil)))
- (set-marker he-search-loc (point))
- (if (not expansion)
- (progn
- (setq he-search-bufs (cdr he-search-bufs))
- (setq he-searched-n-bufs (1+ he-searched-n-bufs))
- (set-marker he-search-loc 1 (car he-search-bufs))))))
- (setq he-search-bufs (cdr he-search-bufs))
- (set-marker he-search-loc 1 (car he-search-bufs)))))
-
- (set-buffer buf)
- (if (not expansion)
- (progn
- (if old (he-reset-string))
- ())
- (progn
- (he-substitute-string expansion t)
- t))))
+ (he--all-buffers old #'he-list-beg #'he-list-search))
-(defun he-list-search (str reverse)
+(defun he-list-search (str &optional reverse)
(let ((result ())
beg pos err)
(while (and (not result)
@@ -924,51 +888,7 @@ string). It returns t if a new expansion is found, nil otherwise."
The argument OLD has to be nil the first call of this function, and t
for subsequent calls (for further possible expansions of the same
string). It returns t if a new expansion is found, nil otherwise."
- (let ((expansion ())
- (buf (current-buffer))
- (orig-case-fold-search case-fold-search))
- (if (not old)
- (progn
- (he-init-string (he-dabbrev-beg) (point))
- (setq he-search-bufs (buffer-list))
- (setq he-searched-n-bufs 0)
- (set-marker he-search-loc 1 (car he-search-bufs))))
-
- (if (not (equal he-search-string ""))
- (while (and he-search-bufs
- (not expansion)
- (or (not hippie-expand-max-buffers)
- (< he-searched-n-bufs hippie-expand-max-buffers)))
- (set-buffer (car he-search-bufs))
- (if (and (not (eq (current-buffer) buf))
- (if hippie-expand-only-buffers
- (he-buffer-member hippie-expand-only-buffers)
- (not (he-buffer-member hippie-expand-ignore-buffers))))
- (save-excursion
- (save-restriction
- (if hippie-expand-no-restriction
- (widen))
- (goto-char he-search-loc)
- (setq expansion
- (let ((case-fold-search orig-case-fold-search))
- (he-dabbrev-search he-search-string nil)))
- (set-marker he-search-loc (point))
- (if (not expansion)
- (progn
- (setq he-search-bufs (cdr he-search-bufs))
- (setq he-searched-n-bufs (1+ he-searched-n-bufs))
- (set-marker he-search-loc 1 (car he-search-bufs))))))
- (setq he-search-bufs (cdr he-search-bufs))
- (set-marker he-search-loc 1 (car he-search-bufs)))))
-
- (set-buffer buf)
- (if (not expansion)
- (progn
- (if old (he-reset-string))
- ())
- (progn
- (he-substitute-string expansion t)
- t))))
+ (he--all-buffers old #'he-dabbrev-beg #'he-dabbrev-search))
;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
;; suggested this one.
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index e2171a27f5c..35243485036 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -1,9 +1,9 @@
-;;; hl-line.el --- highlight the current line
+;;; hl-line.el --- highlight the current line -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 1998-09-13
;; Keywords: faces, frames, emulations
@@ -61,13 +61,17 @@
;;; Code:
-(defvar hl-line-overlay nil
+(defvar-local hl-line-overlay nil
"Overlay used by Hl-Line mode to highlight the current line.")
-(make-variable-buffer-local 'hl-line-overlay)
-(defvar global-hl-line-overlay nil
+(defvar-local global-hl-line-overlay nil
"Overlay used by Global-Hl-Line mode to highlight the current line.")
+(defvar global-hl-line-overlays nil
+ "Overlays used by Global-Hl-Line mode in various buffers.
+Global-Hl-Line keeps displaying one overlay in each buffer
+when `global-hl-line-sticky-flag' is non-nil.")
+
(defgroup hl-line nil
"Highlight the current line."
:version "21.1"
@@ -155,13 +159,18 @@ addition to `hl-line-highlight' on `post-command-hook'."
(remove-hook 'change-major-mode-hook #'hl-line-unhighlight t)
(remove-hook 'pre-command-hook #'hl-line-unhighlight t)))
+(defun hl-line-make-overlay ()
+ (let ((ol (make-overlay (point) (point))))
+ (overlay-put ol 'priority -50) ;(bug#16192)
+ (overlay-put ol 'face hl-line-face)
+ ol))
+
(defun hl-line-highlight ()
"Activate the Hl-Line overlay on the current line."
(if hl-line-mode ; Might be changed outside the mode function.
(progn
(unless hl-line-overlay
- (setq hl-line-overlay (make-overlay 1 1)) ; to be moved
- (overlay-put hl-line-overlay 'face hl-line-face))
+ (setq hl-line-overlay (hl-line-make-overlay))) ; To be moved.
(overlay-put hl-line-overlay
'window (unless hl-line-sticky-flag (selected-window)))
(hl-line-move hl-line-overlay))
@@ -189,9 +198,14 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
:group 'hl-line
(if global-hl-line-mode
(progn
- (add-hook 'pre-command-hook #'global-hl-line-unhighlight)
+ ;; In case `kill-all-local-variables' is called.
+ (add-hook 'change-major-mode-hook #'global-hl-line-unhighlight)
+ (if global-hl-line-sticky-flag
+ (remove-hook 'pre-command-hook #'global-hl-line-unhighlight)
+ (add-hook 'pre-command-hook #'global-hl-line-unhighlight))
+ (global-hl-line-highlight)
(add-hook 'post-command-hook #'global-hl-line-highlight))
- (global-hl-line-unhighlight)
+ (global-hl-line-unhighlight-all)
(remove-hook 'pre-command-hook #'global-hl-line-unhighlight)
(remove-hook 'post-command-hook #'global-hl-line-highlight)))
@@ -200,8 +214,9 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
(when global-hl-line-mode ; Might be changed outside the mode function.
(unless (window-minibuffer-p)
(unless global-hl-line-overlay
- (setq global-hl-line-overlay (make-overlay 1 1)) ; to be moved
- (overlay-put global-hl-line-overlay 'face hl-line-face))
+ (setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved.
+ (unless (member global-hl-line-overlay global-hl-line-overlays)
+ (push global-hl-line-overlay global-hl-line-overlays))
(overlay-put global-hl-line-overlay 'window
(unless global-hl-line-sticky-flag
(selected-window)))
@@ -212,6 +227,16 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
(when global-hl-line-overlay
(delete-overlay global-hl-line-overlay)))
+(defun global-hl-line-unhighlight-all ()
+ "Deactivate all Global-Hl-Line overlays."
+ (mapc (lambda (ov)
+ (let ((ovb (overlay-buffer ov)))
+ (when (bufferp ovb)
+ (with-current-buffer ovb
+ (global-hl-line-unhighlight)))))
+ global-hl-line-overlays)
+ (setq global-hl-line-overlays nil))
+
(defun hl-line-move (overlay)
"Move the Hl-Line overlay.
If `hl-line-range-function' is non-nil, move the OVERLAY to the position
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 3de2b1a65e6..719cb50ac77 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1,6 +1,6 @@
;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks
-;; Copyright (C) 2002-2003, 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2015 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
@@ -15,7 +15,6 @@
;; Compatibility: Emacs23, Emacs22
;; Incompatibility: Emacs19, Emacs20, Emacs21
;; Last Updated: Thu 2009-11-19 01:31:21 +0000
-;; Version: 0.21
;; This file is part of GNU Emacs.
@@ -134,10 +133,10 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
\(defun rtfm-build-source-docs (section srcdir destdir)
(interactive
\"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \")
- (require 'htmlfontify)
+ (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)
@@ -147,6 +146,8 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
"Convert buffers and files to HTML."
:group 'applications
:link '(variable-link htmlfontify-manual)
+ :link '(custom-manual "(htmlfontify) Top")
+ :link '(info-link "(htmlfontify) Customization")
:prefix "hfy-")
(defcustom hfy-page-header 'hfy-default-header
@@ -186,13 +187,13 @@ It takes only one argument, the filename."
:type '(string))
(defcustom hfy-src-doc-link-style "text-decoration: underline;"
- "String to add to the '<style> a' variant of an htmlfontify CSS class."
+ "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."
+ "Regex to remove from the `<style> a' variant of an htmlfontify CSS class."
:group 'htmlfontify
:tag "src-doc-link-unstyle"
:type '(string))
@@ -329,7 +330,7 @@ done;")
(defcustom hfy-etags-cmd-alist
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'."
+`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)))
@@ -388,8 +389,8 @@ exuberant-ctags' etags respectively."
(defcustom hfy-istext-command "file %s | sed -e 's@^[^:]*:[ \t]*@@'"
"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."
+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))
@@ -439,7 +440,7 @@ and so on."
(background (choice (const :tag "Dark" dark )
(const :tag "Bright" light ))) ))
-(defcustom hfy-optimisations (list 'keep-overlays)
+(defcustom hfy-optimizations (list 'keep-overlays)
"Optimizations to turn on: So far, the following have been implemented:\n
merge-adjacent-tags: If two (or more) span tags are adjacent, identical and
separated by nothing more than whitespace, they will
@@ -474,6 +475,7 @@ which can never slow you down, but may result in incomplete fontification."
(const :tag "body-text-only" body-text-only ))
:group 'htmlfontify
:tag "optimizations")
+(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1")
(defvar hfy-tags-cache nil
"Alist of the form:\n
@@ -498,12 +500,12 @@ tagged items, not the locations of their definitions.")
(defvar hfy-style-assoc 'please-ignore-this-line
"An assoc representing/describing an Emacs face.
Properties may be repeated, in which case later properties should be
-treated as if they were inherited from a 'parent' font.
+treated as if they were inherited from a `parent' font.
\(For some properties, only the first encountered value is of any importance,
for others the values might be cumulative, and for others they might be
cumulative in a complex way.)\n
Some examples:\n
-\(hfy-face-to-style 'default) =>
+\(hfy-face-to-style \\='default) =>
((\"background\" . \"rgb(0, 0, 0)\")
(\"color\" . \"rgb(255, 255, 255)\")
(\"font-style\" . \"normal\")
@@ -512,7 +514,7 @@ Some examples:\n
(\"font-family\" . \"misc-fixed\")
(\"font-size\" . \"13pt\")
(\"text-decoration\" . \"none\"))\n
-\(hfy-face-to-style 'Info-title-3-face) =>
+\(hfy-face-to-style \\='Info-title-3-face) =>
((\"font-weight\" . \"700\")
(\"font-family\" . \"helv\")
(\"font-size\" . \"120%\")
@@ -525,14 +527,14 @@ Some examples:\n
(defvar hfy-facemap-assoc 'please-ignore-this-line
"An assoc of (point . FACE-SYMBOL) or (point . DEFFACE-LIST)
-and (point . 'end) elements, in descending order of point value
+and (point . \\='end) elements, in descending order of point value
\(ie from the file's end to its beginning).\n
The map is in reverse order because inserting a <style> tag (or any other
string) at `point' invalidates the map for all entries with a greater value of
point. By traversing the map from greatest to least point, we still invalidate
the map as we go, but only those points we have already dealt with (and
therefore no longer care about) will be invalid at any time.\n
-'((64820 . end)
+\\='((64820 . end)
(64744 . font-lock-comment-face)
(64736 . end)
(64722 . font-lock-string-face)
@@ -605,7 +607,7 @@ in a windowing system - try to trick it..."
(defun hfy-opt (symbol)
"Is option SYMBOL set."
- (memq symbol hfy-optimisations))
+ (memq symbol hfy-optimizations))
(defun hfy-default-header (file style)
"Default value for `hfy-page-header'.
@@ -1138,7 +1140,7 @@ See also `hfy-face-to-css'."
(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) ...\).
+The signature of the handler is of the form \(lambda (FN) ...).
FN is a font or `defface' specification (cf
`face-attr-construct'). The handler should return a cons cell of
the form (STYLE-NAME . STYLE-SPEC).
@@ -1196,7 +1198,7 @@ MAP is the invisibility map as returned by `hfy-find-invisible-ranges'."
;; -- v
(defun hfy-face-at (p)
"Find face in effect at point P.
-If overlays are to be considered (see `hfy-optimisations') then this may
+If overlays are to be considered (see `hfy-optimizations') then this may
return a `defface' style list of face properties instead of a face symbol."
;;(message "hfy-face-at");;DBUG
;; Fix-me: clean up, remove face-name etc
@@ -1327,9 +1329,7 @@ return a `defface' style list of face properties instead of a face symbol."
(defun hfy-overlay-props-at (p)
"Grab overlay properties at point P.
The plists are returned in descending priority order."
- (sort (mapcar #'overlay-properties (overlays-at p))
- (lambda (A B) (> (or (cadr (memq 'priority A)) 0) ;FIXME: plist-get?
- (or (cadr (memq 'priority B)) 0)))))
+ (mapcar #'overlay-properties (overlays-at p 'sorted)))
;; construct an assoc of (face-name . (css-name . "{ css-style }")) elements:
(defun hfy-compile-stylesheet ()
@@ -1598,7 +1598,7 @@ information."
(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
+TEXT-ID TEXT-BEGINS-BLOCK-P) ...). The handler must insert
appropriate tags to begin a span of text.
STYLE is the name of the style that begins at point. It is
@@ -1620,13 +1620,13 @@ span also begins a invisible portion of text.
An implementation can use TEXT-BLOCK, TEXT-ID,
TEXT-BEGINS-BLOCK-P to implement fold/unfold-on-mouse-click like
-behaviour.
+behavior.
The default handler is `hfy-begin-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
+The signature of the handler is \(lambda () ...). The handler
must insert appropriate tags to end a span of text.
The default handler is `hfy-end-span'.")
@@ -1641,7 +1641,6 @@ FILE, if set, is the file name."
(css-map nil)
(invis-ranges nil)
(rovl nil)
- (orig-ovls (overlays-in (point-min) (point-max)))
(rmin (when mark-active (region-beginning)))
(rmax (when mark-active (region-end ))) )
(when (and mark-active
@@ -1663,12 +1662,6 @@ FILE, if set, is the file name."
(set-buffer html-buffer)
;; rip out props that could interfere with our htmlization of the buffer:
(remove-text-properties (point-min) (point-max) hfy-ignored-properties)
- ;; Apply overlay invisible spec
- (setq orig-ovls
- (sort orig-ovls
- (lambda (A B)
- (> (or (cadr (memq 'priority (overlay-properties A))) 0)
- (or (cadr (memq 'priority (overlay-properties B))) 0)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; at this point, html-buffer retains the fontification of the parent:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1708,7 +1701,7 @@ FILE, if set, is the file name."
;; think we only need to relocate the hfy-endl property, as the hfy-linkp
;; property has already served its main purpose by this point.
;;(message "mapcar over the CSS-MAP")
- (message "invis-ranges:\n%S" invis-ranges)
+ ;; (message "invis-ranges:\n%S" invis-ranges)
(dolist (point-face css-map)
(let ((pt (car point-face))
(fn (cdr point-face))
@@ -1803,8 +1796,8 @@ FILE, if set, is the file name."
It is assumed that STRING has text properties that allow it to be
fontified. This is a simple convenience wrapper around
`htmlfontify-buffer'."
- (let* ((hfy-optimisations-1 (copy-sequence hfy-optimisations))
- (hfy-optimisations (add-to-list 'hfy-optimisations-1
+ (let* ((hfy-optimizations-1 (copy-sequence hfy-optimizations))
+ (hfy-optimizations (add-to-list 'hfy-optimizations-1
'skip-refontification)))
(with-temp-buffer
(insert string)
@@ -1817,17 +1810,25 @@ fontified. This is a simple convenience wrapper around
(eval-and-compile (require 'font-lock))
(if (boundp 'font-lock-cache-position)
(or font-lock-cache-position
- (set 'font-lock-cache-position (make-marker))))
- (if (not noninteractive)
- (progn
- (message "hfy interactive mode (%S %S)" window-system major-mode)
- (when (and font-lock-defaults
- font-lock-mode)
- (font-lock-fontify-region (point-min) (point-max) nil)))
+ (setq font-lock-cache-position (make-marker))))
+ (cond
+ (noninteractive
(message "hfy batch mode (%s:%S)"
(or (buffer-file-name) (buffer-name)) major-mode)
- (when font-lock-defaults
- (font-lock-fontify-buffer)) ))
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (when font-lock-defaults
+ (font-lock-fontify-buffer))))
+ ((fboundp #'jit-lock-fontify-now)
+ (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))
+ )))
;;;###autoload
(defun htmlfontify-buffer (&optional srcdir file)
@@ -2111,7 +2112,7 @@ FILE is the specific file we are rendering."
;; functionality easier to implement.
;; ( tar file functionality not merged here because it requires a
;; hacked copy of etags capable of tagging stdin: if Francesco
-;; Potorti accepts a patch, or otherwise implements stdin tagging,
+;; Potortì accepts a patch, or otherwise implements stdin tagging,
;; then I will provide a `htmlfontify-tar-file' defun )
(defun hfy-parse-tags-buffer (srcdir buffer)
"Parse a BUFFER containing etags formatted output, loading the
@@ -2411,8 +2412,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
(load file 'NOERROR nil nil) ))
-;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
-;;;;;; "hfy-cmap" "hfy-cmap.el" "3f97eeabe72027099da579f6ef9ae0bd")
+;;;### (autoloads nil "hfy-cmap" "hfy-cmap.el" "1fb78b15b18622256262c7246b2a3520")
;;; Generated autoloads from hfy-cmap.el
(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
@@ -2433,8 +2433,4 @@ Use a fallback method for obtaining the rgb values for a color.
(provide 'htmlfontify)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; htmlfontify.el ends here
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 1ba0b0f0779..e5df9997b5a 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1,6 +1,6 @@
-;;; ibuf-ext.el --- extensions for ibuffer
+;;; ibuf-ext.el --- extensions for ibuffer -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -523,9 +523,9 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
ibuffer-filter-groups
(append ibuffer-filter-groups
(list (cons "Default" nil))))))
-;; (dolist (hidden ibuffer-hidden-filter-groups)
-;; (setq filter-group-alist (ibuffer-delete-alist
-;; hidden filter-group-alist)))
+ ;; (dolist (hidden ibuffer-hidden-filter-groups)
+ ;; (setq filter-group-alist (ibuffer-delete-alist
+ ;; hidden filter-group-alist)))
(let ((vec (make-vector (length filter-group-alist) nil))
(i 0))
(dolist (filtergroup filter-group-alist)
@@ -540,12 +540,13 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
(cl-incf i)
(setq bmarklist lamers))))
(let (ret)
- (dotimes (j i ret)
+ (dotimes (j i)
(let ((bufs (aref vec j)))
(unless (and noempty (null bufs))
(push (cons (car (nth j filter-group-alist))
bufs)
- ret))))))))
+ ret))))
+ ret))))
;;;###autoload
(defun ibuffer-filters-to-filter-group (name)
@@ -1100,9 +1101,9 @@ Default sorting modes are:
Major Mode - the name of the major mode of the buffer
Size - the size of the buffer"
(interactive)
- (let ((modes (mapcar 'car ibuffer-sorting-functions-alist)))
- (add-to-list 'modes 'recency)
- (setq modes (sort modes 'string-lessp))
+ (let ((modes (mapcar #'car ibuffer-sorting-functions-alist)))
+ (cl-pushnew 'recency modes)
+ (setq modes (sort modes #'string-lessp))
(let ((next (or (car-safe (cdr-safe (memq ibuffer-sorting-mode modes)))
(car modes))))
(setq ibuffer-sorting-mode next)
@@ -1556,7 +1557,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
;;;###autoload
(defun ibuffer-mark-special-buffers ()
- "Mark all buffers whose name begins and ends with '*'."
+ "Mark all buffers whose name begins and ends with `*'."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf) (string-match "^\\*.+\\*$"
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 6cbcbc6f135..cf7f39e9fa5 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -1,6 +1,6 @@
-;;; ibuf-macs.el --- macros for ibuffer
+;;; ibuf-macs.el --- macros for ibuffer -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -111,6 +111,7 @@ change its definition, you should explicitly call
,(if inline
`(push '(,sym ,bod) ibuffer-inline-columns)
`(defun ,sym (buffer mark)
+ (ignore mark) ;Silence byte-compiler if mark is unused.
,bod))
(put (quote ,sym) 'ibuffer-column-name
,(if (stringp name)
@@ -204,7 +205,8 @@ macro for exactly what it does.
(declare (indent 2) (doc-string 3))
`(progn
(defun ,(intern (concat (if (string-match "^ibuffer-do" (symbol-name op))
- "" "ibuffer-do-") (symbol-name op)))
+ "" "ibuffer-do-")
+ (symbol-name op)))
,args
,(if (stringp documentation)
documentation
@@ -247,6 +249,9 @@ macro for exactly what it does.
(_
'ibuffer-map-marked-lines))
#'(lambda (buf mark)
+ ;; Silence warning for code that doesn't
+ ;; use `mark'.
+ (ignore mark)
,(if (eq modifier-p :maybe)
`(let ((ibuffer-tmp-previous-buffer-modification
(buffer-modified-p buf)))
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index ce29505d6f2..89477bd919f 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1,6 +1,6 @@
-;;; ibuffer.el --- operate on buffers like dired
+;;; ibuffer.el --- operate on buffers like dired -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -156,7 +156,7 @@ elisp byte-compiler."
(null buffer-file-name))
italic)
(30 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face)
- (35 (eq major-mode 'dired-mode) font-lock-function-name-face))
+ (35 (derived-mode-p 'dired-mode) font-lock-function-name-face))
"An alist describing how to fontify buffers.
Each element should be of the form (PRIORITY FORM FACE), where
PRIORITY is an integer, FORM is an arbitrary form to evaluate in the
@@ -350,6 +350,7 @@ directory, like `default-directory'."
(defcustom ibuffer-mode-hook nil
"Hook run upon entry into `ibuffer-mode'."
:type 'hook
+ :options '(ibuffer-auto-mode)
:group 'ibuffer)
(defcustom ibuffer-load-hook nil
@@ -539,10 +540,6 @@ directory, like `default-directory'."
(define-key map (kbd "/ X") 'ibuffer-delete-saved-filter-groups)
(define-key map (kbd "/ \\") 'ibuffer-clear-filter-groups)
- (define-key map (kbd "q") 'ibuffer-quit)
- (define-key map (kbd "h") 'describe-mode)
- (define-key map (kbd "?") 'describe-mode)
-
(define-key map (kbd "% n") 'ibuffer-mark-by-name-regexp)
(define-key map (kbd "% m") 'ibuffer-mark-by-mode-regexp)
(define-key map (kbd "% f") 'ibuffer-mark-by-file-name-regexp)
@@ -706,7 +703,8 @@ directory, like `default-directory'."
'(menu-item "Diff with file" ibuffer-diff-with-file
:help "View the differences between this buffer and its file"))
(define-key-after map [menu-bar view auto-mode]
- '(menu-item "Toggle Auto Mode" ibuffer-auto-mode
+ '(menu-item "Auto Mode" ibuffer-auto-mode
+ :button (:toggle . ibuffer-auto-mode)
:help "Attempt to automatically update the Ibuffer buffer"))
(define-key-after map [menu-bar view customize]
'(menu-item "Customize Ibuffer" ibuffer-customize
@@ -876,12 +874,6 @@ directory, like `default-directory'."
(define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
map))
-(defvar ibuffer-restore-window-config-on-quit nil
- "If non-nil, restore previous window configuration upon exiting `ibuffer'.")
-
-(defvar ibuffer-prev-window-config nil
- "Window configuration before starting Ibuffer.")
-
(defvar ibuffer-did-modification nil)
(defvar ibuffer-compiled-formats nil)
@@ -915,7 +907,7 @@ width and the longest string in LIST."
(when (zerop columns)
(setq columns 1))
(while list
- (dotimes (i (1- columns))
+ (dotimes (_ (1- columns))
(insert (concat (car list) (make-string (- max (length (car list)))
?\s)))
(setq list (cdr list)))
@@ -1283,7 +1275,7 @@ a new window in the current frame, splitting vertically."
:modifier-p t)
(set-buffer-modified-p (not (buffer-modified-p))))
-(define-ibuffer-op ibuffer-do-toggle-read-only (&optional arg)
+(define-ibuffer-op ibuffer-do-toggle-read-only (&optional _arg);FIXME:arg unused!
"Toggle read only status in marked buffers.
With optional ARG, make read-only only if ARG is not negative."
(:opstring "toggled read only status in"
@@ -1528,7 +1520,7 @@ If point is on a group name, this function operates on that group."
;; We use these variables to keep track of which variables
;; inside the generated function we need to bind, since
;; binding variables in Emacs takes time.
- str-used tmp1-used tmp2-used global-strlen-used)
+ (vars-used ()))
(dolist (form format)
(push
;; Generate a form based on a particular format entry, like
@@ -1554,8 +1546,8 @@ If point is on a group name, this function operates on that group."
;; This is a complex case; they want it limited to a
;; minimum size.
(setq min-used t)
- (setq str-used t strlen-used t global-strlen-used t
- tmp1-used t tmp2-used t)
+ (setq strlen-used t)
+ (setq vars-used '(str strlen tmp1 tmp2))
;; Generate code to limit the string to a minimum size.
(setq minform `(progn
(setq str
@@ -1567,7 +1559,8 @@ If point is on a group name, this function operates on that group."
strlen)
align)))))
(when (or (not (integerp max)) (> max 0))
- (setq str-used t max-used t)
+ (setq max-used t)
+ (cl-pushnew 'str vars-used)
;; Generate code to limit the string to a maximum size.
(setq maxform `(progn
(setq str
@@ -1595,8 +1588,9 @@ If point is on a group name, this function operates on that group."
;; don't even understand it, and I wrote it five
;; minutes ago.
(insertgenfn
- (ibuffer-aif (get sym 'ibuffer-column-summarizer)
+ (if (get sym 'ibuffer-column-summarizer)
;; I really, really wish Emacs Lisp had closures.
+ ;; FIXME: Elisp does have them now.
(lambda (arg sym)
`(insert
(let ((ret ,arg))
@@ -1604,7 +1598,7 @@ If point is on a group name, this function operates on that group."
(cons ret (get ',sym
'ibuffer-column-summary)))
ret)))
- (lambda (arg sym)
+ (lambda (arg _sym)
`(insert ,arg))))
(mincompform `(< strlen ,(if (integerp min)
min
@@ -1632,10 +1626,9 @@ If point is on a group name, this function operates on that group."
`(when ,maxcompform
,maxform)))
outforms)
- (push (append
- `(setq str ,callform)
- (when strlen-used
- `(strlen (length str))))
+ (push `(setq str ,callform
+ ,@(when strlen-used
+ `(strlen (length str))))
outforms)
(setq outforms
(append outforms
@@ -1648,25 +1641,17 @@ If point is on a group name, this function operates on that group."
`(let ,letbindings
,@outforms)))))
result))
- (setq result
- ;; We don't want to unconditionally load the byte-compiler.
- (funcall (if (or ibuffer-always-compile-formats
- (featurep 'bytecomp))
- #'byte-compile
- #'identity)
- ;; Here, we actually create a lambda form which
- ;; inserts all the generated forms for each entry
- ;; in the format string.
- (nconc (list 'lambda '(buffer mark))
- `((let ,(append (when str-used
- '(str))
- (when global-strlen-used
- '(strlen))
- (when tmp1-used
- '(tmp1))
- (when tmp2-used
- '(tmp2)))
- ,@(nreverse result))))))))
+ ;; We don't want to unconditionally load the byte-compiler.
+ (funcall (if (or ibuffer-always-compile-formats
+ (featurep 'bytecomp))
+ #'byte-compile
+ #'identity)
+ ;; Here, we actually create a lambda form which
+ ;; inserts all the generated forms for each entry
+ ;; in the format string.
+ `(lambda (buffer mark)
+ (let ,vars-used
+ ,@(nreverse result))))))
(defun ibuffer-recompile-formats ()
"Recompile `ibuffer-formats'."
@@ -1684,8 +1669,8 @@ If point is on a group name, this function operates on that group."
(defun ibuffer-clear-summary-columns (format)
(dolist (form format)
- (ibuffer-awhen (and (consp form)
- (get (car form) 'ibuffer-column-summarizer))
+ (when (and (consp form)
+ (get (car form) 'ibuffer-column-summarizer))
(put (car form) 'ibuffer-column-summary nil))))
(defun ibuffer-check-formats ()
@@ -1800,7 +1785,7 @@ If point is on a group name, this function operates on that group."
(let ((procs 0)
(files 0))
(dolist (string strings)
- (if (string-match "\\(\?:\\`(\[\[:ascii:\]\]\+)\\)" string)
+ (if (string-match "\\(?:\\`([[:ascii:]]+)\\)" string)
(progn (setq procs (1+ procs))
(if (< (match-end 0) (length string))
(setq files (1+ files))))
@@ -1923,9 +1908,9 @@ the buffer object itself and the current mark symbol."
;; Kill the line if the buffer is dead
'kill)))
;; A given mapping function should return:
- ;; `nil' if it chose not to affect the buffer
+ ;; nil if it chose not to affect the buffer
;; `kill' means the remove line from the buffer list
- ;; `t' otherwise
+ ;; t otherwise
(cl-incf ibuffer-map-lines-total)
(cond ((null result)
(forward-line 1))
@@ -2052,7 +2037,7 @@ the value of point at the beginning of the line for that buffer."
(defun ibuffer-update-title-and-summary (format)
(ibuffer-assert-ibuffer-mode)
;; Don't do funky font-lock stuff here
- (let ((after-change-functions nil))
+ (let ((inhibit-modification-hooks t))
(if (get-text-property (point-min) 'ibuffer-title)
(delete-region (point-min)
(next-single-property-change
@@ -2177,7 +2162,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(eq ibuffer-always-show-last-buffer
:nomini)
(minibufferp (cadr bufs)))
- (cl-caddr bufs)
+ (nth 2 bufs)
(cadr bufs))
(ibuffer-current-buffers-with-marks bufs)
ibuffer-display-maybe-show-predicates)))
@@ -2209,7 +2194,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(require 'ibuf-ext))
(let* ((sortdat (assq ibuffer-sorting-mode
ibuffer-sorting-functions-alist))
- (func (cl-caddr sortdat)))
+ (func (nth 2 sortdat)))
(let ((result
;; actually sort the buffers
(if (and sortdat func)
@@ -2259,7 +2244,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(orig (count-lines (point-min) (point)))
;; Inhibit font-lock caching tricks, since we're modifying the
;; entire buffer at once
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(ext-loaded (featurep 'ibuf-ext))
(bgroups (if ext-loaded
(ibuffer-generate-filter-groups bmarklist)
@@ -2296,18 +2281,6 @@ If optional arg SILENT is non-nil, do not display progress messages."
(goto-char (point-min))
(forward-line orig))))
-(defun ibuffer-quit ()
- "Quit this `ibuffer' session.
-Try to restore the previous window configuration if
-`ibuffer-restore-window-config-on-quit' is non-nil."
- (interactive)
- (if ibuffer-restore-window-config-on-quit
- (progn
- (bury-buffer)
- (unless (= (count-windows) 1)
- (set-window-configuration ibuffer-prev-window-config)))
- (bury-buffer)))
-
;;;###autoload
(defun ibuffer-list-buffers (&optional files-only)
"Display a list of buffers, in another window.
@@ -2330,7 +2303,7 @@ buffers which are visiting a file."
(defun ibuffer (&optional other-window-p name qualifiers noselect
shrink filter-groups formats)
"Begin using Ibuffer to edit a list of buffers.
-Type 'h' after entering ibuffer for more information.
+Type `h' after entering ibuffer for more information.
All arguments are optional.
OTHER-WINDOW-P says to use another window.
@@ -2348,7 +2321,6 @@ FORMATS is the value to use for `ibuffer-formats'.
(interactive "P")
(when ibuffer-use-other-window
(setq other-window-p t))
- (setq ibuffer-prev-window-config (current-window-configuration))
(let ((buf (get-buffer-create (or name "*Ibuffer*"))))
(if other-window-p
(funcall (if noselect (lambda (buf) (display-buffer buf t)) #'pop-to-buffer) buf)
@@ -2358,10 +2330,9 @@ FORMATS is the value to use for `ibuffer-formats'.
;; We switch to the buffer's window in order to be able
;; to modify the value of point
(select-window (get-buffer-window buf 0))
- (or (eq major-mode 'ibuffer-mode)
+ (or (derived-mode-p 'ibuffer-mode)
(ibuffer-mode))
- (setq ibuffer-restore-window-config-on-quit other-window-p)
- (when shrink
+ (when shrink
(setq ibuffer-shrink-to-minimum-size shrink))
(when qualifiers
(require 'ibuf-ext)
@@ -2383,7 +2354,7 @@ FORMATS is the value to use for `ibuffer-formats'.
(message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for help"))))))
(put 'ibuffer-mode 'mode-class 'special)
-(defun ibuffer-mode ()
+(define-derived-mode ibuffer-mode special-mode "IBuffer"
"A major mode for viewing a list of buffers.
In Ibuffer, you can conveniently perform many operations on the
currently open buffers, in addition to filtering your view to a
@@ -2391,123 +2362,122 @@ particular subset of them, and sorting by various criteria.
Operations on marked buffers:
\\<ibuffer-mode-map>
- '\\[ibuffer-do-save]' - Save the marked buffers
- '\\[ibuffer-do-view]' - View the marked buffers in this frame.
- '\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
- '\\[ibuffer-do-revert]' - Revert the marked buffers.
- '\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers.
- '\\[ibuffer-do-delete]' - Kill the marked buffers.
- '\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers.
- '\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers.
- '\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked
+ `\\[ibuffer-do-save]' - Save the marked buffers
+ `\\[ibuffer-do-view]' - View the marked buffers in this frame.
+ `\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
+ `\\[ibuffer-do-revert]' - Revert the marked buffers.
+ `\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers.
+ `\\[ibuffer-do-delete]' - Kill the marked buffers.
+ `\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers.
+ `\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers.
+ `\\[ibuffer-do-replace-regexp]' - Replace by regexp in each of the marked
buffers.
- '\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers.
- '\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression.
- '\\[ibuffer-do-print]' - Print the marked buffers.
- '\\[ibuffer-do-occur]' - List lines in all marked buffers which match
+ `\\[ibuffer-do-query-replace]' - Query replace in each of the marked buffers.
+ `\\[ibuffer-do-query-replace-regexp]' - As above, with a regular expression.
+ `\\[ibuffer-do-print]' - Print the marked buffers.
+ `\\[ibuffer-do-occur]' - List lines in all marked buffers which match
a given regexp (like the function `occur').
- '\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked
+ `\\[ibuffer-do-shell-command-pipe]' - Pipe the contents of the marked
buffers to a shell command.
- '\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked
+ `\\[ibuffer-do-shell-command-pipe-replace]' - Replace the contents of the marked
buffers with the output of a shell command.
- '\\[ibuffer-do-shell-command-file]' - Run a shell command with the
+ `\\[ibuffer-do-shell-command-file]' - Run a shell command with the
buffer's file as an argument.
- '\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This
+ `\\[ibuffer-do-eval]' - Evaluate a form in each of the marked buffers. This
is a very flexible command. For example, if you want to make all
of the marked buffers read only, try using (read-only-mode 1) as
the input form.
- '\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
+ `\\[ibuffer-do-view-and-eval]' - As above, but view each buffer while the form
is evaluated.
- '\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer,
+ `\\[ibuffer-do-kill-lines]' - Remove the marked lines from the *Ibuffer* buffer,
but don't kill the associated buffer.
- '\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion.
+ `\\[ibuffer-do-kill-on-deletion-marks]' - Kill all buffers marked for deletion.
Marking commands:
- '\\[ibuffer-mark-forward]' - Mark the buffer at point.
- '\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark
+ `\\[ibuffer-mark-forward]' - Mark the buffer at point.
+ `\\[ibuffer-toggle-marks]' - Unmark all currently marked buffers, and mark
all unmarked buffers.
- '\\[ibuffer-unmark-forward]' - Unmark the buffer at point.
- '\\[ibuffer-unmark-backward]' - Unmark the buffer at point, and move to the
+ `\\[ibuffer-unmark-forward]' - Unmark the buffer at point.
+ `\\[ibuffer-unmark-backward]' - Unmark the buffer at point, and move to the
previous line.
- '\\[ibuffer-unmark-all]' - Unmark all marked buffers.
- '\\[ibuffer-mark-by-mode]' - Mark buffers by major mode.
- '\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers.
+ `\\[ibuffer-unmark-all]' - Unmark all marked buffers.
+ `\\[ibuffer-mark-by-mode]' - Mark buffers by major mode.
+ `\\[ibuffer-mark-unsaved-buffers]' - Mark all \"unsaved\" buffers.
This means that the buffer is modified, and has an associated file.
- '\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers,
+ `\\[ibuffer-mark-modified-buffers]' - Mark all modified buffers,
regardless of whether or not they have an associated file.
- '\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and
- ends with '*'.
- '\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have
+ `\\[ibuffer-mark-special-buffers]' - Mark all buffers whose name begins and
+ ends with `*'.
+ `\\[ibuffer-mark-dissociated-buffers]' - Mark all buffers which have
an associated file, but that file doesn't currently exist.
- '\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers.
- '\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired' mode.
- '\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc.
- '\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'.
- '\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion.
- '\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp.
- '\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp.
- '\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp.
+ `\\[ibuffer-mark-read-only-buffers]' - Mark all read-only buffers.
+ `\\[ibuffer-mark-dired-buffers]' - Mark buffers in `dired' mode.
+ `\\[ibuffer-mark-help-buffers]' - Mark buffers in `help-mode', `apropos-mode', etc.
+ `\\[ibuffer-mark-old-buffers]' - Mark buffers older than `ibuffer-old-time'.
+ `\\[ibuffer-mark-for-delete]' - Mark the buffer at point for deletion.
+ `\\[ibuffer-mark-by-name-regexp]' - Mark buffers by their name, using a regexp.
+ `\\[ibuffer-mark-by-mode-regexp]' - Mark buffers by their major mode, using a regexp.
+ `\\[ibuffer-mark-by-file-name-regexp]' - Mark buffers by their filename, using a regexp.
Filtering commands:
- '\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
- '\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
- '\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
- '\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
- '\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
- '\\[ibuffer-filter-by-filename]' - Add a filter by filename.
- '\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
- '\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
- '\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate.
- '\\[ibuffer-save-filters]' - Save the current filters with a name.
- '\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
- '\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
- '\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
- '\\[ibuffer-pop-filter]' - Remove the top filter.
- '\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
- '\\[ibuffer-decompose-filter]' - Break down the topmost filter.
- '\\[ibuffer-filter-disable]' - Remove all filtering currently in effect.
+ `\\[ibuffer-filter-by-mode]' - Add a filter by any major mode.
+ `\\[ibuffer-filter-by-used-mode]' - Add a filter by a major mode now in use.
+ `\\[ibuffer-filter-by-derived-mode]' - Add a filter by derived mode.
+ `\\[ibuffer-filter-by-name]' - Add a filter by buffer name.
+ `\\[ibuffer-filter-by-content]' - Add a filter by buffer content.
+ `\\[ibuffer-filter-by-filename]' - Add a filter by filename.
+ `\\[ibuffer-filter-by-size-gt]' - Add a filter by buffer size.
+ `\\[ibuffer-filter-by-size-lt]' - Add a filter by buffer size.
+ `\\[ibuffer-filter-by-predicate]' - Add a filter by an arbitrary Lisp predicate.
+ `\\[ibuffer-save-filters]' - Save the current filters with a name.
+ `\\[ibuffer-switch-to-saved-filters]' - Switch to previously saved filters.
+ `\\[ibuffer-add-saved-filters]' - Add saved filters to current filters.
+ `\\[ibuffer-or-filter]' - Replace the top two filters with their logical OR.
+ `\\[ibuffer-pop-filter]' - Remove the top filter.
+ `\\[ibuffer-negate-filter]' - Invert the logical sense of the top filter.
+ `\\[ibuffer-decompose-filter]' - Break down the topmost filter.
+ `\\[ibuffer-filter-disable]' - Remove all filtering currently in effect.
Filter group commands:
- '\\[ibuffer-filters-to-filter-group]' - Create filter group from filters.
- '\\[ibuffer-pop-filter-group]' - Remove top filter group.
- '\\[ibuffer-forward-filter-group]' - Move to the next filter group.
- '\\[ibuffer-backward-filter-group]' - Move to the previous filter group.
- '\\[ibuffer-clear-filter-groups]' - Remove all active filter groups.
- '\\[ibuffer-save-filter-groups]' - Save the current groups with a name.
- '\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups.
- '\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups.
+ `\\[ibuffer-filters-to-filter-group]' - Create filter group from filters.
+ `\\[ibuffer-pop-filter-group]' - Remove top filter group.
+ `\\[ibuffer-forward-filter-group]' - Move to the next filter group.
+ `\\[ibuffer-backward-filter-group]' - Move to the previous filter group.
+ `\\[ibuffer-clear-filter-groups]' - Remove all active filter groups.
+ `\\[ibuffer-save-filter-groups]' - Save the current groups with a name.
+ `\\[ibuffer-switch-to-saved-filter-groups]' - Restore previously saved groups.
+ `\\[ibuffer-delete-saved-filter-groups]' - Delete previously saved groups.
Sorting commands:
- '\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes.
- '\\[ibuffer-invert-sorting]' - Reverse the current sorting order.
- '\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically.
- '\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name.
- '\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time.
- '\\[ibuffer-do-sort-by-size]' - Sort the buffers by size.
- '\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode.
+ `\\[ibuffer-toggle-sorting-mode]' - Rotate between the various sorting modes.
+ `\\[ibuffer-invert-sorting]' - Reverse the current sorting order.
+ `\\[ibuffer-do-sort-by-alphabetic]' - Sort the buffers lexicographically.
+ `\\[ibuffer-do-sort-by-filename/process]' - Sort the buffers by the file name.
+ `\\[ibuffer-do-sort-by-recency]' - Sort the buffers by last viewing time.
+ `\\[ibuffer-do-sort-by-size]' - Sort the buffers by size.
+ `\\[ibuffer-do-sort-by-major-mode]' - Sort the buffers by major mode.
Other commands:
- '\\[ibuffer-update]' - Regenerate the list of all buffers.
+ `\\[ibuffer-update]' - Regenerate the list of all buffers.
Prefix arg means to toggle whether buffers that match
`ibuffer-maybe-show-predicates' should be displayed.
- '\\[ibuffer-switch-format]' - Change the current display format.
- '\\[forward-line]' - Move point to the next line.
- '\\[previous-line]' - Move point to the previous line.
- '\\[ibuffer-quit]' - Bury the Ibuffer buffer.
- '\\[describe-mode]' - This help.
- '\\[ibuffer-diff-with-file]' - View the differences between this buffer
+ `\\[ibuffer-switch-format]' - Change the current display format.
+ `\\[forward-line]' - Move point to the next line.
+ `\\[previous-line]' - Move point to the previous line.
+ `\\[describe-mode]' - This help.
+ `\\[ibuffer-diff-with-file]' - View the differences between this buffer
and its associated file.
- '\\[ibuffer-visit-buffer]' - View the buffer on this line.
- '\\[ibuffer-visit-buffer-other-window]' - As above, but in another window.
- '\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select
+ `\\[ibuffer-visit-buffer]' - View the buffer on this line.
+ `\\[ibuffer-visit-buffer-other-window]' - As above, but in another window.
+ `\\[ibuffer-visit-buffer-other-window-noselect]' - As both above, but don't select
the new window.
- '\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line.
+ `\\[ibuffer-bury-buffer]' - Bury (not kill!) the buffer on this line.
** Information on Filtering:
@@ -2515,7 +2485,7 @@ Other commands:
buffer has its own stack of active filters. For example, suppose you
are working on an Emacs Lisp project. You can create an Ibuffer
buffer displays buffers in just `emacs-lisp' modes via
-'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET'. In this case, there
+`\\[ibuffer-filter-by-mode] emacs-lisp-mode RET'. In this case, there
is just one entry on the filtering stack.
You can also combine filters. The various filtering commands push a
@@ -2523,21 +2493,24 @@ new filter onto the stack, and the filters combine to show just
buffers which satisfy ALL criteria on the stack. For example, suppose
you only want to see buffers in `emacs-lisp' mode, whose names begin
with \"gnus\". You can accomplish this via:
-'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET
-\\[ibuffer-filter-by-name] ^gnus RET'.
+
+ \\[ibuffer-filter-by-mode] emacs-lisp-mode RET
+ \\[ibuffer-filter-by-name] ^gnus RET
Additionally, you can OR the top two filters together with
-'\\[ibuffer-or-filters]'. To see all buffers in either
+`\\[ibuffer-or-filters]'. To see all buffers in either
`emacs-lisp-mode' or `lisp-interaction-mode', type:
-'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET \\[ibuffer-filter-by-mode] lisp-interaction-mode RET \\[ibuffer-or-filters]'.
+ \\[ibuffer-filter-by-mode] emacs-lisp-mode RET
+ \\[ibuffer-filter-by-mode] lisp-interaction-mode RET
+ \\[ibuffer-or-filters]
Filters can also be saved and restored using mnemonic names: see the
functions `ibuffer-save-filters' and `ibuffer-switch-to-saved-filters'.
-To remove the top filter on the stack, use '\\[ibuffer-pop-filter]', and
+To remove the top filter on the stack, use `\\[ibuffer-pop-filter]', and
to disable all filtering currently in effect, use
-'\\[ibuffer-filter-disable]'.
+`\\[ibuffer-filter-disable]'.
** Filter Groups:
@@ -2545,12 +2518,13 @@ Once one has mastered filters, the next logical step up is \"filter
groups\". A filter group is basically a named group of buffers which
match a filter, which are displayed together in an Ibuffer buffer. To
create a filter group, simply use the regular functions to create a
-filter, and then type '\\[ibuffer-filters-to-filter-group]'.
+filter, and then type `\\[ibuffer-filters-to-filter-group]'.
A quick example will make things clearer. Suppose that one wants to
-group all of one's Emacs Lisp buffers together. To do this, type
+group all of one's Emacs Lisp buffers together. To do this, type:
-'\\[ibuffer-filter-by-mode] emacs-lisp-mode RET \\[ibuffer-filters-to-filter-group] RET emacs lisp buffers RET'
+ \\[ibuffer-filter-by-mode] emacs-lisp-mode RET
+ \\[ibuffer-filters-to-filter-group] emacs lisp buffers RET
You may, of course, name the group whatever you want; it doesn't have
to be \"emacs lisp buffers\". Filter groups may be composed of any
@@ -2562,12 +2536,8 @@ multiple filter groups; instead, the first filter group is used. The
filter groups are displayed in this order of precedence.
You may rearrange filter groups by using the regular
-'\\[ibuffer-kill-line]' and '\\[ibuffer-yank]' pair. Yanked groups
+`\\[ibuffer-kill-line]' and `\\[ibuffer-yank]' pair. Yanked groups
will be inserted before the group at point."
- (kill-all-local-variables)
- (use-local-map ibuffer-mode-map)
- (setq major-mode 'ibuffer-mode)
- (setq mode-name "Ibuffer")
;; Include state info next to the mode name.
(set (make-local-variable 'mode-line-process)
'(" by "
@@ -2618,7 +2588,6 @@ will be inserted before the group at point."
(set (make-local-variable 'ibuffer-cached-eliding-string) nil)
(set (make-local-variable 'ibuffer-cached-elide-long-columns) nil)
(set (make-local-variable 'ibuffer-current-format) nil)
- (set (make-local-variable 'ibuffer-restore-window-config-on-quit) nil)
(set (make-local-variable 'ibuffer-did-modification) nil)
(set (make-local-variable 'ibuffer-tmp-hide-regexps) nil)
(set (make-local-variable 'ibuffer-tmp-show-regexps) nil)
@@ -2627,13 +2596,12 @@ will be inserted before the group at point."
(ibuffer-update-format)
(when ibuffer-default-directory
(setq default-directory ibuffer-default-directory))
- (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
- (run-mode-hooks 'ibuffer-mode-hook))
+ (add-hook 'change-major-mode-hook 'font-lock-defontify nil t))
;;; Start of automatically extracted autoloads.
-;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "d06b2735a74954e0c6922a811de7608c")
+;;;### (autoloads nil "ibuf-ext" "ibuf-ext.el" "65ef908165926cf48da6f43fd01ef50b")
;;; Generated autoloads from ibuf-ext.el
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
@@ -2980,7 +2948,7 @@ Mark buffers which have not been viewed in `ibuffer-old-time' hours.
\(fn)" t nil)
(autoload 'ibuffer-mark-special-buffers "ibuf-ext" "\
-Mark all buffers whose name begins and ends with '*'.
+Mark all buffers whose name begins and ends with `*'.
\(fn)" t nil)
@@ -3010,8 +2978,4 @@ defaults to one.
(run-hooks 'ibuffer-load-hook)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; ibuffer.el ends here
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 104e3363831..9c712db71bf 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -1,12 +1,11 @@
;;; icomplete.el --- minibuffer completion incremental feedback
-;; Copyright (C) 1992-1994, 1997, 1999, 2001-2013 Free Software
+;; Copyright (C) 1992-1994, 1997, 1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Ken Manheimer <klm@i.am>
;; Maintainer: Ken Manheimer <klm@i.am>
;; Created: Mar 1993 Ken Manheimer, klm@nist.gov - first release to usenet
-;; Last update: Ken Manheimer <klm@i.am>, 11/18/1999.
;; Keywords: help, abbrev
;; This file is part of GNU Emacs.
@@ -26,7 +25,7 @@
;;; Commentary:
-;; Loading this package implements a more fine-grained minibuffer
+;; Enabling this package implements a more fine-grained minibuffer
;; completion feedback scheme. Prospective completions are concisely
;; indicated within the minibuffer itself, with each successive
;; keystroke.
@@ -38,14 +37,7 @@
;; customize icomplete setup for interoperation with other
;; minibuffer-oriented packages.
-;; To activate icomplete mode, load the package and use the
-;; `icomplete-mode' function. You can subsequently deactivate it by
-;; invoking the function icomplete-mode with a negative prefix-arg
-;; (C-U -1 ESC-x icomplete-mode). Also, you can prevent activation of
-;; the mode during package load by first setting the variable
-;; `icomplete-mode' to nil. Icompletion can be enabled any time after
-;; the package is loaded by invoking icomplete-mode without a prefix
-;; arg.
+;; To enable/disable icomplete mode, use the `icomplete-mode' function.
;; Thanks to everyone for their suggestions for refinements of this
;; package. I particularly have to credit Michael Cook, who
@@ -58,13 +50,10 @@
;;; Code:
-;;;_* Provide
-(provide 'icomplete)
-
-
(defgroup icomplete nil
"Show completions dynamically in minibuffer."
:prefix "icomplete-"
+ :link '(info-link "(emacs)Icomplete")
:group 'minibuffer)
(defvar icomplete-prospects-length 80)
@@ -72,7 +61,7 @@
'icomplete-prospects-length 'icomplete-prospects-height "23.1")
(defcustom icomplete-separator " | "
- "String used by icomplete to separate alternatives in the minibuffer."
+ "String used by Icomplete to separate alternatives in the minibuffer."
:type 'string
:version "24.4")
@@ -80,13 +69,26 @@
"When non-nil, hide common prefix from completion candidates.
When nil, show candidates in full."
:type 'boolean
- :version "24.4"
- :group 'icomplete)
+ :version "24.4")
+
+(defcustom icomplete-show-matches-on-no-input nil
+ "When non-nil, show completions when first prompting for input."
+ :type 'boolean
+ :version "24.4")
-(defface icomplete-first-match '((t :weight bold))
- "Face used by icomplete for highlighting first match."
+(defcustom icomplete-with-completion-tables t
+ "Specialized completion tables with which Icomplete should operate.
+If this is t, Icomplete operates on all tables.
+Otherwise this should be a list of the completion tables (e.g.,
+`internal-complete-buffer') on which Icomplete should operate."
+ ;; Prior to 24.4, not a user-option, default '(internal-complete-buffer).
:version "24.4"
- :group 'icomplete)
+ :type '(choice (const :tag "All" t)
+ (repeat function)))
+
+(defface icomplete-first-match '((t :weight bold))
+ "Face used by Icomplete for highlighting first match."
+ :version "24.4")
;;;_* User Customization variables
(defcustom icomplete-prospects-height
@@ -95,37 +97,33 @@ When nil, show candidates in full."
(+ 1 (/ (+ icomplete-prospects-length 20) (window-width)))
"Maximum number of lines to use in the minibuffer."
:type 'integer
- :group 'icomplete
:version "23.1")
(defcustom icomplete-compute-delay .3
"Completions-computation stall, used only with large-number completions.
See `icomplete-delay-completions-threshold'."
- :type 'number
- :group 'icomplete)
+ :type 'number)
(defcustom icomplete-delay-completions-threshold 400
"Pending-completions number over which to apply `icomplete-compute-delay'."
- :type 'integer
- :group 'icomplete)
+ :type 'integer)
(defcustom icomplete-max-delay-chars 3
- "Maximum number of initial chars to apply icomplete compute delay."
- :type 'integer
- :group 'icomplete)
+ "Maximum number of initial chars to apply `icomplete-compute-delay'."
+ :type 'integer)
+
+(defvar icomplete-in-buffer nil
+ "If non-nil, also use Icomplete when completing in non-mini buffers.")
(defcustom icomplete-minibuffer-setup-hook nil
"Icomplete-specific customization of minibuffer setup.
-This hook is run during minibuffer setup if icomplete is active.
-It is intended for use in customizing icomplete for interoperation
+This hook is run during minibuffer setup if Icomplete is active.
+It is intended for use in customizing Icomplete for interoperation
with other features and packages. For instance:
- \(add-hook 'icomplete-minibuffer-setup-hook
- \(function
- \(lambda ()
- \(make-local-variable 'max-mini-window-height)
- \(setq max-mini-window-height 3))))
+ (add-hook \\='icomplete-minibuffer-setup-hook
+ (lambda () (setq-local max-mini-window-height 3)))
will constrain Emacs to a maximum minibuffer height of 3 lines when
icompletion is occurring."
@@ -140,61 +138,60 @@ icompletion is occurring."
(defvar icomplete-overlay (make-overlay (point-min) (point-min) nil t t)
"Overlay used to display the list of completions.")
-;;;_ = icomplete-pre-command-hook
-(defvar icomplete-pre-command-hook nil
- "Incremental-minibuffer-completion pre-command-hook.
+(defun icomplete-pre-command-hook ()
+ (let ((non-essential t))
+ (icomplete-tidy)))
-Is run in minibuffer before user input when `icomplete-mode' is non-nil.
-Use `icomplete-mode' function to set it up properly for incremental
-minibuffer completion.")
-(add-hook 'icomplete-pre-command-hook 'icomplete-tidy)
-;;;_ = icomplete-post-command-hook
-(defvar icomplete-post-command-hook nil
- "Incremental-minibuffer-completion post-command-hook.
-
-Is run in minibuffer after user input when `icomplete-mode' is non-nil.
-Use `icomplete-mode' function to set it up properly for incremental
-minibuffer completion.")
-(add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
-
-;;;_ = icomplete-with-completion-tables
-(defvar icomplete-with-completion-tables '(internal-complete-buffer)
- "Specialized completion tables with which icomplete should operate.
-
-Icomplete does not operate with any specialized completion tables
-except those on this list.")
+(defun icomplete-post-command-hook ()
+ (let ((non-essential t)) ;E.g. don't prompt for password!
+ (icomplete-exhibit)))
(defvar icomplete-minibuffer-map
(let ((map (make-sparse-keymap)))
(define-key map [?\M-\t] 'minibuffer-force-complete)
- (define-key map [?\C-j] 'minibuffer-force-complete-and-exit)
+ (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))
+ map)
+ "Keymap used by `icomplete-mode' in the minibuffer.")
+
+(defun icomplete-force-complete-and-exit ()
+ "Complete the minibuffer and exit.
+Use the first of the matches if there are any displayed, and use
+the default otherwise."
+ (interactive)
+ (if (or icomplete-show-matches-on-no-input
+ (> (icomplete--field-end) (icomplete--field-beg)))
+ (minibuffer-force-complete-and-exit)
+ (minibuffer-complete-and-exit)))
(defun icomplete-forward-completions ()
"Step forward completions by one entry.
Second entry becomes the first and can be selected with
-`minibuffer-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'."
(interactive)
- (let* ((comps (completion-all-sorted-completions))
+ (let* ((beg (icomplete--field-beg))
+ (end (icomplete--field-end))
+ (comps (completion-all-sorted-completions beg end))
(last (last comps)))
(when comps
(setcdr last (cons (car comps) (cdr last)))
- (completion--cache-all-sorted-completions (cdr comps)))))
+ (completion--cache-all-sorted-completions beg end (cdr comps)))))
(defun icomplete-backward-completions ()
"Step backward completions by one entry.
Last entry becomes the first and can be selected with
-`minibuffer-force-complete-and-exit'."
+`icomplete-force-complete-and-exit'."
(interactive)
- (let* ((comps (completion-all-sorted-completions))
+ (let* ((beg (icomplete--field-beg))
+ (end (icomplete--field-end))
+ (comps (completion-all-sorted-completions beg end))
(last-but-one (last comps 2))
(last (cdr last-but-one)))
(when (consp last) ; At least two elements in comps
(setcdr last-but-one (cdr last))
(push (car last) comps)
- (completion--cache-all-sorted-completions comps))))
+ (completion--cache-all-sorted-completions beg end comps))))
;;;_ > icomplete-mode (&optional prefix)
;;;###autoload
@@ -202,32 +199,66 @@ Last entry becomes the first and can be selected with
"Toggle incremental minibuffer completion (Icomplete mode).
With a prefix argument ARG, enable Icomplete mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil."
+the mode if ARG is omitted or nil.
+
+When this global minor mode is enabled, typing in the minibuffer
+continuously displays a list of possible completions that match
+the string you have typed. See `icomplete-completions' for a
+description of how prospective completions are displayed.
+
+For more information, see Info node `(emacs)Icomplete'.
+For options you can set, `\\[customize-group] icomplete'.
+
+You can use the following key bindings to navigate and select
+completions:
+
+\\{icomplete-minibuffer-map}"
:global t :group 'icomplete
- (if icomplete-mode
- ;; The following is not really necessary after first time -
- ;; no great loss.
- (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup)
- (remove-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup)))
+ (remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)
+ (remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup)
+ (when icomplete-mode
+ (when icomplete-in-buffer
+ (add-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup))
+ (add-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup)))
+
+(defun icomplete--completion-table ()
+ (if (window-minibuffer-p) minibuffer-completion-table
+ (or (nth 2 completion-in-region--data)
+ (message "In %S (w=%S): %S"
+ (current-buffer) (selected-window) (window-minibuffer-p)))))
+(defun icomplete--completion-predicate ()
+ (if (window-minibuffer-p) minibuffer-completion-predicate
+ (nth 3 completion-in-region--data)))
+(defun icomplete--field-string ()
+ (if (window-minibuffer-p) (minibuffer-contents)
+ (buffer-substring-no-properties
+ (nth 0 completion-in-region--data)
+ (nth 1 completion-in-region--data))))
+(defun icomplete--field-beg ()
+ (if (window-minibuffer-p) (minibuffer-prompt-end)
+ (nth 0 completion-in-region--data)))
+(defun icomplete--field-end ()
+ (if (window-minibuffer-p) (point-max)
+ (nth 1 completion-in-region--data)))
;;;_ > icomplete-simple-completing-p ()
(defun icomplete-simple-completing-p ()
- "Non-nil if current window is minibuffer that's doing simple completion.
+ "Non-nil if current window is a minibuffer that's doing simple completion.
Conditions are:
the selected window is a minibuffer,
and not in the middle of macro execution,
- and `minibuffer-completion-table' is not a symbol (which would
+ and the completion table is not a function (which would
indicate some non-standard, non-simple completion mechanism,
- like file-name and other custom-func completions)."
+ like file-name and other custom-func completions),
+ and `icomplete-with-completion-tables' doesn't restrict completion."
- (and (window-minibuffer-p)
- (not executing-kbd-macro)
- minibuffer-completion-table
- (or (not (functionp minibuffer-completion-table))
- (eq icomplete-with-completion-tables t)
- (member minibuffer-completion-table
- icomplete-with-completion-tables))))
+ (unless executing-kbd-macro
+ (let ((table (icomplete--completion-table)))
+ (and table
+ (or (not (functionp table))
+ (eq icomplete-with-completion-tables t)
+ (member table icomplete-with-completion-tables))))))
;;;_ > icomplete-minibuffer-setup ()
(defun icomplete-minibuffer-setup ()
@@ -237,58 +268,83 @@ Usually run by inclusion in `minibuffer-setup-hook'."
(set (make-local-variable 'completion-show-inline-help) nil)
(use-local-map (make-composed-keymap icomplete-minibuffer-map
(current-local-map)))
- (add-hook 'pre-command-hook
- (lambda () (let ((non-essential t))
- (run-hooks 'icomplete-pre-command-hook)))
- nil t)
- (add-hook 'post-command-hook
- (lambda () (let ((non-essential t)) ;E.g. don't prompt for password!
- (run-hooks 'icomplete-post-command-hook)))
- nil t)
- (run-hooks 'icomplete-minibuffer-setup-hook)))
-;
+ (add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t)
+ (add-hook 'post-command-hook #'icomplete-post-command-hook nil t)
+ (run-hooks 'icomplete-minibuffer-setup-hook)
+ (when icomplete-show-matches-on-no-input
+ (icomplete-exhibit))))
+
+(defvar icomplete--in-region-buffer nil)
+
+(defun icomplete--in-region-setup ()
+ (when (or (not completion-in-region-mode)
+ (and icomplete--in-region-buffer
+ (not (eq icomplete--in-region-buffer (current-buffer)))))
+ (with-current-buffer (or icomplete--in-region-buffer (current-buffer))
+ (setq icomplete--in-region-buffer nil)
+ (delete-overlay icomplete-overlay)
+ (kill-local-variable 'completion-show-inline-help)
+ (remove-hook 'pre-command-hook 'icomplete-pre-command-hook t)
+ (remove-hook 'post-command-hook 'icomplete-post-command-hook t)
+ (message nil)))
+ (when (and completion-in-region-mode
+ icomplete-mode (icomplete-simple-completing-p))
+ (setq icomplete--in-region-buffer (current-buffer))
+ (set (make-local-variable 'completion-show-inline-help) nil)
+ (let ((tem (assq 'completion-in-region-mode
+ minor-mode-overriding-map-alist)))
+ (unless (memq icomplete-minibuffer-map (cdr tem))
+ (setcdr tem (make-composed-keymap icomplete-minibuffer-map
+ (cdr tem)))))
+ (add-hook 'pre-command-hook 'icomplete-pre-command-hook nil t)
+ (add-hook 'post-command-hook 'icomplete-post-command-hook nil t)))
+
;;;_* Completion
;;;_ > icomplete-tidy ()
(defun icomplete-tidy ()
- "Remove completions display \(if any) prior to new user input.
-Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode'
-and `minibuffer-setup-hook'."
+ "Remove completions display (if any) prior to new user input.
+Should be run in on the minibuffer `pre-command-hook'.
+See `icomplete-mode' and `minibuffer-setup-hook'."
(delete-overlay icomplete-overlay))
;;;_ > icomplete-exhibit ()
(defun icomplete-exhibit ()
- "Insert icomplete completions display.
-Should be run via minibuffer `post-command-hook'. See `icomplete-mode'
-and `minibuffer-setup-hook'."
- (when (and icomplete-mode (icomplete-simple-completing-p))
+ "Insert Icomplete completions display.
+Should be run via minibuffer `post-command-hook'.
+See `icomplete-mode' and `minibuffer-setup-hook'."
+ (when (and icomplete-mode
+ (icomplete-simple-completing-p)) ;Shouldn't be necessary.
(save-excursion
(goto-char (point-max))
; Insert the match-status information:
- (if (and (> (point-max) (minibuffer-prompt-end))
- buffer-undo-list ; Wait for some user input.
+ (if (and (or icomplete-show-matches-on-no-input
+ (> (icomplete--field-end) (icomplete--field-beg)))
(or
;; Don't bother with delay after certain number of chars:
- (> (- (point) (field-beginning)) icomplete-max-delay-chars)
+ (> (- (point) (icomplete--field-beg))
+ icomplete-max-delay-chars)
;; Don't delay if the completions are known.
completion-all-sorted-completions
;; Don't delay if alternatives number is small enough:
- (and (sequencep minibuffer-completion-table)
- (< (length minibuffer-completion-table)
+ (and (sequencep (icomplete--completion-table))
+ (< (length (icomplete--completion-table))
icomplete-delay-completions-threshold))
;; Delay - give some grace time for next keystroke, before
;; embarking on computing completions:
(sit-for icomplete-compute-delay)))
- (let ((text (while-no-input
- (icomplete-completions
- (field-string)
- minibuffer-completion-table
- minibuffer-completion-predicate
- (not minibuffer-completion-confirm))))
- (buffer-undo-list t)
- deactivate-mark)
+ (let* ((field-string (icomplete--field-string))
+ (text (while-no-input
+ (icomplete-completions
+ field-string
+ (icomplete--completion-table)
+ (icomplete--completion-predicate)
+ (if (window-minibuffer-p)
+ (not minibuffer-completion-confirm)))))
+ (buffer-undo-list t)
+ deactivate-mark)
;; Do nothing if while-no-input was aborted.
(when (stringp text)
(move-overlay icomplete-overlay (point) (point) (current-buffer))
@@ -306,27 +362,31 @@ The display is updated with each minibuffer keystroke during
minibuffer completion.
Prospective completion suffixes (if any) are displayed, bracketed by
-one of \(), \[], or \{} pairs. The choice of brackets is as follows:
+one of (), [], or {} pairs. The choice of brackets is as follows:
- \(...) - a single prospect is identified and matching is enforced,
- \[...] - a single prospect is identified but matching is optional, or
- \{...} - multiple prospects, separated by commas, are indicated, and
+ (...) - a single prospect is identified and matching is enforced,
+ [...] - a single prospect is identified but matching is optional, or
+ {...} - multiple prospects, separated by commas, are indicated, and
further input is required to distinguish a single one.
-The displays for unambiguous matches have ` [Matched]' appended
-\(whether complete or not), or ` \[No matches]', if no eligible
-matches exist. \(Keybindings for uniquely matched commands
-are exhibited within the square braces.)"
+If there are multiple possibilities, `icomplete-separator' separates them.
- (let* ((md (completion--field-metadata (field-beginning)))
- (comps (completion-all-sorted-completions))
+The displays for unambiguous matches have ` [Matched]' appended
+\(whether complete or not), or ` [No matches]', if no eligible
+matches exist."
+ (let* ((minibuffer-completion-table candidates)
+ (minibuffer-completion-predicate predicate)
+ (md (completion--field-metadata (icomplete--field-beg)))
+ (comps (completion-all-sorted-completions
+ (icomplete--field-beg) (icomplete--field-end)))
(last (if (consp comps) (last comps)))
(base-size (cdr last))
(open-bracket (if require-match "(" "["))
(close-bracket (if require-match ")" "]")))
;; `concat'/`mapconcat' is the slow part.
(if (not (consp comps))
- (format " %sNo matches%s" open-bracket close-bracket)
+ (progn ;;(debug (format "Candidates=%S field=%S" candidates name))
+ (format " %sNo matches%s" open-bracket close-bracket))
(if last (setcdr last nil))
(let* ((most-try
(if (and base-size (> base-size 0))
@@ -342,6 +402,7 @@ are exhibited within the square braces.)"
;; a prefix of most, or something else.
(compare (compare-strings name nil nil
most nil nil completion-ignore-case))
+ (ellipsis (if (char-displayable-p ?…) "…" "..."))
(determ (unless (or (eq t compare) (eq t most-try)
(= (setq compare (1- (abs compare)))
(length most)))
@@ -352,14 +413,14 @@ are exhibited within the square braces.)"
(substring most compare))
;; Don't bother truncating if it doesn't gain
;; us at least 2 columns.
- ((< compare 3) most)
- (t (concat "…" (substring most compare))))
+ ((< compare (+ 2 (string-width ellipsis))) most)
+ (t (concat ellipsis (substring most compare))))
close-bracket)))
;;"-prospects" - more than one candidate
(prospects-len (+ (string-width
(or determ (concat open-bracket close-bracket)))
(string-width icomplete-separator)
- 3 ;; take {…} into account
+ (+ 2 (string-width ellipsis)) ;; take {…} into account
(string-width (buffer-string))))
(prospects-max
;; Max total length to use, including the minibuffer content.
@@ -368,20 +429,24 @@ are exhibited within the square braces.)"
;; one line, increase the allowable space accordingly.
(/ prospects-len (window-width)))
(window-width)))
+ ;; Find the common prefix among `comps'.
+ ;; We can't use the optimization below because its assumptions
+ ;; aren't always true, e.g. when completion-cycling (bug#10850):
+ ;; (if (eq t (compare-strings (car comps) nil (length most)
+ ;; most nil nil completion-ignore-case))
+ ;; ;; Common case.
+ ;; (length most)
+ ;; Else, use try-completion.
(prefix (when icomplete-hide-common-prefix
(try-completion "" comps)))
(prefix-len
- ;; Find the common prefix among `comps'.
- ;; We can't use the optimization below because its assumptions
- ;; aren't always true, e.g. when completion-cycling (bug#10850):
- ;; (if (eq t (compare-strings (car comps) nil (length most)
- ;; most nil nil completion-ignore-case))
- ;; ;; Common case.
- ;; (length most)
- ;; Else, use try-completion.
- (and (stringp prefix) (length prefix))) ;;)
+ (and (stringp prefix)
+ ;; Only hide the prefix if the corresponding info
+ ;; is already displayed via `most'.
+ (string-prefix-p prefix most t)
+ (length prefix))) ;;)
prospects comp limit)
- (if (eq most-try t) ;; (or (null (cdr comps))
+ (if (or (eq most-try t) (not (consp (cdr comps))))
(setq prospects nil)
(when (member name comps)
;; NAME is complete but not unique. This scenario poses
@@ -428,10 +493,26 @@ are exhibited within the square braces.)"
(concat determ
"{"
(mapconcat 'identity prospects icomplete-separator)
- (and limit (concat icomplete-separator "…"))
+ (and limit (concat icomplete-separator ellipsis))
"}")
(concat determ " [Matched]"))))))
+;;; Iswitchb compatibility
+
+;; We moved Iswitchb to `obsolete' in 24.4, but autoloads in files in
+;; `obsolete' aren't obeyed (since that would encourage people to keep using
+;; those packages, oblivious to their obsolescence). Given the fact that
+;; Iswitchb was very popular, we decided to keep its autoload for a bit longer,
+;; so we moved it here.
+
+;;;###autoload(when (locate-library "obsolete/iswitchb")
+;;;###autoload (autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
+;;;###autoload (make-obsolete 'iswitchb-mode
+;;;###autoload "use `icomplete-mode' or `ido-mode' instead." "24.4"))
+
+;;;_* Provide
+(provide 'icomplete)
+
;;_* Local emacs vars.
;;Local variables:
;;allout-layout: (-2 :)
diff --git a/lisp/ido.el b/lisp/ido.el
index 39ad3137bc9..6ad354c58f2 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,6 +1,6 @@
;;; ido.el --- interactively do things with buffers and files
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -162,7 +162,7 @@
;;
;; The standard way of completion with Unix-shells and Emacs is to insert a
;; PREFIX and then hitting TAB (or another completion key). Cause of this
-;; behavior has become second nature to a lot of Emacs users `ido' offers in
+;; behavior has become second nature to a lot of Emacs users, Ido offers in
;; addition to the default substring-matching-method (look above) also the
;; prefix-matching-method. The kind of matching is the only difference to
;; the description of the substring-matching above.
@@ -206,15 +206,15 @@
;; Customization
;; -------------
;;
-;; Customize the `ido' group to change the `ido' functionality.
+;; Customize the Ido group to change the Ido functionality.
;;
-;; To modify the keybindings, use the ido-setup-hook. For example:
-;;(add-hook 'ido-setup-hook 'ido-my-keys)
+;; To modify the keybindings, use `define-key' on
+;; `ido-common-completion-map' or one of the specialized keymaps:
+;; `ido-file-dir-completion-map', `ido-file-completion-map' or
+;; `ido-buffer-completion-map'.
;;
-;;(defun ido-my-keys ()
-;; "Add my keybindings for ido."
-;; (define-key ido-completion-map " " 'ido-next-match)
-;; )
+;; (with-eval-after-load 'ido
+;; (define-key ido-common-completion-map " " 'ido-next-match))
;; Seeing all the matching buffers or files
;; ----------------------------------------
@@ -277,7 +277,7 @@
;; If you don't want to rely on the `ido-everywhere' functionality,
;; ido-read-buffer, ido-read-file-name, and ido-read-directory-name
;; can be used by other packages to read a buffer name, a file name,
-;; or a directory name in the `ido' way.
+;; or a directory name in the Ido way.
;;; Acknowledgments
@@ -322,9 +322,10 @@
;;; Code:
(defvar recentf-list)
+(require 'seq)
+
+;;;; Options
-;;; User Variables
-;;
;; These are some things you might want to change.
(defun ido-fractionp (n)
@@ -337,17 +338,19 @@
:group 'convenience
:version "22.1"
:link '(emacs-commentary-link :tag "Commentary" "ido.el")
- :link '(emacs-library-link :tag "Lisp File" "ido.el"))
+ :link '(emacs-library-link :tag "Lisp File" "ido.el")
+ :link '(custom-manual "(ido) Top")
+ :link '(info-link "(ido) Customization"))
;;;###autoload
(defcustom ido-mode nil
"Determines for which buffer/file Ido should be enabled.
The following values are possible:
-- `buffer': Turn only on ido buffer behavior (switching, killing,
+- `buffer': Turn only on Ido buffer behavior (switching, killing,
displaying...)
-- `file': Turn only on ido file behavior (finding, writing, inserting...)
-- `both': Turn on ido buffer and file behavior.
-- nil: Turn off any ido switching.
+- `file': Turn only on Ido file behavior (finding, writing, inserting...)
+- `both': Turn on Ido buffer and file behavior.
+- nil: Turn off any Ido switching.
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'."
@@ -375,7 +378,7 @@ use either \\[customize] or the function `ido-mode'."
'("\\` ")
"List of regexps or functions matching buffer names to ignore.
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
+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)
@@ -384,7 +387,7 @@ example functions that filter buffer names."
'("\\`CVS/" "\\`#" "\\`.#" "\\`\\.\\./" "\\`\\./")
"List of regexps or functions matching file names to ignore.
For example, traditional behavior is not to list files whose names begin
-with a #, for which the regexp is `\\`#'. See the source file for
+with a #, for which the regexp is `\\\\=`#'. See the source file for
example functions that filter filenames."
:type '(repeat (choice regexp function))
:group 'ido)
@@ -428,10 +431,10 @@ in merged file and directory lists."
;; (with-current-buffer name
;; (derived-mode-p 'c-mode)))
;;
-;;(setq ido-ignore-buffers '("^ " ido-ignore-c-mode))
+;;(setq ido-ignore-buffers '("\\` " ido-ignore-c-mode))
;; Examples for setting the value of ido-ignore-files
-;;(setq ido-ignore-files '("^ " "\\.c\\'" "\\.h\\'"))
+;;(setq ido-ignore-files '("\\` " "\\.c\\'" "\\.h\\'"))
(defcustom ido-default-file-method 'raise-frame
"How to visit a new file when using `ido-find-file'.
@@ -465,7 +468,7 @@ See `ido-default-file-method' for details."
:group 'ido)
(defcustom ido-enable-flex-matching nil
- "Non-nil means that `ido' will do flexible string matching.
+ "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."
@@ -474,8 +477,8 @@ in the given sequence will match."
(defcustom ido-enable-regexp nil
- "Non-nil means that `ido' will do regexp matching.
-Value can be toggled within `ido' using `ido-toggle-regexp'."
+ "Non-nil means that Ido will do regexp matching.
+Value can be toggled within Ido using `ido-toggle-regexp'."
:type 'boolean
:group 'ido)
@@ -483,7 +486,7 @@ Value can be toggled within `ido' using `ido-toggle-regexp'."
"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'."
+Value can be toggled within Ido using `ido-toggle-prefix'."
:type 'boolean
:group 'ido)
@@ -497,7 +500,7 @@ as first char even if `ido-enable-prefix' is nil."
;; See http://debbugs.gnu.org/2042 for more info.
(defcustom ido-buffer-disable-smart-matches t
"Non-nil means not to re-order matches for buffer switching.
-By default, ido arranges matches in the following order:
+By default, Ido arranges matches in the following order:
full-matches > suffix matches > prefix matches > remaining matches
@@ -562,7 +565,7 @@ the frame width."
:group 'ido)
(defcustom ido-enable-last-directory-history t
- "Non-nil means that `ido' will remember latest selected directory names.
+ "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)
@@ -583,7 +586,7 @@ the `ido-work-directory-list' list."
(defcustom ido-use-filename-at-point nil
- "Non-nil means that ido shall look for a filename at point.
+ "Non-nil means that Ido shall look for a filename at point.
May use `ffap-guesser' to guess whether text at point is a filename.
If found, use that as the starting point for filename selection."
:type '(choice
@@ -601,38 +604,38 @@ If found, call `find-file-at-point' to visit it."
(defcustom ido-enable-tramp-completion t
- "Non-nil means that ido shall perform tramp method and server name completion.
+ "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)
(defcustom ido-record-ftp-work-directories t
- "Non-nil means record ftp file names in the work directory list."
+ "Non-nil means record FTP file names in the work directory list."
:type 'boolean
:group 'ido)
(defcustom ido-merge-ftp-work-directories nil
- "If nil, merging ignores ftp file names in the work directory list."
+ "If nil, merging ignores FTP file names in the work directory list."
:type 'boolean
:group 'ido)
(defcustom ido-cache-ftp-work-directory-time 1.0
- "Maximum time to cache contents of an ftp directory (in hours).
+ "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."
+If zero, FTP directories are not cached."
:type 'number
:group 'ido)
(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
+ "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)
(defcustom ido-slow-ftp-host-regexps nil
- "List of regexps matching slow ftp hosts (see `ido-slow-ftp-hosts')."
+ "List of regexps matching slow FTP hosts (see `ido-slow-ftp-hosts')."
:type '(repeat regexp)
:group 'ido)
@@ -724,16 +727,16 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'."
:group 'ido)
(defcustom ido-max-directory-size nil
- "Maximum size (in bytes) for directories to use ido completion.
+ "Maximum size (in bytes) for directories to use Ido completion.
\\<ido-completion-map>
-If you enter a directory with a size larger than this size, ido will
+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)
(defcustom ido-rotate-file-list-default nil
- "Non-nil means that `ido' will always rotate file list to get default in front."
+ "Non-nil means that Ido will always rotate file list to get default in front."
:type 'boolean
:group 'ido)
@@ -760,21 +763,23 @@ ask user whether to create buffer, or 'never to never create new buffer."
:group 'ido)
(defcustom ido-setup-hook nil
- "Hook run after the ido variables and keymap have been setup.
+ "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.
+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)
(defcustom ido-separator nil
- "String used by ido to separate the alternatives in the minibuffer.
-Obsolete. Set 3rd element of `ido-decorations' instead."
+ "String used by Ido to separate the alternatives in the minibuffer."
:type '(choice string (const nil))
:group 'ido)
+(make-obsolete-variable 'ido-separator
+ "set 3rd element of `ido-decorations' instead." nil)
-(defcustom ido-decorations '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched]" " [Not readable]" " [Too big]" " [Confirm]")
- "List of strings used by ido to display the alternatives in the minibuffer.
+(defcustom ido-decorations '("{" "}" " | " " | ..." "[" "]" " [No match]"
+ " [Matched]" " [Not readable]" " [Too big]" " [Confirm]")
+ "List of strings used by Ido to display the alternatives in the minibuffer.
There are between 11 and 13 elements in this list:
1st and 2nd elements are used as brackets around the prospect list,
3rd element is the separator between prospects (ignored if
@@ -793,13 +798,11 @@ remaining completion. If absent, elements 5 and 6 are used instead."
:group 'ido)
(defcustom ido-use-virtual-buffers nil
- "Specify how virtual buffers should be used.
-The value can be one of the following:
-
- nil: No virtual buffers are used.
- auto: Use virtual bufferw when the current input matches no
- existing buffers.
+ "If non-nil, refer to past (\"virtual\") buffers as well as existing ones.
+The options are:
+ nil: Do not use virtual buffers.
t: Always use virtual buffers.
+ auto: Use virtual buffers if the current input matches no existing buffer.
Essentially it works as follows: Say you are visiting a file and
the buffer gets cleaned up by midnight.el. Later, you want to
@@ -809,29 +812,30 @@ the `ido-virtual' face, and always at the end), and if you select
it, it opens the file back up again. This allows you to think
less about whether recently opened files are still open or not.
Most of the time you can quit Emacs, restart, and then switch to
-a file buffer that was previously open as if it still were. This
-feature relies upon the `recentf' package, which will be enabled
-if this variable is configured to a non-nil value."
- :version "24.4"
+a file buffer that was previously open as if it still were.
+
+This feature relies upon the `recentf' package, which will be
+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)
(defcustom ido-use-faces t
- "Non-nil means use ido faces to highlighting first match, only match and
+ "Non-nil means use Ido faces to highlighting first match, only match and
subdirs in the alternatives."
:type 'boolean
:group 'ido)
(defface ido-first-match '((t :weight bold))
- "Face used by ido for highlighting first match."
+ "Face used by Ido for highlighting first match."
:group 'ido)
(defface ido-only-match '((((class color))
:foreground "ForestGreen")
(t :slant italic))
- "Face used by ido for highlighting only match."
+ "Face used by Ido for highlighting only match."
:group 'ido)
(defface ido-subdir '((((min-colors 88) (class color))
@@ -839,11 +843,11 @@ subdirs in the alternatives."
(((class color))
:foreground "red")
(t :underline t))
- "Face used by ido for highlighting subdirs in the alternatives."
+ "Face used by Ido for highlighting subdirs in the alternatives."
:group 'ido)
(defface ido-virtual '((t :inherit font-lock-builtin-face))
- "Face used by ido for matching virtual buffer names."
+ "Face used by Ido for matching virtual buffer names."
:version "24.1"
:group 'ido)
@@ -852,7 +856,7 @@ subdirs in the alternatives."
(((class color))
:foreground "yellow" :background "red" :width condensed)
(t :inverse-video t))
- "Face used by ido for highlighting its indicators."
+ "Face used by Ido for highlighting its indicators."
:group 'ido)
(defface ido-incomplete-regexp
@@ -900,7 +904,7 @@ The following variables are available, but should not be changed:
:group 'ido)
(defvar ido-rewrite-file-prompt-rules nil
- "Alist of rewriting rules for directory names in ido prompts.
+ "Alist of rewriting rules for directory names in Ido prompts.
A list of elements of the form (FROM . TO) or (FROM . FUNC), each
meaning to rewrite the directory name if matched by FROM by either
substituting the matched string by TO or calling the function FUNC
@@ -910,7 +914,7 @@ also modify the dynamic variables described for the variable
`ido-rewrite-file-prompt-functions'.")
(defcustom ido-completion-buffer "*Ido Completions*"
- "Name of completion buffer used by ido.
+ "Name of completion buffer used by Ido.
Set to nil to disable completion buffers popping up."
:type 'string
:group 'ido)
@@ -933,39 +937,37 @@ See documentation of `walk-windows' for useful values."
(defcustom ido-minibuffer-setup-hook nil
"Ido-specific customization of minibuffer setup.
-This hook is run during minibuffer setup if `ido' is active.
-It is intended for use in customizing ido for interoperation
+This hook is run during minibuffer setup if Ido is active.
+It is intended for use in customizing Ido for interoperation
with other packages. For instance:
- \(add-hook 'ido-minibuffer-setup-hook
- \(function
- \(lambda ()
- \(make-local-variable 'max-mini-window-height)
- \(setq max-mini-window-height 3))))
+ (add-hook \\='ido-minibuffer-setup-hook
+ (lambda () (setq-local max-mini-window-height 3)))
will constrain Emacs to a maximum minibuffer height of 3 lines when
-ido is running. Copied from `icomplete-minibuffer-setup-hook'."
+Ido is running. Copied from `icomplete-minibuffer-setup-hook'."
:type 'hook
:group 'ido)
(defcustom ido-save-directory-list-file
(locate-user-emacs-file "ido.last" ".ido.last")
- "File in which the ido state is saved between invocations.
+ "File in which the Ido state is saved between invocations.
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."
+Must be set before enabling Ido mode."
+ :version "24.4" ; added locate-user-emacs-file
:type 'string
:group 'ido)
(defcustom ido-read-file-name-as-directory-commands '()
- "List of commands which uses `read-file-name' to read a directory name.
+ "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)
(defcustom ido-read-file-name-non-ido '()
- "List of commands which shall not read file names the ido way.
+ "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)
@@ -977,24 +979,89 @@ The fallback command is passed as an argument to the functions."
:type 'hook
:group 'ido)
-;;; Internal Variables
-
-;; Persistent variables
+;;;; Keymaps
-(defvar ido-completion-map nil
- "Currently active keymap for ido commands.")
+(defvar ido-common-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-a" 'ido-toggle-ignore)
+ (define-key map "\C-c" 'ido-toggle-case)
+ (define-key map "\C-e" 'ido-edit-input)
+ (define-key map "\t" 'ido-complete)
+ (define-key map " " 'ido-complete-space)
+ (define-key map "\C-j" 'ido-select-text)
+ (define-key map "\C-m" 'ido-exit-minibuffer)
+ (define-key map "\C-p" 'ido-toggle-prefix)
+ (define-key map "\C-r" 'ido-prev-match)
+ (define-key map "\C-s" 'ido-next-match)
+ (define-key map [?\C-.] 'ido-next-match)
+ (define-key map [?\C-,] 'ido-prev-match)
+ (define-key map "\C-t" 'ido-toggle-regexp)
+ (define-key map "\C-z" 'ido-undo-merge-work-directory)
+ (define-key map [(control ?\s)] 'ido-restrict-to-matches)
+ (define-key map [(meta ?\s)] 'ido-take-first-match)
+ (define-key map [(control ?@)] 'ido-restrict-to-matches)
+ (define-key map [right] 'ido-next-match)
+ (define-key map [left] 'ido-prev-match)
+ (define-key map "?" 'ido-completion-help)
+ (define-key map "\C-b" 'ido-magic-backward-char)
+ (define-key map "\C-f" 'ido-magic-forward-char)
+ (define-key map "\C-d" 'ido-magic-delete-char)
+ map)
+ "Keymap for all Ido commands.")
-(defvar ido-common-completion-map nil
- "Keymap for all ido commands.")
+(defvar ido-file-dir-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-common-completion-map)
+ (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
+ (define-key map "\C-x\C-f" 'ido-fallback-command)
+ (define-key map "\C-x\C-d" 'ido-enter-dired)
+ (define-key map [down] 'ido-next-match-dir)
+ (define-key map [up] 'ido-prev-match-dir)
+ (define-key map [(meta up)] 'ido-prev-work-directory)
+ (define-key map [(meta down)] 'ido-next-work-directory)
+ (define-key map [backspace] 'ido-delete-backward-updir)
+ (define-key map "\d" 'ido-delete-backward-updir)
+ (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ; BS
+ (define-key map [remap backward-kill-word] 'ido-delete-backward-word-updir) ; M-DEL
+ (define-key map [(control backspace)] 'ido-up-directory)
+ (define-key map "\C-l" 'ido-reread-directory)
+ (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
+ (define-key map [(meta ?b)] 'ido-push-dir)
+ (define-key map [(meta ?v)] 'ido-push-dir-first)
+ (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
+ (define-key map [(meta ?k)] 'ido-forget-work-directory)
+ (define-key map [(meta ?m)] 'ido-make-directory)
+ (define-key map [(meta ?n)] 'ido-next-work-directory)
+ (define-key map [(meta ?o)] 'ido-prev-work-file)
+ (define-key map [(meta control ?o)] 'ido-next-work-file)
+ (define-key map [(meta ?p)] 'ido-prev-work-directory)
+ (define-key map [(meta ?s)] 'ido-merge-work-directories)
+ map)
+ "Keymap for Ido file and directory commands.")
-(defvar ido-file-completion-map nil
- "Keymap for ido file commands.")
+(defvar ido-file-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-file-dir-completion-map)
+ (define-key map "\C-k" 'ido-delete-file-at-head)
+ (define-key map "\C-o" 'ido-copy-current-word)
+ (define-key map "\C-w" 'ido-copy-current-file-name)
+ (define-key map [(meta ?l)] 'ido-toggle-literal)
+ map)
+ "Keymap for Ido file commands.")
-(defvar ido-file-dir-completion-map nil
- "Keymap for ido file and directory commands.")
+(defvar ido-buffer-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map ido-common-completion-map)
+ (define-key map "\C-x\C-f" 'ido-enter-find-file)
+ (define-key map "\C-x\C-b" 'ido-fallback-command)
+ (define-key map "\C-k" 'ido-kill-buffer-at-head)
+ (define-key map [?\C-\S-b] 'ido-bury-buffer-at-head)
+ (define-key map "\C-o" 'ido-toggle-virtual-buffers)
+ map)
+ "Keymap for Ido buffer commands.")
-(defvar ido-buffer-completion-map nil
- "Keymap for ido buffer commands.")
+;;;; Persistent variables
(defvar ido-file-history nil
"History of files selected using `ido-find-file'.")
@@ -1022,11 +1089,14 @@ at the front of this list.")
Each element in the list is of the form (DIR (MTIME) FILE...).")
(defvar ido-ignore-item-temp-list nil
- "List of items to ignore in current ido invocation.
-Intended to be let-bound by functions which call ido repeatedly.
+ "List of items to ignore in current Ido invocation.
+Intended to be let-bound by functions which call Ido repeatedly.
Should never be set permanently.")
-;; Temporary storage
+;;;; Temporary storage
+
+(defvar ido-completion-map nil
+ "Currently active keymap for Ido commands.")
(defvar ido-eoinput 1
"Point where minibuffer input ends and completion info begins.
@@ -1043,19 +1113,19 @@ Copied from `icomplete-eoinput'.")
"Non-nil means we are rotating list of matches.")
(defvar ido-text nil
- "Stores the users string as it is typed in.")
+ "Stores the user's string as it is typed in.")
(defvar ido-text-init nil
- "The initial string for the users string it is typed in.")
+ "The initial string for the user's string it is typed in.")
(defvar ido-input-stack nil
- "Stores the users strings when user hits M-b/M-f.")
+ "Stores the user's strings when user hits M-b/M-f.")
(defvar ido-matches nil
"List of files currently matching `ido-text'.")
(defvar ido-report-no-match t
- "Report [No Match] when no completions matches `ido-text'.")
+ "Report \"[No Match]\" when no completions matches `ido-text'.")
(defvar ido-exit nil
"Flag to monitor how `ido-find-file' exits.
@@ -1069,8 +1139,8 @@ selected.")
"Delay timer for auto merge.")
(defvar ido-use-mycompletion-depth 0
- "Non-nil means use `ido' completion feedback.
-Is set by ido functions to the current `minibuffer-depth',
+ "Non-nil means use Ido completion feedback.
+Is set by Ido functions to the current `minibuffer-depth',
so that it doesn't interfere with other minibuffer usage.")
(defvar ido-incomplete-regexp nil
@@ -1085,13 +1155,14 @@ Value is an integer which is number of chars to right of prompt.")
This is a copy of `recentf-list', pared down and with faces applied.
Only used if `ido-use-virtual-buffers' is non-nil.")
-;;; Variables with dynamic bindings.
-;;; Declared here to keep the byte compiler quiet.
+;;;; Variables with dynamic bindings.
+
+;; These are declared here to keep the byte compiler quiet.
;; Stores the current ido item type ('file, 'dir, 'buffer, or 'list).
(defvar ido-cur-item)
-;;; Stores the current default item
+;; Stores the current default item.
(defvar ido-default-item)
;; Stores the current list of items that will be searched through.
@@ -1281,7 +1352,8 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
(defun ido-is-ftp-directory (&optional dir)
(string-match
(if ido-enable-tramp-completion
- "\\`/[^/:][^/:]+:" ;; like tramp-file-name-regexp-unified, but doesn't match single drive letters
+ ;; like tramp-file-name-regexp-unified, but doesn't match single drive letters
+ "\\`/[^/:][^/:]+:"
"\\`/[^/:][^/:]+:/")
(or dir ido-current-directory)))
@@ -1304,8 +1376,7 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
(defun ido-time-stamp (&optional time)
;; Time is a floating point number (fractions of 1 hour)
- (setq time (or time (current-time)))
- (/ (+ (* (car time) 65536.0) (car (cdr time))) 3600.0))
+ (/ (float-time time) 3600))
(defun ido-cache-ftp-valid (&optional time)
(and (numberp ido-cache-ftp-work-directory-time)
@@ -1351,7 +1422,7 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
(insert "\n)\n")))
(defun ido-save-history ()
- "Save ido history and cache information between sessions."
+ "Save Ido history and cache information between sessions."
(interactive)
(when (and ido-last-directory-list ido-save-directory-list-file)
(let ((buf (get-buffer-create " *ido session*"))
@@ -1372,7 +1443,7 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
(kill-buffer buf)))))
(defun ido-load-history (&optional arg)
- "Load ido history and cache information from previous session.
+ "Load Ido history and cache information from previous session.
With prefix argument, reload history unconditionally."
(interactive "P")
(if (or arg (and ido-save-directory-list-file (not ido-last-directory-list)))
@@ -1395,7 +1466,7 @@ With prefix argument, reload history unconditionally."
(ido-wash-history))
(defun ido-wash-history ()
- "Clean-up ido history and cache information.
+ "Clean-up Ido history and cache information.
Removes badly formatted data and ignored directories."
(interactive)
;; Check format of each of our lists, discard bogus elements
@@ -1501,15 +1572,14 @@ Removes badly formatted data and ignored directories."
(ido-save-history))
(defun ido-common-initialization ()
- (ido-init-completion-maps)
(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.
With a prefix argument ARG, enable this feature if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil."
+positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil."
:global t
:group 'ido
(when (get 'ido-everywhere 'file)
@@ -1521,20 +1591,20 @@ the mode if ARG is omitted or nil."
(when ido-everywhere
(when (memq ido-mode '(both file))
(put 'ido-everywhere 'file (cons read-file-name-function nil))
- (setq read-file-name-function 'ido-read-file-name))
+ (setq read-file-name-function #'ido-read-file-name))
(when (memq ido-mode '(both buffer))
(put 'ido-everywhere 'buffer (cons read-buffer-function nil))
- (setq read-buffer-function 'ido-read-buffer))))
+ (setq read-buffer-function #'ido-read-buffer))))
(defvar ido-minor-mode-map-entry nil)
;;;###autoload
(defun ido-mode (&optional arg)
- "Toggle ido mode on or off.
-With ARG, turn ido-mode on if arg is positive, off otherwise.
-Turning on ido-mode will remap (via a minor-mode keymap) the default
+ "Toggle Ido mode on or off.
+With ARG, turn Ido mode on if arg is positive, off otherwise.
+Turning on Ido mode will remap (via a minor-mode keymap) the default
keybindings for the `find-file' and `switch-to-buffer' families of
-commands to the ido versions of these functions.
+commands to the Ido versions of these functions.
However, if ARG arg equals 'files, remap only commands for files, or
if it equals 'buffers, remap only commands for buffer switching.
This function also adds a hook to the minibuffer."
@@ -1595,119 +1665,51 @@ This function also adds a hook to the minibuffer."
;;; IDO KEYMAP
-(defun ido-init-completion-maps ()
- "Set up the completion keymaps used by `ido'."
- ;; Common map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-a" 'ido-toggle-ignore)
- (define-key map "\C-c" 'ido-toggle-case)
- (define-key map "\C-e" 'ido-edit-input)
- (define-key map "\t" 'ido-complete)
- (define-key map " " 'ido-complete-space)
- (define-key map "\C-j" 'ido-select-text)
- (define-key map "\C-m" 'ido-exit-minibuffer)
- (define-key map "\C-p" 'ido-toggle-prefix)
- (define-key map "\C-r" 'ido-prev-match)
- (define-key map "\C-s" 'ido-next-match)
- (define-key map [?\C-.] 'ido-next-match)
- (define-key map [?\C-,] 'ido-prev-match)
- (define-key map "\C-t" 'ido-toggle-regexp)
- (define-key map "\C-z" 'ido-undo-merge-work-directory)
- (define-key map [(control ?\s)] 'ido-restrict-to-matches)
- (define-key map [(meta ?\s)] 'ido-take-first-match)
- (define-key map [(control ?@)] 'ido-restrict-to-matches)
- (define-key map [right] 'ido-next-match)
- (define-key map [left] 'ido-prev-match)
- (define-key map "?" 'ido-completion-help)
- ;; Magic commands.
- (define-key map "\C-b" 'ido-magic-backward-char)
- (define-key map "\C-f" 'ido-magic-forward-char)
- (define-key map "\C-d" 'ido-magic-delete-char)
- (set-keymap-parent map minibuffer-local-map)
- (setq ido-common-completion-map map))
-
- ;; File and directory map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
- (define-key map "\C-x\C-f" 'ido-fallback-command)
- (define-key map "\C-x\C-d" 'ido-enter-dired)
- (define-key map [down] 'ido-next-match-dir)
- (define-key map [up] 'ido-prev-match-dir)
- (define-key map [(meta up)] 'ido-prev-work-directory)
- (define-key map [(meta down)] 'ido-next-work-directory)
- (define-key map [backspace] 'ido-delete-backward-updir)
- (define-key map "\d" 'ido-delete-backward-updir)
- (define-key map [remap delete-backward-char] 'ido-delete-backward-updir) ; BS
- (define-key map [remap backward-kill-word] 'ido-delete-backward-word-updir) ; M-DEL
-
- (define-key map [(control backspace)] 'ido-up-directory)
- (define-key map "\C-l" 'ido-reread-directory)
- (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
- (define-key map [(meta ?b)] 'ido-push-dir)
- (define-key map [(meta ?v)] 'ido-push-dir-first)
- (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
- (define-key map [(meta ?k)] 'ido-forget-work-directory)
- (define-key map [(meta ?m)] 'ido-make-directory)
- (define-key map [(meta ?n)] 'ido-next-work-directory)
- (define-key map [(meta ?o)] 'ido-prev-work-file)
- (define-key map [(meta control ?o)] 'ido-next-work-file)
- (define-key map [(meta ?p)] 'ido-prev-work-directory)
- (define-key map [(meta ?s)] 'ido-merge-work-directories)
- (set-keymap-parent map ido-common-completion-map)
- (setq ido-file-dir-completion-map map))
-
- ;; File only map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-k" 'ido-delete-file-at-head)
- (define-key map "\C-o" 'ido-copy-current-word)
- (define-key map "\C-w" 'ido-copy-current-file-name)
- (define-key map [(meta ?l)] 'ido-toggle-literal)
- (set-keymap-parent map ido-file-dir-completion-map)
- (setq ido-file-completion-map map))
+(defalias 'ido-init-completion-maps 'ignore "")
+(make-obsolete 'ido-init-completion-maps "it does nothing." "25.1")
- ;; Buffer map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-f" 'ido-enter-find-file)
- (define-key map "\C-x\C-b" 'ido-fallback-command)
- (define-key map "\C-k" 'ido-kill-buffer-at-head)
- (define-key map "\C-o" 'ido-toggle-virtual-buffers)
- (set-keymap-parent map ido-common-completion-map)
- (setq ido-buffer-completion-map map)))
+(defun ido-setup-completion-map ()
+ "Set up the completion keymap used by Ido.
+Create a keymap, bind `ido-completion-map' to it, and depending
+on what is being completed (`ido-cur-item') set its parent keymap
+to one of:
-(defun ido-setup-completion-map ()
- "Set up the keymap for `ido'."
+ `ido-common-completion-map'
+ `ido-file-dir-completion-map'
+ `ido-file-completion-map'
+ `ido-buffer-completion-map'
+If option `ido-context-switch-command' is non-nil or `viper-mode'
+is enabled then some keybindings are changed in the keymap."
;; generated every time so that it can inherit new functions.
(let ((map (make-sparse-keymap))
(viper-p (if (boundp 'viper-mode) viper-mode)))
-
(when viper-p
(define-key map [remap viper-intercept-ESC-key] 'ignore))
-
- (cond
- ((memq ido-cur-item '(file dir))
+ (pcase ido-cur-item
+ ((or `file `dir)
(when ido-context-switch-command
(define-key map "\C-x\C-b" ido-context-switch-command)
(define-key map "\C-x\C-d" 'ignore))
(when viper-p
- (define-key map [remap viper-backward-char] 'ido-delete-backward-updir)
- (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir)
- (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir))
+ (define-key map [remap viper-backward-char]
+ 'ido-delete-backward-updir)
+ (define-key map [remap viper-del-backward-char-in-insert]
+ 'ido-delete-backward-updir)
+ (define-key map [remap viper-delete-backward-word]
+ 'ido-delete-backward-word-updir))
(set-keymap-parent map
(if (eq ido-cur-item 'file)
ido-file-completion-map
ido-file-dir-completion-map)))
-
- ((eq ido-cur-item 'buffer)
+ (`buffer
(when ido-context-switch-command
(define-key map "\C-x\C-f" ido-context-switch-command))
(set-keymap-parent map ido-buffer-completion-map))
-
- (t
+ (_
(set-keymap-parent map ido-common-completion-map)))
-
(setq ido-completion-map map)))
(defun ido-final-slash (dir &optional fix-it)
@@ -2203,7 +2205,7 @@ If INITIAL is non-nil, it specifies the initial input string."
ido-selected))
(defun ido-edit-input ()
- "Edit absolute file name entered so far with ido; terminate by RET.
+ "Edit absolute file name entered so far with Ido; terminate by RET.
If cursor is not at the end of the user input, move to end of input."
(interactive)
(if (not (eobp))
@@ -2273,7 +2275,8 @@ If cursor is not at the end of the user input, move to end of input."
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
- (not (y-or-n-p (format "No buffer matching `%s', create one? " buf))))
+ (not (y-or-n-p (format-message
+ "No buffer matching `%s', create one? " buf))))
nil)
;; buffer doesn't exist
@@ -2283,7 +2286,8 @@ If cursor is not at the end of the user input, move to end of input."
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
- (not (y-or-n-p (format "No buffer matching `%s', create one? " buf))))
+ (not (y-or-n-p (format-message
+ "No buffer matching `%s', create one? " buf))))
nil)
;; create a new buffer
@@ -2354,8 +2358,8 @@ If cursor is not at the end of the user input, move to end of input."
(ido-directory-too-big-p ido-current-directory))))
(when (and (eq item 'file)
- (or ido-use-url-at-point ido-use-filename-at-point))
- (let (fn d)
+ (or ido-use-url-at-point ido-use-filename-at-point))
+ (let (fn)
(require 'ffap)
;; Duplicate code from ffap-guesser as we want different
;; behavior for files and URLs.
@@ -2373,17 +2377,19 @@ If cursor is not at the end of the user input, move to end of input."
(if (eq ido-use-filename-at-point 'guess)
(ffap-guesser)
(ffap-string-at-point))))
- (not (string-match "^http:/" fn))
- (let ((absolute-fn (expand-file-name fn)))
- (setq d (if (file-directory-p absolute-fn)
- (file-name-as-directory absolute-fn)
- (file-name-directory absolute-fn))))
- (file-directory-p d))
- (setq ido-current-directory d)
- (setq initial (file-name-nondirectory fn))))))
+ (not (string-match "\\`http:/" fn)))
+ (let ((absolute-fn (expand-file-name fn)))
+ (cond
+ ((file-directory-p absolute-fn)
+ (setq ido-current-directory
+ (file-name-as-directory absolute-fn)))
+ ((file-directory-p (file-name-directory absolute-fn))
+ (setq ido-current-directory (file-name-directory absolute-fn))
+ (setq initial (file-name-nondirectory absolute-fn)))))))))
(let (ido-saved-vc-hb
- (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends))
+ (vc-handled-backends (and (boundp 'vc-handled-backends)
+ vc-handled-backends))
(ido-work-directory-index -1)
(ido-work-file-index -1)
(ido-find-literal nil))
@@ -2391,11 +2397,13 @@ If cursor is not at the end of the user input, move to end of input."
(unless filename
(setq ido-saved-vc-hb vc-handled-backends)
(let ((minibuffer-completing-file-name t))
- (setq filename (ido-read-internal item
- (or prompt "Find file: ")
- 'ido-file-history
- (and (eq method 'alt-file) buffer-file-name)
- (confirm-nonexistent-file-or-buffer) initial))))
+ (setq filename
+ (ido-read-internal item
+ (or prompt "Find file: ")
+ 'ido-file-history
+ (and (eq method 'alt-file) buffer-file-name)
+ (confirm-nonexistent-file-or-buffer)
+ initial))))
;; Choose the file name: either the text typed in, or the head
;; of the list of matches
@@ -2412,11 +2420,13 @@ If cursor is not at the end of the user input, move to end of input."
((eq ido-exit 'switch-to-buffer)
(ido-buffer-internal
- (if (memq method '(other-window other-frame)) method ido-default-buffer-method)
+ (if (memq method '(other-window other-frame))
+ method ido-default-buffer-method)
nil nil nil ido-text))
((eq ido-exit 'insert-buffer)
- (ido-buffer-internal 'insert 'insert-buffer "Insert buffer: " nil ido-text 'ido-enter-insert-file))
+ (ido-buffer-internal 'insert 'insert-buffer "Insert buffer: "
+ nil ido-text 'ido-enter-insert-file))
((eq ido-exit 'dired)
(funcall (cond ((eq method 'other-window) 'dired-other-window)
@@ -2436,7 +2446,8 @@ If cursor is not at the end of the user input, move to end of input."
((memq method '(dired list-directory))
(if (equal filename ".")
(setq filename ""))
- (let* ((dirname (ido-final-slash (concat ido-current-directory filename) t))
+ (let* ((dirname (ido-final-slash
+ (concat ido-current-directory filename) t))
(file (substring dirname 0 -1)))
(cond
((file-directory-p dirname)
@@ -2457,7 +2468,8 @@ If cursor is not at the end of the user input, move to end of input."
(ido-record-command method dirname)
(ido-record-work-directory)
(funcall method dirname))
- ((y-or-n-p (format "Directory %s does not exist. Create it? " filename))
+ ((y-or-n-p (format "Directory %s does not exist. Create it? "
+ filename))
(ido-record-command method dirname)
(ido-record-work-directory dirname)
(make-directory-internal dirname)
@@ -2503,7 +2515,8 @@ If cursor is not at the end of the user input, move to end of input."
(ido-record-command 'find-file filename)
(add-to-history 'file-name-history filename)
(ido-record-work-directory)
- (ido-visit-buffer (find-file-noselect filename nil ido-find-literal) method))))))
+ (ido-visit-buffer (find-file-noselect filename nil ido-find-literal)
+ method))))))
(defun ido-existing-item-p ()
;; Return non-nil if there is a matching item
@@ -2605,7 +2618,7 @@ If cursor is not at the end of the user input, move to end of input."
(ido-complete)))
(defun ido-undo-merge-work-directory (&optional text try refresh)
- "Undo or redo last ido directory merge operation.
+ "Undo or redo last Ido directory merge operation.
If no merge has yet taken place, toggle automatic merging option."
(interactive)
(cond
@@ -2637,9 +2650,9 @@ If no merge has yet taken place, toggle automatic merging option."
"Move forward in user input or perform magic action.
If no user input is present, or at end of input, perform magic actions:
C-x C-b ... C-f switch to `ido-find-file'.
-C-x C-f ... C-f fallback to non-ido `find-file'.
-C-x C-d ... C-f fallback to non-ido brief `dired'.
-C-x d ... C-f fallback to non-ido `dired'."
+C-x C-f ... C-f fallback to non-Ido `find-file'.
+C-x C-d ... C-f fallback to non-Ido brief `dired'.
+C-x d ... C-f fallback to non-Ido `dired'."
(interactive "P")
(cond
((or arg (not (eobp)))
@@ -2660,7 +2673,7 @@ If no user input is present, or at start of input, perform magic actions:
C-x C-f C-b switch to `ido-switch-buffer'.
C-x C-d C-b switch to `ido-switch-buffer'.
C-x d C-b switch to `ido-switch-buffer'.
-C-x C-b C-b fallback to non-ido `switch-to-buffer'."
+C-x C-b C-b fallback to non-Ido `switch-to-buffer'."
(interactive "P")
(cond
((or arg (> (point) (minibuffer-prompt-end)))
@@ -2733,7 +2746,7 @@ C-x C-f ... C-d enter `dired' on current directory."
(exit-minibuffer)))
(defun ido-toggle-vc ()
- "Disable version control for this file."
+ "Toggle version control for this file."
(interactive)
(if (and ido-mode (eq ido-cur-item 'file))
(progn
@@ -2770,7 +2783,7 @@ See `ido-use-virtual-buffers' for explanation of virtual buffer."
(defun ido-reread-directory ()
"Read current directory again.
May be useful if cached version is no longer valid, but directory
-timestamp has not changed (e.g. with ftp or on Windows)."
+timestamp has not changed (e.g. with FTP or on Windows)."
(interactive)
(if (and ido-mode (memq ido-cur-item '(file dir)))
(progn
@@ -2804,7 +2817,7 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
(exit-minibuffer))
(defun ido-fallback-command ()
- "Fallback to non-ido version of current command."
+ "Fallback to non-Ido version of current command."
(interactive)
(let ((i (length ido-text)))
(while (> i 0)
@@ -2938,7 +2951,7 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
(exit-minibuffer))
(defun ido-wide-find-file (&optional file)
- "Prompt for FILE to search for using find, starting from current directory."
+ "Prompt for FILE to search for using `find', starting from current directory."
(interactive)
(unless file
(let ((enable-recursive-minibuffers t))
@@ -2954,7 +2967,7 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
(exit-minibuffer)))
(defun ido-wide-find-dir (&optional dir)
- "Prompt for DIR to search for using find, starting from current directory."
+ "Prompt for DIR to search for using `find', starting from current directory."
(interactive)
(unless dir
(let ((enable-recursive-minibuffers t))
@@ -2970,7 +2983,7 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
(exit-minibuffer)))
(defun ido-wide-find-dir-or-delete-dir (&optional _dir)
- "Prompt for DIR to search for using find, starting from current directory.
+ "Prompt for DIR to search for using `find', starting from current directory.
If input stack is non-empty, delete current directory component."
(interactive)
(if ido-input-stack
@@ -3170,11 +3183,19 @@ for first matching file."
(if (> i 0)
(setq ido-cur-list (ido-chop ido-cur-list (nth i ido-matches)))))))
-(defun ido-restrict-to-matches ()
- "Set current item list to the currently matched items."
- (interactive)
+(defun ido-restrict-to-matches (&optional removep)
+ "Set current item list to the currently matched items.
+
+When argument REMOVEP is non-nil, the currently matched items are
+instead removed from the current item list."
+ (interactive "P")
(when ido-matches
- (setq ido-cur-list ido-matches
+ (setq ido-cur-list (if removep
+ ;; An important feature is to preserve the
+ ;; order of the elements.
+ (seq-difference ido-cur-list ido-matches)
+ ido-matches)
+ ido-matches ido-cur-list
ido-text-init ""
ido-rescan nil
ido-exit 'keep)
@@ -3470,8 +3491,14 @@ This is to make them appear as if they were \"virtual buffers\"."
;; the file which the user might thought was still open.
(unless recentf-mode (recentf-mode 1))
(setq ido-virtual-buffers nil)
- (let (name)
- (dolist (head recentf-list)
+ (let ((bookmarks (and (boundp 'bookmark-alist)
+ bookmark-alist))
+ name)
+ (dolist (head (append
+ recentf-list
+ (delq nil (mapcar (lambda (bookmark)
+ (cdr (assoc 'filename bookmark)))
+ bookmarks))))
(setq name (file-name-nondirectory head))
;; In case HEAD is a directory with trailing /. See bug#14552.
(when (equal name "")
@@ -3750,13 +3777,13 @@ frame, rather than all frames, regardless of value of `ido-all-frames'."
(not (and (eq ido-cur-item 'buffer)
ido-buffer-disable-smart-matches))
(not ido-enable-regexp)
- (not (string-match "\$\\'" rex0))
+ (not (string-match "$\\'" rex0))
(concat "\\`" rex0 (if slash "/" "") "\\'")))
(suffix-re (and do-full slash
(not (and (eq ido-cur-item 'buffer)
ido-buffer-disable-smart-matches))
(not ido-enable-regexp)
- (not (string-match "\$\\'" rex0))
+ (not (string-match "$\\'" rex0))
(concat rex0 "/\\'")))
(prefix-re (and full-re (not ido-enable-prefix)
(concat "\\`" rexq)))
@@ -3927,7 +3954,7 @@ If `ido-change-word-sub' cannot be found in WORD, return nil."
t))
(defun ido-completion-help ()
- "Show possible completions in a *File Completions* buffer."
+ "Show possible completions in a \"*File Completions*\" buffer."
(interactive)
(setq ido-rescan nil)
(let ((temp-buf (and ido-completion-buffer
@@ -4016,6 +4043,20 @@ If cursor is not at the end of the user input, delete to end of input."
(setq ido-cur-list (delete buf ido-cur-list))
(setq ido-rescan t))))))
+;;; BURY CURRENT BUFFER
+(defun ido-bury-buffer-at-head ()
+ "Bury the buffer at the head of `ido-matches'."
+ (interactive)
+ (let ((enable-recursive-minibuffers t)
+ (buf (ido-name (car ido-matches)))
+ (nextbuf (cadr ido-matches)))
+ (when (get-buffer buf)
+ (bury-buffer buf)
+ (setq ido-default-item nextbuf
+ ido-text-init ido-text
+ ido-exit 'refresh)
+ (exit-minibuffer))))
+
;;; DELETE CURRENT FILE
(defun ido-delete-file-at-head ()
"Delete the file at the head of `ido-matches'.
@@ -4108,31 +4149,31 @@ default is to show it in the same window, unless it is already visible
in another frame.
As you type in a string, all of the buffers matching the string are
-displayed if substring-matching is used \(default). Look at
+displayed if substring-matching is used (default). Look at
`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the
buffer you want, it can then be selected. As you type, most keys have
their normal keybindings, except for the following: \\<ido-buffer-completion-map>
-RET Select the buffer at the front of the list of matches. If the
-list is empty, possibly prompt to create new buffer.
-
-\\[ido-select-text] Use the current input string verbatim.
-
-\\[ido-next-match] Put the first element at the end of the list.
-\\[ido-prev-match] Put the last element at the start of the list.
-\\[ido-complete] Complete a common suffix to the current string that
-matches all buffers. If there is only one match, select that buffer.
-If there is no common suffix, show a list of all matching buffers
-in a separate window.
-\\[ido-edit-input] Edit input string.
-\\[ido-fallback-command] Fallback to non-ido version of current command.
-\\[ido-toggle-regexp] Toggle regexp searching.
-\\[ido-toggle-prefix] Toggle between substring and prefix matching.
-\\[ido-toggle-case] Toggle case-sensitive searching of buffer names.
-\\[ido-completion-help] Show list of matching buffers in separate window.
-\\[ido-enter-find-file] Drop into `ido-find-file'.
-\\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
-\\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'."
+RET\tSelect the buffer at the front of the list of matches.
+\tIf the list is empty, possibly prompt to create new buffer.
+
+\\[ido-select-text]\tUse the current input string verbatim.
+
+\\[ido-next-match]\tPut the first element at the end of the list.
+\\[ido-prev-match]\tPut the last element at the start of the list.
+\\[ido-complete]\tComplete a common suffix to the current string that matches
+\tall buffers. If there is only one match, select that buffer.
+\tIf there is no common suffix, show a list of all matching buffers
+\tin a separate window.
+\\[ido-edit-input]\tEdit input string.
+\\[ido-fallback-command]\tFallback to non-ido version of current command.
+\\[ido-toggle-regexp]\tToggle regexp searching.
+\\[ido-toggle-prefix]\tToggle between substring and prefix matching.
+\\[ido-toggle-case]\tToggle case-sensitive searching of buffer names.
+\\[ido-completion-help]\tShow list of matching buffers in separate window.
+\\[ido-enter-find-file]\tDrop into `ido-find-file'.
+\\[ido-kill-buffer-at-head]\tKill buffer at head of buffer list.
+\\[ido-toggle-ignore]\tToggle ignoring buffers listed in `ido-ignore-buffers'."
(interactive)
(ido-buffer-internal ido-default-buffer-method))
@@ -4158,7 +4199,8 @@ For details of keybindings, see `ido-switch-buffer'."
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'."
(interactive)
- (ido-buffer-internal 'kill 'kill-buffer "Kill buffer: " (buffer-name (current-buffer)) nil 'ignore))
+ (ido-buffer-internal 'kill 'kill-buffer "Kill buffer: "
+ (buffer-name (current-buffer)) nil 'ignore))
;;;###autoload
(defun ido-insert-buffer ()
@@ -4166,7 +4208,8 @@ For details of keybindings, see `ido-switch-buffer'."
The buffer name is selected interactively by typing a substring.
For details of keybindings, see `ido-switch-buffer'."
(interactive)
- (ido-buffer-internal 'insert 'insert-buffer "Insert buffer: " nil nil 'ido-enter-insert-file))
+ (ido-buffer-internal 'insert 'insert-buffer "Insert buffer: "
+ nil nil 'ido-enter-insert-file))
;;;###autoload
(defun ido-switch-buffer-other-frame ()
@@ -4189,42 +4232,45 @@ For details of keybindings, see `ido-switch-buffer'."
(defun ido-find-file ()
"Edit file with name obtained via minibuffer.
The file is displayed according to `ido-default-file-method' -- the
-default is to show it in the same window, unless it is already
-visible in another frame.
+default is to show it in the same window, unless it is already visible
+in another frame.
The file name is selected interactively by typing a substring. As you
type in a string, all of the filenames matching the string are displayed
-if substring-matching is used \(default). Look at `ido-enable-prefix' and
+if substring-matching is used (default). Look at `ido-enable-prefix' and
`ido-toggle-prefix'. When you have found the filename you want, it can
then be selected. As you type, most keys have their normal keybindings,
except for the following: \\<ido-file-completion-map>
-RET Select the file at the front of the list of matches. If the
-list is empty, possibly prompt to create new file.
-
-\\[ido-select-text] Use the current input string verbatim.
-
-\\[ido-next-match] Put the first element at the end of the list.
-\\[ido-prev-match] Put the last element at the start of the list.
-\\[ido-complete] Complete a common suffix to the current string that
-matches all files. If there is only one match, select that file.
-If there is no common suffix, show a list of all matching files
-in a separate window.
-\\[ido-magic-delete-char] Open the specified directory in Dired mode.
-\\[ido-edit-input] Edit input string (including directory).
-\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
-\\[ido-merge-work-directories] search for file in the work directory history.
-\\[ido-forget-work-directory] removes current directory from the work directory history.
-\\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history.
-\\[ido-wide-find-file-or-pop-dir] and \\[ido-wide-find-dir-or-delete-dir] prompts and uses find to locate files or directories.
-\\[ido-make-directory] prompts for a directory to create in current directory.
-\\[ido-fallback-command] Fallback to non-ido version of current command.
-\\[ido-toggle-regexp] Toggle regexp searching.
-\\[ido-toggle-prefix] Toggle between substring and prefix matching.
-\\[ido-toggle-case] Toggle case-sensitive searching of file names.
-\\[ido-toggle-literal] Toggle literal reading of this file.
-\\[ido-completion-help] Show list of matching files in separate window.
-\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'."
+RET\tSelect the file at the front of the list of matches.
+\tIf the list is empty, possibly prompt to create new file.
+
+\\[ido-select-text]\tUse the current input string verbatim.
+
+\\[ido-next-match]\tPut the first element at the end of the list.
+\\[ido-prev-match]\tPut the last element at the start of the list.
+\\[ido-complete]\tComplete a common suffix to the current string that matches
+\tall files. If there is only one match, select that file.
+\tIf there is no common suffix, show a list of all matching files
+\tin a separate window.
+\\[ido-magic-delete-char]\tOpen the specified directory in Dired mode.
+\\[ido-edit-input]\tEdit input string (including directory).
+\\[ido-prev-work-directory]\tGo to previous directory in work directory history.
+\\[ido-next-work-directory]\tGo to next directory in work directory history.
+\\[ido-merge-work-directories]\tSearch for file in the work directory history.
+\\[ido-forget-work-directory]\tRemove current directory from the work directory history.
+\\[ido-prev-work-file]\tCycle to previous file in work file history.
+\\[ido-next-work-file]\tCycle to next file in work file history.
+\\[ido-wide-find-file-or-pop-dir]\tPrompt for a file and use find to locate it.
+\\[ido-wide-find-dir-or-delete-dir]\tPrompt for a directory and use find to locate it.
+\\[ido-make-directory]\tPrompt for a directory to create in current directory.
+\\[ido-fallback-command]\tFallback to non-Ido version of current command.
+\\[ido-toggle-regexp]\tToggle regexp searching.
+\\[ido-toggle-prefix]\tToggle between substring and prefix matching.
+\\[ido-toggle-case]\tToggle case-sensitive searching of file names.
+\\[ido-toggle-literal]\tToggle literal reading of this file.
+\\[ido-completion-help]\tShow list of matching files in separate window.
+\\[ido-toggle-ignore]\tToggle ignoring files listed in `ido-ignore-files'."
(interactive)
(ido-file-internal ido-default-file-method))
@@ -4259,7 +4305,8 @@ For details of keybindings, see `ido-find-file'."
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'."
(interactive)
- (ido-file-internal 'read-only 'find-file-read-only-other-window nil "Find file read-only other window: "))
+ (ido-file-internal 'read-only 'find-file-read-only-other-window nil
+ "Find file read-only other window: "))
;;;###autoload
(defun ido-find-file-read-only-other-frame ()
@@ -4267,7 +4314,8 @@ For details of keybindings, see `ido-find-file'."
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'."
(interactive)
- (ido-file-internal 'read-only 'find-file-read-only-other-frame nil "Find file read-only other frame: "))
+ (ido-file-internal 'read-only 'find-file-read-only-other-frame nil
+ "Find file read-only other frame: "))
;;;###autoload
(defun ido-display-file ()
@@ -4309,7 +4357,7 @@ For details of keybindings, see `ido-find-file'."
;;;###autoload
(defun ido-dired ()
- "Call `dired' the ido way.
+ "Call `dired' the Ido way.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'."
(interactive)
@@ -4318,7 +4366,7 @@ For details of keybindings, see `ido-find-file'."
(ido-file-internal 'dired 'dired nil "Dired: " 'dir)))
(defun ido-list-directory ()
- "Call `list-directory' the ido way.
+ "Call `list-directory' the Ido way.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'."
(interactive)
@@ -4356,7 +4404,7 @@ For details of keybindings, see `ido-find-file'."
(throw 'ido contents))))
(defun ido-exhibit ()
- "Post command hook for `ido'."
+ "Post command hook for Ido."
;; Find matching files and display a list in the minibuffer.
;; Copied from `icomplete-exhibit' with two changes:
;; 1. It prints a default file name when there is no text yet entered.
@@ -4684,7 +4732,7 @@ Modified from `icomplete-completions'."
(nth 1 ido-decorations)))))))
(defun ido-minibuffer-setup ()
- "Minibuffer setup hook for `ido'."
+ "Minibuffer setup hook for Ido."
;; Copied from `icomplete-minibuffer-setup-hook'.
(when (ido-active)
(add-hook 'pre-command-hook 'ido-tidy nil t)
@@ -4698,7 +4746,7 @@ Modified from `icomplete-completions'."
(setq ido-initial-position nil))))
(defun ido-tidy ()
- "Pre command hook for `ido'."
+ "Pre command hook for Ido."
;; Remove completions display, if any, prior to new user input.
;; Copied from `icomplete-tidy'."
@@ -4707,19 +4755,18 @@ Modified from `icomplete-completions'."
(cancel-timer ido-auto-merge-timer)
(setq ido-auto-merge-timer nil))
- (if (ido-active)
- (if (and (boundp 'ido-eoinput)
- ido-eoinput)
-
- (if (> ido-eoinput (point-max))
- ;; Oops, got rug pulled out from under us - reinit:
- (setq ido-eoinput (point-max))
- (let ((buffer-undo-list t))
- (delete-region ido-eoinput (point-max))))
-
- ;; Reestablish the local variable 'cause minibuffer-setup is weird:
- (make-local-variable 'ido-eoinput)
- (setq ido-eoinput 1))))
+ (when (ido-active)
+ (if (bound-and-true-p ido-eoinput)
+ (if (> ido-eoinput (point-max))
+ ;; Oops, got rug pulled out from under us - reinit:
+ (setq ido-eoinput (point-max))
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t))
+ (delete-region ido-eoinput (point-max))))
+
+ ;; Reestablish the local variable 'cause minibuffer-setup is weird:
+ (make-local-variable 'ido-eoinput)
+ (setq ido-eoinput 1))))
(defun ido-summary-buffers-to-end ()
;; Move the summaries to the end of the buffer list.
@@ -4740,12 +4787,13 @@ Modified from `icomplete-completions'."
(put 'ibuffer-find-file 'ido 'find-file)
(put 'dired 'ido 'dir)
(put 'dired-other-window 'ido 'dir)
+(put 'dired-other-frame 'ido 'dir)
;; See http://debbugs.gnu.org/11954 for reasons.
(put 'dired-do-copy 'ido 'ignore)
(put 'dired-do-rename 'ido 'ignore)
;;;###autoload
-(defun ido-read-buffer (prompt &optional default require-match)
+(defun ido-read-buffer (prompt &optional default require-match predicate)
"Ido replacement for the built-in `read-buffer'.
Return the name of a buffer selected.
PROMPT is the prompt to give to the user. DEFAULT if given is the default
@@ -4759,7 +4807,7 @@ If REQUIRE-MATCH is non-nil, an existing buffer must be selected."
(if (eq ido-exit 'fallback)
(let ((read-buffer-function nil))
(run-hook-with-args 'ido-before-fallback-functions 'read-buffer)
- (read-buffer prompt default require-match))
+ (read-buffer prompt default require-match predicate))
buf)))
;;;###autoload
@@ -4857,10 +4905,10 @@ See `read-directory-name' for additional parameters."
(defun ido-completing-read (prompt choices &optional _predicate require-match
initial-input hist def _inherit-input-method)
"Ido replacement for the built-in `completing-read'.
-Read a string in the minibuffer with ido-style completion.
+Read a string in the minibuffer with Ido-style completion.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
CHOICES is a list of strings which are the possible completions.
-PREDICATE and INHERIT-INPUT-METHOD is currently ignored; it is included
+PREDICATE and INHERIT-INPUT-METHOD are currently ignored; they are included
to be compatible with `completing-read'.
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
the input is (or completes to) an element of CHOICES or is null.
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 4280a49af6e..b0354321656 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -1,9 +1,10 @@
+;;; -*- lexical-binding: t -*-
;;; ielm.el --- interaction mode for Emacs Lisp
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: David Smith <maa036@lancaster.ac.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 25 Feb 1994
;; Keywords: lisp
@@ -61,11 +62,11 @@ narrowing in effect. This way you will be certain that none of
the remaining prompts will be accidentally messed up. You may
wish to put something like the following in your init file:
-\(add-hook 'ielm-mode-hook
- (lambda ()
- (define-key ielm-map \"\\C-w\" 'comint-kill-region)
- (define-key ielm-map [C-S-backspace]
- 'comint-kill-whole-line)))
+\(add-hook \\='ielm-mode-hook
+ (lambda ()
+ (define-key ielm-map \"\\C-w\" \\='comint-kill-region)
+ (define-key ielm-map [C-S-backspace]
+ \\='comint-kill-whole-line)))
If you set `comint-prompt-read-only' to t, you might wish to use
`comint-mode-hook' and `comint-mode-map' instead of
@@ -117,7 +118,7 @@ such as `edebug-defun' to work with such inputs."
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
- :options '(turn-on-eldoc-mode)
+ :options '(eldoc-mode)
:type 'hook
:group 'ielm)
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
@@ -167,8 +168,9 @@ This variable is buffer-local.")
(defvar ielm-map
(let ((map (make-sparse-keymap)))
- (define-key map "\t" 'completion-at-point)
+ (define-key map "\t" 'ielm-tab)
(define-key map "\C-m" 'ielm-return)
+ (define-key map "\e\C-m" 'ielm-return-for-effect)
(define-key map "\C-j" 'ielm-send-input)
(define-key map "\e\C-x" 'eval-defun) ; for consistency with
(define-key map "\e\t" 'completion-at-point) ; lisp-interaction-mode
@@ -199,40 +201,23 @@ This variable is buffer-local.")
;;; Completion stuff
-(defun ielm-tab nil
- "Possibly indent the current line as Lisp code."
+(defun ielm-tab ()
+ "Indent or complete."
(interactive)
- (when (or (eq (preceding-char) ?\n)
- (eq (char-syntax (preceding-char)) ?\s))
- (ielm-indent-line)
- t))
-
-(defun ielm-complete-symbol nil
- "Complete the Lisp symbol before point."
- ;; A wrapper for completion-at-point that returns non-nil if
- ;; completion has occurred
- (let* ((btick (buffer-modified-tick))
- (cbuffer (get-buffer "*Completions*"))
- (ctick (and cbuffer (buffer-modified-tick cbuffer)))
- (completion-at-point-functions '(lisp-completion-at-point)))
- (completion-at-point)
- ;; completion has occurred if:
- (or
- ;; the buffer has been modified
- (not (= btick (buffer-modified-tick)))
- ;; a completions buffer has been modified or created
- (if cbuffer
- (not (= ctick (buffer-modified-tick cbuffer)))
- (get-buffer "*Completions*")))))
+ (if (or (eq (preceding-char) ?\n)
+ (eq (char-syntax (preceding-char)) ?\s))
+ (ielm-indent-line)
+ (completion-at-point)))
+
(defun ielm-complete-filename nil
"Dynamically complete filename before point, if in a string."
(when (nth 3 (parse-partial-sexp comint-last-input-start (point)))
- (comint-dynamic-complete-filename)))
+ (comint-filename-completion)))
(defun ielm-indent-line nil
"Indent the current line as Lisp code if it is not a prompt line."
- (when (save-excursion (comint-bol) (bolp))
+ (when (save-excursion (comint-bol t) (bolp))
(lisp-indent-line)))
;;; Working buffer manipulation
@@ -258,13 +243,13 @@ evaluated. You can achieve the same effect with a call to
(interactive "bSet working buffer to: ")
(let ((buffer (get-buffer buf)))
(if (and buffer (buffer-live-p buffer))
- (setq ielm-working-buffer buffer)
+ (setq ielm-working-buffer buffer)
(error "No such buffer: %S" buf)))
(ielm-print-working-buffer))
;;; Other bindings
-(defun ielm-return nil
+(defun ielm-return (&optional for-effect)
"Newline and indent, or evaluate the sexp before the prompt.
Complete sexps are evaluated; for incomplete sexps inserts a newline
and indents. If however `ielm-dynamic-return' is nil, this always
@@ -272,22 +257,27 @@ simply inserts a newline."
(interactive)
(if ielm-dynamic-return
(let ((state
- (save-excursion
- (end-of-line)
- (parse-partial-sexp (ielm-pm)
- (point)))))
- (if (and (< (car state) 1) (not (nth 3 state)))
- (ielm-send-input)
- (when (and ielm-dynamic-multiline-inputs
- (save-excursion
- (beginning-of-line)
- (looking-at-p comint-prompt-regexp)))
- (save-excursion
- (goto-char (ielm-pm))
- (newline 1)))
- (newline-and-indent)))
+ (save-excursion
+ (end-of-line)
+ (parse-partial-sexp (ielm-pm)
+ (point)))))
+ (if (and (< (car state) 1) (not (nth 3 state)))
+ (ielm-send-input for-effect)
+ (when (and ielm-dynamic-multiline-inputs
+ (save-excursion
+ (beginning-of-line)
+ (looking-at-p comint-prompt-regexp)))
+ (save-excursion
+ (goto-char (ielm-pm))
+ (newline 1)))
+ (newline-and-indent)))
(newline)))
+(defun ielm-return-for-effect ()
+ "Like `ielm-return', but do not print the result."
+ (interactive)
+ (ielm-return t))
+
(defvar ielm-input)
(defun ielm-input-sender (_proc input)
@@ -295,12 +285,12 @@ simply inserts a newline."
;; `ielm-send-input's call.
(setq ielm-input input))
-(defun ielm-send-input nil
+(defun ielm-send-input (&optional for-effect)
"Evaluate the Emacs Lisp expression after the prompt."
(interactive)
- (let (ielm-input) ; set by ielm-input-sender
- (comint-send-input) ; update history, markers etc.
- (ielm-eval-input ielm-input)))
+ (let (ielm-input) ; set by ielm-input-sender
+ (comint-send-input) ; update history, markers etc.
+ (ielm-eval-input ielm-input for-effect)))
;;; Utility functions
@@ -311,16 +301,41 @@ simply inserts a newline."
;;; Evaluation
-(defvar ielm-string)
-(defvar ielm-form)
-(defvar ielm-pos)
-(defvar ielm-result)
-(defvar ielm-error-type)
-(defvar ielm-output)
-(defvar ielm-wbuf)
-(defvar ielm-pmark)
-
-(defun ielm-eval-input (input-string)
+(defun ielm-standard-output-impl (process)
+ "Return a function to use for `standard-output' while in ielm eval.
+The returned function takes one character as input. Passing nil
+to this function instead of a character flushes the output
+buffer. Passing t appends a terminating newline if the buffer is
+nonempty, then flushes the buffer."
+ ;; Use an intermediate output buffer because doing redisplay for
+ ;; each character we output is too expensive. Set up a flush timer
+ ;; so that users don't have to wait for whole lines to appear before
+ ;; seeing output.
+ (let* ((output-buffer nil)
+ (flush-timer nil)
+ (flush-buffer
+ (lambda ()
+ (comint-output-filter
+ process
+ (apply #'string (nreverse output-buffer)))
+ (redisplay)
+ (setf output-buffer nil)
+ (when flush-timer
+ (cancel-timer flush-timer)
+ (setf flush-timer nil)))))
+ (lambda (char)
+ (let (flush-now)
+ (cond ((and (eq char t) output-buffer)
+ (push ?\n output-buffer)
+ (setf flush-now t))
+ ((characterp char)
+ (push char output-buffer)))
+ (if flush-now
+ (funcall flush-buffer)
+ (unless flush-timer
+ (setf flush-timer (run-with-timer 0.1 nil flush-buffer))))))))
+
+(defun ielm-eval-input (input-string &optional for-effect)
"Evaluate the Lisp expression INPUT-STRING, and pretty-print the result."
;; This is the function that actually `sends' the input to the
;; `inferior Lisp process'. All comint-send-input does is works out
@@ -331,108 +346,121 @@ simply inserts a newline."
;; this as in output filter that converted sexps in the output
;; stream to their evaluated value. But that would have involved
;; more process coordination than I was happy to deal with.
- ;;
- ;; NOTE: all temporary variables in this function will be in scope
- ;; during the eval, and so need to have non-clashing names.
- (let ((ielm-string input-string) ; input expression, as a string
- ielm-form ; form to evaluate
- ielm-pos ; End posn of parse in string
- ielm-result ; Result, or error message
- ielm-error-type ; string, nil if no error
- (ielm-output "") ; result to display
- (ielm-wbuf ielm-working-buffer) ; current buffer after evaluation
- (ielm-pmark (ielm-pm)))
- (unless (ielm-is-whitespace-or-comment ielm-string)
+ (let ((string input-string) ; input expression, as a string
+ form ; form to evaluate
+ pos ; End posn of parse in string
+ result ; Result, or error message
+ error-type ; string, nil if no error
+ (output "") ; result to display
+ (wbuf ielm-working-buffer) ; current buffer after evaluation
+ (pmark (ielm-pm)))
+ (unless (ielm-is-whitespace-or-comment string)
(condition-case err
- (let ((rout (read-from-string ielm-string)))
- (setq ielm-form (car rout)
- ielm-pos (cdr rout)))
- (error (setq ielm-result (error-message-string err))
- (setq ielm-error-type "Read error")))
- (unless ielm-error-type
- ;; Make sure working buffer has not been killed
- (if (not (buffer-name ielm-working-buffer))
- (setq ielm-result "Working buffer has been killed"
- ielm-error-type "IELM Error"
- ielm-wbuf (current-buffer))
- (if (ielm-is-whitespace-or-comment (substring ielm-string ielm-pos))
- ;; To correctly handle the ielm-local variables *,
- ;; ** and ***, we need a temporary buffer to be
- ;; current at entry to the inner of the next two let
- ;; forms. We need another temporary buffer to exit
- ;; that same let. To avoid problems, neither of
- ;; these buffers should be alive during the
- ;; evaluation of ielm-form.
- (let ((*1 *)
- (*2 **)
- (*3 ***)
- ielm-temp-buffer)
- (set-match-data ielm-match-data)
- (save-excursion
- (with-temp-buffer
- (condition-case err
- (unwind-protect
- ;; The next let form creates default
- ;; bindings for *, ** and ***. But
- ;; these default bindings are
- ;; identical to the ielm-local
- ;; bindings. Hence, during the
- ;; evaluation of ielm-form, the
- ;; ielm-local values are going to be
- ;; used in all buffers except for
- ;; other ielm buffers, which override
- ;; them. Normally, the variables *1,
- ;; *2 and *3 also have default
- ;; bindings, which are not overridden.
- (let ((* *1)
- (** *2)
- (*** *3))
- (kill-buffer (current-buffer))
- (set-buffer ielm-wbuf)
- (setq ielm-result
- (eval ielm-form lexical-binding))
- (setq ielm-wbuf (current-buffer))
- (setq
- ielm-temp-buffer
- (generate-new-buffer " *ielm-temp*"))
- (set-buffer ielm-temp-buffer))
- (when ielm-temp-buffer
- (kill-buffer ielm-temp-buffer)))
- (error (setq ielm-result (error-message-string err))
- (setq ielm-error-type "Eval error"))
- (quit (setq ielm-result "Quit during evaluation")
- (setq ielm-error-type "Eval error")))))
- (setq ielm-match-data (match-data)))
- (setq ielm-error-type "IELM error")
- (setq ielm-result "More than one sexp in input"))))
+ (let ((rout (read-from-string string)))
+ (setq form (car rout)
+ pos (cdr rout)))
+ (error (setq result (error-message-string err))
+ (setq error-type "Read error")))
+ (unless error-type
+ ;; Make sure working buffer has not been killed
+ (if (not (buffer-name ielm-working-buffer))
+ (setq result "Working buffer has been killed"
+ error-type "IELM Error"
+ wbuf (current-buffer))
+ (if (ielm-is-whitespace-or-comment (substring string pos))
+ ;; To correctly handle the ielm-local variables *,
+ ;; ** and ***, we need a temporary buffer to be
+ ;; current at entry to the inner of the next two let
+ ;; forms. We need another temporary buffer to exit
+ ;; that same let. To avoid problems, neither of
+ ;; these buffers should be alive during the
+ ;; evaluation of form.
+ (let* ((*1 *)
+ (*2 **)
+ (*3 ***)
+ (active-process (ielm-process))
+ (old-standard-output standard-output)
+ new-standard-output
+ ielm-temp-buffer)
+ (set-match-data ielm-match-data)
+ (save-excursion
+ (with-temp-buffer
+ (condition-case err
+ (unwind-protect
+ ;; The next let form creates default
+ ;; bindings for *, ** and ***. But
+ ;; these default bindings are
+ ;; identical to the ielm-local
+ ;; bindings. Hence, during the
+ ;; evaluation of form, the
+ ;; ielm-local values are going to be
+ ;; used in all buffers except for
+ ;; other ielm buffers, which override
+ ;; them. Normally, the variables *1,
+ ;; *2 and *3 also have default
+ ;; bindings, which are not overridden.
+ (let ((* *1)
+ (** *2)
+ (*** *3))
+ (when (eq standard-output t)
+ (setf new-standard-output
+ (ielm-standard-output-impl
+ active-process))
+ (setf standard-output new-standard-output))
+ (kill-buffer (current-buffer))
+ (set-buffer wbuf)
+ (setq result
+ (eval form lexical-binding))
+ (setq wbuf (current-buffer))
+ (setq
+ ielm-temp-buffer
+ (generate-new-buffer " *ielm-temp*"))
+ (set-buffer ielm-temp-buffer))
+ (when ielm-temp-buffer
+ (kill-buffer ielm-temp-buffer))
+ (when (eq new-standard-output standard-output)
+ (ignore-errors
+ (funcall standard-output t))
+ (setf standard-output old-standard-output)))
+ (error (setq result (error-message-string err))
+ (setq error-type "Eval error"))
+ (quit (setq result "Quit during evaluation")
+ (setq error-type "Eval error")))))
+ (setq ielm-match-data (match-data)))
+ (setq error-type "IELM error")
+ (setq result "More than one sexp in input"))))
;; If the eval changed the current buffer, mention it here
- (unless (eq ielm-wbuf ielm-working-buffer)
- (message "current buffer is now: %s" ielm-wbuf)
- (setq ielm-working-buffer ielm-wbuf))
-
- (goto-char ielm-pmark)
- (unless ielm-error-type
- (condition-case nil
- ;; Self-referential objects cause loops in the printer, so
- ;; trap quits here. May as well do errors, too
- (setq ielm-output (concat ielm-output (pp-to-string ielm-result)))
- (error (setq ielm-error-type "IELM Error")
- (setq ielm-result "Error during pretty-printing (bug in pp)"))
- (quit (setq ielm-error-type "IELM Error")
- (setq ielm-result "Quit during pretty-printing"))))
- (if ielm-error-type
- (progn
- (when ielm-noisy (ding))
- (setq ielm-output (concat ielm-output "*** " ielm-error-type " *** "))
- (setq ielm-output (concat ielm-output ielm-result)))
- ;; There was no error, so shift the *** values
- (setq *** **)
- (setq ** *)
- (setq * ielm-result))
- (setq ielm-output (concat ielm-output "\n")))
- (setq ielm-output (concat ielm-output ielm-prompt-internal))
- (comint-output-filter (ielm-process) ielm-output)))
+ (unless (eq wbuf ielm-working-buffer)
+ (message "current buffer is now: %s" wbuf)
+ (setq ielm-working-buffer wbuf))
+
+ (goto-char pmark)
+ (unless error-type
+ (condition-case nil
+ ;; Self-referential objects cause loops in the printer, so
+ ;; trap quits here. May as well do errors, too
+ (unless for-effect
+ (setq output (concat output (pp-to-string result)
+ (let ((str (eval-expression-print-format result)))
+ (if str (propertize str 'font-lock-face 'shadow))))))
+ (error (setq error-type "IELM Error")
+ (setq result "Error during pretty-printing (bug in pp)"))
+ (quit (setq error-type "IELM Error")
+ (setq result "Quit during pretty-printing"))))
+ (if error-type
+ (progn
+ (when ielm-noisy (ding))
+ (setq output (concat output "*** " error-type " *** "))
+ (setq output (concat output result)))
+ ;; There was no error, so shift the *** values
+ (setq *** **)
+ (setq ** *)
+ (setq * result))
+ (when (or (not for-effect) (not (equal output "")))
+ (setq output (concat output "\n"))))
+ (setq output (concat output ielm-prompt-internal))
+ (comint-output-filter (ielm-process) output)))
;;; Process and marker utilities
@@ -462,6 +490,11 @@ Uses the interface provided by `comint-mode' (which see).
Inputs longer than one line are moved to the line following the
prompt (but see variable `ielm-dynamic-multiline-inputs').
+* \\[ielm-return-for-effect] works like `ielm-return', except
+ that it doesn't print the result of evaluating the input. This
+ functionality is useful when forms would generate voluminous
+ output.
+
* \\[completion-at-point] completes Lisp symbols (or filenames, within strings),
or indents the line if there is nothing to complete.
@@ -478,6 +511,13 @@ evaluations respectively. If the working buffer is another IELM
buffer, then the values in the working buffer are used. The variables
`*1', `*2' and `*3', yield the process buffer values.
+If, at the start of evaluation, `standard-output' is t (the
+default), `standard-output' is set to a special function that
+causes output to be directed to the ielm buffer.
+`standard-output' is restored after evaluation unless explicitly
+set to a different value during evaluation. You can use (princ
+VALUE) or (pp VALUE) to write to the ielm buffer.
+
Expressions evaluated by IELM are not subject to `debug-on-quit' or
`debug-on-error'.
@@ -500,8 +540,10 @@ Customized bindings may be defined in `ielm-map', which currently contains:
(setq comint-input-sender 'ielm-input-sender)
(setq comint-process-echoes nil)
(set (make-local-variable 'completion-at-point-functions)
- '(ielm-tab comint-replace-by-expanded-history
- ielm-complete-filename ielm-complete-symbol))
+ '(comint-replace-by-expanded-history
+ ielm-complete-filename elisp-completion-at-point))
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)
(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)
@@ -509,7 +551,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
(setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer))))
;; Useful for `hs-minor-mode'.
(setq-local comment-start ";")
- (setq-local comment-use-global-state t)
+ (setq-local comment-use-syntax t)
(set (make-local-variable 'indent-line-function) 'ielm-indent-line)
(set (make-local-variable 'ielm-working-buffer) (current-buffer))
@@ -530,7 +572,7 @@ Customized bindings may be defined in `ielm-map', which currently contains:
;; Was cat, but on non-Unix platforms that might not exist, so
;; use hexl instead, which is part of the Emacs distribution.
(condition-case nil
- (start-process "ielm" (current-buffer) "hexl")
+ (start-process "ielm" (current-buffer) "hexl")
(file-error (start-process "ielm" (current-buffer) "cat")))
(set-process-query-on-exit-flag (ielm-process) nil)
(goto-char (point-max))
@@ -565,14 +607,15 @@ Customized bindings may be defined in `ielm-map', which currently contains:
;;;###autoload
(defun ielm nil
"Interactively evaluate Emacs Lisp expressions.
-Switches to the buffer `*ielm*', or creates it if it does not exist."
+Switches to the buffer `*ielm*', or creates it if it does not exist.
+See `inferior-emacs-lisp-mode' for details."
(interactive)
(let (old-point)
(unless (comint-check-proc "*ielm*")
(with-current-buffer (get-buffer-create "*ielm*")
- (unless (zerop (buffer-size)) (setq old-point (point)))
- (inferior-emacs-lisp-mode)))
- (switch-to-buffer "*ielm*")
+ (unless (zerop (buffer-size)) (setq old-point (point)))
+ (inferior-emacs-lisp-mode)))
+ (pop-to-buffer-same-window "*ielm*")
(when old-point (push-mark old-point))))
(provide 'ielm)
diff --git a/lisp/iimage.el b/lisp/iimage.el
index 9276301dad3..08808b1b4c4 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -1,6 +1,6 @@
;;; iimage.el --- Inline image minor mode.
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: KOSEKI Yoshinori <kose@meadowy.org>
;; Maintainer: KOSEKI Yoshinori <kose@meadowy.org>
@@ -25,7 +25,6 @@
;; Iimage is a minor mode that displays images, when image-filename
;; exists in the buffer.
-;; http://www.netlaputa.ne.jp/~kose/Emacs/iimage.html
;;
;; ** Display images in *Info* buffer.
;;
@@ -72,7 +71,7 @@ NUM specifies which parenthesized expression in the regexp.
Examples of image filename patterns to match:
file://foo.png
- `file://foo.png'
+ \\=`file://foo.png\\='
\\[\\[foo.gif]]
<foo.png>
foo.JPG
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index f26ad5dcd0e..c5efb338152 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,6 +1,6 @@
;;; image-dired.el --- use dired to browse and manipulate your images
;;
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;;
;; Version: 0.4.11
;; Keywords: multimedia
@@ -881,7 +881,7 @@ displayed."
(progn
(image-dired-display-thumbs)
(pop-to-buffer image-dired-thumbnail-buffer))
- (message "Cancelled."))))
+ (message "Canceled."))))
;;;###autoload
(defalias 'image-dired 'image-dired-show-all-from-dir)
@@ -1910,7 +1910,7 @@ overwritten. This confirmation can be turned off using
(message "No image at point")
(let ((file (image-dired-original-file-name))
command)
- (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file))
+ (if (not (string-match "\\.[jJ][pP[eE]?[gG]$" file))
(error "Only JPEG images can be rotated!"))
(setq command (format-spec
image-dired-cmd-rotate-original-options
@@ -1950,7 +1950,7 @@ for traceability. The format of the returned file name is
YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
`image-dired-copy-with-exif-file-name'."
(let (data no-exif-data-found)
- (if (not (string-match "\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file)))
+ (if (not (string-match "\\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file)))
(progn
(setq no-exif-data-found t)
(setq data
@@ -2572,7 +2572,7 @@ tags to their respective image file. Internal function used by
;; (let ((fattribs (file-attributes f)))
;; ;; Get last access time and file size
;; `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f)))
-;; (directory-files (image-dired-dir) t ".+\.thumb\..+$"))
+;; (directory-files (image-dired-dir) t ".+\\.thumb\\..+$"))
;; ;; Sort function. Compare time between two files.
;; (lambda (l1 l2)
;; (time-less-p (car l1) (car l2)))))
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 55f1d186833..eaac575007e 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -1,6 +1,6 @@
;;; image-file.el --- support for visiting image files
;;
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: multimedia
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index f9bbbcdb1ab..e6d6a3edb71 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -1,6 +1,6 @@
;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;;
;; Author: Richard Stallman <rms@gnu.org>
;; Keywords: multimedia
@@ -49,6 +49,26 @@
"Special hook run when image data is requested in a new window.
It is called with one argument, the initial WINPROPS.")
+;; FIXME this doesn't seem mature yet. Document in manual when it is.
+(defvar image-transform-resize nil
+ "The image resize operation.
+Its value should be one of the following:
+ - nil, meaning no resizing.
+ - `fit-height', meaning to fit the image to the window height.
+ - `fit-width', meaning to fit the image to the window width.
+ - A number, which is a scale factor (the default size is 1).")
+
+(defvar image-transform-scale 1.0
+ "The scale factor of the image being displayed.")
+
+(defvar image-transform-rotation 0.0
+ "Rotation angle for the image in the current Image mode buffer.")
+
+(defvar image-transform-right-angle-fudge 0.0001
+ "Snap distance to a multiple of a right angle.
+There's no deep theory behind the default value, it should just
+be somewhat larger than ImageMagick's MagickEpsilon.")
+
(defun image-mode-winprops (&optional window cleanup)
"Return winprops of WINDOW.
A winprops object has the shape (WINDOW . ALIST).
@@ -90,6 +110,8 @@ otherwise it defaults to t, used for times when the buffer is not displayed."
(defun image-mode-window-put (prop val &optional winprops)
(unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
+ (unless (eq t (car winprops))
+ (image-mode-window-put prop val t))
(setcdr winprops (cons (cons prop val)
(delq (assq prop (cdr winprops)) (cdr winprops)))))
@@ -358,6 +380,7 @@ call."
(define-key map "a-" 'image-decrease-speed)
(define-key map "a0" 'image-reset-speed)
(define-key map "ar" 'image-reverse-speed)
+ (define-key map "k" 'image-kill-buffer)
(define-key map [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
@@ -377,8 +400,6 @@ call."
["Show as Text" image-toggle-display :active t
:help "Show image as text"]
"--"
- ["Fit Frame to Image" image-mode-fit-frame :active t
- :help "Resize frame to match image"]
["Fit to Window Height" image-transform-fit-to-height
:visible (eq image-type 'imagemagick)
:help "Resize image to match the window height"]
@@ -388,6 +409,9 @@ call."
["Rotate Image..." image-transform-set-rotation
:visible (eq image-type 'imagemagick)
:help "Rotate the image"]
+ ["Reset Transformations" image-transform-reset
+ :visible (eq image-type 'imagemagick)
+ :help "Reset all image transformations"]
"--"
["Show Thumbnails"
(lambda ()
@@ -400,6 +424,9 @@ call."
["Previous Image" image-previous-file :active buffer-file-name
:help "Move to previous image in this directory"]
"--"
+ ["Fit Frame to Image" image-mode-fit-frame :active t
+ :help "Resize frame to match image"]
+ "--"
["Animate Image" image-toggle-animation :style toggle
:selected (let ((image (image-get-display-property)))
(and image (image-animate-timer image)))
@@ -636,8 +663,19 @@ was inserted."
(string-make-unibyte
(buffer-substring-no-properties (point-min) (point-max)))
filename))
- (type (image-type file-or-data nil data-p))
- (image (create-image file-or-data type data-p))
+ ;; If we have a `fit-width' or a `fit-height', don't limit
+ ;; the size of the image to the window size.
+ (edges (and (null image-transform-resize)
+ (window-inside-pixel-edges
+ (get-buffer-window (current-buffer)))))
+ (type (if (fboundp 'imagemagick-types)
+ 'imagemagick
+ (image-type file-or-data nil data-p)))
+ (image (if (not edges)
+ (create-image file-or-data type data-p)
+ (create-image file-or-data type data-p
+ :max-width (- (nth 2 edges) (nth 0 edges))
+ :max-height (- (nth 3 edges) (nth 1 edges)))))
(inhibit-read-only t)
(buffer-undo-list t)
(modified (buffer-modified-p))
@@ -685,6 +723,11 @@ the image by calling `image-mode'."
(image-mode-as-text)
(image-mode)))
+(defun image-kill-buffer ()
+ "Kill the current buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
(defun image-after-revert-hook ()
(when (image-get-display-property)
(image-toggle-display-text)
@@ -888,26 +931,6 @@ replacing the current Image mode buffer."
;; nil "image-transform" image-transform-minor-mode-map)
-;; FIXME this doesn't seem mature yet. Document in manual when it is.
-(defvar image-transform-resize nil
- "The image resize operation.
-Its value should be one of the following:
- - nil, meaning no resizing.
- - `fit-height', meaning to fit the image to the window height.
- - `fit-width', meaning to fit the image to the window width.
- - A number, which is a scale factor (the default size is 1).")
-
-(defvar image-transform-scale 1.0
- "The scale factor of the image being displayed.")
-
-(defvar image-transform-rotation 0.0
- "Rotation angle for the image in the current Image mode buffer.")
-
-(defvar image-transform-right-angle-fudge 0.0001
- "Snap distance to a multiple of a right angle.
-There's no deep theory behind the default value, it should just
-be somewhat larger than ImageMagick's MagickEpsilon.")
-
(defsubst image-transform-width (width height)
"Return the bounding box width of a rotated WIDTH x HEIGHT rectangle.
The rotation angle is the value of `image-transform-rotation' in degrees."
@@ -1089,6 +1112,16 @@ Emacs is compiled with ImageMagick support."
(setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
+(defun image-transform-reset ()
+ "Display the current image with the default size and rotation.
+This command has no effect unless Emacs is compiled with
+ImageMagick support."
+ (interactive)
+ (setq image-transform-resize nil
+ image-transform-rotation 0.0
+ image-transform-scale 1)
+ (image-toggle-display-image))
+
(provide 'image-mode)
;;; image-mode.el ends here
diff --git a/lisp/image.el b/lisp/image.el
index 6c15a7d0b96..295b79f161d 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -1,8 +1,8 @@
;;; image.el --- image API
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: multimedia
;; Package: emacs
@@ -34,7 +34,10 @@
(defconst image-type-header-regexps
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
- ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" . pbm)
+ ("\\`P[1-6]\\(?:\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
+\\)\\{2\\}" . pbm)
("\\`GIF8[79]a" . gif)
("\\`\x89PNG\r\n\x1a\n" . png)
("\\`[\t\n\r ]*#define \\([a-z0-9_]+\\)_width [0-9]+\n\
@@ -101,11 +104,13 @@ AUTODETECT can be
(defvar image-format-suffixes
'((image/x-icon "ico"))
- "Alist of MIME Content-Type headers to file name suffixes.
+ "An alist associating image types with file name suffixes.
This is used as a hint by the ImageMagick library when detecting
-image types. If `create-image' is called with a :format
-matching found in this alist, the ImageMagick library will be
-told that the data would have this suffix if saved to a file.")
+the type of image data (that does not have an associated file name).
+Each element has the form (MIME-CONTENT-TYPE EXTENSION).
+If `create-image' is called with a :format attribute whose value
+equals a content-type found in this list, the ImageMagick library is
+told that the data would have the associated suffix if saved to a file.")
(defcustom image-load-path
(list (file-name-as-directory (expand-file-name "images" data-directory))
@@ -115,7 +120,9 @@ If an element is a string, it defines a directory to search.
If an element is a variable symbol whose value is a string, that
value defines a directory to search.
If an element is a variable symbol whose value is a list, the
-value is used as a list of directories to search."
+value is used as a list of directories to search.
+
+Subdirectories are not automatically included in the search."
:type '(repeat (choice directory variable))
:initialize 'custom-initialize-delay)
@@ -291,6 +298,7 @@ be determined."
(setq types (cdr types)))))
(goto-char opoint)
(and type
+ (boundp 'image-types)
(memq type image-types)
type)))
@@ -349,7 +357,7 @@ Optional DATA-P non-nil means SOURCE is a string containing image data."
(if (fboundp 'image-metadata) ; eg not --without-x
(define-obsolete-function-alias 'image-extension-data
- 'image-metadata' "24.1"))
+ 'image-metadata "24.1"))
(define-obsolete-variable-alias
'image-library-alist
@@ -590,7 +598,7 @@ Image files should not be larger than specified by `max-image-size'."
;;;###autoload
(defmacro defimage (symbol specs &optional doc)
- "Define SYMBOL as an image.
+ "Define SYMBOL as an image, and return SYMBOL.
SPECS is a list of image specifications. DOC is an optional
documentation string.
@@ -624,13 +632,14 @@ The actual return value is a cons (NIMAGES . DELAY), where NIMAGES is
the number of frames (or sub-images) in the image and DELAY is the delay
in seconds that the image specifies between each frame. DELAY may be nil,
in which case you might want to use `image-default-frame-delay'."
- (let* ((metadata (image-metadata image))
- (images (plist-get metadata 'count))
- (delay (plist-get metadata 'delay)))
- (when (and images (> images 1))
- (if (or (not (numberp delay)) (< delay 0))
- (setq delay image-default-frame-delay))
- (cons images delay))))
+ (when (fboundp 'image-metadata)
+ (let* ((metadata (image-metadata image))
+ (images (plist-get metadata 'count))
+ (delay (plist-get metadata 'delay)))
+ (when (and images (> images 1))
+ (and delay (or (not (numberp delay)) (< delay 0))
+ (setq delay image-default-frame-delay))
+ (cons images delay)))))
(defun image-animated-p (image)
"Like `image-multi-frame-p', but returns nil if no delay is specified."
@@ -653,6 +662,7 @@ number, play until that number of seconds has elapsed."
(when animation
(if (setq timer (image-animate-timer image))
(cancel-timer timer))
+ (plist-put (cdr image) :animate-buffer (current-buffer))
(run-with-timer 0.2 nil 'image-animate-timeout
image (or index 0) (car animation)
0 limit))))
@@ -717,30 +727,31 @@ 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."
- (image-show-frame image n t)
- (let* ((speed (image-animate-get-speed image))
- (time (float-time))
- (animation (image-multi-frame-p image))
- ;; Subtract off the time we took to load the image from the
- ;; stated delay time.
- (delay (max (+ (* (or (cdr animation) image-default-frame-delay)
- (/ 1 (abs speed)))
- time (- (float-time)))
- image-minimum-frame-delay))
- done)
- (setq n (if (< speed 0)
- (1- n)
- (1+ n)))
- (if limit
- (cond ((>= n count) (setq n 0))
- ((< n 0) (setq n (1- count))))
- (and (or (>= n count) (< n 0)) (setq done t)))
- (setq time-elapsed (+ delay time-elapsed))
- (if (numberp limit)
- (setq done (>= time-elapsed limit)))
- (unless done
- (run-with-timer delay nil 'image-animate-timeout
- image n count time-elapsed limit))))
+ (when (buffer-live-p (plist-get (cdr image) :animate-buffer))
+ (image-show-frame image n t)
+ (let* ((speed (image-animate-get-speed image))
+ (time (float-time))
+ (animation (image-multi-frame-p image))
+ ;; Subtract off the time we took to load the image from the
+ ;; stated delay time.
+ (delay (max (+ (* (or (cdr animation) image-default-frame-delay)
+ (/ 1.0 (abs speed)))
+ time (- (float-time)))
+ image-minimum-frame-delay))
+ done)
+ (setq n (if (< speed 0)
+ (1- n)
+ (1+ n)))
+ (if limit
+ (cond ((>= n count) (setq n 0))
+ ((< n 0) (setq n (1- count))))
+ (and (or (>= n count) (< n 0)) (setq done t)))
+ (setq time-elapsed (+ delay time-elapsed))
+ (if (numberp limit)
+ (setq done (>= time-elapsed limit)))
+ (unless done
+ (run-with-timer delay nil 'image-animate-timeout
+ image n count time-elapsed limit)))))
(defvar imagemagick-types-inhibit)
diff --git a/lisp/imenu.el b/lisp/imenu.el
index d79b0abeebc..717ac633665 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -1,10 +1,10 @@
;;; imenu.el --- framework for mode-specific buffer indexes -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
;; Lars Lindberg <lli@sypro.cap.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 8 Feb 1994
;; Keywords: tools convenience
@@ -185,6 +185,13 @@ with name concatenation."
:type 'string
:group 'imenu)
+(defcustom imenu-generic-skip-comments-and-strings t
+ "When non-nil, ignore text inside comments and strings.
+Only affects `imenu--generic-function'."
+ :type 'boolean
+ :group 'imenu
+ :version "24.4")
+
;;;###autoload
(defvar imenu-generic-expression nil
"List of definition matchers for creating an Imenu index.
@@ -286,8 +293,10 @@ The function in this variable is called when selecting a normal index-item.")
(defun imenu--subalist-p (item)
- (and (consp (cdr item)) (listp (cadr item))
- (not (eq (car (cadr item)) 'lambda))))
+ (and (consp item)
+ (consp (cdr item))
+ (listp (cadr item))
+ (not (functionp (cadr item)))))
(defmacro imenu-progress-message (_prevpos &optional _relpos _reverse)
"Macro to display a progress message.
@@ -339,6 +348,12 @@ Don't move point."
;;; Lisp
;;;
+(define-error 'imenu-unavailable "imenu unavailable")
+
+(defun imenu-unavailable-error (format &rest args)
+ (signal 'imenu-unavailable
+ (list (apply #'format-message format args))))
+
(defun imenu-example--lisp-extract-index-name ()
;; Example of a candidate for `imenu-extract-index-name-function'.
;; This will generate a flat index of definitions in a lisp file.
@@ -454,7 +469,7 @@ Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...).
To \"go to\" a special element means applying FUNCTION
to INDEX-NAME, POSITION, and the ARGUMENTS.
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
+A nested sub-alist element looks like (INDEX-NAME . SUB-ALIST).
The function `imenu--subalist-p' tests an element and returns t
if it is a sub-alist.
@@ -467,7 +482,7 @@ element recalculates the buffer's index alist.")
(defvar imenu--history-list nil
;; Making this buffer local caused it not to work!
- "History list for 'jump-to-function-in-buffer'.")
+ "History list for `jump-to-function-in-buffer'.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -490,10 +505,7 @@ If REVERSE is non-nil then the beginning is 100 and the end is 0."
(let ((pos (point))
(total (buffer-size)))
(and reverse (setq pos (- total pos)))
- (if (> total 50000)
- ;; Avoid overflow from multiplying by 100!
- (/ (1- pos) (max (/ total 100) 1))
- (/ (* 100 (1- pos)) (max total 1)))))
+ (floor (* 100.0 (1- pos)) (max total 1))))
(defun imenu--split (list n)
"Split LIST into sublists of max length N.
@@ -584,7 +596,8 @@ See `imenu--index-alist' for the format of the index alist."
(funcall imenu-create-index-function))))
(imenu--truncate-items imenu--index-alist)))
(or imenu--index-alist noerror
- (user-error "No items suitable for an index found in this buffer"))
+ (imenu-unavailable-error
+ "No items suitable for an index found in this buffer"))
(or imenu--index-alist
(setq imenu--index-alist (list nil)))
;; Add a rescan option to the index.
@@ -638,9 +651,11 @@ Non-nil arguments are in recursive calls."
;; (INDEX-NAME (INDEX-NAME . INDEX-POSITION) ...)
;; while a bottom-level element looks like
;; (INDEX-NAME . INDEX-POSITION)
+ ;; or
+ ;; (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...)
;; We are only interested in the bottom-level elements, so we need to
- ;; recurse if TAIL is a list.
- (cond ((listp tail)
+ ;; recurse if TAIL is a nested ALIST.
+ (cond ((imenu--subalist-p elt)
(if (setq res (imenu--in-alist str tail))
(setq alist nil)))
((if imenu-name-lookup-function
@@ -696,7 +711,7 @@ The alternate method, which is the one most often used, is to call
((and imenu-generic-expression)
(imenu--generic-function imenu-generic-expression))
(t
- (user-error "This buffer cannot use `imenu-default-create-index-function'"))))
+ (imenu-unavailable-error "This buffer cannot use `imenu-default-create-index-function'"))))
;;;
;;; Generic index gathering function.
@@ -715,8 +730,12 @@ for modes which use `imenu--generic-function'. If it is not set, but
;; so it needs to be careful never to loop!
(defun imenu--generic-function (patterns)
"Return an index alist of the current buffer based on PATTERNS.
-PATTERNS should be an alist which has the same form as
-`imenu-generic-expression'.
+PATTERNS should be an alist with the same form as `imenu-generic-expression'.
+
+If `imenu-generic-skip-comments-and-strings' is non-nil, this ignores
+text inside comments and strings.
+
+If `imenu-case-fold-search' is non-nil, this ignores case.
The return value is an alist of the form
(INDEX-NAME . INDEX-POSITION)
@@ -796,7 +815,9 @@ depending on PATTERNS."
;; starting with its title (or nil).
(menu (assoc menu-title index-alist)))
;; Insert the item unless it is already present.
- (unless (member item (cdr menu))
+ (unless (or (member item (cdr menu))
+ (and imenu-generic-skip-comments-and-strings
+ (nth 8 (syntax-ppss))))
(setcdr menu
(cons item (cdr menu)))))
;; Go to the start of the match, to make sure we
@@ -919,6 +940,8 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
(setq result t imenu--index-alist nil)))
result))
+(defvar-local imenu--menubar-keymap nil)
+
;;;###autoload
(defun imenu-add-to-menubar (name)
"Add an `imenu' entry to the menu bar for the current buffer.
@@ -935,12 +958,13 @@ See the command `imenu' for more information."
(let ((newmap (make-sparse-keymap)))
(set-keymap-parent newmap (current-local-map))
(setq imenu--last-menubar-index-alist nil)
+ (setq imenu--menubar-keymap (make-sparse-keymap "Imenu"))
(define-key newmap [menu-bar index]
- `(menu-item ,name ,(make-sparse-keymap "Imenu")))
+ `(menu-item ,name ,imenu--menubar-keymap))
(use-local-map newmap)
(add-hook 'menu-bar-update-hook 'imenu-update-menubar)))
- (user-error "The mode `%s' does not support Imenu"
- (format-mode-line mode-name))))
+ (imenu-unavailable-error "The mode `%s' does not support Imenu"
+ (format-mode-line mode-name))))
;;;###autoload
(defun imenu-add-menubar-index ()
@@ -958,28 +982,23 @@ to `imenu-update-menubar'.")
(defun imenu-update-menubar ()
(when (and (current-local-map)
- (keymapp (lookup-key (current-local-map) [menu-bar index]))
+ imenu--menubar-keymap
(/= (buffer-chars-modified-tick) imenu-menubar-modified-tick))
(setq imenu-menubar-modified-tick (buffer-chars-modified-tick))
(let ((index-alist (imenu--make-index-alist t)))
;; Don't bother updating if the index-alist has not changed
;; since the last time we did it.
(unless (equal index-alist imenu--last-menubar-index-alist)
- (let (menu menu1 old)
- (setq imenu--last-menubar-index-alist index-alist)
- (setq index-alist (imenu--split-submenus index-alist))
- (setq menu (imenu--split-menu index-alist
- (buffer-name)))
- (setq menu1 (imenu--create-keymap (car menu)
+ (setq imenu--last-menubar-index-alist index-alist)
+ (setq index-alist (imenu--split-submenus index-alist))
+ (let* ((menu (imenu--split-menu index-alist
+ (buffer-name)))
+ (menu1 (imenu--create-keymap (car menu)
(cdr (if (< 1 (length (cdr menu)))
menu
(car (cdr menu))))
- 'imenu--menubar-select))
- (setq old (lookup-key (current-local-map) [menu-bar index]))
- ;; This should never happen, but in some odd cases, potentially,
- ;; lookup-key may return a dynamically composed keymap.
- (if (keymapp (cadr old)) (setq old (cadr old)))
- (setcdr old (cdr menu1)))))))
+ 'imenu--menubar-select)))
+ (setcdr imenu--menubar-keymap (cdr menu1)))))))
(defun imenu--menubar-select (item)
"Use Imenu to select the function or variable named in this menu ITEM."
@@ -995,7 +1014,7 @@ to `imenu-update-menubar'.")
(imenu item)
nil))
-(defun imenu-default-goto-function (_name position &optional _rest)
+(defun imenu-default-goto-function (_name position &rest _rest)
"Move to the given position.
NAME is ignored. POSITION is where to move. REST is also ignored.
@@ -1017,16 +1036,13 @@ for more information."
(if (stringp index-item)
(setq index-item (assoc index-item (imenu--make-index-alist))))
(when index-item
- (push-mark nil t)
- (let* ((is-special-item (listp (cdr index-item)))
- (function
- (if is-special-item
- (nth 2 index-item) imenu-default-goto-function))
- (position (if is-special-item
- (cadr index-item) (cdr index-item)))
- (rest (if is-special-item (cddr index-item))))
- (apply function (car index-item) position rest))
- (run-hooks 'imenu-after-jump-hook)))
+ (pcase index-item
+ (`(,name ,pos ,fn . ,args)
+ (push-mark nil t)
+ (apply fn name pos args)
+ (run-hooks 'imenu-after-jump-hook))
+ (`(,name . ,pos) (imenu (list name pos imenu-default-goto-function)))
+ (_ (error "Unknown imenu item: %S" index-item)))))
(provide 'imenu)
diff --git a/lisp/indent.el b/lisp/indent.el
index c7e2c72950a..cba8f755f8f 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -1,8 +1,8 @@
-;;; indent.el --- indentation commands for Emacs
+;;; indent.el --- indentation commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1995, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
@@ -76,15 +76,32 @@ that case, indent by aligning to the previous non-blank line."
;; indenting. Replace with something ad-hoc.
(let ((column (save-excursion
(beginning-of-line)
- (skip-chars-backward "\n \t")
- (beginning-of-line)
- (current-indentation))))
+ (if (bobp) 0
+ (beginning-of-line 0)
+ (if (looking-at "[ \t]*$") 0
+ (current-indentation))))))
(if (<= (current-column) (current-indentation))
(indent-line-to column)
(save-excursion (indent-line-to column))))
;; The normal case.
(funcall indent-line-function)))
+(defun indent--default-inside-comment ()
+ (unless (or (> (current-column) (current-indentation))
+ (eq this-command last-command))
+ (let ((ppss (syntax-ppss)))
+ (when (nth 4 ppss)
+ (indent-line-to
+ (save-excursion
+ (forward-line -1)
+ (skip-chars-forward " \t")
+ (when (< (1- (point)) (nth 8 ppss) (line-end-position))
+ (goto-char (nth 8 ppss))
+ (when (looking-at comment-start-skip)
+ (goto-char (match-end 0))))
+ (current-column)))
+ t))))
+
(defun indent-for-tab-command (&optional arg)
"Indent the current line or region, or insert a tab, as appropriate.
This function either inserts a tab, or indents the current line,
@@ -123,7 +140,11 @@ prefix argument is ignored."
(old-indent (current-indentation)))
;; Indent the line.
- (funcall indent-line-function)
+ (or (not (eq (funcall indent-line-function) 'noindent))
+ (indent--default-inside-comment)
+ (when (or (<= (current-column) (current-indentation))
+ (not (eq tab-always-indent 'complete)))
+ (funcall (default-value 'indent-line-function))))
(cond
;; If the text was already indented right, try completion.
@@ -154,33 +175,117 @@ prefix argument is ignored."
(insert-char ?\t count)
(indent-to (* tab-width (+ count (/ (current-column) tab-width)))))))
-(defun indent-rigidly (start end arg)
- "Indent all lines starting in the region sideways by ARG columns.
-Called from a program, takes three arguments, START, END and ARG.
-You can remove all indentation from a region by giving a large negative ARG."
- (interactive "r\np")
+(defun indent-rigidly--current-indentation (beg end)
+ "Return the smallest indentation in range from BEG to END.
+Blank lines are ignored."
(save-excursion
- (goto-char end)
- (setq end (point-marker))
- (goto-char start)
- (or (bolp) (forward-line 1))
- (while (< (point) end)
- (let ((indent (current-indentation))
- eol-flag)
- (save-excursion
- (skip-chars-forward " \t")
- (setq eol-flag (eolp)))
- (or eol-flag
- (indent-to (max 0 (+ indent arg)) 0))
- (delete-region (point) (progn (skip-chars-forward " \t") (point))))
- (forward-line 1))
- (move-marker end nil)))
+ (save-match-data
+ (let ((beg (progn (goto-char beg) (line-beginning-position)))
+ indent)
+ (goto-char beg)
+ (while (re-search-forward "^\\s-*[[:print:]]" end t)
+ (setq indent (min (or indent (current-indentation))
+ (current-indentation))))
+ indent))))
+
+(defvar indent-rigidly-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [left] 'indent-rigidly-left)
+ (define-key map [right] 'indent-rigidly-right)
+ (define-key map [S-left] 'indent-rigidly-left-to-tab-stop)
+ (define-key map [S-right] 'indent-rigidly-right-to-tab-stop)
+ map)
+ "Transient keymap for adjusting indentation interactively.
+It is activated by calling `indent-rigidly' interactively.")
+
+(defun indent-rigidly (start end arg &optional interactive)
+ "Indent all lines starting in the region.
+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.
+
+If called from a program, or interactively with prefix ARG,
+indent all lines starting in the region forward by ARG columns.
+If called from a program, START and END specify the beginning and
+end of the text to act on, in place of the region.
+
+Negative values of ARG indent backward, so you can remove all
+indentation by specifying a large negative ARG."
+ (interactive "r\nP\np")
+ (if (and (not arg) interactive)
+ (progn
+ (message
+ (substitute-command-keys
+ "Indent region with \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]."))
+ (set-transient-map indent-rigidly-map t))
+ (save-excursion
+ (goto-char end)
+ (setq end (point-marker))
+ (goto-char start)
+ (or (bolp) (forward-line 1))
+ (while (< (point) end)
+ (let ((indent (current-indentation))
+ eol-flag)
+ (save-excursion
+ (skip-chars-forward " \t")
+ (setq eol-flag (eolp)))
+ (or eol-flag
+ (indent-to (max 0 (+ indent (prefix-numeric-value arg))) 0))
+ (delete-region (point) (progn (skip-chars-forward " \t") (point))))
+ (forward-line 1))
+ (move-marker end nil)
+ ;; Keep the active region in transient mode.
+ (when (eq (cadr overriding-terminal-local-map) indent-rigidly-map)
+ (setq deactivate-mark nil)))))
+
+(defun indent-rigidly--pop-undo ()
+ (and (memq last-command '(indent-rigidly-left indent-rigidly-right
+ indent-rigidly-left-to-tab-stop
+ indent-rigidly-right-to-tab-stop))
+ (consp buffer-undo-list)
+ (eq (car buffer-undo-list) nil)
+ (pop buffer-undo-list)))
+
+(defun indent-rigidly-left (beg end)
+ "Indent all lines between BEG and END leftward by one space."
+ (interactive "r")
+ (indent-rigidly--pop-undo)
+ (indent-rigidly
+ beg end
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left) 1 -1)))
+
+(defun indent-rigidly-right (beg end)
+ "Indent all lines between BEG and END rightward by one space."
+ (interactive "r")
+ (indent-rigidly--pop-undo)
+ (indent-rigidly
+ beg end
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left) -1 1)))
+
+(defun indent-rigidly-left-to-tab-stop (beg end)
+ "Indent all lines between BEG and END leftward to a tab stop."
+ (interactive "r")
+ (indent-rigidly--pop-undo)
+ (let* ((current (indent-rigidly--current-indentation beg end))
+ (rtl (eq (current-bidi-paragraph-direction) 'right-to-left))
+ (next (indent-next-tab-stop current (if rtl nil 'prev))))
+ (indent-rigidly beg end (- next current))))
+
+(defun indent-rigidly-right-to-tab-stop (beg end)
+ "Indent all lines between BEG and END rightward to a tab stop."
+ (interactive "r")
+ (indent-rigidly--pop-undo)
+ (let* ((current (indent-rigidly--current-indentation beg end))
+ (rtl (eq (current-bidi-paragraph-direction) 'right-to-left))
+ (next (indent-next-tab-stop current (if rtl 'prev))))
+ (indent-rigidly beg end (- next current))))
(defun indent-line-to (column)
"Indent current line to COLUMN.
This function removes or adds spaces and tabs at beginning of line
only if necessary. It leaves point at end of indentation."
- (back-to-indentation)
+ (backward-to-indentation 0)
(let ((cur-col (current-column)))
(cond ((< cur-col column)
(if (>= (- column (* (/ cur-col tab-width) tab-width)) tab-width)
@@ -189,7 +294,7 @@ only if necessary. It leaves point at end of indentation."
(indent-to column))
((> cur-col column) ; too far right (after tab?)
(delete-region (progn (move-to-column column t) (point))
- (progn (back-to-indentation) (point)))))))
+ (progn (backward-to-indentation 0) (point)))))))
(defun current-left-margin ()
"Return the left margin to use for this line.
@@ -405,6 +510,7 @@ If the third argument COLUMN is an integer, it specifies the
column to indent to; if it is nil, use one of the three methods above."
(interactive "r\nP")
(cond
+ ;; If a numeric prefix is given, indent to that column.
(column
(setq column (prefix-numeric-value column))
(save-excursion
@@ -416,8 +522,9 @@ column to indent to; if it is nil, use one of the three methods above."
(delete-region (point) (progn (skip-chars-forward " \t") (point)))
(or (eolp)
(indent-to column 0))
- (forward-line 1))
+ (forward-line 1))
(move-marker end nil)))
+ ;; If a fill-prefix is specified, use it.
(fill-prefix
(save-excursion
(goto-char end)
@@ -429,21 +536,28 @@ column to indent to; if it is nil, use one of the three methods above."
(and (bolp) (eolp))
(insert fill-prefix))
(forward-line 1)))))
+ ;; Use indent-region-function is available.
(indent-region-function
(funcall indent-region-function start end))
+ ;; Else, use a default implementation that calls indent-line-function on
+ ;; each line.
(t
(save-excursion
(setq end (copy-marker end))
(goto-char start)
- (while (< (point) end)
- (or (and (bolp) (eolp))
- (indent-according-to-mode))
- (forward-line 1))
- (move-marker end nil))))
+ (let ((pr (unless (minibufferp)
+ (make-progress-reporter "Indenting region..." (point) end))))
+ (while (< (point) end)
+ (or (and (bolp) (eolp))
+ (indent-according-to-mode))
+ (forward-line 1)
+ (and pr (progress-reporter-update pr (point))))
+ (and pr (progress-reporter-done pr))
+ (move-marker end nil)))))
;; In most cases, reindenting modifies the buffer, but it may also
;; leave it unmodified, in which case we have to deactivate the mark
;; by hand.
- (deactivate-mark))
+ (setq deactivate-mark t))
(defun indent-relative-maybe ()
"Indent a new line like previous nonblank line.
@@ -492,13 +606,17 @@ See also `indent-relative-maybe'."
(move-marker opoint nil))
(tab-to-tab-stop))))
-(defcustom tab-stop-list
- '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120)
+(defcustom tab-stop-list nil
"List of tab stop positions used by `tab-to-tab-stop'.
-This should be a list of integers, ordered from smallest to largest."
+This should be nil, or a list of integers, ordered from smallest to largest.
+It implicitly extends to infinity through repetition of the last step.
+For example, '(1 2 5) is equivalent to '(1 2 5 8 11 ...). If the list has
+fewer than 2 elements, `tab-width' is used as the \"last step\".
+A value of nil means a tab stop every `tab-width' columns."
:group 'indent
+ :version "24.4" ; from explicit list to nil
+ :safe 'listp
:type '(repeat integer))
-(put 'tab-stop-list 'safe-local-variable 'listp)
(defvar edit-tab-stops-map
(let ((map (make-sparse-keymap)))
@@ -520,8 +638,7 @@ You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops
(setq edit-tab-stops-buffer (current-buffer))
(switch-to-buffer (get-buffer-create "*Tab Stops*"))
(use-local-map edit-tab-stops-map)
- (make-local-variable 'indent-tabs-mode)
- (setq indent-tabs-mode nil)
+ (setq-local indent-tabs-mode nil)
(overwrite-mode 1)
(setq truncate-lines t)
(erase-buffer)
@@ -557,6 +674,36 @@ You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops
(setq tab-stop-list tabs))
(message "Tab stops installed"))
+(defun indent-next-tab-stop (column &optional prev)
+ "Return the next tab stop after COLUMN.
+If PREV is non-nil, return the previous one instead."
+ (let ((tabs tab-stop-list))
+ (while (and tabs (>= column (car tabs)))
+ (setq tabs (cdr tabs)))
+ (if tabs
+ (if (not prev)
+ (car tabs)
+ (let ((prevtabs (cdr (memq (car tabs) (reverse tab-stop-list)))))
+ (if (null prevtabs) 0
+ (if (= column (car prevtabs))
+ (or (nth 1 prevtabs) 0)
+ (car prevtabs)))))
+ ;; We passed the end of tab-stop-list: guess a continuation.
+ (let* ((last2 (last tab-stop-list 2))
+ (step (if (cdr last2) (- (cadr last2) (car last2)) tab-width))
+ (last (or (cadr last2) (car last2) 0)))
+ ;; Repeat the last tab's length.
+ (+ last (* step (if prev
+ (if (<= column last) -1 (/ (- column last 1) step))
+ (1+ (/ (- column last) step)))))))))
+
+(defun indent-accumulate-tab-stops (limit)
+ "Get a list of tab stops before LIMIT (inclusive)."
+ (let ((tab 0) (tab-stops))
+ (while (<= (setq tab (indent-next-tab-stop tab)) limit)
+ (push tab tab-stops))
+ (nreverse tab-stops)))
+
(defun tab-to-tab-stop ()
"Insert spaces or tabs to next defined tab-stop column.
The variable `tab-stop-list' is a list of columns at which there are tab stops.
@@ -564,37 +711,29 @@ Use \\[edit-tab-stops] to edit them interactively."
(interactive)
(and abbrev-mode (= (char-syntax (preceding-char)) ?w)
(expand-abbrev))
- (let ((tabs tab-stop-list))
- (while (and tabs (>= (current-column) (car tabs)))
- (setq tabs (cdr tabs)))
- (if tabs
- (progn
- (delete-horizontal-space t)
- (indent-to (car tabs)))
- (insert ?\s))))
+ (let ((nexttab (indent-next-tab-stop (current-column))))
+ (delete-horizontal-space t)
+ (indent-to nexttab)))
(defun move-to-tab-stop ()
"Move point to next defined tab-stop column.
The variable `tab-stop-list' is a list of columns at which there are tab stops.
Use \\[edit-tab-stops] to edit them interactively."
(interactive)
- (let ((tabs tab-stop-list))
- (while (and tabs (>= (current-column) (car tabs)))
- (setq tabs (cdr tabs)))
- (if tabs
- (let ((before (point)))
- (move-to-column (car tabs) t)
- (save-excursion
- (goto-char before)
- ;; If we just added a tab, or moved over one,
- ;; delete any superfluous spaces before the old point.
- (if (and (eq (preceding-char) ?\s)
- (eq (following-char) ?\t))
- (let ((tabend (* (/ (current-column) tab-width) tab-width)))
- (while (and (> (current-column) tabend)
- (eq (preceding-char) ?\s))
- (forward-char -1))
- (delete-region (point) before))))))))
+ (let ((nexttab (indent-next-tab-stop (current-column))))
+ (let ((before (point)))
+ (move-to-column nexttab t)
+ (save-excursion
+ (goto-char before)
+ ;; If we just added a tab, or moved over one,
+ ;; delete any superfluous spaces before the old point.
+ (if (and (eq (preceding-char) ?\s)
+ (eq (following-char) ?\t))
+ (let ((tabend (* (/ (current-column) tab-width) tab-width)))
+ (while (and (> (current-column) tabend)
+ (eq (preceding-char) ?\s))
+ (forward-char -1))
+ (delete-region (point) before)))))))
(define-key global-map "\t" 'indent-for-tab-command)
(define-key esc-map "\C-\\" 'indent-region)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index e43cd731547..70c30c3e7a6 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1,7 +1,7 @@
;;; info-look.el --- major-mode-sensitive Info index lookup facility -*- lexical-binding: t -*-
;; An older version of this was known as libc.el.
-;; Copyright (C) 1995-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
;; (did not show signs of life (Nov 2001) -stef)
@@ -35,6 +35,11 @@
;; (or CTAN mirrors)
;; Perl: <URL:ftp://ftp.cpan.org/pub/CPAN/doc/manual/texinfo/> (or CPAN mirrors)
+;; Traditionally, makeinfo quoted `like this', but version 5 and later
+;; quotes 'like this' or ‘like this’. Doc specs with patterns
+;; therefore match open and close quotes with ['`‘] and ['’],
+;; respectively.
+
;;; Code:
(require 'info)
@@ -137,7 +142,7 @@ OTHER-MODES is a list of cross references to other help modes.")
"Add or update a help specification.
Function arguments are specified as keyword/argument pairs:
- \(KEYWORD . ARGUMENT)
+ (KEYWORD . ARGUMENT)
KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case',
`:doc-spec', `:parse-rule', or `:other-modes'.
@@ -260,7 +265,7 @@ minibuffer. In the minibuffer, use M-n to yank the default argument
value into the minibuffer so you can edit it. The default symbol is the
one found at point.
-With prefix arg a query for the symbol help mode is offered."
+With prefix arg MODE a query for the symbol help mode is offered."
(interactive
(info-lookup-interactive-arguments 'symbol current-prefix-arg))
(info-lookup 'symbol symbol mode))
@@ -274,7 +279,7 @@ In the minibuffer, use M-n to yank the default file name
into the minibuffer so you can edit it.
The default file name is the one found at point.
-With prefix arg a query for the file help mode is offered."
+With prefix arg MODE a query for the file help mode is offered."
(interactive
(info-lookup-interactive-arguments 'file current-prefix-arg))
(info-lookup 'file file mode))
@@ -608,8 +613,8 @@ Return nil if there is nothing appropriate in the buffer near point."
(condition-case nil
(save-excursion
(let ((case-fold-search t)
- (ignored-chars "][()`',:.\" \t\n")
- (significant-chars "^][()`',:.\" \t\n")
+ (ignored-chars "][()`'‘’,:.\" \t\n")
+ (significant-chars "^][()`'‘’,:.\" \t\n")
beg end)
(cond
((and (memq (get-char-property (point) 'face)
@@ -629,7 +634,8 @@ Return nil if there is nothing appropriate in the buffer near point."
(setq end (point))
(> end beg))
(and (looking-at "[ \t\n]")
- (looking-back (concat "[" significant-chars "]"))
+ (looking-back (concat "[" significant-chars "]")
+ (1- (point)))
(setq end (point))
(skip-chars-backward significant-chars)
(setq beg (point))
@@ -716,12 +722,12 @@ Return nil if there is nothing appropriate in the buffer near point."
;; suffix "\\>" is not used because that sends DBL_MAX to
;; DBL_MAX_EXP ("_" is a non-word char)
("(libc)Variable Index" nil
- "^\\([ \t]+-+ \\(Variable\\|Macro\\): .*\\<\\|`\\)"
- "\\( \\|'?$\\)")
+ "^\\([ \t]+-+ \\(Variable\\|Macro\\): .*\\<\\|['`‘]\\)"
+ "\\( \\|['’]?$\\)")
("(libc)Type Index" nil
"^[ \t]+-+ Data Type: \\<" "\\>")
("(termcap)Var Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
:parse-rule 'info-lookup-guess-c-symbol)
(info-lookup-maybe-add-help
@@ -733,7 +739,7 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'bison-mode
:regexp "[:;|]\\|%\\([%{}]\\|[_a-z]+\\)\\|YY[_A-Z]+\\|yy[_a-z]+"
:doc-spec '(("(bison)Index" nil
- "`" "'"))
+ "['`‘]" "['’]"))
:parse-rule "[:;|]\\|%\\([%{}]\\|[_a-zA-Z][_a-zA-Z0-9]*\\)"
:other-modes '(c-mode))
@@ -741,7 +747,7 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'makefile-mode
:regexp "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z][_a-zA-Z0-9-]*"
:doc-spec '(("(make)Name Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
:parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+")
(info-lookup-maybe-add-help
@@ -756,15 +762,16 @@ Return nil if there is nothing appropriate in the buffer near point."
:doc-spec '(
;; "(automake)Macro Index" is autoconf macros used in
;; configure.ac, not Makefile.am, so don't have that here.
- ("(automake)Variable Index" nil "^[ \t]*`" "'")
+ ("(automake)Variable Index" nil "^[ \t]*['`‘]" "['’]")
;; In automake 1.4 macros and variables were a combined node.
- ("(automake)Macro and Variable Index" nil "^[ \t]*`" "'")
+ ("(automake)Macro and Variable Index" nil "^[ \t]*['`‘]"
+ "['’]")
;; Directives like "if" are in the "General Index".
;; Prefix "`" since the text for say `+=' isn't always an
;; @item etc and so not always at the start of a line.
- ("(automake)General Index" nil "`" "'")
+ ("(automake)General Index" nil "['`‘]" "['’]")
;; In automake 1.3 there was just a single "Index" node.
- ("(automake)Index" nil "`" "'"))
+ ("(automake)Index" nil "['`‘]" "['’]"))
:other-modes '(makefile-mode))
(info-lookup-maybe-add-help
@@ -775,7 +782,7 @@ Return nil if there is nothing appropriate in the buffer near point."
(lambda (item)
(if (string-match "^\\([a-zA-Z]+\\|[^a-zA-Z]\\)\\( .*\\)?$" item)
(concat "@" (match-string 1 item))))
- "`" "[' ]")))
+ "['`‘]" "['’ ]")))
(info-lookup-maybe-add-help
:mode 'm4-mode
@@ -821,7 +828,7 @@ Return nil if there is nothing appropriate in the buffer near point."
;; macros (eg. AC_PROG_CC). Ensure this is after the autoconf
;; index, so as to prefer the autoconf docs.
("(automake)Macro and Variable Index" nil
- "^[ \t]*`" "'"))
+ "^[ \t]*['`‘]" "['’]"))
;; Autoconf symbols are M4 macros. Thus use M4's parser.
:parse-rule 'ignore
:other-modes '(m4-mode))
@@ -846,7 +853,7 @@ Return nil if there is nothing appropriate in the buffer near point."
;; Built-in functions (matches to many entries).
((string-match "^[a-z]+$" item)
item))))
- "`" "\\([ \t]*([^)]*)\\)?'")))
+ "['`‘]" "\\([ \t]*([^)]*)\\)?['’]")))
(info-lookup-maybe-add-help
:mode 'perl-mode
@@ -885,16 +892,19 @@ Return nil if there is nothing appropriate in the buffer near point."
;; From http://home.gna.org/latexrefman
"(latex2e)Command Index"
"(latex)Command Index")
- nil "`" "\\({[^}]*}\\)?'")))
+ ;; \frac{NUM}{DEN} etc can have more than one {xx} argument.
+ ;; \sqrt[ROOT]{num} and others can have square brackets.
+ nil "[`'‘]" "\\({[^}]*}|\\[[^]]*\\]\\)*['’]")))
+
(info-lookup-maybe-add-help
:mode 'emacs-lisp-mode
- :regexp "[^][()`',\" \t\n]+"
+ :regexp "[^][()`'‘’,\" \t\n]+"
:doc-spec '(;; Commands with key sequences appear in nodes as `foo' and
;; those without as `M-x foo'.
- ("(emacs)Command Index" nil "`\\(M-x[ \t\n]+\\)?" "'")
+ ("(emacs)Command Index" nil "['`‘]\\(M-x[ \t\n]+\\)?" "['’]")
;; Variables normally appear in nodes as just `foo'.
- ("(emacs)Variable Index" nil "`" "'")
+ ("(emacs)Variable Index" nil "['`‘]" "['’]")
;; Almost all functions, variables, etc appear in nodes as
;; " -- Function: foo" etc. A small number of aliases and
;; symbols appear only as `foo', and will miss out on exact
@@ -907,24 +917,24 @@ Return nil if there is nothing appropriate in the buffer near point."
;; docstrings talk about elisp, so have apropos-mode follow emacs-lisp-mode
(info-lookup-maybe-add-help
:mode 'apropos-mode
- :regexp "[^][()`',\" \t\n]+" ;; same as emacs-lisp-mode above
+ :regexp "[^][()`'‘’,\" \t\n]+" ;; same as emacs-lisp-mode above
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'lisp-interaction-mode
- :regexp "[^][()`',\" \t\n]+"
+ :regexp "[^][()`'‘’,\" \t\n]+"
:parse-rule 'ignore
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'lisp-mode
- :regexp "[^()`',\" \t\n]+"
+ :regexp "[^()`'‘’,\" \t\n]+"
:parse-rule 'ignore
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'scheme-mode
- :regexp "[^()`',\" \t\n]+"
+ :regexp "[^()`'‘’,\" \t\n]+"
:ignore-case t
;; Aubrey Jaffer's rendition from <URL:ftp://ftp-swiss.ai.mit.edu/pub/scm>
:doc-spec '(("(r5rs)Index" nil
@@ -976,9 +986,9 @@ Return nil if there is nothing appropriate in the buffer near point."
;; bash has "." and ":" in its index, but those chars will probably never
;; work in info, so don't bother matching them in the regexp.
:regexp "\\([a-zA-Z0-9_-]+\\|[!{}@*#?$]\\|\\[\\[?\\|]]?\\)"
- :doc-spec '(("(bash)Builtin Index" nil "^`" "[ .']")
- ("(bash)Reserved Word Index" nil "^`" "[ .']")
- ("(bash)Variable Index" nil "^`" "[ .']")
+ :doc-spec '(("(bash)Builtin Index" nil "^['`‘]" "[ .'’]")
+ ("(bash)Reserved Word Index" nil "^['`‘]" "[ .'’]")
+ ("(bash)Variable Index" nil "^['`‘]" "[ .'’]")
;; coreutils (version 4.5.10) doesn't have a separate program
;; index, so exclude extraneous stuff (most of it) by demanding
@@ -1026,18 +1036,18 @@ Return nil if there is nothing appropriate in the buffer near point."
item))
;; This gets functions in evaluated classes. Other
;; possible patterns don't seem to work too well.
- "`" "(")))
+ "['`‘]" "(")))
(info-lookup-maybe-add-help
:mode 'Custom-mode
:ignore-case t
- :regexp "[^][()`',:\" \t\n]+"
+ :regexp "[^][()`'‘’,:\" \t\n]+"
:parse-rule 'info-lookup-guess-custom-symbol
:other-modes '(emacs-lisp-mode))
(info-lookup-maybe-add-help
:mode 'help-mode
- :regexp "[^][()`',:\" \t\n]+"
+ :regexp "[^][()`'‘’,:\" \t\n]+"
:other-modes '(emacs-lisp-mode))
(provide 'info-look)
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 21fb592ff19..fcdf5323db7 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -1,6 +1,6 @@
;;; info-xref.el --- check external references in an Info document
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Kevin Ryde <user42@zip.com.au>
;; Keywords: docs
@@ -170,13 +170,13 @@ overall good/bad count summary inserted at the very end."
info-xref-good info-xref-bad info-xref-unavail))))
(defun info-xref-output (fmt &rest args)
- "Emit a `format'-ed message FMT+ARGS to the `info-xref-output-buffer'."
+ "Emit a `format-message'-ed message FMT+ARGS to the `info-xref-output-buffer'."
(with-current-buffer info-xref-output-buffer
(save-excursion
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert info-xref-output-heading
- (apply 'format fmt args)
+ (apply #'format-message fmt args)
"\n")))
(setq info-xref-output-heading "")
;; all this info-xref can be pretty slow, display now so the user sees
@@ -454,7 +454,7 @@ and can take a long time."
(cond ((symbolp load)
(condition-case cause (require load)
(error
- (info-xref-output "Symbol `%s': cannot require '%s: %s"
+ (info-xref-output "Symbol `%s': cannot require `%s': %s"
symbol load cause))))
;; skip if previously loaded
((assoc load load-history))
diff --git a/lisp/info.el b/lisp/info.el
index 182ad8563aa..b11330b1430 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1,8 +1,8 @@
-;; info.el --- info package for Emacs
+;; info.el --- Info package for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
;; This file is part of GNU Emacs.
@@ -32,17 +32,19 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup info nil
"Info subsystem."
:group 'help
:group 'docs)
-(defvar Info-history nil
+(defvar-local Info-history nil
"Stack of Info nodes user has visited.
Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).")
-(defvar Info-history-forward nil
+(defvar-local Info-history-forward nil
"Stack of Info nodes user has visited with `Info-history-back' command.
Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).")
@@ -136,10 +138,15 @@ The Lisp code is executed when the node is selected.")
:type 'boolean
:group 'info)
-(defcustom Info-fontify-maximum-menu-size 100000
+;; It's unfortunate that nil means no fontification, as opposed to no limit,
+;; since that differs from font-lock-maximum-size.
+(defcustom Info-fontify-maximum-menu-size 400000
"Maximum size of menu to fontify if `font-lock-mode' is non-nil.
-Set to nil to disable node fontification."
- :type 'integer
+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)
(defcustom Info-use-header-line t
@@ -296,7 +303,7 @@ when you hit the end of the current node."
"If non-nil, hide the tag and section reference in *note and * menu items.
If value is non-nil but not `hide', also replaces the \"*note\" with \"see\".
If value is non-nil but not t or `hide', the reference section is still shown.
-`nil' completely disables this feature. If this is non-nil, you might
+nil completely disables this feature. If this is non-nil, you might
want to set `Info-refill-paragraphs'."
:version "22.1"
:type '(choice (const :tag "No hiding" nil)
@@ -375,33 +382,33 @@ with wrapping around the current Info node."
(make-obsolete-variable 'Info-edit-mode-hook
"editing Info nodes by hand is not recommended." "24.4")
-(defvar Info-current-file nil
+(defvar-local Info-current-file nil
"Info file that Info is now looking at, or nil.
This is the name that was specified in Info, not the actual file name.
It doesn't contain directory names or file name extensions added by Info.")
-(defvar Info-current-subfile nil
+(defvar-local Info-current-subfile nil
"Info subfile that is actually in the *info* buffer now.
It is nil if current Info file is not split into subfiles.")
-(defvar Info-current-node nil
+(defvar-local Info-current-node nil
"Name of node that Info is now looking at, or nil.")
-(defvar Info-tag-table-marker nil
+(defvar-local Info-tag-table-marker nil
"Marker pointing at beginning of current Info file's tag table.
Marker points nowhere if file has no tag table.")
-(defvar Info-tag-table-buffer nil
+(defvar-local Info-tag-table-buffer nil
"Buffer used for indirect tag tables.")
-(defvar Info-current-file-completions nil
+(defvar-local Info-current-file-completions nil
"Cached completion list for current Info file.")
(defvar Info-file-completions nil
"Cached completion alist of visited Info files.
Each element of the alist is (FILE . COMPLETIONS)")
-(defvar Info-file-supports-index-cookies nil
+(defvar-local Info-file-supports-index-cookies nil
"Non-nil if current Info file supports index cookies.")
(defvar Info-file-supports-index-cookies-list nil
@@ -409,7 +416,7 @@ Each element of the alist is (FILE . COMPLETIONS)")
Each element of the list is a list (FILENAME SUPPORTS-INDEX-COOKIES)
where SUPPORTS-INDEX-COOKIES can be either t or nil.")
-(defvar Info-index-alternatives nil
+(defvar-local Info-index-alternatives nil
"List of possible matches for last `Info-index' command.")
(defvar Info-point-loc nil
@@ -455,7 +462,7 @@ existing node names. OPERATION is one of the following operation
symbols `find-node' that define what HANDLER function to call instead
of calling the default corresponding function to override it.")
-(defvar Info-current-node-virtual nil
+(defvar-local Info-current-node-virtual nil
"Non-nil if the current Info node is virtual.")
(defun Info-virtual-file-p (filename)
@@ -625,7 +632,7 @@ Do the right thing if the file has been compressed or zipped."
default-directory)))
(or (consp decoder)
(setq decoder (list decoder)))
- (apply 'call-process-region (point-min) (point-max)
+ (apply #'call-process-region (point-min) (point-max)
(car decoder) t t nil (cdr decoder))))
(let ((inhibit-null-byte-detection t)) ; Index nodes include null bytes
(insert-file-contents fullname visit)))
@@ -772,8 +779,7 @@ with the top-level Info directory.
In interactive use, a non-numeric prefix argument directs
this command to read a file name from the minibuffer.
-A numeric prefix argument N selects an Info buffer named
-\"*info*<%s>\".
+A numeric prefix argument of N selects an Info buffer named \"*info*<N>\".
The search path for Info files is in the variable `Info-directory-list'.
The top-level Info directory is made by combining all the files named `dir'
@@ -790,7 +796,7 @@ See a list of available Info commands in `Info-mode'."
(defun info-setup (file-or-node buffer)
"Display Info node FILE-OR-NODE in BUFFER."
- (if (and buffer (not (eq major-mode 'Info-mode)))
+ (if (and buffer (not (derived-mode-p 'Info-mode)))
(Info-mode))
(if file-or-node
;; If argument already contains parentheses, don't add another set
@@ -917,7 +923,10 @@ just return nil (no error)."
(setq filename found)
(if noerror
(setq filename nil)
- (error "Info file %s does not exist" filename)))
+ ;; If there is no previous Info file, go to the directory.
+ (unless Info-current-file
+ (Info-directory))
+ (user-error "Info file %s does not exist" filename)))
filename))))
(defun Info-find-node (filename nodename &optional no-going-back strict-case)
@@ -931,7 +940,7 @@ STRICT-CASE is non-nil)."
(info-initialize)
(setq filename (Info-find-file filename))
;; Go into Info buffer.
- (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
;; Record the node we are leaving, if we were in one.
(and (not no-going-back)
Info-current-file
@@ -951,17 +960,17 @@ otherwise, that defaults to `Top'."
(unless nodename (setq nodename "Top"))
(info-initialize)
(Info-mode)
- (set (make-local-variable 'Info-current-file)
- (or buffer-file-name
- ;; If called on a non-file buffer, make a fake file name.
- (concat default-directory (buffer-name))))
+ (setq Info-current-file
+ (or buffer-file-name
+ ;; If called on a non-file buffer, make a fake file name.
+ (concat default-directory (buffer-name))))
(Info-find-node-2 nil nodename))
(defun Info-revert-find-node (filename nodename)
"Go to an Info node FILENAME and NODENAME, re-reading disk contents.
When *info* is already displaying FILENAME and NODENAME, the window position
is preserved, if possible."
- (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
(let ((old-filename Info-current-file)
(old-nodename Info-current-node)
(window-selected (eq (selected-window) (get-buffer-window)))
@@ -1000,7 +1009,7 @@ REGEXP is a regular expression matching nodes or references. Its first
group should match `Node:' or `Ref:'.
CASE-FOLD t means search for a case-insensitive match.
If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
-FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
+FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the file position
where the match was found, and MODE is `major-mode' of the buffer in
which the match was found."
(let ((case-fold-search case-fold))
@@ -1011,7 +1020,7 @@ which the match was found."
(beginning-of-line)
(when (re-search-forward regexp nil t)
(list (string-equal "Ref:" (match-string 1))
- (+ (point-min) (read (current-buffer)))
+ (read (current-buffer))
major-mode)))))
(defun Info-find-in-tag-table (marker regexp &optional strict-case)
@@ -1020,7 +1029,7 @@ MARKER specifies the buffer and position to start searching at.
REGEXP is a regular expression matching nodes or references. Its first
group should match `Node:' or `Ref:'.
If a match was found, value is a list (FOUND-ANCHOR POS MODE), where
-FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the position
+FOUND-ANCHOR is non-nil if a `Ref:' was matched, POS is the file position
where the match was found, and MODE is `major-mode' of the buffer in
which the match was found.
This function tries to find a case-sensitive match first, then a
@@ -1065,7 +1074,7 @@ is non-nil)."
(defun Info-find-node-2 (filename nodename &optional no-going-back strict-case)
(buffer-disable-undo (current-buffer))
- (or (eq major-mode 'Info-mode)
+ (or (derived-mode-p 'Info-mode)
(Info-mode))
(widen)
(setq Info-current-node nil)
@@ -1088,7 +1097,7 @@ is non-nil)."
(set-marker Info-tag-table-marker nil)
(setq buffer-read-only t)
(set-buffer-modified-p nil)
- (set (make-local-variable 'Info-current-node-virtual) t)))
+ (setq Info-current-node-virtual t)))
((not (and
;; Reread a file when moving from a virtual node.
(not Info-current-node-virtual)
@@ -1098,7 +1107,7 @@ is non-nil)."
(let ((inhibit-read-only t))
(when Info-current-node-virtual
;; When moving from a virtual node.
- (set (make-local-variable 'Info-current-node-virtual) nil)
+ (setq Info-current-node-virtual nil)
(if (null filename)
(setq filename Info-current-file)))
(setq Info-current-file nil
@@ -1106,10 +1115,14 @@ is non-nil)."
Info-current-file-completions nil
buffer-file-name nil)
(erase-buffer)
+ ;; Erase any memory of the previous coding-system, so that
+ ;; info-insert-file-contents sets the buffer's encoding to
+ ;; what the Info file specifies.
+ (set-buffer-file-coding-system 'undecided t)
(info-insert-file-contents filename nil)
(setq default-directory (file-name-directory filename))
(set-buffer-modified-p nil)
- (set (make-local-variable 'Info-file-supports-index-cookies)
+ (setq Info-file-supports-index-cookies
(Info-file-supports-index-cookies filename))
;; See whether file has a tag table. Record the location if yes.
@@ -1178,15 +1191,18 @@ is non-nil)."
(when found
;; FOUND is (ANCHOR POS MODE).
- (setq guesspos (nth 1 found))
+ (let ((filepos (nth 1 found))) ;File position in bytes.
+
+ ;; If this is an indirect file, determine which
+ ;; file really holds this node and read it in.
+ (unless (eq (nth 2 found) 'Info-mode)
+ ;; Note that the current buffer must be the
+ ;; *info* buffer on entry to
+ ;; Info-read-subfile. Thus the hackery above.
+ (setq filepos (Info-read-subfile filepos)))
- ;; If this is an indirect file, determine which
- ;; file really holds this node and read it in.
- (unless (eq (nth 2 found) 'Info-mode)
- ;; Note that the current buffer must be the
- ;; *info* buffer on entry to
- ;; Info-read-subfile. Thus the hackery above.
- (setq guesspos (Info-read-subfile guesspos)))
+ (setq guesspos
+ (filepos-to-bufferpos filepos 'approximate)))
;; Handle anchor
(when (nth 0 found)
@@ -1194,8 +1210,7 @@ is non-nil)."
(throw 'foo t)))))
;; Else we may have a node, which we search for:
- (goto-char (max (point-min)
- (- (byte-to-position guesspos) 1000)))
+ (goto-char (max (point-min) (- guesspos 1000)))
;; Now search from our advised position (or from beg of
;; buffer) to find the actual node. First, check
@@ -1206,6 +1221,18 @@ is non-nil)."
(goto-char pos)
(throw 'foo t)))
+ ;; If the Texinfo source had an @ifnottex block of text
+ ;; before the Top node, makeinfo 5.0 and 5.1 mistakenly
+ ;; omitted that block's size from the starting position
+ ;; of the 1st subfile, which makes GUESSPOS overshoot
+ ;; the correct position by the length of that text. So
+ ;; we try again with a larger slop.
+ (goto-char (max (point-min) (- guesspos 10000)))
+ (let ((pos (Info-find-node-in-buffer regexp strict-case)))
+ (when pos
+ (goto-char pos)
+ (throw 'foo t)))
+
(when (string-match "\\([^.]+\\)\\." nodename)
(let (Info-point-loc)
(Info-find-node-2
@@ -1237,26 +1264,28 @@ is non-nil)."
(Info-find-index-name Info-point-loc)
(setq Info-point-loc nil))))))
;; If we did not finish finding the specified node,
- ;; go back to the previous one.
- (or Info-current-node no-going-back (null Info-history)
- (let ((hist (car Info-history)))
- (setq Info-history (cdr Info-history))
- (Info-find-node (nth 0 hist) (nth 1 hist) t)
- (goto-char (nth 2 hist))))))
+ ;; go back to the previous one or to the Top node.
+ (unless (or Info-current-node no-going-back)
+ (if Info-history
+ (let ((hist (car Info-history)))
+ (setq Info-history (cdr Info-history))
+ (Info-find-node (nth 0 hist) (nth 1 hist) t)
+ (goto-char (nth 2 hist)))
+ (Info-find-node Info-current-file "Top" t)))))
;; Cache the contents of the (virtual) dir file, once we have merged
;; it for the first time, so we can save time subsequently.
-(defvar Info-dir-contents nil)
+(defvar-local Info-dir-contents nil)
;; Cache for the directory we decided to use for the default-directory
;; of the merged dir text.
-(defvar Info-dir-contents-directory nil)
+(defvar-local Info-dir-contents-directory nil)
;; Record the file attributes of all the files from which we
;; constructed Info-dir-contents.
-(defvar Info-dir-file-attributes nil)
+(defvar-local Info-dir-file-attributes nil)
-(defvar Info-dir-file-name nil)
+(defvar-local Info-dir-file-name nil)
;; Construct the Info directory node by merging the files named `dir'
;; from various directories. Set the *info* buffer's
@@ -1329,13 +1358,12 @@ is non-nil)."
;; knows...
(let ((inhibit-null-byte-detection t))
(insert-file-contents file)
- (set (make-local-variable 'Info-dir-file-name)
- file)
+ (setq Info-dir-file-name file)
(push (current-buffer) buffers)
(push (cons file attrs) dir-file-attrs))
(error (kill-buffer (current-buffer))))))))
(unless (cdr dirs)
- (set (make-local-variable 'Info-dir-contents-directory)
+ (setq Info-dir-contents-directory
(file-name-as-directory (car dirs))))
(setq dirs (cdr dirs))))
@@ -1412,16 +1440,16 @@ is non-nil)."
(insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
;; Merge the text from the other buffer's menu
;; into the menu in the like-named node in the main buffer.
- (apply 'insert-buffer-substring (cdr node))))
+ (apply #'insert-buffer-substring (cdr node))))
(Info-dir-remove-duplicates)
;; Kill all the buffers we just made, including the special one excised.
- (mapc 'kill-buffer (cons buffer buffers))
+ (mapc #'kill-buffer (cons buffer buffers))
(goto-char (point-min))
(if problems
(message "Composing main Info directory...problems encountered, see `*Messages*'")
(message "Composing main Info directory...done"))
- (set (make-local-variable 'Info-dir-contents) (buffer-string))
- (set (make-local-variable 'Info-dir-file-attributes) dir-file-attrs)))
+ (setq Info-dir-contents (buffer-string))
+ (setq Info-dir-file-attributes dir-file-attrs)))
(setq default-directory Info-dir-contents-directory))
(defvar Info-streamline-headings
@@ -1496,7 +1524,7 @@ is non-nil)."
;; Note that on entry to this function the current-buffer must be the
;; *info* buffer; not the info tags buffer.
(defun Info-read-subfile (nodepos)
- ;; NODEPOS is either a position (in the Info file as a whole,
+ ;; NODEPOS is either a position in bytes (in the Info file as a whole,
;; not relative to a subfile) or the name of a subfile.
(let (lastfilepos
lastfilename)
@@ -1513,7 +1541,7 @@ is non-nil)."
thisfilepos thisfilename)
(search-forward ": ")
(setq thisfilename (buffer-substring beg (- (point) 2)))
- (setq thisfilepos (+ (point-min) (read (current-buffer))))
+ (setq thisfilepos (read (current-buffer)))
;; read in version 19 stops at the end of number.
;; Advance to the next line.
(forward-line 1)
@@ -1541,10 +1569,13 @@ is non-nil)."
(if (looking-at "\^_")
(forward-char 1)
(search-forward "\n\^_"))
- ;; Don't add the length of the skipped summary segment to
- ;; the value returned to `Info-find-node-2'. (Bug#14125)
(if (numberp nodepos)
- (+ (- nodepos lastfilepos) (point-min)))))
+ ;; Our caller ('Info-find-node-2') wants the (zero-based) byte
+ ;; offset corresponding to NODEPOS, from the beginning of the
+ ;; subfile. This is especially important if NODEPOS is for an
+ ;; anchor reference, because for those the position is all we
+ ;; have.
+ (+ (- nodepos lastfilepos) (bufferpos-to-filepos (point) 'exact)))))
(defun Info-unescape-quotes (value)
"Unescape double quotes and backslashes in VALUE."
@@ -1595,17 +1626,20 @@ escaped (\\\",\\\\)."
""))
(image (if (file-exists-p image-file)
(create-image image-file)
- "[broken image]")))
+ (or (cdr (assoc-string "text" parameter-alist))
+ (and src (concat "[broken image:" src "]"))
+ "[broken image]"))))
(if (not (get-text-property start 'display))
(add-text-properties
- start (point) `(display ,image rear-nonsticky (display)))))
+ start (point)
+ `(display ,image rear-nonsticky (display)
+ help-echo ,(cdr (assoc-string "alt" parameter-alist))))))
;; text-only display, show alternative text if provided, or
;; otherwise a clue that there's meant to be a picture
(delete-region start (point))
(insert (or (cdr (assoc-string "text" parameter-alist))
(cdr (assoc-string "alt" parameter-alist))
- (and src
- (concat "[image:" src "]"))
+ (and src (concat "[image:" src "]"))
"[image]"))))))
(set-buffer-modified-p nil)))
@@ -1797,10 +1831,10 @@ See `completing-read' for a description of arguments and usage."
((string-match "\\`([^)]*\\'" string)
(completion-table-with-context
"("
- (apply-partially 'completion-table-with-terminator ")"
- (apply-partially 'Info-read-node-name-2
+ (apply-partially #'completion-table-with-terminator ")"
+ (apply-partially #'Info-read-node-name-2
Info-directory-list
- (mapcar 'car Info-suffix-list)))
+ (mapcar #'car Info-suffix-list)))
(substring string 1)
predicate
code))
@@ -1814,12 +1848,11 @@ See `completing-read' for a description of arguments and usage."
t
(completion-table-with-context
file0
- (apply-partially
- (lambda (string pred action)
- (complete-with-action
- action
- (Info-build-node-completions (Info-find-file file1))
- string pred)))
+ (lambda (string pred action)
+ (complete-with-action
+ action
+ (Info-build-node-completions (Info-find-file file1))
+ string pred))
nodename predicate code))))
;; Otherwise use Info-read-node-completion-table.
(t (complete-with-action
@@ -1884,7 +1917,7 @@ the Top node in FILENAME."
(cons (list (match-string-no-properties 1))
compl))))))))
(setq compl (cons '("*") (nreverse compl)))
- (set (make-local-variable 'Info-current-file-completions) compl)
+ (setq Info-current-file-completions compl)
compl))
@@ -2001,10 +2034,9 @@ If DIRECTION is `backward', search in the reverse direction."
(re-search-backward "\\(^.*\\): [0-9]+$")
(re-search-forward "\\(^.*\\): [0-9]+$"))
(goto-char (+ (match-end 1) 2))
- (setq list (cons (cons (+ (point-min)
- (read (current-buffer)))
- (match-string-no-properties 1))
- list))
+ (push (cons (read (current-buffer))
+ (match-string-no-properties 1))
+ list)
(goto-char (if backward
(1- (match-beginning 0))
(1+ (match-end 0)))))
@@ -2082,14 +2114,14 @@ If DIRECTION is `backward', search in the reverse direction."
search-whitespace-regexp)))
(Info-search
(cond
- (isearch-word
+ (isearch-regexp-function
;; Lax version of word search
(let ((lax (not (or isearch-nonincremental
(eq (length string)
(length (isearch--state-string
(car isearch-cmds))))))))
- (if (functionp isearch-word)
- (funcall isearch-word string lax)
+ (if (functionp isearch-regexp-function)
+ (funcall isearch-regexp-function string lax)
(word-search-regexp string lax))))
(isearch-regexp string)
(t (regexp-quote string)))
@@ -2199,7 +2231,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
"[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space.
"\\|\\)\\)")) ;Allow empty node names.
-;;; For compatibility; other files have used this name.
+;; For compatibility; other files have used this name.
(defun Info-following-node-name ()
(and (looking-at (Info-following-node-name-re))
(match-string-no-properties 1)))
@@ -2209,7 +2241,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
(interactive)
;; In case another window is currently selected
(save-window-excursion
- (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
(Info-goto-node (Info-extract-pointer "next"))))
(defun Info-prev ()
@@ -2217,7 +2249,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat."
(interactive)
;; In case another window is currently selected
(save-window-excursion
- (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
(Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))))
(defun Info-up (&optional same-file)
@@ -2226,7 +2258,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(interactive)
;; In case another window is currently selected
(save-window-excursion
- (or (eq major-mode 'Info-mode) (switch-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*"))
(let ((old-node Info-current-node)
(old-file Info-current-file)
(node (Info-extract-pointer "up")) p)
@@ -2564,7 +2596,9 @@ new buffer."
(save-excursion
;; Move point to the beginning of reference if point is on reference
(or (looking-at "\\*note[ \n\t]+")
- (and (looking-back "\\*note[ \n\t]+")
+ (and (looking-back "\\*note[ \n\t]+"
+ (save-excursion (skip-chars-backward " \n\t")
+ (line-beginning-position)))
(goto-char (match-beginning 0)))
(if (and (save-excursion
(goto-char (+ (point) 5)) ; skip a possible *note
@@ -2637,7 +2671,7 @@ Because of ambiguities, this should be concatenated with something like
(defvar Info-complete-menu-buffer)
(defvar Info-complete-next-re nil)
(defvar Info-complete-nodes nil)
-(defvar Info-complete-cache nil)
+(defvar-local Info-complete-cache nil)
(defconst Info-node-spec-re
(concat (Info-following-node-name-re "^.,:") "[,:.]")
@@ -2682,9 +2716,7 @@ Because of ambiguities, this should be concatenated with something like
(equal (nth 1 Info-complete-cache) Info-current-node)
(equal (nth 2 Info-complete-cache) Info-complete-next-re)
(equal (nth 5 Info-complete-cache) Info-complete-nodes)
- (let ((prev (nth 3 Info-complete-cache)))
- (eq t (compare-strings string 0 (length prev)
- prev 0 nil t))))
+ (string-prefix-p (nth 3 Info-complete-cache) string) t)
;; We can reuse the previous list.
(setq completions (nth 4 Info-complete-cache))
;; The cache can't be used.
@@ -2706,7 +2738,7 @@ Because of ambiguities, this should be concatenated with something like
(unless (equal Info-current-node orignode)
(Info-goto-node orignode))
;; Update the cache.
- (set (make-local-variable 'Info-complete-cache)
+ (setq Info-complete-cache
(list Info-current-file Info-current-node
Info-complete-next-re string completions
Info-complete-nodes)))
@@ -2737,7 +2769,8 @@ new buffer."
(end-of-line)
(if (re-search-backward (concat "\n\\* +\\("
Info-menu-entry-name-re
- "\\):") beg t)
+ "\\):")
+ beg t)
(setq default (match-string-no-properties 1))))))
(let ((item nil))
(while (null item)
@@ -2747,7 +2780,8 @@ new buffer."
(format "Menu item (default %s): "
default)
"Menu item: ")
- 'Info-complete-menu-item nil t)))
+ #'Info-complete-menu-item nil t nil nil
+ default)))
;; we rely on the fact that completing-read accepts an input
;; of "" even when the require-match argument is true and ""
;; is not a valid possibility
@@ -3347,11 +3381,11 @@ Give an empty topic name to go to the Index node itself."
(car (car Info-index-alternatives))
(nth 2 (car Info-index-alternatives))
(if (cdr Info-index-alternatives)
- (format "(%s total; use `%s' for next)"
- (length Info-index-alternatives)
- (key-description (where-is-internal
- 'Info-index-next overriding-local-map
- t)))
+ (format-message
+ "(%s total; use `%s' for next)"
+ (length Info-index-alternatives)
+ (key-description (where-is-internal
+ 'Info-index-next overriding-local-map t)))
"(Only match)")))
(defun Info-find-index-name (name)
@@ -3364,10 +3398,10 @@ Give an empty topic name to go to the Index node itself."
(re-search-forward (format
"[a-zA-Z]+: [a-zA-Z0-9_ *&]+ %s\\( \\|$\\)"
(regexp-quote name)) nil t)
- (search-forward (format "`%s'" name) nil t)
+ (search-forward (format "['`‘]%s['’]" name) nil t)
(and (string-match "\\`.*\\( (.*)\\)\\'" name)
(search-forward
- (format "`%s'" (substring name 0 (match-beginning 1)))
+ (format "['`‘]%s['’]" (substring name 0 (match-beginning 1)))
nil t))
(search-forward name nil t)
;; Try again without the " <1>" makeinfo can append
@@ -3392,7 +3426,7 @@ MATCHES is a list of index matches found by `Info-index'.")
(defun Info-virtual-index-find-node (filename nodename &optional _no-going-back)
"Index-specific implementation of `Info-find-node-2'."
;; Generate Index-like menu of matches
- (if (string-match "^\\*Index for `\\(.+\\)'\\*$" nodename)
+ (if (string-match "^\\*Index for ‘\\(.+\\)’\\*$" nodename)
;; Generate Index-like menu of matches
(let* ((topic (match-string 1 nodename))
(matches (cdr (assoc (cons (or filename Info-current-file) topic)
@@ -3401,7 +3435,7 @@ MATCHES is a list of index matches found by `Info-index'.")
(or filename Info-current-file) nodename))
(insert "Info Virtual Index\n")
(insert "******************\n\n")
- (insert "Index entries that match `" topic "':\n\n")
+ (insert "Index entries that match ‘" topic "’:\n\n")
(insert "\0\b[index\0\b]\n")
(if (null matches)
(insert "No matches found.\n")
@@ -3420,13 +3454,13 @@ MATCHES is a list of index matches found by `Info-index'.")
(insert "Info Virtual Index\n")
(insert "******************\n\n")
(insert "This is a list of search results produced by\n"
- "`Info-virtual-index' for the current manual.\n\n")
+ "‘Info-virtual-index’ for the current manual.\n\n")
(insert "* Menu:\n\n")
(dolist (nodeinfo nodes)
(when (equal (car (nth 0 nodeinfo)) (or filename Info-current-file))
(insert
(format "* %-20s %s.\n"
- (format "*Index for `%s'*::" (cdr (nth 0 nodeinfo)))
+ (format "*Index for ‘%s’*::" (cdr (nth 0 nodeinfo)))
(cdr (nth 0 nodeinfo)))))))))
(defun Info-virtual-index (topic)
@@ -3461,7 +3495,8 @@ search results."
(setq Info-history-list ohist-list)
(Info-goto-node orignode)
(message "")))
- (Info-find-node Info-current-file (format "*Index for `%s'*" topic))))
+ (Info-find-node Info-current-file
+ (format "*Index for ‘%s’*" topic))))
(add-to-list 'Info-virtual-files
'("\\`\\*Apropos\\*\\'"
@@ -3483,7 +3518,7 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.")
(defun Info-apropos-toc-nodes (filename)
"Apropos-specific implementation of `Info-toc-nodes'."
- (let ((nodes (mapcar 'car (reverse Info-apropos-nodes))))
+ (let ((nodes (mapcar #'car (reverse Info-apropos-nodes))))
`(,filename
("Top" nil nil ,nodes)
,@(mapcar (lambda (node) `(,node "Top" nil nil)) nodes))))
@@ -3501,7 +3536,7 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.")
Info-apropos-file nodename))
(insert "Apropos Index\n")
(insert "*************\n\n")
- (insert "This is a list of search results produced by `info-apropos'.\n\n")
+ (insert "This is a list of search results produced by ‘info-apropos’.\n\n")
(insert "* Menu:\n\n")
(dolist (nodeinfo nodes)
(insert (format "* %-20s %s.\n"
@@ -3515,7 +3550,7 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.")
Info-apropos-file nodename))
(insert "Apropos Index\n")
(insert "*************\n\n")
- (insert "Index entries that match `" (nth 1 nodeinfo) "':\n\n")
+ (insert "Index entries that match ‘" (nth 1 nodeinfo) "’:\n\n")
(insert "\0\b[index\0\b]\n")
(if (eq matches t)
(insert "No matches found.\n")
@@ -3554,9 +3589,9 @@ Return a list of matches where each element is in the format
(goto-char (point-min))
(re-search-forward "\\* Menu: *\n" nil t)
(while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
- ;; add-to-list makes sure we don't have duplicates in `manuals',
+ ;; Make sure we don't have duplicates in `manuals',
;; so that the following dolist loop runs faster.
- (add-to-list 'manuals (match-string 1)))
+ (cl-pushnew (match-string 1) manuals :test #'equal))
(dolist (manual (nreverse manuals))
(message "Searching %s" manual)
(condition-case err
@@ -3600,7 +3635,7 @@ Build a menu of the possible matches."
(setq nodes (cdr nodes)))
(if nodes
(Info-find-node Info-apropos-file (car (car nodes)))
- (setq nodename (format "Index for `%s'" string))
+ (setq nodename (format "Index for ‘%s’" string))
(push (list nodename string (Info-apropos-matches string))
Info-apropos-nodes)
(Info-find-node Info-apropos-file nodename)))))
@@ -3625,6 +3660,18 @@ Build a menu of the possible matches."
(defvar finder-keywords-hash)
(defvar package--builtins) ; finder requires package
+(defun info--prettify-description (desc)
+ (if (stringp desc)
+ (with-temp-buffer
+ (insert (substitute-command-keys desc))
+ (if (equal ?. (char-before))
+ (delete-char -1))
+ (goto-char (point-min))
+ (or (let (case-fold-search) (looking-at-p "\\.\\|[[:upper:]]"))
+ (capitalize-word 1))
+ (buffer-string))
+ desc))
+
(defun Info-finder-find-node (_filename nodename &optional _no-going-back)
"Finder-specific implementation of `Info-find-node-2'."
(require 'finder)
@@ -3643,7 +3690,7 @@ Build a menu of the possible matches."
(insert (format "* %s %s.\n"
(concat (symbol-name keyword) ": "
"Keyword " (symbol-name keyword) ".")
- (cdr assoc))))))
+ (info--prettify-description (cdr assoc)))))))
((equal nodename "Keyword unknown")
;; Display unknown keywords
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
@@ -3671,7 +3718,7 @@ Build a menu of the possible matches."
(when (vectorp desc)
(insert (format "* %-16s %s.\n"
(concat (symbol-name (car package)) "::")
- (aref desc 2)))))))
+ (info--prettify-description (aref desc 2))))))))
((string-match "\\`Keyword " nodename)
(setq nodename (substring nodename (match-end 0)))
;; Display packages that match the keyword
@@ -3681,33 +3728,42 @@ Build a menu of the possible matches."
(insert "Finder Packages\n")
(insert "***************\n\n")
(insert
- "The following packages match the keyword `" nodename "':\n\n")
+ "The following packages match the keyword ‘" nodename "’:\n\n")
(insert "* Menu:\n\n")
(let ((keywords
- (mapcar 'intern (if (string-match-p "," nodename)
+ (mapcar #'intern (if (string-match-p "," nodename)
(split-string nodename ",[ \t\n]*" t)
(list nodename))))
hits desc)
(dolist (keyword keywords)
(push (copy-tree (gethash keyword finder-keywords-hash)) hits))
- (setq hits (delete-dups (apply 'append hits)))
+ (setq hits (delete-dups (apply #'append hits))
+ ;; Not a meaningful package.
+ hits (delete 'emacs hits)
+ hits (sort hits (lambda (a b) (string< (symbol-name a)
+ (symbol-name b)))))
(dolist (package hits)
(setq desc (cdr-safe (assq package package--builtins)))
(when (vectorp desc)
(insert (format "* %-16s %s.\n"
(concat (symbol-name package) "::")
- (aref desc 2)))))))
+ (info--prettify-description (aref desc 2))))))))
(t
;; Display commentary section
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
Info-finder-file nodename))
- (insert "Finder Commentary\n")
- (insert "*****************\n\n")
+ (insert "Package Description\n")
+ (insert "*******************\n\n")
(insert
- "Commentary section of the package `" nodename "':\n\n")
- (let ((str (lm-commentary (find-library-name nodename))))
+ "Description of the package ‘" nodename "’:\n\n")
+ ;; This assumes that a file named package.el exists,
+ ;; which is not always true. E.g. for the nxml package,
+ ;; there is no "nxml.el" (it's nxml-mode.el).
+ ;; 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 any Commentary section\n\n")
+ (insert "Can’t find package description.\n\n")
(insert
(with-temp-buffer
(insert str)
@@ -3732,8 +3788,8 @@ with a list of packages that contain all specified keywords."
(list
(completing-read-multiple
"Keywords (separated by comma): "
- (mapcar 'symbol-name (mapcar 'car (append finder-known-keywords
- (finder-unknown-keywords))))
+ (mapcar #'symbol-name (mapcar #'car (append finder-known-keywords
+ (finder-unknown-keywords))))
nil t))))
(require 'finder)
(if keywords
@@ -3770,7 +3826,7 @@ with a list of packages that contain all specified keywords."
(message (if flag "Type Space to see more"
"Type Space to return to Info"))
(if (not (eq ?\s (setq ch (read-event))))
- (progn (setq unread-command-events (list ch)) nil)
+ (progn (push ch unread-command-events) nil)
flag))
(scroll-up)))
(bury-buffer "*Help*")))
@@ -3782,7 +3838,7 @@ START is a regular expression which will match the
beginning of the tokens delimited string.
ALL is a regular expression with a single
parenthesized subpattern which is the token to be
- returned. E.g. '{\(.*\)}' would return any string
+ returned. E.g. `{(.*)}' would return any string
enclosed in braces around POS.
ERRORSTRING optional fourth argument, controls action on no match:
nil: return nil
@@ -3859,7 +3915,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(let (node)
(cond
((setq node (Info-get-token (point) "[hf]t?tps?://"
- "\\([hf]t?tps?://[^ \t\n\"`({<>})']+\\)"))
+ "\\([hf]t?tps?://[^ \t\n\"`‘({<>})’']+\\)"))
(browse-url node)
(setq node t))
((setq node (Info-get-token (point) "\\*note[ \n\t]+"
@@ -3954,6 +4010,10 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "f" 'Info-follow-reference)
(define-key map "g" 'Info-goto-node)
(define-key map "h" 'Info-help)
+ ;; This is for compatibility with standalone info (>~ version 5.2).
+ ;; Though for some time, standalone info had H and h reversed.
+ ;; See <http://debbugs.gnu.org/16455>.
+ (define-key map "H" 'describe-mode)
(define-key map "i" 'Info-index)
(define-key map "I" 'Info-virtual-index)
(define-key map "l" 'Info-history-back)
@@ -4079,7 +4139,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(defun Info-menu-update ()
"Update the Info menu for the current node."
(condition-case nil
- (if (or (not (eq major-mode 'Info-mode))
+ (if (or (not (derived-mode-p 'Info-mode))
(equal (list Info-current-file Info-current-node)
Info-menu-last-node))
()
@@ -4175,9 +4235,16 @@ With a zero prefix arg, put the name inside a function call to `info'."
st)
"Syntax table used in `Info-mode'.")
+(defface Info-quoted
+ '((t :family "courier"))
+ "Face used for quoted elements.")
+
+(defvar Info-mode-font-lock-keywords
+ '(("‘\\([^’]*\\)’" (1 'Info-quoted))))
+
;; Autoload cookie needed by desktop.el
;;;###autoload
-(define-derived-mode Info-mode nil "Info"
+(define-derived-mode Info-mode nil "Info" ;FIXME: Derive from special-mode?
"Info mode provides commands for browsing through the Info documentation tree.
Documentation in Info is divided into \"nodes\", each of which discusses
one topic and contains references to other nodes which discuss related
@@ -4245,44 +4312,32 @@ Advanced commands:
(add-hook 'activate-menubar-hook 'Info-menu-update nil t)
(setq case-fold-search t)
(setq buffer-read-only t)
- (make-local-variable 'Info-current-file)
- (make-local-variable 'Info-current-subfile)
- (make-local-variable 'Info-current-node)
- (set (make-local-variable 'Info-tag-table-marker) (make-marker))
- (set (make-local-variable 'Info-tag-table-buffer) nil)
- (make-local-variable 'Info-history)
- (make-local-variable 'Info-history-forward)
- (make-local-variable 'Info-index-alternatives)
+ (setq Info-tag-table-marker (make-marker))
(if Info-use-header-line ; do not override global header lines
(setq header-line-format
'(:eval (get-text-property (point-min) 'header-line))))
- (set (make-local-variable 'tool-bar-map) info-tool-bar-map)
+ (setq-local tool-bar-map info-tool-bar-map)
;; This is for the sake of the invisible text we use handling titles.
- (set (make-local-variable 'line-move-ignore-invisible) t)
- (set (make-local-variable 'desktop-save-buffer)
- 'Info-desktop-buffer-misc-data)
- (set (make-local-variable 'widen-automatically) nil)
+ (setq-local line-move-ignore-invisible t)
+ (setq-local desktop-save-buffer 'Info-desktop-buffer-misc-data)
+ (setq-local widen-automatically nil)
(add-hook 'kill-buffer-hook 'Info-kill-buffer nil t)
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
- (set (make-local-variable 'isearch-search-fun-function)
- 'Info-isearch-search)
- (set (make-local-variable 'isearch-wrap-function)
- 'Info-isearch-wrap)
- (set (make-local-variable 'isearch-push-state-function)
- 'Info-isearch-push-state)
- (set (make-local-variable 'isearch-filter-predicate) #'Info-isearch-filter)
- (set (make-local-variable 'revert-buffer-function)
- 'Info-revert-buffer-function)
+ (setq-local isearch-search-fun-function #'Info-isearch-search)
+ (setq-local isearch-wrap-function #'Info-isearch-wrap)
+ (setq-local isearch-push-state-function #'Info-isearch-push-state)
+ (setq-local isearch-filter-predicate #'Info-isearch-filter)
+ (setq-local revert-buffer-function #'Info-revert-buffer-function)
+ (setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t))
(Info-set-mode-line)
- (set (make-local-variable 'bookmark-make-record-function)
- 'Info-bookmark-make-record))
+ (setq-local bookmark-make-record-function #'Info-bookmark-make-record))
;; When an Info buffer is killed, make sure the associated tags buffer
;; is killed too.
(defun Info-kill-buffer ()
- (and (eq major-mode 'Info-mode)
+ (and (derived-mode-p 'Info-mode)
Info-tag-table-buffer
(kill-buffer Info-tag-table-buffer)))
@@ -4299,32 +4354,27 @@ Advanced commands:
(copy-marker (marker-position m)))
(make-marker))))))
-(defvar Info-edit-map (let ((map (make-sparse-keymap)))
- (set-keymap-parent map text-mode-map)
- (define-key map "\C-c\C-c" 'Info-cease-edit)
- map)
+(define-obsolete-variable-alias 'Info-edit-map 'Info-edit-mode-map "24.1")
+(defvar Info-edit-mode-map (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map text-mode-map)
+ (define-key map "\C-c\C-c" 'Info-cease-edit)
+ map)
"Local keymap used within `e' command of Info.")
-(make-obsolete-variable 'Info-edit-map
+(make-obsolete-variable 'Info-edit-mode-map
"editing Info nodes by hand is not recommended."
"24.4")
;; Info-edit mode is suitable only for specially formatted data.
(put 'Info-edit-mode 'mode-class 'special)
-(defun Info-edit-mode ()
+(define-derived-mode Info-edit-mode text-mode "Info Edit"
"Major mode for editing the contents of an Info node.
Like text mode with the addition of `Info-cease-edit'
-which returns to Info mode for browsing.
-\\{Info-edit-map}"
- (use-local-map Info-edit-map)
- (setq major-mode 'Info-edit-mode)
- (setq mode-name "Info Edit")
- (kill-local-variable 'mode-line-buffer-identification)
+which returns to Info mode for browsing."
(setq buffer-read-only nil)
(force-mode-line-update)
- (buffer-enable-undo (current-buffer))
- (run-mode-hooks 'Info-edit-mode-hook))
+ (buffer-enable-undo (current-buffer)))
(make-obsolete 'Info-edit-mode
"editing Info nodes by hand is not recommended." "24.4")
@@ -4334,7 +4384,7 @@ which returns to Info mode for browsing.
(interactive)
(Info-edit-mode)
(message "%s" (substitute-command-keys
- "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info")))
+ "Editing: Type \\<Info-edit-mode-map>\\[Info-cease-edit] to return to info")))
(put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended.
This feature will be removed in future.")
@@ -4349,11 +4399,7 @@ This feature will be removed in future.")
(and (buffer-modified-p)
(y-or-n-p "Save the file? ")
(save-buffer))
- (use-local-map Info-mode-map)
- (setq major-mode 'Info-mode)
- (setq mode-name "Info")
- (Info-set-mode-line)
- (setq buffer-read-only t)
+ (Info-mode)
(force-mode-line-update)
(and (marker-position Info-tag-table-marker)
(buffer-modified-p)
@@ -4466,7 +4512,7 @@ COMMAND must be a symbol or string."
;; Get Info running, and pop to it in another window.
(save-window-excursion
(info))
- (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
+ (or (derived-mode-p 'Info-mode) (pop-to-buffer "*info*"))
;; Bind Info-history to nil, to prevent the last Index node
;; visited by Info-find-emacs-command-nodes from being
;; pushed onto the history.
@@ -4587,7 +4633,9 @@ first line or header line, and for breadcrumb links.")
(and Info-fontify-visited-nodes
;; Don't take time to refontify visited nodes in huge nodes
Info-fontify-maximum-menu-size
- (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
+ (or (eq Info-fontify-maximum-menu-size t)
+ (< (- (point-max) (point-min))
+ Info-fontify-maximum-menu-size))))
rbeg rend)
;; Fontify header line
@@ -4672,28 +4720,28 @@ first line or header line, and for breadcrumb links.")
;; Fontify titles
(goto-char (point-min))
(when (and font-lock-mode not-fontified-p)
- (while (and (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
- nil t)
- ;; Only consider it as an underlined title if the ASCII
- ;; underline has the same size as the text. A typical
- ;; counter example is when a continuation "..." is alone
- ;; on a line.
- (= (string-width (match-string 1))
- (string-width (match-string 2))))
- (let* ((c (preceding-char))
- (face
- (cond ((= c ?*) 'info-title-1)
- ((= c ?=) 'info-title-2)
- ((= c ?-) 'info-title-3)
- (t 'info-title-4))))
- (put-text-property (match-beginning 1) (match-end 1)
- 'font-lock-face face))
- ;; This is a serious problem for trying to handle multiple
- ;; frame types at once. We want this text to be invisible
- ;; on frames that can display the font above.
- (when (memq (framep (selected-frame)) '(x pc w32 ns))
- (add-text-properties (1- (match-beginning 2)) (match-end 2)
- '(invisible t front-sticky nil rear-nonsticky t)))))
+ (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*\\*+\\|==+\\|--+\\|\\.\\.+\\)$"
+ nil t)
+ ;; Only consider it as an underlined title if the ASCII
+ ;; underline has the same size as the text. A typical
+ ;; counter example is when a continuation "..." is alone
+ ;; on a line.
+ (when (= (string-width (match-string 1))
+ (string-width (match-string 2)))
+ (let* ((c (preceding-char))
+ (face
+ (cond ((= c ?*) 'info-title-1)
+ ((= c ?=) 'info-title-2)
+ ((= c ?-) 'info-title-3)
+ (t 'info-title-4))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-face face))
+ ;; This is a serious problem for trying to handle multiple
+ ;; frame types at once. We want this text to be invisible
+ ;; on frames that can display the font above.
+ (when (memq (framep (selected-frame)) '(x pc w32 ns))
+ (add-text-properties (1- (match-beginning 2)) (match-end 2)
+ '(invisible t front-sticky nil rear-nonsticky t))))))
;; Fontify cross references
(goto-char (point-min))
@@ -4714,9 +4762,11 @@ first line or header line, and for breadcrumb links.")
;; an end of sentence
(skip-syntax-backward " ("))
(setq other-tag
- (cond ((save-match-data (looking-back "\\<see"))
+ (cond ((save-match-data (looking-back "\\<see"
+ (- (point) 3)))
"")
- ((save-match-data (looking-back "\\<in"))
+ ((save-match-data (looking-back "\\<in"
+ (- (point) 2)))
"")
((memq (char-before) '(nil ?\. ?! ??))
"See ")
@@ -4844,7 +4894,9 @@ first line or header line, and for breadcrumb links.")
(search-forward "\n* Menu:" nil t)
;; Don't take time to annotate huge menus
Info-fontify-maximum-menu-size
- (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
+ (or (eq Info-fontify-maximum-menu-size t)
+ (< (- (point-max) (point))
+ Info-fontify-maximum-menu-size)))
(let ((n 0)
cont)
(while (re-search-forward
@@ -4948,7 +5000,7 @@ first line or header line, and for breadcrumb links.")
;; Fontify http and ftp references
(goto-char (point-min))
(when not-fontified-p
- (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`({<>})']+"
+ (while (re-search-forward "\\(https?\\|ftp\\)://[^ \t\n\"`‘({<>})’']+"
nil t)
(add-text-properties (match-beginning 0) (match-end 0)
'(font-lock-face info-xref
@@ -5130,7 +5182,7 @@ INDENT is the current indentation depth."
NODESPEC is a string of the form: (file)node."
;; Set up a buffer we can use to fake-out Info.
(with-current-buffer (get-buffer-create " *info-browse-tmp*")
- (if (not (equal major-mode 'Info-mode))
+ (if (not (derived-mode-p 'Info-mode))
(Info-mode))
;; Get the node into this buffer
(if (not (string-match "^(\\([^)]+\\))\\([^.]+\\)$" nodespec))
@@ -5251,13 +5303,15 @@ type returned by `Info-bookmark-make-record', which see."
(defun info-display-manual (manual)
"Display an Info buffer displaying MANUAL.
If there is an existing Info buffer for MANUAL, display it.
-Otherwise, visit the manual in a new Info buffer."
+Otherwise, visit the manual in a new Info buffer. In interactive
+use, a prefix argument directs this command to limit the
+completion alternatives to currently visited manuals."
(interactive
(list
(progn
(info-initialize)
(completing-read "Manual name: "
- (info--manual-names)
+ (info--manual-names current-prefix-arg)
nil t))))
(let ((blist (buffer-list))
(manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)"))
@@ -5276,7 +5330,7 @@ Otherwise, visit the manual in a new Info buffer."
(info (Info-find-file manual)
(generate-new-buffer-name "*info*")))))
-(defun info--manual-names ()
+(defun info--manual-names (visited-only)
(let (names)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
@@ -5287,11 +5341,12 @@ Otherwise, visit the manual in a new Info buffer."
(file-name-nondirectory Info-current-file))
names))))
(delete-dups (append (nreverse names)
- (all-completions
- ""
- (apply-partially 'Info-read-node-name-2
- Info-directory-list
- (mapcar 'car Info-suffix-list)))))))
+ (when (not visited-only)
+ (all-completions
+ ""
+ (apply-partially #'Info-read-node-name-2
+ Info-directory-list
+ (mapcar #'car Info-suffix-list))))))))
(provide 'info)
diff --git a/lisp/informat.el b/lisp/informat.el
index 53b043fbbad..93fec0982d3 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -1,8 +1,8 @@
;;; informat.el --- info support functions package for Emacs
-;; Copyright (C) 1986, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
;; This file is part of GNU Emacs.
diff --git a/lisp/international/.gitignore b/lisp/international/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/international/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/international/README b/lisp/international/README
index 59923b456b9..92fc4a089ec 100644
--- a/lisp/international/README
+++ b/lisp/international/README
@@ -1,51 +1,13 @@
The following files in this directory are derived from the Unicode
-Data File at http://www.unicode.org/Public/UNIDATA/UnicodeData.txt,
-downloaded on 2006-05-23:
+Data File at http://www.unicode.org/Public/UNIDATA/UnicodeData.txt:
charprop.el uni-bidi.el uni-category.el uni-combining.el
uni-comment.el uni-decimal.el uni-decomposition.el uni-digit.el
uni-lowercase.el uni-mirrored.el uni-name.el uni-numeric.el
uni-old-name.el uni-titlecase.el uni-uppercase.el
-These files were generated from UnicodeData.txt using unidata-gen.el,
-which is not included in the Emacs distribution; it can be found in
-the admin/unidata directory of the Emacs source repository at
-https://savannah.gnu.org/projects/emacs/
+These files were generated from the version admin/unidata/UnicodeData.txt
+in the Emacs sources, using the file unidata-gen.el in the same directory.
-The file UnicodeData.txt is used under the terms of the following
-Copyright and Permission Notice:
-
-
-Copyright (C) 1991-2009 Unicode, Inc. All rights reserved. Distributed
-under the Terms of Use in http://www.unicode.org/copyright.html.
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of the Unicode data files and any associated documentation (the
-"Data Files") or Unicode software and any associated documentation
-(the "Software") to deal in the Data Files or Software without
-restriction, including without limitation the rights to use, copy,
-modify, merge, publish, distribute, and/or sell copies of the Data
-Files or Software, and to permit persons to whom the Data Files or
-Software are furnished to do so, provided that (a) the above copyright
-notice(s) and this permission notice appear with all copies of the
-Data Files or Software, (b) both the above copyright notice(s) and
-this permission notice appear in associated documentation, and (c)
-there is clear notice in each modified Data File or in the Software as
-well as in the documentation associated with the Data File(s) or
-Software that the data or software has been modified.
-
-THE DATA FILES AND SOFTWARE ARE PROVIDED "AS IS", WITHOUT WARRANTY OF
-ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
-WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE COPYRIGHT
-HOLDER OR HOLDERS INCLUDED IN THIS NOTICE BE LIABLE FOR ANY CLAIM, OR
-ANY SPECIAL INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES
-WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
-ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
-OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THE DATA FILES OR
-SOFTWARE.
-
-Except as contained in this notice, the name of a copyright holder
-shall not be used in advertising or otherwise to promote the sale, use
-or other dealings in these Data Files or Software without prior
-written authorization of the copyright holder.
+The file UnicodeData.txt is used under the Unicode Terms of Use,
+contained in the file admin/unidata/copyright.html.
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 7b79a1dd1f9..2fcbc884b35 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -1,6 +1,6 @@
-;;; ccl.el --- CCL (Code Conversion Language) compiler
+;;; ccl.el --- CCL (Code Conversion Language) compiler -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -479,8 +479,7 @@ If READ-FLAG is non-nil, this statement has the form
(let ((condition (nth 1 cmd))
(true-cmds (nth 2 cmd))
(false-cmds (nth 3 cmd))
- jump-cond-address
- false-ic)
+ jump-cond-address)
(if (and (listp condition)
(listp (car condition)))
;; If CONDITION is a nested expression, the inner expression
@@ -678,8 +677,7 @@ is a list of CCL-BLOCKs."
(ccl-embed-code 'write-const-jump 0 ccl-loop-head)
(ccl-embed-data arg))
((stringp arg)
- (let ((len (length arg))
- (i 0))
+ (let ((len (length arg)))
(ccl-embed-code 'write-string-jump 0 ccl-loop-head)
(ccl-embed-data len)
(ccl-embed-string len arg)))
@@ -920,8 +918,7 @@ is a list of CCL-BLOCKs."
(error "CCL: Invalid number of arguments: %s" cmd))
(let ((RRR (nth 1 cmd))
(rrr (nth 2 cmd))
- (map (nth 3 cmd))
- id)
+ (map (nth 3 cmd)))
(ccl-check-register rrr cmd)
(ccl-check-register RRR cmd)
(ccl-embed-extended-command 'map-single rrr RRR 0)
@@ -962,12 +959,13 @@ is a list of CCL-BLOCKs."
(defvar ccl-code)
;;;###autoload
-(defun ccl-dump (ccl-code)
- "Disassemble compiled CCL-CODE."
- (let ((len (length ccl-code))
- (buffer-mag (aref ccl-code 0)))
+(defun ccl-dump (code)
+ "Disassemble compiled CCL-code CODE."
+ (let* ((ccl-code code)
+ (len (length ccl-code))
+ (buffer-mag (aref ccl-code 0)))
(cond ((= buffer-mag 0)
- (insert "Don't output anything.\n"))
+ (insert (substitute-command-keys "Don't output anything.\n")))
((= buffer-mag 1)
(insert "Out-buffer must be as large as in-buffer.\n"))
(t
@@ -1005,7 +1003,7 @@ is a list of CCL-BLOCKs."
(defun ccl-dump-set-short-const (rrr cc)
(insert (format "r%d = %d\n" rrr cc)))
-(defun ccl-dump-set-const (rrr ignore)
+(defun ccl-dump-set-const (rrr _ignore)
(insert (format "r%d = %d\n" rrr (ccl-get-next-code))))
(defun ccl-dump-set-array (rrr cc)
@@ -1019,7 +1017,7 @@ is a list of CCL-BLOCKs."
(setq i (1+ i)))
(insert "\n")))
-(defun ccl-dump-jump (ignore cc &optional address)
+(defun ccl-dump-jump (_ignore cc &optional address)
(insert (format "jump to %d(" (+ (or address ccl-current-ic) cc)))
(if (>= cc 0)
(insert "+"))
@@ -1042,13 +1040,13 @@ is a list of CCL-BLOCKs."
(defun ccl-extract-arith-op (cc)
(aref ccl-arith-table (ash cc -6)))
-(defun ccl-dump-write-expr-const (ignore cc)
+(defun ccl-dump-write-expr-const (_ignore cc)
(insert (format "write (r%d %s %d)\n"
(logand cc 7)
(ccl-extract-arith-op cc)
(ccl-get-next-code))))
-(defun ccl-dump-write-expr-register (ignore cc)
+(defun ccl-dump-write-expr-register (_ignore cc)
(insert (format "write (r%d %s r%d)\n"
(logand cc 7)
(ccl-extract-arith-op cc)
@@ -1059,7 +1057,7 @@ is a list of CCL-BLOCKs."
((= cc ?\n) (insert " \"^J\""))
(t (insert (format " \"%c\"" cc)))))
-(defun ccl-dump-write-const-jump (ignore cc)
+(defun ccl-dump-write-const-jump (_ignore cc)
(let ((address ccl-current-ic))
(insert "write char")
(ccl-dump-insert-char (ccl-get-next-code))
@@ -1075,7 +1073,7 @@ is a list of CCL-BLOCKs."
(ccl-get-next-code) ; Skip dummy READ-JUMP
))
-(defun ccl-dump-write-string-jump (ignore cc)
+(defun ccl-dump-write-string-jump (_ignore cc)
(let ((address ccl-current-ic)
(len (ccl-get-next-code))
(i 0))
@@ -1125,9 +1123,9 @@ is a list of CCL-BLOCKs."
(defun ccl-dump-write-register (rrr cc)
(insert (format "write r%d (%d remaining)\n" rrr cc)))
-(defun ccl-dump-call (ignore cc)
+(defun ccl-dump-call (_ignore _cc)
(let ((subroutine (car (ccl-get-next-code))))
- (insert (format "call subroutine `%s'\n" subroutine))))
+ (insert (format-message "call subroutine `%s'\n" subroutine))))
(defun ccl-dump-write-const-string (rrr cc)
(if (= rrr 0)
@@ -1160,7 +1158,7 @@ is a list of CCL-BLOCKs."
(setq i (1+ i)))
(insert "\n")))
-(defun ccl-dump-end (&rest ignore)
+(defun ccl-dump-end (&rest _ignore)
(insert "end\n"))
(defun ccl-dump-set-assign-expr-const (rrr cc)
@@ -1213,9 +1211,10 @@ is a list of CCL-BLOCKs."
(insert (format "read r%d, " rrr))
(ccl-dump-jump-cond-expr-register rrr cc))
-(defun ccl-dump-binary (ccl-code)
- (let ((len (length ccl-code))
- (i 2))
+(defun ccl-dump-binary (code)
+ (let* ((ccl-code code)
+ (len (length ccl-code))
+ (i 2))
(while (< i len)
(let ((code (aref ccl-code i))
(j 27))
@@ -1235,28 +1234,28 @@ is a list of CCL-BLOCKs."
(insert (format "<%s> " ex-op))
(funcall (get ex-op 'ccl-dump-function) rrr RRR Rrr)))
-(defun ccl-dump-read-multibyte-character (rrr RRR Rrr)
+(defun ccl-dump-read-multibyte-character (rrr RRR _Rrr)
(insert (format "read-multibyte-character r%d r%d\n" RRR rrr)))
-(defun ccl-dump-write-multibyte-character (rrr RRR Rrr)
+(defun ccl-dump-write-multibyte-character (rrr RRR _Rrr)
(insert (format "write-multibyte-character r%d r%d\n" RRR rrr)))
(defun ccl-dump-translate-character (rrr RRR Rrr)
(insert (format "translation table(r%d) r%d r%d\n" Rrr RRR rrr)))
-(defun ccl-dump-translate-character-const-tbl (rrr RRR Rrr)
+(defun ccl-dump-translate-character-const-tbl (rrr RRR _Rrr)
(let ((tbl (ccl-get-next-code)))
(insert (format "translation table(%S) r%d r%d\n" tbl RRR rrr))))
-(defun ccl-dump-lookup-int-const-tbl (rrr RRR Rrr)
+(defun ccl-dump-lookup-int-const-tbl (rrr RRR _Rrr)
(let ((tbl (ccl-get-next-code)))
(insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
-(defun ccl-dump-lookup-char-const-tbl (rrr RRR Rrr)
+(defun ccl-dump-lookup-char-const-tbl (rrr RRR _Rrr)
(let ((tbl (ccl-get-next-code)))
(insert (format "hash table(%S) r%d r%d\n" tbl RRR rrr))))
-(defun ccl-dump-iterate-multiple-map (rrr RRR Rrr)
+(defun ccl-dump-iterate-multiple-map (rrr RRR _Rrr)
(let ((notbl (ccl-get-next-code))
(i 0) id)
(insert (format "iterate-multiple-map r%d r%d\n" RRR rrr))
@@ -1267,7 +1266,7 @@ is a list of CCL-BLOCKs."
(setq i (1+ i)))
(insert "]\n")))
-(defun ccl-dump-map-multiple (rrr RRR Rrr)
+(defun ccl-dump-map-multiple (rrr RRR _Rrr)
(let ((notbl (ccl-get-next-code))
(i 0) id)
(insert (format "map-multiple r%d r%d\n" RRR rrr))
@@ -1280,7 +1279,7 @@ is a list of CCL-BLOCKs."
(setq i (1+ i)))
(insert "]\n")))
-(defun ccl-dump-map-single (rrr RRR Rrr)
+(defun ccl-dump-map-single (rrr RRR _Rrr)
(let ((id (ccl-get-next-code)))
(insert (format "map-single r%d r%d map(%S)\n" RRR rrr id))))
@@ -1355,6 +1354,14 @@ IF := (if EXPRESSION CCL_BLOCK_0 CCL_BLOCK_1)
BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...])
;; Execute STATEMENTs until (break) or (end) is executed.
+
+;; Create a block of STATEMENTs for repeating. The STATEMENTs
+;; are executed sequentially until REPEAT or BREAK is executed.
+;; If REPEAT statement is executed, STATEMENTs are executed from the
+;; start again. If BREAK statements is executed, the execution
+;; exits from the block. If neither REPEAT nor BREAK is
+;; executed, the execution exits from the block after executing the
+;; last STATEMENT.
LOOP := (loop STATEMENT [STATEMENT ...])
;; Terminate the most inner loop.
@@ -1501,17 +1508,42 @@ ARRAY := `[' integer ... `]'
TRANSLATE :=
- (translate-character REG(table) REG(charset) REG(codepoint))
- | (translate-character SYMBOL REG(charset) REG(codepoint))
- ;; SYMBOL must refer to a table defined by `define-translation-table'.
+ ;; Decode character SRC, translate it by translate table
+ ;; TABLE, and encode it back to DST. TABLE is specified
+ ;; by its id number in REG_0, SRC is specified by its
+ ;; charset id number and codepoint in REG_1 and REG_2
+ ;; respectively.
+ ;; On encoding, the charset of highest priority is selected.
+ ;; After the execution, DST is specified by its charset
+ ;; id number and codepoint in REG_1 and REG_2 respectively.
+ (translate-character REG_0 REG_1 REG_2)
+
+ ;; Same as above except for SYMBOL specifying the name of
+ ;; the translate table defined by `define-translation-table'.
+ | (translate-character SYMBOL REG_1 REG_2)
+
LOOKUP :=
- (lookup-character SYMBOL REG(charset) REG(codepoint))
+ ;; Look up character SRC in hash table TABLE. TABLE is
+ ;; specified by its name in SYMBOL, and SRC is specified by
+ ;; its charset id number and codepoint in REG_1 and REG_2
+ ;; respectively.
+ ;; If its associated value is an integer, set REG_1 to that
+ ;; value, and set r7 to 1. Otherwise, set r7 to 0.
+ (lookup-character SYMBOL REG_1 REG_2)
+
+ ;; Look up integer value N in hash table TABLE. TABLE is
+ ;; specified by its name in SYMBOL and N is specified in
+ ;; REG.
+ ;; If its associated value is a character, set REG to that
+ ;; value, and set r7 to 1. Otherwise, set r7 to 0.
| (lookup-integer SYMBOL REG(integer))
- ;; SYMBOL refers to a table defined by `define-translation-hash-table'.
+
MAP :=
- (iterate-multiple-map REG REG MAP-IDs)
- | (map-multiple REG REG (MAP-SET))
- | (map-single REG REG MAP-ID)
+ ;; The following statements are for internal use only.
+ (iterate-multiple-map REG REG MAP-IDs)
+ | (map-multiple REG REG (MAP-SET))
+ | (map-single REG REG MAP-ID)
+
MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index ce6256c1e47..e4f7e7c3f3b 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1,6 +1,6 @@
;;; characters.el --- set syntax and category for multibyte characters
-;; Copyright (C) 1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -484,13 +484,24 @@ with L, LRE, or LRO Unicode bidi character type.")
;; Bidi categories
-(map-char-table (lambda (key val)
- (cond
- ((memq val '(R AL RLO RLE))
- (modify-category-entry key ?R))
- ((memq val '(L LRE LRO))
- (modify-category-entry key ?L))))
- (unicode-property-table-internal 'bidi-class))
+;; If bootstrapping without generated uni-*.el files, table not defined.
+(let ((table (unicode-property-table-internal 'bidi-class)))
+ (when table
+ (map-char-table (lambda (key val)
+ (cond
+ ((memq val '(R AL RLO RLE))
+ (modify-category-entry key ?R))
+ ((memq val '(L LRE LRO))
+ (modify-category-entry key ?L))))
+ table)))
+
+;; Load uni-mirrored.el and uni-brackets.el if available, so that they
+;; get dumped into Emacs. This allows to start Emacs with
+;; force-load-messages in ~/.emacs, and avoid infinite recursion in
+;; bidi_initialize, which needs to load uni-mirrored.el and
+;; uni-brackets.el in order to display the "Loading" messages.
+(unicode-property-table-internal 'mirroring)
+(unicode-property-table-internal 'bracket-type)
;; Latin
@@ -638,6 +649,68 @@ with L, LRE, or LRO Unicode bidi character type.")
(set-case-syntax-pair c (1+ c) tbl))
(setq c (1+ c)))
+ ;; Latin Extended-C
+ (setq c #x2C60)
+ (while (<= c #x2C7F)
+ (modify-category-entry c ?l)
+ (setq c (1+ c)))
+
+ (let ((pair-ranges '((#x2C60 . #x2C61)
+ (#x2C67 . #x2C6C)
+ (#x2C72 . #x2C73)
+ (#x2C75 . #x2C76))))
+ (dolist (elt pair-ranges)
+ (let ((from (car elt)) (to (cdr elt)))
+ (while (< from to)
+ (set-case-syntax-pair from (1+ from) tbl)
+ (setq from (+ from 2))))))
+
+ (set-case-syntax-pair ?Ɫ ?ɫ tbl)
+ (set-case-syntax-pair ?Ᵽ ?ᵽ tbl)
+ (set-case-syntax-pair ?Ɽ ?ɽ tbl)
+ (set-case-syntax-pair ?Ɑ ?ɑ tbl)
+ (set-case-syntax-pair ?Ɱ ?ɱ tbl)
+ (set-case-syntax-pair ?Ɐ ?ɐ tbl)
+ (set-case-syntax-pair ?Ɒ ?ɒ tbl)
+ (set-case-syntax-pair ?Ȿ ?ȿ tbl)
+ (set-case-syntax-pair ?Ɀ ?ɀ tbl)
+
+ ;; Latin Extended-D
+ (setq c #xA720)
+ (while (<= c #xA7FF)
+ (modify-category-entry c ?l)
+ (setq c (1+ c)))
+
+ (let ((pair-ranges '((#xA722 . #xA72F)
+ (#xA732 . #xA76F)
+ (#xA779 . #xA77C)
+ (#xA77E . #xA787)
+ (#xA78B . #xA78E)
+ (#xA790 . #xA793)
+ (#xA796 . #xA7A9)
+ (#xA7B4 . #xA7B7))))
+ (dolist (elt pair-ranges)
+ (let ((from (car elt)) (to (cdr elt)))
+ (while (< from to)
+ (set-case-syntax-pair from (1+ from) tbl)
+ (setq from (+ from 2))))))
+
+ (set-case-syntax-pair ?Ᵹ ?ᵹ tbl)
+ (set-case-syntax-pair ?Ɦ ?ɦ tbl)
+ (set-case-syntax-pair ?Ɜ ?ɜ tbl)
+ (set-case-syntax-pair ?Ɡ ?ɡ tbl)
+ (set-case-syntax-pair ?Ɬ ?ɬ tbl)
+ (set-case-syntax-pair ?Ʞ ?ʞ tbl)
+ (set-case-syntax-pair ?Ʇ ?ʇ tbl)
+ (set-case-syntax-pair ?Ʝ ?ʝ tbl)
+ (set-case-syntax-pair ?Ꭓ ?ꭓ tbl)
+
+ ;; Latin Extended-E
+ (setq c #xAB30)
+ (while (<= c #xAB64)
+ (modify-category-entry c ?l)
+ (setq c (1+ c)))
+
;; Greek
(modify-category-entry '(#x0370 . #x03ff) ?g)
(setq c #x0370)
@@ -713,14 +786,29 @@ with L, LRE, or LRO Unicode bidi character type.")
(and (zerop (% c 2))
(or (and (>= c #x0460) (<= c #x0480))
(and (>= c #x048c) (<= c #x04be))
- (and (>= c #x04d0) (<= c #x04f4)))
+ (and (>= c #x04d0) (<= c #x052e)))
(set-case-syntax-pair c (1+ c) tbl))
(setq c (1+ c)))
(set-case-syntax-pair ?Ӂ ?ӂ tbl)
(set-case-syntax-pair ?Ӄ ?ӄ tbl)
(set-case-syntax-pair ?Ӈ ?ӈ tbl)
(set-case-syntax-pair ?Ӌ ?ӌ tbl)
- (set-case-syntax-pair ?Ӹ ?ӹ tbl)
+
+ (modify-category-entry '(#xA640 . #xA69F) ?y)
+ (setq c #xA640)
+ (while (<= c #xA66C)
+ (set-case-syntax-pair c (+ c 1) tbl)
+ (setq c (+ c 2)))
+ (setq c #xA680)
+ (while (<= c #xA69A)
+ (set-case-syntax-pair c (+ c 1) tbl)
+ (setq c (+ c 2)))
+
+ ;; Georgian
+ (setq c #x10A0)
+ (while (<= c #x10CD)
+ (set-case-syntax-pair c (+ c #x1C60) tbl)
+ (setq c (1+ c)))
;; general punctuation
(setq c #x2000)
@@ -781,6 +869,26 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry (+ c 26) ?l)
(setq c (1+ c)))
+ ;; Glagolitic
+ (setq c #x2C00)
+ (while (<= c #x2C2E)
+ (set-case-syntax-pair c (+ c 48) tbl)
+ (setq c (1+ c)))
+
+ ;; Coptic
+ (let ((pair-ranges '((#x2C80 . #x2CE2)
+ (#x2CEB . #x2CF2))))
+ (dolist (elt pair-ranges)
+ (let ((from (car elt)) (to (cdr elt)))
+ (while (< from to)
+ (set-case-syntax-pair from (1+ from) tbl)
+ (setq from (+ from 2))))))
+ ;; There's no Coptic category. However, Coptic letters that are
+ ;; part of the Greek block above get the Greek category, and those
+ ;; in this block are derived from Greek letters, so let's be
+ ;; consistent about their category.
+ (modify-category-entry '(#x2C80 . #x2CFF) ?g)
+
;; Fullwidth Latin
(setq c #xff21)
(while (<= c #xff3a)
@@ -789,10 +897,28 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry (+ c #x20) ?l)
(setq c (1+ c)))
+ ;; Deseret
+ (setq c #x10400)
+ (while (<= c #x10427)
+ (set-case-syntax-pair c (+ c 28) tbl)
+ (setq c (1+ c)))
+
+ ;; Old Hungarian
+ (setq c #x10c80)
+ (while (<= c #x10cb2)
+ (set-case-syntax-pair c (+ c #x40) tbl)
+ (setq c (1+ c)))
+
+ ;; Warang Citi
+ (setq c #x118a0)
+ (while (<= c #x118bf)
+ (set-case-syntax-pair c (+ c #x20) tbl)
+ (setq c (1+ c)))
+
;; Combining diacritics
(modify-category-entry '(#x300 . #x362) ?^)
;; Combining marks
- (modify-category-entry '(#x20d0 . #x20e3) ?^)
+ (modify-category-entry '(#x20d0 . #x20ff) ?^)
;; Fixme: syntax for symbols &c
)
@@ -1091,7 +1217,7 @@ with L, LRE, or LRO Unicode bidi character type.")
;; (LOCALE TABLE (CHARSET (FROM-CODE . TO-CODE) ...) ...)
;; LOCALE: locale symbol
;; TABLE: char-table used for char-width-table, initially nil.
-;; CAHRSET: character set
+;; CHARSET: character set
;; FROM-CODE, TO-CODE: range of code-points in CHARSET
(defvar cjk-char-width-table-list
@@ -1138,191 +1264,11 @@ Setup char-width-table appropriate for non-CJK language environment."
;; Setting char-script-table.
-
-;; The data is compiled from Blocks.txt and Scripts.txt in the
-;; "Unicode Character Database", simplified to lump together all the
-;; blocks belonging to the same language. E.g., "Basic Latin",
-;; "Latin-1 Supplement", "Latin Extended-A", etc. are all lumped
-;; together under "latin".
-;;
-;; The Unicode blocks actually extend past some of these ranges with
-;; undefined codepoints.
-(let ((script-list nil))
- (dolist
- (elt
- '((#x0000 #x007F latin)
- (#x00A0 #x024F latin)
- (#x0250 #x02AF phonetic)
- (#x02B0 #x036F latin)
- (#x0370 #x03E1 greek)
- (#x03E2 #x03EF coptic)
- (#x03F0 #x03F3 greek)
- (#x0400 #x052F cyrillic)
- (#x0530 #x058F armenian)
- (#x0590 #x05FF hebrew)
- (#x0600 #x06FF arabic)
- (#x0700 #x074F syriac)
- (#x0750 #x077F arabic)
- (#x0780 #x07BF thaana)
- (#x07C0 #x07FF nko)
- (#x0800 #x083F samaritan)
- (#x0840 #x085F mandaic)
- (#x08A0 #x08FF arabic)
- (#x0900 #x097F devanagari)
- (#x0980 #x09FF bengali)
- (#x0A00 #x0A7F gurmukhi)
- (#x0A80 #x0AFF gujarati)
- (#x0B00 #x0B7F oriya)
- (#x0B80 #x0BFF tamil)
- (#x0C00 #x0C7F telugu)
- (#x0C80 #x0CFF kannada)
- (#x0D00 #x0D7F malayalam)
- (#x0D80 #x0DFF sinhala)
- (#x0E00 #x0E7F thai)
- (#x0E80 #x0EFF lao)
- (#x0F00 #x0FFF tibetan)
- (#x1000 #x109F burmese) ; according to Unicode 6.1, should be "myanmar"
- (#x10A0 #x10FF georgian)
- (#x1100 #x11FF hangul)
- (#x1200 #x139F ethiopic)
- (#x13A0 #x13FF cherokee)
- (#x1400 #x167F canadian-aboriginal)
- (#x1680 #x169F ogham)
- (#x16A0 #x16FF runic)
- (#x1700 #x171F tagalog)
- (#x1720 #x173F hanunoo)
- (#x1740 #x175F buhid)
- (#x1760 #x177F tagbanwa)
- (#x1780 #x17FF khmer)
- (#x1800 #x18AF mongolian)
- (#x18B0 #x18FF canadian-aboriginal)
- (#x1900 #x194F limbu)
- (#x1950 #x197F tai-le)
- (#x1980 #x19DF tai-lue)
- (#x19E0 #x19FF khmer)
- (#x1A00 #x1A00 buginese)
- (#x1A20 #x1AAF tai-tham)
- (#x1B00 #x1B7F balinese)
- (#x1B80 #x1BBF sundanese)
- (#x1BC0 #x1BFF batak)
- (#x1C00 #x1C4F lepcha)
- (#x1C50 #x1C7F ol-chiki)
- (#x1CC0 #x1CCF sundanese)
- (#x1CD0 #x1CFF vedic)
- (#x1D00 #x1DBF phonetic)
- (#x1DC0 #x1EFF latin)
- (#x1F00 #x1FFF greek)
- (#x2000 #x27FF symbol)
- (#x2800 #x28FF braille)
- (#x2900 #x2BFF symbol)
- (#x2C00 #x2C5F glagolitic)
- (#x2C60 #x2C7F latin)
- (#x2C80 #x2CFF coptic)
- (#x2D00 #x2D2F georgian)
- (#x2D30 #x2D7F tifinagh)
- (#x2D80 #x2DDF ethiopic)
- (#x2DE0 #x2DFF cyrillic)
- (#x2E00 #x2E7F symbol)
- (#x2E80 #x2FDF han)
- (#x2FF0 #x2FFF ideographic-description)
- (#x3000 #x303F cjk-misc)
- (#x3040 #x30FF kana)
- (#x3100 #x312F bopomofo)
- (#x3130 #x318F hangul)
- (#x3190 #x319F kanbun)
- (#x31A0 #x31BF bopomofo)
- (#x31C0 #x31EF cjk-misc)
- (#x31F0 #x31FF kana)
- (#x3200 #x9FAF han)
- (#xA000 #xA4CF yi)
- (#xA4D0 #xA4FF lisu)
- (#xA500 #xA63F vai)
- (#xA640 #xA69F cyrillic)
- (#xA6A0 #xA6FF bamum)
- (#xA700 #xA7FF latin)
- (#xA800 #xA82F syloti-nagri)
- (#xA830 #xA83F north-indic-number)
- (#xA840 #xA87F phags-pa)
- (#xA880 #xA8DF saurashtra)
- (#xA8E0 #xA8FF devanagari)
- (#xA900 #xA92F kayah-li)
- (#xA930 #xA95F rejang)
- (#xA960 #xA97F hangul)
- (#xA980 #xA9DF javanese)
- (#xAA00 #xAA5F cham)
- (#xAA60 #xAA7B burmese) ; Unicode 6.1: "myanmar"
- (#xAA80 #xAADF tai-viet)
- (#xAAE0 #xAAFF meetei-mayek)
- (#xAB00 #xAB2F ethiopic)
- (#xABC0 #xABFF meetei-mayek)
- (#xAC00 #xD7FF hangul)
- (#xF900 #xFAFF han)
- (#xFB1D #xFB4F hebrew)
- (#xFB50 #xFDFF arabic)
- (#xFE30 #xFE4F han)
- (#xFE70 #xFEFF arabic)
- (#xFF00 #xFF5F cjk-misc)
- (#xFF61 #xFF9F kana)
- (#xFFE0 #xFFE6 cjk-misc)
- (#x10000 #x100FF linear-b)
- (#x10100 #x1013F aegean-number)
- (#x10140 #x1018F ancient-greek-number)
- (#x10190 #x101CF ancient-symbol)
- (#x101D0 #x101FF phaistos-disc)
- (#x10280 #x1029F lycian)
- (#x102A0 #x102DF carian)
- (#x10300 #x1032F olt-italic)
- (#x10330 #x1034F gothic)
- (#x10380 #x1039F ugaritic)
- (#x103A0 #x103DF old-persian)
- (#x10400 #x1044F deseret)
- (#x10450 #x1047F shavian)
- (#x10480 #x104AF osmanya)
- (#x10800 #x1083F cypriot-syllabary)
- (#x10840 #x1085F aramaic)
- (#x10900 #x1091F phoenician)
- (#x10920 #x1093F lydian)
- (#x10980 #x109FF meroitic)
- (#x10A00 #x10A5F kharoshthi)
- (#x10A60 #x10A7F old-south-arabian)
- (#x10B00 #x10B3F avestan)
- (#x10B40 #x10B5F inscriptional-parthian)
- (#x10B60 #x10B7F inscriptional-pahlavi)
- (#x10C00 #x10C4F old-turkic)
- (#x10E60 #x10E7F rumi-number)
- (#x11000 #x1107F brahmi)
- (#x11080 #x110CF kaithi)
- (#x110D0 #x110FF sora-sompeng)
- (#x11100 #x1114F chakma)
- (#x11180 #x111DF sharada)
- (#x11680 #x116CF takri)
- (#x12000 #x123FF cuneiform)
- (#x12400 #x1247F cuneiform-numbers-and-punctuation)
- (#x13000 #x1342F egyptian)
- (#x16800 #x16A3F bamum)
- (#x16F00 #x16F9F miao)
- (#x1B000 #x1B0FF kana)
- (#x1D000 #x1D0FF byzantine-musical-symbol)
- (#x1D100 #x1D1FF musical-symbol)
- (#x1D200 #x1D24F ancient-greek-musical-notation)
- (#x1D300 #x1D35F tai-xuan-jing-symbol)
- (#x1D360 #x1D37F counting-rod-numeral)
- (#x1D400 #x1D7FF mathematical)
- (#x1EE00 #x1EEFF arabic)
- (#x1F000 #x1F02F mahjong-tile)
- (#x1F030 #x1F09F domino-tile)
- (#x1F0A0 #x1F0FF playing-cards)
- (#x1F100 #x1F1FF symbol)
- (#x1F200 #x1F2FF han)
- (#x1F300 #x1F64F symbol)
- (#x1F680 #x1F77F symbol)
- (#x20000 #x2B81F han)
- (#x2F800 #x2FFFF han)))
- (set-char-table-range char-script-table
- (cons (car elt) (nth 1 elt)) (nth 2 elt))
- (or (memq (nth 2 elt) script-list)
- (setq script-list (cons (nth 2 elt) script-list))))
- (set-char-table-extra-slot char-script-table 0 (nreverse script-list)))
+(if purify-flag
+ ;; While dumping, we can't use require, and international is not
+ ;; in load-path.
+ (load "international/charscript")
+ (require 'charscript))
(map-charset-chars
#'(lambda (range _ignore)
@@ -1332,15 +1278,17 @@ Setup char-width-table appropriate for non-CJK language environment."
;;; Setting unicode-category-table.
-(setq unicode-category-table
- (unicode-property-table-internal 'general-category))
-(map-char-table #'(lambda (key val)
- (if (and val
- (or (and (/= (aref (symbol-name val) 0) ?M)
- (/= (aref (symbol-name val) 0) ?C))
- (eq val 'Zs)))
- (modify-category-entry key ?.)))
- unicode-category-table)
+(when (setq unicode-category-table
+ (unicode-property-table-internal 'general-category))
+ (map-char-table #'(lambda (key val)
+ (if val
+ (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
+ (/= (aref (symbol-name val) 0) ?C))
+ (eq val 'Zs))
+ (modify-category-entry key ?.))
+ ((eq val 'Mn)
+ (modify-category-entry key ?^)))))
+ unicode-category-table))
(optimize-char-table (standard-category-table))
@@ -1426,23 +1374,24 @@ This function updates the char-table `glyphless-char-display'."
(glyphless-set-char-table-range glyphless-char-display
#x80 #x9F method))
((eq target 'format-control)
- (map-char-table
- #'(lambda (char category)
- (if (eq category 'Cf)
- (let ((this-method method)
- from to)
- (if (consp char)
- (setq from (car char) to (cdr char))
- (setq from char to char))
- (while (<= from to)
- (when (/= from #xAD)
- (if (eq method 'acronym)
- (setq this-method
- (aref char-acronym-table from)))
- (set-char-table-range glyphless-char-display
- from this-method))
- (setq from (1+ from))))))
- unicode-category-table))
+ (when unicode-category-table
+ (map-char-table
+ #'(lambda (char category)
+ (if (eq category 'Cf)
+ (let ((this-method method)
+ from to)
+ (if (consp char)
+ (setq from (car char) to (cdr char))
+ (setq from char to char))
+ (while (<= from to)
+ (when (/= from #xAD)
+ (if (eq method 'acronym)
+ (setq this-method
+ (aref char-acronym-table from)))
+ (set-char-table-range glyphless-char-display
+ from this-method))
+ (setq from (1+ from))))))
+ unicode-category-table)))
((eq target 'no-font)
(set-char-table-extra-slot glyphless-char-display 0 method))
(t
@@ -1485,7 +1434,12 @@ METHOD must be one of these symbols:
`empty-box': display an empty box.
`acronym': display an acronym of the character in a box. The
acronym is taken from `char-acronym-table', which see.
- `hex-code': display the hexadecimal character code in a box."
+ `hex-code': display the hexadecimal character code in a box.
+
+Do not set its value directly from Lisp; the value takes effect
+only via a custom `:set'
+function (`update-glyphless-char-display'), which updates
+`glyphless-char-display'."
:version "24.1"
:type '(alist :key-type (symbol :tag "Character Group")
:value-type (symbol :tag "Display Method"))
diff --git a/lisp/international/charprop.el b/lisp/international/charprop.el
deleted file mode 100644
index 50226b1b773..00000000000
--- a/lisp/international/charprop.el
+++ /dev/null
@@ -1,87 +0,0 @@
-;; Automatically generated by unidata-gen.el.
-;; FILE: uni-name.el
-(define-char-code-property 'name "uni-name.el"
- "Unicode character name.
-Property value is a string or nil.
-The value nil stands for the default value \"null string\").")
-;; FILE: uni-category.el
-(define-char-code-property 'general-category "uni-category.el"
- "Unicode general category.
-Property value is one of the following symbols:
- Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
- Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn")
-;; FILE: uni-combining.el
-(define-char-code-property 'canonical-combining-class "uni-combining.el"
- "Unicode canonical combining class.
-Property value is an integer.")
-;; FILE: uni-bidi.el
-(define-char-code-property 'bidi-class "uni-bidi.el"
- "Unicode bidi class.
-Property value is one of the following symbols:
- L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET,
- AN, CS, NSM, BN, B, S, WS, ON")
-;; FILE: uni-decomposition.el
-(define-char-code-property 'decomposition "uni-decomposition.el"
- "Unicode decomposition mapping.
-Property value is a list of characters. The first element may be
-one of these symbols representing compatibility formatting tag:
- font, noBreak, initial, medial, final, isolated, circle, super,
- sub, vertical, wide, narrow, small, square, fraction, compat")
-;; FILE: uni-decimal.el
-(define-char-code-property 'decimal-digit-value "uni-decimal.el"
- "Unicode numeric value (decimal digit).
-Property value is an integer 0..9, or nil.
-The value nil stands for NaN \"Numeric_Value\".")
-;; FILE: uni-digit.el
-(define-char-code-property 'digit-value "uni-digit.el"
- "Unicode numeric value (digit).
-Property value is an integer 0..9, or nil.
-The value nil stands for NaN \"Numeric_Value\".")
-;; FILE: uni-numeric.el
-(define-char-code-property 'numeric-value "uni-numeric.el"
- "Unicode numeric value (numeric).
-Property value is an integer, a floating point, or nil.
-The value nil stands for NaN \"Numeric_Value\".")
-;; FILE: uni-mirrored.el
-(define-char-code-property 'mirrored "uni-mirrored.el"
- "Unicode bidi mirrored flag.
-Property value is a symbol `Y' or `N'. See also the property `mirroring'.")
-;; FILE: uni-old-name.el
-(define-char-code-property 'old-name "uni-old-name.el"
- "Unicode old names as published in Unicode 1.0.
-Property value is a string or nil.
-The value nil stands for the default value \"null string\").")
-;; FILE: uni-comment.el
-(define-char-code-property 'iso-10646-comment "uni-comment.el"
- "Unicode ISO 10646 comment.
-Property value is a string.")
-;; FILE: uni-uppercase.el
-(define-char-code-property 'uppercase "uni-uppercase.el"
- "Unicode simple uppercase mapping.
-Property value is a character or nil.
-The value nil means that the actual property value of a character
-is the character itself.")
-;; FILE: uni-lowercase.el
-(define-char-code-property 'lowercase "uni-lowercase.el"
- "Unicode simple lowercase mapping.
-Property value is a character or nil.
-The value nil means that the actual property value of a character
-is the character itself.")
-;; FILE: uni-titlecase.el
-(define-char-code-property 'titlecase "uni-titlecase.el"
- "Unicode simple titlecase mapping.
-Property value is a character or nil.
-The value nil means that the actual property value of a character
-is the character itself.")
-;; FILE: uni-mirrored.el
-(define-char-code-property 'mirroring "uni-mirrored.el"
- "Unicode bidi-mirroring characters.
-Property value is a character that has the corresponding mirroring image or nil.
-The value nil means that the actual property value of a character
-is the character itself.")
-;; Local Variables:
-;; coding: utf-8
-;; no-byte-compile: t
-;; End:
-
-;; charprop.el ends here
diff --git a/lisp/international/cp51932.el b/lisp/international/cp51932.el
deleted file mode 100644
index a6489268578..00000000000
--- a/lisp/international/cp51932.el
+++ /dev/null
@@ -1,470 +0,0 @@
-;;; cp51932.el -- translation table for CP51932. -*- no-byte-compile: t -*-
-;;; Automatically generated from CP932-2BYTE.map
-(let ((map
- '(;JISEXT<->UNICODE
- (#x2D21 . #x2460)
- (#x2D22 . #x2461)
- (#x2D23 . #x2462)
- (#x2D24 . #x2463)
- (#x2D25 . #x2464)
- (#x2D26 . #x2465)
- (#x2D27 . #x2466)
- (#x2D28 . #x2467)
- (#x2D29 . #x2468)
- (#x2D2A . #x2469)
- (#x2D2B . #x246A)
- (#x2D2C . #x246B)
- (#x2D2D . #x246C)
- (#x2D2E . #x246D)
- (#x2D2F . #x246E)
- (#x2D30 . #x246F)
- (#x2D31 . #x2470)
- (#x2D32 . #x2471)
- (#x2D33 . #x2472)
- (#x2D34 . #x2473)
- (#x2D35 . #x2160)
- (#x2D36 . #x2161)
- (#x2D37 . #x2162)
- (#x2D38 . #x2163)
- (#x2D39 . #x2164)
- (#x2D3A . #x2165)
- (#x2D3B . #x2166)
- (#x2D3C . #x2167)
- (#x2D3D . #x2168)
- (#x2D3E . #x2169)
- (#x2D40 . #x3349)
- (#x2D41 . #x3314)
- (#x2D42 . #x3322)
- (#x2D43 . #x334D)
- (#x2D44 . #x3318)
- (#x2D45 . #x3327)
- (#x2D46 . #x3303)
- (#x2D47 . #x3336)
- (#x2D48 . #x3351)
- (#x2D49 . #x3357)
- (#x2D4A . #x330D)
- (#x2D4B . #x3326)
- (#x2D4C . #x3323)
- (#x2D4D . #x332B)
- (#x2D4E . #x334A)
- (#x2D4F . #x333B)
- (#x2D50 . #x339C)
- (#x2D51 . #x339D)
- (#x2D52 . #x339E)
- (#x2D53 . #x338E)
- (#x2D54 . #x338F)
- (#x2D55 . #x33C4)
- (#x2D56 . #x33A1)
- (#x2D5F . #x337B)
- (#x2D60 . #x301D)
- (#x2D61 . #x301F)
- (#x2D62 . #x2116)
- (#x2D63 . #x33CD)
- (#x2D64 . #x2121)
- (#x2D65 . #x32A4)
- (#x2D66 . #x32A5)
- (#x2D67 . #x32A6)
- (#x2D68 . #x32A7)
- (#x2D69 . #x32A8)
- (#x2D6A . #x3231)
- (#x2D6B . #x3232)
- (#x2D6C . #x3239)
- (#x2D6D . #x337E)
- (#x2D6E . #x337D)
- (#x2D6F . #x337C)
- (#x2D70 . #x2252)
- (#x2D71 . #x2261)
- (#x2D72 . #x222B)
- (#x2D73 . #x222E)
- (#x2D74 . #x2211)
- (#x2D75 . #x221A)
- (#x2D76 . #x22A5)
- (#x2D77 . #x2220)
- (#x2D78 . #x221F)
- (#x2D79 . #x22BF)
- (#x2D7A . #x2235)
- (#x2D7B . #x2229)
- (#x2D7C . #x222A)
- (#x7921 . #x7E8A)
- (#x7922 . #x891C)
- (#x7923 . #x9348)
- (#x7924 . #x9288)
- (#x7925 . #x84DC)
- (#x7926 . #x4FC9)
- (#x7927 . #x70BB)
- (#x7928 . #x6631)
- (#x7929 . #x68C8)
- (#x792A . #x92F9)
- (#x792B . #x66FB)
- (#x792C . #x5F45)
- (#x792D . #x4E28)
- (#x792E . #x4EE1)
- (#x792F . #x4EFC)
- (#x7930 . #x4F00)
- (#x7931 . #x4F03)
- (#x7932 . #x4F39)
- (#x7933 . #x4F56)
- (#x7934 . #x4F92)
- (#x7935 . #x4F8A)
- (#x7936 . #x4F9A)
- (#x7937 . #x4F94)
- (#x7938 . #x4FCD)
- (#x7939 . #x5040)
- (#x793A . #x5022)
- (#x793B . #x4FFF)
- (#x793C . #x501E)
- (#x793D . #x5046)
- (#x793E . #x5070)
- (#x793F . #x5042)
- (#x7940 . #x5094)
- (#x7941 . #x50F4)
- (#x7942 . #x50D8)
- (#x7943 . #x514A)
- (#x7944 . #x5164)
- (#x7945 . #x519D)
- (#x7946 . #x51BE)
- (#x7947 . #x51EC)
- (#x7948 . #x5215)
- (#x7949 . #x529C)
- (#x794A . #x52A6)
- (#x794B . #x52C0)
- (#x794C . #x52DB)
- (#x794D . #x5300)
- (#x794E . #x5307)
- (#x794F . #x5324)
- (#x7950 . #x5372)
- (#x7951 . #x5393)
- (#x7952 . #x53B2)
- (#x7953 . #x53DD)
- (#x7954 . #xFA0E)
- (#x7955 . #x549C)
- (#x7956 . #x548A)
- (#x7957 . #x54A9)
- (#x7958 . #x54FF)
- (#x7959 . #x5586)
- (#x795A . #x5759)
- (#x795B . #x5765)
- (#x795C . #x57AC)
- (#x795D . #x57C8)
- (#x795E . #x57C7)
- (#x795F . #xFA0F)
- (#x7960 . #xFA10)
- (#x7961 . #x589E)
- (#x7962 . #x58B2)
- (#x7963 . #x590B)
- (#x7964 . #x5953)
- (#x7965 . #x595B)
- (#x7966 . #x595D)
- (#x7967 . #x5963)
- (#x7968 . #x59A4)
- (#x7969 . #x59BA)
- (#x796A . #x5B56)
- (#x796B . #x5BC0)
- (#x796C . #x752F)
- (#x796D . #x5BD8)
- (#x796E . #x5BEC)
- (#x796F . #x5C1E)
- (#x7970 . #x5CA6)
- (#x7971 . #x5CBA)
- (#x7972 . #x5CF5)
- (#x7973 . #x5D27)
- (#x7974 . #x5D53)
- (#x7975 . #xFA11)
- (#x7976 . #x5D42)
- (#x7977 . #x5D6D)
- (#x7978 . #x5DB8)
- (#x7979 . #x5DB9)
- (#x797A . #x5DD0)
- (#x797B . #x5F21)
- (#x797C . #x5F34)
- (#x797D . #x5F67)
- (#x797E . #x5FB7)
- (#x7A21 . #x5FDE)
- (#x7A22 . #x605D)
- (#x7A23 . #x6085)
- (#x7A24 . #x608A)
- (#x7A25 . #x60DE)
- (#x7A26 . #x60D5)
- (#x7A27 . #x6120)
- (#x7A28 . #x60F2)
- (#x7A29 . #x6111)
- (#x7A2A . #x6137)
- (#x7A2B . #x6130)
- (#x7A2C . #x6198)
- (#x7A2D . #x6213)
- (#x7A2E . #x62A6)
- (#x7A2F . #x63F5)
- (#x7A30 . #x6460)
- (#x7A31 . #x649D)
- (#x7A32 . #x64CE)
- (#x7A33 . #x654E)
- (#x7A34 . #x6600)
- (#x7A35 . #x6615)
- (#x7A36 . #x663B)
- (#x7A37 . #x6609)
- (#x7A38 . #x662E)
- (#x7A39 . #x661E)
- (#x7A3A . #x6624)
- (#x7A3B . #x6665)
- (#x7A3C . #x6657)
- (#x7A3D . #x6659)
- (#x7A3E . #xFA12)
- (#x7A3F . #x6673)
- (#x7A40 . #x6699)
- (#x7A41 . #x66A0)
- (#x7A42 . #x66B2)
- (#x7A43 . #x66BF)
- (#x7A44 . #x66FA)
- (#x7A45 . #x670E)
- (#x7A46 . #xF929)
- (#x7A47 . #x6766)
- (#x7A48 . #x67BB)
- (#x7A49 . #x6852)
- (#x7A4A . #x67C0)
- (#x7A4B . #x6801)
- (#x7A4C . #x6844)
- (#x7A4D . #x68CF)
- (#x7A4E . #xFA13)
- (#x7A4F . #x6968)
- (#x7A50 . #xFA14)
- (#x7A51 . #x6998)
- (#x7A52 . #x69E2)
- (#x7A53 . #x6A30)
- (#x7A54 . #x6A6B)
- (#x7A55 . #x6A46)
- (#x7A56 . #x6A73)
- (#x7A57 . #x6A7E)
- (#x7A58 . #x6AE2)
- (#x7A59 . #x6AE4)
- (#x7A5A . #x6BD6)
- (#x7A5B . #x6C3F)
- (#x7A5C . #x6C5C)
- (#x7A5D . #x6C86)
- (#x7A5E . #x6C6F)
- (#x7A5F . #x6CDA)
- (#x7A60 . #x6D04)
- (#x7A61 . #x6D87)
- (#x7A62 . #x6D6F)
- (#x7A63 . #x6D96)
- (#x7A64 . #x6DAC)
- (#x7A65 . #x6DCF)
- (#x7A66 . #x6DF8)
- (#x7A67 . #x6DF2)
- (#x7A68 . #x6DFC)
- (#x7A69 . #x6E39)
- (#x7A6A . #x6E5C)
- (#x7A6B . #x6E27)
- (#x7A6C . #x6E3C)
- (#x7A6D . #x6EBF)
- (#x7A6E . #x6F88)
- (#x7A6F . #x6FB5)
- (#x7A70 . #x6FF5)
- (#x7A71 . #x7005)
- (#x7A72 . #x7007)
- (#x7A73 . #x7028)
- (#x7A74 . #x7085)
- (#x7A75 . #x70AB)
- (#x7A76 . #x710F)
- (#x7A77 . #x7104)
- (#x7A78 . #x715C)
- (#x7A79 . #x7146)
- (#x7A7A . #x7147)
- (#x7A7B . #xFA15)
- (#x7A7C . #x71C1)
- (#x7A7D . #x71FE)
- (#x7A7E . #x72B1)
- (#x7B21 . #x72BE)
- (#x7B22 . #x7324)
- (#x7B23 . #xFA16)
- (#x7B24 . #x7377)
- (#x7B25 . #x73BD)
- (#x7B26 . #x73C9)
- (#x7B27 . #x73D6)
- (#x7B28 . #x73E3)
- (#x7B29 . #x73D2)
- (#x7B2A . #x7407)
- (#x7B2B . #x73F5)
- (#x7B2C . #x7426)
- (#x7B2D . #x742A)
- (#x7B2E . #x7429)
- (#x7B2F . #x742E)
- (#x7B30 . #x7462)
- (#x7B31 . #x7489)
- (#x7B32 . #x749F)
- (#x7B33 . #x7501)
- (#x7B34 . #x756F)
- (#x7B35 . #x7682)
- (#x7B36 . #x769C)
- (#x7B37 . #x769E)
- (#x7B38 . #x769B)
- (#x7B39 . #x76A6)
- (#x7B3A . #xFA17)
- (#x7B3B . #x7746)
- (#x7B3C . #x52AF)
- (#x7B3D . #x7821)
- (#x7B3E . #x784E)
- (#x7B3F . #x7864)
- (#x7B40 . #x787A)
- (#x7B41 . #x7930)
- (#x7B42 . #xFA18)
- (#x7B43 . #xFA19)
- (#x7B44 . #xFA1A)
- (#x7B45 . #x7994)
- (#x7B46 . #xFA1B)
- (#x7B47 . #x799B)
- (#x7B48 . #x7AD1)
- (#x7B49 . #x7AE7)
- (#x7B4A . #xFA1C)
- (#x7B4B . #x7AEB)
- (#x7B4C . #x7B9E)
- (#x7B4D . #xFA1D)
- (#x7B4E . #x7D48)
- (#x7B4F . #x7D5C)
- (#x7B50 . #x7DB7)
- (#x7B51 . #x7DA0)
- (#x7B52 . #x7DD6)
- (#x7B53 . #x7E52)
- (#x7B54 . #x7F47)
- (#x7B55 . #x7FA1)
- (#x7B56 . #xFA1E)
- (#x7B57 . #x8301)
- (#x7B58 . #x8362)
- (#x7B59 . #x837F)
- (#x7B5A . #x83C7)
- (#x7B5B . #x83F6)
- (#x7B5C . #x8448)
- (#x7B5D . #x84B4)
- (#x7B5E . #x8553)
- (#x7B5F . #x8559)
- (#x7B60 . #x856B)
- (#x7B61 . #xFA1F)
- (#x7B62 . #x85B0)
- (#x7B63 . #xFA20)
- (#x7B64 . #xFA21)
- (#x7B65 . #x8807)
- (#x7B66 . #x88F5)
- (#x7B67 . #x8A12)
- (#x7B68 . #x8A37)
- (#x7B69 . #x8A79)
- (#x7B6A . #x8AA7)
- (#x7B6B . #x8ABE)
- (#x7B6C . #x8ADF)
- (#x7B6D . #xFA22)
- (#x7B6E . #x8AF6)
- (#x7B6F . #x8B53)
- (#x7B70 . #x8B7F)
- (#x7B71 . #x8CF0)
- (#x7B72 . #x8CF4)
- (#x7B73 . #x8D12)
- (#x7B74 . #x8D76)
- (#x7B75 . #xFA23)
- (#x7B76 . #x8ECF)
- (#x7B77 . #xFA24)
- (#x7B78 . #xFA25)
- (#x7B79 . #x9067)
- (#x7B7A . #x90DE)
- (#x7B7B . #xFA26)
- (#x7B7C . #x9115)
- (#x7B7D . #x9127)
- (#x7B7E . #x91DA)
- (#x7C21 . #x91D7)
- (#x7C22 . #x91DE)
- (#x7C23 . #x91ED)
- (#x7C24 . #x91EE)
- (#x7C25 . #x91E4)
- (#x7C26 . #x91E5)
- (#x7C27 . #x9206)
- (#x7C28 . #x9210)
- (#x7C29 . #x920A)
- (#x7C2A . #x923A)
- (#x7C2B . #x9240)
- (#x7C2C . #x923C)
- (#x7C2D . #x924E)
- (#x7C2E . #x9259)
- (#x7C2F . #x9251)
- (#x7C30 . #x9239)
- (#x7C31 . #x9267)
- (#x7C32 . #x92A7)
- (#x7C33 . #x9277)
- (#x7C34 . #x9278)
- (#x7C35 . #x92E7)
- (#x7C36 . #x92D7)
- (#x7C37 . #x92D9)
- (#x7C38 . #x92D0)
- (#x7C39 . #xFA27)
- (#x7C3A . #x92D5)
- (#x7C3B . #x92E0)
- (#x7C3C . #x92D3)
- (#x7C3D . #x9325)
- (#x7C3E . #x9321)
- (#x7C3F . #x92FB)
- (#x7C40 . #xFA28)
- (#x7C41 . #x931E)
- (#x7C42 . #x92FF)
- (#x7C43 . #x931D)
- (#x7C44 . #x9302)
- (#x7C45 . #x9370)
- (#x7C46 . #x9357)
- (#x7C47 . #x93A4)
- (#x7C48 . #x93C6)
- (#x7C49 . #x93DE)
- (#x7C4A . #x93F8)
- (#x7C4B . #x9431)
- (#x7C4C . #x9445)
- (#x7C4D . #x9448)
- (#x7C4E . #x9592)
- (#x7C4F . #xF9DC)
- (#x7C50 . #xFA29)
- (#x7C51 . #x969D)
- (#x7C52 . #x96AF)
- (#x7C53 . #x9733)
- (#x7C54 . #x973B)
- (#x7C55 . #x9743)
- (#x7C56 . #x974D)
- (#x7C57 . #x974F)
- (#x7C58 . #x9751)
- (#x7C59 . #x9755)
- (#x7C5A . #x9857)
- (#x7C5B . #x9865)
- (#x7C5C . #xFA2A)
- (#x7C5D . #xFA2B)
- (#x7C5E . #x9927)
- (#x7C5F . #xFA2C)
- (#x7C60 . #x999E)
- (#x7C61 . #x9A4E)
- (#x7C62 . #x9AD9)
- (#x7C63 . #x9ADC)
- (#x7C64 . #x9B75)
- (#x7C65 . #x9B72)
- (#x7C66 . #x9B8F)
- (#x7C67 . #x9BB1)
- (#x7C68 . #x9BBB)
- (#x7C69 . #x9C00)
- (#x7C6A . #x9D70)
- (#x7C6B . #x9D6B)
- (#x7C6C . #xFA2D)
- (#x7C6D . #x9E19)
- (#x7C6E . #x9ED1)
- (#x7C71 . #x2170)
- (#x7C72 . #x2171)
- (#x7C73 . #x2172)
- (#x7C74 . #x2173)
- (#x7C75 . #x2174)
- (#x7C76 . #x2175)
- (#x7C77 . #x2176)
- (#x7C78 . #x2177)
- (#x7C79 . #x2178)
- (#x7C7A . #x2179)
- (#x7C7B . #xFFE2)
- (#x7C7C . #xFFE4)
- (#x7C7D . #xFF07)
- (#x7C7E . #xFF02))))
- (mapc #'(lambda (x)
- (setcar x (decode-char 'japanese-jisx0208 (car x))))
- map)
- (define-translation-table 'cp51932-decode map)
- (mapc #'(lambda (x)
- (let ((tmp (car x)))
- (setcar x (cdr x)) (setcdr x tmp)))
- map)
- (define-translation-table 'cp51932-encode map))
diff --git a/lisp/international/eucjp-ms.el b/lisp/international/eucjp-ms.el
deleted file mode 100644
index 6e4e1e798b0..00000000000
--- a/lisp/international/eucjp-ms.el
+++ /dev/null
@@ -1,2087 +0,0 @@
-;;; eucjp-ms.el -- translation table for eucJP-ms. -*- no-byte-compile: t -*-
-;;; Automatically generated from /usr/share/i18n/charmaps/EUC-JP-MS.gz
-(let ((map
- '(;JISEXT<->UNICODE
-
- (#xada1 . #x2460)
- (#xada2 . #x2461)
- (#xada3 . #x2462)
- (#xada4 . #x2463)
- (#xada5 . #x2464)
- (#xada6 . #x2465)
- (#xada7 . #x2466)
- (#xada8 . #x2467)
- (#xada9 . #x2468)
- (#xadaa . #x2469)
- (#xadab . #x246A)
- (#xadac . #x246B)
- (#xadad . #x246C)
- (#xadae . #x246D)
- (#xadaf . #x246E)
- (#xadb0 . #x246F)
- (#xadb1 . #x2470)
- (#xadb2 . #x2471)
- (#xadb3 . #x2472)
- (#xadb4 . #x2473)
- (#xadb5 . #x2160)
- (#xadb6 . #x2161)
- (#xadb7 . #x2162)
- (#xadb8 . #x2163)
- (#xadb9 . #x2164)
- (#xadba . #x2165)
- (#xadbb . #x2166)
- (#xadbc . #x2167)
- (#xadbd . #x2168)
- (#xadbe . #x2169)
- (#xadc0 . #x3349)
- (#xadc1 . #x3314)
- (#xadc2 . #x3322)
- (#xadc3 . #x334D)
- (#xadc4 . #x3318)
- (#xadc5 . #x3327)
- (#xadc6 . #x3303)
- (#xadc7 . #x3336)
- (#xadc8 . #x3351)
- (#xadc9 . #x3357)
- (#xadca . #x330D)
- (#xadcb . #x3326)
- (#xadcc . #x3323)
- (#xadcd . #x332B)
- (#xadce . #x334A)
- (#xadcf . #x333B)
- (#xadd0 . #x339C)
- (#xadd1 . #x339D)
- (#xadd2 . #x339E)
- (#xadd3 . #x338E)
- (#xadd4 . #x338F)
- (#xadd5 . #x33C4)
- (#xadd6 . #x33A1)
- (#xaddf . #x337B)
- (#xade0 . #x301D)
- (#xade1 . #x301F)
- (#xade2 . #x2116)
- (#xade3 . #x33CD)
- (#xade4 . #x2121)
- (#xade5 . #x32A4)
- (#xade6 . #x32A5)
- (#xade7 . #x32A6)
- (#xade8 . #x32A7)
- (#xade9 . #x32A8)
- (#xadea . #x3231)
- (#xadeb . #x3232)
- (#xadec . #x3239)
- (#xaded . #x337E)
- (#xadee . #x337D)
- (#xadef . #x337C)
- (#xadf0 . #x2252)
- (#xadf1 . #x2261)
- (#xadf2 . #x222B)
- (#xadf3 . #x222E)
- (#xadf4 . #x2211)
- (#xadf5 . #x221A)
- (#xadf6 . #x22A5)
- (#xadf7 . #x2220)
- (#xadf8 . #x221F)
- (#xadf9 . #x22BF)
- (#xadfa . #x2235)
- (#xadfb . #x2229)
- (#xadfc . #x222A)
- (#xf5a1 . #xE000)
- (#xf5a2 . #xE001)
- (#xf5a3 . #xE002)
- (#xf5a4 . #xE003)
- (#xf5a5 . #xE004)
- (#xf5a6 . #xE005)
- (#xf5a7 . #xE006)
- (#xf5a8 . #xE007)
- (#xf5a9 . #xE008)
- (#xf5aa . #xE009)
- (#xf5ab . #xE00A)
- (#xf5ac . #xE00B)
- (#xf5ad . #xE00C)
- (#xf5ae . #xE00D)
- (#xf5af . #xE00E)
- (#xf5b0 . #xE00F)
- (#xf5b1 . #xE010)
- (#xf5b2 . #xE011)
- (#xf5b3 . #xE012)
- (#xf5b4 . #xE013)
- (#xf5b5 . #xE014)
- (#xf5b6 . #xE015)
- (#xf5b7 . #xE016)
- (#xf5b8 . #xE017)
- (#xf5b9 . #xE018)
- (#xf5ba . #xE019)
- (#xf5bb . #xE01A)
- (#xf5bc . #xE01B)
- (#xf5bd . #xE01C)
- (#xf5be . #xE01D)
- (#xf5bf . #xE01E)
- (#xf5c0 . #xE01F)
- (#xf5c1 . #xE020)
- (#xf5c2 . #xE021)
- (#xf5c3 . #xE022)
- (#xf5c4 . #xE023)
- (#xf5c5 . #xE024)
- (#xf5c6 . #xE025)
- (#xf5c7 . #xE026)
- (#xf5c8 . #xE027)
- (#xf5c9 . #xE028)
- (#xf5ca . #xE029)
- (#xf5cb . #xE02A)
- (#xf5cc . #xE02B)
- (#xf5cd . #xE02C)
- (#xf5ce . #xE02D)
- (#xf5cf . #xE02E)
- (#xf5d0 . #xE02F)
- (#xf5d1 . #xE030)
- (#xf5d2 . #xE031)
- (#xf5d3 . #xE032)
- (#xf5d4 . #xE033)
- (#xf5d5 . #xE034)
- (#xf5d6 . #xE035)
- (#xf5d7 . #xE036)
- (#xf5d8 . #xE037)
- (#xf5d9 . #xE038)
- (#xf5da . #xE039)
- (#xf5db . #xE03A)
- (#xf5dc . #xE03B)
- (#xf5dd . #xE03C)
- (#xf5de . #xE03D)
- (#xf5df . #xE03E)
- (#xf5e0 . #xE03F)
- (#xf5e1 . #xE040)
- (#xf5e2 . #xE041)
- (#xf5e3 . #xE042)
- (#xf5e4 . #xE043)
- (#xf5e5 . #xE044)
- (#xf5e6 . #xE045)
- (#xf5e7 . #xE046)
- (#xf5e8 . #xE047)
- (#xf5e9 . #xE048)
- (#xf5ea . #xE049)
- (#xf5eb . #xE04A)
- (#xf5ec . #xE04B)
- (#xf5ed . #xE04C)
- (#xf5ee . #xE04D)
- (#xf5ef . #xE04E)
- (#xf5f0 . #xE04F)
- (#xf5f1 . #xE050)
- (#xf5f2 . #xE051)
- (#xf5f3 . #xE052)
- (#xf5f4 . #xE053)
- (#xf5f5 . #xE054)
- (#xf5f6 . #xE055)
- (#xf5f7 . #xE056)
- (#xf5f8 . #xE057)
- (#xf5f9 . #xE058)
- (#xf5fa . #xE059)
- (#xf5fb . #xE05A)
- (#xf5fc . #xE05B)
- (#xf5fd . #xE05C)
- (#xf5fe . #xE05D)
- (#xf6a1 . #xE05E)
- (#xf6a2 . #xE05F)
- (#xf6a3 . #xE060)
- (#xf6a4 . #xE061)
- (#xf6a5 . #xE062)
- (#xf6a6 . #xE063)
- (#xf6a7 . #xE064)
- (#xf6a8 . #xE065)
- (#xf6a9 . #xE066)
- (#xf6aa . #xE067)
- (#xf6ab . #xE068)
- (#xf6ac . #xE069)
- (#xf6ad . #xE06A)
- (#xf6ae . #xE06B)
- (#xf6af . #xE06C)
- (#xf6b0 . #xE06D)
- (#xf6b1 . #xE06E)
- (#xf6b2 . #xE06F)
- (#xf6b3 . #xE070)
- (#xf6b4 . #xE071)
- (#xf6b5 . #xE072)
- (#xf6b6 . #xE073)
- (#xf6b7 . #xE074)
- (#xf6b8 . #xE075)
- (#xf6b9 . #xE076)
- (#xf6ba . #xE077)
- (#xf6bb . #xE078)
- (#xf6bc . #xE079)
- (#xf6bd . #xE07A)
- (#xf6be . #xE07B)
- (#xf6bf . #xE07C)
- (#xf6c0 . #xE07D)
- (#xf6c1 . #xE07E)
- (#xf6c2 . #xE07F)
- (#xf6c3 . #xE080)
- (#xf6c4 . #xE081)
- (#xf6c5 . #xE082)
- (#xf6c6 . #xE083)
- (#xf6c7 . #xE084)
- (#xf6c8 . #xE085)
- (#xf6c9 . #xE086)
- (#xf6ca . #xE087)
- (#xf6cb . #xE088)
- (#xf6cc . #xE089)
- (#xf6cd . #xE08A)
- (#xf6ce . #xE08B)
- (#xf6cf . #xE08C)
- (#xf6d0 . #xE08D)
- (#xf6d1 . #xE08E)
- (#xf6d2 . #xE08F)
- (#xf6d3 . #xE090)
- (#xf6d4 . #xE091)
- (#xf6d5 . #xE092)
- (#xf6d6 . #xE093)
- (#xf6d7 . #xE094)
- (#xf6d8 . #xE095)
- (#xf6d9 . #xE096)
- (#xf6da . #xE097)
- (#xf6db . #xE098)
- (#xf6dc . #xE099)
- (#xf6dd . #xE09A)
- (#xf6de . #xE09B)
- (#xf6df . #xE09C)
- (#xf6e0 . #xE09D)
- (#xf6e1 . #xE09E)
- (#xf6e2 . #xE09F)
- (#xf6e3 . #xE0A0)
- (#xf6e4 . #xE0A1)
- (#xf6e5 . #xE0A2)
- (#xf6e6 . #xE0A3)
- (#xf6e7 . #xE0A4)
- (#xf6e8 . #xE0A5)
- (#xf6e9 . #xE0A6)
- (#xf6ea . #xE0A7)
- (#xf6eb . #xE0A8)
- (#xf6ec . #xE0A9)
- (#xf6ed . #xE0AA)
- (#xf6ee . #xE0AB)
- (#xf6ef . #xE0AC)
- (#xf6f0 . #xE0AD)
- (#xf6f1 . #xE0AE)
- (#xf6f2 . #xE0AF)
- (#xf6f3 . #xE0B0)
- (#xf6f4 . #xE0B1)
- (#xf6f5 . #xE0B2)
- (#xf6f6 . #xE0B3)
- (#xf6f7 . #xE0B4)
- (#xf6f8 . #xE0B5)
- (#xf6f9 . #xE0B6)
- (#xf6fa . #xE0B7)
- (#xf6fb . #xE0B8)
- (#xf6fc . #xE0B9)
- (#xf6fd . #xE0BA)
- (#xf6fe . #xE0BB)
- (#xf7a1 . #xE0BC)
- (#xf7a2 . #xE0BD)
- (#xf7a3 . #xE0BE)
- (#xf7a4 . #xE0BF)
- (#xf7a5 . #xE0C0)
- (#xf7a6 . #xE0C1)
- (#xf7a7 . #xE0C2)
- (#xf7a8 . #xE0C3)
- (#xf7a9 . #xE0C4)
- (#xf7aa . #xE0C5)
- (#xf7ab . #xE0C6)
- (#xf7ac . #xE0C7)
- (#xf7ad . #xE0C8)
- (#xf7ae . #xE0C9)
- (#xf7af . #xE0CA)
- (#xf7b0 . #xE0CB)
- (#xf7b1 . #xE0CC)
- (#xf7b2 . #xE0CD)
- (#xf7b3 . #xE0CE)
- (#xf7b4 . #xE0CF)
- (#xf7b5 . #xE0D0)
- (#xf7b6 . #xE0D1)
- (#xf7b7 . #xE0D2)
- (#xf7b8 . #xE0D3)
- (#xf7b9 . #xE0D4)
- (#xf7ba . #xE0D5)
- (#xf7bb . #xE0D6)
- (#xf7bc . #xE0D7)
- (#xf7bd . #xE0D8)
- (#xf7be . #xE0D9)
- (#xf7bf . #xE0DA)
- (#xf7c0 . #xE0DB)
- (#xf7c1 . #xE0DC)
- (#xf7c2 . #xE0DD)
- (#xf7c3 . #xE0DE)
- (#xf7c4 . #xE0DF)
- (#xf7c5 . #xE0E0)
- (#xf7c6 . #xE0E1)
- (#xf7c7 . #xE0E2)
- (#xf7c8 . #xE0E3)
- (#xf7c9 . #xE0E4)
- (#xf7ca . #xE0E5)
- (#xf7cb . #xE0E6)
- (#xf7cc . #xE0E7)
- (#xf7cd . #xE0E8)
- (#xf7ce . #xE0E9)
- (#xf7cf . #xE0EA)
- (#xf7d0 . #xE0EB)
- (#xf7d1 . #xE0EC)
- (#xf7d2 . #xE0ED)
- (#xf7d3 . #xE0EE)
- (#xf7d4 . #xE0EF)
- (#xf7d5 . #xE0F0)
- (#xf7d6 . #xE0F1)
- (#xf7d7 . #xE0F2)
- (#xf7d8 . #xE0F3)
- (#xf7d9 . #xE0F4)
- (#xf7da . #xE0F5)
- (#xf7db . #xE0F6)
- (#xf7dc . #xE0F7)
- (#xf7dd . #xE0F8)
- (#xf7de . #xE0F9)
- (#xf7df . #xE0FA)
- (#xf7e0 . #xE0FB)
- (#xf7e1 . #xE0FC)
- (#xf7e2 . #xE0FD)
- (#xf7e3 . #xE0FE)
- (#xf7e4 . #xE0FF)
- (#xf7e5 . #xE100)
- (#xf7e6 . #xE101)
- (#xf7e7 . #xE102)
- (#xf7e8 . #xE103)
- (#xf7e9 . #xE104)
- (#xf7ea . #xE105)
- (#xf7eb . #xE106)
- (#xf7ec . #xE107)
- (#xf7ed . #xE108)
- (#xf7ee . #xE109)
- (#xf7ef . #xE10A)
- (#xf7f0 . #xE10B)
- (#xf7f1 . #xE10C)
- (#xf7f2 . #xE10D)
- (#xf7f3 . #xE10E)
- (#xf7f4 . #xE10F)
- (#xf7f5 . #xE110)
- (#xf7f6 . #xE111)
- (#xf7f7 . #xE112)
- (#xf7f8 . #xE113)
- (#xf7f9 . #xE114)
- (#xf7fa . #xE115)
- (#xf7fb . #xE116)
- (#xf7fc . #xE117)
- (#xf7fd . #xE118)
- (#xf7fe . #xE119)
- (#xf8a1 . #xE11A)
- (#xf8a2 . #xE11B)
- (#xf8a3 . #xE11C)
- (#xf8a4 . #xE11D)
- (#xf8a5 . #xE11E)
- (#xf8a6 . #xE11F)
- (#xf8a7 . #xE120)
- (#xf8a8 . #xE121)
- (#xf8a9 . #xE122)
- (#xf8aa . #xE123)
- (#xf8ab . #xE124)
- (#xf8ac . #xE125)
- (#xf8ad . #xE126)
- (#xf8ae . #xE127)
- (#xf8af . #xE128)
- (#xf8b0 . #xE129)
- (#xf8b1 . #xE12A)
- (#xf8b2 . #xE12B)
- (#xf8b3 . #xE12C)
- (#xf8b4 . #xE12D)
- (#xf8b5 . #xE12E)
- (#xf8b6 . #xE12F)
- (#xf8b7 . #xE130)
- (#xf8b8 . #xE131)
- (#xf8b9 . #xE132)
- (#xf8ba . #xE133)
- (#xf8bb . #xE134)
- (#xf8bc . #xE135)
- (#xf8bd . #xE136)
- (#xf8be . #xE137)
- (#xf8bf . #xE138)
- (#xf8c0 . #xE139)
- (#xf8c1 . #xE13A)
- (#xf8c2 . #xE13B)
- (#xf8c3 . #xE13C)
- (#xf8c4 . #xE13D)
- (#xf8c5 . #xE13E)
- (#xf8c6 . #xE13F)
- (#xf8c7 . #xE140)
- (#xf8c8 . #xE141)
- (#xf8c9 . #xE142)
- (#xf8ca . #xE143)
- (#xf8cb . #xE144)
- (#xf8cc . #xE145)
- (#xf8cd . #xE146)
- (#xf8ce . #xE147)
- (#xf8cf . #xE148)
- (#xf8d0 . #xE149)
- (#xf8d1 . #xE14A)
- (#xf8d2 . #xE14B)
- (#xf8d3 . #xE14C)
- (#xf8d4 . #xE14D)
- (#xf8d5 . #xE14E)
- (#xf8d6 . #xE14F)
- (#xf8d7 . #xE150)
- (#xf8d8 . #xE151)
- (#xf8d9 . #xE152)
- (#xf8da . #xE153)
- (#xf8db . #xE154)
- (#xf8dc . #xE155)
- (#xf8dd . #xE156)
- (#xf8de . #xE157)
- (#xf8df . #xE158)
- (#xf8e0 . #xE159)
- (#xf8e1 . #xE15A)
- (#xf8e2 . #xE15B)
- (#xf8e3 . #xE15C)
- (#xf8e4 . #xE15D)
- (#xf8e5 . #xE15E)
- (#xf8e6 . #xE15F)
- (#xf8e7 . #xE160)
- (#xf8e8 . #xE161)
- (#xf8e9 . #xE162)
- (#xf8ea . #xE163)
- (#xf8eb . #xE164)
- (#xf8ec . #xE165)
- (#xf8ed . #xE166)
- (#xf8ee . #xE167)
- (#xf8ef . #xE168)
- (#xf8f0 . #xE169)
- (#xf8f1 . #xE16A)
- (#xf8f2 . #xE16B)
- (#xf8f3 . #xE16C)
- (#xf8f4 . #xE16D)
- (#xf8f5 . #xE16E)
- (#xf8f6 . #xE16F)
- (#xf8f7 . #xE170)
- (#xf8f8 . #xE171)
- (#xf8f9 . #xE172)
- (#xf8fa . #xE173)
- (#xf8fb . #xE174)
- (#xf8fc . #xE175)
- (#xf8fd . #xE176)
- (#xf8fe . #xE177)
- (#xf9a1 . #xE178)
- (#xf9a2 . #xE179)
- (#xf9a3 . #xE17A)
- (#xf9a4 . #xE17B)
- (#xf9a5 . #xE17C)
- (#xf9a6 . #xE17D)
- (#xf9a7 . #xE17E)
- (#xf9a8 . #xE17F)
- (#xf9a9 . #xE180)
- (#xf9aa . #xE181)
- (#xf9ab . #xE182)
- (#xf9ac . #xE183)
- (#xf9ad . #xE184)
- (#xf9ae . #xE185)
- (#xf9af . #xE186)
- (#xf9b0 . #xE187)
- (#xf9b1 . #xE188)
- (#xf9b2 . #xE189)
- (#xf9b3 . #xE18A)
- (#xf9b4 . #xE18B)
- (#xf9b5 . #xE18C)
- (#xf9b6 . #xE18D)
- (#xf9b7 . #xE18E)
- (#xf9b8 . #xE18F)
- (#xf9b9 . #xE190)
- (#xf9ba . #xE191)
- (#xf9bb . #xE192)
- (#xf9bc . #xE193)
- (#xf9bd . #xE194)
- (#xf9be . #xE195)
- (#xf9bf . #xE196)
- (#xf9c0 . #xE197)
- (#xf9c1 . #xE198)
- (#xf9c2 . #xE199)
- (#xf9c3 . #xE19A)
- (#xf9c4 . #xE19B)
- (#xf9c5 . #xE19C)
- (#xf9c6 . #xE19D)
- (#xf9c7 . #xE19E)
- (#xf9c8 . #xE19F)
- (#xf9c9 . #xE1A0)
- (#xf9ca . #xE1A1)
- (#xf9cb . #xE1A2)
- (#xf9cc . #xE1A3)
- (#xf9cd . #xE1A4)
- (#xf9ce . #xE1A5)
- (#xf9cf . #xE1A6)
- (#xf9d0 . #xE1A7)
- (#xf9d1 . #xE1A8)
- (#xf9d2 . #xE1A9)
- (#xf9d3 . #xE1AA)
- (#xf9d4 . #xE1AB)
- (#xf9d5 . #xE1AC)
- (#xf9d6 . #xE1AD)
- (#xf9d7 . #xE1AE)
- (#xf9d8 . #xE1AF)
- (#xf9d9 . #xE1B0)
- (#xf9da . #xE1B1)
- (#xf9db . #xE1B2)
- (#xf9dc . #xE1B3)
- (#xf9dd . #xE1B4)
- (#xf9de . #xE1B5)
- (#xf9df . #xE1B6)
- (#xf9e0 . #xE1B7)
- (#xf9e1 . #xE1B8)
- (#xf9e2 . #xE1B9)
- (#xf9e3 . #xE1BA)
- (#xf9e4 . #xE1BB)
- (#xf9e5 . #xE1BC)
- (#xf9e6 . #xE1BD)
- (#xf9e7 . #xE1BE)
- (#xf9e8 . #xE1BF)
- (#xf9e9 . #xE1C0)
- (#xf9ea . #xE1C1)
- (#xf9eb . #xE1C2)
- (#xf9ec . #xE1C3)
- (#xf9ed . #xE1C4)
- (#xf9ee . #xE1C5)
- (#xf9ef . #xE1C6)
- (#xf9f0 . #xE1C7)
- (#xf9f1 . #xE1C8)
- (#xf9f2 . #xE1C9)
- (#xf9f3 . #xE1CA)
- (#xf9f4 . #xE1CB)
- (#xf9f5 . #xE1CC)
- (#xf9f6 . #xE1CD)
- (#xf9f7 . #xE1CE)
- (#xf9f8 . #xE1CF)
- (#xf9f9 . #xE1D0)
- (#xf9fa . #xE1D1)
- (#xf9fb . #xE1D2)
- (#xf9fc . #xE1D3)
- (#xf9fd . #xE1D4)
- (#xf9fe . #xE1D5)
- (#xfaa1 . #xE1D6)
- (#xfaa2 . #xE1D7)
- (#xfaa3 . #xE1D8)
- (#xfaa4 . #xE1D9)
- (#xfaa5 . #xE1DA)
- (#xfaa6 . #xE1DB)
- (#xfaa7 . #xE1DC)
- (#xfaa8 . #xE1DD)
- (#xfaa9 . #xE1DE)
- (#xfaaa . #xE1DF)
- (#xfaab . #xE1E0)
- (#xfaac . #xE1E1)
- (#xfaad . #xE1E2)
- (#xfaae . #xE1E3)
- (#xfaaf . #xE1E4)
- (#xfab0 . #xE1E5)
- (#xfab1 . #xE1E6)
- (#xfab2 . #xE1E7)
- (#xfab3 . #xE1E8)
- (#xfab4 . #xE1E9)
- (#xfab5 . #xE1EA)
- (#xfab6 . #xE1EB)
- (#xfab7 . #xE1EC)
- (#xfab8 . #xE1ED)
- (#xfab9 . #xE1EE)
- (#xfaba . #xE1EF)
- (#xfabb . #xE1F0)
- (#xfabc . #xE1F1)
- (#xfabd . #xE1F2)
- (#xfabe . #xE1F3)
- (#xfabf . #xE1F4)
- (#xfac0 . #xE1F5)
- (#xfac1 . #xE1F6)
- (#xfac2 . #xE1F7)
- (#xfac3 . #xE1F8)
- (#xfac4 . #xE1F9)
- (#xfac5 . #xE1FA)
- (#xfac6 . #xE1FB)
- (#xfac7 . #xE1FC)
- (#xfac8 . #xE1FD)
- (#xfac9 . #xE1FE)
- (#xfaca . #xE1FF)
- (#xfacb . #xE200)
- (#xfacc . #xE201)
- (#xfacd . #xE202)
- (#xface . #xE203)
- (#xfacf . #xE204)
- (#xfad0 . #xE205)
- (#xfad1 . #xE206)
- (#xfad2 . #xE207)
- (#xfad3 . #xE208)
- (#xfad4 . #xE209)
- (#xfad5 . #xE20A)
- (#xfad6 . #xE20B)
- (#xfad7 . #xE20C)
- (#xfad8 . #xE20D)
- (#xfad9 . #xE20E)
- (#xfada . #xE20F)
- (#xfadb . #xE210)
- (#xfadc . #xE211)
- (#xfadd . #xE212)
- (#xfade . #xE213)
- (#xfadf . #xE214)
- (#xfae0 . #xE215)
- (#xfae1 . #xE216)
- (#xfae2 . #xE217)
- (#xfae3 . #xE218)
- (#xfae4 . #xE219)
- (#xfae5 . #xE21A)
- (#xfae6 . #xE21B)
- (#xfae7 . #xE21C)
- (#xfae8 . #xE21D)
- (#xfae9 . #xE21E)
- (#xfaea . #xE21F)
- (#xfaeb . #xE220)
- (#xfaec . #xE221)
- (#xfaed . #xE222)
- (#xfaee . #xE223)
- (#xfaef . #xE224)
- (#xfaf0 . #xE225)
- (#xfaf1 . #xE226)
- (#xfaf2 . #xE227)
- (#xfaf3 . #xE228)
- (#xfaf4 . #xE229)
- (#xfaf5 . #xE22A)
- (#xfaf6 . #xE22B)
- (#xfaf7 . #xE22C)
- (#xfaf8 . #xE22D)
- (#xfaf9 . #xE22E)
- (#xfafa . #xE22F)
- (#xfafb . #xE230)
- (#xfafc . #xE231)
- (#xfafd . #xE232)
- (#xfafe . #xE233)
- (#xfba1 . #xE234)
- (#xfba2 . #xE235)
- (#xfba3 . #xE236)
- (#xfba4 . #xE237)
- (#xfba5 . #xE238)
- (#xfba6 . #xE239)
- (#xfba7 . #xE23A)
- (#xfba8 . #xE23B)
- (#xfba9 . #xE23C)
- (#xfbaa . #xE23D)
- (#xfbab . #xE23E)
- (#xfbac . #xE23F)
- (#xfbad . #xE240)
- (#xfbae . #xE241)
- (#xfbaf . #xE242)
- (#xfbb0 . #xE243)
- (#xfbb1 . #xE244)
- (#xfbb2 . #xE245)
- (#xfbb3 . #xE246)
- (#xfbb4 . #xE247)
- (#xfbb5 . #xE248)
- (#xfbb6 . #xE249)
- (#xfbb7 . #xE24A)
- (#xfbb8 . #xE24B)
- (#xfbb9 . #xE24C)
- (#xfbba . #xE24D)
- (#xfbbb . #xE24E)
- (#xfbbc . #xE24F)
- (#xfbbd . #xE250)
- (#xfbbe . #xE251)
- (#xfbbf . #xE252)
- (#xfbc0 . #xE253)
- (#xfbc1 . #xE254)
- (#xfbc2 . #xE255)
- (#xfbc3 . #xE256)
- (#xfbc4 . #xE257)
- (#xfbc5 . #xE258)
- (#xfbc6 . #xE259)
- (#xfbc7 . #xE25A)
- (#xfbc8 . #xE25B)
- (#xfbc9 . #xE25C)
- (#xfbca . #xE25D)
- (#xfbcb . #xE25E)
- (#xfbcc . #xE25F)
- (#xfbcd . #xE260)
- (#xfbce . #xE261)
- (#xfbcf . #xE262)
- (#xfbd0 . #xE263)
- (#xfbd1 . #xE264)
- (#xfbd2 . #xE265)
- (#xfbd3 . #xE266)
- (#xfbd4 . #xE267)
- (#xfbd5 . #xE268)
- (#xfbd6 . #xE269)
- (#xfbd7 . #xE26A)
- (#xfbd8 . #xE26B)
- (#xfbd9 . #xE26C)
- (#xfbda . #xE26D)
- (#xfbdb . #xE26E)
- (#xfbdc . #xE26F)
- (#xfbdd . #xE270)
- (#xfbde . #xE271)
- (#xfbdf . #xE272)
- (#xfbe0 . #xE273)
- (#xfbe1 . #xE274)
- (#xfbe2 . #xE275)
- (#xfbe3 . #xE276)
- (#xfbe4 . #xE277)
- (#xfbe5 . #xE278)
- (#xfbe6 . #xE279)
- (#xfbe7 . #xE27A)
- (#xfbe8 . #xE27B)
- (#xfbe9 . #xE27C)
- (#xfbea . #xE27D)
- (#xfbeb . #xE27E)
- (#xfbec . #xE27F)
- (#xfbed . #xE280)
- (#xfbee . #xE281)
- (#xfbef . #xE282)
- (#xfbf0 . #xE283)
- (#xfbf1 . #xE284)
- (#xfbf2 . #xE285)
- (#xfbf3 . #xE286)
- (#xfbf4 . #xE287)
- (#xfbf5 . #xE288)
- (#xfbf6 . #xE289)
- (#xfbf7 . #xE28A)
- (#xfbf8 . #xE28B)
- (#xfbf9 . #xE28C)
- (#xfbfa . #xE28D)
- (#xfbfb . #xE28E)
- (#xfbfc . #xE28F)
- (#xfbfd . #xE290)
- (#xfbfe . #xE291)
- (#xfca1 . #xE292)
- (#xfca2 . #xE293)
- (#xfca3 . #xE294)
- (#xfca4 . #xE295)
- (#xfca5 . #xE296)
- (#xfca6 . #xE297)
- (#xfca7 . #xE298)
- (#xfca8 . #xE299)
- (#xfca9 . #xE29A)
- (#xfcaa . #xE29B)
- (#xfcab . #xE29C)
- (#xfcac . #xE29D)
- (#xfcad . #xE29E)
- (#xfcae . #xE29F)
- (#xfcaf . #xE2A0)
- (#xfcb0 . #xE2A1)
- (#xfcb1 . #xE2A2)
- (#xfcb2 . #xE2A3)
- (#xfcb3 . #xE2A4)
- (#xfcb4 . #xE2A5)
- (#xfcb5 . #xE2A6)
- (#xfcb6 . #xE2A7)
- (#xfcb7 . #xE2A8)
- (#xfcb8 . #xE2A9)
- (#xfcb9 . #xE2AA)
- (#xfcba . #xE2AB)
- (#xfcbb . #xE2AC)
- (#xfcbc . #xE2AD)
- (#xfcbd . #xE2AE)
- (#xfcbe . #xE2AF)
- (#xfcbf . #xE2B0)
- (#xfcc0 . #xE2B1)
- (#xfcc1 . #xE2B2)
- (#xfcc2 . #xE2B3)
- (#xfcc3 . #xE2B4)
- (#xfcc4 . #xE2B5)
- (#xfcc5 . #xE2B6)
- (#xfcc6 . #xE2B7)
- (#xfcc7 . #xE2B8)
- (#xfcc8 . #xE2B9)
- (#xfcc9 . #xE2BA)
- (#xfcca . #xE2BB)
- (#xfccb . #xE2BC)
- (#xfccc . #xE2BD)
- (#xfccd . #xE2BE)
- (#xfcce . #xE2BF)
- (#xfccf . #xE2C0)
- (#xfcd0 . #xE2C1)
- (#xfcd1 . #xE2C2)
- (#xfcd2 . #xE2C3)
- (#xfcd3 . #xE2C4)
- (#xfcd4 . #xE2C5)
- (#xfcd5 . #xE2C6)
- (#xfcd6 . #xE2C7)
- (#xfcd7 . #xE2C8)
- (#xfcd8 . #xE2C9)
- (#xfcd9 . #xE2CA)
- (#xfcda . #xE2CB)
- (#xfcdb . #xE2CC)
- (#xfcdc . #xE2CD)
- (#xfcdd . #xE2CE)
- (#xfcde . #xE2CF)
- (#xfcdf . #xE2D0)
- (#xfce0 . #xE2D1)
- (#xfce1 . #xE2D2)
- (#xfce2 . #xE2D3)
- (#xfce3 . #xE2D4)
- (#xfce4 . #xE2D5)
- (#xfce5 . #xE2D6)
- (#xfce6 . #xE2D7)
- (#xfce7 . #xE2D8)
- (#xfce8 . #xE2D9)
- (#xfce9 . #xE2DA)
- (#xfcea . #xE2DB)
- (#xfceb . #xE2DC)
- (#xfcec . #xE2DD)
- (#xfced . #xE2DE)
- (#xfcee . #xE2DF)
- (#xfcef . #xE2E0)
- (#xfcf0 . #xE2E1)
- (#xfcf1 . #xE2E2)
- (#xfcf2 . #xE2E3)
- (#xfcf3 . #xE2E4)
- (#xfcf4 . #xE2E5)
- (#xfcf5 . #xE2E6)
- (#xfcf6 . #xE2E7)
- (#xfcf7 . #xE2E8)
- (#xfcf8 . #xE2E9)
- (#xfcf9 . #xE2EA)
- (#xfcfa . #xE2EB)
- (#xfcfb . #xE2EC)
- (#xfcfc . #xE2ED)
- (#xfcfd . #xE2EE)
- (#xfcfe . #xE2EF)
- (#xfda1 . #xE2F0)
- (#xfda2 . #xE2F1)
- (#xfda3 . #xE2F2)
- (#xfda4 . #xE2F3)
- (#xfda5 . #xE2F4)
- (#xfda6 . #xE2F5)
- (#xfda7 . #xE2F6)
- (#xfda8 . #xE2F7)
- (#xfda9 . #xE2F8)
- (#xfdaa . #xE2F9)
- (#xfdab . #xE2FA)
- (#xfdac . #xE2FB)
- (#xfdad . #xE2FC)
- (#xfdae . #xE2FD)
- (#xfdaf . #xE2FE)
- (#xfdb0 . #xE2FF)
- (#xfdb1 . #xE300)
- (#xfdb2 . #xE301)
- (#xfdb3 . #xE302)
- (#xfdb4 . #xE303)
- (#xfdb5 . #xE304)
- (#xfdb6 . #xE305)
- (#xfdb7 . #xE306)
- (#xfdb8 . #xE307)
- (#xfdb9 . #xE308)
- (#xfdba . #xE309)
- (#xfdbb . #xE30A)
- (#xfdbc . #xE30B)
- (#xfdbd . #xE30C)
- (#xfdbe . #xE30D)
- (#xfdbf . #xE30E)
- (#xfdc0 . #xE30F)
- (#xfdc1 . #xE310)
- (#xfdc2 . #xE311)
- (#xfdc3 . #xE312)
- (#xfdc4 . #xE313)
- (#xfdc5 . #xE314)
- (#xfdc6 . #xE315)
- (#xfdc7 . #xE316)
- (#xfdc8 . #xE317)
- (#xfdc9 . #xE318)
- (#xfdca . #xE319)
- (#xfdcb . #xE31A)
- (#xfdcc . #xE31B)
- (#xfdcd . #xE31C)
- (#xfdce . #xE31D)
- (#xfdcf . #xE31E)
- (#xfdd0 . #xE31F)
- (#xfdd1 . #xE320)
- (#xfdd2 . #xE321)
- (#xfdd3 . #xE322)
- (#xfdd4 . #xE323)
- (#xfdd5 . #xE324)
- (#xfdd6 . #xE325)
- (#xfdd7 . #xE326)
- (#xfdd8 . #xE327)
- (#xfdd9 . #xE328)
- (#xfdda . #xE329)
- (#xfddb . #xE32A)
- (#xfddc . #xE32B)
- (#xfddd . #xE32C)
- (#xfdde . #xE32D)
- (#xfddf . #xE32E)
- (#xfde0 . #xE32F)
- (#xfde1 . #xE330)
- (#xfde2 . #xE331)
- (#xfde3 . #xE332)
- (#xfde4 . #xE333)
- (#xfde5 . #xE334)
- (#xfde6 . #xE335)
- (#xfde7 . #xE336)
- (#xfde8 . #xE337)
- (#xfde9 . #xE338)
- (#xfdea . #xE339)
- (#xfdeb . #xE33A)
- (#xfdec . #xE33B)
- (#xfded . #xE33C)
- (#xfdee . #xE33D)
- (#xfdef . #xE33E)
- (#xfdf0 . #xE33F)
- (#xfdf1 . #xE340)
- (#xfdf2 . #xE341)
- (#xfdf3 . #xE342)
- (#xfdf4 . #xE343)
- (#xfdf5 . #xE344)
- (#xfdf6 . #xE345)
- (#xfdf7 . #xE346)
- (#xfdf8 . #xE347)
- (#xfdf9 . #xE348)
- (#xfdfa . #xE349)
- (#xfdfb . #xE34A)
- (#xfdfc . #xE34B)
- (#xfdfd . #xE34C)
- (#xfdfe . #xE34D)
- (#xfea1 . #xE34E)
- (#xfea2 . #xE34F)
- (#xfea3 . #xE350)
- (#xfea4 . #xE351)
- (#xfea5 . #xE352)
- (#xfea6 . #xE353)
- (#xfea7 . #xE354)
- (#xfea8 . #xE355)
- (#xfea9 . #xE356)
- (#xfeaa . #xE357)
- (#xfeab . #xE358)
- (#xfeac . #xE359)
- (#xfead . #xE35A)
- (#xfeae . #xE35B)
- (#xfeaf . #xE35C)
- (#xfeb0 . #xE35D)
- (#xfeb1 . #xE35E)
- (#xfeb2 . #xE35F)
- (#xfeb3 . #xE360)
- (#xfeb4 . #xE361)
- (#xfeb5 . #xE362)
- (#xfeb6 . #xE363)
- (#xfeb7 . #xE364)
- (#xfeb8 . #xE365)
- (#xfeb9 . #xE366)
- (#xfeba . #xE367)
- (#xfebb . #xE368)
- (#xfebc . #xE369)
- (#xfebd . #xE36A)
- (#xfebe . #xE36B)
- (#xfebf . #xE36C)
- (#xfec0 . #xE36D)
- (#xfec1 . #xE36E)
- (#xfec2 . #xE36F)
- (#xfec3 . #xE370)
- (#xfec4 . #xE371)
- (#xfec5 . #xE372)
- (#xfec6 . #xE373)
- (#xfec7 . #xE374)
- (#xfec8 . #xE375)
- (#xfec9 . #xE376)
- (#xfeca . #xE377)
- (#xfecb . #xE378)
- (#xfecc . #xE379)
- (#xfecd . #xE37A)
- (#xfece . #xE37B)
- (#xfecf . #xE37C)
- (#xfed0 . #xE37D)
- (#xfed1 . #xE37E)
- (#xfed2 . #xE37F)
- (#xfed3 . #xE380)
- (#xfed4 . #xE381)
- (#xfed5 . #xE382)
- (#xfed6 . #xE383)
- (#xfed7 . #xE384)
- (#xfed8 . #xE385)
- (#xfed9 . #xE386)
- (#xfeda . #xE387)
- (#xfedb . #xE388)
- (#xfedc . #xE389)
- (#xfedd . #xE38A)
- (#xfede . #xE38B)
- (#xfedf . #xE38C)
- (#xfee0 . #xE38D)
- (#xfee1 . #xE38E)
- (#xfee2 . #xE38F)
- (#xfee3 . #xE390)
- (#xfee4 . #xE391)
- (#xfee5 . #xE392)
- (#xfee6 . #xE393)
- (#xfee7 . #xE394)
- (#xfee8 . #xE395)
- (#xfee9 . #xE396)
- (#xfeea . #xE397)
- (#xfeeb . #xE398)
- (#xfeec . #xE399)
- (#xfeed . #xE39A)
- (#xfeee . #xE39B)
- (#xfeef . #xE39C)
- (#xfef0 . #xE39D)
- (#xfef1 . #xE39E)
- (#xfef2 . #xE39F)
- (#xfef3 . #xE3A0)
- (#xfef4 . #xE3A1)
- (#xfef5 . #xE3A2)
- (#xfef6 . #xE3A3)
- (#xfef7 . #xE3A4)
- (#xfef8 . #xE3A5)
- (#xfef9 . #xE3A6)
- (#xfefa . #xE3A7)
- (#xfefb . #xE3A8)
- (#xfefc . #xE3A9)
- (#xfefd . #xE3AA)
- (#xfefe . #xE3AB)
- (#xf3f3 #x2170)
- (#xf3f4 #x2171)
- (#xf3f5 #x2172)
- (#xf3f6 #x2173)
- (#xf3f7 #x2174)
- (#xf3f8 #x2175)
- (#xf3f9 #x2176)
- (#xf3fa #x2177)
- (#xf3fb #x2178)
- (#xf3fc #x2179)
- (#xf3fd #x2160)
- (#xf3fe #x2161)
- (#xf4a1 #x2162)
- (#xf4a2 #x2163)
- (#xf4a3 #x2164)
- (#xf4a4 #x2165)
- (#xf4a5 #x2166)
- (#xf4a6 #x2167)
- (#xf4a7 #x2168)
- (#xf4a8 #x2169)
- (#xf4a9 #xFF07)
- (#xf4aa #xFF02)
- (#xf4ab #x3231)
- (#xf4ac #x2116)
- (#xf4ad #x2121)
- (#xf4ae #x70BB)
- (#xf4af #x4EFC)
- (#xf4b0 #x50F4)
- (#xf4b1 #x51EC)
- (#xf4b2 #x5307)
- (#xf4b3 #x5324)
- (#xf4b4 #xFA0E)
- (#xf4b5 #x548A)
- (#xf4b6 #x5759)
- (#xf4b7 #xFA0F)
- (#xf4b8 #xFA10)
- (#xf4b9 #x589E)
- (#xf4ba #x5BEC)
- (#xf4bb #x5CF5)
- (#xf4bc #x5D53)
- (#xf4bd #xFA11)
- (#xf4be #x5FB7)
- (#xf4bf #x6085)
- (#xf4c0 #x6120)
- (#xf4c1 #x654E)
- (#xf4c2 #x663B)
- (#xf4c3 #x6665)
- (#xf4c4 #xFA12)
- (#xf4c5 #xF929)
- (#xf4c6 #x6801)
- (#xf4c7 #xFA13)
- (#xf4c8 #xFA14)
- (#xf4c9 #x6A6B)
- (#xf4ca #x6AE2)
- (#xf4cb #x6DF8)
- (#xf4cc #x6DF2)
- (#xf4cd #x7028)
- (#xf4ce #xFA15)
- (#xf4cf #xFA16)
- (#xf4d0 #x7501)
- (#xf4d1 #x7682)
- (#xf4d2 #x769E)
- (#xf4d3 #xFA17)
- (#xf4d4 #x7930)
- (#xf4d5 #xFA18)
- (#xf4d6 #xFA19)
- (#xf4d7 #xFA1A)
- (#xf4d8 #xFA1B)
- (#xf4d9 #x7AE7)
- (#xf4da #xFA1C)
- (#xf4db #xFA1D)
- (#xf4dc #x7DA0)
- (#xf4dd #x7DD6)
- (#xf4de #xFA1E)
- (#xf4df #x8362)
- (#xf4e0 #xFA1F)
- (#xf4e1 #x85B0)
- (#xf4e2 #xFA20)
- (#xf4e3 #xFA21)
- (#xf4e4 #x8807)
- (#xf4e5 #xFA22)
- (#xf4e6 #x8B7F)
- (#xf4e7 #x8CF4)
- (#xf4e8 #x8D76)
- (#xf4e9 #xFA23)
- (#xf4ea #xFA24)
- (#xf4eb #xFA25)
- (#xf4ec #x90DE)
- (#xf4ed #xFA26)
- (#xf4ee #x9115)
- (#xf4ef #xFA27)
- (#xf4f0 #xFA28)
- (#xf4f1 #x9592)
- (#xf4f2 #xF9DC)
- (#xf4f3 #xFA29)
- (#xf4f4 #x973B)
- (#xf4f5 #x974D)
- (#xf4f6 #x9751)
- (#xf4f7 #xFA2A)
- (#xf4f8 #xFA2B)
- (#xf4f9 #xFA2C)
- (#xf4fa #x999E)
- (#xf4fb #x9AD9)
- (#xf4fc #x9B72)
- (#xf4fd #xFA2D)
- (#xf4fe #x9ED1)
- (#xf5a1 #xE3AC)
- (#xf5a2 #xE3AD)
- (#xf5a3 #xE3AE)
- (#xf5a4 #xE3AF)
- (#xf5a5 #xE3B0)
- (#xf5a6 #xE3B1)
- (#xf5a7 #xE3B2)
- (#xf5a8 #xE3B3)
- (#xf5a9 #xE3B4)
- (#xf5aa #xE3B5)
- (#xf5ab #xE3B6)
- (#xf5ac #xE3B7)
- (#xf5ad #xE3B8)
- (#xf5ae #xE3B9)
- (#xf5af #xE3BA)
- (#xf5b0 #xE3BB)
- (#xf5b1 #xE3BC)
- (#xf5b2 #xE3BD)
- (#xf5b3 #xE3BE)
- (#xf5b4 #xE3BF)
- (#xf5b5 #xE3C0)
- (#xf5b6 #xE3C1)
- (#xf5b7 #xE3C2)
- (#xf5b8 #xE3C3)
- (#xf5b9 #xE3C4)
- (#xf5ba #xE3C5)
- (#xf5bb #xE3C6)
- (#xf5bc #xE3C7)
- (#xf5bd #xE3C8)
- (#xf5be #xE3C9)
- (#xf5bf #xE3CA)
- (#xf5c0 #xE3CB)
- (#xf5c1 #xE3CC)
- (#xf5c2 #xE3CD)
- (#xf5c3 #xE3CE)
- (#xf5c4 #xE3CF)
- (#xf5c5 #xE3D0)
- (#xf5c6 #xE3D1)
- (#xf5c7 #xE3D2)
- (#xf5c8 #xE3D3)
- (#xf5c9 #xE3D4)
- (#xf5ca #xE3D5)
- (#xf5cb #xE3D6)
- (#xf5cc #xE3D7)
- (#xf5cd #xE3D8)
- (#xf5ce #xE3D9)
- (#xf5cf #xE3DA)
- (#xf5d0 #xE3DB)
- (#xf5d1 #xE3DC)
- (#xf5d2 #xE3DD)
- (#xf5d3 #xE3DE)
- (#xf5d4 #xE3DF)
- (#xf5d5 #xE3E0)
- (#xf5d6 #xE3E1)
- (#xf5d7 #xE3E2)
- (#xf5d8 #xE3E3)
- (#xf5d9 #xE3E4)
- (#xf5da #xE3E5)
- (#xf5db #xE3E6)
- (#xf5dc #xE3E7)
- (#xf5dd #xE3E8)
- (#xf5de #xE3E9)
- (#xf5df #xE3EA)
- (#xf5e0 #xE3EB)
- (#xf5e1 #xE3EC)
- (#xf5e2 #xE3ED)
- (#xf5e3 #xE3EE)
- (#xf5e4 #xE3EF)
- (#xf5e5 #xE3F0)
- (#xf5e6 #xE3F1)
- (#xf5e7 #xE3F2)
- (#xf5e8 #xE3F3)
- (#xf5e9 #xE3F4)
- (#xf5ea #xE3F5)
- (#xf5eb #xE3F6)
- (#xf5ec #xE3F7)
- (#xf5ed #xE3F8)
- (#xf5ee #xE3F9)
- (#xf5ef #xE3FA)
- (#xf5f0 #xE3FB)
- (#xf5f1 #xE3FC)
- (#xf5f2 #xE3FD)
- (#xf5f3 #xE3FE)
- (#xf5f4 #xE3FF)
- (#xf5f5 #xE400)
- (#xf5f6 #xE401)
- (#xf5f7 #xE402)
- (#xf5f8 #xE403)
- (#xf5f9 #xE404)
- (#xf5fa #xE405)
- (#xf5fb #xE406)
- (#xf5fc #xE407)
- (#xf5fd #xE408)
- (#xf5fe #xE409)
- (#xf6a1 #xE40A)
- (#xf6a2 #xE40B)
- (#xf6a3 #xE40C)
- (#xf6a4 #xE40D)
- (#xf6a5 #xE40E)
- (#xf6a6 #xE40F)
- (#xf6a7 #xE410)
- (#xf6a8 #xE411)
- (#xf6a9 #xE412)
- (#xf6aa #xE413)
- (#xf6ab #xE414)
- (#xf6ac #xE415)
- (#xf6ad #xE416)
- (#xf6ae #xE417)
- (#xf6af #xE418)
- (#xf6b0 #xE419)
- (#xf6b1 #xE41A)
- (#xf6b2 #xE41B)
- (#xf6b3 #xE41C)
- (#xf6b4 #xE41D)
- (#xf6b5 #xE41E)
- (#xf6b6 #xE41F)
- (#xf6b7 #xE420)
- (#xf6b8 #xE421)
- (#xf6b9 #xE422)
- (#xf6ba #xE423)
- (#xf6bb #xE424)
- (#xf6bc #xE425)
- (#xf6bd #xE426)
- (#xf6be #xE427)
- (#xf6bf #xE428)
- (#xf6c0 #xE429)
- (#xf6c1 #xE42A)
- (#xf6c2 #xE42B)
- (#xf6c3 #xE42C)
- (#xf6c4 #xE42D)
- (#xf6c5 #xE42E)
- (#xf6c6 #xE42F)
- (#xf6c7 #xE430)
- (#xf6c8 #xE431)
- (#xf6c9 #xE432)
- (#xf6ca #xE433)
- (#xf6cb #xE434)
- (#xf6cc #xE435)
- (#xf6cd #xE436)
- (#xf6ce #xE437)
- (#xf6cf #xE438)
- (#xf6d0 #xE439)
- (#xf6d1 #xE43A)
- (#xf6d2 #xE43B)
- (#xf6d3 #xE43C)
- (#xf6d4 #xE43D)
- (#xf6d5 #xE43E)
- (#xf6d6 #xE43F)
- (#xf6d7 #xE440)
- (#xf6d8 #xE441)
- (#xf6d9 #xE442)
- (#xf6da #xE443)
- (#xf6db #xE444)
- (#xf6dc #xE445)
- (#xf6dd #xE446)
- (#xf6de #xE447)
- (#xf6df #xE448)
- (#xf6e0 #xE449)
- (#xf6e1 #xE44A)
- (#xf6e2 #xE44B)
- (#xf6e3 #xE44C)
- (#xf6e4 #xE44D)
- (#xf6e5 #xE44E)
- (#xf6e6 #xE44F)
- (#xf6e7 #xE450)
- (#xf6e8 #xE451)
- (#xf6e9 #xE452)
- (#xf6ea #xE453)
- (#xf6eb #xE454)
- (#xf6ec #xE455)
- (#xf6ed #xE456)
- (#xf6ee #xE457)
- (#xf6ef #xE458)
- (#xf6f0 #xE459)
- (#xf6f1 #xE45A)
- (#xf6f2 #xE45B)
- (#xf6f3 #xE45C)
- (#xf6f4 #xE45D)
- (#xf6f5 #xE45E)
- (#xf6f6 #xE45F)
- (#xf6f7 #xE460)
- (#xf6f8 #xE461)
- (#xf6f9 #xE462)
- (#xf6fa #xE463)
- (#xf6fb #xE464)
- (#xf6fc #xE465)
- (#xf6fd #xE466)
- (#xf6fe #xE467)
- (#xf7a1 #xE468)
- (#xf7a2 #xE469)
- (#xf7a3 #xE46A)
- (#xf7a4 #xE46B)
- (#xf7a5 #xE46C)
- (#xf7a6 #xE46D)
- (#xf7a7 #xE46E)
- (#xf7a8 #xE46F)
- (#xf7a9 #xE470)
- (#xf7aa #xE471)
- (#xf7ab #xE472)
- (#xf7ac #xE473)
- (#xf7ad #xE474)
- (#xf7ae #xE475)
- (#xf7af #xE476)
- (#xf7b0 #xE477)
- (#xf7b1 #xE478)
- (#xf7b2 #xE479)
- (#xf7b3 #xE47A)
- (#xf7b4 #xE47B)
- (#xf7b5 #xE47C)
- (#xf7b6 #xE47D)
- (#xf7b7 #xE47E)
- (#xf7b8 #xE47F)
- (#xf7b9 #xE480)
- (#xf7ba #xE481)
- (#xf7bb #xE482)
- (#xf7bc #xE483)
- (#xf7bd #xE484)
- (#xf7be #xE485)
- (#xf7bf #xE486)
- (#xf7c0 #xE487)
- (#xf7c1 #xE488)
- (#xf7c2 #xE489)
- (#xf7c3 #xE48A)
- (#xf7c4 #xE48B)
- (#xf7c5 #xE48C)
- (#xf7c6 #xE48D)
- (#xf7c7 #xE48E)
- (#xf7c8 #xE48F)
- (#xf7c9 #xE490)
- (#xf7ca #xE491)
- (#xf7cb #xE492)
- (#xf7cc #xE493)
- (#xf7cd #xE494)
- (#xf7ce #xE495)
- (#xf7cf #xE496)
- (#xf7d0 #xE497)
- (#xf7d1 #xE498)
- (#xf7d2 #xE499)
- (#xf7d3 #xE49A)
- (#xf7d4 #xE49B)
- (#xf7d5 #xE49C)
- (#xf7d6 #xE49D)
- (#xf7d7 #xE49E)
- (#xf7d8 #xE49F)
- (#xf7d9 #xE4A0)
- (#xf7da #xE4A1)
- (#xf7db #xE4A2)
- (#xf7dc #xE4A3)
- (#xf7dd #xE4A4)
- (#xf7de #xE4A5)
- (#xf7df #xE4A6)
- (#xf7e0 #xE4A7)
- (#xf7e1 #xE4A8)
- (#xf7e2 #xE4A9)
- (#xf7e3 #xE4AA)
- (#xf7e4 #xE4AB)
- (#xf7e5 #xE4AC)
- (#xf7e6 #xE4AD)
- (#xf7e7 #xE4AE)
- (#xf7e8 #xE4AF)
- (#xf7e9 #xE4B0)
- (#xf7ea #xE4B1)
- (#xf7eb #xE4B2)
- (#xf7ec #xE4B3)
- (#xf7ed #xE4B4)
- (#xf7ee #xE4B5)
- (#xf7ef #xE4B6)
- (#xf7f0 #xE4B7)
- (#xf7f1 #xE4B8)
- (#xf7f2 #xE4B9)
- (#xf7f3 #xE4BA)
- (#xf7f4 #xE4BB)
- (#xf7f5 #xE4BC)
- (#xf7f6 #xE4BD)
- (#xf7f7 #xE4BE)
- (#xf7f8 #xE4BF)
- (#xf7f9 #xE4C0)
- (#xf7fa #xE4C1)
- (#xf7fb #xE4C2)
- (#xf7fc #xE4C3)
- (#xf7fd #xE4C4)
- (#xf7fe #xE4C5)
- (#xf8a1 #xE4C6)
- (#xf8a2 #xE4C7)
- (#xf8a3 #xE4C8)
- (#xf8a4 #xE4C9)
- (#xf8a5 #xE4CA)
- (#xf8a6 #xE4CB)
- (#xf8a7 #xE4CC)
- (#xf8a8 #xE4CD)
- (#xf8a9 #xE4CE)
- (#xf8aa #xE4CF)
- (#xf8ab #xE4D0)
- (#xf8ac #xE4D1)
- (#xf8ad #xE4D2)
- (#xf8ae #xE4D3)
- (#xf8af #xE4D4)
- (#xf8b0 #xE4D5)
- (#xf8b1 #xE4D6)
- (#xf8b2 #xE4D7)
- (#xf8b3 #xE4D8)
- (#xf8b4 #xE4D9)
- (#xf8b5 #xE4DA)
- (#xf8b6 #xE4DB)
- (#xf8b7 #xE4DC)
- (#xf8b8 #xE4DD)
- (#xf8b9 #xE4DE)
- (#xf8ba #xE4DF)
- (#xf8bb #xE4E0)
- (#xf8bc #xE4E1)
- (#xf8bd #xE4E2)
- (#xf8be #xE4E3)
- (#xf8bf #xE4E4)
- (#xf8c0 #xE4E5)
- (#xf8c1 #xE4E6)
- (#xf8c2 #xE4E7)
- (#xf8c3 #xE4E8)
- (#xf8c4 #xE4E9)
- (#xf8c5 #xE4EA)
- (#xf8c6 #xE4EB)
- (#xf8c7 #xE4EC)
- (#xf8c8 #xE4ED)
- (#xf8c9 #xE4EE)
- (#xf8ca #xE4EF)
- (#xf8cb #xE4F0)
- (#xf8cc #xE4F1)
- (#xf8cd #xE4F2)
- (#xf8ce #xE4F3)
- (#xf8cf #xE4F4)
- (#xf8d0 #xE4F5)
- (#xf8d1 #xE4F6)
- (#xf8d2 #xE4F7)
- (#xf8d3 #xE4F8)
- (#xf8d4 #xE4F9)
- (#xf8d5 #xE4FA)
- (#xf8d6 #xE4FB)
- (#xf8d7 #xE4FC)
- (#xf8d8 #xE4FD)
- (#xf8d9 #xE4FE)
- (#xf8da #xE4FF)
- (#xf8db #xE500)
- (#xf8dc #xE501)
- (#xf8dd #xE502)
- (#xf8de #xE503)
- (#xf8df #xE504)
- (#xf8e0 #xE505)
- (#xf8e1 #xE506)
- (#xf8e2 #xE507)
- (#xf8e3 #xE508)
- (#xf8e4 #xE509)
- (#xf8e5 #xE50A)
- (#xf8e6 #xE50B)
- (#xf8e7 #xE50C)
- (#xf8e8 #xE50D)
- (#xf8e9 #xE50E)
- (#xf8ea #xE50F)
- (#xf8eb #xE510)
- (#xf8ec #xE511)
- (#xf8ed #xE512)
- (#xf8ee #xE513)
- (#xf8ef #xE514)
- (#xf8f0 #xE515)
- (#xf8f1 #xE516)
- (#xf8f2 #xE517)
- (#xf8f3 #xE518)
- (#xf8f4 #xE519)
- (#xf8f5 #xE51A)
- (#xf8f6 #xE51B)
- (#xf8f7 #xE51C)
- (#xf8f8 #xE51D)
- (#xf8f9 #xE51E)
- (#xf8fa #xE51F)
- (#xf8fb #xE520)
- (#xf8fc #xE521)
- (#xf8fd #xE522)
- (#xf8fe #xE523)
- (#xf9a1 #xE524)
- (#xf9a2 #xE525)
- (#xf9a3 #xE526)
- (#xf9a4 #xE527)
- (#xf9a5 #xE528)
- (#xf9a6 #xE529)
- (#xf9a7 #xE52A)
- (#xf9a8 #xE52B)
- (#xf9a9 #xE52C)
- (#xf9aa #xE52D)
- (#xf9ab #xE52E)
- (#xf9ac #xE52F)
- (#xf9ad #xE530)
- (#xf9ae #xE531)
- (#xf9af #xE532)
- (#xf9b0 #xE533)
- (#xf9b1 #xE534)
- (#xf9b2 #xE535)
- (#xf9b3 #xE536)
- (#xf9b4 #xE537)
- (#xf9b5 #xE538)
- (#xf9b6 #xE539)
- (#xf9b7 #xE53A)
- (#xf9b8 #xE53B)
- (#xf9b9 #xE53C)
- (#xf9ba #xE53D)
- (#xf9bb #xE53E)
- (#xf9bc #xE53F)
- (#xf9bd #xE540)
- (#xf9be #xE541)
- (#xf9bf #xE542)
- (#xf9c0 #xE543)
- (#xf9c1 #xE544)
- (#xf9c2 #xE545)
- (#xf9c3 #xE546)
- (#xf9c4 #xE547)
- (#xf9c5 #xE548)
- (#xf9c6 #xE549)
- (#xf9c7 #xE54A)
- (#xf9c8 #xE54B)
- (#xf9c9 #xE54C)
- (#xf9ca #xE54D)
- (#xf9cb #xE54E)
- (#xf9cc #xE54F)
- (#xf9cd #xE550)
- (#xf9ce #xE551)
- (#xf9cf #xE552)
- (#xf9d0 #xE553)
- (#xf9d1 #xE554)
- (#xf9d2 #xE555)
- (#xf9d3 #xE556)
- (#xf9d4 #xE557)
- (#xf9d5 #xE558)
- (#xf9d6 #xE559)
- (#xf9d7 #xE55A)
- (#xf9d8 #xE55B)
- (#xf9d9 #xE55C)
- (#xf9da #xE55D)
- (#xf9db #xE55E)
- (#xf9dc #xE55F)
- (#xf9dd #xE560)
- (#xf9de #xE561)
- (#xf9df #xE562)
- (#xf9e0 #xE563)
- (#xf9e1 #xE564)
- (#xf9e2 #xE565)
- (#xf9e3 #xE566)
- (#xf9e4 #xE567)
- (#xf9e5 #xE568)
- (#xf9e6 #xE569)
- (#xf9e7 #xE56A)
- (#xf9e8 #xE56B)
- (#xf9e9 #xE56C)
- (#xf9ea #xE56D)
- (#xf9eb #xE56E)
- (#xf9ec #xE56F)
- (#xf9ed #xE570)
- (#xf9ee #xE571)
- (#xf9ef #xE572)
- (#xf9f0 #xE573)
- (#xf9f1 #xE574)
- (#xf9f2 #xE575)
- (#xf9f3 #xE576)
- (#xf9f4 #xE577)
- (#xf9f5 #xE578)
- (#xf9f6 #xE579)
- (#xf9f7 #xE57A)
- (#xf9f8 #xE57B)
- (#xf9f9 #xE57C)
- (#xf9fa #xE57D)
- (#xf9fb #xE57E)
- (#xf9fc #xE57F)
- (#xf9fd #xE580)
- (#xf9fe #xE581)
- (#xfaa1 #xE582)
- (#xfaa2 #xE583)
- (#xfaa3 #xE584)
- (#xfaa4 #xE585)
- (#xfaa5 #xE586)
- (#xfaa6 #xE587)
- (#xfaa7 #xE588)
- (#xfaa8 #xE589)
- (#xfaa9 #xE58A)
- (#xfaaa #xE58B)
- (#xfaab #xE58C)
- (#xfaac #xE58D)
- (#xfaad #xE58E)
- (#xfaae #xE58F)
- (#xfaaf #xE590)
- (#xfab0 #xE591)
- (#xfab1 #xE592)
- (#xfab2 #xE593)
- (#xfab3 #xE594)
- (#xfab4 #xE595)
- (#xfab5 #xE596)
- (#xfab6 #xE597)
- (#xfab7 #xE598)
- (#xfab8 #xE599)
- (#xfab9 #xE59A)
- (#xfaba #xE59B)
- (#xfabb #xE59C)
- (#xfabc #xE59D)
- (#xfabd #xE59E)
- (#xfabe #xE59F)
- (#xfabf #xE5A0)
- (#xfac0 #xE5A1)
- (#xfac1 #xE5A2)
- (#xfac2 #xE5A3)
- (#xfac3 #xE5A4)
- (#xfac4 #xE5A5)
- (#xfac5 #xE5A6)
- (#xfac6 #xE5A7)
- (#xfac7 #xE5A8)
- (#xfac8 #xE5A9)
- (#xfac9 #xE5AA)
- (#xfaca #xE5AB)
- (#xfacb #xE5AC)
- (#xfacc #xE5AD)
- (#xfacd #xE5AE)
- (#xface #xE5AF)
- (#xfacf #xE5B0)
- (#xfad0 #xE5B1)
- (#xfad1 #xE5B2)
- (#xfad2 #xE5B3)
- (#xfad3 #xE5B4)
- (#xfad4 #xE5B5)
- (#xfad5 #xE5B6)
- (#xfad6 #xE5B7)
- (#xfad7 #xE5B8)
- (#xfad8 #xE5B9)
- (#xfad9 #xE5BA)
- (#xfada #xE5BB)
- (#xfadb #xE5BC)
- (#xfadc #xE5BD)
- (#xfadd #xE5BE)
- (#xfade #xE5BF)
- (#xfadf #xE5C0)
- (#xfae0 #xE5C1)
- (#xfae1 #xE5C2)
- (#xfae2 #xE5C3)
- (#xfae3 #xE5C4)
- (#xfae4 #xE5C5)
- (#xfae5 #xE5C6)
- (#xfae6 #xE5C7)
- (#xfae7 #xE5C8)
- (#xfae8 #xE5C9)
- (#xfae9 #xE5CA)
- (#xfaea #xE5CB)
- (#xfaeb #xE5CC)
- (#xfaec #xE5CD)
- (#xfaed #xE5CE)
- (#xfaee #xE5CF)
- (#xfaef #xE5D0)
- (#xfaf0 #xE5D1)
- (#xfaf1 #xE5D2)
- (#xfaf2 #xE5D3)
- (#xfaf3 #xE5D4)
- (#xfaf4 #xE5D5)
- (#xfaf5 #xE5D6)
- (#xfaf6 #xE5D7)
- (#xfaf7 #xE5D8)
- (#xfaf8 #xE5D9)
- (#xfaf9 #xE5DA)
- (#xfafa #xE5DB)
- (#xfafb #xE5DC)
- (#xfafc #xE5DD)
- (#xfafd #xE5DE)
- (#xfafe #xE5DF)
- (#xfba1 #xE5E0)
- (#xfba2 #xE5E1)
- (#xfba3 #xE5E2)
- (#xfba4 #xE5E3)
- (#xfba5 #xE5E4)
- (#xfba6 #xE5E5)
- (#xfba7 #xE5E6)
- (#xfba8 #xE5E7)
- (#xfba9 #xE5E8)
- (#xfbaa #xE5E9)
- (#xfbab #xE5EA)
- (#xfbac #xE5EB)
- (#xfbad #xE5EC)
- (#xfbae #xE5ED)
- (#xfbaf #xE5EE)
- (#xfbb0 #xE5EF)
- (#xfbb1 #xE5F0)
- (#xfbb2 #xE5F1)
- (#xfbb3 #xE5F2)
- (#xfbb4 #xE5F3)
- (#xfbb5 #xE5F4)
- (#xfbb6 #xE5F5)
- (#xfbb7 #xE5F6)
- (#xfbb8 #xE5F7)
- (#xfbb9 #xE5F8)
- (#xfbba #xE5F9)
- (#xfbbb #xE5FA)
- (#xfbbc #xE5FB)
- (#xfbbd #xE5FC)
- (#xfbbe #xE5FD)
- (#xfbbf #xE5FE)
- (#xfbc0 #xE5FF)
- (#xfbc1 #xE600)
- (#xfbc2 #xE601)
- (#xfbc3 #xE602)
- (#xfbc4 #xE603)
- (#xfbc5 #xE604)
- (#xfbc6 #xE605)
- (#xfbc7 #xE606)
- (#xfbc8 #xE607)
- (#xfbc9 #xE608)
- (#xfbca #xE609)
- (#xfbcb #xE60A)
- (#xfbcc #xE60B)
- (#xfbcd #xE60C)
- (#xfbce #xE60D)
- (#xfbcf #xE60E)
- (#xfbd0 #xE60F)
- (#xfbd1 #xE610)
- (#xfbd2 #xE611)
- (#xfbd3 #xE612)
- (#xfbd4 #xE613)
- (#xfbd5 #xE614)
- (#xfbd6 #xE615)
- (#xfbd7 #xE616)
- (#xfbd8 #xE617)
- (#xfbd9 #xE618)
- (#xfbda #xE619)
- (#xfbdb #xE61A)
- (#xfbdc #xE61B)
- (#xfbdd #xE61C)
- (#xfbde #xE61D)
- (#xfbdf #xE61E)
- (#xfbe0 #xE61F)
- (#xfbe1 #xE620)
- (#xfbe2 #xE621)
- (#xfbe3 #xE622)
- (#xfbe4 #xE623)
- (#xfbe5 #xE624)
- (#xfbe6 #xE625)
- (#xfbe7 #xE626)
- (#xfbe8 #xE627)
- (#xfbe9 #xE628)
- (#xfbea #xE629)
- (#xfbeb #xE62A)
- (#xfbec #xE62B)
- (#xfbed #xE62C)
- (#xfbee #xE62D)
- (#xfbef #xE62E)
- (#xfbf0 #xE62F)
- (#xfbf1 #xE630)
- (#xfbf2 #xE631)
- (#xfbf3 #xE632)
- (#xfbf4 #xE633)
- (#xfbf5 #xE634)
- (#xfbf6 #xE635)
- (#xfbf7 #xE636)
- (#xfbf8 #xE637)
- (#xfbf9 #xE638)
- (#xfbfa #xE639)
- (#xfbfb #xE63A)
- (#xfbfc #xE63B)
- (#xfbfd #xE63C)
- (#xfbfe #xE63D)
- (#xfca1 #xE63E)
- (#xfca2 #xE63F)
- (#xfca3 #xE640)
- (#xfca4 #xE641)
- (#xfca5 #xE642)
- (#xfca6 #xE643)
- (#xfca7 #xE644)
- (#xfca8 #xE645)
- (#xfca9 #xE646)
- (#xfcaa #xE647)
- (#xfcab #xE648)
- (#xfcac #xE649)
- (#xfcad #xE64A)
- (#xfcae #xE64B)
- (#xfcaf #xE64C)
- (#xfcb0 #xE64D)
- (#xfcb1 #xE64E)
- (#xfcb2 #xE64F)
- (#xfcb3 #xE650)
- (#xfcb4 #xE651)
- (#xfcb5 #xE652)
- (#xfcb6 #xE653)
- (#xfcb7 #xE654)
- (#xfcb8 #xE655)
- (#xfcb9 #xE656)
- (#xfcba #xE657)
- (#xfcbb #xE658)
- (#xfcbc #xE659)
- (#xfcbd #xE65A)
- (#xfcbe #xE65B)
- (#xfcbf #xE65C)
- (#xfcc0 #xE65D)
- (#xfcc1 #xE65E)
- (#xfcc2 #xE65F)
- (#xfcc3 #xE660)
- (#xfcc4 #xE661)
- (#xfcc5 #xE662)
- (#xfcc6 #xE663)
- (#xfcc7 #xE664)
- (#xfcc8 #xE665)
- (#xfcc9 #xE666)
- (#xfcca #xE667)
- (#xfccb #xE668)
- (#xfccc #xE669)
- (#xfccd #xE66A)
- (#xfcce #xE66B)
- (#xfccf #xE66C)
- (#xfcd0 #xE66D)
- (#xfcd1 #xE66E)
- (#xfcd2 #xE66F)
- (#xfcd3 #xE670)
- (#xfcd4 #xE671)
- (#xfcd5 #xE672)
- (#xfcd6 #xE673)
- (#xfcd7 #xE674)
- (#xfcd8 #xE675)
- (#xfcd9 #xE676)
- (#xfcda #xE677)
- (#xfcdb #xE678)
- (#xfcdc #xE679)
- (#xfcdd #xE67A)
- (#xfcde #xE67B)
- (#xfcdf #xE67C)
- (#xfce0 #xE67D)
- (#xfce1 #xE67E)
- (#xfce2 #xE67F)
- (#xfce3 #xE680)
- (#xfce4 #xE681)
- (#xfce5 #xE682)
- (#xfce6 #xE683)
- (#xfce7 #xE684)
- (#xfce8 #xE685)
- (#xfce9 #xE686)
- (#xfcea #xE687)
- (#xfceb #xE688)
- (#xfcec #xE689)
- (#xfced #xE68A)
- (#xfcee #xE68B)
- (#xfcef #xE68C)
- (#xfcf0 #xE68D)
- (#xfcf1 #xE68E)
- (#xfcf2 #xE68F)
- (#xfcf3 #xE690)
- (#xfcf4 #xE691)
- (#xfcf5 #xE692)
- (#xfcf6 #xE693)
- (#xfcf7 #xE694)
- (#xfcf8 #xE695)
- (#xfcf9 #xE696)
- (#xfcfa #xE697)
- (#xfcfb #xE698)
- (#xfcfc #xE699)
- (#xfcfd #xE69A)
- (#xfcfe #xE69B)
- (#xfda1 #xE69C)
- (#xfda2 #xE69D)
- (#xfda3 #xE69E)
- (#xfda4 #xE69F)
- (#xfda5 #xE6A0)
- (#xfda6 #xE6A1)
- (#xfda7 #xE6A2)
- (#xfda8 #xE6A3)
- (#xfda9 #xE6A4)
- (#xfdaa #xE6A5)
- (#xfdab #xE6A6)
- (#xfdac #xE6A7)
- (#xfdad #xE6A8)
- (#xfdae #xE6A9)
- (#xfdaf #xE6AA)
- (#xfdb0 #xE6AB)
- (#xfdb1 #xE6AC)
- (#xfdb2 #xE6AD)
- (#xfdb3 #xE6AE)
- (#xfdb4 #xE6AF)
- (#xfdb5 #xE6B0)
- (#xfdb6 #xE6B1)
- (#xfdb7 #xE6B2)
- (#xfdb8 #xE6B3)
- (#xfdb9 #xE6B4)
- (#xfdba #xE6B5)
- (#xfdbb #xE6B6)
- (#xfdbc #xE6B7)
- (#xfdbd #xE6B8)
- (#xfdbe #xE6B9)
- (#xfdbf #xE6BA)
- (#xfdc0 #xE6BB)
- (#xfdc1 #xE6BC)
- (#xfdc2 #xE6BD)
- (#xfdc3 #xE6BE)
- (#xfdc4 #xE6BF)
- (#xfdc5 #xE6C0)
- (#xfdc6 #xE6C1)
- (#xfdc7 #xE6C2)
- (#xfdc8 #xE6C3)
- (#xfdc9 #xE6C4)
- (#xfdca #xE6C5)
- (#xfdcb #xE6C6)
- (#xfdcc #xE6C7)
- (#xfdcd #xE6C8)
- (#xfdce #xE6C9)
- (#xfdcf #xE6CA)
- (#xfdd0 #xE6CB)
- (#xfdd1 #xE6CC)
- (#xfdd2 #xE6CD)
- (#xfdd3 #xE6CE)
- (#xfdd4 #xE6CF)
- (#xfdd5 #xE6D0)
- (#xfdd6 #xE6D1)
- (#xfdd7 #xE6D2)
- (#xfdd8 #xE6D3)
- (#xfdd9 #xE6D4)
- (#xfdda #xE6D5)
- (#xfddb #xE6D6)
- (#xfddc #xE6D7)
- (#xfddd #xE6D8)
- (#xfdde #xE6D9)
- (#xfddf #xE6DA)
- (#xfde0 #xE6DB)
- (#xfde1 #xE6DC)
- (#xfde2 #xE6DD)
- (#xfde3 #xE6DE)
- (#xfde4 #xE6DF)
- (#xfde5 #xE6E0)
- (#xfde6 #xE6E1)
- (#xfde7 #xE6E2)
- (#xfde8 #xE6E3)
- (#xfde9 #xE6E4)
- (#xfdea #xE6E5)
- (#xfdeb #xE6E6)
- (#xfdec #xE6E7)
- (#xfded #xE6E8)
- (#xfdee #xE6E9)
- (#xfdef #xE6EA)
- (#xfdf0 #xE6EB)
- (#xfdf1 #xE6EC)
- (#xfdf2 #xE6ED)
- (#xfdf3 #xE6EE)
- (#xfdf4 #xE6EF)
- (#xfdf5 #xE6F0)
- (#xfdf6 #xE6F1)
- (#xfdf7 #xE6F2)
- (#xfdf8 #xE6F3)
- (#xfdf9 #xE6F4)
- (#xfdfa #xE6F5)
- (#xfdfb #xE6F6)
- (#xfdfc #xE6F7)
- (#xfdfd #xE6F8)
- (#xfdfe #xE6F9)
- (#xfea1 #xE6FA)
- (#xfea2 #xE6FB)
- (#xfea3 #xE6FC)
- (#xfea4 #xE6FD)
- (#xfea5 #xE6FE)
- (#xfea6 #xE6FF)
- (#xfea7 #xE700)
- (#xfea8 #xE701)
- (#xfea9 #xE702)
- (#xfeaa #xE703)
- (#xfeab #xE704)
- (#xfeac #xE705)
- (#xfead #xE706)
- (#xfeae #xE707)
- (#xfeaf #xE708)
- (#xfeb0 #xE709)
- (#xfeb1 #xE70A)
- (#xfeb2 #xE70B)
- (#xfeb3 #xE70C)
- (#xfeb4 #xE70D)
- (#xfeb5 #xE70E)
- (#xfeb6 #xE70F)
- (#xfeb7 #xE710)
- (#xfeb8 #xE711)
- (#xfeb9 #xE712)
- (#xfeba #xE713)
- (#xfebb #xE714)
- (#xfebc #xE715)
- (#xfebd #xE716)
- (#xfebe #xE717)
- (#xfebf #xE718)
- (#xfec0 #xE719)
- (#xfec1 #xE71A)
- (#xfec2 #xE71B)
- (#xfec3 #xE71C)
- (#xfec4 #xE71D)
- (#xfec5 #xE71E)
- (#xfec6 #xE71F)
- (#xfec7 #xE720)
- (#xfec8 #xE721)
- (#xfec9 #xE722)
- (#xfeca #xE723)
- (#xfecb #xE724)
- (#xfecc #xE725)
- (#xfecd #xE726)
- (#xfece #xE727)
- (#xfecf #xE728)
- (#xfed0 #xE729)
- (#xfed1 #xE72A)
- (#xfed2 #xE72B)
- (#xfed3 #xE72C)
- (#xfed4 #xE72D)
- (#xfed5 #xE72E)
- (#xfed6 #xE72F)
- (#xfed7 #xE730)
- (#xfed8 #xE731)
- (#xfed9 #xE732)
- (#xfeda #xE733)
- (#xfedb #xE734)
- (#xfedc #xE735)
- (#xfedd #xE736)
- (#xfede #xE737)
- (#xfedf #xE738)
- (#xfee0 #xE739)
- (#xfee1 #xE73A)
- (#xfee2 #xE73B)
- (#xfee3 #xE73C)
- (#xfee4 #xE73D)
- (#xfee5 #xE73E)
- (#xfee6 #xE73F)
- (#xfee7 #xE740)
- (#xfee8 #xE741)
- (#xfee9 #xE742)
- (#xfeea #xE743)
- (#xfeeb #xE744)
- (#xfeec #xE745)
- (#xfeed #xE746)
- (#xfeee #xE747)
- (#xfeef #xE748)
- (#xfef0 #xE749)
- (#xfef1 #xE74A)
- (#xfef2 #xE74B)
- (#xfef3 #xE74C)
- (#xfef4 #xE74D)
- (#xfef5 #xE74E)
- (#xfef6 #xE74F)
- (#xfef7 #xE750)
- (#xfef8 #xE751)
- (#xfef9 #xE752)
- (#xfefa #xE753)
- (#xfefb #xE754)
- (#xfefc #xE755)
- (#xfefd #xE756)
- (#xfefe #xE757))))
- (mapc #'(lambda (x)
- (let ((code (logand (car x) #x7F7F)))
- (if (integerp (cdr x))
- (setcar x (decode-char 'japanese-jisx0208 code))
- (setcar x (decode-char 'japanese-jisx0212 code))
- (setcdr x (cadr x)))))
- map)
- (define-translation-table 'eucjp-ms-decode map)
- (mapc #'(lambda (x)
- (let ((tmp (car x)))
- (setcar x (cdr x)) (setcdr x tmp)))
- map)
- (define-translation-table 'eucjp-ms-encode map))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 324d615c581..cdbaade73ab 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -1,6 +1,6 @@
;;; fontset.el --- commands for handling fontset
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -153,6 +153,7 @@
(cyrillic #x42F)
(armenian #x531)
(hebrew #x5D0)
+ (vai #xA500)
(arabic #x628)
(syriac #x710)
(thaana #x78C)
@@ -197,93 +198,165 @@
(phaistos-disc #x101D0)
(lycian #x10280)
(carian #x102A0)
- (olt-italic #x10300)
+ (old-italic #x10300)
(ugaritic #x10380)
+ (old-permic #x10350)
(old-persian #x103A0)
(deseret #x10400)
(shavian #x10450)
(osmanya #x10480)
+ (elbasan #x10500)
+ (caucasian-albanian #x10530)
+ (linear-a #x10600)
(cypriot-syllabary #x10800)
+ (palmyrene #x10860)
+ (nabataean #x10880)
(phoenician #x10900)
(lydian #x10920)
(kharoshthi #x10A00)
+ (manichaean #x10AC0)
+ (mahajani #x11150)
+ (sinhala-archaic-number #x111E1)
+ (khojki #x11200)
+ (khudawadi #x112B0)
+ (grantha #x11305)
+ (tirhuta #x11481)
+ (siddham #x11580)
+ (modi #x11600)
+ (takri #x11680)
+ (warang-citi #x118A1)
+ (pau-cin-hau #x11AC0)
(cuneiform #x12000)
(cuneiform-numbers-and-punctuation #x12400)
+ (mro #x16A40)
+ (bassa-vah #x16AD0)
+ (pahawh-hmong #x16B11)
+ (duployan-shorthand #x1BC20)
(byzantine-musical-symbol #x1D000)
(musical-symbol #x1D100)
(ancient-greek-musical-notation #x1D200)
(tai-xuan-jing-symbol #x1D300)
(counting-rod-numeral #x1D360)
+ (mende-kikakui #x1E810)
(mahjong-tile #x1F000)
(domino-tile #x1F030)))
(defvar otf-script-alist)
+;; The below was synchronized with the latest Jan 3, 2013 version of
+;; https://www.microsoft.com/typography/otspec/scripttags.htm.
(setq otf-script-alist
'((arab . arabic)
+ (armi . aramaic)
(armn . armenian)
+ (avst . avestan)
(bali . balinese)
+ (bamu . bamum)
+ (batk . batak)
+ (bng2 . bengali)
(beng . bengali)
(bopo . bopomofo)
(brai . braille)
+ (brah . brahmi)
(bugi . buginese)
(buhd . buhid)
(byzm . byzantine-musical-symbol)
(cans . canadian-aboriginal)
+ (cari . carian)
+ (cakm . chakma)
+ (cham . cham)
(cher . cherokee)
(copt . coptic)
(xsux . cuneiform)
- (cyrl . cyrillic)
(cprt . cypriot)
+ (cyrl . cyrillic)
(dsrt . deseret)
(deva . devanagari)
+ (dev2 . devanagari)
+ (egyp . egyptian)
(ethi . ethiopic)
(geor . georgian)
(glag . glagolitic)
(goth . gothic)
(grek . greek)
(gujr . gujarati)
+ (gjr2 . gujarati)
(guru . gurmukhi)
+ (gur2 . gurmukhi)
(hani . han)
(hang . hangul)
+ (jamo . hangul)
(hano . hanunoo)
(hebr . hebrew)
- (kana . kana)
+ (phli . inscriptional-pahlavi)
+ (prti . inscriptional-parthian)
+ (java . javanese)
+ (kthi . kaithi)
+ (kana . kana) ; Hiragana
(knda . kannada)
+ (knd2 . kannada)
+ (kali . kayah-li)
(khar . kharoshthi)
(khmr . khmer)
(lao\ . lao)
(latn . latin)
+ (lepc . lepcha)
(limb . limbu)
(linb . linear_b)
+ (lisu . lisu)
+ (lyci . lycian)
+ (lydi . lydian)
(mlym . malayalam)
+ (mlm2 . malayalam)
+ (mand . mandaic)
(math . mathematical)
+ (mtei . meetei-mayek)
+ (merc . meroitic)
+ (mero . meroitic)
(mong . mongolian)
(musc . musical-symbol)
+ (mym2 . burmese)
(mymr . burmese)
(nko\ . nko)
(ogam . ogham)
+ (olck . ol-chiki)
(ital . old_italic)
(xpeo . old_persian)
+ (sarb . old-south-arabian)
+ (orkh . old-turkic)
(orya . oriya)
+ (ory2 . oriya)
(osma . osmanya)
(phag . phags-pa)
(phnx . phoenician)
+ (rjng . rejang)
(runr . runic)
+ (samr . samaritan)
+ (saur . saurashtra)
+ (shrd . sharada)
(shaw . shavian)
(sinh . sinhala)
+ (sora . sora-sompeng)
+ (sund . sundanese)
(sylo . syloti_nagri)
(syrc . syriac)
(tglg . tagalog)
(tagb . tagbanwa)
- (taml . tamil)
(tale . tai_le)
+ (talu . tai-lue)
+ (lana . tai-tham)
+ (tavt . tai-viet)
+ (takr . takri)
+ (taml . tamil)
+ (tml2 . tamil)
(telu . telugu)
+ (tel2 . telugu)
(thaa . thaana)
(thai . thai)
(tibt . tibetan)
(tfng . tifinagh)
(ugar . ugaritic)
+ (vai\ . vai)
(yi\ \ . yi)))
;; Set standard fontname specification of characters in the default
@@ -312,7 +385,7 @@
(eval-when-compile
-;; Build a data to initialize the default fontset at compile time to
+;; Build data to initialize the default fontset at compile time to
;; avoid loading charsets that won't be necessary at runtime.
;; The value is (CJK-REGISTRY-VECTOR TARGET-SPEC ...), where
@@ -403,19 +476,29 @@
(nil . "TIS620*")
(nil . "ISO8859-11"))
- (devanagari ,(font-spec :registry "iso10646-1" :otf '(deva nil (rphf)))
+ (devanagari ,(font-spec :registry "iso10646-1" :otf '(dev2 nil (rphf)))
+ ,(font-spec :registry "iso10646-1" :otf '(deva nil (rphf)))
(nil . "iso10646.indian-1"))
- (bengali ,(font-spec :registry "iso10646-1" :otf '(beng nil (rphf))))
- (gurmukhi ,(font-spec :registry "iso10646-1" :otf '(guru nil (blwf))))
- (gujarati ,(font-spec :registry "iso10646-1" :otf '(gujr nil (rphf))))
- (oriya ,(font-spec :registry "iso10646-1" :otf '(orya nil (rphf))))
- (tamil ,(font-spec :registry "iso10646-1" :otf '(taml nil (akhn))))
- (telugu ,(font-spec :registry "iso10646-1" :otf '(telu nil (blwf))))
- (kannada ,(font-spec :registry "iso10646-1" :otf '(knda nil (rphf))))
+ (bengali ,(font-spec :registry "iso10646-1" :otf '(bng2 nil (rphf)))
+ ,(font-spec :registry "iso10646-1" :otf '(beng nil (rphf))))
+ (gurmukhi ,(font-spec :registry "iso10646-1" :otf '(gur2 nil (blwf)))
+ ,(font-spec :registry "iso10646-1" :otf '(guru nil (blwf))))
+ (gujarati ,(font-spec :registry "iso10646-1" :otf '(gjr2 nil (rphf)))
+ ,(font-spec :registry "iso10646-1" :otf '(gujr nil (rphf))))
+ (oriya ,(font-spec :registry "iso10646-1" :otf '(ory2 nil (rphf)))
+ ,(font-spec :registry "iso10646-1" :otf '(orya nil (rphf))))
+ (tamil ,(font-spec :registry "iso10646-1" :otf '(tml2 nil (akhn)))
+ ,(font-spec :registry "iso10646-1" :otf '(taml nil (akhn))))
+ (telugu ,(font-spec :registry "iso10646-1" :otf '(tel2 nil (blwf)))
+ ,(font-spec :registry "iso10646-1" :otf '(telu nil (blwf))))
+ (kannada ,(font-spec :registry "iso10646-1" :otf '(knd2 nil (rphf)))
+ ,(font-spec :registry "iso10646-1" :otf '(knda nil (rphf))))
(sinhala ,(font-spec :registry "iso10646-1" :otf '(sinh nil (akhn))))
- (malayalam ,(font-spec :registry "iso10646-1" :otf '(mlym nil (akhn))))
+ (malayalam ,(font-spec :registry "iso10646-1" :otf '(mlm2 nil (akhn)))
+ ,(font-spec :registry "iso10646-1" :otf '(mlym nil (akhn))))
- (burmese ,(font-spec :registry "iso10646-1" :otf '(mymr nil nil))
+ (burmese ,(font-spec :registry "iso10646-1" :otf '(mym2 nil nil))
+ ,(font-spec :registry "iso10646-1" :otf '(mymr nil nil))
,(font-spec :registry "iso10646-1" :script 'burmese))
(lao ,(font-spec :registry "iso10646-1" :otf '(lao\ nil nil (mark)))
@@ -565,7 +648,7 @@
phaistos-disc
lycian
carian
- olt-italic
+ old-italic
ugaritic
old-persian
deseret
@@ -625,6 +708,96 @@
(cons (car math-subgroup) (nth 1 math-subgroup))
(font-spec :registry "iso10646-1" :script (nth 2 math-subgroup))))
+ ;; Special setup for various symbols and punctuation characters
+ ;; covered well by Symbola, excluding those covered well by popular
+ ;; Unicode fonts. We exclude the latter because users don't like us
+ ;; invading on their font setups where they have good support from
+ ;; other fonts.
+ (dolist (symbol-subgroup
+ '((#x2000 . #x2012) ;; General Punctuation
+ (#x2015 . #x2017)
+ #x201F
+ (#x2023 . #x202F)
+ (#x2031 . #x2038)
+ (#x203B . #x206F)
+ (#x2070 . #x209F) ;; Superscripts and Subscripts
+ (#x20B6 . #x20CF) ;; Currency Symbols
+ (#x2100 . #x2121) ;; Letterlike Symbols
+ (#x2123 . #x214F)
+ (#x2150 . #x215A) ;; Number Forms
+ (#x215F . #x218F)
+ (#x2194 . #x21FF) ;; Arrows
+ (#x2200 . #x2211) ;; Mathematical Operators
+ (#x2213 . #x2247)
+ (#x2249 . #x225F)
+ (#x2261 . #x2263)
+ (#x2266 . #x22FF)
+ (#x2300 . #x2301) ;; Miscellaneous Technical
+ (#x2303 . #x230F)
+ (#x2311 . #x231F)
+ (#x2322 . #x23FF)
+ (#x2400 . #x243F) ;; Control Pictures
+ (#x2440 . #x245F) ;; Optical Char Recognition
+ (#x2460 . #x24FF) ;; Enclosed Alphanumerics
+ (#x25A0 . #x25FF) ;; Geometric Shapes
+ (#x2600 . #x265F) ;; Miscellaneous Symbols
+ (#x2661 . #x2662)
+ #x2664
+ (#x2667 . #x2669)
+ (#x266C . #x26FF)
+ (#x2700 . #x27bF) ;; Dingbats
+ (#x27C0 . #x27EF) ;; Misc Mathematical Symbols-A
+ (#x27F0 . #x27FF) ;; Supplemental Arrows-A
+ (#x2900 . #x297F) ;; Supplemental Arrows-B
+ (#x2980 . #x29FF) ;; Misc Mathematical Symbols-B
+ (#x2A00 . #x2AFF) ;; Suppl. Math Operators
+ (#x2B00 . #x2BFF) ;; Misc Symbols and Arrows
+ (#x2E00 . #x2E7F) ;; Supplemental Punctuation
+ (#x4DC0 . #x4DFF) ;; Yijing Hexagram Symbols
+ (#xFE10 . #xFE1F) ;; Vertical Forms
+ (#x10100 . #x1013F) ;; Aegean Numbers
+ (#x102E0 . #x102FF) ;; Coptic Epact Numbers
+ (#x1D000 . #x1D0FF) ;; Byzantine Musical Symbols
+ (#x1D200 . #x1D24F) ;; Ancient Greek Musical Notation
+ (#x1F0A0 . #x1F0FF) ;; Playing Cards
+ (#x1F100 . #x1F1FF) ;; Enclosed Alphanumeric Suppl
+ (#x1F300 . #x1F5FF) ;; Misc Symbols and Pictographs
+ (#x1F600 . #x1F64F) ;; Emoticons
+ (#x1F650 . #x1F67F) ;; Ornamental Dingbats
+ (#x1F680 . #x1F6FF) ;; Transport and Map Symbols
+ (#x1F700 . #x1F77F) ;; Alchemical Symbols
+ (#x1F780 . #x1F7FF) ;; Geometric Shapes Extended
+ (#x1F800 . #x1F8FF))) ;; Supplemental Arrows-C
+ (set-fontset-font "fontset-default" symbol-subgroup "Symbola" nil 'prepend))
+ ;; Box Drawing and Block Elements
+ (set-fontset-font "fontset-default" '(#x2500 . #x259F)
+ "FreeMono" nil 'prepend)
+
+ ;; Since standard-fontset-spec on X uses fixed-medium font, which
+ ;; gets mapped to a iso8859-1 variant, we would like to prefer its
+ ;; iso10646-1 variant for symbols, where the coverage is known to be
+ ;; good.
+ (dolist (symbol-subgroup
+ '((#x2000 . #x206F) ;; General Punctuation
+ (#x2070 . #x209F) ;; Superscripts and Subscripts
+ (#x20A0 . #x20CF) ;; Currency Symbols
+ (#x2150 . #x218F) ;; Number Forms
+ (#x2190 . #x21FF) ;; Arrows
+ (#x2200 . #x22FF) ;; Mathematical Operators
+ (#x2300 . #x23FF) ;; Miscellaneous Technical
+ (#x2400 . #x243F) ;; Control Pictures
+ (#x2440 . #x245F) ;; Optical Char Recognition
+ (#x2460 . #x24FF) ;; Enclosed Alphanumerics
+ (#x2500 . #x257F) ;; Box Drawing
+ (#x2580 . #x259F) ;; Block Elements
+ (#x25A0 . #x25FF) ;; Geometric Shapes
+ (#x2600 . #x2689) ;; Miscellaneous Symbols
+ (#x2700 . #x27bF) ;; Dingbats
+ (#x27F5 . #x27FF))) ;; Supplemental Arrows-A
+ (set-fontset-font "fontset-default" symbol-subgroup
+ "-*-fixed-medium-*-*-*-*-*-*-*-*-*-iso10646-1"
+ nil 'prepend))
+
;; Append CJK fonts for characters other than han, kana, cjk-misc.
;; Append fonts for scripts whose name is also a charset name.
(let* ((data (build-default-fontset-data))
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index 37213b95d3e..92e55220375 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -1,6 +1,6 @@
;;; isearch-x.el --- extended isearch handling commands
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -71,6 +71,7 @@
(defun isearch-with-keyboard-coding ()
(interactive)
+ ;; FIXME: What does this after-change-functions binding do here?
(let ((after-change-functions '(isearch-exit-recursive-edit)))
(recursive-edit))
(exit-minibuffer))
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 0e4c61fe3b4..0359ab8e1cf 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -1,10 +1,10 @@
;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals
-;; Copyright (C) 1987, 1995, 1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1987, 1995, 1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; This file is part of GNU Emacs.
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index 407ff3ae7a4..d662699c17c 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -1,7 +1,7 @@
;;; iso-cvt.el --- translate ISO 8859-1 from/to various encodings -*- coding: utf-8 -*-
;; This file was formerly called gm-lingo.el.
-;; Copyright (C) 1993-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at>
;; Keywords: tex, iso, latin, i18n
@@ -46,7 +46,7 @@
(defvar iso-spanish-trans-tab
'(
("~n" "ñ")
- ("\([a-zA-Z]\)#" "\\1ñ")
+ ("([a-zA-Z])#" "\\1ñ")
("~N" "Ñ")
("\\([-a-zA-Z\"`]\\)\"u" "\\1ü")
("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü")
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 4bbb89c7087..e9fb009a56e 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -1,10 +1,10 @@
-;;; iso-transl.el --- keyboard input definitions for ISO 8859-1 -*- coding: utf-8 -*-
+;;; iso-transl.el --- keyboard input for ISO 10646 chars -*- coding: utf-8 -*-
-;; Copyright (C) 1987, 1993-1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1987, 1993-1999, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; This file is part of GNU Emacs.
@@ -36,6 +36,10 @@
;; to make all of the Alt keys autoload, and it is not clear
;; that the dead accent keys SHOULD autoload this package.
+;; This package supports all characters defined by ISO 8859-1, along
+;; with a few other ISO 10646 characters commonly used in English and
+;; basic math.
+
;;; Code:
;;; Provide some binding for startup:
@@ -192,6 +196,31 @@
("~o" . [?õ])
("~t" . [?þ])
("~~" . [?¬])
+ ("_h" . [?‐])
+ ("_H" . [?‑])
+ ("_f" . [?‒])
+ ("_n" . [?–])
+ ("_m" . [?—])
+ ("_q" . [?―])
+ ("[" . [?‘])
+ ("]" . [?’])
+ ("{" . [?“])
+ ("}" . [?”])
+ ("1+" . [?†])
+ ("2+" . [?‡])
+ ("**" . [?•])
+ ("*'" . [?′])
+ ("*\"" . [?″])
+ ("*E" . [?€])
+ ("No" . [?№])
+ ("a<" . [?←])
+ ("a>" . [?→])
+ ("a=" . [?↔])
+ ("_-" . [?−])
+ ("~=" . [?≈])
+ ("/=" . [?≠])
+ ("_<" . [?≤])
+ ("_>" . [?≥])
("' " . "'")
("` " . "`")
("\" " . "\"")
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 41a31004194..d9c77bf5652 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -1,5 +1,7 @@
;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -278,7 +280,7 @@
(cons (cons kana candidates) skkdic-okuri-nasi-entries)
skkdic-okuri-nasi-entries-count
(1+ skkdic-okuri-nasi-entries-count))
- (setq ratio (floor (/ (* (point) 100.0) (point-max))))
+ (setq ratio (floor (* (point) 100.0) (point-max)))
(if (/= (/ prev-ratio 10) (/ ratio 10))
(progn
(message "collected %2d%% ..." ratio)
@@ -304,7 +306,7 @@
(while l
(let ((kana (car (car l)))
(candidates (cdr (car l))))
- (setq ratio (/ (* count 100) skkdic-okuri-nasi-entries-count)
+ (setq ratio (floor (* count 100.0) skkdic-okuri-nasi-entries-count)
count (1+ count))
(if (/= (/ prev-ratio 10) (/ ratio 10))
(progn
@@ -342,15 +344,12 @@ The name of generated file is specified by the variable `ja-dic-filename'."
(with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
- (insert ";;; ja-dic.el --- dictionary for Japanese input method"
- " -*-coding: utf-8; -*-\n"
+ (insert ";;; ja-dic.el --- dictionary for Japanese input method\n"
";;\tGenerated by the command `skkdic-convert'\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
"\n\n"
";; This file is part of GNU Emacs.\n\n"
- ";;; Commentary:\n\n"
- ";; Do byte-compile this file again after any modification.\n\n"
";;; Start of the header of the original SKK dictionary.\n\n")
(set-buffer skkbuf)
(goto-char 1)
@@ -398,7 +397,13 @@ The name of generated file is specified by the variable `ja-dic-filename'."
;; Postfix
(with-current-buffer buf
(goto-char (point-max))
- (insert ";;\n(provide 'ja-dic)\n\n;;; ja-dic.el ends here\n")))
+ (insert ";;\n(provide 'ja-dic)\n\n"
+ ";; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-update-autoloads: t\n"
+ ";; coding: utf-8\n"
+ ";; End:\n\n"
+ ";;; ja-dic.el ends here\n")))
;; Save the working buffer.
(set-buffer buf)
diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el
index 8400c473afa..7005ba85726 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -109,13 +109,14 @@ without okurigana are placed at the head of the returned list."
(load-library "ja-dic/ja-dic")
(error (ding)
(with-output-to-temp-buffer "*Help*"
- (princ "The library `ja-dic' can't be loaded.
+ (princ (substitute-command-keys "\
+The library `ja-dic' can't be loaded.
The most common case is that you have not yet installed the library
included in LEIM (Libraries of Emacs Input Method) which is
distributed separately from Emacs.
-LEIM is available from the same ftp directory as Emacs."))
+LEIM is available from the same ftp directory as Emacs.")))
(signal (car err) (cdr err)))))
(let ((vec (make-vector len 0))
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index fb6c35c07b5..f1661ca295a 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -1,6 +1,6 @@
;;; kinsoku.el --- `Kinsoku' processing funcs -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el
index 13833fad66b..7eb8a4d4d4a 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -1,6 +1,6 @@
;;; kkc.el --- Kana Kanji converter -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -209,7 +209,7 @@ area while indicating the current selection by `<N>'."
(define-error 'kkc-error nil)
(defun kkc-error (&rest args)
- (signal 'kkc-error (apply 'format args)))
+ (signal 'kkc-error (apply #'format-message args)))
(defvar kkc-converting nil)
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index 8ab0c93e37c..09b8a17c2cf 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -1,6 +1,6 @@
;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: utf-8 -*-
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Arne Jørgensen <arne@arnested.dk>
;; Keywords: mule, coding system, latex
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index 2eadd8f8eb5..29036ff796b 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -1,6 +1,6 @@
;;; latin1-disp.el --- display tables for other ISO 8859 on Latin-1 terminals -*-coding: utf-8;-*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
@@ -2271,7 +2271,7 @@ isn't changed if the display can render Unicode characters."
(?\∨ "OR")
(?\∩ "(U")
(?\∪ ")U")
- (?\∫ "\int ")
+ (?\∫ "\\int ")
(?\∬ "DI")
(?\∮ "Io")
(?\∴ ".:")
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 34b1576d23e..0904ff93e23 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1,6 +1,6 @@
-;;; mule-cmds.el --- commands for multilingual environment -*-coding: utf-8 -*-
+;;; mule-cmds.el --- commands for multilingual environment -*- lexical-binding:t -*-
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -30,6 +30,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defvar dos-codepage)
(autoload 'widget-value "wid-edit")
@@ -157,7 +159,7 @@
;; very frequently while editing multilingual text. Now we can use
;; only two such keys: "\C-\\" and "\C-^", but the latter is not
;; convenient because it requires shifting on most keyboards. An
-;; alternative is "\C-\]" which is now bound to `abort-recursive-edit'
+;; alternative is "\C-]" which is now bound to `abort-recursive-edit'
;; but it won't be used that frequently.
(define-key global-map "\C-\\" 'toggle-input-method)
@@ -175,7 +177,7 @@
"\\(charset\\)"
"\\)\\s-+\\)?"
;; Note starting with word-syntax character:
- "`\\(\\sw\\(\\sw\\|\\s_\\)+\\)'")))
+ "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")))
(defun coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system which differs from CODING-SYSTEM in EOL conversion.
@@ -395,7 +397,7 @@ A coding system that requires automatic detection of text+encoding
To prefer, for instance, utf-8, say the following:
- \(prefer-coding-system 'utf-8)"
+ (prefer-coding-system \\='utf-8)"
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" coding-system))
@@ -548,7 +550,7 @@ Emacs, but is unlikely to be what you really want now."
(coding-system-charset-list cs)))
(charsets charsets))
(if (coding-system-get cs :ascii-compatible-p)
- (add-to-list 'cs-charsets 'ascii))
+ (cl-pushnew 'ascii cs-charsets))
(if (catch 'ok
(when cs-charsets
(while charsets
@@ -636,6 +638,36 @@ The meaning is the same as the argument ACCEPT-DEFAULT-P of the
function `select-safe-coding-system' (which see). This variable
overrides that argument.")
+(defun sanitize-coding-system-list (codings)
+ "Return a list of coding systems presumably more user-friendly than CODINGS."
+ ;; Change each safe coding system to the corresponding
+ ;; mime-charset name if it is also a coding system. Such a name
+ ;; is more friendly to users.
+ (setq codings
+ (mapcar (lambda (cs)
+ (let ((mime-charset (coding-system-get cs 'mime-charset)))
+ (if (and mime-charset (coding-system-p mime-charset)
+ (coding-system-equal cs mime-charset))
+ mime-charset cs)))
+ codings))
+
+ ;; Don't offer variations with locking shift, which you
+ ;; basically never want.
+ (let (l)
+ (dolist (elt codings (setq codings (nreverse l)))
+ (unless (or (eq 'coding-category-iso-7-else
+ (coding-system-category elt))
+ (eq 'coding-category-iso-8-else
+ (coding-system-category elt)))
+ (push elt l))))
+
+ ;; Remove raw-text, emacs-mule and no-conversion unless nothing
+ ;; else is available.
+ (or (delq 'raw-text
+ (delq 'emacs-mule
+ (delq 'no-conversion (copy-sequence codings))))
+ codings))
+
(defun select-safe-coding-system-interactively (from to codings unsafe
&optional rejected default)
"Select interactively a coding system for the region FROM ... TO.
@@ -667,35 +699,7 @@ DEFAULT is the coding system to use by default in the query."
from to coding 11)))))
unsafe)))
- ;; Change each safe coding system to the corresponding
- ;; mime-charset name if it is also a coding system. Such a name
- ;; is more friendly to users.
- (let ((l codings)
- mime-charset)
- (while l
- (setq mime-charset (coding-system-get (car l) :mime-charset))
- (if (and mime-charset (coding-system-p mime-charset)
- (coding-system-equal (car l) mime-charset))
- (setcar l mime-charset))
- (setq l (cdr l))))
-
- ;; Don't offer variations with locking shift, which you
- ;; basically never want.
- (let (l)
- (dolist (elt codings (setq codings (nreverse l)))
- (unless (or (eq 'coding-category-iso-7-else
- (coding-system-category elt))
- (eq 'coding-category-iso-8-else
- (coding-system-category elt)))
- (push elt l))))
-
- ;; Remove raw-text, emacs-mule and no-conversion unless nothing
- ;; else is available.
- (setq codings
- (or (delq 'raw-text
- (delq 'emacs-mule
- (delq 'no-conversion codings)))
- '(raw-text emacs-mule no-conversion)))
+ (setq codings (sanitize-coding-system-list codings))
(let ((window-configuration (current-window-configuration))
(bufname (buffer-name))
@@ -715,14 +719,14 @@ DEFAULT is the coding system to use by default in the query."
(insert "No default coding systems to try for "
(if (stringp from)
(format "string \"%s\"." from)
- (format "buffer `%s'." bufname)))
+ (format-message "buffer `%s'." bufname)))
(insert
"These default coding systems were tried to encode"
(if (stringp from)
(concat " \"" (if (> (length from) 10)
(concat (substring from 0 10) "...\"")
(concat from "\"")))
- (format " text\nin the buffer `%s'" bufname))
+ (format-message " text\nin the buffer `%s'" bufname))
":\n")
(let ((pos (point))
(fill-prefix " "))
@@ -740,7 +744,8 @@ e.g., for sending an email message.\n ")
(when unsafe
(insert (if rejected "The other coding systems"
"However, each of them")
- " encountered characters it couldn't encode:\n")
+ (substitute-command-keys
+ " encountered characters it couldn't encode:\n"))
(dolist (coding unsafe)
(insert (format " %s cannot encode these:" (car coding)))
(let ((i 0)
@@ -871,13 +876,13 @@ and TO is ignored."
(setq auto-cs (car auto-cs))
(display-warning
'mule
- (format "\
+ (format-message "\
Invalid coding system `%s' is specified
for the current buffer/file by the %s.
It is highly recommended to fix it before writing to a file."
(car auto-cs)
(if (eq (cdr auto-cs) :coding) ":coding tag"
- (format "variable `%s'" (cdr auto-cs))))
+ (format-message "variable `%s'" (cdr auto-cs))))
:warning)
(or (yes-or-no-p "Really proceed with writing? ")
(error "Save aborted"))
@@ -972,13 +977,17 @@ It is highly recommended to fix it before writing to a file."
;; Classify the defaults into safe, rejected, and unsafe.
(dolist (elt default-coding-system)
- (if (or (eq (coding-system-type (car elt)) 'undecided)
- (memq (cdr elt) codings))
+ (if (memq (cdr elt) codings)
+ ;; This is safe. Is it acceptable?
(if (and (functionp accept-default-p)
(not (funcall accept-default-p (cdr elt))))
+ ;; No, not acceptable.
(push (car elt) rejected)
+ ;; Yes, acceptable.
(push (car elt) safe))
+ ;; This is not safe.
(push (car elt) unsafe)))
+ ;; If there are safe ones, the first one is what we want.
(if safe
(setq coding-system (car safe))))
@@ -1263,7 +1272,7 @@ This file contains a list of libraries of Emacs input methods (LEIM)
in the format of Lisp expression for registering each input method.
Emacs loads this file at startup time.")
-(defconst leim-list-header (format
+(defconst leim-list-header (format-message
";;; %s -- list of LEIM (Library of Emacs Input Method) -*-coding: utf-8;-*-
;;
;; This file is automatically generated.
@@ -1421,7 +1430,9 @@ The return value is a string."
;; buffer local.
(input-method (completing-read prompt input-method-alist
nil t nil 'input-method-history
- default)))
+ (if (and default (symbolp default))
+ (symbol-name default)
+ default))))
(if (and input-method (symbolp input-method))
(setq input-method (symbol-name input-method)))
(if (> (length input-method) 0)
@@ -1577,7 +1588,7 @@ which marks the variable `default-input-method' as set for Custom buffers."
(called-interactively-p 'interactive))
(with-output-to-temp-buffer (help-buffer)
(let ((elt (assoc input-method input-method-alist)))
- (princ (format
+ (princ (format-message
"Input method: %s (`%s' in mode line) for %s\n %s\n"
input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))))))
@@ -1688,7 +1699,7 @@ Usually, the input method inserts the intermediate key sequence,
or candidate translations corresponding to the sequence,
at point in the current buffer.
But, if this flag is non-nil, it displays them in echo area instead."
- :type 'hook
+ :type 'boolean
:group 'mule)
(defvar input-method-exit-on-invalid-key nil
@@ -2163,10 +2174,11 @@ See `set-language-info-alist' for use in programs."
(search-backward (symbol-name (car l)))
(help-xref-button 0 'help-coding-system (car l))
(goto-char (point-max))
- (insert " (`"
+ (insert (substitute-command-keys " (`")
(coding-system-mnemonic (car l))
- "' in mode line):\n\t"
- (coding-system-doc-string (car l))
+ (substitute-command-keys "' in mode line):\n\t")
+ (substitute-command-keys
+ (coding-system-doc-string (car l)))
"\n")
(let ((aliases (coding-system-aliases (car l))))
(when aliases
@@ -2401,12 +2413,12 @@ See `set-language-info-alist' for use in programs."
))
"Alist of locale regexps vs the corresponding languages and coding systems.
Each element has this form:
- \(LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
+ (LOCALE-REGEXP LANG-ENV CODING-SYSTEM)
The first element whose LOCALE-REGEXP matches the start of a
downcased locale specifies the LANG-ENV \(language environment)
and CODING-SYSTEM corresponding to that locale. If there is no
appropriate language environment, the element may have this form:
- \(LOCALE-REGEXP . LANG-ENV)
+ (LOCALE-REGEXP . LANG-ENV)
In this case, LANG-ENV is one of generic language environments for an
specific encoding such as \"Latin-1\" and \"UTF-8\".")
@@ -2508,6 +2520,9 @@ is returned. Thus, for instance, if charset \"ISO8859-2\",
;; too, for setting things such as calendar holidays, ps-print paper
;; size, spelling dictionary.
+(declare-function w32-get-console-codepage "w32proc.c" ())
+(declare-function w32-get-console-output-codepage "w32proc.c" ())
+
(defun locale-translate (locale)
"Expand LOCALE according to `locale-translation-file-name', if possible.
For example, translate \"swedish\" into \"sv_SE.ISO8859-1\"."
@@ -2589,7 +2604,18 @@ See also `locale-charset-language-names', `locale-language-names',
(setq system-time-locale locale))
(if (string-match "^[a-z][a-z]" locale)
- (setq current-iso639-language (intern (match-string 0 locale)))))
+ ;; The value of 'current-iso639-language' is matched against
+ ;; the ':lang' property of font-spec objects when selecting
+ ;; and prioritizing available fonts for displaying
+ ;; characters; see fontset.c.
+ (setq current-iso639-language
+ ;; The call to 'downcase' is for w32, where the
+ ;; MS-Windows locale names are in caps, as in "ENU",
+ ;; the equivalent of the Posix "en_US". Since the
+ ;; match mentioned above uses memq, and ':lang'
+ ;; properties have lower-case values, the letter-case
+ ;; must match exactly.
+ (intern (downcase (match-string 0 locale))))))
(setq woman-locale
(or system-messages-locale
@@ -2677,14 +2703,22 @@ See also `locale-charset-language-names', `locale-language-names',
;; On Windows, override locale-coding-system,
;; default-file-name-coding-system, keyboard-coding-system,
- ;; terminal-coding-system with system codepage.
+ ;; terminal-coding-system with the ANSI or console codepage.
(when (and (eq system-type 'windows-nt)
(boundp 'w32-ansi-code-page))
- (let ((code-page-coding (intern (format "cp%d" w32-ansi-code-page))))
+ (let* ((code-page-coding
+ (intern (format "cp%d" (if noninteractive
+ (w32-get-console-codepage)
+ w32-ansi-code-page))))
+ (output-coding
+ (if noninteractive
+ (intern (format "cp%d" (w32-get-console-output-codepage)))
+ code-page-coding)))
(when (coding-system-p code-page-coding)
+ (or output-coding (setq output-coding code-page-coding))
(unless frame (setq locale-coding-system code-page-coding))
(set-keyboard-coding-system code-page-coding frame)
- (set-terminal-coding-system code-page-coding frame)
+ (set-terminal-coding-system output-coding frame)
(setq default-file-name-coding-system code-page-coding))))
(when (eq system-type 'darwin)
@@ -2766,11 +2800,7 @@ See also the documentation of `get-char-code-property' and
(or (stringp table)
(error "Not a char-table nor a file name: %s" table)))
(if (stringp table) (setq table (purecopy table)))
- (let ((slot (assq name char-code-property-alist)))
- (if slot
- (setcdr slot table)
- (setq char-code-property-alist
- (cons (cons name table) char-code-property-alist))))
+ (setf (alist-get name char-code-property-alist) table)
(put name 'char-code-property-documentation (purecopy docstring)))
(defvar char-code-property-table
@@ -2899,16 +2929,14 @@ on encoding."
(defun ucs-names ()
"Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
(or ucs-names
- (let ((bmp-ranges
+ (let ((ranges
'((#x0000 . #x33FF)
;; (#x3400 . #x4DBF) CJK Ideographs Extension A
(#x4DC0 . #x4DFF)
;; (#x4E00 . #x9FFF) CJK Unified Ideographs
(#xA000 . #xD7FF)
;; (#xD800 . #xFAFF) Surrogate/Private
- (#xFB00 . #xFFFD)))
- (upper-ranges
- '((#x10000 . #x134FF)
+ (#xFB00 . #x134FF)
;; (#x13500 . #x167FF) unused
(#x16800 . #x16A3F)
;; (#x16A40 . #x1AFFF) unused
@@ -2918,24 +2946,32 @@ on encoding."
;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
(#xE0000 . #xE01FF)))
(gc-cons-threshold 10000000)
- c end name names)
- (dolist (range bmp-ranges)
- (setq c (car range)
- end (cdr range))
- (while (<= c end)
- (if (setq name (get-char-code-property c 'name))
- (push (cons name c) names))
- (if (setq name (get-char-code-property c 'old-name))
- (push (cons name c) names))
- (setq c (1+ c))))
- (dolist (range upper-ranges)
- (setq c (car range)
- end (cdr range))
+ names)
+ (dolist (range ranges)
+ (let ((c (car range))
+ (end (cdr range)))
(while (<= c end)
- (if (setq name (get-char-code-property c 'name))
- (push (cons name c) names))
- (setq c (1+ c))))
- (setq ucs-names names))))
+ (let ((new-name (get-char-code-property c 'name))
+ (old-name (get-char-code-property c 'old-name)))
+ ;; In theory this code could end up pushing an "old-name" that
+ ;; shadows a "new-name" but in practice every time an
+ ;; `old-name' conflicts with a `new-name', the newer one has a
+ ;; higher code, so it gets pushed later!
+ (if new-name (push (cons new-name c) names))
+ (if old-name (push (cons old-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
+ ;; char with that name.
+ (setq ucs-names `(("BELL (BEL)" . 7) ,@names)))))
+
+(defun mule--ucs-names-annotation (name)
+ ;; FIXME: It would be much better to add this annotation before rather than
+ ;; after the char name, so the annotations are aligned.
+ ;; FIXME: The default behavior of displaying annotations in italics
+ ;; doesn't work well here.
+ (let ((char (assoc name ucs-names)))
+ (when char (format " (%c)" (cdr char)))))
(defun read-char-by-name (prompt)
"Read a character by its Unicode name or hex number string.
@@ -2960,7 +2996,9 @@ point or a number in hash notation, e.g. #o21430 for octal,
prompt
(lambda (string pred action)
(if (eq action 'metadata)
- '(metadata (category . unicode-name))
+ '(metadata
+ (annotation-function . mule--ucs-names-annotation)
+ (category . unicode-name))
(complete-with-action action (ucs-names) string pred)))))
(char
(cond
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index a84054b498b..ecbc4f48caa 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1,6 +1,6 @@
;;; mule-conf.el --- configure multilingual environment
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
@@ -35,7 +35,9 @@
;;; Remarks
-;; The ISO-IR registry is at http://www.itscj.ipsj.or.jp/ISO-IR/.
+;; The ISO-IR registry is maintained by the Information Processing
+;; 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/.
@@ -888,21 +890,23 @@
;; script which IS-13194 supports.
(define-charset 'indian-is13194
- "Generic Indian charset for data exchange with IS 13194"
- :short-name "IS 13194"
- :long-name "Indian IS 13194"
+ "7-bit representation of IS 13194 (ISCII) for Devanagari"
+ :short-name "IS 13194 (DEV)"
+ :long-name "Indian IS 13194 (DEV)"
:iso-final-char ?5
:emacs-mule-id 225
:supplementary-p t
:code-space [33 126]
- :code-offset #x180000)
+ :code-offset #x180000
+ :unify-map "MULE-is13194")
(let ((code-offset #x180100))
(dolist (script '(devanagari sanskrit bengali tamil telugu assamese
oriya kannada malayalam gujarati punjabi))
(define-charset (intern (format "%s-cdac" script))
- (format "Glyphs of %s script for CDAC font. Subset of `indian-glyph'."
- (capitalize (symbol-name script)))
+ (format
+ "Glyphs of %s script for CDAC font. Subset of `indian-glyph'."
+ (capitalize (symbol-name script)))
:short-name (format "CDAC %s glyphs" (capitalize (symbol-name script)))
:supplementary-p t
:code-space [0 255]
@@ -912,8 +916,9 @@
(dolist (script '(devanagari bengali punjabi gujarati
oriya tamil telugu kannada malayalam))
(define-charset (intern (format "%s-akruti" script))
- (format "Glyphs of %s script for AKRUTI font. Subset of `indian-glyph'."
- (capitalize (symbol-name script)))
+ (format
+ "Glyphs of %s script for AKRUTI font. Subset of `indian-glyph'."
+ (capitalize (symbol-name script)))
:short-name (format "AKRUTI %s glyphs" (capitalize (symbol-name script)))
:supplementary-p t
:code-space [0 255]
@@ -1109,7 +1114,7 @@
:map "MIK")
(define-charset 'ptcp154
- "`Paratype' codepage (Asian Cyrillic)"
+ "ParaType codepage (Asian Cyrillic)"
:short-name "PT154"
:ascii-compatible-p t
:code-space [0 255]
@@ -1192,6 +1197,7 @@
(unify-charset 'ipa)
(unify-charset 'tibetan)
(unify-charset 'ethiopic)
+(unify-charset 'indian-is13194)
(unify-charset 'japanese-jisx0208-1978)
(unify-charset 'japanese-jisx0208)
(unify-charset 'japanese-jisx0212)
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index dd59d5e77ab..fa5a7ebe7c3 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,6 +1,6 @@
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -332,7 +332,7 @@ meanings of these arguments."
(let ((char (charset-iso-final-char charset)))
(when (> char 0)
(insert "Final char of ISO2022 designation sequence: ")
- (insert (format "`%c'\n" char))))
+ (insert (format-message "`%c'\n" char))))
(let (aliases)
(dolist (c charset-list)
(if (and (not (eq c charset))
@@ -581,7 +581,7 @@ docstring, and print only the first line of the docstring."
(if (string-match "\n" doc)
(setq doc (substring doc 0 (match-beginning 0))))
(setq doc (concat " " doc)))
- (princ (format "%s\n" doc))))))
+ (princ (format "%s\n" (substitute-command-keys doc)))))))
;;;###autoload
(defun describe-current-coding-system ()
@@ -770,7 +770,7 @@ but still contains full information about each coding system."
# MNEMONIC-LETTER -- CODING-SYSTEM-NAME
# DOC-STRING
")
- (princ "\
+ (princ (substitute-command-keys "\
#########################
## LIST OF CODING SYSTEMS
## Each line corresponds to one coding system
@@ -794,7 +794,7 @@ but still contains full information about each coding system."
## 0
## POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
##
-"))
+")))
(dolist (coding-system (sort-coding-systems (coding-system-list 'base-only)))
(if (null arg)
(print-coding-system-briefly coding-system 'tightly)
@@ -825,10 +825,18 @@ but still contains full information about each coding system."
The IGNORED argument is ignored."
(print-list "name (opened by):" (aref font-info 0))
(print-list " full name:" (aref font-info 1))
+ (and (aref font-info 12)
+ (print-list " file name:" (aref font-info 12)))
(print-list " size:" (format "%2d" (aref font-info 2)))
(print-list " height:" (format "%2d" (aref font-info 3)))
(print-list " baseline-offset:" (format "%2d" (aref font-info 4)))
- (print-list "relative-compose:" (format "%2d" (aref font-info 5))))
+ (print-list "relative-compose:" (format "%2d" (aref font-info 5)))
+ (print-list " default-ascent:" (format "%2d" (aref font-info 6)))
+ (print-list " ascent:" (format "%2d" (aref font-info 8)))
+ (print-list " descent:" (format "%2d" (aref font-info 9)))
+ (print-list " average-width:" (format "%2d" (aref font-info 11)))
+ (print-list " space-width:" (format "%2d" (aref font-info 10)))
+ (print-list " max-width:" (format "%2d" (aref font-info 7))))
;;;###autoload
(defun describe-font (fontname)
@@ -1030,7 +1038,8 @@ see the function `describe-fontset' for the format of the list."
(save-excursion
(goto-char (point-min))
(while (re-search-forward
- "^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
+ (substitute-command-keys "^ \\([^ ]+\\) (`.*' in mode line)$")
+ nil t)
(help-xref-button 1 'help-input-method (match-string 1)))))))
(defun list-input-methods-1 ()
@@ -1038,7 +1047,8 @@ see the function `describe-fontset' for the format of the list."
(princ "
No input method is available, perhaps because you have not
installed LEIM (Libraries of Emacs Input Methods).")
- (princ "LANGUAGE\n NAME (`TITLE' in mode line)\n")
+ (princ (substitute-command-keys
+ "LANGUAGE\n NAME (`TITLE' in mode line)\n"))
(princ " SHORT-DESCRIPTION\n------------------------------\n")
(setq input-method-alist
(sort input-method-alist
@@ -1050,16 +1060,18 @@ installed LEIM (Libraries of Emacs Input Methods).")
(setq language (nth 1 elt))
(princ language)
(terpri))
- (princ (format " %s (`%s' in mode line)\n %s\n"
- (car elt)
- (let ((title (nth 3 elt)))
- (if (and (consp title) (stringp (car title)))
- (car title)
- title))
- ;; If the doc is multi-line, indent all
- ;; non-blank lines. (Bug#8066)
- (replace-regexp-in-string "\n\\(.\\)" "\n \\1"
- (or (nth 4 elt) ""))))))))
+ (princ (format-message
+ " %s (`%s' in mode line)\n %s\n"
+ (car elt)
+ (let ((title (nth 3 elt)))
+ (if (and (consp title) (stringp (car title)))
+ (car title)
+ title))
+ ;; If the doc is multi-line, indent all
+ ;; non-blank lines. (Bug#8066)
+ (replace-regexp-in-string
+ "\n\\(.\\)" "\n \\1"
+ (substitute-command-keys (or (nth 4 elt) "")))))))))
;;; DIAGNOSIS
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 21e09593187..b575c2b7db3 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -1,6 +1,6 @@
-;;; mule-util.el --- utility functions for multilingual environment (mule)
+;;; mule-util.el --- utility functions for multilingual environment (mule) -*- lexical-binding:t -*-
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -30,8 +30,7 @@
;;; Code:
-;;; String manipulations while paying attention to multibyte
-;;; characters.
+;;; String manipulations while paying attention to multibyte characters.
;;;###autoload
(defsubst string-to-list (string)
@@ -49,13 +48,15 @@
(if (integerp obj)
(aset string idx obj)
(let ((len1 (length obj))
- (len2 (length string))
(i 0))
(while (< i len1)
(aset string (+ idx i) (aref obj i))
(setq i (1+ i)))))
string)
+(defvar truncate-string-ellipsis "..." ;"…"
+ "String to use to indicate truncation.")
+
;;;###autoload
(defun truncate-string-to-width (str end-column
&optional start-column padding ellipsis)
@@ -80,14 +81,13 @@ 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 \"...\"."
+defaults to `truncate-string-ellipsis'."
(or start-column
(setq start-column 0))
(when (and ellipsis (not (stringp ellipsis)))
- (setq ellipsis "..."))
+ (setq ellipsis truncate-string-ellipsis))
(let ((str-len (length str))
(str-width (string-width str))
- (ellipsis-len (if ellipsis (length ellipsis) 0))
(ellipsis-width (if ellipsis (string-width ellipsis) 0))
(idx 0)
(column 0)
@@ -126,8 +126,8 @@ defaults to \"...\"."
tail-padding ellipsis))))
-;;; Nested alist handler. Nested alist is alist whose elements are
-;;; also nested alist.
+;;; Nested alist handler.
+;; Nested alist is alist whose elements are also nested alist.
;;;###autoload
(defsubst nested-alist-p (obj)
@@ -273,43 +273,223 @@ per-character basis, this may not be accurate."
((not enable-multibyte-characters)
;; Maybe there's a font for it, but we can't put it in the buffer.
nil)
- ((display-multi-font-p)
- ;; On a window system, a character is displayable if we have
- ;; a font for that character in the default face of the
- ;; currently selected frame.
- (car (internal-char-font nil char)))
(t
- ;; On a terminal, a character is displayable if the coding
- ;; system for the terminal can encode it.
- (let ((coding (terminal-coding-system)))
- (when coding
- (let ((cs-list (coding-system-get coding :charset-list)))
- (cond
- ((listp cs-list)
- (catch 'tag
- (mapc #'(lambda (charset)
- (if (encode-char char charset)
- (throw 'tag charset)))
- cs-list)
- nil))
- ((eq cs-list 'iso-2022)
- (catch 'tag2
- (mapc #'(lambda (charset)
- (if (and (plist-get (charset-plist charset)
- :iso-final-char)
- (encode-char char charset))
- (throw 'tag2 charset)))
- charset-list)
- nil))
- ((eq cs-list 'emacs-mule)
- (catch 'tag3
- (mapc #'(lambda (charset)
- (if (and (plist-get (charset-plist charset)
- :emacs-mule-id)
- (encode-char char charset))
- (throw 'tag3 charset)))
- charset-list)
- nil)))))))))
+ (let ((font-glyph (internal-char-font nil char)))
+ (if font-glyph
+ (if (consp font-glyph)
+ ;; On a window system, a character is displayable
+ ;; if a font for that character is in the default
+ ;; face of the currently selected frame.
+ (car font-glyph)
+ ;; On a text terminal supporting glyph codes, CHAR is
+ ;; displayable if its glyph code is nonnegative.
+ (<= 0 font-glyph))
+ ;; On a text terminal without glyph codes, CHAR is displayable
+ ;; if the coding system for the terminal can encode it.
+ (let ((coding (terminal-coding-system)))
+ (when coding
+ (let ((cs-list (coding-system-get coding :charset-list)))
+ (cond
+ ((listp cs-list)
+ (catch 'tag
+ (mapc #'(lambda (charset)
+ (if (encode-char char charset)
+ (throw 'tag charset)))
+ cs-list)
+ nil))
+ ((eq cs-list 'iso-2022)
+ (catch 'tag2
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :iso-final-char)
+ (encode-char char charset))
+ (throw 'tag2 charset)))
+ charset-list)
+ nil))
+ ((eq cs-list 'emacs-mule)
+ (catch 'tag3
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :emacs-mule-id)
+ (encode-char char charset))
+ (throw 'tag3 charset)))
+ charset-list)
+ nil)))))))))))
+
+(defun filepos-to-bufferpos--dos (byte f)
+ (let ((eol-offset 0)
+ ;; Make sure we terminate, even if BYTE falls right in the middle
+ ;; of a CRLF or some other weird corner case.
+ (omin 0) (omax most-positive-fixnum)
+ pos lines)
+ (while
+ (progn
+ (setq pos (funcall f (- byte eol-offset)))
+ ;; Protect against accidental values of BYTE outside of the
+ ;; valid region.
+ (when (null pos)
+ (if (<= byte eol-offset)
+ (setq pos (point-min))
+ (setq pos (point-max))))
+ ;; Adjust POS for DOS EOL format.
+ (setq lines (1- (line-number-at-pos pos)))
+ (and (not (= lines eol-offset)) (> omax omin)))
+ (if (> lines eol-offset)
+ (setq omax (min (1- omax) lines)
+ eol-offset omax)
+ (setq omin (max (1+ omin) lines)
+ eol-offset omin)))
+ pos))
+
+;;;###autoload
+(defun filepos-to-bufferpos (byte &optional quality coding-system)
+ "Try to return the buffer position corresponding to a particular file position.
+The file position is given as a (0-based) BYTE count.
+The function presumes the file is encoded with CODING-SYSTEM, which defaults
+to `buffer-file-coding-system'.
+QUALITY can be:
+ `approximate', in which case we may cut some corners to avoid
+ excessive work.
+ `exact', in which case we may end up re-(en/de)coding a large
+ part of the file/buffer.
+ nil, in which case we may return nil rather than an approximation."
+ (unless coding-system (setq coding-system buffer-file-coding-system))
+ (let ((eol (coding-system-eol-type coding-system))
+ (type (coding-system-type coding-system))
+ (base (coding-system-base coding-system))
+ (pm (save-restriction (widen) (point-min))))
+ (and (eq type 'utf-8)
+ ;; Any post-read/pre-write conversions mean it's not really UTF-8.
+ (not (null (coding-system-get coding-system :post-read-conversion)))
+ (setq type 'not-utf-8))
+ (and (memq type '(charset raw-text undecided))
+ ;; The following are all of type 'charset', but they are
+ ;; actually variable-width encodings.
+ (not (memq base '(chinese-gbk chinese-gb18030 euc-tw euc-jis-2004
+ korean-iso-8bit chinese-iso-8bit
+ japanese-iso-8bit chinese-big5-hkscs
+ japanese-cp932 korean-cp949)))
+ (setq type 'single-byte))
+ (pcase type
+ (`utf-8
+ (when (coding-system-get coding-system :bom)
+ (setq byte (max 0 (- byte 3))))
+ (if (= eol 1)
+ (filepos-to-bufferpos--dos (+ pm byte) #'byte-to-position)
+ (byte-to-position (+ pm byte))))
+ (`single-byte
+ (if (= eol 1)
+ (filepos-to-bufferpos--dos (+ pm byte) #'identity)
+ (+ pm byte)))
+ ((and `utf-16
+ ;; FIXME: For utf-16, we could use the same approach as used for
+ ;; dos EOLs (counting the number of non-BMP chars instead of the
+ ;; number of lines).
+ (guard (not (eq quality 'exact))))
+ ;; Account for BOM, which is always 2 bytes in UTF-16.
+ (when (coding-system-get coding-system :bom)
+ (setq byte (max 0 (- byte 2))))
+ ;; In approximate mode, assume all characters are within the
+ ;; BMP, i.e. take up 2 bytes.
+ (setq byte (/ byte 2))
+ (if (= eol 1)
+ (filepos-to-bufferpos--dos (+ pm byte) #'identity)
+ (+ pm byte)))
+ (_
+ (pcase quality
+ (`approximate (byte-to-position (+ pm byte)))
+ (`exact
+ ;; Rather than assume that the file exists and still holds the right
+ ;; data, we reconstruct it based on the buffer's content.
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((tmp-buf (current-buffer)))
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ ;; Since encoding should always return more bytes than
+ ;; there were chars, encoding all chars up to (+ byte pm)
+ ;; guarantees the encoded result has at least `byte' bytes.
+ (encode-coding-region pm (min (point-max) (+ pm byte))
+ coding-system tmp-buf)))
+ (+ pm (length
+ (decode-coding-region (point-min)
+ (min (point-max) (+ pm byte))
+ coding-system t))))))))))))
+;;;###autoload
+(defun bufferpos-to-filepos (position &optional quality coding-system)
+ "Try to return the file byte corresponding to a particular buffer POSITION.
+Value is the file position given as a (0-based) byte count.
+The function presumes the file is encoded with CODING-SYSTEM, which defaults
+to `buffer-file-coding-system'.
+QUALITY can be:
+ `approximate', in which case we may cut some corners to avoid
+ excessive work.
+ `exact', in which case we may end up re-(en/de)coding a large
+ part of the file/buffer.
+ nil, in which case we may return nil rather than an approximation."
+ (unless coding-system (setq coding-system buffer-file-coding-system))
+ (let* ((eol (coding-system-eol-type coding-system))
+ (lineno (if (= eol 1) (1- (line-number-at-pos position)) 0))
+ (type (coding-system-type coding-system))
+ (base (coding-system-base coding-system))
+ byte)
+ (and (eq type 'utf-8)
+ ;; Any post-read/pre-write conversions mean it's not really UTF-8.
+ (not (null (coding-system-get coding-system :post-read-conversion)))
+ (setq type 'not-utf-8))
+ (and (memq type '(charset raw-text undecided))
+ ;; The following are all of type 'charset', but they are
+ ;; actually variable-width encodings.
+ (not (memq base '(chinese-gbk chinese-gb18030 euc-tw euc-jis-2004
+ korean-iso-8bit chinese-iso-8bit
+ japanese-iso-8bit chinese-big5-hkscs
+ japanese-cp932 korean-cp949)))
+ (setq type 'single-byte))
+ (pcase type
+ (`utf-8
+ (setq byte (position-bytes position))
+ (when (null byte)
+ (if (<= position 0)
+ (setq byte 1)
+ (setq byte (position-bytes (point-max)))))
+ (setq byte (1- byte))
+ (+ byte
+ ;; Account for BOM, if any.
+ (if (coding-system-get coding-system :bom) 3 0)
+ ;; Account for CR in CRLF pairs.
+ lineno))
+ (`single-byte
+ (+ position -1 lineno))
+ ((and `utf-16
+ ;; FIXME: For utf-16, we could use the same approach as used for
+ ;; dos EOLs (counting the number of non-BMP chars instead of the
+ ;; number of lines).
+ (guard (not (eq quality 'exact))))
+ ;; In approximate mode, assume all characters are within the
+ ;; BMP, i.e. each one takes up 2 bytes.
+ (+ (* (1- position) 2)
+ ;; Account for BOM, if any.
+ (if (coding-system-get coding-system :bom) 2 0)
+ ;; Account for CR in CRLF pairs.
+ lineno))
+ (_
+ (pcase quality
+ (`approximate (+ (position-bytes position) -1 lineno))
+ (`exact
+ ;; Rather than assume that the file exists and still holds the right
+ ;; data, we reconstruct its relevant portion.
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((tmp-buf (current-buffer)))
+ (with-current-buffer buf
+ (save-restriction
+ (widen)
+ (encode-coding-region (point-min) (min (point-max) position)
+ coding-system tmp-buf)))
+ (1- (point-max)))))))))))
(provide 'mule-util)
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 9af6bc369a4..af4c6e93e0b 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -1,6 +1,6 @@
;;; mule.el --- basic commands for multilingual environment
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -593,6 +593,29 @@ as the single-shift area.")
The remaining arguments must come in pairs ATTRIBUTE VALUE. ATTRIBUTE
may be any symbol.
+A coding system specifies a rule to decode (i.e. to convert a
+byte sequence to a character sequence) and a rule to encode (the
+opposite of decoding).
+
+The decoding is done by at most 3 steps; the first is to convert
+a byte sequence to a character sequence by one of Emacs'
+internal routines specified by `:coding-type' attribute. The
+optional second step is to convert the character sequence (the
+result of the first step) by a translation table specified
+by `:decode-translation-table' attribute. The optional third step
+is to convert the above result by a Lisp function specified
+by `:post-read-conversion' attribute.
+
+The encoding is done by at most 3 steps, which are the reverse
+of the decoding steps. The optional first step converts a
+character sequence to another character sequence by a Lisp
+function specified by `:pre-write-conversion' attribute. The
+optional second step converts the above result by a translation
+table specified by `:encode-translation-table' attribute. The
+third step converts the above result to a byte sequence by one
+of the Emacs's internal routines specified by the `:coding-type'
+attribute.
+
The following attributes have special meanings. Those labeled as
\"(required)\" should not be omitted.
@@ -602,27 +625,72 @@ VALUE is a character to display on mode line for the coding system.
`:coding-type' (required)
-VALUE must be one of `charset', `utf-8', `utf-16', `iso-2022',
-`emacs-mule', `shift-jis', `ccl', `raw-text', `undecided'.
+VALUE specifies the format of byte sequence the coding system
+decodes and encodes to. It must be one of `charset', `utf-8',
+`utf-16', `iso-2022', `emacs-mule', `shift-jis', `ccl',
+`raw-text', `undecided'.
+
+If VALUE is `charset', the coding system is for handling a
+byte sequence in which each byte or every two- to four-byte
+sequence represents a character code of a charset specified
+by the `:charset-list' attribute.
+
+If VALUE is `utf-8', the coding system is for handling Unicode
+UTF-8 byte sequences. See also the documentation of the
+attribute `:bom'.
+
+If VALUE is `utf-16', the coding system is for handling Unicode
+UTF-16 byte sequences. See also the documentation of the
+attributes :bom and `:endian'.
+
+If VALUE is `iso-2022', the coding system is for handling byte
+sequences conforming to ISO/IEC 2022. See also the documentation
+of the attributes `:charset-list', `:flags', and `:designation'.
+
+If VALUE is `emacs-mule', the coding system is for handling
+byte sequences which Emacs 20 and 21 used for their internal
+representation of characters.
+
+If VALUE is `shift-jis', the coding system is for handling byte
+sequences of Shift_JIS format. See also the attribute `:charset-list'.
+
+If VALUE is `ccl', the coding system uses CCL programs to decode
+and encode byte sequences. The CCL programs must be
+specified by the attributes `:ccl-decoder' and `:ccl-encoder'.
+
+If VALUE is `raw-text', the coding system decodes byte sequences
+without any conversions.
`:eol-type'
VALUE is the EOL (end-of-line) format of the coding system. It must be
one of `unix', `dos', `mac'. The symbol `unix' means Unix-like EOL
-\(i.e. single LF), `dos' means DOS-like EOL \(i.e. sequence of CR LF),
-and `mac' means Mac-like EOL \(i.e. single CR). If omitted, Emacs
-detects the EOL format automatically when decoding.
+\(i.e., a single LF character), `dos' means DOS-like EOL \(i.e., a sequence
+of CR followed by LF), and `mac' means Mac-like EOL \(i.e., a single CR).
+If omitted, Emacs detects the EOL format automatically when decoding.
+
+`:charset-list' (required if `:coding-type' is `charset' or `shift-jis')
+
+VALUE must be a list of charsets supported by the coding system.
+
+If `coding-type:' is `charset', then on decoding and encoding by the
+coding system, if a character belongs to multiple charsets in the
+list, a charset that comes first in the list is selected.
-`:charset-list'
+If `:coding-type' is `iso-2022', VALUE may be `iso-2022', which
+indicates that the coding system supports all ISO-2022 based
+charsets.
-VALUE must be a list of charsets supported by the coding system. On
-encoding by the coding system, if a character belongs to multiple
-charsets in the list, a charset that comes earlier in the list is
-selected. If `:coding-type' is `iso-2022', VALUE may be `iso-2022',
-which indicates that the coding system supports all ISO-2022 based
-charsets. If `:coding-type' is `emacs-mule', VALUE may be
-`emacs-mule', which indicates that the coding system supports all
-charsets that have the `:emacs-mule-id' property.
+If `:coding-type' is `shift-jis', VALUE must be a list of three
+to four charsets supported by Shift_JIS encoding scheme. The
+first charset (one dimension) is for code space 0x00..0x7F, the
+second (one dimension) for 0xA1..0xDF, the third (two dimension)
+for 0x8140..0xEFFC, the optional fourth (three dimension) for
+0xF040..0xFCFC.
+
+If `:coding-type' is `emacs-mule', VALUE may be `emacs-mule',
+which indicates that the coding system supports all charsets that
+have the `:emacs-mule-id' property.
`:ascii-compatible-p'
@@ -643,9 +711,9 @@ VALUE must be a translation table to use on encoding.
VALUE must be a function to call after some text is inserted and
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
+argument: the number of characters in the text to convert, with
point at the start of the text. The function should leave point
-the same, and return the new character count.
+unchanged, and should return the new character count.
`:pre-write-conversion'
@@ -674,7 +742,7 @@ to lower case.
`:mime-text-unsuitable'
VALUE non-nil means the `:mime-charset' property names a charset which
-is unsuitable for the top-level media type \"text\".
+is unsuitable for the top-level media of type \"text\".
`:flags'
@@ -704,8 +772,8 @@ This attribute is meaningful only when `:coding-type' is `iso-2022'.
`:bom'
-This attributes specifies whether the coding system uses a `byte order
-mark'. VALUE must be nil, t, or cons of coding systems whose
+This attributes specifies whether the coding system uses a \"byte order
+mark\". VALUE must be nil, t, or a cons cell of coding systems whose
`:coding-type' is `utf-16' or `utf-8'.
If the value is nil, on decoding, don't treat the first two-byte as
@@ -714,9 +782,9 @@ BOM, and on encoding, don't produce BOM bytes.
If the value is t, on decoding, skip the first two-byte as BOM, and on
encoding, produce BOM bytes according to the value of `:endian'.
-If the value is cons, on decoding, check the first two-byte. If they
-are 0xFE 0xFF, use the car part coding system of the value. If they
-are 0xFF 0xFE, use the cdr part coding system of the value.
+If the value is a cons cell, on decoding, check the first two bytes.
+If they are 0xFE 0xFF, use the car part coding system of the value.
+If they are 0xFF 0xFE, use the cdr part coding system of the value.
Otherwise, treat them as bytes for a normal character. On encoding,
produce BOM bytes according to the value of `:endian'.
@@ -730,17 +798,17 @@ little-endian respectively. The default value is `big'.
This attribute is meaningful only when `:coding-type' is `utf-16'.
-`:ccl-decoder'
+`:ccl-decoder' (required if :coding-type is `ccl')
-VALUE is a symbol representing the registered CCL program used for
-decoding. This attribute is meaningful only when `:coding-type' is
-`ccl'.
+VALUE is a CCL program name defined by `define-ccl-program'. The
+CCL program reads a byte sequence and writes a character sequence
+as a decoding result.
-`:ccl-encoder'
+`:ccl-encoder' (required if :coding-type is `ccl')
-VALUE is a symbol representing the registered CCL program used for
-encoding. This attribute is meaningful only when `:coding-type' is
-`ccl'.
+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-null-byte-detection'
@@ -1934,7 +2002,7 @@ use \"coding: 'raw-text\" instead."
(goto-char pos)
(when (and set-auto-coding-for-load
(re-search-forward re-unibyte tail-end t))
- (display-warning 'mule "`unibyte: t' is obsolete; \
+ (display-warning 'mule "\"unibyte: t\" is obsolete; \
use \"coding: 'raw-text\" instead." :warning)
(setq coding-system 'raw-text))
(when (and (not coding-system)
@@ -2249,7 +2317,13 @@ ALIST is an alist, each element has the form (FROM . TO).
FROM and TO are a character or a vector of characters.
If FROM is a character, that character is translated to TO.
If FROM is a vector of characters, that sequence is translated to TO.
-The first extra-slot of the value is a translation table for reverse mapping."
+The first extra-slot of the value is a translation table for reverse mapping.
+
+FROM and TO may be nil. If TO is nil, the translation from FROM
+to nothing is defined in the translation table and that element
+is ignored in the reverse map. If FROM is nil, the translation
+from TO to nothing is defined in the reverse map only. A vector
+of length zero has the same meaning as specifying nil."
(let ((tables (vector (make-char-table 'translation-table)
(make-char-table 'translation-table)))
table max-lookup from to idx val)
@@ -2262,20 +2336,23 @@ The first extra-slot of the value is a translation table for reverse mapping."
(setq from (cdr elt) to (car elt)))
(if (characterp from)
(setq idx from)
- (setq idx (aref from 0)
- max-lookup (max max-lookup (length from))))
- (setq val (aref table idx))
- (if val
- (progn
- (or (consp val)
- (setq val (list (cons (vector idx) val))))
- (if (characterp from)
- (setq from (vector from)))
- (setq val (nconc val (list (cons from to)))))
- (if (characterp from)
- (setq val to)
- (setq val (list (cons from to)))))
- (aset table idx val))
+ (if (= (length from) 0)
+ (setq idx nil)
+ (setq idx (aref from 0)
+ max-lookup (max max-lookup (length from)))))
+ (when idx
+ (setq val (aref table idx))
+ (if val
+ (progn
+ (or (consp val)
+ (setq val (list (cons (vector idx) val))))
+ (if (characterp from)
+ (setq from (vector from)))
+ (setq val (nconc val (list (cons from to)))))
+ (if (characterp from)
+ (setq val to)
+ (setq val (list (cons from to)))))
+ (aset table idx val)))
(set-char-table-extra-slot table 1 max-lookup))
(set-char-table-extra-slot (aref tables 0) 0 (aref tables 1))
(aref tables 0)))
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 265fa6fc09e..18ebf91d505 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -1,8 +1,8 @@
;;; ogonek.el --- change the encoding of Polish diacritics
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
-;; Author: W{\l}odek Bzyl
+;; Author: Włodek Bzyl
;; Ryszard Kubiak
;; Maintainer: Ryszard Kubiak <rysiek@ipipan.gda.pl>
;; Keywords: i18n
@@ -75,7 +75,7 @@ are given in the following order:
Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy
biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'.
W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac
-polecenie `M-x kill-buffer'.
+polecenie `\\[kill-buffer]'.
Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich
znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
@@ -133,10 +133,10 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
`~/.emacs' za/z/ada/c wczytania wybranych funkcji, na dodatek dopiero
w chwili ich rzeczywistego u/zycia:
- (autoload 'ogonek-jak \"ogonek\")
- (autoload 'ogonek-recode-region \"ogonek\")
- (autoload 'ogonek-prefixify-region \"ogonek\")
- (autoload 'ogonek-deprefixify-region \"ogonek\")
+ (autoload \\='ogonek-jak \"ogonek\")
+ (autoload \\='ogonek-recode-region \"ogonek\")
+ (autoload \\='ogonek-prefixify-region \"ogonek\")
+ (autoload \\='ogonek-deprefixify-region \"ogonek\")
Cz/esto wyst/epuj/ace kombinacje wywo/la/n funkcji mo/zna dla wygody
skr/oci/c i przypisa/c klawiszom. Oto praktyczne przyk/lady:
@@ -144,17 +144,17 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
(defun deprefixify-iso8859-2-region (start end)
(interactive \"*r\")
(ogonek-deprefixify-region start end ?/ \"iso8859-2\"))
- (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
+ (global-set-key \"\\C-cd\" \\='deprefixify-iso8859-2-region) ; ctrl-c d
(defun mazovia-to-iso8859-2 (start end)
(interactive \"*r\")
(ogonek-recode-region start end \"mazovia\" \"iso8859-2\"))
- (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
+ (global-set-key \"\\C-cr\" \\='mazovia-to-iso8859-2) ; ctrl-c r
(defun prefixify-iso8859-2-region (start end)
(interactive \"*r\")
(ogonek-prefixify-region start end \"iso8859-2\" ?/))
- (global-set-key \"\\C-cp\" 'prefixify-iso8859-2-region) ; ctrl-c p
+ (global-set-key \"\\C-cp\" \\='prefixify-iso8859-2-region) ; ctrl-c p
Ka/zd/a operacj/e przekodowania mo/zna w ca/lo/sci odwo/la/c
przez wykonanie polecenia `undo'.")
@@ -163,7 +163,7 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
"Display `ogonek-informacja' in an auxiliary *ogonek-jak* buffer."
(interactive)
(set-buffer (get-buffer-create " *ogonek-jak*"))
- (insert ogonek-informacja)
+ (insert (substitute-command-keys ogonek-informacja))
(switch-to-buffer " *ogonek-jak*")
(goto-char (point-min)))
@@ -174,7 +174,7 @@ znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
If you read this text then you are either looking at the library's
source text or you have called the `ogonek-how' command. In the
-latter case you may remove this text using `M-x kill-buffer'.
+latter case you may remove this text using `\\[kill-buffer]'.
The library provides functions for changing the encoding of Polish
diacritic characters, the ones with an `ogonek' below or above them.
@@ -233,10 +233,10 @@ The functions come in the following groups.
to autoload the needed functions, for example by adding the
following lines to your init file:
- (autoload 'ogonek-how \"ogonek\")
- (autoload 'ogonek-recode-region \"ogonek\")
- (autoload 'ogonek-prefixify-region \"ogonek\")
- (autoload 'ogonek-deprefixify-region \"ogonek\")
+ (autoload \\='ogonek-how \"ogonek\")
+ (autoload \\='ogonek-recode-region \"ogonek\")
+ (autoload \\='ogonek-prefixify-region \"ogonek\")
+ (autoload \\='ogonek-deprefixify-region \"ogonek\")
The most frequent function calls can be abbreviated and assigned to
keyboard keys. Here are a few practical examples:
@@ -244,17 +244,17 @@ The functions come in the following groups.
(defun deprefixify-iso8859-2-region (start end)
(interactive \"*r\")
(ogonek-deprefixify-region start end ?/ \"iso8859-2\"))
- (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
+ (global-set-key \"\\C-cd\" \\='deprefixify-iso8859-2-region) ; ctrl-c d
(defun mazovia-to-iso8859-2 (start end)
(interactive \"*r\")
(ogonek-recode-region start end \"mazovia\" \"iso8859-2\"))
- (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
+ (global-set-key \"\\C-cr\" \\='mazovia-to-iso8859-2) ; ctrl-c r
(defun prefixify-iso8859-2-region (start end)
(interactive \"*r\")
(ogonek-prefixify-region start end \"iso8859-2\" ?/))
- (global-set-key \"\\C-cp\" 'prefixify-iso8859-2-region) ; ctrl-c p
+ (global-set-key \"\\C-cp\" \\='prefixify-iso8859-2-region) ; ctrl-c p
Each recoding operation can be called off using the `undo' command.")
@@ -262,7 +262,7 @@ The functions come in the following groups.
"Display `ogonek-information' in an auxiliary *recode-how* buffer."
(interactive "*")
(set-buffer (get-buffer-create " *ogonek-how*"))
- (insert ogonek-information)
+ (insert (substitute-command-keys ogonek-information))
(switch-to-buffer " *ogonek-how*")
(goto-char (point-min)))
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 245f7975d91..01676ac4fba 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1,6 +1,6 @@
;;; quail.el --- provides simple input method for multilingual text
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -202,7 +202,7 @@ It is an alist of translations and corresponding keys."
See also the documentation of `quail-define-package'."
(nth 11 quail-current-package))
(defsubst quail-overlay-plist ()
- "Return property list of an overly used in the current Quail package."
+ "Return property list of an overlay used in the current Quail package."
(nth 12 quail-current-package))
(defsubst quail-update-translation-function ()
"Return a function for updating translation in the current Quail package."
@@ -252,15 +252,16 @@ This activates input method defined by PACKAGE-NAME by running
(with-output-to-temp-buffer "*Help*"
(princ "Quail package \"")
(princ package-name)
- (princ "\" can't be activated\n because library \"")
+ (princ (substitute-command-keys
+ "\" can't be activated\n because library \""))
(princ (car libraries))
- (princ "\" is not in `load-path'.
+ (princ (substitute-command-keys "\" is not in `load-path'.
The most common case is that you have not yet installed appropriate
libraries in LEIM (Libraries of Emacs Input Method) which is
distributed separately from Emacs.
-LEIM is available from the same ftp directory as Emacs."))
+LEIM is available from the same ftp directory as Emacs.")))
(error "Can't use the Quail package `%s'" package-name))
(setq libraries (cdr libraries))))))
(quail-select-package package-name)
@@ -445,10 +446,11 @@ user's keyboard layout to the standard keyboard layout. See the
documentation of `quail-keyboard-layout' and
`quail-keyboard-layout-standard' for more detail.
-SHOW-LAYOUT non-nil means the `quail-help' command should show
-the user's keyboard layout visually with translated characters.
-If KBD-TRANSLATE is set, it is desirable to set also this flag unless
-this package defines no translations for single character keys.
+SHOW-LAYOUT non-nil means the function `quail-help' (as used by
+the command `describe-input-method') should show the user's keyboard
+layout visually with translated characters. If KBD-TRANSLATE is
+set, it is desirable to also set this flag, unless this package
+defines no translations for single character keys.
CREATE-DECODE-MAP non-nil means decode map is also created. A decode
map is an alist of translations and corresponding original keys.
@@ -624,7 +626,7 @@ While this input method is active, the variable
"Standard keyboard layout of printable characters Quail assumes.
See the documentation of `quail-keyboard-layout' for this format.
This layout is almost the same as that of VT100,
- but the location of key \\ (backslash) is just right of key ' (single-quote),
+ but the location of key \\ (backslash) is just right of key \\=' (single-quote),
not right of RETURN key.")
(defconst quail-keyboard-layout-len 180)
@@ -792,9 +794,10 @@ you type is correctly handled."
keyseq)))
(defun quail-insert-kbd-layout (kbd-layout)
-"Insert the visual keyboard layout table according to KBD-LAYOUT.
+ "Insert the visual keyboard layout table according to KBD-LAYOUT.
The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
(let (done-list layout i ch)
+ (setq bidi-paragraph-direction 'left-to-right)
;; At first, convert KBD-LAYOUT to the same size vector that
;; contains translated character or string.
(setq layout (string-to-vector kbd-layout)
@@ -1303,7 +1306,7 @@ The returned value is a Quail map specific to KEY."
(define-error 'quail-error nil)
(defun quail-error (&rest args)
- (signal 'quail-error (apply 'format args)))
+ (signal 'quail-error (apply #'format-message args)))
(defun quail-input-string-to-events (str)
"Convert input string STR to a list of events.
@@ -1334,9 +1337,7 @@ If STR has `advice' text property, append the following special event:
overriding-local-map)
(list key)
(quail-setup-overlays (quail-conversion-keymap))
- (let ((modified-p (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-modification-hooks t))
+ (with-silent-modifications
(unwind-protect
(let ((input-string (if (quail-conversion-keymap)
(quail-start-conversion key)
@@ -1348,7 +1349,6 @@ If STR has `advice' text property, append the following special event:
(list (aref input-string 0))
(quail-input-string-to-events input-string))))
(quail-delete-overlays)
- (set-buffer-modified-p modified-p)
;; Run this hook only when the current input method doesn't require
;; conversion. When conversion is required, the conversion function
;; should run this hook at a proper timing.
@@ -1416,7 +1416,8 @@ Return the input string."
;; KEYSEQ is not defined in the translation keymap.
;; Let's return the event(s) to the caller.
(setq unread-command-events
- (string-to-list (this-single-command-raw-keys)))
+ (append (this-single-command-raw-keys)
+ unread-command-events))
(setq quail-translating nil))))
(quail-delete-region)
quail-current-str)
@@ -1492,7 +1493,8 @@ Return the input string."
;; KEYSEQ is not defined in the conversion keymap.
;; Let's return the event(s) to the caller.
(setq unread-command-events
- (string-to-list (this-single-command-raw-keys)))
+ (append (this-single-command-raw-keys)
+ unread-command-events))
(setq quail-converting nil))))
(setq quail-translating nil)
(if (overlay-start quail-conv-overlay)
@@ -2486,7 +2488,6 @@ should be made by `quail-build-decode-map' (which see)."
"Show brief description of the current Quail package.
Optional arg PACKAGE specifies the name of alternative Quail
package to describe."
- (interactive)
(require 'help-mode)
(let ((help-xref-mule-regexp help-xref-mule-regexp-template)
(mb enable-multibyte-characters)
@@ -2533,33 +2534,37 @@ package to describe."
(let ((done-list nil))
;; Show keyboard layout if the current package requests it..
(when (quail-show-layout)
- (insert "
+ (insert (substitute-command-keys "
KEYBOARD LAYOUT
---------------
This input method works by translating individual input characters.
-Assuming that your actual keyboard has the `")
+Assuming that your actual keyboard has the `"))
(help-insert-xref-button
quail-keyboard-layout-type
'quail-keyboard-layout-button
quail-keyboard-layout-type)
- (insert "' layout,
-translation results in the following \"virtual\" keyboard layout:
-")
+ (insert (substitute-command-keys "' layout,
+translation results in the following \"virtual\" keyboard layout
+\(the labels on the keys indicate what character will be produced
+by each key, with and without holding Shift):
+"))
(setq done-list
(quail-insert-kbd-layout quail-keyboard-layout))
- (insert "If your keyboard has a different layout, rearranged from
-`")
+ (insert (substitute-command-keys "\
+If your keyboard has a different layout, rearranged from
+`"))
(help-insert-xref-button
"standard"
'quail-keyboard-layout-button "standard")
- (insert "', the \"virtual\" keyboard you get with this input method
+ (insert (substitute-command-keys "\
+', the \"virtual\" keyboard you get with this input method
will be rearranged in the same way.
You can set the variable `quail-keyboard-layout-type' to specify
the physical layout of your keyboard; the tables shown in
documentation of input methods including this one are based on the
physical keyboard layout as specified with that variable.
-")
+"))
(help-insert-xref-button
"[customize keyboard layout]"
'quail-keyboard-customize-button 'quail-keyboard-layout-type)
@@ -2983,7 +2988,7 @@ of each directory."
quail-dirs list-buf pkg-list pos)
(if (not (file-writable-p leim-list))
(error "Can't write to file \"%s\"" leim-list))
- (message "Updating %s ..." leim-list)
+ (or noninteractive (message "Updating %s ..." leim-list))
(setq list-buf (find-file-noselect leim-list))
;; At first, clean up the file.
@@ -3075,7 +3080,7 @@ of each directory."
(let ((coding-system-for-write 'utf-8))
(save-buffer 0)))
(kill-buffer list-buf)
- (message "Updating %s ... done" leim-list)))
+ (or noninteractive (message "Updating %s ... done" leim-list))))
(defun quail-advice (args)
"Advise users about the characters input by the current Quail package.
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 897075f0faf..0ef90b18932 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -466,7 +466,7 @@ While this input method is active, the variable
(list key)
(delete-region start (point))
(if key
- (setq unread-command-events (list key)))
+ (push key unread-command-events))
(if (stringp output)
(string-to-list output)
(list output))))))
@@ -576,7 +576,7 @@ used."
(provide 'robin)
;; Local Variables:
-;; coding: utf-8-emacs
+;; coding: utf-8
;; End:
;;; robin.el ends here
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index bcad78d8ce0..f22b30e613b 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -1,6 +1,6 @@
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; -*-
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -86,7 +86,7 @@
'(("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 base input method for Chinese charset GB2312 (`chinese-gb2312').
Pinyin is the standard Roman transliteration method for Chinese.
For the detail of Pinyin system, see the documentation of the input
@@ -272,13 +272,12 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy
(princ ";; Quail package `")
(princ package)
- (princ (format "' -*- coding:%s -*-\n" coding-system-for-write))
- (princ ";; Generated by the command `titdic-convert'\n")
+ (princ "\n")
+ (princ (substitute-command-keys
+ ";; Generated by the command `titdic-convert'\n"))
(princ ";;\tOriginal TIT dictionary file: ")
(princ (file-name-nondirectory filename))
- (princ "\n\n;;; Comment:\n\n")
- (princ ";; Byte-compile this file again after any modification.\n\n")
- (princ ";;; Start of the header of original TIT dictionary.\n\n")
+ (princ "\n\n")
(while (not (eobp))
(let ((ch (following-char))
@@ -518,7 +517,13 @@ the generated Quail package is saved."
(widen)
;; Process the body part
- (tit-process-body))))))
+ (tit-process-body)
+
+ (princ ";; Local Variables:\n")
+ (princ ";; version-control: never\n")
+ (princ ";; no-update-autoloads: t\n")
+ (princ (format ";; coding: %s\n" coding-system-for-write))
+ (princ ";; End:\n"))))))
;;;###autoload
(defun batch-titdic-convert (&optional force)
@@ -558,9 +563,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
(message "Converting %s to quail-package..." file)
(titdic-convert file targetdir))
(setq files (cdr files)))
- (setq command-line-args-left (cdr command-line-args-left)))
- (message "Byte-compile the created files by:")
- (message " %% emacs -batch -f batch-byte-compile XXX.el")))
+ (setq command-line-args-left (cdr command-line-args-left)))))
(kill-emacs 0))
@@ -1148,9 +1151,9 @@ the generated Quail package is saved."
(setq coding-system-for-write
(coding-system-change-eol-conversion coding 'unix))
(with-temp-file (expand-file-name quailfile dirname)
- (insert (format ";; Quail package `%s' -*- coding:%s -*-\n"
- name coding))
- (insert ";; Generated by the command `miscdic-convert'\n")
+ (insert (format-message ";; Quail package `%s'\n" name))
+ (insert (format-message
+ ";; Generated by the command `miscdic-convert'\n"))
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";; Copyright notice of the source file\n")
(insert ";;------------------------------------------------------\n")
@@ -1168,7 +1171,13 @@ the generated Quail package is saved."
(coding-system-change-eol-conversion coding 'unix))
(dicbuf (find-file-noselect filename)))
(funcall converter dicbuf name title)
- (kill-buffer dicbuf)))
+ (kill-buffer dicbuf))
+ (insert ";; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-update-autoloads: t\n"
+ (format ";; coding: %s\n" coding)
+ ";; End:\n\n"
+ ";;; " quailfile " ends here\n"))
(message "Converting %s to %s...done" dicfile quailfile))
(setq tail (cdr tail)))))
@@ -1198,4 +1207,7 @@ to store generated Quail packages."
(miscdic-convert filename dir))))
(kill-emacs 0))
+;; Prevent "Local Variables" above confusing Emacs.
+
+
;;; titdic-cnv.el ends here
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index 9ff2573fda2..8839b00dfff 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -1,6 +1,6 @@
;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Taichi Kawabata <kawabata.taichi@gmail.com>
;; Keywords: unicode, normalization
@@ -131,7 +131,7 @@
This list is taken from
http://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
- ;; Unicode ranges that decompositions & combinings are defined.
+ ;; Unicode ranges that decompositions & combining characters are defined.
(defvar check-range nil)
(setq check-range '((#x00a0 . #x3400) (#xA600 . #xAC00) (#xF900 . #x110ff) (#x1d000 . #x1dfff) (#x1f100 . #x1f2ff) (#x2f800 . #x2faff)))
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
deleted file mode 100644
index ba1bd436b23..00000000000
--- a/lisp/international/uni-bidi.el
+++ /dev/null
@@ -1,23 +0,0 @@
-;; Copyright (C) 1991-2009 Unicode, Inc.
-;; This file was generated from the Unicode data files at
-;; http://www.unicode.org/Public/UNIDATA/.
-;; See lisp/international/README for the copyright and permission notice.
-(define-char-code-property 'bidi-class #^[1 nil char-code-property-table
-#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] #^^[1 0 #^^[2 0
-#^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "…š„„ƒ…—Ÿˆ" 1 1 1 "¹‡ŽŽ…‰‘" "ð„ˆ" "„î‰" 1 "ƒ‡ö" 1 "Š„­¸" "…‹°•Šƒ" "Ö‡†„Š†" "Žž›³" "¦‹Ž«‰„†" "–„‰ƒ…«ƒ¤" " ‹·›" "ƒ·„ˆ„ƒ‡Šœ" "º„„ˆ”Ž‡„" "¹„„ƒƒžƒŠ" "¹„…„”Ž" "º„ˆˆ‹œ" "½Œ¥†…" "¾ƒ…ƒ„‡‹”‡" "¼”œ" "Á„ˆ”œ" "ʇƒ©" "±‡„‡ˆ±" "±†‹†²" "˜›„³Ž" "……‹¤‰¹"] #^^[2 4096 "­„†™„ƒ„‹" "†â" 1 1 1 1 "݃ " "Šæ" "ÿ" 1 1 1 1 "šã" "’ƒƒžŒ" "´‡ˆ‹‡’Š†" "‹ƒñ" "©Ö" " ƒ„‰†ƒ„ƒº" "Þ¢" "—½‡ˆ†Š" 1 "„°……¨‰Œ" " „ºƒƒŽ" "¬ˆÈ" "Ѓ‡„†‹" 1 "À§•„" 1 1 1 "½ƒ‹ƒƒƒ"] #^^[2 8192 "‹ƒ˜
- …š……†ƒ† ƒ" "Š ƒ‘›•¡" "„Šƒ…†„‹„……„ " "‰†ð" "’ ì" 19 "¶Å…" "•ÞŒ" "§™‹• " "ˆ”Ζ" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "̓Š¦" 1 1 "冄ƒ‡‡" "ÿ" "à " "¼Ä" "šÙŒ" 19 "ÖšŒ„"] #^^[2 12288 "„ƒ™‰„……ƒÀ" "™ƒÚ„" 1 "À¤œ" "±œƒ" "±Œ„°" "÷„…" "ÞŸ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "·¹" 1 1 "ƒß„Š" "ŸÐŽ" "¢Þ" "ˆ÷" "ƒ„™„Œº„ˆ" "Ä›’Ž" "¦ˆ™‹®" "ƒ°„Ã" "©†Œˆ³" "°ƒ…ªˆ‰" 1 "å„’" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "Š ¦°" 7 7 7 "¾À" "ý" "Š†‡‰ ‰ ƒ„" "ÿ" "ƒ…  Š†š†š‹š" "àƒ‡Š…"]] #^^[1 65536 #^^[2 65536 1 1 "¾À" "‹…Œá" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "Ÿà" 2 "ƒ…„¨ƒ„À" 2 "¹‡À" 2 2 2 2 2 "àŸ" 2 2 2] #^^[2 69632 "¶‹”š" "±„Å" "ƒ¤…ˆË" "´‰Á" 1 1 1 1 1 1 1 1 1 "«†È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "„í"] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "烉ˆ…" "ƒ‡ž„Ò" "ƒº" 1 "ש" 1 1 1 1 1 1 "Û¤" "•¹°" "‰¹Š²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 "„›Š„†„ƒ„‡„„" "Š‘…ƒ…‘´Ž" 2 2] #^^[2 126976 "¬„Ð" "”ŒŽ " "‹ß”" 1 1 1 "¡†Æƒ" "”Œ¥…•‘" "¿¾" "ø„ƒ" "¾„Œ˜˜" "û…" "Á„‹°" "ƺ" "ôŒ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1
-#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 #^^[2 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 "žà" 1 16 "ð" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 1048448 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]] #^^[1 1048576 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1110016 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 1113984 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 bidi-class 0 1 #[(val) "\301\236A\207" [val ((L . "Left-to-Right") (LRE . "Left-to-Right Embedding") (LRO . "Left-to-Right Override") (R . "Right-to-Left") (AL . "Right-to-Left Arabic") (RLE . "Right-to-Left Embedding") (RLO . "Right-to-Left Override") (PDF . "Pop Directional Format") (EN . "European Number") (ES . "European Number Separator") (ET . "European Number Terminator") (AN . "Arabic Number") (CS . "Common Number Separator") (NSM . "Non-Spacing Mark") (BN . "Boundary Neutral") (B . "Paragraph Separator") (S . "Segment Separator") (WS . "Whitespace") (ON . "Other Neutrals"))] 2] [nil L R EN AN BN B AL LRE LRO RLE RLO PDF ES ET CS NSM S WS ON]] "Unicode bidi class.
-Property value is one of the following symbols:
- L, LRE, LRO, R, AL, RLE, RLO, PDF, EN, ES, ET,
- AN, CS, NSM, BN, B, S, WS, ON")
-;; Local Variables:
-;; coding: utf-8
-;; no-byte-compile: t
-;; End:
-
-;; uni-bidi.el ends here
diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el
deleted file mode 100644
index 75ebc04c98f..00000000000
--- a/lisp/international/uni-category.el
+++ /dev/null
@@ -1,35 +0,0 @@
-;; Copyright (C) 1991-2009 Unicode, Inc.
-;; This file was generated from the Unicode data files at
-;; http://www.unicode.org/Public/UNIDATA/.
-;; See lisp/international/README for the copyright and permission notice.
-(define-char-code-property 'general-category #^[30 nil char-code-property-table
-#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] #^^[1 0 #^^[2 0
-#^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] " „   ƒ—‡˜ˆ" "" "ƒ„ƒƒƒƒ„ƒ" "‡„±" "”›’„ŒŽ…‡‘" "ðƒ" "„ƒ‘‰£ƒƒ…ƒ" "°°" "…" "‰¦†Ÿ" "ˆ „­ ˆ›…ƒ‹" "…ƒ‹ Š• Š„" "Ô‡†„ Šƒ" "Žž›³" "¦‹Ž Š¡‰ƒ…" "–„‰ƒ…™ƒ¡" " ‹·›" "ƒ¶ƒˆ„‡Š Š†‡" "ˆ–‡ƒ„ƒ„ˆ„ƒ Š †„" "†„–‡ƒ„ƒƒ‡„‡ ŠƒŠ" "‰ƒ–‡…ƒ… ŠŽ" "ˆ–‡…„ˆ„ƒ Š †ˆ" "†ƒƒ„ƒƒƒƒƒŒ„ƒƒƒ†Ž Š ƒ†…" "ƒˆƒ—Š…ƒƒ„ƒ„‡† Šˆ ‡" "ˆƒ—Š……‡‡ Š" "ˆƒ©ƒ„ƒƒˆˆ Š †ƒ†" "’ƒ˜‰‡ƒ„ƒƒˆ’‹" "°‡„†ˆ Š¤" "†„‡ƒ„†…† Š„ " "ƒƒ† Š Šˆ¤„Ž" "……‹¤ˆ†…„¥"] #^^[2 4096 "«„† Š††„ƒƒ‡ƒ„‹" "† Šƒ¦…«ƒ" 5 5 "É„‡„ " "‰„¡„‡„¨" "‘„É ”ƒ" "Š†Õ‹" " ÿ" 5 5 5 "í‘" "šƒËƒ
-ƒ" "„ƒ‹’ƒ‰’ŒƒŒ" "´‡ˆ‹ƒƒ Š† Š†" "† „ƒ Š†£´ˆ" "©…ÆŠ" "ƒƒ„ƒ„†ƒ„ƒ Šž…‹" "¬„‘‡† Š ƒ¢" "—ƒµ‡ˆ†Š" " Š† Š†‡†Ò" "„¯……‡„ Š‡Š‰‰ƒ" "ž„ Š¬ƒƒˆ„" "¤ˆˆƒ… Šƒƒ Šž†" "Àˆˆƒ‡„„‰" "¬¿‡" "›¥§•„" "" "‰" "ˆˆ††ˆˆˆˆ††ˆˆˆŽ" "ˆˆˆˆˆˆ…„ƒƒ„ƒ„„ƒˆ…ƒƒ„"] #^^[2 8192 "‹… †ˆ…‰„ ƒ‹ Š……†  †ƒ" " Šƒƒ›•„ƒŒ" "„ƒƒ…†„„„…„ 
- " "
-ƒ
-„ †……„‡ŸŸŒ" 19 19 "ˆ„”‡Ñƒ" "›™¨†’Œ" "§™‹•  " " œÎ –" 22 "·‰¶ˆ" "ï" 22 "ç Š" " ”¬…Ÿ" 22 22 19 "ƒ¿ " 19 19 "°•†ƒŠ¦" 30 "¯¯ƒ„†" "†ƒ…„ " "¦…¸‡Ž" "—‰‡‡‡‡‡‡‡‡ " "ƒ‰  …Š Ä" "šÙŒ" 22 "ÖšŒ„"] #^^[2 12288 "ƒ
- 
-‰„ …
-ƒ¿" "— Úƒ" "…©ƒÏ" " „Š›…¤Œ" "Ÿ Šž ˆ  " " Š§ ¿" 22 22 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 16384 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¶ŠÀ" 5 5 5 5] 5 5 5 5 #^^[2 36864 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
-#^^[3 40832 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[2 40960 "•ê" 5 5 5 5 5 5 5 5 "ƒ·‰¨†" 5 5 "Œƒ Š”ƒŠ" "‡Æ
-Š†ˆ" "—‰ƒˆ" "ŒÍ…" "ƒ„—„„ ††´„ˆ" "²‰ Š†’†ƒ„" " Šœˆ—‹‹ƒ" "ƒ¯„„ Š„ " "©†‰ƒˆ Š„†ƒ„" "°ƒ…˜‹‰" "†††‰‡‡Ñ" "À£ Š†" 5 5 5 5 5 5 5 5] 5 5 #^^[2 53248 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 "¤Œ—„±„" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 29 #^^[2 61440 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 5 5 "î" "Ú¦" "‡Œ……Š…º" "²‘­" 5 5 "¾°" "¶¨Œ" "‡†‡‰ „ ƒƒ„ ƒ ƒ„…Š" "ý" "ƒƒ  Šƒš šŠ" "žŸƒ†††ƒƒ„Šƒ"]] #^^[1 65536 #^^[2 65536 "Œš“Ž¢" "û…" "ƒ„ ­ƒ‰
-µ „‡" "Š …Œ´­" 30 "ƒ±¯" "Ÿ „Œ‘
-ˆ
-µ" "ž¤„ˆ
-…ª" "¨¨°" "ž ŠÖ" 30 30 30 30 30 30 "†¬ƒ— ˆ " 30 "– †ƒš…À" "¸†À" "ƒ…„„ƒ›„ƒ„ ˆˆ‰‡ " 30 "¶ƒ‡– ˆ“… ˆ" 30 "É·" 30 30 30 "à Ÿ" 30 30 30] #^^[2 69632 "µ‡„ ” Š" "­ƒ„„Ž™‡ Š†" "ƒ¤…ˆ Š„¼" "°ƒ‰„„‡ Š¦" 30 30 30 30 30 30 30 30 30 "«†ˆ Š¶" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 73728 5 5 5 5 5 5 "ï‘" 30 "
-㍄Œ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 77824 5 5 5 5 5 5 5 5 "¯Ñ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 #^^[2 90112 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "¹Ç" 30 30 30 30 30 30 30 30 30 "Å‹®" "„à"] 30 30 30 30 #^^[2 110592 "þ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 #^^[2 118784 22 "öŠ" "§¼ƒƒ†ˆ…" "ƒ‡ž„°¢" "ƒº" 30 "׉ ’Ž" 30 "ššš‡’˜" "š„ˆ„‡‹š–" "„„ˆ‡š„…ƒ‡š”" "†šššš’" "ˆšššš" "Šœ™™†™„" "•†™™†™" "‰†™™† ²" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[2 122880 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 "„›Š„†„ƒ„‡„„" "Š‘…ƒ…‘´Ž" 30 30] #^^[2 126976 "¬„Ð" "”ŒŽ " " ‹…Ÿ¼„" "›Ëš" "ƒ«…‰‡®" 30 "¡†Æƒ" "”Œ¥…•‘" "¿¾" "ø„ƒ" "¾„Œ˜˜" "û…" "Á„‹°" "ƺ" "ôŒ" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30]] #^^[1 131072 5 5 5 5 5 5 5 5 5 5 #^^[2 172032 5 5 5 5 5 5 5 5 5 5 5 5 5
-#^^[3 173696 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] #^^[2 176128 5 5 5 5 5 5 5 5 5 5 5 5 5 5
-#^^[3 177920 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5] 5
-#^^[3 178176 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 #^^[2 192512 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 5 5 5 5 "žâ" 30 30 30 30 30 30 30 30 30 30 30]] 30 30 30 30 30 30 30 30 30 30 30 #^^[1 917504 #^^[2 917504 "žà" 30 6 "ð" 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30] #^^[1 983040 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 #^^[2 1044480 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29
-#^^[3 1048448 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 30 30]]] #^^[1 1048576 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 #^^[2 1110016 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29
-#^^[3 1113984 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 29 30 30]]] 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 30 general-category 0 1 #[(val) "\301\236A\207" [val ((nil . "Uknown") (Lu . "Letter, Uppercase") (Ll . "Letter, Lowercase") (Lt . "Letter, Titlecase") (Lm . "Letter, Modifier") (Lo . "Letter, Other") (Mn . "Mark, Nonspacing") (Mc . "Mark, Spacing Combining") (Me . "Mark, Enclosing") (Nd . "Number, Decimal Digit") (Nl . "Number, Letter") (No . "Number, Other") (Pc . "Punctuation, Connector") (Pd . "Punctuation, Dash") (Ps . "Punctuation, Open") (Pe . "Punctuation, Close") (Pi . "Punctuation, Initial quote") (Pf . "Punctuation, Final quote") (Po . "Punctuation, Other") (Sm . "Symbol, Math") (Sc . "Symbol, Currency") (Sk . "Symbol, Modifier") (So . "Symbol, Other") (Zs . "Separator, Space") (Zl . "Separator, Line") (Zp . "Separator, Paragraph") (Cc . "Other, Control") (Cf . "Other, Format") (Cs . "Other, Surrogate") (Co . "Other, Private Use") (Cn . "Other, Not Assigned"))] 2] [nil Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co Cn]] "Unicode general category.
-Property value is one of the following symbols:
- Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
- Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn")
-;; Local Variables:
-;; coding: utf-8
-;; no-byte-compile: t
-;; End:
-
-;; uni-category.el ends here
diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el
deleted file mode 100644
index 3863f95f881..00000000000
--- a/lisp/international/uni-combining.el
+++ /dev/null
@@ -1,23 +0,0 @@
-;; Copyright (C) 1991-2009 Unicode, Inc.
-;; This file was generated from the Unicode data files at
-;; http://www.unicode.org/Public/UNIDATA/.
-;; See lisp/international/README for the copyright and permission notice.
-(define-char-code-property 'canonical-combining-class #^[1 nil char-code-property-table 1 #^^[1 0 #^^[2 0 1 1 1 1 1 1 "•„…„‹…„ˆƒƒƒ„
-
-
-
- " 1 1 "ƒ…ø" 1 "‘„ƒ ††  ¸" "ˆ° !\"#$…%" "Ö‡„’" "‘&žƒƒµ" "뇌" "–„‰ƒ…«ƒ¤" "䃃 !\"ƒ„" "¼'(ƒ«" "¼'(²" "¼'(²" "¼'(²" "¼'(²" "Í(²" "Í(‡)*©" "¼'(²" "Í(²" "Ê(µ" "¸++(,„´" "¸--Ž.„´" "˜›·/01…0„" "0(¾¹"] #^^[2 4096 "·'((Å" "ò" 1 1 1 1 "݃ " 1 1 1 1 1 1 1 "”(Ÿ(Ë" "Ò(Š¢" 1 "© Ö" "¹ Ä" 1 "—Ç(”ˆ" 1 "´'(¦‡Œ" "ª((º'‹((Œ" "·'È" "Ѓ…„‡„†‹" 1 "À‡
-2–• " 1 1 1 1] #^^[2 8192 1 "Єƒ„ƒ„" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "" "ÿ(" "à " 1 1 1 1] #^^[2 12288 "ª3  44Ð" "™55å" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 1 1 1 "ï„Š" "ŸÐŽ" 1 1 "†(ù" "Ä(›’Ž" "«ƒ¥(¬" "³'Œ(¿" 1 "°…´(‰" 1 "í(’" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ž6á" 1 1 1 1 1 " ‡Ù" 1 1 1]] #^^[1 65536 #^^[2 65536 1 1 1 "ý" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "¨„(À" 1 1 1 1 1 1 1 1 1 1 1] #^^[2 69632 "Æ(¹" "¹('Å" "ƒ°((Ë" "À(¿" 1 1 1 1 1 1 1 1 1 "¶('È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "僃7…ˆ…" "ƒ…ž„Ò" "ƒ»" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 126976 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1
-#^^[3 178176 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 #^^[2 192512 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] 1 1 1 1 1 1 1 1 1 1 1 #^^[1 917504 #^^[2 917504 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[1 983040 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1044480 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 1048448 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]] #^^[1 1048576 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[2 1110016 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
-#^^[3 1113984 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]]] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 canonical-combining-class 0 1 #[(val) "\301\236A\207" [val ((0 . "Spacing, split, enclosing, reordrant, and Tibetan subjoined") (1 . "Overlays and interior") (7 . "Nuktas") (8 . "Hiragana/Katakana voicing marks") (9 . "Viramas") (10 . "Start of fixed position classes") (199 . "End of fixed position classes") (200 . "Below left attached") (202 . "Below attached") (204 . "Below right attached") (208 . "Left attached (reordrant around single base character)") (210 . "Right attached") (212 . "Above left attached") (214 . "Above attached") (216 . "Above right attached") (218 . "Below left") (220 . "Below") (222 . "Below right") (224 . "Left (reordrant around single base character)") (226 . "Right") (228 . "Above left") (230 . "Above") (232 . "Above right") (233 . "Double below") (234 . "Double above") (240 . "Below (iota subscript)"))] 2] [nil 0 230 232 220 216 202 1 240 233 234 222 228 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 30 31 32 27 28 29 33 34 35 36 7 9 84 91 103 107 118 122 129 130 132 214 218 224 8 26 226]] "Unicode canonical combining class.
-Property value is an integer.")
-;; Local Variables:
-;; coding: utf-8
-;; no-byte-compile: t
-;; End:
-
-;; uni-combining.el ends here
diff --git a/lisp/international/uni-comment.el b/lisp/international/uni-comment.el
deleted file mode 100644
index c9743064bd4..00000000000
--- a/lisp/international/uni-comment.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el
deleted file mode 100644
index 1866e7c4354..00000000000
--- a/lisp/international/uni-decimal.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-decomposition.el b/lisp/international/uni-decomposition.el
deleted file mode 100644
index 2bcca9e60fb..00000000000
--- a/lisp/international/uni-decomposition.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-digit.el b/lisp/international/uni-digit.el
deleted file mode 100644
index 405d59784a7..00000000000
--- a/lisp/international/uni-digit.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-lowercase.el b/lisp/international/uni-lowercase.el
deleted file mode 100644
index 81196499150..00000000000
--- a/lisp/international/uni-lowercase.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el
deleted file mode 100644
index c34184c0d6b..00000000000
--- a/lisp/international/uni-mirrored.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el
deleted file mode 100644
index cf37db39b48..00000000000
--- a/lisp/international/uni-name.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el
deleted file mode 100644
index 7c0be5b438a..00000000000
--- a/lisp/international/uni-numeric.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-old-name.el b/lisp/international/uni-old-name.el
deleted file mode 100644
index 6165eba61cc..00000000000
--- a/lisp/international/uni-old-name.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-titlecase.el b/lisp/international/uni-titlecase.el
deleted file mode 100644
index e3454a4dd3d..00000000000
--- a/lisp/international/uni-titlecase.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/uni-uppercase.el b/lisp/international/uni-uppercase.el
deleted file mode 100644
index 85112406d75..00000000000
--- a/lisp/international/uni-uppercase.el
+++ /dev/null
Binary files differ
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index e040d83b061..e77a5801f06 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -1,6 +1,6 @@
;;; utf-7.el --- utf-7 coding system
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n, mail
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 3ff75059b1a..b762884945e 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1,9 +1,9 @@
;;; isearch.el --- incremental search minor mode
-;; Copyright (C) 1992-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1997, 1999-2015 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: matching
;; Package: emacs
@@ -31,11 +31,7 @@
;; is completed. It uses a recursive-edit to behave this way.
;; The key bindings active within isearch-mode are defined below in
-;; `isearch-mode-map' which is given bindings close to the default
-;; characters of the original isearch.el. With `isearch-mode',
-;; however, you can bind multi-character keys and it should be easier
-;; to add new commands. One bug though: keys with meta-prefix cannot
-;; be longer than two chars. Also see minibuffer-local-isearch-map
+;; `isearch-mode-map'. Also see minibuffer-local-isearch-map
;; for bindings active during `isearch-edit-string'.
;; isearch-mode should work even if you switch windows with the mouse,
@@ -72,23 +68,20 @@
(defcustom search-exit-option t
"Non-nil means random control characters terminate incremental search."
- :type 'boolean
- :group 'isearch)
+ :type 'boolean)
(defcustom search-slow-window-lines 1
"Number of lines in slow search display windows.
These are the short windows used during incremental search on slow terminals.
Negative means put the slow search window at the top (normally it's at bottom)
and the value is minus the number of lines."
- :type 'integer
- :group 'isearch)
+ :type 'integer)
(defcustom search-slow-speed 1200
"Highest terminal speed at which to use \"slow\" style incremental search.
This is the style where a one-line window is created to show the line
that the search has reached."
- :type 'integer
- :group 'isearch)
+ :type 'integer)
(defcustom search-upper-case 'not-yanks
"If non-nil, upper case chars disable case fold searching.
@@ -99,15 +92,13 @@ If this value is `not-yanks', text yanked into the search string
in Isearch mode is always downcased."
:type '(choice (const :tag "off" nil)
(const not-yanks)
- (other :tag "on" t))
- :group 'isearch)
+ (other :tag "on" t)))
(defcustom search-nonincremental-instead t
"If non-nil, do a nonincremental search instead of exiting immediately.
Actually, `isearch-edit-string' is called to let you enter the search
string, and RET terminates editing and does a nonincremental search."
- :type 'boolean
- :group 'isearch)
+ :type 'boolean)
(defcustom search-whitespace-regexp (purecopy "\\s-+")
"If non-nil, regular expression to match a sequence of whitespace chars.
@@ -127,38 +118,40 @@ In the Customization buffer, that is `[' followed by a space,
a tab, a carriage return (control-M), a newline, and `]+'."
:type '(choice (const :tag "Match Spaces Literally" nil)
regexp)
- :group 'isearch
:version "24.3")
(defcustom search-invisible 'open
- "If t incremental search can match hidden text.
+ "If t incremental search/query-replace can match hidden text.
A nil value means don't match invisible text.
When the value is `open', if the text matched is made invisible by
an overlay having an `invisible' property and that overlay has a property
`isearch-open-invisible', then incremental search will show the contents.
\(This applies when using `outline.el' and `hideshow.el'.)
+
+To temporarily change the value for an active incremental search,
+use \\<isearch-mode-map>\\[isearch-toggle-invisible].
+
+See also the related option `isearch-hide-immediately'.
+
See also `reveal-mode' if you want overlays to automatically be opened
whenever point is in one of them."
:type '(choice (const :tag "Match hidden text" t)
(const :tag "Open overlays" open)
- (const :tag "Don't match hidden text" nil))
- :group 'isearch)
+ (const :tag "Don't match hidden text" nil)))
(defcustom isearch-hide-immediately t
"If non-nil, re-hide an invisible match right away.
This variable makes a difference when `search-invisible' is set to `open'.
-It means that after search makes some invisible text visible
-to show the match, it makes the text invisible again when the match moves.
-Ordinarily the text becomes invisible again at the end of the search."
- :type 'boolean
- :group 'isearch)
+If nil then do not re-hide opened invisible text when the match moves.
+Whatever the value, all opened invisible text is hidden again after exiting
+the search."
+ :type 'boolean)
(defcustom isearch-resume-in-command-history nil
"If non-nil, `isearch-resume' commands are added to the command history.
This allows you to resume earlier Isearch sessions through the
command history."
- :type 'boolean
- :group 'isearch)
+ :type 'boolean)
(defvar isearch-mode-hook nil
"Function(s) to call after starting up an incremental search.")
@@ -188,7 +181,7 @@ or to the end of the buffer for a backward search.")
to the search status stack.")
(defvar isearch-filter-predicate #'isearch-filter-visible
- "Predicate that filter the search hits that would normally be available.
+ "Predicate that filters the search hits that would normally be available.
Search hits that dissatisfy the predicate are skipped. The function
has two arguments: the positions of start and end of text matched by
the search. If this function returns nil, continue searching without
@@ -206,12 +199,10 @@ displayed in the search message.")
(defcustom search-ring-max 16
"Maximum length of search ring before oldest elements are thrown away."
- :type 'integer
- :group 'isearch)
+ :type 'integer)
(defcustom regexp-search-ring-max 16
"Maximum length of regexp search ring before oldest elements are thrown away."
- :type 'integer
- :group 'isearch)
+ :type 'integer)
(defvar search-ring-yank-pointer nil
"Index in `search-ring' of last string reused.
@@ -223,15 +214,34 @@ It is nil if none yet.")
(defcustom search-ring-update nil
"Non-nil if advancing or retreating in the search ring should cause search.
Default value, nil, means edit the string instead."
- :type 'boolean
- :group 'isearch)
+ :type 'boolean)
+
+(autoload 'character-fold-to-regexp "character-fold")
+
+(defcustom search-default-regexp-mode nil
+ "Default mode to use when starting isearch.
+Value is nil, t, or a function.
+
+If nil, default to literal searches (note that `case-fold-search'
+and `isearch-lax-whitespace' may still be applied).\\<isearch-mode-map>
+If t, default to regexp searches (as if typing `\\[isearch-toggle-regexp]' during
+isearch).
+
+If a function, use that function as an `isearch-regexp-function'.
+Example functions are `word-search-regexp' \(`\\[isearch-toggle-word]'),
+`isearch-symbol-regexp' \(`\\[isearch-toggle-symbol]'), and
+`character-fold-to-regexp' \(`\\[isearch-toggle-character-fold]')."
+ ;; :type is set below by `isearch-define-mode-toggle'.
+ :type '(choice (const :tag "Literal search" nil)
+ (const :tag "Regexp search" t)
+ (function :tag "Other"))
+ :version "25.1")
;;; isearch highlight customization.
(defcustom search-highlight t
"Non-nil means incremental search highlights the current match."
- :type 'boolean
- :group 'isearch)
+ :type 'boolean)
(defface isearch
'((((class color) (min-colors 88) (background light))
@@ -263,8 +273,7 @@ Default value, nil, means edit the string instead."
:foreground "grey")
(t (:inverse-video t)))
"Face for highlighting failed part in Isearch echo-area message."
- :version "23.1"
- :group 'isearch)
+ :version "23.1")
(defcustom isearch-lazy-highlight t
"Controls the lazy-highlighting during incremental search.
@@ -349,7 +358,6 @@ A value of nil means highlight all matches."
(defvar isearch-help-map
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'isearch-other-control-char)
(define-key map (char-to-string help-char) 'isearch-help-for-help)
(define-key map [help] 'isearch-help-for-help)
(define-key map [f1] 'isearch-help-for-help)
@@ -423,9 +431,6 @@ This is like `describe-bindings', but displays only Isearch keys."
;; Make all multibyte characters search for themselves.
(set-char-table-range (nth 1 map) (cons #x100 (max-char))
'isearch-printing-char)
- ;; Make function keys, etc, which aren't bound to a scrolling-function
- ;; exit the search.
- (define-key map [t] 'isearch-other-control-char)
;; Single-byte printing chars extend the search string by default.
(setq i ?\s)
@@ -439,9 +444,7 @@ This is like `describe-bindings', but displays only Isearch keys."
;; would be simpler to disable the global keymap, and/or have a
;; default local key binding for any key not otherwise bound.
(let ((meta-map (make-sparse-keymap)))
- (define-key map (char-to-string meta-prefix-char) meta-map)
- (define-key map [escape] meta-map)
- (define-key meta-map [t] 'isearch-other-meta-char))
+ (define-key map (char-to-string meta-prefix-char) meta-map))
;; Several non-printing chars change the searching behavior.
(define-key map "\C-s" 'isearch-repeat-forward)
@@ -452,17 +455,18 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map "\M-\C-s" 'isearch-repeat-forward)
(define-key map "\M-\C-r" 'isearch-repeat-backward)
(define-key map "\177" 'isearch-delete-char)
+ (define-key map [backspace] 'undefined) ;bug#20466.
(define-key map "\C-g" 'isearch-abort)
;; This assumes \e is the meta-prefix-char.
(or (= ?\e meta-prefix-char)
(error "Inconsistency in isearch.el"))
(define-key map "\e\e\e" 'isearch-cancel)
- (define-key map [escape escape escape] 'isearch-cancel)
(define-key map "\C-q" 'isearch-quote-char)
(define-key map "\r" 'isearch-exit)
+ (define-key map [return] 'isearch-exit)
(define-key map "\C-j" 'isearch-printing-char)
(define-key map "\t" 'isearch-printing-char)
(define-key map [?\S-\ ] 'isearch-printing-char)
@@ -507,12 +511,12 @@ This is like `describe-bindings', but displays only Isearch keys."
(define-key map "\M-r" 'isearch-toggle-regexp)
(define-key map "\M-e" 'isearch-edit-string)
- (define-key map "\M-sc" 'isearch-toggle-case-fold)
- (define-key map "\M-si" 'isearch-toggle-invisible)
- (define-key map "\M-sr" 'isearch-toggle-regexp)
- (define-key map "\M-sw" 'isearch-toggle-word)
- (define-key map "\M-s_" 'isearch-toggle-symbol)
- (define-key map "\M-s " 'isearch-toggle-lax-whitespace)
+ (put 'isearch-toggle-case-fold :advertised-binding "\M-sc")
+ (put 'isearch-toggle-regexp :advertised-binding "\M-sr")
+ (put 'isearch-edit-string :advertised-binding "\M-se")
+
+ (define-key map "\M-se" 'isearch-edit-string)
+ ;; More toggles defined by `isearch-define-mode-toggle'.
(define-key map [?\M-%] 'isearch-query-replace)
(define-key map [?\C-\M-%] 'isearch-query-replace-regexp)
@@ -521,9 +525,6 @@ This is like `describe-bindings', but displays only Isearch keys."
;; The key translations defined in the C-x 8 prefix should add
;; characters to the search string. See iso-transl.el.
- (define-key map "\C-x" nil)
- (define-key map [?\C-x t] 'isearch-other-control-char)
- (define-key map "\C-x8" nil)
(define-key map "\C-x8\r" 'isearch-char-by-name)
map)
@@ -547,13 +548,16 @@ This is like `describe-bindings', but displays only Isearch keys."
(defvar isearch-forward nil) ; Searching in the forward direction.
(defvar isearch-regexp nil) ; Searching for a regexp.
-(defvar isearch-word nil
+(defvar isearch-regexp-function nil
"Regexp-based search mode for words/symbols.
-If t, do incremental search for a sequence of words, ignoring punctuation.
-If the value is a function (e.g. `isearch-symbol-regexp'), it is called to
-convert the search string to a regexp used by regexp search functions.
-The property `isearch-message-prefix' put on this function specifies the
-prefix string displayed in the search message.")
+If the value is a function (e.g. `isearch-symbol-regexp'), it is
+called to convert a plain search string to a regexp used by
+regexp search functions.
+The symbol property `isearch-message-prefix' put on this function
+specifies the prefix string displayed in the search message.")
+;; We still support setting this to t for backwards compatibility.
+(define-obsolete-variable-alias 'isearch-word
+ 'isearch-regexp-function "25.1")
(defvar isearch-lax-whitespace t
"If non-nil, a space will match a sequence of whitespace chars.
@@ -572,10 +576,10 @@ matches literally, against one space. You can toggle the value of this
variable by the command `isearch-toggle-lax-whitespace'.")
(defvar isearch-cmds nil
- "Stack of search status sets.
-Each set is a vector of the form:
+ "Stack of search status elements.
+Each element is an `isearch--state' struct where the slots are
[STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD
- INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]")
+ ERROR WRAPPED BARRIER CASE-FOLD-SEARCH]")
(defvar isearch-string "") ; The current search string.
(defvar isearch-message "") ; text-char-description version of isearch-string
@@ -645,6 +649,8 @@ Each set is a vector of the form:
;; isearch is invoked.
(defvar isearch-input-method-local-p nil)
+(defvar isearch--saved-overriding-local-map nil)
+
;; Minor-mode-alist changes - kind of redundant with the
;; echo area, but if isearching in multiple windows, it can be useful.
@@ -652,8 +658,7 @@ Each set is a vector of the form:
(nconc minor-mode-alist
(list '(isearch-mode isearch-mode))))
-(defvar isearch-mode nil) ;; Name of the minor mode, if non-nil.
-(make-variable-buffer-local 'isearch-mode)
+(defvar-local isearch-mode nil) ;; Name of the minor mode, if non-nil.
(define-key global-map "\C-s" 'isearch-forward)
(define-key esc-map "\C-s" 'isearch-forward-regexp)
@@ -705,6 +710,7 @@ Type \\[isearch-toggle-invisible] to toggle search in invisible text.
Type \\[isearch-toggle-regexp] to toggle regular-expression mode.
Type \\[isearch-toggle-word] to toggle word mode.
Type \\[isearch-toggle-symbol] to toggle symbol mode.
+Type \\[isearch-toggle-character-fold] to toggle character folding.
Type \\[isearch-toggle-lax-whitespace] to toggle whitespace matching.
In incremental searches, a space or spaces normally matches any whitespace
@@ -821,6 +827,7 @@ See the command `isearch-forward-symbol' for more information."
(isearch-update)))))
+(defvar cursor-sensor-inhibit)
;; isearch-mode only sets up incremental search for the minor mode.
;; All the work is done by the isearch-mode commands.
@@ -829,8 +836,7 @@ See the command `isearch-forward-symbol' for more information."
;; isearch-forward-regexp isearch-backward-regexp)
;; "List of commands for which isearch-mode does not recursive-edit.")
-
-(defun isearch-mode (forward &optional regexp op-fun recursive-edit word)
+(defun isearch-mode (forward &optional regexp op-fun recursive-edit regexp-function)
"Start Isearch minor mode.
It is called by the function `isearch-forward' and other related functions.
@@ -846,14 +852,18 @@ does not return to the calling function until the search is completed.
To behave this way it enters a recursive-edit and exits it when done
isearching.
-The arg WORD, if t, does incremental search for a sequence of words,
-ignoring punctuation. If the value is a function, it is called to
-convert the search string to a regexp used by regexp search functions."
+The arg REGEXP-FUNCTION, if non-nil, should be a function. It is
+used to set the value of `isearch-regexp-function'."
;; Initialize global vars.
(setq isearch-forward forward
- isearch-regexp regexp
- isearch-word word
+ isearch-regexp (or regexp
+ (and (not regexp-function)
+ (eq search-default-regexp-mode t)))
+ isearch-regexp-function (or regexp-function
+ (and (functionp search-default-regexp-mode)
+ (not regexp)
+ search-default-regexp-mode))
isearch-op-fun op-fun
isearch-last-case-fold-search isearch-case-fold-search
isearch-case-fold-search case-fold-search
@@ -912,6 +922,9 @@ convert the search string to a regexp used by regexp search functions."
(setq overriding-terminal-local-map isearch-mode-map)
(run-hooks 'isearch-mode-hook)
+ ;; Remember the initial map possibly modified
+ ;; by external packages in isearch-mode-hook. (Bug#16035)
+ (setq isearch--saved-overriding-local-map overriding-terminal-local-map)
;; Pushing the initial state used to be before running isearch-mode-hook,
;; but a hook might set `isearch-push-state-function' used in
@@ -920,6 +933,8 @@ convert the search string to a regexp used by regexp search functions."
(isearch-update)
+ (add-hook 'pre-command-hook 'isearch-pre-command-hook)
+ (add-hook 'post-command-hook 'isearch-post-command-hook)
(add-hook 'mouse-leave-buffer-hook 'isearch-done)
(add-hook 'kbd-macro-termination-hook 'isearch-done)
@@ -933,10 +948,23 @@ convert the search string to a regexp used by regexp search functions."
;; Some high level utilities. Others below.
+(defvar isearch--current-buffer nil)
(defun isearch-update ()
"This is called after every isearch command to update the display.
The last thing it does is to run `isearch-update-post-hook'."
+ (unless (eq (current-buffer) isearch--current-buffer)
+ (when (buffer-live-p isearch--current-buffer)
+ (with-current-buffer isearch--current-buffer
+ (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit))))
+ (setq isearch--current-buffer (current-buffer))
+ (make-local-variable 'cursor-sensor-inhibit)
+ (unless (boundp 'cursor-sensor-inhibit)
+ (setq cursor-sensor-inhibit nil))
+ ;; Suspend things like cursor-intangible during Isearch so we can search
+ ;; even within intangible text.
+ (push 'isearch cursor-sensor-inhibit))
+
(if (and (null unread-command-events)
(null executing-kbd-macro))
(progn
@@ -964,10 +992,17 @@ The last thing it does is to run `isearch-update-post-hook'."
(other-window 1))
(goto-char found-point))
;; Keep same hscrolling as at the start of the search when possible
- (let ((current-scroll (window-hscroll)))
+ (let ((current-scroll (window-hscroll))
+ visible-p)
(set-window-hscroll (selected-window) isearch-start-hscroll)
- (unless (pos-visible-in-window-p)
- (set-window-hscroll (selected-window) current-scroll))))
+ (setq visible-p (pos-visible-in-window-p nil nil t))
+ (if (or (not visible-p)
+ ;; When point is not visible because of hscroll,
+ ;; pos-visible-in-window-p returns non-nil, but
+ ;; the X coordinate it returns is 1 pixel beyond
+ ;; the last visible one.
+ (>= (car visible-p) (window-body-width nil t)))
+ (set-window-hscroll (selected-window) current-scroll))))
(if isearch-other-end
(if (< isearch-other-end (point)) ; isearch-forward?
(isearch-highlight isearch-other-end (point))
@@ -992,15 +1027,20 @@ NOPUSH is t and EDIT is t."
(if isearch-resume-in-command-history
(let ((command `(isearch-resume ,isearch-string ,isearch-regexp
- ,isearch-word ,isearch-forward
+ ,isearch-regexp-function ,isearch-forward
,isearch-message
',isearch-case-fold-search)))
(unless (equal (car command-history) command)
(setq command-history (cons command command-history)))))
+ (remove-hook 'pre-command-hook 'isearch-pre-command-hook)
+ (remove-hook 'post-command-hook 'isearch-post-command-hook)
(remove-hook 'mouse-leave-buffer-hook 'isearch-done)
(remove-hook 'kbd-macro-termination-hook 'isearch-done)
(setq isearch-lazy-highlight-start nil)
+ (with-current-buffer isearch--current-buffer
+ (setq isearch--current-buffer nil)
+ (setq cursor-sensor-inhibit (delq 'isearch cursor-sensor-inhibit)))
;; Called by all commands that terminate isearch-mode.
;; If NOPUSH is non-nil, we don't push the string on the search ring.
@@ -1089,7 +1129,7 @@ REGEXP if non-nil says use the regexp search ring."
(success isearch-success)
(forward isearch-forward)
(other-end isearch-other-end)
- (word isearch-word)
+ (word isearch-regexp-function)
(error isearch-error)
(wrapped isearch-wrapped)
(barrier isearch-barrier)
@@ -1115,7 +1155,7 @@ REGEXP if non-nil says use the regexp search ring."
isearch-success (isearch--state-success cmd)
isearch-forward (isearch--state-forward cmd)
isearch-other-end (isearch--state-other-end cmd)
- isearch-word (isearch--state-word cmd)
+ isearch-regexp-function (isearch--state-word cmd)
isearch-error (isearch--state-error cmd)
isearch-wrapped (isearch--state-wrapped cmd)
isearch-barrier (isearch--state-barrier cmd)
@@ -1143,12 +1183,10 @@ nonincremental search instead via `isearch-edit-string'."
(if (and search-nonincremental-instead
(= 0 (length isearch-string)))
(let ((isearch-nonincremental t))
- (isearch-edit-string)))
- (isearch-done)
+ (isearch-edit-string)) ;; this calls isearch-done as well
+ (isearch-done))
(isearch-clean-overlays))
-(defvar minibuffer-history-symbol) ;; from external package gmhist.el
-
(defun isearch-fail-pos (&optional msg)
"Return position of first mismatch in search string, or nil if none.
If MSG is non-nil, use variable `isearch-message', otherwise `isearch-string'."
@@ -1173,7 +1211,7 @@ If MSG is non-nil, use variable `isearch-message', otherwise `isearch-string'."
"Exit Isearch mode, run BODY, and reinvoke the pending search.
You can update the global isearch variables by setting new values to
`isearch-new-string', `isearch-new-message', `isearch-new-forward',
-`isearch-new-word', `isearch-new-case-fold'."
+`isearch-new-regexp-function', `isearch-new-case-fold'."
;; This code is very hairy for several reasons, explained in the code.
;; Mainly, isearch-mode must be terminated while editing and then restarted.
;; If there were a way to catch any change of buffer from the minibuffer,
@@ -1190,7 +1228,7 @@ You can update the global isearch variables by setting new values to
(isearch-new-string isearch-string)
(isearch-new-message isearch-message)
(isearch-new-forward isearch-forward)
- (isearch-new-word isearch-word)
+ (isearch-new-regexp-function isearch-regexp-function)
(isearch-new-case-fold isearch-case-fold-search)
(isearch-regexp isearch-regexp)
@@ -1256,13 +1294,13 @@ You can update the global isearch variables by setting new values to
isearch-regexp
isearch-op-fun
nil
- isearch-word)
+ isearch-regexp-function)
;; Copy new local values to isearch globals
(setq isearch-string isearch-new-string
isearch-message isearch-new-message
isearch-forward isearch-new-forward
- isearch-word isearch-new-word
+ isearch-regexp-function isearch-new-regexp-function
isearch-case-fold-search isearch-new-case-fold))
;; Empty isearch-string means use default.
@@ -1301,6 +1339,8 @@ You can update the global isearch variables by setting new values to
(isearch-abort) ;; outside of let to restore outside global values
)))
+(defvar minibuffer-history-symbol) ;; from external package gmhist.el
+
(defun isearch-edit-string ()
"Edit the search string in the minibuffer.
The following additional command keys are active while editing.
@@ -1446,86 +1486,88 @@ Use `isearch-exit' to quit without signaling."
(interactive)
(isearch-repeat 'backward))
-(defun isearch-toggle-regexp ()
- "Toggle regexp searching on or off."
- ;; The status stack is left unchanged.
- (interactive)
+
+;;; Toggles for `isearch-regexp-function' and `search-default-regexp-mode'.
+(defmacro isearch-define-mode-toggle (mode key function &optional docstring &rest body)
+ "Define a command called `isearch-toggle-MODE' and bind it to `M-s KEY'.
+The first line of the docstring is auto-generated, the remainder
+may be provided in DOCSTRING.
+If FUNCTION is a symbol, this command first toggles the value of
+`isearch-regexp-function' between nil and FUNCTION. Also set the
+`isearch-message-prefix' property of FUNCTION.
+The command then executes BODY and updates the isearch prompt."
+ (declare (indent defun))
+ (let ((command-name (intern (format "isearch-toggle-%s" mode))))
+ `(progn
+ (defun ,command-name ()
+ ,(format "Toggle %s searching on or off.%s" mode
+ (if docstring (concat "\n" docstring) ""))
+ (interactive)
+ ,@(when function
+ `((setq isearch-regexp-function
+ (unless (eq isearch-regexp-function #',function)
+ #',function))
+ (when isearch-regexp-function (setq isearch-regexp nil))))
+ ,@body
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update))
+ (define-key isearch-mode-map ,(concat "\M-s" key) #',command-name)
+ ,@(when (symbolp function)
+ `((put ',function 'isearch-message-prefix ,(format "%s " mode))
+ (cl-callf (lambda (types) (cons 'choice
+ (cons '(const :tag ,(capitalize (format "%s search" mode)) ,function)
+ (cdr types))))
+ (get 'search-default-regexp-mode 'custom-type)))))))
+
+(isearch-define-mode-toggle word "w" word-search-regexp)
+(isearch-define-mode-toggle symbol "_" isearch-symbol-regexp)
+(isearch-define-mode-toggle character-fold "'" character-fold-to-regexp)
+(put 'character-fold-to-regexp 'isearch-message-prefix "char-fold ")
+
+(isearch-define-mode-toggle regexp "r" nil nil
(setq isearch-regexp (not isearch-regexp))
- (if isearch-regexp (setq isearch-word nil))
- (setq isearch-success t isearch-adjusted t)
- (isearch-update))
+ (if isearch-regexp (setq isearch-regexp-function nil)))
-(defun isearch-toggle-word ()
- "Toggle word searching on or off."
- ;; The status stack is left unchanged.
- (interactive)
- (setq isearch-word (not isearch-word))
- (if isearch-word (setq isearch-regexp nil))
- (setq isearch-success t isearch-adjusted t)
- (isearch-update))
-
-(defun isearch-toggle-symbol ()
- "Toggle symbol searching on or off."
- (interactive)
- (setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp)
- 'isearch-symbol-regexp))
- (if isearch-word (setq isearch-regexp nil))
- (setq isearch-success t isearch-adjusted t)
- (isearch-update))
-
-(defun isearch-toggle-lax-whitespace ()
- "Toggle whitespace matching in searching on or off.
-In ordinary search, toggles the value of the variable
-`isearch-lax-whitespace'. In regexp search, toggles the
-value of the variable `isearch-regexp-lax-whitespace'."
- (interactive)
- (if isearch-regexp
- (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace))
- (setq isearch-lax-whitespace (not isearch-lax-whitespace)))
+(defun isearch--momentary-message (string)
+ "Print STRING at the end of the isearch prompt for 1 second"
(let ((message-log-max nil))
(message "%s%s [%s]"
- (isearch-message-prefix nil isearch-nonincremental)
- isearch-message
- (if (if isearch-regexp
- isearch-regexp-lax-whitespace
- isearch-lax-whitespace)
- "match spaces loosely"
- "match spaces literally")))
- (setq isearch-success t isearch-adjusted t)
- (sit-for 1)
- (isearch-update))
+ (isearch-message-prefix nil isearch-nonincremental)
+ isearch-message
+ string))
+ (sit-for 1))
-(defun isearch-toggle-case-fold ()
- "Toggle case folding in searching on or off.
-Toggles the value of the variable `isearch-case-fold-search'."
- (interactive)
- (setq isearch-case-fold-search
- (if isearch-case-fold-search nil 'yes))
- (let ((message-log-max nil))
- (message "%s%s [case %ssensitive]"
- (isearch-message-prefix nil isearch-nonincremental)
- isearch-message
- (if isearch-case-fold-search "in" "")))
- (setq isearch-success t isearch-adjusted t)
- (sit-for 1)
- (isearch-update))
-
-(defun isearch-toggle-invisible ()
- "Toggle searching in invisible text on or off.
+(isearch-define-mode-toggle lax-whitespace " " nil
+ "In ordinary search, toggles the value of the variable
+`isearch-lax-whitespace'. In regexp search, toggles the
+value of the variable `isearch-regexp-lax-whitespace'."
+ (isearch--momentary-message
+ (if (if isearch-regexp
+ (setq isearch-regexp-lax-whitespace (not isearch-regexp-lax-whitespace))
+ (setq isearch-lax-whitespace (not isearch-lax-whitespace)))
+ "match spaces loosely"
+ "match spaces literally")))
+
+(isearch-define-mode-toggle case-fold "c" nil
+ "Toggles the value of the variable `isearch-case-fold-search'."
+ (isearch--momentary-message
+ (if (setq isearch-case-fold-search
+ (if isearch-case-fold-search nil 'yes))
+ "case insensitive"
+ "case sensitive")))
+
+(isearch-define-mode-toggle invisible "i" nil
+ "This determines whether to search inside invisible text or not.
Toggles the variable `isearch-invisible' between values
nil and a non-nil value of the option `search-invisible'
\(or `open' if `search-invisible' is nil)."
- (interactive)
- (setq isearch-invisible
- (if isearch-invisible nil (or search-invisible 'open)))
- (let ((message-log-max nil))
- (message "%s%s [match %svisible text]"
- (isearch-message-prefix nil isearch-nonincremental)
- isearch-message
- (if isearch-invisible "in" "")))
- (setq isearch-success t isearch-adjusted t)
- (sit-for 1)
- (isearch-update))
+ "match %svisible text"
+ (isearch--momentary-message
+ (if (setq isearch-invisible
+ (if isearch-invisible
+ nil (or search-invisible 'open)))
+ "match invisible text"
+ "match visible text")))
;; Word search
@@ -1667,11 +1709,19 @@ the beginning or the end of the string need not match a symbol boundary."
(let ((search-spaces-regexp search-whitespace-regexp))
(re-search-backward regexp bound noerror count)))
+(dolist (old '(re-search-forward-lax-whitespace search-backward-lax-whitespace
+ search-forward-lax-whitespace re-search-backward-lax-whitespace))
+ (make-obsolete old
+ "instead, use (let ((search-spaces-regexp search-whitespace-regexp))
+ (re-search-... ...))"
+ "25.1"))
+
-(defun isearch-query-replace (&optional delimited regexp-flag)
+(defun isearch-query-replace (&optional arg regexp-flag)
"Start `query-replace' with string to replace from last search string.
-The arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries. Note that using the prefix arg
+The ARG (prefix arg if interactive), if non-nil, means replace
+only matches surrounded by word boundaries. A negative prefix
+arg means replace backward. Note that using the prefix arg
is possible only when `isearch-allow-scroll' is non-nil or
`isearch-allow-prefix' is non-nil, and it doesn't always provide the
correct matches for `query-replace', so the preferred way to run word
@@ -1689,6 +1739,8 @@ replacements from Isearch is `M-s w ... M-%'."
isearch-lax-whitespace)
(replace-regexp-lax-whitespace
isearch-regexp-lax-whitespace)
+ (delimited (and arg (not (eq arg '-))))
+ (backward (and arg (eq arg '-)))
;; Set `isearch-recursive-edit' to nil to prevent calling
;; `exit-recursive-edit' in `isearch-done' that terminates
;; the execution of this command when it is non-nil.
@@ -1697,9 +1749,13 @@ replacements from Isearch is `M-s w ... M-%'."
(isearch-done nil t)
(isearch-clean-overlays)
(if (and isearch-other-end
- (< isearch-other-end (point))
+ (if backward
+ (> isearch-other-end (point))
+ (< isearch-other-end (point)))
(not (and transient-mark-mode mark-active
- (< (mark) (point)))))
+ (if backward
+ (> (mark) (point))
+ (< (mark) (point))))))
(goto-char isearch-other-end))
(set query-replace-from-history-variable
(cons isearch-string
@@ -1709,29 +1765,22 @@ replacements from Isearch is `M-s w ... M-%'."
(query-replace-read-to
isearch-string
(concat "Query replace"
- (if (or delimited isearch-word)
- (let* ((symbol (or delimited isearch-word))
- (string (and symbol (symbolp symbol)
- (get symbol 'isearch-message-prefix))))
- (if (stringp string)
- ;; Move space from the end to the beginning.
- (replace-regexp-in-string "\\(.*\\) \\'" " \\1" string)
- " word"))
- "")
- (if isearch-regexp " regexp" "")
+ (isearch--describe-regexp-mode (or delimited isearch-regexp-function) t)
+ (if backward " backward" "")
(if (and transient-mark-mode mark-active) " in region" ""))
isearch-regexp)
- t isearch-regexp (or delimited isearch-word) nil nil
+ t isearch-regexp (or delimited isearch-regexp-function) nil nil
(if (and transient-mark-mode mark-active) (region-beginning))
- (if (and transient-mark-mode mark-active) (region-end))))
+ (if (and transient-mark-mode mark-active) (region-end))
+ backward))
(and isearch-recursive-edit (exit-recursive-edit)))
-(defun isearch-query-replace-regexp (&optional delimited)
+(defun isearch-query-replace-regexp (&optional arg)
"Start `query-replace-regexp' with string to replace from last search string.
See `isearch-query-replace' for more information."
(interactive
(list current-prefix-arg))
- (isearch-query-replace delimited t))
+ (isearch-query-replace arg t))
(defun isearch-occur (regexp &optional nlines)
"Run `occur' using the last search string as the regexp.
@@ -1747,9 +1796,9 @@ characters in that string."
(interactive
(let* ((perform-collect (consp current-prefix-arg))
(regexp (cond
- ((functionp isearch-word)
- (funcall isearch-word isearch-string))
- (isearch-word (word-search-regexp isearch-string))
+ ((functionp isearch-regexp-function)
+ (funcall isearch-regexp-function isearch-string))
+ (isearch-regexp-function (word-search-regexp isearch-string))
(isearch-regexp isearch-string)
(t (regexp-quote isearch-string)))))
(list regexp
@@ -1798,9 +1847,9 @@ and reads its face argument using `hi-lock-read-face-name'."
(isearch-done nil t)
(isearch-clean-overlays))
(require 'hi-lock nil t)
- (let ((regexp (cond ((functionp isearch-word)
- (funcall isearch-word isearch-string))
- (isearch-word (word-search-regexp isearch-string))
+ (let ((regexp (cond ((functionp isearch-regexp-function)
+ (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)
@@ -1889,8 +1938,8 @@ If search string is empty, just beep."
(defun isearch-yank-x-selection ()
"Pull current X selection into search string."
(interactive)
- (isearch-yank-string (x-get-selection))
- ;; If `x-get-selection' returned the text from the active region,
+ (isearch-yank-string (gui-get-selection))
+ ;; If `gui-get-selection' returned the text from the active region,
;; then it "used" the mark which we should hence deactivate.
(when select-active-regions (deactivate-mark)))
@@ -1933,7 +1982,8 @@ or it might return the position of the end of the line."
(forward-char arg)))
(defun isearch-yank-char (&optional arg)
- "Pull next character from buffer into search string."
+ "Pull next character from buffer into search string.
+If optional ARG is non-nil, pull in the next ARG characters."
(interactive "p")
(isearch-yank-internal (lambda () (forward-char arg) (point))))
@@ -1946,18 +1996,22 @@ Subword is used when `subword-mode' is activated. "
(lambda ()
(if (or (= (char-syntax (or (char-after) 0)) ?w)
(= (char-syntax (or (char-after (1+ (point))) 0)) ?w))
- (if (and (boundp 'subword-mode) subword-mode)
+ (if (or (and (boundp 'subword-mode) subword-mode)
+ (and (boundp 'superword-mode) superword-mode))
(subword-forward 1)
(forward-word 1))
- (forward-char 1)) (point))))
+ (forward-char 1))
+ (point))))
(defun isearch-yank-word (&optional arg)
- "Pull next word from buffer into search string."
+ "Pull next word from buffer into search string.
+If optional ARG is non-nil, pull in the next ARG words."
(interactive "p")
(isearch-yank-internal (lambda () (forward-word arg) (point))))
(defun isearch-yank-line (&optional arg)
- "Pull rest of line from buffer into search string."
+ "Pull rest of line from buffer into search string.
+If optional ARG is non-nil, yank the next ARG lines."
(interactive "p")
(isearch-yank-internal
(lambda () (let ((inhibit-field-text-motion t))
@@ -2000,9 +2054,9 @@ With argument, add COUNT copies of the character."
(setq case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(looking-at (cond
- ((functionp isearch-word)
- (funcall isearch-word isearch-string t))
- (isearch-word (word-search-regexp isearch-string t))
+ ((functionp isearch-regexp-function)
+ (funcall isearch-regexp-function isearch-string t))
+ (isearch-regexp-function (word-search-regexp isearch-string t))
(isearch-regexp isearch-string)
(t (regexp-quote isearch-string)))))
(error nil))
@@ -2100,26 +2154,6 @@ to the barrier."
(min last-other-end isearch-barrier)))
(setq isearch-adjusted t)))))))
-(defun isearch-unread-key-sequence (keylist)
- "Unread the given key-sequence KEYLIST.
-Scroll-bar or mode-line events are processed appropriately."
- (cancel-kbd-macro-events)
- (apply 'isearch-unread keylist)
- ;; If the event was a scroll-bar or mode-line click, the event will have
- ;; been prefixed by a symbol such as vertical-scroll-bar. We must remove
- ;; it here, because this symbol will be attached to the event again next
- ;; time it gets read by read-key-sequence.
- ;;
- ;; (Old comment from isearch-other-meta-char: "Note that we don't have to
- ;; modify the event anymore in 21 because read_key_sequence no longer
- ;; modifies events to produce fake prefix keys.")
- (if (and (> (length keylist) 1)
- (symbolp (car keylist))
- (listp (cadr keylist))
- (not (numberp (posn-point
- (event-start (cadr keylist) )))))
- (pop unread-command-events)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; scrolling within Isearch mode. Alan Mackenzie (acm@muc.de), 2003/2/24
;;
@@ -2244,185 +2278,68 @@ the bottom."
(recenter 0))))
(goto-char isearch-point))
-(defun isearch-reread-key-sequence-naturally (keylist)
- "Reread key sequence KEYLIST with an inactive Isearch-mode keymap.
-Return the key sequence as a string/vector."
- (isearch-unread-key-sequence keylist)
- (let (overriding-terminal-local-map)
- (read-key-sequence nil))) ; This will go through function-key-map, if nec.
-
-(defun isearch-lookup-scroll-key (key-seq)
- "If KEY-SEQ is bound to a scrolling command, return it as a symbol.
-Otherwise return nil."
- (let* ((overriding-terminal-local-map nil)
- (binding (key-binding key-seq)))
- (and binding (symbolp binding) (commandp binding)
- (or (eq (get binding 'isearch-scroll) t)
- (eq (get binding 'scroll-command) t))
- binding)))
-
-(defalias 'isearch-other-control-char 'isearch-other-meta-char)
-
-(defun isearch-other-meta-char (&optional arg)
- "Process a miscellaneous key sequence in Isearch mode.
-
-Try to convert the current key-sequence to something usable in Isearch
-mode, either by converting it with `function-key-map', downcasing a
-key with C-<upper case>, or finding a \"scrolling command\" bound to
-it. \(In the last case, we may have to read more events.) If so,
-either unread the converted sequence or execute the command.
-
-Otherwise, if `search-exit-option' is non-nil (the default) unread the
-key-sequence and exit the search normally. If it is the symbol
-`edit', the search string is edited in the minibuffer and the meta
-character is unread so that it applies to editing the string.
-
-ARG is the prefix argument. It will be transmitted through to the
-scrolling command or to the command whose key-sequence exits
-Isearch mode."
- (interactive "P")
- (let* ((key (if current-prefix-arg ; not nec the same as ARG
- (substring (this-command-keys) universal-argument-num-events)
- (this-command-keys)))
- (main-event (aref key 0))
- (keylist (listify-key-sequence key))
- scroll-command isearch-point)
- (cond ((and (= (length key) 1)
- (let ((lookup (lookup-key local-function-key-map key)))
- (not (or (null lookup) (integerp lookup)
- (keymapp lookup)))))
- ;; Handle a function key that translates into something else.
- ;; If the key has a global definition too,
- ;; exit and unread the key itself, so its global definition runs.
- ;; Otherwise, unread the translation,
- ;; so that the translated key takes effect within isearch.
- (cancel-kbd-macro-events)
- (if (lookup-key global-map key)
- (progn
- (isearch-done)
- (setq prefix-arg arg)
- (apply 'isearch-unread keylist))
- (setq keylist
- (listify-key-sequence
- (lookup-key local-function-key-map key)))
- (while keylist
- (setq key (car keylist))
- ;; If KEY is a printing char, we handle it here
- ;; directly to avoid the input method and keyboard
- ;; coding system translating it.
- (if (and (integerp key)
- (>= key ?\s) (/= key 127) (< key 256))
- (progn
- ;; Ensure that the processed char is recorded in
- ;; the keyboard macro, if any (Bug#4894)
- (store-kbd-macro-event key)
- (isearch-process-search-char key)
- (setq keylist (cdr keylist)))
- ;; As the remaining keys in KEYLIST can't be handled
- ;; here, we must reread them.
- (setq prefix-arg arg)
- (apply 'isearch-unread keylist)
- (setq keylist nil)))))
- (
- ;; Handle an undefined shifted control character
- ;; by downshifting it if that makes it defined.
- ;; (As read-key-sequence would normally do,
- ;; if we didn't have a default definition.)
- (let ((mods (event-modifiers main-event)))
- (and (integerp main-event)
- (memq 'shift mods)
- (memq 'control mods)
- (not (memq (lookup-key isearch-mode-map
- (let ((copy (copy-sequence key)))
- (aset copy 0
- (- main-event
- (- ?\C-\S-a ?\C-a)))
- copy)
- nil)
- '(nil
- isearch-other-control-char)))))
- (setcar keylist (- main-event (- ?\C-\S-a ?\C-a)))
- (cancel-kbd-macro-events)
- (setq prefix-arg arg)
- (apply 'isearch-unread keylist))
- ((eq search-exit-option 'edit)
- (setq prefix-arg arg)
- (apply 'isearch-unread keylist)
- (isearch-edit-string))
- ;; Handle a scrolling function or prefix argument.
- ((progn
- (setq key (isearch-reread-key-sequence-naturally keylist)
- keylist (listify-key-sequence key)
- main-event (aref key 0))
- (or (and isearch-allow-scroll
- (setq scroll-command (isearch-lookup-scroll-key key)))
- (and isearch-allow-prefix
- (let (overriding-terminal-local-map)
- (setq scroll-command (key-binding key))
- (memq scroll-command
- '(universal-argument
- negative-argument digit-argument))))))
- ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a
- ;; complete key sequence, possibly as modified by function-key-map,
- ;; not merely the one or two event fragment which invoked
- ;; isearch-other-meta-char in the first place.
- (setq isearch-point (point))
- (setq prefix-arg arg)
- (command-execute scroll-command)
- (let ((ab-bel (isearch-string-out-of-window isearch-point)))
- (if ab-bel
- (isearch-back-into-window (eq ab-bel 'above) isearch-point)
- (goto-char isearch-point)))
- (isearch-update))
- ;; A mouse click on the isearch message starts editing the search string
- ((and (eq (car-safe main-event) 'down-mouse-1)
- (window-minibuffer-p (posn-window (event-start main-event))))
- ;; Swallow the up-event.
- (read-event)
- (isearch-edit-string))
- (search-exit-option
- (let (window)
- (setq prefix-arg arg)
- (isearch-unread-key-sequence keylist)
- (setq main-event (car unread-command-events))
-
- ;; If we got a mouse click event, that event contains the
- ;; window clicked on. maybe it was read with the buffer
- ;; it was clicked on. If so, that buffer, not the current one,
- ;; is in isearch mode. So end the search in that buffer.
-
- ;; ??? I have no idea what this if checks for, but it's
- ;; obviously wrong for the case that a down-mouse event
- ;; on another window invokes this function. The event
- ;; will contain the window clicked on and that window's
- ;; buffer is certainly not always in Isearch mode.
- ;;
- ;; Leave the code in, but check for current buffer not
- ;; being in Isearch mode for now, until someone tells
- ;; what it's really supposed to do.
- ;;
- ;; --gerd 2001-08-10.
-
- (if (and (not isearch-mode)
- (listp main-event)
- (setq window (posn-window (event-start main-event)))
- (windowp window)
- (or (> (minibuffer-depth) 0)
- (not (window-minibuffer-p window))))
- (with-current-buffer (window-buffer window)
- (isearch-done)
- (isearch-clean-overlays))
- (isearch-done)
- (isearch-clean-overlays)
- (setq prefix-arg arg))))
- (t;; otherwise nil
- (isearch-process-search-string key key)))))
+(defvar isearch-pre-scroll-point nil)
+
+(defun isearch-pre-command-hook ()
+ "Decide whether to exit Isearch mode before executing the command.
+Don't exit Isearch if the key sequence that invoked this command
+is bound in `isearch-mode-map', or if the invoked command is
+a prefix argument command (when `isearch-allow-prefix' is non-nil),
+or it is a scrolling command (when `isearch-allow-scroll' is non-nil).
+Otherwise, exit Isearch (when `search-exit-option' is non-nil)
+before the command is executed globally with terminated Isearch."
+ (let* ((key (this-single-command-keys))
+ (main-event (aref key 0)))
+ (cond
+ ;; Don't exit Isearch if we're in the middle of some
+ ;; `set-transient-map' thingy like `universal-argument--mode'.
+ ((not (eq overriding-terminal-local-map isearch--saved-overriding-local-map)))
+ ;; Don't exit Isearch for isearch key bindings.
+ ((commandp (lookup-key isearch-mode-map key nil)))
+ ;; Optionally edit the search string instead of exiting.
+ ((eq search-exit-option 'edit)
+ (setq this-command 'isearch-edit-string))
+ ;; Handle a scrolling function or prefix argument.
+ ((or (and isearch-allow-prefix
+ (memq this-command '(universal-argument
+ digit-argument negative-argument)))
+ (and isearch-allow-scroll
+ (symbolp this-command)
+ (or (eq (get this-command 'isearch-scroll) t)
+ (eq (get this-command 'scroll-command) t))))
+ (when isearch-allow-scroll
+ (setq isearch-pre-scroll-point (point))))
+ ;; A mouse click on the isearch message starts editing the search string.
+ ((and (eq (car-safe main-event) 'down-mouse-1)
+ (window-minibuffer-p (posn-window (event-start main-event))))
+ ;; Swallow the up-event.
+ (read-event)
+ (setq this-command 'isearch-edit-string))
+ ;; Other characters terminate the search and are then executed normally.
+ (search-exit-option
+ (isearch-done)
+ (isearch-clean-overlays))
+ ;; If search-exit-option is nil, run the command without exiting Isearch.
+ (t
+ (isearch-process-search-string key key)))))
+
+(defun isearch-post-command-hook ()
+ (when isearch-pre-scroll-point
+ (let ((ab-bel (isearch-string-out-of-window isearch-pre-scroll-point)))
+ (if ab-bel
+ (isearch-back-into-window (eq ab-bel 'above) isearch-pre-scroll-point)
+ (goto-char isearch-pre-scroll-point)))
+ (setq isearch-pre-scroll-point nil)
+ (isearch-update)))
(defun isearch-quote-char (&optional count)
"Quote special characters for incremental search.
With argument, add COUNT copies of the character."
(interactive "p")
(let ((char (read-quoted-char (isearch-message t))))
+ (unless (characterp char)
+ (user-error "%s is not a valid character"
+ (key-description (vector char))))
;; Assume character codes 0200 - 0377 stand for characters in some
;; single-byte character set, and convert them to Emacs
;; characters.
@@ -2430,10 +2347,14 @@ With argument, add COUNT copies of the character."
(if (subregexp-context-p isearch-string (length isearch-string))
(isearch-process-search-string "[ ]" " ")
(isearch-process-search-char char count))
- (and enable-multibyte-characters
- (>= char ?\200)
- (<= char ?\377)
- (setq char (unibyte-char-to-multibyte char)))
+ ;; This used to assume character codes 0240 - 0377 stand for
+ ;; characters in some single-byte character set, and converted them
+ ;; to Emacs characters. But in 23.1 this feature is deprecated
+ ;; in favor of inserting the corresponding Unicode characters.
+ ;; (and enable-multibyte-characters
+ ;; (>= char ?\200)
+ ;; (<= char ?\377)
+ ;; (setq char (unibyte-char-to-multibyte char)))
(isearch-process-search-char char count))))
(defun isearch-printing-char (&optional char count)
@@ -2449,6 +2370,8 @@ With argument, add COUNT copies of the character."
(isearch-process-search-char char count))))
(defun isearch-process-search-char (char &optional count)
+ "Add CHAR to the search string, COUNT times.
+Search is updated accordingly."
;; * and ? are special in regexps when not preceded by \.
;; } and | are special in regexps when preceded by \.
;; Nothing special for + because it matches at least once.
@@ -2588,6 +2511,30 @@ If there is no completion possible, say so and continue searching."
(isearch-message-suffix c-q-hack)))
(if c-q-hack m (let ((message-log-max nil)) (message "%s" m)))))
+(defun isearch--describe-regexp-mode (regexp-function &optional space-before)
+ "Make a string for describing REGEXP-FUNCTION.
+If SPACE-BEFORE is non-nil, put a space before, instead of after,
+the word mode."
+ (when (eq regexp-function t)
+ (setq regexp-function #'word-search-regexp))
+ (let ((description
+ ;; Don't use a description on the default search mode.
+ (cond ((equal regexp-function search-default-regexp-mode) "")
+ (regexp-function
+ (and (symbolp regexp-function)
+ (or (get regexp-function 'isearch-message-prefix)
+ "")))
+ (isearch-regexp "regexp ")
+ ;; We're in literal mode. If the default mode is not
+ ;; literal, then describe it.
+ ((functionp search-default-regexp-mode) "literal "))))
+ (if space-before
+ ;; Move space from the end to the beginning.
+ (replace-regexp-in-string "\\(.*\\) \\'" " \\1" description)
+ description)))
+(define-obsolete-function-alias 'isearch--describe-word-mode
+ 'isearch--describe-regexp-mode "25.1")
+
(defun isearch-message-prefix (&optional ellipsis nonincremental)
;; If about to search, and previous search regexp was invalid,
;; check that it still is. If it is valid now,
@@ -2614,14 +2561,12 @@ If there is no completion possible, say so and continue searching."
(let ((np (cdr (assq 'isearch-message-prefix props))))
(if np (setq prefix (concat np prefix)))))
isearch-filter-predicate)
- prefix)
- (if isearch-word
- (or (and (symbolp isearch-word)
- (get isearch-word 'isearch-message-prefix))
- "word ")
- "")
- (if isearch-regexp "regexp " "")
- (if multi-isearch-next-buffer-current-function "multi " "")
+ prefix)
+ (isearch--describe-regexp-mode isearch-regexp-function)
+ (cond
+ (multi-isearch-file-list "multi-file ")
+ (multi-isearch-buffer-list "multi-buffer ")
+ (t ""))
(or isearch-message-prefix-add "")
(if nonincremental "search" "I-search")
(if isearch-forward "" " backward")
@@ -2660,38 +2605,34 @@ search for the first occurrence of STRING or its translation.")
Can be changed via `isearch-search-fun-function' for special needs."
(funcall (or isearch-search-fun-function 'isearch-search-fun-default)))
+(defun isearch--lax-regexp-function-p ()
+ "Non-nil if next regexp-function call should be lax."
+ (not (or isearch-nonincremental
+ (null (car isearch-cmds))
+ (eq (length isearch-string)
+ (length (isearch--state-string
+ (car isearch-cmds)))))))
+
(defun isearch-search-fun-default ()
"Return default functions to use for the search."
- (cond
- (isearch-word
- (lambda (string &optional bound noerror count)
- ;; Use lax versions to not fail at the end of the word while
- ;; the user adds and removes characters in the search string
- ;; (or when using nonincremental word isearch)
- (let ((lax (not (or isearch-nonincremental
- (null (car isearch-cmds))
- (eq (length isearch-string)
- (length (isearch--state-string
- (car isearch-cmds))))))))
- (funcall
- (if isearch-forward #'re-search-forward #'re-search-backward)
- (if (functionp isearch-word)
- (funcall isearch-word string lax)
- (word-search-regexp string lax))
- bound noerror count))))
- ((and isearch-regexp isearch-regexp-lax-whitespace
- search-whitespace-regexp)
- (if isearch-forward
- 're-search-forward-lax-whitespace
- 're-search-backward-lax-whitespace))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- ((and isearch-lax-whitespace search-whitespace-regexp)
- (if isearch-forward
- 'search-forward-lax-whitespace
- 'search-backward-lax-whitespace))
- (t
- (if isearch-forward 'search-forward 'search-backward))))
+ (lambda (string &optional bound noerror count)
+ ;; Use lax versions to not fail at the end of the word while
+ ;; the user adds and removes characters in the search string
+ ;; (or when using nonincremental word isearch)
+ (let ((search-spaces-regexp (when (cond
+ (isearch-regexp isearch-regexp-lax-whitespace)
+ (t isearch-lax-whitespace))
+ search-whitespace-regexp)))
+ (funcall
+ (if isearch-forward #'re-search-forward #'re-search-backward)
+ (cond (isearch-regexp-function
+ (let ((lax (isearch--lax-regexp-function-p)))
+ (if (functionp isearch-regexp-function)
+ (funcall isearch-regexp-function string lax)
+ (word-search-regexp string lax))))
+ (isearch-regexp string)
+ (t (regexp-quote string)))
+ bound noerror count))))
(defun isearch-search-string (string bound noerror)
"Search for the first occurrence of STRING or its translation.
@@ -2773,10 +2714,18 @@ update the match data, and return point."
(invalid-regexp
(setq isearch-error (car (cdr lossage)))
- (if (string-match
- "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
- isearch-error)
- (setq isearch-error "incomplete input")))
+ (cond
+ ((string-match
+ "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
+ isearch-error)
+ (setq isearch-error "incomplete input"))
+ ((and (not isearch-regexp)
+ (string-match "\\`Regular expression too big" isearch-error))
+ (cond
+ (isearch-regexp-function
+ (setq isearch-error "Too many words"))
+ ((and isearch-lax-whitespace search-whitespace-regexp)
+ (setq isearch-error "Too many spaces for whitespace matching"))))))
(search-failed
(setq isearch-success nil)
@@ -2804,17 +2753,12 @@ update the match data, and return point."
;; isearch in their own way, they should set the
;; `isearch-open-invisible-temporary' to a function doing this.
(funcall (overlay-get ov 'isearch-open-invisible-temporary) ov nil)
- ;; Store the values for the `invisible' and `intangible'
- ;; properties, and then set them to nil. This way the text hidden
- ;; by this overlay becomes visible.
+ ;; Store the values for the `invisible' property, and then set it to nil.
+ ;; This way the text hidden by this overlay becomes visible.
- ;; Do we really need to set the `intangible' property to t? Can we
- ;; have the point inside an overlay with an `intangible' property?
;; In 19.34 this does not exist so I cannot test it.
(overlay-put ov 'isearch-invisible (overlay-get ov 'invisible))
- (overlay-put ov 'isearch-intangible (overlay-get ov 'intangible))
- (overlay-put ov 'invisible nil)
- (overlay-put ov 'intangible nil)))
+ (overlay-put ov 'invisible nil)))
;; This is called at the end of isearch. It will open the overlays
@@ -2823,17 +2767,14 @@ update the match data, and return point."
;; in any of these overlays, se we are safe in this case too.
(defun isearch-open-necessary-overlays (ov)
(let ((inside-overlay (and (> (point) (overlay-start ov))
- (< (point) (overlay-end ov))))
+ (<= (point) (overlay-end ov))))
;; If this exists it means that the overlay was opened using
;; this function, not by us tweaking the overlay properties.
(fct-temp (overlay-get ov 'isearch-open-invisible-temporary)))
(when (or inside-overlay (not fct-temp))
- ;; restore the values for the `invisible' and `intangible'
- ;; properties
+ ;; restore the values for the `invisible' properties.
(overlay-put ov 'invisible (overlay-get ov 'isearch-invisible))
- (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible))
- (overlay-put ov 'isearch-invisible nil)
- (overlay-put ov 'isearch-intangible nil))
+ (overlay-put ov 'isearch-invisible nil))
(if inside-overlay
(funcall (overlay-get ov 'isearch-open-invisible) ov)
(if fct-temp
@@ -2871,9 +2812,7 @@ update the match data, and return point."
;; properties.
(funcall fct-temp ov t)
(overlay-put ov 'invisible (overlay-get ov 'isearch-invisible))
- (overlay-put ov 'intangible (overlay-get ov 'isearch-intangible))
- (overlay-put ov 'isearch-invisible nil)
- (overlay-put ov 'isearch-intangible nil)))))))
+ (overlay-put ov 'isearch-invisible nil)))))))
(defun isearch-range-invisible (beg end)
@@ -2972,8 +2911,12 @@ since they have special meaning in a regexp."
(defun isearch-text-char-description (c)
(cond
- ((< c ?\s) (propertize (format "^%c" (+ c 64)) 'face 'escape-glyph))
- ((= c ?\^?) (propertize "^?" 'face 'escape-glyph))
+ ((< c ?\s) (propertize
+ (char-to-string c)
+ 'display (propertize (format "^%c" (+ c 64)) 'face 'escape-glyph)))
+ ((= c ?\^?) (propertize
+ (char-to-string c)
+ 'display (propertize "^?" 'face 'escape-glyph)))
(t (char-to-string c))))
;; General function to unread characters or events.
@@ -3022,7 +2965,7 @@ since they have special meaning in a regexp."
;; - `isearch-string' is expected to contain the current search
;; string as entered by the user;
;; - the type of the current search is expected to be given by
-;; `isearch-word' and `isearch-regexp';
+;; `isearch-regexp-function' and `isearch-regexp';
;; - the direction of the current search is expected to be given by
;; `isearch-forward';
;; - the variable `isearch-error' is expected to be true
@@ -3043,7 +2986,9 @@ since they have special meaning in a regexp."
(defvar isearch-lazy-highlight-regexp nil)
(defvar isearch-lazy-highlight-lax-whitespace nil)
(defvar isearch-lazy-highlight-regexp-lax-whitespace nil)
-(defvar isearch-lazy-highlight-word nil)
+(defvar isearch-lazy-highlight-regexp-function nil)
+(define-obsolete-variable-alias 'isearch-lazy-highlight-word
+ 'isearch-lazy-highlight-regexp-function "25.1")
(defvar isearch-lazy-highlight-forward nil)
(defvar isearch-lazy-highlight-error nil)
@@ -3082,8 +3027,8 @@ by other Emacs features."
isearch-case-fold-search))
(not (eq isearch-lazy-highlight-regexp
isearch-regexp))
- (not (eq isearch-lazy-highlight-word
- isearch-word))
+ (not (eq isearch-lazy-highlight-regexp-function
+ isearch-regexp-function))
(not (eq isearch-lazy-highlight-lax-whitespace
isearch-lax-whitespace))
(not (eq isearch-lazy-highlight-regexp-lax-whitespace
@@ -3123,7 +3068,7 @@ by other Emacs features."
isearch-lazy-highlight-regexp isearch-regexp
isearch-lazy-highlight-lax-whitespace isearch-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace isearch-regexp-lax-whitespace
- isearch-lazy-highlight-word isearch-word
+ isearch-lazy-highlight-regexp-function isearch-regexp-function
isearch-lazy-highlight-forward isearch-forward)
(unless (equal isearch-string "")
(setq isearch-lazy-highlight-timer
@@ -3136,7 +3081,7 @@ Attempt to do the search exactly the way the pending Isearch would."
(condition-case nil
(let ((case-fold-search isearch-lazy-highlight-case-fold-search)
(isearch-regexp isearch-lazy-highlight-regexp)
- (isearch-word isearch-lazy-highlight-word)
+ (isearch-regexp-function isearch-lazy-highlight-regexp-function)
(isearch-lax-whitespace
isearch-lazy-highlight-lax-whitespace)
(isearch-regexp-lax-whitespace
@@ -3148,11 +3093,15 @@ Attempt to do the search exactly the way the pending Isearch would."
(bound (if isearch-lazy-highlight-forward
(min (or isearch-lazy-highlight-end-limit (point-max))
(if isearch-lazy-highlight-wrapped
- isearch-lazy-highlight-start
+ (+ isearch-lazy-highlight-start
+ ;; Extend bound to match whole string at point
+ (1- (length isearch-lazy-highlight-last-string)))
(window-end)))
(max (or isearch-lazy-highlight-start-limit (point-min))
(if isearch-lazy-highlight-wrapped
- isearch-lazy-highlight-end
+ (- isearch-lazy-highlight-end
+ ;; Extend bound to match whole string at point
+ (1- (length isearch-lazy-highlight-last-string)))
(window-start))))))
;; Use a loop like in `isearch-search'.
(while retry
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index b66173ea02d..5e7771cea52 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -1,9 +1,9 @@
;;; isearchb --- a marriage between iswitchb and isearch
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 16 Apr 2004
;; Version: 1.5
;; Keywords: lisp
@@ -75,7 +75,9 @@
;; killing iswitchb.el and then trying to switch back is broken
;; make sure TAB isn't broken
-(require 'iswitchb)
+;;; Code:
+
+(require 'iswitchb) ;FIXME: Don't rely on iswitchb!
(defgroup isearchb nil
"Switch between buffers using a mechanism like isearch."
@@ -118,7 +120,7 @@ Its purpose is to pass different call arguments to
(interactive)
(let* ((prompt "iswitch ")
(iswitchb-method 'samewindow)
- (buf (iswitchb-read-buffer prompt nil nil iswitchb-text t)))
+ (buf (iswitchb-read-buffer prompt nil nil nil iswitchb-text t)))
(if (eq iswitchb-exit 'findfile)
(call-interactively 'find-file)
(when buf
@@ -139,7 +141,8 @@ Its purpose is to pass different call arguments to
(if last-command-event
(setq iswitchb-rescan t
iswitchb-text (concat iswitchb-text
- (char-to-string last-command-event))))
+ (char-to-string
+ (event-basic-type last-command-event)))))
(iswitchb-set-matches)
(let* ((match (car iswitchb-matches))
(buf (and match (get-buffer match))))
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index d0e88309daf..4e8fa7b15cb 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -1,6 +1,6 @@
;;; jit-lock.el --- just-in-time fontification -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
;; Keywords: faces files
@@ -125,7 +125,8 @@ The value of this variable is used when JIT Lock mode is turned on."
(defcustom jit-lock-defer-time nil ;; 0.25
"Idle time after which deferred fontification should take place.
-If nil, fontification is not deferred."
+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")))
@@ -189,69 +190,77 @@ following ways:
Stealth fontification only occurs while the system remains unloaded.
If the system load rises above `jit-lock-stealth-load' percent, stealth
fontification is suspended. Stealth fontification intensity is controlled via
-the variable `jit-lock-stealth-nice'."
+the variable `jit-lock-stealth-nice'.
+
+If you need to debug code run from jit-lock, see `jit-lock-debug-mode'."
(setq jit-lock-mode arg)
- (cond (;; Turn Just-in-time Lock mode on.
- jit-lock-mode
-
- ;; Mark the buffer for refontification.
- (jit-lock-refontify)
-
- ;; Install an idle timer for stealth fontification.
- (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
- (setq jit-lock-stealth-timer
- (run-with-idle-timer jit-lock-stealth-time t
- 'jit-lock-stealth-fontify)))
-
- ;; Create, but do not activate, the idle timer for repeated
- ;; stealth fontification.
- (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
- (setq jit-lock-stealth-repeat-timer (timer-create))
- (timer-set-function jit-lock-stealth-repeat-timer
- 'jit-lock-stealth-fontify '(t)))
-
- ;; Init deferred fontification timer.
- (when (and jit-lock-defer-time (null jit-lock-defer-timer))
- (setq jit-lock-defer-timer
- (run-with-idle-timer jit-lock-defer-time t
- 'jit-lock-deferred-fontify)))
-
- ;; Initialize contextual fontification if requested.
- (when (eq jit-lock-contextually t)
- (unless jit-lock-context-timer
- (setq jit-lock-context-timer
- (run-with-idle-timer jit-lock-context-time t
- 'jit-lock-context-fontify)))
- (setq jit-lock-context-unfontify-pos
- (or jit-lock-context-unfontify-pos (point-max))))
-
- ;; Setup our hooks.
- (add-hook 'after-change-functions 'jit-lock-after-change nil t)
- (add-hook 'fontification-functions 'jit-lock-function))
-
- ;; Turn Just-in-time Lock mode off.
- (t
- ;; Cancel our idle timers.
- (when (and (or jit-lock-stealth-timer jit-lock-defer-timer
- jit-lock-context-timer)
- ;; Only if there's no other buffer using them.
- (not (catch 'found
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when jit-lock-mode (throw 'found t)))))))
- (when jit-lock-stealth-timer
- (cancel-timer jit-lock-stealth-timer)
- (setq jit-lock-stealth-timer nil))
- (when jit-lock-context-timer
- (cancel-timer jit-lock-context-timer)
- (setq jit-lock-context-timer nil))
- (when jit-lock-defer-timer
- (cancel-timer jit-lock-defer-timer)
- (setq jit-lock-defer-timer nil)))
-
- ;; Remove hooks.
- (remove-hook 'after-change-functions 'jit-lock-after-change t)
- (remove-hook 'fontification-functions 'jit-lock-function))))
+ (cond
+ ((buffer-base-buffer)
+ ;; We're in an indirect buffer. This doesn't work because jit-lock relies
+ ;; on the `fontified' text-property which is shared with the base buffer.
+ (setq jit-lock-mode nil)
+ (message "Not enabling jit-lock: it does not work in indirect buffer"))
+
+ (jit-lock-mode ;; Turn Just-in-time Lock mode on.
+
+ ;; Mark the buffer for refontification.
+ (jit-lock-refontify)
+
+ ;; Install an idle timer for stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
+ (setq jit-lock-stealth-timer
+ (run-with-idle-timer jit-lock-stealth-time t
+ 'jit-lock-stealth-fontify)))
+
+ ;; Create, but do not activate, the idle timer for repeated
+ ;; stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
+ (setq jit-lock-stealth-repeat-timer (timer-create))
+ (timer-set-function jit-lock-stealth-repeat-timer
+ 'jit-lock-stealth-fontify '(t)))
+
+ ;; Init deferred fontification timer.
+ (when (and jit-lock-defer-time (null jit-lock-defer-timer))
+ (setq jit-lock-defer-timer
+ (run-with-idle-timer jit-lock-defer-time t
+ 'jit-lock-deferred-fontify)))
+
+ ;; Initialize contextual fontification if requested.
+ (when (eq jit-lock-contextually t)
+ (unless jit-lock-context-timer
+ (setq jit-lock-context-timer
+ (run-with-idle-timer jit-lock-context-time t
+ 'jit-lock-context-fontify)))
+ (setq jit-lock-context-unfontify-pos
+ (or jit-lock-context-unfontify-pos (point-max))))
+
+ ;; Setup our hooks.
+ (add-hook 'after-change-functions 'jit-lock-after-change nil t)
+ (add-hook 'fontification-functions 'jit-lock-function))
+
+ ;; Turn Just-in-time Lock mode off.
+ (t
+ ;; Cancel our idle timers.
+ (when (and (or jit-lock-stealth-timer jit-lock-defer-timer
+ jit-lock-context-timer)
+ ;; Only if there's no other buffer using them.
+ (not (catch 'found
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when jit-lock-mode (throw 'found t)))))))
+ (when jit-lock-stealth-timer
+ (cancel-timer jit-lock-stealth-timer)
+ (setq jit-lock-stealth-timer nil))
+ (when jit-lock-context-timer
+ (cancel-timer jit-lock-context-timer)
+ (setq jit-lock-context-timer nil))
+ (when jit-lock-defer-timer
+ (cancel-timer jit-lock-defer-timer)
+ (setq jit-lock-defer-timer nil)))
+
+ ;; Remove hooks.
+ (remove-hook 'after-change-functions 'jit-lock-after-change t)
+ (remove-hook 'fontification-functions 'jit-lock-function))))
(define-minor-mode jit-lock-debug-mode
"Minor mode to help debug code run from jit-lock.
@@ -310,10 +319,6 @@ Only applies to the current buffer."
(remove-hook 'jit-lock-functions fun t)
(unless jit-lock-functions (jit-lock-mode nil)))
-;; This function is used to prevent font-lock-fontify-buffer from
-;; fontifying eagerly the whole buffer. This is important for
-;; things like CWarn mode which adds/removes a few keywords and
-;; does a refontify (which takes ages on large files).
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
(with-buffer-prepared-for-jit-lock
@@ -329,7 +334,9 @@ Only applies to the current buffer."
This function is added to `fontification-functions' when `jit-lock-mode'
is active."
(when (and jit-lock-mode (not memory-full))
- (if (null jit-lock-defer-timer)
+ (if (not (and jit-lock-defer-timer
+ (or (not (eq jit-lock-defer-time 0))
+ (input-pending-p))))
;; No deferral.
(jit-lock-fontify-now start (+ start jit-lock-chunk-size))
;; Record the buffer for later fontification.
@@ -344,6 +351,30 @@ is active."
(min (point-max) (+ start jit-lock-chunk-size)))
'fontified 'defer)))))
+(defun jit-lock--run-functions (beg end)
+ (let ((tight-beg nil) (tight-end nil)
+ (loose-beg beg) (loose-end end))
+ (run-hook-wrapped
+ 'jit-lock-functions
+ (lambda (fun)
+ (pcase-let*
+ ((res (funcall fun beg end))
+ (`(,this-beg . ,this-end)
+ (if (eq (car-safe res) 'jit-lock-bounds)
+ (cdr res) (cons beg end))))
+ ;; If all functions don't fontify the same region, we currently
+ ;; just try to "still be correct". But we could go further and for
+ ;; the chunks of text that was fontified by some functions but not
+ ;; all, we could add text-properties indicating which functions were
+ ;; already run to avoid running them redundantly when we get to
+ ;; those chunks.
+ (setq tight-beg (max (or tight-beg (point-min)) this-beg))
+ (setq tight-end (min (or tight-end (point-max)) this-end))
+ (setq loose-beg (min loose-beg this-beg))
+ (setq loose-end (max loose-end this-end))
+ nil)))
+ `(,(min tight-beg beg) ,(max tight-end end) ,loose-beg ,loose-end)))
+
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
Defaults to the whole buffer. END can be out of bounds."
@@ -351,14 +382,6 @@ Defaults to the whole buffer. END can be out of bounds."
(save-excursion
(unless start (setq start (point-min)))
(setq end (if end (min end (point-max)) (point-max)))
- ;; This did bind `font-lock-beginning-of-syntax-function' to
- ;; nil at some point, for an unknown reason. Don't do this; it
- ;; can make highlighting slow due to expensive calls to
- ;; `parse-partial-sexp' in function
- ;; `font-lock-fontify-syntactically-region'. Example: paging
- ;; from the end of a buffer to its start, can do repeated
- ;; `parse-partial-sexp' starting from `point-min', which can
- ;; take a long time in a large buffer.
(let ((orig-start start) next)
(save-match-data
;; Fontify chunks beginning at START. The end of a
@@ -369,57 +392,62 @@ Defaults to the whole buffer. END can be out of bounds."
(setq next (or (text-property-any start end 'fontified t)
end))
- ;; Decide which range of text should be fontified.
- ;; The problem is that START and NEXT may be in the
- ;; middle of something matched by a font-lock regexp.
- ;; Until someone has a better idea, let's start
- ;; at the start of the line containing START and
- ;; stop at the start of the line following NEXT.
- (goto-char next) (setq next (line-beginning-position 2))
- (goto-char start) (setq start (line-beginning-position))
-
- ;; Make sure the contextual refontification doesn't re-refontify
- ;; what's already been refontified.
- (when (and jit-lock-context-unfontify-pos
- (< jit-lock-context-unfontify-pos next)
- (>= jit-lock-context-unfontify-pos start)
- ;; Don't move boundary forward if we have to
- ;; refontify previous text. Otherwise, we risk moving
- ;; it past the end of the multiline property and thus
- ;; forget about this multiline region altogether.
- (not (get-text-property start 'jit-lock-defer-multiline)))
- (setq jit-lock-context-unfontify-pos next))
-
;; Fontify the chunk, and mark it as fontified.
;; We mark it first, to make sure that we don't indefinitely
;; re-execute this fontification if an error occurs.
(put-text-property start next 'fontified t)
- (condition-case err
- (run-hook-with-args 'jit-lock-functions start next)
- ;; If the user quits (which shouldn't happen in normal on-the-fly
- ;; jit-locking), make sure the fontification will be performed
- ;; before displaying the block again.
- (quit (put-text-property start next 'fontified nil)
- (funcall 'signal (car err) (cdr err))))
-
- ;; The redisplay engine has already rendered the buffer up-to
- ;; `orig-start' and won't notice if the above jit-lock-functions
- ;; changed the appearance of any part of the buffer prior
- ;; to that. So if `start' is before `orig-start', we need to
- ;; cause a new redisplay cycle after this one so that any changes
- ;; are properly reflected on screen.
- ;; To make such repeated redisplay happen less often, we can
- ;; eagerly extend the refontified region with
- ;; jit-lock-after-change-extend-region-functions.
- (when (< start orig-start)
- (run-with-timer 0 nil #'jit-lock-force-redisplay
- (copy-marker start) (copy-marker orig-start)))
-
- ;; Find the start of the next chunk, if any.
- (setq start (text-property-any next end 'fontified nil))))))))
+ (pcase-let
+ ;; `tight' is the part we've fully refontified, and `loose'
+ ;; is the part we've partly refontified (some of the
+ ;; functions have refontified it but maybe not all).
+ ((`(,tight-beg ,tight-end ,loose-beg ,_loose-end)
+ (condition-case err
+ (jit-lock--run-functions start next)
+ ;; If the user quits (which shouldn't happen in normal
+ ;; on-the-fly jit-locking), make sure the fontification
+ ;; will be performed before displaying the block again.
+ (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.
+ (when (or (< tight-beg start) (> tight-end next))
+ (put-text-property tight-beg tight-end 'fontified t))
+
+ ;; Make sure the contextual refontification doesn't re-refontify
+ ;; what's already been refontified.
+ (when (and jit-lock-context-unfontify-pos
+ (< jit-lock-context-unfontify-pos tight-end)
+ (>= jit-lock-context-unfontify-pos tight-beg)
+ ;; Don't move boundary forward if we have to
+ ;; refontify previous text. Otherwise, we risk moving
+ ;; it past the end of the multiline property and thus
+ ;; forget about this multiline region altogether.
+ (not (get-text-property tight-beg
+ 'jit-lock-defer-multiline)))
+ (setq jit-lock-context-unfontify-pos tight-end))
+
+ ;; The redisplay engine has already rendered the buffer up-to
+ ;; `orig-start' and won't notice if the above jit-lock-functions
+ ;; changed the appearance of any part of the buffer prior
+ ;; to that. So if `loose-beg' is before `orig-start', we need to
+ ;; cause a new redisplay cycle after this one so that the changes
+ ;; are properly reflected on screen.
+ ;; To make such repeated redisplay happen less often, we can
+ ;; eagerly extend the refontified region with
+ ;; jit-lock-after-change-extend-region-functions.
+ (when (< loose-beg orig-start)
+ (run-with-timer 0 nil #'jit-lock-force-redisplay
+ (copy-marker loose-beg)
+ (copy-marker orig-start)))
+
+ ;; Find the start of the next chunk, if any.
+ (setq start
+ (text-property-any tight-end end 'fontified nil)))))))))
(defun jit-lock-force-redisplay (start end)
- "Force the display engine to re-render buffer BUF from START to END."
+ "Force the display engine to re-render START's buffer from START to END.
+This applies to the buffer associated with marker START."
(when (marker-buffer start)
(with-current-buffer (marker-buffer start)
(with-buffer-prepared-for-jit-lock
@@ -494,7 +522,10 @@ non-nil in a repeated invocation of this function."
message-log-max
start)
(if (and jit-lock-stealth-load
- (> (car (load-average)) jit-lock-stealth-load))
+ ;; load-average can return nil. The w32 emulation does
+ ;; that during the first few dozens of seconds after
+ ;; startup.
+ (> (or (car (load-average)) 0) jit-lock-stealth-load))
;; Wait a little if load is too high.
(setq delay jit-lock-stealth-time)
(if (buffer-live-p buffer)
@@ -544,11 +575,13 @@ non-nil in a repeated invocation of this function."
'fontified nil))
(setq pos (next-single-property-change
pos 'fontified)))))))))
- (setq jit-lock-defer-buffers nil)
;; Force fontification of the visible parts.
- (let ((jit-lock-defer-timer nil))
+ (let ((buffers jit-lock-defer-buffers)
+ (jit-lock-defer-timer nil))
+ (setq jit-lock-defer-buffers nil)
;; (message "Jit-Defer Now")
- (sit-for 0)
+ (unless (redisplay) ;FIXME: Should we `force'?
+ (setq jit-lock-defer-buffers buffers))
;; (message "Jit-Defer Done")
)))
@@ -611,12 +644,14 @@ will take place when text is fontified stealthily."
(let ((jit-lock-start start)
(jit-lock-end end))
(with-buffer-prepared-for-jit-lock
- (run-hook-with-args 'jit-lock-after-change-extend-region-functions
- start end old-len)
- ;; Make sure we change at least one char (in case of deletions).
- (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
- ;; Request refontification.
- (put-text-property jit-lock-start jit-lock-end 'fontified nil))
+ (run-hook-with-args 'jit-lock-after-change-extend-region-functions
+ start end old-len)
+ ;; Make sure we change at least one char (in case of deletions).
+ (setq jit-lock-end (min (max jit-lock-end (1+ start)) (point-max)))
+ ;; Request refontification.
+ (save-restriction
+ (widen)
+ (put-text-property jit-lock-start jit-lock-end 'fontified nil)))
;; Mark the change for deferred contextual refontification.
(when jit-lock-context-unfontify-pos
(setq jit-lock-context-unfontify-pos
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 32788b2dfb7..ef6cfb14978 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -1,10 +1,10 @@
;;; jka-cmpr-hook.el --- preloaded code to enable jka-compr.el
-;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2013 Free Software
+;; Copyright (C) 1993-1995, 1997, 1999-2000, 2002-2015 Free Software
;; Foundation, Inc.
-;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Maintainer: FSF
+;; Author: Jay K. Adams <jka@ece.cmu.edu>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: data
;; Package: emacs
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 7266dc9ec80..fced4eeb5f6 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -1,10 +1,10 @@
;;; jka-compr.el --- reading/writing/loading compressed files
-;; Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation,
+;; Copyright (C) 1993-1995, 1997, 1999-2015 Free Software Foundation,
;; Inc.
-;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Maintainer: FSF
+;; Author: Jay K. Adams <jka@ece.cmu.edu>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: data
;; This file is part of GNU Emacs.
diff --git a/lisp/json.el b/lisp/json.el
index aaa7bb0c499..b23d12ad0ed 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -1,6 +1,6 @@
;;; json.el --- JavaScript Object Notation parser / generator
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Edward O'Connor <ted@oconnor.cx>
;; Version: 1.4
@@ -52,19 +52,13 @@
;;; Code:
-
-;; Compatibility code
-
-(defalias 'json-encode-char0 'encode-char)
-(defalias 'json-decode-char0 'decode-char)
-
-
;; Parameters
(defvar json-object-type 'alist
"Type to convert JSON objects to.
Must be one of `alist', `plist', or `hash-table'. Consider let-binding
-this around your call to `json-read' instead of `setq'ing it.")
+this around your call to `json-read' instead of `setq'ing it. Ordering
+is maintained for `alist' and `plist', but not for `hash-table'.")
(defvar json-array-type 'vector
"Type to convert JSON arrays to.
@@ -126,9 +120,10 @@ without indentation.")
(mapconcat 'identity strings separator))
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist."
+ "Non-null if and only if LIST is an alist with simple keys."
(while (consp list)
- (setq list (if (consp (car list))
+ (setq list (if (and (consp (car list))
+ (atom (caar list)))
(cdr list)
'not-alist)))
(null list))
@@ -142,6 +137,17 @@ without indentation.")
'not-plist)))
(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))
+
(defmacro json--with-indentation (body)
`(let ((json--encoding-current-indentation
(if json-encoding-pretty-print
@@ -165,7 +171,7 @@ without indentation.")
"Advance past the character at point, returning it."
(let ((char (json-peek)))
(if (eq char :json-eof)
- (signal 'end-of-file nil)
+ (signal 'json-end-of-file nil)
(json-advance)
char)))
@@ -185,6 +191,8 @@ without indentation.")
(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-end-of-file "End of file while parsing JSON"
+ '(end-of-file json-error))
@@ -262,7 +270,6 @@ representation will be parsed correctly."
(defvar json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
- (?/ . ?/)
(?b . ?\b)
(?f . ?\f)
(?n . ?\n)
@@ -284,14 +291,14 @@ representation will be parsed correctly."
((looking-at "[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]")
(let ((hex (match-string 0)))
(json-advance 4)
- (json-decode-char0 'ucs (string-to-number hex 16))))
+ (string-to-number hex 16)))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
(unless (char-equal (json-peek) ?\")
- (signal 'json-string-format (list "doesn't start with '\"'!")))
+ (signal 'json-string-format (list "doesn't start with `\"'!")))
;; Skip over the '"'
(json-advance)
(let ((characters '())
@@ -310,24 +317,29 @@ representation will be parsed correctly."
;; String encoding
-(defun json-encode-char (char)
- "Encode CHAR as a JSON string."
- (setq char (json-encode-char0 char 'ucs))
- (let ((control-char (car (rassoc char json-special-chars))))
- (cond
- ;; Special JSON character (\n, \r, etc.).
- (control-char
- (format "\\%c" control-char))
- ;; ASCIIish printable character.
- ((and (> char 31) (< char 127))
- (format "%c" char))
- ;; Fallback: UCS code point in \uNNNN form.
- (t
- (format "\\u%04x" char)))))
-
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- (format "\"%s\"" (mapconcat 'json-encode-char 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))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
@@ -346,7 +358,7 @@ Please see the documentation of `json-object-type'."
(cond ((eq json-object-type 'hash-table)
(make-hash-table :test 'equal))
(t
- (list))))
+ ())))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
@@ -400,7 +412,10 @@ Please see the documentation of `json-object-type' and `json-key-type'."
(signal 'json-object-format (list "," (json-peek))))))
;; Skip over the "}"
(json-advance)
- elements))
+ (pcase json-object-type
+ (`alist (nreverse elements))
+ (`plist (json--plist-reverse elements))
+ (_ elements))))
;; Hash table encoding
@@ -553,7 +568,7 @@ Advances point just past JSON object."
(if (functionp (car record))
(apply (car record) (cdr record))
(signal 'json-readtable-error record)))
- (signal 'end-of-file nil))))
+ (signal 'json-end-of-file nil))))
;; Syntactic sugar for the reader
@@ -602,6 +617,8 @@ Advances point just past JSON object."
(interactive "r")
(atomic-change-group
(let ((json-encoding-pretty-print t)
+ ;; Ensure that ordering is maintained
+ (json-object-type 'alist)
(txt (delete-and-extract-region begin end)))
(insert (json-encode (json-read-from-string txt))))))
diff --git a/lisp/kermit.el b/lisp/kermit.el
index da9fb1e3869..9b464ab04b1 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -1,9 +1,9 @@
;;; kermit.el --- additions to shell mode for use with kermit
-;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2015 Free Software Foundation, Inc.
;; Author: Jeff Norden <jeff@colgate.csnet>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 15 Feb 1988
;; Keywords: comm
@@ -135,7 +135,7 @@ In this state, use LFD to send a line and end it with a carriage-return."
(defun kermit-clean-on ()
"Delete all null characters and ^M's from the kermit output.
Note that another (perhaps better) way to do this is to use the
-command `kermit | tr -d '\\015''."
+command `kermit | tr -d \\='\\015\\=''."
(interactive)
(set-process-filter (get-buffer-process (current-buffer))
'kermit-clean-filter))
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index d6de2feb3fc..ddf3005bab5 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,6 +1,6 @@
;;; kmacro.el --- enhanced keyboard macros
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
@@ -432,7 +432,7 @@ Optional arg EMPTY is message to print if no macros are defined."
(setq last-input-event nil)))
(when last-input-event
(clear-this-command-keys t)
- (setq unread-command-events (list last-input-event))))
+ (push last-input-event unread-command-events)))
(defun kmacro-get-repeat-prefix ()
@@ -445,7 +445,8 @@ Optional arg EMPTY is message to print if no macros are defined."
;;;###autoload
(defun kmacro-exec-ring-item (item arg)
- "Execute item ITEM from the macro ring."
+ "Execute item ITEM from the macro ring.
+ARG is the number of times to execute the item."
;; Use counter and format specific to the macro on the ring!
(let ((kmacro-counter (nth 1 item))
(kmacro-counter-format-start (nth 2 item)))
@@ -482,7 +483,8 @@ without repeating the prefix."
(defun kmacro-cycle-ring-next (&optional _arg)
"Move to next keyboard macro in keyboard macro ring.
-Displays the selected macro in the echo area."
+Displays the selected macro in the echo area.
+The ARG parameter is unused."
(interactive)
(unless (kmacro-ring-empty-p)
(kmacro-push-ring)
@@ -501,7 +503,8 @@ Displays the selected macro in the echo area."
(defun kmacro-cycle-ring-previous (&optional _arg)
"Move to previous keyboard macro in keyboard macro ring.
-Displays the selected macro in the echo area."
+Displays the selected macro in the echo area.
+The ARG parameter is unused."
(interactive)
(unless (kmacro-ring-empty-p)
(let ((keys (kmacro-get-repeat-prefix))
@@ -528,7 +531,8 @@ Displays the selected macro in the echo area."
(defun kmacro-delete-ring-head (&optional _arg)
- "Delete current macro from keyboard macro ring."
+ "Delete current macro from keyboard macro ring.
+The ARG parameter is unused."
(interactive)
(unless (kmacro-ring-empty-p t)
(if (null kmacro-ring)
@@ -650,10 +654,10 @@ others, use \\[kmacro-name-last-macro]."
(if (and kmacro-call-repeat-with-arg
arg (> arg 1))
(format " %d times" arg) "")))
- ;; Can't use the `keep-pred' arg because this overlay keymap needs to be
- ;; removed during the next run of the kmacro (i.e. we need to add&remove
- ;; this overlay-map at each repetition).
- (set-temporary-overlay-map
+ ;; Can't use the `keep-pred' arg because this overlay keymap
+ ;; needs to be removed during the next run of the kmacro
+ ;; (i.e. we must add and remove this map at each repetition).
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map (vector repeat-key)
`(lambda () (interactive)
@@ -792,7 +796,8 @@ You can bind to any valid key sequence, but if you try to bind to
a key with an existing command binding, you will be asked for
confirmation whether to replace that binding. Note that the
binding is made in the `global-map' keymap, so the macro binding
-may be shaded by a local key binding."
+may be shaded by a local key binding.
+The ARG parameter is unused."
(interactive "p")
(if (or defining-kbd-macro executing-kbd-macro)
(if defining-kbd-macro
@@ -845,11 +850,13 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
(kmacro-call-macro current-prefix-arg nil nil k))
(defun kmacro-to-register (r)
- "Store the last keyboard macro in register R."
+ "Store the last keyboard macro in register R.
+
+Interactively, reads the register using `register-read-with-preview'."
(interactive
(progn
(or last-kbd-macro (error "No keyboard macro defined"))
- (list (read-char "Save to register: "))))
+ (list (register-read-with-preview "Save to register: "))))
(set-register r (registerv-make
last-kbd-macro
:jump-func 'kmacro-execute-from-register
@@ -862,7 +869,8 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
(defun kmacro-view-macro (&optional _arg)
"Display the last keyboard macro.
-If repeated, it shows previous elements in the macro ring."
+If repeated, it shows previous elements in the macro ring.
+The ARG parameter is unused."
(interactive)
(cond
((or (kmacro-ring-empty-p)
@@ -933,7 +941,6 @@ without repeating the prefix."
(defvar kmacro-step-edit-inserting) ;; inserting into macro
(defvar kmacro-step-edit-appending) ;; append to end of macro
(defvar kmacro-step-edit-replace) ;; replace orig macro when done
-(defvar kmacro-step-edit-prefix-index) ;; index of first prefix arg key
(defvar kmacro-step-edit-key-index) ;; index of current key
(defvar kmacro-step-edit-action) ;; automatic action on next pre-command hook
(defvar kmacro-step-edit-help) ;; kmacro step edit help enabled
@@ -968,11 +975,6 @@ This keymap is an extension to the `query-replace-map', allowing the
following additional answers: `insert', `insert-1', `replace', `replace-1',
`append', `append-end', `act-repeat', `skip-end', `skip-keep'.")
-(defvar kmacro-step-edit-prefix-commands
- '(universal-argument universal-argument-more universal-argument-minus
- digit-argument negative-argument)
- "Commands which build up a prefix arg for the current command.")
-
(defun kmacro-step-edit-prompt (macro index)
;; Show step-edit prompt
(let ((keys (and (not kmacro-step-edit-appending)
@@ -1076,21 +1078,13 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
;; Handle prefix arg, or query user
(cond
(act act) ;; set above
- ((memq this-command kmacro-step-edit-prefix-commands)
- (unless kmacro-step-edit-prefix-index
- (setq kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
- (setq act 'universal-argument))
- ((eq this-command 'universal-argument-other-key)
- (setq act 'universal-argument))
(t
- (kmacro-step-edit-prompt macro (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+ (kmacro-step-edit-prompt macro kmacro-step-edit-key-index)
(setq act (lookup-key kmacro-step-edit-map
(vector (with-current-buffer (current-buffer) (read-event))))))))
;; Resume macro execution and perform the action
(cond
- ((eq act 'universal-argument)
- nil)
((cond
((eq act 'act)
t)
@@ -1102,7 +1096,6 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq kmacro-step-edit-active 'ignore)
nil)
((eq act 'skip)
- (setq kmacro-step-edit-prefix-index nil)
nil)
((eq act 'skip-keep)
(setq this-command 'ignore)
@@ -1115,12 +1108,11 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq act t)
t)
((member act '(insert-1 insert))
- (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+ (setq executing-kbd-macro-index kmacro-step-edit-key-index)
(setq kmacro-step-edit-inserting (if (eq act 'insert-1) 1 t))
nil)
((member act '(replace-1 replace))
(setq kmacro-step-edit-inserting (if (eq act 'replace-1) 1 t))
- (setq kmacro-step-edit-prefix-index nil)
(if (= executing-kbd-macro-index (length executing-kbd-macro))
(setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
kmacro-step-edit-appending t))
@@ -1140,19 +1132,19 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq act t)
t)
((eq act 'help)
- (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+ (setq executing-kbd-macro-index kmacro-step-edit-key-index)
(setq kmacro-step-edit-help (not kmacro-step-edit-help))
nil)
(t ;; Ignore unknown responses
- (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+ (setq executing-kbd-macro-index kmacro-step-edit-key-index)
nil))
- (if (> executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+ (if (> executing-kbd-macro-index kmacro-step-edit-key-index)
(setq kmacro-step-edit-new-macro
(vconcat kmacro-step-edit-new-macro
(substring executing-kbd-macro
- (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)
- (if (eq act t) nil executing-kbd-macro-index)))
- kmacro-step-edit-prefix-index nil))
+ kmacro-step-edit-key-index
+ (if (eq act t) nil
+ executing-kbd-macro-index)))))
(if restore-index
(setq executing-kbd-macro-index restore-index)))
(t
@@ -1167,12 +1159,10 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(executing-kbd-macro nil)
(defining-kbd-macro nil)
cmd keys next-index)
- (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)
- kmacro-step-edit-prefix-index nil)
+ (setq executing-kbd-macro-index kmacro-step-edit-key-index)
(kmacro-step-edit-prompt macro nil)
;; Now, we have read a key sequence from the macro, but we don't want
;; to execute it yet. So push it back and read another sequence.
- (reset-this-command-lengths)
(setq keys (read-key-sequence nil nil nil nil t))
(setq cmd (key-binding keys t nil))
(if (cond
@@ -1193,28 +1183,12 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
unread-command-events nil)))
(setq cmd 'ignore)
nil)
- ((memq cmd kmacro-step-edit-prefix-commands)
- (setq universal-argument-num-events 0)
- (reset-this-command-lengths)
- nil)
- ((eq cmd 'universal-argument-other-key)
- (setq kmacro-step-edit-action t)
- (setq universal-argument-num-events 0)
- (reset-this-command-lengths)
- (if (numberp kmacro-step-edit-inserting)
- (setq kmacro-step-edit-inserting nil))
- nil)
((numberp kmacro-step-edit-inserting)
(setq kmacro-step-edit-inserting nil)
nil)
((equal keys "\C-j")
(setq kmacro-step-edit-inserting nil)
(setq kmacro-step-edit-action nil)
- ;; Forget any (partial) prefix arg from next command
- (setq kmacro-step-edit-prefix-index nil)
- (reset-this-command-lengths)
- (setq overriding-terminal-local-map nil)
- (setq universal-argument-num-events nil)
(setq next-index kmacro-step-edit-key-index)
t)
(t nil))
@@ -1273,7 +1247,6 @@ To customize possible responses, change the \"bindings\" in `kmacro-step-edit-ma
(kmacro-step-edit-inserting nil)
(kmacro-step-edit-appending nil)
(kmacro-step-edit-replace t)
- (kmacro-step-edit-prefix-index nil)
(kmacro-step-edit-key-index 0)
(kmacro-step-edit-action nil)
(kmacro-step-edit-help nil)
diff --git a/lisp/language/.gitignore b/lisp/language/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/language/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 7ef842ce66c..3b879279680 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -1,6 +1,6 @@
;;; china-util.el --- utilities for Chinese -*- coding: utf-8 -*-
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -52,16 +52,16 @@
;; ISO-2022 escape sequence to designate GB2312.
(defvar iso2022-gb-designation "\e$A")
;; HZ escape sequence to designate GB2312.
-(defvar hz-gb-designnation "~{")
+(defvar hz-gb-designation "~{")
;; ISO-2022 escape sequence to designate ASCII.
(defvar iso2022-ascii-designation "\e(B")
;; HZ escape sequence to designate ASCII.
-(defvar hz-ascii-designnation "~}")
+(defvar hz-ascii-designation "~}")
;; Regexp of ZW sequence to start GB2312.
(defvar zw-start-gb "^zW")
;; Regexp for start of GB2312 in an encoding mixture of HZ and ZW.
(defvar hz/zw-start-gb
- (concat hz-gb-designnation "\\|" zw-start-gb "\\|[^\0-\177]"))
+ (concat hz-gb-designation "\\|" zw-start-gb "\\|[^\0-\177]"))
(defvar decode-hz-line-continuation nil
"Flag to tell if we should care line continuation convention of Hz.")
@@ -117,7 +117,7 @@ Return the length of resulting text."
(progn
(translate-region (point) end hz-set-msb-table)
(goto-char end))
- (if (search-forward hz-ascii-designnation
+ (if (search-forward hz-ascii-designation
(if decode-hz-line-continuation nil end)
t)
(delete-char -2))
@@ -155,11 +155,11 @@ Return the length of resulting text."
(goto-char pos)
(while (search-forward iso2022-gb-designation nil t)
(delete-char -3)
- (insert hz-gb-designnation))
+ (insert hz-gb-designation))
(goto-char pos)
(while (search-forward iso2022-ascii-designation nil t)
(delete-char -3)
- (insert hz-ascii-designnation))))
+ (insert hz-ascii-designation))))
(- (point-max) (point-min)))))
;;;###autoload
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index 5be4e344b50..e34c762490a 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -1,6 +1,6 @@
;;; chinese.el --- support for Chinese -*- coding: utf-8; -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index 7af8b993288..5ee927dc320 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -1,6 +1,6 @@
;;; cyril-util.el --- utilities for Cyrillic scripts
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Keywords: mule, multilingual, Cyrillic
@@ -41,7 +41,7 @@
;; Written by Valery Alexeev <valery@math.uga.edu>.
(defvar cyrillic-language-alist
- (list '("Belorussian") '("Bulgarian") '("Macedonian")
+ (list '("Belarusian") '("Bulgarian") '("Macedonian")
'("Russian") '("Serbo-Croatian") '("Ukrainian"))
"List of known cyrillic languages.")
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index 302c6ea9db2..13f763629b6 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -1,6 +1,6 @@
;;; cyrillic.el --- support for Cyrillic -*- coding: utf-8; -*-
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -215,7 +215,7 @@ Support for Russian using koi8-r and the russian-computer input method.")
:charset-list '(mik))
(define-coding-system 'pt154
- "Parattype Asian Cyrillic codepage"
+ "ParaType Asian Cyrillic codepage"
:coding-type 'charset
:mnemonic ?D
:charset-list '(pt154))
diff --git a/lisp/language/czech.el b/lisp/language/czech.el
index bbc7c19d4e5..d5d19d7ec88 100644
--- a/lisp/language/czech.el
+++ b/lisp/language/czech.el
@@ -1,6 +1,6 @@
;;; czech.el --- support for Czech -*- coding: utf-8 -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Pavel Janík <Pavel@Janik.cz>
diff --git a/lisp/language/english.el b/lisp/language/english.el
index e99232844a0..af291a94385 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -1,6 +1,6 @@
;;; english.el --- support for English
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index cbc2d623470..127865760d0 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -1,6 +1,6 @@
;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997-1998, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2002-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -129,9 +129,9 @@ isolated vowel.")
"Degree of reduction in converting Ethiopic digits into Arabic digits.
Should be 0, 1 or 2.
For example, ({10}{9}{100}{80}{7}) is converted into:
- `10`9`100`80`7 if `ethio-numeric-reduction' is 0,
- `109100807 if `ethio-numeric-reduction' is 1,
- `10900807 if `ethio-numeric-reduction' is 2.")
+ \\=`10\\=`9\\=`100\\=`80\\=`7 if `ethio-numeric-reduction' is 0,
+ \\=`109100807 if `ethio-numeric-reduction' is 1,
+ \\=`10900807 if `ethio-numeric-reduction' is 2.")
(defvar ethio-java-save-lowercase nil
"Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
@@ -2071,5 +2071,3 @@ mark."
(provide 'ethio-util)
;;; ethio-util.el ends here
-
-;;; ethio-util.el ends here
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 825a1a7a9dd..25dd649dca4 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -1,6 +1,6 @@
;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/european.el b/lisp/language/european.el
index efcdf9db2c8..1a7b81bd866 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -1,6 +1,6 @@
;;; european.el --- support for European languages -*- coding: utf-8; -*-
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el
index e966cfdb338..5e3883dad1e 100644
--- a/lisp/language/georgian.el
+++ b/lisp/language/georgian.el
@@ -1,6 +1,6 @@
;;; georgian.el --- language support for Georgian
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index 5020fa8b7b2..c9bea3438d0 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -1,6 +1,6 @@
;;; greek.el --- support for Greek
-;; Copyright (C) 2002, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2013-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index ddbd0efcb74..c9501d2ef8f 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -1,6 +1,6 @@
;;; hanja-util.el --- Korean Hanja util module -*- coding: utf-8 -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Jihyun Cho <jihyun.jo@gmail.com>
;; Keywords: multilingual, input method, Korean, Hanja
@@ -6585,7 +6585,9 @@ The value is a hanja character that is selected interactively."
(cmd (lookup-key hanja-keymap seq)))
(if (functionp cmd)
(funcall cmd)
- (setq unread-command-events (listify-key-sequence seq))
+ (setq unread-command-events
+ (nconc (listify-key-sequence seq)
+ unread-command-events))
(throw 'exit-input-loop nil))))))
(setq hanja-conversions nil))))
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 88aa7c70e0d..a3f4b3dd997 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -1,6 +1,6 @@
;;; hebrew.el --- support for Hebrew -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index c8df282e6e9..52bc1733664 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -1,6 +1,6 @@
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Devanagari
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index e4ec284b33c..d5bd054d8a5 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -1,6 +1,6 @@
;;; indian.el --- Indian languages support -*- coding: utf-8; -*-
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index ab419486af9..bdd8853d4dc 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -1,6 +1,6 @@
;;; japan-util.el --- utilities for Japanese -*- coding: iso-2022-7bit; -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -102,7 +102,7 @@ HANKAKU-KATAKANA belongs to `japanese-jisx0201-kana'.")
(?$B!-(B ?') (?$B!.(B ?`) (?$B!0(B ?^) (?$B!2(B ?_) (?$B!<(B ?- ?(I0(B) (?$B!=(B ?-) (?$B!>(B ?-)
(?$B!?(B ?/) (?$B!@(B ?\\) (?$B!A(B ?~) (?$B!C(B ?|) (?$B!F(B ?`) (?$B!G(B ?') (?$B!H(B ?\") (?$B!I(B ?\")
(?\$B!J(B ?\() (?\$B!K(B ?\)) (?\$B!N(B ?[) (?\$B!O(B ?]) (?\$B!P(B ?{) (?\$B!Q(B ?})
- (?$B!R(B ?<) (?$B!S(B ?>) (?\$B!V(B nil ?\(I"(B) (?\$B!W(B nil ?\(I#(B)
+ (?$B!R(B ?<) (?$B!S(B ?>) (?\$B!V(B nil ?\(I"(B) (?\$B!W(B nil ?\(I#(B)
(?$B!\(B ?+) (?$B!](B ?-) (?$B!a(B ?=) (?$B!c(B ?<) (?$B!d(B ?>)
(?$B!l(B ?') (?$B!m(B ?\") (?$B!o(B ?\\) (?$B!p(B ?$) (?$B!s(B ?%) (?$B!t(B ?#) (?$B!u(B ?&) (?$B!v(B ?*)
(?$B!w(B ?@)
@@ -175,9 +175,9 @@ belongs to `japanese-jisx0208', ASCII belongs to `ascii'.")
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
Optional argument HANKAKU t means to convert to `hankaku' Katakana
- \(`japanese-jisx0201-kana'), in which case return value
- may be a string even if OBJ is a character if two Katakanas are
- necessary to represent OBJ."
+\(`japanese-jisx0201-kana'), in which case return value
+may be a string even if OBJ is a character if two Katakanas are
+necessary to represent OBJ."
(if (stringp obj)
(japanese-string-conversion obj 'japanese-katakana-region hankaku)
(or (get-char-code-property obj (if hankaku 'jisx0201 'katakana))
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index 44044032bce..38159d7b458 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -1,6 +1,6 @@
;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
@@ -34,8 +34,8 @@
;;; Code:
;;; Load translation tables for CP932.
-(load "international/cp51932")
-(load "international/eucjp-ms")
+(require 'cp51932)
+(require 'eucjp-ms)
(define-coding-system 'iso-2022-jp
"ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)."
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 1a74926246a..2ed5af47a34 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -1,6 +1,6 @@
;;; korea-util.el --- utilities for Korean
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index ff5a3cbc21e..3bb9aea2d91 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -1,6 +1,6 @@
;;; korean.el --- support for Korean -*- coding: utf-8 -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 8a30ff49264..3bd0394024b 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -1,6 +1,6 @@
;;; lao-util.el --- utilities for Lao -*- coding: utf-8; -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 2f9fd1fc38c..49e24286911 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -1,6 +1,6 @@
;;; lao.el --- support for Lao -*- coding: utf-8 -*-
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
;; 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index ee06e34eef4..c03fd429fe9 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -77,8 +77,10 @@ and Italian.")))
(set-char-table-range
composition-function-table
- '(#x600 . #x6FF)
- (list ["[\u0600-\u06FF]+" 0 font-shape-gstring]))
+ '(#x600 . #x74F)
+ (list (vector "[\u0600-\u074F\u200C\u200D]+" 0 'font-shape-gstring)
+ (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
+ 1 'font-shape-gstring)))
(provide 'misc-lang)
diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el
index 608ff811923..6279885ce66 100644
--- a/lisp/language/romanian.el
+++ b/lisp/language/romanian.el
@@ -1,6 +1,6 @@
;;; romanian.el --- support for Romanian -*- coding: utf-8 -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <done@ece.arizona.edu>
;; Keywords: multilingual, Romanian, i18n
diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el
index a3203067fc8..2b28321e493 100644
--- a/lisp/language/slovak.el
+++ b/lisp/language/slovak.el
@@ -1,6 +1,6 @@
;;; slovak.el --- support for Slovak -*- coding: utf-8 -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>,
;; Milan Zamazal <pdm@zamazal.org>
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index b7a041041f0..dac287ac64b 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -1,6 +1,6 @@
;;; tai-viet.el --- support for Tai Viet -*- coding: utf-8 -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Copyright (C) 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index bb7e4d7d0e8..0cb91510865 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -1,6 +1,6 @@
;;; thai-util.el --- utilities for Thai -*- coding: utf-8; -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 803e9977d47..b63850e3171 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -1,6 +1,6 @@
;;; thai.el --- support for Thai -*- coding: utf-8 -*-
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 422fc697df8..4f59fa1877e 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -1,6 +1,6 @@
;;; tibet-util.el --- utilities for Tibetan -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index f85284702a2..e5a10b9d5aa 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -1,6 +1,6 @@
;;; tibetan.el --- support for Tibetan language -*- coding: utf-8-emacs; -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index 400856d1aa3..ba1ee668825 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -34,7 +34,7 @@
(combining-vowel . "ꪴꪰꪲꪳꪷꪸꪾ")
(combining-tone . "꪿꫁")
(misc . "-"))))
- ;; Set all TaiViet characters to `t'.
+ ;; Set all TaiViet characters to t.
(set-char-table-range table (cons #xaa80 #xaac2) t)
(set-char-table-range table (cons #xaadb #xaadf) t)
;; Overwrite it for special characters.
diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el
index dd8b3f3e5b5..cd8965bfca9 100644
--- a/lisp/language/utf-8-lang.el
+++ b/lisp/language/utf-8-lang.el
@@ -1,6 +1,6 @@
;;; utf-8-lang.el --- generic UTF-8 language environment
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index a4e7ff564e0..f8c11d47891 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -1,6 +1,6 @@
;;; viet-util.el --- utilities for Vietnamese -*- coding: utf-8; -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index 5bc49b07e08..10384a570b1 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -1,6 +1,6 @@
;;; vietnamese.el --- support for Vietnamese -*- coding: utf-8; -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 2c99f2bde2e..e3e620c746b 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -3,7 +3,7 @@
;;; Code:
-;;;### (autoloads nil "5x5" "play/5x5.el" (20709 26818 907104 0))
+;;;### (autoloads nil "5x5" "play/5x5.el" (22026 25907 631502 692000))
;;; Generated autoloads from play/5x5.el
(autoload '5x5 "5x5" "\
@@ -65,8 +65,8 @@ should return a grid vector array that is the new solution.
;;;***
-;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (20874 62962
-;;;;;; 290468 0))
+;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (22011 58553
+;;;;;; 865858 469000))
;;; Generated autoloads from progmodes/ada-mode.el
(autoload 'ada-add-extensions "ada-mode" "\
@@ -85,8 +85,8 @@ Ada mode is the major mode for editing Ada code.
;;;***
-;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from progmodes/ada-stmt.el
(autoload 'ada-header "ada-stmt" "\
@@ -96,8 +96,8 @@ Insert a descriptive header at the top of the file.
;;;***
-;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (22011 58553
+;;;;;; 869858 469000))
;;; Generated autoloads from progmodes/ada-xref.el
(autoload 'ada-find-file "ada-xref" "\
@@ -108,8 +108,8 @@ Completion is available.
;;;***
-;;;### (autoloads nil "add-log" "vc/add-log.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "add-log" "vc/add-log.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from vc/add-log.el
(put 'change-log-default-name 'safe-local-variable 'string-or-null-p)
@@ -147,7 +147,7 @@ Find a change log file for \\[add-change-log-entry] and return the name.
Optional arg FILE-NAME specifies the file to use.
If FILE-NAME is nil, use the value of `change-log-default-name'.
-If `change-log-default-name' is nil, behave as though it were 'ChangeLog'
+If `change-log-default-name' is nil, behave as though it were \"ChangeLog\"
\(or whatever we use on this operating system).
If `change-log-default-name' contains a leading directory component, then
@@ -238,8 +238,8 @@ old-style time formats for entries are supported.
;;;***
-;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (20725 15032
-;;;;;; 264919 0))
+;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (22011 58553
+;;;;;; 345858 469000))
;;; Generated autoloads from emacs-lisp/advice.el
(defvar ad-redefinition-action 'warn "\
@@ -299,8 +299,6 @@ If FUNCTION was not advised already, its advice info will be
initialized. Redefining a piece of advice whose name is part of
the cache-id will clear the cache.
-See Info node `(elisp)Computed Advice' for detailed documentation.
-
\(fn FUNCTION ADVICE CLASS POSITION)" nil nil)
(autoload 'ad-activate "advice" "\
@@ -364,18 +362,19 @@ time. This generates a compiled advised definition according to the current
advice state that will be used during activation if appropriate. Only use
this if the `defadvice' gets actually compiled.
-See Info node `(elisp)Advising Functions' for comprehensive documentation.
usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)
\(fn FUNCTION ARGS &rest BODY)" nil t)
-(put 'defadvice 'doc-string-elt '3)
+(function-put 'defadvice 'doc-string-elt '3)
+
+(function-put 'defadvice 'lisp-indent-function '2)
;;;***
-;;;### (autoloads nil "align" "align.el" (20709 26818 907104 0))
+;;;### (autoloads nil "align" "align.el" (21998 46516 830024 649000))
;;; Generated autoloads from align.el
(autoload 'align "align" "\
@@ -399,15 +398,8 @@ on the format of these lists.
(autoload 'align-regexp "align" "\
Align the current region using an ad-hoc rule read from the minibuffer.
-BEG and END mark the limits of the region. This function will prompt
-for the REGEXP to align with. If no prefix arg was specified, you
-only need to supply the characters to be lined up and any preceding
-whitespace is replaced. If a prefix arg was specified, the full
-regexp with parenthesized whitespace should be supplied; it will also
-prompt for which parenthesis GROUP within REGEXP to modify, the amount
-of SPACING to use, and whether or not to REPEAT the rule throughout
-the line. See `align-rules-list' for more information about these
-options.
+BEG and END mark the limits of the region. Interactively, this function
+prompts for the regular expression REGEXP to align with.
For example, let's say you had a list of phone numbers, and wanted to
align them so that the opening parentheses would line up:
@@ -418,8 +410,29 @@ align them so that the opening parentheses would line up:
Joe (123) 456-7890
There is no predefined rule to handle this, but you could easily do it
-using a REGEXP like \"(\". All you would have to do is to mark the
-region, call `align-regexp' and type in that regular expression.
+using a REGEXP like \"(\". Interactively, all you would have to do is
+to mark the region, call `align-regexp' and enter that regular expression.
+
+REGEXP must contain at least one parenthesized subexpression, typically
+whitespace of the form \"\\\\(\\\\s-*\\\\)\". In normal interactive use,
+this is automatically added to the start of your regular expression after
+you enter it. You only need to supply the characters to be lined up, and
+any preceding whitespace is replaced.
+
+If you specify a prefix argument (or use this function non-interactively),
+you must enter the full regular expression, including the subexpression.
+The function also then prompts for which subexpression parenthesis GROUP
+\(default 1) within REGEXP to modify, the amount of SPACING (default
+`align-default-spacing') to use, and whether or not to REPEAT the rule
+throughout the line.
+
+See `align-rules-list' for more information about these options.
+
+The non-interactive form of the previous example would look something like:
+ (align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\")
+
+This function is a nothing more than a small wrapper that helps you
+construct a rule to pass to `align-region', which does the real work.
\(fn BEG END REGEXP &optional GROUP SPACING REPEAT)" t nil)
@@ -464,9 +477,10 @@ A replacement function for `newline-and-indent', aligning as it goes.
;;;***
-;;;### (autoloads nil "allout" "allout.el" (20932 10282 564846 0))
+;;;### (autoloads nil "allout" "allout.el" (22015 55603 653705 321000))
;;; Generated autoloads from allout.el
-(push (purecopy (quote (allout 2 3))) package--builtin-versions)
+(push (purecopy '(allout 2 3)) package--builtin-versions)
+
(autoload 'allout-auto-activation-helper "allout" "\
Institute `allout-auto-activation'.
@@ -656,7 +670,7 @@ M-x outlineify-sticky Activate outline mode for current buffer,
buffer with name derived from derived from that
of current buffer -- \"*BUFFERNAME exposed*\".
\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
- Like above 'copy-exposed', but convert topic
+ Like above `copy-exposed', but convert topic
prefixes to section.subsection... numeric
format.
\\[customize-variable] allout-auto-activation
@@ -680,7 +694,7 @@ symmetric decryption keys, preventing entry of the correct key on
subsequent decryption attempts until the cache times-out. That
can take several minutes. (Decryption of other entries is not
affected.) Upgrade your EasyPG version, if you can, and you can
-deliberately clear your gpg-agent's cache by sending it a '-HUP'
+deliberately clear your gpg-agent's cache by sending it a `-HUP'
signal.
See `allout-toggle-current-subtree-encryption' function docstring
@@ -823,11 +837,10 @@ for details on preparing Emacs for automatic allout activation.
;;;***
-;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (20932
-;;;;;; 61699 522706 0))
+;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (21998
+;;;;;; 46516 830024 649000))
;;; Generated autoloads from allout-widgets.el
-(push (purecopy (quote (allout-widgets 1 0))) package--builtin-versions)
-(let ((loads (get 'allout-widgets 'custom-loads))) (if (member '"allout-widgets" loads) nil (put 'allout-widgets 'custom-loads (cons '"allout-widgets" loads))))
+(push (purecopy '(allout-widgets 1 0)) package--builtin-versions)
(autoload 'allout-widgets-setup "allout-widgets" "\
Commission or decommission allout-widgets-mode along with allout-mode.
@@ -883,8 +896,8 @@ outline hot-spot navigation (see `allout-mode').
;;;***
-;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (20843 54187 671468
-;;;;;; 0))
+;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (22011 58553 761858
+;;;;;; 469000))
;;; Generated autoloads from net/ange-ftp.el
(defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
@@ -905,8 +918,8 @@ directory, so that Emacs will know its current contents.
;;;***
-;;;### (autoloads nil "animate" "play/animate.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "animate" "play/animate.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from play/animate.el
(autoload 'animate-string "animate" "\
@@ -938,10 +951,11 @@ the buffer *Birthday-Present-for-Name*.
;;;***
-;;;### (autoloads nil "ansi-color" "ansi-color.el" (20930 54950 26050
-;;;;;; 0))
+;;;### (autoloads nil "ansi-color" "ansi-color.el" (21952 37178 110214
+;;;;;; 961000))
;;; Generated autoloads from ansi-color.el
-(push (purecopy (quote (ansi-color 3 4 2))) package--builtin-versions)
+(push (purecopy '(ansi-color 3 4 2)) package--builtin-versions)
+
(autoload 'ansi-color-for-comint-mode-on "ansi-color" "\
Set `ansi-color-for-comint-mode' to t.
@@ -964,10 +978,11 @@ This is a good function to put in `comint-output-filter-functions'.
;;;***
-;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (22011
+;;;;;; 58553 873858 469000))
;;; Generated autoloads from progmodes/antlr-mode.el
-(push (purecopy (quote (antlr-mode 2 2 3))) package--builtin-versions)
+(push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions)
+
(autoload 'antlr-show-makefile-rules "antlr-mode" "\
Show Makefile rules for all grammar files in the current directory.
If the `major-mode' of the current buffer has the value `makefile-mode',
@@ -1000,8 +1015,8 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'.
;;;***
-;;;### (autoloads nil "appt" "calendar/appt.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "appt" "calendar/appt.el" (21998 46516 878024
+;;;;;; 649000))
;;; Generated autoloads from calendar/appt.el
(autoload 'appt-add "appt" "\
@@ -1022,7 +1037,8 @@ ARG is positive, otherwise off.
;;;***
-;;;### (autoloads nil "apropos" "apropos.el" (20716 56 356960 0))
+;;;### (autoloads nil "apropos" "apropos.el" (21998 46516 834024
+;;;;;; 649000))
;;; Generated autoloads from apropos.el
(autoload 'apropos-read-pattern "apropos" "\
@@ -1049,7 +1065,7 @@ variables, not just user options.
(autoload 'apropos-variable "apropos" "\
Show variables that match PATTERN.
-When DO-NOT-ALL is not-nil, show user options only, i.e. behave
+When DO-NOT-ALL is non-nil, show user options only, i.e. behave
like `apropos-user-option'.
\(fn PATTERN &optional DO-NOT-ALL)" t nil)
@@ -1137,8 +1153,8 @@ Returns list of symbols and documentation found.
;;;***
-;;;### (autoloads nil "arc-mode" "arc-mode.el" (20932 10282 564846
-;;;;;; 0))
+;;;### (autoloads nil "arc-mode" "arc-mode.el" (22027 46774 644310
+;;;;;; 591000))
;;; Generated autoloads from arc-mode.el
(autoload 'archive-mode "arc-mode" "\
@@ -1158,7 +1174,7 @@ archive.
;;;***
-;;;### (autoloads nil "array" "array.el" (20709 26818 907104 0))
+;;;### (autoloads nil "array" "array.el" (21670 32330 885624 725000))
;;; Generated autoloads from array.el
(autoload 'array-mode "array" "\
@@ -1229,10 +1245,11 @@ Entering array mode calls the function `array-mode-hook'.
;;;***
-;;;### (autoloads nil "artist" "textmodes/artist.el" (20891 18859
-;;;;;; 893295 0))
+;;;### (autoloads nil "artist" "textmodes/artist.el" (21906 58826
+;;;;;; 78640 200000))
;;; Generated autoloads from textmodes/artist.el
-(push (purecopy (quote (artist 1 2 6))) package--builtin-versions)
+(push (purecopy '(artist 1 2 6)) package--builtin-versions)
+
(autoload 'artist-mode "artist" "\
Toggle Artist mode.
With argument ARG, turn Artist mode on if ARG is positive.
@@ -1311,7 +1328,7 @@ Drawing with the mouse:
* Cut copies, then clears the rectangle/square.
* When drawing lines or poly-lines, you can set arrows.
- See below under ``Arrows'' for more info.
+ See below under \"Arrows\" for more info.
* The mode line shows the currently selected drawing operation.
In addition, if it has an asterisk (*) at the end, you
@@ -1419,8 +1436,8 @@ Variables
artist-vaporize-fuzziness Tolerance when recognizing lines
artist-spray-interval Seconds between repeated sprayings
artist-spray-radius Size of the spray-area
- artist-spray-chars The spray-``color''
- artist-spray-new-chars Initial spray-``color''
+ artist-spray-chars The spray-\"color\"
+ artist-spray-new-chars Initial spray-\"color\"
Hooks
@@ -1435,8 +1452,8 @@ Keymap summary
;;;***
-;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from progmodes/asm-mode.el
(autoload 'asm-mode "asm-mode" "\
@@ -1463,8 +1480,8 @@ Special commands:
;;;***
-;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (20929
-;;;;;; 34089 117790 0))
+;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (22027
+;;;;;; 46774 676310 591000))
;;; Generated autoloads from gnus/auth-source.el
(defvar auth-source-cache-expiry 7200 "\
@@ -1476,8 +1493,8 @@ let-binding.")
;;;***
-;;;### (autoloads nil "autoarg" "autoarg.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "autoarg" "autoarg.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from autoarg.el
(defvar autoarg-mode nil "\
@@ -1537,8 +1554,8 @@ This is similar to `autoarg-mode' but rebinds the keypad keys
;;;***
-;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (20874 62962
-;;;;;; 290468 0))
+;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from progmodes/autoconf.el
(autoload 'autoconf-mode "autoconf" "\
@@ -1548,8 +1565,8 @@ Major mode for editing Autoconf configure.ac files.
;;;***
-;;;### (autoloads nil "autoinsert" "autoinsert.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "autoinsert" "autoinsert.el" (21980 16567 365544
+;;;;;; 893000))
;;; Generated autoloads from autoinsert.el
(autoload 'auto-insert "autoinsert" "\
@@ -1587,14 +1604,16 @@ insert a template for the file depending on the mode of the buffer.
;;;***
-;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (20925
-;;;;;; 37032 237257 0))
+;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (21935
+;;;;;; 28080 450075 956000))
;;; Generated autoloads from emacs-lisp/autoload.el
(put 'generated-autoload-file 'safe-local-variable 'stringp)
(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+(put 'autoload-ensure-writable 'risky-local-variable t)
+
(autoload 'update-file-autoloads "autoload" "\
Update the autoloads for FILE.
If prefix arg SAVE-AFTER is non-nil, save the buffer too.
@@ -1637,8 +1656,8 @@ should be non-nil).
;;;***
-;;;### (autoloads nil "autorevert" "autorevert.el" (20912 25000 802412
-;;;;;; 0))
+;;;### (autoloads nil "autorevert" "autorevert.el" (21980 16567 365544
+;;;;;; 893000))
;;; Generated autoloads from autorevert.el
(autoload 'auto-revert-mode "autorevert" "\
@@ -1661,7 +1680,7 @@ without being changed in the part that is already in the buffer.
Turn on Auto-Revert Mode.
This function is designed to be added to hooks, for example:
- (add-hook 'c-mode-hook 'turn-on-auto-revert-mode)
+ (add-hook \\='c-mode-hook #\\='turn-on-auto-revert-mode)
\(fn)" nil nil)
@@ -1689,7 +1708,7 @@ Use `auto-revert-mode' for changes other than appends!
Turn on Auto-Revert Tail mode.
This function is designed to be added to hooks, for example:
- (add-hook 'my-logfile-mode-hook 'turn-on-auto-revert-tail-mode)
+ (add-hook \\='my-logfile-mode-hook #\\='turn-on-auto-revert-tail-mode)
\(fn)" nil nil)
@@ -1726,7 +1745,7 @@ specifies in the mode line.
;;;***
-;;;### (autoloads nil "avoid" "avoid.el" (20709 26818 907104 0))
+;;;### (autoloads nil "avoid" "avoid.el" (21955 13362 292569 401000))
;;; Generated autoloads from avoid.el
(defvar mouse-avoidance-mode nil "\
@@ -1756,8 +1775,6 @@ Effects of the different modes:
* cat-and-mouse: Same as `animate'.
* proteus: As `animate', but changes the shape of the mouse pointer too.
-Whenever the mouse is moved, the frame is also raised.
-
\(See `mouse-avoidance-threshold' for definition of \"too close\",
and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
definition of \"random distance\".)
@@ -1766,7 +1783,27 @@ definition of \"random distance\".)
;;;***
-;;;### (autoloads nil "battery" "battery.el" (20791 9657 561026 0))
+;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (21670 32331
+;;;;;; 385639 720000))
+;;; Generated autoloads from progmodes/bat-mode.el
+
+(add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode))
+
+(autoload 'bat-mode "bat-mode" "\
+Major mode for editing DOS/Windows batch files.
+
+Start a new script from `bat-template'. Read help pages for DOS commands
+with `bat-cmd-help'. Navigate between sections using `imenu'.
+Run script using `bat-run' and `bat-run-args'.
+
+\\{bat-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "battery" "battery.el" (22026 25907 487502
+;;;;;; 692000))
;;; Generated autoloads from battery.el
(put 'battery-mode-line-string 'risky-local-variable t)
@@ -1801,8 +1838,8 @@ seconds.
;;;***
-;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from emacs-lisp/benchmark.el
(autoload 'benchmark-run "benchmark" "\
@@ -1816,7 +1853,7 @@ See also `benchmark-run-compiled'.
\(fn &optional REPETITIONS &rest FORMS)" nil t)
-(put 'benchmark-run 'lisp-indent-function '1)
+(function-put 'benchmark-run 'lisp-indent-function '1)
(autoload 'benchmark-run-compiled "benchmark" "\
Time execution of compiled version of FORMS.
@@ -1826,7 +1863,7 @@ result. The overhead of the `lambda's is accounted for.
\(fn &optional REPETITIONS &rest FORMS)" nil t)
-(put 'benchmark-run-compiled 'lisp-indent-function '1)
+(function-put 'benchmark-run-compiled 'lisp-indent-function '1)
(autoload 'benchmark "benchmark" "\
Print the time taken for REPETITIONS executions of FORM.
@@ -1838,8 +1875,8 @@ For non-interactive use see also `benchmark-run' and
;;;***
-;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (20937 28198
-;;;;;; 475168 0))
+;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (22011 58554
+;;;;;; 41858 469000))
;;; Generated autoloads from textmodes/bibtex.el
(autoload 'bibtex-initialize "bibtex" "\
@@ -1931,7 +1968,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'.
;;;***
;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el"
-;;;;;; (20709 26818 907104 0))
+;;;;;; (21670 32331 885635 586000))
;;; Generated autoloads from textmodes/bibtex-style.el
(autoload 'bibtex-style-mode "bibtex-style" "\
@@ -1941,8 +1978,8 @@ Major mode for editing BibTeX style files.
;;;***
-;;;### (autoloads nil "binhex" "mail/binhex.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "binhex" "mail/binhex.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from mail/binhex.el
(defconst binhex-begin-line "^:...............................................................$" "\
@@ -1966,8 +2003,8 @@ Binhex decode region between START and END.
;;;***
-;;;### (autoloads nil "blackbox" "play/blackbox.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "blackbox" "play/blackbox.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from play/blackbox.el
(autoload 'blackbox "blackbox" "\
@@ -2086,8 +2123,8 @@ a reflection.
;;;***
-;;;### (autoloads nil "bookmark" "bookmark.el" (20874 65006 176325
-;;;;;; 548000))
+;;;### (autoloads nil "bookmark" "bookmark.el" (22011 58553 109858
+;;;;;; 469000))
;;; Generated autoloads from bookmark.el
(define-key ctl-x-r-map "b" 'bookmark-jump)
(define-key ctl-x-r-map "m" 'bookmark-set)
@@ -2213,10 +2250,11 @@ probably because we were called from there.
(autoload 'bookmark-write "bookmark" "\
Write bookmarks to a file (reading the file name with the minibuffer).
-Don't use this in Lisp programs; use `bookmark-save' instead.
\(fn)" t nil)
+(function-put 'bookmark-write 'interactive-only 'bookmark-save)
+
(autoload 'bookmark-save "bookmark" "\
Save currently defined bookmarks.
Saves by default in the file defined by the variable
@@ -2252,8 +2290,7 @@ explicitly.
If you load a file containing bookmarks with the same names as
bookmarks already present in your Emacs, the new bookmarks will get
-unique numeric suffixes \"<2>\", \"<3>\", ... following the same
-method buffers use to resolve name collisions.
+unique numeric suffixes \"<2>\", \"<3>\", etc.
\(fn FILE &optional OVERWRITE NO-MSG)" t nil)
@@ -2280,8 +2317,8 @@ Incremental search of bookmarks, hiding the non-matches as we go.
;;;***
-;;;### (autoloads nil "browse-url" "net/browse-url.el" (20929 34089
-;;;;;; 117790 0))
+;;;### (autoloads nil "browse-url" "net/browse-url.el" (21993 28596
+;;;;;; 198597 473000))
;;; Generated autoloads from net/browse-url.el
(defvar browse-url-browser-function 'browse-url-default-browser "\
@@ -2326,26 +2363,29 @@ Ask a WWW browser to display the current region.
(autoload 'browse-url "browse-url" "\
Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point. Variable
-`browse-url-browser-function' says which browser to use.
+Prompt for a URL, defaulting to the URL at or before point.
+The variable `browse-url-browser-function' says which browser to use.
If the URL is a mailto: URL, consult `browse-url-mailto-function'
first, if that exists.
+Passes any ARGS to the browser function.
+The default is to pass `browse-url-new-window-flag'.
+
\(fn URL &rest ARGS)" t nil)
(autoload 'browse-url-at-point "browse-url" "\
Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use.
+Variable `browse-url-browser-function' says which browser to use.
+Optional prefix argument ARG non-nil inverts the value of the option
+`browse-url-new-window-flag'.
\(fn &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
-but point is not changed. Doesn't let you edit the URL like
-`browse-url'. Variable `browse-url-browser-function' says which browser
-to use.
+but point is not changed. Variable `browse-url-browser-function'
+says which browser to use.
\(fn EVENT)" t nil)
@@ -2375,6 +2415,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-netscape 'nil '"25.1")
+
(autoload 'browse-url-mozilla "browse-url" "\
Ask the Mozilla WWW browser to load URL.
Default to the URL around or before point. The strings in variable
@@ -2396,29 +2438,19 @@ used instead of `browse-url-new-window-flag'.
(autoload 'browse-url-firefox "browse-url" "\
Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point. The strings in
-variable `browse-url-firefox-arguments' are also passed to
-Firefox.
+Defaults to the URL around or before point. Passes the strings
+in the variable `browse-url-firefox-arguments' to Firefox.
-When called interactively, if variable
-`browse-url-new-window-flag' is non-nil, load the document in a
-new Firefox window, otherwise use a random existing one. A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new Firefox window. A non-nil prefix argument
+reverses the effect of `browse-url-new-window-flag'.
If `browse-url-firefox-new-window-is-tab' is non-nil, then
whenever a document would otherwise be loaded in a new window, it
is loaded in a new tab in an existing window instead.
-When called non-interactively, optional second argument
-NEW-WINDOW is used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is
-ignored. Firefox for Windows does not support the \"-remote\"
-command line parameter. Therefore, the
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the requested
-URL in a new window.
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
@@ -2449,6 +2481,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-galeon 'nil '"25.1")
+
(autoload 'browse-url-emacs "browse-url" "\
Ask Emacs to load URL into a buffer and show it in another window.
@@ -2469,6 +2503,8 @@ used instead of `browse-url-new-window-flag'.
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-gnome-moz 'nil '"25.1")
+
(autoload 'browse-url-mosaic "browse-url" "\
Ask the XMosaic WWW browser to load URL.
@@ -2487,6 +2523,8 @@ 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.
@@ -2505,6 +2543,28 @@ 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
+in the variable `browse-url-conkeror-arguments' to Conkeror.
+
+When called interactively, if variable
+`browse-url-new-window-flag' is non-nil, load the document in a
+new Conkeror window, otherwise use a random existing one. A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-flag'.
+
+If variable `browse-url-conkeror-new-window-is-buffer' is
+non-nil, then whenever a document would otherwise be loaded in a
+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'.
+
+\(fn URL &optional NEW-WINDOW)" t nil)
+
(autoload 'browse-url-w3 "browse-url" "\
Ask the w3 WWW browser to load URL.
Default to the URL around or before point.
@@ -2525,6 +2585,8 @@ The `browse-url-gnudoit-program' program is used with options given by
\(fn URL &optional NEW-WINDOW)" t nil)
+(make-obsolete 'browse-url-w3-gnudoit 'nil '"25.1")
+
(autoload 'browse-url-text-xterm "browse-url" "\
Ask a text browser to load URL.
URL defaults to the URL around or before point.
@@ -2596,9 +2658,10 @@ from `browse-url-elinks-wrapper'.
;;;***
-;;;### (autoloads nil "bs" "bs.el" (20933 31141 450159 0))
+;;;### (autoloads nil "bs" "bs.el" (21998 46516 834024 649000))
;;; Generated autoloads from bs.el
-(push (purecopy (quote (bs 1 17))) package--builtin-versions)
+(push (purecopy '(bs 1 17)) package--builtin-versions)
+
(autoload 'bs-cycle-next "bs" "\
Select next buffer defined by buffer cycling.
The buffers taking part in buffer cycling are defined
@@ -2636,8 +2699,8 @@ name of buffer configuration.
;;;***
-;;;### (autoloads nil "bubbles" "play/bubbles.el" (20791 9657 561026
-;;;;;; 0))
+;;;### (autoloads nil "bubbles" "play/bubbles.el" (22026 25907 631502
+;;;;;; 692000))
;;; Generated autoloads from play/bubbles.el
(autoload 'bubbles "bubbles" "\
@@ -2659,7 +2722,7 @@ columns on its right towards the left.
;;;***
;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el"
-;;;;;; (20709 26818 907104 0))
+;;;;;; (21980 16567 993544 893000))
;;; Generated autoloads from progmodes/bug-reference.el
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
@@ -2679,8 +2742,8 @@ Like `bug-reference-mode', but only buttonize in comments and strings.
;;;***
-;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (20929
-;;;;;; 34089 117790 0))
+;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (22011
+;;;;;; 58553 361858 469000))
;;; Generated autoloads from emacs-lisp/bytecomp.el
(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
@@ -2699,7 +2762,7 @@ else the global value will be modified.
(autoload 'byte-compile-enable-warning "bytecomp" "\
Change `byte-compile-warnings' to enable WARNING.
-If `byte-compile-warnings' is `t', do nothing. Otherwise, if the
+If `byte-compile-warnings' is t, do nothing. Otherwise, if the
first element is `not', remove WARNING, else add it.
Normally you should let-bind `byte-compile-warnings' before calling this,
else the global value will be modified.
@@ -2760,8 +2823,8 @@ whose definitions have been compiled in this Emacs session, as well as
all functions called by those functions.
The call graph does not include macros, inline functions, or
-primitives that the byte-code interpreter knows about directly (eq,
-cons, etc.).
+primitives that the byte-code interpreter knows about directly
+\(`eq', `cons', etc.).
The call tree also lists those functions which are not known to be called
\(that is, to which no calls have been compiled), and which cannot be
@@ -2800,8 +2863,8 @@ and corresponding effects.
;;;***
-;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from calendar/cal-china.el
(put 'calendar-chinese-time-zone 'risky-local-variable t)
@@ -2810,8 +2873,8 @@ and corresponding effects.
;;;***
-;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (21990 52406
+;;;;;; 468500 385000))
;;; Generated autoloads from calendar/cal-dst.el
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
@@ -2822,8 +2885,8 @@ and corresponding effects.
;;;***
-;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (21993
+;;;;;; 28595 970597 473000))
;;; Generated autoloads from calendar/cal-hebrew.el
(autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\
@@ -2833,11 +2896,9 @@ from the cursor position.
\(fn DEATH-DATE START-YEAR END-YEAR)" t nil)
-(define-obsolete-function-alias 'list-yahrzeit-dates 'calendar-hebrew-list-yahrzeits "23.1")
-
;;;***
-;;;### (autoloads nil "calc" "calc/calc.el" (20932 10282 564846 0))
+;;;### (autoloads nil "calc" "calc/calc.el" (22026 25907 527502 692000))
;;; Generated autoloads from calc/calc.el
(define-key ctl-x-map "*" 'calc-dispatch)
@@ -2858,8 +2919,10 @@ Invoke the Calculator and give it a full-sized window.
(autoload 'quick-calc "calc" "\
Do a quick calculation in the minibuffer without invoking full Calculator.
+With prefix argument INSERT, insert the result in the current
+buffer. Otherwise, the result is copied into the kill ring.
-\(fn)" t nil)
+\(fn &optional INSERT)" t nil)
(autoload 'calc-eval "calc" "\
Do a quick calculation and return the result as a string.
@@ -2917,12 +2980,12 @@ See Info node `(calc)Defining Functions'.
\(fn FUNC ARGS &rest BODY)" nil t)
-(put 'defmath 'doc-string-elt '3)
+(function-put 'defmath 'doc-string-elt '3)
;;;***
-;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from calc/calc-undo.el
(autoload 'calc-undo "calc-undo" "\
@@ -2932,8 +2995,8 @@ See Info node `(calc)Defining Functions'.
;;;***
-;;;### (autoloads nil "calculator" "calculator.el" (20891 18859 893295
-;;;;;; 0))
+;;;### (autoloads nil "calculator" "calculator.el" (21993 28595 966597
+;;;;;; 473000))
;;; Generated autoloads from calculator.el
(autoload 'calculator "calculator" "\
@@ -2944,8 +3007,8 @@ See the documentation for `calculator-mode' for more information.
;;;***
-;;;### (autoloads nil "calendar" "calendar/calendar.el" (20762 9398
-;;;;;; 526093 0))
+;;;### (autoloads nil "calendar" "calendar/calendar.el" (22026 25907
+;;;;;; 535502 692000))
;;; Generated autoloads from calendar/calendar.el
(autoload 'calendar "calendar" "\
@@ -2988,8 +3051,8 @@ This function is suitable for execution in an init file.
;;;***
-;;;### (autoloads nil "canlock" "gnus/canlock.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "canlock" "gnus/canlock.el" (21852 24381 567240
+;;;;;; 49000))
;;; Generated autoloads from gnus/canlock.el
(autoload 'canlock-insert-header "canlock" "\
@@ -3006,55 +3069,8 @@ it fails.
;;;***
-;;;### (autoloads nil "cap-words" "progmodes/cap-words.el" (20709
-;;;;;; 26818 907104 0))
-;;; Generated autoloads from progmodes/cap-words.el
-
-(autoload 'capitalized-words-mode "cap-words" "\
-Toggle Capitalized Words mode.
-With a prefix argument ARG, enable Capitalized Words mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
-
-Capitalized Words mode is a buffer-local minor mode. When
-enabled, a word boundary occurs immediately before an uppercase
-letter in a symbol. This is in addition to all the normal
-boundaries given by the syntax and category tables. There is no
-restriction to ASCII.
-
-E.g. the beginning of words in the following identifier are as marked:
-
- capitalizedWorDD
- ^ ^ ^^
-
-Note that these word boundaries only apply for word motion and
-marking commands such as \\[forward-word]. This mode does not affect word
-boundaries found by regexp matching (`\\>', `\\w' &c).
-
-This style of identifiers is common in environments like Java ones,
-where underscores aren't trendy enough. Capitalization rules are
-sometimes part of the language, e.g. Haskell, which may thus encourage
-such a style. It is appropriate to add `capitalized-words-mode' to
-the mode hook for programming language modes in which you encounter
-variables like this, e.g. `java-mode-hook'. It's unlikely to cause
-trouble if such identifiers aren't used.
-
-See also `glasses-mode' and `studlify-word'.
-Obsoletes `c-forward-into-nomenclature'.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20709
-;;;;;; 26818 907104 0))
-;;; Generated autoloads from progmodes/cc-compat.el
-(put 'c-indent-level 'safe-local-variable 'integerp)
-
-;;;***
-
-;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (20911
-;;;;;; 4138 279475 0))
+;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (22011
+;;;;;; 58553 881858 469000))
;;; Generated autoloads from progmodes/cc-engine.el
(autoload 'c-guess-basic-syntax "cc-engine" "\
@@ -3064,8 +3080,8 @@ Return the syntactic context of the current line.
;;;***
-;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (21976 19510
+;;;;;; 84430 241000))
;;; Generated autoloads from progmodes/cc-guess.el
(defvar c-guess-guessed-offsets-alist nil "\
@@ -3163,8 +3179,8 @@ the absolute file name of the file if STYLE-NAME is nil.
;;;***
-;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (20907 7082
-;;;;;; 901087 0))
+;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (22021 7991
+;;;;;; 65719 83000))
;;; Generated autoloads from progmodes/cc-mode.el
(autoload 'c-initialize-cc-mode "cc-mode" "\
@@ -3176,9 +3192,6 @@ only some basic setup is done, and a call to `c-init-language-vars' or
control). See \"cc-mode.el\" for more info.
\(fn &optional NEW-STYLE-INIT)" nil nil)
-
-(defvar c-mode-syntax-table nil "\
-Syntax table used in c-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.\\(cc\\|hh\\)\\'" . c++-mode))
(add-to-list 'auto-mode-alist '("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode))
(add-to-list 'auto-mode-alist '("\\.\\(CC?\\|HH?\\)\\'" . c++-mode))
@@ -3189,7 +3202,8 @@ Syntax table used in c-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.ii\\'" . c++-mode))
(autoload 'c-mode "cc-mode" "\
-Major mode for editing K&R and ANSI C code.
+Major mode for editing C code.
+
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c-mode buffer. This automatically sets up a mail buffer with version
information already added. You just need to add a description of the
@@ -3205,9 +3219,6 @@ Key bindings:
\(fn)" t nil)
-(defvar c++-mode-syntax-table nil "\
-Syntax table used in c++-mode buffers.")
-
(autoload 'c++-mode "cc-mode" "\
Major mode for editing C++ code.
To submit a problem report, enter `\\[c-submit-bug-report]' from a
@@ -3225,9 +3236,6 @@ Key bindings:
\\{c++-mode-map}
\(fn)" t nil)
-
-(defvar objc-mode-syntax-table nil "\
-Syntax table used in objc-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.m\\'" . objc-mode))
(autoload 'objc-mode "cc-mode" "\
@@ -3247,9 +3255,6 @@ Key bindings:
\\{objc-mode-map}
\(fn)" t nil)
-
-(defvar java-mode-syntax-table nil "\
-Syntax table used in java-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.java\\'" . java-mode))
(autoload 'java-mode "cc-mode" "\
@@ -3269,9 +3274,6 @@ Key bindings:
\\{java-mode-map}
\(fn)" t nil)
-
-(defvar idl-mode-syntax-table nil "\
-Syntax table used in idl-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.idl\\'" . idl-mode))
(autoload 'idl-mode "cc-mode" "\
@@ -3291,9 +3293,6 @@ Key bindings:
\\{idl-mode-map}
\(fn)" t nil)
-
-(defvar pike-mode-syntax-table nil "\
-Syntax table used in pike-mode buffers.")
(add-to-list 'auto-mode-alist '("\\.\\(u?lpc\\|pike\\|pmod\\(\\.in\\)?\\)\\'" . pike-mode))
(add-to-list 'interpreter-mode-alist '("pike" . pike-mode))
@@ -3319,7 +3318,6 @@ Key bindings:
(add-to-list 'interpreter-mode-alist '("mawk" . awk-mode))
(add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
(add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
- (autoload 'awk-mode "cc-mode" "Major mode for editing AWK code." t)
(autoload 'awk-mode "cc-mode" "\
Major mode for editing AWK code.
@@ -3340,8 +3338,8 @@ Key bindings:
;;;***
-;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (21976
+;;;;;; 19510 104430 241000))
;;; Generated autoloads from progmodes/cc-styles.el
(autoload 'c-set-style "cc-styles" "\
@@ -3392,8 +3390,8 @@ and exists only for compatibility reasons.
;;;***
-;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20907 7082
-;;;;;; 901087 0))
+;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (22011 58553
+;;;;;; 885858 469000))
;;; Generated autoloads from progmodes/cc-vars.el
(put 'c-basic-offset 'safe-local-variable 'integerp)
(put 'c-backslash-column 'safe-local-variable 'integerp)
@@ -3401,8 +3399,8 @@ and exists only for compatibility reasons.
;;;***
-;;;### (autoloads nil "ccl" "international/ccl.el" (20884 7264 412929
-;;;;;; 442000))
+;;;### (autoloads nil "ccl" "international/ccl.el" (21998 46517 74024
+;;;;;; 649000))
;;; Generated autoloads from international/ccl.el
(autoload 'ccl-compile "ccl" "\
@@ -3478,6 +3476,14 @@ IF := (if EXPRESSION CCL_BLOCK_0 CCL_BLOCK_1)
BRANCH := (branch EXPRESSION CCL_BLOCK_0 [CCL_BLOCK_1 ...])
;; Execute STATEMENTs until (break) or (end) is executed.
+
+;; Create a block of STATEMENTs for repeating. The STATEMENTs
+;; are executed sequentially until REPEAT or BREAK is executed.
+;; If REPEAT statement is executed, STATEMENTs are executed from the
+;; start again. If BREAK statements is executed, the execution
+;; exits from the block. If neither REPEAT nor BREAK is
+;; executed, the execution exits from the block after executing the
+;; last STATEMENT.
LOOP := (loop STATEMENT [STATEMENT ...])
;; Terminate the most inner loop.
@@ -3624,24 +3630,49 @@ ARRAY := `[' integer ... `]'
TRANSLATE :=
- (translate-character REG(table) REG(charset) REG(codepoint))
- | (translate-character SYMBOL REG(charset) REG(codepoint))
- ;; SYMBOL must refer to a table defined by `define-translation-table'.
+ ;; Decode character SRC, translate it by translate table
+ ;; TABLE, and encode it back to DST. TABLE is specified
+ ;; by its id number in REG_0, SRC is specified by its
+ ;; charset id number and codepoint in REG_1 and REG_2
+ ;; respectively.
+ ;; On encoding, the charset of highest priority is selected.
+ ;; After the execution, DST is specified by its charset
+ ;; id number and codepoint in REG_1 and REG_2 respectively.
+ (translate-character REG_0 REG_1 REG_2)
+
+ ;; Same as above except for SYMBOL specifying the name of
+ ;; the translate table defined by `define-translation-table'.
+ | (translate-character SYMBOL REG_1 REG_2)
+
LOOKUP :=
- (lookup-character SYMBOL REG(charset) REG(codepoint))
+ ;; Look up character SRC in hash table TABLE. TABLE is
+ ;; specified by its name in SYMBOL, and SRC is specified by
+ ;; its charset id number and codepoint in REG_1 and REG_2
+ ;; respectively.
+ ;; If its associated value is an integer, set REG_1 to that
+ ;; value, and set r7 to 1. Otherwise, set r7 to 0.
+ (lookup-character SYMBOL REG_1 REG_2)
+
+ ;; Look up integer value N in hash table TABLE. TABLE is
+ ;; specified by its name in SYMBOL and N is specified in
+ ;; REG.
+ ;; If its associated value is a character, set REG to that
+ ;; value, and set r7 to 1. Otherwise, set r7 to 0.
| (lookup-integer SYMBOL REG(integer))
- ;; SYMBOL refers to a table defined by `define-translation-hash-table'.
+
MAP :=
- (iterate-multiple-map REG REG MAP-IDs)
- | (map-multiple REG REG (MAP-SET))
- | (map-single REG REG MAP-ID)
+ ;; The following statements are for internal use only.
+ (iterate-multiple-map REG REG MAP-IDs)
+ | (map-multiple REG REG (MAP-SET))
+ | (map-single REG REG MAP-ID)
+
MAP-IDs := MAP-ID ...
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
\(fn NAME CCL-PROGRAM &optional DOC)" nil t)
-(put 'define-ccl-program 'doc-string-elt '3)
+(function-put 'define-ccl-program 'doc-string-elt '3)
(autoload 'check-ccl-program "ccl" "\
Check validity of CCL-PROGRAM.
@@ -3662,8 +3693,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program.
;;;***
-;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (20922 60838
-;;;;;; 997229 0))
+;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (22026 25907
+;;;;;; 559502 692000))
;;; Generated autoloads from emacs-lisp/cconv.el
(autoload 'cconv-closure-convert "cconv" "\
@@ -3682,16 +3713,18 @@ Add the warnings that closure conversion would encounter.
;;;***
-;;;### (autoloads nil "cedet" "cedet/cedet.el" (20748 62911 684442
-;;;;;; 0))
+;;;### (autoloads nil "cedet" "cedet/cedet.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from cedet/cedet.el
-(push (purecopy (quote (cedet 2 0))) package--builtin-versions)
+(push (purecopy '(cedet 2 0)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (20929 34089
-;;;;;; 117790 0))
+;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (22011 58553
+;;;;;; 889858 469000))
;;; Generated autoloads from progmodes/cfengine.el
-(push (purecopy (quote (cfengine 1 2))) package--builtin-versions)
+(push (purecopy '(cfengine 1 4)) package--builtin-versions)
+
(autoload 'cfengine3-mode "cfengine" "\
Major mode for editing CFEngine3 input.
There are no special keybindings by default.
@@ -3711,21 +3744,45 @@ to the action header.
\(fn)" t nil)
(autoload 'cfengine-auto-mode "cfengine" "\
-Choose between `cfengine2-mode' and `cfengine3-mode' depending
-on the buffer contents
+Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents.
-\(fn)" nil nil)
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "character-fold" "character-fold.el" (21973
+;;;;;; 43315 242113 285000))
+;;; Generated autoloads from character-fold.el
+
+(defvar character-fold-search nil "\
+Non-nil if searches should fold similar characters.
+This means some characters will match entire groups of characters.
+For instance, \" will match all variants of double quotes, and
+the letter a will match all of its accented versions (and then
+some).")
+
+(autoload 'character-fold-to-regexp "character-fold" "\
+Return a regexp matching anything that character-folds into STRING.
+If `character-fold-search' is nil, `regexp-quote' string.
+Otherwise, any character in STRING that has an entry in
+`character-fold-table' is replaced with that entry (which is a
+regexp) and other characters are `regexp-quote'd.
+If LAX is non-nil, any single whitespace character is allowed to
+match any number of times.
+
+\(fn STRING &optional LAX)" nil nil)
;;;***
-;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (20895 15912
-;;;;;; 444844 0))
+;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (21998 46516
+;;;;;; 978024 649000))
;;; Generated autoloads from emacs-lisp/chart.el
-(push (purecopy (quote (chart 0 2))) package--builtin-versions)
+(push (purecopy '(chart 0 2)) package--builtin-versions)
+
;;;***
;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el"
-;;;;;; (20709 26818 907104 0))
+;;;;;; (22011 58553 361858 469000))
;;; Generated autoloads from emacs-lisp/check-declare.el
(autoload 'check-declare-file "check-declare" "\
@@ -3742,19 +3799,25 @@ Returns non-nil if any false statements are found.
;;;***
-;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (20893
-;;;;;; 60586 188550 0))
+;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (22002
+;;;;;; 43570 516887 749000))
;;; Generated autoloads from emacs-lisp/checkdoc.el
-(push (purecopy (quote (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)
-(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp)
-(put 'checkdoc-symbol-words 'safe-local-variable 'checkdoc-list-of-strings-p)
+(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)
+(put 'checkdoc-spellcheck-documentation-flag 'safe-local-variable #'booleanp)
+(put 'checkdoc-ispell-list-words 'safe-local-variable #'checkdoc-list-of-strings-p)
+(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
+(put 'checkdoc-verb-check-experimental-flag 'safe-local-variable #'booleanp)
+(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p)
(autoload 'checkdoc-list-of-strings-p "checkdoc" "\
-
+Return t when OBJ is a list of strings.
\(fn OBJ)" nil nil)
+(put 'checkdoc-proper-noun-regexp 'safe-local-variable 'stringp)
+(put 'checkdoc-common-verbs-regexp 'safe-local-variable 'stringp)
(autoload 'checkdoc "checkdoc" "\
Interactively check the entire buffer for style errors.
@@ -3801,6 +3864,11 @@ otherwise stop after the first error.
\(fn &optional TAKE-NOTES)" t nil)
+(autoload 'checkdoc-file "checkdoc" "\
+Check FILE for document, comment, error style, and rogue spaces.
+
+\(fn FILE)" nil nil)
+
(autoload 'checkdoc-start "checkdoc" "\
Start scanning the current buffer for documentation string style errors.
Only documentation strings are checked.
@@ -3861,65 +3929,65 @@ space at the end of each line.
(autoload 'checkdoc-ispell "checkdoc" "\
Check the style and spelling of everything interactively.
Calls `checkdoc' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc'
+Prefix argument is the same as for `checkdoc'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-current-buffer "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-current-buffer' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'
+Prefix argument is the same as for `checkdoc-current-buffer'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-interactive "checkdoc" "\
Check the style and spelling of the current buffer interactively.
Calls `checkdoc-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'
+Prefix argument is the same as for `checkdoc-interactive'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-message-interactive "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-interactive' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'
+Prefix argument is the same as for `checkdoc-message-interactive'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-message-text "checkdoc" "\
Check the style and spelling of message text interactively.
Calls `checkdoc-message-text' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'
+Prefix argument is the same as for `checkdoc-message-text'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-start "checkdoc" "\
Check the style and spelling of the current buffer.
Calls `checkdoc-start' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-start'
+Prefix argument is the same as for `checkdoc-start'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-continue "checkdoc" "\
Check the style and spelling of the current buffer after point.
Calls `checkdoc-continue' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'
+Prefix argument is the same as for `checkdoc-continue'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-comments "checkdoc" "\
Check the style and spelling of the current buffer's comments.
Calls `checkdoc-comments' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'
+Prefix argument is the same as for `checkdoc-comments'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-ispell-defun "checkdoc" "\
Check the style and spelling of the current defun with Ispell.
Calls `checkdoc-defun' with spell-checking turned on.
-Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'
+Prefix argument is the same as for `checkdoc-defun'
-\(fn &optional TAKE-NOTES)" t nil)
+\(fn)" t nil)
(autoload 'checkdoc-minor-mode "checkdoc" "\
Toggle automatic docstring checking (Checkdoc minor mode).
@@ -3935,10 +4003,15 @@ checking of documentation strings.
\(fn &optional ARG)" t nil)
+(autoload 'checkdoc-package-keywords "checkdoc" "\
+Find package keywords that aren't in `finder-known-keywords'.
+
+\(fn)" t nil)
+
;;;***
-;;;### (autoloads nil "china-util" "language/china-util.el" (20799
-;;;;;; 169 640767 0))
+;;;### (autoloads nil "china-util" "language/china-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/china-util.el
(autoload 'decode-hz-region "china-util" "\
@@ -3975,8 +4048,8 @@ Encode the text in the current buffer to HZ.
;;;***
-;;;### (autoloads nil "chistory" "chistory.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "chistory" "chistory.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from chistory.el
(autoload 'repeat-matching-complex-command "chistory" "\
@@ -4015,8 +4088,8 @@ and runs the normal hook `command-history-hook'.
;;;***
-;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (20879
-;;;;;; 27694 495748 0))
+;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21901
+;;;;;; 9907 369083 895000))
;;; Generated autoloads from emacs-lisp/cl-indent.el
(autoload 'common-lisp-indent-function "cl-indent" "\
@@ -4090,14 +4163,20 @@ For example, the function `case' has an indent property
of them. The first list element has an offset of 2, all the rest
have an offset of 2+1=3.
+If the current mode is actually `emacs-lisp-mode', look for a
+`common-lisp-indent-function-for-elisp' property before looking
+at `common-lisp-indent-function' and, if set, use its value
+instead.
+
\(fn INDENT-POINT STATE)" nil nil)
;;;***
-;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20932 10282
-;;;;;; 564846 0))
+;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21903 51634
+;;;;;; 278370 580000))
;;; Generated autoloads from emacs-lisp/cl-lib.el
-(push (purecopy (quote (cl-lib 1 0))) package--builtin-versions)
+(push (purecopy '(cl-lib 1 0)) package--builtin-versions)
+
(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3")
(defvar cl-custom-print-functions nil "\
@@ -4110,20 +4189,10 @@ printer proceeds to the next function on the list.
This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.")
-(autoload 'cl--defsubst-expand "cl-macs")
-
-(put 'cl-defun 'doc-string-elt 3)
-
-(put 'cl-defmacro 'doc-string-elt 3)
-
-(put 'cl-defsubst 'doc-string-elt 3)
-
-(put 'cl-defstruct 'doc-string-elt 2)
-
;;;***
-;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (22026 25907
+;;;;;; 631502 692000))
;;; Generated autoloads from progmodes/cmacexp.el
(autoload 'c-macro-expand "cmacexp" "\
@@ -4143,8 +4212,8 @@ For use inside Lisp programs, see also `c-macro-expansion'.
;;;***
-;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (20932 61699 522706
-;;;;;; 0))
+;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (22011 58553 281858
+;;;;;; 469000))
;;; Generated autoloads from cmuscheme.el
(autoload 'run-scheme "cmuscheme" "\
@@ -4164,7 +4233,7 @@ is run).
;;;***
-;;;### (autoloads nil "color" "color.el" (20721 17977 14204 0))
+;;;### (autoloads nil "color" "color.el" (22026 25907 555502 692000))
;;; Generated autoloads from color.el
(autoload 'color-name-to-rgb "color" "\
@@ -4183,7 +4252,7 @@ If FRAME cannot display COLOR, return nil.
;;;***
-;;;### (autoloads nil "comint" "comint.el" (20932 10282 564846 0))
+;;;### (autoloads nil "comint" "comint.el" (22011 58553 293858 469000))
;;; Generated autoloads from comint.el
(defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\
@@ -4245,6 +4314,8 @@ See `make-comint' and `comint-exec'.
\(fn PROGRAM)" t nil)
+(function-put 'comint-run 'interactive-only 'make-comint)
+
(defvar comint-file-name-prefix (purecopy "") "\
Prefix prepended to absolute file names taken from process input.
This is used by Comint's and shell's completion functions, and by shell's
@@ -4282,12 +4353,15 @@ REGEXP-GROUP is the regular expression group in REGEXP to use.
;;;***
-;;;### (autoloads nil "compare-w" "vc/compare-w.el" (20871 33574
-;;;;;; 214287 0))
+;;;### (autoloads nil "compare-w" "vc/compare-w.el" (21872 61770
+;;;;;; 310089 300000))
;;; Generated autoloads from vc/compare-w.el
(autoload 'compare-windows "compare-w" "\
-Compare text in current window with text in next window.
+Compare text in current window with text in another window.
+The option `compare-windows-get-window-function' defines how
+to get another window.
+
Compares the text starting at point in each window,
moving over text in each one as far as they match.
@@ -4316,8 +4390,8 @@ on third call it again advances points to the next difference and so on.
;;;***
-;;;### (autoloads nil "compile" "progmodes/compile.el" (20911 4138
-;;;;;; 279475 0))
+;;;### (autoloads nil "compile" "progmodes/compile.el" (22015 55603
+;;;;;; 789705 321000))
;;; Generated autoloads from progmodes/compile.el
(defvar compilation-mode-hook nil "\
@@ -4379,13 +4453,15 @@ Last shell command used to do a compilation; default for next compilation.
Sometimes it is useful for files to supply local values for this variable.
You might also use mode hooks to specify it in certain modes, like this:
- (add-hook 'c-mode-hook
+ (add-hook \\='c-mode-hook
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (set (make-local-variable 'compile-command)
+ (set (make-local-variable \\='compile-command)
(concat \"make -k \"
- (file-name-sans-extension buffer-file-name))))))")
+ (if buffer-file-name
+ (shell-quote-argument
+ (file-name-sans-extension buffer-file-name))))))))")
(custom-autoload 'compile-command "compile" t)
(put 'compile-command 'safe-local-variable (lambda (a) (and (stringp a) (or (not (boundp 'compilation-read-command)) compilation-read-command))))
@@ -4409,7 +4485,7 @@ If optional second arg COMINT is t the buffer will be in Comint mode with
`compilation-shell-minor-mode'.
Interactively, prompts for the command if the variable
-`compilation-read-command' is non-nil; otherwise uses`compile-command'.
+`compilation-read-command' is non-nil; otherwise uses `compile-command'.
With prefix arg, always prompts.
Additionally, with universal prefix arg, compilation buffer will be in
comint mode, i.e. interactive.
@@ -4496,8 +4572,8 @@ This is the value of `next-error-function' in Compilation buffers.
;;;***
-;;;### (autoloads nil "completion" "completion.el" (20884 7264 412929
-;;;;;; 442000))
+;;;### (autoloads nil "completion" "completion.el" (21804 59688 154807
+;;;;;; 989000))
;;; Generated autoloads from completion.el
(defvar dynamic-completion-mode nil "\
@@ -4519,8 +4595,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (20791
-;;;;;; 9657 561026 0))
+;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (22026
+;;;;;; 25907 647502 692000))
;;; Generated autoloads from textmodes/conf-mode.el
(autoload 'conf-mode "conf-mode" "\
@@ -4675,8 +4751,8 @@ For details see `conf-mode'. Example:
;;;***
-;;;### (autoloads nil "cookie1" "play/cookie1.el" (20932 61824 204300
-;;;;;; 748000))
+;;;### (autoloads nil "cookie1" "play/cookie1.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from play/cookie1.el
(autoload 'cookie "cookie1" "\
@@ -4704,8 +4780,8 @@ and subsequent calls on the same file won't go to disk.
;;;***
-;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (22026
+;;;;;; 25907 575502 692000))
;;; Generated autoloads from emacs-lisp/copyright.el
(put 'copyright-at-end-flag 'safe-local-variable 'booleanp)
(put 'copyright-names-regexp 'safe-local-variable 'stringp)
@@ -4743,8 +4819,8 @@ If FIX is non-nil, run `copyright-fix-years' instead.
;;;***
-;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (20929
-;;;;;; 34089 117790 0))
+;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (22011
+;;;;;; 58553 893858 469000))
;;; Generated autoloads from progmodes/cperl-mode.el
(put 'cperl-indent-level 'safe-local-variable 'integerp)
(put 'cperl-brace-offset 'safe-local-variable 'integerp)
@@ -4942,8 +5018,8 @@ Run a `perldoc' on the word around point.
;;;***
-;;;### (autoloads nil "cpp" "progmodes/cpp.el" (20874 65006 672942
-;;;;;; 217000))
+;;;### (autoloads nil "cpp" "progmodes/cpp.el" (21988 10682 33624
+;;;;;; 461000))
;;; Generated autoloads from progmodes/cpp.el
(autoload 'cpp-highlight-buffer "cpp" "\
@@ -4961,82 +5037,52 @@ Edit display information for cpp conditionals.
;;;***
-;;;### (autoloads nil "crisp" "emulation/crisp.el" (20709 26818 907104
-;;;;;; 0))
-;;; Generated autoloads from emulation/crisp.el
-
-(defvar crisp-mode nil "\
-Track status of CRiSP emulation mode.
-A value of nil means CRiSP mode is not enabled. A value of t
-indicates CRiSP mode is enabled.
-
-Setting this variable directly does not take effect;
-use either M-x customize or the function `crisp-mode'.")
-
-(custom-autoload 'crisp-mode "crisp" nil)
-
-(autoload 'crisp-mode "crisp" "\
-Toggle CRiSP/Brief emulation (CRiSP mode).
-With a prefix argument ARG, enable CRiSP mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-
-\(fn &optional ARG)" t nil)
-
-(defalias 'brief-mode 'crisp-mode)
-
-;;;***
-
-;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (20825 24233 991089
-;;;;;; 0))
+;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (21980 16567 501544
+;;;;;; 893000))
;;; Generated autoloads from emacs-lisp/crm.el
(autoload 'completing-read-multiple "crm" "\
Read multiple strings in the minibuffer, with completion.
-By using this functionality, a user may specify multiple strings at a
-single prompt, optionally using completion.
+The arguments are the same as those of `completing-read'.
+\\<crm-local-completion-map>
+Input multiple strings by separating each one with a string that
+matches the regexp `crm-separator'. For example, if the separator
+regexp is \",\", entering \"alice,bob,eve\" specifies the strings
+\"alice\", \"bob\", and \"eve\".
-Multiple strings are specified by separating each of the strings with
-a prespecified separator regexp. For example, if the separator
-regexp is \",\", the strings 'alice', 'bob', and 'eve' would be
-specified as 'alice,bob,eve'.
-
-The default value for the separator regexp is the value of
-`crm-default-separator' (comma). The separator regexp may be
-changed by modifying the value of `crm-separator'.
-
-Contiguous strings of non-separator-characters are referred to as
-'elements'. In the aforementioned example, the elements are: 'alice',
-'bob', and 'eve'.
+We refer to contiguous strings of non-separator-characters as
+\"elements\". In this example there are three elements.
Completion is available on a per-element basis. For example, if the
-contents of the minibuffer are 'alice,bob,eve' and point is between
-'l' and 'i', pressing TAB operates on the element 'alice'.
+contents of the minibuffer are \"alice,bob,eve\" and point is between
+\"l\" and \"i\", pressing \\[minibuffer-complete] operates on the element \"alice\".
-The return value of this function is a list of the read strings
+This function returns a list of the strings that were read,
with empty strings removed.
-See the documentation for `completing-read' for details on the arguments:
-PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
-INHERIT-INPUT-METHOD.
-
\(fn PROMPT TABLE &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)" nil nil)
;;;***
-;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (22014 34736
+;;;;;; 811840 613000))
;;; Generated autoloads from textmodes/css-mode.el
(autoload 'css-mode "css-mode" "\
Major mode to edit Cascading Style Sheets.
\(fn)" t nil)
+ (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode))
+
+(autoload 'scss-mode "css-mode" "\
+Major mode to edit \"Sassy CSS\" files.
+
+\(fn)" t nil)
;;;***
-;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (21990 52406
+;;;;;; 528500 385000))
;;; Generated autoloads from emulation/cua-base.el
(defvar cua-mode nil "\
@@ -5072,11 +5118,6 @@ You can customize `cua-enable-cua-keys' to completely disable the
CUA bindings, or `cua-prefix-override-inhibit-delay' to change
the prefix fallback behavior.
-CUA mode manages Transient Mark mode internally. Trying to disable
-Transient Mark mode while CUA mode is enabled does not work; if you
-only want to highlight the region when it is selected using a
-shifted movement key, set `cua-highlight-region-shift-only'.
-
\(fn &optional ARG)" t nil)
(autoload 'cua-selection-mode "cua-base" "\
@@ -5086,8 +5127,41 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings.
;;;***
-;;;### (autoloads nil "cus-edit" "cus-edit.el" (20932 10282 564846
-;;;;;; 0))
+;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (21670 32330
+;;;;;; 885624 725000))
+;;; Generated autoloads from emulation/cua-rect.el
+
+(autoload 'cua-rectangle-mark-mode "cua-rect" "\
+Toggle the region as rectangular.
+Activates the region if needed. Only lasts until the region is deactivated.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "cursor-sensor" "emacs-lisp/cursor-sensor.el"
+;;;;;; (21804 59688 154807 989000))
+;;; Generated autoloads from emacs-lisp/cursor-sensor.el
+
+(autoload 'cursor-intangible-mode "cursor-sensor" "\
+Keep cursor outside of any `cursor-intangible' text property.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'cursor-sensor-mode "cursor-sensor" "\
+Handle the `cursor-sensor-functions' text property.
+This property should hold a list of functions which react to the motion
+of the cursor. They're called with three arguments (WINDOW OLDPOS DIR)
+where WINDOW is the affected window, OLDPOS is the last known position of
+the cursor and DIR can be `left' or `entered' depending on whether the cursor is
+entering the area covered by the text-property property or leaving it.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "cus-edit" "cus-edit.el" (21993 28596 22597
+;;;;;; 473000))
;;; Generated autoloads from cus-edit.el
(defvar custom-browse-sort-alphabetically nil "\
@@ -5224,8 +5298,8 @@ and `defface'.
For example, the MH-E package updates this alist as follows:
- (add-to-list 'customize-package-emacs-version-alist
- '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
+ (add-to-list \\='customize-package-emacs-version-alist
+ \\='(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
(\"7.0\" . \"22.1\") (\"7.1\" . \"22.1\")
(\"7.2\" . \"22.1\") (\"7.3\" . \"22.1\")
(\"7.4\" . \"22.1\") (\"8.0\" . \"22.1\")))
@@ -5313,12 +5387,20 @@ Customize all loaded groups matching REGEXP.
\(fn REGEXP)" t nil)
+(autoload 'custom-prompt-customize-unsaved-options "cus-edit" "\
+Prompt user to customize any unsaved customization options.
+Return non-nil if user chooses to customize, for use in
+`kill-emacs-query-functions'.
+
+\(fn)" nil nil)
+
(autoload 'custom-buffer-create "cus-edit" "\
Create a buffer containing OPTIONS.
Optional NAME is the name of the buffer.
OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where
SYMBOL is a customization option, and WIDGET is a widget for editing
that option.
+DESCRIPTION is unused.
\(fn OPTIONS &optional NAME DESCRIPTION)" nil nil)
@@ -5398,8 +5480,8 @@ The format is suitable for use with `easy-menu-define'.
;;;***
-;;;### (autoloads nil "cus-theme" "cus-theme.el" (20841 12463 538770
-;;;;;; 0))
+;;;### (autoloads nil "cus-theme" "cus-theme.el" (21998 46516 910024
+;;;;;; 649000))
;;; Generated autoloads from cus-theme.el
(autoload 'customize-create-theme "cus-theme" "\
@@ -5432,8 +5514,8 @@ omitted, a buffer named *Custom Themes* is used.
;;;***
-;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (22026 25907
+;;;;;; 671502 692000))
;;; Generated autoloads from vc/cvs-status.el
(autoload 'cvs-status-mode "cvs-status" "\
@@ -5443,10 +5525,11 @@ Mode used for cvs status output.
;;;***
-;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from progmodes/cwarn.el
-(push (purecopy (quote (cwarn 1 3 1))) package--builtin-versions)
+(push (purecopy '(cwarn 1 3 1)) package--builtin-versions)
+
(autoload 'cwarn-mode "cwarn" "\
Minor mode that highlights suspicious C and C++ constructions.
@@ -5487,8 +5570,8 @@ See `cwarn-mode' for more information on Cwarn mode.
;;;***
-;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (20826
-;;;;;; 45095 436233 0))
+;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/cyril-util.el
(autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\
@@ -5516,8 +5599,8 @@ If the argument is nil, we return the display table to its standard state.
;;;***
-;;;### (autoloads nil "dabbrev" "dabbrev.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "dabbrev" "dabbrev.el" (22011 58553 321858
+;;;;;; 469000))
;;; Generated autoloads from dabbrev.el
(put 'dabbrev-case-fold-search 'risky-local-variable t)
(put 'dabbrev-case-replace 'risky-local-variable t)
@@ -5563,8 +5646,8 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion].
;;;***
-;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (20938 49065
-;;;;;; 383398 0))
+;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (21974 64192
+;;;;;; 556009 993000))
;;; Generated autoloads from cedet/data-debug.el
(autoload 'data-debug-new-buffer "data-debug" "\
@@ -5574,7 +5657,7 @@ Create a new data-debug buffer with NAME.
;;;***
-;;;### (autoloads nil "dbus" "net/dbus.el" (20900 33838 319219 0))
+;;;### (autoloads nil "dbus" "net/dbus.el" (22011 58553 761858 469000))
;;; Generated autoloads from net/dbus.el
(autoload 'dbus-handle-event "dbus" "\
@@ -5587,8 +5670,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message.
;;;***
-;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (20763 30266
-;;;;;; 231060 0))
+;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (22011 58553
+;;;;;; 897858 469000))
;;; Generated autoloads from progmodes/dcl-mode.el
(autoload 'dcl-mode "dcl-mode" "\
@@ -5714,8 +5797,8 @@ There is some minimal font-lock support (see vars
;;;***
-;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21918 44225
+;;;;;; 955204 84000))
;;; Generated autoloads from emacs-lisp/debug.el
(setq debugger 'debug)
@@ -5758,8 +5841,8 @@ To specify a nil argument interactively, exit with an empty minibuffer.
;;;***
-;;;### (autoloads nil "decipher" "play/decipher.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "decipher" "play/decipher.el" (21948 40114
+;;;;;; 398686 453000))
;;; Generated autoloads from play/decipher.el
(autoload 'decipher "decipher" "\
@@ -5787,10 +5870,11 @@ The most useful commands are:
;;;***
-;;;### (autoloads nil "delim-col" "delim-col.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "delim-col" "delim-col.el" (21980 16567 477544
+;;;;;; 893000))
;;; Generated autoloads from delim-col.el
-(push (purecopy (quote (delim-col 2 1))) package--builtin-versions)
+(push (purecopy '(delim-col 2 1)) package--builtin-versions)
+
(autoload 'delimit-columns-customize "delim-col" "\
Customization of `columns' group.
@@ -5812,7 +5896,7 @@ START and END delimits the corners of text rectangle.
;;;***
-;;;### (autoloads nil "delsel" "delsel.el" (20709 26818 907104 0))
+;;;### (autoloads nil "delsel" "delsel.el" (21973 43315 242113 285000))
;;; Generated autoloads from delsel.el
(defalias 'pending-delete-mode 'delete-selection-mode)
@@ -5832,17 +5916,16 @@ With a prefix argument ARG, enable Delete Selection mode if ARG
is positive, and disable it otherwise. If called from Lisp,
enable the mode if ARG is omitted or nil.
-When Delete Selection mode is enabled, Transient Mark mode is also
-enabled and typed text replaces the selection if the selection is
-active. Otherwise, typed text is just inserted at point regardless of
-any selection.
+When Delete Selection mode is enabled, typed text replaces the selection
+if the selection is active. Otherwise, typed text is just inserted at
+point regardless of any selection.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (20900 33838
-;;;;;; 319219 0))
+;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (21978 61237
+;;;;;; 450488 269000))
;;; Generated autoloads from emacs-lisp/derived.el
(autoload 'define-derived-mode "derived" "\
@@ -5896,7 +5979,9 @@ See Info node `(elisp)Derived Modes' for more details.
\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t)
-(put 'define-derived-mode 'doc-string-elt '4)
+(function-put 'define-derived-mode 'doc-string-elt '4)
+
+(function-put 'define-derived-mode 'lisp-indent-function '3)
(autoload 'derived-mode-init-mode-variables "derived" "\
Initialize variables for a new MODE.
@@ -5908,8 +5993,8 @@ the first time the mode is used.
;;;***
-;;;### (autoloads nil "descr-text" "descr-text.el" (20875 30633 412173
-;;;;;; 0))
+;;;### (autoloads nil "descr-text" "descr-text.el" (21998 46516 914024
+;;;;;; 649000))
;;; Generated autoloads from descr-text.el
(autoload 'describe-text-properties "descr-text" "\
@@ -5941,26 +6026,56 @@ relevant to POS.
\(fn POS &optional BUFFER)" t nil)
+(autoload 'describe-char-eldoc "descr-text" "\
+Return a description of character at point for use by ElDoc mode.
+
+Return nil if character at point is a printable ASCII
+character (i.e. codepoint between 32 and 127 inclusively).
+Otherwise return a description formatted by
+`describe-char-eldoc--format' function taking into account value
+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.
+
+\(fn)" nil nil)
+
;;;***
-;;;### (autoloads nil "desktop" "desktop.el" (20945 22315 8369 0))
+;;;### (autoloads nil "desktop" "desktop.el" (22026 25907 555502
+;;;;;; 692000))
;;; Generated autoloads from desktop.el
(defvar desktop-save-mode nil "\
Non-nil if Desktop-Save mode is enabled.
-See the command `desktop-save-mode' for a description of this minor mode.")
+See the command `desktop-save-mode' 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 `desktop-save-mode'.")
(custom-autoload 'desktop-save-mode "desktop" nil)
(autoload 'desktop-save-mode "desktop" "\
Toggle desktop saving (Desktop Save mode).
-With a prefix argument ARG, enable Desktop Save mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+With a prefix argument ARG, enable Desktop Save mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode if ARG
+is omitted or nil.
+
+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
+it exits (this may prompt you; see the option `desktop-save'). The next
+time Emacs starts, if this mode is active it will restore the desktop.
+
+To manually save the desktop at any time, use the command `\\[desktop-save]'.
+To load it, use `\\[desktop-read]'.
+
+Once a desktop file exists, Emacs will auto-save it according to the
+option `desktop-auto-save-timeout'.
-If Desktop Save mode is enabled, the state of Emacs is saved from
-one session to another. See variable `desktop-save' and function
-`desktop-read' for details.
+To see all the options you can set, browse the `desktop' customization group.
+
+For further details, see info node `(emacs)Saving Emacs Sessions'.
\(fn &optional ARG)" t nil)
@@ -5971,9 +6086,8 @@ modes are restored automatically; they should not be listed here.")
(custom-autoload 'desktop-locals-to-save "desktop" t)
-(defvar desktop-save-buffer nil "\
+(defvar-local desktop-save-buffer nil "\
When non-nil, save buffer status in desktop file.
-This variable becomes buffer local when set.
If the value is a function, it is called by `desktop-save' with argument
DESKTOP-DIRNAME to obtain auxiliary information to save in the desktop
@@ -6002,13 +6116,13 @@ Handlers are called with argument list
Furthermore, they may use the following variables:
- desktop-file-version
- desktop-buffer-major-mode
- desktop-buffer-minor-modes
- desktop-buffer-point
- desktop-buffer-mark
- desktop-buffer-read-only
- desktop-buffer-locals
+ `desktop-file-version'
+ `desktop-buffer-major-mode'
+ `desktop-buffer-minor-modes'
+ `desktop-buffer-point'
+ `desktop-buffer-mark'
+ `desktop-buffer-read-only'
+ `desktop-buffer-locals'
If a handler returns a buffer, then the saved mode settings
and variable values for that buffer are copied into it.
@@ -6021,7 +6135,9 @@ code like
(add-to-list 'desktop-buffer-mode-handlers
'(foo-mode . foo-restore-desktop-buffer))
-Furthermore the major mode function must be autoloaded.")
+The major mode function must either be autoloaded, or of the form
+\"foobar-mode\" and defined in library \"foobar\", so that desktop
+can guess how to load the mode's definition.")
(put 'desktop-buffer-mode-handlers 'risky-local-variable t)
@@ -6041,15 +6157,15 @@ Handlers are called with argument list
Furthermore, they may use the following variables:
- desktop-file-version
- desktop-buffer-file-name
- desktop-buffer-name
- desktop-buffer-major-mode
- desktop-buffer-minor-modes
- desktop-buffer-point
- desktop-buffer-mark
- desktop-buffer-read-only
- desktop-buffer-misc
+ `desktop-file-version'
+ `desktop-buffer-file-name'
+ `desktop-buffer-name'
+ `desktop-buffer-major-mode'
+ `desktop-buffer-minor-modes'
+ `desktop-buffer-point'
+ `desktop-buffer-mark'
+ `desktop-buffer-read-only'
+ `desktop-buffer-misc'
When a handler is called, the buffer has been created and the major mode has
been set, but local variables listed in desktop-buffer-locals has not yet been
@@ -6063,7 +6179,9 @@ code like
(add-to-list 'desktop-minor-mode-handlers
'(foo-mode . foo-desktop-restore))
-Furthermore the minor mode function must be autoloaded.
+The minor mode function must either be autoloaded, or of the form
+\"foobar-mode\" and defined in library \"foobar\", so that desktop
+can guess how to load the mode's definition.
See also `desktop-minor-mode-table'.")
@@ -6074,6 +6192,9 @@ Empty the Desktop.
This kills all buffers except for internal ones and those with names matched by
a regular expression in the list `desktop-clear-preserve-buffers'.
Furthermore, it clears the variables listed in `desktop-globals-to-clear'.
+When called interactively and `desktop-restore-frames' is non-nil, it also
+deletes all frames except the selected one (and its minibuffer frame,
+if different).
\(fn)" t nil)
@@ -6081,10 +6202,11 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'.
Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
Optional parameter RELEASE says whether we're done with this desktop.
-If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
-and don't save the buffer if they are the same.
+If ONLY-IF-CHANGED is non-nil, compare the current desktop information
+to that in the desktop file, and if the desktop information has not
+changed since it was last saved then do not rewrite the file.
-\(fn DIRNAME &optional RELEASE AUTO-SAVE)" t nil)
+\(fn DIRNAME &optional RELEASE ONLY-IF-CHANGED)" t nil)
(autoload 'desktop-remove "desktop" "\
Delete desktop file in `desktop-dirname'.
@@ -6131,8 +6253,8 @@ Revert to the last loaded desktop.
;;;***
-;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (20791 9657 561026
-;;;;;; 0))
+;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (21855 576 877944
+;;;;;; 285000))
;;; Generated autoloads from gnus/deuglify.el
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\
@@ -6164,8 +6286,8 @@ Deuglify broken Outlook (Express) articles and redisplay.
;;;***
-;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (20932
-;;;;;; 61699 522706 0))
+;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (22026
+;;;;;; 25907 547502 692000))
;;; Generated autoloads from calendar/diary-lib.el
(autoload 'diary "diary-lib" "\
@@ -6207,10 +6329,10 @@ Major mode for editing the diary file.
;;;***
-;;;### (autoloads nil "diff" "vc/diff.el" (20760 54070 584283 0))
+;;;### (autoloads nil "diff" "vc/diff.el" (21804 59688 284811 0))
;;; Generated autoloads from vc/diff.el
-(defvar diff-switches (purecopy "-c") "\
+(defvar diff-switches (purecopy "-u") "\
A string or list of strings specifying switches to be passed to diff.")
(custom-autoload 'diff-switches "diff" t)
@@ -6255,8 +6377,8 @@ This requires the external program `diff' to be in your `exec-path'.
;;;***
-;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (20814 53928
-;;;;;; 50501 0))
+;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (22011 58554
+;;;;;; 89858 469000))
;;; Generated autoloads from vc/diff-mode.el
(autoload 'diff-mode "diff-mode" "\
@@ -6288,7 +6410,7 @@ the mode if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "dig" "net/dig.el" (20709 26818 907104 0))
+;;;### (autoloads nil "dig" "net/dig.el" (21670 32331 385639 720000))
;;; Generated autoloads from net/dig.el
(autoload 'dig "dig" "\
@@ -6299,7 +6421,7 @@ Optional arguments are passed to `dig-invoke'.
;;;***
-;;;### (autoloads nil "dired" "dired.el" (20932 61699 522706 0))
+;;;### (autoloads nil "dired" "dired.el" (21998 46624 946024 649000))
;;; Generated autoloads from dired.el
(defvar dired-listing-switches (purecopy "-al") "\
@@ -6324,10 +6446,16 @@ The directory name must be absolute, but need not be fully expanded.")
\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
Optional second argument SWITCHES specifies the `ls' options used.
\(Interactively, use a prefix argument to be able to specify SWITCHES.)
-Dired displays a list of files in DIRNAME (which may also have
-shell wildcards appended to select certain files). If DIRNAME is a cons,
-its first element is taken as the directory name and the rest as an explicit
-list of files to make directory entries for.
+
+If DIRNAME is a string, Dired displays a list of files in DIRNAME (which
+may also have shell wildcards appended to select certain files).
+
+If DIRNAME is a cons, its first element is taken as the directory name
+and the rest as an explicit list of files to make directory entries for.
+In this case, SWITCHES are applied to each of the files separately, and
+therefore switches that control the order of the files in the produced
+listing have no effect.
+
\\<dired-mode-map>You can flag files for deletion with \\[dired-flag-file-deletion] and then
delete them by typing \\[dired-do-flagged-delete].
Type \\[describe-mode] after entering Dired for more info.
@@ -6375,7 +6503,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands.
to see why something went wrong.
Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory.
Type \\[dired-unmark-backward] to back up one line and unmark or unflag.
-Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'.
+Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'.
Type \\[dired-find-file] to Find the current line's file
(or dired it in another buffer, if it is a directory).
Type \\[dired-find-file-other-window] to find file or Dired directory in Other window.
@@ -6417,15 +6545,10 @@ Keybindings:
\(fn &optional DIRNAME SWITCHES)" nil nil)
(put 'dired-find-alternate-file 'disabled t)
-(autoload 'dired-hide-details-mode "dired" "\
-Hide details in Dired mode.
-
-\(fn &optional ARG)" t nil)
-
;;;***
-;;;### (autoloads nil "dirtrack" "dirtrack.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "dirtrack" "dirtrack.el" (21981 37426 531399
+;;;;;; 97000))
;;; Generated autoloads from dirtrack.el
(autoload 'dirtrack-mode "dirtrack" "\
@@ -6455,8 +6578,8 @@ from `default-directory'.
;;;***
-;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (21993 28596
+;;;;;; 58597 473000))
;;; Generated autoloads from emacs-lisp/disass.el
(autoload 'disassemble "disass" "\
@@ -6470,8 +6593,8 @@ redefine OBJECT if it is a symbol.
;;;***
-;;;### (autoloads nil "disp-table" "disp-table.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "disp-table" "disp-table.el" (21981 37426 535399
+;;;;;; 97000))
;;; Generated autoloads from disp-table.el
(autoload 'make-display-table "disp-table" "\
@@ -6592,8 +6715,8 @@ in `.emacs'.
;;;***
-;;;### (autoloads nil "dissociate" "play/dissociate.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "dissociate" "play/dissociate.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from play/dissociate.el
(autoload 'dissociated-press "dissociate" "\
@@ -6609,7 +6732,7 @@ Default is 2.
;;;***
-;;;### (autoloads nil "dnd" "dnd.el" (20709 26818 907104 0))
+;;;### (autoloads nil "dnd" "dnd.el" (22026 25907 555502 692000))
;;; Generated autoloads from dnd.el
(defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\
@@ -6629,8 +6752,8 @@ if some action was made, or nil if the URL is ignored.")
;;;***
-;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from textmodes/dns-mode.el
(autoload 'dns-mode "dns-mode" "\
@@ -6653,8 +6776,8 @@ Locate SOA record and increment the serial field.
;;;***
-;;;### (autoloads nil "doc-view" "doc-view.el" (20899 12965 791908
-;;;;;; 0))
+;;;### (autoloads nil "doc-view" "doc-view.el" (21716 41663 456033
+;;;;;; 27000))
;;; Generated autoloads from doc-view.el
(autoload 'doc-view-mode-p "doc-view" "\
@@ -6700,8 +6823,8 @@ See the command `doc-view-mode' for more information on this mode.
;;;***
-;;;### (autoloads nil "doctor" "play/doctor.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "doctor" "play/doctor.el" (22011 58553 865858
+;;;;;; 469000))
;;; Generated autoloads from play/doctor.el
(autoload 'doctor "doctor" "\
@@ -6711,7 +6834,7 @@ Switch to *doctor* buffer and start giving psychotherapy.
;;;***
-;;;### (autoloads nil "double" "double.el" (20709 26818 907104 0))
+;;;### (autoloads nil "double" "double.el" (21953 58033 239058 929000))
;;; Generated autoloads from double.el
(autoload 'double-mode "double" "\
@@ -6727,10 +6850,11 @@ strings when pressed twice. See `double-map' for details.
;;;***
-;;;### (autoloads nil "dunnet" "play/dunnet.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "dunnet" "play/dunnet.el" (21980 16567 965544
+;;;;;; 893000))
;;; Generated autoloads from play/dunnet.el
-(push (purecopy (quote (dunnet 2 1))) package--builtin-versions)
+(push (purecopy '(dunnet 2 2)) package--builtin-versions)
+
(autoload 'dunnet "dunnet" "\
Switch to *dungeon* buffer and start game.
@@ -6738,8 +6862,8 @@ Switch to *dungeon* buffer and start game.
;;;***
-;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (20900
-;;;;;; 33838 319219 0))
+;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (22011
+;;;;;; 58553 361858 469000))
;;; Generated autoloads from emacs-lisp/easy-mmode.el
(defalias 'easy-mmode-define-minor-mode 'define-minor-mode)
@@ -6775,9 +6899,12 @@ Optional KEYMAP is the default keymap bound to the mode keymap.
BODY contains code to execute each time the mode is enabled or disabled.
It is executed after toggling the mode, and before running MODE-hook.
Before the actual body code, you can write keyword arguments, i.e.
- alternating keywords and values. These following special keywords
- are supported (other keywords are passed to `defcustom' if the minor
- mode is global):
+ alternating keywords and values. If you provide BODY, then you must
+ provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide
+ at least one keyword argument, or both; otherwise, BODY would be
+ misinterpreted as the first omitted argument. The following special
+ keywords are supported (other keywords are passed to `defcustom' if
+ 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\".
@@ -6811,7 +6938,9 @@ For example, you could write
\(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t)
-(put 'define-minor-mode 'doc-string-elt '2)
+(function-put 'define-minor-mode 'doc-string-elt '2)
+
+(function-put 'define-minor-mode 'lisp-indent-function '1)
(defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode)
@@ -6842,7 +6971,7 @@ on if the hook has explicitly disabled it.
\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t)
-(put 'define-globalized-minor-mode 'doc-string-elt '2)
+(function-put 'define-globalized-minor-mode 'doc-string-elt '2)
(autoload 'easy-mmode-define-keymap "easy-mmode" "\
Return a keymap built from bindings BS.
@@ -6878,8 +7007,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
;;;***
-;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from emacs-lisp/easymenu.el
(autoload 'easy-menu-define "easymenu" "\
@@ -6981,7 +7110,7 @@ MENU. This is a submenu.
\(fn SYMBOL MAPS DOC MENU)" nil t)
-(put 'easy-menu-define 'lisp-indent-function 'defun)
+(function-put 'easy-menu-define 'lisp-indent-function 'defun)
(autoload 'easy-menu-do-define "easymenu" "\
@@ -7017,10 +7146,11 @@ To implement dynamic menus, either call this from
;;;***
-;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (22011 58553
+;;;;;; 897858 469000))
;;; Generated autoloads from progmodes/ebnf2ps.el
-(push (purecopy (quote (ebnf2ps 4 4))) package--builtin-versions)
+(push (purecopy '(ebnf2ps 4 4)) package--builtin-versions)
+
(autoload 'ebnf-customize "ebnf2ps" "\
Customization for ebnf group.
@@ -7282,8 +7412,8 @@ See `ebnf-style-database' documentation.
;;;***
-;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (21998 46517
+;;;;;; 206024 649000))
;;; Generated autoloads from progmodes/ebrowse.el
(autoload 'ebrowse-tree-mode "ebrowse" "\
@@ -7431,8 +7561,8 @@ Display statistics for a class tree.
;;;***
-;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (21953 58033 239058
+;;;;;; 929000))
;;; Generated autoloads from ebuff-menu.el
(autoload 'electric-buffer-list "ebuff-menu" "\
@@ -7464,8 +7594,8 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry.
;;;***
-;;;### (autoloads nil "echistory" "echistory.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "echistory" "echistory.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from echistory.el
(autoload 'Electric-command-history-redo-expression "echistory" "\
@@ -7476,8 +7606,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
;;;***
-;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/ecomplete.el
(autoload 'ecomplete-setup "ecomplete" "\
@@ -7487,9 +7617,10 @@ With prefix arg NOCONFIRM, execute current line as-is without editing.
;;;***
-;;;### (autoloads nil "ede" "cedet/ede.el" (20908 27948 216644 0))
+;;;### (autoloads nil "ede" "cedet/ede.el" (21996 4784 796983 429000))
;;; Generated autoloads from cedet/ede.el
-(push (purecopy (quote (ede 1 2))) package--builtin-versions)
+(push (purecopy '(ede 1 2)) package--builtin-versions)
+
(defvar global-ede-mode nil "\
Non-nil if Global-Ede mode is enabled.
See the command `global-ede-mode' for a description of this minor mode.
@@ -7512,20 +7643,8 @@ an EDE controlled project.
;;;***
-;;;### (autoloads nil "ede/dired" "cedet/ede/dired.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from cedet/ede/dired.el
-(push (purecopy (quote (dired 0 4))) package--builtin-versions)
-;;;***
-
-;;;### (autoloads nil "ede/project-am" "cedet/ede/project-am.el"
-;;;;;; (20881 10343 547564 552000))
-;;; Generated autoloads from cedet/ede/project-am.el
-(push (purecopy (quote (project-am 0 0 3))) package--builtin-versions)
-;;;***
-
-;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (20912 25000
-;;;;;; 802412 0))
+;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (22022 28851
+;;;;;; 765037 303000))
;;; Generated autoloads from emacs-lisp/edebug.el
(defvar edebug-all-defs nil "\
@@ -7536,7 +7655,7 @@ This applies to `eval-defun', `eval-region', `eval-buffer', and
You can use the command `edebug-all-defs' to toggle the value of this
variable. You may wish to make it local to each buffer with
-\(make-local-variable 'edebug-all-defs) in your
+\(make-local-variable \\='edebug-all-defs) in your
`emacs-lisp-mode-hook'.")
(custom-autoload 'edebug-all-defs "edebug" t)
@@ -7589,9 +7708,10 @@ Toggle edebugging of all forms.
;;;***
-;;;### (autoloads nil "ediff" "vc/ediff.el" (20893 60586 188550 0))
+;;;### (autoloads nil "ediff" "vc/ediff.el" (22011 58554 93858 469000))
;;; Generated autoloads from vc/ediff.el
-(push (purecopy (quote (ediff 2 81 4))) package--builtin-versions)
+(push (purecopy '(ediff 2 81 4)) package--builtin-versions)
+
(autoload 'ediff-files "ediff" "\
Run Ediff on a pair of files, FILE-A and FILE-B.
@@ -7818,10 +7938,50 @@ With optional NODE, goes to that node.
\(fn &optional NODE)" t nil)
+(autoload 'ediff-files-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff3-files-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-merge-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-merge-with-ancestor-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-directories-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-directories3-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-merge-directories-command "ediff" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ediff-merge-directories-with-ancestor-command "ediff" "\
+
+
+\(fn)" nil nil)
+
;;;***
-;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (21870 54319
+;;;;;; 247944 919000))
;;; Generated autoloads from vc/ediff-help.el
(autoload 'ediff-customize "ediff-help" "\
@@ -7831,8 +7991,8 @@ With optional NODE, goes to that node.
;;;***
-;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (20893 60586
-;;;;;; 188550 0))
+;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (21993 28596
+;;;;;; 422597 473000))
;;; Generated autoloads from vc/ediff-mult.el
(autoload 'ediff-show-registry "ediff-mult" "\
@@ -7844,8 +8004,8 @@ Display Ediff's registry.
;;;***
-;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (20893 60586
-;;;;;; 188550 0))
+;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (22026 25907
+;;;;;; 671502 692000))
;;; Generated autoloads from vc/ediff-util.el
(autoload 'ediff-toggle-multiframe "ediff-util" "\
@@ -7864,15 +8024,16 @@ To change the default, set the variable `ediff-use-toolbar-p', which see.
;;;***
-;;;### (autoloads nil "edmacro" "edmacro.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "edmacro" "edmacro.el" (21976 19509 748430
+;;;;;; 241000))
;;; Generated autoloads from edmacro.el
-(push (purecopy (quote (edmacro 2 1))) package--builtin-versions)
+(push (purecopy '(edmacro 2 1)) package--builtin-versions)
+
(autoload 'edit-kbd-macro "edmacro" "\
Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 300 keystrokes as a keyboard macro, or `M-x' to edit a macro by
+the last 300 keystrokes as a keyboard macro, or `\\[execute-extended-command]' to edit a macro by
its command name.
With a prefix argument, format the macro in a more concise way.
@@ -7913,8 +8074,8 @@ or nil, use a compact 80-column format.
;;;***
-;;;### (autoloads nil "edt" "emulation/edt.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "edt" "emulation/edt.el" (22011 58553 453858
+;;;;;; 469000))
;;; Generated autoloads from emulation/edt.el
(autoload 'edt-set-scroll-margins "edt" "\
@@ -7931,7 +8092,7 @@ Turn on EDT Emulation.
;;;***
-;;;### (autoloads nil "ehelp" "ehelp.el" (20762 9398 526093 0))
+;;;### (autoloads nil "ehelp" "ehelp.el" (21953 58033 247058 929000))
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -7967,16 +8128,18 @@ BUFFER is put back into its original major mode.
;;;***
-;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (20930 5097 423575
-;;;;;; 701000))
+;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21998 46624
+;;;;;; 898024 649000))
;;; Generated autoloads from emacs-lisp/eieio.el
-(push (purecopy (quote (eieio 1 4))) package--builtin-versions)
+(push (purecopy '(eieio 1 4)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (20908
-;;;;;; 27948 216644 0))
+;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (22009
+;;;;;; 58952 307546 645000))
;;; Generated autoloads from emacs-lisp/eieio-core.el
-(push (purecopy (quote (eieio-core 1 4))) package--builtin-versions)
+(push (purecopy '(eieio-core 1 4)) package--builtin-versions)
+
(autoload 'eieio-defclass-autoload "eieio-core" "\
Create autoload symbols for the EIEIO class CNAME.
SUPERCLASSES are the superclasses that CNAME inherits from.
@@ -7989,135 +8152,18 @@ It creates an autoload function for CNAME's constructor.
;;;***
-;;;### (autoloads nil "eieio-custom" "emacs-lisp/eieio-custom.el"
-;;;;;; (20929 34089 117790 0))
-;;; Generated autoloads from emacs-lisp/eieio-custom.el
-
-(autoload 'customize-object "eieio-custom" "\
-Customize OBJ in a custom buffer.
-Optional argument GROUP is the sub-group of slots to display.
-
-\(fn OBJ &optional GROUP)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "eieio-opt" "emacs-lisp/eieio-opt.el" (20892
-;;;;;; 39729 858825 0))
-;;; Generated autoloads from emacs-lisp/eieio-opt.el
-
-(autoload 'eieio-browse "eieio-opt" "\
-Create an object browser window to show all objects.
-If optional ROOT-CLASS, then start with that, otherwise start with
-variable `eieio-default-superclass'.
-
-\(fn &optional ROOT-CLASS)" t nil)
-(defalias 'describe-class 'eieio-describe-class)
-
-(autoload 'eieio-describe-class "eieio-opt" "\
-Describe a CLASS defined by a string or symbol.
-If CLASS is actually an object, then also display current values of that object.
-Optional HEADERFCN should be called to insert a few bits of info first.
+;;;### (autoloads nil "elec-pair" "elec-pair.el" (21888 48869 288181
+;;;;;; 796000))
+;;; Generated autoloads from elec-pair.el
-\(fn CLASS &optional HEADERFCN)" t nil)
+(defvar electric-pair-text-pairs '((34 . 34)) "\
+Alist of pairs that should always be used in comments and strings.
-(autoload 'eieio-describe-constructor "eieio-opt" "\
-Describe the constructor function FCN.
-Uses `eieio-describe-class' to describe the class being constructed.
+Pairs of delimiters in this list are a fallback in case they have
+no syntax relevant to `electric-pair-mode' in the syntax table
+defined in `electric-pair-text-syntax-table'")
-\(fn FCN)" t nil)
-(defalias 'describe-generic 'eieio-describe-generic)
-
-(autoload 'eieio-describe-generic "eieio-opt" "\
-Describe the generic function GENERIC.
-Also extracts information about all methods specific to this generic.
-
-\(fn GENERIC)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (20806 59818
-;;;;;; 347907 0))
-;;; Generated autoloads from emacs-lisp/eldoc.el
-
-(defvar eldoc-minor-mode-string (purecopy " ElDoc") "\
-String to display in mode line when ElDoc Mode is enabled; nil for none.")
-
-(custom-autoload 'eldoc-minor-mode-string "eldoc" t)
-
-(autoload 'eldoc-mode "eldoc" "\
-Toggle echo area display of Lisp objects at point (ElDoc mode).
-With a prefix argument ARG, enable ElDoc mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable ElDoc mode
-if ARG is omitted or nil.
-
-ElDoc mode is a buffer-local minor mode. When enabled, the echo
-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.
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'eldoc-post-insert-mode "eldoc" "\
-Toggle Eldoc-Post-Insert mode on or off.
-With a prefix argument ARG, enable Eldoc-Post-Insert mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
-\\{eldoc-post-insert-mode-map}
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'turn-on-eldoc-mode "eldoc" "\
-Unequivocally turn on ElDoc mode (see command `eldoc-mode').
-
-\(fn)" t nil)
-
-(defvar eldoc-documentation-function nil "\
-If non-nil, 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.
-
-This variable is expected to be made buffer-local by modes (other than
-Emacs Lisp mode) that support ElDoc.")
-
-;;;***
-
-;;;### (autoloads nil "electric" "electric.el" (20929 34089 117790
-;;;;;; 0))
-;;; Generated autoloads from electric.el
-
-(defvar electric-indent-chars '(10) "\
-Characters that should cause automatic reindentation.")
-
-(defvar electric-indent-mode nil "\
-Non-nil if Electric-Indent mode is enabled.
-See the command `electric-indent-mode' 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 `electric-indent-mode'.")
-
-(custom-autoload 'electric-indent-mode "electric" nil)
-
-(autoload 'electric-indent-mode "electric" "\
-Toggle on-the-fly reindentation (Electric Indent mode).
-With a prefix argument ARG, enable Electric Indent mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-This is a global minor mode. When enabled, it reindents whenever
-the hook `electric-indent-functions' returns non-nil, or you
-insert a character from `electric-indent-chars'.
-
-\(fn &optional ARG)" t nil)
+(custom-autoload 'electric-pair-text-pairs "elec-pair" t)
(defvar electric-pair-mode nil "\
Non-nil if Electric-Pair mode is enabled.
@@ -8126,9 +8172,9 @@ Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `electric-pair-mode'.")
-(custom-autoload 'electric-pair-mode "electric" nil)
+(custom-autoload 'electric-pair-mode "elec-pair" nil)
-(autoload 'electric-pair-mode "electric" "\
+(autoload 'electric-pair-mode "elec-pair" "\
Toggle automatic parens pairing (Electric Pair mode).
With a prefix argument ARG, enable Electric Pair mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
@@ -8136,34 +8182,20 @@ the mode if ARG is omitted or nil.
Electric Pair mode is a global minor mode. When enabled, typing
an open parenthesis automatically inserts the corresponding
-closing parenthesis. (Likewise for brackets, etc.)
-
-See options `electric-pair-pairs' and `electric-pair-skip-self'.
+closing parenthesis. (Likewise for brackets, etc.). To toggle
+the mode in a single buffer, use `electric-pair-local-mode'.
\(fn &optional ARG)" t nil)
-(defvar electric-layout-mode nil "\
-Non-nil if Electric-Layout mode is enabled.
-See the command `electric-layout-mode' 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 `electric-layout-mode'.")
-
-(custom-autoload 'electric-layout-mode "electric" nil)
-
-(autoload 'electric-layout-mode "electric" "\
-Automatically insert newlines around some chars.
-With a prefix argument ARG, enable Electric Layout mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-The variable `electric-layout-rules' says when and how to insert newlines.
+(autoload 'electric-pair-local-mode "elec-pair" "\
+Toggle `electric-pair-mode' only in this buffer.
\(fn &optional ARG)" t nil)
;;;***
-;;;### (autoloads nil "elide-head" "elide-head.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "elide-head" "elide-head.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from elide-head.el
(autoload 'elide-head "elide-head" "\
@@ -8178,8 +8210,8 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks.
;;;***
-;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (21998 46516
+;;;;;; 994024 649000))
;;; Generated autoloads from emacs-lisp/elint.el
(autoload 'elint-file "elint" "\
@@ -8214,8 +8246,8 @@ optional prefix argument REINIT is non-nil.
;;;***
-;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lisp/elp.el
(autoload 'elp-instrument-function "elp" "\
@@ -8249,8 +8281,8 @@ displayed.
;;;***
-;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (20933 31141 450159
-;;;;;; 0))
+;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lock.el
(autoload 'emacs-lock-mode "emacs-lock" "\
@@ -8277,20 +8309,22 @@ Other values are interpreted as usual.
;;;***
-;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (20759 33211
-;;;;;; 414988 0))
+;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (21989 31537
+;;;;;; 887825 721000))
;;; Generated autoloads from mail/emacsbug.el
(autoload 'report-emacs-bug "emacsbug" "\
Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer.
-\(fn TOPIC &optional RECENT-KEYS)" t nil)
+\(fn TOPIC &optional UNUSED)" t nil)
+
+(set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5")
;;;***
-;;;### (autoloads nil "emerge" "vc/emerge.el" (20576 42138 697312
-;;;;;; 0))
+;;;### (autoloads nil "emerge" "vc/emerge.el" (21953 58033 507058
+;;;;;; 929000))
;;; Generated autoloads from vc/emerge.el
(autoload 'emerge-files "emerge" "\
@@ -8350,8 +8384,8 @@ Emerge two RCS revisions of a file, with another revision as ancestor.
;;;***
-;;;### (autoloads nil "enriched" "textmodes/enriched.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "enriched" "textmodes/enriched.el" (21691 38459
+;;;;;; 74604 918000))
;;; Generated autoloads from textmodes/enriched.el
(autoload 'enriched-mode "enriched" "\
@@ -8366,7 +8400,7 @@ if ARG is omitted or nil.
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
-etc/enriched.doc in the Emacs distribution directory.
+\"enriched.txt\" in `data-directory'.
Commands:
@@ -8386,7 +8420,7 @@ Commands:
;;;***
-;;;### (autoloads nil "epa" "epa.el" (20917 42917 611340 0))
+;;;### (autoloads nil "epa" "epa.el" (21980 16567 517544 893000))
;;; Generated autoloads from epa.el
(autoload 'epa-list-keys "epa" "\
@@ -8448,10 +8482,10 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-decrypt-string context (buffer-substring start end))
- 'utf-8))
+ \\='utf-8))
\(fn START END &optional MAKE-BUFFER-FUNCTION)" t nil)
@@ -8463,6 +8497,8 @@ See the reason described in the `epa-decrypt-region' documentation.
\(fn START END)" t nil)
+(function-put 'epa-decrypt-armor-in-region 'interactive-only 't)
+
(autoload 'epa-verify-region "epa" "\
Verify the current region between START and END.
@@ -8476,13 +8512,15 @@ should consider using the string based counterpart
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(decode-coding-string
(epg-verify-string context (buffer-substring start end))
- 'utf-8))
+ \\='utf-8))
\(fn START END)" t nil)
+(function-put 'epa-verify-region 'interactive-only 't)
+
(autoload 'epa-verify-cleartext-in-region "epa" "\
Verify OpenPGP cleartext signed messages in the current region
between START and END.
@@ -8492,6 +8530,8 @@ See the reason described in the `epa-verify-region' documentation.
\(fn START END)" t nil)
+(function-put 'epa-verify-cleartext-in-region 'interactive-only 't)
+
(autoload 'epa-sign-region "epa" "\
Sign the current region between START and END by SIGNERS keys selected.
@@ -8504,13 +8544,15 @@ based counterpart `epg-sign-file' instead.
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(epg-sign-string
context
- (encode-coding-string (buffer-substring start end) 'utf-8)))
+ (encode-coding-string (buffer-substring start end) \\='utf-8)))
\(fn START END SIGNERS MODE)" t nil)
+(function-put 'epa-sign-region 'interactive-only 't)
+
(autoload 'epa-encrypt-region "epa" "\
Encrypt the current region between START and END for RECIPIENTS.
@@ -8523,14 +8565,16 @@ file based counterpart `epg-encrypt-file' instead.
For example:
-\(let ((context (epg-make-context 'OpenPGP)))
+\(let ((context (epg-make-context \\='OpenPGP)))
(epg-encrypt-string
context
- (encode-coding-string (buffer-substring start end) 'utf-8)
+ (encode-coding-string (buffer-substring start end) \\='utf-8)
nil))
\(fn START END RECIPIENTS SIGN SIGNERS)" t nil)
+(function-put 'epa-encrypt-region 'interactive-only 't)
+
(autoload 'epa-delete-keys "epa" "\
Delete selected KEYS.
@@ -8564,8 +8608,8 @@ Insert selected KEYS after the point.
;;;***
-;;;### (autoloads nil "epa-dired" "epa-dired.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "epa-dired" "epa-dired.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from epa-dired.el
(autoload 'epa-dired-do-decrypt "epa-dired" "\
@@ -8590,8 +8634,8 @@ Encrypt marked files.
;;;***
-;;;### (autoloads nil "epa-file" "epa-file.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "epa-file" "epa-file.el" (21964 28338 113695
+;;;;;; 749000))
;;; Generated autoloads from epa-file.el
(autoload 'epa-file-handler "epa-file" "\
@@ -8611,8 +8655,8 @@ Encrypt marked files.
;;;***
-;;;### (autoloads nil "epa-mail" "epa-mail.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "epa-mail" "epa-mail.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from epa-mail.el
(autoload 'epa-mail-mode "epa-mail" "\
@@ -8627,42 +8671,49 @@ if ARG is omitted or nil.
Decrypt OpenPGP armors in the current buffer.
The buffer is expected to contain a mail message.
-Don't use this command in Lisp programs!
-
\(fn)" t nil)
+(function-put 'epa-mail-decrypt 'interactive-only 't)
+
(autoload 'epa-mail-verify "epa-mail" "\
Verify OpenPGP cleartext signed messages in the current buffer.
The buffer is expected to contain a mail message.
-Don't use this command in Lisp programs!
-
\(fn)" t nil)
+(function-put 'epa-mail-verify 'interactive-only 't)
+
(autoload 'epa-mail-sign "epa-mail" "\
Sign the current buffer.
The buffer is expected to contain a mail message.
-Don't use this command in Lisp programs!
-
\(fn START END SIGNERS MODE)" t nil)
+(function-put 'epa-mail-sign 'interactive-only 't)
+
(autoload 'epa-mail-encrypt "epa-mail" "\
-Encrypt the current buffer.
-The buffer is expected to contain a mail message.
+Encrypt the outgoing mail message in the current buffer.
+Takes the recipients from the text in the header in the buffer
+and translates them through `epa-mail-aliases'.
+With prefix argument, asks you to select among them interactively
+and also whether and how to sign.
-Don't use this command in Lisp programs!
+Called from Lisp, the optional argument RECIPIENTS is a list
+of recipient addresses, t to perform symmetric encryption,
+or nil meaning use the defaults.
-\(fn START END RECIPIENTS SIGN SIGNERS)" t nil)
+SIGNERS is a list of keys to sign the message with.
+
+\(fn &optional RECIPIENTS SIGNERS)" t nil)
(autoload 'epa-mail-import-keys "epa-mail" "\
Import keys in the OpenPGP armor format in the current buffer.
The buffer is expected to contain a mail message.
-Don't use this command in Lisp programs!
-
\(fn)" t nil)
+(function-put 'epa-mail-import-keys 'interactive-only 't)
+
(defvar epa-global-mail-mode nil "\
Non-nil if Epa-Global-Mail mode is enabled.
See the command `epa-global-mail-mode' for a description of this minor mode.
@@ -8682,9 +8733,10 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "epg" "epg.el" (20936 7342 261759 0))
+;;;### (autoloads nil "epg" "epg.el" (22011 58553 461858 469000))
;;; Generated autoloads from epg.el
-(push (purecopy (quote (epg 1 0 0))) package--builtin-versions)
+(push (purecopy '(epg 1 0 0)) package--builtin-versions)
+
(autoload 'epg-make-context "epg" "\
Return a context object.
@@ -8692,8 +8744,8 @@ Return a context object.
;;;***
-;;;### (autoloads nil "epg-config" "epg-config.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "epg-config" "epg-config.el" (21927 33969 780642
+;;;;;; 720000))
;;; Generated autoloads from epg-config.el
(autoload 'epg-configuration "epg-config" "\
@@ -8713,9 +8765,10 @@ Look at CONFIG and try to expand GROUP.
;;;***
-;;;### (autoloads nil "erc" "erc/erc.el" (20891 18859 893295 0))
+;;;### (autoloads nil "erc" "erc/erc.el" (22011 58553 477858 469000))
;;; Generated autoloads from erc/erc.el
-(push (purecopy (quote (erc 5 3))) package--builtin-versions)
+(push (purecopy '(erc 5 3)) package--builtin-versions)
+
(autoload 'erc-select-read-args "erc" "\
Prompt the user for values of nick, server, port, and password.
@@ -8742,7 +8795,7 @@ 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
be invoked for the values of the other parameters.
-\(fn &key (server (erc-compute-server)) (port (erc-compute-port)) (nick (erc-compute-nick)) PASSWORD (full-name (erc-compute-full-name)))" t nil)
+\(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)))" t nil)
(defalias 'erc-select 'erc)
@@ -8761,36 +8814,36 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;***
-;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (21989
+;;;;;; 31537 763825 721000))
;;; Generated autoloads from erc/erc-autoaway.el
(autoload 'erc-autoaway-mode "erc-autoaway")
;;;***
-;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-button" "erc/erc-button.el" (21998 46517
+;;;;;; 30024 649000))
;;; Generated autoloads from erc/erc-button.el
(autoload 'erc-button-mode "erc-button" nil t)
;;;***
-;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-capab.el
(autoload 'erc-capab-identify-mode "erc-capab" nil t)
;;;***
-;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-compat.el
(autoload 'erc-define-minor-mode "erc-compat")
;;;***
-;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (20759 33211 414988
-;;;;;; 0))
+;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (21998 46517 30024
+;;;;;; 649000))
;;; Generated autoloads from erc/erc-dcc.el
(autoload 'erc-dcc-mode "erc-dcc")
@@ -8820,14 +8873,14 @@ that subcommand.
;;;***
;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el"
-;;;;;; (20874 65006 176325 548000))
+;;;;;; (21670 32330 885624 725000))
;;; Generated autoloads from erc/erc-desktop-notifications.el
(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
;;;***
-;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (21855
+;;;;;; 576 787951 155000))
;;; Generated autoloads from erc/erc-ezbounce.el
(autoload 'erc-cmd-ezb "erc-ezbounce" "\
@@ -8838,7 +8891,7 @@ Send EZB commands to the EZBouncer verbatim.
(autoload 'erc-ezb-get-login "erc-ezbounce" "\
Return an appropriate EZBounce login for SERVER and PORT.
Look up entries in `erc-ezb-login-alist'. If the username or password
-in the alist is `nil', prompt for the appropriate values.
+in the alist is nil, prompt for the appropriate values.
\(fn SERVER PORT)" nil nil)
@@ -8889,8 +8942,8 @@ Add EZBouncer convenience functions to ERC.
;;;***
-;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (21989 31537 771825
+;;;;;; 721000))
;;; Generated autoloads from erc/erc-fill.el
(autoload 'erc-fill-mode "erc-fill" nil t)
@@ -8902,8 +8955,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'.
;;;***
-;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-identd.el
(autoload 'erc-identd-mode "erc-identd")
@@ -8924,8 +8977,8 @@ system.
;;;***
-;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-imenu.el
(autoload 'erc-create-imenu-index "erc-imenu" "\
@@ -8935,28 +8988,22 @@ system.
;;;***
-;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "erc-join" "erc/erc-join.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-join.el
(autoload 'erc-autojoin-mode "erc-join" nil t)
;;;***
-;;;### (autoloads nil "erc-lang" "erc/erc-lang.el" (20709 26818 907104
-;;;;;; 0))
-;;; Generated autoloads from erc/erc-lang.el
-(push (purecopy (quote (erc-lang 1 0 0))) package--builtin-versions)
-;;;***
-
-;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20884 7264 412929
-;;;;;; 442000))
+;;;### (autoloads nil "erc-list" "erc/erc-list.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-list.el
-(push (purecopy (quote (erc-list 0 1))) package--builtin-versions) (autoload 'erc-list-mode "erc-list")
+ (autoload 'erc-list-mode "erc-list")
;;;***
-;;;### (autoloads nil "erc-log" "erc/erc-log.el" (20891 18859 893295
-;;;;;; 0))
+;;;### (autoloads nil "erc-log" "erc/erc-log.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-log.el
(autoload 'erc-log-mode "erc-log" nil t)
@@ -8985,8 +9032,8 @@ You can save every individual message by putting this function on
;;;***
-;;;### (autoloads nil "erc-match" "erc/erc-match.el" (20763 30266
-;;;;;; 231060 0))
+;;;### (autoloads nil "erc-match" "erc/erc-match.el" (22011 58553
+;;;;;; 461858 469000))
;;; Generated autoloads from erc/erc-match.el
(autoload 'erc-match-mode "erc-match")
@@ -9032,15 +9079,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'.
;;;***
-;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20884 7264 412929
-;;;;;; 442000))
+;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-menu.el
(autoload 'erc-menu-mode "erc-menu" nil t)
;;;***
-;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from erc/erc-netsplit.el
(autoload 'erc-netsplit-mode "erc-netsplit")
@@ -9051,8 +9098,8 @@ Show who's gone.
;;;***
-;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (22011
+;;;;;; 58553 473858 469000))
;;; Generated autoloads from erc/erc-networks.el
(autoload 'erc-determine-network "erc-networks" "\
@@ -9069,8 +9116,8 @@ Interactively select a server to connect to using `erc-server-alist'.
;;;***
-;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (20891 18859
-;;;;;; 893295 0))
+;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-notify.el
(autoload 'erc-notify-mode "erc-notify" nil t)
@@ -9088,36 +9135,36 @@ with args, toggle notify status of people.
;;;***
-;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "erc-page" "erc/erc-page.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-page.el
(autoload 'erc-page-mode "erc-page")
;;;***
-;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (21855
+;;;;;; 576 787951 155000))
;;; Generated autoloads from erc/erc-pcomplete.el
(autoload 'erc-completion-mode "erc-pcomplete" nil t)
;;;***
-;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-replace.el
(autoload 'erc-replace-mode "erc-replace")
;;;***
-;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20884 7264 412929
-;;;;;; 442000))
+;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-ring.el
(autoload 'erc-ring-mode "erc-ring" nil t)
;;;***
-;;;### (autoloads nil "erc-services" "erc/erc-services.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-services" "erc/erc-services.el" (22011
+;;;;;; 58553 473858 469000))
;;; Generated autoloads from erc/erc-services.el
(autoload 'erc-services-mode "erc-services" nil t)
@@ -9134,15 +9181,15 @@ When called interactively, read the password using `read-passwd'.
;;;***
-;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from erc/erc-sound.el
(autoload 'erc-sound-mode "erc-sound")
;;;***
-;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (21980
+;;;;;; 16567 521544 893000))
;;; Generated autoloads from erc/erc-speedbar.el
(autoload 'erc-speedbar-browser "erc-speedbar" "\
@@ -9153,22 +9200,22 @@ This will add a speedbar major display mode.
;;;***
-;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21727
+;;;;;; 11963 635339 992000))
;;; Generated autoloads from erc/erc-spelling.el
(autoload 'erc-spelling-mode "erc-spelling" nil t)
;;;***
-;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (21860 18496
+;;;;;; 27951 644000))
;;; Generated autoloads from erc/erc-stamp.el
(autoload 'erc-timestamp-mode "erc-stamp" nil t)
;;;***
-;;;### (autoloads nil "erc-track" "erc/erc-track.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "erc-track" "erc/erc-track.el" (21980 16567
+;;;;;; 521544 893000))
;;; Generated autoloads from erc/erc-track.el
(defvar erc-track-minor-mode nil "\
@@ -9193,8 +9240,8 @@ keybindings will not do anything useful.
;;;***
-;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from erc/erc-truncate.el
(autoload 'erc-truncate-mode "erc-truncate" nil t)
@@ -9213,8 +9260,8 @@ Meant to be used in hooks, like `erc-insert-post-hook'.
;;;***
-;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from erc/erc-xdcc.el
(autoload 'erc-xdcc-mode "erc-xdcc")
@@ -9225,8 +9272,8 @@ Add a file to `erc-xdcc-files'.
;;;***
-;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (20834 39208 838628
-;;;;;; 0))
+;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (22011 58553 409858
+;;;;;; 469000))
;;; Generated autoloads from emacs-lisp/ert.el
(autoload 'ert-deftest "ert" "\
@@ -9235,8 +9282,8 @@ Define NAME (a symbol) as a test.
BODY is evaluated as a `progn' when the test is run. It should
signal a condition on failure or just return if the test passes.
-`should', `should-not' and `should-error' are useful for
-assertions in BODY.
+`should', `should-not', `should-error' and `skip-unless' are
+useful for assertions in BODY.
Use `ert' to run tests interactively.
@@ -9244,7 +9291,11 @@ Tests that are expected to fail can be marked as such
using :expected-result. See `ert-test-result-type-p' for a
description of valid values for RESULT-TYPE.
-\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil (quote macro))
+\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil t)
+
+(function-put 'ert-deftest 'doc-string-elt '3)
+
+(function-put 'ert-deftest 'lisp-indent-function '2)
(put 'ert-deftest 'lisp-indent-function 2)
@@ -9291,8 +9342,8 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test).
;;;***
-;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (22011 58553
+;;;;;; 393858 469000))
;;; Generated autoloads from emacs-lisp/ert-x.el
(put 'ert-with-test-buffer 'lisp-indent-function 1)
@@ -9304,23 +9355,22 @@ Kill all test buffers that are still live.
;;;***
-;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (20911 4138
-;;;;;; 279475 0))
+;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (22003 64432
+;;;;;; 600146 533000))
;;; Generated autoloads from eshell/esh-mode.el
(autoload 'eshell-mode "esh-mode" "\
Emacs shell interactive mode.
-\\{eshell-mode-map}
-
-\(fn)" nil nil)
+\(fn)" t nil)
;;;***
-;;;### (autoloads nil "eshell" "eshell/eshell.el" (20893 60586 188550
-;;;;;; 0))
+;;;### (autoloads nil "eshell" "eshell/eshell.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from eshell/eshell.el
-(push (purecopy (quote (eshell 2 4 2))) package--builtin-versions)
+(push (purecopy '(eshell 2 4 2)) package--builtin-versions)
+
(autoload 'eshell "eshell" "\
Create an interactive Eshell buffer.
The buffer used for Eshell sessions is determined by the value of
@@ -9352,8 +9402,8 @@ corresponding to a successful execution.
;;;***
-;;;### (autoloads nil "etags" "progmodes/etags.el" (20731 53823 676680
-;;;;;; 0))
+;;;### (autoloads nil "etags" "progmodes/etags.el" (21998 46517 206024
+;;;;;; 649000))
;;; Generated autoloads from progmodes/etags.el
(defvar tags-file-name nil "\
@@ -9446,6 +9496,11 @@ as they appeared in the `etags' command that created the table, usually
without directory names.
\(fn)" nil nil)
+
+(autoload 'tags-lazy-completion-table "etags" "\
+
+
+\(fn)" nil nil)
(defun tags-completion-at-point-function ()
(if (or tags-table-list tags-file-name)
(progn
@@ -9494,7 +9549,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
- (define-key esc-map "." 'find-tag)
+
+(make-obsolete 'find-tag 'xref-find-definitions '"25.1")
(autoload 'find-tag-other-window "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
@@ -9517,7 +9573,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
\(fn TAGNAME &optional NEXT-P REGEXP-P)" t nil)
- (define-key ctl-x-4-map "." 'find-tag-other-window)
+
+(make-obsolete 'find-tag-other-window 'xref-find-definitions-other-window '"25.1")
(autoload 'find-tag-other-frame "etags" "\
Find tag (in current tags table) whose name contains TAGNAME.
@@ -9540,7 +9597,8 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
\(fn TAGNAME &optional NEXT-P)" t nil)
- (define-key ctl-x-5-map "." 'find-tag-other-frame)
+
+(make-obsolete 'find-tag-other-frame 'xref-find-definitions-other-frame '"25.1")
(autoload 'find-tag-regexp "etags" "\
Find tag (in current tags table) whose name matches REGEXP.
@@ -9561,17 +9619,10 @@ Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'.
\(fn REGEXP &optional NEXT-P OTHER-WINDOW)" t nil)
- (define-key esc-map [?\C-.] 'find-tag-regexp)
- (define-key esc-map "*" 'pop-tag-mark)
-
-(autoload 'pop-tag-mark "etags" "\
-Pop back to where \\[find-tag] was last invoked.
-This is distinct from invoking \\[find-tag] with a negative argument
-since that pops a stack of markers at which tags were found, not from
-where they were found.
+(make-obsolete 'find-tag-regexp 'xref-find-apropos '"25.1")
-\(fn)" t nil)
+(defalias 'pop-tag-mark 'xref-pop-marker-stack)
(autoload 'next-file "etags" "\
Select next file among files in current tags table.
@@ -9600,7 +9651,8 @@ evaluate to operate on an interesting file. If the latter evaluates to
nil, we exit; otherwise we scan the next file.
\(fn &optional FIRST-TIME)" t nil)
- (define-key esc-map "," 'tags-loop-continue)
+
+(make-obsolete 'tags-loop-continue '"use `xref-find-definitions' interface instead." '"25.1")
(autoload 'tags-search "etags" "\
Search through all files listed in tags table for match for REGEXP.
@@ -9644,6 +9696,8 @@ Display list of all tags in tags table REGEXP matches.
\(fn REGEXP)" t nil)
+(make-obsolete 'tags-apropos 'xref-find-apropos '"25.1")
+
(autoload 'select-tags-table "etags" "\
Select a tags table file from a menu of those you have already used.
The list of tags tables to select from is stored in `tags-table-set-list';
@@ -9659,10 +9713,15 @@ for \\[find-tag] (which see).
\(fn)" t nil)
+(autoload 'etags-xref-find "etags" "\
+
+
+\(fn ACTION ID)" nil nil)
+
;;;***
-;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (21862
+;;;;;; 60209 768658 443000))
;;; Generated autoloads from language/ethio-util.el
(autoload 'setup-ethiopic-environment-internal "ethio-util" "\
@@ -9830,7 +9889,7 @@ With ARG, insert that many delimiters.
;;;***
-;;;### (autoloads nil "eudc" "net/eudc.el" (20791 9657 561026 0))
+;;;### (autoloads nil "eudc" "net/eudc.el" (22026 25907 611502 692000))
;;; Generated autoloads from net/eudc.el
(autoload 'eudc-set-server "eudc" "\
@@ -9884,8 +9943,8 @@ This does nothing except loading eudc by autoload side-effect.
;;;***
-;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (20791 9657 561026
-;;;;;; 0))
+;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (22026 25907 607502
+;;;;;; 692000))
;;; Generated autoloads from net/eudc-bob.el
(autoload 'eudc-display-generic-binary "eudc-bob" "\
@@ -9920,8 +9979,8 @@ Display a button for the JPEG DATA.
;;;***
-;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (20871 33574
-;;;;;; 214287 0))
+;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (22026 25907
+;;;;;; 607502 692000))
;;; Generated autoloads from net/eudc-export.el
(autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\
@@ -9937,8 +9996,8 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record.
;;;***
-;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (20791
-;;;;;; 9657 561026 0))
+;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (22026
+;;;;;; 25907 607502 692000))
;;; Generated autoloads from net/eudc-hotlist.el
(autoload 'eudc-edit-hotlist "eudc-hotlist" "\
@@ -9948,8 +10007,8 @@ Edit the hotlist of directory servers in a specialized buffer.
;;;***
-;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -9975,30 +10034,55 @@ fourth arg NOSEP non-nil inhibits this.
;;;***
-;;;### (autoloads nil "eww" "net/eww.el" (20941 25255 50698 0))
+;;;### (autoloads nil "eww" "net/eww.el" (22011 58553 761858 469000))
;;; Generated autoloads from net/eww.el
+(defvar eww-suggest-uris '(eww-links-at-point url-get-url-at-point eww-current-url) "\
+List of functions called to form the list of default URIs for `eww'.
+Each of the elements is a function returning either a string or a list
+of strings. The results will be joined into a single list with
+duplicate entries (if any) removed.")
+
+(custom-autoload 'eww-suggest-uris "eww" t)
+
(autoload 'eww "eww" "\
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'.
\(fn URL)" t nil)
+ (defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
-Render a file using EWW.
+Render FILE using EWW.
\(fn FILE)" t nil)
+(autoload 'eww-search-words "eww" "\
+Search the web for the text between BEG and END.
+See the `eww-search-prefix' variable for the search engine used.
+
+\(fn &optional BEG END)" t nil)
+
+(autoload 'eww-mode "eww" "\
+Mode for browsing the web.
+
+\(fn)" t nil)
+
(autoload 'eww-browse-url "eww" "\
\(fn URL &optional NEW-WINDOW)" nil nil)
+(autoload 'eww-list-bookmarks "eww" "\
+Display the bookmarks.
+
+\(fn)" t nil)
+
;;;***
-;;;### (autoloads nil "executable" "progmodes/executable.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "executable" "progmodes/executable.el" (21988
+;;;;;; 10682 37624 461000))
;;; Generated autoloads from progmodes/executable.el
(autoload 'executable-command-find-posix-p "executable" "\
@@ -10024,12 +10108,6 @@ executable.
\(fn INTERPRETER &optional ARGUMENT NO-QUERY-FLAG INSERT-FLAG)" t nil)
-(autoload 'executable-self-display "executable" "\
-Turn a text file into a self-displaying Un*x command.
-The magic number of such a command displays all lines but itself.
-
-\(fn)" t nil)
-
(autoload 'executable-make-buffer-file-executable-if-script-p "executable" "\
Make file executable according to umask if not already executable.
If file already has any execute bits set at all, do not change existing
@@ -10039,7 +10117,7 @@ file modes.
;;;***
-;;;### (autoloads nil "expand" "expand.el" (20709 26818 907104 0))
+;;;### (autoloads nil "expand" "expand.el" (22011 58553 477858 469000))
;;; Generated autoloads from expand.el
(autoload 'expand-add-abbrevs "expand" "\
@@ -10088,8 +10166,8 @@ This is used only in conjunction with `expand-add-abbrevs'.
;;;***
-;;;### (autoloads nil "f90" "progmodes/f90.el" (20886 939 575794
-;;;;;; 0))
+;;;### (autoloads nil "f90" "progmodes/f90.el" (22026 25907 635502
+;;;;;; 692000))
;;; Generated autoloads from progmodes/f90.el
(autoload 'f90-mode "f90" "\
@@ -10100,7 +10178,7 @@ For fixed format code, use `fortran-mode'.
\\[f90-indent-new-line] indents current line and creates a new indented line.
\\[f90-indent-subprogram] indents the current subprogram.
-Type `? or `\\[help-command] to display a list of built-in abbrevs for F90 keywords.
+Type \\=`? or \\=`\\[help-command] to display a list of built-in abbrevs for F90 keywords.
Key definitions:
\\{f90-mode-map}
@@ -10138,7 +10216,7 @@ Variables controlling indentation style and extra features:
Non-nil causes `f90-do-auto-fill' to break lines before delimiters
(default t).
`f90-beginning-ampersand'
- Automatic insertion of & at beginning of continuation lines (default t).
+ Automatic insertion of `&' at beginning of continuation lines (default t).
`f90-smart-end'
From an END statement, check and fill the end using matching block start.
Allowed values are `blink', `no-blink', and nil, which determine
@@ -10156,8 +10234,8 @@ with no args, if that value is non-nil.
;;;***
-;;;### (autoloads nil "face-remap" "face-remap.el" (20928 40842 890989
-;;;;;; 0))
+;;;### (autoloads nil "face-remap" "face-remap.el" (21888 47150 706945
+;;;;;; 440000))
;;; Generated autoloads from face-remap.el
(autoload 'face-remap-add-relative "face-remap" "\
@@ -10202,7 +10280,7 @@ of face attribute/value pairs, like in a `face' text property.
If SPECS is empty, call `face-remap-reset-base' to use the normal
definition of FACE as the base remapping; note that this is
-different from SPECS containing a single value `nil', which means
+different from SPECS containing a single value nil, which means
not to inherit from the global definition of FACE at all.
\(fn FACE &rest SPECS)" nil nil)
@@ -10251,11 +10329,9 @@ key-binding used to invoke the command, with all modifiers removed:
- Decrease the default face height by one step
0 Reset the default face height to the global default
-When adjusting with `+' or `-', continue to read input events and
-further adjust the face height as long as the input event read
-\(with all modifiers removed) is `+' or `-'.
-
-When adjusting with `0', immediately finish.
+After adjusting, continue to read input events and further adjust
+the face height as long as the input event read
+\(with all modifiers removed) is one of the above characters.
Each step scales the height of the default face by the variable
`text-scale-mode-step' (a negative number of steps decreases the
@@ -10318,10 +10394,11 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
;;;***
-;;;### (autoloads nil "feedmail" "mail/feedmail.el" (20891 18859
-;;;;;; 893295 0))
+;;;### (autoloads nil "feedmail" "mail/feedmail.el" (22011 58553
+;;;;;; 677858 469000))
;;; Generated autoloads from mail/feedmail.el
-(push (purecopy (quote (feedmail 11))) package--builtin-versions)
+(push (purecopy '(feedmail 11)) package--builtin-versions)
+
(autoload 'feedmail-send-it "feedmail" "\
Send the current mail buffer using the Feedmail package.
This is a suitable value for `send-mail-function'. It can be used
@@ -10372,14 +10449,14 @@ you can set `feedmail-queue-reminder-alist' to nil.
;;;***
-;;;### (autoloads nil "ffap" "ffap.el" (20752 26669 524456 0))
+;;;### (autoloads nil "ffap" "ffap.el" (21993 28596 82597 473000))
;;; Generated autoloads from ffap.el
(autoload 'ffap-next "ffap" "\
Search buffer for next file or URL, and run ffap.
Optional argument BACK says to search backwards.
Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
+Interactively: use a single prefix \\[universal-argument] to search backwards,
double prefix to wrap forward, triple to wrap backwards.
Actual search is done by the function `ffap-next-guess'.
@@ -10435,8 +10512,8 @@ Evaluate the forms in variable `ffap-bindings'.
;;;***
-;;;### (autoloads nil "filecache" "filecache.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "filecache" "filecache.el" (21740 23998 26747
+;;;;;; 125000))
;;; Generated autoloads from filecache.el
(autoload 'file-cache-add-directory "filecache" "\
@@ -10493,8 +10570,23 @@ the name is considered already unique; only the second substitution
;;;***
-;;;### (autoloads nil "files-x" "files-x.el" (20938 49065 383398
-;;;;;; 0))
+;;;### (autoloads nil "filenotify" "filenotify.el" (22019 52657 867929
+;;;;;; 676000))
+;;; Generated autoloads from filenotify.el
+
+(autoload 'file-notify-handle-event "filenotify" "\
+Handle file system monitoring event.
+If EVENT is a filewatch event, call its callback. It has the format
+
+ (file-notify (DESCRIPTOR ACTIONS FILE [FILE1-OR-COOKIE]) CALLBACK)
+
+Otherwise, signal a `file-notify-error'.
+
+\(fn EVENT)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "files-x" "files-x.el" (21998 46517 38024 649000))
;;; Generated autoloads from files-x.el
(autoload 'add-file-local-variable "files-x" "\
@@ -10559,8 +10651,8 @@ Copy directory-local variables to the -*- line.
;;;***
-;;;### (autoloads nil "filesets" "filesets.el" (20791 9657 561026
-;;;;;; 0))
+;;;### (autoloads nil "filesets" "filesets.el" (22026 25907 587502
+;;;;;; 692000))
;;; Generated autoloads from filesets.el
(autoload 'filesets-init "filesets" "\
@@ -10571,16 +10663,17 @@ Set up hooks, load the cache file -- if existing -- and build the menu.
;;;***
-;;;### (autoloads nil "find-cmd" "find-cmd.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "find-cmd" "find-cmd.el" (22011 58553 489858
+;;;;;; 469000))
;;; Generated autoloads from find-cmd.el
-(push (purecopy (quote (find-cmd 0 6))) package--builtin-versions)
+(push (purecopy '(find-cmd 0 6)) package--builtin-versions)
+
(autoload 'find-cmd "find-cmd" "\
Initiate the building of a find command.
For example:
-\(find-cmd '(prune (name \".svn\" \".git\" \".CVS\"))
- '(and (or (name \"*.pl\" \"*.pm\" \"*.t\")
+\(find-cmd \\='(prune (name \".svn\" \".git\" \".CVS\"))
+ \\='(and (or (name \"*.pl\" \"*.pm\" \"*.t\")
(mtime \"+1\"))
(fstype \"nfs\" \"ufs\"))))
@@ -10591,8 +10684,8 @@ result is a string that should be ready for the command line.
;;;***
-;;;### (autoloads nil "find-dired" "find-dired.el" (20763 30266 231060
-;;;;;; 0))
+;;;### (autoloads nil "find-dired" "find-dired.el" (22011 58553 489858
+;;;;;; 469000))
;;; Generated autoloads from find-dired.el
(autoload 'find-dired "find-dired" "\
@@ -10608,16 +10701,18 @@ use in place of \"-ls\" as the final argument.
(autoload 'find-name-dired "find-dired" "\
Search DIR recursively for files matching the globbing pattern PATTERN,
-and run dired on those files.
+and run Dired on those files.
PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
-The command run (after changing into DIR) is
+The default command run (after changing into DIR) is
+
+ find . -name \\='PATTERN\\=' -ls
- find . -name 'PATTERN' -ls
+See `find-name-arg' to customize the arguments.
\(fn DIR PATTERN)" t nil)
(autoload 'find-grep-dired "find-dired" "\
-Find files in DIR containing a regexp REGEXP and start Dired on output.
+Find files in DIR matching a regexp REGEXP and start Dired on output.
The command run (after changing into DIR) is
find . \\( -type f -exec `grep-program' `find-grep-options' \\
@@ -10630,8 +10725,8 @@ use in place of \"-ls\" as the final argument.
;;;***
-;;;### (autoloads nil "find-file" "find-file.el" (20872 54440 171355
-;;;;;; 0))
+;;;### (autoloads nil "find-file" "find-file.el" (22011 58553 489858
+;;;;;; 469000))
;;; Generated autoloads from find-file.el
(defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\
@@ -10721,8 +10816,8 @@ Visit the file you click on in another window.
;;;***
-;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (22011
+;;;;;; 58553 409858 469000))
;;; Generated autoloads from emacs-lisp/find-func.el
(autoload 'find-library "find-func" "\
@@ -10863,6 +10958,18 @@ Set mark before moving, if the buffer already existed.
\(fn KEY)" t nil)
+(autoload 'find-function-on-key-other-window "find-func" "\
+Find, in the other window, the function that KEY invokes.
+See `find-function-on-key'.
+
+\(fn KEY)" t nil)
+
+(autoload 'find-function-on-key-other-frame "find-func" "\
+Find, in the other frame, the function that KEY invokes.
+See `find-function-on-key'.
+
+\(fn KEY)" t nil)
+
(autoload 'find-function-at-point "find-func" "\
Find directly the function at point in the other window.
@@ -10880,8 +10987,8 @@ Define some key bindings for the find-function family of functions.
;;;***
-;;;### (autoloads nil "find-lisp" "find-lisp.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "find-lisp" "find-lisp.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from find-lisp.el
(autoload 'find-lisp-find-dired "find-lisp" "\
@@ -10895,15 +11002,16 @@ Find all subdirectories of DIR.
\(fn DIR)" t nil)
(autoload 'find-lisp-find-dired-filter "find-lisp" "\
-Change the filter on a find-lisp-find-dired buffer to REGEXP.
+Change the filter on a `find-lisp-find-dired' buffer to REGEXP.
\(fn REGEXP)" t nil)
;;;***
-;;;### (autoloads nil "finder" "finder.el" (20925 37032 237257 0))
+;;;### (autoloads nil "finder" "finder.el" (21998 46517 46024 649000))
;;; Generated autoloads from finder.el
-(push (purecopy (quote (finder 1 0))) package--builtin-versions)
+(push (purecopy '(finder 1 0)) package--builtin-versions)
+
(autoload 'finder-list-keywords "finder" "\
Display descriptions of the keywords in the Finder buffer.
@@ -10922,8 +11030,8 @@ Find packages matching a given keyword.
;;;***
-;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from flow-ctrl.el
(autoload 'enable-flow-control "flow-ctrl" "\
@@ -10944,8 +11052,8 @@ to get the effect of a C-q.
;;;***
-;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/flow-fill.el
(autoload 'fill-flowed-encode "flow-fill" "\
@@ -10960,15 +11068,17 @@ to get the effect of a C-q.
;;;***
-;;;### (autoloads nil "flymake" "progmodes/flymake.el" (20932 61699
-;;;;;; 522706 0))
+;;;### (autoloads nil "flymake" "progmodes/flymake.el" (22011 58553
+;;;;;; 901858 469000))
;;; Generated autoloads from progmodes/flymake.el
-(push (purecopy (quote (flymake 0 3))) package--builtin-versions)
+(push (purecopy '(flymake 0 3)) package--builtin-versions)
+
(autoload 'flymake-mode "flymake" "\
-Toggle on-the-fly syntax checking.
-With a prefix argument ARG, enable the mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
+Toggle Flymake mode on or off.
+With a prefix argument ARG, enable Flymake mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{flymake-mode-map}
\(fn &optional ARG)" t nil)
@@ -10989,8 +11099,8 @@ Turn flymake mode off.
;;;***
-;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (20847 51240
-;;;;;; 240216 0))
+;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21980 16568
+;;;;;; 77544 893000))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
@@ -11025,7 +11135,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 (function (lambda () (setq ispell-parser \\='tex))))
in your init file.
\\[flyspell-region] checks all words inside a region.
@@ -11060,13 +11170,14 @@ Flyspell whole buffer.
;;;***
-;;;### (autoloads nil "foldout" "foldout.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "foldout" "foldout.el" (22011 58553 513858
+;;;;;; 469000))
;;; Generated autoloads from foldout.el
-(push (purecopy (quote (foldout 1 10))) package--builtin-versions)
+(push (purecopy '(foldout 1 10)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "follow" "follow.el" (20709 26818 907104 0))
+;;;### (autoloads nil "follow" "follow.el" (22023 49716 552634 164000))
;;; Generated autoloads from follow.el
(autoload 'turn-on-follow-mode "follow" "\
@@ -11092,7 +11203,7 @@ virtual window. This is accomplished by two main techniques:
This means that whenever one window is moved, all the
others will follow. (Hence the name Follow mode.)
-* Should the point (cursor) end up outside a window, another
+* Should point (cursor) end up outside a window, another
window displaying that point is selected, if possible. This
makes it possible to walk between windows using normal cursor
movement commands.
@@ -11105,7 +11216,7 @@ and being able to use 144 lines instead of the normal 72... (your
mileage may vary).
To split one large window into two side-by-side windows, the commands
-`\\[split-window-right]' or `M-x follow-delete-other-windows-and-split' can be used.
+`\\[split-window-right]' or `\\[follow-delete-other-windows-and-split]' can be used.
Only windows displayed in the same frame follow each other.
@@ -11116,6 +11227,32 @@ Keys specific to Follow mode:
\(fn &optional ARG)" t nil)
+(autoload 'follow-scroll-up "follow" "\
+Scroll text in a Follow mode window chain up.
+
+If called with no ARG, the `next-screen-context-lines' last lines of
+the bottom window in the chain will be visible in the top window.
+
+If called with an argument, scroll ARG lines up.
+Negative ARG means scroll downward.
+
+Works like `scroll-up' when not in Follow mode.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'follow-scroll-down "follow" "\
+Scroll text in a Follow mode window chain down.
+
+If called with no ARG, the `next-screen-context-lines' top lines of
+the top window in the chain will be visible in the bottom window.
+
+If called with an argument, scroll ARG lines down.
+Negative ARG means scroll upward.
+
+Works like `scroll-down' when not in Follow mode.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'follow-delete-other-windows-and-split "follow" "\
Create two side by side windows and enter Follow mode.
@@ -11134,10 +11271,11 @@ selected if the original window is the first one in the frame.
;;;***
-;;;### (autoloads nil "footnote" "mail/footnote.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "footnote" "mail/footnote.el" (22026 25907
+;;;;;; 595502 692000))
;;; Generated autoloads from mail/footnote.el
-(push (purecopy (quote (footnote 0 19))) package--builtin-versions)
+(push (purecopy '(footnote 0 19)) package--builtin-versions)
+
(autoload 'footnote-mode "footnote" "\
Toggle Footnote mode.
With a prefix argument ARG, enable Footnote mode if ARG is
@@ -11153,7 +11291,7 @@ play around with the following keys:
;;;***
-;;;### (autoloads nil "forms" "forms.el" (20709 26818 907104 0))
+;;;### (autoloads nil "forms" "forms.el" (21981 37426 535399 97000))
;;; Generated autoloads from forms.el
(autoload 'forms-mode "forms" "\
@@ -11189,8 +11327,8 @@ Visit a file in Forms mode in other window.
;;;***
-;;;### (autoloads nil "fortran" "progmodes/fortran.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "fortran" "progmodes/fortran.el" (22011 58553
+;;;;;; 901858 469000))
;;; Generated autoloads from progmodes/fortran.el
(autoload 'fortran-mode "fortran" "\
@@ -11222,15 +11360,15 @@ Variables controlling indentation style and extra features:
Amount of extra indentation for text in full-line comments (default 0).
`fortran-comment-indent-style'
How to indent the text in full-line comments. Allowed values are:
- nil don't change the indentation
- fixed indent to `fortran-comment-line-extra-indent' beyond the
+ nil don't change the indentation
+ `fixed' indent to `fortran-comment-line-extra-indent' beyond the
value of either
`fortran-minimum-statement-indent-fixed' (fixed format) or
`fortran-minimum-statement-indent-tab' (TAB format),
depending on the continuation format in use.
- relative indent to `fortran-comment-line-extra-indent' beyond the
+ `relative' indent to `fortran-comment-line-extra-indent' beyond the
indentation for a line of code.
- (default 'fixed)
+ (default `fixed')
`fortran-comment-indent-char'
Single-character string to be inserted instead of space for
full-line comment indentation (default \" \").
@@ -11267,8 +11405,8 @@ with no args, if that value is non-nil.
;;;***
-;;;### (autoloads nil "fortune" "play/fortune.el" (20765 36517 595445
-;;;;;; 191000))
+;;;### (autoloads nil "fortune" "play/fortune.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from play/fortune.el
(autoload 'fortune-add-fortune "fortune" "\
@@ -11316,14 +11454,202 @@ and choose the directory as the fortune-file.
;;;***
-;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (20752 26925
-;;;;;; 124734 677000))
+;;;### (autoloads nil "frameset" "frameset.el" (21799 41766 981374
+;;;;;; 972000))
+;;; Generated autoloads from frameset.el
+
+(defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\
+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) (font . frameset-filter-shelve-param) (foreground-color . frameset-filter-sanitize-color) (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-id . :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.")
+
+(defvar frameset-filter-alist frameset-persistent-filter-alist "\
+Alist of frame parameters and filtering functions.
+
+This alist is the default value of the FILTERS argument of
+`frameset-save' and `frameset-restore' (which see).
+
+Initially, `frameset-filter-alist' is set to, and shares the value of,
+`frameset-persistent-filter-alist'. You can override any item in
+this alist by `push'ing a new item onto it. If, for some reason, you
+intend to modify existing values, do
+
+ (setq frameset-filter-alist (copy-tree frameset-filter-alist))
+
+before changing anything.
+
+On saving, PARAMETERS is the parameter alist of each frame processed,
+and FILTERED is the parameter alist that gets saved to the frameset.
+
+On restoring, PARAMETERS is the parameter alist extracted from the
+frameset, and FILTERED is the resulting frame parameter alist used
+to restore the frame.
+
+Elements of `frameset-filter-alist' are conses (PARAM . ACTION),
+where PARAM is a parameter name (a symbol identifying a frame
+parameter), and ACTION can be:
+
+ nil The parameter is copied to FILTERED.
+ :never The parameter is never copied to FILTERED.
+ :save The parameter is copied only when saving the frame.
+ :restore The parameter is copied only when restoring the frame.
+ FILTER A filter function.
+
+FILTER can be a symbol FILTER-FUN, or a list (FILTER-FUN ARGS...).
+FILTER-FUN is invoked with
+
+ (apply FILTER-FUN CURRENT FILTERED PARAMETERS SAVING ARGS)
+
+where
+
+ CURRENT A cons (PARAM . VALUE), where PARAM is the one being
+ filtered and VALUE is its current value.
+ FILTERED The resulting alist (so far).
+ PARAMETERS The complete alist of parameters being filtered,
+ SAVING Non-nil if filtering before saving state, nil if filtering
+ before restoring it.
+ ARGS Any additional arguments specified in the ACTION.
+
+FILTER-FUN is allowed to modify items in FILTERED, but no other arguments.
+It must return:
+ nil Skip CURRENT (do not add it to FILTERED).
+ t Add CURRENT to FILTERED as is.
+ (NEW-PARAM . NEW-VALUE) Add this to FILTERED instead of CURRENT.
+
+Frame parameters not on this alist are passed intact, as if they were
+defined with ACTION = nil.")
+
+(autoload 'frameset-frame-id "frameset" "\
+Return the frame id of FRAME, if it has one; else, return nil.
+A frame id is a string that uniquely identifies a frame.
+It is persistent across `frameset-save' / `frameset-restore'
+invocations, and once assigned is never changed unless the same
+frame is duplicated (via `frameset-restore'), in which case the
+newest frame keeps the id and the old frame's is set to nil.
+
+\(fn FRAME)" nil nil)
+
+(autoload 'frameset-frame-id-equal-p "frameset" "\
+Return non-nil if FRAME's id matches ID.
+
+\(fn FRAME ID)" nil nil)
+
+(autoload 'frameset-frame-with-id "frameset" "\
+Return the live frame with id ID, if exists; else nil.
+If FRAME-LIST is a list of frames, check these frames only.
+If nil, check all live frames.
+
+\(fn ID &optional FRAME-LIST)" nil nil)
+
+(autoload 'frameset-save "frameset" "\
+Return a frameset for FRAME-LIST, a list of frames.
+Dead frames and non-frame objects are silently removed from the list.
+If nil, FRAME-LIST defaults to the output of `frame-list' (all live frames).
+APP, NAME and DESCRIPTION are optional data; see the docstring of the
+`frameset' defstruct for details.
+FILTERS is an alist of parameter filters; if nil, the value of the variable
+`frameset-filter-alist' is used instead.
+PREDICATE is a predicate function, which must return non-nil for frames that
+should be saved; if PREDICATE is nil, all frames from FRAME-LIST are saved.
+PROPERTIES is a user-defined property list to add to the frameset.
+
+\(fn FRAME-LIST &key APP NAME DESCRIPTION FILTERS PREDICATE PROPERTIES)" nil nil)
+
+(autoload 'frameset-restore "frameset" "\
+Restore a FRAMESET into the current display(s).
+
+PREDICATE is a function called with two arguments, the parameter alist
+and the window-state of the frame being restored, in that order (see
+the docstring of the `frameset' defstruct for additional details).
+If PREDICATE returns nil, the frame described by that parameter alist
+and window-state is not restored.
+
+FILTERS is an alist of parameter filters; if nil, the value of
+`frameset-filter-alist' is used instead.
+
+REUSE-FRAMES selects the policy to reuse frames when restoring:
+ t All existing frames can be reused.
+ nil No existing frame can be reused.
+ match Only frames with matching frame ids can be reused.
+ PRED A predicate function; it receives as argument a live frame,
+ and must return non-nil to allow reusing it, nil otherwise.
+
+FORCE-DISPLAY can be:
+ t Frames are restored in the current display.
+ nil Frames are restored, if possible, in their original displays.
+ delete Frames in other displays are deleted instead of restored.
+ PRED A function called with two arguments, the parameter alist and
+ the window state (in that order). It must return t, nil or
+ `delete', as above but affecting only the frame that will
+ be created from that parameter alist.
+
+FORCE-ONSCREEN can be:
+ t Force onscreen only those frames that are fully offscreen.
+ nil Do not force any frame back onscreen.
+ all Force onscreen any frame fully or partially offscreen.
+ PRED A function called with three arguments,
+ - the live frame just restored,
+ - a list (LEFT TOP WIDTH HEIGHT), describing the frame,
+ - a list (LEFT TOP WIDTH HEIGHT), describing the workarea.
+ It must return non-nil to force the frame onscreen, nil otherwise.
+
+CLEANUP-FRAMES allows to \"clean up\" the frame list after restoring a frameset:
+ t Delete all frames that were not created or restored upon.
+ nil Keep all frames.
+ FUNC A function called with two arguments:
+ - FRAME, a live frame.
+ - ACTION, which can be one of
+ :rejected Frame existed, but was not a candidate for reuse.
+ :ignored Frame existed, was a candidate, but wasn't reused.
+ :reused Frame existed, was a candidate, and restored upon.
+ :created Frame didn't exist, was created and restored upon.
+ Return value is ignored.
+
+Note the timing and scope of the operations described above: REUSE-FRAMES
+affects existing frames; PREDICATE, FILTERS and FORCE-DISPLAY affect the frame
+being restored before that happens; FORCE-ONSCREEN affects the frame once
+it has been restored; and CLEANUP-FRAMES affects all frames alive after the
+restoration, including those that have been reused or created anew.
+
+All keyword parameters default to nil.
+
+\(fn FRAMESET &key PREDICATE FILTERS REUSE-FRAMES FORCE-DISPLAY FORCE-ONSCREEN CLEANUP-FRAMES)" nil nil)
+
+(autoload 'frameset--jump-to-register "frameset" "\
+Restore frameset from DATA stored in register.
+Called from `jump-to-register'. Internal use only.
+
+\(fn DATA)" nil nil)
+
+(autoload 'frameset--print-register "frameset" "\
+Print basic info about frameset stored in DATA.
+Called from `list-registers' and `view-register'. Internal use only.
+
+\(fn DATA)" nil nil)
+
+(autoload 'frameset-to-register "frameset" "\
+Store the current frameset in register REGISTER.
+Use \\[jump-to-register] to restore the frameset.
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'.
+
+\(fn REGISTER)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21720 38720
+;;;;;; 956749 443000))
;;; Generated autoloads from play/gamegrid.el
-(push (purecopy (quote (gamegrid 1 2))) package--builtin-versions)
+(push (purecopy '(gamegrid 1 2)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (20932 61687
-;;;;;; 205708 148000))
+;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (22029 2088
+;;;;;; 514685 339000))
;;; Generated autoloads from progmodes/gdb-mi.el
(defvar gdb-enable-debug nil "\
@@ -11400,8 +11726,8 @@ detailed description of this mode.
;;;***
-;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (20928 13222
-;;;;;; 500272 0))
+;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from emacs-lisp/generic.el
(defvar generic-mode-list nil "\
@@ -11445,9 +11771,9 @@ See the file generic-x.el for some examples of `define-generic-mode'.
\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t)
-(put 'define-generic-mode 'lisp-indent-function '1)
+(function-put 'define-generic-mode 'lisp-indent-function '1)
-(put 'define-generic-mode 'doc-string-elt '7)
+(function-put 'define-generic-mode 'doc-string-elt '7)
(autoload 'generic-mode-internal "generic" "\
Go into the generic mode MODE.
@@ -11481,8 +11807,8 @@ regular expression that can be used as an element of
;;;***
-;;;### (autoloads nil "glasses" "progmodes/glasses.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "glasses" "progmodes/glasses.el" (22011 58553
+;;;;;; 901858 469000))
;;; Generated autoloads from progmodes/glasses.el
(autoload 'glasses-mode "glasses" "\
@@ -11496,8 +11822,8 @@ add virtual separators (like underscores) at places they belong to.
;;;***
-;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (21993 28596
+;;;;;; 86597 473000))
;;; Generated autoloads from gnus/gmm-utils.el
(autoload 'gmm-regexp-concat "gmm-utils" "\
@@ -11551,9 +11877,10 @@ DEFAULT-MAP specifies the default key map for ICON-LIST.
;;;***
-;;;### (autoloads nil "gnus" "gnus/gnus.el" (20901 54695 989166 0))
+;;;### (autoloads nil "gnus" "gnus/gnus.el" (22011 58553 561858 469000))
;;; Generated autoloads from gnus/gnus.el
-(push (purecopy (quote (gnus 5 13))) package--builtin-versions)(when (fboundp 'custom-autoload)
+(push (purecopy '(gnus 5 13)) package--builtin-versions)
+(when (fboundp 'custom-autoload)
(custom-autoload 'gnus-select-method "gnus"))
(autoload 'gnus-slave-no-server "gnus" "\
@@ -11600,8 +11927,8 @@ prompt the user for the name of an NNTP server to use.
;;;***
-;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (21989 31537
+;;;;;; 791825 721000))
;;; Generated autoloads from gnus/gnus-agent.el
(autoload 'gnus-unplugged "gnus-agent" "\
@@ -11685,14 +12012,14 @@ Start Gnus, send queue and fetch session.
(autoload 'gnus-agent-regenerate "gnus-agent" "\
Regenerate all agent covered files.
-If CLEAN, obsolete (ignore).
+CLEAN is obsolete and ignored.
\(fn &optional CLEAN REREAD)" t nil)
;;;***
-;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (20941 25255
-;;;;;; 50698 0))
+;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (22011 58553
+;;;;;; 521858 469000))
;;; Generated autoloads from gnus/gnus-art.el
(autoload 'gnus-article-prepare-display "gnus-art" "\
@@ -11702,8 +12029,8 @@ Make the current buffer look like a nice article.
;;;***
-;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (22011
+;;;;;; 58553 521858 469000))
;;; Generated autoloads from gnus/gnus-bookmark.el
(autoload 'gnus-bookmark-set "gnus-bookmark" "\
@@ -11726,8 +12053,8 @@ deletion, or > if it is flagged for displaying.
;;;***
-;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-cache.el
(autoload 'gnus-jog-cache "gnus-cache" "\
@@ -11768,8 +12095,8 @@ supported.
;;;***
-;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (20791 9657
-;;;;;; 561026 0))
+;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-delay.el
(autoload 'gnus-delay-article "gnus-delay" "\
@@ -11804,8 +12131,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
;;;***
-;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-diary.el
(autoload 'gnus-user-format-function-d "gnus-diary" "\
@@ -11820,8 +12147,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil.
;;;***
-;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-dired.el
(autoload 'turn-on-gnus-dired-mode "gnus-dired" "\
@@ -11831,8 +12158,8 @@ Convenience method to turn on gnus-dired-mode.
;;;***
-;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-draft.el
(autoload 'gnus-draft-reminder "gnus-draft" "\
@@ -11842,13 +12169,22 @@ Reminder user if there are unsent drafts.
;;;***
-;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (21989 31537
+;;;;;; 811825 721000))
;;; Generated autoloads from gnus/gnus-fun.el
+(autoload 'gnus--random-face-with-type "gnus-fun" "\
+Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN.
+
+\(fn DIR EXT OMIT FUN)" nil nil)
+
+(autoload 'message-goto-eoh "message" nil t)
+
(autoload 'gnus-random-x-face "gnus-fun" "\
Return X-Face header data chosen randomly from `gnus-x-face-directory'.
+Files matching `gnus-x-face-omit-files' are not considered.
+
\(fn)" t nil)
(autoload 'gnus-insert-random-x-face-header "gnus-fun" "\
@@ -11857,7 +12193,7 @@ Insert a random X-Face header from `gnus-x-face-directory'.
\(fn)" t nil)
(autoload 'gnus-x-face-from-file "gnus-fun" "\
-Insert an X-Face header based on an image file.
+Insert an X-Face header based on an image FILE.
Depending on `gnus-convert-image-to-x-face-command' it may accept
different input formats.
@@ -11865,7 +12201,7 @@ different input formats.
\(fn FILE)" t nil)
(autoload 'gnus-face-from-file "gnus-fun" "\
-Return a Face header based on an image file.
+Return a Face header based on an image FILE.
Depending on `gnus-convert-image-to-face-command' it may accept
different input formats.
@@ -11885,10 +12221,22 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to
\(fn FILE)" nil nil)
+(autoload 'gnus-random-face "gnus-fun" "\
+Return randomly chosen Face from `gnus-face-directory'.
+
+Files matching `gnus-face-omit-files' are not considered.
+
+\(fn)" t nil)
+
+(autoload 'gnus-insert-random-face-header "gnus-fun" "\
+Insert a random Face header from `gnus-face-directory'.
+
+\(fn)" nil nil)
+
;;;***
-;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (20874
-;;;;;; 65006 176325 548000))
+;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from gnus/gnus-gravatar.el
(autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\
@@ -11905,8 +12253,8 @@ If gravatars are already displayed, remove them.
;;;***
-;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (20929 34089
-;;;;;; 117790 0))
+;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (22011 58553
+;;;;;; 529858 469000))
;;; Generated autoloads from gnus/gnus-group.el
(autoload 'gnus-fetch-group "gnus-group" "\
@@ -11923,8 +12271,8 @@ Pop up a frame and enter GROUP.
;;;***
-;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (20874 65006
-;;;;;; 672942 217000))
+;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (21972 22452
+;;;;;; 190264 357000))
;;; Generated autoloads from gnus/gnus-html.el
(autoload 'gnus-article-html "gnus-html" "\
@@ -11939,8 +12287,8 @@ Pop up a frame and enter GROUP.
;;;***
-;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-kill.el
(defalias 'gnus-batch-kill 'gnus-batch-score)
@@ -11953,8 +12301,8 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score
;;;***
-;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from gnus/gnus-ml.el
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\
@@ -11977,8 +12325,8 @@ Minor mode for providing mailing-list commands.
;;;***
-;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (22011 58553
+;;;;;; 529858 469000))
;;; Generated autoloads from gnus/gnus-mlspl.el
(autoload 'gnus-group-split-setup "gnus-mlspl" "\
@@ -12078,8 +12426,8 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
;;;***
-;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (20858 21542
-;;;;;; 723007 0))
+;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21725 56638
+;;;;;; 795320 63000))
;;; Generated autoloads from gnus/gnus-msg.el
(autoload 'gnus-msg-mail "gnus-msg" "\
@@ -12106,7 +12454,7 @@ Like `message-reply'.
;;;***
;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el"
-;;;;;; (20886 939 575794 0))
+;;;;;; (21757 29489 158925 687000))
;;; Generated autoloads from gnus/gnus-notifications.el
(autoload 'gnus-notifications "gnus-notifications" "\
@@ -12122,8 +12470,8 @@ This is typically a function to add in
;;;***
-;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (20874 65006
-;;;;;; 672942 217000))
+;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-picon.el
(autoload 'gnus-treat-from-picon "gnus-picon" "\
@@ -12146,8 +12494,8 @@ If picons are already displayed, remove them.
;;;***
-;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-range.el
(autoload 'gnus-sorted-difference "gnus-range" "\
@@ -12214,8 +12562,8 @@ Add NUM into sorted LIST by side effect.
;;;***
-;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (20779
-;;;;;; 18487 859617 0))
+;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (22011
+;;;;;; 58553 541858 469000))
;;; Generated autoloads from gnus/gnus-registry.el
(autoload 'gnus-registry-initialize "gnus-registry" "\
@@ -12230,8 +12578,8 @@ Install the registry hooks.
;;;***
-;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (22011 58553
+;;;;;; 541858 469000))
;;; Generated autoloads from gnus/gnus-sieve.el
(autoload 'gnus-sieve-update "gnus-sieve" "\
@@ -12258,8 +12606,8 @@ See the documentation for these variables and functions for details.
;;;***
-;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (20893 60586
-;;;;;; 188550 0))
+;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-spec.el
(autoload 'gnus-update-format "gnus-spec" "\
@@ -12269,8 +12617,8 @@ Update the format specification near point.
;;;***
-;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (20763 30266
-;;;;;; 231060 0))
+;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21993 28596
+;;;;;; 102597 473000))
;;; Generated autoloads from gnus/gnus-start.el
(autoload 'gnus-declare-backend "gnus-start" "\
@@ -12280,8 +12628,8 @@ Declare back end NAME with ABILITIES as a Gnus back end.
;;;***
-;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (20901 54695
-;;;;;; 989166 0))
+;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21993 28596
+;;;;;; 110597 473000))
;;; Generated autoloads from gnus/gnus-sum.el
(autoload 'gnus-summary-bookmark-jump "gnus-sum" "\
@@ -12292,8 +12640,8 @@ BOOKMARK is a bookmark name or a bookmark record.
;;;***
-;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (21832 3452
+;;;;;; 581913 198000))
;;; Generated autoloads from gnus/gnus-sync.el
(autoload 'gnus-sync-initialize "gnus-sync" "\
@@ -12308,8 +12656,8 @@ Install the sync hooks.
;;;***
-;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gnus-win.el
(autoload 'gnus-add-configuration "gnus-win" "\
@@ -12319,8 +12667,8 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
;;;***
-;;;### (autoloads nil "gnutls" "net/gnutls.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "gnutls" "net/gnutls.el" (22011 58553 761858
+;;;;;; 469000))
;;; Generated autoloads from net/gnutls.el
(defvar gnutls-min-prime-bits 256 "\
@@ -12336,8 +12684,8 @@ A value of nil says to use the default GnuTLS value.")
;;;***
-;;;### (autoloads nil "gomoku" "play/gomoku.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "gomoku" "play/gomoku.el" (21998 46517 190024
+;;;;;; 649000))
;;; Generated autoloads from play/gomoku.el
(autoload 'gomoku "gomoku" "\
@@ -12363,8 +12711,8 @@ Use \\[describe-mode] for more info.
;;;***
-;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (20766 6456
-;;;;;; 368550 0))
+;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from net/goto-addr.el
(define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1")
@@ -12405,8 +12753,8 @@ Like `goto-address-mode', but only for comments and strings.
;;;***
-;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (20901 54695
-;;;;;; 989166 0))
+;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/gravatar.el
(autoload 'gravatar-retrieve "gravatar" "\
@@ -12422,8 +12770,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it.
;;;***
-;;;### (autoloads nil "grep" "progmodes/grep.el" (20896 36774 886399
-;;;;;; 0))
+;;;### (autoloads nil "grep" "progmodes/grep.el" (22027 46774 676310
+;;;;;; 591000))
;;; Generated autoloads from progmodes/grep.el
(defvar grep-window-height nil "\
@@ -12456,7 +12804,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([1-9][0-9]*\\)\\2" 1 3 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
+(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[ ]*:" 1 2 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
(defvar grep-program (purecopy "grep") "\
@@ -12464,8 +12812,9 @@ The default grep program for `grep-command' and `grep-find-command'.
This variable's value takes effect when `grep-compute-defaults' is called.")
(defvar find-program (purecopy "find") "\
-The default find program for `grep-find-command'.
-This variable's value takes effect when `grep-compute-defaults' is called.")
+The default find program.
+This is used by commands like `grep-find-command', `find-dired'
+and others.")
(defvar xargs-program (purecopy "xargs") "\
The default xargs program for `grep-find-command'.
@@ -12580,13 +12929,13 @@ Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR.
Like `rgrep' but uses `zgrep' for `grep-program', sets the default
file name to `*.gz', and sets `grep-highlight-matches' to `always'.
-\(fn REGEXP &optional FILES DIR CONFIRM GREP-FIND-TEMPLATE)" t nil)
+\(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil)
(defalias 'rzgrep 'zrgrep)
;;;***
-;;;### (autoloads nil "gs" "gs.el" (20709 26818 907104 0))
+;;;### (autoloads nil "gs" "gs.el" (21670 32331 385639 720000))
;;; Generated autoloads from gs.el
(autoload 'gs-load-image "gs" "\
@@ -12599,8 +12948,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful.
;;;***
-;;;### (autoloads nil "gud" "progmodes/gud.el" (20895 15912 444844
-;;;;;; 0))
+;;;### (autoloads nil "gud" "progmodes/gud.el" (22018 31799 115263
+;;;;;; 120000))
;;; Generated autoloads from progmodes/gud.el
(autoload 'gud-gdb "gud" "\
@@ -12648,6 +12997,13 @@ and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
+(autoload 'guiler "gud" "\
+Run guiler on program FILE in buffer `*gud-FILE*'.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger.
+
+\(fn COMMAND-LINE)" t nil)
+
(autoload 'jdb "gud" "\
Run jdb with command line COMMAND-LINE in a buffer.
The buffer is named \"*gud*\" if no initial class is given or
@@ -12688,8 +13044,8 @@ it if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (22011 58553 409858
+;;;;;; 469000))
;;; Generated autoloads from emacs-lisp/gv.el
(autoload 'gv-get "gv" "\
@@ -12717,7 +13073,7 @@ all the parts of PLACE that can be evaluated and then runs E.
\(fn (GETTER SETTER) PLACE &rest BODY)" nil t)
-(put 'gv-letplace 'lisp-indent-function '2)
+(function-put 'gv-letplace 'lisp-indent-function '2)
(autoload 'gv-define-expander "gv" "\
Use HANDLER to handle NAME as a generalized var.
@@ -12727,16 +13083,16 @@ arguments as NAME. DO is a function as defined in `gv-get'.
\(fn NAME HANDLER)" nil t)
-(put 'gv-define-expander 'lisp-indent-function '1)
+(function-put 'gv-define-expander 'lisp-indent-function '1)
(autoload 'gv--defun-declaration "gv" "\
\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
-(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)) defun-declarations-alist)
+(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)))
-(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist)
+(or (assq 'gv-setter defun-declarations-alist) (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist))
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
@@ -12748,11 +13104,11 @@ return a Lisp form that does the assignment.
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))
+ (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))
\(fn NAME ARGLIST &rest BODY)" nil t)
-(put 'gv-define-setter 'lisp-indent-function '2)
+(function-put 'gv-define-setter 'lisp-indent-function '2)
(autoload 'gv-define-simple-setter "gv" "\
Define a simple setter method for generalized variable NAME.
@@ -12783,13 +13139,16 @@ The return value is the last VAL in the list.
(autoload 'gv-ref "gv" "\
Return a reference to PLACE.
This is like the `&' operator of the C language.
+Note: this only works reliably with lexical binding mode, except for very
+simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
+binding mode.
\(fn PLACE)" nil t)
;;;***
-;;;### (autoloads nil "handwrite" "play/handwrite.el" (20791 9657
-;;;;;; 561026 0))
+;;;### (autoloads nil "handwrite" "play/handwrite.el" (22026 25907
+;;;;;; 631502 692000))
;;; Generated autoloads from play/handwrite.el
(autoload 'handwrite "handwrite" "\
@@ -12806,8 +13165,8 @@ Variables: `handwrite-linespace' (default 12)
;;;***
-;;;### (autoloads nil "hanoi" "play/hanoi.el" (20478 3673 653810
-;;;;;; 0))
+;;;### (autoloads nil "hanoi" "play/hanoi.el" (21799 41767 31221
+;;;;;; 635000))
;;; Generated autoloads from play/hanoi.el
(autoload 'hanoi "hanoi" "\
@@ -12834,8 +13193,8 @@ to be updated.
;;;***
-;;;### (autoloads nil "hashcash" "mail/hashcash.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "hashcash" "mail/hashcash.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from mail/hashcash.el
(autoload 'hashcash-insert-payment "hashcash" "\
@@ -12877,8 +13236,8 @@ Prefix arg sets default accept amount temporarily.
;;;***
-;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from help-at-pt.el
(autoload 'help-at-pt-string "help-at-pt" "\
@@ -13005,8 +13364,8 @@ different regions. With numeric argument ARG, behaves like
;;;***
-;;;### (autoloads nil "help-fns" "help-fns.el" (20924 16196 967284
-;;;;;; 0))
+;;;### (autoloads nil "help-fns" "help-fns.el" (22011 58553 601858
+;;;;;; 469000))
;;; Generated autoloads from help-fns.el
(autoload 'describe-function "help-fns" "\
@@ -13026,8 +13385,7 @@ OBJECT should be a symbol associated with a function, variable, or face;
alternatively, it can be a function definition.
If TYPE is `defvar', search for a variable definition.
If TYPE is `defface', search for a face definition.
-If TYPE is the value returned by `symbol-function' for a function symbol,
- search for a function definition.
+If TYPE is not a symbol, search for a function definition.
The return value is the absolute name of a readable file where OBJECT is
defined. If several such files exist, preference is given to a file
@@ -13058,6 +13416,12 @@ it is displayed along with the global value.
\(fn VARIABLE &optional BUFFER FRAME)" t nil)
+(autoload 'describe-symbol "help-fns" "\
+Display the full documentation of SYMBOL.
+Will show the info of SYMBOL as a function, variable, and/or face.
+
+\(fn SYMBOL &optional BUFFER FRAME)" t nil)
+
(autoload 'describe-syntax "help-fns" "\
Describe the syntax specifications in the syntax table of BUFFER.
The descriptions are inserted in a help buffer, which is then displayed.
@@ -13085,8 +13449,8 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file.
;;;***
-;;;### (autoloads nil "help-macro" "help-macro.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "help-macro" "help-macro.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from help-macro.el
(defvar three-step-help nil "\
@@ -13100,8 +13464,8 @@ gives the window that lists the options.")
;;;***
-;;;### (autoloads nil "help-mode" "help-mode.el" (20920 19111 869400
-;;;;;; 0))
+;;;### (autoloads nil "help-mode" "help-mode.el" (21972 22452 270264
+;;;;;; 357000))
;;; Generated autoloads from help-mode.el
(autoload 'help-mode "help-mode" "\
@@ -13113,12 +13477,12 @@ Commands:
\(fn)" t nil)
(autoload 'help-mode-setup "help-mode" "\
-
+Enter Help Mode in the current buffer.
\(fn)" nil nil)
(autoload 'help-mode-finish "help-mode" "\
-
+Finalize Help Mode setup in current buffer.
\(fn)" nil nil)
@@ -13191,6 +13555,8 @@ Add xrefs for symbols in `pp's output between FROM and TO.
\(fn FROM TO)" nil nil)
+(define-obsolete-function-alias 'help-xref-interned 'describe-symbol "25.1")
+
(autoload 'help-bookmark-jump "help-mode" "\
Jump to help-mode bookmark BOOKMARK.
Handler function for record returned by `help-bookmark-make-record'.
@@ -13200,8 +13566,8 @@ BOOKMARK is a bookmark name or a bookmark record.
;;;***
-;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from emacs-lisp/helper.el
(autoload 'Helper-describe-bindings "helper" "\
@@ -13216,7 +13582,7 @@ Provide help for current mode.
;;;***
-;;;### (autoloads nil "hexl" "hexl.el" (20763 30266 231060 0))
+;;;### (autoloads nil "hexl" "hexl.el" (21985 34484 226705 925000))
;;; Generated autoloads from hexl.el
(autoload 'hexl-mode "hexl" "\
@@ -13231,10 +13597,10 @@ using the function `hexlify-buffer'.
Each line in the buffer has an \"address\" (displayed in hexadecimal)
representing the offset into the file that the characters on this line
are at and 16 characters from the file (displayed as hexadecimal
-values grouped every `hexl-bits' bits) and as their ASCII values.
+values grouped every `hexl-bits' bits, and as their ASCII values).
If any of the characters (displayed as ASCII characters) are
-unprintable (control or meta characters) they will be replaced as
+unprintable (control or meta characters) they will be replaced by
periods.
If `hexl-mode' is invoked with an argument the buffer is assumed to be
@@ -13258,8 +13624,8 @@ A sample format:
000000b0: 7461 626c 6520 6368 6172 6163 7465 7220 table character
000000c0: 7265 6769 6f6e 2e0a region..
-Movement is as simple as movement in a normal Emacs text buffer. Most
-cursor movement bindings are the same: use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
+Movement is as simple as movement in a normal Emacs text buffer.
+Most cursor movement bindings are the same: use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
to move the cursor left, right, down, and up.
Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
@@ -13284,7 +13650,7 @@ into the buffer at the current point.
\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
into the buffer at the current point.
-\\[hexl-mode-exit] will exit hexl-mode.
+\\[hexl-mode-exit] will exit `hexl-mode'.
Note: saving the file with any of the usual Emacs commands
will actually convert it back to binary format while saving.
@@ -13310,8 +13676,8 @@ This discards the buffer's undo information.
;;;***
-;;;### (autoloads nil "hi-lock" "hi-lock.el" (20908 27948 216644
-;;;;;; 0))
+;;;### (autoloads nil "hi-lock" "hi-lock.el" (21993 28596 134597
+;;;;;; 473000))
;;; Generated autoloads from hi-lock.el
(autoload 'hi-lock-mode "hi-lock" "\
@@ -13404,9 +13770,8 @@ See `hi-lock-mode' for more information on Hi-Lock mode.
(autoload 'hi-lock-line-face-buffer "hi-lock" "\
Set face of all lines containing a match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) of REGEXP. Use the global history list for FACE.
+Interactively, prompt for REGEXP using `read-regexp', then FACE.
+Use the global history list for FACE.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -13418,9 +13783,8 @@ highlighting will not update as you type.
(autoload 'hi-lock-face-buffer "hi-lock" "\
Set face of each match of REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) REGEXP. Use the global history list for FACE.
+Interactively, prompt for REGEXP using `read-regexp', then FACE.
+Use the global history list for FACE.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -13432,12 +13796,12 @@ highlighting will not update as you type.
(autoload 'hi-lock-face-phrase-buffer "hi-lock" "\
Set face of each match of phrase REGEXP to FACE.
-Interactively, prompt for REGEXP then FACE. Use
-`hi-lock-read-regexp-defaults-function' to retrieve default
-value(s) of REGEXP. 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'.
+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'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -13448,14 +13812,13 @@ highlighting will not update as you type.
(defalias 'highlight-symbol-at-point 'hi-lock-face-symbol-at-point)
(autoload 'hi-lock-face-symbol-at-point "hi-lock" "\
-Set face of each match of the symbol at point.
-Use `find-tag-default-as-regexp' to retrieve the symbol at point.
-Use non-nil `hi-lock-auto-select-face' to retrieve the next face
-from `hi-lock-face-defaults' automatically.
+Highlight each instance of the symbol at point.
+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.
-Use Font lock mode, if enabled, to highlight symbol at point.
-Otherwise, use overlays for highlighting. If overlays are used,
-the highlighting will not update as you type.
+This uses Font lock mode if it is enabled; otherwise it uses overlays,
+in which case the highlighting will not update as you type.
\(fn)" t nil)
@@ -13481,8 +13844,8 @@ be found in variable `hi-lock-interactive-patterns'.
;;;***
-;;;### (autoloads nil "hideif" "progmodes/hideif.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "hideif" "progmodes/hideif.el" (21989 31537
+;;;;;; 939825 721000))
;;; Generated autoloads from progmodes/hideif.el
(autoload 'hide-ifdef-mode "hideif" "\
@@ -13497,27 +13860,31 @@ that the C preprocessor would eliminate may be hidden from view.
Several variables affect how the hiding is done:
`hide-ifdef-env'
- An association list of defined and undefined symbols for the
- current buffer. Initially, the global value of `hide-ifdef-env'
- is used.
+ An association list of defined and undefined symbols for the
+ current project. Initially, the global value of `hide-ifdef-env'
+ is used. This variable was a buffer-local variable, which limits
+ hideif to parse only one C/C++ file at a time. We've extended
+ hideif to support parsing a C/C++ project containing multiple C/C++
+ source files opened simultaneously in different buffers. Therefore
+ `hide-ifdef-env' can no longer be buffer local but must be global.
`hide-ifdef-define-alist'
- An association list of defined symbol lists.
+ An association list of defined symbol lists.
Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
from one of the lists in `hide-ifdef-define-alist'.
`hide-ifdef-lines'
- Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
- #endif lines when hiding.
+ Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
+ #endif lines when hiding.
`hide-ifdef-initially'
- Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
- is activated.
+ Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
+ is activated.
`hide-ifdef-read-only'
- Set to non-nil if you want to make buffers read only while hiding.
- After `show-ifdefs', read-only status is restored to previous value.
+ Set to non-nil if you want to make buffers read only while hiding.
+ After `show-ifdefs', read-only status is restored to previous value.
\\{hide-ifdef-mode-map}
@@ -13525,8 +13892,8 @@ Several variables affect how the hiding is done:
;;;***
-;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (20791 9657
-;;;;;; 561026 0))
+;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (22026 25907
+;;;;;; 635502 692000))
;;; 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))) "\
@@ -13588,8 +13955,8 @@ Unconditionally turn off `hs-minor-mode'.
;;;***
-;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (21980 16567 693544
+;;;;;; 893000))
;;; Generated autoloads from hilit-chg.el
(autoload 'highlight-changes-mode "hilit-chg" "\
@@ -13600,7 +13967,7 @@ enable the mode if ARG is omitted or nil.
When Highlight Changes is enabled, changes are marked with a text
property. Normally they are displayed in a distinctive face, but
-command \\[highlight-changes-visible-mode] can be used to toggles
+command \\[highlight-changes-visible-mode] can be used to toggle
this on and off.
Other functions for buffers in this mode include:
@@ -13628,7 +13995,7 @@ in a distinctive face.
The default value can be customized with variable
`highlight-changes-visibility-initial-state'.
-This command does not itself set highlight-changes mode.
+This command does not itself set Highlight Changes mode.
\(fn &optional ARG)" t nil)
@@ -13660,7 +14027,7 @@ You can automatically rotate colors when the buffer is saved by adding
this function to `write-file-functions' as a buffer-local value. To do
this, eval the following in the buffer to be saved:
- (add-hook 'write-file-functions 'highlight-changes-rotate-faces nil t)
+ (add-hook \\='write-file-functions \\='highlight-changes-rotate-faces nil t)
\(fn)" t nil)
@@ -13720,10 +14087,11 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode.
;;;***
-;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (21850 34968 457268
+;;;;;; 630000))
;;; Generated autoloads from hippie-exp.el
-(push (purecopy (quote (hippie-exp 1 6))) package--builtin-versions)
+(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'.
To change the behavior of `hippie-expand', remove, change the order of,
@@ -13752,8 +14120,8 @@ argument VERBOSE non-nil makes the function verbose.
;;;***
-;;;### (autoloads nil "hl-line" "hl-line.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "hl-line" "hl-line.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from hl-line.el
(autoload 'hl-line-mode "hl-line" "\
@@ -13802,12 +14170,10 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and
;;;***
-;;;### (autoloads nil "holidays" "calendar/holidays.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "holidays" "calendar/holidays.el" (22026 25907
+;;;;;; 551502 692000))
;;; Generated autoloads from calendar/holidays.el
-(define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1")
-
(defvar holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fools' Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\
General holidays. Default value is for the United States.
See the documentation for `calendar-holidays' for details.")
@@ -13816,8 +14182,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-general-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'oriental-holidays 'holiday-oriental-holidays "23.1")
-
(defvar holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append (holiday-chinese 1 15 "Lantern Festival") (holiday-chinese-qingming) (holiday-chinese 5 5 "Dragon Boat Festival") (holiday-chinese 7 7 "Double Seventh Festival") (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice))))) "\
Oriental holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13826,8 +14190,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-oriental-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1")
-
(defvar holiday-local-holidays nil "\
Local holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13836,8 +14198,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-local-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1")
-
(defvar holiday-other-holidays nil "\
User defined holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13846,28 +14206,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-other-holidays 'risky-local-variable t)
-(defvar hebrew-holidays-1 (mapcar 'purecopy '((holiday-hebrew-rosh-hashanah) (if calendar-hebrew-all-holidays-flag (holiday-julian 11 (let ((m displayed-month) (y displayed-year) year) (calendar-increment-month m y -1) (setq year (calendar-extract-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y))))) (if (zerop (% (1+ year) 4)) 22 21)) "\"Tal Umatar\" (evening)")))) "\
-Component of the old default value of `holiday-hebrew-holidays'.")
-
-(put 'hebrew-holidays-1 'risky-local-variable t)
-
-(defvar hebrew-holidays-2 (mapcar 'purecopy '((holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (holiday-hebrew 10 (let ((h-year (calendar-extract-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list displayed-month 28 displayed-year)))))) (if (= 6 (% (calendar-hebrew-to-absolute (list 10 10 h-year)) 7)) 11 10)) "Tzom Teveth")) (if calendar-hebrew-all-holidays-flag (holiday-hebrew 11 15 "Tu B'Shevat")))) "\
-Component of the old default value of `holiday-hebrew-holidays'.")
-
-(put 'hebrew-holidays-2 'risky-local-variable t)
-
-(defvar hebrew-holidays-3 (mapcar 'purecopy '((if calendar-hebrew-all-holidays-flag (holiday-hebrew 11 (let* ((m displayed-month) (y displayed-year) (h-year (progn (calendar-increment-month m y 1) (calendar-extract-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y)))))) (s-s (calendar-hebrew-from-absolute (if (= 6 (% (calendar-hebrew-to-absolute (list 7 1 h-year)) 7)) (calendar-dayname-on-or-before 6 (calendar-hebrew-to-absolute (list 11 17 h-year))) (calendar-dayname-on-or-before 6 (calendar-hebrew-to-absolute (list 11 16 h-year)))))) (day (calendar-extract-day s-s))) day) "Shabbat Shirah")))) "\
-Component of the old default value of `holiday-hebrew-holidays'.")
-
-(put 'hebrew-holidays-3 'risky-local-variable t)
-
-(defvar hebrew-holidays-4 (mapcar 'purecopy '((holiday-hebrew-passover) (and calendar-hebrew-all-holidays-flag (let* ((m displayed-month) (y displayed-year) (year (progn (calendar-increment-month m y -1) (calendar-extract-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y))))))) (= 21 (% year 28))) (holiday-julian 3 26 "Kiddush HaHamah")) (if calendar-hebrew-all-holidays-flag (holiday-hebrew-tisha-b-av)))) "\
-Component of the old default value of `holiday-hebrew-holidays'.")
-
-(put 'hebrew-holidays-4 'risky-local-variable t)
-
-(define-obsolete-variable-alias 'hebrew-holidays 'holiday-hebrew-holidays "23.1")
-
(defvar holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) (holiday-hebrew-misc))))) "\
Jewish holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13876,8 +14214,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-hebrew-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'christian-holidays 'holiday-christian-holidays "23.1")
-
(defvar holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag (append (holiday-fixed 1 6 "Epiphany") (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") (holiday-advent 0 "Advent"))))) "\
Christian holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13886,8 +14222,6 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-christian-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'islamic-holidays 'holiday-islamic-holidays "23.1")
-
(defvar holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag (append (holiday-islamic 1 10 "Ashura") (holiday-islamic 3 12 "Mulad-al-Nabi") (holiday-islamic 7 26 "Shab-e-Mi'raj") (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") (holiday-islamic 12 10 "Id-al-Adha"))))) "\
Islamic holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13896,18 +14230,14 @@ See the documentation for `calendar-holidays' for details.")
(put 'holiday-islamic-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1")
-
-(defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá'u'lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá'u'lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu'l-Bahá"))))) "\
-Bahá'í holidays.
+(defvar holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) (holiday-fixed 5 23 "Declaration of the Báb") (holiday-fixed 5 29 "Ascension of Bahá’u’lláh") (holiday-fixed 7 9 "Martyrdom of the Báb") (holiday-fixed 10 20 "Birth of the Báb") (holiday-fixed 11 12 "Birth of Bahá’u’lláh") (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá"))))) "\
+Bahá’í holidays.
See the documentation for `calendar-holidays' for details.")
(custom-autoload 'holiday-bahai-holidays "holidays" t)
(put 'holiday-bahai-holidays 'risky-local-variable t)
-(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1")
-
(defvar holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" (solar-time-string (/ calendar-daylight-savings-starts-time (float 60)) calendar-standard-time-zone-name))) (holiday-sexp calendar-daylight-savings-ends (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) calendar-daylight-time-zone-name))))) "\
Sun-related holidays.
See the documentation for `calendar-holidays' for details.")
@@ -13951,8 +14281,8 @@ The optional LABEL is used to label the buffer created.
;;;***
-;;;### (autoloads nil "html2text" "gnus/html2text.el" (20791 9657
-;;;;;; 561026 0))
+;;;### (autoloads nil "html2text" "gnus/html2text.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from gnus/html2text.el
(autoload 'html2text "html2text" "\
@@ -13962,10 +14292,11 @@ Convert HTML to plain text in the current buffer.
;;;***
-;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (20938 49065
-;;;;;; 383398 0))
+;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (22026 25907
+;;;;;; 591502 692000))
;;; Generated autoloads from htmlfontify.el
-(push (purecopy (quote (htmlfontify 0 21))) package--builtin-versions)
+(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
+
(autoload 'htmlfontify-buffer "htmlfontify" "\
Create a new buffer, named for the current buffer + a .html extension,
containing an inline CSS-stylesheet and formatted CSS-markup HTML
@@ -13995,8 +14326,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
;;;***
-;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from ibuf-macs.el
(autoload 'define-ibuffer-column "ibuf-macs" "\
@@ -14022,7 +14353,9 @@ inlined into the compiled format versions. This means that if you
change its definition, you should explicitly call
`ibuffer-recompile-formats'.
-\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil (quote macro))
+\(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil t)
+
+(function-put 'define-ibuffer-column 'lisp-indent-function 'defun)
(autoload 'define-ibuffer-sorter "ibuf-macs" "\
Define a method of sorting named NAME.
@@ -14034,7 +14367,11 @@ For sorting, the forms in BODY will be evaluated with `a' bound to one
buffer object, and `b' bound to another. BODY should return a non-nil
value if and only if `a' is \"less than\" `b'.
-\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil (quote macro))
+\(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil t)
+
+(function-put 'define-ibuffer-sorter 'lisp-indent-function '1)
+
+(function-put 'define-ibuffer-sorter 'doc-string-elt '2)
(autoload 'define-ibuffer-op "ibuf-macs" "\
Generate a function which operates on a buffer.
@@ -14067,7 +14404,11 @@ confirmation message, in the form:
COMPLEX means this function is special; see the source code of this
macro for exactly what it does.
-\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil (quote macro))
+\(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil t)
+
+(function-put 'define-ibuffer-op 'lisp-indent-function '2)
+
+(function-put 'define-ibuffer-op 'doc-string-elt '3)
(autoload 'define-ibuffer-filter "ibuf-macs" "\
Define a filter named NAME.
@@ -14080,12 +14421,16 @@ not a particular buffer should be displayed or not. The forms in BODY
will be evaluated with BUF bound to the buffer object, and QUALIFIER
bound to the current value of the filter.
-\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil (quote macro))
+\(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil t)
+
+(function-put 'define-ibuffer-filter 'lisp-indent-function '2)
+
+(function-put 'define-ibuffer-filter 'doc-string-elt '2)
;;;***
-;;;### (autoloads nil "ibuffer" "ibuffer.el" (20921 40206 193565
-;;;;;; 167000))
+;;;### (autoloads nil "ibuffer" "ibuffer.el" (22026 25907 595502
+;;;;;; 692000))
;;; Generated autoloads from ibuffer.el
(autoload 'ibuffer-list-buffers "ibuffer" "\
@@ -14104,7 +14449,7 @@ buffers which are visiting a file.
(autoload 'ibuffer "ibuffer" "\
Begin using Ibuffer to edit a list of buffers.
-Type 'h' after entering ibuffer for more information.
+Type `h' after entering ibuffer for more information.
All arguments are optional.
OTHER-WINDOW-P says to use another window.
@@ -14124,10 +14469,11 @@ FORMATS is the value to use for `ibuffer-formats'.
;;;***
-;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (22026
+;;;;;; 25907 551502 692000))
;;; Generated autoloads from calendar/icalendar.el
-(push (purecopy (quote (icalendar 0 19))) package--builtin-versions)
+(push (purecopy '(icalendar 0 19)) package--builtin-versions)
+
(autoload 'icalendar-export-file "icalendar" "\
Export diary file to iCalendar format.
All diary entries in the file DIARY-FILENAME are converted to iCalendar
@@ -14177,8 +14523,8 @@ buffer `*icalendar-errors*'.
;;;***
-;;;### (autoloads nil "icomplete" "icomplete.el" (20766 59066 666084
-;;;;;; 0))
+;;;### (autoloads nil "icomplete" "icomplete.el" (21980 16567 701544
+;;;;;; 893000))
;;; Generated autoloads from icomplete.el
(defvar icomplete-mode nil "\
@@ -14196,12 +14542,29 @@ With a prefix argument ARG, enable Icomplete mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
+When this global minor mode is enabled, typing in the minibuffer
+continuously displays a list of possible completions that match
+the string you have typed. See `icomplete-completions' for a
+description of how prospective completions are displayed.
+
+For more information, see Info node `(emacs)Icomplete'.
+For options you can set, `\\[customize-group] icomplete'.
+
+You can use the following key bindings to navigate and select
+completions:
+
+\\{icomplete-minibuffer-map}
+
\(fn &optional ARG)" t nil)
+(when (locate-library "obsolete/iswitchb")
+ (autoload 'iswitchb-mode "iswitchb" "Toggle Iswitchb mode." t)
+ (make-obsolete 'iswitchb-mode
+ "use `icomplete-mode' or `ido-mode' instead." "24.4"))
;;;***
-;;;### (autoloads nil "icon" "progmodes/icon.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "icon" "progmodes/icon.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from progmodes/icon.el
(autoload 'icon-mode "icon" "\
@@ -14241,8 +14604,8 @@ with no args, if that value is non-nil.
;;;***
-;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (20938
-;;;;;; 49065 383398 0))
+;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (22011
+;;;;;; 58553 905858 469000))
;;; Generated autoloads from progmodes/idlw-shell.el
(autoload 'idlwave-shell "idlw-shell" "\
@@ -14267,10 +14630,11 @@ See also the variable `idlwave-shell-prompt-pattern'.
;;;***
-;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (20929 34089
-;;;;;; 117790 0))
+;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (22011 58553
+;;;;;; 909858 469000))
;;; Generated autoloads from progmodes/idlwave.el
-(push (purecopy (quote (idlwave 6 1 22))) package--builtin-versions)
+(push (purecopy '(idlwave 6 1 22)) package--builtin-versions)
+
(autoload 'idlwave-mode "idlwave" "\
Major mode for editing IDL source files (version 6.1_em22).
@@ -14339,7 +14703,7 @@ The main features of this mode are
5. Code Templates and Abbreviations
--------------------------------
Many Abbreviations are predefined to expand to code fragments and templates.
- The abbreviations start generally with a `\\`. Some examples:
+ The abbreviations start generally with a `\\'. Some examples:
\\pr PROCEDURE template
\\fu FUNCTION template
@@ -14380,7 +14744,8 @@ The main features of this mode are
Info documentation for this package is available. Use
\\[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://idlwave.org'.
+ documentation, check IDLWAVE's homepage at URL
+ `http://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -14395,17 +14760,17 @@ The main features of this mode are
;;;***
-;;;### (autoloads nil "ido" "ido.el" (20937 28198 475168 0))
+;;;### (autoloads nil "ido" "ido.el" (22011 58553 641858 469000))
;;; Generated autoloads from ido.el
(defvar ido-mode nil "\
-Determines for which functional group (buffer and files) ido behavior
-should be enabled. The following values are possible:
-- `buffer': Turn only on ido buffer behavior (switching, killing,
+Determines for which buffer/file Ido should be enabled.
+The following values are possible:
+- `buffer': Turn only on Ido buffer behavior (switching, killing,
displaying...)
-- `file': Turn only on ido file behavior (finding, writing, inserting...)
-- `both': Turn on ido buffer and file behavior.
-- `nil': Turn off any ido switching.
+- `file': Turn only on Ido file behavior (finding, writing, inserting...)
+- `both': Turn on Ido buffer and file behavior.
+- nil: Turn off any Ido switching.
Setting this variable directly does not take effect;
use either \\[customize] or the function `ido-mode'.")
@@ -14413,11 +14778,11 @@ use either \\[customize] or the function `ido-mode'.")
(custom-autoload 'ido-mode "ido" nil)
(autoload 'ido-mode "ido" "\
-Toggle ido mode on or off.
-With ARG, turn ido-mode on if arg is positive, off otherwise.
-Turning on ido-mode will remap (via a minor-mode keymap) the default
+Toggle Ido mode on or off.
+With ARG, turn Ido mode on if arg is positive, off otherwise.
+Turning on Ido mode will remap (via a minor-mode keymap) the default
keybindings for the `find-file' and `switch-to-buffer' families of
-commands to the ido versions of these functions.
+commands to the Ido versions of these functions.
However, if ARG arg equals 'files, remap only commands for files, or
if it equals 'buffers, remap only commands for buffer switching.
This function also adds a hook to the minibuffer.
@@ -14436,26 +14801,26 @@ displayed if substring-matching is used (default). Look at
buffer you want, it can then be selected. As you type, most keys have
their normal keybindings, except for the following: \\<ido-buffer-completion-map>
-RET Select the buffer at the front of the list of matches. If the
-list is empty, possibly prompt to create new buffer.
+RET Select the buffer at the front of the list of matches.
+ If the list is empty, possibly prompt to create new buffer.
-\\[ido-select-text] Use the current input string verbatim.
+\\[ido-select-text] Use the current input string verbatim.
-\\[ido-next-match] Put the first element at the end of the list.
-\\[ido-prev-match] Put the last element at the start of the list.
-\\[ido-complete] Complete a common suffix to the current string that
-matches all buffers. If there is only one match, select that buffer.
-If there is no common suffix, show a list of all matching buffers
-in a separate window.
-\\[ido-edit-input] Edit input string.
-\\[ido-fallback-command] Fallback to non-ido version of current command.
-\\[ido-toggle-regexp] Toggle regexp searching.
-\\[ido-toggle-prefix] Toggle between substring and prefix matching.
-\\[ido-toggle-case] Toggle case-sensitive searching of buffer names.
-\\[ido-completion-help] Show list of matching buffers in separate window.
-\\[ido-enter-find-file] Drop into `ido-find-file'.
-\\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
-\\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'.
+\\[ido-next-match] Put the first element at the end of the list.
+\\[ido-prev-match] Put the last element at the start of the list.
+\\[ido-complete] Complete a common suffix to the current string that matches
+ all buffers. If there is only one match, select that buffer.
+ If there is no common suffix, show a list of all matching buffers
+ in a separate window.
+\\[ido-edit-input] Edit input string.
+\\[ido-fallback-command] Fallback to non-ido version of current command.
+\\[ido-toggle-regexp] Toggle regexp searching.
+\\[ido-toggle-prefix] Toggle between substring and prefix matching.
+\\[ido-toggle-case] Toggle case-sensitive searching of buffer names.
+\\[ido-completion-help] Show list of matching buffers in separate window.
+\\[ido-enter-find-file] Drop into `ido-find-file'.
+\\[ido-kill-buffer-at-head] Kill buffer at head of buffer list.
+\\[ido-toggle-ignore] Toggle ignoring buffers listed in `ido-ignore-buffers'.
\(fn)" t nil)
@@ -14502,8 +14867,8 @@ Switch to another file starting from DIR.
(autoload 'ido-find-file "ido" "\
Edit file with name obtained via minibuffer.
The file is displayed according to `ido-default-file-method' -- the
-default is to show it in the same window, unless it is already
-visible in another frame.
+default is to show it in the same window, unless it is already visible
+in another frame.
The file name is selected interactively by typing a substring. As you
type in a string, all of the filenames matching the string are displayed
@@ -14512,32 +14877,35 @@ if substring-matching is used (default). Look at `ido-enable-prefix' and
then be selected. As you type, most keys have their normal keybindings,
except for the following: \\<ido-file-completion-map>
-RET Select the file at the front of the list of matches. If the
-list is empty, possibly prompt to create new file.
-
-\\[ido-select-text] Use the current input string verbatim.
-
-\\[ido-next-match] Put the first element at the end of the list.
-\\[ido-prev-match] Put the last element at the start of the list.
-\\[ido-complete] Complete a common suffix to the current string that
-matches all files. If there is only one match, select that file.
-If there is no common suffix, show a list of all matching files
-in a separate window.
-\\[ido-magic-delete-char] Open the specified directory in Dired mode.
-\\[ido-edit-input] Edit input string (including directory).
-\\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history.
-\\[ido-merge-work-directories] search for file in the work directory history.
-\\[ido-forget-work-directory] removes current directory from the work directory history.
-\\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history.
-\\[ido-wide-find-file-or-pop-dir] and \\[ido-wide-find-dir-or-delete-dir] prompts and uses find to locate files or directories.
-\\[ido-make-directory] prompts for a directory to create in current directory.
-\\[ido-fallback-command] Fallback to non-ido version of current command.
-\\[ido-toggle-regexp] Toggle regexp searching.
-\\[ido-toggle-prefix] Toggle between substring and prefix matching.
-\\[ido-toggle-case] Toggle case-sensitive searching of file names.
-\\[ido-toggle-literal] Toggle literal reading of this file.
-\\[ido-completion-help] Show list of matching files in separate window.
-\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
+RET Select the file at the front of the list of matches.
+ If the list is empty, possibly prompt to create new file.
+
+\\[ido-select-text] Use the current input string verbatim.
+
+\\[ido-next-match] Put the first element at the end of the list.
+\\[ido-prev-match] Put the last element at the start of the list.
+\\[ido-complete] Complete a common suffix to the current string that matches
+ all files. If there is only one match, select that file.
+ If there is no common suffix, show a list of all matching files
+ in a separate window.
+\\[ido-magic-delete-char] Open the specified directory in Dired mode.
+\\[ido-edit-input] Edit input string (including directory).
+\\[ido-prev-work-directory] Go to previous directory in work directory history.
+\\[ido-next-work-directory] Go to next directory in work directory history.
+\\[ido-merge-work-directories] Search for file in the work directory history.
+\\[ido-forget-work-directory] Remove current directory from the work directory history.
+\\[ido-prev-work-file] Cycle to previous file in work file history.
+\\[ido-next-work-file] Cycle to next file in work file history.
+\\[ido-wide-find-file-or-pop-dir] Prompt for a file and use find to locate it.
+\\[ido-wide-find-dir-or-delete-dir] Prompt for a directory and use find to locate it.
+\\[ido-make-directory] Prompt for a directory to create in current directory.
+\\[ido-fallback-command] Fallback to non-Ido version of current command.
+\\[ido-toggle-regexp] Toggle regexp searching.
+\\[ido-toggle-prefix] Toggle between substring and prefix matching.
+\\[ido-toggle-case] Toggle case-sensitive searching of file names.
+\\[ido-toggle-literal] Toggle literal reading of this file.
+\\[ido-completion-help] Show list of matching files in separate window.
+\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
\(fn)" t nil)
@@ -14605,7 +14973,7 @@ For details of keybindings, see `ido-find-file'.
\(fn)" t nil)
(autoload 'ido-dired "ido" "\
-Call `dired' the ido way.
+Call `dired' the Ido way.
The directory is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'.
@@ -14618,7 +14986,7 @@ PROMPT is the prompt to give to the user. DEFAULT if given is the default
buffer to be selected, which will go to the front of the list.
If REQUIRE-MATCH is non-nil, an existing buffer must be selected.
-\(fn PROMPT &optional DEFAULT REQUIRE-MATCH)" nil nil)
+\(fn PROMPT &optional DEFAULT REQUIRE-MATCH PREDICATE)" nil nil)
(autoload 'ido-read-file-name "ido" "\
Ido replacement for the built-in `read-file-name'.
@@ -14636,10 +15004,10 @@ See `read-directory-name' for additional parameters.
(autoload 'ido-completing-read "ido" "\
Ido replacement for the built-in `completing-read'.
-Read a string in the minibuffer with ido-style completion.
+Read a string in the minibuffer with Ido-style completion.
PROMPT is a string to prompt with; normally it ends in a colon and a space.
CHOICES is a list of strings which are the possible completions.
-PREDICATE and INHERIT-INPUT-METHOD is currently ignored; it is included
+PREDICATE and INHERIT-INPUT-METHOD are currently ignored; they are included
to be compatible with `completing-read'.
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
the input is (or completes to) an element of CHOICES or is null.
@@ -14654,18 +15022,19 @@ DEF, if non-nil, is the default value.
;;;***
-;;;### (autoloads nil "ielm" "ielm.el" (20903 10024 645978 0))
+;;;### (autoloads nil "ielm" "ielm.el" (21980 16567 705544 893000))
;;; Generated autoloads from ielm.el
(autoload 'ielm "ielm" "\
Interactively evaluate Emacs Lisp expressions.
Switches to the buffer `*ielm*', or creates it if it does not exist.
+See `inferior-emacs-lisp-mode' for details.
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "iimage" "iimage.el" (20709 26818 907104 0))
+;;;### (autoloads nil "iimage" "iimage.el" (21990 52406 604500 385000))
;;; Generated autoloads from iimage.el
(define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1")
@@ -14681,7 +15050,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
;;;***
-;;;### (autoloads nil "image" "image.el" (20903 10024 645978 0))
+;;;### (autoloads nil "image" "image.el" (22011 58553 641858 469000))
;;; Generated autoloads from image.el
(autoload 'image-type-from-data "image" "\
@@ -14835,7 +15204,7 @@ Image files should not be larger than specified by `max-image-size'.
\(fn SPECS)" nil nil)
(autoload 'defimage "image" "\
-Define SYMBOL as an image.
+Define SYMBOL as an image, and return SYMBOL.
SPECS is a list of image specifications. DOC is an optional
documentation string.
@@ -14856,7 +15225,7 @@ Example:
\(fn SYMBOL SPECS &optional DOC)" nil t)
-(put 'defimage 'doc-string-elt '3)
+(function-put 'defimage 'doc-string-elt '3)
(autoload 'imagemagick-register-types "image" "\
Register file types that can be handled by ImageMagick.
@@ -14874,10 +15243,11 @@ If Emacs is compiled without ImageMagick support, this does nothing.
;;;***
-;;;### (autoloads nil "image-dired" "image-dired.el" (20921 39978
-;;;;;; 248467 0))
+;;;### (autoloads nil "image-dired" "image-dired.el" (22011 58553
+;;;;;; 641858 469000))
;;; Generated autoloads from image-dired.el
-(push (purecopy (quote (image-dired 0 4 11))) package--builtin-versions)
+(push (purecopy '(image-dired 0 4 11)) package--builtin-versions)
+
(autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\
Toggle thumbnails in front of file names in the dired buffer.
If no marked file could be found, insert or hide thumbnails on the
@@ -15011,8 +15381,8 @@ easy-to-use form.
;;;***
-;;;### (autoloads nil "image-file" "image-file.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "image-file" "image-file.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from image-file.el
(defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\
@@ -15074,8 +15444,8 @@ An image file is one whose name has an extension in
;;;***
-;;;### (autoloads nil "image-mode" "image-mode.el" (20899 12965 791908
-;;;;;; 0))
+;;;### (autoloads nil "image-mode" "image-mode.el" (21716 41663 456033
+;;;;;; 27000))
;;; Generated autoloads from image-mode.el
(autoload 'image-mode "image-mode" "\
@@ -15083,6 +15453,9 @@ Major mode for image files.
You can use \\<image-mode-map>\\[image-toggle-display]
to toggle between display as an image and display as text.
+Key bindings:
+\\{image-mode-map}
+
\(fn)" t nil)
(autoload 'image-minor-mode "image-mode" "\
@@ -15119,7 +15492,7 @@ on these modes.
;;;***
-;;;### (autoloads nil "imenu" "imenu.el" (20784 36406 653593 0))
+;;;### (autoloads nil "imenu" "imenu.el" (21986 55346 284512 613000))
;;; Generated autoloads from imenu.el
(defvar imenu-sort-function nil "\
@@ -15257,8 +15630,8 @@ for more information.
;;;***
-;;;### (autoloads nil "ind-util" "language/ind-util.el" (20826 45095
-;;;;;; 436233 0))
+;;;### (autoloads nil "ind-util" "language/ind-util.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from language/ind-util.el
(autoload 'indian-compose-region "ind-util" "\
@@ -15288,8 +15661,8 @@ Convert old Emacs Devanagari characters to UCS.
;;;***
-;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (20774 53405
-;;;;;; 644725 888000))
+;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (22011 58553
+;;;;;; 909858 469000))
;;; Generated autoloads from progmodes/inf-lisp.el
(autoload 'inferior-lisp "inf-lisp" "\
@@ -15307,7 +15680,7 @@ of `inferior-lisp-program'). Runs the hooks from
;;;***
-;;;### (autoloads nil "info" "info.el" (20940 4391 641153 0))
+;;;### (autoloads nil "info" "info.el" (22011 58553 645858 469000))
;;; Generated autoloads from info.el
(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\
@@ -15349,8 +15722,7 @@ with the top-level Info directory.
In interactive use, a non-numeric prefix argument directs
this command to read a file name from the minibuffer.
-A numeric prefix argument N selects an Info buffer named
-\"*info*<%s>\".
+A numeric prefix argument of N selects an Info buffer named \"*info*<N>\".
The search path for Info files is in the variable `Info-directory-list'.
The top-level Info directory is made by combining all the files named `dir'
@@ -15512,14 +15884,16 @@ type returned by `Info-bookmark-make-record', which see.
(autoload 'info-display-manual "info" "\
Display an Info buffer displaying MANUAL.
If there is an existing Info buffer for MANUAL, display it.
-Otherwise, visit the manual in a new Info buffer.
+Otherwise, visit the manual in a new Info buffer. In interactive
+use, a prefix argument directs this command to limit the
+completion alternatives to currently visited manuals.
\(fn MANUAL)" t nil)
;;;***
-;;;### (autoloads nil "info-look" "info-look.el" (20854 24486 190633
-;;;;;; 0))
+;;;### (autoloads nil "info-look" "info-look.el" (22011 58553 641858
+;;;;;; 469000))
;;; Generated autoloads from info-look.el
(autoload 'info-lookup-reset "info-look" "\
@@ -15538,7 +15912,7 @@ minibuffer. In the minibuffer, use M-n to yank the default argument
value into the minibuffer so you can edit it. The default symbol is the
one found at point.
-With prefix arg a query for the symbol help mode is offered.
+With prefix arg MODE a query for the symbol help mode is offered.
\(fn SYMBOL &optional MODE)" t nil)
(put 'info-lookup-file 'info-file "emacs")
@@ -15550,7 +15924,7 @@ In the minibuffer, use M-n to yank the default file name
into the minibuffer so you can edit it.
The default file name is the one found at point.
-With prefix arg a query for the file help mode is offered.
+With prefix arg MODE a query for the file help mode is offered.
\(fn FILE &optional MODE)" t nil)
@@ -15566,10 +15940,11 @@ Perform completion on file preceding point.
;;;***
-;;;### (autoloads nil "info-xref" "info-xref.el" (20938 49065 383398
-;;;;;; 0))
+;;;### (autoloads nil "info-xref" "info-xref.el" (21978 61237 550488
+;;;;;; 269000))
;;; Generated autoloads from info-xref.el
-(push (purecopy (quote (info-xref 3))) package--builtin-versions)
+(push (purecopy '(info-xref 3)) package--builtin-versions)
+
(autoload 'info-xref-check "info-xref" "\
Check external references in FILENAME, an info document.
Interactively from an `Info-mode' or `texinfo-mode' buffer the
@@ -15649,8 +16024,8 @@ the sources handy.
;;;***
-;;;### (autoloads nil "informat" "informat.el" (20774 566 676067
-;;;;;; 0))
+;;;### (autoloads nil "informat" "informat.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from informat.el
(autoload 'Info-tagify "informat" "\
@@ -15695,10 +16070,26 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\"
;;;***
-;;;### (autoloads nil "inversion" "cedet/inversion.el" (20745 310
-;;;;;; 425822 0))
+;;;### (autoloads nil "inline" "emacs-lisp/inline.el" (21670 32330
+;;;;;; 885624 725000))
+;;; Generated autoloads from emacs-lisp/inline.el
+
+(autoload 'define-inline "inline" "\
+
+
+\(fn NAME ARGS &rest BODY)" nil t)
+
+(function-put 'define-inline 'lisp-indent-function 'defun)
+
+(function-put 'define-inline 'doc-string-elt '3)
+
+;;;***
+
+;;;### (autoloads nil "inversion" "cedet/inversion.el" (21993 28595
+;;;;;; 998597 473000))
;;; Generated autoloads from cedet/inversion.el
-(push (purecopy (quote (inversion 1 3))) package--builtin-versions)
+(push (purecopy '(inversion 1 3)) package--builtin-versions)
+
(autoload 'inversion-require-emacs "inversion" "\
Declare that you need either EMACS-VER, XEMACS-VER or SXEMACS-ver.
Only checks one based on which kind of Emacs is being run.
@@ -15707,8 +16098,8 @@ Only checks one based on which kind of Emacs is being run.
;;;***
-;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (20922
-;;;;;; 60838 997229 0))
+;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (22003
+;;;;;; 64432 624146 533000))
;;; Generated autoloads from international/isearch-x.el
(autoload 'isearch-toggle-specified-input-method "isearch-x" "\
@@ -15728,10 +16119,11 @@ Toggle input method in interactive search.
;;;***
-;;;### (autoloads nil "isearchb" "isearchb.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "isearchb" "isearchb.el" (21767 65327 504606
+;;;;;; 256000))
;;; Generated autoloads from isearchb.el
-(push (purecopy (quote (isearchb 1 5))) package--builtin-versions)
+(push (purecopy '(isearchb 1 5)) package--builtin-versions)
+
(autoload 'isearchb-activate "isearchb" "\
Active isearchb mode for subsequent alphanumeric keystrokes.
Executing this command again will terminate the search; or, if
@@ -15742,8 +16134,8 @@ accessed via isearchb.
;;;***
-;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (20791
-;;;;;; 9657 561026 0))
+;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (22011
+;;;;;; 58553 645858 469000))
;;; Generated autoloads from international/iso-cvt.el
(autoload 'iso-spanish "iso-cvt" "\
@@ -15834,15 +16226,15 @@ Add submenus to the File menu, to convert to and from various formats.
;;;***
;;;### (autoloads nil "iso-transl" "international/iso-transl.el"
-;;;;;; (20791 9657 561026 0))
+;;;;;; (21840 19142 552627 956000))
;;; Generated autoloads from international/iso-transl.el
(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)
;;;***
-;;;### (autoloads nil "ispell" "textmodes/ispell.el" (20847 51240
-;;;;;; 240216 0))
+;;;### (autoloads nil "ispell" "textmodes/ispell.el" (22011 58554
+;;;;;; 45858 469000))
;;; Generated autoloads from textmodes/ispell.el
(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
@@ -15850,7 +16242,7 @@ Add submenus to the File menu, to convert to and from various formats.
(defvar ispell-personal-dictionary nil "\
File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
-\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
+\"~/.aspell.LANG.pws\" for Aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code.")
(custom-autoload 'ispell-personal-dictionary "ispell" t)
@@ -15997,7 +16389,7 @@ Check the current buffer for spelling errors interactively.
(autoload 'ispell-buffer-with-debug "ispell" "\
`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
-Use APPEND to append the info to previous buffer if exists.
+If APPEND is non-n il, append the info to previous buffer if exists.
\(fn &optional APPEND)" t nil)
@@ -16007,8 +16399,8 @@ Continue a halted spelling session beginning with the current word.
\(fn)" t nil)
(autoload 'ispell-complete-word "ispell" "\
-Try to complete the word before or under point (see `lookup-words').
-If optional INTERIOR-FRAG is non-nil then the word may be a character
+Try to complete the word before or at point.
+If optional INTERIOR-FRAG is non-nil, then the word may be a character
sequence inside of a word.
Standard ispell choices are then available.
@@ -16043,7 +16435,7 @@ typing SPC or RET warns you if the previous word is incorrectly
spelled.
All the buffer-local variables and dictionaries are ignored. To
-read them into the running ispell process, type \\[ispell-word]
+read them into the running Ispell process, type \\[ispell-word]
SPC.
For spell-checking \"on the fly\", not just after typing SPC or
@@ -16062,47 +16454,21 @@ The `X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
in your init file:
- (add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
- (add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
- (add-hook 'mail-send-hook 'ispell-message)
- (add-hook 'mh-before-send-letter-hook 'ispell-message)
+ (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5
+ (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4
+ (add-hook \\='mail-send-hook \\='ispell-message)
+ (add-hook \\='mh-before-send-letter-hook \\='ispell-message)
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)))
+ (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "iswitchb" "iswitchb.el" (20824 3367 300658
-;;;;;; 0))
-;;; Generated autoloads from iswitchb.el
-
-(defvar iswitchb-mode nil "\
-Non-nil if Iswitchb mode is enabled.
-See the command `iswitchb-mode' 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 `iswitchb-mode'.")
-
-(custom-autoload 'iswitchb-mode "iswitchb" nil)
-
-(autoload 'iswitchb-mode "iswitchb" "\
-Toggle Iswitchb mode.
-With a prefix argument ARG, enable Iswitchb mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-Iswitchb mode is a global minor mode that enables switching
-between buffers using substrings. See `iswitchb' for details.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "japan-util" "language/japan-util.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "japan-util" "language/japan-util.el" (22011
+;;;;;; 58553 673858 469000))
;;; Generated autoloads from language/japan-util.el
(autoload 'setup-japanese-environment-internal "japan-util" "\
@@ -16115,9 +16481,9 @@ Convert argument to Katakana and return that.
The argument may be a character or string. The result has the same type.
The argument object is not altered--the value is a copy.
Optional argument HANKAKU t means to convert to `hankaku' Katakana
- (`japanese-jisx0201-kana'), in which case return value
- may be a string even if OBJ is a character if two Katakanas are
- necessary to represent OBJ.
+\(`japanese-jisx0201-kana'), in which case return value
+may be a string even if OBJ is a character if two Katakanas are
+necessary to represent OBJ.
\(fn OBJ &optional HANKAKU)" nil nil)
@@ -16179,8 +16545,8 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
;;;***
-;;;### (autoloads nil "jka-compr" "jka-compr.el" (20759 33211 414988
-;;;;;; 0))
+;;;### (autoloads nil "jka-compr" "jka-compr.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from jka-compr.el
(defvar jka-compr-inhibit nil "\
@@ -16203,25 +16569,29 @@ by `jka-compr-installed'.
;;;***
-;;;### (autoloads nil "js" "progmodes/js.el" (20895 15912 444844
-;;;;;; 0))
+;;;### (autoloads nil "js" "progmodes/js.el" (22026 25907 635502
+;;;;;; 692000))
;;; Generated autoloads from progmodes/js.el
-(push (purecopy (quote (js 9))) package--builtin-versions)
+(push (purecopy '(js 9)) package--builtin-versions)
+
(autoload 'js-mode "js" "\
Major mode for editing JavaScript.
\(fn)" t nil)
(defalias 'javascript-mode 'js-mode)
+(dolist (name (list "node" "nodejs" "gjs" "rhino")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode)))
+
;;;***
-;;;### (autoloads nil "json" "json.el" (20709 26818 907104 0))
+;;;### (autoloads nil "json" "json.el" (21998 46517 78024 649000))
;;; Generated autoloads from json.el
-(push (purecopy (quote (json 1 4))) package--builtin-versions)
+(push (purecopy '(json 1 4)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "keypad" "emulation/keypad.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "keypad" "emulation/keypad.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from emulation/keypad.el
(defvar keypad-setup nil "\
@@ -16276,8 +16646,8 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.'
;;;***
-;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from international/kinsoku.el
(autoload 'kinsoku "kinsoku" "\
@@ -16298,8 +16668,8 @@ the context of text formatting.
;;;***
-;;;### (autoloads nil "kkc" "international/kkc.el" (20799 169 640767
-;;;;;; 0))
+;;;### (autoloads nil "kkc" "international/kkc.el" (21978 61237 570488
+;;;;;; 269000))
;;; Generated autoloads from international/kkc.el
(defvar kkc-after-update-conversion-functions nil "\
@@ -16321,7 +16691,7 @@ and the return value is the length of the conversion.
;;;***
-;;;### (autoloads nil "kmacro" "kmacro.el" (20830 42150 757296 0))
+;;;### (autoloads nil "kmacro" "kmacro.el" (21990 52406 604500 385000))
;;; Generated autoloads from kmacro.el
(global-set-key "\C-x(" 'kmacro-start-macro)
(global-set-key "\C-x)" 'kmacro-end-macro)
@@ -16333,6 +16703,7 @@ and the return value is the length of the conversion.
(autoload 'kmacro-exec-ring-item "kmacro" "\
Execute item ITEM from the macro ring.
+ARG is the number of times to execute the item.
\(fn ITEM ARG)" nil nil)
@@ -16432,8 +16803,8 @@ If kbd macro currently being defined end it before activating it.
;;;***
-;;;### (autoloads nil "korea-util" "language/korea-util.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "korea-util" "language/korea-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/korea-util.el
(defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\
@@ -16447,39 +16818,8 @@ The kind of Korean keyboard for Korean input method.
;;;***
-;;;### (autoloads nil "landmark" "play/landmark.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from play/landmark.el
-
-(defalias 'landmark-repeat 'landmark-test-run)
-
-(autoload 'landmark-test-run "landmark" "\
-Run 100 Landmark games, each time saving the weights from the previous game.
-
-\(fn)" t nil)
-
-(autoload 'landmark "landmark" "\
-Start or resume an Landmark game.
-If a game is in progress, this command allows you to resume it.
-Here is the relation between prefix args and game options:
-
-prefix arg | robot is auto-started | weights are saved from last game
----------------------------------------------------------------------
-none / 1 | yes | no
- 2 | yes | yes
- 3 | no | yes
- 4 | no | no
-
-You start by moving to a square and typing \\[landmark-start-robot],
-if you did not use a prefix arg to ask for automatic start.
-Use \\[describe-mode] for more info.
-
-\(fn PARG)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "lao-util" "language/lao-util.el" (20826 45095
-;;;;;; 436233 0))
+;;;### (autoloads nil "lao-util" "language/lao-util.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from language/lao-util.el
(autoload 'lao-compose-string "lao-util" "\
@@ -16516,8 +16856,8 @@ Transcribe Romanized Lao string STR to Lao character string.
;;;***
-;;;### (autoloads nil "latexenc" "international/latexenc.el" (20799
-;;;;;; 169 640767 0))
+;;;### (autoloads nil "latexenc" "international/latexenc.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from international/latexenc.el
(defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\
@@ -16549,7 +16889,7 @@ coding system names is determined from `latex-inputenc-coding-alist'.
;;;***
;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el"
-;;;;;; (20826 45095 436233 0))
+;;;;;; (22011 58553 645858 469000))
;;; Generated autoloads from international/latin1-disp.el
(defvar latin1-display nil "\
@@ -16590,8 +16930,8 @@ use either \\[customize] or the function `latin1-display'.")
;;;***
-;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (20874
-;;;;;; 62962 290468 0))
+;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from progmodes/ld-script.el
(autoload 'ld-script-mode "ld-script" "\
@@ -16601,7 +16941,47 @@ A major mode to edit GNU ld script files
;;;***
-;;;### (autoloads nil "life" "play/life.el" (20709 26818 907104 0))
+;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (21890
+;;;;;; 39605 402073 663000))
+;;; Generated autoloads from emacs-lisp/let-alist.el
+(push (purecopy '(let-alist 1 0 4)) package--builtin-versions)
+
+(autoload 'let-alist "let-alist" "\
+Let-bind dotted symbols to their cdrs in ALIST and execute BODY.
+Dotted symbol is any symbol starting with a `.'. Only those present
+in BODY are let-bound and this search is done at compile time.
+
+For instance, the following code
+
+ (let-alist alist
+ (if (and .title .body)
+ .body
+ .site
+ .site.contents))
+
+essentially expands to
+
+ (let ((.title (cdr (assq 'title alist)))
+ (.body (cdr (assq 'body alist)))
+ (.site (cdr (assq 'site alist)))
+ (.site.contents (cdr (assq 'contents (cdr (assq 'site alist))))))
+ (if (and .title .body)
+ .body
+ .site
+ .site.contents))
+
+If you nest `let-alist' invocations, the inner one can't access
+the variables of the outer one. You can, however, access alists
+inside the original alist by using dots inside the symbol, as
+displayed in the example above.
+
+\(fn ALIST &rest BODY)" nil t)
+
+(function-put 'let-alist 'lisp-indent-function '1)
+
+;;;***
+
+;;;### (autoloads nil "life" "play/life.el" (21670 32331 385639 720000))
;;; Generated autoloads from play/life.el
(autoload 'life "life" "\
@@ -16614,9 +16994,10 @@ generations (this defaults to 1).
;;;***
-;;;### (autoloads nil "linum" "linum.el" (20709 26818 907104 0))
+;;;### (autoloads nil "linum" "linum.el" (21855 577 57945 485000))
;;; Generated autoloads from linum.el
-(push (purecopy (quote (linum 0 9 24))) package--builtin-versions)
+(push (purecopy '(linum 0 9 24)) package--builtin-versions)
+
(autoload 'linum-mode "linum" "\
Toggle display of line numbers in the left margin (Linum mode).
With a prefix argument ARG, enable Linum mode if ARG is positive,
@@ -16650,8 +17031,8 @@ See `linum-mode' for more information on Linum mode.
;;;***
-;;;### (autoloads nil "loadhist" "loadhist.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "loadhist" "loadhist.el" (22011 58553 673858
+;;;;;; 469000))
;;; Generated autoloads from loadhist.el
(autoload 'unload-feature "loadhist" "\
@@ -16682,7 +17063,7 @@ something strange, such as redefining an Emacs function.
;;;***
-;;;### (autoloads nil "locate" "locate.el" (20763 30266 231060 0))
+;;;### (autoloads nil "locate" "locate.el" (21670 32331 385639 720000))
;;; Generated autoloads from locate.el
(defvar locate-ls-subdir-switches (purecopy "-al") "\
@@ -16734,8 +17115,8 @@ except that FILTER is not optional.
;;;***
-;;;### (autoloads nil "log-edit" "vc/log-edit.el" (20721 17977 14204
-;;;;;; 0))
+;;;### (autoloads nil "log-edit" "vc/log-edit.el" (22011 58554 93858
+;;;;;; 469000))
;;; Generated autoloads from vc/log-edit.el
(autoload 'log-edit "log-edit" "\
@@ -16766,8 +17147,8 @@ done. Otherwise, it uses the current buffer.
;;;***
-;;;### (autoloads nil "log-view" "vc/log-view.el" (20918 63784 852859
-;;;;;; 0))
+;;;### (autoloads nil "log-view" "vc/log-view.el" (21947 19252 637252
+;;;;;; 749000))
;;; Generated autoloads from vc/log-view.el
(autoload 'log-view-mode "log-view" "\
@@ -16777,7 +17158,7 @@ Major mode for browsing CVS log output.
;;;***
-;;;### (autoloads nil "lpr" "lpr.el" (20878 6823 881439 0))
+;;;### (autoloads nil "lpr" "lpr.el" (22011 58553 673858 469000))
;;; Generated autoloads from lpr.el
(defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\
@@ -16872,8 +17253,8 @@ for further customization of the printer command.
;;;***
-;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (20870 12718 549931
-;;;;;; 0))
+;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (21993 28596 150597
+;;;;;; 473000))
;;; Generated autoloads from ls-lisp.el
(defvar ls-lisp-support-shell-wildcards t "\
@@ -16884,8 +17265,8 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).")
;;;***
-;;;### (autoloads nil "lunar" "calendar/lunar.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "lunar" "calendar/lunar.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from calendar/lunar.el
(autoload 'lunar-phases "lunar" "\
@@ -16895,12 +17276,10 @@ This function is suitable for execution in an init file.
\(fn &optional ARG)" t nil)
-(define-obsolete-function-alias 'phases-of-moon 'lunar-phases "23.1")
-
;;;***
-;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (20874 62962
-;;;;;; 290468 0))
+;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (22015 55603
+;;;;;; 805705 321000))
;;; Generated autoloads from progmodes/m4-mode.el
(autoload 'm4-mode "m4-mode" "\
@@ -16910,7 +17289,7 @@ A major mode to edit m4 macro files.
;;;***
-;;;### (autoloads nil "macros" "macros.el" (20709 26818 907104 0))
+;;;### (autoloads nil "macros" "macros.el" (21887 28847 979667 16000))
;;; Generated autoloads from macros.el
(autoload 'name-last-kbd-macro "macros" "\
@@ -16922,7 +17301,8 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
\(fn SYMBOL)" t nil)
(autoload 'insert-kbd-macro "macros" "\
-Insert in buffer the definition of kbd macro NAME, as Lisp code.
+Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
+MACRONAME should be a symbol.
Optional second arg KEYS means also record the keys it is on
\(this is the prefix argument, when calling interactively).
@@ -16998,8 +17378,8 @@ and then select the region of un-tablified names and use
;;;***
-;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (22026 25907
+;;;;;; 599502 692000))
;;; Generated autoloads from mail/mail-extr.el
(autoload 'mail-extract-address-components "mail-extr" "\
@@ -17029,8 +17409,8 @@ Convert mail domain DOMAIN to the country it corresponds to.
;;;***
-;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from mail/mail-hist.el
(autoload 'mail-hist-define-keys "mail-hist" "\
@@ -17059,8 +17439,8 @@ This function normally would be called when the message is sent.
;;;***
-;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (20891 18859
-;;;;;; 893295 0))
+;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (21964 28338
+;;;;;; 125695 749000))
;;; Generated autoloads from mail/mail-utils.el
(defvar mail-use-rfc822 nil "\
@@ -17134,8 +17514,8 @@ matches may be returned from the message body.
;;;***
-;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (20847 51240
-;;;;;; 240216 0))
+;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (21850 35149
+;;;;;; 497265 880000))
;;; Generated autoloads from mail/mailabbrev.el
(defvar mail-abbrevs-mode nil "\
@@ -17184,13 +17564,13 @@ double-quotes.
;;;***
-;;;### (autoloads nil "mailalias" "mail/mailalias.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mailalias" "mail/mailalias.el" (21993 28596
+;;;;;; 166597 473000))
;;; Generated autoloads from mail/mailalias.el
(defvar mail-complete-style 'angles "\
Specifies how \\[mail-complete] formats the full name when it completes.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
@@ -17238,8 +17618,8 @@ current header, calls `mail-complete-function' and passes prefix ARG if any.
;;;***
-;;;### (autoloads nil "mailclient" "mail/mailclient.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mailclient" "mail/mailclient.el" (22011 58553
+;;;;;; 693858 469000))
;;; Generated autoloads from mail/mailclient.el
(autoload 'mailclient-send-it "mailclient" "\
@@ -17251,8 +17631,8 @@ The mail client is taken to be the handler of mailto URLs.
;;;***
-;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (20924
-;;;;;; 16196 967284 0))
+;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (22011
+;;;;;; 58553 913858 469000))
;;; Generated autoloads from progmodes/make-mode.el
(autoload 'makefile-mode "make-mode" "\
@@ -17369,8 +17749,8 @@ An adapted `makefile-mode' that knows about imake.
;;;***
-;;;### (autoloads nil "makesum" "makesum.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "makesum" "makesum.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from makesum.el
(autoload 'make-command-summary "makesum" "\
@@ -17381,19 +17761,21 @@ Previous contents of that buffer are killed first.
;;;***
-;;;### (autoloads nil "man" "man.el" (20888 42662 256824 0))
+;;;### (autoloads nil "man" "man.el" (22026 25907 603502 692000))
;;; Generated autoloads from man.el
(defalias 'manual-entry 'man)
(autoload 'man "man" "\
Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package. It
-runs a Un*x command to retrieve and clean a manpage in the
+This command is the top-level command in the man package.
+It runs a Un*x command to retrieve and clean a manpage in the
background and places the results in a `Man-mode' browsing
-buffer. See variable `Man-notify-method' for what happens when
-the buffer is ready. If a buffer already exists for this man
-page, it will display immediately.
+buffer. The variable `Man-width' defines the number of columns in
+formatted manual pages. The buffer is displayed immediately.
+The variable `Man-notify-method' defines how the buffer is displayed.
+If a buffer already exists for this man page, it will be displayed
+without running the man command.
For a manpage from a particular section, use either of the
following. \"cat(1)\" is how cross-references appear and is
@@ -17435,9 +17817,17 @@ Default bookmark handler for Man buffers.
;;;***
-;;;### (autoloads nil "master" "master.el" (20884 7264 912957 506000))
+;;;### (autoloads nil "map" "emacs-lisp/map.el" (21996 4784 808983
+;;;;;; 429000))
+;;; Generated autoloads from emacs-lisp/map.el
+(push (purecopy '(map 1 0)) package--builtin-versions)
+
+;;;***
+
+;;;### (autoloads nil "master" "master.el" (21670 32331 385639 720000))
;;; Generated autoloads from master.el
-(push (purecopy (quote (master 1 0 2))) package--builtin-versions)
+(push (purecopy '(master 1 0 2)) package--builtin-versions)
+
(autoload 'master-mode "master" "\
Toggle Master mode.
With a prefix argument ARG, enable Master mode if ARG is
@@ -17457,8 +17847,8 @@ yourself the value of `master-of' by calling `master-show-slave'.
;;;***
-;;;### (autoloads nil "mb-depth" "mb-depth.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "mb-depth" "mb-depth.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from mb-depth.el
(defvar minibuffer-depth-indicate-mode nil "\
@@ -17485,13 +17875,14 @@ recursion depth in the minibuffer prompt. This is only useful if
;;;***
-;;;### (autoloads nil "md4" "md4.el" (20709 26818 907104 0))
+;;;### (autoloads nil "md4" "md4.el" (21670 32331 385639 720000))
;;; Generated autoloads from md4.el
-(push (purecopy (quote (md4 1 0))) package--builtin-versions)
+(push (purecopy '(md4 1 0)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "message" "gnus/message.el" (20889 63525 775294
-;;;;;; 0))
+;;;### (autoloads nil "message" "gnus/message.el" (22011 58553 581858
+;;;;;; 469000))
;;; Generated autoloads from gnus/message.el
(define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)
@@ -17656,10 +18047,11 @@ which specify the range to operate on.
;;;***
-;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (20874
-;;;;;; 62962 290468 0))
+;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from progmodes/meta-mode.el
-(push (purecopy (quote (meta-mode 1 0))) package--builtin-versions)
+(push (purecopy '(meta-mode 1 0)) package--builtin-versions)
+
(autoload 'metafont-mode "meta-mode" "\
Major mode for editing Metafont sources.
@@ -17672,8 +18064,8 @@ Major mode for editing MetaPost sources.
;;;***
-;;;### (autoloads nil "metamail" "mail/metamail.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "metamail" "mail/metamail.el" (21980 16567
+;;;;;; 769544 893000))
;;; Generated autoloads from mail/metamail.el
(autoload 'metamail-interpret-header "metamail" "\
@@ -17704,7 +18096,7 @@ redisplayed as output is inserted.
\(fn &optional VIEWMODE BUFFER NODISPLAY)" t nil)
(autoload 'metamail-region "metamail" "\
-Process current region through '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
@@ -17716,8 +18108,8 @@ redisplayed as output is inserted.
;;;***
-;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (20890 54503 125088
-;;;;;; 852000))
+;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (22011 58553 729858
+;;;;;; 469000))
;;; Generated autoloads from mh-e/mh-comp.el
(autoload 'mh-smail "mh-comp" "\
@@ -17807,9 +18199,10 @@ delete the draft message.
;;;***
-;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (20874 65006 672942 217000))
+;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (22011 58553 749858 469000))
;;; Generated autoloads from mh-e/mh-e.el
-(push (purecopy (quote (mh-e 8 5))) package--builtin-versions)
+(push (purecopy '(mh-e 8 6)) package--builtin-versions)
+
(put 'mh-progs 'risky-local-variable t)
(put 'mh-lib 'risky-local-variable t)
@@ -17823,8 +18216,8 @@ Display version information about MH-E and the MH mail handling system.
;;;***
-;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (20787 12616
-;;;;;; 976036 0))
+;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (22011 58553
+;;;;;; 749858 469000))
;;; Generated autoloads from mh-e/mh-folder.el
(autoload 'mh-rmail "mh-folder" "\
@@ -17905,10 +18298,24 @@ perform the operation on all messages in that region.
;;;***
-;;;### (autoloads nil "midnight" "midnight.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "midnight" "midnight.el" (21822 58098 20521
+;;;;;; 61000))
;;; Generated autoloads from midnight.el
+(defvar midnight-mode nil "\
+Non-nil if Midnight mode is enabled.
+See the command `midnight-mode' 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 `midnight-mode'.")
+
+(custom-autoload 'midnight-mode "midnight" nil)
+
+(autoload 'midnight-mode "midnight" "\
+Non-nil means run `midnight-hook' at midnight.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'clean-buffer-list "midnight" "\
Kill old buffers that have not been displayed recently.
The relevant variables are `clean-buffer-list-delay-general',
@@ -17932,8 +18339,8 @@ to its second argument TM.
;;;***
-;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (20760 54070
-;;;;;; 584283 0))
+;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from minibuf-eldef.el
(defvar minibuffer-electric-default-mode nil "\
@@ -17962,7 +18369,7 @@ is modified to remove the default indication.
;;;***
-;;;### (autoloads nil "misc" "misc.el" (20709 26818 907104 0))
+;;;### (autoloads nil "misc" "misc.el" (21670 32331 385639 720000))
;;; Generated autoloads from misc.el
(autoload 'butterfly "misc" "\
@@ -17990,8 +18397,7 @@ The return value is always nil.
;;;***
-;;;### (autoloads nil "misearch" "misearch.el" (20721 17977 14204
-;;;;;; 0))
+;;;### (autoloads nil "misearch" "misearch.el" (21797 36 720489 297000))
;;; Generated autoloads from misearch.el
(add-hook 'isearch-mode-hook 'multi-isearch-setup)
@@ -18026,6 +18432,13 @@ Isearch starts.")
The buffer where the search is currently searching.
The value is nil when the search still is in the initial buffer.")
+(defvar multi-isearch-buffer-list nil "\
+Sequence of buffers visited by multiple buffers Isearch.
+This is nil if Isearch is not currently searching more than one buffer.")
+
+(defvar multi-isearch-file-list nil "\
+Sequence of files visited by multiple file buffers Isearch.")
+
(autoload 'multi-isearch-setup "misearch" "\
Set up isearch to search multiple buffers.
Intended to be added to `isearch-mode-hook'.
@@ -18072,10 +18485,11 @@ whose file names match the specified wildcard.
;;;***
-;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from progmodes/mixal-mode.el
-(push (purecopy (quote (mixal-mode 0 1))) package--builtin-versions)
+(push (purecopy '(mixal-mode 0 1)) package--builtin-versions)
+
(autoload 'mixal-mode "mixal-mode" "\
Major mode for the mixal asm language.
@@ -18083,8 +18497,8 @@ Major mode for the mixal asm language.
;;;***
-;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/mm-encode.el
(autoload 'mm-default-file-encoding "mm-encode" "\
@@ -18094,8 +18508,8 @@ Return a default encoding for FILE.
;;;***
-;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/mm-extern.el
(autoload 'mm-extern-cache-contents "mm-extern" "\
@@ -18113,8 +18527,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
;;;***
-;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/mm-partial.el
(autoload 'mm-inline-partial "mm-partial" "\
@@ -18127,8 +18541,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing.
;;;***
-;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from gnus/mm-url.el
(autoload 'mm-url-insert-file-contents "mm-url" "\
@@ -18144,8 +18558,8 @@ Insert file contents of URL using `mm-url-program'.
;;;***
-;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (22010 37685 116774
+;;;;;; 305000))
;;; Generated autoloads from gnus/mm-uu.el
(autoload 'mm-uu-dissect "mm-uu" "\
@@ -18164,7 +18578,7 @@ Assume text has been decoded if DECODED is non-nil.
;;;***
-;;;### (autoloads nil "mml" "gnus/mml.el" (20829 21286 719109 0))
+;;;### (autoloads nil "mml" "gnus/mml.el" (21826 49866 790514 606000))
;;; Generated autoloads from gnus/mml.el
(autoload 'mml-to-mime "mml" "\
@@ -18189,8 +18603,8 @@ body) or \"attachment\" (separate from the body).
;;;***
-;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (20875 30633 412173
-;;;;;; 0))
+;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from gnus/mml1991.el
(autoload 'mml1991-encrypt "mml1991" "\
@@ -18205,8 +18619,8 @@ body) or \"attachment\" (separate from the body).
;;;***
-;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (20922 60838 997229
-;;;;;; 0))
+;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from gnus/mml2015.el
(autoload 'mml2015-decrypt "mml2015" "\
@@ -18246,16 +18660,16 @@ body) or \"attachment\" (separate from the body).
;;;***
-;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (22011 58553
+;;;;;; 245858 469000))
;;; Generated autoloads from cedet/mode-local.el
(put 'define-overloadable-function 'doc-string-elt 3)
;;;***
-;;;### (autoloads nil "modula2" "progmodes/modula2.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21607 54478
+;;;;;; 800121 42000))
;;; Generated autoloads from progmodes/modula2.el
(defalias 'modula-2-mode 'm2-mode)
@@ -18288,8 +18702,8 @@ followed by the first character of the construct.
;;;***
-;;;### (autoloads nil "morse" "play/morse.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "morse" "play/morse.el" (22026 25907 631502
+;;;;;; 692000))
;;; Generated autoloads from play/morse.el
(autoload 'morse-region "morse" "\
@@ -18314,8 +18728,8 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text.
;;;***
-;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (21993 28596 194597
+;;;;;; 473000))
;;; Generated autoloads from mouse-drag.el
(autoload 'mouse-drag-throw "mouse-drag" "\
@@ -18338,7 +18752,7 @@ about which direction is natural. Perhaps it has to do with which
hemisphere you're in.)
To test this function, evaluate:
- (global-set-key [down-mouse-2] 'mouse-drag-throw)
+ (global-set-key [down-mouse-2] \\='mouse-drag-throw)
\(fn START-EVENT)" t nil)
@@ -18356,13 +18770,13 @@ Drag scrolling is identical to the \"hand\" option in MacPaint, or the
middle button in Tk text widgets.
To test this function, evaluate:
- (global-set-key [down-mouse-2] 'mouse-drag-drag)
+ (global-set-key [down-mouse-2] \\='mouse-drag-drag)
\(fn START-EVENT)" t nil)
;;;***
-;;;### (autoloads nil "mpc" "mpc.el" (20838 36262 626321 0))
+;;;### (autoloads nil "mpc" "mpc.el" (22002 43570 536887 749000))
;;; Generated autoloads from mpc.el
(autoload 'mpc "mpc" "\
@@ -18372,7 +18786,7 @@ Main entry point for MPC.
;;;***
-;;;### (autoloads nil "mpuz" "play/mpuz.el" (20709 26818 907104 0))
+;;;### (autoloads nil "mpuz" "play/mpuz.el" (21670 32331 385639 720000))
;;; Generated autoloads from play/mpuz.el
(autoload 'mpuz "mpuz" "\
@@ -18382,7 +18796,7 @@ Multiplication puzzle with GNU Emacs.
;;;***
-;;;### (autoloads nil "msb" "msb.el" (20709 26818 907104 0))
+;;;### (autoloads nil "msb" "msb.el" (22011 58553 757858 469000))
;;; Generated autoloads from msb.el
(defvar msb-mode nil "\
@@ -18407,8 +18821,8 @@ different buffer menu using the function `msb'.
;;;***
-;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (20891
-;;;;;; 18859 893295 0))
+;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (21998
+;;;;;; 46517 78024 649000))
;;; Generated autoloads from international/mule-diag.el
(autoload 'list-character-sets "mule-diag" "\
@@ -18540,8 +18954,8 @@ The default is 20. If LIMIT is negative, do not limit the listing.
;;;***
-;;;### (autoloads nil "mule-util" "international/mule-util.el" (20826
-;;;;;; 45095 436233 0))
+;;;### (autoloads nil "mule-util" "international/mule-util.el" (22002
+;;;;;; 43570 532887 749000))
;;; Generated autoloads from international/mule-util.el
(defsubst string-to-list (string) "\
@@ -18577,7 +18991,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 \"...\".
+defaults to `truncate-string-ellipsis'.
\(fn STR END-COLUMN &optional START-COLUMN PADDING ELLIPSIS)" nil nil)
@@ -18670,96 +19084,38 @@ per-character basis, this may not be accurate.
\(fn CHAR)" nil nil)
-;;;***
-
-;;;### (autoloads nil "nadvice" "emacs-lisp/nadvice.el" (20940 4391
-;;;;;; 641153 0))
-;;; Generated autoloads from emacs-lisp/nadvice.el
-
-(autoload 'advice--remove-function "nadvice" "\
-
-
-\(fn FLIST FUNCTION)" nil nil)
-
-(autoload 'advice--buffer-local "nadvice" "\
-Buffer-local value of VAR, presumed to contain a function.
-
-\(fn VAR)" nil nil)
-
-(autoload 'add-function "nadvice" "\
-Add a piece of advice on the function stored at PLACE.
-FUNCTION describes the code to add. WHERE describes where to add it.
-WHERE can be explained by showing the resulting new function, as the
-result of combining FUNCTION and the previous value of PLACE, which we
-call OLDFUN here:
-`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
-`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
-`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r))
-`:override' (lambda (&rest r) (apply FUNCTION r))
-`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
-`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r)))
-`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
-`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r)))
-`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r)))
-`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r)))
-If FUNCTION was already added, do nothing.
-PROPS is an alist of additional properties, among which the following have
-a special meaning:
-- `name': a string or symbol. It can be used to refer to this piece of advice.
-
-If PLACE is a simple variable, only its global value will be affected.
-Use (local 'VAR) if you want to apply FUNCTION to VAR buffer-locally.
-
-If one of FUNCTION or OLDFUN is interactive, then the resulting function
-is also interactive. There are 3 cases:
-- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
-- The interactive spec of FUNCTION is itself a function: it should take one
- argument (the interactive spec of OLDFUN, which it can pass to
- `advice-eval-interactive-spec') and return the list of arguments to use.
-- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN.
-
-\(fn WHERE PLACE FUNCTION &optional PROPS)" nil t)
-
-(autoload 'advice--add-function "nadvice" "\
-
-
-\(fn WHERE REF FUNCTION PROPS)" nil nil)
-
-(autoload 'remove-function "nadvice" "\
-Remove the FUNCTION piece of advice from PLACE.
-If FUNCTION was not added to PLACE, do nothing.
-Instead of FUNCTION being the actual function, it can also be the `name'
-of the piece of advice.
-
-\(fn PLACE FUNCTION)" nil t)
-
-(autoload 'advice-add "nadvice" "\
-Like `add-function' but for the function named SYMBOL.
-Contrary to `add-function', this will properly handle the cases where SYMBOL
-is defined as a macro, alias, command, ...
-
-\(fn SYMBOL WHERE FUNCTION &optional PROPS)" nil nil)
-
-(autoload 'advice-remove "nadvice" "\
-Like `remove-function' but for the function named SYMBOL.
-Contrary to `remove-function', this also works when SYMBOL is a macro
-or an autoload and it preserves `fboundp'.
-Instead of the actual function to remove, FUNCTION can also be the `name'
-of the piece of advice.
-
-\(fn SYMBOL FUNCTION)" nil nil)
-
-(autoload 'advice-member-p "nadvice" "\
-Return non-nil if ADVICE has been added to FUNCTION-NAME.
-Instead of ADVICE being the actual function, it can also be the `name'
-of the piece of advice.
-
-\(fn ADVICE FUNCTION-NAME)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "net-utils" "net/net-utils.el" (20903 10024
-;;;;;; 645978 0))
+(autoload 'filepos-to-bufferpos "mule-util" "\
+Try to return the buffer position corresponding to a particular file position.
+The file position is given as a (0-based) BYTE count.
+The function presumes the file is encoded with CODING-SYSTEM, which defaults
+to `buffer-file-coding-system'.
+QUALITY can be:
+ `approximate', in which case we may cut some corners to avoid
+ excessive work.
+ `exact', in which case we may end up re-(en/de)coding a large
+ part of the file/buffer.
+ nil, in which case we may return nil rather than an approximation.
+
+\(fn BYTE &optional QUALITY CODING-SYSTEM)" nil nil)
+
+(autoload 'bufferpos-to-filepos "mule-util" "\
+Try to return the file byte corresponding to a particular buffer POSITION.
+Value is the file position given as a (0-based) byte count.
+The function presumes the file is encoded with CODING-SYSTEM, which defaults
+to `buffer-file-coding-system'.
+QUALITY can be:
+ `approximate', in which case we may cut some corners to avoid
+ excessive work.
+ `exact', in which case we may end up re-(en/de)coding a large
+ part of the file/buffer.
+ nil, in which case we may return nil rather than an approximation.
+
+\(fn POSITION &optional QUALITY CODING-SYSTEM)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "net-utils" "net/net-utils.el" (22011 58553
+;;;;;; 761858 469000))
;;; Generated autoloads from net/net-utils.el
(autoload 'ifconfig "net-utils" "\
@@ -18853,8 +19209,8 @@ Open a network connection to HOST on PORT.
;;;***
-;;;### (autoloads nil "netrc" "net/netrc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "netrc" "net/netrc.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from net/netrc.el
(autoload 'netrc-credentials "netrc" "\
@@ -18866,8 +19222,8 @@ listed in the PORTS list.
;;;***
-;;;### (autoloads nil "network-stream" "net/network-stream.el" (20770
-;;;;;; 3512 176098 0))
+;;;### (autoloads nil "network-stream" "net/network-stream.el" (21855
+;;;;;; 577 147947 107000))
;;; Generated autoloads from net/network-stream.el
(autoload 'open-network-stream "network-stream" "\
@@ -18940,7 +19296,7 @@ values:
:client-certificate should either be a list where the first
element is the certificate key file name, and the second
- element is the certificate file name itself, or `t', which
+ element is the certificate file name itself, or t, which
means that `auth-source' will be queried for the key and the
certificate. This parameter will only be used when doing TLS
or STARTTLS connections.
@@ -18948,8 +19304,14 @@ values:
:use-starttls-if-possible is a boolean that says to do opportunistic
STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
+:warn-unless-encrypted is a boolean which, if :return-list is
+non-nil, is used warn the user if the connection isn't encrypted.
+
+:nogreeting is a boolean that can be used to inhibit waiting for
+a greeting from the server.
+
:nowait is a boolean that says the connection should be made
- asynchronously, if possible.
+asynchronously, if possible.
\(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil)
@@ -18957,8 +19319,8 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
;;;***
-;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (22011
+;;;;;; 58553 765858 469000))
;;; Generated autoloads from net/newst-backend.el
(autoload 'newsticker-running-p "newst-backend" "\
@@ -18980,7 +19342,7 @@ Run `newsticker-start-hook' if newsticker was not running already.
;;;***
;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el"
-;;;;;; (20762 9398 526093 0))
+;;;;;; (21980 16567 809544 893000))
;;; Generated autoloads from net/newst-plainview.el
(autoload 'newsticker-plainview "newst-plainview" "\
@@ -18990,8 +19352,8 @@ Start newsticker plainview.
;;;***
-;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (22011
+;;;;;; 58553 765858 469000))
;;; Generated autoloads from net/newst-reader.el
(autoload 'newsticker-show-news "newst-reader" "\
@@ -19001,8 +19363,8 @@ Start reading news. You may want to bind this to a key.
;;;***
-;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from net/newst-ticker.el
(autoload 'newsticker-ticker-running-p "newst-ticker" "\
@@ -19022,8 +19384,8 @@ running already.
;;;***
-;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (21998
+;;;;;; 46517 110024 649000))
;;; Generated autoloads from net/newst-treeview.el
(autoload 'newsticker-treeview "newst-treeview" "\
@@ -19033,14 +19395,8 @@ Start newsticker treeview.
;;;***
-;;;### (autoloads nil "newsticker" "net/newsticker.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from net/newsticker.el
-(push (purecopy (quote (newsticker 1 99))) package--builtin-versions)
-;;;***
-
-;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (21990 52406 596500
+;;;;;; 385000))
;;; Generated autoloads from gnus/nndiary.el
(autoload 'nndiary-generate-nov-databases "nndiary" "\
@@ -19050,8 +19406,8 @@ Generate NOV databases in all nndiary directories.
;;;***
-;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (22011 58553 585858
+;;;;;; 469000))
;;; Generated autoloads from gnus/nndoc.el
(autoload 'nndoc-add-type "nndoc" "\
@@ -19065,8 +19421,8 @@ symbol in the alist.
;;;***
-;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/nnfolder.el
(autoload 'nnfolder-generate-active-file "nnfolder" "\
@@ -19077,13 +19433,7 @@ This command does not work if you use short group names.
;;;***
-;;;### (autoloads nil "nnmairix" "gnus/nnmairix.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from gnus/nnmairix.el
-(push (purecopy (quote (nnmairix 0 6))) package--builtin-versions)
-;;;***
-
-;;;### (autoloads nil "nnml" "gnus/nnml.el" (20709 26818 907104 0))
+;;;### (autoloads nil "nnml" "gnus/nnml.el" (21948 40114 266686 453000))
;;; Generated autoloads from gnus/nnml.el
(autoload 'nnml-generate-nov-databases "nnml" "\
@@ -19093,7 +19443,7 @@ Generate NOV databases in all nnml directories.
;;;***
-;;;### (autoloads nil "novice" "novice.el" (20709 26818 907104 0))
+;;;### (autoloads nil "novice" "novice.el" (21985 34484 234705 925000))
;;; Generated autoloads from novice.el
(define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1")
@@ -19125,8 +19475,8 @@ future sessions.
;;;***
-;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (21670
+;;;;;; 32331 885635 586000))
;;; Generated autoloads from textmodes/nroff-mode.el
(autoload 'nroff-mode "nroff-mode" "\
@@ -19140,13 +19490,14 @@ closing requests for requests that are used in matched pairs.
;;;***
-;;;### (autoloads nil "ntlm" "net/ntlm.el" (20709 26818 907104 0))
+;;;### (autoloads nil "ntlm" "net/ntlm.el" (21997 25649 666447 325000))
;;; Generated autoloads from net/ntlm.el
-(push (purecopy (quote (ntlm 1 0))) package--builtin-versions)
+(push (purecopy '(ntlm 2 0)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from nxml/nxml-glyph.el
(autoload 'nxml-glyph-display-string "nxml-glyph" "\
@@ -19158,8 +19509,8 @@ Return nil if the face cannot display a glyph for N.
;;;***
-;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (20884 6711
-;;;;;; 386198 0))
+;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (22021 7991
+;;;;;; 61719 83000))
;;; Generated autoloads from nxml/nxml-mode.el
(autoload 'nxml-mode "nxml-mode" "\
@@ -19215,13 +19566,12 @@ Many aspects this mode can be customized using
\\[customize-group] nxml RET.
\(fn)" t nil)
-
(defalias 'xml-mode 'nxml-mode)
;;;***
-;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from nxml/nxml-uchnm.el
(autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\
@@ -19233,8 +19583,8 @@ the variable `nxml-enabled-unicode-blocks'.
;;;***
-;;;### (autoloads nil "octave" "progmodes/octave.el" (20932 10282
-;;;;;; 564846 0))
+;;;### (autoloads nil "octave" "progmodes/octave.el" (22027 46774
+;;;;;; 680310 591000))
;;; Generated autoloads from progmodes/octave.el
(autoload 'octave-mode "octave" "\
@@ -19245,6 +19595,11 @@ computations. It provides a convenient command line interface
for solving linear and nonlinear problems numerically. Function
definitions can also be stored in files and used in batch mode.
+See Info node `(octave-mode) Using Octave Mode' for more details.
+
+Key bindings:
+\\{octave-mode-map}
+
\(fn)" t nil)
(autoload 'inferior-octave "octave" "\
@@ -19266,14 +19621,14 @@ startup file, `~/.emacs-octave'.
;;;***
-;;;### (autoloads nil "opascal" "progmodes/opascal.el" (20858 21542
-;;;;;; 723007 0))
+;;;### (autoloads nil "opascal" "progmodes/opascal.el" (21948 40114
+;;;;;; 450686 453000))
;;; Generated autoloads from progmodes/opascal.el
(define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4")
(autoload 'opascal-mode "opascal" "\
-Major mode for editing OPascal code. \\<opascal-mode-map>
+Major mode for editing OPascal code.\\<opascal-mode-map>
\\[opascal-find-unit] - Search for a OPascal source file.
\\[opascal-fill-comment] - Fill the current comment.
\\[opascal-new-comment-line] - If in a // comment, do a new comment line.
@@ -19288,9 +19643,6 @@ Customization:
Extra indentation for blocks in compound statements.
`opascal-case-label-indent' (default 0)
Extra indentation for case statement labels.
- `opascal-tab-always-indents' (default `tab-always-indents')
- Non-nil means TAB in OPascal mode should always reindent the current line,
- regardless of where in the line point is when the TAB command is used.
`opascal-search-path' (default .)
Directories to search when finding external units.
`opascal-verbose' (default nil)
@@ -19298,17 +19650,14 @@ Customization:
Coloring:
- `opascal-keyword-face' (default font-lock-keyword-face)
+ `opascal-keyword-face' (default `font-lock-keyword-face')
Face used to color OPascal keywords.
-Turning on OPascal mode calls the value of the variable `opascal-mode-hook'
-with no args, if that value is non-nil.
-
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "org" "org/org.el" (20783 15545 430927 0))
+;;;### (autoloads nil "org" "org/org.el" (22011 58553 849858 469000))
;;; Generated autoloads from org/org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -19316,6 +19665,15 @@ Load the languages defined in `org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
+(autoload 'org-babel-load-file "org" "\
+Load Emacs Lisp source code blocks in the Org-mode FILE.
+This function exports the source code using `org-babel-tangle'
+and then loads the resulting file using `load-file'. With prefix
+arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
+file to byte-code before it is loaded.
+
+\(fn FILE &optional COMPILE)" t nil)
+
(autoload 'org-version "org" "\
Show the org-mode version in the echo area.
With prefix argument HERE, insert it at point.
@@ -19411,6 +19769,7 @@ With \\[universal-argument] prefix arg, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
\(fn &optional ARG)" t nil)
+(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
(autoload 'orgstruct-mode "org" "\
Toggle the minor mode `orgstruct-mode'.
@@ -19419,22 +19778,6 @@ modes. The following keys behave as if Org-mode were active, if
the cursor is on a headline, or on a plain list item (both as
defined by Org-mode).
-M-up Move entry/item up
-M-down Move entry/item down
-M-left Promote
-M-right Demote
-M-S-up Move entry/item up
-M-S-down Move entry/item down
-M-S-left Promote subtree
-M-S-right Demote subtree
-M-q Fill paragraph and items like in Org-mode
-C-c ^ Sort entries
-C-c - Cycle list bullet
-TAB Cycle item visibility
-M-RET Insert new heading/item
-S-M-RET Insert new TODO heading / Checkbox item
-C-c C-c Set tags / toggle checkbox
-
\(fn &optional ARG)" t nil)
(autoload 'turn-on-orgstruct "org" "\
@@ -19460,10 +19803,16 @@ call CMD.
This link is added to `org-stored-links' and can later be inserted
into an org-buffer with \\[org-insert-link].
-For some link types, a prefix arg is interpreted:
-For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
+For some link types, a prefix arg is interpreted.
+For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
For file links, arg negates `org-context-in-file-links'.
+A double prefix arg force skipping storing functions that are not
+part of Org's core.
+
+A triple prefix arg force storing a link for each line in the
+active region.
+
\(fn ARG)" t nil)
(autoload 'org-insert-link-global "org" "\
@@ -19529,8 +19878,8 @@ Call the customize function with org as argument.
;;;***
-;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (20847 51240
-;;;;;; 240216 0))
+;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (22011 58553
+;;;;;; 805858 469000))
;;; Generated autoloads from org/org-agenda.el
(autoload 'org-toggle-sticky-agenda "org-agenda" "\
@@ -19623,7 +19972,7 @@ agenda-day The day in the agenda where this is listed
\(fn CMD-KEY &rest PARAMETERS)" nil t)
(autoload 'org-store-agenda-views "org-agenda" "\
-
+Store agenda views.
\(fn &rest PARAMETERS)" t nil)
@@ -19644,7 +19993,10 @@ the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'.
-\(fn &optional ARG START-DAY SPAN)" t nil)
+When WITH-HOUR is non-nil, only include scheduled and deadline
+items if they have an hour specification like [h]h:mm.
+
+\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil)
(autoload 'org-search-view "org-agenda" "\
Show all entries that contain a phrase or words or regular expressions.
@@ -19732,8 +20084,8 @@ all files listed in `org-agenda-files' will be checked automatically:
&%%(org-diary)
-If you don't give any arguments (as in the example above), the default
-arguments (:deadline :scheduled :timestamp :sexp) are used.
+If you don't give any arguments (as in the example above), the default value
+of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
So the example above may also be written as
&%%(org-diary :deadline :timestamp :sexp :scheduled)
@@ -19744,6 +20096,19 @@ function from a program - use `org-agenda-get-day-entries' instead.
\(fn &rest ARGS)" nil nil)
+(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\
+Do we have a reason to ignore this TODO entry because it has a time stamp?
+
+\(fn &optional END)" nil nil)
+
+(autoload 'org-agenda-set-restriction-lock "org-agenda" "\
+Set restriction lock for agenda, to current subtree or file.
+Restriction will be the file if TYPE is `file', or if type is the
+universal prefix '(4), or if the cursor is before the first headline
+in the file. Otherwise, restriction will be to the current subtree.
+
+\(fn &optional TYPE)" t nil)
+
(autoload 'org-calendar-goto-agenda "org-agenda" "\
Compute the Org-mode agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
@@ -19766,16 +20131,17 @@ calling the function returns nil. This function takes one
argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
-either 'headline or 'category. For example:
+either `headline' or `category'. For example:
- '((headline \"IMPORTANT\")
- (category \"Work\"))
+ ((headline \"IMPORTANT\")
+ (category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
-By default `org-agenda-to-appt' will use :deadline, :scheduled
+By default `org-agenda-to-appt' will use :deadline*, :scheduled*
+\(i.e., deadlines and scheduled items with a hh:mm specification)
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
@@ -19786,34 +20152,12 @@ to override `appt-message-warning-time'.
;;;***
-;;;### (autoloads nil "org-beamer" "org/org-beamer.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from org/org-beamer.el
-
-(autoload 'org-beamer-sectioning "org-beamer" "\
-Return the sectioning entry for the current headline.
-LEVEL is the reduced level of the headline.
-TEXT is the text of the headline, everything except the leading stars.
-The return value is a cons cell. The car is the headline text, usually
-just TEXT, but possibly modified if options have been extracted from the
-text. The cdr is the sectioning entry, similar to what is given
-in org-export-latex-classes.
-
-\(fn LEVEL TEXT)" nil nil)
-
-(autoload 'org-beamer-mode "org-beamer" "\
-Special support for editing Org-mode files made to export to beamer.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "org-capture" "org/org-capture.el" (20723 59703
-;;;;;; 12265 0))
+;;;### (autoloads nil "org-capture" "org/org-capture.el" (21993 28596
+;;;;;; 242597 473000))
;;; Generated autoloads from org/org-capture.el
(autoload 'org-capture-string "org-capture" "\
-
+Capture STRING with the template selected by KEYS.
\(fn STRING &optional KEYS)" t nil)
@@ -19833,32 +20177,54 @@ stored.
When called with a `C-0' (zero) prefix, insert a template at point.
-Lisp programs can set KEYS to a string associated with a template
+ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
If `org-capture-use-agenda-date' is non-nil, capturing from the
-agenda will use the date at point as the default date.
+agenda will use the date at point as the default date. Then, a
+`C-1' prefix will tell the capture process to use the HH:MM time
+of the day at point (if any) or the current HH:MM time.
\(fn &optional GOTO KEYS)" t nil)
(autoload 'org-capture-import-remember-templates "org-capture" "\
-Set org-capture-templates to be similar to `org-remember-templates'.
+Set `org-capture-templates' to be similar to `org-remember-templates'.
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "org-colview" "org/org-colview.el" (20717 20920
-;;;;;; 410005 0))
+;;;### (autoloads nil "org-colview" "org/org-colview.el" (22011 58553
+;;;;;; 809858 469000))
;;; Generated autoloads from org/org-colview.el
+(autoload 'org-columns-remove-overlays "org-colview" "\
+Remove all currently active column overlays.
+
+\(fn)" t nil)
+
+(autoload 'org-columns-get-format-and-top-level "org-colview" "\
+
+
+\(fn)" nil nil)
+
(autoload 'org-columns "org-colview" "\
Turn on column view on an org-mode file.
When COLUMNS-FMT-STRING is non-nil, use it as the column format.
\(fn &optional COLUMNS-FMT-STRING)" t nil)
+(autoload 'org-columns-compute "org-colview" "\
+Sum the values of property PROPERTY hierarchically, for the entire buffer.
+
+\(fn PROPERTY)" t nil)
+
+(autoload 'org-columns-number-to-string "org-colview" "\
+Convert a computed column number to a string value, according to FMT.
+
+\(fn N FMT &optional PRINTF)" nil nil)
+
(autoload 'org-dblock-write:columnview "org-colview" "\
Write the column view table.
PARAMS is a property list of parameters:
@@ -19893,8 +20259,8 @@ Turn on or update column view in the agenda.
;;;***
-;;;### (autoloads nil "org-compat" "org/org-compat.el" (20723 59703
-;;;;;; 12265 0))
+;;;### (autoloads nil "org-compat" "org/org-compat.el" (21988 10681
+;;;;;; 989624 461000))
;;; Generated autoloads from org/org-compat.el
(autoload 'org-check-version "org-compat" "\
@@ -19904,8 +20270,19 @@ Try very hard to provide sensible version strings.
;;;***
-;;;### (autoloads nil "org-version" "org/org-version.el" (20783 15545
-;;;;;; 430927 0))
+;;;### (autoloads nil "org-macs" "org/org-macs.el" (21855 577 287944
+;;;;;; 835000))
+;;; Generated autoloads from org/org-macs.el
+
+(autoload 'org-load-noerror-mustsuffix "org-macs" "\
+Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it.
+
+\(fn FILE)" nil t)
+
+;;;***
+
+;;;### (autoloads nil "org-version" "org/org-version.el" (21607 54478
+;;;;;; 800121 42000))
;;; Generated autoloads from org/org-version.el
(autoload 'org-release "org-version" "\
@@ -19920,13 +20297,10 @@ The Git version of org-mode.
\(fn)" nil nil)
-(defvar org-odt-data-dir "/usr/share/emacs/etc/org" "\
-The location of ODT styles.")
-
;;;***
-;;;### (autoloads nil "outline" "outline.el" (20773 35190 350513
-;;;;;; 0))
+;;;### (autoloads nil "outline" "outline.el" (21990 52406 672500
+;;;;;; 385000))
;;; Generated autoloads from outline.el
(put 'outline-regexp 'safe-local-variable 'stringp)
(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
@@ -19941,29 +20315,11 @@ invisible, or visible again. Invisible lines are attached to the end
of the heading, so they move with it, if the line is killed and yanked
back. A heading with text hidden under it is marked with an ellipsis (...).
-Commands:\\<outline-mode-map>
-\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
-\\[outline-previous-visible-heading] outline-previous-visible-heading
-\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
-\\[outline-backward-same-level] outline-backward-same-level
-\\[outline-up-heading] outline-up-heading move from subheading to heading
-
-\\[hide-body] make all text invisible (not headings).
-\\[show-all] make everything in buffer visible.
-\\[hide-sublevels] make only the first N levels of headers visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree] hide-subtree make body and subheadings invisible.
-\\[show-subtree] show-subtree make body and subheadings visible.
-\\[show-children] show-children make direct subheadings visible.
- No effect on body, or subheadings 2 or more levels down.
- With arg N, affects subheadings N levels down.
-\\[hide-entry] make immediately following body invisible.
-\\[show-entry] make it visible.
-\\[hide-leaves] make body under heading and under its subheadings invisible.
- The subheadings remain visible.
-\\[show-branches] make all subheadings at all levels visible.
+\\{outline-mode-map}
+The commands `outline-hide-subtree', `outline-show-subtree',
+`outline-show-children', `outline-hide-entry',
+`outline-show-entry', `outline-hide-leaves', and `outline-show-branches'
+are used when point is on a heading line.
The variable `outline-regexp' can be changed to control what is a heading.
A line is a heading if `outline-regexp' matches something at the
@@ -19987,10 +20343,11 @@ See the command `outline-mode' for more information on this mode.
;;;***
-;;;### (autoloads nil "package" "emacs-lisp/package.el" (20938 49065
-;;;;;; 383398 0))
+;;;### (autoloads nil "package" "emacs-lisp/package.el" (22000 31493
+;;;;;; 736082 901000))
;;; Generated autoloads from emacs-lisp/package.el
-(push (purecopy (quote (package 1 0 1))) package--builtin-versions)
+(push (purecopy '(package 1 0 1)) package--builtin-versions)
+
(defvar package-enable-at-startup t "\
Whether to activate installed packages when Emacs starts.
If non-nil, packages are activated after reading the init file
@@ -20002,40 +20359,88 @@ activate the package system at any time.")
(custom-autoload 'package-enable-at-startup "package" t)
+(autoload 'package-initialize "package" "\
+Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+If `user-init-file' does not mention `(package-initialize)', add
+it to the file.
+If called as part of loading `user-init-file', set
+`package-enable-at-startup' to nil, to prevent accidentally
+loading packages twice.
+
+\(fn &optional NO-ACTIVATE)" t nil)
+
+(autoload 'package-import-keyring "package" "\
+Import keys from FILE.
+
+\(fn &optional FILE)" t nil)
+
+(autoload 'package-refresh-contents "package" "\
+Download descriptions of all configured ELPA packages.
+For each archive configured in the variable `package-archives',
+inform Emacs about the latest versions of all packages it offers,
+and make them available for download.
+Optional argument ASYNC specifies whether to perform the
+downloads in the background.
+
+\(fn &optional ASYNC)" t nil)
+
(autoload 'package-install "package" "\
Install the package PKG.
PKG can be a package-desc or the package name of one the available packages
in an archive in `package-archives'. Interactively, prompt for its name.
-\(fn PKG)" t nil)
+If called interactively or if DONT-SELECT nil, add PKG to
+`package-selected-packages'.
+
+If PKG is a package-desc and it is already installed, don't try
+to install it but still mark it as selected.
+
+\(fn PKG &optional DONT-SELECT)" t nil)
(autoload 'package-install-from-buffer "package" "\
Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file that follows the
-packaging guidelines; see info node `(elisp)Packaging'.
+The current buffer is assumed to be a single .el or .tar file or
+a directory. These must follow the packaging guidelines (see
+info node `(elisp)Packaging').
+
+Specially, if current buffer is a directory, the -pkg.el
+description file is not mandatory, in which case the information
+is derived from the main .el file in the directory.
+
Downloads and installs required packages as needed.
\(fn)" t nil)
(autoload 'package-install-file "package" "\
Install a package from a file.
-The file can either be a tar file or an Emacs Lisp file.
+The file can either be a tar file, an Emacs Lisp file, or a
+directory.
\(fn FILE)" t nil)
-(autoload 'package-refresh-contents "package" "\
-Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download.
+(autoload 'package-install-selected-packages "package" "\
+Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them.
\(fn)" t nil)
-(autoload 'package-initialize "package" "\
-Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+(autoload 'package-reinstall "package" "\
+Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object.
-\(fn &optional NO-ACTIVATE)" t nil)
+\(fn PKG)" t nil)
+
+(autoload 'package-autoremove "package" "\
+Remove packages that are no more needed.
+
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted.
+
+\(fn)" t nil)
(autoload 'describe-package "package" "\
Display the full documentation of PACKAGE (a symbol).
@@ -20054,7 +20459,7 @@ The list is displayed in a buffer named `*Packages*'.
;;;***
-;;;### (autoloads nil "paren" "paren.el" (20903 56815 695483 0))
+;;;### (autoloads nil "paren" "paren.el" (21670 32331 385639 720000))
;;; Generated autoloads from paren.el
(defvar show-paren-mode nil "\
@@ -20080,8 +20485,8 @@ matching parenthesis is highlighted in `show-paren-style' after
;;;***
-;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (21670
+;;;;;; 32330 885624 725000))
;;; Generated autoloads from calendar/parse-time.el
(put 'parse-time-rules 'risky-local-variable t)
@@ -20094,12 +20499,12 @@ unknown are returned as nil.
;;;***
-;;;### (autoloads nil "pascal" "progmodes/pascal.el" (20870 12718
-;;;;;; 549931 0))
+;;;### (autoloads nil "pascal" "progmodes/pascal.el" (21974 64192
+;;;;;; 644009 993000))
;;; Generated autoloads from progmodes/pascal.el
(autoload 'pascal-mode "pascal" "\
-Major mode for editing Pascal code. \\<pascal-mode-map>
+Major mode for editing Pascal code.\\<pascal-mode-map>
TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
\\[completion-at-point] completes the word around current point with respect to position in code
@@ -20140,15 +20545,12 @@ Variables controlling indentation/edit style:
See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
`pascal-separator-keywords'.
-Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil.
-
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "password-cache" "password-cache.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "password-cache" "password-cache.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from password-cache.el
(defvar password-cache t "\
@@ -20169,70 +20571,110 @@ Check if KEY is in the cache.
;;;***
-;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (20717 20920
-;;;;;; 410005 0))
+;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (22026 25907
+;;;;;; 583502 692000))
;;; Generated autoloads from emacs-lisp/pcase.el
(autoload 'pcase "pcase" "\
Perform ML-style pattern matching on EXP.
-CASES is a list of elements of the form (UPATTERN CODE...).
+CASES is a list of elements of the form (PATTERN CODE...).
-UPatterns can take the following forms:
+Patterns can take the following forms:
_ matches anything.
- SELFQUOTING matches itself. This includes keywords, numbers, and strings.
SYMBOL matches anything and binds it to SYMBOL.
- (or UPAT...) matches if any of the patterns matches.
- (and UPAT...) matches if all the patterns match.
- `QPAT matches if the QPattern QPAT matches.
- (pred PRED) matches if PRED applied to the object returns non-nil.
+ (or PAT...) matches if any of the patterns matches.
+ (and PAT...) matches if all the patterns match.
+ \\='VAL matches if the object is `equal' to VAL
+ ATOM is a shorthand for \\='ATOM.
+ ATOM can be a keyword, an integer, or a string.
+ (pred FUN) matches if FUN applied to the object returns non-nil.
(guard BOOLEXP) matches if BOOLEXP evaluates to non-nil.
- (let UPAT EXP) matches if EXP matches UPAT.
+ (let PAT EXP) matches if EXP matches PAT.
+ (app FUN PAT) matches if FUN applied to the object matches PAT.
If a SYMBOL is used twice in the same pattern (i.e. the pattern is
\"non-linear\"), then the second occurrence is turned into an `eq'uality test.
-QPatterns can take the following forms:
- (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
- ,UPAT matches if the UPattern UPAT matches.
- STRING matches if the object is `equal' to STRING.
- ATOM matches if the object is `eq' to ATOM.
-QPatterns for vectors are not implemented yet.
-
-PRED can take the form
- FUNCTION in which case it gets called with one argument.
- (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+FUN can take the form
+ SYMBOL or (lambda ARGS BODY) in which case it's called with one argument.
+ (F ARG1 .. ARGn) in which case F gets called with an n+1'th argument
which is the value being matched.
-A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
-PRED patterns can refer to variables bound earlier in the pattern.
+So a FUN of the form SYMBOL is equivalent to one of the form (FUN).
+FUN can refer to variables bound earlier in the pattern.
+FUN is assumed to be pure, i.e. it can be dropped if its result is not used,
+and two identical calls can be merged into one.
E.g. you can match pairs where the cdr is larger than the car with a pattern
-like `(,a . ,(pred (< a))) or, with more checks:
-`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+like \\=`(,a . ,(pred (< a))) or, with more checks:
+\\=`(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))
+
+Additional patterns can be defined via `pcase-defmacro'.
+Currently, the following patterns are provided this way:
+
+\(fn EXP &rest CASES)" nil t)
+
+(function-put 'pcase 'lisp-indent-function '1)
+
+(autoload 'pcase-exhaustive "pcase" "\
+The exhaustive version of `pcase' (which see).
\(fn EXP &rest CASES)" nil t)
-(put 'pcase 'lisp-indent-function '1)
+(function-put 'pcase-exhaustive 'lisp-indent-function '1)
+
+(autoload 'pcase-lambda "pcase" "\
+Like `lambda' but allow each argument to be a pattern.
+I.e. accepts the usual &optional and &rest keywords, but every
+formal argument can be any pattern accepted by `pcase' (a mere
+variable name being but a special case of it).
+
+\(fn LAMBDA-LIST &rest BODY)" nil t)
+
+(function-put 'pcase-lambda 'doc-string-elt '2)
+
+(function-put 'pcase-lambda 'lisp-indent-function 'defun)
(autoload 'pcase-let* "pcase" "\
Like `let*' but where you can use `pcase' patterns for bindings.
BODY should be an expression, and BINDINGS should be a list of bindings
-of the form (UPAT EXP).
+of the form (PAT EXP).
\(fn BINDINGS &rest BODY)" nil t)
-(put 'pcase-let* 'lisp-indent-function '1)
+(function-put 'pcase-let* 'lisp-indent-function '1)
(autoload 'pcase-let "pcase" "\
Like `let' but where you can use `pcase' patterns for bindings.
BODY should be a list of expressions, and BINDINGS should be a list of bindings
-of the form (UPAT EXP).
+of the form (PAT EXP).
+The macro is expanded and optimized under the assumption that those
+patterns *will* match, so a mismatch may go undetected or may cause
+any kind of error.
\(fn BINDINGS &rest BODY)" nil t)
-(put 'pcase-let 'lisp-indent-function '1)
+(function-put 'pcase-let 'lisp-indent-function '1)
+
+(autoload 'pcase-dolist "pcase" "\
+
+
+\(fn SPEC &rest BODY)" nil t)
+
+(function-put 'pcase-dolist 'lisp-indent-function '1)
+
+(autoload 'pcase-defmacro "pcase" "\
+Define a new kind of pcase PATTERN, by macro expansion.
+Patterns of the form (NAME ...) will be expanded according
+to this macro.
+
+\(fn NAME ARGS &rest BODY)" nil t)
+
+(function-put 'pcase-defmacro 'lisp-indent-function '2)
+
+(function-put 'pcase-defmacro 'doc-string-elt '3)
;;;***
-;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (21998 46517 178024
+;;;;;; 649000))
;;; Generated autoloads from pcmpl-cvs.el
(autoload 'pcomplete/cvs "pcmpl-cvs" "\
@@ -20242,8 +20684,8 @@ Completion rules for the `cvs' command.
;;;***
-;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (20907 7082 901087
-;;;;;; 0))
+;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from pcmpl-gnu.el
(autoload 'pcomplete/gzip "pcmpl-gnu" "\
@@ -20270,8 +20712,8 @@ Completion for the GNU tar utility.
;;;***
-;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (20884 7264
-;;;;;; 912957 506000))
+;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from pcmpl-linux.el
(autoload 'pcomplete/kill "pcmpl-linux" "\
@@ -20291,8 +20733,8 @@ Completion for GNU/Linux `mount'.
;;;***
-;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from pcmpl-rpm.el
(autoload 'pcomplete/rpm "pcmpl-rpm" "\
@@ -20302,8 +20744,8 @@ Completion for the `rpm' command.
;;;***
-;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (21791 47660 796747
+;;;;;; 422000))
;;; Generated autoloads from pcmpl-unix.el
(autoload 'pcomplete/cd "pcmpl-unix" "\
@@ -20358,8 +20800,8 @@ Includes files as well as host names followed by a colon.
;;;***
-;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (20837 15398 184639
-;;;;;; 0))
+;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (21980 16567 953544
+;;;;;; 893000))
;;; Generated autoloads from pcmpl-x.el
(autoload 'pcomplete/tlmgr "pcmpl-x" "\
@@ -20369,17 +20811,22 @@ Completion for the `tlmgr' command.
(autoload 'pcomplete/ack "pcmpl-x" "\
Completion for the `ack' command.
-Start an argument with '-' to complete short options and '--' for
+Start an argument with `-' to complete short options and `--' for
long options.
\(fn)" nil nil)
(defalias 'pcomplete/ack-grep 'pcomplete/ack)
+(autoload 'pcomplete/ag "pcmpl-x" "\
+Completion for the `ag' command.
+
+\(fn)" nil nil)
+
;;;***
-;;;### (autoloads nil "pcomplete" "pcomplete.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pcomplete" "pcomplete.el" (21980 16567 953544
+;;;;;; 893000))
;;; Generated autoloads from pcomplete.el
(autoload 'pcomplete "pcomplete" "\
@@ -20436,11 +20883,11 @@ Setup `shell-mode' to use pcomplete.
;;;***
-;;;### (autoloads nil "pcvs" "vc/pcvs.el" (20717 20920 410005 0))
+;;;### (autoloads nil "pcvs" "vc/pcvs.el" (21985 34484 302705 925000))
;;; Generated autoloads from vc/pcvs.el
(autoload 'cvs-checkout "pcvs" "\
-Run a 'cvs checkout MODULES' in DIR.
+Run a `cvs checkout MODULES' in DIR.
Feed the output to a *cvs* buffer, display it in the current window,
and run `cvs-mode' on it.
@@ -20499,7 +20946,7 @@ Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'.")
(defvar cvs-dired-use-hook '(4) "\
Whether or not opening a CVS directory should run PCL-CVS.
A value of nil means never do it.
-ALWAYS means to always do it unless a prefix argument is given to the
+`always' means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value.")
@@ -20511,8 +20958,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d
;;;***
-;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from vc/pcvs-defs.el
(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)) "\
@@ -20520,8 +20967,8 @@ Global menu used by PCL-CVS.")
;;;***
-;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (20929
-;;;;;; 34089 117790 0))
+;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (22011
+;;;;;; 58553 921858 469000))
;;; Generated autoloads from progmodes/perl-mode.el
(put 'perl-indent-level 'safe-local-variable 'integerp)
(put 'perl-continued-statement-offset 'safe-local-variable 'integerp)
@@ -20582,8 +21029,8 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'.
;;;***
-;;;### (autoloads nil "picture" "textmodes/picture.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "picture" "textmodes/picture.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from textmodes/picture.el
(autoload 'picture-mode "picture" "\
@@ -20663,8 +21110,23 @@ they are not by default assigned to keys.
;;;***
-;;;### (autoloads nil "plstore" "gnus/plstore.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pinentry" "net/pinentry.el" (21972 22452 338264
+;;;;;; 357000))
+;;; Generated autoloads from net/pinentry.el
+(push (purecopy '(pinentry 0 1)) package--builtin-versions)
+
+(autoload 'pinentry-start "pinentry" "\
+Start a Pinentry service.
+
+Once the environment is properly set, subsequent invocations of
+the gpg command will interact with Emacs for passphrase input.
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "plstore" "gnus/plstore.el" (21786 29744 368212
+;;;;;; 633000))
;;; Generated autoloads from gnus/plstore.el
(autoload 'plstore-open "plstore" "\
@@ -20679,7 +21141,8 @@ Major mode for editing PLSTORE files.
;;;***
-;;;### (autoloads nil "po" "textmodes/po.el" (20791 9657 561026 0))
+;;;### (autoloads nil "po" "textmodes/po.el" (22026 25907 651502
+;;;;;; 692000))
;;; Generated autoloads from textmodes/po.el
(autoload 'po-find-file-coding-system "po" "\
@@ -20690,7 +21153,7 @@ Called through `file-coding-system-alist', before the file is visited for real.
;;;***
-;;;### (autoloads nil "pong" "play/pong.el" (20709 26818 907104 0))
+;;;### (autoloads nil "pong" "play/pong.el" (21670 32331 385639 720000))
;;; Generated autoloads from play/pong.el
(autoload 'pong "pong" "\
@@ -20706,7 +21169,7 @@ pong-mode keybindings:\\<pong-mode-map>
;;;***
-;;;### (autoloads nil "pop3" "gnus/pop3.el" (20709 26818 907104 0))
+;;;### (autoloads nil "pop3" "gnus/pop3.el" (21974 64192 580009 993000))
;;; Generated autoloads from gnus/pop3.el
(autoload 'pop3-movemail "pop3" "\
@@ -20717,8 +21180,8 @@ Use streaming commands.
;;;***
-;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lisp/pp.el
(autoload 'pp-to-string "pp" "\
@@ -20768,10 +21231,11 @@ Ignores leading comment characters.
;;;***
-;;;### (autoloads nil "printing" "printing.el" (20891 44219 680764
-;;;;;; 0))
+;;;### (autoloads nil "printing" "printing.el" (21990 52406 680500
+;;;;;; 385000))
;;; Generated autoloads from printing.el
-(push (purecopy (quote (printing 6 9 3))) package--builtin-versions)
+(push (purecopy '(printing 6 9 3)) package--builtin-versions)
+
(autoload 'pr-interface "printing" "\
Activate the printing interface buffer.
@@ -21356,7 +21820,7 @@ are both set to t.
;;;***
-;;;### (autoloads nil "proced" "proced.el" (20709 26818 907104 0))
+;;;### (autoloads nil "proced" "proced.el" (21998 46517 190024 649000))
;;; Generated autoloads from proced.el
(autoload 'proced "proced" "\
@@ -21374,8 +21838,8 @@ Proced buffers.
;;;***
-;;;### (autoloads nil "profiler" "profiler.el" (20932 10282 564846
-;;;;;; 0))
+;;;### (autoloads nil "profiler" "profiler.el" (21948 40114 402686
+;;;;;; 453000))
;;; Generated autoloads from profiler.el
(autoload 'profiler-start "profiler" "\
@@ -21403,8 +21867,19 @@ Open profile FILENAME.
;;;***
-;;;### (autoloads nil "prolog" "progmodes/prolog.el" (20919 46844
-;;;;;; 767888 0))
+;;;### (autoloads nil "project" "progmodes/project.el" (21960 31281
+;;;;;; 344212 153000))
+;;; Generated autoloads from progmodes/project.el
+
+(autoload 'project-current "project" "\
+Return the project instance in DIR or `default-directory'.
+
+\(fn &optional DIR)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "prolog" "progmodes/prolog.el" (22027 46774
+;;;;;; 684310 591000))
;;; Generated autoloads from progmodes/prolog.el
(autoload 'prolog-mode "prolog" "\
@@ -21420,8 +21895,6 @@ To find out what version of Prolog mode you are running, enter
Commands:
\\{prolog-mode-map}
-Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil.
\(fn)" t nil)
@@ -21439,7 +21912,7 @@ With prefix argument ARG, restart the Prolog process if running before.
;;;***
-;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (20799 169 640767 0))
+;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (21670 32331 885635 586000))
;;; Generated autoloads from ps-bdf.el
(defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\
@@ -21450,10 +21923,11 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").")
;;;***
-;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (20777 63161
-;;;;;; 848428 0))
+;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from progmodes/ps-mode.el
-(push (purecopy (quote (ps-mode 1 1 9))) package--builtin-versions)
+(push (purecopy '(ps-mode 1 1 9)) package--builtin-versions)
+
(autoload 'ps-mode "ps-mode" "\
Major mode for editing PostScript with GNU Emacs.
@@ -21462,7 +21936,6 @@ Entry to this mode calls `ps-mode-hook'.
The following variables hold user options, and can
be set through the `customize' command:
- `ps-mode-auto-indent'
`ps-mode-tab'
`ps-mode-paper-size'
`ps-mode-print-function'
@@ -21497,10 +21970,11 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
;;;***
-;;;### (autoloads nil "ps-print" "ps-print.el" (20874 65006 672942
-;;;;;; 217000))
+;;;### (autoloads nil "ps-print" "ps-print.el" (22011 58553 993858
+;;;;;; 469000))
;;; Generated autoloads from ps-print.el
-(push (purecopy (quote (ps-print 7 3 5))) package--builtin-versions)
+(push (purecopy '(ps-print 7 3 5)) package--builtin-versions)
+
(defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\
List associating a symbolic paper type to its width, height and doc media.
See `ps-paper-type'.")
@@ -21694,49 +22168,64 @@ If EXTENSION is any other symbol, it is ignored.
;;;***
-;;;### (autoloads nil "pulse" "cedet/pulse.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "pulse" "cedet/pulse.el" (21968 25395 287570
+;;;;;; 741000))
;;; Generated autoloads from cedet/pulse.el
-(push (purecopy (quote (pulse 1 0))) package--builtin-versions)
+(push (purecopy '(pulse 1 0)) package--builtin-versions)
+
+(autoload 'pulse-momentary-highlight-one-line "pulse" "\
+Highlight the line around POINT, unhighlighting before next command.
+Optional argument FACE specifies the face to do the highlighting.
+
+\(fn POINT &optional FACE)" nil nil)
+
+(autoload 'pulse-momentary-highlight-region "pulse" "\
+Highlight between START and END, unhighlighting before next command.
+Optional argument FACE specifies the face to do the highlighting.
+
+\(fn START END &optional FACE)" nil nil)
+
;;;***
-;;;### (autoloads nil "python" "progmodes/python.el" (20928 13222
-;;;;;; 500272 0))
+;;;### (autoloads nil "python" "progmodes/python.el" (22026 25907
+;;;;;; 639502 692000))
;;; Generated autoloads from progmodes/python.el
-(push (purecopy (quote (python 0 24 2))) package--builtin-versions)
+(push (purecopy '(python 0 25 1)) package--builtin-versions)
+
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
-(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
+(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
(autoload 'run-python "python" "\
Run an inferior Python process.
-Input and output via buffer named after
-`python-shell-buffer-name'. If there is a process already
-running in that buffer, just switch to it.
-With argument, allows you to define CMD so you can edit the
-command used to call the interpreter and define DEDICATED, so a
-dedicated process for the current buffer is open. When numeric
-prefix arg is other than 0 or 4 do not SHOW.
+Argument CMD defaults to `python-shell-calculate-command' return
+value. When called interactively with `prefix-arg', it allows
+the user to edit such value and choose whether the interpreter
+should be DEDICATED for the current buffer. When numeric prefix
+arg is other than 0 or 4 do not SHOW.
+
+For a given buffer and same values of DEDICATED, if a process is
+already running for it, it will do nothing. This means that if
+the current buffer is using a global process, the user is still
+able to switch it to use a dedicated one.
-Runs the hook `inferior-python-mode-hook' (after the
-`comint-mode-hook' is run). (Type \\[describe-mode] in the
+Runs the hook `inferior-python-mode-hook' after
+`comint-mode-hook' is run. (Type \\[describe-mode] in the
process buffer for a list of commands.)
-\(fn CMD &optional DEDICATED SHOW)" t nil)
+\(fn &optional CMD DEDICATED SHOW)" t nil)
(autoload 'python-mode "python" "\
Major mode for editing Python files.
\\{python-mode-map}
-Entry to this mode calls the value of `python-mode-hook'
-if that value is non-nil.
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "qp" "gnus/qp.el" (20709 26818 907104 0))
+;;;### (autoloads nil "qp" "gnus/qp.el" (21670 32331 385639 720000))
;;; Generated autoloads from gnus/qp.el
(autoload 'quoted-printable-decode-region "qp" "\
@@ -21755,8 +22244,8 @@ them into characters should be done separately.
;;;***
-;;;### (autoloads nil "quail" "international/quail.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "quail" "international/quail.el" (21988 10681
+;;;;;; 981624 461000))
;;; Generated autoloads from international/quail.el
(autoload 'quail-title "quail" "\
@@ -21817,10 +22306,11 @@ user's keyboard layout to the standard keyboard layout. See the
documentation of `quail-keyboard-layout' and
`quail-keyboard-layout-standard' for more detail.
-SHOW-LAYOUT non-nil means the `quail-help' command should show
-the user's keyboard layout visually with translated characters.
-If KBD-TRANSLATE is set, it is desirable to set also this flag unless
-this package defines no translations for single character keys.
+SHOW-LAYOUT non-nil means the function `quail-help' (as used by
+the command `describe-input-method') should show the user's keyboard
+layout visually with translated characters. If KBD-TRANSLATE is
+set, it is desirable to also set this flag, unless this package
+defines no translations for single character keys.
CREATE-DECODE-MAP non-nil means decode map is also created. A decode
map is an alist of translations and corresponding original keys.
@@ -21985,8 +22475,36 @@ of each directory.
;;;***
-;;;### (autoloads nil "quickurl" "net/quickurl.el" (20799 169 640767
-;;;;;; 0))
+;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21953
+;;;;;; 58033 331058 929000))
+;;; Generated autoloads from leim/quail/hangul.el
+
+(autoload 'hangul-input-method-activate "quail/hangul" "\
+Activate Hangul input method INPUT-METHOD.
+FUNC is a function to handle input key.
+HELP-TEXT is a text set in `hangul-input-method-help-text'.
+
+\(fn INPUT-METHOD FUNC HELP-TEXT &rest ARGS)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el"
+;;;;;; (21670 32331 385639 720000))
+;;; Generated autoloads from leim/quail/uni-input.el
+
+(autoload 'ucs-input-activate "quail/uni-input" "\
+Activate UCS input method.
+With ARG, activate UCS input method if and only if ARG is positive.
+
+While this input method is active, the variable
+`input-method-function' is bound to the function `ucs-input-method'.
+
+\(fn &optional ARG)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "quickurl" "net/quickurl.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from net/quickurl.el
(defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\
@@ -22057,7 +22575,8 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'.
;;;***
-;;;### (autoloads nil "rcirc" "net/rcirc.el" (20770 3512 176098 0))
+;;;### (autoloads nil "rcirc" "net/rcirc.el" (22011 58553 765858
+;;;;;; 469000))
;;; Generated autoloads from net/rcirc.el
(autoload 'rcirc "rcirc" "\
@@ -22095,20 +22614,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "rcompile" "net/rcompile.el" (20709 26818 907104
-;;;;;; 0))
-;;; Generated autoloads from net/rcompile.el
-
-(autoload 'remote-compile "rcompile" "\
-Compile the current buffer's directory on HOST. Log in as USER.
-See \\[compile].
-
-\(fn HOST USER COMMAND)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (21998
+;;;;;; 46517 18024 649000))
;;; Generated autoloads from emacs-lisp/re-builder.el
(defalias 'regexp-builder 're-builder)
@@ -22126,8 +22633,8 @@ matching parts of the target buffer will be highlighted.
;;;***
-;;;### (autoloads nil "recentf" "recentf.el" (20871 33574 214287
-;;;;;; 0))
+;;;### (autoloads nil "recentf" "recentf.el" (21998 46517 266024
+;;;;;; 649000))
;;; Generated autoloads from recentf.el
(defvar recentf-mode nil "\
@@ -22153,7 +22660,7 @@ were operated on recently.
;;;***
-;;;### (autoloads nil "rect" "rect.el" (20709 26818 907104 0))
+;;;### (autoloads nil "rect" "rect.el" (21803 38823 44085 519000))
;;; Generated autoloads from rect.el
(autoload 'delete-rectangle "rect" "\
@@ -22285,10 +22792,16 @@ with a prefix argument, prompt for START-AT and FORMAT.
\(fn START END START-AT &optional FORMAT)" t nil)
+(autoload 'rectangle-mark-mode "rect" "\
+Toggle the region as rectangular.
+Activates the region if needed. Only lasts until the region is deactivated.
+
+\(fn &optional ARG)" t nil)
+
;;;***
-;;;### (autoloads nil "refill" "textmodes/refill.el" (20884 7264
-;;;;;; 912957 506000))
+;;;### (autoloads nil "refill" "textmodes/refill.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from textmodes/refill.el
(autoload 'refill-mode "refill" "\
@@ -22308,9 +22821,13 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead.
;;;***
-;;;### (autoloads nil "reftex" "textmodes/reftex.el" (20928 13222
-;;;;;; 500272 0))
+;;;### (autoloads nil "reftex" "textmodes/reftex.el" (22026 25907
+;;;;;; 655502 692000))
;;; Generated autoloads from textmodes/reftex.el
+(autoload 'reftex-citation "reftex-cite" nil t)
+(autoload 'reftex-all-document-files "reftex-parse")
+(autoload 'reftex-isearch-minor-mode "reftex-global" nil t)
+(autoload 'reftex-index-phrases-mode "reftex-index" nil t)
(autoload 'turn-on-reftex "reftex" "\
Turn on RefTeX mode.
@@ -22358,101 +22875,8 @@ This enforces rescanning the buffer on next use.
;;;***
-;;;### (autoloads nil "reftex-cite" "textmodes/reftex-cite.el" (20921
-;;;;;; 39978 248467 0))
-;;; Generated autoloads from textmodes/reftex-cite.el
-
-(autoload 'reftex-citation "reftex-cite" "\
-Make a citation using BibTeX database files.
-After prompting for a regular expression, scans the buffers with
-bibtex entries (taken from the \\bibliography command) and offers the
-matching entries for selection. The selected entry is formatted according
-to `reftex-cite-format' and inserted into the buffer.
-
-If NO-INSERT is non-nil, nothing is inserted, only the selected key returned.
-
-FORMAT-KEY can be used to pre-select a citation format.
-
-When called with a `C-u' prefix, prompt for optional arguments in
-cite macros. When called with a numeric prefix, make that many
-citations. When called with point inside the braces of a `\\cite'
-command, it will add another key, ignoring the value of
-`reftex-cite-format'.
-
-The regular expression uses an expanded syntax: && is interpreted as `and'.
-Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
-While entering the regexp, completion on knows citation keys is possible.
-`=' is a good regular expression to match all entries in all files.
-
-\(fn &optional NO-INSERT FORMAT-KEY)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "reftex-global" "textmodes/reftex-global.el"
-;;;;;; (20709 26818 907104 0))
-;;; Generated autoloads from textmodes/reftex-global.el
-
-(autoload 'reftex-isearch-minor-mode "reftex-global" "\
-When on, isearch searches the whole document, not only the current file.
-This minor mode allows isearch to search through all the files of
-the current TeX document.
-
-With no argument, this command toggles
-`reftex-isearch-minor-mode'. With a prefix argument ARG, turn
-`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off.
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "reftex-index" "textmodes/reftex-index.el"
-;;;;;; (20709 26818 907104 0))
-;;; Generated autoloads from textmodes/reftex-index.el
-
-(autoload 'reftex-index-phrases-mode "reftex-index" "\
-Major mode for managing the Index phrases of a LaTeX document.
-This buffer was created with RefTeX.
-
-To insert new phrases, use
- - `C-c \\' in the LaTeX document to copy selection or word
- - `\\[reftex-index-new-phrase]' in the phrases buffer.
-
-To index phrases use one of:
-
-\\[reftex-index-this-phrase] index current phrase
-\\[reftex-index-next-phrase] index next phrase (or N with prefix arg)
-\\[reftex-index-all-phrases] index all phrases
-\\[reftex-index-remaining-phrases] index current and following phrases
-\\[reftex-index-region-phrases] index the phrases in the region
-
-You can sort the phrases in this buffer with \\[reftex-index-sort-phrases].
-To display information about the phrase at point, use \\[reftex-index-phrases-info].
-
-For more information see the RefTeX User Manual.
-
-Here are all local bindings.
-
-\\{reftex-index-phrases-mode-map}
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "reftex-parse" "textmodes/reftex-parse.el"
-;;;;;; (20921 39978 248467 0))
-;;; Generated autoloads from textmodes/reftex-parse.el
-
-(autoload 'reftex-all-document-files "reftex-parse" "\
-Return a list of all files belonging to the current document.
-When RELATIVE is non-nil, give file names relative to directory
-of master file.
-
-\(fn &optional RELATIVE)" nil nil)
-
-;;;***
-
-;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20895
-;;;;;; 15912 444844 0))
+;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (22025
+;;;;;; 5040 882195 139000))
;;; Generated autoloads from textmodes/reftex-vars.el
(put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
(put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x))))
@@ -22461,8 +22885,8 @@ of master file.
;;;***
-;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (22011
+;;;;;; 58553 413858 469000))
;;; Generated autoloads from emacs-lisp/regexp-opt.el
(autoload 'regexp-opt "regexp-opt" "\
@@ -22473,7 +22897,7 @@ is enclosed by at least one regexp grouping construct.
The returned regexp is typically more efficient than the equivalent regexp:
(let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
- (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
+ (concat open (mapconcat \\='regexp-quote STRINGS \"\\\\|\") close))
If PAREN is `words', then the resulting regexp is additionally surrounded
by \\=\\< and \\>.
@@ -22491,16 +22915,18 @@ This means the number of non-shy regexp grouping constructs
;;;***
-;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lisp/regi.el
-(push (purecopy (quote (regi 1 8))) package--builtin-versions)
+(push (purecopy '(regi 1 8)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "remember" "textmodes/remember.el" (20945 22315
-;;;;;; 8369 0))
+;;;### (autoloads nil "remember" "textmodes/remember.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from textmodes/remember.el
-(push (purecopy (quote (remember 2 0))) package--builtin-versions)
+(push (purecopy '(remember 2 0)) package--builtin-versions)
+
(autoload 'remember "remember" "\
Remember an arbitrary piece of data.
INITIAL is the text to initially place in the *Remember* buffer,
@@ -22527,37 +22953,34 @@ Extract diary entries from the region.
\(fn)" nil nil)
(autoload 'remember-notes "remember" "\
-Creates notes buffer and switches to it if called interactively.
-
-If a notes buffer created by a previous invocation of this
-function already exist, it will be returned. Otherwise a new
-buffer will be created whose content will be read from file
-pointed by `remember-data-file'. If a buffer visiting this file
-already exist, that buffer will be used instead of creating a new
-one (see `find-file-noselect' function for more details).
-
-Name of the created buffer is taken from `remember-notes-buffer-name'
-variable and if a buffer with that name already exist (but was not
-created by this function), it will be first killed.
-\\<remember-notes-mode-map>
-`remember-notes-mode' is active in the notes buffer which by default
-contains only one \\[save-and-bury-buffer] binding which saves and
-buries the buffer.
-
-Function returns notes buffer. When called interactively,
-switches to it as well.
-
-Notes buffer is meant for keeping random notes which you'd like to
-preserve across Emacs restarts. The notes will be stored in the
-`remember-data-file'.
+Return the notes buffer, creating it if needed, and maybe switch to it.
+This buffer is for notes that you want to preserve across Emacs sessions.
+The notes are saved in `remember-data-file'.
+
+If a buffer is already visiting that file, just return it.
+
+Otherwise, create the buffer, and rename it to `remember-notes-buffer-name',
+unless a buffer of that name already exists. Set the major mode according
+to `remember-notes-initial-major-mode', and enable `remember-notes-mode'
+minor mode.
+
+Use \\<remember-notes-mode-map>\\[remember-notes-save-and-bury-buffer] to save and bury the notes buffer.
+
+Interactively, or if SWITCH-TO is non-nil, switch to the buffer.
+Return the buffer.
+
+Set `initial-buffer-choice' to `remember-notes' to visit your notes buffer
+when Emacs starts. Set `remember-notes-buffer-name' to \"*scratch*\"
+to turn the *scratch* buffer into your notes buffer.
\(fn &optional SWITCH-TO)" t nil)
;;;***
-;;;### (autoloads nil "repeat" "repeat.el" (20709 26818 907104 0))
+;;;### (autoloads nil "repeat" "repeat.el" (21670 32331 885635 586000))
;;; Generated autoloads from repeat.el
-(push (purecopy (quote (repeat 0 51))) package--builtin-versions)
+(push (purecopy '(repeat 0 51)) package--builtin-versions)
+
(autoload 'repeat "repeat" "\
Repeat most recently executed command.
If REPEAT-ARG is non-nil (interactively, with a prefix argument),
@@ -22577,8 +23000,8 @@ recently executed command not bound to an input event\".
;;;***
-;;;### (autoloads nil "reporter" "mail/reporter.el" (20921 39978
-;;;;;; 248467 0))
+;;;### (autoloads nil "reporter" "mail/reporter.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from mail/reporter.el
(autoload 'reporter-submit-bug-report "reporter" "\
@@ -22609,8 +23032,8 @@ mail-sending package is used for editing and sending the message.
;;;***
-;;;### (autoloads nil "reposition" "reposition.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "reposition" "reposition.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from reposition.el
(autoload 'reposition-window "reposition" "\
@@ -22636,7 +23059,7 @@ first comment line visible (if point is in a comment).
;;;***
-;;;### (autoloads nil "reveal" "reveal.el" (20709 26818 907104 0))
+;;;### (autoloads nil "reveal" "reveal.el" (21670 32331 885635 586000))
;;; Generated autoloads from reveal.el
(autoload 'reveal-mode "reveal" "\
@@ -22671,8 +23094,8 @@ the mode if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (21998 46517 18024
+;;;;;; 649000))
;;; Generated autoloads from emacs-lisp/ring.el
(autoload 'ring-p "ring" "\
@@ -22687,8 +23110,8 @@ Make a ring that can contain SIZE elements.
;;;***
-;;;### (autoloads nil "rlogin" "net/rlogin.el" (20903 10024 645978
-;;;;;; 0))
+;;;### (autoloads nil "rlogin" "net/rlogin.el" (22011 58553 765858
+;;;;;; 469000))
;;; Generated autoloads from net/rlogin.el
(autoload 'rlogin "rlogin" "\
@@ -22732,8 +23155,8 @@ variable.
;;;***
-;;;### (autoloads nil "rmail" "mail/rmail.el" (20892 39729 858825
-;;;;;; 0))
+;;;### (autoloads nil "rmail" "mail/rmail.el" (22011 58553 725858
+;;;;;; 469000))
;;; Generated autoloads from mail/rmail.el
(defvar rmail-file-name (purecopy "~/RMAIL") "\
@@ -22930,8 +23353,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server.
;;;***
-;;;### (autoloads nil "rmailout" "mail/rmailout.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "rmailout" "mail/rmailout.el" (21989 31537
+;;;;;; 907825 721000))
;;; Generated autoloads from mail/rmailout.el
(put 'rmail-output-file-alist 'risky-local-variable t)
@@ -22995,8 +23418,8 @@ than appending to it. Deletes the message after writing if
;;;***
-;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (21978 61237
+;;;;;; 666488 269000))
;;; Generated autoloads from nxml/rng-cmpct.el
(autoload 'rng-c-load-schema "rng-cmpct" "\
@@ -23007,8 +23430,8 @@ Return a pattern.
;;;***
-;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (20813 33065
-;;;;;; 721081 0))
+;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from nxml/rng-nxml.el
(autoload 'rng-nxml-mode-init "rng-nxml" "\
@@ -23020,8 +23443,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil.
;;;***
-;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (20884 6711
-;;;;;; 386198 0))
+;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (21948 40114
+;;;;;; 322686 453000))
;;; Generated autoloads from nxml/rng-valid.el
(autoload 'rng-validate-mode "rng-valid" "\
@@ -23051,8 +23474,8 @@ to use for finding the schema.
;;;***
-;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from nxml/rng-xsd.el
(put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile)
@@ -23079,8 +23502,8 @@ must be equal.
;;;***
-;;;### (autoloads nil "robin" "international/robin.el" (20523 62082
-;;;;;; 997685 0))
+;;;### (autoloads nil "robin" "international/robin.el" (21953 58033
+;;;;;; 303058 929000))
;;; Generated autoloads from international/robin.el
(autoload 'robin-define-package "robin" "\
@@ -23112,7 +23535,7 @@ Start using robin package NAME, which is a string.
;;;***
-;;;### (autoloads nil "rot13" "rot13.el" (20709 26818 907104 0))
+;;;### (autoloads nil "rot13" "rot13.el" (21670 32331 885635 586000))
;;; Generated autoloads from rot13.el
(autoload 'rot13 "rot13" "\
@@ -23149,8 +23572,8 @@ Toggle the use of ROT13 encoding for the current window.
;;;***
-;;;### (autoloads nil "rst" "textmodes/rst.el" (20932 10282 564846
-;;;;;; 0))
+;;;### (autoloads nil "rst" "textmodes/rst.el" (22026 25907 659502
+;;;;;; 692000))
;;; Generated autoloads from textmodes/rst.el
(add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -23180,32 +23603,29 @@ for modes derived from Text mode, like Mail mode.
;;;***
-;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (20944
-;;;;;; 1446 914400 0))
+;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (22015
+;;;;;; 55603 817705 321000))
;;; Generated autoloads from progmodes/ruby-mode.el
-(push (purecopy (quote (ruby-mode 1 2))) package--builtin-versions)
-(autoload 'ruby-mode "ruby-mode" "\
-Major mode for editing Ruby scripts.
-\\[ruby-indent-line] properly indents subexpressions of multi-line
-class, module, def, if, while, for, do, and case statements, taking
-nesting into account.
+(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
-The variable `ruby-indent-level' controls the amount of indentation.
+(autoload 'ruby-mode "ruby-mode" "\
+Major mode for editing Ruby code.
\\{ruby-mode-map}
\(fn)" t nil)
-(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." "rb\\|ru\\|rake\\|thor" "\\|jbuilder\\|gemspec" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "Vagrant\\|Guard\\)file" "\\)\\'")) 'ruby-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy (concat "\\(?:\\." "rb\\|ru\\|rake\\|thor" "\\|jbuilder\\|rabl\\|gemspec\\|podspec" "\\|/" "\\(?:Gem\\|Rake\\|Cap\\|Thor" "\\|Puppet\\|Berks" "\\|Vagrant\\|Guard\\|Pod\\)file" "\\)\\'")) 'ruby-mode))
(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode)))
;;;***
-;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (20791 9657 561026
-;;;;;; 0))
+;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (22026 25907 643502
+;;;;;; 692000))
;;; Generated autoloads from ruler-mode.el
-(push (purecopy (quote (ruler-mode 1 6))) package--builtin-versions)
+(push (purecopy '(ruler-mode 1 6)) package--builtin-versions)
+
(defvar ruler-mode nil "\
Non-nil if Ruler mode is enabled.
Use the command `ruler-mode' to change this variable.")
@@ -23220,8 +23640,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (22011 58553 441858
+;;;;;; 469000))
;;; Generated autoloads from emacs-lisp/rx.el
(autoload 'rx-to-string "rx" "\
@@ -23236,7 +23656,7 @@ Translate regular expressions REGEXPS in sexp form to a regexp string.
REGEXPS is a non-empty sequence of forms of the sort listed below.
Note that `rx' is a Lisp macro; when used in a Lisp program being
- compiled, the translation is performed by the compiler.
+compiled, the translation is performed by the compiler.
See `rx-to-string' for how to do such a translation at run-time.
The following are valid subforms of regular expressions in sexp
@@ -23329,20 +23749,20 @@ CHAR
matches space and tab only.
`graphic', `graph'
- matches graphic characters--everything except ASCII control chars,
- space, and DEL.
+ matches graphic characters--everything except whitespace, ASCII
+ and non-ASCII control characters, surrogates, and codepoints
+ unassigned by Unicode.
`printing', `print'
- matches printing characters--everything except ASCII control chars
- and DEL.
+ matches whitespace and graphic characters.
`alphanumeric', `alnum'
- matches letters and digits. (But at present, for multibyte characters,
- it matches anything that has word syntax.)
+ matches alphabetic characters and digits. (For multibyte characters,
+ it matches according to Unicode character properties.)
`letter', `alphabetic', `alpha'
- matches letters. (But at present, for multibyte characters,
- it matches anything that has word syntax.)
+ matches alphabetic characters. (For multibyte characters,
+ it matches according to Unicode character properties.)
`ascii'
matches ASCII (unibyte) characters.
@@ -23410,7 +23830,7 @@ CHAR
`not-at-end-of-line' (\\c<)
`not-at-beginning-of-line' (\\c>)
`alpha-numeric-two-byte' (\\cA)
- `chinse-two-byte' (\\cC)
+ `chinese-two-byte' (\\cC)
`greek-two-byte' (\\cG)
`japanese-hiragana-two-byte' (\\cH)
`indian-tow-byte' (\\cI)
@@ -23532,16 +23952,18 @@ enclosed in `(and ...)'.
;;;***
-;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from net/sasl-ntlm.el
-(push (purecopy (quote (sasl 1 0))) package--builtin-versions)
+(push (purecopy '(sasl 1 0)) package--builtin-versions)
+
;;;***
-;;;### (autoloads nil "savehist" "savehist.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "savehist" "savehist.el" (21981 37426 703399
+;;;;;; 97000))
;;; Generated autoloads from savehist.el
-(push (purecopy (quote (savehist 24))) package--builtin-versions)
+(push (purecopy '(savehist 24)) package--builtin-versions)
+
(defvar savehist-mode nil "\
Non-nil if Savehist mode is enabled.
See the command `savehist-mode' for a description of this minor mode.
@@ -23570,8 +23992,30 @@ histories, which is probably undesirable.
;;;***
-;;;### (autoloads nil "scheme" "progmodes/scheme.el" (20924 16196
-;;;;;; 967284 0))
+;;;### (autoloads nil "saveplace" "saveplace.el" (21822 58098 20521
+;;;;;; 61000))
+;;; Generated autoloads from saveplace.el
+
+(defvar save-place-mode nil "\
+Non-nil if Save-Place mode is enabled.
+See the command `save-place-mode' 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 `save-place-mode'.")
+
+(custom-autoload 'save-place-mode "saveplace" nil)
+
+(autoload 'save-place-mode "saveplace" "\
+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.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "scheme" "progmodes/scheme.el" (22011 58553
+;;;;;; 925858 469000))
;;; Generated autoloads from progmodes/scheme.el
(autoload 'scheme-mode "scheme" "\
@@ -23591,8 +24035,6 @@ Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
\\{scheme-mode-map}
-Entry to this mode calls the value of `scheme-mode-hook'
-if that value is non-nil.
\(fn)" t nil)
@@ -23612,8 +24054,8 @@ that variable's value is a string.
;;;***
-;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/score-mode.el
(autoload 'gnus-score-mode "score-mode" "\
@@ -23626,8 +24068,8 @@ This mode is an extended emacs-lisp mode.
;;;***
-;;;### (autoloads nil "scroll-all" "scroll-all.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "scroll-all" "scroll-all.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from scroll-all.el
(defvar scroll-all-mode nil "\
@@ -23652,8 +24094,8 @@ one window apply to all visible windows in the same frame.
;;;***
-;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from scroll-lock.el
(autoload 'scroll-lock-mode "scroll-lock" "\
@@ -23669,18 +24111,19 @@ vertically fixed relative to window boundaries during scrolling.
;;;***
-;;;### (autoloads nil "secrets" "net/secrets.el" (20929 34089 117790
-;;;;;; 0))
+;;;### (autoloads nil "secrets" "net/secrets.el" (22011 58553 765858
+;;;;;; 469000))
;;; Generated autoloads from net/secrets.el
(when (featurep 'dbusbind)
(autoload 'secrets-show-secrets "secrets" nil t))
;;;***
-;;;### (autoloads nil "semantic" "cedet/semantic.el" (20908 27948
-;;;;;; 216644 0))
+;;;### (autoloads nil "semantic" "cedet/semantic.el" (21948 40114
+;;;;;; 186686 453000))
;;; Generated autoloads from cedet/semantic.el
-(push (purecopy (quote (semantic 2 2))) package--builtin-versions)
+(push (purecopy '(semantic 2 2)) package--builtin-versions)
+
(defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\
List of auxiliary Semantic minor modes enabled by `semantic-mode'.
The possible elements of this list include the following:
@@ -23735,7 +24178,7 @@ Semantic mode.
;;;***
;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el"
-;;;;;; (20895 15912 444844 0))
+;;;;;; (21670 32330 885624 725000))
;;; Generated autoloads from cedet/semantic/bovine/grammar.el
(autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\
@@ -23746,7 +24189,7 @@ Major mode for editing Bovine grammars.
;;;***
;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el"
-;;;;;; (20879 27694 495748 0))
+;;;;;; (21670 32330 885624 725000))
;;; Generated autoloads from cedet/semantic/wisent/grammar.el
(autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\
@@ -23756,14 +24199,14 @@ Major mode for editing Wisent grammars.
;;;***
-;;;### (autoloads nil "sendmail" "mail/sendmail.el" (20723 59703
-;;;;;; 12265 0))
+;;;### (autoloads nil "sendmail" "mail/sendmail.el" (22026 25907
+;;;;;; 603502 692000))
;;; Generated autoloads from mail/sendmail.el
(defvar mail-from-style 'default "\
Specifies how \"From:\" fields look.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
@@ -24038,7 +24481,14 @@ Like `mail' command, but display mail buffer in another frame.
;;;***
-;;;### (autoloads nil "server" "server.el" (20763 30266 231060 0))
+;;;### (autoloads nil "seq" "emacs-lisp/seq.el" (22026 25907 583502
+;;;;;; 692000))
+;;; Generated autoloads from emacs-lisp/seq.el
+(push (purecopy '(seq 2 0)) package--builtin-versions)
+
+;;;***
+
+;;;### (autoloads nil "server" "server.el" (21998 46517 270024 649000))
;;; Generated autoloads from server.el
(put 'server-host 'risky-local-variable t)
@@ -24105,39 +24555,65 @@ only these files will be asked to be saved.
;;;***
-;;;### (autoloads nil "ses" "ses.el" (20709 26818 907104 0))
+;;;### (autoloads nil "ses" "ses.el" (21990 52406 736500 385000))
;;; Generated autoloads from ses.el
(autoload 'ses-mode "ses" "\
Major mode for Simple Emacs Spreadsheet.
-See \"ses-example.ses\" (in `data-directory') for more info.
-Key definitions:
+When you invoke SES in a new buffer, it is divided into cells
+that you can enter data into. You can navigate the cells with
+the arrow keys and add more cells with the tab key. The contents
+of these cells can be numbers, text, or Lisp expressions. (To
+enter text, enclose it in double quotes.)
+
+In an expression, you can use cell coordinates to refer to the
+contents of another cell. For example, you can sum a range of
+cells with `(+ A1 A2 A3)'. There are specialized functions like
+`ses+' (addition for ranges with empty cells), `ses-average' (for
+performing calculations on cells), and `ses-range' and `ses-select'
+\(for extracting ranges of cells).
+
+Each cell also has a print function that controls how it is
+displayed.
+
+Each SES buffer is divided into a print area and a data area.
+Normally, you can simply use SES to look at and manipulate the print
+area, and let SES manage the data area outside the visible region.
+
+See \"ses-example.ses\" (in `data-directory') for an example
+spreadsheet, and the Info node `(ses)Top.'
+
+In the following, note the separate keymaps for cell editing mode
+and print mode specifications. Key definitions:
+
\\{ses-mode-map}
-These key definitions are active only in the print area (the visible part):
+These key definitions are active only in the print area (the visible
+part):
\\{ses-mode-print-map}
-These are active only in the minibuffer, when entering or editing a formula:
+These are active only in the minibuffer, when entering or editing a
+formula:
\\{ses-mode-edit-map}
\(fn)" t nil)
;;;***
-;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (20784
-;;;;;; 36406 653593 0))
+;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (22011
+;;;;;; 58554 69858 469000))
;;; Generated autoloads from textmodes/sgml-mode.el
(autoload 'sgml-mode "sgml-mode" "\
Major mode for editing SGML documents.
Makes > match <.
-Keys <, &, SPC within <>, \", / and ' can be electric depending on
+Keys <, &, SPC within <>, \", / and \\=' can be electric depending on
`sgml-quick-keys'.
An argument of N to a tag-inserting command means to wrap it around
the next N words. In Transient Mark mode, when the mark is active,
N defaults to -1, which means to wrap it around the current region.
-If you like upcased tags, put (setq sgml-transformation-function 'upcase)
+If you like upcased tags, put (setq sgml-transformation-function \\='upcase)
in your init file.
Use \\[sgml-validate] to validate your document with an SGML parser.
@@ -24181,7 +24657,7 @@ Images in many formats can be inlined with <img src=\"URL\">.
If you mainly create your own documents, `sgml-specials' might be
interesting. But note that some HTML 2 browsers can't handle `&apos;'.
To work around that, do:
- (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
+ (eval-after-load \"sgml-mode\" \\='(aset sgml-char-names ?\\=' nil))
\\{html-mode-map}
@@ -24189,10 +24665,11 @@ To work around that, do:
;;;***
-;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (20850
-;;;;;; 27430 515630 0))
+;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (22027
+;;;;;; 46774 688310 591000))
;;; Generated autoloads from progmodes/sh-script.el
-(push (purecopy (quote (sh-script 2 0 6))) package--builtin-versions)(put 'sh-shell 'safe-local-variable 'symbolp)
+(push (purecopy '(sh-script 2 0 6)) package--builtin-versions)
+(put 'sh-shell 'safe-local-variable 'symbolp)
(autoload 'sh-mode "sh-script" "\
Major mode for editing shell scripts.
@@ -24231,7 +24708,6 @@ buffer indents as it currently is indented.
\\[backward-delete-char-untabify] Delete backward one position, even if it was a tab.
-\\[newline-and-indent] Delete unquoted space and indent new line same as this one.
\\[sh-end-of-command] Go to end of successive commands.
\\[sh-beginning-of-command] Go to beginning of successive commands.
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
@@ -24253,8 +24729,8 @@ with your script for an edit-interpret-debug cycle.
;;;***
-;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (20858 21542
-;;;;;; 723007 0))
+;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (22026 25907
+;;;;;; 583502 692000))
;;; Generated autoloads from emacs-lisp/shadow.el
(autoload 'list-load-path-shadows "shadow" "\
@@ -24276,7 +24752,7 @@ For example, suppose `load-path' is set to
and that each of these directories contains a file called XXX.el. Then
XXX.el in the site-lisp directory is referred to by all of:
-\(require 'XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
+\(require \\='XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc.
The first XXX.el file prevents Emacs from seeing the second (unless
the second is loaded explicitly via `load-file').
@@ -24303,8 +24779,8 @@ function, `load-path-shadows-find'.
;;;***
-;;;### (autoloads nil "shadowfile" "shadowfile.el" (20799 169 640767
-;;;;;; 0))
+;;;### (autoloads nil "shadowfile" "shadowfile.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from shadowfile.el
(autoload 'shadow-define-cluster "shadowfile" "\
@@ -24342,7 +24818,7 @@ Set up file shadowing.
;;;***
-;;;### (autoloads nil "shell" "shell.el" (20884 7264 912957 506000))
+;;;### (autoloads nil "shell" "shell.el" (21896 48221 754207 816000))
;;; Generated autoloads from shell.el
(defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\
@@ -24390,9 +24866,14 @@ Otherwise, one argument `-i' is passed to the shell.
;;;***
-;;;### (autoloads nil "shr" "net/shr.el" (20944 31824 211965 0))
+;;;### (autoloads nil "shr" "net/shr.el" (22026 25907 631502 692000))
;;; Generated autoloads from net/shr.el
+(autoload 'shr-render-region "shr" "\
+Display the HTML rendering of the region between BEGIN and END.
+
+\(fn BEGIN END &optional BUFFER)" t nil)
+
(autoload 'shr-insert-document "shr" "\
Render the parsed document DOM into the current buffer.
DOM should be a parse tree as generated by
@@ -24402,8 +24883,8 @@ DOM should be a parse tree as generated by
;;;***
-;;;### (autoloads nil "sieve" "gnus/sieve.el" (20926 57896 715754
-;;;;;; 0))
+;;;### (autoloads nil "sieve" "gnus/sieve.el" (21972 22452 270264
+;;;;;; 357000))
;;; Generated autoloads from gnus/sieve.el
(autoload 'sieve-manage "sieve" "\
@@ -24428,8 +24909,8 @@ DOM should be a parse tree as generated by
;;;***
-;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (21931 31023
+;;;;;; 733164 572000))
;;; Generated autoloads from gnus/sieve-mode.el
(autoload 'sieve-mode "sieve-mode" "\
@@ -24444,8 +24925,8 @@ Turning on Sieve mode runs `sieve-mode-hook'.
;;;***
-;;;### (autoloads nil "simula" "progmodes/simula.el" (20777 63161
-;;;;;; 848428 0))
+;;;### (autoloads nil "simula" "progmodes/simula.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from progmodes/simula.el
(autoload 'simula-mode "simula" "\
@@ -24493,8 +24974,8 @@ with no arguments, if that value is non-nil.
;;;***
-;;;### (autoloads nil "skeleton" "skeleton.el" (20912 25000 802412
-;;;;;; 0))
+;;;### (autoloads nil "skeleton" "skeleton.el" (22026 25907 643502
+;;;;;; 692000))
;;; Generated autoloads from skeleton.el
(defvar skeleton-filter-function 'identity "\
@@ -24507,7 +24988,7 @@ SKELETON is as defined under `skeleton-insert'.
\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t)
-(put 'define-skeleton 'doc-string-elt '2)
+(function-put 'define-skeleton 'doc-string-elt '2)
(autoload 'skeleton-proxy-new "skeleton" "\
Insert SKELETON.
@@ -24545,7 +25026,9 @@ not needed, a prompt-string or an expression for complex read functions.
If ELEMENT is a string or a character it gets inserted (see also
`skeleton-transformation-function'). Other possibilities are:
- \\n go to next line and indent according to mode
+ \\n go to next line and indent according to mode, unless
+ this is the first/last element of a skeleton and point
+ is at bol/eol
_ interesting point, interregion here
- interesting point, no interregion interaction, overrides
interesting point set by _
@@ -24553,21 +25036,26 @@ If ELEMENT is a string or a character it gets inserted (see also
@ add position to `skeleton-positions'
& do next ELEMENT if previous moved point
| do next ELEMENT if previous didn't move point
- -num delete num preceding characters (see `skeleton-untabify')
+ -NUM delete NUM preceding characters (see `skeleton-untabify')
resume: skipped, continue here if quit is signaled
nil skipped
After termination, point will be positioned at the last occurrence of -
or at the first occurrence of _ or at the end of the inserted text.
-Further elements can be defined via `skeleton-further-elements'. ELEMENT may
-itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
-different inputs. The SKELETON is processed as often as the user enters a
-non-empty string. \\[keyboard-quit] terminates skeleton insertion, but
-continues after `resume:' and positions at `_' if any. If INTERACTOR in such
-a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list of
-strings with the subskeleton being repeated once for each string.
+Note that \\n as the last element of the skeleton only inserts a
+newline if not at eol. If you want to unconditionally insert a newline
+at the end of the skeleton, use \"\\n\" instead. Likewise with \\n
+as the first element when at bol.
+
+Further elements can be defined via `skeleton-further-elements'.
+ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted
+repeatedly for different inputs. The SKELETON is processed as often as
+the user enters a non-empty string. \\[keyboard-quit] terminates skeleton insertion, but
+continues after `resume:' and positions at `_' if any. If INTERACTOR in
+such a subskeleton is a prompt-string which contains a \".. %s ..\" it is
+formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list
+of strings with the subskeleton being repeated once for each string.
Quoted Lisp expressions are evaluated for their side-effects.
Other Lisp expressions are evaluated and the value treated as above.
@@ -24598,15 +25086,16 @@ Pairing is also prohibited if we are right after a quoting character
such as backslash.
If a match is found in `skeleton-pair-alist', that is inserted, else
-the defaults are used. These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others.
+the defaults are used. These are (), [], {}, <> and (grave
+accent, apostrophe) for the paired ones, and the same character
+twice for the others.
\(fn ARG)" t nil)
;;;***
-;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from vc/smerge-mode.el
(autoload 'smerge-ediff "smerge-mode" "\
@@ -24633,8 +25122,8 @@ If no conflict maker is found, turn off `smerge-mode'.
;;;***
-;;;### (autoloads nil "smiley" "gnus/smiley.el" (20726 5184 974741
-;;;;;; 509000))
+;;;### (autoloads nil "smiley" "gnus/smiley.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from gnus/smiley.el
(autoload 'smiley-region "smiley" "\
@@ -24651,8 +25140,8 @@ interactively. If there's no argument, do it at the current buffer.
;;;***
-;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from mail/smtpmail.el
(autoload 'smtpmail-send-it "smtpmail" "\
@@ -24667,8 +25156,8 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'.
;;;***
-;;;### (autoloads nil "snake" "play/snake.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "snake" "play/snake.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from play/snake.el
(autoload 'snake "snake" "\
@@ -24691,8 +25180,8 @@ Snake mode keybindings:
;;;***
-;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (20891 18859
-;;;;;; 893295 0))
+;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from net/snmp-mode.el
(autoload 'snmp-mode "snmp-mode" "\
@@ -24721,8 +25210,8 @@ then `snmpv2-mode-hook'.
;;;***
-;;;### (autoloads nil "solar" "calendar/solar.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "solar" "calendar/solar.el" (21849 48176 337264
+;;;;;; 443000))
;;; Generated autoloads from calendar/solar.el
(autoload 'sunrise-sunset "solar" "\
@@ -24737,8 +25226,8 @@ This function is suitable for execution in an init file.
;;;***
-;;;### (autoloads nil "solitaire" "play/solitaire.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "solitaire" "play/solitaire.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from play/solitaire.el
(autoload 'solitaire "solitaire" "\
@@ -24813,7 +25302,7 @@ Pick your favorite shortcuts:
;;;***
-;;;### (autoloads nil "sort" "sort.el" (20896 36774 886399 0))
+;;;### (autoloads nil "sort" "sort.el" (22011 58553 993858 469000))
;;; Generated autoloads from sort.el
(put 'sort-fold-case 'safe-local-variable 'booleanp)
@@ -24966,31 +25455,29 @@ From a program takes two point or marker arguments, BEG and END.
\(fn BEG END)" t nil)
(autoload 'delete-duplicate-lines "sort" "\
-Delete duplicate lines in the region between BEG and END.
-
-If REVERSE is nil, search and delete duplicates forward keeping the first
-occurrence of duplicate lines. If REVERSE is non-nil (when called
-interactively with C-u prefix), search and delete duplicates backward
-keeping the last occurrence of duplicate lines.
+Delete all but one copy of any identical lines in the region.
+Non-interactively, arguments BEG and END delimit the region.
+Normally it searches forwards, keeping the first instance of
+each identical line. If REVERSE is non-nil (interactively, with
+a C-u prefix), it searches backwards and keeps the last instance of
+each repeated line.
-If ADJACENT is non-nil (when called interactively with two C-u prefixes),
-delete repeated lines only if they are adjacent. It works like the utility
-`uniq' and is useful when lines are already sorted in a large file since
-this is more efficient in performance and memory usage than when ADJACENT
-is nil that uses additional memory to remember previous lines.
+Identical lines need not be adjacent, unless the argument
+ADJACENT is non-nil (interactively, with a C-u C-u prefix).
+This is a more efficient mode of operation, and may be useful
+on large regions that have already been sorted.
-If KEEP-BLANKS is non-nil (when called interactively with three C-u prefixes),
-duplicate blank lines are preserved.
+If the argument KEEP-BLANKS is non-nil (interactively, with a
+C-u C-u C-u prefix), it retains repeated blank lines.
-When called from Lisp and INTERACTIVE is omitted or nil, return the number
-of deleted duplicate lines, do not print it; if INTERACTIVE is t, the
-function behaves in all respects as if it had been called interactively.
+Returns the number of deleted lines. Interactively, or if INTERACTIVE
+is non-nil, it also prints a message describing the number of deletions.
\(fn BEG END &optional REVERSE ADJACENT KEEP-BLANKS INTERACTIVE)" t nil)
;;;***
-;;;### (autoloads nil "spam" "gnus/spam.el" (20901 54695 989166 0))
+;;;### (autoloads nil "spam" "gnus/spam.el" (21981 37426 607399 97000))
;;; Generated autoloads from gnus/spam.el
(autoload 'spam-initialize "spam" "\
@@ -25004,8 +25491,8 @@ installed through `spam-necessary-extra-headers'.
;;;***
-;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (20874
-;;;;;; 65006 672942 217000))
+;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (22011
+;;;;;; 58553 601858 469000))
;;; Generated autoloads from gnus/spam-report.el
(autoload 'spam-report-process-queue "spam-report" "\
@@ -25047,8 +25534,8 @@ Spam reports will be queued with the method used when
;;;***
-;;;### (autoloads nil "speedbar" "speedbar.el" (20892 39729 858825
-;;;;;; 0))
+;;;### (autoloads nil "speedbar" "speedbar.el" (22011 58553 993858
+;;;;;; 469000))
;;; Generated autoloads from speedbar.el
(defalias 'speedbar 'speedbar-frame-mode)
@@ -25072,8 +25559,8 @@ selected. If the speedbar frame is active, then select the attached frame.
;;;***
-;;;### (autoloads nil "spook" "play/spook.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "spook" "play/spook.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from play/spook.el
(autoload 'spook "spook" "\
@@ -25088,10 +25575,11 @@ Return a vector containing the lines from `spook-phrases-file'.
;;;***
-;;;### (autoloads nil "sql" "progmodes/sql.el" (20878 6823 881439
-;;;;;; 0))
+;;;### (autoloads nil "sql" "progmodes/sql.el" (22011 58553 929858
+;;;;;; 469000))
;;; Generated autoloads from progmodes/sql.el
-(push (purecopy (quote (sql 3 2))) package--builtin-versions)
+(push (purecopy '(sql 3 5)) package--builtin-versions)
+
(autoload 'sql-add-product-keywords "sql" "\
Add highlighting KEYWORDS for SQL PRODUCT.
@@ -25105,16 +25593,14 @@ of the current highlighting list.
For example:
- (sql-add-product-keywords 'ms
- '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
+ (sql-add-product-keywords \\='ms
+ \\='((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
adds a fontification pattern to fontify identifiers ending in
`_t' as data types.
\(fn PRODUCT KEYWORDS &optional APPEND)" nil nil)
-(eval '(defun sql-help nil #("Show short help for the SQL modes.\n\nUse an entry function to open an interactive SQL buffer. This buffer is\nusually named `*SQL*'. The name of the major mode is SQLi.\n\nUse the following commands to start a specific SQL interpreter:\n\n \\\\FREE\n\nOther non-free SQL implementations are also supported:\n\n \\\\NONFREE\n\nBut we urge you to choose a free implementation instead of these.\n\nYou can also use \\[sql-product-interactive] to invoke the\ninterpreter for the current `sql-product'.\n\nOnce you have the SQLi buffer, you can enter SQL statements in the\nbuffer. The output generated is appended to the buffer and a new prompt\nis generated. See the In/Out menu in the SQLi buffer for some functions\nthat help you navigate through the buffer, the input history, etc.\n\nIf you have a really complex SQL statement or if you are writing a\nprocedure, you can do this in a separate buffer. Put the new buffer in\n`sql-mode' by calling \\[sql-mode]. The name of this buffer can be\nanything. The name of the major mode is SQL.\n\nIn this SQL buffer (SQL mode), you can send the region or the entire\nbuffer to the interactive SQL buffer (SQLi mode). The results are\nappended to the SQLi buffer without disturbing your SQL buffer." 0 1 (dynamic-docstring-function sql--make-help-docstring)) (interactive) (describe-function 'sql-help)))
-
(autoload 'sql-mode "sql" "\
Major mode to edit SQL.
@@ -25139,7 +25625,7 @@ Note that SQL doesn't have an escape character unless you specify
one. If you specify backslash as escape character in SQL, you
must tell Emacs. Here's how to do that in your init file:
-\(add-hook 'sql-mode-hook
+\(add-hook \\='sql-mode-hook
(lambda ()
(modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))
@@ -25549,16 +26035,22 @@ buffer.
\(fn &optional BUFFER)" t nil)
+(autoload 'sql-vertica "sql" "\
+Run vsql as an inferior process.
+
+\(fn &optional BUFFER)" t nil)
+
;;;***
-;;;### (autoloads nil "srecode" "cedet/srecode.el" (20748 62911 684442
-;;;;;; 0))
+;;;### (autoloads nil "srecode" "cedet/srecode.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from cedet/srecode.el
-(push (purecopy (quote (srecode 1 2))) package--builtin-versions)
+(push (purecopy '(srecode 1 2)) package--builtin-versions)
+
;;;***
;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el"
-;;;;;; (20813 33065 721081 0))
+;;;;;; (21998 46516 910024 649000))
;;; Generated autoloads from cedet/srecode/srt-mode.el
(autoload 'srecode-template-mode "srecode/srt-mode" "\
@@ -25570,8 +26062,8 @@ Major-mode for writing SRecode macros.
;;;***
-;;;### (autoloads nil "starttls" "gnus/starttls.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "starttls" "gnus/starttls.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from gnus/starttls.el
(autoload 'starttls-open-stream "starttls" "\
@@ -25594,14 +26086,15 @@ GnuTLS requires a port number.
;;;***
-;;;### (autoloads nil "strokes" "strokes.el" (20799 169 640767 0))
+;;;### (autoloads nil "strokes" "strokes.el" (21981 37426 735399
+;;;;;; 97000))
;;; Generated autoloads from strokes.el
(autoload 'strokes-global-set-stroke "strokes" "\
Interactively give STROKE the global binding as COMMAND.
-Operated just like `global-set-key', except for strokes.
-COMMAND is a symbol naming an interactively-callable function. STROKE
-is a list of sampled positions on the stroke grid as described in the
+Works just like `global-set-key', except for strokes. COMMAND is
+a symbol naming an interactively-callable function. STROKE is a
+list of sampled positions on the stroke grid as described in the
documentation for the `strokes-define-stroke' function.
See also `strokes-global-set-stroke-string'.
@@ -25657,8 +26150,8 @@ Load user-defined strokes from file named by `strokes-file'.
(autoload 'strokes-list-strokes "strokes" "\
Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
-With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes
-chronologically by command name.
+With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes chronologically
+by command name.
If STROKES-MAP is not given, `strokes-global-map' will be used instead.
\(fn &optional CHRONOLOGICAL STROKES-MAP)" t nil)
@@ -25675,8 +26168,8 @@ or call the function `strokes-mode'.")
(autoload 'strokes-mode "strokes" "\
Toggle Strokes mode, a global minor mode.
With a prefix argument ARG, enable Strokes mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
@@ -25707,8 +26200,8 @@ Read a complex stroke and insert its glyph into the current buffer.
;;;***
-;;;### (autoloads nil "studly" "play/studly.el" (20355 10021 546955
-;;;;;; 0))
+;;;### (autoloads nil "studly" "play/studly.el" (21607 54478 800121
+;;;;;; 42000))
;;; Generated autoloads from play/studly.el
(autoload 'studlify-region "studly" "\
@@ -25728,18 +26221,20 @@ Studlify-case the current buffer.
;;;***
-;;;### (autoloads nil "subword" "progmodes/subword.el" (20886 47777
-;;;;;; 83668 440000))
+;;;### (autoloads nil "subword" "progmodes/subword.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from progmodes/subword.el
+(define-obsolete-function-alias 'capitalized-words-mode 'subword-mode "25.1")
+
(autoload 'subword-mode "subword" "\
Toggle subword movement and editing (Subword mode).
With a prefix argument ARG, enable Subword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Subword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to subword-based commands that handle
+Subword mode is a buffer-local minor mode. Enabling it changes
+the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
@@ -25753,9 +26248,8 @@ called a `subword'. Here are some examples:
EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
-The subword oriented commands activated in this minor mode recognize
-subwords in a nomenclature to move between subwords and to edit them
-as words.
+This mode changes the definition of a word so that word commands
+treat nomenclature boundaries as word boundaries.
\\{subword-mode-map}
@@ -25788,13 +26282,10 @@ With a prefix argument ARG, enable Superword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Superword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to superword-based commands that
-treat symbols as words, e.g. \"this_is_a_symbol\".
-
-The superword oriented commands activated in this minor mode
-recognize symbols as superwords to move between superwords and to
-edit them as words.
+Superword mode is a buffer-local minor mode. Enabling it changes
+the definition of words such that symbols characters are treated
+as parts of words: e.g., in `superword-mode',
+\"this_is_a_symbol\" counts as one word.
\\{superword-mode-map}
@@ -25823,8 +26314,8 @@ See `superword-mode' for more information on Superword mode.
;;;***
-;;;### (autoloads nil "supercite" "mail/supercite.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "supercite" "mail/supercite.el" (21852 24381
+;;;;;; 697240 10000))
;;; Generated autoloads from mail/supercite.el
(autoload 'sc-cite-original "supercite" "\
@@ -25856,8 +26347,8 @@ and `sc-post-hook' is run after the guts of this function.
;;;***
-;;;### (autoloads nil "t-mouse" "t-mouse.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "t-mouse" "t-mouse.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from t-mouse.el
(define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1")
@@ -25885,7 +26376,7 @@ It relies on the `gpm' daemon being activated.
;;;***
-;;;### (autoloads nil "tabify" "tabify.el" (20928 13222 500272 0))
+;;;### (autoloads nil "tabify" "tabify.el" (21670 32331 885635 586000))
;;; Generated autoloads from tabify.el
(autoload 'untabify "tabify" "\
@@ -25914,31 +26405,10 @@ The variable `tab-width' controls the spacing of tab stops.
;;;***
-;;;### (autoloads nil "table" "textmodes/table.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "table" "textmodes/table.el" (21998 46517 298024
+;;;;;; 649000))
;;; Generated autoloads from textmodes/table.el
-(defvar table-cell-map-hook nil "\
-Normal hooks run when finishing construction of `table-cell-map'.
-User can modify `table-cell-map' by adding custom functions here.")
-
-(custom-autoload 'table-cell-map-hook "table" t)
-
-(defvar table-load-hook nil "\
-List of functions to be called after the table is first loaded.")
-
-(custom-autoload 'table-load-hook "table" t)
-
-(defvar table-point-entered-cell-hook nil "\
-List of functions to be called after point entered a table cell.")
-
-(custom-autoload 'table-point-entered-cell-hook "table" t)
-
-(defvar table-point-left-cell-hook nil "\
-List of functions to be called after point left a table cell.")
-
-(custom-autoload 'table-point-left-cell-hook "table" t)
-
(autoload 'table-insert "table" "\
Insert an editable text table.
Insert a table of specified number of COLUMNS and ROWS. Optional
@@ -26249,15 +26719,15 @@ ORIENTATION is a symbol either horizontally or vertically.
(autoload 'table-justify "table" "\
Justify contents of a cell, a row of cells or a column of cells.
-WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
-'center, 'right, 'top, 'middle, 'bottom or 'none.
+WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
+`left', `center', `right', `top', `middle', `bottom' or `none'.
\(fn WHAT JUSTIFY)" t nil)
(autoload 'table-justify-cell "table" "\
Justify cell contents.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
-'middle, 'bottom or 'none for vertical. When optional PARAGRAPH is
+JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
+`middle', `bottom' or `none' for vertical. When optional PARAGRAPH is
non-nil the justify operation is limited to the current paragraph,
otherwise the entire cell contents is justified.
@@ -26265,15 +26735,15 @@ otherwise the entire cell contents is justified.
(autoload 'table-justify-row "table" "\
Justify cells of a row.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical.
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical.
\(fn JUSTIFY)" t nil)
(autoload 'table-justify-column "table" "\
Justify cells of a column.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical.
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical.
\(fn JUSTIFY)" t nil)
@@ -26346,25 +26816,25 @@ INTERVAL is the number of cells to travel between sequence element
insertion which is normally 1. When zero or less is given for
INTERVAL it is interpreted as number of cells per row so that sequence
is placed straight down vertically as long as the table's cell
-structure is uniform. JUSTIFY is one of the symbol 'left, 'center or
-'right, that specifies justification of the inserted string.
+structure is uniform. JUSTIFY is a symbol `left', `center' or
+`right' that specifies justification of the inserted string.
Example:
(progn
(table-insert 16 3 5 1)
(table-forward-cell 15)
- (table-insert-sequence \"D0\" -16 1 1 'center)
+ (table-insert-sequence \"D0\" -16 1 1 \\='center)
(table-forward-cell 16)
- (table-insert-sequence \"A[0]\" -16 1 1 'center)
+ (table-insert-sequence \"A[0]\" -16 1 1 \\='center)
(table-forward-cell 1)
- (table-insert-sequence \"-\" 16 0 1 'center))
+ (table-insert-sequence \"-\" 16 0 1 \\='center))
(progn
(table-insert 16 8 5 1)
- (table-insert-sequence \"@\" 0 1 2 'right)
+ (table-insert-sequence \"@\" 0 1 2 \\='right)
(table-forward-cell 1)
- (table-insert-sequence \"64\" 0 1 2 'left))
+ (table-insert-sequence \"64\" 0 1 2 \\='left))
\(fn STR N INCREMENT INTERVAL JUSTIFY)" t nil)
@@ -26507,7 +26977,7 @@ converts a table into plain text without frames. It is a companion to
;;;***
-;;;### (autoloads nil "talk" "talk.el" (20709 26818 907104 0))
+;;;### (autoloads nil "talk" "talk.el" (21670 32331 885635 586000))
;;; Generated autoloads from talk.el
(autoload 'talk-connect "talk" "\
@@ -26522,8 +26992,8 @@ Connect to the Emacs talk group from the current X display or tty frame.
;;;***
-;;;### (autoloads nil "tar-mode" "tar-mode.el" (20932 10282 564846
-;;;;;; 0))
+;;;### (autoloads nil "tar-mode" "tar-mode.el" (21704 50495 455324
+;;;;;; 752000))
;;; Generated autoloads from tar-mode.el
(autoload 'tar-mode "tar-mode" "\
@@ -26546,8 +27016,8 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
;;;***
-;;;### (autoloads nil "tcl" "progmodes/tcl.el" (20903 10024 645978
-;;;;;; 0))
+;;;### (autoloads nil "tcl" "progmodes/tcl.el" (21842 42581 539414
+;;;;;; 570000))
;;; Generated autoloads from progmodes/tcl.el
(autoload 'tcl-mode "tcl" "\
@@ -26595,8 +27065,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'.
;;;***
-;;;### (autoloads nil "telnet" "net/telnet.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "telnet" "net/telnet.el" (21852 24381 767239
+;;;;;; 782000))
;;; Generated autoloads from net/telnet.el
(autoload 'telnet "telnet" "\
@@ -26621,7 +27091,7 @@ Normally input is edited in Emacs and sent a line at a time.
;;;***
-;;;### (autoloads nil "term" "term.el" (20921 39978 248467 0))
+;;;### (autoloads nil "term" "term.el" (22011 58553 997858 469000))
;;; Generated autoloads from term.el
(autoload 'make-term "term" "\
@@ -26663,8 +27133,8 @@ use in that buffer.
;;;***
-;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (20878
-;;;;;; 6823 881439 0))
+;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (21998
+;;;;;; 46517 22024 649000))
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-this-defun "testcover" "\
@@ -26674,10 +27144,11 @@ Start coverage on function under point.
;;;***
-;;;### (autoloads nil "tetris" "play/tetris.el" (20874 65006 672942
-;;;;;; 217000))
+;;;### (autoloads nil "tetris" "play/tetris.el" (22000 1842 148539
+;;;;;; 693000))
;;; Generated autoloads from play/tetris.el
-(push (purecopy (quote (tetris 2 1))) package--builtin-versions)
+(push (purecopy '(tetris 2 1)) package--builtin-versions)
+
(autoload 'tetris "tetris" "\
Play the Tetris game.
Shapes drop from the top of the screen, and the user has to move and
@@ -26699,8 +27170,8 @@ tetris-mode keybindings:
;;;***
-;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (20774 53405
-;;;;;; 754743 8000))
+;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (22026 25907
+;;;;;; 663502 692000))
;;; Generated autoloads from textmodes/tex-mode.el
(defvar tex-shell-file-name nil "\
@@ -26862,8 +27333,8 @@ says which mode to use.
(autoload 'plain-tex-mode "tex-mode" "\
Major mode for editing files of input for plain TeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run TeX on the current region, plus a \"header\"
copied from the top of the file (containing macro definitions, etc.),
@@ -26905,8 +27376,8 @@ special subshell is initiated, the hook `tex-shell-hook' is run.
(autoload 'latex-mode "tex-mode" "\
Major mode for editing files of input for LaTeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run LaTeX on the current region, plus the preamble
copied from the top of the file (containing \\documentstyle, etc.),
@@ -26948,8 +27419,8 @@ subshell is initiated, `tex-shell-hook' is run.
(autoload 'slitex-mode "tex-mode" "\
Major mode for editing files of input for SliTeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run SliTeX on the current region, plus the preamble
copied from the top of the file (containing \\documentstyle, etc.),
@@ -27001,8 +27472,8 @@ Major mode to edit DocTeX files.
;;;***
-;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (22011 58554
+;;;;;; 81858 469000))
;;; Generated autoloads from textmodes/texinfmt.el
(autoload 'texinfo-format-buffer "texinfmt" "\
@@ -27041,8 +27512,8 @@ if large. You can use `Info-split' to do this manually.
;;;***
-;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (22026 25907
+;;;;;; 667502 692000))
;;; Generated autoloads from textmodes/texinfo.el
(defvar texinfo-open-quote (purecopy "``") "\
@@ -27126,8 +27597,8 @@ value of `texinfo-mode-hook'.
;;;***
-;;;### (autoloads nil "thai-util" "language/thai-util.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "thai-util" "language/thai-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/thai-util.el
(autoload 'thai-compose-region "thai-util" "\
@@ -27154,8 +27625,8 @@ Compose Thai characters in the current buffer.
;;;***
-;;;### (autoloads nil "thingatpt" "thingatpt.el" (20874 62962 290468
-;;;;;; 0))
+;;;### (autoloads nil "thingatpt" "thingatpt.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from thingatpt.el
(autoload 'forward-thing "thingatpt" "\
@@ -27219,7 +27690,7 @@ Return the Lisp list at point, or nil if none is found.
;;;***
-;;;### (autoloads nil "thumbs" "thumbs.el" (20709 26818 907104 0))
+;;;### (autoloads nil "thumbs" "thumbs.el" (21993 28596 414597 473000))
;;; Generated autoloads from thumbs.el
(autoload 'thumbs-find-thumb "thumbs" "\
@@ -27253,8 +27724,8 @@ In dired, call the setroot program on the image at point.
;;;***
-;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (20826
-;;;;;; 45095 436233 0))
+;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/tibet-util.el
(autoload 'tibetan-char-p "tibet-util" "\
@@ -27327,31 +27798,74 @@ See also docstring of the function tibetan-compose-region.
;;;***
-;;;### (autoloads nil "tildify" "textmodes/tildify.el" (20791 9657
-;;;;;; 561026 0))
+;;;### (autoloads nil "tildify" "textmodes/tildify.el" (22026 25907
+;;;;;; 667502 692000))
;;; Generated autoloads from textmodes/tildify.el
-(push (purecopy (quote (tildify 4 5))) package--builtin-versions)
+(push (purecopy '(tildify 4 6 1)) package--builtin-versions)
+
(autoload 'tildify-region "tildify" "\
Add hard spaces in the region between BEG and END.
-See variables `tildify-pattern-alist', `tildify-string-alist', and
+See variables `tildify-pattern', `tildify-space-string', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
This function performs no refilling of the changed text.
+If DONT-ASK is set, or called interactively with prefix argument, user
+won't be prompted for confirmation of each substitution.
-\(fn BEG END)" t nil)
+\(fn BEG END &optional DONT-ASK)" t nil)
(autoload 'tildify-buffer "tildify" "\
Add hard spaces in the current buffer.
-See variables `tildify-pattern-alist', `tildify-string-alist', and
+See variables `tildify-pattern', `tildify-space-string', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
This function performs no refilling of the changed text.
+If DONT-ASK is set, or called interactively with prefix argument, user
+won't be prompted for confirmation of each substitution.
+
+\(fn &optional DONT-ASK)" t nil)
+
+(autoload 'tildify-space "tildify" "\
+Convert space before point into a hard space if the context is right.
+
+If
+ * character before point is a space character,
+ * character before that has \"w\" character syntax (i.e. it's a word
+ constituent),
+ * `tildify-space-pattern' matches when `looking-back' (no more than 10
+ characters) from before the space character, and
+ * all predicates in `tildify-space-predicates' return non-nil,
+replace the space character with value of `tildify-space-string' and
+return t.
+
+Otherwise, if
+ * `tildify-double-space-undos' variable is non-nil,
+ * character before point is a space character, and
+ * text before that is a hard space as defined by
+ `tildify-space-string' variable,
+remove the hard space and leave only the space character.
+
+This function is meant to be used as a `post-self-insert-hook'.
\(fn)" t nil)
+(autoload 'tildify-mode "tildify" "\
+Adds electric behaviour to space character.
+
+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'),
+that space character is replaced by a hard space specified by
+`tildify-space-string'. Converting of the space is done by `tildify-space'.
+
+When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
+representation for current major mode, the `tildify-space-string' buffer-local
+variable will be set to the representation.
+
+\(fn &optional ARG)" t nil)
+
;;;***
-;;;### (autoloads nil "time" "time.el" (20709 26818 907104 0))
+;;;### (autoloads nil "time" "time.el" (22026 25907 667502 692000))
;;; Generated autoloads from time.el
(defvar display-time-day-and-date nil "\
@@ -27413,8 +27927,8 @@ Return a string giving the duration of the Emacs initialization.
;;;***
-;;;### (autoloads nil "time-date" "calendar/time-date.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "time-date" "calendar/time-date.el" (22000
+;;;;;; 55581 510930 477000))
;;; Generated autoloads from calendar/time-date.el
(autoload 'date-to-time "time-date" "\
@@ -27429,15 +27943,10 @@ If DATE lacks timezone information, GMT is assumed.
(autoload 'time-to-seconds "time-date"))
(autoload 'seconds-to-time "time-date" "\
-Convert SECONDS (a floating point number) to a time value.
+Convert SECONDS to a time value.
\(fn SECONDS)" nil nil)
-(autoload 'time-less-p "time-date" "\
-Return non-nil if time value T1 is earlier than time value T2.
-
-\(fn T1 T2)" nil nil)
-
(autoload 'days-to-time "time-date" "\
Convert DAYS into a time value.
@@ -27450,17 +27959,9 @@ TIME should be either a time value or a date-time string.
\(fn TIME)" nil nil)
(defalias 'subtract-time 'time-subtract)
-
-(autoload 'time-subtract "time-date" "\
-Subtract two time values, T1 minus T2.
-Return the difference in the format of a time value.
-
-\(fn T1 T2)" nil nil)
-
-(autoload 'time-add "time-date" "\
-Add two time values T1 and T2. One should represent a time difference.
-
-\(fn T1 T2)" nil nil)
+(autoload 'time-add "time-date")
+(autoload 'time-subtract "time-date")
+(autoload 'time-less-p "time-date")
(autoload 'date-to-day "time-date" "\
Return the number of days between year 1 and DATE.
@@ -27523,10 +28024,15 @@ This function does not work for SECONDS greater than `most-positive-fixnum'.
\(fn STRING SECONDS)" nil nil)
+(autoload 'seconds-to-string "time-date" "\
+Convert the time interval in seconds to a short string.
+
+\(fn DELAY)" nil nil)
+
;;;***
-;;;### (autoloads nil "time-stamp" "time-stamp.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "time-stamp" "time-stamp.el" (21980 16568 89544
+;;;;;; 893000))
;;; Generated autoloads from time-stamp.el
(put 'time-stamp-format 'safe-local-variable 'stringp)
(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
@@ -27541,7 +28047,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'.
Update the time stamp string(s) in the buffer.
A template in a file can be automatically updated with a new time stamp
every time you save the file. Add this line to your init file:
- (add-hook 'before-save-hook 'time-stamp)
+ (add-hook \\='before-save-hook \\='time-stamp)
or customize `before-save-hook' through Custom.
Normally the template must appear in the first 8 lines of a file and
look like one of the following:
@@ -27566,10 +28072,20 @@ With ARG, turn time stamping on if and only if arg is positive.
;;;***
-;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (20799
-;;;;;; 169 640767 0))
+;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (21998
+;;;;;; 46516 882024 649000))
;;; Generated autoloads from calendar/timeclock.el
-(push (purecopy (quote (timeclock 2 6 1))) package--builtin-versions)
+(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.
+See the command `timeclock-mode-line-display' 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 `timeclock-mode-line-display'.")
+
+(custom-autoload 'timeclock-mode-line-display "timeclock" nil)
+
(autoload 'timeclock-mode-line-display "timeclock" "\
Toggle display of the amount of time left today in the mode line.
If `timeclock-use-display-time' is non-nil (the default), then
@@ -27667,7 +28183,7 @@ relative only to the time worked today, and not to past time.
;;;***
;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el"
-;;;;;; (20929 34089 117790 0))
+;;;;;; (22011 58553 673858 469000))
;;; Generated autoloads from international/titdic-cnv.el
(autoload 'titdic-convert "titdic-cnv" "\
@@ -27689,7 +28205,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\".
;;;***
-;;;### (autoloads nil "tmm" "tmm.el" (20764 51137 83502 0))
+;;;### (autoloads nil "tmm" "tmm.el" (21907 48688 873360 195000))
;;; Generated autoloads from tmm.el
(define-key global-map "\M-`" 'tmm-menubar)
(define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
@@ -27700,6 +28216,10 @@ See the documentation for `tmm-prompt'.
X-POSITION, if non-nil, specifies a horizontal position within the menu bar;
we make that menu bar item (the one at that position) the default choice.
+Note that \\[menu-bar-open] by default drops down TTY menus; if you want it
+to invoke `tmm-menubar' instead, customize the variable
+`tty-menu-open-use-tmm' to a non-nil value.
+
\(fn &optional X-POSITION)" t nil)
(autoload 'tmm-menubar-mouse "tmm" "\
@@ -27727,8 +28247,8 @@ Its value should be an event that has a binding in MENU.
;;;***
-;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (20944
-;;;;;; 31824 211965 0))
+;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (22015
+;;;;;; 55603 665705 321000))
;;; Generated autoloads from calendar/todo-mode.el
(autoload 'todo-show "todo-mode" "\
@@ -27770,12 +28290,33 @@ and done items are always shown on visiting a category.
Invoking this command in Todo Archive mode visits the
corresponding todo file, displaying the corresponding category.
-\(fn &optional SOLICIT-FILE)" t nil)
+\(fn &optional SOLICIT-FILE INTERACTIVE)" t nil)
+
+(autoload 'todo-mode "todo-mode" "\
+Major mode for displaying, navigating and editing todo lists.
+
+\\{todo-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'todo-archive-mode "todo-mode" "\
+Major mode for archived todo categories.
+
+\\{todo-archive-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'todo-filtered-items-mode "todo-mode" "\
+Mode for displaying and reprioritizing top priority Todo.
+
+\\{todo-filtered-items-mode-map}
+
+\(fn)" t nil)
;;;***
-;;;### (autoloads nil "tool-bar" "tool-bar.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "tool-bar" "tool-bar.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from tool-bar.el
(autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\
@@ -27845,73 +28386,8 @@ holds a keymap.
;;;***
-;;;### (autoloads nil "tpu-edt" "emulation/tpu-edt.el" (20884 7264
-;;;;;; 412929 442000))
-;;; Generated autoloads from emulation/tpu-edt.el
-(push (purecopy (quote (tpu-edt 4 5))) package--builtin-versions)
-(defvar tpu-edt-mode nil "\
-Non-nil if Tpu-Edt mode is enabled.
-See the command `tpu-edt-mode' 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 `tpu-edt-mode'.")
-
-(custom-autoload 'tpu-edt-mode "tpu-edt" nil)
-
-(autoload 'tpu-edt-mode "tpu-edt" "\
-Toggle TPU/edt emulation on or off.
-With a prefix argument ARG, enable the mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-
-\(fn &optional ARG)" t nil)
-
-(defalias 'tpu-edt 'tpu-edt-on)
-
-(autoload 'tpu-edt-on "tpu-edt" "\
-Turn on TPU/edt emulation.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "tpu-mapper" "emulation/tpu-mapper.el" (20709
-;;;;;; 26818 907104 0))
-;;; Generated autoloads from emulation/tpu-mapper.el
-
-(autoload 'tpu-mapper "tpu-mapper" "\
-Create an Emacs lisp file defining the TPU-edt keypad for X-windows.
-
-This command displays an instruction screen showing the TPU-edt keypad
-and asks you to press the TPU-edt editing keys. It uses the keys you
-press to create an Emacs Lisp file that will define a TPU-edt keypad
-for your X server. You can even re-arrange the standard EDT keypad to
-suit your tastes (or to cope with those silly Sun and PC keypads).
-
-Finally, you will be prompted for the name of the file to store the key
-definitions. If you chose the default, TPU-edt will find it and load it
-automatically. If you specify a different file name, you will need to
-set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
-you might go about doing that in your init file.
-
- (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
- (tpu-edt)
-
-Known Problems:
-
-Sometimes, tpu-mapper will ignore a key you press, and just continue to
-prompt for the same key. This can happen when your window manager sucks
-up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
-Either way, there's nothing that tpu-mapper can do about it. You must
-press RETURN, to skip the current key and continue. Later, you and/or
-your local X guru can try to figure out why the key is being ignored.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (21670 32330 885624
+;;;;;; 725000))
;;; Generated autoloads from emacs-lisp/tq.el
(autoload 'tq-create "tq" "\
@@ -27924,8 +28400,8 @@ to a tcp server on another machine.
;;;***
-;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (20903 10024
-;;;;;; 645978 0))
+;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from emacs-lisp/trace.el
(defvar trace-buffer "*trace-output*" "\
@@ -27940,22 +28416,29 @@ You can call this function to add internal values in the trace buffer.
\(fn &rest VALUES)" nil nil)
(autoload 'trace-function-foreground "trace" "\
-Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead.
+Trace calls to function FUNCTION.
+With a prefix argument, also prompt for the trace buffer (default
+`trace-buffer'), and a Lisp expression CONTEXT.
-To untrace a function, use `untrace-function' or `untrace-all'.
+Tracing a function causes every call to that function to insert
+into BUFFER Lisp-style trace messages that display the function's
+arguments and return values. It also evaluates CONTEXT, if that is
+non-nil, and inserts its value too. For example, you can use this
+to track the current buffer, or position of point.
+
+This function creates BUFFER if it does not exist. This buffer will
+popup whenever FUNCTION is called. Do not use this function to trace
+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'.
\(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
(autoload 'trace-function-background "trace" "\
-Traces FUNCTION with trace output going quietly to BUFFER.
-Like `trace-function-foreground' but without popping up the trace BUFFER or
-changing the window configuration.
+Trace calls to function FUNCTION, quietly.
+This is like `trace-function-foreground', but without popping up
+the output buffer or changing the window configuration.
\(fn FUNCTION &optional BUFFER CONTEXT)" t nil)
@@ -27963,8 +28446,8 @@ changing the window configuration.
;;;***
-;;;### (autoloads nil "tramp" "net/tramp.el" (20854 24486 190633
-;;;;;; 0))
+;;;### (autoloads nil "tramp" "net/tramp.el" (22015 55603 713705
+;;;;;; 321000))
;;; Generated autoloads from net/tramp.el
(defvar tramp-mode t "\
@@ -27979,12 +28462,11 @@ Tramp filename syntax to be used.
It can have the following values:
'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
- 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
- 'url -- URL-like syntax.")
+ 'sep -- Syntax as defined for XEmacs.")
(custom-autoload 'tramp-syntax "tramp" t)
-(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):" "\\`/\\([^[/|:]+\\|[^/|]+]\\):") "\
+(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):" "\\`/[^/|:][^/|]*:") "\
Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
@@ -27996,11 +28478,7 @@ Value for `tramp-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://" "\
-Value for `tramp-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
+(defconst tramp-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\
Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
When tramp.el is loaded, this regular expression is prepended to
@@ -28028,11 +28506,7 @@ Value for `tramp-completion-file-name-regexp' for separate remoting.
XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
-(defconst tramp-completion-file-name-regexp-url "\\`/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'" "\
-Value for `tramp-completion-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-(defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url) (t (error "Wrong `tramp-syntax' defined"))) "\
+(defconst tramp-completion-file-name-regexp (cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified) ((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate) (t (error "Wrong `tramp-syntax' defined"))) "\
Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
@@ -28049,30 +28523,22 @@ Used for file names matching `tramp-file-name-regexp'. Operations
not mentioned here will be handled by Tramp's file name handler
functions, or the normal Emacs functions.")
-(defun tramp-run-real-handler (operation args) "\
-Invoke normal file name handler for OPERATION.
-First arg specifies the OPERATION, second arg is a list of arguments to
-pass to the OPERATION." (let* ((inhibit-file-name-handlers (\` (tramp-file-name-handler tramp-vc-file-name-handler tramp-completion-file-name-handler cygwin-mount-name-hook-function cygwin-mount-map-drive-hook-function \, (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers)))) (inhibit-file-name-operation operation)) (apply operation args)))
-
(defun tramp-completion-run-real-handler (operation args) "\
Invoke `tramp-file-name-handler' for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION." (let* ((inhibit-file-name-handlers (\` (tramp-completion-file-name-handler cygwin-mount-name-hook-function cygwin-mount-map-drive-hook-function \, (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers)))) (inhibit-file-name-operation operation)) (apply operation args)))
-(autoload 'tramp-file-name-handler "tramp" "\
-Invoke Tramp file name handler.
-Falls back to normal file name handler if no Tramp file name handler exists.
-
-\(fn OPERATION &rest ARGS)" nil nil)
-
(defun tramp-completion-file-name-handler (operation &rest args) "\
Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists." (let ((directory-sep-char 47) (fn (assoc operation tramp-completion-file-name-handler-alist))) (if (and fn tramp-mode (or (eq tramp-syntax (quote sep)) (featurep (quote tramp)) (and (boundp (quote partial-completion-mode)) (symbol-value (quote partial-completion-mode))) (featurep (quote ido)) (featurep (quote icicles)))) (save-match-data (apply (cdr fn) args)) (tramp-completion-run-real-handler operation args))))
-(defun tramp-register-file-name-handlers nil "\
-Add Tramp file name handlers to `file-name-handler-alist'." (let ((a1 (rassq (quote tramp-file-name-handler) file-name-handler-alist))) (setq file-name-handler-alist (delq a1 file-name-handler-alist))) (let ((a1 (rassq (quote tramp-completion-file-name-handler) file-name-handler-alist))) (setq file-name-handler-alist (delq a1 file-name-handler-alist))) (add-to-list (quote file-name-handler-alist) (cons tramp-file-name-regexp (quote tramp-file-name-handler))) (put (quote tramp-file-name-handler) (quote safe-magic) t) (add-to-list (quote file-name-handler-alist) (cons tramp-completion-file-name-regexp (quote tramp-completion-file-name-handler))) (put (quote tramp-completion-file-name-handler) (quote safe-magic) t) (dolist (fnh (quote (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)))))))
+(defun tramp-autoload-file-name-handler (operation &rest args) "\
+Load Tramp file name handler, and perform OPERATION." (let ((default-directory "/")) (load "tramp" nil t)) (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 (quote file-name-handler-alist) (cons tramp-file-name-regexp (quote tramp-autoload-file-name-handler))) (put (quote tramp-autoload-file-name-handler) (quote safe-magic) t) (add-to-list (quote file-name-handler-alist) (cons tramp-completion-file-name-regexp (quote tramp-completion-file-name-handler))) (put (quote tramp-completion-file-name-handler) (quote safe-magic) t))
-(tramp-register-file-name-handlers)
+(tramp-register-autoload-file-name-handlers)
(autoload 'tramp-unload-file-name-handlers "tramp" "\
@@ -28096,8 +28562,8 @@ Discard Tramp from loading remote files.
;;;***
-;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from net/tramp-ftp.el
(autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\
@@ -28107,8 +28573,8 @@ Discard Tramp from loading remote files.
;;;***
-;;;### (autoloads nil "tutorial" "tutorial.el" (20760 54070 584283
-;;;;;; 0))
+;;;### (autoloads nil "tutorial" "tutorial.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from tutorial.el
(autoload 'help-with-tutorial "tutorial" "\
@@ -28132,8 +28598,8 @@ resumed later.
;;;***
-;;;### (autoloads nil "tv-util" "language/tv-util.el" (20355 10021
-;;;;;; 546955 0))
+;;;### (autoloads nil "tv-util" "language/tv-util.el" (21855 577
+;;;;;; 57945 485000))
;;; Generated autoloads from language/tv-util.el
(autoload 'tai-viet-composition-function "tv-util" "\
@@ -28143,8 +28609,8 @@ resumed later.
;;;***
-;;;### (autoloads nil "two-column" "textmodes/two-column.el" (20763
-;;;;;; 30266 231060 0))
+;;;### (autoloads nil "two-column" "textmodes/two-column.el" (21998
+;;;;;; 46517 298024 649000))
;;; Generated autoloads from textmodes/two-column.el
(autoload '2C-command "two-column" () t 'keymap)
(global-set-key "\C-x6" '2C-command)
@@ -28191,8 +28657,8 @@ First column's text sSs Second column's text
;;;***
-;;;### (autoloads nil "type-break" "type-break.el" (20884 7264 912957
-;;;;;; 506000))
+;;;### (autoloads nil "type-break" "type-break.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from type-break.el
(defvar type-break-mode nil "\
@@ -28324,7 +28790,7 @@ FRAC should be the inverse of the fractional value; for example, a value of
;;;***
-;;;### (autoloads nil "uce" "mail/uce.el" (20709 26818 907104 0))
+;;;### (autoloads nil "uce" "mail/uce.el" (22026 25907 603502 692000))
;;; Generated autoloads from mail/uce.el
(autoload 'uce-reply-to-uce "uce" "\
@@ -28338,7 +28804,7 @@ You might need to set `uce-mail-reader' before using this.
;;;***
;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el"
-;;;;;; (20709 26818 907104 0))
+;;;;;; (21670 32331 385639 720000))
;;; Generated autoloads from international/ucs-normalize.el
(autoload 'ucs-normalize-NFD-region "ucs-normalize" "\
@@ -28403,8 +28869,8 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus.
;;;***
-;;;### (autoloads nil "underline" "textmodes/underline.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "underline" "textmodes/underline.el" (21670
+;;;;;; 32331 885635 586000))
;;; Generated autoloads from textmodes/underline.el
(autoload 'underline-region "underline" "\
@@ -28424,8 +28890,8 @@ which specify the range to operate on.
;;;***
-;;;### (autoloads nil "unrmail" "mail/unrmail.el" (20895 15912 444844
-;;;;;; 0))
+;;;### (autoloads nil "unrmail" "mail/unrmail.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from mail/unrmail.el
(autoload 'batch-unrmail "unrmail" "\
@@ -28445,8 +28911,8 @@ The variable `unrmail-mbox-format' controls which mbox format to use.
;;;***
-;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (21670 32330
+;;;;;; 885624 725000))
;;; Generated autoloads from emacs-lisp/unsafep.el
(autoload 'unsafep "unsafep" "\
@@ -28458,7 +28924,7 @@ UNSAFEP-VARS is a list of symbols with local bindings.
;;;***
-;;;### (autoloads nil "url" "url/url.el" (20893 60586 188550 0))
+;;;### (autoloads nil "url" "url/url.el" (21670 32331 885635 586000))
;;; Generated autoloads from url/url.el
(autoload 'url-retrieve "url" "\
@@ -28501,12 +28967,12 @@ Return the buffer containing the data, or nil if there are no data
associated with it (the case for dired, info, or mailto URLs that need
no further processing). URL is either a string or a parsed URL.
-\(fn URL)" nil nil)
+\(fn URL &optional SILENT INHIBIT-COOKIES)" nil nil)
;;;***
-;;;### (autoloads nil "url-auth" "url/url-auth.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-auth" "url/url-auth.el" (21989 31537 943825
+;;;;;; 721000))
;;; Generated autoloads from url/url-auth.el
(autoload 'url-get-authentication "url-auth" "\
@@ -28517,12 +28983,12 @@ URL is the url you are requesting authorization to. This can be either a
string representing the URL, or the parsed representation returned by
`url-generic-parse-url'
REALM is the realm at a specific site we are looking for. This should be a
- string specifying the exact realm, or nil or the symbol 'any' to
+ string specifying the exact realm, or nil or the symbol `any' to
specify that the filename portion of the URL should be used as the
realm
TYPE is the type of authentication to be returned. This is either a string
- representing the type (basic, digest, etc), or nil or the symbol 'any'
- to specify that any authentication is acceptable. If requesting 'any'
+ representing the type (basic, digest, etc), or nil or the symbol `any'
+ to specify that any authentication is acceptable. If requesting `any'
the strongest matching authentication will be returned. If this is
wrong, it's no big deal, the error from the server will specify exactly
what type of auth to use
@@ -28547,8 +29013,8 @@ RATING a rating between 1 and 10 of the strength of the authentication.
;;;***
-;;;### (autoloads nil "url-cache" "url/url-cache.el" (20751 39094
-;;;;;; 700824 0))
+;;;### (autoloads nil "url-cache" "url/url-cache.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from url/url-cache.el
(autoload 'url-store-in-cache "url-cache" "\
@@ -28569,8 +29035,8 @@ Extract FNAM from the local disk cache.
;;;***
-;;;### (autoloads nil "url-cid" "url/url-cid.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-cid" "url/url-cid.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-cid.el
(autoload 'url-cid "url-cid" "\
@@ -28580,8 +29046,8 @@ Extract FNAM from the local disk cache.
;;;***
-;;;### (autoloads nil "url-dav" "url/url-dav.el" (20891 18859 893295
-;;;;;; 0))
+;;;### (autoloads nil "url-dav" "url/url-dav.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from url/url-dav.el
(autoload 'url-dav-supported-p "url-dav" "\
@@ -28615,8 +29081,8 @@ added to this list, so most requests can just pass in nil.
;;;***
-;;;### (autoloads nil "url-file" "url/url-file.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-file" "url/url-file.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-file.el
(autoload 'url-file "url-file" "\
@@ -28626,8 +29092,8 @@ Handle file: and ftp: URLs.
;;;***
-;;;### (autoloads nil "url-gw" "url/url-gw.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-gw" "url/url-gw.el" (22011 58554 85858
+;;;;;; 469000))
;;; Generated autoloads from url/url-gw.el
(autoload 'url-gateway-nslookup-host "url-gw" "\
@@ -28641,12 +29107,15 @@ Args per `open-network-stream'.
Will not make a connection if `url-gateway-unplugged' is non-nil.
Might do a non-blocking connection; use `process-status' to check.
-\(fn NAME BUFFER HOST SERVICE)" nil nil)
+Optional arg GATEWAY-METHOD specifies the gateway to be used,
+overriding the value of `url-gateway-method'.
+
+\(fn NAME BUFFER HOST SERVICE &optional GATEWAY-METHOD)" nil nil)
;;;***
-;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (20892
-;;;;;; 39729 858825 0))
+;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (22011
+;;;;;; 58554 85858 469000))
;;; Generated autoloads from url/url-handlers.el
(defvar url-handler-mode nil "\
@@ -28700,8 +29169,8 @@ accessible.
;;;***
-;;;### (autoloads nil "url-http" "url/url-http.el" (20766 59628 334727
-;;;;;; 618000))
+;;;### (autoloads nil "url-http" "url/url-http.el" (22018 31799 119263
+;;;;;; 120000))
;;; Generated autoloads from url/url-http.el
(autoload 'url-default-expander "url-expand")
@@ -28713,8 +29182,8 @@ accessible.
;;;***
-;;;### (autoloads nil "url-irc" "url/url-irc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-irc" "url/url-irc.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-irc.el
(autoload 'url-irc "url-irc" "\
@@ -28724,8 +29193,8 @@ accessible.
;;;***
-;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-ldap.el
(autoload 'url-ldap "url-ldap" "\
@@ -28738,8 +29207,8 @@ URL can be a URL string, or a URL vector of the type returned by
;;;***
-;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from url/url-mailto.el
(autoload 'url-mail "url-mailto" "\
@@ -28754,8 +29223,8 @@ Handle the mailto: URL syntax.
;;;***
-;;;### (autoloads nil "url-misc" "url/url-misc.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-misc" "url/url-misc.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-misc.el
(autoload 'url-man "url-misc" "\
@@ -28786,8 +29255,8 @@ Fetch a data URL (RFC 2397).
;;;***
-;;;### (autoloads nil "url-news" "url/url-news.el" (20884 7264 912957
-;;;;;; 506000))
+;;;### (autoloads nil "url-news" "url/url-news.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-news.el
(autoload 'url-news "url-news" "\
@@ -28802,8 +29271,8 @@ Fetch a data URL (RFC 2397).
;;;***
-;;;### (autoloads nil "url-ns" "url/url-ns.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-ns" "url/url-ns.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from url/url-ns.el
(autoload 'isPlainHostName "url-ns" "\
@@ -28843,8 +29312,8 @@ Fetch a data URL (RFC 2397).
;;;***
-;;;### (autoloads nil "url-parse" "url/url-parse.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "url-parse" "url/url-parse.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from url/url-parse.el
(autoload 'url-recreate-url "url-parse" "\
@@ -28868,7 +29337,7 @@ TARGET is the fragment identifier component (used to refer to a
ATTRIBUTES is nil; this slot originally stored the attribute and
value alists for IMAP URIs, but this feature was removed
since it conflicts with RFC 3986.
-FULLNESS is non-nil iff the hierarchical sequence component of
+FULLNESS is non-nil if the hierarchical sequence component of
the URL starts with two slashes, \"//\".
The parser follows RFC 3986, except that it also tries to handle
@@ -28895,8 +29364,8 @@ parses to
;;;***
-;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from url/url-privacy.el
(autoload 'url-setup-privacy-info "url-privacy" "\
@@ -28906,8 +29375,8 @@ Setup variables that expose info about you and your system.
;;;***
-;;;### (autoloads nil "url-queue" "url/url-queue.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "url-queue" "url/url-queue.el" (21670 32331
+;;;;;; 885635 586000))
;;; Generated autoloads from url/url-queue.el
(autoload 'url-queue-retrieve "url-queue" "\
@@ -28921,8 +29390,27 @@ The variable `url-queue-timeout' sets a timeout.
;;;***
-;;;### (autoloads nil "url-util" "url/url-util.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (21670 32331
+;;;;;; 885635 586000))
+;;; Generated autoloads from url/url-tramp.el
+
+(defvar url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") "\
+List of URL protocols the work is handled by Tramp.
+They must also be covered by `url-handler-regexp'.")
+
+(custom-autoload 'url-tramp-protocols "url-tramp" t)
+
+(autoload 'url-tramp-file-handler "url-tramp" "\
+Function called from the `file-name-handler-alist' routines.
+OPERATION is what needs to be done. ARGS are the arguments that
+would have been passed to OPERATION.
+
+\(fn OPERATION &rest ARGS)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "url-util" "url/url-util.el" (21993 28596 418597
+;;;;;; 473000))
;;; Generated autoloads from url/url-util.el
(defvar url-debug nil "\
@@ -28984,11 +29472,6 @@ Remove spaces at the front of a string.
\(fn X)" nil nil)
-(autoload 'url-pretty-length "url-util" "\
-
-
-\(fn N)" nil nil)
-
(autoload 'url-display-percentage "url-util" "\
@@ -29020,7 +29503,7 @@ Return the nondirectory part of FILE, for a URL.
Build a query-string.
Given a QUERY in the form:
-'((key1 val1)
+ ((key1 val1)
(key2 val2)
(key3 val1 val2)
(key4)
@@ -29095,8 +29578,8 @@ This uses `url-current-object', set locally to the buffer.
;;;***
-;;;### (autoloads nil "userlock" "userlock.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "userlock" "userlock.el" (21976 19510 152430
+;;;;;; 241000))
;;; Generated autoloads from userlock.el
(autoload 'ask-user-about-lock "userlock" "\
@@ -29124,8 +29607,8 @@ The buffer in question is current when this function is called.
;;;***
-;;;### (autoloads nil "utf-7" "international/utf-7.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "utf-7" "international/utf-7.el" (21670 32331
+;;;;;; 385639 720000))
;;; Generated autoloads from international/utf-7.el
(autoload 'utf-7-post-read-conversion "utf-7" "\
@@ -29150,7 +29633,7 @@ The buffer in question is current when this function is called.
;;;***
-;;;### (autoloads nil "utf7" "gnus/utf7.el" (20791 9657 561026 0))
+;;;### (autoloads nil "utf7" "gnus/utf7.el" (21670 32331 385639 720000))
;;; Generated autoloads from gnus/utf7.el
(autoload 'utf7-encode "utf7" "\
@@ -29160,8 +29643,8 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil.
;;;***
-;;;### (autoloads nil "uudecode" "mail/uudecode.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "uudecode" "mail/uudecode.el" (21855 577 67944
+;;;;;; 554000))
;;; Generated autoloads from mail/uudecode.el
(autoload 'uudecode-decode-region-external "uudecode" "\
@@ -29185,7 +29668,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME.
;;;***
-;;;### (autoloads nil "vc" "vc/vc.el" (20919 46844 767888 0))
+;;;### (autoloads nil "vc" "vc/vc.el" (22014 34736 871840 613000))
;;; Generated autoloads from vc/vc.el
(defvar vc-checkout-hook nil "\
@@ -29206,6 +29689,16 @@ See `run-hooks'.")
(custom-autoload 'vc-before-checkin-hook "vc" t)
+(autoload 'vc-responsible-backend "vc" "\
+Return the name of a backend system that is responsible for FILE.
+
+If FILE is already registered, return the
+backend of FILE. If FILE is not registered, then the
+first backend in `vc-handled-backends' that declares itself
+responsible for FILE is returned.
+
+\(fn FILE)" nil nil)
+
(autoload 'vc-next-action "vc" "\
Do the next logical version control operation on the current fileset.
This requires that all files in the current VC fileset be in the
@@ -29224,8 +29717,7 @@ For old-style locking-based version control systems, like RCS:
If every file is registered and unlocked, check out (lock)
the file(s) for editing.
If every file is locked by you and has changes, pop up a
- *vc-log* buffer to check in the changes. If the variable
- `vc-keep-workfiles' is non-nil (the default), leave a
+ *vc-log* buffer to check in the changes. Leave a
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
If every file is locked by someone else, offer to steal the lock.
@@ -29236,8 +29728,7 @@ For old-style locking-based version control systems, like RCS:
Register into a version control system.
If VC-FILESET is given, register the files in that fileset.
Otherwise register the current file.
-With prefix argument SET-REVISION, allow user to specify initial revision
-level. If COMMENT is present, use that as an initial comment.
+If COMMENT is present, use that as an initial comment.
The version control system to use is found by cycling through the list
`vc-handled-backends'. The first backend in that list which declares
@@ -29246,7 +29737,7 @@ directory are already registered under that backend) will be used to
register the file. If no backend declares itself responsible, the
first backend that could register the file is used.
-\(fn &optional SET-REVISION VC-FILESET COMMENT)" t nil)
+\(fn &optional VC-FILESET COMMENT)" t nil)
(autoload 'vc-version-diff "vc" "\
Report diffs between revisions of the fileset in the repository history.
@@ -29293,6 +29784,12 @@ saving the buffer.
\(fn HISTORIC &optional NOT-URGENT)" t nil)
+(autoload 'vc-root-dir "vc" "\
+Return the root directory for the current VC tree.
+Return nil if the root directory cannot be identified.
+
+\(fn)" nil nil)
+
(autoload 'vc-revision-other-window "vc" "\
Visit revision REV of the current file in another window.
If the current file is named `F', the revision is named `F.~REV~'.
@@ -29335,8 +29832,12 @@ checked out in that new branch.
\(fn DIR NAME BRANCHP)" t nil)
(autoload 'vc-retrieve-tag "vc" "\
-Descending recursively from DIR, retrieve the tag called NAME.
-If NAME is empty, it refers to the latest revisions.
+For each file in or below DIR, retrieve their tagged version NAME.
+NAME can name a branch, in which case this command will switch to the
+named branch in the directory DIR.
+Interactively, prompt for DIR only for VCS that works at file level;
+otherwise use the default directory of the current buffer.
+If NAME is empty, it refers to the latest revisions of the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped).
@@ -29364,7 +29865,7 @@ When called interactively with a prefix argument, prompt for LIMIT.
(autoload 'vc-log-incoming "vc" "\
Show a log of changes that will be received with a pull operation from REMOTE-LOCATION.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION..
+When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
\(fn &optional REMOTE-LOCATION)" t nil)
@@ -29374,6 +29875,11 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
\(fn &optional REMOTE-LOCATION)" t nil)
+(autoload 'vc-region-history "vc" "\
+Show the history of the region FROM..TO.
+
+\(fn FROM TO)" t nil)
+
(autoload 'vc-revert "vc" "\
Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
@@ -29381,13 +29887,6 @@ to the working revision (except for keyword expansion).
\(fn)" t nil)
-(autoload 'vc-rollback "vc" "\
-Roll back (remove) the most recent changeset committed to the repository.
-This may be either a file-level or a repository-level operation,
-depending on the underlying version-control system.
-
-\(fn)" t nil)
-
(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
(autoload 'vc-pull "vc" "\
@@ -29407,6 +29906,16 @@ tip revision are merged into the working file.
(defalias 'vc-update 'vc-pull)
+(autoload 'vc-push "vc" "\
+Push the current branch.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
+On a distributed version control system, this runs a \"push\"
+operation on the current branch, prompting for the precise command
+if required. Optional prefix ARG non-nil forces a prompt.
+On a non-distributed version control system, this signals an error.
+
+\(fn &optional ARG)" t nil)
+
(autoload 'vc-switch-backend "vc" "\
Make BACKEND the current version control system for FILE.
FILE must already be registered in BACKEND. The change is not
@@ -29466,8 +29975,8 @@ Return the branch part of a revision number REV.
;;;***
-;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (20709 26818
-;;;;;; 907104 0))
+;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (22011 58554
+;;;;;; 93858 469000))
;;; Generated autoloads from vc/vc-annotate.el
(autoload 'vc-annotate "vc-annotate" "\
@@ -29499,24 +30008,15 @@ Customization variables:
mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-very-old-color' define the mapping of time to colors.
`vc-annotate-background' specifies the background color.
+`vc-annotate-background-mode' specifies whether the color map
+should be applied to the background or to the foreground.
\(fn FILE REV &optional DISPLAY-MODE BUF MOVE-POINT-TO VC-BK)" t nil)
;;;***
-;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20900 33838 319219
-;;;;;; 0))
-;;; Generated autoloads from vc/vc-arch.el
- (defun vc-arch-registered (file)
- (if (vc-find-root file "{arch}/=tagging-method")
- (progn
- (load "vc-arch" nil t)
- (vc-arch-registered file))))
-
-;;;***
-
-;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (22014 34736 819840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-bzr.el
(defconst vc-bzr-admin-dirname ".bzr" "\
@@ -29532,8 +30032,8 @@ Name of the format file in a .bzr directory.")
;;;***
-;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20921 39978 248467
-;;;;;; 0))
+;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (22014 34736 823840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-cvs.el
(defun vc-cvs-registered (f)
"Return non-nil if file F is registered with CVS."
@@ -29544,8 +30044,8 @@ Name of the format file in a .bzr directory.")
;;;***
-;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (21842 40083 319216
+;;;;;; 272000))
;;; Generated autoloads from vc/vc-dir.el
(autoload 'vc-dir "vc-dir" "\
@@ -29569,8 +30069,8 @@ These are the commands available for use in the file status buffer:
;;;***
-;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (20924
-;;;;;; 16196 967284 0))
+;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (21862
+;;;;;; 60209 928657 362000))
;;; Generated autoloads from vc/vc-dispatcher.el
(autoload 'vc-do-command "vc-dispatcher" "\
@@ -29593,8 +30093,8 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-git" "vc/vc-git.el" (22014 34736 835840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-git.el
(defun vc-git-registered (file)
"Return non-nil if FILE is registered with git."
@@ -29605,7 +30105,7 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20900 33838 319219 0))
+;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (22014 34736 835840 613000))
;;; Generated autoloads from vc/vc-hg.el
(defun vc-hg-registered (file)
"Return non-nil if FILE is registered with hg."
@@ -29616,8 +30116,8 @@ case, and the process object in the asynchronous case.
;;;***
-;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (22014 34736 839840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-mtn.el
(defconst vc-mtn-admin-dir "_MTN" "\
@@ -29633,8 +30133,8 @@ Name of the monotone directory's format file.")
;;;***
-;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (22014 34736 851840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-rcs.el
(defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\
@@ -29647,8 +30147,8 @@ For a description of possible values, see `vc-check-master-templates'.")
;;;***
-;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (22014 34736 863840
+;;;;;; 613000))
;;; Generated autoloads from vc/vc-sccs.el
(defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\
@@ -29659,15 +30159,29 @@ For a description of possible values, see `vc-check-master-templates'.")
(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))
-(defun vc-sccs-search-project-dir (dirname basename) "\
+(defun vc-sccs-search-project-dir (_dirname basename) "\
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 (quote ("SCCS" ""))) (setq dirs (quote ("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)))))
;;;***
-;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20900 33838 319219
-;;;;;; 0))
+;;;### (autoloads nil "vc-src" "vc/vc-src.el" (22014 34736 863840
+;;;;;; 613000))
+;;; Generated autoloads from vc/vc-src.el
+
+(defvar vc-src-master-templates (purecopy '("%s.src/%s,v")) "\
+Where to look for SRC master files.
+For a description of possible values, see `vc-check-master-templates'.")
+
+(custom-autoload 'vc-src-master-templates "vc-src" t)
+
+(defun vc-src-registered (f) (vc-default-registered 'src f))
+
+;;;***
+
+;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (22011 58554 97858
+;;;;;; 469000))
;;; Generated autoloads from vc/vc-svn.el
(defun vc-svn-registered (f)
(let ((admin-dir (cond ((and (eq system-type 'windows-nt)
@@ -29680,10 +30194,11 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir)
;;;***
-;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (20893
-;;;;;; 60586 188550 0))
+;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (22011
+;;;;;; 58553 929858 469000))
;;; Generated autoloads from progmodes/vera-mode.el
-(push (purecopy (quote (vera-mode 2 28))) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
+(push (purecopy '(vera-mode 2 28)) package--builtin-versions)
+ (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode))
(autoload 'vera-mode "vera-mode" "\
Major mode for editing Vera code.
@@ -29739,7 +30254,7 @@ Key bindings:
;;;***
;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el"
-;;;;;; (20885 2819 449152 0))
+;;;;;; (22015 55603 833705 321000))
;;; Generated autoloads from progmodes/verilog-mode.el
(autoload 'verilog-mode "verilog-mode" "\
@@ -29774,7 +30289,7 @@ Variables controlling indentation/edit style:
Set to 0 to get such code to lined up underneath the task or
function keyword.
`verilog-indent-level-directive' (default 1)
- Indentation of `ifdef/`endif blocks.
+ Indentation of \\=`ifdef/\\=`endif blocks.
`verilog-cexp-indent' (default 1)
Indentation of Verilog statements broken across lines i.e.:
if (a)
@@ -29847,7 +30362,8 @@ Some other functions are:
\\[verilog-sk-fork] Insert a fork begin .. end .. join block.
\\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block.
\\[verilog-sk-ovm-class] Insert an OVM Class block.
- \\[verilog-sk-uvm-class] Insert an UVM Class block.
+ \\[verilog-sk-uvm-object] Insert an UVM Object block.
+ \\[verilog-sk-uvm-component] Insert an UVM Component block.
\\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block.
\\[verilog-sk-repeat] Insert a repeat (..) begin .. end block.
\\[verilog-sk-specify] Insert a specify .. endspecify block.
@@ -29877,8 +30393,8 @@ Key bindings specific to `verilog-mode-map' are:
;;;***
-;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (20892
-;;;;;; 39729 858825 0))
+;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (22011
+;;;;;; 58553 969858 469000))
;;; Generated autoloads from progmodes/vhdl-mode.el
(autoload 'vhdl-mode "vhdl-mode" "\
@@ -29928,7 +30444,7 @@ Usage:
;;; --> \" := \" [[ --> [ --CR --> comment-out code
.. --> \" => \" ] --> ) --- --> horizontal line
,, --> \" <= \" ]] --> ] ---- --> display comment
- == --> \" == \" '' --> \\\"
+ == --> \" == \" \\='\\=' --> \\\"
WORD COMPLETION:
@@ -29940,7 +30456,7 @@ Usage:
Typing `TAB' after `(' looks for and inserts complete parenthesized
expressions (e.g. for array index ranges). All keywords as well as
standard types and subprograms of VHDL have predefined abbreviations
- (e.g. type \"std\" and `TAB' will toggle through all standard types
+ (e.g., type \"std\" and `TAB' will toggle through all standard types
beginning with \"std\").
Typing `TAB' after a non-word character indents the line if at the
@@ -29989,11 +30505,11 @@ Usage:
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
+ tabs. `\\[tabify]' and `\\[untabify]' allow to convert spaces to tabs
and vice versa.
Syntax-based indentation can be very slow in large files. Option
- `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ `vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
Option `vhdl-indent-comment-like-next-code-line' controls whether
comment lines are indented like the preceding or like the following code
@@ -30026,7 +30542,7 @@ Usage:
CODE FILLING:
- Code filling allows to condense code (e.g. sensitivity lists or port
+ Code filling allows you to condense code (e.g. sensitivity lists or port
maps) by removing comments and newlines and re-wrapping so that all
lines are maximally filled (block filling). `C-c C-f C-f' fills a list
enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
@@ -30255,7 +30771,7 @@ Usage:
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
KEYWORD CASE:
@@ -30286,7 +30802,7 @@ Usage:
Words with special syntax can be highlighted by specifying their
syntax and color in option `vhdl-special-syntax-alist' and by setting
- option `vhdl-highlight-special-words' to non-nil. This allows to
+ option `vhdl-highlight-special-words' to non-nil. This allows you to
establish some naming conventions (e.g. to distinguish different kinds
of signals or other objects by using name suffices) and to support them
visually.
@@ -30300,7 +30816,7 @@ Usage:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`M-x customize-group'). For
+ customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
@@ -30338,7 +30854,7 @@ Usage:
CODE FIXING:
`C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
- (e.g. if the closing parenthesis is on the wrong line or is missing).
+ (e.g., if the closing parenthesis is on the wrong line or is missing).
PRINTING:
@@ -30360,14 +30876,14 @@ Usage:
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
- customize-group' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command `\\[customize-option]'
+ (`\\[customize-group]' for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`M-x vhdl-customize' or menu)!
+ what other useful user options there are (`\\[vhdl-customize]' or menu)!
FILE EXTENSIONS:
@@ -30375,7 +30891,7 @@ Usage:
automatically recognized as VHDL source files. To add an extension
\".xxx\", add the following line to your Emacs start-up file (`.emacs'):
- (push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
+ (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist)
HINTS:
@@ -30396,7 +30912,7 @@ Usage:
Maintenance:
------------
-To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
+To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
@@ -30432,61 +30948,8 @@ Key bindings:
;;;***
-;;;### (autoloads nil "vi" "emulation/vi.el" (20929 34089 117790
-;;;;;; 0))
-;;; Generated autoloads from emulation/vi.el
-
-(autoload 'vi-mode "vi" "\
-Major mode that acts like the `vi' editor.
-The purpose of this mode is to provide you the combined power of vi (namely,
-the \"cross product\" effect of commands and repeat last changes) and Emacs.
-
-This command redefines nearly all keys to look like vi commands.
-It records the previous major mode, and any vi command for input
-\(`i', `a', `s', etc.) switches back to that mode.
-Thus, ordinary Emacs (in whatever major mode you had been using)
-is \"input\" mode as far as vi is concerned.
-
-To get back into vi from \"input\" mode, you must issue this command again.
-Therefore, it is recommended that you assign it to a key.
-
-Major differences between this mode and real vi :
-
-* Limitations and unsupported features
- - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are
- not supported.
- - Ex commands are not implemented; try ':' to get some hints.
- - No line undo (i.e. the 'U' command), but multi-undo is a standard feature.
-
-* Modifications
- - The stopping positions for some point motion commands (word boundary,
- pattern search) are slightly different from standard 'vi'.
- Also, no automatic wrap around at end of buffer for pattern searching.
- - Since changes are done in two steps (deletion then insertion), you need
- to undo twice to completely undo a change command. But this is not needed
- for undoing a repeated change command.
- - No need to set/unset 'magic', to search for a string with regular expr
- in it just put a prefix arg for the search commands. Replace cmds too.
- - ^R is bound to incremental backward search, so use ^L to redraw screen.
-
-* Extensions
- - Some standard (or modified) Emacs commands were integrated, such as
- incremental search, query replace, transpose objects, and keyboard macros.
- - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to
- esc-map or set undefined. These can give you the full power of Emacs.
- - See vi-com-map for those keys that are extensions to standard vi, e.g.
- `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
- `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy.
- - Use \\[vi-switch-mode] to switch among different modes quickly.
-
-Syntax table and abbrevs while in vi mode remain as they were in Emacs.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "viet-util" "language/viet-util.el" (20826
-;;;;;; 45095 436233 0))
+;;;### (autoloads nil "viet-util" "language/viet-util.el" (21670
+;;;;;; 32331 385639 720000))
;;; Generated autoloads from language/viet-util.el
(autoload 'viet-encode-viscii-char "viet-util" "\
@@ -30530,7 +30993,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics.
;;;***
-;;;### (autoloads nil "view" "view.el" (20762 9398 526093 0))
+;;;### (autoloads nil "view" "view.el" (21670 32331 885635 586000))
;;; Generated autoloads from view.el
(defvar view-remove-frame-by-deleting t "\
@@ -30786,26 +31249,11 @@ Exit View mode and make the current buffer editable.
;;;***
-;;;### (autoloads nil "vip" "emulation/vip.el" (20929 34089 117790
-;;;;;; 0))
-;;; Generated autoloads from emulation/vip.el
-
-(autoload 'vip-setup "vip" "\
-Set up bindings for C-x 7 and C-z that are useful for VIP users.
-
-\(fn)" nil nil)
-
-(autoload 'vip-mode "vip" "\
-Turn on VIP emulation of VI.
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "viper" "emulation/viper.el" (20799 169 640767
-;;;;;; 0))
+;;;### (autoloads nil "viper" "emulation/viper.el" (22011 58553 461858
+;;;;;; 469000))
;;; Generated autoloads from emulation/viper.el
-(push (purecopy (quote (viper 3 14 1))) package--builtin-versions)
+(push (purecopy '(viper 3 14 1)) package--builtin-versions)
+
(autoload 'toggle-viper-mode "viper" "\
Toggle Viper on/off.
If Viper is enabled, turn it off. Otherwise, turn it on.
@@ -30819,8 +31267,8 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'.
;;;***
-;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (20709
-;;;;;; 26818 907104 0))
+;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (21986
+;;;;;; 55346 260512 613000))
;;; Generated autoloads from emacs-lisp/warnings.el
(defvar warning-prefix-function nil "\
@@ -30879,8 +31327,9 @@ See also `warning-series', `warning-prefix-function' and
\(fn TYPE MESSAGE &optional LEVEL BUFFER-NAME)" nil nil)
(autoload 'lwarn "warnings" "\
-Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
+Display a warning message made from (format-message MESSAGE ARGS...).
+\\<special-mode-map>
+Aside from generating the message with `format-message',
this is equivalent to `display-warning'.
TYPE is the warning type: either a custom group name (a symbol),
@@ -30900,8 +31349,8 @@ LEVEL should be either :debug, :warning, :error, or :emergency
\(fn TYPE LEVEL MESSAGE &rest ARGS)" nil nil)
(autoload 'warn "warnings" "\
-Display a warning message made from (format MESSAGE ARGS...).
-Aside from generating the message with `format',
+Display a warning message made from (format-message MESSAGE ARGS...).
+Aside from generating the message with `format-message',
this is equivalent to `display-warning', using
`emacs' as the type and `:warning' as the level.
@@ -30909,9 +31358,10 @@ this is equivalent to `display-warning', using
;;;***
-;;;### (autoloads nil "wdired" "wdired.el" (20900 33838 319219 0))
+;;;### (autoloads nil "wdired" "wdired.el" (22026 25907 675502 692000))
;;; Generated autoloads from wdired.el
-(push (purecopy (quote (wdired 2 0))) package--builtin-versions)
+(push (purecopy '(wdired 2 0)) package--builtin-versions)
+
(autoload 'wdired-change-to-wdired-mode "wdired" "\
Put a Dired buffer in Writable Dired (WDired) mode.
\\<wdired-mode-map>
@@ -30926,8 +31376,8 @@ See `wdired-mode'.
;;;***
-;;;### (autoloads nil "webjump" "net/webjump.el" (20927 49244 970422
-;;;;;; 0))
+;;;### (autoloads nil "webjump" "net/webjump.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from net/webjump.el
(autoload 'webjump "webjump" "\
@@ -30943,8 +31393,8 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke
;;;***
-;;;### (autoloads nil "which-func" "progmodes/which-func.el" (20895
-;;;;;; 15912 444844 0))
+;;;### (autoloads nil "which-func" "progmodes/which-func.el" (21986
+;;;;;; 55346 292512 613000))
;;; Generated autoloads from progmodes/which-func.el
(put 'which-func-format 'risky-local-variable t)
(put 'which-func-current 'risky-local-variable t)
@@ -30974,10 +31424,11 @@ in certain major modes.
;;;***
-;;;### (autoloads nil "whitespace" "whitespace.el" (20874 65007 172950
-;;;;;; 7000))
+;;;### (autoloads nil "whitespace" "whitespace.el" (22026 25907 675502
+;;;;;; 692000))
;;; Generated autoloads from whitespace.el
-(push (purecopy (quote (whitespace 13 2 2))) package--builtin-versions)
+(push (purecopy '(whitespace 13 2 2)) package--builtin-versions)
+
(autoload 'whitespace-mode "whitespace" "\
Toggle whitespace visualization (Whitespace mode).
With a prefix argument ARG, enable Whitespace mode if ARG is
@@ -31072,6 +31523,7 @@ Interactively, it reads one of the following chars:
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
I toggle indentation SPACEs visualization
i toggle indentation TABs visualization
+ C-t toggle big indentation visualization
C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode')
A toggle SPACEs after TAB: SPACEs visualization
a toggle SPACEs after TAB: TABs visualization
@@ -31101,6 +31553,7 @@ The valid symbols are:
indentation toggle indentation SPACEs visualization
indentation::tab toggle indentation SPACEs visualization
indentation::space toggle indentation TABs visualization
+ big-indent toggle big indentation visualization
space-after-tab toggle SPACEs after TAB visualization
space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization
space-after-tab::space toggle SPACEs after TAB: TABs visualization
@@ -31142,6 +31595,7 @@ Interactively, it accepts one of the following chars:
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
I toggle indentation SPACEs visualization
i toggle indentation TABs visualization
+ C-t toggle big indentation visualization
C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode')
A toggle SPACEs after TAB: SPACEs visualization
a toggle SPACEs after TAB: TABs visualization
@@ -31171,6 +31625,7 @@ The valid symbols are:
indentation toggle indentation SPACEs visualization
indentation::tab toggle indentation SPACEs visualization
indentation::space toggle indentation TABs visualization
+ big-indent toggle big indentation visualization
space-after-tab toggle SPACEs after TAB visualization
space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization
space-after-tab::space toggle SPACEs after TAB: TABs visualization
@@ -31288,43 +31743,7 @@ documentation.
(autoload 'whitespace-report "whitespace" "\
Report some whitespace problems in buffer.
-Return nil if there is no whitespace problem; otherwise, return
-non-nil.
-
-If FORCE is non-nil or \\[universal-argument] was pressed just
-before calling `whitespace-report' interactively, it forces
-`whitespace-style' to have:
-
- empty
- trailing
- indentation
- space-before-tab
- space-after-tab
-
-If REPORT-IF-BOGUS is non-nil, it reports only when there are any
-whitespace problems in buffer.
-
-Report if some of the following whitespace problems exist:
-
-* If `indent-tabs-mode' is non-nil:
- empty 1. empty lines at beginning of buffer.
- empty 2. empty lines at end of buffer.
- trailing 3. SPACEs or TABs at end of line.
- indentation 4. 8 or more SPACEs at beginning of line.
- space-before-tab 5. SPACEs before TAB.
- space-after-tab 6. 8 or more SPACEs after TAB.
-
-* If `indent-tabs-mode' is nil:
- empty 1. empty lines at beginning of buffer.
- empty 2. empty lines at end of buffer.
- trailing 3. SPACEs or TABs at end of line.
- indentation 4. TABS at beginning of line.
- space-before-tab 5. SPACEs before TAB.
- space-after-tab 6. 8 or more SPACEs after TAB.
-
-See `whitespace-style' for documentation.
-See also `whitespace-cleanup' and `whitespace-cleanup-region' for
-cleaning up these problems.
+Perform `whitespace-report-region' on the current buffer.
\(fn &optional FORCE REPORT-IF-BOGUS)" t nil)
@@ -31339,13 +31758,14 @@ before calling `whitespace-report-region' interactively, it
forces `whitespace-style' to have:
empty
+ trailing
indentation
space-before-tab
- trailing
space-after-tab
-If REPORT-IF-BOGUS is non-nil, it reports only when there are any
-whitespace problems in buffer.
+If REPORT-IF-BOGUS is t, it reports only when there are any
+whitespace problems in buffer; if it is `never', it does not
+report problems.
Report if some of the following whitespace problems exist:
@@ -31373,8 +31793,8 @@ cleaning up these problems.
;;;***
-;;;### (autoloads nil "wid-browse" "wid-browse.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "wid-browse" "wid-browse.el" (21670 32331 885635
+;;;;;; 586000))
;;; Generated autoloads from wid-browse.el
(autoload 'widget-browse-at "wid-browse" "\
@@ -31402,8 +31822,8 @@ if ARG is omitted or nil.
;;;***
-;;;### (autoloads nil "wid-edit" "wid-edit.el" (20945 22315 8369
-;;;;;; 0))
+;;;### (autoloads nil "wid-edit" "wid-edit.el" (22003 64432 668146
+;;;;;; 533000))
;;; Generated autoloads from wid-edit.el
(autoload 'widgetp "wid-edit" "\
@@ -31445,8 +31865,8 @@ Setup current buffer so editing string widgets works.
;;;***
-;;;### (autoloads nil "windmove" "windmove.el" (20709 26818 907104
-;;;;;; 0))
+;;;### (autoloads nil "windmove" "windmove.el" (21852 24382 97237
+;;;;;; 703000))
;;; Generated autoloads from windmove.el
(autoload 'windmove-left "windmove" "\
@@ -31498,7 +31918,7 @@ Default MODIFIER is 'shift.
;;;***
-;;;### (autoloads nil "winner" "winner.el" (20849 6570 598687 0))
+;;;### (autoloads nil "winner" "winner.el" (22009 58952 311546 645000))
;;; Generated autoloads from winner.el
(defvar winner-mode nil "\
@@ -31521,9 +31941,10 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
;;;***
-;;;### (autoloads nil "woman" "woman.el" (20709 26818 907104 0))
+;;;### (autoloads nil "woman" "woman.el" (22026 25907 679502 692000))
;;; Generated autoloads from woman.el
-(push (purecopy (quote (woman 0 551))) package--builtin-versions)
+(push (purecopy '(woman 0 551)) package--builtin-versions)
+
(defvar woman-locale nil "\
String specifying a manual page locale, or nil.
If a manual page is available in the specified locale
@@ -31569,120 +31990,7 @@ Default bookmark handler for Woman buffers.
;;;***
-;;;### (autoloads nil "ws-mode" "emulation/ws-mode.el" (20709 26818
-;;;;;; 907104 0))
-;;; Generated autoloads from emulation/ws-mode.el
-(push (purecopy (quote (ws-mode 0 7))) package--builtin-versions)
-(autoload 'wordstar-mode "ws-mode" "\
-Major mode with WordStar-like key bindings.
-
-BUGS:
- - Help menus with WordStar commands (C-j just calls help-for-help)
- are not implemented
- - Options for search and replace
- - Show markers (C-k h) is somewhat strange
- - Search and replace (C-q a) is only available in forward direction
-
-No key bindings beginning with ESC are installed, they will work
-Emacs-like.
-
-The key bindings are:
-
- C-a backward-word
- C-b fill-paragraph
- C-c scroll-up-line
- C-d forward-char
- C-e previous-line
- C-f forward-word
- C-g delete-char
- C-h backward-char
- C-i indent-for-tab-command
- C-j help-for-help
- C-k ordstar-C-k-map
- C-l ws-repeat-search
- C-n open-line
- C-p quoted-insert
- C-r scroll-down-line
- C-s backward-char
- C-t kill-word
- C-u keyboard-quit
- C-v overwrite-mode
- C-w scroll-down
- C-x next-line
- C-y kill-complete-line
- C-z scroll-up
-
- C-k 0 ws-set-marker-0
- C-k 1 ws-set-marker-1
- C-k 2 ws-set-marker-2
- C-k 3 ws-set-marker-3
- C-k 4 ws-set-marker-4
- C-k 5 ws-set-marker-5
- C-k 6 ws-set-marker-6
- C-k 7 ws-set-marker-7
- C-k 8 ws-set-marker-8
- C-k 9 ws-set-marker-9
- C-k b ws-begin-block
- C-k c ws-copy-block
- C-k d save-buffers-kill-emacs
- C-k f find-file
- C-k h ws-show-markers
- C-k i ws-indent-block
- C-k k ws-end-block
- C-k p ws-print-block
- C-k q kill-emacs
- C-k r insert-file
- C-k s save-some-buffers
- C-k t ws-mark-word
- C-k u ws-exdent-block
- C-k C-u keyboard-quit
- C-k v ws-move-block
- C-k w ws-write-block
- C-k x kill-emacs
- C-k y ws-delete-block
-
- C-o c wordstar-center-line
- C-o b switch-to-buffer
- C-o j justify-current-line
- C-o k kill-buffer
- C-o l list-buffers
- C-o m auto-fill-mode
- C-o r set-fill-column
- C-o C-u keyboard-quit
- C-o wd delete-other-windows
- C-o wh split-window-right
- C-o wo other-window
- C-o wv split-window-below
-
- C-q 0 ws-find-marker-0
- C-q 1 ws-find-marker-1
- C-q 2 ws-find-marker-2
- C-q 3 ws-find-marker-3
- C-q 4 ws-find-marker-4
- C-q 5 ws-find-marker-5
- C-q 6 ws-find-marker-6
- C-q 7 ws-find-marker-7
- C-q 8 ws-find-marker-8
- C-q 9 ws-find-marker-9
- C-q a ws-query-replace
- C-q b ws-to-block-begin
- C-q c end-of-buffer
- C-q d end-of-line
- C-q f ws-search
- C-q k ws-to-block-end
- C-q l ws-undo
- C-q p ws-last-cursorp
- C-q r beginning-of-buffer
- C-q C-u keyboard-quit
- C-q w ws-last-error
- C-q y ws-kill-eol
- C-q DEL ws-kill-bol
-
-\(fn)" t nil)
-
-;;;***
-
-;;;### (autoloads nil "xml" "xml.el" (20766 6456 368550 0))
+;;;### (autoloads nil "xml" "xml.el" (21974 64192 720009 993000))
;;; Generated autoloads from xml.el
(autoload 'xml-parse-file "xml" "\
@@ -31699,8 +32007,8 @@ URIs, and expanded names will be returned as a cons
If PARSE-NS is an alist, it will be used as the mapping from
namespace to URIs instead.
-If it is the symbol 'symbol-qnames, expanded names will be
-returned as a plain symbol 'namespace:foo instead of a cons.
+If it is the symbol `symbol-qnames', expanded names will be
+returned as a plain symbol `namespace:foo' instead of a cons.
Both features can be combined by providing a cons cell
@@ -31727,8 +32035,8 @@ URIs, and expanded names will be returned as a cons
If PARSE-NS is an alist, it will be used as the mapping from
namespace to URIs instead.
-If it is the symbol 'symbol-qnames, expanded names will be
-returned as a plain symbol 'namespace:foo instead of a cons.
+If it is the symbol `symbol-qnames', expanded names will be
+returned as a plain symbol `namespace:foo' instead of a cons.
Both features can be combined by providing a cons cell
@@ -31738,8 +32046,8 @@ Both features can be combined by providing a cons cell
;;;***
-;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (20884 6711 386198
-;;;;;; 0))
+;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (21670 32331 385639
+;;;;;; 720000))
;;; Generated autoloads from nxml/xmltok.el
(autoload 'xmltok-get-declared-encoding-position "xmltok" "\
@@ -31757,8 +32065,73 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT.
;;;***
-;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (20797 44848 327754
-;;;;;; 0))
+;;;### (autoloads nil "xref" "progmodes/xref.el" (21993 28596 366597
+;;;;;; 473000))
+;;; Generated autoloads from progmodes/xref.el
+
+(autoload 'xref-pop-marker-stack "xref" "\
+Pop back to where \\[xref-find-definitions] was last invoked.
+
+\(fn)" t nil)
+
+(autoload 'xref-marker-stack-empty-p "xref" "\
+Return t if the marker stack is empty; nil otherwise.
+
+\(fn)" nil nil)
+
+(autoload 'xref-find-definitions "xref" "\
+Find the definition of the identifier at point.
+With prefix argument or when there's no identifier at point,
+prompt for it.
+
+If the backend has sufficient information to determine a unique
+definition for IDENTIFIER, it returns only that definition. If
+there are multiple possible definitions, it returns all of them.
+
+If the backend returns one definition, jump to it; otherwise,
+display the list in a buffer.
+
+\(fn IDENTIFIER)" t nil)
+
+(autoload 'xref-find-definitions-other-window "xref" "\
+Like `xref-find-definitions' but switch to the other window.
+
+\(fn IDENTIFIER)" t nil)
+
+(autoload 'xref-find-definitions-other-frame "xref" "\
+Like `xref-find-definitions' but switch to the other frame.
+
+\(fn IDENTIFIER)" t nil)
+
+(autoload 'xref-find-references "xref" "\
+Find references to the identifier at point.
+With prefix argument, prompt for the identifier.
+
+\(fn IDENTIFIER)" t nil)
+
+(autoload 'xref-find-regexp "xref" "\
+Find all matches for REGEXP.
+With \\[universal-argument] prefix, you can specify the directory
+to search in, and the file name pattern to search for.
+
+\(fn REGEXP)" t nil)
+
+(autoload 'xref-find-apropos "xref" "\
+Find all meaningful symbols that match PATTERN.
+The argument has the same meaning as in `apropos'.
+
+\(fn PATTERN)" t nil)
+ (define-key esc-map "." #'xref-find-definitions)
+ (define-key esc-map "," #'xref-pop-marker-stack)
+ (define-key esc-map "?" #'xref-find-references)
+ (define-key esc-map [?\C-.] #'xref-find-apropos)
+ (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
+ (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
+
+;;;***
+
+;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21852 24382 117243
+;;;;;; 951000))
;;; Generated autoloads from xt-mouse.el
(defvar xterm-mouse-mode nil "\
@@ -31787,7 +32160,7 @@ down the SHIFT key while pressing the mouse button.
;;;***
-;;;### (autoloads nil "yenc" "gnus/yenc.el" (20709 26818 907104 0))
+;;;### (autoloads nil "yenc" "gnus/yenc.el" (21670 32331 385639 720000))
;;; Generated autoloads from gnus/yenc.el
(autoload 'yenc-decode-region "yenc" "\
@@ -31802,7 +32175,7 @@ Extract file name from an yenc header.
;;;***
-;;;### (autoloads nil "zone" "play/zone.el" (20709 26818 907104 0))
+;;;### (autoloads nil "zone" "play/zone.el" (21670 32331 385639 720000))
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
@@ -31834,7 +32207,8 @@ Zone out, completely.
;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el"
;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el"
;;;;;; "cedet/cedet-idutils.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el"
-;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el"
+;;;;;; "cedet/ede/base.el" "cedet/ede/config.el" "cedet/ede/cpp-root.el"
+;;;;;; "cedet/ede/custom.el" "cedet/ede/detect.el" "cedet/ede/dired.el"
;;;;;; "cedet/ede/emacs.el" "cedet/ede/files.el" "cedet/ede/generic.el"
;;;;;; "cedet/ede/linux.el" "cedet/ede/loaddefs.el" "cedet/ede/locate.el"
;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el"
@@ -31842,21 +32216,19 @@ Zone out, completely.
;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el"
;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el"
;;;;;; "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" "cedet/ede/proj.el"
-;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el"
-;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el"
-;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el"
-;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el"
-;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el"
-;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el"
-;;;;;; "cedet/semantic/bovine/debug.el" "cedet/semantic/bovine/el.el"
-;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el"
-;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el"
-;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/chart.el"
-;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-debug.el"
-;;;;;; "cedet/semantic/db-ebrowse.el" "cedet/semantic/db-el.el"
-;;;;;; "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" "cedet/semantic/db-global.el"
-;;;;;; "cedet/semantic/db-javascript.el" "cedet/semantic/db-mode.el"
-;;;;;; "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el"
+;;;;;; "cedet/ede/project-am.el" "cedet/ede/shell.el" "cedet/ede/simple.el"
+;;;;;; "cedet/ede/source.el" "cedet/ede/speedbar.el" "cedet/ede/srecode.el"
+;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/semantic/analyze.el"
+;;;;;; "cedet/semantic/analyze/complete.el" "cedet/semantic/analyze/debug.el"
+;;;;;; "cedet/semantic/analyze/fcn.el" "cedet/semantic/analyze/refs.el"
+;;;;;; "cedet/semantic/bovine.el" "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el"
+;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el"
+;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el"
+;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el"
+;;;;;; "cedet/semantic/db-debug.el" "cedet/semantic/db-ebrowse.el"
+;;;;;; "cedet/semantic/db-el.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el"
+;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-javascript.el"
+;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el"
;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate.el"
;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el"
;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/ede-grammar.el"
@@ -31874,151 +32246,160 @@ Zone out, completely.
;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el"
;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el"
;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el"
-;;;;;; "cedet/semantic/wisent/javat-wy.el" "cedet/semantic/wisent/js-wy.el"
-;;;;;; "cedet/semantic/wisent/python-wy.el" "cedet/semantic/wisent/python.el"
-;;;;;; "cedet/semantic/wisent/wisent.el" "cedet/srecode/args.el"
-;;;;;; "cedet/srecode/compile.el" "cedet/srecode/cpp.el" "cedet/srecode/ctxt.el"
-;;;;;; "cedet/srecode/dictionary.el" "cedet/srecode/document.el"
+;;;;;; "cedet/semantic/wisent/python.el" "cedet/semantic/wisent/wisent.el"
+;;;;;; "cedet/srecode/args.el" "cedet/srecode/compile.el" "cedet/srecode/cpp.el"
+;;;;;; "cedet/srecode/ctxt.el" "cedet/srecode/dictionary.el" "cedet/srecode/document.el"
;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el"
;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el"
;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el"
;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el"
-;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el"
-;;;;;; "cedet/srecode/table.el" "cedet/srecode/template.el" "cedet/srecode/texi.el"
-;;;;;; "cus-dep.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el"
-;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el"
-;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el"
-;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el"
-;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el"
-;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-speedbar.el"
-;;;;;; "emacs-lisp/find-gc.el" "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el"
-;;;;;; "emacs-lisp/package-x.el" "emacs-lisp/smie.el" "emacs-lisp/tcover-ses.el"
-;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/cua-rect.el"
-;;;;;; "emulation/edt-lk201.el" "emulation/edt-mapper.el" "emulation/edt-pc.el"
-;;;;;; "emulation/edt-vt100.el" "emulation/tpu-extras.el" "emulation/viper-cmd.el"
-;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el" "emulation/viper-keym.el"
-;;;;;; "emulation/viper-macs.el" "emulation/viper-mous.el" "emulation/viper-util.el"
-;;;;;; "erc/erc-backend.el" "erc/erc-goodies.el" "erc/erc-ibuffer.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" "eshell/esh-arg.el"
-;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el"
-;;;;;; "eshell/esh-io.el" "eshell/esh-module.el" "eshell/esh-opt.el"
-;;;;;; "eshell/esh-proc.el" "eshell/esh-util.el" "eshell/esh-var.el"
-;;;;;; "ezimage.el" "format-spec.el" "fringe.el" "generic-x.el"
-;;;;;; "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el"
-;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el"
-;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el"
+;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt.el" "cedet/srecode/table.el"
+;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "cus-dep.el"
+;;;;;; "dframe.el" "dired-aux.el" "dired-x.el" "dom.el" "dos-fns.el"
+;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/avl-tree.el"
+;;;;;; "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" "emacs-lisp/cl-extra.el"
+;;;;;; "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el"
+;;;;;; "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-compat.el"
+;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el"
+;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el"
+;;;;;; "emacs-lisp/generator.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el"
+;;;;;; "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el"
+;;;;;; "emacs-lisp/tcover-unsafep.el" "emulation/cua-gmrk.el" "emulation/edt-lk201.el"
+;;;;;; "emulation/edt-mapper.el" "emulation/edt-pc.el" "emulation/edt-vt100.el"
+;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el" "emulation/viper-init.el"
+;;;;;; "emulation/viper-keym.el" "emulation/viper-macs.el" "emulation/viper-mous.el"
+;;;;;; "emulation/viper-util.el" "erc/erc-backend.el" "erc/erc-goodies.el"
+;;;;;; "erc/erc-ibuffer.el" "erc/erc-lang.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" "eshell/esh-arg.el" "eshell/esh-cmd.el"
+;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el"
+;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el"
+;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "format-spec.el"
+;;;;;; "fringe.el" "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el"
+;;;;;; "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" "gnus/gnus-cloud.el"
+;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el"
+;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-icalendar.el"
;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el"
-;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-setup.el"
-;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el"
-;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el"
-;;;;;; "gnus/ietf-drums.el" "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el"
-;;;;;; "gnus/mail-prsvr.el" "gnus/mail-source.el" "gnus/mailcap.el"
-;;;;;; "gnus/messcompat.el" "gnus/mm-archive.el" "gnus/mm-bodies.el"
-;;;;;; "gnus/mm-decode.el" "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el"
-;;;;;; "gnus/mml-smime.el" "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el"
-;;;;;; "gnus/nndraft.el" "gnus/nneething.el" "gnus/nngateway.el"
-;;;;;; "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el"
-;;;;;; "gnus/nnmaildir.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el"
+;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-srvr.el"
+;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el"
+;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el"
+;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el"
+;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el"
+;;;;;; "gnus/mm-archive.el" "gnus/mm-bodies.el" "gnus/mm-decode.el"
+;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el"
+;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el"
+;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el"
+;;;;;; "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" "gnus/nnmaildir.el"
+;;;;;; "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el"
;;;;;; "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" "gnus/nnspool.el"
;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/registry.el"
-;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el"
-;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/sieve-manage.el"
-;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el"
-;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/cp51932.el" "international/eucjp-ms.el"
-;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el"
+;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2231.el"
+;;;;;; "gnus/rtree.el" "gnus/sieve-manage.el" "gnus/smime.el" "gnus/spam-stat.el"
+;;;;;; "gnus/spam-wash.el" "hex-util.el" "hfy-cmap.el" "ibuf-ext.el"
+;;;;;; "international/charscript.el" "international/fontset.el"
+;;;;;; "international/iso-ascii.el" "international/ja-dic-cnv.el"
;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/uni-bidi.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-titlecase.el"
-;;;;;; "international/uni-uppercase.el" "kermit.el" "language/hanja-util.el"
-;;;;;; "language/thai-word.el" "ldefs-boot.el" "loadup.el" "mail/blessmail.el"
-;;;;;; "mail/mailheader.el" "mail/mspools.el" "mail/rfc2368.el"
-;;;;;; "mail/rfc822.el" "mail/rmail-spam-filter.el" "mail/rmailedit.el"
-;;;;;; "mail/rmailkwd.el" "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el"
-;;;;;; "mail/rmailsum.el" "mail/undigest.el" "mh-e/mh-acros.el"
-;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el"
-;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el"
-;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.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-titlecase.el" "international/uni-uppercase.el"
+;;;;;; "kermit.el" "language/hanja-util.el" "language/thai-word.el"
+;;;;;; "ldefs-boot.el" "leim/quail/arabic.el" "leim/quail/croatian.el"
+;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el"
+;;;;;; "leim/quail/ethiopic.el" "leim/quail/georgian.el" "leim/quail/greek.el"
+;;;;;; "leim/quail/hanja-jis.el" "leim/quail/hanja.el" "leim/quail/hanja3.el"
+;;;;;; "leim/quail/hebrew.el" "leim/quail/indian.el" "leim/quail/ipa-praat.el"
+;;;;;; "leim/quail/ipa.el" "leim/quail/japanese.el" "leim/quail/lao.el"
+;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" "leim/quail/latin-post.el"
+;;;;;; "leim/quail/latin-pre.el" "leim/quail/lrt.el" "leim/quail/persian.el"
+;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/rfc1345.el"
+;;;;;; "leim/quail/sgml-input.el" "leim/quail/sisheng.el" "leim/quail/slovak.el"
+;;;;;; "leim/quail/symbol-ksc.el" "leim/quail/thai.el" "leim/quail/tibetan.el"
+;;;;;; "leim/quail/viqr.el" "leim/quail/vntelex.el" "leim/quail/vnvni.el"
+;;;;;; "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" "mail/mailheader.el"
+;;;;;; "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el"
+;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el"
+;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el"
+;;;;;; "mail/undigest.el" "mh-e/mh-acros.el" "mh-e/mh-alias.el"
+;;;;;; "mh-e/mh-buffers.el" "mh-e/mh-compat.el" "mh-e/mh-funcs.el"
+;;;;;; "mh-e/mh-gnus.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el"
+;;;;;; "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el"
;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el"
;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el"
;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el"
-;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mouse.el"
-;;;;;; "mwheel.el" "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el"
-;;;;;; "net/eudcb-ldap.el" "net/eudcb-mab.el" "net/eudcb-ph.el"
-;;;;;; "net/hmac-def.el" "net/hmac-md5.el" "net/imap.el" "net/ldap.el"
-;;;;;; "net/mairix.el" "net/sasl-cram.el" "net/sasl-digest.el" "net/sasl.el"
-;;;;;; "net/shr-color.el" "net/soap-client.el" "net/soap-inspect.el"
-;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el"
-;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el"
-;;;;;; "net/tramp-gw.el" "net/tramp-loaddefs.el" "net/tramp-sh.el"
-;;;;;; "net/tramp-smb.el" "net/tramp-uu.el" "net/trampver.el" "net/zeroconf.el"
-;;;;;; "notifications.el" "nxml/nxml-enc.el" "nxml/nxml-maint.el"
-;;;;;; "nxml/nxml-ns.el" "nxml/nxml-outln.el" "nxml/nxml-parse.el"
-;;;;;; "nxml/nxml-rap.el" "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el"
-;;;;;; "nxml/rng-maint.el" "nxml/rng-match.el" "nxml/rng-parse.el"
-;;;;;; "nxml/rng-pttrn.el" "nxml/rng-uri.el" "nxml/rng-util.el"
-;;;;;; "nxml/xsd-regexp.el" "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el"
-;;;;;; "org/ob-awk.el" "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el"
+;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mwheel.el"
+;;;;;; "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" "net/eudcb-ldap.el"
+;;;;;; "net/eudcb-mab.el" "net/eudcb-ph.el" "net/hmac-def.el" "net/hmac-md5.el"
+;;;;;; "net/imap.el" "net/ldap.el" "net/mairix.el" "net/newsticker.el"
+;;;;;; "net/nsm.el" "net/rfc2104.el" "net/sasl-cram.el" "net/sasl-digest.el"
+;;;;;; "net/sasl-scram-rfc.el" "net/sasl.el" "net/shr-color.el"
+;;;;;; "net/soap-client.el" "net/soap-inspect.el" "net/socks.el"
+;;;;;; "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" "net/tramp-cmds.el"
+;;;;;; "net/tramp-compat.el" "net/tramp-gvfs.el" "net/tramp-gw.el"
+;;;;;; "net/tramp-loaddefs.el" "net/tramp-sh.el" "net/tramp-smb.el"
+;;;;;; "net/tramp-uu.el" "net/trampver.el" "net/zeroconf.el" "notifications.el"
+;;;;;; "nxml/nxml-enc.el" "nxml/nxml-maint.el" "nxml/nxml-ns.el"
+;;;;;; "nxml/nxml-outln.el" "nxml/nxml-parse.el" "nxml/nxml-rap.el"
+;;;;;; "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el" "nxml/rng-maint.el"
+;;;;;; "nxml/rng-match.el" "nxml/rng-parse.el" "nxml/rng-pttrn.el"
+;;;;;; "nxml/rng-uri.el" "nxml/rng-util.el" "nxml/xsd-regexp.el"
+;;;;;; "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" "org/ob-awk.el"
+;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-core.el"
;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el"
;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el"
;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el"
;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el"
-;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-matlab.el" "org/ob-maxima.el"
-;;;;;; "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el" "org/ob-org.el"
-;;;;;; "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el"
+;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" "org/ob-matlab.el"
+;;;;;; "org/ob-maxima.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el"
+;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el"
;;;;;; "org/ob-python.el" "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el"
;;;;;; "org/ob-scala.el" "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el"
;;;;;; "org/ob-shen.el" "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el"
-;;;;;; "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-ascii.el"
-;;;;;; "org/org-attach.el" "org/org-bbdb.el" "org/org-bibtex.el"
-;;;;;; "org/org-clock.el" "org/org-crypt.el" "org/org-ctags.el"
-;;;;;; "org/org-datetree.el" "org/org-docbook.el" "org/org-docview.el"
-;;;;;; "org/org-element.el" "org/org-entities.el" "org/org-eshell.el"
-;;;;;; "org/org-exp-blocks.el" "org/org-exp.el" "org/org-faces.el"
-;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-freemind.el"
-;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-html.el" "org/org-icalendar.el"
+;;;;;; "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-attach.el"
+;;;;;; "org/org-bbdb.el" "org/org-bibtex.el" "org/org-clock.el"
+;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-datetree.el"
+;;;;;; "org/org-docview.el" "org/org-element.el" "org/org-entities.el"
+;;;;;; "org/org-eshell.el" "org/org-faces.el" "org/org-feed.el"
+;;;;;; "org/org-footnote.el" "org/org-gnus.el" "org/org-habit.el"
;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-info.el" "org/org-inlinetask.el"
-;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-jsinfo.el"
-;;;;;; "org/org-latex.el" "org/org-list.el" "org/org-loaddefs.el"
-;;;;;; "org/org-lparse.el" "org/org-mac-message.el" "org/org-macs.el"
-;;;;;; "org/org-mew.el" "org/org-mhe.el" "org/org-mks.el" "org/org-mobile.el"
-;;;;;; "org/org-mouse.el" "org/org-odt.el" "org/org-pcomplete.el"
-;;;;;; "org/org-plot.el" "org/org-protocol.el" "org/org-publish.el"
-;;;;;; "org/org-remember.el" "org/org-rmail.el" "org/org-special-blocks.el"
-;;;;;; "org/org-src.el" "org/org-table.el" "org/org-taskjuggler.el"
-;;;;;; "org/org-timer.el" "org/org-vm.el" "org/org-w3m.el" "org/org-wl.el"
-;;;;;; "org/org-xoxo.el" "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el"
-;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el"
-;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-defs.el" "progmodes/cc-fonts.el"
-;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/ebnf-abn.el"
-;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el"
-;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el"
-;;;;;; "progmodes/idlw-complete-structtag.el" "progmodes/idlw-help.el"
-;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el"
-;;;;;; "ps-def.el" "ps-mule.el" "ps-samp.el" "saveplace.el" "sb-image.el"
-;;;;;; "scroll-bar.el" "select.el" "soundex.el" "subdirs.el" "tempo.el"
+;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-list.el" "org/org-loaddefs.el"
+;;;;;; "org/org-macro.el" "org/org-mhe.el" "org/org-mobile.el" "org/org-mouse.el"
+;;;;;; "org/org-pcomplete.el" "org/org-plot.el" "org/org-protocol.el"
+;;;;;; "org/org-rmail.el" "org/org-src.el" "org/org-table.el" "org/org-timer.el"
+;;;;;; "org/org-w3m.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el"
+;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-man.el" "org/ox-md.el"
+;;;;;; "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el"
+;;;;;; "org/ox.el" "play/gametree.el" "progmodes/ada-prj.el" "progmodes/cc-align.el"
+;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el"
+;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el"
+;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el"
+;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el"
+;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el"
+;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el"
+;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el"
+;;;;;; "sb-image.el" "scroll-bar.el" "soundex.el" "subdirs.el" "tempo.el"
;;;;;; "textmodes/bib-mode.el" "textmodes/makeinfo.el" "textmodes/page-ext.el"
;;;;;; "textmodes/refbib.el" "textmodes/refer.el" "textmodes/reftex-auc.el"
-;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el"
-;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el"
-;;;;;; "tooltip.el" "tree-widget.el" "uniquify.el" "url/url-about.el"
+;;;;;; "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" "textmodes/reftex-global.el"
+;;;;;; "textmodes/reftex-index.el" "textmodes/reftex-parse.el" "textmodes/reftex-ref.el"
+;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el"
+;;;;;; "timezone.el" "tooltip.el" "tree-widget.el" "url/url-about.el"
;;;;;; "url/url-cookie.el" "url/url-dired.el" "url/url-domsuf.el"
;;;;;; "url/url-expand.el" "url/url-ftp.el" "url/url-future.el"
;;;;;; "url/url-history.el" "url/url-imap.el" "url/url-methods.el"
;;;;;; "url/url-nfs.el" "url/url-proxy.el" "url/url-vars.el" "vc/ediff-diff.el"
;;;;;; "vc/ediff-init.el" "vc/ediff-merg.el" "vc/ediff-ptch.el"
;;;;;; "vc/ediff-vers.el" "vc/ediff-wind.el" "vc/pcvs-info.el" "vc/pcvs-parse.el"
-;;;;;; "vc/pcvs-util.el" "vc/vc-dav.el" "vcursor.el" "vt-control.el"
-;;;;;; "vt100-led.el" "w32-common-fns.el" "w32-fns.el" "w32-vars.el"
-;;;;;; "x-dnd.el") (20945 22525 596830 318000))
+;;;;;; "vc/pcvs-util.el" "vc/vc-dav.el" "vc/vc-filewise.el" "vcursor.el"
+;;;;;; "vt-control.el" "vt100-led.el" "w32-fns.el" "w32-vars.el"
+;;;;;; "x-dnd.el") (22026 26004 435502 692000))
;;;***
diff --git a/lisp/leim/quail/arabic.el b/lisp/leim/quail/arabic.el
new file mode 100644
index 00000000000..d05fc479c55
--- /dev/null
+++ b/lisp/leim/quail/arabic.el
@@ -0,0 +1,115 @@
+;;; arabic.el --- Quail package for inputting Arabic -*- coding: utf-8;-*-
+
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
+
+;; Author: James Cloos <cloos@jhcloos.com>
+;; Keywords: mule, input method, Arabic
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "arabic" "Arabic" "ع" nil "Arabic input method.
+
+Based on Arabic table in X Keyboard Configuration DB.
+" nil t t t t nil nil nil nil nil t)
+
+;; ذّ 1! 2@ 3# 4$ 5% 6^ 7& 8* 9) 0( -_ =+
+;; ضَ صً ثُ قٌ فﻹ غإ ع` ه÷ خ× ح؛ ج< د> <>
+;; شِ سٍ ي] ب[ لﻷ اأ تـ ن، م/ ك: ط"
+;; ئ~ ءْ ؤ} ر{ ﻻﻵ ىآ ة' و, ز. ظ؟
+;;
+
+(quail-define-rules
+ ("`" ?ذ)
+ ("~" ?ّ)
+
+ ("Q" ?َ)
+ ("W" ?ً)
+ ("E" ?ُ)
+ ("R" ?ٌ)
+ ("T" ["لإ"])
+ ("Y" ?إ)
+ ("U" ?`)
+ ("I" ?÷)
+ ("O" ?×)
+ ("P" ?؛)
+ ("{" ?<)
+ ("}" ?>)
+
+ ("A" ?ِ)
+ ("S" ?ٍ)
+ ("D" ?\])
+ ("F" ?\[)
+ ("G" ["لأ"])
+ ("H" ?أ)
+ ("J" ?ـ)
+ ("K" ?،)
+ ("L" ?/)
+
+ ("Z" ?~)
+ ("X" ?ْ)
+ ("C" ?})
+ ("V" ?{)
+ ("B" ["لآ"])
+ ("N" ?آ)
+ ("M" ?')
+ ("<" ?,)
+ (">" ?.)
+ ("?" ?؟)
+
+ ("q" ?ض)
+ ("w" ?ص)
+ ("e" ?ث)
+ ("r" ?ق)
+ ("t" ?ف)
+ ("y" ?غ)
+ ("u" ?ع)
+ ("i" ?ه)
+ ("o" ?خ)
+ ("p" ?ح)
+ ("[" ?ج)
+ ("]" ?د)
+
+ ("a" ?ش)
+ ("s" ?س)
+ ("d" ?ي)
+ ("f" ?ب)
+ ("g" ?ل)
+ ("h" ?ا)
+ ("j" ?ت)
+ ("k" ?ن)
+ ("l" ?م)
+ (";" ?ك)
+ ("'" ?ط)
+
+ ("z" ?ئ)
+ ("x" ?ء)
+ ("c" ?ؤ)
+ ("v" ?ر)
+ ("b" ["لا"])
+ ("n" ?ى)
+ ("m" ?ة)
+ ("," ?و)
+ ("." ?ز)
+ ("/" ?ظ))
+
+;;; arabic.el ends here
diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el
new file mode 100644
index 00000000000..e82be231dca
--- /dev/null
+++ b/lisp/leim/quail/croatian.el
@@ -0,0 +1,199 @@
+;;; croatian.el -- Quail package for inputting Croatian -*-coding: utf-8;-*-
+
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Nikšić <hniksic@xemacs.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Modeled after czech.el by Milan Zamazal.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "croatian" "Croatian" "HR" nil
+ "\"Standard\" Croatian keyboard."
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("@" ?\")
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("-" ?\')
+ ("_" ??)
+ ("=" ?+)
+ ("+" ?*)
+ ("[" ?š)
+ ("{" ?Š)
+ ("]" ?đ)
+ ("}" ?Đ)
+ (";" ?č)
+ (":" ?Č)
+ ("'" ?ć)
+ ("\"" ?Ć)
+ ("\\" ?ž)
+ ("|" ?Ž)
+ ("<" ?\;)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("y" ?z)
+ ("Y" ?Z)
+ ("z" ?y)
+ ("Z" ?Y))
+
+(quail-define-package
+ "croatian-qwerty" "Croatian" "HR" nil
+ "Croatian keyboard without the y/z swap."
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("@" ?\")
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("-" ?\')
+ ("_" ??)
+ ("=" ?+)
+ ("+" ?*)
+ ("[" ?š)
+ ("{" ?Š)
+ ("]" ?đ)
+ ("}" ?Đ)
+ (";" ?č)
+ (":" ?Č)
+ ("'" ?ć)
+ ("\"" ?Ć)
+ ("\\" ?ž)
+ ("|" ?Ž)
+ ("<" ?\;)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_))
+
+(quail-define-package
+ "croatian-prefix" "Croatian" "HR" nil
+ "Croatian input method, prefix.
+
+\"c -> č
+'c -> ć
+\"s -> š
+\"z -> ž
+/d -> đ"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("\"c" ?č)
+ ("\"C" ?Č)
+ ("'c" ?ć)
+ ("'C" ?Ć)
+ ("\"s" ?š)
+ ("\"S" ?Š)
+ ("\"z" ?ž)
+ ("\"Z" ?Ž)
+ ("/d" ?đ)
+ ("/D" ?Đ))
+
+(quail-define-package
+ "croatian-postfix" "Croatian" "HR" nil
+ "Croatian input method, postfix.
+
+c\" -> č
+c' -> ć
+s\" -> š
+z\" -> ž
+d/ -> đ"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("c\"" ?č)
+ ("C\"" ?Č)
+ ("c'" ?ć)
+ ("C'" ?Ć)
+ ("s\"" ?š)
+ ("S\"" ?Š)
+ ("z\"" ?ž)
+ ("Z\"" ?Ž)
+ ("d/" ?đ)
+ ("D/" ?Đ))
+
+(quail-define-package
+ "croatian-xy" "Croatian" "HR" nil
+ "An alternative Croatian input method.
+
+cx -> č
+cy -> ć
+sx -> š
+zx -> ž
+dy -> đ"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("cx" ?č)
+ ("CX" ?Č)
+ ("Cx" ?Č)
+ ("cy" ?ć)
+ ("CY" ?Ć)
+ ("Cy" ?Ć)
+ ("sx" ?š)
+ ("SX" ?Š)
+ ("Sx" ?Š)
+ ("zx" ?ž)
+ ("ZX" ?Ž)
+ ("Zx" ?Ž)
+ ("dy" ?đ)
+ ("DY" ?Đ)
+ ("Dy" ?Đ))
+
+(quail-define-package
+ "croatian-cc" "Croatian" "HR" nil
+ "Another alternative Croatian input method.
+
+cc -> č
+ch -> ć
+ss -> š
+zz -> ž
+dd -> đ"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("cc" ?č)
+ ("CC" ?Č)
+ ("Cc" ?Č)
+ ("ch" ?ć)
+ ("CH" ?Ć)
+ ("Ch" ?Ć)
+ ("ss" ?š)
+ ("SS" ?Š)
+ ("Ss" ?Š)
+ ("zz" ?ž)
+ ("ZZ" ?Ž)
+ ("Zz" ?Ž)
+ ("dd" ?đ)
+ ("DD" ?Đ)
+ ("Dd" ?Đ))
+
+;;; croatian.el ends here
diff --git a/lisp/leim/quail/cyril-jis.el b/lisp/leim/quail/cyril-jis.el
new file mode 100644
index 00000000000..d771414da0a
--- /dev/null
+++ b/lisp/leim/quail/cyril-jis.el
@@ -0,0 +1,145 @@
+;;; cyril-jis.el --- Quail package for inputting JISX0208 Cyrillic letters
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Cyrillic
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This Quail package is for inputting Cyrillic letters of Japanese
+;; character set JISX0208, not for inputting Cyrillic letters of
+;; ISO-8859-5. For the latter, use packages in quail/cyrillic.el.
+
+;;; Code:
+
+(quail-define-package
+ "cyrillic-jis-russian" "Cyrillic" "$B'('+(B" nil
+ "$B'+'8'5','&'/(B keyboard layout same as JCUKEN (JIS X0208.1983 encoding)"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4" 5: 6, 7. 8* 9( 0) -_ =+ ,L!(B
+;; ,L9(B ,LF(B ,LC(B ,L:(B ,L5(B ,L=(B ,L3(B ,LH(B ,LI(B ,L7(B ,LE(B ,Lj(B
+;; ,LD(B ,LK(B ,L2(B ,L0(B ,L?(B ,L@(B ,L>(B ,L;(B ,L4(B ,L6(B ,LM(B
+;; ,LO(B ,LG(B ,LA(B ,L<(B ,L8(B ,LB(B ,LL(B ,L1(B ,LN(B /?
+
+(quail-define-rules
+ ("1" ?$B#1(B)
+ ("2" ?$B#2(B)
+ ("3" ?$B#3(B)
+ ("4" ?$B#4(B)
+ ("5" ?$B#5(B)
+ ("6" ?$B#6(B)
+ ("7" ?$B#7(B)
+ ("8" ?$B#8(B)
+ ("9" ?$B#9(B)
+ ("0" ?$B#0(B)
+ ("-" ?$B!](B)
+ ("=" ?$B!a(B)
+ ("`" ?$B'W(B)
+ ("q" ?$B'[(B)
+ ("w" ?$B'h(B)
+ ("e" ?$B'e(B)
+ ("r" ?$B'\(B)
+ ("t" ?$B'V(B)
+ ("y" ?$B'_(B)
+ ("u" ?$B'T(B)
+ ("i" ?$B'j(B)
+ ("o" ?$B'k(B)
+ ("p" ?$B'Y(B)
+ ("[" ?$B'g(B)
+ ("]" ?$B'l(B)
+ ("a" ?$B'f(B)
+ ("s" ?$B'm(B)
+ ("d" ?$B'S(B)
+ ("f" ?$B'Q(B)
+ ("g" ?$B'a(B)
+ ("h" ?$B'b(B)
+ ("j" ?$B'`(B)
+ ("k" ?$B'](B)
+ ("l" ?$B'U(B)
+ (";" ?$B'X(B)
+ ("'" ?$B'o(B)
+ ("\\" ?$B!@(B)
+ ("z" ?$B'q(B)
+ ("x" ?$B'i(B)
+ ("c" ?$B'c(B)
+ ("v" ?$B'^(B)
+ ("b" ?$B'Z(B)
+ ("n" ?$B'd(B)
+ ("m" ?$B'n(B)
+ ("," ?$B'R(B)
+ ("." ?$B'p(B)
+ ("/" ?$B!?(B)
+
+ ("!" ?$B!*(B)
+ ("@" ?$B!w(B)
+ ("#" ?$B!t(B)
+ ("$" ?$B!I(B)
+ ("%" ?$B!'(B)
+ ("^" ?$B!$(B)
+ ("&" ?$B!%(B)
+ ("*" ?$B!v(B)
+ ("(" ?$B!J(B)
+ (")" ?$B!K(B)
+ ("_" ?$B!2(B)
+ ("+" ?$B!\(B)
+ ("~" ?$B''(B)
+ ("Q" ?$B'+(B)
+ ("W" ?$B'8(B)
+ ("E" ?$B'5(B)
+ ("R" ?$B',(B)
+ ("T" ?$B'&(B)
+ ("Y" ?$B'/(B)
+ ("U" ?$B'$(B)
+ ("I" ?$B':(B)
+ ("O" ?$B';(B)
+ ("P" ?$B')(B)
+ ("{" ?$B'7(B)
+ ("}" ?$B'<(B)
+ ("A" ?$B'6(B)
+ ("S" ?$B'=(B)
+ ("D" ?$B'#(B)
+ ("F" ?$B'!(B)
+ ("G" ?$B'1(B)
+ ("H" ?$B'2(B)
+ ("J" ?$B'0(B)
+ ("K" ?$B'-(B)
+ ("L" ?$B'%(B)
+ (":" ?$B'((B)
+ ("\"" ?$B'?(B)
+ ("|" ?$B!C(B)
+ ("Z" ?$B'A(B)
+ ("X" ?$B'9(B)
+ ("C" ?$B'3(B)
+ ("V" ?$B'.(B)
+ ("B" ?$B'*(B)
+ ("N" ?$B'4(B)
+ ("M" ?$B'>(B)
+ ("<" ?$B'"(B)
+ (">" ?$B'@(B)
+ ("?" ?$B!)(B))
+
+;; Local Variables:
+;; coding: iso-2022-7bit
+;; End:
+
+;;; cyril-jis.el ends here
diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el
new file mode 100644
index 00000000000..5d11e45b3f6
--- /dev/null
+++ b/lisp/leim/quail/cyrillic.el
@@ -0,0 +1,1480 @@
+;;; cyrillic.el --- Quail package for inputting Cyrillic characters
+
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
+;; Keywords: multilingual, input method, Cyrillic, 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; These methods use a mixture of 8859-5 and Unicode. Quail, used
+;; with ucs-tables provides support for translating on the fly to
+;; what's appropriate for aa buffer's file coding system, so the
+;; encoding shouldn't matter too much provided it supports the
+;; necessary characters.
+
+;;; Code:
+
+(require 'quail)
+
+;; This was `cyrillic-jcuken'. Alexander Mikhailian
+;; <mikhailian@altern.org> says: "cyrillic-jcuken" is actually
+;; russian. It is ok but a bit outdated. This layout has been used
+;; in typewriters for ages but it has been superseded on desktops by
+;; a variation of this layout, implemented in M$ Windows software.
+;; The Windows layout is greatly preferred because of the comma and
+;; period being placed more conveniently and, of course, because of
+;; the popularity of Windows software. This layout is a common option
+;; in X Windows and console layouts for GNU/Linux. [See
+;; `russian-computer' below.]
+(quail-define-package
+ "russian-typewriter" "Russian" "ЖЙ" nil
+ "ЙЦУКЕН Russian typewriter layout (ISO 8859-5 encoding)."
+ nil t t t t nil nil nil nil nil t)
+
+;; №1 -2 /3 "4 :5 ,6 .7 _8 ?9 %0 != ;\ |+
+;; Й Ц У К Е Н Г Ш Щ З Х Ъ )(
+;; Ф Ы В А П Р О Л Д Ж Э
+;; Я Ч С М И Т Ь Б Ю Ё
+
+(quail-define-rules
+ ("1" ?№)
+ ("2" ?-)
+ ("3" ?/)
+ ("4" ?\")
+ ("5" ?:)
+ ("6" ?,)
+ ("7" ?.)
+ ("8" ?_)
+ ("9" ??)
+ ("0" ?%)
+ ("-" ?!)
+ ("=" ?\;)
+ ("`" ?|)
+ ("q" ?й)
+ ("w" ?ц)
+ ("e" ?у)
+ ("r" ?к)
+ ("t" ?е)
+ ("y" ?н)
+ ("u" ?г)
+ ("i" ?ш)
+ ("o" ?щ)
+ ("p" ?з)
+ ("[" ?х)
+ ("]" ?ъ)
+ ("a" ?ф)
+ ("s" ?ы)
+ ("d" ?в)
+ ("f" ?а)
+ ("g" ?п)
+ ("h" ?р)
+ ("j" ?о)
+ ("k" ?л)
+ ("l" ?д)
+ (";" ?ж)
+ ("'" ?э)
+ ("\\" ?\))
+ ("z" ?я)
+ ("x" ?ч)
+ ("c" ?с)
+ ("v" ?м)
+ ("b" ?и)
+ ("n" ?т)
+ ("m" ?ь)
+ ("," ?б)
+ ("." ?ю)
+ ("/" ?ё)
+
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("_" ?=)
+ ("+" ?\\)
+ ("~" ?+)
+ ("Q" ?Й)
+ ("W" ?Ц)
+ ("E" ?У)
+ ("R" ?К)
+ ("T" ?Е)
+ ("Y" ?Н)
+ ("U" ?Г)
+ ("I" ?Ш)
+ ("O" ?Щ)
+ ("P" ?З)
+ ("{" ?Х)
+ ("}" ?Ъ)
+ ("A" ?Ф)
+ ("S" ?Ы)
+ ("D" ?В)
+ ("F" ?А)
+ ("G" ?П)
+ ("H" ?Р)
+ ("J" ?О)
+ ("K" ?Л)
+ ("L" ?Д)
+ (":" ?Ж)
+ ("\"" ?Э)
+ ("|" ?\()
+ ("Z" ?Я)
+ ("X" ?Ч)
+ ("C" ?С)
+ ("V" ?М)
+ ("B" ?И)
+ ("N" ?Т)
+ ("M" ?Ь)
+ ("<" ?Б)
+ (">" ?Ю)
+ ("?" ?Ё)
+ )
+
+;; Maintain the obsolete name for now.
+(push (cons "cyrillic-jcuken"
+ (cdr (assoc "russian-typewriter" quail-package-alist)))
+ quail-package-alist)
+
+;; This needs to be seen by quail-update-leim-list-file, but cannot be
+;; commented out because quail-update-leim-list-file ignores
+;; commented-out lines.
+(if nil
+ (quail-define-package
+ "cyrillic-jcuken" "Russian" "ЖЙ" nil
+ "ЙЦУКЕН Russian typewriter layout (ISO 8859-5 encoding)."))
+
+;; See comment above. This is the variant `winkeys' from `ru' in XKB.
+(quail-define-package
+ "russian-computer" "Russian" "RU" nil
+ "ЙЦУКЕН Russian computer layout"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3№ 4; 5% 6: 7? 8* 9( 0) -_ =+ \/ ёЁ
+;; Й Ц У К Е Н Г Ш Щ З Х Ъ
+;; Ф Ы В А П Р О Л Д Ж Э
+;; Я Ч С М И Т Ь Б Ю .,
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?-)
+ ("=" ?=)
+ ("|" ?/)
+ ("`" ?ё)
+ ("q" ?й)
+ ("w" ?ц)
+ ("e" ?у)
+ ("r" ?к)
+ ("t" ?е)
+ ("y" ?н)
+ ("u" ?г)
+ ("i" ?ш)
+ ("o" ?щ)
+ ("p" ?з)
+ ("[" ?х)
+ ("]" ?ъ)
+ ("a" ?ф)
+ ("s" ?ы)
+ ("d" ?в)
+ ("f" ?а)
+ ("g" ?п)
+ ("h" ?р)
+ ("j" ?о)
+ ("k" ?л)
+ ("l" ?д)
+ (";" ?ж)
+ ("'" ?э)
+ ("\\" ?\\)
+ ("z" ?я)
+ ("x" ?ч)
+ ("c" ?с)
+ ("v" ?м)
+ ("b" ?и)
+ ("n" ?т)
+ ("m" ?ь)
+ ("," ?б)
+ ("." ?ю)
+ ("/" ?.)
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?№)
+ ("$" ?\;)
+ ("%" ?%)
+ ("^" ?:)
+ ("&" ??)
+ ("*" ?*)
+ ("(" ?()
+ (")" ?))
+ ("_" ?_)
+ ("+" ?+)
+ ("~" ?Ё)
+ ("Q" ?Й)
+ ("W" ?Ц)
+ ("E" ?У)
+ ("R" ?К)
+ ("T" ?Е)
+ ("Y" ?Н)
+ ("U" ?Г)
+ ("I" ?Ш)
+ ("O" ?Щ)
+ ("P" ?З)
+ ("{" ?Х)
+ ("}" ?Ъ)
+ ("A" ?Ф)
+ ("S" ?Ы)
+ ("D" ?В)
+ ("F" ?А)
+ ("G" ?П)
+ ("H" ?Р)
+ ("J" ?О)
+ ("K" ?Л)
+ ("L" ?Д)
+ (":" ?Ж)
+ ("\"" ?Э)
+ ("|" ?|)
+ ("Z" ?Я)
+ ("X" ?Ч)
+ ("C" ?С)
+ ("V" ?М)
+ ("B" ?И)
+ ("N" ?Т)
+ ("M" ?Ь)
+ ("<" ?Б)
+ (">" ?Ю)
+ ("?" ?,))
+
+;; Mikhailian couldn't check the next two.
+
+;; This seems to have the same layout for letters as mk in XKB, but at
+;; least the top row is different.
+(quail-define-package
+ "cyrillic-macedonian" "Cyrillic" "ЖM" nil
+ "ЉЊЕРТЗ-ЃЌ keyboard layout based on JUS.I.K1.004"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
+;; Љ Њ Е Р Т З У И О П Ш Ѓ
+;; А С Д Ф Г Х Ј К Л Ч Ќ Ж
+;; Ѕ Џ Ц В Б Н М ,; .: -_
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?/)
+ ("=" ?+)
+ ("`" ?<)
+ ("q" ?љ)
+ ("w" ?њ)
+ ("e" ?е)
+ ("r" ?р)
+ ("t" ?т)
+ ("y" ?з)
+ ("u" ?у)
+ ("i" ?и)
+ ("o" ?о)
+ ("p" ?п)
+ ("[" ?ш)
+ ("]" ?ѓ)
+ ("a" ?а)
+ ("s" ?с)
+ ("d" ?д)
+ ("f" ?ф)
+ ("g" ?г)
+ ("h" ?х)
+ ("j" ?ј)
+ ("k" ?к)
+ ("l" ?л)
+ (";" ?ч)
+ ("'" ?ќ)
+ ("\\" ?ж)
+ ("z" ?ѕ)
+ ("x" ?џ)
+ ("c" ?ц)
+ ("v" ?в)
+ ("b" ?б)
+ ("n" ?н)
+ ("m" ?м)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?-)
+
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?#)
+ ("$" ?$)
+ ("%" ?%)
+ ("^" ?&)
+ ("&" ?')
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?*)
+ ("~" ?>)
+ ("Q" ?Љ)
+ ("W" ?Њ)
+ ("E" ?Е)
+ ("R" ?Р)
+ ("T" ?Т)
+ ("Y" ?З)
+ ("U" ?У)
+ ("I" ?И)
+ ("O" ?О)
+ ("P" ?П)
+ ("{" ?Ш)
+ ("}" ?Ѓ)
+ ("A" ?А)
+ ("S" ?С)
+ ("D" ?Д)
+ ("F" ?Ф)
+ ("G" ?Г)
+ ("H" ?Х)
+ ("J" ?Ј)
+ ("K" ?К)
+ ("L" ?Л)
+ (":" ?Ч)
+ ("\"" ?Ќ)
+ ("|" ?Ж)
+ ("Z" ?Ѕ)
+ ("X" ?Џ)
+ ("C" ?Ц)
+ ("V" ?В)
+ ("B" ?Б)
+ ("N" ?Н)
+ ("M" ?М)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_))
+
+;;
+
+(quail-define-package
+ "cyrillic-serbian" "Cyrillic" "ЖS" nil
+ "ЉЊЕРТЗ-ЂЋ keyboard layout based on JUS.I.K1.005"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
+;; Љ Њ Е Р Т З У И О П Ш Ђ
+;; А С Д Ф Г Х Ј К Л Ч Ћ Ж
+;; Ѕ Џ Ц В Б Н М ,; .: -_
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?/)
+ ("=" ?+)
+ ("`" ?<)
+ ("q" ?љ)
+ ("w" ?њ)
+ ("e" ?е)
+ ("r" ?р)
+ ("t" ?т)
+ ("y" ?з)
+ ("u" ?у)
+ ("i" ?и)
+ ("o" ?о)
+ ("p" ?п)
+ ("[" ?ш)
+ ("]" ?ђ)
+ ("a" ?а)
+ ("s" ?с)
+ ("d" ?д)
+ ("f" ?ф)
+ ("g" ?г)
+ ("h" ?х)
+ ("j" ?ј)
+ ("k" ?к)
+ ("l" ?л)
+ (";" ?ч)
+ ("'" ?ћ)
+ ("\\" ?ж)
+ ("z" ?ѕ)
+ ("x" ?џ)
+ ("c" ?ц)
+ ("v" ?в)
+ ("b" ?б)
+ ("n" ?н)
+ ("m" ?м)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?-)
+
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?#)
+ ("$" ?$)
+ ("%" ?%)
+ ("^" ?&)
+ ("&" ?')
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?*)
+ ("~" ?>)
+ ("Q" ?Љ)
+ ("W" ?Њ)
+ ("E" ?Е)
+ ("R" ?Р)
+ ("T" ?Т)
+ ("Y" ?З)
+ ("U" ?У)
+ ("I" ?И)
+ ("O" ?О)
+ ("P" ?П)
+ ("{" ?Ш)
+ ("}" ?Ђ)
+ ("A" ?А)
+ ("S" ?С)
+ ("D" ?Д)
+ ("F" ?Ф)
+ ("G" ?Г)
+ ("H" ?Х)
+ ("J" ?Ј)
+ ("K" ?К)
+ ("L" ?Л)
+ (":" ?Ч)
+ ("\"" ?Ћ)
+ ("|" ?Ж)
+ ("Z" ?Ѕ)
+ ("X" ?Џ)
+ ("C" ?Ц)
+ ("V" ?В)
+ ("B" ?Б)
+ ("N" ?Н)
+ ("M" ?М)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_))
+
+;;
+
+;; Alexander Mikhailian comments:
+;; Having worked for several years as a Belarusian linguist, I still
+;; can not find the origin of this layout which BTW does include
+;; several characters that are not present in Belarusian and does not
+;; include a few ones that do exist in Belarusian. Besides, the typo
+;; in the name of this layout speaks for itself since Belarusian has
+;; an outdated version of spelling which is "Byelorussian" and not
+;; "beylorussian". I suggest that you just remove this layout.
+
+;; [`derived from JUS.I.K1' according to an old Mule note -- fx]
+
+;; (quail-define-package
+;; "cyrillic-beylorussian" "Belarussian" "ЖB" nil
+;; "ЉЊЕРТЗ-ІЎ BEYLORUSSIAN (ISO 8859-5 encoding)"
+;; nil t t t t nil nil nil nil nil t)
+
+;; ;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
+;; ;; Љ Њ Е Р Т З У И О П Ш І
+;; ;; А С Д Ф Г Х Ј К Л Ч Ў Ж
+;; ;; Ѕ Џ Ц В Б Н М ,; .: -_
+
+;; (quail-define-rules
+;; ("-" ?/)
+;; ("=" ?+)
+;; ("`" ?<)
+;; ("q" ?љ)
+;; ("w" ?њ)
+;; ("e" ?е)
+;; ("r" ?р)
+;; ("t" ?т)
+;; ("y" ?з)
+;; ("u" ?у)
+;; ("i" ?и)
+;; ("o" ?о)
+;; ("p" ?п)
+;; ("[" ?ш)
+;; ("]" ?і)
+;; ("a" ?а)
+;; ("s" ?с)
+;; ("d" ?д)
+;; ("f" ?ф)
+;; ("g" ?г)
+;; ("h" ?х)
+;; ("j" ?ј)
+;; ("k" ?к)
+;; ("l" ?л)
+;; (";" ?ч)
+;; ("'" ?ў)
+;; ("\\" ?ж)
+;; ("z" ?ѕ)
+;; ("x" ?џ)
+;; ("c" ?ц)
+;; ("v" ?в)
+;; ("b" ?б)
+;; ("n" ?н)
+;; ("m" ?м)
+;; ("/" ?-)
+
+;; ("@" ?\")
+;; ("^" ?&)
+;; ("&" ?')
+;; ("*" ?\()
+;; ("(" ?\))
+;; (")" ?=)
+;; ("_" ??)
+;; ("+" ?*)
+;; ("~" ?>)
+;; ("Q" ?Љ)
+;; ("W" ?Њ)
+;; ("E" ?Е)
+;; ("R" ?Р)
+;; ("T" ?Т)
+;; ("Y" ?З)
+;; ("U" ?У)
+;; ("I" ?И)
+;; ("O" ?О)
+;; ("P" ?П)
+;; ("{" ?Ш)
+;; ("}" ?І)
+;; ("A" ?А)
+;; ("S" ?С)
+;; ("D" ?Д)
+;; ("F" ?Ф)
+;; ("G" ?Г)
+;; ("H" ?Х)
+;; ("J" ?Ј)
+;; ("K" ?К)
+;; ("L" ?Л)
+;; (":" ?Ч)
+;; ("\"" ?Ў)
+;; ("|" ?Ж)
+;; ("Z" ?Ѕ)
+;; ("X" ?Џ)
+;; ("C" ?Ц)
+;; ("V" ?В)
+;; ("B" ?Б)
+;; ("N" ?Н)
+;; ("M" ?М)
+;; ("<" ?\;)
+;; (">" ?:)
+;; ("?" ?_))
+
+;;
+
+;; Alexander Mikhailian reports the opinion of fellow Ukrainian
+;; linguist Bogdan Babych <babych@altern.org>:
+;; He had seen this layout on some oldish systems but that the vast
+;; majority of the population uses a modified version of the M$ Windows
+;; layout. In fact, Microsoft shipped for a while a layout that was lacking
+;; two characters, precisely the "GHE_WITH_UPTURN" and the apostrophe. The
+;; latest versions of Windows software do have the "GHE_WITH_UPTURN" in the
+;; ukrainian keyboard layout but the apostrophe is still not there, whereas
+;; there is one letter, "Cyrillic_YO", not used in ukrainian. Ukrainians
+;; normally replace the "Cyrillic_YO" by the apostrophe sign and live
+;; happily with this little change. [See "ukrainian-computer" below.]
+
+;; Fixme: add GHE_WITH_UPTURN.
+(quail-define-package
+ "cyrillic-ukrainian" "Ukrainian" "ЖU" nil
+ "ЄЇЕРТЗ-ІЎ UKRAINIAN
+
+Sorry, but `ghe with upturn' is not included in ISO 8859-5."
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
+;; Є Ї Е Р Т З У И О П Ш І
+;; А С Д Ф Г Х Ј К Л Ч Ў Ж
+;; Ѕ Џ Ц В Б Н М ,; .: -_
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?/)
+ ("=" ?+)
+ ("`" ?<)
+ ("q" ?є)
+ ("w" ?ї)
+ ("e" ?е)
+ ("r" ?р)
+ ("t" ?т)
+ ("y" ?з)
+ ("u" ?у)
+ ("i" ?и)
+ ("o" ?о)
+ ("p" ?п)
+ ("[" ?ш)
+ ("]" ?і)
+ ("a" ?а)
+ ("s" ?с)
+ ("d" ?д)
+ ("f" ?ф)
+ ("g" ?г)
+ ("h" ?х)
+ ("j" ?ј)
+ ("k" ?к)
+ ("l" ?л)
+ (";" ?ч)
+ ("'" ?ў)
+ ("\\" ?ж)
+ ("z" ?ѕ)
+ ("x" ?џ)
+ ("c" ?ц)
+ ("v" ?в)
+ ("b" ?б)
+ ("n" ?н)
+ ("m" ?м)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?-)
+
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?#)
+ ("$" ?$)
+ ("%" ?%)
+ ("^" ?&)
+ ("&" ?')
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?*)
+ ("~" ?>)
+ ("Q" ?Є)
+ ("W" ?Ї)
+ ("E" ?Е)
+ ("R" ?Р)
+ ("T" ?Т)
+ ("Y" ?З)
+ ("U" ?У)
+ ("I" ?И)
+ ("O" ?О)
+ ("P" ?П)
+ ("{" ?Ш)
+ ("}" ?І)
+ ("A" ?А)
+ ("S" ?С)
+ ("D" ?Д)
+ ("F" ?Ф)
+ ("G" ?Г)
+ ("H" ?Х)
+ ("J" ?Ј)
+ ("K" ?К)
+ ("L" ?Л)
+ (":" ?Ч)
+ ("\"" ?Ў)
+ ("|" ?Ж)
+ ("Z" ?Ѕ)
+ ("X" ?Џ)
+ ("C" ?Ц)
+ ("V" ?В)
+ ("B" ?Б)
+ ("N" ?Н)
+ ("M" ?М)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_))
+
+
+(quail-define-package
+ "ukrainian-computer" "Ukrainian" "UK" nil
+ "ЙЦУКЕН Ukrainian (Unicode-based for use with KOI8-U encoding)."
+ nil t t t t nil nil nil nil nil t)
+
+;; ' 1! 2" 3№ 4; 5% 6: 7? 8* 9( 0) -_ =+
+;; Й Ц У К Е Н Г Ш Щ З Х Ї
+;; Ф І В А П Р О Л Д Ж Є Ґ
+;; Я Ч С М И Т Ь Б Ю .,
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?-)
+ ("=" ?=)
+ ("`" ?')
+ ("q" ?й)
+ ("w" ?ц)
+ ("e" ?у)
+ ("r" ?к)
+ ("t" ?е)
+ ("y" ?н)
+ ("u" ?г)
+ ("i" ?ш)
+ ("o" ?щ)
+ ("p" ?з)
+ ("[" ?х)
+ ("]" ?ї)
+ ("a" ?ф)
+ ("s" ?і)
+ ("d" ?в)
+ ("f" ?а)
+ ("g" ?п)
+ ("h" ?р)
+ ("j" ?о)
+ ("k" ?л)
+ ("l" ?д)
+ (";" ?ж)
+ ("'" ?є)
+ ("z" ?я)
+ ("x" ?ч)
+ ("c" ?с)
+ ("v" ?м)
+ ("b" ?и)
+ ("n" ?т)
+ ("m" ?ь)
+ ("," ?б)
+ ("." ?ю)
+ ("/" ?.)
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?№)
+ ("$" ?\;)
+ ("%" ?%)
+ ("^" ?:)
+ ("&" ??)
+ ("*" ?*)
+ ("(" ?()
+ (")" ?))
+ ("_" ?_)
+ ("+" ?+)
+ ("~" ?')
+ ("Q" ?Й)
+ ("W" ?Ц)
+ ("E" ?У)
+ ("R" ?К)
+ ("T" ?Е)
+ ("Y" ?Н)
+ ("U" ?Г)
+ ("I" ?Ш)
+ ("O" ?Щ)
+ ("P" ?З)
+ ("{" ?Х)
+ ("}" ?Ї)
+ ("A" ?Ф)
+ ("S" ?І)
+ ("D" ?В)
+ ("F" ?А)
+ ("G" ?П)
+ ("H" ?Р)
+ ("J" ?О)
+ ("K" ?Л)
+ ("L" ?Д)
+ (":" ?Ж)
+ ("\"" ?Є)
+ ("Z" ?Я)
+ ("X" ?Ч)
+ ("C" ?С)
+ ("V" ?М)
+ ("B" ?И)
+ ("N" ?Т)
+ ("M" ?Ь)
+ ("<" ?Б)
+ (">" ?Ю)
+ ("?" ?,)
+ ("\\" ?ґ)
+ ("|" ?Ґ))
+;;
+
+;; Alexander Mikhailian says this is of limited use. It has been
+;; popular among emigrants or foreigners who have to type in Cyrillic
+;; (mostly Russian) from time to time.
+(quail-define-package
+ "cyrillic-yawerty" "Cyrillic" "ЖЯ" nil
+ "ЯВЕРТЫ Roman transcription
+
+This layout is based on Roman transcription by phonemic resemblance.
+When preceded by a `/', the second and the third rows (number key row) change
+as follows.
+
+ keytop | Q W E R T Y U I O P A S D
+ --------+---------------------------------------
+ input | Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ќ Ў Џ"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2ё 3ъ 4Ё 5% 6^ 7& 8* 9( 0) -_ Ч Ю
+;; Я В Е Р Т Ы У И О П Ш Щ
+;; А С Д Ф Г Х Й К Л ;: '" Э
+;; З Ь Ц Ж Б Н М ,< .> /?
+
+;; 1! 2ё 3ъ 4Ё 5% 6^ 7& 8* 9( 0) -_ Ч Ю
+;; Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ш Щ
+;; Ќ Ў Џ Ф Г Х Й К Л ;: '" Э
+;; З Ь Ц Ж Б Н М ,< .> /?
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?-)
+ ("=" ?ч)
+ ("`" ?ю)
+ ("q" ?я)
+ ("w" ?в)
+ ("e" ?е)
+ ("r" ?р)
+ ("t" ?т)
+ ("y" ?ы)
+ ("u" ?у)
+ ("i" ?и)
+ ("o" ?о)
+ ("p" ?п)
+ ("[" ?ш)
+ ("]" ?щ)
+ ("a" ?а)
+ ("s" ?с)
+ ("d" ?д)
+ ("f" ?ф)
+ ("g" ?г)
+ ("h" ?х)
+ ("j" ?й)
+ ("k" ?к)
+ ("l" ?л)
+ (";" ?\;)
+ ("'" ?')
+ ("\\" ?э)
+ ("z" ?з)
+ ("x" ?ь)
+ ("c" ?ц)
+ ("v" ?ж)
+ ("b" ?б)
+ ("n" ?н)
+ ("m" ?м)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?ё)
+ ("#" ?ъ)
+ ("$" ?Ё)
+ ("%" ?%)
+ ("^" ?^)
+ ("&" ?&)
+ ("*" ?*)
+ ("(" ?\()
+ (")" ?\))
+ ("_" ?_)
+ ("+" ?Ч)
+ ("~" ?Ю)
+ ("Q" ?Я)
+ ("W" ?В)
+ ("E" ?Е)
+ ("R" ?Р)
+ ("T" ?Т)
+ ("Y" ?Ы)
+ ("U" ?У)
+ ("I" ?И)
+ ("O" ?О)
+ ("P" ?П)
+ ("{" ?Ш)
+ ("}" ?Щ)
+ ("A" ?А)
+ ("S" ?С)
+ ("D" ?Д)
+ ("F" ?Ф)
+ ("G" ?Г)
+ ("H" ?Х)
+ ("J" ?Й)
+ ("K" ?К)
+ ("L" ?Л)
+ (":" ?:)
+ ("\"" ?\")
+ ("|" ?Э)
+ ("Z" ?З)
+ ("X" ?Ь)
+ ("C" ?Ц)
+ ("V" ?Ж)
+ ("B" ?Б)
+ ("N" ?Н)
+ ("M" ?М)
+ ("<" ?<)
+ (">" ?>)
+ ("?" ??)
+
+ ("/q" ?ђ)
+ ("/w" ?ѓ)
+ ("/e" ?є)
+ ("/r" ?ѕ)
+ ("/t" ?і)
+ ("/y" ?ї)
+ ("/u" ?ј)
+ ("/i" ?љ)
+ ("/o" ?њ)
+ ("/p" ?ћ)
+ ("/a" ?ќ)
+ ("/s" ?ў)
+ ("/d" ?џ)
+
+ ("/Q" ?Ђ)
+ ("/W" ?Ѓ)
+ ("/E" ?Є)
+ ("/R" ?Ѕ)
+ ("/T" ?І)
+ ("/Y" ?Ї)
+ ("/U" ?Ј)
+ ("/I" ?Љ)
+ ("/O" ?Њ)
+ ("/P" ?Ћ)
+ ("/A" ?Ќ)
+ ("/S" ?Ў)
+ ("/D" ?Џ))
+
+;; This was provided by Valery Alexeev <valery@domovoy.math.uga.edu>.
+
+;; Ognyan Kulev <ogi@fmi.uni-sofia.bg> wrote:
+
+;; I would suggest future `cyrillic-translit' to be with the
+;; modification of `cyrillic-translit-bulgarian' applied and the
+;; latter to disappear. It could be used by people who write
+;; bulgarian e-mails with latin letters for kick start (phonetic input
+;; method is not so obvious as translit input method but each letter
+;; is one keypress and a *lot* of people know it).
+
+;; Anton Zinoviev <anton@lml.bas.bg> wrote:
+;; I would say that the main idea for cyrillic-translit is to be
+;; language-independent and universal. It should be able to generate all
+;; Cyrillic symbols.
+(quail-define-package
+ "cyrillic-translit" "Cyrillic" "Жt" t
+ "Intuitively transliterated keyboard layout.
+Most convenient for entering Russian, but all Cyrillic characters
+are included. Should handle most cases. However:
+ for ц (TSE) use \"c\", never \"ts\"
+ щ (SHCHA = Bulgarian SHT) = \"shch\", \"sj\", \"/sht\" or \"/t\",
+ э (REVERSE ROUNDED E) = \"e\\\"
+ х (KHA) when after с (S) = \"x\" or \"kh\"
+ ъ (HARD SIGN) = \"~\", Ъ (CAPITAL HARD SIGN) = \"~~\",
+ ь (SOFT SIGN) = \"\\='\", Ь (CAPITAL SOFT SIGN) = \"\\='\\='\",
+ я (YA) = \"ya\", \"ja\" or \"q\".
+
+Russian alphabet: a b v=w g d e yo=jo zh z i j=j\\=' k l m n o p r s t
+u f h=kh=x c ch sh shch=sj=/s=/sht ~ y \\=' e\\ yu=ju ya=ja=q
+
+Also included are Ukrainian є (YE) = \"/e\", ї (YI) = \"yi\",
+ґ (GHE WITH UPTURN) = \"g\\='\",
+Belarusian ў (SHORT U) = \"u~\",
+Serbo-Croatian ђ (DJE) = \"/d\", ћ (CHJE)= \"/ch\",
+Macedonian ѓ (GJE) = \"/g\", ѕ (DZE) = \"/s\", ќ (KJE) = \"/k\",
+cyrillic і (I DECIMAL) = \"/i\", ј (JE) = \"/j\",
+љ (LJE) = \"/l\", њ (NJE) = \"/n\" and џ (DZE) =\"/z\"."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("a" ?а) ("b" ?б) ("v" ?в) ("w" ?в) ("g" ?г) ("d" ?д)
+ ("e" ?е) ("je" ?е)
+ ("yo" ?ё) ("jo" ?ё)
+ ("zh" ?ж) ("z" ?з) ("i" ?и)
+ ("j" ?й) ("j'" ?й) ("j`" ?й) ("k" ?к) ("l" ?л)
+ ("m" ?м) ("n" ?н) ("o" ?о) ("p" ?п) ("r" ?р) ("s" ?с) ("t" ?т) ("u" ?у)
+ ("f" ?ф) ("x" ?х) ("h" ?х) ("kh" ?х)
+ ("c" ?ц) ("ch" ?ч)
+ ("sh" ?ш)
+ ("shch" ?щ) ("sj" ?щ)
+ ("/sht" ?щ) ("/t" ?щ)
+ ("~" ?ъ) ("y" ?ы) ("'" ?ь) ("`" ?ь)
+ ("e\\" ?э) ("e'" ?э) ("e`" ?э) ("@" ?э)
+ ("yu" ?ю) ("ju" ?ю)
+ ("ya" ?я) ("ja" ?я) ("q" ?я)
+
+ ("A" ?А) ("B" ?Б) ("V" ?В) ("W" ?В) ("G" ?Г) ("D" ?Д)
+ ("E" ?Е) ("Je" ?Е) ("JE" ?Е)
+ ("Yo" ?Ё) ("YO" ?Ё) ("Jo" ?Ё) ("JO" ?Ё)
+ ("Zh" ?Ж) ("ZH" ?Ж) ("Z" ?З) ("I" ?И)
+ ("J" ?Й) ("J'" ?Й) ("J`" ?Й) ("K" ?К) ("L" ?Л)
+ ("M" ?М) ("N" ?Н) ("O" ?О) ("P" ?П) ("R" ?Р) ("S" ?С) ("T" ?Т) ("U" ?У)
+ ("F" ?Ф) ("X" ?Х) ("H" ?Х) ("Kh" ?Х) ("KH" ?Х)
+ ("C" ?Ц) ("Ch" ?Ч) ("CH" ?Ч)
+ ("Sh" ?Ш) ("SH" ?Ш)
+ ("Shch" ?Щ) ("SHCH" ?Щ) ("Sj" ?Щ) ("SJ" ?Щ)
+ ("/Sht" ?Щ) ("/SHT" ?Щ) ("/T" ?Щ)
+ ("~~" ?Ъ) ("Y" ?Ы) ("''" ?Ь)
+ ("E\\" ?Э) ("E'" ?Э) ("E`" ?Э) ("@@" ?Э)
+ ("Yu" ?Ю) ("YU" ?Ю) ("Ju" ?Ю) ("JU" ?Ю)
+ ("Ya" ?Я) ("YA" ?Я) ("Ja" ?Я) ("JA" ?Я) ("Q" ?Я)
+
+ ("/e" ?є) ("yi" ?ї) ("u'" ?ў) ("u~" ?ў)
+ ("g'" ?ґ)
+ ("/d" ?ђ) ("/ch" ?ћ)
+ ("/g" ?ѓ) ("/s" ?ѕ) ("/k" ?ќ)
+ ("/i" ?і) ("/j" ?ј) ("/l" ?љ) ("/n" ?њ) ("/z" ?џ)
+ ("/E" ?Є) ("YE" ?Є) ("Yi" ?Ї) ("YI" ?Ї) ("U'" ?Ў) ("U~" ?Ў)
+ ("G'" ?Ґ)
+ ("/D" ?Ђ) ("/Ch" ?Ћ) ("/CH" ?Ћ)
+ ("/G" ?Ѓ) ("/S" ?Ѕ) ("/K" ?Ќ)
+ ("/I" ?І) ("/J" ?Ј) ("/L" ?Љ) ("/N" ?Њ) ("/Z" ?Џ)
+
+ ;; Combining accents as a separate character
+ ("//'" ?́) ("//`" ?̀)
+
+ ;; In the following two rules the accent is not a separate character
+ ("i`" ?ѝ) ("I`" ?Ѝ)
+
+ ("/-" ?–) ;; EN DASH
+ ("/--" ?—) ;; EM DASH
+ ("/*" ?•) ;; BULLET
+ ("/." ?․) ;; ONE DOT LEADER
+ ("/.." ?‥) ;; TWO DOT LEADER
+ ("/..." ?…) ;; HORIZONTAL ELLIPSIS
+ ("/,," ?„) ;; DOUBLE LOW-9 QUOTATION MARK
+ ("/," ?‚) ;; SINGLE LOW-9 QUOTATION MARK
+ ("/''" ?”) ;; RIGHT DOUBLE QUOTATION MARK
+ ("/'" ?’) ;; RIGHT SINGLE QUOTATION MARK
+ ("/``" ?“) ;; LEFT DOUBLE QUOTATION MARK
+ ("/`" ?‘) ;; LEFT SINGLE QUOTATION MARK
+ ("/<<" ?«) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+ ("/>>" ?») ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+
+ ("/&" ?§)
+ ("/ab" ?§) ; _аб_зац
+ ("/pa" ?§) ; _pa_ragraph
+ ("/#" ?№)
+ ("/no" ?№) ; _но_мер
+
+ ("/c" ?©)
+ ("/tm" ?™)
+ ("/reg" ?®)
+ ("/eu" ?€)
+ ("/ce" ?¢)
+
+ ;; fractions
+ ("/78" ?⅞)
+ ("/58" ?⅝)
+ ("/38" ?⅜)
+ ("/18" ?⅛)
+ ("/56" ?⅚)
+ ("/16" ?⅙)
+ ("/45" ?⅘)
+ ("/35" ?⅗)
+ ("/25" ?⅖)
+ ("/15" ?⅕)
+ ("/23" ?⅔)
+ ("/13" ?⅓)
+ ("/34" ?¾)
+ ("/12" ?½)
+ ("/14" ?¼)
+
+ ;; Roman numerals, commonly used for months and section/subsection numbers
+ ("/RI" ?Ⅰ)
+ ("/RII" ?Ⅱ)
+ ("/RIII" ?Ⅲ)
+ ("/RIV" ?Ⅳ)
+ ("/RV" ?Ⅴ)
+ ("/RVI" ?Ⅵ)
+ ("/RVII" ?Ⅶ)
+ ("/RVIII" ?Ⅷ)
+ ("/RIX" ?Ⅸ)
+ ("/RX" ?Ⅹ)
+ ("/RXI" ?Ⅺ)
+ ("/RXII" ?Ⅻ)
+
+ ("/ri" ?ⅰ)
+ ("/rii" ?ⅱ)
+ ("/riii" ?ⅲ)
+ ("/riv" ?ⅳ)
+ ("/rv" ?ⅴ)
+ ("/rvi" ?ⅵ)
+ ("/rvii" ?ⅶ)
+ ("/rviii" ?ⅷ)
+ ("/rix" ?ⅸ)
+ ("/rx" ?ⅹ)
+ ("/rxi" ?ⅺ)
+ ("/rxii" ?ⅻ)
+)
+
+;; Originally from Yudit's `Belarusian input table according to
+;; STB955-94 belarusian standard' (not all) by Alexander Mikhailian
+;; <mikhailian@altern.org>, subsequently amended by AM.
+(quail-define-package
+ "belarusian" "Belarusian" "BE" nil
+ "ЙЦУКЕН keyboard layout registered as STB955-94 Belarusian standard.
+Unicode based."
+ nil t t t t nil nil nil nil nil t)
+
+;; ёЁ 1! 2" 3N 4; 5% 6: 7? 8* 9( 0) -_ =+
+;; Й Ц У К Е Н Г Ш Ў З Х '
+;; Ф Ы В А П Р О Л Д Ж Э
+;; Я Ч С М І Т Ь Б Ю .,
+
+(quail-define-rules
+ ("~" ?Ё)
+ ("@" ?\")
+ ("#" ?№)
+ ("$" ?\;)
+ ("%" ?%)
+ ("^" ?:)
+ ("&" ??)
+ ("Q" ?Й)
+ ("W" ?Ц)
+ ("E" ?У)
+ ("R" ?К)
+ ("T" ?Е)
+ ("Y" ?Н)
+ ("U" ?Г)
+ ("I" ?Ш)
+ ("O" ?Ў)
+ ("P" ?З)
+ ("{" ?Х)
+ ("}" ?')
+ ("A" ?Ф)
+ ("S" ?Ы)
+ ("D" ?В)
+ ("F" ?А)
+ ("G" ?П)
+ ("H" ?Р)
+ ("J" ?О)
+ ("K" ?Л)
+ ("L" ?Д)
+ (":" ?Ж)
+ ("\"" ?Э)
+ ("|" ?|)
+ ("Z" ?Я)
+ ("X" ?Ч)
+ ("C" ?С)
+ ("V" ?М)
+ ("B" ?І)
+ ("N" ?Т)
+ ("M" ?Ь)
+ ("<" ?Б)
+ (">" ?Ю)
+ ("?" ?,)
+
+ ("`" ?ё)
+ ("q" ?й)
+ ("w" ?ц)
+ ("e" ?у)
+ ("r" ?к)
+ ("t" ?е)
+ ("y" ?н)
+ ("u" ?г)
+ ("i" ?ш)
+ ("o" ?ў)
+ ("p" ?з)
+ ("[" ?х)
+ ("]" ?')
+ ("a" ?ф)
+ ("s" ?ы)
+ ("d" ?в)
+ ("f" ?а)
+ ("g" ?п)
+ ("h" ?р)
+ ("j" ?о)
+ ("k" ?л)
+ ("l" ?д)
+ (";" ?ж)
+ ("'" ?э)
+ ("z" ?я)
+ ("x" ?ч)
+ ("c" ?с)
+ ("v" ?м)
+ ("b" ?і)
+ ("n" ?т)
+ ("m" ?ь)
+ ("," ?б)
+ ("." ?ю)
+ ("/" ?.))
+
+(quail-define-package
+ "bulgarian-alt-phonetic" "Bulgarian" "БНФ"
+ nil
+ "Bulgarian alternative Phonetic keyboard layout, producing Unicode.
+
+This phonetic layout replaces all the Latin letters with Bulgarian
+\(Cyrillic) letters based on similarities in their pronunciation or look.
+
+Note that, since the letters `щ', `ь', `ю' and `я' are attached to the
+`]', `\\', `\\=`' and `[' keys respectively, Caps Lock does not affect them."
+nil t t t t nil nil nil nil nil t)
+
+;; Ю 1! 2@ 3№ 4$ 5% 6€ 7§ 8* 9( 0) -– =+ ьѝ
+;; Ч Ш Е Р Т Ъ У И О П Я Щ
+;; А С Д Ф Г Х Й К Л :; '"
+;; З Ж Ц В Б Н М ,„ .“ /?
+
+(quail-define-rules
+ ("#" ?№)
+ ("&" ?§)
+ ("/#" ?#)
+ ("/&" ?&)
+ ("/<" ?<)
+ ("/>" ?>)
+ ("/[" ?\[)
+ ("/\\" ?\\)
+ ("/]" ?\])
+ ("/^" ?^)
+ ("/_" ?_)
+ ("/`" ?`)
+ ("/{" ?{)
+ ("/|" ?|)
+ ("/}" ?})
+ ("/~" ?~)
+ ("<" ?„)
+ (">" ?“)
+ ("A" ?А) ("a" ?а)
+ ("B" ?Б) ("b" ?б)
+ ("C" ?Ц) ("c" ?ц)
+ ("D" ?Д) ("d" ?д)
+ ("E" ?Е) ("e" ?е)
+ ("F" ?Ф) ("f" ?ф)
+ ("G" ?Г) ("g" ?г)
+ ("H" ?Х) ("h" ?х)
+ ("I" ?И) ("i" ?и)
+ ("J" ?Й) ("j" ?й)
+ ("K" ?К) ("k" ?к)
+ ("L" ?Л) ("l" ?л)
+ ("M" ?М) ("m" ?м)
+ ("N" ?Н) ("n" ?н)
+ ("O" ?О) ("o" ?о)
+ ("P" ?П) ("p" ?п)
+ ("Q" ?Ч) ("q" ?ч)
+ ("R" ?Р) ("r" ?р)
+ ("S" ?С) ("s" ?с)
+ ("T" ?Т) ("t" ?т)
+ ("U" ?У) ("u" ?у)
+ ("V" ?В) ("v" ?в)
+ ("W" ?Ш) ("w" ?ш)
+ ("X" ?Ж) ("x" ?ж)
+ ("Y" ?Ъ) ("y" ?ъ)
+ ("Z" ?З) ("z" ?з)
+ ("[" ?я)
+ ("\\" ?ь)
+ ("]" ?щ)
+ ("^" ?€)
+ ("_" ?–)
+ ("`" ?ю)
+ ("{" ?Я)
+ ("|" ?ѝ)
+ ("}" ?Щ)
+ ("~" ?Ю))
+
+;; From `Bulgarian-PHO.kmap for Yudit', Alexander Shopov
+;; <al_shopov@web.bg>.
+
+;; Extra commentary and the indicator from an independent
+;; (cyrillic-iso8859-5) implementation by Ognyan Kulev
+;; <ogi@fmi.uni-sofia.bg> and name changes from Anton Zinoviev
+;; <anton@lml.bas.bg>.
+(quail-define-package
+ "bulgarian-phonetic" "Bulgarian" "ЖБФ"
+ nil
+ "Bulgarian Phonetic keyboard layout, producing Unicode.
+
+The layout is similar to `cyrillic-translit', but all Bulgarian
+characters are typed with a single key.
+
+Use /& for § (Cyrillic paragraph) and /# for №.
+
+The letters Ч, Ш, Щ and Ю are not affected by Caps Lock."
+ nil t t t t nil nil nil nil nil t)
+
+;; Ч
+;; Я В Е Р Т Ъ У И О П Ш Щ
+;; А С Д Ф Г Х Й К Л Ю
+;; З ьѝ Ц Ж Б Н М
+
+(quail-define-rules
+ ("/&" ?§)
+ ("/#" ?№)
+ ("A" ?А)
+ ("B" ?Б)
+ ("W" ?В)
+ ("G" ?Г)
+ ("D" ?Д)
+ ("E" ?Е)
+ ("V" ?Ж)
+ ("Z" ?З)
+ ("I" ?И)
+ ("J" ?Й)
+ ("K" ?К)
+ ("L" ?Л)
+ ("M" ?М)
+ ("N" ?Н)
+ ("O" ?О)
+ ("P" ?П)
+ ("R" ?Р)
+ ("S" ?С)
+ ("T" ?Т)
+ ("U" ?У)
+ ("F" ?Ф)
+ ("H" ?Х)
+ ("C" ?Ц)
+ ("~" ?Ч)
+ ("{" ?Ш)
+ ("}" ?Щ)
+ ("Y" ?Ъ)
+ ("X" ?ѝ)
+ ("|" ?Ю)
+ ("Q" ?Я)
+ ("a" ?а)
+ ("b" ?б)
+ ("w" ?в)
+ ("g" ?г)
+ ("d" ?д)
+ ("e" ?е)
+ ("v" ?ж)
+ ("z" ?з)
+ ("i" ?и)
+ ("j" ?й)
+ ("k" ?к)
+ ("l" ?л)
+ ("m" ?м)
+ ("n" ?н)
+ ("o" ?о)
+ ("p" ?п)
+ ("r" ?р)
+ ("s" ?с)
+ ("t" ?т)
+ ("u" ?у)
+ ("f" ?ф)
+ ("h" ?х)
+ ("c" ?ц)
+ ("`" ?ч)
+ ("[" ?ш)
+ ("]" ?щ)
+ ("y" ?ъ)
+ ("x" ?ь)
+ ("\\" ?ю)
+ ("q" ?я))
+
+;; Based on an implementation by Ognyan Kulev <ogi@fmi.uni-sofia.bg>.
+;; This follows XKB bg.
+
+(quail-define-package
+ "bulgarian-bds" "Bulgarian" "БДС" nil
+ "Bulgarian standard keyboard layout (BDS)
+
+This keyboard layout is standard for Bulgarian typewriters.
+
+The letters Ц, М, Ч, Р, Л, Б and Ы are not affected by Caps Lock.
+
+In addition to original Bulgarian typewriter layout, keys \\ and |
+are transformed into \\=' and Ы respectively. Some keyboards mark these
+keys as being transformed into ( and ) respectively. For ( and ), use
+\\=` and ~ respectively. This input method follows XKB."
+ nil t t t t nil nil nil nil nil t)
+
+;; () 1! 2? 3+ 4" 5% 6= 7: 8/ 9_ 0№ -I .V
+;; ,ы У Е И Ш Щ К С Д З Ц ;§
+;; ьѝ Я А О Ж Г Т Н В М Ч 'Ы
+;; Ю Й Ъ Э Ф Х П Р Л Б
+
+(quail-define-rules
+
+ ("1" ?1) ("!" ?!)
+ ("2" ?2) ("@" ??)
+ ("3" ?3) ("#" ?+)
+ ("4" ?4) ("$" ?\")
+ ("5" ?5) ("%" ?%)
+ ("6" ?6) ("^" ?=)
+ ("7" ?7) ("&" ?:)
+ ("8" ?8) ("*" ?/)
+ ("9" ?9) ("(" ?_)
+ ("0" ?0) (")" ?№)
+ ("-" ?-) ("_" ?I)
+ ("=" ?.) ("+" ?V)
+
+ ("q" ?,) ("Q" ?ы)
+ ("w" ?у) ("W" ?У)
+ ("e" ?е) ("E" ?Е)
+ ("r" ?и) ("R" ?И)
+ ("t" ?ш) ("T" ?Ш)
+ ("y" ?щ) ("Y" ?Щ)
+ ("u" ?к) ("U" ?К)
+ ("i" ?с) ("I" ?С)
+ ("o" ?д) ("O" ?Д)
+ ("p" ?з) ("P" ?З)
+ ("[" ?ц) ("{" ?Ц)
+ ("]" ?\;) ("}" ?§)
+
+ ("a" ?ь) ("A" ?ѝ)
+ ("s" ?я) ("S" ?Я)
+ ("d" ?а) ("D" ?А)
+ ("f" ?о) ("F" ?О)
+ ("g" ?ж) ("G" ?Ж)
+ ("h" ?г) ("H" ?Г)
+ ("j" ?т) ("J" ?Т)
+ ("k" ?н) ("K" ?Н)
+ ("l" ?в) ("L" ?В)
+ (";" ?м) (":" ?М)
+ ("'" ?ч) ("\"" ?Ч)
+ ("`" ?\() ("~" ?\))
+
+ ("z" ?ю) ("Z" ?Ю)
+ ("x" ?й) ("X" ?Й)
+ ("c" ?ъ) ("C" ?Ъ)
+ ("v" ?э) ("V" ?Э)
+ ("b" ?ф) ("B" ?Ф)
+ ("n" ?х) ("N" ?Х)
+ ("m" ?п) ("M" ?П)
+ ("," ?р) ("<" ?Р)
+ ("." ?л) (">" ?Л)
+ ("/" ?б) ("?" ?Б)
+ ("\\" ?') ("|" ?Ы))
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; cyrillic.el ends here
diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el
new file mode 100644
index 00000000000..18e0ec693c5
--- /dev/null
+++ b/lisp/leim/quail/czech.el
@@ -0,0 +1,568 @@
+;;; czech.el --- Quail package for inputting Czech -*-coding: utf-8;-*-
+
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Milan Zamazal <pdm@zamazal.org>
+;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Keywords: i18n, multilingual, input method, Czech
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines the following Czech keyboards:
+;; - "standard" Czech keyboard in the Windoze NT 105 keys version (both
+;; "QWERTZ" and "QWERTY" versions)
+;; - three non-standard Czech keyboards for programmers
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "czech" "Czech" "CZ" t
+ "\"Standard\" Czech keyboard in the Windows NT 105 keys version."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ě)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ř)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("-" ?=)
+ ("_" ?%)
+ ("[" ?ú)
+ ("{" ?/)
+ ("]" ?\))
+ ("}" ?\()
+ ("|" ?`)
+ (";" ?ů)
+ (":" ?\")
+ ("'" ?§)
+ ("\"" ?!)
+ ("<" ??)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("`" ?\;)
+ ("y" ?z)
+ ("z" ?y)
+ ("Y" ?Z)
+ ("Z" ?Y)
+ ("\\a" ?ä)
+ ("\\o" ?ö)
+ ("\\s" ?ß)
+ ("\\u" ?ü)
+ ("\\A" ?Ä)
+ ("\\O" ?Ö)
+ ("\\S" ?ß)
+ ("\\U" ?Ü)
+ ("~u" ?ů)
+ ("~U" ?Ů)
+ ("=a" ?á)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+r" ?ř)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("=z" ?ý)
+ ("+y" ?ž)
+ ("=A" ?Á)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+R" ?Ř)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("=Z" ?Ý)
+ ("+Y" ?Ž)
+ ("=1" ?!)
+ ("=2" ?@)
+ ("=3" ?#)
+ ("=4" ?$)
+ ("=5" ?%)
+ ("=6" ?^)
+ ("=7" ?&)
+ ("=8" ?*)
+ ("=9" ?\()
+ ("=0" ?\))
+ ("+1" ?!)
+ ("+2" ?@)
+ ("+3" ?#)
+ ("+4" ?$)
+ ("+5" ?%)
+ ("+6" ?^)
+ ("+7" ?&)
+ ("+8" ?*)
+ ("+9" ?\()
+ ("+0" ?\))
+ ("=<" ?<)
+ ("=>" ?>)
+ ("=[" ?\[)
+ ("=]" ?\])
+ ("={" ?{)
+ ("=}" ?})
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+(quail-define-package
+ "czech-qwerty" "Czech" "CZ" t
+ "\"Standard\" Czech keyboard in the Windows NT 105 keys version, QWERTY layout."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ě)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ř)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("-" ?=)
+ ("_" ?%)
+ ("[" ?ú)
+ ("{" ?/)
+ ("]" ?\))
+ ("}" ?\()
+ ("|" ?`)
+ (";" ?ů)
+ (":" ?\")
+ ("'" ?§)
+ ("\"" ?!)
+ ("<" ??)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("`" ?\;)
+ ("\\a" ?ä)
+ ("\\o" ?ö)
+ ("\\s" ?ß)
+ ("\\u" ?ü)
+ ("\\A" ?Ä)
+ ("\\O" ?Ö)
+ ("\\S" ?ß)
+ ("\\U" ?Ü)
+ ("~u" ?ů)
+ ("~U" ?Ů)
+ ("=a" ?á)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+r" ?ř)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("=y" ?ý)
+ ("+z" ?ž)
+ ("=A" ?Á)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+R" ?Ř)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=Y" ?Ý)
+ ("+Z" ?Ž)
+ ("=U" ?Ú)
+ ("=1" ?!)
+ ("=2" ?@)
+ ("=3" ?#)
+ ("=4" ?$)
+ ("=5" ?%)
+ ("=6" ?^)
+ ("=7" ?&)
+ ("=8" ?*)
+ ("=9" ?\()
+ ("=0" ?\))
+ ("+1" ?!)
+ ("+2" ?@)
+ ("+3" ?#)
+ ("+4" ?$)
+ ("+5" ?%)
+ ("+6" ?^)
+ ("+7" ?&)
+ ("+8" ?*)
+ ("+9" ?\()
+ ("+0" ?\))
+ ("=<" ?<)
+ ("=>" ?>)
+ ("=[" ?\[)
+ ("=]" ?\])
+ ("={" ?{)
+ ("=}" ?})
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+(quail-define-package
+ "czech-prog-1" "Czech" "CZ" t
+ "Czech (non-standard) keyboard for programmers #1.
+
+All digits except of `1' are replaced by Czech characters as on the standard
+Czech keyboard.
+`1' is replaced by `+'.
+`+' is a dead key. Multiple presses of the dead key generate various accents.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ě)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ř)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("+1" ?1)
+ ("+2" ?2)
+ ("+3" ?3)
+ ("+4" ?4)
+ ("+5" ?5)
+ ("+6" ?6)
+ ("+7" ?7)
+ ("+8" ?8)
+ ("+9" ?9)
+ ("+0" ?0)
+ ("+a" ?á)
+ ("++a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("+e" ?é)
+ ("++e" ?ě)
+ ("+i" ?í)
+ ("+l" ?ĺ)
+ ("++l" ?ľ)
+ ("+n" ?ň)
+ ("+o" ?ó)
+ ("++o" ?ö)
+ ("+++o" ?ô)
+ ("+r" ?ř)
+ ("++r" ?ŕ)
+ ("+s" ?š)
+ ("++s" ?ß)
+ ("+t" ?ť)
+ ("+u" ?ú)
+ ("++u" ?ů)
+ ("+++u" ?ü)
+ ("+y" ?ý)
+ ("+z" ?ž)
+ ("+A" ?Á)
+ ("++A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("+E" ?É)
+ ("++E" ?Ě)
+ ("+I" ?Í)
+ ("+L" ?Ĺ)
+ ("++L" ?Ľ)
+ ("+N" ?Ň)
+ ("+O" ?Ó)
+ ("++O" ?Ö)
+ ("+++O" ?Ô)
+ ("+R" ?Ř)
+ ("++R" ?Ŕ)
+ ("+S" ?Š)
+ ("++S" ?ß)
+ ("+T" ?Ť)
+ ("+U" ?Ú)
+ ("++U" ?Ů)
+ ("+++U" ?Ü)
+ ("+Y" ?Ý)
+ ("+Z" ?Ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+(quail-define-package
+ "czech-prog-2" "Czech" "CZ" t
+ "Czech (non-standard) keyboard for programmers #2.
+
+All digits except of `1' are replaced by Czech characters as on the standard
+Czech keyboard.
+`1' is replaced by `ů'.
+`+' is a dead key. Multiple presses of the dead key generate various accents.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?ů)
+ ("2" ?ě)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ř)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("+1" ?1)
+ ("+2" ?2)
+ ("+3" ?3)
+ ("+4" ?4)
+ ("+5" ?5)
+ ("+6" ?6)
+ ("+7" ?7)
+ ("+8" ?8)
+ ("+9" ?9)
+ ("+0" ?0)
+ ("+a" ?á)
+ ("++a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("+e" ?é)
+ ("++e" ?ě)
+ ("+i" ?í)
+ ("+l" ?ĺ)
+ ("++l" ?ľ)
+ ("+n" ?ň)
+ ("+o" ?ó)
+ ("++o" ?ö)
+ ("+++o" ?ô)
+ ("+r" ?ř)
+ ("++r" ?ŕ)
+ ("+s" ?š)
+ ("++s" ?ß)
+ ("+t" ?ť)
+ ("+u" ?ú)
+ ("++u" ?ů)
+ ("+++u" ?ü)
+ ("+y" ?ý)
+ ("+z" ?ž)
+ ("+A" ?Á)
+ ("++A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("+E" ?É)
+ ("++E" ?Ě)
+ ("+I" ?Í)
+ ("+L" ?Ĺ)
+ ("++L" ?Ľ)
+ ("+N" ?Ň)
+ ("+O" ?Ó)
+ ("++O" ?Ö)
+ ("+++O" ?Ô)
+ ("+R" ?Ř)
+ ("++R" ?Ŕ)
+ ("+S" ?Š)
+ ("++S" ?ß)
+ ("+T" ?Ť)
+ ("+U" ?Ú)
+ ("++U" ?Ů)
+ ("+++U" ?Ü)
+ ("+Y" ?Ý)
+ ("+Z" ?Ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+(quail-define-package
+ "czech-prog-3" "Czech" "CZ" t
+ "Czech (non-standard) keyboard for programmers compatible with the default
+keyboard from the obsolete `emacs-czech' package.
+
+All digits except of `1' are replaced by Czech characters as on the standard
+Czech keyboard.
+`[' and `]' are replaced with `ú' and `ů', respectively.
+There are two dead keys on `=' and `+'. Characters with diaereses are
+accessible through `+='.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("2" ?ě)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ř)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("[" ?ú)
+ ("]" ?ů)
+ ("==" ?=)
+ ("++" ?+)
+ ("=+" ?+)
+ ("=[" ?\[)
+ ("=]" ?\])
+ ("+[" ?\[)
+ ("+]" ?\])
+ ("=1" ?1)
+ ("=2" ?2)
+ ("=3" ?3)
+ ("=4" ?4)
+ ("=5" ?5)
+ ("=6" ?6)
+ ("=7" ?7)
+ ("=8" ?8)
+ ("=9" ?9)
+ ("=0" ?0)
+ ("+1" ?1)
+ ("+2" ?2)
+ ("+3" ?3)
+ ("+4" ?4)
+ ("+5" ?5)
+ ("+6" ?6)
+ ("+7" ?7)
+ ("+8" ?8)
+ ("+9" ?9)
+ ("+0" ?0)
+ ("=A" ?Á)
+ ("+A" ?Ä)
+ ("+=A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("=L" ?Ľ)
+ ("+L" ?Ĺ)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+O" ?Ô)
+ ("+=O" ?Ö)
+ ("=R" ?Ŕ)
+ ("+R" ?Ř)
+ ("+S" ?Š)
+ ("=S" ?ß)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("+U" ?Ů)
+ ("+=U" ?Ü)
+ ("=Y" ?Ý)
+ ("+Z" ?Ž)
+ ("=a" ?á)
+ ("+a" ?ä)
+ ("+=a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("=l" ?ľ)
+ ("+l" ?ĺ)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+o" ?ô)
+ ("+=o" ?ö)
+ ("=r" ?ŕ)
+ ("+r" ?ř)
+ ("+s" ?š)
+ ("=s" ?ß)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("+u" ?ů)
+ ("+=u" ?ü)
+ ("=y" ?ý)
+ ("+z" ?ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+;;; czech.el ends here
diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el
new file mode 100644
index 00000000000..eaf3a03bafa
--- /dev/null
+++ b/lisp/leim/quail/ethiopic.el
@@ -0,0 +1,1149 @@
+;;; ethiopic.el --- Quail package for inputting Ethiopic characters -*-coding: utf-8-emacs;-*-
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, ethiopic
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'ethio-util)
+
+;;
+;; The package "ethiopic"
+;;
+
+(quail-define-package
+ "ethiopic" "Ethiopic"
+ '("ፊደል "
+ (ethio-prefer-ascii-space "_" "፡")
+ "።")
+ t " Quail package for Ethiopic (Tigrigna and Amharic)
+
+When you are in Ethiopic language environment, the following special
+keys are available.
+
+C-F9 or `M-x ethio-toggle-space'
+ Toggles space characters for keyboard input. The current mode is
+ indicated in mode-line, whether by `_' (ASCII space) or `፡'
+ (Ethiopic colon-like word separator). Even in the `፡' mode, an
+ ASCII space is inserted if the point is preceded by an Ethiopic
+ punctuation char that is followed by zero or more ASCII spaces.
+
+S-F5 or `M-x ethio-toggle-punctuation'
+ Toggles ASCII punctuation and Ethiopic punctuation for keyboard input.
+ The current mode is indicated by `.' (ASCII) or `።' (Ethiopic).
+
+S-SPC or `M-x ethio-insert-ethio-space'
+ Always insert an Ethiopic word separator `፡'. With a prefix number,
+ insert that many word separators.
+
+C-\\=' or `M-x ethio-gemination'
+ Compose the character before the point with the Ethiopic gemination mark.
+ If the character is already composed, decompose it and remove the
+ gemination mark."
+
+ ;; The following keys should work as defined in lisp/language/ethio-util,
+ ;; even during the translation.
+ '(([C-f9] . quail-execute-non-quail-command)
+ ([S-f5] . quail-execute-non-quail-command)
+ (" " . quail-execute-non-quail-command)
+ ([?\S- ] . quail-execute-non-quail-command)
+ ([?\C-'] . quail-execute-non-quail-command))
+ t t)
+
+(quail-define-rules
+ ("he" ?ሀ)
+ ("hu" ?ሁ)
+ ("hi" ?ሂ)
+ ("ha" ?ሃ)
+ ("hE" ?ሄ)
+ ("hee" ?ሄ)
+ ("h" ?ህ)
+ ("ho" ?ሆ)
+ ("hW" ?ኋ)
+ ("hWa" ?ኋ)
+ ("hWe" ?ኈ)
+ ("hWu" ?ኍ)
+ ("hWi" ?ኊ)
+ ("hWE" ?ኌ)
+ ("hW'" ?ኍ)
+
+ ("le" ?ለ)
+ ("lu" ?ሉ)
+ ("li" ?ሊ)
+ ("la" ?ላ)
+ ("lE" ?ሌ)
+ ("lee" ?ሌ)
+ ("l" ?ል)
+ ("lo" ?ሎ)
+ ("lW" ?ሏ)
+ ("lWa" ?ሏ)
+ ("lWe" ["ል"])
+ ("lWu" ["ል"])
+ ("lWi" ["ል"])
+ ("lWE" ["ል"])
+ ("lW'" ["ል"])
+
+ ("Le" ?ለ)
+ ("Lu" ?ሉ)
+ ("Li" ?ሊ)
+ ("La" ?ላ)
+ ("LE" ?ሌ)
+ ("Lee" ?ሌ)
+ ("L" ?ል)
+ ("Lo" ?ሎ)
+ ("LW" ?ሏ)
+ ("LWa" ?ሏ)
+ ("LWe" ["ል"])
+ ("LWu" ["ል"])
+ ("LWi" ["ል"])
+ ("LWE" ["ል"])
+ ("LW'" ["ል"])
+
+ ("He" ?ሐ)
+ ("Hu" ?ሑ)
+ ("Hi" ?ሒ)
+ ("Ha" ?ሓ)
+ ("HE" ?ሔ)
+ ("Hee" ?ሔ)
+ ("H" ?ሕ)
+ ("Ho" ?ሖ)
+ ("HW" ?ሗ)
+ ("HWa" ?ሗ)
+ ("HWe" ["ሕ"])
+ ("HWu" ["ሕ"])
+ ("HWi" ["ሕ"])
+ ("HWE" ["ሕ"])
+ ("HW'" ["ሕ"])
+
+ ("me" ?መ)
+ ("mu" ?ሙ)
+ ("mi" ?ሚ)
+ ("ma" ?ማ)
+ ("mE" ?ሜ)
+ ("mee" ?ሜ)
+ ("m" ?ም)
+ ("mo" ?ሞ)
+ ("mWe" ?)
+ ("mWu" ?)
+ ("mWi" ?)
+ ("mW" ?ሟ)
+ ("mWa" ?ሟ)
+ ("mWE" ?)
+ ("mWee" ?)
+ ("mW'" ?)
+ ("mY" ?ፘ)
+ ("mYa" ?ፘ)
+
+ ("Me" ?መ)
+ ("Mu" ?ሙ)
+ ("Mi" ?ሚ)
+ ("Ma" ?ማ)
+ ("ME" ?ሜ)
+ ("Mee" ?ሜ)
+ ("M" ?ም)
+ ("Mo" ?ሞ)
+ ("MWe" ?)
+ ("MWu" ?)
+ ("MWi" ?)
+ ("MW" ?ሟ)
+ ("MWa" ?ሟ)
+ ("MWE" ?)
+ ("MWee" ?)
+ ("MW'" ?)
+ ("MY" ?ፘ)
+ ("MYa" ?ፘ)
+
+ ("`se" ?ሠ)
+ ("`su" ?ሡ)
+ ("`si" ?ሢ)
+ ("`sa" ?ሣ)
+ ("`sE" ?ሤ)
+ ("`see" ?ሤ)
+ ("`s" ?ሥ)
+ ("`so" ?ሦ)
+ ("`sW" ?ሧ)
+ ("`sWa" ?ሧ)
+ ("`sWe" ["ሥ"])
+ ("`sWu" ["ሥ"])
+ ("`sWi" ["ሥ"])
+ ("`sWE" ["ሥ"])
+ ("`sWee" ["ሥ"])
+ ("`sW'" ["ሥ"])
+
+ ("s2e" ?ሠ)
+ ("s2u" ?ሡ)
+ ("s2i" ?ሢ)
+ ("s2a" ?ሣ)
+ ("s2E" ?ሤ)
+ ("s2ee" ?ሤ)
+ ("s2" ?ሥ)
+ ("s2o" ?ሦ)
+ ("s2W" ?ሧ)
+ ("s2Wa" ?ሧ)
+ ("s2We" ["ሥ"])
+ ("s2Wu" ["ሥ"])
+ ("s2Wi" ["ሥ"])
+ ("s2WE" ["ሥ"])
+ ("s2Wee" ["ሥ"])
+ ("s2W'" ["ሥ"])
+
+ ("sse" ?ሠ)
+ ("ssu" ?ሡ)
+ ("ssi" ?ሢ)
+ ("ssa" ?ሣ)
+ ("ssE" ?ሤ)
+ ("ssee" ?ሤ)
+ ("ss" ?ሥ)
+ ("sso" ?ሦ)
+ ("ssW" ?ሧ)
+ ("ssWa" ?ሧ)
+ ("ssWe" ["ሥ"])
+ ("ssWu" ["ሥ"])
+ ("ssWi" ["ሥ"])
+ ("ssWE" ["ሥ"])
+ ("ssWee" ["ሥ"])
+ ("ssW'" ["ሥ"])
+
+ ("re" ?ረ)
+ ("ru" ?ሩ)
+ ("ri" ?ሪ)
+ ("ra" ?ራ)
+ ("rE" ?ሬ)
+ ("ree" ?ሬ)
+ ("r" ?ር)
+ ("ro" ?ሮ)
+ ("rW" ?ሯ)
+ ("rWa" ?ሯ)
+ ("rY" ?ፙ)
+ ("rYa" ?ፙ)
+ ("rWe" ["ር"])
+ ("rWu" ["ር"])
+ ("rWi" ["ር"])
+ ("rWE" ["ር"])
+ ("rWee" ["ር"])
+ ("rW'" ["ር"])
+
+ ("Re" ?ረ)
+ ("Ru" ?ሩ)
+ ("Ri" ?ሪ)
+ ("Ra" ?ራ)
+ ("RE" ?ሬ)
+ ("Ree" ?ሬ)
+ ("R" ?ር)
+ ("Ro" ?ሮ)
+ ("RW" ?ሯ)
+ ("RWa" ?ሯ)
+ ("RYa" ?ፙ)
+ ("RWe" ["ር"])
+ ("RWu" ["ር"])
+ ("RWi" ["ር"])
+ ("RWE" ["ር"])
+ ("RWee" ["ር"])
+ ("RW'" ["ር"])
+
+ ("se" ?ሰ)
+ ("su" ?ሱ)
+ ("si" ?ሲ)
+ ("sa" ?ሳ)
+ ("sE" ?ሴ)
+ ("see" ?ሴ)
+ ("s" ?ስ)
+ ("so" ?ሶ)
+ ("sW" ?ሷ)
+ ("sWa" ?ሷ)
+ ("sWe" ["ስ"])
+ ("sWu" ["ስ"])
+ ("sWi" ["ስ"])
+ ("sWE" ["ስ"])
+ ("sWee" ["ስ"])
+ ("sW'" ["ስ"])
+
+ ("xe" ?ሸ)
+ ("xu" ?ሹ)
+ ("xi" ?ሺ)
+ ("xa" ?ሻ)
+ ("xE" ?ሼ)
+ ("xee" ?ሼ)
+ ("x" ?ሽ)
+ ("xo" ?ሾ)
+ ("xW" ?ሿ)
+ ("xWa" ?ሿ)
+ ("xWe" ["ሽ"])
+ ("xWu" ["ሽ"])
+ ("xWi" ["ሽ"])
+ ("xWE" ["ሽ"])
+ ("xWee" ["ሽ"])
+ ("xW'" ["ሽ"])
+
+ ("qe" ?ቀ)
+ ("qu" ?ቁ)
+ ("qi" ?ቂ)
+ ("qa" ?ቃ)
+ ("qE" ?ቄ)
+ ("qee" ?ቄ)
+ ("q" ?ቅ)
+ ("qo" ?ቆ)
+ ("qWe" ?ቈ)
+ ("qWu" ?ቍ)
+ ("qWi" ?ቊ)
+ ("qW" ?ቋ)
+ ("qWa" ?ቋ)
+ ("qWE" ?ቌ)
+ ("qWee" ?ቌ)
+ ("qW'" ?ቍ)
+
+ ("`qe" ?)
+ ("`qu" ?)
+ ("`qi" ?)
+ ("`qa" ?)
+ ("`qE" ?)
+ ("`qee" ?)
+ ("`q" ?)
+ ("`qo" ?)
+
+ ("q2e" ?)
+ ("q2u" ?)
+ ("q2i" ?)
+ ("q2a" ?)
+ ("q2E" ?)
+ ("q2ee" ?)
+ ("q2" ?)
+ ("q2o" ?)
+
+ ("qqe" ?)
+ ("qqu" ?)
+ ("qqi" ?)
+ ("qqa" ?)
+ ("qqE" ?)
+ ("qqee" ?)
+ ("qq" ?)
+ ("qqo" ?)
+
+ ("Qe" ?ቐ)
+ ("Qu" ?ቑ)
+ ("Qi" ?ቒ)
+ ("Qa" ?ቓ)
+ ("QE" ?ቔ)
+ ("Qee" ?ቔ)
+ ("Q" ?ቕ)
+ ("Qo" ?ቖ)
+ ("QWe" ?ቘ)
+ ("QWu" ?ቝ)
+ ("QWi" ?ቚ)
+ ("QW" ?ቛ)
+ ("QWa" ?ቛ)
+ ("QWE" ?ቜ)
+ ("QWee" ?ቜ)
+ ("QW'" ?ቝ)
+
+ ("be" ?በ)
+ ("bu" ?ቡ)
+ ("bi" ?ቢ)
+ ("ba" ?ባ)
+ ("bE" ?ቤ)
+ ("bee" ?ቤ)
+ ("b" ?ብ)
+ ("bo" ?ቦ)
+ ("bWe" ?)
+ ("bWu" ?)
+ ("bWi" ?)
+ ("bW" ?ቧ)
+ ("bWa" ?ቧ)
+ ("bWE" ?)
+ ("bWee" ?)
+ ("bW'" ?)
+
+ ("Be" ?በ)
+ ("Bu" ?ቡ)
+ ("Bi" ?ቢ)
+ ("Ba" ?ባ)
+ ("BE" ?ቤ)
+ ("Bee" ?ቤ)
+ ("B" ?ብ)
+ ("Bo" ?ቦ)
+ ("BWe" ?)
+ ("BWu" ?)
+ ("BWi" ?)
+ ("BW" ?ቧ)
+ ("BWa" ?ቧ)
+ ("BWE" ?)
+ ("BWee" ?)
+ ("BW'" ?)
+
+ ("ve" ?ቨ)
+ ("vu" ?ቩ)
+ ("vi" ?ቪ)
+ ("va" ?ቫ)
+ ("vE" ?ቬ)
+ ("vee" ?ቬ)
+ ("v" ?ቭ)
+ ("vo" ?ቮ)
+ ("vW" ?ቯ)
+ ("vWa" ?ቯ)
+ ("vWe" ["ቭ"])
+ ("vWu" ["ቭ"])
+ ("vWi" ["ቭ"])
+ ("vWE" ["ቭ"])
+ ("vWee" ["ቭ"])
+ ("vW'" ["ቭ"])
+
+ ("Ve" ?ቨ)
+ ("Vu" ?ቩ)
+ ("Vi" ?ቪ)
+ ("Va" ?ቫ)
+ ("VE" ?ቬ)
+ ("Vee" ?ቬ)
+ ("V" ?ቭ)
+ ("Vo" ?ቮ)
+ ("VW" ?ቯ)
+ ("VWa" ?ቯ)
+ ("VWe" ["ቭ"])
+ ("VWu" ["ቭ"])
+ ("VWi" ["ቭ"])
+ ("VWE" ["ቭ"])
+ ("VWee" ["ቭ"])
+ ("VW'" ["ቭ"])
+
+ ("te" ?ተ)
+ ("tu" ?ቱ)
+ ("ti" ?ቲ)
+ ("ta" ?ታ)
+ ("tE" ?ቴ)
+ ("tee" ?ቴ)
+ ("t" ?ት)
+ ("to" ?ቶ)
+ ("tW" ?ቷ)
+ ("tWa" ?ቷ)
+ ("tWe" ["ት"])
+ ("tWu" ["ት"])
+ ("tWi" ["ት"])
+ ("tWE" ["ት"])
+ ("tWee" ["ት"])
+ ("tW'" ["ት"])
+
+ ("ce" ?ቸ)
+ ("cu" ?ቹ)
+ ("ci" ?ቺ)
+ ("ca" ?ቻ)
+ ("cE" ?ቼ)
+ ("cee" ?ቼ)
+ ("c" ?ች)
+ ("co" ?ቾ)
+ ("cW" ?ቿ)
+ ("cWa" ?ቿ)
+ ("cWe" ["ች"])
+ ("cWu" ["ች"])
+ ("cWi" ["ች"])
+ ("cWE" ["ች"])
+ ("cWee" ["ች"])
+ ("cW'" ["ች"])
+
+ ("`he" ?ኀ)
+ ("`hu" ?ኁ)
+ ("`hi" ?ኂ)
+ ("`ha" ?ኃ)
+ ("`hE" ?ኄ)
+ ("`hee" ?ኄ)
+ ("`h" ?ኅ)
+ ("`ho" ?ኆ)
+ ("`hWe" ?ኈ)
+ ("`hWu" ?ኍ)
+ ("`hWi" ?ኊ)
+ ("`hW" ?ኋ)
+ ("`hWa" ?ኋ)
+ ("`hWE" ?ኌ)
+ ("`hWee" ?ኌ)
+ ("`hW'" ?ኍ)
+
+ ("h2e" ?ኀ)
+ ("h2u" ?ኁ)
+ ("h2i" ?ኂ)
+ ("h2a" ?ኃ)
+ ("h2E" ?ኄ)
+ ("h2ee" ?ኄ)
+ ("h2" ?ኅ)
+ ("h2o" ?ኆ)
+ ("h2We" ?ኈ)
+ ("h2Wu" ?ኍ)
+ ("h2Wi" ?ኊ)
+ ("h2W" ?ኋ)
+ ("h2Wa" ?ኋ)
+ ("h2WE" ?ኌ)
+ ("h2Wee" ?ኌ)
+ ("h2W'" ?ኍ)
+
+ ("hhe" ?ኀ)
+ ("hhu" ?ኁ)
+ ("hhi" ?ኂ)
+ ("hha" ?ኃ)
+ ("hhE" ?ኄ)
+ ("hhee" ?ኄ)
+ ("hh" ?ኅ)
+ ("hho" ?ኆ)
+ ("hhWe" ?ኈ)
+ ("hhWu" ?ኍ)
+ ("hhWi" ?ኊ)
+ ("hhW" ?ኋ)
+ ("hhWa" ?ኋ)
+ ("hhWE" ?ኌ)
+ ("hhWee" ?ኌ)
+ ("hhW'" ?ኍ)
+
+ ("ne" ?ነ)
+ ("nu" ?ኑ)
+ ("ni" ?ኒ)
+ ("na" ?ና)
+ ("nE" ?ኔ)
+ ("nee" ?ኔ)
+ ("n" ?ን)
+ ("no" ?ኖ)
+ ("nW" ?ኗ)
+ ("nWa" ?ኗ)
+ ("nWe" ["ን"])
+ ("nWu" ["ን"])
+ ("nWi" ["ን"])
+ ("nWE" ["ን"])
+ ("nWee" ["ን"])
+ ("nW'" ["ን"])
+
+ ("Ne" ?ኘ)
+ ("Nu" ?ኙ)
+ ("Ni" ?ኚ)
+ ("Na" ?ኛ)
+ ("NE" ?ኜ)
+ ("Nee" ?ኜ)
+ ("N" ?ኝ)
+ ("No" ?ኞ)
+ ("NW" ?ኟ)
+ ("NWa" ?ኟ)
+ ("NWe" ["ኝ"])
+ ("NWu" ["ኝ"])
+ ("NWi" ["ኝ"])
+ ("NWE" ["ኝ"])
+ ("NWee" ["ኝ"])
+ ("NW'" ["ኝ"])
+
+ ; ("e" ?አ) ; old style
+ ("u" ?ኡ)
+ ("U" ?ኡ)
+ ("i" ?ኢ)
+ ("a" ?ኣ)
+ ("A" ?ኣ)
+ ("E" ?ኤ)
+ ; ("ee" ?ኤ) ; Alef-E is rare vs Aynu-I, so ee = Aynu-I
+ ("I" ?እ)
+ ("e" ?እ) ; This is the premise to "new style" for vowels
+
+ ("o" ?ኦ)
+ ("O" ?ኦ)
+ ("ea" ?ኧ)
+
+ ("ke" ?ከ)
+ ("ku" ?ኩ)
+ ("ki" ?ኪ)
+ ("ka" ?ካ)
+ ("kE" ?ኬ)
+ ("kee" ?ኬ)
+ ("k" ?ክ)
+ ("ko" ?ኮ)
+ ("kWe" ?ኰ)
+ ("kWu" ?ኵ)
+ ("kWi" ?ኲ)
+ ("kW" ?ኳ)
+ ("kWa" ?ኳ)
+ ("kWE" ?ኴ)
+ ("kWee" ?ኴ)
+ ("kW'" ?ኵ)
+
+ ("`ke" ?)
+ ("`ku" ?)
+ ("`ki" ?)
+ ("`ka" ?)
+ ("`kE" ?)
+ ("`kee" ?)
+ ("`k" ?)
+ ("`ko" ?)
+
+ ("k2e" ?)
+ ("k2u" ?)
+ ("k2i" ?)
+ ("k2a" ?)
+ ("k2E" ?)
+ ("k2ee" ?)
+ ("k2" ?)
+ ("k2o" ?)
+
+ ("kke" ?)
+ ("kku" ?)
+ ("kki" ?)
+ ("kka" ?)
+ ("kkE" ?)
+ ("kkee" ?)
+ ("kk" ?)
+ ("kko" ?)
+
+ ("Ke" ?ኸ)
+ ("Ku" ?ኹ)
+ ("Ki" ?ኺ)
+ ("Ka" ?ኻ)
+ ("KE" ?ኼ)
+ ("Kee" ?ኼ)
+ ("K" ?ኽ)
+ ("Ko" ?ኾ)
+ ("KWe" ?ዀ)
+ ("KWu" ?ዅ)
+ ("KWi" ?ዂ)
+ ("KW" ?ዃ)
+ ("KWa" ?ዃ)
+ ("KWE" ?ዄ)
+ ("KWee" ?ዄ)
+ ("KW'" ?ዅ)
+
+ ("Xe" ?)
+ ("Xu" ?)
+ ("Xi" ?)
+ ("Xa" ?)
+ ("XE" ?)
+ ("Xee" ?)
+ ("X" ?)
+ ("Xo" ?)
+
+ ("we" ?ወ)
+ ("wu" ?ዉ)
+ ("wi" ?ዊ)
+ ("wa" ?ዋ)
+ ("wE" ?ዌ)
+ ("wee" ?ዌ)
+ ("w" ?ው)
+ ("wo" ?ዎ)
+
+ ("`e" ?ዐ)
+ ("`u" ?ዑ)
+ ("`U" ?ዑ)
+ ("`i" ?ዒ)
+ ("`a" ?ዓ)
+ ("`A" ?ዓ)
+ ("`E" ?ዔ)
+ ("`ee" ?ዔ)
+ ("`I" ?ዕ)
+ ("`o" ?ዖ)
+ ("`O" ?ዖ)
+
+ ("e2" ?ዐ)
+ ("u2" ?ዑ)
+ ("U2" ?ዑ)
+ ("i2" ?ዒ)
+ ("a2" ?ዓ)
+ ("A2" ?ዓ)
+ ("E2" ?ዔ)
+ ("ee2" ?ዔ)
+ ("I2" ?ዕ)
+ ("o2" ?ዖ)
+ ("O2" ?ዖ)
+
+ ; ("ee" ?ዐ) ; old style
+ ("ae" ?ዐ) ; new style
+ ("aaa" ?ዐ) ; new style
+ ("uu" ?ዑ)
+ ("UU" ?ዑ)
+ ("ii" ?ዒ)
+ ("aa" ?ዓ)
+ ("AA" ?ዓ)
+ ("EE" ?ዔ)
+ ("II" ?ዕ)
+ ("ee" ?ዕ) ; new style
+ ("oo" ?ዖ)
+ ("OO" ?ዖ)
+
+ ("ze" ?ዘ)
+ ("zu" ?ዙ)
+ ("zi" ?ዚ)
+ ("za" ?ዛ)
+ ("zE" ?ዜ)
+ ("zee" ?ዜ)
+ ("z" ?ዝ)
+ ("zo" ?ዞ)
+ ("zW" ?ዟ)
+ ("zWa" ?ዟ)
+ ("zWe" ["ዝ"])
+ ("zWu" ["ዝ"])
+ ("zWi" ["ዝ"])
+ ("zWE" ["ዝ"])
+ ("zWee" ["ዝ"])
+ ("zW'" ["ዝ"])
+
+ ("Ze" ?ዠ)
+ ("Zu" ?ዡ)
+ ("Zi" ?ዢ)
+ ("Za" ?ዣ)
+ ("ZE" ?ዤ)
+ ("Zee" ?ዤ)
+ ("Z" ?ዥ)
+ ("Zo" ?ዦ)
+ ("ZW" ?ዧ)
+ ("ZWa" ?ዧ)
+ ("ZWe" ["ዥ"])
+ ("ZWu" ["ዥ"])
+ ("ZWi" ["ዥ"])
+ ("ZWE" ["ዥ"])
+ ("ZWee" ["ዥ"])
+ ("ZW'" ["ዥ"])
+
+ ("ye" ?የ)
+ ("yu" ?ዩ)
+ ("yi" ?ዪ)
+ ("ya" ?ያ)
+ ("yE" ?ዬ)
+ ("yee" ?ዬ)
+ ("y" ?ይ)
+ ("yo" ?ዮ)
+ ("yW" ?)
+ ("yWa" ?)
+ ("yWe" ["ይ"])
+ ("yWu" ["ይ"])
+ ("yWi" ["ይ"])
+ ("yWE" ["ይ"])
+ ("yWee" ["ይ"])
+ ("yW'" ["ይ"])
+
+ ("Ye" ?የ)
+ ("Yu" ?ዩ)
+ ("Yi" ?ዪ)
+ ("Ya" ?ያ)
+ ("YE" ?ዬ)
+ ("Yee" ?ዬ)
+ ("Y" ?ይ)
+ ("Yo" ?ዮ)
+ ("YW" ?)
+ ("YWa" ?)
+ ("YWe" ["ይ"])
+ ("YWu" ["ይ"])
+ ("YWi" ["ይ"])
+ ("YWE" ["ይ"])
+ ("YWee" ["ይ"])
+ ("YW'" ["ይ"])
+
+ ("de" ?ደ)
+ ("du" ?ዱ)
+ ("di" ?ዲ)
+ ("da" ?ዳ)
+ ("dE" ?ዴ)
+ ("dee" ?ዴ)
+ ("d" ?ድ)
+ ("do" ?ዶ)
+ ("dW" ?ዷ)
+ ("dWa" ?ዷ)
+ ("dWe" ["ድ"])
+ ("dWu" ["ድ"])
+ ("dWi" ["ድ"])
+ ("dWE" ["ድ"])
+ ("dWee" ["ድ"])
+ ("dW'" ["ድ"])
+
+ ("De" ?ዸ)
+ ("Du" ?ዹ)
+ ("Di" ?ዺ)
+ ("Da" ?ዻ)
+ ("DE" ?ዼ)
+ ("Dee" ?ዼ)
+ ("D" ?ዽ)
+ ("Do" ?ዾ)
+ ("DW" ?ዿ)
+ ("DWa" ?ዿ)
+ ("DWe" ["ዽ"])
+ ("DWu" ["ዽ"])
+ ("DWi" ["ዽ"])
+ ("DWE" ["ዽ"])
+ ("DWee" ["ዽ"])
+ ("DW'" ["ዽ"])
+
+ ("je" ?ጀ)
+ ("ju" ?ጁ)
+ ("ji" ?ጂ)
+ ("ja" ?ጃ)
+ ("jE" ?ጄ)
+ ("jee" ?ጄ)
+ ("j" ?ጅ)
+ ("jo" ?ጆ)
+ ("jW" ?ጇ)
+ ("jWa" ?ጇ)
+ ("jWe" ["ጅ"])
+ ("jWu" ["ጅ"])
+ ("jWi" ["ጅ"])
+ ("jWE" ["ጅ"])
+ ("jWee" ["ጅ"])
+ ("jW'" ["ጅ"])
+
+ ("Je" ?ጀ)
+ ("Ju" ?ጁ)
+ ("Ji" ?ጂ)
+ ("Ja" ?ጃ)
+ ("JE" ?ጄ)
+ ("Jee" ?ጄ)
+ ("J" ?ጅ)
+ ("Jo" ?ጆ)
+ ("JW" ?ጇ)
+ ("JWa" ?ጇ)
+ ("JWe" ["ጅ"])
+ ("JWu" ["ጅ"])
+ ("JWi" ["ጅ"])
+ ("JWE" ["ጅ"])
+ ("JWee" ["ጅ"])
+ ("JW'" ["ጅ"])
+
+ ("ge" ?ገ)
+ ("gu" ?ጉ)
+ ("gi" ?ጊ)
+ ("ga" ?ጋ)
+ ("gE" ?ጌ)
+ ("gee" ?ጌ)
+ ("g" ?ግ)
+ ("go" ?ጎ)
+ ("gWe" ?ጐ)
+ ("gWu" ?ጕ)
+ ("gWi" ?ጒ)
+ ("gW" ?ጓ)
+ ("gWa" ?ጓ)
+ ("gWE" ?ጔ)
+ ("gWee" ?ጔ)
+ ("gW'" ?ጕ)
+
+ ("`ge" ?)
+ ("`gu" ?)
+ ("`gi" ?)
+ ("`ga" ?)
+ ("`gE" ?)
+ ("`gee" ?)
+ ("`g" ?)
+ ("`go" ?)
+
+ ("g2e" ?)
+ ("g2u" ?)
+ ("g2i" ?)
+ ("g2a" ?)
+ ("g2E" ?)
+ ("g2ee" ?)
+ ("g2" ?)
+ ("g2o" ?)
+
+ ("gge" ?)
+ ("ggu" ?)
+ ("ggi" ?)
+ ("gga" ?)
+ ("ggE" ?)
+ ("ggee" ?)
+ ("gg" ?)
+ ("ggo" ?)
+
+ ("Ge" ?ጘ)
+ ("Gu" ?ጙ)
+ ("Gi" ?ጚ)
+ ("Ga" ?ጛ)
+ ("GE" ?ጜ)
+ ("Gee" ?ጜ)
+ ("G" ?ጝ)
+ ("Go" ?ጞ)
+ ("GWe" ?)
+ ("GWu" ?)
+ ("GWi" ?)
+ ("GW" ?)
+ ("GWa" ?)
+ ("GWE" ?)
+ ("GWee" ?)
+ ("GW'" ?)
+
+ ("Te" ?ጠ)
+ ("Tu" ?ጡ)
+ ("Ti" ?ጢ)
+ ("Ta" ?ጣ)
+ ("TE" ?ጤ)
+ ("Tee" ?ጤ)
+ ("T" ?ጥ)
+ ("To" ?ጦ)
+ ("TW" ?ጧ)
+ ("TWa" ?ጧ)
+ ("TWe" ["ጥ"])
+ ("TWu" ["ጥ"])
+ ("TWi" ["ጥ"])
+ ("TWE" ["ጥ"])
+ ("TWee" ["ጥ"])
+ ("TW'" ["ጥ"])
+
+ ("Ce" ?ጨ)
+ ("Cu" ?ጩ)
+ ("Ci" ?ጪ)
+ ("Ca" ?ጫ)
+ ("CE" ?ጬ)
+ ("Cee" ?ጬ)
+ ("C" ?ጭ)
+ ("Co" ?ጮ)
+ ("CW" ?ጯ)
+ ("CWa" ?ጯ)
+ ("CWe" ["ጭ"])
+ ("CWu" ["ጭ"])
+ ("CWi" ["ጭ"])
+ ("CWE" ["ጭ"])
+ ("CWee" ["ጭ"])
+ ("CW'" ["ጭ"])
+
+ ("Pe" ?ጰ)
+ ("Pu" ?ጱ)
+ ("Pi" ?ጲ)
+ ("Pa" ?ጳ)
+ ("PE" ?ጴ)
+ ("Pee" ?ጴ)
+ ("P" ?ጵ)
+ ("Po" ?ጶ)
+ ("PW" ?ጷ)
+ ("PWa" ?ጷ)
+ ("PWe" ["ጵ"])
+ ("PWu" ["ጵ"])
+ ("PWi" ["ጵ"])
+ ("PWE" ["ጵ"])
+ ("PWee" ["ጵ"])
+ ("PW'" ["ጵ"])
+
+ ("Se" ?ጸ)
+ ("Su" ?ጹ)
+ ("Si" ?ጺ)
+ ("Sa" ?ጻ)
+ ("SE" ?ጼ)
+ ("See" ?ጼ)
+ ("S" ?ጽ)
+ ("So" ?ጾ)
+ ("SW" ?ጿ)
+ ("SWa" ?ጿ)
+ ("SWe" ["ጽ"])
+ ("SWu" ["ጽ"])
+ ("SWi" ["ጽ"])
+ ("SWE" ["ጽ"])
+ ("SWee" ["ጽ"])
+ ("SW'" ["ጽ"])
+
+ ("`Se" ?ፀ)
+ ("`Su" ?ፁ)
+ ("`Si" ?ፂ)
+ ("`Sa" ?ፃ)
+ ("`SE" ?ፄ)
+ ("`See" ?ፄ)
+ ("`S" ?ፅ)
+ ("`So" ?ፆ)
+ ("`SW" ?ጿ)
+ ("`SWa" ?ጿ)
+ ("`SWe" ["ፅ"])
+ ("`SWu" ["ፅ"])
+ ("`SWi" ["ፅ"])
+ ("`SWE" ["ፅ"])
+ ("`SWee" ["ፅ"])
+ ("`SW'" ["ፅ"])
+
+ ("S2e" ?ፀ)
+ ("S2u" ?ፁ)
+ ("S2i" ?ፂ)
+ ("S2a" ?ፃ)
+ ("S2E" ?ፄ)
+ ("S2ee" ?ፄ)
+ ("S2" ?ፅ)
+ ("S2o" ?ፆ)
+ ("S2W" ?ጿ)
+ ("S2Wa" ?ጿ)
+ ("S2We" ["ፅ"])
+ ("S2Wu" ["ፅ"])
+ ("S2Wi" ["ፅ"])
+ ("S2WE" ["ፅ"])
+ ("S2Wee" ["ፅ"])
+ ("S2W'" ["ፅ"])
+
+ ("SSe" ?ፀ)
+ ("SSu" ?ፁ)
+ ("SSi" ?ፂ)
+ ("SSa" ?ፃ)
+ ("SSE" ?ፄ)
+ ("SSee" ?ፄ)
+ ("SS" ?ፅ)
+ ("SSo" ?ፆ)
+ ("SSW" ?ጿ)
+ ("SSWa" ?ጿ)
+ ("SSWe" ["ፅ"])
+ ("SSWu" ["ፅ"])
+ ("SSWi" ["ፅ"])
+ ("SSWE" ["ፅ"])
+ ("SSWee" ["ፅ"])
+ ("SW'" ["ፅ"])
+
+ ("fe" ?ፈ)
+ ("fu" ?ፉ)
+ ("fi" ?ፊ)
+ ("fa" ?ፋ)
+ ("fE" ?ፌ)
+ ("fee" ?ፌ)
+ ("f" ?ፍ)
+ ("fo" ?ፎ)
+ ("fWe" ?)
+ ("fWu" ?)
+ ("fWi" ?)
+ ("fW" ?ፏ)
+ ("fWa" ?ፏ)
+ ("fWE" ?)
+ ("fWee" ?)
+ ("fW'" ?)
+ ("fY" ?ፚ)
+ ("fYa" ?ፚ)
+
+ ("Fe" ?ፈ)
+ ("Fu" ?ፉ)
+ ("Fi" ?ፊ)
+ ("Fa" ?ፋ)
+ ("FE" ?ፌ)
+ ("Fee" ?ፌ)
+ ("F" ?ፍ)
+ ("Fo" ?ፎ)
+ ("FWe" ?)
+ ("FWu" ?)
+ ("FWi" ?)
+ ("FW" ?ፏ)
+ ("FWa" ?ፏ)
+ ("FWE" ?)
+ ("FWee" ?)
+ ("FW'" ?)
+ ("FY" ?ፚ)
+ ("FYa" ?ፚ)
+
+ ("pe" ?ፐ)
+ ("pu" ?ፑ)
+ ("pi" ?ፒ)
+ ("pa" ?ፓ)
+ ("pE" ?ፔ)
+ ("pee" ?ፔ)
+ ("p" ?ፕ)
+ ("po" ?ፖ)
+ ("pWe" ?)
+ ("pWu" ?)
+ ("pWi" ?)
+ ("pW" ?ፗ)
+ ("pWa" ?ፗ)
+ ("pWE" ?)
+ ("pWee" ?)
+ ("pW'" ?)
+
+ ("'" [""])
+ ("''" ?')
+ (":" ?፡)
+ ("::" ?።)
+ (":::" ?:)
+ ("." ?።)
+ (".." ?)
+ ("..." ?.)
+ ("," ?፣)
+ (",," ?,)
+ (";" ?፤)
+ (";;" ?\;)
+ ("-:" ?፥)
+ (":-" ?፦)
+ ("*" ?*)
+ ("**" ?፨)
+ (":|:" ?፨)
+ ("?" ?)
+ ("??" ?፧)
+ ("`?" ?፧)
+ ("???" ??)
+ ("<<" ?)
+ (">>" ?)
+ ("`!" ?)
+ ("wWe" ?)
+ ("wWu" ?)
+ ("wWi" ?)
+ ("wW" ?)
+ ("wWa" ?)
+ ("wWE" ?)
+ ("wWee" ?)
+ ("wW'" ?)
+ ("We" ?)
+ ("Wu" ?)
+ ("Wi" ?)
+ ("W" ?)
+ ("Wa" ?)
+ ("WE" ?)
+ ("Wee" ?)
+ ("W'" ?)
+ ("`1" ?፩)
+ ("`2" ?፪)
+ ("`3" ?፫)
+ ("`4" ?፬)
+ ("`5" ?፭)
+ ("`6" ?፮)
+ ("`7" ?፯)
+ ("`8" ?፰)
+ ("`9" ?፱)
+ ("`10" ?፲)
+ ("`20" ?፳)
+ ("`30" ?፴)
+ ("`40" ?፵)
+ ("`50" ?፶)
+ ("`60" ?፷)
+ ("`70" ?፸)
+ ("`80" ?፹)
+ ("`90" ?፺)
+ ("`100" ?፻)
+ ("`1000" ["፲፻"])
+ ("`2000" ["፳፻"])
+ ("`3000" ["፴፻"])
+ ("`4000" ["፵፻"])
+ ("`5000" ["፶፻"])
+ ("`6000" ["፷፻"])
+ ("`7000" ["፸፻"])
+ ("`8000" ["፹፻"])
+ ("`9000" ["፺፻"])
+ ("`10000" ?፼)
+ ("`20000" ["፪፼"])
+ ("`30000" ["፫፼"])
+ ("`40000" ["፬፼"])
+ ("`50000" ["፭፼"])
+ ("`60000" ["፮፼"])
+ ("`70000" ["፯፼"])
+ ("`80000" ["፰፼"])
+ ("`90000" ["፱፼"])
+ ("`100000" ["፲፼"])
+ ("`200000" ["፳፼"])
+ ("`300000" ["፴፼"])
+ ("`400000" ["፵፼"])
+ ("`500000" ["፶፼"])
+ ("`600000" ["፷፼"])
+ ("`700000" ["፸፼"])
+ ("`800000" ["፹፼"])
+ ("`900000" ["፺፼"])
+ ("`1000000" ["፻፼"])
+)
+
+(defun ethio-select-a-translation ()
+ ;; The translation of `a' depends on the language
+ ;; (either Tigrigna or Amharic).
+ (quail-defrule "a"
+ (if (ethio-prefer-amharic-p) ?አ ?ኣ)
+ "ethiopic"))
+
+;;; ethiopic.el ends here
diff --git a/lisp/leim/quail/georgian.el b/lisp/leim/quail/georgian.el
new file mode 100644
index 00000000000..167c71fdf4c
--- /dev/null
+++ b/lisp/leim/quail/georgian.el
@@ -0,0 +1,83 @@
+;;; georgian.el --- Quail package for inputting Georgian characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Georgian input following the Yudit map from Mark Leisher
+;; <mleisher@crl.nmsu.edu>.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "georgian" "Georgian" "გ" t
+ "A common Georgian transliteration (using Unicode)"
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("a" ?ა)
+ ("b" ?ბ)
+ ("g" ?გ)
+ ("d" ?დ)
+ ("e" ?ე)
+ ("v" ?ვ)
+ ("z" ?ზ)
+ ("t" ?თ)
+ ("i" ?ი)
+ (".k" ?კ)
+ ("l" ?ლ)
+ ("m" ?მ)
+ ("n" ?ნ)
+ ("o" ?ო)
+ (".p" ?პ)
+ ("+z" ?ჟ)
+ ("r" ?რ)
+ ("s" ?ს)
+ (".t" ?ტ)
+ ("u" ?უ)
+ ("p" ?ფ)
+ ("k" ?ქ)
+ (".g" ?ღ)
+ ("q" ?ყ)
+ ("+s" ?შ)
+ ("+c" ?ჩ)
+ ("c" ?ც)
+ ("j" ?ძ)
+ (".c" ?წ)
+ (".+c" ?ჭ)
+ ("x" ?ხ)
+ ("+j" ?ჯ)
+ ("h" ?ჰ)
+ ("q1" ?ჴ)
+ ("e0" ?ჱ)
+ ("o1" ?ჵ)
+ ("i1" ?ჲ)
+ ("w" ?ჳ)
+ ("f" ?ჶ)
+ ;; Presumably, these are GEORGIAN LETTER YN, GEORGIAN LETTER ELIFI,
+ ;; accepted for U+10F7, U+10F8 -- fx
+ ("y" ?) ;; Letter not in Unicode (private use code).
+ ("e1" ?) ;; Letter not in Unicode (private use code).
+ )
+
+;;; georgian.el ends here
diff --git a/lisp/leim/quail/greek.el b/lisp/leim/quail/greek.el
new file mode 100644
index 00000000000..1dfc93aa936
--- /dev/null
+++ b/lisp/leim/quail/greek.el
@@ -0,0 +1,1431 @@
+;;; greek.el --- Quail package for inputting Greek -*-coding: utf-8-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Greek
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "greek-jis" "Greek" "Ω" nil
+ "Ελληνικα: Greek keyboard layout (JIS X0208.1983)
+
+The layout is same as greek, but uses JIS characters.
+Sorry, accents and terminal sigma are not supported in JIS."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?−)
+ ("=" ?=)
+ ("`" ?‘)
+ ("q" ?・)
+ ("w" ?σ)
+ ("e" ?ε)
+ ("r" ?ρ)
+ ("t" ?τ)
+ ("y" ?υ)
+ ("u" ?θ)
+ ("i" ?ι)
+ ("o" ?ο)
+ ("p" ?π)
+ ("[" ?\[)
+ ("]" ?\])
+ ("a" ?α)
+ ("s" ?σ)
+ ("d" ?δ)
+ ("f" ?φ)
+ ("g" ?γ)
+ ("h" ?η)
+ ("j" ?ξ)
+ ("k" ?κ)
+ ("l" ?λ)
+ (";" ?’)
+ ("'" ?’)
+ ("\\" ?\)
+ ("z" ?ζ)
+ ("x" ?χ)
+ ("c" ?ψ)
+ ("v" ?ω)
+ ("b" ?β)
+ ("n" ?ν)
+ ("m" ?μ)
+ ("," ?, )
+ ("." ?. )
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?@)
+ ("#" ?#)
+ ("$" ?#)
+ ("%" ?%)
+ ("^" ?^)
+ ("&" ?&)
+ ("*" ?*)
+ ("(" ?\()
+ (")" ?\))
+ ("_" ?_)
+ ("+" ?+)
+ ("~" ? ̄)
+ ("Q" ?−)
+ ("W" ?Σ)
+ ("E" ?Ε)
+ ("R" ?Ρ)
+ ("T" ?Τ)
+ ("Y" ?Υ)
+ ("U" ?Θ)
+ ("I" ?Ι)
+ ("O" ?Ο)
+ ("P" ?Ρ)
+ ("{" ?\{)
+ ("}" ?\})
+ ("A" ?Α)
+ ("S" ?Σ)
+ ("D" ?Δ)
+ ("F" ?Φ)
+ ("G" ?Γ)
+ ("H" ?Η)
+ ("J" ?Ξ)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ (":" ?”)
+ ("\"" ?”)
+ ("|" ?|)
+ ("Z" ?Ζ)
+ ("X" ?Χ)
+ ("C" ?Ψ)
+ ("V" ?Ω)
+ ("B" ?Β)
+ ("N" ?Ν)
+ ("M" ?Μ)
+ ("<" ?;)
+ (">" ?:)
+ ("?" ??))
+
+;;
+
+(quail-define-package "greek-mizuochi" "Greek" "CG" t
+"The Mizuochi input method for Classical Greek using mule-unicode-0100-24ff.
+
+-------------------------------------
+character capital small
+-------------------------------------
+alpha A a
+beta B b
+gamma G g
+delta D d
+epsilon E e
+zeta Z z
+eta H h
+theta Q q
+iota I i
+kappa K k
+lambda L l
+mu M m
+nu N n
+xi X x
+omicron O o
+pi P p
+rho R r
+sigma S s
+final sigma j
+tau T t
+upsilon U u
+phi F f
+chi C c
+psi Y y
+omega W w
+-------------------------------------
+sampi !
+digamma #
+stigma $
+koppa & %
+-------------------------------------
+
+------------------------
+mark key
+------------------------
+ypogegrammeni J
+psili \\=' or v
+dasia \\=` or V
+oxia /
+varia ?
+perispomeni \\ or ^
+dialytika \"
+ano teleia :
+erotimatiko ;
+----------------------
+"
+nil t t nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+
+ ("!" ?ϡ) ; sampi
+ ("#" ?Ϝ) ; DIGAMMA
+ ("$" ?ϛ) ; stigma
+ ("%" ?ϟ) ; koppa
+ ("&" ?Ϟ) ; KOPPA
+ ("'" ?᾿) ("v" ?᾿) ; psili
+ ("/" ?´) ; oxia
+ (":" ?·) ; ano teleia
+ (";" ?;) ; erotimatiko
+ ("\"" ?¨) ; dialytika
+
+ ("A" ?Α)
+ ("B" ?Β)
+ ("C" ?Χ)
+ ("D" ?Δ)
+ ("E" ?Ε)
+ ("F" ?Φ)
+ ("G" ?Γ)
+ ("H" ?Η)
+ ("I" ?Ι)
+ ("wJ" ?ῳ)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ ("M" ?Μ)
+ ("N" ?Ν)
+ ("O" ?Ο)
+
+ ("P" ?Π)
+ ("Q" ?Θ)
+ ("R" ?Ρ)
+ ("S" ?Σ)
+ ("T" ?Τ)
+ ("U" ?Υ)
+ ("hJ" ?ῃ)
+ ("W" ?Ω)
+ ("X" ?Ξ)
+ ("Y" ?Ψ)
+ ("Z" ?Ζ)
+ ("?" ?`) ; varia
+ ("\\" ?῀) ("^" ?῀) ; perispomeni
+
+ ("`" ?῾) ("V" ?῾) ; dasia
+ ("a" ?α)
+ ("b" ?β)
+ ("c" ?χ)
+ ("d" ?δ)
+ ("e" ?ε)
+ ("f" ?φ)
+ ("g" ?γ)
+ ("h" ?η)
+ ("i" ?ι)
+ ("j" ?ς)
+ ("k" ?κ)
+ ("l" ?λ)
+ ("m" ?μ)
+ ("n" ?ν)
+ ("o" ?ο)
+
+ ("p" ?π)
+ ("q" ?θ)
+ ("r" ?ρ)
+ ("s" ?σ)
+ ("t" ?τ)
+ ("u" ?υ)
+ ("aJ" ?ᾳ)
+ ("w" ?ω)
+ ("x" ?ξ)
+ ("y" ?ψ)
+ ("z" ?ζ)
+
+ ("i`" ?ἱ) ("iV" ?ἱ)
+ ("i'" ?ἰ) ("iv" ?ἰ)
+ ("i/" ?ί)
+ ("i`/" ?ἵ) ("iV/" ?ἵ) ("i/`" ?ἵ) ("i/V" ?ἵ)
+ ("i'/" ?ἴ) ("iv/" ?ἴ) ("i/'" ?ἴ) ("i/v" ?ἴ)
+ ("i?" ?ὶ)
+ ("i`?" ?ἳ) ("iV?" ?ἳ) ("i?`" ?ἳ) ("i?V" ?ἳ)
+ ("i'?" ?ἲ) ("iv?" ?ἲ) ("i?'" ?ἲ) ("i?v" ?ἲ)
+ ("i^" ?ῖ) ("i\\" ?ῖ)
+ ("i`^" ?ἷ) ("i`\\" ?ἷ) ("iV^" ?ἷ) ("iV\\" ?ἷ)
+ ("i^`" ?ἷ) ("i\\`" ?ἷ) ("i^V" ?ἷ) ("i\\V" ?ἷ)
+ ("i'^" ?ἶ) ("i'\\" ?ἶ) ("iv^" ?ἶ) ("iv\\" ?ἶ)
+ ("i^'" ?ἶ) ("i\\'" ?ἶ) ("i^v" ?ἶ) ("i\\v" ?ἶ)
+ ("i\"" ?ϊ)
+ ("i/\"" ?ΐ) ("i\"/" ?ΐ)
+ ("i?\"" ?ῒ) ("i\"?" ?ῒ)
+
+ ("^`" ?῟) ("^V" ?῟) ("\\`" ?῟) ("\\V" ?῟)
+ ("`^" ?῟) ("V^" ?῟) ("`\\" ?῟) ("V\\" ?῟)
+ ("^'" ?῏) ("^v" ?῏) ("\\'" ?῏) ("\\v" ?῏)
+ ("'^" ?῏) ("v^" ?῏) ("'\\" ?῏) ("v\\" ?῏)
+ ("/`" ?῞) ("/V" ?῞) ("`/" ?῞) ("V/" ?῞)
+ ("/'" ?῎) ("/v" ?῎) ("'/" ?῎) ("v/" ?῎)
+ ("?`" ?῝) ("?V" ?῝) ("`?" ?῝) ("V?" ?῝)
+ ("?'" ?῍) ("?v" ?῍) ("'?" ?῍) ("v?" ?῍)
+ ("\"/" ?΅) ("/\"" ?΅)
+ ("\"?" ?῭) ("?\"" ?῭)
+
+ ("e`" ?ἑ) ("eV" ?ἑ)
+ ("e'" ?ἐ) ("ev" ?ἐ)
+ ("e/" ?έ)
+ ("e/`" ?ἕ) ("e/V" ?ἕ) ("e`/" ?ἕ) ("eV/" ?ἕ)
+ ("e/'" ?ἔ) ("e/v" ?ἔ) ("e'/" ?ἔ) ("ev/" ?ἔ)
+ ("e?" ?ὲ)
+ ("e?`" ?ἓ) ("e?V" ?ἓ) ("e`?" ?ἓ) ("eV?" ?ἓ)
+ ("e?'" ?ἒ) ("e?v" ?ἒ) ("e'?" ?ἒ) ("ev?" ?ἒ)
+
+ ("a`" ?ἁ) ("aV" ?ἁ)
+ ("a'" ?ἀ) ("av" ?ἀ)
+ ("a/" ?ά)
+ ("a/`" ?ἅ) ("a/V" ?ἅ) ("a`/" ?ἅ) ("aV/" ?ἅ)
+ ("a/'" ?ἄ) ("a/v" ?ἄ) ("a'/" ?ἄ) ("av/" ?ἄ)
+ ("a?" ?ὰ)
+ ("a?`" ?ἃ) ("a?V" ?ἃ) ("a`?" ?ἃ) ("aV?" ?ἃ)
+ ("a?'" ?ἂ) ("a?v" ?ἂ) ("a'?" ?ἂ) ("av?" ?ἂ)
+ ("a^" ?ᾶ) ("a\\" ?ᾶ)
+ ("a^`" ?ἇ) ("a^V" ?ἇ) ("a\\`" ?ἇ) ("a\\V" ?ἇ)
+ ("a`^" ?ἇ) ("aV^" ?ἇ) ("a`\\" ?ἇ) ("aV\\" ?ἇ)
+ ("a^'" ?ἆ) ("a^v" ?ἆ) ("a\\'" ?ἆ) ("a\\v" ?ἆ)
+ ("a'^" ?ἆ) ("av^" ?ἆ) ("a'\\" ?ἆ) ("av\\" ?ἆ)
+
+ ("aJ`" ?ᾁ) ("aJV" ?ᾁ)
+ ("aJ'" ?ᾀ) ("aJv" ?ᾀ)
+ ("aJ/" ?ᾴ)
+ ("aJ/`" ?ᾅ) ("aJ/V" ?ᾅ) ("aJ`/" ?ᾅ) ("aJV/" ?ᾅ)
+ ("aJ/'" ?ᾄ) ("aJ/v" ?ᾄ) ("aJ'/" ?ᾄ) ("aJv/" ?ᾄ)
+ ("aJ?" ?ᾲ)
+ ("aJ?`" ?ᾃ) ("aJ?V" ?ᾃ) ("aJ`?" ?ᾃ) ("aJV?" ?ᾃ)
+ ("aJ?'" ?ᾂ) ("aJ?v" ?ᾂ) ("aJ'?" ?ᾂ) ("aJv?" ?ᾂ)
+ ("aJ^" ?ᾷ) ("aJ\\" ?ᾷ)
+ ("aJ^`" ?ᾇ) ("aJ^V" ?ᾇ) ("aJ\\`" ?ᾇ) ("aJ\\V" ?ᾇ)
+ ("aJ`^" ?ᾇ) ("aJV^" ?ᾇ) ("aJ`\\" ?ᾇ) ("aJV\\" ?ᾇ)
+ ("aJ^'" ?ᾆ) ("aJ^v" ?ᾆ) ("aJ\\'" ?ᾆ) ("aJ\\v" ?ᾆ)
+ ("aJ'^" ?ᾆ) ("aJv^" ?ᾆ) ("aJ'\\" ?ᾆ) ("aJv\\" ?ᾆ)
+
+ ("r`" ?ῥ) ("rV" ?ῥ)
+ ("r'" ?ῤ) ("rv" ?ῤ)
+
+ ("h`" ?ἡ) ("hV" ?ἡ)
+ ("h'" ?ἠ) ("hv" ?ἠ)
+ ("h/" ?ή)
+ ("h/`" ?ἥ) ("h/V" ?ἥ) ("h`/" ?ἥ) ("hV/" ?ἥ)
+ ("h/'" ?ἤ) ("h/v" ?ἤ) ("h'/" ?ἤ) ("hv/" ?ἤ)
+ ("h?" ?ὴ)
+ ("h?`" ?ἣ) ("h?V" ?ἣ) ("h`?" ?ἣ) ("hV?" ?ἣ)
+ ("h?'" ?ἢ) ("h?v" ?ἢ) ("h'?" ?ἢ) ("hv?" ?ἢ)
+ ("h^" ?ῆ) ("h\\" ?ῆ)
+ ("h^`" ?ἧ) ("h^V" ?ἧ) ("h\\`" ?ἧ) ("h\\V" ?ἧ)
+ ("h`^" ?ἧ) ("h`\\" ?ἧ) ("hV^" ?ἧ) ("hV\\" ?ἧ)
+ ("h^'" ?ἦ) ("h^v" ?ἦ) ("h\\'" ?ἦ) ("h\\v" ?ἦ)
+ ("h'^" ?ἦ) ("h'\\" ?ἦ) ("hv^" ?ἦ) ("hv\\" ?ἦ)
+
+ ("J" ?ͺ) ; ypogegrammeni
+
+ ("hJ`" ?ᾑ) ("hJV" ?ᾑ)
+ ("hJ'" ?ᾐ) ("hJv" ?ᾐ)
+ ("hJ/" ?ῄ)
+ ("hJ`/" ?ᾕ) ("hJV/" ?ᾕ) ("hJ/`" ?ᾕ) ("hJ/V" ?ᾕ)
+ ("hJ'/" ?ᾔ) ("hJv/" ?ᾔ) ("hJ/'" ?ᾔ) ("hJ/v" ?ᾔ)
+ ("hJ?" ?ῂ)
+ ("hJ`?" ?ᾓ) ("hJV?" ?ᾓ) ("hJ?`" ?ᾓ) ("hJ?V" ?ᾓ)
+ ("hJ'?" ?ᾒ) ("hJv?" ?ᾒ) ("hJ?'" ?ᾒ) ("hJ?v" ?ᾒ)
+ ("hJ^" ?ῇ) ("hJ\\" ?ῇ)
+ ("hJ`^" ?ᾗ) ("hJ`\\" ?ᾗ) ("hJV^" ?ᾗ) ("hJV\\" ?ᾗ)
+ ("hJ^`" ?ᾗ) ("hJ\\`" ?ᾗ) ("hJ^V" ?ᾗ) ("hJ\\V" ?ᾗ)
+ ("hJ'^" ?ᾖ) ("hJ'\\" ?ᾖ) ("hJv^" ?ᾖ) ("hJv\\" ?ᾖ)
+ ("hJ^'" ?ᾖ) ("hJ\\'" ?ᾖ) ("hJ^v" ?ᾖ) ("hJ\\v" ?ᾖ)
+
+ ("o`" ?ὁ) ("oV" ?ὁ)
+ ("o'" ?ὀ) ("ov" ?ὀ)
+ ("o/" ?ό)
+ ("o/`" ?ὅ) ("o/V" ?ὅ) ("o`/" ?ὅ) ("oV/" ?ὅ)
+ ("o/'" ?ὄ) ("o/v" ?ὄ) ("o'/" ?ὄ) ("ov/" ?ὄ)
+ ("o?" ?ὸ)
+ ("o?`" ?ὃ) ("o?V" ?ὃ) ("o`?" ?ὃ) ("oV?" ?ὃ)
+ ("o?'" ?ὂ) ("o?v" ?ὂ) ("o'?" ?ὂ) ("ov?" ?ὂ)
+
+ ("u`" ?ὑ) ("uV" ?ὑ)
+ ("u'" ?ὐ) ("uv" ?ὐ)
+ ("u/" ?ύ)
+ ("u/`" ?ὕ) ("u/V" ?ὕ) ("u`/" ?ὕ) ("uV/" ?ὕ)
+ ("u/'" ?ὔ) ("u/v" ?ὔ) ("u'/" ?ὔ) ("uv/" ?ὔ)
+ ("u?" ?ὺ)
+ ("u?`" ?ὓ) ("u?V" ?ὓ) ("u`?" ?ὓ) ("uV?" ?ὓ)
+ ("u?'" ?ὒ) ("u?v" ?ὒ) ("u'?" ?ὒ) ("uv?" ?ὒ)
+ ("u^" ?ῦ) ("u\\" ?ῦ)
+ ("u^`" ?ὗ) ("u^V" ?ὗ) ("u\\`" ?ὗ) ("u\\V" ?ὗ)
+ ("u`^" ?ὗ) ("uV^" ?ὗ) ("u`\\" ?ὗ) ("uV\\" ?ὗ)
+ ("u^'" ?ὖ) ("u^v" ?ὖ) ("u\\'" ?ὖ) ("u\\v" ?ὖ)
+ ("u'^" ?ὖ) ("uv^" ?ὖ) ("u'\\" ?ὖ) ("uv\\" ?ὖ)
+ ("u\"" ?ϋ)
+ ("u\"/" ?ΰ) ("u/\"" ?ΰ)
+ ("u\"?" ?ῢ) ("u?\"" ?ῢ)
+
+ ("w`" ?ὡ) ("wV" ?ὡ)
+ ("w'" ?ὠ) ("wv" ?ὠ)
+ ("w/" ?ώ)
+ ("w/`" ?ὥ) ("w/V" ?ὥ) ("w`/" ?ὥ) ("wV/" ?ὥ)
+ ("w/'" ?ὤ) ("w/v" ?ὤ) ("w'/" ?ὤ) ("wv/" ?ὤ)
+ ("w?" ?ὼ)
+ ("w?`" ?ὣ) ("w?V" ?ὣ) ("w`?" ?ὣ) ("wV?" ?ὣ)
+ ("w?'" ?ὢ) ("w?v" ?ὢ) ("w'?" ?ὢ) ("wv?" ?ὢ)
+ ("w^" ?ῶ) ("w\\" ?ῶ)
+ ("w^`" ?ὧ) ("w^V" ?ὧ) ("w\\`" ?ὧ) ("w\\V" ?ὧ)
+ ("w`^" ?ὧ) ("wV^" ?ὧ) ("w`\\" ?ὧ) ("wV\\" ?ὧ)
+ ("w^'" ?ὦ) ("w^v" ?ὦ) ("w\\'" ?ὦ) ("w\\v" ?ὦ)
+ ("w'^" ?ὦ) ("wv^" ?ὦ) ("w'\\" ?ὦ) ("wv\\" ?ὦ)
+
+ ("wJ`" ?ᾡ) ("wJV" ?ᾡ)
+ ("wJ'" ?ᾠ) ("wJv" ?ᾠ)
+ ("wJ/" ?ῴ)
+ ("wJ/`" ?ᾥ) ("wJ/V" ?ᾥ) ("wJ`/" ?ᾥ) ("wJV/" ?ᾥ)
+ ("wJ/'" ?ᾤ) ("wJ/v" ?ᾤ) ("wJ'/" ?ᾤ) ("wJv/" ?ᾤ)
+ ("wJ?" ?ῲ)
+ ("wJ?`" ?ᾣ) ("wJ?V" ?ᾣ) ("wJ`?" ?ᾣ) ("wJV?" ?ᾣ)
+ ("wJ?'" ?ᾢ) ("wJ?v" ?ᾢ) ("wJ'?" ?ᾢ) ("wJv?" ?ᾢ)
+ ("wJ^" ?ῷ) ("wJ\\" ?ῷ)
+ ("wJ^`" ?ᾧ) ("wJ^V" ?ᾧ) ("wJ\\`" ?ᾧ) ("wJ\\V" ?ᾧ)
+ ("wJ`^" ?ᾧ) ("wJV^" ?ᾧ) ("wJ`\\" ?ᾧ) ("wJV\\" ?ᾧ)
+ ("wJ^'" ?ᾦ) ("wJ^v" ?ᾦ) ("wJ\\'" ?ᾦ) ("wJ\\v" ?ᾦ)
+ ("wJ'^" ?ᾦ) ("wJv^" ?ᾦ) ("wJ'\\" ?ᾦ) ("wJv\\" ?ᾦ)
+ )
+
+;;
+
+(quail-define-package "greek-babel" "Greek" "BG" t
+"The TeX Babel input method for Classical Greek using mule-unicode-0100-24ff.
+
+-------------------------------------
+character capital small
+-------------------------------------
+alpha A a
+beta B b
+gamma G g
+delta D d
+epsilon E e
+zeta Z z
+eta H h
+theta J j
+iota I i
+kappa K k
+lambda L l
+mu M m
+nu N n
+xi X x
+omicron O o
+pi P p
+rho R r
+sigma S s
+final sigma c
+tau T t
+upsilon U u
+phi F f
+chi Q q
+psi Y y
+omega W w
+-------------------------------------
+sampi !
+digamma #
+stigma $
+koppa & %
+-------------------------------------
+
+------------------------
+mark key
+------------------------
+ypogegrammeni |
+psili >
+dasia <
+oxia \\='
+koronis \\='\\='
+varia \\=`
+perispomeni ~
+dialytika \"
+ano teleia ;
+erotimatiko ?
+----------------------
+"
+nil t t nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+
+ ("!" ?ϡ) ; sampi
+ ("#" ?Ϝ) ; DIGAMMA
+ ("$" ?ϛ) ; stigma
+ ("%" ?ϟ) ; koppa
+ ("&" ?Ϟ) ; KOPPA
+ (">" ?᾿) ; psili
+ ("'" ?´) ; oxia
+ (";" ?·) ; ano teleia
+ ("?" ?;) ; erotimatiko
+ ("\"" ?¨) ; dialytika
+ ("|" ?ͺ) ; ypogegrammeni
+ ("''" ?᾽) ; koronis
+ ("((" ?«) ; #x00ab
+ ("))" ?») ; #x00bb
+
+ ("A" ?Α)
+ ("A|" ?ᾼ)
+ ("B" ?Β)
+ ("D" ?Δ)
+ ("E" ?Ε)
+ ("F" ?Φ)
+ ("G" ?Γ)
+ ("H" ?Η)
+ ("H|" ?ῌ)
+ ("I" ?Ι)
+ ("J" ?Θ)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ ("M" ?Μ)
+ ("N" ?Ν)
+ ("O" ?Ο)
+ ("P" ?Π)
+ ("Q" ?Χ)
+ ("R" ?Ρ)
+ ("S" ?Σ)
+ ("T" ?Τ)
+ ("U" ?Υ)
+ ("W" ?Ω)
+ ("W|" ?ῼ)
+ ("X" ?Ξ)
+ ("Y" ?Ψ)
+ ("Z" ?Ζ)
+ ("`" ?`) ; varia
+ ("~" ?῀) ; perispomeni
+
+ ("<" ?῾) ; dasia
+ ("a" ?α)
+ ("a|" ?ᾳ)
+ ("b" ?β)
+ ("c" ?ς)
+ ("d" ?δ)
+ ("e" ?ε)
+ ("f" ?φ)
+ ("g" ?γ)
+ ("h" ?η)
+ ("h|" ?ῃ)
+ ("i" ?ι)
+ ("j" ?θ)
+ ("k" ?κ)
+ ("l" ?λ)
+ ("m" ?μ)
+ ("n" ?ν)
+ ("o" ?ο)
+ ("p" ?π)
+ ("q" ?χ)
+ ("r" ?ρ)
+ ("s" ?σ)
+ ("t" ?τ)
+ ("u" ?υ)
+ ("w" ?ω)
+ ("w|" ?ῳ)
+ ("x" ?ξ)
+ ("y" ?ψ)
+ ("z" ?ζ)
+
+ ("<i" ?ἱ)
+ (">i" ?ἰ)
+ ("'i" ?ί)
+ ("<'i" ?ἵ)
+ (">'i" ?ἴ)
+ ("`i" ?ὶ)
+ ("<`i" ?ἳ)
+ (">`i" ?ἲ)
+ ("~i" ?ῖ)
+ ("<~i" ?ἷ)
+ (">~i" ?ἶ)
+ ("\"i" ?ϊ)
+ ("\"'i" ?ΐ)
+ ("\"`i" ?ῒ)
+
+ ("<I" ?Ἱ)
+ (">I" ?Ἰ)
+ ("'I" ?Ί)
+ ("<'I" ?Ἵ)
+ (">'I" ?Ἴ)
+ ("`I" ?Ὶ)
+ ("<`I" ?Ἳ)
+ (">`I" ?Ἲ)
+ ("<~I" ?Ἷ)
+ (">~I" ?Ἶ)
+ ("\"I" ?Ϊ)
+
+ ("<~" ?῟)
+ (">~" ?῏)
+ ("<'" ?῞)
+ (">'" ?῎)
+ ("<`" ?῝)
+ (">`" ?῍)
+ ("\"'" ?΅)
+ ("\"`" ?῭)
+
+ ("<e" ?ἑ)
+ (">e" ?ἐ)
+ ("'e" ?έ)
+ ("<'e" ?ἕ)
+ (">'e" ?ἔ)
+ ("`e" ?ὲ)
+ ("<`e" ?ἓ)
+ (">`e" ?ἒ)
+
+ ("<E" ?Ἑ)
+ (">E" ?Ἐ)
+ ("'E" ?Έ)
+ ("<'E" ?Ἕ)
+ (">'E" ?Ἔ)
+ ("`E" ?Ὲ)
+ ("<`E" ?Ἓ)
+ (">`E" ?Ἒ)
+
+ ("<a" ?ἁ)
+ (">a" ?ἀ)
+ ("'a" ?ά)
+ ("<'a" ?ἅ)
+ (">'a" ?ἄ)
+ ("`a" ?ὰ)
+ ("<`a" ?ἃ)
+ (">`a" ?ἂ)
+ ("~a" ?ᾶ)
+ ("<~a" ?ἇ)
+ (">~a" ?ἆ)
+
+ ("<A" ?Ἁ)
+ (">A" ?Ἀ)
+ ("'A" ?Ά)
+ ("<'A" ?Ἅ)
+ (">'A" ?Ἄ)
+ ("`A" ?Ὰ)
+ ("<`A" ?Ἃ)
+ (">`A" ?Ἂ)
+ ("<~A" ?Ἇ)
+ (">~A" ?Ἆ)
+
+ ("<a|" ?ᾁ)
+ (">a|" ?ᾀ)
+ ("'a|" ?ᾴ)
+ ("<'a|" ?ᾅ)
+ (">'a|" ?ᾄ)
+ ("`a|" ?ᾲ)
+ ("<`a|" ?ᾃ)
+ (">`a|" ?ᾂ)
+ ("~a|" ?ᾷ)
+ ("<~a|" ?ᾇ)
+ (">~a|" ?ᾆ)
+
+ ("<A|" ?ᾉ)
+ (">A|" ?ᾈ)
+ ("<'A|" ?ᾍ)
+ (">'A|" ?ᾌ)
+ ("<`A|" ?ᾋ)
+ (">`A|" ?ᾊ)
+ ("<~A|" ?ᾏ)
+ (">~A|" ?ᾎ)
+
+ ("<r" ?ῥ)
+ (">r" ?ῤ)
+
+ ("<R" ?Ῥ)
+
+ ("<h" ?ἡ)
+ (">h" ?ἠ)
+ ("'h" ?ή)
+ ("<'h" ?ἥ)
+ (">'h" ?ἤ)
+ ("`h" ?ὴ)
+ ("<`h" ?ἣ)
+ (">`h" ?ἢ)
+ ("~h" ?ῆ)
+ ("<~h" ?ἧ)
+ (">~h" ?ἦ)
+
+ ("<H" ?Ἡ)
+ (">H" ?Ἠ)
+ ("'H" ?Ή)
+ ("<'H" ?Ἥ)
+ (">'H" ?Ἤ)
+ ("`H" ?Ὴ)
+ ("<`H" ?Ἣ)
+ (">`H" ?Ἢ)
+ ("<~H" ?Ἧ)
+ (">~H" ?Ἦ)
+
+ ("|" ?ͺ) ; ypogegrammeni
+
+ ("<h|" ?ᾑ)
+ (">h|" ?ᾐ)
+ ("'h|" ?ῄ)
+ ("<'h|" ?ᾕ)
+ (">'h|" ?ᾔ)
+ ("`h|" ?ῂ)
+ ("<`h|" ?ᾓ)
+ (">`h|" ?ᾒ)
+ ("~h|" ?ῇ)
+ ("<~h|" ?ᾗ)
+ (">~h|" ?ᾖ)
+
+ ("<H|" ?ᾙ)
+ (">H|" ?ᾘ)
+ ("<'H|" ?ᾝ)
+ (">'H|" ?ᾜ)
+ ("<`H|" ?ᾛ)
+ (">`H|" ?ᾚ)
+ ("<~H|" ?ᾟ)
+ (">~H|" ?ᾞ)
+
+ ("<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" ?Ύ)
+ ("<'U" ?Ὕ)
+ ("`U" ?Ὺ)
+ ("<`U" ?Ὓ)
+ ("<~U" ?Ὗ)
+ ("\"U" ?Ϋ)
+
+ ("<w" ?ὡ)
+ (">w" ?ὠ)
+ ("'w" ?ώ)
+ ("<'w" ?ὥ)
+ (">'w" ?ὤ)
+ ("`w" ?ὼ)
+ ("<`w" ?ὣ)
+ (">`w" ?ὢ)
+ ("~w" ?ῶ)
+ ("<~w" ?ὧ)
+ (">~w" ?ὦ)
+
+ ("<W" ?Ὡ)
+ (">W" ?Ὠ)
+ ("'W" ?Ώ)
+ ("<'W" ?Ὥ)
+ (">'W" ?Ὤ)
+ ("`W" ?Ὼ)
+ ("<`W" ?Ὣ)
+ (">`W" ?Ὢ)
+ ("<~W" ?Ὧ)
+ (">~W" ?Ὦ)
+
+ ("<w|" ?ᾡ)
+ (">w|" ?ᾠ)
+ ("'w|" ?ῴ)
+ ("<'w|" ?ᾥ)
+ (">'w|" ?ᾤ)
+ ("`w|" ?ῲ)
+ ("<`w|" ?ᾣ)
+ (">`w|" ?ᾢ)
+ ("~w|" ?ῷ)
+ ("<~w|" ?ᾧ)
+ (">~w|" ?ᾦ)
+
+ ("<W|" ?ᾩ)
+ (">W|" ?ᾨ)
+ ("'W|" ?ῴ)
+ ("<'W|" ?ᾭ)
+ (">'W|" ?ᾬ)
+ ("<`W|" ?ᾫ)
+ (">`W|" ?ᾪ)
+ ("<~W|" ?ᾯ)
+ (">~W|" ?ᾮ)
+ )
+
+;;
+
+(quail-define-package "greek-ibycus4" "Greek" "IB" t
+"The Ibycus4 input method for Classical Greek using mule-unicode-0100-24ff."
+nil t t nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+
+ ("{((}" ?\() ("((" ?\() ; #x0028
+ ("{))}" ?\)) ("))" ?\)) ; #x0029
+ ("<<" ?«) ; #x00ab
+ (">>" ?») ; #x00bb
+
+ ("-" ?‐) ; #x2010
+ ("---" ?—) ; #x2014
+ ("||" ?‖) ; #x2016
+ ("{`}" ?‘) ("`" ?‘) ; #x2018
+ ("{'}" ?’) ("'" ?’) ; #x2019
+ ("{``}" ?“) ("``" ?“) ; #x201c
+ ("{''}" ?”) ("''" ?”) ; #x201d
+ ("{\\dag}" ?†) ("\\dag" ?†) ; #x2020
+ ("{\\ddag}" ?‡) ("\\ddag" ?‡) ; #x2021
+ ("<" ?‹) ; #x2039
+ (">" ?›) ; #x203a
+ ("$\\leftarrow$" ?←) ; #x2190
+ ("$\\rightarrow$" ?→) ; #x2192
+
+ ("?" ?;) ; #x037e ; erotimatiko
+ (";" ?·) ; #x0387 ; ano teleia
+ ("|" ?ͺ) ; #x037a ; ypogegrammeni
+
+ ("A" ?Α)
+ ("B" ?Β)
+ ("G" ?Γ)
+ ("D" ?Δ)
+ ("E" ?Ε)
+ ("Z" ?Ζ)
+ ("H" ?Η)
+ ("Q" ?Θ)
+ ("I" ?Ι)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ ("M" ?Μ)
+ ("N" ?Ν)
+ ("C" ?Ξ)
+ ("O" ?Ο)
+ ("P" ?Π)
+ ("R" ?Ρ)
+ ("S" ?Σ)
+ ("T" ?Τ)
+ ("U" ?Υ)
+ ("F" ?Φ)
+ ("X" ?Χ)
+ ("Y" ?Ψ)
+ ("W" ?Ω)
+
+ ("a" ?α)
+ ("b" ?β)
+ ("g" ?γ)
+ ("d" ?δ)
+ ("e" ?ε)
+ ("z" ?ζ)
+ ("h" ?η)
+ ("q" ?θ)
+ ("i" ?ι)
+ ("k" ?κ)
+ ("l" ?λ)
+ ("m" ?μ)
+ ("n" ?ν)
+ ("c" ?ξ)
+ ("o" ?ο)
+ ("p" ?π)
+ ("r" ?ρ)
+ ("j" ?ς) ("s " ["ς "]) ("s," ["ς,"]) ("s." ["ς."]) ("s?" ["ς;"]) ("s;" ["ς·"])
+ ("s|" ?σ) ("s" ?σ)
+ ("t" ?τ)
+ ("u" ?υ)
+ ("f" ?φ)
+ ("x" ?χ)
+ ("y" ?ψ)
+ ("w" ?ω)
+
+ ("i+" ?ϊ)
+ ("u+" ?ϋ)
+ ("V" ?Ϝ) ; DIGAMMA
+ ("v" ?ϝ) ; digamma
+ ("K+" ?Ϟ) ; KOPPA
+ ("k+" ?ϟ) ; koppa
+ ("S+" ?Ϡ) ; SAMPI
+ ("s+" ?ϡ) ; sampi
+ ("c+" ?ϲ) ; lunate sigma
+
+ ("a)" ?ἀ)
+ ("a(" ?ἁ)
+ ("a)`" ?ἂ)
+ ("a(`" ?ἃ)
+ ("a)'" ?ἄ)
+ ("a('" ?ἅ)
+ ("a)=" ?ἆ)
+ ("a(=" ?ἇ)
+
+ (")A" ?Ἀ)
+ ("(A" ?Ἁ)
+ (")`A" ?Ἂ)
+ ("(`A" ?Ἃ)
+ (")'A" ?Ἄ)
+ ("('A" ?Ἅ)
+ (")=A" ?Ἆ)
+ ("(=A" ?Ἇ)
+
+ ("e)" ?ἐ)
+ ("e(" ?ἑ)
+ ("e)`" ?ἒ)
+ ("e(`" ?ἓ)
+ ("e)'" ?ἔ)
+ ("e('" ?ἕ)
+
+ (")E" ?Ἐ)
+ ("(E" ?Ἑ)
+ (")`E" ?Ἒ)
+ ("(`E" ?Ἓ)
+ (")'E" ?Ἔ)
+ ("('E" ?Ἕ)
+
+ ("h)" ?ἠ)
+ ("h(" ?ἡ)
+ ("h)`" ?ἢ)
+ ("h(`" ?ἣ)
+ ("h)'" ?ἤ)
+ ("h('" ?ἥ)
+ ("h)=" ?ἦ)
+ ("h(=" ?ἧ)
+
+ (")H" ?Ἠ)
+ ("(H" ?Ἡ)
+ (")`H" ?Ἢ)
+ ("(`H" ?Ἣ)
+ (")'H" ?Ἤ)
+ ("('H" ?Ἥ)
+ (")=H" ?Ἦ)
+ ("(=H" ?Ἧ)
+
+ ("i)" ?ἰ)
+ ("i(" ?ἱ)
+ ("i)`" ?ἲ)
+ ("i(`" ?ἳ)
+ ("i)'" ?ἴ)
+ ("i('" ?ἵ)
+ ("i)=" ?ἶ)
+ ("i(=" ?ἷ)
+
+ (")I" ?Ἰ)
+ ("(I" ?Ἱ)
+ (")`I" ?Ἲ)
+ ("(`I" ?Ἳ)
+ (")'I" ?Ἴ)
+ ("('I" ?Ἵ)
+ (")=I" ?Ἶ)
+ ("(=I" ?Ἷ)
+
+ ("o)" ?ὀ)
+ ("o(" ?ὁ)
+ ("o)`" ?ὂ)
+ ("o(`" ?ὃ)
+ ("o)'" ?ὄ)
+ ("o('" ?ὅ)
+
+ (")O" ?Ὀ)
+ ("(O" ?Ὁ)
+ (")`O" ?Ὂ)
+ ("(`O" ?Ὃ)
+ (")'O" ?Ὄ)
+ ("('O" ?Ὅ)
+
+ ("u)" ?ὐ)
+ ("u(" ?ὑ)
+ ("u)`" ?ὒ)
+ ("u(`" ?ὓ)
+ ("u)'" ?ὔ)
+ ("u('" ?ὕ)
+ ("u)=" ?ὖ)
+ ("u(=" ?ὗ)
+
+ ("(U" ?Ὑ)
+ ("(`U" ?Ὓ)
+ ("('U" ?Ὕ)
+ ("(=U" ?Ὗ)
+
+ ("w)" ?ὠ)
+ ("w(" ?ὡ)
+ ("w)`" ?ὢ)
+ ("w(`" ?ὣ)
+ ("w)'" ?ὤ)
+ ("w('" ?ὥ)
+ ("w)=" ?ὦ)
+ ("w(=" ?ὧ)
+
+ (")W" ?Ὠ)
+ ("(W" ?Ὡ)
+ (")`W" ?Ὢ)
+ ("(`W" ?Ὣ)
+ (")'W" ?Ὤ)
+ ("('W" ?Ὥ)
+ (")=W" ?Ὦ)
+ ("(=W" ?Ὧ)
+
+ ("a`" ?ὰ)
+ ("a'" ?ά)
+ ("e`" ?ὲ)
+ ("e'" ?έ)
+ ("h`" ?ὴ)
+ ("h'" ?ή)
+ ("i`" ?ὶ)
+ ("i'" ?ί)
+ ("o`" ?ὸ)
+ ("o'" ?ό)
+ ("u`" ?ὺ)
+ ("u'" ?ύ)
+ ("w`" ?ὼ)
+ ("w'" ?ώ)
+
+ ("a)|" ?ᾀ)
+ ("a(|" ?ᾁ)
+ ("a)`|" ?ᾂ)
+ ("a(`|" ?ᾃ)
+ ("a)'|" ?ᾄ)
+ ("a('|" ?ᾅ)
+ ("a)=|" ?ᾆ)
+ ("a(=|" ?ᾇ)
+
+ (")A|" ?ᾈ)
+ ("(A|" ?ᾉ)
+ (")`A|" ?ᾊ)
+ ("(`A|" ?ᾋ)
+ (")'A|" ?ᾌ)
+ ("('A|" ?ᾍ)
+ (")=A|" ?ᾎ)
+ ("(=A|" ?ᾏ)
+
+ ("h)|" ?ᾐ)
+ ("h(|" ?ᾑ)
+ ("h)`|" ?ᾒ)
+ ("h(`|" ?ᾓ)
+ ("h)'|" ?ᾔ)
+ ("h('|" ?ᾕ)
+ ("h)=|" ?ᾖ)
+ ("h(=|" ?ᾗ)
+
+ (")H|" ?ᾘ)
+ ("(H|" ?ᾙ)
+ (")`H|" ?ᾚ)
+ ("(`H|" ?ᾛ)
+ (")'H|" ?ᾜ)
+ ("('H|" ?ᾝ)
+ (")=H|" ?ᾞ)
+ ("(=H|" ?ᾟ)
+
+ ("w)|" ?ᾠ)
+ ("w(|" ?ᾡ)
+ ("w)`|" ?ᾢ)
+ ("w(`|" ?ᾣ)
+ ("w)'|" ?ᾤ)
+ ("w('|" ?ᾥ)
+ ("w)=|" ?ᾦ)
+ ("w(=|" ?ᾧ)
+
+ (")W|" ?ᾨ)
+ ("(W|" ?ᾩ)
+ (")`W|" ?ᾪ)
+ ("(`W|" ?ᾫ)
+ (")'W|" ?ᾬ)
+ ("('W|" ?ᾭ)
+ (")=W|" ?ᾮ)
+ ("(=W|" ?ᾯ)
+
+ ("a`|" ?ᾲ)
+ ("a|" ?ᾳ)
+ ("a'|" ?ᾴ)
+ ("a=" ?ᾶ)
+ ("a=|" ?ᾷ)
+
+ ("`A" ?Ὰ)
+ ("'A" ?Ά)
+ ("A|" ?ᾼ)
+
+ (")" ?᾿) ; #x1fbf ; psili
+ ("=" ?῀) ; #x1fc0 ; perispomeni
+ ("+=" ?῁) ; #x1fc1
+
+ ("h`|" ?ῂ)
+ ("h|" ?ῃ)
+ ("h'|" ?ῄ)
+ ("h=" ?ῆ)
+ ("h=|" ?ῇ)
+
+ ("`E" ?Ὲ)
+ ("'E" ?Έ)
+
+ ("`H" ?Ὴ)
+ ("'H" ?Ή)
+ ("H|" ?ῌ)
+
+ (")`" ?῍) ; #x1fcd
+ (")'" ?῎) ; #x1fce
+ (")=" ?῏) ; #x1fcf
+
+ ("i+`" ?ῒ)
+ ("i+'" ?ΐ)
+ ("i=" ?ῖ)
+ ("i+=" ?ῗ)
+
+ ("`I" ?Ὶ)
+ ("'I" ?Ί)
+
+ ("(`" ?῝) ; #x1fdd
+ ("('" ?῞) ; #x1fde
+ ("(=" ?῟) ; #x1fdf
+
+ ("u+`" ?ῢ)
+ ("u+'" ?ΰ)
+
+ ("r)" ?ῤ)
+ ("r(" ?ῥ)
+
+ ("u=" ?ῦ)
+ ("u+=" ?ῧ)
+
+ ("`U" ?Ὺ)
+ ("'U" ?Ύ)
+
+ ("`R" ?Ῥ)
+
+ ("+`" ?῭) ; #x1fed
+ ("+'" ?΅) ; #x1fee
+ ("`" ?`) ; #x1fef ; varia
+
+ ("w`|" ?ῲ)
+ ("w|" ?ῳ)
+ ("w'|" ?ῴ)
+ ("w=" ?ῶ)
+ ("w=|" ?ῷ)
+
+ ("`O" ?Ὸ)
+ ("'O" ?Ό)
+
+ ("`W" ?Ὼ)
+ ("'W" ?Ώ)
+ ("W|" ?ῼ)
+
+ ("'" ?´) ; #x1ffd ; oxia
+ ("(" ?῾) ; #x1ffe ; dasia
+)
+
+;;
+
+(quail-define-package
+ "greek" "Greek" "Ω" nil
+ "Ελληνικά: Greek keyboard layout (ISO 8859-7)
+--------------
+
+In the right of λ key is a combination key, where
+ ΄ acute
+ ¨ diaeresis
+
+e.g.
+ ΄ + α -> ά
+ ¨ + ι -> ϊ
+ ¨ + ΄ + ι -> ΐ"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~
+;; ;: ςΣ εΕ ρΡ τΤ υΥ θΘ ιΙ οΟ πΠ [{ ]}
+;; αΑ σΣ δΔ φΦ γΓ ηΗ ξΞ κΚ λΛ ΄¨ '" \|
+;; ζΖ χΧ ψΨ ωΩ βΒ νΝ μΜ ,< .> /?
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?-)
+ ("=" ?=)
+ ("`" ?`)
+ ("q" ?\;)
+ ("w" ?ς)
+ ("e" ?ε)
+ ("r" ?ρ)
+ ("t" ?τ)
+ ("y" ?υ)
+ ("u" ?θ)
+ ("i" ?ι)
+ ("o" ?ο)
+ ("p" ?π)
+ ("[" ?\[)
+ ("]" ?\])
+ ("a" ?α)
+ ("s" ?σ)
+ ("d" ?δ)
+ ("f" ?φ)
+ ("g" ?γ)
+ ("h" ?η)
+ ("j" ?ξ)
+ ("k" ?κ)
+ ("l" ?λ)
+ (";" ?΄)
+ ("'" ?')
+ ("\\" ?\\)
+ ("z" ?ζ)
+ ("x" ?χ)
+ ("c" ?ψ)
+ ("v" ?ω)
+ ("b" ?β)
+ ("n" ?ν)
+ ("m" ?μ)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?@)
+ ("#" ?#)
+ ("$" ?$)
+ ("%" ?%)
+ ("^" ?^)
+ ("&" ?&)
+ ("*" ?*)
+ ("(" ?\()
+ (")" ?\))
+ ("_" ?_)
+ ("+" ?+)
+ ("~" ?~)
+ ("Q" ?:)
+ ("W" ?Σ)
+ ("E" ?Ε)
+ ("R" ?Ρ)
+ ("T" ?Τ)
+ ("Y" ?Υ)
+ ("U" ?Θ)
+ ("I" ?Ι)
+ ("O" ?Ο)
+ ("P" ?Π)
+ ("{" ?{)
+ ("}" ?})
+ ("A" ?Α)
+ ("S" ?Σ)
+ ("D" ?Δ)
+ ("F" ?Φ)
+ ("G" ?Γ)
+ ("H" ?Η)
+ ("J" ?Ξ)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ (":" ?¨)
+ ("\"" ?\")
+ ("|" ?|)
+ ("Z" ?Ζ)
+ ("X" ?Χ)
+ ("C" ?Ψ)
+ ("V" ?Ω)
+ ("B" ?Β)
+ ("N" ?Ν)
+ ("M" ?Μ)
+ ("<" ?<)
+ (">" ?>)
+ ("?" ??)
+
+ (";a" ?ά)
+ (";e" ?έ)
+ (";h" ?ή)
+ (";i" ?ί)
+ (";o" ?ό)
+ (";y" ?ύ)
+ (";v" ?ώ)
+ (";A" ?Ά)
+ (";E" ?Έ)
+ (";H" ?Ή)
+ (";I" ?Ί)
+ (";O" ?Ό)
+ (";Y" ?Ύ)
+ (";V" ?Ώ)
+ (":i" ?ϊ)
+ (":y" ?ϋ)
+ (":I" ?Ϊ)
+ (":Y" ?Ϋ)
+ (";:i" ?ΐ)
+ (":;i" ?ΐ)
+ (";:y" ?ΰ)
+ (":;y" ?ΰ)
+ (";<" ?«)
+ (";>" ?»))
+
+(quail-define-package
+ "greek-postfix" "GreekPost" "Ψ" nil
+ "Ελληνικά: Greek keyboard layout with postfix accents (ISO 8859-7)
+--------------
+
+In the right of λ key is a combination key, where
+ ΄ acute
+ ¨ diaeresis
+
+e.g.
+ α + ΄ -> ά
+ ι + ¨ -> ϊ
+ ι + ¨ + ΄ -> ΐ"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) -_ =+ `~
+;; ·― ςΣ εΕ ρΡ τΤ υΥ θΘ ιΙ οΟ πΠ [{ ]}
+;; αΑ σΣ δΔ φΦ γΓ ηΗ ξΞ κΚ λΛ ΄¨ '" \|
+;; ζΖ χΧ ψΨ ωΩ βΒ νΝ μΜ ,; .: /?
+
+(quail-define-rules
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?-)
+ ("=" ?=)
+ ("`" ?`)
+ ("q" ?\;)
+ ("w" ?ς)
+ ("e" ?ε)
+ ("r" ?ρ)
+ ("t" ?τ)
+ ("y" ?υ)
+ ("u" ?θ)
+ ("i" ?ι)
+ ("o" ?ο)
+ ("p" ?π)
+ ("[" ?\[)
+ ("]" ?\])
+ ("a" ?α)
+ ("s" ?σ)
+ ("d" ?δ)
+ ("f" ?φ)
+ ("g" ?γ)
+ ("h" ?η)
+ ("j" ?ξ)
+ ("k" ?κ)
+ ("l" ?λ)
+ (";" ?΄)
+ ("'" ?')
+ ("\\" ?\\)
+ ("z" ?ζ)
+ ("x" ?χ)
+ ("c" ?ψ)
+ ("v" ?ω)
+ ("b" ?β)
+ ("n" ?ν)
+ ("m" ?μ)
+ ("," ?,)
+ ("." ?.)
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?@)
+ ("#" ?#)
+ ("$" ?$)
+ ("%" ?%)
+ ("^" ?^)
+ ("&" ?&)
+ ("*" ?*)
+ ("(" ?\()
+ (")" ?\))
+ ("_" ?_)
+ ("+" ?+)
+ ("~" ?~)
+ ("Q" ?:)
+ ("W" ?Σ)
+ ("E" ?Ε)
+ ("R" ?Ρ)
+ ("T" ?Τ)
+ ("Y" ?Υ)
+ ("U" ?Θ)
+ ("I" ?Ι)
+ ("O" ?Ο)
+ ("P" ?Π)
+ ("{" ?{)
+ ("}" ?})
+ ("A" ?Α)
+ ("S" ?Σ)
+ ("D" ?Δ)
+ ("F" ?Φ)
+ ("G" ?Γ)
+ ("H" ?Η)
+ ("J" ?Ξ)
+ ("K" ?Κ)
+ ("L" ?Λ)
+ (":" ?¨)
+ ("\"" ?\")
+ ("|" ?|)
+ ("Z" ?Ζ)
+ ("X" ?Χ)
+ ("C" ?Ψ)
+ ("V" ?Ω)
+ ("B" ?Β)
+ ("N" ?Ν)
+ ("M" ?Μ)
+ ("<" ?<)
+ (">" ?>)
+ ("?" ??)
+
+ ("a;" ?ά)
+ ("e;" ?έ)
+ ("h;" ?ή)
+ ("i;" ?ί)
+ ("o;" ?ό)
+ ("y;" ?ύ)
+ ("v;" ?ώ)
+ ("A;" ?Ά)
+ ("E;" ?Έ)
+ ("H;" ?Ή)
+ ("I;" ?Ί)
+ ("O;" ?Ό)
+ ("Y;" ?Ύ)
+ ("V;" ?Ώ)
+ ("i:" ?ϊ)
+ ("y:" ?ϋ)
+ ("I:" ?Ϊ)
+ ("Y:" ?Ϋ)
+ ("i:;" ?ΐ)
+ ("i;:" ?ΐ)
+ ("y:;" ?ΰ)
+ ("y;:" ?ΰ)
+ ;; These two are asymmetric with ";<" and ";>" in "greek" input
+ ;; method. But, as the other Latin postfix methods adopt "<<" and
+ ;; ">>", it may be better to follow them.
+ ("<<" ?«)
+ (">>" ?»))
+
+
+;;; greek.el ends here
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
new file mode 100644
index 00000000000..56a244f4574
--- /dev/null
+++ b/lisp/leim/quail/hangul.el
@@ -0,0 +1,556 @@
+;;; hangul.el --- Korean Hangul input method
+
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
+
+;; Author: Jihyun Cho <jihyun.jo@gmail.com>
+;; Keywords: multilingual, input method, Korean, Hangul
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file is to implement the following hangul automata:
+;; - Hangul 2-Bulsik input method
+;; - Hangul 3-Bulsik final input method
+;; - Hangul 3-Bulsik 390 input method
+
+;;; Code:
+
+(require 'quail)
+(require 'hanja-util)
+
+;; Hangul double Jamo table.
+;; The format is an alist of JAMO-TYPE vs. DOUBLE-JAMO-TABLE.
+;;
+;; JAMO-TYPE is a symbol `cho' for Choseong, `jung' for Jungseong, and
+;; `jong' for Jongseong.
+;;
+;; DOUBLE-JAMO-TABLE is an alist of Jamo index vs. the vector of Jamo
+;; indies that can be combined with the car part.
+;;
+;; Jamo index is a relative index in `hangul Compatibility Jamo' area
+;; of the Unicode (i.e. 1 for U+3131).
+
+(defconst hangul-djamo-table
+ '((cho . ((1 . [1]) ; Choseong
+ (7 . [7])
+ (18 . [18])
+ (21 . [21])
+ (24 . [24])))
+ (jung . ((39 . [31 32 51]) ; Jungseong
+ (44 . [35 36 51])
+ (49 . [51])))
+ (jong . ((1 . [1 21]) ; Jongseong
+ (4 . [24 30])
+ (9 . [1 17 18 21 28 29 30])
+ (18 . [18 21])
+ (21 . [21])))))
+
+;; Hangul 2-Bulsik keymap.
+;; It converts an ASCII code A-Z, a-z, to the corresponding hangul
+;; Jamo index.
+
+(defconst hangul2-keymap
+ [17 48 26 23 7 9 30 39 33 35 31 51 49 44 32 36 18 1 4 21 37 29 24 28 43 27])
+
+;; Hangul 3-Bulsik final keymap. 3-Bulsik use full keyboard layout.
+;; Therefore, we must map all printable ASCII codes (`!' to `~')
+;; to Hangul 3-Bulsik codes.
+;; Other parts are the same as `hangul2-keymap'.
+(defconst hangul3-keymap
+ [2 183 24 15 14 8220 120 39 126 8221 43 44 41 46 74 119 30 22 18 78 83
+ 68 73 85 79 52 110 44 62 46 33 10 7 63 27 12 5 11 69 48 55 49 50 51
+ 34 45 56 57 29 16 6 13 54 3 28 20 53 26 40 58 60 61 59 42 23 79 71
+ 86 72 66 84 96 109 115 93 116 122 113 118 121 21 67 4 70 99 74 9 1
+ 101 17 37 92 47 8251])
+
+;; Hangul 3-Bulsik 390 keymap.
+;; The role is the same as `hangul3-keymap'.
+(defconst hangul390-keymap
+ [24 34 35 36 37 38 120 40 41 42 43 44 45 46 73 119 30 22 18 77 82 67 72
+ 84 78 58 110 50 61 51 63 64 7 33 11 10 27 2 47 39 56 52 53 54 49 48
+ 57 62 29 68 6 59 55 16 28 20 60 26 91 92 93 94 95 96 23 78 70 85 71
+ 65 83 90 109 115 87 116 122 113 118 121 21 66 4 69 99 73 9 1 101 17
+ 123 124 125 126])
+
+(defvar hangul-im-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\d" 'hangul-delete-backward-char)
+ (define-key map [f9] 'hangul-to-hanja-conversion)
+ (define-key map [Hangul_Hanja] 'hangul-to-hanja-conversion)
+ map)
+ "Keymap for Hangul method. It is used by all Hangul input methods.")
+
+;; Current input character buffer. Store separated hangul character.
+;; The first and second are Choseong position.
+;; The third and forth are Jungseong position.
+;; The fifth and sixth are Jongseong position.
+;; The second, forth and sixth are double Jamo position.
+(defvar hangul-queue
+ (make-vector 6 0))
+
+(defsubst notzerop (number)
+ (not (zerop number)))
+
+(defsubst alphabetp (char)
+ (or (and (>= char ?A) (<= char ?Z))
+ (and (>= char ?a) (<= char ?z))))
+
+(defun hangul-character (cho jung jong)
+ "Convert CHO, JUNG, JONG to the precomposed `Hangul Syllables' character.
+CHO, JUNG, JONG are relative indices in `Hangul Compatibility Jamo' of Unicode.
+Return a zero-length string if the conversion fails."
+ (or
+ (decode-char
+ 'ucs
+ (if (and (/= cho 0) (/= jung 0))
+ (+ #xac00
+ (* 588
+ (- cho
+ (cond ((< cho 3) 1)
+ ((< cho 5) 2)
+ ((< cho 10) 4)
+ ((< cho 20) 11)
+ (t 12))))
+ (* 28 (- jung 31))
+ (- jong
+ (cond ((< jong 8) 0)
+ ((< jong 19) 1)
+ ((< jong 25) 2)
+ (t 3))))
+ (+ #x3130
+ (cond ((/= cho 0) cho)
+ ((/= jung 0) jung)
+ ((/= jong 0) jong)))))
+ ""))
+
+(defun hangul-insert-character (&rest queues)
+ "Insert characters generated from QUEUES.
+Each queue has the same form as `hangul-queue'.
+Setup `quail-overlay' to the last character."
+ (if (and mark-active transient-mark-mode)
+ (progn
+ (delete-region (region-beginning) (region-end))
+ (deactivate-mark)))
+ (quail-delete-region)
+ (let ((first (car queues)))
+ (insert
+ (hangul-character
+ (+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1)))
+ (+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3)))
+ (+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5))))))
+ (move-overlay quail-overlay (overlay-start quail-overlay) (point))
+ (dolist (queue (cdr queues))
+ (insert
+ (hangul-character
+ (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1)))
+ (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3)))
+ (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))
+ (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))
+
+(defun hangul-djamo (jamo char1 char2)
+ "Return the double Jamo index calculated from the arguments.
+JAMO is a type of Hangul Jamo; `cho', `jung', or `jong'.
+CHAR1 and CHAR2 are Hangul Jamo indices.
+Return nil if CHAR1 and CHAR2 can not be combined."
+ (let* ((jamo (cdr (assoc jamo hangul-djamo-table)))
+ (char1 (cdr (assoc char1 jamo))))
+ (if char1
+ (let ((i (length char1)))
+ (or (catch 'found
+ (while (> i 0)
+ (if (= char2 (aref char1 (1- i)))
+ (throw 'found i))
+ (setf i (1- i))))
+ 0))
+ 0)))
+
+(defsubst hangul2-input-method-jaum (char)
+ "Store Hangul Jamo indice CHAR in `hangul-queue'.
+It is a Hangul 2-Bulsik Jaum.
+This function processes a Hangul 2-Bulsik Jaum.
+The Hangul 2-Bulsik is composed of a Jaum and a Moum.
+The Jaum can be located in a Choseong position and a Jongseong position.
+Unless the function inserts CHAR to `hangul-queue',
+commit current `hangul-queue' and then set a new `hangul-queue',
+and insert CHAR to new `hangul-queue'."
+ (if (cond ((zerop (aref hangul-queue 0))
+ (aset hangul-queue 0 char))
+ ((and (zerop (aref hangul-queue 1))
+ (zerop (aref hangul-queue 2))
+ (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
+ (aset hangul-queue 1 char))
+ ((and (zerop (aref hangul-queue 4))
+ (notzerop (aref hangul-queue 2))
+ (/= char 8)
+ (/= char 19)
+ (/= char 25)
+ (numberp
+ (hangul-character
+ (+ (aref hangul-queue 0)
+ (hangul-djamo
+ 'cho
+ (aref hangul-queue 0)
+ (aref hangul-queue 1)))
+ (+ (aref hangul-queue 2)
+ (hangul-djamo
+ 'jung
+ (aref hangul-queue 2)
+ (aref hangul-queue 3)))
+ char)))
+ (aset hangul-queue 4 char))
+ ((and (zerop (aref hangul-queue 5))
+ (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
+ (numberp
+ (hangul-character
+ (+ (aref hangul-queue 0)
+ (hangul-djamo
+ 'cho
+ (aref hangul-queue 0)
+ (aref hangul-queue 1)))
+ (+ (aref hangul-queue 2)
+ (hangul-djamo
+ 'jung
+ (aref hangul-queue 2)
+ (aref hangul-queue 3)))
+ (+ (aref hangul-queue 4)
+ (hangul-djamo
+ 'jong
+ (aref hangul-queue 4)
+ char)))))
+ (aset hangul-queue 5 char)))
+ (hangul-insert-character hangul-queue)
+ (hangul-insert-character hangul-queue
+ (setq hangul-queue (vector char 0 0 0 0 0)))))
+
+(defsubst hangul2-input-method-moum (char)
+ "Store Hangul Jamo indice CHAR in `hangul-queue'.
+It is a Hangul 2-Bulsik Moum.
+This function processes a Hangul 2-Bulsik Moum.
+The Moum can be located in a Jungseong position.
+Other parts are the same as a `hangul2-input-method-jaum'."
+ (if (cond ((zerop (aref hangul-queue 2))
+ (aset hangul-queue 2 char))
+ ((and (zerop (aref hangul-queue 3))
+ (zerop (aref hangul-queue 4))
+ (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
+ (aset hangul-queue 3 char)))
+ (hangul-insert-character hangul-queue)
+ (let ((next-char (vector 0 0 char 0 0 0)))
+ (cond ((notzerop (aref hangul-queue 5))
+ (aset next-char 0 (aref hangul-queue 5))
+ (aset hangul-queue 5 0))
+ ((notzerop (aref hangul-queue 4))
+ (aset next-char 0 (aref hangul-queue 4))
+ (aset hangul-queue 4 0)))
+ (hangul-insert-character hangul-queue
+ (setq hangul-queue next-char)))))
+
+(defsubst hangul3-input-method-cho (char)
+ "Store Hangul Jamo indice CHAR in `hangul-queue'.
+It is a Hangul 3-Bulsik Choseong.
+This function processes a Hangul 3-Bulsik Choseong.
+The Hangul 3-Bulsik is composed of a Choseong, a Jungseong and a Jongseong.
+The Choseong can be located in a Choseong position.
+Other parts are the same as a `hangul2-input-method-jaum'."
+ (if (cond ((and (zerop (aref hangul-queue 0))
+ (zerop (aref hangul-queue 4)))
+ (aset hangul-queue 0 char))
+ ((and (zerop (aref hangul-queue 1))
+ (zerop (aref hangul-queue 2))
+ (notzerop (hangul-djamo 'cho (aref hangul-queue 0) char)))
+ (aset hangul-queue 1 char)))
+ (hangul-insert-character hangul-queue)
+ (hangul-insert-character hangul-queue
+ (setq hangul-queue (vector char 0 0 0 0 0)))))
+
+(defsubst hangul3-input-method-jung (char)
+ "Store Hangul Jamo indice CHAR in `hangul-queue'.
+It is a Hangul 3-Bulsik Jungseong.
+This function processes a Hangul 3-Bulsik Jungseong.
+The Jungseong can be located in a Jungseong position.
+Other parts are the same as a `hangul3-input-method-cho'."
+ (if (cond ((and (zerop (aref hangul-queue 2))
+ (zerop (aref hangul-queue 4)))
+ (aset hangul-queue 2 char))
+ ((and (zerop (aref hangul-queue 3))
+ (notzerop (hangul-djamo 'jung (aref hangul-queue 2) char)))
+ (aset hangul-queue 3 char)))
+ (hangul-insert-character hangul-queue)
+ (hangul-insert-character hangul-queue
+ (setq hangul-queue (vector 0 0 char 0 0 0)))))
+
+(defsubst hangul3-input-method-jong (char)
+ "Store Hangul Jamo indice CHAR in `hangul-queue'.
+It is a Hangul 3-Bulsik Jongseong.
+This function processes a Hangul 3-Bulsik Jongseong.
+The Jongseong can be located in a Jongseong position.
+Other parts are the same as a `hangul3-input-method-cho'."
+ (if (cond ((and (zerop (aref hangul-queue 4))
+ (notzerop (aref hangul-queue 0))
+ (notzerop (aref hangul-queue 2))
+ (numberp
+ (hangul-character
+ (+ (aref hangul-queue 0)
+ (hangul-djamo
+ 'cho
+ (aref hangul-queue 0)
+ (aref hangul-queue 1)))
+ (+ (aref hangul-queue 2)
+ (hangul-djamo
+ 'jung
+ (aref hangul-queue 2)
+ (aref hangul-queue 3)))
+ char)))
+ (aset hangul-queue 4 char))
+ ((and (zerop (aref hangul-queue 5))
+ (notzerop (hangul-djamo 'jong (aref hangul-queue 4) char))
+ (numberp
+ (hangul-character
+ (+ (aref hangul-queue 0)
+ (hangul-djamo
+ 'cho
+ (aref hangul-queue 0)
+ (aref hangul-queue 1)))
+ (+ (aref hangul-queue 2)
+ (hangul-djamo
+ 'jung
+ (aref hangul-queue 2)
+ (aref hangul-queue 3)))
+ (+ (aref hangul-queue 4)
+ (hangul-djamo
+ 'jong
+ (aref hangul-queue 4)
+ char)))))
+ (aset hangul-queue 5 char)))
+ (hangul-insert-character hangul-queue)
+ (if (zerop (apply '+ (append hangul-queue nil)))
+ (hangul-insert-character (setq hangul-queue (vector 0 0 0 0 char 0)))
+ (hangul-insert-character hangul-queue
+ (setq hangul-queue (vector 0 0 0 0 char 0))))))
+
+(defun hangul-delete-backward-char ()
+ "Delete the previous hangul character by Jaso units."
+ (interactive)
+ (let ((i 5))
+ (while (and (> i 0) (zerop (aref hangul-queue i)))
+ (setq i (1- i)))
+ (aset hangul-queue i 0))
+ (if (notzerop (apply '+ (append hangul-queue nil)))
+ (hangul-insert-character hangul-queue)
+ (delete-char -1)))
+
+(defun hangul-to-hanja-conversion ()
+ "Convert the previous hangul character to the corresponding hanja character.
+When a Korean input method is off, convert the following hangul character."
+ (interactive)
+ (let ((echo-keystrokes 0)
+ delete-func
+ hanja-character)
+ (if (and (overlayp quail-overlay) (overlay-start quail-overlay))
+ (progn
+ (setq hanja-character (hangul-to-hanja-char (preceding-char)))
+ (setq delete-func (lambda () (delete-char -1))))
+ (setq hanja-character (hangul-to-hanja-char (following-char)))
+ (setq delete-func (lambda () (delete-char 1))))
+ (when hanja-character
+ (funcall delete-func)
+ (insert hanja-character)
+ (setq hangul-queue (make-vector 6 0))
+ (if (and (overlayp quail-overlay) (overlay-start quail-overlay))
+ (move-overlay quail-overlay (point) (point))))))
+
+;; Support function for `hangul2-input-method'. Actually, this
+;; function handles the Hangul 2-Bulsik. KEY is an entered key code
+;; used for looking up `hangul2-keymap'."
+(defun hangul2-input-method-internal (key)
+ (let ((char (+ (aref hangul2-keymap (1- (% key 32)))
+ (cond ((or (= key ?O) (= key ?P)) 2)
+ ((or (= key ?E) (= key ?Q) (= key ?R)
+ (= key ?T) (= key ?W)) 1)
+ (t 0)))))
+ (if (< char 31)
+ (hangul2-input-method-jaum char)
+ (hangul2-input-method-moum char))))
+
+(defun hangul2-input-method (key)
+ "2-Bulsik input method."
+ (if (or buffer-read-only (not (alphabetp key)))
+ (list key)
+ (quail-setup-overlays nil)
+ (let ((input-method-function nil)
+ (echo-keystrokes 0)
+ (help-char nil))
+ (setq hangul-queue (make-vector 6 0))
+ (hangul2-input-method-internal key)
+ (unwind-protect
+ (catch 'exit-input-loop
+ (while t
+ (let* ((seq (read-key-sequence nil))
+ (cmd (lookup-key hangul-im-keymap seq))
+ key)
+ (cond ((and (stringp seq)
+ (= 1 (length seq))
+ (setq key (aref seq 0))
+ (alphabetp key))
+ (hangul2-input-method-internal key))
+ ((commandp cmd)
+ (call-interactively cmd))
+ (t
+ (setq unread-command-events
+ (nconc (listify-key-sequence seq)
+ unread-command-events))
+ (throw 'exit-input-loop nil))))))
+ (quail-delete-overlays)))))
+
+;; Support function for `hangul3-input-method'. Actually, this
+;; function handles the Hangul 3-Bulsik final. KEY is an entered key
+;; code used for looking up `hangul3-keymap'."
+(defun hangul3-input-method-internal (key)
+ (let ((char (aref hangul3-keymap (- key 33))))
+ (cond ((and (> char 92) (< char 123))
+ (hangul3-input-method-cho (- char 92)))
+ ((and (> char 65) (< char 87))
+ (hangul3-input-method-jung (- char 35)))
+ ((< char 31)
+ (hangul3-input-method-jong char))
+ (t
+ (setq hangul-queue (make-vector 6 0))
+ (insert (decode-char 'ucs char))
+ (move-overlay quail-overlay (point) (point))))))
+
+(defun hangul3-input-method (key)
+ "3-Bulsik final input method."
+ (if (or buffer-read-only (< key 33) (>= key 127))
+ (list key)
+ (quail-setup-overlays nil)
+ (let ((input-method-function nil)
+ (echo-keystrokes 0)
+ (help-char nil))
+ (setq hangul-queue (make-vector 6 0))
+ (hangul3-input-method-internal key)
+ (unwind-protect
+ (catch 'exit-input-loop
+ (while t
+ (let* ((seq (read-key-sequence nil))
+ (cmd (lookup-key hangul-im-keymap seq))
+ key)
+ (cond ((and (stringp seq)
+ (= 1 (length seq))
+ (setq key (aref seq 0))
+ (and (>= key 33) (< key 127)))
+ (hangul3-input-method-internal key))
+ ((commandp cmd)
+ (call-interactively cmd))
+ (t
+ (setq unread-command-events
+ (nconc (listify-key-sequence seq)
+ unread-command-events))
+ (throw 'exit-input-loop nil))))))
+ (quail-delete-overlays)))))
+
+;; Support function for `hangul390-input-method'. Actually, this
+;; function handles the Hangul 3-Bulsik 390. KEY is an entered key
+;; code used for looking up `hangul390-keymap'."
+(defun hangul390-input-method-internal (key)
+ (let ((char (aref hangul390-keymap (- key 33))))
+ (cond ((or (and (> char 86) (< char 91))
+ (and (> char 96) (< char 123)))
+ (hangul3-input-method-cho (- char (if (< char 97) 86 92))))
+ ((and (> char 64) (< char 86))
+ (hangul3-input-method-jung (- char 34)))
+ ((< char 31)
+ (hangul3-input-method-jong char))
+ (t
+ (setq hangul-queue (make-vector 6 0))
+ (insert (decode-char 'ucs char))
+ (move-overlay quail-overlay (point) (point))))))
+
+(defun hangul390-input-method (key)
+ "3-Bulsik 390 input method."
+ (if (or buffer-read-only (< key 33) (>= key 127))
+ (list key)
+ (quail-setup-overlays nil)
+ (let ((input-method-function nil)
+ (echo-keystrokes 0)
+ (help-char nil))
+ (setq hangul-queue (make-vector 6 0))
+ (hangul390-input-method-internal key)
+ (unwind-protect
+ (catch 'exit-input-loop
+ (while t
+ (let* ((seq (read-key-sequence nil))
+ (cmd (lookup-key hangul-im-keymap seq))
+ key)
+ (cond ((and (stringp seq)
+ (= 1 (length seq))
+ (setq key (aref seq 0))
+ (and (>= key 33) (< key 127)))
+ (hangul390-input-method-internal key))
+ ((commandp cmd)
+ (call-interactively cmd))
+ (t
+ (setq unread-command-events
+ (nconc (listify-key-sequence seq)
+ unread-command-events))
+ (throw 'exit-input-loop nil))))))
+ (quail-delete-overlays)))))
+
+;; Text shown by describe-input-method. Set to a proper text by
+;; hangul-input-method-activate.
+(defvar hangul-input-method-help-text nil)
+(make-variable-buffer-local 'hangul-input-method-help-text)
+
+;;;###autoload
+(defun hangul-input-method-activate (input-method func help-text &rest args)
+ "Activate Hangul input method INPUT-METHOD.
+FUNC is a function to handle input key.
+HELP-TEXT is a text set in `hangul-input-method-help-text'."
+ (setq deactivate-current-input-method-function 'hangul-input-method-deactivate
+ describe-current-input-method-function 'hangul-input-method-help
+ hangul-input-method-help-text help-text)
+ (quail-delete-overlays)
+ (if (eq (selected-window) (minibuffer-window))
+ (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
+ (set (make-local-variable 'input-method-function) func))
+
+(defun hangul-input-method-deactivate ()
+ "Deactivate the current Hangul input method."
+ (interactive)
+ (unwind-protect
+ (progn
+ (quail-hide-guidance)
+ (quail-delete-overlays)
+ (setq describe-current-input-method-function nil))
+ (kill-local-variable 'input-method-function)))
+
+(define-obsolete-function-alias
+ 'hangul-input-method-inactivate
+ 'hangul-input-method-deactivate "24.3")
+
+(defun hangul-input-method-help ()
+ "Describe the current Hangul input method."
+ (interactive)
+ (with-output-to-temp-buffer "*Help*"
+ (princ hangul-input-method-help-text)))
+
+(provide 'hangul)
+
+;; Local Variables:
+;; generated-autoload-load-name: "quail/hangul"
+;; End:
+
+;;; hangul.el ends here
diff --git a/lisp/leim/quail/hanja-jis.el b/lisp/leim/quail/hanja-jis.el
new file mode 100644
index 00000000000..2c7eebb8345
--- /dev/null
+++ b/lisp/leim/quail/hanja-jis.el
@@ -0,0 +1,527 @@
+;;; hanja-jis.el --- Quail package for inputting Korean Hanja (JISX0208) -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Korean, Hangul
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "korean-hanja-jis" "Korean" "$B4A(B2" t
+ "2$(C9z=D(BJIS$B4A;z(B: $B3:aD$(CGO4B(B $B4A;z$(C@G(B $B1$$(C@;(B $(CGQ1[(B2$(C9z$B<0$(C@87N(B $B8F=P$(CGO?)(B $BA*Z$(B"
+ nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("rk" "$B1]2>2@2A2B2C2D2E2G2H2K2M2N2Q2T2W2X2`2o3976P$PqQ+RjS'[H[I`]aPcwgWhSkEkhlKlhmF(B")
+ ("rkr" "$B3F3J3L3P3Q3S3U5Q5S9oH9RJS>T=WmXBZ([d]W`Bk4l;r((B")
+ ("rks" "$B064%4&4)4/43444B4G4H4J4N4V:&:):1?{U!XLYc[8[K[Y[e`CarcCecgek]s*su(B")
+ ("rkf" "$B2p3e3i3k3l7GP"[+brcqf;iypbpv(B")
+ ("rka" "$B4*4.46484:4;4E4F4U7g848::0QaT,T0VHY"Y~\m]>^@aQbWeHiTm^nGoHs|(B")
+ ("rkq" "$B2!389C9gL(R:b5fpo^(B")
+ ("rkd" "$B2,3`6/607D9/959>9G9K9P9V9]9_9dFzP6Q,S3U*V>XMY,[:[|aEbee,eZf5i(jvlora(B")
+ ("ro" "$B2B2U2p2r2~3'3)3+3,3.313435383;8DP"P$PCQsXAXhYb\4^taNb5k;(B")
+ ("ror" "$B5RS=(B")
+ ("rod" "$B9#99dkf=f>o3(B")
+ ("ri" "$B2X(B")
+ ("rir" "$BnS(B")
+ ("rj" "$B5n5o5p5q5r5t5w5x<V?x?~P`PbTRZ!Z)Z*]0_Yc@d(gplwn1nSnj(B")
+ ("rjs" "$B4%6R7o7r7z80X4Ykg'iJkim!qZ(B")
+ ("rjf" "$B3i7G7f8pC4KqPu[?[\]ccq(B")
+ ("rja" "$B4;7p7u8!84Q-QxQyQzQ{\}b[g@sX(B")
+ ("rjq" "$B5h619e=&Qg(B")
+ ("rp" "$B7F7GPuX\br(B")
+ ("rur" "$B2>3J3V3W7b7cPqYH\|g-h#k.ojqnr/rps&(B")
+ ("rus" "$B3_3o7x8#8$8(8*8+8/G{KzLzPWVtWz[G`Fa+d*f0l$s$(B")
+ ("ruf" "$B5K7@7h7i7k7mLRQSY1YIYMe~r!(B")
+ ("rua" "$B3y7s8,XDY:]>d/heni(B")
+ ("ruq" "$B3fKKXDnw(B")
+ ("rud" "$B5~6%6*6-6@6C797B7D7I7J7P7T7U7Y7Z7[7_9.999<9E9L:"P7Q?QDQHQmR&R'S+WMX]\{_i`{a9a[b~e%e4e;fVfzh3krmKmtpopts](B")
+ ("rP" "$B2|3#3&3,5(787<7@7K7L7N7O7Q7R7W7\:fFOU|W@X)[G^da8b#c4d"e;eki)kSl0r!s1(B")
+ ("rh" "$B6l8E8G8H8I8K8N8O8S8T8V8Z8[8\8]9F9M9Q9b9i9p;)<J?,C!ONPFQYQjRmZ?ZJZ^[W[][^\I\_]xa`b(bPb\cLd2f*f6fxiVjCk8kFkUlKmcn~pQrurzsi(B")
+ ("rhr" "$B6J9p9r9s9tC+H#S-ZO[g\`mXq~(B")
+ ("rhs" "$B:$:%:+:-:.TgVBW}[~^xhBjnrArJs.(B")
+ ("rhf" "$B3j9|\K]qs3(B")
+ ("rhd" "$B6!6&62636u8x8y9&9)95969WPeW0YJ[}\Jd3iOi^i_lop_(B")
+ ("rhk" "$B1;2I2J2L2[2]2a8S8X8YFiTFTnTrXyfxhTixjglvpy(B")
+ ("rhkr" "$B3G3TZ2Z<[v\Zayb_oWp9(B")
+ ("rhks" "$B4'4142474=4>4C4I4P4Q4S4X4[4\6z?{P%QN]Y^ub9eEeGf%k7oQopsA(B")
+ ("rhkf" "$B3g3hH&I0Qi[XfZ(B")
+ ("rhkd" "$B3H6)688w9-9[9\T]W"Z2[%[&[Z^+bhc~d!e&e-fykToJ(B")
+ ("rho" "$B3]757SS%XyYL[Jjh(B")
+ ("rhl" "$B2q2t2u2x2z2}3!P*PzTUW_XC\G`skK(B")
+ ("rhlr" "$Bg2qE(B")
+ ("rhld" "$B9(9I9O9l^3mDo)(B")
+ ("ry" "$B3I3P3S3z5j6#6+6,65666:6>8r8s9'9*9;9J9Y9Z;->7R{UHYxZJ\r_$`Db)c#c\fKg1i`m]n[q-qaqb(B")
+ ("rn" "$B11192$2%2*3C555V5W5X5_5a5d5e5f5l5q6e6f6g6h6i6j6k6m6n6o6p6q7)8{8}9$949=9B9XC!G#H7KUP}QJR"R?RkSRU=UBUdVOV}V~WaW|XvY+Yl[M[N]?]X]\a.aLbZc`d@gOgQgqhgiUjMjdk2kMkpmsn)n9nlplq'qDq\r-szs}(B")
+ ("rnr" "$B5E5F5G6I9m9qSxT"[xdxkqlr(B")
+ ("rns" "$B7/727374[ub0b1c[f:je(B")
+ ("rnf" "$B6~7!7"KYPcRPVA(B")
+ ("rnd" "$B5\5]5gcVm;(B")
+ ("rnjs" "$B4+4,5s7q7t7w7}7~8"R%R0RKT!X+[{\^bGe<ipq"(B")
+ ("rnjf" "$B7!OOP-RP`Um,om(B")
+ ("rnp" "$B4y5"50B|DYQ\R<[z]$]Eb'dOgLkLlnm,q9q?(B")
+ ("rnl" "$B5"5.5455S@[z]Eb's}(B")
+ ("rnlr" "$BDOVn(B")
+ ("rb" "$B0*1.5,5j6+6e7=7>:"DPTwYdYw\\b#bkcad}eYj_lbm|oaqDr-(B")
+ ("rbs" "$B556Q6]d0nbsKs}(B")
+ ("rbf" "$B5L(B")
+ ("rmr" "$B2D3W6K7`7a7d9nP4QnUqV![yh{n<(B")
+ ("rms" "$B6O6P6R6T6Z6\6`6a:,Xi\]`wbbhAk3ncq<(B")
+ ("rmf" "$B7@k?(B")
+ ("rma" "$B6S6W6X6Y6^6_6b8i:#SaZ"jPsX(B")
+ ("rmq" "$B075Z5^5b5h5i5kV)(B")
+ ("rmd" "$B919NOJOKQ>Wqbb(B")
+ ("rl" "$B0k4k4l4o4p4q4s4t4v4w4z4{4|4}4~5!5$5%5&5'5*5-5/5253585;5=5@5o778J8k8p:j:k:l<(B6H)IIL'P4PXQCQpSOSZT-TtV?W1YVZ\Zz[.[9[L[w\H]c]f]k^?aCc2cEe:f3f4fMk+k1kxl1leq@qVqgr?sJ(B")
+ ("rlr" "$B5J(B")
+ ("rls" "$B6[(B")
+ ("rlf" "$B5H5K5MPKYI(B")
+ ("rla" "$B6b(B")
+ ("Rlr" "$B5J(B")
+ ("sk" "$BF`FaFqQ5U1XoY.Y<Y=[kdy(B")
+ ("skr" "$BBz(B")
+ ("sks" "$BCHFqZ:_kl_(B")
+ ("skf" "$BFhYT^:(B")
+ ("ska" "$BCKFnFoSGU3n((B")
+ ("skq" "$BG<jU(B")
+ ("skd" "$BG9L<[((B")
+ ("so" "$BBQF`FbFwG5G6G=mr(B")
+ ("sid" "$B>nUP(B")
+ ("su" "$B=wY<Y=h'(B")
+ ("sus" "$BG/G2bzmY(B")
+ ("suf" "$BYT^:(B")
+ ("sua" "$BG0WwY@\,(B")
+ ("suq" "$B@]G1Ypm:oR(B")
+ ("sud" "$BG+Sf_?`Xfd(B")
+ ("sP" "$BG)Zc(B")
+ ("sh" "$BEXE[E\G>RsUWVfW8`obug*gBqN(B")
+ ("shd" "$BG;G?G@Q/(B")
+ ("shk" "$B<6(B")
+ ("shl" "$BG:G>X=g*q/(B")
+ ("sy" "$BE.G"U>Yz\vo?o_r)(B")
+ ("sn" "$BfU(B")
+ ("sns" "$BUD(B")
+ ("snf" "$BRefmkD(B")
+ ("sb" "$BI3WY`=nf(B")
+ ("sbr" "$BWYjHjI(B")
+ ("smd" "$BG=(B")
+ ("sl" "$BE%FtG)G*Wb_>_Pg7(B")
+ ("slr" "$BE.F?(B")
+ ("slf" "$BFtWbZc(B")
+ ("sla" "$BDBWl(B")
+ ("ek" "$BB?BgCcTl(B")
+ ("eks" "$B1_C"C0C1C4C6C;C<C=C@CACCCDCECGCICJFNFXP9SET%WAXIXUZR\g^Z`NaUeKh[iijXj{j|nBs((B")
+ ("ekf" "$BC#RtU'WeZ%_}`\m}orpZpg(B")
+ ("eka" "$BC4C8C9C?CLF^S7S8T`XkY?]__,_8abb>g<i!k)k}q5(B")
+ ("ekq" "$B7#EkEzF'Quh)(B")
+ ("ekd" "$BE^EbEdEvE|F2F5Q8Vq[c\+^oaDbUc'j0j;j}oFs^(B")
+ ("eo" "$B10BPBRBSBTBWB^B_BbBcBeBgFXT2UtVhZ,Z-`^gJi7o>p0(B")
+ ("ejr" "$BFAW\(B")
+ ("eh" "$B0p?^D)D7EHEIEKELEOEQERESETEUEYE]EaEgEhEiEmEnEpEqEsExE~F(F+F3F:F;R[T&V:Y[Y\YqZ.[7[m\*]%]9^9^mbQcKe6eBeCe{h8h9k/lum%mmokpkqC(B")
+ ("ehr" "$B<3FBFDFEFFFGFHFI`1`9`We{l&qqsb(B")
+ ("ehs" "$B=cFUFWFXFYFZF[F\Z}_wa&n,q+(B")
+ ("ehf" "$BFMF\Rt[S(B")
+ ("ehd" "$B4R6ME_E`ElEoF!F/F0F1F4F6F7F8F9F<Q*\u_.aVdig^gtr<s)sj(B")
+ ("en" "$B1%3u?`EMENEZEwF&F,FIP5Y5ceflh:iQjEjFl&nFr((B")
+ ("ens" "$BFVF[F\F_g=n,(B")
+ ("emr" "$BF@(B")
+ ("emd" "$BEPEtEuEyF#F%F*F-VS\t^naVc$d[d\eX(B")
+ ("fk" "$B;IMeMfMgSIXqapaziGn6oUozq`(B")
+ ("fkr" "$B3J3ZMlMmMnMoS>\[_``8`dqQ(B")
+ ("fks" "$BMpMqMsMvP,UO]3_Q_s`%k&oVolsB(B")
+ ("fkf" "$BQoSIT?T@dzme(B")
+ ("fka" "$BMrMtMuMwQ0U:Z0]4dWeqe|k"k5nN(B")
+ ("fkq" "$B@"O9YG[VgDgEoM(B")
+ ("fkd" "$BBlBmO-O/O1O2O5O:[-`f`gh>j'lplt(B")
+ ("fo" "$BPTWR(B")
+ ("fod" "$BNd(B")
+ ("fir" "$BN+N,Z6a@(B")
+ ("fid" "$BL:N+N<N>NBNCNHNINJNLPoQ@QZSJdmdnjllpltmQmRr4(B")
+ ("fu" "$B023BEWK{N7N8N9NeNoO$O?Q6R/S:W*[q]-`4`5avbjdze8eFg0gFh-i<iCiZjBoLocqfqk(B")
+ ("fur" "$BNONqNrV'[6]+],]._Ma|c*m`mapNr/(B")
+ ("fus" "$BNgNmNxNyNzN{N}N~O!O"O#SXXxYcZ;\Bf_gHmSo:rY(B")
+ ("fuf" "$BNsNtNuNvQXY`^0(B")
+ ("fua" "$B3yNwN|R=T~ZL_2_R(B")
+ ("fuq" "$BND`Zr'(B")
+ ("fud" "$BNNNaNbNfNgNhNjNkNmNnNpSz]2_:f9fYiYpMryst(B")
+ ("fP" "$BK-NcNiNlc9h-nTp1rg(B")
+ ("fh" "$B02:mH'IyN:O%O&O'O(O)O*O+O4O7R)S$Y}[E_#_3_I_N`$atb:gbgcgdiCmJmboNoOq!qfrisC(B")
+ ("fhr" "$B3Q9w</C+NPO<O=O?[rbqc3m\(B")
+ ("fhs" "$BO@^M(B")
+ ("fhd" "$BBlBmN5N6O.O6O8S/T;Tb[0\Y`|dFiDp/(B")
+ ("fhl" "$B@%MjMkN]O(Q4T^Z']*azb}d]f#fPi2iAkQlO(B")
+ ("fy" "$BN;N=N@NANENFNKUlW!Y|["_yegfXhznRoAs>(B")
+ ("fyd" "$BN5N6iD(B")
+ ("fn" "$B<HN^N_O,O0O3Q$\l`4`5aqdMe_e`j3jzo;o{qp(B")
+ ("fnl" "$BN^^%(B")
+ ("fb" "$BI5LxN-N.N/N0N1N2N\N]N_N`R-ShT^W!ZX\X^%_H`eaneYe`g{nvo9pEq:(B")
+ ("fbr" "$BN&O;R-Y$hz(B")
+ ("fbs" "$BNQNXO@PUVFVG\2^MeE(B")
+ ("fbf" "$B7*N'N(N*XKdE(B")
+ ("fbd" "$BN4VWcc(B")
+ ("fmr" "$BO>P>pU(B")
+ ("fma" "$BQ[W)XnhR(B")
+ ("fmd" "$B0=I)KSN?NGNMVE\AhQi3(B")
+ ("fl" "$B3=8qA8C,DsKiMxMyMzM{M|M}M~N!N"N#N$N%NRNoP]P^X&Xm_"`4`5crdaf@h.h=imjBkJl>nZqkr5rEsW(B")
+ ("fls" "$BNUNYNZN[RgX'iBm8m9nC(B")
+ ("fla" "$BNSNTNVNWaepC(B")
+ ("flq" "$B3^N)N3g~(B")
+ ("ak" "$BGMGOK`KaKbKcSWU@Vw`uadb{j1j2(B")
+ ("akr" "$BGyG|KFKkKlLNUki8(B")
+ ("aks" "$B17HTHUHZJZK|K}K~L!L"OQRDRXV]VoW>W?Xp^`_TbVe\h_jGktm*mNo8q=r#(B")
+ ("akf" "$BKuKvKwbFcBg}k$p\pi(B")
+ ("akd" "$BK4K:K;K>LQLVX1f&f(gjh+hOj<j=nzr3(B")
+ ("ao" "$BGMG^G_G`GaGcGdJrK?KdKeKfKgKhL%Ug`pgugvlNn2pJ(B")
+ ("aor" "$BG|G~I4L.`Sfwl=lBoyq^sN(B")
+ ("aod" "$B0:K(LALTLUQ3]ba0hNsf(B")
+ ("aur" "$BQLQQVm]qf2k,(B")
+ ("aus" "$BJYL2LHLILJLKLLLMP[QKU_^^b@bTeDsQ(B")
+ ("auf" "$BJNLG(B")
+ ("aud" "$B;.L=L>L?L@LCLDZy\U^rbTh,j&nIsf(B")
+ ("aP" "$BjV(B")
+ ("ah" "$B18243}G|InJgJhJiJkJlK9K?KAKEKFKHKlL0L6L7LNLOLSLWU(ZV`S`pa(b&bHcjdwfNfnhOkuqxr|(B")
+ ("ahr" "$BI$KRKTLZL\Q^[7]teYg|s/(B")
+ ("ahf" "$BKWL^]G]s(B")
+ ("ahd" "$BL4LXQOTm[$[/](_Bb^ga(B")
+ ("ay" "$B1,@&G-I@IAICIDIEJhL/ZbZe^]b?eMg{i8(B")
+ ("an" "$B@&I5IoIpIqIsJjJlK4K?KEKGL3L5L6L7L8L9LPU(V`W'XcXlYEZ[\>bHeYhOj]kX(B")
+ ("anr" "$BKAKOK|L[`Tfn(B")
+ ("ans" "$B2cJ-J8J9JZLHLdLfLgLhPnQfX$XpY_e$(B")
+ ("anf" "$BJ*L^(B")
+ ("al" "$B3aFfHxHyH}H~JFL#L$LBLoU;VKW9W=_>_Pdve[i/m?sHsSs`(B")
+ ("als" "$BIRL1LeV1X>XbZa^#eNf+o\sf(B")
+ ("alf" "$BL)L*\ikm(B")
+ ("qkr" "$B9}GmGnGoGqGsGtGuGvGwGzG}JmKPKQP8YsYv\w^p`a`yg.p;qPr0rX(B")
+ ("qks" "$BH<H>H?H@HBHCHIHJHKHLHRHSHWHXJ1JVJ[YBZ5\Q_/amcme+fvj6k'm*(B")
+ ("qkf" "$BH-H.H/H0H1H4KVUVX#Y6Y{^_b"b$cAlmq{r1(B")
+ ("qkd" "$BJoJ|J}K'K,K.K5K7K8K<K@KBKCKIR9RMUxVsWEWGZU[D\V^qb|cmg/gVhpiSkno%qwr7(B")
+ ("qo" "$BGPGRGSGUGVGXGZG[G\G]GeGfGrKLT/WQX`YA^\_d`jfujj(B")
+ ("qor" "$B3|GFGlGoGpGrGuI4PQVg[1`aa)cndjr0(B")
+ ("qjs" "$BH(H?HKHMHQHVHYK]ZYZZ\h_/_xc)effLg8j[o@s=(B")
+ ("qjf" "$BH2H3H5H6f/(B")
+ ("qja" "$BHAHEHFHHHOK^[p^"c{gw(B")
+ ("qjq" "$BK!`k(B")
+ ("qur" "$BI{I}JHJIJJJKQ|Z&]!`za2i0j~m2mdospH(B")
+ ("qus" "$BHPJQJTJUJXJ[MhQ~RFY(Y7ZN]repg&jokfmgn4n5qX(B")
+ ("quf" "$BHcJDJLJMP(Z~sh(B")
+ ("qud" "$BIBIMISJ:J;J<JAJBL_V"Vu[D\V_[c=cme3m~q6qX(B")
+ ("qh" "$BD=F>IVIaIcIhJ]JbJcJdJeJnJsJuTHUoUph^jppfse(B")
+ ("qhr" "$BIzI{I|I}I~J!J"J#J$KMKNKPR6Z=Z>\w]M_Ad9h*hyiui}j`m.mUmVqFrX(B")
+ ("qhs" "$BK\TqlL(B")
+ ("qhd" "$B0)HFIuJpJtJvJwJ{K%K)K*K/K1K@^"_bcsdK(B")
+ ("qn" "$B3x4L<C@lG]H]ITIUIVIWIXIYIZI\I^I_I`IbIcIdIeIfIgIiIjIkIlImIoItIzI{I|J#J$JmJsK6P=PZPmP|RuS_T4UUU[Y8YC[T[U[o\T]M^pf)g%gYgxijk>lRlgmUn>n]rjrksOsPse(B")
+ ("qnr" "$BKL(B")
+ ("qns" "$BBNHRH[J,J.J/J0J1J2J3J4J5J6J7K[K_RfW][C]d]p_9`6a'a=cic|gnlL(B")
+ ("qnf" "$BITJ&J'J(J)PGWJWgYD[,`Ac1q|sd(B")
+ ("qnd" "$BC*J+JxJ~K2TDW:boe^(B")
+ ("qmr" "$BR6(B")
+ ("ql" "$B7%H[H\H]H^H_HaHbHcHeHfHgHjHkHlHnHpHqHsHtHwHzH{H|I!J(JOP#PlR8SgU&U9U{X`[,\R`Aa]acbNbgc0c>dDdcdue#f1fGg#g$g>hKhoitjkl"l@lAlLl]nAp)pBp[pfqorL(B")
+ ("qls" "$BIFIKILINIOIPIQLFUMZ/]']R_@eoi@p~r&(B")
+ ("qld" "$BI9QRQVQ_U2Xaf[qHqU(B")
+ ("tk" "$B278%:3:6:;:=:>:?:@:p;E;G;H;J;K;L;M;N;U;W;[;`;b;d;e;l;r;t;v;w;{<%<-<K<L<M<N<O<P<R<S<U<X<Y?)?ZFcGAL&L,LcP/PXQPRSSNTzU0UmWP[O[h\L]y^/^V_C_S`:`[aBc+c,codAdBdCe/fSfhgRh5iImfnanmqJqKrBr^sM(B")
+ ("tkr" "$B:o:s:w?tSVZK\N`#oK(B")
+ ("tks" "$B;1;3;5;6;9;:;;;@IGQh[<]haMedlioYo[(B")
+ ("tkf" "$B;&;';5hq(B")
+ ("tka" "$B;0;2?9?yRTWD^zdsexf.glhujN(B")
+ ("tkq" "$B07=BA^Yg]=_'_(p@q%(B")
+ ("tkd" "$B7,8~=}=~>&>(>0>2>E>M>X>\>]>^>e>o>uAPASAVA[AjAzA|BlBmErF=FKH"MMRVUCURVyV{XS\k]O`.a3fFjak<ksrh(B")
+ ("to" "$B:I<%^/_Sg(lPp{rT(B")
+ ("tor" "$B:I:p:w?'T'XG\ecQi,(B")
+ ("tod" "$B1y>J@7@8`Ocy(B")
+ ("tid" "$Bq.(B")
+ ("tj" "$B5P:T=k=l=n=o=p=q=r=s=v=x=y=z={?p@3@4@>@@@BAMD)L;P0ScTPTfVYY3ZFZGd.e1fTf]fqsUsk(B")
+ ("tjr" "$B3c<.<M<a<b@J@K@N@O@P@YM<^Hb,hnirj.jinYnq(B")
+ ("tjs" "$B4T@f@g@h@k@p@q@v@z@{@~A"A#A%A*A-A/A1A5A6A7C1OKQ"SEUIUvX:^/`!a}c8e@fAgUiElqpG(B")
+ ("tjf" "$B1L6}7@@^@_@b@c@eC-FQSwYM\8]u^Xe(e2eJi-jxsv(B")
+ ("tja" "$BA!A.UQZ{]@]S]Tcxeyezj9k~lXnu(B")
+ ("tjq" "$B=&>D@"@]RYSqXRXwYpfcm:oRq#(B")
+ ("tjd" "$B>J>k@+@-@.@1@9@;@<@?@CX9Zp`Od-fag)(B")
+ ("tp" "$B:P:Y:{@$@*@G@b@vLcWB^/ih(B")
+ ("th" "$B037+:i<D=j>$>%>,>.>/><>?>B>C>F>K>P>R>S>dA:AAABAGAIAJALA]A_AcAgA{B}I%R#SbU?XG[`\f][]{^j_O_va4d,dTg[hvi+i?l!lsmvn:n[nyp<ppq[rCrM(B")
+ ("thr" "$B0@B+B.B/B0B3V$etkll^(B")
+ ("ths" "$B;AB9B;B=C'(B")
+ ("thf" "$BN(j+(B")
+ ("thd" "$B>>>YAWAwW~[@^DcpgNiOkVo1psr"(B")
+ ("thkf" "$B:~(B")
+ ("tho" "$B:?:U:~;&;/^/_S`tbl(B")
+ ("thl" "$B?h?jTj(B")
+ ("tn" "$B<i<j<l<m<s<u<w<x<y<z<{<|<}=$=%=(=+=/=2=7=C=I?\?b?c?e?g?k?o?p?q?tA\AiB5C(C/D\JfLyM"N(RWS4SUSVT1ThU?V-X{YSZ@ZK]U]z^,^l^{_|`Yc.cOdXdoe5e7elf7f{g!g;h%h5hki.j-l(l3n.nHnsnxo5p$p+qrr$(B")
+ ("tnr" "$B=G=H=I=J=L=M=N=OPhUY`GfihChr(B")
+ ("tns" "$B=V=X=Y=[=\=]=^=_=b=c=d=f=gFkWNWv^-d#d$f|h&hsh|kNkYo>s((B")
+ ("tnf" "$B=Q=RN(WuX|[2(B")
+ ("tnd" "$B?r?shE(B")
+ ("tnl" "$BPfPg^C(B")
+ ("tmf" "$BI(`niMi|(B")
+ ("tmq" "$B<>=&=,=1_<jyp.(B")
+ ("tmd" "$B>!>#>5>:>g>h>jANFlGhP+QtR4[Fejj$o~(B")
+ ("tl" "$B0;3A:|;&;H;O;S;T;\;k;m;n;x;{;~<(<,<E<F@'DsLpRQSASOS]UyU}W#W6WtYy`JfBg(gShahikkl5l9p{(B")
+ ("tlr" "$B6t<0<1>}>~?!?"?#?)?*B)Uf_omHq3(B")
+ ("tls" "$B:g?-?.?1?5?7?=?@?B?C?E?H?I?U?V?WC$GjH8RqS"UbXFY;Zo_~iglYpur`(B")
+ ("tlf" "$B<:<<<=<BUi\Cj)(B")
+ ("tla" "$B;2?3?4?<?D?R?SRTWZ\;]n_)_Dh~o=(B")
+ ("tlq" "$B=&=:===BDTRARB_'_(a#cgdb(B")
+ ("Tkd" "$BAPRV(B")
+ ("Tl" "$B;a(B")
+ ("dk" "$B0!0"0$2d2e2f2g2j2k2m2n368f;yP3Q;S(U.U4V6[s`Ha^h0jKk(kCn{o<rms!s"(B")
+ ("dkr" "$B0!0-0.0/3Y3Z3\DWOLP3RxTAVVVjX(X3\[hUhVh`k`n?s-sys{(B")
+ ("dks" "$B0B0D0F0H4_4c4f4g4i8APtZg]Vpzr=rnro(B")
+ ("dkf" "$B060D1ZX~Y!]"]1]Fk@mBn!odpK(B")
+ ("dka" "$B0C0E0G1^264`4b4dVIV^h?k^pws_sa(B")
+ ("dkq" "$B0(052!3{R}TZ`@(B")
+ ("dkd" "$B1{6D97Wi]J]vc?pYrs(B")
+ ("do" "$B0%0&0'3336373eS1SNS`T<V=[#]7b-bJbYbvc(ghi=oup'pKpOq>(B")
+ ("dor" "$B1U3[LkLqY/YUf~mCoup'(B")
+ ("dod" "$BSm]/f"rts@(B")
+ ("di" "$B<M<P<Y<c<fG8LiLjLkLlLmLnYh\?s,(B")
+ ("dir" "$B0s<c<eLsLtLvU>Ynd`h`hji;oPs4s~(B")
+ ("did" "$B>\>m>n>w>y>zMHMLMMMNMSM[M\PSTaUPWyZ7ZfZx\k_!_G_laZagaxc:cUjwl*nVqh(B")
+ ("dj" "$B1w5y5z5{8f8lS0S}S~^Kq,qGrNsw(B")
+ ("djr" "$B2/21225?M^\z(B")
+ ("djs" "$B1a8@8AGgI'PpUA_adN(B")
+ ("djf" "$B]"]1(B")
+ ("dja" "$B1b1f264`4d8387Q7RLSnV^Vx^;f,ofqd(B")
+ ("djq" "$B6H(B")
+ ("dp" "$BWk]P(B")
+ ("du" "$BFrG!M=M>M?M@MAMBP.]C^.aBe1gMgPh'i1ikl%q1(B")
+ ("dur" "$B0W0h1V1X5U<MKrLrLuXdehinl#o`ogp?qcrH(B")
+ ("dus" "$B0v1c1d1h1i1l1m1o1t8&8'<!A3FPFpG3J%RdSkU+U/WzYPYa\=])^'^2^7^=_]d'gCh/icj@l'(B")
+ ("duf" "$B0v1Y1\@bG.ReSYsv(B")
+ ("dua" "$B1^1j1k1p1v@wL-QG\ygfgroeqyr6rPsEsa(B")
+ ("duq" "$B1^MUSq[!pT(B")
+ ("dud" "$B1D1E1F1G1I1J1K1M1N1O1P1Q1S7J7^RiS[TJU$U%Zu\3\F^s_J`r`}`~ewj>lWn;pD(B")
+ ("dP" "$B0e1C1H1L1T4"7X7];y<IM@MBP)P.PdQ;Q<St[*]u`IbKbOcRfJghi"i#i:iRjcl%l?p?rIsL(B")
+ ("dh" "$B0-1(1*1w1x1|2(8^8`8a8b8c8d8g8h8mP~S*SKSSTITTT|U<UhWXX(XeZDZm_4_r_z`3`iiej(n+o2rbsg(B")
+ ("dhr" "$B0$206L9vM`(B")
+ ("dhs" "$B292:X2aicSi%i>jrr[r\(B")
+ ("dhf" "$BQ:\Eg,(B")
+ ("dhd" "$B2'MJTYW+a%a1a~c<hcp6s0(B")
+ ("dhk" "$B0#122i3?4$7&RwSyc]hbiwkBkw(B")
+ ("dhks" "$B08404K4P4X4a4e4hOPOROSU6^1_5iol2op(B")
+ ("dhkf" "$B[)(B")
+ ("dhkd" "$B1}2"2&9DUwWH[>]j(B")
+ ("dho" "$B0#3?OARwbdiw(B")
+ ("dhl" "$B0Z307(VLV[`Pbvi'r>(B")
+ ("dy" "$B1z3Z6F9x>qD8F+LsMEMIMKMRMTMWMXMZQ'TpU-UKULVRVvWTWUY9YjYz\[\v]H_$`"`vcXc_eeh}j4kon-n3qAs8t!t#t$(B")
+ ("dyr" "$B?+C+M]M_MaV;^ieUhljs(B")
+ ("dyd" "$B23B{M&M/M0MCMFMGMOMPMQMVMYP\XJXY\Wa5f`gNill}o0ps(B")
+ ("dn" "$B0r1&1'1)1*1+2$2%5m6h6r6s6v6w6x6y?uKtL`M$M%M'M+M4M9P2P}R^R_VJ\d]?]XaOb3c;c<d~foi9kpsIsz(B")
+ ("dnr" "$B000jR(TT_4_z(B")
+ ("dns" "$B0w1$1>1?1@Zt]N_pe"fQp(pq(B")
+ ("dnf" "$B080S1516]5_q(B")
+ ("dnd" "$B7'M:(B")
+ ("dnjs" "$B080w1!1`1e1g1n1q1r1s1u3@4j85868;I2QMT$T(U6UcXE^S`)gkiojOkdmWn|ovp((B")
+ ("dnjf" "$B1[7nXz[)denh(B")
+ ("dnl" "$B010L0N0O0Q0R0S0V0Y0^0_0`0b0c161R4m56OAQ&S@SxT#Vk^O`*a_eOh<ivjLm{pjr2(B")
+ ("db" "$B0T0]0d:y<t=@D\FSFjFyF}G(KnL{L|L}L~M!M"M#M(M)M*M-M.M1M2M3M5M6M7MDPRQASHS|U^ViXoYfYiZA\@^a^b`qahdre7g+gLhPi$iXj!j"j@k!k0kglzl|n'nXo+pds[sl(B")
+ ("dbr" "$B0i4!FyS|]Zdx(B")
+ ("dbs" "$B0t0}1<=aUzlVnJ(B")
+ ("dbf" "$Bffrr(B")
+ ("dbd" "$B=?M;e0(B")
+ ("dms" "$B1#286dRaT-T7X@X[]V`;p,su(B")
+ ("dmf" "$B255?(B")
+ ("dma" "$B0{0|0~1"2;5?6cR_U5V@];pF(B")
+ ("dmq" "$B5cM,M8X%(B")
+ ("dmd" "$B1~5?6EBkGhXfg?j$m@mA(B")
+ ("dml" "$B0M0U0X0a365#57595<5?5A5B5C5DODPaV=VTVXXt]:_q`Hbcc&ePg_nPq>(B")
+ ("dl" "$B0;0J0K0P0W0[0\1B;\<$<)<*<X?)BBBfCPFRFsFvP1U)UuVaW3W4W^^&`ba-aXfggokHlFlHlIm_mnp0(B")
+ ("dlr" "$B1WMbMcVXW5[;fDkjs2(B")
+ ("dls" "$B0u0v0x0y0z1l?M?N?O?YFRG&G'LbP@PAQ9QcTEUTW.]e^P_]h!h;iNpW(B")
+ ("dlf" "$B0l0m0n0oF|P!PETejRn_o-(B")
+ ("dla" "$B1A?QDBG$G%L-U,WljSjT(B")
+ ("dlq" "$B9~F{F~R]T)rl(B")
+ ("dld" "$B>jP;QtUT(B")
+ ("wk" "$B040q:4:8:::^:n;F;I;P;Q;R;Z;g;p;q;s;z;|<"<'<+<Q<T@F@QDSI&PwQ}RoR~UZWs^h_Ua*aSbDbEdggsh$hti4i5k9lGlZl`r8s:sn(B")
+ ("wkr" "$B:n:r<[<]<^<_<`?]?}SpU"UeZQ[P_Zd+e?ginLs'(B")
+ ("wks" "$B;7;DV#X}\"]L_%b7(B")
+ ("wka" "$B;=;C@xC9V*_*_+d>dQjDlQo4(B")
+ ("wkq" "$B;(AYA^C}SrYgd4p7p8(B")
+ ("wkd" "$B>">)>->1>8>@>O>Q>U>_>c>f>l>s>uATAqArAuB!B"D"D%D2D9F5P?TGTVTcTyT}U#UrVQW2\u\~^J^y`-`/`R`xaog6gGgIg`h7hIi,i6jfl[l\o6rc(B")
+ ("wo" "$B:F:H:K:M:R:X:[:\:_:`:b<F@FB8^hc7eRexl9lZsn(B")
+ ("wod" "$BA9AdAhAyVDVl`'bUd7d8kZo#(B")
+ ("wj" "$B093n5O<Q=m=s=t={=|A;A@CtCuCvCwCxCyDcDlDqE!EKGgH$LYPJRrW7Y3[A[R\:]|_L`2aTbicle*f8fTgsiWk:kIl7m0p3sr(B")
+ ("wjr" "$B2.<Z<d@Q@R@S@V@W@XB1C`CdD$D_E&E(E)E*E+E,E-LvR*W/_U`?a{c!d{gii4k6mlmqmx(B")
+ ("wjs" "$B<2=W@o@r@s@y@}A'A,A0A4B7C.DQE5E6E8E;E>E?EAEBECEDEEG{H*KjMdQ#QrR4RdSsT{UsV\W%X"X}Y%ZBZS]a^!_E`0a/aYaub!c"d%d5d?euf?fHg"lcm7mYm[nonto"oCp4pSp|q4qBs6s7t"(B")
+ ("wjf" "$B=`@Z@[@^@`@a@dCbLERERGRzY#ZqZr^6cffOlkmE(B")
+ ("wja" "$B0>@jA2E9E@FQG4V3dRpAsVsZ(B")
+ ("wjq" "$B@\D3XR\&\7\D]~^XfcrW(B")
+ ("wjd" "$B0f;*>=>Z>`>p>t>{@,@/@0@5@:@EBGCzD.D:DbDdDeDgDhDjDmDnDrDuDvDwDxDzD{E"E#E$FTKoLwMdP'RZVlY]ZW[l^F^[a6aKbMcWf^hGj:mwn&nDnKoFp=pP(B")
+ ("wp" "$B1-:O:Q:W:]:^=t=|@)@=@F@^BhBiBjDiDkDoDpDsDtD}P_Q1Q}Z+Zq_;bDbEbIgAi5lZm3pIpmpnsn(B")
+ ("wh" "$B3v7+:x;4<D=u><>H>[>rA;A<ADAEAFAHAKA`AaAbAeAfAgAlAtAxB$BdC{C|D$D&D+D,D/D4D7D8D;DUD^D_D`FXGBH%POPYS^SdWIXNXTXjY2Y4Zj[j[t\'\*_6`,bic/cGcZc^cud|e6f-fTfrg]iskGkPl!ldm/oXp:qt(B")
+ ("whr" "$BB-B2dHhwo7(B")
+ ("whs" "$BB:YO(B")
+ ("whf" "$B@[B4OHR@`L(B")
+ ("whd" "$B<o<p=!=*=>=D>a>bAnI"P:WOXQ\#\$\b^JdpeTj*l{m'm)oG(B")
+ ("whk" "$B:4:8:A:B:C(B")
+ ("whl" "$B:a(B")
+ ("wy" "$Bn[(B")
+ ("wn" "$B3t:n<g<k<n<r<v<~=#='=.=5=;=K?_AUAvB-B2ChCkClCmCpCqCrCsD4D]I*L+P&PMPvQ2QISUW$ZlaFaGcGdVdZe!eBfthwiakOlam4mTn$oIsG(B")
+ ("wnr" "$B4!C]dx(B")
+ ("wns" "$B1==S=T=W=Y=`=c=eFVH;KpQ.RETSWvX"X6^4_=b/jAm-mu(B")
+ ("wnd" "$B=0=ECfCg(B")
+ ("wmr" "$BB(B1(B")
+ ("wmf" "$B6{(B")
+ ("wma" "$BWc(B")
+ ("wmq" "$B=4=AIxM,\7eI(B")
+ ("wmd" "$B3(9y>I>Z>xA9A=A>A}A~B#D'YN\t__kz(B")
+ ("wl" "$B4t5@;V;X;Y;];^;_;c;f;h;i;j;o;}<1<A<G?%B~CNCOCRCSCXCYDRDlDqEVG7S!T.TMVcW7Yu[L]ma\c-fMfsgSk:lDlSlflym5mIn/owr?s9(B")
+ ("wlr" "$B?%?&D>SDcFcM(B")
+ ("wls" "$B?0?6?8?:?>???A?G?J?L?P?T?XC$DADCDDDEE6FxKyPVSQZi]I_~`_a+a;b8bCbSeVgKhmjWlcmGo/(B")
+ ("wlf" "$B<8<;<@<ACaCbE3IHLEPERzSDT9Ve[_fOg4g5lDlkmE(B")
+ ("wla" "$BD?ZPnErq(B")
+ ("wlq" "$B<9=4=8=AeI(B")
+ ("wld" "$B@!D'D(_-(B")
+ ("ck" "$B3n:!:5:7:9:<<V<W<ZOMPNSMV+VMY-Ym[3\Lbxd4gsm"n`(B")
+ ("ckr" "$B:q:u:x@NB*ByCeCxY'eSm0oXsqsx(B")
+ ("cks" "$B;8;<;>;?;A@qRUZ9`&cbdlesl-lUo4oSoTqB(B")
+ ("ckf" "$B;!;";$;%QkY)`\e'(B")
+ ("cka" "$B;2;4;BA2Q(Q)RTTOVPVZXNXOXPXrXs\ackk{k|l)l+q](B")
+ ("ckd" "$B>'>+>3>4>;>T?zAOARAdAkAsD*D1H+PiQlRRX0XHYoZHZd^E^k^}`KalcYgZm#r.(B")
+ ("co" "$B:9:D:L:N:S:V:W:Z<F@UMi\Me=hql8n`pV(B")
+ ("cor" "$B:p:t:u:v:}@UA<QFSTY>[Pbyd)dG(B")
+ ("cj" "$B:J=h@(A@Q]X.^Ge1hF(B")
+ ("cjr" "$B;I<\@I@L@M@TD=QqRhWFZ3^~akinljm$m(m6p"s5(B")
+ ("cjs" "$B0+6N6z6|;=@i@n@q@t@u@|A$A&A(A)A+C)E7PBPjQdSCV_Z#[a\9^I^Y_Ea$chh(lMlxoqotph(B")
+ ("cjf" "$BDVE/E0E1E2E4FLFmS5V%YZmPnno$oDoEq8(B")
+ ("cja" "$B84@mE:E<Q!W[Ww\a\y]~b]dSdUd^d_j9k-k[k~(B")
+ ("cjq" "$B>*>9>vC}D!D-D5E=aHaIaJbLjymLmM(B")
+ ("cjd" "$B;*;,@2@6@A@DD#D0W,W-fehGiq(B")
+ ("cp" "$B@ZBNBXBZBaDVDfDyD|D~FeFmSFSiSjYZ\<^8^|bIbfh\hxjim<m=n*pLqsqv(B")
+ ("ch" "$B7-=i>%>6>7>A>G>K>L>S>V>d?]A?ACApD6D8ICQvR#R+V%V9X!X7X^[B\%^W_VcDggkWl:mknLndqzs<ss(B")
+ ("chr" "$B<q>|?$?(?tB%B0SvV$ZKb`badHifk=m1o7qq(B")
+ ("chs" "$B1%@#B<WVn7(B")
+ ("chd" "$B=>=FAQAZAmAoC~DMF4G,N5N6P:PxR2WOWdX;eAeTfb(B")
+ ("chl" "$B:E:GVCYt\c^/(B")
+ ("cn" "$B0,1/3b<h<q="=%=)=-=6=9=P?[?d?m?n?u?v?wAFC\CjDFDGDHDIDJGkOISBU7U9VdX/YXYY\6\d^Wa,b2cTd6dHeWf\gmhZn@p%p2pcqWqerUsF(B")
+ ("cnr" "$B1/<3<4=3=K=LC[C\C^C_C`M.\egXm&(B")
+ ("cns" "$B=UDXrV(B")
+ ("cnf" "$B=P[2sY(B")
+ ("cnd" "$B2-=<=F>WCiCnCoMCQU`>g^j5(B")
+ ("cnp" "$BX,X-X8aahDlT(B")
+ ("cnl" "$B<h<q="=-?a?f?i?l@HOIS\U8X8Ye\r]^aafCf\g9hDk9nMqe(B")
+ ("cmr" "$BB&B'B,D=P<X<Z`(B")
+ ("cms" "$Bsp(B")
+ ("cma" "$Boo(B")
+ ("cmd" "$BA=A>AX(B")
+ ("cl" "$B:7:9;u<#<&>}?"?%CMCQCTCUCVCWCZD'D>FePLRHRNSPTiV5VbVpVz[i_ua7a?awbtcPcze#e>eLfWiPjul8lemOo!p5r5rKrvrwscso(B")
+ ("clr" "$BB'B,D<R,RNVzX<ZE(B")
+ ("cls" "$B?Fk%sp(B")
+ ("clf" "$B<7<?(B")
+ ("cla" "$B5N?/?2?;?KC9D@KmUjWZZP\;o*o,ooqT(B")
+ ("clq" "$Bj/(B")
+ ("cld" "$B>NGicJjYqU(B")
+ ("cho" "$B2wTo`V(B")
+ ("xk" "$B<XB>BBBCBDBEBFBGBHBIBJBKBLBMCSOMPIS#TXU`YYYe[4\s]}g!m>qLrx(B")
+ ("xkr" "$BBnBoBqBsBtBuBvBwBxByE'EYPkS6Y>[Q_7ner0(B")
+ ("xks" "$BBMC2C3C7C:C>CBCFF]FgW<X_Z:]QjX(B")
+ ("xkf" "$BC%C&(B")
+ ("xka" "$BC5C?b>lE(B")
+ ("xkq" "$BEcEkYr\PpaperW(B")
+ ("xkd" "$BEfErE|F"Vfb;j#(B")
+ ("xo" "$B@GB@BABUBVBYB[B]BaBfBgG=KXLaQ<\(cze)ihkHq&qM(B")
+ ("xor" "$BBpBrBtZ$_7(B")
+ ("xh" "$BEFEGEQEZEeF$Q=h9(B")
+ ("xhs" "$Bjt(B")
+ ("xhd" "$B23DKDLE{E}HuWxXV(B")
+ ("xhl" "$B?dBOB\B`DHDIDJFXjtpx(B")
+ ("xn" "$BEJEjF)F.L{Pye5o+qmr,(B")
+ ("xmr" "$BB_FCXW(B")
+ ("vk" "$B?|GCGDGEGGGHGIGJGKGLGNHmHvT3WfZ4[1`(``bncvfRg8hJh]jZllox(B")
+ ("vks" "$B:d:eH=HDHGHNR!]ra"ng(B")
+ ("vkf" "$B;+H,R\[5n\(B")
+ ("vo" "$B143-GIGTGWGXG\GbH4HmI#PPUVX#Y6ZT[1]o`cp>(B")
+ ("vod" "$BC*K#K5KDW:WEZU_0b|e^(B")
+ ("vir" "$BX?(B")
+ ("vus" "$BJ?JPJRJSJTJWJXJ\Y(fIgyi~jokfqY(B")
+ ("vua" "$BlJ(B")
+ ("vud" "$BDZI>IMJ?Wh^$bogyhLr9(B")
+ ("vP" "$B3AGQGYJ>J@JCJDJEKJUJVrW&ZIZMasi0qo(B")
+ ("vh" "$B1:3s3wGxGzI[I]IrJ^J_J`JaJqJyJzK"K$K&K+K0K=R1R5R7RvS.T5YF[T_F_\aWb.f}gTgzj\jqmynppRq0q}r:rDsR(B")
+ ("vhr" "$BGxGzI}K=_F(B")
+ ("vy" "$B<]I6I7I8I:I;I<I=I?QwUEXX]Ke]q(q)q*q_qjqurd(B")
+ ("vns" "$BJ,(B")
+ ("vna" "$BIJcHcI(B")
+ ("vnd" "$BIvIwK-afkel4q$qH(B")
+ ("vb" "$BI7(B")
+ ("vl" "$BH`HdHhHiHmHoHrllmdox(B")
+ ("vlf" "$B2^HfHgI$I%I+I,I-I.J'J)PGYDdJkvm+s+(B")
+ ("vlq" "$BI/I}K3^"(B")
+ ("gk" "$B2<2?2F2O2Y2\2b2l3E<6ROR`V|^Q`leKf!kEl.n"o(rQ(B")
+ ("gkr" "$B2)3X5TDaT[U\U]^A`Bajkbl;s?(B")
+ ("gks" "$B4(4@4A4M4W4Z8B:(UFUGW{Y*YRZ][e_K`Cb*f'n8qSqlsm(B")
+ ("gkf" "$B323d3e3mR$bRiys\(B")
+ ("gka" "$B4O4Y4^H!MtQbRyS2S?VH]#^>eHh1n8nro|pwq2rRsD(B")
+ ("gkq" "$B389^9gH:RnR}^eb4b5b6hdonr{(B")
+ ("gkd" "$B7e9+91939:9A9R9T9_9`FzP6PDRbWqe}fjobprr*(B")
+ ("go" "$B0g2r3#3$3*3/31323:3<:zPsT6TnTxUXW(Xh\4i&j7k;k_n0nOqO(B")
+ ("gor" "$B3/3Kbkk*mJ(B")
+ ("god" "$B0I8v9,9Te.jbr}(B")
+ ("gid" "$B5}6?6A6B8~9aSlq.(B")
+ ("gj" "$B135u5vTR[[]A^w(B")
+ ("gjs" "$B7{8%8.YW`[(B")
+ ("gjf" "$B]<iyj8(B")
+ ("gja" "$B8183VUp*qd(B")
+ ("gur" "$B3E3R3W7CTu^)r+(B")
+ ("gus" "$B0<7|8)8+8-82898<8=8>8?9`JGPWRl^-aRbAeQidjJnkp}(B")
+ ("guf" "$B7j7l>iJGLRUSk#pv(B")
+ ("gua" "$B7y(B")
+ ("guq" "$B0A3p6"6(6.64696<KKOFTsV7XDYQ^5`Ed)d:h2nwo}p!(B")
+ ("gud" "$B3>5|7:7;7?7A7U7V7e9UTk_W_X`rfzj%mj(B")
+ ("gP" "$B7E7RQBR>TxWBX*b=c4l~nQp^(B")
+ ("gh" "$B3O8C8F8L8M8P8Q8R8U8W8[8_8c8j8n8o9%9@9f9h9j9k:c;)<JD[QTTdW`Y&Z_Zn\5]]]l^v^w`7`ha!b(b+hYhfiHiKizn=o.q7(B")
+ ("ghr" "$B0?9s9tOGUeZO(B")
+ ("ghs" "$B:':*:+:.:2[~\!^U^g_c`m(B")
+ ("ghf" "$B3K9z9{]Gcts3(B")
+ ("ghq" "$B3f(B")
+ ("ghd" "$B909?9H9cR|]g]wkAobr*(B")
+ ("ghk" "$B2=2P2R2S2V2Z2_2h3q3r7$CtOBOCS;V<aAdqo&(B")
+ ("ghkr" "$B3H3M3N3OZ2Z<ayb_j?p9(B")
+ ("ghks" "$B4-45494<4?4D4T4]88OKT(TvUaUnXu]D^R^S_eb*bAbbl,l6oBqir%r](B")
+ ("ghkf" "$B1[3h3j;#`Qbwi]l/ohoi(B")
+ ("ghkd" "$B2+677;92989D9SKZQWQ`WSWrX5Zh^T^f_jd;dPfki{n#p&rS(B")
+ ("gho" "$B2h7S`VaA(B")
+ ("ghl" "$B2q2s2u2v2y2z2{3"3%=ZI0OEPrQER;TUWKXg[X\G^Neig:h"i'i\kKkRmorf(B")
+ ("ghlr" "$B2h3D3MaA(B")
+ ("ghld" "$B2#909U9li*mDo)sT(B")
+ ("gy" "$B6G8s8z9;9Z:hP{S,SeSoZCZ|[f^B_^`+qaqb(B")
+ ("gn" "$B0r5`8e8t8u8|9!9"PHRcSLSR^A_h`Md<kMmp(B")
+ ("gns" "$B7.7071FkR._m_nhXnU(B")
+ ("gnd" "$Bi*(B")
+ ("gnjs" "$B3~7vCHX:Zwh@kcl,(B")
+ ("gnp" "$BCnRCS<TL_{(B")
+ ("gnl" "$B4x5+51WCY&Zv]`ka(B")
+ ("gb" "$B5Y7H7MC\Z8_^iLl<(B")
+ ("gbr" "$BC\(B")
+ ("gbf" "$BWukys;(B")
+ ("gbd" "$B6$6'6;R3Wo^((B")
+ ("gmr" "$B9un^(B")
+ ("gms" "$B6U:/WLWWYWnW(B")
+ ("gmf" "$B5%5IKxV(k?(B")
+ ("gma" "$B6V7g(B")
+ ("gmq" "$B5[]@^*b%fE(B")
+ ("gmd" "$B6=Fz(B")
+ ("gml" "$B4n4r4u5)5:5>I1Q%RzS)S`XAXZY&Zk[']8_f_g_t`!`:c6f<nZrF(B")
+ ("glf" "$B5Merk#pvs\(B")
+ ("unknown" "$B4#<5DNFJFdFuJ=KsL]QeRIRpS&S9SuS{T*T+T8T:T>TBTCTKTNTQTWT\T_UNU~V&V,V-V.V/V0V2V4V8VNW;WjWnWpY0YKY^Z1Zs[=[b[n\)\-\.\/\0\1\O\S\j\n\o\p\q\x]&]6]B]i^<^L^c_&_1`<a:a<a>b<bBbXbmbpbsc%c5cNcdc}d&d1d=dIdLdYdddfdhdte9eaebemenevf$g3g\h4h6hHhMhWhhiFi[ibj,jQj^jmk\lCmZmhmimzn%n}o'oZo]p#p-pXp]p`q;qIqRr;r@rGrOrZr_rer~s#s%(B"))
+
+;;; hanja-jis.el ends here
diff --git a/lisp/leim/quail/hanja.el b/lisp/leim/quail/hanja.el
new file mode 100644
index 00000000000..dbfc2a7c9c1
--- /dev/null
+++ b/lisp/leim/quail/hanja.el
@@ -0,0 +1,516 @@
+;;; hanja.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Korean, Hanja
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines korean-hanja keyboards:
+;; - hanja input method with hangul keyboard type 2
+
+;;; Code:
+
+(require 'quail)
+(require 'korea-util)
+
+(quail-define-package
+ "korean-hanja" "Korean" "漢2" t
+ "2벌식KSC漢字: 該當하는 漢字의 韻을 한글2벌式으로 呼出하여 選擇"
+ nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("rk" "伽佳假價加可呵哥嘉嫁家暇架枷柯歌珂痂稼苛茄街袈訶賈跏軻迦駕")
+ ("rkr" "刻却各恪慤殼珏脚覺角閣")
+ ("rks" "侃刊墾奸姦干幹懇揀杆柬桿澗癎看磵稈竿簡肝艮艱諫間")
+ ("rkf" "乫喝曷渴碣竭葛褐蝎鞨")
+ ("rka" "勘坎堪嵌感憾戡敢柑橄減甘疳監瞰紺邯鑑鑒龕")
+ ("rkq" "匣岬甲胛鉀閘")
+ ("rkd" "剛堈姜岡崗康强彊慷江畺疆糠絳綱羌腔舡薑襁講鋼降鱇")
+ ("ro" "介价個凱塏愷愾慨改槪漑疥皆盖箇芥蓋豈鎧開")
+ ("ror" "喀客")
+ ("rod" "坑更粳羹")
+ ("rir" "醵")
+ ("rj" "倨去居巨拒据據擧渠炬祛距踞車遽鉅鋸")
+ ("rjs" "乾件健巾建愆楗腱虔蹇鍵騫")
+ ("rjf" "乞傑杰桀")
+ ("rja" "儉劍劒檢瞼鈐黔")
+ ("rjq" "劫怯迲")
+ ("rp" "偈憩揭")
+ ("rur" "擊格檄激膈覡隔")
+ ("rus" "堅牽犬甄絹繭肩見譴遣鵑")
+ ("ruf" "抉決潔結缺訣")
+ ("rua" "兼慊箝謙鉗鎌")
+ ("rud" "京俓倞傾儆勁勍卿坰境庚徑慶憬擎敬景暻更梗涇炅烱璟璥瓊痙硬磬竟競絅經耕耿脛莖警輕逕鏡頃頸驚鯨")
+ ("rP" "係啓堺契季屆悸戒桂械棨溪界癸磎稽系繫繼計誡谿階鷄")
+ ("rh" "古叩告呱固姑孤尻庫拷攷故敲暠枯槁沽痼皐睾稿羔考股膏苦苽菰藁蠱袴誥賈辜錮雇顧高鼓")
+ ("rhr" "哭斛曲梏穀谷鵠")
+ ("rhs" "困坤崑昆梱棍滾琨袞鯤")
+ ("rhf" "汨滑骨")
+ ("rhd" "供公共功孔工恐恭拱控攻珙空蚣貢鞏")
+ ("rhw" "串")
+ ("rhk" "寡戈果瓜科菓誇課跨過鍋顆")
+ ("rhkr" "廓槨藿郭")
+ ("rhks" "串冠官寬慣棺款灌琯瓘管罐菅觀貫關館")
+ ("rhkf" "刮恝括适")
+ ("rhkd" "侊光匡壙廣曠洸炚狂珖筐胱鑛")
+ ("rho" "卦掛罫")
+ ("rhl" "乖傀塊壞怪愧拐槐魁")
+ ("rhld" "宏紘肱轟")
+ ("ry" "交僑咬喬嬌嶠巧攪敎校橋狡皎矯絞翹膠蕎蛟較轎郊餃驕鮫")
+ ("rn" "丘久九仇俱具勾區口句咎嘔坵垢寇嶇廐懼拘救枸柩構歐毆毬求溝灸狗玖球瞿矩究絿耉臼舅舊苟衢謳購軀逑邱鉤銶駒驅鳩鷗龜")
+ ("rnr" "國局菊鞠鞫麴")
+ ("rns" "君窘群裙軍郡")
+ ("rnf" "堀屈掘窟")
+ ("rnd" "宮弓穹窮芎躬")
+ ("rnjs" "倦券勸卷圈拳捲權淃眷")
+ ("rnjf" "厥獗蕨蹶闕")
+ ("rnp" "机櫃潰詭軌饋")
+ ("rnl" "句晷歸貴鬼龜")
+ ("rb" "叫圭奎揆槻珪硅窺竅糾葵規赳逵閨")
+ ("rbs" "勻均畇筠菌鈞龜")
+ ("rbf" "橘")
+ ("rmr" "克剋劇戟棘極隙")
+ ("rms" "僅劤勤懃斤根槿瑾筋芹菫覲謹近饉")
+ ("rmf" "契")
+ ("rma" "今妗擒昑檎琴禁禽芩衾衿襟金錦")
+ ("rmq" "伋及急扱汲級給")
+ ("rmd" "亘兢矜肯")
+ ("rl" "企伎其冀嗜器圻基埼夔奇妓寄岐崎己幾忌技旗旣朞期杞棋棄機欺氣汽沂淇玘琦琪璂璣畸畿碁磯祁祇祈祺箕紀綺羈耆耭肌記譏豈起錡錤飢饑騎騏驥麒")
+ ("rls" "緊")
+ ("rlf" "佶吉拮桔")
+ ("rla" "金")
+ ("Rlr" "喫")
+ ("sk" "儺喇奈娜懦懶拏拿癩羅蘿螺裸邏那")
+ ("skr" "樂洛烙珞落諾酪駱")
+ ("sks" "亂卵暖欄煖爛蘭難鸞")
+ ("skf" "捏捺")
+ ("ska" "南嵐枏楠湳濫男藍襤")
+ ("skq" "拉納臘蠟衲")
+ ("skd" "囊娘廊朗浪狼郎")
+ ("so" "乃來內奈柰耐")
+ ("sod" "冷")
+ ("su" "女")
+ ("sus" "年撚秊")
+ ("sua" "念恬拈捻")
+ ("sud" "寧寗")
+ ("sh" "努勞奴弩怒擄櫓爐瑙盧老蘆虜路露駑魯鷺")
+ ("shr" "碌祿綠菉錄鹿")
+ ("shs" "論")
+ ("shd" "壟弄濃籠聾膿農")
+ ("shl" "惱牢磊腦賂雷")
+ ("sy" "尿")
+ ("sn" "壘屢樓淚漏累縷陋")
+ ("sns" "嫩")
+ ("snf" "訥")
+ ("sb" "杻紐")
+ ("smr" "勒肋")
+ ("sma" "凜")
+ ("smd" "凌稜綾能菱陵")
+ ("sl" "尼泥")
+ ("slr" "匿溺")
+ ("ek" "多茶")
+ ("eks" "丹亶但單團壇彖斷旦檀段湍短端簞緞蛋袒鄲鍛")
+ ("ekf" "撻澾獺疸達")
+ ("eka" "啖坍憺擔曇淡湛潭澹痰聃膽蕁覃談譚錟")
+ ("ekq" "沓畓答踏遝")
+ ("ekd" "唐堂塘幢戇撞棠當糖螳黨")
+ ("eo" "代垈坮大對岱帶待戴擡玳臺袋貸隊黛")
+ ("eor" "宅")
+ ("ejr" "德悳")
+ ("eh" "倒刀到圖堵塗導屠島嶋度徒悼挑掉搗桃棹櫂淘渡滔濤燾盜睹禱稻萄覩賭跳蹈逃途道都鍍陶韜")
+ ("ehr" "毒瀆牘犢獨督禿篤纛讀")
+ ("ehs" "墩惇敦旽暾沌焞燉豚頓")
+ ("ehf" "乭突")
+ ("ehd" "仝冬凍動同憧東桐棟洞潼疼瞳童胴董銅")
+ ("en" "兜斗杜枓痘竇荳讀豆逗頭")
+ ("ens" "屯臀芚遁遯鈍")
+ ("emr" "得")
+ ("emd" "嶝橙燈登等藤謄鄧騰")
+ ("fk" "喇懶拏癩羅蘿螺裸邏")
+ ("fkr" "樂洛烙珞絡落諾酪駱")
+ ("fks" "丹亂卵欄欒瀾爛蘭鸞")
+ ("fkf" "剌辣")
+ ("fka" "嵐擥攬欖濫籃纜藍襤覽")
+ ("fkq" "拉臘蠟")
+ ("fkd" "廊朗浪狼琅瑯螂郞")
+ ("fo" "來崍徠萊")
+ ("fod" "冷")
+ ("fir" "掠略")
+ ("fid" "亮倆兩凉梁樑粮粱糧良諒輛量")
+ ("fu" "侶儷勵呂廬慮戾旅櫚濾礪藜蠣閭驢驪麗黎")
+ ("fur" "力曆歷瀝礫轢靂")
+ ("fus" "憐戀攣漣煉璉練聯蓮輦連鍊")
+ ("fuf" "冽列劣洌烈裂")
+ ("fua" "廉斂殮濂簾")
+ ("fuq" "獵")
+ ("fud" "令伶囹寧岺嶺怜玲笭羚翎聆逞鈴零靈領齡")
+ ("fP" "例澧禮醴隷")
+ ("fh" "勞怒撈擄櫓潞瀘爐盧老蘆虜路輅露魯鷺鹵")
+ ("fhr" "碌祿綠菉錄鹿麓")
+ ("fhs" "論")
+ ("fhd" "壟弄朧瀧瓏籠聾")
+ ("fhl" "儡瀨牢磊賂賚賴雷")
+ ("fy" "了僚寮廖料燎療瞭聊蓼遼鬧")
+ ("fyd" "龍")
+ ("fn" "壘婁屢樓淚漏瘻累縷蔞褸鏤陋")
+ ("fb" "劉旒柳榴流溜瀏琉瑠留瘤硫謬類")
+ ("fbr" "六戮陸")
+ ("fbs" "侖倫崙淪綸輪")
+ ("fbf" "律慄栗率")
+ ("fbd" "隆")
+ ("fmr" "勒肋")
+ ("fma" "凜")
+ ("fmd" "凌楞稜綾菱陵")
+ ("fl" "俚利厘吏唎履悧李梨浬犁狸理璃異痢籬罹羸莉裏裡里釐離鯉")
+ ("fls" "吝潾燐璘藺躪隣鱗麟")
+ ("fla" "林淋琳臨霖")
+ ("flq" "砬立笠粒")
+ ("ak" "摩瑪痲碼磨馬魔麻")
+ ("akr" "寞幕漠膜莫邈")
+ ("aks" "万卍娩巒彎慢挽晩曼滿漫灣瞞萬蔓蠻輓饅鰻")
+ ("akf" "唜抹末沫茉襪靺")
+ ("akd" "亡妄忘忙望網罔芒茫莽輞邙")
+ ("ao" "埋妹媒寐昧枚梅每煤罵買賣邁魅")
+ ("aor" "脈貊陌驀麥")
+ ("aod" "孟氓猛盲盟萌")
+ ("aur" "冪覓")
+ ("aus" "免冕勉棉沔眄眠綿緬面麵")
+ ("auf" "滅蔑")
+ ("aud" "冥名命明暝椧溟皿瞑茗蓂螟酩銘鳴")
+ ("aP" "袂")
+ ("ah" "侮冒募姆帽慕摸摹暮某模母毛牟牡瑁眸矛耗芼茅謀謨貌")
+ ("ahr" "木沐牧目睦穆鶩")
+ ("ahf" "歿沒")
+ ("ahd" "夢朦蒙")
+ ("ay" "卯墓妙廟描昴杳渺猫竗苗錨")
+ ("an" "務巫憮懋戊拇撫无楙武毋無珷畝繆舞茂蕪誣貿霧鵡")
+ ("anr" "墨默")
+ ("ans" "們刎吻問文汶紊紋聞蚊門雯")
+ ("anf" "勿沕物")
+ ("al" "味媚尾嵋彌微未梶楣渼湄眉米美薇謎迷靡黴")
+ ("als" "岷悶愍憫敏旻旼民泯玟珉緡閔")
+ ("alf" "密蜜謐")
+ ("qkr" "剝博拍搏撲朴樸泊珀璞箔粕縛膊舶薄迫雹駁")
+ ("qks" "伴半反叛拌搬攀斑槃泮潘班畔瘢盤盼磐磻礬絆般蟠返頒飯")
+ ("qkf" "勃拔撥渤潑發跋醱鉢髮魃")
+ ("qkd" "倣傍坊妨尨幇彷房放方旁昉枋榜滂磅紡肪膀舫芳蒡蚌訪謗邦防龐")
+ ("qo" "倍俳北培徘拜排杯湃焙盃背胚裴裵褙賠輩配陪")
+ ("qor" "伯佰帛柏栢白百魄")
+ ("qjs" "幡樊煩燔番磻繁蕃藩飜")
+ ("qjf" "伐筏罰閥")
+ ("qja" "凡帆梵氾汎泛犯範范")
+ ("qjq" "法琺")
+ ("qur" "僻劈壁擘檗璧癖碧蘗闢霹")
+ ("qus" "便卞弁變辨辯邊")
+ ("quf" "別瞥鱉鼈")
+ ("qud" "丙倂兵屛幷昞昺柄棅炳甁病秉竝輧餠騈")
+ ("qh" "保堡報寶普步洑湺潽珤甫菩補褓譜輔")
+ ("qhr" "伏僕匐卜宓復服福腹茯蔔複覆輹輻馥鰒")
+ ("qhs" "本")
+ ("qhf" "乶")
+ ("qhd" "俸奉封峯峰捧棒烽熢琫縫蓬蜂逢鋒鳳")
+ ("qn" "不付俯傅剖副否咐埠夫婦孚孵富府復扶敷斧浮溥父符簿缶腐腑膚艀芙莩訃負賦賻赴趺部釜阜附駙鳧")
+ ("qnr" "北")
+ ("qns" "分吩噴墳奔奮忿憤扮昐汾焚盆粉糞紛芬賁雰")
+ ("qnf" "不佛弗彿拂")
+ ("qnd" "崩朋棚硼繃鵬")
+ ("ql" "丕備匕匪卑妃婢庇悲憊扉批斐枇榧比毖毗毘沸泌琵痺砒碑秕秘粃緋翡肥脾臂菲蜚裨誹譬費鄙非飛鼻")
+ ("qls" "嚬嬪彬斌檳殯浜濱瀕牝玭貧賓頻")
+ ("qld" "憑氷聘騁")
+ ("tk" "乍事些仕伺似使俟僿史司唆嗣四士奢娑寫寺射巳師徙思捨斜斯柶査梭死沙泗渣瀉獅砂社祀祠私篩紗絲肆舍莎蓑蛇裟詐詞謝賜赦辭邪飼駟麝")
+ ("tkr" "削數朔索")
+ ("tks" "傘刪山散汕珊産疝算蒜酸霰")
+ ("tkf" "乷撒殺煞薩")
+ ("tka" "三參杉森渗芟蔘衫")
+ ("tkq" "揷澁鈒颯")
+ ("tkd" "上傷像償商喪嘗孀尙峠常床庠廂想桑橡湘爽牀狀相祥箱翔裳觴詳象賞霜")
+ ("to" "塞璽賽")
+ ("tor" "嗇塞穡索色")
+ ("tod" "牲生甥省笙")
+ ("tj" "墅壻嶼序庶徐恕抒捿敍暑曙書栖棲犀瑞筮絮緖署胥舒薯西誓逝鋤黍鼠")
+ ("tjr" "夕奭席惜昔晳析汐淅潟石碩蓆釋錫")
+ ("tjs" "仙僊先善嬋宣扇敾旋渲煽琁瑄璇璿癬禪線繕羨腺膳船蘚蟬詵跣選銑鐥饍鮮")
+ ("tjf" "卨屑楔泄洩渫舌薛褻設說雪齧")
+ ("tja" "剡暹殲纖蟾贍閃陝")
+ ("tjq" "攝涉燮葉")
+ ("tjd" "城姓宬性惺成星晟猩珹盛省筬聖聲腥誠醒")
+ ("tp" "世勢歲洗稅笹細說貰")
+ ("th" "召嘯塑宵小少巢所掃搔昭梳沼消溯瀟炤燒甦疏疎瘙笑篠簫素紹蔬蕭蘇訴逍遡邵銷韶騷")
+ ("thr" "俗屬束涑粟續謖贖速")
+ ("ths" "孫巽損蓀遜飡")
+ ("thf" "率")
+ ("thd" "宋悚松淞訟誦送頌")
+ ("tho" "刷殺灑碎鎖")
+ ("thl" "衰釗")
+ ("tn" "修受嗽囚垂壽嫂守岫峀帥愁戍手授搜收數樹殊水洙漱燧狩獸琇璲瘦睡秀穗竪粹綏綬繡羞脩茱蒐蓚藪袖誰讐輸遂邃酬銖銹隋隧隨雖需須首髓鬚")
+ ("tnr" "叔塾夙孰宿淑潚熟琡璹肅菽")
+ ("tns" "巡徇循恂旬栒楯橓殉洵淳珣盾瞬筍純脣舜荀蓴蕣詢諄醇錞順馴")
+ ("tnf" "戌術述鉥")
+ ("tnd" "崇崧嵩")
+ ("tmf" "瑟膝蝨")
+ ("tmq" "濕拾習褶襲")
+ ("tmd" "丞乘僧勝升承昇繩蠅陞")
+ ("tl" "侍匙嘶始媤尸屎屍市弑恃施是時枾柴猜矢示翅蒔蓍視試詩諡豕豺")
+ ("tlr" "埴寔式息拭植殖湜熄篒蝕識軾食飾")
+ ("tls" "伸侁信呻娠宸愼新晨燼申神紳腎臣莘薪藎蜃訊身辛辰迅")
+ ("tlf" "失室實悉")
+ ("tla" "審尋心沁沈深瀋甚芯諶")
+ ("tlq" "什十拾")
+ ("Tkd" "雙")
+ ("Tl" "氏")
+ ("dk" "亞俄兒啞娥峨我牙芽莪蛾衙訝阿雅餓鴉鵝")
+ ("dkr" "堊岳嶽幄惡愕握樂渥鄂鍔顎鰐齷")
+ ("dks" "安岸按晏案眼雁鞍顔鮟")
+ ("dkf" "斡謁軋閼")
+ ("dka" "唵岩巖庵暗癌菴闇")
+ ("dkq" "壓押狎鴨")
+ ("dkd" "仰央怏昻殃秧鴦")
+ ("do" "厓哀埃崖愛曖涯碍艾隘靄")
+ ("dor" "厄扼掖液縊腋額")
+ ("dod" "櫻罌鶯鸚")
+ ("di" "也倻冶夜惹揶椰爺耶若野")
+ ("dir" "弱掠略約若葯蒻藥躍")
+ ("did" "亮佯兩凉壤孃恙揚攘敭暘梁楊樣洋瀁煬痒瘍禳穰糧羊良襄諒讓釀陽量養")
+ ("dj" "圄御於漁瘀禦語馭魚齬")
+ ("djr" "億憶抑檍臆")
+ ("djs" "偃堰彦焉言諺")
+ ("djf" "孼蘖")
+ ("dja" "俺儼嚴奄掩淹")
+ ("djq" "嶪業")
+ ("dps" "円")
+ ("du" "予余勵呂女如廬旅歟汝濾璵礖礪與艅茹輿轝閭餘驪麗黎")
+ ("dur" "亦力域役易曆歷疫繹譯轢逆驛")
+ ("dus" "嚥堧姸娟宴年延憐戀捐挻撚椽沇沿涎涓淵演漣烟然煙煉燃燕璉硏硯秊筵緣練縯聯衍軟輦蓮連鉛鍊鳶")
+ ("duf" "列劣咽悅涅烈熱裂說閱")
+ ("dua" "厭廉念捻染殮炎焰琰艶苒簾閻髥鹽")
+ ("duq" "曄獵燁葉")
+ ("dud" "令囹塋寧嶺嶸影怜映暎楹榮永泳渶潁濚瀛瀯煐營獰玲瑛瑩瓔盈穎纓羚聆英詠迎鈴鍈零霙靈領")
+ ("dP" "乂倪例刈叡曳汭濊猊睿穢芮藝蘂禮裔詣譽豫醴銳隸霓預")
+ ("dh" "五伍俉傲午吾吳嗚塢墺奧娛寤悟惡懊敖旿晤梧汚澳烏熬獒筽蜈誤鰲鼇")
+ ("dhr" "屋沃獄玉鈺")
+ ("dhs" "溫瑥瘟穩縕蘊")
+ ("dhf" "兀")
+ ("dhd" "壅擁瓮甕癰翁邕雍饔")
+ ("dhk" "渦瓦窩窪臥蛙蝸訛")
+ ("dhks" "婉完宛梡椀浣玩琓琬碗緩翫脘腕莞豌阮頑")
+ ("dhkf" "曰")
+ ("dhkd" "往旺枉汪王")
+ ("dho" "倭娃歪矮")
+ ("dhl" "外嵬巍猥畏")
+ ("dy" "了僚僥凹堯夭妖姚寥寮尿嶢拗搖撓擾料曜樂橈燎燿瑤療窈窯繇繞耀腰蓼蟯要謠遙遼邀饒")
+ ("dyr" "慾欲浴縟褥辱")
+ ("dyd" "俑傭冗勇埇墉容庸慂榕涌湧溶熔瑢用甬聳茸蓉踊鎔鏞龍")
+ ("dn" "于佑偶優又友右宇寓尤愚憂旴牛玗瑀盂祐禑禹紆羽芋藕虞迂遇郵釪隅雨雩")
+ ("dnr" "勖彧旭昱栯煜稶郁頊")
+ ("dns" "云暈橒殞澐熉耘芸蕓運隕雲韻")
+ ("dnf" "蔚鬱亐")
+ ("dnd" "熊雄")
+ ("dnjs" "元原員圓園垣媛嫄寃怨愿援沅洹湲源爰猿瑗苑袁轅遠阮院願鴛")
+ ("dnjf" "月越鉞")
+ ("dnl" "位偉僞危圍委威尉慰暐渭爲瑋緯胃萎葦蔿蝟衛褘謂違韋魏")
+ ("db" "乳侑儒兪劉唯喩孺宥幼幽庾悠惟愈愉揄攸有杻柔柚柳楡楢油洧流游溜濡猶猷琉瑜由留癒硫紐維臾萸裕誘諛諭踰蹂遊逾遺酉釉鍮類")
+ ("dbr" "六堉戮毓肉育陸")
+ ("dbs" "倫允奫尹崙淪潤玧胤贇輪鈗閏")
+ ("dbf" "律慄栗率聿")
+ ("dbd" "戎瀜絨融隆")
+ ("dms" "垠恩慇殷誾銀隱")
+ ("dmf" "乙")
+ ("dma" "吟淫蔭陰音飮")
+ ("dmq" "揖泣邑")
+ ("dmd" "凝應膺鷹")
+ ("dml" "依倚儀宜意懿擬椅毅疑矣義艤薏蟻衣誼議醫")
+ ("dl" "二以伊利吏夷姨履已弛彛怡易李梨泥爾珥理異痍痢移罹而耳肄苡荑裏裡貽貳邇里離飴餌")
+ ("dlr" "匿溺瀷益翊翌翼謚")
+ ("dls" "人仁刃印吝咽因姻寅引忍湮燐璘絪茵藺蚓認隣靭靷鱗麟")
+ ("dlf" "一佚佾壹日溢逸鎰馹")
+ ("dla" "任壬妊姙恁林淋稔臨荏賃")
+ ("dlq" "入卄立笠粒")
+ ("dld" "仍剩孕芿")
+ ("wk" "仔刺咨姉姿子字孜恣慈滋炙煮玆瓷疵磁紫者自茨蔗藉諮資雌")
+ ("wkr" "作勺嚼斫昨灼炸爵綽芍酌雀鵲")
+ ("wks" "孱棧殘潺盞")
+ ("wka" "岑暫潛箴簪蠶")
+ ("wkq" "雜")
+ ("wkd" "丈仗匠場墻壯奬將帳庄張掌暲杖樟檣欌漿牆狀獐璋章粧腸臟臧莊葬蔣薔藏裝贓醬長障")
+ ("wo" "再哉在宰才材栽梓渽滓災縡裁財載齋齎")
+ ("wod" "爭箏諍錚")
+ ("wj" "佇低儲咀姐底抵杵楮樗沮渚狙猪疽箸紵苧菹著藷詛貯躇這邸雎齟")
+ ("wjr" "勣吊嫡寂摘敵滴狄炙的積笛籍績翟荻謫賊赤跡蹟迪迹適鏑")
+ ("wjs" "佃佺傳全典前剪塡塼奠專展廛悛戰栓殿氈澱煎琠田甸畑癲筌箋箭篆纏詮輾轉鈿銓錢鐫電顚顫餞")
+ ("wjf" "切截折浙癤竊節絶")
+ ("wja" "占岾店漸点粘霑鮎點")
+ ("wjq" "接摺蝶")
+ ("wjd" "丁井亭停偵呈姃定幀庭廷征情挺政整旌晶晸柾楨檉正汀淀淨渟湞瀞炡玎珽町睛碇禎程穽精綎艇訂諪貞鄭酊釘鉦鋌錠霆靖靜頂鼎")
+ ("wp" "制劑啼堤帝弟悌提梯濟祭第臍薺製諸蹄醍除際霽題齊")
+ ("wh" "俎兆凋助嘲弔彫措操早晁曺曹朝條棗槽漕潮照燥爪璪眺祖祚租稠窕粗糟組繰肇藻蚤詔調趙躁造遭釣阻雕鳥")
+ ("whr" "族簇足鏃")
+ ("whs" "存尊")
+ ("whf" "卒拙猝")
+ ("whd" "倧宗從悰慫棕淙琮種終綜縱腫踪踵鍾鐘")
+ ("whk" "佐坐左座挫")
+ ("whl" "罪")
+ ("wn" "主住侏做姝胄呪周嗾奏宙州廚晝朱柱株注洲湊澍炷珠疇籌紂紬綢舟蛛註誅走躊輳週酎酒鑄駐")
+ ("wnr" "竹粥")
+ ("wns" "俊儁准埈寯峻晙樽浚準濬焌畯竣蠢逡遵雋駿")
+ ("wnf" "茁")
+ ("wnd" "中仲衆重")
+ ("wmr" "卽")
+ ("wmf" "櫛")
+ ("wmq" "楫汁葺")
+ ("wmd" "增憎曾拯烝甑症繒蒸證贈")
+ ("wl" "之只咫地址志持指摯支旨智枝枳止池沚漬知砥祉祗紙肢脂至芝芷蜘誌識贄趾遲")
+ ("wlr" "直稙稷織職")
+ ("wls" "唇嗔塵振搢晉晋桭榛殄津溱珍瑨璡畛疹盡眞瞋秦縉縝臻蔯袗診賑軫辰進鎭陣陳震")
+ ("wlf" "侄叱姪嫉帙桎瓆疾秩窒膣蛭質跌迭")
+ ("wla" "斟朕")
+ ("wlq" "什執潗緝輯鏶集")
+ ("wld" "徵懲澄")
+ ("ck" "且侘借叉嗟嵯差次此磋箚茶蹉車遮")
+ ("ckr" "捉搾着窄錯鑿齪")
+ ("cks" "撰澯燦璨瓚竄簒纂粲纘讚贊鑽餐饌")
+ ("ckf" "刹察擦札紮")
+ ("cka" "僭參塹慘慙懺斬站讒讖")
+ ("ckd" "倉倡創唱娼廠彰愴敞昌昶暢槍滄漲猖瘡窓脹艙菖蒼")
+ ("co" "債埰寀寨彩採砦綵菜蔡采釵")
+ ("cor" "冊柵策責")
+ ("cj" "凄妻悽處")
+ ("cjr" "倜刺剔尺慽戚拓擲斥滌瘠脊蹠陟隻")
+ ("cjs" "仟千喘天川擅泉淺玔穿舛薦賤踐遷釧闡阡韆")
+ ("cjf" "凸哲喆徹撤澈綴輟轍鐵")
+ ("cja" "僉尖沾添甛瞻簽籤詹諂")
+ ("cjq" "堞妾帖捷牒疊睫諜貼輒")
+ ("cjd" "廳晴淸聽菁請靑鯖")
+ ("cp" "切剃替涕滯締諦逮遞體")
+ ("ch" "初剿哨憔抄招梢椒楚樵炒焦硝礁礎秒稍肖艸苕草蕉貂超酢醋醮")
+ ("chr" "促囑燭矗蜀觸")
+ ("chs" "寸忖村邨")
+ ("chd" "叢塚寵悤憁摠總聰蔥銃")
+ ("chkf" "撮")
+ ("chl" "催崔最")
+ ("cn" "墜抽推椎楸樞湫皺秋芻萩諏趨追鄒酋醜錐錘鎚雛騶鰍")
+ ("cnr" "丑畜祝竺筑築縮蓄蹙蹴軸逐")
+ ("cns" "春椿瑃")
+ ("cnf" "出朮黜")
+ ("cnd" "充忠沖蟲衝衷")
+ ("cnp" "悴膵萃贅")
+ ("cnl" "取吹嘴娶就炊翠聚脆臭趣醉驟鷲")
+ ("cmr" "側仄厠惻測")
+ ("cmd" "層")
+ ("cl" "侈値嗤峙幟恥梔治淄熾痔痴癡稚穉緇緻置致蚩輜雉馳齒")
+ ("clr" "則勅飭")
+ ("cls" "親")
+ ("clf" "七柒漆")
+ ("cla" "侵寢枕沈浸琛砧針鍼")
+ ("clq" "蟄")
+ ("cld" "秤稱")
+ ("zho" "快")
+ ("xk" "他咤唾墮妥惰打拖朶楕舵陀馱駝")
+ ("xkr" "倬卓啄坼度托拓擢晫柝濁濯琢琸託鐸")
+ ("xks" "呑嘆坦彈憚歎灘炭綻誕")
+ ("xkf" "奪脫")
+ ("xka" "探眈耽貪")
+ ("xkq" "塔搭榻")
+ ("xkd" "宕帑湯糖蕩")
+ ("xo" "兌台太怠態殆汰泰笞胎苔跆邰颱")
+ ("xor" "宅擇澤")
+ ("xod" "撑")
+ ("xj" "攄")
+ ("xh" "兎吐土討")
+ ("xhd" "慟桶洞痛筒統通")
+ ("xhl" "堆槌腿褪退頹")
+ ("xn" "偸套妬投透鬪")
+ ("xmr" "慝特")
+ ("xma" "闖")
+ ("vk" "坡婆巴把播擺杷波派爬琶破罷芭跛頗")
+ ("vks" "判坂板版瓣販辦鈑阪")
+ ("vkf" "八叭捌")
+ ("vo" "佩唄悖敗沛浿牌狽稗覇貝")
+ ("vod" "彭澎烹膨")
+ ("vir" "愎")
+ ("vus" "便偏扁片篇編翩遍鞭騙")
+ ("vua" "貶")
+ ("vud" "坪平枰萍評")
+ ("vP" "吠嬖幣廢弊斃肺蔽閉陛")
+ ("vh" "佈包匍匏咆哺圃布怖抛抱捕暴泡浦疱砲胞脯苞葡蒲袍褒逋鋪飽鮑")
+ ("vhr" "幅暴曝瀑爆輻")
+ ("vy" "俵剽彪慓杓標漂瓢票表豹飇飄驃")
+ ("vna" "品稟")
+ ("vnd" "楓諷豊風馮")
+ ("vl" "彼披疲皮被避陂")
+ ("vlf" "匹弼必泌珌畢疋筆苾馝")
+ ("vlq" "乏逼")
+ ("gk" "下何厦夏廈昰河瑕荷蝦賀遐霞鰕")
+ ("gkr" "壑學虐謔鶴")
+ ("gks" "寒恨悍旱汗漢澣瀚罕翰閑閒限韓")
+ ("gkf" "割轄")
+ ("gka" "函含咸啣喊檻涵緘艦銜陷鹹")
+ ("gkq" "合哈盒蛤閤闔陜")
+ ("gkd" "亢伉姮嫦巷恒抗杭桁沆港缸肛航行降項")
+ ("go" "亥偕咳垓奚孩害懈楷海瀣蟹解該諧邂駭骸")
+ ("gor" "劾核")
+ ("god" "倖幸杏荇行")
+ ("gid" "享向嚮珦鄕響餉饗香")
+ ("gj" "噓墟虛許")
+ ("gjs" "憲櫶獻軒")
+ ("gjf" "歇")
+ ("gja" "險驗")
+ ("gur" "奕爀赫革")
+ ("gus" "俔峴弦懸晛泫炫玄玹現眩睍絃絢縣舷衒見賢鉉顯")
+ ("guf" "孑穴血頁")
+ ("gua" "嫌")
+ ("guq" "俠協夾峽挾浹狹脅脇莢鋏頰")
+ ("gud" "亨兄刑型形泂滎瀅灐炯熒珩瑩荊螢衡逈邢鎣馨")
+ ("gP" "兮彗惠慧暳蕙蹊醯鞋")
+ ("gh" "乎互呼壕壺好岵弧戶扈昊晧毫浩淏湖滸澔濠濩灝狐琥瑚瓠皓祜糊縞胡芦葫蒿虎號蝴護豪鎬頀顥")
+ ("ghr" "惑或酷")
+ ("ghs" "婚昏混渾琿魂")
+ ("ghf" "忽惚笏")
+ ("ghd" "哄弘汞泓洪烘紅虹訌鴻")
+ ("ghk" "化和嬅樺火畵禍禾花華話譁貨靴")
+ ("ghkr" "廓擴攫確碻穫")
+ ("ghks" "丸喚奐宦幻患換歡晥桓渙煥環紈還驩鰥")
+ ("ghkf" "活滑猾豁闊")
+ ("ghkd" "凰幌徨恍惶愰慌晃晄榥況湟滉潢煌璜皇篁簧荒蝗遑隍黃")
+ ("ghl" "匯回廻徊恢悔懷晦會檜淮澮灰獪繪膾茴蛔誨賄")
+ ("ghlr" "劃獲")
+ ("ghld" "宖橫鐄")
+ ("gy" "哮嚆孝效斅曉梟涍淆爻肴酵驍")
+ ("gn" "侯候厚后吼喉嗅帿後朽煦珝逅")
+ ("gns" "勛勳塤壎焄熏燻薰訓暈")
+ ("gnd" "薨")
+ ("gnjs" "喧暄煊萱")
+ ("gnp" "卉喙毁")
+ ("gnl" "彙徽揮暉煇諱輝麾")
+ ("gb" "休携烋畦虧")
+ ("gbf" "恤譎鷸")
+ ("gbd" "兇凶匈洶胸")
+ ("gmr" "黑")
+ ("gms" "昕欣炘痕")
+ ("gmf" "吃屹紇訖")
+ ("gma" "欠欽歆")
+ ("gmq" "吸恰洽翕")
+ ("gmd" "興")
+ ("gml" "僖凞喜噫囍姬嬉希憙憘戱晞曦熙熹熺犧禧稀羲")
+ ("glf" "詰"))
+
+;;; hanja.el ends here
diff --git a/lisp/leim/quail/hanja3.el b/lisp/leim/quail/hanja3.el
new file mode 100644
index 00000000000..14446a96a57
--- /dev/null
+++ b/lisp/leim/quail/hanja3.el
@@ -0,0 +1,614 @@
+;;; hanja3.el --- Quail-package for Korean Hanja (KSC5601) -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Koaunghi Un <koaunghi.un@zdv.uni-tuebingen.de>
+;; Keywords: mule, quail, multilingual, input method, Korean, Hanja
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines korean-hanja3 keyboards:
+;; - hanja input method with hangul keyboard type 3
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "korean-hanja3" "Korean" "漢3" t
+ "3벌식KSC漢字: 該當하는 漢字의 韻을 한글3벌式으로 呼出하여 選擇"
+ nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("kf" "伽佳假價加可呵哥嘉嫁家暇架枷柯歌珂痂稼苛茄街袈訶賈跏軻迦駕")
+ ("kfx" "刻却各恪慤殼珏脚覺角閣")
+ ("kfs" "侃刊墾奸姦干幹懇揀杆柬桿澗癎看磵稈竿簡肝艮艱諫間")
+ ("kfw" "乫喝曷渴碣竭葛褐蝎鞨")
+ ("kfz" "勘坎堪嵌感憾戡敢柑橄減甘疳監瞰紺邯鑑鑒龕")
+ ("kf3" "匣岬甲胛鉀閘")
+ ("kfa" "剛堈姜岡崗康强彊慷江畺疆糠絳綱羌腔舡薑襁講鋼降鱇")
+ ("kr" "介价個凱塏愷愾慨改槪漑疥皆盖箇芥蓋豈鎧開")
+ ("krx" "喀客")
+ ("kra" "坑更粳羹")
+ ("k6x" "醵")
+ ("kt" "倨去居巨拒据據擧渠炬祛距踞車遽鉅鋸")
+ ("kts" "乾件健巾建愆楗腱虔蹇鍵騫")
+ ("ktw" "乞傑杰桀")
+ ("ktz" "儉劍劒檢瞼鈐黔")
+ ("kt3" "劫怯迲")
+ ("kc" "偈憩揭")
+ ("kex" "擊格檄激膈覡隔")
+ ("kes" "堅牽犬甄絹繭肩見譴遣鵑")
+ ("kew" "抉決潔結缺訣")
+ ("kez" "兼慊箝謙鉗鎌")
+ ("kea" "京俓倞傾儆勁勍卿坰境庚徑慶憬擎敬景暻更梗涇炅烱璟璥瓊痙硬磬竟競絅經耕耿脛莖警輕逕鏡頃頸驚鯨")
+ ("k7" "係啓堺契季屆悸戒桂械棨溪界癸磎稽系繫繼計誡谿階鷄")
+ ("kv" "古叩告呱固姑孤尻庫拷攷故敲暠枯槁沽痼皐睾稿羔考股膏苦苽菰藁蠱袴誥賈辜錮雇顧高鼓")
+ ("kvx" "哭斛曲梏穀谷鵠")
+ ("kvs" "困坤崑昆梱棍滾琨袞鯤")
+ ("kvw" "汨滑骨")
+ ("kva" "供公共功孔工恐恭拱控攻珙空蚣貢鞏")
+ ("kv!" "串")
+ ("k/" "古叩告呱固姑孤尻庫拷攷故敲暠枯槁沽痼皐睾稿羔考股膏苦苽菰藁蠱袴誥賈辜錮雇顧高鼓")
+ ("k/x" "哭斛曲梏穀谷鵠")
+ ("k/s" "困坤崑昆梱棍滾琨袞鯤")
+ ("k/w" "汨滑骨")
+ ("k/a" "供公共功孔工恐恭拱控攻珙空蚣貢鞏")
+ ("k/!" "串")
+ ("k/f" "寡戈果瓜科菓誇課跨過鍋顆")
+ ("k/fx" "廓槨藿郭")
+ ("k/fs" "串冠官寬慣棺款灌琯瓘管罐菅觀貫關館")
+ ("k/fw" "刮恝括适")
+ ("k/fa" "侊光匡壙廣曠洸炚狂珖筐胱鑛")
+ ("k/r" "卦掛罫")
+ ("k/d" "乖傀塊壞怪愧拐槐魁")
+ ("k/da" "宏紘肱轟")
+ ("k4" "交僑咬喬嬌嶠巧攪敎校橋狡皎矯絞翹膠蕎蛟較轎郊餃驕鮫")
+ ("kb" "丘久九仇俱具勾區口句咎嘔坵垢寇嶇廐懼拘救枸柩構歐毆毬求溝灸狗玖球瞿矩究絿耉臼舅舊苟衢謳購軀逑邱鉤銶駒驅鳩鷗龜")
+ ("kbx" "國局菊鞠鞫麴")
+ ("kbs" "君窘群裙軍郡")
+ ("kbw" "堀屈掘窟")
+ ("kba" "宮弓穹窮芎躬")
+ ("k9" "丘久九仇俱具勾區口句咎嘔坵垢寇嶇廐懼拘救枸柩構歐毆毬求溝灸狗玖球瞿矩究絿耉臼舅舊苟衢謳購軀逑邱鉤銶駒驅鳩鷗龜")
+ ("k9x" "國局菊鞠鞫麴")
+ ("k9s" "君窘群裙軍郡")
+ ("k9w" "堀屈掘窟")
+ ("k9a" "宮弓穹窮芎躬")
+ ("k9ts" "倦券勸卷圈拳捲權淃眷")
+ ("k9tw" "厥獗蕨蹶闕")
+ ("k9c" "机櫃潰詭軌饋")
+ ("k9d" "句晷歸貴鬼龜")
+ ("k5" "叫圭奎揆槻珪硅窺竅糾葵規赳逵閨")
+ ("k5s" "勻均畇筠菌鈞龜")
+ ("k5w" "橘")
+ ("kgx" "克剋劇戟棘極隙")
+ ("kgs" "僅劤勤懃斤根槿瑾筋芹菫覲謹近饉")
+ ("kgw" "契")
+ ("kgz" "今妗擒昑檎琴禁禽芩衾衿襟金錦")
+ ("kg3" "伋及急扱汲級給")
+ ("kga" "亘兢矜肯")
+ ("kd" "企伎其冀嗜器圻基埼夔奇妓寄岐崎己幾忌技旗旣朞期杞棋棄機欺氣汽沂淇玘琦琪璂璣畸畿碁磯祁祇祈祺箕紀綺羈耆耭肌記譏豈起錡錤飢饑騎騏驥麒")
+ ("kds" "緊")
+ ("kdw" "佶吉拮桔")
+ ("kdz" "金")
+ ("kkdx" "喫")
+ ("hf" "儺喇奈娜懦懶拏拿癩羅蘿螺裸邏那")
+ ("hfx" "樂洛烙珞落諾酪駱")
+ ("hfs" "亂卵暖欄煖爛蘭難鸞")
+ ("hfw" "捏捺")
+ ("hfz" "南嵐枏楠湳濫男藍襤")
+ ("hf3" "拉納臘蠟衲")
+ ("hfa" "囊娘廊朗浪狼郎")
+ ("hr" "乃來內奈柰耐")
+ ("hra" "冷")
+ ("he" "女")
+ ("hes" "年撚秊")
+ ("hez" "念恬拈捻")
+ ("hea" "寧寗")
+ ("hv" "努勞奴弩怒擄櫓爐瑙盧老蘆虜路露駑魯鷺")
+ ("hvx" "碌祿綠菉錄鹿")
+ ("hvs" "論")
+ ("hva" "壟弄濃籠聾膿農")
+ ("h/" "努勞奴弩怒擄櫓爐瑙盧老蘆虜路露駑魯鷺")
+ ("h/x" "碌祿綠菉錄鹿")
+ ("h/s" "論")
+ ("h/a" "壟弄濃籠聾膿農")
+ ("h/d" "惱牢磊腦賂雷")
+ ("h4" "尿")
+ ("hb" "壘屢樓淚漏累縷陋")
+ ("hbs" "嫩")
+ ("hbw" "訥")
+ ("h9" "壘屢樓淚漏累縷陋")
+ ("h9s" "嫩")
+ ("h9w" "訥")
+ ("h5" "杻紐")
+ ("hgx" "勒肋")
+ ("hgz" "凜")
+ ("hga" "凌稜綾能菱陵")
+ ("hd" "尼泥")
+ ("hdx" "匿溺")
+ ("uf" "多茶")
+ ("ufs" "丹亶但單團壇彖斷旦檀段湍短端簞緞蛋袒鄲鍛")
+ ("ufw" "撻澾獺疸達")
+ ("ufz" "啖坍憺擔曇淡湛潭澹痰聃膽蕁覃談譚錟")
+ ("uf3" "沓畓答踏遝")
+ ("ufa" "唐堂塘幢戇撞棠當糖螳黨")
+ ("ur" "代垈坮大對岱帶待戴擡玳臺袋貸隊黛")
+ ("urx" "宅")
+ ("utx" "德悳")
+ ("uv" "倒刀到圖堵塗導屠島嶋度徒悼挑掉搗桃棹櫂淘渡滔濤燾盜睹禱稻萄覩賭跳蹈逃途道都鍍陶韜")
+ ("uvx" "毒瀆牘犢獨督禿篤纛讀")
+ ("uvs" "墩惇敦旽暾沌焞燉豚頓")
+ ("uvw" "乭突")
+ ("uva" "仝冬凍動同憧東桐棟洞潼疼瞳童胴董銅")
+ ("u/" "倒刀到圖堵塗導屠島嶋度徒悼挑掉搗桃棹櫂淘渡滔濤燾盜睹禱稻萄覩賭跳蹈逃途道都鍍陶韜")
+ ("u/x" "毒瀆牘犢獨督禿篤纛讀")
+ ("u/s" "墩惇敦旽暾沌焞燉豚頓")
+ ("u/w" "乭突")
+ ("u/a" "仝冬凍動同憧東桐棟洞潼疼瞳童胴董銅")
+ ("ub" "兜斗杜枓痘竇荳讀豆逗頭")
+ ("ubs" "屯臀芚遁遯鈍")
+ ("u9" "兜斗杜枓痘竇荳讀豆逗頭")
+ ("u9s" "屯臀芚遁遯鈍")
+ ("ugx" "得")
+ ("uga" "嶝橙燈登等藤謄鄧騰")
+ ("yf" "喇懶拏癩羅蘿螺裸邏")
+ ("yfx" "樂洛烙珞絡落諾酪駱")
+ ("yfs" "丹亂卵欄欒瀾爛蘭鸞")
+ ("yfw" "剌辣")
+ ("yfz" "嵐擥攬欖濫籃纜藍襤覽")
+ ("yf3" "拉臘蠟")
+ ("yfa" "廊朗浪狼琅瑯螂郞")
+ ("yr" "來崍徠萊")
+ ("yra" "冷")
+ ("y6x" "掠略")
+ ("y6a" "亮倆兩凉梁樑粮粱糧良諒輛量")
+ ("ye" "侶儷勵呂廬慮戾旅櫚濾礪藜蠣閭驢驪麗黎")
+ ("yex" "力曆歷瀝礫轢靂")
+ ("yes" "憐戀攣漣煉璉練聯蓮輦連鍊")
+ ("yew" "冽列劣洌烈裂")
+ ("yez" "廉斂殮濂簾")
+ ("ye3" "獵")
+ ("yea" "令伶囹寧岺嶺怜玲笭羚翎聆逞鈴零靈領齡")
+ ("y7" "例澧禮醴隷")
+ ("yv" "勞怒撈擄櫓潞瀘爐盧老蘆虜路輅露魯鷺鹵")
+ ("yvx" "碌祿綠菉錄鹿麓")
+ ("yvs" "論")
+ ("yva" "壟弄朧瀧瓏籠聾")
+ ("y/" "勞怒撈擄櫓潞瀘爐盧老蘆虜路輅露魯鷺鹵")
+ ("y/x" "碌祿綠菉錄鹿麓")
+ ("y/s" "論")
+ ("y/a" "壟弄朧瀧瓏籠聾")
+ ("y/d" "儡瀨牢磊賂賚賴雷")
+ ("y4" "了僚寮廖料燎療瞭聊蓼遼鬧")
+ ("y4a" "龍")
+ ("yb" "壘婁屢樓淚漏瘻累縷蔞褸鏤陋")
+ ("y9" "壘婁屢樓淚漏瘻累縷蔞褸鏤陋")
+ ("y5" "劉旒柳榴流溜瀏琉瑠留瘤硫謬類")
+ ("y5x" "六戮陸")
+ ("y5s" "侖倫崙淪綸輪")
+ ("y5w" "律慄栗率")
+ ("y5a" "隆")
+ ("ygx" "勒肋")
+ ("ygz" "凜")
+ ("yga" "凌楞稜綾菱陵")
+ ("yd" "俚利厘吏唎履悧李梨浬犁狸理璃異痢籬罹羸莉裏裡里釐離鯉")
+ ("yds" "吝潾燐璘藺躪隣鱗麟")
+ ("ydz" "林淋琳臨霖")
+ ("yd3" "砬立笠粒")
+ ("if" "摩瑪痲碼磨馬魔麻")
+ ("ifx" "寞幕漠膜莫邈")
+ ("ifs" "万卍娩巒彎慢挽晩曼滿漫灣瞞萬蔓蠻輓饅鰻")
+ ("ifw" "唜抹末沫茉襪靺")
+ ("ifa" "亡妄忘忙望網罔芒茫莽輞邙")
+ ("ir" "埋妹媒寐昧枚梅每煤罵買賣邁魅")
+ ("irx" "脈貊陌驀麥")
+ ("ira" "孟氓猛盲盟萌")
+ ("iex" "冪覓")
+ ("ies" "免冕勉棉沔眄眠綿緬面麵")
+ ("iew" "滅蔑")
+ ("iea" "冥名命明暝椧溟皿瞑茗蓂螟酩銘鳴")
+ ("i7" "袂")
+ ("iv" "侮冒募姆帽慕摸摹暮某模母毛牟牡瑁眸矛耗芼茅謀謨貌")
+ ("ivx" "木沐牧目睦穆鶩")
+ ("ivw" "歿沒")
+ ("iva" "夢朦蒙")
+ ("i/" "侮冒募姆帽慕摸摹暮某模母毛牟牡瑁眸矛耗芼茅謀謨貌")
+ ("i/x" "木沐牧目睦穆鶩")
+ ("i/w" "歿沒")
+ ("i/a" "夢朦蒙")
+ ("i4" "卯墓妙廟描昴杳渺猫竗苗錨")
+ ("ib" "務巫憮懋戊拇撫无楙武毋無珷畝繆舞茂蕪誣貿霧鵡")
+ ("ibx" "墨默")
+ ("ibs" "們刎吻問文汶紊紋聞蚊門雯")
+ ("ibw" "勿沕物")
+ ("i9" "務巫憮懋戊拇撫无楙武毋無珷畝繆舞茂蕪誣貿霧鵡")
+ ("i9x" "墨默")
+ ("i9s" "們刎吻問文汶紊紋聞蚊門雯")
+ ("i9w" "勿沕物")
+ ("id" "味媚尾嵋彌微未梶楣渼湄眉米美薇謎迷靡黴")
+ ("ids" "岷悶愍憫敏旻旼民泯玟珉緡閔")
+ ("idw" "密蜜謐")
+ (";fx" "剝博拍搏撲朴樸泊珀璞箔粕縛膊舶薄迫雹駁")
+ (";fs" "伴半反叛拌搬攀斑槃泮潘班畔瘢盤盼磐磻礬絆般蟠返頒飯")
+ (";fw" "勃拔撥渤潑發跋醱鉢髮魃")
+ (";fa" "倣傍坊妨尨幇彷房放方旁昉枋榜滂磅紡肪膀舫芳蒡蚌訪謗邦防龐")
+ (";r" "倍俳北培徘拜排杯湃焙盃背胚裴裵褙賠輩配陪")
+ (";rx" "伯佰帛柏栢白百魄")
+ (";ts" "幡樊煩燔番磻繁蕃藩飜")
+ (";tw" "伐筏罰閥")
+ (";tz" "凡帆梵氾汎泛犯範范")
+ (";t3" "法琺")
+ (";ex" "僻劈壁擘檗璧癖碧蘗闢霹")
+ (";es" "便卞弁變辨辯邊")
+ (";ew" "別瞥鱉鼈")
+ (";ea" "丙倂兵屛幷昞昺柄棅炳甁病秉竝輧餠騈")
+ (";v" "保堡報寶普步洑湺潽珤甫菩補褓譜輔")
+ (";vx" "伏僕匐卜宓復服福腹茯蔔複覆輹輻馥鰒")
+ (";vs" "本")
+ (";vw" "乶")
+ (";va" "俸奉封峯峰捧棒烽熢琫縫蓬蜂逢鋒鳳")
+ (";/" "保堡報寶普步洑湺潽珤甫菩補褓譜輔")
+ (";/x" "伏僕匐卜宓復服福腹茯蔔複覆輹輻馥鰒")
+ (";/s" "本")
+ (";/w" "乶")
+ (";/a" "俸奉封峯峰捧棒烽熢琫縫蓬蜂逢鋒鳳")
+ (";b" "不付俯傅剖副否咐埠夫婦孚孵富府復扶敷斧浮溥父符簿缶腐腑膚艀芙莩訃負賦賻赴趺部釜阜附駙鳧")
+ (";bx" "北")
+ (";bs" "分吩噴墳奔奮忿憤扮昐汾焚盆粉糞紛芬賁雰")
+ (";bw" "不佛弗彿拂")
+ (";ba" "崩朋棚硼繃鵬")
+ (";9" "不付俯傅剖副否咐埠夫婦孚孵富府復扶敷斧浮溥父符簿缶腐腑膚艀芙莩訃負賦賻赴趺部釜阜附駙鳧")
+ (";9x" "北")
+ (";9s" "分吩噴墳奔奮忿憤扮昐汾焚盆粉糞紛芬賁雰")
+ (";9w" "不佛弗彿拂")
+ (";9a" "崩朋棚硼繃鵬")
+ (";d" "丕備匕匪卑妃婢庇悲憊扉批斐枇榧比毖毗毘沸泌琵痺砒碑秕秘粃緋翡肥脾臂菲蜚裨誹譬費鄙非飛鼻")
+ (";ds" "嚬嬪彬斌檳殯浜濱瀕牝玭貧賓頻")
+ (";da" "憑氷聘騁")
+ ("nf" "乍事些仕伺似使俟僿史司唆嗣四士奢娑寫寺射巳師徙思捨斜斯柶査梭死沙泗渣瀉獅砂社祀祠私篩紗絲肆舍莎蓑蛇裟詐詞謝賜赦辭邪飼駟麝")
+ ("nfx" "削數朔索")
+ ("nfs" "傘刪山散汕珊産疝算蒜酸霰")
+ ("nfw" "乷撒殺煞薩")
+ ("nfz" "三參杉森渗芟蔘衫")
+ ("nf3" "揷澁鈒颯")
+ ("nfa" "上傷像償商喪嘗孀尙峠常床庠廂想桑橡湘爽牀狀相祥箱翔裳觴詳象賞霜")
+ ("nr" "塞璽賽")
+ ("nrx" "嗇塞穡索色")
+ ("nra" "牲生甥省笙")
+ ("nt" "墅壻嶼序庶徐恕抒捿敍暑曙書栖棲犀瑞筮絮緖署胥舒薯西誓逝鋤黍鼠")
+ ("ntx" "夕奭席惜昔晳析汐淅潟石碩蓆釋錫")
+ ("nts" "仙僊先善嬋宣扇敾旋渲煽琁瑄璇璿癬禪線繕羨腺膳船蘚蟬詵跣選銑鐥饍鮮")
+ ("ntw" "卨屑楔泄洩渫舌薛褻設說雪齧")
+ ("ntz" "剡暹殲纖蟾贍閃陝")
+ ("nt3" "攝涉燮葉")
+ ("nta" "城姓宬性惺成星晟猩珹盛省筬聖聲腥誠醒")
+ ("nc" "世勢歲洗稅笹細說貰")
+ ("nv" "召嘯塑宵小少巢所掃搔昭梳沼消溯瀟炤燒甦疏疎瘙笑篠簫素紹蔬蕭蘇訴逍遡邵銷韶騷")
+ ("nvx" "俗屬束涑粟續謖贖速")
+ ("nvs" "孫巽損蓀遜飡")
+ ("nvw" "率")
+ ("nva" "宋悚松淞訟誦送頌")
+ ("n/" "召嘯塑宵小少巢所掃搔昭梳沼消溯瀟炤燒甦疏疎瘙笑篠簫素紹蔬蕭蘇訴逍遡邵銷韶騷")
+ ("n/x" "俗屬束涑粟續謖贖速")
+ ("n/s" "孫巽損蓀遜飡")
+ ("n/w" "率")
+ ("n/a" "宋悚松淞訟誦送頌")
+ ("n/r" "刷殺灑碎鎖")
+ ("n/d" "衰釗")
+ ("nb" "修受嗽囚垂壽嫂守岫峀帥愁戍手授搜收數樹殊水洙漱燧狩獸琇璲瘦睡秀穗竪粹綏綬繡羞脩茱蒐蓚藪袖誰讐輸遂邃酬銖銹隋隧隨雖需須首髓鬚")
+ ("nbx" "叔塾夙孰宿淑潚熟琡璹肅菽")
+ ("nbs" "巡徇循恂旬栒楯橓殉洵淳珣盾瞬筍純脣舜荀蓴蕣詢諄醇錞順馴")
+ ("nbw" "戌術述鉥")
+ ("nba" "崇崧嵩")
+ ("n9" "修受嗽囚垂壽嫂守岫峀帥愁戍手授搜收數樹殊水洙漱燧狩獸琇璲瘦睡秀穗竪粹綏綬繡羞脩茱蒐蓚藪袖誰讐輸遂邃酬銖銹隋隧隨雖需須首髓鬚")
+ ("n9x" "叔塾夙孰宿淑潚熟琡璹肅菽")
+ ("n9s" "巡徇循恂旬栒楯橓殉洵淳珣盾瞬筍純脣舜荀蓴蕣詢諄醇錞順馴")
+ ("n9w" "戌術述鉥")
+ ("n9a" "崇崧嵩")
+ ("ngw" "瑟膝蝨")
+ ("ng3" "濕拾習褶襲")
+ ("nga" "丞乘僧勝升承昇繩蠅陞")
+ ("nd" "侍匙嘶始媤尸屎屍市弑恃施是時枾柴猜矢示翅蒔蓍視試詩諡豕豺")
+ ("ndx" "埴寔式息拭植殖湜熄篒蝕識軾食飾")
+ ("nds" "伸侁信呻娠宸愼新晨燼申神紳腎臣莘薪藎蜃訊身辛辰迅")
+ ("ndw" "失室實悉")
+ ("ndz" "審尋心沁沈深瀋甚芯諶")
+ ("nd3" "什十拾")
+ ("nnfa" "雙")
+ ("nnd" "氏")
+ ("jf" "亞俄兒啞娥峨我牙芽莪蛾衙訝阿雅餓鴉鵝")
+ ("jfx" "堊岳嶽幄惡愕握樂渥鄂鍔顎鰐齷")
+ ("jfs" "安岸按晏案眼雁鞍顔鮟")
+ ("jfw" "斡謁軋閼")
+ ("jfz" "唵岩巖庵暗癌菴闇")
+ ("jf3" "壓押狎鴨")
+ ("jfa" "仰央怏昻殃秧鴦")
+ ("jr" "厓哀埃崖愛曖涯碍艾隘靄")
+ ("jrx" "厄扼掖液縊腋額")
+ ("jra" "櫻罌鶯鸚")
+ ("j6" "也倻冶夜惹揶椰爺耶若野")
+ ("j6x" "弱掠略約若葯蒻藥躍")
+ ("j6a" "亮佯兩凉壤孃恙揚攘敭暘梁楊樣洋瀁煬痒瘍禳穰糧羊良襄諒讓釀陽量養")
+ ("jt" "圄御於漁瘀禦語馭魚齬")
+ ("jtx" "億憶抑檍臆")
+ ("jts" "偃堰彦焉言諺")
+ ("jtw" "孼蘖")
+ ("jtz" "俺儼嚴奄掩淹")
+ ("jt3" "嶪業")
+ ("jcs" "円")
+ ("je" "予余勵呂女如廬旅歟汝濾璵礖礪與艅茹輿轝閭餘驪麗黎")
+ ("jex" "亦力域役易曆歷疫繹譯轢逆驛")
+ ("jes" "嚥堧姸娟宴年延憐戀捐挻撚椽沇沿涎涓淵演漣烟然煙煉燃燕璉硏硯秊筵緣練縯聯衍軟輦蓮連鉛鍊鳶")
+ ("jew" "列劣咽悅涅烈熱裂說閱")
+ ("jez" "厭廉念捻染殮炎焰琰艶苒簾閻髥鹽")
+ ("je3" "曄獵燁葉")
+ ("jea" "令囹塋寧嶺嶸影怜映暎楹榮永泳渶潁濚瀛瀯煐營獰玲瑛瑩瓔盈穎纓羚聆英詠迎鈴鍈零霙靈領")
+ ("j7" "乂倪例刈叡曳汭濊猊睿穢芮藝蘂禮裔詣譽豫醴銳隸霓預")
+ ("jv" "五伍俉傲午吾吳嗚塢墺奧娛寤悟惡懊敖旿晤梧汚澳烏熬獒筽蜈誤鰲鼇")
+ ("jvx" "屋沃獄玉鈺")
+ ("jvs" "溫瑥瘟穩縕蘊")
+ ("jvw" "兀")
+ ("jva" "壅擁瓮甕癰翁邕雍饔")
+ ("j/" "五伍俉傲午吾吳嗚塢墺奧娛寤悟惡懊敖旿晤梧汚澳烏熬獒筽蜈誤鰲鼇")
+ ("j/x" "屋沃獄玉鈺")
+ ("j/s" "溫瑥瘟穩縕蘊")
+ ("j/w" "兀")
+ ("j/a" "壅擁瓮甕癰翁邕雍饔")
+ ("j/f" "渦瓦窩窪臥蛙蝸訛")
+ ("j/fs" "婉完宛梡椀浣玩琓琬碗緩翫脘腕莞豌阮頑")
+ ("j/fw" "曰")
+ ("j/fa" "往旺枉汪王")
+ ("j/r" "倭娃歪矮")
+ ("j/d" "外嵬巍猥畏")
+ ("j4" "了僚僥凹堯夭妖姚寥寮尿嶢拗搖撓擾料曜樂橈燎燿瑤療窈窯繇繞耀腰蓼蟯要謠遙遼邀饒")
+ ("j4x" "慾欲浴縟褥辱")
+ ("j4a" "俑傭冗勇埇墉容庸慂榕涌湧溶熔瑢用甬聳茸蓉踊鎔鏞龍")
+ ("jb" "于佑偶優又友右宇寓尤愚憂旴牛玗瑀盂祐禑禹紆羽芋藕虞迂遇郵釪隅雨雩")
+ ("jbx" "勖彧旭昱栯煜稶郁頊")
+ ("jbs" "云暈橒殞澐熉耘芸蕓運隕雲韻")
+ ("jbw" "蔚鬱亐")
+ ("jba" "熊雄")
+ ("j9" "于佑偶優又友右宇寓尤愚憂旴牛玗瑀盂祐禑禹紆羽芋藕虞迂遇郵釪隅雨雩")
+ ("j9x" "勖彧旭昱栯煜稶郁頊")
+ ("j9s" "云暈橒殞澐熉耘芸蕓運隕雲韻")
+ ("j9w" "蔚鬱亐")
+ ("j9a" "熊雄")
+ ("j9ts" "元原員圓園垣媛嫄寃怨愿援沅洹湲源爰猿瑗苑袁轅遠阮院願鴛")
+ ("j9tw" "月越鉞")
+ ("j9d" "位偉僞危圍委威尉慰暐渭爲瑋緯胃萎葦蔿蝟衛褘謂違韋魏")
+ ("j5" "乳侑儒兪劉唯喩孺宥幼幽庾悠惟愈愉揄攸有杻柔柚柳楡楢油洧流游溜濡猶猷琉瑜由留癒硫紐維臾萸裕誘諛諭踰蹂遊逾遺酉釉鍮類")
+ ("j5x" "六堉戮毓肉育陸")
+ ("j5s" "倫允奫尹崙淪潤玧胤贇輪鈗閏")
+ ("j5w" "律慄栗率聿")
+ ("j5a" "戎瀜絨融隆")
+ ("jgs" "垠恩慇殷誾銀隱")
+ ("jgw" "乙")
+ ("jgz" "吟淫蔭陰音飮")
+ ("jg3" "揖泣邑")
+ ("jga" "凝應膺鷹")
+ ("j8" "依倚儀宜意懿擬椅毅疑矣義艤薏蟻衣誼議醫")
+ ("jd" "二以伊利吏夷姨履已弛彛怡易李梨泥爾珥理異痍痢移罹而耳肄苡荑裏裡貽貳邇里離飴餌")
+ ("jdx" "匿溺瀷益翊翌翼謚")
+ ("jds" "人仁刃印吝咽因姻寅引忍湮燐璘絪茵藺蚓認隣靭靷鱗麟")
+ ("jdw" "一佚佾壹日溢逸鎰馹")
+ ("jdz" "任壬妊姙恁林淋稔臨荏賃")
+ ("jd3" "入卄立笠粒")
+ ("jda" "仍剩孕芿")
+ ("lf" "仔刺咨姉姿子字孜恣慈滋炙煮玆瓷疵磁紫者自茨蔗藉諮資雌")
+ ("lfx" "作勺嚼斫昨灼炸爵綽芍酌雀鵲")
+ ("lfs" "孱棧殘潺盞")
+ ("lfz" "岑暫潛箴簪蠶")
+ ("lf3" "雜")
+ ("lfa" "丈仗匠場墻壯奬將帳庄張掌暲杖樟檣欌漿牆狀獐璋章粧腸臟臧莊葬蔣薔藏裝贓醬長障")
+ ("lr" "再哉在宰才材栽梓渽滓災縡裁財載齋齎")
+ ("lra" "爭箏諍錚")
+ ("lt" "佇低儲咀姐底抵杵楮樗沮渚狙猪疽箸紵苧菹著藷詛貯躇這邸雎齟")
+ ("ltx" "勣吊嫡寂摘敵滴狄炙的積笛籍績翟荻謫賊赤跡蹟迪迹適鏑")
+ ("lts" "佃佺傳全典前剪塡塼奠專展廛悛戰栓殿氈澱煎琠田甸畑癲筌箋箭篆纏詮輾轉鈿銓錢鐫電顚顫餞")
+ ("ltw" "切截折浙癤竊節絶")
+ ("ltz" "占岾店漸点粘霑鮎點")
+ ("lt3" "接摺蝶")
+ ("lta" "丁井亭停偵呈姃定幀庭廷征情挺政整旌晶晸柾楨檉正汀淀淨渟湞瀞炡玎珽町睛碇禎程穽精綎艇訂諪貞鄭酊釘鉦鋌錠霆靖靜頂鼎")
+ ("lc" "制劑啼堤帝弟悌提梯濟祭第臍薺製諸蹄醍除際霽題齊")
+ ("lv" "俎兆凋助嘲弔彫措操早晁曺曹朝條棗槽漕潮照燥爪璪眺祖祚租稠窕粗糟組繰肇藻蚤詔調趙躁造遭釣阻雕鳥")
+ ("lvx" "族簇足鏃")
+ ("lvs" "存尊")
+ ("lvw" "卒拙猝")
+ ("lva" "倧宗從悰慫棕淙琮種終綜縱腫踪踵鍾鐘")
+ ("l/" "俎兆凋助嘲弔彫措操早晁曺曹朝條棗槽漕潮照燥爪璪眺祖祚租稠窕粗糟組繰肇藻蚤詔調趙躁造遭釣阻雕鳥")
+ ("l/x" "族簇足鏃")
+ ("l/s" "存尊")
+ ("l/w" "卒拙猝")
+ ("l/a" "倧宗從悰慫棕淙琮種終綜縱腫踪踵鍾鐘")
+ ("l/f" "佐坐左座挫")
+ ("l/d" "罪")
+ ("lb" "主住侏做姝胄呪周嗾奏宙州廚晝朱柱株注洲湊澍炷珠疇籌紂紬綢舟蛛註誅走躊輳週酎酒鑄駐")
+ ("lbx" "竹粥")
+ ("lbs" "俊儁准埈寯峻晙樽浚準濬焌畯竣蠢逡遵雋駿")
+ ("lbw" "茁")
+ ("lba" "中仲衆重")
+ ("l9" "主住侏做姝胄呪周嗾奏宙州廚晝朱柱株注洲湊澍炷珠疇籌紂紬綢舟蛛註誅走躊輳週酎酒鑄駐")
+ ("l9x" "竹粥")
+ ("l9s" "俊儁准埈寯峻晙樽浚準濬焌畯竣蠢逡遵雋駿")
+ ("l9w" "茁")
+ ("l9a" "中仲衆重")
+ ("lgx" "卽")
+ ("lgw" "櫛")
+ ("lg3" "楫汁葺")
+ ("lga" "增憎曾拯烝甑症繒蒸證贈")
+ ("ld" "之只咫地址志持指摯支旨智枝枳止池沚漬知砥祉祗紙肢脂至芝芷蜘誌識贄趾遲")
+ ("ldx" "直稙稷織職")
+ ("lds" "唇嗔塵振搢晉晋桭榛殄津溱珍瑨璡畛疹盡眞瞋秦縉縝臻蔯袗診賑軫辰進鎭陣陳震")
+ ("ldw" "侄叱姪嫉帙桎瓆疾秩窒膣蛭質跌迭")
+ ("ldz" "斟朕")
+ ("ld3" "什執潗緝輯鏶集")
+ ("lda" "徵懲澄")
+ ("of" "且侘借叉嗟嵯差次此磋箚茶蹉車遮")
+ ("ofx" "捉搾着窄錯鑿齪")
+ ("ofs" "撰澯燦璨瓚竄簒纂粲纘讚贊鑽餐饌")
+ ("ofw" "刹察擦札紮")
+ ("ofz" "僭參塹慘慙懺斬站讒讖")
+ ("ofa" "倉倡創唱娼廠彰愴敞昌昶暢槍滄漲猖瘡窓脹艙菖蒼")
+ ("or" "債埰寀寨彩採砦綵菜蔡采釵")
+ ("orx" "冊柵策責")
+ ("ot" "凄妻悽處")
+ ("otx" "倜刺剔尺慽戚拓擲斥滌瘠脊蹠陟隻")
+ ("ots" "仟千喘天川擅泉淺玔穿舛薦賤踐遷釧闡阡韆")
+ ("otw" "凸哲喆徹撤澈綴輟轍鐵")
+ ("otz" "僉尖沾添甛瞻簽籤詹諂")
+ ("ot3" "堞妾帖捷牒疊睫諜貼輒")
+ ("ota" "廳晴淸聽菁請靑鯖")
+ ("oc" "切剃替涕滯締諦逮遞體")
+ ("ov" "初剿哨憔抄招梢椒楚樵炒焦硝礁礎秒稍肖艸苕草蕉貂超酢醋醮")
+ ("ovx" "促囑燭矗蜀觸")
+ ("ovs" "寸忖村邨")
+ ("ova" "叢塚寵悤憁摠總聰蔥銃")
+ ("o/" "初剿哨憔抄招梢椒楚樵炒焦硝礁礎秒稍肖艸苕草蕉貂超酢醋醮")
+ ("o/x" "促囑燭矗蜀觸")
+ ("o/s" "寸忖村邨")
+ ("o/a" "叢塚寵悤憁摠總聰蔥銃")
+ ("o/fw" "撮")
+ ("o/d" "催崔最")
+ ("ob" "墜抽推椎楸樞湫皺秋芻萩諏趨追鄒酋醜錐錘鎚雛騶鰍")
+ ("obx" "丑畜祝竺筑築縮蓄蹙蹴軸逐")
+ ("obs" "春椿瑃")
+ ("obw" "出朮黜")
+ ("oba" "充忠沖蟲衝衷")
+ ("o9" "墜抽推椎楸樞湫皺秋芻萩諏趨追鄒酋醜錐錘鎚雛騶鰍")
+ ("o9x" "丑畜祝竺筑築縮蓄蹙蹴軸逐")
+ ("o9s" "春椿瑃")
+ ("o9w" "出朮黜")
+ ("o9a" "充忠沖蟲衝衷")
+ ("o9c" "悴膵萃贅")
+ ("o9d" "取吹嘴娶就炊翠聚脆臭趣醉驟鷲")
+ ("ogx" "側仄厠惻測")
+ ("oga" "層")
+ ("od" "侈値嗤峙幟恥梔治淄熾痔痴癡稚穉緇緻置致蚩輜雉馳齒")
+ ("odx" "則勅飭")
+ ("ods" "親")
+ ("odw" "七柒漆")
+ ("odz" "侵寢枕沈浸琛砧針鍼")
+ ("od3" "蟄")
+ ("oda" "秤稱")
+ ("0/r" "快")
+ ("'f" "他咤唾墮妥惰打拖朶楕舵陀馱駝")
+ ("'fx" "倬卓啄坼度托拓擢晫柝濁濯琢琸託鐸")
+ ("'fs" "呑嘆坦彈憚歎灘炭綻誕")
+ ("'fw" "奪脫")
+ ("'fz" "探眈耽貪")
+ ("'f3" "塔搭榻")
+ ("'fa" "宕帑湯糖蕩")
+ ("'r" "兌台太怠態殆汰泰笞胎苔跆邰颱")
+ ("'rx" "宅擇澤")
+ ("'ra" "撑")
+ ("'t" "攄")
+ ("'v" "兎吐土討")
+ ("'va" "慟桶洞痛筒統通")
+ ("'/" "兎吐土討")
+ ("'/a" "慟桶洞痛筒統通")
+ ("'/d" "堆槌腿褪退頹")
+ ("'b" "偸套妬投透鬪")
+ ("'9" "偸套妬投透鬪")
+ ("'gx" "慝特")
+ ("'gz" "闖")
+ ("pf" "坡婆巴把播擺杷波派爬琶破罷芭跛頗")
+ ("pfs" "判坂板版瓣販辦鈑阪")
+ ("pfw" "八叭捌")
+ ("pr" "佩唄悖敗沛浿牌狽稗覇貝")
+ ("pra" "彭澎烹膨")
+ ("p6x" "愎")
+ ("pes" "便偏扁片篇編翩遍鞭騙")
+ ("pez" "貶")
+ ("pea" "坪平枰萍評")
+ ("p7" "吠嬖幣廢弊斃肺蔽閉陛")
+ ("pv" "佈包匍匏咆哺圃布怖抛抱捕暴泡浦疱砲胞脯苞葡蒲袍褒逋鋪飽鮑")
+ ("pvx" "幅暴曝瀑爆輻")
+ ("p/" "佈包匍匏咆哺圃布怖抛抱捕暴泡浦疱砲胞脯苞葡蒲袍褒逋鋪飽鮑")
+ ("p/x" "幅暴曝瀑爆輻")
+ ("p4" "俵剽彪慓杓標漂瓢票表豹飇飄驃")
+ ("pbz" "品稟")
+ ("pba" "楓諷豊風馮")
+ ("p9z" "品稟")
+ ("p9a" "楓諷豊風馮")
+ ("pd" "彼披疲皮被避陂")
+ ("pdw" "匹弼必泌珌畢疋筆苾馝")
+ ("pd3" "乏逼")
+ ("mf" "下何厦夏廈昰河瑕荷蝦賀遐霞鰕")
+ ("mfx" "壑學虐謔鶴")
+ ("mfs" "寒恨悍旱汗漢澣瀚罕翰閑閒限韓")
+ ("mfw" "割轄")
+ ("mfz" "函含咸啣喊檻涵緘艦銜陷鹹")
+ ("mf3" "合哈盒蛤閤闔陜")
+ ("mfa" "亢伉姮嫦巷恒抗杭桁沆港缸肛航行降項")
+ ("mr" "亥偕咳垓奚孩害懈楷海瀣蟹解該諧邂駭骸")
+ ("mrx" "劾核")
+ ("mra" "倖幸杏荇行")
+ ("m6a" "享向嚮珦鄕響餉饗香")
+ ("mt" "噓墟虛許")
+ ("mts" "憲櫶獻軒")
+ ("mtw" "歇")
+ ("mtz" "險驗")
+ ("mex" "奕爀赫革")
+ ("mes" "俔峴弦懸晛泫炫玄玹現眩睍絃絢縣舷衒見賢鉉顯")
+ ("mew" "孑穴血頁")
+ ("mez" "嫌")
+ ("me3" "俠協夾峽挾浹狹脅脇莢鋏頰")
+ ("mea" "亨兄刑型形泂滎瀅灐炯熒珩瑩荊螢衡逈邢鎣馨")
+ ("m7" "兮彗惠慧暳蕙蹊醯鞋")
+ ("mv" "乎互呼壕壺好岵弧戶扈昊晧毫浩淏湖滸澔濠濩灝狐琥瑚瓠皓祜糊縞胡芦葫蒿虎號蝴護豪鎬頀顥")
+ ("mvx" "惑或酷")
+ ("mvs" "婚昏混渾琿魂")
+ ("mvw" "忽惚笏")
+ ("mva" "哄弘汞泓洪烘紅虹訌鴻")
+ ("m/" "乎互呼壕壺好岵弧戶扈昊晧毫浩淏湖滸澔濠濩灝狐琥瑚瓠皓祜糊縞胡芦葫蒿虎號蝴護豪鎬頀顥")
+ ("m/x" "惑或酷")
+ ("m/s" "婚昏混渾琿魂")
+ ("m/w" "忽惚笏")
+ ("m/a" "哄弘汞泓洪烘紅虹訌鴻")
+ ("m/f" "化和嬅樺火畵禍禾花華話譁貨靴")
+ ("m/fx" "廓擴攫確碻穫")
+ ("m/fs" "丸喚奐宦幻患換歡晥桓渙煥環紈還驩鰥")
+ ("m/fw" "活滑猾豁闊")
+ ("m/fa" "凰幌徨恍惶愰慌晃晄榥況湟滉潢煌璜皇篁簧荒蝗遑隍黃")
+ ("m/d" "匯回廻徊恢悔懷晦會檜淮澮灰獪繪膾茴蛔誨賄")
+ ("m/dx" "劃獲")
+ ("m/da" "宖橫鐄")
+ ("m4" "哮嚆孝效斅曉梟涍淆爻肴酵驍")
+ ("mb" "侯候厚后吼喉嗅帿後朽煦珝逅")
+ ("mbs" "勛勳塤壎焄熏燻薰訓暈")
+ ("mba" "薨")
+ ("m9" "侯候厚后吼喉嗅帿後朽煦珝逅")
+ ("m9s" "勛勳塤壎焄熏燻薰訓暈")
+ ("m9a" "薨")
+ ("m9ts" "喧暄煊萱")
+ ("m9c" "卉喙毁")
+ ("m9d" "彙徽揮暉煇諱輝麾")
+ ("m5" "休携烋畦虧")
+ ("m5w" "恤譎鷸")
+ ("m5a" "兇凶匈洶胸")
+ ("mgx" "黑")
+ ("mgs" "昕欣炘痕")
+ ("mgw" "吃屹紇訖")
+ ("mgz" "欠欽歆")
+ ("mg3" "吸恰洽翕")
+ ("mga" "興")
+ ("m8" "僖凞喜噫囍姬嬉希憙憘戱晞曦熙熹熺犧禧稀羲")
+ ("mdw" "詰"))
+
+;;; hanja3.el ends here
diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el
new file mode 100644
index 00000000000..d90b362407b
--- /dev/null
+++ b/lisp/leim/quail/hebrew.el
@@ -0,0 +1,882 @@
+;; hebrew.el --- Quail package for inputting Hebrew characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Many input methods in this file provided
+;; by Yair Friedman <yair.f.lists@gmail.com>
+
+;; Keywords: multilingual, input method, Hebrew
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "hebrew" "Hebrew" "ע" nil "Hebrew SI-1452 input method.
+
+Based on SI-1452 keyboard layout.
+Only Hebrew-related characters are considered.
+ `q' is used to switch levels instead of Alt-Gr.
+ Maqaaf (־) is mapped to `/פ'.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?\;)
+ ("w" ?\')
+ ("e" ?ק) ; Qof
+ ("r" ?ר) ; Resh
+ ("t" ?א) ; Alef
+ ("y" ?ט) ; Tet
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?י) ; Yod
+ ("j" ?ח) ; Het
+ ("k" ?ל) ; Lamed
+ ("l" ?ך) ; Final Kaf
+ (";" ?ף) ; Final Pe
+ ("'" ?,)
+ ("z" ?ז) ; Zayin
+ ("x" ?ס) ; Samekh
+ ("c" ?ב) ; Bet
+ ("v" ?ה) ; He
+ ("b" ?נ) ; Nun
+ ("n" ?מ) ; Mem
+ ("m" ?צ) ; Tsadi
+ ("," ?ת) ; Tav
+ ("." ?ץ) ; Final Tsadi
+ ("/" ?.) ; Stop
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+ ("<" ?>) ; mirroring
+ (">" ?<) ; mirroring
+ ("q`" ?ְ) ; Sheva
+ ("q1" ?ֱ) ; Hataf Segol
+ ("q2" ?ֲ) ; Hataf Patah
+ ("q3" ?ֳ) ; Hataf Qamats
+ ("q4" ?ִ) ; Hiriq
+ ("q5" ?ֵ) ; Tsere
+ ("q6" ?ֶ) ; Segol (Point)
+ ("q7" ?ַ) ; Patah
+ ("q8" ?ָ) ; Qamats
+ ("q9" ?ׂ) ; Sin dot
+ ("q0" ?ׁ) ; Shin dot
+ ("q-" ?ֹ) ; Holam
+ ("q=" ?ּ) ; Dagesh or Mapiq
+ ("q\\" ?ֻ) ; Qubuts
+ ("qq" ?/)
+ ("qw" ?׳) ; Geresh (Punct.)
+ ("qi" ?װ) ; Yiddish Double Vav
+ ("qp" ?־) ; Maqaf
+ ("q[" ?ֿ) ; Rafe
+ ("q]" ?ֽ) ; Meteg
+ ("qa" ?₪) ; New Sheqel sign
+ ("qh" ?ײ) ; Yiddish Double Yod
+ ("qj" ?ױ) ; Yiddish Vav Yod
+ ("q\"" ?״) ; Gershayim (Punct.)
+ ("q," ?\u200E) ; LRM
+ ("q." ?\u200F) ; RLM
+)
+
+(quail-define-package
+ "hebrew-new" "Hebrew" "ע" nil "Hebrew SI-1452 new draft input method.
+
+Based on latest draft of SI-1452 keyboard layout.
+Only Hebrew-related characters are considered.
+ `\\=`' is used to switch levels instead of Alt-Gr.
+Geresh is mapped to `\\=`k'.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?/)
+ ("w" ?\')
+ ("e" ?ק) ; Qof
+ ("r" ?ר) ; Resh
+ ("t" ?א) ; Alef
+ ("y" ?ט) ; Tet
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?י) ; Yod
+ ("j" ?ח) ; Het
+ ("k" ?ל) ; Lamed
+ ("l" ?ך) ; Final Kaf
+ (";" ?ף) ; Final Pe
+ ("'" ?,)
+ ("z" ?ז) ; Zayin
+ ("x" ?ס) ; Samekh
+ ("c" ?ב) ; Bet
+ ("v" ?ה) ; He
+ ("b" ?נ) ; Nun
+ ("n" ?מ) ; Mem
+ ("m" ?צ) ; Tsadi
+ ("," ?ת) ; Tav
+ ("." ?ץ) ; Final Tsadi
+ ("/" ?.) ; Stop
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+ ("<" ?>) ; mirroring
+ (">" ?<) ; mirroring
+
+ ("``" ?\;)
+ ("`1" ?ֽ) ; Meteg
+;("`2" ??) ; Unassigned
+ ("`3" ?€) ; Euro Sign
+ ("`4" ?₪) ; New Sheqel sign
+ ("`5" ?°) ; Degree Sign
+ ("`6" ?֫) ; Ole
+;("`7" ??) ; Unassigned
+ ("`8" ?×) ; Multiplication Sign
+ ("`9" ?\u200E) ; LRM
+ ("`0" ?\u200F) ; RLM
+ ("`-" ?־) ; Maqaf
+ ("`=" ?–) ; En Dash
+ ("`q" ?ׂ) ; Sin dot
+ ("`w" ?ׁ) ; Shin dot
+ ("`e" ?ָ) ; Qamats
+ ("`r" ?ֳ) ; Hataf Qamats
+;("`t" ??) ; Unassigned
+ ("`y" ?װ) ; Yiddish Double Vav
+ ("`u" ?ֹ) ; Holam
+;("`i" ??) ; Unassigned
+;("`o" ??) ; Unassigned
+ ("`p" ?ַ) ; Patah
+ ("`[" ?ֲ) ; Hataf Patah
+ ("`]" ?ֿ) ; Rafe
+ ("`\\" ?ֻ) ; Qubuts
+ ("`a" ?ְ) ; Sheva
+ ("`s" ?ּ) ; Dagesh or Mapiq
+;("`d" ??) ; Unassigned
+;("`f" ??) ; Unassigned
+ ("`g" ?ױ) ; Yiddish Vav Yod
+ ("`h" ?ײ) ; Yiddish Double Yod
+ ("`j" ?ִ) ; Hiriq
+ ("`k" ?׳) ; Geresh (Punct.)
+ ("`l" ?“) ; Left Double Quotation Mark
+ ("`;" ?”) ; Right Double Quotation Mark
+ ("`'" ?״) ; Gershayim (Punct.)
+;("`z" ??) ; Unassigned
+ ("`x" ?ֶ) ; Segol (Point)
+ ("`c" ?ֱ) ; Hataf Segol
+;("`v" ??) ; Unassigned
+;("`b" ??) ; Unassigned
+;("`n" ??) ; Unassigned
+ ("`m" ?ֵ) ; Tsere
+;("`," ??) ; Unassigned
+;("`." ??) ; Unassigned
+ ("`/" ?÷) ; Division Sign
+
+ ("``" ?׃) ; Sof Pasuq
+ ("`!" ?֑) ; Etnahta
+ ("`@" ?֒) ; Segol (Accent)
+ ("`#" ?֓) ; Shalshelet
+ ("`$" ?֔) ; Zaqef Qatan
+ ("`%" ?֕) ; Zaqef Gadol
+ ("`^" ?֖) ; Tipeha
+ ("`&" ?֗) ; Revia
+ ("`*" ?֘) ; Zarqa
+ ("`(" ?֙) ; Pashta
+ ("`)" ?֚) ; Yetiv
+ ("`_" ?֛) ; Tevir
+ ("`+" ?֜) ; Geresh (Accent)
+ ("`Q" ?֝) ; Geresh Muqdam
+ ("`W" ?֞) ; Gershayim (Accent)
+ ("`E" ?ׇ) ; Qamats Qatan
+ ("`R" ?֟) ; Qarney Para
+ ("`T" ?֠) ; Telisha Gedola
+ ("`Y" ?֡) ; Pazer
+ ("`U" ?ֺ) ; Holam Haser for Vav
+ ("`I" ?֢) ; Atnah Hafukh
+ ("`O" ?֣) ; Munah
+;("`P" ??) ; Reserved
+ ("`{" ?֤) ; Mahapakh
+ ("`}" ?֥) ; Merkha
+ ("`|" ?֦) ; Merkha Kefula
+;("`A" ??) ; Reserved
+;("`S" ??) ; Reserved
+ ("`D" ?֧) ; Darga
+ ("`F" ?֨) ; Qadma
+ ("`G" ?֩) ; Telisha Qetana
+ ("`H" ?֪) ; Yerah Ben Yomo
+ ("`J" ?\u200D) ; ZWJ
+ ("`K" ?֬) ; Iluy
+ ("`L" ?“) ; Left Double Quotation Mark (2nd)
+ ("`:" ?„) ; Double Low-9 Quotation Mark
+ ("`\"" ?֭) ; Dehi
+ ("`Z" ?֮) ; Zinor
+ ("`X" ?֯) ; Masora Circle
+ ("`C" ?\u034F) ; CGJ
+ ("`V" ?׀) ; Paseq
+ ("`B" ?׆) ; Nun Hafukha
+ ("`N" ?\u200C) ; ZWNJ
+;("`M" ??) ; Unassigned
+;("`<" ??) ; Unassigned
+ ("`>" ?ׅ) ; Lower Dot
+ ("`?" ?ׄ) ; Upper Dot
+)
+
+(quail-define-package
+ "hebrew-lyx" "Hebrew" "לִ" nil "Hebrew LyX input method.
+
+Based on LyX keyboard layout.
+Additional mappings for Rafe and Yiddish ligatures.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?\;)
+ ("_" ?־) ; Maqaf
+ ("q`" ?ְ) ; Sheva
+ ("w" ?\')
+ ("e" ?ק) ; Qof
+ ("r" ?ר) ; Resh
+ ("t" ?א) ; Alef
+ ("y" ?ט) ; Tet
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?י) ; Yod
+ ("j" ?ח) ; Het
+ ("k" ?ל) ; Lamed
+ ("l" ?ך) ; Final Kaf
+ (";" ?ף) ; Final Pe
+ ("'" ?,)
+ ("z" ?ז) ; Zayin
+ ("x" ?ס) ; Samekh
+ ("c" ?ב) ; Bet
+ ("v" ?ה) ; He
+ ("b" ?נ) ; Nun
+ ("n" ?מ) ; Mem
+ ("m" ?צ) ; Tsadi
+ ("," ?ת) ; Tav
+ ("." ?ץ) ; Final Tsadi
+ ("/" ?.) ; Stop
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("W" ?׳) ; Geresh (Punct.)
+ ("E" ?ָ) ; Qamats
+ ("R" ?ֿ) ; Rafe
+ ("T" ?\u200E) ; LRM
+ ("Y" ?\u200F) ; RLM
+ ("U" ?ֹ) ; Holam
+ ("I" ?ײ) ; Yiddish Double Yod
+ ("O" ?װ) ; Yiddish Double Vav
+ ("P" ?ַ) ; Patah
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+ ("A" ?ְ) ; Sheva
+ ("S" ?ּ) ; Dagesh or Mapiq
+ ("F" ?״) ; Gershayim (Punct.)
+ ("G" ?ׂ) ; Sin dot
+ ("H" ?ׁ) ; Shin dot
+ ("J" ?ִ) ; Hiriq
+ ("K" ?₪) ; New Sheqel sign
+ ("L" ?ױ) ; Yiddish Vav Yod
+ ("X" ?ֶ) ; Segol (Point)
+ ("C" ?ֻ) ; Qubuts
+ ("V" ?ֱ) ; Hataf Segol
+ ("B" ?ֲ) ; Hataf Patah
+ ("N" ?ֳ) ; Hataf Qamats
+ ("M" ?ֵ) ; Tsere
+ ("<" ?>) ; mirroring
+ (">" ?<) ; mirroring
+)
+
+
+(quail-define-package
+ "hebrew-full" "Hebrew" "עִ֫" nil "Hebrew Full method.
+
+Provides access to all Hebrew characters suitable to Modern Hebrew.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?\;)
+ ("-" ?־) ; Maqaf
+ ("w" ?')
+ ("e" ?ק) ; Qof
+ ("r" ?ר) ; Resh
+ ("t" ?א) ; Alef
+ ("y" ?ט) ; Tet
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?י) ; Yod
+ ("j" ?ח) ; Het
+ ("k" ?ל) ; Lamed
+ ("l" ?ך) ; Final Kaf
+ (";" ?ף) ; Final Pe
+ ("'" ?,)
+ ("z" ?ז) ; Zayin
+ ("x" ?ס) ; Samekh
+ ("c" ?ב) ; Bet
+ ("v" ?ה) ; He
+ ("b" ?נ) ; Nun
+ ("n" ?מ) ; Mem
+ ("m" ?צ) ; Tsadi
+ ("," ?ת) ; Tav
+ ("." ?ץ) ; Final Tsadi
+ ("/" ?.)
+
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("Q" ?/)
+ ("W" ?׳) ; Geresh (Punct.)
+ ("E" ?₪) ; New Sheqel Sign
+ ("R" ?ֿ) ; Rafe
+ ("T" ?ֱ) ; Hataf Segol
+ ("Y" ?ױ) ; Yiddish Vav Yod
+ ("U" ?װ) ; Yiddish Double Vav
+ ("I" ?ֲ) ; Hataf Patah
+ ("O" ?ֳ) ; Hataf Qamats
+ ("P" ?״) ; Gershayim (Punct.)
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+ ("A" ?ְ) ; Sheva
+ ("S" ?ּ) ; Dagesh or Mapiq
+ ("D" ?ֻ) ; Qubuts
+ ("F" ?ֹ) ; Holam
+ ("G" ?ֶ) ; Segol (Point)
+ ("H" ?ֵ) ; Tsere
+ ("J" ?ִ) ; Hiriq
+ ("K" ?ַ) ; Patah
+ ("L" ?ָ) ; Qamats
+ ("Z" ?ׂ) ; Sin Dot
+ ("X" ?ׁ) ; Shin Dot
+ ("C" ?֫) ; Ole
+ ("V" ?ײ) ; Yiddish Double Yod
+ ("B" ?׃) ; Sof Pasuq
+ ("N" ?\u200E) ; LRM
+ ("M" ?\u200F) ; RLM
+ ("<" ?>) ; mirroring
+ (">" ?<) ; mirroring
+
+ ("q`" ?\u202D) ; LRO
+ ("q1" ?\u202E) ; RLO
+ ("q2" ?\u202A) ; LRE
+ ("q3" ?\u202B) ; RLE
+ ("q4" ?\u202C) ; PDF
+ ("q5" ?\u034F) ; CGJ
+ ("q6" ?֬) ; Iluy
+ ("q8" ?֭) ; Dehi
+ ("q9" ?ׇ) ; Qamats Qatan
+ ("q0" ?֝) ; Geresh Muqdam
+ ("q-" ?-) ; Minus
+ ("q=" ?֮) ; Zinor
+ ("q|" ?׀) ; Paseq
+ ("qw" ?֯) ; Masora Circle
+ ("qe" ?ׄ) ; Upper Dot
+ ("qr" ?ׅ) ; Lower Dot
+ ("qy" ?֟) ; Qarney Para
+ ("qu" ?֓) ; Shalshelet
+ ("qi" ?֞) ; Gershayim (Accent)
+ ("qo" ?֜) ; Geresh (Accent)
+ ("qp" ?֨) ; Qadma
+ ("q[" ?׆) ; Nun Hafukha
+ ("qa" ?ֺ) ; Holam Haser for Vav
+ ("qs" ?֩) ; Telisha Qetana
+ ("qd" ?֠) ; Telisha Gedola
+ ("qf" ?֡) ; Pazer
+ ("qg" ?֕) ; Zaqef Gadol
+ ("qh" ?֔) ; Zaqef Qatan
+ ("qj" ?֙) ; Pashta
+ ("qk" ?֤) ; Mahapakh
+ ("ql" ?֗) ; Revia
+ ("q;" ?֒) ; Segol (Accent)
+ ("q'" ?֘) ; Zarqa
+ ("qz" ?֪) ; Yerah Ben Yomo
+ ("qx" ?֦) ; Merkha Kefula
+ ("qc" ?֚) ; Yetiv
+ ("qv" ?֛) ; Tevir
+ ("qb" ?֧) ; Darga
+ ("qn" ?֑) ; Etnahta
+ ("qm" ?֣) ; Munah
+ ("q," ?֖) ; Tipeha
+ ("q." ?֥) ; Merkha
+ ("q/" ?ֽ) ; Meteg
+)
+
+
+(quail-define-package
+ "hebrew-biblical-tiro" "Hebrew" "תִרֹ" nil
+"Biblical Hebrew Tiro input method.
+
+Based on Society of Biblical Literature's Tiro keyboard layout.
+Not suitable for modern Hebrew input.
+ `q' is used to switch levels instead of Alt-Gr.
+ Combining dot above (Called Masora dot) (̇) is mapped to `q1'.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?׃) ; Sof Pasuq
+ ("-" ?־) ; Maqaf
+ ("=" ?◦) ; White Bullet
+ ("w" ?׳) ; Geresh (Punct.)
+ ("e" ?ק) ; Qof
+ ("r" ?ר) ; Resh
+ ("t" ?א) ; Alef
+ ("y" ?ט) ; Tet
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("\\" ?׀) ; Paseq
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?י) ; Yod
+ ("j" ?ח) ; Het
+ ("k" ?ל) ; Lamed
+ ("l" ?ך) ; Final Kaf
+ (";" ?ף) ; Final Pe
+ ("'" ?֚) ; Yetiv
+ ("z" ?ז) ; Zayin
+ ("x" ?ס) ; Samekh
+ ("c" ?ב) ; Bet
+ ("v" ?ה) ; He
+ ("b" ?נ) ; Nun
+ ("n" ?מ) ; Mem
+ ("m" ?צ) ; Tsadi
+ ("," ?ת) ; Tav
+ ("." ?ץ) ; Final Tsadi
+ ("/" ?֭) ; Dehi
+ ("~" ?֮) ; Zinor
+ ("!" ?֩) ; Telisha Qetana
+ ("@" ?֙) ; Pashta
+ ("#" ?֒) ; Segol (Accent)
+ ("$" ?֯) ; Masora circle
+ ("%" ?ֺ) ; Holam Haser for Vav
+ ("^" ?ֹ) ; Holam
+ ("&" ?ֿ) ; Rafe
+ ("*" ?ׂ) ; Sin dot
+ ("(" ?ׁ) ; Shin dot
+ (")" ?֝) ; Geresh Muqdam
+ ("_" ?֠) ; Telisha Gedola
+ ("+" ?ּ) ; Dagesh or Mapiq
+ ("Q" ?ׄ) ; Upper dot
+ ("W" ?֬) ; Iluy
+ ("E" ?֫) ; Ole
+ ("R" ?֟) ; Qarney Para
+ ("T" ?֓) ; Shalshelet
+ ("Y" ?֞) ; Gershayim (Accent)
+ ("U" ?֜) ; Geresh (Accent)
+ ("I" ?֡) ; Pazer
+ ("O" ?֕) ; Zaqef Gadol
+ ("P" ?֔) ; Zaqef Qatan
+ ("{" ?֗) ; Revia
+ ("}" ?֘) ; Zarqa
+ ("|" ?֨) ; Qadma
+ ("A" ?ֽ) ; Meteg
+ ("S" ?ְ) ; Sheva
+ ("D" ?ֻ) ; Qubuts
+ ("F" ?ִ) ; Hiriq
+ ("G" ?ֱ) ; Hataf Segol
+ ("H" ?ֶ) ; Segol (Point)
+ ("J" ?ֵ) ; Tsere
+ ("K" ?ֳ) ; Hataf Qamats
+ ("L" ?ָ) ; Qamats
+ (":" ?ֲ) ; Hataf Patah
+ ("\"" ?ַ) ; Patah
+ ("Z" ?ׅ) ; Lower dot
+ ("X" ?֤) ; Mahapakh
+ ("C" ?֪) ; Yerah Ben Yomo
+ ("V" ?֦) ; Merkha Kefula
+ ("B" ?֥) ; Merkha
+ ("N" ?֧) ; Darga
+ ("M" ?֛) ; Tevir
+ ("<" ?֑) ; Etnahta
+ (">" ?֖) ; Tipeha
+ ("?" ?֣) ; Munah
+
+ ("q`" ?\;)
+ ("q1" ?\u0307) ; Combining dot above
+ ("q2" ?\u0336) ; Combining long stroke overlay
+ ("q3" ?\u030A) ; Combining ring above
+ ("q4" ?₪) ; New Sheqel Sign
+ ("q5" ?\u200D) ; ZWJ
+ ("q6" ?\u200C) ; ZWNJ
+ ("q7" ?\u034F) ; CGJ
+ ("q8" ?\u200E) ; LRM
+ ("q9" ?\u200F) ; RLM
+ ("q0" ?◌) ; Dotted Circle
+ ("q-" ?-) ; Minus
+ ("q=" ?•) ; Bullet
+ ("qq" ?\u0308) ; Combining Diaeresis
+ ("qw" ?״) ; Gershayim (Punct.)
+ ("qe" ?€) ; Euro Sign
+ ("qu" ?װ) ; Yiddish Double Vav
+ ("q\\" ?\\)
+ ("qh" ?ײ) ; Yiddish Double Yod
+ ("qj" ?ױ) ; Yiddish Vav Yod
+ ("ql" ?ׇ) ; Qamats Qatan
+ ("q'" ?,)
+ ("qc" ?֢) ; Atnah Hafukh
+ ("qb" ?׆) ; Nun Hafukha
+ ("q/" ?.)
+
+ ("q~" ?~)
+ ("q!" ?!)
+ ("q@" ?@)
+ ("q#" ?#)
+ ("q$" ?$)
+ ("q%" ?%)
+ ("q^" ?^)
+ ("q&" ?&)
+ ("q*" ?*)
+ ("q(" ?\)) ; mirroring
+ ("q)" ?\() ; mirroring
+ ("q_" ?_)
+ ("q+" ?+)
+ ("qQ" ?/)
+ ("qW" ?')
+ ("q{" ?}) ; mirroring
+ ("q}" ?{) ; mirroring
+ ("q|" ?|)
+ ("q:" ?:)
+ ("q\"" ?\")
+ ("q<" ?>)
+ ("q>" ?<)
+ ("q?" ??)
+)
+
+(quail-define-package
+ "hebrew-biblical-sil" "Hebrew" "סִל" nil
+"Biblical Hebrew SIL input method.
+
+Based on Society of Biblical Literature's SIL keyboard layout.
+Phonetic and not suitable for modern Hebrew input.
+ `\\=`' is used to switch levels instead of Alt-Gr.
+ Euro Sign (€) is mapped to `Z'.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("-" ?־) ; Maqaf
+ ("=" ?ּ) ; Dagesh or Mapiq
+ ("q" ?ק) ; Qof
+ ("w" ?ו) ; Vav
+ ("e" ?ֶ) ; Segol (Point)
+ ("r" ?ר) ; Resh
+ ("t" ?ת) ; Tav
+ ("y" ?י) ; Yod
+ ("u" ?ֻ) ; Qubuts
+ ("i" ?ִ) ; Hiriq
+ ("o" ?ֹ) ; Holam
+ ("p" ?פ) ; Pe
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("\\" ?׀) ; Paseq
+ ("a" ?ַ) ; Patah
+ ("s" ?ס) ; Samekh
+ ("d" ?ד) ; Dalet
+ ("f" [ "שׂ" ]) ; Shin + Sin dot
+ ("g" ?ג) ; Gimel
+ ("h" ?ה) ; He
+ ("j" [ "שׁ" ]) ; Shin + Shin dot
+ ("k" ?כ) ; Kaf
+ ("l" ?ל) ; Lamed
+ (";" ?ְ) ; Sheva
+ ("'" ?’) ; Right Single Quotation Mark
+ ("z" ?ז) ; Zayin
+ ("x" ?ח) ; Het
+ ("c" ?צ) ; Tsadi
+ ("v" ?ט) ; Tet
+ ("b" ?ב) ; Bet
+ ("n" ?נ) ; Nun
+ ("m" ?מ) ; Mem
+
+ ("~" ?₪) ; New Sheqel Sign
+ ("@" ?֘) ; Zarqa
+ ("#" ?֨) ; Qadma
+ ("$" ?֜) ; Geresh (Accent)
+ ("%" ?֞) ; Gershayim (Accent)
+ ("&" ?֬) ; Iluy
+ ("*" ?֝) ; Geresh Muqdam
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("_" ?–) ; Em Dash
+ ("Q" ?֗) ; Revia
+ ("E" ?ֵ) ; Tsere
+ ("Y" ?֟) ; Qarney Para
+ ("O" ?ֺ) ; Holam Haser for Vav
+ ("P" ?ף) ; Final Pe
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+
+ ("A" ?ָ) ; Qamats
+ ("S" ?ש) ; Shin
+ ("K" ?ך) ; Final Kaf
+ (":" ?״) ; Gershayim (Punct.)
+ ("\"" ?”) ; Right Double Quotation Mark
+ ("Z" ?€) ; Euro Sign
+ ("C" ?ץ) ; Final Tsadi
+ ("N" ?ן) ; Final Nun
+ ("M" ?ם) ; Final Mem
+ ("<" ?ע) ; Ayin
+ (">" ?א) ; Alef
+
+ ("``" ?$)
+ ("`1" ?ֽ) ; Meteg
+ ("`2" ?֢) ; Atnah Hafukh
+ ("`3" ?֖) ; Tipeha
+ ("`4" ?֥) ; Merkha
+ ("`5" ?֦) ; Merkha Kefula
+ ("`6" ?֭) ; Dehi
+ ("`7" ?֣) ; Munah
+ ("`8" ?֛) ; Tevir
+ ("`9" ?֧) ; Darga
+ ("`0" ?֪) ; Yerah Ben Yomo
+ ("`-" ?—) ; Em Dash
+ ("`=" ?֑) ; Etnahta
+ ("`]" ?֚) ; Accent Yetiv
+ ("`\\" ?֤) ; Mahapakh
+ ("`a" ?ׇ) ; Qamats Qatan
+ ("`g" ? ◦) ; White Bullet
+ ("`h" ?\u0336) ; Combining Long Stroke Overlay
+ ("`;" ?\;)
+ ("`'" ?\u0323); Combining Dot Below (Lower Point??)
+ ("`m" ?\u200C) ; ZWNJ
+ ("`," ?») ; mirroring
+ ("`." ?«) ; mirroring
+ ("`/" ?׳) ; Geresh (Punct.)
+
+ ("`!" ?֗) ; Revia
+ ("`@" ?֮) ; Zinor
+ ("`#" ?֙) ; Pashta
+ ("`$" ?֠) ; Telisha Gedola
+ ("`%" ?֩) ; Telisha Qetana
+ ("`&" ?֡) ; Pazer
+ ("`*" ?֕) ; Zaqef Gadol
+ ("`(" ?֓) ; Shalshelet
+ ("`)" ?֯) ; Masora Circle
+ ("`_" ?ֿ) ; Rafe
+ ("`+" ?◌) ; Dotted Circle
+ ("`E" ?ֱ) ; Hataf Segol
+ ("`O" ?ֳ) ; Hataf Qamats
+ ("`P" ?\u034F) ; CGJ
+ ("`{" ?֔) ; Zaqef Qatan
+ ("`}" ?֒) ; Segol (Accent)
+ ("`|" ?֫) ; Ole
+ ("`A" ?ֲ) ; Hataf Patah
+ ("`G" ?•) ; Bullet
+ ("`H" ?\u030A) ; Combining ring above
+ ("`:" ?׃) ; Sof Pasuq
+ ("`\"" ?ׄ) ; Upper Dot
+ ("`M" ?\u200D) ; ZWJ
+ ("`<" ?\u0307) ; Combining dot above
+ ("`>" ?\u0308) ; Combining Diaeresis
+)
+
+
+(quail-define-package
+ "yiddish-royal" "Hebrew" "ײר" nil "Yiddish Royal input method.
+
+Based on Royal Yiddish typewriter.
+Better for yiddish than Hebrew methods.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?~)
+ ("q" ?ק) ; Qof
+ ("w" [ "אָ" ]) ; Qamats Alef (Komets Alef)
+ ("e" ?ר) ; Resh
+ ("r" ?א) ; Alef (Shtumer Alef)
+ ("t" ?ט) ; Tet
+ ("y" ?װ) ; Yiddish Double Vav (Tsvey Vovn)
+ ("u" ?ו) ; Vav
+ ("i" ?ן) ; Final Nun
+ ("o" ?ם) ; Final Mem
+ ("p" [ "פֿ" ]) ; Rafe Pe (Fey)
+ ("[" [ "פּ" ]) ; Dagesh Pe (Pey)
+ ("]" ?,)
+ ("a" ?ש) ; Shin
+ ("s" ?ד) ; Dalet
+ ("d" ?ג) ; Gimel
+ ("f" ?כ) ; Kaf
+ ("g" ?ע) ; Ayin
+ ("h" ?ײ) ; Yiddish Double Yod (Tsvey Yudn)
+ ("j" ?י) ; Yod
+ ("k" ?ח) ; Het
+ ("l" ?ל) ; Lamed
+ (";" ?ך) ; Final Kaf
+ ("'" ?ף) ; Final Pe
+ ("z" ?.)
+ ("x" ?ז) ; Zayin
+ ("c" ?ס) ; Samekh
+ ("v" ?ב) ; Bet
+ ("b" ?ה) ; He
+ ("n" ?נ) ; Nun
+ ("m" ?מ) ; Mem
+ ("," ?צ) ; Tsadi
+ ("." ?ת) ; Tav
+ ("/" ?ץ) ; Final Tsadi
+
+ ("~" ?@)
+ ("!" ?”) ; Right Double Quotation Mark
+ ("@" ?„) ; Double Low-9 Quotation Mark
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("Q" ?“) ; Left Double Quotation Mark
+ ("W" ?”) ; Right Double Quotation Mark
+ ("E" ?ײ) ; Yiddish Double Yod (x2)
+ ("R" [ "אַ" ]) ; Patah Alef (Pasekh Alef)
+; ("T" "")
+ ("Y" ?ױ) ; Ligature Yiddish Vav Yod (vov yud)
+ ("U" [ "וּ" ]) ; Melupm vov
+ ("I" ?/)
+ ("O" ?\\)
+ ("P" ?פ) ; Pe
+ ("{" ??)
+ ("}" ?!)
+ ("A" [ "שׂ" ]) ; Shin + Sin dot
+ ("S" [ "שׂ" ]) ; Shin + Sin dot
+; ("D" "")
+ ("F" [ "כּ" ]) ; Dagesh Kaf (Kof)
+; ("G" "")
+ ("H" [ "ײַ" ]) ; Yiddish Double Yod + Patah (Pasekh Tsvey Yudn)
+ ("J" [ "יִ" ]) ; Khirik Yud
+ ("K" ?}) ; mirroring
+ ("L" ?{) ; mirroring
+ ("\"" ?\;)
+ ("Z" ??)
+ ("X" ?|)
+ ("C" [ "בּ" ]) ; Dagesh Bet (Beys)
+ ("V" [ "בֿ" ]) ; Rafe Bet (Veys)
+ ("B" ?\]) ; mirroring
+ ("N" ?\[) ; mirroring
+ ("M" ?>) ; mirroring
+ ("<" ?<) ; mirroring
+ (">" [ "תּ" ]) ; Dagesh Tav (Tof)
+ ("?" ?\')
+)
+
+
+(quail-define-package
+ "yiddish-keyman" "Hebrew" "ײק" nil "Yiddish Keyman input method.
+
+Based on Keyman keyboard layout.
+Better for yiddish than Hebrew methods..
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("`" ?\;)
+ ("q" ?„) ; Double Low-9 Quotation Mark
+ ("w" ?ש) ; Shin
+ ("e" ?ע) ; Ayin
+ ("r" ?ר) ; Resh
+ ("t" ?ט) ; Tet
+ ("y" ?י) ; Yod
+ ("u" ?ו) ; Vav
+ ("i" ?י) ; Yod (x2)
+ ("o" [ "אָ" ]) ; Qamats Alef (Komets Alef)
+ ("p" [ "פּ" ]) ; Dagesh Pe (Pey)
+ ("[" ?\]) ; mirroring
+ ("]" ?\[) ; mirroring
+ ("a" [ "אַ" ]) ; Patah Alef (Pasekh Alef)
+ ("s" ?ס) ; Samekh
+ ("d" ?ד) ; Dalet
+ ("f" [ "פֿ" ]) ; Rafe Pe (Fey)
+ ("g" ?ג) ; Gimel
+ ("h" ?ה) ; He
+ ("j" ?ײ) ; Yiddish Double Yod (Tsvey Yudn)
+ ("k" ?ק) ; Qof
+ ("l" ?ל) ; Lamed
+ ("z" ?ז) ; Zayin
+ ("x" ?כ) ; Kaf
+ ("c" ?צ) ; Tsadi
+ ("v" ?װ) ; Yiddish Double Vav (Tsvey Vovn)
+ ("b" ?ב) ; Bet
+ ("n" ?נ) ; Nun
+ ("m" ?מ) ; Mem
+
+ ("(" ?\)) ; mirroring
+ (")" ?\() ; mirroring
+ ("Q" ?”) ; Right Double Quotation Mark
+ ("W" [ "שׂ" ]) ; Shin + Sin dot
+ ("E" ?ײ) ; Yiddish Double Yod (x2)
+; ("R" "") ;
+ ("T" [ "תּ" ]) ; Dagesh Tav (Tof)
+ ("Y" [ "ײַ" ]) ; Yiddish Double Yod + Patah (Pasekh Tsvey Yudn)
+ ("U" [ "וּ" ]) ; Melupm vov
+ ("I" [ "יִ" ]) ; Khirik Yud
+ ("O" ?ױ) ; Ligature Yiddish Vav Yod (vov yud)
+; ("P" "")
+ ("{" ?}) ; mirroring
+ ("}" ?{) ; mirroring
+ ("A" ?א) ; Alef (Shtumer Alef)
+ ("S" ?ת) ; Tav
+ ("F" ?ף) ; Final Pe
+ ("G" ?׳) ; Geresh (Punct.)
+ ("H" ?ח) ; Het
+ ("J" ?ײ) ; Yiddish Double Yod (x2)
+ ("K" [ "כּ" ]) ; Dagesh Kaf (Kof)
+; ("L" "")
+; ("Z" "")
+ ("X" ?ך) ; Final Kaf
+ ("C" ?ץ) ; Final Tsadi
+ ("V" [ "בֿ" ]) ; Rafe Bet (Veys) ) ; Bet
+; ("B" "")
+ ("N" ?ן) ; Final Nun
+ ("M" ?ם) ; Final Mem
+ ("<" ?>) ; mirroring
+ (">" ?<) ; mirroring
+)
+
+;;; hebrew.el ends here
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
new file mode 100644
index 00000000000..855ccc989fb
--- /dev/null
+++ b/lisp/leim/quail/indian.el
@@ -0,0 +1,473 @@
+;;; indian.el --- Quail packages for inputting Indian
+
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
+
+;; Author: KAWABATA, Taichi <kawabata@m17n.org>
+
+;; Keywords: multilingual, input method, Indian, Devanagari
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; History:
+
+;; 2000.12.12
+;; Totally re-written from devanagari.el to handle multiple Indian Scripts.
+
+;;; Code:
+
+(require 'quail)
+(require 'ind-util)
+
+;;;
+;;; Input by transliteration
+;;;
+
+(defun quail-define-indian-trans-package (hashtbls pkgname
+ lang title doc)
+ (funcall 'quail-define-package pkgname lang title t doc
+ nil nil nil nil nil nil t nil)
+ (maphash
+ (lambda (key val)
+ (quail-defrule key (if (= (length val) 1)
+ (string-to-char val)
+ (vector val))))
+ (cdr hashtbls)))
+
+;; This needs to be seen by quail-update-leim-list-file, but cannot be
+;; commented out because quail-update-leim-list-file ignores
+;; commented-out lines.
+(if nil
+ (quail-define-package "devanagari-itrans" "Devanagari" "DevIT" t "Devanagari ITRANS"))
+(quail-define-indian-trans-package
+ indian-dev-itrans-v5-hash "devanagari-itrans" "Devanagari" "DevIT"
+ "Devanagari transliteration by ITRANS method.")
+(quail-defrule "..." ?॥)
+(quail-defrule "\\'" ?॑)
+(quail-defrule "\\_" ?॒)
+(quail-defrule "\\__" ?_)
+(quail-defrule "\\''" ?')
+
+(if nil
+ (quail-define-package "devanagari-kyoto-harvard" "Devanagari" "DevKH" t "Devanagari Kyoto-Harvard"))
+(quail-define-indian-trans-package
+ indian-dev-kyoto-harvard-hash
+ "devanagari-kyoto-harvard" "Devanagari" "DevKH"
+ "Devanagari transliteration by Kyoto-Harvard method.")
+
+(if nil
+ (quail-define-package "devanagari-aiba" "Devanagari" "DevAB" t "Devanagari Aiba"))
+(quail-define-indian-trans-package
+ indian-dev-aiba-hash "devanagari-aiba" "Devanagari" "DevAB"
+ "Devanagari transliteration by Aiba-method.")
+
+(if nil
+ (quail-define-package "punjabi-itrans" "Punjabi" "PnjIT" t "Punjabi ITRANS"))
+(quail-define-indian-trans-package
+ indian-pnj-itrans-v5-hash "punjabi-itrans" "Punjabi" "PnjIT"
+ "Punjabi transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "gujarati-itrans" "Gujarati" "GjrIT" t "Gujarati ITRANS"))
+(quail-define-indian-trans-package
+ indian-gjr-itrans-v5-hash "gujarati-itrans" "Gujarati" "GjrIT"
+ "Gujarati transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "oriya-itrans" "Oriya" "OriIT" t "Oriya ITRANS"))
+(quail-define-indian-trans-package
+ indian-ori-itrans-v5-hash "oriya-itrans" "Oriya" "OriIT"
+ "Oriya transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "bengali-itrans" "Bengali" "BngIT" t "Bengali ITRANS"))
+(quail-define-indian-trans-package
+ indian-bng-itrans-v5-hash "bengali-itrans" "Bengali" "BngIT"
+ "Bengali transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "assamese-itrans" "Assamese" "AsmIT" t "Assamese ITRANS"))
+(quail-define-indian-trans-package
+ indian-asm-itrans-v5-hash "assamese-itrans" "Assamese" "AsmIT"
+ "Assamese transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "telugu-itrans" "Telugu" "TlgIT" t "Telugu ITRANS"))
+(quail-define-indian-trans-package
+ indian-tlg-itrans-v5-hash "telugu-itrans" "Telugu" "TlgIT"
+ "Telugu transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "kannada-itrans" "Kannada" "KndIT" t "Kannada ITRANS"))
+(quail-define-indian-trans-package
+ indian-knd-itrans-v5-hash "kannada-itrans" "Kannada" "KndIT"
+ "Kannada transliteration by ITRANS method.")
+
+(if nil
+ (quail-define-package "malayalam-itrans" "Malayalam" "MlmIT" t "Malayalam ITRANS"))
+(quail-define-indian-trans-package
+ indian-mlm-itrans-v5-hash "malayalam-itrans" "Malayalam" "MlmIT"
+ "Malayalam transliteration by ITRANS method.")
+
+(defvar quail-tamil-itrans-syllable-table
+ (let ((vowels
+ '(("அ" nil "a")
+ ("ஆ" "ா" "A")
+ ("இ" "ி" "i")
+ ("ஈ" "ீ" "I")
+ ("உ" "ு" "u")
+ ("ஊ" "ூ" "U")
+ ("எ" "ெ" "e")
+ ("ஏ" "ே" "E")
+ ("ஐ" "ை" "ai")
+ ("ஒ" "ொ" "o")
+ ("ஓ" "ோ" "O")
+ ("ஔ" "ௌ" "au")))
+ (consonants
+ '(("க" "k") ; U+0B95
+ ("ங" "N^") ; U+0B99
+ ("ச" "ch") ; U+0B9A
+ ("ஞ" "JN") ; U+0B9E
+ ("ட" "T") ; U+0B9F
+ ("ண" "N") ; U+0BA3
+ ("த" "t") ; U+0BA4
+ ("ந" "n") ; U+0BA8
+ ("ப" "p") ; U+0BAA
+ ("ம" "m") ; U+0BAE
+ ("ய" "y") ; U+0BAF
+ ("ர" "r") ; U+0BB0
+ ("ல" "l") ; U+0BB2
+ ("வ" "v") ; U+0BB5
+ ("ழ" "z") ; U+0BB4
+ ("ள" "L") ; U+0BB3
+ ("ற" "rh") ; U+0BB1
+ ("ன" "nh") ; U+0BA9
+ ("ஜ" "j") ; U+0B9C
+ ("ஶ" nil) ; U+0BB6
+ ("ஷ" "Sh") ; U+0BB7
+ ("ஸ" "s") ; U+0BB8
+ ("ஹ" "h") ; U+0BB9
+ ("க்ஷ" "x" ) ; U+0B95
+ ))
+ (virama #x0BCD)
+ clm)
+ (with-temp-buffer
+ (insert "\n")
+ (insert " +")
+ (insert-char ?- 74)
+ (insert "\n |")
+ (setq clm 6)
+ (dolist (v vowels)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (car v))
+ (setq clm (+ clm 6)))
+ (insert "\n |")
+ (setq clm 6)
+ (dolist (v vowels)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (nth 2 v))
+ (setq clm (+ clm 6)))
+ (dolist (c consonants)
+ (insert "\n----+")
+ (insert-char ?- 74)
+ (insert "\n")
+ (insert (car c) virama
+ (propertize "\t" 'display '(space :align-to 4))
+ "|")
+ (setq clm 6)
+ (dolist (v vowels)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (car c) (or (nth 1 v) ""))
+ (setq clm (+ clm 6)))
+ (insert "\n" (or (nth 1 c) "")
+ (propertize "\t" 'display '(space :align-to 4))
+ "|")
+ (setq clm 6)
+
+ (dolist (v vowels)
+ (apply 'insert (propertize "\t" 'display (list 'space :align-to clm))
+ (if (nth 1 c) (list (nth 1 c) (nth 2 v)) (list "")))
+ (setq clm (+ clm 6))))
+ (insert "\n")
+ (insert "----+")
+ (insert-char ?- 74)
+ (insert "\n")
+ (buffer-string))))
+
+(defvar quail-tamil-itrans-numerics-and-symbols-table
+ (let ((numerics '((?௰ "பத்து") (?௱ "நூறு") (?௲ "ஆயிரம்")))
+ (symbols '((?௳ "நாள்") (?௴ "மாதம்") (?௵ "வருடம்")
+ (?௶ "பற்று") (?௷ "வரவு") (?௸ "மேற்படி")
+ (?௹ "ரூபாய்") (?௺ "எண்")))
+ clm)
+ (with-temp-buffer
+ (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (insert
+ (propertize "\t" 'display '(space :align-to 5)) "numerics"
+ (propertize "\t" 'display '(space :align-to 18)) "|"
+ (propertize "\t" 'display '(space :align-to 45)) "symbols")
+ (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (dotimes (i 2)
+ (setq clm 0)
+ (dolist (elm numerics)
+ (if (> clm 0)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))))
+ (insert (nth i elm))
+ (setq clm (+ clm 5)))
+ (insert (propertize "\t" 'display '(space :align-to 18)) "|")
+ (setq clm 19)
+ (dolist (elm symbols)
+ (if (> clm 19)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))))
+ (insert (nth i elm))
+ (setq clm (+ clm 8)))
+ (insert "\n"))
+ (insert (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (insert "\n")
+ (buffer-string))))
+
+(defvar quail-tamil-itrans-various-signs-and-digits-table
+ (let ((various '((?ஃ . "H") ("ஸ்ரீ" . "srii") (?ௐ)))
+ (digits "௦௧௨௩௪௫௬௭௮௯")
+ (width 6) clm)
+ (with-temp-buffer
+ (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (insert
+ (propertize "\t" 'display '(space :align-to 5)) "various"
+ (propertize "\t" 'display '(space :align-to 18)) "|"
+ (propertize "\t" 'display '(space :align-to 45)) "digits")
+
+ (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (setq clm 0 )
+
+ (dotimes (i (length various))
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (car (nth i various)))
+ (setq clm (+ clm width)))
+ (insert (propertize "\t" 'display '(space :align-to 18)) "|")
+ (setq clm 20)
+ (dotimes (i 10)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (aref digits i))
+ (setq clm (+ clm width)))
+ (insert "\n")
+ (setq clm 0)
+ (dotimes (i (length various))
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (or (cdr (nth i various)) ""))
+ (setq clm (+ clm width)))
+ (insert (propertize "\t" 'display '(space :align-to 18)) "|")
+ (setq clm 20)
+ (dotimes (i 10)
+ (insert (propertize "\t" 'display (list 'space :align-to clm))
+ (format "%d" i))
+ (setq clm (+ clm width)))
+ (insert "\n" (make-string 18 ?-) "+" (make-string 60 ?-) "\n")
+ (buffer-string))))
+
+(if nil
+ (quail-define-package "tamil-itrans" "Tamil" "TmlIT" t "Tamil ITRANS"))
+(quail-define-indian-trans-package
+ indian-tml-itrans-v5-hash "tamil-itrans" "Tamil" "TmlIT"
+ "Tamil transliteration by ITRANS method.
+
+You can input characters using the following mapping tables.
+ Example: To enter வணக்கம், type vaNakkam.
+
+### Basic syllables (consonants + vowels) ###
+\\<quail-tamil-itrans-syllable-table>
+
+### Miscellaneous (various signs + digits) ###
+\\<quail-tamil-itrans-various-signs-and-digits-table>
+
+### Others (numerics + symbols) ###
+
+Characters below have no ITRANS method associated with them.
+Their descriptions are included for easy reference.
+\\<quail-tamil-itrans-numerics-and-symbols-table>
+
+Full key sequences are listed below:")
+
+;;;
+;;; Input by Inscript
+;;;
+
+(defun quail-define-inscript-package (char-tables key-tables pkgname lang
+ title docstring)
+ (funcall 'quail-define-package pkgname lang title nil docstring
+ nil nil nil t nil nil nil nil)
+ (let (char-table key-table char key)
+ (while (and char-tables key-tables)
+ (setq char-table (car char-tables)
+ char-tables (cdr char-tables)
+ key-table (car key-tables)
+ key-tables (cdr key-tables))
+ (while (and char-table key-table)
+ (setq char (car char-table)
+ char-table (cdr char-table)
+ key (car key-table)
+ key-table (cdr key-table))
+ (if (and (consp char) (consp key))
+ (setq char-table (append char char-table)
+ key-table (append key key-table))
+ (if (and key char)
+ (quail-defrule
+ (if (characterp key) (char-to-string key) key)
+ (if (stringp char) (vector char) char))))))))
+
+;;
+
+(defvar inscript-dev-keytable
+ '(
+ (;; VOWELS (18)
+ (?D nil) (?E ?e) (?F ?f) (?R ?r) (?G ?g) (?T ?t)
+ (?+ ?=) ("F]" "f]") (?! ?@) (?Z ?z) (?S ?s) (?W ?w)
+ (?| ?\\) (?~ ?`) (?A ?a) (?Q ?q) ("+]" "=]") ("R]" "r]"))
+ (;; CONSONANTS (42)
+ ?k ?K ?i ?I ?U ;; GRUTTALS
+ ?\; ?: ?p ?P ?} ;; PALATALS
+ ?' ?\" ?\[ ?{ ?C ;; CEREBRALS
+ ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?h ?H ?y ?Y ?c ;; LABIALS
+ ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?M ?< ?m ?u ;; SIBILANTS
+ "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
+ ?% ?&)
+ (;; Misc Symbols (7)
+ ?X ?x ?_ ">]" ?d "X]" ?>)
+ (;; Digits
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
+ (;; Inscripts
+ ?# ?$ ?^ ?* ?\])))
+
+(defvar inscript-mlm-keytable
+ '(
+ (;; 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]"))
+ (;; CONSONANTS (42)
+ ?k ?K ?i ?I ?U ;; GRUTTALS
+ ?\; ?: ?p ?P ?} ;; PALATALS
+ ?' ?\" ?\[ ?{ ?C ;; CEREBRALS
+ ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?h ?H ?y ?Y ?c ;; LABIALS
+ ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?M ?< ?m ?u ;; SIBILANTS
+ "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
+ ?% ?&)
+ (;; Misc Symbols (7)
+ ?X ?x ?_ ">]" ?d "X]" ?>)
+ (;; Digits
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
+ (;; Inscripts
+ ?# ?$ ?^ ?* ?\])))
+
+(defvar inscript-tml-keytable
+ '(
+ (;; VOWELS (18)
+ (?D nil) (?E ?e) (?F ?f) (?R ?r) (?G ?g) (?T ?t)
+ nil nil nil (?S ?s) (?Z ?z) (?W ?w)
+ nil (?A ?a) (?~ ?`) (?Q ?q) nil nil)
+ (;; CONSONANTS (42)
+ ?k ?K ?i ?I ?U ;; GRUTTALS
+ ?\; ?: ?p ?P ?} ;; PALATALS
+ ?' ?\" ?\[ ?{ ?C ;; CEREBRALS
+ ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?h ?H ?y ?Y ?c ;; LABIALS
+ ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?M ?< ?m ?u ;; SIBILANTS
+ "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
+ ?% ?&)
+ (;; Misc Symbols (7)
+ ?X ?x ?_ ">]" ?d "X]" ?>)
+ (;; Digits
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
+ (;; Inscripts
+ ?# ?$ ?^ ?* ?\])))
+
+(if nil
+ (quail-define-package "devanagari-inscript" "Devanagari" "DevIS" t "Devanagari keyboard Inscript"))
+(quail-define-inscript-package
+ indian-dev-base-table inscript-dev-keytable
+ "devanagari-inscript" "Devanagari" "DevIS"
+ "Devanagari keyboard Inscript.")
+
+(if nil
+ (quail-define-package "punjabi-inscript" "Punjabi" "PnjIS" t "Punjabi keyboard Inscript"))
+(quail-define-inscript-package
+ indian-pnj-base-table inscript-dev-keytable
+ "punjabi-inscript" "Punjabi" "PnjIS"
+ "Punjabi keyboard Inscript.")
+
+(if nil
+ (quail-define-package "gujarati-inscript" "Gujarati" "GjrIS" t "Gujarati keyboard Inscript"))
+(quail-define-inscript-package
+ indian-gjr-base-table inscript-dev-keytable
+ "gujarati-inscript" "Gujarati" "GjrIS"
+ "Gujarati keyboard Inscript.")
+
+(if nil
+ (quail-define-package "oriya-inscript" "Oriya" "OriIS" t "Oriya keyboard Inscript"))
+(quail-define-inscript-package
+ indian-ori-base-table inscript-dev-keytable
+ "oriya-inscript" "Oriya" "OriIS"
+ "Oriya keyboard Inscript.")
+
+(if nil
+ (quail-define-package "bengali-inscript" "Bengali" "BngIS" t "Bengali keyboard Inscript"))
+(quail-define-inscript-package
+ indian-bng-base-table inscript-dev-keytable
+ "bengali-inscript" "Bengali" "BngIS"
+ "Bengali keyboard Inscript.")
+
+(if nil
+ (quail-define-package "assamese-inscript" "Assamese" "AsmIS" t "Assamese keyboard Inscript"))
+(quail-define-inscript-package
+ indian-asm-base-table inscript-dev-keytable
+ "assamese-inscript" "Assamese" "AsmIS"
+ "Assamese keyboard Inscript.")
+
+(if nil
+ (quail-define-package "telugu-inscript" "Telugu" "TlgIS" t "Telugu keyboard Inscript"))
+(quail-define-inscript-package
+ indian-tlg-base-table inscript-dev-keytable
+ "telugu-inscript" "Telugu" "TlgIS"
+ "Telugu keyboard Inscript.")
+
+(if nil
+ (quail-define-package "kannada-inscript" "Kannada" "KndIS" t "Kannada keyboard Inscript"))
+(quail-define-inscript-package
+ indian-knd-base-table inscript-dev-keytable
+ "kannada-inscript" "Kannada" "KndIS"
+ "Kannada keyboard Inscript.")
+
+(if nil
+ (quail-define-package "malayalam-inscript" "Malayalam" "MlmIS" t "Malayalam keyboard Inscript"))
+(quail-define-inscript-package
+ indian-mlm-base-table inscript-mlm-keytable
+ "malayalam-inscript" "Malayalam" "MlmIS"
+ "Malayalam keyboard Inscript.")
+
+(if nil
+ (quail-define-package "tamil-inscript" "Tamil" "TmlIS" t "Tamil keyboard Inscript"))
+(quail-define-inscript-package
+ indian-tml-base-table inscript-tml-keytable
+ "tamil-inscript" "Tamil" "TmlIS"
+ "Tamil keyboard Inscript.")
+
+;;; indian.el ends here
diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el
new file mode 100644
index 00000000000..0a8db8c6d55
--- /dev/null
+++ b/lisp/leim/quail/ipa-praat.el
@@ -0,0 +1,346 @@
+;;; ipa-praat.el --- Inputting IPA characters with the conventions of Praat
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Oliver Scholz <epameinondas@gmx.de>
+;; Keywords: multilingual, input method, IPA
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a new input method for IPA characters and diacritics, which follows
+;; the conventions of Praat, a GPLed program for phonetic analysis.
+;;
+;; This input method is much more complete than the current ipa.el.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "ipa-praat" "IPA" "IPAP" t
+ "International Phonetic Alphabet input method.
+This follows the input method of the phonetic analysis program
+Praat (http://www.fon.hum.uva.nl/praat/).
+
+
+* Vowels
+
+- Unrounded
+ | front | centr. | back
+-------------+-------+--------+------
+close | i i | ɨ \\i- | ɯ \\mt
+close centr. | ɪ \\ic | |
+close-mid | e e | ɘ \\e- | ɤ \\rh
+ | | ə \\sw |
+open-mid | ɛ \\ef | ɜ \\er | ʌ \\vt
+ | æ \\ae | ɐ \\at |
+open | a a | | ɑ \\as
+
+
+
+- Rounded
+ | front | centr. | back
+-------------+-------+--------+-------
+close | y y | ʉ \\u- | u u
+close centr. | ʏ \\yc | | ʊ \\hs
+close-mid | ø \\o/ | ɵ \\o- | o o
+open-mid | œ \\oe | ɞ \\kb | ɔ \\ct
+open | ɶ \\Oe | | ɒ \\ab
+
+
+
+For most of the codes, the first letter tells you the most
+similar letter of the English alphabet. The second letter can be
+t (turned), c (capital), s (script), r (reversed), - (barred or
+retracted), or / (slashed). One symbol (ɛ) is a phonetic version
+of a Greek letter. The codes for ə, ɤ, ʊ and ɞ are abbreviations
+for schwa, ram's horn, horseshoe, and kidney bean.
+
+
+* Consonants
+
+- Pulmonic
+
+ | plos. | nasal | fric. | approx. | trill | tap/flap | l. appr.
+-----------+-------+-------+-------+---------+-------+----------+---------
+bilabial | p p | m m | ɸ \\ff | | | |
+ | b b | | β \\bf | ʋ \\vs | ʙ \\bc | |
+labiodent. | | ɱ \\mj | f f | | | |
+ | | | v v | | | |
+dental | | | θ \\tf | | | |
+ | | | ð \\dh | | | |
+alveolar | t t | n n | s s | | | ɾ \\fh |
+ | d d | | z z | ɹ \\rt | r r | | l l
+alv. lat. | | | ɬ \\l- | | | ɺ \\rl |
+ | | | ɮ \\lz | l l | | | l l
+postalv. | | | ʃ \\sh | | | |
+ | | | ʒ \\zh | | | |
+retroflex | ʈ \\t. | ɳ \\n. | ʂ \\s. | | | ɽ \\f. |
+ | ɖ \\d. | | ʐ \\z. | ɻ \\r. | | | ɭ \\l.
+alv.-pala. | | | ɕ \\cc | | | |
+ | | | ʑ \\zc | | | |
+palatal | c c | ɲ \\nj | ç \\c, | | | |
+ | ɟ \\j. | | ʝ \\jc | j j | | | ʎ \\yt
+lab.-pal. | | | | | | |
+ | | | | ɥ \\ht | | |
+lab.-vela. | | | ʍ \\wt | | | |
+ | | | | w w | | |
+velar | k k | ŋ \\ng | x x | | | | ʟ \\lc
+ | ɡ \\gs | | ɣ \\gf | ɰ \\ml | | |
+uvular | q q | ɴ \\nc | χ \\cf | | | |
+ | ɢ \\gc | | ʁ \\ri | | ʀ \\rc | |
+pharyngeal | | | ħ \\h- | | | |
+ | | | ʕ \\9e | | | |
+epiglottal | ʡ \\?- | | ʜ \\hc | | | |
+ | | | ʢ \\9- | | | |
+glottal | ʔ | | h h | | | |
+ | | | ɦ \\h^ | | | |
+
+- Nonpulmonic
+
+ | implosive | click
+----------+-----------+------
+bilabial | ɓ \\b^ | ʘ \\O.
+dental | | ǀ \\|1
+alveolar | ɗ \\d^ |
+alv.-lat. | | ǁ \\|2
+postalv. | | ǂ \\|-
+retrofl. | | ! !
+palatal | ʄ \\j^ |
+velar | ɠ \\g^ |
+uvular | ʛ \\G^ |
+
+For most of the codes, the first letter tells you the most
+similar letter of the English alphabet. The second letter can
+be t (turned), c (capital or curled), s (script), - (barred),
+l (with leg), i (inverted), or j (left tail). Some phonetic
+symbols are similar to Greek letters but have special
+phonetic (f) versions with serifs (ɸ, β, ɣ) or are otherwise
+slightly different (θ, χ). The codes for ŋ (engma), ð (eth),
+ʃ (esh), and ʒ (yogh) are traditional alternative spellings.
+The retroflexes have a period in the second place, because an
+alternative traditional spelling is to write a dot under
+them. The code for ɾ is an abbreviation for fishhook.
+
+
+* Diacritics
+
+- In line
+
+input | example | description
+------+---------+---------------------
+\\:f | ː | phonetic length sign
+\\'1 | ˈ | primary stress
+\\'2 | ˌ | secondary stress
+\\cn | t̚ | unreleased plosive
+\\rh | ɜ˞ | rhotacized vowel
+
+- Understrikes
+
+input | example | description
+------+---------+--------------------------------
+\\|v | n̩ | syllabic consonant
+\\0v | b̥ | voiceless
+\\Tv | o̞ | lowered
+\\T^ | o̝ | raised
+\\T( | o̘ | advanced tongue root
+\\T) | o̙ | retracted tongue root
+\\-v | e̱ | backed
+\\+v | o̟ | fronted
+\\:v | o̤ | breathy voice
+\\~v | o̰ | creaky voice
+\\Nv | d̪ | dental (as opposed to alveolar)
+\\Uv | d̺ | apical
+\\Dv | d̻ | laminal
+\\nv | u̯ | nonsyllabic
+\\e3v | e̹ | slightly rounded
+\\cv | u̜ | slightly unrounded
+
+- Overstrikes
+
+input | example | description
+------+---------+--------------------------------------------
+\\0^ | ɣ̊ | voiceless
+\\'^ | | high tone
+\\`^ | | low tone
+\\-^ | | mid tone
+\\~^ | | nasalized
+\\v^ | | rising tone
+\\^^ | | falling tone
+\\:^ | | centralized
+\\N^ | | short
+\\li | k͡p | simultaneous articulation or single segment
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ;; plosives
+ ("\\t." ?ʈ) ; retroflex
+ ("\\d." ?ɖ) ; voiced retroflex
+ ("\\j-" ?ɟ) ; voiced palatal
+ ("\\gs" ?ɡ) ; voiced velar
+ ("\\gc" ?ɢ) ; voiced uvular
+ ("\\?-" ?ʡ) ; epiglottal
+ ("\\?g" ?ʔ) ; glottal
+
+ ;; nasals
+ ("\\mj" ?ɱ) ; labiodental
+ ("\\n." ?ɳ) ; retroflex
+ ("\\nj" ?ɲ) ; palatal
+ ("\\ng" ?ŋ) ; velar
+ ("\\nc" ?ɴ) ; uvular
+
+ ;; fricatives
+ ("\\ff" ?ɸ) ; bilabial
+ ("\\bf" ?β) ; voiced bilabial
+ ("\\tf" ?θ) ; labiodental
+ ("\\dh" ?ð) ; voiced labiodental
+ ("\\sh" ?ʃ) ; postalveolar
+ ("\\l-" ?ɬ) ; alv. lateral
+ ("\\lz" ?ɮ) ; voiced alv. lateral
+ ("\\zh" ?ʒ) ; voiced postalveolar
+ ("\\s." ?ʂ) ; retroflex
+ ("\\z." ?ʐ) ; voiced retroflex
+ ("\\cc" ?ɕ) ; alveolo-palatal
+ ("\\zc" ?ʑ) ; voiced alveolo-palatal
+ ("\\c," ?ç) ; palatal
+ ("\\jc" ?ʝ) ; voiced palatal
+ ("\\wt" ?ʍ) ; labial-velar
+ ("\\gf" ?ɣ) ; voiced velar
+ ("\\cf" ?χ) ; uvular
+ ("\\ri" ?ʁ) ; voiced uvular
+ ("\\h-" ?ħ) ; pharyngeal
+ ("\\9e" ?ʕ) ; voiced pharyngeal
+ ("\\hc" ?ʜ) ; epiglottal
+ ("\\9-" ?ʢ) ; voiced epiglottal
+ ("\\h^" ?ɦ) ; voiced glottal
+
+ ;; approximants
+ ("\\vs" ?ʋ) ; labiodental
+ ("\\rt" ?ɹ) ; alveolar
+ ("\\r." ?ɻ) ; retroflex
+ ("\\ht" ?ɥ) ; labial-palatal
+ ("\\ml" ?ɰ) ; velar
+
+ ;; trills
+ ("\\bc" ?ʙ) ; bilabial
+ ("\\rc" ?ʀ) ; uvular
+
+ ;; taps or flaps
+ ; ⱱ -- labiodental
+ ("\\fh" ?ɾ) ; alveolar
+ ("\\rl" ?ɺ) ; alv.-lateral
+ ("\\f." ?ɽ) ; retroflex
+
+ ;; lateral approx.
+ ("\\l." ?ɭ) ; retroflex
+ ("\\yt" ?ʎ) ; palatal
+ ("\\lc" ?ʟ) ; velar
+
+ ;; implosives
+ ("\\b^" ?ɓ) ; bilabial
+ ("\\d^" ?ɗ) ; alveolar
+ ("\\j^" ?ʄ) ; palatal
+ ("\\g^" ?ɠ) ; velar
+ ("\\G^" ?ʛ) ; uvular
+
+ ;; clicks
+ ("\\O." ?ʘ) ; bilabial
+ ("\\|1" ?ǀ) ; dental
+ ("\\|2" ?ǁ) ; alv. lateral
+ ("\\|-" ?ǂ) ; postalveolar
+
+ ;; other
+ ("\\l~" ?ɫ) ; velarized l
+ ("\\hj" ?ɧ) ; post-alveolar & velar fricative
+
+ ;; vowels
+ ("\\i-" ?ɨ)
+ ("\\u-" ?ʉ)
+
+ ("\\mt" ?ɯ)
+
+ ("\\ic" ?ɪ)
+ ("\\yc" ?ʏ)
+
+ ("\\hs" ?ʊ)
+
+ ("\\o/" ?ø)
+ ("\\e-" ?ɘ)
+ ("\\o-" ?ɵ)
+ ("\\rh" ?ɤ)
+
+ ("\\sw" ?ə)
+
+ ("\\ef" ?ɛ)
+ ("\\oe" ?œ)
+ ("\\er" ?ɜ)
+ ("\\kb" ?ɞ)
+ ("\\vt" ?ʌ)
+ ("\\ct" ?ɔ)
+
+ ("\\ae" ?æ)
+ ("\\at" ?ɐ)
+
+ ("\\Oe" ?ɶ)
+ ("\\as" ?ɑ)
+ ("\\ab" ?ɒ)
+
+ ("\\sr" ?ɚ)
+
+ ;; diacritics
+ ("\\:f" ?ː) ; phonetic length sign
+ ("\\'1" ?ˈ) ; primary stress
+ ("\\'2" ?ˌ) ; secondary stress
+ ("\\cn" #x031A) ; t̚ unreleased plosive
+ ("\\rh" #x02DE) ; ɜ˞ rhotacized vowel
+
+ ("\\|v" #x0329) ; n̩ syllabic consonant
+ ("\\0v" #x0325) ; b̥ voiceless
+ ("\\Tv" #x031E) ; o̞ lowered
+ ("\\T^" #x031D ) ; o̝ raised
+ ("\\T(" #x0318) ; o̘ advanced tongue root
+ ("\\T)" #x0319) ; o̙ retracted tongue root
+ ("\\-v" #x0331) ; e̱ backed
+ ("\\+v" #x031F) ; o̟ fronted
+ ("\\:v" #x0324) ; o̤ breathy voice
+ ("\\~v" #x0330) ; o̰ creaky voice
+ ("\\Nv" #x032A) ; d̪ dental (as opposed to alveolar)
+ ("\\Uv" #x033A) ; d̺ apical
+ ("\\Dv" #x033B) ; d̻ laminal
+ ("\\nv" #x032F) ; u̯ nonsyllabic
+ ("\\e3v" #x0339) ; e̹ slightly rounded
+ ("\\cv" #x031C) ; u̜ slightly unrounded
+
+ ("\\0^" #x030A) ; ɣ̊ voiceless
+ ("\\'^" #x0301) ; high tone
+ ("\\`^" #x0300) ; low tone
+ ("\\-^" #x0304) ; mid tone
+ ("\\~^" #x0303) ; nasalized
+ ("\\v^" #x030C) ; rising tone
+ ("\\^^" #x0302) ; falling tone
+ ("\\:^" #x0308) ; centralized
+ ("\\N^" #x0306) ; short
+ ("\\li" #x0361) ; k͡p simultaneous articulation or single segment
+ )
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; ipa-praat.el ends here
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
new file mode 100644
index 00000000000..d9c4515a35a
--- /dev/null
+++ b/lisp/leim/quail/ipa.el
@@ -0,0 +1,519 @@
+;;; ipa.el --- Quail package for inputting IPA characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+;; Licensed to the Free Software Foundation.
+
+;; Keywords: multilingual, input method, IPA
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(eval-when-compile (require 'cl-lib))
+
+(quail-define-package
+ "ipa" "IPA" "IPA" t
+ "International Phonetic Alphabet for English, French, German and Italian
+
+Upside-down characters are obtained by a preceding slash (/)."
+ nil nil nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("i" ?i)
+ ("I" ?ɪ)
+ ("e" ?e)
+ ("/3" ?ɛ)
+ ("E" ?ɛ)
+ ("ae" ?æ)
+ ("a" ?a)
+ ("i-" ?ɨ)
+ ("/e" ?ə)
+ ("/a" ?ɐ)
+ ("/m" ?ɯ)
+ ("&" ?ɤ)
+ ("/v" ?ʌ)
+ ("A" ?ɑ)
+ ("o|" ?ɑ)
+ ("y" ?y)
+ ("Y" ?ʏ)
+ ("o/" ?ø)
+ ("oe" ?œ)
+ ("OE" ?ɶ)
+ ("u-" ?ʉ)
+ ("o-" ?ɵ)
+ ("u" ?u)
+ ("U" ?ʊ)
+ ("o" ?o)
+ ("/c" ?ɔ)
+ ("/A" ?ɒ)
+ ("|o" ?ɒ)
+ ("e-" ?ɚ)
+ ("e|" ?ɚ)
+ ("/3~" ["ɛ̃"])
+ ("E~" ["ɛ̃"])
+ ("A~" ["ɑ̃"])
+ ("oe~" ["œ̃"])
+ ("/c~" ["ɔ̃"])
+ ("p" ?p)
+ ("b" ?b)
+ ("t" ?t)
+ ("d" ?d)
+ ("k" ?k)
+ ("g" ?ɡ)
+ ("f" ?f)
+ ("v" ?v)
+ ("th" ?θ)
+ ("dh" ?ð)
+ ("s" ?s)
+ ("z" ?z)
+ ("sh" ?ʃ)
+ ("tsh" ["ʧ" "tʃ" "t⁀ʃ"])
+ ("zh" ?ʒ)
+ ("3" ?ʒ)
+ ("c," ?ç)
+ ("x" ?x)
+ ("/R" ?ʁ)
+ ("h" ?h)
+ ("m" ?m)
+ ("n" ?n)
+ ("gn" ?ɲ)
+ ("ng" ?ŋ)
+ ("r" ?r)
+ ("R" ?ʀ)
+ ("/r" ?ɹ)
+ ("j" ?j)
+ ("l" ?l)
+ ("/y" ?ʎ)
+ ("L" ?ʟ)
+ ("/h" ?ɥ)
+ ("w" ?w)
+ ("M" ?ʍ)
+ ("'" ?ˈ)
+ ("`" ?ˌ)
+ (":" ?ː))
+
+(quail-define-package
+ "ipa-kirshenbaum" "IPA" "IPA-K" t
+ "The International Phonetic Alphabet, using Kirshenbaum ASCII translit.
+
+Kirshenbaum IPA is an ASCII transliteration of the phonetic alphabet, common
+in the Usenet groups `sci.lang' and `alt.usage.english'. This input method
+allows you to type Kirshenbaum on your ASCII-capable keyboard, producing the
+corresponding actual IPA characters in your editor.
+
+See http://www.kirshenbaum.net/IPA/ascii-ipa.pdf for full details of the
+transliteration.
+
+A caveat with regard to that document; while XEmacs currently preserves
+Unicode diacritics on reading and emitting them, it displays them,
+incorrectly, as separate from the modified glyphs.")
+
+(quail-define-rules
+ ("g" "ɡ") ;; Voiced velar plosive U+0261
+ ("r" "ɹ") ;; Alveolar approximant U+0279
+ ("A" "ɑ") ;; Low back unrounded vowel U+0251
+ ("B" "β") ;; Voiced bilabial fricative U+03B2
+ ("C" "ç") ;; Voiced palatal fricative U+00E7
+ ("D" "ð") ;; Voiced dental fricative U+00F0
+ ("E" "ɛ") ;; Lower-mid front unrounded vowel U+025B
+ ("G" "ɢ") ;; Voiced uvular stop U+0262
+ ("H" "ħ") ;; Voiced pharyngeal fricative U+0127
+ ("I" "ɪ") ;; Semi-high front unrounded vowel U+026A
+ ("J" "ɟ") ;; Voiced palatal stop U+025F
+ ("L" ["ɫ" ;; Voiced velar lateral U+026B
+ "ʟ" ;; Voiced velar lateral U+029F
+ "ɬ"]) ;; Voiced alveolar lateral fricative U+026C
+ ("M" "ɱ") ;; Labio-dental nasal U+0271
+ ("N" "ŋ") ;; Velar nasal U+014B
+ ("O" "ɔ") ;; Low-mid back rounded vowel U+0254
+ ("P" "ɸ") ;; Voiceless bilabial fricative U+0278
+ ("Q" "ɣ") ;; Voiced velar fricative U+0263
+ ("R" ["ʀ" ;; Alveolar trill U+0280
+ "ɚ"]) ;; Rhotacized schwa U+025A
+ ("@<r>" "ɚ") ;; Mid central rhotacized vowel U+025A
+ ("S" "ʃ") ;; Voiceless postalveolar fricative U+0283
+ ("tS" ["ʧ" ;; Voiceless postalveolar affricate U+02A7
+ "tʃ" ;; U+0074 U+0283
+ "t⁀ʃ"]) ;; U+0074 U+2040 U+0283
+ ("T" "θ") ;; Voiceless dental fricative U+03B8
+ ("U" "ʊ") ;; Semi-high back rounded vowel U+028A
+ ("V" "ʌ") ;; Low-mid back unrounded vowel U+028C
+ ("W" "œ") ;; Low-mid front rounded vowel U+0153
+ ("X" "χ") ;; Voiceless uvular fricative U+03C7
+ ("Y" "ø") ;; Upper-mid front rounded vowel U+00F8
+ ("Z" "ʒ") ;; Voiced postalveolar fricative U+0292
+ ("?" "ʔ") ;; Glottal stop U+0294
+ ("@" "ə") ;; Mid central unrounded vowel (schwa) U+0259
+ ("&" "æ") ;; Low front unrounded vowel U+00E6
+ ("*" "ɾ") ;; Voiced alveolar flap U+027E
+
+ ("a~" "ã") ;; Low central unrounded vowel, nasal U+00E3
+ ("o~" "õ") ;; Upper-mid back rounded vowel, nasal U+00F5
+ ("u~" "ũ") ;; High back rounded vowel, nasal U+0169
+ ("~" "̃") ;; +Nasalized modifier U+0303
+ (":" "ː") ;; +Long modifier U+02D0
+ ("-" "̩") ;; +Syllabic modifier U+0329
+ ("." "̣") ;; +Retroflex modifier U+0323
+ ("`" "ʼ") ;; +Ejective modifier U+02BC
+ ("[" "̪") ;; +Dental modifier U+032A
+ (";" "ʲ") ;; +Palatalized modifier U+02B2
+ ("<H>" "̴") ;; +Pharyngealized modifier U+0334
+ ("<h>" "ʰ") ;; +Aspirated modifier U+02B0
+ ("<o>" ["̥" ;; +Voiceless modifier U+0325
+ "˚"]) ;; +Unexploded modifier U+02DA
+ ("<r>" "ʳ") ;; +Rhotacized modifier U+02B3
+ ("<w>" "ʷ") ;; +Labialized modifier U+02B7
+ ("<?>" "ʱ") ;; +Murmured modifier U+02B1
+
+ ("b<trl>" "ʙ") ;; Bilabial trill U+0299
+ ("b`" "ɓ") ;; Bilabial implosive U+0253
+ ("p!" "ʘ") ;; Bilabial click U+0298
+ ("r<lbd>" "ʋ") ;; Labio-dental approximant U+028B
+ ("d`" "ɗ") ;; Dental implosive U+0257
+ ("t!" "ʇ") ;; Dental click U+0287
+ ("s<lat>" "ɬ") ;; Voiceless alveolar lateral fricative U+026C
+ ("z<lat>" "ɮ") ;; Voiced alveolar lateral fricative U+026E
+ ("r<trl>" "ʀ") ;; Alveolar trill U+0280
+
+ ("*<lat>" "ɺ") ;; Voiced alveolar lateral flap U+027A
+ ("c!" "ʗ") ;; Alveolar click U+0297
+ ("l!" "ʖ") ;; Alveolar lateral click U+0296
+ ("n." "ɳ") ;; Retroflex nasal U+0273
+ ("t." "ʈ") ;; Voiceless retroflex stop U+0288
+ ("d." "ɖ") ;; Voiced retroflex stop U+0256
+ ("s." "ʂ") ;; Voiceless retroflex fricative U+0282
+ ("z." "ʐ") ;; Voiceless retroflex fricative U+0290
+ ("r." "ɻ") ;; Retroflex approximant U+027B
+ ("l." "ɭ") ;; Retroflex lateral U+026D
+ ("*." "ɽ") ;; Retroflex flap U+027D
+
+ ("C<vcd>" "ʝ") ;; Voiced palatal fricative U+029D
+ ("j<rnd>" "ɥ") ;; Rounded palatal approximant U+0265
+ ("l^" "ʎ") ;; Palatal lateral U+028E
+ ("J`" "ʄ") ;; Palatal implosive U+0284
+ ("j<vel>" "ɰ") ;; Velar approximant U+0270
+ ("g`" "ɠ") ;; Velar implosive U+0260
+ ("k!" "ʞ") ;; Velar click U+029E
+
+ ("n<lbv>" ["n⁀g"]) ;; Labio-velar nasal
+ ("t<lbv>" ["k⁀p"]) ;; Voiceless labio-velar stop
+
+ ;; "n<lbv> for "gb" WITH U+2030 CHARACTER TIE was ambiguous and
+ ;; misleading. I _believe_ this is what was meant instead.
+ ("d<lbv>" ["g⁀b"]) ;; Voiced labio-velar stop.
+
+ ("w<vls>" "ʍ") ;; Voiceless labio-velar stop U+028D
+ ("n\"" "ɴ") ;; Uvular nasal U+0274
+ ("g\"" "ʁ") ;; Voiced uvular fricative U+0281
+ ("r\"" "ʀ") ;; Uvular trill U+0280
+ ("G`" "ʛ") ;; Voiced uvular implosive U+029B
+ ("H<vcd>" "ʕ") ;; Voiced pharyngeal fricative U+0295
+
+ ("h<?>" "ɦ") ;; Murmured glottal fricative U+0266
+ ("I." "ʏ") ;; Semi-high front rounded vowel U+028F
+ ("&." "ɶ") ;; Low front unrounded vowel U+0276
+
+ ("i\"" "ɨ") ;; High central unrounded vowel U+0268
+ ("u\"" "ʉ") ;; High central rounded vowel U+0289
+ ("@<umd>" "ɘ") ;; Upper-mid central unrounded vowel U+0258
+
+ ("R<umd>" "ɝ") ;; Upper-mid central rhotacized vowel U+025D
+
+ ("@." "ɵ") ;; Mid central rounded vowel U+0275
+ ("V\"" "ɜ") ;; Lower-mid central unrounded vowel U+025C
+ ("O\"" "ɞ") ;; Lower-mid central rounded vowel U+025E
+ ("u-" "ɯ") ;; High back unrounded vowel U+026F
+ ("o-" "ɤ") ;; Upper-mid back unrounded vowel U+0264
+ ("A." "ɒ")) ;; Lower back rounded vowel U+0252
+
+
+(defconst ipa-x-sampa-implosive-submap
+ '(("b_<" ?ɓ) ;; Voiced bilabial implosive U+0253
+ ("d_<" ?ɗ) ;; Voiced alveolar implosive U+0257
+ ("g_<" ?ɠ) ;; Voiced velar implosive U+0260
+ ("G\\_<" ?ʛ) ;; Voiced uvular implosive U+029B
+ ("J\\_<" ?ʄ)) ;; Voiced palatal implosive U+0284
+ "A map from the X-SAMPA for some implosive consonants to characters.
+This is used because their X-SAMPA syntax is quasi-diacritic, but the
+corresponding Unicode characters themselves don't have diacritics, they are
+separate code points. So we need to implement some extra logic that isn't
+normally provided by Quail.")
+
+;; On XEmacs, with the supplied X-SAMPA data, this function is capably
+;; implemented with:
+;;
+;; (list (vector (concat to-prepend quail-keymap)))
+;;
+;; Supporting GNU Emacs too makes it a good deal more complicated.
+
+(defun ipa-x-sampa-prepend-to-keymap-entry (to-prepend quail-keymap)
+ "Return QUAIL-KEYMAP with TO-PREPEND at the beginning of each result.
+
+QUAIL-KEYMAP is a cons that satisfies `quail-map-p'; TO-PREPEND is a
+string."
+ (when (consp quail-keymap) (setq quail-keymap (cdr quail-keymap)))
+ (if (or (integerp quail-keymap)
+ (and (fboundp 'characterp) (characterp quail-keymap)))
+ (setq quail-keymap (list (string quail-keymap)))
+ (if (stringp quail-keymap)
+ (setq quail-keymap (list quail-keymap))
+ (cl-assert (vectorp quail-keymap) t)
+ (setq quail-keymap (append quail-keymap nil))))
+ (list
+ (apply 'vector
+ (mapcar
+ #'(lambda (entry)
+ (cl-assert (char-or-string-p entry) t)
+ (format "%s%s" to-prepend
+ (if (integerp entry) (string entry) entry)))
+ quail-keymap))))
+
+(defun ipa-x-sampa-underscore-implosive (input-string length)
+ "Return keymap with IPA implosives, for INPUT-STRING, length LENGTH.
+
+The implosive consonants in X-SAMPA are represented with more or less a
+diacritic syntax, but the property +implosive in the IPA is expressed using
+separate characters, and not using a diacritic. This function works around
+the confusion that implies when generating IPA from X-SAMPA; it returns a
+Quail map that is a copy of the map for `_', but with all the DIACRITIC
+entries changed to return the diacritic together with the base character,
+and with the map to the implosive added to its end.
+
+Like all `quail-defrule'-assigned functions, this will be called once for
+each particular sequence of keys, the first time the user types that
+particular sequence of keys, and the result will be cached by Quail."
+ (let* ((input-string (substring input-string 0 (or length)))
+ (underscore-map (copy-tree (quail-lookup-key "_")))
+ (split-input (split-string input-string "_"))
+ (pre-underscore (car split-input))
+ (pre-underscore-map (quail-lookup-key pre-underscore))
+ (x-sampa-submap-entry
+ (assoc (format "%s<" input-string) ipa-x-sampa-implosive-submap))
+ underscore-map-entry)
+ (if (and (consp pre-underscore-map) (car pre-underscore-map))
+ (setq pre-underscore-map (car pre-underscore-map))
+ (setq pre-underscore-map pre-underscore))
+ (unless (stringp pre-underscore-map)
+ (setq pre-underscore-map (string pre-underscore-map)))
+ (dolist (underscoring underscore-map)
+ (cond ((null underscoring))
+ ((eq (length underscoring) 2)
+ (setq underscore-map-entry (cl-second underscoring))
+ (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry
+ pre-underscore-map underscore-map-entry)))
+ ((eq (length underscoring) 3)
+ (setq underscore-map-entry (cl-second (cl-third underscoring)))
+ (setcdr (cl-third underscoring)
+ (ipa-x-sampa-prepend-to-keymap-entry
+ pre-underscore-map underscore-map-entry)))
+ (t
+ (cl-assert (null t) t
+ "Can't handle subtrees of this level right now."))))
+ (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry))))))
+
+(quail-define-package
+ "ipa-x-sampa" "IPA" "IPA-X" t
+ "The International Phonetic Alphabet, using J.C. Wells' X-SAMPA.
+
+X-SAMPA is an ASCII transliteration of the IPA, normally used for data
+exchange in environments where Unicode is not available. This input method
+uses this transliteration to allow you to produce the IPA in your editor
+with a keyboard that's limited to ASCII.
+
+See http://www.phon.ucl.ac.uk/home/sampa/ipasam-x.pdf for a full definition
+of the mapping. A caveat with regard to that document; while XEmacs
+currently preserves Unicode diacritics on reading and emitting them, it
+displays them, incorrectly, as separate from the modified glyphs.")
+
+(quail-define-rules
+ ;; Table taken from http://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
+ ("g" "ɡ") ;; Voiced velar plosive U+0261
+ ("h\\" "ɦ") ;; Voiced glottal fricative U+0266
+ ("j\\" "ʝ") ;; Voiced palatal fricative U+029D
+ ("l`" "ɭ") ;; Retroflex lateral approximant U+026D
+ ("l\\" "ɺ") ;; Alveolar lateral flap U+027A
+ ("n`" "ɳ") ;; Retroflex nasal U+0273
+ ("p\\" "ɸ") ;; Voiceless bilabial fricative U+0278
+ ("r`" "ɽ") ;; Retroflex flap U+027D
+ ("r\\" "ɹ") ;; Alveolar approximant U+0279
+ ("r\\`" "ɻ") ;; Retroflex approximant U+027B
+ ("s`" "ʂ") ;; Voiceless retroflex fricative U+0282
+ ("s\\" "ɕ") ;; Voiceless alveolo-palatal fricative U+0255
+ ("t`" "ʈ") ;; Voiceless retroflex plosive U+0288
+ ("v\\" "ʋ") ;; Labiodental approximant U+028B
+ ("x\\" "ɧ") ;; Voiceless palatal-velar fricative U+0267
+ ("z`" "ʐ") ;; Voiced retroflex fricative U+0290
+ ("z\\" "ʑ") ;; Voiced alveolo-palatal fricative U+0291
+ ("A" "ɑ") ;; Open back unrounded vowel U+0251
+ ("B" "β") ;; Voiced bilabial fricative U+03B2
+ ("B\\" "ʙ") ;; Bilabial trill U+0299
+ ("C" "ç") ;; Voiceless palatal fricative U+00E7
+ ("D" "ð") ;; Voiced dental fricative U+00F0
+ ("E" "ɛ") ;; Open-mid front unrounded vowel U+025B
+ ("F" "ɱ") ;; Labiodental nasal U+0271
+ ("G" "ɣ") ;; Voiced velar fricative U+0263
+ ("G\\" "ɢ") ;; Voiced uvular plosive U+0262
+ ("H" "ɥ") ;; Labial-palatal approximant U+0265
+ ("H\\" "ʜ") ;; Voiceless epiglottal fricative U+029C
+ ("I" "ɪ") ;; Near-close near-front unrounded vowel U+026A
+ ("I\\" "Ɨ") ;; Central lax close unrounded vowel U+0197
+ ("J" "ɲ") ;; Palatal nasal U+0272
+ ("J\\" "ɟ") ;; Voiceless palatal plosive U+025F
+ ("K" "ɬ") ;; Voiceless alveolar lateral fricative U+026C
+ ("K\\" "ɮ") ;; Voiced alveolar lateral fricative U+026E
+ ("L" "ʎ") ;; Palatal lateral approximant U+028E
+ ("L\\" "ʟ") ;; Velar lateral approximant U+029F
+ ("M" "ɯ") ;; Close back unrounded vowel U+026F
+ ("M\\" "ɰ") ;; Velar approximant U+0270
+ ("N" "ŋ") ;; Velar nasal U+014B
+ ("N\\" "ɴ") ;; Uvular nasal U+0274
+ ("O" "ɔ") ;; Open-mid back rounded vowel U+0254
+ ("O\\" "ʘ") ;; Bilabial click U+0298
+ ("P" "ʋ") ;; Labiodental approximant U+028B
+ ("Q" "ɒ") ;; Open back rounded vowel U+0252
+ ("R" "ʁ") ;; Voiced uvular fricative U+0281
+ ("R\\" "ʀ") ;; Uvular trill U+0280
+ ("S" "ʃ") ;; Voiceless postalveolar fricative U+0283
+ ("tS" ["ʧ" ;; Voiceless postalveolar affricate U+02A7
+ "tʃ" ;; U+0074 U+0283
+ "t⁀ʃ"]) ;; U+0074 U+2040 U+0283
+ ("T" "θ") ;; Voiceless dental fricative U+03B8
+ ("U" "ʊ") ;; Near-close near-back rounded vowel U+028A
+ ("U\\" ["ʊ̵"]) ;; Central lax close rounded vowel, U+028A U+0335
+ ("V" "ʌ") ;; Open-mid back unrounded vowel U+028C
+ ("W" "ʍ") ;; Voiceless labial-velar fricative U+028D
+ ("X" "χ") ;; Voiceless uvular fricative U+03C7
+ ("X\\" "ħ") ;; Voiceless pharyngeal fricative U+0127
+ ("Y" "ʏ") ;; Near-close near-front rounded vowel U+028F
+ ("Z" "ʒ") ;; Voiced postalveolar fricative U+0292
+
+ ("\"" "ˈ") ;; Primary stress U+02C8
+ ("%" "ˌ") ;; Secondary stress U+02CC
+ (":" "ː") ;; Long U+02D0
+ (":\\" "ˑ") ;; Half-long U+02D1
+ ("@" "ə") ;; Schwa U+0259
+ ("@\\" "ɘ") ;; Close-mid central unrounded vowel U+0258
+ ("@`" "ɚ") ;; Rhotacized schwa U+025A
+ ("{" "æ") ;; Near-open front unrounded vowel U+00E6
+ ("}" "ʉ") ;; Close central rounded vowel U+0289
+ ("1" "ɨ") ;; Close central unrounded vowel U+0268
+ ("2" "ø") ;; Close-mid front rounded vowel U+00F8
+ ("3" "ɜ") ;; Open-mid central unrounded vowel U+025C
+ ("3\\" "ɞ") ;; Open-mid central rounded vowel U+025E
+ ("4" "ɾ") ;; Alveolar flap U+027E
+ ("5" "ɫ") ;; Velarized alveolar lateral approximant U+026B
+ ("6" "ɐ") ;; Near-open central vowel U+0250
+ ("7" "ɤ") ;; Close-mid back unrounded vowel U+0264
+ ("8" "ɵ") ;; Close-mid central rounded vowel U+0275
+ ("9" "œ") ;; Open-mid front rounded vowel U+0153
+ ("&" "ɶ") ;; Open front rounded vowel U+0276
+ ("?" "ʔ") ;; Glottal stop U+0294
+ ("?\\" "ʕ") ;; Voiced pharyngeal fricative U+0295
+ ;; The undefined escape character, ignored.
+ ;; Indeterminacy in French vowels, ignored.
+ ;; Begin nonsegmental notation, ignored.
+ ("<\\" "ʢ") ;; Voiced epiglottal fricative U+02A2
+ ;; End nonsegmental notation, ignored.
+ (">\\" "ʡ") ;; Epiglottal plosive U+02A1
+ ("^" "↑") ;; Upstep U+2191
+ ("!" "↓") ;; Downstep U+2193
+ ("!\\" "ǃ") ;; Postalveolar click U+01C3
+ ("\\" "ǀ") ;; Dental click U+01C0
+ ("\\|\\" "ǁ") ;; Lateral alveolar click U+01C1
+ ("=\\" "ǂ") ;; Palatal click U+01C2
+ ("-\\" "̮") ;; Linking mark U+032E
+
+ ;; Diacritics. Note that XEmacs doesn't yet have composed characters, so we
+ ;; can input them, but they won't display properly. If you send email using
+ ;; them, and the recipient's client is capable, they will get through,
+ ;; though.
+
+ ("_\"" "̈") ;; Centralized U+0308
+ ("_+" "̟") ;; Advanced U+031F
+ ("_-" "̠") ;; Retracted U+0320
+ ("_/" "ˇ") ;; Rising tone U+02C7
+ ("_0" "̥") ;; Voiceless U+0325
+ ("_=" "̩") ;; Syllabic U+0329
+ ("=" "̩") ;; Syllabic U+0329
+ ("_>" "ʼ") ;; Ejective U+02BC
+ ("_?\\" "ˤ") ;; Pharyngealized U+02E4
+ ("_\\" "ˆ") ;; Falling Tone U+02C6
+ ("_^" "̯") ;; Non-syllabic U+032F
+ ("_}" "̚") ;; No audible release U+031A
+ ;; ` is alternatively; retroflexion in consonants
+ ("`" "˞") ;; Rhotacization in vowels U+02DE
+ ("_~" "̃") ;; Nasalization U+0303
+ ("~" "̃") ;; Nasalization U+0303
+ ("_A" "̘") ;; Advanced tongue root U+0318
+ ("_a" "̺") ;; Apical U+033A
+ ("_B" "̏") ;; Extra low tone U+030F
+ ;; _B_L omitted, no Unicode code point for "low rising tone."
+ ("_c" "̜") ;; Less rounded U+031C
+ ("_d" "̪") ;; Dental U+032A
+ ("_e" "̴") ;; Velarized or pharyngeal U+0334
+
+ ("<F>" "↘") ;; Global fall; SOUTH EAST ARROW; may be a bit smaller than
+ ;; intended.
+ ("_F" "̂") ;; Falling tone U+0302
+ ("_G" "ˠ") ;; Velarized U+02E0
+ ("_H" "́") ;; High tone U+0301
+ ;; "_H_T omitted, no Unicode code point for "high rising tone"
+ ("_h" "ʰ") ;; Aspirated U+02B0
+ ("_j" "ʲ") ;; Palatalized U+02B2
+ ("'" "ʲ") ;; Palatalized U+02B2
+ ("_k" "̰") ;; Creaky voice U+0330
+ ("_L" "̀") ;; Low tone U+0300
+ ("_l" "ˡ") ;; Lateral release U+02E1
+ ("_M" "̄") ;; Mid tone U+0304
+ ("_m" "̻") ;; Laminal U+033B
+ ("_N" "̼") ;; Linguolabial U+033C
+ ("_n" "ⁿ") ;; Nasal release U+207F
+ ("_O" "̹") ;; More rounded U+0339
+ ("_o" "̞") ;; Lowered U+031E
+ ("_q" "̙") ;; Retracted tongue root U+0319
+ ("<R>" "↗") ;; NORTH EAST ARROW; may be a bit smaller than intended.
+ ("_R" "̌") ;; Haček, caron, rising tone. U+030C
+ ;; _R_F omitted, apparently there's no corresponding Unicode entry.
+ ("_r" "̝") ;; Raised U+031D
+ ("_T" "̋") ;; Extra high tone U+030B
+ ("_t" "̤") ;; Breathy voice U+0324
+ ("_v" "̬") ;; Voiced U+032C
+ ("_w" "ʷ") ;; Labialized U+02B7
+ ("_X" "̆") ;; Extra-short U+0306
+ ("_x" "̽")) ;; Mid-centralized U+033D
+
+;; Putting in place rules for the implosives like for the others above
+;; breaks the "_<diacritic>" rules for b, d, g, G and J a little--you need
+;; to interrupt Quail before typing the underscore if you want the
+;; diacritic. To avoid this, handle the input specially with the function
+;; ipa-x-sampa-underscore-implosive.
+
+(dolist (implosive-x-sampa (mapcar 'car ipa-x-sampa-implosive-submap))
+ (setq implosive-x-sampa (car (split-string implosive-x-sampa "_")))
+ (quail-defrule (format "%s_" implosive-x-sampa)
+ 'ipa-x-sampa-underscore-implosive))
+
+;;; ipa.el ends here
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
new file mode 100644
index 00000000000..7741697286b
--- /dev/null
+++ b/lisp/leim/quail/japanese.el
@@ -0,0 +1,553 @@
+;;; japanese.el --- Quail package for inputting Japanese -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Japanese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'kkc)
+
+(defvar quail-japanese-use-double-n nil
+ "If non-nil, use type \"nn\" to insert $B$s(B.")
+
+;; Update Quail translation region while considering Japanese bizarre
+;; translation rules.
+(defun quail-japanese-update-translation (control-flag)
+ (if (null control-flag)
+ (setq quail-current-str
+ (if (/= (aref quail-current-key 0) ?q)
+ (or quail-current-str quail-current-key)
+ ""))
+ (if (integerp control-flag)
+ (let ((keylen (length quail-current-key)))
+ (cond ((= control-flag 0)
+ (setq quail-current-str (aref quail-current-key 0)
+ control-flag t))
+ ((= (aref quail-current-key 0) ?n)
+ (setq quail-current-str ?$B$s(B)
+ (if (and quail-japanese-use-double-n
+ (> keylen 0)
+ (= (aref quail-current-key 1) ?n))
+ (setq control-flag t)))
+ ((and (> keylen 1)
+ (= (aref quail-current-key 0) (aref quail-current-key 1)))
+ (setq quail-current-str ?$B$C(B))
+ (t
+ (setq quail-current-str (aref quail-current-key 0))))
+ (if (integerp control-flag)
+ (setq unread-command-events
+ (append
+ (substring quail-current-key control-flag)
+ unread-command-events))))))
+ control-flag)
+
+;; Convert Hiragana <-> Katakana in the current translation region.
+(defun quail-japanese-toggle-kana ()
+ (interactive)
+ (setq quail-translating nil)
+ (let ((start (overlay-start quail-conv-overlay))
+ (end (overlay-end quail-conv-overlay)))
+ (save-excursion
+ (goto-char start)
+ (if (re-search-forward "\\cH" end t)
+ (japanese-katakana-region start end)
+ (japanese-hiragana-region start end)))
+ (setq quail-conversion-str
+ (buffer-substring (overlay-start quail-conv-overlay)
+ (overlay-end quail-conv-overlay)))))
+
+;; Convert Hiragana in the current translation region to Kanji by KKC
+;; (Kana Kanji Converter) utility.
+(defun quail-japanese-kanji-kkc ()
+ (interactive)
+ (when (= (char-before (overlay-end quail-conv-overlay)) ?n)
+ ;; The last char is `n'. We had better convert it to `$B$s(B'
+ ;; before kana-kanji conversion.
+ (goto-char (1- (overlay-end quail-conv-overlay)))
+ (insert ?$B$s(B)
+ (delete-char 1))
+ (let* ((from (copy-marker (overlay-start quail-conv-overlay)))
+ (len (- (overlay-end quail-conv-overlay) from)))
+ (quail-delete-overlays)
+ (setq quail-current-str nil)
+ (unwind-protect
+ (let ((result (kkc-region from (+ from len))))
+ (move-overlay quail-conv-overlay from (point))
+ (setq quail-conversion-str (buffer-substring from (point)))
+ (if (= (+ from result) (point))
+ (setq quail-converting nil))
+ (setq quail-translating nil))
+ (set-marker from nil))))
+
+(defun quail-japanese-self-insert-and-switch-to-alpha (key idx)
+ (quail-delete-region)
+ (push (aref key (1- idx)) unread-command-events)
+ (quail-japanese-switch-package "q" 1))
+
+(defvar quail-japanese-switch-table
+ '((?z . "japanese-zenkaku")
+ (?k . "japanese-hankaku-kana")
+ (?h . "japanese")
+ (?q . ("japanese-ascii"))))
+
+(defvar quail-japanese-package-saved nil)
+(make-variable-buffer-local 'quail-japanese-package-saved)
+(put 'quail-japanese-package-saved 'permanent-local t)
+
+(defun quail-japanese-switch-package (key idx)
+ (quail-delete-region)
+ (setq quail-current-str nil
+ quail-converting nil
+ quail-conversion-str "")
+ (let ((pkg (cdr (assq (aref key (1- idx)) quail-japanese-switch-table))))
+ (if (null pkg)
+ (quail-error "No package to be switched")
+ (if (stringp pkg)
+ (activate-input-method pkg)
+ (if (string= (car pkg) current-input-method)
+ (if quail-japanese-package-saved
+ (activate-input-method quail-japanese-package-saved))
+ (setq quail-japanese-package-saved current-input-method)
+ (activate-input-method (car pkg))))))
+ (throw 'quail-tag nil))
+
+(defvar quail-japanese-transliteration-rules
+ '(( "a" "$B$"(B") ( "i" "$B$$(B") ( "u" "$B$&(B") ( "e" "$B$((B") ( "o" "$B$*(B")
+ ("ka" "$B$+(B") ("ki" "$B$-(B") ("ku" "$B$/(B") ("ke" "$B$1(B") ("ko" "$B$3(B")
+ ("sa" "$B$5(B") ("si" "$B$7(B") ("su" "$B$9(B") ("se" "$B$;(B") ("so" "$B$=(B")
+ ("ta" "$B$?(B") ("ti" "$B$A(B") ("tu" "$B$D(B") ("te" "$B$F(B") ("to" "$B$H(B")
+ ("na" "$B$J(B") ("ni" "$B$K(B") ("nu" "$B$L(B") ("ne" "$B$M(B") ("no" "$B$N(B")
+ ("ha" "$B$O(B") ("hi" "$B$R(B") ("hu" "$B$U(B") ("he" "$B$X(B") ("ho" "$B$[(B")
+ ("ma" "$B$^(B") ("mi" "$B$_(B") ("mu" "$B$`(B") ("me" "$B$a(B") ("mo" "$B$b(B")
+ ("ya" "$B$d(B") ("yu" "$B$f(B") ("yo" "$B$h(B")
+ ("ra" "$B$i(B") ("ri" "$B$j(B") ("ru" "$B$k(B") ("re" "$B$l(B") ("ro" "$B$m(B")
+ ("la" "$B$i(B") ("li" "$B$j(B") ("lu" "$B$k(B") ("le" "$B$l(B") ("lo" "$B$m(B")
+ ("wa" "$B$o(B") ("wi" "$B$p(B") ("wu" "$B$&(B") ("we" "$B$q(B") ("wo" "$B$r(B")
+ ("n'" "$B$s(B")
+ ("ga" "$B$,(B") ("gi" "$B$.(B") ("gu" "$B$0(B") ("ge" "$B$2(B") ("go" "$B$4(B")
+ ("za" "$B$6(B") ("zi" "$B$8(B") ("zu" "$B$:(B") ("ze" "$B$<(B") ("zo" "$B$>(B")
+ ("da" "$B$@(B") ("di" "$B$B(B") ("du" "$B$E(B") ("de" "$B$G(B") ("do" "$B$I(B")
+ ("ba" "$B$P(B") ("bi" "$B$S(B") ("bu" "$B$V(B") ("be" "$B$Y(B") ("bo" "$B$\(B")
+ ("pa" "$B$Q(B") ("pi" "$B$T(B") ("pu" "$B$W(B") ("pe" "$B$Z(B") ("po" "$B$](B")
+
+ ("kya" ["$B$-$c(B"]) ("kyu" ["$B$-$e(B"]) ("kye" ["$B$-$'(B"]) ("kyo" ["$B$-$g(B"])
+ ("sya" ["$B$7$c(B"]) ("syu" ["$B$7$e(B"]) ("sye" ["$B$7$'(B"]) ("syo" ["$B$7$g(B"])
+ ("sha" ["$B$7$c(B"]) ("shu" ["$B$7$e(B"]) ("she" ["$B$7$'(B"]) ("sho" ["$B$7$g(B"])
+ ("cha" ["$B$A$c(B"]) ("chu" ["$B$A$e(B"]) ("che" ["$B$A$'(B"]) ("cho" ["$B$A$g(B"])
+ ("tya" ["$B$A$c(B"]) ("tyu" ["$B$A$e(B"]) ("tye" ["$B$A$'(B"]) ("tyo" ["$B$A$g(B"])
+ ("nya" ["$B$K$c(B"]) ("nyu" ["$B$K$e(B"]) ("nye" ["$B$K$'(B"]) ("nyo" ["$B$K$g(B"])
+ ("hya" ["$B$R$c(B"]) ("hyu" ["$B$R$e(B"]) ("hye" ["$B$R$'(B"]) ("hyo" ["$B$R$g(B"])
+ ("mya" ["$B$_$c(B"]) ("myu" ["$B$_$e(B"]) ("mye" ["$B$_$'(B"]) ("myo" ["$B$_$g(B"])
+ ("rya" ["$B$j$c(B"]) ("ryu" ["$B$j$e(B"]) ("rye" ["$B$j$'(B"]) ("ryo" ["$B$j$g(B"])
+ ("lya" ["$B$j$c(B"]) ("lyu" ["$B$j$e(B"]) ("lye" ["$B$j$'(B"]) ("lyo" ["$B$j$g(B"])
+ ("gya" ["$B$.$c(B"]) ("gyu" ["$B$.$e(B"]) ("gye" ["$B$.$'(B"]) ("gyo" ["$B$.$g(B"])
+ ("zya" ["$B$8$c(B"]) ("zyu" ["$B$8$e(B"]) ("zye" ["$B$8$'(B"]) ("zyo" ["$B$8$g(B"])
+ ("jya" ["$B$8$c(B"]) ("jyu" ["$B$8$e(B"]) ("jye" ["$B$8$'(B"]) ("jyo" ["$B$8$g(B"])
+ ( "ja" ["$B$8$c(B"]) ( "ju" ["$B$8$e(B"]) ( "je" ["$B$8$'(B"]) ( "jo" ["$B$8$g(B"])
+ ("bya" ["$B$S$c(B"]) ("byu" ["$B$S$e(B"]) ("bye" ["$B$S$'(B"]) ("byo" ["$B$S$g(B"])
+ ("pya" ["$B$T$c(B"]) ("pyu" ["$B$T$e(B"]) ("pye" ["$B$T$'(B"]) ("pyo" ["$B$T$g(B"])
+
+ ("kwa" ["$B$/$n(B"]) ("kwi" ["$B$/$#(B"]) ("kwe" ["$B$/$'(B"]) ("kwo" ["$B$/$)(B"])
+ ("tsa" ["$B$D$!(B"]) ("tsi" ["$B$D$#(B"]) ("tse" ["$B$D$'(B"]) ("tso" ["$B$D$)(B"])
+ ( "fa" ["$B$U$!(B"]) ( "fi" ["$B$U$#(B"]) ( "fe" ["$B$U$'(B"]) ( "fo" ["$B$U$)(B"])
+ ("gwa" ["$B$0$n(B"]) ("gwi" ["$B$0$#(B"]) ("gwe" ["$B$0$'(B"]) ("gwo" ["$B$0$)(B"])
+
+ ("dyi" ["$B$G$#(B"]) ("dyu" ["$B$I$%(B"]) ("dye" ["$B$G$'(B"]) ("dyo" ["$B$I$)(B"])
+ ("xwi" ["$B$&$#(B"]) ("xwe" ["$B$&$'(B"]) ("xwo" ["$B$&$)(B"])
+
+ ("shi" "$B$7(B") ("tyi" ["$B$F$#(B"]) ("chi" "$B$A(B") ("tsu" "$B$D(B") ("ji" "$B$8(B")
+ ("fu" "$B$U(B")
+ ("ye" ["$B$$$'(B"])
+
+ ("va" ["$B%t$!(B"]) ("vi" ["$B%t$#(B"]) ("vu" "$B%t(B") ("ve" ["$B%t$'(B"]) ("vo" ["$B%t$)(B"])
+
+ ("xa" "$B$!(B") ("xi" "$B$#(B") ("xu" "$B$%(B") ("xe" "$B$'(B") ("xo" "$B$)(B")
+ ("xtu" "$B$C(B") ("xya" "$B$c(B") ("xyu" "$B$e(B") ("xyo" "$B$g(B") ("xwa" "$B$n(B")
+ ("xka" "$B%u(B") ("xke" "$B%v(B")
+
+ ("1" "$B#1(B") ("2" "$B#2(B") ("3" "$B#3(B") ("4" "$B#4(B") ("5" "$B#5(B")
+ ("6" "$B#6(B") ("7" "$B#7(B") ("8" "$B#8(B") ("9" "$B#9(B") ("0" "$B#0(B")
+
+ ("!" "$B!*(B") ("@" "$B!w(B") ("#" "$B!t(B") ("$" "$B!p(B") ("%" "$B!s(B")
+ ("^" "$B!0(B") ("&" "$B!u(B") ("*" "$B!v(B") ("(" "$B!J(B") (")" "$B!K(B")
+ ("-" "$B!<(B") ("=" "$B!a(B") ("`" "$B!.(B") ("\\" "$B!o(B") ("|" "$B!C(B")
+ ("_" "$B!2(B") ("+" "$B!\(B") ("~" "$B!1(B") ("[" "$B!V(B") ("]" "$B!W(B")
+ ("{" "$B!P(B") ("}" "$B!Q(B") (":" "$B!'(B") (";" "$B!((B") ("\"" "$B!I(B")
+ ("'" "$B!G(B") ("." "$B!#(B") ("," "$B!"(B") ("<" "$B!c(B") (">" "$B!d(B")
+ ("?" "$B!)(B") ("/" "$B!?(B")
+
+ ("z1" "$B!{(B") ("z!" "$B!|(B")
+ ("z2" "$B"&(B") ("z@" "$B"'(B")
+ ("z3" "$B"$(B") ("z#" "$B"%(B")
+ ("z4" "$B""(B") ("z$" "$B"#(B")
+ ("z5" "$B!~(B") ("z%" "$B"!(B")
+ ("z6" "$B!y(B") ("z^" "$B!z(B")
+ ("z7" "$B!}(B") ("z&" "$B!r(B")
+ ("z8" "$B!q(B") ("z*" "$B!_(B")
+ ("z9" "$B!i(B") ("z(" "$B!Z(B")
+ ("z0" "$B!j(B") ("z)" "$B![(B")
+ ("z-" "$B!A(B") ("z_" "$B!h(B")
+ ("z=" "$B!b(B") ("z+" "$B!^(B")
+ ("z\\" "$B!@(B") ("z|" "$B!B(B")
+ ("z`" "$B!-(B") ("z~" "$B!/(B")
+
+ ("zq" "$B!T(B") ("zQ" "$B!R(B")
+ ("zw" "$B!U(B") ("zW" "$B!S(B")
+ ("zr" "$B!9(B") ("zR" "$B!8(B")
+ ("zt" "$B!:(B") ("zT" "$B!x(B")
+ ("zp" "$B")(B") ("zP" "$B",(B")
+ ("z[" "$B!X(B") ("z{" "$B!L(B")
+ ("z]" "$B!Y(B") ("z}" "$B!M(B")
+
+ ("zs" "$B!3(B") ("zS" "$B!4(B")
+ ("zd" "$B!5(B") ("zD" "$B!6(B")
+ ("zf" "$B!7(B") ("zF" "$B"*(B")
+ ("zg" "$B!>(B") ("zG" "$B!=(B")
+ ("zh" "$B"+(B")
+ ("zj" "$B"-(B")
+ ("zk" "$B",(B")
+ ("zl" "$B"*(B")
+ ("z;" "$B!+(B") ("z:" "$B!,(B")
+ ("z'" "$B!F(B") ("z\"" "$B!H(B")
+
+ ("zx" [":-"]) ("zX" [":-)"])
+ ("zc" "$B!;(B") ("zC" "$B!n(B")
+ ("zv" "$B"((B") ("zV" "$B!`(B")
+ ("zb" "$B!k(B") ("zB" "$B"+(B")
+ ("zn" "$B!l(B") ("zN" "$B"-(B")
+ ("zm" "$B!m(B") ("zM" "$B".(B")
+ ("z," "$B!E(B") ("z<" "$B!e(B")
+ ("z." "$B!D(B") ("z>" "$B!f(B")
+ ("z/" "$B!&(B") ("z?" "$B!g(B")
+
+ ("\\\\" quail-japanese-self-insert-and-switch-to-alpha)
+ ("{{" quail-japanese-self-insert-and-switch-to-alpha)
+ ("}}" quail-japanese-self-insert-and-switch-to-alpha)
+
+ ("qq" quail-japanese-switch-package)
+ ("qz" quail-japanese-switch-package)
+ ))
+
+
+;; $B%m!<%^;zF~NO5Z$S2>L>4A;zJQ49$K$h$kF|K\8lF~NO%a%=%C%I(B
+;;
+;; $B$3$NF~NO%a%=%C%I$G$NF|K\8l$NF~NO$OFs$D$N%9%F!<%8!V%m!<%^;z2>L>JQ49!W(B
+;; $B$H!V2>L>4A;zJQ49!W$+$i$J$k!#:G=i$O%m!<%^;z2>L>JQ49$N%9%F!<%8$G!"%9(B
+;; $B%Z!<%9%-!<$r2!$9$3$H$K$h$j!"<!$N%9%F!<%8!V2>L>4A;zJQ49!W$X?J$`!#(B
+;;
+;; $B!V%m!<%^;z2>L>JQ49!W(B
+;;
+;; $BJ?2>L>$O>.J8;z%-!<!JNs!K$rBG$D$3$H$K$h$jF~NO!#6gFIE@!"3g8LN`$OBP1~(B
+;; $B$9$k1Q;z%-!<$rBG$D$3$H$K$h$jF~NO!#$=$NB>$N%7%s%\%k$O(B `z' $B$KB3$1$F2?(B
+;; $B$l$+$N%-!<$rBG$D$3$H$K$h$jF~NO!#2<$KA4$F$N2DG=$J%-!<%7!<%1%s%9%j%9(B
+;; $B%H%"%C%W$5$l$F$$$k!#F~NO$5$l$?J8;z$O2<@~$G<($5$l$k!#(B
+;;
+;; $B$5$i$K0J2<$N%-!<$GFCJL$J=hM}$r9T$&!#(B
+;;
+;; K $BJ?2>L>$rJR2>L>$K!"$"$k$$$OJR2>L>$rJ?2>L>$KJQ49(B
+;; qq $B$3$NF~NO%a%=%C%I$H(B `japanese-ascii' $BF~NO%a%=%C%I$r%H%0%k@ZBX(B
+;; qz `japanese-zenkaku' $BF~NO%a%=%C%I$K%7%U%H(B
+;; qh $B$HBG$F$P85$KLa$k(B
+;; RET $B8=:_$NF~NOJ8;zNs$r3NDj(B
+;; SPC $B2>L>4A;zJQ49$K?J$`(B
+;;
+;; `japanese-ascii' $BF~NO%a%=%C%I$O(B ASCII $BJ8;z$rF~NO$9$k$N$K;H$&!#$3$l(B
+;; $B$OF~NO%a%=%C%I$r%*%U$K$9$k$N$H$[$H$s$IF1$8$G$"$k!#0[$J$k$N$O(B qq $B$H(B
+;; $BBG$D$3$H$K$h$j!"(B`japanese' $BF~NO%a%=%C%I$KLa$l$kE@$G$"$k!#(B
+;;
+;; `japanese-zenkaku' $BF~NO%a%=%C%I$OA43Q1Q?t;z$rF~NO$9$k$N$K;H$&!#(B
+;;
+;; $B!V%m!<%^;z2>L>JQ49!W%9%F!<%8$G$N%-!<%7!<%1%s%9$N%j%9%H$O:G8e$KIU$1(B
+;; $B$F$"$k!#(B
+;;
+;; $B!V2>L>4A;zJQ49!W(B
+;;
+;; $B$3$N%9%F!<%8$G$O!"A0%9%F!<%8$GF~NO$5$l$?J8;zNs$r2>L>4A;zJQ49$9$k!#(B
+;; $BJQ49$5$l$?J8;zNs$O!"CmL\J8@a!JH?E>I=<(!K$H;D$j$NF~NO!J2<@~I=<(!K$K(B
+;; $BJ,$1$i$l$k!#CmL\J8@a$KBP$7$F$O0J2<$N%3%^%s%I$,;H$($k!#(B
+;;
+;; SPC, C-n kkc-next
+;; $B<!$NJQ498uJd$rI=<((B
+;; kkc-show-conversion-list-count $B0J>eB3$1$FBG$F$P!"JQ498uJd%j%9(B
+;; $B%H$r%(%3!<%(%j%"$KI=<((B
+;; C-p kkc-prev
+;; $BA0$NJQ498uJd$rI=<((B
+;; kkc-show-conversion-list-count $B0J>eB3$1$FBG$F$P!"JQ498uJd%j%9(B
+;; $B%H$r%(%3!<%(%j%"$KI=<((B
+;; l kkc-show-conversion-list-or-next-group
+;; $B:G9b#1#08D$^$G$NJQ498uJd$r%(%3!<%(%j%"$KI=<(!#(B
+;; $BB3$1$FBG$?$l$l$P!"<!$N#1#08uJd$rI=<(!#(B
+;; L kkc-show-conversion-list-or-prev-group
+;; $B:G9b#1#08D$^$G$NJQ498uJd$r%(%3!<%(%j%"$KI=<(!#(B
+;; $BB3$1$FBG$?$l$l$P!"A0$N#1#08uJd$rI=<(!#(B
+;; 0..9 kkc-select-from-list
+;; $BBG$?$l$??t;z$NJQ498uJd$rA*Br(B
+;; H kkc-hiragana
+;; $BCmL\J8@a$rJ?2>L>$KJQ49(B
+;; K kkc-katakana
+;; $BCmL\J8@a$rJR2>L>$KJQ49(B
+;; C-o kkc-longer
+;; $BCmL\J8@a$r8e$m$K0lJ8;z?-$P$9(B
+;; C-i kkc-shorter
+;; $BCmL\J8@a$r8e$m$+$i0lJ8;z=L$a$k(B
+;; C-f kkc-next-phrase
+;; $BCmL\J8@a$r3NDj$5$;$k!#$b$7;D$j$NF~NO$,$^$@$"$l$P!":G=i$NJ8@a$r(B
+;; $BA*Br$7!"$=$l$rCmL\J8@a$H$7!"$=$N:G=i$NJQ498uJd$rI=<($9$k!#(B
+;; DEL, C-c kkc-cancel
+;; $B2>L>4A;zJQ49$r%-%c%s%;%k$7!"%m!<%^;z2>L>JQ49$N%9%F!<%8$KLa$k!#(B
+;; return kkc-terminate
+;; $BA4J8@a$r3NDj$5$;$k!#(B
+;; C-SPC, C-@ kkc-first-char-only
+;; $B:G=i$NJ8;z$r3NDj$5$;!";D$j$O:o=|$9$k!#(B
+;; C-h kkc-help
+;; $B$3$l$i$N%-!<%P%$%s%I$N%j%9%H$rI=<($9$k!#$"(B
+
+(quail-define-package
+ "japanese" "Japanese" "A$B$"(B"
+ nil
+ "Japanese input method by Roman transliteration and Kana-Kanji conversion.
+
+When you use this input method, text entry proceeds in two stages:
+Roman-Kana transliteration and Kana-Kanji conversion. When you start
+to enter text, you are in the first stage, Roman-Kana transliteration.
+Type SPC to proceed to the next stage, Kana-Kanji conversion.
+
+:: Roman-Kana transliteration ::
+
+You can input any Hiragana character as a sequence of lower-case
+letters, Japanese punctuation characters by typing punctuation keys,
+Japanese symbols by typing `z' followed by another key. See below for
+a list of all available sequences. The characters you input are
+underlined.
+
+In addition, the following keys provide special effects:
+
+K Change Hiragana to Katakana or Katakana to Hiragana.
+qq Toggle between this input method and the input method `japanese-ascii'.
+qz Shift to the input method `japanese-zenkaku'.
+ Typing \"qh\" will put you back to this input method.
+RET Accept the current character sequence.
+SPC Proceed to the next stage, Kana-Kanji conversion.
+
+The input method `japanese-ascii' is used to enter ASCII characters.
+This is almost the same as turning off the input method. The only
+difference is that typing `qq' will put you back into the Japanese
+input method.
+
+The input method `japanese-zenkaku' is used to enter full width
+JISX0208 characters corresponding to typed ASCII characters.
+
+List of the all key sequences for Roman-Kana transliteration is shown
+at the tail.
+
+:: Kana-Kanji conversion ::
+
+You can convert the current Japanese characters (underlined) to
+Kana-Kanji mixed text. In this stage, the converted text is divided
+into two parts, the current phrase (highlighted) and the remaining
+input (underlined). The following commands can be used on the
+current phrase.
+
+SPC, C-n kkc-next
+ Show the next candidate for the current phrase.
+ If successively typed `kkc-show-conversion-list-count' times,
+ conversion candidates are shown in the echo area.
+C-p kkc-prev
+ Show the previous candidate for the current phrase.
+ If successively typed `kkc-show-conversion-list-count' times,
+ conversion candidates are shown in the echo area.
+l kkc-show-conversion-list-or-next-group
+ Show at most 10 candidates for the current phrase in echo area.
+ If typed repeatedly, show the next 10 candidates.
+L kkc-show-conversion-list-or-prev-group
+ Show at most 10 candidates for the current phrase in echo area.
+ If typed repeatedly, show the previous 10 candidates.
+0..9 kkc-select-from-list
+ Select a candidate corresponding to the typed number.
+H kkc-hiragana
+ Convert the current phrase to Hiragana
+K kkc-katakana
+ Convert the current phrase to Katakana
+C-o kkc-longer
+ Extend the current phrase; pull in the first character of
+ the remaining input.
+C-i kkc-shorter
+ Contract the current phrase; drop its last character
+ back into the remaining input.
+C-f kkc-next-phrase
+ Accept the current phrase. If there remains input, select
+ the first phrase as the current one, and show the first
+ candidate for the conversion.
+DEL, C-c kkc-cancel
+ Cancel the conversion, shift back to the Roman-Kana
+ transliteration.
+return kkc-terminate
+ Accept the whole conversion.
+C-SPC, C-@ kkc-first-char-only
+ Accept the first character of the current conversion,
+ delete the remaining input.
+C-h kkc-help
+ List these key bindings.
+"
+ nil t t nil nil nil nil nil
+ 'quail-japanese-update-translation
+ '(("K" . quail-japanese-toggle-kana)
+ (" " . quail-japanese-kanji-kkc)
+ ("\C-m" . quail-no-conversion)
+ ([return] . quail-no-conversion))
+ )
+
+(dolist (elt quail-japanese-transliteration-rules)
+ (quail-defrule (car elt) (nth 1 elt)))
+
+(quail-define-package
+ "japanese-ascii" "Japanese" "Aa"
+ nil
+ "Temporary ASCII input mode used within the input method `japanese'.
+Type \"qq\" to go back to previous input method."
+ nil t t)
+
+(quail-define-rules ("qq" quail-japanese-switch-package))
+
+(quail-define-package
+ "japanese-zenkaku" "Japanese" "$B#A(B"
+ nil
+ "Japanese zenkaku alpha numeric character input method.
+---- Special key bindings ----
+qq: toggle between this input method and the input method `japanese-ascii'.
+qh: shift to the input method `japanese',
+ typing \"qz\" puts you back to this input method.
+"
+ nil t t)
+
+(quail-define-rules
+
+(" " "$B!!(B") ("!" "$B!*(B") ("\"" "$B!m(B") ("#" "$B!t(B")
+("$" "$B!p(B") ("%" "$B!s(B") ("&" "$B!u(B") ("'" "$B!l(B")
+("(" "$B!J(B") (")" "$B!K(B") ("*" "$B!v(B") ("+" "$B!\(B")
+("," "$B!$(B") ("-" "$B!](B") ("." "$B!%(B") ("/" "$B!?(B")
+("0" "$B#0(B") ("1" "$B#1(B") ("2" "$B#2(B") ("3" "$B#3(B")
+("4" "$B#4(B") ("5" "$B#5(B") ("6" "$B#6(B") ("7" "$B#7(B")
+("8" "$B#8(B") ("9" "$B#9(B") (":" "$B!'(B") (";" "$B!((B")
+("<" "$B!c(B") ("=" "$B!a(B") (">" "$B!d(B") ("?" "$B!)(B")
+("@" "$B!w(B") ("A" "$B#A(B") ("B" "$B#B(B") ("C" "$B#C(B")
+("D" "$B#D(B") ("E" "$B#E(B") ("F" "$B#F(B") ("G" "$B#G(B")
+("H" "$B#H(B") ("I" "$B#I(B") ("J" "$B#J(B") ("K" "$B#K(B")
+("L" "$B#L(B") ("M" "$B#M(B") ("N" "$B#N(B") ("O" "$B#O(B")
+("P" "$B#P(B") ("Q" "$B#Q(B") ("R" "$B#R(B") ("S" "$B#S(B")
+("T" "$B#T(B") ("U" "$B#U(B") ("V" "$B#V(B") ("W" "$B#W(B")
+("X" "$B#X(B") ("Y" "$B#Y(B") ("Z" "$B#Z(B") ("[" "$B!N(B")
+("\\" "$B!o(B") ("]" "$B!O(B") ("^" "$B!0(B") ("_" "$B!2(B")
+("`" "$B!F(B") ("a" "$B#a(B") ("b" "$B#b(B") ("c" "$B#c(B")
+("d" "$B#d(B") ("e" "$B#e(B") ("f" "$B#f(B") ("g" "$B#g(B")
+("h" "$B#h(B") ("i" "$B#i(B") ("j" "$B#j(B") ("k" "$B#k(B")
+("l" "$B#l(B") ("m" "$B#m(B") ("n" "$B#n(B") ("o" "$B#o(B")
+("p" "$B#p(B") ("q" "$B#q(B") ("r" "$B#r(B") ("s" "$B#s(B")
+("t" "$B#t(B") ("u" "$B#u(B") ("v" "$B#v(B") ("w" "$B#w(B")
+("x" "$B#x(B") ("y" "$B#y(B") ("z" "$B#z(B") ("{" "$B!P(B")
+("|" "$B!C(B") ("}" "$B!Q(B") ("~" "$B!A(B")
+
+("qq" quail-japanese-switch-package)
+("qh" quail-japanese-switch-package)
+)
+
+(defun quail-japanese-hankaku-update-translation (control-flag)
+ (setq control-flag
+ (quail-japanese-update-translation control-flag))
+ (if (or (and (stringp quail-current-str)
+ (> (length quail-current-str) 0))
+ (integerp quail-current-str))
+ (setq quail-current-str (japanese-hankaku quail-current-str)))
+ control-flag)
+
+(quail-define-package
+ "japanese-hankaku-kana"
+ "Japanese" "(I1(B"
+ nil
+ "Japanese hankaku katakana input method by Roman transliteration.
+---- Special key bindings ----
+qq: toggle between this input method and the input method `japanese-ascii'.
+"
+ nil t t nil nil nil nil nil
+ 'quail-japanese-hankaku-update-translation)
+
+(dolist (elt quail-japanese-transliteration-rules)
+ (quail-defrule (car elt)
+ (let ((trans (nth 1 elt)))
+ (when (or (stringp trans) (vectorp trans))
+ (let ((s (japanese-hankaku (if (stringp trans)
+ trans
+ (aref trans 0)))))
+ ;; If the result of the conversion is a string
+ ;; containing more than one character, make the
+ ;; result a vector, so that quail-defrule
+ ;; recognizes the whole string is the
+ ;; translation, instead of interpreting
+ ;; individual characters as alternative
+ ;; translations.
+ (if (and (stringp s) (> (length s) 1))
+ (setq trans (vector s))
+ (setq trans s))))
+ trans)))
+
+(quail-define-package
+ "japanese-hiragana" "Japanese" "$B$"(B"
+ nil
+ "Japanese hiragana input method by Roman transliteration."
+ nil t t nil nil nil nil nil
+ 'quail-japanese-update-translation)
+
+;; Use the same map as that of `japanese'.
+(setcar (cdr (cdr quail-current-package))
+ (nth 2 (assoc "japanese" quail-package-alist)))
+
+;; Update Quail translation region while converting Hiragana to Katakana.
+(defun quail-japanese-katakana-update-translation (control-flag)
+ (setq control-flag
+ (quail-japanese-update-translation control-flag))
+ (if (or (and (stringp quail-current-str)
+ (> (length quail-current-str) 0))
+ (integerp quail-current-str))
+ (setq quail-current-str (japanese-katakana quail-current-str)))
+ control-flag)
+
+(quail-define-package
+ "japanese-katakana" "Japanese" "$B%"(B"
+ nil
+ "Japanese katakana input method by Roman transliteration."
+ nil t t nil nil nil nil nil
+ 'quail-japanese-katakana-update-translation)
+
+(dolist (elt quail-japanese-transliteration-rules)
+ (quail-defrule (car elt)
+ (let ((trans (nth 1 elt)))
+ (cond ((stringp trans)
+ (japanese-katakana trans))
+ ((vectorp trans)
+ (vector (japanese-katakana (aref trans 0))))
+ (t trans)))))
+
+;;; japanese.el ends here
diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el
new file mode 100644
index 00000000000..14cf9268287
--- /dev/null
+++ b/lisp/leim/quail/lao.el
@@ -0,0 +1,214 @@
+;;; lao.el --- Quail package for inputting Lao characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Lao
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'lao-util)
+
+(defun quail-lao-update-translation (control-flag)
+ (if (integerp control-flag)
+ ;; Non-composable character typed.
+ (setq quail-current-str
+ (buffer-substring (overlay-start quail-overlay)
+ (overlay-end quail-overlay))
+ unread-command-events
+ (append
+ (substring quail-current-key control-flag)
+ unread-command-events))
+ (setq quail-current-str
+ (compose-string (quail-lookup-map-and-concat quail-current-key))))
+ control-flag)
+
+(defvar lao-key-alist
+ '(("!" . "1")
+ ("\"" . "=")
+ ("#" . "3")
+ ("$" . "4")
+ ("&" . "5")
+ ("%" . "໌")
+ ("'" . "ງ")
+ ("(" . "7")
+ (")" . "8")
+ ("*" . "6")
+ ("+" . ["ໍ່"])
+ ("," . "ມ")
+ ("-" . "ຊ")
+ ("." . "ໃ")
+ ("/" . "ຝ")
+ ("0" . "ຂ")
+ ("1" . "ຢ")
+ ("2" . "ຟ")
+ ("3" . "ໂ")
+ ("4" . "ຖ")
+ ("5" . "ຸ")
+ ("6" . "ູ")
+ ("7" . "ຄ")
+ ("8" . "ຕ")
+ ("9" . "ຈ")
+ (":" . "%")
+ (";" . "ວ")
+ ("<" . "ໝ")
+ ("=" . "ໍ")
+ (">" . "$")
+ ("?" . ")")
+ ("@" . "2")
+ ("A" . ["ັ້"])
+ ("B" . ["ຶ້"])
+ ("C" . "ຯ")
+ ("D" . ".")
+ ("E" . ["ຳ້"])
+ ("F" . ",")
+ ("G" . ":")
+ ("H" . "໊")
+ ("I" . "ຮ")
+ ("J" . "໋")
+ ("K" . "!")
+ ("L" . "?")
+ ("M" . "ໆ")
+ ("N" . ["ື້"])
+ ("O" . "ໜ")
+ ("P" . "ຽ")
+ ("Q" . ["ົ້"])
+ ("R" . "_")
+ ("S" . ";")
+ ("T" . "+")
+ ("U" . ["ີ້"])
+ ("V" . "x")
+ ("W" . "0")
+ ("X" . "(")
+ ("Y" . ["ິ້"])
+ ("Z" . "\"")
+ ("[" . "ບ")
+ ("]" . "ລ")
+ ("^" . "ຼ")
+ ("_" . "9")
+ ("`" . "ງ")
+ ("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" . "໐")
+ ("\\1" . "໑")
+ ("\\2" . "໒")
+ ("\\3" . "໓")
+ ("\\4" . "໔")
+ ("\\5" . "໕")
+ ("\\6" . "໖")
+ ("\\7" . "໗")
+ ("\\8" . "໘")
+ ("\\9" . "໙")
+ )
+ "Alist of key sequences vs the corresponding Lao string to input.
+This variable is for the input method \"lao\".
+If you change the value of this variable while quail/lao is already loaded,
+you need to re-load it to properly re-initialize related alists.")
+
+;; Temporary variable to initialize lao-consonant-key-alist, etc.
+(defconst lao-key-alist-vector
+ (let ((tail lao-key-alist)
+ consonant-key-alist semivowel-key-alist vowel-key-alist
+ voweltone-key-alist tone-key-alist other-key-alist
+ elt phonetic-type)
+ (while tail
+ (setq elt (car tail) tail (cdr tail))
+ (if (stringp (cdr elt))
+ (setq phonetic-type (get-char-code-property (aref (cdr elt) 0)
+ 'phonetic-type))
+ (setq phonetic-type (get-char-code-property (aref (aref (cdr elt) 0) 0)
+ 'phonetic-type))
+ (aset (cdr elt) 0 (compose-string (aref (cdr elt) 0))))
+ (cond ((eq phonetic-type 'consonant)
+ (setq consonant-key-alist (cons elt consonant-key-alist)))
+ ((memq phonetic-type '(vowel-upper vowel-lower))
+ (if (stringp (cdr elt))
+ (setq vowel-key-alist (cons elt vowel-key-alist))
+ (setq voweltone-key-alist (cons elt voweltone-key-alist))))
+ ((eq phonetic-type 'tone)
+ (setq tone-key-alist (cons elt tone-key-alist)))
+ ((eq phonetic-type 'semivowel-lower)
+ (setq semivowel-key-alist (cons elt semivowel-key-alist)))
+ (t
+ (setq other-key-alist (cons elt other-key-alist)))))
+ (vector consonant-key-alist semivowel-key-alist vowel-key-alist
+ voweltone-key-alist tone-key-alist other-key-alist)))
+
+(defconst lao-consonant-key-alist (aref lao-key-alist-vector 0))
+(defconst lao-semivowel-key-alist (aref lao-key-alist-vector 1))
+(defconst lao-vowel-key-alist (aref lao-key-alist-vector 2))
+(defconst lao-voweltone-key-alist (aref lao-key-alist-vector 3))
+(defconst lao-tone-key-alist (aref lao-key-alist-vector 4))
+(defconst lao-other-key-alist (aref lao-key-alist-vector 5))
+
+;; Done with it.
+(makunbound 'lao-key-alist-vector)
+
+(quail-define-package
+ "lao" "Lao" "ລ" t
+ "Lao input method simulating Lao keyboard layout based on Thai TIS620"
+ nil t t t t nil nil nil 'quail-lao-update-translation nil t)
+
+(quail-install-map
+ (quail-map-from-table
+ '((base-state (lao-consonant-key-alist . svt-state)
+ lao-vowel-key-alist
+ lao-voweltone-key-alist
+ lao-tone-key-alist
+ lao-other-key-alist)
+ (svt-state (lao-semivowel-key-alist . v-state)
+ (lao-vowel-key-alist . t-state)
+ lao-voweltone-key-alist
+ lao-tone-key-alist)
+ (v-state (lao-vowel-key-alist . t-state))
+ (t-state lao-tone-key-alist))))
+
+;;; lao.el ends here
diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el
new file mode 100644
index 00000000000..a0697c48f7d
--- /dev/null
+++ b/lisp/leim/quail/latin-alt.el
@@ -0,0 +1,1722 @@
+;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, latin
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; Author (of latin-post.el): TAKAHASHI Naoto <ntakahas@etl.go.jp>
+
+;;; Commentary:
+
+;; These input methods differ from those in latin-post.el
+;; in that comma is not special (use / instead),
+;; and // is not special either (so you can enter a slash
+;; by typing //).
+
+;; At least, that's what I could see by comparing the first few
+;; of these with latin-post.el.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "latin-1-alt-postfix" "Latin-1" "1<" t
+ "Latin-1 character input method with postfix modifiers
+This input method differs from `latin-1-postfix' in that
+comma is not special (use slash instead), and `//' is not
+special (so you can use that to enter a slash).
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | / | c/ -> ç
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | /<> | s/ -> ß ?/ -> ¿ !/ -> ¡
+ | various | << -> « >> -> » o_ -> º a_ -> ª
+
+It seems natural to use comma for cedillas, but that is
+inconvenient in practice because commas are needed very
+often after a letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Å)
+ ("a`" ?à)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?å)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("E/" ?Æ)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("e/" ?æ)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Í)
+ ("i'" ?í)
+ ("I^" ?Î)
+ ("i^" ?î)
+ ("I\"" ?Ï)
+ ("i\"" ?ï)
+ ("O`" ?Ò)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("O~" ?Õ)
+ ("o~" ?õ)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("O/" ?Ø)
+ ("o/" ?ø)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U^" ?Û)
+ ("u^" ?û)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("Y'" ?Ý)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("D/" ?Ð)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
+ ("s/" ?ß)
+ ("C/" ?Ç)
+ ("c/" ?ç)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
+
+ ("A``" ["A`"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("A\"\"" ["A\""])
+ ("A//" ["A/"])
+ ("a``" ["a`"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("a\"\"" ["a\""])
+ ("a//" ["a/"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("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\""])
+ ("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/"])
+ ("U``" ["U`"])
+ ("u``" ["u`"])
+ ("U''" ["U'"])
+ ("u''" ["u'"])
+ ("U^^" ["U^"])
+ ("u^^" ["u^"])
+ ("U\"\"" ["U\""])
+ ("u\"\"" ["u\""])
+ ("Y''" ["Y'"])
+ ("y''" ["y'"])
+ ("y\"\"" ["y\""])
+ ("D//" ["D/"])
+ ("d//" ["d/"])
+ ("T//" ["T/"])
+ ("t//" ["t/"])
+ ("s//" ["s/"])
+ ("C//" ["C/"])
+ ("c//" ["c/"])
+ ("N~~" ["N~"])
+ ("n~~" ["n~"])
+ ("?//" ["?/"])
+ ("!//" ["!/"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("o__" ["o_"])
+ ("a__" ["a_"])
+ )
+
+(quail-define-package
+ "latin-2-alt-postfix" "Latin-2" "2<" t
+ "Latin-2 character input method with postfix modifiers
+This input method differs from `latin-2-postfix' in that
+comma and period are not special (use \\=` instead).
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ ogonek | \\=` | a\\=` -> ą
+ diaeresis | \" | a\" -> ä
+ circumflex | ^ | a^ -> â
+ breve | ~ | a~ -> ă
+ cedilla | \\=` | c\\=` -> ç
+ caron | ~ | c~ -> č
+ dbl. acute | : | o: -> ő
+ ring | \\=` | u\\=` -> ů
+ dot | \\=` | z\\=` -> ż
+ stroke | / | d/ -> đ
+ others | / | s/ -> ß
+
+It seems natural to use period and comma for dots/rings and
+cedillas/ogoneks, but that is inconvenient in practice, because
+periods and commas are needed very often after a letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("A`" ?Ą)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A~" ?Ă)
+ ("C'" ?Ć)
+ ("C`" ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Đ)
+ ("D~" ?Ď)
+ ("E'" ?É)
+ ("E`" ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Ě)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("L'" ?Ĺ)
+ ("L/" ?Ł)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O:" ?Ő)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("R'" ?Ŕ)
+ ("R~" ?Ř)
+ ("S'" ?Ś)
+ ("S`" ?Ş)
+ ("S~" ?Š)
+ ("T`" ?Ţ)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U:" ?Ű)
+ ("U\"" ?Ü)
+ ("U`" ?Ů)
+ ("Y'" ?Ý)
+ ("Z'" ?Ź)
+ ("Z`" ?Ż)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a`" ?ą)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c`" ?ç)
+ ("c~" ?č)
+ ("d/" ?đ)
+ ("d~" ?ď)
+ ("e'" ?é)
+ ("e`" ?ę)
+ ("e\"" ?ë)
+ ("e~" ?ě)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("l'" ?ĺ)
+ ("l/" ?ł)
+ ("l~" ?ľ)
+ ("n'" ?ń)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o:" ?ő)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("r'" ?ŕ)
+ ("r~" ?ř)
+ ("s'" ?ś)
+ ("s`" ?ş)
+ ("s/" ?ß)
+ ("s~" ?š)
+ ("t`" ?ţ)
+ ("t~" ?ť)
+ ("u'" ?ú)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u`" ?ů)
+ ("y'" ?ý)
+ ("z'" ?ź)
+ ("z`" ?ż)
+ ("z~" ?ž)
+
+ ("A''" ["A'"])
+ ("A``" ["A`"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("C''" ["C'"])
+ ("C``" ["C`"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("D~~" ["D~"])
+ ("E''" ["E'"])
+ ("E``" ["E`"])
+ ("E\"\"" ["E\""])
+ ("E~~" ["E~"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("L''" ["L'"])
+ ("L//" ["L/"])
+ ("L~~" ["L~"])
+ ("N''" ["N'"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O::" ["O:"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("R''" ["R'"])
+ ("R~~" ["R~"])
+ ("S''" ["S'"])
+ ("S``" ["S`"])
+ ("S~~" ["S~"])
+ ("T``" ["T`"])
+ ("T~~" ["T~"])
+ ("U''" ["U'"])
+ ("U::" ["U:"])
+ ("U\"\"" ["U\""])
+ ("U``" ["U`"])
+ ("Y''" ["Y'"])
+ ("Z''" ["Z'"])
+ ("Z``" ["Z`"])
+ ("Z~~" ["Z~"])
+ ("a''" ["a'"])
+ ("a``" ["a`"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("c''" ["c'"])
+ ("c``" ["c`"])
+ ("c~~" ["c~"])
+ ("d//" ["d/"])
+ ("d~~" ["d~"])
+ ("e''" ["e'"])
+ ("e``" ["e`"])
+ ("e\"\"" ["e\""])
+ ("e~~" ["e~"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("l''" ["l'"])
+ ("l//" ["l/"])
+ ("l~~" ["l~"])
+ ("n''" ["n'"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o::" ["o:"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("r''" ["r'"])
+ ("r~~" ["r~"])
+ ("s''" ["s'"])
+ ("s``" ["s`"])
+ ("s//" ["s/"])
+ ("s~~" ["s~"])
+ ("t``" ["t`"])
+ ("t~~" ["t~"])
+ ("u''" ["u'"])
+ ("u::" ["u:"])
+ ("u\"\"" ["u\""])
+ ("u``" ["u`"])
+ ("y''" ["y'"])
+ ("z''" ["z'"])
+ ("z``" ["z`"])
+ ("z~~" ["z~"])
+ )
+
+(quail-define-package
+ "latin-3-alt-postfix" "Latin-3" "3<" t
+ "Latin-3 character input method with postfix modifiers
+This input method differs from `latin-3-postfix' in that
+comma is not special (use \\=` instead), and period is not
+special (use slash instead).
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ dot | / | c/ -> ċ i/ -> ı I/ -> İ
+ cedilla | \\=` | c\\=` -> ç
+ breve | ~ | g~ -> ğ
+ tilde | ~ | n~ -> ñ
+ stroke | / | h/ -> ħ
+ others | / | s/ -> ß
+
+It would be natural to use period and comma for dots and cedillas, but
+that would inconvenient in practice, because periods and commas are
+needed very often after a letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A\"" ?Ä)
+ ("C/" ?Ċ)
+ ("C^" ?Ĉ)
+ ("C`" ?Ç)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("G~" ?Ğ)
+ ("G/" ?Ġ)
+ ("G^" ?Ĝ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I/" ?İ)
+ ("I`" ?Ì)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("I\"" ?Ï)
+ ("J^" ?Ĵ)
+ ("N~" ?Ñ)
+ ("O`" ?Ò)
+ ("O'" ?Ó)
+ ("O^" ?Ô)
+ ("O\"" ?Ö)
+ ("S`" ?Ş)
+ ("S^" ?Ŝ)
+ ("U`" ?Ù)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ŭ)
+ ("Z/" ?Ż)
+ ("a`" ?à)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a\"" ?ä)
+ ("c/" ?ċ)
+ ("c^" ?ĉ)
+ ("c`" ?ç)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("g~" ?ğ)
+ ("g/" ?ġ)
+ ("g^" ?ĝ)
+ ("h/" ?ħ)
+ ("h^" ?ĥ)
+ ("i/" ?ı)
+ ("i`" ?ì)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("j^" ?ĵ)
+ ("n~" ?ñ)
+ ("o`" ?ò)
+ ("o'" ?ó)
+ ("o^" ?ô)
+ ("o\"" ?ö)
+ ("s`" ?ş)
+ ("s/" ?ß)
+ ("s^" ?ŝ)
+ ("u`" ?ù)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?ŭ)
+ ("z/" ?ż)
+
+ ("A``" ["A`"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A\"\"" ["A\""])
+ ("C//" ["C/"])
+ ("C^^" ["C^"])
+ ("C``" ["C`"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("E\"\"" ["E\""])
+ ("G~~" ["G~"])
+ ("G//" ["G/"])
+ ("G^^" ["G^"])
+ ("H//" ["H/"])
+ ("H^^" ["H^"])
+ ("I//" ["I/"])
+ ("I``" ["I`"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("I\"\"" ["I\""])
+ ("J^^" ["J^"])
+ ("N~~" ["N~"])
+ ("O``" ["O`"])
+ ("O''" ["O'"])
+ ("O^^" ["O^"])
+ ("O\"\"" ["O\""])
+ ("S``" ["S`"])
+ ("S^^" ["S^"])
+ ("U``" ["U`"])
+ ("U''" ["U'"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("U~~" ["U~"])
+ ("Z//" ["Z/"])
+ ("a``" ["a`"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a\"\"" ["a\""])
+ ("c//" ["c/"])
+ ("c^^" ["c^"])
+ ("c``" ["c`"])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("e^^" ["e^"])
+ ("e\"\"" ["e\""])
+ ("g~~" ["g~"])
+ ("g//" ["g/"])
+ ("g^^" ["g^"])
+ ("h//" ["h/"])
+ ("h^^" ["h^"])
+ ("i//" ["i/"])
+ ("i``" ["i`"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("i\"\"" ["i\""])
+ ("j^^" ["j^"])
+ ("n~~" ["n~"])
+ ("o``" ["o`"])
+ ("o''" ["o'"])
+ ("o^^" ["o^"])
+ ("o\"\"" ["o\""])
+ ("s``" ["s`"])
+ ("s//" ["s/"])
+ ("s^^" ["s^"])
+ ("u``" ["u`"])
+ ("u''" ["u'"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("u~~" ["u~"])
+ ("z//" ["z/"])
+ )
+
+(quail-define-package
+ "latin-4-alt-postfix" "Latin-4" "4<" t
+ "Latin-4 characters input method with postfix modifiers
+This input method differs from `latin-4-postfix' in that
+comma is not special (use \\=` instead), and period is not
+special (use ~ instead).
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ ogonek | \\=` | a\\=` -> ą
+ macron | - | a- -> ā
+ tilde | ~ | a~ -> ã
+ caron | ~ | c~ -> č
+ dot | ~ | e~ -> ė
+ cedilla | \\=` | k\\=` -> ķ g\\=` -> ģ
+ stroke | / | d/ -> đ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß n/ -> ŋ k/ -> ĸ
+
+It seems natural to use period and comma for dots and
+cedillas/ogoneks, but that is inconvenient in practice, because
+periods and commas are needed very often after a letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?Ą)
+ ("A-" ?Ā)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Å)
+ ("C~" ?Č)
+ ("D/" ?Đ)
+ ("E/" ?Æ)
+ ("E-" ?Ē)
+ ("E'" ?É)
+ ("E`" ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Ė)
+ ("G`" ?Ģ)
+ ("I~" ?Ĩ)
+ ("I`" ?Į)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("I-" ?Ī)
+ ("K`" ?Ķ)
+ ("L`" ?Ļ)
+ ("N/" ?Ŋ)
+ ("N`" ?Ņ)
+ ("O-" ?Ō)
+ ("O^" ?Ô)
+ ("O~" ?Õ)
+ ("O\"" ?Ö)
+ ("O/" ?Ø)
+ ("R`" ?Ŗ)
+ ("S~" ?Š)
+ ("T/" ?Ŧ)
+ ("U`" ?Ų)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ũ)
+ ("U-" ?Ū)
+ ("Z~" ?Ž)
+ ("a`" ?ą)
+ ("a-" ?ā)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?å)
+ ("c~" ?č)
+ ("d/" ?đ)
+ ("e/" ?æ)
+ ("e-" ?ē)
+ ("e'" ?é)
+ ("e`" ?ę)
+ ("e\"" ?ë)
+ ("e~" ?ė)
+ ("g`" ?ģ)
+ ("i~" ?ĩ)
+ ("i`" ?į)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("i-" ?ī)
+ ("k/" ?ĸ)
+ ("k`" ?ķ)
+ ("l`" ?ļ)
+ ("n/" ?ŋ)
+ ("n`" ?ņ)
+ ("o-" ?ō)
+ ("o^" ?ô)
+ ("o~" ?õ)
+ ("o\"" ?ö)
+ ("o/" ?ø)
+ ("r`" ?ŗ)
+ ("s/" ?ß)
+ ("s~" ?š)
+ ("t/" ?ŧ)
+ ("u`" ?ų)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?ũ)
+ ("u-" ?ū)
+ ("z~" ?ž)
+
+ ("A``" ["A`"])
+ ("A--" ["A-"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("A\"\"" ["A\""])
+ ("A//" ["A/"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("E//" ["E/"])
+ ("E--" ["E-"])
+ ("E''" ["E'"])
+ ("E``" ["E`"])
+ ("E\"\"" ["E\""])
+ ("E~~" ["E~"])
+ ("G``" ["G`"])
+ ("I~~" ["I~"])
+ ("I``" ["I`"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("I--" ["I-"])
+ ("K``" ["K`"])
+ ("L``" ["L`"])
+ ("N//" ["N/"])
+ ("N``" ["N`"])
+ ("O--" ["O-"])
+ ("O^^" ["O^"])
+ ("O~~" ["O~"])
+ ("O\"\"" ["O\""])
+ ("O//" ["O/"])
+ ("R``" ["R`"])
+ ("S~~" ["S~"])
+ ("T//" ["T/"])
+ ("U``" ["U`"])
+ ("U''" ["U'"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("U~~" ["U~"])
+ ("U--" ["U-"])
+ ("Z~~" ["Z~"])
+ ("a``" ["a`"])
+ ("a--" ["a-"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("a\"\"" ["a\""])
+ ("a//" ["a/"])
+ ("c~~" ["c~"])
+ ("d//" ["d/"])
+ ("e//" ["e/"])
+ ("e--" ["e-"])
+ ("e''" ["e'"])
+ ("e``" ["e`"])
+ ("e\"\"" ["e\""])
+ ("e~~" ["e~"])
+ ("g``" ["g`"])
+ ("i~~" ["i~"])
+ ("i``" ["i`"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("i--" ["i-"])
+ ("k//" ["k/"])
+ ("k``" ["k`"])
+ ("l``" ["l`"])
+ ("n//" ["n/"])
+ ("n``" ["n`"])
+ ("o--" ["o-"])
+ ("o^^" ["o^"])
+ ("o~~" ["o~"])
+ ("o\"\"" ["o\""])
+ ("o//" ["o/"])
+ ("r``" ["r`"])
+ ("s//" ["s/"])
+ ("s~~" ["s~"])
+ ("t//" ["t/"])
+ ("u``" ["u`"])
+ ("u''" ["u'"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("u~~" ["u~"])
+ ("u--" ["u-"])
+ ("z~~" ["z~"])
+ )
+
+(quail-define-package
+ "latin-5-alt-postfix" "Latin-5" "5<" t
+ "Latin-5 characters input method with postfix modifiers
+This input method differs from `latin-5-postfix' in that
+comma is not special (use \\=` instead), and period is not
+special (use / instead).
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ breve | ~ | g~ -> ğ
+ cedilla | \\=` | c\\=` -> ç
+ dot | / | i/ -> ı I/ -> İ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß
+
+It seems natural to use period and comma for dots and cedillas, but
+that is inconvenient in practice, because periods and commas are
+needed very often after a letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("A/" ?Å)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("C`" ?Ç)
+ ("E'" ?É)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("G~" ?Ğ)
+ ("I'" ?Í)
+ ("I/" ?İ)
+ ("I\"" ?Ï)
+ ("I^" ?Î)
+ ("I`" ?Ì)
+ ("N~" ?Ñ)
+ ("O'" ?Ó)
+ ("O/" ?Ø)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ò)
+ ("O~" ?Õ)
+ ("S`" ?Ş)
+ ("U'" ?Ú)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("a'" ?á)
+ ("a/" ?å)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a`" ?à)
+ ("a~" ?ã)
+ ("c`" ?ç)
+ ("e'" ?é)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("g~" ?ğ)
+ ("i'" ?í)
+ ("i/" ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("n~" ?ñ)
+ ("o'" ?ó)
+ ("o/" ?ø)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("s`" ?ş)
+ ("s/" ?ß)
+ ("u'" ?ú)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("y\"" ?ÿ)
+
+ ("A''" ["A'"])
+ ("A//" ["A/"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A``" ["A`"])
+ ("A~~" ["A~"])
+ ("C``" ["C`"])
+ ("E''" ["E'"])
+ ("E//" ["E/"])
+ ("E\"\"" ["E\""])
+ ("E^^" ["E^"])
+ ("E``" ["E`"])
+ ("G~~" ["G~"])
+ ("I''" ["I'"])
+ ("I//" ["I/"])
+ ("I\"\"" ["I\""])
+ ("I^^" ["I^"])
+ ("I``" ["I`"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O//" ["O/"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("O``" ["O`"])
+ ("O~~" ["O~"])
+ ("S``" ["S`"])
+ ("U''" ["U'"])
+ ("U\"\"" ["U\""])
+ ("U^^" ["U^"])
+ ("U``" ["U`"])
+ ("a''" ["a'"])
+ ("a//" ["a/"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a``" ["a`"])
+ ("a~~" ["a~"])
+ ("c``" ["c`"])
+ ("e''" ["e'"])
+ ("e//" ["e/"])
+ ("e\"\"" ["e\""])
+ ("e^^" ["e^"])
+ ("e``" ["e`"])
+ ("g~~" ["g~"])
+ ("i''" ["i'"])
+ ("i//" ["i/"])
+ ("i\"\"" ["i\""])
+ ("i^^" ["i^"])
+ ("i``" ["i`"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o//" ["o/"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("o``" ["o`"])
+ ("o~~" ["o~"])
+ ("s``" ["s`"])
+ ("s//" ["s/"])
+ ("u''" ["u'"])
+ ("u\"\"" ["u\""])
+ ("u^^" ["u^"])
+ ("u``" ["u`"])
+ ("y\"\"" ["y\""])
+ )
+
+
+
+(quail-define-package
+ "french-alt-postfix" "French" "FR<" t
+ "French (Français) input method with postfix modifiers
+
+\\=` pour grave, \\=' pour aigu, ^ pour circonflexe, et \" pour tréma.
+Par exemple: a\\=` -> à e\\=' -> é.
+
+Ç, «, et » sont produits par C/, <<, et >>.
+
+En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
+Par exemple: e\\='\\=' -> e\\='
+
+Πest produit par O/."
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A^" ?Â)
+ ("a`" ?à)
+ ("a^" ?â)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("I^" ?Î)
+ ("I\"" ?Ï)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("O^" ?Ô)
+ ("O/" ?Œ)
+ ("o^" ?ô)
+ ("o/" ?œ)
+ ("U`" ?Ù)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("u`" ?ù)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("C/" ?Ç)
+ ("c/" ?ç)
+ ("<<" ?«)
+ (">>" ?»)
+
+ ("A``" ["A`"])
+ ("A^^" ["A^"])
+ ("a``" ["a`"])
+ ("a^^" ["a^"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("E\"\"" ["E\""])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("e^^" ["e^"])
+ ("e\"\"" ["e\""])
+ ("I^^" ["I^"])
+ ("I\"\"" ["I\""])
+ ("i^^" ["i^"])
+ ("i\"\"" ["i\""])
+ ("O^^" ["O^"])
+ ("O//" ["O/"])
+ ("o^^" ["o^"])
+ ("o//" ["o/"])
+ ("U``" ["U`"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("u``" ["u`"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("C//" ["C/"])
+ ("c//" ["c/"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ )
+
+
+
+(quail-define-package
+ "italian-alt-postfix" "Latin-1" "IT<" t
+ "Italian (Italiano) input method with postfix modifiers
+
+a\\=' -> á A\\=' -> Á a\\=` -> à A\\=` -> À i^ -> î << -> «
+e\\=' -> é E\\=' -> É e\\=` -> è E\\=` -> È I^ -> Î >> -> »
+i\\=' -> í I\\=' -> Í i\\=` -> ì I\\=` -> Ì o_ -> º
+o\\=' -> ó O\\=' -> Ó o\\=` -> ò O\\=` -> Ò a_ -> ª
+u\\=' -> ú U\\=' -> Ú u\\=` -> ù U\\=` -> Ù
+
+This method is for purists who like accents the old way.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A'" ?Á)
+ ("a`" ?à)
+ ("a'" ?á)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Í)
+ ("i'" ?í)
+ ("I^" ?Î)
+ ("i^" ?î)
+ ("O`" ?Ò)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
+
+ ("A``" ["A`"])
+ ("A''" ["A'"])
+ ("a``" ["a`"])
+ ("a''" ["a'"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("I``" ["I`"])
+ ("i``" ["i`"])
+ ("I''" ["I'"])
+ ("i''" ["i'"])
+ ("I^^" ["I^"])
+ ("i^^" ["i^"])
+ ("O``" ["O`"])
+ ("o``" ["o`"])
+ ("O''" ["O'"])
+ ("o''" ["o'"])
+ ("U``" ["U`"])
+ ("u``" ["u`"])
+ ("U''" ["U'"])
+ ("u''" ["u'"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("o__" ["o_"])
+ ("a__" ["a_"])
+ )
+
+
+(quail-define-package
+ "turkish-alt-postfix" "Turkish" "TR«" t
+ "Turkish (Türkçe) input method with postfix modifiers.
+This input method differs from `turkish-postfix' in that
+comma is not special (use \\=` instead).
+
+turkish-latin-3-alt-postfix is an obsolete alias for turkish-alt-postfix.
+
+Note for I, ı, İ, i.
+
+A^ -> Â
+C\\=` -> Ç
+G^ -> Ğ
+I -> I
+i -> ı
+I/ -> İ
+i/ -> i
+O\" -> Ö
+S\\=` -> Ş
+U\" -> Ü
+U^ -> Û
+
+Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A^" ?Â)
+ ("a^" ?â)
+ ("C`" ?Ç)
+ ("c`" ?ç)
+ ("G^" ?Ğ)
+ ("g^" ?ğ)
+ ("I/" ?İ)
+ ("i" ?ı)
+ ("i/" ?i)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("S`" ?Ş)
+ ("s`" ?ş)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("U^" ?Û)
+ ("u^" ?û)
+
+ ("A^^" ["A^"])
+ ("a^^" ["a^"])
+ ("C``" ["C`"])
+ ("c``" ["c`"])
+ ("G^^" ["G^"])
+ ("g^^" ["g^"])
+ ("I//" ["I/"])
+ ("i" ["i"])
+ ("i//" ["i/"])
+ ("O\"\"" ["O\""])
+ ("o\"\"" ["o\""])
+ ("S``" ["S`"])
+ ("s``" ["s`"])
+ ("U\"\"" ["U\""])
+ ("u\"\"" ["u\""])
+ ("U^^" ["U^"])
+ ("u^^" ["u^"])
+ )
+
+;; Backwards compatibility.
+(push (cons "turkish-latin-3-alt-postfix"
+ (cdr (assoc "turkish-alt-postfix" quail-package-alist)))
+ quail-package-alist)
+
+;; Dutch Quail input method derived from the one in Yudit by Roman
+;; Czyborra.
+(quail-define-package
+ "dutch" "Dutch" "NL" t
+ "Dutch character mixfix input method.
+Caters for French and Turkish as well as Dutch.
+
+ | | examples
+ ------------+---------+----------
+ others | | fl. -> ƒ eur. -> € ij -> ij IJ -> IJ
+ ------------+---------+----------
+ | postfix |
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ Turkish | various | i/ -> ı s, -> ş g^ -> ğ I/ -> İ
+ | | S, -> Ş G^ -> Ğ
+ ------------+---------+----------
+ | prefix |
+ ------------+---------+----------
+ diaeresis | \" | \"a -> ä
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("fl." ?ƒ) ;; LATIN SMALL LETTER F WITH HOOK (florin currency symbol)
+ ("eur." ?€) ;; EURO SIGN
+ ;; “The 25th letter of the Dutch alphabet.”
+ ("ij" ?ij) ;; LATIN SMALL LIGATURE IJ
+ ("IJ" ?IJ) ;; LATIN CAPITAL LIGATURE IJ
+ ;; “Trema on the second letter of vowel pair.” Yudit uses `:', not `"'.
+ ("\"a" ?ä) ;; LATIN SMALL LETTER A WITH DIAERESIS
+ ("\"e" ?ë) ;; LATIN SMALL LETTER E WITH DIAERESIS
+ ("\"i" ?ï) ;; LATIN SMALL LETTER I WITH DIAERESIS
+ ("\"o" ?ö) ;; LATIN SMALL LETTER O WITH DIAERESIS
+ ("\"u" ?ü) ;; LATIN SMALL LETTER U WITH DIAERESIS
+ ("\"A" ?Ä) ;; LATIN CAPITAL LETTER A WITH DIAERESIS
+ ("\"E" ?Ë) ;; LATIN CAPITAL LETTER E WITH DIAERESIS
+ ("\"I" ?Ï) ;; LATIN CAPITAL LETTER I WITH DIAERESIS
+ ("\"O" ?Ö) ;; LATIN CAPITAL LETTER O WITH DIAERESIS
+ ("\"U" ?Ü) ;; LATIN CAPITAL LETTER U WITH DIAERESIS
+ ;; “Acute, marking emphasis on long vowels”:
+ ("a'" ?á) ;; LATIN SMALL LETTER A WITH ACUTE
+ ("e'" ?é) ;; LATIN SMALL LETTER E WITH ACUTE
+ ("i'" ?í) ;; LATIN SMALL LETTER I WITH ACUTE
+ ("o'" ?ó) ;; LATIN SMALL LETTER O WITH ACUTE
+ ("u'" ?ú) ;; LATIN SMALL LETTER U WITH ACUTE
+ ("A'" ?Á) ;; LATIN CAPITAL LETTER A WITH ACUTE
+ ("E'" ?É) ;; LATIN CAPITAL LETTER E WITH ACUTE
+ ("I'" ?Í) ;; LATIN CAPITAL LETTER I WITH ACUTE
+ ("O'" ?Ó) ;; LATIN CAPITAL LETTER O WITH ACUTE
+ ("U'" ?Ú) ;; LATIN CAPITAL LETTER U WITH ACUTE
+ ;; “Grave, marking emphasis on short vowels”:
+ ("a`" ?à) ;; LATIN SMALL LETTER A WITH GRAVE
+ ("e`" ?è) ;; LATIN SMALL LETTER E WITH GRAVE
+ ("i`" ?ì) ;; LATIN SMALL LETTER I WITH GRAVE
+ ("o`" ?ò) ;; LATIN SMALL LETTER O WITH GRAVE
+ ("u`" ?ù) ;; LATIN SMALL LETTER U WITH GRAVE
+ ("A`" ?À) ;; LATIN CAPITAL LETTER A WITH GRAVE
+ ("E`" ?È) ;; LATIN CAPITAL LETTER E WITH GRAVE
+ ("I`" ?Ì) ;; LATIN CAPITAL LETTER I WITH GRAVE
+ ("O`" ?Ò) ;; LATIN CAPITAL LETTER O WITH GRAVE
+ ("U`" ?Ù) ;; LATIN CAPITAL LETTER U WITH GRAVE
+ ;; “Cater for the use of many French words and use of the circumflex
+ ;; in Frisian.” Yudit used `;' for cedilla.
+ ("c," ?ç) ;; LATIN SMALL LETTER C WITH CEDILLA
+ ("C," ?Ç) ;; LATIN CAPITAL LETTER C WITH CEDILLA
+ ("a^" ?â) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("e^" ?ê) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("i^" ?î) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX
+ ("o^" ?ô) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("u^" ?û) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX
+ ("A^" ?Â) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("E^" ?Ê) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("I^" ?Î) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+ ("O^" ?Ô) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("U^" ?Û) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+ ;; “Follow the example of the Dutch POSIX locale, using ISO-8859-9 to
+ ;; cater to the many Turks in Dutch society.” Perhaps German methods
+ ;; should do so too. Follow turkish-alt-postfix here.
+ ("i/" ?ı) ;; LATIN SMALL LETTER I WITH NO DOT
+ ("s," ?ş) ;; LATIN SMALL LETTER S WITH CEDILLA
+ ("g^" ?ğ) ;; LATIN SMALL LETTER G WITH BREVE
+ ("I/" ?İ) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE
+ ("S," ?Ş) ;; LATIN CAPITAL LETTER S WITH CEDILLA
+ ("G^" ?Ğ) ;; LATIN CAPITAL LETTER G WITH BREVE
+ )
+
+;; Originally from Yudit, discussed with Albertas Agejevas
+;; <alga@uosis.mif.vu.lt>
+(quail-define-package
+ "lithuanian-numeric" "Lithuanian" "LtN" t
+ "Lithuanian numeric input method.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?ą)
+ ("2" ?č)
+ ("3" ?ę)
+ ("4" ?ė)
+ ("5" ?į)
+ ("6" ?š)
+ ("7" ?ų)
+ ("8" ?ū)
+ ("9" ?„)
+ ("0" ?“)
+ ("=" ?ž)
+ ("!" ?Ą)
+ ("@" ?Č)
+ ("#" ?Ę)
+ ("$" ?Ė)
+ ("%" ?Į)
+ ("^" ?Š)
+ ("&" ?Ų)
+ ("*" ?Ū)
+ ("+" ?Ž))
+
+;; From XFree 4.1 /usr/X11R6/lib/X11/xkb/symbols/lt, suggested by
+;; Albertas Agejevas <alga@uosis.mif.vu.lt>
+(quail-define-package
+ "lithuanian-keyboard" "Lithuanian" "Lt" t
+ "Lithuanian standard keyboard input method.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?ą)
+ ("!" ?Ą)
+ ("2" ?č)
+ ("@" ?Č)
+ ("#" ?Ę)
+ ("4" ?ė)
+ ("$" ?Ė)
+ ("5" ?į)
+ ("%" ?Į)
+ ("6" ?š)
+ ("^" ?Š)
+ ("7" ?ų)
+ ("&" ?Ų)
+ ("9" ?„)
+ ("0" ?“)
+ ("=" ?ž)
+ ("+" ?Ž))
+
+;; From XFree 4.1 /usr/X11R6/lib/X11/xkb/symbols/lv
+(quail-define-package
+ "latvian-keyboard" "Latvian" "Lv" t
+ "Latvian standard keyboard input method.
+" nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("4" ?€)
+ ("$" ?¢)
+ ("e" ?ē)
+ ("E" ?Ē)
+ ("r" ?ŗ)
+ ("R" ?Ŗ)
+ ("u" ?ū)
+ ("U" ?Ū)
+ ("i" ?ī)
+ ("I" ?Ī)
+ ("o" ?ō)
+ ("O" ?Ō)
+ ("a" ?ā)
+ ("A" ?Ā)
+ ("s" ?š)
+ ("S" ?Š)
+ ("g" ?ģ)
+ ("G" ?Ģ)
+ ("k" ?ķ)
+ ("K" ?Ķ)
+ ("l" ?ļ)
+ ("L" ?Ļ)
+ ("'" ?“)
+ ("\"" ?„)
+ ("z" ?ž)
+ ("Z" ?Ž)
+ ("c" ?č)
+ ("C" ?Č)
+ ("n" ?ņ)
+ ("N" ?Ņ))
+
+(quail-define-package
+ "latin-alt-postfix" "Latin" "L<" t
+ "Latin character input method with postfix modifiers.
+This is the union of various input methods originally made for input
+of characters from a single Latin-N charset.
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | /\\=` | c/ -> ç c\\=` -> ç
+ ogonek | \\=` | a\\=` -> ą
+ breve | ~ | a~ -> ă
+ caron | ~ | c~ -> č
+ dbl. acute | : | o: -> ő
+ ring | \\=` | u\\=` -> ů
+ dot | \\=` | z\\=` -> ż
+ stroke | / | d/ -> đ
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | /<> | s/ -> ß ?/ -> ¿ !/ -> ¡
+ | various | << -> « >> -> » o_ -> º a_ -> ª
+
+It would be natural to use comma for cedillas, but that would be
+inconvenient in practice because commas are needed very often after a
+letter.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+;; Fixme: ¦ § ¨ © ¬ ­ ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ ¼ ½ ¾ × ÷
+(quail-define-rules
+ (" _" ? )
+ ("!/" ?¡)
+ ("//" ?°)
+ ("<<" ?«)
+ (">>" ?»)
+ ("?/" ?¿)
+ ("$/" ?£)
+ ("$/" ?¤)
+ ("A'" ?Á)
+ ("A-" ?Ā)
+ ("A/" ?Å)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A`" ?Ą)
+ ("A~" ?Ã)
+ ("A~" ?Ă)
+ ("C'" ?Ć)
+ ("C/" ?Ç)
+ ("C/" ?Ċ)
+ ("C^" ?Ĉ)
+ ("C`" ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Ð)
+ ("D/" ?Đ)
+ ("D~" ?Ď)
+ ("E'" ?É)
+ ("E-" ?Ē)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("E`" ?Ę)
+ ("E~" ?Ė)
+ ("E~" ?Ě)
+ ("G/" ?Ġ)
+ ("G^" ?Ĝ)
+ ("G`" ?Ģ)
+ ("G~" ?Ğ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I'" ?Í)
+ ("I-" ?Ī)
+ ("I/" ?İ)
+ ("I\"" ?Ï)
+ ("I^" ?Î)
+ ("I`" ?Ì)
+ ("I`" ?Į)
+ ("I~" ?Ĩ)
+ ("J^" ?Ĵ)
+ ("K`" ?Ķ)
+ ("L'" ?Ĺ)
+ ("L/" ?Ł)
+ ("L`" ?Ļ)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N/" ?Ŋ)
+ ("N`" ?Ņ)
+ ("N~" ?Ñ)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O-" ?Ō)
+ ("O/" ?Ø)
+ ("O/" ?Œ)
+ ("O:" ?Ő)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ò)
+ ("O~" ?Õ)
+ ("R'" ?Ŕ)
+ ("R`" ?Ŗ)
+ ("R~" ?Ř)
+ ("S'" ?Ś)
+ ("S^" ?Ŝ)
+ ("S`" ?Ş)
+ ("S~" ?Š)
+ ("T/" ?Þ)
+ ("T/" ?Ŧ)
+ ("T`" ?Ţ)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U-" ?Ū)
+ ("U:" ?Ű)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("U`" ?Ů)
+ ("U`" ?Ų)
+ ("U~" ?Ũ)
+ ("U~" ?Ŭ)
+ ("Y'" ?Ý)
+ ("Y\"" ?Ÿ)
+ ("Y=" ?¥)
+ ("Z'" ?Ź)
+ ("Z/" ?Ż)
+ ("Z`" ?Ż)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a-" ?ā)
+ ("a/" ?å)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a_" ?ª)
+ ("a`" ?à)
+ ("a`" ?ą)
+ ("a~" ?ã)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c/" ?ç)
+ ("c/" ?ċ)
+ ("c/" ?¢)
+ ("c^" ?ĉ)
+ ("c`" ?ç)
+ ("c~" ?č)
+ ("d/" ?ð)
+ ("d/" ?đ)
+ ("d~" ?ď)
+ ("e'" ?é)
+ ("e-" ?ē)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("e`" ?ę)
+ ("e~" ?ė)
+ ("e~" ?ě)
+ ("e=" ?€)
+ ("g/" ?ġ)
+ ("g^" ?ĝ)
+ ("g`" ?ģ)
+ ("g~" ?ğ)
+ ("h/" ?ħ)
+ ("h^" ?ĥ)
+ ("i'" ?í)
+ ("i-" ?ī)
+ ("i/" ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("i`" ?į)
+ ("i~" ?ĩ)
+ ("j^" ?ĵ)
+ ("k/" ?ĸ)
+ ("k`" ?ķ)
+ ("l'" ?ĺ)
+ ("l/" ?ł)
+ ("l`" ?ļ)
+ ("l~" ?ľ)
+ ("n'" ?ń)
+ ("n/" ?ŋ)
+ ("n`" ?ņ)
+ ("n~" ?ñ)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o-" ?ō)
+ ("o/" ?ø)
+ ("o/" ?œ)
+ ("o:" ?ő)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o_" ?º)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("r'" ?ŕ)
+ ("r`" ?ŗ)
+ ("r~" ?ř)
+ ("s'" ?ś)
+ ("s/" ?ß)
+ ("s^" ?ŝ)
+ ("s`" ?ş)
+ ("s~" ?š)
+ ("t/" ?þ)
+ ("t/" ?ŧ)
+ ("t`" ?ţ)
+ ("t~" ?ť)
+ ("u'" ?ú)
+ ("u-" ?ū)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("u`" ?ů)
+ ("u`" ?ų)
+ ("u~" ?ũ)
+ ("u~" ?ŭ)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("z'" ?ź)
+ ("z/" ?ż)
+ ("z`" ?ż)
+ ("z~" ?ž)
+
+ (" __" [" _"])
+ ("!//" ["!/"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("?//" ["?/"])
+ ("///" ["//"])
+ ("$//" ["$/"])
+ ("A''" ["A'"])
+ ("A--" ["A-"])
+ ("A//" ["A/"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A``" ["A`"])
+ ("A~~" ["A~"])
+ ("C''" ["C'"])
+ ("C//" ["C/"])
+ ("C^^" ["C^"])
+ ("C``" ["C`"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("D~~" ["D~"])
+ ("E''" ["E'"])
+ ("E--" ["E-"])
+ ("E//" ["E/"])
+ ("E\"\"" ["E\""])
+ ("E^^" ["E^"])
+ ("E``" ["E`"])
+ ("E~~" ["E~"])
+ ("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~"])
+ ("J^^" ["J^"])
+ ("K``" ["K`"])
+ ("L''" ["L'"])
+ ("L//" ["L/"])
+ ("L``" ["L`"])
+ ("L~~" ["L~"])
+ ("N''" ["N'"])
+ ("N//" ["N/"])
+ ("N``" ["N`"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O--" ["O-"])
+ ("O//" ["O/"])
+ ("O::" ["O:"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("O``" ["O`"])
+ ("O~~" ["O~"])
+ ("R''" ["R'"])
+ ("R``" ["R`"])
+ ("R~~" ["R~"])
+ ("S''" ["S'"])
+ ("S^^" ["S^"])
+ ("S``" ["S`"])
+ ("S~~" ["S~"])
+ ("T//" ["T/"])
+ ("T``" ["T`"])
+ ("T~~" ["T~"])
+ ("U''" ["U'"])
+ ("U--" ["U-"])
+ ("U::" ["U:"])
+ ("U\"\"" ["U\""])
+ ("U^^" ["U^"])
+ ("U``" ["U`"])
+ ("U~~" ["U~"])
+ ("Y''" ["Y'"])
+ ("Z''" ["Z'"])
+ ("Z//" ["Z/"])
+ ("Z``" ["Z`"])
+ ("Z~~" ["Z~"])
+ ("a''" ["a'"])
+ ("a--" ["a-"])
+ ("a//" ["a/"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a__" ["a_"])
+ ("a``" ["a`"])
+ ("a~~" ["a~"])
+ ("c''" ["c'"])
+ ("c//" ["c/"])
+ ("c^^" ["c^"])
+ ("c``" ["c`"])
+ ("c~~" ["c~"])
+ ("d//" ["d/"])
+ ("d~~" ["d~"])
+ ("e''" ["e'"])
+ ("e--" ["e-"])
+ ("e//" ["e/"])
+ ("e\"\"" ["e\""])
+ ("e^^" ["e^"])
+ ("e``" ["e`"])
+ ("e~~" ["e~"])
+ ("e==" ["e="])
+ ("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~"])
+ ("j^^" ["j^"])
+ ("k//" ["k/"])
+ ("k``" ["k`"])
+ ("l''" ["l'"])
+ ("l//" ["l/"])
+ ("l``" ["l`"])
+ ("l~~" ["l~"])
+ ("n''" ["n'"])
+ ("n//" ["n/"])
+ ("n``" ["n`"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o--" ["o-"])
+ ("o//" ["o/"])
+ ("o::" ["o:"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("o__" ["o_"])
+ ("o``" ["o`"])
+ ("o~~" ["o~"])
+ ("r''" ["r'"])
+ ("r``" ["r`"])
+ ("r~~" ["r~"])
+ ("s''" ["s'"])
+ ("s//" ["s/"])
+ ("s^^" ["s^"])
+ ("s``" ["s`"])
+ ("s~~" ["s~"])
+ ("t//" ["t/"])
+ ("t``" ["t`"])
+ ("t~~" ["t~"])
+ ("u''" ["u'"])
+ ("u--" ["u-"])
+ ("u::" ["u:"])
+ ("u\"\"" ["u\""])
+ ("u^^" ["u^"])
+ ("u``" ["u`"])
+ ("u~~" ["u~"])
+ ("y''" ["y'"])
+ ("y\"\"" ["y\""])
+ ("z''" ["z'"])
+ ("z//" ["z/"])
+ ("z``" ["z`"])
+ ("z~~" ["z~"])
+ )
+
+;;; latin-alt.el ends here
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
new file mode 100644
index 00000000000..c63a758f198
--- /dev/null
+++ b/lisp/leim/quail/latin-ltx.el
@@ -0,0 +1,738 @@
+;;; latin-ltx.el --- Quail package for TeX-style input -*-coding: utf-8;-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
+;; Dave Love <fx@gnu.org>
+;; Keywords: multilingual, input, Greek, 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "TeX" "UTF-8" "\\" t
+ "LaTeX-like input method for many characters.
+These characters are from the charsets used by the `utf-8' coding
+system, including many technical ones. Examples:
+ \\\\='a -> á \\\\=`{a} -> à
+ \\pi -> π \\int -> ∫ ^1 -> ¹"
+
+ '(("\t" . quail-completion))
+ t t nil nil nil nil nil nil nil t)
+
+(eval-when-compile
+ (require 'cl-lib)
+
+ (defconst latin-ltx--mark-map
+ '(("DOT BELOW" . "d")
+ ("DOT ABOVE" . ".")
+ ("OGONEK" . "k")
+ ("CEDILLA" . "c")
+ ("CARON" . "v")
+ ;; ("HOOK ABOVE" . ??)
+ ("MACRON" . "=")
+ ("BREVE" . "u")
+ ("TILDE" . "~")
+ ("GRAVE" . "`")
+ ("CIRCUMFLEX" . "^")
+ ("DIAERESIS" . "\"")
+ ("DOUBLE ACUTE" . "H")
+ ("ACUTE" . "'")))
+
+ (defconst latin-ltx--mark-re (regexp-opt (mapcar #'car latin-ltx--mark-map)))
+
+ (defun latin-ltx--ascii-p (char)
+ (and (characterp char) (< char 128)))
+
+ (defmacro latin-ltx--define-rules (&rest rules)
+ (load "uni-name")
+ (let ((newrules ()))
+ (dolist (rule rules)
+ (pcase rule
+ (`(,_ ,(pred characterp)) (push rule newrules)) ;; Normal quail rule.
+ (`(,seq ,re)
+ (let ((count 0)
+ (re (eval re t)))
+ (dolist (pair (ucs-names))
+ (let ((name (car pair))
+ (char (cdr pair)))
+ (when (and (characterp char) ;; Ignore char-ranges.
+ (string-match re name))
+ (let ((keys (if (stringp seq)
+ (replace-match seq nil nil name)
+ (funcall seq name char))))
+ (if (listp keys)
+ (dolist (x keys)
+ (setq count (1+ count))
+ (push (list x char) newrules))
+ (setq count (1+ count))
+ (push (list keys char) newrules))))))
+ ;; (message "latin-ltx: %d mappings for %S" count re)
+ ))))
+ (setq newrules (delete-dups newrules))
+ (let ((rules (copy-sequence newrules)))
+ (while rules
+ (let ((rule (pop rules)))
+ (when (assoc (car rule) rules)
+ (let ((conflicts (list (cadr rule)))
+ (tail rules)
+ c)
+ (while (setq c (assoc (car rule) tail))
+ (push (cadr c) conflicts)
+ (setq tail (cdr (memq c tail)))
+ (setq rules (delq c rules)))
+ (message "Conflict for %S: %S"
+ (car rule) (apply #'string conflicts)))))))
+ (let ((inputs (mapcar #'car newrules)))
+ (setq inputs (delete-dups inputs))
+ (message "latin-ltx: %d rules (+ %d conflicts)!"
+ (length inputs) (- (length newrules) (length inputs))))
+ `(quail-define-rules ,@(nreverse newrules)))))
+
+(latin-ltx--define-rules
+ ("!`" ?¡)
+ ("\\pounds" ?£) ;; ("{\\pounds}" ?£)
+ ("\\S" ?§) ;; ("{\\S}" ?§)
+ ("$^a$" ?ª)
+ ("$\\pm$" ?±) ("\\pm" ?±)
+ ("$^2$" ?²)
+ ("$^3$" ?³)
+ ("\\P" ?¶) ;; ("{\\P}" ?¶)
+ ;; Fixme: Yudit has the equivalent of ("\\cdot" ?⋅), for U+22C5, DOT
+ ;; OPERATOR, whereas · is MIDDLE DOT. JadeTeX translates both to
+ ;; \cdot.
+ ("$\\cdot$" ?·) ("\\cdot" ?·)
+ ("$^1$" ?¹)
+ ("$^o$" ?º)
+ ("?`" ?¿)
+
+ ((lambda (name char)
+ (let* ((c (if (match-end 1)
+ (downcase (match-string 2 name))
+ (match-string 2 name)))
+ (mark1 (cdr (assoc (match-string 3 name) latin-ltx--mark-map)))
+ (mark2 (if (match-end 4)
+ (cdr (assoc (match-string 4 name) latin-ltx--mark-map))))
+ (marks (if mark2 (concat mark1 "\\" mark2) mark1)))
+ (cl-assert mark1)
+ (cons (format "\\%s{%s}" marks c)
+ ;; Exclude "d" because we use "\\dh" for something else.
+ (unless (member (or mark2 mark1) '("d"));; "k"
+ (list (format "\\%s%s" marks c))))))
+ (concat "\\`LATIN \\(?:CAPITAL\\|SMAL\\(L\\)\\) LETTER \\(.\\) WITH \\("
+ latin-ltx--mark-re "\\)\\(?: AND \\("
+ latin-ltx--mark-re "\\)\\)?\\'"))
+
+ ((lambda (name char)
+ (let* ((mark (cdr (assoc (match-string 1 name) latin-ltx--mark-map))))
+ (cl-assert mark)
+ (list (format "\\%s" mark))))
+ (concat "\\`COMBINING \\(" latin-ltx--mark-re "\\)\\(?: ACCENT\\)?\\'"))
+
+ ((lambda (name char)
+ (unless (latin-ltx--ascii-p char)
+ (let* ((mark (cdr (assoc (match-string 1 name) latin-ltx--mark-map))))
+ (cl-assert mark)
+ (list (format "\\%s{}" mark)))))
+ (concat "\\`\\(?:SPACING \\)?\\(" latin-ltx--mark-re "\\)\\(?: ACCENT\\)?\\'"))
+
+ ("\\AA" ?Å) ;; ("{\\AA}" ?Å)
+ ("\\AE" ?Æ) ;; ("{\\AE}" ?Æ)
+
+ ("$\\times$" ?×) ("\\times" ?×)
+ ("\\O" ?Ø) ;; ("{\\O}" ?Ø)
+ ("\\ss" ?ß) ;; ("{\\ss}" ?ß)
+
+ ("\\aa" ?å) ;; ("{\\aa}" ?å)
+ ("\\ae" ?æ) ;; ("{\\ae}" ?æ)
+
+ ("$\\div$" ?÷) ("\\div" ?÷)
+ ("\\o" ?ø) ;; ("{\\o}" ?ø)
+
+ ("\\~{\\i}" ?ĩ)
+ ("\\={\\i}" ?ī)
+ ("\\u{\\i}" ?ĭ)
+
+ ("\\i" ?ı) ;; ("{\\i}" ?ı)
+ ("\\^{\\j}" ?ĵ)
+
+ ("\\L" ?Ł) ;; ("{\\L}" ?Ł)
+ ("\\l" ?ł) ;; ("{\\l}" ?ł)
+
+ ("\\H" ?̋)
+ ("\\H{}" ?˝)
+ ("\\U{o}" ?ő) ("\\Uo" ?ő) ;; FIXME: Was it just a typo?
+
+ ("\\OE" ?Œ) ;; ("{\\OE}" ?Œ)
+ ("\\oe" ?œ) ;; ("{\\oe}" ?œ)
+
+ ("\\v{\\i}" ?ǐ)
+
+ ("\\={\\AE}" ?Ǣ) ("\\=\\AE" ?Ǣ)
+ ("\\={\\ae}" ?ǣ) ("\\=\\ae" ?ǣ)
+
+ ("\\v{\\j}" ?ǰ)
+ ("\\'{\\AE}" ?Ǽ) ("\\'\\AE" ?Ǽ)
+ ("\\'{\\ae}" ?ǽ) ("\\'\\ae" ?ǽ)
+ ("\\'{\\O}" ?Ǿ) ("\\'\\O" ?Ǿ)
+ ("\\'{\\o}" ?ǿ) ("\\'\\o" ?ǿ)
+
+ ("\\," ? )
+ ("\\/" ?‌)
+ ("\\:" ? )
+ ("\\;" ? )
+
+ ((lambda (name char)
+ (let* ((base (concat (match-string 1 name) (match-string 3 name)))
+ (basechar (cdr (assoc base (ucs-names)))))
+ (when (latin-ltx--ascii-p basechar)
+ (string (if (match-end 2) ?^ ?_) basechar))))
+ "\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)")
+
+ ((lambda (name _char)
+ (let* ((basename (match-string 2 name))
+ (name (if (match-end 1) (capitalize basename) (downcase basename))))
+ (concat "^" (if (> (length name) 1) "\\") name)))
+ "\\`MODIFIER LETTER \\(?:SMALL\\|CAPITA\\(L\\)\\) \\([[:ascii:]]+\\)\\'")
+
+ ;; ((lambda (name char) (format "^%s" (downcase (match-string 1 name))))
+ ;; "\\`MODIFIER LETTER SMALL \\(.\\)\\'")
+ ;; ("^\\1" "\\`MODIFIER LETTER CAPITAL \\(.\\)\\'")
+ ("^o_" ?º)
+ ("^{SM}" ?℠)
+ ("^{TEL}" ?℡)
+ ("^{TM}" ?™)
+
+ ("\\b" ?̱)
+
+ ("\\rq" ?’)
+
+ ;; FIXME: Provides some useful entries (yen, euro, copyright, registered,
+ ;; currency, minus, micro), but also a lot of dubious ones.
+ ((lambda (name char)
+ (unless (or (latin-ltx--ascii-p char)
+ ;; We prefer COMBINING LONG SOLIDUS OVERLAY for \not.
+ (member name '("NOT SIGN")))
+ (concat "\\" (downcase (match-string 1 name)))))
+ "\\`\\([^- ]+\\) SIGN\\'")
+
+ ((lambda (name char)
+ (concat "\\" (funcall (if (match-end 1) #' capitalize #'downcase)
+ (match-string 2 name))))
+ "\\`GREEK \\(?:SMALL\\|CAPITA\\(L\\)\\) LETTER \\([^- ]+\\)\\'")
+
+ ("\\Box" ?□)
+ ("\\Bumpeq" ?≎)
+ ("\\Cap" ?⋒)
+ ("\\Cup" ?⋓)
+ ("\\Diamond" ?◇)
+ ("\\Downarrow" ?⇓)
+ ("\\H{o}" ?ő)
+ ("\\Im" ?ℑ)
+ ("\\Join" ?⋈)
+ ("\\Leftarrow" ?⇐)
+ ("\\Leftrightarrow" ?⇔)
+ ("\\Ll" ?⋘)
+ ("\\Lleftarrow" ?⇚)
+ ("\\Longleftarrow" ?⇐)
+ ("\\Longleftrightarrow" ?⇔)
+ ("\\Longrightarrow" ?⇒)
+ ("\\Lsh" ?↰)
+ ("\\Re" ?ℜ)
+ ("\\Rightarrow" ?⇒)
+ ("\\Rrightarrow" ?⇛)
+ ("\\Rsh" ?↱)
+ ("\\Subset" ?⋐)
+ ("\\Supset" ?⋑)
+ ("\\Uparrow" ?⇑)
+ ("\\Updownarrow" ?⇕)
+ ("\\Vdash" ?⊩)
+ ("\\Vert" ?‖)
+ ("\\Vvdash" ?⊪)
+ ("\\aleph" ?ℵ)
+ ("\\amalg" ?∐)
+ ("\\angle" ?∠)
+ ("\\approx" ?≈)
+ ("\\approxeq" ?≊)
+ ("\\ast" ?∗)
+ ("\\asymp" ?≍)
+ ("\\backcong" ?≌)
+ ("\\backepsilon" ?∍)
+ ("\\backprime" ?‵)
+ ("\\backsim" ?∽)
+ ("\\backsimeq" ?⋍)
+ ("\\backslash" ?\\)
+ ("\\barwedge" ?⊼)
+ ("\\because" ?∵)
+ ("\\beth" ?ℶ)
+ ("\\between" ?≬)
+ ("\\bigcap" ?⋂)
+ ("\\bigcirc" ?◯)
+ ("\\bigcup" ?⋃)
+ ("\\bigstar" ?★)
+ ("\\bigtriangledown" ?▽)
+ ("\\bigtriangleup" ?△)
+ ("\\bigvee" ?⋁)
+ ("\\bigwedge" ?⋀)
+ ("\\blacklozenge" ?✦)
+ ("\\blacksquare" ?▪)
+ ("\\blacktriangle" ?▴)
+ ("\\blacktriangledown" ?▾)
+ ("\\blacktriangleleft" ?◂)
+ ("\\blacktriangleright" ?▸)
+ ("\\bot" ?⊥)
+ ("\\bowtie" ?⋈)
+ ("\\boxminus" ?⊟)
+ ("\\boxplus" ?⊞)
+ ("\\boxtimes" ?⊠)
+ ("\\bullet" ?•)
+ ("\\bumpeq" ?≏)
+ ("\\cap" ?∩)
+ ("\\cdots" ?⋯)
+ ("\\centerdot" ?·)
+ ("\\checkmark" ?✓)
+ ("\\chi" ?χ)
+ ("\\circ" ?∘)
+ ("\\circeq" ?≗)
+ ("\\circlearrowleft" ?↺)
+ ("\\circlearrowright" ?↻)
+ ("\\circledR" ?®)
+ ("\\circledS" ?Ⓢ)
+ ("\\circledast" ?⊛)
+ ("\\circledcirc" ?⊚)
+ ("\\circleddash" ?⊝)
+ ("\\clubsuit" ?♣)
+ ("\\coloneq" ?≔)
+ ("\\complement" ?∁)
+ ("\\cong" ?≅)
+ ("\\coprod" ?∐)
+ ("\\cup" ?∪)
+ ("\\curlyeqprec" ?⋞)
+ ("\\curlyeqsucc" ?⋟)
+ ("\\curlypreceq" ?≼)
+ ("\\curlyvee" ?⋎)
+ ("\\curlywedge" ?⋏)
+ ("\\curvearrowleft" ?↶)
+ ("\\curvearrowright" ?↷)
+
+ ("\\dag" ?†)
+ ("\\dagger" ?†)
+ ("\\daleth" ?ℸ)
+ ("\\dashv" ?⊣)
+ ("\\ddag" ?‡)
+ ("\\ddagger" ?‡)
+ ("\\ddots" ?⋱)
+ ("\\diamond" ?⋄)
+ ("\\diamondsuit" ?♢)
+ ("\\divideontimes" ?⋇)
+ ("\\doteq" ?≐)
+ ("\\doteqdot" ?≑)
+ ("\\dotplus" ?∔)
+ ("\\dotsquare" ?⊡)
+ ("\\downarrow" ?↓)
+ ("\\downdownarrows" ?⇊)
+ ("\\downleftharpoon" ?⇃)
+ ("\\downrightharpoon" ?⇂)
+ ("\\ell" ?ℓ)
+ ("\\emptyset" ?∅)
+ ("\\eqcirc" ?≖)
+ ("\\eqcolon" ?≕)
+ ("\\eqslantgtr" ?⋝)
+ ("\\eqslantless" ?⋜)
+ ("\\equiv" ?≡)
+ ("\\exists" ?∃)
+ ("\\fallingdotseq" ?≒)
+ ("\\flat" ?♭)
+ ("\\forall" ?∀)
+ ("\\frac1" ?⅟)
+ ("\\frac12" ?½)
+ ("\\frac13" ?⅓)
+ ("\\frac14" ?¼)
+ ("\\frac15" ?⅕)
+ ("\\frac16" ?⅙)
+ ("\\frac18" ?⅛)
+ ("\\frac23" ?⅔)
+ ("\\frac25" ?⅖)
+ ("\\frac34" ?¾)
+ ("\\frac35" ?⅗)
+ ("\\frac38" ?⅜)
+ ("\\frac45" ?⅘)
+ ("\\frac56" ?⅚)
+ ("\\frac58" ?⅝)
+ ("\\frac78" ?⅞)
+ ("\\frown" ?⌢)
+ ("\\ge" ?≥)
+ ("\\geq" ?≥)
+ ("\\geqq" ?≧)
+ ("\\geqslant" ?≥)
+ ("\\gets" ?←)
+ ("\\gg" ?≫)
+ ("\\ggg" ?⋙)
+ ("\\gimel" ?ℷ)
+ ("\\gnapprox" ?⋧)
+ ("\\gneq" ?≩)
+ ("\\gneqq" ?≩)
+ ("\\gnsim" ?⋧)
+ ("\\gtrapprox" ?≳)
+ ("\\gtrdot" ?⋗)
+ ("\\gtreqless" ?⋛)
+ ("\\gtreqqless" ?⋛)
+ ("\\gtrless" ?≷)
+ ("\\gtrsim" ?≳)
+ ("\\gvertneqq" ?≩)
+ ("\\hbar" ?ℏ)
+ ("\\heartsuit" ?♥)
+ ("\\hookleftarrow" ?↩)
+ ("\\hookrightarrow" ?↪)
+ ("\\iff" ?⇔)
+ ("\\imath" ?ı)
+ ("\\in" ?∈)
+ ("\\infty" ?∞)
+ ("\\int" ?∫)
+ ("\\intercal" ?⊺)
+ ("\\langle" ?⟨) ;; Was ?〈, see bug#12948.
+ ("\\lbrace" ?{)
+ ("\\lbrack" ?\[)
+ ("\\lceil" ?⌈)
+ ("\\ldots" ?…)
+ ("\\le" ?≤)
+ ("\\leadsto" ?↝)
+ ("\\leftarrow" ?←)
+ ("\\leftarrowtail" ?↢)
+ ("\\leftharpoondown" ?↽)
+ ("\\leftharpoonup" ?↼)
+ ("\\leftleftarrows" ?⇇)
+ ;; ("\\leftparengtr" ?〈), see bug#12948.
+ ("\\leftrightarrow" ?↔)
+ ("\\leftrightarrows" ?⇆)
+ ("\\leftrightharpoons" ?⇋)
+ ("\\leftrightsquigarrow" ?↭)
+ ("\\leftthreetimes" ?⋋)
+ ("\\leq" ?≤)
+ ("\\leqq" ?≦)
+ ("\\leqslant" ?≤)
+ ("\\lessapprox" ?≲)
+ ("\\lessdot" ?⋖)
+ ("\\lesseqgtr" ?⋚)
+ ("\\lesseqqgtr" ?⋚)
+ ("\\lessgtr" ?≶)
+ ("\\lesssim" ?≲)
+ ("\\lfloor" ?⌊)
+ ("\\lhd" ?◁)
+ ("\\rhd" ?▷)
+ ("\\ll" ?≪)
+ ("\\llcorner" ?⌞)
+ ("\\lnapprox" ?⋦)
+ ("\\lneq" ?≨)
+ ("\\lneqq" ?≨)
+ ("\\lnsim" ?⋦)
+ ("\\longleftarrow" ?←)
+ ("\\longleftrightarrow" ?↔)
+ ("\\longmapsto" ?↦)
+ ("\\longrightarrow" ?→)
+ ("\\looparrowleft" ?↫)
+ ("\\looparrowright" ?↬)
+ ("\\lozenge" ?✧)
+ ("\\lq" ?‘)
+ ("\\lrcorner" ?⌟)
+ ("\\ltimes" ?⋉)
+ ("\\lvertneqq" ?≨)
+ ("\\maltese" ?✠)
+ ("\\mapsto" ?↦)
+ ("\\measuredangle" ?∡)
+ ("\\mho" ?℧)
+ ("\\mid" ?∣)
+ ("\\models" ?⊧)
+ ("\\mp" ?∓)
+ ("\\multimap" ?⊸)
+ ("\\nLeftarrow" ?⇍)
+ ("\\nLeftrightarrow" ?⇎)
+ ("\\nRightarrow" ?⇏)
+ ("\\nVDash" ?⊯)
+ ("\\nVdash" ?⊮)
+ ("\\nabla" ?∇)
+ ("\\napprox" ?≉)
+ ("\\natural" ?♮)
+ ("\\ncong" ?≇)
+ ("\\ne" ?≠)
+ ("\\nearrow" ?↗)
+ ("\\neg" ?¬)
+ ("\\neq" ?≠)
+ ("\\nequiv" ?≢)
+ ("\\newline" ?
)
+ ("\\nexists" ?∄)
+ ("\\ngeq" ?≱)
+ ("\\ngeqq" ?≱)
+ ("\\ngeqslant" ?≱)
+ ("\\ngtr" ?≯)
+ ("\\ni" ?∋)
+ ("\\nleftarrow" ?↚)
+ ("\\nleftrightarrow" ?↮)
+ ("\\nleq" ?≰)
+ ("\\nleqq" ?≰)
+ ("\\nleqslant" ?≰)
+ ("\\nless" ?≮)
+ ("\\nmid" ?∤)
+ ("\\not" ?̸) ;FIXME: conflict with "NOT SIGN" ¬.
+ ("\\notin" ?∉)
+ ("\\nparallel" ?∦)
+ ("\\nprec" ?⊀)
+ ("\\npreceq" ?⋠)
+ ("\\nrightarrow" ?↛)
+ ("\\nshortmid" ?∤)
+ ("\\nshortparallel" ?∦)
+ ("\\nsim" ?≁)
+ ("\\nsimeq" ?≄)
+ ("\\nsubset" ?⊄)
+ ("\\nsubseteq" ?⊈)
+ ("\\nsubseteqq" ?⊈)
+ ("\\nsucc" ?⊁)
+ ("\\nsucceq" ?⋡)
+ ("\\nsupset" ?⊅)
+ ("\\nsupseteq" ?⊉)
+ ("\\nsupseteqq" ?⊉)
+ ("\\ntriangleleft" ?⋪)
+ ("\\ntrianglelefteq" ?⋬)
+ ("\\ntriangleright" ?⋫)
+ ("\\ntrianglerighteq" ?⋭)
+ ("\\nvDash" ?⊭)
+ ("\\nvdash" ?⊬)
+ ("\\nwarrow" ?↖)
+ ("\\odot" ?⊙)
+ ("\\oint" ?∮)
+ ("\\ominus" ?⊖)
+ ("\\oplus" ?⊕)
+ ("\\oslash" ?⊘)
+ ("\\otimes" ?⊗)
+ ("\\par" ?
)
+ ("\\parallel" ?∥)
+ ("\\partial" ?∂)
+ ("\\perp" ?⊥)
+ ("\\pitchfork" ?⋔)
+ ("\\prec" ?≺)
+ ("\\precapprox" ?≾)
+ ("\\preceq" ?≼)
+ ("\\precnapprox" ?⋨)
+ ("\\precnsim" ?⋨)
+ ("\\precsim" ?≾)
+ ("\\prime" ?′)
+ ("\\prod" ?∏)
+ ("\\propto" ?∝)
+ ("\\qed" ?∎)
+ ("\\quad" ? )
+ ("\\rangle" ?⟩) ;; Was ?〉, see bug#12948.
+ ("\\rbrace" ?})
+ ("\\rbrack" ?\])
+ ("\\rceil" ?⌉)
+ ("\\rfloor" ?⌋)
+ ("\\rightarrow" ?→)
+ ("\\rightarrowtail" ?↣)
+ ("\\rightharpoondown" ?⇁)
+ ("\\rightharpoonup" ?⇀)
+ ("\\rightleftarrows" ?⇄)
+ ("\\rightleftharpoons" ?⇌)
+ ;; ("\\rightparengtr" ?⦔) ;; Was ?〉, see bug#12948.
+ ("\\rightrightarrows" ?⇉)
+ ("\\rightthreetimes" ?⋌)
+ ("\\risingdotseq" ?≓)
+ ("\\rtimes" ?⋊)
+ ("\\sbs" ?﹨)
+ ("\\searrow" ?↘)
+ ("\\setminus" ?∖)
+ ("\\sharp" ?♯)
+ ("\\shortmid" ?∣)
+ ("\\shortparallel" ?∥)
+ ("\\sim" ?∼)
+ ("\\simeq" ?≃)
+ ("\\smallamalg" ?∐)
+ ("\\smallsetminus" ?∖)
+ ("\\smallsmile" ?⌣)
+ ("\\smile" ?⌣)
+ ("\\spadesuit" ?♠)
+ ("\\sphericalangle" ?∢)
+ ("\\sqcap" ?⊓)
+ ("\\sqcup" ?⊔)
+ ("\\sqsubset" ?⊏)
+ ("\\sqsubseteq" ?⊑)
+ ("\\sqsupset" ?⊐)
+ ("\\sqsupseteq" ?⊒)
+ ("\\square" ?□)
+ ("\\squigarrowright" ?⇝)
+ ("\\star" ?⋆)
+ ("\\straightphi" ?φ)
+ ("\\subset" ?⊂)
+ ("\\subseteq" ?⊆)
+ ("\\subseteqq" ?⊆)
+ ("\\subsetneq" ?⊊)
+ ("\\subsetneqq" ?⊊)
+ ("\\succ" ?≻)
+ ("\\succapprox" ?≿)
+ ("\\succcurlyeq" ?≽)
+ ("\\succeq" ?≽)
+ ("\\succnapprox" ?⋩)
+ ("\\succnsim" ?⋩)
+ ("\\succsim" ?≿)
+ ("\\sum" ?∑)
+ ("\\supset" ?⊃)
+ ("\\supseteq" ?⊇)
+ ("\\supseteqq" ?⊇)
+ ("\\supsetneq" ?⊋)
+ ("\\supsetneqq" ?⊋)
+ ("\\surd" ?√)
+ ("\\swarrow" ?↙)
+ ("\\therefore" ?∴)
+ ("\\thickapprox" ?≈)
+ ("\\thicksim" ?∼)
+ ("\\to" ?→)
+ ("\\top" ?⊤)
+ ("\\triangle" ?▵)
+ ("\\triangledown" ?▿)
+ ("\\triangleleft" ?◃)
+ ("\\trianglelefteq" ?⊴)
+ ("\\triangleq" ?≜)
+ ("\\triangleright" ?▹)
+ ("\\trianglerighteq" ?⊵)
+ ("\\twoheadleftarrow" ?↞)
+ ("\\twoheadrightarrow" ?↠)
+ ("\\ulcorner" ?⌜)
+ ("\\uparrow" ?↑)
+ ("\\updownarrow" ?↕)
+ ("\\upleftharpoon" ?↿)
+ ("\\uplus" ?⊎)
+ ("\\uprightharpoon" ?↾)
+ ("\\upuparrows" ?⇈)
+ ("\\urcorner" ?⌝)
+ ("\\u{i}" ?ĭ)
+ ("\\vDash" ?⊨)
+
+ ((lambda (name char)
+ (concat "\\var" (downcase (match-string 1 name))))
+ "\\`GREEK \\([^- ]+\\) SYMBOL\\'")
+
+ ("\\varprime" ?′)
+ ("\\varpropto" ?∝)
+ ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var.
+ ("\\vartriangleleft" ?⊲)
+ ("\\vartriangleright" ?⊳)
+ ("\\vdash" ?⊢)
+ ("\\vdots" ?⋮)
+ ("\\vee" ?∨)
+ ("\\veebar" ?⊻)
+ ("\\vert" ?|)
+ ("\\wedge" ?∧)
+ ("\\wp" ?℘)
+ ("\\wr" ?≀)
+
+ ("\\Bbb{N}" ?ℕ) ; AMS commands for blackboard bold
+ ("\\Bbb{P}" ?ℙ) ; Also sometimes \mathbb.
+ ("\\Bbb{R}" ?ℝ)
+ ("\\Bbb{Z}" ?ℤ)
+ ("--" ?–)
+ ("---" ?—)
+ ;; We used to use ~ for NBSP but that's inconvenient and may even look like
+ ;; a bug where the user finds his ~ key doesn't insert a ~ any more.
+ ("\\ " ? )
+ ("\\\\" ?\\)
+ ("\\mathscr{I}" ?ℐ) ; moment of inertia
+ ("\\Smiley" ?☺)
+ ("\\blacksmiley" ?☻)
+ ("\\Frowny" ?☹)
+ ("\\Letter" ?✉)
+ ("\\permil" ?‰)
+ ;; Probably not useful enough:
+ ;; ("\\Telefon" ?☎) ; there are other possibilities
+ ;; ("\\Radioactivity" ?☢)
+ ;; ("\\Biohazard" ?☣)
+ ;; ("\\Male" ?♂)
+ ;; ("\\Female" ?♀)
+ ;; ("\\Lightning" ?☇)
+ ;; ("\\Mercury" ?☿)
+ ;; ("\\Earth" ?♁)
+ ;; ("\\Jupiter" ?♃)
+ ;; ("\\Saturn" ?♄)
+ ;; ("\\Uranus" ?♅)
+ ;; ("\\Neptune" ?♆)
+ ;; ("\\Pluto" ?♇)
+ ;; ("\\Sun" ?☉)
+ ;; ("\\Writinghand" ?✍)
+ ;; ("\\Yinyang" ?☯)
+ ;; ("\\Heart" ?♡)
+ ("\\dh" ?ð)
+ ("\\DH" ?Ð)
+ ("\\th" ?þ)
+ ("\\TH" ?Þ)
+ ("\\lnot" ?¬)
+ ("\\ordfeminine" ?ª)
+ ("\\ordmasculine" ?º)
+ ("\\lambdabar" ?ƛ)
+ ("\\celsius" ?℃)
+ ;; by analogy with lq, rq:
+ ("\\ldq" ?\“)
+ ("\\rdq" ?\”)
+ ("\\defs" ?≙) ; per fuzz/zed
+ ;; ("\\sqrt[3]" ?∛)
+ ("\\llbracket" ?\〚) ; stmaryrd
+ ("\\rrbracket" ?\〛)
+ ;; ("\\lbag" ?\〚) ; fuzz
+ ;; ("\\rbag" ?\〛)
+ ("\\ldata" ?\《) ; fuzz/zed
+ ("\\rdata" ?\》)
+ ;; From Karl Eichwalder.
+ ("\\glq" ?‚)
+ ("\\grq" ?‘)
+ ("\\glqq" ?„) ("\\\"`" ?„)
+ ("\\grqq" ?“) ("\\\"'" ?“)
+ ("\\flq" ?‹)
+ ("\\frq" ?›)
+ ("\\flqq" ?\«) ("\\\"<" ?\«)
+ ("\\frqq" ?\») ("\\\">" ?\»)
+
+ ("\\-" ?­) ;; soft hyphen
+
+ ("\\textmu" ?µ)
+ ("\\textfractionsolidus" ?⁄)
+ ("\\textbigcircle" ?⃝)
+ ("\\textmusicalnote" ?♪)
+ ("\\textdied" ?✝)
+ ("\\textcolonmonetary" ?₡)
+ ("\\textwon" ?₩)
+ ("\\textnaira" ?₦)
+ ("\\textpeso" ?₱)
+ ("\\textlira" ?₤)
+ ("\\textrecipe" ?℞)
+ ("\\textinterrobang" ?‽)
+ ("\\textpertenthousand" ?‱)
+ ("\\textbaht" ?฿)
+ ("\\textnumero" ?№)
+ ("\\textdiscount" ?⁒)
+ ("\\textestimated" ?℮)
+ ("\\textopenbullet" ?◦)
+ ("\\textlquill" ?⁅)
+ ("\\textrquill" ?⁆)
+ ("\\textcircledP" ?℗)
+ ("\\textreferencemark" ?※)
+ )
+
+;;; latin-ltx.el ends here
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
new file mode 100644
index 00000000000..25fd4508314
--- /dev/null
+++ b/lisp/leim/quail/latin-post.el
@@ -0,0 +1,2497 @@
+;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+
+;; Keywords: multilingual, input method, latin, 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 <http://www.gnu.org/licenses/>.
+
+;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "latin-1-postfix" "Latin-1" "1<" t
+ "Latin-1 character input method with postfix modifiers
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | , | c, -> ç
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> °
+ | various | << -> « >> -> » o_ -> º a_ -> ª
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Å)
+ ("a`" ?à)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?å)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("E/" ?Æ)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("e/" ?æ)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Í)
+ ("i'" ?í)
+ ("I^" ?Î)
+ ("i^" ?î)
+ ("I\"" ?Ï)
+ ("i\"" ?ï)
+ ("O`" ?Ò)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("O~" ?Õ)
+ ("o~" ?õ)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("O/" ?Ø)
+ ("o/" ?ø)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U^" ?Û)
+ ("u^" ?û)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("Y'" ?Ý)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("D/" ?Ð)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
+ ("s/" ?ß)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
+ ("//" ?°)
+
+ ("A``" ["A`"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("A\"\"" ["A\""])
+ ("A//" ["A/"])
+ ("a``" ["a`"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("a\"\"" ["a\""])
+ ("a//" ["a/"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("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\""])
+ ("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/"])
+ ("U``" ["U`"])
+ ("u``" ["u`"])
+ ("U''" ["U'"])
+ ("u''" ["u'"])
+ ("U^^" ["U^"])
+ ("u^^" ["u^"])
+ ("U\"\"" ["U\""])
+ ("u\"\"" ["u\""])
+ ("Y''" ["Y'"])
+ ("y''" ["y'"])
+ ("y\"\"" ["y\""])
+ ("D//" ["D/"])
+ ("d//" ["d/"])
+ ("T//" ["T/"])
+ ("t//" ["t/"])
+ ("s//" ["s/"])
+ ("C,," ["C,"])
+ ("c,," ["c,"])
+ ("N~~" ["N~"])
+ ("n~~" ["n~"])
+ ("?//" ["?/"])
+ ("!//" ["!/"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("o__" ["o_"])
+ ("a__" ["a_"])
+ ("///" ["//"])
+ )
+
+(quail-define-package
+ "latin-2-postfix" "Latin-2" "2<" t
+ "Latin-2 character input method with postfix modifiers
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ ogonek | , | a, -> ą
+ diaeresis | \" | a\" -> ä
+ circumflex | ^ | a^ -> â
+ breve | ~ | a~ -> ă
+ cedilla | , | c, -> ç
+ caron | ~ | c~ -> č
+ dbl. acute | : | o: -> ő
+ ring | . | u. -> ů
+ dot | . | z. -> ż
+ stroke | / | d/ -> đ
+ others | / | s/ -> ß
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("A," ?Ą)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A~" ?Ă)
+ ("C'" ?Ć)
+ ("C," ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Đ)
+ ("D~" ?Ď)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Ě)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("L'" ?Ĺ)
+ ("L/" ?Ł)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O:" ?Ő)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("R'" ?Ŕ)
+ ("R~" ?Ř)
+ ("S'" ?Ś)
+ ("S," ?Ş)
+ ("S~" ?Š)
+ ("T," ?Ţ)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U:" ?Ű)
+ ("U\"" ?Ü)
+ ("U." ?Ů)
+ ("Y'" ?Ý)
+ ("Z'" ?Ź)
+ ("Z." ?Ż)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a," ?ą)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c," ?ç)
+ ("c~" ?č)
+ ("d/" ?đ)
+ ("d~" ?ď)
+ ("e'" ?é)
+ ("e," ?ę)
+ ("e\"" ?ë)
+ ("e~" ?ě)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("l'" ?ĺ)
+ ("l/" ?ł)
+ ("l~" ?ľ)
+ ("n'" ?ń)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o:" ?ő)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("r'" ?ŕ)
+ ("r~" ?ř)
+ ("s'" ?ś)
+ ("s," ?ş)
+ ("s/" ?ß)
+ ("s~" ?š)
+ ("t," ?ţ)
+ ("t~" ?ť)
+ ("u'" ?ú)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u." ?ů)
+ ("y'" ?ý)
+ ("z'" ?ź)
+ ("z." ?ż)
+ ("z~" ?ž)
+
+ ("A''" ["A'"])
+ ("A,," ["A,"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("C''" ["C'"])
+ ("C,," ["C,"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("D~~" ["D~"])
+ ("E''" ["E'"])
+ ("E,," ["E,"])
+ ("E\"\"" ["E\""])
+ ("E~~" ["E~"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("L''" ["L'"])
+ ("L//" ["L/"])
+ ("L~~" ["L~"])
+ ("N''" ["N'"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O::" ["O:"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("R''" ["R'"])
+ ("R~~" ["R~"])
+ ("S''" ["S'"])
+ ("S,," ["S,"])
+ ("S~~" ["S~"])
+ ("T,," ["T,"])
+ ("T~~" ["T~"])
+ ("U''" ["U'"])
+ ("U::" ["U:"])
+ ("U\"\"" ["U\""])
+ ("U.." ["U."])
+ ("Y''" ["Y'"])
+ ("Z''" ["Z'"])
+ ("Z.." ["Z."])
+ ("Z~~" ["Z~"])
+ ("a''" ["a'"])
+ ("a,," ["a,"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("c''" ["c'"])
+ ("c,," ["c,"])
+ ("c~~" ["c~"])
+ ("d//" ["d/"])
+ ("d~~" ["d~"])
+ ("e''" ["e'"])
+ ("e,," ["e,"])
+ ("e\"\"" ["e\""])
+ ("e~~" ["e~"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("l''" ["l'"])
+ ("l//" ["l/"])
+ ("l~~" ["l~"])
+ ("n''" ["n'"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o::" ["o:"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("r''" ["r'"])
+ ("r~~" ["r~"])
+ ("s''" ["s'"])
+ ("s,," ["s,"])
+ ("s//" ["s/"])
+ ("s~~" ["s~"])
+ ("t,," ["t,"])
+ ("t~~" ["t~"])
+ ("u''" ["u'"])
+ ("u::" ["u:"])
+ ("u\"\"" ["u\""])
+ ("u.." ["u."])
+ ("y''" ["y'"])
+ ("z''" ["z'"])
+ ("z.." ["z."])
+ ("z~~" ["z~"])
+ )
+
+(quail-define-package
+ "latin-3-postfix" "Latin-3" "3<" t
+ "Latin-3 character input method with postfix modifiers
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ dot | . | c. -> ċ i. -> ı I. -> İ
+ cedilla | , | c, -> ç
+ breve | ~ | g~ -> ğ
+ tilde | ~ | n~ -> ñ
+ stroke | / | h/ -> ħ
+ others | / | s/ -> ß
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A\"" ?Ä)
+ ("C." ?Ċ)
+ ("C^" ?Ĉ)
+ ("C," ?Ç)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("G~" ?Ğ)
+ ("G." ?Ġ)
+ ("G^" ?Ĝ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I." ?İ)
+ ("I`" ?Ì)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("I\"" ?Ï)
+ ("J^" ?Ĵ)
+ ("N~" ?Ñ)
+ ("O`" ?Ò)
+ ("O'" ?Ó)
+ ("O^" ?Ô)
+ ("O\"" ?Ö)
+ ("S," ?Ş)
+ ("S^" ?Ŝ)
+ ("U`" ?Ù)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ŭ)
+ ("Z." ?Ż)
+ ("a`" ?à)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a\"" ?ä)
+ ("c." ?ċ)
+ ("c^" ?ĉ)
+ ("c," ?ç)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("g~" ?ğ)
+ ("g." ?ġ)
+ ("g^" ?ĝ)
+ ("h/" ?ħ)
+ ("h^" ?ĥ)
+ ("i." ?ı)
+ ("i`" ?ì)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("j^" ?ĵ)
+ ("n~" ?ñ)
+ ("o`" ?ò)
+ ("o'" ?ó)
+ ("o^" ?ô)
+ ("o\"" ?ö)
+ ("s," ?ş)
+ ("s/" ?ß)
+ ("s^" ?ŝ)
+ ("u`" ?ù)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?ŭ)
+ ("z." ?ż)
+
+ ("A``" ["A`"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A\"\"" ["A\""])
+ ("C.." ["C."])
+ ("C^^" ["C^"])
+ ("C,," ["C,"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("E\"\"" ["E\""])
+ ("G~~" ["G~"])
+ ("G.." ["G."])
+ ("G^^" ["G^"])
+ ("H//" ["H/"])
+ ("H^^" ["H^"])
+ ("I.." ["I."])
+ ("I``" ["I`"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("I\"\"" ["I\""])
+ ("J^^" ["J^"])
+ ("N~~" ["N~"])
+ ("O``" ["O`"])
+ ("O''" ["O'"])
+ ("O^^" ["O^"])
+ ("O\"\"" ["O\""])
+ ("S,," ["S,"])
+ ("S^^" ["S^"])
+ ("U``" ["U`"])
+ ("U''" ["U'"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("U~~" ["U~"])
+ ("Z.." ["Z."])
+ ("a``" ["a`"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a\"\"" ["a\""])
+ ("c.." ["c."])
+ ("c^^" ["c^"])
+ ("c,," ["c,"])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("e^^" ["e^"])
+ ("e\"\"" ["e\""])
+ ("g~~" ["g~"])
+ ("g.." ["g."])
+ ("g^^" ["g^"])
+ ("h//" ["h/"])
+ ("h^^" ["h^"])
+ ("i.." ["i."])
+ ("i``" ["i`"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("i\"\"" ["i\""])
+ ("j^^" ["j^"])
+ ("n~~" ["n~"])
+ ("o``" ["o`"])
+ ("o''" ["o'"])
+ ("o^^" ["o^"])
+ ("o\"\"" ["o\""])
+ ("s,," ["s,"])
+ ("s//" ["s/"])
+ ("s^^" ["s^"])
+ ("u``" ["u`"])
+ ("u''" ["u'"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("u~~" ["u~"])
+ ("z.." ["z."])
+ )
+
+(quail-define-package
+ "latin-4-postfix" "Latin-4" "4<" t
+ "Latin-4 characters input method with postfix modifiers
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ ogonek | , | a, -> ą
+ macron | - | a- -> ā
+ tilde | ~ | a~ -> ã
+ caron | ~ | c~ -> č
+ dot | . | e. -> ė
+ cedilla | , | k, -> ķ g, -> ģ
+ stroke | / | d/ -> đ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß n/ -> ŋ k/ -> ĸ
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A," ?Ą)
+ ("A-" ?Ā)
+ ("A'" ?Á)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Å)
+ ("C~" ?Č)
+ ("D/" ?Đ)
+ ("E/" ?Æ)
+ ("E-" ?Ē)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E\"" ?Ë)
+ ("E." ?Ė)
+ ("G," ?Ģ)
+ ("I~" ?Ĩ)
+ ("I," ?Į)
+ ("I'" ?Í)
+ ("I^" ?Î)
+ ("I-" ?Ī)
+ ("K," ?Ķ)
+ ("L," ?Ļ)
+ ("N/" ?Ŋ)
+ ("N," ?Ņ)
+ ("O-" ?Ō)
+ ("O^" ?Ô)
+ ("O~" ?Õ)
+ ("O\"" ?Ö)
+ ("O/" ?Ø)
+ ("R," ?Ŗ)
+ ("S~" ?Š)
+ ("T/" ?Ŧ)
+ ("U," ?Ų)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ũ)
+ ("U-" ?Ū)
+ ("Z~" ?Ž)
+ ("a," ?ą)
+ ("a-" ?ā)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?å)
+ ("c~" ?č)
+ ("d/" ?đ)
+ ("e/" ?æ)
+ ("e-" ?ē)
+ ("e'" ?é)
+ ("e," ?ę)
+ ("e\"" ?ë)
+ ("e." ?ė)
+ ("g," ?ģ)
+ ("i~" ?ĩ)
+ ("i," ?į)
+ ("i'" ?í)
+ ("i^" ?î)
+ ("i-" ?ī)
+ ("k/" ?ĸ)
+ ("k," ?ķ)
+ ("l," ?ļ)
+ ("n/" ?ŋ)
+ ("n," ?ņ)
+ ("o-" ?ō)
+ ("o^" ?ô)
+ ("o~" ?õ)
+ ("o\"" ?ö)
+ ("o/" ?ø)
+ ("r," ?ŗ)
+ ("s/" ?ß)
+ ("s~" ?š)
+ ("t/" ?ŧ)
+ ("u," ?ų)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?ũ)
+ ("u-" ?ū)
+ ("z~" ?ž)
+
+ ("A,," ["A,"])
+ ("A--" ["A-"])
+ ("A''" ["A'"])
+ ("A^^" ["A^"])
+ ("A~~" ["A~"])
+ ("A\"\"" ["A\""])
+ ("A//" ["A/"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("E//" ["E/"])
+ ("E--" ["E-"])
+ ("E''" ["E'"])
+ ("E,," ["E,"])
+ ("E\"\"" ["E\""])
+ ("E.." ["E."])
+ ("G,," ["G,"])
+ ("I~~" ["I~"])
+ ("I,," ["I,"])
+ ("I''" ["I'"])
+ ("I^^" ["I^"])
+ ("I--" ["I-"])
+ ("K,," ["K,"])
+ ("L,," ["L,"])
+ ("N//" ["N/"])
+ ("N,," ["N,"])
+ ("O--" ["O-"])
+ ("O^^" ["O^"])
+ ("O~~" ["O~"])
+ ("O\"\"" ["O\""])
+ ("O//" ["O/"])
+ ("R,," ["R,"])
+ ("S~~" ["S~"])
+ ("T//" ["T/"])
+ ("U,," ["U,"])
+ ("U''" ["U'"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("U~~" ["U~"])
+ ("U--" ["U-"])
+ ("Z~~" ["Z~"])
+ ("a,," ["a,"])
+ ("a--" ["a-"])
+ ("a''" ["a'"])
+ ("a^^" ["a^"])
+ ("a~~" ["a~"])
+ ("a\"\"" ["a\""])
+ ("a//" ["a/"])
+ ("c~~" ["c~"])
+ ("d//" ["d/"])
+ ("e//" ["e/"])
+ ("e--" ["e-"])
+ ("e''" ["e'"])
+ ("e,," ["e,"])
+ ("e\"\"" ["e\""])
+ ("e.." ["e."])
+ ("g,," ["g,"])
+ ("i~~" ["i~"])
+ ("i,," ["i,"])
+ ("i''" ["i'"])
+ ("i^^" ["i^"])
+ ("i--" ["i-"])
+ ("k//" ["k/"])
+ ("k,," ["k,"])
+ ("l,," ["l,"])
+ ("n//" ["n/"])
+ ("n,," ["n,"])
+ ("o--" ["o-"])
+ ("o^^" ["o^"])
+ ("o~~" ["o~"])
+ ("o\"\"" ["o\""])
+ ("o//" ["o/"])
+ ("r,," ["r,"])
+ ("s//" ["s/"])
+ ("s~~" ["s~"])
+ ("t//" ["t/"])
+ ("u,," ["u,"])
+ ("u''" ["u'"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("u~~" ["u~"])
+ ("u--" ["u-"])
+ ("z~~" ["z~"])
+ )
+
+(quail-define-package
+ "latin-5-postfix" "Latin-5" "5<" t
+ "Latin-5 characters input method with postfix modifiers
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ breve | ~ | g~ -> ğ
+ cedilla | , | c, -> ç
+ dot | . | i. -> ı I. -> İ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("A/" ?Å)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("C," ?Ç)
+ ("E'" ?É)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("G~" ?Ğ)
+ ("I'" ?Í)
+ ("I." ?İ)
+ ("I\"" ?Ï)
+ ("I^" ?Î)
+ ("I`" ?Ì)
+ ("N~" ?Ñ)
+ ("O'" ?Ó)
+ ("O/" ?Ø)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ò)
+ ("O~" ?Õ)
+ ("S," ?Ş)
+ ("U'" ?Ú)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("a'" ?á)
+ ("a/" ?å)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a`" ?à)
+ ("a~" ?ã)
+ ("c," ?ç)
+ ("e'" ?é)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("g~" ?ğ)
+ ("i'" ?í)
+ ("i." ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("n~" ?ñ)
+ ("o'" ?ó)
+ ("o/" ?ø)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("s," ?ş)
+ ("s/" ?ß)
+ ("u'" ?ú)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("y\"" ?ÿ)
+
+ ("A''" ["A'"])
+ ("A//" ["A/"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A``" ["A`"])
+ ("A~~" ["A~"])
+ ("C,," ["C,"])
+ ("E''" ["E'"])
+ ("E//" ["E/"])
+ ("E\"\"" ["E\""])
+ ("E^^" ["E^"])
+ ("E``" ["E`"])
+ ("G~~" ["G~"])
+ ("I''" ["I'"])
+ ("I.." ["I."])
+ ("I\"\"" ["I\""])
+ ("I^^" ["I^"])
+ ("I``" ["I`"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O//" ["O/"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("O``" ["O`"])
+ ("O~~" ["O~"])
+ ("S,," ["S,"])
+ ("U''" ["U'"])
+ ("U\"\"" ["U\""])
+ ("U^^" ["U^"])
+ ("U``" ["U`"])
+ ("a''" ["a'"])
+ ("a//" ["a/"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a``" ["a`"])
+ ("a~~" ["a~"])
+ ("c,," ["c,"])
+ ("e''" ["e'"])
+ ("e//" ["e/"])
+ ("e\"\"" ["e\""])
+ ("e^^" ["e^"])
+ ("e``" ["e`"])
+ ("g~~" ["g~"])
+ ("i''" ["i'"])
+ ("i.." ["i."])
+ ("i\"\"" ["i\""])
+ ("i^^" ["i^"])
+ ("i``" ["i`"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o//" ["o/"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("o``" ["o`"])
+ ("o~~" ["o~"])
+ ("s,," ["s,"])
+ ("s//" ["s/"])
+ ("u''" ["u'"])
+ ("u\"\"" ["u\""])
+ ("u^^" ["u^"])
+ ("u``" ["u`"])
+ ("y\"\"" ["y\""])
+ )
+
+(quail-define-package
+ "danish-postfix" "Latin-1" "DA<" t
+ "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E\\=' -> É)
+
+Doubling the postfix separates the letter and postfix: e.g. aee -> ae
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Å)
+ ("aa" ?å)
+ ("E'" ?É)
+ ("e'" ?é)
+
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("AAA" ["AA"])
+ ("aaa" ["aa"])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ )
+
+(quail-define-package
+ "esperanto-postfix" "Latin-3" "EO<" t
+ "Esperanto input method with postfix modifiers
+
+A following ^ or x will produce an accented character,
+e.g. c^ -> ĉ gx -> ĝ u^ -> ŭ.
+
+Doubling the postfix separates the letter and postfix,
+e.g. a\\='\\=' -> a\\='.
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("Cx" ?Ĉ)
+ ("C^" ?Ĉ)
+ ("cx" ?ĉ)
+ ("c^" ?ĉ)
+ ("Gx" ?Ĝ)
+ ("G^" ?Ĝ)
+ ("gx" ?ĝ)
+ ("g^" ?ĝ)
+ ("Hx" ?Ĥ)
+ ("H^" ?Ĥ)
+ ("hx" ?ĥ)
+ ("h^" ?ĥ)
+ ("Jx" ?Ĵ)
+ ("J^" ?Ĵ)
+ ("jx" ?ĵ)
+ ("j^" ?ĵ)
+ ("Sx" ?Ŝ)
+ ("S^" ?Ŝ)
+ ("sx" ?ŝ)
+ ("s^" ?ŝ)
+ ("Ux" ?Ŭ)
+ ("U^" ?Ŭ)
+ ("ux" ?ŭ)
+ ("u^" ?ŭ)
+
+ ("Cxx" ["Cx"])
+ ("C^^" ["C^"])
+ ("cxx" ["cx"])
+ ("c^^" ["c^"])
+ ("Gxx" ["Gx"])
+ ("G^^" ["G^"])
+ ("gxx" ["gx"])
+ ("g^^" ["g^"])
+ ("Hxx" ["Hx"])
+ ("H^^" ["H^"])
+ ("hxx" ["hx"])
+ ("h^^" ["h^"])
+ ("Jxx" ["Jx"])
+ ("J^^" ["J^"])
+ ("jxx" ["jx"])
+ ("j^^" ["j^"])
+ ("Sxx" ["Sx"])
+ ("S^^" ["S^"])
+ ("sxx" ["sx"])
+ ("s^^" ["s^"])
+ ("Uxx" ["Ux"])
+ ("U^^" ["U^"])
+ ("uxx" ["ux"])
+ ("u^^" ["u^"])
+ )
+
+(quail-define-package
+ "finnish-postfix" "Latin-1" "FI<" t
+ "Finnish (Suomi) input method
+
+AE -> Ä
+AEE -> AE
+OE -> Ö
+OEE -> OE
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ )
+
+(quail-define-package
+ "french-postfix" "French" "FR<" t
+ "French (Français) input method with postfix modifiers
+
+\\=` pour grave, \\=' pour aigu, ^ pour circonflexe, et \" pour tréma.
+Par exemple: a\\=` -> à e\\=' -> é.
+
+Ç, «, et » sont produits par C,, <<, et >>.
+
+En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
+Par exemple: e\\='\\=' -> e\\='
+
+Πest produit par O/."
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("A^" ?Â)
+ ("a`" ?à)
+ ("a^" ?â)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("I^" ?Î)
+ ("I\"" ?Ï)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("O^" ?Ô)
+ ("O/" ?Œ)
+ ("o^" ?ô)
+ ("o/" ?œ)
+ ("U`" ?Ù)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("u`" ?ù)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("<<" ?«)
+ (">>" ?»)
+
+ ("A``" ["A`"])
+ ("A^^" ["A^"])
+ ("a``" ["a`"])
+ ("a^^" ["a^"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("E^^" ["E^"])
+ ("E\"\"" ["E\""])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("e^^" ["e^"])
+ ("e\"\"" ["e\""])
+ ("I^^" ["I^"])
+ ("I\"\"" ["I\""])
+ ("i^^" ["i^"])
+ ("i\"\"" ["i\""])
+ ("O^^" ["O^"])
+ ("O//" ["O/"])
+ ("o^^" ["o^"])
+ ("o//" ["o/"])
+ ("U``" ["U`"])
+ ("U^^" ["U^"])
+ ("U\"\"" ["U\""])
+ ("u``" ["u`"])
+ ("u^^" ["u^"])
+ ("u\"\"" ["u\""])
+ ("C,," ["C,"])
+ ("c,," ["c,"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ )
+
+(quail-define-package
+ "german-postfix" "German" "DE<" t
+ "German (Deutsch) input method
+
+ae -> ä
+aee -> ae
+oe -> ö
+oee -> oe
+ue -> ü (not after a/e/q)
+uee -> ue
+sz -> ß
+szz -> sz
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("UE" ?Ü)
+ ("ue" ?ü)
+ ("sz" ?ß)
+
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("UEE" ["UE"])
+ ("uee" ["ue"])
+ ("szz" ["sz"])
+ ("ge" ["ge"])
+ ("eue" ["eue"])
+ ("Eue" ["Eue"])
+ ("aue" ["aue"])
+ ("Aue" ["Aue"])
+ ("que" ["que"])
+ ("Que" ["Que"])
+)
+
+(quail-define-package
+ "icelandic-postfix" "Latin-1" "IS<" t
+ "Icelandic (Íslenska) input method with postfix modifiers
+
+A\\=' -> Á
+E\\=' -> É
+I\\=' -> Í
+O\\=' -> Ó
+U\\=' -> Ú
+Y\\=' -> Ý
+AE -> Æ
+OE -> Ö
+D/ -> Ð (eth)
+T/ -> Þ (thorn)
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("a'" ?á)
+ ("E'" ?É)
+ ("e'" ?é)
+ ("I'" ?Í)
+ ("i'" ?í)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("Y'" ?Ý)
+ ("y'" ?ý)
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("D/" ?Ð)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
+
+ ("A''" ["A'"])
+ ("a''" ["a'"])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ ("I''" ["I'"])
+ ("i''" ["i'"])
+ ("O''" ["O'"])
+ ("o''" ["o'"])
+ ("U''" ["U'"])
+ ("u''" ["u'"])
+ ("Y''" ["Y'"])
+ ("y''" ["y'"])
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("D//" ["D/"])
+ ("d//" ["d/"])
+ ("T//" ["T/"])
+ ("t//" ["t/"])
+ )
+
+(quail-define-package
+ "italian-postfix" "Latin-1" "IT<" t
+ "Italian (Italiano) input method with postfix modifiers
+
+a\\=` -> à A\\=` -> À e\\=' -> é << -> «
+e\\=` -> è E\\=` -> È E\\=' -> É >> -> »
+i\\=` -> ì I\\=` -> Ì o_ -> º
+o\\=` -> ò O\\=` -> Ò a_ -> ª
+u\\=` -> ù U\\=` -> Ù
+
+Typewriter-style italian characters.
+
+Doubling the postfix separates the letter and postfix: e.g. a\\=`\\=` -> a\\=`
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A`" ?À)
+ ("a`" ?à)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("O`" ?Ò)
+ ("o`" ?ò)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
+
+ ("A``" ["A`"])
+ ("a``" ["a`"])
+ ("E``" ["E`"])
+ ("E''" ["E'"])
+ ("e``" ["e`"])
+ ("e''" ["e'"])
+ ("I``" ["I`"])
+ ("i``" ["i`"])
+ ("O``" ["O`"])
+ ("o``" ["o`"])
+ ("U``" ["U`"])
+ ("u``" ["u`"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("o__" ["o_"])
+ ("a__" ["a_"])
+ )
+
+(quail-define-package
+ "norwegian-postfix" "Latin-1" "NO<" t
+ "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E\\='->É)
+
+Doubling the postfix separates the letter and postfix: e.g. aee -> ae
+"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Å)
+ ("aa" ?å)
+ ("E'" ?É)
+ ("e'" ?é)
+
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("AAA" ["AA"])
+ ("aaa" ["aa"])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ )
+
+(quail-define-package
+ "scandinavian-postfix" "Latin-1" "SC<" t
+ "Scandinavian input method with postfix modifiers
+Supported languages are Swedish, Norwegian, Danish, and Finnish.
+
+ae -> æ
+oe -> ø
+aa -> å
+a\" -> ä
+o\" -> ö
+e\\=' -> é
+
+Doubling the postfix separates the letter and postfix:
+aee -> ae o\"\" -> o\" etc.
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Å)
+ ("aa" ?å)
+ ("A\"" ?Ä)
+ ("a\"" ?ä)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("E'" ?É)
+ ("e'" ?é)
+
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("AAA" ["AA"])
+ ("aaa" ["aa"])
+ ("A\"\"" ["A\""])
+ ("a\"\"" ["a\""])
+ ("O\"\"" ["O\""])
+ ("o\"\"" ["o\""])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ )
+
+(quail-define-package
+ "spanish-postfix" "Spanish" "ES<" t
+ "Spanish (Español) input method with postfix modifiers
+
+A\\=' -> Á
+E\\=' -> É
+I\\=' -> Í
+O\\=' -> Ó
+U\\=' -> Ú
+N~ -> Ñ
+!/ -> ¡
+?/ -> ¿
+
+Doubling the postfix separates the letter and postfix:
+a\\='\\=' -> a\\=' n~~ -> n~, etc.
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A'" ?Á)
+ ("a'" ?á)
+ ("E'" ?É)
+ ("e'" ?é)
+ ("I'" ?Í)
+ ("i'" ?í)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
+
+ ("A''" ["A'"])
+ ("a''" ["a'"])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ ("I''" ["I'"])
+ ("i''" ["i'"])
+ ("O''" ["O'"])
+ ("o''" ["o'"])
+ ("U''" ["U'"])
+ ("u''" ["u'"])
+ ("U\"" ["U\""])
+ ("u\"" ["U\""])
+ ("N~~" ["N~"])
+ ("n~~" ["n~"])
+ ("?//" ["?/"])
+ ("!//" ["!/"])
+ )
+
+(quail-define-package
+ "swedish-postfix" "Latin-1" "SV<" t
+ "Swedish (Svenska) input method (rule: AA -> Å AE -> Ä OE -> Ö E\\=' -> É)
+
+Doubling the postfix separates the letter and postfix: e.g. aee -> ae
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("AA" ?Å)
+ ("aa" ?å)
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("E'" ?É)
+ ("e'" ?é)
+
+ ("AAA" ["AA"])
+ ("aaa" ["aa"])
+ ("AEE" ["AE"])
+ ("aee" ["ae"])
+ ("OEE" ["OE"])
+ ("oee" ["oe"])
+ ("E''" ["E'"])
+ ("e''" ["e'"])
+ )
+
+(quail-define-package
+ "turkish-postfix" "Turkish" "TR<" t
+ "Turkish (Türkçe) input method with postfix modifiers.
+turkish-latin-3-postfix is an obsolete alias for turkish-postfix.
+
+Note for I, ı, İ, i.
+
+A^ -> Â
+C, -> Ç
+G^ -> Ğ
+I -> I
+i -> ı
+I. -> İ
+i. -> i
+O\" -> Ö
+S, -> Ş
+U\" -> Ü
+U^ -> Û
+
+Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A^" ?Â)
+ ("a^" ?â)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("G^" ?Ğ)
+ ("g^" ?ğ)
+ ("I." ?İ)
+ ("i" ?ı)
+ ("i." ?i)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("S," ?Ş)
+ ("s," ?ş)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("U^" ?Û)
+ ("u^" ?û)
+
+ ("A^^" ["A^"])
+ ("a^^" ["a^"])
+ ("C,," ["C,"])
+ ("c,," ["c,"])
+ ("G^^" ["G^"])
+ ("g^^" ["g^"])
+ ("I.." ["I."])
+ ("i" ["i"])
+ ("i.." ["i."])
+ ("O\"\"" ["O\""])
+ ("o\"\"" ["o\""])
+ ("S,," ["S,"])
+ ("s,," ["s,"])
+ ("U\"\"" ["U\""])
+ ("u\"\"" ["u\""])
+ ("U^^" ["U^"])
+ ("u^^" ["u^"])
+ )
+
+;; Backwards compatibility.
+(push (cons "turkish-latin-3-postfix"
+ (cdr (assoc "turkish-postfix" quail-package-alist)))
+ quail-package-alist)
+
+(quail-define-package
+ "british" "Latin-1" "£@" t
+ "British English input method with Latin-1 character £ (# -> £)"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("#" [?£ ?#])
+ )
+
+;; The following are various quail packages for those who think
+;; the above are too awkward. Supported languages and their
+;; package name are:
+;;
+;; French (frnch, azerty)
+;; Icelandic (iclndc)
+;; Denish (dnsh)
+;; Norwegian (nrwgn)
+;; Swedish (swdsh)
+;; Finnish (fnnsh)
+;; German (grmn)
+;; Italian (itln)
+;; Spanish (spnsh)
+;; Dvorak (dvorak)
+;;
+;;; 92.12.15 created for Mule Ver.0.9.6 by Takahashi N. <ntakahas@etl.go.jp>
+;;; 92.12.29 modified by Takahashi N. <ntakahas@etl.go.jp>
+
+;;
+(quail-define-package
+ "french-keyboard" "French" "FR@" t
+ "French (Français) input method simulating some French keyboard
+<e dans l'o> n'est pas disponible." nil t t t t nil nil nil nil nil t)
+
+;; ê1 é2 è3 ô4 î5 ï6 â7 û8 ù9 à0 -_ ë+ `~
+;; qQ wW eE rR tT yY uU iI oO pP çÇ ü&
+;; aA sS dD fF gG hH jJ kK lL ;: '" \|
+;; zZ xX cC vV bB nN mM ,( .) !?
+
+(quail-define-rules
+ ("1" ?ê)
+ ("2" ?é)
+ ("3" ?è)
+ ("4" ?ô)
+ ("5" ?î)
+ ("6" ?ï)
+ ("7" ?â)
+ ("8" ?û)
+ ("9" ?ù)
+ ("0" ?à)
+ ("=" ?ë)
+ ("[" ?ç)
+ ("]" ?ü)
+
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("{" ?Ç)
+ ("}" ?&)
+ ("<" ?\()
+ (">" ?\))
+ )
+
+;;
+(quail-define-package
+ "french-azerty" "French" "AZ@" t
+ "French (Français) input method simulating Azerty keyboard
+
+Similaire au clavier français de SUN.
+préfixes: ^ pour circonflexe, ¨ pour tréma.
+<e dans l'o> n'est pas disponible." nil t t t t nil nil nil nil nil t)
+
+;; &1 é2 "3 '4 (5 §6 è7 !8 ç9 à0 )° -_ @~
+;; aA zZ eE rR tT yY uU iI oO pP ^¨ `$
+;; qQ sS dD fF gG hH jJ kK lL mM ù% *|
+;; wW xX cC vV bB nN ,? ;. :/ =+
+
+(quail-define-rules
+ ("1" ?&)
+ ("2" ?é)
+ ("3" ?\")
+ ("4" ?')
+ ("5" ?\()
+ ("6" ?§)
+ ("7" ?è)
+ ("8" ?!)
+ ("9" ?ç)
+ ("0" ?à)
+ ("-" ?\))
+ ("=" ?-)
+ ("`" ?@)
+ ("q" ?a)
+ ("w" ?z)
+ ("e" ?e)
+ ("r" ?r)
+ ("t" ?t)
+ ("y" ?y)
+ ("u" ?u)
+ ("i" ?i)
+ ("o" ?o)
+ ("p" ?p)
+ ("[" ?^)
+ ("]" ?`)
+ ("a" ?q)
+ ("s" ?s)
+ ("d" ?d)
+ ("f" ?f)
+ ("g" ?g)
+ ("h" ?h)
+ ("j" ?j)
+ ("k" ?k)
+ ("l" ?l)
+ (";" ?m)
+ ("'" ?ù)
+ ("\\" ?*)
+ ("z" ?w)
+ ("x" ?x)
+ ("c" ?c)
+ ("v" ?v)
+ ("b" ?b)
+ ("n" ?n)
+ ("m" ?,)
+ ("," ?\;)
+ ("." ?:)
+ ("/" ?=)
+
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("_" ?°)
+ ("+" ?_)
+ ("~" ?~)
+ ("Q" ?A)
+ ("W" ?Z)
+ ("E" ?E)
+ ("R" ?R)
+ ("T" ?T)
+ ("Y" ?Y)
+ ("U" ?U)
+ ("I" ?I)
+ ("O" ?O)
+ ("P" ?P)
+ ("{" ?¨)
+ ("}" ?$)
+ ("A" ?Q)
+ ("S" ?S)
+ ("D" ?D)
+ ("F" ?F)
+ ("G" ?G)
+ ("H" ?H)
+ ("J" ?J)
+ ("K" ?K)
+ ("L" ?L)
+ (":" ?M)
+ ("\"" ?%)
+ ("|" ?|)
+ ("Z" ?W)
+ ("X" ?X)
+ ("C" ?C)
+ ("V" ?V)
+ ("B" ?B)
+ ("N" ?N)
+ ("M" ??)
+ ("<" ?.)
+ (">" ?/)
+ ("?" ?+)
+
+ ("[q" ?â)
+ ("[e" ?ê)
+ ("[i" ?î)
+ ("[o" ?ô)
+ ("[u" ?û)
+
+ ("{e" ?ë)
+ ("{i" ?ï)
+ ("{u" ?ü)
+
+ ("[[" ?^)
+ ("{{" ?¨)
+ )
+
+;;
+(quail-define-package
+ "icelandic-keyboard" "Latin-1" "IS@" t
+ "Icelandic (Íslenska) input method simulating some Icelandic keyboard
+
+Dead accent is right to æ." nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4$ 5% 6^ 7& 8* 9( 0) öÖ -_ `~
+;; qQ wW eE rR tT yY uU iI oO pP ðÐ '?
+;; aA sS dD fF gG hH jJ kK lL æÆ ´´ +*
+;; zZ xX cC vV bB nN mM ,; .: þÞ
+
+(quail-define-rules
+ ("-" ?ö)
+ ("=" ?-)
+ ("[" ?ð)
+ ("]" ?')
+ (";" ?æ)
+ ("'" ?´)
+ ("\\" ?+)
+ ("/" ?þ)
+
+ ("@" ?\")
+ ("_" ?Ö)
+ ("+" ?_)
+ ("{" ?Ð)
+ ("}" ??)
+ (":" ?Æ)
+ ("\"" ?´)
+ ("|" ?*)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?Þ)
+
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ý)
+
+ ("''" ?´)
+ )
+
+;;
+(quail-define-package
+ "danish-keyboard" "Latin-1" "DA@" t
+ "Danish input method simulating SUN Danish keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? ½§ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL æÆ øØ '*
+;; zZ xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?+)
+ ("=" ?½)
+ ("`" ?~)
+ ("[" ?å)
+ ("]" ?é)
+ (";" ?æ)
+ ("'" ?ø)
+ ("\\" ?')
+ ("/" ?-)
+
+ ("@" ?\")
+ ("$" ?¤)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?§)
+ ("~" ?^)
+ ("{" ?Å)
+ ("}" ?É)
+ (":" ?Æ)
+ ("\"" ?Ø)
+ ("|" ?*)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "norwegian-keyboard" "Latin-1" "NO@" t
+ "Norwegian (Norsk) input method simulating SUN Norwegian keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? |§ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL øØ æÆ '*
+;; zZ xX cC vV bB nN mM ,; .: '?
+
+(quail-define-rules
+ ("-" ?+)
+ ("=" ?|)
+ ("`" ?~)
+ ("[" ?å)
+ ("]" ?é)
+ (";" ?ø)
+ ("'" ?æ)
+ ("\\" ?')
+ ("/" ?-)
+
+ ("!" ?!)
+ ("@" ?\")
+ ("$" ?¤)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?§)
+ ("~" ?^)
+ ("{" ?Å)
+ ("}" ?É)
+ (":" ?Ø)
+ ("\"" ?Æ)
+ ("|" ?*)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "swedish-keyboard" "Latin-1" "SV@" t
+ "Swedish (Svenska) input method simulating SUN Swedish/Finnish keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? §½ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ '*
+;; zZ xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?+)
+ ("=" ?§)
+ ("`" ?~)
+ ("[" ?å)
+ ("]" ?é)
+ (";" ?ö)
+ ("'" ?ä)
+ ("\\" ?')
+ ("/" ?-)
+
+ ("@" ?\")
+ ("$" ?¤)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?½)
+ ("~" ?^)
+ ("{" ?Å)
+ ("}" ?É)
+ (":" ?Ö)
+ ("\"" ?Ä)
+ ("|" ?*)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "finnish-keyboard" "Latin-1" "FI@" t
+ "Finnish input method simulating SUN Finnish/Swedish keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? §½ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ '*
+;; zZ xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?+)
+ ("=" ?§)
+ ("`" ?~)
+ ("[" ?å)
+ ("]" ?é)
+ (";" ?ö)
+ ("'" ?ä)
+ ("\\" ?')
+ ("/" ?-)
+
+ ("@" ?\")
+ ("$" ?¤)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?½)
+ ("~" ?^)
+ ("{" ?Å)
+ ("}" ?É)
+ (":" ?Ö)
+ ("\"" ?Ä)
+ ("|" ?*)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "german" "German" "DE@" t
+ "German (Deutsch) input method simulating SUN German keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3§ 4$ 5% 6& 7/ 8( 9) 0= ß? [{ ]}
+;; qQ wW eE rR tT zZ uU iI oO pP üÜ +*
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ #^
+;; yY xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?ß)
+ ("=" ?\[)
+ ("`" ?\])
+ ("y" ?z)
+ ("[" ?ü)
+ ("]" ?+)
+ (";" ?ö)
+ ("'" ?ä)
+ ("\\" ?#)
+ ("z" ?y)
+ ("/" ?-)
+
+ ("@" ?\")
+ ("#" ?§)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("Y" ?Z)
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?{)
+ ("~" ?})
+ ("{" ?Ü)
+ ("}" ?*)
+ (":" ?Ö)
+ ("\"" ?Ä)
+ ("|" ?^)
+ ("Z" ?Y)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "italian-keyboard" "Latin-1" "IT@" t
+ "Italian (Italiano) input method simulating SUN Italian keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3£ 4$ 5% 6& 7/ 8( 9) 0= '? ì^ `~
+;; qQ wW eE rR tT yY uU iI oO pP èé +*
+;; aA sS dD fF gG hH jJ kK lL òç à° ù§
+;; zZ xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?')
+ ("=" ?ì)
+ ("[" ?è)
+ ("]" ?+)
+ (";" ?ò)
+ ("'" ?à)
+ ("\\" ?ù)
+ ("/" ?-)
+
+ ("@" ?\")
+ ("#" ?£)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?^)
+ ("~" ?~)
+ ("{" ?é)
+ ("}" ?*)
+ (":" ?ç)
+ ("\"" ?°)
+ ("|" ?§)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "spanish-keyboard" "Spanish" "ES@" t
+ "Spanish (Español) input method simulating SUN Spanish keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2" 3· 4$ 5% 6& 7/ 8( 9) 0= '? ¡¿ íÍ
+;; qQ wW eE rR tT yY uU iI oO pP éÉ óÓ
+;; aA sS dD fF gG hH jJ kK lL ñÑ áÁ úÚ
+;; zZ xX cC vV bB nN mM ,; .: -_
+
+(quail-define-rules
+ ("-" ?')
+ ("=" ?¡)
+ ("`" ?í)
+ ("[" ?é)
+ ("]" ?ó)
+ (";" ?ñ)
+ ("'" ?á)
+ ("\\" ?ú)
+ ("/" ?-)
+
+ ("@" ?\")
+ ("#" ?·)
+ ("^" ?&)
+ ("&" ?/)
+ ("*" ?\()
+ ("(" ?\))
+ (")" ?=)
+ ("_" ??)
+ ("+" ?¿)
+ ("~" ?Í)
+ ("{" ?É)
+ ("}" ?Ó)
+ (":" ?Ñ)
+ ("\"" ?Á)
+ ("|" ?Ú)
+ ("<" ?\;)
+ (">" ?:)
+ ("?" ?_)
+ )
+
+;;
+(quail-define-package
+ "english-dvorak" "English" "DV@" t
+ "English (ASCII) input method simulating Dvorak keyboard"
+ nil t t t t nil nil nil nil nil t)
+
+;; 1! 2@ 3# 4$ 5% 6^ 7& 8* 9( 0) [{ ]} `~
+;; '" ,< .> pP yY fF gG cC rR lL /? =+
+;; aA oO eE uU iI dD hH tT nN sS -_ \|
+;; ;: qQ jJ kK xX bB mM wW vV zZ
+
+(quail-define-rules
+ ("-" ?\[)
+ ("=" ?\])
+ ("`" ?`)
+ ("q" ?')
+ ("w" ?,)
+ ("e" ?.)
+ ("r" ?p)
+ ("t" ?y)
+ ("y" ?f)
+ ("u" ?g)
+ ("i" ?c)
+ ("o" ?r)
+ ("p" ?l)
+ ("[" ?/)
+ ("]" ?=)
+ ("a" ?a)
+ ("s" ?o)
+ ("d" ?e)
+ ("f" ?u)
+ ("g" ?i)
+ ("h" ?d)
+ ("j" ?h)
+ ("k" ?t)
+ ("l" ?n)
+ (";" ?s)
+ ("'" ?-)
+ ("\\" ?\\)
+ ("z" ?\;)
+ ("x" ?q)
+ ("c" ?j)
+ ("v" ?k)
+ ("b" ?x)
+ ("n" ?b)
+ ("m" ?m)
+ ("," ?w)
+ ("." ?v)
+ ("/" ?z)
+
+ ("_" ?{)
+ ("+" ?})
+ ("~" ?~)
+ ("Q" ?\")
+ ("W" ?<)
+ ("E" ?>)
+ ("R" ?P)
+ ("T" ?Y)
+ ("Y" ?F)
+ ("U" ?G)
+ ("I" ?C)
+ ("O" ?R)
+ ("P" ?L)
+ ("{" ??)
+ ("}" ?+)
+ ("A" ?A)
+ ("S" ?O)
+ ("D" ?E)
+ ("F" ?U)
+ ("G" ?I)
+ ("H" ?D)
+ ("J" ?H)
+ ("K" ?T)
+ ("L" ?N)
+ (":" ?S)
+ ("\"" ?_)
+ ("|" ?|)
+ ("Z" ?:)
+ ("X" ?Q)
+ ("C" ?J)
+ ("V" ?K)
+ ("B" ?X)
+ ("N" ?B)
+ ("M" ?M)
+ ("<" ?W)
+ (">" ?V)
+ ("?" ?Z)
+ )
+
+(quail-define-package
+ "latin-postfix" "Latin" "L<" t
+ "Latin character input method with postfix modifiers.
+This is the union of various input methods originally made for input
+of characters from a single Latin-N charset.
+
+ | postfix | examples
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | , | c, -> ç
+ ogonek | , | a, -> ą
+ breve | ~ | a~ -> ă
+ caron | ~ | c~ -> č
+ dbl. acute | : | o: -> ő
+ ring | . | u. -> ů
+ dot | . | z. -> ż
+ stroke | / | d/ -> đ
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> ° o/ -> œ
+ | various | << -> « >> -> » o_ -> º a_ -> ª
+
+Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
+" nil t nil nil nil nil nil nil nil nil t)
+
+;; Fixme: ¦ § ¨ © ¬ ­ ® ¯ ± ² ³ ´ µ ¶ · ¸ ¹ ¼ ½ ¾ × ÷
+(quail-define-rules
+ (" _" ? )
+ ("!/" ?¡)
+ ("//" ?°)
+ ("<<" ?\«)
+ (">>" ?\»)
+ ("?/" ?¿)
+ ("$/" ?£)
+ ("$/" ?¤)
+ ("A'" ?Á)
+ ("A," ?Ą)
+ ("A-" ?Ā)
+ ("A/" ?Å)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("A~" ?Ă)
+ ("C'" ?Ć)
+ ("C," ?Ç)
+ ("C." ?Ċ)
+ ("C^" ?Ĉ)
+ ("C~" ?Č)
+ ("D/" ?Ð)
+ ("D/" ?Đ)
+ ("D~" ?Ď)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E-" ?Ē)
+ ("E." ?Ė)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("E~" ?Ě)
+ ("G," ?Ģ)
+ ("G." ?Ġ)
+ ("G^" ?Ĝ)
+ ("G~" ?Ğ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I'" ?Í)
+ ("I," ?Į)
+ ("I-" ?Ī)
+ ("I." ?İ)
+ ("I\"" ?Ï)
+ ("I^" ?Î)
+ ("I`" ?Ì)
+ ("I~" ?Ĩ)
+ ("J^" ?Ĵ)
+ ("K," ?Ķ)
+ ("L'" ?Ĺ)
+ ("L," ?Ļ)
+ ("L/" ?Ł)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N," ?Ņ)
+ ("N/" ?Ŋ)
+ ("N~" ?Ñ)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O-" ?Ō)
+ ("O/" ?Ø)
+ ("O/" ?Œ)
+ ("O:" ?Ő)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ò)
+ ("O~" ?Õ)
+ ("R'" ?Ŕ)
+ ("R," ?Ŗ)
+ ("R~" ?Ř)
+ ("S'" ?Ś)
+ ("S," ?Ş)
+ ("S^" ?Ŝ)
+ ("S~" ?Š)
+ ("T," ?Ţ)
+ ("T/" ?Þ)
+ ("T/" ?Ŧ)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U," ?Ų)
+ ("U-" ?Ū)
+ ("U." ?Ů)
+ ("U:" ?Ű)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("U~" ?Ũ)
+ ("U~" ?Ŭ)
+ ("Y'" ?Ý)
+ ("Y\"" ?Ÿ)
+ ("Y=" ?¥)
+ ("Z'" ?Ź)
+ ("Z." ?Ż)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a," ?ą)
+ ("a-" ?ā)
+ ("a/" ?å)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a_" ?ª)
+ ("a`" ?à)
+ ("a~" ?ã)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c," ?ç)
+ ("c." ?ċ)
+ ("c^" ?ĉ)
+ ("c~" ?č)
+ ("c/" ?¢)
+ ("d/" ?ð)
+ ("d/" ?đ)
+ ("d~" ?ď)
+ ("e'" ?é)
+ ("e," ?ę)
+ ("e-" ?ē)
+ ("e." ?ė)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("e~" ?ě)
+ ("e=" ?€)
+ ("g," ?ģ)
+ ("g." ?ġ)
+ ("g^" ?ĝ)
+ ("g~" ?ğ)
+ ("h/" ?ħ)
+ ("h^" ?ĥ)
+ ("i'" ?í)
+ ("i," ?į)
+ ("i-" ?ī)
+ ("i." ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("i~" ?ĩ)
+ ("j^" ?ĵ)
+ ("k," ?ķ)
+ ("k/" ?ĸ)
+ ("l'" ?ĺ)
+ ("l," ?ļ)
+ ("l/" ?ł)
+ ("l~" ?ľ)
+ ("n'" ?ń)
+ ("n," ?ņ)
+ ("n/" ?ŋ)
+ ("n~" ?ñ)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o-" ?ō)
+ ("o/" ?ø)
+ ("o/" ?œ)
+ ("o:" ?ő)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o_" ?º)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("r'" ?ŕ)
+ ("r," ?ŗ)
+ ("r~" ?ř)
+ ("s'" ?ś)
+ ("s," ?ş)
+ ("s/" ?ß)
+ ("s^" ?ŝ)
+ ("s~" ?š)
+ ("t," ?ţ)
+ ("t/" ?þ)
+ ("t/" ?ŧ)
+ ("t~" ?ť)
+ ("u'" ?ú)
+ ("u," ?ų)
+ ("u-" ?ū)
+ ("u." ?ů)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("u~" ?ũ)
+ ("u~" ?ŭ)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("z'" ?ź)
+ ("z." ?ż)
+ ("z~" ?ž)
+
+ (" __" [" _"])
+ ("!//" ["!/"])
+ ("///" ["//"])
+ ("<<<" ["<<"])
+ (">>>" [">>"])
+ ("?//" ["?/"])
+ ("$//" ["$/"])
+ ("A''" ["A'"])
+ ("A,," ["A,"])
+ ("A--" ["A-"])
+ ("A//" ["A/"])
+ ("A\"\"" ["A\""])
+ ("A^^" ["A^"])
+ ("A``" ["A`"])
+ ("A~~" ["A~"])
+ ("C''" ["C'"])
+ ("C,," ["C,"])
+ ("C.." ["C."])
+ ("C^^" ["C^"])
+ ("C~~" ["C~"])
+ ("D//" ["D/"])
+ ("D~~" ["D~"])
+ ("E''" ["E'"])
+ ("E,," ["E,"])
+ ("E--" ["E-"])
+ ("E.." ["E."])
+ ("E//" ["E/"])
+ ("E\"\"" ["E\""])
+ ("E^^" ["E^"])
+ ("E``" ["E`"])
+ ("E~~" ["E~"])
+ ("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`"])
+ ("I~~" ["I~"])
+ ("J^^" ["J^"])
+ ("K,," ["K,"])
+ ("L''" ["L'"])
+ ("L,," ["L,"])
+ ("L//" ["L/"])
+ ("L~~" ["L~"])
+ ("N''" ["N'"])
+ ("N,," ["N,"])
+ ("N//" ["N/"])
+ ("N~~" ["N~"])
+ ("O''" ["O'"])
+ ("O--" ["O-"])
+ ("O//" ["O/"])
+ ("O::" ["O:"])
+ ("O\"\"" ["O\""])
+ ("O^^" ["O^"])
+ ("O``" ["O`"])
+ ("O~~" ["O~"])
+ ("R''" ["R'"])
+ ("R,," ["R,"])
+ ("R~~" ["R~"])
+ ("S''" ["S'"])
+ ("S,," ["S,"])
+ ("S^^" ["S^"])
+ ("S~~" ["S~"])
+ ("T,," ["T,"])
+ ("T//" ["T/"])
+ ("T~~" ["T~"])
+ ("U''" ["U'"])
+ ("U,," ["U,"])
+ ("U--" ["U-"])
+ ("U.." ["U."])
+ ("U::" ["U:"])
+ ("U\"\"" ["U\""])
+ ("U^^" ["U^"])
+ ("U``" ["U`"])
+ ("U~~" ["U~"])
+ ("Y''" ["Y'"])
+ ("Y\"\"" ["Y\""])
+ ("Y==" ["Y="])
+ ("Z''" ["Z'"])
+ ("Z.." ["Z."])
+ ("Z~~" ["Z~"])
+ ("a''" ["a'"])
+ ("a,," ["a,"])
+ ("a--" ["a-"])
+ ("a//" ["a/"])
+ ("a\"\"" ["a\""])
+ ("a^^" ["a^"])
+ ("a__" ["a_"])
+ ("a``" ["a`"])
+ ("a~~" ["a~"])
+ ("c''" ["c'"])
+ ("c,," ["c,"])
+ ("c.." ["c."])
+ ("c^^" ["c^"])
+ ("c~~" ["c~"])
+ ("c//" ["c/"])
+ ("d//" ["d/"])
+ ("d~~" ["d~"])
+ ("e''" ["e'"])
+ ("e,," ["e,"])
+ ("e--" ["e-"])
+ ("e.." ["e."])
+ ("e//" ["e/"])
+ ("e\"\"" ["e\""])
+ ("e^^" ["e^"])
+ ("e``" ["e`"])
+ ("e==" ["e="])
+ ("e~~" ["e~"])
+ ("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`"])
+ ("i~~" ["i~"])
+ ("j^^" ["j^"])
+ ("k,," ["k,"])
+ ("k//" ["k/"])
+ ("l''" ["l'"])
+ ("l,," ["l,"])
+ ("l//" ["l/"])
+ ("l~~" ["l~"])
+ ("n''" ["n'"])
+ ("n,," ["n,"])
+ ("n//" ["n/"])
+ ("n~~" ["n~"])
+ ("o''" ["o'"])
+ ("o--" ["o-"])
+ ("o//" ["o/"])
+ ("o::" ["o:"])
+ ("o\"\"" ["o\""])
+ ("o^^" ["o^"])
+ ("o__" ["o_"])
+ ("o``" ["o`"])
+ ("o~~" ["o~"])
+ ("r''" ["r'"])
+ ("r,," ["r,"])
+ ("r~~" ["r~"])
+ ("s''" ["s'"])
+ ("s,," ["s,"])
+ ("s//" ["s/"])
+ ("s^^" ["s^"])
+ ("s~~" ["s~"])
+ ("t,," ["t,"])
+ ("t//" ["t/"])
+ ("t~~" ["t~"])
+ ("u''" ["u'"])
+ ("u,," ["u,"])
+ ("u--" ["u-"])
+ ("u.." ["u."])
+ ("u::" ["u:"])
+ ("u\"\"" ["u\""])
+ ("u^^" ["u^"])
+ ("u``" ["u`"])
+ ("u~~" ["u~"])
+ ("y''" ["y'"])
+ ("y\"\"" ["y\""])
+ ("z''" ["z'"])
+ ("z.." ["z."])
+ ("z~~" ["z~"])
+ )
+
+;; Derived from Slovenian.kmap from Yudit
+;; attributed as: 2001-11-11 Roman Maurer <roman.maurer@amis.net>
+(quail-define-package
+ "slovenian" "Slovenian" "Sl" t
+ "Slovenian postfix input."
+ nil t t t nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("C<" ?Č)
+ ("C'" ?Ć)
+ ("D;" ?Đ)
+ ("S<" ?Š)
+ ("Z<" ?Ž)
+ ("c<" ?č)
+ ("c'" ?ć)
+ ("d;" ?đ)
+ ("s<" ?š)
+ ("z<" ?ž))
+
+;;; latin-post.el ends here
diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el
new file mode 100644
index 00000000000..7e4fd438cdd
--- /dev/null
+++ b/lisp/leim/quail/latin-pre.el
@@ -0,0 +1,1194 @@
+;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: mule, multilingual, latin, input method
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Key translation maps were originally copied from iso-acc.el.
+;; latin-1-prefix: extra special characters added, adapted from the vim
+;; digraphs (from J.H.M.Dassen <jdassen@wi.leidenuniv.nl>)
+;; by R.F. Smith <rsmith@xs4all.nl>
+;;
+;; polish-slash:
+;; Author: Włodek Bzyl <matwb@univ.gda.pl>
+;; Maintainer: Włodek Bzyl <matwb@univ.gda.pl>
+;;
+;; latin-[89]-prefix: Dave Love <fx@gnu.org>
+
+;; You might make extra input sequences on the basis of the X
+;; locale/*/Compose files (which have both prefix and postfix
+;; sequences), but bear in mind that sequences which are logical in
+;; that context may not be sensible when they're not signaled with
+;; the Compose key. An example is a double space for NBSP.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "latin-1-prefix" "Latin-1" "1>" t
+ "Latin-1 characters input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á, \\='\\=' -> ´
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ¸
+ | ~ | ~s -> § ~x -> ¤ ~. -> · ~$ -> £ ~u -> µ
+ | ~ | ~p -> ¶ ~- -> ­ ~= -> ¯ ~| -> ¦
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ | _ / | _: -> ÷ /c -> ¢ /2 -> ½ /4 -> ¼ /3 -> ¾
+ | _ / | /= -> ¬
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ý)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("''" ?´)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ò)
+ ("`U" ?Ù)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("``" ?`)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?Î)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"y" ?ÿ)
+ ("\"\"" ?¨)
+ ("\" " ?\")
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ð)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~T" ?Þ)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~t" ?þ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
+ ("~~" ?¸)
+ ("~ " ?~)
+ ("/A" ?Å)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?å)
+ ("/e" ?æ)
+ ("/o" ?ø)
+ ("//" ?°)
+ ("/ " ?/)
+ ("_o" ?º)
+ ("_a" ?ª)
+ ("_ " ? )
+;; Symbols added by Roland Smith <rsmith@xs4all.nl>
+ ("_+" ?±)
+ ("_y" ?¥)
+ ("_:" ?÷)
+ ("__" ?_)
+ ("/c" ?¢)
+ ("/\\" ?×)
+ ("/2" ?½)
+ ("/4" ?¼)
+ ("/3" ?¾)
+ ("~s" ?§)
+ ("~p" ?¶)
+ ("~x" ?¤)
+ ("~." ?·)
+ ("~$" ?£)
+ ("~u" ?µ)
+ ("^r" ?®)
+ ("^c" ?©)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("~-" ?­)
+ ("~|" ?¦)
+ ("/=" ?¬)
+ ("~=" ?¯)
+)
+
+(quail-define-package
+ "catalan-prefix" "Latin-1" "CA>" t
+ "Catalan and Spanish input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á \\='\\=' -> ´
+ grave | \\=` | \\=`a -> à
+ diaeresis | \" | \"i -> ï \"\" -> ¨
+ tilde | ~ | ~n -> ñ
+ cedilla | ~ | ~c -> ç
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`O" ?Ò)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`o" ?ò)
+ ("` " ?`)
+ ("\"I" ?Ï)
+ ("\"U" ?Ü)
+ ("\"i" ?ï)
+ ("\"u" ?ü)
+ ("\" " ?\")
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
+ ("~ " ?~)
+)
+
+(quail-define-package
+ "esperanto-prefix" "Latin-3" "EO>" t
+ "Esperanto input method with prefix modifiers
+Key translation rules are:
+ ^H -> ?Ĥ ^J -> ?Ĵ ^h -> ?ĥ ^j -> ?ĵ ^C -> ?Ĉ ^G -> ?Ĝ,
+ ^S -> ?Ŝ ^c -> ?ĉ ^g -> ?ĝ ^s -> ?ŝ ~U -> ?Ŭ ~u -> ?ŭ
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("^H" ?Ĥ)
+ ("^J" ?Ĵ)
+ ("^h" ?ĥ)
+ ("^j" ?ĵ)
+ ("^C" ?Ĉ)
+ ("^G" ?Ĝ)
+ ("^S" ?Ŝ)
+ ("^c" ?ĉ)
+ ("^g" ?ĝ)
+ ("^s" ?ŝ)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("~U" ?Ŭ)
+ ("~u" ?ŭ)
+ ("~ " ?~)
+)
+
+(quail-define-package
+ "french-prefix" "French" "FR>" t
+ "French (Français) input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='e -> é
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"i -> ï
+ cedilla | ~ or , | ~c -> ç ,c -> ç
+ symbol | ~ | ~> -> » ~< -> «
+ misc | / | /o -> œ
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'E" ?É)
+ ("'C" ?Ç)
+ ("'e" ?é)
+ ("'c" ?ç)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`U" ?Ù)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`u" ?ù)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?Î)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
+ ("^ " ?^)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\" " ?\")
+ ("/o" ?œ)
+ ("/O" ?Œ)
+ ("/ " ?/)
+ ("~<" ?\«)
+ ("~>" ?\»)
+ ("~C" ?Ç)
+ ("~c" ?ç)
+ ("~ " ?~)
+ (",C" ?Ç)
+ (",c" ?ç)
+ (",," ?,)
+)
+
+(quail-define-package
+ "romanian-prefix" "Romanian" "RO>" t
+ "Romanian (româneşte) input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+------------------
+ tilde | ~ | ~a -> ă
+ circumflex | ^ | ^a -> â, ^i -> î
+ cedilla | , | ,s -> ş, ,t -> ţ
+ ~ | ~ | ~~ -> ~
+ ^ | ^ | ^^ -> ^
+ , | , | ,, -> ,
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("~A" ?Ă) ("~a" ?ă)
+ ("^A" ?Â) ("^a" ?â)
+ ("^I" ?Î) ("^i" ?î)
+ (",S" ?Ş) (",s" ?ş)
+ (",T" ?Ţ) (",t" ?ţ)
+ ("^^" ?^) ("~~" ?~) (",," ?,))
+
+(quail-define-package
+ "romanian-alt-prefix" "Romanian" "RO>" t
+ "Alternative Romanian (româneşte) input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+------------------
+ tilde | \" | \"a -> â
+ circumflex | \\=' | \\='a -> â, \\='i -> î
+ cedilla | \\=' | \\='s -> ş, \\='t -> ţ
+ \\=' | \\=' | \\='\\=' -> \\='
+ \" | \" | \"\" -> \"
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Ă) ("'a" ?ă)
+ ("\"A" ?Â) ("\"a" ?â)
+ ("'I" ?Î) ("'i" ?î)
+ ("'S" ?Ş) ("'s" ?ş)
+ ("'T" ?Ţ) ("'t" ?ţ)
+ ("''" ?') ("\"\"" ?\"))
+
+(quail-define-package
+ "german-prefix" "German" "DE>" t
+ "German (Deutsch) input method with prefix modifiers
+Key translation rules are:
+ \"A -> Ä -> \"O -> Ö \"U -> Ü \"s -> ß
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("\"A" ?Ä)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"o" ?ö)
+ ("\"u" ?ü)
+ ("\"s" ?ß)
+ ("\" " ?\")
+)
+
+(quail-define-package
+ "irish-prefix" "Latin-1" "GA>" t
+ "Irish input method with prefix modifiers
+Key translation rules are:
+ \\='A -> Á \\='E -> É \\='I -> Í \\='O -> Ó \\='U -> Ú
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("' " ?')
+)
+
+(quail-define-package
+ "portuguese-prefix" "Latin-1" "PT>" t
+ "Portuguese input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á \\='\\=' -> ´
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"u -> ü
+ tilde | ~ | ~a -> ã
+ cedilla | \\=' or , | \\='c -> ç ,c -> ç
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'C" ?Ç)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'c" ?ç)
+ ("' " ?')
+ ("`A" ?À)
+ ("`a" ?à)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^O" ?Ô)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^o" ?ô)
+ ("^ " ?^)
+ ("\"U" ?Ü)
+ ("\"u" ?ü)
+ ("\" " ?\")
+ ("~A" ?Ã)
+ ("~O" ?Õ)
+ ("~a" ?ã)
+ ("~o" ?õ)
+ ("~ " ?~)
+ (",c" ?ç)
+ (",C" ?Ç)
+ (",," ?,)
+)
+
+(quail-define-package
+ "spanish-prefix" "Spanish" "ES>" t
+ "Spanish (Español) input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á
+ diaeresis | \" | \"u -> ü
+ tilde | ~ | ~n -> ñ
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("' " ?')
+ ("\"U" ?Ü)
+ ("\"u" ?ü)
+ ("\" " ?\")
+ ("~N" ?Ñ)
+ ("~n" ?ñ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
+ ("~ " ?~)
+)
+
+(quail-define-package
+ "latin-2-prefix" "Latin-2" "2>" t
+ "Latin-2 characters input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á \\='\\=' -> ?´
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ breve | ~ | ~a -> ă
+ caron | ~ | ~c -> č
+ cedilla | \\=` | \\=`c -> ç \\=`e -> ?ę
+ misc | \\=' \\=` ~ | \\='d -> đ \\=`l -> ł \\=`z -> ż ~o -> ő ~u -> ű
+ symbol | ~ | \\=`. -> ˙ ~~ -> ˘ ~. -> ?¸
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'C" ?Ć)
+ ("'D" ?Đ)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'L" ?Ĺ)
+ ("'N" ?Ń)
+ ("'O" ?Ó)
+ ("'R" ?Ŕ)
+ ("'S" ?Ś)
+ ("'U" ?Ú)
+ ("'Y" ?Ý)
+ ("'Z" ?Ź)
+ ("'a" ?á)
+ ("'c" ?ć)
+ ("'d" ?đ)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'l" ?ĺ)
+ ("'n" ?ń)
+ ("'o" ?ó)
+ ("'r" ?ŕ)
+ ("'s" ?ś)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("'z" ?ź)
+ ("''" ?´)
+ ("' " ?')
+ ("`A" ?Ą)
+ ("`C" ?Ç)
+ ("`E" ?Ę)
+ ("`L" ?Ł)
+ ("`S" ?Ş)
+ ("`T" ?Ţ)
+ ("`Z" ?Ż)
+ ("`a" ?ą)
+ ("`l" ?ł)
+ ("`c" ?ç)
+ ("`e" ?ę)
+ ("`s" ?ş)
+ ("`t" ?ţ)
+ ("`z" ?ż)
+ ("``" ?Ş)
+ ("`." ?˙)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^I" ?Î)
+ ("^O" ?Ô)
+ ("^a" ?â)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"\"" ?¨)
+ ("\" " ?\")
+ ("~A" ?Ă)
+ ("~C" ?Č)
+ ("~D" ?Ď)
+ ("~E" ?Ě)
+ ("~L" ?Ľ)
+ ("~N" ?Ň)
+ ("~O" ?Ő)
+ ("~R" ?Ř)
+ ("~S" ?Š)
+ ("~T" ?Ť)
+ ("~U" ?Ű)
+ ("~Z" ?Ž)
+ ("~a" ?ă)
+ ("~c" ?č)
+ ("~d" ?ď)
+ ("~e" ?ě)
+ ("~l" ?ľ)
+ ("~n" ?ň)
+ ("~o" ?ő)
+ ("~r" ?ř)
+ ("~s" ?š)
+ ("~t" ?ť)
+ ("~u" ?ű)
+ ("~z" ?ž)
+ ("~v" ?˘)
+ ("~~" ?˘)
+ ("~." ?¸)
+ ("~ " ?~)
+)
+
+(quail-define-package
+ "latin-3-prefix" "Latin-3" "3>" t
+ "Latin-3 characters input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á \\='\\=' -> ?´
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ cedilla | ~ | ~c -> ç ~s -> ş ~~ -> ¸
+ dot above | / . | /g -> ġ .o -> ġ
+ misc | \" ~ / | \"s -> ß ~g -> ğ ~u -> ŭ /h -> ħ /i -> ı
+ symbol | ~ | ~\\=` -> ˘ /# -> £ /$ -> ¤ // -> °
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("''" ?´)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ò)
+ ("`U" ?Ù)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("``" ?`)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^C" ?Ĉ)
+ ("^E" ?Ê)
+ ("^G" ?Ĝ)
+ ("^H" ?Ĥ)
+ ("^I" ?Î)
+ ("^J" ?Ĵ)
+ ("^O" ?Ô)
+ ("^S" ?Ŝ)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^c" ?ĉ)
+ ("^e" ?ê)
+ ("^g" ?ĝ)
+ ("^h" ?ĥ)
+ ("^i" ?î)
+ ("^j" ?ĵ)
+ ("^o" ?ô)
+ ("^s" ?ŝ)
+ ("^u" ?û)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"u" ?ü)
+ ("\"s" ?ß)
+ ("\"\"" ?¨)
+ ("\" " ?\")
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~S" ?Ş)
+ ("~s" ?ş)
+ ("~G" ?Ğ)
+ ("~g" ?ğ)
+ ("~U" ?Ŭ)
+ ("~u" ?ŭ)
+ ("~`" ?˘)
+ ("~~" ?¸)
+ ("~ " ?~)
+ ("/C" ?Ċ)
+ ("/G" ?Ġ)
+ ("/H" ?Ħ)
+ ("/I" ?İ)
+ ("/Z" ?Ż)
+ ("/c" ?ċ)
+ ("/g" ?ġ)
+ ("/h" ?ħ)
+ ("/i" ?ı)
+ ("/z" ?ż)
+ ("/." ?˙)
+ ("/#" ?£)
+ ("/$" ?¤)
+ ("//" ?°)
+ ("/ " ?/)
+ (".C" ?Ċ)
+ (".G" ?Ġ)
+ (".I" ?İ)
+ (".Z" ?Ż)
+ (".c" ?ċ)
+ (".g" ?ġ)
+ (".z" ?ż)
+)
+
+
+(quail-define-package
+ "polish-slash" "Polish" "PL>" nil
+ "Polish diacritics and slash character are input as `/[acelnosxzACELNOSXZ/]'.
+For example, the character named `aogonek' is obtained by `/a'."
+ nil t t t nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("//" ?/)
+ ("/a" ?ą)
+ ("/c" ?ć)
+ ("/e" ?ę)
+ ("/l" ?ł)
+ ("/n" ?ń)
+ ("/o" ?ó)
+ ("/s" ?ś)
+ ("/x" ?ź)
+ ("/z" ?ż)
+ ("/A" ?Ą)
+ ("/C" ?Ć)
+ ("/E" ?Ę)
+ ("/L" ?Ł)
+ ("/N" ?Ń)
+ ("/O" ?Ó)
+ ("/S" ?Ś)
+ ("/X" ?Ź)
+ ("/Z" ?Ż))
+
+(quail-define-package
+ "latin-9-prefix" "Latin-9" "0>" t
+ "Latin-9 characters input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä, \"Y -> Ÿ
+ tilde | ~ | ~a -> ã
+ caron | ~ | ~z -> ž
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ | \" ~ / | /o -> œ
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ž
+ | ~ | ~s -> § ~e -> € ~. -> · ~$ -> £ ~u -> µ
+ | ~ | ~- -> ­ ~= -> ¯
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ | _ / | _: -> ÷ /c -> ¢ ~p -> ¶
+ | _ / | /= -> ¬
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³ _a -> ª
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ý)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ò)
+ ("`U" ?Ù)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("``" ?`)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?Î)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"y" ?ÿ)
+ ("\" " ?\")
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ð)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~S" ?Š)
+ ("~T" ?Þ)
+ ("~Z" ?Ž)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~s" ?š)
+ ("~t" ?þ)
+ ("~z" ?ž)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
+ ("~ " ?~)
+ ("/A" ?Å)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?å)
+ ("/e" ?æ)
+ ("/o" ?ø)
+ ("//" ?°)
+ ("/ " ?/)
+ ("_o" ?º)
+ ("_a" ?ª)
+ ("_+" ?±)
+ ("_y" ?¥)
+ ("_:" ?÷)
+ ("_ " ? )
+ ("__" ?_)
+ ("/c" ?¢)
+ ("/\\" ?×)
+ ("/o" ?œ) ; clash with ø, but æ uses /
+ ("/O" ?Œ)
+ ("\"Y" ?Ÿ)
+ ("~s" ?§)
+ ("~p" ?¶)
+ ;; Is this the best option for Euro entry?
+ ("~e" ?€)
+ ("~." ?·)
+ ("~$" ?£)
+ ("~u" ?µ)
+ ("^r" ?®)
+ ("^c" ?©)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("~-" ?­)
+ ("~=" ?¯)
+ ("/=" ?¬))
+
+;; Latin-8 was done by an Englishman -- Johnny Celt should take a
+;; squint at it.
+
+(quail-define-package
+ "latin-8-prefix" "Latin-8" "8>" t
+ "Latin-8 characters input method with prefix modifiers
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^w -> ŵ
+ diaeresis | \" | \"a -> ä
+ dot above | . | .b -> ḃ
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß /a -> å /e -> æ /o -> ø
+ | ~ | ~s -> § ~$ -> £ ~p -> ¶
+ symbol | ^ | ^r -> ® ^c -> ©
+" nil t nil nil nil nil nil nil nil nil t)
+
+;; Basically following Latin-1, plus dottiness from Latin-3.
+(quail-define-rules
+ (".B" ?Ḃ)
+ (".b" ?ḃ)
+ (".c" ?ċ)
+ (".C" ?Ċ)
+ (".D" ?Ḋ)
+ (".d" ?ḋ)
+ (".f" ?ḟ)
+ (".F" ?Ḟ)
+ (".g" ?ġ)
+ (".G" ?Ġ)
+ (".m" ?ṁ)
+ (".M" ?Ṁ)
+ (".p" ?ṗ)
+ (".P" ?Ṗ)
+ (".s" ?ṡ)
+ (".S" ?Ṡ)
+ (".t" ?ṫ)
+ (".T" ?Ṫ)
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ý)
+ ("'W" ?Ẃ)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'w" ?ẃ)
+ ("'y" ?ý)
+ ("' " ?')
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ò)
+ ("`U" ?Ù)
+ ("`W" ?Ẁ)
+ ("`Y" ?Ỳ)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("`w" ?ẁ)
+ ("`y" ?ỳ)
+ ("``" ?`)
+ ("` " ?`)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?Î)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
+ ("^w" ?ŵ)
+ ("^W" ?Ŵ)
+ ("^y" ?ŷ)
+ ("^Y" ?Ŷ)
+ ("^^" ?^)
+ ("^ " ?^)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"w" ?ẅ)
+ ("\"W" ?Ẅ)
+ ("\"y" ?ÿ)
+ ("\"Y" ?Ÿ)
+ ("\" " ?\")
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~ " ?~)
+ ("/A" ?Å)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?å)
+ ("/e" ?æ)
+ ("/o" ?ø)
+ ("/ " ?/)
+ ("~p" ?¶)
+ ("~s" ?§)
+ ("~$" ?£)
+ ("^r" ?®)
+ ("^c" ?©))
+
+(quail-define-package
+ "latin-prefix" "Latin" "L>" t
+ "Latin characters input method with prefix modifiers.
+This is the union of various input methods originally made for input
+of characters from a single Latin-N charset.
+
+ effect | prefix | examples
+ ------------+--------+----------
+ acute | \\=' | \\='a -> á, \\='\\=' -> ´
+ grave | \\=` | \\=`a -> à
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ breve | ~ | ~a -> ă
+ caron | ~ | ~c -> č
+ dot above | ~ / . | ~o -> ġ /o -> ġ .o -> ġ
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ¸
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
+" nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("' " ?')
+ ("''" ?´)
+ ("'A" ?Á)
+ ("'E" ?É)
+ ("'I" ?Í)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'W" ?Ẃ)
+ ("'Y" ?Ý)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?í)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'w" ?ẃ)
+ ("'y" ?ý)
+ (".B" ?Ḃ)
+ (".C" ?Ċ)
+ (".D" ?Ḋ)
+ (".F" ?Ḟ)
+ (".G" ?Ġ)
+ (".I" ?İ)
+ (".M" ?Ṁ)
+ (".P" ?Ṗ)
+ (".S" ?Ṡ)
+ (".T" ?Ṫ)
+ (".Z" ?Ż)
+ (".b" ?ḃ)
+ (".c" ?ċ)
+ (".d" ?ḋ)
+ (".f" ?ḟ)
+ (".g" ?ġ)
+ (".m" ?ṁ)
+ (".p" ?ṗ)
+ (".s" ?ṡ)
+ (".t" ?ṫ)
+ (".z" ?ż)
+ ("/ " ?/)
+ ("/#" ?£)
+ ("/$" ?¤)
+ ("/." ?˙)
+ ("//" ?°)
+ ("/2" ?½)
+ ("/3" ?¾)
+ ("/4" ?¼)
+ ("/=" ?¬)
+ ("/A" ?Å)
+ ("/C" ?Ċ)
+ ("/E" ?Æ)
+ ("/G" ?Ġ)
+ ("/H" ?Ħ)
+ ("/I" ?İ)
+ ("/O" ?Ø)
+ ("/O" ?Œ)
+ ("/Z" ?Ż)
+ ("/\\" ?×)
+ ("/a" ?å)
+ ("/c" ?¢)
+ ("/c" ?ċ)
+ ("/e" ?æ)
+ ("/g" ?ġ)
+ ("/h" ?ħ)
+ ("/i" ?ı)
+ ("/o" ?ø)
+ ("/o" ?œ)
+ ("/z" ?ż)
+ ("\" " ?\")
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ï)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"W" ?Ẅ)
+ ("\"Y" ?Ÿ)
+ ("\"\"" ?¨)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"w" ?ẅ)
+ ("\"y" ?ÿ)
+ ("^ " ?^)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("^A" ?Â)
+ ("^C" ?Ĉ)
+ ("^E" ?Ê)
+ ("^G" ?Ĝ)
+ ("^H" ?Ĥ)
+ ("^I" ?Î)
+ ("^J" ?Ĵ)
+ ("^O" ?Ô)
+ ("^S" ?Ŝ)
+ ("^U" ?Û)
+ ("^W" ?Ŵ)
+ ("^Y" ?Ŷ)
+ ("^^" ?^)
+ ("^a" ?â)
+ ("^c" ?©)
+ ("^c" ?ĉ)
+ ("^e" ?ê)
+ ("^g" ?ĝ)
+ ("^h" ?ĥ)
+ ("^i" ?î)
+ ("^j" ?ĵ)
+ ("^o" ?ô)
+ ("^r" ?®)
+ ("^s" ?ŝ)
+ ("^u" ?û)
+ ("^w" ?ŵ)
+ ("^y" ?ŷ)
+ ("_+" ?±)
+ ("_:" ?÷)
+ ("_a" ?ª)
+ ("_o" ?º)
+ ("_y" ?¥)
+ ("_ " ? )
+ ("` " ?`)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ò)
+ ("`U" ?Ù)
+ ("`W" ?Ẁ)
+ ("`Y" ?Ỳ)
+ ("``" ?`)
+ ("`a" ?à)
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("`w" ?ẁ)
+ ("`y" ?ỳ)
+ ("~ " ?~)
+ ("~!" ?¡)
+ ("~$" ?£)
+ ("~-" ?­)
+ ("~." ?·)
+ ("~<" ?\«)
+ ("~=" ?¯)
+ ("~>" ?\»)
+ ("~?" ?¿)
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ð)
+ ("~G" ?Ğ)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~O" ?Ġ)
+ ("~S" ?Ş)
+ ("~S" ?Š)
+ ("~T" ?Þ)
+ ("~U" ?Ŭ)
+ ("~Z" ?Ž)
+ ("~`" ?˘)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~e" ?€)
+ ("~g" ?ğ)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~o" ?ġ)
+ ("~p" ?¶)
+ ("~s" ?§)
+ ("~s" ?ş)
+ ("~s" ?š)
+ ("~t" ?þ)
+ ("~u" ?µ)
+ ("~u" ?ŭ)
+ ("~x" ?¤)
+ ("~z" ?ž)
+ ("~|" ?¦)
+ ("~~" ?¸)
+)
+
+;;; latin-pre.el ends here
diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el
new file mode 100644
index 00000000000..ed9138d2134
--- /dev/null
+++ b/lisp/leim/quail/lrt.el
@@ -0,0 +1,81 @@
+;;; lrt.el --- Quail package for inputting Lao characters by LRT method -*-coding: utf-8;-*-
+
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Lao, LRT.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'lao-util)
+
+;; LRT (Lao Roman Transcription) input method accepts the following
+;; key sequence:
+;; consonant [+ semi-vowel-sign-lo ] + vowel [+ maa-sakod ] [+ tone-mark ]
+
+(defun quail-lrt-update-translation (control-flag)
+ (if (integerp control-flag)
+ ;; Non-composable character typed.
+ (setq quail-current-str
+ (buffer-substring (overlay-start quail-overlay)
+ (overlay-end quail-overlay))
+ unread-command-events
+ (append
+ (substring quail-current-key control-flag)
+ unread-command-events))
+ (let ((lao-str (lao-transcribe-roman-to-lao-string quail-current-key)))
+ (if (> (aref lao-str 0) 255)
+ (setq quail-current-str lao-str)
+ (or quail-current-str
+ (setq quail-current-str quail-current-key)))))
+ control-flag)
+
+
+(quail-define-package
+ "lao-lrt" "Lao" "ລR" t
+ "Lao input method using LRT (Lao Roman Transcription).
+`\\' (backslash) + number-key => ໐,໑,໒,... LAO DIGIT ZERO, ONE, TWO, ...
+`\\' (backslash) + `\\' => ໆ LAO KO LA (REPETITION)
+`\\' (backslash) + `$' => ຯ LAO ELLIPSIS
+"
+ nil 'forget-last-selection 'deterministic 'kbd-translate 'show-layout
+ nil nil nil 'quail-lrt-update-translation nil t)
+
+;; LRT (Lao Roman Transcription) input method accepts the following
+;; key sequence:
+;; consonant [ semi-vowel-sign-lo ] vowel [ maa-sakod ] [ tone-mark ]
+
+(quail-install-map
+ (quail-map-from-table
+ '((base-state (lao-transcription-consonant-alist . sv-state)
+ lao-transcription-vowel-alist
+ lao-transcription-tone-alist)
+ (sv-state (lao-transcription-semi-vowel-alist . v-state)
+ (lao-transcription-vowel-alist . mt-state))
+ (v-state (lao-transcription-vowel-alist . mt-state))
+ (mt-state (lao-transcription-maa-sakod-alist . t-state)
+ lao-transcription-tone-alist)
+ (t-state lao-transcription-tone-alist))))
+
+;;; lrt.el ends here
diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el
new file mode 100644
index 00000000000..7739c225869
--- /dev/null
+++ b/lisp/leim/quail/persian.el
@@ -0,0 +1,526 @@
+;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*-
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Mohsen BANAN <libre@mohsen.1.banan.byname.net>
+;; X-URL: http://mohsen.1.banan.byname.net/contact
+
+;; Keywords: multilingual, input method, Farsi, Persian, keyboard
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This file contains a collection of input methods for
+;; Persian languages (Farsi, Urdu, Pashto/Afghanic, ...)
+;;
+;; At this time, the following input methods are specified:
+;;
+;; - (farsi-isiri-9149) Persian Keyboard based on Islamic Republic of Iran's ISIRI-9147
+;; - (farsi-transliterate-banan) An intuitive transliteration keyboard for Farsi
+;;
+;; Additional documentation for these input methods can be found at:
+;; http://www.persoarabic.org/PLPC/120036
+;;
+
+;;; Code:
+
+(require 'quail)
+
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; farsi-isiri-9147
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; The keyboard mapping defined here is based on:
+;; فنّاوریِ اطلاعات - چیدمان حروف و علائم فارسی بر صفحه کلید رایانه
+;; استاندارد ملی ایران ۹۱۴۷ − چاپ اول
+;;
+;; Institute of Standards and Industrial Research of Iran
+;; Information Technology – Layout of Persian Letters and Symbols
+;; on Computer Keyboards
+;; ISIRI 9147 -- 1st edition
+;; Published at: http://www.isiri.org/portal/files/std/9147.pdf
+;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-9147
+;;
+;;
+;; Specification of Iran's Persian Character Set is also relevant:
+;; فنّاوریِ اطلاعات -- تبادل و شیوه‌ی نمایش اطلاعاتِ فارسی بر اساس یونی کُد
+;; استاندارد ملی ایران ۶۲۱۹ −− نسخهی نهایی
+;;
+;; Institute of Standards and Industrial Research of Iran
+;; Information Technology – Persian Information Interchange and Display Mechanism, using Unicode
+;; ISIRI-6219 Final Version
+;; Published at: http://www.isiri.org/portal/files/std/6219.htm
+;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-6219
+;;
+;; Layers 1, 2 and 3 of ISIRI-9147 are fully implemented with the
+;; exception of the Backslash, Alt-Backslash, Shift-Space and
+;; Alt-Space keys.
+;;
+;; The Backslash key is used to replace کلید با دگر ساز راست‌ -- the Alt or
+;; Meta key.
+;;
+;; Layer 3 is then entered with the Backslash key and Layer 3 is
+;; implemented as two letter keys as specified in ISIRI-9147.
+;;
+;; The character corresponding to Backslash is entered with Backslash-Backslash.
+;; Alt-Backslash has been moved to Backslash-r.
+;; Alt-Space has been moved to Backslash-t.
+;; Shift-Space has been moved to Backslash-y.
+;;
+;; With these modifications, farsi-isiri-9147 is a full implementation
+;; of ISIRI-9147. Additionally, these modifications allow for this
+;; implementation to be ascii input stream based -- in addition to
+;; being a keyboard layout.
+;;
+;; If a key on Layer 1 was reserved to replace دگر ساز راست‌ (the Alt
+;; or Meta key), then farsi-isiri-9147 could have claimed full
+;; compliance -- without the need for the above description. Perhaps
+;; this can be considered a flaw in the base ISIRI-9147 specification
+;; to be addressed in the next revision.
+;;
+
+
+(quail-define-package
+ "farsi-isiri-9147" "Persian" " ف" nil
+ "Farsi keyboard based on ISIRI-9147.
+ See http://www.persoarabic.org/PLPC/120036 for additional documentation."
+ nil t t t t nil nil nil nil nil t)
+
+;; Note: the rows of keys below are enclosed in Left-To-Right Override
+;; embedding, to prevent them from being reordered by the Emacs
+;; display engine.
+
+
+;; +----------------------------------------------------------------+
+;; ‭| ۱! | ۲٬ | ۳٫ | ۴﷼ | ۵٪ | ۶× | ۷، | ۸* | ۹( | ۰) | -ـ | =+ | `÷ |‬
+;; +----------------------------------------------------------------+
+;; ‭| ضْ| صٌ| ثٍ| قً| فُ| غِ| عَ| هّ| خ] | ح[ | ج{ | چ} |‬
+;; +------------------------------------------------------------+
+;; ‭| ش‌ؤ | س‌ئ | ی‌ي | ب‌إ | لأ | اآ | ت‌ة | ن« | م» | ک: | گ؛ | \| |‬
+;; +-----------------------------------------------------------+
+;; ‭| ظ‌ك | طٓ| زژ | رٰ| ذB | دٔ| پء | و< | .> | /؟ |‬
+;; +-------------------------------------------+
+
+(quail-define-rules
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?۶)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+ ("0" ?۰)
+ ("-" ?-)
+ ("=" ?=)
+ ("`" ?\u200D) ;; ZWJ -- ZERO WIDTH JOINER اتصال مجازى
+ ("q" ?ض)
+ ("w" ?ص)
+ ("e" ?ث)
+ ("r" ?ق)
+ ("t" ?ف)
+ ("y" ?غ)
+ ("u" ?ع)
+ ("i" ?ه)
+ ("o" ?خ)
+ ("p" ?ح)
+ ("[" ?ج)
+ ("]" ?چ)
+ ("a" ?ش)
+ ("s" ?س)
+ ("d" ?ی)
+ ("f" ?ب)
+ ("g" ?ل)
+ ("h" ?ا)
+ ("j" ?ت)
+ ("k" ?ن)
+ ("l" ?م)
+ (";" ?ک)
+ ("'" ?گ)
+
+ ("z" ?ظ)
+ ("x" ?ط)
+ ("c" ?ز)
+ ("v" ?ر)
+ ("b" ?ذ)
+ ("n" ?د)
+ ("m" ?پ)
+ ("," ?و)
+ ("." ?.)
+ ("/" ?/)
+
+ ("!" ?!)
+ ("@" ?٬)
+ ("#" ?٫)
+ ("$" ?﷼)
+ ("%" ?٪)
+ ("^" ?×)
+ ("&" ?،)
+ ("*" ?*)
+ ("(" ?\))
+ (")" ?\()
+ ("_" ?ـ)
+ ("+" ?+)
+ ("~" ?÷)
+ ("Q" ?ْ) ;; ساکن فارسى
+ ("W" ?ٌ) ;; دو پيش فارسى -- تنوين رفع
+ ("E" ?ٍ) ;; دو زير فارسى -- تنوين جر
+ ("R" ?ً) ;; دو زبر فارسى -- تنوين نصب
+ ("T" ?ُ) ;; پيش فارسى -- ضمه
+ ("Y" ?ِ) ;; زير فارسى -- کسره
+ ("U" ?َ) ;; زبر فارسى -- فتحه
+ ("I" ?ّ) ;; تشديد فارسى
+ ("O" ?\])
+ ("P" ?\[)
+ ("{" ?})
+ ("}" ?{)
+ ("A" ?ؤ)
+ ("S" ?ئ)
+ ("D" ?ي)
+ ("F" ?إ)
+ ("G" ?أ)
+ ("H" ?آ)
+ ("J" ?ة)
+ ("K" ?»)
+ ("L" ?«)
+ (":" ?:)
+ ("\"" ?؛)
+ ("|" ?|)
+ ("Z" ?ك)
+ ("X" ?ٓ)
+ ("C" ?ژ)
+ ("V" ?ٰ)
+ ("B" ?\u200C) ;; ZWNJ -- ZERO WIDTH NON-JOINER فاصلهٔ مجازى
+ ("N" ?ٔ) ;; همزه فارسى بالا
+ ("M" ?ء) ;; harf farsi hamzeh
+ ("<" ?>)
+ (">" ?<)
+ ("?" ?؟)
+
+ ;; Level 3 Entered with \
+ ;;
+ ("\\" ?\\) ;; خط اريب وارو
+ ("\\\\" ?\\)
+ ("\\~" ?\u007E)
+ ("\\1" ?\u0060)
+ ("\\2" ?\u0040)
+ ("\\3" ?\u0023)
+ ("\\4" ?\u0024)
+ ("\\5" ?\u0025)
+ ("\\6" ?\u005E)
+ ("\\7" ?\u0026)
+ ("\\8" ?\u2022)
+ ("\\9" ?\u200E)
+ ("\\0" ?\u200F)
+ ("\\-" ?\u005F)
+ ("\\+" ?\u2212)
+ ("\\q" ?\u00B0)
+ ;;\\w" ?\u0000)
+ ("\\e" ?\u20AC)
+ ("\\r" ?\u2010) ;; replacement for Alt-BSL
+ ("\\t" ?\u00A0) ;; replacement for ALT-SPC
+ ("\\y" ?\u200C) ;; replacement for SHIFT-SPC
+ ;;("\\u" ?\u0000)
+ ("\\i" ?\u202D)
+ ("\\o" ?\u202E)
+ ("\\p" ?\u202C)
+ ("\\[" ?\u202A)
+ ("\\]" ?\u202B)
+ ;;("\\a" ?\u0000)
+ ;;("\\s" ?\u0000)
+ ("\\d" ?\u0649)
+ ;;("\\f" ?\u0000)
+ ;;("\\g" ?\u0000)
+ ("\\h" ?\u0671)
+ ;;("\\j" ?\u0000)
+ ("\\k" ?\uFD3E)
+ ("\\l" ?\uFD3F)
+ ("\\;" ?\u003B)
+ ("\\'" ?\u0022)
+ ;;("\\z" ?\u0000)
+ ;;("\\x" ?\u0000)
+ ;;("\\c" ?\u0000)
+ ("\\v" ?\u0656)
+ ("\\b" ?\u200D)
+ ("\\n" ?\u0655)
+ ("\\m" ?\u2026)
+ ("\\," ?\u002C)
+ ("\\." ?\u0027)
+ ("\\?" ?\u003F)
+ ;;("\\\\" ?\u2010) ;; Moved to backslash r to leave room for BSL-BSL
+ )
+
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; farsi-transliterate-banan
+;;
+;; Given a Qwerty keyboard, use Persian-to-Latin transliteration knowledge
+;; to reverse transliterate in persian
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; See http://www.persoarabic.org/PLPC/120036 document for more complete
+;;; documentation of keyboard bindings and usage instructions.
+;;;
+;;
+;; ISIRI-9147 Persian keyboard is generally not well suited for Iranian-Expatriates
+;; working/living in the West.
+;;
+;; The qwerty keyboard is usually second nature to Persian speaking expatriates and they
+;; don't want to learn/adapt to ISIRI-9147. They expect software to adapt to them.
+;;
+;; That is what the ``Banan Multi-Character (Reverse) Transliteration Persian Input Method'' does.
+;;
+;; The typical profile of the user is assumed to be one who:
+;;
+;; - can write in farsi (not just speak it).
+;; - is fully comfortable with a qwerty latin keyboard.
+;; - is not familiar with isir-9147 and does not wish to be trained.
+;; - communicates and writes in a mixed globish/persian -- not pure persian.
+;; - is intuitively familiar with transliteration of farsi/persian into latin based on two letter
+;; phonetic mapping to persian characters (e.g., gh ق -- kh خ -- sh ش -- ch چ -- zh ژ.
+;;
+;; This transliteration keyboard is designed to be intuitive such that
+;; mapping are easy and natural to remember for a persian writer.
+;; It is designed to be equivalent in capability to farsi-isiri-9147
+;; and provide for inputting all characters enumerated in ISIRI-6219.
+;;
+;; farsi-transliterate-banan is of course phonetic oriented. But it is very different from
+;; pinglish. Pinglish is word oriented where you sound out the word with latin letters --
+;; including the vowels. farsi-transliterate-banan is letter oriented where you enter the
+;; latin letter/letters closest to the persian letter. And usually omit vowels.
+;;
+;; For some persian characters there are multiple ways of inputting
+;; the same character. For example both ``i'' and ``y'' produce ی.
+;; For یک ``yk'', ``y'' is more natural and for این ``ain'', ``i'' is more natural.
+;;
+;; The more frequently used keys are mapped to lower case. The less frequently used letter moves to
+;; upper case. For example: ``s'' is س and ``S'' is ص. ``h'' is ه and ``H''
+;; is ح.
+;;
+;; Multi-character input is based on \, &, and / prefix
+;; characters. The letter 'h' is used as a postfix for the following two character mappings:
+;; gh ق -- kh خ -- sh ش -- ch چ -- zh ژ -- Th ة -- Yh ى.
+;;
+;;
+;; Prefix letter \ is used for two character inputs when an alternate form of a letter
+;; is desired for example '\-' is: '÷' when '-' is: '-'.
+;;
+;; Prefix letter & is used for multi-character inputs when special characters are
+;; desired based on their abbreviate name. For example you can enter &lrm; to enter the
+;; ``LEFT-TO-RIGHT MARK'' character.
+;;
+;; Prefix letter / is used to provide two characters. / is: ``ZERO WIDTH NON-JOINER''
+;; and // is /.
+;;
+;; The letter 'h' is used in a number of two character postfix mappings,
+;; for example ``sh'' ش. So if you need the sequence of ``s'' and ``h'' you
+;; need to repeat the ``s''. For example: سهم = 's' 's' 'h' 'm'.
+;;
+
+
+(quail-define-package
+ "farsi-transliterate-banan" "Persian" "ب" t
+ "Intuitive transliteration keyboard layout for persian/farsi.
+ See http://www.persoarabic.org/PLPC/120036 for additional documentation."
+ nil t t t t nil nil nil nil nil t)
+
+
+(quail-define-rules
+;;;;;;;;;;; isiri-6219 Table 5 -- جدول ۵ - حروِفِ اصلیِ فارسی
+ ("W" ?ء) ;; hamzeh
+ ("A" ?آ) ;; U+0622 & ARABIC LETTER ALEF WITH MADDA ABOVE & الف با کلاه
+ ("a" ?ا) ;; U+0627 & ARABIC LETTER ALEF & الف
+ ("\\a" ?أ)
+ ("b" ?ب) ;; U+0628 & ARABIC LETTER BEH &
+ ("p" ?پ) ;; U+067e & ARABIC LETTER PEH &
+ ("t" ?ت)
+ ("tt" ?ت)
+ ("c" ?ث)
+ ("cc" ?ث)
+ ("j" ?ج)
+ ("ch" ?چ)
+ ("H" ?ح)
+ ("hh" ?ح)
+ ("kh" ?خ)
+ ("d" ?د)
+ ("Z" ?ذ)
+ ("r" ?ر)
+ ("z" ?ز)
+ ("zz" ?ز)
+ ("zh" ?ژ)
+ ("s" ?س)
+ ("ss" ?س)
+ ("sh" ?ش)
+ ("S" ?ص)
+ ("x" ?ض)
+ ("T" ?ط)
+ ("TT" ?ط)
+ ("X" ?ظ)
+ ("w" ?ع)
+ ("q" ?غ)
+ ("G" ?غ)
+ ("Gh" ?غ)
+ ("GG" ?غ)
+ ("f" ?ف)
+ ("Q" ?ق)
+ ("gh" ?ق)
+ ("k" ?ک)
+ ("kk" ?ک)
+ ("g" ?گ)
+ ("gg" ?گ)
+ ("l" ?ل)
+ ("m" ?م)
+ ("n" ?ن)
+ ("v" ?و)
+ ("u" ?و)
+ ("V" ?ؤ)
+ ("h" ?ه)
+ ("y" ?ی)
+ ("i" ?ی)
+ ("I" ?ئ)
+
+
+;;;;;;;;;;; isiri-6219 Table 6 -- جدول ۶ - حروِفِ عربی
+ ("F" ?إ)
+ ("D" ?\u0671) ;; (ucs-insert #x0671)ٱ named: حرفِ الفِ وصل
+ ("K" ?ك) ;; Arabic kaf
+ ("Th" ?ة) ;; ta marbuteh
+ ("Y" ?ي)
+ ("YY" ?ي)
+ ("Yh" ?ى)
+
+;;;;;;;;;;; isiri-6219 Table 4 -- جدول ۴ - ارقام و علائم ریاضی
+ ("0" ?۰)
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?۶)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+
+ ("\\/" ?\u066B) ;; (ucs-insert #x066B)٫ named: ممیزِ فارسی
+ ("\\," ?\u066C) ;; (ucs-insert #x066C)٬ named: جداکننده‌ی هزارهای فارسی
+ ("%" ?\u066A) ;; (ucs-insert #x066A)٪ named: درصدِ فارسی
+ ("+" ?\u002B) ;; (ucs-insert #x002B)+ named: علامتِ به‌اضافه
+ ("-" ?\u2212) ;; (ucs-insert #x2212)− named: علامتِ منها
+ ("\\*" ?\u00D7) ;; (ucs-insert #x00D7)× named: علامتِ ضرب
+ ("\\-" ?\u00F7) ;; (ucs-insert #x00F7)÷ named: علامتِ تقسیم
+ ("<" ?\u003C) ;; (ucs-insert #x003C)< named: علامتِ کوچکتر
+ ("=" ?\u003D) ;; (ucs-insert #x003D)= named: علامتِ مساوی
+ (">" ?\u003E) ;; (ucs-insert #x003E)> named: علامتِ بزرگتر
+
+
+;;;;;;;;;;; isiri-6219 Table 2 -- جدول ۲ - علائم نقطه گذاریِ مشترک
+ ;;; Space
+ ("." ?.) ;;
+ (":" ?\u003A) ;; (ucs-insert #x003A): named:
+ ("!" ?\u0021) ;; (ucs-insert #x0021)! named:
+ ("\\." ?\u2026) ;; (ucs-insert #x2026)… named:
+ ("\\-" ?\u2010) ;; (ucs-insert #x2010)‐ named:
+ ("-" ?\u002D) ;; (ucs-insert #x002D)- named:
+ ("|" ?|)
+ ;;("\\\\" ?\)
+ ("//" ?/)
+ ("*" ?\u002A) ;; (ucs-insert #x002A)* named:
+ ("(" ?\u0028) ;; (ucs-insert #x0028)( named:
+ (")" ?\u0029) ;; (ucs-insert #x0029)) named:
+ ("[" ?\u005B) ;; (ucs-insert #x005B)[ named:
+ ("[" ?\u005D) ;; (ucs-insert #x005D)] named:
+ ("{" ?\u007B) ;; (ucs-insert #x007B){ named:
+ ("}" ?\u007D) ;; (ucs-insert #x007D)} named:
+ ("\\<" ?\u00AB) ;; (ucs-insert #x00AB)« named:
+ ("\\>" ?\u00BB) ;; (ucs-insert #x00BB)» named:
+ ("N" ?\u00AB) ;; (ucs-insert #x00AB)« named:
+ ("M" ?\u00BB) ;; (ucs-insert #x00BB)» named:
+
+;;;;;;;;;;; isiri-6219 Table 3 -- جدول ۳ - علائم نقطه گذاریِ فارسی
+ ("," ?،) ;; farsi
+ (";" ?؛) ;;
+ ("?" ?؟) ;; alamat soal
+ ("_" ?ـ) ;;
+
+
+;;;;;;;;;;; isiri-6219 Table 1 -- جدول ۱ - نویسه‌های کنترلی
+ ;; LF
+ ;; CR
+ ("&zwnj;" ?\u200C) ;; (ucs-insert #x200C)‌ named: فاصله‌ی مجازی
+ ("/" ?\u200C) ;;
+ ("&zwj;" ?\u200D) ;; (ucs-insert #x200D)‍ named: اتصالِ مجازی
+ ("J" ?\u200D) ;;
+ ("&lrm;" ?\u200E) ;; (ucs-insert #x200E)‎ named: نشانه‌ی چپ‌به‌راست
+ ("&rlm;" ?\u200F) ;; (ucs-insert #x200F)‏ named: نشانه‌ی راست‌به‌چپ
+ ("&ls;" ?\u2028) ;; (ucs-insert #x2028)
 named: جداکننده‌ی سطرها
+ ("&ps;" ?\u2028) ;; (ucs-insert #x2029)
 named: جداکننده‌ی بندها
+ ("&lre;" ?\u202A) ;; (ucs-insert #x202A)‪ named: زیرمتنِ چپ‌به‌راست
+ ("&rle;" ?\u202B) ;; (ucs-insert #x202B) named: زیرمتنِ راست‌به‌چپ
+ ("&pdf;" ?\u202C) ;; (ucs-insert #x202C) named: پایانِ زیرمتن
+ ("&lro;" ?\u202D) ;; (ucs-insert #x202D) named: زیرمتنِ اکیداً چپ‌به‌راست
+ ("&rlo;" ?\u202D) ;; (ucs-insert #x202E) named: زیرمتنِ اکیداً راست‌به‌چپ
+ ("&bom;" ?\uFEFF) ;; (ucs-insert #xFEFF) named: نشانه‌ی ترتیبِ بایت‌ها
+
+
+;;;;;;;;;;; isiri-6219 Table 7 -- جدول ۷ - نشانه‌هایِ فارسی
+ ("^" ?َ) ;; zbar ;; زبر فارسى
+ ("e" ?ِ) ;; zir زير فارسى
+ ("o" ?ُ) ;; peesh ;; پيش فارسى -- ضمه
+ ("E" ?ٍ) ;; eizan ;; دو زير فارسى -- تنوين جر
+ ("#" ?ً) ;; دو زبر
+ ("O" ?ٌ) ;; دو پيش فارسى -- تنوين رفع
+ ("~" ?ّ) ;; tashdid ;; تشديد فارسى
+ ("@" ?ْ) ;; ساکن فارسى
+ ("U" ?\u0653) ;; (ucs-insert #x0653)ٓ named: مدِ فارسی
+ ("`" ?ٔ) ;; همزه فارسى بالا
+ ("C" ?\u0655) ;; (ucs-insert #x0655)ٕ named: همزه فارسى پایین
+ ("$" ?\u0670) ;; (ucs-insert #x0670)ٰ named: الفِ مقصوره‌ی فارسی
+
+
+;;;;;;;;;;; isiri-6219 Table 8 - Forbidden Characters -- جدول ۸ - نویسه‌هایِ ممنوع
+;; ;; he ye (ucs-insert 1728) (ucs-insert #x06c0) kills emacs-24.0.90
+;; arabic digits 0-9
+
+
+;;;;;;; Latin Extensions
+ ("\\" ?\\) ;; خط اريب وارو
+ ("\\\\" ?\\)
+ ("\\~" ?~)
+ ("\\@" ?@)
+ ("\\#" ?#)
+ ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named:
+ ("\\^" ?^)
+ ("\\1" ?1)
+ ("\\2" ?2)
+ ("\\3" ?3)
+ ("\\4" ?4)
+ ("\\5" ?5)
+ ("\\6" ?6)
+ ("\\7" ?7)
+ ("\\8" ?8)
+ ("\\9" ?9)
+ ("\\0" ?0)
+
+)
+
+;;; persian.el ends here
diff --git a/lisp/leim/quail/py-punct.el b/lisp/leim/quail/py-punct.el
new file mode 100644
index 00000000000..fddabc6574f
--- /dev/null
+++ b/lisp/leim/quail/py-punct.el
@@ -0,0 +1,77 @@
+;;; py-punct.el --- Quail packages for Chinese (pinyin + extra symbols) -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Author: Ken'ichi HANDA <handa@etl.go.jp>
+
+;; Keywords: multilingual, input method, Chinese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(load "quail/PY")
+(load "quail/Punct")
+
+(quail-define-package
+ "chinese-py-punct" "Chinese-GB" "$AF47{(B"
+ t
+ "$A::WVJdHk(B $AF4Rt7=08(B and `v' for $A1j5c7{:EJdHk(B
+
+This is the combination of the input methods `chinese-py' and `chinese-punct'.
+You can enter normal Chinese characters by the same way as `chinese-py'.
+And, you can enter symbols by typing `v' followed by any key sequences
+defined in `chinese-punct'.
+
+For instance, typing `v' and `%' insert `$A#%(B'.
+")
+
+(setcar (nthcdr 2 quail-current-package)
+ (copy-sequence (nth 2 (assoc "chinese-py" quail-package-alist))))
+
+(quail-defrule "v" (nth 2 (assoc "chinese-punct" quail-package-alist)))
+
+(load "quail/TONEPY")
+
+(quail-define-package
+ "chinese-tonepy-punct" "Chinese-GB" "$AF47{(B"
+ t
+ "$A::WVJdHk(B $A4x5wF4Rt7=08(B and `v' for $A1j5c7{:EJdHk(B
+
+This is the combination of the input methods `chinese-tonepy' and
+`chinese-punct'.
+
+You can enter normal Chinese characters by the same way as
+`chinese-tonepy'. And, you can enter symbols by typing `v' followed
+by any key sequences defined in `chinese-punct'.
+
+For instance, typing `v' and `%' insert `$A#%(B'.
+")
+
+(setcar (nthcdr 2 quail-current-package)
+ (copy-sequence (nth 2 (assoc "chinese-tonepy" quail-package-alist))))
+
+(quail-defrule "v" (nth 2 (assoc "chinese-punct" quail-package-alist)))
+
+;;; py-punct.el ends here
diff --git a/lisp/leim/quail/pypunct-b5.el b/lisp/leim/quail/pypunct-b5.el
new file mode 100644
index 00000000000..37c12659cc3
--- /dev/null
+++ b/lisp/leim/quail/pypunct-b5.el
@@ -0,0 +1,56 @@
+;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols) -*-coding: iso-2022-7bit;-*-
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Author: Ken'ichi HANDA <handa@etl.go.jp>
+
+;; Keywords: multilingual, input method, Chinese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(load "quail/PY-b5")
+(load "quail/Punct-b5")
+
+(quail-define-package
+ "chinese-py-punct-b5" "Chinese-BIG5" "$(03<>K(B"
+ t
+ "$(0&d'GTT&,!J3<5x!K(B and `v' for $(0O:X5>KHATT&,(B
+
+This is the combination of the input method `chinese-py-b5' and
+`chinese-punct-b5'.
+
+You can enter normal Chinese characters by the same way as `chinese-py-b5'.
+And, you can enter symbols by typing `v' followed by any key sequences
+defined in `chinese-punct-b5'.
+
+For instance, typing `v' and `%' insert `$(0"h(B'.
+")
+
+(setcar (nthcdr 2 quail-current-package)
+ (nth 2 (assoc "chinese-py-b5" quail-package-alist)))
+
+(quail-defrule "v" (nth 2 (assoc "chinese-punct-b5" quail-package-alist)))
+
+;;; pypunct-b5.el ends here
diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el
new file mode 100644
index 00000000000..a21ba7ab918
--- /dev/null
+++ b/lisp/leim/quail/rfc1345.el
@@ -0,0 +1,2064 @@
+;;; rfc1345.el --- Quail method for RFC 1345 mnemonics -*- coding: utf-8 -*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The table below was derived from GNU Recode 3.6.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "rfc1345" "UTF-8" "m" t
+ "Unicode characters input method using RFC1345 mnemonics (non-ASCII only).
+E.g. &a' -> á"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+;; There doesn't seem to be any point in including ASCII.
+;; ("&NU" ?\^@)
+;; ("&SH" ?\^A)
+;; ("&SX" ?\^B)
+;; ("&EX" ?\^C)
+;; ("&ET" ?\^D)
+;; ("&EQ" ?\^E)
+;; ("&AK" ?\^F)
+;; ("&BL" ?\^G)
+;; ("&BS" ?\^H)
+;; ("&HT" 9)
+;; ("&LF" 10)
+;; ("&VT" ?\^K)
+;; ("&FF" ?\^L)
+;; ("&CR" 13)
+;; ("&SO" ?\^N)
+;; ("&SI" ?\^O)
+;; ("&DL" ?\^P)
+;; ("&D1" ?\^Q)
+;; ("&D2" ?\^R)
+;; ("&D3" ?\^S)
+;; ("&D4" ?\^T)
+;; ("&NK" ?\^U)
+;; ("&SY" ?\^V)
+;; ("&EB" ?\^W)
+;; ("&CN" ?\^X)
+;; ("&EM" ?\^Y)
+;; ("&SB" ?\032) ; ^Z in a file causes trouble on MS systems.
+;; ("&EC" ?\033)
+;; ("&FS" ?\034)
+;; ("&GS" ?\035)
+;; ("&RS" ?\036)
+;; ("&US" ?\037)
+;; ("&SP" ?\ )
+;; ("&!" ?\!)
+;; ("&\"" ?\")
+;; ("&Nb" ?\#)
+;; ("&DO" ?\$)
+;; ("&%" ?\%)
+;; ("&&" ?\&)
+;; ("&'" ?\')
+;; ("&(" ?\()
+;; ("&)" ?\))
+;; ("&*" ?\*)
+;; ("&+" ?\+)
+;; ("&," ?\,)
+;; ("&-" ?\-)
+;; ("&." ?\.)
+;; ("&/" ?\/)
+;; ("&0" ?\0)
+;; ("&1" ?\1)
+;; ("&2" ?\2)
+;; ("&3" ?\3)
+;; ("&4" ?\4)
+;; ("&5" ?\5)
+;; ("&6" ?\6)
+;; ("&7" ?\7)
+;; ("&8" ?\8)
+;; ("&9" ?\9)
+;; ("&:" ?\:)
+;; ("&;" ?\;)
+;; ("&<" ?\<)
+;; ("&=" ?\=)
+;; ("&>" ?\>)
+;; ("&?" ?\?)
+;; ("&At" ?\@)
+;; ("&A" ?\A)
+;; ("&B" ?\B)
+;; ("&C" ?\C)
+;; ("&D" ?\D)
+;; ("&E" ?\E)
+;; ("&F" ?\F)
+;; ("&G" ?\G)
+;; ("&H" ?\H)
+;; ("&I" ?\I)
+;; ("&J" ?\J)
+;; ("&K" ?\K)
+;; ("&L" ?\L)
+;; ("&M" ?\M)
+;; ("&N" ?\N)
+;; ("&O" ?\O)
+;; ("&P" ?\P)
+;; ("&Q" ?\Q)
+;; ("&R" ?\R)
+;; ("&S" ?\S)
+;; ("&T" ?\T)
+;; ("&U" ?\U)
+;; ("&V" ?\V)
+;; ("&W" ?\W)
+;; ("&X" ?\X)
+;; ("&Y" ?\Y)
+;; ("&Z" ?\Z)
+;; ("&<(" ?\[)
+;; ("&//" ?\\)
+;; ("&)>" ?\])
+;; ("&'>" ?\^)
+;; ("&_" ?\_)
+;; ("&'!" ?\`)
+;; ("&a" ?\a)
+;; ("&b" ?\b)
+;; ("&c" ?\c)
+;; ("&d" ?\d)
+;; ("&e" ?\e)
+;; ("&f" ?\f)
+;; ("&g" ?\g)
+;; ("&h" ?\h)
+;; ("&i" ?\i)
+;; ("&j" ?\j)
+;; ("&k" ?\k)
+;; ("&l" ?\l)
+;; ("&m" ?\m)
+;; ("&n" ?\n)
+;; ("&o" ?\o)
+;; ("&p" ?\p)
+;; ("&q" ?\q)
+;; ("&r" ?\r)
+;; ("&s" ?\s)
+;; ("&t" ?\t)
+;; ("&u" ?\u)
+;; ("&v" ?\v)
+;; ("&w" ?\w)
+;; ("&x" ?\x)
+;; ("&y" ?\y)
+;; ("&z" ?\z)
+;; ("&(!" ?\{)
+;; ("&!!" ?\|)
+;; ("&!)" ?\})
+;; ("&'?" ?\~)
+;; ("&DT" ?\)
+ ("&PA" ?\€)
+ ("&HO" ?\)
+ ("&BH" ?\‚)
+ ("&NH" ?\ƒ)
+ ("&IN" ?\„)
+ ("&NL" ?\…)
+ ("&SA" ?\†)
+ ("&ES" ?\‡)
+ ("&HS" ?\ˆ)
+ ("&HJ" ?\‰)
+ ("&VS" ?\Š)
+ ("&PD" ?\‹)
+ ("&PU" ?\Œ)
+ ("&RI" ?\)
+ ("&S2" ?\Ž)
+ ("&S3" ?\)
+ ("&DC" ?\)
+ ("&P1" ?\‘)
+ ("&P2" ?\’)
+ ("&TS" ?\“)
+ ("&CC" ?\”)
+ ("&MW" ?\•)
+ ("&SG" ?\–)
+ ("&EG" ?\—)
+ ("&SS" ?\˜)
+ ("&GC" ?\™)
+ ("&SC" ?\š)
+ ("&CI" ?\›)
+ ("&ST" ?\œ)
+ ("&OC" ?\)
+ ("&PM" ?\ž)
+ ("&AC" ?\Ÿ)
+ ("&NS" ?\ )
+ ("&!I" ?\¡)
+ ("&Ct" ?\¢)
+ ("&Pd" ?\£)
+ ("&Cu" ?\¤)
+ ("&Ye" ?\¥)
+ ("&BB" ?\¦)
+ ("&SE" ?\§)
+ ("&':" ?\¨)
+ ("&Co" ?\©)
+ ("&-a" ?\ª)
+ ("&<<" ?\«)
+ ("&NO" ?\¬)
+ ("&--" ?\­)
+ ("&Rg" ?\®)
+ ("&'m" ?\¯)
+ ("&DG" ?\°)
+ ("&+-" ?\±)
+ ("&2S" ?\²)
+ ("&3S" ?\³)
+ ("&''" ?\´)
+ ("&My" ?\µ)
+ ("&PI" ?\¶)
+ ("&.M" ?\·)
+ ("&'," ?\¸)
+ ("&1S" ?\¹)
+ ("&-o" ?\º)
+ ("&>>" ?\»)
+ ("&14" ?\¼)
+ ("&12" ?\½)
+ ("&34" ?\¾)
+ ("&?I" ?\¿)
+ ("&A!" ?\À)
+ ("&A'" ?\Á)
+ ("&A>" ?\Â)
+ ("&A?" ?\Ã)
+ ("&A:" ?\Ä)
+ ("&AA" ?\Å)
+ ("&AE" ?\Æ)
+ ("&C," ?\Ç)
+ ("&E!" ?\È)
+ ("&E'" ?\É)
+ ("&E>" ?\Ê)
+ ("&E:" ?\Ë)
+ ("&I!" ?\Ì)
+ ("&I'" ?\Í)
+ ("&I>" ?\Î)
+ ("&I:" ?\Ï)
+ ("&D-" ?\Ð)
+ ("&N?" ?\Ñ)
+ ("&O!" ?\Ò)
+ ("&O'" ?\Ó)
+ ("&O>" ?\Ô)
+ ("&O?" ?\Õ)
+ ("&O:" ?\Ö)
+ ("&*X" ?\×)
+ ("&O/" ?\Ø)
+ ("&U!" ?\Ù)
+ ("&U'" ?\Ú)
+ ("&U>" ?\Û)
+ ("&U:" ?\Ü)
+ ("&Y'" ?\Ý)
+ ("&TH" ?\Þ)
+ ("&ss" ?\ß)
+ ("&a!" ?\à)
+ ("&a'" ?\á)
+ ("&a>" ?\â)
+ ("&a?" ?\ã)
+ ("&a:" ?\ä)
+ ("&aa" ?\å)
+ ("&ae" ?\æ)
+ ("&c," ?\ç)
+ ("&e!" ?\è)
+ ("&e'" ?\é)
+ ("&e>" ?\ê)
+ ("&e:" ?\ë)
+ ("&i!" ?\ì)
+ ("&i'" ?\í)
+ ("&i>" ?\î)
+ ("&i:" ?\ï)
+ ("&d-" ?\ð)
+ ("&n?" ?\ñ)
+ ("&o!" ?\ò)
+ ("&o'" ?\ó)
+ ("&o>" ?\ô)
+ ("&o?" ?\õ)
+ ("&o:" ?\ö)
+ ("&-:" ?\÷)
+ ("&o/" ?\ø)
+ ("&u!" ?\ù)
+ ("&u'" ?\ú)
+ ("&u>" ?\û)
+ ("&u:" ?\ü)
+ ("&y'" ?\ý)
+ ("&th" ?\þ)
+ ("&y:" ?\ÿ)
+ ("&A-" ?\Ā)
+ ("&a-" ?\ā)
+ ("&A(" ?\Ă)
+ ("&a(" ?\ă)
+ ("&A;" ?\Ą)
+ ("&a;" ?\ą)
+ ("&C'" ?\Ć)
+ ("&c'" ?\ć)
+ ("&C>" ?\Ĉ)
+ ("&c>" ?\ĉ)
+ ("&C." ?\Ċ)
+ ("&c." ?\ċ)
+ ("&C<" ?\Č)
+ ("&c<" ?\č)
+ ("&D<" ?\Ď)
+ ("&d<" ?\ď)
+ ("&D/" ?\Đ)
+ ("&d/" ?\đ)
+ ("&E-" ?\Ē)
+ ("&e-" ?\ē)
+ ("&E(" ?\Ĕ)
+ ("&e(" ?\ĕ)
+ ("&E." ?\Ė)
+ ("&e." ?\ė)
+ ("&E;" ?\Ę)
+ ("&e;" ?\ę)
+ ("&E<" ?\Ě)
+ ("&e<" ?\ě)
+ ("&G>" ?\Ĝ)
+ ("&g>" ?\ĝ)
+ ("&G(" ?\Ğ)
+ ("&g(" ?\ğ)
+ ("&G." ?\Ġ)
+ ("&g." ?\ġ)
+ ("&G," ?\Ģ)
+ ("&g," ?\ģ)
+ ("&H>" ?\Ĥ)
+ ("&h>" ?\ĥ)
+ ("&H/" ?\Ħ)
+ ("&h/" ?\ħ)
+ ("&I?" ?\Ĩ)
+ ("&i?" ?\ĩ)
+ ("&I-" ?\Ī)
+ ("&i-" ?\ī)
+ ("&I(" ?\Ĭ)
+ ("&i(" ?\ĭ)
+ ("&I;" ?\Į)
+ ("&i;" ?\į)
+ ("&I." ?\İ)
+ ("&i." ?\ı)
+ ("&IJ" ?\IJ)
+ ("&ij" ?\ij)
+ ("&J>" ?\Ĵ)
+ ("&j>" ?\ĵ)
+ ("&K," ?\Ķ)
+ ("&k," ?\ķ)
+ ("&kk" ?\ĸ)
+ ("&L'" ?\Ĺ)
+ ("&l'" ?\ĺ)
+ ("&L," ?\Ļ)
+ ("&l," ?\ļ)
+ ("&L<" ?\Ľ)
+ ("&l<" ?\ľ)
+ ("&L." ?\Ŀ)
+ ("&l." ?\ŀ)
+ ("&L/" ?\Ł)
+ ("&l/" ?\ł)
+ ("&N'" ?\Ń)
+ ("&n'" ?\ń)
+ ("&N," ?\Ņ)
+ ("&n," ?\ņ)
+ ("&N<" ?\Ň)
+ ("&n<" ?\ň)
+ ("&'n" ?\ʼn)
+ ("&NG" ?\Ŋ)
+ ("&ng" ?\ŋ)
+ ("&O-" ?\Ō)
+ ("&o-" ?\ō)
+ ("&O(" ?\Ŏ)
+ ("&o(" ?\ŏ)
+ ("&O\"" ?\Ő)
+ ("&o\"" ?\ő)
+ ("&OE" ?\Œ)
+ ("&oe" ?\œ)
+ ("&R'" ?\Ŕ)
+ ("&r'" ?\ŕ)
+ ("&R," ?\Ŗ)
+ ("&r," ?\ŗ)
+ ("&R<" ?\Ř)
+ ("&r<" ?\ř)
+ ("&S'" ?\Ś)
+ ("&s'" ?\ś)
+ ("&S>" ?\Ŝ)
+ ("&s>" ?\ŝ)
+ ("&S," ?\Ş)
+ ("&s," ?\ş)
+ ("&S<" ?\Š)
+ ("&s<" ?\š)
+ ("&T," ?\Ţ)
+ ("&t," ?\ţ)
+ ("&T<" ?\Ť)
+ ("&t<" ?\ť)
+ ("&T/" ?\Ŧ)
+ ("&t/" ?\ŧ)
+ ("&U?" ?\Ũ)
+ ("&u?" ?\ũ)
+ ("&U-" ?\Ū)
+ ("&u-" ?\ū)
+ ("&U(" ?\Ŭ)
+ ("&u(" ?\ŭ)
+ ("&U0" ?\Ů)
+ ("&u0" ?\ů)
+ ("&U\"" ?\Ű)
+ ("&u\"" ?\ű)
+ ("&U;" ?\Ų)
+ ("&u;" ?\ų)
+ ("&W>" ?\Ŵ)
+ ("&w>" ?\ŵ)
+ ("&Y>" ?\Ŷ)
+ ("&y>" ?\ŷ)
+ ("&Y:" ?\Ÿ)
+ ("&Z'" ?\Ź)
+ ("&z'" ?\ź)
+ ("&Z." ?\Ż)
+ ("&z." ?\ż)
+ ("&Z<" ?\Ž)
+ ("&z<" ?\ž)
+ ("&s1" ?\ſ)
+ ("&b/" ?\ƀ)
+ ("&B2" ?\Ɓ)
+ ("&C2" ?\Ƈ)
+ ("&c2" ?\ƈ)
+ ("&F2" ?\Ƒ)
+ ("&f2" ?\ƒ)
+ ("&K2" ?\Ƙ)
+ ("&k2" ?\ƙ)
+ ("&O9" ?\Ơ)
+ ("&o9" ?\ơ)
+ ("&OI" ?\Ƣ)
+ ("&oi" ?\ƣ)
+ ("&yr" ?\Ʀ)
+ ("&U9" ?\Ư)
+ ("&u9" ?\ư)
+ ("&Z/" ?\Ƶ)
+ ("&z/" ?\ƶ)
+ ("&ED" ?\Ʒ)
+ ("&DZ<" ?\DŽ)
+ ("&Dz<" ?\Dž)
+ ("&dz<" ?\dž)
+ ("&LJ3" ?\LJ)
+ ("&Lj3" ?\Lj)
+ ("&lj3" ?\lj)
+ ("&NJ3" ?\NJ)
+ ("&Nj3" ?\Nj)
+ ("&nj3" ?\nj)
+ ("&A<" ?\Ǎ)
+ ("&a<" ?\ǎ)
+ ("&I<" ?\Ǐ)
+ ("&i<" ?\ǐ)
+ ("&O<" ?\Ǒ)
+ ("&o<" ?\ǒ)
+ ("&U<" ?\Ǔ)
+ ("&u<" ?\ǔ)
+ ("&U:-" ?\Ǖ)
+ ("&u:-" ?\ǖ)
+ ("&U:'" ?\Ǘ)
+ ("&u:'" ?\ǘ)
+ ("&U:<" ?\Ǚ)
+ ("&u:<" ?\ǚ)
+ ("&U:!" ?\Ǜ)
+ ("&u:!" ?\ǜ)
+ ("&e1" ?\ǝ)
+ ("&A1" ?\Ǟ)
+ ("&a1" ?\ǟ)
+ ("&A7" ?\Ǡ)
+ ("&a7" ?\ǡ)
+ ("&A3" ?\Ǣ)
+ ("&a3" ?\ǣ)
+ ("&G/" ?\Ǥ)
+ ("&g/" ?\ǥ)
+ ("&G<" ?\Ǧ)
+ ("&g<" ?\ǧ)
+ ("&K<" ?\Ǩ)
+ ("&k<" ?\ǩ)
+ ("&O;" ?\Ǫ)
+ ("&o;" ?\ǫ)
+ ("&O1" ?\Ǭ)
+ ("&o1" ?\ǭ)
+ ("&EZ" ?\Ǯ)
+ ("&ez" ?\ǯ)
+ ("&j<" ?\ǰ)
+ ("&DZ3" ?\DZ)
+ ("&Dz3" ?\Dz)
+ ("&dz3" ?\dz)
+ ("&G'" ?\Ǵ)
+ ("&g'" ?\ǵ)
+ ("&AA'" ?\Ǻ)
+ ("&aa'" ?\ǻ)
+ ("&AE'" ?\Ǽ)
+ ("&ae'" ?\ǽ)
+ ("&O/'" ?\Ǿ)
+ ("&o/'" ?\ǿ)
+ ("&A!!" ?\Ȁ)
+ ("&a!!" ?\ȁ)
+ ("&A)" ?\Ȃ)
+ ("&a)" ?\ȃ)
+ ("&E!!" ?\Ȅ)
+ ("&e!!" ?\ȅ)
+ ("&E)" ?\Ȇ)
+ ("&e)" ?\ȇ)
+ ("&I!!" ?\Ȉ)
+ ("&i!!" ?\ȉ)
+ ("&I)" ?\Ȋ)
+ ("&i)" ?\ȋ)
+ ("&O!!" ?\Ȍ)
+ ("&o!!" ?\ȍ)
+ ("&O)" ?\Ȏ)
+ ("&o)" ?\ȏ)
+ ("&R!!" ?\Ȑ)
+ ("&r!!" ?\ȑ)
+ ("&R)" ?\Ȓ)
+ ("&r)" ?\ȓ)
+ ("&U!!" ?\Ȕ)
+ ("&u!!" ?\ȕ)
+ ("&U)" ?\Ȗ)
+ ("&u)" ?\ȗ)
+ ("&r1" ?\ɼ)
+ ("&ed" ?\ʒ)
+ ("&;S" ?\ʻ)
+ ("&1>" ?\ˆ)
+ ("&'<" ?\ˇ)
+ ("&1-" ?\ˉ)
+ ("&1!" ?\ˋ)
+ ("&'(" ?\˘)
+ ("&'." ?\˙)
+ ("&'0" ?\˚)
+ ("&';" ?\˛)
+ ("&1?" ?\˜)
+ ("&'\"" ?\˝)
+ ("&'G" ?\ʹ)
+ ("&,G" ?\͵)
+ ("&j3" ?\ͺ)
+ ("&?%" ?\;)
+ ("&'*" ?\΄)
+ ("&'%" ?\΅)
+ ("&A%" ?\Ά)
+ ("&.*" ?\·)
+ ("&E%" ?\Έ)
+ ("&Y%" ?\Ή)
+ ("&I%" ?\Ί)
+ ("&O%" ?\Ό)
+ ("&U%" ?\Ύ)
+ ("&W%" ?\Ώ)
+ ("&i3" ?\ΐ)
+ ("&A*" ?\Α)
+ ("&B*" ?\Β)
+ ("&G*" ?\Γ)
+ ("&D*" ?\Δ)
+ ("&E*" ?\Ε)
+ ("&Z*" ?\Ζ)
+ ("&Y*" ?\Η)
+ ("&H*" ?\Θ)
+ ("&I*" ?\Ι)
+ ("&K*" ?\Κ)
+ ("&L*" ?\Λ)
+ ("&M*" ?\Μ)
+ ("&N*" ?\Ν)
+ ("&C*" ?\Ξ)
+ ("&O*" ?\Ο)
+ ("&P*" ?\Π)
+ ("&R*" ?\Ρ)
+ ("&S*" ?\Σ)
+ ("&T*" ?\Τ)
+ ("&U*" ?\Υ)
+ ("&F*" ?\Φ)
+ ("&X*" ?\Χ)
+ ("&Q*" ?\Ψ)
+ ("&W*" ?\Ω)
+ ("&J*" ?\Ϊ)
+ ("&V*" ?\Ϋ)
+ ("&a%" ?\ά)
+ ("&e%" ?\έ)
+ ("&y%" ?\ή)
+ ("&i%" ?\ί)
+ ("&u3" ?\ΰ)
+ ("&a*" ?\α)
+ ("&b*" ?\β)
+ ("&g*" ?\γ)
+ ("&d*" ?\δ)
+ ("&e*" ?\ε)
+ ("&z*" ?\ζ)
+ ("&y*" ?\η)
+ ("&h*" ?\θ)
+ ("&i*" ?\ι)
+ ("&k*" ?\κ)
+ ("&l*" ?\λ)
+ ("&m*" ?\μ)
+ ("&n*" ?\ν)
+ ("&c*" ?\ξ)
+ ("&o*" ?\ο)
+ ("&p*" ?\π)
+ ("&r*" ?\ρ)
+ ("&*s" ?\ς)
+ ("&s*" ?\σ)
+ ("&t*" ?\τ)
+ ("&u*" ?\υ)
+ ("&f*" ?\φ)
+ ("&x*" ?\χ)
+ ("&q*" ?\ψ)
+ ("&w*" ?\ω)
+ ("&j*" ?\ϊ)
+ ("&v*" ?\ϋ)
+ ("&o%" ?\ό)
+ ("&u%" ?\ύ)
+ ("&w%" ?\ώ)
+ ("&b3" ?\ϐ)
+ ("&T3" ?\Ϛ)
+ ("&M3" ?\Ϝ)
+ ("&K3" ?\Ϟ)
+ ("&P3" ?\Ϡ)
+ ("&IO" ?\Ё)
+ ("&D%" ?\Ђ)
+ ("&G%" ?\Ѓ)
+ ("&IE" ?\Є)
+ ("&DS" ?\Ѕ)
+ ("&II" ?\І)
+ ("&YI" ?\Ї)
+ ("&J%" ?\Ј)
+ ("&LJ" ?\Љ)
+ ("&NJ" ?\Њ)
+ ("&Ts" ?\Ћ)
+ ("&KJ" ?\Ќ)
+ ("&V%" ?\Ў)
+ ("&DZ" ?\Џ)
+ ("&A=" ?\А)
+ ("&B=" ?\Б)
+ ("&V=" ?\В)
+ ("&G=" ?\Г)
+ ("&D=" ?\Д)
+ ("&E=" ?\Е)
+ ("&Z%" ?\Ж)
+ ("&Z=" ?\З)
+ ("&I=" ?\И)
+ ("&J=" ?\Й)
+ ("&K=" ?\К)
+ ("&L=" ?\Л)
+ ("&M=" ?\М)
+ ("&N=" ?\Н)
+ ("&O=" ?\О)
+ ("&P=" ?\П)
+ ("&R=" ?\Р)
+ ("&S=" ?\С)
+ ("&T=" ?\Т)
+ ("&U=" ?\У)
+ ("&F=" ?\Ф)
+ ("&H=" ?\Х)
+ ("&C=" ?\Ц)
+ ("&C%" ?\Ч)
+ ("&S%" ?\Ш)
+ ("&Sc" ?\Щ)
+ ("&=\"" ?\Ъ)
+ ("&Y=" ?\Ы)
+ ("&%\"" ?\Ь)
+ ("&JE" ?\Э)
+ ("&JU" ?\Ю)
+ ("&JA" ?\Я)
+ ("&a=" ?\а)
+ ("&b=" ?\б)
+ ("&v=" ?\в)
+ ("&g=" ?\г)
+ ("&d=" ?\д)
+ ("&e=" ?\е)
+ ("&z%" ?\ж)
+ ("&z=" ?\з)
+ ("&i=" ?\и)
+ ("&j=" ?\й)
+ ("&k=" ?\к)
+ ("&l=" ?\л)
+ ("&m=" ?\м)
+ ("&n=" ?\н)
+ ("&o=" ?\о)
+ ("&p=" ?\п)
+ ("&r=" ?\р)
+ ("&s=" ?\с)
+ ("&t=" ?\т)
+ ("&u=" ?\у)
+ ("&f=" ?\ф)
+ ("&h=" ?\х)
+ ("&c=" ?\ц)
+ ("&c%" ?\ч)
+ ("&s%" ?\ш)
+ ("&sc" ?\щ)
+ ("&='" ?\ъ)
+ ("&y=" ?\ы)
+ ("&%'" ?\ь)
+ ("&je" ?\э)
+ ("&ju" ?\ю)
+ ("&ja" ?\я)
+ ("&io" ?\ё)
+ ("&d%" ?\ђ)
+ ("&g%" ?\ѓ)
+ ("&ie" ?\є)
+ ("&ds" ?\ѕ)
+ ("&ii" ?\і)
+ ("&yi" ?\ї)
+ ("&j%" ?\ј)
+ ("&lj" ?\љ)
+ ("&nj" ?\њ)
+ ("&ts" ?\ћ)
+ ("&kj" ?\ќ)
+ ("&v%" ?\ў)
+ ("&dz" ?\џ)
+ ("&Y3" ?\Ѣ)
+ ("&y3" ?\ѣ)
+ ("&O3" ?\Ѫ)
+ ("&o3" ?\ѫ)
+ ("&F3" ?\Ѳ)
+ ("&f3" ?\ѳ)
+ ("&V3" ?\Ѵ)
+ ("&v3" ?\ѵ)
+ ("&C3" ?\Ҁ)
+ ("&c3" ?\ҁ)
+ ("&G3" ?\Ґ)
+ ("&g3" ?\ґ)
+ ("&A+" ?\א)
+ ("&B+" ?\ב)
+ ("&G+" ?\ג)
+ ("&D+" ?\ד)
+ ("&H+" ?\ה)
+ ("&W+" ?\ו)
+ ("&Z+" ?\ז)
+ ("&X+" ?\ח)
+ ("&Tj" ?\ט)
+ ("&J+" ?\י)
+ ("&K%" ?\ך)
+ ("&K+" ?\כ)
+ ("&L+" ?\ל)
+ ("&M%" ?\ם)
+ ("&M+" ?\מ)
+ ("&N%" ?\ן)
+ ("&N+" ?\נ)
+ ("&S+" ?\ס)
+ ("&E+" ?\ע)
+ ("&P%" ?\ף)
+ ("&P+" ?\פ)
+ ("&Zj" ?\ץ)
+ ("&ZJ" ?\צ)
+ ("&Q+" ?\ק)
+ ("&R+" ?\ר)
+ ("&Sh" ?\ש)
+ ("&T+" ?\ת)
+ ("&,+" ?\،)
+ ("&;+" ?\؛)
+ ("&?+" ?\؟)
+ ("&H'" ?\ء)
+ ("&aM" ?\آ)
+ ("&aH" ?\أ)
+ ("&wH" ?\ؤ)
+ ("&ah" ?\إ)
+ ("&yH" ?\ئ)
+ ("&a+" ?\ا)
+ ("&b+" ?\ب)
+ ("&tm" ?\ة)
+ ("&t+" ?\ت)
+ ("&tk" ?\ث)
+ ("&g+" ?\ج)
+ ("&hk" ?\ح)
+ ("&x+" ?\خ)
+ ("&d+" ?\د)
+ ("&dk" ?\ذ)
+ ("&r+" ?\ر)
+ ("&z+" ?\ز)
+ ("&s+" ?\س)
+ ("&sn" ?\ش)
+ ("&c+" ?\ص)
+ ("&dd" ?\ض)
+ ("&tj" ?\ط)
+ ("&zH" ?\ظ)
+ ("&e+" ?\ع)
+ ("&i+" ?\غ)
+ ("&++" ?\ـ)
+ ("&f+" ?\ف)
+ ("&q+" ?\ق)
+ ("&k+" ?\ك)
+ ("&l+" ?\ل)
+ ("&m+" ?\م)
+ ("&n+" ?\ن)
+ ("&h+" ?\ه)
+ ("&w+" ?\و)
+ ("&j+" ?\ى)
+ ("&y+" ?\ي)
+ ("&:+" ?\ً)
+ ("&\"+" ?\ٌ)
+ ("&=+" ?\ٍ)
+ ("&/+" ?\َ)
+ ("&'+" ?\ُ)
+ ("&1+" ?\ِ)
+ ("&3+" ?\ّ)
+ ("&0+" ?\ْ)
+ ("&0a" ?\٠)
+ ("&1a" ?\١)
+ ("&2a" ?\٢)
+ ("&3a" ?\٣)
+ ("&4a" ?\٤)
+ ("&5a" ?\٥)
+ ("&6a" ?\٦)
+ ("&7a" ?\٧)
+ ("&8a" ?\٨)
+ ("&9a" ?\٩)
+ ("&aS" ?\ٰ)
+ ("&p+" ?\پ)
+ ("&hH" ?\ځ)
+ ("&tc" ?\چ)
+ ("&zj" ?\ژ)
+ ("&v+" ?\ڤ)
+ ("&gf" ?\گ)
+ ("&A-0" ?\Ḁ)
+ ("&a-0" ?\ḁ)
+ ("&B." ?\Ḃ)
+ ("&b." ?\ḃ)
+ ("&B-." ?\Ḅ)
+ ("&b-." ?\ḅ)
+ ("&B_" ?\Ḇ)
+ ("&b_" ?\ḇ)
+ ("&C,'" ?\Ḉ)
+ ("&c,'" ?\ḉ)
+ ("&D." ?\Ḋ)
+ ("&d." ?\ḋ)
+ ("&D-." ?\Ḍ)
+ ("&d-." ?\ḍ)
+ ("&D_" ?\Ḏ)
+ ("&d_" ?\ḏ)
+ ("&D," ?\Ḑ)
+ ("&d," ?\ḑ)
+ ("&D->" ?\Ḓ)
+ ("&d->" ?\ḓ)
+ ("&E-!" ?\Ḕ)
+ ("&e-!" ?\ḕ)
+ ("&E-'" ?\Ḗ)
+ ("&e-'" ?\ḗ)
+ ("&E->" ?\Ḙ)
+ ("&e->" ?\ḙ)
+ ("&E-?" ?\Ḛ)
+ ("&e-?" ?\ḛ)
+ ("&E,(" ?\Ḝ)
+ ("&e,(" ?\ḝ)
+ ("&F." ?\Ḟ)
+ ("&f." ?\ḟ)
+ ("&G-" ?\Ḡ)
+ ("&g-" ?\ḡ)
+ ("&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-." ?\ṃ)
+ ("&N." ?\Ṅ)
+ ("&n." ?\ṅ)
+ ("&N-." ?\Ṇ)
+ ("&n-." ?\ṇ)
+ ("&N_" ?\Ṉ)
+ ("&n_" ?\ṉ)
+ ("&N->" ?\Ṋ)
+ ("&n->" ?\ṋ)
+ ("&O?'" ?\Ṍ)
+ ("&o?'" ?\ṍ)
+ ("&O?:" ?\Ṏ)
+ ("&o?:" ?\ṏ)
+ ("&O-!" ?\Ṑ)
+ ("&o-!" ?\ṑ)
+ ("&O-'" ?\Ṓ)
+ ("&o-'" ?\ṓ)
+ ("&P'" ?\Ṕ)
+ ("&p'" ?\ṕ)
+ ("&P." ?\Ṗ)
+ ("&p." ?\ṗ)
+ ("&R." ?\Ṙ)
+ ("&r." ?\ṙ)
+ ("&R-." ?\Ṛ)
+ ("&r-." ?\ṛ)
+ ("&R_" ?\Ṟ)
+ ("&r_" ?\ṟ)
+ ("&S." ?\Ṡ)
+ ("&s." ?\ṡ)
+ ("&S-." ?\Ṣ)
+ ("&s-." ?\ṣ)
+ ("&S'." ?\Ṥ)
+ ("&s'." ?\ṥ)
+ ("&S<." ?\Ṧ)
+ ("&s<." ?\ṧ)
+ ("&T." ?\Ṫ)
+ ("&t." ?\ṫ)
+ ("&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-." ?\ẉ)
+ ("&X." ?\Ẋ)
+ ("&x." ?\ẋ)
+ ("&X:" ?\Ẍ)
+ ("&x:" ?\ẍ)
+ ("&Y." ?\Ẏ)
+ ("&y." ?\ẏ)
+ ("&Z>" ?\Ẑ)
+ ("&z>" ?\ẑ)
+ ("&Z-." ?\Ẓ)
+ ("&z-." ?\ẓ)
+ ("&Z_" ?\Ẕ)
+ ("&z_" ?\ẕ)
+ ("&A-." ?\Ạ)
+ ("&a-." ?\ạ)
+ ("&A2" ?\Ả)
+ ("&a2" ?\ả)
+ ("&A>'" ?\Ấ)
+ ("&a>'" ?\ấ)
+ ("&A>!" ?\Ầ)
+ ("&a>!" ?\ầ)
+ ("&A>2" ?\Ẩ)
+ ("&a>2" ?\ẩ)
+ ("&A>?" ?\Ẫ)
+ ("&a>?" ?\ẫ)
+ ("&A('" ?\Ắ)
+ ("&a('" ?\ắ)
+ ("&A(!" ?\Ằ)
+ ("&a(!" ?\ằ)
+ ("&A(2" ?\Ẳ)
+ ("&a(2" ?\ẳ)
+ ("&A(?" ?\Ẵ)
+ ("&a(?" ?\ẵ)
+ ("&E-." ?\Ẹ)
+ ("&e-." ?\ẹ)
+ ("&E2" ?\Ẻ)
+ ("&e2" ?\ẻ)
+ ("&E?" ?\Ẽ)
+ ("&e?" ?\ẽ)
+ ("&E>'" ?\Ế)
+ ("&e>'" ?\ế)
+ ("&E>!" ?\Ề)
+ ("&e>!" ?\ề)
+ ("&E>2" ?\Ể)
+ ("&e>2" ?\ể)
+ ("&E>?" ?\Ễ)
+ ("&e>?" ?\ễ)
+ ("&I2" ?\Ỉ)
+ ("&i2" ?\ỉ)
+ ("&I-." ?\Ị)
+ ("&i-." ?\ị)
+ ("&O-." ?\Ọ)
+ ("&o-." ?\ọ)
+ ("&O2" ?\Ỏ)
+ ("&o2" ?\ỏ)
+ ("&O>'" ?\Ố)
+ ("&o>'" ?\ố)
+ ("&O>!" ?\Ồ)
+ ("&o>!" ?\ồ)
+ ("&O>2" ?\Ổ)
+ ("&o>2" ?\ổ)
+ ("&O>?" ?\Ỗ)
+ ("&o>?" ?\ỗ)
+ ("&O9'" ?\Ớ)
+ ("&o9'" ?\ớ)
+ ("&O9!" ?\Ờ)
+ ("&o9!" ?\ờ)
+ ("&O92" ?\Ở)
+ ("&o92" ?\ở)
+ ("&O9?" ?\Ỡ)
+ ("&o9?" ?\ỡ)
+ ("&U-." ?\Ụ)
+ ("&u-." ?\ụ)
+ ("&U2" ?\Ủ)
+ ("&u2" ?\ủ)
+ ("&U9'" ?\Ứ)
+ ("&u9'" ?\ứ)
+ ("&U9!" ?\Ừ)
+ ("&u9!" ?\ừ)
+ ("&U92" ?\Ử)
+ ("&u92" ?\ử)
+ ("&U9?" ?\Ữ)
+ ("&u9?" ?\ữ)
+ ("&Y!" ?\Ỳ)
+ ("&y!" ?\ỳ)
+ ("&Y-." ?\Ỵ)
+ ("&y-." ?\ỵ)
+ ("&Y2" ?\Ỷ)
+ ("&y2" ?\ỷ)
+ ("&Y?" ?\Ỹ)
+ ("&y?" ?\ỹ)
+ ("&a*," ?\ἀ)
+ ("&a*;" ?\ἁ)
+ ("&A*," ?\Ἀ)
+ ("&A*;" ?\Ἁ)
+ ("&e*," ?\ἐ)
+ ("&e*;" ?\ἑ)
+ ("&E*," ?\Ἐ)
+ ("&E*;" ?\Ἑ)
+ ("&y*," ?\ἠ)
+ ("&y*;" ?\ἡ)
+ ("&Y*," ?\Ἠ)
+ ("&Y*;" ?\Ἡ)
+ ("&i*," ?\ἰ)
+ ("&i*;" ?\ἱ)
+ ("&I*," ?\Ἰ)
+ ("&I*;" ?\Ἱ)
+ ("&o*," ?\ὀ)
+ ("&o*;" ?\ὁ)
+ ("&O*," ?\Ὀ)
+ ("&O*;" ?\Ὁ)
+ ("&u*," ?\ὐ)
+ ("&u*;" ?\ὑ)
+ ("&U*;" ?\Ὑ)
+ ("&w*," ?\ὠ)
+ ("&w*;" ?\ὡ)
+ ("&W*," ?\Ὠ)
+ ("&W*;" ?\Ὡ)
+ ("&a*!" ?\ὰ)
+ ("&a*'" ?\ά)
+ ("&e*!" ?\ὲ)
+ ("&e*'" ?\έ)
+ ("&y*!" ?\ὴ)
+ ("&y*'" ?\ή)
+ ("&i*!" ?\ὶ)
+ ("&i*'" ?\ί)
+ ("&o*!" ?\ὸ)
+ ("&o*'" ?\ό)
+ ("&u*!" ?\ὺ)
+ ("&u*'" ?\ύ)
+ ("&w*!" ?\ὼ)
+ ("&w*'" ?\ώ)
+ ("&a*(" ?\ᾰ)
+ ("&a*-" ?\ᾱ)
+ ("&a*j" ?\ᾳ)
+ ("&a*?" ?\ᾶ)
+ ("&A*(" ?\Ᾰ)
+ ("&A*-" ?\Ᾱ)
+ ("&A*!" ?\Ὰ)
+ ("&A*'" ?\Ά)
+ ("&A*J" ?\ᾼ)
+ ("&)*" ?\᾽)
+ ("&J3" ?\ι)
+ ("&,," ?\᾿)
+ ("&?*" ?\῀)
+ ("&?:" ?\῁)
+ ("&y*j" ?\ῃ)
+ ("&y*?" ?\ῆ)
+ ("&E*'" ?\Έ)
+ ("&Y*!" ?\Ὴ)
+ ("&Y*'" ?\Ή)
+ ("&Y*J" ?\ῌ)
+ ("&,!" ?\῍)
+ ("&,'" ?\῎)
+ ("&?," ?\῏)
+ ("&i*(" ?\ῐ)
+ ("&i*-" ?\ῑ)
+ ("&i*?" ?\ῖ)
+ ("&I*(" ?\Ῐ)
+ ("&I*-" ?\Ῑ)
+ ("&I*!" ?\Ὶ)
+ ("&I*'" ?\Ί)
+ ("&;!" ?\῝)
+ ("&;'" ?\῞)
+ ("&?;" ?\῟)
+ ("&u*(" ?\ῠ)
+ ("&u*-" ?\ῡ)
+ ("&r*," ?\ῤ)
+ ("&r*;" ?\ῥ)
+ ("&u*?" ?\ῦ)
+ ("&U*(" ?\Ῠ)
+ ("&U*-" ?\Ῡ)
+ ("&U*!" ?\Ὺ)
+ ("&U*'" ?\Ύ)
+ ("&R*;" ?\Ῥ)
+ ("&!:" ?\῭)
+ ("&:'" ?\΅)
+ ("&!*" ?\`)
+ ("&w*j" ?\ῳ)
+ ("&w*?" ?\ῶ)
+ ("&O*!" ?\Ὸ)
+ ("&O*'" ?\Ό)
+ ("&W*!" ?\Ὼ)
+ ("&W*'" ?\Ώ)
+ ("&W*J" ?\ῼ)
+ ("&/*" ?\´)
+ ("&;;" ?\῾)
+ ("&1N" ?\ )
+ ("&1M" ?\ )
+ ("&3M" ?\ )
+ ("&4M" ?\ )
+ ("&6M" ?\ )
+ ("&1T" ?\ )
+ ("&1H" ?\ )
+ ("&LR" ?\‎)
+ ("&RL" ?\‏)
+ ("&-1" ?\‐)
+ ("&-N" ?\–)
+ ("&-M" ?\—)
+ ("&-3" ?\―)
+ ("&!2" ?\‖)
+ ("&=2" ?\‗)
+ ("&'6" ?\‘)
+ ("&'9" ?\’)
+ ("&.9" ?\‚)
+ ("&9'" ?\‛)
+ ("&\"6" ?\“)
+ ("&\"9" ?\”)
+ ("&:9" ?\„)
+ ("&9\"" ?\‟)
+ ("&/-" ?\†)
+ ("&/=" ?\‡)
+ ("&sb" ?\•)
+ ("&3b" ?\‣)
+ ("&.." ?\‥)
+ ("&.3" ?\…)
+ ("&.-" ?\‧)
+ ("&%0" ?\‰)
+ ("&1'" ?\′)
+ ("&2'" ?\″)
+ ("&3'" ?\‴)
+ ("&1\"" ?\‵)
+ ("&2\"" ?\‶)
+ ("&3\"" ?\‷)
+ ("&Ca" ?\‸)
+ ("&<1" ?\‹)
+ ("&>1" ?\›)
+ ("&:X" ?\※)
+ ("&!*2" ?\‼)
+ ("&'-" ?\‾)
+ ("&-b" ?\⁃)
+ ("&/f" ?\⁄)
+ ("&0S" ?\⁰)
+ ("&4S" ?\⁴)
+ ("&5S" ?\⁵)
+ ("&6S" ?\⁶)
+ ("&7S" ?\⁷)
+ ("&8S" ?\⁸)
+ ("&9S" ?\⁹)
+ ("&+S" ?\⁺)
+ ("&-S" ?\⁻)
+ ("&=S" ?\⁼)
+ ("&(S" ?\⁽)
+ ("&)S" ?\⁾)
+ ("&nS" ?\ⁿ)
+ ("&0s" ?\₀)
+ ("&1s" ?\₁)
+ ("&2s" ?\₂)
+ ("&3s" ?\₃)
+ ("&4s" ?\₄)
+ ("&5s" ?\₅)
+ ("&6s" ?\₆)
+ ("&7s" ?\₇)
+ ("&8s" ?\₈)
+ ("&9s" ?\₉)
+ ("&+s" ?\₊)
+ ("&-s" ?\₋)
+ ("&=s" ?\₌)
+ ("&(s" ?\₍)
+ ("&)s" ?\₎)
+ ("&Ff" ?\₣)
+ ("&Li" ?\₤)
+ ("&Pt" ?\₧)
+ ("&W=" ?\₩)
+ ("&NSh" ?\₪)
+ ("&Eu" ?\€)
+ ("&\"7" ?\⃑)
+ ("&oC" ?\℃)
+ ("&co" ?\℅)
+ ("&oF" ?\℉)
+ ("&N0" ?\№)
+ ("&PO" ?\℗)
+ ("&Rx" ?\℞)
+ ("&SM" ?\℠)
+ ("&TM" ?\™)
+ ("&Om" ?\Ω)
+ ("&AO" ?\Å)
+ ("&Est" ?\℮)
+ ("&13" ?\⅓)
+ ("&23" ?\⅔)
+ ("&15" ?\⅕)
+ ("&25" ?\⅖)
+ ("&35" ?\⅗)
+ ("&45" ?\⅘)
+ ("&16" ?\⅙)
+ ("&56" ?\⅚)
+ ("&18" ?\⅛)
+ ("&38" ?\⅜)
+ ("&58" ?\⅝)
+ ("&78" ?\⅞)
+ ("&1R" ?\Ⅰ)
+ ("&2R" ?\Ⅱ)
+ ("&3R" ?\Ⅲ)
+ ("&4R" ?\Ⅳ)
+ ("&5R" ?\Ⅴ)
+ ("&6R" ?\Ⅵ)
+ ("&7R" ?\Ⅶ)
+ ("&8R" ?\Ⅷ)
+ ("&9R" ?\Ⅸ)
+ ("&aR" ?\Ⅹ)
+ ("&bR" ?\Ⅺ)
+ ("&cR" ?\Ⅻ)
+ ("&50R" ?\Ⅼ)
+ ("&1r" ?\ⅰ)
+ ("&2r" ?\ⅱ)
+ ("&3r" ?\ⅲ)
+ ("&4r" ?\ⅳ)
+ ("&5r" ?\ⅴ)
+ ("&6r" ?\ⅵ)
+ ("&7r" ?\ⅶ)
+ ("&8r" ?\ⅷ)
+ ("&9r" ?\ⅸ)
+ ("&ar" ?\ⅹ)
+ ("&br" ?\ⅺ)
+ ("&cr" ?\ⅻ)
+ ("&50r" ?\ⅼ)
+ ("&<-" ?\←)
+ ("&-!" ?\↑)
+ ("&->" ?\→)
+ ("&-v" ?\↓)
+ ("&<>" ?\↔)
+ ("&UD" ?\↕)
+ ("&<!!" ?\↖)
+ ("&//>" ?\↗)
+ ("&!!>" ?\↘)
+ ("&<//" ?\↙)
+ ("&UD-" ?\↨)
+ ("&>V" ?\⇀)
+ ("&<=" ?\⇐)
+ ("&=>" ?\⇒)
+ ("&==" ?\⇔)
+ ("&FA" ?\∀)
+ ("&dP" ?\∂)
+ ("&TE" ?\∃)
+ ("&/0" ?\∅)
+ ("&DE" ?\∆)
+ ("&NB" ?\∇)
+ ("&(-" ?\∈)
+ ("&-)" ?\∋)
+ ("&FP" ?\∎)
+ ("&*P" ?\∏)
+ ("&+Z" ?\∑)
+ ("&-2" ?\−)
+ ("&-+" ?\∓)
+ ("&.+" ?\∔)
+ ("&*-" ?\∗)
+ ("&Ob" ?\∘)
+ ("&Sb" ?\∙)
+ ("&RT" ?\√)
+ ("&0(" ?\∝)
+ ("&00" ?\∞)
+ ("&-L" ?\∟)
+ ("&-V" ?\∠)
+ ("&PP" ?\∥)
+ ("&AN" ?\∧)
+ ("&OR" ?\∨)
+ ("&(U" ?\∩)
+ ("&)U" ?\∪)
+ ("&In" ?\∫)
+ ("&DI" ?\∬)
+ ("&Io" ?\∮)
+ ("&.:" ?\∴)
+ ("&:." ?\∵)
+ ("&:R" ?\∶)
+ ("&::" ?\∷)
+ ("&?1" ?\∼)
+ ("&CG" ?\∾)
+ ("&?-" ?\≃)
+ ("&?=" ?\≅)
+ ("&?2" ?\≈)
+ ("&=?" ?\≌)
+ ("&HI" ?\≓)
+ ("&!=" ?\≠)
+ ("&=3" ?\≡)
+ ("&=<" ?\≤)
+ ("&>=" ?\≥)
+ ("&<*" ?\≪)
+ ("&*>" ?\≫)
+ ("&!<" ?\≮)
+ ("&!>" ?\≯)
+ ("&(C" ?\⊂)
+ ("&)C" ?\⊃)
+ ("&(_" ?\⊆)
+ ("&)_" ?\⊇)
+ ("&0." ?\⊙)
+ ("&02" ?\⊚)
+ ("&-T" ?\⊥)
+ ("&.P" ?\⋅)
+ ("&:3" ?\⋮)
+ ("&Eh" ?\⌂)
+ ("&<7" ?\⌈)
+ ("&>7" ?\⌉)
+ ("&7<" ?\⌊)
+ ("&7>" ?\⌋)
+ ("&NI" ?\⌐)
+ ("&(A" ?\⌒)
+ ("&TR" ?\⌕)
+ ("&88" ?\⌘)
+ ("&Iu" ?\⌠)
+ ("&Il" ?\⌡)
+ ("&</" ?\〈)
+ ("&/>" ?\〉)
+ ("&Vs" ?\␣)
+ ("&1h" ?\⑀)
+ ("&3h" ?\⑁)
+ ("&2h" ?\⑂)
+ ("&4h" ?\⑃)
+ ("&1j" ?\⑆)
+ ("&2j" ?\⑇)
+ ("&3j" ?\⑈)
+ ("&4j" ?\⑉)
+ ("&1-o" ?\①)
+ ("&2-o" ?\②)
+ ("&3-o" ?\③)
+ ("&4-o" ?\④)
+ ("&5-o" ?\⑤)
+ ("&6-o" ?\⑥)
+ ("&7-o" ?\⑦)
+ ("&8-o" ?\⑧)
+ ("&9-o" ?\⑨)
+ ("&(1)" ?\⑴)
+ ("&(2)" ?\⑵)
+ ("&(3)" ?\⑶)
+ ("&(4)" ?\⑷)
+ ("&(5)" ?\⑸)
+ ("&(6)" ?\⑹)
+ ("&(7)" ?\⑺)
+ ("&(8)" ?\⑻)
+ ("&(9)" ?\⑼)
+ ("&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-o" ?\Ⓐ)
+ ("&B-o" ?\Ⓑ)
+ ("&C-o" ?\Ⓒ)
+ ("&D-o" ?\Ⓓ)
+ ("&E-o" ?\Ⓔ)
+ ("&F-o" ?\Ⓕ)
+ ("&G-o" ?\Ⓖ)
+ ("&H-o" ?\Ⓗ)
+ ("&I-o" ?\Ⓘ)
+ ("&J-o" ?\Ⓙ)
+ ("&K-o" ?\Ⓚ)
+ ("&L-o" ?\Ⓛ)
+ ("&M-o" ?\Ⓜ)
+ ("&N-o" ?\Ⓝ)
+ ("&O-o" ?\Ⓞ)
+ ("&P-o" ?\Ⓟ)
+ ("&Q-o" ?\Ⓠ)
+ ("&R-o" ?\Ⓡ)
+ ("&S-o" ?\Ⓢ)
+ ("&T-o" ?\Ⓣ)
+ ("&U-o" ?\Ⓤ)
+ ("&V-o" ?\Ⓥ)
+ ("&W-o" ?\Ⓦ)
+ ("&X-o" ?\Ⓧ)
+ ("&Y-o" ?\Ⓨ)
+ ("&Z-o" ?\Ⓩ)
+ ("&a-o" ?\ⓐ)
+ ("&b-o" ?\ⓑ)
+ ("&c-o" ?\ⓒ)
+ ("&d-o" ?\ⓓ)
+ ("&e-o" ?\ⓔ)
+ ("&f-o" ?\ⓕ)
+ ("&g-o" ?\ⓖ)
+ ("&h-o" ?\ⓗ)
+ ("&i-o" ?\ⓘ)
+ ("&j-o" ?\ⓙ)
+ ("&k-o" ?\ⓚ)
+ ("&l-o" ?\ⓛ)
+ ("&m-o" ?\ⓜ)
+ ("&n-o" ?\ⓝ)
+ ("&o-o" ?\ⓞ)
+ ("&p-o" ?\ⓟ)
+ ("&q-o" ?\ⓠ)
+ ("&r-o" ?\ⓡ)
+ ("&s-o" ?\ⓢ)
+ ("&t-o" ?\ⓣ)
+ ("&u-o" ?\ⓤ)
+ ("&v-o" ?\ⓥ)
+ ("&w-o" ?\ⓦ)
+ ("&x-o" ?\ⓧ)
+ ("&y-o" ?\ⓨ)
+ ("&z-o" ?\ⓩ)
+ ("&0-o" ?\⓪)
+ ("&hh" ?\─)
+ ("&HH-" ?\━)
+ ("&vv" ?\│)
+ ("&VV-" ?\┃)
+ ("&3-" ?\┄)
+ ("&3_" ?\┅)
+ ("&3!" ?\┆)
+ ("&3/" ?\┇)
+ ("&4-" ?\┈)
+ ("&4_" ?\┉)
+ ("&4!" ?\┊)
+ ("&4/" ?\┋)
+ ("&dr" ?\┌)
+ ("&dR-" ?\┍)
+ ("&Dr-" ?\┎)
+ ("&DR-" ?\┏)
+ ("&dl" ?\┐)
+ ("&dL-" ?\┑)
+ ("&Dl-" ?\┒)
+ ("&LD-" ?\┓)
+ ("&ur" ?\└)
+ ("&uR-" ?\┕)
+ ("&Ur-" ?\┖)
+ ("&UR-" ?\┗)
+ ("&ul" ?\┘)
+ ("&uL-" ?\┙)
+ ("&Ul-" ?\┚)
+ ("&UL-" ?\┛)
+ ("&vr" ?\├)
+ ("&vR-" ?\┝)
+ ("&Udr" ?\┞)
+ ("&uDr" ?\┟)
+ ("&Vr-" ?\┠)
+ ("&UdR" ?\┡)
+ ("&uDR" ?\┢)
+ ("&VR-" ?\┣)
+ ("&vl" ?\┤)
+ ("&vL-" ?\┥)
+ ("&Udl" ?\┦)
+ ("&uDl" ?\┧)
+ ("&Vl-" ?\┨)
+ ("&UdL" ?\┩)
+ ("&uDL" ?\┪)
+ ("&VL-" ?\┫)
+ ("&dh" ?\┬)
+ ("&dLr" ?\┭)
+ ("&dlR" ?\┮)
+ ("&dH-" ?\┯)
+ ("&Dh-" ?\┰)
+ ("&DLr" ?\┱)
+ ("&DlR" ?\┲)
+ ("&DH-" ?\┳)
+ ("&uh" ?\┴)
+ ("&uLr" ?\┵)
+ ("&ulR" ?\┶)
+ ("&uH-" ?\┷)
+ ("&Uh-" ?\┸)
+ ("&ULr" ?\┹)
+ ("&UlR" ?\┺)
+ ("&UH-" ?\┻)
+ ("&vh" ?\┼)
+ ("&vLr" ?\┽)
+ ("&vlR" ?\┾)
+ ("&vH-" ?\┿)
+ ("&Udh" ?\╀)
+ ("&uDh" ?\╁)
+ ("&Vh-" ?\╂)
+ ("&UdH" ?\╇)
+ ("&uDH" ?\╈)
+ ("&VLr" ?\╉)
+ ("&VlR" ?\╊)
+ ("&VH-" ?\╋)
+ ("&HH" ?\═)
+ ("&VV" ?\║)
+ ("&dR" ?\╒)
+ ("&Dr" ?\╓)
+ ("&DR" ?\╔)
+ ("&dL" ?\╕)
+ ("&Dl" ?\╖)
+ ("&LD" ?\╗)
+ ("&uR" ?\╘)
+ ("&Ur" ?\╙)
+ ("&UR" ?\╚)
+ ("&uL" ?\╛)
+ ("&Ul" ?\╜)
+ ("&UL" ?\╝)
+ ("&vR" ?\╞)
+ ("&Vr" ?\╟)
+ ("&VR" ?\╠)
+ ("&vL" ?\╡)
+ ("&Vl" ?\╢)
+ ("&VL" ?\╣)
+ ("&dH" ?\╤)
+ ("&Dh" ?\╥)
+ ("&DH" ?\╦)
+ ("&uH" ?\╧)
+ ("&Uh" ?\╨)
+ ("&UH" ?\╩)
+ ("&vH" ?\╪)
+ ("&Vh" ?\╫)
+ ("&VH" ?\╬)
+ ("&FD" ?\╱)
+ ("&BD" ?\╲)
+ ("&TB" ?\▀)
+ ("&LB" ?\▄)
+ ("&FB" ?\█)
+ ("&lB" ?\▌)
+ ("&RB" ?\▐)
+ ("&.S" ?\░)
+ ("&:S" ?\▒)
+ ("&?S" ?\▓)
+ ("&fS" ?\■)
+ ("&OS" ?\□)
+ ("&RO" ?\▢)
+ ("&Rr" ?\▣)
+ ("&RF" ?\▤)
+ ("&RY" ?\▥)
+ ("&RH" ?\▦)
+ ("&RZ" ?\▧)
+ ("&RK" ?\▨)
+ ("&RX" ?\▩)
+ ("&sB" ?\▪)
+ ("&SR" ?\▬)
+ ("&Or" ?\▭)
+ ("&UT" ?\▲)
+ ("&uT" ?\△)
+ ("&Tr" ?\▷)
+ ("&PR" ?\►)
+ ("&Dt" ?\▼)
+ ("&dT" ?\▽)
+ ("&Tl" ?\◁)
+ ("&PL" ?\◄)
+ ("&Db" ?\◆)
+ ("&Dw" ?\◇)
+ ("&LZ" ?\◊)
+ ("&0m" ?\○)
+ ("&0o" ?\◎)
+ ("&0M" ?\●)
+ ("&0L" ?\◐)
+ ("&0R" ?\◑)
+ ("&Sn" ?\◘)
+ ("&Ic" ?\◙)
+ ("&Fd" ?\◢)
+ ("&Bd" ?\◣)
+ ("&Ci" ?\◯)
+ ("&*2" ?\★)
+ ("&*1" ?\☆)
+ ("&TEL" ?\☎)
+ ("&tel" ?\☏)
+ ("&<H" ?\☜)
+ ("&>H" ?\☞)
+ ("&0u" ?\☺)
+ ("&0U" ?\☻)
+ ("&SU" ?\☼)
+ ("&Fm" ?\♀)
+ ("&Ml" ?\♂)
+ ("&cS" ?\♠)
+ ("&cH" ?\♡)
+ ("&cD" ?\♢)
+ ("&cC" ?\♣)
+ ("&cS-" ?\♤)
+ ("&cH-" ?\♥)
+ ("&cD-" ?\♦)
+ ("&cC-" ?\♧)
+ ("&Md" ?\♩)
+ ("&M8" ?\♪)
+ ("&M2" ?\♫)
+ ("&M16" ?\♬)
+ ("&Mb" ?\♭)
+ ("&Mx" ?\♮)
+ ("&MX" ?\♯)
+ ("&OK" ?\✓)
+ ("&XX" ?\✗)
+ ("&-X" ?\✠)
+ ("&IS" ?\ )
+ ("&,_" ?\、)
+ ("&._" ?\。)
+ ("&+\"" ?\〃)
+ ("&JIS" ?\〄)
+ ("&*_" ?\々)
+ ("&;_" ?\〆)
+ ("&0_" ?\〇)
+ ("&<+" ?\《)
+ ("&>+" ?\》)
+ ("&<'" ?\「)
+ ("&>'" ?\」)
+ ("&<\"" ?\『)
+ ("&>\"" ?\』)
+ ("&(\"" ?\【)
+ ("&)\"" ?\】)
+ ("&=T" ?\〒)
+ ("&=_" ?\〓)
+ ("&('" ?\〔)
+ ("&)'" ?\〕)
+ ("&(I" ?\〖)
+ ("&)I" ?\〗)
+ ("&-?" ?\〜)
+ ("&A5" ?\ぁ)
+ ("&a5" ?\あ)
+ ("&I5" ?\ぃ)
+ ("&i5" ?\い)
+ ("&U5" ?\ぅ)
+ ("&u5" ?\う)
+ ("&E5" ?\ぇ)
+ ("&e5" ?\え)
+ ("&O5" ?\ぉ)
+ ("&o5" ?\お)
+ ("&ka" ?\か)
+ ("&ga" ?\が)
+ ("&ki" ?\き)
+ ("&gi" ?\ぎ)
+ ("&ku" ?\く)
+ ("&gu" ?\ぐ)
+ ("&ke" ?\け)
+ ("&ge" ?\げ)
+ ("&ko" ?\こ)
+ ("&go" ?\ご)
+ ("&sa" ?\さ)
+ ("&za" ?\ざ)
+ ("&si" ?\し)
+ ("&zi" ?\じ)
+ ("&su" ?\す)
+ ("&zu" ?\ず)
+ ("&se" ?\せ)
+ ("&ze" ?\ぜ)
+ ("&so" ?\そ)
+ ("&zo" ?\ぞ)
+ ("&ta" ?\た)
+ ("&da" ?\だ)
+ ("&ti" ?\ち)
+ ("&di" ?\ぢ)
+ ("&tU" ?\っ)
+ ("&tu" ?\つ)
+ ("&du" ?\づ)
+ ("&te" ?\て)
+ ("&de" ?\で)
+ ("&to" ?\と)
+ ("&do" ?\ど)
+ ("&na" ?\な)
+ ("&ni" ?\に)
+ ("&nu" ?\ぬ)
+ ("&ne" ?\ね)
+ ("&no" ?\の)
+ ("&ha" ?\は)
+ ("&ba" ?\ば)
+ ("&pa" ?\ぱ)
+ ("&hi" ?\ひ)
+ ("&bi" ?\び)
+ ("&pi" ?\ぴ)
+ ("&hu" ?\ふ)
+ ("&bu" ?\ぶ)
+ ("&pu" ?\ぷ)
+ ("&he" ?\へ)
+ ("&be" ?\べ)
+ ("&pe" ?\ぺ)
+ ("&ho" ?\ほ)
+ ("&bo" ?\ぼ)
+ ("&po" ?\ぽ)
+ ("&ma" ?\ま)
+ ("&mi" ?\み)
+ ("&mu" ?\む)
+ ("&me" ?\め)
+ ("&mo" ?\も)
+ ("&yA" ?\ゃ)
+ ("&ya" ?\や)
+ ("&yU" ?\ゅ)
+ ("&yu" ?\ゆ)
+ ("&yO" ?\ょ)
+ ("&yo" ?\よ)
+ ("&ra" ?\ら)
+ ("&ri" ?\り)
+ ("&ru" ?\る)
+ ("&re" ?\れ)
+ ("&ro" ?\ろ)
+ ("&wA" ?\ゎ)
+ ("&wa" ?\わ)
+ ("&wi" ?\ゐ)
+ ("&we" ?\ゑ)
+ ("&wo" ?\を)
+ ("&n5" ?\ん)
+ ("&vu" ?\ゔ)
+ ("&\"5" ?\゛)
+ ("&05" ?\゜)
+ ("&*5" ?\ゝ)
+ ("&+5" ?\ゞ)
+ ("&a6" ?\ァ)
+ ("&A6" ?\ア)
+ ("&i6" ?\ィ)
+ ("&I6" ?\イ)
+ ("&u6" ?\ゥ)
+ ("&U6" ?\ウ)
+ ("&e6" ?\ェ)
+ ("&E6" ?\エ)
+ ("&o6" ?\ォ)
+ ("&O6" ?\オ)
+ ("&Ka" ?\カ)
+ ("&Ga" ?\ガ)
+ ("&Ki" ?\キ)
+ ("&Gi" ?\ギ)
+ ("&Ku" ?\ク)
+ ("&Gu" ?\グ)
+ ("&Ke" ?\ケ)
+ ("&Ge" ?\ゲ)
+ ("&Ko" ?\コ)
+ ("&Go" ?\ゴ)
+ ("&Sa" ?\サ)
+ ("&Za" ?\ザ)
+ ("&Si" ?\シ)
+ ("&Zi" ?\ジ)
+ ("&Su" ?\ス)
+ ("&Zu" ?\ズ)
+ ("&Se" ?\セ)
+ ("&Ze" ?\ゼ)
+ ("&So" ?\ソ)
+ ("&Zo" ?\ゾ)
+ ("&Ta" ?\タ)
+ ("&Da" ?\ダ)
+ ("&Ti" ?\チ)
+ ("&Di" ?\ヂ)
+ ("&TU" ?\ッ)
+ ("&Tu" ?\ツ)
+ ("&Du" ?\ヅ)
+ ("&Te" ?\テ)
+ ("&De" ?\デ)
+ ("&To" ?\ト)
+ ("&Do" ?\ド)
+ ("&Na" ?\ナ)
+ ("&Ni" ?\ニ)
+ ("&Nu" ?\ヌ)
+ ("&Ne" ?\ネ)
+ ("&No" ?\ノ)
+ ("&Ha" ?\ハ)
+ ("&Ba" ?\バ)
+ ("&Pa" ?\パ)
+ ("&Hi" ?\ヒ)
+ ("&Bi" ?\ビ)
+ ("&Pi" ?\ピ)
+ ("&Hu" ?\フ)
+ ("&Bu" ?\ブ)
+ ("&Pu" ?\プ)
+ ("&He" ?\ヘ)
+ ("&Be" ?\ベ)
+ ("&Pe" ?\ペ)
+ ("&Ho" ?\ホ)
+ ("&Bo" ?\ボ)
+ ("&Po" ?\ポ)
+ ("&Ma" ?\マ)
+ ("&Mi" ?\ミ)
+ ("&Mu" ?\ム)
+ ("&Me" ?\メ)
+ ("&Mo" ?\モ)
+ ("&YA" ?\ャ)
+ ("&Ya" ?\ヤ)
+ ("&YU" ?\ュ)
+ ("&Yu" ?\ユ)
+ ("&YO" ?\ョ)
+ ("&Yo" ?\ヨ)
+ ("&Ra" ?\ラ)
+ ("&Ri" ?\リ)
+ ("&Ru" ?\ル)
+ ("&Re" ?\レ)
+ ("&Ro" ?\ロ)
+ ("&WA" ?\ヮ)
+ ("&Wa" ?\ワ)
+ ("&Wi" ?\ヰ)
+ ("&We" ?\ヱ)
+ ("&Wo" ?\ヲ)
+ ("&N6" ?\ン)
+ ("&Vu" ?\ヴ)
+ ("&KA" ?\ヵ)
+ ("&KE" ?\ヶ)
+ ("&Va" ?\ヷ)
+ ("&Vi" ?\ヸ)
+ ("&Ve" ?\ヹ)
+ ("&Vo" ?\ヺ)
+ ("&.6" ?\・)
+ ("&-6" ?\ー)
+ ("&*6" ?\ヽ)
+ ("&+6" ?\ヾ)
+ ("&b4" ?\ㄅ)
+ ("&p4" ?\ㄆ)
+ ("&m4" ?\ㄇ)
+ ("&f4" ?\ㄈ)
+ ("&d4" ?\ㄉ)
+ ("&t4" ?\ㄊ)
+ ("&n4" ?\ㄋ)
+ ("&l4" ?\ㄌ)
+ ("&g4" ?\ㄍ)
+ ("&k4" ?\ㄎ)
+ ("&h4" ?\ㄏ)
+ ("&j4" ?\ㄐ)
+ ("&q4" ?\ㄑ)
+ ("&x4" ?\ㄒ)
+ ("&zh" ?\ㄓ)
+ ("&ch" ?\ㄔ)
+ ("&sh" ?\ㄕ)
+ ("&r4" ?\ㄖ)
+ ("&z4" ?\ㄗ)
+ ("&c4" ?\ㄘ)
+ ("&s4" ?\ㄙ)
+ ("&a4" ?\ㄚ)
+ ("&o4" ?\ㄛ)
+ ("&e4" ?\ㄜ)
+ ("&eh4" ?\ㄝ)
+ ("&ai" ?\ㄞ)
+ ("&ei" ?\ㄟ)
+ ("&au" ?\ㄠ)
+ ("&ou" ?\ㄡ)
+ ("&an" ?\ㄢ)
+ ("&en" ?\ㄣ)
+ ("&aN" ?\ㄤ)
+ ("&eN" ?\ㄥ)
+ ("&er" ?\ㄦ)
+ ("&i4" ?\ㄧ)
+ ("&u4" ?\ㄨ)
+ ("&iu" ?\ㄩ)
+ ("&v4" ?\ㄪ)
+ ("&nG" ?\ㄫ)
+ ("&gn" ?\ㄬ)
+ ("&1c" ?\㈠)
+ ("&2c" ?\㈡)
+ ("&3c" ?\㈢)
+ ("&4c" ?\㈣)
+ ("&5c" ?\㈤)
+ ("&6c" ?\㈥)
+ ("&7c" ?\㈦)
+ ("&8c" ?\㈧)
+ ("&9c" ?\㈨)
+ ("&10c" ?\㈩)
+ ("&KSC" ?\㉿)
+ ("&am" ?\㏂)
+ ("&pm" ?\㏘)
+ ("&\"3" ?\)
+ ("&\"1" ?\)
+ ("&\"!" ?\)
+ ("&\"'" ?\)
+ ("&\">" ?\)
+ ("&\"?" ?\)
+ ("&\"-" ?\)
+ ("&\"(" ?\)
+ ("&\"." ?\)
+ ("&\":" ?\)
+ ("&\"0" ?\)
+ ("&\"," ?\)
+ ("&\"_" ?\)
+ ("&\"\"" ?\)
+ ("&\";" ?\)
+ ("&\"<" ?\)
+ ("&\"=" ?\)
+ ("&\"/" ?\)
+ ("&\"p" ?\)
+ ("&\"d" ?\)
+ ("&\"i" ?\)
+ ("&+_" ?\)
+ ("&a+:" ?\)
+ ("&Tel" ?\)
+ ("&UA" ?\)
+ ("&UB" ?\)
+ ("&t3" ?\)
+ ("&m3" ?\)
+ ("&k3" ?\)
+ ("&p3" ?\)
+ ("&Mc" ?\)
+ ("&Fl" ?\)
+ ("&Ss" ?\)
+ ("&Ch" ?\)
+ ("&CH" ?\)
+ ("&__" ?\)
+ ("&/c" ?\)
+ ("&ff" ?\ff)
+ ("&fi" ?\fi)
+ ("&fl" ?\fl)
+ ("&ffi" ?\ffi)
+ ("&ffl" ?\ffl)
+ ("&St" ?\ſt)
+ ("&st" ?\st)
+ ("&3+;" ?\ﹽ)
+ ("&aM." ?\ﺂ)
+ ("&aH." ?\ﺄ)
+ ("&ah." ?\ﺈ)
+ ("&a+-" ?\ﺍ)
+ ("&a+." ?\ﺎ)
+ ("&b+-" ?\ﺏ)
+ ("&b+." ?\ﺐ)
+ ("&b+," ?\ﺑ)
+ ("&b+;" ?\ﺒ)
+ ("&tm-" ?\ﺓ)
+ ("&tm." ?\ﺔ)
+ ("&t+-" ?\ﺕ)
+ ("&t+." ?\ﺖ)
+ ("&t+," ?\ﺗ)
+ ("&t+;" ?\ﺘ)
+ ("&tk-" ?\ﺙ)
+ ("&tk." ?\ﺚ)
+ ("&tk," ?\ﺛ)
+ ("&tk;" ?\ﺜ)
+ ("&g+-" ?\ﺝ)
+ ("&g+." ?\ﺞ)
+ ("&g+," ?\ﺟ)
+ ("&g+;" ?\ﺠ)
+ ("&hk-" ?\ﺡ)
+ ("&hk." ?\ﺢ)
+ ("&hk," ?\ﺣ)
+ ("&hk;" ?\ﺤ)
+ ("&x+-" ?\ﺥ)
+ ("&x+." ?\ﺦ)
+ ("&x+," ?\ﺧ)
+ ("&x+;" ?\ﺨ)
+ ("&d+-" ?\ﺩ)
+ ("&d+." ?\ﺪ)
+ ("&dk-" ?\ﺫ)
+ ("&dk." ?\ﺬ)
+ ("&r+-" ?\ﺭ)
+ ("&r+." ?\ﺮ)
+ ("&z+-" ?\ﺯ)
+ ("&z+." ?\ﺰ)
+ ("&s+-" ?\ﺱ)
+ ("&s+." ?\ﺲ)
+ ("&s+," ?\ﺳ)
+ ("&s+;" ?\ﺴ)
+ ("&sn-" ?\ﺵ)
+ ("&sn." ?\ﺶ)
+ ("&sn," ?\ﺷ)
+ ("&sn;" ?\ﺸ)
+ ("&c+-" ?\ﺹ)
+ ("&c+." ?\ﺺ)
+ ("&c+," ?\ﺻ)
+ ("&c+;" ?\ﺼ)
+ ("&dd-" ?\ﺽ)
+ ("&dd." ?\ﺾ)
+ ("&dd," ?\ﺿ)
+ ("&dd;" ?\ﻀ)
+ ("&tj-" ?\ﻁ)
+ ("&tj." ?\ﻂ)
+ ("&tj," ?\ﻃ)
+ ("&tj;" ?\ﻄ)
+ ("&zH-" ?\ﻅ)
+ ("&zH." ?\ﻆ)
+ ("&zH," ?\ﻇ)
+ ("&zH;" ?\ﻈ)
+ ("&e+-" ?\ﻉ)
+ ("&e+." ?\ﻊ)
+ ("&e+," ?\ﻋ)
+ ("&e+;" ?\ﻌ)
+ ("&i+-" ?\ﻍ)
+ ("&i+." ?\ﻎ)
+ ("&i+," ?\ﻏ)
+ ("&i+;" ?\ﻐ)
+ ("&f+-" ?\ﻑ)
+ ("&f+." ?\ﻒ)
+ ("&f+," ?\ﻓ)
+ ("&f+;" ?\ﻔ)
+ ("&q+-" ?\ﻕ)
+ ("&q+." ?\ﻖ)
+ ("&q+," ?\ﻗ)
+ ("&q+;" ?\ﻘ)
+ ("&k+-" ?\ﻙ)
+ ("&k+." ?\ﻚ)
+ ("&k+," ?\ﻛ)
+ ("&k+;" ?\ﻜ)
+ ("&l+-" ?\ﻝ)
+ ("&l+." ?\ﻞ)
+ ("&l+," ?\ﻟ)
+ ("&l+;" ?\ﻠ)
+ ("&m+-" ?\ﻡ)
+ ("&m+." ?\ﻢ)
+ ("&m+," ?\ﻣ)
+ ("&m+;" ?\ﻤ)
+ ("&n+-" ?\ﻥ)
+ ("&n+." ?\ﻦ)
+ ("&n+," ?\ﻧ)
+ ("&n+;" ?\ﻨ)
+ ("&h+-" ?\ﻩ)
+ ("&h+." ?\ﻪ)
+ ("&h+," ?\ﻫ)
+ ("&h+;" ?\ﻬ)
+ ("&w+-" ?\ﻭ)
+ ("&w+." ?\ﻮ)
+ ("&j+-" ?\ﻯ)
+ ("&j+." ?\ﻰ)
+ ("&y+-" ?\ﻱ)
+ ("&y+." ?\ﻲ)
+ ("&y+," ?\ﻳ)
+ ("&y+;" ?\ﻴ)
+ ("&lM-" ?\ﻵ)
+ ("&lM." ?\ﻶ)
+ ("&lH-" ?\ﻷ)
+ ("&lH." ?\ﻸ)
+ ("&lh-" ?\ﻹ)
+ ("&lh." ?\ﻺ)
+ ("&la-" ?\ﻻ)
+ ("&la." ?\ﻼ)
+)
+
+(provide 'rfc1345)
+
+;;; rfc1345.el ends here
diff --git a/lisp/leim/quail/sgml-input.el b/lisp/leim/quail/sgml-input.el
new file mode 100644
index 00000000000..2e447b1fc4d
--- /dev/null
+++ b/lisp/leim/quail/sgml-input.el
@@ -0,0 +1,1061 @@
+;;; sgml-input.el --- Quail method for Unicode entered as SGML entities -*- coding: utf-8 -*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The table was derived from the Unicode consortium file
+;; MAPPINGS/VENDORS/MISC/SGML.TXT.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "sgml" "UTF-8" "&" t
+ "Unicode characters input method using SGML entities.
+Entities are covered from the public sets ISOamsa, ISOamsb, ISOamsc,
+ISOamsn, ISOamso, ISOamsr, ISObox, ISOcyr1, ISOcyr2, ISOdia, ISOgrk1,
+ISOgrk2, ISOgrk3, ISOgrk4, ISOlat1, ISOlat2, ISOnum, ISOpub, ISOtech,
+HTMLspecial and HTMLsymbol.
+
+E.g.: &aacute; -> á"
+ '(("\t" . quail-completion))
+ t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("&Aacgr;" ?\Ά) ;; GREEK CAPITAL LETTER ALPHA WITH TONOS
+ ("&aacgr;" ?\ά) ;; GREEK SMALL LETTER ALPHA WITH TONOS
+ ("&Aacute;" ?\Á) ;; LATIN CAPITAL LETTER A WITH ACUTE
+ ("&aacute;" ?\á) ;; LATIN SMALL LETTER A WITH ACUTE
+ ("&Abreve;" ?\Ă) ;; LATIN CAPITAL LETTER A WITH BREVE
+ ("&abreve;" ?\ă) ;; LATIN SMALL LETTER A WITH BREVE
+ ("&Acirc;" ?\Â) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("&acirc;" ?\â) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("&acute;" ?\´) ;; ACUTE ACCENT
+ ("&Acy;" ?\А) ;; CYRILLIC CAPITAL LETTER A
+ ("&acy;" ?\а) ;; CYRILLIC SMALL LETTER A
+ ("&AElig;" ?\Æ) ;; LATIN CAPITAL LETTER AE
+ ("&aelig;" ?\æ) ;; LATIN SMALL LETTER AE
+ ("&Agr;" ?\Α) ;; GREEK CAPITAL LETTER ALPHA
+ ("&agr;" ?\α) ;; GREEK SMALL LETTER ALPHA
+ ("&Agrave;" ?\À) ;; LATIN CAPITAL LETTER A WITH GRAVE
+ ("&agrave;" ?\à) ;; LATIN SMALL LETTER A WITH GRAVE
+ ("&alefsym;" ?\ℵ) ;; ALEF SYMBOL
+ ("&aleph;" ?\ℵ) ;; ALEF SYMBOL
+ ("&Alpha;" ?\Α) ;; GREEK CAPITAL LETTER ALPHA
+ ("&alpha;" ?\α) ;; GREEK SMALL LETTER ALPHA
+ ("&Amacr;" ?\Ā) ;; LATIN CAPITAL LETTER A WITH MACRON
+ ("&amacr;" ?\ā) ;; LATIN SMALL LETTER A WITH MACRON
+ ("&amalg;" ?\∐) ;; N-ARY COPRODUCT
+ ("&amp;" ?\&) ;; AMPERSAND
+ ("&and;" ?\∧) ;; LOGICAL AND
+ ("&ang;" ?\∠) ;; ANGLE
+ ("&ang90;" ?\∟) ;; RIGHT ANGLE
+ ("&angmsd;" ?\∡) ;; MEASURED ANGLE
+ ("&angsph;" ?\∢) ;; SPHERICAL ANGLE
+ ("&angst;" ?\Å) ;; ANGSTROM SIGN
+ ("&Aogon;" ?\Ą) ;; LATIN CAPITAL LETTER A WITH OGONEK
+ ("&aogon;" ?\ą) ;; LATIN SMALL LETTER A WITH OGONEK
+ ("&ap;" ?\≈) ;; ALMOST EQUAL TO
+ ("&ape;" ?\≊) ;; ALMOST EQUAL OR EQUAL TO
+ ("&apos;" ?\ʼ) ;; MODIFIER LETTER APOSTROPHE
+ ("&Aring;" ?\Å) ;; LATIN CAPITAL LETTER A WITH RING ABOVE
+ ("&aring;" ?\å) ;; LATIN SMALL LETTER A WITH RING ABOVE
+ ("&ast;" ?\*) ;; ASTERISK
+ ("&asymp;" ?\≈) ;; ALMOST EQUAL TO
+ ("&Atilde;" ?\Ã) ;; LATIN CAPITAL LETTER A WITH TILDE
+ ("&atilde;" ?\ã) ;; LATIN SMALL LETTER A WITH TILDE
+ ("&Auml;" ?\Ä) ;; LATIN CAPITAL LETTER A WITH DIAERESIS
+ ("&auml;" ?\ä) ;; LATIN SMALL LETTER A WITH DIAERESIS
+ ("&b.alpha;" ?\α) ;; GREEK SMALL LETTER ALPHA
+ ("&barwed;" ?\⊼) ;; NAND
+ ("&Barwed;" ?\⌆) ;; PERSPECTIVE
+ ("&b.beta;" ?\β) ;; GREEK SMALL LETTER BETA
+ ("&bchi;" ?\χ) ;; GREEK SMALL LETTER CHI
+ ("&bcong;" ?\≌) ;; ALL EQUAL TO
+ ("&Bcy;" ?\Б) ;; CYRILLIC CAPITAL LETTER BE
+ ("&bcy;" ?\б) ;; CYRILLIC SMALL LETTER BE
+ ("&b.Delta;" ?\Δ) ;; GREEK CAPITAL LETTER DELTA
+ ("&b.delta;" ?\γ) ;; GREEK SMALL LETTER GAMMA
+ ("&bdquo;" ?\„) ;; DOUBLE LOW-9 QUOTATION MARK
+ ("&becaus;" ?\∵) ;; BECAUSE
+ ("&bepsi;" ?\∍) ;; SMALL CONTAINS AS MEMBER
+ ("&b.epsi;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&b.epsis;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&b.epsiv;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&bernou;" ?\ℬ) ;; SCRIPT CAPITAL B
+ ("&Beta;" ?\Β) ;; GREEK CAPITAL LETTER BETA
+ ("&beta;" ?\β) ;; GREEK SMALL LETTER BETA
+ ("&b.eta;" ?\η) ;; GREEK SMALL LETTER ETA
+ ("&beth;" ?\ℶ) ;; BET SYMBOL
+ ("&b.Gamma;" ?\Γ) ;; GREEK CAPITAL LETTER GAMMA
+ ("&b.gamma;" ?\γ) ;; GREEK SMALL LETTER GAMMA
+ ("&b.gammagrk4;" ?\Ϝ) ;; GREEK LETTER DIGAMMA
+ ("&Bgr;" ?\Β) ;; GREEK CAPITAL LETTER BETA
+ ("&bgr;" ?\β) ;; GREEK SMALL LETTER BETA
+ ("&b.iota;" ?\ι) ;; GREEK SMALL LETTER IOTA
+ ("&b.kappa;" ?\κ) ;; GREEK SMALL LETTER KAPPA
+ ("&b.kappagrk4;" ?\ϰ) ;; GREEK KAPPA SYMBOL
+ ("&b.Lambdgrk4;" ?\Λ) ;; GREEK CAPITAL LETTER LAMDA
+ ("&b.lambdgrk4;" ?\λ) ;; GREEK SMALL LETTER LAMDA
+ ("&blank;" ?\␣) ;; OPEN BOX
+ ("&blk12;" ?\▒) ;; MEDIUM SHADE
+ ("&blk14;" ?\░) ;; LIGHT SHADE
+ ("&blk34;" ?\▓) ;; DARK SHADE
+ ("&block;" ?\█) ;; FULL BLOCK
+ ("&b.mu;" ?\μ) ;; GREEK SMALL LETTER MU
+ ("&b.nu;" ?\ν) ;; GREEK SMALL LETTER NU
+ ("&b.Omega;" ?\Ω) ;; GREEK CAPITAL LETTER OMEGA
+ ("&b.omega;" ?\ώ) ;; GREEK SMALL LETTER OMEGA WITH TONOS
+ ("&bottom;" ?\⊥) ;; UP TACK
+ ("&bowtie;" ?\⋈) ;; BOWTIE
+ ("&boxdl;" ?\┐) ;; BOX DRAWINGS LIGHT DOWN AND LEFT
+ ("&boxdL;" ?\╕) ;; BOX DRAWINGS DOWN SINGLE AND LEFT DOUBLE
+ ("&boxDl;" ?\╖) ;; BOX DRAWINGS DOWN DOUBLE AND LEFT SINGLE
+ ("&boxDL;" ?\╗) ;; BOX DRAWINGS DOUBLE DOWN AND LEFT
+ ("&boxdr;" ?\┌) ;; BOX DRAWINGS LIGHT DOWN AND RIGHT
+ ("&boxdR;" ?\╒) ;; BOX DRAWINGS DOWN SINGLE AND RIGHT DOUBLE
+ ("&boxDr;" ?\╓) ;; BOX DRAWINGS DOWN DOUBLE AND RIGHT SINGLE
+ ("&boxDR;" ?\╔) ;; BOX DRAWINGS DOUBLE DOWN AND RIGHT
+ ("&boxh;" ?\─) ;; BOX DRAWINGS LIGHT HORIZONTAL
+ ("&boxH;" ?\═) ;; BOX DRAWINGS DOUBLE HORIZONTAL
+ ("&boxhd;" ?\┬) ;; BOX DRAWINGS LIGHT DOWN AND HORIZONTAL
+ ("&boxHd;" ?\╤) ;; BOX DRAWINGS DOWN SINGLE AND HORIZONTAL DOUBLE
+ ("&boxhD;" ?\╥) ;; BOX DRAWINGS DOWN DOUBLE AND HORIZONTAL SINGLE
+ ("&boxHD;" ?\╦) ;; BOX DRAWINGS DOUBLE DOWN AND HORIZONTAL
+ ("&boxhu;" ?\┴) ;; BOX DRAWINGS LIGHT UP AND HORIZONTAL
+ ("&boxHu;" ?\╧) ;; BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE
+ ("&boxhU;" ?\╨) ;; BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE
+ ("&boxHU;" ?\╩) ;; BOX DRAWINGS DOUBLE UP AND HORIZONTAL
+ ("&boxul;" ?\┘) ;; BOX DRAWINGS LIGHT UP AND LEFT
+ ("&boxuL;" ?\╛) ;; BOX DRAWINGS UP SINGLE AND LEFT DOUBLE
+ ("&boxUl;" ?\╜) ;; BOX DRAWINGS UP DOUBLE AND LEFT SINGLE
+ ("&boxUL;" ?\╝) ;; BOX DRAWINGS DOUBLE UP AND LEFT
+ ("&boxur;" ?\└) ;; BOX DRAWINGS LIGHT UP AND RIGHT
+ ("&boxuR;" ?\╘) ;; BOX DRAWINGS UP SINGLE AND RIGHT DOUBLE
+ ("&boxUr;" ?\╙) ;; BOX DRAWINGS UP DOUBLE AND RIGHT SINGLE
+ ("&boxUR;" ?\╚) ;; BOX DRAWINGS DOUBLE UP AND RIGHT
+ ("&boxv;" ?\│) ;; BOX DRAWINGS LIGHT VERTICAL
+ ("&boxV;" ?\║) ;; BOX DRAWINGS DOUBLE VERTICAL
+ ("&boxvh;" ?\┼) ;; BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL
+ ("&boxvH;" ?\╪) ;; BOX DRAWINGS VERTICAL SINGLE AND HORIZONTAL DOUBLE
+ ("&boxVh;" ?\╫) ;; BOX DRAWINGS VERTICAL DOUBLE AND HORIZONTAL SINGLE
+ ("&boxVH;" ?\╬) ;; BOX DRAWINGS DOUBLE VERTICAL AND HORIZONTAL
+ ("&boxvl;" ?\┤) ;; BOX DRAWINGS LIGHT VERTICAL AND LEFT
+ ("&boxvL;" ?\╡) ;; BOX DRAWINGS VERTICAL SINGLE AND LEFT DOUBLE
+ ("&boxVl;" ?\╢) ;; BOX DRAWINGS VERTICAL DOUBLE AND LEFT SINGLE
+ ("&boxVL;" ?\╣) ;; BOX DRAWINGS DOUBLE VERTICAL AND LEFT
+ ("&boxvr;" ?\├) ;; BOX DRAWINGS LIGHT VERTICAL AND RIGHT
+ ("&boxvR;" ?\╞) ;; BOX DRAWINGS VERTICAL SINGLE AND RIGHT DOUBLE
+ ("&boxVr;" ?\╟) ;; BOX DRAWINGS VERTICAL DOUBLE AND RIGHT SINGLE
+ ("&boxVR;" ?\╠) ;; BOX DRAWINGS DOUBLE VERTICAL AND RIGHT
+ ("&b.Phi;" ?\Φ) ;; GREEK CAPITAL LETTER PHI
+ ("&b.phis;" ?\φ) ;; GREEK SMALL LETTER PHI
+ ("&b.phiv;" ?\ϕ) ;; GREEK PHI SYMBOL
+ ("&b.Pi;" ?\Π) ;; GREEK CAPITAL LETTER PI
+ ("&b.pi;" ?\π) ;; GREEK SMALL LETTER PI
+ ("&b.piv;" ?\ϖ) ;; GREEK PI SYMBOL
+ ("&bprime;" ?\‵) ;; REVERSED PRIME
+ ("&b.Psi;" ?\Ψ) ;; GREEK CAPITAL LETTER PSI
+ ("&b.psi;" ?\ψ) ;; GREEK SMALL LETTER PSI
+ ("&breve;" ?\˘) ;; BREVE
+ ("&b.rho;" ?\ρ) ;; GREEK SMALL LETTER RHO
+ ("&b.rhov;" ?\ϱ) ;; GREEK RHO SYMBOL
+ ("&brvbar;" ?\¦) ;; BROKEN BAR
+ ("&b.Sigma;" ?\Σ) ;; GREEK CAPITAL LETTER SIGMA
+ ("&b.sigma;" ?\σ) ;; GREEK SMALL LETTER SIGMA
+ ("&b.sigmagrk4;" ?\ς) ;; GREEK SMALL LETTER FINAL SIGMA
+ ("&bsim;" ?\∽) ;; REVERSED TILDE
+ ("&bsime;" ?\⋍) ;; REVERSED TILDE EQUALS
+ ("&bsol;" ?\\) ;; REVERSE SOLIDUS
+ ("&b.tau;" ?\τ) ;; GREEK SMALL LETTER TAU
+ ("&b.Theta;" ?\Θ) ;; GREEK CAPITAL LETTER THETA
+ ("&b.thetagrk4;" ?\θ) ;; GREEK SMALL LETTER THETA
+ ("&b.thetagrk4;" ?\ϑ) ;; GREEK THETA SYMBOL
+ ("&bull;" ?\•) ;; BULLET
+ ("&bump;" ?\≎) ;; GEOMETRICALLY EQUIVALENT TO
+ ("&bumpe;" ?\≏) ;; DIFFERENCE BETWEEN
+ ("&b.Upsi;" ?\Υ) ;; GREEK CAPITAL LETTER UPSILON
+ ("&b.upsi;" ?\υ) ;; GREEK SMALL LETTER UPSILON
+ ("&b.Xi;" ?\Ξ) ;; GREEK CAPITAL LETTER XI
+ ("&b.xi;" ?\ξ) ;; GREEK SMALL LETTER XI
+ ("&b.zeta;" ?\ζ) ;; GREEK SMALL LETTER ZETA
+ ("&Cacute;" ?\Ć) ;; LATIN CAPITAL LETTER C WITH ACUTE
+ ("&cacute;" ?\ć) ;; LATIN SMALL LETTER C WITH ACUTE
+ ("&Cap;" ?\⋒) ;; DOUBLE INTERSECTION
+ ("&cap;" ?\∩) ;; INTERSECTION
+ ("&caret;" ?\⁁) ;; CARET INSERTION POINT
+ ("&caron;" ?\ˇ) ;; CARON
+ ("&Ccaron;" ?\Č) ;; LATIN CAPITAL LETTER C WITH CARON
+ ("&ccaron;" ?\č) ;; LATIN SMALL LETTER C WITH CARON
+ ("&Ccedil;" ?\Ç) ;; LATIN CAPITAL LETTER C WITH CEDILLA
+ ("&ccedil;" ?\ç) ;; LATIN SMALL LETTER C WITH CEDILLA
+ ("&Ccirc;" ?\Ĉ) ;; LATIN CAPITAL LETTER C WITH CIRCUMFLEX
+ ("&ccirc;" ?\ĉ) ;; LATIN SMALL LETTER C WITH CIRCUMFLEX
+ ("&Cdot;" ?\Ċ) ;; LATIN CAPITAL LETTER C WITH DOT ABOVE
+ ("&cdot;" ?\ċ) ;; LATIN SMALL LETTER C WITH DOT ABOVE
+ ("&cedil;" ?\¸) ;; CEDILLA
+ ("&cent;" ?\¢) ;; CENT SIGN
+ ("&CHcy;" ?\Ч) ;; CYRILLIC CAPITAL LETTER CHE
+ ("&chcy;" ?\ч) ;; CYRILLIC SMALL LETTER CHE
+ ("&check;" ?\✓) ;; CHECK MARK
+ ("&Chi;" ?\Χ) ;; GREEK CAPITAL LETTER CHI
+ ("&chi;" ?\χ) ;; GREEK SMALL LETTER CHI
+ ("&cir;" ?\○) ;; WHITE CIRCLE
+ ("&circ;" ?\ˆ) ;; MODIFIER LETTER CIRCUMFLEX ACCENT
+ ("&cire;" ?\≗) ;; RING EQUAL TO
+ ("&clubs;" ?\♣) ;; BLACK CLUB SUIT
+ ("&colon;" ?\:) ;; COLON
+ ("&colone;" ?\≔) ;; COLON EQUALS
+ ("&comma;" ?\,) ;; COMMA
+ ("&commat;" ?\@) ;; COMMERCIAL AT
+ ("&comp;" ?\∁) ;; COMPLEMENT
+ ("&compfn;" ?\∘) ;; RING OPERATOR
+ ("&cong;" ?\≅) ;; APPROXIMATELY EQUAL TO
+ ("&conint;" ?\∮) ;; CONTOUR INTEGRAL
+ ("&coprod;" ?\∐) ;; N-ARY COPRODUCT
+ ("&copy;" ?\©) ;; COPYRIGHT SIGN
+ ("&copysr;" ?\℗) ;; SOUND RECORDING COPYRIGHT
+ ("&crarr;" ?\↵) ;; DOWNWARDS ARROW WITH CORNER LEFTWARDS
+ ("&cross;" ?\✗) ;; BALLOT X
+ ("&cuepr;" ?\⋞) ;; EQUAL TO OR PRECEDES
+ ("&cuesc;" ?\⋟) ;; EQUAL TO OR SUCCEEDS
+ ("&cularr;" ?\↶) ;; ANTICLOCKWISE TOP SEMICIRCLE ARROW
+ ("&Cup;" ?\⋓) ;; DOUBLE UNION
+ ("&cup;" ?\∪) ;; UNION
+ ("&cupre;" ?\≼) ;; PRECEDES OR EQUAL TO
+ ("&curarr;" ?\↷) ;; CLOCKWISE TOP SEMICIRCLE ARROW
+ ("&curren;" ?\¤) ;; CURRENCY SIGN
+ ("&cuvee;" ?\⋎) ;; CURLY LOGICAL OR
+ ("&cuwed;" ?\⋏) ;; CURLY LOGICAL AND
+ ("&dagger;" ?\†) ;; DAGGER
+ ("&Dagger;" ?\‡) ;; DOUBLE DAGGER
+ ("&daleth;" ?\ℸ) ;; DALET SYMBOL
+ ("&dArr;" ?\⇓) ;; DOWNWARDS DOUBLE ARROW
+ ("&darr;" ?\↓) ;; DOWNWARDS ARROW
+ ("&darr2;" ?\⇊) ;; DOWNWARDS PAIRED ARROWS
+ ("&dash;" ?\‐) ;; HYPHEN
+ ("&dashv;" ?\⊣) ;; LEFT TACK
+ ("&dblac;" ?\˝) ;; DOUBLE ACUTE ACCENT
+ ("&Dcaron;" ?\Ď) ;; LATIN CAPITAL LETTER D WITH CARON
+ ("&dcaron;" ?\ď) ;; LATIN SMALL LETTER D WITH CARON
+ ("&Dcy;" ?\Д) ;; CYRILLIC CAPITAL LETTER DE
+ ("&dcy;" ?\д) ;; CYRILLIC SMALL LETTER DE
+ ("&deg;" ?\°) ;; DEGREE SIGN
+ ("&Delta;" ?\Δ) ;; GREEK CAPITAL LETTER DELTA
+ ("&delta;" ?\δ) ;; GREEK SMALL LETTER DELTA
+ ("&Dgr;" ?\Δ) ;; GREEK CAPITAL LETTER DELTA
+ ("&dgr;" ?\δ) ;; GREEK SMALL LETTER DELTA
+ ("&dharl;" ?\⇃) ;; DOWNWARDS HARPOON WITH BARB LEFTWARDS
+ ("&dharr;" ?\⇂) ;; DOWNWARDS HARPOON WITH BARB RIGHTWARDS
+ ("&diam;" ?\⋄) ;; DIAMOND OPERATOR
+ ("&diams;" ?\♦) ;; BLACK DIAMOND SUIT
+ ("&die;" ?\¨) ;; DIAERESIS
+ ("&divide;" ?\÷) ;; DIVISION SIGN
+ ("&divonx;" ?\⋇) ;; DIVISION TIMES
+ ("&DJcy;" ?\Ђ) ;; CYRILLIC CAPITAL LETTER DJE
+ ("&djcy;" ?\ђ) ;; CYRILLIC SMALL LETTER DJE
+ ("&dlarr;" ?\↙) ;; SOUTH WEST ARROW
+ ("&dlcorn;" ?\⌞) ;; BOTTOM LEFT CORNER
+ ("&dlcrop;" ?\⌍) ;; BOTTOM LEFT CROP
+ ("&dollar;" ?\$) ;; DOLLAR SIGN
+ ("&dot;" ?\˙) ;; DOT ABOVE
+ ("&Dot;" ?\¨) ;; DIAERESIS
+ ("&DotDot;" ?\⃜) ;; COMBINING FOUR DOTS ABOVE
+ ("&drarr;" ?\↘) ;; SOUTH EAST ARROW
+ ("&drcorn;" ?\⌟) ;; BOTTOM RIGHT CORNER
+ ("&drcrop;" ?\⌌) ;; BOTTOM RIGHT CROP
+ ("&DScy;" ?\Ѕ) ;; CYRILLIC CAPITAL LETTER DZE
+ ("&dscy;" ?\ѕ) ;; CYRILLIC SMALL LETTER DZE
+ ("&Dstrok;" ?\Đ) ;; LATIN CAPITAL LETTER D WITH STROKE
+ ("&dstrok;" ?\đ) ;; LATIN SMALL LETTER D WITH STROKE
+ ("&dtri;" ?\▿) ;; WHITE DOWN-POINTING SMALL TRIANGLE
+ ("&dtrif;" ?\▾) ;; BLACK DOWN-POINTING SMALL TRIANGLE
+ ("&DZcy;" ?\Џ) ;; CYRILLIC CAPITAL LETTER DZHE
+ ("&dzcy;" ?\џ) ;; CYRILLIC SMALL LETTER DZHE
+ ("&Eacgr;" ?\Έ) ;; GREEK CAPITAL LETTER EPSILON WITH TONOS
+ ("&eacgr;" ?\έ) ;; GREEK SMALL LETTER EPSILON WITH TONOS
+ ("&Eacute;" ?\É) ;; LATIN CAPITAL LETTER E WITH ACUTE
+ ("&eacute;" ?\é) ;; LATIN SMALL LETTER E WITH ACUTE
+ ("&Ecaron;" ?\Ě) ;; LATIN CAPITAL LETTER E WITH CARON
+ ("&ecaron;" ?\ě) ;; LATIN SMALL LETTER E WITH CARON
+ ("&ecir;" ?\≖) ;; RING IN EQUAL TO
+ ("&Ecirc;" ?\Ê) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("&ecirc;" ?\ê) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("&ecolon;" ?\≕) ;; EQUALS COLON
+ ("&Ecy;" ?\Э) ;; CYRILLIC CAPITAL LETTER E
+ ("&ecy;" ?\э) ;; CYRILLIC SMALL LETTER E
+ ("&eDot;" ?\≑) ;; GEOMETRICALLY EQUAL TO
+ ("&Edot;" ?\Ė) ;; LATIN CAPITAL LETTER E WITH DOT ABOVE
+ ("&edot;" ?\ė) ;; LATIN SMALL LETTER E WITH DOT ABOVE
+ ("&EEacgr;" ?\Ή) ;; GREEK CAPITAL LETTER ETA WITH TONOS
+ ("&eeacgr;" ?\ή) ;; GREEK SMALL LETTER ETA WITH TONOS
+ ("&EEgr;" ?\Η) ;; GREEK CAPITAL LETTER ETA
+ ("&eegr;" ?\η) ;; GREEK SMALL LETTER ETA
+ ("&efDot;" ?\≒) ;; APPROXIMATELY EQUAL TO OR THE IMAGE OF
+ ("&Egr;" ?\Ε) ;; GREEK CAPITAL LETTER EPSILON
+ ("&egr;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&Egrave;" ?\È) ;; LATIN CAPITAL LETTER E WITH GRAVE
+ ("&egrave;" ?\è) ;; LATIN SMALL LETTER E WITH GRAVE
+ ("&egs;" ?\⋝) ;; EQUAL TO OR GREATER-THAN
+ ("&ell;" ?\ℓ) ;; SCRIPT SMALL L
+ ("&els;" ?\⋜) ;; EQUAL TO OR LESS-THAN
+ ("&Emacr;" ?\Ē) ;; LATIN CAPITAL LETTER E WITH MACRON
+ ("&emacr;" ?\ē) ;; LATIN SMALL LETTER E WITH MACRON
+ ("&empty;" ?\∅) ;; EMPTY SET
+ ("&emsp;" ?\ ) ;; EM SPACE
+ ("&emsp13;" ?\ ) ;; THREE-PER-EM SPACE
+ ("&emsp14;" ?\ ) ;; FOUR-PER-EM SPACE
+ ("&ENG;" ?\Ŋ) ;; LATIN CAPITAL LETTER ENG
+ ("&eng;" ?\ŋ) ;; LATIN SMALL LETTER ENG
+ ("&ensp;" ?\ ) ;; EN SPACE
+ ("&Eogon;" ?\Ę) ;; LATIN CAPITAL LETTER E WITH OGONEK
+ ("&eogon;" ?\ę) ;; LATIN SMALL LETTER E WITH OGONEK
+ ("&epsi;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&Epsilon;" ?\Ε) ;; GREEK CAPITAL LETTER EPSILON
+ ("&epsilon;" ?\ε) ;; GREEK SMALL LETTER EPSILON
+ ("&epsis;" ?\∊) ;; SMALL ELEMENT OF
+;;; ("&epsiv;" ?\x????) ;; variant epsilon
+ ("&equals;" ?\=) ;; EQUALS SIGN
+ ("&equiv;" ?\≡) ;; IDENTICAL TO
+ ("&erDot;" ?\≓) ;; IMAGE OF OR APPROXIMATELY EQUAL TO
+ ("&esdot;" ?\≐) ;; APPROACHES THE LIMIT
+ ("&Eta;" ?\Η) ;; GREEK CAPITAL LETTER ETA
+ ("&eta;" ?\η) ;; GREEK SMALL LETTER ETA
+ ("&ETH;" ?\Ð) ;; LATIN CAPITAL LETTER ETH
+ ("&eth;" ?\ð) ;; LATIN SMALL LETTER ETH
+ ("&Euml;" ?\Ë) ;; LATIN CAPITAL LETTER E WITH DIAERESIS
+ ("&euml;" ?\ë) ;; LATIN SMALL LETTER E WITH DIAERESIS
+ ("&excl;" ?\!) ;; EXCLAMATION MARK
+ ("&exist;" ?\∃) ;; THERE EXISTS
+ ("&Fcy;" ?\Ф) ;; CYRILLIC CAPITAL LETTER EF
+ ("&fcy;" ?\ф) ;; CYRILLIC SMALL LETTER EF
+ ("&female;" ?\♀) ;; FEMALE SIGN
+ ("&ffilig;" ?\ffi) ;; LATIN SMALL LIGATURE FFI
+ ("&fflig;" ?\ff) ;; LATIN SMALL LIGATURE FF
+ ("&ffllig;" ?\ffl) ;; LATIN SMALL LIGATURE FFL
+ ("&filig;" ?\fi) ;; LATIN SMALL LIGATURE FI
+;; ("&fjlig;" ?\x????) ;; fj ligature
+ ("&flat;" ?\♭) ;; MUSIC FLAT SIGN
+ ("&fllig;" ?\fl) ;; LATIN SMALL LIGATURE FL
+ ("&fnof;" ?\ƒ) ;; LATIN SMALL LETTER F WITH HOOK
+ ("&forall;" ?\∀) ;; FOR ALL
+ ("&fork;" ?\⋔) ;; PITCHFORK
+ ("&frac12;" ?\½) ;; VULGAR FRACTION ONE HALF
+ ("&frac13;" ?\⅓) ;; VULGAR FRACTION ONE THIRD
+ ("&frac14;" ?\¼) ;; VULGAR FRACTION ONE QUARTER
+ ("&frac15;" ?\⅕) ;; VULGAR FRACTION ONE FIFTH
+ ("&frac16;" ?\⅙) ;; VULGAR FRACTION ONE SIXTH
+ ("&frac18;" ?\⅛) ;; VULGAR FRACTION ONE EIGHTH
+ ("&frac23;" ?\⅔) ;; VULGAR FRACTION TWO THIRDS
+ ("&frac25;" ?\⅖) ;; VULGAR FRACTION TWO FIFTHS
+ ("&frac34;" ?\¾) ;; VULGAR FRACTION THREE QUARTERS
+ ("&frac35;" ?\⅗) ;; VULGAR FRACTION THREE FIFTHS
+ ("&frac38;" ?\⅜) ;; VULGAR FRACTION THREE EIGHTHS
+ ("&frac45;" ?\⅘) ;; VULGAR FRACTION FOUR FIFTHS
+ ("&frac56;" ?\⅚) ;; VULGAR FRACTION FIVE SIXTHS
+ ("&frac58;" ?\⅝) ;; VULGAR FRACTION FIVE EIGHTHS
+ ("&frac78;" ?\⅞) ;; VULGAR FRACTION SEVEN EIGHTHS
+ ("&frasl;" ?\⁄) ;; FRACTION SLASH
+ ("&frown;" ?\⌢) ;; FROWN
+ ("&gacute;" ?\ǵ) ;; LATIN SMALL LETTER G WITH ACUTE
+ ("&Gamma;" ?\Γ) ;; GREEK CAPITAL LETTER GAMMA
+ ("&gamma;" ?\γ) ;; GREEK SMALL LETTER GAMMA
+ ("&gammad;" ?\Ϝ) ;; GREEK LETTER DIGAMMA
+;;; ("&gap;" 0x????) ;; greater-than, approximately equal to
+ ("&Gbreve;" ?\Ğ) ;; LATIN CAPITAL LETTER G WITH BREVE
+ ("&gbreve;" ?\ğ) ;; LATIN SMALL LETTER G WITH BREVE
+ ("&Gcedil;" ?\Ģ) ;; LATIN CAPITAL LETTER G WITH CEDILLA
+ ("&gcedil;" ?\ģ) ;; LATIN SMALL LETTER G WITH CEDILLA
+ ("&Gcirc;" ?\Ĝ) ;; LATIN CAPITAL LETTER G WITH CIRCUMFLEX
+ ("&gcirc;" ?\ĝ) ;; LATIN SMALL LETTER G WITH CIRCUMFLEX
+ ("&Gcy;" ?\Г) ;; CYRILLIC CAPITAL LETTER GHE
+ ("&gcy;" ?\г) ;; CYRILLIC SMALL LETTER GHE
+ ("&Gdot;" ?\Ġ) ;; LATIN CAPITAL LETTER G WITH DOT ABOVE
+ ("&gdot;" ?\ġ) ;; LATIN SMALL LETTER G WITH DOT ABOVE
+ ("&gE;" ?\≧) ;; GREATER-THAN OVER EQUAL TO
+ ("&ge;" ?\≥) ;; GREATER-THAN OR EQUAL TO
+;;; ("&gEl;" ?\x????) ;; greater-than, double equals, less-than
+ ("&gel;" ?\⋛) ;; GREATER-THAN EQUAL TO OR LESS-THAN
+ ("&ges;" ?\≥) ;; GREATER-THAN OR EQUAL TO
+ ("&Gg;" ?\⋙) ;; VERY MUCH GREATER-THAN
+ ("&Ggr;" ?\Γ) ;; GREEK CAPITAL LETTER GAMMA
+ ("&ggr;" ?\γ) ;; GREEK SMALL LETTER GAMMA
+ ("&gimel;" ?\ℷ) ;; GIMEL SYMBOL
+ ("&GJcy;" ?\Ѓ) ;; CYRILLIC CAPITAL LETTER GJE
+ ("&gjcy;" ?\ѓ) ;; CYRILLIC SMALL LETTER GJE
+ ("&gl;" ?\≷) ;; GREATER-THAN OR LESS-THAN
+;;; ("&gnap;" ?\x????) ;; greater-than, not approximately equal to
+ ("&gne;" ?\≩) ;; GREATER-THAN BUT NOT EQUAL TO
+ ("&gnE;" ?\≩) ;; GREATER-THAN BUT NOT EQUAL TO
+ ("&gnsim;" ?\⋧) ;; GREATER-THAN BUT NOT EQUIVALENT TO
+ ("&grave;" ?\`) ;; GRAVE ACCENT
+ ("&gsdot;" ?\⋗) ;; GREATER-THAN WITH DOT
+ ("&gsim;" ?\≳) ;; GREATER-THAN OR EQUIVALENT TO
+ ("&Gt;" ?\≫) ;; MUCH GREATER-THAN
+ ("&gt;" ?\>) ;; GREATER-THAN SIGN
+ ("&gvnE;" ?\≩) ;; GREATER-THAN BUT NOT EQUAL TO
+ ("&hairsp;" ?\ ) ;; HAIR SPACE
+ ("&half;" ?\½) ;; VULGAR FRACTION ONE HALF
+ ("&hamilt;" ?\ℋ) ;; SCRIPT CAPITAL H
+ ("&HARDcy;" ?\Ъ) ;; CYRILLIC CAPITAL LETTER HARD SIGN
+ ("&hardcy;" ?\ъ) ;; CYRILLIC SMALL LETTER HARD SIGN
+ ("&harr;" ?\↔) ;; LEFT RIGHT ARROW
+ ("&hArr;" ?\⇔) ;; LEFT RIGHT DOUBLE ARROW
+ ("&harrw;" ?\↭) ;; LEFT RIGHT WAVE ARROW
+ ("&Hcirc;" ?\Ĥ) ;; LATIN CAPITAL LETTER H WITH CIRCUMFLEX
+ ("&hcirc;" ?\ĥ) ;; LATIN SMALL LETTER H WITH CIRCUMFLEX
+ ("&hearts;" ?\♥) ;; BLACK HEART SUIT
+ ("&hellip;" ?\…) ;; HORIZONTAL ELLIPSIS
+ ("&horbar;" ?\―) ;; HORIZONTAL BAR
+ ("&Hstrok;" ?\Ħ) ;; LATIN CAPITAL LETTER H WITH STROKE
+ ("&hstrok;" ?\ħ) ;; LATIN SMALL LETTER H WITH STROKE
+ ("&hybull;" ?\⁃) ;; HYPHEN BULLET
+ ("&hyphen;" ?\-) ;; HYPHEN-MINUS
+ ("&Iacgr;" ?\Ί) ;; GREEK CAPITAL LETTER IOTA WITH TONOS
+ ("&iacgr;" ?\ί) ;; GREEK SMALL LETTER IOTA WITH TONOS
+ ("&Iacute;" ?\Í) ;; LATIN CAPITAL LETTER I WITH ACUTE
+ ("&iacute;" ?\í) ;; LATIN SMALL LETTER I WITH ACUTE
+ ("&Icirc;" ?\Î) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+ ("&icirc;" ?\î) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX
+ ("&Icy;" ?\И) ;; CYRILLIC CAPITAL LETTER I
+ ("&icy;" ?\и) ;; CYRILLIC SMALL LETTER I
+ ("&idiagr;" ?\ΐ) ;; GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS
+ ("&Idigr;" ?\Ϊ) ;; GREEK CAPITAL LETTER IOTA WITH DIALYTIKA
+ ("&idigr;" ?\ϊ) ;; GREEK SMALL LETTER IOTA WITH DIALYTIKA
+ ("&Idot;" ?\İ) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE
+ ("&IEcy;" ?\Е) ;; CYRILLIC CAPITAL LETTER IE
+ ("&iecy;" ?\е) ;; CYRILLIC SMALL LETTER IE
+ ("&iexcl;" ?\¡) ;; INVERTED EXCLAMATION MARK
+ ("&iff;" ?\⇔) ;; LEFT RIGHT DOUBLE ARROW
+ ("&Igr;" ?\Ι) ;; GREEK CAPITAL LETTER IOTA
+ ("&igr;" ?\ι) ;; GREEK SMALL LETTER IOTA
+ ("&Igrave;" ?\Ì) ;; LATIN CAPITAL LETTER I WITH GRAVE
+ ("&igrave;" ?\ì) ;; LATIN SMALL LETTER I WITH GRAVE
+ ("&IJlig;" ?\IJ) ;; LATIN CAPITAL LIGATURE IJ
+ ("&ijlig;" ?\ij) ;; LATIN SMALL LIGATURE IJ
+ ("&Imacr;" ?\Ī) ;; LATIN CAPITAL LETTER I WITH MACRON
+ ("&imacr;" ?\ī) ;; LATIN SMALL LETTER I WITH MACRON
+ ("&image;" ?\ℑ) ;; BLACK-LETTER CAPITAL I
+ ("&incare;" ?\℅) ;; CARE OF
+ ("&infin;" ?\∞) ;; INFINITY
+ ("&inodot;" ?\ı) ;; LATIN SMALL LETTER DOTLESS I
+ ("&inodot;" ?\ı) ;; LATIN SMALL LETTER DOTLESS I
+ ("&int;" ?\∫) ;; INTEGRAL
+ ("&intcal;" ?\⊺) ;; INTERCALATE
+ ("&IOcy;" ?\Ё) ;; CYRILLIC CAPITAL LETTER IO
+ ("&iocy;" ?\ё) ;; CYRILLIC SMALL LETTER IO
+ ("&Iogon;" ?\Į) ;; LATIN CAPITAL LETTER I WITH OGONEK
+ ("&iogon;" ?\į) ;; LATIN SMALL LETTER I WITH OGONEK
+ ("&Iota;" ?\Ι) ;; GREEK CAPITAL LETTER IOTA
+ ("&iota;" ?\ι) ;; GREEK SMALL LETTER IOTA
+ ("&iquest;" ?\¿) ;; INVERTED QUESTION MARK
+ ("&isin;" ?\∈) ;; ELEMENT OF
+ ("&Itilde;" ?\Ĩ) ;; LATIN CAPITAL LETTER I WITH TILDE
+ ("&itilde;" ?\ĩ) ;; LATIN SMALL LETTER I WITH TILDE
+ ("&Iukcy;" ?\І) ;; CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I
+ ("&iukcy;" ?\і) ;; CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I
+ ("&Iuml;" ?\Ï) ;; LATIN CAPITAL LETTER I WITH DIAERESIS
+ ("&iuml;" ?\ï) ;; LATIN SMALL LETTER I WITH DIAERESIS
+ ("&Jcirc;" ?\Ĵ) ;; LATIN CAPITAL LETTER J WITH CIRCUMFLEX
+ ("&jcirc;" ?\ĵ) ;; LATIN SMALL LETTER J WITH CIRCUMFLEX
+ ("&Jcy;" ?\Й) ;; CYRILLIC CAPITAL LETTER SHORT I
+ ("&jcy;" ?\й) ;; CYRILLIC SMALL LETTER SHORT I
+;;; ("&jnodot;" ?\x????) ;; latin small letter dotless j
+ ("&Jsercy;" ?\Ј) ;; CYRILLIC CAPITAL LETTER JE
+ ("&jsercy;" ?\ј) ;; CYRILLIC SMALL LETTER JE
+ ("&Jukcy;" ?\Є) ;; CYRILLIC CAPITAL LETTER UKRAINIAN IE
+ ("&jukcy;" ?\є) ;; CYRILLIC SMALL LETTER UKRAINIAN IE
+ ("&Kappa;" ?\Κ) ;; GREEK CAPITAL LETTER KAPPA
+ ("&kappa;" ?\κ) ;; GREEK SMALL LETTER KAPPA
+ ("&kappav;" ?\ϰ) ;; GREEK KAPPA SYMBOL
+ ("&Kcedil;" ?\Ķ) ;; LATIN CAPITAL LETTER K WITH CEDILLA
+ ("&kcedil;" ?\ķ) ;; LATIN SMALL LETTER K WITH CEDILLA
+ ("&Kcy;" ?\К) ;; CYRILLIC CAPITAL LETTER KA
+ ("&kcy;" ?\к) ;; CYRILLIC SMALL LETTER KA
+ ("&Kgr;" ?\Κ) ;; GREEK CAPITAL LETTER KAPPA
+ ("&kgr;" ?\κ) ;; GREEK SMALL LETTER KAPPA
+ ("&kgreen;" ?\ĸ) ;; LATIN SMALL LETTER KRA
+ ("&KHcy;" ?\Х) ;; CYRILLIC CAPITAL LETTER HA
+ ("&khcy;" ?\х) ;; CYRILLIC SMALL LETTER HA
+ ("&KHgr;" ?\Χ) ;; GREEK CAPITAL LETTER CHI
+ ("&khgr;" ?\χ) ;; GREEK SMALL LETTER CHI
+ ("&KJcy;" ?\Ќ) ;; CYRILLIC CAPITAL LETTER KJE
+ ("&kjcy;" ?\ќ) ;; CYRILLIC SMALL LETTER KJE
+ ("&lAarr;" ?\⇚) ;; LEFTWARDS TRIPLE ARROW
+ ("&Lacute;" ?\Ĺ) ;; LATIN CAPITAL LETTER L WITH ACUTE
+ ("&lacute;" ?\ĺ) ;; LATIN SMALL LETTER L WITH ACUTE
+ ("&lagran;" ?\ℒ) ;; SCRIPT CAPITAL L
+ ("&Lambda;" ?\Λ) ;; GREEK CAPITAL LETTER LAMDA
+ ("&lambda;" ?\λ) ;; GREEK SMALL LETTER LAMDA
+ ("&lang;" ?\〈) ;; LEFT-POINTING ANGLE BRACKET
+;;; ("&lap;" ?\x????) ;; less-than, approximately equal to
+ ("&laquo;" ?\«) ;; LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
+ ("&Larr;" ?\↞) ;; LEFTWARDS TWO HEADED ARROW
+ ("&larr;" ?\←) ;; LEFTWARDS ARROW
+ ("&lArr;" ?\⇐) ;; LEFTWARDS DOUBLE ARROW
+ ("&larr2;" ?\⇇) ;; LEFTWARDS PAIRED ARROWS
+ ("&larrhk;" ?\↩) ;; LEFTWARDS ARROW WITH HOOK
+ ("&larrlp;" ?\↫) ;; LEFTWARDS ARROW WITH LOOP
+ ("&larrtl;" ?\↢) ;; LEFTWARDS ARROW WITH TAIL
+ ("&Lcaron;" ?\Ľ) ;; LATIN CAPITAL LETTER L WITH CARON
+ ("&lcaron;" ?\ľ) ;; LATIN SMALL LETTER L WITH CARON
+ ("&Lcedil;" ?\Ļ) ;; LATIN CAPITAL LETTER L WITH CEDILLA
+ ("&lcedil;" ?\ļ) ;; LATIN SMALL LETTER L WITH CEDILLA
+ ("&lceil;" ?\⌈) ;; LEFT CEILING
+ ("&lcub;" ?\{) ;; LEFT CURLY BRACKET
+ ("&Lcy;" ?\Л) ;; CYRILLIC CAPITAL LETTER EL
+ ("&lcy;" ?\л) ;; CYRILLIC SMALL LETTER EL
+ ("&ldot;" ?\⋖) ;; LESS-THAN WITH DOT
+ ("&ldquo;" ?\“) ;; LEFT DOUBLE QUOTATION MARK
+ ("&ldquor;" ?\„) ;; DOUBLE LOW-9 QUOTATION MARK
+ ("&lE;" ?\≦) ;; LESS-THAN OVER EQUAL TO
+ ("&le;" ?\≤) ;; LESS-THAN OR EQUAL TO
+;;; ("&lEg;" ?\x????) ;; less-than, double equals, greater-than
+ ("&leg;" ?\⋚) ;; LESS-THAN EQUAL TO OR GREATER-THAN
+ ("&les;" ?\≤) ;; LESS-THAN OR EQUAL TO
+ ("&lfloor;" ?\⌊) ;; LEFT FLOOR
+ ("&lg;" ?\≶) ;; LESS-THAN OR GREATER-THAN
+ ("&Lgr;" ?\Λ) ;; GREEK CAPITAL LETTER LAMDA
+ ("&lgr;" ?\λ) ;; GREEK SMALL LETTER LAMDA
+ ("&lhard;" ?\↽) ;; LEFTWARDS HARPOON WITH BARB DOWNWARDS
+ ("&lharu;" ?\↼) ;; LEFTWARDS HARPOON WITH BARB UPWARDS
+ ("&lhblk;" ?\▄) ;; LOWER HALF BLOCK
+ ("&LJcy;" ?\Љ) ;; CYRILLIC CAPITAL LETTER LJE
+ ("&ljcy;" ?\љ) ;; CYRILLIC SMALL LETTER LJE
+ ("&Ll;" ?\⋘) ;; VERY MUCH LESS-THAN
+ ("&Lmidot;" ?\Ŀ) ;; LATIN CAPITAL LETTER L WITH MIDDLE DOT
+ ("&lmidot;" ?\ŀ) ;; LATIN SMALL LETTER L WITH MIDDLE DOT
+;;; ("&lnap;" 0x????) ;; less-than, not approximately equal to
+ ("&lnE;" ?\≨) ;; LESS-THAN BUT NOT EQUAL TO
+ ("&lne;" ?\≨) ;; LESS-THAN BUT NOT EQUAL TO
+ ("&lnsim;" ?\⋦) ;; LESS-THAN BUT NOT EQUIVALENT TO
+ ("&lowast;" ?\∗) ;; ASTERISK OPERATOR
+ ("&lowbar;" ?\_) ;; LOW LINE
+ ("&loz;" ?\◊) ;; LOZENGE
+ ("&loz;" ?\✧) ;; WHITE FOUR POINTED STAR
+ ("&lozf;" ?\✦) ;; BLACK FOUR POINTED STAR
+ ("&lpar;" ?\() ;; LEFT PARENTHESIS
+;;; ("&lpargt;" ?\x????) ;; left parenthesis, greater-than
+ ("&lrarr2;" ?\⇆) ;; LEFTWARDS ARROW OVER RIGHTWARDS ARROW
+ ("&lrhar2;" ?\⇋) ;; LEFTWARDS HARPOON OVER RIGHTWARDS HARPOON
+ ("&lrm;" ?\‎) ;; LEFT-TO-RIGHT MARK
+ ("&lsaquo;" ?\‹) ;; SINGLE LEFT-POINTING ANGLE QUOTATION MARK
+ ("&lsh;" ?\↰) ;; UPWARDS ARROW WITH TIP LEFTWARDS
+ ("&lsim;" ?\≲) ;; LESS-THAN OR EQUIVALENT TO
+ ("&lsqb;" ?\[) ;; LEFT SQUARE BRACKET
+ ("&lsquo;" ?\‘) ;; LEFT SINGLE QUOTATION MARK
+ ("&lsquor;" ?\‚) ;; SINGLE LOW-9 QUOTATION MARK
+ ("&Lstrok;" ?\Ł) ;; LATIN CAPITAL LETTER L WITH STROKE
+ ("&lstrok;" ?\ł) ;; LATIN SMALL LETTER L WITH STROKE
+ ("&Lt;" ?\≪) ;; MUCH LESS-THAN
+ ("&lt;" ?\<) ;; LESS-THAN SIGN
+ ("&lthree;" ?\⋋) ;; LEFT SEMIDIRECT PRODUCT
+ ("&ltimes;" ?\⋉) ;; LEFT NORMAL FACTOR SEMIDIRECT PRODUCT
+ ("&ltri;" ?\◃) ;; WHITE LEFT-POINTING SMALL TRIANGLE
+ ("&ltrie;" ?\⊴) ;; NORMAL SUBGROUP OF OR EQUAL TO
+ ("&ltrif;" ?\◂) ;; BLACK LEFT-POINTING SMALL TRIANGLE
+ ("&lvnE;" ?\≨) ;; LESS-THAN BUT NOT EQUAL TO
+ ("&macr;" ?\¯) ;; MACRON
+ ("&male;" ?\♂) ;; MALE SIGN
+ ("&malt;" ?\✠) ;; MALTESE CROSS
+ ("&map;" ?\↦) ;; RIGHTWARDS ARROW FROM BAR
+ ("&marker;" ?\▮) ;; BLACK VERTICAL RECTANGLE
+ ("&Mcy;" ?\М) ;; CYRILLIC CAPITAL LETTER EM
+ ("&mcy;" ?\м) ;; CYRILLIC SMALL LETTER EM
+ ("&mdash;" ?\—) ;; EM DASH
+ ("&Mgr;" ?\Μ) ;; GREEK CAPITAL LETTER MU
+ ("&mgr;" ?\μ) ;; GREEK SMALL LETTER MU
+ ("&micro;" ?\µ) ;; MICRO SIGN
+ ("&mid;" ?\∣) ;; DIVIDES
+ ("&middot;" ?\·) ;; MIDDLE DOT
+ ("&minus;" ?\−) ;; MINUS SIGN
+ ("&minusb;" ?\⊟) ;; SQUARED MINUS
+ ("&mldr;" ?\…) ;; HORIZONTAL ELLIPSIS
+ ("&mnplus;" ?\∓) ;; MINUS-OR-PLUS SIGN
+ ("&models;" ?\⊧) ;; MODELS
+ ("&Mu;" ?\Μ) ;; GREEK CAPITAL LETTER MU
+ ("&mu;" ?\μ) ;; GREEK SMALL LETTER MU
+ ("&mumap;" ?\⊸) ;; MULTIMAP
+ ("&nabla;" ?\∇) ;; NABLA
+ ("&Nacute;" ?\Ń) ;; LATIN CAPITAL LETTER N WITH ACUTE
+ ("&nacute;" ?\ń) ;; LATIN SMALL LETTER N WITH ACUTE
+ ("&nap;" ?\≉) ;; NOT ALMOST EQUAL TO
+ ("&napos;" ?\ʼn) ;; LATIN SMALL LETTER N PRECEDED BY APOSTROPHE
+ ("&natur;" ?\♮) ;; MUSIC NATURAL SIGN
+ ("&nbsp;" ?\ ) ;; NO-BREAK SPACE
+ ("&Ncaron;" ?\Ň) ;; LATIN CAPITAL LETTER N WITH CARON
+ ("&ncaron;" ?\ň) ;; LATIN SMALL LETTER N WITH CARON
+ ("&Ncedil;" ?\Ņ) ;; LATIN CAPITAL LETTER N WITH CEDILLA
+ ("&ncedil;" ?\ņ) ;; LATIN SMALL LETTER N WITH CEDILLA
+ ("&ncong;" ?\≇) ;; NEITHER APPROXIMATELY NOR ACTUALLY EQUAL TO
+ ("&Ncy;" ?\Н) ;; CYRILLIC CAPITAL LETTER EN
+ ("&ncy;" ?\н) ;; CYRILLIC SMALL LETTER EN
+ ("&ndash;" ?\–) ;; EN DASH
+ ("&ne;" ?\≠) ;; NOT EQUAL TO
+ ("&nearr;" ?\↗) ;; NORTH EAST ARROW
+ ("&nequiv;" ?\≢) ;; NOT IDENTICAL TO
+ ("&nexist;" ?\∄) ;; THERE DOES NOT EXIST
+;;; ("&ngE;" ?\x????) ;; not greater-than, double equals
+ ("&nge;" ?\≱) ;; NEITHER GREATER-THAN NOR EQUAL TO
+ ("&nges;" ?\≱) ;; NEITHER GREATER-THAN NOR EQUAL TO
+ ("&Ngr;" ?\Ν) ;; GREEK CAPITAL LETTER NU
+ ("&ngr;" ?\ν) ;; GREEK SMALL LETTER NU
+ ("&ngt;" ?\≯) ;; NOT GREATER-THAN
+ ("&nharr;" ?\↮) ;; LEFT RIGHT ARROW WITH STROKE
+ ("&nhArr;" ?\⇎) ;; LEFT RIGHT DOUBLE ARROW WITH STROKE
+ ("&ni;" ?\∋) ;; CONTAINS AS MEMBER
+ ("&NJcy;" ?\Њ) ;; CYRILLIC CAPITAL LETTER NJE
+ ("&njcy;" ?\њ) ;; CYRILLIC SMALL LETTER NJE
+ ("&nlarr;" ?\↚) ;; LEFTWARDS ARROW WITH STROKE
+ ("&nlArr;" ?\⇍) ;; LEFTWARDS DOUBLE ARROW WITH STROKE
+ ("&nldr;" ?\‥) ;; TWO DOT LEADER
+;;; ("&nlE;" ?\x????) ;; not less-than, double equals
+ ("&nle;" ?\≰) ;; NEITHER LESS-THAN NOR EQUAL TO
+ ("&nles;" ?\≰) ;; NEITHER LESS-THAN NOR EQUAL TO
+ ("&nlt;" ?\≮) ;; NOT LESS-THAN
+ ("&nltri;" ?\⋪) ;; NOT NORMAL SUBGROUP OF
+ ("&nltrie;" ?\⋬) ;; NOT NORMAL SUBGROUP OF OR EQUAL TO
+ ("&nmid;" ?\∤) ;; DOES NOT DIVIDE
+ ("&not;" ?\¬) ;; NOT SIGN
+ ("&notin;" ?\∉) ;; NOT AN ELEMENT OF
+ ("&npar;" ?\∦) ;; NOT PARALLEL TO
+ ("&npr;" ?\⊀) ;; DOES NOT PRECEDE
+ ("&npre;" ?\⋠) ;; DOES NOT PRECEDE OR EQUAL
+ ("&nrarr;" ?\↛) ;; RIGHTWARDS ARROW WITH STROKE
+ ("&nrArr;" ?\⇏) ;; RIGHTWARDS DOUBLE ARROW WITH STROKE
+ ("&nrtri;" ?\⋫) ;; DOES NOT CONTAIN AS NORMAL SUBGROUP
+ ("&nrtrie;" ?\⋭) ;; DOES NOT CONTAIN AS NORMAL SUBGROUP OR EQUAL
+ ("&nsc;" ?\⊁) ;; DOES NOT SUCCEED
+ ("&nsce;" ?\⋡) ;; DOES NOT SUCCEED OR EQUAL
+ ("&nsim;" ?\≁) ;; NOT TILDE
+ ("&nsime;" ?\≄) ;; NOT ASYMPTOTICALLY EQUAL TO
+;;; ("&nsmid;" ?\x????) ;; nshortmid ?\∤
+ ("&nspar;" ?\∦) ;; NOT PARALLEL TO
+ ("&nsub;" ?\⊄) ;; NOT A SUBSET OF
+ ("&nsubE;" ?\⊈) ;; NEITHER A SUBSET OF NOR EQUAL TO
+ ("&nsube;" ?\⊈) ;; NEITHER A SUBSET OF NOR EQUAL TO
+ ("&nsup;" ?\⊅) ;; NOT A SUPERSET OF
+ ("&nsupE;" ?\⊉) ;; NEITHER A SUPERSET OF NOR EQUAL TO
+ ("&nsupe;" ?\⊉) ;; NEITHER A SUPERSET OF NOR EQUAL TO
+ ("&Ntilde;" ?\Ñ) ;; LATIN CAPITAL LETTER N WITH TILDE
+ ("&ntilde;" ?\ñ) ;; LATIN SMALL LETTER N WITH TILDE
+ ("&Nu;" ?\Ν) ;; GREEK CAPITAL LETTER NU
+ ("&nu;" ?\ν) ;; GREEK SMALL LETTER NU
+ ("&num;" ?\#) ;; NUMBER SIGN
+ ("&numero;" ?\№) ;; NUMERO SIGN
+ ("&numsp;" ?\ ) ;; FIGURE SPACE
+ ("&nvdash;" ?\⊬) ;; DOES NOT PROVE
+ ("&nvDash;" ?\⊭) ;; NOT TRUE
+ ("&nVdash;" ?\⊮) ;; DOES NOT FORCE
+ ("&nVDash;" ?\⊯) ;; NEGATED DOUBLE VERTICAL BAR DOUBLE RIGHT TURNSTILE
+ ("&nwarr;" ?\↖) ;; NORTH WEST ARROW
+ ("&Oacgr;" ?\Ό) ;; GREEK CAPITAL LETTER OMICRON WITH TONOS
+ ("&oacgr;" ?\ό) ;; GREEK SMALL LETTER OMICRON WITH TONOS
+ ("&Oacute;" ?\Ó) ;; LATIN CAPITAL LETTER O WITH ACUTE
+ ("&oacute;" ?\ó) ;; LATIN SMALL LETTER O WITH ACUTE
+ ("&oast;" ?\⊛) ;; CIRCLED ASTERISK OPERATOR
+ ("&ocir;" ?\⊚) ;; CIRCLED RING OPERATOR
+ ("&Ocirc;" ?\Ô) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("&ocirc;" ?\ô) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("&Ocy;" ?\О) ;; CYRILLIC CAPITAL LETTER O
+ ("&ocy;" ?\о) ;; CYRILLIC SMALL LETTER O
+ ("&odash;" ?\⊝) ;; CIRCLED DASH
+ ("&Odblac;" ?\Ő) ;; LATIN CAPITAL LETTER O WITH DOUBLE ACUTE
+ ("&odblac;" ?\ő) ;; LATIN SMALL LETTER O WITH DOUBLE ACUTE
+ ("&odot;" ?\⊙) ;; CIRCLED DOT OPERATOR
+ ("&OElig;" ?\Œ) ;; LATIN CAPITAL LIGATURE OE
+ ("&oelig;" ?\œ) ;; LATIN SMALL LIGATURE OE
+ ("&ogon;" ?\˛) ;; OGONEK
+ ("&Ogr;" ?\Ο) ;; GREEK CAPITAL LETTER OMICRON
+ ("&ogr;" ?\ο) ;; GREEK SMALL LETTER OMICRON
+ ("&Ograve;" ?\Ò) ;; LATIN CAPITAL LETTER O WITH GRAVE
+ ("&ograve;" ?\ò) ;; LATIN SMALL LETTER O WITH GRAVE
+ ("&OHacgr;" ?\Ώ) ;; GREEK CAPITAL LETTER OMEGA WITH TONOS
+ ("&ohacgr;" ?\ώ) ;; GREEK SMALL LETTER OMEGA WITH TONOS
+ ("&OHgr;" ?\Ω) ;; GREEK CAPITAL LETTER OMEGA
+ ("&ohgr;" ?\ω) ;; GREEK SMALL LETTER OMEGA
+ ("&ohm;" ?\Ω) ;; OHM SIGN
+ ("&olarr;" ?\↺) ;; ANTICLOCKWISE OPEN CIRCLE ARROW
+ ("&oline;" ?\‾) ;; OVERLINE
+ ("&Omacr;" ?\Ō) ;; LATIN CAPITAL LETTER O WITH MACRON
+ ("&omacr;" ?\ō) ;; LATIN SMALL LETTER O WITH MACRON
+ ("&Omega;" ?\Ω) ;; GREEK CAPITAL LETTER OMEGA
+ ("&omega;" ?\ω) ;; GREEK SMALL LETTER OMEGA
+ ("&Omicron;" ?\Ο) ;; GREEK CAPITAL LETTER OMICRON
+ ("&omicron;" ?\ο) ;; GREEK SMALL LETTER OMICRON
+ ("&ominus;" ?\⊖) ;; CIRCLED MINUS
+ ("&oplus;" ?\⊕) ;; CIRCLED PLUS
+ ("&or;" ?\∨) ;; LOGICAL OR
+ ("&orarr;" ?\↻) ;; CLOCKWISE OPEN CIRCLE ARROW
+ ("&order;" ?\ℴ) ;; SCRIPT SMALL O
+ ("&ordf;" ?\ª) ;; FEMININE ORDINAL INDICATOR
+ ("&ordm;" ?\º) ;; MASCULINE ORDINAL INDICATOR
+ ("&oS;" ?\Ⓢ) ;; CIRCLED LATIN CAPITAL LETTER S
+ ("&Oslash;" ?\Ø) ;; LATIN CAPITAL LETTER O WITH STROKE
+ ("&oslash;" ?\ø) ;; LATIN SMALL LETTER O WITH STROKE
+ ("&osol;" ?\⊘) ;; CIRCLED DIVISION SLASH
+ ("&Otilde;" ?\Õ) ;; LATIN CAPITAL LETTER O WITH TILDE
+ ("&otilde;" ?\õ) ;; LATIN SMALL LETTER O WITH TILDE
+ ("&otimes;" ?\⊗) ;; CIRCLED TIMES
+ ("&Ouml;" ?\Ö) ;; LATIN CAPITAL LETTER O WITH DIAERESIS
+ ("&ouml;" ?\ö) ;; LATIN SMALL LETTER O WITH DIAERESIS
+ ("&par;" ?\∥) ;; PARALLEL TO
+ ("&para;" ?\¶) ;; PILCROW SIGN
+ ("&part;" ?\∂) ;; PARTIAL DIFFERENTIAL
+ ("&Pcy;" ?\П) ;; CYRILLIC CAPITAL LETTER PE
+ ("&pcy;" ?\п) ;; CYRILLIC SMALL LETTER PE
+ ("&percnt;" ?\%) ;; PERCENT SIGN
+ ("&period;" ?\.) ;; FULL STOP
+ ("&permil;" ?\‰) ;; PER MILLE SIGN
+ ("&perp;" ?\⊥) ;; UP TACK
+ ("&Pgr;" ?\Π) ;; GREEK CAPITAL LETTER PI
+ ("&pgr;" ?\π) ;; GREEK SMALL LETTER PI
+ ("&PHgr;" ?\Φ) ;; GREEK CAPITAL LETTER PHI
+ ("&phgr;" ?\φ) ;; GREEK SMALL LETTER PHI
+ ("&phi;" ?\φ) ;; GREEK SMALL LETTER PHI
+ ("&Phi;" ?\Φ) ;; GREEK CAPITAL LETTER PHI
+ ("&phis;" ?\φ) ;; GREEK SMALL LETTER PHI
+ ("&phiv;" ?\ϕ) ;; GREEK PHI SYMBOL
+ ("&phmmat;" ?\ℳ) ;; SCRIPT CAPITAL M
+ ("&phone;" ?\☎) ;; BLACK TELEPHONE
+ ("&Pi;" ?\Π) ;; GREEK CAPITAL LETTER PI
+ ("&pi;" ?\π) ;; GREEK SMALL LETTER PI
+ ("&piv;" ?\ϖ) ;; GREEK PI SYMBOL
+ ("&planck;" ?\ℏ) ;; PLANCK CONSTANT OVER TWO PI
+ ("&plus;" ?\+) ;; PLUS SIGN
+ ("&plusb;" ?\⊞) ;; SQUARED PLUS
+ ("&plusdo;" ?\∔) ;; DOT PLUS
+ ("&plusmn;" ?\±) ;; PLUS-MINUS SIGN
+ ("&pound;" ?\£) ;; POUND SIGN
+ ("&pr;" ?\≺) ;; PRECEDES
+;;; ("&prap;" ?\x????) ;; precedes, approximately equal to
+ ("&pre;" ?\≼) ;; PRECEDES OR EQUAL TO
+ ("&prime;" ?\′) ;; PRIME
+ ("&Prime;" ?\″) ;; DOUBLE PRIME
+;;; ("&prnap;" 0x????) ;; precedes, not approximately equal to
+;;; ("&prnE;" 0x????) ;; precedes, not double equal
+ ("&prnsim;" ?\⋨) ;; PRECEDES BUT NOT EQUIVALENT TO
+ ("&prod;" ?\∏) ;; N-ARY PRODUCT
+ ("&prop;" ?\∝) ;; PROPORTIONAL TO
+ ("&prsim;" ?\≾) ;; PRECEDES OR EQUIVALENT TO
+ ("&PSgr;" ?\Ψ) ;; GREEK CAPITAL LETTER PSI
+ ("&psgr;" ?\ψ) ;; GREEK SMALL LETTER PSI
+ ("&Psi;" ?\Ψ) ;; GREEK CAPITAL LETTER PSI
+ ("&psi;" ?\ψ) ;; GREEK SMALL LETTER PSI
+ ("&puncsp;" ?\ ) ;; PUNCTUATION SPACE
+ ("&quest;" ?\?) ;; QUESTION MARK
+ ("&quot;" ?\") ;; QUOTATION MARK
+ ("&rAarr;" ?\⇛) ;; RIGHTWARDS TRIPLE ARROW
+ ("&Racute;" ?\Ŕ) ;; LATIN CAPITAL LETTER R WITH ACUTE
+ ("&racute;" ?\ŕ) ;; LATIN SMALL LETTER R WITH ACUTE
+ ("&radic;" ?\√) ;; SQUARE ROOT
+ ("&rang;" ?\〉) ;; RIGHT-POINTING ANGLE BRACKET
+ ("&raquo;" ?\») ;; RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
+ ("&Rarr;" ?\↠) ;; RIGHTWARDS TWO HEADED ARROW
+ ("&rarr;" ?\→) ;; RIGHTWARDS ARROW
+ ("&rArr;" ?\⇒) ;; RIGHTWARDS DOUBLE ARROW
+ ("&rarr2;" ?\⇉) ;; RIGHTWARDS PAIRED ARROWS
+ ("&rarrhk;" ?\↪) ;; RIGHTWARDS ARROW WITH HOOK
+ ("&rarrlp;" ?\↬) ;; RIGHTWARDS ARROW WITH LOOP
+ ("&rarrtl;" ?\↣) ;; RIGHTWARDS ARROW WITH TAIL
+ ("&rarrw;" ?\↝) ;; RIGHTWARDS WAVE ARROW
+ ("&Rcaron;" ?\Ř) ;; LATIN CAPITAL LETTER R WITH CARON
+ ("&rcaron;" ?\ř) ;; LATIN SMALL LETTER R WITH CARON
+ ("&Rcedil;" ?\Ŗ) ;; LATIN CAPITAL LETTER R WITH CEDILLA
+ ("&rcedil;" ?\ŗ) ;; LATIN SMALL LETTER R WITH CEDILLA
+ ("&rceil;" ?\⌉) ;; RIGHT CEILING
+ ("&rcub;" ?\}) ;; RIGHT CURLY BRACKET
+ ("&Rcy;" ?\Р) ;; CYRILLIC CAPITAL LETTER ER
+ ("&rcy;" ?\р) ;; CYRILLIC SMALL LETTER ER
+ ("&rdquo;" ?\”) ;; RIGHT DOUBLE QUOTATION MARK
+ ("&rdquor;" ?\“) ;; LEFT DOUBLE QUOTATION MARK
+ ("&real;" ?\ℜ) ;; BLACK-LETTER CAPITAL R
+ ("&rect;" ?\▭) ;; WHITE RECTANGLE
+ ("&reg;" ?\®) ;; REGISTERED SIGN
+ ("&rfloor;" ?\⌋) ;; RIGHT FLOOR
+ ("&Rgr;" ?\Ρ) ;; GREEK CAPITAL LETTER RHO
+ ("&rgr;" ?\ρ) ;; GREEK SMALL LETTER RHO
+ ("&rhard;" ?\⇁) ;; RIGHTWARDS HARPOON WITH BARB DOWNWARDS
+ ("&rharu;" ?\⇀) ;; RIGHTWARDS HARPOON WITH BARB UPWARDS
+ ("&Rho;" ?\Ρ) ;; GREEK CAPITAL LETTER RHO
+ ("&rho;" ?\ρ) ;; GREEK SMALL LETTER RHO
+ ("&rhov;" ?\ϱ) ;; GREEK RHO SYMBOL
+ ("&ring;" ?\˚) ;; RING ABOVE
+ ("&rlarr2;" ?\⇄) ;; RIGHTWARDS ARROW OVER LEFTWARDS ARROW
+ ("&rlhar2;" ?\⇌) ;; RIGHTWARDS HARPOON OVER LEFTWARDS HARPOON
+ ("&rlm;" ?\‏) ;; RIGHT-TO-LEFT MARK
+ ("&rpar;" ?\)) ;; RIGHT PARENTHESIS
+;;; ("&rpargt;" ?\x????) ;; right parenthesis, greater-than
+ ("&rsaquo;" ?\›) ;; SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
+ ("&rsh;" ?\↱) ;; UPWARDS ARROW WITH TIP RIGHTWARDS
+ ("&rsqb;" ?\]) ;; RIGHT SQUARE BRACKET
+ ("&rsquo;" ?\’) ;; RIGHT SINGLE QUOTATION MARK
+ ("&rsquor;" ?\‘) ;; LEFT SINGLE QUOTATION MARK
+ ("&rthree;" ?\⋌) ;; RIGHT SEMIDIRECT PRODUCT
+ ("&rtimes;" ?\⋊) ;; RIGHT NORMAL FACTOR SEMIDIRECT PRODUCT
+ ("&rtri;" ?\▹) ;; WHITE RIGHT-POINTING SMALL TRIANGLE
+ ("&rtrie;" ?\⊵) ;; CONTAINS AS NORMAL SUBGROUP OR EQUAL TO
+ ("&rtrif;" ?\▸) ;; BLACK RIGHT-POINTING SMALL TRIANGLE
+ ("&rx;" ?\℞) ;; PRESCRIPTION TAKE
+ ("&Sacute;" ?\Ś) ;; LATIN CAPITAL LETTER S WITH ACUTE
+ ("&sacute;" ?\ś) ;; LATIN SMALL LETTER S WITH ACUTE
+ ("&samalg;" ?\∐) ;; N-ARY COPRODUCT
+ ("&sbquo;" ?\‚) ;; SINGLE LOW-9 QUOTATION MARK
+ ("&sbsol;" ?\\) ;; REVERSE SOLIDUS
+ ("&sc;" ?\≻) ;; SUCCEEDS
+;;; ("&scap;" ?\x????) ;; succeeds, approximately equal to
+ ("&Scaron;" ?\Š) ;; LATIN CAPITAL LETTER S WITH CARON
+ ("&scaron;" ?\š) ;; LATIN SMALL LETTER S WITH CARON
+ ("&sccue;" ?\≽) ;; SUCCEEDS OR EQUAL TO
+ ("&sce;" ?\≽) ;; SUCCEEDS OR EQUAL TO
+ ("&Scedil;" ?\Ş) ;; LATIN CAPITAL LETTER S WITH CEDILLA
+ ("&scedil;" ?\ş) ;; LATIN SMALL LETTER S WITH CEDILLA
+ ("&Scirc;" ?\Ŝ) ;; LATIN CAPITAL LETTER S WITH CIRCUMFLEX
+ ("&scirc;" ?\ŝ) ;; LATIN SMALL LETTER S WITH CIRCUMFLEX
+;;; ("&scnap;" ?\x????) ;; succeeds, not approximately equal to
+;;; ("&scnE;" ?\x????) ;; succeeds, not double equals
+ ("&scnsim;" ?\⋩) ;; SUCCEEDS BUT NOT EQUIVALENT TO
+ ("&scsim;" ?\≿) ;; SUCCEEDS OR EQUIVALENT TO
+ ("&Scy;" ?\С) ;; CYRILLIC CAPITAL LETTER ES
+ ("&scy;" ?\с) ;; CYRILLIC SMALL LETTER ES
+ ("&sdot;" ?\⋅) ;; DOT OPERATOR
+ ("&sdotb;" ?\⊡) ;; SQUARED DOT OPERATOR
+ ("&sect;" ?\§) ;; SECTION SIGN
+ ("&semi;" ?\;) ;; SEMICOLON
+ ("&setmn;" ?\∖) ;; SET MINUS
+ ("&sext;" ?\✶) ;; SIX POINTED BLACK STAR
+ ("&sfgr;" ?\ς) ;; GREEK SMALL LETTER FINAL SIGMA
+ ("&sfrown;" ?\⌢) ;; FROWN
+ ("&Sgr;" ?\Σ) ;; GREEK CAPITAL LETTER SIGMA
+ ("&sgr;" ?\σ) ;; GREEK SMALL LETTER SIGMA
+ ("&sharp;" ?\♯) ;; MUSIC SHARP SIGN
+ ("&SHCHcy;" ?\Щ) ;; CYRILLIC CAPITAL LETTER SHCHA
+ ("&shchcy;" ?\щ) ;; CYRILLIC SMALL LETTER SHCHA
+ ("&SHcy;" ?\Ш) ;; CYRILLIC CAPITAL LETTER SHA
+ ("&shcy;" ?\ш) ;; CYRILLIC SMALL LETTER SHA
+ ("&shy;" ?\­) ;; SOFT HYPHEN
+ ("&Sigma;" ?\Σ) ;; GREEK CAPITAL LETTER SIGMA
+ ("&sigma;" ?\σ) ;; GREEK SMALL LETTER SIGMA
+ ("&sigmaf;" ?\ς) ;; GREEK SMALL LETTER FINAL SIGMA
+ ("&sigmav;" ?\ς) ;; GREEK SMALL LETTER FINAL SIGMA
+ ("&sim;" ?\∼) ;; TILDE OPERATOR
+ ("&sime;" ?\≃) ;; ASYMPTOTICALLY EQUAL TO
+;;; ("&smid;" ?\x????) ;; shortmid ?\∤
+ ("&smile;" ?\⌣) ;; SMILE
+ ("&SOFTcy;" ?\Ь) ;; CYRILLIC CAPITAL LETTER SOFT SIGN
+ ("&softcy;" ?\ь) ;; CYRILLIC SMALL LETTER SOFT SIGN
+ ("&sol;" ?\/) ;; SOLIDUS
+ ("&spades;" ?\♠) ;; BLACK SPADE SUIT
+ ("&spar;" ?\∥) ;; PARALLEL TO
+ ("&sqcap;" ?\⊓) ;; SQUARE CAP
+ ("&sqcup;" ?\⊔) ;; SQUARE CUP
+ ("&sqsub;" ?\⊏) ;; SQUARE IMAGE OF
+ ("&sqsube;" ?\⊑) ;; SQUARE IMAGE OF OR EQUAL TO
+ ("&sqsup;" ?\⊐) ;; SQUARE ORIGINAL OF
+ ("&sqsupe;" ?\⊒) ;; SQUARE ORIGINAL OF OR EQUAL TO
+ ("&squ;" ?\□) ;; WHITE SQUARE
+ ("&square;" ?\□) ;; WHITE SQUARE
+ ("&squf;" ?\▪) ;; BLACK SMALL SQUARE
+ ("&ssetmn;" ?\∖) ;; SET MINUS
+ ("&ssmile;" ?\⌣) ;; SMILE
+ ("&sstarf;" ?\⋆) ;; STAR OPERATOR
+ ("&star;" ?\☆) ;; WHITE STAR
+ ("&starf;" ?\★) ;; BLACK STAR
+ ("&Sub;" ?\⋐) ;; DOUBLE SUBSET
+ ("&sub;" ?\⊂) ;; SUBSET OF
+ ("&subE;" ?\⊆) ;; SUBSET OF OR EQUAL TO
+ ("&sube;" ?\⊆) ;; SUBSET OF OR EQUAL TO
+ ("&subnE;" ?\⊊) ;; SUBSET OF WITH NOT EQUAL TO
+ ("&subne;" ?\⊊) ;; SUBSET OF WITH NOT EQUAL TO
+ ("&sum;" ?\∑) ;; N-ARY SUMMATION
+ ("&sung;" ?\♪) ;; EIGHTH NOTE
+ ("&Sup;" ?\⋑) ;; DOUBLE SUPERSET
+ ("&sup;" ?\⊃) ;; SUPERSET OF
+ ("&sup1;" ?\¹) ;; SUPERSCRIPT ONE
+ ("&sup2;" ?\²) ;; SUPERSCRIPT TWO
+ ("&sup3;" ?\³) ;; SUPERSCRIPT THREE
+ ("&supE;" ?\⊇) ;; SUPERSET OF OR EQUAL TO
+ ("&supe;" ?\⊇) ;; SUPERSET OF OR EQUAL TO
+ ("&supnE;" ?\⊋) ;; SUPERSET OF WITH NOT EQUAL TO
+ ("&supne;" ?\⊋) ;; SUPERSET OF WITH NOT EQUAL TO
+ ("&szlig;" ?\ß) ;; LATIN SMALL LETTER SHARP S
+ ("&target;" ?\⌖) ;; POSITION INDICATOR
+ ("&Tau;" ?\Τ) ;; GREEK CAPITAL LETTER TAU
+ ("&tau;" ?\τ) ;; GREEK SMALL LETTER TAU
+ ("&Tcaron;" ?\Ť) ;; LATIN CAPITAL LETTER T WITH CARON
+ ("&tcaron;" ?\ť) ;; LATIN SMALL LETTER T WITH CARON
+ ("&Tcedil;" ?\Ţ) ;; LATIN CAPITAL LETTER T WITH CEDILLA
+ ("&tcedil;" ?\ţ) ;; LATIN SMALL LETTER T WITH CEDILLA
+ ("&Tcy;" ?\Т) ;; CYRILLIC CAPITAL LETTER TE
+ ("&tcy;" ?\т) ;; CYRILLIC SMALL LETTER TE
+ ("&tdot;" ?\⃛) ;; COMBINING THREE DOTS ABOVE
+ ("&telrec;" ?\⌕) ;; TELEPHONE RECORDER
+ ("&Tgr;" ?\Τ) ;; GREEK CAPITAL LETTER TAU
+ ("&tgr;" ?\τ) ;; GREEK SMALL LETTER TAU
+ ("&there4;" ?\∴) ;; THEREFORE
+ ("&theta;" ?\θ) ;; GREEK SMALL LETTER THETA
+ ("&Theta;" ?\Θ) ;; GREEK CAPITAL LETTER THETA
+ ("&thetas;" ?\θ) ;; GREEK SMALL LETTER THETA
+ ("&thetasym;" ?\ϑ) ;; GREEK THETA SYMBOL
+ ("&thetav;" ?\ϑ) ;; GREEK THETA SYMBOL
+ ("&THgr;" ?\Θ) ;; GREEK CAPITAL LETTER THETA
+ ("&thgr;" ?\θ) ;; GREEK SMALL LETTER THETA
+ ("&thinsp;" ?\ ) ;; THIN SPACE
+ ("&thkap;" ?\≈) ;; ALMOST EQUAL TO
+ ("&thksim;" ?\∼) ;; TILDE OPERATOR
+ ("&THORN;" ?\Þ) ;; LATIN CAPITAL LETTER THORN
+ ("&thorn;" ?\þ) ;; LATIN SMALL LETTER THORN
+ ("&tilde;" ?\˜) ;; SMALL TILDE
+ ("&times;" ?\×) ;; MULTIPLICATION SIGN
+ ("&timesb;" ?\⊠) ;; SQUARED TIMES
+ ("&top;" ?\⊤) ;; DOWN TACK
+ ("&tprime;" ?\‴) ;; TRIPLE PRIME
+ ("&trade;" ?\™) ;; TRADE MARK SIGN
+ ("&trie;" ?\≜) ;; DELTA EQUAL TO
+ ("&TScy;" ?\Ц) ;; CYRILLIC CAPITAL LETTER TSE
+ ("&tscy;" ?\ц) ;; CYRILLIC SMALL LETTER TSE
+ ("&TSHcy;" ?\Ћ) ;; CYRILLIC CAPITAL LETTER TSHE
+ ("&tshcy;" ?\ћ) ;; CYRILLIC SMALL LETTER TSHE
+ ("&Tstrok;" ?\Ŧ) ;; LATIN CAPITAL LETTER T WITH STROKE
+ ("&tstrok;" ?\ŧ) ;; LATIN SMALL LETTER T WITH STROKE
+ ("&twixt;" ?\≬) ;; BETWEEN
+ ("&Uacgr;" ?\Ύ) ;; GREEK CAPITAL LETTER UPSILON WITH TONOS
+ ("&uacgr;" ?\ύ) ;; GREEK SMALL LETTER UPSILON WITH TONOS
+ ("&Uacute;" ?\Ú) ;; LATIN CAPITAL LETTER U WITH ACUTE
+ ("&uacute;" ?\ú) ;; LATIN SMALL LETTER U WITH ACUTE
+ ("&uArr;" ?\⇑) ;; UPWARDS DOUBLE ARROW
+ ("&uarr;" ?\↑) ;; UPWARDS ARROW
+ ("&uarr2;" ?\⇈) ;; UPWARDS PAIRED ARROWS
+ ("&Ubrcy;" ?\Ў) ;; CYRILLIC CAPITAL LETTER SHORT U
+ ("&ubrcy;" ?\ў) ;; CYRILLIC SMALL LETTER SHORT U
+ ("&Ubreve;" ?\Ŭ) ;; LATIN CAPITAL LETTER U WITH BREVE
+ ("&ubreve;" ?\ŭ) ;; LATIN SMALL LETTER U WITH BREVE
+ ("&Ucirc;" ?\Û) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+ ("&ucirc;" ?\û) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX
+ ("&Ucy;" ?\У) ;; CYRILLIC CAPITAL LETTER U
+ ("&ucy;" ?\у) ;; CYRILLIC SMALL LETTER U
+ ("&Udblac;" ?\Ű) ;; LATIN CAPITAL LETTER U WITH DOUBLE ACUTE
+ ("&udblac;" ?\ű) ;; LATIN SMALL LETTER U WITH DOUBLE ACUTE
+ ("&udiagr;" ?\ΰ) ;; GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS
+ ("&Udigr;" ?\Ϋ) ;; GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA
+ ("&udigr;" ?\ϋ) ;; GREEK SMALL LETTER UPSILON WITH DIALYTIKA
+ ("&Ugr;" ?\Υ) ;; GREEK CAPITAL LETTER UPSILON
+ ("&ugr;" ?\υ) ;; GREEK SMALL LETTER UPSILON
+ ("&Ugrave;" ?\Ù) ;; LATIN CAPITAL LETTER U WITH GRAVE
+ ("&ugrave;" ?\ù) ;; LATIN SMALL LETTER U WITH GRAVE
+ ("&uharl;" ?\↿) ;; UPWARDS HARPOON WITH BARB LEFTWARDS
+ ("&uharr;" ?\↾) ;; UPWARDS HARPOON WITH BARB RIGHTWARDS
+ ("&uhblk;" ?\▀) ;; UPPER HALF BLOCK
+ ("&ulcorn;" ?\⌜) ;; TOP LEFT CORNER
+ ("&ulcrop;" ?\⌏) ;; TOP LEFT CROP
+ ("&Umacr;" ?\Ū) ;; LATIN CAPITAL LETTER U WITH MACRON
+ ("&umacr;" ?\ū) ;; LATIN SMALL LETTER U WITH MACRON
+ ("&uml;" ?\¨) ;; DIAERESIS
+ ("&Uogon;" ?\Ų) ;; LATIN CAPITAL LETTER U WITH OGONEK
+ ("&uogon;" ?\ų) ;; LATIN SMALL LETTER U WITH OGONEK
+ ("&uplus;" ?\⊎) ;; MULTISET UNION
+ ("&Upsi;" ?\Υ) ;; GREEK CAPITAL LETTER UPSILON
+ ("&upsi;" ?\υ) ;; GREEK SMALL LETTER UPSILON
+ ("&upsih;" ?\ϒ) ;; GREEK UPSILON WITH HOOK SYMBOL
+ ("&Upsilon;" ?\Υ) ;; GREEK CAPITAL LETTER UPSILON
+ ("&upsilon;" ?\υ) ;; GREEK SMALL LETTER UPSILON
+ ("&urcorn;" ?\⌝) ;; TOP RIGHT CORNER
+ ("&urcrop;" ?\⌎) ;; TOP RIGHT CROP
+ ("&Uring;" ?\Ů) ;; LATIN CAPITAL LETTER U WITH RING ABOVE
+ ("&uring;" ?\ů) ;; LATIN SMALL LETTER U WITH RING ABOVE
+ ("&Utilde;" ?\Ũ) ;; LATIN CAPITAL LETTER U WITH TILDE
+ ("&utilde;" ?\ũ) ;; LATIN SMALL LETTER U WITH TILDE
+ ("&utri;" ?\▵) ;; WHITE UP-POINTING SMALL TRIANGLE
+ ("&utrif;" ?\▴) ;; BLACK UP-POINTING SMALL TRIANGLE
+ ("&Uuml;" ?\Ü) ;; LATIN CAPITAL LETTER U WITH DIAERESIS
+ ("&uuml;" ?\ü) ;; LATIN SMALL LETTER U WITH DIAERESIS
+ ("&varr;" ?\↕) ;; UP DOWN ARROW
+ ("&vArr;" ?\⇕) ;; UP DOWN DOUBLE ARROW
+ ("&Vcy;" ?\В) ;; CYRILLIC CAPITAL LETTER VE
+ ("&vcy;" ?\в) ;; CYRILLIC SMALL LETTER VE
+ ("&vdash;" ?\⊢) ;; RIGHT TACK
+ ("&vDash;" ?\⊨) ;; TRUE
+ ("&Vdash;" ?\⊩) ;; FORCES
+ ("&veebar;" ?\⊻) ;; XOR
+ ("&vellip;" ?\⋮) ;; VERTICAL ELLIPSIS
+ ("&verbar;" ?\|) ;; VERTICAL LINE
+ ("&Verbar;" ?\‖) ;; DOUBLE VERTICAL LINE
+ ("&vltri;" ?\⊲) ;; NORMAL SUBGROUP OF
+ ("&vprime;" ?\′) ;; PRIME
+ ("&vprop;" ?\∝) ;; PROPORTIONAL TO
+ ("&vrtri;" ?\⊳) ;; CONTAINS AS NORMAL SUBGROUP
+ ("&vsubnE;" ?\⊊) ;; SUBSET OF WITH NOT EQUAL TO
+ ("&vsubne;" ?\⊊) ;; SUBSET OF WITH NOT EQUAL TO
+ ("&vsupne;" ?\⊋) ;; SUPERSET OF WITH NOT EQUAL TO
+ ("&vsupnE;" ?\⊋) ;; SUPERSET OF WITH NOT EQUAL TO
+ ("&Vvdash;" ?\⊪) ;; TRIPLE VERTICAL BAR RIGHT TURNSTILE
+ ("&Wcirc;" ?\Ŵ) ;; LATIN CAPITAL LETTER W WITH CIRCUMFLEX
+ ("&wcirc;" ?\ŵ) ;; LATIN SMALL LETTER W WITH CIRCUMFLEX
+ ("&wedgeq;" ?\≙) ;; ESTIMATES
+ ("&weierp;" ?\℘) ;; SCRIPT CAPITAL P
+ ("&wreath;" ?\≀) ;; WREATH PRODUCT
+ ("&xcirc;" ?\○) ;; WHITE CIRCLE
+ ("&xdtri;" ?\▽) ;; WHITE DOWN-POINTING TRIANGLE
+ ("&Xgr;" ?\Ξ) ;; GREEK CAPITAL LETTER XI
+ ("&xgr;" ?\ξ) ;; GREEK SMALL LETTER XI
+ ("&xhArr;" ?\↔) ;; LEFT RIGHT ARROW
+ ("&xharr;" ?\↔) ;; LEFT RIGHT ARROW
+ ("&Xi;" ?\Ξ) ;; GREEK CAPITAL LETTER XI
+ ("&xi;" ?\ξ) ;; GREEK SMALL LETTER XI
+ ("&xlArr;" ?\⇐) ;; LEFTWARDS DOUBLE ARROW
+ ("&xrArr;" ?\⇒) ;; RIGHTWARDS DOUBLE ARROW
+ ("&xutri;" ?\△) ;; WHITE UP-POINTING TRIANGLE
+ ("&Yacute;" ?\Ý) ;; LATIN CAPITAL LETTER Y WITH ACUTE
+ ("&yacute;" ?\ý) ;; LATIN SMALL LETTER Y WITH ACUTE
+ ("&YAcy;" ?\Я) ;; CYRILLIC CAPITAL LETTER YA
+ ("&yacy;" ?\я) ;; CYRILLIC SMALL LETTER YA
+ ("&Ycirc;" ?\Ŷ) ;; LATIN CAPITAL LETTER Y WITH CIRCUMFLEX
+ ("&ycirc;" ?\ŷ) ;; LATIN SMALL LETTER Y WITH CIRCUMFLEX
+ ("&Ycy;" ?\Ы) ;; CYRILLIC CAPITAL LETTER YERU
+ ("&ycy;" ?\ы) ;; CYRILLIC SMALL LETTER YERU
+ ("&yen;" ?\¥) ;; YEN SIGN
+ ("&YIcy;" ?\Ї) ;; CYRILLIC CAPITAL LETTER YI
+ ("&yicy;" ?\ї) ;; CYRILLIC SMALL LETTER YI
+ ("&YUcy;" ?\Ю) ;; CYRILLIC CAPITAL LETTER YU
+ ("&yucy;" ?\ю) ;; CYRILLIC SMALL LETTER YU
+ ("&yuml;" ?\ÿ) ;; LATIN SMALL LETTER Y WITH DIAERESIS
+ ("&Yuml;" ?\Ÿ) ;; LATIN CAPITAL LETTER Y WITH DIAERESIS
+ ("&Zacute;" ?\Ź) ;; LATIN CAPITAL LETTER Z WITH ACUTE
+ ("&zacute;" ?\ź) ;; LATIN SMALL LETTER Z WITH ACUTE
+ ("&Zcaron;" ?\Ž) ;; LATIN CAPITAL LETTER Z WITH CARON
+ ("&zcaron;" ?\ž) ;; LATIN SMALL LETTER Z WITH CARON
+ ("&Zcy;" ?\З) ;; CYRILLIC CAPITAL LETTER ZE
+ ("&zcy;" ?\з) ;; CYRILLIC SMALL LETTER ZE
+ ("&Zdot;" ?\Ż) ;; LATIN CAPITAL LETTER Z WITH DOT ABOVE
+ ("&zdot;" ?\ż) ;; LATIN SMALL LETTER Z WITH DOT ABOVE
+ ("&Zeta;" ?\Ζ) ;; GREEK CAPITAL LETTER ZETA
+ ("&zeta;" ?\ζ) ;; GREEK SMALL LETTER ZETA
+ ("&Zgr;" ?\Ζ) ;; GREEK CAPITAL LETTER ZETA
+ ("&zgr;" ?\ζ) ;; GREEK SMALL LETTER ZETA
+ ("&ZHcy;" ?\Ж) ;; CYRILLIC CAPITAL LETTER ZHE
+ ("&zhcy;" ?\ж) ;; CYRILLIC SMALL LETTER ZHE
+ ("&zwj;" ?\‍) ;; ZERO WIDTH JOINER
+ ("&zwnj;" ?\‌) ;; ZERO WIDTH NON-JOINER
+)
+
+;;; sgml-input.el ends here
diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el
new file mode 100644
index 00000000000..e43bf0ac5cb
--- /dev/null
+++ b/lisp/leim/quail/sisheng.el
@@ -0,0 +1,290 @@
+;;; sisheng.el --- sisheng input method for Chinese pinyin transliteration
+
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
+
+;; Author: Werner LEMBERG <wl@gnu.org>
+
+;; Keywords: multilingual, input method, Chinese, pinyin, sisheng
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(defconst sisheng-regexp
+ "[āēīōūǖ]\\|üē")
+
+;; First element is the key,
+;; second element is the vowel used for the input sequence,
+;; last four elements are the resulting tones.
+;;
+(defconst sisheng-vowel-table
+ '(("ā" "a" "ā" "á" "ǎ" "à")
+ ("ē" "e" "ē" "é" "ě" "è")
+ ("ī" "i" "ī" "í" "ǐ" "ì")
+ ("ō" "o" "ō" "ó" "ǒ" "ò")
+ ("ū" "u" "ū" "ú" "ǔ" "ù")
+ ("ǖ" "v" "ǖ" "ǘ" "ǚ" "ǜ")
+ ("üē" "ve" "üē" "üé" "üě" "üè")))
+
+
+;; All possible syllables in Mandarin Chinese, presented in the first
+;; tone. Note that make-sisheng-rules always constructs rules for all
+;; four tones even if some of those tones aren't used in Mandarin.
+;;
+(defconst sisheng-syllable-table
+ '("ā" "āi" "ān" "āng" "āo"
+
+ "bā" "bāi" "bān" "bāng" "bāo"
+ "bēi" "bēn" "bēng"
+ "bī" "biān" "biāo" "biē" "bīn" "bīng"
+ "bō"
+ "bū"
+
+ "cā" "cāi" "cān" "cāng" "cāo"
+ "cē" "cēn" "cēng"
+ "cī"
+ "cōng" "cōu"
+ "cū" "cuān" "cuī" "cūn" "cuō"
+
+ "chā" "chāi" "chān" "chāng" "chāo"
+ "chē" "chēn" "chēng"
+ "chī"
+ "chōng" "chōu"
+ "chū" "chuā" "chuāi" "chuān" "chuāng" "chuī" "chūn" "chuō"
+
+ "dā" "dāi" "dān" "dāng" "dāo"
+ "dē" "dēi" "dēn" "dēng"
+ "dī" "diān" "diāo" "diē" "dīng" "diū"
+ "dōng" "dōu"
+ "dū" "duān" "duī" "dūn" "duō"
+
+ "ē" "ēi" "ēn" "ēng" "ēr"
+
+ "fā" "fān" "fāng"
+ "fēi" "fēn" "fēng"
+ "fiāo"
+ "fō" "fōu"
+ "fū"
+
+ "gā" "gāi" "gān" "gāng" "gāo"
+ "gē" "gēi" "gēn" "gēng"
+ "gōng" "gōu"
+ "gū" "guā" "guāi" "guān" "guāng" "guī" "gūn" "guō"
+
+ "hā" "hāi" "hān" "hāng" "hāo"
+ "hē" "hēi" "hēn" "hēng"
+ "hōng" "hōu"
+ "hū" "huā" "huāi" "huān" "huāng" "huī" "hūn" "huō"
+
+ "jī" "jiā" "jiān" "jiāng" "jiāo" "jiē" "jīn" "jīng" "jiōng" "jiū"
+ "jū" "juān" "juē" "jūn"
+
+ "kā" "kāi" "kān" "kāng" "kāo"
+ "kē" "kēi" "kēn" "kēng"
+ "kōng" "kōu"
+ "kū" "kuā" "kuāi" "kuān" "kuāng" "kuī" "kūn" "kuō"
+
+ "lā" "lāi" "lān" "lāng" "lāo"
+ "lē" "lēi" "lēng"
+ "lī" "liā" "liān" "liāng" "liāo" "liē" "līn" "līng" "liū"
+ "lōng" "lōu"
+ "lū" "luān" "lūn" "luō"
+ "lǖ" "lüē"
+
+ "mā" "māi" "mān" "māng" "māo"
+ "mē" "mēi" "mēn" "mēng"
+ "mī" "miān" "miāo" "miē" "mīn" "mīng" "miū"
+ "mō" "mōu"
+ "mū"
+
+ "nā" "nāi" "nān" "nāng" "nāo"
+ "nē" "nēi" "nēn" "nēng"
+ "nī" "niān" "niāng" "niāo" "niē" "nīn" "nīng" "niū"
+ "nōng" "nōu"
+ "nū" "nuān" "nuō"
+ "nǖ" "nüē"
+
+ "ō" "ōu"
+
+ "pā" "pāi" "pān" "pāng" "pāo"
+ "pēi" "pēn" "pēng"
+ "pī" "piān" "piāo" "piē" "pīn" "pīng"
+ "pō" "pōu"
+ "pū"
+
+ "qī" "qiā" "qiān" "qiāng" "qiāo" "qiē" "qīn" "qīng" "qiōng" "qiū"
+ "qū" "quān" "quē" "qūn"
+
+ "rān" "rāng" "rāo"
+ "rē" "rēn" "rēng"
+ "rī"
+ "rōng" "rōu"
+ "rū" "ruā" "ruān" "ruī" "rūn" "ruō"
+
+ "sā" "sāi" "sān" "sāng" "sāo"
+ "sē" "sēn" "sēng"
+ "sī"
+ "sōng" "sōu"
+ "sū" "suān" "suī" "sūn" "suō"
+
+ "shā" "shāi" "shān" "shāng" "shāo"
+ "shē" "shēi" "shēn" "shēng"
+ "shī"
+ "shōu"
+ "shū" "shuā" "shuāi" "shuān" "shuāng" "shuī" "shūn" "shuō"
+
+ "tā" "tāi" "tān" "tāng" "tāo"
+ "tē" "tēi" "tēng"
+ "tī" "tiān" "tiāo" "tiē" "tīng"
+ "tōng" "tōu"
+ "tū" "tuān" "tuī" "tūn" "tuō"
+
+ "wā" "wāi" "wān" "wāng"
+ "wēi" "wēn" "wēng"
+ "wō"
+ "wū"
+
+ "xī" "xiā" "xiān" "xiāng" "xiāo" "xiē" "xīn" "xīng" "xiōng" "xiū"
+ "xū" "xuān" "xuē" "xūn"
+
+ "yā" "yān" "yāng" "yāo"
+ "yē"
+ "yī" "yīn" "yīng"
+ "yō" "yōng" "yōu"
+ "yū" "yuān" "yuē" "yūn"
+
+ "zā" "zāi" "zān" "zāng" "zāo"
+ "zē" "zēi" "zēn" "zēng"
+ "zī"
+ "zōng" "zōu"
+ "zū" "zuān" "zuī" "zūn" "zuō"
+
+ "zhā" "zhāi" "zhān" "zhāng" "zhāo"
+ "zhē" "zhēi" "zhēn" "zhēng"
+ "zhī"
+ "zhōng" "zhōu"
+ "zhū" "zhuā" "zhuāi" "zhuān" "zhuāng" "zhuī" "zhūn" "zhuō"))
+
+;; This function converts e.g.
+;;
+;; "zhuō"
+;;
+;; into
+;;
+;; (("zhuo4" ["zhuò"])
+;; ("zhuo3" ["zhuǒ"])
+;; ("zhuo2" ["zhuó"])
+;; ("zhuo1" ["zhuō"]))
+;;
+(defun quail-make-sisheng-rules (syllable)
+ (let ((case-fold-search t)
+ vowel-match
+ vowel-list
+ input-vowel
+ base-key
+ key
+ value
+ key-value-list
+ (i 1))
+ (string-match sisheng-regexp syllable)
+ (setq vowel-match (downcase (match-string 0 syllable)))
+ (setq vowel-list
+ (cdr (assoc-string vowel-match sisheng-vowel-table)))
+ (setq input-vowel (car vowel-list))
+ (setq base-key (replace-match input-vowel nil nil syllable))
+ (while (<= i 4)
+ (setq key (concat base-key (number-to-string i)))
+ (setq value (vector (replace-match (nth i vowel-list) nil nil syllable)))
+ (push (list key value) key-value-list)
+ (setq i (1+ i)))
+ key-value-list))
+
+;; Set up sisheng input method.
+;;
+(quail-define-package
+ "chinese-sisheng" ; name
+ "Chinese" ; language
+ "ǚ" ; title
+ t ; guidance
+ "Sìshēng input method for pīnyīn transliteration of Chinese.
+
+Examples: shuang1 -> shuāng
+ Lv3 -> Lǚ
+ AN4 -> ÀN
+
+Use the fifth (unstressed) tone for syllables containing `ü'
+without a tone mark.
+
+Example: nve5 -> nüe
+" ; docstring
+ nil ; translation-keys
+ t ; forget-last-selection
+ nil ; deterministic
+ nil ; kbd-translate
+ nil ; show-layout
+ nil ; create-decode-map
+ nil ; maximum-shortest
+ nil ; overlay-plist
+ nil ; update-translation-function
+ nil ; conversion-keys
+ t ; simple
+ )
+
+;; Call quail-make-sisheng-rules for all syllables in sisheng-syllable-table.
+;;
+(let (sisheng-list)
+ (dolist (syllable sisheng-syllable-table)
+ (setq sisheng-list
+ (append (quail-make-sisheng-rules syllable)
+ sisheng-list)))
+
+ (dolist (syllable sisheng-syllable-table)
+ (setq sisheng-list
+ (append (quail-make-sisheng-rules (upcase-initials syllable))
+ sisheng-list)))
+
+ (dolist (syllable sisheng-syllable-table)
+ (setq sisheng-list
+ (append (quail-make-sisheng-rules (upcase syllable))
+ sisheng-list)))
+
+ (eval `(quail-define-rules
+ ,@sisheng-list
+
+ ("lv5" ["lü"])
+ ("lve5" ["lüe"])
+ ("nv5" ["nü"])
+ ("nve5" ["nüe"])
+
+ ("Lv5" ["Lü"])
+ ("Lve5" ["Lüe"])
+ ("Nv5" ["Nü"])
+ ("Nve5" ["Nüe"])
+
+ ("LV5" ["LÜ"])
+ ("LVE5" ["LÜE"])
+ ("NV5" ["NÜ"])
+ ("NVE5" ["NÜE"]))))
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; sisheng.el ends here
diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el
new file mode 100644
index 00000000000..ba1d37cb9a9
--- /dev/null
+++ b/lisp/leim/quail/slovak.el
@@ -0,0 +1,479 @@
+;;; slovak.el --- Quail package for inputting Slovak -*-coding: utf-8;-*-
+
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
+
+;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>
+;; Milan Zamazal <pdm@zamazal.org>
+;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Keywords: i18n, multilingual, input method, Slovak
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines the following Slovak keyboards:
+;; - standard Slovak keyboard
+;; - three Slovak keyboards for programmers
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "slovak" "Slovak" "SK" t
+ "Standard Slovak keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ľ)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ť)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("-" ?=)
+ ("_" ?%)
+ ("=" ?')
+ ("[" ?ú)
+ ("{" ?/)
+ ("]" ?ä)
+ ("}" ?\()
+ ("\\" ?ň)
+ ("|" ?\))
+ (";" ?ô)
+ (":" ?\")
+ ("'" ?§)
+ ("\"" ?!)
+ ("<" ??)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("`" ?\;)
+ ("~" ?^)
+ ("y" ?z)
+ ("z" ?y)
+ ("Y" ?Z)
+ ("Z" ?Y)
+ ("=a" ?á)
+ ("+a" ?ä)
+ ("+=a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("=l" ?ĺ)
+ ("+l" ?ľ)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+o" ?ô)
+ ("~o" ?ô)
+ ("+=o" ?ö)
+ ("=r" ?ŕ)
+ ("+r" ?ř)
+ ("=s" ?ß)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("+u" ?ů)
+ ("+=u" ?ü)
+ ("=z" ?ý)
+ ("+y" ?ž)
+ ("=A" ?Á)
+ ("+A" ?Ä)
+ ("+=A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("=L" ?Ĺ)
+ ("+L" ?Ľ)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+O" ?Ô)
+ ("~O" ?Ô)
+ ("+=O" ?Ö)
+ ("=R" ?Ŕ)
+ ("+R" ?Ř)
+ ("=S" ?ß)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("+U" ?Ů)
+ ("+=U" ?Ü)
+ ("=Z" ?Ý)
+ ("+Y" ?Ž)
+ ("=q" ?`)
+ ("=2" ?@)
+ ("=3" ?#)
+ ("=4" ?$)
+ ("=5" ?%)
+ ("=6" ?^)
+ ("=7" ?&)
+ ("=8" ?*)
+ ("=9" ?\()
+ ("=0" ?\))
+ ("+1" ?!)
+ ("+2" ?@)
+ ("+3" ?#)
+ ("+4" ?$)
+ ("+5" ?%)
+ ("+6" ?^)
+ ("+7" ?&)
+ ("+8" ?*)
+ ("+9" ?\()
+ ("+0" ?\))
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+
+(quail-define-package
+ "slovak-prog-1" "Slovak" "SK" t
+ "Slovak (non-standard) keyboard for programmers #1.
+
+All digits except of `1' are replaced by Slovak characters as on the standard
+Slovak keyboard.
+Dead keys are on `[', `[[', and `[[['.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("[[[[" ?\[)
+ ("2" ?ľ)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ť)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("[a" ?á)
+ ("[[a" ?ä)
+ ("[[[a" ?ä)
+ ("[c" ?č)
+ ("[[c" ?č)
+ ("[d" ?ď)
+ ("[[d" ?ď)
+ ("[e" ?é)
+ ("[[e" ?ě)
+ ("[i" ?í)
+ ("[l" ?ĺ)
+ ("[[l" ?ľ)
+ ("[n" ?ň)
+ ("[[n" ?ň)
+ ("[o" ?ó)
+ ("[[o" ?ô)
+ ("[[[o" ?ö)
+ ("[r" ?ŕ)
+ ("[[r" ?ř)
+ ("[s" ?š)
+ ("[[s" ?š)
+ ("[[[s" ?ß)
+ ("[t" ?ť)
+ ("[[t" ?ť)
+ ("[u" ?ú)
+ ("[[u" ?ů)
+ ("[[[u" ?ü)
+ ("[y" ?ý)
+ ("[z" ?ž)
+ ("[[z" ?ž)
+ ("[A" ?Á)
+ ("[[A" ?Ä)
+ ("[[[A" ?Ä)
+ ("[C" ?Č)
+ ("[[C" ?Č)
+ ("[D" ?Ď)
+ ("[[D" ?Ď)
+ ("[E" ?É)
+ ("[[E" ?Ě)
+ ("[I" ?Í)
+ ("[L" ?Ĺ)
+ ("[[L" ?Ľ)
+ ("[N" ?Ň)
+ ("[[N" ?Ň)
+ ("[O" ?Ó)
+ ("[[O" ?Ô)
+ ("[[[O" ?Ö)
+ ("[R" ?Ŕ)
+ ("[[R" ?Ř)
+ ("[S" ?Š)
+ ("[[S" ?Š)
+ ("[[[S" ?ß)
+ ("[T" ?Ť)
+ ("[[T" ?Ť)
+ ("[U" ?Ú)
+ ("[[U" ?Ů)
+ ("[[[U" ?Ü)
+ ("[Y" ?Ý)
+ ("[Z" ?Ž)
+ ("[[Z" ?Ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+
+(quail-define-package
+ "slovak-prog-2" "Slovak" "SK" t
+ "Slovak (non-standard) keyboard for programmers #2.
+
+All digits except of `1' are replaced by Slovak characters as on the standard
+Slovak keyboard.
+Dead keys are on `=' and `+'.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("2" ?ľ)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ť)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("==" ?=)
+ ("++" ?+)
+ ("=+" ?+)
+ ("=2" ?2)
+ ("=3" ?3)
+ ("=4" ?4)
+ ("=5" ?5)
+ ("=6" ?6)
+ ("=7" ?7)
+ ("=8" ?8)
+ ("=9" ?9)
+ ("=0" ?0)
+ ("+2" ?2)
+ ("+3" ?3)
+ ("+4" ?4)
+ ("+5" ?5)
+ ("+6" ?6)
+ ("+7" ?7)
+ ("+8" ?8)
+ ("+9" ?9)
+ ("+0" ?0)
+ ("=a" ?á)
+ ("+a" ?ä)
+ ("+=a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("=l" ?ĺ)
+ ("+l" ?ľ)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+o" ?ô)
+ ("+=o" ?ö)
+ ("=r" ?ŕ)
+ ("+r" ?ř)
+ ("=s" ?ß)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("+u" ?ů)
+ ("+=u" ?ü)
+ ("=y" ?ý)
+ ("+z" ?ž)
+ ("=A" ?Á)
+ ("+A" ?Ä)
+ ("+=A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("=L" ?Ĺ)
+ ("+L" ?Ľ)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+O" ?Ô)
+ ("+=O" ?Ö)
+ ("=R" ?Ŕ)
+ ("+R" ?Ř)
+ ("=S" ?ß)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("+U" ?Ů)
+ ("+=U" ?Ü)
+ ("=Y" ?Ý)
+ ("+Z" ?Ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+
+(quail-define-package
+ "slovak-prog-3" "Slovak" "SK" t
+ "Slovak (non-standard) keyboard for programmers #3.
+
+Dead keys are on `[', `[[', `[[[', and `]'.
+All other keys are the same as on standard US keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("[[[[" ?\[)
+ ("[]" ?\])
+ ("][" ?\[)
+ ("]]" ?\])
+ ("[a" ?á)
+ ("[[a" ?ä)
+ ("[[[a" ?ä)
+ ("]a" ?ä)
+ ("][a" ?ä)
+ ("[c" ?č)
+ ("[[c" ?č)
+ ("]c" ?č)
+ ("[d" ?ď)
+ ("[[d" ?ď)
+ ("]d" ?ď)
+ ("[e" ?é)
+ ("[[e" ?ě)
+ ("]e" ?ě)
+ ("[i" ?í)
+ ("[l" ?ĺ)
+ ("[[l" ?ľ)
+ ("]l" ?ľ)
+ ("[n" ?ň)
+ ("[[n" ?ň)
+ ("]n" ?ň)
+ ("[[o" ?ô)
+ ("[[[o" ?ö)
+ ("[o" ?ó)
+ ("]o" ?ô)
+ ("][o" ?ö)
+ ("[r" ?ŕ)
+ ("[[r" ?ř)
+ ("]r" ?ř)
+ ("[s" ?š)
+ ("[[s" ?š)
+ ("[[[s" ?ß)
+ ("]s" ?š)
+ ("[t" ?ť)
+ ("[[t" ?ť)
+ ("]t" ?ť)
+ ("[u" ?ú)
+ ("[[u" ?ů)
+ ("[[[u" ?ü)
+ ("]u" ?ů)
+ ("][u" ?ü)
+ ("[y" ?ý)
+ ("[z" ?ž)
+ ("[[z" ?ž)
+ ("]z" ?ž)
+ ("[A" ?Á)
+ ("[[A" ?Ä)
+ ("[[[A" ?Ä)
+ ("]A" ?Ä)
+ ("][A" ?Ä)
+ ("[C" ?Č)
+ ("[[C" ?Č)
+ ("]C" ?Č)
+ ("[D" ?Ď)
+ ("[[D" ?Ď)
+ ("]D" ?Ď)
+ ("[E" ?É)
+ ("[[E" ?Ě)
+ ("]E" ?Ě)
+ ("[I" ?Í)
+ ("[L" ?Ĺ)
+ ("[[L" ?Ľ)
+ ("]L" ?Ľ)
+ ("[N" ?Ň)
+ ("[[N" ?Ň)
+ ("]N" ?Ň)
+ ("[O" ?Ó)
+ ("[[O" ?Ô)
+ ("[[[O" ?Ö)
+ ("]O" ?Ô)
+ ("][O" ?Ö)
+ ("[R" ?Ŕ)
+ ("[[R" ?Ř)
+ ("]R" ?Ř)
+ ("[S" ?Š)
+ ("[[S" ?Š)
+ ("[[[S" ?ß)
+ ("]S" ?Š)
+ ("[T" ?Ť)
+ ("[[T" ?Ť)
+ ("]T" ?Ť)
+ ("[U" ?Ú)
+ ("[[U" ?Ů)
+ ("[[[U" ?Ü)
+ ("]U" ?Ů)
+ ("][U" ?Ü)
+ ("[Y" ?Ý)
+ ("[Z" ?Ž)
+ ("[[Z" ?Ž)
+ ("]Z" ?Ž)
+ ([kp-1] ?1)
+ ([kp-2] ?2)
+ ([kp-3] ?3)
+ ([kp-4] ?4)
+ ([kp-5] ?5)
+ ([kp-6] ?6)
+ ([kp-7] ?7)
+ ([kp-8] ?8)
+ ([kp-9] ?9)
+ ([kp-0] ?0)
+ ([kp-add] ?+))
+
+;;; slovak.el ends here
diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el
new file mode 100644
index 00000000000..50a586cc77e
--- /dev/null
+++ b/lisp/leim/quail/symbol-ksc.el
@@ -0,0 +1,202 @@
+;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Korean, Hangul
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 94.10.24 Written for Mule Ver.2.0 (koaunghi.un@zdv.uni-tuebingen.de)
+;;; 94.11.04 Updated for Mule Ver.2.1 (koaunghi.un@zdv.uni-tuebingen.de)
+;;; 96.09.23 Updated for emacs-19.33-beta (koaunghi.un@zdv.uni-tuebingen.de)
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'korea-util)
+
+(quail-define-package
+ "korean-symbol" "Korean" "심벌" t
+ "한글심벌입력표:
+ 【(】괄호열기【arrow】화살【sex】♂♀【index】첨자 【accent】악센트
+ 【)】괄호닫기【music】음악【dot】점 【quote】따옴표【xtext】§※¶¡¿
+ 【Unit】℃Å¢℉【math】수학기호【pic】상형문자【line】선문자
+ 【unit】단위 【frac】분수 【textline】­―∥\∼
+ 【wn】㈜【ks】㉿【No】№【㏇】㏇ 【dag】† 【ddag】‡【percent】‰
+ 【am】㏂【pm】㏘【™】™【Tel】℡【won】₩ 【yen】¥ 【pound】£
+ 【Eng】ABC… 【enum】012… 【Russ】АБВ…【Greek】ΑΒΓ…
+ 【eng】abc… 【easc】영어ASCII【russ】абв…【greek】αβγ…
+ 【Rom】ⅠⅡⅢ… 【Scan】ÆЪ… 【hira】ぁあぃ
+ 【rom】ⅰⅱⅲ… 【scan】æđð… 【kata】ァアィ
+ 【ojaso】㉠∼㉭【pjaso】㈀∼㈍【oeng】ⓐ∼ⓩ【peng】⒜∼⒵
+ 【ogana】㉮∼㉻【pgana】㈎∼㈛【onum】①∼⑮【pnum】⑴∼⒂
+ 【자소】2벌식 + ㅥ(S) ㅿ(t_) ㆁ(D) ㆀ(DD) ㅱ(aD) ㆆ(_d) ㆅ(G) ㆍ(uk)")
+
+(quail-define-rules
+ ("(" "〔〈《「『【")
+ (")" "〕〉》」』】")
+ ("math" "±×÷≠≤≥∞∴∠⊥⌒∂∇≡≒〓≪≫√∽∝∵∫∬∈∋⊆⊇⊂⊃∪∩∧∨¬⇒⇔∀∃∮∑∏")
+ ("pic" "☆★○●◎◇◆□■△▲▽▼◁◀▷▶♤♠♡♥♧♣⊙◈▣◐◑▒▤▥▨▧▦▩♨☏☎☜☞¤")
+ ("arrow" "→←↑↓↔↕↗↙↖↘")
+ ("music" "♭♩♪♬")
+ ("won" "₩")
+ ("yen" "¥")
+ ("pound" "£")
+ ("xtext" "§※¶¡¿")
+ ("dot" "·‥…¨ː")
+ ("quote" "、。〃‘’“”°′″´˝")
+ ("textline" "­―∥\∼")
+ ("Unit" "℃Å¢℉")
+ ("sex" "♂♀")
+ ("accent" "~ˇ˘˚˙¸˛")
+ ("percent" "‰")
+ ("dag" "†")
+ ("ddag" "‡")
+ ("wn" "㈜")
+ ("ks" "㉿")
+ ("No" "№")
+ ("Co" "㏇")
+ ("TM" "™")
+ ("am" "㏂")
+ ("pm" "㏘")
+ ("Tel" "℡")
+ ("easc" "!"#$%&'()*+,-./:;<=>?@[]^_`{|} ̄")
+ ("enum" "0123456789")
+ ("Eng" "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ ("eng" "abcdefghijklmnopqrstuvwxyz")
+ ("r" "ㄱ")
+ ("R" "ㄲ")
+ ("rt" "ㄳ")
+ ("s" "ㄴ")
+ ("sw" "ㄵ")
+ ("sg" "ㄶ")
+ ("e" "ㄷ")
+ ("E" "ㄸ")
+ ("f" "ㄹ")
+ ("fr" "ㄺ")
+ ("fa" "ㄻ")
+ ("fq" "ㄼ")
+ ("ft" "ㄽ")
+ ("fx" "ㄾ")
+ ("fv" "ㄿ")
+ ("fg" "ㅀ")
+ ("a" "ㅁ")
+ ("q" "ㅂ")
+ ("Q" "ㅃ")
+ ("qt" "ㅄ")
+ ("t" "ㅅ")
+ ("T" "ㅆ")
+ ("d" "ㅇ")
+ ("w" "ㅈ")
+ ("W" "ㅉ")
+ ("c" "ㅊ")
+ ("z" "ㅋ")
+ ("x" "ㅌ")
+ ("v" "ㅍ")
+ ("g" "ㅎ")
+ ("k" "ㅏ")
+ ("o" "ㅐ")
+ ("i" "ㅑ")
+ ("O" "ㅒ")
+ ("j" "ㅓ")
+ ("p" "ㅔ")
+ ("u" "ㅕ")
+ ("P" "ㅖ")
+ ("h" "ㅗ")
+ ("hk" "ㅘ")
+ ("ho" "ㅙ")
+ ("hl" "ㅚ")
+ ("y" "ㅛ")
+ ("n" "ㅜ")
+ ("nj" "ㅝ")
+ ("np" "ㅞ")
+ ("nl" "ㅟ")
+ ("b" "ㅠ")
+ ("m" "ㅡ")
+ ("ml" "ㅢ")
+ ("l" "ㅣ")
+ ("S" "ㅥ")
+ ("se" "ㅦ")
+ ("st" "ㅧ")
+ ("st_" "ㅨ")
+ ("frt" "ㅩ")
+ ("fqt" "ㅫ")
+ ("fe" "ㅪ")
+ ("ft_" "ㅬ")
+ ("f_d" "ㅭ")
+ ("aq" "ㅮ")
+ ("at" "ㅯ")
+ ("at_" "ㅰ")
+ ("aD" "ㅱ")
+ ("qr" "ㅲ")
+ ("qe" "ㅳ")
+ ("qtr" "ㅴ")
+ ("qte" "ㅵ")
+ ("qw" "ㅶ")
+ ("qx" "ㅷ")
+ ("qD" "ㅸ")
+ ("QD" "ㅹ")
+ ("tr" "ㅺ")
+ ("ts" "ㅻ")
+ ("te" "ㅼ")
+ ("tq" "ㅽ")
+ ("tw" "ㅾ")
+ ("t_" "ㅿ")
+ ("DD" "ㆀ")
+ ("D" "ㆁ")
+ ("Dt" "ㆂ")
+ ("Dt_" "ㆃ")
+ ("vD" "ㆄ")
+ ("G" "ㆅ")
+ ("_d" "ㆆ")
+ ("yi" "ㆇ")
+ ("yO" "ㆈ")
+ ("yl" "ㆉ")
+ ("bu" "ㆊ")
+ ("bP" "ㆋ")
+ ("bl" "ㆌ")
+ ("uk" "ㆍ")
+ ("ukl" "ㆎ")
+ ("Rom" "ⅠⅡⅢⅣⅤⅥⅦⅧⅨⅩ")
+ ("rom" "ⅰⅱⅲⅳⅴⅵⅶⅷⅸⅹ")
+ ("Greek" "ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ")
+ ("greek" "αβγδεζηθικλμνξοπρστυφχψω")
+ ("line" "─│┌┐┘└├┬┤┴┼━┃┏┓┛┗┣┳┫┻╋┠┯┨┷┿┝┰┥┸╂┒┑┚┙┖┕┎┍┞┟┡┢┦┧┩┪┭┮┱┲┵┶┹┺┽┾╀╁╃╄╅╆╇╈╉╊")
+ ("unit" "㎕㎖㎗ℓ㎘㏄㎣㎤㎥㎦㎙㎚㎛㎜㎝㎞㎟㎠㎡㎢㏊㎍㎎㎏㏏㎈㎉㏈㎧㎨㎰㎱㎲㎳㎴㎵㎶㎷㎸㎹㎀㎁㎂㎃㎄㎺㎻㎼㎽㎾㎿㎐㎑㎒㎓㎔Ω㏀㏁㎊㎋㎌㏖㏅㎭㎮㎯㏛㎩㎪㎫㎬㏝㏐㏓㏃㏉㏜㏆")
+ ("Scan" "ÆЪĦIJĿŁØŒºÞŦŊ")
+ ("ojaso" "㉠㉡㉢㉣㉤㉥㉦㉧㉨㉩㉪㉫㉬㉭")
+ ("ogana" "㉮㉯㉰㉱㉲㉳㉴㉵㉶㉷㉸㉹㉺㉻")
+ ("oeng" "ⓐⓑⓒⓓⓔⓕⓖⓗⓘⓙⓚⓛⓜⓝⓞⓟⓠⓡⓢⓣⓤⓥⓦⓧⓨⓩ")
+ ("onum" "①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮")
+ ("frac" "½⅓⅔¼¾⅛⅜⅝⅞")
+ ("scan" "æđðħıijĸŀłøœßþŧŋʼn")
+ ("pjaso" "㈀㈁㈂㈃㈄㈅㈆㈇㈈㈉㈊㈋㈌㈍>")
+ ("pgana" "㈎㈏㈐㈑㈒㈓㈔㈕㈖㈗㈘㈙㈚㈛")
+ ("peng" "⒜⒝⒞⒟⒠⒡⒢⒣⒤⒥⒦⒧⒨⒩⒪⒫⒬⒭⒮⒯⒰⒱⒲⒳⒴⒵")
+ ("pnum" "⑴⑵⑶⑷⑸⑹⑺⑻⑼⑽⑾⑿⒀⒁⒂")
+ ("index" "¹²³⁴ⁿ₁₂₃₄")
+ ("hira" "ぁあぃいぅうぇえぉおかがきぎくぐけげこごさざしじすずせぜそぞただちぢっつづてでとどなにぬねのはばぱひびぴふぶぷへべぺほぼぽまみむめもゃやゅゆょよらりるれろゎわゐゑをん")
+ ("kata" "ァアィイゥウェエォオカガキギクグケゲコゴサザシジスズセゼソゾタダチヂッツヅテデトドナニヌネノハバパヒビピフブプヘベペホボポマミムメモャヤュユョヨラリルレロヮワヰヱヲンヴヵヶ")
+ ("Russ" "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ")
+ ("russ" "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"))
+
+;;; symbol-ksc.el ends here
diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el
new file mode 100644
index 00000000000..02f8b78d76b
--- /dev/null
+++ b/lisp/leim/quail/thai.el
@@ -0,0 +1,112 @@
+;;; thai.el --- Quail package for inputting Thai characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Thai
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+
+(defmacro thai-generate-quail-map (translation-table)
+ (let (map)
+ (dotimes (i (length translation-table))
+ (let ((trans (aref translation-table i)))
+ (when (not (eq trans 0))
+ (if (> (length trans) 1)
+ (setq trans (vector trans))
+ (setq trans (aref trans 0)))
+ (setq map (cons (list (char-to-string i) trans) map)))))
+ `(quail-define-rules ,@map)))
+
+;; Thai Kesmanee keyboard support.
+
+(quail-define-package
+ "thai-kesmanee" "Thai" "กก>" t
+ "Thai Kesmanee input method with TIS620 keyboard layout
+
+The difference from the ordinal Thai keyboard:
+ `฿' and `๏' are assigned to `\\' and `|' respectively,
+ `ฃ' and `ฅ' are assigned to `\\=`' and `~' respectively,
+ Don't know where to assign characters `๚' and `๛'."
+ nil t t t t nil nil nil nil nil t)
+
+(thai-generate-quail-map
+ [
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+;; This data is quite old.
+;; 0 "#" "." "๒" "๓" "๔" "ั้" "ง" ; SPC .. '
+;; "๖" "๗" "๕" "๙" "ม" "ข" "ใ" "ฝ" ; ( .. /
+;; "จ" "ล" "/" "_" "ภ" "ถ" "ุ" "ึ" ; 0 .. 7
+;; "ค" "ต" "ซ" "ว" "ฒ" "ช" "ฬ" "ฦ" ; 8 .. ?
+;; "๑" "ฤ" "ฺ" "ฉ" "ฏ" "ฎ" "โ" "ฌ" ; @ .. G
+;; "็" "ณ" "๋" "ษ" "ศ" "๎" "์" "ฯ" ; H .. O
+;; "ญ" "๐" "ฑ" "ฆ" "ธ" "๊" "ฮ" "\"" ; P .. W
+;; ")" "ํ" "(" "บ" "฿" "ล" "ู" "๘" ; X .. _
+;; "ฃ" "ฟ" "ิ" "แ" "ก" "ำ" "ด" "เ" ; ` .. g
+;; "้" "ร" "่" "า" "ส" "ท" "ื" "น" ; h .. o
+;; "ย" "ๆ" "พ" "ห" "ะ" "ี" "อ" "ไ" ; p .. w
+;; "ป" "ั" "ผ" "ฐ" "๏" "," "ฅ" 0 ; x .. DEL
+;; This is the correct data nowadays.
+ 0 "+" "." "๒" "๓" "๔" "฿" "ง" ; SPC .. '
+ "๖" "๗" "๕" "๙" "ม" "ข" "ใ" "ฝ" ; ( .. /
+ "จ" "ๅ" "/" "-" "ภ" "ถ" "ุ" "ึ" ; 0 .. 7
+ "ค" "ต" "ซ" "ว" "ฒ" "ช" "ฬ" "ฦ" ; 8 .. ?
+ "๑" "ฤ" "ฺ" "ฉ" "ฏ" "ฎ" "โ" "ฌ" ; @ .. G
+ "็" "ณ" "๋" "ษ" "ศ" "?" "์" "ฯ" ; H .. O
+ "ญ" "๐" "ฑ" "ฆ" "ธ" "๊" "ฮ" "\"" ; P .. W
+ ")" "ํ" "(" "บ" "ฃ" "ล" "ู" "๘" ; X .. _
+ "_" "ฟ" "ิ" "แ" "ก" "ำ" "ด" "เ" ; ` .. g
+ "้" "ร" "่" "า" "ส" "ท" "ื" "น" ; h .. o
+ "ย" "ๆ" "พ" "ห" "ะ" "ี" "อ" "ไ" ; p .. w
+ "ป" "ั" "ผ" "ฐ" "ฅ" "," "%" 0 ; x .. DEL
+ ])
+
+
+;; Thai Pattachote keyboard support.
+
+(quail-define-package
+ "thai-pattachote" "Thai" "กป>" t
+ "Thai Pattachote input method with TIS620 keyboard layout"
+ nil t t t t nil nil nil nil nil t)
+
+(thai-generate-quail-map
+ [
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 "+" "ฑ" "/" "," "?" "_" "ข" ; SPC .. '
+ "(" ")" "." "%" "ะ" "๑" "จ" "พ" ; ( .. /
+ "๐" "=" "๒" "๓" "๔" "๕" "ู" "๗" ; 0 .. 7
+ "๘" "๙" "ฆ" "ไ" "ฟ" "๖" "ฒ" "ฬ" ; 8 .. ?
+ "\"" "๋" "ั" "ฐ" "ำ" "ๆ" "ณ" "์" ; @ .. G
+ "ื" "ซ" "ผ" "ช" "โ" "ฮ" "ศ" "ถ" ; H .. O
+ "ฒ" "๊" "ญ" "ธ" "ษ" "ฝ" "ภ" "ฤ" ; P .. W
+ "ฎ" "ึ" "ฎ" "ใ" "ฺ" "ฒ" "ุ" "-" ; X .. _
+ "ฃ" "้" "ิ" "ล" "ง" "ย" "ก" "ั" ; ` .. g
+ "ี" "ม" "า" "น" "เ" "ส" "ค" "ว" ; h .. o
+ "แ" "็" "อ" "ท" "ร" "ด" "ห" "ต" ; p .. w
+ "ป" "่" "บ" "ฯ" "ํ" "ฦ" "ฅ" 0 ; x .. DEL
+ ])
+
+;;; thai.el ends here
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
new file mode 100644
index 00000000000..93cb65b8d43
--- /dev/null
+++ b/lisp/leim/quail/tibetan.el
@@ -0,0 +1,457 @@
+;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: utf-8-emacs;-*-
+
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, Tibetan
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;; Author: Toru TOMABECHI <Toru.Tomabechi@orient.unil.ch>
+
+;; Created: Feb. 17. 1997
+
+;; History:
+;; 1997.03.13 Support for inputting special signs and punctuation added.
+;; (Only Ext. Wylie input)
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'tibet-util)
+
+;; Now quail-current-key is set to Tibetan-Roman transcription. We
+;; set quail-current-str to the corresponding Tibetan string (composed
+;; if necessary). Both Wylie and TibKey input methods use this
+;; function.
+
+(defun quail-tibetan-update-translation (control-flag)
+ (if (numberp control-flag)
+ ;; Non-composable-character typed.
+ (setq quail-current-str
+ (buffer-substring (overlay-start quail-overlay)
+ (overlay-end quail-overlay))
+ unread-command-events
+ (append
+ (substring quail-current-key control-flag)
+ unread-command-events))
+ ;; Special treatment of "-d..." and "-y...".
+ (if (string-match "^-[dy]" quail-current-key)
+ (setq quail-current-key (substring quail-current-key 1)))
+ (let ((str (tibetan-transcription-to-tibetan quail-current-key)))
+ ;; If quail-current-key is for punctuation, it can't be
+ ;; transcribed by tibetan-transcription-to-tibetan, thus STR
+ ;; contains ASCII string now. In that case, use the current
+ ;; characters set in quail-current-str.
+ (if (> (aref str 0) 255)
+ (setq quail-current-str (tibetan-compose-string str))
+ (or quail-current-str
+ (setq quail-current-str quail-current-key)))))
+ control-flag)
+
+;;; Wylie transcription based input methods.
+
+;; Special alist for `འ'. It must be treated as a subjoined
+;; consonant if it follows a consonant.
+;; * Removed by Tomabechi 2000/06/10 *
+;; 'a chung must be explicitly typed as a vowel ("fa")
+;; འ is now treated as normal base consonants
+;; (defconst tibetan-wylie-quote-alist '(("'" . ?འ)))
+
+;; Special alist to avoid default stacking.
+(defconst tibetan-wylie-non-stacking-alist
+ '(("-d" . "ད")
+ ("-y" . "ཡ")))
+
+;; Punctuation characters are not transcribed.
+
+(defconst tibetan-wylie-punctuation-alist
+ '(("." . " ")
+ (":" . "ཿ")
+ (" " . "་")
+ ("/" . "།")
+ ("//" . "༎")
+ ("////" . ["༎ ༎"])
+ ("$" . "༏")
+ ("/\"" . "༐") ; Not defined in Ext. Wylie.
+ ("&" . "༐")
+ (";" . "༑")
+ ("%" . "༔")
+ ("!" . "༈")
+ ("<" . "༼")
+ (">" . "༽")
+ ("@" . "྅")
+ ("*" . ["༄༅"])
+ ("#" . ["༄༅༅"])
+ ("^" . "༆")
+ ("0" . "༠")
+ ("1" . "༡")
+ ("2" . "༢")
+ ("3" . "༣")
+ ("4" . "༤")
+ ("5" . "༥")
+ ("6" . "༦")
+ ("7" . "༧")
+ ("8" . "༨")
+ ("9" . "༩")
+ ("-0" . "༳")
+ ("-1" . "༪")
+ ("-2" . "༫")
+ ("-3" . "༬")
+ ("-4" . "༭")
+ ("-5" . "༮")
+ ("-6" . "༯")
+ ("-7" . "༰")
+ ("-8" . "༱")
+ ("-9" . "༲")
+ ("|" . "ༀ༁༂༃༇༉༊༒༓༕༖༗༘༙༚༛༜༝༞༟༴༶༸༺༻༾༿྾྿࿀࿁࿂࿃࿄࿅࿆࿇࿈࿉࿊࿋࿌࿏")))
+
+(quail-define-package "tibetan-wylie" "Tibetan" "TIBw" t
+"Tibetan character input by Extended Wylie key assignment.
+
+ +-------------------------------------+
+ |ཀ་ k |ཁ་ kh |ག་ g |གྷ་ gh |ང་ ng| ི i ། /
+ |ཅ་ c |ཆ་ ch |ཇ་ j | |ཉ་ ny| ུ u ༎ //
+ |ཊ་ T |ཋ་ TH |ཌ་ D |ཌྷ་ DH |ཎ་ N | ེ e ༎ ༎ ////
+ |ཏ་ t |ཐ་ th |ད་ d |དྷ་ dh |ན་ n | ོ o ༑ ;
+ |པ་ p |ཕ་ ph |བ་ b |བྷ་ bh |མ་ m | ཻ ai (ee, E) ༏ $
+ |ཙ་ ts|ཚ་ tsh|ཛ་ dz |ཛྷ་ dzh|ཝ་ w | ཽ au (oo, O) ༐ &
+ |ཞ་ zh|ཟ་ z |འ་ \\=' | |ཡ་ y | ྀ I ༄༅ *
+ |ར་ r |ལ་ l |ཤ་ sh |ཥ་ SH |ས་ s | ཿ : ༄༅༅ #
+ |ཧ་ h |ཨ་ A |ཀྵ་ kSH| | | ཾ M ༼ ༽ < >
+ +-------------------------------------+ ༔ %
+ (The consonant ཨ་ must be typed explicitly.)
+
+ NOT SPECIFIED IN EXT. WYLIE:
+ +--------------------------------------------------------+
+ |ྂ = ~ |ྃ = \\=` |྄ = , |྅ = @ |༷ = _o|༵ = _O|༆ = ^|
+ +--------------------------------------------------------+
+ |ྈ = x |ྉ = X |྆ = v |྇ = V |ྊ = q |ྋ = Q |
+ +-----------------------------------------------+
+
+ SPECIAL KEYS
+ + : Consonant Stacking
+ (Consonant stacking for ordinary Tibetan is done automatically)
+ - : No Consonant Stacking
+ (To suppress automatic stacking for \"g-y\",
+ and to get da-drag in -r-d, -l-d .)
+ | : Special signs.
+
+ Tsheg is assigned to SPC. Space is assigned to period `.'.
+"
+ nil nil nil nil nil nil nil nil
+ 'quail-tibetan-update-translation)
+
+;; Here we build up a Quail map for a Tibetan sequence the whole of
+;; which can be one composition.
+;;
+;; A Tibetan syllable is typically structured as follows:
+;; [P] C [c+] V [M] [S [s]]
+;; ^^^^^^^^^^^^
+;; where P:prefix, C:base consonant, c:subjoined consonant,
+;; V:vowel, M:vowel modifier, S:suffix, s:post suffix.
+;; In this pattern, the part indicated by "^^^" can be one composition.
+
+;;; modified by Tomabechi 1999/12/10
+;;; modified by Tomabechi 2000/06/08
+;;; Allows infinite addition of vowels/modifiers
+;;; as specified in Unicode v.3
+(quail-install-map
+ (quail-map-from-table
+ '((base-state (tibetan-consonant-transcription-alist . svm-state)
+ (tibetan-precomposed-transcription-alist . svm-state)
+ (tibetan-wylie-non-stacking-alist . svm-state)
+ tibetan-subjoined-transcription-alist
+ tibetan-vowel-transcription-alist
+ tibetan-modifier-transcription-alist
+ tibetan-wylie-punctuation-alist)
+ (svm-state ;;(tibetan-wylie-quote-alist . vm-state)
+ (tibetan-vowel-transcription-alist . vm-state)
+ (tibetan-subjoined-transcription-alist . svm-state)
+ (tibetan-modifier-transcription-alist . m-state))
+ (vm-state (tibetan-vowel-transcription-alist . vm-state)
+ (tibetan-modifier-transcription-alist . m-state))
+ (m-state (tibetan-modifier-transcription-alist . m-state)))))
+
+;;;
+;;; TibKey key alignment based input method
+;;;
+
+(defconst tibetan-tibkey-to-transcription-alist
+ '(;; consonant
+ ("`" . "`") ; sna ldan
+ ("~" . "~") ; sna ldan + nada
+ ("q" . "k") ; ka
+ ("Q" ."kSH") ; kSHa
+ ("w" . "kh") ; kha
+ ("e" . "g") ; ga
+ ("r" . "ng") ; nga
+ ("t" . "c") ; ca
+ ("T" . "I") ; gi gu log
+ ("y" . "ch") ; cha
+ ("u" . "j") ; ja
+ ("i" . "ny") ; nya
+ ("o" . "t") ; ta
+ ("O" . "T") ; Ta
+ ("p" . "th") ; tha
+ ("P" . "TH") ; THa
+ ("[" . "d") ; da
+ ("{" . "D") ; Da
+ ("]" . "n") ; na
+ ("}" . "N") ; Na
+ ("a" . "p") ; pa
+ ("A" . "a") ; Vowel a (not used in original TibKey)
+ ("s" . "ph") ; pha
+ ("d" . "b") ; ba
+ ("f" . "m") ; ma
+ ("F" . "M") ; anusvara
+ ("g" . "u") ; zhabs kyu
+ ("G" . "i") ; gi gu
+ ("H" . ",") ; virama
+ ("j" . "o") ; naro
+ ("J" . "e") ; 'greng bu
+ ("k" . "ts") ; tsa
+ ("l" . "tsh") ; tsha
+ (";" . "dz") ; dza
+ ("'" . "w") ; wa
+ ("\"" . "+w") ; wa zur
+ ("z" . "zh") ; zha
+ ("x" . "z") ; za
+ ("c" . "'") ; 'a
+ ("C" . "+'") ; 'a chung
+ ("v" . "y") ; ya
+ ("V" . "+y") ; ya btags
+ ("b" . "r") ; ra
+ ("B" . "+r") ; ra btags
+ ("n" . "l") ; la
+ ("N" . "+l") ; la btags
+ ("m" . "sh") ; sha
+ ("M" . "SH") ; SHa
+ ("," . "s") ; sa
+ ("." . "h") ; ha
+ ("/" . "A") ; Aa
+ ;; subjoined
+ ("hq" . "+k") ; ka
+ ("hQ" ."+kSH") ; kSHa
+ ("hw" . "+kh") ; kha
+ ("he" . "+g") ; ga
+ ("hr" . "+ng") ; nga
+ ("ht" . "+c") ; ca
+ ("hy" . "+ch") ; cha
+ ("hu" . "+j") ; ja
+ ("hi" . "+ny") ; nya
+ ("ho" . "+t") ; ta
+ ("hO" . "+T") ; Ta
+ ("hp" . "+th") ; tha
+ ("hP" . "+TH") ; THa
+ ("h[" . "+d") ; da
+ ("h{" . "+D") ; Da
+ ("h]" . "+n") ; na
+ ("h}" . "+N") ; Na
+ ("ha" . "+p") ; pa
+ ("hs" . "+ph") ; pha
+ ("hd" . "+b") ; ba
+ ("hf" . "+m") ; ma
+ ("hk" . "+ts") ; tsa
+ ("hl" . "+tsh") ; tsha
+ ("h;" . "+dz") ; dza
+ ("h'" . "+w") ; wa
+ ("hz" . "+zh") ; zha
+ ("hx" . "+z") ; za
+ ("hc" . "+'") ; 'a
+ ("hv" . "+y") ; ya
+ ("hb" . "+r") ; ra
+ ("hn" . "+l") ; la
+ ("hm" . "+sh") ; sha
+ ("hM" . "+SH") ; SHa
+ ("h," . "+s") ; sa
+ ("h." . "+h") ; ha
+ ("h/" . "+A") ; Aa
+ ;; Special rule for `ཡ' to avoid stacking.
+ ("E" . "-y")
+ ))
+
+(defconst tibetan-consonant-tibkey-alist nil)
+(defconst tibetan-subjoined-tibkey-alist nil)
+(defconst tibetan-vowel-tibkey-alist nil)
+(defconst tibetan-modifier-tibkey-alist nil)
+(defconst tibetan-non-stacking-tibkey-alist nil)
+
+(let ((type-list '("consonant" "subjoined" "vowel" "modifier" "non-stacking"))
+ (tail tibetan-tibkey-to-transcription-alist)
+ elt)
+ (while tail
+ (setq elt (car tail) tail (cdr tail))
+ (let ((types type-list)
+ type transcription trans-alist tibkey-alist)
+ (while types
+ (setq type (car types) types (cdr types))
+ (setq trans-alist
+ (if (string= type "non-stacking")
+ 'tibetan-wylie-non-stacking-alist
+ (intern (format "tibetan-%s-transcription-alist" type)))
+ transcription
+ (cdr (assoc (cdr elt) (symbol-value trans-alist))))
+ (when transcription
+ (setq tibkey-alist (intern (format "tibetan-%s-tibkey-alist" type)))
+ (set tibkey-alist
+ (cons (cons (car elt) transcription)
+ (symbol-value tibkey-alist)))))
+ (or tibkey-alist
+ (error "No Tibetan transcription for %s" (cdr elt))))))
+
+(defconst tibetan-punctuation-tibkey-alist
+ '(("1" . "༡")
+ ("!" . "༄") ; nyi zla long
+ ("2" . "༢")
+ ("@" . "༅") ; nyi zla simple
+ ("3" . "༣")
+;;; ("#" )
+ ("4" . "༤")
+;;; ("$" )
+ ("5" . "༥")
+ ("%" . "༔")
+ ("6" . "༦")
+ ("^" . "༁")
+ ("7" . "༧")
+ ("8" . "༨")
+;;; ("*" ) ; avagraha, not supported yet
+ ("9" . "༩")
+ ("(" . "༼")
+ ("0" . "༠")
+ (")" . "༽")
+;;; ("-" ) ; emphatic, not yet supported
+;;; ("_" ) ; id.
+;;; ("=" ) ; special sign, not yet supported
+ ("+" . "༑")
+ ("\\" . "༏")
+ ("|" . "༈")
+ ("I" . "྅") ; avagraha
+ (":" . "ཿ")
+;;; (">" ?་) ; to be assigned to SPC
+ (">" . " ")
+ ("?" . "།")
+ ("??" . "༎")
+ ("????" . ["༎ ༎"])
+ (" " . "་")
+ ))
+
+;; Convert TibKey string to Tibetan-Roman transcription string.
+;; If there's no proper conversion, return nil.
+(defun quail-tibkey-to-transcription (tibkey)
+ (let ((len (length tibkey))
+ (i 0)
+ (trans-list nil))
+ (while (< i len)
+ (let ((last len)
+ trans)
+ (while (and (not trans) (> last i))
+ (or (setq trans (cdr (assoc (substring tibkey i last)
+ tibetan-tibkey-to-transcription-alist)))
+ (setq last (1- last))))
+ (if trans
+ (setq trans-list (cons trans trans-list)
+ i last)
+ (setq trans-list nil i len))))
+ (apply 'concat (nreverse trans-list))))
+
+(defvar quail-tibkey-characters nil)
+
+(defun quail-tibkey-update-translation (control-flag)
+ (if (integerp control-flag)
+ ;; Non-composable-character typed.
+ (setq quail-current-str
+ (buffer-substring (overlay-start quail-overlay)
+ (overlay-end quail-overlay))
+ unread-command-events
+ (append
+ (substring quail-current-key control-flag)
+ unread-command-events))
+ (let ((transcription (quail-tibkey-to-transcription quail-current-key)))
+ (if (> (length transcription) 0)
+ (let ((quail-current-key transcription))
+ (setq control-flag
+ (quail-tibetan-update-translation control-flag)))
+ (or quail-current-str
+ (setq quail-current-str quail-current-key)))))
+ control-flag)
+
+(quail-define-package "tibetan-tibkey" "Tibetan" "TIBt" t
+"Tibetan character input by TibKey key assignment.
+
+\(This implementation is still incomplete.
+ Therefore, the following key assignment is a provisional one.)
+
+ [NOT SHIFTED]
+
+ +-------------------------------------------------------+
+ |`ྃ|1༡|2༢|3༣|4༤|5༥|6༦|7༧|8༨|9༩|0༠|- |= |\\༈|
+ +-------------------------------------------------------+
+ |qཀ|wཁ|eག|rང|tཅ|yཆ|uཇ|iཉ|oཏ|pཐ|[ད|]ན|
+ +-----------------------------------------------+
+ |aཔ| sཕ| dབ|fམ|gུ|h |jོ|kཙ|lཚ|;ཛ|\\='ཝ|
+ +---------------------------------------------+
+ |zཞ|xཟ|cའ|vཡ|bར|nལ|mཤ|,ས|.ཧ|/ཨ|
+ +---------------------------------------+
+ The key `h' is used for consonant stacking.
+
+ [SHIFTED]
+
+ +----------------------------------------------------------+
+ |~ྂ|!༄|@༅|# |$ |%༔ |^༁|& |* |(༼|)༽|_ |+༑| |༈|
+ +----------------------------------------------------------+
+ |Qཀྵ|W |E |R |Tྀ|Y |U |I྅|Oཊ|Pཋ|{ཌ|}ཎ|
+ +-----------------------------------------------+
+ |A |S |D |Fཾ|Gི|H྄|Jེ|K |L |:ཿ|\"ྭ|
+ +-------------------------------------------+
+ |Z |X |Cཱ|Vྱ|Bྲ|Nླ|Mཥ|< |> |?། |
+ +---------------------------------------+
+
+ DIFFERENCE FROM THE ORIGINAL TIBKEY:
+
+ 1. Vowel `a' should be typed explicitly by the key `A'.
+ This is really inconvenient. But to make the coding
+ scheme clear, it is desirable to have an explicit
+ vowel sign for `a'.
+ 2. Tsheg is assigned to SPC key. You can input a space
+ by typing `>'.
+ 4. To avoid the default stacking and to obtain གཡ,
+ type `E' instead of `v' (=ཡ).
+ 3. There are many characters that are not supported in the
+ current implementation (especially special signs).
+ I hope I'll complete in a future revision.
+"
+ nil nil nil nil nil nil nil nil
+ 'quail-tibkey-update-translation)
+
+(quail-install-map
+ (quail-map-from-table
+ '((base-state (tibetan-consonant-tibkey-alist . s-state)
+ (tibetan-non-stacking-tibkey-alist . s-state)
+ tibetan-subjoined-tibkey-alist
+ tibetan-vowel-tibkey-alist
+ tibetan-modifier-tibkey-alist
+ tibetan-punctuation-tibkey-alist)
+ (s-state (tibetan-subjoined-tibkey-alist . s-state)
+ (tibetan-vowel-tibkey-alist . m-state))
+ (m-state tibetan-modifier-tibkey-alist))))
+
+;;; tibetan.el ends here
diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el
new file mode 100644
index 00000000000..7d2cd26c657
--- /dev/null
+++ b/lisp/leim/quail/uni-input.el
@@ -0,0 +1,138 @@
+;;; uni-input.el --- Hex Unicode input method
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provides an input method for entering characters by hex unicode in
+;; the form `uxxxx', similarly to the Yudit editor.
+
+;; This is not really a Quail method, but uses some Quail functions.
+;; There is probably A Better Way.
+
+;; You can get a similar effect by using C-q with
+;; `read-quoted-char-radix' set to 16.
+
+;; Note that this only allows you to enter BMP values unless someone
+;; extends it to use variable numbers of digits.
+
+;;; Code:
+
+(require 'quail)
+
+(defun ucs-input-insert-char (char)
+ (insert char)
+ (move-overlay quail-overlay (overlay-start quail-overlay) (point)))
+
+(defun ucs-input-method (key)
+ (if (or buffer-read-only
+ (and (/= key ?U) (/= key ?u)))
+ (list key)
+ (quail-setup-overlays nil)
+ (ucs-input-insert-char key)
+ (let ((modified-p (buffer-modified-p))
+ (buffer-undo-list t)
+ (input-method-function nil)
+ (echo-keystrokes 0)
+ (help-char nil)
+ (events (list key))
+ (str " "))
+ (unwind-protect
+ (catch 'non-digit
+ (progn
+ (dotimes (i 4)
+ (let ((seq (read-key-sequence nil))
+ key)
+ (if (and (stringp seq)
+ (= 1 (length seq))
+ (setq key (aref seq 0))
+ (memq key '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?a
+ ?b ?c ?d ?e ?f ?A ?B ?C ?D ?E ?F)))
+ (progn
+ (push key events)
+ (ucs-input-insert-char key))
+ (quail-delete-region)
+ (throw 'non-digit (append (reverse events)
+ (listify-key-sequence seq))))))
+ (quail-delete-region)
+ (let ((n (string-to-number (apply 'string
+ (cdr (nreverse events)))
+ 16)))
+ (if (characterp n)
+ (list n)))))
+ (quail-delete-overlays)
+ (set-buffer-modified-p modified-p)
+ (run-hooks 'input-method-after-insert-chunk-hook)))))
+
+;;;###autoload
+(defun ucs-input-activate (&optional arg)
+ "Activate UCS input method.
+With ARG, activate UCS input method if and only if ARG is positive.
+
+While this input method is active, the variable
+`input-method-function' is bound to the function `ucs-input-method'."
+ (if (and arg
+ (< (prefix-numeric-value arg) 0))
+ (unwind-protect
+ (progn
+ (quail-hide-guidance)
+ (quail-delete-overlays)
+ (setq describe-current-input-method-function nil))
+ (kill-local-variable 'input-method-function))
+ (setq deactivate-current-input-method-function 'ucs-input-deactivate)
+ (setq describe-current-input-method-function 'ucs-input-help)
+ (quail-delete-overlays)
+ (if (eq (selected-window) (minibuffer-window))
+ (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer))
+ (set (make-local-variable 'input-method-function)
+ 'ucs-input-method)))
+
+(defun ucs-input-deactivate ()
+ "Deactivate UCS input method."
+ (interactive)
+ (ucs-input-activate -1))
+
+(define-obsolete-function-alias
+ 'ucs-input-inactivate
+ 'ucs-input-deactivate "24.3")
+
+(defun ucs-input-help ()
+ (interactive)
+ (with-output-to-temp-buffer "*Help*"
+ (princ "\
+Input method: ucs (mode line indicator:U+)
+
+Input as Unicode: U<hex> or u<hex>, where <hex> is a four-digit hex number.")))
+
+;; The file leim-list.el contains the following call.
+;; (register-input-method "ucs" "UTF-8" 'ucs-input-activate "U+"
+;; "Unicode input as hex in the form Uxxxx.")
+
+(provide 'uni-input)
+
+;; Local Variables:
+;; generated-autoload-load-name: "quail/uni-input"
+;; End:
+
+;;; uni-input.el ends here
diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el
new file mode 100644
index 00000000000..879fba4da2c
--- /dev/null
+++ b/lisp/leim/quail/viqr.el
@@ -0,0 +1,71 @@
+;;; viqr.el --- Quail packages for inputting Vietnamese with VIQR system -*-coding: utf-8;-*-
+
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010, 2011
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
+
+;; Keywords: multilingual, input method, latin
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'quail)
+(require 'viet-util)
+
+;; `viet-viqr-alist' is an alist of Vietnamese characters vs
+;; corresponding VIQR strings. We create Quail map which maps VIQR
+;; strings to corresponding Vietnamese characters.
+
+(defmacro viet-quail-define-rules ()
+ (cons 'quail-define-rules
+ (let ((l viet-viqr-alist)
+ rules)
+ (while l
+ (setq rules (cons (list (cdr (car l)) (car (car l))) rules))
+ (setq l (cdr l)))
+ rules)))
+
+(quail-define-package
+ "vietnamese-viqr" "Vietnamese" "VQ" t
+ "Vietnamese input method with VIQR mnemonic system
+
+ effect | postfix | examples
+ ------------+---------+----------
+ breve | ( | a( -> ă
+ circumflex | ^ | a^ -> â
+ horn | + | o+ -> ơ
+ ------------+---------+----------
+ acute | \\=' | a\\=' -> á
+ grave | \\=` | a\\=` -> à
+ hook above | ? | a? -> ả
+ tilde | ~ | a~ -> ã
+ dot below | . | a. -> ạ
+ ------------+---------+----------
+ d bar | dd | dd -> đ
+ ------------+---------+----------
+ no compose | \\ | a\\. -> a.
+ ------------+---------+----------
+ combination| (~ | a(~ -> ẵ
+" nil t t nil nil t nil nil nil nil t)
+
+
+(viet-quail-define-rules)
+
+;;; viqr.el ends here
diff --git a/lisp/leim/quail/vntelex.el b/lisp/leim/quail/vntelex.el
new file mode 100644
index 00000000000..4ee6a47ae27
--- /dev/null
+++ b/lisp/leim/quail/vntelex.el
@@ -0,0 +1,428 @@
+;;; vntelex.el --- Quail package for Vietnamese by Telex method
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Werner Lemberg <wl@gnu.org>
+;; Keywords: multilingual, input method, Vietnamese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; based on the files VietnameseTelex.kmap (written by Nguyen Thanh
+;; Bien <biennt@linuxvn.com>) and VNtelex.kmap (written by Nguyen Dai
+;; Quy <DaiQuy.Nguyen@ulg.ac.be>) from the yudit 2.4 package
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "vietnamese-telex" ; NAME
+ "Vietnamese" ; LANGUAGE
+ "VT" ; TITLE
+ t ; GUIDANCE
+ "Vietnamese telex input method
+
+Vowels with circumflex:
+
+ aa -> â, EE -> Ê, etc.
+
+Other diacritics:
+
+ effect postfix examples
+ ------------------------------
+ breve w aw -> ă
+ horn w ow -> ơ
+
+ acute s as -> á
+ grave f af -> à
+ hook above r ar -> ả
+ tilde x ax -> ã
+ dot below j aj -> ạ
+
+ d bar dd -> đ
+
+Combinations:
+
+ AWF -> Ằ, owx -> ỡ, etc.
+
+Alternatives:
+
+ EE = Ee -> Ê, AWF = Awf -> Ằ, etc.
+
+Doubling the postfix (but not in combinations) separates the letter
+and postfix: Eee -> Ee, ajj -> aj, etc.
+" ; DOCSTRING
+ nil ; TRANSLATION-KEYS
+ t ; FORGET-LAST-SELECTION
+ nil ; DETERMINISTIC
+ nil ; KBD-TRANSLATE
+ nil ; SHOW-LAYOUT
+ nil ; CREATE-DECODE-MAP
+ nil ; MAXIMUM-SHORTEST
+ nil ; OVERLAY-PLIST
+ nil ; UPDATE-TRANSLATION-FUNCTION
+ nil ; CONVERSION-KEYS
+ t) ; SIMPLE
+
+(quail-define-rules
+ ("af" ?à) ; LATIN SMALL LETTER A WITH GRAVE
+ ("AF" ?À) ; LATIN CAPITAL LETTER A WITH GRAVE
+ ("Af" ?À)
+ ("as" ?á) ; LATIN SMALL LETTER A WITH ACUTE
+ ("AS" ?Á) ; LATIN CAPITAL LETTER A WITH ACUTE
+ ("As" ?Á)
+ ("aa" ?â) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("AA" ?Â) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("Aa" ?Â)
+ ("ax" ?ã) ; LATIN SMALL LETTER A WITH TILDE
+ ("AX" ?Ã) ; LATIN CAPITAL LETTER A WITH TILDE
+ ("Ax" ?Ã)
+ ("ef" ?è) ; LATIN SMALL LETTER E WITH GRAVE
+ ("EF" ?È) ; LATIN CAPITAL LETTER E WITH GRAVE
+ ("Ef" ?È)
+ ("es" ?é) ; LATIN SMALL LETTER E WITH ACUTE
+ ("ES" ?É) ; LATIN CAPITAL LETTER E WITH ACUTE
+ ("Es" ?É)
+ ("ee" ?ê) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("EE" ?Ê) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("Ee" ?Ê)
+ ("if" ?ì) ; LATIN SMALL LETTER I WITH GRAVE
+ ("IF" ?Ì) ; LATIN CAPITAL LETTER I WITH GRAVE
+ ("If" ?Ì)
+ ("is" ?í) ; LATIN SMALL LETTER I WITH ACUTE
+ ("IS" ?Í) ; LATIN CAPITAL LETTER I WITH ACUTE
+ ("Is" ?Í)
+ ("of" ?ò) ; LATIN SMALL LETTER O WITH GRAVE
+ ("OF" ?Ò) ; LATIN CAPITAL LETTER O WITH GRAVE
+ ("Of" ?Ò)
+ ("os" ?ó) ; LATIN SMALL LETTER O WITH ACUTE
+ ("OS" ?Ó) ; LATIN CAPITAL LETTER O WITH ACUTE
+ ("Os" ?Ó)
+ ("oo" ?ô) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("OO" ?Ô) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("Oo" ?Ô)
+ ("ox" ?õ) ; LATIN SMALL LETTER O WITH TILDE
+ ("OX" ?Õ) ; LATIN CAPITAL LETTER O WITH TILDE
+ ("Ox" ?Õ)
+ ("uf" ?ù) ; LATIN SMALL LETTER U WITH GRAVE
+ ("UF" ?Ù) ; LATIN CAPITAL LETTER U WITH GRAVE
+ ("Uf" ?Ù)
+ ("us" ?ú) ; LATIN SMALL LETTER U WITH ACUTE
+ ("US" ?Ú) ; LATIN CAPITAL LETTER U WITH ACUTE
+ ("Us" ?Ú)
+ ("ys" ?ý) ; LATIN SMALL LETTER Y WITH ACUTE
+ ("YS" ?Ý) ; LATIN CAPITAL LETTER Y WITH ACUTE
+ ("Ys" ?Ý)
+ ("aw" ?ă) ; LATIN SMALL LETTER A WITH BREVE
+ ("AW" ?Ă) ; LATIN CAPITAL LETTER A WITH BREVE
+ ("Aw" ?Ă)
+ ("ix" ?ĩ) ; LATIN SMALL LETTER I WITH TILDE
+ ("IX" ?Ĩ) ; LATIN CAPITAL LETTER I WITH TILDE
+ ("Ix" ?Ĩ)
+ ("ux" ?ũ) ; LATIN SMALL LETTER U WITH TILDE
+ ("UX" ?Ũ) ; LATIN CAPITAL LETTER U WITH TILDE
+ ("Ux" ?Ũ)
+ ("ow" ?ơ) ; LATIN SMALL LETTER O WITH HORN
+ ("OW" ?Ơ) ; LATIN CAPITAL LETTER O WITH HORN
+ ("Ow" ?Ơ)
+ ("uw" ?ư) ; LATIN SMALL LETTER U WITH HORN
+ ("UW" ?Ư) ; LATIN CAPITAL LETTER U WITH HORN
+ ("Uw" ?Ư)
+ ("aj" ?ạ) ; LATIN SMALL LETTER A WITH DOT BELOW
+ ("AJ" ?Ạ) ; LATIN CAPITAL LETTER A WITH DOT BELOW
+ ("Aj" ?Ạ)
+ ("ar" ?ả) ; LATIN SMALL LETTER A WITH HOOK ABOVE
+ ("AR" ?Ả) ; LATIN CAPITAL LETTER A WITH HOOK ABOVE
+ ("Ar" ?Ả)
+ ("aas" ?ấ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("AAS" ?Ấ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("Aas" ?Ấ)
+ ("aaf" ?ầ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("AAF" ?Ầ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("Aaf" ?Ầ)
+ ("aar" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+ ("AAR" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE
+ ("Aar" ?Ẩ)
+ ("aax" ?ẫ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("AAX" ?Ẫ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("Aax" ?Ẫ)
+ ("aaj" ?ậ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("AAJ" ?Ậ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("Aaj" ?Ậ)
+ ("aws" ?ắ) ; LATIN SMALL LETTER A WITH BREVE AND ACUTE
+ ("AWS" ?Ắ) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+ ("Aws" ?Ắ)
+ ("awf" ?ằ) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
+ ("AWF" ?Ằ) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+ ("Awf" ?Ằ)
+ ("awr" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE
+ ("AWR" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE
+ ("Awr" ?Ẳ)
+ ("awx" ?ẵ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
+ ("AWX" ?Ẵ) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+ ("Awx" ?Ẵ)
+ ("awj" ?ặ) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+ ("AWJ" ?Ặ) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+ ("Awj" ?Ặ)
+ ("ej" ?ẹ) ; LATIN SMALL LETTER E WITH DOT BELOW
+ ("EJ" ?Ẹ) ; LATIN CAPITAL LETTER E WITH DOT BELOW
+ ("Ej" ?Ẹ)
+ ("er" ?ẻ) ; LATIN SMALL LETTER E WITH HOOK ABOVE
+ ("ER" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HOOK ABOVE
+ ("Er" ?Ẻ)
+ ("ex" ?ẽ) ; LATIN SMALL LETTER E WITH TILDE
+ ("EX" ?Ẽ) ; LATIN CAPITAL LETTER E WITH TILDE
+ ("Ex" ?Ẽ)
+ ("ees" ?ế) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("EES" ?Ế) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("Ees" ?Ế)
+ ("eef" ?ề) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("EEF" ?Ề) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("Eef" ?Ề)
+ ("eer" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+ ("EER" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE
+ ("Eer" ?Ể)
+ ("eex" ?ễ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("EEX" ?Ễ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("Eex" ?Ễ)
+ ("eej" ?ệ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("EEJ" ?Ệ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("Eej" ?Ệ)
+ ("ir" ?ỉ) ; LATIN SMALL LETTER I WITH HOOK ABOVE
+ ("IR" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HOOK ABOVE
+ ("Ir" ?Ỉ)
+ ("ij" ?ị) ; LATIN SMALL LETTER I WITH DOT BELOW
+ ("IJ" ?Ị) ; LATIN CAPITAL LETTER I WITH DOT BELOW
+ ("Ij" ?Ị)
+ ("oj" ?ọ) ; LATIN SMALL LETTER O WITH DOT BELOW
+ ("OJ" ?Ọ) ; LATIN CAPITAL LETTER O WITH DOT BELOW
+ ("Oj" ?Ọ)
+ ("or" ?ỏ) ; LATIN SMALL LETTER O WITH HOOK ABOVE
+ ("OR" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HOOK ABOVE
+ ("Or" ?Ỏ)
+ ("oos" ?ố) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("OOS" ?Ố) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("Oos" ?Ố)
+ ("oof" ?ồ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("OOF" ?Ồ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("Oof" ?Ồ)
+ ("oor" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+ ("OOR" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE
+ ("Oor" ?Ổ)
+ ("oox" ?ỗ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("OOX" ?Ỗ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("Oox" ?Ỗ)
+ ("ooj" ?ộ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+ ("OOJ" ?Ộ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW
+ ("Ooj" ?Ộ)
+ ("ows" ?ớ) ; LATIN SMALL LETTER O WITH HORN AND ACUTE
+ ("OWS" ?Ớ) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+ ("Ows" ?Ớ)
+ ("owf" ?ờ) ; LATIN SMALL LETTER O WITH HORN AND GRAVE
+ ("OWF" ?Ờ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+ ("Owf" ?Ờ)
+ ("owr" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE
+ ("OWR" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE
+ ("Owr" ?Ở)
+ ("owx" ?ỡ) ; LATIN SMALL LETTER O WITH HORN AND TILDE
+ ("OWX" ?Ỡ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
+ ("Owx" ?Ỡ)
+ ("owj" ?ợ) ; LATIN SMALL LETTER O WITH HORN AND DOT BELOW
+ ("OWJ" ?Ợ) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW
+ ("Owj" ?Ợ)
+ ("uj" ?ụ) ; LATIN SMALL LETTER U WITH DOT BELOW
+ ("UJ" ?Ụ) ; LATIN CAPITAL LETTER U WITH DOT BELOW
+ ("Uj" ?Ụ)
+ ("ur" ?ủ) ; LATIN SMALL LETTER U WITH HOOK ABOVE
+ ("UR" ?Ủ) ; LATIN CAPITAL LETTER U WITH HOOK ABOVE
+ ("Ur" ?Ủ)
+ ("uws" ?ứ) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
+ ("UWS" ?Ứ) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+ ("Uws" ?Ứ)
+ ("uwf" ?ừ) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
+ ("UWF" ?Ừ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+ ("Uwf" ?Ừ)
+ ("uwr" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE
+ ("UWR" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE
+ ("Uwr" ?Ử)
+ ("uwx" ?ữ) ; LATIN SMALL LETTER U WITH HORN AND TILDE
+ ("UWX" ?Ữ) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
+ ("Uwx" ?Ữ)
+ ("uwj" ?ự) ; LATIN SMALL LETTER U WITH HORN AND DOT BELOW
+ ("UWJ" ?Ự) ; LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW
+ ("Uwj" ?Ự)
+ ("yf" ?ỳ) ; LATIN SMALL LETTER Y WITH GRAVE
+ ("YF" ?Ỳ) ; LATIN CAPITAL LETTER Y WITH GRAVE
+ ("Yf" ?Ỳ)
+ ("yj" ?ỵ) ; LATIN SMALL LETTER Y WITH DOT BELOW
+ ("YJ" ?Ỵ) ; LATIN CAPITAL LETTER Y WITH DOT BELOW
+ ("Yj" ?Ỵ)
+ ("yr" ?ỷ) ; LATIN SMALL LETTER Y WITH HOOK ABOVE
+ ("YR" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HOOK ABOVE
+ ("Yr" ?Ỷ)
+ ("yx" ?ỹ) ; LATIN SMALL LETTER Y WITH TILDE
+ ("YX" ?Ỹ) ; LATIN CAPITAL LETTER Y WITH TILDE
+ ("Yx" ?Ỹ)
+ ("dd" ?đ) ; LATIN SMALL LETTER D WITH STROKE
+ ("DD" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE
+ ("Dd" ?Đ)
+;("$$" ?₫) ; U+20AB DONG SIGN (#### check)
+
+ ("aff" ["af"])
+ ("AFF" ["AF"])
+ ("Aff" ["Af"])
+ ("ass" ["as"])
+ ("ASS" ["AS"])
+ ("Ass" ["As"])
+ ("aaa" ["aa"])
+ ("AAA" ["AA"])
+ ("Aaa" ["Aa"])
+ ("axx" ["ax"])
+ ("AXX" ["AX"])
+ ("Axx" ["Ax"])
+ ("eff" ["ef"])
+ ("EFF" ["EF"])
+ ("Eff" ["Ef"])
+ ("ess" ["es"])
+ ("ESS" ["ES"])
+ ("Ess" ["Es"])
+ ("eee" ["ee"])
+ ("EEE" ["EE"])
+ ("Eee" ["Ee"])
+ ("iff" ["if"])
+ ("IFF" ["IF"])
+ ("Iff" ["If"])
+ ("iss" ["is"])
+ ("ISS" ["IS"])
+ ("Iss" ["Is"])
+ ("off" ["of"])
+ ("OFF" ["OF"])
+ ("Off" ["Of"])
+ ("oss" ["os"])
+ ("OSS" ["OS"])
+ ("Oss" ["Os"])
+ ("ooo" ["oo"])
+ ("OOO" ["OO"])
+ ("Ooo" ["Oo"])
+ ("oxx" ["ox"])
+ ("OXX" ["OX"])
+ ("Oxx" ["Ox"])
+ ("uff" ["uf"])
+ ("UFF" ["UF"])
+ ("Uff" ["Uf"])
+ ("uss" ["us"])
+ ("USS" ["US"])
+ ("Uss" ["Us"])
+ ("yss" ["ys"])
+ ("YSS" ["YS"])
+ ("Yss" ["Ys"])
+ ("aww" ["aw"])
+ ("AWW" ["AW"])
+ ("Aww" ["Aw"])
+ ("ixx" ["ix"])
+ ("IXX" ["IX"])
+ ("Ixx" ["Ix"])
+ ("uxx" ["ux"])
+ ("UXX" ["UX"])
+ ("Uxx" ["ux"])
+ ("oww" ["ow"])
+ ("OWW" ["OW"])
+ ("Oww" ["Ow"])
+ ("uww" ["uw"])
+ ("UWW" ["UW"])
+ ("Uww" ["Uw"])
+ ("ajj" ["aj"])
+ ("AJJ" ["AJ"])
+ ("Ajj" ["Aj"])
+ ("arr" ["ar"])
+ ("ARR" ["AR"])
+ ("Arr" ["Ar"])
+ ("ejj" ["ej"])
+ ("EJJ" ["EJ"])
+ ("Ejj" ["Ej"])
+ ("err" ["er"])
+ ("ERR" ["ER"])
+ ("Err" ["Er"])
+ ("exx" ["ex"])
+ ("EXX" ["EX"])
+ ("Exx" ["Ex"])
+ ("irr" ["ir"])
+ ("IRR" ["IR"])
+ ("Irr" ["Ir"])
+ ("ijj" ["ij"])
+ ("IJJ" ["IJ"])
+ ("Ijj" ["Ij"])
+ ("ojj" ["oj"])
+ ("OJJ" ["OJ"])
+ ("Ojj" ["Oj"])
+ ("orr" ["or"])
+ ("ORR" ["OR"])
+ ("Orr" ["Or"])
+ ("ujj" ["uj"])
+ ("UJJ" ["UJ"])
+ ("Ujj" ["Uj"])
+ ("urr" ["ur"])
+ ("URR" ["UR"])
+ ("Urr" ["Ur"])
+ ("yff" ["yf"])
+ ("YFF" ["YF"])
+ ("Yff" ["Yf"])
+ ("yjj" ["yj"])
+ ("YJJ" ["YJ"])
+ ("Yjj" ["Yj"])
+ ("yrr" ["yr"])
+ ("YRR" ["YR"])
+ ("Yrr" ["Yr"])
+ ("yxx" ["yx"])
+ ("YXX" ["YX"])
+ ("Yxx" ["Yx"])
+ ("ddd" ["dd"])
+ ("DDD" ["DD"])
+ ("Ddd" ["Dd"])
+;("$$$" ["$$"])
+
+ ;; escape from composition
+ ("\\w" ?w) ; breve or horn
+ ("\\W" ?W)
+ ("\\a" ?a) ; a circumflex
+ ("\\A" ?A) ; A circumflex
+ ("\\e" ?e) ; e circumflex
+ ("\\E" ?E) ; E circumflex
+ ("\\o" ?o) ; o circumflex
+ ("\\O" ?O) ; O circumflex
+ ("\\s" ?s) ; acute
+ ("\\S" ?S)
+ ("\\f" ?f) ; grave
+ ("\\F" ?F)
+ ("\\r" ?r) ; hook above
+ ("\\R" ?R)
+ ("\\x" ?x) ; tilde
+ ("\\X" ?X)
+ ("\\j" ?j) ; dot below
+ ("\\J" ?J)
+ ("\\d" ?d) ; d-bar (d)
+ ("\\D" ?D) ; D-bar (d)
+ ("\\\\" ?\\) ; literal backslash
+)
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; vntelex.el ends here
diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el
new file mode 100644
index 00000000000..cbacca429ce
--- /dev/null
+++ b/lisp/leim/quail/vnvni.el
@@ -0,0 +1,305 @@
+;;; vnvni.el --- Quail package for Vietnamese by VNI method
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Werner Lemberg <wl@gnu.org>
+;; Nguyen Thai Ngoc Duy <pclouds@gmail.com>
+;; Keywords: multilingual, input method, Vietnamese
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; There are two commonly-used input methods for Vietnamese: Telex
+;; (implemented in vntelex.el) and VNI (implemented in this file,
+;; which was based on vntelex.el).
+
+;;; Code:
+
+(require 'quail)
+
+
+(quail-define-package
+ "vietnamese-vni" ; NAME
+ "Vietnamese" ; LANGUAGE
+ "VV" ; TITLE
+ t ; GUIDANCE
+ "Vietnamese VNI input method
+
+Diacritics:
+
+ effect postfix examples
+ ------------------------------
+ circumflex 6 a6 -> â
+ breve 8 a8 -> ă
+ horn 7 o7 -> ơ
+
+ acute 1 a1 -> á
+ grave 2 a2 -> à
+ hook above 3 a3 -> ả
+ tilde 4 a4 -> ã
+ dot below 5 a5 -> ạ
+
+ d bar 9 d9 -> đ
+
+Combinations:
+
+ A82 -> Ằ, o74 -> ỡ, etc.
+
+Doubling the postfix (but not in combinations) separates the letter
+and postfix: E66 -> E6, a55 -> a5, etc.
+" ; DOCSTRING
+ nil ; TRANSLATION-KEYS
+ t ; FORGET-LAST-SELECTION
+ nil ; DETERMINISTIC
+ nil ; KBD-TRANSLATE
+ nil ; SHOW-LAYOUT
+ nil ; CREATE-DECODE-MAP
+ nil ; MAXIMUM-SHORTEST
+ nil ; OVERLAY-PLIST
+ nil ; UPDATE-TRANSLATION-FUNCTION
+ nil ; CONVERSION-KEYS
+ t) ; SIMPLE
+
+(quail-define-rules
+ ("a2" ?à) ; LATIN SMALL LETTER A WITH GRAVE
+ ("A2" ?À) ; LATIN CAPITAL LETTER A WITH GRAVE
+ ("a1" ?á) ; LATIN SMALL LETTER A WITH ACUTE
+ ("A1" ?Á) ; LATIN CAPITAL LETTER A WITH ACUTE
+ ("a6" ?â) ; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("A6" ?Â) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("a4" ?ã) ; LATIN SMALL LETTER A WITH TILDE
+ ("A4" ?Ã) ; LATIN CAPITAL LETTER A WITH TILDE
+ ("e2" ?è) ; LATIN SMALL LETTER E WITH GRAVE
+ ("E2" ?È) ; LATIN CAPITAL LETTER E WITH GRAVE
+ ("e1" ?é) ; LATIN SMALL LETTER E WITH ACUTE
+ ("E1" ?É) ; LATIN CAPITAL LETTER E WITH ACUTE
+ ("e6" ?ê) ; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("E6" ?Ê) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("i2" ?ì) ; LATIN SMALL LETTER I WITH GRAVE
+ ("I2" ?Ì) ; LATIN CAPITAL LETTER I WITH GRAVE
+ ("i1" ?í) ; LATIN SMALL LETTER I WITH ACUTE
+ ("I1" ?Í) ; LATIN CAPITAL LETTER I WITH ACUTE
+ ("o2" ?ò) ; LATIN SMALL LETTER O WITH GRAVE
+ ("O2" ?Ò) ; LATIN CAPITAL LETTER O WITH GRAVE
+ ("o1" ?ó) ; LATIN SMALL LETTER O WITH ACUTE
+ ("O1" ?Ó) ; LATIN CAPITAL LETTER O WITH ACUTE
+ ("o6" ?ô) ; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("O6" ?Ô) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("o4" ?õ) ; LATIN SMALL LETTER O WITH TILDE
+ ("O4" ?Õ) ; LATIN CAPITAL LETTER O WITH TILDE
+ ("u2" ?ù) ; LATIN SMALL LETTER U WITH GRAVE
+ ("U2" ?Ù) ; LATIN CAPITAL LETTER U WITH GRAVE
+ ("u1" ?ú) ; LATIN SMALL LETTER U WITH ACUTE
+ ("U1" ?Ú) ; LATIN CAPITAL LETTER U WITH ACUTE
+ ("y1" ?ý) ; LATIN SMALL LETTER Y WITH ACUTE
+ ("Y1" ?Ý) ; LATIN CAPITAL LETTER Y WITH ACUTE
+ ("a8" ?ă) ; LATIN SMALL LETTER A WITH BREVE
+ ("A8" ?Ă) ; LATIN CAPITAL LETTER A WITH BREVE
+ ("i4" ?ĩ) ; LATIN SMALL LETTER I WITH TILDE
+ ("I4" ?Ĩ) ; LATIN CAPITAL LETTER I WITH TILDE
+ ("u4" ?ũ) ; LATIN SMALL LETTER U WITH TILDE
+ ("U4" ?Ũ) ; LATIN CAPITAL LETTER U WITH TILDE
+ ("o7" ?ơ) ; LATIN SMALL LETTER O WITH HORN
+ ("O7" ?Ơ) ; LATIN CAPITAL LETTER O WITH HORN
+ ("u7" ?ư) ; LATIN SMALL LETTER U WITH HORN
+ ("U7" ?Ư) ; LATIN CAPITAL LETTER U WITH HORN
+ ("a5" ?ạ) ; LATIN SMALL LETTER A WITH DOT BELOW
+ ("A5" ?Ạ) ; LATIN CAPITAL LETTER A WITH DOT BELOW
+ ("a3" ?ả) ; LATIN SMALL LETTER A WITH HOOK ABOVE
+ ("A3" ?Ả) ; LATIN CAPITAL LETTER A WITH HOOK ABOVE
+ ("a61" ?ấ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("A61" ?Ấ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE
+ ("a62" ?ầ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("A62" ?Ầ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE
+ ("a63" ?ẩ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("A63" ?Ẩ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HO6K ABOVE
+ ("a64" ?ẫ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("A64" ?Ẫ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE
+ ("a65" ?ậ) ; LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("A65" ?Ậ) ; LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW
+ ("a81" ?ắ) ; LATIN SMALL LETTER A WITH BREVE AND ACUTE
+ ("A81" ?Ắ) ; LATIN CAPITAL LETTER A WITH BREVE AND ACUTE
+ ("a82" ?ằ) ; LATIN SMALL LETTER A WITH BREVE AND GRAVE
+ ("A82" ?Ằ) ; LATIN CAPITAL LETTER A WITH BREVE AND GRAVE
+ ("a83" ?ẳ) ; LATIN SMALL LETTER A WITH BREVE AND HO6K ABOVE
+ ("A83" ?Ẳ) ; LATIN CAPITAL LETTER A WITH BREVE AND HO6K ABOVE
+ ("a84" ?ẵ) ; LATIN SMALL LETTER A WITH BREVE AND TILDE
+ ("A84" ?Ẵ) ; LATIN CAPITAL LETTER A WITH BREVE AND TILDE
+ ("a85" ?ặ) ; LATIN SMALL LETTER A WITH BREVE AND DOT BELOW
+ ("A85" ?Ặ) ; LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW
+ ("e5" ?ẹ) ; LATIN SMALL LETTER E WITH DOT BELOW
+ ("E5" ?Ẹ) ; LATIN CAPITAL LETTER E WITH DOT BELOW
+ ("e3" ?ẻ) ; LATIN SMALL LETTER E WITH HO6K ABOVE
+ ("E3" ?Ẻ) ; LATIN CAPITAL LETTER E WITH HO6K ABOVE
+ ("e4" ?ẽ) ; LATIN SMALL LETTER E WITH TILDE
+ ("E4" ?Ẽ) ; LATIN CAPITAL LETTER E WITH TILDE
+ ("e61" ?ế) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("E61" ?Ế) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE
+ ("e62" ?ề) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("E62" ?Ề) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE
+ ("e63" ?ể) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("E63" ?Ể) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HO6K ABOVE
+ ("e64" ?ễ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("E64" ?Ễ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE
+ ("e65" ?ệ) ; LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("E65" ?Ệ) ; LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW
+ ("i3" ?ỉ) ; LATIN SMALL LETTER I WITH HO6K ABOVE
+ ("I3" ?Ỉ) ; LATIN CAPITAL LETTER I WITH HO6K ABOVE
+ ("i5" ?ị) ; LATIN SMALL LETTER I WITH DOT BELOW
+ ("I5" ?Ị) ; LATIN CAPITAL LETTER I WITH DOT BELOW
+ ("o5" ?ọ) ; LATIN SMALL LETTER O WITH DOT BELOW
+ ("O5" ?Ọ) ; LATIN CAPITAL LETTER O WITH DOT BELOW
+ ("o3" ?ỏ) ; LATIN SMALL LETTER O WITH HO6K ABOVE
+ ("O3" ?Ỏ) ; LATIN CAPITAL LETTER O WITH HO6K ABOVE
+ ("o61" ?ố) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("O61" ?Ố) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE
+ ("o62" ?ồ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("O62" ?Ồ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE
+ ("o63" ?ổ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("O63" ?Ổ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HO6K ABOVE
+ ("o64" ?ỗ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("O64" ?Ỗ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE
+ ("o65" ?ộ) ; LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("O65" ?Ộ) ; LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELO7
+ ("o71" ?ớ) ; LATIN SMALL LETTER O WITH HORN AND ACUTE
+ ("O71" ?Ớ) ; LATIN CAPITAL LETTER O WITH HORN AND ACUTE
+ ("o72" ?ờ) ; LATIN SMALL LETTER O WITH HORN AND GRAVE
+ ("O72" ?Ờ) ; LATIN CAPITAL LETTER O WITH HORN AND GRAVE
+ ("o73" ?ở) ; LATIN SMALL LETTER O WITH HORN AND HO6K ABOVE
+ ("O73" ?Ở) ; LATIN CAPITAL LETTER O WITH HORN AND HO6K ABOVE
+ ("o74" ?ỡ) ; LATIN SMALL LETTER O WITH HORN AND TILDE
+ ("O74" ?Ỡ) ; LATIN CAPITAL LETTER O WITH HORN AND TILDE
+ ("o75" ?ợ) ; LATIN SMALL LETTER O WITH HORN AND DOT BELO7
+ ("O75" ?Ợ) ; LATIN CAPITAL LETTER O WITH HORN AND DOT BELO7
+ ("u5" ?ụ) ; LATIN SMALL LETTER U WITH DOT BELO7
+ ("U5" ?Ụ) ; LATIN CAPITAL LETTER U WITH DOT BELO7
+ ("u3" ?ủ) ; LATIN SMALL LETTER U WITH HO6K ABOVE
+ ("U3" ?Ủ) ; LATIN CAPITAL LETTER U WITH HO6K ABOVE
+ ("u71" ?ứ) ; LATIN SMALL LETTER U WITH HORN AND ACUTE
+ ("U71" ?Ứ) ; LATIN CAPITAL LETTER U WITH HORN AND ACUTE
+ ("u72" ?ừ) ; LATIN SMALL LETTER U WITH HORN AND GRAVE
+ ("U72" ?Ừ) ; LATIN CAPITAL LETTER U WITH HORN AND GRAVE
+ ("u73" ?ử) ; LATIN SMALL LETTER U WITH HORN AND HO6K ABOVE
+ ("U73" ?Ử) ; LATIN CAPITAL LETTER U WITH HORN AND HO6K ABOVE
+ ("u74" ?ữ) ; LATIN SMALL LETTER U WITH HORN AND TILDE
+ ("U74" ?Ữ) ; LATIN CAPITAL LETTER U WITH HORN AND TILDE
+ ("u75" ?ự) ; LATIN SMALL LETTER U WITH HORN AND DOT BELO7
+ ("U75" ?Ự) ; LATIN CAPITAL LETTER U WITH HORN AND DOT BELO7
+ ("y2" ?ỳ) ; LATIN SMALL LETTER Y WITH GRAVE
+ ("Y2" ?Ỳ) ; LATIN CAPITAL LETTER Y WITH GRAVE
+ ("y5" ?ỵ) ; LATIN SMALL LETTER Y WITH DOT BELO7
+ ("Y5" ?Ỵ) ; LATIN CAPITAL LETTER Y WITH DOT BELO7
+ ("y3" ?ỷ) ; LATIN SMALL LETTER Y WITH HO6K ABOVE
+ ("Y3" ?Ỷ) ; LATIN CAPITAL LETTER Y WITH HO6K ABOVE
+ ("y4" ?ỹ) ; LATIN SMALL LETTER Y WITH TILDE
+ ("Y4" ?Ỹ) ; LATIN CAPITAL LETTER Y WITH TILDE
+ ("d9" ?đ) ; LATIN SMALL LETTER D WITH STROKE
+ ("D9" ?Đ) ; LATIN CAPITAL LETTER D WITH STROKE
+;("$$" ?₫) ; U+20AB DONG SIGN (#### check)
+
+ ("a22" ["a22"])
+ ("A22" ["A2"])
+ ("a11" ["a1"])
+ ("A11" ["A1"])
+ ("a66"' ["a6"])
+ ("A66"' ["A6"])
+ ("a44" ["a4"])
+ ("A44" ["A4"])
+ ("e22" ["e2"])
+ ("E22" ["E2"])
+ ("e11" ["e1"])
+ ("E11" ["E1"])
+ ("e66" ["e6"])
+ ("E66" ["E6"])
+ ("i22" ["i2"])
+ ("I22" ["I2"])
+ ("i11" ["i1"])
+ ("I11" ["I1"])
+ ("o22" ["o2"])
+ ("O22" ["O2"])
+ ("o11" ["o1"])
+ ("O11" ["O1"])
+ ("o66" ["o6"])
+ ("O66" ["O6"])
+ ("o44" ["o4"])
+ ("O44" ["O4"])
+ ("u22" ["u2"])
+ ("U22" ["U2"])
+ ("u11" ["u1"])
+ ("U11" ["U1"])
+ ("y11" ["y1"])
+ ("Y11" ["Y1"])
+ ("a88" ["a8"])
+ ("A88" ["A8"])
+ ("i44" ["i4"])
+ ("I44" ["I4"])
+ ("u44" ["u4"])
+ ("U44" ["u4"])
+ ("o77" ["o7"])
+ ("O77" ["O7"])
+ ("u77" ["u7"])
+ ("U77" ["U7"])
+ ("a55" ["a5"])
+ ("A55" ["A5"])
+ ("a33" ["a3"])
+ ("A33" ["A3"])
+ ("e55" ["e5"])
+ ("E55" ["E5"])
+ ("e33" ["e3"])
+ ("E33" ["E3"])
+ ("e44" ["e4"])
+ ("E44" ["E4"])
+ ("i33" ["i3"])
+ ("I33" ["I3"])
+ ("i55" ["i5"])
+ ("I55" ["I5"])
+ ("o55" ["o5"])
+ ("O55" ["O5"])
+ ("o33" ["o3"])
+ ("O33" ["O3"])
+ ("u55" ["u5"])
+ ("U55" ["U5"])
+ ("u33" ["u3"])
+ ("U33" ["U3"])
+ ("y22" ["y2"])
+ ("Y22" ["Y2"])
+ ("y55" ["y5"])
+ ("Y55" ["Y5"])
+ ("y33" ["y3"])
+ ("Y33" ["Y3"])
+ ("y44" ["y4"])
+ ("Y44" ["Y4"])
+ ("d9" ["d9"])
+ ("D99" ["D9"])
+;("$$$" ["$$"])
+
+ ;; escape from composition
+ ("\\1" ?1)
+ ("\\2" ?2)
+ ("\\3" ?3)
+ ("\\4" ?4)
+ ("\\5" ?5)
+ ("\\6" ?6)
+ ("\\7" ?7)
+ ("\\8" ?8)
+ ("\\9" ?9)
+ ("\\\\" ?\\)) ; literal backslash
+
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
diff --git a/lisp/leim/quail/welsh.el b/lisp/leim/quail/welsh.el
new file mode 100644
index 00000000000..a39bd421992
--- /dev/null
+++ b/lisp/leim/quail/welsh.el
@@ -0,0 +1,201 @@
+;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: utf-8;-*-
+
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
+
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Welsh input following the Yudit map by david@sheetmusic.org.uk.
+
+;;; Code:
+
+(require 'quail)
+
+(quail-define-package
+ "welsh" "Welsh" "Ŵ" t
+ "Welsh postfix input method"
+ nil t nil nil nil nil nil nil nil nil t)
+
+(quail-define-rules
+ ("A\\" ?À)
+ ("A/" ?Á)
+ ("A^" ?Â)
+ ("A+" ?Â)
+ ("A\"" ?Ä)
+ ("a\\" ?à)
+ ("a/" ?á)
+ ("a^" ?â)
+ ("a+" ?â)
+ ("a\"" ?ä)
+
+ ("E\\" ?È)
+ ("E/" ?É)
+ ("E^" ?Ê)
+ ("E+" ?Ê)
+ ("E\"" ?Ë)
+ ("e\\" ?è)
+ ("e/" ?é)
+ ("e^" ?ê)
+ ("e+" ?ê)
+ ("e\"" ?ë)
+
+ ("I\\" ?Ì)
+ ("I/" ?Í)
+ ("I^" ?Î)
+ ("I+" ?Î)
+ ("I\"" ?Ï)
+ ("i\\" ?ì)
+ ("i/" ?í)
+ ("i^" ?î)
+ ("i+" ?î)
+ ("i\"" ?ï)
+
+ ("O\\" ?Ò)
+ ("O/" ?Ó)
+ ("O^" ?Ô)
+ ("O+" ?Ô)
+ ("O\"" ?Ö)
+ ("o\\" ?ò)
+ ("o/" ?ó)
+ ("o^" ?ô)
+ ("o+" ?ô)
+ ("o\"" ?ö)
+
+ ("U\\" ?Ù)
+ ("U/" ?Ú)
+ ("U^" ?Û)
+ ("U+" ?Û)
+ ("U\"" ?Ü)
+ ("u\\" ?ù)
+ ("u/" ?ú)
+ ("u^" ?û)
+ ("u+" ?û)
+ ("u\"" ?ü)
+
+ ("Y\\" ?Ỳ)
+ ("Y/" ?Ý)
+ ("Y^" ?Ŷ)
+ ("Y+" ?Ŷ)
+ ("Y\"" ?Ÿ)
+ ("y\\" ?ỳ)
+ ("y/" ?ý)
+ ("y\"" ?ÿ)
+ ("y^" ?ŷ)
+ ("y+" ?ŷ)
+
+ ("W\\" ?Ẁ)
+ ("W/" ?Ẃ)
+ ("W^" ?Ŵ)
+ ("W+" ?Ŵ)
+ ("W\"" ?Ẅ)
+ ("w\\" ?ẁ)
+ ("w/" ?ẃ)
+ ("w^" ?ŵ)
+ ("w+" ?ŵ)
+ ("w\"" ?ẅ)
+
+ ;; "hawlfraint" (copyright). Dyma arwyddlun hawlfraint.
+ ("(h)" ?ⓗ))
+
+;; (quail-define-package
+;; "welsh" "Welsh" "Ŵ" t
+;; "Welsh postfix input method, using Latin-8"
+;; nil t nil nil nil nil nil nil nil nil t)
+
+;; (quail-define-rules
+;; ("A\\" ?À)
+;; ("A/" ?Á)
+;; ("A^" ?Â)
+;; ("A+" ?Â)
+;; ("A\"" ?Ä)
+;; ("a\\" ?à)
+;; ("a/" ?á)
+;; ("a^" ?â)
+;; ("a+" ?â)
+;; ("a\"" ?ä)
+
+;; ("E\\" ?È)
+;; ("E/" ?É)
+;; ("E^" ?Ê)
+;; ("E+" ?Ê)
+;; ("E\"" ?Ë)
+;; ("e\\" ?è)
+;; ("e/" ?é)
+;; ("e^" ?ê)
+;; ("e+" ?ê)
+;; ("e\"" ?ë)
+
+;; ("I\\" ?Ì)
+;; ("I/" ?Í)
+;; ("I^" ?Î)
+;; ("I+" ?Î)
+;; ("I\"" ?Ï)
+;; ("i\\" ?ì)
+;; ("i/" ?í)
+;; ("i^" ?î)
+;; ("i+" ?î)
+;; ("i\"" ?ï)
+
+;; ("O\\" ?Ò)
+;; ("O/" ?Ó)
+;; ("O^" ?Ô)
+;; ("O+" ?Ô)
+;; ("O\"" ?Ö)
+;; ("o\\" ?ò)
+;; ("o/" ?ó)
+;; ("o^" ?ô)
+;; ("o+" ?ô)
+;; ("o\"" ?ö)
+
+;; ("U\\" ?Ù)
+;; ("U/" ?Ú)
+;; ("U^" ?Û)
+;; ("U+" ?Û)
+;; ("U\"" ?Ü)
+;; ("u\\" ?ù)
+;; ("u/" ?ú)
+;; ("u^" ?û)
+;; ("u+" ?û)
+;; ("u\"" ?ü)
+
+;; ("Y\\" ?¬)
+;; ("Y/" ?Ý)
+;; ("Y^" ?Þ)
+;; ("Y+" ?Þ)
+;; ("Y\"" ?¯)
+;; ("y\\" ?¼)
+;; ("y/" ?ý)
+;; ("y\"" ?ÿ)
+;; ("y^" ?þ)
+;; ("y+" ?þ)
+
+;; ("W\\" ?¨)
+;; ("W/" ?ª)
+;; ("W^" ?Ð)
+;; ("W+" ?Ð)
+;; ("W\"" ?½)
+;; ("w\\" ?¸)
+;; ("w/" ?º)
+;; ("w^" ?ð)
+;; ("w+" ?ð)
+;; ("w\"" ?¾))
+
+
+;;; welsh.el ends here
diff --git a/lisp/linum.el b/lisp/linum.el
index d9d7e5ad120..7b6a3ea4e42 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -1,9 +1,9 @@
;;; linum.el --- display line numbers in the left margin -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Markus Triska <markus.triska@gmx.at>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; Version: 0.9x
@@ -62,7 +62,7 @@ See also `linum-before-numbering-hook'."
(defcustom linum-eager t
"Whether line numbers should be updated after each command.
-The conservative setting `nil' might miss some buffer changes,
+The conservative setting nil might miss some buffer changes,
and you have to scroll or press \\[recenter-top-bottom] to update the numbers."
:group 'linum
:type 'boolean)
@@ -138,6 +138,17 @@ Linum mode is a buffer-local minor mode."
(mapc #'delete-overlay linum-available)
(setq linum-available nil))))
+;; Behind display-graphic-p test.
+(declare-function font-info "font.c" (name &optional frame))
+
+(defun linum--face-width (face)
+ (let ((info (font-info (face-font face)))
+ width)
+ (setq width (aref info 11))
+ (if (<= width 0)
+ (setq width (aref info 10)))
+ width))
+
(defun linum-update-window (win)
"Update line numbers for the portion visible in window WIN."
(goto-char (window-start win))
@@ -152,7 +163,7 @@ Linum mode is a buffer-local minor mode."
(run-hooks 'linum-before-numbering-hook)
;; Create an overlay (or reuse an existing one) for each
;; line visible in this window, if necessary.
- (while (and (not (eobp)) (<= (point) limit))
+ (while (and (not (eobp)) (< (point) limit))
(let* ((str (if fmt
(propertize (format fmt line) 'face 'linum)
(funcall linum-format line)))
@@ -178,6 +189,10 @@ Linum mode is a buffer-local minor mode."
(let ((inhibit-point-motion-hooks t))
(forward-line))
(setq line (1+ line)))
+ (when (display-graphic-p)
+ (setq width (ceiling
+ (/ (* width 1.0 (linum--face-width 'linum))
+ (frame-char-width)))))
(set-window-margins win width (cdr (window-margins win)))))
(defun linum-after-change (beg end _len)
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 620344734b3..4ea1bcb9f50 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,9 +1,9 @@
;;; loadhist.el --- lisp functions for working with feature groups
-;; Copyright (C) 1995, 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -101,14 +101,15 @@ A library name is equivalent to the file name that `load-library' would load."
"Read feature name from the minibuffer, prompting with string PROMPT.
If optional second arg LOADED-P is non-nil, the feature must be loaded
from a file."
- (intern
- (completing-read prompt
- (cons nil features)
- (and loaded-p
- #'(lambda (f)
- (and f ; ignore nil
- (feature-file f))))
- loaded-p)))
+ (intern (completing-read
+ prompt
+ (mapcar #'symbol-name
+ (if loaded-p
+ (delq nil
+ (mapcar
+ (lambda (x) (and (feature-file x) x))
+ features))
+ features)))))
(defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks)
(defvar unload-feature-special-hooks
@@ -122,7 +123,6 @@ from a file."
delete-frame-functions disabled-command-function
fill-nobreak-predicate find-directory-functions
find-file-not-found-functions
- font-lock-beginning-of-syntax-function
font-lock-fontify-buffer-function
font-lock-fontify-region-function
font-lock-mark-block-function
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c32bd00463e..fef111f6611 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -1,9 +1,9 @@
;;; loadup.el --- load up standardly loaded Lisp files for Emacs
-;; Copyright (C) 1985-1986, 1992, 1994, 2001-2013 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -26,43 +26,50 @@
;; This is loaded into a bare Emacs to make a dumpable one.
-;; If you add/remove Lisp files to be loaded here, consider the
-;; following issues:
+;; If you add a file to be loaded here, keep the following points in mind:
-;; i) Any file loaded on any platform should appear in $lisp in src/lisp.mk.
-;; Use the .el or .elc version as appropriate.
+;; i) If the file is no-byte-compile, explicitly load the .el version.
+;; Such files should (where possible) obey the doc-string conventions
+;; expected by make-docfile. They should also be added to the
+;; uncompiled[] list in make-docfile.c.
+;; ii) If the file is dumped with Emacs (on any platform), put the
+;; load statement at the start of a line (leading whitespace is ok).
+
+;; iii) If the file is _not_ dumped with Emacs, make sure the load
+;; statement is _not_ at the start of a line. See pcase for an example.
+
+;; These rules are so that src/Makefile can construct lisp.mk automatically.
;; This ensures both that the Lisp files are compiled (if necessary)
;; before the emacs executable is dumped, and that they are passed to
;; make-docfile. (Any that are not processed for DOC will not have
-;; doc strings in the dumped Emacs.) Because of this:
-
-;; ii) If the file is loaded uncompiled, it should (where possible)
-;; obey the doc-string conventions expected by make-docfile. It
-;; should also be added to the uncompiled[] list in make-docfile.c.
+;; doc strings in the dumped Emacs.)
;;; Code:
;; Add subdirectories to the load-path for files that might get
;; autoloaded when bootstrapping.
;; This is because PATH_DUMPLOADSEARCH is just "../lisp".
-;; Note that we reset load-path below just before dumping,
-;; since lread.c:init_lread checks for changes to load-path
-;; in deciding whether to modify it.
-(if (or (equal (nth 3 command-line-args) "bootstrap")
- (equal (nth 4 command-line-args) "bootstrap")
- (equal (nth 3 command-line-args) "unidata-gen.el")
- (equal (nth 4 command-line-args) "unidata-gen-files")
- ;; In case CANNOT_DUMP.
- (string-match "src/bootstrap-emacs" (nth 0 command-line-args)))
+(if (or (equal (member "bootstrap" command-line-args) '("bootstrap"))
+ ;; FIXME this is irritatingly fragile.
+ (equal (nth 4 command-line-args) "unidata-gen.el")
+ (equal (nth 7 command-line-args) "unidata-gen-files")
+ (if (fboundp 'dump-emacs)
+ (string-match "src/bootstrap-emacs" (nth 0 command-line-args))
+ t))
(let ((dir (car load-path)))
;; We'll probably overflow the pure space.
(setq purify-flag nil)
- (setq load-path (list dir
+ (setq load-path (list (expand-file-name "." dir)
(expand-file-name "emacs-lisp" dir)
(expand-file-name "language" dir)
(expand-file-name "international" dir)
- (expand-file-name "textmodes" dir)))))
+ (expand-file-name "textmodes" dir)
+ (expand-file-name "vc" dir)))))
+
+;; Prevent build-time PATH getting stored in the binary.
+;; Mainly cosmetic, but helpful for Guix. (Bug#20330)
+(setq exec-path nil)
(if (eq t purify-flag)
;; Hash consing saved around 11% of pure space in my tests.
@@ -70,11 +77,15 @@
(message "Using load-path %s" load-path)
-(if (or (member (nth 3 command-line-args) '("dump" "bootstrap"))
- (member (nth 4 command-line-args) '("dump" "bootstrap")))
- ;; To reduce the size of dumped Emacs, we avoid making huge
- ;; char-tables.
- (setq inhibit-load-charset-map t))
+;; This is a poor man's `last', since we haven't loaded subr.el yet.
+(if (or (equal (member "bootstrap" command-line-args) '("bootstrap"))
+ (equal (member "dump" command-line-args) '("dump")))
+ (progn
+ ;; To reduce the size of dumped Emacs, we avoid making huge char-tables.
+ (setq inhibit-load-charset-map t)
+ ;; --eval gets handled too late.
+ (defvar load--prefer-newer load-prefer-newer)
+ (setq load-prefer-newer t)))
;; We don't want to have any undo records in the dumped Emacs.
(set-buffer "*scratch*")
@@ -98,7 +109,6 @@
(load "env")
(load "format")
(load "bindings")
-(load "cus-start")
(load "window") ; Needed here for `replace-buffer-in-windows'.
(setq load-source-file-function 'load-with-code-conversion)
(load "files")
@@ -111,16 +121,15 @@
;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
;; fail until pcase is explicitly loaded. This also means that we have to
;; disable eager macro-expansion while loading pcase.
- (let ((macroexp--pending-eager-loads '(skip)))
- (load "emacs-lisp/pcase"))
+ (let ((macroexp--pending-eager-loads '(skip))) (load "emacs-lisp/pcase"))
;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
- (load "emacs-lisp/macroexp"))
+ (let ((max-lisp-eval-depth (* 2 max-lisp-eval-depth)))
+ (load "emacs-lisp/macroexp")))
(load "cus-face")
(load "faces") ; after here, `defface' may be used.
(load "button")
-(load "startup")
;; 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.
@@ -133,14 +142,13 @@
;; should be updated by overwriting it with an up-to-date copy of
;; loaddefs.el that is uncorrupted by local changes.
;; autogen/update_autogen can be used to periodically update ldefs-boot.
-(condition-case nil
- ;; Don't get confused if someone compiled this by mistake.
- (load "loaddefs.el")
+(condition-case nil (load "loaddefs.el")
;; In case loaddefs hasn't been generated yet.
(file-error (load "ldefs-boot.el")))
(load "emacs-lisp/nadvice")
-(load "minibuffer")
+(load "emacs-lisp/cl-preloaded")
+(load "minibuffer") ;After loaddefs, for define-minor-mode.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "simple")
@@ -171,6 +179,8 @@
(load "language/romanian")
(load "language/greek")
(load "language/hebrew")
+(load "international/cp51932")
+(load "international/eucjp-ms")
(load "language/japanese")
(load "language/korean")
(load "language/lao")
@@ -186,7 +196,9 @@
(load "language/cham")
(load "indent")
+(load "emacs-lisp/cl-generic")
(load "frame")
+(load "startup")
(load "term/tty-colors")
(load "font-core")
;; facemenu must be loaded before font-lock, because `facemenu-keymap'
@@ -196,12 +208,10 @@
(load "font-lock")
(load "jit-lock")
-(if (fboundp 'track-mouse)
- (progn
- (load "mouse")
- (and (boundp 'x-toolkit-scroll-bars)
- (load "scroll-bar"))
- (load "select")))
+(load "mouse")
+(if (boundp 'x-toolkit-scroll-bars)
+ (load "scroll-bar"))
+(load "select")
(load "emacs-lisp/timer")
(load "isearch")
(load "rfn-eshadow")
@@ -213,6 +223,7 @@
(load "textmodes/paragraphs")
(load "progmodes/prog-mode")
(load "emacs-lisp/lisp-mode")
+(load "progmodes/elisp-mode")
(load "textmodes/text-mode")
(load "textmodes/fill")
(load "newcomment")
@@ -247,7 +258,6 @@
(load "w32-vars")
(load "term/w32-win")
(load "disp-table")
- (load "w32-common-fns")
(when (eq system-type 'windows-nt)
(load "w32-fns")
(load "ls-lisp")
@@ -276,20 +286,46 @@
(load "vc/vc-hooks")
(load "vc/ediff-hook")
-(if (fboundp 'x-show-tip) (load "tooltip"))
+(load "uniquify")
+(load "electric")
+(load "emacs-lisp/eldoc")
+(load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway)
+(if (not (eq system-type 'ms-dos))
+ (load "tooltip"))
-;If you want additional libraries to be preloaded and their
-;doc strings kept in the DOC file rather than in core,
-;you may load them with a "site-load.el" file.
-;But you must also cause them to be scanned when the DOC file
-;is generated.
-;For other systems, you must edit ../src/Makefile.in.
-(load "site-load" t)
+;; This file doesn't exist when building a development version of Emacs
+;; from the repository. It is generated just after temacs is built.
+(load "leim/leim-list.el" t)
+
+;; If you want additional libraries to be preloaded and their
+;; doc strings kept in the DOC file rather than in core,
+;; you may load them with a "site-load.el" file.
+;; But you must also cause them to be scanned when the DOC file
+;; is generated.
+(let ((lp load-path))
+ (load "site-load" t)
+ ;; We reset load-path after dumping.
+ ;; For a permanent change in load-path, use configure's
+ ;; --enable-locallisppath option.
+ ;; See http://debbugs.gnu.org/16107 for more details.
+ (or (equal lp load-path)
+ (message "Warning: Change in load-path due to site-load will be \
+lost after dumping")))
+
+;; Make sure default-directory is unibyte when dumping. This is
+;; because we cannot decode and encode it correctly (since the locale
+;; environment is not, and should not be, set up). default-directory
+;; is used every time we call expand-file-name, which we do in every
+;; file primitive. So the only workable solution to support building
+;; in non-ASCII directories is to manipulate unibyte strings in the
+;; current locale's encoding.
+(if (and (member (car (last command-line-args)) '("dump" "bootstrap"))
+ (multibyte-string-p default-directory))
+ (error "default-directory must be unibyte when dumping Emacs!"))
;; Determine which last version number to use
;; based on the executables that now exist.
-(if (and (or (equal (nth 3 command-line-args) "dump")
- (equal (nth 4 command-line-args) "dump"))
+(if (and (equal (last command-line-args) '("dump"))
(not (eq system-type 'ms-dos)))
(let* ((base (concat "emacs-" emacs-version "."))
(exelen (if (eq system-type 'windows-nt) -4))
@@ -299,7 +335,7 @@
(string-to-number
(substring name (length base) exelen))))
files)))
- (setq emacs-bzr-version (condition-case nil (emacs-bzr-get-version)
+ (setq emacs-repository-version (condition-case nil (emacs-repository-get-version)
(error nil)))
;; `emacs-version' is a constant, so we shouldn't change it with `setq'.
(defconst emacs-version
@@ -308,8 +344,7 @@
(message "Finding pointers to doc strings...")
-(if (or (equal (nth 3 command-line-args) "dump")
- (equal (nth 4 command-line-args) "dump"))
+(if (equal (last command-line-args) '("dump"))
(Snarf-documentation "DOC")
(condition-case nil
(Snarf-documentation "DOC")
@@ -318,9 +353,16 @@
;; Note: You can cause additional libraries to be preloaded
;; by writing a site-init.el that loads them.
-;; See also "site-load" above.
-(load "site-init" t)
+;; See also "site-load" above
+(let ((lp load-path))
+ (load "site-init" t)
+ (or (equal lp load-path)
+ (message "Warning: Change in load-path due to site-init will be \
+lost after dumping")))
+
(setq current-load-list nil)
+;; Avoid storing references to build directory in the binary.
+(setq custom-current-group-alist nil)
;; We keep the load-history data in PURE space.
;; Make sure that the spine of the list is not in pure space because it can
@@ -329,13 +371,14 @@
(set-buffer-modified-p nil)
-;; reset the load-path. See lread.c:init_lread why.
-(if (or (equal (nth 3 command-line-args) "bootstrap")
- (equal (nth 4 command-line-args) "bootstrap"))
- (setcdr load-path nil))
-
(remove-hook 'after-load-functions (lambda (f) (garbage-collect)))
+(if (boundp 'load--prefer-newer)
+ (progn
+ (setq load-prefer-newer load--prefer-newer)
+ (put 'load-prefer-newer 'standard-value load--prefer-newer)
+ (makunbound 'load--prefer-newer)))
+
(setq inhibit-load-charset-map nil)
(clear-charset-maps)
(garbage-collect)
@@ -367,8 +410,7 @@
(if (null (garbage-collect))
(setq pure-space-overflow t))
-(if (or (member (nth 3 command-line-args) '("dump" "bootstrap"))
- (member (nth 4 command-line-args) '("dump" "bootstrap")))
+(if (member (car (last command-line-args)) '("dump" "bootstrap"))
(progn
(message "Dumping under the name emacs")
(condition-case ()
@@ -384,8 +426,7 @@
(if (not (or (eq system-type 'ms-dos)
;; Don't bother adding another name if we're just
;; building bootstrap-emacs.
- (equal (nth 3 command-line-args) "bootstrap")
- (equal (nth 4 command-line-args) "bootstrap")))
+ (equal (last command-line-args) '("bootstrap"))))
(let ((name (concat "emacs-" emacs-version))
(exe (if (eq system-type 'windows-nt) ".exe" "")))
(while (string-match "[^-+_.a-zA-Z0-9]+" name)
@@ -406,7 +447,7 @@
;; this file must be loaded each time Emacs is run.
;; So run the startup code now. First, remove `-l loadup' from args.
-(if (and (equal (nth 1 command-line-args) "-l")
+(if (and (member (nth 1 command-line-args) '("-l" "--load"))
(equal (nth 2 command-line-args) "loadup"))
(setcdr command-line-args (nthcdr 3 command-line-args)))
diff --git a/lisp/locate.el b/lisp/locate.el
index ab0417070e7..ff1d11d31bf 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -1,6 +1,6 @@
;;; locate.el --- interface to the locate command
-;; Copyright (C) 1996, 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Keywords: unix files
@@ -95,7 +95,7 @@
;;
;; (defadvice dired-make-relative (before set-no-error activate)
;; "For locate mode and Windows, don't return errors"
-;; (if (and (eq major-mode 'locate-mode)
+;; (if (and (derived-mode-p 'locate-mode)
;; (memq system-type '(windows-nt ms-dos)))
;; (ad-set-arg 2 t)
;; ))
@@ -448,7 +448,7 @@ file name or is inside a subdirectory."
;; Define a mode for locate
;; Default directory is set to "/" so that dired commands, which
;; expect to be in a tree, will work properly
-(defun locate-mode ()
+(define-derived-mode locate-mode special-mode "Locate"
"Major mode for the `*Locate*' buffer made by \\[locate].
\\<locate-mode-map>\
In that buffer, you can use almost all the usual dired bindings.
@@ -463,39 +463,31 @@ Specific `locate-mode' commands, such as \\[locate-find-directory],
do not work in subdirectories.
\\{locate-mode-map}"
- ;; Not to be called interactively.
- (kill-all-local-variables)
;; Avoid clobbering this variable
(make-local-variable 'dired-subdir-alist)
- (use-local-map locate-mode-map)
- (setq major-mode 'locate-mode
- mode-name "Locate"
- default-directory "/"
+ (setq default-directory "/"
buffer-read-only t
selective-display t)
(dired-alist-add-1 default-directory (point-min-marker))
(set (make-local-variable 'dired-directory) "/")
(set (make-local-variable 'dired-subdir-switches) locate-ls-subdir-switches)
(setq dired-switches-alist nil)
- (make-local-variable 'directory-listing-before-filename-regexp)
;; This should support both Unix and Windoze style names
- (setq directory-listing-before-filename-regexp
- (concat "^.\\("
- (make-string (1- locate-filename-indentation) ?\s)
- "\\)\\|"
- (default-value 'directory-listing-before-filename-regexp)))
- (make-local-variable 'dired-actual-switches)
- (setq dired-actual-switches "")
- (make-local-variable 'dired-permission-flags-regexp)
- (setq dired-permission-flags-regexp
- (concat "^.\\("
- (make-string (1- locate-filename-indentation) ?\s)
- "\\)\\|"
- (default-value 'dired-permission-flags-regexp)))
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'locate-update)
- (set (make-local-variable 'page-delimiter) "\n\n")
- (run-mode-hooks 'locate-mode-hook))
+ (setq-local directory-listing-before-filename-regexp
+ (concat "^.\\("
+ (make-string (1- locate-filename-indentation) ?\s)
+ "\\)\\|"
+ (default-value
+ 'directory-listing-before-filename-regexp)))
+ (setq-local dired-actual-switches "")
+ (setq-local dired-permission-flags-regexp
+ (concat "^.\\("
+ (make-string (1- locate-filename-indentation) ?\s)
+ "\\)\\|"
+ (default-value 'dired-permission-flags-regexp)))
+
+ (setq-local revert-buffer-function #'locate-update)
+ (setq-local page-delimiter "\n\n"))
(put 'locate-mode 'derived-mode-parent 'dired-mode)
(defun locate-do-setup (search-string)
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 5aed3bcc484..11cc8f86cfd 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,9 +1,9 @@
;;; lpr.el --- print Emacs buffer on line printer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2013 Free Software
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix
;; This file is part of GNU Emacs.
@@ -49,7 +49,7 @@
(defcustom printer-name
(and (eq system-type 'ms-dos) "PRN")
"The name of a local printer to which data is sent for printing.
-\(Note that PostScript files are sent to `ps-printer-name', which see.\)
+\(Note that PostScript files are sent to `ps-printer-name', which see.)
On Unix-like systems, a string value should be a name understood by
lpr's -P option; otherwise the value should be nil.
@@ -132,7 +132,7 @@ and print the result."
(defcustom print-region-function
(if (memq system-type '(ms-dos windows-nt))
- #'direct-print-region-function
+ #'w32-direct-print-region-function
#'call-process-region)
"Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
@@ -161,7 +161,7 @@ See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
(interactive
(unless (y-or-n-p "Send current buffer to default printer? ")
- (error "Cancelled")))
+ (error "Canceled")))
(print-region-1 (point-min) (point-max) lpr-switches nil))
;;;###autoload
@@ -180,7 +180,7 @@ See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
(interactive
(unless (y-or-n-p "Send current buffer to default printer? ")
- (error "Cancelled")))
+ (error "Canceled")))
(print-region-1 (point-min) (point-max) lpr-switches t))
;;;###autoload
@@ -191,7 +191,7 @@ for customization of the printer command."
(interactive
(if (y-or-n-p "Send selected text to default printer? ")
(list (region-beginning) (region-end))
- (error "Cancelled")))
+ (error "Canceled")))
(print-region-1 start end lpr-switches nil))
;;;###autoload
@@ -211,7 +211,7 @@ for further customization of the printer command."
(interactive
(if (y-or-n-p "Send selected text to default printer? ")
(list (region-beginning) (region-end))
- (error "Cancelled")))
+ (error "Canceled")))
(print-region-1 start end lpr-switches t))
(defun print-region-1 (start end switches page-headers)
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 82a78545d62..87f12ba673e 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -1,10 +1,10 @@
;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
-;; Copyright (C) 1992, 1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, dired
;; Package: emacs
@@ -27,11 +27,9 @@
;; OVERVIEW ==========================================================
-;; This file redefines the function `insert-directory' to implement it
-;; directly from Emacs lisp, without running ls in a subprocess. It
-;; is useful if you cannot afford to fork Emacs on a real memory UNIX,
-;; or other non-UNIX platforms if you don't have the ls
-;; program, or if you want a different format from what ls offers.
+;; This file advises the function `insert-directory' to implement it
+;; directly from Emacs lisp, without running ls in a subprocess.
+;; This is useful if you don't have ls installed (ie, on MS Windows).
;; This function can use regexps instead of shell wildcards. If you
;; enter regexps remember to double each $ sign. For example, to
@@ -115,6 +113,47 @@ update the dependent variables."
:type 'boolean
:group 'ls-lisp)
+(defcustom ls-lisp-use-string-collate
+ (cond ((memq ls-lisp-emulation '(MacOS UNIX)) nil)
+ (t t)) ; GNU/Linux or MS-Windows emulate GNU ls
+ "Non-nil causes ls-lisp to sort files in locale-dependent collation order.
+
+A value of nil means use ordinary string comparison (see `compare-strings')
+for sorting files. A non-nil value uses `string-collate-lessp' instead,
+which more closely emulates what GNU `ls' does.
+
+On GNU/Linux systems, if the locale's codeset specifies UTF-8, as
+in \"en_US.UTF-8\", the collation order follows the Unicode
+Collation Algorithm (UCA), which places together file names that
+differ only in punctuation characters. On MS-Windows, customize
+the option `ls-lisp-UCA-like-collation' to a non-nil value to get
+similar behavior."
+ :version "25.1"
+ :set-after '(ls-lisp-emulation)
+ :type 'boolean
+ :group 'ls-lisp)
+
+(defcustom ls-lisp-UCA-like-collation t
+ "Non-nil means force ls-lisp use a collation order compatible with UCA.
+
+UCA is the Unicode Collation Algorithm. GNU/Linux systems automatically
+follow it in their string-collation routines if the locale specifies
+UTF-8 as its codeset. On MS-Windows, customize this option to a non-nil
+value to get similar behavior.
+
+When this option is non-nil, and `ls-lisp-use-string-collate' is also
+non-nil, the collation order produced on MS-Windows will ignore
+punctuation and symbol characters, which will, for example, place
+`.foo' near `foo'. See the documentation of `string-collate-lessp'
+and `w32-collate-ignore-punctuation' for more details.
+
+This option is ignored on platforms other than MS-Windows; to
+control the collation ordering of the file names on those other
+systems, set your locale instead."
+ :version "25.1"
+ :type 'boolean
+ :group 'ls-lisp)
+
(defcustom ls-lisp-dirs-first (eq ls-lisp-emulation 'MS-Windows)
"Non-nil causes ls-lisp to sort directories first in any ordering.
\(Or last if it is reversed.) Follows Microsoft Windows Explorer."
@@ -183,7 +222,7 @@ current year. The OLD-TIME-FORMAT is used for older files. To use ISO
8601 dates, you could set:
\(setq ls-lisp-format-time-list
- '(\"%Y-%m-%d %H:%M\"
+ \\='(\"%Y-%m-%d %H:%M\"
\"%Y-%m-%d \"))"
:type '(list (string :tag "Early time format")
(string :tag "Old time format"))
@@ -198,30 +237,24 @@ to fail to line up, e.g. if month names are not all of the same length."
:type 'boolean
:group 'ls-lisp)
-(defvar original-insert-directory nil
- "This holds the original function definition of `insert-directory'.")
-
-(defvar ls-lisp-uid-d-fmt "-%d"
+(defvar ls-lisp-uid-d-fmt " %d"
"Format to display integer UIDs.")
-(defvar ls-lisp-uid-s-fmt "-%s"
+(defvar ls-lisp-uid-s-fmt " %s"
"Format to display user names.")
-(defvar ls-lisp-gid-d-fmt "-%d"
+(defvar ls-lisp-gid-d-fmt " %d"
"Format to display integer GIDs.")
-(defvar ls-lisp-gid-s-fmt "-%s"
+(defvar ls-lisp-gid-s-fmt " %s"
"Format to display user group names.")
(defvar ls-lisp-filesize-d-fmt "%d"
"Format to display integer file sizes.")
(defvar ls-lisp-filesize-f-fmt "%.0f"
"Format to display float file sizes.")
-
-;; Remember the original insert-directory function
-(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
- (setq original-insert-directory (symbol-function 'insert-directory)))
-
+(defvar ls-lisp-filesize-b-fmt "%.0f"
+ "Format to display file sizes in blocks (for the -s switch).")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun insert-directory (file switches &optional wildcard full-directory-p)
+(defun ls-lisp--insert-directory (orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings.
@@ -231,21 +264,19 @@ switches do not contain `d', so that a full listing is expected.
This version of the function comes from `ls-lisp.el'.
If the value of `ls-lisp-use-insert-directory-program' is non-nil then
-it works exactly like the version from `files.el' and runs a directory
-listing program whose name is in the variable
-`insert-directory-program'; if also WILDCARD is non-nil then it runs
-the shell specified by `shell-file-name'. If the value of
-`ls-lisp-use-insert-directory-program' is nil then it runs a Lisp
-emulation.
+this advice just delegates the work to ORIG-FUN (the normal `insert-directory'
+function from `files.el').
+But if the value of `ls-lisp-use-insert-directory-program' is nil
+then it runs a Lisp emulation.
The Lisp emulation does not run any external programs or shells. It
supports ordinary shell wildcards if `ls-lisp-support-shell-wildcards'
is non-nil; otherwise, it interprets wildcards as regular expressions
to match file names. It does not support all `ls' switches -- those
-that work are: A a B C c F G g h i n R r S s t U u X. The l switch
+that work are: A a B C c F G g h i n R r S s t U u v X. The l switch
is assumed to be always present and cannot be turned off."
(if ls-lisp-use-insert-directory-program
- (funcall original-insert-directory
+ (funcall orig-fun
file switches wildcard full-directory-p)
;; We need the directory in order to find the right handler.
(let ((handler (find-file-name-handler (expand-file-name file)
@@ -305,6 +336,7 @@ is assumed to be always present and cannot be turned off."
(replace-match "total used in directory")
(end-of-line)
(insert " available " available)))))))))
+(advice-add 'insert-directory :around #'ls-lisp--insert-directory)
(defun ls-lisp-insert-directory
(file switches time-index wildcard-regexp full-directory-p)
@@ -367,17 +399,15 @@ not contain `d', so that a full listing is expected."
(setq ls-lisp-gid-d-fmt (format " %%-%dd" max-gid-len))
(setq ls-lisp-gid-s-fmt (format " %%-%ds" max-gid-len))
(setq ls-lisp-filesize-d-fmt
- (format " %%%dd"
- (if (memq ?s switches)
- (length (format "%.0f"
- (fceiling (/ max-file-size 1024.0))))
- (length (format "%.0f" max-file-size)))))
+ (format " %%%dd" (length (format "%.0f" max-file-size))))
(setq ls-lisp-filesize-f-fmt
- (format " %%%d.0f"
- (if (memq ?s switches)
+ (format " %%%d.0f" (length (format "%.0f" max-file-size))))
+ (if (memq ?s switches)
+ (setq ls-lisp-filesize-b-fmt
+ (format "%%%d.0f "
(length (format "%.0f"
- (fceiling (/ max-file-size 1024.0))))
- (length (format "%.0f" max-file-size)))))
+ (fceiling
+ (/ max-file-size 1024.0)))))))
(setq files file-alist)
(while files ; long (-l) format
(setq elt (car files)
@@ -506,11 +536,81 @@ Responds to the window width as ls should but may not!"
result))
(defsubst ls-lisp-string-lessp (s1 s2)
- "Return t if string S1 is less than string S2 in lexicographic order.
+ "Return t if string S1 should sort before string S2.
+Case is significant if `ls-lisp-ignore-case' is nil.
+Uses `string-collate-lessp' if `ls-lisp-use-string-collate' is non-nil,
+`compare-strings' otherwise.
+On GNU/Linux systems, if the locale specifies UTF-8 as the codeset,
+the sorting order will place together file names that differ only
+by punctuation characters, like `.emacs' and `emacs'. To have a
+similar behavior on MS-Windows, customize `ls-lisp-UCA-like-collation'
+to a non-nil value."
+ (let ((w32-collate-ignore-punctuation ls-lisp-UCA-like-collation))
+ (if ls-lisp-use-string-collate
+ (string-collate-lessp s1 s2 nil ls-lisp-ignore-case)
+ (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case)))
+ (and (numberp u) (< u 0))))))
+
+(defun ls-lisp-version-lessp (s1 s2)
+ "Return t if versioned string S1 should sort before versioned string S2.
+
Case is significant if `ls-lisp-ignore-case' is nil.
-Unibyte strings are converted to multibyte for comparison."
- (let ((u (compare-strings s1 0 nil s2 0 nil ls-lisp-ignore-case)))
- (and (numberp u) (< u 0))))
+This is the same as string-lessp (with the exception of case
+insensitivity), but sequences of digits are compared numerically,
+as a whole, in the same manner as the `strverscmp' function available
+in some standard C libraries does."
+ (let ((i1 0)
+ (i2 0)
+ (len1 (length s1))
+ (len2 (length s2))
+ (val 0)
+ ni1 ni2 e1 e2 found-2-numbers-p)
+ (while (and (< i1 len1) (< i2 len2) (zerop val))
+ (unless found-2-numbers-p
+ (setq ni1 (string-match "[0-9]+" s1 i1)
+ e1 (match-end 0))
+ (setq ni2 (string-match "[0-9]+" s2 i2)
+ e2 (match-end 0)))
+ (cond
+ ((and ni1 ni2)
+ (cond
+ ((and (> ni1 i1) (> ni2 i2))
+ ;; Compare non-numerical part as strings.
+ (setq val (compare-strings s1 i1 ni1 s2 i2 ni2 ls-lisp-ignore-case)
+ i1 ni1
+ i2 ni2
+ found-2-numbers-p t))
+ ((and (= ni1 i1) (= ni2 i2))
+ (setq found-2-numbers-p nil)
+ ;; Compare numerical parts as integral and/or fractional parts.
+ (let* ((sub1 (substring s1 ni1 e1))
+ (sub2 (substring s2 ni2 e2))
+ ;; "Fraction" is a numerical sequence with leading zeros.
+ (fr1 (string-match "\\`0+" sub1))
+ (fr2 (string-match "\\`0+" sub2)))
+ (cond
+ ((and fr1 fr2) ; two fractions, the shortest wins
+ (setq val (- val (- (length sub1) (length sub2)))))
+ (fr1 ; a fraction is always less than an integral
+ (setq val (- ni1)))
+ (fr2
+ (setq val ni2)))
+ (if (zerop val) ; fall back on numerical comparison
+ (setq val (- (string-to-number sub1)
+ (string-to-number sub2))))
+ (setq i1 e1
+ i2 e2)))
+ (t
+ (setq val (compare-strings s1 i1 nil s2 i2 nil ls-lisp-ignore-case)
+ i1 len1
+ i2 len2))))
+ (t (setq val (compare-strings s1 i1 nil s2 i2 nil ls-lisp-ignore-case)
+ i1 len1
+ i2 len2)))
+ (and (eq val t) (setq val 0)))
+ (if (zerop val)
+ (setq val (- len1 len2)))
+ (< val 0)))
(defun ls-lisp-handle-switches (file-alist switches)
"Return new FILE-ALIST sorted according to SWITCHES.
@@ -538,6 +638,9 @@ SWITCHES is a list of characters. Default sorting is alphabetic."
(ls-lisp-string-lessp
(ls-lisp-extension (car x))
(ls-lisp-extension (car y)))))
+ ((memq ?v switches)
+ (lambda (x y) ; sorted by version number
+ (ls-lisp-version-lessp (car x) (car y))))
(t
(lambda (x y) ; sorted alphabetically
(ls-lisp-string-lessp (car x) (car y))))))))
@@ -566,7 +669,7 @@ SWITCHES is a list of characters. Default sorting is alphabetic."
))))
;; Finally reverse file alist if necessary.
;; (eq below MUST compare `(not (memq ...))' to force comparison of
- ;; `t' or `nil', rather than list tails!)
+ ;; t or nil, rather than list tails!)
(if (eq (eq (not (memq ?U switches)) ; unsorted order is reversed
(not (memq ?r switches))) ; reversed sort order requested
ls-lisp-dirs-first) ; already reversed
@@ -664,9 +767,20 @@ SWITCHES and TIME-INDEX give the full switch list and time data."
(cdr inode))))
(format " %18d " inode))))
;; nil is treated like "" in concat
- (if (memq ?s switches) ; size in K
- (format ls-lisp-filesize-f-fmt
- (fceiling (/ file-size 1024.0))))
+ (if (memq ?s switches) ; size in K, rounded up
+ ;; In GNU ls, -h affects the size in blocks, displayed
+ ;; by -s, as well.
+ (if (memq ?h switches)
+ (format "%6s "
+ (file-size-human-readable
+ ;; We use 1K as "block size", although
+ ;; most Windows volumes use 4KB to 8KB
+ ;; clusters, and exFAT will usually have
+ ;; clusters of 32KB or even 128KB. See
+ ;; KB article 140365 for the details.
+ (* 1024.0 (fceiling (/ file-size 1024.0)))))
+ (format ls-lisp-filesize-b-fmt
+ (fceiling (/ file-size 1024.0)))))
drwxrwxrwx ; attribute string
(if (memq 'links ls-lisp-verbosity)
(format "%3d" (nth 1 file-attr))) ; link count
@@ -748,7 +862,7 @@ All ls time options, namely c, t and u, are handled."
ls-lisp-filesize-f-fmt
ls-lisp-filesize-d-fmt)
file-size)
- (format " %7s" (file-size-human-readable file-size))))
+ (format " %6s" (file-size-human-readable file-size))))
(provide 'ls-lisp)
diff --git a/lisp/macros.el b/lisp/macros.el
index b6db9bdcdef..101f8b4a2a1 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,9 +1,9 @@
;;; macros.el --- non-primitive commands for keyboard macros
-;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2013 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev
;; Package: emacs
@@ -39,19 +39,20 @@ The symbol's function definition becomes the keyboard macro string.
Such a \"function\" cannot be called from Lisp, but it is a valid editor command."
(interactive "SName for last kbd macro: ")
(or last-kbd-macro
- (error "No keyboard macro defined"))
+ (user-error "No keyboard macro defined"))
(and (fboundp symbol)
(not (stringp (symbol-function symbol)))
(not (vectorp (symbol-function symbol)))
- (error "Function %s is already defined and not a keyboard macro"
+ (user-error "Function %s is already defined and not a keyboard macro"
symbol))
(if (string-equal symbol "")
- (error "No command name given"))
+ (user-error "No command name given"))
(fset symbol last-kbd-macro))
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
- "Insert in buffer the definition of kbd macro NAME, as Lisp code.
+ "Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
+MACRONAME should be a symbol.
Optional second arg KEYS means also record the keys it is on
\(this is the prefix argument, when calling interactively).
@@ -165,7 +166,7 @@ Your options are: \\<query-replace-map>
(interactive "P")
(or executing-kbd-macro
defining-kbd-macro
- (error "Not defining or executing kbd macro"))
+ (user-error "Not defining or executing kbd macro"))
(if flag
(let (executing-kbd-macro defining-kbd-macro)
(recursive-edit))
@@ -259,7 +260,7 @@ and then select the region of un-tablified names and use
(or macro
(progn
(if (null last-kbd-macro)
- (error "No keyboard macro has been defined"))
+ (user-error "No keyboard macro has been defined"))
(setq macro last-kbd-macro)))
(save-excursion
(let ((end-marker (copy-marker bottom))
diff --git a/lisp/mail/.gitignore b/lisp/mail/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/mail/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index df12b6369f0..2a2137e057a 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -1,6 +1,6 @@
;;; binhex.el --- decode BinHex-encoded text
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: binhex news
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index 64d51a2f020..3290f30815a 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -1,8 +1,8 @@
;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t -*-
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index c1bc7e2e1ab..8e28973c43f 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,10 +1,10 @@
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2013 Free Software
+;; Copyright (C) 1985, 1994, 1997-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: maint mail
;; Package: emacs
@@ -43,11 +43,6 @@
(define-obsolete-variable-alias 'report-emacs-bug-pretest-address
'report-emacs-bug-address "24.1")
-(defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org"
- "Address of mailing list for GNU Emacs bugs."
- :group 'emacsbug
- :type 'string)
-
(defcustom report-emacs-bug-no-confirmation nil
"If non-nil, suppress the confirmations asked for the sake of novice users."
:group 'emacsbug
@@ -142,13 +137,18 @@ This requires either the OS X \"open\" command, or the freedesktop
(concat "mailto:" to)))
(error "Subject, To or body not found")))))
+;; It's the default mail mode, so it seems OK to use its features.
+(autoload 'message-bogus-recipient-p "message")
+(autoload 'message-make-address "message")
+(defvar message-send-mail-function)
+(defvar message-sendmail-envelope-from)
+
;;;###autoload
-(defun report-emacs-bug (topic &optional recent-keys)
+(defun report-emacs-bug (topic &optional unused)
"Report a bug in GNU Emacs.
Prompts for bug subject. Leaves you in a mail buffer."
- ;; This strange form ensures that (recent-keys) is the value before
- ;; the bug subject string is read.
- (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
+ (declare (advertised-calling-convention (topic) "24.5"))
+ (interactive "sBug Subject: ")
;; The syntax `version;' is preferred to `[version]' because the
;; latter could be mistakenly stripped by mailing software.
(if (eq system-type 'ms-dos)
@@ -160,7 +160,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
(report-emacs-bug-can-use-osx-open)))
user-point message-end-point)
(setq message-end-point
- (with-current-buffer (get-buffer-create "*Messages*")
+ (with-current-buffer (messages-buffer)
(point-max-marker)))
(compose-mail report-emacs-bug-address topic)
;; The rest of this does not execute if the user was asked to
@@ -170,7 +170,12 @@ Prompts for bug subject. Leaves you in a mail buffer."
;; that report-emacs-bug-orig-text remains valid. (Bug#5178)
(message-sort-headers)
;; Stop message-mode stealing the properties we will add.
- (set (make-local-variable 'message-strip-special-text-properties) nil))
+ (set (make-local-variable 'message-strip-special-text-properties) nil)
+ ;; Make sure we default to the From: address as envelope when sending
+ ;; through sendmail.
+ (when (and (not message-sendmail-envelope-from)
+ (message-bogus-recipient-p (message-make-address)))
+ (set (make-local-variable 'message-sendmail-envelope-from) 'header)))
(rfc822-goto-eoh)
(forward-line 1)
;; Move the mail signature to the proper place.
@@ -210,7 +215,7 @@ usually do not have translators for other languages.\n\n")))
(insert "Please describe exactly what actions triggered the bug, and\n"
"the precise symptoms of the bug. If you can, give a recipe\n"
- "starting from `emacs -Q':\n\n")
+ "starting from 'emacs -Q':\n\n")
(let ((txt (delete-and-extract-region
(save-excursion (rfc822-goto-eoh) (line-beginning-position 2))
(point))))
@@ -220,7 +225,7 @@ usually do not have translators for other languages.\n\n")))
(insert "If Emacs crashed, and you have the Emacs process in the gdb debugger,\n"
"please include the output from the following gdb commands:\n"
- " `bt full' and `xbacktrace'.\n")
+ " 'bt full' and 'xbacktrace'.\n")
(let ((debug-file (expand-file-name "DEBUG" data-directory)))
(if (file-readable-p debug-file)
@@ -230,12 +235,12 @@ usually do not have translators for other languages.\n\n")))
(insert (propertize "\n" 'display txt)))
(insert "\n\nIn " (emacs-version) "\n")
- (if (stringp emacs-bzr-version)
- (insert "Bzr revision: " emacs-bzr-version "\n"))
+ (if (stringp emacs-repository-version)
+ (insert "Repository revision: " emacs-repository-version "\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)
+ (insert "Windowing system distributor '" (x-server-vendor)
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
@@ -248,9 +253,11 @@ usually do not have translators for other languages.\n\n")))
(insert "System " lsb "\n")))
(when (and system-configuration-options
(not (equal system-configuration-options "")))
- (insert "Configured using:\n `configure "
+ (insert "Configured using:\n 'configure "
system-configuration-options "'\n\n")
(fill-region (line-beginning-position -1) (point)))
+ (insert "Configured features:\n" system-configuration-features "\n\n")
+ (fill-region (line-beginning-position -1) (point))
(insert "Important settings:\n")
(mapc
(lambda (var)
@@ -260,8 +267,11 @@ usually do not have translators for other languages.\n\n")))
"LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
"LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
- (insert (format " default enable-multibyte-characters: %s\n"
- (default-value 'enable-multibyte-characters)))
+ ;; Only ~ 0.2% of people from a sample of 3200 changed this from
+ ;; the default, t.
+ (or (default-value 'enable-multibyte-characters)
+ (insert (format " default enable-multibyte-characters: %s\n"
+ (default-value 'enable-multibyte-characters))))
(insert "\n")
(insert (format "Major mode: %s\n"
(format-mode-line
@@ -273,23 +283,6 @@ usually do not have translators for other languages.\n\n")))
(and (boundp mode) (buffer-local-value mode from-buffer)
(insert (format " %s: %s\n" mode
(buffer-local-value mode from-buffer)))))
- (insert "\n")
- (insert "Recent input:\n")
- (let ((before-keys (point)))
- (insert (mapconcat (lambda (key)
- (if (or (integerp key)
- (symbolp key)
- (listp key))
- (single-key-description key)
- (prin1-to-string key nil)))
- (or recent-keys (recent-keys))
- " "))
- (save-restriction
- (narrow-to-region before-keys (point))
- (goto-char before-keys)
- (while (progn (move-to-column 50) (not (eobp)))
- (search-forward " " nil t)
- (insert "\n"))))
(let ((message-buf (get-buffer "*Messages*")))
(if message-buf
(let (beg-pos
@@ -298,11 +291,11 @@ usually do not have translators for other languages.\n\n")))
(goto-char end-pos)
(forward-line -10)
(setq beg-pos (point)))
- (insert "\n\nRecent messages:\n")
+ (insert "\nRecent messages:\n")
(insert-buffer-substring message-buf beg-pos end-pos))))
;; After Recent messages, to avoid the messages produced by
;; list-load-path-shadows.
- (unless (looking-back "\n")
+ (unless (looking-back "\n" (1- (point)))
(insert "\n"))
(insert "\n")
(insert "Load-path shadows:\n")
@@ -319,6 +312,10 @@ usually do not have translators for other languages.\n\n")))
shadows)))
(insert (format "\nFeatures:\n%s\n" features))
(fill-region (line-beginning-position 0) (point))
+
+ (insert (format "\nMemory information:\n"))
+ (pp (garbage-collect) (current-buffer))
+
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
(define-key (current-local-map) "\C-c\C-i" 'info-emacs-bug)
@@ -360,10 +357,6 @@ usually do not have translators for other languages.\n\n")))
(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3")
-;; It's the default mail mode, so it seems OK to use its features.
-(autoload 'message-bogus-recipient-p "message")
-(defvar message-send-mail-function)
-
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
(save-excursion
@@ -396,7 +389,7 @@ and send the mail again%s."
(format " using \\[%s]"
report-emacs-bug-send-command)
"")))))
- (error "M-x report-emacs-bug was cancelled, please read *Bug Help* buffer"))
+ (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.
@@ -424,7 +417,8 @@ and send the mail again%s."
(regexp-quote (system-name)))
from))
(not (yes-or-no-p
- (format "Is `%s' really your email address? " from)))
+ (format-message "Is `%s' really your email address? "
+ from)))
(error "Please edit the From address and try again"))))))
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 7f27599edf2..aec93db3fa6 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -399,10 +399,10 @@
"If non-nil, give a y-or-n confirmation prompt before sending mail.
This is done after the message is completely prepped, and you'll be
looking at the top of the message in a buffer when you get the prompt.
-If set to the symbol 'queued, give the confirmation prompt only while
+If set to the symbol `queued', give the confirmation prompt only while
running the queue (however, the prompt is always suppressed if you are
processing the queue via `feedmail-run-the-queue-no-prompts'). If set
-to the symbol 'immediate, give the confirmation prompt only when
+to the symbol `immediate', give the confirmation prompt only when
sending immediately. For any other non-nil value, prompt in both
cases. You can give a timeout for the prompt; see variable
`feedmail-confirm-outgoing-timeout'."
@@ -418,9 +418,9 @@ cases. You can give a timeout for the prompt; see variable
If nil, the prepped message will be shown, for confirmation or
otherwise, in some window in the current frame without resizing
anything. That may or may not display enough of the message to
-distinguish it from others. If set to the symbol 'queued, take
+distinguish it from others. If set to the symbol `queued', take
this action only when running the queue. If set to the symbol
-'immediate, take this action only when sending immediately. For
+`immediate', take this action only when sending immediately. For
any other non-nil value, take the action in both cases. Even if
you're not confirming the sending of immediate or queued messages,
it can still be interesting to see a lot about them as they are
@@ -438,7 +438,7 @@ shuttled robotically onward."
If a positive number, it's a timeout before sending. If a negative
number, it's a timeout before not sending. This will not work if your
version of Emacs doesn't include the function `y-or-n-p-with-timeout'
-\(e.g., some versions of XEmacs\)."
+\(e.g., some versions of XEmacs)."
:version "24.1"
:group 'feedmail-misc
:type '(choice (const nil) integer)
@@ -449,7 +449,7 @@ version of Emacs doesn't include the function `y-or-n-p-with-timeout'
"If non-nil remove Bcc: lines from the message headers.
In any case, the Bcc: lines do participate in the composed address
list. You may want to leave them in if you're using sendmail
-\(see `feedmail-buffer-eating-function'\)."
+\(see `feedmail-buffer-eating-function')."
:group 'feedmail-headers
:type 'boolean
)
@@ -459,7 +459,7 @@ list. You may want to leave them in if you're using sendmail
"If non-nil remove Resent-Bcc: lines from the message headers.
In any case, the Resent-Bcc: lines do participate in the composed
address list. You may want to leave them in if you're using sendmail
-\(see `feedmail-buffer-eating-function'\)."
+\(see `feedmail-buffer-eating-function')."
:group 'feedmail-headers
:type 'boolean
)
@@ -471,9 +471,9 @@ Addresses for the message envelope are deduced by examining
appropriate address headers in the message. Generally, they will show
up in the list of deduced addresses in the order that the headers
happen to appear (duplicate addresses are eliminated in any case).
-This variable can be set to the symbol 'first, in which case the
+This variable can be set to the symbol `first', in which case the
Bcc:/Resent-Bcc: addresses will appear at the beginning in the list;
-or, it can be set to the symbol 'last, in which case they will appear
+or, it can be set to the symbol `last', in which case they will appear
at the end of the list.
Why should you care? Well, maybe you don't, and certainly the same
@@ -484,7 +484,7 @@ addresses are not handled first, there can be substantial delays in
seeing the message again. Some configurations of sendmail, for example,
seem to try to deliver to each addressee at least once, immediately
and serially, so slow SMTP conversations can add up to a delay. There
-is an option for either 'first or 'last because you might have a
+is an option for either `first' or `last' because you might have a
delivery agent that processes the addresses backwards."
:group 'feedmail-headers
:type '(choice (const nil)
@@ -566,7 +566,7 @@ but common in some proprietary systems."
"If non-nil and the email has no Sender: header, use this value.
May be nil, in which case nothing in particular is done with respect
to Sender: lines. By design, will not replace an existing Sender:
-line, but you can achieve that with a fiddle-plex 'replace action.
+line, but you can achieve that with a fiddle-plex replace action.
NB: it makes no sense to use the value t since there is no sensible
default for Sender:.
@@ -645,7 +645,7 @@ is not an option for many users. As this is the default behavior of most
sendmail installations, one can mostly only wish it were otherwise. If feedmail
believes the sendmail program will sell you out this way, it won't use the \"-f\"
option when calling sendmail. If it doesn't think sendmail will sell you out,
-it will use the \"-f\" \(since it is a handy feature\). You control what
+it will use the \"-f\" \(since it is a handy feature). You control what
feedmail thinks with this variable. The default is nil, meaning that feedmail
will believe that sendmail will sell you out."
:version "24.1"
@@ -861,7 +861,7 @@ as well."
"User-supplied specification for a crude form of mailmerge capability.
When spraying is enabled, feedmail composes a list of envelope addresses.
In turn, `feedmail-spray-this-address' is temporarily set to each address
-\(stripped of any comments and angle brackets\) and a function is called which
+\(stripped of any comments and angle brackets) and a function is called which
fiddles message headers according to this variable. See the documentation for
`feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
@@ -1231,7 +1231,7 @@ If a string, it is used directly.
If a function, it is called with no arguments from the buffer containing the raw
text of the message. It must return a string (which may be empty).
-If the symbol 'ask, you will be prompted for a string in the mini-buffer.
+If the symbol `ask', you will be prompted for a string in the mini-buffer.
Filename completion is available so that you can inspect what's already been
used, but feedmail will do further manipulation on the string you return, so
it's not expected to be a complete filename."
@@ -1301,27 +1301,27 @@ the fact in the messages buffer."
(defvar feedmail-queue-buffer-file-name nil
- "If non-nil, has the value normally expected of 'buffer-file-name'.
+ "If non-nil, has the value normally expected of `buffer-file-name'.
You are not intended to set this to something in your configuration. Rather,
you might programmatically set it to something via a hook or function
advice or whatever. You might like to do this if you are using a mail
-composition program that eventually uses sendmail.el's 'mail-send'
+composition program that eventually uses sendmail.el's `mail-send'
function to process the message. If there is a filename associated
-with the message buffer, 'mail-send' will ask you for confirmation.
+with the message buffer, `mail-send' will ask you for confirmation.
There's no trivial way to avoid it. It's unwise to just set the value
-of 'buffer-file-name' to nil because that will defeat feedmail's file
+of `buffer-file-name' to nil because that will defeat feedmail's file
management features. Instead, arrange for this variable to be set to
-the value of 'buffer-file-name' before setting that to nil. An easy way
-to do that would be with defadvice on 'mail-send' \(undoing the
-assignments in a later advice\).
+the value of `buffer-file-name' before setting that to nil. An easy way
+to do that would be with defadvice on `mail-send' \(undoing the
+assignments in a later advice).
-feedmail will pretend that 'buffer-file-name', if nil, has the value
-assigned of 'feedmail-queue-buffer-file-name' and carry out its normal
+feedmail will pretend that `buffer-file-name', if nil, has the value
+assigned of `feedmail-queue-buffer-file-name' and carry out its normal
activities. feedmail does not restore the non-nil value of
-'buffer-file-name'. For safe bookkeeping, the user should insure that
+`buffer-file-name'. For safe bookkeeping, the user should insure that
feedmail-queue-buffer-file-name is restored to nil.
-Example 'defadvice' for mail-send:
+Example `defadvice' for mail-send:
(defadvice mail-send (before feedmail-mail-send-before-advice activate)
(setq feedmail-queue-buffer-file-name buffer-file-name)
@@ -1354,7 +1354,7 @@ If you have `mail-send-hook' functions that should only be called for sending/
queueing messages or only be called for the sending of queued messages, this is
for you. Add this function to `mail-send-hook' with something like this:
- (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
+ (add-hook \\='mail-send-hook \\='feedmail-mail-send-hook-splitter)
Then add the functions you want called to either `feedmail-mail-send-hook-queued'
or `feedmail-mail-send-hook', as appropriate. The distinction is that
@@ -1507,7 +1507,7 @@ The default action is an anonymous function which gets rid of the file
from the queue directory. With a non-nil second argument, a brief
message is give for each file deleted. You could replace this
function, for example, to archive all of your sent messages someplace
-\(though there are better ways to get that particular result\)."
+\(though there are better ways to get that particular result)."
:group 'feedmail-queue
:type 'function
)
@@ -1551,7 +1551,7 @@ See feedmail-binmail-template documentation."
"/bin/rmail %s" "/bin/mail %s"))
"Command template for the subprocess which will get rid of the mail.
It can result in any command understandable by /bin/sh. Might not
-work at all in non-UNIX environments. The single '%s', if present,
+work at all in non-UNIX environments. The single `%s', if present,
gets replaced by the space-separated, simplified list of addressees.
Used in `feedmail-buffer-to-binmail' to form the shell command which
will receive the contents of the prepped buffer as stdin. The default
@@ -1715,7 +1715,7 @@ for ACTION (default is `supplement'):
VAL-LIKE is not used. Else, if VAL-LIKE is a function,
it is called with two arguments: NAME and the
aggregate like values. Else, if VAL-LIKE is a string, it is
- used as a format string where a single \%s will be
+ used as a format string where a single %s will be
replaced by the aggregate values of like fields.
VAL-PRE, the results of using VAL-LIKE, and VAL-POST
@@ -1745,7 +1745,8 @@ applied to a file after you've just read it from disk: for example, a
feedmail FQM message file from a queue. You could use something like
this:
-\(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
+\(setq auto-mode-alist
+ (cons \\='(\"\\\\.fqm$\" . feedmail-vm-mail-mode) auto-mode-alist))
"
(feedmail-say-debug ">in-> feedmail-vm-mail-mode")
(let ((the-buf (current-buffer)))
@@ -1889,32 +1890,33 @@ with various lower-level mechanisms to provide features such as queueing."
(defun feedmail-message-action-help-blat (d-string)
(feedmail-say-debug ">in-> feedmail-message-action-help-blat")
(with-output-to-temp-buffer feedmail-p-h-b-n
- (princ "You're dispatching a message and feedmail queuing is enabled.
+ (princ (substitute-command-keys "\
+You're dispatching a message and feedmail queuing is enabled.
Typing ? again will normally scroll this help buffer.
Choices:
- q QUEUE for later sending \(via feedmail-run-the-queue\)
+ q QUEUE for later sending (via feedmail-run-the-queue)
Q QUEUE! like \"q\", but always make a new file
- i IMMEDIATELY send this \(but not the other queued messages\)
+ i IMMEDIATELY send this (but not the other queued messages)
I IMMEDIATELY! like \"i\", but skip following confirmation prompt
d DRAFT queue in the draft directory
D DRAFT! like \"d\", but always make a new file
- e EDIT return to the message edit buffer \(don't send or queue\)
- * SPRAY toggle spray mode \(individual message transmissions\)
- > SCROLL UP scroll message up \(toward end of message\)
- < SCROLL DOWN scroll message down \(toward beginning of message\)
+ e EDIT return to the message edit buffer (don't send or queue)
+ * SPRAY toggle spray mode (individual message transmissions)
+ > SCROLL UP scroll message up (toward end of message)
+ < SCROLL DOWN scroll message down (toward beginning of message)
? HELP show or scroll this help buffer
Synonyms:
- s SEND immediately \(same as \"i\"\)
- S SEND! immediately \(same as \"I\"\)
- r ROUGH draft \(same as \"d\"\)
- R ROUGH! draft \(same as \"D\"\)
- n NOPE didn't mean it \(same as \"e\"\)
- y YUP do the default behavior \(same as \"C-m\"\)
- SPC SCROLL UP \(same as \">\"\)
-
-The user-configurable default is currently \"")
+ s SEND immediately (same as \"i\")
+ S SEND! immediately (same as \"I\")
+ r ROUGH draft (same as \"d\")
+ R ROUGH! draft (same as \"D\")
+ n NOPE didn't mean it (same as \"e\")
+ y YUP do the default behavior (same as \"C-m\")
+ SPC SCROLL UP (same as \">\")
+
+The user-configurable default is currently \""))
(princ d-string)
(princ "\". For other possibilities,
see the variable feedmail-prompt-before-queue-user-alist.
@@ -2053,7 +2055,7 @@ backup file names and the like)."
;; the handler for the condition-case
(error (setq messages-skipped (1+ messages-skipped))
(ding t)
- (message "FQM: Trapped '%s', message left in queue." (car signal-stuff))
+ (message "FQM: Trapped `%s', message left in queue." (car signal-stuff))
(sit-for 3)
(message "FQM: Trap details: \"%s\""
(mapconcat 'identity (cdr signal-stuff) "\" \""))
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 7ded4c31cf5..839e24c8a90 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -1,6 +1,6 @@
-;;; footnote.el --- footnote support for message mode -*- coding: utf-8;-*-
+;;; footnote.el --- footnote support for message mode
-;; Copyright (C) 1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Steven L Baur <steve@xemacs.org>
;; Keywords: mail, news
@@ -45,6 +45,7 @@
(defcustom footnote-mode-line-string " FN"
"String to display in modes section of the mode-line."
+ :type 'string
:group 'footnote)
(defcustom footnote-mode-hook nil
@@ -86,10 +87,8 @@ displaying footnotes."
"Prefix key to use for Footnote command in Footnote minor mode.
The value of this variable is checked as part of loading Footnote mode.
After that, changing the prefix key requires manipulating keymaps."
- ;; FIXME: the type should be a key-sequence, but it seems Custom
- ;; doesn't support that yet.
- ;; :type 'string
- )
+ :type 'key-sequence
+ :group 'footnote)
;;; Interface variables that probably shouldn't be changed
@@ -719,7 +718,7 @@ delete the footnote with that number."
end
(point-max))))
(Footnote-goto-char-point-max)
- (when (looking-back "\n\n")
+ (when (looking-back "\n\n" (- (point) 2))
(kill-line -1))))))))
(defun Footnote-renumber-footnotes (&optional arg)
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index b6df075f7ef..70170654f67 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,6 +1,6 @@
;;; hashcash.el --- Add hashcash payments to email
-;; Copyright (C) 2003-2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2005, 2007-2015 Free Software Foundation, Inc.
;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
@@ -47,10 +47,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl)) ; for case
(defgroup hashcash nil
@@ -89,20 +85,25 @@ present, is the string to be hashed; if not present ADDR will be used."
Resources named here are to be accepted in incoming payments. If the
corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
is used instead."
+ :type 'alist
:group 'hashcash)
-(defcustom hashcash-path (executable-find "hashcash")
- "The path to the hashcash binary."
+(define-obsolete-variable-alias 'hashcash-path 'hashcash-program "24.4")
+(defcustom hashcash-program "hashcash"
+ "The name of the hashcash executable.
+If this is not in your PATH, specify an absolute file name."
+ :type '(choice (const nil) file)
:group 'hashcash)
(defcustom hashcash-extra-generate-parameters nil
- "A list of parameter strings passed to `hashcash-path' when minting.
+ "A list of parameter strings passed to `hashcash-program' when minting.
For example, you may want to set this to '(\"-Z2\") to reduce header length."
:type '(repeat string)
:group 'hashcash)
(defcustom hashcash-double-spend-database "hashcash.db"
- "The path to the double-spending database."
+ "The name of the double-spending database file."
+ :type 'file
:group 'hashcash)
(defcustom hashcash-in-news nil
@@ -159,10 +160,10 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length."
(defun hashcash-generate-payment (str val)
"Generate a hashcash payment by finding a VAL-bit collison on STR."
(if (and (> val 0)
- hashcash-path)
+ hashcash-program)
(with-current-buffer (get-buffer-create " *hashcash*")
(erase-buffer)
- (apply 'call-process hashcash-path nil t nil
+ (apply 'call-process hashcash-program nil t nil
"-m" "-q" "-b" (number-to-string val) str
hashcash-extra-generate-parameters)
(goto-char (point-min))
@@ -173,9 +174,9 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length."
"Generate a hashcash payment by finding a VAL-bit collison on STR.
Return immediately. Call CALLBACK with process and result when ready."
(if (and (> val 0)
- hashcash-path)
+ hashcash-program)
(let ((process (apply 'start-process "hashcash" nil
- hashcash-path "-m" "-q"
+ hashcash-program "-m" "-q"
"-b" (number-to-string val) str
hashcash-extra-generate-parameters)))
(setq hashcash-process-alist (cons
@@ -187,8 +188,8 @@ Return immediately. Call CALLBACK with process and result when ready."
(defun hashcash-check-payment (token str val)
"Check the validity of a hashcash payment."
- (if hashcash-path
- (zerop (call-process hashcash-path nil nil nil "-c"
+ (if hashcash-program
+ (zerop (call-process hashcash-program nil nil nil "-c"
"-d" "-f" hashcash-double-spend-database
"-b" (number-to-string val)
"-r" str
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 41c1bb708ac..35138985ed7 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,10 +1,10 @@
-;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*-
+;;; mail-extr.el --- extract full name and address from RFC 822 mail header
-;; Copyright (C) 1991-1994, 1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1991-1994, 1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: mail-utils
@@ -329,7 +329,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Matches an embedded or leading nickname that should be removed.
;; (defconst mail-extr-nickname-pattern
;; (purecopy
-;; (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] "
+;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
;; mail-extr-all-letters)))
;; Matches the occurrence of a generational name suffix, and the last
@@ -369,7 +369,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Matches a variety of trailing comments not including comma-delimited
;; comments.
(defconst mail-extr-trailing-comment-start-pattern
- (purecopy " [-{]\\|--\\|[+@#></\;]"))
+ (purecopy " [-{]\\|--\\|[+@#></;]"))
;; Matches a name (not an initial).
;; This doesn't force a word boundary at the end because sometimes a
@@ -456,7 +456,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}'
;; ($7E7D) is outside the defined GB range.)
(defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
- (purecopy "~{\\([^~].\\|~[^\}]\\)+~}"))
+ (purecopy "~{\\([^~].\\|~[^}]\\)+~}"))
;; The leading optional lowercase letters are for a bastardized version of
;; the encoding, as is the optional nature of the final slash.
@@ -543,8 +543,8 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
(?\t " ")
(?\r " ")
(?\n " ")
- (?\( "\(\)")
- (?\) "\)\(")
+ (?\( "()")
+ (?\) ")(")
(?\\ "\\"))
(mail-extr-address-domain-literal-syntax-table
(?\000 ?\377 "w")
@@ -553,8 +553,8 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
(?\t " ")
(?\r " ")
(?\n " ")
- (?\[ "\(\]") ;??????
- (?\] "\)\[") ;??????
+ (?\[ "(]") ;??????
+ (?\] ")[") ;??????
(?\\ "\\"))
(mail-extr-address-text-comment-syntax-table
(?\000 ?\377 "w")
@@ -563,16 +563,16 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
(?\t " ")
(?\r " ")
(?\n " ")
- (?\( "\(\)")
- (?\) "\)\(")
- (?\[ "\(\]")
- (?\] "\)\[")
- (?\{ "\(\}")
- (?\} "\)\{")
+ (?\( "()")
+ (?\) ")(")
+ (?\[ "(]")
+ (?\] ")[")
+ (?\{ "(}")
+ (?\} "){")
(?\\ "\\")
(?\" "\"")
- ;; (?\' "\)\`")
- ;; (?\` "\(\'")
+ ;; (?\' ")`")
+ ;; (?\` "('")
)
(mail-extr-address-text-syntax-table
(?\000 ?\177 ".")
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 9e4174bfcaa..adec35adfbd 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,6 +1,6 @@
;;; mail-hist.el --- headers and message body history for outgoing mail
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 0129d270db1..3d5d7c96054 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -1,8 +1,8 @@
;;; mail-utils.el --- utility functions used both by rmail and rnews
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail, news
;; This file is part of GNU Emacs.
@@ -50,9 +50,10 @@ also the To field, unless this would leave an empty To field."
;;;###autoload
(defun mail-file-babyl-p (file)
"Return non-nil if FILE is a Babyl file."
- (with-temp-buffer
- (insert-file-contents file nil 0 100)
- (looking-at "BABYL OPTIONS:")))
+ (let ((epa-inhibit t))
+ (with-temp-buffer
+ (insert-file-contents file nil 0 100)
+ (looking-at "BABYL OPTIONS:"))))
(defun mail-string-delete (string start end)
"Returns a string containing all of STRING except the part
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 981be8b6a98..f974f2083dc 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -1,10 +1,10 @@
;;; mailabbrev.el --- abbrev-expansion of mail aliases
-;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2013 Free
+;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2015 Free
;; Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com; now jwz@jwz.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 19 Oct 90
;; Keywords: mail
@@ -603,7 +603,7 @@ In other respects, this behaves like `end-of-buffer', which see."
(eval-after-load "sendmail"
'(progn
(define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias)
- (define-key mail-mode-map "\e\t" ; like lisp-complete-symbol
+ (define-key mail-mode-map "\e\t" ; like completion-at-point
'mail-abbrev-complete-alias)))
;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 4d9b24e0043..cd9df1f638a 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -1,9 +1,9 @@
;;; mailalias.el --- expand and complete mailing address aliases -*- lexical-binding: t -*-
-;; Copyright (C) 1985, 1987, 1995-1997, 2001-2013 Free Software
+;; Copyright (C) 1985, 1987, 1995-1997, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -77,7 +77,7 @@ If not on matching header, `mail-complete-function' gets called instead."
;;;###autoload
(defcustom mail-complete-style 'angles
"Specifies how \\[mail-complete] formats the full name when it completes.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
@@ -119,11 +119,11 @@ completed. `pattern' is nil when `mail-directory-requery' is nil.
The value might look like this:
- '(remote-shell-program \"HOST\" \"-nl\" \"USER\" \"COMMAND\")
+ (remote-shell-program \"HOST\" \"-nl\" \"USER\" \"COMMAND\")
or like this:
- '(remote-shell-program \"HOST\" \"-n\" \"COMMAND '^\" pattern \"'\")"
+ (remote-shell-program \"HOST\" \"-n\" \"COMMAND \\='^\" pattern \"\\='\")"
:type 'sexp
:group 'mailalias)
(put 'mail-directory-process 'risky-local-variable t)
@@ -512,7 +512,7 @@ PREFIX is the string we want to complete."
mail-aliases))
(if (consp mail-local-names)
mail-local-names)
- (or directory
+ (or directory
(when (consp mail-directory-names)
mail-directory-names)))
(lambda (a b)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index b07246e41c6..5bc1d3129ea 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,6 +1,6 @@
;;; mailclient.el --- mail sending via system's mail client.
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: David Reitter <david.reitter@gmail.com>
;; Keywords: mail
@@ -62,10 +62,9 @@ supported. Defaults to non-nil on Windows, nil otherwise."
(mapcar
(lambda (char)
(cond
- ((eq char ?\x20) "%20") ;; space
((eq char ?\n) "%0D%0A") ;; newline
- ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
- (char-to-string char)) ;; printable
+ ((string-match "[-a-zA-Z0-9._~]" (char-to-string char))
+ (char-to-string char)) ;; unreserved as per RFC 6068
(t ;; everything else
(format "%%%02x" char)))) ;; escape
;; Convert string to list of chars
@@ -96,10 +95,11 @@ supported. Defaults to non-nil on Windows, nil otherwise."
recp)))
(setq first nil))
(split-string
- (mail-strip-quoted-names field) "\, *"))
+ (mail-strip-quoted-names field) ", *"))
result)))))
-(declare-function clipboard-kill-ring-save "menu-bar.el" (beg end))
+(declare-function clipboard-kill-ring-save "menu-bar.el"
+ (beg end &optional region))
;;;###autoload
(defun mailclient-send-it ()
@@ -124,6 +124,13 @@ The mail client is taken to be the handler of mailto URLs."
(< (point) delimline))
(replace-match "\n"))
(let ((case-fold-search t)
+ (mime-charset-pattern
+ (concat
+ "^content-type:[ \t]*text/plain;"
+ "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
+ "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
+ coding-system
+ character-coding
;; Use the external browser function to send the
;; message.
(browse-url-mailto-function nil))
@@ -134,6 +141,15 @@ The mail client is taken to be the handler of mailto URLs."
(concat
(save-excursion
(narrow-to-region (point-min) delimline)
+ (goto-char (point-min))
+ (setq coding-system
+ (if (re-search-forward mime-charset-pattern nil t)
+ (coding-system-from-name (match-string 1))
+ 'undecided))
+ (setq character-coding
+ (mail-fetch-field "content-transfer-encoding"))
+ (when character-coding
+ (setq character-coding (downcase character-coding)))
(concat
"mailto:"
;; some of the headers according to RFC822
@@ -159,18 +175,31 @@ The mail client is taken to be the handler of mailto URLs."
(mailclient-encode-string-as-url subj))
""))))
;; body
- (concat
- (mailclient-url-delim) "body="
- (mailclient-encode-string-as-url
- (if mailclient-place-body-on-clipboard-flag
- (progn
- (clipboard-kill-ring-save
- (+ 1 delimline) (point-max))
- (concat
- "*** E-Mail body has been placed on clipboard, "
- "please paste it here! ***"))
- ;; else
- (buffer-substring (+ 1 delimline) (point-max))))))))))))
+ (mailclient-url-delim) "body="
+ (progn
+ (delete-region (point-min) delimline)
+ (unless (null character-coding)
+ ;; mailto: and clipboard need UTF-8 and cannot deal with
+ ;; Content-Transfer-Encoding or Content-Type.
+ ;; FIXME: There is code duplication here with rmail.el.
+ (set-buffer-multibyte nil)
+ (cond
+ ((string= character-coding "base64")
+ (base64-decode-region (point-min) (point-max)))
+ ((string= character-coding "quoted-printable")
+ (mail-unquote-printable-region (point-min) (point-max)
+ nil nil t))
+ (t (error "unsupported Content-Transfer-Encoding: %s"
+ character-coding)))
+ (decode-coding-region (point-min) (point-max) coding-system))
+ (mailclient-encode-string-as-url
+ (if mailclient-place-body-on-clipboard-flag
+ (progn
+ (clipboard-kill-ring-save (point-min) (point-max))
+ (concat
+ "*** E-Mail body has been placed on clipboard, "
+ "please paste it here! ***"))
+ (buffer-string)))))))))))
(provide 'mailclient)
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 52d0f70a607..7606e266745 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -1,6 +1,6 @@
;;; mailheader.el --- mail header parsing, merging, formatting
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: tools, mail, news
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
index 4739d407c64..6f406c38f4f 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/mail/metamail.el
@@ -1,6 +1,6 @@
;;; metamail.el --- Metamail interface for GNU Emacs
-;; Copyright (C) 1993, 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
@@ -150,7 +150,7 @@ redisplayed as output is inserted."
;;;###autoload
(defun metamail-region (beg end &optional viewmode buffer nodisplay)
- "Process current region through '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
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 5e01a7149a8..f22222ad552 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -1,6 +1,6 @@
;;; mspools.el --- show mail spools waiting to be read
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Maintainer: Stephen Eglen <stephen@gnu.org>
@@ -309,7 +309,7 @@ Buffer is not displayed if SHOW is non-nil."
;; to file name.
;(defun get-folder-from-spool-safe (name)
; "Return the folder name corresponding to the spool file NAME."
-; (if (string-match "^\\(.*\\)\.spool$" name)
+; (if (string-match "^\\(.*\\)\\.spool$" name)
; (substring name (match-beginning 1) (match-end 1))
; (error "Could not extract folder name from spool name %s" name)))
@@ -344,19 +344,13 @@ nil."
(interactive)
(kill-buffer mspools-buffer))
-(defun mspools-mode ()
+(define-derived-mode mspools-mode special-mode "MSpools"
"Major mode for output from mspools-show.
\\<mspools-mode-map>Move point to one of the items in this buffer, then use
\\[mspools-visit-spool] to go to the spool that the current line refers to.
\\[revert-buffer] to regenerate the list of spools.
\\{mspools-mode-map}"
- (kill-all-local-variables)
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'mspools-revert-buffer)
- (use-local-map mspools-mode-map)
- (setq major-mode 'mspools-mode)
- (setq mode-name "MSpools")
- (run-mode-hooks 'mspools-mode-hook))
+ (setq-local revert-buffer-function 'mspools-revert-buffer))
(defun mspools-get-spool-files ()
"Find the list of spool files and display them in *spools* buffer."
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 8f6715018c4..f8332a6906b 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -1,9 +1,9 @@
;;; reporter.el --- customizable bug reporting of lisp programs
-;; Copyright (C) 1993-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: 1993-1998 Barry A. Warsaw
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 19-Apr-1993
;; Keywords: maint mail tools
@@ -200,9 +200,10 @@ MAILBUF is the mail buffer being composed."
(insert "\n"))
(void-variable
(with-current-buffer mailbuf
- (mail-position-on-field "X-Reporter-Void-Vars-Found")
- (end-of-line)
- (insert (symbol-name varsym) " ")))
+ (save-excursion
+ (mail-position-on-field "X-Reporter-Void-Vars-Found")
+ (end-of-line)
+ (insert (symbol-name varsym) " "))))
(error
(error ""))))
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 346fe1ce9b4..50ff2cfb8ea 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,6 +1,6 @@
;;; rfc2368.el --- support for rfc2368
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Sen Nagata <sen@eccosys.com>
;; Keywords: mail
@@ -66,16 +66,16 @@
;; describes 'mailto:'
(defconst rfc2368-mailto-scheme-index 1
- "Describes the 'mailto:' portion of the url.")
+ "Describes the `mailto:' portion of the url.")
;; i'm going to call this part the 'prequery'
(defconst rfc2368-mailto-prequery-index 2
- "Describes the portion of the url between 'mailto:' and '?'.")
+ "Describes the portion of the url between `mailto:' and `?'.")
;; i'm going to call this part the 'query'
(defconst rfc2368-mailto-query-index 4
- "Describes the portion of the url after '?'.")
+ "Describes the portion of the url after `?'.")
(defun rfc2368-unhexify-string (string)
- "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
+ "Unhexify STRING -- e.g. `hello%20there' -> `hello there'."
(replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
(lambda (match)
(string (string-to-number (substring match 1)
@@ -85,7 +85,7 @@
(defun rfc2368-parse-mailto-url (mailto-url)
"Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a
-key of 'Body' is a special case and is considered a header for this purpose.
+key of `Body' is a special case and is considered a header for this purpose.
The returned alist is intended for use w/ the `compose-mail' interface.
Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. &amp; -> &), before
calling this function."
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index e3c17bb6cd0..e127c4418aa 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -1,10 +1,10 @@
;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike
-;; Copyright (C) 1986-1987, 1990, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1986-1987, 1990, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 0f9bc54ff8f..ef6b6d0d683 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -1,6 +1,6 @@
;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
;; Author: Eli Tziperman <eli AT deas.harvard.edu>
;; Package: rmail
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index aa244ddae81..8e38564b14a 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1,9 +1,9 @@
-;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
+;;; rmail.el --- main code of "RMAIL" mail reader for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1988, 1993-1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1988, 1993-1998, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -104,6 +104,11 @@ its character representation and its display representation.")
"Non-nil if message has been processed by `rmail-show-mime-function'.")
(put 'rmail-mime-decoded 'permanent-local t) ; for rmail-edit
+(defsubst rmail-mime-message-p ()
+ "Non-nil if and only if the current message is a MIME."
+ (or (get-text-property (point) 'rmail-mime-entity)
+ (get-text-property (point-min) 'rmail-mime-entity)))
+
(defgroup rmail nil
"Mail reader for Emacs."
:group 'mail)
@@ -249,7 +254,7 @@ We do this by executing it with `--version' and analyzing its output."
(cond
((looking-at ".*movemail: invalid option")
'emacs) ;; Possibly...
- ((looking-at "movemail (GNU Mailutils .*)")
+ ((looking-at "movemail (GNU Mailutils")
'mailutils)
(t
;; FIXME:
@@ -311,7 +316,7 @@ Currently known variants are 'emacs and 'mailutils."
If non-nil, this variable is used to identify the correspondent
when receiving new mail. If it matches the address of the sender,
the recipient is taken as correspondent of a mail.
-If nil \(default value\), your `user-login-name' and `user-mail-address'
+If nil \(default value), your `user-login-name' and `user-mail-address'
are used to exclude yourself as correspondent.
Usually you don't have to set this variable, except if you collect mails
@@ -388,7 +393,7 @@ go to that message and type \\[rmail-toggle-header] twice."
"Regexp to match Header fields that Rmail should display.
If nil, display all header fields except those matched by
`rmail-ignored-headers'."
- :type '(choice regexp (const :tag "All"))
+ :type '(choice regexp (const :tag "All" nil))
:group 'rmail-headers)
;;;###autoload
@@ -402,7 +407,7 @@ If nil, display all header fields except those matched by
(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:")
"Regexp to match Header fields that Rmail should normally highlight.
A value of nil means don't highlight. Uses the face `rmail-highlight'."
- :type 'regexp
+ :type '(choice regexp (const :tag "None" nil))
:group 'rmail-headers)
(defface rmail-highlight
@@ -686,6 +691,12 @@ Element N specifies the summary line for message N+1.")
This is set to nil by default.")
+(defcustom rmail-get-coding-function nil
+ "Function of no args to try to determine coding system for a message."
+ :type 'function
+ :group 'rmail
+ :version "24.4")
+
(defcustom rmail-enable-mime t
"If non-nil, RMAIL automatically displays decoded MIME messages.
For this to work, the feature specified by `rmail-mime-feature' must
@@ -878,12 +889,12 @@ that knows the exact ordering of the \\( \\) subexpressions.")
Signal an error and set `rmail-mime-feature' to nil if the feature
isn't provided."
(when rmail-enable-mime
- (condition-case err
+ (condition-case nil
(require rmail-mime-feature)
(error
(display-warning
'rmail
- (format "Although MIME support is requested
+ (format-message "Although MIME support is requested
through `rmail-enable-mime' being non-nil, the required feature
`%s' (the value of `rmail-mime-feature')
is not available in the current session.
@@ -1029,9 +1040,11 @@ This function also reinitializes local variables used by Rmail."
The buffer is expected to be narrowed to just the header of the message."
(save-excursion
(goto-char (point-min))
- (if (re-search-forward rmail-mime-charset-pattern nil t)
- (coding-system-from-name (match-string 1))
- 'undecided)))
+ (or (if rmail-get-coding-function
+ (funcall rmail-get-coding-function))
+ (if (re-search-forward rmail-mime-charset-pattern nil t)
+ (coding-system-from-name (match-string 1))
+ 'undecided))))
;;; Set up Rmail mode keymaps
@@ -1495,8 +1508,7 @@ If so restore the actual mbox message collection."
'(rmail-font-lock-keywords
t t nil nil
(font-lock-maximum-size . nil)
- (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
- (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
+ (font-lock-dont-widen . t)
(font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
(make-local-variable 'require-final-newline)
(setq require-final-newline nil)
@@ -1560,7 +1572,7 @@ Hook `rmail-quit-hook' is run after expunging."
(when (boundp 'rmail-quit-hook)
(run-hooks 'rmail-quit-hook))
;; Don't switch to the summary buffer even if it was recently visible.
- (when rmail-summary-buffer
+ (when (rmail-summary-exists)
(with-current-buffer rmail-summary-buffer
(set-buffer-modified-p nil))
(replace-buffer-in-windows rmail-summary-buffer)
@@ -1574,13 +1586,12 @@ Hook `rmail-quit-hook' is run after expunging."
(interactive)
;; This let var was called rmail-buffer, but that interfered
;; with the buffer-local var used in summary buffers.
- (let ((buffer-to-bury (current-buffer)))
- (if (rmail-summary-exists)
- (let (window)
- (while (setq window (get-buffer-window rmail-summary-buffer))
- (quit-window nil window))
- (bury-buffer rmail-summary-buffer)))
- (quit-window)))
+ (if (rmail-summary-exists)
+ (let (window)
+ (while (setq window (get-buffer-window rmail-summary-buffer))
+ (quit-window nil window))
+ (bury-buffer rmail-summary-buffer)))
+ (quit-window))
(defun rmail-duplicate-message ()
"Create a duplicated copy of the current message.
@@ -1748,15 +1759,14 @@ not be a new one). It returns non-nil if it got any new messages."
;; This loops if any members of the inbox list have the same
;; basename (see "name conflict" below).
(while all-files
- (let ((opoint (point))
- ;; If buffer has not changed yet, and has not been
+ (let (;; If buffer has not changed yet, and has not been
;; saved yet, don't replace the old backup file now.
(make-backup-files (and make-backup-files
(buffer-modified-p)))
(buffer-read-only nil)
;; Don't make undo records while getting mail.
(buffer-undo-list t)
- delete-files success files file-last-names)
+ delete-files files file-last-names)
;; Pull files off all-files onto files as long as there is
;; no name conflict. A conflict happens when two inbox
;; file names have the same last component.
@@ -1775,7 +1785,7 @@ not be a new one). It returns non-nil if it got any new messages."
;; Make sure we end with a blank line unless there are
;; no messages, as required by mbox format (Bug#9974).
(unless (bobp)
- (while (not (looking-back "\n\n"))
+ (while (not (looking-back "\n\n" (- (point) 2)))
(insert "\n")))
(setq found (or
(rmail-get-new-mail-1 file-name files delete-files)
@@ -1898,9 +1908,10 @@ is non-nil if the user has supplied the password interactively.
((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
(let (got-password supplied-password
- (proto "pop")
- (user (match-string 1 file))
- (host (match-string 3 file)))
+ ;; (proto "pop")
+ ;; (user (match-string 1 file))
+ ;; (host (match-string 3 file))
+ )
(when rmail-remote-password-required
(setq got-password (not (rmail-have-password)))
@@ -1933,8 +1944,7 @@ SIZE is the original size of the newly read mail.
Value is the size of the newly read mail after conversion."
;; Detect previous Babyl format files.
(let ((case-fold-search nil)
- (old-file file)
- new-file)
+ (old-file file))
(cond ((looking-at "BABYL OPTIONS:")
;; The new mail is in Babyl version 5 format. Use unrmail
;; to convert it.
@@ -1960,7 +1970,7 @@ Value is the size of the newly read mail after conversion."
(or (memq (file-locked-p buffer-file-name) '(nil t))
(error "RMAIL file %s is locked"
(file-name-nondirectory buffer-file-name)))
- (let (file tofile delete-files movemail popmail got-password password)
+ (let (file tofile delete-files popmail got-password password)
(while files
;; Handle remote mailbox names specially; don't expand as filenames
;; in case the userid contains a directory separator.
@@ -2080,7 +2090,7 @@ Value is the size of the newly read mail after conversion."
;; Make sure the read-in mbox data properly ends with a
;; blank line unless it is of size 0.
(unless (zerop size)
- (while (not (looking-back "\n\n"))
+ (while (not (looking-back "\n\n" (- (point) 2)))
(insert "\n")))
(if (not (and rmail-preserve-inbox (string= file tofile)))
(setq delete-files (cons tofile delete-files)))))
@@ -2115,7 +2125,7 @@ Value is the size of the newly read mail after conversion."
Call with point at the end of the message."
(unless (bolp)
(insert "\n"))
- (unless (looking-back "\n\n")
+ (unless (looking-back "\n\n" (- (point) 2))
(insert "\n")))
(defun rmail-add-mbox-headers ()
@@ -2132,7 +2142,7 @@ new messages. Return the number of new messages."
(value "------U-")
(case-fold-search nil)
(delim (concat "\n\n" rmail-unix-mail-delimiter))
- limit stop)
+ stop)
;; Detect an empty inbox file.
(unless (= start (point-max))
;; Scan the new messages to establish a count and to ensure that
@@ -2652,8 +2662,8 @@ Ask the user whether to add that list name to `mail-mailing-lists'."
"\\>\\)"))
addr))
(y-or-n-p
- (format "Add `%s' to `mail-mailing-lists'? "
- addr)))
+ (format-message "Add `%s' to `mail-mailing-lists'? "
+ addr)))
(customize-save-variable 'mail-mailing-lists
(cons addr mail-mailing-lists)))))))))
@@ -2750,7 +2760,8 @@ The current mail message becomes the message displayed."
(let ((mbox-buf rmail-buffer)
(view-buf rmail-view-buffer)
blurb beg end body-start coding-system character-coding
- is-text-message header-style)
+ is-text-message header-style
+ showing-message)
(if (not msg)
(setq msg rmail-current-message))
(unless (setq blurb (rmail-no-mail-p))
@@ -2776,7 +2787,8 @@ The current mail message becomes the message displayed."
(setq beg (rmail-msgbeg msg)
end (rmail-msgend msg))
(when (> (- end beg) rmail-show-message-verbose-min)
- (message "Showing message %d" msg))
+ (setq showing-message t)
+ (message "Showing message %d..." msg))
(narrow-to-region beg end)
(goto-char beg)
(with-current-buffer rmail-view-buffer
@@ -2790,6 +2802,8 @@ The current mail message becomes the message displayed."
(re-search-forward "mime-version: 1.0" nil t))
(let ((rmail-buffer mbox-buf)
(rmail-view-buffer view-buf))
+ (setq showing-message t)
+ (message "Showing message %d..." msg)
(set (make-local-variable 'rmail-mime-decoded) t)
(funcall rmail-show-mime-function))
(setq body-start (search-forward "\n\n" nil t))
@@ -2869,11 +2883,11 @@ The current mail message becomes the message displayed."
(rmail-swap-buffers)
(setq rmail-buffer-swapped t)
(run-hooks 'rmail-show-message-hook)
- (when (> (- end beg) rmail-show-message-verbose-min)
- (message "Showing message %d...done" msg))))
+ (when showing-message
+ (setq blurb (format "Showing message %d...done" msg)))))
blurb))
-(defun rmail-copy-headers (beg end &optional ignored-headers)
+(defun rmail-copy-headers (beg _end &optional ignored-headers)
"Copy displayed header fields to the message viewer buffer.
BEG and END marks the start and end positions of the message in
the mbox buffer. If the optional argument IGNORED-HEADERS is
@@ -2926,7 +2940,8 @@ buffer to the end of the headers."
(1+ (match-beginning 0))
(point-max))))
(if (and (looking-at ignored-headers)
- (not (looking-at rmail-nonignored-headers)))
+ (not (and rmail-nonignored-headers
+ (looking-at rmail-nonignored-headers))))
(goto-char lim)
(append-to-buffer rmail-view-buffer (point) lim)
(goto-char lim))))
@@ -3136,7 +3151,7 @@ or forward if N is negative."
(rmail-maybe-set-message-counters)
(rmail-show-message rmail-total-messages))
-(defun rmail-next-error-move (msg-pos bad-marker)
+(defun rmail-next-error-move (msg-pos _bad-marker)
"Move to an error locus (probably grep hit) in an Rmail buffer.
MSG-POS is a marker pointing at the error message in the grep buffer.
BAD-MARKER is a marker that ought to point at where to move to,
@@ -3436,47 +3451,65 @@ STATE non-nil means mark as deleted."
"Delete this message and stay on it."
(interactive)
(rmail-set-attribute rmail-deleted-attr-index t)
- (run-hooks 'rmail-delete-message-hook))
+ (run-hooks 'rmail-delete-message-hook)
+ (let ((del-msg rmail-current-message))
+ (if (rmail-summary-exists)
+ (rmail-select-summary
+ (rmail-summary-mark-deleted del-msg)))))
-(defun rmail-undelete-previous-message ()
+(defun rmail-undelete-previous-message (count)
"Back up to deleted message, select it, and undelete it."
- (interactive)
+ (interactive "p")
(set-buffer rmail-buffer)
- (let ((msg rmail-current-message))
- (while (and (> msg 0)
- (not (rmail-message-deleted-p msg)))
- (setq msg (1- msg)))
- (if (= msg 0)
- (error "No previous deleted message")
- (if (/= msg rmail-current-message)
- (rmail-show-message msg))
- (rmail-set-attribute rmail-deleted-attr-index nil)
- (if (rmail-summary-exists)
- (with-current-buffer rmail-summary-buffer
- (rmail-summary-mark-undeleted msg)))
- (rmail-maybe-display-summary))))
-
-(defun rmail-delete-forward (&optional backward)
+ (dotimes (_ count)
+ (let ((msg rmail-current-message))
+ (while (and (> msg 0)
+ (not (rmail-message-deleted-p msg)))
+ (setq msg (1- msg)))
+ (if (= msg 0)
+ (error "No previous deleted message")
+ (if (/= msg rmail-current-message)
+ (rmail-show-message msg))
+ (rmail-set-attribute rmail-deleted-attr-index nil)
+ (if (rmail-summary-exists)
+ (with-current-buffer rmail-summary-buffer
+ (rmail-summary-mark-undeleted msg))))))
+ (rmail-maybe-display-summary))
+
+(defun rmail-delete-forward (&optional count)
"Delete this message and move to next nondeleted one.
Deleted messages stay in the file until the \\[rmail-expunge] command is given.
-With prefix argument, delete and move backward.
+Optional argument COUNT (interactively, prefix argument) is a repeat count;
+negative argument means move backwards instead of forwards.
Returns t if a new message is displayed after the delete, or nil otherwise."
- (interactive "P")
- (rmail-set-attribute rmail-deleted-attr-index t)
- (run-hooks 'rmail-delete-message-hook)
- (let ((del-msg rmail-current-message))
- (if (rmail-summary-exists)
- (rmail-select-summary
- (rmail-summary-mark-deleted del-msg)))
- (prog1 (rmail-next-undeleted-message (if backward -1 1))
- (rmail-maybe-display-summary))))
+ (interactive "p")
+ (if (not count) (setq count 1))
+ (let (value backward)
+ (if (< count 0)
+ (setq count (- count) backward t))
+ (dotimes (_ count)
+ (rmail-set-attribute rmail-deleted-attr-index t)
+ (run-hooks 'rmail-delete-message-hook)
+ (let ((del-msg rmail-current-message))
+ (if (rmail-summary-exists)
+ (rmail-select-summary
+ (rmail-summary-mark-deleted del-msg)))
+ (setq value (rmail-next-undeleted-message (if backward -1 1)))))
+ (rmail-maybe-display-summary)
+ value))
-(defun rmail-delete-backward ()
+(defun rmail-delete-backward (&optional count)
"Delete this message and move to previous nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given."
- (interactive)
- (rmail-delete-forward t))
+Deleted messages stay in the file until the \\[rmail-expunge] command is given.
+Optional argument COUNT (interactively, prefix argument) is a repeat count;
+negative argument means move forwards instead of backwards.
+
+Returns t if a new message is displayed after the delete, or nil otherwise."
+
+ (interactive "p")
+ (if (not count) (setq count 1))
+ (rmail-delete-forward (- count)))
;; Expunging.
@@ -3752,7 +3785,7 @@ use \\[mail-yank-original] to yank the original message into it."
(if (zerop rmail-current-message)
(error "There is no message to reply to"))
(let (from reply-to cc subject date to message-id references
- resent-to resent-cc resent-reply-to
+ ;; resent-to resent-cc resent-reply-to
(msgnum rmail-current-message))
(rmail-apply-in-message
rmail-current-message
@@ -3767,14 +3800,14 @@ use \\[mail-yank-original] to yank the original message into it."
date (mail-fetch-field "date")
message-id (mail-fetch-field "message-id")
references (mail-fetch-field "references" nil nil t)
- resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
;; Bug#512. It's inappropriate to reply to these addresses.
-;;; resent-cc (and (not just-sender)
-;;; (mail-fetch-field "resent-cc" nil t))
-;;; resent-to (or (mail-fetch-field "resent-to" nil t) "")
-;;; resent-subject (mail-fetch-field "resent-subject")
-;;; resent-date (mail-fetch-field "resent-date")
-;;; resent-message-id (mail-fetch-field "resent-message-id")
+ ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
+ ;;resent-cc (and (not just-sender)
+ ;; (mail-fetch-field "resent-cc" nil t))
+ ;;resent-to (or (mail-fetch-field "resent-to" nil t) "")
+ ;;resent-subject (mail-fetch-field "resent-subject")
+ ;;resent-date (mail-fetch-field "resent-date")
+ ;;resent-message-id (mail-fetch-field "resent-message-id")
)
(unless just-sender
(if (mail-fetch-field "mail-followup-to" nil t)
@@ -3785,17 +3818,18 @@ use \\[mail-yank-original] to yank the original message into it."
to (or (mail-fetch-field "to" nil t) ""))))))
;; Merge the resent-to and resent-cc into the to and cc.
;; Bug#512. It's inappropriate to reply to these addresses.
-;;; (if (and resent-to (not (equal resent-to "")))
-;;; (if (not (equal to ""))
-;;; (setq to (concat to ", " resent-to))
-;;; (setq to resent-to)))
-;;; (if (and resent-cc (not (equal resent-cc "")))
-;;; (if (not (equal cc ""))
-;;; (setq cc (concat cc ", " resent-cc))
-;;; (setq cc resent-cc)))
+ ;;(if (and resent-to (not (equal resent-to "")))
+ ;; (setq to (if (not (equal to ""))
+ ;; (concat to ", " resent-to)
+ ;; resent-to)))
+ ;;(if (and resent-cc (not (equal resent-cc "")))
+ ;; (setq cc (if (not (equal cc ""))
+ ;; (concat cc ", " resent-cc)
+ ;; resent-cc)))
;; Add `Re: ' to subject if not there already.
(and (stringp subject)
- (setq subject
+ (setq subject (rfc2047-decode-string subject)
+ subject
(concat rmail-reply-prefix
(if (let ((case-fold-search t))
(string-match rmail-reply-regexp subject))
@@ -3863,16 +3897,18 @@ which is an element of rmail-msgref-vector."
message-id))
;; missing From, or Message-ID is sufficiently informative
message-id
- (concat message-id " (" tem ")"))
+ (concat message-id " (" tem ")"))
+ ;; Message has no Message-ID field.
;; Copy TEM, discarding text properties.
(setq tem (copy-sequence tem))
(set-text-properties 0 (length tem) nil tem)
(setq tem (copy-sequence tem))
;; Use prin1 to fake RFC822 quoting
(let ((field (prin1-to-string tem)))
+ ;; Wrap it in parens to make it a comment according to RFC822
(if date
- (concat field "'s message of " date)
- field)))))
+ (concat "(" field "'s message of " date ")")
+ (concat "(" field ")"))))))
((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+")
(bar "[^][\000-\037()<>@,;:\\\"]+"))
;; These strings both match all non-ASCII characters.
@@ -3898,7 +3934,8 @@ which is an element of rmail-msgref-vector."
(if message-id
;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
(concat message-id " (" field ")")
- field))))
+ ;; Wrap in parens to make it a comment, for RFC822.
+ (concat "(" field ")")))))
(t
;; If we can't kludge it simply, do it correctly
(let ((mail-use-rfc822 t))
@@ -4105,9 +4142,11 @@ The message should be narrowed to just the headers."
(autoload 'mail-position-on-field "sendmail")
-(declare-function rmail-mime-message-p "rmailmm" ())
(declare-function rmail-mime-toggle-raw "rmailmm" (&optional state))
+(defvar rmail-mime-mbox-buffer)
+(defvar rmail-mime-view-buffer)
+
(defun rmail-retry-failure ()
"Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
@@ -4283,31 +4322,21 @@ This has an effect only if a summary buffer exists."
(defun rmail-unfontify-buffer-function ()
;; This function's symbol is bound to font-lock-fontify-unbuffer-function.
- (let ((modified (buffer-modified-p))
- (buffer-undo-list t) (inhibit-read-only t)
- before-change-functions after-change-functions
- buffer-file-name buffer-file-truename)
+ (with-silent-modifications
(save-restriction
(widen)
(remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
(remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
- (font-lock-default-unfontify-buffer)
- (and (not modified) (buffer-modified-p)
- (restore-buffer-modified-p nil)))))
+ (font-lock-default-unfontify-buffer))))
(defun rmail-fontify-message ()
;; Fontify the current message if it is not already fontified.
(if (text-property-any (point-min) (point-max) 'rmail-fontified nil)
- (let ((modified (buffer-modified-p))
- (buffer-undo-list t) (inhibit-read-only t)
- before-change-functions after-change-functions
- buffer-file-name buffer-file-truename)
+ (with-silent-modifications
(save-excursion
(save-match-data
(add-text-properties (point-min) (point-max) '(rmail-fontified t))
- (font-lock-fontify-region (point-min) (point-max))
- (and (not modified) (buffer-modified-p)
- (restore-buffer-modified-p nil)))))))
+ (font-lock-fontify-region (point-min) (point-max)))))))
;;; Speedbar support for RMAIL files.
(defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
@@ -4394,13 +4423,13 @@ current message into that RMAIL folder."
(declare-function dframe-select-attached-frame "dframe" (&optional frame))
(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
-(defun rmail-speedbar-button (text token indent)
+(defun rmail-speedbar-button (_text token _indent)
"Execute an rmail command specified by TEXT.
The command used is TOKEN. INDENT is not used."
(dframe-with-attached-buffer
(funcall token t)))
-(defun rmail-speedbar-find-file (text token indent)
+(defun rmail-speedbar-find-file (text _token _indent)
"Load in the rmail file TEXT.
TOKEN and INDENT are not used."
(dframe-with-attached-buffer
@@ -4419,7 +4448,7 @@ TOKEN and INDENT are not used."
(forward-char -2)
(speedbar-do-function-pointer)))))
-(defun rmail-speedbar-move-message (text token indent)
+(defun rmail-speedbar-move-message (_text token _indent)
"From button TEXT, copy current message to the rmail file specified by TOKEN.
TEXT and INDENT are not used."
(dframe-with-attached-buffer
@@ -4479,68 +4508,107 @@ encoded string (and the same mask) will decode the string."
(setq i (1+ i)))
(concat string-vector)))
+(defun rmail-epa-decrypt-1 (mime)
+ "Decrypt a single GnuPG encrypted text in a message.
+The starting string of the encrypted text should have just been regexp-matched.
+Argument MIME is non-nil if this is a mime message."
+ (let* ((armor-start (match-beginning 0))
+ (armor-prefix (buffer-substring
+ (line-beginning-position)
+ armor-start))
+ (armor-end-regexp)
+ armor-end after-end
+ unquote)
+ (if (string-match "<pre>\\'" armor-prefix)
+ (setq armor-prefix ""))
+
+ (setq armor-end-regexp
+ (concat "^"
+ armor-prefix
+ "-----END PGP MESSAGE-----$"))
+ (setq armor-end (re-search-forward armor-end-regexp
+ nil t))
+
+ (unless armor-end
+ (error "Encryption armor beginning has no matching end"))
+ (goto-char armor-start)
+
+ ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
+ (require 'epa)
+
+ ;; Advance over this armor.
+ (goto-char armor-end)
+ (setq after-end (- (point-max) armor-end))
+
+ (when mime
+ (save-excursion
+ (goto-char armor-start)
+ (re-search-backward "^--" nil t)
+ (save-restriction
+ (narrow-to-region (point) armor-start)
+
+ ;; Use the charset specified in the armor.
+ (unless coding-system-for-read
+ (if (re-search-forward "^[ \t]*Charset[ \t\n]*:[ \t\n]*\\(.*\\)" nil t)
+ (setq coding-system-for-read
+ (epa--find-coding-system-for-mime-charset
+ (intern (downcase (match-string 1)))))))
+
+ (goto-char (point-min))
+ (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t\n]*:[ \t\n]*quoted-printable[ \t]*$" nil t)
+ (setq unquote t)))))
+
+ (when unquote
+ (let ((inhibit-read-only t))
+ (mail-unquote-printable-region armor-start
+ (- (point-max) after-end))))
+
+ ;; Decrypt it, maybe in place, maybe making new buffer.
+ (epa-decrypt-region
+ armor-start (- (point-max) after-end)
+ ;; Call back this function to prepare the output.
+ (lambda ()
+ (let ((inhibit-read-only t))
+ (delete-region armor-start (- (point-max) after-end))
+ (goto-char armor-start)
+ (current-buffer))))
+
+ (list armor-start (- (point-max) after-end) mime
+ armor-end-regexp)))
+
;; Should this have a key-binding, or be in a menu?
;; There doesn't really seem to be an appropriate menu.
;; Eg the edit command is not in a menu either.
+
(defun rmail-epa-decrypt ()
- "Decrypt OpenPGP armors in current message."
+ "Decrypt GnuPG or OpenPGP armors in current message."
(interactive)
;; Save the current buffer here for cleanliness, in case we
;; change it in one of the calls to `epa-decrypt-region'.
(save-excursion
- (let (decrypts)
+ (let (decrypts (mime (rmail-mime-message-p))
+ mime-disabled)
(goto-char (point-min))
- ;; In case the encrypted data is inside a mime attachment,
- ;; show it. This is a kludge; to be clean, it should not
- ;; modify the buffer, but I don't see how to do that.
- (when (search-forward "octet-stream" nil t)
- (beginning-of-line)
- (forward-button 1)
- (if (looking-at "Show")
- (rmail-mime-toggle-hidden)))
+ ;; Turn off mime processing.
+ (when (and mime
+ (not (get-text-property (point-min) 'rmail-mime-hidden)))
+ (setq mime-disabled t)
+ (rmail-mime))
;; Now find all armored messages in the buffer
;; and decrypt them one by one.
(goto-char (point-min))
(while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
(let ((coding-system-for-read coding-system-for-read)
- armor-start armor-end after-end)
- (setq armor-start (match-beginning 0)
- armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
- nil t))
- (unless armor-end
- (error "Encryption armor beginning has no matching end"))
- (goto-char armor-start)
-
- ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
- (require 'epa)
-
- ;; Use the charset specified in the armor.
- (unless coding-system-for-read
- (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
- (setq coding-system-for-read
- (epa--find-coding-system-for-mime-charset
- (intern (downcase (match-string 1)))))))
-
- ;; Advance over this armor.
- (goto-char armor-end)
- (setq after-end (- (point-max) armor-end))
-
- ;; Decrypt it, maybe in place, maybe making new buffer.
- (epa-decrypt-region
- armor-start armor-end
- ;; Call back this function to prepare the output.
- (lambda ()
- (let ((inhibit-read-only t))
- (delete-region armor-start armor-end)
- (goto-char armor-start)
- (current-buffer))))
-
- (push (list armor-start (- (point-max) after-end))
- decrypts)))
+ (case-fold-search t))
+
+ (push (rmail-epa-decrypt-1 mime) decrypts)))
+
+ (when (and decrypts (eq major-mode 'rmail-mode))
+ (rmail-add-label "decrypt"))
(when (and decrypts (rmail-buffers-swapped-p))
(when (y-or-n-p "Replace the original message? ")
@@ -4552,24 +4620,69 @@ encoded string (and the same mask) will decode the string."
(narrow-to-region beg end)
(goto-char (point-min))
(dolist (d decrypts)
+ ;; Find, in the real Rmail buffer, the same armors
+ ;; that we found and decrypted in the view buffer.
(if (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
- (let (armor-start armor-end)
+ (let (armor-start armor-end armor-end-regexp)
(setq armor-start (match-beginning 0)
- armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
- nil t))
+ armor-end-regexp (nth 3 d)
+ armor-end (re-search-forward
+ armor-end-regexp
+ nil t))
+
+ ;; Found as expected -- now replace it with the decrypt.
(when armor-end
(delete-region armor-start armor-end)
- (insert-buffer-substring from-buffer (nth 0 d) (nth 1 d)))))))))))))
+ (insert-buffer-substring from-buffer (nth 0 d) (nth 1 d)))
+
+ ;; Change the mime type (if this is in a mime part)
+ ;; so this part will display by default
+ ;; when the message is shown later.
+ (when (nth 2 d)
+ (goto-char armor-start)
+ (when (re-search-backward "^--" nil t)
+ (save-restriction
+ (narrow-to-region (point) armor-start)
+ (when (re-search-forward "^content-type[ \t\n]*:[ \t\n]*" nil t)
+ (when (looking-at "[^\n \t;]+")
+ (let ((value (match-string 0)))
+ (unless (member value '("text/plain" "text/html"))
+ (replace-match "text/plain"))))))))
+ )))))))
+
+ (when (and (null decrypts)
+ mime mime-disabled)
+ ;; Re-enable mime processing.
+ (rmail-mime)
+ ;; Find each Show button and show that part.
+ (while (search-forward " Show " nil t)
+ (forward-char -2)
+ (let ((rmail-mime-render-html-function nil)
+ (entity (get-text-property (point) 'rmail-mime-entity)))
+ (unless (and (not (stringp entity))
+ (rmail-mime-entity-truncated entity))
+ (push-button))))
+ (goto-char (point-min))
+ (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
+ (let ((coding-system-for-read coding-system-for-read)
+ (case-fold-search t))
+ (push (rmail-epa-decrypt-1 mime) decrypts)))
+
+ )
+
+ (unless decrypts
+ (error "Nothing to decrypt")))))
+
;;;; Desktop support
-(defun rmail-restore-desktop-buffer (desktop-buffer-file-name
- desktop-buffer-name
- desktop-buffer-misc)
+(defun rmail-restore-desktop-buffer (file-name
+ _buffer-name
+ _buffer-misc)
"Restore an rmail buffer specified in a desktop file."
- (condition-case error
+ (condition-case nil
(progn
- (rmail-input desktop-buffer-file-name)
+ (rmail-input file-name)
(if (eq major-mode 'rmail-mode)
(current-buffer)
rmail-buffer))
@@ -4585,7 +4698,7 @@ encoded string (and the same mask) will decode the string."
(defvar rmail-message-encoding nil)
;; Used in `write-region-annotate-functions' to write rmail files.
-(defun rmail-write-region-annotate (start end)
+(defun rmail-write-region-annotate (start _end)
(when (and (null start) rmail-buffer-swapped)
(unless (buffer-live-p rmail-view-buffer)
(error "Buffer `%s' with real text of `%s' has disappeared"
@@ -4612,8 +4725,7 @@ encoded string (and the same mask) will decode the string."
;;; Start of automatically extracted autoloads.
-;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;; "0b056146d4775080a1847b8ce7527bc5")
+;;;### (autoloads nil "rmailedit" "rmailedit.el" "1ed1c211e6e9c254ba3e0dd8d546e745")
;;; Generated autoloads from rmailedit.el
(autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4623,9 +4735,7 @@ Edit the contents of this message.
;;;***
-;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
-;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
-;;;;;; "rmailkwd.el" "b5337290fd35bbc11888afb25d767195")
+;;;### (autoloads nil "rmailkwd" "rmailkwd.el" "298dcda7febb6e4ebf0a166101f40650")
;;; Generated autoloads from rmailkwd.el
(autoload 'rmail-add-label "rmailkwd" "\
@@ -4668,7 +4778,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "93951f748e43e1015da1b485088970ca")
+;;;### (autoloads nil "rmailmm" "rmailmm.el" "36f518e036612a33eb436cb267fd39c7")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
@@ -4694,8 +4804,7 @@ The arguments ARG and STATE have no effect in this case.
;;;***
-;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;; "8a2466563b4a463710531d01766c07a3")
+;;;### (autoloads nil "rmailmsc" "rmailmsc.el" "c3f0d33739768fc12acc4258ae0da72e")
;;; Generated autoloads from rmailmsc.el
(autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4709,9 +4818,7 @@ This applies only to the current session.
;;;***
-;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
-;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
-;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "3e3a30326fc95d7f17835906c2ccb19f")
+;;;### (autoloads nil "rmailsort" "rmailsort.el" "8f551773021df4fa1a14ec2517e6a4f1")
;;; Generated autoloads from rmailsort.el
(autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4768,7 +4875,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order.
;;;***
-;;;### (autoloads nil "rmailsum" "rmailsum.el" "a9b3bbd9b82dd566524a1209b5cdb7dd")
+;;;### (autoloads nil "rmailsum" "rmailsum.el" "4bc0d1a65aede332348200e1937c84d4")
;;; Generated autoloads from rmailsum.el
(autoload 'rmail-summary "rmailsum" "\
@@ -4787,7 +4894,7 @@ Display a summary of all messages with the given RECIPIENTS.
Normally checks the To, From and Cc fields of headers;
but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
-RECIPIENTS is a string of regexps separated by commas.
+RECIPIENTS is a regular expression.
\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil)
@@ -4803,20 +4910,19 @@ Emacs will list the message in the summary.
Display a summary of all messages with the given SUBJECT.
Normally checks just the Subject field of headers; but with prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
-SUBJECT is a string of regexps separated by commas.
+SUBJECT is a regular expression.
\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil)
(autoload 'rmail-summary-by-senders "rmailsum" "\
Display a summary of all messages whose \"From\" field matches SENDERS.
-SENDERS is a string of regexps separated by commas.
+SENDERS is a regular expression.
\(fn SENDERS)" t nil)
;;;***
-;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;; "undigest" "undigest.el" "9b273a3e15b5496ab6121b585d8bd3b3")
+;;;### (autoloads nil "undigest" "undigest.el" "c0ddfad4fe34ef9c1e790c2cc72b571d")
;;; Generated autoloads from undigest.el
(autoload 'undigestify-rmail-message "undigest" "\
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 68fc35e0e2a..0b49782d80f 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -1,8 +1,8 @@
;;; rmailedit.el --- "RMAIL edit mode" Edit the current message
-;; Copyright (C) 1985, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
@@ -44,6 +44,8 @@
(declare-function rmail-summary-disable "rmailsum" ())
+;; We can't straightforwardly make this derive from text-mode, because
+;; we need to bind (rmail-buffer-swapped) around the text-mode call. :(
(defun rmail-edit-mode ()
"Major mode for editing the contents of an Rmail message.
The editing commands are the same as in Text mode, together with
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index e470e5060a6..f46a687d152 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -1,9 +1,9 @@
;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs
-;; Copyright (C) 1985, 1988, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985, 1988, 1994, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 350e3dacbcf..16f62154fbc 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,10 +1,10 @@
;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Alexander Pohoyda
;; Alex Schroeder
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
@@ -131,6 +131,27 @@ automatically display the image in the buffer."
:version "23.2"
:group 'rmail-mime)
+(defcustom rmail-mime-render-html-function
+ (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
+ ((executable-find "lynx") 'rmail-mime-render-html-lynx)
+ (t nil))
+ "Function to convert HTML to text.
+Called with buffer containing HTML extracted from message in a
+temporary buffer. Converts to text in current buffer. If nil,
+display HTML source."
+ :group 'rmail
+ :version "25.1"
+ :type '(choice function (const nil)))
+
+(defcustom rmail-mime-prefer-html
+ ;; Default to preferring HTML parts, but only if we have a renderer
+ (if rmail-mime-render-html-function t nil)
+ "If non-nil, default to showing HTML part rather than text part
+when both are available"
+ :group 'rmail
+ :version "25.1"
+ :type 'boolean)
+
;;; End of user options.
;;; Global variables that always have let-binding when referred.
@@ -150,6 +171,10 @@ processing MIME.")
The value is usually nil, and bound to non-nil while inserting
MIME entities.")
+(defvar rmail-mime-searching nil
+ "Bound to T inside `rmail-search-mime-message' to suppress expensive
+operations such as HTML decoding")
+
;;; MIME-entity object
(defun rmail-mime-entity (type disposition transfer-encoding
@@ -165,7 +190,7 @@ A MIME-entity is a vector of 10 elements:
TYPE and DISPOSITION correspond to MIME headers Content-Type and
Content-Disposition respectively, and have this format:
- \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+ (VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
Each VALUE is a string and each ATTRIBUTE is a string.
@@ -177,7 +202,7 @@ Content-Type: multipart/mixed;
The corresponding TYPE argument must be:
\(\"multipart/mixed\"
- \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
+ (\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
TRANSFER-ENCODING corresponds to MIME header
Content-Transfer-Encoding, and is a lower-case string.
@@ -230,11 +255,6 @@ TRUNCATED is non-nil if the text of this entity was truncated."
(defsubst rmail-mime-entity-set-truncated (entity truncated)
(aset entity 9 truncated))
-(defsubst rmail-mime-message-p ()
- "Non-nil if and only if the current message is a MIME."
- (or (get-text-property (point) 'rmail-mime-entity)
- (get-text-property (point-min) 'rmail-mime-entity)))
-
;;; Buttons
(defun rmail-mime-save (button)
@@ -636,6 +656,92 @@ HEADER is a header component of a MIME-entity object (see
(insert-image (create-image data (cdr bulk-data) t))
(insert "\n")))
+(defun rmail-mime-insert-html (entity)
+ "Decode, render, and insert html from MIME-entity ENTITY."
+ (let ((body (rmail-mime-entity-body entity))
+ (transfer-encoding (rmail-mime-entity-transfer-encoding entity))
+ (charset (cdr (assq 'charset (cdr (rmail-mime-entity-type entity)))))
+ (buffer (current-buffer))
+ (case-fold-search t)
+ coding-system)
+ (if charset (setq coding-system (coding-system-from-name charset)))
+ (or (and coding-system (coding-system-p coding-system))
+ (setq coding-system 'undecided))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (setq buffer-undo-list t)
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
+ (cond ((string= transfer-encoding "base64")
+ (ignore-errors (base64-decode-region (point-min) (point-max))))
+ ((string= transfer-encoding "quoted-printable")
+ (quoted-printable-decode-region (point-min) (point-max))))
+ ;; Some broken MUAs state the charset only in the HTML <head>,
+ ;; so if we don't have a non-trivial coding-system at this
+ ;; point, make one last attempt to find it there.
+ (if (eq coding-system 'undecided)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^<html><head><meta[^;]*; charset=\\([-a-zA-Z0-9]+\\)"
+ nil t)
+ (setq coding-system (coding-system-from-name (match-string 1)))
+ (or (and coding-system (coding-system-p coding-system))
+ (setq coding-system 'undecided)))
+ ;; Finally, let them manually force decoding if they know it.
+ (if (and (eq coding-system 'undecided)
+ (not (null coding-system-for-read)))
+ (setq coding-system coding-system-for-read))))
+ (decode-coding-region (point-min) (point) coding-system)
+ (if (and
+ (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
+ (not (eq (coding-system-base coding-system) 'us-ascii)))
+ (setq rmail-mime-coding-system coding-system))
+ ;; Convert html in temporary buffer to text and insert in original buffer
+ (let ((source-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (let ((start (point)))
+ (if rmail-mime-render-html-function
+ (funcall rmail-mime-render-html-function source-buffer)
+ (insert-buffer-substring source-buffer))
+ (rmail-mime-fix-inserted-faces start)))))))
+
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url discard-comments))
+
+(defun rmail-mime-render-html-shr (source-buffer)
+ (let ((dom (with-current-buffer source-buffer
+ (libxml-parse-html-region (point-min) (point-max))))
+ ;; Image retrieval happens asynchronously, but meanwhile
+ ;; `rmail-swap-buffers' may have been run, leaving
+ ;; `shr-image-fetched' trying to insert the image in the wrong buffer.
+ (shr-inhibit-images t)
+ ;; Bind shr-width to nil to force shr-insert-document break
+ ;; the lines at the window margin. The default is
+ ;; fill-column, whose default value is too small, and screws
+ ;; up display of the quoted messages.
+ shr-width)
+ (shr-insert-document dom)))
+
+(defun rmail-mime-render-html-lynx (source-buffer)
+ (let ((destination-buffer (current-buffer)))
+ (with-current-buffer source-buffer
+ (call-process-region (point-min) (point-max)
+ "lynx" nil destination-buffer nil
+ "-stdin" "-dump" "-force_html"
+ "-dont_wrap_pre" "-width=70"))))
+
+;; Put font-lock-face properties matching face properties on text
+;; inserted, e.g., by shr, in text from START to point.
+(defun rmail-mime-fix-inserted-faces (start)
+ (while (< start (point))
+ (let ((face (get-text-property start 'face))
+ (next (next-single-property-change
+ start 'face (current-buffer) (point))))
+ (if face ; anything to do?
+ (put-text-property start next 'font-lock-face face))
+ (setq start next))))
+
(defun rmail-mime-toggle-button (button)
"Hide or show the body of the MIME-entity associated with BUTTON."
(save-excursion
@@ -680,12 +786,15 @@ directly."
(setq size (/ (* size 7) 3)))))))
(cond
+ ((string-match "text/html" content-type)
+ (setq type 'html))
((string-match "text/" content-type)
(setq type 'text))
((string-match "image/\\(.*\\)" content-type)
(setq type (image-type-from-file-name
(concat "." (match-string 1 content-type))))
- (if (and (memq type image-types)
+ (if (and (boundp 'image-types)
+ (memq type image-types)
(image-type-available-p type))
(if (and rmail-mime-show-images
(not (eq rmail-mime-show-images 'button))
@@ -788,6 +897,12 @@ directly."
(if (rmail-mime-display-body new)
(cond ((eq (cdr bulk-data) 'text)
(rmail-mime-insert-decoded-text entity))
+ ((eq (cdr bulk-data) 'html)
+ ;; Render HTML if display single message, but if searching
+ ;; don't render but just search HTML itself.
+ (if rmail-mime-searching
+ (rmail-mime-insert-decoded-text entity)
+ (rmail-mime-insert-html entity)))
((cdr bulk-data)
(rmail-mime-insert-image entity))
(t
@@ -922,18 +1037,28 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
(setq entities (nreverse entities))
(if (string-match "alternative" subtype)
;; Find the best entity to show, and hide all the others.
- (let (best second)
+ ;; If rmail-mime-prefer-html is set, html is best, then plain.
+ ;; If not, plain is best, then html.
+ ;; Then comes any other text part.
+ ;; If thereto of the same type, earlier entities in the message (later
+ ;; in the reverse list) are preferred.
+ (let (best best-priority)
(dolist (child entities)
(if (string= (or (car (rmail-mime-entity-disposition child))
(car content-disposition))
"inline")
- (if (string-match "text/plain"
- (car (rmail-mime-entity-type child)))
- (setq best child)
- (if (string-match "text/.*"
- (car (rmail-mime-entity-type child)))
- (setq second child)))))
- (or best (not second) (setq best second))
+ (let ((type (car (rmail-mime-entity-type child))))
+ (if (string-match "text/" type)
+ ;; Consider all inline text parts
+ (let ((priority
+ (cond ((string-match "text/html" type)
+ (if rmail-mime-prefer-html 1 2))
+ ((string-match "text/plain" type)
+ (if rmail-mime-prefer-html 2 1))
+ (t 3))))
+ (if (or (null best) (<= priority best-priority))
+ (setq best child
+ best-priority priority)))))))
(dolist (child entities)
(unless (eq best child)
(aset (rmail-mime-entity-body child) 2 nil)
@@ -994,11 +1119,11 @@ are the values of the respective parsed headers. The latter should
be lower-case. The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
have the form
- \(VALUE . ALIST)
+ (VALUE . ALIST)
In other words:
- \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+ (VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
VALUE is a string and ATTRIBUTE is a symbol.
@@ -1010,7 +1135,7 @@ Content-Type: multipart/mixed;
The parsed header value:
\(\"multipart/mixed\"
- \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
+ (\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
;; Handle the content transfer encodings we know. Unknown transfer
;; encodings will be passed on to the various handlers.
(cond ((string= content-transfer-encoding "base64")
@@ -1118,6 +1243,8 @@ modified."
(cond ((string-match "multipart/.*" (car content-type))
(save-restriction
(narrow-to-region (1- end) (point-max))
+ (if (zerop (length parse-tag)) ; top level of message
+ (aset new 1 (aset tagline 2 nil))) ; don't show tagline
(setq children (rmail-mime-process-multipart
content-type
content-disposition
@@ -1138,6 +1265,12 @@ modified."
(aset (rmail-mime-entity-tagline msg) 2 nil)
(setq children (list msg)
handler 'rmail-mime-insert-multipart))))
+ ((and is-inline (string-match "text/html" (car content-type)))
+ ;; Display tagline, so part can be detached
+ (aset new 1 (aset tagline 2 t))
+ (aset new 2 (aset body 2 t)) ; display body also.
+ (setq handler 'rmail-mime-insert-bulk))
+ ;; Inline non-HTML text
((and is-inline (string-match "text/" (car content-type)))
;; Don't need a tagline.
(aset new 1 (aset tagline 2 nil))
@@ -1190,10 +1323,6 @@ If an error occurs, return an error message string."
(new (aref (rmail-mime-entity-display entity) 1)))
;; Show header.
(aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
- ;; Show tagline if and only if body is not shown.
- (if (aref new 2)
- (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
- (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
entity)))
(error (format "%s" err)))))
@@ -1394,7 +1523,8 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'."
"Function to set in `rmail-search-mime-message-function' (which see)."
(save-restriction
(narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
- (let* ((rmail-mime-mbox-buffer (current-buffer))
+ (let* ((rmail-mime-searching t) ; mark inside search
+ (rmail-mime-mbox-buffer (current-buffer))
(rmail-mime-view-buffer rmail-view-buffer)
(header-end (save-excursion
(re-search-forward "^$" nil 'move) (point)))
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index edf355ce891..aefb35d5c52 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -1,8 +1,8 @@
;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 7db265ef435..1e770e6fea6 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -1,9 +1,9 @@
;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file
-;; Copyright (C) 1985, 1987, 1993-1994, 2001-2013 Free Software
+;; Copyright (C) 1985, 1987, 1993-1994, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
@@ -85,8 +85,11 @@ This uses `rmail-output-file-alist'."
(error
(display-warning
:error
- (format "Error evaluating \
-`rmail-output-file-alist' element:\nregexp: %s\naction: %s\nerror: %S\n"
+ (format-message "\
+Error evaluating `rmail-output-file-alist' element:
+regexp: %s
+action: %s
+error: %S\n"
(caar tail) (cdar tail) err))
nil))))
(setq tail (cdr tail)))
@@ -345,6 +348,7 @@ the text directly to FILE-NAME, and displays a \"Wrote file\" message
unless NOMSG is a symbol (neither nil nor t).
AS-SEEN is non-nil if we are copying the message \"as seen\"."
(let ((case-fold-search t)
+ encrypted-file-name
from date)
(goto-char (point-min))
;; Preserve the Mail-From and MIME-Version fields
@@ -364,10 +368,45 @@ AS-SEEN is non-nil if we are copying the message \"as seen\"."
(goto-char (point-min))
(let ((buf (find-buffer-visiting file-name))
(tembuf (current-buffer)))
+ (when (string-match "[.]gpg\\'" file-name)
+ (setq encrypted-file-name file-name
+ file-name (substring file-name 0 (match-beginning 0))))
(if (null buf)
- (let ((coding-system-for-write 'raw-text-unix))
+ (let ((coding-system-for-write 'raw-text-unix)
+ (coding-system-for-read 'raw-text-unix))
+ ;; If the specified file is encrypted, decrypt it.
+ (when encrypted-file-name
+ (with-temp-buffer
+ (insert-file-contents encrypted-file-name)
+ (write-region 1 (point-max) file-name nil 'nomsg)))
;; FIXME should ensure existing file ends with a blank line.
- (write-region (point-min) (point-max) file-name t nomsg))
+ (write-region (point-min) (point-max) file-name t
+ (if (or nomsg encrypted-file-name)
+ 'nomsg))
+ ;; If the specified file was encrypted, re-encrypt it.
+ (when encrypted-file-name
+ ;; Save the old encrypted file as a backup.
+ (rename-file encrypted-file-name
+ (make-backup-file-name encrypted-file-name)
+ t)
+ (if (= 0
+ (call-process "gpg" nil nil
+ "--use-agent" "--batch" "--no-tty"
+ "--encrypt" "-r"
+ user-mail-address
+ file-name))
+ ;; Delete the unencrypted file if encryption succeeded.
+ (delete-file file-name)
+ ;; If encrypting failed, put back the original
+ ;; encrypted file and signal an error.
+ (rename-file (make-backup-file-name encrypted-file-name)
+ encrypted-file-name
+ t)
+ (error "Encryption failed; %s unchanged"
+ encrypted-file-name))
+ (unless nomsg
+ (message "Added to %s" encrypted-file-name)))
+ )
(if (eq buf (current-buffer))
(error "Can't output message to same file it's already in"))
;; File has been visited, in buffer BUF.
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index 670b81eda41..3e01b58a523 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -1,10 +1,10 @@
;;; rmailsort.el --- Rmail: sort messages
-;; Copyright (C) 1990, 1993-1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1990, 1993-1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 3a0a7824ad8..eeb42e81c6d 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1,9 +1,8 @@
-;;; rmailsum.el --- make summary buffers for the mail reader
+;;; rmailsum.el --- make summary buffers for the mail reader -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1993-1996, 2000-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1985, 1993-1996, 2000-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: rmail
@@ -263,7 +262,7 @@ Setting this option to nil might speed up the generation of summaries."
;; Regenerate the contents of the summary
;; using the same selection criterion as last time.
;; M-x revert-buffer in a summary buffer calls this function.
-(defun rmail-update-summary (&rest ignore)
+(defun rmail-update-summary (&rest _)
(apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
;;;###autoload
@@ -288,23 +287,18 @@ LABELS should be a string containing the desired labels, separated by commas."
(mail-comma-list-regexp labels)
"\\)\\(,\\|\\'\\)")))
-;; FIXME "a string of regexps separated by commas" makes no sense because:
-;; i) it's pointless (you can just use \\|)
-;; ii) it's broken (you can't specify a literal comma)
-;; rmail-summary-by-topic and rmail-summary-by-senders have the same issue.
;;;###autoload
(defun rmail-summary-by-recipients (recipients &optional primary-only)
"Display a summary of all messages with the given RECIPIENTS.
Normally checks the To, From and Cc fields of headers;
but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
-RECIPIENTS is a string of regexps separated by commas."
+RECIPIENTS is a regular expression."
(interactive "sRecipients to summarize by: \nP")
(rmail-new-summary
(concat "recipients " recipients)
(list 'rmail-summary-by-recipients recipients primary-only)
- 'rmail-message-recipients-p
- (mail-comma-list-regexp recipients) primary-only))
+ 'rmail-message-recipients-p recipients primary-only))
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
(rmail-apply-in-message msg 'rmail-message-recipients-p-1
@@ -341,20 +335,37 @@ Emacs will list the message in the summary."
"Return t, if for message number MSG, regexp REGEXP matches in the header."
(rmail-apply-in-message msg 'rmail-message-regexp-p-1 msg regexp))
+(defun rmail--decode-and-apply (function &rest args)
+ "Make an RFC2047-decoded copy of current buffer, apply FUNCTION with ARGS."
+ (let ((buff (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring buff)
+ (goto-char (point-min))
+ ;; FIXME? In rmail-show-message-1, decoding depends on
+ ;; rmail-enable-mime being non-nil (?).
+ (rfc2047-decode-region (point-min)
+ (save-excursion
+ (progn
+ (search-forward "\n\n" nil 'move)
+ (point))))
+ (apply function args))))
+
(defun rmail-message-regexp-p-1 (msg regexp)
;; Search functions can expect to start from the beginning.
(narrow-to-region (point) (save-excursion (search-forward "\n\n") (point)))
(if (and rmail-enable-mime
rmail-search-mime-header-function)
(funcall rmail-search-mime-header-function msg regexp (point))
- (re-search-forward regexp nil t)))
+ ;; We need to search the full headers, but probably want to decode
+ ;; them so they match the ones people see displayed. (Bug#19088)
+ (rmail--decode-and-apply 're-search-forward regexp nil t)))
;;;###autoload
(defun rmail-summary-by-topic (subject &optional whole-message)
"Display a summary of all messages with the given SUBJECT.
Normally checks just the Subject field of headers; but with prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
-SUBJECT is a string of regexps separated by commas."
+SUBJECT is a regular expression."
(interactive
;; We quote the default subject, because if it contains regexp
;; special characters (eg "?"), it can fail to match itself. (Bug#2333)
@@ -366,24 +377,23 @@ SUBJECT is a string of regexps separated by commas."
(rmail-new-summary
(concat "about " subject)
(list 'rmail-summary-by-topic subject whole-message)
- 'rmail-message-subject-p
- (mail-comma-list-regexp subject) whole-message))
+ 'rmail-message-subject-p subject whole-message))
(defun rmail-message-subject-p (msg subject &optional whole-message)
(if whole-message
- (rmail-apply-in-message msg 're-search-forward subject nil t)
+ ;; SUBJECT and rmail-simplified-subject are 2047 decoded.
+ (rmail-apply-in-message msg 'rmail--decode-and-apply
+ 're-search-forward subject nil t)
(string-match subject (rmail-simplified-subject msg))))
;;;###autoload
(defun rmail-summary-by-senders (senders)
"Display a summary of all messages whose \"From\" field matches SENDERS.
-SENDERS is a string of regexps separated by commas."
+SENDERS is a regular expression."
(interactive "sSenders to summarize by: ")
(rmail-new-summary
(concat "senders " senders)
- (list 'rmail-summary-by-senders senders)
- 'rmail-message-senders-p
- (mail-comma-list-regexp senders)))
+ (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p senders))
(defun rmail-message-senders-p (msg senders)
(string-match senders (or (rmail-get-header "From" msg) "")))
@@ -408,7 +418,7 @@ If FUNCTION is nil, includes all messages."
(unless rmail-buffer
(error "No RMAIL buffer found"))
(let (mesg was-in-summary sumbuf)
- (if (eq major-mode 'rmail-summary-mode)
+ (if (derived-mode-p 'rmail-summary-mode)
(setq was-in-summary t))
(with-current-buffer rmail-buffer
(setq rmail-summary-buffer (rmail-new-summary-1 desc redo function args)
@@ -473,8 +483,8 @@ message."
(widen)
(goto-char (point-min))
(while (>= total msgnum)
- ;; Go back to the Rmail buffer so
- ;; so FUNCTION and rmail-get-summary can see its local vars.
+ ;; Go back to the Rmail buffer so FUNCTION and
+ ;; rmail-get-summary can see its local vars.
(with-current-buffer main-buffer
;; First test whether to include this message.
(if (or (null function)
@@ -656,7 +666,7 @@ LINES is the number of lines in the message (if we should display that)
(goto-char (point-min))
(let ((line (rmail-header-summary))
(labels (rmail-get-summary-labels))
- pos status prefix basic-start basic-end linecount-string)
+ status prefix basic-start basic-end linecount-string)
(setq linecount-string
(cond
@@ -728,7 +738,7 @@ the message being processed."
;; Get all the lines of the From field
;; so that we get a whole comment if there is one,
;; so that mail-strip-quoted-names can discard it.
- (let ((opoint (point)))
+ (progn
(while (progn (forward-line 1)
(looking-at "[ \t]")))
;; Back up over newline, then trailing spaces or tabs
@@ -791,7 +801,7 @@ the message being processed."
(forward-line 1)
(setq str (buffer-substring pos (1- (point))))
(while (looking-at "[ \t]")
- (setq str (concat str " "
+ (setq str (concat str " "
(buffer-substring (match-end 0)
(line-end-position))))
(forward-line 1))
@@ -804,7 +814,8 @@ the message being processed."
(defun rmail-summary-next-all (&optional number)
(interactive "p")
- (forward-line (if number number 1))
+ (or number (setq number 1))
+ (forward-line number)
;; It doesn't look nice to move forward past the last message line.
(and (eobp) (> number 0)
(forward-line -1))
@@ -812,17 +823,14 @@ the message being processed."
(defun rmail-summary-previous-all (&optional number)
(interactive "p")
- (forward-line (- (if number number 1)))
- ;; It doesn't look nice to move forward past the last message line.
- (and (eobp) (< number 0)
- (forward-line -1))
- (display-buffer rmail-buffer))
+ (rmail-summary-next-all (- (or number 1))))
(defun rmail-summary-next-msg (&optional number)
"Display next non-deleted msg from rmail file.
With optional prefix argument NUMBER, moves forward this number of non-deleted
messages, or backward if NUMBER is negative."
(interactive "p")
+ (or number (setq number 1))
(forward-line 0)
(and (> number 0) (end-of-line))
(let ((count (if (< number 0) (- number) number))
@@ -840,7 +848,7 @@ messages, or backward if NUMBER is negative."
With optional prefix argument NUMBER, moves backward this number of
non-deleted messages."
(interactive "p")
- (rmail-summary-next-msg (- (if number number 1))))
+ (rmail-summary-next-msg (- (or number 1))))
(defun rmail-summary-next-labeled-message (n labels)
"Show next message with LABELS. Defaults to last labels used.
@@ -912,9 +920,12 @@ A prefix argument serves as a repeat count;
a negative argument means to delete and move backward."
(interactive "p")
(unless (numberp count) (setq count 1))
- (let (end del-msg
- (backward (< count 0)))
- (while (/= count 0)
+ (let (del-msg
+ (backward (< count 0)))
+ (while (and (/= count 0)
+ ;; Don't waste time if we are at the beginning
+ ;; and trying to go backward.
+ (not (and backward (bobp))))
(rmail-summary-goto-msg)
(with-current-buffer rmail-buffer
(rmail-delete-message)
@@ -924,11 +935,13 @@ a negative argument means to delete and move backward."
(save-excursion (beginning-of-line)
(looking-at " *[0-9]+D")))
(forward-line (if backward -1 1)))
+ (setq count
+ (if (> count 0) (1- count) (1+ count)))
;; It looks ugly to move to the empty line at end of buffer.
+ ;; And don't waste time after hitting the end.
(and (eobp) (not backward)
- (forward-line -1))
- (setq count
- (if (> count 0) (1- count) (1+ count))))))
+ (progn (setq count 0)
+ (forward-line -1))))))
(defun rmail-summary-delete-backward (&optional count)
"Delete this message and move to previous nondeleted one.
@@ -939,8 +952,9 @@ a negative argument means to delete and move forward."
(rmail-summary-delete-forward (- count)))
(defun rmail-summary-mark-deleted (&optional n undel)
- ;; Since third arg is t, this only alters the summary, not the Rmail buf.
- (and n (rmail-summary-goto-msg n t t))
+ (and n (not (eq n (rmail-summary-msg-number)))
+ ;; Since third arg is t, this only alters summary, not the Rmail buf.
+ (rmail-summary-goto-msg n t t))
(or (eobp)
(not (overlay-get rmail-summary-overlay 'face))
(let ((buffer-read-only nil))
@@ -951,9 +965,9 @@ a negative argument means to delete and move forward."
(progn (delete-char 1) (insert " ")))
(delete-char 1)
(insert "D"))
- ;; Register a new summary line.
+ ;; Discard cached new summary line.
(with-current-buffer rmail-buffer
- (aset rmail-summary-vector (1- n) (rmail-create-summary-line n)))))
+ (aset rmail-summary-vector (1- n) nil))))
(beginning-of-line))
(defun rmail-summary-update-line (n)
@@ -1002,7 +1016,7 @@ Optional prefix ARG means undelete ARG previous messages."
(set-buffer rmail-buffer)
(rmail-pop-to-buffer rmail-buffer))
(and (rmail-message-deleted-p rmail-current-message)
- (rmail-undelete-previous-message))
+ (rmail-undelete-previous-message 1))
(if rmail-enable-mime
(rmail-pop-to-buffer rmail-buffer))
(rmail-pop-to-buffer rmail-summary-buffer))
@@ -1011,31 +1025,40 @@ Optional prefix ARG means undelete ARG previous messages."
(defun rmail-summary-undelete-many (&optional n)
"Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
(interactive "P")
- (with-current-buffer rmail-buffer
- (let* ((init-msg (if n rmail-current-message rmail-total-messages))
- (rmail-current-message init-msg)
- (n (or n rmail-total-messages))
- (msgs-undeled 0))
- (while (and (> rmail-current-message 0)
- (< msgs-undeled n))
- (if (rmail-message-deleted-p rmail-current-message)
- (progn (rmail-set-attribute rmail-deleted-attr-index nil)
- (setq msgs-undeled (1+ msgs-undeled))))
- (setq rmail-current-message (1- rmail-current-message)))
- (set-buffer rmail-summary-buffer)
- (setq rmail-current-message init-msg msgs-undeled 0)
- (while (and (> rmail-current-message 0)
- (< msgs-undeled n))
- (if (rmail-summary-deleted-p rmail-current-message)
- (progn (rmail-summary-mark-undeleted rmail-current-message)
- (setq msgs-undeled (1+ msgs-undeled))))
- (setq rmail-current-message (1- rmail-current-message))))
- (rmail-summary-goto-msg)))
+ (if n
+ (while (and (> n 0) (not (eobp)))
+ (rmail-summary-goto-msg)
+ (let (del-msg)
+ (when (rmail-summary-deleted-p)
+ (with-current-buffer rmail-buffer
+ (rmail-undelete-previous-message 1)
+ (setq del-msg rmail-current-message))
+ (rmail-summary-mark-undeleted del-msg)))
+ (while (and (not (eobp))
+ (save-excursion (beginning-of-line)
+ (looking-at " *[0-9]+ ")))
+ (forward-line 1))
+ (setq n (1- n)))
+ (rmail-summary-goto-msg 1)
+ (dotimes (_ rmail-total-messages)
+ (rmail-summary-goto-msg)
+ (let (del-msg)
+ (when (rmail-summary-deleted-p)
+ (with-current-buffer rmail-buffer
+ (rmail-undelete-previous-message 1)
+ (setq del-msg rmail-current-message))
+ (rmail-summary-mark-undeleted del-msg)))
+ (if (not (eobp))
+ (forward-line 1))))
+
+ ;; It looks ugly to move to the empty line at end of buffer.
+ (and (eobp)
+ (forward-line -1)))
;; Rmail Summary mode is suitable only for specially formatted data.
(put 'rmail-summary-mode 'mode-class 'special)
-(defun rmail-summary-mode ()
+(define-derived-mode rmail-summary-mode special-mode "RMAIL Summary"
"Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
As commands are issued in the summary buffer, they are applied to the
corresponding mail messages in the rmail buffer.
@@ -1058,10 +1081,6 @@ Commands for sorting the summary:
\\[rmail-summary-sort-by-correspondent] Sort by correspondent.
\\[rmail-summary-sort-by-lines] Sort by lines.
\\[rmail-summary-sort-by-labels] Sort by labels."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'rmail-summary-mode)
- (setq mode-name "RMAIL Summary")
(setq truncate-lines t)
(setq buffer-read-only t)
(set-syntax-table text-mode-syntax-table)
@@ -1074,8 +1093,7 @@ Commands for sorting the summary:
(make-local-variable 'revert-buffer-function)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
- (rmail-summary-enable)
- (run-mode-hooks 'rmail-summary-mode-hook))
+ (rmail-summary-enable))
;; Summary features need to be disabled during edit mode.
(defun rmail-summary-disable ()
@@ -1193,6 +1211,13 @@ Search, the `unseen' attribute is restored.")
(goto-char (posn-point (event-end event)))
(rmail-summary-goto-msg))
+(defun rmail-summary-msg-number ()
+ (save-excursion
+ (beginning-of-line)
+ (string-to-number
+ (buffer-substring (point)
+ (min (point-max) (+ 6 (point)))))))
+
(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
"Go to message N in the summary buffer and the Rmail buffer.
If N is nil, use the message corresponding to point in the summary
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 4fdd75c68a6..9269d7f7d83 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,9 +1,9 @@
;;; sendmail.el --- mail sending commands for Emacs
-;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1986, 1992-1996, 1998, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -58,7 +58,7 @@
(defcustom mail-from-style 'default
"Specifies how \"From:\" fields look.
-If `nil', they contain just the return address like:
+If nil, they contain just the return address like:
king@grassland.com
If `parens', they look like:
king@grassland.com (Elvis Parsley)
@@ -525,31 +525,33 @@ This also saves the value of `send-mail-function' via Customize."
;; Query the user.
(with-temp-buffer
(rename-buffer "*Emacs Mail Setup Help*" t)
- (insert "\
+ (insert (substitute-command-keys "\
Emacs is about to send an email message, but it has not been
configured for sending email. To tell Emacs how to send email:
- - Type `"
+ - Type `")
(propertize "mail client" 'face 'bold)
- "' to start your default email client and
- pass it the message text.\n\n")
+ (substitute-command-keys "\
+' to start your default email client and
+ pass it the message text.\n\n"))
(and sendmail-program
(executable-find sendmail-program)
- (insert "\
- - Type `"
+ (insert (substitute-command-keys "\
+ - Type `")
(propertize "transport" 'face 'bold)
- "' to invoke the system's mail transport agent
- (the `"
+ (substitute-command-keys "\
+' to invoke the system's mail transport agent
+ (the `")
sendmail-program
- "' program).\n\n"))
- (insert "\
- - Type `"
+ (substitute-command-keys "' program).\n\n")))
+ (insert (substitute-command-keys "\
+ - Type `")
(propertize "smtp" 'face 'bold)
- "' to send mail directly to an \"outgoing mail\" server.
+ (substitute-command-keys "' to send mail directly to an \"outgoing mail\" server.
(Emacs may prompt you for SMTP settings).
Emacs will record your selection and will use it thereafter.
- To change it later, customize the option `send-mail-function'.\n")
+ To change it later, customize the option `send-mail-function'.\n"))
(goto-char (point-min))
(display-buffer (current-buffer))
(let ((completion-ignore-case t))
@@ -907,6 +909,8 @@ the user from the mailer."
(concat "\\(?:[[:space:];,]\\|\\`\\)"
(regexp-opt mail-mailing-lists t)
"\\(?:[[:space:];,]\\|\\'\\)"))))
+ (mail-combine-fields "To")
+ (mail-combine-fields "CC")
;; If there are mailing lists defined
(when ml
(save-excursion
@@ -1075,6 +1079,71 @@ This function does not perform RFC2047 encoding."
(goto-char fullname-start))))
(insert ")\n")))))
+(defun mail-combine-fields (field)
+ "Offer to combine all FIELD fields in buffer into one FIELD field.
+If this finds multiple FIELD fields, it asks the user whether
+to combine them into one, and does so if the user says y."
+ (let ((search-pattern (format "^%s[ \t]*:" field))
+ first-to-end
+ query-asked
+ query-answer
+ (old-point (point))
+ (old-max (point-max)))
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region (point-min) (mail-header-end))
+ ;; Find the first FIELD field and record where it ends.
+ (when (re-search-forward search-pattern nil t)
+ (forward-line 1)
+ (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (setq first-to-end (point-marker))
+ (set-marker-insertion-type first-to-end t)
+ ;; Find each following FIELD field
+ ;; and combine it with the first FIELD field.
+ (while (re-search-forward search-pattern nil t)
+ ;; For the second FIELD field, ask user to
+ ;; approve combining them.
+ ;; But if the user refuse to combine them, signal error.
+ (unless query-asked
+ (save-restriction
+ ;; This is just so the screen doesn't change.
+ (narrow-to-region (point-min) old-max)
+ (goto-char old-point)
+ (setq query-asked t)
+ (if (y-or-n-p (format "Message contains multiple %s fields. Combine? " field))
+ (setq query-answer t))))
+ (when query-answer
+ (let ((this-to-start (line-beginning-position))
+ this-to-end
+ this-to)
+ (forward-line 1)
+ (re-search-forward "^[^ \t]" nil t)
+ (beginning-of-line)
+ (setq this-to-end (point))
+ ;; Get the text of this FIELD field.
+ (setq this-to (buffer-substring this-to-start this-to-end))
+ ;; Delete it.
+ (delete-region this-to-start this-to-end)
+ (save-excursion
+ ;; Put a comma after the first FIELD field.
+ (goto-char first-to-end)
+ (forward-char -1)
+ (insert ",")
+ ;; Copy this one after it.
+ (goto-char first-to-end)
+ (save-excursion
+ (insert this-to))
+ ;; Replace the FIELD: with spaces.
+ (looking-at search-pattern)
+ ;; Try to preserve alignment of contents of the field
+ (let ((prefix-length (length (match-string 0))))
+ (replace-match " ")
+ (dotimes (i (1- prefix-length))
+ (insert " ")))))))
+ (set-marker first-to-end nil))))))
+
(defun mail-encode-header (beg end)
"Encode the mail header between BEG and END according to RFC2047.
Return non-nil if and only if some part of the header is encoded."
@@ -1299,10 +1368,10 @@ external program defined by `sendmail-program'."
(error "Sending...failed to %s"
(buffer-substring (point-min) (point-max)))))))
(kill-buffer tembuf)
- (if (and (bufferp errbuf)
- (not error))
- (kill-buffer errbuf)
- (switch-to-buffer-other-window errbuf)))))
+ (when (buffer-live-p errbuf)
+ (if error
+ (switch-to-buffer-other-window errbuf)
+ (kill-buffer errbuf))))))
(autoload 'rmail-output-to-rmail-buffer "rmailout")
@@ -1500,9 +1569,10 @@ just append to the file, in Babyl format if necessary."
(insert "\nMail-Followup-To: "))))
(defun mail-position-on-field (field &optional soft)
- "Move to the start of the contents of header field FIELD.
-If there is none, insert one, unless SOFT is non-nil.
-If there are multiple FIELD fields, this goes to the first."
+ "Move to the end of the contents of header field FIELD.
+If there is no such header, insert one, unless SOFT is non-nil.
+If there are multiple FIELD fields, this goes to the first.
+Returns non-nil if FIELD was originally present."
(let (end
(case-fold-search t))
(setq end (mail-header-end))
@@ -1977,7 +2047,7 @@ you can move to one of them and type C-c C-c to recover that one."
(if (not (yes-or-no-p
(format "Recover mail draft from auto save file %s? "
file-name)))
- (error "mail-recover cancelled")
+ (error "mail-recover canceled")
(let ((buffer-read-only nil)
(buffer-coding buffer-file-coding-system)
;; Auto-save files are written in internal
@@ -2008,7 +2078,6 @@ you can move to one of them and type C-c C-c to recover that one."
;; Local Variables:
;; byte-compile-dynamic: t
-;; coding: utf-8
;; End:
;;; sendmail.el ends here
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 5bfa29a0175..20de353295f 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,6 @@
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -687,6 +687,7 @@ Returns an error if the server cannot be contacted."
"smtpmail" process-buffer host port
:type smtpmail-stream-type
:return-list t
+ :warn-unless-encrypted ask-for-password
:capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
:end-of-command "^[0-9]+ .*\r\n"
:success "^2.*\n"
@@ -733,7 +734,7 @@ Returns an error if the server cannot be contacted."
(plist-get (cdr result) :capabilities)
"\r\n")))
(let ((name
- (with-case-table ascii-case-table
+ (with-case-table ascii-case-table ;FIXME: Why?
(mapcar (lambda (s) (intern (downcase s)))
(split-string (substring line 4) "[ ]")))))
(when (= (length name) 1)
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index fa55d5d278e..56158cc156c 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1,10 +1,10 @@
;;; supercite.el --- minor mode for citing mail and news replies
-;; Copyright (C) 1993, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: 1993 Barry A. Warsaw <bwarsaw@python.org>
-;; Maintainer: Glenn Morris <rgm@gnu.org>
-;; Created: February 1993
+;; Maintainer: emacs-devel@gnu.org
+;; Created: February 1993
;; Keywords: mail, news
;; This file is part of GNU Emacs.
@@ -886,10 +886,10 @@ Action can be one of: View, Modify, Add, or Delete."
(defun sc-attribs-%@-addresses (from &optional delim)
"Extract the author's email terminus from email address FROM.
-Match addresses of the style ``name%[stuff].'' when called with DELIM
-of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
+Match addresses of the style \"name%[stuff].\" when called with DELIM
+of \"%\" and addresses of the style \"[stuff]name@[stuff]\" when
called with DELIM \"@\". If DELIM is nil or not provided, matches
-addresses of the style ``name''."
+addresses of the style \"name\"."
(and (string-match (concat "[-[:alnum:]_.]+" delim) from 0)
(substring from
(match-beginning 0)
@@ -897,7 +897,7 @@ addresses of the style ``name''."
(defun sc-attribs-!-addresses (from)
"Extract the author's email terminus from email address FROM.
-Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
+Match addresses of the style \"[stuff]![stuff]...!name[stuff].\""
(let ((eos (length from))
(mstart (string-match "![-[:alnum:]_.]+\\([^-![:alnum:]_.]\\|$\\)"
from 0))
@@ -907,7 +907,7 @@ Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
(defun sc-attribs-<>-addresses (from)
"Extract the author's email terminus from email address FROM.
-Match addresses of the style ``<name[stuff]>.''"
+Match addresses of the style \"<name[stuff]>.\""
(and (string-match "<\\(.*\\)>" from)
(match-string 1 from)))
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 5ed9cc7d8f4..5db135728ea 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -1,6 +1,6 @@
;;; uce.el --- facilitate reply to unsolicited commercial email
-;; Copyright (C) 1996, 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: stanislav shalunov <shalunov@mccme.ru>
;; Created: 10 Dec 1996
@@ -88,7 +88,7 @@
;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
-;; Dec 11, 1996 -- fixed some typos, and Francesco Potorti`
+;; Dec 11, 1996 -- fixed some typos, and Francesco Potortì
;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was
;; weird, suggested fix, and added let form.
@@ -279,7 +279,7 @@ You might need to set `uce-mail-reader' before using this."
(goto-char (point-min)))
;; Now find the mail hub that first accepted this message.
;; This should try to find the last Received: header.
- ;; Sometimes there may be other headers inbetween Received: headers.
+ ;; Sometimes there may be other headers in between Received: headers.
(cond ((eq uce-mail-reader 'gnus)
;; Does Gnus always have Lines: in the end?
(re-search-forward "^Lines:")
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 42be51841a3..9fbbd94b083 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -1,9 +1,9 @@
;;; undigest.el --- digest-cracking support for the RMAIL mail reader
-;; Copyright (C) 1985-1986, 1994, 1996, 2001-2013 Free Software
+;; Copyright (C) 1985-1986, 1994, 1996, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -79,7 +79,7 @@ See rmail-digest-methods."
(rmail-digest-rfc1153
"^-\\{70\\}\n\n"
"^\n-\\{30\\}\n\n"
- "^\n-\\{30\\}\n\nEnd of .* Digest.*\n\\*\\{15,\\}\n+\'"))
+ "^\n-\\{30\\}\n\nEnd of .* Digest.*\n\\*\\{15,\\}\n+\\'"))
(defun rmail-digest-parse-rfc1153sloppy ()
"Parse using the method defined in RFC 1153, allowing for some sloppiness.
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index ac28e23e924..321baa57dac 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -1,8 +1,8 @@
;;; unrmail.el --- convert Rmail Babyl files to mbox files
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -52,12 +52,12 @@ Therefore any lines in the message bodies that start with \"From \"
must be quoted. The `mboxo' format just prepends a \">\" to such lines.
This is not reversible, because given a line starting with \">From \" in
an mboxo file, it is not possible to know whether the original had a \">\"
-or not. The `mxbord' format avoids this by also quoting \">From \" as
+or not. The `mboxrd' format avoids this by also quoting \">From \" as
\">>From \", and so on. For this reason, mboxrd is recommended.
See also `rmail-mbox-format'."
:type '(choice (const mboxrd)
- (const mboxro))
+ (const mboxo))
:version "24.4"
:group 'rmail-files)
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index 29818323c3c..c1e3439a5de 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -1,6 +1,6 @@
;;; uudecode.el -- elisp native uudecode
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: uudecode news
@@ -102,7 +102,7 @@ used is specified by `uudecode-decoder-program'."
(let ((cdir default-directory)
(default-process-coding-system
(if (featurep 'xemacs)
- ;; In XEmacs, `nil' is not a valid coding system.
+ ;; In XEmacs, nil is not a valid coding system.
'(binary . binary)
nil)))
(unwind-protect
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
deleted file mode 100644
index f4bbaf38040..00000000000
--- a/lisp/makefile.w32-in
+++ /dev/null
@@ -1,728 +0,0 @@
-# -*- Makefile -*- for GNU Emacs on the Microsoft Windows API.
-# Copyright (C) 2000-2013 Free Software Foundation, Inc.
-
-# This file is part of GNU Emacs.
-
-# GNU Emacs is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-
-# GNU Emacs is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-ALL =
-
-all: $(ALL)
-
-SQUOTE='
-# '
-
-lisp = $(CURDIR)
-srcdir = $(CURDIR)/..
-
-# You can specify a different executable on the make command line,
-# e.g. "make EMACS=../bin/emacs ...".
-
-EMACS = ../src/$(BLD)/emacs.exe
-
-# Command line flags for Emacs.
-
-EMACSOPT = -batch --no-site-file --no-site-lisp
-
-# Extra flags to pass to the byte compiler
-BYTE_COMPILE_EXTRA_FLAGS =
-# For example to not display the undefined function warnings you can use this:
-# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
-# The example above is just for developers, it should not be used by default.
-
-# Set EMACSLOADPATH correctly (already defined in environment).
-EMACSLOADPATH=$(lisp)
-
-# Use C locale
-LC_ALL = C
-
-lisptagsfiles1 = $(lisp)/*.el
-lisptagsfiles2 = $(lisp)/*/*.el
-lisptagsfiles3 = $(lisp)/*/*/*.el
-lisptagsfiles4 = $(lisp)/*/*/*/*.el
-ETAGS = "../lib-src/$(BLD)/etags.exe"
-## $(DEST) is overridden by ../src/makefile.w32-in.
-DEST=$(lisp)
-
-# Automatically generated autoload files, apart from lisp/loaddefs.el.
-LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
- $(lisp)/calendar/diary-loaddefs.el $(lisp)/calendar/hol-loaddefs.el \
- $(lisp)/mh-e/mh-loaddefs.el $(lisp)/net/tramp-loaddefs.el
-
-AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \
- $(lisp)/finder-inf.el $(lisp)/subdirs.el $(lisp)/eshell/esh-groups.el \
- $(lisp)/calc/calc-loaddefs.el $(lisp)/nxml/subdirs.el \
- $(lisp)/cedet/semantic/loaddefs.el $(lisp)/cedet/ede/loaddefs.el \
- $(lisp)/cedet/srecode/loaddefs.el
-
-# Value of max-lisp-eval-depth when compiling initially.
-# During bootstrapping the byte-compiler is run interpreted when compiling
-# itself, and uses more stack than usual.
-#
-BIG_STACK_DEPTH = 2200
-BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
-
-BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
-
-# Files to compile before others during a bootstrap. This is done to
-# speed up the bootstrap process.
-
-COMPILE_FIRST = \
- $(lisp)/emacs-lisp/macroexp.el \
- $(lisp)/emacs-lisp/cconv.el \
- $(lisp)/emacs-lisp/byte-opt.el \
- $(lisp)/emacs-lisp/bytecomp.el \
- $(lisp)/emacs-lisp/autoload.el
-
-# The actual Emacs command run in the targets below.
-# The quotes around $(EMACS) are here because the user could type
-# it with forward slashes and without quotes, which will fail if
-# the shell is cmd.exe.
-
-emacs = "$(EMACS)" $(EMACSOPT)
-
-# Have to define the list of subdirs manually when not using sh.
-WINS_CEDET=\
- cedet \
- cedet/ede \
- cedet/semantic \
- cedet/srecode \
- cedet/semantic/analyze \
- cedet/semantic/bovine \
- cedet/semantic/decorate \
- cedet/semantic/symref \
- cedet/semantic/wisent
-
-# The list of subdirectories is subdivided into 4 more or less equal
-# parts so that we could have 4-way parallelism while compiling Lisp
-# files, which helps to slash bootstrap times. See the 'compile'
-# target below.
-WINS_BASIC1=\
- calc \
- calendar \
- emacs-lisp \
- erc \
- net \
- url
-
-WINS_BASIC2=\
- gnus \
- international \
- language \
- mail
-
-WINS_BASIC3=\
- emulation \
- mh-e \
- nxml \
- org \
- play \
- textmodes \
- vc
-
-WINS_BASIC4=\
- eshell \
- progmodes
-
-WINS_BASIC= $(WINS_BASIC1) $(WINS_BASIC2) $(WINS_BASIC3) $(WINS_BASIC4)
-
-# Directories with lisp files to compile, and to extract data from
-# (customs, autoloads, etc.)
-WINS_UPDATES=$(WINS_BASIC) \
- $(WINS_CEDET)
-
-# Directories to add to subdirs.el
-WINS_SUBDIR=$(WINS_BASIC) \
- obsolete
-
-# All directories
-WINS= $(WINS_UPDATES) \
- term \
- obsolete
-
-doit:
-
-cus-load.el-SH:
- echo ";;; cus-load.el --- automatically extracted custom dependencies" > $@
- echo ";;" >> $@; echo ";;; Code:" >> $@
- echo " " >> $@
- echo ";; Local Variables:" >> $@
- echo ";; version-control: never" >> $@
- echo ";; no-byte-compile: t" >> $@
- echo ";; no-update-autoloads: t" >> $@
- echo ";; End:" >> $@
-
-cus-load.el-CMD:
- echo ;;; cus-load.el --- automatically extracted custom dependencies> $@
- echo ;;>> $@
- echo ;;; Code:>> $@
- echo. >> $@
- echo ;; Local Variables:>> $@
- echo ;; version-control: never>> $@
- echo ;; no-byte-compile: t>> $@
- echo ;; no-update-autoloads: t>> $@
- echo ;; End:>> $@
-
-$(lisp)/cus-load.el:
- $(MAKE) $(MFLAGS) cus-load.el-$(SHELLTYPE)
- mv cus-load.el-$(SHELLTYPE) $@
-
-# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
-# this can break with GNU Make 3.81 and later if sh.exe is used.
-custom-deps: $(lisp)/cus-load.el $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
- @echo Directories: $(WINS_UPDATES)
- -$(emacs) -l cus-dep --eval $(ARGQUOTE)(setq find-file-hook nil)$(ARGQUOTE) \
- -f custom-make-dependencies $(lisp) $(WINS_UPDATES)
-
-finder-data: $(lisp)/loaddefs.el $(lisp)/subdirs.el doit
- @echo Directories: $(WINS_UPDATES)
- $(emacs) -l finder -f finder-compile-keywords-make-dist $(lisp) $(WINS_UPDATES)
-
-$(lisp)/loaddefs.el:
- $(MAKE) $(MFLAGS) loaddefs.el-$(SHELLTYPE)
- cp loaddefs.el-$(SHELLTYPE) $@
- rm loaddefs.el-$(SHELLTYPE)
-
-loaddefs.el-SH:
- echo ";;; loaddefs.el --- automatically extracted autoloads" > $@
- echo ";;" >> $@; echo ";;; Code:" >> $@
- echo " " >> $@
- echo ";; Local Variables:" >> $@
- echo ";; version-control: never" >> $@
- echo ";; no-byte-compile: t" >> $@
- echo ";; no-update-autoloads: t" >> $@
- echo ";; coding: utf-8" >> $@
- echo ";; End:" >> $@
- echo ";;; loaddefs.el ends here" >> $@
-
-loaddefs.el-CMD:
- echo ;;; loaddefs.el --- automatically extracted autoloads> $@
- echo ;;>> $@
- echo ;;; Code:>> $@
- echo. >> $@
- echo ;; Local Variables:>> $@
- echo ;; version-control: never>> $@
- echo ;; no-byte-compile: t>> $@
- echo ;; no-update-autoloads: t>> $@
- echo ;; coding: utf-8>> $@
- echo ;; End:>> $@
- echo ;;; loaddefs.el ends here>> $@
-
-# Use . instead of $(lisp) because $(lisp) is an absolute file name,
-# including a drive letter and any leading directories, so the generated
-# loaddefs.el will mention file names that on other machine reference
-# possibly non-existent directories.
-#
-# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
-# this can break with GNU Make 3.81 and later if sh.exe is used.
-autoloads: $(lisp)/loaddefs.el $(LOADDEFS) doit
- @echo Directories: . $(WINS_UPDATES)
- $(emacs) -l autoload \
- --eval $(ARGQUOTE)(setq find-file-hook nil find-file-suppress-same-file-warnings t)$(ARGQUOTE) \
- -f w32-batch-update-autoloads "$(lisp)/loaddefs.el" $(MAKE) . $(WINS_UPDATES)
-
-$(lisp)/subdirs.el:
- $(MAKE) $(MFLAGS) update-subdirs
-
-# Need separate version for sh and native cmd.exe
-update-subdirs: update-subdirs-$(SHELLTYPE)
-
-update-subdirs-CMD: doit
- echo ;; In load-path, after this directory should come> $(lisp)/subdirs.el
- echo ;; certain of its subdirectories. Here we specify them.>> $(lisp)/subdirs.el
- echo (normal-top-level-add-to-load-path $(SQUOTE)(>> $(lisp)/subdirs.el
- @for %%d in ($(WINS_SUBDIR) cedet) do echo "%%d">> $(lisp)/subdirs.el
- echo ))>> $(lisp)/subdirs.el
- echo ;; Local Variables:>> $(lisp)/subdirs.el
- echo ;; version-control: never>> $(lisp)/subdirs.el
- echo ;; no-byte-compile: t>> $(lisp)/subdirs.el
- echo ;; End:>> $(lisp)/subdirs.el
-
-update-subdirs-SH: doit
- $(srcdir)/build-aux/update-subdirs $(lisp); \
- for file in $(WINS_SUBDIR); do \
- $(srcdir)/build-aux/update-subdirs $$file; \
- done;
-
-updates: $(lisp)/subdirs.el autoloads mh-autoloads finder-data custom-deps
-
-# This is useful after "bzr up".
-bzr-update: recompile autoloads finder-data custom-deps
-
-# For backwards compatibility:
-cvs-update: bzr-update
-
-# Update the AUTHORS file.
-
-update-authors:
- $(emacs) -l authors -f batch-update-authors $(srcdir)/etc/AUTHORS $(srcdir)
-
-TAGS: TAGS-$(MAKETYPE)
-
-TAGS-LISP: TAGS-LISP-$(MAKETYPE)
-
-TAGS-nmake:
- echo This target is not supported with NMake
- exit -1
-
-TAGS-LISP-nmake:
- echo This target is not supported with NMake
- exit -1
-
-TAGS-gmake: TAGS-$(SHELLTYPE)
-
-TAGS-LISP-gmake: TAGS-LISP-$(SHELLTYPE)
-
-TAGS-SH: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
- - $(DEL) TAGS
- for dir in . $(WINS_UPDATES); do \
- $(ETAGS) -a $(lisp)/$$dir/*.el; \
- done
-
-TAGS-LISP-SH: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
- - $(DEL) $(DEST)/TAGS-LISP
- for dir in . $(WINS_UPDATES); do \
- $(ETAGS) -a -o $(DEST)/TAGS-LISP $(lisp)/$$dir/*.el; \
- done
-
-TAGS-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
- - $(DEL) TAGS
- for %%d in (. $(WINS_UPDATES)) do $(ETAGS) -a $(lisp)/%%d/*.el
-
-TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
- - $(DEL) $(DEST)/TAGS-LISP
- for %%d in (. $(WINS_UPDATES)) do \
- $(ETAGS) -a -o $(DEST)/TAGS-LISP $(lisp)/%%d/*.el
-
-.SUFFIXES: .elc .el
-
-.el.elc:
- -$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $<
-
-# Compile all Lisp files, but don't recompile those that are up to
-# date. Some files don't actually get compiled because they set the
-# local variable no-byte-compile.
-
-# All .elc files are made writable before compilation in case we
-# checked out read-only (CVS option -r). Files MUST be compiled one by
-# one. If we compile several files in a row we can't make sure that
-# the compilation environment is clean. We also set the load-path of
-# the Emacs used for compilation to the current directory and its
-# subdirectories, to make sure require's and load's in the files being
-# compiled find the right files.
-
-# Need separate version for sh and native cmd.exe
-compile: $(lisp)/subdirs.el compile0-$(SHELLTYPE) compile1-$(SHELLTYPE) compile2-$(SHELLTYPE) compile3-$(SHELLTYPE) compile4-$(SHELLTYPE) doit
-
-compile0-CMD: autoloads
-# -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
- for %%f in ($(COMPILE_FIRST)) do \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f
-
-compile1-CMD: autoloads compile0-CMD
- for %%f in (. $(WINS_BASIC1)) do for %%g in (%%f/*.el) do \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-
-compile2-CMD: autoloads compile0-CMD
- for %%f in ($(WINS_BASIC2)) do for %%g in (%%f/*.el) do \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-
-compile3-CMD: autoloads compile0-CMD
- for %%f in ($(WINS_BASIC3)) do for %%g in (%%f/*.el) do \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-
-compile4-CMD: autoloads compile0-CMD
- for %%f in ($(WINS_BASIC4) $(WINS_CEDET) term obsolete) do for %%g in (%%f/*.el) do \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g
-
-compile0-SH: autoloads
-# for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
- for el in $(COMPILE_FIRST); do \
- echo Compiling $$el; \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
- done
-
-compile1-SH: autoloads compile0-SH
- for dir in $(lisp) $(WINS_BASIC1); do \
- for el in $$dir/*.el; do \
- if test -f $$el; \
- then \
- echo Compiling $$el; \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
- fi \
- done; \
- done
-
-compile2-SH: autoloads compile0-SH
- for dir in $(WINS_BASIC2); do \
- for el in $$dir/*.el; do \
- if test -f $$el; \
- then \
- echo Compiling $$el; \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
- fi \
- done; \
- done
-
-compile3-SH: autoloads compile0-SH
- for dir in $(WINS_BASIC3); do \
- for el in $$dir/*.el; do \
- if test -f $$el; \
- then \
- echo Compiling $$el; \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
- fi \
- done; \
- done
-
-compile4-SH: autoloads compile0-SH
- for dir in $(WINS_BASIC4) $(WINS_CEDET) term obsolete; do \
- for el in $$dir/*.el; do \
- if test -f $$el; \
- then \
- echo Compiling $$el; \
- $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \
- fi \
- done; \
- done
-
-# Compile all Lisp files. This is like `compile' but compiles files
-# unconditionally. Some files don't actually get compiled because they
-# set the local variable no-byte-compile.
-
-compile-always: $(lisp)/subdirs.el compile-always-$(SHELLTYPE) doit
-
-compile-always-CMD:
-# -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g
- for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f
- for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f/%%g
-
-compile-always-SH:
-# for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done
- for el in $(COMPILE_FIRST); do \
- echo Compiling $$el; \
- $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
- done
- for dir in $(lisp) $(WINS); do \
- for el in $$dir/*.el; do \
- echo Compiling $$el; \
- $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
- done; \
- done
-
-compile-calc: compile-calc-$(SHELLTYPE)
-
-compile-calc-CMD:
- for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f
-
-compile-calc-SH:
- for el in $(lisp)/calc/*.el; do \
- echo Compiling $$el; \
- $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \
- done
-
-# Backup compiled Lisp files in elc.tar.gz. If that file already
-# exists, make a backup of it.
-
-backup-compiled-files:
- -mv $(lisp)/elc.tar.gz $(lisp)/elc.tar.gz~
- -tar czf $(lisp)/elc.tar.gz $(lisp)/*.elc $(lisp)/*/*.elc
-
-# Compile Lisp files, but save old compiled files first.
-
-compile-after-backup: backup-compiled-files compile-always
-
-compile-first: $(lisp)/emacs-lisp/bytecomp.elc $(lisp)/emacs-lisp/byte-opt.elc \
- $(lisp)/emacs-lisp/autoload.elc $(lisp)/subdirs.el
-
-# Recompile all Lisp files which are newer than their .elc files.
-# Note that this doesn't create .elc files. It only recompiles if an
-# .elc is present.
-# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
-# this can break with GNU Make 3.81 and later if sh.exe is used.
-recompile: compile-first autoloads doit $(lisp)/progmodes/cc-mode.elc
- $(emacs) --eval $(ARGQUOTE)(batch-byte-recompile-directory 0)$(ARGQUOTE) $(lisp)
-
-$(lisp)/calendar/cal-loaddefs.el: $(lisp)/subdirs.el
- "$(EMACS)" $(EMACSOPT) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \
- --eval "(setq find-file-suppress-same-file-warnings t)" \
- --eval "(setq make-backup-files nil)" \
- -f w32-batch-update-autoloads "$(lisp)/calendar/cal-loaddefs.el" \
- $(MAKE) ./calendar
-
-$(lisp)/calendar/diary-loaddefs.el: $(lisp)/subdirs.el
- "$(EMACS)" $(EMACSOPT) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \
- --eval "(setq find-file-suppress-same-file-warnings t)" \
- --eval "(setq make-backup-files nil)" \
- -f w32-batch-update-autoloads $(lisp)/calendar/diary-loaddefs.el \
- $(MAKE) ./calendar
-
-$(lisp)/calendar/hol-loaddefs.el: $(lisp)/subdirs.el
- "$(EMACS)" $(EMACSOPT) -l autoload \
- --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \
- --eval "(setq find-file-suppress-same-file-warnings t)" \
- --eval "(setq make-backup-files nil)" \
- -f w32-batch-update-autoloads $(lisp)/calendar/hol-loaddefs.el \
- $(MAKE) ./calendar
-
-# Update MH-E internal autoloads. These are not to be confused with
-# the autoloads for the MH-E entry points, which are already in
-# loaddefs.el.
-MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \
- $(lisp)/mh-e/mh-buffers.el $(lisp)/mh-e/mh-compat.el \
- $(lisp)/mh-e/mh-comp.el $(lisp)/mh-e/mh-e.el \
- $(lisp)/mh-e/mh-folder.el $(lisp)/mh-e/mh-funcs.el \
- $(lisp)/mh-e/mh-gnus.el $(lisp)/mh-e/mh-identity.el \
- $(lisp)/mh-e/mh-inc.el $(lisp)/mh-e/mh-junk.el \
- $(lisp)/mh-e/mh-letter.el $(lisp)/mh-e/mh-limit.el \
- $(lisp)/mh-e/mh-mime.el $(lisp)/mh-e/mh-print.el \
- $(lisp)/mh-e/mh-scan.el $(lisp)/mh-e/mh-search.el \
- $(lisp)/mh-e/mh-seq.el $(lisp)/mh-e/mh-show.el \
- $(lisp)/mh-e/mh-speed.el $(lisp)/mh-e/mh-thread.el \
- $(lisp)/mh-e/mh-tool-bar.el $(lisp)/mh-e/mh-utils.el \
- $(lisp)/mh-e/mh-xface.el
-
-# See the commentary for autoloads above for why we use ./mh-e below
-# instead of $(lisp)/mh-e.
-mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el
-$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) $(lisp)/subdirs.el
- "$(EMACS)" $(EMACSOPT) \
- -l autoload \
- --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###mh-autoload$(DQUOTE))$(ARGQUOTE) \
- --eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \
- --eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \
- -f w32-batch-update-autoloads \
- $(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e
-
-# Update TRAMP internal autoloads. Maybe we could move tramp*.el into
-# an own subdirectory. OTOH, it does not hurt to keep them in
-# lisp/net.
-TRAMP_DIR = $(lisp)/net
-TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \
- $(TRAMP_DIR)/tramp-cache.el $(TRAMP_DIR)/tramp-cmds.el \
- $(TRAMP_DIR)/tramp-compat.el $(TRAMP_DIR)/tramp-ftp.el \
- $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \
- $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \
- $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
-
-$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) $(lisp)/subdirs.el
- "$(EMACS)" $(EMACSOPT) \
- -l autoload \
- --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \
- --eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \
- --eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \
- -f w32-batch-update-autoloads \
- $(ARGQUOTE)$(TRAMP_DIR)/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net
-
-# Prepare a bootstrap in the lisp subdirectory.
-#
-# Build loaddefs.el to make sure it's up-to-date. If it's not, that
-# might lead to errors during the bootstrap because something fails to
-# autoload as expected. If there is no emacs binary, then we can't
-# build autoloads yet. In that case we have to use ldefs-boot.el;
-# bootstrap should always work with ldefs-boot.el. (Because
-# loaddefs.el is an automatically generated file, we don't want to
-# store it in the source repository).
-#
-# Remove compiled Lisp files so that bootstrap-emacs will be built from
-# sources only.
-
-# Need separate version for sh and native cmd.exe
-bootstrap-clean:
- - $(DEL) $(lisp)/loaddefs.el
- - $(DEL) $(lisp)/subdirs.el
- $(MAKE) $(MFLAGS) bootstrap-clean-$(SHELLTYPE)
-
-bootstrap-clean-CMD:
-# if exist "$(EMACS)" $(MAKE) $(MFLAGS) autoloads
- -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g
-
-bootstrap-clean-SH:
-# if test -f "$(EMACS)"; then $(MAKE) $(MFLAGS) autoloads; fi
-# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc
- -for dir in . $(WINS); do rm -f $$dir/*.elc $$dir/*/*.elc $$dir/*/*/*.elc; done
-
-# Generate/update files for the bootstrap process.
-# When done, remove bootstrap-emacs from ../bin, so that
-# it will not be mistaken for an installed binary.
-
-bootstrap: $(lisp)/subdirs.el compile finder-data custom-deps
- - $(DEL) "$(EMACS)"
-
-#
-# Assuming INSTALL_DIR is defined, copy the elisp files to it
-# Windows 95 makes this harder than it should be.
-#
-install:
- - mkdir "$(INSTALL_DIR)/lisp"
- - $(DEL) ../$(DIRNAME)_same-dir.tst
- - $(DEL) "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
- echo SameDirTest > "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
-#ifdef COPY_LISP_SOURCE
- $(IFNOTSAMEDIR) $(MAKE) $(MFLAGS) install-lisp-$(SHELLTYPE) $(ENDIF)
-#else
-# $(IFNOTSAMEDIR) $(CP_DIR) *.elc "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) cus-load.el "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) forms*.el "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) patcomp.el "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) subdirs.el "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) version.el "$(INSTALL_DIR)/lisp" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) mail/blessmail.el "$(INSTALL_DIR)/lisp/mail" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) mail/sc.el "$(INSTALL_DIR)/lisp/mail" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) play/bruce.el "$(INSTALL_DIR)/lisp/play" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) international/latin-*.el "$(INSTALL_DIR)/lisp/international" $(ENDIF)
-# $(IFNOTSAMEDIR) $(CP) international/mule-conf.el "$(INSTALL_DIR)/lisp/international" $(ENDIF)
-#endif
- - $(DEL) ../$(DIRNAME)_same-dir.tst
- - $(DEL) "$(INSTALL_DIR)/$(DIRNAME)_same-dir.tst"
-
-# Need to copy *.el files first, to avoid "source file is newer" annoyance
-# since cp does not preserve time stamps
-install-lisp-SH:
- cp -f *.el "$(INSTALL_DIR)/lisp"
- for dir in $(WINS); do [ -d "$(INSTALL_DIR)/lisp/$$dir" ] || mkdir "$(INSTALL_DIR)/lisp/$$dir"; done
- for dir in $(WINS); do cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done
- for dir in . $(WINS); do cp $$dir/*.elc "$(INSTALL_DIR)/lisp/$$dir"; done
-
-install-lisp-CMD:
- cp -f *.el "$(INSTALL_DIR)/lisp"
- for %%f in ($(WINS)) do if not exist "$(INSTALL_DIR)/lisp/%%f" mkdir "$(INSTALL_DIR)/lisp/%%f"
- for %%f in ($(WINS)) do cp -f %%f/*.el "$(INSTALL_DIR)/lisp/%%f"
- for %%f in (. $(WINS)) do cp -f %%f/*.elc "$(INSTALL_DIR)/lisp/%%f"
-
-# WARNING: Do NOT split the part inside $(ARGQUOTE)s into multiple lines as
-# this can break with GNU Make 3.81 and later if sh.exe is used.
-check-declare:
- $(emacs) -l $(lisp)/emacs-lisp/check-declare --eval $(ARGQUOTE)(check-declare-directory $(DQUOTE)$(lisp)$(DQUOTE))$(ARGQUOTE)
-
-#
-# Maintenance
-#
-# We used to delete *~ here, but that might inadvertently remove
-# precious files if it happens to match their short 8+3 aliases.
-clean:
- - $(DEL) *.el~
- - $(DEL) calc/calc-loaddefs.el~
- - $(DEL) eshell/esh-groups.el~
-
-distclean: clean
- - $(DEL) $(lisp)/Makefile
-
-maintainer-clean: bootstrap-clean distclean
- - $(DEL) $(AUTOGENEL)
-
-# Dependencies
-
-# CC Mode uses a compile time macro system which causes a compile time
-# dependency in cc-*.elc files on the macros in other cc-*.el and the
-# version string in cc-defs.el.
-$(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-awk.elc\
- $(lisp)/progmodes/cc-cmds.elc $(lisp)/progmodes/cc-compat.elc\
- $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-fonts.elc\
- $(lisp)/progmodes/cc-langs.elc $(lisp)/progmodes/cc-menus.elc\
- $(lisp)/progmodes/cc-mode.elc $(lisp)/progmodes/cc-styles.elc\
- $(lisp)/progmodes/cc-vars.elc: \
- $(lisp)/progmodes/cc-bytecomp.elc $(lisp)/progmodes/cc-defs.elc
-
-$(lisp)/progmodes/cc-align.elc: \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc
-
-$(lisp)/progmodes/cc-cmds.elc: \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc
-
-$(lisp)/progmodes/cc-compat.elc: \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-styles.elc \
- $(lisp)/progmodes/cc-engine.elc
-
-$(lisp)/progmodes/cc-defs.elc: $(lisp)/progmodes/cc-bytecomp.elc \
- $(lisp)/emacs-lisp/cl.elc $(lisp)/emacs-lisp/regexp-opt.elc
-
-$(lisp)/progmodes/cc-engine.elc: $(lisp)/progmodes/cc-langs.elc \
- $(lisp)/progmodes/cc-vars.elc
-
-$(lisp)/progmodes/cc-fonts.elc: $(lisp)/progmodes/cc-langs.elc \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
- $(lisp)/font-lock.elc
-
-$(lisp)/progmodes/cc-langs.elc: $(lisp)/progmodes/cc-vars.elc \
- $(lisp)/emacs-lisp/cl.elc
-
-$(lisp)/progmodes/cc-mode.elc: $(lisp)/progmodes/cc-langs.elc \
- $(lisp)/progmodes/cc-vars.elc $(lisp)/progmodes/cc-engine.elc \
- $(lisp)/progmodes/cc-styles.elc $(lisp)/progmodes/cc-cmds.elc \
- $(lisp)/progmodes/cc-align.elc $(lisp)/progmodes/cc-menus.elc \
- $(lisp)/subdirs.el
-
-$(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \
- $(lisp)/progmodes/cc-align.elc
-
-$(lisp)/progmodes/cc-vars.elc: $(lisp)/custom.elc $(lisp)/widget.elc
-
-# MH-E dependencies, mainly to prevent failures with parallel
-# compilation, due to race conditions between writing a given FOO.elc
-# file and another file being compiled that says "(require FOO)",
-# which causes Emacs to try to read FOO.elc.
-MH_E_DIR = ./mh-e
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-comp.elc $(MH_E_DIR)/mh-folder.elc\
- $(MH_E_DIR)/mh-funcs.elc $(MH_E_DIR)/mh-identity.elc $(MH_E_DIR)/mh-inc.elc\
- $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-limit.elc\
- $(MH_E_DIR)/mh-mime.elc $(MH_E_DIR)/mh-print.elc $(MH_E_DIR)/mh-scan.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc\
- $(MH_E_DIR)/mh-speed.elc $(MH_E_DIR)/mh-thread.elc $(MH_E_DIR)/mh-tool-bar.elc\
- $(MH_E_DIR)/mh-utils.elc $(MH_E_DIR)/mh-xface.elc:\
- $(MH_E_DIR)/mh-e.elc
-
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-e.elc $(MH_E_DIR)/mh-folder.elc\
- $(MH_E_DIR)/mh-inc.elc $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-limit.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-speed.elc\
- $(MH_E_DIR)/mh-utils.elc $(MH_E_DIR)/mh-xface.elc:\
- $(lisp)/emacs-lisp/cl.elc
-
-$(MH_E_DIR)/mh-comp.elc $(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-funcs.elc\
- $(MH_E_DIR)/mh-junk.elc $(MH_E_DIR)/mh-limit.elc $(MH_E_DIR)/mh-print.elc\
- $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc $(MH_E_DIR)/mh-thread.elc:\
- $(MH_E_DIR)/mh-scan.elc
-
-$(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-mime.elc\
- $(MH_E_DIR)/mh-search.elc $(MH_E_DIR)/mh-show.elc $(MH_E_DIR)/mh-speed.elc:\
- $(lisp)/gnus/gnus-util.elc
-
-$(MH_E_DIR)/mh-folder.elc $(MH_E_DIR)/mh-search.elc:\
- $(lisp)/progmodes/which-func.elc
-
-$(MH_E_DIR)/mh-letter.elc $(MH_E_DIR)/mh-seq.elc $(MH_E_DIR)/mh-show.elc\
- $(MH_E_DIR)/mh-utils.elc:\
- $(lisp)/font-lock.elc
-
-$(MH_E_DIR)/mh-alias.elc $(MH_E_DIR)/mh-show.elc: $(lisp)/net/goto-addr.elc
-
-$(MH_E_DIR)/mh-comp.elc: $(lisp)/mail/sendmail.elc
-
-$(MH_E_DIR)/mh-e.elc: $(MH_E_DIR)/mh-buffers.elc $(lisp)/gnus/gnus.elc \
- $(lisp)/cus-face.elc
-
-$(MH_E_DIR)/mh-letter.elc: $(lisp)/gnus/mailcap.elc $(lisp)/gnus/mm-decode.elc \
- $(lisp)/gnus/mm-view.elc $(lisp)/gnus/mml.elc $(lisp)/gnus/message.elc
-
-$(MH_E_DIR)/mh-print.elc: $(lisp)/ps-print.elc
-
-$(MH_E_DIR)/mh-search.elc: $(lisp)/imenu.elc
-
-$(MH_E_DIR)/mh-show.elc: $(lisp)/gnus/gnus-cite.elc
-
-$(MH_E_DIR)/mh-speed.elc: $(lisp)/speedbar.elc $(lisp)/emacs-lisp/timer.elc
-
-$(MH_E_DIR)/mh-tool-bar.elc: $(lisp)/tool-bar.elc
diff --git a/lisp/makesum.el b/lisp/makesum.el
index 3129176d5f7..f2ac1e2af4c 100644
--- a/lisp/makesum.el
+++ b/lisp/makesum.el
@@ -1,8 +1,8 @@
;;; makesum.el --- generate key binding summary for Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
;; This file is part of GNU Emacs.
diff --git a/lisp/man.el b/lisp/man.el
index 34131f43692..90d658a3e76 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1,10 +1,10 @@
-;;; man.el --- browse UNIX manual pages -*- coding: utf-8 -*-
+;;; man.el --- browse UNIX manual pages
-;; Copyright (C) 1993-1994, 1996-1997, 2001-2013 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help
;; Adapted-By: ESR, pot
@@ -55,7 +55,7 @@
;; point and some other names have been changed to make it a drop-in
;; replacement for the old man.el package.
-;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
+;; Francesco Potortì <pot@cnuce.cnr.it> cleaned it up thoroughly,
;; making it faster, more robust and more tolerant of different
;; systems' man idiosyncrasies.
@@ -89,6 +89,7 @@
;;; Code:
(require 'ansi-color)
+(require 'cl-lib)
(require 'button)
(defgroup man nil
@@ -103,7 +104,7 @@
"Manpage cleaning filter command phrases.
This variable contains a list of the following form:
-'((command-string phrase-string*)*)
+ ((command-string phrase-string*)*)
Each phrase-string is concatenated onto the command-string to form a
command filter. The (standard) output (and standard error) of the Un*x
@@ -173,13 +174,12 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
(defcustom Man-width nil
"Number of columns for which manual pages should be formatted.
-If nil, the width of the window selected at the moment of man
-invocation is used. If non-nil, the width of the frame selected
-at the moment of man invocation is used. The value also can be a
-positive integer."
+If nil, use the width of the window where the manpage is displayed.
+If non-nil, use the width of the frame where the manpage is displayed.
+The value also can be a positive integer for a fixed width."
:type '(choice (const :tag "Window width" nil)
(const :tag "Frame width" t)
- (integer :tag "Specific width" :value 65))
+ (integer :tag "Fixed width" :value 65))
:group 'man)
(defcustom Man-frame-parameters nil
@@ -311,7 +311,7 @@ This regular expression should start with a `^' character.")
"Regular expression describing a reference to another manpage.")
(defvar Man-apropos-regexp
- (concat "\\\[\\(" Man-name-regexp "\\)\\\][ \t]*(\\(" Man-section-regexp "\\))")
+ (concat "\\[\\(" Man-name-regexp "\\)\\][ \t]*(\\(" Man-section-regexp "\\))")
"Regular expression describing a reference to manpages in \"man -k output\".")
(defvar Man-synopsis-regexp "SYNOPSIS"
@@ -368,6 +368,12 @@ specified subject, if your `man' program supports it."
Otherwise, the value is whatever the function
`Man-support-local-filenames' should return.")
+(defcustom man-imenu-title "Contents"
+ "The title to use if man adds a Contents menu to the menubar."
+ :version "24.4"
+ :type 'string
+ :group 'man)
+
;; other variables and keymap initializations
(defvar Man-original-frame)
@@ -413,7 +419,7 @@ Otherwise, the value is whatever the function
(defvar Man-topic-history nil "Topic read history.")
-(defvar man-mode-syntax-table
+(defvar Man-mode-syntax-table
(let ((table (copy-syntax-table (standard-syntax-table))))
(modify-syntax-entry ?. "w" table)
(modify-syntax-entry ?_ "w" table)
@@ -441,11 +447,34 @@ Otherwise, the value is whatever the function
(define-key map "s" 'Man-goto-see-also-section)
(define-key map "k" 'Man-kill)
(define-key map "q" 'Man-quit)
+ (define-key map "u" 'Man-update-manpage)
(define-key map "m" 'man)
;; Not all the man references get buttons currently. The text in the
;; manual page can contain references to other man pages
(define-key map "\r" 'man-follow)
(define-key map "?" 'describe-mode)
+
+ (easy-menu-define nil map
+ "`Man-mode' menu."
+ '("Man"
+ ["Next Section" Man-next-section t]
+ ["Previous Section" Man-previous-section t]
+ ["Go To Section..." Man-goto-section t]
+ ["Go To \"SEE ALSO\" Section" Man-goto-see-also-section
+ :active (cl-member Man-see-also-regexp Man--sections
+ :test #'string-match-p)]
+ ["Follow Reference..." Man-follow-manual-reference
+ :active Man--refpages
+ :help "Go to a manpage referred to in the \"SEE ALSO\" section"]
+ "--"
+ ["Next Manpage" Man-next-manpage
+ :active (> (length Man-page-list) 1)]
+ ["Previous Manpage" Man-previous-manpage
+ :active (> (length Man-page-list) 1)]
+ "--"
+ ["Man..." man t]
+ ["Kill Buffer" Man-kill t]
+ ["Quit" Man-quit t]))
map)
"Keymap for Man mode.")
@@ -665,9 +694,8 @@ a \"/\" as a local filename. The function returns either `man-db'
(with-temp-buffer
(let ((default-directory
;; Ensure that `default-directory' exists and is readable.
- (if (and (file-directory-p default-directory)
- (file-readable-p default-directory))
- default-directory
+ (if (file-accessible-directory-p default-directory)
+ default-directory
(expand-file-name "~/"))))
(ignore-errors
(call-process manual-program nil t nil "--help")))
@@ -719,7 +747,8 @@ POS defaults to `point'."
;; Record the distance traveled.
(setq distance (- column (current-column)))
(when (looking-back
- (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)"))
+ (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")
+ (line-beginning-position))
;; Skip section number backwards.
(goto-char (match-beginning 0))
(skip-chars-backward " \t"))
@@ -810,7 +839,7 @@ foo[, bar [, ...]] [other stuff] (sec) - description
foo(sec)[, bar(sec) [, ...]] [other stuff] - description
For more details and some regression tests, please see
-test/automated/man-tests.el in the emacs bzr repository."
+test/automated/man-tests.el in the emacs repository."
(goto-char (point-min))
;; See man-tests for data about which systems use which format (hopefully we
;; will be able to simplify the code if/when some of those formats aren't
@@ -902,12 +931,14 @@ test/automated/man-tests.el in the emacs bzr repository."
;;;###autoload
(defun man (man-args)
"Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package. It
-runs a Un*x command to retrieve and clean a manpage in the
+This command is the top-level command in the man package.
+It runs a Un*x command to retrieve and clean a manpage in the
background and places the results in a `Man-mode' browsing
-buffer. See variable `Man-notify-method' for what happens when
-the buffer is ready. If a buffer already exists for this man
-page, it will display immediately.
+buffer. The variable `Man-width' defines the number of columns in
+formatted manual pages. The buffer is displayed immediately.
+The variable `Man-notify-method' defines how the buffer is displayed.
+If a buffer already exists for this man page, it will be displayed
+without running the man command.
For a manpage from a particular section, use either of the
following. \"cat(1)\" is how cross-references appear and is
@@ -971,6 +1002,59 @@ names or descriptions. The pattern argument is usually an
(error "No item under point")
(man man-args)))
+(defmacro Man-start-calling (&rest body)
+ "Start the man command in `body' after setting up the environment"
+ `(let ((process-environment (copy-sequence process-environment))
+ ;; The following is so Awk script gets \n intact
+ ;; But don't prevent decoding of the outside.
+ (coding-system-for-write 'raw-text-unix)
+ ;; We must decode the output by a coding system that the
+ ;; system's locale suggests in multibyte mode.
+ (coding-system-for-read locale-coding-system)
+ ;; Avoid possible error by using a directory that always exists.
+ (default-directory
+ (if (and (file-directory-p default-directory)
+ (not (find-file-name-handler default-directory
+ 'file-directory-p)))
+ default-directory
+ "/")))
+ ;; Prevent any attempt to use display terminal fanciness.
+ (setenv "TERM" "dumb")
+ ;; In Debian Woody, at least, we get overlong lines under X
+ ;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
+ ;; a tty. man(1) says:
+ ;; MANWIDTH
+ ;; If $MANWIDTH is set, its value is used as the line
+ ;; length for which manual pages should be formatted.
+ ;; If it is not set, manual pages will be formatted
+ ;; with a line length appropriate to the current ter-
+ ;; minal (using an ioctl(2) if available, the value of
+ ;; $COLUMNS, or falling back to 80 characters if nei-
+ ;; ther is available).
+ (when (or window-system
+ (not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
+ ;; Since the page buffer is displayed beforehand,
+ ;; we can select its window and get the window/frame width.
+ (setenv "COLUMNS" (number-to-string
+ (cond
+ ((and (integerp Man-width) (> Man-width 0))
+ Man-width)
+ (Man-width
+ (if (window-live-p (get-buffer-window (current-buffer) t))
+ (with-selected-window (get-buffer-window (current-buffer) t)
+ (frame-width))
+ (frame-width)))
+ (t
+ (if (window-live-p (get-buffer-window (current-buffer) t))
+ (with-selected-window (get-buffer-window (current-buffer) t)
+ (window-width))
+ (window-width)))))))
+ ;; Since man-db 2.4.3-1, man writes plain text with no escape
+ ;; sequences when stdout is not a tty. In 2.5.0, the following
+ ;; env-var was added to allow control of this (see Debian Bug#340673).
+ (setenv "MAN_KEEP_FORMATTING" "1")
+ ,@body))
+
(defun Man-getpage-in-background (topic)
"Use TOPIC to build and fire off the manpage and cleaning command.
Return the buffer in which the manpage will appear."
@@ -983,77 +1067,73 @@ Return the buffer in which the manpage will appear."
(message "Invoking %s %s in the background" manual-program man-args)
(setq buffer (generate-new-buffer bufname))
(with-current-buffer buffer
+ (Man-notify-when-ready buffer)
(setq buffer-undo-list t)
(setq Man-original-frame (selected-frame))
- (setq Man-arguments man-args))
- (let ((process-environment (copy-sequence process-environment))
- ;; The following is so Awk script gets \n intact
- ;; But don't prevent decoding of the outside.
- (coding-system-for-write 'raw-text-unix)
- ;; We must decode the output by a coding system that the
- ;; system's locale suggests in multibyte mode.
- (coding-system-for-read
- (if (default-value 'enable-multibyte-characters)
- locale-coding-system 'raw-text-unix))
- ;; Avoid possible error by using a directory that always exists.
- (default-directory
- (if (and (file-directory-p default-directory)
- (not (find-file-name-handler default-directory
- 'file-directory-p)))
- default-directory
- "/")))
- ;; Prevent any attempt to use display terminal fanciness.
- (setenv "TERM" "dumb")
- ;; In Debian Woody, at least, we get overlong lines under X
- ;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
- ;; a tty. man(1) says:
- ;; MANWIDTH
- ;; If $MANWIDTH is set, its value is used as the line
- ;; length for which manual pages should be formatted.
- ;; If it is not set, manual pages will be formatted
- ;; with a line length appropriate to the current ter-
- ;; minal (using an ioctl(2) if available, the value of
- ;; $COLUMNS, or falling back to 80 characters if nei-
- ;; ther is available).
- (when (or window-system
- (not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
- ;; This isn't strictly correct, since we don't know how
- ;; the page will actually be displayed, but it seems
- ;; reasonable.
- (setenv "COLUMNS" (number-to-string
- (cond
- ((and (integerp Man-width) (> Man-width 0))
- Man-width)
- (Man-width (frame-width))
- ((window-width))))))
- ;; Since man-db 2.4.3-1, man writes plain text with no escape
- ;; sequences when stdout is not a tty. In 2.5.0, the following
- ;; env-var was added to allow control of this (see Debian Bug#340673).
- (setenv "MAN_KEEP_FORMATTING" "1")
- (if (fboundp 'start-process)
- (set-process-sentinel
- (start-process manual-program buffer
- (if (memq system-type '(cygwin windows-nt))
- shell-file-name
- "sh")
- shell-command-switch
- (format (Man-build-man-command) man-args))
- 'Man-bgproc-sentinel)
- (let ((exit-status
- (call-process shell-file-name nil (list buffer nil) nil
- shell-command-switch
- (format (Man-build-man-command) man-args)))
- (msg ""))
- (or (and (numberp exit-status)
- (= exit-status 0))
- (and (numberp exit-status)
- (setq msg
- (format "exited abnormally with code %d"
- exit-status)))
- (setq msg exit-status))
- (Man-bgproc-sentinel bufname msg)))))
+ (setq Man-arguments man-args)
+ (Man-mode)
+ (setq mode-line-process
+ (concat " " (propertize (if Man-fontify-manpage-flag
+ "[formatting...]"
+ "[cleaning...]")
+ 'face 'mode-line-emphasis)))
+ (Man-start-calling
+ (if (fboundp 'start-process)
+ (let ((proc (start-process
+ manual-program buffer
+ (if (memq system-type '(cygwin windows-nt))
+ shell-file-name
+ "sh")
+ shell-command-switch
+ (format (Man-build-man-command) man-args))))
+ (set-process-sentinel proc 'Man-bgproc-sentinel)
+ (set-process-filter proc 'Man-bgproc-filter))
+ (let* ((inhibit-read-only t)
+ (exit-status
+ (call-process shell-file-name nil (list buffer nil) nil
+ shell-command-switch
+ (format (Man-build-man-command) man-args)))
+ (msg ""))
+ (or (and (numberp exit-status)
+ (= exit-status 0))
+ (and (numberp exit-status)
+ (setq msg
+ (format "exited abnormally with code %d"
+ exit-status)))
+ (setq msg exit-status))
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage))
+ (Man-bgproc-sentinel bufname msg))))))
buffer))
+(defun Man-update-manpage ()
+ "Reformat current manpage by calling the man command again synchronously."
+ (interactive)
+ (when (eq Man-arguments nil)
+ ;;this shouldn't happen unless it is not in a Man buffer."
+ (error "Man-arguments not initialized"))
+ (let ((old-pos (point))
+ (text (current-word))
+ (old-size (buffer-size))
+ (inhibit-read-only t)
+ (buffer-read-only nil))
+ (erase-buffer)
+ (Man-start-calling
+ (call-process shell-file-name nil (list (current-buffer) nil) nil
+ shell-command-switch
+ (format (Man-build-man-command) Man-arguments)))
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage))
+ (goto-char old-pos)
+ ;;restore the point, not strictly right.
+ (unless (or (eq text nil) (= old-size (buffer-size)))
+ (let ((case-fold-search nil))
+ (if (> old-size (buffer-size))
+ (search-backward text nil t))
+ (search-forward text nil t)))))
+
(defun Man-notify-when-ready (man-buffer)
"Notify the user when MAN-BUFFER is ready.
See the variable `Man-notify-method' for the different notification behaviors."
@@ -1110,7 +1190,6 @@ See the variable `Man-notify-method' for the different notification behaviors."
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
(interactive)
- (message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min))
;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function
@@ -1125,7 +1204,7 @@ Same for the ANSI bold and normal escape sequences."
;; Multibyte characters exist.
(progn
(goto-char (point-min))
- (while (search-forward "__\b\b" nil t)
+ (while (and (search-forward "__\b\b" nil t) (not (eobp)))
(backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
@@ -1133,7 +1212,7 @@ Same for the ANSI bold and normal escape sequences."
(backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min))
- (while (search-forward "_\b" nil t)
+ (while (and (search-forward "_\b" nil t) (not (eobp)))
(backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min))
@@ -1165,8 +1244,7 @@ Same for the ANSI bold and normal escape sequences."
(while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0)
(match-end 0)
- 'face 'Man-overstrike)))
- (message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
+ 'face 'Man-overstrike))))
(defun Man-highlight-references (&optional xref-man-type)
"Highlight the references on mouse-over.
@@ -1228,8 +1306,6 @@ Normally skip any jobs that should have been done by the sed script,
but when called interactively, do those jobs even if the sed
script would have done them."
(interactive "p")
- (message "Please wait: cleaning up the %s man page..."
- Man-arguments)
(if (or interactive (not Man-sed-script))
(progn
(goto-char (point-min))
@@ -1251,8 +1327,35 @@ script would have done them."
;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2))
- (Man-softhyphen-to-minus)
- (message "%s man page cleaned up" Man-arguments))
+ (Man-softhyphen-to-minus))
+
+(defun Man-bgproc-filter (process string)
+ "Manpage background process filter.
+When manpage command is run asynchronously, PROCESS is the process
+object for the manpage command; when manpage command is run
+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
+ (set-process-buffer process nil)
+
+ (with-current-buffer Man-buffer
+ (let ((inhibit-read-only t)
+ (beg (marker-position (process-mark process))))
+ (save-excursion
+ (goto-char beg)
+ (insert string)
+ (save-restriction
+ (narrow-to-region
+ (save-excursion
+ (goto-char beg)
+ (line-beginning-position))
+ (point))
+ (if Man-fontify-manpage-flag
+ (Man-fontify-manpage)
+ (Man-cleanup-manpage)))
+ (set-marker (process-mark process) (point-max)))))))))
(defun Man-bgproc-sentinel (process msg)
"Manpage background process sentinel.
@@ -1271,63 +1374,75 @@ manpage command."
(set-process-buffer process nil))
(with-current-buffer Man-buffer
- (let ((case-fold-search nil))
- (goto-char (point-min))
- (cond ((or (looking-at "No \\(manual \\)*entry for")
- (looking-at "[^\n]*: nothing appropriate$"))
- (setq err-mess (buffer-substring (point)
- (progn
- (end-of-line) (point)))
- delete-buff t))
-
- ;; "-k foo", successful exit, but no output (from man-db)
- ;; ENHANCE-ME: share the check for -k with
- ;; `Man-highlight-references'. The \\s- bits here are
- ;; meant to allow for multiple options with -k among them.
- ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments)
- (eq (process-status process) 'exit)
- (= (process-exit-status process) 0)
- (= (point-min) (point-max)))
- (setq err-mess (format "%s: no matches" Man-arguments)
- delete-buff t))
-
- ((or (stringp process)
- (not (and (eq (process-status process) 'exit)
- (= (process-exit-status process) 0))))
- (or (zerop (length msg))
- (progn
- (setq err-mess
- (concat (buffer-name Man-buffer)
- ": process "
- (let ((eos (1- (length msg))))
- (if (= (aref msg eos) ?\n)
- (substring msg 0 eos) msg))))
- (goto-char (point-max))
- (insert (format "\nprocess %s" msg))))
- ))
- (if delete-buff
- (kill-buffer Man-buffer)
- (if Man-fontify-manpage-flag
- (Man-fontify-manpage)
- (Man-cleanup-manpage))
-
- (run-hooks 'Man-cooked-hook)
- (Man-mode)
-
- (if (not Man-page-list)
- (let ((args Man-arguments))
- (kill-buffer (current-buffer))
- (user-error "Can't find the %s manpage"
- (Man-page-from-arguments args)))
- (set-buffer-modified-p nil))))
- ;; Restore case-fold-search before calling
- ;; Man-notify-when-ready because it may switch buffers.
-
- (if (not delete-buff)
- (Man-notify-when-ready Man-buffer))
+ (save-excursion
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (cond ((or (looking-at "No \\(manual \\)*entry for")
+ (looking-at "[^\n]*: nothing appropriate$"))
+ (setq err-mess (buffer-substring (point)
+ (progn
+ (end-of-line) (point)))
+ delete-buff t))
+
+ ;; "-k foo", successful exit, but no output (from man-db)
+ ;; ENHANCE-ME: share the check for -k with
+ ;; `Man-highlight-references'. The \\s- bits here are
+ ;; meant to allow for multiple options with -k among them.
+ ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments)
+ (eq (process-status process) 'exit)
+ (= (process-exit-status process) 0)
+ (= (point-min) (point-max)))
+ (setq err-mess (format "%s: no matches" Man-arguments)
+ delete-buff t))
+
+ ((or (stringp process)
+ (not (and (eq (process-status process) 'exit)
+ (= (process-exit-status process) 0))))
+ (or (zerop (length msg))
+ (progn
+ (setq err-mess
+ (concat (buffer-name Man-buffer)
+ ": process "
+ (let ((eos (1- (length msg))))
+ (if (= (aref msg eos) ?\n)
+ (substring msg 0 eos) msg))))
+ (goto-char (point-max))
+ (insert (format "\nprocess %s" msg))))
+ ))
+ (if delete-buff
+ (if (window-live-p (get-buffer-window Man-buffer t))
+ (quit-restore-window
+ (get-buffer-window Man-buffer t) 'kill)
+ (kill-buffer Man-buffer))
+
+ (run-hooks 'Man-cooked-hook)
+
+ (Man-build-page-list)
+ (Man-strip-page-headers)
+ (Man-unindent)
+ (Man-goto-page 1 t)
+
+ (if (not Man-page-list)
+ (let ((args Man-arguments))
+ (if (window-live-p (get-buffer-window (current-buffer) t))
+ (quit-restore-window
+ (get-buffer-window (current-buffer) t) 'kill)
+ (kill-buffer (current-buffer)))
+ (message "Can't find the %s manpage"
+ (Man-page-from-arguments args)))
+
+ (if Man-fontify-manpage-flag
+ (message "%s man page formatted"
+ (Man-page-from-arguments Man-arguments))
+ (message "%s man page cleaned up"
+ (Man-page-from-arguments Man-arguments)))
+ (unless (and (processp process)
+ (not (eq (process-status process) 'exit)))
+ (setq mode-line-process nil))
+ (set-buffer-modified-p nil)))))
(if err-mess
- (error "%s" err-mess))
+ (message "%s" err-mess))
))))
(defun Man-page-from-arguments (args)
@@ -1350,7 +1465,7 @@ manpage command."
(put 'Man-mode 'mode-class 'special)
-(defun Man-mode ()
+(define-derived-mode Man-mode fundamental-mode "Man"
"A mode for browsing Un*x manual pages.
The following man commands are available in the buffer. Try
@@ -1371,7 +1486,7 @@ The following man commands are available in the buffer. Try
The following variables may be of some use. Try
\"\\[describe-variable] <variable-name> RET\" for more information:
-`Man-notify-method' What happens when manpage formatting is done.
+`Man-notify-method' What happens when manpage is ready to display.
`Man-downcase-section-letters-flag' Force section letters to lower case.
`Man-circular-pages-flag' Treat multiple manpage list as circular.
`Man-section-translations-alist' List of section numbers and their Un*x equiv.
@@ -1387,11 +1502,7 @@ The following variables may be of some use. Try
The following key bindings are currently in effect in the buffer:
\\{Man-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'Man-mode
- mode-name "Man"
- buffer-auto-save-file-name nil
+ (setq buffer-auto-save-file-name nil
mode-line-buffer-identification
(list (default-value 'mode-line-buffer-identification)
" {" 'Man-page-mode-string "}")
@@ -1399,18 +1510,12 @@ The following key bindings are currently in effect in the buffer:
buffer-read-only t)
(buffer-disable-undo)
(auto-fill-mode -1)
- (use-local-map Man-mode-map)
- (set-syntax-table man-mode-syntax-table)
(setq imenu-generic-expression (list (list nil Man-heading-regexp 0)))
+ (imenu-add-to-menubar man-imenu-title)
(set (make-local-variable 'outline-regexp) Man-heading-regexp)
(set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'bookmark-make-record-function)
- 'Man-bookmark-make-record)
- (Man-build-page-list)
- (Man-strip-page-headers)
- (Man-unindent)
- (Man-goto-page 1 t)
- (run-mode-hooks 'Man-mode-hook))
+ 'Man-bookmark-make-record))
(defsubst Man-build-section-alist ()
"Build the list of manpage sections."
@@ -1464,7 +1569,6 @@ The following key bindings are currently in effect in the buffer:
(page-end (point-max))
(header ""))
(goto-char page-start)
- ;; (switch-to-buffer (current-buffer))(debug)
(while (not (eobp))
(setq header
(if (looking-at Man-page-header-regexp)
diff --git a/lisp/master.el b/lisp/master.el
index 4a536ca5cda..b309cc40158 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -1,6 +1,6 @@
;;; master.el --- make a buffer the master over another buffer
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Alex Schroeder <alex@gnu.org>
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index cf20c6b118e..be11b2d61ee 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -1,6 +1,6 @@
;;; mb-depth.el --- Indicate minibuffer-depth in prompt
;;
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
diff --git a/lisp/md4.el b/lisp/md4.el
index 9b7bd839a0d..372d33d2895 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -1,6 +1,6 @@
;;; md4.el --- MD4 Message Digest Algorithm.
-;; Copyright (C) 2001, 2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004, 2007-2015 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: MD4
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 34cfc68295e..42f48c784e1 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1,9 +1,9 @@
;;; menu-bar.el --- define a default menu bar
-;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2015 Free Software Foundation, Inc.
-;; Author: RMS
-;; Maintainer: FSF
+;; Author: Richard M. Stallman
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal, mouse
;; Package: emacs
@@ -40,23 +40,10 @@
(or (lookup-key global-map [menu-bar])
(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
-(if (not (featurep 'ns))
- ;; Force Help item to come last, after the major mode's own items.
- ;; The symbol used to be called `help', but that gets confused with the
- ;; help key.
- (setq menu-bar-final-items '(help-menu))
- (if (eq system-type 'darwin)
- (setq menu-bar-final-items '(buffer services help-menu))
- (setq menu-bar-final-items '(buffer services hide-app quit))
- ;; Add standard top-level items to GNUstep menu.
- (bindings--define-key global-map [menu-bar quit]
- '(menu-item "Quit" save-buffers-kill-emacs
- :help "Save unsaved buffers, then exit"))
- (bindings--define-key global-map [menu-bar hide-app]
- '(menu-item "Hide" ns-do-hide-emacs
- :help "Hide Emacs")))
- (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win.
- (cons "Services" (make-sparse-keymap "Services"))))
+;; Force Help item to come last, after the major mode's own items.
+;; The symbol used to be called `help', but that gets confused with the
+;; help key.
+(setq menu-bar-final-items '(help-menu))
;; This definition is just to show what this looks like.
;; It gets modified in place when menu-bar-update-buffers is called.
@@ -162,8 +149,11 @@
:help "Recover edits from a crashed session"))
(bindings--define-key menu [revert-buffer]
'(menu-item "Revert Buffer" revert-buffer
- :enable (or revert-buffer-function
- revert-buffer-insert-file-contents-function
+ :enable (or (not (eq revert-buffer-function
+ 'revert-buffer--default))
+ (not (eq
+ revert-buffer-insert-file-contents-function
+ 'revert-buffer-insert-file-contents--default-function))
(and buffer-file-number
(or (buffer-modified-p)
(not (verify-visited-file-modtime
@@ -383,35 +373,31 @@
(bindings--define-key menu [set-tags-name]
'(menu-item "Set Tags File Name..." visit-tags-table
- :help "Tell Tags commands which tag table file to use"))
+ :visible (menu-bar-goto-uses-etags-p)
+ :help "Tell navigation commands which tag table file to use"))
(bindings--define-key menu [separator-tag-file]
- menu-bar-separator)
+ '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p)))
+
+ (bindings--define-key menu [xref-pop]
+ '(menu-item "Back" xref-pop-marker-stack
+ :visible (and (featurep 'xref)
+ (not (xref-marker-stack-empty-p)))
+ :help "Back to the position of the last search"))
- (bindings--define-key menu [apropos-tags]
- '(menu-item "Tags Apropos..." tags-apropos
+ (bindings--define-key menu [xref-apropos]
+ '(menu-item "Find Apropos..." xref-find-apropos
:help "Find function/variables whose names match regexp"))
- (bindings--define-key menu [next-tag-otherw]
- '(menu-item "Next Tag in Other Window"
- menu-bar-next-tag-other-window
- :enable (and (boundp 'tags-location-ring)
- (not (ring-empty-p tags-location-ring)))
- :help "Find next function/variable matching last tag name in another window"))
-
- (bindings--define-key menu [next-tag]
- '(menu-item "Find Next Tag"
- menu-bar-next-tag
- :enable (and (boundp 'tags-location-ring)
- (not (ring-empty-p tags-location-ring)))
- :help "Find next function/variable matching last tag name"))
- (bindings--define-key menu [find-tag-otherw]
- '(menu-item "Find Tag in Other Window..." find-tag-other-window
+
+ (bindings--define-key menu [xref-find-otherw]
+ '(menu-item "Find Definition in Other Window..."
+ xref-find-definitions-other-window
:help "Find function/variable definition in another window"))
- (bindings--define-key menu [find-tag]
- '(menu-item "Find Tag..." find-tag
+ (bindings--define-key menu [xref-find-def]
+ '(menu-item "Find Definition..." xref-find-definitions
:help "Find definition of function or variable"))
- (bindings--define-key menu [separator-tags]
+ (bindings--define-key menu [separator-xref]
menu-bar-separator)
(bindings--define-key menu [end-of-buf]
@@ -426,6 +412,9 @@
:help "Read a line number and go to that line"))
menu))
+(defun menu-bar-goto-uses-etags-p ()
+ (or (not (boundp 'xref-find-function))
+ (eq xref-find-function 'etags-xref-find)))
(defvar yank-menu (cons (purecopy "Select Yank") nil))
(fset 'yank-menu (cons 'keymap yank-menu))
@@ -480,21 +469,20 @@
[paste-from-menu])
;; ns-win.el said: Change text to be more consistent with
;; surrounding menu items `paste', etc."
- `(menu-item ,(if (featurep 'ns) "Select and Paste"
- "Paste from Kill Menu") yank-menu
+ `(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
+ yank-menu
:enable (and (cdr yank-menu) (not buffer-read-only))
:help "Choose a string from the kill ring and paste it"))
(bindings--define-key menu [paste]
- '(menu-item "Paste" yank
- :enable (and (or
- ;; Emacs compiled --without-x (or --with-ns)
- ;; doesn't have x-selection-exists-p.
- (and (fboundp 'x-selection-exists-p)
- (x-selection-exists-p 'CLIPBOARD))
- (if (featurep 'ns) ; like paste-from-menu
- (cdr yank-menu)
- kill-ring))
- (not buffer-read-only))
+ `(menu-item "Paste" yank
+ :enable (funcall
+ ',(lambda ()
+ (and (or
+ (gui-backend-selection-exists-p 'CLIPBOARD)
+ (if (featurep 'ns) ; like paste-from-menu
+ (cdr yank-menu)
+ kill-ring))
+ (not buffer-read-only))))
:help "Paste (yank) text most recently cut/copied"))
(bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
@@ -527,16 +515,6 @@
menu))
-(defun menu-bar-next-tag-other-window ()
- "Find the next definition of the tag already specified."
- (interactive)
- (find-tag-other-window nil t))
-
-(defun menu-bar-next-tag ()
- "Find the next definition of the tag already specified."
- (interactive)
- (find-tag nil t))
-
(define-obsolete-function-alias
'menu-bar-kill-ring-save 'kill-ring-save "24.1")
@@ -547,28 +525,30 @@
'(and mark-active (not buffer-read-only)))
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
- '(and (or (not (fboundp 'x-selection-exists-p))
- (x-selection-exists-p)
- (x-selection-exists-p 'CLIPBOARD))
- (not buffer-read-only)))
+ `(funcall ',(lambda ()
+ (and (or (gui-backend-selection-exists-p 'PRIMARY)
+ (gui-backend-selection-exists-p 'CLIPBOARD))
+ (not buffer-read-only)))))
+
+(defvar gui-select-enable-clipboard)
(defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
- (let ((x-select-enable-clipboard t))
+ (let ((gui-select-enable-clipboard t))
(yank)))
-(defun clipboard-kill-ring-save (beg end)
- "Copy region to kill ring, and save in the X clipboard."
- (interactive "r")
- (let ((x-select-enable-clipboard t))
- (kill-ring-save beg end)))
+(defun clipboard-kill-ring-save (beg end &optional region)
+ "Copy region to kill ring, and save in the GUI's clipboard."
+ (interactive "r\np")
+ (let ((gui-select-enable-clipboard t))
+ (kill-ring-save beg end region)))
-(defun clipboard-kill-region (beg end)
- "Kill the region, and save it in the X clipboard."
- (interactive "r")
- (let ((x-select-enable-clipboard t))
- (kill-region beg end)))
+(defun clipboard-kill-region (beg end &optional region)
+ "Kill the region, and save it in the GUI's clipboard."
+ (interactive "r\np")
+ (let ((gui-select-enable-clipboard t))
+ (kill-region beg end region)))
(defun menu-bar-enable-clipboard ()
"Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
@@ -672,7 +652,9 @@ by \"Save Options\" in Custom buffers.")
;; Function for setting/saving default font.
(defun menu-set-font ()
- "Interactively select a font and make it the default."
+ "Interactively select a font and make it the default on all frames.
+
+The selected font will be the default on both the existing and future frames."
(interactive)
(set-frame-font (if (fboundp 'x-select-font)
(x-select-font)
@@ -703,7 +685,7 @@ by \"Save Options\" in Custom buffers.")
(dolist (elt '(scroll-bar-mode
debug-on-quit debug-on-error
;; Somehow this works, when tool-bar and menu-bar don't.
- tooltip-mode
+ tooltip-mode window-divider-mode
save-place uniquify-buffer-name-style fringe-mode
indicate-empty-lines indicate-buffer-boundaries
case-fold-search font-use-system-font
@@ -731,6 +713,95 @@ by \"Save Options\" in Custom buffers.")
;; The "Show/Hide" submenu of menu "Options"
+(defun menu-bar-window-divider-customize ()
+ "Show customization buffer for `window-divider' group."
+ (interactive)
+ (customize-group 'window-divider))
+
+(defun menu-bar-bottom-and-right-window-divider ()
+ "Display dividers on the bottom and right of each window."
+ (interactive)
+ (customize-set-variable 'window-divider-default-places t)
+ (window-divider-mode 1))
+
+(defun menu-bar-right-window-divider ()
+ "Display dividers only on the right of each window."
+ (interactive)
+ (customize-set-variable 'window-divider-default-places 'right-only)
+ (window-divider-mode 1))
+
+(defun menu-bar-bottom-window-divider ()
+ "Display dividers only at the bottom of each window."
+ (interactive)
+ (customize-set-variable 'window-divider-default-places 'bottom-only)
+ (window-divider-mode 1))
+
+(defun menu-bar-no-window-divider ()
+ "Do not display window dividers."
+ (interactive)
+ (window-divider-mode -1))
+
+;; For the radio buttons below we check whether the respective dividers
+;; are displayed on the selected frame. This is not fully congruent
+;; with `window-divider-mode' but makes the menu entries work also when
+;; dividers are displayed by manipulating frame parameters directly.
+(defvar menu-bar-showhide-window-divider-menu
+ (let ((menu (make-sparse-keymap "Window Divider")))
+ (bindings--define-key menu [customize]
+ '(menu-item "Customize" menu-bar-window-divider-customize
+ :help "Customize window dividers"
+ :visible (memq (window-system) '(x w32))))
+
+ (bindings--define-key menu [bottom-and-right]
+ '(menu-item "Bottom and Right"
+ menu-bar-bottom-and-right-window-divider
+ :help "Display window divider on the bottom and right of each window"
+ :visible (memq (window-system) '(x w32))
+ :button (:radio
+ . (and (window-divider-width-valid-p
+ (cdr (assq 'bottom-divider-width
+ (frame-parameters))))
+ (window-divider-width-valid-p
+ (cdr (assq 'right-divider-width
+ (frame-parameters))))))))
+ (bindings--define-key menu [right-only]
+ '(menu-item "Right Only"
+ menu-bar-right-window-divider
+ :help "Display window divider on the right of each window only"
+ :visible (memq (window-system) '(x w32))
+ :button (:radio
+ . (and (not (window-divider-width-valid-p
+ (cdr (assq 'bottom-divider-width
+ (frame-parameters)))))
+ (window-divider-width-valid-p
+ (cdr (assq 'right-divider-width
+ (frame-parameters))))))))
+ (bindings--define-key menu [bottom-only]
+ '(menu-item "Bottom Only"
+ menu-bar-bottom-window-divider
+ :help "Display window divider on the bottom of each window only"
+ :visible (memq (window-system) '(x w32))
+ :button (:radio
+ . (and (window-divider-width-valid-p
+ (cdr (assq 'bottom-divider-width
+ (frame-parameters))))
+ (not (window-divider-width-valid-p
+ (cdr (assq 'right-divider-width
+ (frame-parameters)))))))))
+ (bindings--define-key menu [no-divider]
+ '(menu-item "None"
+ menu-bar-no-window-divider
+ :help "Do not display window dividers"
+ :visible (memq (window-system) '(x w32))
+ :button (:radio
+ . (and (not (window-divider-width-valid-p
+ (cdr (assq 'bottom-divider-width
+ (frame-parameters)))))
+ (not (window-divider-width-valid-p
+ (cdr (assq 'right-divider-width
+ (frame-parameters)))))))))
+ menu))
+
(defun menu-bar-showhide-fringe-ind-customize ()
"Show customization buffer for `indicate-buffer-boundaries'."
(interactive)
@@ -897,8 +968,33 @@ by \"Save Options\" in Custom buffers.")
(interactive)
(customize-set-variable 'scroll-bar-mode nil))
+(defun menu-bar-horizontal-scroll-bar ()
+ "Display horizontal scroll bars on each window."
+ (interactive)
+ (customize-set-variable 'horizontal-scroll-bar-mode t))
+
+(defun menu-bar-no-horizontal-scroll-bar ()
+ "Turn off horizontal scroll bars."
+ (interactive)
+ (customize-set-variable 'horizontal-scroll-bar-mode nil))
+
(defvar menu-bar-showhide-scroll-bar-menu
(let ((menu (make-sparse-keymap "Scroll-bar")))
+ (bindings--define-key menu [horizontal]
+ '(menu-item "Horizontal"
+ menu-bar-horizontal-scroll-bar
+ :help "Horizontal scroll bar"
+ :visible (horizontal-scroll-bars-available-p)
+ :button (:radio . (cdr (assq 'horizontal-scroll-bars
+ (frame-parameters))))))
+
+ (bindings--define-key menu [none-horizontal]
+ '(menu-item "None-horizontal"
+ menu-bar-no-horizontal-scroll-bar
+ :help "Turn off horizontal scroll bars"
+ :visible (horizontal-scroll-bars-available-p)
+ :button (:radio . (not (cdr (assq 'horizontal-scroll-bars
+ (frame-parameters)))))))
(bindings--define-key menu [right]
'(menu-item "On the Right"
@@ -906,7 +1002,8 @@ by \"Save Options\" in Custom buffers.")
:help "Scroll-bar on the right side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
- (frame-parameters))) 'right))))
+ (frame-parameters)))
+ 'right))))
(bindings--define-key menu [left]
'(menu-item "On the Left"
@@ -914,7 +1011,8 @@ by \"Save Options\" in Custom buffers.")
:help "Scroll-bar on the left side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
- (frame-parameters))) 'left))))
+ (frame-parameters)))
+ 'left))))
(bindings--define-key menu [none]
'(menu-item "None"
@@ -922,7 +1020,8 @@ by \"Save Options\" in Custom buffers.")
:help "Turn off scroll-bar"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
- (frame-parameters))) nil))))
+ (frame-parameters)))
+ nil))))
menu))
(defun menu-bar-frame-for-menubar ()
@@ -932,7 +1031,7 @@ by \"Save Options\" in Custom buffers.")
(selected-frame)))
(defun menu-bar-positive-p (val)
- "Return non-nil iff VAL is a positive number."
+ "Return non-nil if VAL is a positive number."
(and (numberp val)
(> val 0)))
@@ -1064,6 +1163,10 @@ mail status in mode line"))
(frame-visible-p
(symbol-value 'speedbar-frame))))))
+ (bindings--define-key menu [showhide-window-divider]
+ `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu
+ :visible (memq (window-system) '(x w32))))
+
(bindings--define-key menu [showhide-fringe]
`(menu-item "Fringe" ,menu-bar-showhide-fringe-menu
:visible (display-graphic-p)))
@@ -1102,15 +1205,6 @@ mail status in mode line"))
'tool-bar-lines))))))
menu))
-(defun menu-bar-text-mode-auto-fill ()
- (interactive)
- (toggle-text-mode-auto-fill)
- ;; This is somewhat questionable, as `text-mode-hook'
- ;; might have changed outside customize.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
- (customize-mark-as-set 'text-mode-hook))
-
-
(defvar menu-bar-line-wrapping-menu
(let ((menu (make-sparse-keymap "Line Wrapping")))
@@ -1245,10 +1339,9 @@ mail status in mode line"))
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
"Uniquify buffer names by adding parent directory names"
- (require 'uniquify)
(setq uniquify-buffer-name-style
(if (not uniquify-buffer-name-style)
- 'forward))))
+ 'post-forward-angle-brackets))))
(bindings--define-key menu [edit-options-separator]
menu-bar-separator)
@@ -1275,15 +1368,6 @@ mail status in mode line"))
"Case-Insensitive Search %s"
"Ignore letter-case in search commands"))
- (bindings--define-key menu [auto-fill-mode]
- '(menu-item
- "Auto Fill in Text Modes"
- menu-bar-text-mode-auto-fill
- :help "Automatically fill text while typing (Auto Fill mode)"
- :button (:toggle . (if (listp text-mode-hook)
- (member 'turn-on-auto-fill text-mode-hook)
- (eq 'turn-on-auto-fill text-mode-hook)))))
-
(bindings--define-key menu [line-wrapping]
`(menu-item "Line Wrapping in This Buffer"
,menu-bar-line-wrapping-menu))
@@ -1331,9 +1415,6 @@ mail status in mode line"))
(bindings--define-key menu [life]
'(menu-item "Life" life
:help "Watch how John Conway's cellular automaton evolves"))
- (bindings--define-key menu [land]
- '(menu-item "Landmark" landmark
- :help "Watch a neural-network robot learn landmarks"))
(bindings--define-key menu [hanoi]
'(menu-item "Towers of Hanoi" hanoi
:help "Watch Towers-of-Hanoi puzzle solved by Emacs"))
@@ -1450,6 +1531,8 @@ mail status in mode line"))
(bindings--define-key menu [separator-net]
menu-bar-separator)
+ (bindings--define-key menu [browse-web]
+ '(menu-item "Browse the Web..." browse-web))
(bindings--define-key menu [directory-search]
'(menu-item "Directory Search" eudc-tools-menu))
(bindings--define-key menu [compose-mail]
@@ -1665,14 +1748,6 @@ key, a click, or a menu-item"))
:help "Read the Introduction to Emacs Lisp Programming"))
menu))
-(defun menu-bar-help-extra-packages ()
- "Display help about some additional packages available for Emacs."
- (interactive)
- (let (enable-local-variables)
- (view-file (expand-file-name "MORE.STUFF"
- data-directory))
- (goto-address-mode 1)))
-
(defun help-with-tutorial-spec-language ()
"Use the Emacs tutorial, specifying which language you want."
(interactive)
@@ -1700,8 +1775,8 @@ key, a click, or a menu-item"))
(bindings--define-key menu [sep2]
menu-bar-separator)
(bindings--define-key menu [external-packages]
- '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages
- :help "Lisp packages distributed separately for use in Emacs"))
+ '(menu-item "Finding Extra Packages" view-external-packages
+ :help "How to get more Lisp packages for use in Emacs"))
(bindings--define-key menu [find-emacs-packages]
'(menu-item "Search Built-in Packages" finder-by-keyword
:help "Find built-in packages and features by keyword"))
@@ -1761,15 +1836,8 @@ key, a click, or a menu-item"))
(cons "Edit" menu-bar-edit-menu))
(bindings--define-key global-map [menu-bar file]
(cons "File" menu-bar-file-menu))
-
-;; Put "Help" menu at the end, or Info at the front.
-;; If running under GNUstep, "Help" is moved and renamed "Info" (see below).
-(if (and (featurep 'ns)
- (not (eq system-type 'darwin)))
- (bindings--define-key global-map [menu-bar help-menu]
- (cons "Info" menu-bar-help-menu))
- (define-key-after global-map [menu-bar help-menu]
- (cons (purecopy "Help") menu-bar-help-menu)))
+(bindings--define-key global-map [menu-bar help-menu]
+ (cons (purecopy "Help") menu-bar-help-menu))
(defun menu-bar-menu-frame-live-and-visible-p ()
"Return non-nil if the menu frame is alive and visible.
@@ -1779,12 +1847,14 @@ The menu frame is the frame for which we are updating the menu."
(frame-visible-p menu-frame))))
(defun menu-bar-non-minibuffer-window-p ()
- "Return non-nil if selected window of the menu frame is not a minibuf window.
-
-See the documentation of `menu-bar-menu-frame-live-and-visible-p'
-for the definition of the menu frame."
+ "Return non-nil if the menu frame's selected window is no minibuffer window.
+Return nil if the menu frame is dead or its selected window is a
+minibuffer window. The menu frame is the frame for which we are
+updating the menu."
(let ((menu-frame (or menu-updating-frame (selected-frame))))
- (not (window-minibuffer-p (frame-selected-window menu-frame)))))
+ (and (frame-live-p menu-frame)
+ (not (window-minibuffer-p
+ (frame-selected-window menu-frame))))))
(defun kill-this-buffer () ; for the menu bar
"Kill the current buffer.
@@ -1959,6 +2029,19 @@ Buffers menu is regenerated."
"Function to select the buffer chosen from the `Buffers' menu-bar menu.
It must accept a buffer as its only required argument.")
+(defun menu-bar-buffer-vector (alist)
+ ;; turn ((name . buffer) ...) into a menu
+ (let ((buffers-vec (make-vector (length alist) nil))
+ (i (length alist)))
+ (dolist (pair alist)
+ (setq i (1- i))
+ (aset buffers-vec i
+ (cons (car pair)
+ `(lambda ()
+ (interactive)
+ (funcall menu-bar-select-buffer-function ,(cdr pair))))))
+ buffers-vec))
+
(defun menu-bar-update-buffers (&optional force)
;; If user discards the Buffers item, play along.
(and (lookup-key (current-global-map) [menu-bar buffer])
@@ -1966,20 +2049,20 @@ It must accept a buffer as its only required argument.")
(let ((buffers (buffer-list))
(frames (frame-list))
buffers-menu)
- ;; If requested, list only the N most recently selected buffers.
- (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- (if (> (length buffers) buffers-menu-max-size)
- (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
;; Make the menu of buffers proper.
(setq buffers-menu
- (let (alist)
+ (let ((i 0)
+ (limit (if (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1))
+ buffers-menu-max-size most-positive-fixnum))
+ alist)
;; Put into each element of buffer-list
;; the name for actual display,
;; perhaps truncated in the middle.
- (dolist (buf buffers)
- (let ((name (buffer-name buf)))
+ (while buffers
+ (let* ((buf (pop buffers))
+ (name (buffer-name buf)))
(unless (eq ?\s (aref name 0))
(push (menu-bar-update-buffers-1
(cons buf
@@ -1993,19 +2076,12 @@ It must accept a buffer as its only required argument.")
name (- (/ buffers-menu-buffer-name-length 2))))
name)
))
- alist))))
- ;; Now make the actual list of items.
- (let ((buffers-vec (make-vector (length alist) nil))
- (i (length alist)))
- (dolist (pair alist)
- (setq i (1- i))
- (aset buffers-vec i
- (nconc (list (car pair)
- (cons nil nil))
- `(lambda ()
- (interactive)
- (funcall menu-bar-select-buffer-function ,(cdr pair))))))
- (list buffers-vec))))
+ alist)
+ ;; If requested, list only the N most recently
+ ;; selected buffers.
+ (when (= limit (setq i (1+ i)))
+ (setq buffers nil)))))
+ (list (menu-bar-buffer-vector alist))))
;; Make a Frames menu if we have more than one frame.
(when (cdr frames)
@@ -2016,10 +2092,8 @@ It must accept a buffer as its only required argument.")
(i 0))
(dolist (frame frames)
(aset frames-vec i
- (nconc
- (list
- (frame-parameter frame 'name)
- (cons nil nil))
+ (cons
+ (frame-parameter frame 'name)
`(lambda ()
(interactive) (menu-bar-select-frame ,frame))))
(setq i (1+ i)))
@@ -2064,7 +2138,7 @@ It must accept a buffer as its only required argument.")
;; We used to "(define-key (current-global-map) [menu-bar buffer]"
;; but that did not do the right thing when the [menu-bar buffer]
;; entry above had been moved (e.g. to a parent keymap).
- (setcdr global-buffers-menu-map (cons "Select Buffer" buffers-menu)))))
+ (setcdr global-buffers-menu-map (cons "Buffers" buffers-menu)))))
(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
@@ -2182,13 +2256,129 @@ See `menu-bar-mode' for more information."
(declare-function x-menu-bar-open "term/x-win" (&optional frame))
(declare-function w32-menu-bar-open "term/w32-win" (&optional frame))
+(defun lookup-key-ignore-too-long (map key)
+ "Call `lookup-key' and convert numeric values to nil."
+ (let ((binding (lookup-key map key)))
+ (if (numberp binding) ; `too long'
+ nil
+ binding)))
+
+(defun popup-menu (menu &optional position prefix from-menu-bar)
+ "Popup the given menu and call the selected option.
+MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
+`x-popup-menu'.
+The menu is shown at the place where POSITION specifies.
+For the form of POSITION, see `popup-menu-normalize-position'.
+PREFIX is the prefix argument (if any) to pass to the command.
+FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus."
+ (let* ((map (cond
+ ((keymapp menu) menu)
+ ((and (listp menu) (keymapp (car menu))) menu)
+ (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
+ (filter (when (symbolp map)
+ (plist-get (get map 'menu-prop) :filter))))
+ (if filter (funcall filter (symbol-function map)) map)))))
+ (frame (selected-frame))
+ event cmd)
+ (if from-menu-bar
+ (let* ((xy (posn-x-y position))
+ (menu-symbol (menu-bar-menu-at-x-y (car xy) (cdr xy))))
+ (setq position (list menu-symbol (list frame '(menu-bar)
+ xy 0))))
+ (setq position (popup-menu-normalize-position position)))
+ ;; The looping behavior was taken from lmenu's popup-menu-popup
+ (while (and map (setq event
+ ;; map could be a prefix key, in which case
+ ;; we need to get its function cell
+ ;; definition.
+ (x-popup-menu position (indirect-function map))))
+ ;; Strangely x-popup-menu returns a list.
+ ;; mouse-major-mode-menu was using a weird:
+ ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
+ (setq cmd
+ (cond
+ ((and from-menu-bar
+ (consp event)
+ (numberp (car event))
+ (numberp (cdr event)))
+ (let ((x (car event))
+ (y (cdr event))
+ menu-symbol)
+ (setq menu-symbol (menu-bar-menu-at-x-y x y))
+ (setq position (list menu-symbol (list frame '(menu-bar)
+ event 0)))
+ (setq map
+ (key-binding (vector 'menu-bar menu-symbol)))))
+ ((and (not (keymapp map)) (listp map))
+ ;; We were given a list of keymaps. Search them all
+ ;; in sequence until a first binding is found.
+ (let ((mouse-click (apply 'vector event))
+ binding)
+ (while (and map (null binding))
+ (setq binding (lookup-key-ignore-too-long (car map) mouse-click))
+ (setq map (cdr map)))
+ binding))
+ (t
+ ;; We were given a single keymap.
+ (lookup-key map (apply 'vector event)))))
+ ;; Clear out echoing, which perhaps shows a prefix arg.
+ (message "")
+ ;; Maybe try again but with the submap.
+ (setq map (if (keymapp cmd) cmd)))
+ ;; If the user did not cancel by refusing to select,
+ ;; and if the result is a command, run it.
+ (when (and (null map) (commandp cmd))
+ (setq prefix-arg prefix)
+ ;; `setup-specified-language-environment', for instance,
+ ;; expects this to be set from a menu keymap.
+ (setq last-command-event (car (last event)))
+ ;; mouse-major-mode-menu was using `command-execute' instead.
+ (call-interactively cmd))))
+
+(defun popup-menu-normalize-position (position)
+ "Convert the POSITION to the form which `popup-menu' expects internally.
+POSITION can be an event, a posn- value, a value having the
+form ((XOFFSET YOFFSET) WINDOW), or nil.
+If nil, the current mouse position is used, or nil if there is no mouse."
+ (pcase position
+ ;; nil -> mouse cursor position
+ (`nil
+ (let ((mp (mouse-pixel-position)))
+ (list (list (cadr mp) (cddr mp)) (car mp))))
+ ;; Value returned from `event-end' or `posn-at-point'.
+ ((pred posnp)
+ (let ((xy (posn-x-y position)))
+ (list (list (car xy) (cdr xy))
+ (posn-window position))))
+ ;; Event.
+ ((pred eventp)
+ (popup-menu-normalize-position (event-end position)))
+ (_ position)))
+
+(defcustom tty-menu-open-use-tmm nil
+ "If non-nil, \\[menu-bar-open] on a TTY will invoke `tmm-menubar'.
+
+If nil, \\[menu-bar-open] will drop down the menu corresponding to the
+first (leftmost) menu-bar item; you can select other items by typing
+\\[forward-char], \\[backward-char], \\[right-char] and \\[left-char]."
+ :type '(choice (const :tag "F10 drops down TTY menus" nil)
+ (const :tag "F10 invokes tmm-menubar" t))
+ :group 'display
+ :version "24.4")
+
+(defvar tty-menu--initial-menu-x 1
+ "X coordinate of the first menu-bar menu dropped by F10.
+
+This is meant to be used only for debugging TTY menus.")
+
(defun menu-bar-open (&optional frame)
"Start key navigation of the menu bar in FRAME.
This function decides which method to use to access the menu
depending on FRAME's terminal device. On X displays, it calls
-`x-menu-bar-open'; on Windows, `w32-menu-bar-open' otherwise it
-calls `tmm-menubar'.
+`x-menu-bar-open'; on Windows, `w32-menu-bar-open'; otherwise it
+calls either `popup-menu' or `tmm-menubar' depending on whether
+`tty-menu-open-use-tmm' is nil or not.
If FRAME is nil or not given, use the selected frame."
(interactive)
@@ -2196,11 +2386,118 @@ If FRAME is nil or not given, use the selected frame."
(cond
((eq type 'x) (x-menu-bar-open frame))
((eq type 'w32) (w32-menu-bar-open frame))
+ ((and (null tty-menu-open-use-tmm)
+ (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))))
+ ;; Make sure the menu bar is up to date. One situation where
+ ;; this is important is when this function is invoked by name
+ ;; via M-x, in which case the menu bar includes the "Minibuf"
+ ;; menu item that should be removed when we exit the minibuffer.
+ (force-mode-line-update)
+ (redisplay)
+ (let* ((x tty-menu--initial-menu-x)
+ (menu (menu-bar-menu-at-x-y x 0 frame)))
+ (popup-menu (or
+ (lookup-key-ignore-too-long
+ global-map (vector 'menu-bar menu))
+ (lookup-key-ignore-too-long
+ (current-local-map) (vector 'menu-bar menu))
+ (cdar (minor-mode-key-binding (vector 'menu-bar menu)))
+ (mouse-menu-bar-map))
+ (posn-at-x-y x 0 nil t) nil t)))
(t (with-selected-frame (or frame (selected-frame))
(tmm-menubar))))))
(global-set-key [f10] 'menu-bar-open)
+(defun buffer-menu-open ()
+ "Start key navigation of the buffer menu.
+This is the keyboard interface to \\[mouse-buffer-menu]."
+ (interactive)
+ (popup-menu (mouse-buffer-menu-keymap)
+ (posn-at-x-y 0 0 nil t)))
+
+(global-set-key [C-f10] 'buffer-menu-open)
+
+(defun mouse-buffer-menu-keymap ()
+ (let* ((menu (mouse-buffer-menu-map))
+ (km (make-sparse-keymap (pop menu))))
+ (dolist (item (nreverse menu))
+ (let* ((name (pop item)))
+ (define-key km (vector (intern name))
+ (list name 'keymap name
+ (menu-bar-buffer-vector item)))))
+ km))
+
+(defvar tty-menu-navigation-map
+ (let ((map (make-sparse-keymap)))
+ ;; The next line is disabled because it breaks interpretation of
+ ;; escape sequences, produced by TTY arrow keys, as tty-menu-*
+ ;; commands. Instead, we explicitly bind some keys to
+ ;; tty-menu-exit.
+ ;;(define-key map [t] 'tty-menu-exit)
+
+ ;; The tty-menu-* are just symbols interpreted by term.c, they are
+ ;; not real commands.
+ (dolist (bind '((keyboard-quit . tty-menu-exit)
+ (keyboard-escape-quit . tty-menu-exit)
+ ;; The following two will need to be revised if we ever
+ ;; support a right-to-left menu bar.
+ (forward-char . tty-menu-next-menu)
+ (backward-char . tty-menu-prev-menu)
+ (right-char . tty-menu-next-menu)
+ (left-char . tty-menu-prev-menu)
+ (next-line . tty-menu-next-item)
+ (previous-line . tty-menu-prev-item)
+ (newline . tty-menu-select)
+ (newline-and-indent . tty-menu-select)
+ (menu-bar-open . tty-menu-exit)))
+ (substitute-key-definition (car bind) (cdr bind)
+ map (current-global-map)))
+
+ ;; The bindings of menu-bar items are so that clicking on the menu
+ ;; bar when a menu is already shown pops down that menu.
+ (define-key map [menu-bar t] 'tty-menu-exit)
+
+ (define-key map [?\C-r] 'tty-menu-select)
+ (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
+ ;; 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)
+ ;; 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)
+ map)
+ "Keymap used while processing TTY menus.")
+
(provide 'menu-bar)
;;; menu-bar.el ends here
diff --git a/lisp/mh-e/.gitignore b/lisp/mh-e/.gitignore
deleted file mode 100644
index 2e5b1740f15..00000000000
--- a/lisp/mh-e/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-mh-autoloads.el
-mh-cus-load.el
-mh-loaddefs.el
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index f90d88ee0de..2f65eb1f19c 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -145,6 +145,12 @@
(xemacs): Depend on autoloads instead of deleted loaddefs-xemacs.
(loaddefs-xemacs): Deleted.
+2005-08-10 Lars Hansen <larsh@soem.dk>
+
+ * mh-e.el: Add handler to desktop-buffer-mode-handlers.
+ (mh-restore-desktop-buffer): Remove autoload cookie.
+ (mh-folder-mode): Add autoload cookie.
+
2005-07-19 Bill Wohler <wohler@newt.com>
* README (INSTALL): Added info for Mac users.
@@ -903,6 +909,19 @@
rfc822-goto-eoh with something that allows From_ lines in the mail
header.
+2004-04-26 Lars Hansen <larsh@math.ku.dk>
+
+ * mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t.
+
+2004-04-22 Lars Hansen <larsh@math.ku.dk>
+
+ * mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings.
+
+2004-04-21 Lars Hansen <larsh@math.ku.dk>
+
+ * mh-e.el (mh-restore-desktop-buffer): Move from desktop.el.
+ Add Parameters.
+
2004-04-14 Bill Wohler <wohler@newt.com>
* mh-utils.el (mh-show-mouse): s/EVENT/event/. Thanks to John Paul
@@ -9946,7 +9965,7 @@
bug that I accidentally introduced by adding an extra line when
cut and pasting my changes.
- * mh-func.el (compilation): Code rearrangement to remove compiler
+ * mh-funcs.el (compilation): Code rearrangement to remove compiler
warnings.
* mh-mime.el (compilation): Code rearrangement to remove compiler
@@ -11242,7 +11261,7 @@
* mh-utils.el (mh-decode-quoted-printable):
New customizable variable telling whether to run mimedecode on
MIME message containing quoted-printable parts. mimedecode will
- only alter quoted-printable parts , leaving others intact, and the
+ only alter quoted-printable parts, leaving others intact, and the
resulting message is still fully MIME.
* mh-utils.el (mh-decode-quoted-printable): New function to run
mimedecode on the current buffer.
@@ -11400,7 +11419,7 @@
(dist): Leave release in current directory.
- Copyright (C) 2003-2013 Free Software Foundation, Inc.
+ Copyright (C) 2003-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog.2
index 5e94265f67d..4b41d60a1e8 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog.2
@@ -1,3 +1,45 @@
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-09-30 Bill Wohler <wohler@newt.com>
+
+ Release MH-E version 8.6.
+
+ * mh-e.el (Version, mh-version): Update for release 8.6.
+
+2014-09-30 Mike Kupfer <m.kupfer@acm.org>
+
+ * mh-comp.el (mh-insert-x-face): Ensure that mh-x-face-file is a
+ string before trying to use it (closes SF #474).
+ (mh-bare-components): New function to create a temporary initial
+ components file; replaces mh-find-components. Improve the temp
+ folder and file names as per a suggestion from Bill Wohler.
+ Also address XEmacs compatibility issues: use mm-make-temp-file instead
+ of make-temp-file, and only pass one argument to delete-directory.
+ (mh-edit-again, mh-send-sub): Use mh-bare-components instead of
+ mh-find-components (partially closes SF #468).
+
+2014-05-09 Glenn Morris <rgm@gnu.org>
+
+ * mh-e.el (mh-variants): Use file-accessible-directory-p.
+
+2014-03-16 Bill Wohler <wohler@newt.com>
+
+ * mh-folder.el (mh-regenerate-headers): Fix scan: bad message list
+ `unseen' error (closes SF #471).
+ * mh-e.el (mh-version): Add +bzr to version.
+
+2014-03-06 Glenn Morris <rgm@gnu.org>
+
+ * mh-compat.el (mh-display-completion-list):
+ Replace use of obsolete argument of display-completion-list.
+
+2013-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * mh-print.el (mh-ps-print-preprint): Don't use dynamic-var
+ `prefix-arg' as function argument.
+
2013-06-18 Juri Linkov <juri@jurta.org>
* mh-alias.el (mh-alias-local-users): Add non-nil arg REPLACE to
@@ -61,8 +103,8 @@
* mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable
macro.
- * mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use
- new mh-define-obsolete-variable-alias macro.
+ * mh-e.el (mh-kill-folder-suppress-prompt-hooks):
+ Use new mh-define-obsolete-variable-alias macro.
* mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and
flet elsewhere.
@@ -74,8 +116,8 @@
Replace flet with new alias mh-cl-flet.
* mh-mime.el (mh-display-with-external-viewer, mh-mime-display)
- (mh-press-button, mh-push-button, mh-display-emphasis): Replace
- flet with new alias mh-cl-flet.
+ (mh-press-button, mh-push-button, mh-display-emphasis):
+ Replace flet with new alias mh-cl-flet.
* mh-e.el (mh-invisible-header-fields-internal):
Remove trailing whitespace.
@@ -117,16 +159,16 @@
(mh-folder-mode): Add mh-blacklist and mh-whitelist variables.
(mh-execute-commands): Update documentation.
(mh-undo, mh-outstanding-commands-p, mh-process-commands)
- (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle
- blacklisted and whitelisted messages.
+ (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg):
+ Handle blacklisted and whitelisted messages.
* mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put
messages in blacklist and whitelist respectively for latter
processing.
(mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to
support previous functions.
(mh-junk-blacklist-disposition): New function.
- (mh-junk-process-blacklist, mh-junk-process-whitelist): New
- functions that perform the blacklisting and whitelisting
+ (mh-junk-process-blacklist, mh-junk-process-whitelist):
+ New functions that perform the blacklisting and whitelisting
respectively that used to be performed by mh-junk-blacklist and
mh-junk-whitelist.
* mh-scan.el (mh-scan-blacklisted-msg-regexp)
@@ -149,18 +191,18 @@
X-MaxCode-Template:, X-ME-Bayesian:, X-Sendergroup:, X-SFDC-,
X-SMFBL:, X-SMHeaderMap:, X-VGI-OESCD:, X-VirtualServer:,
X-VirtualServerGroup:, X-XPT-XSL-Name:, X-Y-GMX-Trusted:,
- X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-. Updated
- the comment. (addresses SF #1916032).
+ X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-.
+ Updated the comment. (addresses SF #1916032).
2012-11-25 Bill Wohler <wohler@newt.com>
- * mh-e.el (mh-invisible-header-fields-internal): Add
- X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress,
+ * mh-e.el (mh-invisible-header-fields-internal):
+ Add X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress,
X-Bayes-Prob, X-Cam-, X-CanIt-Geo, X-Completed, X-Facebook,
X-Forwarded-, X-Generated-By, X-Headers-End, X-IEEE-UCE,
X-Jira-Fingerprint, X-Junkmail-, X-Launchpad-, X-MXL-Hash,
- X-Notification-, X-Notifications, X-Oracle-Calendar. Replace
- X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032).
+ X-Notification-, X-Notifications, X-Oracle-Calendar.
+ Replace X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032).
2012-11-25 Jeffrey C Honig <jch@honig.net>
@@ -269,7 +311,7 @@
2011-07-09 Bill Wohler <wohler@newt.com>
- * mh-speed.el (mh-speed-toggle,mh-speed-view): Document "ignored"
+ * mh-speed.el (mh-speed-toggle, mh-speed-view): Document "ignored"
arguments to keep checkdoc happy.
* mh-search.el (mh-flists-execute): Ditto.
@@ -403,8 +445,8 @@
2009-11-05 Stefan Monnier <monnier@iro.umontreal.ca>
* mh-thread.el (mh-thread-set-tables):
- * mh-speed.el (mh-folder-speedbar-menu-items, mh-speed-stealth-update):
- (mh-speed-extract-folder-name, mh-speed-parse-flists-output):
+ * mh-speed.el (mh-folder-speedbar-menu-items, mh-speed-stealth-update)
+ (mh-speed-extract-folder-name, mh-speed-parse-flists-output)
(mh-speed-invalidate-map, mh-speed-add-folder):
* mh-show.el (mh-invalidate-show-buffer, mh-show-sequence-menu):
* mh-seq.el (mh-list-sequences):
@@ -422,7 +464,7 @@
* mh-e.el (mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
(mh-handle-process-error, mh-variant-info):
* mh-comp.el (mh-forward):
- * mh-alias.el (mh-alias-local-users, mh-alias-which-file-has-alias):
+ * mh-alias.el (mh-alias-local-users, mh-alias-which-file-has-alias)
(mh-alias-add-alias-to-file): Use with-current-buffer (closes SF
#1903293).
@@ -713,7 +755,7 @@
* mh-acros.el (mh-do-in-gnu-emacs, mh-do-in-xemacs)
(with-mh-folder-updating, mh-in-show-buffer)
- (mh-iterate-on-messages-in-region, mh-iterate-on-range):
+ (mh-iterate-on-messages-in-region, mh-iterate-on-range)
(mh-do-at-event-location): Add debug decls.
(mh-seq-msgs): Use defsubst.
@@ -1218,8 +1260,8 @@
(mh-show-subject, mh-show-to, mh-show-xface)
(mh-speedbar-folder, mh-speedbar-folder-with-unseen-messages)
(mh-speedbar-selected-folder)
- (mh-speedbar-selected-folder-with-unseen-messages): : Add
- :package-version keyword to these faces (closes SF #1452724).
+ (mh-speedbar-selected-folder-with-unseen-messages):
+ Add :package-version keyword to these faces (closes SF #1452724).
* mh-tool-bar.el (mh-tool-bar-define): Add commented-out
:package-version keywords (closes SF #1452724).
@@ -3619,14 +3661,19 @@
* mh-customize.el: Call mh-image-load-path just before
mh-tool-bar-define so that the toolbar images can be found.
+2005-10-06 Bill Wohler <wohler@newt.com>
+
+ * mh-loaddefs.el: Remove. Now generated automatically.
+
2005-10-04 Bill Wohler <wohler@newt.com>
* ChangeLog: Move contents into ChangeLog.1 and trim.
* ChangeLog.1: New file. Contains old ChangeLog.
+See ChangeLog.1 for earlier changes.
- Copyright (C) 2005-2013 Free Software Foundation, Inc.
+ Copyright (C) 2005-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 7d6279e4eca..04096246f16 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -1,6 +1,6 @@
;;; mh-acros.el --- macros used in MH-E
-;; Copyright (C) 2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -46,6 +46,10 @@
;;; Compatibility
+;; TODO: Replace `cl' with `cl-lib'.
+;; `cl' is deprecated in Emacs 24.3. Use `cl-lib' instead. However,
+;; we'll likely have to insert `cl-' before each use of a Common Lisp
+;; function.
;;;###mh-autoload
(defmacro mh-require-cl ()
"Macro to load \"cl\" if needed.
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index e97ba1dd83e..04e9fef59eb 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -1,6 +1,6 @@
;;; mh-alias.el --- MH-E mail alias completion and expansion
-;; Copyright (C) 1994-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -417,7 +417,7 @@ string is converted to lower case."
(defun mh-alias-insert-file (&optional alias)
"Return filename which should be used to add ALIAS.
-The value of the option `mh-alias-insert-file' is used if non-nil\;
+The value of the option `mh-alias-insert-file' is used if non-nil;
otherwise the value of the \"Aliasfile:\" profile component is used.
If the alias already exists, try to return the name of the file that
contains it."
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index 291d2539ddb..2963daea938 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -1,6 +1,6 @@
;;; mh-buffers.el --- MH-E buffer constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 782537aee2d..129e6857a4c 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1,6 +1,7 @@
;;; mh-comp.el --- MH-E functions for composing and sending messages
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
+;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -90,7 +91,7 @@ user's MH directory, then in the system MH lib directory.")
Default is \"replgroupcomps\".
This file is used to form replies to the sender and all recipients of
-a message. Only used if `(mh-variant-p 'nmh)' is non-nil.
+a message. Only used if (mh-variant-p \\='nmh) is non-nil.
If not an absolute file name, the file is searched for first in the
user's MH directory, then in the system MH lib directory.")
@@ -268,7 +269,7 @@ RETURN-ACTION and any additional arguments are IGNORED."
When you are all through editing a message, you send it with this
command. You can give a prefix argument ARG to monitor the first stage
-of the delivery\; this output can be found in a buffer called \"*MH-E
+of the delivery; this output can be found in a buffer called \"*MH-E
Mail Delivery*\".
The hook `mh-before-send-letter-hook' is run at the beginning of
@@ -410,6 +411,7 @@ See also `mh-send'."
(interactive (list (mh-get-msg-num t)))
(let* ((from-folder mh-current-folder)
(config (current-window-configuration))
+ (components-file (mh-bare-components))
(draft
(cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
(pop-to-buffer (find-file-noselect (mh-msg-filename message))
@@ -466,7 +468,8 @@ See also `mh-send'."
;; Text field, that's an easy case
(t
(mh-modify-header-field field value))))))
- (mh-components-to-list (mh-find-components)))
+ (mh-components-to-list components-file))
+ (delete-file components-file)
(goto-char (point-min))
(save-buffer)
(mh-compose-and-send-mail
@@ -884,22 +887,6 @@ Optional argument BUFFER can be used to specify the buffer."
(t
nil))))
-(defun mh-find-components ()
- "Return the path to the components file."
- (let (components)
- (cond
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-user-path)))
- components)
- ((file-exists-p
- (setq components
- (expand-file-name mh-comp-formfile mh-lib)))
- components)
- (t
- (error "Can't find %s in %s or %s"
- mh-comp-formfile mh-user-path mh-lib)))))
-
(defun mh-send-sub (to cc subject config)
"Do the real work of composing and sending a letter.
Expects the TO, CC, and SUBJECT fields as arguments.
@@ -909,8 +896,8 @@ CONFIG is the window configuration before sending mail."
(message "Composing a message...")
(let ((draft (mh-read-draft
"message"
- (mh-find-components)
- nil)))
+ (mh-bare-components)
+ t)))
(mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
(goto-char (point-max))
(mh-compose-and-send-mail draft "" folder msg-num
@@ -919,6 +906,29 @@ CONFIG is the window configuration before sending mail."
(mh-letter-mode-message)
(mh-letter-adjust-point))))
+(defun mh-bare-components ()
+ "Generate a temporary, clean components file and return its path."
+ ;; Let comp(1) create the skeleton for us. This is particularly
+ ;; important with nmh-1.5, because its default "components" needs
+ ;; some processing before it can be used. Unfortunately, comp(1)
+ ;; doesn't have a -build option. So, to avoid the possibility of
+ ;; clobbering an existing draft, create a temporary directory and
+ ;; use it as the drafts folder. Then copy the skeleton to a regular
+ ;; temp file, and return the regular temp file.
+ (let (new
+ (temp-folder (mm-make-temp-file
+ (concat mh-user-path "draftfolder.") t)))
+ (mh-exec-cmd "comp" "-nowhatnowproc"
+ "-draftfolder" (format "+%s"
+ (file-name-nondirectory temp-folder))
+ (if (stringp mh-comp-formfile)
+ (list "-form" mh-comp-formfile)))
+ (setq new (mm-make-temp-file "comp."))
+ (rename-file (concat temp-folder "/" "1") new t)
+ (delete-file (concat temp-folder "/" ".mh_sequences"))
+ (delete-directory temp-folder)
+ new))
+
(defun mh-read-draft (use initial-contents delete-contents-file)
"Read draft file into a draft buffer and make that buffer the current one.
@@ -1054,7 +1064,7 @@ The versions of MH-E, Emacs, and MH are shown."
(string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?"
emacs-version)
(match-string 0 emacs-version))
- ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?"
+ ((string-match "[0-9.]*\\( +([ a-z]+[0-9]+)\\)?"
emacs-version)
(match-string 0 emacs-version))
(t (format "%s.%s" emacs-major-version
@@ -1068,7 +1078,8 @@ The versions of MH-E, Emacs, and MH are shown."
(defun mh-insert-x-face ()
"Append X-Face, Face or X-Image-URL field to header.
If the field already exists, this function does nothing."
- (when (and (file-exists-p mh-x-face-file)
+ (when (and (stringp mh-x-face-file)
+ (file-exists-p mh-x-face-file)
(file-readable-p mh-x-face-file))
(save-excursion
(unless (or (mh-position-on-field "X-Face")
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index b755572c957..9865d085444 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -1,6 +1,6 @@
;;; mh-compat.el --- make MH-E compatible with various versions of Emacs
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -96,12 +96,18 @@ expected to return an integer."
(defmacro mh-display-completion-list (completions &optional common-substring)
"Display the list of COMPLETIONS.
See documentation for `display-completion-list' for a description of the
-arguments COMPLETIONS and perhaps COMMON-SUBSTRING.
-This macro is used by Emacs versions that lack a COMMON-SUBSTRING
-argument, introduced in Emacs 22."
- (if (< emacs-major-version 22)
- `(display-completion-list ,completions)
- `(display-completion-list ,completions ,common-substring)))
+arguments COMPLETIONS.
+The optional argument COMMON-SUBSTRING, if non-nil, should be a string
+specifying a common substring for adding the faces
+`completions-first-difference' and `completions-common-part' to
+the completions."
+ (cond ((< emacs-major-version 22) `(display-completion-list ,completions))
+ ((fboundp 'completion-hilit-commonality) ; Emacs 23.1 and later
+ `(display-completion-list
+ (completion-hilit-commonality ,completions
+ ,(length common-substring) nil)))
+ (t ; Emacs 22
+ `(display-completion-list ,completions ,common-substring))))
(defmacro mh-face-foreground (face &optional frame inherit)
"Return the foreground color name of FACE, or nil if unspecified.
@@ -156,7 +162,7 @@ compatibility with versions of Emacs that lack the variable
(let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
(image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
+ (when (boundp \\='image-load-path)
image-load-path))))
(mh-tool-bar-folder-buttons-init))"
(unless library (error "No library specified"))
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 752e2c5e9c6..c757920ef29 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1,11 +1,11 @@
;;; mh-e.el --- GNU Emacs interface to the MH mail system
-;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2013 Free
+;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2015 Free
;; Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
-;; Version: 8.5
+;; Version: 8.6
;; Keywords: mail
;; This file is part of GNU Emacs.
@@ -112,7 +112,7 @@
"\\(defgroup-mh\\)"
"\\)\\>"
;; Any whitespace and defined object.
- "[ \t'\(]*"
+ "[ \t'(]*"
"\\(setf[ \t]+\\sw+)\\|\\sw+\\)?")
(1 font-lock-keyword-face)
(7 (cond ((match-beginning 2) font-lock-function-name-face)
@@ -127,7 +127,7 @@
;; Try to keep variables local to a single file. Provide accessors if
;; variables are shared. Use this section as a last resort.
-(defconst mh-version "8.5" "Version number of MH-E.")
+(defconst mh-version "8.6" "Version number of MH-E.")
;; Variants
@@ -739,7 +739,7 @@ is described by the variable `mh-variants'."
(setq dir (file-chase-links (directory-file-name dir)))
(add-to-list 'list-unique dir))
(loop for dir in (nreverse list-unique) do
- (when (and dir (file-directory-p dir) (file-readable-p dir))
+ (when (and dir (file-accessible-directory-p dir))
(let ((variant (mh-variant-info dir)))
(if variant
(add-to-list 'mh-variants variant)))))
@@ -1353,8 +1353,8 @@ show window is toggled off."
This option is consulted when a prefix argument is used with
\\[mh-sort-folder]. Normally default arguments to \"sortm\" are
specified in the MH profile. This option may be used to provide
-an alternate view. For example, \"'(\"-nolimit\" \"-textfield\"
-\"subject\")\" is a useful setting."
+an alternate view. For example, (\"-nolimit\" \"-textfield\"
+\"subject\") is a useful setting."
:type '(repeat string)
:group 'mh-folder
:package-version '(MH-E . "8.0"))
@@ -1657,7 +1657,7 @@ using the Emacs 22 command \"emacsclient\" as follows:
origMode
polltime 10
headertime 0
- command emacsclient --eval '(mh-inc-spool-mh-e)'
+ command emacsclient --eval \\='(mh-inc-spool-mh-e)\\='
In XEmacs, the command \"gnuclient\" is used in a similar
fashion."
@@ -1834,7 +1834,7 @@ message without line wrapping."
"Default method to use in security tags.
This option is used to select between a variety of mail security
-mechanisms. The default is \"PGP (MIME)\" if it is supported\;
+mechanisms. The default is \"PGP (MIME)\" if it is supported;
otherwise, the default is \"None\". Other mechanisms include
vanilla \"PGP\" and \"S/MIME\".
@@ -2901,11 +2901,11 @@ This option contains the Unix command line which performs the
actual printing for the \\[mh-print-msg] command. The string can
contain one escape, \"%s\", which is replaced by the name of the
folder and the message number and is useful for print job names.
-I use \"mpage -h'%s' -b Letter -H1of -mlrtb -P\" which produces a
+I use \"mpage -h\\='%s\\=' -b Letter -H1of -mlrtb -P\" which produces a
nice header and adds a bit of margin so the text fits within my
printer's margins.
-This options is not used by the commands \\[mh-ps-print-msg] or
+This option is not used by the commands \\[mh-ps-print-msg] or
\\[mh-ps-print-msg-file]."
:type 'string
:group 'mh-show
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 01f304a38dc..d21720ebe55 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -1,6 +1,6 @@
;;; mh-folder.el --- MH-Folder mode
-;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -755,7 +755,7 @@ You can enter the message NUMBER either before or after typing
In a program, optional non-nil second argument NO-ERROR-IF-NO-MESSAGE
means return nil instead of signaling an error if message does not
-exist\; in this case, the cursor is positioned near where the message
+exist; in this case, the cursor is positioned near where the message
would have been. Non-nil third argument DONT-SHOW means not to show
the message."
(interactive "NGo to message: ")
@@ -1817,15 +1817,13 @@ If UPDATE, append the scan lines, otherwise replace."
"-width" (window-width)
folder range)
(goto-char scan-start)
- (cond ((looking-at "scan: no messages in")
- (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines
- ((looking-at (if (mh-variant-p 'gnu-mh)
- "scan: message set .* does not exist"
- "scan: bad message list "))
- (keep-lines mh-scan-valid-regexp))
- ((looking-at "scan: ")) ; Keep error messages
+ (cond ((or (looking-at "scan: no messages in")
+ (looking-at "scan: message set .* does not exist")
+ (looking-at "scan: bad message list "))
+ (keep-lines mh-scan-valid-regexp)) ; flush common scan output
+ ((looking-at "scan: ")) ; keep unexpected error messages
(t
- (keep-lines mh-scan-valid-regexp))) ; Flush random scan lines
+ (keep-lines mh-scan-valid-regexp))) ; flush random scan output
(setq mh-seq-list (mh-read-folder-sequences folder nil))
(mh-notate-user-sequences)
(or update
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 05cd8a4cbde..f710b8ce0f4 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -1,6 +1,6 @@
;;; mh-funcs.el --- MH-E functions not everyone will use right away
-;; Copyright (C) 1993, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 50a5aed62a0..b54355e3e74 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -1,6 +1,6 @@
;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
-;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index c93a4e0f2a8..cdd92fe3307 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -1,6 +1,6 @@
;;; mh-identity.el --- multiple identify support for MH-E
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index a2e16d92640..fc0bbf14b48 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -1,6 +1,6 @@
;;; mh-inc.el --- MH-E "inc" and separate mail spool handling
-;; Copyright (C) 2003-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index d7632ffc729..4a6693c2db6 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -1,6 +1,6 @@
;;; mh-junk.el --- MH-E interface to anti-spam measures
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>,
;; Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index b4d8b625586..7a56427027e 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -1,6 +1,6 @@
;;; mh-letter.el --- MH-Letter mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -553,7 +553,7 @@ one space."
(defun mh-letter-confirm-address ()
"Flash alias expansion.
-Addresses are separated by a comma\; when you press the comma,
+Addresses are separated by a comma; when you press the comma,
this command flashes the alias expansion in the minibuffer if
`mh-alias-flash-on-comma' is turned on."
(interactive)
@@ -932,7 +932,7 @@ Any match found replaces the text from BEGIN to END."
(and (stringp file)
(file-exists-p file)
(or (and (not (mh-have-file-command))
- (not (null (string-match "\.vcf$" file))))
+ (not (null (string-match "\\.vcf$" file))))
(string-equal "text/x-vcard" (mh-file-mime-type file))))))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index 8cb1f1464f6..daa9f8ef646 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -1,6 +1,6 @@
;;; mh-limit.el --- MH-E display limits
-;; Copyright (C) 2001-2003, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2003, 2006-2015 Free Software Foundation, Inc.
;; Author: Peter S. Galbraith <psg@debian.org>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 046f03d5255..a1c0bebd289 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -1,6 +1,6 @@
;;; mh-mime.el --- MH-E MIME support
-;; Copyright (C) 1993, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -1715,7 +1715,7 @@ buffer, while END defaults to the end of the buffer."
(defun mh-minibuffer-read-type (filename &optional default)
"Return the content type associated with the given FILENAME.
If the \"file\" command exists and recognizes the given file,
-then its value is returned\; otherwise, the user is prompted for
+then its value is returned; otherwise, the user is prompted for
a type (see `mailcap-mime-types').
Optional argument DEFAULT is returned if a type isn't entered."
(mailcap-parse-mimetypes)
@@ -1756,21 +1756,21 @@ Returns nil if file command not on system."
(kill-buffer tmp-buffer)))))))
(defvar mh-file-mime-type-substitutions
- '(("application/msword" "\.xls" "application/ms-excel")
- ("application/msword" "\.ppt" "application/ms-powerpoint")
- ("text/plain" "\.vcf" "text/x-vcard")
- ("text/rtf" "\.rtf" "application/rtf")
- ("application/x-zip" "\.sxc" "application/vnd.sun.xml.calc")
- ("application/x-zip" "\.sxd" "application/vnd.sun.xml.draw")
- ("application/x-zip" "\.sxi" "application/vnd.sun.xml.impress")
- ("application/x-zip" "\.sxw" "application/vnd.sun.xml.writer")
- ("application/x-zip" "\.odg" "application/vnd.oasis.opendocument.graphics")
- ("application/x-zip" "\.odi" "application/vnd.oasis.opendocument.image")
- ("application/x-zip" "\.odp"
+ '(("application/msword" "\\.xls" "application/ms-excel")
+ ("application/msword" "\\.ppt" "application/ms-powerpoint")
+ ("text/plain" "\\.vcf" "text/x-vcard")
+ ("text/rtf" "\\.rtf" "application/rtf")
+ ("application/x-zip" "\\.sxc" "application/vnd.sun.xml.calc")
+ ("application/x-zip" "\\.sxd" "application/vnd.sun.xml.draw")
+ ("application/x-zip" "\\.sxi" "application/vnd.sun.xml.impress")
+ ("application/x-zip" "\\.sxw" "application/vnd.sun.xml.writer")
+ ("application/x-zip" "\\.odg" "application/vnd.oasis.opendocument.graphics")
+ ("application/x-zip" "\\.odi" "application/vnd.oasis.opendocument.image")
+ ("application/x-zip" "\\.odp"
"application/vnd.oasis.opendocument.presentation")
- ("application/x-zip" "\.ods"
+ ("application/x-zip" "\\.ods"
"application/vnd.oasis.opendocument.spreadsheet")
- ("application/x-zip" "\.odt" "application/vnd.oasis.opendocument.text"))
+ ("application/x-zip" "\\.odt" "application/vnd.oasis.opendocument.text"))
"Substitutions to make for Content-Type returned from file command.
The first element is the Content-Type returned by the file command.
The second element is a regexp matching the file name, usually the
@@ -1801,7 +1801,7 @@ initialized. Always use the command `mh-have-file-command'.")
;;;###mh-autoload
(defun mh-have-file-command ()
- "Return t if 'file' command is on the system.
+ "Return t if `file' command is on the system.
'file -i' is used to get MIME type of composition insertion."
(when (eq mh-have-file-command 'undefined)
(setq mh-have-file-command
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index f57ccf56d85..d1233f05800 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -1,6 +1,6 @@
;;; mh-print.el --- MH-E printing support
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Jeffrey C Honig <jch@honig.net>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -139,11 +139,11 @@ commands \\[mh-ps-print-toggle-color] and
(interactive (list (mh-interactive-range "Print") (mh-ps-print-preprint 1)))
(mh-ps-print-range range file))
-(defun mh-ps-print-preprint (prefix-arg)
+(defun mh-ps-print-preprint (arg)
"Provide a better default file name for `ps-print-preprint'.
-Pass along the PREFIX-ARG to it."
+Pass along the prefix ARG to it."
(let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
- (ps-print-preprint prefix-arg)))
+ (ps-print-preprint arg)))
;;;###mh-autoload
(defun mh-ps-print-toggle-faces ()
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index e06c02b92b8..4e15ea861c8 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -1,6 +1,6 @@
;;; mh-scan.el --- MH-E scan line constants and utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index d31d0ca495a..b6eef4ecfc6 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -1,6 +1,6 @@
;;; mh-search --- MH-Search mode
-;; Copyright (C) 1993, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Indexed search by Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -1160,7 +1160,7 @@ the file \"/home/user/Mail/.namazu/mknmzrc\" with the following
contents:
package conf; # Don't remove this line!
- $ADDRESS = 'user@localhost';
+ $ADDRESS = \\='user@localhost\\=';
$ALLOW_FILE = \"[0-9]*\";
$EXCLUDE_PATH = \"^/home/user/Mail/(mhe-index|spam)\";
@@ -1247,7 +1247,7 @@ is used to search."
(prog1
(block nil
(when (eobp) (return nil))
- (when (search-forward-regexp "^\+" (mh-line-end-position) t)
+ (when (search-forward-regexp "^\\+" (mh-line-end-position) t)
(setq mh-index-pick-folder
(buffer-substring-no-properties (mh-line-beginning-position)
(mh-line-end-position)))
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index ff75a071fa9..259f60de2d5 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -1,6 +1,6 @@
;;; mh-seq.el --- MH-E sequences support
-;; Copyright (C) 1993, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -390,7 +390,7 @@ then a non-empty sequence is read."
"Read and return a sequence name.
Prompt with PROMPT, raise an error if the sequence is empty and
the NOT-EMPTY flag is non-nil, and supply an optional DEFAULT
-sequence. A reply of '%' defaults to the first sequence
+sequence. A reply of `%' defaults to the first sequence
containing the current message."
(let* ((input (completing-read (format "%s sequence%s: " prompt
(if default
@@ -766,7 +766,7 @@ completion is over."
"Parse LINE to generate folder name, unseen messages and total messages.
If CURRENT-FOLDER is non-nil then it contains the current folder
name and it is used to avoid problems in corner cases involving
-folders whose names end with a '+' character."
+folders whose names end with a `+' character."
(with-temp-buffer
(insert line)
(goto-char (point-max))
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 87b048dbd60..6d58670ce08 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -1,6 +1,6 @@
;;; mh-show.el --- MH-Show mode
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index bae019f8926..a260d742d05 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -1,6 +1,6 @@
;;; mh-speed.el --- MH-E speedbar support
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index d80e9f3ae53..201b897ed0c 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -1,6 +1,6 @@
;;; mh-thread.el --- MH-E threading support
-;; Copyright (C) 2002-2004, 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -27,9 +27,11 @@
;; The threading portion of this files tries to implement the
;; algorithm described at:
;; http://www.jwz.org/doc/threading.html
-;; It also begins to implement the IMAP Threading extension RFC. The
-;; implementation lacks the reference and subject canonicalization of
-;; the RFC.
+;; It also begins to implement the threading section of the IMAP -
+;; SORT and THREAD Extensions RFC at:
+;; http://tools.ietf.org/html/rfc5256
+;; The implementation lacks the reference and subject canonicalization
+;; of the RFC.
;; In the presentation buffer, children messages are shown indented
;; with either [ ] or < > around them. Square brackets ([ ]) denote
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index dc0d163e300..7200576de77 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -1,6 +1,6 @@
;;; mh-tool-bar.el --- MH-E tool bar support
-;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
;; Maintainer: Bill Wohler <wohler@newt.com>
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 09448feb136..37fd1651c5e 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -1,6 +1,6 @@
;;; mh-utils.el --- MH-E general utilities
-;; Copyright (C) 1993, 1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1993, 1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Wohler <wohler@newt.com>
@@ -419,21 +419,21 @@ names and the function is called when OUTPUT is available."
return-nil-if-folder-empty)
"Normalizes FOLDER name.
-Makes sure that two '/' characters never occur next to each
-other. Also all occurrences of \"..\" and \".\" are suitably
+Makes sure that two `/' characters never occur next to each
+other. Also all occurrences of `..' and `.' are suitably
processed. So \"+inbox/../news\" will be normalized to \"+news\".
-If optional argument EMPTY-STRING-OKAY is nil then a '+' is added
+If optional argument EMPTY-STRING-OKAY is nil then a `+' is added
at the front if FOLDER lacks one. If non-nil and FOLDER is the
empty string then nothing is added.
If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a
-trailing '/' if present is retained (if present), otherwise it is
+trailing `/' if present is retained (if present), otherwise it is
removed.
If optional argument RETURN-NIL-IF-FOLDER-EMPTY is non-nil, then
return nil if FOLDER is \"\" or \"+\". This is useful when
-normalizing the folder for the \"folders\" command which displays
+normalizing the folder for the `folders' command which displays
the directories in / if passed \"+\". This is usually not
desired. If this argument is non-nil, then EMPTY-STRING-OKAY has
no effect."
@@ -515,7 +515,7 @@ they will not be returned."
;; folder is specified, ensure it is nil to avoid adding the
;; folder to the folder-list and adding a slash to it.
(when folder
- (setq folder (mh-replace-regexp-in-string "^\+" "" folder))
+ (setq folder (mh-replace-regexp-in-string "^\\+" "" folder))
(setq folder (mh-replace-regexp-in-string "/+$" "" folder))
(if (equal folder "")
(setq folder nil)))
@@ -653,7 +653,7 @@ with \"+\"."
;;;###mh-autoload
(defun mh-expand-file-name (filename &optional default)
"Expand FILENAME like `expand-file-name', but also handle MH folder names.
-Any filename that starts with '+' is treated as a folder name.
+Any filename that starts with `+' is treated as a folder name.
See `expand-file-name' for description of DEFAULT."
(if (mh-folder-name-p filename)
(expand-file-name (substring filename 1) mh-user-path)
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 4340373f5c4..d48a8b3d152 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -1,6 +1,6 @@
;;; mh-xface.el --- MH-E X-Face and Face header field display
-;; Copyright (C) 2002-2003, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Bill Wohler <wohler@newt.com>
;; Maintainer: Bill Wohler <wohler@newt.com>
@@ -366,7 +366,7 @@ filenames. In addition, replaces * with %2a. See URL
`http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/ifaces/iitemnamelimits/GetValidCharacters.asp'."
(format "%s/%s.png" mh-x-image-cache-directory
(mh-replace-regexp-in-string
- "\*" "%2a"
+ "\\*" "%2a"
(mh-url-hexify-string
(with-temp-buffer
(insert url)
diff --git a/lisp/midnight.el b/lisp/midnight.el
index f207d438e5b..256ab9c06aa 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -1,6 +1,6 @@
-;;; midnight.el --- run something every midnight, e.g., kill old buffers
+;;; midnight.el --- run something every midnight, e.g., kill old buffers -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Sam Steingold <sds@gnu.org>
;; Maintainer: Sam Steingold <sds@gnu.org>
@@ -36,7 +36,7 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(defgroup midnight nil
"Run something every day at midnight."
@@ -48,24 +48,19 @@
Use `cancel-timer' to stop it and `midnight-delay-set' to change
the time when it is run.")
-(defcustom midnight-mode nil
- "Non-nil means run `midnight-hook' at midnight.
-Setting this variable outside customize has no effect;
-call `cancel-timer' or `timer-activate' on `midnight-timer' instead."
- :type 'boolean
- :group 'midnight
- :require 'midnight
- :initialize 'custom-initialize-default
- :set (lambda (symb val)
- (set symb val) (require 'midnight)
- (if val (timer-activate midnight-timer)
- (cancel-timer midnight-timer))))
+;;;###autoload
+(define-minor-mode midnight-mode
+ "Non-nil means run `midnight-hook' at midnight."
+ :global t
+ :initialize #'custom-initialize-default
+ (if midnight-mode (timer-activate midnight-timer)
+ (cancel-timer midnight-timer)))
;;; time conversion
-(defun midnight-buffer-display-time (&optional buffer)
+(defun midnight-buffer-display-time (buffer)
"Return the time-stamp of BUFFER, or current buffer, as float."
- (with-current-buffer (or buffer (current-buffer))
+ (with-current-buffer buffer
(when buffer-display-time (float-time buffer-display-time))))
;;; clean-buffer-list stuff
@@ -76,18 +71,16 @@ The autokilling is done by `clean-buffer-list' when is it in `midnight-hook'.
Currently displayed and/or modified (unsaved) buffers, as well as buffers
matching `clean-buffer-list-kill-never-buffer-names' and
`clean-buffer-list-kill-never-regexps' are excluded."
- :type 'integer
- :group 'midnight)
+ :type 'integer)
(defcustom clean-buffer-list-delay-special 3600
"The number of seconds before some buffers become eligible for autokilling.
Buffers matched by `clean-buffer-list-kill-regexps' and
`clean-buffer-list-kill-buffer-names' are killed if they were last
displayed more than this many seconds ago."
- :type 'integer
- :group 'midnight)
+ :type 'integer)
-(defcustom clean-buffer-list-kill-regexps nil
+(defcustom clean-buffer-list-kill-regexps '("\\`\\*Man ")
"List of regexps saying which buffers will be killed at midnight.
If buffer name matches a regexp in the list and the buffer was not displayed
in the last `clean-buffer-list-delay-special' seconds, it is killed by
@@ -96,12 +89,17 @@ If a member of the list is a cons, its `car' is the regexp and its `cdr' is
the number of seconds to use instead of `clean-buffer-list-delay-special'.
See also `clean-buffer-list-kill-buffer-names',
`clean-buffer-list-kill-never-regexps' and
-`clean-buffer-list-kill-never-buffer-names'."
- :type '(repeat (regexp :tag "Regexp matching Buffer Name"))
- :group 'midnight)
+`clean-buffer-list-kill-never-buffer-names'.
+
+Each element can also be a function instead of a regexp, in which case
+it takes a single argument (a buffer name) and should return non-nil
+if the buffer should be killed by `clean-buffer-list'."
+ :type '(repeat
+ (choice (regexp :tag "Regexp matching Buffer Name")
+ (function :tag "Predicate function"))))
(defcustom clean-buffer-list-kill-buffer-names
- '("*Help*" "*Apropos*" "*Man " "*Buffer List*" "*Compile-Log*" "*info*"
+ '("*Help*" "*Apropos*" "*Buffer List*" "*Compile-Log*" "*info*"
"*vc*" "*vc-diff*" "*diff*")
"List of strings saying which buffers will be killed at midnight.
Buffers with names in this list, which were not displayed in the last
@@ -112,8 +110,7 @@ the number of seconds to use instead of `clean-buffer-list-delay-special'.
See also `clean-buffer-list-kill-regexps',
`clean-buffer-list-kill-never-regexps' and
`clean-buffer-list-kill-never-buffer-names'."
- :type '(repeat (string :tag "Buffer Name"))
- :group 'midnight)
+ :type '(repeat (string :tag "Buffer Name")))
(defcustom clean-buffer-list-kill-never-buffer-names
'("*scratch*" "*Messages*")
@@ -122,33 +119,34 @@ See also `clean-buffer-list-kill-never-regexps'.
Note that this does override `clean-buffer-list-kill-regexps' and
`clean-buffer-list-kill-buffer-names' so a buffer matching any of these
two lists will NOT be killed if it is also present in this list."
- :type '(repeat (string :tag "Buffer Name"))
- :group 'midnight)
+ :type '(repeat (string :tag "Buffer Name")))
-(defcustom clean-buffer-list-kill-never-regexps '("^ \\*Minibuf-.*\\*$")
+(defcustom clean-buffer-list-kill-never-regexps '("\\` \\*Minibuf-.*\\*\\'")
"List of regexp saying which buffers will never be killed at midnight.
See also `clean-buffer-list-kill-never-buffer-names'.
Killing is done by `clean-buffer-list'.
Note that this does override `clean-buffer-list-kill-regexps' and
`clean-buffer-list-kill-buffer-names' so a buffer matching any of these
-two lists will NOT be killed if it also matches anything in this list."
- :type '(repeat (regexp :tag "Regexp matching Buffer Name"))
- :group 'midnight)
+two lists will NOT be killed if it also matches anything in this list.
-(defun midnight-find (el ls test &optional key)
- "A stopgap solution to the absence of `find' in ELisp."
- (cl-dolist (rr ls)
- (when (funcall test (if key (funcall key rr) rr) el)
- (cl-return rr))))
+Each element can also be a function instead of a regexp, in which case
+it takes a single argument (a buffer name) and should return non-nil
+if the buffer should never be killed by `clean-buffer-list'."
+ :type '(repeat
+ (choice (regexp :tag "Regexp matching Buffer Name")
+ (function :tag "Predicate function"))))
(defun clean-buffer-list-delay (name)
"Return the delay, in seconds, before killing a buffer named NAME.
Uses `clean-buffer-list-kill-buffer-names', `clean-buffer-list-kill-regexps'
`clean-buffer-list-delay-general' and `clean-buffer-list-delay-special'.
Autokilling is done by `clean-buffer-list'."
- (or (assoc-default name clean-buffer-list-kill-buffer-names 'string=
+ (or (assoc-default name clean-buffer-list-kill-buffer-names #'string=
clean-buffer-list-delay-special)
- (assoc-default name clean-buffer-list-kill-regexps 'string-match
+ (assoc-default name clean-buffer-list-kill-regexps
+ (lambda (re str)
+ (if (functionp re)
+ (funcall re str) (string-match re str)))
clean-buffer-list-delay-special)
(* clean-buffer-list-delay-general 24 60 60)))
@@ -172,10 +170,13 @@ lifetime, i.e., its \"age\" when it will be purged."
(setq bts (midnight-buffer-display-time buf) bn (buffer-name buf)
delay (if bts (- tm bts) 0) cbld (clean-buffer-list-delay bn))
(message "[%s] `%s' [%s %d]" ts bn (if bts (round delay)) cbld)
- (unless (or (midnight-find bn clean-buffer-list-kill-never-regexps
- 'string-match)
- (midnight-find bn clean-buffer-list-kill-never-buffer-names
- 'string-equal)
+ (unless (or (cl-find bn clean-buffer-list-kill-never-regexps
+ :test (lambda (bn re)
+ (if (functionp re)
+ (funcall re bn)
+ (string-match re bn))))
+ (cl-find bn clean-buffer-list-kill-never-buffer-names
+ :test #'string-equal)
(get-buffer-process buf)
(and (buffer-file-name buf) (buffer-modified-p buf))
(get-buffer-window buf 'visible) (< delay cbld))
@@ -190,8 +191,7 @@ lifetime, i.e., its \"age\" when it will be purged."
(defcustom midnight-hook '(clean-buffer-list)
"The hook run `midnight-delay' seconds after midnight every day.
The default value is `clean-buffer-list'."
- :type 'hook
- :group 'midnight)
+ :type 'hook)
(defun midnight-next ()
"Return the number of seconds till the next midnight."
@@ -209,7 +209,7 @@ to its second argument TM."
(when (timerp midnight-timer) (cancel-timer midnight-timer))
(setq midnight-timer
(run-at-time (if (numberp tm) (+ (midnight-next) tm) tm)
- midnight-period 'run-hooks 'midnight-hook)))
+ midnight-period #'run-hooks 'midnight-hook)))
(defcustom midnight-delay 3600
"The number of seconds after the midnight when the `midnight-timer' is run.
@@ -218,8 +218,7 @@ set it by calling `midnight-delay-set', or use `custom'.
If you wish, you can use a string instead, it will be passed as the
first argument to `run-at-time'."
:type 'sexp
- :set 'midnight-delay-set
- :group 'midnight)
+ :set #'midnight-delay-set)
(provide 'midnight)
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 3b59a9c622a..14697ea9802 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -1,6 +1,6 @@
;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*-
;;
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 72cb6f7e894..6123750b0c3 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1,6 +1,6 @@
;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
@@ -38,7 +38,7 @@
;;; Bugs:
-;; - completion-all-sorted-completions list all the completions, whereas
+;; - completion-all-sorted-completions lists all the completions, whereas
;; it should only lists the ones that `try-completion' would consider.
;; E.g. it should honor completion-ignored-extensions.
;; - choose-completion can't automatically figure out the boundaries
@@ -92,18 +92,21 @@
;;; Completion table manipulation
;; New completion-table operation.
-(defun completion-boundaries (string table pred suffix)
- "Return the boundaries of the completions returned by TABLE for STRING.
+(defun completion-boundaries (string collection pred suffix)
+ "Return the boundaries of text on which COLLECTION will operate.
STRING is the string on which completion will be performed.
SUFFIX is the string after point.
+If COLLECTION is a function, it is called with 3 arguments: STRING,
+PRED, and a cons cell of the form (boundaries . SUFFIX).
+
The result is of the form (START . END) where START is the position
in STRING of the beginning of the completion field and END is the position
in SUFFIX of the end of the completion field.
E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
and for file names the result is the positions delimited by
the closest directory separators."
- (let ((boundaries (if (functionp table)
- (funcall table string pred
+ (let ((boundaries (if (functionp collection)
+ (funcall collection string pred
(cons 'boundaries suffix)))))
(if (not (eq (car-safe boundaries) 'boundaries))
(setq boundaries nil))
@@ -145,7 +148,7 @@ Like CL's `some'."
(let ((firsterror nil)
res)
(while (and (not res) xs)
- (condition-case err
+ (condition-case-unless-debug err
(setq res (funcall fun (pop xs)))
(error (unless firsterror (setq firsterror err)) nil)))
(or res
@@ -169,27 +172,52 @@ ACTION can be one of nil, t or `lambda'."
(t 'test-completion))
string table pred))))
-(defun completion-table-dynamic (fun)
+(defun completion-table-dynamic (fun &optional switch-buffer)
"Use function FUN as a dynamic completion table.
FUN is called with one argument, the string for which completion is required,
and it should return an alist containing all the intended possible completions.
This alist may be a full list of possible completions so that FUN can ignore
-the value of its argument. If completion is performed in the minibuffer,
-FUN will be called in the buffer from which the minibuffer was entered.
+the value of its argument.
+If SWITCH-BUFFER is non-nil and completion is performed in the
+minibuffer, FUN will be called in the buffer from which the minibuffer
+was entered.
The result of the `completion-table-dynamic' form is a function
that can be used as the COLLECTION argument to `try-completion' and
-`all-completions'. See Info node `(elisp)Programmed Completion'."
+`all-completions'. See Info node `(elisp)Programmed Completion'.
+
+See also the related function `completion-table-with-cache'."
(lambda (string pred action)
(if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
;; `fun' is not supposed to return another function but a plain old
;; completion table, whose boundaries are always trivial.
nil
- (with-current-buffer (let ((win (minibuffer-selected-window)))
- (if (window-live-p win) (window-buffer win)
- (current-buffer)))
+ (with-current-buffer (if (not switch-buffer) (current-buffer)
+ (let ((win (minibuffer-selected-window)))
+ (if (window-live-p win) (window-buffer win)
+ (current-buffer))))
(complete-with-action action (funcall fun string) string pred)))))
+(defun completion-table-with-cache (fun &optional ignore-case)
+ "Create dynamic completion table from function FUN, with cache.
+This is a wrapper for `completion-table-dynamic' that saves the last
+argument-result pair from FUN, so that several lookups with the
+same argument (or with an argument that starts with the first one)
+only need to call FUN once. This can be useful when FUN performs a
+relatively slow operation, such as calling an external process.
+
+When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
+ ;; See eg bug#11906.
+ (let* (last-arg last-result
+ (new-fun
+ (lambda (arg)
+ (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+ last-result
+ (prog1
+ (setq last-result (funcall fun arg))
+ (setq last-arg arg))))))
+ (completion-table-dynamic new-fun)))
+
(defmacro lazy-completion-table (var fun)
"Initialize variable VAR as a lazy completion table.
If the completion table VAR is used for the first time (e.g., by passing VAR
@@ -206,7 +234,8 @@ You should give VAR a non-nil `risky-local-variable' property."
(lambda (,str)
(when (functionp ,var)
(setq ,var (funcall #',fun)))
- ,var))))
+ ,var)
+ 'do-switch-buffer)))
(defun completion-table-case-fold (table &optional dont-fold)
"Return new completion TABLE that is case insensitive.
@@ -222,8 +251,7 @@ The result is a completion table which completes strings of the
form (concat S1 S) in the same way as TABLE completes strings of
the form (concat S2 S)."
(lambda (string pred action)
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
+ (let* ((str (if (string-prefix-p s1 string completion-ignore-case)
(concat s2 (substring string (length s1)))))
(res (if str (complete-with-action action table str pred))))
(when res
@@ -235,8 +263,7 @@ the form (concat S2 S)."
(+ beg (- (length s1) (length s2))))
. ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
+ (if (string-prefix-p s2 string completion-ignore-case)
(concat s1 (substring res (length s2)))))
((eq action t)
(let ((bounds (completion-boundaries str table pred "")))
@@ -370,11 +397,37 @@ Note: TABLE needs to be a proper completion table which obeys predicates."
"Create a completion table that tries each table in TABLES in turn."
;; FIXME: the boundaries may come from TABLE1 even when the completion list
;; is returned by TABLE2 (because TABLE1 returned an empty list).
+ ;; Same potential problem if any of the tables use quoting.
(lambda (string pred action)
(completion--some (lambda (table)
(complete-with-action action table string pred))
tables)))
+(defun completion-table-merge (&rest tables)
+ "Create a completion table that collects completions from all TABLES."
+ ;; FIXME: same caveats as in `completion-table-in-turn'.
+ (lambda (string pred action)
+ (cond
+ ((null action)
+ (let ((retvals (mapcar (lambda (table)
+ (try-completion string table pred))
+ tables)))
+ (if (member string retvals)
+ string
+ (try-completion string
+ (mapcar (lambda (value)
+ (if (eq value t) string value))
+ (delq nil retvals))
+ pred))))
+ ((eq action t)
+ (apply #'append (mapcar (lambda (table)
+ (all-completions string table pred))
+ tables)))
+ (t
+ (completion--some (lambda (table)
+ (complete-with-action action table string pred))
+ tables)))))
+
(defun completion-table-with-quoting (table unquote requote)
;; A difficult part of completion-with-quoting is to map positions in the
;; quoted string to equivalent positions in the unquoted string and
@@ -471,11 +524,35 @@ for use at QPOS."
completions))
((eq action 'completion--unquote)
- (let ((ustring (funcall unquote string))
- (uprefix (funcall unquote (substring string 0 pred))))
- ;; We presume (more or less) that `concat' and `unquote' commute.
- (cl-assert (string-prefix-p uprefix ustring))
- (list ustring table (length uprefix)
+ ;; PRED is really a POINT in STRING.
+ ;; We should return a new set (STRING TABLE POINT REQUOTE)
+ ;; where STRING is a new (unquoted) STRING to match against the new TABLE
+ ;; using a new POINT inside it, and REQUOTE is a requoting function which
+ ;; should reverse the unquoting, (i.e. it receives the completion result
+ ;; of using the new TABLE and should turn it into the corresponding
+ ;; quoted result).
+ (let* ((qpos pred)
+ (ustring (funcall unquote string))
+ (uprefix (funcall unquote (substring string 0 qpos)))
+ ;; FIXME: we really should pass `qpos' to `unquote' and have that
+ ;; function give us the corresponding `uqpos'. But for now we
+ ;; presume (more or less) that `concat' and `unquote' commute.
+ (uqpos (if (string-prefix-p uprefix ustring)
+ ;; Yay!! They do seem to commute!
+ (length uprefix)
+ ;; They don't commute this time! :-(
+ ;; Maybe qpos is in some text that disappears in the
+ ;; ustring (bug#17239). Let's try a second chance guess.
+ (let ((usuffix (funcall unquote (substring string qpos))))
+ (if (string-suffix-p usuffix ustring)
+ ;; Yay!! They still "commute" in a sense!
+ (- (length ustring) (length usuffix))
+ ;; Still no luck! Let's just choose *some* position
+ ;; within ustring.
+ (/ (+ (min (length uprefix) (length ustring))
+ (max (- (length ustring) (length usuffix)) 0))
+ 2))))))
+ (list ustring table uqpos
(lambda (unquoted-result op)
(pcase op
(1 ;;try
@@ -613,7 +690,7 @@ for use at QPOS."
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'."
+If ARGS are provided, then pass MESSAGE through `format-message'."
(if (not (minibufferp (current-buffer)))
(progn
(if args
@@ -623,11 +700,12 @@ If ARGS are provided, then pass MESSAGE through `format'."
(message nil)))
;; Clear out any old echo-area message to make way for our new thing.
(message nil)
- (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
+ (setq message (if (and (null args)
+ (string-match-p "\\` *\\[.+\\]\\'" message))
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
- (when args (setq message (apply 'format message args)))
+ (when args (setq message (apply #'format-message message args)))
(let ((ol (make-overlay (point-max) (point-max) nil t t))
;; A quit during sit-for normally only interrupts the sit-for,
;; but since minibuffer-message is used at the end of a command,
@@ -651,7 +729,7 @@ If ARGS are provided, then pass MESSAGE through `format'."
"Return the user input in a minibuffer before point as a string.
In Emacs-22, that was what completion commands operated on."
(declare (obsolete nil "24.4"))
- (buffer-substring (field-beginning) (point)))
+ (buffer-substring (minibuffer-prompt-end) (point)))
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
@@ -670,8 +748,7 @@ If the value is t the *Completion* buffer is displayed whenever completion
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
the second failed attempt to complete."
- :type '(choice (const nil) (const t) (const lazy))
- :group 'minibuffer)
+ :type '(choice (const nil) (const t) (const lazy)))
(defconst completion-styles-alist
'((emacs21
@@ -750,19 +827,29 @@ The available styles are listed in `completion-styles-alist'.
Note that `completion-category-overrides' may override these
styles for specific categories, such as files, buffers, etc."
:type completion--styles-type
- :group 'minibuffer
:version "23.1")
-(defcustom completion-category-overrides
- '((buffer (styles . (basic substring))))
- "List of `completion-styles' overrides for specific categories.
+(defvar completion-category-defaults
+ '((buffer (styles . (basic substring)))
+ (unicode-name (styles . (basic substring))))
+ "Default settings for specific completion categories.
+Each entry has the shape (CATEGORY . ALIST) where ALIST is
+an association list that can specify properties such as:
+- `styles': the list of `completion-styles' to use for that category.
+- `cycle': the `completion-cycle-threshold' to use for that category.
+Categories are symbols such as `buffer' and `file', used when
+completing buffer and file names, respectively.")
+
+(defcustom completion-category-overrides nil
+ "List of category-specific user overrides for completion styles.
Each override has the shape (CATEGORY . ALIST) where ALIST is
an association list that can specify properties such as:
- `styles': the list of `completion-styles' to use for that category.
- `cycle': the `completion-cycle-threshold' to use for that category.
Categories are symbols such as `buffer' and `file', used when
-completing buffer and file names, respectively."
- :version "24.1"
+completing buffer and file names, respectively.
+This overrides the defaults specified in `completion-category-defaults'."
+ :version "25.1"
:type `(alist :key-type (choice :tag "Category"
(const buffer)
(const file)
@@ -778,9 +865,13 @@ completing buffer and file names, respectively."
(const :tag "Select one value from the menu." cycle)
,completion--cycling-threshold-type))))
+(defun completion--category-override (category tag)
+ (or (assq tag (cdr (assq category completion-category-overrides)))
+ (assq tag (cdr (assq category completion-category-defaults)))))
+
(defun completion--styles (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
- (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
+ (over (completion--category-override cat 'styles)))
(if over
(delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles)))
@@ -802,17 +893,19 @@ completing buffer and file names, respectively."
;; part of the string (e.g. substitute-in-file-name).
(let ((requote
(when (completion-metadata-get metadata 'completion--unquote-requote)
+ (cl-assert (functionp table))
(let ((new (funcall table string point 'completion--unquote)))
(setq string (pop new))
(setq table (pop new))
(setq point (pop new))
+ (cl-assert (<= point (length string)))
(pop new))))
- (result
- (completion--some (lambda (style)
- (funcall (nth n (assq style
- completion-styles-alist))
- string table pred point))
- (completion--styles metadata))))
+ (result
+ (completion--some (lambda (style)
+ (funcall (nth n (assq style
+ completion-styles-alist))
+ string table pred point))
+ (completion--styles metadata))))
(if requote
(funcall requote result n)
result)))
@@ -874,13 +967,14 @@ Moves point to the end of the new text."
(setq end (- end suffix-len))
(setq newtext (substring newtext 0 (- suffix-len))))
(goto-char beg)
- (insert-and-inherit newtext)
- (delete-region (point) (+ (point) (- end beg)))
+ (let ((length (- end beg))) ;Read `end' before we insert the text.
+ (insert-and-inherit newtext)
+ (delete-region (point) (+ (point) length)))
(forward-char suffix-len)))
(defcustom completion-cycle-threshold nil
"Number of completion candidates below which cycling is used.
-Depending on this setting `minibuffer-complete' may use cycling,
+Depending on this setting `completion-in-region' may use cycling,
like `minibuffer-force-complete'.
If nil, cycling is never used.
If t, cycling is always used.
@@ -891,11 +985,10 @@ completion candidates than this number."
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
- (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
+ (over (completion--category-override cat 'cycle)))
(if over (cdr over) completion-cycle-threshold)))
-(defvar completion-all-sorted-completions nil)
-(make-variable-buffer-local 'completion-all-sorted-completions)
+(defvar-local completion-all-sorted-completions nil)
(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil)
@@ -906,8 +999,8 @@ completion candidates than this number."
(if completion-show-inline-help
(minibuffer-message msg)))
-(defun completion--do-completion (&optional try-completion-function
- expect-exact)
+(defun completion--do-completion (beg end &optional
+ try-completion-function expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
@@ -926,9 +1019,7 @@ E = after completion we now have an Exact match.
TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
EXPECT-EXACT, if non-nil, means that there is no need to tell the user
when the buffer's text is already an exact match."
- (let* ((beg (field-beginning))
- (end (field-end))
- (string (buffer-substring beg end))
+ (let* ((string (buffer-substring beg end))
(md (completion--field-metadata beg))
(comp (funcall (or try-completion-function
'completion-try-completion)
@@ -963,7 +1054,8 @@ when the buffer's text is already an exact match."
(if unchanged
(goto-char end)
;; Insert in minibuffer the chars we got.
- (completion--replace beg end completion))
+ (completion--replace beg end completion)
+ (setq end (+ beg (length completion))))
;; Move point to its completion-mandated destination.
(forward-char (- comp-pos (length completion)))
@@ -972,7 +1064,8 @@ when the buffer's text is already an exact match."
;; whether this is a unique completion or not, so try again using
;; the real case (this shouldn't recurse again, because the next
;; time try-completion will return either t or the exact string).
- (completion--do-completion try-completion-function expect-exact)
+ (completion--do-completion beg end
+ try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
(let* ((exact (test-completion completion
@@ -995,7 +1088,7 @@ when the buffer's text is already an exact match."
minibuffer-completion-predicate
""))
comp-pos)))
- (completion-all-sorted-completions))))
+ (completion-all-sorted-completions beg end))))
(completion--flush-all-sorted-completions)
(cond
((and (consp (cdr comps)) ;; There's something to cycle.
@@ -1006,8 +1099,8 @@ when the buffer's text is already an exact match."
;; Not more than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
- (completion--cache-all-sorted-completions comps)
- (minibuffer-force-complete))
+ (completion--cache-all-sorted-completions beg end comps)
+ (minibuffer-force-complete beg end))
(completed
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
@@ -1024,14 +1117,14 @@ when the buffer's text is already an exact match."
(if (pcase completion-auto-help
(`lazy (eq this-command last-command))
(_ completion-auto-help))
- (minibuffer-completion-help)
+ (minibuffer-completion-help beg end)
(completion--message "Next char not unique")))
;; If the last exact completion and this one were the same, it
;; means we've already given a "Complete, but not unique" message
;; and the user's hit TAB again, so now we give him help.
(t
(if (and (eq this-command last-command) completion-auto-help)
- (minibuffer-completion-help))
+ (minibuffer-completion-help beg end))
(completion--done completion 'exact
(unless expect-exact
"Complete, but not unique"))))
@@ -1045,6 +1138,12 @@ If no characters can be completed, display a list of possible completions.
If you repeat this command after it displayed such a list,
scroll the window of possible completions."
(interactive)
+ (when (<= (minibuffer-prompt-end) (point))
+ (completion-in-region (minibuffer-prompt-end) (point-max)
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
+
+(defun completion--in-region-1 (beg end)
;; If the previous command was not this,
;; mark the completion buffer obsolete.
(setq this-command 'completion-at-point)
@@ -1063,21 +1162,22 @@ scroll the window of possible completions."
;; If end is in view, scroll up to the beginning.
(set-window-start window (point-min) nil)
;; Else scroll down one screen.
- (scroll-other-window))
+ (with-selected-window window
+ (scroll-up)))
nil)))
;; If we're cycling, keep on cycling.
((and completion-cycling completion-all-sorted-completions)
- (minibuffer-force-complete)
+ (minibuffer-force-complete beg end)
t)
- (t (pcase (completion--do-completion)
+ (t (pcase (completion--do-completion beg end)
(#b000 nil)
(_ t)))))
-(defun completion--cache-all-sorted-completions (comps)
+(defun completion--cache-all-sorted-completions (beg end comps)
(add-hook 'after-change-functions
'completion--flush-all-sorted-completions nil t)
(setq completion--all-sorted-completions-location
- (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
+ (cons (copy-marker beg) (copy-marker end)))
(setq completion-all-sorted-completions comps))
(defun completion--flush-all-sorted-completions (&optional start end _len)
@@ -1097,10 +1197,10 @@ scroll the window of possible completions."
(if (eq (car bounds) base) md-at-point
(completion-metadata (substring string 0 base) table pred))))
-(defun completion-all-sorted-completions ()
+(defun completion-all-sorted-completions (&optional start end)
(or completion-all-sorted-completions
- (let* ((start (field-beginning))
- (end (field-end))
+ (let* ((start (or start (minibuffer-prompt-end)))
+ (end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
(all (completion-all-completions
@@ -1138,18 +1238,20 @@ scroll the window of possible completions."
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
- (completion--cache-all-sorted-completions (nconc all base-size))))))
+ (completion--cache-all-sorted-completions
+ start end (nconc all base-size))))))
(defun minibuffer-force-complete-and-exit ()
"Complete the minibuffer with first of the matches and exit."
(interactive)
(minibuffer-force-complete)
- (minibuffer--complete-and-exit
+ (completion--complete-and-exit
+ (minibuffer-prompt-end) (point-max) #'exit-minibuffer
;; If the previous completion completed to an element which fails
;; test-completion, then we shouldn't exit, but that should be rare.
(lambda () (minibuffer-message "Incomplete"))))
-(defun minibuffer-force-complete ()
+(defun minibuffer-force-complete (&optional start end)
"Complete the minibuffer to an exact match.
Repeated uses step through the possible completions."
(interactive)
@@ -1157,10 +1259,10 @@ Repeated uses step through the possible completions."
;; FIXME: Need to deal with the extra-size issue here as well.
;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
- (let* ((start (copy-marker (field-beginning)))
- (end (field-end))
+ (let* ((start (copy-marker (or start (minibuffer-prompt-end))))
+ (end (or end (point-max)))
;; (md (completion--field-metadata start))
- (all (completion-all-sorted-completions))
+ (all (completion-all-sorted-completions start end))
(base (+ start (or (cdr (last all)) 0))))
(cond
((not (consp all))
@@ -1173,10 +1275,11 @@ Repeated uses step through the possible completions."
'finished (when done "Sole completion"))))
(t
(completion--replace base end (car all))
+ (setq end (+ base (length (car all))))
(completion--done (buffer-substring-no-properties start (point)) 'sole)
;; Set cycling after modifying the buffer since the flush hook resets it.
(setq completion-cycling t)
- (setq this-command 'completion-at-point) ;For minibuffer-complete.
+ (setq this-command 'completion-at-point) ;For completion-in-region.
;; If completing file names, (car all) may be a directory, so we'd now
;; have a new set of possible completions and might want to reset
;; completion-all-sorted-completions to nil, but we prefer not to,
@@ -1184,7 +1287,7 @@ Repeated uses step through the possible completions."
;; through the previous possible completions.
(let ((last (last all)))
(setcdr last (cons (car all) (cdr last)))
- (completion--cache-all-sorted-completions (cdr all)))
+ (completion--cache-all-sorted-completions start end (cdr all)))
;; Make sure repeated uses cycle, even though completion--done might
;; have added a space or something that moved us outside of the field.
;; (bug#12221).
@@ -1196,7 +1299,7 @@ Repeated uses step through the possible completions."
(interactive)
(let ((completion-extra-properties extra-prop))
(completion-in-region start (point) table pred)))))
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map [remap completion-at-point] cmd)
(define-key map (vector last-command-event) cmd)
@@ -1223,27 +1326,32 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
`minibuffer-confirm-exit-commands', and accept the input
otherwise."
(interactive)
- (minibuffer--complete-and-exit
+ (completion-complete-and-exit (minibuffer-prompt-end) (point-max)
+ #'exit-minibuffer))
+
+(defun completion-complete-and-exit (beg end exit-function)
+ (completion--complete-and-exit
+ beg end exit-function
(lambda ()
(pcase (condition-case nil
- (completion--do-completion nil 'expect-exact)
+ (completion--do-completion beg end
+ nil 'expect-exact)
(error 1))
- ((or #b001 #b011) (exit-minibuffer))
+ ((or #b001 #b011) (funcall exit-function))
(#b111 (if (not minibuffer-completion-confirm)
- (exit-minibuffer)
+ (funcall exit-function)
(minibuffer-message "Confirm")
nil))
(_ nil)))))
-(defun minibuffer--complete-and-exit (completion-function)
+(defun completion--complete-and-exit (beg end
+ exit-function completion-function)
"Exit from `require-match' minibuffer.
COMPLETION-FUNCTION is called if the current buffer's content does not
appear to be a match."
- (let ((beg (field-beginning))
- (end (field-end)))
(cond
;; Allow user to specify null string
- ((= beg end) (exit-minibuffer))
+ ((= beg end) (funcall exit-function))
((test-completion (buffer-substring beg end)
minibuffer-completion-table
minibuffer-completion-predicate)
@@ -1269,7 +1377,7 @@ appear to be a match."
;; that file.
(= (length string) (length compl)))
(completion--replace beg end compl))))
- (exit-minibuffer))
+ (funcall exit-function))
((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
;; The user is permitted to exit with an input that's rejected
@@ -1280,13 +1388,13 @@ appear to be a match."
;; catches most minibuffer typos).
(and (eq minibuffer-completion-confirm 'confirm-after-completion)
(not (memq last-command minibuffer-confirm-exit-commands))))
- (exit-minibuffer)
+ (funcall exit-function)
(minibuffer-message "Confirm")
nil))
(t
;; Call do-completion, but ignore errors.
- (funcall completion-function)))))
+ (funcall completion-function))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
@@ -1308,6 +1416,8 @@ appear to be a match."
(before (substring string 0 point))
(after (substring string point))
tem)
+ ;; If both " " and "-" lead to completions, prefer " " so SPC behaves
+ ;; a bit more like a self-inserting key (bug#17375).
(while (and exts (not (consp tem)))
(setq tem (completion-try-completion
(concat before (pop exts) after)
@@ -1381,9 +1491,18 @@ After one word is completed as much as possible, a space or hyphen
is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
- (pcase (completion--do-completion 'completion--try-word-completion)
+ (completion-in-region--single-word
+ (minibuffer-prompt-end) (point-max)
+ minibuffer-completion-table minibuffer-completion-predicate))
+
+(defun completion-in-region--single-word (beg end collection
+ &optional predicate)
+ (let ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate predicate))
+ (pcase (completion--do-completion beg end
+ #'completion--try-word-completion)
(#b000 nil)
- (_ t)))
+ (_ t))))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
@@ -1395,7 +1514,6 @@ in columns in the *Completions* buffer.
If the value is `horizontal', display completions sorted
horizontally in alphabetical order, rather than down the screen."
:type '(choice (const horizontal) (const vertical))
- :group 'minibuffer
:version "23.2")
(defun completion--insert-strings (strings)
@@ -1504,17 +1622,26 @@ See also `display-completion-list'.")
(defface completions-first-difference
'((t (:inherit bold)))
- "Face added on the first uncommon character in completions in *Completions* buffer."
- :group 'completion)
+ "Face for the first uncommon character in completions.
+See also the face `completions-common-part'.")
(defface completions-common-part '((t nil))
- "Face added on the common prefix substring in completions in *Completions* buffer.
-The idea of `completions-common-part' is that you can use it to
-make the common parts less visible than normal, so that the rest
-of the differing parts is, by contrast, slightly highlighted."
- :group 'completion)
-
-(defun completion-hilit-commonality (completions prefix-len base-size)
+ "Face for the common prefix substring in completions.
+The idea of this face is that you can use it to make the common parts
+less visible than normal, so that the differing parts are emphasized
+by contrast.
+See also the face `completions-first-difference'.")
+
+(defun completion-hilit-commonality (completions prefix-len &optional base-size)
+ "Apply font-lock highlighting to a list of completions, COMPLETIONS.
+PREFIX-LEN is an integer. BASE-SIZE is an integer or nil (meaning zero).
+
+This adds the face `completions-common-part' to the first
+\(PREFIX-LEN - BASE-SIZE) characters of each completion, and the face
+`completions-first-difference' to the first character after that.
+
+It returns a list with font-lock properties applied to each element,
+and with BASE-SIZE appended as the last element."
(when completions
(let ((com-str-len (- prefix-len (or base-size 0))))
(nconc
@@ -1555,12 +1682,8 @@ alternative, the second serves as annotation.
The actual completion alternatives, as inserted, are given `mouse-face'
properties of `highlight'.
At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'.
-
-The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string
-specifying a common substring for adding the faces
-`completions-first-difference' and `completions-common-part' to
-the completions buffer."
+It can find the completion buffer in `standard-output'."
+ (declare (advertised-calling-convention (completions) "24.4"))
(if common-substring
(setq completions (completion-hilit-commonality
completions (length common-substring)
@@ -1647,19 +1770,19 @@ variables.")
(equal pre-msg (and exit-fun (current-message))))
(completion--message message))))
-(defun minibuffer-completion-help ()
+(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
(interactive)
(message "Making completion list...")
- (let* ((start (field-beginning))
- (end (field-end))
- (string (field-string))
+ (let* ((start (or start (minibuffer-prompt-end)))
+ (end (or end (point-max)))
+ (string (buffer-substring start end))
(md (completion--field-metadata start))
(completions (completion-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) (field-beginning))
+ (- (point) start)
md)))
(message nil)
(if (or (null completions)
@@ -1674,7 +1797,7 @@ variables.")
(if completions "Sole completion" "No completions")))
(let* ((last (last completions))
- (base-size (cdr last))
+ (base-size (or (cdr last) 0))
(prefix (unless (zerop base-size) (substring string 0 base-size)))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
@@ -1689,8 +1812,32 @@ variables.")
;; 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-output-to-temp-buffer "*Completions*"
+ (display-buffer-mark-dedicated 'soft)
+ ;; Disable `pop-up-windows' temporarily to allow
+ ;; `display-buffer--maybe-pop-up-frame-or-window'
+ ;; in the display actions below to pop up a frame
+ ;; if `pop-up-frames' is non-nil, but not to pop up a window.
+ (pop-up-windows nil))
+ (with-displayed-buffer-window
+ "*Completions*"
+ ;; This is a copy of `display-buffer-fallback-action'
+ ;; where `display-buffer-use-some-window' is replaced
+ ;; with `display-buffer-at-bottom'.
+ `((display-buffer--maybe-same-window
+ display-buffer-reuse-window
+ display-buffer--maybe-pop-up-frame-or-window
+ ;; Use `display-buffer-below-selected' for inline completions,
+ ;; but not in the minibuffer (e.g. in `eval-expression')
+ ;; for which `display-buffer-at-bottom' is used.
+ ,(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 . shrink-window-if-larger-than-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))
@@ -1775,14 +1922,14 @@ variables.")
(exit-minibuffer))
(defvar completion-in-region-functions nil
- "Wrapper hook around `completion-in-region'.")
+ "Wrapper hook around `completion--in-region'.")
(make-obsolete-variable 'completion-in-region-functions
'completion-in-region-function "24.4")
(defvar completion-in-region-function #'completion--in-region
"Function to perform the job of `completion-in-region'.
The function is called with 4 arguments: START END COLLECTION PREDICATE.
-The arguments and expected return value are like the ones of
+The arguments and expected return value are as specified for
`completion-in-region'.")
(defvar completion-in-region--data nil)
@@ -1800,10 +1947,12 @@ we entered `completion-in-region-mode'.")
(defun completion-in-region (start end collection &optional predicate)
"Complete the text between START and END using COLLECTION.
-Return nil if there is no valid completion, else t.
Point needs to be somewhere between START and END.
-PREDICATE (a function called with no arguments) says when to
-exit."
+PREDICATE (a function called with no arguments) says when to exit.
+This calls the function that `completion-in-region-function' specifies
+\(passing the same four arguments that it received) to do the work,
+and returns whatever it does. The return value should be nil
+if there was no valid completion, else t."
(cl-assert (<= start (point)) (<= (point) end))
(funcall completion-in-region-function start end collection predicate))
@@ -1811,32 +1960,27 @@ exit."
(if (memq system-type '(ms-dos windows-nt darwin cygwin))
t nil)
"Non-nil means when reading a file name completion ignores case."
- :group 'minibuffer
:type 'boolean
:version "22.1")
(defun completion--in-region (start end collection &optional predicate)
+ "Default function to use for `completion-in-region-function'.
+Its arguments and return value are as specified for `completion-in-region'.
+This respects the wrapper hook `completion-in-region-functions'."
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
completion-in-region-functions (start end collection predicate)
(let ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate predicate)
- (ol (make-overlay start end nil nil t)))
- (overlay-put ol 'field 'completion)
+ (minibuffer-completion-predicate predicate))
;; HACK: if the text we are completing is already in a field, we
;; want the completion field to take priority (e.g. Bug#6830).
- (overlay-put ol 'priority 100)
(when completion-in-region-mode-predicate
- (completion-in-region-mode 1)
(setq completion-in-region--data
- (list (if (markerp start) start (copy-marker start))
- (copy-marker end) collection)))
- ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
- ;; than the other way around!
- (unwind-protect
- (call-interactively 'minibuffer-complete)
- (delete-overlay ol)))))
+ `(,(if (markerp start) start (copy-marker start))
+ ,(copy-marker end t) ,collection ,predicate))
+ (completion-in-region-mode 1))
+ (completion--in-region-1 start end))))
(defvar completion-in-region-mode-map
(let ((map (make-sparse-keymap)))
@@ -1848,7 +1992,7 @@ exit."
"Keymap activated during `completion-in-region'.")
;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
-;; the *Completions*).
+;; the *Completions*). Here's how previous packages did it:
;; - lisp-mode: never.
;; - comint: only do it if you hit SPC at the right time.
;; - pcomplete: pop it down on SPC or after some time-delay.
@@ -1869,22 +2013,25 @@ exit."
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
+(defvar completion-in-region-mode nil) ;Explicit defvar, i.s.o defcustom.
+
(define-minor-mode completion-in-region-mode
- "Transient minor mode used during `completion-in-region'.
-With a prefix argument ARG, enable the modemode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil."
+ "Transient minor mode used during `completion-in-region'."
:global t
:group 'minibuffer
- (setq completion-in-region--data nil)
+ ;; Prevent definition of a custom-variable since it makes no sense to
+ ;; customize this variable.
+ :variable completion-in-region-mode
;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
(remove-hook 'post-command-hook #'completion-in-region--postch)
(setq minor-mode-overriding-map-alist
(delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
minor-mode-overriding-map-alist))
(if (null completion-in-region-mode)
- (unless (equal "*Completions*" (buffer-name (window-buffer)))
- (minibuffer-hide-completions))
+ (progn
+ (setq completion-in-region--data nil)
+ (unless (equal "*Completions*" (buffer-name (window-buffer)))
+ (minibuffer-hide-completions)))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
(cl-assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
@@ -1901,7 +2048,7 @@ the mode if ARG is omitted or nil."
(defvar completion-at-point-functions '(tags-completion-at-point-function)
"Special hook to find the completion table for the thing at point.
-Each function on this hook is called in turns without any argument and should
+Each function on this hook is called in turn without any argument and should
return either nil to mean that it is not applicable at point,
or a function of no argument to perform completion (discouraged),
or a list of the form (START END COLLECTION . PROPS) where
@@ -1980,7 +2127,11 @@ The completion method is determined by `completion-at-point-functions'."
(completion-in-region start end collection
(plist-get plist :predicate))))
;; Maybe completion already happened and the function returned t.
- (_ (cdr res)))))
+ (_
+ (when (cdr res)
+ (message "Warning: %S failed to return valid completion data!"
+ (car res)))
+ (cdr res)))))
(defun completion-help-at-point ()
"Display the completions on the text around point.
@@ -2001,19 +2152,15 @@ The completion method is determined by `completion-at-point-functions'."
(lambda ()
;; We're still in the same completion field.
(let ((newstart (car-safe (funcall hookfun))))
- (and newstart (= newstart start)))))
- (ol (make-overlay start end nil nil t)))
+ (and newstart (= newstart start))))))
;; FIXME: We should somehow (ab)use completion-in-region-function or
;; introduce a corresponding hook (plus another for word-completion,
;; and another for force-completion, maybe?).
- (overlay-put ol 'field 'completion)
- (overlay-put ol 'priority 100)
- (completion-in-region-mode 1)
(setq completion-in-region--data
- (list start (copy-marker end) collection))
- (unwind-protect
- (call-interactively 'minibuffer-completion-help)
- (delete-overlay ol))))
+ `(,start ,(copy-marker end t) ,collection
+ ,(plist-get plist :predicate)))
+ (completion-in-region-mode 1)
+ (minibuffer-completion-help start end)))
(`(,hookfun . ,_)
;; The hook function already performed completion :-(
;; Not much we can do at this point.
@@ -2246,8 +2393,7 @@ same as `substitute-in-file-name'."
;; - Cygwin (substitute-in-file-name "C:\bin") => "/usr/bin"
;; (substitute-in-file-name "C:\") => "/"
;; (substitute-in-file-name "C:\bi") => "/bi"
- (let* ((non-essential t)
- (ustr (substitute-in-file-name qstr))
+ (let* ((ustr (substitute-in-file-name qstr))
(uprefix (substring ustr 0 upos))
qprefix)
;; Main assumption: nothing after qpos should affect the text before upos,
@@ -2309,7 +2455,6 @@ the minibuffer empty.
For some commands, exiting with an empty minibuffer has a special meaning,
such as making the current buffer visit no file in the case of
`set-visited-file-name'."
- :group 'minibuffer
:type 'boolean)
;; Not always defined, but only called if next-read-file-uses-dialog-p says so.
@@ -2344,7 +2489,7 @@ such as making the current buffer visit no file in the case of
(defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
"Read file name, prompting with PROMPT and completing in directory DIR.
-Value is not expanded---you must call `expand-file-name' yourself.
+The return value is not expanded---you must call `expand-file-name' yourself.
DIR is the directory to use for completing relative file names.
It should be an absolute directory name, or nil (which means the
@@ -2430,7 +2575,7 @@ and `read-file-name-function'."
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
See `read-file-name' for the meaning of the arguments."
- (unless dir (setq dir default-directory))
+ (unless dir (setq dir (or default-directory "~/")))
(unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
(unless default-filename
(setq default-filename (if initial (expand-file-name initial dir)
@@ -2702,12 +2847,11 @@ expression (not containing character ranges like `a-z')."
;; Refresh other vars.
(completion-pcm--prepare-delim-re value))
:initialize 'custom-initialize-reset
- :group 'minibuffer
:type 'string)
(defcustom completion-pcm-complete-word-inserts-delimiters nil
"Treat the SPC or - inserted by `minibuffer-complete-word' as delimiters.
-Those chars are treated as delimiters iff this variable is non-nil.
+Those chars are treated as delimiters if this variable is non-nil.
I.e. if non-nil, M-x SPC will just insert a \"-\" in the minibuffer, whereas
if nil, it will list all possible commands in *Completions* because none of
the commands start with a \"-\" or a SPC."
@@ -2735,7 +2879,8 @@ or a symbol, see `completion-pcm--merge-completions'."
(completion-pcm--string->pattern suffix)))
(let* ((pattern nil)
(p 0)
- (p0 p))
+ (p0 p)
+ (pending nil))
(while (and (setq p (string-match completion-pcm--delim-wild-regex
string p))
@@ -2752,18 +2897,49 @@ or a symbol, see `completion-pcm--merge-completions'."
;; This is determined by the presence of a submatch-1 which delimits
;; the prefix.
(if (match-end 1) (setq p (match-end 1)))
- (push (substring string p0 p) pattern)
+ (unless (= p0 p)
+ (if pending (push pending pattern))
+ (push (substring string p0 p) pattern))
+ (setq pending nil)
(if (eq (aref string p) ?*)
(progn
(push 'star pattern)
(setq p0 (1+ p)))
(push 'any pattern)
- (setq p0 p))
- (cl-incf p))
-
+ (if (match-end 1)
+ (setq p0 p)
+ (push (substring string p (match-end 0)) pattern)
+ ;; `any-delim' is used so that "a-b" also finds "array->beginning".
+ (setq pending 'any-delim)
+ (setq p0 (match-end 0))))
+ (setq p p0))
+
+ (when (> (length string) p0)
+ (if pending (push pending pattern))
+ (push (substring string p0) pattern))
;; An empty string might be erroneously added at the beginning.
;; It should be avoided properly, but it's so easy to remove it here.
- (delete "" (nreverse (cons (substring string p0) pattern))))))
+ (delete "" (nreverse pattern)))))
+
+(defun completion-pcm--optimize-pattern (p)
+ ;; Remove empty strings in a separate phase since otherwise a ""
+ ;; might prevent some other optimization, as in '(any "" any).
+ (setq p (delete "" p))
+ (let ((n '()))
+ (while p
+ (pcase p
+ (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest)
+ (setq p (cons (concat s1 s2) rest)))
+ (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_)
+ (setq p (cdr p)))
+ (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest)))
+ (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest)))
+ (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest)))
+ (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest)))
+ (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest)))
+ (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
+ (_ (push (pop p) n))))
+ (nreverse n)))
(defun completion-pcm--pattern->regex (pattern &optional group)
(let ((re
@@ -2772,8 +2948,13 @@ or a symbol, see `completion-pcm--merge-completions'."
(lambda (x)
(cond
((stringp x) (regexp-quote x))
- ((if (consp group) (memq x group) group) "\\(.*?\\)")
- (t ".*?")))
+ (t
+ (let ((re (if (eq x 'any-delim)
+ (concat completion-pcm--delim-wild-regex "*?")
+ ".*?")))
+ (if (if (consp group) (memq x group) group)
+ (concat "\\(" re "\\)")
+ re)))))
pattern
""))))
;; Avoid pathological backtracking.
@@ -2847,11 +3028,11 @@ filter out additional entries (because TABLE might not obey PRED)."
(setq string (substring string (car bounds) (+ point (cdr bounds))))
(let* ((relpoint (- point (car bounds)))
(pattern (completion-pcm--string->pattern string relpoint))
- (all (condition-case err
+ (all (condition-case-unless-debug err
(funcall filter
(completion-pcm--all-completions
prefix pattern table pred))
- (error (unless firsterror (setq firsterror err)) nil))))
+ (error (setq firsterror err) nil))))
(when (and (null all)
(> (car bounds) 0)
(null (ignore-errors (try-completion prefix table pred))))
@@ -2930,16 +3111,9 @@ filter out additional entries (because TABLE might not obey PRED)."
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
-(defun completion--sreverse (str)
- "Like `reverse' but for a string STR rather than a list."
- (apply #'string (nreverse (mapcar 'identity str))))
-
(defun completion--common-suffix (strs)
"Return the common suffix of the strings STRS."
- (completion--sreverse
- (try-completion
- ""
- (mapcar #'completion--sreverse strs))))
+ (nreverse (try-completion "" (mapcar #'reverse strs))))
(defun completion-pcm--merge-completions (strs pattern)
"Extract the commonality in STRS, with the help of PATTERN.
@@ -3089,11 +3263,20 @@ the same set of elements."
;; Not `prefix'.
mergedpat))
;; New pos from the start.
- (newpos (length (completion-pcm--pattern->string pointpat)))
+ (newpos (length (completion-pcm--pattern->string pointpat)))
;; Do it afterwards because it changes `pointpat' by side effect.
(merged (completion-pcm--pattern->string (nreverse mergedpat))))
- (setq suffix (completion--merge-suffix merged newpos suffix))
+ (setq suffix (completion--merge-suffix
+ ;; The second arg should ideally be "the position right
+ ;; after the last char of `merged' that comes from the text
+ ;; to be completed". But completion-pcm--merge-completions
+ ;; currently doesn't give us that info. So instead we just
+ ;; use the "last but one" position, which tends to work
+ ;; well in practice since `suffix' always starts
+ ;; with a boundary and we hence mostly/only care about
+ ;; merging this boundary (bug#15419).
+ merged (max 0 (1- (length merged))) suffix))
(cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
(defun completion-pcm-try-completion (string table pred point)
@@ -3148,6 +3331,7 @@ the same set of elements."
(string-match completion-pcm--delim-wild-regex str
(car bounds)))
(if (zerop (car bounds))
+ ;; FIXME: Don't hardcode "-" (bug#17559).
(mapconcat 'string str "-")
;; If there's a boundary, it's trickier. The main use-case
;; we consider here is file-name completion. We'd like
diff --git a/lisp/misc.el b/lisp/misc.el
index 8da289cb803..91ddd429f88 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -1,8 +1,8 @@
;;; misc.el --- some nonstandard editing and utility commands for Emacs
-;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; Package: emacs
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 0c4cd4ea323..157b04d8a9e 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -1,6 +1,6 @@
;;; misearch.el --- isearch extensions for multi-buffer search
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Juri Linkov <juri@jurta.org>
;; Keywords: matching
@@ -91,6 +91,14 @@ Isearch starts.")
"The buffer where the search is currently searching.
The value is nil when the search still is in the initial buffer.")
+;;;###autoload
+(defvar multi-isearch-buffer-list nil
+ "Sequence of buffers visited by multiple buffers Isearch.
+This is nil if Isearch is not currently searching more than one buffer.")
+;;;###autoload
+(defvar multi-isearch-file-list nil
+ "Sequence of files visited by multiple file buffers Isearch.")
+
(defvar multi-isearch-orig-search-fun nil)
(defvar multi-isearch-orig-wrap nil)
(defvar multi-isearch-orig-push-state nil)
@@ -119,7 +127,9 @@ Intended to be added to `isearch-mode-hook'."
(defun multi-isearch-end ()
"Clean up the multi-buffer search after terminating isearch."
(setq multi-isearch-current-buffer nil
- multi-isearch-next-buffer-current-function nil)
+ multi-isearch-next-buffer-current-function nil
+ multi-isearch-buffer-list nil
+ multi-isearch-file-list nil)
(setq-default isearch-search-fun-function multi-isearch-orig-search-fun
isearch-wrap-function multi-isearch-orig-wrap
isearch-push-state-function multi-isearch-orig-push-state)
@@ -204,8 +214,6 @@ Switch to the buffer restored from the search status stack."
;;; Global multi-buffer search invocations
-(defvar multi-isearch-buffer-list nil)
-
(defun multi-isearch-next-buffer-from-list (&optional buffer wrap)
"Return the next buffer in the series of buffers.
This function is used for multiple buffers Isearch. A sequence of
@@ -229,7 +237,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
(setq buf (read-buffer
- (if (eq read-buffer-function 'ido-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))
@@ -239,7 +247,8 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'."
(nreverse bufs)))
(defun multi-isearch-read-matching-buffers ()
- "Return a list of buffers whose names match specified regexp."
+ "Return a list of buffers whose names match specified regexp.
+Uses `read-regexp' to read the regexp."
;; Most code from `multi-occur-in-matching-buffers'
;; and `kill-matching-buffers'.
(let ((bufregexp
@@ -262,11 +271,11 @@ whose names match the specified regexp."
(multi-isearch-read-matching-buffers)
(multi-isearch-read-buffers))))
(let ((multi-isearch-next-buffer-function
- 'multi-isearch-next-buffer-from-list)
- (multi-isearch-buffer-list (mapcar #'get-buffer buffers)))
+ 'multi-isearch-next-buffer-from-list))
+ (setq multi-isearch-buffer-list (mapcar #'get-buffer buffers))
(switch-to-buffer (car multi-isearch-buffer-list))
(goto-char (if isearch-forward (point-min) (point-max)))
- (isearch-forward)))
+ (isearch-forward nil t)))
;;;###autoload
(defun multi-isearch-buffers-regexp (buffers)
@@ -280,17 +289,15 @@ whose names match the specified regexp."
(multi-isearch-read-matching-buffers)
(multi-isearch-read-buffers))))
(let ((multi-isearch-next-buffer-function
- 'multi-isearch-next-buffer-from-list)
- (multi-isearch-buffer-list (mapcar #'get-buffer buffers)))
+ 'multi-isearch-next-buffer-from-list))
+ (setq multi-isearch-buffer-list (mapcar #'get-buffer buffers))
(switch-to-buffer (car multi-isearch-buffer-list))
(goto-char (if isearch-forward (point-min) (point-max)))
- (isearch-forward-regexp)))
+ (isearch-forward-regexp nil t)))
;;; Global multi-file search invocations
-(defvar multi-isearch-file-list nil)
-
(defun multi-isearch-next-file-buffer-from-list (&optional buffer wrap)
"Return the next buffer in the series of file buffers.
This function is used for multiple file buffers Isearch. A sequence
@@ -322,8 +329,10 @@ Every next/previous file in the defined sequence is visited by
(add-to-list 'files file))
(nreverse files)))
+;; A regexp is not the same thing as a file glob - does this matter?
(defun multi-isearch-read-matching-files ()
- "Return a list of files whose names match specified wildcard."
+ "Return a list of files whose names match specified wildcard.
+Uses `read-regexp' to read the wildcard."
;; Most wildcard code from `find-file-noselect'.
(let ((filename (read-regexp "Search in files whose names match wildcard")))
(when (and filename
@@ -346,11 +355,11 @@ whose file names match the specified wildcard."
(multi-isearch-read-matching-files)
(multi-isearch-read-files))))
(let ((multi-isearch-next-buffer-function
- 'multi-isearch-next-file-buffer-from-list)
- (multi-isearch-file-list (mapcar #'expand-file-name files)))
+ 'multi-isearch-next-file-buffer-from-list))
+ (setq multi-isearch-file-list (mapcar #'expand-file-name files))
(find-file (car multi-isearch-file-list))
(goto-char (if isearch-forward (point-min) (point-max)))
- (isearch-forward)))
+ (isearch-forward nil t)))
;;;###autoload
(defun multi-isearch-files-regexp (files)
@@ -365,11 +374,32 @@ whose file names match the specified wildcard."
(multi-isearch-read-matching-files)
(multi-isearch-read-files))))
(let ((multi-isearch-next-buffer-function
- 'multi-isearch-next-file-buffer-from-list)
- (multi-isearch-file-list (mapcar #'expand-file-name files)))
+ 'multi-isearch-next-file-buffer-from-list))
+ (setq multi-isearch-file-list (mapcar #'expand-file-name files))
(find-file (car multi-isearch-file-list))
(goto-char (if isearch-forward (point-min) (point-max)))
- (isearch-forward-regexp)))
+ (isearch-forward-regexp nil t)))
+
+(defvar unload-function-defs-list)
+
+(defun multi-isearch-unload-function ()
+ "Remove autoloaded variables from `unload-function-defs-list'.
+Also prevent the feature from being reloaded via `isearch-mode-hook'."
+ (remove-hook 'isearch-mode-hook 'multi-isearch-setup)
+ (let ((defs (list (car unload-function-defs-list)))
+ (auto '(multi-isearch-next-buffer-function
+ multi-isearch-next-buffer-current-function
+ multi-isearch-current-buffer
+ multi-isearch-buffer-list multi-isearch-file-list)))
+ (dolist (def (cdr unload-function-defs-list))
+ (unless (and (symbolp def)
+ (memq def auto))
+ (push def defs)))
+ (setq unload-function-defs-list (nreverse defs))
+ ;; .
+ nil))
+
+(defalias 'misearch-unload-function 'multi-isearch-unload-function)
(provide 'multi-isearch)
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index e20c5908f0a..6198a125433 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -1,6 +1,6 @@
;;; mouse-copy.el --- one-click text copy and move
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
@@ -147,14 +147,14 @@ If you have the bug (or the real fix :-), please let me know."
;; Third, set the selection.
;; (setq me-beg beg me-end end me-range range) ; for debugging
(set-buffer end-buffer)
- (x-set-selection 'SECONDARY (buffer-substring beg end)))))
+ (gui-set-selection 'SECONDARY (buffer-substring beg end)))))
(defun mouse-drag-secondary-pasting (start-event)
"Drag out a secondary selection, then paste it at the current point.
To test this function, evaluate:
- (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
+ (global-set-key [M-down-mouse-1] \\='mouse-drag-secondary-pasting)
put the point at one place, then click and drag over some other region."
(interactive "e")
;; Work-around: We see and react to each part of a multi-click event
@@ -177,7 +177,7 @@ put the point at one place, then click and drag over some other region."
(mouse-copy-work-around-drag-bug start-event last-input-event))
;; Remember what we do so we can undo it, if necessary.
(setq mouse-copy-last-paste-start (point))
- (insert (x-get-selection 'SECONDARY))
+ (insert (gui-get-selection 'SECONDARY))
(setq mouse-copy-last-paste-end (point)))
(setq mouse-copy-last-paste-start nil)))
@@ -203,7 +203,7 @@ by johnh@ficus.cs.ucla.edu."
(kill-region (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))
;; (delete-overlay mouse-secondary-overlay)
- ;; (x-set-selection 'SECONDARY nil)
+ ;; (gui-set-selection 'SECONDARY nil)
;; (setq mouse-secondary-overlay nil)
)
@@ -216,7 +216,7 @@ by johnh@ficus.cs.ucla.edu."
(if (mouse-drag-secondary start-event)
(progn
(mouse-kill-preserving-secondary)
- (insert (x-get-selection 'SECONDARY))))
+ (insert (gui-get-selection 'SECONDARY))))
)
(provide 'mouse-copy)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index 009cc2efe1a..2b61096d86b 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -1,6 +1,6 @@
;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
-;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: John Heidemann <johnh@ISI.EDU>
;; Keywords: mouse
@@ -206,7 +206,7 @@ about which direction is natural. Perhaps it has to do with which
hemisphere you're in.)
To test this function, evaluate:
- (global-set-key [down-mouse-2] 'mouse-drag-throw)"
+ (global-set-key [down-mouse-2] \\='mouse-drag-throw)"
(interactive "e")
;; we want to do save-selected-window, but that requires 19.29
(let* ((start-posn (event-start start-event))
@@ -222,6 +222,8 @@ To test this function, evaluate:
(col-scrolling-p (mouse-drag-should-do-col-scrolling)))
(select-window start-window)
(track-mouse
+ ;; Don't change the mouse pointer shape while we drag.
+ (setq track-mouse 'dragging)
(while (progn
(setq event (read-event)
end (event-end event)
@@ -264,7 +266,7 @@ Drag scrolling is identical to the \"hand\" option in MacPaint, or the
middle button in Tk text widgets.
To test this function, evaluate:
- (global-set-key [down-mouse-2] 'mouse-drag-drag)"
+ (global-set-key [down-mouse-2] \\='mouse-drag-drag)"
(interactive "e")
;; we want to do save-selected-window, but that requires 19.29
(let* ((start-posn (event-start start-event))
@@ -291,7 +293,7 @@ To test this function, evaluate:
(or (mouse-movement-p event)
(eq (car-safe event) 'switch-frame)))
;; Scroll if see if we're on the edge.
- ;; NEEDSWORK: should handle mouse-in-other window.
+ ;; FIXME: should handle mouse-in-other window.
(cond
((not (eq start-window (posn-window end)))
t) ; wait for return to original window
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0367cad87b8..d6ce31a7a53 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1,8 +1,8 @@
;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1995, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware, mouse
;; Package: emacs
@@ -26,8 +26,6 @@
;; This package provides various useful commands (including help
;; system access) through the mouse. All this code assumes that mouse
;; interpretation has been abstracted into Emacs input events.
-;;
-;; The code is rather X-dependent.
;;; Code:
@@ -96,17 +94,15 @@ point at the click position."
(defun mouse--down-1-maybe-follows-link (&optional _prompt)
"Turn `mouse-1' events into `mouse-2' events if follows-link.
Expects to be bound to `down-mouse-1' in `key-translation-map'."
- (if (or (null mouse-1-click-follows-link)
- (not (eq (if (eq mouse-1-click-follows-link 'double)
- 'double-down-mouse-1 'down-mouse-1)
- (car-safe last-input-event)))
- (not (mouse-on-link-p (event-start last-input-event)))
- (and (not mouse-1-click-in-non-selected-windows)
- (not (eq (selected-window)
- (posn-window (event-start last-input-event))))))
- nil
- (let ((this-event last-input-event)
- (timedout
+ (when (and mouse-1-click-follows-link
+ (eq (if (eq mouse-1-click-follows-link 'double)
+ 'double-down-mouse-1 'down-mouse-1)
+ (car-safe last-input-event))
+ (mouse-on-link-p (event-start last-input-event))
+ (or mouse-1-click-in-non-selected-windows
+ (eq (selected-window)
+ (posn-window (event-start last-input-event)))))
+ (let ((timedout
(sit-for (if (numberp mouse-1-click-follows-link)
(/ (abs mouse-1-click-follows-link) 1000.0)
0))))
@@ -115,24 +111,19 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'."
timedout (not timedout))
nil
- (let ((event (read-event)))
+ (let ((event (read-key))) ;Use read-key so it works for xterm-mouse-mode!
(if (eq (car-safe event) (if (eq mouse-1-click-follows-link 'double)
'double-mouse-1 'mouse-1))
;; Turn the mouse-1 into a mouse-2 to follow links.
(let ((newup (if (eq mouse-1-click-follows-link 'double)
- 'double-mouse-2 'mouse-2))
- (newdown (if (eq mouse-1-click-follows-link 'double)
- 'double-down-mouse-2 'down-mouse-2)))
+ 'double-mouse-2 'mouse-2)))
;; If mouse-2 has never been done by the user, it doesn't have
;; the necessary property to be interpreted correctly.
- (put newup 'event-kind (get (car event) 'event-kind))
- (put newdown 'event-kind (get (car this-event) 'event-kind))
+ (unless (get newup 'event-kind)
+ (put newup 'event-kind (get (car event) 'event-kind)))
(push (cons newup (cdr event)) unread-command-events)
- ;; Modify the event in place, so read-key-sequence doesn't
- ;; generate a second fake prefix key (see fake_prefixed_keys in
- ;; src/keyboard.c).
- (setcar this-event newdown)
- (vector this-event))
+ ;; Don't change the down event, only the up-event (bug#18212).
+ nil)
(push event unread-command-events)
nil))))))
@@ -144,79 +135,6 @@ Expects to be bound to `down-mouse-1' in `key-translation-map'."
;; Provide a mode-specific menu on a mouse button.
-(defun popup-menu (menu &optional position prefix)
- "Popup the given menu and call the selected option.
-MENU can be a keymap, an easymenu-style menu or a list of keymaps as for
-`x-popup-menu'.
-The menu is shown at the place where POSITION specifies. About
-the form of POSITION, see `popup-menu-normalize-position'.
-PREFIX is the prefix argument (if any) to pass to the command."
- (let* ((map (cond
- ((keymapp menu) menu)
- ((and (listp menu) (keymapp (car menu))) menu)
- (t (let* ((map (easy-menu-create-menu (car menu) (cdr menu)))
- (filter (when (symbolp map)
- (plist-get (get map 'menu-prop) :filter))))
- (if filter (funcall filter (symbol-function map)) map)))))
- event cmd
- (position (popup-menu-normalize-position position)))
- ;; The looping behavior was taken from lmenu's popup-menu-popup
- (while (and map (setq event
- ;; map could be a prefix key, in which case
- ;; we need to get its function cell
- ;; definition.
- (x-popup-menu position (indirect-function map))))
- ;; Strangely x-popup-menu returns a list.
- ;; mouse-major-mode-menu was using a weird:
- ;; (key-binding (apply 'vector (append '(menu-bar) menu-prefix events)))
- (setq cmd
- (if (and (not (keymapp map)) (listp map))
- ;; We were given a list of keymaps. Search them all
- ;; in sequence until a first binding is found.
- (let ((mouse-click (apply 'vector event))
- binding)
- (while (and map (null binding))
- (setq binding (lookup-key (car map) mouse-click))
- (if (numberp binding) ; `too long'
- (setq binding nil))
- (setq map (cdr map)))
- binding)
- ;; We were given a single keymap.
- (lookup-key map (apply 'vector event))))
- ;; Clear out echoing, which perhaps shows a prefix arg.
- (message "")
- ;; Maybe try again but with the submap.
- (setq map (if (keymapp cmd) cmd)))
- ;; If the user did not cancel by refusing to select,
- ;; and if the result is a command, run it.
- (when (and (null map) (commandp cmd))
- (setq prefix-arg prefix)
- ;; `setup-specified-language-environment', for instance,
- ;; expects this to be set from a menu keymap.
- (setq last-command-event (car (last event)))
- ;; mouse-major-mode-menu was using `command-execute' instead.
- (call-interactively cmd))))
-
-(defun popup-menu-normalize-position (position)
- "Convert the POSITION to the form which `popup-menu' expects internally.
-POSITION can an event, a posn- value, a value having
-form ((XOFFSET YOFFSET) WINDOW), or nil.
-If nil, the current mouse position is used."
- (pcase position
- ;; nil -> mouse cursor position
- (`nil
- (let ((mp (mouse-pixel-position)))
- (list (list (cadr mp) (cddr mp)) (car mp))))
- ;; Value returned from `event-end' or `posn-at-point'.
- ((pred posnp)
- (let ((xy (posn-x-y position)))
- (list (list (car xy) (cdr xy))
- (posn-window position))))
- ;; Event.
- ((pred eventp)
- (popup-menu-normalize-position (event-end position)))
- (t position)))
-
(defun minor-mode-menu-from-indicator (indicator)
"Show menu for minor mode specified by INDICATOR.
Interactively, INDICATOR is read using completion.
@@ -234,13 +152,16 @@ items `Turn Off' and `Help'."
(setq menu
(if menu
(mouse-menu-non-singleton menu)
- `(keymap
- ,indicator
- (turn-off menu-item "Turn Off minor mode" ,mm-fun)
- (help menu-item "Help for minor mode"
- (lambda () (interactive)
- (describe-function ',mm-fun))))))
- (popup-menu menu))))
+ (if (fboundp mm-fun) ; bug#20201
+ `(keymap
+ ,indicator
+ (turn-off menu-item "Turn Off minor mode" ,mm-fun)
+ (help menu-item "Help for minor mode"
+ (lambda () (interactive)
+ (describe-function ',mm-fun)))))))
+ (if menu
+ (popup-menu menu)
+ (message "No menu available")))))
(defun mouse-minor-mode-menu (event)
"Show minor-mode menu for EVENT on minor modes area of the mode line."
@@ -388,13 +309,14 @@ This command must be bound to a mouse click."
(or (eq frame oframe)
(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
-(defun mouse-tear-off-window (click)
- "Delete the window clicked on, and create a new frame displaying its buffer."
+(define-obsolete-function-alias 'mouse-tear-off-window 'tear-off-window "24.4")
+(defun tear-off-window (click)
+ "Delete the selected window, and create a new frame displaying its buffer."
(interactive "e")
(mouse-minibuffer-check click)
(let* ((window (posn-window (event-start click)))
(buf (window-buffer window))
- (frame (make-frame)))
+ (frame (make-frame))) ;FIXME: Use pop-to-buffer.
(select-frame frame)
(switch-to-buffer buf)
(delete-window window)))
@@ -416,9 +338,12 @@ This command must be bound to a mouse click."
(first-line window-min-height)
(last-line (- (window-height) window-min-height)))
(if (< last-line first-line)
- (error "Window too short to split")
- (split-window-vertically
- (min (max new-height first-line) last-line))))))
+ (user-error "Window too short to split")
+ ;; Bind `window-combination-resize' to nil so we are sure to get
+ ;; the split right at the line clicked on.
+ (let (window-combination-resize)
+ (split-window-vertically
+ (min (max new-height first-line) last-line)))))))
(defun mouse-split-window-horizontally (click)
"Select Emacs window mouse is on, then split it horizontally in half.
@@ -432,27 +357,12 @@ This command must be bound to a mouse click."
(first-col window-min-width)
(last-col (- (window-width) window-min-width)))
(if (< last-col first-col)
- (error "Window too narrow to split")
- (split-window-horizontally
- (min (max new-width first-col) last-col))))))
-
-;; `mouse-drag-line' is now the common routine for handling all line
-;; dragging events combining the earlier `mouse-drag-mode-line-1' and
-;; `mouse-drag-vertical-line'. It should improve the behavior of line
-;; dragging wrt Emacs 23 as follows:
-
-;; (1) Gratuitous error messages and restrictions have been (hopefully)
-;; removed. (The help-echo that dragging the mode-line can resize a
-;; one-window-frame's window will still show through via bindings.el.)
-
-;; (2) No gratuitous selection of other windows should happen. (This
-;; has not been completely fixed for mouse-autoselected windows yet.)
-
-;; (3) Mouse clicks below a scroll-bar should pass through via unread
-;; command events.
-
-;; Note that `window-in-direction' replaces `mouse-drag-window-above'
-;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1.
+ (user-error "Window too narrow to split")
+ ;; Bind `window-combination-resize' to nil so we are sure to get
+ ;; the split right at the column clicked on.
+ (let (window-combination-resize)
+ (split-window-horizontally
+ (min (max new-width first-col) last-col)))))))
(defun mouse-drag-line (start-event line)
"Drag a mode line, header line, or vertical line with the mouse.
@@ -464,95 +374,139 @@ must be one of the symbols `header', `mode', or `vertical'."
(start (event-start start-event))
(window (posn-window start))
(frame (window-frame window))
- (minibuffer-window (minibuffer-window frame))
- (side (and (eq line 'vertical)
- (or (cdr (assq 'vertical-scroll-bars
- (frame-parameters frame)))
- 'right)))
+ ;; `position' records the x- or y-coordinate of the last
+ ;; sampled position.
+ (position (if (eq line 'vertical)
+ (+ (window-pixel-left window)
+ (car (posn-x-y start)))
+ (+ (window-pixel-top window)
+ (cdr (posn-x-y start)))))
+ ;; `last-position' records the x- or y-coordinate of the
+ ;; previously sampled position. The difference of `position'
+ ;; and `last-position' determines the size change of WINDOW.
+ (last-position position)
(draggable t)
- event position growth dragged)
+ posn-window growth dragged)
+ ;; Decide on whether we are allowed to track at all and whose
+ ;; window's edge we drag.
(cond
((eq line 'header)
- ;; Check whether header-line can be dragged at all.
(if (window-at-side-p window 'top)
+ ;; We can't drag the header line of a topmost window.
(setq draggable nil)
+ ;; Drag bottom edge of window above the header line.
(setq window (window-in-direction 'above window t))))
((eq line 'mode)
- ;; Check whether mode-line can be dragged at all.
- (and (window-at-side-p window 'bottom)
- ;; Allow resizing the minibuffer window if it's on the same
- ;; frame as and immediately below the clicked window, and
- ;; it's active or `resize-mini-windows' is nil.
- (not (and (eq (window-frame minibuffer-window) frame)
- (= (nth 1 (window-edges minibuffer-window))
- (nth 3 (window-edges window)))
- (or (not resize-mini-windows)
- (eq minibuffer-window
- (active-minibuffer-window)))))
- (setq draggable nil)))
- ((eq line 'vertical)
- ;; Get the window to adjust for the vertical case. If the
- ;; scroll bar is on the window's right or there's no scroll bar
- ;; at all, adjust the window where the start-event occurred. If
- ;; the scroll bar is on the start-event window's left, adjust
- ;; the window on the left of it.
- (unless (eq side 'right)
- (setq window (window-in-direction 'left window t)))))
-
- ;; Start tracking.
- (track-mouse
- ;; Loop reading events and sampling the position of the mouse,
- ;; until there is a non-mouse-movement event. Also,
- ;; scroll-bar-movement events are the same as mouse movement for
- ;; our purposes. (Why? -- cyd)
- ;; If you change this, check that all of the following still work:
- ;; Resizing windows by dragging mode-lines and header lines,
- ;; and vertical lines (in windows without scroll bars).
- ;; Doing this should not select another window, even if
- ;; mouse-autoselect-window is non-nil.
- ;; Mouse-1 clicks in Info header lines should advance position
- ;; by one node at a time if mouse-1-click-follows-link is non-nil,
- ;; otherwise they should just select the window.
- (while (progn
- (setq event (read-event))
- (memq (car-safe event)
- '(mouse-movement scroll-bar-movement
- switch-frame select-window)))
- (setq position (mouse-position))
- ;; Do nothing if
- ;; - there is a switch-frame event.
- ;; - the mouse isn't in the frame that we started in
- ;; - the mouse isn't in any Emacs frame
- (cond
- ((memq (car event) '(switch-frame select-window))
- nil)
- ((not (and (eq (car position) frame)
- (cadr position)))
- nil)
- ((eq line 'vertical)
- ;; Drag vertical divider.
- (setq growth (- (cadr position)
- (if (eq side 'right) 0 2)
- (nth 2 (window-edges window))
- -1))
- (unless (zerop growth)
- (setq dragged t))
- (adjust-window-trailing-edge window growth t))
- (draggable
- ;; Drag horizontal divider.
- (setq growth
- (if (eq line 'mode)
- (- (cddr position) (nth 3 (window-edges window)) -1)
- ;; The window's top includes the header line!
- (- (nth 3 (window-edges window)) (cddr position))))
- (unless (zerop growth)
- (setq dragged t))
- (adjust-window-trailing-edge window (if (eq line 'mode)
- growth
- (- growth)))))))
- ;; Process the terminating event.
- (unless dragged
- (push event unread-command-events))))
+ (if (and (window-at-side-p window 'bottom)
+ ;; Allow resizing the minibuffer window if it's on the
+ ;; same frame as and immediately below `window', and it's
+ ;; either active or `resize-mini-windows' is nil.
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (not (and (eq (window-frame minibuffer-window) frame)
+ (or (not resize-mini-windows)
+ (eq minibuffer-window
+ (active-minibuffer-window)))))))
+ (setq draggable nil))))
+
+ (let* ((exitfun nil)
+ (move
+ (lambda (event) (interactive "e")
+ (cond
+ ((not (consp event))
+ nil)
+ ((eq line 'vertical)
+ ;; Drag right edge of `window'.
+ (setq start (event-start event))
+ (setq position (car (posn-x-y start)))
+ ;; Set `posn-window' to the window where `event' was recorded.
+ ;; This can be `window' or the window on the left or right of
+ ;; `window'.
+ (when (window-live-p (setq posn-window (posn-window start)))
+ ;; Add left edge of `posn-window' to `position'.
+ (setq position (+ (window-pixel-left posn-window) position))
+ (unless (nth 1 start)
+ ;; Add width of objects on the left of the text area to
+ ;; `position'.
+ (when (eq (window-current-scroll-bars posn-window) 'left)
+ (setq position (+ (window-scroll-bar-width posn-window)
+ position)))
+ (setq position (+ (car (window-fringes posn-window))
+ (or (car (window-margins posn-window)) 0)
+ position))))
+ ;; When the cursor overshoots after shrinking a window to its
+ ;; minimum size and the dragging direction changes, have the
+ ;; cursor first catch up with the window edge.
+ (unless (or (zerop (setq growth (- position last-position)))
+ (and (> growth 0)
+ (< position (+ (window-pixel-left window)
+ (window-pixel-width window))))
+ (and (< growth 0)
+ (> position (+ (window-pixel-left window)
+ (window-pixel-width window)))))
+ (setq dragged t)
+ (adjust-window-trailing-edge window growth t t))
+ (setq last-position position))
+ (draggable
+ ;; Drag bottom edge of `window'.
+ (setq start (event-start event))
+ ;; Set `posn-window' to the window where `event' was recorded.
+ ;; This can be either `window' or the window above or below of
+ ;; `window'.
+ (setq posn-window (posn-window start))
+ (setq position (cdr (posn-x-y start)))
+ (when (window-live-p posn-window)
+ ;; Add top edge of `posn-window' to `position'.
+ (setq position (+ (window-pixel-top posn-window) position))
+ ;; If necessary, add height of header line to `position'
+ (when (memq (posn-area start)
+ '(nil left-fringe right-fringe left-margin right-margin))
+ (setq position (+ (window-header-line-height posn-window) position))))
+ ;; When the cursor overshoots after shrinking a window to its
+ ;; minimum size and the dragging direction changes, have the
+ ;; cursor first catch up with the window edge.
+ (unless (or (zerop (setq growth (- position last-position)))
+ (and (> growth 0)
+ (< position (+ (window-pixel-top window)
+ (window-pixel-height window))))
+ (and (< growth 0)
+ (> position (+ (window-pixel-top window)
+ (window-pixel-height window)))))
+ (setq dragged t)
+ (adjust-window-trailing-edge window growth nil t))
+ (setq last-position position))))))
+ ;; 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)))
+ ;; For vertical line dragging swallow also a mouse-1
+ ;; event (but only if we dragged at least once to allow mouse-1
+ ;; clicks to get through).
+ (when (eq line 'vertical)
+ (define-key map [mouse-1]
+ `(menu-item "" ,(lambda () (interactive) (funcall exitfun))
+ :filter ,(lambda (cmd) (if dragged cmd)))))
+ ;; 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 nil)))))))
(defun mouse-drag-mode-line (start-event)
"Change the height of a window by dragging on the mode line."
@@ -569,14 +523,18 @@ must be one of the symbols `header', `mode', or `vertical'."
(interactive "e")
(mouse-drag-line start-event 'vertical))
-(defun mouse-set-point (event)
+(defun mouse-set-point (event &optional promote-to-region)
"Move point to the position clicked on with the mouse.
-This should be bound to a mouse click event type."
- (interactive "e")
+This should be bound to a mouse click event type.
+If PROMOTE-TO-REGION is non-nil and event is a multiple-click,
+select the corresponding element around point."
+ (interactive "e\np")
(mouse-minibuffer-check event)
- ;; Use event-end in case called from mouse-drag-region.
- ;; If EVENT is a click, event-end and event-start give same value.
- (posn-set-point (event-end event)))
+ (if (and promote-to-region (> (event-click-count event) 1))
+ (mouse-set-region event)
+ ;; Use event-end in case called from mouse-drag-region.
+ ;; If EVENT is a click, event-end and event-start give same value.
+ (posn-set-point (event-end event))))
(defvar mouse-last-region-beg nil)
(defvar mouse-last-region-end nil)
@@ -589,6 +547,8 @@ This should be bound to a mouse click event type."
(eq mouse-last-region-end (region-end))
(eq mouse-last-region-tick (buffer-modified-tick))))
+(defvar mouse--drag-start-event nil)
+
(defun mouse-set-region (click)
"Set the region to the text dragged over, and copy to kill ring.
This should be bound to a mouse drag event.
@@ -598,7 +558,29 @@ command alters the kill ring or not."
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
(let ((beg (posn-point (event-start click)))
- (end (posn-point (event-end click))))
+ (end (posn-point (event-end click)))
+ (click-count (event-click-count click)))
+ (let ((drag-start (terminal-parameter nil 'mouse-drag-start)))
+ (when drag-start
+ ;; Drag events don't come with a click count, sadly, so we hack
+ ;; our way around this problem by remembering the start-event in
+ ;; `mouse-drag-start' and fetching the click-count from there.
+ (when (and (<= click-count 1)
+ (equal beg (posn-point (event-start drag-start))))
+ (setq click-count (event-click-count drag-start)))
+ ;; Occasionally we get spurious drag events where the user hasn't
+ ;; dragged his mouse, but instead Emacs has dragged the text under the
+ ;; user's mouse. Try to recover those cases (bug#17562).
+ (when (and (equal (posn-x-y (event-start click))
+ (posn-x-y (event-end click)))
+ (not (eq (car drag-start) 'mouse-movement)))
+ (setq end beg))
+ (setf (terminal-parameter nil 'mouse-drag-start) nil)))
+ (when (and (integerp beg) (integerp end))
+ (let ((range (mouse-start-end beg end (1- click-count))))
+ (if (< end beg)
+ (setq end (nth 0 range) beg (nth 1 range))
+ (setq beg (nth 0 range) end (nth 1 range)))))
(and mouse-drag-copy-region (integerp beg) (integerp end)
;; Don't set this-command to `kill-region', so a following
;; C-w won't double the text in the kill ring. Ignore
@@ -618,10 +600,10 @@ command alters the kill ring or not."
(defun mouse-set-region-1 ()
;; Set transient-mark-mode for a little while.
(unless (eq (car-safe transient-mark-mode) 'only)
- (setq transient-mark-mode
- (cons 'only
- (unless (eq transient-mark-mode 'lambda)
- transient-mark-mode))))
+ (setq-local transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode))))
(setq mouse-last-region-beg (region-beginning))
(setq mouse-last-region-end (region-end))
(setq mouse-last-region-tick (buffer-modified-tick)))
@@ -692,13 +674,11 @@ Upon exit, point is at the far edge of the newly visible text."
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event.
In Transient Mark mode, the highlighting remains as long as the mark
-remains active. Otherwise, it remains until the next input event.
-
-If the click is in the echo area, display the `*Messages*' buffer."
+remains active. Otherwise, it remains until the next input event."
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (mouse-drag-track start-event t))
+ (mouse-drag-track start-event))
(defun mouse-posn-property (pos property)
@@ -715,7 +695,11 @@ its value is returned."
(str (posn-string pos)))
(or (and str
(get-text-property (cdr str) property (car str)))
- (and pt
+ ;; Mouse clicks in the fringe come with a position in
+ ;; (nth 5). This is useful but is not exactly where we clicked, so
+ ;; don't look up that position's properties!
+ (and pt (not (memq (posn-area pos) '(left-fringe right-fringe
+ left-margin right-margin)))
(get-char-property pt property w))))
(get-char-property pos property)))
@@ -802,12 +786,9 @@ at the same position."
"mouse-1" (substring msg 7)))))))
msg)
-(defun mouse-drag-track (start-event &optional
- do-mouse-drag-region-post-process)
+(defun mouse-drag-track (start-event)
"Track mouse drags by highlighting area between point and cursor.
-The region will be defined with mark and point.
-DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
-`mouse-drag-region'."
+The region will be defined with mark and point."
(mouse-minibuffer-check start-event)
(setq mouse-selection-click-count-buffer (current-buffer))
(deactivate-mark)
@@ -820,8 +801,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(start-posn (event-start start-event))
(start-point (posn-point start-posn))
(start-window (posn-window start-posn))
- (start-window-start (window-start start-window))
- (start-hscroll (window-hscroll start-window))
(bounds (window-edges start-window))
(make-cursor-line-fully-visible nil)
(top (nth 1 bounds))
@@ -832,9 +811,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(click-count (1- (event-click-count start-event)))
;; Suppress automatic hscrolling, because that is a nuisance
;; when setting point near the right fringe (but see below).
- (auto-hscroll-mode-saved auto-hscroll-mode)
- (auto-hscroll-mode nil)
- moved-off-start event end end-point)
+ (auto-hscroll-mode-saved auto-hscroll-mode))
(setq mouse-selection-click-count click-count)
;; In case the down click is in the middle of some intangible text,
@@ -845,93 +822,51 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
;; Activate the region, using `mouse-start-end' to determine where
;; to put point and mark (e.g., double-click will select a word).
- (setq transient-mark-mode
- (if (eq transient-mark-mode 'lambda)
- '(only)
- (cons 'only transient-mark-mode)))
+ (setq-local transient-mark-mode
+ (if (eq transient-mark-mode 'lambda)
+ '(only)
+ (cons 'only transient-mark-mode)))
(let ((range (mouse-start-end start-point start-point click-count)))
(push-mark (nth 0 range) t t)
(goto-char (nth 1 range)))
- ;; Track the mouse until we get a non-movement event.
- (track-mouse
- (while (progn
- (setq event (read-event))
- (or (mouse-movement-p event)
- (memq (car-safe event) '(switch-frame select-window))))
- (unless (memq (car-safe event) '(switch-frame select-window))
- ;; Automatic hscrolling did not occur during the call to
- ;; `read-event'; but if the user subsequently drags the
- ;; mouse, go ahead and hscroll.
- (let ((auto-hscroll-mode auto-hscroll-mode-saved))
- (redisplay))
- (setq end (event-end event)
- end-point (posn-point end))
- ;; Note whether the mouse has left the starting position.
- (unless (eq end-point start-point)
- (setq moved-off-start t))
- (if (and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- (mouse--drag-set-mark-and-point start-point
- end-point click-count)
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)
- nil start-point))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
- nil start-point))))))))
-
- ;; Handle the terminating event if possible.
- (when (consp event)
- ;; Ensure that point is on the end of the last event.
- (when (and (setq end-point (posn-point (event-end event)))
- (eq (posn-window end) start-window)
- (integer-or-marker-p end-point)
- (/= start-point end-point))
- (mouse--drag-set-mark-and-point start-point
- end-point click-count))
-
- ;; Find its binding.
- (let* ((fun (key-binding (vector (car event))))
- ;; FIXME This doesn't make sense, because
- ;; event-click-count always returns something >= 1.
- (do-multi-click (and (> (event-click-count event) 0)
- (functionp fun)
- (not (memq fun '(mouse-set-point
- mouse-set-region))))))
- (if (and (/= (mark) (point))
- (not do-multi-click))
-
- ;; If point has moved, finish the drag.
- (let* (last-command this-command)
- (and mouse-drag-copy-region
- do-mouse-drag-region-post-process
- (let (deactivate-mark)
- (copy-region-as-kill (mark) (point)))))
-
- ;; Otherwise, run binding of terminating up-event.
+ (setf (terminal-parameter nil 'mouse-drag-start) start-event)
+ (setq track-mouse t)
+ (setq auto-hscroll-mode nil)
+
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [mouse-movement]
+ (lambda (event) (interactive "e")
+ (let* ((end (event-end event))
+ (end-point (posn-point end)))
+ (unless (eq end-point start-point)
+ ;; As soon as the user moves, we can re-enable auto-hscroll.
+ (setq auto-hscroll-mode auto-hscroll-mode-saved)
+ ;; And remember that we have moved, so mouse-set-region can know
+ ;; its event is really a drag event.
+ (setcar start-event 'mouse-movement))
+ (if (and (eq (posn-window end) start-window)
+ (integer-or-marker-p end-point))
+ (mouse--drag-set-mark-and-point start-point
+ end-point click-count)
+ (let ((mouse-row (cdr (cdr (mouse-position)))))
+ (cond
+ ((null mouse-row))
+ ((< mouse-row top)
+ (mouse-scroll-subr start-window (- mouse-row top)
+ nil start-point))
+ ((>= mouse-row bottom)
+ (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
+ nil start-point))))))))
+ map)
+ t (lambda ()
+ (setq track-mouse nil)
+ (setq auto-hscroll-mode auto-hscroll-mode-saved)
(deactivate-mark)
- (if do-multi-click
- (goto-char start-point)
- (unless moved-off-start
- (pop-mark)))
-
- (when (and (functionp fun)
- (= start-hscroll (window-hscroll start-window))
- ;; Don't run the up-event handler if the window
- ;; start changed in a redisplay after the
- ;; mouse-set-point for the down-mouse event at
- ;; the beginning of this function. When the
- ;; window start has changed, the up-mouse event
- ;; contains a different position due to the new
- ;; window contents, and point is set again.
- (or end-point
- (= (window-start start-window)
- start-window-start)))
- (push event unread-command-events)))))))
+ (pop-mark)))))
(defun mouse--drag-set-mark-and-point (start click click-count)
(let* ((range (mouse-start-end start click click-count))
@@ -1092,7 +1027,7 @@ This must be bound to a mouse click."
(interactive "e")
(mouse-minibuffer-check click)
(select-window (posn-window (event-start click)))
- ;; We don't use save-excursion because that preserves the mark too.
+ ;; FIXME: Use save-excursion
(let ((point-save (point)))
(unwind-protect
(progn (mouse-set-point click)
@@ -1146,27 +1081,9 @@ regardless of where you click."
(let (select-active-regions)
(deactivate-mark)))
(or mouse-yank-at-point (mouse-set-point click))
- (let ((primary
- (cond
- ((eq (framep (selected-frame)) 'w32)
- ;; MS-Windows emulates PRIMARY in x-get-selection, but not
- ;; in x-get-selection-value (the latter only accesses the
- ;; clipboard). So try PRIMARY first, in case they selected
- ;; something with the mouse in the current Emacs session.
- (or (x-get-selection 'PRIMARY)
- (x-get-selection-value)))
- ((fboundp 'x-get-selection-value) ; MS-DOS and X.
- ;; On X, x-get-selection-value supports more formats and
- ;; encodings, so use it in preference to x-get-selection.
- (or (x-get-selection-value)
- (x-get-selection 'PRIMARY)))
- ;; FIXME: What about xterm-mouse-mode etc.?
- (t
- (x-get-selection 'PRIMARY)))))
- (unless primary
- (error "No selection is available"))
+ (let ((primary (gui-get-primary-selection)))
(push-mark (point))
- (insert primary)))
+ (insert-for-yank primary)))
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
@@ -1194,12 +1111,12 @@ This does not delete the region; it acts like \\[kill-ring-save]."
;; Delete, but make the undo-list entry share with the kill ring.
;; First, delete just one char, so in case buffer is being modified
;; for the first time, the undo list records that fact.
- (let (before-change-functions after-change-functions)
+ (let ((inhibit-modification-hooks t))
(delete-region beg
(+ beg (if (> end beg) 1 -1))))
(let ((buffer-undo-list buffer-undo-list))
;; Undo that deletion--but don't change the undo list!
- (let (before-change-functions after-change-functions)
+ (let ((inhibit-modification-hooks t))
(primitive-undo 1 buffer-undo-list))
;; Now delete the rest of the specified region,
;; but don't record it.
@@ -1351,7 +1268,7 @@ This must be bound to a mouse drag event."
(if (numberp (posn-point posn))
(setq beg (posn-point posn)))
(move-overlay mouse-secondary-overlay beg (posn-point end))
- (x-set-selection
+ (gui-set-selection
'SECONDARY
(buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay))))))
@@ -1388,6 +1305,7 @@ The function returns a non-nil value if it creates a secondary selection."
(setq mouse-secondary-start (make-marker)))
(set-marker mouse-secondary-start start-point)
(delete-overlay mouse-secondary-overlay))
+ ;; FIXME: Use mouse-drag-track!
(let (event end end-point)
(track-mouse
(while (progn
@@ -1426,13 +1344,13 @@ The function returns a non-nil value if it creates a secondary selection."
(if (marker-position mouse-secondary-start)
(save-window-excursion
(delete-overlay mouse-secondary-overlay)
- (x-set-selection 'SECONDARY nil)
+ (gui-set-selection 'SECONDARY nil)
(select-window start-window)
(save-excursion
(goto-char mouse-secondary-start)
(sit-for 1)
nil))
- (x-set-selection
+ (gui-set-selection
'SECONDARY
(buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))))))))
@@ -1446,9 +1364,9 @@ regardless of where you click."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
- (let ((secondary (x-get-selection 'SECONDARY)))
+ (let ((secondary (gui-get-selection 'SECONDARY)))
(if secondary
- (insert secondary)
+ (insert-for-yank secondary)
(error "No secondary selection"))))
(defun mouse-kill-secondary ()
@@ -1565,7 +1483,7 @@ CLICK position, kill the secondary selection."
(setq str (buffer-substring (overlay-start mouse-secondary-overlay)
(overlay-end mouse-secondary-overlay)))
(> (length str) 0)
- (x-set-selection 'SECONDARY str))))
+ (gui-set-selection 'SECONDARY str))))
(defcustom mouse-buffer-menu-maxlen 20
@@ -1610,8 +1528,17 @@ This switches buffers in the window that you clicked on,
and selects that window."
(interactive "e")
(mouse-minibuffer-check event)
- (let ((buffers (buffer-list)) alist menu split-by-major-mode sum-of-squares)
- ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
+ (let ((buf (x-popup-menu event (mouse-buffer-menu-map)))
+ (window (posn-window (event-start event))))
+ (when buf
+ (select-window
+ (if (framep window) (frame-selected-window window)
+ window))
+ (switch-to-buffer buf))))
+
+(defun mouse-buffer-menu-map ()
+ ;; Make an alist of elements that look like (MENU-ITEM . BUFFER).
+ (let ((buffers (buffer-list)) split-by-major-mode sum-of-squares)
(dolist (buf buffers)
;; Divide all buffers into buckets for various major modes.
;; Each bucket looks like (MODE NAMESTRING BUFFERS...).
@@ -1675,18 +1602,10 @@ and selects that window."
(setq subdivided-menus
(cons (cons "Others" others-list)
subdivided-menus)))))
- (setq menu (cons "Buffer Menu" (nreverse subdivided-menus))))
- (progn
- (setq alist (mouse-buffer-menu-alist buffers))
- (setq menu (cons "Buffer Menu"
- (mouse-buffer-menu-split "Select Buffer" alist)))))
- (let ((buf (x-popup-menu event menu))
- (window (posn-window (event-start event))))
- (when buf
- (select-window
- (if (framep window) (frame-selected-window window)
- window))
- (switch-to-buffer buf)))))
+ (cons "Buffer Menu" (nreverse subdivided-menus)))
+ (cons "Buffer Menu"
+ (mouse-buffer-menu-split "Select Buffer"
+ (mouse-buffer-menu-alist buffers))))))
(defun mouse-buffer-menu-alist (buffers)
(let (tail
@@ -1894,6 +1813,8 @@ choose a font."
(declare-function buffer-face-mode-invoke "face-remap"
(face arg &optional interactive))
(declare-function font-face-attributes "font.c" (font &optional frame))
+(defvar w32-use-w32-font-dialog)
+(defvar w32-fixed-font-alist)
(defun mouse-appearance-menu (event)
"Show a menu for changing the default face in the current buffer."
@@ -1913,13 +1834,18 @@ choose a font."
(define-key mouse-appearance-menu-map [text-scale-increase]
'(menu-item "Increase Buffer Text Size" text-scale-increase))
;; Font selector
- (if (functionp 'x-select-font)
+ (if (and (functionp 'x-select-font)
+ (or (not (boundp 'w32-use-w32-font-dialog))
+ w32-use-w32-font-dialog))
(define-key mouse-appearance-menu-map [x-select-font]
'(menu-item "Change Buffer Font..." x-select-font))
;; If the select-font is unavailable, construct a menu.
(let ((font-submenu (make-sparse-keymap "Change Text Font"))
- (font-alist (cdr (append x-fixed-font-alist
- (list (generate-fontset-menu))))))
+ (font-alist (cdr (append
+ (if (eq system-type 'windows-nt)
+ w32-fixed-font-alist
+ x-fixed-font-alist)
+ (list (generate-fontset-menu))))))
(dolist (family font-alist)
(let* ((submenu-name (car family))
(submenu-map (make-sparse-keymap submenu-name)))
@@ -1960,14 +1886,10 @@ choose a font."
;;; Bindings for mouse commands.
-(define-key global-map [down-mouse-1] 'mouse-drag-region)
+(global-set-key [down-mouse-1] 'mouse-drag-region)
(global-set-key [mouse-1] 'mouse-set-point)
(global-set-key [drag-mouse-1] 'mouse-set-region)
-;; These are tested for in mouse-drag-region.
-(global-set-key [double-mouse-1] 'mouse-set-point)
-(global-set-key [triple-mouse-1] 'mouse-set-point)
-
(defun mouse--strip-first-event (_prompt)
(substring (this-single-command-raw-keys) 1))
@@ -1999,18 +1921,25 @@ choose a font."
;; vertical-line prevents Emacs from signaling an error when the mouse
;; button is released after dragging these lines, on non-toolkit
;; versions.
-(global-set-key [mode-line mouse-1] 'mouse-select-window)
-(global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
-(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
(global-set-key [header-line down-mouse-1] 'mouse-drag-header-line)
(global-set-key [header-line mouse-1] 'mouse-select-window)
+;; (global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
+(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
+(global-set-key [mode-line mouse-1] 'mouse-select-window)
(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
(global-set-key [mode-line mouse-3] 'mouse-delete-window)
(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
(global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
+(global-set-key [horizontal-scroll-bar C-mouse-2] 'mouse-split-window-horizontally)
(global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
(global-set-key [vertical-line mouse-1] 'mouse-select-window)
+(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
+(global-set-key [right-divider down-mouse-1] 'mouse-drag-vertical-line)
+(global-set-key [right-divider mouse-1] 'ignore)
+(global-set-key [right-divider C-mouse-2] 'mouse-split-window-vertically)
+(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
+(global-set-key [bottom-divider mouse-1] 'ignore)
+(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
(provide 'mouse)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 825eb3c05d4..af1aac93f14 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -1,6 +1,6 @@
-;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*-
+;;; mpc.el --- A client for the Music Player Daemon -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: multimedia
@@ -44,7 +44,6 @@
;; - visual feedback for drag'n'drop
;; - display/set `repeat' and `random' state (and maybe also `crossfade').
;; - allow multiple *mpc* sessions in the same Emacs to control different mpds.
-;; - look for .folder.png (freedesktop) or folder.jpg (XP) as well.
;; - fetch album covers and lyrics from the web?
;; - improve MPC-Status: better volume control, add a way to show/hide the
;; rest, plus add the buttons currently in the toolbar.
@@ -92,7 +91,9 @@
;; UI-commands : mpc-
;; internal : mpc--
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
(defgroup mpc ()
"Client for the Music Player Daemon (mpd)."
@@ -217,7 +218,7 @@ defaults to 6600 and HOST defaults to localhost."
(goto-char (point-max))
(insert-before-markers ;So it scrolls.
(replace-regexp-in-string "\n" "\n "
- (apply 'format format args))
+ (apply #'format-message format args))
"\n"))))
(defun mpc--proc-filter (proc string)
@@ -253,6 +254,7 @@ defaults to 6600 and HOST defaults to localhost."
(defun mpc--proc-connect (host)
(let ((port 6600)
+ local
pass)
(when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'"
@@ -267,6 +269,11 @@ defaults to 6600 and HOST defaults to localhost."
(if (string-match "[^[:digit:]]" v)
(string-to-number v)
v)))))
+ (when (file-name-absolute-p host)
+ ;; Expand file name because `file-name-absolute-p'
+ ;; considers paths beginning with "~" as absolute
+ (setq host (expand-file-name host))
+ (setq local t))
(mpc--debug "Connecting to %s:%s..." host port)
(with-current-buffer (get-buffer-create (format " *mpc-%s:%s*" host port))
@@ -279,7 +286,10 @@ defaults to 6600 and HOST defaults to localhost."
(let* ((coding-system-for-read 'utf-8-unix)
(coding-system-for-write 'utf-8-unix)
(proc (condition-case err
- (open-network-stream "MPC" (current-buffer) host port)
+ (make-network-process :name "MPC" :buffer (current-buffer)
+ :host (unless local host)
+ :service (if local host port)
+ :family (if local 'local))
(error (user-error (error-message-string err))))))
(when (processp mpc-proc)
;; Inherit the properties of the previous connection.
@@ -491,10 +501,13 @@ to call FUN for any change whatsoever.")
(cancel-timer mpc--status-timer)
(setq mpc--status-timer nil)))
(defun mpc--status-timer-run ()
- (condition-case err
- (when (process-get (mpc-proc) 'ready)
- (with-local-quit (mpc-status-refresh)))
- (error (message "MPC: %s" err))))
+ (with-demoted-errors "MPC: %S"
+ (when (process-get (mpc-proc) 'ready)
+ (let* ((buf (mpc-proc-buffer (mpc-proc) 'status))
+ (win (get-buffer-window buf t)))
+ (if (not win)
+ (mpc--status-timer-stop)
+ (with-local-quit (mpc-status-refresh)))))))
(defvar mpc--status-idle-timer nil)
(defun mpc--status-idle-timer-start ()
@@ -519,11 +532,8 @@ to call FUN for any change whatsoever.")
;; client starts playback, we may get a chance to notice it.
(run-with-idle-timer 10 t 'mpc--status-idle-timer-run))))
(defun mpc--status-idle-timer-run ()
- (when (process-get (mpc-proc) 'ready)
- (condition-case err
- (with-local-quit (mpc-status-refresh))
- (error (message "MPC: %s" err))))
- (mpc--status-timer-start))
+ (mpc--status-timer-start)
+ (mpc--status-timer-run))
(defun mpc--status-timers-refresh ()
"Start/stop the timers according to whether a song is playing."
@@ -786,6 +796,22 @@ The songs are returned as alists."
;; (setq mpc-queue-back nil mpc-queue nil)
)
+(defun mpc-cmd-consume (&optional arg)
+ "Set consume mode state."
+ (mpc-proc-cmd (list "consume" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-random (&optional arg)
+ "Set random (shuffle) mode state."
+ (mpc-proc-cmd (list "random" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-repeat (&optional arg)
+ "Set repeat mode state."
+ (mpc-proc-cmd (list "repeat" arg) #'mpc-status-refresh))
+
+(defun mpc-cmd-single (&optional arg)
+ "Set single mode state."
+ (mpc-proc-cmd (list "single" arg) #'mpc-status-refresh))
+
(defun mpc-cmd-pause (&optional arg callback)
"Pause or resume playback of the queue of songs."
(let ((cb callback))
@@ -891,9 +917,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
:type '(choice (const nil) directory))
(defcustom mpc-data-directory
- (if (and (not (file-directory-p "~/.mpc"))
- (file-directory-p "~/.emacs.d"))
- "~/.emacs.d/mpc" "~/.mpc")
+ (locate-user-emacs-file "mpc" ".mpc")
"Directory where MPC.el stores auxiliary data."
:type 'directory)
@@ -905,8 +929,13 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(defun mpc-file-local-copy (file)
;; Try to set mpc-mpd-music-directory.
(when (and (null mpc-mpd-music-directory)
- (string-match "\\`localhost" mpc-host))
- (let ((files '("~/.mpdconf" "/etc/mpd.conf"))
+ (or (string-match "\\`localhost" mpc-host)
+ (file-name-absolute-p mpc-host)))
+ (let ((files `(,(let ((xdg (getenv "XDG_CONFIG_HOME")))
+ (concat (if (and xdg (file-name-absolute-p xdg))
+ xdg "~/.config")
+ "/mpd/mpd.conf"))
+ "~/.mpdconf" "~/.mpd/mpd.conf" "/etc/mpd.conf"))
file)
(while (and files (not file))
(if (file-exists-p (car files)) (setq file (car files)))
@@ -997,35 +1026,42 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(substring time (match-end 0))
time)))))
(`Cover
- (let* ((dir (file-name-directory (cdr (assq 'file info))))
- (cover (concat dir "cover.jpg"))
- (file (condition-case err
- (mpc-file-local-copy cover)
- (error (message "MPC: %s" err))))
- image)
+ (let ((dir (file-name-directory
+ (mpc-file-local-copy (cdr (assq 'file info))))))
;; (debug)
(push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred)
- (if (null file)
- ;; Make sure we return something on which we can
- ;; place the `mpc-pred' property, as
- ;; a negative-cache. We could also use
- ;; a default cover.
- (progn (setq size nil) " ")
- (if (null size) (setq image (create-image file))
- (let ((tempfile (make-temp-file "mpc" nil ".jpg")))
- (call-process "convert" nil nil nil
- "-scale" size file tempfile)
- (setq image (create-image tempfile))
- (mpc-tempfiles-add image tempfile)))
- (setq size nil)
- (propertize dir 'display image))))
+ (if-let ((covers '(".folder.png" "cover.jpg" "folder.jpg"))
+ (cover (cl-loop for file in (directory-files dir)
+ if (member (downcase file) covers)
+ return (concat dir file)))
+ (file (with-demoted-errors "MPC: %s"
+ (mpc-file-local-copy cover))))
+ (let (image)
+ (if (null size) (setq image (create-image file))
+ (let ((tempfile (make-temp-file "mpc" nil ".jpg")))
+ (call-process "convert" nil nil nil
+ "-scale" size file tempfile)
+ (setq image (create-image tempfile))
+ (mpc-tempfiles-add image tempfile)))
+ (setq size nil)
+ (propertize dir 'display image))
+ ;; Make sure we return something on which we can
+ ;; place the `mpc-pred' property, as
+ ;; a negative-cache. We could also use
+ ;; a default cover.
+ (progn (setq size nil) " "))))
(_ (let ((val (cdr (assq tag info))))
;; For Streaming URLs, there's no other info
;; than the URL in `file'. Pretend it's in `Title'.
(when (and (null val) (eq tag 'Title))
(setq val (cdr (assq 'file info))))
(push `(equal ',val (cdr (assq ',tag info))) pred)
- val)))))
+ (cond
+ ((not (and (eq tag 'Date) (stringp val))) val)
+ ;; For "date", only keep the year!
+ ((string-match "[0-9]\\{4\\}" val)
+ (match-string 0 val))
+ (t val)))))))
(space (when size
(setq size (string-to-number size))
(propertize " " 'display
@@ -1070,8 +1106,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;;; The actual UI code ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mpc-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
+ (let ((map (make-sparse-keymap)))
;; (define-key map "\e" 'mpc-stop)
(define-key map "q" 'mpc-quit)
(define-key map "\r" 'mpc-select)
@@ -1090,11 +1125,28 @@ If PLAYLIST is t or nil or missing, use the main playlist."
;; is applied elsewhere :-(
;; (define-key map [(double mouse-2)] 'mpc-play-at-point)
(define-key map "p" 'mpc-pause)
+ (define-key map "s" 'mpc-toggle-play)
+ (define-key map ">" 'mpc-next)
+ (define-key map "<" 'mpc-prev)
+ (define-key map "g" nil)
map))
(easy-menu-define mpc-mode-menu mpc-mode-map
"Menu for MPC.el."
'("MPC.el"
+ ["Play/Pause" mpc-toggle-play] ;FIXME: Add one of ⏯/▶/⏸ in there?
+ ["Next Track" mpc-next] ;FIXME: Add ⇥ there?
+ ["Previous Track" mpc-prev] ;FIXME: Add ⇤ there?
+ "--"
+ ["Repeat Playlist" mpc-toggle-repeat :style toggle
+ :selected (member '(repeat . "1") mpc-status)]
+ ["Shuffle Playlist" mpc-toggle-shuffle :style toggle
+ :selected (member '(random . "1") mpc-status)]
+ ["Repeat Single Track" mpc-toggle-single :style toggle
+ :selected (member '(single . "1") mpc-status)]
+ ["Consume Mode" mpc-toggle-consume :style toggle
+ :selected (member '(consume . "1") mpc-status)]
+ "--"
["Add new browser" mpc-tagbrowser]
["Update DB" mpc-update]
["Quit" mpc-quit]))
@@ -1138,11 +1190,11 @@ If PLAYLIST is t or nil or missing, use the main playlist."
:help "Append to the playlist")
map))
-(define-derived-mode mpc-mode fundamental-mode "MPC"
+(define-derived-mode mpc-mode special-mode "MPC"
"Major mode for the features common to all buffers of MPC."
(buffer-disable-undo)
- (setq buffer-read-only t)
- (setq-local tool-bar-map mpc-tool-bar-map)
+ (if (boundp 'tool-bar-map) ; not if --without-x
+ (setq-local tool-bar-map mpc-tool-bar-map))
(setq-local truncate-lines t))
;;; The mpc-status-mode buffer ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1243,7 +1295,7 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(let ((ol (make-overlay
(line-beginning-position) (line-beginning-position 2))))
(overlay-put ol 'mpc-select t)
- (overlay-put ol 'face 'region)
+ (overlay-put ol 'face 'highlight)
(overlay-put ol 'evaporate t)
(push ol mpc-select)))
@@ -1542,7 +1594,7 @@ when constructing the set of constraints."
(move-overlay mpc-tagbrowser-all-ol
(point) (line-beginning-position 2))
(let ((ol (make-overlay (point) (line-beginning-position 2))))
- (overlay-put ol 'face 'region)
+ (overlay-put ol 'face 'highlight)
(overlay-put ol 'evaporate t)
(setq-local mpc-tagbrowser-all-ol ol))))))
@@ -1619,7 +1671,7 @@ Return non-nil if a selection was deactivated."
(setq active
(if (listp active) (mpc-intersection active vals) vals))))
- (when (and (listp active))
+ (when (listp active)
;; Remove the selections if they are all in conflict with
;; other constraints.
(let ((deactivate t))
@@ -1633,7 +1685,13 @@ Return non-nil if a selection was deactivated."
(setq selection nil)
(mapc 'delete-overlay mpc-select)
(setq mpc-select nil)
- (mpc-tagbrowser-all-select)))))
+ (mpc-tagbrowser-all-select))))
+
+ ;; Don't bother splitting the "active" elements to the first part if
+ ;; they're the same as the selection.
+ (when (equal (sort (copy-sequence active) #'string-lessp)
+ (sort (copy-sequence selection) #'string-lessp))
+ (setq active 'all)))
;; FIXME: This `mpc-sort' takes a lot of time. Maybe we should
;; be more clever and presume the buffer is mostly sorted already.
@@ -1742,7 +1800,7 @@ A value of t means the main playlist.")
(completing-read "Rename playlist: "
(mpc-cmd-list 'Playlist)
nil 'require-match)))
- (newname (read-string (format "Rename '%s' to: " oldname))))
+ (newname (read-string (format-message "Rename `%s' to: " oldname))))
(if (zerop (length newname))
(error "Aborted")
(list oldname newname))))
@@ -1796,7 +1854,10 @@ A value of t means the main playlist.")
;; Maintain the volume.
(setq mpc-volume
(mpc-volume-widget
- (string-to-number (cdr (assq 'volume mpc-status))))))
+ (string-to-number (cdr (assq 'volume mpc-status)))))
+ (let ((status-buf (mpc-proc-buffer (mpc-proc) 'status)))
+ (when (buffer-live-p status-buf)
+ (with-current-buffer status-buf (force-mode-line-update)))))
(defvar mpc-volume-step 5)
@@ -1811,9 +1872,14 @@ A value of t means the main playlist.")
(char-after (posn-point posn))))
'(?◁ ?<))
(- mpc-volume-step) mpc-volume-step))
- (newvol (+ (string-to-number (cdr (assq 'volume mpc-status))) diff)))
- (mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh)
- (message "Set MPD volume to %s%%" newvol)))
+ (curvol (string-to-number (cdr (assq 'volume mpc-status))))
+ (newvol (max 0 (min 100 (+ curvol diff)))))
+ (if (= newvol curvol)
+ (progn
+ (message "MPD volume already at %s%%" newvol)
+ (ding))
+ (mpc-proc-cmd (list "setvol" newvol) 'mpc-status-refresh)
+ (message "Set MPD volume to %s%%" newvol))))
(defun mpc-volume-widget (vol &optional size)
(unless size (setq size 12.5))
@@ -1849,7 +1915,6 @@ A value of t means the main playlist.")
(defvar mpc-songs-mode-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map mpc-mode-map)
(define-key map [remap mpc-select] 'mpc-songs-jump-to)
map))
@@ -1861,7 +1926,7 @@ This is used so that they can be compared with `eq', which is needed for
`text-property-any'.")
(defun mpc-songs-hashcons (name)
(or (gethash name mpc-songs-hashcons) (puthash name name mpc-songs-hashcons)))
-(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %10{Date}"
+(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %5{Date}"
"Format used to display each song in the list of songs."
:type 'string)
@@ -1927,7 +1992,7 @@ This is used so that they can be compared with `eq', which is needed for
;; I punt on it and just use file-name sorting, which does the
;; right thing if your library is properly arranged.
(dolist (song (if dontsort active
- (sort active
+ (sort (copy-sequence active)
(lambda (song1 song2)
(let ((cmp (mpc-compare-strings
(cdr (assq 'file song1))
@@ -2011,14 +2076,16 @@ This is used so that they can be compared with `eq', which is needed for
posn))))
(let* ((plbuf (mpc-proc-cmd "playlist"))
(re (if song-file
- (concat "^\\([0-9]+\\):" (regexp-quote song-file) "$")))
+ ;; Newer MPCs apparently include "file: " in the buffer.
+ (concat "^\\([0-9]+\\):\\(?:file: \\)?"
+ (regexp-quote song-file) "$")))
(sn (with-current-buffer plbuf
(goto-char (point-min))
(when (and re (re-search-forward re nil t))
(match-string 1)))))
(cond
((null re) (posn-set-point posn))
- ((null sn) (error "This song is not in the playlist"))
+ ((null sn) (user-error "This song is not in the playlist"))
((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!
@@ -2295,6 +2362,30 @@ This is used so that they can be compared with `eq', which is needed for
(mpc-status-stop)
(if proc (delete-process proc))))
+(defun mpc-toggle-consume ()
+ "Toggle consume mode: removing played songs from the playlist."
+ (interactive)
+ (mpc-cmd-consume
+ (if (string= "0" (cdr (assq 'consume (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-repeat ()
+ "Toggle repeat mode."
+ (interactive)
+ (mpc-cmd-repeat
+ (if (string= "0" (cdr (assq 'repeat (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-single ()
+ "Toggle single mode."
+ (interactive)
+ (mpc-cmd-single
+ (if (string= "0" (cdr (assq 'single (mpc-cmd-status)))) "1" "0")))
+
+(defun mpc-toggle-shuffle ()
+ "Toggle shuffling of the playlist (random mode)."
+ (interactive)
+ (mpc-cmd-random
+ (if (string= "0" (cdr (assq 'random (mpc-cmd-status)))) "1" "0")))
+
(defun mpc-stop ()
"Stop playing the current queue of songs."
(interactive)
@@ -2312,6 +2403,16 @@ This is used so that they can be compared with `eq', which is needed for
(interactive)
(mpc-cmd-pause "0"))
+(defun mpc-toggle-play ()
+ "Toggle between play and pause.
+If stopped, start playback."
+ (interactive)
+ (if (member (cdr (assq 'state (mpc-cmd-status))) '("stop"))
+ (mpc-cmd-play)
+ (if (member (cdr (assq 'state (mpc-cmd-status))) '("pause"))
+ (mpc-resume)
+ (mpc-pause))))
+
(defun mpc-play ()
"Start playing whatever is selected."
(interactive)
@@ -2328,7 +2429,7 @@ This is used so that they can be compared with `eq', which is needed for
(if (mpc-playlist-add)
(if (member (cdr (assq 'state (mpc-cmd-status))) '("stop"))
(mpc-cmd-play))
- (error "Don't know what to play"))))
+ (user-error "Don't know what to play"))))
(defun mpc-next ()
"Jump to the next song in the queue."
@@ -2592,7 +2693,8 @@ This is used so that they can be compared with `eq', which is needed for
(mpc-cmd-move (let ((poss '()))
(dotimes (i (length songs))
(push (+ i (length pl)) poss))
- (nreverse poss)) dest-pos mpc-songs-playlist)
+ (nreverse poss))
+ dest-pos mpc-songs-playlist)
(message "Added %d songs" (length songs)))))
(mpc-songs-refresh))
(t
@@ -2611,6 +2713,8 @@ This is used so that they can be compared with `eq', which is needed for
(interactive
(progn
(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)))
nil))
(let* ((song-buf (mpc-songs-buf))
diff --git a/lisp/msb.el b/lisp/msb.el
index 110a4277376..fbc130174b8 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -1,9 +1,9 @@
;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993-1995, 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1997-2015 Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 8 Oct 1993
;; Lindberg's last update version: 3.34
;; Keywords: mouse buffer menu
@@ -659,7 +659,7 @@ If the argument is left out or nil, then the current buffer is considered."
(defun msb--create-function-info (menu-cond-elt)
"Create a vector from an element MENU-COND-ELT of `msb-menu-cond'.
This takes the form:
-\[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER]
+[BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER]
See `msb-menu-cond' for a description of its elements."
(let* ((list-symbol (make-symbol "-msb-buffer-list"))
(tmp-ih (and (> (length menu-cond-elt) 3)
@@ -745,7 +745,7 @@ to the buffer-list variable in FUNCTION-INFO."
(msb--add-to-menu buffer info max-buffer-name-length)))
(error (unless msb--error
(setq msb--error
- (format
+ (format-message
"In msb-menu-cond, error for buffer `%s'."
(buffer-name buffer)))
(error "%s" msb--error))))))
@@ -777,7 +777,7 @@ SORT-PREDICATE.
Example:
\(msb--aggregate-alist
- '((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
+ \\='((a . a1) (a . a2) (b . b1) (c . c3) (a . a4) (a . a3) (b . b3) (b . b2))
(function string=)
(lambda (item1 item2)
(string< (symbol-name item1) (symbol-name item2))))
@@ -1064,7 +1064,7 @@ variable `msb-menu-cond'."
list))
(defun msb--make-keymap-menu (raw-menu)
- (let ((end (cons '(nil) 'menu-bar-select-buffer))
+ (let ((end 'menu-bar-select-buffer)
(mcount 0))
(mapcar
(lambda (sub-menu)
@@ -1105,13 +1105,12 @@ variable `msb-menu-cond'."
(setcdr (nthcdr msb-max-menu-items frames) nil))
(setq frames-menu
(nconc
- (list 'frame f-title '(nil) 'keymap f-title)
+ (list 'frame f-title 'keymap f-title)
(mapcar
(lambda (frame)
(nconc
(list (frame-parameter frame 'name)
- (frame-parameter frame 'name)
- (cons nil nil))
+ (frame-parameter frame 'name))
`(lambda ()
(interactive) (menu-bar-select-frame ,frame))))
frames)))))
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 6679c5716e4..4b69ec0c7b2 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,6 @@
;;; mwheel.el --- Wheel mouse support
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: mouse
;; Package: emacs
diff --git a/lisp/net/.gitignore b/lisp/net/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/net/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 177fdaca150..4f7fa3b8f39 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1,9 +1,10 @@
;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-;; Copyright (C) 1989-1996, 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1996, 1998, 2000-2015 Free Software Foundation,
+;; Inc.
;; Author: Andy Norman (ange@hplb.hpl.hp.com)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -192,7 +193,7 @@
;;
;; "^$*$ *"
;;
-;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let
+;; 9) Set the variable ange-ftp-gateway-program-interactive to t to let
;; ange-ftp know that it has to "hand-hold" the login to the gateway
;; machine.
;;
@@ -363,7 +364,7 @@
;;
;; Filename syntax:
;;
-;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
+;; CMS filenames are entered in a UNIX-y way. In other words, minidisks are
;; treated as UNIX directories. For example to access the file READ.ME in
;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
;; /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
@@ -680,7 +681,7 @@
'("\\`/\\(\\([^/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
"Format of a fully expanded remote file name.
-This is a list of the form \(REGEXP HOST USER NAME\),
+This is a list of the form \(REGEXP HOST USER NAME),
where REGEXP is a regular expression matching
the full remote name, and HOST, USER, and NAME are the numbers of
parenthesized expressions in REGEXP for the components (in that order)."
@@ -1106,7 +1107,7 @@ All HOST values should be in lower case.")
(defun ange-ftp-message (fmt &rest args)
"Display message in echo area, but indicate if truncated.
Args are as in `message': a format string, plus arguments to be formatted."
- (let ((msg (apply 'format fmt args))
+ (let ((msg (apply #'format-message fmt args))
(max (window-width (minibuffer-window))))
(if noninteractive
msg
@@ -1365,8 +1366,8 @@ only return the directory part of FILE."
(goto-char end)))
;; Read in ~/.netrc, if one exists. If ~/.netrc file exists and has
-;; the correct permissions then extract the \`machine\', \`login\',
-;; \`password\' and \`account\' information from within.
+;; the correct permissions then extract the machine, login,
+;; password and account information from within.
(defun ange-ftp-parse-netrc ()
;; We set this before actually doing it to avoid the possibility
@@ -1535,8 +1536,8 @@ then kill the related FTP process."
(signal 'file-error
(list "Opening directory"
(if (file-exists-p directory)
- "not a directory"
- "no such file or directory")
+ "Not a directory"
+ "No such file or directory")
directory))))
;;;; ------------------------------------------------------------
@@ -1612,7 +1613,7 @@ good, skip, fatal, or unknown."
-6)))
(if (zerop ange-ftp-xfer-size)
(ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes)
- (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size)))
+ (let ((percent (floor (* 100.0 kbytes) ange-ftp-xfer-size)))
;; cut out the redisplay of identical %-age messages.
(unless (eq percent ange-ftp-last-percent)
(setq ange-ftp-last-percent percent)
@@ -2510,7 +2511,7 @@ Works by doing a pwd and examining the directory syntax."
;;;; Remote file and directory listing support.
;;;; ------------------------------------------------------------
-;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
+;; Returns whether HOST's FTP server doesn't like 'ls' or 'dir' commands
;; to take switch arguments.
(defun ange-ftp-dumb-unix-host (host)
(and host ange-ftp-dumb-unix-host-regexp
@@ -2830,16 +2831,24 @@ match subdirectories as well.")
files ange-ftp-files-hashtable)))
(defun ange-ftp-switches-ok (switches)
- "Return SWITCHES (a string) if suitable for our use."
+ "Return SWITCHES (a string) if suitable for use with ls over ftp."
(and (stringp switches)
- ;; We allow the A switch, which lists all files except "." and
- ;; "..". This is OK because we manually insert these entries
- ;; in the hash table.
+ ;; We allow the --almost-all switch, which lists all files
+ ;; except "." and "..". This is OK because we manually
+ ;; insert these entries in the hash table.
(string-match
- "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]" switches)
+ "--\\(almost-\\)?all\\>\\|\\(\\`\\| \\)-[[:alpha:]]*[aA]"
+ switches)
+ ;; Disallow other long flags except --(almost-)all.
+ (not (string-match "\\(\\`\\| \\)--\\w+"
+ (replace-regexp-in-string
+ "--\\(almost-\\)?all\\>" ""
+ switches)))
+ ;; Must include 'l'.
(string-match "\\(\\`\\| \\)-[[:alpha:]]*l" switches)
+ ;; Disallow recursive flag.
(not (string-match
- "--recursive\\>\\|\\(\\`\\| \\)-[[:alpha:]]*R" switches))
+ "\\(\\`\\| \\)-[[:alpha:]]*R" switches))
switches))
(defun ange-ftp-get-files (directory &optional no-error)
@@ -3655,7 +3664,7 @@ so return the size on the remote host exactly. See RFC 3659."
(or (file-exists-p filename)
(signal 'file-error
- (list "Copy file" "no such file or directory" filename)))
+ (list "Copy file" "No such file or directory" filename)))
;; canonicalize newname if a directory.
(if (file-directory-p newname)
@@ -3733,7 +3742,7 @@ so return the size on the remote host exactly. See RFC 3659."
;; next part of copying routine.
(defun ange-ftp-cf1 (result line
filename newname binary msg
- f-parsed f-host f-user f-name f-abbr
+ f-parsed f-host f-user _f-name f-abbr
t-parsed t-host t-user t-name t-abbr
temp1 temp2 cont nowait)
(if line
@@ -3835,7 +3844,7 @@ so return the size on the remote host exactly. See RFC 3659."
(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
keep-date preserve-uid-gid
- preserve-selinux-context)
+ _preserve-selinux-context)
(interactive "fCopy file: \nFCopy %s to file: \np")
(ange-ftp-copy-file-internal filename
newname
@@ -4200,7 +4209,7 @@ directory, so that Emacs will know its current contents."
(while (and tryfiles (not copy))
(catch 'ftp-error
(let ((ange-ftp-waiting-flag t))
- (condition-case error
+ (condition-case _error
(setq copy (ange-ftp-file-local-copy (car tryfiles)))
(ftp-error nil))))
(setq tryfiles (cdr tryfiles)))
@@ -4214,7 +4223,7 @@ directory, so that Emacs will know its current contents."
(ange-ftp-real-load file noerror nomessage nosuffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
-(defun ange-ftp-unhandled-file-name-directory (filename)
+(defun ange-ftp-unhandled-file-name-directory (_filename)
nil)
@@ -4605,7 +4614,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
(let* ((parsed (ange-ftp-ftp-name default-directory))
(host (nth 0 parsed))
- (user (nth 1 parsed))
(name (nth 2 parsed)))
(if (not parsed)
(ange-ftp-real-shell-command command output-buffer error-buffer)
@@ -4618,7 +4626,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
(format "%s %s \"%s\"" ; remsh -l USER does not work well
; on a hp-ux machine I tried
remote-shell-program host command))
- (ange-ftp-message "Remote command '%s' ..." command)
+ (ange-ftp-message "Remote command `%s' ..." command)
;; Cannot call ange-ftp-real-dired-run-shell-command here as it
;; would prepend "cd default-directory" --- which bombs because
;; default-directory is in ange-ftp syntax for remote file names.
@@ -5176,7 +5184,7 @@ Other orders of $ and _ seem to all work just fine.")
;; versions left. If not, then delete the
;; root entry.
(maphash
- (lambda (key val)
+ (lambda (key _val)
(and (string-match regexp key)
(setq versions t)))
files)
@@ -5358,7 +5366,7 @@ Other orders of $ and _ seem to all work just fine.")
;; compressed files. Instead, we turn "FILE.TYPE" into
;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
-(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
+(defun ange-ftp-vms-make-compressed-filename (name &optional _reverse)
(cond
((string-match "-Z;[0-9]+\\'" name)
(list nil (substring name 0 (match-beginning 0))))
@@ -5399,7 +5407,7 @@ Other orders of $ and _ seem to all work just fine.")
;; (cons '(vms . ange-ftp-dired-vms-ls-trim)
;; ange-ftp-dired-ls-trim-alist)))
-(defun ange-ftp-vms-sans-version (name &rest args)
+(defun ange-ftp-vms-sans-version (name &rest _args)
(save-match-data
(if (string-match ";[0-9]+\\'" name)
(substring name 0 (match-beginning 0))
@@ -5920,7 +5928,7 @@ Other orders of $ and _ seem to all work just fine.")
;; (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
;; ange-ftp-dired-move-to-end-of-filename-alist)))
-(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
+(defun ange-ftp-cms-make-compressed-filename (name &optional _reverse)
(if (string-match "-Z\\'" name)
(list nil (substring name 0 -2))
(list t (concat name "-Z"))))
@@ -5970,7 +5978,7 @@ Other orders of $ and _ seem to all work just fine.")
(defcustom ange-ftp-bs2000-special-prefix
"X"
- "Prefix used for filenames starting with '#' or '@'."
+ "Prefix used for filenames starting with `#' or `@'."
:group 'ange-ftp
:type 'string)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 70173dbc0b3..757e368317a 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1,9 +1,9 @@
;;; browse-url.el --- pass a URL to a WWW browser
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Denis Howe <dbh@doc.ic.ac.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 03 Apr 1995
;; Keywords: hypertext, hypermedia, mouse
@@ -31,89 +31,33 @@
;; different methods of remote control so there is one function for
;; each supported browser. If the chosen browser is not running, it
;; is started. Currently there is support for the following browsers,
-;; some of them probably now obsolete:
+;; as well as some other obsolete ones:
;; Function Browser Earliest version
;; browse-url-mozilla Mozilla Don't know
;; browse-url-firefox Firefox Don't know (tried with 1.0.1)
;; browse-url-chromium Chromium 3.0
-;; browse-url-galeon Galeon Don't know
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-netscape Netscape 1.1b1
-;; browse-url-mosaic XMosaic/mMosaic <= 2.4
-;; browse-url-cci XMosaic 2.5
+;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
-;; browse-url-w3-gnudoit w3 remotely
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
;; browse-url-default-windows-browser MS-Windows browser
;; browse-url-default-macosx-browser Mac OS X browser
;; browse-url-xdg-open Free Desktop xdg-open on Gnome, KDE, Xfce4, LXDE
-;; browse-url-gnome-moz GNOME interface to Mozilla
;; browse-url-kde KDE konqueror (kfm)
;; browse-url-elinks Elinks Don't know (tried with 0.12.GIT)
-;; [A version of the Netscape browser is now free software
-;; <URL:http://www.mozilla.org/>, albeit not GPLed, so it is
-;; reasonable to have that as the default.]
-
-;; Note that versions of Netscape before 1.1b1 did not have remote
-;; control. <URL:http://www.netscape.com/newsref/std/x-remote.html>.
-
;; Browsers can cache Web pages so it may be necessary to tell them to
-;; reload the current page if it has changed (e.g. if you have edited
+;; reload the current page if it has changed (e.g., if you have edited
;; it). There is currently no perfect automatic solution to this.
-;; Netscape allows you to specify the id of the window you want to
-;; control but which window DO you want to control and how do you
-;; discover its id?
-
-;; William M. Perry's excellent "w3" WWW browser for
-;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
-;; has a function w3-follow-url-at-point, but that
-;; doesn't let you edit the URL like browse-url.
-;; The `gnuserv' package that can be used to control it in another
-;; Emacs process is available from
-;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
-
-;; Lynx is now distributed by the FSF. See also
-;; <URL:http://lynx.browser.org/>.
-
-;; Free graphical browsers that could be used by `browse-url-generic'
-;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
-;; <URL:http://www.unlv.edu/chimera/>, Arena
-;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena> and Amaya
-;; <URL:ftp://ftp.w3.org/pub/amaya>. mMosaic
-;; <URL:ftp://ftp.enst.fr/pub/mbone/mMosaic/>,
-;; <URL:http://www.enst.fr/~dauphin/mMosaic/> (with development
-;; support for Java applets and multicast) can be used like Mosaic by
-;; setting `browse-url-mosaic-program' appropriately.
-
-;; I [Denis Howe, not Dave Love] recommend Nelson Minar
-;; <nelson@santafe.edu>'s excellent html-helper-mode.el for editing
-;; HTML and thank Nelson for his many useful comments on this code.
-;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>
-
-;; See also hm--html-menus <URL:http://www.tnt.uni-hannover.de/%7Emuenkel/
-;; software/own/hm--html-menus/>. For composing correct HTML see also
-;; PSGML the general SGML structure editor package
-;; <URL:ftp://ftp.lysator.liu.se/pub/sgml>; hm--html-menus can be used
-;; with this.
-
;; This package generalizes function html-previewer-process in Marc
;; Andreessen's html-mode (LCD modes/html-mode.el.Z). See also the
;; ffap.el package. The huge hyperbole package also contains similar
;; functions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Help!
-
-;; Can you write and test some code for the Macintrash and Windoze
-;; Netscape remote control APIs? (See the URL above).
-
-;; Do any other browsers have remote control?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Usage
;; To display the URL at or before point:
@@ -169,34 +113,9 @@
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To get round the Netscape caching problem, you could EITHER have
-;; write-file in html-helper-mode make Netscape reload the document:
-;;
-;; (autoload 'browse-url-netscape-reload "browse-url"
-;; "Ask a WWW browser to redisplay the current file." t)
-;; (add-hook 'html-helper-mode-hook
-;; (lambda ()
-;; (add-hook 'local-write-file-hooks
-;; (lambda ()
-;; (let ((local-write-file-hooks))
-;; (save-buffer))
-;; (browse-url-netscape-reload)
-;; t) ; => file written by hook
-;; t))) ; append to l-w-f-hooks
-;;
-;; OR have browse-url-of-file ask Netscape to load and then reload the
-;; file:
-;;
-;; (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
-
-;; You may also want to customize browse-url-netscape-arguments, e.g.
-;; (setq browse-url-netscape-arguments '("-install"))
-;;
-;; or similarly for the other browsers.
-
;; To invoke different browsers for different URLs:
;; (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
-;; ("." . browse-url-netscape)))
+;; ("." . browse-url-firefox)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
@@ -225,17 +144,12 @@ function is passed the URL and any other args of `browse-url'. The last
regexp should probably be \".\" to specify a default browser."
:type '(choice
(function-item :tag "Emacs W3" :value browse-url-w3)
- (function-item :tag "W3 in another Emacs via `gnudoit'"
- :value browse-url-w3-gnudoit)
+ (function-item :tag "eww" :value eww-browse-url)
(function-item :tag "Mozilla" :value browse-url-mozilla)
(function-item :tag "Firefox" :value browse-url-firefox)
(function-item :tag "Chromium" :value browse-url-chromium)
- (function-item :tag "Galeon" :value browse-url-galeon)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Netscape" :value browse-url-netscape)
- (function-item :tag "eww" :value eww-browse-url)
- (function-item :tag "Mosaic" :value browse-url-mosaic)
- (function-item :tag "Mosaic using CCI" :value browse-url-cci)
+ (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"
@@ -248,8 +162,6 @@ regexp should probably be \".\" to specify a default browser."
:value browse-url-default-windows-browser)
(function-item :tag "Default Mac OS X browser"
:value browse-url-default-macosx-browser)
- (function-item :tag "GNOME invoking Mozilla"
- :value browse-url-gnome-moz)
(function-item :tag "Default browser"
:value browse-url-default-browser)
(function :tag "Your own function")
@@ -282,18 +194,25 @@ system, given vroot.h from the same directory, with cc flags
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-program nil "25.1")
+
(defcustom browse-url-netscape-arguments nil
"A list of strings to pass to Netscape as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-arguments nil "25.1")
+
(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
"A list of strings to pass to Netscape when it starts up.
Defaults to the value of `browse-url-netscape-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument"))
+
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-startup-arguments nil "25.1")
+
(defcustom browse-url-browser-display nil
"The X display for running the browser, if not same as Emacs's."
:type '(choice string (const :tag "Default" nil))
@@ -317,26 +236,29 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time
:group 'browse-url)
(defcustom browse-url-firefox-program
- (let ((candidates '("firefox" "iceweasel" "icecat")))
+ (let ((candidates '("icecat" "iceweasel" "firefox")))
(while (and candidates (not (executable-find (car candidates))))
(setq candidates (cdr candidates)))
(or (car candidates) "firefox"))
- "The name by which to invoke Firefox."
+ "The name by which to invoke Firefox or a variant of it."
:type 'string
:group 'browse-url)
(defcustom browse-url-firefox-arguments nil
- "A list of strings to pass to Firefox as arguments."
+ "A list of strings to pass to Firefox (or variant) as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
(defcustom browse-url-firefox-startup-arguments browse-url-firefox-arguments
- "A list of strings to pass to Firefox when it starts up.
+ "A list of strings to pass to Firefox (or variant) when it starts up.
Defaults to the value of `browse-url-firefox-arguments' at the time
`browse-url' is loaded."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-firefox-startup-arguments
+ "it no longer has any effect." "24.5")
+
(defcustom browse-url-chromium-program
(let ((candidates '("chromium" "chromium-browser")))
(while (and candidates (not (executable-find (car candidates))))
@@ -358,11 +280,15 @@ Defaults to the value of `browse-url-firefox-arguments' at the time
:type 'string
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-program nil "25.1")
+
(defcustom browse-url-galeon-arguments nil
"A list of strings to pass to Galeon as arguments."
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-arguments nil "25.1")
+
(defcustom browse-url-galeon-startup-arguments browse-url-galeon-arguments
"A list of strings to pass to Galeon when it starts up.
Defaults to the value of `browse-url-galeon-arguments' at the time
@@ -370,6 +296,8 @@ Defaults to the value of `browse-url-galeon-arguments' at the time
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-startup-arguments nil "25.1")
+
(defcustom browse-url-epiphany-program "epiphany"
"The name by which to invoke Epiphany."
:type 'string
@@ -390,12 +318,16 @@ Defaults to the value of `browse-url-epiphany-arguments' at the time
;; GNOME means of invoking either Mozilla or Netscape.
(defvar browse-url-gnome-moz-program "gnome-moz-remote")
+(make-obsolete-variable 'browse-url-gnome-moz-program nil "25.1")
+
(defcustom browse-url-gnome-moz-arguments '()
"A list of strings passed to the GNOME mozilla viewer as arguments."
:version "21.1"
:type '(repeat (string :tag "Argument"))
:group 'browse-url)
+(make-obsolete-variable 'browse-url-gnome-moz-arguments nil "25.1")
+
(defcustom browse-url-mozilla-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
@@ -413,6 +345,13 @@ functionality is not available there."
:type 'boolean
:group 'browse-url)
+(defcustom browse-url-conkeror-new-window-is-buffer nil
+ "Whether to open up new windows in a buffer or a new window.
+If non-nil, then open the URL in a new buffer rather than a new window if
+`browse-url-conkeror' is asked to open it in a new window."
+ :type 'boolean
+ :group 'browse-url)
+
(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
@@ -420,6 +359,8 @@ If non-nil, then open the URL in a new tab rather than a new window if
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-galeon-new-window-is-tab nil "25.1")
+
(defcustom browse-url-epiphany-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
@@ -435,11 +376,12 @@ window."
:type 'boolean
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-new-window-is-tab nil "25.1")
+
(defcustom browse-url-new-window-flag nil
"Non-nil means always open a new browser window with appropriate browsers.
Passing an interactive argument to \\[browse-url], or specific browser
-commands reverses the effect of this variable. Requires Netscape version
-1.1N or later or XMosaic version 2.5 or later if using those browsers."
+commands reverses the effect of this variable."
:type 'boolean
:group 'browse-url)
@@ -449,16 +391,33 @@ commands reverses the effect of this variable. Requires Netscape version
:version "20.3"
:group 'browse-url)
+(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"))
:group 'browse-url)
+(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
:group 'browse-url)
+(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"
+ :group 'browse-url)
+
+(defcustom browse-url-conkeror-arguments nil
+ "A list of strings to pass to Conkeror as arguments."
+ :type '(repeat (string :tag "Argument"))
+ :group 'browse-url)
+
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/")
;; The above loses the username to avoid the browser prompting for
@@ -480,7 +439,7 @@ For example, adding to the default a specific translation of an ange-ftp
address to an HTTP URL:
(setq browse-url-filename-alist
- '((\"/webmaster@webserver:/home/www/html/\" .
+ \\='((\"/webmaster@webserver:/home/www/html/\" .
\"http://www.acme.co.uk/\")
(\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\")
(\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\")
@@ -498,12 +457,8 @@ Used by the `browse-url-of-file' command."
:group 'browse-url)
(defcustom browse-url-of-file-hook nil
- "Run after `browse-url-of-file' has asked a browser to load a file.
-
-Set this to `browse-url-netscape-reload' to force Netscape to load the
-file rather than displaying a cached copy."
+ "Hook run after `browse-url-of-file' has asked a browser to load a file."
:type 'hook
- :options '(browse-url-netscape-reload)
:group 'browse-url)
(defcustom browse-url-CCI-port 3003
@@ -513,6 +468,8 @@ the value set in the browser."
:type 'integer
:group 'browse-url)
+(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
@@ -520,6 +477,8 @@ enabled. The port number should be set in `browse-url-CCI-port'."
:type 'string
:group 'browse-url)
+(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)
@@ -571,6 +530,8 @@ incompatibly at version 4."
:type 'number
:group 'browse-url)
+(make-obsolete-variable 'browse-url-netscape-version nil "25.1")
+
(defcustom browse-url-text-browser "lynx"
"The name of the text browser to invoke."
:type 'string
@@ -723,9 +684,12 @@ interactively. Turn the filename into a URL with function
(defun browse-url-file-url (file)
"Return the URL corresponding to FILE.
Use variable `browse-url-filename-alist' to map filenames to URLs."
- (let ((coding (and (default-value 'enable-multibyte-characters)
- (or file-name-coding-system
- default-file-name-coding-system))))
+ (let ((coding (if (equal system-type 'windows-nt)
+ ;; W32 pretends that file names are UTF-8 encoded.
+ 'utf-8
+ (and (default-value 'enable-multibyte-characters)
+ (or file-name-coding-system
+ default-file-name-coding-system)))))
(if coding (setq file (encode-coding-string file coding))))
(setq file (browse-url-url-encode-chars file "[*\"()',=;?% ]"))
(dolist (map browse-url-filename-alist)
@@ -797,22 +761,25 @@ narrowed."
;;;###autoload
(defun browse-url (url &rest args)
"Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point. Variable
-`browse-url-browser-function' says which browser to use.
+Prompt for a URL, defaulting to the URL at or before point.
+The variable `browse-url-browser-function' says which browser to use.
If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists."
+first, if that exists.
+
+Passes any ARGS to the browser function.
+The default is to pass `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
+ (when (and url-handler-mode (not (file-name-absolute-p 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)
browse-url-browser-function))
;; Ensure that `default-directory' exists and is readable (b#6077).
- (default-directory (if (and (file-directory-p default-directory)
- (file-readable-p default-directory))
- default-directory
- (expand-file-name "~/"))))
+ (default-directory (or (unhandled-file-name-directory default-directory)
+ (expand-file-name "~/"))))
;; When connected to various displays, be careful to use the display of
;; the currently selected frame, rather than the original start display,
;; which may not even exist any more.
@@ -836,8 +803,9 @@ first, if that exists."
;;;###autoload
(defun browse-url-at-point (&optional arg)
"Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like `browse-url'. Variable
-`browse-url-browser-function' says which browser to use."
+Variable `browse-url-browser-function' says which browser to use.
+Optional prefix argument ARG non-nil inverts the value of the option
+`browse-url-new-window-flag'."
(interactive "P")
(let ((url (browse-url-url-at-point)))
(if url
@@ -850,9 +818,8 @@ Doesn't let you edit the URL like `browse-url'. Variable
(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
-but point is not changed. Doesn't let you edit the URL like
-`browse-url'. Variable `browse-url-browser-function' says which browser
-to use."
+but point is not changed. Variable `browse-url-browser-function'
+says which browser to use."
(interactive "e")
(save-excursion
(mouse-set-point event)
@@ -868,7 +835,7 @@ to use."
(defvar dos-windows-version)
(declare-function w32-shell-execute "w32fns.c") ;; Defined in C.
-(defun browse-url-default-windows-browser (url &optional new-window)
+(defun browse-url-default-windows-browser (url &optional _new-window)
(interactive (browse-url-interactive-arg "URL: "))
(cond ((eq system-type 'ms-dos)
(if dos-windows-version
@@ -878,7 +845,7 @@ to use."
(call-process "cygstart" nil nil nil url))
(t (w32-shell-execute "open" url))))
-(defun browse-url-default-macosx-browser (url &optional new-window)
+(defun browse-url-default-macosx-browser (url &optional _new-window)
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
@@ -922,18 +889,19 @@ used instead of `browse-url-new-window-flag'."
((memq system-type '(darwin))
'browse-url-default-macosx-browser)
((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
- ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
+;;; ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
((executable-find browse-url-chromium-program) 'browse-url-chromium)
- ((executable-find browse-url-galeon-program) 'browse-url-galeon)
+;;; ((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-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-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
(t
- (lambda (&rest ignore) (error "No usable browser found"))))
+ (lambda (&rest _ignore) (error "No usable browser found"))))
url args))
(defun browse-url-can-use-xdg-open ()
@@ -994,6 +962,7 @@ is loaded in a new tab in an existing window instead.
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 "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
@@ -1021,6 +990,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Netscape not running - start it
@@ -1032,6 +1002,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-netscape-reload ()
"Ask Netscape to reload its current document.
How depends on `browse-url-netscape-version'."
+ (declare (obsolete nil "25.1"))
(interactive)
;; Backwards incompatibility reported by
;; <peter.kruse@psychologie.uni-regensburg.de>.
@@ -1041,6 +1012,7 @@ How depends on `browse-url-netscape-version'."
(defun browse-url-netscape-send (command)
"Send a remote control command to Netscape."
+ (declare (obsolete nil "25.1"))
(let* ((process-environment (browse-url-process-environment)))
(apply 'start-process "netscape" nil
browse-url-netscape-program
@@ -1099,71 +1071,35 @@ used instead of `browse-url-new-window-flag'."
;;;###autoload
(defun browse-url-firefox (url &optional new-window)
"Ask the Firefox WWW browser to load URL.
-Default to the URL around or before point. The strings in
-variable `browse-url-firefox-arguments' are also passed to
-Firefox.
+Defaults to the URL around or before point. Passes the strings
+in the variable `browse-url-firefox-arguments' to Firefox.
-When called interactively, if variable
-`browse-url-new-window-flag' is non-nil, load the document in a
-new Firefox window, otherwise use a random existing one. A
-non-nil interactive prefix argument reverses the effect of
-`browse-url-new-window-flag'.
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new Firefox window. A non-nil prefix argument
+reverses the effect of `browse-url-new-window-flag'.
If `browse-url-firefox-new-window-is-tab' is non-nil, then
whenever a document would otherwise be loaded in a new window, it
is loaded in a new tab in an existing window instead.
-When called non-interactively, optional second argument
-NEW-WINDOW is used instead of `browse-url-new-window-flag'.
-
-On MS-Windows systems the optional `new-window' parameter is
-ignored. Firefox for Windows does not support the \"-remote\"
-command line parameter. Therefore, the
-`browse-url-new-window-flag' and `browse-url-firefox-new-window-is-tab'
-are ignored as well. Firefox on Windows will always open the requested
-URL in a new window."
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'."
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
- (let* ((process-environment (browse-url-process-environment))
- (use-remote
- (not (memq system-type '(windows-nt ms-dos))))
- (process
- (apply 'start-process
- (concat "firefox " url) nil
- browse-url-firefox-program
- (append
- browse-url-firefox-arguments
- (if use-remote
- (list "-remote"
- (concat
- "openURL("
- url
- (if (browse-url-maybe-new-window new-window)
- (if browse-url-firefox-new-window-is-tab
- ",new-tab"
- ",new-window"))
- ")"))
- (list url))))))
- ;; If we use -remote, the process exits with status code 2 if
- ;; Firefox is not already running. The sentinel runs firefox
- ;; directly if that happens.
- (when use-remote
- (set-process-sentinel process
- `(lambda (process change)
- (browse-url-firefox-sentinel process ,url))))))
-
-(defun browse-url-firefox-sentinel (process url)
- "Handle a change to the process communicating with Firefox."
- (or (eq (process-exit-status process) 0)
- (let* ((process-environment (browse-url-process-environment)))
- ;; Firefox is not running - start it
- (message "Starting Firefox...")
- (apply 'start-process (concat "firefox " url) nil
- browse-url-firefox-program
- (append browse-url-firefox-startup-arguments (list url))))))
+ (let* ((process-environment (browse-url-process-environment)))
+ (apply 'start-process
+ (concat "firefox " url) nil
+ browse-url-firefox-program
+ (append
+ browse-url-firefox-arguments
+ (if (browse-url-maybe-new-window new-window)
+ (if browse-url-firefox-new-window-is-tab
+ '("-new-tab")
+ '("-new-window")))
+ (list url)))))
;;;###autoload
-(defun browse-url-chromium (url &optional new-window)
+(defun browse-url-chromium (url &optional _new-window)
"Ask the Chromium WWW browser to load URL.
Default to the URL around or before point. The strings in
variable `browse-url-chromium-arguments' are also passed to
@@ -1195,6 +1131,7 @@ new tab in an existing window instead.
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 "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment))
@@ -1216,6 +1153,7 @@ used instead of `browse-url-new-window-flag'."
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
+ (declare (obsolete nil "25.1"))
(or (eq (process-exit-status process) 0)
(let* ((process-environment (browse-url-process-environment)))
;; Galeon is not running - start it
@@ -1272,7 +1210,7 @@ used instead of `browse-url-new-window-flag'."
(defvar url-handler-regexp)
;;;###autoload
-(defun browse-url-emacs (url &optional new-window)
+(defun browse-url-emacs (url &optional _new-window)
"Ask Emacs to load URL into a buffer and show it in another window."
(interactive (browse-url-interactive-arg "URL: "))
(require 'url-handlers)
@@ -1298,6 +1236,7 @@ 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 "URL: "))
(apply 'start-process (concat "gnome-moz-remote " url)
nil
@@ -1326,32 +1265,33 @@ 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)
- (save-excursion
- (find-file pidfile)
- (goto-char (point-min))
- (setq pid (read (current-buffer)))
- (kill-buffer nil)))
- (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
- (save-excursion
- (find-file (format "/tmp/Mosaic.%d" pid))
- (erase-buffer)
- (insert (if (browse-url-maybe-new-window new-window)
- "newwin\n"
- "goto\n")
- url "\n")
- (save-buffer)
- (kill-buffer nil)
+ (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))
+ ;; http://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")
- )
+ (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
@@ -1376,6 +1316,7 @@ 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)
@@ -1389,6 +1330,42 @@ used instead of `browse-url-new-window-flag'."
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
+;; --- Conkeror ---
+;;;###autoload
+(defun browse-url-conkeror (url &optional new-window)
+ "Ask the Conkeror WWW browser to load URL.
+Default to the URL around or before point. Also pass the strings
+in the variable `browse-url-conkeror-arguments' to Conkeror.
+
+When called interactively, if variable
+`browse-url-new-window-flag' is non-nil, load the document in a
+new Conkeror window, otherwise use a random existing one. A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-flag'.
+
+If variable `browse-url-conkeror-new-window-is-buffer' is
+non-nil, then whenever a document would otherwise be loaded in a
+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'."
+ (interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
+ (let* ((process-environment (browse-url-process-environment)))
+ (apply 'start-process (format "conkeror %s" url)
+ nil
+ browse-url-conkeror-program
+ (append
+ browse-url-conkeror-arguments
+ (list
+ "-e"
+ (format "load_url_in_new_%s('%s')"
+ (if (browse-url-maybe-new-window new-window)
+ (if browse-url-conkeror-new-window-is-buffer
+ "buffer"
+ "window")
+ "buffer")
+ url))))))
;; --- W3 ---
;; External.
@@ -1413,11 +1390,12 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch url)))
;;;###autoload
-(defun browse-url-w3-gnudoit (url &optional new-window)
+(defun browse-url-w3-gnudoit (url &optional _new-window)
;; new-window ignored
"Ask another Emacs running gnuserv to load the URL using the W3 browser.
The `browse-url-gnudoit-program' program is used with options given by
`browse-url-gnudoit-args'. Default to the URL around or before point."
+ (declare (obsolete nil "25.1"))
(interactive (browse-url-interactive-arg "W3 URL: "))
(apply 'start-process (concat "gnudoit:" url) nil
browse-url-gnudoit-program
@@ -1428,7 +1406,7 @@ The `browse-url-gnudoit-program' program is used with options given by
;; --- Lynx in an xterm ---
;;;###autoload
-(defun browse-url-text-xterm (url &optional new-window)
+(defun browse-url-text-xterm (url &optional _new-window)
;; new-window ignored
"Ask a text browser to load URL.
URL defaults to the URL around or before point.
@@ -1469,7 +1447,7 @@ used instead of `browse-url-new-window-flag'."
(n browse-url-text-input-attempts))
(require 'term)
(if (and (browse-url-maybe-new-window new-buffer) buf)
- ;; Rename away the OLD buffer. This isn't very polite, but
+ ;; Rename away the OLD buffer. This isn't very polite, but
;; term insists on working in a buffer named *lynx* and would
;; choke on *lynx*<1>
(progn (set-buffer buf)
@@ -1492,7 +1470,7 @@ used instead of `browse-url-new-window-flag'."
(get-buffer-process buf)
;; Don't leave around a dead one (especially because of its
;; munged keymap.)
- (lambda (process event)
+ (lambda (process _event)
(if (not (memq (process-status process) '(run stop)))
(let ((buf (process-buffer process)))
(if buf (kill-buffer buf)))))))
@@ -1565,7 +1543,7 @@ used instead of `browse-url-new-window-flag'."
;; --- Random browser ---
;;;###autoload
-(defun browse-url-generic (url &optional new-window)
+(defun browse-url-generic (url &optional _new-window)
;; new-window ignored
"Ask the WWW browser defined by `browse-url-generic-program' to load URL.
Default to the URL around or before point. A fresh copy of the
@@ -1580,7 +1558,7 @@ don't offer a form of remote control."
(append browse-url-generic-args (list url))))
;;;###autoload
-(defun browse-url-kde (url &optional new-window)
+(defun browse-url-kde (url &optional _new-window)
"Ask the KDE WWW browser to load URL.
Default to the URL around or before point."
(interactive (browse-url-interactive-arg "KDE URL: "))
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 0e9c4fc5c76..e8e6bc0cb6a 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -1,6 +1,6 @@
;;; dbus.el --- Elisp bindings for D-Bus.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
@@ -35,7 +35,7 @@
;; Declare used subroutines and variables.
(declare-function dbus-message-internal "dbusbind.c")
-(declare-function dbus-init-bus "dbusbind.c")
+(declare-function dbus--init-bus "dbusbind.c")
(defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return)
@@ -55,6 +55,9 @@
(defconst dbus-path-dbus "/org/freedesktop/DBus"
"The object path used to talk to the bus itself.")
+(defconst dbus-path-local (concat dbus-path-dbus "/Local")
+ "The object path used in local/in-process-generated messages.")
+
;; Default D-Bus interfaces.
(defconst dbus-interface-dbus "org.freedesktop.DBus"
@@ -129,6 +132,15 @@ See URL `http://dbus.freedesktop.org/doc/dbus-specification.html#standard-interf
;; </signal>
;; </interface>
+(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
+ "An interface whose methods can only be invoked by the local implementation.")
+
+;; <interface name="org.freedesktop.DBus.Local">
+;; <signal name="Disconnected">
+;; <arg name="object_path" type="o"/>
+;; </signal>
+;; </interface>
+
;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
@@ -154,7 +166,7 @@ Otherwise, return result of last form in BODY, or all other errors."
(define-obsolete-variable-alias 'dbus-event-error-hooks
'dbus-event-error-functions "24.3")
-(defvar dbus-event-error-functions nil
+(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'.")
@@ -167,17 +179,34 @@ caught in `condition-case' by `dbus-error'.")
A key in this hash table is a list (:serial BUS SERIAL), like in
`dbus-registered-objects-table'. BUS is either a Lisp symbol,
`:system' or `:session', or a string denoting the bus address.
-SERIAL is the serial number of the reply message.")
+SERIAL is the serial number of the reply message.
+
+The value of an entry is a cons (STATE . RESULT). STATE can be
+either `:pending' (we are still waiting for the result),
+`:complete' (the result is available) or `:error' (the reply
+message was an error message).")
(defun dbus-call-method-handler (&rest args)
"Handler for reply messages of asynchronous D-Bus message calls.
It calls the function stored in `dbus-registered-objects-table'.
The result will be made available in `dbus-return-values-table'."
- (puthash (list :serial
- (dbus-event-bus-name last-input-event)
- (dbus-event-serial-number last-input-event))
- (if (= (length args) 1) (car args) args)
- dbus-return-values-table))
+ (let* ((key (list :serial
+ (dbus-event-bus-name last-input-event)
+ (dbus-event-serial-number last-input-event)))
+ (result (gethash key dbus-return-values-table)))
+ (when (consp result)
+ (setcar result :complete)
+ (setcdr result (if (= (length args) 1) (car args) args)))))
+
+(defun dbus-notice-synchronous-call-errors (ev er)
+ "Detect errors resulting from pending synchronous calls."
+ (let* ((key (list :serial
+ (dbus-event-bus-name ev)
+ (dbus-event-serial-number ev)))
+ (result (gethash key dbus-return-values-table)))
+ (when (consp result)
+ (setcar result :error)
+ (setcdr result er))))
(defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS.
@@ -248,6 +277,8 @@ object is returned instead of a list containing this single Lisp object.
=> \"i686\""
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session)) (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
@@ -260,27 +291,44 @@ object is returned instead of a list containing this single Lisp object.
(signal 'wrong-type-argument (list 'stringp method)))
(let ((timeout (plist-get args :timeout))
+ (check-interval 0.001)
(key
(apply
'dbus-message-internal dbus-message-type-method-call
- bus service path interface method 'dbus-call-method-handler args)))
+ 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
;; `dbus-return-values-table'. If no timeout is given, use the
;; default 25". Events which are not from D-Bus must be restored.
;; `read-event' performs a redisplay. This must be suppressed; it
;; hurts when reading D-Bus events asynchronously.
- (with-timeout ((if timeout (/ timeout 1000.0) 25))
- (while (eq (gethash key dbus-return-values-table :ignore) :ignore)
- (let ((event (let ((inhibit-redisplay t) unread-command-events)
- (read-event nil nil 0.1))))
- (when (and event (not (ignore-errors (dbus-check-event event))))
- (setq unread-command-events
- (append unread-command-events (list event)))))))
-
- ;; Cleanup `dbus-return-values-table'. Return the result.
- (prog1
- (gethash key dbus-return-values-table)
+
+ ;; Work around bug#16775 by busy-waiting with gradual backoff for
+ ;; dbus calls to complete. A better approach would involve either
+ ;; adding arbitrary wait condition support to read-event or
+ ;; restructuring dbus as a kind of process object. Poll at most
+ ;; about once per second for completion.
+
+ (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))
(remhash key dbus-return-values-table))))
;; `dbus-call-method' works non-blocking now.
@@ -329,13 +377,15 @@ 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\")
- => \(:serial :system 2)
+ => (:serial :system 2)
-| i686"
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session)) (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
@@ -384,6 +434,8 @@ Example:
:session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
\"FileModified\" \"/home/albinus/.emacs\")"
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session)) (stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
@@ -402,6 +454,8 @@ Example:
"Return for message SERIAL on the D-Bus BUS.
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)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
@@ -416,6 +470,8 @@ This is an internal function, it shall not be used outside dbus.el."
"Return error message for message SERIAL on the D-Bus BUS.
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)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
@@ -488,6 +544,10 @@ placed in the queue.
`:already-owner': Service is already the primary owner."
+ ;; Add Peer handler.
+ (dbus-register-method
+ 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"
@@ -521,7 +581,7 @@ 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:
-`:released': Service has become the primary owner of the name.
+`:released': We successfully released the service.
`:non-existent': Service name does not exist on this bus.
@@ -530,12 +590,13 @@ queue of this service."
(maphash
(lambda (key value)
- (dolist (elt value)
- (ignore-errors
- (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
- (unless
- (puthash key (delete elt value) dbus-registered-objects-table)
- (remhash key dbus-registered-objects-table))))))
+ (unless (equal :serial (car key))
+ (dolist (elt value)
+ (ignore-errors
+ (when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
+ (unless
+ (puthash key (delete elt value) dbus-registered-objects-table)
+ (remhash key dbus-registered-objects-table)))))))
dbus-registered-objects-table)
(let ((reply (dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
@@ -593,10 +654,10 @@ 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))
+ => ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
+ (\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
`dbus-register-signal' returns an object, which can be used in
`dbus-unregister-object' for removing the registration."
@@ -646,7 +707,8 @@ Example:
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
value (car args))
- (unless (and (<= counter 63) (stringp value))
+ (unless (and (<= (string-to-number counter) 63)
+ (stringp value))
(signal 'wrong-type-argument
(list "Wrong argument" key value)))
(format
@@ -751,7 +813,7 @@ discovering the still incomplete interface."
"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.
+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
@@ -807,7 +869,7 @@ association to the service from D-Bus."
;; Service.
(string-equal service (cadr e))
;; Non-empty object path.
- (cl-caddr e)
+ (nth 2 e)
(throw :found t)))))
dbus-registered-objects-table)
nil))))
@@ -827,10 +889,18 @@ STRING shall be UTF8 coded."
(dolist (elt (string-to-list string) (append '(:array) result))
(setq result (append result (list :byte elt)))))))
-(defun dbus-byte-array-to-string (byte-array)
+(defun dbus-byte-array-to-string (byte-array &optional multibyte)
"Transforms BYTE-ARRAY into UTF8 coded string.
-BYTE-ARRAY must be a list of structure (c1 c2 ...)."
- (apply 'string byte-array))
+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)))))))))
(defun dbus-escape-as-identifier (string)
"Escape an arbitrary STRING so it follows the rules for a C identifier.
@@ -848,7 +918,7 @@ and a smaller allowed set. As a special case, \"\" is escaped to
\"_\".
Returns the escaped string. Algorithm taken from
-telepathy-glib's `tp-escape-as-identifier'."
+telepathy-glib's `tp_escape_as_identifier'."
(if (zerop (length string))
"_"
(replace-regexp-in-string
@@ -857,13 +927,13 @@ telepathy-glib's `tp-escape-as-identifier'."
string)))
(defun dbus-unescape-from-identifier (string)
- "Retrieve the original string from the encoded STRING.
-STRING must have been coded with `dbus-escape-as-identifier'"
+ "Retrieve the original string from the encoded STRING as unibyte string.
+STRING must have been encoded with `dbus-escape-as-identifier'."
(if (string-equal string "_")
""
(replace-regexp-in-string
"_.."
- (lambda (x) (format "%c" (string-to-number (substring x 1) 16)))
+ (lambda (x) (byte-to-string (string-to-number (substring x 1) 16)))
string)))
@@ -902,7 +972,8 @@ not well formed."
;; Service.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
- (stringp (nth 4 event)))
+ (or (stringp (nth 4 event))
+ (null (nth 4 event))))
;; Object path.
(or (= dbus-message-type-method-return (nth 2 event))
(= dbus-message-type-error (nth 2 event))
@@ -953,7 +1024,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(nth 1 event) (nth 4 event) (nth 3 event) (cadr err))))
;; Propagate D-Bus error messages.
(run-hook-with-args 'dbus-event-error-functions event err)
- (when (or dbus-debug (= dbus-message-type-error (nth 2 event)))
+ (when dbus-debug
(signal (car err) (cdr err))))))
(defun dbus-event-bus-name (event)
@@ -1021,7 +1092,7 @@ well formed."
(defun dbus-list-activatable-names (&optional bus)
"Return the D-Bus service names which can be activated as list.
If BUS is left nil, `:system' is assumed. The result is a list
-of strings, which is `nil' when there are no activatable service
+of strings, which is nil when there are no activatable service
names at all."
(dbus-ignore-errors
(dbus-call-method
@@ -1030,7 +1101,7 @@ names at all."
(defun dbus-list-names (bus)
"Return the service names registered at D-Bus BUS.
-The result is a list of strings, which is `nil' when there are no
+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."
@@ -1048,7 +1119,7 @@ A service has a known name if it doesn't start with \":\"."
(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
+The result is a list of strings, or nil when there are no
queued name owners service names at all."
(dbus-ignore-errors
(dbus-call-method
@@ -1057,7 +1128,7 @@ queued name owners service names at all."
(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."
+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
@@ -1072,9 +1143,9 @@ Note, that this autoloads SERVICE if it is not running yet. If
it shall be checked whether SERVICE is already running, one shall
apply
- \(member service \(dbus-list-known-names bus))"
+ (member service \(dbus-list-known-names bus))"
;; "Ping" raises a D-Bus error if SERVICE does not exist.
- ;; Otherwise, it returns silently with `nil'.
+ ;; Otherwise, it returns silently with nil.
(condition-case nil
(not
(if (natnump timeout)
@@ -1085,6 +1156,22 @@ apply
bus service dbus-path-dbus dbus-interface-peer "Ping")))
(dbus-error nil)))
+(defun dbus-peer-handler ()
+ "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)))
+ (cond
+ ;; "Ping" does not return an output parameter.
+ ((string-equal method "Ping")
+ :ignore)
+ ;; "GetMachineId" returns "s".
+ ((string-equal method "GetMachineId")
+ (signal
+ 'dbus-error
+ (list
+ (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+
;;; D-Bus introspection.
@@ -1248,7 +1335,7 @@ object can contain \"annotation\" children."
(defun dbus-introspect-get-annotation-names
(bus service path interface &optional name)
"Return all annotation names as list of strings.
-If NAME is `nil', the annotations are children of INTERFACE,
+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
@@ -1265,7 +1352,7 @@ object, where the annotations belong to."
(defun dbus-introspect-get-annotation
(bus service path interface name annotation)
"Return ANNOTATION as XML object.
-If NAME is `nil', ANNOTATION is a child of INTERFACE, otherwise
+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
@@ -1289,7 +1376,7 @@ NAME must be the name of a \"method\", \"signal\", or
"Return a list of all argument names as list of strings.
NAME must be a \"method\" or \"signal\" object.
-Argument names are optional, the function can return `nil'
+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)
@@ -1317,9 +1404,9 @@ element of the list returned by `dbus-introspect-get-argument-names'."
(bus service path interface name &optional direction)
"Return signature of a `method' or `signal', represented by NAME, as string.
If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
-If DIRECTION is `nil', \"in\" is assumed.
+If DIRECTION is nil, \"in\" is assumed.
-If NAME is a `signal', and DIRECTION is non-`nil', DIRECTION must
+If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must
be \"out\"."
;; For methods, we use "in" as default direction.
(let ((object (or (dbus-introspect-get-method
@@ -1353,7 +1440,7 @@ 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."
+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
@@ -1364,7 +1451,7 @@ valid D-Bus value, or `nil' if there is no 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 has
-been set successful, the result is VALUE. Otherwise, `nil' is
+been set successful, the result is VALUE. Otherwise, nil is
returned."
(dbus-ignore-errors
;; "Set" requires a variant.
@@ -1378,7 +1465,7 @@ returned."
"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."
+nil is returned."
(dbus-ignore-errors
;; "GetAll" returns "a{sv}".
(let (result)
@@ -1544,22 +1631,22 @@ name, and the cdr is the list of properties as returned by
\(dbus-get-all-managed-objects :session \"org.gnome.SettingsDaemon\" \"/\")
- => \(\(\"/org/gnome/SettingsDaemon/MediaKeys\"
- \(\"org.gnome.SettingsDaemon.MediaKeys\")
- \(\"org.freedesktop.DBus.Peer\")
- \(\"org.freedesktop.DBus.Introspectable\")
- \(\"org.freedesktop.DBus.Properties\")
- \(\"org.freedesktop.DBus.ObjectManager\"))
- \(\"/org/gnome/SettingsDaemon/Power\"
- \(\"org.gnome.SettingsDaemon.Power.Keyboard\")
- \(\"org.gnome.SettingsDaemon.Power.Screen\")
- \(\"org.gnome.SettingsDaemon.Power\"
- \(\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
- \(\"Tooltip\" . \"Laptop battery is charged\"))
- \(\"org.freedesktop.DBus.Peer\")
- \(\"org.freedesktop.DBus.Introspectable\")
- \(\"org.freedesktop.DBus.Properties\")
- \(\"org.freedesktop.DBus.ObjectManager\"))
+ => ((\"/org/gnome/SettingsDaemon/MediaKeys\"
+ (\"org.gnome.SettingsDaemon.MediaKeys\")
+ (\"org.freedesktop.DBus.Peer\")
+ (\"org.freedesktop.DBus.Introspectable\")
+ (\"org.freedesktop.DBus.Properties\")
+ (\"org.freedesktop.DBus.ObjectManager\"))
+ (\"/org/gnome/SettingsDaemon/Power\"
+ (\"org.gnome.SettingsDaemon.Power.Keyboard\")
+ (\"org.gnome.SettingsDaemon.Power.Screen\")
+ (\"org.gnome.SettingsDaemon.Power\"
+ (\"Icon\" . \". GThemedIcon battery-full-charged-symbolic \")
+ (\"Tooltip\" . \"Laptop battery is charged\"))
+ (\"org.freedesktop.DBus.Peer\")
+ (\"org.freedesktop.DBus.Introspectable\")
+ (\"org.freedesktop.DBus.Properties\")
+ (\"org.freedesktop.DBus.ObjectManager\"))
...)
If possible, \"org.freedesktop.DBus.ObjectManager.GetManagedObjects\"
@@ -1606,10 +1693,9 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow."
(defun dbus-managed-objects-handler ()
"Default handler for the \"org.freedesktop.DBus.ObjectManager\" interface.
-It will be registered for all objects created by `dbus-register-method'."
+It will be registered for all objects created by `dbus-register-service'."
(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)))
;; "GetManagedObjects" returns "a{oa{sa{sv}}}".
(let (interfaces result)
@@ -1625,8 +1711,7 @@ It will be registered for all objects created by `dbus-register-method'."
;; Check all registered object paths.
(maphash
(lambda (key val)
- (let ((object (or (nth 2 (car-safe val)) ""))
- (interface (nth 2 key)))
+ (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))
@@ -1661,6 +1746,63 @@ It will be registered for all objects created by `dbus-register-method'."
result)
'(:signature "{oa{sa{sv}}}"))))))
+(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))
+ (maphash
+ (lambda (key value)
+ (when (and (eq (nth 0 key) :serial)
+ (eq (nth 1 key) bus))
+ (run-hook-with-args
+ 'dbus-event-error-functions
+ (list 'dbus-event
+ bus
+ dbus-message-type-error
+ (nth 2 key)
+ nil
+ nil
+ nil
+ nil
+ value)
+ (list 'dbus-error "Bus disconnected" bus))
+ (push key keys-to-remove)))
+ dbus-registered-objects-table)
+ (dolist (key keys-to-remove)
+ (remhash key dbus-registered-objects-table))))
+
+(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.
+
+The function returns a number, which counts the connections this Emacs
+session has established to the BUS under the same unique name (see
+`dbus-get-unique-name'). It depends on the libraries Emacs is linked
+with, and on the environment Emacs is running. For 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."
+ (or (featurep 'dbusbind)
+ (signal 'dbus-error (list "Emacs not compiled with dbus support")))
+ (dbus--init-bus bus private)
+ (dbus-register-signal
+ bus nil dbus-path-local dbus-interface-local
+ "Disconnected" #'dbus-handle-bus-disconnect))
+
;; Initialize `:system' and `:session' buses. This adds their file
;; descriptors to input_wait_mask, in order to detect incoming
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 73c2d871824..234139f94bd 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -1,6 +1,6 @@
;;; dig.el --- Domain Name System dig interface
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS BIND dig comm
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 1c456eb8202..ba6523f6f5f 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -1,6 +1,6 @@
;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network comm
@@ -31,6 +31,12 @@
"List of DNS servers to query.
If nil, /etc/resolv.conf and nslookup will be consulted.")
+(defvar dns-servers-valid-for-interfaces nil
+ "The return value of `network-interface-list' when `dns-servers' was set.
+If the set of network interfaces and/or their IP addresses
+change, then presumably the list of DNS servers needs to be
+updated. Set this variable to t to disable the check.")
+
;;; Internal code:
(defvar dns-query-types
@@ -297,6 +303,17 @@ If TCP-P, the first two bytes of the package with be the length field."
(t string)))
(goto-char point))))
+(declare-function network-interface-list "process.c")
+
+(defun dns-servers-up-to-date-p ()
+ "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\"."
@@ -314,7 +331,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
(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)))))))
+ (setq dns-servers (list (match-string 1))))))
+ (when (fboundp 'network-interface-list)
+ (setq dns-servers-valid-for-interfaces (network-interface-list))))
(defun dns-read-txt (string)
(if (> (length string) 1)
@@ -378,7 +397,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
If FULLP, return the entire record returned.
If REVERSEP, look up an IP address."
(setq type (or type 'A))
- (unless dns-servers
+ (unless (dns-servers-up-to-date-p)
(dns-set-servers))
(when reversep
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 106aab2ac0a..e48af4dc205 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,9 +1,10 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC -*- coding: utf-8 -*-
+;;; eudc-bob.el --- Binary Objects Support for EUDC
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index 8e52a4df4ed..c60911ff0c5 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -1,9 +1,10 @@
-;;; eudc-export.el --- functions to export EUDC query results -*- coding: utf-8 -*-
+;;; eudc-export.el --- functions to export EUDC query results
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -173,7 +174,7 @@ LOCATION is used as the phone location for BBDB."
(condition-case err
(setq phone-list (bbdb-parse-phone-number phone))
(error
- (if (string= "phone number unparsable." (eudc-cadr err))
+ (if (string= "phone number unparsable." (cadr err))
(if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone)))
(error "Phone number unparsable")
(setq phone-list (list (bbdb-string-trim phone))))
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index a8a51b7d61b..55a2fd9a20a 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -1,9 +1,10 @@
-;;; eudc-hotlist.el --- hotlist management for EUDC -*- coding: utf-8 -*-
+;;; eudc-hotlist.el --- hotlist management for EUDC
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -44,7 +45,7 @@
(define-key map "x" 'kill-this-buffer)
map))
-(defun eudc-hotlist-mode ()
+(define-derived-mode eudc-hotlist-mode fundamental-mode "EUDC-Servers"
"Major mode used to edit the hotlist of servers.
These are the special commands of this mode:
@@ -54,18 +55,12 @@ These are the special commands of this mode:
t -- Transpose the server at point and the previous one
q -- Commit the changes and quit.
x -- Quit without committing the changes."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'eudc-hotlist-mode)
- (setq mode-name "EUDC-Servers")
- (use-local-map eudc-hotlist-mode-map)
(when (featurep 'xemacs)
(setq mode-popup-menu eudc-hotlist-menu)
(when (featurep 'menubar)
(set-buffer-menubar current-menubar)
(add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))))
- (setq buffer-read-only t)
- (run-mode-hooks 'eudc-hotlist-mode-hook))
+ (setq buffer-read-only t))
;;;###autoload
(defun eudc-edit-hotlist ()
@@ -76,10 +71,8 @@ These are the special commands of this mode:
(switch-to-buffer (get-buffer-create "*EUDC Servers*"))
(setq buffer-read-only nil)
(erase-buffer)
- (mapc (function
- (lambda (entry)
- (setq proto-col (max (length (car entry)) proto-col))))
- eudc-server-hotlist)
+ (dolist (entry eudc-server-hotlist)
+ (setq proto-col (max (length (car entry)) proto-col)))
(setq proto-col (+ 3 proto-col))
(setq gap (make-string (- proto-col 6) ?\ ))
(insert " EUDC Servers\n"
@@ -89,17 +82,16 @@ These are the special commands of this mode:
"------" gap "--------\n"
"\n")
(setq eudc-hotlist-list-beginning (point))
- (mapc (lambda (entry)
- (insert (car entry))
- (indent-to proto-col)
- (insert (symbol-name (cdr entry)) "\n"))
- eudc-server-hotlist)
- (eudc-hotlist-mode)))
+ (dolist (entry eudc-server-hotlist)
+ (insert (car entry))
+ (indent-to proto-col)
+ (insert (symbol-name (cdr entry)) "\n"))
+ (eudc-hotlist-mode)))
(defun eudc-hotlist-add-server ()
"Add a new server to the list after current one."
(interactive)
- (if (not (eq major-mode 'eudc-hotlist-mode))
+ (if (not (derived-mode-p 'eudc-hotlist-mode))
(error "Not in a EUDC hotlist edit buffer"))
(let ((server (read-from-minibuffer "Server: "))
(protocol (completing-read "Protocol: "
@@ -117,7 +109,7 @@ These are the special commands of this mode:
(defun eudc-hotlist-delete-server ()
"Delete the server at point from the list."
(interactive)
- (if (not (eq major-mode 'eudc-hotlist-mode))
+ (if (not (derived-mode-p 'eudc-hotlist-mode))
(error "Not in a EUDC hotlist edit buffer"))
(let ((buffer-read-only nil))
(save-excursion
@@ -130,7 +122,7 @@ These are the special commands of this mode:
(defun eudc-hotlist-quit-edit ()
"Quit the hotlist editing mode and save changes to the hotlist."
(interactive)
- (if (not (eq major-mode 'eudc-hotlist-mode))
+ (if (not (derived-mode-p 'eudc-hotlist-mode))
(error "Not in a EUDC hotlist edit buffer"))
(let (hotlist)
(goto-char eudc-hotlist-list-beginning)
@@ -149,7 +141,7 @@ These are the special commands of this mode:
(defun eudc-hotlist-select-server ()
"Select the server at point as the current server."
(interactive)
- (if (not (eq major-mode 'eudc-hotlist-mode))
+ (if (not (derived-mode-p 'eudc-hotlist-mode))
(error "Not in a EUDC hotlist edit buffer"))
(save-excursion
(beginning-of-line)
@@ -163,7 +155,7 @@ These are the special commands of this mode:
(defun eudc-hotlist-transpose-servers ()
"Swap the order of the server with the previous one in the list."
(interactive)
- (if (not (eq major-mode 'eudc-hotlist-mode))
+ (if (not (derived-mode-p 'eudc-hotlist-mode))
(error "Not in a EUDC hotlist edit buffer"))
(let ((buffer-read-only nil))
(save-excursion
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index d53fd83eee7..8cffa8e466a 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -1,9 +1,10 @@
-;;; eudc-vars.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
+;;; eudc-vars.el --- Emacs Unified Directory Client
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -41,14 +42,36 @@
"The name or IP address of the directory server.
A port number may be specified by appending a colon and a
number to the name of the server. Use `localhost' if the directory
-server resides on your computer (BBDB backend)."
- :type '(choice (string :tag "Server") (const :tag "None" nil))
- :group 'eudc)
+server resides on your computer (BBDB backend).
+
+To specify multiple servers, customize eudc-server-hotlist
+instead."
+ :type '(choice (string :tag "Server") (const :tag "None" nil)))
;; Known protocols (used in completion)
;; Not to be mistaken with `eudc-supported-protocols'
(defvar eudc-known-protocols '(bbdb ph ldap))
+(defcustom eudc-server-hotlist nil
+ "Directory servers to query.
+This is an alist of the form (SERVER . PROTOCOL). SERVER is the
+host name or URI of the server, PROTOCOL is a symbol representing
+the EUDC backend with which to access the server.
+
+The BBDB backend ignores SERVER; `localhost' can be used as a
+placeholder string."
+ :tag "Directory Servers to Query"
+ :type `(repeat (cons :tag "Directory Server"
+ (string :tag "Server Host Name or URI")
+ (choice :tag "Protocol"
+ :menu-tag "Protocol"
+ ,@(mapcar (lambda (s)
+ (list 'const
+ ':tag (symbol-name s) s))
+ eudc-known-protocols)
+ (const :tag "None" nil))))
+ :version "25.1")
+
(defvar eudc-supported-protocols nil
"Protocols currently supported by EUDC.
This variable is updated when protocol-specific libraries
@@ -61,15 +84,13 @@ Supported protocols are specified by `eudc-supported-protocols'."
,@(mapcar (lambda (s)
(list 'const ':tag (symbol-name s) s))
eudc-known-protocols)
- (const :tag "None" nil))
- :group 'eudc)
+ (const :tag "None" nil)))
(defcustom eudc-strict-return-matches t
"Ignore or allow entries not containing all requested return attributes.
If non-nil, such entries are ignored."
- :type 'boolean
- :group 'eudc)
+ :type 'boolean)
(defcustom eudc-default-return-attributes nil
"A list of default attributes to extract from directory entries.
@@ -82,8 +103,7 @@ server."
(repeat :menu-tag "Attribute list"
:tag "Attribute name"
:value (nil)
- (symbol :tag "Attribute name")))
- :group 'eudc)
+ (symbol :tag "Attribute name"))))
(defcustom eudc-multiple-match-handling-method 'select
"What to do when multiple entries match an inline expansion query.
@@ -102,8 +122,7 @@ Possible values are:
(const :menu-tag "Abort Operation"
:tag "Abort Operation" abort)
(const :menu-tag "Default (Use First)"
- :tag "Default (Use First)" nil))
- :group 'eudc)
+ :tag "Default (Use First)" nil)))
(defcustom eudc-duplicate-attribute-handling-method '((email . duplicate))
"A method to handle entries containing duplicate attributes.
@@ -130,10 +149,10 @@ different values."
(const :menu-tag "List" list)
(const :menu-tag "First" first)
(const :menu-tag "Concat" concat)
- (const :menu-tag "Duplicate" duplicate)))))
- :group 'eudc)
+ (const :menu-tag "Duplicate" duplicate))))))
-(defcustom eudc-inline-query-format '((name)
+(defcustom eudc-inline-query-format '((email)
+ (firstname)
(firstname name))
"Format of an inline expansion query.
This is a list of FORMATs. A FORMAT is itself a list of one or more
@@ -160,14 +179,16 @@ must be set in a protocol/server-local fashion, see `eudc-server-set' and
(const :menu-tag "Email Address" :tag "Email Address" email)
(const :menu-tag "Phone" :tag "Phone" phone)
(symbol :menu-tag "Other" :tag "Attribute name"))))
- :group 'eudc)
+ :version "25.1")
-(defcustom eudc-expansion-overwrites-query t
+;; Default to nil so that the most common use of eudc-expand-inline,
+;; where replace is nil, does not affect the kill ring.
+(defcustom eudc-expansion-overwrites-query nil
"If non-nil, expanding a query overwrites the query string."
:type 'boolean
- :group 'eudc)
+ :version "25.1")
-(defcustom eudc-inline-expansion-format '("%s" email)
+(defcustom eudc-inline-expansion-format '("%s %s <%s>" firstname name email)
"A list specifying the format of the expansion of inline queries.
This variable controls what `eudc-expand-inline' actually inserts in
the buffer. First element is a string passed to `format'. Remaining
@@ -185,7 +206,7 @@ are passed as additional arguments to `format'."
(const :menu-tag "Phone" :tag "Phone" phone)
(symbol :menu-tag "Other")
(symbol :tag "Attribute name"))))
- :group 'eudc)
+ :version "25.1")
(defcustom eudc-inline-expansion-servers 'server-then-hotlist
"Which servers to contact for the expansion of inline queries.
@@ -198,8 +219,7 @@ Possible values are:
:menu-tag "Servers"
(const :menu-tag "Current server" current-server)
(const :menu-tag "Servers in the hotlist" hotlist)
- (const :menu-tag "Current server then hotlist" server-then-hotlist))
- :group 'eudc)
+ (const :menu-tag "Current server then hotlist" server-then-hotlist)))
(defcustom eudc-max-servers-to-query nil
"Maximum number of servers to query for an inline expansion.
@@ -213,8 +233,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
(const :menu-tag "3" 3)
(const :menu-tag "4" 4)
(const :menu-tag "5" 5)
- (integer :menu-tag "Set"))
- :group 'eudc)
+ (integer :menu-tag "Set")))
(defcustom eudc-query-form-attributes '(name firstname email phone)
"A list of attributes presented in the query form."
@@ -226,8 +245,7 @@ If nil, query all servers available from `eudc-inline-expansion-servers'."
(const :menu-tag "Surname" :tag "Surname" name)
(const :menu-tag "Email Address" :tag "Email Address" email)
(const :menu-tag "Phone" :tag "Phone" phone)
- (symbol :menu-tag "Other" :tag "Attribute name")))
- :group 'eudc)
+ (symbol :menu-tag "Other" :tag "Attribute name"))))
(defcustom eudc-user-attribute-names-alist '((url . "URL")
(callsign . "HAM Call Sign")
@@ -257,15 +275,13 @@ at `_' characters and capitalizing the individual words."
:tag "User-defined Names of Directory Attributes"
:type '(repeat (cons :tag "Field"
(symbol :tag "Directory attribute")
- (string :tag "User friendly name ")))
- :group 'eudc)
+ (string :tag "User friendly name "))))
(defcustom eudc-use-raw-directory-names nil
"If non-nil, use attributes names as defined in the directory.
Otherwise, directory query/response forms display the user attribute
names defined in `eudc-user-attribute-names-alist'."
- :type 'boolean
- :group 'eudc)
+ :type 'boolean)
(defcustom eudc-attribute-display-method-alist nil
"An alist specifying methods to display attribute values.
@@ -277,8 +293,7 @@ attribute values for display."
:tag "Attribute Decoding Functions"
:type '(repeat (cons :tag "Attribute"
(symbol :tag "Name")
- (symbol :tag "Display Function")))
- :group 'eudc)
+ (symbol :tag "Display Function"))))
(defcustom eudc-external-viewers '(("ImageMagick" "display" "-")
("ShowAudio" "showaudio"))
@@ -295,18 +310,17 @@ arguments that should be passed to the program."
(repeat
:tag "Arguments"
:inline t
- (string :tag "Argument"))))
- :group 'eudc)
+ (string :tag "Argument")))))
-(defcustom eudc-options-file "~/.eudc-options"
+(defcustom eudc-options-file
+ (locate-user-emacs-file "eudc-options" ".eudc-options")
"A file where the `servers' hotlist is stored."
:type '(file :Tag "File Name:")
- :group 'eudc)
+ :version "25.1")
(defcustom eudc-mode-hook nil
"Normal hook run on entry to EUDC mode."
- :type '(repeat (sexp :tag "Hook definition"))
- :group 'eudc)
+ :type 'hook)
;;}}}
@@ -341,8 +355,7 @@ BBDB fields. SPECs are sexps which are evaluated:
:tag "BBDB to PH Field Name Mapping"
:type '(repeat (cons :tag "Field Name"
(symbol :tag "BBDB Field")
- (sexp :tag "Conversion Spec")))
- :group 'eudc-ph)
+ (sexp :tag "Conversion Spec"))))
;;}}}
@@ -376,8 +389,7 @@ BBDB fields. SPECs are sexps which are evaluated:
:tag "BBDB to LDAP Attribute Names Mapping"
:type '(repeat (cons :tag "Field Name"
(symbol :tag "BBDB Field")
- (sexp :tag "Conversion Spec")))
- :group 'eudc-ldap)
+ (sexp :tag "Conversion Spec"))))
;;}}}
@@ -391,14 +403,12 @@ BBDB fields. SPECs are sexps which are evaluated:
"If non-nil, BBDB address and phone locations are used as attribute names.
This has no effect on queries (you can't search for a specific location)
but influences the way records are displayed."
- :type 'boolean
- :group 'eudc-bbdb)
+ :type 'boolean)
(defcustom eudc-bbdb-enable-substring-matches t
"If non-nil, authorize substring match in the same way BBDB does.
Otherwise records must match queries exactly."
- :type 'boolean
- :group 'eudc-bbdb)
+ :type 'boolean)
;;}}}
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index ef09267f854..7280d9d2625 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -1,9 +1,10 @@
-;;; eudc.el --- Emacs Unified Directory Client -*- coding: utf-8 -*-
+;;; eudc.el --- Emacs Unified Directory Client
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -46,6 +47,8 @@
(require 'wid-edit)
+(eval-when-compile (require 'cl-lib))
+
(eval-and-compile
(if (not (fboundp 'make-overlay))
(require 'overlay)))
@@ -76,10 +79,6 @@
(defvar mode-popup-menu)
-;; List of known servers
-;; Alist of (SERVER . PROTOCOL)
-(defvar eudc-server-hotlist nil)
-
;; List of variables that have server- or protocol-local bindings
(defvar eudc-local-vars nil)
@@ -108,18 +107,6 @@
;; attribute name
(defvar eudc-protocol-has-default-query-attributes nil)
-(defun eudc-cadr (obj)
- (car (cdr obj)))
-
-(defun eudc-cdar (obj)
- (cdr (car obj)))
-
-(defun eudc-caar (obj)
- (car (car obj)))
-
-(defun eudc-cdaar (obj)
- (cdr (car (car obj))))
-
(defun eudc-plist-member (plist prop)
"Return t if PROP has a value specified in PLIST."
(if (not (= 0 (% (length plist) 2)))
@@ -518,12 +505,12 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
precords))
(insert "\n")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(eudc-query-form))
"New query")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(kill-this-buffer))
"Quit")
(eudc-mode)
@@ -558,10 +545,10 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
;; Search for multiple records
(while (and rec
- (not (listp (eudc-cdar rec))))
+ (not (listp (cdar rec))))
(setq rec (cdr rec)))
- (if (null (eudc-cdar rec))
+ (if (null (cdar rec))
(list record) ; No duplicate attrs in this record
(mapc (function
(lambda (field)
@@ -593,7 +580,7 @@ otherwise they are formatted according to `eudc-user-attribute-names-alist'."
((eq 'first method)
(setq result
(eudc-add-field-to-records (cons (car field)
- (eudc-cadr field))
+ (cadr field))
result)))
((eq 'concat method)
(setq result
@@ -652,7 +639,7 @@ Each copy is added a new field containing one of the values of FIELD."
result))
-(defun eudc-mode ()
+(define-derived-mode eudc-mode special-mode "EUDC"
"Major mode used in buffers displaying the results of directory queries.
There is no sense in calling this command from a buffer other than
one containing the results of a directory query.
@@ -663,15 +650,9 @@ These are the special commands of EUDC mode:
n -- Move to next record.
p -- Move to previous record.
b -- Insert record at point into the BBDB database."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'eudc-mode)
- (setq mode-name "EUDC")
- (use-local-map eudc-mode-map)
(if (not (featurep 'xemacs))
(easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))
- (setq mode-popup-menu (eudc-menu)))
- (run-mode-hooks 'eudc-mode-hook))
+ (setq mode-popup-menu (eudc-menu))))
;;}}}
@@ -694,7 +675,8 @@ server for future sessions."
(cons (symbol-name elt)
elt))
eudc-known-protocols)))))
- (unless (or (member protocol
+ (unless (or (null protocol)
+ (member protocol
eudc-supported-protocols)
(load (concat "eudcb-" (symbol-name protocol)) t))
(error "Unsupported protocol: %s" protocol))
@@ -718,7 +700,7 @@ If ERROR is non-nil, report an error if there is none."
(let ((result (eudc-query (list (cons 'name name)) '(email)))
email)
(if (null (cdr result))
- (setq email (eudc-cdaar result))
+ (setq email (cl-cdaar result))
(error "Multiple match--use the query form"))
(if error
(if email
@@ -736,7 +718,7 @@ If ERROR is non-nil, report an error if there is none."
(let ((result (eudc-query (list (cons 'name name)) '(phone)))
phone)
(if (null (cdr result))
- (setq phone (eudc-cdaar result))
+ (setq phone (cl-cdaar result))
(error "Multiple match--use the query form"))
(if error
(if phone
@@ -772,10 +754,9 @@ otherwise a list of symbols is returned."
format (cdr format)))
;; If the same attribute appears more than once, merge
;; the corresponding values
- (setq query-alist (nreverse query-alist))
(while query-alist
- (setq key (eudc-caar query-alist)
- val (eudc-cdar query-alist)
+ (setq key (caar query-alist)
+ val (cdar query-alist)
cell (assq key query))
(if cell
(setcdr cell (concat (cdr cell) " " val))
@@ -818,19 +799,29 @@ If REPLACE is non-nil, then this expansion replaces the name in the buffer.
Multiple servers can be tried with the same query until one finds a match,
see `eudc-inline-expansion-servers'"
(interactive)
- (if (memq eudc-inline-expansion-servers
- '(current-server server-then-hotlist))
- (or eudc-server
- (call-interactively 'eudc-set-server))
+ (cond
+ ((eq eudc-inline-expansion-servers 'current-server)
+ (or eudc-server
+ (call-interactively 'eudc-set-server)))
+ ((eq eudc-inline-expansion-servers 'server-then-hotlist)
+ (or eudc-server
+ ;; Allow server to be nil if hotlist is set.
+ eudc-server-hotlist
+ (call-interactively 'eudc-set-server)))
+ ((eq eudc-inline-expansion-servers 'hotlist)
(or eudc-server-hotlist
(error "No server in the hotlist")))
+ (t
+ (error "Wrong value for `eudc-inline-expansion-servers': %S"
+ eudc-inline-expansion-servers)))
(let* ((end (point))
(beg (save-excursion
(if (re-search-backward "\\([:,]\\|^\\)[ \t]*"
(point-at-bol) 'move)
(goto-char (match-end 0)))
(point)))
- (query-words (split-string (buffer-substring beg end) "[ \t]+"))
+ (query-words (split-string (buffer-substring-no-properties beg end)
+ "[ \t]+"))
query-formats
response
response-string
@@ -846,24 +837,23 @@ see `eudc-inline-expansion-servers'"
((eq eudc-inline-expansion-servers 'hotlist)
eudc-server-hotlist)
((eq eudc-inline-expansion-servers 'server-then-hotlist)
- (cons (cons eudc-server eudc-protocol)
- (delete (cons eudc-server eudc-protocol) servers)))
+ (if eudc-server
+ (cons (cons eudc-server eudc-protocol)
+ (delete (cons eudc-server eudc-protocol) servers))
+ eudc-server-hotlist))
((eq eudc-inline-expansion-servers 'current-server)
- (list (cons eudc-server eudc-protocol)))
- (t
- (error "Wrong value for `eudc-inline-expansion-servers': %S"
- eudc-inline-expansion-servers))))
+ (list (cons eudc-server eudc-protocol)))))
(if (and eudc-max-servers-to-query
(> (length servers) eudc-max-servers-to-query))
(setcdr (nthcdr (1- eudc-max-servers-to-query) servers) nil))
- (condition-case signal
+ (unwind-protect
(progn
(setq response
(catch 'found
;; Loop on the servers
(while servers
- (eudc-set-server (eudc-caar servers) (eudc-cdar servers) t)
+ (eudc-set-server (caar servers) (cdar servers) t)
;; Determine which formats apply in the query-format list
(setq query-formats
@@ -893,14 +883,15 @@ see `eudc-inline-expansion-servers'"
;; Process response through eudc-inline-expansion-format
(while response
- (setq response-string (apply 'format
- (car eudc-inline-expansion-format)
- (mapcar (function
- (lambda (field)
- (or (cdr (assq field (car response)))
- "")))
- (eudc-translate-attribute-list
- (cdr eudc-inline-expansion-format)))))
+ (setq response-string
+ (apply 'format
+ (car eudc-inline-expansion-format)
+ (mapcar (function
+ (lambda (field)
+ (or (cdr (assq field (car response)))
+ "")))
+ (eudc-translate-attribute-list
+ (cdr eudc-inline-expansion-format)))))
(if (> (length response-string) 0)
(setq response-strings
(cons response-string response-strings)))
@@ -922,15 +913,10 @@ see `eudc-inline-expansion-servers'"
(delete-region beg end)
(insert (mapconcat 'identity response-strings ", ")))
((eq eudc-multiple-match-handling-method 'abort)
- (error "There is more than one match for the query"))))
- (or (and (equal eudc-server eudc-former-server)
- (equal eudc-protocol eudc-former-protocol))
- (eudc-set-server eudc-former-server eudc-former-protocol t)))
- (error
- (or (and (equal eudc-server eudc-former-server)
- (equal eudc-protocol eudc-former-protocol))
- (eudc-set-server eudc-former-server eudc-former-protocol t))
- (signal (car signal) (cdr signal))))))
+ (error "There is more than one match for the query")))))
+ (or (and (equal eudc-server eudc-former-server)
+ (equal eudc-protocol eudc-former-protocol))
+ (eudc-set-server eudc-former-server eudc-former-protocol t)))))
;;;###autoload
(defun eudc-query-form (&optional get-fields-from-server)
@@ -995,17 +981,17 @@ queries the server for the existing fields and displays a corresponding form."
fields)
(widget-insert "\n\n")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(eudc-process-form))
"Query Server")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(eudc-query-form))
"Reset Form")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(kill-this-buffer))
"Quit")
(goto-char pt)
@@ -1051,14 +1037,14 @@ queries the server for the existing fields and displays a corresponding form."
(point))
(setq set-server-p t))
((and (eq (car sexp) 'setq)
- (eq (eudc-cadr sexp) 'eudc-server-hotlist))
+ (eq (cadr sexp) 'eudc-server-hotlist))
(delete-region (save-excursion
(backward-sexp)
(point))
(point))
(setq set-hotlist-p t))
((and (eq (car sexp) 'provide)
- (equal (eudc-cadr sexp) '(quote eudc-options-file)))
+ (equal (cadr sexp) '(quote eudc-options-file)))
(setq provide-p t)))
(if (and provide-p
set-hotlist-p
@@ -1084,7 +1070,7 @@ queries the server for the existing fields and displays a corresponding form."
(defun eudc-move-to-next-record ()
"Move to next record, in a buffer displaying directory query results."
(interactive)
- (if (not (eq major-mode 'eudc-mode))
+ (if (not (derived-mode-p 'eudc-mode))
(error "Not in a EUDC buffer")
(let ((pt (next-overlay-change (point))))
(if (< pt (point-max))
@@ -1094,7 +1080,7 @@ queries the server for the existing fields and displays a corresponding form."
(defun eudc-move-to-previous-record ()
"Move to previous record, in a buffer displaying directory query results."
(interactive)
- (if (not (eq major-mode 'eudc-mode))
+ (if (not (derived-mode-p 'eudc-mode))
(error "Not in a EUDC buffer")
(let ((pt (previous-overlay-change (point))))
(if (> pt (point-min))
@@ -1122,7 +1108,7 @@ queries the server for the existing fields and displays a corresponding form."
(overlay-get (car (overlays-at (point))) 'eudc-record))
:help "Insert record at point into the BBDB database"]
["Insert All Records into BBDB" eudc-batch-export-records-to-bbdb
- (and (eq major-mode 'eudc-mode)
+ (and (derived-mode-p 'eudc-mode)
(or (featurep 'bbdb)
(prog1 (locate-library "bbdb") (message ""))))
:help "Insert all the records returned by a directory query into BBDB"]
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index d9d2aa5fe85..0545304b4a3 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -1,9 +1,10 @@
-;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend -*- coding: utf-8 -*-
+;;; eudcb-bbdb.el --- Emacs Unified Directory Client - BBDB Backend
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -41,6 +42,24 @@
(defvar eudc-bbdb-current-query nil)
(defvar eudc-bbdb-current-return-attributes nil)
+(defvar bbdb-version)
+
+(defun eudc-bbdb-field (field-symbol)
+ "Convert FIELD-SYMBOL so that it is recognized by the current BBDB version.
+BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
+ ;; This just-in-time translation permits upgrading from BBDB 2 to
+ ;; BBDB 3 without restarting Emacs.
+ (if (and (eq field-symbol 'net)
+ (or
+ ;; MELPA versions of BBDB may have a bad package version,
+ ;; but they're all version 3 or later.
+ (equal bbdb-version "@PACKAGE_VERSION@")
+ ;; Development versions of BBDB can have the format "X.YZ
+ ;; devo". Split the string just in case.
+ (version<= "3" (car (split-string bbdb-version)))))
+ 'mail
+ field-symbol))
+
(defvar eudc-bbdb-attributes-translation-alist
'((name . lastname)
(email . net)
@@ -84,7 +103,9 @@
(progn
(setq bbdb-val
(eval (list (intern (concat "bbdb-record-"
- (symbol-name attr)))
+ (symbol-name
+ (eudc-bbdb-field
+ attr))))
'record)))
(if (listp bbdb-val)
(if eudc-bbdb-enable-substring-matches
@@ -167,7 +188,7 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'"
(setq val (eval
(list (intern
(concat "bbdb-record-"
- (symbol-name attr)))
+ (symbol-name (eudc-bbdb-field attr))))
'record))))
(t
(error "Unknown BBDB attribute")))
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index d0ba47ad753..b50d29ddae8 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -1,9 +1,10 @@
-;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend -*- coding: utf-8 -*-
+;;; eudcb-ldap.el --- Emacs Unified Directory Client - LDAP Backend
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -70,16 +71,14 @@
("mail" . eudc-display-mail)
("url" . eudc-display-url))
'ldap)
-(eudc-protocol-set 'eudc-switch-to-server-hook
- '(eudc-ldap-check-base)
- 'ldap)
(defun eudc-ldap-cleanup-record-simple (record)
"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 (car field))
+ (cons (intern (downcase (car field)))
(if (cdr (cdr field))
(cdr field)
(car (cdr field))))))
@@ -88,22 +87,36 @@
(defun eudc-filter-$ (string)
(mapconcat 'identity (split-string string "\\$") "\n"))
-;; Cleanup a LDAP record to make it suitable for EUDC:
-;; Make the record a cons-cell instead of a list if it is single-valued
-;; Filter the $ character in addresses into \n if not done by the LDAP lib
(defun eudc-ldap-cleanup-record-filtering-addresses (record)
- (mapcar
- (function
- (lambda (field)
- (let ((name (intern (car field)))
+ "Clean up RECORD to make it suitable for EUDC.
+Make the record a cons-cell instead of a list if it is
+single-valued. Change the `$' character in postal addresses to a
+newline. Combine separate mail fields into one mail field with
+multiple addresses."
+ (let ((clean-up-addresses (or (not (boundp 'ldap-ignore-attribute-codings))
+ (not ldap-ignore-attribute-codings)))
+ result mail-addresses)
+ (dolist (field record)
+ ;; Some servers return case-sensitive names (e.g. givenName
+ ;; instead of givenname); downcase the field's name so that it
+ ;; can be matched against
+ ;; eudc-ldap-attributes-translation-alist.
+ (let ((name (intern (downcase (car field))))
(value (cdr field)))
- (if (memq name '(postaladdress registeredaddress))
- (setq value (mapcar 'eudc-filter-$ value)))
- (cons name
- (if (cdr value)
- value
- (car value))))))
- record))
+ (when (and clean-up-addresses
+ (memq name '(postaladdress registeredaddress)))
+ (setq value (mapcar 'eudc-filter-$ value)))
+ (if (eq name 'mail)
+ (setq mail-addresses (append mail-addresses value))
+ (push (cons name (if (cdr value)
+ value
+ (car value)))
+ result))))
+ (push (cons 'mail (if (cdr mail-addresses)
+ mail-addresses
+ (car mail-addresses)))
+ result)
+ (nreverse result)))
(defun eudc-ldap-simple-query-internal (query &optional return-attrs)
"Query the LDAP server with QUERY.
@@ -116,11 +129,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
(if (listp return-attrs)
(mapcar 'symbol-name return-attrs))))
final-result)
- (if (or (not (boundp 'ldap-ignore-attribute-codings))
- ldap-ignore-attribute-codings)
- (setq result
- (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
- (setq result (mapcar 'eudc-ldap-cleanup-record-simple result)))
+ (setq result (mapcar 'eudc-ldap-cleanup-record-filtering-addresses result))
(if (and eudc-strict-return-matches
return-attrs
@@ -136,7 +145,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to
result))
final-result))
-(defun eudc-ldap-get-field-list (dummy &optional objectclass)
+(defun eudc-ldap-get-field-list (_dummy &optional objectclass)
"Return a list of valid attribute names for the current server.
OBJECTCLASS is the LDAP object class for which the valid
attribute names are returned. Default to `person'"
@@ -146,7 +155,7 @@ attribute names are returned. Default to `person'"
(let ((ldap-host-parameters-alist
(list (cons eudc-server
'(scope subtree sizelimit 1)))))
- (mapcar 'eudc-ldap-cleanup-record-simple
+ (mapcar 'eudc-ldap-cleanup-record-filtering-addresses
(ldap-search
(eudc-ldap-format-query-as-rfc1558
(list (cons "objectclass"
@@ -170,14 +179,16 @@ attribute names are returned. Default to `person'"
(defun eudc-ldap-format-query-as-rfc1558 (query)
"Format the EUDC QUERY list as a RFC1558 LDAP search filter."
- (format "(&%s)"
- (apply 'concat
- (mapcar (lambda (item)
- (format "(%s=%s)"
- (car item)
- (eudc-ldap-escape-query-special-chars (cdr item))))
- query))))
-
+ (let ((formatter (lambda (item &optional wildcard)
+ (format "(%s=%s)"
+ (car item)
+ (concat
+ (eudc-ldap-escape-query-special-chars
+ (cdr item)) (if wildcard "*" ""))))))
+ (format "(&%s)"
+ (concat
+ (mapconcat formatter (butlast query) "")
+ (funcall formatter (car (last query)) t)))))
;;}}}
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 75b3382f511..a11cd95b05d 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -1,9 +1,9 @@
;;; eudcb-mab.el --- Emacs Unified Directory Client - AddressBook backend
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
-;; Maintainer: FSF
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index 1796f2d9806..f144bf695f5 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -1,9 +1,10 @@
-;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend -*- coding: utf-8 -*-
+;;; eudcb-ph.el --- Emacs Unified Directory Client - CCSO PH/QI Backend
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Keywords: comm
;; Package: eudc
@@ -80,7 +81,7 @@ are returned"
(eudc-ph-do-request "fields")
(if full-records
(eudc-ph-parse-query-result)
- (mapcar 'eudc-caar (eudc-ph-parse-query-result))))
+ (mapcar #'caar (eudc-ph-parse-query-result))))
(defun eudc-ph-parse-query-result (&optional fields)
"Return a list of alists of key/values from in `eudc-ph-process-buffer'.
@@ -125,9 +126,9 @@ Fields not in FIELDS are discarded."
(memq current-key fields))
(if key
(setq record (cons (cons key value) record)) ; New key
- (setcdr (car record) (if (listp (eudc-cdar record))
- (append (eudc-cdar record) (list value))
- (list (eudc-cdar record) value))))))))
+ (setcdr (car record) (if (listp (cdar record))
+ (append (cdar record) (list value))
+ (list (cdar record) value))))))))
(and (not ignore)
(or (null fields)
(eq 'all fields)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 34934a03549..5748e88bbca 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1,6 +1,6 @@
-;;; eww.el --- Emacs Web Wowser
+;;; eww.el --- Emacs Web Wowser -*- lexical-binding:t -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
@@ -28,12 +28,16 @@
(require 'format-spec)
(require 'shr)
(require 'url)
+(require 'url-queue)
+(require 'url-util) ; for url-get-url-at-point
(require 'mm-url)
+(eval-when-compile (require 'subr-x)) ;; for string-trim
(defgroup eww nil
"Emacs Web Wowser"
- :version "24.4"
- :group 'hypermedia
+ :version "25.1"
+ :link '(custom-manual "(eww) Top")
+ :group 'web
:prefix "eww-")
(defcustom eww-header-line-format "%t: %u"
@@ -45,17 +49,109 @@
:type 'string)
(defcustom eww-search-prefix "https://duckduckgo.com/html/?q="
- "Prefix URL to search engine"
+ "Prefix URL to search engine."
:version "24.4"
:group 'eww
:type 'string)
-(defcustom eww-download-path "~/Downloads/"
- "Path where files will downloaded."
+(defcustom eww-download-directory "~/Downloads/"
+ "Directory where files will downloaded."
:version "24.4"
:group 'eww
:type 'string)
+;;;###autoload
+(defcustom eww-suggest-uris
+ '(eww-links-at-point
+ url-get-url-at-point
+ eww-current-url)
+ "List of functions called to form the list of default URIs for `eww'.
+Each of the elements is a function returning either a string or a list
+of strings. The results will be joined into a single list with
+duplicate entries (if any) removed."
+ :version "25.1"
+ :group 'eww
+ :type 'hook
+ :options '(eww-links-at-point
+ url-get-url-at-point
+ eww-current-url))
+
+(defcustom eww-bookmarks-directory user-emacs-directory
+ "Directory where bookmark files will be stored."
+ :version "25.1"
+ :group 'eww
+ :type 'string)
+
+(defcustom eww-desktop-remove-duplicates t
+ "Whether to remove duplicates from the history when saving desktop data.
+If non-nil, repetitive EWW history entries (comprising of the URI, the
+title, and the point position) will not be saved as part of the Emacs
+desktop. Otherwise, such entries will be retained."
+ :version "25.1"
+ :group 'eww
+ :type 'boolean)
+
+(defcustom eww-restore-desktop nil
+ "How to restore EWW buffers on `desktop-restore'.
+If t or 'auto, the buffers will be reloaded automatically.
+If nil, buffers will require manual reload, and will contain the text
+specified in `eww-restore-reload-prompt' instead of the actual Web
+page contents."
+ :version "25.1"
+ :group 'eww
+ :type '(choice (const :tag "Restore all automatically" t)
+ (const :tag "Require manual reload" nil)))
+
+(defcustom eww-restore-reload-prompt
+ "\n\n *** Use \\[eww-reload] to reload this buffer. ***\n"
+ "The string to put in the buffers not reloaded on `desktop-restore'.
+This prompt will be used if `eww-restore-desktop' is nil.
+
+The string will be passed through `substitute-command-keys'."
+ :version "25.1"
+ :group 'eww
+ :type 'string)
+
+(defcustom eww-history-limit 50
+ "Maximum number of entries to retain in the history."
+ :version "25.1"
+ :group 'eww
+ :type '(choice (const :tag "Unlimited" nil)
+ integer))
+
+(defcustom eww-use-external-browser-for-content-type
+ "\\`\\(video/\\|audio/\\|application/ogg\\)"
+ "Always use external browser for specified content-type."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const :tag "Never" nil)
+ regexp))
+
+(defcustom eww-after-render-hook nil
+ "A hook called after eww has finished rendering the buffer."
+ :version "25.1"
+ :group 'eww
+ :type 'hook)
+
+(defcustom eww-form-checkbox-selected-symbol "[X]"
+ "Symbol used to represent a selected checkbox.
+See also `eww-form-checkbox-symbol'."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const "[X]")
+ (const "☒") ; Unicode BALLOT BOX WITH X
+ (const "☑") ; Unicode BALLOT BOX WITH CHECK
+ string))
+
+(defcustom eww-form-checkbox-symbol "[ ]"
+ "Symbol used to represent a checkbox.
+See also `eww-form-checkbox-selected-symbol'."
+ :version "24.4"
+ :group 'eww
+ :type '(choice (const "[ ]")
+ (const "☐") ; Unicode BALLOT BOX
+ string))
+
(defface eww-form-submit
'((((type x w32 ns) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
@@ -64,6 +160,14 @@
:version "24.4"
:group 'eww)
+(defface eww-form-file
+ '((((type x w32 ns) (class color)) ; Like default mode line
+ :box (:line-width 2 :style released-button)
+ :background "#808080" :foreground "black"))
+ "Face for eww buffer buttons."
+ :version "25.1"
+ :group 'eww)
+
(defface eww-form-checkbox
'((((type x w32 ns) (class color)) ; Like default mode line
:box (:line-width 2 :style released-button)
@@ -88,58 +192,131 @@
:version "24.4"
:group 'eww)
-(defvar eww-current-url nil)
-(defvar eww-current-title ""
- "Title of current page.")
+(defface eww-form-textarea
+ '((t (:background "#C0C0C0"
+ :foreground "black"
+ :box (:line-width 1))))
+ "Face for eww textarea inputs."
+ :version "24.4"
+ :group 'eww)
+
+(defface eww-invalid-certificate
+ '((default :weight bold)
+ (((class color)) :foreground "red"))
+ "Face for web pages with invalid certificates."
+ :version "25.1"
+ :group 'eww)
+
+(defface eww-valid-certificate
+ '((default :weight bold)
+ (((class color)) :foreground "ForestGreen"))
+ "Face for web pages with valid certificates."
+ :version "25.1"
+ :group 'eww)
+
+(defvar eww-data nil)
(defvar eww-history nil)
(defvar eww-history-position 0)
-(defvar eww-next-url nil)
-(defvar eww-previous-url nil)
-(defvar eww-up-url nil)
-(defvar eww-home-url nil)
-(defvar eww-start-url nil)
-(defvar eww-contents-url nil)
+(defvar eww-local-regex "localhost"
+ "When this regex is found in the URL, it's not a keyword but an address.")
+
+(defvar eww-link-keymap
+ (let ((map (copy-keymap shr-map)))
+ (define-key map "\r" 'eww-follow-link)
+ map))
+
+(defun eww-suggested-uris nil
+ "Return the list of URIs to suggest at the `eww' prompt.
+This list can be customized via `eww-suggest-uris'."
+ (let ((obseen (make-vector 42 0))
+ (uris nil))
+ (dolist (fun eww-suggest-uris)
+ (let ((ret (funcall fun)))
+ (dolist (uri (if (stringp ret) (list ret) ret))
+ (when (and uri (not (intern-soft uri obseen)))
+ (intern uri obseen)
+ (push uri uris)))))
+ (nreverse uris)))
;;;###autoload
(defun eww (url)
"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'."
- (interactive "sEnter URL or keywords: ")
- (if (and (= (length (split-string url)) 1)
- (> (length (split-string url "\\.")) 1))
- (progn
- (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
- (setq url (concat "http://" url)))
- ;; some site don't redirect final /
- (when (string= (url-filename (url-generic-parse-url url)) "")
- (setq url (concat url "/"))))
- (unless (string-match-p "\\'file:" url)
- (setq url (concat eww-search-prefix
- (replace-regexp-in-string " " "+" url)))))
- (url-retrieve url 'eww-render (list url)))
+ (interactive
+ (let* ((uris (eww-suggested-uris))
+ (prompt (concat "Enter URL or keywords"
+ (if uris (format " (default %s)" (car uris)) "")
+ ": ")))
+ (list (read-string prompt nil nil uris))))
+ (setq url (string-trim url))
+ (cond ((string-match-p "\\`file:/" url))
+ ;; Don't mangle file: URLs at all.
+ ((string-match-p "\\`ftp://" url)
+ (user-error "FTP is not supported"))
+ (t
+ ;; Anything that starts with something that vaguely looks
+ ;; like a protocol designator is interpreted as a full URL.
+ (if (or (string-match "\\`[A-Za-z]+:" url)
+ ;; Also try to match "naked" URLs like
+ ;; en.wikipedia.org/wiki/Free software
+ (string-match "\\`[A-Za-z_]+\\.[A-Za-z._]+/" url)
+ (and (= (length (split-string url)) 1)
+ (or (and (not (string-match-p "\\`[\"'].*[\"']\\'" url))
+ (> (length (split-string url "[.:]")) 1))
+ (string-match eww-local-regex url))))
+ (progn
+ (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
+ (setq url (concat "http://" url)))
+ ;; Some sites do not redirect final /
+ (when (string= (url-filename (url-generic-parse-url url)) "")
+ (setq url (concat url "/"))))
+ (setq url (concat eww-search-prefix
+ (replace-regexp-in-string " " "+" url))))))
+ (if (eq major-mode 'eww-mode)
+ (when (or (plist-get eww-data :url)
+ (plist-get eww-data :dom))
+ (eww-save-history))
+ (eww-setup-buffer)
+ (plist-put eww-data :url url)
+ (plist-put eww-data :title "")
+ (eww-update-header-line-format)
+ (let ((inhibit-read-only t))
+ (insert (format "Loading %s..." url))
+ (goto-char (point-min))))
+ (url-retrieve url 'eww-render
+ (list url nil (current-buffer))))
+
+;;;###autoload (defalias 'browse-web 'eww)
;;;###autoload
(defun eww-open-file (file)
- "Render a file using EWW."
+ "Render FILE using EWW."
(interactive "fFile: ")
- (eww (concat "file://" (expand-file-name file))))
+ (eww (concat "file://"
+ (and (memq system-type '(windows-nt ms-dos))
+ "/")
+ (expand-file-name file))))
-(defun eww-render (status url &optional point)
+;;;###autoload
+(defun eww-search-words (&optional beg end)
+ "Search the web for the text between BEG and END.
+See the `eww-search-prefix' variable for the search engine used."
+ (interactive "r")
+ (eww (buffer-substring beg end)))
+
+(defun eww-html-p (content-type)
+ "Return non-nil if CONTENT-TYPE designates an HTML content type.
+Currently this means either text/html or application/xhtml+xml."
+ (member content-type '("text/html"
+ "application/xhtml+xml")))
+
+(defun eww-render (status url &optional point buffer encode)
(let ((redirect (plist-get status :redirect)))
(when redirect
(setq url redirect)))
- (set (make-local-variable 'eww-next-url) nil)
- (set (make-local-variable 'eww-previous-url) nil)
- (set (make-local-variable 'eww-up-url) nil)
- (set (make-local-variable 'eww-home-url) nil)
- (set (make-local-variable 'eww-start-url) nil)
- (set (make-local-variable 'eww-contents-url) nil)
(let* ((headers (eww-parse-headers))
- (shr-target-id
- (and (string-match "#\\(.*\\)" url)
- (match-string 1 url)))
(content-type
(mail-header-parse-content-type
(or (cdr (assoc "content-type" headers))
@@ -147,28 +324,32 @@ word(s) will be searched for via `eww-search-prefix'."
(charset (intern
(downcase
(or (cdr (assq 'charset (cdr content-type)))
- (eww-detect-charset (equal (car content-type)
- "text/html"))
- "utf8"))))
+ (eww-detect-charset (eww-html-p (car content-type)))
+ "utf-8"))))
(data-buffer (current-buffer)))
+ ;; Save the https peer status.
+ (with-current-buffer buffer
+ (plist-put eww-data :peer (plist-get status :peer)))
(unwind-protect
(progn
(cond
- ((equal (car content-type) "text/html")
- (eww-display-html charset url))
- ((string-match "^image/" (car content-type))
- (eww-display-image))
+ ((and eww-use-external-browser-for-content-type
+ (string-match-p eww-use-external-browser-for-content-type
+ (car content-type)))
+ (eww-browse-with-external-browser url))
+ ((eww-html-p (car content-type))
+ (eww-display-html charset url nil point buffer encode))
+ ((equal (car content-type) "application/pdf")
+ (eww-display-pdf))
+ ((string-match-p "\\`image/" (car content-type))
+ (eww-display-image buffer))
(t
- (eww-display-raw charset)))
- (setq eww-history-position 0)
- (cond
- (point
- (goto-char point))
- (shr-target-id
- (let ((point (next-single-property-change
- (point-min) 'shr-target-id)))
- (when point
- (goto-char (1+ point)))))))
+ (eww-display-raw buffer encode)))
+ (with-current-buffer buffer
+ (plist-put eww-data :url url)
+ (eww-update-header-line-format)
+ (setq eww-history-position 0)
+ (run-hooks 'eww-after-render-hook)))
(kill-buffer data-buffer))))
(defun eww-parse-headers ()
@@ -197,118 +378,163 @@ word(s) will be searched for via `eww-search-prefix'."
"[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
(match-string 1)))))
-(defun eww-display-html (charset url)
- (unless (eq charset 'utf8)
- (condition-case nil
- (decode-coding-region (point) (point-max) charset)
- (coding-system-error nil)))
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url discard-comments))
+
+(defun eww-display-html (charset url &optional document point buffer encode)
+ (unless (fboundp 'libxml-parse-html-region)
+ (error "This function requires Emacs to be compiled with libxml2"))
+ (unless (buffer-live-p buffer)
+ (error "Buffer %s doesn't exist" buffer))
+ ;; There should be a better way to abort loading images
+ ;; asynchronously.
+ (setq url-queue nil)
(let ((document
- (list
- 'base (list (cons 'href url))
- (libxml-parse-html-region (point) (point-max)))))
- (eww-setup-buffer)
- (setq eww-current-url url)
- (eww-update-header-line-format)
- (let ((inhibit-read-only t)
- (after-change-functions nil)
- (shr-width nil)
- (shr-external-rendering-functions
- '((title . eww-tag-title)
- (form . eww-tag-form)
- (input . eww-tag-input)
- (textarea . eww-tag-textarea)
- (body . eww-tag-body)
- (select . eww-tag-select)
- (link . eww-tag-link)
- (a . eww-tag-a))))
- (shr-insert-document document))
- (goto-char (point-min))))
-
-(defun eww-handle-link (cont)
- (let* ((rel (assq :rel cont))
- (href (assq :href cont))
- (where (assoc
- ;; The text associated with :rel is case-insensitive.
- (if rel (downcase (cdr rel)))
- '(("next" . eww-next-url)
- ;; Texinfo uses "previous", but HTML specifies
- ;; "prev", so recognize both.
- ("previous" . eww-previous-url)
- ("prev" . eww-previous-url)
- ;; HTML specifies "start" but also "contents",
- ;; and Gtk seems to use "home". Recognize
- ;; them all; but store them in different
- ;; variables so that we can readily choose the
- ;; "best" one.
- ("start" . eww-start-url)
- ("home" . eww-home-url)
- ("contents" . eww-contents-url)
- ("up" . eww-up-url)))))
+ (or document
+ (list
+ 'base (list (cons 'href url))
+ (progn
+ (when (or (and encode
+ (not (eq charset encode)))
+ (not (eq charset 'utf-8)))
+ (condition-case nil
+ (decode-coding-region (point) (point-max)
+ (or encode charset))
+ (coding-system-error nil)))
+ (libxml-parse-html-region (point) (point-max))))))
+ (source (and (null document)
+ (buffer-substring (point) (point-max)))))
+ (with-current-buffer buffer
+ (plist-put eww-data :source source)
+ (plist-put eww-data :dom document)
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ (shr-target-id (url-target (url-generic-parse-url url)))
+ (shr-external-rendering-functions
+ '((title . eww-tag-title)
+ (form . eww-tag-form)
+ (input . eww-tag-input)
+ (textarea . eww-tag-textarea)
+ (select . eww-tag-select)
+ (link . eww-tag-link)
+ (a . eww-tag-a))))
+ (erase-buffer)
+ (shr-insert-document document)
+ (cond
+ (point
+ (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))))
+ (t
+ (goto-char (point-min))
+ ;; Don't leave point inside forms, because the normal eww
+ ;; commands aren't available there.
+ (while (and (not (eobp))
+ (get-text-property (point) 'eww-form))
+ (forward-line 1)))))
+ (eww-size-text-inputs))))
+
+(defun eww-handle-link (dom)
+ (let* ((rel (dom-attr dom 'rel))
+ (href (dom-attr dom 'href))
+ (where (assoc
+ ;; The text associated with :rel is case-insensitive.
+ (if rel (downcase rel))
+ '(("next" . :next)
+ ;; Texinfo uses "previous", but HTML specifies
+ ;; "prev", so recognize both.
+ ("previous" . :previous)
+ ("prev" . :previous)
+ ;; HTML specifies "start" but also "contents",
+ ;; and Gtk seems to use "home". Recognize
+ ;; them all; but store them in different
+ ;; variables so that we can readily choose the
+ ;; "best" one.
+ ("start" . :start)
+ ("home" . :home)
+ ("contents" . :contents)
+ ("up" . :up)))))
(and href
where
- (set (cdr where) (cdr href)))))
+ (plist-put eww-data (cdr where) href))))
-(defun eww-tag-link (cont)
- (eww-handle-link cont)
- (shr-generic cont))
+(defun eww-tag-link (dom)
+ (eww-handle-link dom)
+ (shr-generic dom))
-(defun eww-tag-a (cont)
- (eww-handle-link cont)
- (shr-tag-a cont))
+(defun eww-tag-a (dom)
+ (eww-handle-link dom)
+ (let ((start (point)))
+ (shr-tag-a dom)
+ (put-text-property start (point) 'keymap eww-link-keymap)))
(defun eww-update-header-line-format ()
- (if eww-header-line-format
- (setq header-line-format
- (replace-regexp-in-string
- "%" "%%"
- (format-spec eww-header-line-format
- `((?u . ,eww-current-url)
- (?t . ,eww-current-title)))))
- (setq header-line-format nil)))
-
-(defun eww-tag-title (cont)
- (setq eww-current-title "")
- (dolist (sub cont)
- (when (eq (car sub) 'text)
- (setq eww-current-title (concat eww-current-title (cdr sub)))))
+ (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.
+ (when peer
+ (setq title
+ (propertize title 'face
+ (if (plist-get peer :warnings)
+ 'eww-invalid-certificate
+ 'eww-valid-certificate))))
+ (replace-regexp-in-string
+ "%" "%%"
+ (format-spec
+ eww-header-line-format
+ `((?u . ,(or (plist-get eww-data :url) ""))
+ (?t . ,title))))))))
+
+(defun eww-tag-title (dom)
+ (plist-put eww-data :title
+ (replace-regexp-in-string
+ "^ \\| $" ""
+ (replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
(eww-update-header-line-format))
-(defun eww-tag-body (cont)
- (let* ((start (point))
- (fgcolor (cdr (or (assq :fgcolor cont)
- (assq :text cont))))
- (bgcolor (cdr (assq :bgcolor cont)))
- (shr-stylesheet (list (cons 'color fgcolor)
- (cons 'background-color bgcolor))))
- (shr-generic cont)
- (eww-colorize-region start (point) fgcolor bgcolor)))
-
-(defun eww-colorize-region (start end fg &optional bg)
- (when (or fg bg)
- (let ((new-colors (shr-color-check fg bg)))
- (when new-colors
- (when fg
- (add-face-text-property start end
- (list :foreground (cadr new-colors))
- t))
- (when bg
- (add-face-text-property start end
- (list :background (car new-colors))
- t))))))
-
-(defun eww-display-raw (charset)
+(defun eww-display-raw (buffer &optional encode)
(let ((data (buffer-substring (point) (point-max))))
- (eww-setup-buffer)
- (let ((inhibit-read-only t))
- (insert data))
- (goto-char (point-min))))
-
-(defun eww-display-image ()
+ (unless (buffer-live-p buffer)
+ (error "Buffer %s doesn't exist" buffer))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert data)
+ (unless (eq encode 'utf-8)
+ (encode-coding-region (point-min) (1+ (length data)) 'utf-8)
+ (condition-case nil
+ (decode-coding-region (point-min) (1+ (length data)) encode)
+ (coding-system-error nil))))
+ (goto-char (point-min)))))
+
+(defun eww-display-image (buffer)
(let ((data (shr-parse-image-data)))
- (eww-setup-buffer)
- (let ((inhibit-read-only t))
- (shr-put-image data nil))
- (goto-char (point-min))))
+ (unless (buffer-live-p buffer)
+ (error "Buffer %s doesn't exist" buffer))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (shr-put-image data nil))
+ (goto-char (point-min)))))
+
+(declare-function mailcap-view-mime "mailcap" (type))
+(defun eww-display-pdf ()
+ (let ((data (buffer-substring (point) (point-max))))
+ (switch-to-buffer (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)))
(defun eww-setup-buffer ()
(switch-to-buffer (get-buffer-create "*eww*"))
@@ -318,18 +544,106 @@ word(s) will be searched for via `eww-search-prefix'."
(unless (eq major-mode 'eww-mode)
(eww-mode)))
+(defun eww-current-url nil
+ "Return URI of the Web page the current EWW buffer is visiting."
+ (plist-get eww-data :url))
+
+(defun eww-links-at-point ()
+ "Return list of URIs, if any, linked at point."
+ (remq nil
+ (list (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
+
+(defun eww-view-source ()
+ "View the HTML source code of the current page."
+ (interactive)
+ (let ((buf (get-buffer-create "*eww-source*"))
+ (source (plist-get eww-data :source)))
+ (with-current-buffer buf
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (insert (or source "no source"))
+ (goto-char (point-min))
+ ;; Decode the source and set the buffer's encoding according
+ ;; to what the HTML source specifies in its 'charset' header,
+ ;; if any.
+ (let ((cs (find-auto-coding "" (point-max))))
+ (when (consp cs)
+ (setq cs (car cs))
+ (when (coding-system-p cs)
+ (decode-coding-region (point-min) (point-max) cs)
+ (setq buffer-file-coding-system last-coding-system-used))))
+ (when (fboundp 'html-mode)
+ (html-mode))))
+ (view-buffer buf)))
+
+(defun eww-readable ()
+ "View the main \"readable\" parts of the current web page.
+This command uses heuristics to find the parts of the web page that
+contains the main textual portion, leaving out navigation menus and
+the like."
+ (interactive)
+ (let* ((old-data eww-data)
+ (dom (with-temp-buffer
+ (insert (plist-get old-data :source))
+ (condition-case nil
+ (decode-coding-region (point-min) (point-max) 'utf-8)
+ (coding-system-error nil))
+ (libxml-parse-html-region (point-min) (point-max)))))
+ (eww-score-readability dom)
+ (eww-save-history)
+ (eww-display-html nil nil
+ (eww-highest-readability dom)
+ nil (current-buffer))
+ (dolist (elem '(:source :url :title :next :previous :up))
+ (plist-put eww-data elem (plist-get old-data elem)))
+ (eww-update-header-line-format)))
+
+(defun eww-score-readability (node)
+ (let ((score -1))
+ (cond
+ ((memq (dom-tag node) '(script head comment))
+ (setq score -2))
+ ((eq (dom-tag node) 'meta)
+ (setq score -1))
+ ((eq (dom-tag node) 'img)
+ (setq score 2))
+ ((eq (dom-tag node) 'a)
+ (setq score (- (length (split-string (dom-text node))))))
+ (t
+ (dolist (elem (dom-children node))
+ (if (stringp elem)
+ (setq score (+ score (length (split-string elem))))
+ (setq score (+ score
+ (or (cdr (assoc :eww-readability-score (cdr elem)))
+ (eww-score-readability elem))))))))
+ ;; Cache the score of the node to avoid recomputing all the time.
+ (dom-set-attribute node :eww-readability-score score)
+ score))
+
+(defun eww-highest-readability (node)
+ (let ((result node)
+ highest)
+ (dolist (elem (dom-non-text-children node))
+ (when (> (or (dom-attr
+ (setq highest (eww-highest-readability elem))
+ :eww-readability-score)
+ most-negative-fixnum)
+ (or (dom-attr result :eww-readability-score)
+ most-negative-fixnum))
+ (setq result highest)))
+ result))
+
(defvar eww-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'eww-quit)
- (define-key map "g" 'eww-reload)
- (define-key map [tab] 'shr-next-link)
+ (define-key map "g" 'eww-reload) ;FIXME: revert-buffer-function instead!
+ (define-key map "G" 'eww)
+ (define-key map [?\t] 'shr-next-link)
+ (define-key map [?\M-\t] 'shr-previous-link)
(define-key map [backtab] 'shr-previous-link)
(define-key map [delete] 'scroll-down-command)
- (define-key map "\177" 'scroll-down-command)
- (define-key map " " 'scroll-up-command)
(define-key map "l" 'eww-back-url)
- (define-key map "f" 'eww-forward-url)
+ (define-key map "r" 'eww-forward-url)
(define-key map "n" 'eww-next-url)
(define-key map "p" 'eww-previous-url)
(define-key map "u" 'eww-up-url)
@@ -338,6 +652,12 @@ word(s) will be searched for via `eww-search-prefix'."
(define-key map "d" 'eww-download)
(define-key map "w" 'eww-copy-page-url)
(define-key map "C" 'url-cookie-list)
+ (define-key map "v" 'eww-view-source)
+ (define-key map "R" 'eww-readable)
+ (define-key map "H" 'eww-list-histories)
+ (define-key map "E" 'eww-set-character-encoding)
+ (define-key map "S" 'eww-list-buffers)
+ (define-key map "F" 'eww-toggle-fonts)
(define-key map "b" 'eww-add-bookmark)
(define-key map "B" 'eww-list-bookmarks)
@@ -345,8 +665,9 @@ word(s) will be searched for via `eww-search-prefix'."
(define-key map [(meta p)] 'eww-previous-bookmark)
(easy-menu-define nil map ""
- '("eww"
- ["Quit" eww-quit t]
+ '("Eww"
+ ["Exit" quit-window t]
+ ["Close browser" quit-window t]
["Reload" eww-reload t]
["Back to previous page" eww-back-url
:active (not (zerop (length eww-history)))]
@@ -354,50 +675,62 @@ word(s) will be searched for via `eww-search-prefix'."
:active (not (zerop eww-history-position))]
["Browse with external browser" eww-browse-with-external-browser t]
["Download" eww-download t]
+ ["View page source" eww-view-source]
["Copy page URL" eww-copy-page-url t]
+ ["List histories" eww-list-histories t]
+ ["List buffers" eww-list-buffers t]
["Add bookmark" eww-add-bookmark t]
- ["List bookmarks" eww-copy-page-url t]
- ["List cookies" url-cookie-list t]))
+ ["List bookmarks" eww-list-bookmarks t]
+ ["List cookies" url-cookie-list t]
+ ["Character Encoding" eww-set-character-encoding]))
map))
-(define-derived-mode eww-mode nil "eww"
- "Mode for browsing the web.
-
-\\{eww-mode-map}"
- (set (make-local-variable 'eww-current-url) 'author)
- (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url)
- (set (make-local-variable 'after-change-functions) 'eww-process-text-input)
- (set (make-local-variable 'eww-history) nil)
- (set (make-local-variable 'eww-history-position) 0)
+(defvar eww-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (tool-bar-item
+ '((quit-window . "close")
+ (eww-reload . "refresh")
+ (eww-back-url . "left-arrow")
+ (eww-forward-url . "right-arrow")
+ (eww-view-source . "show")
+ (eww-copy-page-url . "copy")
+ (eww-add-bookmark . "bookmark_add"))) ;; ...
+ (tool-bar-local-item-from-menu
+ (car tool-bar-item) (cdr tool-bar-item) map eww-mode-map))
+ map)
+ "Tool bar for `eww-mode'.")
+
+;; Autoload cookie needed by desktop.el.
+;;;###autoload
+(define-derived-mode eww-mode special-mode "eww"
+ "Mode for browsing the web."
+ (setq-local eww-data (list :title ""))
+ (setq-local browse-url-browser-function #'eww-browse-url)
+ (add-hook 'after-change-functions #'eww-process-text-input nil t)
+ (setq-local eww-history nil)
+ (setq-local eww-history-position 0)
+ (when (boundp 'tool-bar-map)
+ (setq-local tool-bar-map eww-tool-bar-map))
+ ;; desktop support
+ (setq-local desktop-save-buffer #'eww-desktop-misc-data)
+ ;; multi-page isearch support
+ (setq-local multi-isearch-next-buffer-function #'eww-isearch-next-buffer)
+ (setq truncate-lines t)
(buffer-disable-undo)
- ;;(setq buffer-read-only t)
- )
-
-(defun eww-save-history ()
- (push (list :url eww-current-url
- :title eww-current-title
- :point (point)
- :text (buffer-string))
- eww-history))
+ (setq buffer-read-only t))
;;;###autoload
(defun eww-browse-url (url &optional new-window)
- (when (and (equal major-mode 'eww-mode)
- eww-current-url)
- (eww-save-history))
+ (cond (new-window
+ (switch-to-buffer (generate-new-buffer "*eww*"))
+ (eww-mode)))
(eww url))
-(defun eww-quit ()
- "Exit the Emacs Web Wowser."
- (interactive)
- (setq eww-history nil)
- (kill-buffer (current-buffer)))
-
(defun eww-back-url ()
"Go to the previously displayed page."
(interactive)
(when (>= eww-history-position (length eww-history))
- (error "No previous page"))
+ (user-error "No previous page"))
(eww-save-history)
(setq eww-history-position (+ eww-history-position 2))
(eww-restore-history (elt eww-history (1- eww-history-position))))
@@ -406,62 +739,77 @@ word(s) will be searched for via `eww-search-prefix'."
"Go to the next displayed page."
(interactive)
(when (zerop eww-history-position)
- (error "No next page"))
+ (user-error "No next page"))
(eww-save-history)
(eww-restore-history (elt eww-history (1- eww-history-position))))
(defun eww-restore-history (elem)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (plist-get elem :text))
- (goto-char (plist-get elem :point))
- (setq eww-current-url (plist-get elem :url)
- eww-current-title (plist-get elem :title))))
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t)
+ (text (plist-get elem :text)))
+ (setq eww-data elem)
+ (if (null text)
+ (eww-reload) ; FIXME: restore :point?
+ (erase-buffer)
+ (insert text)
+ (goto-char (plist-get elem :point))
+ (eww-update-header-line-format))))
(defun eww-next-url ()
"Go to the page marked `next'.
A page is marked `next' if rel=\"next\" appears in a <link>
or <a> tag."
(interactive)
- (if eww-next-url
- (eww-browse-url (shr-expand-url eww-next-url eww-current-url))
- (error "No `next' on this page")))
+ (if (plist-get eww-data :next)
+ (eww-browse-url (shr-expand-url (plist-get eww-data :next)
+ (plist-get eww-data :url)))
+ (user-error "No `next' on this page")))
(defun eww-previous-url ()
"Go to the page marked `previous'.
A page is marked `previous' if rel=\"previous\" appears in a <link>
or <a> tag."
(interactive)
- (if eww-previous-url
- (eww-browse-url (shr-expand-url eww-previous-url eww-current-url))
- (error "No `previous' on this page")))
+ (if (plist-get eww-data :previous)
+ (eww-browse-url (shr-expand-url (plist-get eww-data :previous)
+ (plist-get eww-data :url)))
+ (user-error "No `previous' on this page")))
(defun eww-up-url ()
"Go to the page marked `up'.
A page is marked `up' if rel=\"up\" appears in a <link>
or <a> tag."
(interactive)
- (if eww-up-url
- (eww-browse-url (shr-expand-url eww-up-url eww-current-url))
- (error "No `up' on this page")))
+ (if (plist-get eww-data :up)
+ (eww-browse-url (shr-expand-url (plist-get eww-data :up)
+ (plist-get eww-data :url)))
+ (user-error "No `up' on this page")))
(defun eww-top-url ()
"Go to the page marked `top'.
A page is marked `top' if rel=\"start\", rel=\"home\", or rel=\"contents\"
appears in a <link> or <a> tag."
(interactive)
- (let ((best-url (or eww-start-url
- eww-contents-url
- eww-home-url)))
+ (let ((best-url (or (plist-get eww-data :start)
+ (plist-get eww-data :contents)
+ (plist-get eww-data :home))))
(if best-url
- (eww-browse-url (shr-expand-url best-url eww-current-url))
- (error "No `top' for this page"))))
-
-(defun eww-reload ()
- "Reload the current page."
- (interactive)
- (url-retrieve eww-current-url 'eww-render
- (list eww-current-url (point))))
+ (eww-browse-url (shr-expand-url best-url (plist-get eww-data :url)))
+ (user-error "No `top' for this page"))))
+
+(defun eww-reload (&optional local encode)
+ "Reload the current page.
+If LOCAL (the command prefix), don't reload the page from the
+network, but just re-display the HTML already fetched."
+ (interactive "P")
+ (let ((url (plist-get eww-data :url)))
+ (if local
+ (if (null (plist-get eww-data :dom))
+ (error "No current HTML data")
+ (eww-display-html 'utf-8 url (plist-get eww-data :dom)
+ (point) (current-buffer)))
+ (url-retrieve url 'eww-render
+ (list url (point) (current-buffer) encode)))))
;; Form support.
@@ -473,9 +821,15 @@ appears in a <link> or <a> tag."
(define-key map [(control c) (control c)] 'eww-submit)
map))
+(defvar eww-submit-file
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'eww-select-file)
+ (define-key map [(control c) (control c)] 'eww-submit)
+ map))
+
(defvar eww-checkbox-map
(let ((map (make-sparse-keymap)))
- (define-key map [space] 'eww-toggle-checkbox)
+ (define-key map " " 'eww-toggle-checkbox)
(define-key map "\r" 'eww-toggle-checkbox)
(define-key map [(control c) (control c)] 'eww-submit)
map))
@@ -487,8 +841,8 @@ appears in a <link> or <a> tag."
(define-key map [(control a)] 'eww-beginning-of-text)
(define-key map [(control c) (control c)] 'eww-submit)
(define-key map [(control e)] 'eww-end-of-text)
- (define-key map [tab] 'shr-next-link)
- (define-key map [backtab] 'shr-previous-link)
+ (define-key map [?\t] 'shr-next-link)
+ (define-key map [?\M-\t] 'shr-previous-link)
map))
(defvar eww-textarea-map
@@ -496,8 +850,8 @@ appears in a <link> or <a> tag."
(set-keymap-parent map text-mode-map)
(define-key map "\r" 'forward-line)
(define-key map [(control c) (control c)] 'eww-submit)
- (define-key map [tab] 'shr-next-link)
- (define-key map [backtab] 'shr-previous-link)
+ (define-key map [?\t] 'shr-next-link)
+ (define-key map [?\M-\t] 'shr-previous-link)
map))
(defvar eww-select-map
@@ -537,13 +891,12 @@ appears in a <link> or <a> tag."
(1- (next-single-property-change
(point) 'eww-form nil (point-max))))
-(defun eww-tag-form (cont)
- (let ((eww-form
- (list (assq :method cont)
- (assq :action cont)))
+(defun eww-tag-form (dom)
+ (let ((eww-form (list (cons :method (dom-attr dom 'method))
+ (cons :action (dom-attr dom 'action))))
(start (point)))
(shr-ensure-paragraph)
- (shr-generic cont)
+ (shr-generic dom)
(unless (bolp)
(insert "\n"))
(insert "\n")
@@ -551,9 +904,9 @@ appears in a <link> or <a> tag."
(put-text-property start (1+ start)
'eww-form eww-form))))
-(defun eww-form-submit (cont)
+(defun eww-form-submit (dom)
(let ((start (point))
- (value (cdr (assq :value cont))))
+ (value (dom-attr dom 'value)))
(setq value
(if (zerop (length value))
"Submit"
@@ -564,103 +917,147 @@ appears in a <link> or <a> tag."
(list :eww-form eww-form
:value value
:type "submit"
- :name (cdr (assq :name cont))))
+ :name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-submit-map)
(insert " ")))
-(defun eww-form-checkbox (cont)
+(defun eww-form-checkbox (dom)
(let ((start (point)))
- (if (cdr (assq :checked cont))
- (insert "[X]")
- (insert "[ ]"))
+ (if (dom-attr dom 'checked)
+ (insert eww-form-checkbox-selected-symbol)
+ (insert eww-form-checkbox-symbol))
(add-face-text-property start (point) 'eww-form-checkbox)
(put-text-property start (point) 'eww-form
(list :eww-form eww-form
- :value (cdr (assq :value cont))
- :type (downcase (cdr (assq :type cont)))
- :checked (cdr (assq :checked cont))
- :name (cdr (assq :name cont))))
+ :value (dom-attr dom 'value)
+ :type (downcase (dom-attr dom 'type))
+ :checked (dom-attr dom 'checked)
+ :name (dom-attr dom 'name)))
(put-text-property start (point) 'keymap eww-checkbox-map)
(insert " ")))
-(defun eww-form-text (cont)
+(defun eww-form-file (dom)
(let ((start (point))
- (type (downcase (or (cdr (assq :type cont))
- "text")))
- (value (or (cdr (assq :value cont)) ""))
- (width (string-to-number
- (or (cdr (assq :size cont))
- "40"))))
+ (value (dom-attr dom 'value)))
+ (setq value
+ (if (zerop (length value))
+ " No file selected"
+ value))
+ (insert "Browse")
+ (add-face-text-property start (point) 'eww-form-file)
+ (insert value)
+ (put-text-property start (point) 'eww-form
+ (list :eww-form eww-form
+ :value (dom-attr dom 'value)
+ :type (downcase (dom-attr dom 'type))
+ :name (dom-attr dom 'name)))
+ (put-text-property start (point) 'keymap eww-submit-file)
+ (insert " ")))
+
+(defun eww-select-file ()
+ "Change the value of the upload file menu under point."
+ (interactive)
+ (let* ((input (get-text-property (point) 'eww-form)))
+ (let ((filename
+ (let ((insert-default-directory t))
+ (read-file-name "filename: "))))
+ (eww-update-field filename (length "Browse"))
+ (plist-put input :filename filename))))
+
+(defun eww-form-text (dom)
+ (let ((start (point))
+ (type (downcase (or (dom-attr dom 'type) "text")))
+ (value (or (dom-attr dom 'value) ""))
+ (width (string-to-number (or (dom-attr dom 'size) "40")))
+ (readonly-property (if (or (dom-attr dom 'disabled)
+ (dom-attr dom 'readonly))
+ 'read-only
+ 'inhibit-read-only)))
(insert value)
(when (< (length value) width)
(insert (make-string (- width (length value)) ? )))
(put-text-property start (point) 'face 'eww-form-text)
- (put-text-property start (point) 'local-map eww-text-map)
(put-text-property start (point) 'inhibit-read-only t)
+ (put-text-property start (point) 'local-map eww-text-map)
+ (put-text-property start (point) readonly-property t)
(put-text-property start (point) 'eww-form
- (list :eww-form eww-form
- :value value
- :type type
- :name (cdr (assq :name cont))))
+ (list :eww-form eww-form
+ :value value
+ :type type
+ :name (dom-attr dom 'name)))
(insert " ")))
-(defun eww-process-text-input (beg end length)
- (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form))
- (properties (text-properties-at end))
- (type (plist-get form :type)))
- (when (and form
- (member type '("text" "password" "textarea")))
- (cond
- ((zerop length)
- ;; Delete some space at the end.
- (save-excursion
- (goto-char
- (if (equal type "textarea")
- (1- (line-end-position))
- (eww-end-of-field)))
- (let ((new (- end beg)))
- (while (and (> new 0)
+(defconst eww-text-input-types '("text" "password" "textarea"
+ "color" "date" "datetime" "datetime-local"
+ "email" "month" "number" "search" "tel"
+ "time" "url" "week")
+ "List of input types which represent a text input.
+See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
+
+(defun eww-process-text-input (beg end replace-length)
+ (when-let (pos (and (< (1+ end) (point-max))
+ (> (1- end) (point-min))
+ (cond
+ ((get-text-property (1+ end) 'eww-form)
+ (1+ end))
+ ((get-text-property (1- end) 'eww-form)
+ (1- end)))))
+ (let* ((form (get-text-property pos 'eww-form))
+ (properties (text-properties-at pos))
+ (inhibit-read-only t)
+ (length (- end beg replace-length))
+ (type (plist-get form :type)))
+ (when (and form
+ (member type eww-text-input-types))
+ (cond
+ ((> length 0)
+ ;; Delete some space at the end.
+ (save-excursion
+ (goto-char
+ (if (equal type "textarea")
+ (1- (line-end-position))
+ (eww-end-of-field)))
+ (while (and (> length 0)
(eql (following-char) ? ))
- (delete-region (point) (1+ (point)))
- (setq new (1- new))))
- (set-text-properties beg end properties)))
- ((> length 0)
- ;; Add padding.
- (save-excursion
- (goto-char
- (if (equal type "textarea")
- (1- (line-end-position))
- (eww-end-of-field)))
- (let ((start (point)))
- (insert (make-string length ? ))
- (set-text-properties start (point) properties)))))
- (let ((value (buffer-substring-no-properties
- (eww-beginning-of-field)
- (eww-end-of-field))))
- (when (string-match " +\\'" value)
- (setq value (substring value 0 (match-beginning 0))))
- (plist-put form :value value)
- (when (equal type "password")
- ;; Display passwords as asterisks.
- (let ((start (eww-beginning-of-field)))
- (put-text-property start (+ start (length value))
- 'display (make-string (length value) ?*))))))))
-
-(defun eww-tag-textarea (cont)
+ (delete-region (1- (point)) (point))
+ (cl-decf length))))
+ ((< length 0)
+ ;; Add padding.
+ (save-excursion
+ (goto-char (1- end))
+ (goto-char
+ (if (equal type "textarea")
+ (1- (line-end-position))
+ (1+ (eww-end-of-field))))
+ (let ((start (point)))
+ (insert (make-string (abs length) ? ))
+ (set-text-properties start (point) properties))
+ (goto-char (1- end)))))
+ (set-text-properties (plist-get form :start) (plist-get form :end)
+ properties)
+ (let ((value (buffer-substring-no-properties
+ (eww-beginning-of-field)
+ (eww-end-of-field))))
+ (when (string-match " +\\'" value)
+ (setq value (substring value 0 (match-beginning 0))))
+ (plist-put form :value value)
+ (when (equal type "password")
+ ;; Display passwords as asterisks.
+ (let ((start (eww-beginning-of-field)))
+ (put-text-property start (+ start (length value))
+ 'display (make-string (length value) ?*)))))))))
+
+(defun eww-tag-textarea (dom)
(let ((start (point))
- (value (or (cdr (assq :value cont)) ""))
- (lines (string-to-number
- (or (cdr (assq :rows cont))
- "10")))
- (width (string-to-number
- (or (cdr (assq :cols cont))
- "10")))
+ (value (or (dom-attr dom 'value) ""))
+ (lines (string-to-number (or (dom-attr dom 'rows) "10")))
+ (width (string-to-number (or (dom-attr dom 'cols) "10")))
end)
(shr-ensure-newline)
(insert value)
(shr-ensure-newline)
(when (< (count-lines start (point)) lines)
- (dotimes (i (- lines (count-lines start (point))))
+ (dotimes (_ (- lines (count-lines start (point))))
(insert "\n")))
(setq end (point-marker))
(goto-char start)
@@ -670,7 +1067,8 @@ appears in a <link> or <a> tag."
(when (> pad 0)
(insert (make-string pad ? ))))
(add-face-text-property (line-beginning-position)
- (point) 'eww-form-text)
+ (point) 'eww-form-textarea)
+ (put-text-property (line-beginning-position) (point) 'inhibit-read-only t)
(put-text-property (line-beginning-position) (point)
'local-map eww-textarea-map)
(forward-line 1))
@@ -678,21 +1076,22 @@ appears in a <link> or <a> tag."
(list :eww-form eww-form
:value value
:type "textarea"
- :name (cdr (assq :name cont))))))
+ :name (dom-attr dom 'name)))))
-(defun eww-tag-input (cont)
- (let ((type (downcase (or (cdr (assq :type cont))
- "text")))
+(defun eww-tag-input (dom)
+ (let ((type (downcase (or (dom-attr dom 'type) "text")))
(start (point)))
(cond
((or (equal type "checkbox")
(equal type "radio"))
- (eww-form-checkbox cont))
+ (eww-form-checkbox dom))
+ ((equal type "file")
+ (eww-form-file dom))
((equal type "submit")
- (eww-form-submit cont))
+ (eww-form-submit dom))
((equal type "hidden")
(let ((form eww-form)
- (name (cdr (assq :name cont))))
+ (name (dom-attr dom 'name)))
;; Don't add <input type=hidden> elements repeatedly.
(while (and form
(or (not (consp (car form)))
@@ -704,28 +1103,33 @@ appears in a <link> or <a> tag."
(nconc eww-form (list
(list 'hidden
:name name
- :value (cdr (assq :value cont))))))))
+ :value (dom-attr dom 'value)))))))
(t
- (eww-form-text cont)))
+ (eww-form-text dom)))
(unless (= start (point))
(put-text-property start (1+ start) 'help-echo "Input field"))))
-(defun eww-tag-select (cont)
+(defun eww-tag-select (dom)
(shr-ensure-paragraph)
- (let ((menu (list :name (cdr (assq :name cont))
+ (let ((menu (list :name (dom-attr dom 'name)
:eww-form eww-form))
(options nil)
(start (point))
- (max 0))
- (dolist (elem cont)
- (when (eq (car elem) 'option)
- (when (cdr (assq :selected (cdr elem)))
- (nconc menu (list :value
- (cdr (assq :value (cdr elem))))))
- (let ((display (or (cdr (assq 'text (cdr elem))) "")))
+ (max 0)
+ opelem)
+ (if (eq (dom-tag dom) 'optgroup)
+ (dolist (groupelem (dom-children dom))
+ (unless (dom-attr groupelem 'disabled)
+ (setq opelem (append opelem (list groupelem)))))
+ (setq opelem (list dom)))
+ (dolist (elem opelem)
+ (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 (cdr (assq :value (cdr elem)))
+ :value (dom-attr elem 'value)
:display display)
options))))
(when options
@@ -740,6 +1144,8 @@ appears in a <link> or <a> tag."
(put-text-property start (point) 'eww-form menu)
(add-face-text-property start (point) 'eww-form-select)
(put-text-property start (point) 'keymap eww-select-map)
+ (unless (= start (point))
+ (put-text-property start (1+ start) 'help-echo "select field"))
(shr-ensure-paragraph))))
(defun eww-select-display (select)
@@ -756,7 +1162,6 @@ appears in a <link> or <a> tag."
"Change the value of the select drop-down menu under point."
(interactive)
(let* ((input (get-text-property (point) 'eww-form))
- (properties (text-properties-at (point)))
(completion-ignore-case t)
(options
(delq nil
@@ -773,14 +1178,17 @@ appears in a <link> or <a> tag."
(goto-char
(eww-update-field display))))
-(defun eww-update-field (string)
+(defun eww-update-field (string &optional offset)
+ (if (not offset) (setq offset 0))
(let ((properties (text-properties-at (point)))
- (start (eww-beginning-of-field))
- (end (1+ (eww-end-of-field))))
- (delete-region start end)
+ (start (+ (eww-beginning-of-field) offset))
+ (current-end (1+ (eww-end-of-field)))
+ (new-end (1+ (+ (eww-beginning-of-field) (length string)))))
+ (delete-region start current-end)
+ (forward-char offset)
(insert string
- (make-string (- (- end start) (length string)) ? ))
- (set-text-properties start end properties)
+ (make-string (- (- (+ new-end offset) start) (length string)) ? ))
+ (if (= 0 offset) (set-text-properties start new-end properties))
start))
(defun eww-toggle-checkbox ()
@@ -794,9 +1202,9 @@ appears in a <link> or <a> tag."
(if (plist-get input :checked)
(progn
(plist-put input :checked nil)
- (eww-update-field "[ ]"))
+ (eww-update-field eww-form-checkbox-symbol))
(plist-put input :checked t)
- (eww-update-field "[X]"))))
+ (eww-update-field eww-form-checkbox-selected-symbol))))
;; Radio button. Switch all other buttons off.
(let ((name (plist-get input :name)))
(save-excursion
@@ -806,9 +1214,9 @@ appears in a <link> or <a> tag."
(if (not (eq (cdr elem) input))
(progn
(plist-put input :checked nil)
- (eww-update-field "[ ]"))
+ (eww-update-field eww-form-checkbox-symbol))
(plist-put input :checked t)
- (eww-update-field "[X]")))))
+ (eww-update-field eww-form-checkbox-selected-symbol)))))
(forward-char 1)))))
(defun eww-inputs (form)
@@ -825,6 +1233,18 @@ appears in a <link> or <a> tag."
(setq start (next-single-property-change start 'eww-form))))
(nreverse inputs)))
+(defun eww-size-text-inputs ()
+ (let ((start (point-min)))
+ (while (and start
+ (< start (point-max)))
+ (when (or (get-text-property start 'eww-form)
+ (setq start (next-single-property-change start 'eww-form)))
+ (let ((props (get-text-property start 'eww-form)))
+ (plist-put props :start start)
+ (setq start (next-single-property-change
+ start 'eww-form nil (point-max)))
+ (plist-put props :end start))))))
+
(defun eww-input-value (input)
(let ((type (plist-get input :type))
(value (plist-get input :value)))
@@ -848,8 +1268,8 @@ appears in a <link> or <a> tag."
(form (plist-get this-input :eww-form))
values next-submit)
(dolist (elem (sort (eww-inputs form)
- (lambda (o1 o2)
- (< (car o1) (car o2)))))
+ (lambda (o1 o2)
+ (< (car o1) (car o2)))))
(let* ((input (cdr elem))
(input-start (car elem))
(name (plist-get input :name)))
@@ -859,6 +1279,16 @@ appears in a <link> or <a> tag."
(when (plist-get input :checked)
(push (cons name (plist-get input :value))
values)))
+ ((equal (plist-get input :type) "file")
+ (push (cons "file"
+ (list (cons "filedata"
+ (with-temp-buffer
+ (insert-file-contents
+ (plist-get input :filename))
+ (buffer-string)))
+ (cons "name" (plist-get input :name))
+ (cons "filename" (plist-get input :filename))))
+ values))
((equal (plist-get input :type) "submit")
;; We want the values from buttons if we hit a button if
;; we hit enter on it, or if it's the first button after
@@ -877,35 +1307,88 @@ appears in a <link> or <a> tag."
(when (and (consp elem)
(eq (car elem) 'hidden))
(push (cons (plist-get (cdr elem) :name)
- (plist-get (cdr elem) :value))
+ (or (plist-get (cdr elem) :value) ""))
values)))
(if (and (stringp (cdr (assq :method form)))
(equal (downcase (cdr (assq :method form))) "post"))
- (let ((url-request-method "POST")
- (url-request-extra-headers
- '(("Content-Type" . "application/x-www-form-urlencoded")))
- (url-request-data (mm-url-encode-www-form-urlencoded values)))
- (eww-browse-url (shr-expand-url (cdr (assq :action form))
- eww-current-url)))
+ (let ((mtype))
+ (dolist (x values mtype)
+ (if (equal (car x) "file")
+ (progn
+ (setq mtype "multipart/form-data"))))
+ (cond ((equal mtype "multipart/form-data")
+ (let ((boundary (mml-compute-boundary '())))
+ (let ((url-request-method "POST")
+ (url-request-extra-headers
+ (list (cons "Content-Type"
+ (concat "multipart/form-data; boundary="
+ boundary))))
+ (url-request-data
+ (mm-url-encode-multipart-form-data values boundary)))
+ (eww-browse-url (shr-expand-url
+ (cdr (assq :action form))
+ (plist-get eww-data :url))))))
+ (t
+ (let ((url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-Type" .
+ "application/x-www-form-urlencoded")))
+ (url-request-data
+ (mm-url-encode-www-form-urlencoded values)))
+ (eww-browse-url (shr-expand-url
+ (cdr (assq :action form))
+ (plist-get eww-data :url)))))))
(eww-browse-url
(concat
(if (cdr (assq :action form))
- (shr-expand-url (cdr (assq :action form))
- eww-current-url)
- eww-current-url)
+ (shr-expand-url (cdr (assq :action form)) (plist-get eww-data :url))
+ (plist-get eww-data :url))
"?"
(mm-url-encode-www-form-urlencoded values))))))
-(defun eww-browse-with-external-browser ()
+(defun eww-browse-with-external-browser (&optional url)
"Browse the current URL with an external browser.
The browser to used is specified by the `shr-external-browser' variable."
(interactive)
- (funcall shr-external-browser eww-current-url))
+ (funcall shr-external-browser (or url (plist-get eww-data :url))))
+
+(defun eww-follow-link (&optional external mouse-event)
+ "Browse the URL under point.
+If EXTERNAL is single prefix, browse the URL using `shr-external-browser'.
+If EXTERNAL is double prefix, browse in new buffer."
+ (interactive (list current-prefix-arg last-nonmenu-event))
+ (mouse-set-point mouse-event)
+ (let ((url (get-text-property (point) 'shr-url)))
+ (cond
+ ((not url)
+ (message "No link under point"))
+ ((string-match "^mailto:" url)
+ (browse-url-mail url))
+ ((and (consp external) (<= (car external) 4))
+ (funcall shr-external-browser url))
+ ;; This is a #target url in the same page as the current one.
+ ((and (url-target (url-generic-parse-url url))
+ (eww-same-page-p url (plist-get eww-data :url)))
+ (let ((dom (plist-get eww-data :dom)))
+ (eww-save-history)
+ (eww-display-html 'utf-8 url dom nil (current-buffer))))
+ (t
+ (eww-browse-url url external)))))
+
+(defun eww-same-page-p (url1 url2)
+ "Return non-nil if URL1 and URL2 represent the same page.
+Differences in #targets are ignored."
+ (let ((obj1 (url-generic-parse-url url1))
+ (obj2 (url-generic-parse-url url2)))
+ (setf (url-target obj1) nil)
+ (setf (url-target obj2) nil)
+ (equal (url-recreate-url obj1) (url-recreate-url obj2))))
(defun eww-copy-page-url ()
+ "Copy the URL of the current page into the kill ring."
(interactive)
- (message "%s" eww-current-url)
- (kill-new eww-current-url))
+ (message "%s" (plist-get eww-data :url))
+ (kill-new (plist-get eww-data :url)))
(defun eww-download ()
"Download URL under point to `eww-download-directory'."
@@ -920,8 +1403,10 @@ The browser to used is specified by the `shr-external-browser' variable."
(let* ((obj (url-generic-parse-url url))
(path (car (url-path-and-query obj)))
(file (eww-make-unique-file-name (file-name-nondirectory path)
- eww-download-path)))
- (write-file file)
+ eww-download-directory)))
+ (goto-char (point-min))
+ (re-search-forward "\r?\n\r?\n")
+ (write-region (point) (point-max) file)
(message "Saved %s" file))))
(defun eww-make-unique-file-name (file directory)
@@ -930,8 +1415,7 @@ The browser to used is specified by the `shr-external-browser' variable."
(setq file "!"))
((string-match "\\`[.]" file)
(setq file (concat "!" file))))
- (let ((base file)
- (count 1))
+ (let ((count 1))
(while (file-exists-p (expand-file-name file directory))
(setq file
(if (string-match "\\`\\(.*\\)\\([.][^.]+\\)" file)
@@ -941,40 +1425,60 @@ The browser to used is specified by the `shr-external-browser' variable."
(setq count (1+ count)))
(expand-file-name file directory)))
+(defun eww-set-character-encoding (charset)
+ "Set character encoding to CHARSET.
+If CHARSET is nil then use UTF-8."
+ (interactive "zUse character set (default utf-8): ")
+ (if (null charset)
+ (eww-reload nil 'utf-8)
+ (eww-reload nil charset)))
+
+(defun eww-toggle-fonts ()
+ "Toggle whether to use monospaced or font-enabled layouts."
+ (interactive)
+ (message "Fonts are now %s"
+ (if (setq shr-use-fonts (not shr-use-fonts))
+ "on"
+ "off"))
+ (eww-reload))
+
;;; Bookmarks code
(defvar eww-bookmarks nil)
(defun eww-add-bookmark ()
- "Add the current page to the bookmarks."
+ "Bookmark the current page."
(interactive)
(eww-read-bookmarks)
(dolist (bookmark eww-bookmarks)
- (when (equal eww-current-url
- (plist-get bookmark :url))
- (error "Already bookmarked")))
- (let ((title (replace-regexp-in-string "[\n\t\r]" " " eww-current-title)))
- (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
- (push (list :url eww-current-url
- :title title
- :time (current-time-string))
- eww-bookmarks))
- (eww-write-bookmarks)
- (message "Bookmarked %s (%s)" eww-current-url eww-current-title))
+ (when (equal (plist-get eww-data :url) (plist-get bookmark :url))
+ (user-error "Already bookmarked")))
+ (when (y-or-n-p "Bookmark this page?")
+ (let ((title (replace-regexp-in-string "[\n\t\r]" " "
+ (plist-get eww-data :title))))
+ (setq title (replace-regexp-in-string "\\` +\\| +\\'" "" title))
+ (push (list :url (plist-get eww-data :url)
+ :title title
+ :time (current-time-string))
+ eww-bookmarks))
+ (eww-write-bookmarks)
+ (message "Bookmarked %s (%s)" (plist-get eww-data :url)
+ (plist-get eww-data :title))))
(defun eww-write-bookmarks ()
- (with-temp-file (expand-file-name "eww-bookmarks" user-emacs-directory)
+ (with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
(insert ";; Auto-generated file; don't edit\n")
(pp eww-bookmarks (current-buffer))))
(defun eww-read-bookmarks ()
- (let ((file (expand-file-name "eww-bookmarks" user-emacs-directory)))
+ (let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (nth 7 (file-attributes file)) 0))
(with-temp-buffer
(insert-file-contents file)
(read (current-buffer)))))))
+;;;###autoload
(defun eww-list-bookmarks ()
"Display the bookmarks."
(interactive)
@@ -983,23 +1487,22 @@ The browser to used is specified by the `shr-external-browser' variable."
(defun eww-bookmark-prepare ()
(eww-read-bookmarks)
- (when (null eww-bookmarks)
- (error "No bookmarks are defined"))
+ (unless eww-bookmarks
+ (user-error "No bookmarks are defined"))
(set-buffer (get-buffer-create "*eww bookmarks*"))
(eww-bookmark-mode)
- (let ((format "%-40s %s")
- (inhibit-read-only t)
- start url)
+ (let* ((width (/ (window-width) 2))
+ (format (format "%%-%ds %%s" width))
+ (inhibit-read-only t)
+ start title)
(erase-buffer)
- (setq header-line-format (concat " " (format format "URL" "Title")))
+ (setq header-line-format (concat " " (format format "Title" "URL")))
(dolist (bookmark eww-bookmarks)
- (setq start (point))
- (setq url (plist-get bookmark :url))
- (when (> (length url) 40)
- (setq url (substring url 0 40)))
- (insert (format format url
- (plist-get bookmark :title))
- "\n")
+ (setq start (point)
+ title (plist-get bookmark :title))
+ (when (> (length title) width)
+ (setq title (truncate-string-to-width title width)))
+ (insert (format format title (plist-get bookmark :url)) "\n")
(put-text-property start (1+ start) 'eww-bookmark bookmark))
(goto-char (point-min))))
@@ -1012,7 +1515,7 @@ The browser to used is specified by the `shr-external-browser' variable."
(bookmark (get-text-property start 'eww-bookmark))
(inhibit-read-only t))
(unless bookmark
- (error "No bookmark on the current line"))
+ (user-error "No bookmark on the current line"))
(forward-line 1)
(push (buffer-substring start (point)) eww-bookmark-kill-ring)
(delete-region start (point))
@@ -1023,7 +1526,7 @@ The browser to used is specified by the `shr-external-browser' variable."
"Yank a previously killed bookmark to the current line."
(interactive)
(unless eww-bookmark-kill-ring
- (error "No previously killed bookmark"))
+ (user-error "No previously killed bookmark"))
(beginning-of-line)
(let ((inhibit-read-only t)
(start (point))
@@ -1037,22 +1540,14 @@ The browser to used is specified by the `shr-external-browser' variable."
(cons bookmark (nthcdr line eww-bookmarks)))))
(eww-write-bookmarks)))
-(defun eww-bookmark-quit ()
- "Kill the current buffer."
- (interactive)
- (kill-buffer (current-buffer)))
-
(defun eww-bookmark-browse ()
"Browse the bookmark under point in eww."
(interactive)
(let ((bookmark (get-text-property (line-beginning-position) 'eww-bookmark)))
(unless bookmark
- (error "No bookmark on the current line"))
- ;; We wish to leave this window, but if it's the only window here,
- ;; just let it remain.
- (ignore-errors
- (delete-window))
- (eww (plist-get bookmark :url))))
+ (user-error "No bookmark on the current line"))
+ (quit-window)
+ (eww-browse-url (plist-get bookmark :url))))
(defun eww-next-bookmark ()
"Go to the next bookmark in the list."
@@ -1069,7 +1564,7 @@ The browser to used is specified by the `shr-external-browser' variable."
(setq bookmark (get-text-property (line-beginning-position)
'eww-bookmark))
(unless bookmark
- (error "No next bookmark")))
+ (user-error "No next bookmark")))
(eww-browse-url (plist-get bookmark :url))))
(defun eww-previous-bookmark ()
@@ -1088,7 +1583,7 @@ The browser to used is specified by the `shr-external-browser' variable."
(when (eolp)
(forward-line -1))
(if (bobp)
- (error "No previous bookmark")
+ (user-error "No previous bookmark")
(forward-line -1))
(setq bookmark (get-text-property (line-beginning-position)
'eww-bookmark)))
@@ -1096,20 +1591,323 @@ The browser to used is specified by the `shr-external-browser' variable."
(defvar eww-bookmark-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'eww-bookmark-quit)
(define-key map [(control k)] 'eww-bookmark-kill)
(define-key map [(control y)] 'eww-bookmark-yank)
(define-key map "\r" 'eww-bookmark-browse)
+
+ (easy-menu-define nil map
+ "Menu for `eww-bookmark-mode-map'."
+ '("Eww Bookmark"
+ ["Exit" quit-window t]
+ ["Browse" eww-bookmark-browse
+ :active (get-text-property (line-beginning-position) 'eww-bookmark)]
+ ["Kill" eww-bookmark-kill
+ :active (get-text-property (line-beginning-position) 'eww-bookmark)]
+ ["Yank" eww-bookmark-yank
+ :active eww-bookmark-kill-ring]))
map))
-(define-derived-mode eww-bookmark-mode nil "eww bookmarks"
+(define-derived-mode eww-bookmark-mode special-mode "eww bookmarks"
"Mode for listing bookmarks.
\\{eww-bookmark-mode-map}"
(buffer-disable-undo)
- (setq buffer-read-only t
- truncate-lines t))
+ (setq truncate-lines t))
+
+;;; History code
+
+(defun eww-save-history ()
+ (plist-put eww-data :point (point))
+ (plist-put eww-data :text (buffer-string))
+ (push eww-data eww-history)
+ (setq eww-data (list :title ""))
+ ;; Don't let the history grow infinitely. We store quite a lot of
+ ;; data per page.
+ (when-let (tail (and eww-history-limit
+ (nthcdr eww-history-limit eww-history)))
+ (setcdr tail nil)))
+
+(defvar eww-current-buffer)
+
+(defun eww-list-histories ()
+ "List the eww-histories."
+ (interactive)
+ (when (null eww-history)
+ (error "No eww-histories are defined"))
+ (let ((eww-history-trans eww-history)
+ (buffer (current-buffer)))
+ (set-buffer (get-buffer-create "*eww history*"))
+ (eww-history-mode)
+ (setq-local eww-current-buffer buffer)
+ (let ((inhibit-read-only t)
+ (domain-length 0)
+ (title-length 0)
+ url title format start)
+ (erase-buffer)
+ (dolist (history eww-history-trans)
+ (setq start (point))
+ (setq domain-length (max domain-length (length (plist-get history :url))))
+ (setq title-length (max title-length (length (plist-get history :title)))))
+ (setq format (format "%%-%ds %%-%ds" title-length domain-length)
+ header-line-format
+ (concat " " (format format "Title" "URL")))
+ (dolist (history eww-history-trans)
+ (setq start (point))
+ (setq url (plist-get history :url))
+ (setq title (plist-get history :title))
+ (insert (format format title url))
+ (insert "\n")
+ (put-text-property start (1+ start) 'eww-history history))
+ (goto-char (point-min)))
+ (pop-to-buffer "*eww history*")))
+
+(defun eww-history-browse ()
+ "Browse the history under point in eww."
+ (interactive)
+ (let ((history (get-text-property (line-beginning-position) 'eww-history)))
+ (unless history
+ (error "No history on the current line"))
+ (let ((buffer eww-current-buffer))
+ (quit-window)
+ (when buffer
+ (switch-to-buffer buffer)))
+ (eww-restore-history history)))
+
+(defvar eww-history-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\r" 'eww-history-browse)
+;; (define-key map "n" 'next-error-no-select)
+;; (define-key map "p" 'previous-error-no-select)
+
+ (easy-menu-define nil map
+ "Menu for `eww-history-mode-map'."
+ '("Eww History"
+ ["Exit" quit-window t]
+ ["Browse" eww-history-browse
+ :active (get-text-property (line-beginning-position) 'eww-history)]))
+ map))
+
+(define-derived-mode eww-history-mode special-mode "eww history"
+ "Mode for listing eww-histories.
+
+\\{eww-history-mode-map}"
+ (buffer-disable-undo)
+ (setq truncate-lines t))
+
+;;; eww buffers list
+
+(defun eww-list-buffers ()
+ "Enlist eww buffers."
+ (interactive)
+ (let (buffers-info
+ (current (current-buffer)))
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (derived-mode-p 'eww-mode)
+ (push (vector buffer (plist-get eww-data :title)
+ (plist-get eww-data :url))
+ buffers-info))))
+ (unless buffers-info
+ (error "No eww buffers"))
+ (setq buffers-info (nreverse buffers-info)) ;more recent on top
+ (set-buffer (get-buffer-create "*eww buffers*"))
+ (eww-buffers-mode)
+ (let ((inhibit-read-only t)
+ (domain-length 0)
+ (title-length 0)
+ url title format start)
+ (erase-buffer)
+ (dolist (buffer-info buffers-info)
+ (setq title-length (max title-length
+ (length (elt buffer-info 1)))
+ domain-length (max domain-length
+ (length (elt buffer-info 2)))))
+ (setq format (format "%%-%ds %%-%ds" title-length domain-length)
+ header-line-format
+ (concat " " (format format "Title" "URL")))
+ (let ((line 0)
+ (current-buffer-line 1))
+ (dolist (buffer-info buffers-info)
+ (setq start (point)
+ title (elt buffer-info 1)
+ url (elt buffer-info 2)
+ line (1+ line))
+ (insert (format format title url))
+ (insert "\n")
+ (let ((buffer (elt buffer-info 0)))
+ (put-text-property start (1+ start) 'eww-buffer
+ buffer)
+ (when (eq current buffer)
+ (setq current-buffer-line line))))
+ (goto-char (point-min))
+ (forward-line (1- current-buffer-line)))))
+ (pop-to-buffer "*eww buffers*"))
+
+(defun eww-buffer-select ()
+ "Switch to eww buffer."
+ (interactive)
+ (let ((buffer (get-text-property (line-beginning-position)
+ 'eww-buffer)))
+ (unless buffer
+ (error "No buffer on current line"))
+ (quit-window)
+ (switch-to-buffer buffer)))
+
+(defun eww-buffer-show ()
+ "Display buffer under point in eww buffer list."
+ (let ((buffer (get-text-property (line-beginning-position)
+ 'eww-buffer)))
+ (unless buffer
+ (error "No buffer on current line"))
+ (other-window -1)
+ (switch-to-buffer buffer)
+ (other-window 1)))
+
+(defun eww-buffer-show-next ()
+ "Move to next eww buffer in the list and display it."
+ (interactive)
+ (forward-line)
+ (when (eobp)
+ (goto-char (point-min)))
+ (eww-buffer-show))
+
+(defun eww-buffer-show-previous ()
+ "Move to previous eww buffer in the list and display it."
+ (interactive)
+ (beginning-of-line)
+ (when (bobp)
+ (goto-char (point-max)))
+ (forward-line -1)
+ (eww-buffer-show))
+
+(defun eww-buffer-kill ()
+ "Kill buffer from eww list."
+ (interactive)
+ (let* ((start (line-beginning-position))
+ (buffer (get-text-property start 'eww-buffer))
+ (inhibit-read-only t))
+ (unless buffer
+ (user-error "No buffer on the current line"))
+ (kill-buffer buffer)
+ (forward-line 1)
+ (delete-region start (point)))
+ (when (eobp)
+ (forward-line -1))
+ (eww-buffer-show))
+
+(defvar eww-buffers-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control k)] 'eww-buffer-kill)
+ (define-key map "\r" 'eww-buffer-select)
+ (define-key map "n" 'eww-buffer-show-next)
+ (define-key map "p" 'eww-buffer-show-previous)
+
+ (easy-menu-define nil map
+ "Menu for `eww-buffers-mode-map'."
+ '("Eww Buffers"
+ ["Exit" quit-window t]
+ ["Select" eww-buffer-select
+ :active (get-text-property (line-beginning-position) 'eww-buffer)]
+ ["Kill" eww-buffer-kill
+ :active (get-text-property (line-beginning-position) 'eww-buffer)]))
+ map))
+
+(define-derived-mode eww-buffers-mode special-mode "eww buffers"
+ "Mode for listing buffers.
+
+\\{eww-buffers-mode-map}"
+ (buffer-disable-undo)
+ (setq truncate-lines t))
+
+;;; Desktop support
+
+(defvar eww-desktop-data-save
+ '(:url :title :point)
+ "List of `eww-data' properties to preserve in the desktop file.
+Also used when saving `eww-history'.")
+
+(defun eww-desktop-data-1 (alist)
+ (let ((acc nil)
+ (tail alist))
+ (while tail
+ (let ((k (car tail))
+ (v (cadr tail)))
+ (when (memq k eww-desktop-data-save)
+ (setq acc (cons k (cons v acc)))))
+ (setq tail (cddr tail)))
+ acc))
+
+(defun eww-desktop-history-duplicate (a b)
+ (let ((tail a) (r t))
+ (while tail
+ (if (or (memq (car tail) '(:point)) ; ignore :point
+ (equal (cadr tail)
+ (plist-get b (car tail))))
+ (setq tail (cddr tail))
+ (setq tail nil
+ r nil)))
+ ;; .
+ r))
+
+(defun eww-desktop-misc-data (_directory)
+ "Return a property list with data used to restore eww buffers.
+This list will contain, as :history, the list, whose first element is
+the value of `eww-data', and the tail is `eww-history'.
+
+If `eww-desktop-remove-duplicates' is non-nil, duplicate
+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))))
+
+(defun eww-restore-desktop (file-name buffer-name misc-data)
+ "Restore an eww buffer from its desktop file record.
+If `eww-restore-desktop' is t or 'auto, this function will also
+initiate the retrieval of the respective URI in the background.
+Otherwise, the restored buffer will contain a prompt to do so by using
+\\[eww-reload]."
+ (with-current-buffer (get-buffer-create buffer-name)
+ (eww-mode)
+ ;; NB: eww-history, eww-data are buffer-local per (eww-mode)
+ (setq eww-history (cdr (plist-get misc-data :history))
+ eww-data (or (car (plist-get misc-data :history))
+ ;; backwards compatibility
+ (list :url (plist-get misc-data :uri))))
+ (unless file-name
+ (when (plist-get eww-data :url)
+ (case eww-restore-desktop
+ ((t auto) (eww (plist-get eww-data :url)))
+ ((zerop (buffer-size))
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys
+ eww-restore-reload-prompt)))))))
+ ;; .
+ (current-buffer)))
+
+(add-to-list 'desktop-locals-to-save
+ 'eww-history-position)
+(add-to-list 'desktop-buffer-mode-handlers
+ '(eww-mode . eww-restore-desktop))
+
+;;; Isearch support
+
+(defun eww-isearch-next-buffer (&optional _buffer wrap)
+ "Go to the next page to search using `rel' attribute for navigation."
+ (if wrap
+ (condition-case nil
+ (eww-top-url)
+ (error nil))
+ (if isearch-forward
+ (eww-next-url)
+ (eww-previous-url)))
+ (current-buffer))
(provide 'eww)
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 37755806616..479c9a579f3 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -1,6 +1,6 @@
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
@@ -35,13 +35,13 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(defgroup gnutls nil
"Emacs interface to the GnuTLS library."
:version "24.1"
:prefix "gnutls-"
- :group 'net-utils)
+ :group 'comm)
(defcustom gnutls-algorithm-priority nil
"If non-nil, this should be a TLS priority string.
@@ -51,6 +51,20 @@ set this variable to \"normal:-dhe-rsa\"."
:type '(choice (const nil)
string))
+(defcustom gnutls-verify-error nil
+ "If non-nil, this should be a list of checks per hostname regex or t."
+ :group 'gnutls
+ :version "24.4"
+ :type '(choice
+ (const t)
+ (repeat :tag "List of hostname regexps with flags for each"
+ (list
+ (choice :tag "Hostname"
+ (const ".*" :tag "Any hostname")
+ regexp)
+ (set (const :trustfiles)
+ (const :hostname))))))
+
(defcustom gnutls-trustfiles
'(
"/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux
@@ -97,9 +111,9 @@ specifying a port number to connect to.
Usage example:
- \(with-temp-buffer
- \(open-gnutls-stream \"tls\"
- \(current-buffer)
+ (with-temp-buffer
+ (open-gnutls-stream \"tls\"
+ (current-buffer)
\"your server goes here\"
\"imaps\"))
@@ -115,6 +129,7 @@ trust and key files, and priority string."
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
(declare-function gnutls-errorp "gnutls.c" (error))
+(defvar gnutls-log-level) ; gnutls.c
(cl-defun gnutls-negotiate
(&rest spec
@@ -137,19 +152,25 @@ MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
\(see `gnutls-min-prime-bits' for more information). Use nil for the
default.
-When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
-when the hostname does not match the presented certificate's host
-name. The exact verification algorithm is a basic implementation
-of the matching described in RFC2818 (HTTPS), which takes into
-account wildcards, and the DNSName/IPAddress subject alternative
-name PKIX extension. See GnuTLS' gnutls_x509_crt_check_hostname
-for details. When VERIFY-HOSTNAME-ERROR is nil, only a warning
-will be issued.
+VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
+putting `:hostname' in VERIFY-ERROR.
+
+When VERIFY-ERROR is t or a list containing `:trustfiles', an
+error will be raised when the peer certificate verification fails
+as per GnuTLS' gnutls_certificate_verify_peers2. Otherwise, only
+warnings will be shown about the verification failure.
-When VERIFY-ERROR is not nil, an error will be raised when the
-peer certificate verification fails as per GnuTLS'
-gnutls_certificate_verify_peers2. Otherwise, only warnings will
-be shown about the verification failure.
+When VERIFY-ERROR is t or a list containing `:hostname', an error
+will be raised when the hostname does not match the presented
+certificate's host name. The exact verification algorithm is a
+basic implementation of the matching described in
+RFC2818 (HTTPS), which takes into account wildcards, and the
+DNSName/IPAddress subject alternative name PKIX extension. See
+GnuTLS' gnutls_x509_crt_check_hostname for details. Otherwise,
+only a warning will be issued.
+
+Note that the list in `gnutls-verify-error', matched against the
+HOSTNAME, is the default VERIFY-ERROR.
VERIFY-FLAGS is a numeric OR of verification flags only for
`gnutls-x509pki' connections. See GnuTLS' x509.h for details;
@@ -168,6 +189,9 @@ here's a recent version of the list.
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let* ((type (or type 'gnutls-x509pki))
+ ;; The gnutls library doesn't understand files delivered via
+ ;; the special handlers, so ignore all files found via those.
+ (file-name-handler-alist nil)
(trustfiles (or trustfiles
(delq nil
(mapcar (lambda (f) (and f (file-exists-p f) f))
@@ -182,8 +206,30 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(if gnutls-algorithm-priority
(upcase gnutls-algorithm-priority)
"NORMAL")))))
+ (verify-error (or verify-error
+ ;; this uses the value of `gnutls-verify-error'
+ (cond
+ ;; if t, pass it on
+ ((eq gnutls-verify-error t)
+ t)
+ ;; if a list, look for hostname matches
+ ((listp gnutls-verify-error)
+ (apply 'append
+ (mapcar
+ (lambda (check)
+ (when (string-match (nth 0 check)
+ hostname)
+ (nth 1 check)))
+ gnutls-verify-error)))
+ ;; else it's nil
+ (t nil))))
(min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
- (params `(:priority ,priority-string
+ params ret)
+
+ (when verify-hostname-error
+ (push :hostname verify-error))
+
+ (setq params `(:priority ,priority-string
:hostname ,hostname
:loglevel ,gnutls-log-level
:min-prime-bits ,min-prime-bits
@@ -192,9 +238,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:keylist ,keylist
:verify-flags ,verify-flags
:verify-error ,verify-error
- :verify-hostname-error ,verify-hostname-error
:callbacks nil))
- ret)
(gnutls-message-maybe
(setq ret (gnutls-boot process type params))
@@ -215,7 +259,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(message "%s: (err=[%s] %s) %s"
"gnutls.el"
doit (gnutls-error-string doit)
- (apply 'format format (or params '(nil))))))
+ (apply #'format-message format (or params '(nil))))))
(provide 'gnutls)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 59e4da16619..51d8ed11b0b 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -1,9 +1,9 @@
;;; goto-addr.el --- click to browse URL or to send to e-mail address
-;; Copyright (C) 1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Eric Ding <ericding@alum.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 15 Aug 1995
;; Keywords: mh-e, www, mouse, mail
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index bf80ce153c9..2855fa4d57e 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -1,6 +1,6 @@
;;; hmac-def.el --- A macro for defining HMAC functions.
-;; Copyright (C) 1999, 2001, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2015 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 3aaa1a8ab31..26f448fee6a 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,6 +1,6 @@
;;; hmac-md5.el --- Compute HMAC-MD5.
-;; Copyright (C) 1999, 2001, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2007-2015 Free Software Foundation, Inc.
;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
;; Keywords: HMAC, RFC2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 9584ceb24d0..b559ff65908 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1,6 +1,6 @@
;;; imap.el --- imap library
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
@@ -139,7 +139,7 @@
(eval-when-compile (require 'cl))
(eval-and-compile
;; For Emacs <22.2 and XEmacs.
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
(autoload 'sasl-find-mechanism "sasl")
@@ -661,7 +661,7 @@ sure of changing the value of `foo'."
nil)))))
done))
-(defun imap-ssl-p (buffer)
+(defun imap-ssl-p (_buffer)
nil)
(defun imap-ssl-open (name buffer server port)
@@ -711,7 +711,7 @@ sure of changing the value of `foo'."
(message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
-(defun imap-tls-p (buffer)
+(defun imap-tls-p (_buffer)
nil)
(defun imap-tls-open (name buffer server port)
@@ -738,7 +738,7 @@ sure of changing the value of `foo'."
(when (memq (process-status process) '(open run))
process))))
-(defun imap-network-p (buffer)
+(defun imap-network-p (_buffer)
t)
(defun imap-network-open (name buffer server port)
@@ -757,7 +757,7 @@ sure of changing the value of `foo'."
(when (memq (process-status process) '(open run))
process))))
-(defun imap-shell-p (buffer)
+(defun imap-shell-p (_buffer)
nil)
(defun imap-shell-open (name buffer server port)
@@ -850,15 +850,16 @@ t if it successfully authenticates, nil otherwise."
(while (or (not user) (not passwd))
(setq user (or imap-username
(read-from-minibuffer
- (concat "imap: username for " imap-server
- " (using stream `" (symbol-name imap-stream)
- "'): ")
+ (format-message
+ "imap: username for %s (using stream `%s'): "
+ imap-server imap-stream)
(or user imap-default-user))))
- (setq passwd (or imap-password
- (read-passwd
- (concat "imap: password for " user "@"
- imap-server " (using authenticator `"
- (symbol-name imap-auth) "'): "))))
+ (setq passwd
+ (or imap-password
+ (read-passwd
+ (format-message
+ "imap: password for %s@%s (using authenticator `%s'): "
+ user imap-server imap-auth))))
(when (and user passwd)
(if (funcall loginfunc user passwd)
(progn
@@ -881,10 +882,10 @@ t if it successfully authenticates, nil otherwise."
;; passwd nil))))
ret)))
-(defun imap-gssapi-auth-p (buffer)
+(defun imap-gssapi-auth-p (_buffer)
(eq imap-stream 'gssapi))
-(defun imap-gssapi-auth (buffer)
+(defun imap-gssapi-auth (_buffer)
(message "imap: Authenticating using GSSAPI...%s"
(if (eq imap-stream 'gssapi) "done" "failed"))
(eq imap-stream 'gssapi))
@@ -893,7 +894,7 @@ t if it successfully authenticates, nil otherwise."
(and (imap-capability 'AUTH=KERBEROS_V4 buffer)
(eq imap-stream 'kerberos4)))
-(defun imap-kerberos4-auth (buffer)
+(defun imap-kerberos4-auth (_buffer)
(message "imap: Authenticating using Kerberos 4...%s"
(if (eq imap-stream 'kerberos4) "done" "failed"))
(eq imap-stream 'kerberos4))
@@ -947,7 +948,7 @@ t if it successfully authenticates, nil otherwise."
(imap-quote-specials passwd)
"\""))))))
-(defun imap-anonymous-p (buffer)
+(defun imap-anonymous-p (_buffer)
t)
(defun imap-anonymous-auth (buffer)
@@ -1838,7 +1839,7 @@ See `imap-enable-exchange-bug-workaround'."
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
+ (lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@@ -1884,7 +1885,7 @@ first element. The rest of list contains the saved articles' UIDs."
(and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
+ (lambda (uid _prop) uid) 'UID))))
(if old-mailbox
(imap-mailbox-select old-mailbox (eq state 'examine))
(imap-mailbox-unselect)))))))
@@ -1893,7 +1894,7 @@ first element. The rest of list contains the saved articles' UIDs."
(with-current-buffer (or buffer (current-buffer))
(imap-message-appenduid-1 (imap-utf7-encode mailbox))))
-(defun imap-message-append (mailbox article &optional flags date-time buffer)
+(defun imap-message-append (mailbox article &optional _flags _date-time buffer)
"Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
FLAGS and DATE-TIME is currently not used. Return a cons holding
uidvalidity of MAILBOX and UID the newly created article got, or nil
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 724904280ef..1c604e330b2 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,9 +1,9 @@
;;; ldap.el --- client interface to LDAP for Emacs
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: April 1998
;; Keywords: comm
@@ -34,6 +34,7 @@
;;; Code:
(require 'custom)
+(require 'password-cache)
(autoload 'auth-source-search "auth-source")
@@ -47,15 +48,13 @@
A TCP port number can be appended to that name using a colon as
a separator."
:type '(choice (string :tag "Host name")
- (const :tag "Use library default" nil))
- :group 'ldap)
+ (const :tag "Use library default" nil)))
(defcustom ldap-default-port nil
"Default TCP port for LDAP connections.
Initialized from the LDAP library at build time. Default value is 389."
:type '(choice (const :tag "Use library default" nil)
- (integer :tag "Port number"))
- :group 'ldap)
+ (integer :tag "Port number")))
(defcustom ldap-default-base nil
"Default base for LDAP searches.
@@ -63,8 +62,7 @@ This is a string using the syntax of RFC 1779.
For instance, \"o=ACME, c=US\" limits the search to the
Acme organization in the United States."
:type '(choice (const :tag "Use library default" nil)
- (string :tag "Search base"))
- :group 'ldap)
+ (string :tag "Search base")))
(defcustom ldap-host-parameters-alist nil
@@ -144,35 +142,35 @@ Valid properties include:
:tag "Size Limit"
:inline t
(const :tag "Size Limit" sizelimit)
- (integer :tag "(number of records)")))))
- :group 'ldap)
+ (integer :tag "(number of records)"))))))
(defcustom ldap-ldapsearch-prog "ldapsearch"
"The name of the ldapsearch command line program."
- :type '(string :tag "`ldapsearch' Program")
- :group 'ldap)
+ :type '(string :tag "`ldapsearch' Program"))
(defcustom ldap-ldapsearch-args '("-LL" "-tt")
"A list of additional arguments to pass to `ldapsearch'."
:type '(repeat :tag "`ldapsearch' Arguments"
- (string :tag "Argument"))
- :group 'ldap)
+ (string :tag "Argument")))
+
+(defcustom ldap-ldapsearch-password-prompt-regexp "Enter LDAP Password: "
+ "A regular expression used to recognize the `ldapsearch'
+program's password prompt."
+ :type 'regexp
+ :version "25.1")
(defcustom ldap-ignore-attribute-codings nil
"If non-nil, do not encode/decode LDAP attribute values."
- :type 'boolean
- :group 'ldap)
+ :type 'boolean)
(defcustom ldap-default-attribute-decoder nil
"Decoder function to use for attributes whose syntax is unknown."
- :type 'symbol
- :group 'ldap)
+ :type 'symbol)
(defcustom ldap-coding-system 'utf-8
"Coding system of LDAP string values.
LDAP v3 specifies the coding system of strings to be UTF-8."
- :type 'symbol
- :group 'ldap)
+ :type 'symbol)
(defvar ldap-attribute-syntax-encoders
[nil ; 1 ACI Item N
@@ -378,9 +376,19 @@ RFC2252 section 4.3.2")
(houseidentifier . 15)
(supportedalgorithms . 49)
(deltarevocationlist . 9)
- (dmdname . 15))
+ (dmdname . 15)
+ (carlicense . 15)
+ (departmentnumber . 15)
+ (displayname . 15)
+ (employeenumber . 15)
+ (employeetype . 15)
+ (jpegphoto . 28)
+ (preferredlanguage . 15)
+ (usersmimecertificate . 5)
+ (userpkcs12 . 5))
"A map of LDAP attribute names to their type object id minor number.
-This table is built from RFC2252 Section 5 and RFC2256 Section 5")
+This table is built from RFC2252 Section 5, RFC2256 Section 5 and
+RFC2798 Section 9.1.1")
;; Coding/decoding functions
@@ -476,6 +484,47 @@ Additional search parameters can be specified through
(mapcar 'ldap-decode-attribute record))
result))))
+(defun ldap-password-read (host)
+ "Read LDAP password for HOST.
+If the password is cached, it is read from the cache, otherwise the user
+is prompted for the password. If `password-cache' is non-nil the password
+is verified and cached. The `password-cache-expiry' variable
+controls for how long the password is cached.
+
+This function can be specified for the `passwd' property in
+`ldap-host-parameters-alist' when interactive password prompting
+is desired for HOST."
+ ;; Add ldap: namespace to allow empty string for default host.
+ (let* ((host-key (concat "ldap:" host))
+ (password (password-read
+ (format "Enter LDAP Password%s: "
+ (if (equal host "")
+ ""
+ (format " for %s" host)))
+ host-key)))
+ (when (and password-cache
+ (not (password-in-cache-p host-key))
+ ;; Confirm the password is valid before adding it to
+ ;; the password cache. ldap-search-internal will throw
+ ;; an error if the password is invalid.
+ (not (ldap-search-internal
+ `(host ,host
+ ;; Specify an arbitrary filter that should
+ ;; produce no results, since only
+ ;; authentication success is of interest.
+ filter "emacs-test-password="
+ attributes nil
+ attrsonly nil
+ withdn nil
+ ;; Preempt passwd ldap-password-read
+ ;; setting in ldap-host-parameters-alist.
+ passwd ,password
+ ,@(cdr
+ (assoc
+ host
+ ldap-host-parameters-alist))))))
+ (password-cache-add host-key password))
+ password))
(defun ldap-search-internal (search-plist)
"Perform a search on a LDAP server.
@@ -507,8 +556,8 @@ not their associated values.
`auth' is one of the symbols `simple', `krbv41' or `krbv42'.
`base' is the base for the search as described in RFC 1779.
`scope' is one of the three symbols `sub', `base' or `one'.
- `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
- `auth' is one of the symbols `simple', `krbv41' or `krbv42'
+ `binddn' is the distinguished name of the user to bind as (in
+RFC 1779 syntax).
`passwd' is the password to use for simple authentication.
`deref' is one of the symbols `never', `always', `search' or `find'.
`timelimit' is the timeout limit for the connection in seconds.
@@ -531,7 +580,11 @@ an alist of attribute/value pairs."
(passwd (or (plist-get search-plist 'passwd)
(plist-get asfound :secret)))
;; convert the password from a function call if needed
- (passwd (if (functionp passwd) (funcall passwd) passwd))
+ (passwd (if (functionp passwd)
+ (if (eq passwd 'ldap-password-read)
+ (funcall passwd host)
+ (funcall passwd))
+ passwd))
;; get the binddn from the search-list or from the
;; auth-source user or binddn tokens
(binddn (or (plist-get search-plist 'binddn)
@@ -550,7 +603,7 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result)
+ arglist dn name value record result proc)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
@@ -559,7 +612,13 @@ an alist of attribute/value pairs."
(erase-buffer)
(if (and host
(not (equal "" host)))
- (setq arglist (nconc arglist (list (format "-h%s" host)))))
+ (setq arglist (nconc arglist
+ (list (format
+ ;; Use -H if host is a new-style LDAP URI.
+ (if (string-match "^[a-zA-Z]+://" host)
+ "-H%s"
+ "-h%s")
+ host)))))
(if (and attrsonly
(not (equal "" attrsonly)))
(setq arglist (nconc arglist (list "-A"))))
@@ -575,9 +634,9 @@ an alist of attribute/value pairs."
(if (and auth
(equal 'simple auth))
(setq arglist (nconc arglist (list "-x"))))
- (if (and passwd
- (not (equal "" passwd)))
- (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
+ ;; Allow passwd to be set to "", representing a blank password.
+ (if passwd
+ (setq arglist (nconc arglist (list "-W"))))
(if (and deref
(not (equal "" deref)))
(setq arglist (nconc arglist (list (format "-a%s" deref)))))
@@ -587,14 +646,43 @@ an alist of attribute/value pairs."
(if (and sizelimit
(not (equal "" sizelimit)))
(setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
- (apply #'call-process ldap-ldapsearch-prog
- ;; Ignore stderr, which can corrupt results
- nil (list buf nil) nil
- (append arglist ldap-ldapsearch-args filter))
+ (if passwd
+ (let* ((process-connection-type nil)
+ (proc-args (append arglist ldap-ldapsearch-args
+ filter))
+ (proc (apply #'start-process "ldapsearch" buf
+ ldap-ldapsearch-prog
+ proc-args)))
+ (while (null (progn
+ (goto-char (point-min))
+ (re-search-forward
+ ldap-ldapsearch-password-prompt-regexp
+ (point-max) t)))
+ (accept-process-output proc 1))
+ (process-send-string proc passwd)
+ (process-send-string proc "\n")
+ (while (not (memq (process-status proc) '(exit signal)))
+ (sit-for 0.1))
+ (let ((status (process-exit-status proc)))
+ (when (not (eq status 0))
+ ;; Handle invalid credentials exit status specially
+ ;; for ldap-password-read.
+ (if (eq status 49)
+ (error (concat "Incorrect LDAP password or"
+ " bind distinguished name (binddn)"))
+ (error "Failed ldapsearch invocation: %s \"%s\""
+ ldap-ldapsearch-prog
+ (mapconcat 'identity proc-args "\" \""))))))
+ (apply #'call-process ldap-ldapsearch-prog
+ ;; Ignore stderr, which can corrupt results
+ nil (list buf nil) nil
+ (append arglist ldap-ldapsearch-args filter)))
(insert "\n")
(goto-char (point-min))
- (while (re-search-forward "[\t\n\f]+ " nil t)
+ (while (re-search-forward (concat "[\t\n\f]+ \\|"
+ ldap-ldapsearch-password-prompt-regexp)
+ nil t)
(replace-match "" nil nil))
(goto-char (point-min))
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index e6a5f8299ac..a73b4dfa921 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -1,6 +1,6 @@
;;; mairix.el --- Mairix interface for Emacs
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: David Engster <dengste@eml.cc>
;; Keywords: mail searching
@@ -116,7 +116,7 @@ You can add further options here if you want to, but better use
(defcustom mairix-update-options '("-F" "-Q")
"Options when calling mairix for updating the database.
-The default is '-F' and '-Q' for making updates faster. You
+The default is \"-F\" and \"-Q\" for making updates faster. You
should call mairix without these options from time to
time (e.g. via cron job)."
:type '(repeat string)
@@ -124,7 +124,7 @@ time (e.g. via cron job)."
(defcustom mairix-search-options '("-Q")
"Options when calling mairix for searching.
-The default is '-Q' for making searching faster."
+The default is \"-Q\" for making searching faster."
:type '(repeat string)
:group 'mairix)
@@ -265,18 +265,22 @@ Currently there are 'threads and 'flags.")
(mail-fetch-field field)))))
;;; Gnus
-(eval-when-compile
- (defvar gnus-article-buffer)
- (autoload 'gnus-summary-toggle-header "gnus-sum")
- (autoload 'gnus-buffer-exists-p "gnus-util")
- (autoload 'message-field-value "message")
- (autoload 'gnus-group-read-ephemeral-group "gnus-group")
- (autoload 'gnus-alive-p "gnus-util"))
+
+;; For gnus-buffer-exists-p, although it seems that could be replaced by:
+;; (and buffer (get-buffer buffer))
+(eval-when-compile (require 'gnus-util))
+(defvar gnus-article-buffer)
+(declare-function gnus-group-read-ephemeral-group "gnus-group"
+ (group method &optional activate quit-config
+ request-only select-articles parameters number))
+(declare-function gnus-summary-toggle-header "gnus-sum" (&optional arg))
+(declare-function message-field-value "message" (header &optional not-all))
;; Display function:
(defun mairix-gnus-ephemeral-nndoc (folder)
"Create ephemeral nndoc group for reading mbox file FOLDER in Gnus."
- (unless (gnus-alive-p)
+ (unless (and (fboundp 'gnus-alive-p)
+ (gnus-alive-p))
(error "Gnus is not running"))
(gnus-group-read-ephemeral-group
;; add randomness to group string to prevent Gnus from using a
@@ -289,26 +293,29 @@ Currently there are 'threads and 'flags.")
;; Fetching mail header field:
(defun mairix-gnus-fetch-field (field)
"Get mail header FIELD for current message using Gnus."
- (unless (gnus-alive-p)
+ (unless (and (fboundp 'gnus-alive-p)
+ (gnus-alive-p))
(error "Gnus is not running"))
(unless (gnus-buffer-exists-p gnus-article-buffer)
(error "No article buffer available"))
(with-current-buffer gnus-article-buffer
+ ;; gnus-art requires gnus-sum and message.
(gnus-summary-toggle-header 1)
(message-field-value field)))
;;; VM
;;; written by Ulrich Mueller
-(eval-when-compile
- (autoload 'vm-quit "vm-folder")
- (autoload 'vm-visit-folder "vm")
- (autoload 'vm-select-folder-buffer "vm-macro")
- (autoload 'vm-check-for-killed-summary "vm-misc")
- (autoload 'vm-get-header-contents "vm-summary")
- (autoload 'vm-check-for-killed-summary "vm-misc")
- (autoload 'vm-error-if-folder-empty "vm-misc")
- (autoload 'vm-select-marked-or-prefixed-messages "vm-folder"))
+(declare-function vm-quit "ext:vm-folder" (&optional no-change))
+(declare-function vm-visit-folder "ext:vm-startup"
+ (folder &optional read-only))
+(declare-function vm-select-folder-buffer "ext:vm-macro" ()) ; defsubst
+(declare-function vm-check-for-killed-summary "ext:vm-misc" ())
+(declare-function vm-error-if-folder-empty "ext:vm-misc" ())
+(declare-function vm-get-header-contents "ext:vm-summary"
+ (message header-name-regexp &optional clump-sep))
+(declare-function vm-select-marked-or-prefixed-messages "ext:vm-folder"
+ (prefix))
;; Display function
(defun mairix-vm-display (folder)
@@ -391,7 +398,7 @@ Overwrite existing entry? ")
(concat "\n\n" (make-string 65 ?=)
"\nYou can now customize your saved Mairix searches by modifying\n\
the variable mairix-saved-searches. Don't forget to save your\nchanges \
-in your .emacs by pressing 'Save for Future Sessions'.\n"
+in your .emacs by pressing `Save for Future Sessions'.\n"
(make-string 65 ?=) "\n")))
(autoload 'mail-strip-quoted-names "mail-utils")
@@ -660,7 +667,8 @@ Fill in VALUES if based on an article."
" up to N errors(missing/extra/different letters)\n"
" ^substring= to match the substring at the beginning of a word.\n"))
(widget-insert
- "Whitespace will be converted to ',' (i.e. AND). Use '/' for OR.\n\n")
+ (format-message
+ "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n"))
(setq mairix-widgets (mairix-widget-build-editable-fields values))
(when (member 'flags mairix-widget-other)
(widget-insert "\nFlags:\n Seen: ")
@@ -755,33 +763,26 @@ VALUES may contain values for editable fields from current article."
(define-key map [(d)] 'mairix-select-delete)
(define-key map [(s)] 'mairix-select-save)
map)
- "'mairix-searches-mode' keymap.")
-
-(defvar mairix-searches-mode-font-lock-keywords)
-
-(defun mairix-searches-mode ()
+ "`mairix-searches-mode' keymap.")
+
+(defvar mairix-searches-mode-font-lock-keywords
+ '(("^\\([0-9]+\\)"
+ (1 font-lock-constant-face))
+ ("^[0-9 ]+\\(Name:\\) \\(.*\\)"
+ (1 font-lock-keyword-face) (2 font-lock-string-face))
+ ("^[ ]+\\(Query:\\) \\(.*\\) , "
+ (1 font-lock-keyword-face) (2 font-lock-string-face))
+ (", \\(Threads:\\) \\(.*\\)"
+ (1 font-lock-keyword-face) (2 font-lock-constant-face))
+ ("^\\([A-Z].*\\)$"
+ (1 font-lock-comment-face))
+ ("^[ ]+\\(Folder:\\) \\(.*\\)"
+ (1 font-lock-keyword-face) (2 font-lock-string-face))))
+
+(define-derived-mode mairix-searches-mode fundamental-mode "mairix-searches"
"Major mode for editing mairix searches."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'mairix-searches-mode)
- (setq mode-name "mairix-searches")
- (set-syntax-table text-mode-syntax-table)
- (use-local-map mairix-searches-mode-map)
- (make-local-variable 'font-lock-defaults)
- (setq mairix-searches-mode-font-lock-keywords
- (list (list "^\\([0-9]+\\)"
- '(1 font-lock-constant-face))
- (list "^[0-9 ]+\\(Name:\\) \\(.*\\)"
- '(1 font-lock-keyword-face) '(2 font-lock-string-face))
- (list "^[ ]+\\(Query:\\) \\(.*\\) , "
- '(1 font-lock-keyword-face) '(2 font-lock-string-face))
- (list ", \\(Threads:\\) \\(.*\\)"
- '(1 font-lock-keyword-face) '(2 font-lock-constant-face))
- (list "^\\([A-Z].*\\)$"
- '(1 font-lock-comment-face))
- (list "^[ ]+\\(Folder:\\) \\(.*\\)"
- '(1 font-lock-keyword-face) '(2 font-lock-string-face))))
- (setq font-lock-defaults '(mairix-searches-mode-font-lock-keywords)))
+ :syntax-table text-mode-syntax-table
+ (setq-local font-lock-defaults '(mairix-searches-mode-font-lock-keywords)))
(defun mairix-build-search-list ()
"Display saved searches in current buffer."
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 810d8963ce2..c6d40b62415 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -1,6 +1,6 @@
;;; net-utils.el --- network functions
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Sun Mar 16 1997
@@ -204,7 +204,7 @@ This variable is only used if the variable
:group 'net-utils
:type '(repeat string))
-(defcustom smbclient-prompt-regexp "^smb: \>"
+(defcustom smbclient-prompt-regexp "^smb: >"
"Regexp which matches the smbclient program's prompt.
This variable is only used if the variable
@@ -326,9 +326,19 @@ This variable is only used if the variable
(insert filtered-string)
(set-marker (process-mark process) (point))))))
+(declare-function w32-get-console-output-codepage "w32proc.c" ())
+
(defun net-utils-run-program (name header program args)
"Run a network information program."
- (let ((buf (get-buffer-create (concat "*" name "*"))))
+ (let ((buf (get-buffer-create (concat "*" name "*")))
+ (coding-system-for-read
+ ;; MS-Windows versions of network utilities output text
+ ;; encoded in the console (a.k.a. "OEM") codepage, which is
+ ;; different from the default system (a.k.a. "ANSI")
+ ;; codepage.
+ (if (eq system-type 'windows-nt)
+ (intern (format "cp%d" (w32-get-console-output-codepage)))
+ coding-system-for-read)))
(set-buffer buf)
(erase-buffer)
(insert header "\n")
@@ -352,7 +362,15 @@ This variable is only used if the variable
(when proc
(set-process-filter proc nil)
(delete-process proc)))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (coding-system-for-read
+ ;; MS-Windows versions of network utilities output text
+ ;; encoded in the console (a.k.a. "OEM") codepage, which is
+ ;; different from the default system (a.k.a. "ANSI")
+ ;; codepage.
+ (if (eq system-type 'windows-nt)
+ (intern (format "cp%d" (w32-get-console-output-codepage)))
+ coding-system-for-read)))
(erase-buffer))
(net-utils-mode)
(setq-local net-utils--revert-cmd
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index b08c052eb71..61da85c7c1c 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -1,5 +1,5 @@
;;; netrc.el --- .netrc parsing functionality
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index ab7d02cc802..1eb5342009c 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -1,6 +1,6 @@
;;; network-stream.el --- open network processes, possibly with encryption
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
@@ -45,6 +45,7 @@
(require 'tls)
(require 'starttls)
(require 'auth-source)
+(require 'nsm)
(autoload 'gnutls-negotiate "gnutls")
(autoload 'open-gnutls-stream "gnutls")
@@ -120,7 +121,7 @@ values:
:client-certificate should either be a list where the first
element is the certificate key file name, and the second
- element is the certificate file name itself, or `t', which
+ element is the certificate file name itself, or t, which
means that `auth-source' will be queried for the key and the
certificate. This parameter will only be used when doing TLS
or STARTTLS connections.
@@ -128,11 +129,14 @@ values:
:use-starttls-if-possible is a boolean that says to do opportunistic
STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality.
+:warn-unless-encrypted is a boolean which, if :return-list is
+non-nil, is used warn the user if the connection isn't encrypted.
+
:nogreeting is a boolean that can be used to inhibit waiting for
a greeting from the server.
:nowait is a boolean that says the connection should be made
- asynchronously, if possible."
+asynchronously, if possible."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
@@ -196,6 +200,8 @@ a greeting from the server.
(stream (make-network-process :name name :buffer buffer
:host host :service service
:nowait (plist-get parameters :nowait))))
+ (when (plist-get parameters :warn-unless-encrypted)
+ (setq stream (nsm-verify-connection stream host service nil t)))
(list stream
(network-stream-get-response stream start
(plist-get parameters :end-of-command))
@@ -219,8 +225,6 @@ a greeting from the server.
(capabilities (network-stream-command stream capability-command
eo-capa))
(resulting-type 'plain)
- (builtin-starttls (and (fboundp 'gnutls-available-p)
- (gnutls-available-p)))
starttls-available starttls-command error)
;; First check whether the server supports STARTTLS at all.
@@ -231,18 +235,19 @@ a greeting from the server.
;; connection.
(when (and starttls-command
(setq starttls-available
- (or builtin-starttls
+ (or (gnutls-available-p)
(and (or require-tls
(plist-get parameters :use-starttls-if-possible))
(starttls-available-p))))
(not (eq (plist-get parameters :type) 'plain)))
;; If using external STARTTLS, drop this connection and start
;; anew with `starttls-open-stream'.
- (unless builtin-starttls
+ (unless (gnutls-available-p)
(delete-process stream)
(setq start (with-current-buffer buffer (point-max)))
(let* ((starttls-extra-arguments
- (if require-tls
+ (if (or require-tls
+ (member "--insecure" starttls-extra-arguments))
starttls-extra-arguments
;; For opportunistic TLS upgrades, we don't really
;; care about the identity of the peer.
@@ -270,7 +275,7 @@ a greeting from the server.
(network-stream-command stream starttls-command eoc)))
(and response (string-match success-string response)))
;; The server said it was OK to begin STARTTLS negotiations.
- (if builtin-starttls
+ (if (gnutls-available-p)
(let ((cert (network-stream-certificate host service parameters)))
(condition-case nil
(gnutls-negotiate :process stream :hostname host
@@ -318,6 +323,12 @@ a greeting from the server.
"' program was found"))))
(delete-process stream)
(setq stream nil))
+ ;; Check certificate validity etc.
+ (when (gnutls-available-p)
+ (setq stream (nsm-verify-connection
+ stream host service
+ (eq resulting-type 'tls)
+ (plist-get parameters :warn-unless-encrypted))))
;; Return value:
(list stream greeting capabilities resulting-type error)))
@@ -343,29 +354,32 @@ a greeting from the server.
(defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
(let* ((start (point-max))
- (use-builtin-gnutls (and (fboundp 'gnutls-available-p)
- (gnutls-available-p)))
(stream
- (funcall (if use-builtin-gnutls
+ (funcall (if (gnutls-available-p)
'open-gnutls-stream
'open-tls-stream)
name buffer host service))
(eoc (plist-get parameters :end-of-command)))
+ ;; Check certificate validity etc.
+ (when (and (gnutls-available-p) stream)
+ (setq stream (nsm-verify-connection stream host service)))
(if (null stream)
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (when (and (null use-builtin-gnutls)
+ (when (and (not (gnutls-available-p))
eoc)
(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 eoc)
+ (network-stream-command stream capability-command eo-capa)
'tls))))))
(defun network-stream-open-shell (name buffer host service parameters)
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f017345e8cb..072fd015b60 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1,12 +1,11 @@
;;; newst-backend.el --- Retrieval backend for newsticker.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-backend.el
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
-;; Time-stamp: "13. Mai 2011, 20:47:05 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -37,6 +36,7 @@
(require 'derived)
(require 'xml)
+(require 'url-parse)
;; Silence warnings
(defvar w3-mode-map)
@@ -47,9 +47,6 @@
"List of timers for news retrieval.
This is an alist, each element consisting of (feed-name . timer).")
-(defvar newsticker--download-logos nil
- "If non-nil download feed logos if available.")
-
(defvar newsticker--sentinel-callback nil
"Function called at end of `newsticker--sentinel'.")
@@ -196,7 +193,7 @@ RSS or Atom file. The file is retrieved by calling wget, or whatever you
specify as `newsticker-wget-name'.
URL may also be a function which returns news data. In this case
-`newsticker-retrieval-method' etc. are ignored for this feed.
+`newsticker-retrieval-method' etc. are ignored for this feed.
The START-TIME can be either a string, or nil. If it is a string it
specifies a fixed time at which this feed shall be retrieved for the
@@ -238,7 +235,7 @@ which apply for this feed only, overriding the value of
'intern
"Method for retrieving news from the web, either `intern' or `extern'.
Default value `intern' uses Emacs' built-in asynchronous download
-capabilities ('url-retrieve'). If set to `extern' the external
+capabilities (`url-retrieve'). If set to `extern' the external
program wget is used, see `newsticker-wget-name'."
:type '(choice :tag "Method"
(const :tag "Intern" intern)
@@ -335,9 +332,9 @@ deleted at the next retrieval."
This is an alist of the form (FEED-NAME PATTERN-LIST). I.e. each
element consists of a FEED-NAME a PATTERN-LIST. Each element of
the pattern-list has the form (AGE TITLE-OR-DESCRIPTION REGEXP).
-AGE must be one of the symbols 'old or 'immortal.
-TITLE-OR-DESCRIPTION must be on of the symbols 'title,
-'description, or 'all. REGEXP is a regular expression, i.e. a
+AGE must be one of the symbols `old' or `immortal'.
+TITLE-OR-DESCRIPTION must be one of the symbols `title',
+`description', or `all'. REGEXP is a regular expression, i.e., a
string.
This filter is checked after a new headline has been retrieved.
@@ -346,8 +343,8 @@ pattern-list is checked: The new headline will be marked as AGE
if REGEXP matches the headline's TITLE-OR-DESCRIPTION.
If, for example, `newsticker-auto-mark-filter-list' looks like
- \((slashdot ('old 'title \"^Forget me!$\") ('immortal 'title \"Read me\")
- \('immortal 'all \"important\"))))
+ ((slashdot (\\='old \\='title \"^Forget me!$\") (\\='immortal \\='title \"Read me\")
+ (\\='immortal \\='all \"important\"))))
then all articles from slashdot are marked as old if they have
the title \"Forget me!\". All articles with a title containing
@@ -483,14 +480,6 @@ that can be added."
;; ======================================================================
;;; Internal variables
;; ======================================================================
-(defvar newsticker--item-list nil
- "List of newsticker items.")
-(defvar newsticker--item-position 0
- "Actual position in list of newsticker items.")
-(defvar newsticker--prev-message "There was no previous message yet!"
- "Last message that the newsticker displayed.")
-(defvar newsticker--scrollable-text ""
- "The text which is scrolled smoothly in the echo area.")
(defvar newsticker--buffer-uptodate-p nil
"Tells whether the newsticker buffer is up to date.")
(defvar newsticker--latest-update-time (current-time)
@@ -573,7 +562,7 @@ If non-nil only the current headline is visible.")
"Return guid of ITEM."
(newsticker--guid-to-string (assoc 'guid (newsticker--extra item))))
(defsubst newsticker--enclosure (item)
- "Return enclosure element of ITEM in the form \(...FIXME...\) or nil."
+ "Return enclosure element of ITEM in the form (...FIXME...) or nil."
(let ((enclosure (assoc 'enclosure (newsticker--extra item))))
(if enclosure
(xml-node-attributes enclosure))))
@@ -756,10 +745,14 @@ from."
(insert result)
;; remove MIME header
(goto-char (point-min))
- (search-forward "\n\n")
+ (search-forward "\n\n" nil t)
(delete-region (point-min) (point))
;; read the rss/atom contents
- (newsticker--sentinel-work nil t feed-name "url-retrieve" (current-buffer))
+ (newsticker--sentinel-work nil
+ (or (not status)
+ (not (eq (car status) :error)))
+ feed-name "url-retrieve"
+ (current-buffer))
(when status
(let ((status-type (car status))
(status-details (cdr status)))
@@ -768,7 +761,7 @@ from."
)
((eq status-type :error)
(message "%s: Error while retrieving news from %s: %s: \"%s\""
- (format-time-string "%A, %H:%M" (current-time))
+ (format-time-string "%A, %H:%M")
feed-name
(car status-details) (cdr status-details))))))))
@@ -788,6 +781,7 @@ See `newsticker-get-news'."
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
(set-process-sentinel proc 'newsticker--sentinel)
+ (process-put proc 'nt-feed-name feed-name)
(setq newsticker--process-ids (cons (process-id proc)
newsticker--process-ids))
(force-mode-line-update)))))
@@ -797,7 +791,7 @@ See `newsticker-get-news'."
FEED-NAME must be a string which occurs as the label (i.e. the first element)
in an element of `newsticker-url-list' or `newsticker-url-list-defaults'."
(newsticker--debug-msg "%s: Getting news for %s"
- (format-time-string "%A, %H:%M" (current-time))
+ (format-time-string "%A, %H:%M")
feed-name)
(let* ((item (or (assoc feed-name newsticker-url-list)
(assoc feed-name newsticker-url-list-defaults)
@@ -823,25 +817,26 @@ Argument PROCESS is the process which has just changed its state.
Argument EVENT tells what has happened to the process."
(let ((p-status (process-status process))
(exit-status (process-exit-status process))
- (name (process-name process))
+ (feed-name (process-get process 'nt-feed-name))
(command (process-command process))
(buffer (process-buffer process)))
(newsticker--sentinel-work event
(and (eq p-status 'exit)
(= exit-status 0))
- name command buffer)))
+ feed-name command buffer)))
-(defun newsticker--sentinel-work (event status-ok name command buffer)
+(defun newsticker--sentinel-work (event status-ok feed-name command buffer)
"Actually do the sentinel work.
Argument EVENT tells what has happened to the retrieval process.
Argument STATUS-OK is the final status of the retrieval process,
non-nil meaning retrieval was successful.
-Argument NAME is the name of the retrieval process.
+Argument FEED-NAME is the name of the retrieved feed.
Argument COMMAND is the command of the retrieval process.
Argument BUFFER is the buffer of the retrieval process."
(let ((time (current-time))
- (name-symbol (intern name))
- (something-was-added nil))
+ (name-symbol (intern feed-name))
+ (something-was-added nil)
+ (ct (current-time)))
;; catch known errors (zombie processes, rubbish-xml etc.
;; if an error occurs the news feed is not updated!
(catch 'oops
@@ -851,77 +846,30 @@ Argument BUFFER is the buffer of the retrieval process."
newsticker--cache
name-symbol
newsticker--error-headline
- (format
+ (format-message
(concat "%s: Newsticker could not retrieve news from %s.\n"
"Return status: `%s'\n"
"Command was `%s'")
- (format-time-string "%A, %H:%M" (current-time))
- name event command)
+ (format-time-string "%A, %H:%M")
+ feed-name event command)
""
- (current-time)
+ ct
'new
- 0 nil))
+ 0 '((guid nil "newsticker--download-error"))
+ ct))
(message "%s: Error while retrieving news from %s"
- (format-time-string "%A, %H:%M" (current-time))
- name)
+ (format-time-string "%A, %H:%M")
+ feed-name)
(throw 'oops nil))
(let* ((coding-system 'utf-8)
(node-list
(save-current-buffer
(set-buffer buffer)
- ;; a very very dirty workaround to overcome the
- ;; problems with the newest (20030621) xml.el:
- ;; remove all unnecessary whitespace
- (goto-char (point-min))
- (while (re-search-forward ">[ \t\r\n]+<" nil t)
- (replace-match "><" nil t))
- ;; and another brutal workaround (20031105)! For some
- ;; reason the xml parser does not like the colon in the
- ;; doctype name "rdf:RDF"
- (goto-char (point-min))
- (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
- (replace-match "<!DOCTYPE rdfColonRDF" nil t))
- ;; finally.... ~##^°!!!!!
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" nil t))
- ;; still more brutal workarounds (20040309)! The xml
- ;; parser does not like doctype rss
- (goto-char (point-min))
- (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
- (replace-match "" nil t))
- ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
- ;; Remove comments to avoid this xml-parsing bug:
- ;; "XML files can have only one toplevel tag"
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (let ((start (match-beginning 0)))
- (unless (search-forward "-->" nil t)
- (error "Can't find end of comment"))
- (delete-region start (point))))
- ;; And another one (20050702)! If description is HTML
- ;; encoded and starts with a `<', wrap the whole
- ;; description in a CDATA expression. This happened for
- ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
- (goto-char (point-min))
- (while (re-search-forward
- "<description>\\(<img.*?\\)</description>" nil t)
- (replace-match
- "<description><![CDATA[ \\1 ]]></description>"))
- ;; And another one (20051123)! XML parser does not
- ;; like this: <yweather:location city="Frankfurt/Main"
- ;; region="" country="GM" />
- ;; try to "fix" empty attributes
- ;; This happened for
- ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
- (goto-char (point-min))
- (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
- (replace-match "\\1=\" \""))
- ;;
- (set-buffer-modified-p nil)
+ (unless (fboundp 'libxml-parse-xml-region)
+ (newsticker--do-xml-workarounds))
;; check coding system
(goto-char (point-min))
- (if (re-search-forward "encoding=\"\\([^\"]+\\)\""
+ (if (re-search-forward "encoding=['\"]\\([^\"]+?\\)['\"]"
nil t)
(setq coding-system (intern (downcase (match-string 1))))
(setq coding-system
@@ -930,22 +878,25 @@ Argument BUFFER is the buffer of the retrieval process."
(coding-system-error
(message
"newsticker.el: ignoring coding system %s for %s"
- coding-system name)
+ coding-system feed-name)
nil))))
;; Decode if possible
(when coding-system
(decode-coding-region (point-min) (point-max)
coding-system))
(condition-case errordata
- ;; The xml parser might fail
- ;; or the xml might be bugged
- (xml-parse-region (point-min) (point-max))
+ ;; The xml parser might fail or the xml might be
+ ;; bugged
+ (if (fboundp 'libxml-parse-xml-region)
+ (list (libxml-parse-xml-region (point-min) (point-max)
+ nil t))
+ (xml-parse-region (point-min) (point-max)))
(error (message "Could not parse %s: %s"
(buffer-name) (cadr errordata))
(throw 'oops nil)))))
(topnode (car node-list))
- (channelnode (car (xml-get-children topnode 'channel)))
- (imageurl nil))
+ (image-url nil)
+ (icon-url nil))
;; mark all items as obsolete
(newsticker--cache-replace-age newsticker--cache
name-symbol
@@ -963,41 +914,51 @@ Argument BUFFER is the buffer of the retrieval process."
;; RSS 0.91
((and (eq 'rss (xml-node-name topnode))
(string= "0.91" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-0.91 topnode))
- (newsticker--parse-rss-0.91 name time topnode))
+ (setq image-url (newsticker--get-logo-url-rss-0.91 topnode))
+ (newsticker--parse-rss-0.91 feed-name time topnode))
;; RSS 0.92
((and (eq 'rss (xml-node-name topnode))
(string= "0.92" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-0.92 topnode))
- (newsticker--parse-rss-0.92 name time topnode))
+ (setq image-url (newsticker--get-logo-url-rss-0.92 topnode))
+ (newsticker--parse-rss-0.92 feed-name time topnode))
;; RSS 1.0
- ((eq 'rdf:RDF (xml-node-name topnode))
- (setq imageurl (newsticker--get-logo-url-rss-1.0 topnode))
- (newsticker--parse-rss-1.0 name time topnode))
+ ((or (eq 'RDF (xml-node-name topnode))
+ (eq 'rdf:RDF (xml-node-name topnode)))
+ (setq image-url (newsticker--get-logo-url-rss-1.0 topnode))
+ (newsticker--parse-rss-1.0 feed-name time topnode))
;; RSS 2.0
((and (eq 'rss (xml-node-name topnode))
(string= "2.0" (xml-get-attribute topnode 'version)))
- (setq imageurl (newsticker--get-logo-url-rss-2.0 topnode))
- (newsticker--parse-rss-2.0 name time topnode))
+ (setq image-url (newsticker--get-logo-url-rss-2.0 topnode))
+ (newsticker--parse-rss-2.0 feed-name time topnode))
;; Atom 0.3
((and (eq 'feed (xml-node-name topnode))
(string= "http://purl.org/atom/ns#"
(xml-get-attribute topnode 'xmlns)))
- (setq imageurl (newsticker--get-logo-url-atom-0.3 topnode))
- (newsticker--parse-atom-0.3 name time topnode))
+ (setq image-url (newsticker--get-logo-url-atom-0.3 topnode))
+ (newsticker--parse-atom-0.3 feed-name time topnode))
;; Atom 1.0
- ((and (eq 'feed (xml-node-name topnode))
- (string= "http://www.w3.org/2005/Atom"
- (xml-get-attribute topnode 'xmlns)))
- (setq imageurl (newsticker--get-logo-url-atom-1.0 topnode))
- (newsticker--parse-atom-1.0 name time topnode))
- ;; unknown feed type
(t
- (newsticker--debug-msg "Feed type unknown: %s: %s"
- (xml-node-name topnode) name)
- nil))
+ ;; The test for Atom 1.0 does not work when using
+ ;; libxml, as with libxml the namespace attribute is
+ ;; not in the xml tree. For the time being we skip
+ ;; the check and assume that we are dealing with an
+ ;; Atom 1.0 feed.
+
+ ;; (and (eq 'feed (xml-node-name topnode))
+ ;; (string= "http://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))
+ (newsticker--parse-atom-1.0 feed-name time topnode))
+ ;; unknown feed type
+ ;; (t
+ ;; (newsticker--debug-msg "Feed type unknown: %s: %s"
+ ;; (xml-node-name topnode) feed-name)
+ ;; nil)
+ )
(setq something-was-added t))
- (error (message "sentinelerror in %s: %s" name error-data)))
+ (error (message "sentinelerror in %s: %s" feed-name error-data)))
;; Remove those old items from cache which have been removed from
;; the feed
@@ -1038,17 +999,97 @@ Argument BUFFER is the buffer of the retrieval process."
;; kill the process buffer if wanted
(unless newsticker-debug
(kill-buffer buffer))
- ;; launch retrieval of image
- (when (and imageurl newsticker--download-logos)
- (newsticker--image-get name imageurl)))))
+ ;; launch retrieval of images
+ (when (and (boundp 'newsticker-download-logos)
+ newsticker-download-logos)
+ ;; feed logo
+ (when image-url
+ (newsticker--image-get feed-name feed-name (newsticker--images-dir)
+ image-url))
+ ;; icon / favicon
+ (setq icon-url
+ (or icon-url
+ (let* ((feed-url (newsticker--link (cadr (newsticker--cache-get-feed
+ (intern feed-name)))))
+ (uri (url-generic-parse-url feed-url)))
+ (when (and feed-url uri)
+ (setf (url-filename uri) nil)
+ (setf (url-target uri) nil)
+ (concat (url-recreate-url uri) "favicon.ico")))))
+ (when icon-url
+ (newsticker--image-get feed-name
+ (concat feed-name "."
+ (file-name-extension icon-url))
+ (newsticker--icons-dir)
+ icon-url))))))
(when newsticker--sentinel-callback
(funcall newsticker--sentinel-callback)))
+(defun newsticker--do-xml-workarounds ()
+ "Fix all issues which `xml-parse-region' could be choking on."
+
+ ;; a very very dirty workaround to overcome the
+ ;; problems with the newest (20030621) xml.el:
+ ;; remove all unnecessary whitespace
+ (goto-char (point-min))
+ (while (re-search-forward ">[ \t\r\n]+<" nil t)
+ (replace-match "><" nil t))
+ ;; and another brutal workaround (20031105)! For some
+ ;; reason the xml parser does not like the colon in the
+ ;; doctype name "rdf:RDF"
+ (goto-char (point-min))
+ (if (re-search-forward "<!DOCTYPE[ \t\n]+rdf:RDF" nil t)
+ (replace-match "<!DOCTYPE rdfColonRDF" nil t))
+ ;; finally.... ~##^°!!!!!
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n" nil t))
+ ;; still more brutal workarounds (20040309)! The xml
+ ;; parser does not like doctype rss
+ (goto-char (point-min))
+ (if (re-search-forward "<!DOCTYPE[ \t\n]+rss[ \t\n]*>" nil t)
+ (replace-match "" nil t))
+ ;; And another one (20050618)! (Fixed in GNU Emacs 22.0.50.18)
+ ;; Remove comments to avoid this xml-parsing bug:
+ ;; "XML files can have only one toplevel tag"
+ (goto-char (point-min))
+ (while (search-forward "<!--" nil t)
+ (let ((start (match-beginning 0)))
+ (unless (search-forward "-->" nil t)
+ (error "Can't find end of comment"))
+ (delete-region start (point))))
+ ;; And another one (20050702)! If description is HTML
+ ;; encoded and starts with a `<', wrap the whole
+ ;; description in a CDATA expression. This happened for
+ ;; http://www.thefreedictionary.com/_/WoD/rss.aspx?type=quote
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<description>\\(<img.*?\\)</description>" nil t)
+ (replace-match
+ "<description><![CDATA[ \\1 ]]></description>"))
+ ;; And another one (20051123)! XML parser does not
+ ;; like this: <yweather:location city="Frankfurt/Main"
+ ;; region="" country="GM" />
+ ;; try to "fix" empty attributes
+ ;; This happened for
+ ;; http://xml.weather.yahoo.com/forecastrss?p=GMXX0040&u=f
+ (goto-char (point-min))
+ (while (re-search-forward "\\(<[^>]*\\)=\"\"" nil t)
+ (replace-match "\\1=\" \""))
+ ;;
+ (set-buffer-modified-p nil))
+
+
(defun newsticker--get-logo-url-atom-1.0 (node)
"Return logo URL from atom 1.0 data in NODE."
(car (xml-node-children
(car (xml-get-children node 'logo)))))
+(defun newsticker--get-icon-url-atom-1.0 (node)
+ "Return icon URL from atom 1.0 data in NODE."
+ (car (xml-node-children
+ (car (xml-get-children node 'icon)))))
+
(defun newsticker--get-logo-url-atom-0.3 (node)
"Return logo URL from atom 0.3 data in NODE."
(car (xml-node-children
@@ -1125,6 +1166,30 @@ same as in `newsticker--parse-atom-1.0'."
(xml-node-children node))))
(or new-item new-feed)))
+(defun newsticker--unxml (node)
+ "Reverse parsing of an xml string.
+Restore an xml-string from a an xml NODE that was returned by xml-parse..."
+ (if (or (not node) (stringp node))
+ node
+ (newsticker--unxml-node node)))
+
+(defun newsticker--unxml-node (node)
+ "Actually restore xml-string of an xml NODE."
+ (let ((qname (symbol-name (car node)))
+ (att-list (cadr node))
+ (children (cddr node)))
+ (concat "<" qname
+ (when att-list " ")
+ (mapconcat 'newsticker--unxml-attribute att-list " ")
+ ">"
+ (mapconcat 'newsticker--unxml children "") "</" qname ">")))
+
+(defun newsticker--unxml-attribute (attribute)
+ "Actually restore xml-string of an ATTRIBUTE of an xml node."
+ (let ((name (symbol-name (car attribute)))
+ (value (cdr attribute)))
+ (concat name "=\"" value "\"")))
+
(defun newsticker--parse-atom-1.0 (name time topnode)
"Parse Atom 1.0 data.
Argument NAME gives the name of a news feed. TIME gives the
@@ -1157,8 +1222,17 @@ URL `http://www.atompub.org/2005/08/17/draft-ietf-atompub-format-11.html'"
(car (xml-get-children node 'title)))))
;; desc-fn
(lambda (node)
- (or (car (xml-node-children
- (car (xml-get-children node 'content))))
+ ;; unxml the content or the summary node. Atom
+ ;; allows for integrating (x)html into the atom
+ ;; structure but we need the raw html string.
+ ;; e.g. http://www.heise.de/open/news/news-atom.xml
+ ;; http://feeds.feedburner.com/ru_nix_blogs
+ (or (newsticker--unxml
+ (car (xml-node-children
+ (car (xml-get-children node 'content)))))
+ (newsticker--unxml
+ (car (xml-node-children
+ (car (xml-get-children node 'summary)))))
(car (xml-node-children
(car (xml-get-children node 'summary))))))
;; link-fn
@@ -1303,9 +1377,15 @@ For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'."
(car (xml-node-children
(car (xml-get-children channelnode 'title))))
;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
+ (or (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'encoded))))
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'content:encoded))))
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description)))))
;; link
(car (xml-node-children
(car (xml-get-children channelnode 'link))))
@@ -1329,8 +1409,10 @@ For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'."
;; time-fn
(lambda (node)
(newsticker--decode-iso8601-date
- (car (xml-node-children
- (car (xml-get-children node 'dc:date))))))
+ (or (car (xml-node-children
+ (car (xml-get-children node 'dc:date))))
+ (car (xml-node-children
+ (car (xml-get-children node 'date)))))))
;; guid-fn
(lambda (node)
nil)
@@ -1354,9 +1436,15 @@ For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'."
(car (xml-node-children
(car (xml-get-children channelnode 'title))))
;; desc
- (car (xml-node-children
- (car (xml-get-children channelnode
- 'description))))
+ (or (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'encoded))))
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'content:encoded))))
+ (car (xml-node-children
+ (car (xml-get-children channelnode
+ 'description)))))
;; link
(car (xml-node-children
(car (xml-get-children channelnode 'link))))
@@ -1372,6 +1460,9 @@ For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'."
(lambda (node)
(or (car (xml-node-children
(car (xml-get-children node
+ 'encoded))))
+ (car (xml-node-children
+ (car (xml-get-children node
'content:encoded))))
(car (xml-node-children
(car (xml-get-children node
@@ -1464,7 +1555,7 @@ argument, which is one of the items in ITEMLIST."
;; decode numeric entities
(setq title (xml-substitute-numeric-entities title))
(when desc
- (setq desc (xml-substitute-numeric-entities desc)))
+ (setq desc (xml-substitute-numeric-entities desc)))
(setq link (xml-substitute-numeric-entities link))
;; remove whitespace from title, desc, and link
(setq title (newsticker--remove-whitespace title))
@@ -1486,9 +1577,9 @@ argument, which is one of the items in ITEMLIST."
(let ((prev-age (newsticker--age old-item)))
(unless newsticker-automatically-mark-items-as-old
;; Some feeds deliver items multiply, the
- ;; first time we find an 'obsolete-old one the
- ;; cache, the following times we find an 'old
- ;; one
+ ;; first time we find an 'obsolete-old one in
+ ;; the cache, the following times we find an
+ ;; 'old one
(if (memq prev-age '(obsolete-old old))
(setq age2 'old)
(setq age2 'new)))
@@ -1498,11 +1589,16 @@ argument, which is one of the items in ITEMLIST."
;; item was not there
(setq item-new-p t)
(setq something-was-added t))
- (setq newsticker--cache
- (newsticker--cache-add
- newsticker--cache (intern name) title desc link
- time age1 position (funcall extra-fn node)
- time age2))
+ (let ((extra-elements-with-guid (funcall extra-fn node)))
+ (unless (assoc 'guid extra-elements-with-guid)
+ (setq extra-elements-with-guid
+ (cons `(guid nil ,(funcall guid-fn node))
+ extra-elements-with-guid)))
+ (setq newsticker--cache
+ (newsticker--cache-add
+ newsticker--cache (intern name) title desc link
+ time age1 position extra-elements-with-guid
+ time age2)))
(when item-new-p
(let ((item (newsticker--cache-contains
newsticker--cache (intern name) title
@@ -1712,31 +1808,44 @@ Checks list of active processes against list of newsticker processes."
;; ======================================================================
(defun newsticker--images-dir ()
"Return directory where feed images are saved."
- (concat newsticker-dir "/images"))
+ (concat newsticker-dir "/images/"))
-(defun newsticker--image-get (feed-name url)
- "Get image of the news site FEED-NAME from URL.
-If the image has been downloaded in the last 24h do nothing."
- (let ((image-name (concat (newsticker--images-dir) feed-name)))
+(defun newsticker--icons-dir ()
+ "Return directory where feed icons are saved."
+ (concat newsticker-dir "/icons/"))
+
+(defun newsticker--image-get (feed-name filename directory url)
+ "Get image for FEED-NAME by returning FILENAME from DIRECTORY.
+If the file does no exist or if it is older than 24 hours
+download it from URL first."
+ (let ((image-name (concat directory feed-name)))
(if (and (file-exists-p image-name)
(time-less-p (current-time)
(time-add (nth 5 (file-attributes image-name))
(seconds-to-time 86400))))
(newsticker--debug-msg "%s: Getting image for %s skipped"
- (format-time-string "%A, %H:%M" (current-time))
+ (format-time-string "%A, %H:%M")
feed-name)
;; download
(newsticker--debug-msg "%s: Getting image for %s"
- (format-time-string "%A, %H:%M" (current-time))
+ (format-time-string "%A, %H:%M")
feed-name)
- (let* ((buffername (concat " *newsticker-wget-image-" feed-name "*"))
- (item (or (assoc feed-name newsticker-url-list)
+ (if (eq newsticker-retrieval-method 'intern)
+ (newsticker--image-download-by-url feed-name filename directory url)
+ (newsticker--image-download-by-wget feed-name filename directory url)))))
+
+(defun newsticker--image-download-by-wget (feed-name filename directory url)
+ "Download image for FEED-NAME using external program.
+Save image as FILENAME in DIRECTORY, download it from URL."
+ (let* ((proc-name (concat feed-name "-" filename))
+ (buffername (concat " *newsticker-wget-image-" proc-name "*"))
+ (item (or (assoc feed-name newsticker-url-list)
(assoc feed-name newsticker-url-list-defaults)
(error
- "Cannot get news for %s: Check newsticker-url-list"
+ "Cannot get image for %s: Check newsticker-url-list"
feed-name)))
- (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
- newsticker-wget-arguments)))
+ (wget-arguments (or (car (cdr (cdr (cdr (cdr item)))))
+ newsticker-wget-arguments)))
(with-current-buffer (get-buffer-create buffername)
(erase-buffer)
;; throw an error if there is an old wget-process around
@@ -1745,39 +1854,96 @@ If the image has been downloaded in the last 24h do nothing."
feed-name))
;; start wget
(let* ((args (append wget-arguments (list url)))
- (proc (apply 'start-process feed-name buffername
+ (proc (apply 'start-process proc-name buffername
newsticker-wget-name args)))
(set-process-coding-system proc 'no-conversion 'no-conversion)
- (set-process-sentinel proc 'newsticker--image-sentinel)))))))
+ (set-process-sentinel proc 'newsticker--image-sentinel)
+ (process-put proc 'nt-directory directory)
+ (process-put proc 'nt-feed-name feed-name)
+ (process-put proc 'nt-filename filename)))))
(defun newsticker--image-sentinel (process event)
"Sentinel for image-retrieving PROCESS caused by EVENT."
(let* ((p-status (process-status process))
(exit-status (process-exit-status process))
- (feed-name (process-name process)))
+ (feed-name (process-get process 'nt-feed-name))
+ (directory (process-get process 'nt-directory))
+ (filename (process-get process 'nt-filename)))
;; catch known errors (zombie processes, rubbish-xml, etc.)
;; if an error occurs the news feed is not updated!
(catch 'oops
(unless (and (eq p-status 'exit)
(= exit-status 0))
(message "%s: Error while retrieving image from %s"
- (format-time-string "%A, %H:%M" (current-time))
+ (format-time-string "%A, %H:%M")
feed-name)
+ (newsticker--image-remove directory feed-name)
(throw 'oops nil))
- (let (image-name)
- (with-current-buffer (process-buffer process)
- (setq image-name (concat (newsticker--images-dir) feed-name))
- (set-buffer-file-coding-system 'no-conversion)
- ;; make sure the cache dir exists
- (unless (file-directory-p (newsticker--images-dir))
- (make-directory (newsticker--images-dir)))
- ;; write and close buffer
- (let ((require-final-newline nil)
- (backup-inhibited t)
- (coding-system-for-write 'no-conversion))
- (write-region nil nil image-name nil 'quiet))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))))))
+ (newsticker--image-save (process-buffer process) directory filename))))
+
+(defun newsticker--image-save (buffer directory file-name)
+ "Save contents of BUFFER in DIRECTORY as FILE-NAME.
+Finally kill buffer."
+ (with-current-buffer buffer
+ (let ((image-name (concat directory file-name)))
+ (set-buffer-file-coding-system 'no-conversion)
+ ;; make sure the cache dir exists
+ (unless (file-directory-p directory)
+ (make-directory directory))
+ ;; write and close buffer
+ (let ((require-final-newline nil)
+ (backup-inhibited t)
+ (coding-system-for-write 'no-conversion))
+ (write-region nil nil image-name nil 'quiet))
+ (set-buffer-modified-p nil)
+ (kill-buffer buffer))))
+
+(defun newsticker--image-remove (directory file-name)
+ "In DIRECTORY remove FILE-NAME."
+ (let ((image-name (concat directory file-name)))
+ (when (file-exists-p file-name)
+ (delete-file image-name))))
+
+(defun newsticker--image-download-by-url (feed-name filename directory url)
+ "Download image for FEED-NAME using `url-retrieve'.
+Save image as FILENAME in DIRECTORY, download it from URL."
+ (let ((coding-system-for-read 'no-conversion))
+ (condition-case error-data
+ (url-retrieve url 'newsticker--image-download-by-url-callback
+ (list feed-name directory filename))
+ (error (message "Error retrieving image from %s: %s" feed-name
+ error-data))))
+ (force-mode-line-update))
+
+(defun newsticker--image-download-by-url-callback (status feed-name directory filename)
+ "Callback function for `newsticker--image-download-by-url'.
+STATUS is the return status as delivered by `url-retrieve'.
+FEED-NAME is the name of the feed that the news were retrieved
+from.
+The image is saved in DIRECTORY as FILENAME."
+ (let ((do-save
+ (or (not status)
+ (let ((status-type (car status))
+ (status-details (cdr status)))
+ (cond ((eq status-type :redirect)
+ ;; don't care about redirects
+ t)
+ ((eq status-type :error)
+ ;; silently ignore errors
+ nil))))))
+ (when do-save
+ (let ((buf (get-buffer-create (concat " *newsticker-url-image-" feed-name "-"
+ directory "*")))
+ (result (string-to-multibyte (buffer-string))))
+ (set-buffer buf)
+ (erase-buffer)
+ (insert result)
+ ;; remove MIME header
+ (goto-char (point-min))
+ (search-forward "\n\n")
+ (delete-region (point-min) (point))
+ ;; save
+ (newsticker--image-save buf directory filename)))))
(defun newsticker--insert-image (img string)
"Insert IMG with STRING at point."
@@ -2192,6 +2358,7 @@ If AGE is nil, the total number of items is returned."
(defun newsticker-opml-export ()
"OPML subscription export.
Export subscriptions to a buffer in OPML Format."
+ ;; FIXME: use newsticker-groups
(interactive)
(with-current-buffer (get-buffer-create "*OPML Export*")
(set-buffer-file-coding-system 'utf-8)
@@ -2211,7 +2378,8 @@ Export subscriptions to a buffer in OPML Format."
(insert " <outline text=\"")
(insert (newsticker--title sub))
(insert "\" xmlUrl=\"")
- (insert (cadr sub))
+ (insert (xml-escape-string (let ((url (cadr sub)))
+ (if (stringp url) url (prin1-to-string url)))))
(insert "\"/>\n"))
(append newsticker-url-list newsticker-url-list-defaults))
(insert " </body>\n</opml>\n"))
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index 2ba4e5c2716..0cb5d8c6a2f 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -1,11 +1,10 @@
;;; newst-plainview.el --- Single buffer frontend for newsticker.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-plainview.el
;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "Mon 11-Feb-2013 20:27:11 gm on skiddaw"
;; Package: newsticker
;; ======================================================================
@@ -252,7 +251,7 @@ assures that the current feed is completely visible."
"List of functions run after the newsticker buffer has been updated.
Each function is called after `newsticker-buffer-update' has been called.
-The default value '`newsticker-w3m-show-inline-images' loads inline
+The default value `\\='newsticker-w3m-show-inline-images' loads inline
images."
:type 'hook
:group 'newsticker-plainview-hooks)
@@ -264,7 +263,7 @@ Each function is called after
`newsticker-toggle-auto-narrow-to-feed' or
`newsticker-toggle-auto-narrow-to-item' has been called.
-The default value '`newsticker-w3m-show-inline-images' loads inline
+The default value `\\='newsticker-w3m-show-inline-images' loads inline
images."
:type 'hook
:group 'newsticker-plainview-hooks)
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index 21bb890f742..105b36e14a3 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -1,11 +1,10 @@
;;; newst-reader.el --- Generic RSS reader functions.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-reader.el
;; URL: http://www.nongnu.org/newsticker
-;; Time-stamp: "24. September 2011, 15:47:49 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -67,6 +66,12 @@ This must be one of the functions `newsticker-plainview' or
:group 'newsticker-reader)
;; image related things
+(defcustom newsticker-download-logos
+ t
+ "If non-nil newsticker downloads logo images of subscribed feeds."
+ :type 'boolean
+ :group 'newsticker-reader)
+
(defcustom newsticker-enable-logo-manipulations
t
"If non-nil newsticker manipulates logo images.
@@ -101,15 +106,18 @@ window is used when filling. See also `newsticker-justification'."
:group 'newsticker-reader)
(defcustom newsticker-html-renderer
- nil
+ (if (fboundp 'libxml-parse-html-region)
+ #'shr-render-region)
"Function for rendering HTML contents.
If non-nil, newsticker.el will call this function whenever it
-finds HTML-like tags in item descriptions. Possible functions
-are `w3m-region', `w3-region', and `newsticker-htmlr-render'.
+finds HTML-like tags in item descriptions.
+Possible functions include `shr-render-region', `w3m-region', `w3-region', and
+`newsticker-htmlr-render'.
Newsticker automatically loads the respective package w3m, w3, or
htmlr if this option is set."
:type '(choice :tag "Function"
(const :tag "None" nil)
+ (const :tag "SHR" shr-render-region)
(const :tag "w3" w3-region)
(const :tag "w3m" w3m-region)
(const :tag "htmlr" newsticker-htmlr-render))
@@ -183,15 +191,18 @@ KEYMAP will be applied."
'nt-type 'desc))
(insert "\n")))))
-(defun newsticker--print-extra-elements (item keymap)
+(defun newsticker--print-extra-elements (item keymap &optional htmlish)
"Insert extra-elements of ITEM in a pretty form into the current buffer.
-KEYMAP is applied."
+KEYMAP is applied. If HTMLISH is non-nil then HTML-markup is used
+for formatting."
(let ((ignored-elements '(items link title description content
- content:encoded dc:subject
- dc:date entry item guid pubDate
+ content:encoded encoded
+ dc:subject subject
+ dc:date date entry item guid pubDate
published updated
enclosure))
(left-column-width 1))
+ (if htmlish (insert "<ul>"))
(mapc (lambda (extra-element)
(when (listp extra-element) ;; take care of broken xml
;; data, 2007-05-25
@@ -206,15 +217,20 @@ KEYMAP is applied."
(unless (memq (car extra-element) ignored-elements)
(newsticker--do-print-extra-element extra-element
left-column-width
- keymap))))
- (newsticker--extra item))))
+ keymap
+ htmlish))))
+ (newsticker--extra item))
+ (if htmlish (insert "</ul>"))))
-(defun newsticker--do-print-extra-element (extra-element width keymap)
+(defun newsticker--do-print-extra-element (extra-element width keymap htmlish)
"Actually print an EXTRA-ELEMENT using the given WIDTH.
-KEYMAP is applied."
+KEYMAP is applied. If HTMLISH is non-nil then HTML-markup is used
+for formatting."
(let ((name (symbol-name (car extra-element))))
- (insert (format "%s: " name))
- (insert (make-string (- width (length name)) ? )))
+ (if htmlish
+ (insert (format "<li>%s: " name))
+ (insert (format "%s: " name))
+ (insert (make-string (- width (length name)) ? ))))
(let (;;(attributes (cadr extra-element)) ;FIXME!!!!
(contents (cddr extra-element)))
(cond ((listp contents)
@@ -235,30 +251,58 @@ KEYMAP is applied."
contents))
(t
(insert (format "%s" contents))))
- (insert "\n")))
+ (if htmlish
+ (insert "</li>")
+ (insert "\n"))))
-(defun newsticker--image-read (feed-name-symbol disabled)
+(defun newsticker--image-read (feed-name-symbol disabled &optional max-height)
"Read the cached image for FEED-NAME-SYMBOL from disk.
If DISABLED is non-nil the image will be converted to a disabled look
-\(unless `newsticker-enable-logo-manipulations' is not t\).
+\(unless `newsticker-enable-logo-manipulations' is not t).
+Optional argument MAX-HEIGHT specifies the maximal image height.
Return the image."
(let ((image-name (concat (newsticker--images-dir)
- (symbol-name feed-name-symbol)))
- (img nil))
+ (symbol-name feed-name-symbol))))
(when (file-exists-p image-name)
(condition-case error-data
- (setq img (create-image
- image-name nil nil
- :conversion (and newsticker-enable-logo-manipulations
- disabled
- 'disabled)
- :mask (and newsticker-enable-logo-manipulations
- 'heuristic)
- :ascent 70))
+ (create-image
+ image-name
+ (and (fboundp 'imagemagick-types)
+ (imagemagick-types)
+ 'imagemagick)
+ nil
+ :conversion (and newsticker-enable-logo-manipulations
+ disabled
+ 'disabled)
+ :mask (and newsticker-enable-logo-manipulations
+ 'heuristic)
+ :ascent 100
+ :max-height max-height)
(error
(message "Error: cannot create image for %s: %s"
- feed-name-symbol error-data))))
- img))
+ feed-name-symbol error-data))))))
+
+(defun newsticker--icon-read (feed-name-symbol)
+ "Read the cached icon for FEED-NAME-SYMBOL from disk.
+Return the image."
+ (catch 'icon
+ (when (file-exists-p (newsticker--icons-dir))
+ (dolist (file (directory-files (newsticker--icons-dir) t
+ (concat (symbol-name feed-name-symbol) "\\..*")))
+ (condition-case error-data
+ (throw 'icon (create-image
+ file (and (fboundp 'imagemagick-types)
+ (imagemagick-types)
+ 'imagemagick)
+ nil
+ :ascent 'center
+ :max-width 16
+ :max-height 16))
+ (error
+ (message "Error: cannot create icon for %s: %s"
+ feed-name-symbol error-data)))))
+ ;; Fallback: default icon.
+ (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))))
;; the functions we need for retrieval and display
;;;###autoload
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 1ff231aabfb..9426bb7a8e4 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -1,12 +1,11 @@
;; newst-ticker.el --- mode line ticker for newsticker.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-ticker.el
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
-;; Time-stamp: "6. Dezember 2009, 19:16:00 (ulf)"
;; Package: newsticker
;; ======================================================================
@@ -37,6 +36,14 @@
(require 'newst-backend)
+(defvar newsticker--item-list nil
+ "List of newsticker items.")
+(defvar newsticker--item-position 0
+ "Actual position in list of newsticker items.")
+(defvar newsticker--prev-message "There was no previous message yet!"
+ "Last message that the newsticker displayed.")
+(defvar newsticker--scrollable-text ""
+ "The text which is scrolled smoothly in the echo area.")
(defvar newsticker--ticker-timer nil
"Timer for newsticker ticker.")
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index d6c8f6f557d..0c2df8897d7 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -1,10 +1,9 @@
-;;; newst-treeview.el --- Treeview frontend for newsticker.
+;;; newst-treeview.el --- Treeview frontend for newsticker. -*- lexical-binding:t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newst-treeview.el
-;; URL: http://www.nongnu.org/newsticker
;; Created: 2007
;; Keywords: News, RSS, Atom
;; Package: newsticker
@@ -83,6 +82,14 @@
"Face for newsticker selection."
:group 'newsticker-treeview)
+(defcustom newsticker-treeview-date-format
+ "%d.%m.%y, %H:%M"
+ "Format for the date column in the treeview list buffer.
+See `format-time-string' for a list of valid specifiers."
+ :version "25.1"
+ :type 'string
+ :group 'newsticker-treeview)
+
(defcustom newsticker-treeview-own-frame
nil
"Decides whether newsticker treeview creates and uses its own frame."
@@ -124,8 +131,9 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\")
\"feed3\")")
(defcustom newsticker-groups-filename
- "~/.newsticker-groups"
- "Name of the newsticker groups settings file."
+ nil
+ "Name of the newsticker groups settings file. This variable is obsolete."
+ :version "25.1" ; changed default value to nil
:type 'string
:group 'newsticker-treeview)
(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1")
@@ -210,7 +218,7 @@ their id stays constant."
;;(message "%s/%s %s/%s" (widget-get node1 :tag) (widget-get node2 :tag)
;; (or id1 -1) (or id2 -1))
(or (newsticker--treeview-ids-eq id1 id2)
- (string= (widget-get node1 :tag) (widget-get node2 :tag)))))
+ (string= (widget-get node1 :nt-feed) (widget-get node2 :nt-feed)))))
(defun newsticker--treeview-do-get-node-of-feed (feed-name startnode)
"Recursively search node for feed FEED-NAME starting from STARTNODE."
@@ -230,28 +238,30 @@ their id stays constant."
(newsticker--treeview-do-get-node-of-feed feed-name
newsticker--treeview-vfeed-tree)))
-(defun newsticker--treeview-do-get-node (id startnode)
+(defun newsticker--treeview-do-get-node-by-id (id startnode)
"Recursively search node with ID starting from STARTNODE."
(if (newsticker--treeview-ids-eq id (widget-get startnode :nt-id))
(throw 'found startnode)
(let ((children (widget-get startnode :children)))
(dolist (w children)
- (newsticker--treeview-do-get-node id w)))))
+ (newsticker--treeview-do-get-node-by-id id w)))))
-(defun newsticker--treeview-get-node (id)
+(defun newsticker--treeview-get-node-by-id (id)
"Return node with ID in newsticker treeview tree."
(catch 'found
- (newsticker--treeview-do-get-node id newsticker--treeview-feed-tree)
- (newsticker--treeview-do-get-node id newsticker--treeview-vfeed-tree)))
+ (newsticker--treeview-do-get-node-by-id id newsticker--treeview-feed-tree)
+ (newsticker--treeview-do-get-node-by-id id newsticker--treeview-vfeed-tree)))
(defun newsticker--treeview-get-current-node ()
"Return current node in newsticker treeview tree."
- (newsticker--treeview-get-node newsticker--treeview-current-node-id))
+ (newsticker--treeview-get-node-by-id newsticker--treeview-current-node-id))
;; ======================================================================
-(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
+(unless (fboundp 'declare-function) (defmacro declare-function (&rest _)))
(declare-function w3m-toggle-inline-images "ext:w3m" (&optional force no-cache))
+(defvar w3m-fill-column)
+(defvar w3-maximum-line-length)
(defun newsticker--treeview-render-text (start end)
"Render text between markers START and END."
@@ -307,7 +317,7 @@ If string SHOW-FEED is non-nil it is shown in the item string."
0 10)
(propertize " " 'display '(space :align-to 12)))
""))
- (insert (format-time-string "%d.%m.%y, %H:%M"
+ (insert (format-time-string newsticker-treeview-date-format
(newsticker--time item)))
(insert (propertize " " 'display
(list 'space :align-to (if show-feed 28 18))))
@@ -319,7 +329,8 @@ If string SHOW-FEED is non-nil it is shown in the item string."
(while (search-forward "\n" nil t)
(replace-match " "))
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'newsticker-treeview-tree-click)
+ (dolist (key'([mouse-1] [mouse-3]))
+ (define-key map key 'newsticker-treeview-tree-click))
(define-key map "\n" 'newsticker-treeview-show-item)
(define-key map "\C-m" 'newsticker-treeview-show-item)
(add-text-properties pos1 (point-max)
@@ -341,7 +352,7 @@ If string SHOW-FEED is non-nil it is shown in the item string."
(remove-overlays))))
(defun newsticker--treeview-list-items-with-age-callback (widget
- changed-widget
+ _changed-widget
&rest ages)
"Fill newsticker treeview list window with items of certain age.
This is a callback function for the treeview nodes.
@@ -350,7 +361,7 @@ Argument CHANGED-WIDGET is the widget that actually has changed.
Optional argument AGES is the list of ages that are to be shown."
(newsticker--treeview-list-clear)
(widget-put widget :nt-selected t)
- (apply 'newsticker--treeview-list-items-with-age ages))
+ (apply #'newsticker--treeview-list-items-with-age ages))
(defun newsticker--treeview-list-items-with-age (&rest ages)
"Actually fill newsticker treeview list window with items of certain age.
@@ -367,7 +378,7 @@ AGES is the list of ages that are to be shown."
(newsticker--treeview-list-update nil))
(defun newsticker--treeview-list-new-items (widget changed-widget
- &optional event)
+ &optional _event)
"Fill newsticker treeview list window with new items.
This is a callback function for the treeview nodes.
Argument WIDGET is the calling treeview widget.
@@ -380,7 +391,7 @@ Optional argument EVENT is the mouse event that triggered this action."
"This is a virtual feed containing all new items"))
(defun newsticker--treeview-list-immortal-items (widget changed-widget
- &optional event)
+ &optional _event)
"Fill newsticker treeview list window with immortal items.
This is a callback function for the treeview nodes.
Argument WIDGET is the calling treeview widget.
@@ -393,7 +404,7 @@ Optional argument EVENT is the mouse event that triggered this action."
"This is a virtual feed containing all immortal items."))
(defun newsticker--treeview-list-obsolete-items (widget changed-widget
- &optional event)
+ &optional _event)
"Fill newsticker treeview list window with obsolete items.
This is a callback function for the treeview nodes.
Argument WIDGET is the calling treeview widget.
@@ -445,8 +456,8 @@ Optional argument EVENT is the mouse event that triggered this action."
(cdr (newsticker--cache-get-feed (intern feed-name)))))
(newsticker--treeview-list-update nil))))
-(defun newsticker--treeview-list-feed-items (widget changed-widget
- &optional event)
+(defun newsticker--treeview-list-feed-items (widget _changed-widget
+ &optional _event)
"Callback function for listing feed items.
Argument WIDGET is the calling treeview widget.
Argument CHANGED-WIDGET is the widget that actually has changed.
@@ -573,11 +584,10 @@ The sort function is chosen according to the value of
(defun newsticker--treeview-list-update-highlight ()
"Update the highlight in the treeview list buffer."
(newsticker--treeview-list-clear-highlight)
- (let (pos num-lines)
- (with-current-buffer (newsticker--treeview-list-buffer)
- (let ((inhibit-read-only t))
- (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
- (newsticker--treeview-list-update-faces))))
+ (with-current-buffer (newsticker--treeview-list-buffer)
+ (let ((inhibit-read-only t))
+ (put-text-property (point-at-bol) (point-at-eol) :nt-selected t))
+ (newsticker--treeview-list-update-faces)))
(defun newsticker--treeview-list-highlight-start ()
"Return position of selection in treeview list buffer."
@@ -654,23 +664,22 @@ for the button."
(defun newsticker--treeview-list-select (item)
"Select ITEM in treeview's list buffer."
(newsticker--treeview-list-clear-highlight)
- (let (pos num-lines)
- (save-current-buffer
- (set-buffer (newsticker--treeview-list-buffer))
- (goto-char (point-min))
- (catch 'found
- (while t
- (let ((it (get-text-property (point) :nt-item)))
- (when (eq it item)
- (newsticker--treeview-list-update-highlight)
- (newsticker--treeview-list-update-faces)
- (newsticker--treeview-item-show
- item (get-text-property (point) :nt-feed))
- (throw 'found t)))
- (forward-line 1)
- (when (eobp)
- (goto-char (point-min))
- (throw 'found nil)))))))
+ (save-current-buffer
+ (set-buffer (newsticker--treeview-list-buffer))
+ (goto-char (point-min))
+ (catch 'found
+ (while t
+ (let ((it (get-text-property (point) :nt-item)))
+ (when (eq it item)
+ (newsticker--treeview-list-update-highlight)
+ (newsticker--treeview-list-update-faces)
+ (newsticker--treeview-item-show
+ item (get-text-property (point) :nt-feed))
+ (throw 'found t)))
+ (forward-line 1)
+ (when (eobp)
+ (goto-char (point-min))
+ (throw 'found nil))))))
;; ======================================================================
;;; item window
@@ -708,7 +717,9 @@ for the button."
(remove-overlays)
(when (and item feed-name-symbol)
- (let ((wwidth (1- (window-width (newsticker--treeview-item-window)))))
+ (let ((wwidth (1- (if (window-live-p (newsticker--treeview-item-window))
+ (window-width (newsticker--treeview-item-window))
+ fill-column))))
(if newsticker-use-full-width
(set (make-local-variable 'fill-column) wwidth))
(set (make-local-variable 'fill-column) (min fill-column
@@ -727,7 +738,7 @@ for the button."
(goto-char (point-min))
;; insert logo at top
(let* ((newsticker-enable-logo-manipulations nil)
- (img (newsticker--image-read feed-name-symbol nil)))
+ (img (newsticker--image-read feed-name-symbol nil 40)))
(if (and (display-images-p) img)
(newsticker--insert-image img (car item))
(insert (newsticker--real-feed-name feed-name-symbol))))
@@ -773,8 +784,11 @@ for the button."
(put-text-property pos (point) 'face 'newsticker-enclosure-face)
(setq pos (point))
(insert "\n")
- (newsticker--print-extra-elements item newsticker--treeview-url-keymap)
- (put-text-property pos (point) 'face 'newsticker-extra-face)
+ (set-marker marker1 pos)
+ (newsticker--print-extra-elements item newsticker--treeview-url-keymap t)
+ (set-marker marker2 (point))
+ (newsticker--treeview-render-text marker1 marker2)
+ (put-text-property marker1 marker2 'face 'newsticker-extra-face)
(goto-char (point-min)))))
(if (and newsticker-treeview-automatically-mark-displayed-items-as-old
item
@@ -818,6 +832,7 @@ Callback function for tree widget that adds nodes for feeds and subgroups."
:nt-group ,(cdr g)
:nt-feed ,g-name
:nt-id ,nt-id
+ :leaf-icon newsticker--tree-widget-leaf-icon
:keep (:nt-feed :num-new :nt-id :open);; :nt-group
:open nil))
(let ((tag (newsticker--treeview-tree-get-tag g nil nt-id)))
@@ -830,8 +845,25 @@ Callback function for tree widget that adds nodes for feeds and subgroups."
:open t))))
group)))
-(defun newsticker--treeview-tree-expand-status (tree &optional changed-widget
- event)
+(defun newsticker--tree-widget-icon-create (icon)
+ "Create the ICON widget."
+ (let* ((g (widget-get (widget-get icon :node) :nt-feed))
+ (ico (and g (newsticker--icon-read (intern g)))))
+ (if ico
+ (progn
+ (widget-put icon :tag-glyph ico)
+ (widget-default-create icon)
+ ;; Insert space between the icon and the node widget.
+ (insert-char ? 1)
+ (put-text-property
+ (1- (point)) (point)
+ 'display (list 'space :width tree-widget-space-width)))
+ ;; fallback: default icon
+ (widget-put icon :leaf-icon 'tree-widget-leaf-icon)
+ (tree-widget-icon-create icon))))
+
+(defun newsticker--treeview-tree-expand-status (tree &optional _changed-widget
+ _event)
"Expand the vfeed TREE.
Optional arguments CHANGED-WIDGET and EVENT are ignored."
(tree-widget-set-theme "folder")
@@ -864,6 +896,7 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored."
"Icon for a tree-widget leaf node."
:tag "O"
:glyph-name "leaf"
+ :create 'newsticker--tree-widget-icon-create
:button-face 'default)
(defun newsticker--treeview-tree-update ()
@@ -882,7 +915,7 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored."
:tag (newsticker--treeview-propertize-tag
"Feeds" 0 "feeds")
:expander 'newsticker--treeview-tree-expand
- :expander-p (lambda (&rest ignore) t)
+ :expander-p (lambda (&rest _) t)
:leaf-icon 'newsticker--tree-widget-leaf-icon
:nt-group (cdr newsticker-groups)
:nt-id "feeds"
@@ -893,7 +926,7 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored."
:tag (newsticker--treeview-propertize-tag
"Virtual Feeds" 0 "vfeeds")
:expander 'newsticker--treeview-tree-expand-status
- :expander-p (lambda (&rest ignore) t)
+ :expander-p (lambda (&rest _) t)
:leaf-icon 'newsticker--tree-widget-leaf-icon
:nt-id "vfeeds"
:keep '(:nt-id)
@@ -907,12 +940,13 @@ Optional arguments CHANGED-WIDGET and EVENT are ignored."
"Return propertized copy of string TAG.
Optional argument NUM-NEW is used for choosing face, other
arguments NT-ID, FEED, and VFEED are added as properties."
- ;;(message "newsticker--treeview-propertize-tag '%s' %s" feed nt-id)
+ ;;(message "newsticker--treeview-propertize-tag `%s' %s" feed nt-id)
(let ((face 'newsticker-treeview-face)
(map (make-sparse-keymap)))
(if (and num-new (> num-new 0))
(setq face 'newsticker-treeview-new-face))
- (define-key map [mouse-1] 'newsticker-treeview-tree-click)
+ (dolist (key '([mouse-1] [mouse-3]))
+ (define-key map key 'newsticker-treeview-tree-click))
(define-key map "\n" 'newsticker-treeview-tree-do-click)
(define-key map "\C-m" 'newsticker-treeview-tree-do-click)
(propertize tag 'face face 'keymap map
@@ -955,10 +989,10 @@ Optional argument NT-ID is added to the tag's properties."
(defun newsticker--stat-num-items-for-group (feed-name-symbol &rest ages)
"Count number of items in feed FEED-NAME-SYMBOL that have an age matching AGES."
;;(message "newsticker--stat-num-items-for-group %s %s" feed-name-symbol ages)
- (let ((result (apply 'newsticker--stat-num-items feed-name-symbol ages)))
+ (let ((result (apply #'newsticker--stat-num-items feed-name-symbol ages)))
(mapc (lambda (f-n)
(setq result (+ result
- (apply 'newsticker--stat-num-items (intern f-n)
+ (apply #'newsticker--stat-num-items (intern f-n)
ages))))
(newsticker--group-get-feeds
(newsticker--group-get-group (symbol-name feed-name-symbol)) t))
@@ -984,7 +1018,7 @@ the feed is a virtual feed."
num-new))
(defun newsticker--treeview-tree-update-tag (w &optional recursive
- &rest ignore)
+ &rest _ignore)
"Update tag for tree widget W.
If RECURSIVE is non-nil recursively update parent widgets as
well. Argument IGNORE is ignored. Note that this function, if
@@ -1007,8 +1041,7 @@ that case."
(widget-put w :num-new num-new)
(widget-put w :tag tag)
(when (marker-position (widget-get w :from))
- (let ((p (point))
- (notify (widget-get w :notify)))
+ (let ((p (point)))
;; FIXME: This moves point!!!!
(with-current-buffer (newsticker--treeview-tree-buffer)
(widget-value-set w (widget-value w)))
@@ -1022,9 +1055,9 @@ that case."
(newsticker--treeview-tree-do-update-tags w))
(newsticker--treeview-tree-update-tag widget))))
-(defun newsticker--treeview-tree-update-tags (&rest ignore)
+(defun newsticker--treeview-tree-update-tags (&rest _ignore)
"Update all tags of all trees.
-Arguments IGNORE are ignored."
+Arguments are ignored."
(save-current-buffer
(set-buffer (newsticker--treeview-tree-buffer))
(let ((inhibit-read-only t))
@@ -1158,12 +1191,14 @@ Arguments IGNORE are ignored."
(unless newsticker--selection-overlay
(with-current-buffer (newsticker--treeview-list-buffer)
+ (setq buffer-undo-list t)
(setq newsticker--selection-overlay (make-overlay (point-min)
(point-max)))
(overlay-put newsticker--selection-overlay 'face
'newsticker-treeview-selection-face)))
(unless newsticker--tree-selection-overlay
(with-current-buffer (newsticker--treeview-tree-buffer)
+ (setq buffer-undo-list t)
(setq newsticker--tree-selection-overlay (make-overlay (point-min)
(point-max)))
(overlay-put newsticker--tree-selection-overlay 'face
@@ -1210,7 +1245,7 @@ Note: does not update the layout."
(newsticker-treeview-save))
(defun newsticker-treeview-save ()
- "Save newsticker data including treeview settings."
+ "Save treeview group settings."
(interactive)
(let ((coding-system-for-write 'utf-8)
(buf (find-file-noselect (concat newsticker-dir "/groups"))))
@@ -1227,16 +1262,27 @@ Note: does not update the layout."
"Load treeview settings."
(let* ((coding-system-for-read 'utf-8)
(filename
- (or (and (file-exists-p newsticker-groups-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 "Old newsticker groups (%s) file exists. Read it? "
- newsticker-groups-filename))
+ (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")))
(buf (and (file-exists-p filename)
(find-file-noselect filename))))
- (and (file-exists-p newsticker-groups-filename)
- (y-or-n-p (format "Delete old newsticker groups file? "))
+ (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)
@@ -1590,10 +1636,8 @@ Return t if a new feed was activated, nil otherwise."
"Recursively show subtree above the node that represents FEED-NAME."
(let ((node (newsticker--treeview-get-node-of-feed feed-name)))
(unless node
- (let* ((group-name (or (car (newsticker--group-find-group-for-feed
- feed-name))
- (newsticker--group-get-parent-group
- feed-name))))
+ (let* ((group-name (car (newsticker--group-find-parent-group
+ feed-name))))
(newsticker--treeview-unfold-node group-name))
(setq node (newsticker--treeview-get-node-of-feed feed-name)))
(when node
@@ -1609,28 +1653,39 @@ Return t if a new feed was activated, nil otherwise."
(completing-read
"Jump to feed: "
(append '("new" "obsolete" "immortal" "all")
- (mapcar 'car (append newsticker-url-list
- newsticker-url-list-defaults)))
+ (mapcar #'car (append newsticker-url-list
+ newsticker-url-list-defaults)))
nil t))))
(newsticker--treeview-unfold-node feed-name))
;; ======================================================================
;;; Groups
;; ======================================================================
-(defun newsticker--group-do-find-group-for-feed (feed-name node)
- "Recursively find FEED-NAME in NODE."
- (if (member feed-name (cdr node))
- (throw 'found node)
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-find-group-for-feed feed-name n)))
- (cdr node))))
-
-(defun newsticker--group-find-group-for-feed (feed-name)
- "Find group containing FEED-NAME."
+(defun newsticker--group-do-find-group (feed-or-group-name parent-node node)
+ "Recursively find FEED-OR-GROUP-NAME in PARENT-NODE or NODE."
+ (cond ((stringp node)
+ (when (string= feed-or-group-name node)
+ (throw 'found parent-node)))
+ ((listp node)
+ (cond ((string= feed-or-group-name (car node))
+ (throw 'found parent-node))
+ ((member feed-or-group-name (cdr node))
+ (throw 'found node))
+ (t
+ (mapc (lambda (n)
+ (if (listp n)
+ (newsticker--group-do-find-group
+ feed-or-group-name node n)))
+ (cdr node)))))))
+
+(defun newsticker--group-find-parent-group (feed-or-group-name)
+ "Find group containing FEED-OR-GROUP-NAME."
(catch 'found
- (newsticker--group-do-find-group-for-feed feed-name
- newsticker-groups)
+ (mapc (lambda (n)
+ (newsticker--group-do-find-group feed-or-group-name
+ newsticker-groups
+ n))
+ newsticker-groups)
nil))
(defun newsticker--group-do-get-group (name node)
@@ -1651,26 +1706,6 @@ Return t if a new feed was activated, nil otherwise."
newsticker-groups)
nil))
-(defun newsticker--group-do-get-parent-group (name node parent)
- "Recursively find parent group for NAME from NODE which is a child of PARENT."
- (if (string= name (car node))
- (throw 'found parent)
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-parent-group name n (car node))))
- (cdr node))))
-
-(defun newsticker--group-get-parent-group (name)
- "Find parent group for group named NAME."
- (catch 'found
- (mapc (lambda (n)
- (if (listp n)
- (newsticker--group-do-get-parent-group
- name n (car newsticker-groups))))
- newsticker-groups)
- nil))
-
-
(defun newsticker--group-get-subgroups (group &optional recursive)
"Return list of subgroups for GROUP.
If RECURSIVE is non-nil recursively get subgroups and return a nested list."
@@ -1706,9 +1741,9 @@ return a nested list."
(defun newsticker-group-add-group (name parent)
"Add group NAME to group PARENT."
(interactive
- (list (read-string "Group Name: ")
+ (list (read-string "Name of new group: ")
(let ((completion-ignore-case t))
- (completing-read "Parent Group: " (newsticker--group-all-groups)
+ (completing-read "Name of parent group (optional): " (newsticker--group-all-groups)
nil t))))
(if (newsticker--group-get-group name)
(error "Group %s exists already" name))
@@ -1718,46 +1753,155 @@ return a nested list."
(unless p
(error "Parent %s does not exist" parent))
(setcdr p (cons (list name) (cdr p))))
- (newsticker--treeview-tree-update))
+ (newsticker--treeview-tree-update)
+ (newsticker-treeview-jump newsticker--treeview-current-feed))
+
+(defun newsticker-group-delete-group (name)
+ "Delete group NAME."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Delete group: "
+ (newsticker--group-names)
+ nil t (car (newsticker--group-find-parent-group
+ newsticker--treeview-current-feed))))))
+ (let ((parent-group (newsticker--group-find-parent-group name)))
+ (unless parent-group
+ (error "Parent %s does not exist" parent-group))
+ (setcdr parent-group (cl-delete-if (lambda (g)
+ (and (listp g)
+ (string= name (car g))))
+ (cdr parent-group)))
+ (newsticker--group-manage-orphan-feeds)
+ (newsticker--treeview-tree-update)
+ (newsticker-treeview-update)
+ (newsticker-treeview-jump newsticker--treeview-current-feed)))
+
+(defun newsticker--group-do-rename-group (old-name new-name)
+ "Actually rename group OLD-NAME to NEW-NAME."
+ (let ((parent-group (newsticker--group-find-parent-group old-name)))
+ (unless parent-group
+ (error "Parent of %s does not exist" old-name))
+ (mapcar (lambda (elt)
+ (cond ((and (listp elt)
+ (string= old-name (car elt)))
+ (cons new-name (cdr elt)))
+ (t
+ elt)))
+ parent-group)))
+
+(defun newsticker-group-rename-group (old-name new-name)
+ "Rename group OLD-NAME to NEW-NAME."
+ (interactive
+ (list (let* ((completion-ignore-case t))
+ (completing-read "Rename group: "
+ (newsticker--group-names)
+ nil t (car (newsticker--group-find-parent-group
+ newsticker--treeview-current-feed))))
+ (read-string "Rename to: ")))
+ (setq newsticker-groups (newsticker--group-do-rename-group old-name new-name))
+ (newsticker--group-manage-orphan-feeds)
+ (newsticker--treeview-tree-update)
+ (newsticker-treeview-update)
+ (newsticker-treeview-jump newsticker--treeview-current-feed))
+
+(defun newsticker--get-group-names (lst)
+ "Do get the group names from LST."
+ (delete nil (cons (car lst)
+ (apply #'append
+ (mapcar (lambda (e)
+ (cond ((listp e)
+ (newsticker--get-group-names e))
+ (t
+ nil)))
+ (cdr lst))))))
+
+(defun newsticker--group-names ()
+ "Get names of all newsticker groups."
+ (newsticker--get-group-names newsticker-groups))
(defun newsticker-group-move-feed (name group-name &optional no-update)
"Move feed NAME to group GROUP-NAME.
Update treeview afterwards unless NO-UPDATE is non-nil."
(interactive
(let ((completion-ignore-case t))
- (list (completing-read "Feed Name: "
- (mapcar 'car newsticker-url-list)
+ (list (completing-read "Name of feed or group to move: "
+ (append (mapcar #'car newsticker-url-list)
+ (newsticker--group-names))
nil t newsticker--treeview-current-feed)
- (completing-read "Group Name: " (newsticker--group-all-groups)
+ (completing-read "Name of new parent group: " (newsticker--group-names)
nil t))))
- (let ((group (if (and group-name (not (string= group-name "")))
- (newsticker--group-get-group group-name)
- newsticker-groups)))
+ (let* ((group (if (and group-name (not (string= group-name "")))
+ (newsticker--group-get-group group-name)
+ newsticker-groups))
+ (moving-group-p (member name (newsticker--group-names)))
+ (moved-thing (if moving-group-p
+ (newsticker--group-get-group name)
+ name)))
(unless group
(error "Group %s does not exist" group-name))
(while (let ((old-group
- (newsticker--group-find-group-for-feed name)))
+ (newsticker--group-find-parent-group name)))
(when old-group
- (delete name old-group))
+ (delete moved-thing old-group))
old-group))
- (setcdr group (cons name (cdr group)))
+ (setcdr group (cons moved-thing (cdr group)))
(unless no-update
(newsticker--treeview-tree-update)
- (newsticker-treeview-update))))
+ (newsticker-treeview-update)
+ (newsticker-treeview-jump name))))
-(defun newsticker-group-delete-group (name)
- "Remove group NAME."
- (interactive
- (let ((completion-ignore-case t))
- (list (completing-read "Group Name: " (newsticker--group-all-groups)
- nil t))))
- (let* ((g (newsticker--group-get-group name))
- (p (or (newsticker--group-get-parent-group name)
- newsticker-groups)))
- (unless g
- (error "Group %s does not exist" name))
- (delete g p))
- (newsticker--treeview-tree-update))
+(defun newsticker-group-shift-feed-down ()
+ "Shift current feed down in its group."
+ (interactive)
+ (newsticker--group-shift 1))
+
+(defun newsticker-group-shift-feed-up ()
+ "Shift current feed down in its group."
+ (interactive)
+ (newsticker--group-shift -1))
+
+(defun newsticker-group-shift-group-down ()
+ "Shift current group down in its group."
+ (interactive)
+ (newsticker--group-shift 1 t))
+
+(defun newsticker-group-shift-group-up ()
+ "Shift current group down in its group."
+ (interactive)
+ (newsticker--group-shift -1 t))
+
+(defun newsticker--group-shift (delta &optional move-group)
+ "Shift current feed or group within its parent group.
+DELTA is an integer which specifies the direction and the amount
+of the shift. If MOVE-GROUP is nil the currently selected feed
+`newsticker--treeview-current-feed' is shifted, if it is t then
+the current feed's parent group is shifted.."
+ (let* ((cur-feed newsticker--treeview-current-feed)
+ (thing (if move-group
+ (newsticker--group-find-parent-group cur-feed)
+ cur-feed))
+ (parent-group (newsticker--group-find-parent-group
+ (if move-group (car thing) thing))))
+ (unless parent-group
+ (error "Group not found!"))
+ (let* ((siblings (cdr parent-group))
+ (pos (cl-position thing siblings :test 'equal))
+ (tpos (+ pos delta ))
+ (new-pos (max 0 (min (length siblings) tpos)))
+ (beg (cl-subseq siblings 0 (min pos new-pos)))
+ (end (cl-subseq siblings (+ 1 (max pos new-pos))))
+ (p (elt siblings new-pos)))
+ (when (not (= pos new-pos))
+ (setcdr parent-group
+ (cl-concatenate 'list
+ beg
+ (if (> delta 0)
+ (list p thing)
+ (list thing p))
+ end))
+ (newsticker--treeview-tree-update)
+ (newsticker-treeview-update)
+ (newsticker-treeview-jump cur-feed)))))
(defun newsticker--count-groups (group)
"Recursively count number of subgroups of GROUP."
@@ -1804,7 +1948,7 @@ Return t if groups have changed, nil otherwise."
(let ((new-feed nil)
(grouped-feeds (newsticker--count-grouped-feeds newsticker-groups)))
(mapc (lambda (f)
- (unless (newsticker--group-find-group-for-feed (car f))
+ (unless (newsticker--group-find-parent-group (car f))
(setq new-feed t)
(newsticker-group-move-feed (car f) nil t)))
(append newsticker-url-list-defaults newsticker-url-list))
@@ -1817,37 +1961,22 @@ Return t if groups have changed, nil otherwise."
;; ======================================================================
;;; Modes
;; ======================================================================
-(defun newsticker--treeview-create-groups-menu (group-list
- excluded-group)
- "Create menu for GROUP-LIST omitting EXCLUDED-GROUP."
- (let ((menu (make-sparse-keymap (if (stringp (car group-list))
- (car group-list)
- "Move to group..."))))
- (mapc (lambda (g)
- (when (listp g)
- (let ((title (if (stringp (car g))
- (car g)
- "Move to group...")))
- (unless (eq g excluded-group)
- (define-key menu (vector (intern title))
- (list 'menu-item title
- (newsticker--treeview-create-groups-menu
- (cdr g) excluded-group)))))))
- (reverse group-list))
- menu))
-
-(defun newsticker--treeview-create-tree-menu (feed-name)
- "Create tree menu for FEED-NAME."
- (let ((menu (make-sparse-keymap feed-name)))
+(defun newsticker--treeview-tree-open-menu (event)
+ "Open tree menu at position of EVENT."
+ (let* ((feed-name newsticker--treeview-current-feed)
+ (menu (make-sparse-keymap feed-name)))
(define-key menu [newsticker-treeview-mark-list-items-old]
(list 'menu-item "Mark all items old"
'newsticker-treeview-mark-list-items-old))
- (define-key menu [move]
- (list 'menu-item "Move to group..."
- (newsticker--treeview-create-groups-menu
- newsticker-groups
- (newsticker--group-get-group feed-name))))
- menu))
+ (define-key menu [newsticker-treeview-get-news]
+ (list 'menu-item (concat "Get news for " feed-name)
+ 'newsticker-treeview-get-news))
+ (define-key menu [newsticker-get-all-news]
+ (list 'menu-item "Get news for all feeds"
+ 'newsticker-get-all-news))
+ (let ((choice (x-popup-menu event menu)))
+ (when choice
+ (funcall (car choice))))))
(defvar newsticker-treeview-list-menu
(let ((menu (make-sparse-keymap "Newsticker List")))
@@ -1906,16 +2035,18 @@ Return t if groups have changed, nil otherwise."
;;(define-key map "\C-m" 'newsticker-treeview-scroll-item)
(define-key map "\M-m" 'newsticker-group-move-feed)
(define-key map "\M-a" 'newsticker-group-add-group)
+ (define-key map "\M-d" 'newsticker-group-delete-group)
+ (define-key map "\M-r" 'newsticker-group-rename-group)
+ (define-key map [M-down] 'newsticker-group-shift-feed-down)
+ (define-key map [M-up] 'newsticker-group-shift-feed-up)
+ (define-key map [M-S-down] 'newsticker-group-shift-group-down)
+ (define-key map [M-S-up] 'newsticker-group-shift-group-up)
map)
"Mode map for newsticker treeview.")
-(defun newsticker-treeview-mode ()
+(define-derived-mode newsticker-treeview-mode fundamental-mode "Newsticker TV"
"Major mode for Newsticker Treeview.
\\{newsticker-treeview-mode-map}"
- (kill-all-local-variables)
- (use-local-map newsticker-treeview-mode-map)
- (setq major-mode 'newsticker-treeview-mode)
- (setq mode-name "Newsticker TV")
(if (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map)
newsticker-treeview-tool-bar-map))
@@ -1954,7 +2085,7 @@ Return t if groups have changed, nil otherwise."
(newsticker--treeview-restore-layout)
(save-excursion
(switch-to-buffer (window-buffer (posn-window (event-end event))))
- (newsticker-treeview-tree-do-click (posn-point (event-end event)))))
+ (newsticker-treeview-tree-do-click (posn-point (event-end event)) event)))
(defun newsticker-treeview-tree-do-click (&optional pos event)
"Actually handle click event.
@@ -1968,13 +2099,17 @@ POS gives the position where EVENT occurred."
(newsticker-treeview-show-item))
(t
;; click in tree buffer
- (let ((w (newsticker--treeview-get-node nt-id)))
+ (let ((w (newsticker--treeview-get-node-by-id nt-id)))
(when w
(newsticker--treeview-tree-update-tag w t t)
- (setq w (newsticker--treeview-get-node nt-id))
+ (setq w (newsticker--treeview-get-node-by-id nt-id))
(widget-put w :nt-selected t)
(widget-apply w :action event)
- (newsticker--treeview-set-current-node w))))))
+ (newsticker--treeview-set-current-node w)
+ (and event
+ (eq 'mouse-3 (car event))
+ (sit-for 0)
+ (newsticker--treeview-tree-open-menu event)))))))
(newsticker--treeview-tree-update-highlight))
(defun newsticker--treeview-restore-layout ()
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index bc95ad30452..9b16c1f0749 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -1,14 +1,12 @@
;;; newsticker.el --- A Newsticker for Emacs.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; Filename: newsticker.el
;; URL: http://www.nongnu.org/newsticker
;; Created: 17. June 2003
;; Keywords: News, RSS, Atom
-;; Time-stamp: "6. Dezember 2009, 19:15:18 (ulf)"
-;; Version: 1.99
;; ======================================================================
@@ -28,6 +26,7 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
(defconst newsticker-version "1.99" "Version number of newsticker.el.")
+(make-obsolete-variable 'newsticker-version 'emacs-version "25.1")
;; ======================================================================
;;; Commentary:
@@ -378,7 +377,7 @@
;; * Remove stupid newlines in titles (headlines) -- Thanks to
;; Jeff Rancier.
-;; 0.94 * Added clickerability and description for channel headings.
+;; 0.94 * Added clickability and description for channel headings.
;; * Made it work for (at least some) rss 0.9<something> feeds.
;; 0.93 * Added some more sites.
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
new file mode 100644
index 00000000000..c54553ae5ea
--- /dev/null
+++ b/lisp/net/nsm.el
@@ -0,0 +1,508 @@
+;;; nsm.el --- Network Security Manager
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Keywords: encryption, security, network
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar nsm-permanent-host-settings nil)
+(defvar nsm-temporary-host-settings nil)
+
+(defgroup nsm nil
+ "Network Security Manager"
+ :version "25.1"
+ :group 'comm)
+
+(defcustom network-security-level 'medium
+ "How secure the network should be.
+If a potential problem with the security of the network
+connection is found, the user is asked to give input into how the
+connection should be handled.
+
+The following values are possible:
+
+`low': Absolutely no checks are performed.
+`medium': This is the default level, should be reasonable for most usage.
+`high': This warns about additional things that many people would
+not find useful.
+`paranoid': On this level, the user is queried for most new connections.
+
+See the Emacs manual for a description of all things that are
+checked and warned against."
+ :version "25.1"
+ :group 'nsm
+ :type '(choice (const :tag "Low" low)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)
+ (const :tag "Paranoid" paranoid)))
+
+(defcustom nsm-settings-file (expand-file-name "network-security.data"
+ user-emacs-directory)
+ "The file the security manager settings will be stored in."
+ :version "25.1"
+ :group 'nsm
+ :type 'file)
+
+(defcustom nsm-save-host-names nil
+ "If non-nil, always save host names in the structures in `nsm-settings-file'.
+By default, only hosts that have exceptions have their names
+stored in plain text."
+ :version "25.1"
+ :group 'nsm
+ :type 'boolean)
+
+(defvar nsm-noninteractive nil
+ "If non-nil, the connection is opened in a non-interactive context.
+This means that no queries should be performed.")
+
+(declare-function gnutls-peer-status "gnutls.c" (proc))
+
+(defun nsm-verify-connection (process host port &optional
+ save-fingerprint warn-unencrypted)
+ "Verify the security status of PROCESS that's connected to HOST:PORT.
+If PROCESS is a gnutls connection, the certificate validity will
+be examined. If it's a non-TLS connection, it may be compared
+against previous connections. If the function determines that
+there is something odd about the connection, the user will be
+queried about what to do about it.
+
+The process it returned if everything is OK, and otherwise, the
+process will be deleted and nil is returned.
+
+If SAVE-FINGERPRINT, always save the fingerprint of the
+server (if the connection is a TLS connection). This is useful
+to keep track of the TLS status of STARTTLS servers.
+
+If WARN-UNENCRYPTED, query the user if the connection is
+unencrypted."
+ (if (eq network-security-level 'low)
+ process
+ (let* ((status (gnutls-peer-status process))
+ (id (nsm-id host port))
+ (settings (nsm-host-settings id)))
+ (cond
+ ((not (process-live-p process))
+ nil)
+ ((not status)
+ ;; This is a non-TLS connection.
+ (nsm-check-plain-connection process host port settings
+ warn-unencrypted))
+ (t
+ (let ((process
+ (nsm-check-tls-connection process host port status settings)))
+ (when (and process save-fingerprint
+ (null (nsm-host-settings id)))
+ (nsm-save-host host port status 'fingerprint 'always))
+ process))))))
+
+(defun nsm-check-tls-connection (process host port status settings)
+ (let ((process (nsm-check-certificate process host port status settings)))
+ (if (and process
+ (>= (nsm-level network-security-level) (nsm-level 'high)))
+ ;; Do further protocol-level checks if the security is high.
+ (nsm-check-protocol process host port status settings)
+ process)))
+
+(declare-function gnutls-peer-status-warning-describe "gnutls.c"
+ (status-symbol))
+
+(defun nsm-check-certificate (process host port status settings)
+ (let ((warnings (plist-get status :warnings)))
+ (cond
+
+ ;; The certificate validated, but perhaps we want to do
+ ;; certificate pinning.
+ ((null warnings)
+ (cond
+ ((< (nsm-level network-security-level) (nsm-level 'high))
+ process)
+ ;; The certificate is fine, but if we're paranoid, we might
+ ;; want to check whether it's changed anyway.
+ ((and (>= (nsm-level network-security-level) (nsm-level 'high))
+ (not (nsm-fingerprint-ok-p host port status settings)))
+ (delete-process process)
+ nil)
+ ;; We haven't seen this before, and we're paranoid.
+ ((and (eq network-security-level 'paranoid)
+ (null settings)
+ (not (nsm-new-fingerprint-ok-p host port status)))
+ (delete-process process)
+ nil)
+ ((>= (nsm-level network-security-level) (nsm-level 'high))
+ ;; Save the host fingerprint so that we can check it the
+ ;; next time we connect.
+ (nsm-save-host host port status 'fingerprint 'always)
+ process)
+ (t
+ process)))
+
+ ;; The certificate did not validate.
+ ((not (equal network-security-level 'low))
+ ;; We always want to pin the certificate of invalid connections
+ ;; to track man-in-the-middle or the like.
+ (if (not (nsm-fingerprint-ok-p host port status settings))
+ (progn
+ (delete-process process)
+ nil)
+ ;; We have a warning, so query the user.
+ (if (and (not (nsm-warnings-ok-p status settings))
+ (not (nsm-query
+ host port status 'conditions
+ "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
+ host port
+ (if (> (length warnings) 1)
+ "s" "")
+ (mapconcat #'gnutls-peer-status-warning-describe
+ warnings
+ "\n"))))
+ (progn
+ (delete-process process)
+ nil)
+ process))))))
+
+(defun nsm-check-protocol (process host port status settings)
+ (let ((prime-bits (plist-get status :diffie-hellman-prime-bits))
+ (encryption (format "%s-%s-%s"
+ (plist-get status :key-exchange)
+ (plist-get status :cipher)
+ (plist-get status :mac)))
+ (protocol (plist-get status :protocol)))
+ (cond
+ ((and prime-bits
+ (< prime-bits 1024)
+ (not (memq :diffie-hellman-prime-bits
+ (plist-get settings :conditions)))
+ (not
+ (nsm-query
+ host port status :diffie-hellman-prime-bits
+ "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)."
+ prime-bits host port 1024)))
+ (delete-process process)
+ nil)
+ ((and (string-match "\\bRC4\\b" encryption)
+ (not (memq :rc4 (plist-get settings :conditions)))
+ (not
+ (nsm-query
+ host port status :rc4
+ "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe."
+ host port encryption)))
+ (delete-process process)
+ nil)
+ ((and protocol
+ (string-match "SSL" protocol)
+ (not (memq :ssl (plist-get settings :conditions)))
+ (not
+ (nsm-query
+ host port status :ssl
+ "The connection to %s:%s uses the %s protocol, which is believed to be unsafe."
+ host port protocol)))
+ (delete-process process)
+ nil)
+ (t
+ process))))
+
+(defun nsm-fingerprint (status)
+ (plist-get (plist-get status :certificate) :public-key-id))
+
+(defun nsm-fingerprint-ok-p (host port status settings)
+ (let ((did-query nil))
+ (if (and settings
+ (not (eq (plist-get settings :fingerprint) :none))
+ (not (equal (nsm-fingerprint status)
+ (plist-get settings :fingerprint)))
+ (not
+ (setq did-query
+ (nsm-query
+ host port status 'fingerprint
+ "The fingerprint for the connection to %s:%s has changed from %s to %s"
+ host port
+ (plist-get settings :fingerprint)
+ (nsm-fingerprint status)))))
+ ;; Not OK.
+ nil
+ (when did-query
+ ;; Remove any exceptions that have been set on the previous
+ ;; certificate.
+ (plist-put settings :conditions nil))
+ t)))
+
+(defun nsm-new-fingerprint-ok-p (host port status)
+ (nsm-query
+ host port status 'fingerprint
+ "The fingerprint for the connection to %s:%s is new: %s"
+ host port
+ (nsm-fingerprint status)))
+
+(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
+ ;; If this connection used to be TLS, but is now plain, then it's
+ ;; possible that we're being Man-In-The-Middled by a proxy that's
+ ;; stripping out STARTTLS announcements.
+ (cond
+ ((and (plist-get settings :fingerprint)
+ (not (eq (plist-get settings :fingerprint) :none))
+ (not
+ (nsm-query
+ host port nil 'conditions
+ "The connection to %s:%s used to be an encrypted connection, but is now unencrypted. This might mean that there's a man-in-the-middle tapping this connection."
+ host port)))
+ (delete-process process)
+ nil)
+ ((and warn-unencrypted
+ (not (memq :unencrypted (plist-get settings :conditions)))
+ (not (nsm-query
+ host port nil 'conditions
+ "The connection to %s:%s is unencrypted."
+ host port)))
+ (delete-process process)
+ nil)
+ (t
+ process)))
+
+(defun nsm-query (host port status what message &rest args)
+ ;; If there is no user to answer queries, then say `no' to everything.
+ (if (or noninteractive
+ nsm-noninteractive)
+ nil
+ (let ((response
+ (condition-case nil
+ (nsm-query-user message args (nsm-format-certificate status))
+ ;; Make sure we manage to close the process if the user hits
+ ;; `C-g'.
+ (quit 'no)
+ (error 'no))))
+ (if (eq response 'no)
+ nil
+ (nsm-save-host host port status what response)
+ t))))
+
+(defun nsm-query-user (message args cert)
+ (let ((buffer (get-buffer-create "*Network Security Manager*")))
+ (with-help-window buffer
+ (with-current-buffer buffer
+ (erase-buffer)
+ (when (> (length cert) 0)
+ (insert cert "\n"))
+ (let ((start (point)))
+ (insert (apply #'format-message message args))
+ (goto-char start)
+ ;; Fill the first line of the message, which usually
+ ;; contains lots of explanatory text.
+ (fill-region (point) (line-end-position)))))
+ (let ((responses '((?n . no)
+ (?s . session)
+ (?a . always)))
+ (prefix "")
+ (cursor-in-echo-area t)
+ response)
+ (while (not response)
+ (setq response
+ (cdr
+ (assq (downcase
+ (read-char
+ (concat prefix
+ "Continue connecting? (No, Session only, Always) ")))
+ responses)))
+ (unless response
+ (ding)
+ (setq prefix "Invalid choice. ")))
+ (kill-buffer buffer)
+ ;; If called from a callback, `read-char' will insert things
+ ;; into the pending input. Clear that.
+ (clear-this-command-keys)
+ response)))
+
+(defun nsm-save-host (host port status what permanency)
+ (let* ((id (nsm-id host port))
+ (saved
+ (list :id id
+ :fingerprint (or (nsm-fingerprint status)
+ ;; Plain connection.
+ :none))))
+ (when (or (eq what 'conditions)
+ nsm-save-host-names)
+ (nconc saved (list :host (format "%s:%s" host port))))
+ ;; We either want to save/update the fingerprint or the conditions
+ ;; of the certificate/unencrypted connection.
+ (cond
+ ((eq what 'conditions)
+ (cond
+ ((not status)
+ (nconc saved '(:conditions (:unencrypted))))
+ ((plist-get status :warnings)
+ (nconc saved
+ (list :conditions (plist-get status :warnings))))))
+ ((not (eq what 'fingerprint))
+ ;; Store additional protocol settings.
+ (let ((settings (nsm-host-settings id)))
+ (when settings
+ (setq saved settings))
+ (if (plist-get saved :conditions)
+ (nconc (plist-get saved :conditions) (list what))
+ (nconc saved (list :conditions (list what)))))))
+ (if (eq permanency 'always)
+ (progn
+ (nsm-remove-temporary-setting id)
+ (nsm-remove-permanent-setting id)
+ (push saved nsm-permanent-host-settings)
+ (nsm-write-settings))
+ (nsm-remove-temporary-setting id)
+ (push saved nsm-temporary-host-settings))))
+
+(defun nsm-write-settings ()
+ (with-temp-file nsm-settings-file
+ (insert "(\n")
+ (dolist (setting nsm-permanent-host-settings)
+ (insert " ")
+ (prin1 setting (current-buffer))
+ (insert "\n"))
+ (insert ")\n")))
+
+(defun nsm-read-settings ()
+ (setq nsm-permanent-host-settings
+ (with-temp-buffer
+ (insert-file-contents nsm-settings-file)
+ (goto-char (point-min))
+ (ignore-errors (read (current-buffer))))))
+
+(defun nsm-id (host port)
+ (concat "sha1:" (sha1 (format "%s:%s" host port))))
+
+(defun nsm-host-settings (id)
+ (when (and (not nsm-permanent-host-settings)
+ (file-exists-p nsm-settings-file))
+ (nsm-read-settings))
+ (let ((result nil))
+ (dolist (elem (append nsm-temporary-host-settings
+ nsm-permanent-host-settings))
+ (when (and (not result)
+ (equal (plist-get elem :id) id))
+ (setq result elem)))
+ result))
+
+(defun nsm-warnings-ok-p (status settings)
+ (let ((ok t)
+ (conditions (plist-get settings :conditions)))
+ (dolist (warning (plist-get status :warnings))
+ (unless (memq warning conditions)
+ (setq ok nil)))
+ ok))
+
+(defun nsm-remove-permanent-setting (id)
+ (setq nsm-permanent-host-settings
+ (cl-delete-if
+ (lambda (elem)
+ (equal (plist-get elem :id) id))
+ nsm-permanent-host-settings)))
+
+(defun nsm-remove-temporary-setting (id)
+ (setq nsm-temporary-host-settings
+ (cl-delete-if
+ (lambda (elem)
+ (equal (plist-get elem :id) id))
+ nsm-temporary-host-settings)))
+
+(defun nsm-format-certificate (status)
+ (let ((cert (plist-get status :certificate)))
+ (when cert
+ (with-temp-buffer
+ (insert
+ "Certificate information\n"
+ "Issued by:"
+ (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
+ "Issued to:"
+ (or (nsm-certificate-part (plist-get cert :subject) "O")
+ (nsm-certificate-part (plist-get cert :subject) "OU" t))
+ "\n"
+ "Hostname:"
+ (nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
+ (when (and (plist-get cert :public-key-algorithm)
+ (plist-get cert :signature-algorithm))
+ (insert
+ "Public key:" (plist-get cert :public-key-algorithm)
+ ", signature: " (plist-get cert :signature-algorithm) "\n"))
+ (when (and (plist-get status :key-exchange)
+ (plist-get status :cipher)
+ (plist-get status :mac)
+ (plist-get status :protocol))
+ (insert
+ "Protocol:" (plist-get status :protocol)
+ ", key: " (plist-get status :key-exchange)
+ ", cipher: " (plist-get status :cipher)
+ ", mac: " (plist-get status :mac) "\n"))
+ (when (plist-get cert :certificate-security-level)
+ (insert
+ "Security level:"
+ (propertize (plist-get cert :certificate-security-level)
+ 'face 'bold)
+ "\n"))
+ (insert
+ "Valid:From " (plist-get cert :valid-from)
+ " to " (plist-get cert :valid-to) "\n\n")
+ (goto-char (point-min))
+ (while (re-search-forward "^[^:]+:" nil t)
+ (insert (make-string (- 20 (current-column)) ? )))
+ (buffer-string)))))
+
+(defun nsm-certificate-part (string part &optional full)
+ (let ((part (cadr (assoc part (nsm-parse-subject string)))))
+ (cond
+ (part part)
+ (full string)
+ (t nil))))
+
+(defun nsm-parse-subject (string)
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (let ((start (point))
+ (result nil))
+ (while (not (eobp))
+ (push (replace-regexp-in-string
+ "[\\]\\(.\\)" "\\1"
+ (buffer-substring start
+ (if (re-search-forward "[^\\]," nil 'move)
+ (1- (point))
+ (point))))
+ result)
+ (setq start (point)))
+ (mapcar
+ (lambda (elem)
+ (let ((pos (cl-position ?= elem)))
+ (if pos
+ (list (substring elem 0 pos)
+ (substring elem (1+ pos)))
+ elem)))
+ (nreverse result)))))
+
+(defun nsm-level (symbol)
+ "Return a numerical level for SYMBOL for easier comparison."
+ (cond
+ ((eq symbol 'low) 0)
+ ((eq symbol 'medium) 1)
+ ((eq symbol 'high) 2)
+ (t 3)))
+
+(provide 'nsm)
+
+;;; nsm.el ends here
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 1a9d99e012f..ff7e79e5aa6 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,10 +1,11 @@
;;; ntlm.el --- NTLM (NT LanManager) authentication support
-;; Copyright (C) 2001, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2007-2015 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
-;; Keywords: NTLM, SASL
-;; Version: 1.00
+;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
+;; Keywords: NTLM, SASL, comm
+;; Version: 2.00
;; Created: February 2001
;; This file is part of GNU Emacs.
@@ -65,6 +66,27 @@
;;; Code:
(require 'md4)
+(require 'hmac-md5)
+(require 'calc)
+
+(defgroup ntlm nil
+ "NTLM (NT LanManager) authentication."
+ :version "25.1"
+ :group 'comm)
+
+(defcustom ntlm-compatibility-level 5
+ "The NTLM compatibility level.
+Ordered from 0, the oldest, least-secure level through 5, the
+newest, most-secure level. Newer servers may reject lower
+levels. At levels 3 through 5, send LMv2 and NTLMv2 responses.
+At levels 0, 1 and 2, send LM and NTLM responses.
+
+In this implementation, levels 0, 1 and 2 are the same (old,
+insecure), and levels 3, 4 and 5 are the same (new, secure). If
+NTLM authentication isn't working at level 5, try level 0. The
+other levels are only present because other clients have six
+levels."
+ :type '(choice (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
;;;
;;; NTLM authentication interface functions
@@ -80,8 +102,8 @@ is not given."
(request-msgType (concat (make-string 1 1) (make-string 3 0)))
;0x01 0x00 0x00 0x00
(request-flags (concat (make-string 1 7) (make-string 1 178)
- (make-string 2 0)))
- ;0x07 0xb2 0x00 0x00
+ (make-string 1 8) (make-string 1 0)))
+ ;0x07 0xb2 0x08 0x00
lu ld off-d off-u)
(when (string-match "@" user)
(unless domain
@@ -112,6 +134,39 @@ is not given."
`(string-as-unibyte ,string)
string)))
+(defun ntlm-compute-timestamp ()
+ "Compute 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."
+ (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)")
+ ;; add trailing zeros to support old current-time formats
+ 'rawnum (append (current-time) '(0 0))))
+ 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))))
+
+(defun ntlm-generate-nonce ()
+ "Generate a random nonce, not to be used more than once.
+Return a random eight byte unibyte string."
+ (unibyte-string
+ (random 256) (random 256) (random 256) (random 256)
+ (random 256) (random 256) (random 256) (random 256)))
+
(defun ntlm-build-auth-response (challenge user password-hashes)
"Return the response string to a challenge string CHALLENGE given by
the NTLM based server for the user USER and the password hash list
@@ -128,9 +183,9 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
uDomain-len uDomain-offs
;; response struct and its fields
lmRespData ;lmRespData, 24 bytes
- ntRespData ;ntRespData, 24 bytes
+ ntRespData ;ntRespData, variable length
domain ;ascii domain string
- lu ld off-lm off-nt off-d off-u off-w off-s)
+ lu ld ln off-lm off-nt off-d off-u off-w off-s)
;; extract domain string from challenge string
(setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
(setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
@@ -144,21 +199,79 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(setq domain (substring user (1+ (match-beginning 0))))
(setq user (substring user 0 (match-beginning 0))))
- ;; generate response data
- (setq lmRespData
- (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
- (setq ntRespData
- (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))
+ (unless (and (integerp ntlm-compatibility-level)
+ (>= ntlm-compatibility-level 0)
+ (<= ntlm-compatibility-level 5))
+ (error "Invalid ntlm-compatibility-level value"))
+ (if (and (>= ntlm-compatibility-level 3)
+ (<= ntlm-compatibility-level 5))
+ ;; extract target information block, if it is present
+ (if (< (cdr uDomain-offs) 48)
+ (error "Failed to find target information block")
+ (let* ((targetInfo-len (md4-unpack-int16 (substring rchallenge
+ 40 42)))
+ (targetInfo-offs (md4-unpack-int32 (substring rchallenge
+ 44 48)))
+ (targetInfo (substring rchallenge
+ (cdr targetInfo-offs)
+ (+ (cdr targetInfo-offs)
+ targetInfo-len)))
+ (upcase-user (upcase (ntlm-ascii2unicode user (length user))))
+ (ntlmv2-hash (hmac-md5 (concat upcase-user
+ (ntlm-ascii2unicode
+ domain (length domain)))
+ (cadr password-hashes)))
+ (nonce (ntlm-generate-nonce))
+ (blob (concat (make-string 2 1)
+ (make-string 2 0) ; blob signature
+ (make-string 4 0) ; reserved value
+ (ntlm-compute-timestamp) ; timestamp
+ nonce ; client nonce
+ (make-string 4 0) ; unknown
+ targetInfo ; target info
+ (make-string 4 0))) ; unknown
+ ;; for reference: LMv2 interim calculation
+ ;; (lm-interim (hmac-md5 (concat challengeData nonce)
+ ;; ntlmv2-hash))
+ (nt-interim (hmac-md5 (concat challengeData blob)
+ ntlmv2-hash)))
+ ;; for reference: LMv2 field, but match other clients that
+ ;; send all zeros
+ ;; (setq lmRespData (concat lm-interim nonce))
+ (setq lmRespData (make-string 24 0))
+ (setq ntRespData (concat nt-interim blob))))
+ ;; compatibility level is 2, 1 or 0
+ ;; level 2 should be treated specially but it's not clear how,
+ ;; so just treat it the same as levels 0 and 1
+ ;; check if "negotiate NTLM2 key" flag is set in type 2 message
+ (if (not (zerop (logand (aref flags 2) 8)))
+ (let (randomString
+ sessionHash)
+ ;; generate NTLM2 session response data
+ (setq randomString (ntlm-generate-nonce))
+ (setq sessionHash (secure-hash 'md5
+ (concat challengeData randomString)
+ nil nil t))
+ (setq sessionHash (substring sessionHash 0 8))
+ (setq lmRespData (concat randomString (make-string 16 0)))
+ (setq ntRespData (ntlm-smb-owf-encrypt
+ (cadr password-hashes) sessionHash)))
+ ;; generate response data
+ (setq lmRespData
+ (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
+ (setq ntRespData
+ (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
;; get offsets to fields to pack the response struct in a string
(setq lu (length user))
(setq ld (length domain))
+ (setq ln (length ntRespData))
(setq off-lm 64) ;offset to string 'lmResponse
(setq off-nt (+ 64 24)) ;offset to string 'ntResponse
- (setq off-d (+ 64 48)) ;offset to string 'uDomain
- (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser
- (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
- (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
+ (setq off-d (+ 64 24 ln)) ;offset to string 'uDomain
+ (setq off-u (+ 64 24 ln (* 2 ld))) ;offset to string 'uUser
+ (setq off-w (+ 64 24 ln (* 2 (+ ld lu)))) ;offset to string 'uWks
+ (setq off-s (+ 64 24 ln (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
;; pack the response struct in a string
(concat "NTLMSSP\0" ;response ident field, 8 bytes
(md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
@@ -170,9 +283,9 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(md4-pack-int32 (cons 0 off-lm)) ;field offset
;; ntResponse field, 8 bytes
- ;;AddBytes(response,ntResponse,ntRespData,24);
- (md4-pack-int16 24) ;len field
- (md4-pack-int16 24) ;maxlen field
+ ;;AddBytes(response,ntResponse,ntRespData,ln);
+ (md4-pack-int16 ln) ;len field
+ (md4-pack-int16 ln) ;maxlen field
(md4-pack-int32 (cons 0 off-nt)) ;field offset
;; uDomain field, 8 bytes
diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el
new file mode 100644
index 00000000000..eaa9fa40b12
--- /dev/null
+++ b/lisp/net/pinentry.el
@@ -0,0 +1,452 @@
+;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Daiki Ueno <ueno@gnu.org>
+;; Version: 0.1
+;; Keywords: GnuPG
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package allows GnuPG passphrase to be prompted through the
+;; minibuffer instead of graphical dialog.
+;;
+;; To use, add allow-emacs-pinentry to ~/.gnupg/gpg-agent.conf, and
+;; start the server with M-x pinentry-start.
+;;
+;; The actual communication path between the relevant components is
+;; as follows:
+;;
+;; gpg --> gpg-agent --> pinentry --> Emacs
+;;
+;; where pinentry and Emacs communicate through a Unix domain socket
+;; created at:
+;;
+;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
+;;
+;; under the same directory which server.el uses. The protocol is a
+;; subset of the Pinentry Assuan protocol described in (info
+;; "(pinentry) Protocol").
+;;
+;; NOTE: As of August 2015, this feature requires newer versions of
+;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
+
+;;; Code:
+
+(defgroup pinentry nil
+ "The Pinentry server"
+ :version "25.1"
+ :group 'external)
+
+(defcustom pinentry-popup-prompt-window t
+ "If non-nil, display multiline prompt in another window."
+ :type 'boolean
+ :group 'pinentry)
+
+(defcustom pinentry-prompt-window-height 5
+ "Number of lines used to display multiline prompt."
+ :type 'integer
+ :group 'pinentry)
+
+(defvar pinentry-debug nil)
+(defvar pinentry-debug-buffer nil)
+(defvar pinentry--server-process nil)
+(defvar pinentry--connection-process-list nil)
+
+(defvar pinentry--labels nil)
+(put 'pinentry-read-point 'permanent-local t)
+(defvar pinentry--read-point nil)
+(put 'pinentry--read-point 'permanent-local t)
+
+(defvar pinentry--prompt-buffer nil)
+
+;; We use the same location as `server-socket-dir', when local sockets
+;; are supported.
+(defvar pinentry--socket-dir
+ (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
+ "The directory in which to place the server socket.
+If local sockets are not supported, this is nil.")
+
+(defconst pinentry--set-label-commands
+ '("SETPROMPT" "SETTITLE" "SETDESC"
+ "SETREPEAT" "SETREPEATERROR"
+ "SETOK" "SETCANCEL" "SETNOTOK"))
+
+;; These error codes are defined in libgpg-error/src/err-codes.h.in.
+(defmacro pinentry--error-code (code)
+ (logior (lsh 5 24) code))
+(defconst pinentry--error-not-implemented
+ (cons (pinentry--error-code 69) "not implemented"))
+(defconst pinentry--error-cancelled
+ (cons (pinentry--error-code 99) "cancelled"))
+(defconst pinentry--error-not-confirmed
+ (cons (pinentry--error-code 114) "not confirmed"))
+
+(autoload 'server-ensure-safe-dir "server")
+
+(defvar pinentry-prompt-mode-map
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "q" 'quit-window)
+ keymap))
+
+(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
+ "Major mode for `pinentry--prompt-buffer'."
+ (buffer-disable-undo)
+ (setq truncate-lines t
+ buffer-read-only t))
+
+(defun pinentry--prompt (labels query-function &rest query-args)
+ (let ((desc (cdr (assq 'desc labels)))
+ (error (cdr (assq 'error labels)))
+ (prompt (cdr (assq 'prompt labels))))
+ (when (string-match "[ \n]*\\'" prompt)
+ (setq prompt (concat
+ (substring
+ prompt 0 (match-beginning 0)) " ")))
+ (when error
+ (setq desc (concat "Error: " (propertize error 'face 'error)
+ "\n" desc)))
+ (if (and desc pinentry-popup-prompt-window)
+ (save-window-excursion
+ (delete-other-windows)
+ (unless (and pinentry--prompt-buffer
+ (buffer-live-p pinentry--prompt-buffer))
+ (setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
+ (if (get-buffer-window pinentry--prompt-buffer)
+ (delete-window (get-buffer-window pinentry--prompt-buffer)))
+ (with-current-buffer pinentry--prompt-buffer
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (insert desc))
+ (pinentry-prompt-mode)
+ (goto-char (point-min)))
+ (if (> (window-height)
+ pinentry-prompt-window-height)
+ (set-window-buffer (split-window nil
+ (- (window-height)
+ pinentry-prompt-window-height))
+ pinentry--prompt-buffer)
+ (pop-to-buffer pinentry--prompt-buffer)
+ (if (> (window-height) pinentry-prompt-window-height)
+ (shrink-window (- (window-height)
+ pinentry-prompt-window-height))))
+ (prog1 (apply query-function prompt query-args)
+ (quit-window)))
+ (apply query-function (concat desc "\n" prompt) query-args))))
+
+;;;###autoload
+(defun pinentry-start ()
+ "Start a Pinentry service.
+
+Once the environment is properly set, subsequent invocations of
+the gpg command will interact with Emacs for passphrase input."
+ (interactive)
+ (unless (featurep 'make-network-process '(:family local))
+ (error "local sockets are not supported"))
+ (if (process-live-p pinentry--server-process)
+ (message "Pinentry service is already running")
+ (let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
+ (server-ensure-safe-dir pinentry--socket-dir)
+ ;; Delete the socket files made by previous server invocations.
+ (ignore-errors
+ (let (delete-by-moving-to-trash)
+ (delete-file server-file)))
+ (setq pinentry--server-process
+ (make-network-process
+ :name "pinentry"
+ :server t
+ :noquery t
+ :sentinel #'pinentry--process-sentinel
+ :filter #'pinentry--process-filter
+ :coding 'no-conversion
+ :family 'local
+ :service server-file))
+ (process-put pinentry--server-process :server-file server-file))))
+
+(defun pinentry-stop ()
+ "Stop a Pinentry service."
+ (interactive)
+ (when (process-live-p pinentry--server-process)
+ (delete-process pinentry--server-process))
+ (setq pinentry--server-process nil)
+ (dolist (process pinentry--connection-process-list)
+ (when (buffer-live-p (process-buffer process))
+ (kill-buffer (process-buffer process))))
+ (setq pinentry--connection-process-list nil))
+
+(defun pinentry--labels-to-shortcuts (labels)
+ "Convert strings in LABEL by stripping mnemonics."
+ (mapcar (lambda (label)
+ (when label
+ (let (c)
+ (if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
+ (let ((key (match-string 1 label)))
+ (setq c (downcase (aref key 0)))
+ (setq label (replace-match
+ (propertize key 'face 'underline)
+ t t label)))
+ (setq c (if (= (length label) 0)
+ ??
+ (downcase (aref label 0)))))
+ ;; Double underscores mean a single underscore.
+ (when (string-match "__" label)
+ (setq label (replace-match "_" t t label)))
+ (cons c label))))
+ labels))
+
+(defun pinentry--escape-string (string)
+ "Escape STRING in the Assuan percent escape."
+ (let ((length (length string))
+ (index 0)
+ (count 0))
+ (while (< index length)
+ (if (memq (aref string index) '(?\n ?\r ?%))
+ (setq count (1+ count)))
+ (setq index (1+ index)))
+ (setq index 0)
+ (let ((result (make-string (+ length (* count 2)) ?\0))
+ (result-index 0)
+ c)
+ (while (< index length)
+ (setq c (aref string index))
+ (if (memq c '(?\n ?\r ?%))
+ (let ((hex (format "%02X" c)))
+ (aset result result-index ?%)
+ (setq result-index (1+ result-index))
+ (aset result result-index (aref hex 0))
+ (setq result-index (1+ result-index))
+ (aset result result-index (aref hex 1))
+ (setq result-index (1+ result-index)))
+ (aset result result-index c)
+ (setq result-index (1+ result-index)))
+ (setq index (1+ index)))
+ result)))
+
+(defun pinentry--unescape-string (string)
+ "Unescape STRING in the Assuan percent escape."
+ (let ((length (length string))
+ (index 0))
+ (let ((result (make-string length ?\0))
+ (result-index 0)
+ c)
+ (while (< index length)
+ (setq c (aref string index))
+ (if (and (eq c '?%) (< (+ index 2) length))
+ (progn
+ (aset result result-index
+ (string-to-number (substring string
+ (1+ index)
+ (+ index 3))
+ 16))
+ (setq result-index (1+ result-index))
+ (setq index (+ index 2)))
+ (aset result result-index c)
+ (setq result-index (1+ result-index)))
+ (setq index (1+ index)))
+ (substring result 0 result-index))))
+
+(defun pinentry--send-data (process escaped)
+ "Send a string ESCAPED to a process PROCESS.
+ESCAPED will be split if it exceeds the line length limit of the
+Assuan protocol."
+ (let ((length (length escaped))
+ (index 0))
+ (if (= length 0)
+ (process-send-string process "D \n")
+ (while (< index length)
+ ;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
+ (let* ((sub-length (min (- length index) 997))
+ (sub (substring escaped index (+ index sub-length))))
+ (unwind-protect
+ (progn
+ (process-send-string process "D ")
+ (process-send-string process sub)
+ (process-send-string process "\n"))
+ (clear-string sub))
+ (setq index (+ index sub-length)))))))
+
+(defun pinentry--send-error (process error)
+ (process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
+
+(defun pinentry--process-filter (process input)
+ (unless (buffer-live-p (process-buffer process))
+ (let ((buffer (generate-new-buffer " *pinentry*")))
+ (set-process-buffer process buffer)
+ (with-current-buffer buffer
+ (if (fboundp 'set-buffer-multibyte)
+ (set-buffer-multibyte nil))
+ (make-local-variable 'pinentry--read-point)
+ (setq pinentry--read-point (point-min))
+ (make-local-variable 'pinentry--labels))))
+ (with-current-buffer (process-buffer process)
+ (when pinentry-debug
+ (with-current-buffer
+ (or pinentry-debug-buffer
+ (setq pinentry-debug-buffer (generate-new-buffer
+ " *pinentry-debug*")))
+ (goto-char (point-max))
+ (insert input)))
+ (save-excursion
+ (goto-char (point-max))
+ (insert input)
+ (goto-char pinentry--read-point)
+ (beginning-of-line)
+ (while (looking-at ".*\n") ;the input line finished
+ (if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
+ (let ((command (match-string 1))
+ (string (pinentry--unescape-string (match-string 2))))
+ (pcase command
+ ((and set (guard (member set pinentry--set-label-commands)))
+ (when (> (length string) 0)
+ (let* ((symbol (intern (downcase (substring set 3))))
+ (entry (assq symbol pinentry--labels))
+ (label (decode-coding-string string 'utf-8)))
+ (if entry
+ (setcdr entry label)
+ (push (cons symbol label) pinentry--labels))))
+ (ignore-errors
+ (process-send-string process "OK\n")))
+ ("NOP"
+ (ignore-errors
+ (process-send-string process "OK\n")))
+ ("GETPIN"
+ (let ((confirm (not (null (assq 'repeat pinentry--labels))))
+ passphrase escaped-passphrase encoded-passphrase)
+ (unwind-protect
+ (condition-case err
+ (progn
+ (setq passphrase
+ (pinentry--prompt
+ pinentry--labels
+ #'read-passwd confirm))
+ (setq escaped-passphrase
+ (pinentry--escape-string
+ passphrase))
+ (setq encoded-passphrase (encode-coding-string
+ escaped-passphrase
+ 'utf-8))
+ (ignore-errors
+ (pinentry--send-data
+ process encoded-passphrase)
+ (process-send-string process "OK\n")))
+ (error
+ (message "GETPIN error %S" err)
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled))))
+ (if passphrase
+ (clear-string passphrase))
+ (if escaped-passphrase
+ (clear-string escaped-passphrase))
+ (if encoded-passphrase
+ (clear-string encoded-passphrase))))
+ (setq pinentry--labels nil))
+ ("CONFIRM"
+ (let ((prompt
+ (or (cdr (assq 'prompt pinentry--labels))
+ "Confirm? "))
+ (buttons
+ (delq nil
+ (pinentry--labels-to-shortcuts
+ (list (cdr (assq 'ok pinentry--labels))
+ (cdr (assq 'notok pinentry--labels))
+ (cdr (assq 'cancel pinentry--labels))))))
+ entry)
+ (if buttons
+ (progn
+ (setq prompt
+ (concat prompt " ("
+ (mapconcat #'cdr buttons
+ ", ")
+ ") "))
+ (if (setq entry (assq 'prompt pinentry--labels))
+ (setcdr entry prompt)
+ (setq pinentry--labels (cons (cons 'prompt prompt)
+ pinentry--labels)))
+ (condition-case nil
+ (let ((result (pinentry--prompt pinentry--labels
+ #'read-char)))
+ (if (eq result (caar buttons))
+ (ignore-errors
+ (process-send-string process "OK\n"))
+ (if (eq result (car (nth 1 buttons)))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-confirmed))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled)))))
+ (error
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-cancelled)))))
+ (if (setq entry (assq 'prompt pinentry--labels))
+ (setcdr entry prompt)
+ (setq pinentry--labels (cons (cons 'prompt prompt)
+ pinentry--labels)))
+ (if (condition-case nil
+ (pinentry--prompt pinentry--labels #'y-or-n-p)
+ (quit))
+ (ignore-errors
+ (process-send-string process "OK\n"))
+ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-confirmed))))
+ (setq pinentry--labels nil)))
+ (_ (ignore-errors
+ (pinentry--send-error
+ process
+ pinentry--error-not-implemented))))
+ (forward-line)
+ (setq pinentry--read-point (point))))))))
+
+(defun pinentry--process-sentinel (process _status)
+ "The process sentinel for Emacs server connections."
+ ;; If this is a new client process, set the query-on-exit flag to nil
+ ;; for this process (it isn't inherited from the server process).
+ (when (and (eq (process-status process) 'open)
+ (process-query-on-exit-flag process))
+ (push process pinentry--connection-process-list)
+ (set-process-query-on-exit-flag process nil)
+ (ignore-errors
+ (process-send-string process "OK Your orders please\n")))
+ ;; Kill the process buffer of the connection process.
+ (when (and (not (process-contact process :server))
+ (eq (process-status process) 'closed))
+ (when (buffer-live-p (process-buffer process))
+ (kill-buffer (process-buffer process)))
+ (setq pinentry--connection-process-list
+ (delq process pinentry--connection-process-list)))
+ ;; Delete the associated connection file, if applicable.
+ ;; Although there's no 100% guarantee that the file is owned by the
+ ;; running Emacs instance, server-start uses server-running-p to check
+ ;; for possible servers before doing anything, so it *should* be ours.
+ (and (process-contact process :server)
+ (eq (process-status process) 'closed)
+ (ignore-errors
+ (delete-file (process-get process :server-file)))))
+
+(provide 'pinentry)
+
+;;; pinentry.el ends here
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index 1e05d8db336..2d571254d35 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -1,6 +1,6 @@
;;; quickurl.el --- insert a URL based on text at point in buffer
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Maintainer: Dave Pearson <davep@davep.org>
@@ -97,6 +97,7 @@
(defcustom quickurl-url-file
(locate-user-emacs-file "quickurls" ".quickurls")
"File that contains the URL list."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'quickurl)
@@ -429,18 +430,12 @@ current buffer, this default action can be modified via
(put 'quickurl-list-mode 'mode-class 'special)
;;;###autoload
-(defun quickurl-list-mode ()
+(define-derived-mode quickurl-list-mode fundamental-mode "quickurl list"
"A mode for browsing the quickurl URL list.
The key bindings for `quickurl-list-mode' are:
\\{quickurl-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map quickurl-list-mode-map)
- (setq major-mode 'quickurl-list-mode
- mode-name "quickurl list")
- (run-mode-hooks 'quickurl-list-mode-hook)
(setq buffer-read-only t
truncate-lines t))
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 2d8da415295..d58f3ebd4ea 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1,10 +1,10 @@
-;;; rcirc.el --- default, simple IRC client.
+;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*-
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Ryan Yeske <rcyeske@gmail.com>
;; Maintainers: Ryan Yeske <rcyeske@gmail.com>,
-;; Deniz Dogan <deniz@dogan.se>
+;; Leo Liu <sdl.web@gmail.com>
;; Keywords: comm
;; This file is part of GNU Emacs.
@@ -43,9 +43,9 @@
;;; Code:
+(require 'cl-lib)
(require 'ring)
(require 'time-date)
-(eval-when-compile (require 'cl))
(defgroup rcirc nil
"Simple IRC client."
@@ -145,11 +145,13 @@ for connections using SSL/TLS."
(defcustom rcirc-fill-column nil
"Column beyond which automatic line-wrapping should happen.
-If nil, use value of `fill-column'. If 'frame-width, use the
-maximum frame width."
- :type '(choice (const :tag "Value of `fill-column'")
- (const :tag "Full frame width" frame-width)
- (integer :tag "Number of columns"))
+If nil, use value of `fill-column'.
+If a function (e.g., `frame-text-width' or `window-text-width'),
+call it to compute the number of columns."
+ :risky t ; can get funcalled
+ :type '(choice (const :tag "Value of `fill-column'" nil)
+ (integer :tag "Number of columns")
+ (function :tag "Function returning the number of columns"))
:group 'rcirc)
(defcustom rcirc-fill-prefix nil
@@ -489,7 +491,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(when (string= server (process-name p))
(setq connected p)))
(if (not connected)
- (condition-case e
+ (condition-case nil
(rcirc-connect server port nick user-name
full-name channels password encryption)
(quit (message "Quit connecting to %s" server)))
@@ -521,6 +523,7 @@ If ARG is non-nil, instead prompt for connection parameters."
(defvar rcirc-user-authenticated nil)
(defvar rcirc-user-disconnect nil)
(defvar rcirc-connecting nil)
+(defvar rcirc-connection-info nil)
(defvar rcirc-process nil)
;;;###autoload
@@ -549,22 +552,23 @@ If ARG is non-nil, instead prompt for connection parameters."
(set-process-sentinel process 'rcirc-sentinel)
(set-process-filter process 'rcirc-filter)
- (set (make-local-variable 'rcirc-process) process)
- (set (make-local-variable 'rcirc-server) server)
- (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response.
- (set (make-local-variable 'rcirc-buffer-alist) nil)
- (set (make-local-variable 'rcirc-nick-table)
- (make-hash-table :test 'equal))
- (set (make-local-variable 'rcirc-nick) nick)
- (set (make-local-variable 'rcirc-process-output) nil)
- (set (make-local-variable 'rcirc-startup-channels) startup-channels)
- (set (make-local-variable 'rcirc-last-server-message-time)
- (current-time))
-
- (set (make-local-variable 'rcirc-timeout-timer) nil)
- (set (make-local-variable 'rcirc-user-disconnect) nil)
- (set (make-local-variable 'rcirc-user-authenticated) nil)
- (set (make-local-variable 'rcirc-connecting) t)
+ (setq-local rcirc-connection-info
+ (list server port nick user-name full-name startup-channels
+ password encryption))
+ (setq-local rcirc-process process)
+ (setq-local rcirc-server server)
+ (setq-local rcirc-server-name server) ; Update when we get 001 response.
+ (setq-local rcirc-buffer-alist nil)
+ (setq-local rcirc-nick-table (make-hash-table :test 'equal))
+ (setq-local rcirc-nick nick)
+ (setq-local rcirc-process-output nil)
+ (setq-local rcirc-startup-channels startup-channels)
+ (setq-local rcirc-last-server-message-time (current-time))
+
+ (setq-local rcirc-timeout-timer nil)
+ (setq-local rcirc-user-disconnect nil)
+ (setq-local rcirc-user-authenticated nil)
+ (setq-local rcirc-connecting t)
(add-hook 'auto-save-hook 'rcirc-log-write)
@@ -595,10 +599,10 @@ If ARG is non-nil, instead prompt for connection parameters."
`(with-current-buffer rcirc-server-buffer
,@body))
-(defun rcirc-float-time ()
+(defalias 'rcirc-float-time
(if (featurep 'xemacs)
- (time-to-seconds (current-time))
- (float-time)))
+ 'time-to-seconds
+ 'float-time))
(defun rcirc-prompt-for-encryption (server-plist)
"Prompt the user for the encryption method to use.
@@ -629,7 +633,7 @@ last ping."
(cancel-timer rcirc-keepalive-timer))
(setq rcirc-keepalive-timer nil)))
-(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message)
+(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message)
(with-rcirc-process-buffer process
(setq header-line-format (format "%f" (- (rcirc-float-time)
(string-to-number message))))))
@@ -656,6 +660,16 @@ is non-nil."
"Hook functions called when the process sentinel is called.
Functions are called with PROCESS and SENTINEL arguments.")
+(defcustom rcirc-reconnect-delay 0
+ "The minimum interval in seconds between reconnect attempts.
+When 0, do not auto-reconnect."
+ :version "25.1"
+ :type 'integer
+ :group 'rcirc)
+
+(defvar rcirc-last-connect-time nil
+ "The last time the buffer was connected.")
+
(defun rcirc-sentinel (process sentinel)
"Called when PROCESS receives SENTINEL."
(let ((sentinel (replace-regexp-in-string "\n" "" sentinel)))
@@ -667,8 +681,17 @@ Functions are called with PROCESS and SENTINEL arguments.")
(format "%s: %s (%S)"
(process-name process)
sentinel
- (process-status process)) (not rcirc-target))
+ (process-status process))
+ (not rcirc-target))
(rcirc-disconnect-buffer)))
+ (when (and (string= sentinel "deleted")
+ (< 0 rcirc-reconnect-delay))
+ (let ((now (current-time)))
+ (when (or (null rcirc-last-connect-time)
+ (< rcirc-reconnect-delay
+ (float-time (time-subtract now rcirc-last-connect-time))))
+ (setq rcirc-last-connect-time now)
+ (rcirc-cmd-reconnect nil))))
(run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
(defun rcirc-disconnect-buffer (&optional buffer)
@@ -752,7 +775,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defvar rcirc-responses-no-activity '("305" "306")
"Responses that don't trigger activity in the mode-line indicator.")
-(defun rcirc-handler-generic (process response sender args text)
+(defun rcirc-handler-generic (process response sender args _text)
"Generic server response handler."
(rcirc-print process sender response nil
(mapconcat 'identity (cdr args) " ")
@@ -782,11 +805,11 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.")
(defun rcirc-buffer-process (&optional buffer)
"Return the process associated with channel BUFFER.
With no argument or nil as argument, use the current buffer."
- (or (get-buffer-process (if buffer
- (with-current-buffer buffer
- rcirc-server-buffer)
- rcirc-server-buffer))
- rcirc-process))
+ (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer)
+ rcirc-server-buffer))))
+ (if buffer
+ (with-current-buffer buffer rcirc-process)
+ rcirc-process)))
(defun rcirc-server-name (process)
"Return PROCESS server name, given by the 001 response."
@@ -881,7 +904,10 @@ The list is updated automatically by `defun-rcirc-command'.")
"Function used for `completion-at-point-functions' in `rcirc-mode'."
(and (rcirc-looking-at-input)
(let* ((beg (save-excursion
- (if (re-search-backward " " rcirc-prompt-end-marker t)
+ ;; On some networks it is common to message or
+ ;; mention someone using @nick instead of just
+ ;; nick.
+ (if (re-search-backward "[[:space:]@]" rcirc-prompt-end-marker t)
(1+ (point))
rcirc-prompt-end-marker)))
(table (if (and (= beg rcirc-prompt-end-marker)
@@ -900,7 +926,7 @@ The list is updated automatically by `defun-rcirc-command'.")
(defun rcirc-complete ()
"Cycle through completions from list of nicks in channel or IRC commands.
-IRC command completion is performed only if '/' is the first input char."
+IRC command completion is performed only if `/' is the first input char."
(interactive)
(unless (rcirc-looking-at-input)
(error "Point not located after rcirc prompt"))
@@ -928,12 +954,12 @@ IRC command completion is performed only if '/' is the first input char."
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
(interactive "zCoding system for incoming messages: ")
- (set (make-local-variable 'rcirc-decode-coding-system) coding-system))
+ (setq-local rcirc-decode-coding-system coding-system))
(defun set-rcirc-encode-coding-system (coding-system)
"Set the encode coding system used in this channel."
(interactive "zCoding system for outgoing messages: ")
- (set (make-local-variable 'rcirc-encode-coding-system) coding-system))
+ (setq-local rcirc-encode-coding-system coding-system))
(defvar rcirc-mode-map
(let ((map (make-sparse-keymap)))
@@ -990,25 +1016,26 @@ This number is independent of the number of lines in the buffer.")
(setq major-mode 'rcirc-mode)
(setq mode-line-process nil)
- (set (make-local-variable 'rcirc-input-ring)
- ;; If rcirc-input-ring is already a ring with desired size do
- ;; not re-initialize.
- (if (and (ring-p rcirc-input-ring)
- (= (ring-size rcirc-input-ring)
- rcirc-input-ring-size))
- rcirc-input-ring
- (make-ring rcirc-input-ring-size)))
- (set (make-local-variable 'rcirc-server-buffer) (process-buffer process))
- (set (make-local-variable 'rcirc-target) target)
- (set (make-local-variable 'rcirc-topic) nil)
- (set (make-local-variable 'rcirc-last-post-time) (current-time))
- (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph)
- (set (make-local-variable 'rcirc-recent-quit-alist) nil)
- (set (make-local-variable 'rcirc-current-line) 0)
+ (setq-local rcirc-input-ring
+ ;; If rcirc-input-ring is already a ring with desired
+ ;; size do not re-initialize.
+ (if (and (ring-p rcirc-input-ring)
+ (= (ring-size rcirc-input-ring)
+ rcirc-input-ring-size))
+ rcirc-input-ring
+ (make-ring rcirc-input-ring-size)))
+ (setq-local rcirc-server-buffer (process-buffer process))
+ (setq-local rcirc-target target)
+ (setq-local rcirc-topic nil)
+ (setq-local rcirc-last-post-time (current-time))
+ (setq-local fill-paragraph-function 'rcirc-fill-paragraph)
+ (setq-local rcirc-recent-quit-alist nil)
+ (setq-local rcirc-current-line 0)
+ (setq-local rcirc-last-connect-time (current-time))
(use-hard-newlines t)
- (set (make-local-variable 'rcirc-short-buffer-name) nil)
- (set (make-local-variable 'rcirc-urls) nil)
+ (setq-local rcirc-short-buffer-name nil)
+ (setq-local rcirc-urls nil)
;; setup for omitting responses
(setq buffer-invisibility-spec '())
@@ -1023,18 +1050,18 @@ This number is independent of the number of lines in the buffer.")
(serv (if (consp (car i)) (cdar i) "")))
(when (and (string-match chan (or target ""))
(string-match serv (rcirc-server-name process)))
- (set (make-local-variable 'rcirc-decode-coding-system)
- (if (consp (cdr i)) (cadr i) (cdr i)))
- (set (make-local-variable 'rcirc-encode-coding-system)
- (if (consp (cdr i)) (cddr i) (cdr i))))))
+ (setq-local rcirc-decode-coding-system
+ (if (consp (cdr i)) (cadr i) (cdr i)))
+ (setq-local rcirc-encode-coding-system
+ (if (consp (cdr i)) (cddr i) (cdr i))))))
;; setup the prompt and markers
- (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker))
- (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker))
+ (setq-local rcirc-prompt-start-marker (point-max-marker))
+ (setq-local rcirc-prompt-end-marker (point-max-marker))
(rcirc-update-prompt)
(goto-char rcirc-prompt-end-marker)
- (set (make-local-variable 'overlay-arrow-position) (make-marker))
+ (setq-local overlay-arrow-position (make-marker))
;; if the user changes the major mode or kills the buffer, there is
;; cleanup work to do
@@ -1222,13 +1249,13 @@ Create the buffer if it doesn't exist."
(ring-insert rcirc-input-ring input)
(setq rcirc-input-ring-index 0))))))
-(defun rcirc-fill-paragraph (&optional arg)
- (interactive "p")
+(defun rcirc-fill-paragraph (&optional justify)
+ (interactive "P")
(when (> (point) rcirc-prompt-end-marker)
(save-restriction
(narrow-to-region rcirc-prompt-end-marker (point-max))
(let ((fill-column rcirc-max-message-length))
- (fill-region (point-min) (point-max))))))
+ (fill-region (point-min) (point-max) justify)))))
(defun rcirc-process-input-line (line)
(if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line)
@@ -1348,7 +1375,7 @@ if ARG is omitted or nil."
(t . "%fp*** %fs%n %r %m"))
"An alist of formats used for printing responses.
The format is looked up using the response-type as a key;
-if no match is found, the default entry (with a key of `t') is used.
+if no match is found, the default entry (with a key of t) is used.
The entry's value part should be a string, which is inserted with
the of the following escape sequences replaced by the described values:
@@ -1393,9 +1420,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(rcirc-add-face start (match-beginning 0) face)
(setq start (match-beginning 0))
(replace-match
- (case (aref (match-string 1) 0)
+ (cl-case (aref (match-string 1) 0)
(?f (setq face
- (case (string-to-char (match-string 3))
+ (cl-case (string-to-char (match-string 3))
(?w 'font-lock-warning-face)
(?p 'rcirc-server-prefix)
(?s 'rcirc-server)
@@ -1431,9 +1458,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'."
(rcirc-add-face start (match-beginning 0) face))
(buffer-substring (point-min) (point-max))))
-(defun rcirc-target-buffer (process sender response target text)
+(defun rcirc-target-buffer (process sender response target _text)
"Return a buffer to print the server response."
- (assert (not (bufferp target)))
+ (cl-assert (not (bufferp target)))
(with-rcirc-process-buffer process
(cond ((not target)
(rcirc-any-buffer process))
@@ -1474,11 +1501,10 @@ Returns nil if the information is not recorded."
(defun rcirc-last-line (process nick target)
"Return the line from the last activity from NICK in TARGET."
- (let* ((chanbuf (rcirc-get-buffer process target))
- (line (or (cdr (assoc-string target
- (gethash nick (with-rcirc-server-buffer
- rcirc-nick-table)) t))
- (rcirc-last-quit-line process nick target))))
+ (let ((line (or (cdr (assoc-string target
+ (gethash nick (with-rcirc-server-buffer
+ rcirc-nick-table)) t))
+ (rcirc-last-quit-line process nick target))))
(if line
line
;;(message "line is nil for %s in %s" nick target)
@@ -1883,7 +1909,9 @@ Uninteresting lines are those whose responses are listed in
(message "Rcirc-Omit mode enabled"))
(remove-from-invisibility-spec '(rcirc-omit . nil))
(message "Rcirc-Omit mode disabled"))
- (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
+ (dolist (window (get-buffer-window-list (current-buffer)))
+ (with-selected-window window
+ (recenter (when (> (point) rcirc-prompt-start-marker) -1)))))
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
@@ -1899,17 +1927,13 @@ Uninteresting lines are those whose responses are listed in
(goto-char overlay-arrow-position)
(message "No unread messages")))
-(defun rcirc-non-irc-buffer ()
- (let ((buflist (buffer-list))
- buffer)
- (while (and buflist (not buffer))
- (with-current-buffer (car buflist)
- (unless (or (eq major-mode 'rcirc-mode)
- (= ?\s (aref (buffer-name) 0)) ; internal buffers
- (get-buffer-window (current-buffer)))
- (setq buffer (current-buffer))))
- (setq buflist (cdr buflist)))
- buffer))
+(defun rcirc-bury-buffers ()
+ "Bury all RCIRC buffers."
+ (interactive)
+ (dolist (buf (buffer-list))
+ (when (eq 'rcirc-mode (with-current-buffer buf major-mode))
+ (bury-buffer buf) ; buffers not shown
+ (quit-windows-on buf)))) ; buffers shown in a window
(defun rcirc-next-active-buffer (arg)
"Switch to the next rcirc buffer with activity.
@@ -1924,15 +1948,13 @@ With prefix ARG, go to the next low priority buffer with activity."
(switch-to-buffer (car (if arg lopri hipri)))
(when (> (point) rcirc-prompt-start-marker)
(recenter -1)))
- (if (eq major-mode 'rcirc-mode)
- (switch-to-buffer (rcirc-non-irc-buffer))
- (message "%s" (concat
- "No IRC activity."
- (when lopri
- (concat
- " Type C-u "
- (key-description (this-command-keys))
- " for low priority activity."))))))))
+ (rcirc-bury-buffers)
+ (message "No IRC activity.%s"
+ (if lopri
+ (concat
+ " Type C-u " (key-description (this-command-keys))
+ " for low priority activity.")
+ "")))))
(define-obsolete-variable-alias 'rcirc-activity-hooks
'rcirc-activity-functions "24.3")
@@ -1950,12 +1972,13 @@ activity. Only run if the buffer is not visible and
(old-types rcirc-activity-types))
(when (not (get-buffer-window (current-buffer) t))
(setq rcirc-activity
- (sort (add-to-list 'rcirc-activity (current-buffer))
+ (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity
+ (cons (current-buffer) rcirc-activity))
(lambda (b1 b2)
(let ((t1 (with-current-buffer b1 rcirc-last-post-time))
(t2 (with-current-buffer b2 rcirc-last-post-time)))
(time-less-p t2 t1)))))
- (pushnew type rcirc-activity-types)
+ (cl-pushnew type rcirc-activity-types)
(unless (and (equal rcirc-activity old-activity)
(member type old-types))
(rcirc-update-activity-string)))))
@@ -1976,13 +1999,13 @@ activity. Only run if the buffer is not visible and
(defun rcirc-split-activity (activity)
"Return a cons cell with ACTIVITY split into (lopri . hipri)."
(let (lopri hipri)
- (dolist (buf rcirc-activity)
+ (dolist (buf activity)
(with-current-buffer buf
(if (and rcirc-low-priority-flag
(not (member 'nick rcirc-activity-types)))
- (add-to-list 'lopri buf t)
- (add-to-list 'hipri buf t))))
- (cons lopri hipri)))
+ (push buf lopri)
+ (push buf hipri))))
+ (cons (nreverse lopri) (nreverse hipri))))
(defvar rcirc-update-activity-string-hook nil
"Hook run whenever the activity string is updated.")
@@ -2014,7 +2037,7 @@ activity. Only run if the buffer is not visible and
(with-current-buffer b
(dolist (type rcirc-activity-types)
(rcirc-add-face 0 (length s)
- (case type
+ (cl-case type
(nick 'rcirc-track-nick)
(keyword 'rcirc-track-keyword))
s)))
@@ -2122,7 +2145,7 @@ activity. Only run if the buffer is not visible and
(when (and (listp x) (listp (cadr x)))
(setcdr x (if (> (length (cdr x)) 1)
(rcirc-make-trees (cdr x))
- (setcdr x (list (cdadr x)))))))
+ (setcdr x (list (cl-cdadr x)))))))
alist)))
;;; /commands these are called with 3 args: PROCESS, TARGET, which is
@@ -2141,6 +2164,7 @@ activity. Only run if the buffer is not visible and
,interactive-form
(let ((process (or process (rcirc-buffer-process)))
(target (or target rcirc-target)))
+ (ignore target) ; mark `target' variable as ignorable
,@body))))
(defun-rcirc-command msg (message)
@@ -2210,6 +2234,19 @@ CHANNELS is a comma- or space-separated string of channel names."
reason
rcirc-id-string))))
+(defun-rcirc-command reconnect (_)
+ "Reconnect to current server."
+ (interactive "i")
+ (with-rcirc-server-buffer
+ (cond
+ (rcirc-connecting (message "Already connecting"))
+ ((process-live-p process) (message "Server process is alive"))
+ (t (let ((conn-info rcirc-connection-info))
+ (setf (nth 5 conn-info)
+ (cl-remove-if-not #'rcirc-channel-p
+ (mapcar #'car rcirc-buffer-alist)))
+ (apply #'rcirc-connect conn-info))))))
+
(defun-rcirc-command nick (nick)
"Change nick to NICK."
(interactive "i")
@@ -2280,7 +2317,7 @@ With a prefix arg, prompt for new topic."
(mapconcat 'identity (cdr arglist) " "))))
(rcirc-send-string process (concat "KICK " target " " argstring))))
-(defun rcirc-cmd-ctcp (args &optional process target)
+(defun rcirc-cmd-ctcp (args &optional process _target)
(if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args)
(let* ((target (match-string 1 args))
(request (upcase (match-string 2 args)))
@@ -2291,7 +2328,7 @@ With a prefix arg, prompt for new topic."
(rcirc-print process (rcirc-nick process) "ERROR" nil
"usage: /ctcp NICK REQUEST")))
-(defun rcirc-ctcp-sender-PING (process target request)
+(defun rcirc-ctcp-sender-PING (process target _request)
"Send a CTCP PING message to TARGET."
(let ((timestamp (format "%.0f" (rcirc-float-time))))
(rcirc-send-ctcp process target "PING" timestamp)))
@@ -2360,10 +2397,11 @@ keywords when no KEYWORD is given."
(let ((pos start)
next prop)
(while (< pos end)
- (setq prop (get-text-property pos 'face object)
- next (next-single-property-change pos 'face object end))
- (unless (member name (get-text-property pos 'face object))
- (add-text-properties pos next (list 'face (cons name prop)) object))
+ (setq prop (get-text-property pos 'font-lock-face object)
+ next (next-single-property-change pos 'font-lock-face object end))
+ (unless (member name (get-text-property pos 'font-lock-face object))
+ (add-text-properties pos next
+ (list 'font-lock-face (cons name prop)) object))
(setq pos next)))))
(defun rcirc-facify (string face)
@@ -2410,21 +2448,20 @@ If ARG is given, opens the URL in a new browser window."
(lambda (x) (>= point (cdr x)))
rcirc-urls))
(completions (mapcar (lambda (x) (car x)) filtered))
- (initial-input (caar filtered))
- (history (mapcar (lambda (x) (car x)) (cdr filtered))))
- (browse-url (completing-read "rcirc browse-url: "
- completions nil nil initial-input 'history)
+ (defaults (mapcar (lambda (x) (car x)) filtered)))
+ (browse-url (completing-read "Rcirc browse-url: "
+ completions nil nil (car defaults) nil defaults)
arg)))
-(defun rcirc-markup-timestamp (sender response)
+(defun rcirc-markup-timestamp (_sender _response)
(goto-char (point-min))
(insert (rcirc-facify (format-time-string rcirc-time-format)
'rcirc-timestamp)))
-(defun rcirc-markup-attributes (sender response)
+(defun rcirc-markup-attributes (_sender _response)
(while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t)
(rcirc-add-face (match-beginning 0) (match-end 0)
- (case (char-after (match-beginning 1))
+ (cl-case (char-after (match-beginning 1))
(?\C-b 'bold)
(?\C-v 'italic)
(?\C-_ 'underline)))
@@ -2438,7 +2475,7 @@ If ARG is given, opens the URL in a new browser window."
(while (re-search-forward "\C-o+" nil t)
(delete-region (match-beginning 0) (match-end 0))))
-(defun rcirc-markup-my-nick (sender response)
+(defun rcirc-markup-my-nick (_sender response)
(with-syntax-table rcirc-nick-syntax-table
(while (re-search-forward (concat "\\b"
(regexp-quote (rcirc-nick
@@ -2452,7 +2489,7 @@ If ARG is given, opens the URL in a new browser window."
'rcirc-nick-in-message-full-line)
(rcirc-record-activity (current-buffer) 'nick)))))
-(defun rcirc-markup-urls (sender response)
+(defun rcirc-markup-urls (_sender _response)
(while (and rcirc-url-regexp ;; nil means disable URL catching
(re-search-forward rcirc-url-regexp nil t))
(let* ((start (match-beginning 0))
@@ -2483,7 +2520,7 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword)
(rcirc-record-activity (current-buffer) 'keyword))))))
-(defun rcirc-markup-bright-nicks (sender response)
+(defun rcirc-markup-bright-nicks (_sender response)
(when (and rcirc-bright-nicks
(string= response "NAMES"))
(with-syntax-table rcirc-nick-syntax-table
@@ -2491,16 +2528,15 @@ If ARG is given, opens the URL in a new browser window."
(rcirc-add-face (match-beginning 0) (match-end 0)
'rcirc-bright-nick)))))
-(defun rcirc-markup-fill (sender response)
+(defun rcirc-markup-fill (_sender response)
(when (not (string= response "372")) ; /motd
(let ((fill-prefix
(or rcirc-fill-prefix
(make-string (- (point) (line-beginning-position)) ?\s)))
- (fill-column (- (cond ((eq rcirc-fill-column 'frame-width)
- (1- (frame-width)))
- (rcirc-fill-column
- rcirc-fill-column)
- (t fill-column))
+ (fill-column (- (cond ((null rcirc-fill-column) fill-column)
+ ((functionp rcirc-fill-column)
+ (funcall rcirc-fill-column))
+ (t rcirc-fill-column))
;; make sure ... doesn't cause line wrapping
3)))
(fill-region (point) (point-max) nil t))))
@@ -2564,7 +2600,7 @@ If ARG is given, opens the URL in a new browser window."
(cond ((rcirc-channel-p target)
target)
;;; -ChanServ- [#gnu] Welcome...
- ((string-match "\\[\\(#[^\] ]+\\)\\]" message)
+ ((string-match "\\[\\(#[^] ]+\\)\\]" message)
(match-string 1 message))
(sender
(if (string= sender (rcirc-server-name process))
@@ -2572,7 +2608,7 @@ If ARG is given, opens the URL in a new browser window."
sender)))
message t))))
-(defun rcirc-check-auth-status (process sender args text)
+(defun rcirc-check-auth-status (process sender args _text)
"Check if the user just authenticated.
If authenticated, runs `rcirc-authenticated-hook' with PROCESS as
the only argument."
@@ -2600,10 +2636,10 @@ the only argument."
(run-hook-with-args 'rcirc-authenticated-hook process)
(remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t))))))
-(defun rcirc-handler-WALLOPS (process sender args text)
+(defun rcirc-handler-WALLOPS (process sender args _text)
(rcirc-print process sender "WALLOPS" sender (car args) t))
-(defun rcirc-handler-JOIN (process sender args text)
+(defun rcirc-handler-JOIN (process sender args _text)
(let ((channel (car args)))
(with-current-buffer (rcirc-get-buffer-create process channel)
;; when recently rejoining, restore the linestamp
@@ -2624,7 +2660,7 @@ the only argument."
(rcirc-print process sender "JOIN" sender channel))))
;; PART and KICK are handled the same way
-(defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
+(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args)
(rcirc-ignore-update-automatic nick)
(if (not (string= nick (rcirc-nick process)))
;; this is someone else leaving
@@ -2641,7 +2677,7 @@ the only argument."
(when buffer
(rcirc-disconnect-buffer buffer)))))
-(defun rcirc-handler-PART (process sender args text)
+(defun rcirc-handler-PART (process sender args _text)
(let* ((channel (car args))
(reason (cadr args))
(message (concat channel " " reason)))
@@ -2652,10 +2688,10 @@ the only argument."
(rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
-(defun rcirc-handler-KICK (process sender args text)
+(defun rcirc-handler-KICK (process sender args _text)
(let* ((channel (car args))
(nick (cadr args))
- (reason (caddr args))
+ (reason (nth 2 args))
(message (concat nick " " channel " " reason)))
(rcirc-print process sender "KICK" channel message t)
;; print in private chat buffer if it exists
@@ -2680,7 +2716,7 @@ the only argument."
(cons (cons nick line)
rcirc-recent-quit-alist))))))))))
-(defun rcirc-handler-QUIT (process sender args text)
+(defun rcirc-handler-QUIT (process sender args _text)
(rcirc-ignore-update-automatic sender)
(mapc (lambda (channel)
;; broadcast quit message each channel
@@ -2690,7 +2726,7 @@ the only argument."
(rcirc-nick-channels process sender))
(rcirc-nick-remove process sender))
-(defun rcirc-handler-NICK (process sender args text)
+(defun rcirc-handler-NICK (process sender args _text)
(let* ((old-nick sender)
(new-nick (car args))
(channels (rcirc-nick-channels process old-nick)))
@@ -2721,25 +2757,25 @@ the only argument."
;; reauthenticate
(when rcirc-auto-authenticate-flag (rcirc-authenticate))))))
-(defun rcirc-handler-PING (process sender args text)
+(defun rcirc-handler-PING (process _sender args _text)
(rcirc-send-string process (concat "PONG :" (car args))))
-(defun rcirc-handler-PONG (process sender args text)
+(defun rcirc-handler-PONG (_process _sender _args _text)
;; do nothing
)
-(defun rcirc-handler-TOPIC (process sender args text)
+(defun rcirc-handler-TOPIC (process sender args _text)
(let ((topic (cadr args)))
(rcirc-print process sender "TOPIC" (car args) topic)
(with-current-buffer (rcirc-get-buffer process (car args))
(setq rcirc-topic topic))))
(defvar rcirc-nick-away-alist nil)
-(defun rcirc-handler-301 (process sender args text)
+(defun rcirc-handler-301 (process _sender args text)
"RPL_AWAY"
(let* ((nick (cadr args))
(rec (assoc-string nick rcirc-nick-away-alist))
- (away-message (caddr args)))
+ (away-message (nth 2 args)))
(when (or (not rec)
(not (string= (cdr rec) away-message)))
;; away message has changed
@@ -2749,7 +2785,7 @@ the only argument."
(setq rcirc-nick-away-alist (cons (cons nick away-message)
rcirc-nick-away-alist))))))
-(defun rcirc-handler-317 (process sender args text)
+(defun rcirc-handler-317 (process sender args _text)
"RPL_WHOISIDLE"
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
@@ -2763,31 +2799,31 @@ the only argument."
nick idle-string signon-string)))
(rcirc-print process sender "317" nil message t)))
-(defun rcirc-handler-332 (process sender args text)
+(defun rcirc-handler-332 (process _sender args _text)
"RPL_TOPIC"
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
- (setq rcirc-topic (caddr args)))))
+ (setq rcirc-topic (nth 2 args)))))
-(defun rcirc-handler-333 (process sender args text)
+(defun rcirc-handler-333 (process sender args _text)
"333 says who set the topic and when.
Not in rfc1459.txt"
(let ((buffer (or (rcirc-get-buffer process (cadr args))
(rcirc-get-temp-buffer-create process (cadr args)))))
(with-current-buffer buffer
- (let ((setter (caddr args))
+ (let ((setter (nth 2 args))
(time (current-time-string
(seconds-to-time
- (string-to-number (cadddr args))))))
+ (string-to-number (cl-cadddr args))))))
(rcirc-print process sender "TOPIC" (cadr args)
(format "%s (%s on %s)" rcirc-topic setter time))))))
-(defun rcirc-handler-477 (process sender args text)
+(defun rcirc-handler-477 (process sender args _text)
"ERR_NOCHANMODES"
- (rcirc-print process sender "477" (cadr args) (caddr args)))
+ (rcirc-print process sender "477" (cadr args) (nth 2 args)))
-(defun rcirc-handler-MODE (process sender args text)
+(defun rcirc-handler-MODE (process sender args _text)
(let ((target (car args))
(msg (mapconcat 'identity (cdr args) " ")))
(rcirc-print process sender "MODE"
@@ -2807,7 +2843,7 @@ Not in rfc1459.txt"
(let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process))))
(get-buffer-create tmpnam)))
-(defun rcirc-handler-353 (process sender args text)
+(defun rcirc-handler-353 (process _sender args _text)
"RPL_NAMREPLY"
(let ((channel (nth 2 args))
(names (or (nth 3 args) "")))
@@ -2820,7 +2856,7 @@ Not in rfc1459.txt"
(goto-char (point-max))
(insert (car (last args)) " "))))
-(defun rcirc-handler-366 (process sender args text)
+(defun rcirc-handler-366 (process sender args _text)
"RPL_ENDOFNAMES"
(let* ((channel (cadr args))
(buffer (rcirc-get-temp-buffer-create process channel)))
@@ -2845,14 +2881,14 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(dolist (i rcirc-authinfo)
(let ((process (rcirc-buffer-process))
(server (car i))
- (nick (caddr i))
+ (nick (nth 2 i))
(method (cadr i))
- (args (cdddr i)))
+ (args (cl-cdddr i)))
(when (and (string-match server rcirc-server))
(if (and (memq method '(nickserv chanserv bitlbee))
(string-match nick rcirc-nick))
;; the following methods rely on the user's nickname.
- (case method
+ (cl-case method
(nickserv
(rcirc-send-privmsg
process
@@ -2876,10 +2912,10 @@ Passwords are stored in `rcirc-authinfo' (which see)."
"Q@CServe.quakenet.org"
(format "AUTH %s %s" nick (car args))))))))))
-(defun rcirc-handler-INVITE (process sender args text)
+(defun rcirc-handler-INVITE (process sender args _text)
(rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t))
-(defun rcirc-handler-ERROR (process sender args text)
+(defun rcirc-handler-ERROR (process sender args _text)
(rcirc-print process sender "ERROR" nil (mapconcat 'identity args " ")))
(defun rcirc-handler-CTCP (process target sender text)
@@ -2897,7 +2933,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(rcirc-print process sender "CTCP" target
(format "%s" text) t))))))
-(defun rcirc-handler-ctcp-VERSION (process target sender args)
+(defun rcirc-handler-ctcp-VERSION (process _target sender _args)
(rcirc-send-string process
(concat "NOTICE " sender
" :\C-aVERSION " rcirc-id-string
@@ -2906,12 +2942,12 @@ Passwords are stored in `rcirc-authinfo' (which see)."
(defun rcirc-handler-ctcp-ACTION (process target sender args)
(rcirc-print process sender "ACTION" target args t))
-(defun rcirc-handler-ctcp-TIME (process target sender args)
+(defun rcirc-handler-ctcp-TIME (process _target sender _args)
(rcirc-send-string process
(concat "NOTICE " sender
" :\C-aTIME " (current-time-string) "\C-a")))
-(defun rcirc-handler-CTCP-response (process target sender message)
+(defun rcirc-handler-CTCP-response (process _target sender message)
(rcirc-print process sender "CTCP" nil message t))
(defgroup rcirc-faces nil
diff --git a/lisp/gnus/rfc2104.el b/lisp/net/rfc2104.el
index baf00d203a4..f80e2287879 100644
--- a/lisp/gnus/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -1,6 +1,6 @@
;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el
index e8d13254557..fead60eb8ab 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/net/rlogin.el
@@ -1,6 +1,6 @@
;;; rlogin.el --- remote login interface
-;; Copyright (C) 1992-1995, 1997-1998, 2001-2013 Free Software
+;; Copyright (C) 1992-1995, 1997-1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Noah Friedman
@@ -145,7 +145,7 @@ other arguments for `rlogin'.
Input is sent line-at-a-time to the remote connection.
Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
-\(or `*rlogin-USER@HOST*' if the remote username differs\).
+\(or `*rlogin-USER@HOST*' if the remote username differs).
If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
a new buffer with a different connection will be made.
@@ -174,7 +174,7 @@ If you wish to change directory tracking styles during a session, use the
function `rlogin-directory-tracking-mode' rather than simply setting the
variable."
(interactive (list
- (read-from-minibuffer (format
+ (read-from-minibuffer (format-message
"Arguments for `%s' (hostname first): "
(file-name-nondirectory rlogin-program))
nil nil nil 'rlogin-history)
@@ -235,14 +235,14 @@ variable."
"Do remote or local directory tracking, or disable entirely.
If called with no prefix argument or a unspecified prefix argument (just
-``\\[universal-argument]'' with no number) do remote directory tracking via
+`\\[universal-argument]' with no number) do remote directory tracking via
ange-ftp. If called as a function, give it no argument.
If called with a negative prefix argument, disable directory tracking
entirely.
If called with a positive, numeric prefix argument, e.g.
-``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
+`\\[universal-argument] 1 M-x rlogin-directory-tracking-mode',
then do directory tracking but assume the remote filesystem is the same as
the local system. This only works in general if the remote machine and the
local one share the same directories (e.g. through NFS)."
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index 2a132a5fcd9..235159497ab 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -1,6 +1,6 @@
;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 6adbf444a9e..aa3843bb386 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -1,6 +1,6 @@
;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework
-;; Copyright (C) 2000, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Kenichi OKADA <okada@opaopa.org>
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 487a1d03538..cab899e8ff9 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -1,6 +1,6 @@
;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework
-;; Copyright (C) 2000, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Keywords: SASL, NTLM
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
new file mode 100644
index 00000000000..18d7a6bfa18
--- /dev/null
+++ b/lisp/net/sasl-scram-rfc.el
@@ -0,0 +1,163 @@
+;;; sasl-scram-rfc.el --- SCRAM-SHA-1 module for the SASL client framework -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Magnus Henoch <magnus.henoch@gmail.com>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This program is implemented from RFC 5802. It implements the
+;; SCRAM-SHA-1 SASL mechanism.
+;;
+;; RFC 5802 foresees "hash agility", i.e. new mechanisms based on the
+;; same protocol but using a different hash function. Likewise, this
+;; module attempts to separate generic and specific functions, which
+;; should make it easy to implement any future SCRAM-* SASL mechanism.
+;; It should be as simple as copying the SCRAM-SHA-1 section below and
+;; replacing all SHA-1 references.
+;;
+;; This module does not yet implement the variants with channel
+;; binding, i.e. SCRAM-*-PLUS. That would require cooperation from
+;; the TLS library.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'sasl)
+(require 'hex-util)
+(require 'rfc2104)
+
+;;; Generic for SCRAM-*
+
+(defun sasl-scram-client-first-message (client _step)
+ (let ((c-nonce (sasl-unique-id)))
+ (sasl-client-set-property client 'c-nonce c-nonce))
+ (concat
+ ;; n = client doesn't support channel binding
+ "n,"
+ ;; TODO: where would we get authorization id from?
+ ","
+ (sasl-scram--client-first-message-bare client)))
+
+(defun sasl-scram--client-first-message-bare (client)
+ (let ((c-nonce (sasl-client-property client 'c-nonce)))
+ (concat
+ ;; TODO: saslprep username or disallow non-ASCII characters
+ "n=" (sasl-client-name client) ","
+ "r=" c-nonce)))
+
+(defun sasl-scram--client-final-message (hash-fun block-length hash-length client step)
+ (unless (string-match
+ "^r=\\([^,]+\\),s=\\([^,]+\\),i=\\([0-9]+\\)\\(?:$\\|,\\)"
+ (sasl-step-data step))
+ (sasl-error "Unexpected server response"))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (step-data (sasl-step-data step))
+ (nonce (match-string 1 step-data))
+ (salt-base64 (match-string 2 step-data))
+ (iteration-count (string-to-number (match-string 3 step-data)))
+
+ (c-nonce (sasl-client-property client 'c-nonce))
+ ;; no channel binding, no authorization id
+ (cbind-input "n,,"))
+ (unless (string-prefix-p c-nonce nonce)
+ (sasl-error "Invalid nonce from server"))
+ (let* ((client-final-message-without-proof
+ (concat "c=" (base64-encode-string cbind-input) ","
+ "r=" nonce))
+ (password
+ ;; TODO: either apply saslprep or disallow non-ASCII characters
+ (sasl-read-passphrase
+ (format "%s passphrase for %s: "
+ (sasl-mechanism-name (sasl-client-mechanism client))
+ (sasl-client-name client))))
+ (salt (base64-decode-string salt-base64))
+ (salted-password
+ ;; Hi(str, salt, i):
+ (let ((digest (concat salt (string 0 0 0 1)))
+ (xored nil))
+ (dotimes (_i iteration-count xored)
+ (setq digest (funcall hmac-fun digest password))
+ (setq xored (if (null xored)
+ digest
+ (cl-map 'string 'logxor xored digest))))))
+ (client-key
+ (funcall hmac-fun "Client Key" salted-password))
+ (stored-key (decode-hex-string (funcall hash-fun client-key)))
+ (auth-message
+ (concat
+ (sasl-scram--client-first-message-bare client) ","
+ step-data ","
+ client-final-message-without-proof))
+ (client-signature (funcall hmac-fun (encode-coding-string auth-message 'utf-8) stored-key))
+ (client-proof (cl-map 'string 'logxor client-key client-signature))
+ (client-final-message
+ (concat client-final-message-without-proof ","
+ "p=" (base64-encode-string client-proof))))
+ (sasl-client-set-property client 'auth-message auth-message)
+ (sasl-client-set-property client 'salted-password salted-password)
+ client-final-message)))
+
+(defun sasl-scram--authenticate-server (hash-fun block-length hash-length client step)
+ (cond
+ ((string-match "^e=\\([^,]+\\)" (sasl-step-data step))
+ (sasl-error (format "Server error: %s" (match-string 1 (sasl-step-data step)))))
+ ((string-match "^v=\\([^,]+\\)" (sasl-step-data step))
+ (let* ((hmac-fun (lambda (text key)
+ (decode-hex-string
+ (rfc2104-hash hash-fun block-length hash-length key text))))
+ (verifier (base64-decode-string (match-string 1 (sasl-step-data step))))
+ (auth-message (sasl-client-property client 'auth-message))
+ (salted-password (sasl-client-property client 'salted-password))
+ (server-key (funcall hmac-fun "Server Key" salted-password))
+ (expected-server-signature
+ (funcall hmac-fun (encode-coding-string auth-message 'utf-8) server-key)))
+ (unless (string= expected-server-signature verifier)
+ (sasl-error "Server not authenticated"))))
+ (t
+ (sasl-error "Invalid response from server"))))
+
+;;; SCRAM-SHA-1
+
+(defconst sasl-scram-sha-1-steps
+ '(sasl-scram-client-first-message
+ sasl-scram-sha-1-client-final-message
+ sasl-scram-sha-1-authenticate-server))
+
+(defun sasl-scram-sha-1-client-final-message (client step)
+ (sasl-scram--client-final-message
+ ;; HMAC-SHA1 uses block length 64 and hash length 20; see RFC 2104.
+ 'sha1 64 20 client step))
+
+(defun sasl-scram-sha-1-authenticate-server (client step)
+ (sasl-scram--authenticate-server
+ 'sha1 64 20 client step))
+
+;; This needs to be at the end, because of how `sasl-make-mechanism'
+;; handles step function names.
+(put 'sasl-scram-sha-1 'sasl-mechanism
+ (sasl-make-mechanism "SCRAM-SHA-1" sasl-scram-sha-1-steps))
+
+(put 'sasl-scram-rfc 'sasl-mechanism (get 'sasl-scram-sha-1 'sasl-mechanism))
+
+(provide 'sasl-scram-sha-1)
+
+(provide 'sasl-scram-rfc)
+;;; sasl-scram-rfc.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index a5efdd620e9..9321efdfda8 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -1,6 +1,6 @@
;;; sasl.el --- SASL client framework
-;; Copyright (C) 2000, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2007-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: SASL
@@ -35,8 +35,8 @@
;;; Code:
(defvar sasl-mechanisms
- '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
- "NTLM" "SCRAM-MD5"))
+ '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS"
+ "NTLM"))
(defvar sasl-mechanism-alist
'(("CRAM-MD5" sasl-cram)
@@ -45,7 +45,7 @@
("LOGIN" sasl-login)
("ANONYMOUS" sasl-anonymous)
("NTLM" sasl-ntlm)
- ("SCRAM-MD5" sasl-scram)))
+ ("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 b4e51348dde..5e0274029f1 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -1,6 +1,6 @@
;;; secrets.el --- Client interface to gnome-keyring and kwallet.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm password passphrase
@@ -85,7 +85,7 @@
;; temporarily. This shall be preferred over creation of a persistent
;; collection, when the information shall not live longer than Emacs.
;; The session collection can be addressed either by the string
-;; "session", or by `nil', whenever a collection parameter is needed.
+;; "session", or by nil, whenever a collection parameter is needed.
;; As already said, a collection is a group of secret items. A secret
;; item has a label, the "secret" (which is a string), and a set of
@@ -189,6 +189,7 @@ It returns t if not."
;; </method>
;; <method name="CreateCollection">
;; <arg name="props" type="a{sv}" direction="in"/>
+;; <arg name="alias" type="s" direction="in"/> ;; Added 2011/3/1
;; <arg name="collection" type="o" direction="out"/>
;; <arg name="prompt" type="o" direction="out"/>
;; </method>
@@ -417,7 +418,7 @@ returned, and it will be stored in `secrets-session-path'."
(defun secrets-prompt-handler (&rest args)
"Handler for signals emitted by `secrets-interface-prompt'."
;; An empty object path is always identified as `secrets-empty-path'
- ;; or `nil'. Either we set it explicitly, or it is returned by the
+ ;; or nil. Either we set it explicitly, or it is returned by the
;; "Completed" signal.
(if (car args) ;; dismissed
(setq secrets-prompt-signal (list secrets-empty-path))
@@ -491,9 +492,10 @@ If there is no such COLLECTION, return nil."
(secrets-get-collection-property collection-path "Label"))
(throw 'collection-found collection-path))))))
-(defun secrets-create-collection (collection)
+(defun secrets-create-collection (collection &optional alias)
"Create collection labeled COLLECTION if it doesn't exist.
-Return the D-Bus object path for collection."
+Set ALIAS as alias of the collection. Return the D-Bus object
+path for collection."
(let ((collection-path (secrets-collection-path collection)))
;; Create the collection.
(when (secrets-empty-path collection-path)
@@ -504,7 +506,10 @@ Return the D-Bus object path for collection."
(dbus-call-method
:session secrets-service secrets-path
secrets-interface-service "CreateCollection"
- `(:array (:dict-entry "Label" (:variant ,collection))))))))
+ `(:array
+ (:dict-entry ,(concat secrets-interface-collection ".Label")
+ (:variant ,collection)))
+ (or alias ""))))))
;; Return object path of the collection.
collection-path))
@@ -593,10 +598,9 @@ If successful, return the object path of the collection."
ATTRIBUTES are key-value pairs. The keys are keyword symbols,
starting with a colon. Example:
- \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
- :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
+ (secrets-search-items \"Tramp collection\" :user \"joe\")
-The object paths of the found items are returned as list."
+The object labels of the found items are returned as list."
(let ((collection-path (secrets-unlock-collection collection))
result props)
(unless (secrets-empty-path collection-path)
@@ -604,6 +608,8 @@ The object paths of the found items are returned as list."
(while (consp (cdr attributes))
(unless (keywordp (car attributes))
(error 'wrong-type-argument (car attributes)))
+ (unless (stringp (cadr attributes))
+ (error 'wrong-type-argument (cadr attributes)))
(setq props (add-to-list
'props
(list :dict-entry
@@ -611,8 +617,7 @@ The object paths of the found items are returned as list."
(cadr attributes))
'append)
attributes (cddr attributes)))
- ;; Search. The result is a list of two lists, the object paths
- ;; of the unlocked and the locked items.
+ ;; Search. The result is a list of object paths.
(setq result
(dbus-call-method
:session secrets-service collection-path
@@ -623,15 +628,15 @@ The object paths of the found items are returned as list."
;; Return the found items.
(mapcar
(lambda (item-path) (secrets-get-item-property item-path "Label"))
- (append (car result) (cadr result))))))
+ result))))
(defun secrets-create-item (collection item password &rest attributes)
"Create a new item in COLLECTION with label ITEM and password PASSWORD.
ATTRIBUTES are key-value pairs set for the created item. The
keys are keyword symbols, starting with a colon. Example:
- \(secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
- :method \"sudo\" :user \"joe\" :host \"remote-host\"\)
+ (secrets-create-item \"Tramp collection\" \"item\" \"geheim\"
+ :method \"sudo\" :user \"joe\" :host \"remote-host\")
The object path of the created item is returned."
(unless (member item (secrets-list-items collection))
@@ -642,6 +647,8 @@ The object path of the created item is returned."
(while (consp (cdr attributes))
(unless (keywordp (car attributes))
(error 'wrong-type-argument (car attributes)))
+ (unless (stringp (cadr attributes))
+ (error 'wrong-type-argument (cadr attributes)))
(setq props (add-to-list
'props
(list :dict-entry
@@ -693,7 +700,7 @@ If there is no such item, return nil."
(let ((item-path (secrets-item-path collection item)))
(unless (secrets-empty-path item-path)
(dbus-byte-array-to-string
- (cl-caddr
+ (nth 2
(dbus-call-method
:session secrets-service item-path secrets-interface-item
"GetSecret" :object-path secrets-session-path))))))
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index 21f1fc4f004..f8d358c27b3 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -1,6 +1,6 @@
;;; shr-color.el --- Simple HTML Renderer color management
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: html
@@ -211,7 +211,7 @@ This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"."
"Convert X Y H to RGB value."
(when (< h 0) (incf h))
(when (> h 1) (decf h))
- (cond ((< h (/ 1 6.0)) (+ x (* (- y x) h 6)))
+ (cond ((< h (/ 6.0)) (+ x (* (- y x) h 6)))
((< h 0.5) y)
((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
(t x)))
@@ -223,9 +223,9 @@ This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"."
(setq m2 (* l (+ s 1)))
(setq m2 (- (+ l s) (* l s))))
(setq m1 (- (* l 2) m2))
- (list (shr-color-hue-to-rgb m1 m2 (+ h (/ 1 3.0)))
+ (list (shr-color-hue-to-rgb m1 m2 (+ h (/ 3.0)))
(shr-color-hue-to-rgb m1 m2 h)
- (shr-color-hue-to-rgb m1 m2 (- h (/ 1 3.0))))))
+ (shr-color-hue-to-rgb m1 m2 (- h (/ 3.0))))))
(defun shr-color->hexadecimal (color)
"Convert any color format to hexadecimal representation.
@@ -242,7 +242,7 @@ Like rgb() or hsl()."
"rgb(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*)"
color)
(string-match
- "rgba(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*[0-9]*\.?[0-9]+\s*%?\s*)"
+ "rgba(\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*\\([0-9]\\{1,3\\}\\(?:\s*%\\)?\\)\s*,\s*[0-9]*\\.?[0-9]+\s*%?\s*)"
color))
(format "#%02X%02X%02X"
(shr-color-relative-to-absolute (match-string-no-properties 1 color))
@@ -253,7 +253,7 @@ Like rgb() or hsl()."
"hsl(\s*\\([0-9]\\{1,3\\}\\)\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*)"
color)
(string-match
- "hsla(\s*\\([0-9]\\{1,3\\}\\)\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*[0-9]*\.?[0-9]+\s*%?\s*)"
+ "hsla(\s*\\([0-9]\\{1,3\\}\\)\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*\\([0-9]\\{1,3\\}\\)\s*%\s*,\s*[0-9]*\\.?[0-9]+\s*%?\s*)"
color))
(let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0))
(s (/ (string-to-number (match-string-no-properties 2 color)) 100.0))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 9cac618b159..58deaea6f53 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1,6 +1,6 @@
;;; shr.el --- Simple HTML Renderer
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: html
@@ -33,11 +33,13 @@
(eval-when-compile (require 'cl))
(eval-when-compile (require 'url)) ;For url-filename's setf handler.
(require 'browse-url)
+(require 'subr-x)
+(require 'dom)
(defgroup shr nil
"Simple HTML Renderer"
- :version "24.1"
- :group 'hypermedia)
+ :version "25.1"
+ :group 'web)
(defcustom shr-max-image-proportion 0.9
"How big pictures displayed are in relation to the window they're in.
@@ -55,6 +57,12 @@ fit these criteria."
:group 'shr
:type '(choice (const nil) regexp))
+(defcustom shr-use-fonts t
+ "If non-nil, use proportional fonts for text."
+ :version "25.1"
+ :group 'shr
+ :type 'boolean)
+
(defcustom shr-table-horizontal-line nil
"Character used to draw horizontal table lines.
If nil, don't draw horizontal table lines."
@@ -76,11 +84,12 @@ If nil, don't draw horizontal table lines."
:group 'shr
:type 'character)
-(defcustom shr-width fill-column
+(defcustom shr-width nil
"Frame width to use for 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."
+ :version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
(const :tag "Use the width of the window" nil))
:group 'shr)
@@ -90,6 +99,7 @@ used."
Alternative suggestions are:
- \" \"
- \" \""
+ :version "24.4"
:type 'string
:group 'shr)
@@ -99,6 +109,12 @@ Alternative suggestions are:
:group 'shr
:type 'function)
+(defcustom shr-image-animate t
+ "Non nil means that images that can be animated will be."
+ :version "24.4"
+ :group 'shr
+ :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
@@ -116,32 +132,39 @@ cid: URL as the argument.")
"Font for link elements."
:group 'shr)
+(defvar shr-inhibit-images nil
+ "If non-nil, inhibit loading images.")
+
;;; Internal variables.
(defvar shr-folding-mode nil)
-(defvar shr-state nil)
(defvar shr-start nil)
(defvar shr-indentation 0)
-(defvar shr-inhibit-images nil)
+(defvar shr-internal-width nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
(defvar shr-kinsoku-shorten nil)
(defvar shr-table-depth 0)
(defvar shr-stylesheet nil)
(defvar shr-base nil)
+(defvar shr-depth 0)
+(defvar shr-warning nil)
(defvar shr-ignore-cache nil)
(defvar shr-external-rendering-functions nil)
(defvar shr-target-id nil)
-(defvar shr-inhibit-decoration 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-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'shr-show-alt-text)
(define-key map "i" 'shr-browse-image)
(define-key map "z" 'shr-zoom-image)
- (define-key map [tab] 'shr-next-link)
- (define-key map [backtab] 'shr-previous-link)
+ (define-key map [?\t] 'shr-next-link)
+ (define-key map [?\M-\t] 'shr-previous-link)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-browse-url)
(define-key map "I" 'shr-insert-image)
@@ -154,7 +177,7 @@ cid: URL as the argument.")
;; Public functions and commands.
(declare-function libxml-parse-html-region "xml.c"
- (start end &optional base-url))
+ (start end &optional base-url discard-comments))
(defun shr-render-buffer (buffer)
"Display the HTML rendering of the current buffer."
@@ -168,6 +191,7 @@ cid: URL as the argument.")
(libxml-parse-html-region (point-min) (point-max))))
(goto-char (point-min)))
+;;;###autoload
(defun shr-render-region (begin end &optional buffer)
"Display the HTML rendering of the region between BEGIN and END."
(interactive "r")
@@ -179,13 +203,6 @@ cid: URL as the argument.")
(goto-char begin)
(shr-insert-document dom))))
-(defun shr-visit-file (file)
- "Parse FILE as an HTML document, and render it in a new buffer."
- (interactive "fHTML file name: ")
- (with-temp-buffer
- (insert-file-contents file)
- (shr-render-buffer (current-buffer))))
-
;;;###autoload
(defun shr-insert-document (dom)
"Render the parsed document DOM into the current buffer.
@@ -193,13 +210,46 @@ DOM should be a parse tree as generated by
`libxml-parse-html-region' or similar."
(setq shr-content-cache nil)
(let ((start (point))
- (shr-state nil)
(shr-start nil)
(shr-base nil)
- (shr-preliminary-table-render 0)
- (shr-width (or shr-width (1- (window-width)))))
- (shr-descend (shr-transform-dom dom))
- (shr-remove-trailing-whitespace start (point))))
+ (shr-depth 0)
+ (shr-table-id 0)
+ (shr-warning nil)
+ (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)
+ (or (zerop
+ (fringe-columns 'right))
+ (zerop
+ (fringe-columns 'left))))
+ 0
+ 1))
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ (if (and (null shr-width)
+ (or (zerop
+ (fringe-columns 'right))
+ (zerop
+ (fringe-columns 'left))))
+ (* (frame-char-width) 2)
+ 0))))))
+ (shr-descend dom)
+ (shr-fill-lines start (point))
+ (shr-remove-trailing-whitespace start (point))
+ (when shr-warning
+ (message "%s" shr-warning))))
(defun shr-remove-trailing-whitespace (start end)
(let ((width (window-width)))
@@ -214,12 +264,16 @@ DOM should be a parse tree as generated by
(overlay-put overlay 'before-string nil))))
(forward-line 1)))))
-(defun shr-copy-url ()
+(defun shr-copy-url (&optional image-url)
"Copy the URL under point to the kill ring.
+If IMAGE-URL (the prefix) is non-nil, or there is no link under
+point, but there is an image under point then copy the URL of the
+image under point instead.
If called twice, then try to fetch the URL and see whether it
redirects somewhere else."
- (interactive)
- (let ((url (get-text-property (point) 'shr-url)))
+ (interactive "P")
+ (let ((url (or (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
(cond
((not url)
(message "No URL under point"))
@@ -242,16 +296,17 @@ redirects somewhere else."
;; Copy the URL to the kill ring.
(t
(with-temp-buffer
- (insert url)
+ (insert (url-encode-url url))
(copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" url))))))
+ (message "Copied %s" (buffer-string)))))))
(defun shr-next-link ()
"Skip to the next link."
(interactive)
(let ((skip (text-property-any (point) (point-max) 'help-echo nil)))
- (if (not (setq skip (text-property-not-all skip (point-max)
- 'help-echo nil)))
+ (if (or (eobp)
+ (not (setq skip (text-property-not-all skip (point-max)
+ 'help-echo nil))))
(message "No next link")
(goto-char skip)
(message "%s" (get-text-property (point) 'help-echo)))))
@@ -286,7 +341,7 @@ redirects somewhere else."
(let ((text (get-text-property (point) 'shr-alt)))
(if (not text)
(message "No image under point")
- (message "%s" text))))
+ (message "%s" (shr-fill-text text)))))
(defun shr-browse-image (&optional copy-url)
"Browse the image under point.
@@ -353,184 +408,274 @@ size, and full-buffer size."
;;; Utility functions.
-(defun shr-transform-dom (dom)
- (let ((result (list (pop dom))))
- (dolist (arg (pop dom))
- (push (cons (intern (concat ":" (symbol-name (car arg))) obarray)
- (cdr arg))
- result))
- (dolist (sub dom)
- (if (stringp sub)
- (push (cons 'text sub) result)
- (push (shr-transform-dom sub) result)))
- (nreverse result)))
+(defsubst shr-generic (dom)
+ (dolist (sub (dom-children dom))
+ (if (stringp sub)
+ (shr-insert sub)
+ (shr-descend sub))))
(defun shr-descend (dom)
(let ((function
(or
;; Allow other packages to override (or provide) rendering
;; of elements.
- (cdr (assq (car dom) shr-external-rendering-functions))
- (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)))
- (style (cdr (assq :style (cdr dom))))
+ (cdr (assq (dom-tag dom) shr-external-rendering-functions))
+ (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray)))
+ (style (dom-attr dom 'style))
(shr-stylesheet shr-stylesheet)
+ (shr-depth (1+ shr-depth))
(start (point)))
- (when style
- (if (string-match "color\\|display\\|border-collapse" style)
- (setq shr-stylesheet (nconc (shr-parse-style style)
- shr-stylesheet))
- (setq style nil)))
- ;; If we have a display:none, then just ignore this part of the
- ;; DOM.
- (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
- (if (fboundp function)
- (funcall function (cdr dom))
- (shr-generic (cdr dom)))
- (when (and shr-target-id
- (equal (cdr (assq :id (cdr dom))) shr-target-id))
- (put-text-property start (1+ start) 'shr-target-id shr-target-id))
- ;; If style is set, then this node has set the color.
+ ;; shr uses about 12 frames per nested node.
+ (if (> shr-depth (/ max-specpdl-size 12))
+ (setq shr-warning "Too deeply nested to render properly; consider increasing `max-specpdl-size'")
(when style
- (shr-colorize-region start (point)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet)))))))
-
-(defun shr-generic (cont)
- (dolist (sub cont)
- (cond
- ((eq (car sub) 'text)
- (shr-insert (cdr sub)))
- ((listp (cdr sub))
- (shr-descend sub)))))
-
-(defmacro shr-char-breakable-p (char)
+ (if (string-match "color\\|display\\|border-collapse" style)
+ (setq shr-stylesheet (nconc (shr-parse-style style)
+ shr-stylesheet))
+ (setq style nil)))
+ ;; If we have a display:none, then just ignore this part of the DOM.
+ (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+ (if (fboundp function)
+ (funcall function dom)
+ (shr-generic dom))
+ (when (and shr-target-id
+ (equal (dom-attr dom 'id) shr-target-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 style is set, then this node has set the color.
+ (when style
+ (shr-colorize-region
+ start (point)
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color shr-stylesheet))))))))
+
+(defun shr-fill-text (text)
+ (if (zerop (length text))
+ text
+ (with-temp-buffer
+ (let ((shr-indentation 0)
+ (shr-start nil)
+ (shr-internal-width (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ ;; Adjust the window width for when
+ ;; the user disables the fringes,
+ ;; which causes the display engine
+ ;; to usurp one column for the
+ ;; continuation glyph.
+ (if (and (null shr-width)
+ (or (zerop (fringe-columns 'right))
+ (zerop (fringe-columns 'left))))
+ (* (frame-char-width) 2)
+ 0))))
+ (shr-insert text)
+ (buffer-string)))))
+
+(define-inline shr-char-breakable-p (char)
"Return non-nil if a line can be broken before and after CHAR."
- `(aref fill-find-break-point-function-table ,char))
-(defmacro shr-char-nospace-p (char)
+ (inline-quote (aref fill-find-break-point-function-table ,char)))
+(define-inline shr-char-nospace-p (char)
"Return non-nil if no space is required before and after CHAR."
- `(aref fill-nospace-between-words-table ,char))
+ (inline-quote (aref fill-nospace-between-words-table ,char)))
;; KINSOKU is a Japanese word meaning a rule that should not be violated.
;; In Emacs, it is a term used for characters, e.g. punctuation marks,
;; parentheses, and so on, that should not be placed in the beginning
;; of a line or the end of a line.
-(defmacro shr-char-kinsoku-bol-p (char)
+(define-inline shr-char-kinsoku-bol-p (char)
"Return non-nil if a line ought not to begin with CHAR."
- `(aref (char-category-set ,char) ?>))
-(defmacro shr-char-kinsoku-eol-p (char)
+ (inline-letevals (char)
+ (inline-quote (and (not (eq ,char ?'))
+ (aref (char-category-set ,char) ?>)))))
+(define-inline shr-char-kinsoku-eol-p (char)
"Return non-nil if a line ought not to end with CHAR."
- `(aref (char-category-set ,char) ?<))
+ (inline-quote (aref (char-category-set ,char) ?<)))
(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
(load "kinsoku" nil t))
+(defun shr-pixel-column ()
+ (if (not shr-use-fonts)
+ (current-column)
+ (if (not (get-buffer-window (current-buffer)))
+ (save-window-excursion
+ (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 shr-pixel-region ()
+ (- (shr-pixel-column)
+ (save-excursion
+ (goto-char (mark))
+ (shr-pixel-column))))
+
+(defun shr-string-pixel-width (string)
+ (if (not shr-use-fonts)
+ (length string)
+ (with-temp-buffer
+ (insert string)
+ (shr-pixel-column))))
+
(defun shr-insert (text)
- (when (and (eq shr-state 'image)
- (not (bolp))
- (not (string-match "\\`[ \t\n]+\\'" text)))
- (insert "\n")
- (setq shr-state nil))
+ (when (and (not (bolp))
+ (get-text-property (1- (point)) 'image-url))
+ (insert "\n"))
(cond
((eq shr-folding-mode 'none)
- (insert text))
+ (let ((start (point)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "­" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max)))))
(t
- (when (and (string-match "\\`[ \t\n ]" text)
- (not (bolp))
- (not (eq (char-after (1- (point))) ? )))
- (insert " "))
- (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
- (when (and (bolp)
- (> shr-indentation 0))
- (shr-indent))
- ;; No space is needed behind a wide character categorized as
- ;; kinsoku-bol, between characters both categorized as nospace,
- ;; or at the beginning of a line.
- (let (prev)
- (when (and (> (current-column) shr-indentation)
- (eq (preceding-char) ? )
- (or (= (line-beginning-position) (1- (point)))
- (and (shr-char-breakable-p
- (setq prev (char-after (- (point) 2))))
- (shr-char-kinsoku-bol-p prev))
- (and (shr-char-nospace-p prev)
- (shr-char-nospace-p (aref elem 0)))))
- (delete-char -1)))
- ;; The shr-start is a special variable that is used to pass
- ;; upwards the first point in the buffer where the text really
- ;; starts.
- (unless shr-start
- (setq shr-start (point)))
- (insert elem)
- (setq shr-state nil)
- (let (found)
- (while (and (> (current-column) shr-width)
- (progn
- (setq found (shr-find-fill-point))
- (not (eolp))))
- (when (eq (preceding-char) ? )
- (delete-char -1))
- (insert "\n")
- (unless found
- ;; No space is needed at the beginning of a line.
- (when (eq (following-char) ? )
- (delete-char 1)))
- (when (> shr-indentation 0)
- (shr-indent))
- (end-of-line))
- (insert " ")))
- (unless (string-match "[ \t\r\n ]\\'" text)
- (delete-char -1)))))
-
-(defun shr-find-fill-point ()
- (when (> (move-to-column shr-width) shr-width)
- (backward-char 1))
+ (let ((font-start (point)))
+ (when (and (string-match "\\`[ \t\n\r ]" text)
+ (not (bolp))
+ (not (eq (char-after (1- (point))) ? )))
+ (insert " "))
+ (let ((start (point))
+ (bolp (bolp)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char start)
+ (when (looking-at "[ \t\n\r ]+")
+ (replace-match "" t t))
+ (while (re-search-forward "[ \t\n\r ]+" nil t)
+ (replace-match " " t t))
+ ;; Remove soft hyphens.
+ (goto-char (point-min))
+ (while (search-forward "­" nil t)
+ (replace-match "" t t))
+ (goto-char (point-max)))
+ ;; We may have removed everything we inserted if if was just
+ ;; spaces.
+ (unless (= font-start (point))
+ ;; Mark all lines that should possibly be folded afterwards.
+ (when bolp
+ (shr-mark-fill start))
+ (when shr-use-fonts
+ (put-text-property font-start (point)
+ 'face
+ (or shr-current-font 'variable-pitch)))))))))
+
+(defun shr-fill-lines (start end)
+ (if (<= shr-internal-width 0)
+ nil
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (when (get-text-property (point) 'shr-indentation)
+ (shr-fill-line))
+ (while (setq start (next-single-property-change start 'shr-indentation))
+ (goto-char start)
+ (when (bolp)
+ (shr-fill-line)))
+ (goto-char (point-max)))))
+
+(defun shr-vertical-motion (column)
+ (if (not shr-use-fonts)
+ (move-to-column column)
+ (unless (eolp)
+ (forward-char 1))
+ (vertical-motion (cons (/ column (frame-char-width)) 0))
+ (unless (eolp)
+ (forward-char 1))))
+
+(defun shr-fill-line ()
+ (let ((shr-indentation (get-text-property (point) 'shr-indentation))
+ (continuation (get-text-property
+ (point) 'shr-continuation-indentation))
+ start)
+ (put-text-property (point) (1+ (point)) 'shr-indentation nil)
+ (let ((face (get-text-property (point) 'face))
+ (background-start (point)))
+ (shr-indent)
+ (when face
+ (put-text-property background-start (point) 'face
+ `,(shr-face-background face))))
+ (setq start (point))
+ (setq shr-indentation (or continuation shr-indentation))
+ (shr-vertical-motion shr-internal-width)
+ (when (looking-at " $")
+ (delete-region (point) (line-end-position)))
+ (while (not (eolp))
+ ;; We have to do some folding. First find the first
+ ;; previous point suitable for folding.
+ (if (or (not (shr-find-fill-point (line-beginning-position)))
+ (= (point) start))
+ ;; We had unbreakable text (for this width), so just go to
+ ;; the first space and carry on.
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " ")
+ (search-forward " " (line-end-position) 'move)))
+ ;; Success; continue.
+ (when (= (preceding-char) ?\s)
+ (delete-char -1))
+ (let ((face (get-text-property (point) 'face))
+ (background-start (point)))
+ (insert "\n")
+ (shr-indent)
+ (when face
+ (put-text-property background-start (point) 'face
+ `,(shr-face-background face))))
+ (setq start (point))
+ (shr-vertical-motion shr-internal-width)
+ (when (looking-at " $")
+ (delete-region (point) (line-end-position))))))
+
+(defun shr-find-fill-point (start)
(let ((bp (point))
+ (end (point))
failed)
- (while (not (or (setq failed (= (current-column) shr-indentation))
+ (while (not (or (setq failed (<= (point) start))
(eq (preceding-char) ? )
(eq (following-char) ? )
(shr-char-breakable-p (preceding-char))
(shr-char-breakable-p (following-char))
- (if (eq (preceding-char) ?')
- (not (memq (char-after (- (point) 2))
- (list nil ?\n ? )))
- (and (shr-char-kinsoku-bol-p (preceding-char))
- (shr-char-breakable-p (following-char))
- (not (shr-char-kinsoku-bol-p (following-char)))))
- (shr-char-kinsoku-eol-p (following-char))))
+ (and (shr-char-kinsoku-bol-p (preceding-char))
+ (shr-char-breakable-p (following-char))
+ (not (shr-char-kinsoku-bol-p (following-char))))
+ (shr-char-kinsoku-eol-p (following-char))
+ (bolp)))
(backward-char 1))
- (if (and (not (or failed (eolp)))
- (eq (preceding-char) ?'))
- (while (not (or (setq failed (eolp))
- (eq (following-char) ? )
- (shr-char-breakable-p (following-char))
- (shr-char-kinsoku-eol-p (following-char))))
- (forward-char 1)))
(if failed
;; There's no breakable point, so we give it up.
(let (found)
(goto-char bp)
- (unless shr-kinsoku-shorten
- (while (and (setq found (re-search-forward
- "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
- (line-end-position) 'move))
- (eq (preceding-char) ?')))
- (if (and found (not (match-beginning 1)))
+ ;; Don't overflow the window edge, even if
+ ;; shr-kinsoku-shorten is nil.
+ (unless (or shr-kinsoku-shorten (null shr-width))
+ (while (setq found (re-search-forward
+ "\\(\\c>\\)\\| \\|\\c<\\|\\c|"
+ (line-end-position) 'move)))
+ (if (and found
+ (not (match-beginning 1)))
(goto-char (match-beginning 0)))))
(or
(eolp)
;; Don't put kinsoku-bol characters at the beginning of a line,
;; or kinsoku-eol characters at the end of a line.
(cond
- (shr-kinsoku-shorten
+ ;; Don't overflow the window edge, even if shr-kinsoku-shorten
+ ;; is nil.
+ ((or shr-kinsoku-shorten (null shr-width))
(while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
- (shr-char-kinsoku-eol-p (preceding-char)))
+ (or (shr-char-kinsoku-eol-p (preceding-char))
+ (shr-char-kinsoku-bol-p (following-char))))
(backward-char 1))
- (when (setq failed (= (current-column) shr-indentation))
+ (when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
;; so we look for the second best position.
(while (and (progn
(forward-char 1)
- (<= (current-column) shr-width))
+ (<= (point) end))
(progn
(setq bp (point))
(shr-char-kinsoku-eol-p (following-char)))))
@@ -545,12 +690,12 @@ size, and full-buffer size."
(not (memq (preceding-char) (list ?\C-@ ?\n ? )))
(or (shr-char-kinsoku-eol-p (preceding-char))
(shr-char-kinsoku-bol-p (following-char)))))))
- (if (setq failed (= (current-column) shr-indentation))
- ;; There's no breakable point that doesn't violate kinsoku,
- ;; so we go to the second best position.
- (if (looking-at "\\(\\c<+\\)\\c<")
- (goto-char (match-end 1))
- (forward-char 1))))
+ (when (setq failed (<= (point) start))
+ ;; There's no breakable point that doesn't violate kinsoku,
+ ;; so we go to the second best position.
+ (if (looking-at "\\(\\c<+\\)\\c<")
+ (goto-char (match-end 1))
+ (forward-char 1))))
((shr-char-kinsoku-bol-p (following-char))
;; Find forward the point where kinsoku-bol characters end.
(let ((count 4))
@@ -567,6 +712,8 @@ 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
+ (setq url (shr-expand-url url))
(let* ((parsed (url-generic-parse-url url))
(local (url-filename parsed)))
(setf (url-filename parsed) "")
@@ -582,19 +729,27 @@ size, and full-buffer size."
(url-type parsed)
url)))
+(autoload 'url-expand-file-name "url-expand")
+
+;; FIXME This needs some tests writing.
+;; Does it even need to exist, given that url-expand-file-name does?
(defun shr-expand-url (url &optional base)
(setq base
(if base
+ ;; shr-parse-base should never call this with non-nil base!
(shr-parse-base base)
;; Bound by the parser.
shr-base))
(when (zerop (length url))
(setq url nil))
+ ;; Strip leading whitespace
+ (and url (string-match "\\`\\s-+" url)
+ (setq url (substring url (match-end 0))))
(cond ((or (not url)
(not base)
(string-match "\\`[a-z]*:" url))
- ;; Absolute URL.
- (or url (car base)))
+ ;; Absolute or empty URI
+ (or url (nth 3 base)))
((eq (aref url 0) ?/)
(if (and (> (length url) 1)
(eq (aref url 1) ?/))
@@ -607,7 +762,7 @@ size, and full-buffer size."
(concat (nth 3 base) url))
(t
;; Totally relative.
- (concat (car base) (cadr base) url))))
+ (url-expand-file-name url (concat (car base) (cadr base))))))
(defun shr-ensure-newline ()
(unless (zerop (current-column))
@@ -615,48 +770,61 @@ size, and full-buffer size."
(defun shr-ensure-paragraph ()
(unless (bobp)
- (if (<= (current-column) shr-indentation)
- (unless (save-excursion
- (forward-line -1)
- (looking-at " *$"))
- (insert "\n"))
- (if (save-excursion
- (beginning-of-line)
- ;; If the current line is totally blank, and doesn't even
- ;; have any face properties set, then delete the blank
- ;; space.
- (and (looking-at " *$")
- (not (get-text-property (point) 'face))
- (not (= (next-single-property-change (point) 'face nil
- (line-end-position))
- (line-end-position)))))
- (delete-region (match-beginning 0) (match-end 0))
- (insert "\n\n")))))
+ (let ((prefix (get-text-property (line-beginning-position)
+ 'shr-prefix-length)))
+ (cond
+ ((and (bolp)
+ (save-excursion
+ (forward-line -1)
+ (looking-at " *$")))
+ ;; We're already at a new paragraph; do nothing.
+ )
+ ((and prefix
+ (= prefix (- (point) (line-beginning-position))))
+ ;; Do nothing; we're at the start of a <li>.
+ )
+ ((save-excursion
+ (beginning-of-line)
+ ;; If the current line is totally blank, and doesn't even
+ ;; have any face properties set, then delete the blank
+ ;; space.
+ (and (looking-at " *$")
+ (not (get-text-property (point) 'face))
+ (not (= (next-single-property-change (point) 'face nil
+ (line-end-position))
+ (line-end-position)))))
+ (delete-region (match-beginning 0) (match-end 0)))
+ (t
+ (insert "\n\n"))))))
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert (make-string shr-indentation ? ))))
-
-(defun shr-fontize-cont (cont &rest types)
- (let (shr-start)
- (shr-generic cont)
+ (insert
+ (if (not shr-use-fonts)
+ (make-string shr-indentation ?\s)
+ (propertize " "
+ 'display
+ `(space :width (,shr-indentation)))))))
+
+(defun shr-fontize-dom (dom &rest types)
+ (let ((start (point)))
+ (shr-generic dom)
(dolist (type types)
- (shr-add-font (or shr-start (point)) (point) type))))
+ (shr-add-font start (point) type))))
;; Add face to the region, but avoid putting the font properties on
;; blank text at the start of the line, and the newline at the end, to
;; avoid ugliness.
(defun shr-add-font (start end type)
- (unless shr-inhibit-decoration
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (when (bolp)
- (skip-chars-forward " "))
- (add-face-text-property (point) (min (line-end-position) end) type t)
- (if (< (line-end-position) end)
- (forward-line 1)
- (goto-char end))))))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (when (bolp)
+ (skip-chars-forward " "))
+ (add-face-text-property (point) (min (line-end-position) end) type t)
+ (if (< (line-end-position) end)
+ (forward-line 1)
+ (goto-char end)))))
(defun shr-mouse-browse-url (ev)
"Browse the URL under the mouse cursor."
@@ -732,6 +900,10 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
(setq payload (base64-decode-string payload)))
payload)))
+;; Behind display-graphic-p test.
+(declare-function image-size "image.c" (spec &optional pixels frame))
+(declare-function image-animate "image" (image &optional index limit))
+
(defun shr-put-image (spec alt &optional flags)
"Insert image SPEC with a string ALT. Return image.
SPEC is either an image data blob, or a list where the first
@@ -748,12 +920,14 @@ element is the data blob and the second element is the content-type."
((eq size 'original)
(create-image data nil t :ascent 100
:format content-type))
+ ((eq content-type 'image/svg+xml)
+ (create-image data 'svg t :ascent 100))
((eq size 'full)
(ignore-errors
- (shr-rescale-image data t content-type)))
+ (shr-rescale-image data content-type)))
(t
(ignore-errors
- (shr-rescale-image data nil content-type))))))
+ (shr-rescale-image data content-type))))))
(when image
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
@@ -764,22 +938,22 @@ element is the data blob and the second element is the content-type."
(insert-sliced-image image (or alt "*") nil 20 1)
(insert-image image (or alt "*")))
(put-text-property start (point) 'image-size size)
- (when (cond ((fboundp 'image-multi-frame-p)
+ (when (and shr-image-animate
+ (cond ((fboundp 'image-multi-frame-p)
;; Only animate multi-frame things that specify a
;; delay; eg animated gifs as opposed to
;; multi-page tiffs. FIXME?
- (cdr (image-multi-frame-p image)))
- ((fboundp 'image-animated-p)
- (image-animated-p image)))
- (image-animate image nil 60)))
+ (cdr (image-multi-frame-p image)))
+ ((fboundp 'image-animated-p)
+ (image-animated-p image))))
+ (image-animate image nil 60)))
image)
(insert alt)))
-(defun shr-rescale-image (data &optional force content-type)
- "Rescale DATA, if too big, to fit the current buffer.
-If FORCE, rescale the image anyway."
- (if (or (not (fboundp 'imagemagick-types))
- (not (get-buffer-window (current-buffer))))
+(defun shr-rescale-image (data &optional content-type)
+ "Rescale DATA, if too big, to fit the current buffer."
+ (if (not (and (fboundp 'imagemagick-types)
+ (get-buffer-window (current-buffer))))
(create-image data nil t :ascent 100)
(let ((edges (window-inside-pixel-edges
(get-buffer-window (current-buffer)))))
@@ -809,15 +983,28 @@ Return a string with image data."
(search-forward "\r\n\r\n" nil t))
(shr-parse-image-data)))))
+(declare-function libxml-parse-xml-region "xml.c"
+ (start end &optional base-url discard-comments))
+
(defun shr-parse-image-data ()
- (list
- (buffer-substring (point) (point-max))
- (save-excursion
- (save-restriction
- (narrow-to-region (point-min) (point))
- (let ((content-type (mail-fetch-field "content-type")))
- (and content-type
- (intern content-type obarray)))))))
+ (let ((data (buffer-substring (point) (point-max)))
+ (content-type
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (let ((content-type (mail-fetch-field "content-type")))
+ (and content-type
+ ;; Remove any comments in the type string.
+ (intern (replace-regexp-in-string ";.*" "" content-type)
+ obarray)))))))
+ ;; SVG images may contain references to further images that we may
+ ;; want to block. So special-case these by parsing the XML data
+ ;; and remove the blocked bits.
+ (when (eq content-type 'image/svg+xml)
+ (setq data
+ (shr-dom-to-xml
+ (libxml-parse-xml-region (point) (point-max)))))
+ (list data content-type)))
(defun shr-image-displayer (content-function)
"Return a function to display an image.
@@ -839,18 +1026,22 @@ START, and END. Note that START and END should be markers."
(list (current-buffer) start end)
t t)))))
-(defun shr-heading (cont &rest types)
+(defun shr-heading (dom &rest types)
(shr-ensure-paragraph)
- (apply #'shr-fontize-cont cont types)
+ (apply #'shr-fontize-dom dom types)
(shr-ensure-paragraph))
(defun shr-urlify (start url &optional title)
- (when (and title (string-match "ctx" title)) (debug))
(shr-add-font start (point) 'shr-link)
(add-text-properties
start (point)
(list 'shr-url url
- 'help-echo (if title (format "%s (%s)" url title) url)
+ 'help-echo (let ((iri (or (ignore-errors
+ (decode-coding-string
+ (url-unhex-string url)
+ 'utf-8 t))
+ url)))
+ (if title (format "%s (%s)" iri title) iri))
'follow-link t
'mouse-face 'highlight
'keymap shr-map)))
@@ -885,8 +1076,7 @@ ones, in case fg and bg are nil."
(shr-color-visible bg fg)))))))
(defun shr-colorize-region (start end fg &optional bg)
- (when (and (not shr-inhibit-decoration)
- (or fg bg))
+ (when (and (or fg bg) (>= (display-color-cells) 88))
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
@@ -899,44 +1089,6 @@ ones, in case fg and bg are nil."
t)))
new-colors)))
-(defun shr-expand-newlines (start end color)
- (save-restriction
- ;; Skip past all white space at the start and ends.
- (goto-char start)
- (skip-chars-forward " \t\n")
- (beginning-of-line)
- (setq start (point))
- (goto-char end)
- (skip-chars-backward " \t\n")
- (forward-line 1)
- (setq end (point))
- (narrow-to-region start end)
- (let ((width (shr-buffer-width))
- column)
- (goto-char (point-min))
- (while (not (eobp))
- (end-of-line)
- (when (and (< (setq column (current-column)) width)
- (< (setq column (shr-previous-newline-padding-width column))
- width))
- (let ((overlay (make-overlay (point) (1+ (point)))))
- (overlay-put overlay 'before-string
- (concat
- (mapconcat
- (lambda (overlay)
- (let ((string (plist-get
- (overlay-properties overlay)
- 'before-string)))
- (if (not string)
- ""
- (overlay-put overlay 'before-string "")
- string)))
- (overlays-at (point))
- "")
- (propertize (make-string (- width column) ? )
- 'face (list :background color))))))
- (forward-line 1)))))
-
(defun shr-previous-newline-padding-width (width)
(let ((overlays (overlays-at (point)))
(previous-width 0))
@@ -951,97 +1103,108 @@ ones, in case fg and bg are nil."
;;; Tag-specific rendering rules.
-(defun shr-tag-body (cont)
+(defun shr-tag-body (dom)
(let* ((start (point))
- (fgcolor (cdr (or (assq :fgcolor cont)
- (assq :text cont))))
- (bgcolor (cdr (assq :bgcolor cont)))
+ (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
+ (bgcolor (dom-attr dom 'bgcolor))
(shr-stylesheet (list (cons 'color fgcolor)
(cons 'background-color bgcolor))))
- (shr-generic cont)
+ (shr-generic dom)
(shr-colorize-region start (point) fgcolor bgcolor)))
-(defun shr-tag-style (cont)
+(defun shr-tag-style (_dom)
)
-(defun shr-tag-script (cont)
+(defun shr-tag-script (_dom)
)
-(defun shr-tag-comment (cont)
+(defun shr-tag-comment (_dom)
)
(defun shr-dom-to-xml (dom)
+ (with-temp-buffer
+ (shr-dom-print dom)
+ (buffer-string)))
+
+(defun shr-dom-print (dom)
"Convert DOM into a string containing the xml representation."
- (let ((arg " ")
- (text ""))
- (dolist (sub (cdr dom))
+ (insert (format "<%s" (dom-tag dom)))
+ (dolist (attr (dom-attributes dom))
+ ;; Ignore attributes that start with a colon because they are
+ ;; private elements.
+ (unless (= (aref (format "%s" (car attr)) 0) ?:)
+ (insert (format " %s=\"%s\"" (car attr) (cdr attr)))))
+ (insert ">")
+ (let (url)
+ (dolist (elem (dom-children dom))
(cond
- ((listp (cdr sub))
- (setq text (concat text (shr-dom-to-xml sub))))
- ((eq (car sub) 'text)
- (setq text (concat text (cdr sub))))
- (t
- (setq arg (concat arg (format "%s=\"%s\" "
- (substring (symbol-name (car sub)) 1)
- (cdr sub)))))))
- (format "<%s%s>%s</%s>"
- (car dom)
- (substring arg 0 (1- (length arg)))
- text
- (car dom))))
-
-(defun shr-tag-svg (cont)
- (when (image-type-available-p 'svg)
- (funcall shr-put-image-function
- (shr-dom-to-xml (cons 'svg cont))
- "SVG Image")))
-
-(defun shr-tag-sup (cont)
+ ((stringp elem)
+ (insert elem))
+ ((eq (dom-tag elem) 'comment)
+ )
+ ((or (not (eq (dom-tag elem) 'image))
+ ;; Filter out blocked elements inside the SVG image.
+ (not (setq url (dom-attr elem ':xlink:href)))
+ (not shr-blocked-images)
+ (not (string-match shr-blocked-images url)))
+ (insert " ")
+ (shr-dom-print elem)))))
+ (insert (format "</%s>" (dom-tag dom))))
+
+(defun shr-tag-svg (dom)
+ (when (and (image-type-available-p 'svg)
+ (not shr-inhibit-images))
+ (funcall shr-put-image-function (list (shr-dom-to-xml dom) 'image/svg+xml)
+ "SVG Image")))
+
+(defun shr-tag-sup (dom)
(let ((start (point)))
- (shr-generic cont)
+ (shr-generic dom)
(put-text-property start (point) 'display '(raise 0.5))))
-(defun shr-tag-sub (cont)
+(defun shr-tag-sub (dom)
(let ((start (point)))
- (shr-generic cont)
+ (shr-generic dom)
(put-text-property start (point) 'display '(raise -0.5))))
-(defun shr-tag-label (cont)
- (shr-generic cont)
+(defun shr-tag-label (dom)
+ (shr-generic dom)
(shr-ensure-paragraph))
-(defun shr-tag-p (cont)
+(defun shr-tag-p (dom)
(shr-ensure-paragraph)
- (shr-indent)
- (shr-generic cont)
+ (shr-generic dom)
(shr-ensure-paragraph))
-(defun shr-tag-div (cont)
+(defun shr-tag-div (dom)
(shr-ensure-newline)
- (shr-indent)
- (shr-generic cont)
+ (shr-generic dom)
(shr-ensure-newline))
-(defun shr-tag-s (cont)
- (shr-fontize-cont cont 'shr-strike-through))
+(defun shr-tag-s (dom)
+ (shr-fontize-dom dom 'shr-strike-through))
-(defun shr-tag-del (cont)
- (shr-fontize-cont cont 'shr-strike-through))
+(defun shr-tag-del (dom)
+ (shr-fontize-dom dom 'shr-strike-through))
-(defun shr-tag-b (cont)
- (shr-fontize-cont cont 'bold))
+(defun shr-tag-b (dom)
+ (shr-fontize-dom dom 'bold))
-(defun shr-tag-i (cont)
- (shr-fontize-cont cont 'italic))
+(defun shr-tag-i (dom)
+ (shr-fontize-dom dom 'italic))
-(defun shr-tag-em (cont)
- (shr-fontize-cont cont 'italic))
+(defun shr-tag-em (dom)
+ (shr-fontize-dom dom 'italic))
-(defun shr-tag-strong (cont)
- (shr-fontize-cont cont 'bold))
+(defun shr-tag-strong (dom)
+ (shr-fontize-dom dom 'bold))
-(defun shr-tag-u (cont)
- (shr-fontize-cont cont 'underline))
+(defun shr-tag-u (dom)
+ (shr-fontize-dom dom 'underline))
+
+(defun shr-tag-tt (dom)
+ (let ((shr-current-font 'default))
+ (shr-generic dom)))
(defun shr-parse-style (style)
(when style
@@ -1058,63 +1221,145 @@ ones, in case fg and bg are nil."
(value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem))))
(when (string-match " *!important\\'" value)
(setq value (substring value 0 (match-beginning 0))))
- (push (cons (intern name obarray)
- value)
- plist)))))
+ (unless (equal value "inherit")
+ (push (cons (intern name obarray)
+ value)
+ plist))))))
plist)))
-(defun shr-tag-base (cont)
- (let ((base (cdr (assq :href cont))))
- (when base
- (setq shr-base (shr-parse-base base))))
- (shr-generic cont))
+(defun shr-tag-base (dom)
+ (when-let (base (dom-attr dom 'href))
+ (setq shr-base (shr-parse-base base)))
+ (shr-generic dom))
-(defun shr-tag-a (cont)
- (let ((url (cdr (assq :href cont)))
- (title (cdr (assq :title cont)))
+(defun shr-tag-a (dom)
+ (let ((url (dom-attr dom 'href))
+ (title (dom-attr dom 'title))
(start (point))
shr-start)
- (shr-generic cont)
- (when (and url
- (not shr-inhibit-decoration))
+ (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 (= start (point))
+ (shr-ensure-newline)
+ (insert " "))
+ (put-text-property start (1+ start) 'shr-target-id shr-target-id))
+ (when url
(shr-urlify (or shr-start start) (shr-expand-url url) title))))
-(defun shr-tag-object (cont)
- (let ((start (point))
- url)
- (dolist (elem cont)
- (when (eq (car elem) 'embed)
- (setq url (or url (cdr (assq :src (cdr elem))))))
- (when (and (eq (car elem) 'param)
- (equal (cdr (assq :name (cdr elem))) "movie"))
- (setq url (or url (cdr (assq :value (cdr elem)))))))
- (when url
- (shr-insert " [multimedia] ")
- (shr-urlify start (shr-expand-url url)))
- (shr-generic cont)))
+(defun shr-tag-object (dom)
+ (unless shr-inhibit-images
+ (let ((start (point))
+ url multimedia image)
+ (when-let (type (dom-attr dom 'type))
+ (when (string-match "\\`image/svg" type)
+ (setq url (dom-attr dom 'data)
+ image t)))
+ (dolist (child (dom-non-text-children dom))
+ (cond
+ ((eq (dom-tag child) 'embed)
+ (setq url (or url (dom-attr child 'src))
+ multimedia t))
+ ((and (eq (dom-tag child) 'param)
+ (equal (dom-attr child 'name) "movie"))
+ (setq url (or url (dom-attr child 'value))
+ multimedia t))))
+ (when url
+ (cond
+ (image
+ (shr-tag-img dom url)
+ (setq dom nil))
+ (multimedia
+ (shr-insert " [multimedia] ")
+ (shr-urlify start (shr-expand-url url)))))
+ (when dom
+ (shr-generic dom)))))
+
+(defcustom shr-prefer-media-type-alist '(("webm" . 1.0)
+ ("ogv" . 1.0)
+ ("ogg" . 1.0)
+ ("opus" . 1.0)
+ ("flac" . 0.9)
+ ("wav" . 0.5))
+ "Preferences for media types.
+The key element should be a regexp matched against the type of the source or
+url if no type is specified. The value should be a float in the range 0.0 to
+1.0. Media elements with higher value are preferred."
+ :version "24.4"
+ :group 'shr
+ :type '(alist :key-type regexp :value-type float))
+
+(defun shr--get-media-pref (elem)
+ "Determine the preference for ELEM.
+The preference is a float determined from `shr-prefer-media-type'."
+ (let ((type (dom-attr elem 'type))
+ (p 0.0))
+ (unless type
+ (setq type (dom-attr elem 'src)))
+ (when type
+ (dolist (pref shr-prefer-media-type-alist)
+ (when (and
+ (> (cdr pref) p)
+ (string-match-p (car pref) type))
+ (setq p (cdr pref)))))
+ p))
+
+(defun shr--extract-best-source (dom &optional url pref)
+ "Extract the best `:src' property from <source> blocks in DOM."
+ (setq pref (or pref -1.0))
+ (let (new-pref)
+ (dolist (elem (dom-non-text-children dom))
+ (when (and (eq (dom-tag elem) 'source)
+ (< pref
+ (setq new-pref
+ (shr--get-media-pref elem))))
+ (setq pref new-pref
+ url (dom-attr elem 'src))
+ ;; libxml's html parser isn't HTML5 compliant and non terminated
+ ;; source tags might end up as children. So recursion it is...
+ (dolist (child (dom-non-text-children elem))
+ (when (eq (dom-tag child) 'source)
+ (let ((ret (shr--extract-best-source (list child) url pref)))
+ (when (< pref (cdr ret))
+ (setq url (car ret)
+ pref (cdr ret)))))))))
+ (cons url pref))
+
+(defun shr-tag-video (dom)
+ (let ((image (dom-attr dom 'poster))
+ (url (dom-attr dom 'src))
+ (start (point)))
+ (unless url
+ (setq url (car (shr--extract-best-source dom))))
+ (if image
+ (shr-tag-img nil image)
+ (shr-insert " [video] "))
+ (shr-urlify start (shr-expand-url url))))
-(defun shr-tag-video (cont)
- (let ((image (cdr (assq :poster cont)))
- (url (cdr (assq :src cont)))
- (start (point)))
- (shr-tag-img nil image)
+(defun shr-tag-audio (dom)
+ (let ((url (dom-attr dom 'src))
+ (start (point)))
+ (unless url
+ (setq url (car (shr--extract-best-source dom))))
+ (shr-insert " [audio] ")
(shr-urlify start (shr-expand-url url))))
-(defun shr-tag-img (cont &optional url)
+(defun shr-tag-img (dom &optional url)
(when (or url
- (and cont
- (cdr (assq :src cont))))
- (when (and (> (current-column) 0)
- (not (eq shr-state 'image)))
+ (and dom
+ (> (length (dom-attr dom 'src)) 0)))
+ (when (> (current-column) 0)
(insert "\n"))
- (let ((alt (cdr (assq :alt cont)))
- (url (shr-expand-url (or url (cdr (assq :src cont))))))
+ (let ((alt (dom-attr dom 'alt))
+ (url (shr-expand-url (or url (dom-attr dom 'src)))))
(let ((start (point-marker)))
(when (zerop (length alt))
(setq alt "*"))
(cond
- ((or (member (cdr (assq :height cont)) '("0" "1"))
- (member (cdr (assq :width cont)) '("0" "1")))
+ ((or (member (dom-attr dom 'height) '("0" "1"))
+ (member (dom-attr dom 'width) '("0" "1")))
;; Ignore zero-sized or single-pixel images.
)
((and (not shr-inhibit-images)
@@ -1135,10 +1380,9 @@ ones, in case fg and bg are nil."
(and shr-blocked-images
(string-match shr-blocked-images url)))
(setq shr-start (point))
- (let ((shr-state 'space))
- (if (> (string-width alt) 8)
- (shr-insert (truncate-string-to-width alt 8))
- (shr-insert alt))))
+ (if (> (string-width alt) 8)
+ (shr-insert (truncate-string-to-width alt 8))
+ (shr-insert alt)))
((and (not shr-ignore-cache)
(url-is-cached (shr-encode-url url)))
(funcall shr-put-image-function (shr-get-image-data url) alt))
@@ -1159,108 +1403,131 @@ ones, in case fg and bg are nil."
(put-text-property start (point) 'image-url url)
(put-text-property start (point) 'image-displayer
(shr-image-displayer shr-content-function))
- (put-text-property start (point) 'help-echo alt))
- (setq shr-state 'image)))))
+ (put-text-property start (point) 'help-echo
+ (shr-fill-text
+ (or (dom-attr dom 'title) alt))))))))
-(defun shr-tag-pre (cont)
- (let ((shr-folding-mode 'none))
+(defun shr-tag-pre (dom)
+ (let ((shr-folding-mode 'none)
+ (shr-current-font 'default))
(shr-ensure-newline)
- (shr-indent)
- (shr-generic cont)
+ (shr-generic dom)
(shr-ensure-newline)))
-(defun shr-tag-blockquote (cont)
+(defun shr-tag-blockquote (dom)
(shr-ensure-paragraph)
- (shr-indent)
- (let ((shr-indentation (+ shr-indentation 4)))
- (shr-generic cont))
- (shr-ensure-paragraph))
+ (let ((start (point))
+ (shr-indentation (+ shr-indentation
+ (* 4 shr-table-separator-pixel-width))))
+ (shr-generic dom)
+ (shr-ensure-paragraph)
+ (shr-mark-fill start)))
-(defun shr-tag-dl (cont)
+(defun shr-tag-dl (dom)
(shr-ensure-paragraph)
- (shr-generic cont)
+ (shr-generic dom)
(shr-ensure-paragraph))
-(defun shr-tag-dt (cont)
+(defun shr-tag-dt (dom)
(shr-ensure-newline)
- (shr-generic cont)
+ (shr-generic dom)
(shr-ensure-newline))
-(defun shr-tag-dd (cont)
+(defun shr-tag-dd (dom)
(shr-ensure-newline)
- (let ((shr-indentation (+ shr-indentation 4)))
- (shr-generic cont)))
+ (let ((shr-indentation (+ shr-indentation
+ (* 4 shr-table-separator-pixel-width))))
+ (shr-generic dom)))
-(defun shr-tag-ul (cont)
+(defun shr-tag-ul (dom)
(shr-ensure-paragraph)
(let ((shr-list-mode 'ul))
- (shr-generic cont))
+ (shr-generic dom))
(shr-ensure-paragraph))
-(defun shr-tag-ol (cont)
+(defun shr-tag-ol (dom)
(shr-ensure-paragraph)
(let ((shr-list-mode 1))
- (shr-generic cont))
+ (shr-generic dom))
(shr-ensure-paragraph))
-(defun shr-tag-li (cont)
+(defun shr-tag-li (dom)
(shr-ensure-newline)
- (shr-indent)
- (let* ((bullet
- (if (numberp shr-list-mode)
- (prog1
- (format "%d " shr-list-mode)
- (setq shr-list-mode (1+ shr-list-mode)))
- shr-bullet))
- (shr-indentation (+ shr-indentation (length bullet))))
- (insert bullet)
- (shr-generic cont)))
-
-(defun shr-tag-br (cont)
+ (let ((start (point)))
+ (let* ((bullet
+ (if (numberp shr-list-mode)
+ (prog1
+ (format "%d " shr-list-mode)
+ (setq shr-list-mode (1+ shr-list-mode)))
+ (car shr-internal-bullet)))
+ (width (if (numberp shr-list-mode)
+ (shr-string-pixel-width bullet)
+ (cdr shr-internal-bullet))))
+ (insert bullet)
+ (shr-mark-fill start)
+ (let ((shr-indentation (+ shr-indentation width)))
+ (put-text-property start (1+ start)
+ 'shr-continuation-indentation shr-indentation)
+ (put-text-property start (1+ start) 'shr-prefix-length (length bullet))
+ (shr-generic dom)))))
+
+(defun shr-mark-fill (start)
+ ;; We may not have inserted any text to fill.
+ (unless (= start (point))
+ (put-text-property start (1+ start)
+ 'shr-indentation shr-indentation)))
+
+(defun shr-tag-br (dom)
(when (and (not (bobp))
;; Only add a newline if we break the current line, or
;; the previous line isn't a blank line.
(or (not (bolp))
(and (> (- (point) 2) (point-min))
(not (= (char-after (- (point) 2)) ?\n)))))
- (insert "\n")
- (shr-indent))
- (shr-generic cont))
+ (insert "\n"))
+ (shr-generic dom))
-(defun shr-tag-span (cont)
- (shr-generic cont))
+(defun shr-tag-span (dom)
+ (shr-generic dom))
-(defun shr-tag-h1 (cont)
- (shr-heading cont 'bold 'underline))
+(defun shr-tag-h1 (dom)
+ (shr-heading dom (if shr-use-fonts
+ '(variable-pitch (:height 1.3 :weight bold))
+ 'bold)))
-(defun shr-tag-h2 (cont)
- (shr-heading cont 'bold))
+(defun shr-tag-h2 (dom)
+ (shr-heading dom 'bold))
-(defun shr-tag-h3 (cont)
- (shr-heading cont 'italic))
+(defun shr-tag-h3 (dom)
+ (shr-heading dom 'italic))
-(defun shr-tag-h4 (cont)
- (shr-heading cont))
+(defun shr-tag-h4 (dom)
+ (shr-heading dom))
-(defun shr-tag-h5 (cont)
- (shr-heading cont))
+(defun shr-tag-h5 (dom)
+ (shr-heading dom))
-(defun shr-tag-h6 (cont)
- (shr-heading cont))
+(defun shr-tag-h6 (dom)
+ (shr-heading dom))
-(defun shr-tag-hr (cont)
+(defun shr-tag-hr (_dom)
(shr-ensure-newline)
- (insert (make-string shr-width shr-hr-line) "\n"))
+ (insert (make-string (if (not shr-use-fonts)
+ shr-internal-width
+ (1+ (/ shr-internal-width
+ shr-table-separator-pixel-width)))
+ shr-hr-line)
+ "\n"))
-(defun shr-tag-title (cont)
- (shr-heading cont 'bold 'underline))
+(defun shr-tag-title (dom)
+ (shr-heading dom 'bold 'underline))
-(defun shr-tag-font (cont)
+(defun shr-tag-font (dom)
(let* ((start (point))
- (color (cdr (assq :color cont)))
+ (color (dom-attr dom 'color))
(shr-stylesheet (nconc (list (cons 'color color))
shr-stylesheet)))
- (shr-generic cont)
+ (shr-generic dom)
(when color
(shr-colorize-region start (point) color
(cdr (assq 'background-color shr-stylesheet))))))
@@ -1275,40 +1542,43 @@ ones, in case fg and bg are nil."
;; main buffer). Now we know how much space each TD really takes, so
;; we then render everything again with the new widths, and finally
;; insert all these boxes into the main buffer.
-(defun shr-tag-table-1 (cont)
- (setq cont (or (cdr (assq 'tbody cont))
- cont))
+(defun shr-tag-table-1 (dom)
+ (setq dom (or (dom-child-by-tag dom 'tbody) dom))
(let* ((shr-inhibit-images t)
(shr-table-depth (1+ shr-table-depth))
(shr-kinsoku-shorten t)
;; Find all suggested widths.
- (columns (shr-column-specs cont))
- ;; Compute how many characters wide each TD should be.
+ (columns (shr-column-specs dom))
+ ;; Compute how many pixels wide each TD should be.
(suggested-widths (shr-pro-rate-columns columns))
;; Do a "test rendering" to see how big each TD is (this can
;; be smaller (if there's little text) or bigger (if there's
;; unbreakable text).
- (sketch (shr-make-table cont suggested-widths))
- ;; Compute the "natural" width by setting each column to 500
- ;; characters and see how wide they really render.
- (natural (shr-make-table cont (make-vector (length columns) 500)))
+ (elems (or (dom-attr dom 'shr-suggested-widths)
+ (shr-make-table dom suggested-widths nil
+ 'shr-suggested-widths)))
+ (sketch (loop for line in elems
+ collect (mapcar #'car line)))
+ (natural (loop for line in elems
+ collect (mapcar #'cdr line)))
(sketch-widths (shr-table-widths sketch natural suggested-widths)))
;; This probably won't work very well.
(when (> (+ (loop for width across sketch-widths
summing (1+ width))
- shr-indentation 1)
+ shr-indentation shr-table-separator-pixel-width)
(frame-width))
(setq truncate-lines t))
;; Then render the table again with these new "hard" widths.
- (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+ (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths)))
-(defun shr-tag-table (cont)
+(defun shr-tag-table (dom)
(shr-ensure-paragraph)
- (let* ((caption (cdr (assq 'caption cont)))
- (header (cdr (assq 'thead cont)))
- (body (or (cdr (assq 'tbody cont)) cont))
- (footer (cdr (assq 'tfoot cont)))
- (bgcolor (cdr (assq :bgcolor cont)))
+ (let* ((caption (dom-children (dom-child-by-tag dom 'caption)))
+ (header (dom-non-text-children (dom-child-by-tag dom 'thead)))
+ (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody)
+ dom)))
+ (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot)))
+ (bgcolor (dom-attr dom 'bgcolor))
(start (point))
(shr-stylesheet (nconc (list (cons 'background-color bgcolor))
shr-stylesheet))
@@ -1317,51 +1587,78 @@ ones, in case fg and bg are nil."
(nfooter (if footer (shr-max-columns footer))))
(if (and (not caption)
(not header)
- (not (cdr (assq 'tbody cont)))
- (not (cdr (assq 'tr cont)))
+ (not (dom-child-by-tag dom 'tbody))
+ (not (dom-child-by-tag dom 'tr))
(not footer))
;; The table is totally invalid and just contains random junk.
;; Try to output it anyway.
- (shr-generic cont)
+ (shr-generic dom)
;; It's a real table, so render it.
- (shr-tag-table-1
- (nconc
- (if caption `((tr (td ,@caption))))
- (if header
- (if footer
- ;; hader + body + footer
- (if (= nheader nbody)
- (if (= nbody nfooter)
- `((tr (td (table (tbody ,@header ,@body ,@footer)))))
- (nconc `((tr (td (table (tbody ,@header ,@body)))))
- (if (= nfooter 1)
- footer
- `((tr (td (table (tbody ,@footer))))))))
- (nconc `((tr (td (table (tbody ,@header)))))
- (if (= nbody nfooter)
- `((tr (td (table (tbody ,@body ,@footer)))))
- (nconc `((tr (td (table (tbody ,@body)))))
- (if (= nfooter 1)
- footer
- `((tr (td (table (tbody ,@footer))))))))))
- ;; header + body
- (if (= nheader nbody)
- `((tr (td (table (tbody ,@header ,@body)))))
- (if (= nheader 1)
- `(,@header (tr (td (table (tbody ,@body)))))
- `((tr (td (table (tbody ,@header))))
- (tr (td (table (tbody ,@body))))))))
- (if footer
- ;; body + footer
- (if (= nbody nfooter)
- `((tr (td (table (tbody ,@body ,@footer)))))
- (nconc `((tr (td (table (tbody ,@body)))))
- (if (= nfooter 1)
- footer
- `((tr (td (table (tbody ,@footer))))))))
- (if caption
- `((tr (td (table (tbody ,@body)))))
- body))))))
+ (if (dom-attr dom 'shr-fixed-table)
+ (shr-tag-table-1 dom)
+ ;; Only fix up the table once.
+ (let ((table
+ (nconc
+ (list 'table nil)
+ (if caption `((tr nil (td nil ,@caption))))
+ (cond
+ (header
+ (if footer
+ ;; header + body + footer
+ (if (= nheader nbody)
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table nil
+ (tbody nil ,@header
+ ,@body ,@footer)))))
+ (nconc `((tr nil (td nil (table nil
+ (tbody nil ,@header
+ ,@body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil (tbody
+ nil ,@footer))))))))
+ (nconc `((tr nil (td nil (table nil (tbody
+ nil ,@header)))))
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table
+ nil (tbody nil ,@body
+ ,@footer)))))
+ (nconc `((tr nil (td nil (table
+ nil (tbody nil
+ ,@body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil
+ (tbody
+ nil
+ ,@footer))))))))))
+ ;; header + body
+ (if (= nheader nbody)
+ `((tr nil (td nil (table nil (tbody nil ,@header
+ ,@body)))))
+ (if (= nheader 1)
+ `(,@header (tr nil (td nil (table
+ nil (tbody nil ,@body)))))
+ `((tr nil (td nil (table nil (tbody nil ,@header))))
+ (tr nil (td nil (table nil (tbody nil ,@body)))))))))
+ (footer
+ ;; body + footer
+ (if (= nbody nfooter)
+ `((tr nil (td nil (table
+ nil (tbody nil ,@body ,@footer)))))
+ (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
+ (if (= nfooter 1)
+ footer
+ `((tr nil (td nil (table
+ nil (tbody nil ,@footer)))))))))
+ (caption
+ `((tr nil (td nil (table nil (tbody nil ,@body))))))
+ (body)))))
+ (dom-set-attribute table 'shr-fixed-table t)
+ (setcdr dom (cdr table))
+ (shr-tag-table-1 dom))))
(when bgcolor
(shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
bgcolor))
@@ -1369,54 +1666,113 @@ ones, in case fg and bg are nil."
;; model isn't strong enough to allow us to put the images actually
;; into the tables.
(when (zerop shr-table-depth)
- (dolist (elem (shr-find-elements cont 'img))
- (shr-tag-img (cdr elem))))))
-
-(defun shr-find-elements (cont type)
- (let (result)
- (dolist (elem cont)
- (cond ((eq (car elem) type)
- (push elem result))
- ((consp (cdr elem))
- (setq result (nconc (shr-find-elements (cdr elem) type) result)))))
- (nreverse result)))
+ (save-excursion
+ (shr-expand-alignments start (point)))
+ (dolist (elem (dom-by-tag dom 'object))
+ (shr-tag-object elem))
+ (dolist (elem (dom-by-tag dom 'img))
+ (shr-tag-img elem)))))
(defun shr-insert-table (table widths)
(let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))
"collapse"))
(shr-table-separator-length (if collapse 0 1))
- (shr-table-vertical-line (if collapse "" shr-table-vertical-line)))
+ (shr-table-vertical-line (if collapse "" shr-table-vertical-line))
+ (start (point)))
+ (setq shr-table-id (1+ shr-table-id))
(unless collapse
(shr-insert-table-ruler widths))
(dolist (row table)
(let ((start (point))
+ (align 0)
+ (column-number 0)
(height (let ((max 0))
(dolist (column row)
- (setq max (max max (cadr column))))
+ (setq max (max max (nth 2 column))))
max)))
- (dotimes (i height)
+ (dotimes (i (max height 1))
(shr-indent)
(insert shr-table-vertical-line "\n"))
(dolist (column row)
- (goto-char start)
- (let ((lines (nth 2 column)))
- (dolist (line lines)
- (end-of-line)
- (insert line shr-table-vertical-line)
- (forward-line 1))
- ;; Add blank lines at padding at the bottom of the TD,
- ;; possibly.
- (dotimes (i (- height (length lines)))
- (end-of-line)
- (let ((start (point)))
- (insert (make-string (string-width (car lines)) ? )
- shr-table-vertical-line)
- (when (nth 4 column)
- (shr-add-font start (1- (point))
- (list :background (nth 4 column)))))
- (forward-line 1)))))
+ (when (> (nth 2 column) -1)
+ (goto-char start)
+ ;; Sum up all the widths from the column. (There may be
+ ;; more than one if this is a "colspan" column.)
+ (dotimes (i (nth 4 column))
+ ;; The colspan directive may be wrong and there may not be
+ ;; that number of columns.
+ (when (<= column-number (1- (length widths)))
+ (setq align (+ align
+ (aref widths column-number)
+ (* 2 shr-table-separator-pixel-width))))
+ (setq column-number (1+ column-number)))
+ (let ((lines (nth 3 column))
+ (pixel-align (if (not shr-use-fonts)
+ (* align (frame-char-width))
+ align)))
+ (dolist (line lines)
+ (end-of-line)
+ (let ((start (point)))
+ (insert
+ line
+ (propertize " "
+ 'display `(space :align-to (,pixel-align))
+ 'face (and (> (length line) 0)
+ (shr-face-background
+ (get-text-property
+ (1- (length line)) 'face line)))
+ 'shr-table-indent shr-table-id)
+ shr-table-vertical-line)
+ (shr-colorize-region
+ start (1- (point)) (nth 5 column) (nth 6 column)))
+ (forward-line 1))
+ ;; Add blank lines at padding at the bottom of the TD,
+ ;; possibly.
+ (dotimes (i (- height (length lines)))
+ (end-of-line)
+ (let ((start (point)))
+ (insert (propertize " "
+ 'display `(space :align-to (,pixel-align))
+ 'shr-table-indent shr-table-id)
+ shr-table-vertical-line)
+ (shr-colorize-region
+ start (1- (point)) (nth 5 column) (nth 6 column)))
+ (forward-line 1))))))
(unless collapse
- (shr-insert-table-ruler widths)))))
+ (shr-insert-table-ruler widths)))
+ (unless (= start (point))
+ (put-text-property start (1+ start) 'shr-table-id shr-table-id))))
+
+(defun shr-face-background (face)
+ (and (consp face)
+ (let ((background nil))
+ (dolist (elem face)
+ (when (and (consp elem)
+ (eq (car elem) :background))
+ (setq background (cadr elem))))
+ (and background
+ (list :background background)))))
+
+(defun shr-expand-alignments (start end)
+ (while (< (setq start (next-single-property-change
+ start 'shr-table-id nil end))
+ end)
+ (goto-char start)
+ (let* ((shr-use-fonts t)
+ (id (get-text-property (point) 'shr-table-id))
+ (base (shr-pixel-column))
+ elem)
+ (when id
+ (save-excursion
+ (while (setq elem (text-property-any
+ (point) end 'shr-table-indent id))
+ (goto-char elem)
+ (let ((align (get-text-property (point) 'display)))
+ (put-text-property (point) (1+ (point)) 'display
+ `(space :align-to (,(+ (car (nth 2 align))
+ base)))))
+ (forward-char 1)))))
+ (setq start (1+ start))))
(defun shr-insert-table-ruler (widths)
(when shr-table-horizontal-line
@@ -1424,9 +1780,17 @@ ones, in case fg and bg are nil."
(> shr-indentation 0))
(shr-indent))
(insert shr-table-corner)
- (dotimes (i (length widths))
- (insert (make-string (aref widths i) shr-table-horizontal-line)
- shr-table-corner))
+ (let ((total-width 0))
+ (dotimes (i (length widths))
+ (setq total-width (+ total-width (aref widths i)
+ (* shr-table-separator-pixel-width 2)))
+ (insert (make-string (1+ (/ (aref widths i)
+ shr-table-separator-pixel-width))
+ shr-table-horizontal-line)
+ (propertize " "
+ 'display `(space :align-to (,total-width))
+ 'shr-table-indent shr-table-id)
+ shr-table-corner)))
(insert "\n")))
(defun shr-table-widths (table natural-table suggested-widths)
@@ -1444,7 +1808,8 @@ ones, in case fg and bg are nil."
(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))))
+ (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
;; columns.
@@ -1462,22 +1827,25 @@ ones, in case fg and bg are nil."
(aref widths i))))))))
widths))
-(defun shr-make-table (cont widths &optional fill)
- (or (cadr (assoc (list cont widths fill) shr-content-cache))
- (let ((data (shr-make-table-1 cont widths fill)))
- (push (list (list cont widths fill) data)
+(defun shr-make-table (dom widths &optional fill storage-attribute)
+ (or (cadr (assoc (list dom widths fill) shr-content-cache))
+ (let ((data (shr-make-table-1 dom widths fill)))
+ (push (list (list dom widths fill) data)
shr-content-cache)
+ (when storage-attribute
+ (dom-set-attribute dom storage-attribute data))
data)))
-(defun shr-make-table-1 (cont widths &optional fill)
+(defun shr-make-table-1 (dom widths &optional fill)
(let ((trs nil)
- (shr-inhibit-decoration (not fill))
(rowspans (make-vector (length widths) 0))
+ (colspan-remaining 0)
+ colspan-width colspan-count
width colspan)
- (dolist (row cont)
- (when (eq (car row) 'tr)
+ (dolist (row (dom-non-text-children dom))
+ (when (eq (dom-tag row) 'tr)
(let ((tds nil)
- (columns (cdr row))
+ (columns (dom-non-text-children row))
(i 0)
(width-column 0)
column)
@@ -1491,61 +1859,137 @@ ones, in case fg and bg are nil."
(pop columns)
(aset rowspans i (1- (aref rowspans i)))
'(td)))
- (when (or (memq (car column) '(td th))
- (not column))
- (when (cdr (assq :rowspan (cdr column)))
+ (when (and (not (stringp column))
+ (or (memq (dom-tag column) '(td th))
+ (not column)))
+ (when-let (span (dom-attr column 'rowspan))
(aset rowspans i (+ (aref rowspans i)
- (1- (string-to-number
- (cdr (assq :rowspan (cdr column))))))))
+ (1- (string-to-number span)))))
;; Sanity check for invalid column-spans.
(when (>= width-column (length widths))
(setq width-column 0))
(setq width
(if column
(aref widths width-column)
- 10))
- (when (and fill
- (setq colspan (cdr (assq :colspan (cdr column)))))
+ (* 10 shr-table-separator-pixel-width)))
+ (when (setq colspan (dom-attr column 'colspan))
(setq colspan (min (string-to-number colspan)
;; The colspan may be wrong, so
;; truncate it to the length of the
;; remaining columns.
(- (length widths) i)))
(dotimes (j (1- colspan))
- (if (> (+ i 1 j) (1- (length widths)))
- (setq width (aref widths (1- (length widths))))
- (setq width (+ width
- shr-table-separator-length
- (aref widths (+ i 1 j))))))
- (setq width-column (+ width-column (1- colspan))))
- (when (or column
- (not fill))
- (push (shr-render-td (cdr column) width fill)
- tds))
+ (setq width
+ (if (> (+ i 1 j) (1- (length widths)))
+ ;; If we have a colspan spec that's longer
+ ;; than the table is wide, just use the last
+ ;; width as the width.
+ (aref widths (1- (length widths)))
+ ;; Sum up the widths of the columns we're
+ ;; spanning.
+ (+ width
+ shr-table-separator-length
+ (aref widths (+ i 1 j))))))
+ (setq width-column (+ width-column (1- colspan))
+ colspan-count colspan
+ colspan-remaining colspan))
+ (when column
+ (let ((data (shr-render-td column width fill)))
+ (if (and (not fill)
+ (> colspan-remaining 0))
+ (progn
+ (setq colspan-width (car data))
+ (let ((this-width (/ colspan-width colspan-count)))
+ (push (cons this-width (cadr data)) tds)
+ (setq colspan-remaining (1- colspan-remaining))))
+ (if (not fill)
+ (push (cons (car data) (cadr data)) tds)
+ (push data tds)))))
+ (when (and colspan
+ (> colspan 1))
+ (dotimes (c (1- colspan))
+ (setq i (1+ i))
+ (push
+ (if fill
+ (list 0 0 -1 nil 1 nil nil)
+ '(0 . 0))
+ tds)))
(setq i (1+ i)
width-column (1+ width-column))))
(push (nreverse tds) trs))))
(nreverse trs)))
-(defun shr-render-td (cont width fill)
+(defun shr-pixel-buffer-width ()
+ (if (not shr-use-fonts)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((max 0))
+ (while (not (eobp))
+ (end-of-line)
+ (setq max (max max (current-column)))
+ (forward-line 1))
+ max))
+ (if (get-buffer-window)
+ (car (window-text-pixel-size nil (point-min) (point-max)))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (car (window-text-pixel-size nil (point-min) (point-max)))))))
+
+(defun shr-render-td (dom width fill)
+ (let ((cache (intern (format "shr-td-cache-%s-%s" width fill))))
+ (or (dom-attr dom cache)
+ (and fill
+ (let (result)
+ (dolist (attr (dom-attributes dom))
+ (let ((name (symbol-name (car attr))))
+ (when (string-match "shr-td-cache-\\([0-9]+\\)-nil" name)
+ (let ((cache-width (string-to-number
+ (match-string 1 name))))
+ (when (and (>= cache-width width)
+ (<= (car (cdr attr)) width))
+ (setq result (cdr attr)))))))
+ result))
+ (let ((result (shr-render-td-1 dom width fill)))
+ (dom-set-attribute dom cache result)
+ result))))
+
+(defun shr-render-td-1 (dom width fill)
(with-temp-buffer
- (let ((bgcolor (cdr (assq :bgcolor cont)))
- (fgcolor (cdr (assq :fgcolor cont)))
- (style (cdr (assq :style cont)))
+ (let ((bgcolor (dom-attr dom 'bgcolor))
+ (fgcolor (dom-attr dom 'fgcolor))
+ (style (dom-attr dom 'style))
(shr-stylesheet shr-stylesheet)
- actual-colors)
+ (max-width 0)
+ natural-width)
(when style
(setq style (and (string-match "color" style)
(shr-parse-style style))))
(when bgcolor
- (setq style (nconc (list (cons 'background-color bgcolor)) style)))
+ (setq style (nconc (list (cons 'background-color bgcolor))
+ style)))
(when fgcolor
(setq style (nconc (list (cons 'color fgcolor)) style)))
(when style
(setq shr-stylesheet (append style shr-stylesheet)))
- (let ((shr-width width)
+ (let ((shr-internal-width width)
(shr-indentation 0))
- (shr-descend (cons 'td cont)))
+ (shr-descend dom))
+ (save-window-excursion
+ (set-window-buffer nil (current-buffer))
+ (unless fill
+ (setq natural-width
+ (or (dom-attr dom 'shr-td-cache-natural)
+ (let ((natural (max (shr-pixel-buffer-width)
+ (shr-dom-max-natural-width dom 0))))
+ (dom-set-attribute dom 'shr-td-cache-natural natural)
+ natural))))
+ (if (and natural-width
+ (<= natural-width width))
+ (setq max-width natural-width)
+ (let ((shr-internal-width width))
+ (shr-fill-lines (point-min) (point-max))
+ (setq max-width (shr-pixel-buffer-width)))))
+ (goto-char (point-max))
;; Delete padding at the bottom of the TDs.
(delete-region
(point)
@@ -1554,48 +1998,31 @@ ones, in case fg and bg are nil."
(end-of-line)
(point)))
(goto-char (point-min))
- (let ((max 0))
- (while (not (eobp))
- (end-of-line)
- (setq max (max max (current-column)))
- (forward-line 1))
- (when fill
- (goto-char (point-min))
- ;; If the buffer is totally empty, then put a single blank
- ;; line here.
- (if (zerop (buffer-size))
- (insert (make-string width ? ))
- ;; Otherwise, fill the buffer.
- (let ((align (cdr (assq :align cont)))
- length)
- (while (not (eobp))
- (end-of-line)
- (setq length (- width (current-column)))
- (when (> length 0)
- (cond
- ((equal align "right")
- (beginning-of-line)
- (insert (make-string length ? )))
- ((equal align "center")
- (insert (make-string (/ length 2) ? ))
- (beginning-of-line)
- (insert (make-string (- length (/ length 2)) ? )))
- (t
- (insert (make-string length ? )))))
- (forward-line 1))))
- (when style
- (setq actual-colors
- (shr-colorize-region
- (point-min) (point-max)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet))))))
- (if fill
- (list max
- (count-lines (point-min) (point-max))
- (split-string (buffer-string) "\n")
- nil
- (car actual-colors))
- max)))))
+ (list max-width
+ natural-width
+ (count-lines (point-min) (point-max))
+ (split-string (buffer-string) "\n")
+ (if (dom-attr dom 'colspan)
+ (string-to-number (dom-attr dom 'colspan))
+ 1)
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color shr-stylesheet))))))
+
+(defun shr-dom-max-natural-width (dom max)
+ (if (eq (dom-tag dom) 'table)
+ (max max (or
+ (loop for line in (dom-attr dom 'shr-suggested-widths)
+ maximize (+
+ shr-table-separator-length
+ (loop for elem in line
+ summing
+ (+ (cdr elem)
+ (* 2 shr-table-separator-length)))))
+ 0))
+ (dolist (child (dom-children dom))
+ (unless (stringp child)
+ (setq max (max (shr-dom-max-natural-width child max)))))
+ max))
(defun shr-buffer-width ()
(goto-char (point-min))
@@ -1615,19 +2042,21 @@ ones, in case fg and bg are nil."
(dotimes (i (length columns))
(aset widths i (max (truncate (* (aref columns i)
total-percentage
- (- shr-width (1+ (length columns)))))
+ (- shr-internal-width
+ (* (1+ (length columns))
+ shr-table-separator-pixel-width))))
10)))
widths))
;; Return a summary of the number and shape of the TDs in the table.
-(defun shr-column-specs (cont)
- (let ((columns (make-vector (shr-max-columns cont) 1)))
- (dolist (row cont)
- (when (eq (car row) 'tr)
+(defun shr-column-specs (dom)
+ (let ((columns (make-vector (shr-max-columns dom) 1)))
+ (dolist (row (dom-non-text-children dom))
+ (when (eq (dom-tag row) 'tr)
(let ((i 0))
- (dolist (column (cdr row))
- (when (memq (car column) '(td th))
- (let ((width (cdr (assq :width (cdr column)))))
+ (dolist (column (dom-non-text-children row))
+ (when (memq (dom-tag column) '(td th))
+ (let ((width (dom-attr column 'width)))
(when (and width
(string-match "\\([0-9]+\\)%" width)
(not (zerop (setq width (string-to-number
@@ -1636,25 +2065,23 @@ ones, in case fg and bg are nil."
(setq i (1+ i)))))))
columns))
-(defun shr-count (cont elem)
+(defun shr-count (dom elem)
(let ((i 0))
- (dolist (sub cont)
- (when (eq (car sub) elem)
+ (dolist (sub (dom-children dom))
+ (when (and (not (stringp sub))
+ (eq (dom-tag sub) elem))
(setq i (1+ i))))
i))
-(defun shr-max-columns (cont)
+(defun shr-max-columns (dom)
(let ((max 0))
- (dolist (row cont)
- (when (eq (car row) 'tr)
- (setq max (max max (+ (shr-count (cdr row) 'td)
- (shr-count (cdr row) 'th))))))
+ (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))))))
max))
(provide 'shr)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; shr.el ends here
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index cdefc22cd87..e5740ac560e 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -1,6 +1,6 @@
;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode
-;; Copyright (C) 1995, 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Paul D. Smith <psmith@BayNetworks.com>
;; Keywords: data
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 1d4a9b573da..264a39c1899 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1,12 +1,14 @@
-;;;; soap-client.el -- Access SOAP web services from Emacs
+;;;; soap-client.el -- Access SOAP web services -*- lexical-binding: t -*-
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
+;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
;; Created: December, 2009
+;; Version: 3.0.1
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
-;; Homepage: http://code.google.com/p/emacs-soap-client
+;; Homepage: https://github.com/alex-hhh/emacs-soap-client
;; This file is part of GNU Emacs.
@@ -43,15 +45,20 @@
(eval-when-compile (require 'cl))
(require 'xml)
+(require 'xsd-regexp)
+(require 'rng-xsd)
+(require 'rng-dt)
(require 'warnings)
(require 'url)
(require 'url-http)
(require 'url-util)
+(require 'url-vars)
(require 'mm-decode)
(defsubst soap-warning (message &rest args)
"Display a warning MESSAGE with ARGS, using the 'soap-client warning type."
- (display-warning 'soap-client (apply 'format message args) :warning))
+ (display-warning 'soap-client (apply #'format-message message args)
+ :warning))
(defgroup soap-client nil
"Access SOAP web services from Emacs."
@@ -73,13 +80,17 @@
("wsdlsoap" . "http://schemas.xmlsoap.org/wsdl/soap/")
("xsd" . "http://www.w3.org/2001/XMLSchema")
("xsi" . "http://www.w3.org/2001/XMLSchema-instance")
+ ("wsa" . "http://www.w3.org/2005/08/addressing")
+ ("wsaw" . "http://www.w3.org/2006/05/addressing/wsdl")
("soap" . "http://schemas.xmlsoap.org/soap/envelope/")
("soap12" . "http://schemas.xmlsoap.org/wsdl/soap12/")
("http" . "http://schemas.xmlsoap.org/wsdl/http/")
- ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/"))
+ ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/")
+ ("xml" . "http://www.w3.org/XML/1998/namespace"))
"A list of well known xml namespaces and their aliases.")
-(defvar soap-local-xmlns nil
+(defvar soap-local-xmlns
+ '(("xml" . "http://www.w3.org/XML/1998/namespace"))
"A list of local namespace aliases.
This is a dynamically bound variable, controlled by
`soap-with-local-xmlns'.")
@@ -97,6 +108,10 @@ are fully qualified for a different namespace. This is a
dynamically bound variable, controlled by
`soap-with-local-xmlns'")
+(defvar soap-current-wsdl nil
+ "The current WSDL document used when decoding the SOAP response.
+This is a dynamically bound variable.")
+
(defun soap-wk2l (well-known-name)
"Return local variant of WELL-KNOWN-NAME.
This is done by looking up the namespace in the
@@ -105,24 +120,24 @@ the local name based on the current local translation table
`soap-local-xmlns'. See also `soap-with-local-xmlns'."
(let ((wk-name-1 (if (symbolp well-known-name)
(symbol-name well-known-name)
- well-known-name)))
+ well-known-name)))
(cond
- ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1)
- (let ((ns (match-string 1 wk-name-1))
- (name (match-string 2 wk-name-1)))
- (let ((namespace (cdr (assoc ns soap-well-known-xmlns))))
- (cond ((equal namespace soap-default-xmlns)
- ;; Name is unqualified in the default namespace
- (if (symbolp well-known-name)
- (intern name)
- name))
- (t
- (let* ((local-ns (car (rassoc namespace soap-local-xmlns)))
- (local-name (concat local-ns ":" name)))
- (if (symbolp well-known-name)
- (intern local-name)
- local-name)))))))
- (t well-known-name))))
+ ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1)
+ (let ((ns (match-string 1 wk-name-1))
+ (name (match-string 2 wk-name-1)))
+ (let ((namespace (cdr (assoc ns soap-well-known-xmlns))))
+ (cond ((equal namespace soap-default-xmlns)
+ ;; Name is unqualified in the default namespace
+ (if (symbolp well-known-name)
+ (intern name)
+ name))
+ (t
+ (let* ((local-ns (car (rassoc namespace soap-local-xmlns)))
+ (local-name (concat local-ns ":" name)))
+ (if (symbolp well-known-name)
+ (intern local-name)
+ local-name)))))))
+ (t well-known-name))))
(defun soap-l2wk (local-name)
"Convert LOCAL-NAME into a well known name.
@@ -133,40 +148,37 @@ used in the name.
nil is returned if there is no well-known namespace for the
namespace of LOCAL-NAME."
(let ((l-name-1 (if (symbolp local-name)
- (symbol-name local-name)
- local-name))
+ (symbol-name local-name)
+ local-name))
namespace name)
(cond
- ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1)
- (setq name (match-string 2 l-name-1))
- (let ((ns (match-string 1 l-name-1)))
- (setq namespace (cdr (assoc ns soap-local-xmlns)))
- (unless namespace
- (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns))))
- (t
- (setq name l-name-1)
- (setq namespace soap-default-xmlns)))
+ ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1)
+ (setq name (match-string 2 l-name-1))
+ (let ((ns (match-string 1 l-name-1)))
+ (setq namespace (cdr (assoc ns soap-local-xmlns)))
+ (unless namespace
+ (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns))))
+ (t
+ (setq name l-name-1)
+ (setq namespace soap-default-xmlns)))
(if namespace
(let ((well-known-ns (car (rassoc namespace soap-well-known-xmlns))))
(if well-known-ns
(let ((well-known-name (concat well-known-ns ":" name)))
- (if (symbol-name local-name)
+ (if (symbolp local-name)
(intern well-known-name)
- well-known-name))
- (progn
- ;; (soap-warning "soap-l2wk(%s): namespace %s has no well-known tag"
- ;; local-name namespace)
- nil)))
- ;; if no namespace is defined, just return the unqualified name
- name)))
+ well-known-name))
+ nil))
+ ;; if no namespace is defined, just return the unqualified name
+ name)))
(defun soap-l2fq (local-name &optional use-tns)
"Convert LOCAL-NAME into a fully qualified name.
A fully qualified name is a cons of the namespace name and the
name of the element itself. For example \"xsd:string\" is
-converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\"\).
+converted to (\"http://www.w3.org/2001/XMLSchema\" . \"string\").
The USE-TNS argument specifies what to do when LOCAL-NAME has no
namespace tag. If USE-TNS is non-nil, the `soap-target-xmlns'
@@ -177,19 +189,27 @@ This is needed because different parts of a WSDL document can use
different namespace aliases for the same element."
(let ((local-name-1 (if (symbolp local-name)
(symbol-name local-name)
- local-name)))
+ local-name)))
(cond ((string-match "^\\(.*\\):\\(.*\\)$" local-name-1)
(let ((ns (match-string 1 local-name-1))
(name (match-string 2 local-name-1)))
(let ((namespace (cdr (assoc ns soap-local-xmlns))))
(if namespace
(cons namespace name)
- (error "Soap-l2fq(%s): unknown alias %s" local-name ns)))))
+ (error "Soap-l2fq(%s): unknown alias %s" local-name ns)))))
(t
(cons (if use-tns
soap-target-xmlns
- soap-default-xmlns)
- local-name)))))
+ soap-default-xmlns)
+ local-name-1)))))
+
+(defun soap-name-p (name)
+ "Return true if NAME is a valid name for XMLSchema types.
+A valid name is either a string or a cons of (NAMESPACE . NAME)."
+ (or (stringp name)
+ (and (consp name)
+ (stringp (car name))
+ (stringp (cdr name)))))
(defun soap-extract-xmlns (node &optional xmlns-table)
"Return a namespace alias table for NODE by extending XMLNS-TABLE."
@@ -210,16 +230,10 @@ different namespace aliases for the same element."
;; the target namespace.
(unless (equal target-ns (cdr tns))
(soap-warning
- "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch"
- (xml-node-name node))))
+ "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch"
+ (xml-node-name node))))
((and tns (not target-ns))
- (setq target-ns (cdr tns)))
- ((and (not tns) target-ns)
- ;; a tns alias was not defined in this node. See if the node has
- ;; a "targetNamespace" attribute and add an alias to this. Note
- ;; that we might override an existing tns alias in XMLNS-TABLE,
- ;; but that is intended.
- (push (cons "tns" target-ns) xmlns))))
+ (setq target-ns (cdr tns)))))
(list default-ns target-ns (append xmlns xmlns-table))))
@@ -249,13 +263,21 @@ namespace tag."
(when (and (consp c)
(soap-with-local-xmlns c
;; We use `ignore-errors' here because we want to silently
- ;; skip nodes for which we cannot convert them to a
- ;; well-known name.
+ ;; skip nodes when we cannot convert them to a well-known
+ ;; name.
(eq (ignore-errors (soap-l2wk (xml-node-name c)))
- child-name)))
+ child-name)))
(push c result)))
(nreverse result)))
+(defun soap-xml-node-find-matching-child (node set)
+ "Return the first child of NODE whose name is a member of SET."
+ (catch 'found
+ (dolist (child (xml-node-children node))
+ (when (and (consp child)
+ (memq (soap-l2wk (xml-node-name child)) set))
+ (throw 'found child)))))
+
(defun soap-xml-get-attribute-or-nil1 (node attribute)
"Return the NODE's ATTRIBUTE, or nil if it does not exist.
This is the same as `xml-get-attribute-or-nil', but ATTRIBUTE can
@@ -286,8 +308,13 @@ be tagged with a namespace tag."
"Return a fully qualified name for ELEMENT.
A fq name is the concatenation of the namespace tag and the
element name."
- (concat (soap-element-namespace-tag element)
- ":" (soap-element-name element)))
+ (cond ((soap-element-namespace-tag element)
+ (concat (soap-element-namespace-tag element)
+ ":" (soap-element-name element)))
+ ((soap-element-name element)
+ (soap-element-name element))
+ (t
+ "*unnamed*")))
;; a namespace link stores an alias for an object in once namespace to a
;; "target" object possibly in a different namespace
@@ -310,11 +337,8 @@ discriminant predicate to `soap-namespace-get'"
(let ((name (soap-element-name element)))
(push element (gethash name (soap-namespace-elements ns)))))
-(defun soap-namespace-put-link (name target ns &optional replace)
+(defun soap-namespace-put-link (name target ns)
"Store a link from NAME to TARGET in NS.
-An error will be signaled if an element by the same name is
-already present in NS, unless REPLACE is non nil.
-
TARGET can be either a SOAP-ELEMENT or a string denoting an
element name into another namespace.
@@ -356,34 +380,1563 @@ binding) but the same name."
((= (length elements) 1) (car elements))
((> (length elements) 1)
(error
- "Soap-namespace-get(%s): multiple elements, discriminant needed"
- name))
+ "Soap-namespace-get(%s): multiple elements, discriminant needed"
+ name))
(t
nil))))
-;;;; WSDL documents
-;;;;; WSDL document elements
+;;;; XML Schema
-(defstruct (soap-basic-type (:include soap-element))
- kind ; a symbol of: string, dateTime, long, int
- )
+;; SOAP WSDL documents use XML Schema to define the types that are part of the
+;; message exchange. We include here an XML schema model with a parser and
+;; serializer/deserialiser.
-(defstruct (soap-simple-type (:include soap-basic-type))
- enumeration)
+(defstruct (soap-xs-type (:include soap-element))
+ id
+ attributes
+ attribute-groups)
-(defstruct soap-sequence-element
- name type nillable? multiple?)
+;;;;; soap-xs-basic-type
-(defstruct (soap-sequence-type (:include soap-element))
- parent ; OPTIONAL WSDL-TYPE name
- elements ; LIST of SOAP-SEQUENCE-ELEMENT
+(defstruct (soap-xs-basic-type (:include soap-xs-type))
+ ;; Basic types are "built in" and we know how to handle them directly.
+ ;; Other type definitions reference basic types, so we need to create them
+ ;; in a namespace (see `soap-make-xs-basic-types')
+
+ ;; a symbol of: string, dateTime, long, int, etc
+ kind
)
-(defstruct (soap-array-type (:include soap-element))
- element-type ; WSDL-TYPE of the array elements
+(defun soap-make-xs-basic-types (namespace-name &optional namespace-tag)
+ "Construct NAMESPACE-NAME containing the XMLSchema basic types.
+An optional NAMESPACE-TAG can also be specified."
+ (let ((ns (make-soap-namespace :name namespace-name)))
+ (dolist (type '("string" "language" "ID" "IDREF"
+ "dateTime" "time" "date" "boolean"
+ "gYearMonth" "gYear" "gMonthDay" "gDay" "gMonth"
+ "long" "short" "int" "integer" "nonNegativeInteger"
+ "unsignedLong" "unsignedShort" "unsignedInt"
+ "decimal" "duration"
+ "byte" "unsignedByte"
+ "float" "double"
+ "base64Binary" "anyType" "anyURI" "QName" "Array" "byte[]"))
+ (soap-namespace-put
+ (make-soap-xs-basic-type :name type
+ :namespace-tag namespace-tag
+ :kind (intern type))
+ ns))
+ ns))
+
+(defun soap-encode-xs-basic-type-attributes (value type)
+ "Encode the XML attributes for VALUE according to TYPE.
+The xsi:type and an optional xsi:nil attributes are added. The
+attributes are inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-attributes' for
+`soap-xs-basic-type' objects."
+ (let ((xsi-type (soap-element-fq-name type))
+ (basic-type (soap-xs-basic-type-kind type)))
+ ;; try to classify the type based on the value type and use that type when
+ ;; encoding
+ (when (eq basic-type 'anyType)
+ (cond ((stringp value)
+ (setq xsi-type "xsd:string" basic-type 'string))
+ ((integerp value)
+ (setq xsi-type "xsd:int" basic-type 'int))
+ ((memq value '(t nil))
+ (setq xsi-type "xsd:boolean" basic-type 'boolean))
+ (t
+ (error "Cannot classify anyType value"))))
+
+ (insert " xsi:type=\"" xsi-type "\"")
+ ;; We have some ambiguity here, as a nil value represents "false" when the
+ ;; type is boolean, we will never have a "nil" boolean type...
+ (unless (or value (eq basic-type 'boolean))
+ (insert " xsi:nil=\"true\""))))
+
+(defun soap-encode-xs-basic-type (value type)
+ "Encode the VALUE according to TYPE.
+The data is inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-value' for
+`soap-xs-basic-type' objects."
+ (let ((kind (soap-xs-basic-type-kind type)))
+
+ (when (eq kind 'anyType)
+ (cond ((stringp value)
+ (setq kind 'string))
+ ((integerp value)
+ (setq kind 'int))
+ ((memq value '(t nil))
+ (setq kind 'boolean))
+ (t
+ (error "Cannot classify anyType value"))))
+
+ ;; NOTE: a nil value is not encoded, as an xsi:nil="true" attribute was
+ ;; encoded for it. However, we have some ambiguity here, as a nil value
+ ;; also represents "false" when the type is boolean...
+
+ (when (or value (eq kind 'boolean))
+ (let ((value-string
+ (case kind
+ ((string anyURI QName ID IDREF language)
+ (unless (stringp value)
+ (error "Not a string value: %s" value))
+ (url-insert-entities-in-string value))
+ ((dateTime time date gYearMonth gYear gMonthDay gDay gMonth)
+ (cond ((consp value)
+ ;; Value is a (current-time) style value,
+ ;; convert to the ISO 8601-inspired XSD
+ ;; string format in UTC.
+ (format-time-string
+ (concat
+ (ecase kind
+ (dateTime "%Y-%m-%dT%H:%M:%S")
+ (time "%H:%M:%S")
+ (date "%Y-%m-%d")
+ (gYearMonth "%Y-%m")
+ (gYear "%Y")
+ (gMonthDay "--%m-%d")
+ (gDay "---%d")
+ (gMonth "--%m"))
+ ;; Internal time is always in UTC.
+ "Z")
+ value t))
+ ((stringp value)
+ ;; Value is a string in the ISO 8601-inspired XSD
+ ;; format. Validate it.
+ (soap-decode-date-time value kind)
+ (url-insert-entities-in-string value))
+ (t
+ (error "Invalid date-time format"))))
+ (boolean
+ (unless (memq value '(t nil))
+ (error "Not a boolean value"))
+ (if value "true" "false"))
+
+ ((long short int integer byte unsignedInt unsignedLong
+ unsignedShort nonNegativeInteger decimal duration)
+ (unless (integerp value)
+ (error "Not an integer value"))
+ (when (and (memq kind '(unsignedInt unsignedLong
+ unsignedShort
+ nonNegativeInteger))
+ (< value 0))
+ (error "Not a positive integer"))
+ (number-to-string value))
+
+ ((float double)
+ (unless (numberp value)
+ (error "Not a number"))
+ (number-to-string value))
+
+ (base64Binary
+ (unless (stringp value)
+ (error "Not a string value for base64Binary"))
+ (base64-encode-string value))
+
+ (otherwise
+ (error "Don't know how to encode %s for type %s"
+ value (soap-element-fq-name type))))))
+ (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)
+ "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 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
+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)))
+ (year-sign (progn
+ (string-match datetime-regexp date-time-string)
+ (match-string 1 date-time-string)))
+ (year (match-string 2 date-time-string))
+ (month (match-string 3 date-time-string))
+ (day (match-string 4 date-time-string))
+ (hour (match-string 5 date-time-string))
+ (minute (match-string 6 date-time-string))
+ (second (match-string 7 date-time-string))
+ (second-fraction (match-string 8 date-time-string))
+ (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))
+ (time-zone-minute (match-string 12 date-time-string)))
+ (setq year-sign (if year-sign -1 1))
+ (setq year
+ (if year
+ (* year-sign
+ (string-to-number year))
+ ;; By defaulting to the epoch date, a time value can be treated as
+ ;; a relative number of seconds.
+ 1970))
+ (setq month
+ (if month (string-to-number month) 1))
+ (setq day
+ (if day (string-to-number day) 1))
+ (setq hour
+ (if hour (string-to-number hour) 0))
+ (setq minute
+ (if minute (string-to-number minute) 0))
+ (setq second
+ (if second (string-to-number second) 0))
+ (setq second-fraction
+ (if second-fraction
+ (float (string-to-number second-fraction))
+ 0.0))
+ (setq has-time-zone (and has-time-zone t))
+ (setq time-zone-sign
+ (if (equal time-zone-sign "-") -1 1))
+ (setq time-zone-hour
+ (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))
+ (unless (and
+ ;; XSD does not allow year 0.
+ (> year 0)
+ (>= month 1) (<= month 12)
+ (>= day 1) (<= day (rng-xsd-days-in-month year month))
+ (>= hour 0) (<= hour 23)
+ (>= minute 0) (<= minute 59)
+ ;; 60 represents a leap second, but leap seconds are explicitly
+ ;; disallowed by the XML Schema 1.1 specification. This agrees
+ ;; with typical Emacs installations, which don't count leap
+ ;; seconds in time values.
+ (>= second 0) (<= second 59)
+ (>= time-zone-hour 0)
+ (<= time-zone-hour 23)
+ (>= 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 ...).
+ (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))))
+
+(defun soap-decode-xs-basic-type (type node)
+ "Use TYPE, a `soap-xs-basic-type', to decode the contents of NODE.
+A LISP value is returned based on the contents of NODE and the
+type-info stored in TYPE.
+
+This is a specialization of `soap-decode-type' for
+`soap-xs-basic-type' objects."
+ (let ((contents (xml-node-children node))
+ (kind (soap-xs-basic-type-kind type))
+ (attributes (xml-node-attributes node))
+ (validate-type type)
+ (is-nil nil))
+
+ (dolist (attribute attributes)
+ (let ((attribute-type (soap-l2fq (car attribute)))
+ (attribute-value (cdr attribute)))
+ ;; xsi:type can override an element's expected type.
+ (when (equal attribute-type (soap-l2fq "xsi:type"))
+ (setq validate-type
+ (soap-wsdl-get attribute-value soap-current-wsdl)))
+ ;; xsi:nil can specify that an element is nil in which case we don't
+ ;; validate it.
+ (when (equal attribute-type (soap-l2fq "xsi:nil"))
+ (setq is-nil (string= (downcase attribute-value) "true")))))
+
+ (unless is-nil
+ ;; For validation purposes, when xml-node-children returns nil, treat it
+ ;; as the empty string.
+ (soap-validate-xs-basic-type (car (or contents (list ""))) validate-type))
+
+ (if (null contents)
+ nil
+ (ecase kind
+ ((string anyURI QName ID IDREF language) (car contents))
+ ((dateTime time date gYearMonth gYear gMonthDay gDay gMonth)
+ (car contents))
+ ((long short int integer
+ unsignedInt unsignedLong unsignedShort nonNegativeInteger
+ decimal byte float double duration)
+ (string-to-number (car contents)))
+ (boolean (string= (downcase (car contents)) "true"))
+ (base64Binary (base64-decode-string (car contents)))
+ (anyType (soap-decode-any-type node))
+ (Array (soap-decode-array node))))))
+
+;; Register methods for `soap-xs-basic-type'
+(let ((tag (aref (make-soap-xs-basic-type) 0)))
+ (put tag 'soap-attribute-encoder #'soap-encode-xs-basic-type-attributes)
+ (put tag 'soap-encoder #'soap-encode-xs-basic-type)
+ (put tag 'soap-decoder #'soap-decode-xs-basic-type))
+
+;;;;; soap-xs-element
+
+(defstruct (soap-xs-element (:include soap-element))
+ ;; NOTE: we don't support exact number of occurrences via minOccurs,
+ ;; maxOccurs. Instead we support optional? and multiple?
+
+ id
+ type^ ; note: use soap-xs-element-type to retrieve this member
+ optional?
+ multiple?
+ reference
+ substitution-group
+ ;; contains a list of elements who point to this one via their
+ ;; substitution-group slot
+ alternatives
+ is-group)
+
+(defun soap-xs-element-type (element)
+ "Retrieve the type of ELEMENT.
+This is normally stored in the TYPE^ slot, but if this element
+contains a reference, we retrive the type of the reference."
+ (if (soap-xs-element-reference element)
+ (soap-xs-element-type (soap-xs-element-reference element))
+ (soap-xs-element-type^ element)))
+
+(defun soap-node-optional (node)
+ "Return t if NODE specifies an optional element."
+ (or (equal (xml-get-attribute-or-nil node 'nillable) "true")
+ (let ((e (xml-get-attribute-or-nil node 'minOccurs)))
+ (and e (equal e "0")))))
+
+(defun soap-node-multiple (node)
+ "Return t if NODE permits multiple elements."
+ (let* ((e (xml-get-attribute-or-nil node 'maxOccurs)))
+ (and e (not (equal e "1")))))
+
+(defun soap-xs-parse-element (node)
+ "Construct a `soap-xs-element' from NODE."
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ (id (xml-get-attribute-or-nil node 'id))
+ (type (xml-get-attribute-or-nil node 'type))
+ (optional? (soap-node-optional node))
+ (multiple? (soap-node-multiple node))
+ (ref (xml-get-attribute-or-nil node 'ref))
+ (substitution-group (xml-get-attribute-or-nil node 'substitutionGroup))
+ (node-name (soap-l2wk (xml-node-name node))))
+ (assert (memq node-name '(xsd:element xsd:group))
+ "expecting xsd:element or xsd:group, got %s" node-name)
+
+ (when type
+ (setq type (soap-l2fq type 'tns)))
+
+ (when ref
+ (setq ref (soap-l2fq ref 'tns)))
+
+ (when substitution-group
+ (setq substitution-group (soap-l2fq substitution-group 'tns)))
+
+ (unless (or ref type)
+ ;; no type specified and this is not a reference. Must be a type
+ ;; defined within this node.
+ (let ((simple-type (soap-xml-get-children1 node 'xsd:simpleType)))
+ (if simple-type
+ (setq type (soap-xs-parse-simple-type (car simple-type)))
+ ;; else
+ (let ((complex-type (soap-xml-get-children1 node 'xsd:complexType)))
+ (if complex-type
+ (setq type (soap-xs-parse-complex-type (car complex-type)))
+ ;; else
+ (error "Soap-xs-parse-element: missing type or ref"))))))
+
+ (make-soap-xs-element :name name
+ ;; Use the full namespace name for now, we will
+ ;; convert it to a nstag in
+ ;; `soap-resolve-references-for-xs-element'
+ :namespace-tag soap-target-xmlns
+ :id id :type^ type
+ :optional? optional? :multiple? multiple?
+ :reference ref
+ :substitution-group substitution-group
+ :is-group (eq node-name 'xsd:group))))
+
+(defun soap-resolve-references-for-xs-element (element wsdl)
+ "Replace names in ELEMENT with the referenced objects in the WSDL.
+This is a specialization of `soap-resolve-references' for
+`soap-xs-element' objects.
+
+See also `soap-wsdl-resolve-references'."
+
+ (let ((namespace (soap-element-namespace-tag element)))
+ (when namespace
+ (let ((nstag (car (rassoc namespace (soap-wsdl-alias-table wsdl)))))
+ (when nstag
+ (setf (soap-element-namespace-tag element) nstag)))))
+
+ (let ((type (soap-xs-element-type^ element)))
+ (cond ((soap-name-p type)
+ (setf (soap-xs-element-type^ element)
+ (soap-wsdl-get type wsdl 'soap-xs-type-p)))
+ ((soap-xs-type-p type)
+ ;; an inline defined type, this will not be reached from anywhere
+ ;; else, so we must resolve references now.
+ (soap-resolve-references type wsdl))))
+ (let ((reference (soap-xs-element-reference element)))
+ (when (and (soap-name-p reference)
+ ;; xsd:group reference nodes will be converted to inline types
+ ;; by soap-resolve-references-for-xs-complex-type, so skip them
+ ;; here.
+ (not (soap-xs-element-is-group element)))
+ (setf (soap-xs-element-reference element)
+ (soap-wsdl-get reference wsdl 'soap-xs-element-p))))
+
+ (let ((subst (soap-xs-element-substitution-group element)))
+ (when (soap-name-p subst)
+ (let ((target (soap-wsdl-get subst wsdl)))
+ (if target
+ (push element (soap-xs-element-alternatives target))
+ (soap-warning "No target found for substitution-group" subst))))))
+
+(defun soap-encode-xs-element-attributes (value element)
+ "Encode the XML attributes for VALUE according to ELEMENT.
+Currently no attributes are needed.
+
+This is a specialization of `soap-encode-attributes' for
+`soap-xs-basic-type' objects."
+ ;; Use the variables to suppress checkdoc and compiler warnings.
+ (list value element)
+ nil)
+
+(defun soap-should-encode-value-for-xs-element (value element)
+ "Return t if VALUE should be encoded for ELEMENT, nil otherwise."
+ (cond
+ ;; if value is not nil, attempt to encode it
+ (value)
+
+ ;; value is nil, but the element's type is a boolean, so nil in this case
+ ;; means "false". We need to encode it.
+ ((let ((type (soap-xs-element-type element)))
+ (and (soap-xs-basic-type-p type)
+ (eq (soap-xs-basic-type-kind type) 'boolean))))
+
+ ;; This is not an optional element. Force encoding it (although this
+ ;; might fail at the validation step, but this is what we intend.
+
+ ;; value is nil, but the element's type has some attributes which supply a
+ ;; default value. We need to encode it.
+
+ ((let ((type (soap-xs-element-type element)))
+ (catch 'found
+ (dolist (a (soap-xs-type-attributes type))
+ (when (soap-xs-attribute-default a)
+ (throw 'found t))))))
+
+ ;; otherwise, we don't need to encode it
+ (t nil)))
+
+(defun soap-type-is-array? (type)
+ "Return t if TYPE defines an ARRAY."
+ (and (soap-xs-complex-type-p type)
+ (eq (soap-xs-complex-type-indicator type) 'array)))
+
+(defvar soap-encoded-namespaces nil
+ "A list of namespace tags used during encoding a message.
+This list is populated by `soap-encode-value' and used by
+`soap-create-envelope' to add aliases for these namespace to the
+XML request.
+
+This variable is dynamically bound in `soap-create-envelope'.")
+
+(defun soap-encode-xs-element (value element)
+ "Encode the VALUE according to ELEMENT.
+The data is inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-value' for
+`soap-xs-basic-type' objects."
+ (let ((fq-name (soap-element-fq-name element))
+ (type (soap-xs-element-type element)))
+ ;; Only encode the element if it has a name. NOTE: soap-element-fq-name
+ ;; will return *unnamed* for such elements
+ (if (soap-element-name element)
+ ;; Don't encode this element if value is nil. However, even if value
+ ;; is nil we still want to encode this element if it has any attributes
+ ;; with default values.
+ (when (soap-should-encode-value-for-xs-element value element)
+ (progn
+ (insert "<" fq-name)
+ (soap-encode-attributes value type)
+ ;; If value is nil and type is boolean encode the value as "false".
+ ;; Otherwise don't encode the value.
+ (if (or value (and (soap-xs-basic-type-p type)
+ (eq (soap-xs-basic-type-kind type) 'boolean)))
+ (progn (insert ">")
+ ;; ARRAY's need special treatment, as each element of
+ ;; the array is encoded with the same tag as the
+ ;; current element...
+ (if (soap-type-is-array? type)
+ (let ((new-element (copy-soap-xs-element element)))
+ (when (soap-element-namespace-tag type)
+ (add-to-list 'soap-encoded-namespaces
+ (soap-element-namespace-tag type)))
+ (setf (soap-xs-element-type^ new-element)
+ (soap-xs-complex-type-base type))
+ (loop for i below (length value)
+ do (progn
+ (soap-encode-xs-element (aref value i) new-element)
+ )))
+ (soap-encode-value value type))
+ (insert "</" fq-name ">\n"))
+ ;; else
+ (insert "/>\n"))))
+ (when (soap-should-encode-value-for-xs-element value element)
+ (soap-encode-value value type)))))
+
+(defun soap-decode-xs-element (element node)
+ "Use ELEMENT, a `soap-xs-element', to decode the contents of NODE.
+A LISP value is returned based on the contents of NODE and the
+type-info stored in ELEMENT.
+
+This is a specialization of `soap-decode-type' for
+`soap-xs-basic-type' objects."
+ (let ((type (soap-xs-element-type element)))
+ (soap-decode-type type node)))
+
+;; Register methods for `soap-xs-element'
+(let ((tag (aref (make-soap-xs-element) 0)))
+ (put tag 'soap-resolve-references #'soap-resolve-references-for-xs-element)
+ (put tag 'soap-attribute-encoder #'soap-encode-xs-element-attributes)
+ (put tag 'soap-encoder #'soap-encode-xs-element)
+ (put tag 'soap-decoder #'soap-decode-xs-element))
+
+;;;;; soap-xs-attribute
+
+(defstruct (soap-xs-attribute (:include soap-element))
+ type ; a simple type or basic type
+ default ; the default value, if any
+ reference)
+
+(defstruct (soap-xs-attribute-group (:include soap-xs-type))
+ reference)
+
+(defun soap-xs-parse-attribute (node)
+ "Construct a `soap-xs-attribute' from NODE."
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:attribute)
+ "expecting xsd:attribute, got %s" (soap-l2wk (xml-node-name node)))
+ (let* ((name (xml-get-attribute-or-nil node 'name))
+ (type (soap-l2fq (xml-get-attribute-or-nil node 'type)))
+ (default (xml-get-attribute-or-nil node 'fixed))
+ (attribute (xml-get-attribute-or-nil node 'ref))
+ (ref (when attribute (soap-l2fq attribute))))
+ (unless (or type ref)
+ (setq type (soap-xs-parse-simple-type
+ (soap-xml-node-find-matching-child
+ node '(xsd:restriction xsd:list xsd:union)))))
+ (make-soap-xs-attribute
+ :name name :type type :default default :reference ref)))
+
+(defun soap-xs-parse-attribute-group (node)
+ "Construct a `soap-xs-attribute-group' from NODE."
+ (let ((node-name (soap-l2wk (xml-node-name node))))
+ (assert (eq node-name 'xsd:attributeGroup)
+ "expecting xsd:attributeGroup, got %s" node-name)
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ (id (xml-get-attribute-or-nil node 'id))
+ (ref (xml-get-attribute-or-nil node 'ref))
+ attribute-group)
+ (when (and name ref)
+ (soap-warning "name and ref set for attribute group %s" node-name))
+ (setq attribute-group
+ (make-soap-xs-attribute-group :id id
+ :name name
+ :reference (and ref (soap-l2fq ref))))
+ (when (not ref)
+ (dolist (child (xml-node-children node))
+ ;; Ignore whitespace.
+ (unless (stringp child)
+ ;; Ignore optional annotation.
+ ;; Ignore anyAttribute nodes.
+ (case (soap-l2wk (xml-node-name child))
+ (xsd:attribute
+ (push (soap-xs-parse-attribute child)
+ (soap-xs-type-attributes attribute-group)))
+ (xsd:attributeGroup
+ (push (soap-xs-parse-attribute-group child)
+ (soap-xs-attribute-group-attribute-groups
+ attribute-group)))))))
+ attribute-group)))
+
+(defun soap-resolve-references-for-xs-attribute (attribute wsdl)
+ "Replace names in ATTRIBUTE with the referenced objects in the WSDL.
+This is a specialization of `soap-resolve-references' for
+`soap-xs-attribute' objects.
+
+See also `soap-wsdl-resolve-references'."
+ (let* ((type (soap-xs-attribute-type attribute))
+ (reference (soap-xs-attribute-reference attribute))
+ (predicate 'soap-xs-element-p)
+ (xml-reference
+ (and (soap-name-p reference)
+ (equal (car reference) "http://www.w3.org/XML/1998/namespace"))))
+ (cond (xml-reference
+ ;; Convert references to attributes defined by the XML
+ ;; schema (xml:base, xml:lang, xml:space and xml:id) to
+ ;; xsd:string, to avoid needing to bundle and parse
+ ;; xml.xsd.
+ (setq reference '("http://www.w3.org/2001/XMLSchema" . "string"))
+ (setq predicate 'soap-xs-basic-type-p))
+ ((soap-name-p type)
+ (setf (soap-xs-attribute-type attribute)
+ (soap-wsdl-get type wsdl
+ (lambda (type)
+ (or (soap-xs-basic-type-p type)
+ (soap-xs-simple-type-p type))))))
+ ((soap-xs-type-p type)
+ ;; an inline defined type, this will not be reached from anywhere
+ ;; else, so we must resolve references now.
+ (soap-resolve-references type wsdl)))
+ (when (soap-name-p reference)
+ (setf (soap-xs-attribute-reference attribute)
+ (soap-wsdl-get reference wsdl predicate)))))
+
+(put (aref (make-soap-xs-attribute) 0)
+ 'soap-resolve-references #'soap-resolve-references-for-xs-attribute)
+
+(defun soap-resolve-references-for-xs-attribute-group (attribute-group wsdl)
+ "Set slots in ATTRIBUTE-GROUP to the referenced objects in the WSDL.
+This is a specialization of `soap-resolve-references' for
+`soap-xs-attribute-group' objects.
+
+See also `soap-wsdl-resolve-references'."
+ (let ((reference (soap-xs-attribute-group-reference attribute-group)))
+ (when (soap-name-p reference)
+ (let ((resolved (soap-wsdl-get reference wsdl
+ 'soap-xs-attribute-group-p)))
+ (dolist (attribute (soap-xs-attribute-group-attributes resolved))
+ (soap-resolve-references attribute wsdl))
+ (setf (soap-xs-attribute-group-name attribute-group)
+ (soap-xs-attribute-group-name resolved))
+ (setf (soap-xs-attribute-group-id attribute-group)
+ (soap-xs-attribute-group-id resolved))
+ (setf (soap-xs-attribute-group-reference attribute-group) nil)
+ (setf (soap-xs-attribute-group-attributes attribute-group)
+ (soap-xs-attribute-group-attributes resolved))
+ (setf (soap-xs-attribute-group-attribute-groups attribute-group)
+ (soap-xs-attribute-group-attribute-groups resolved))))))
+
+(put (aref (make-soap-xs-attribute-group) 0)
+ 'soap-resolve-references #'soap-resolve-references-for-xs-attribute-group)
+
+;;;;; soap-xs-simple-type
+
+(defstruct (soap-xs-simple-type (:include soap-xs-type))
+ ;; A simple type is an extension on the basic type to which some
+ ;; restrictions can be added. For example we can define a simple type based
+ ;; off "string" with the restrictions that only the strings "one", "two" and
+ ;; "three" are valid values (this is an enumeration).
+
+ base ; can be a single type, or a list of types for union types
+ enumeration ; nil, or list of permitted values for the type
+ pattern ; nil, or value must match this pattern
+ length-range ; a cons of (min . max) length, inclusive range.
+ ; For exact length, use (l, l).
+ ; nil means no range,
+ ; (nil . l) means no min range,
+ ; (l . nil) means no max range.
+ integer-range ; a pair of (min, max) integer values, inclusive range,
+ ; same meaning as `length-range'
+ is-list ; t if this is an xs:list, nil otherwise
)
+(defun soap-xs-parse-simple-type (node)
+ "Construct an `soap-xs-simple-type' object from the XML NODE."
+ (assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:simpleType xsd:simpleContent))
+ nil
+ "expecting xsd:simpleType or xsd:simpleContent node, got %s"
+ (soap-l2wk (xml-node-name node)))
+
+ ;; NOTE: name can be nil for inline types. Such types cannot be added to a
+ ;; namespace.
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ (id (xml-get-attribute-or-nil node 'id)))
+
+ (let ((type (make-soap-xs-simple-type
+ :name name :namespace-tag soap-target-xmlns :id id))
+ (def (soap-xml-node-find-matching-child
+ node '(xsd:restriction xsd:extension xsd:union xsd:list))))
+ (ecase (soap-l2wk (xml-node-name def))
+ (xsd:restriction (soap-xs-add-restriction def type))
+ (xsd:extension (soap-xs-add-extension def type))
+ (xsd:union (soap-xs-add-union def type))
+ (xsd:list (soap-xs-add-list def type)))
+
+ type)))
+
+(defun soap-xs-add-restriction (node type)
+ "Add restrictions defined in XML NODE to TYPE, an `soap-xs-simple-type'."
+
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:restriction)
+ nil
+ "expecting xsd:restriction node, got %s"
+ (soap-l2wk (xml-node-name node)))
+
+ (setf (soap-xs-simple-type-base type)
+ (soap-l2fq (xml-get-attribute node 'base)))
+
+ (dolist (r (xml-node-children node))
+ (unless (stringp r) ; skip the white space
+ (let ((value (xml-get-attribute r 'value)))
+ (case (soap-l2wk (xml-node-name r))
+ (xsd:enumeration
+ (push value (soap-xs-simple-type-enumeration type)))
+ (xsd:pattern
+ (setf (soap-xs-simple-type-pattern type)
+ (concat "\\`" (xsdre-translate value) "\\'")))
+ (xsd:length
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-length-range type)
+ (cons value value))))
+ (xsd:minLength
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-length-range type)
+ (if (soap-xs-simple-type-length-range type)
+ (cons value
+ (cdr (soap-xs-simple-type-length-range type)))
+ ;; else
+ (cons value nil)))))
+ (xsd:maxLength
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-length-range type)
+ (if (soap-xs-simple-type-length-range type)
+ (cons (car (soap-xs-simple-type-length-range type))
+ value)
+ ;; else
+ (cons nil value)))))
+ (xsd:minExclusive
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-integer-range type)
+ (if (soap-xs-simple-type-integer-range type)
+ (cons (1+ value)
+ (cdr (soap-xs-simple-type-integer-range type)))
+ ;; else
+ (cons (1+ value) nil)))))
+ (xsd:maxExclusive
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-integer-range type)
+ (if (soap-xs-simple-type-integer-range type)
+ (cons (car (soap-xs-simple-type-integer-range type))
+ (1- value))
+ ;; else
+ (cons nil (1- value))))))
+ (xsd:minInclusive
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-integer-range type)
+ (if (soap-xs-simple-type-integer-range type)
+ (cons value
+ (cdr (soap-xs-simple-type-integer-range type)))
+ ;; else
+ (cons value nil)))))
+ (xsd:maxInclusive
+ (let ((value (string-to-number value)))
+ (setf (soap-xs-simple-type-integer-range type)
+ (if (soap-xs-simple-type-integer-range type)
+ (cons (car (soap-xs-simple-type-integer-range type))
+ value)
+ ;; else
+ (cons nil value))))))))))
+
+(defun soap-xs-add-union (node type)
+ "Add union members defined in XML NODE to TYPE, an `soap-xs-simple-type'."
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:union)
+ nil
+ "expecting xsd:union node, got %s" (soap-l2wk (xml-node-name node)))
+
+ (setf (soap-xs-simple-type-base type)
+ (mapcar 'soap-l2fq
+ (split-string
+ (or (xml-get-attribute-or-nil node 'memberTypes) ""))))
+
+ ;; Additional simple types can be defined inside the union node. Add them
+ ;; to the base list. The "memberTypes" members will have to be resolved by
+ ;; the "resolve-references" method, the inline types will not.
+ (let (result)
+ (dolist (simple-type (soap-xml-get-children1 node 'xsd:simpleType))
+ (push (soap-xs-parse-simple-type simple-type) result))
+ (setf (soap-xs-simple-type-base type)
+ (append (soap-xs-simple-type-base type) (nreverse result)))))
+
+(defun soap-xs-add-list (node type)
+ "Add list defined in XML NODE to TYPE, a `soap-xs-simple-type'."
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:list)
+ nil
+ "expecting xsd:list node, got %s" (soap-l2wk (xml-node-name node)))
+
+ ;; A simple type can be defined inline inside the list node or referenced by
+ ;; the itemType attribute, in which case it will be resolved by the
+ ;; resolve-references method.
+ (let* ((item-type (xml-get-attribute-or-nil node 'itemType))
+ (children (soap-xml-get-children1 node 'xsd:simpleType)))
+ (if item-type
+ (if (= (length children) 0)
+ (setf (soap-xs-simple-type-base type) (soap-l2fq item-type))
+ (soap-warning
+ "xsd:list node with itemType has more than zero children: %s"
+ (soap-xs-type-name type)))
+ (if (= (length children) 1)
+ (setf (soap-xs-simple-type-base type)
+ (soap-xs-parse-simple-type
+ (car (soap-xml-get-children1 node 'xsd:simpleType))))
+ (soap-warning "xsd:list node has more than one child %s"
+ (soap-xs-type-name type))))
+ (setf (soap-xs-simple-type-is-list type) t)))
+
+(defun soap-xs-add-extension (node type)
+ "Add the extended type defined in XML NODE to TYPE, an `soap-xs-simple-type'."
+ (setf (soap-xs-simple-type-base type)
+ (soap-l2fq (xml-get-attribute node 'base)))
+ (dolist (attribute (soap-xml-get-children1 node 'xsd:attribute))
+ (push (soap-xs-parse-attribute attribute)
+ (soap-xs-type-attributes type)))
+ (dolist (attribute-group (soap-xml-get-children1 node 'xsd:attributeGroup))
+ (push (soap-xs-parse-attribute-group attribute-group)
+ (soap-xs-type-attribute-groups type))))
+
+(defun soap-validate-xs-basic-type (value type)
+ "Validate VALUE against the basic type TYPE."
+ (let* ((kind (soap-xs-basic-type-kind type)))
+ (case kind
+ ((anyType Array byte[])
+ value)
+ (t
+ (let ((convert (get kind 'rng-xsd-convert)))
+ (if convert
+ (if (rng-dt-make-value convert value)
+ value
+ (error "Invalid %s: %s" (symbol-name kind) value))
+ (error "Don't know how to convert %s" kind)))))))
+
+(defun soap-validate-xs-simple-type (value type)
+ "Validate VALUE against the restrictions of TYPE."
+
+ (let* ((base-type (soap-xs-simple-type-base type))
+ (messages nil))
+ (if (listp base-type)
+ (catch 'valid
+ (dolist (base base-type)
+ (condition-case error-object
+ (cond ((soap-xs-simple-type-p base)
+ (throw 'valid
+ (soap-validate-xs-simple-type value base)))
+ ((soap-xs-basic-type-p base)
+ (throw 'valid
+ (soap-validate-xs-basic-type value base))))
+ (error (push (cadr error-object) messages))))
+ (when messages
+ (error (mapconcat 'identity (nreverse messages) "; and: "))))
+ (cl-flet ((fail-with-message (format value)
+ (push (format format value) messages)
+ (throw 'invalid nil)))
+ (catch 'invalid
+ (let ((enumeration (soap-xs-simple-type-enumeration type)))
+ (when (and (> (length enumeration) 1)
+ (not (member value enumeration)))
+ (fail-with-message "bad value, should be one of %s" enumeration)))
+
+ (let ((pattern (soap-xs-simple-type-pattern type)))
+ (when (and pattern (not (string-match-p pattern value)))
+ (fail-with-message "bad value, should match pattern %s" pattern)))
+
+ (let ((length-range (soap-xs-simple-type-length-range type)))
+ (when length-range
+ (unless (stringp value)
+ (fail-with-message
+ "bad value, should be a string with length range %s"
+ length-range))
+ (when (car length-range)
+ (unless (>= (length value) (car length-range))
+ (fail-with-message "short string, should be at least %s chars"
+ (car length-range))))
+ (when (cdr length-range)
+ (unless (<= (length value) (cdr length-range))
+ (fail-with-message "long string, should be at most %s chars"
+ (cdr length-range))))))
+
+ (let ((integer-range (soap-xs-simple-type-integer-range type)))
+ (when integer-range
+ (unless (numberp value)
+ (fail-with-message "bad value, should be a number with range %s"
+ integer-range))
+ (when (car integer-range)
+ (unless (>= value (car integer-range))
+ (fail-with-message "small value, should be at least %s"
+ (car integer-range))))
+ (when (cdr integer-range)
+ (unless (<= value (cdr integer-range))
+ (fail-with-message "big value, should be at most %s"
+ (cdr integer-range))))))))
+ (when messages
+ (error "Xs-simple-type(%s, %s): %s"
+ value (or (soap-xs-type-name type) (soap-xs-type-id type))
+ (car messages)))))
+ ;; Return the validated value.
+ value)
+
+(defun soap-resolve-references-for-xs-simple-type (type wsdl)
+ "Replace names in TYPE with the referenced objects in the WSDL.
+This is a specialization of `soap-resolve-references' for
+`soap-xs-simple-type' objects.
+
+See also `soap-wsdl-resolve-references'."
+
+ (let ((namespace (soap-element-namespace-tag type)))
+ (when namespace
+ (let ((nstag (car (rassoc namespace (soap-wsdl-alias-table wsdl)))))
+ (when nstag
+ (setf (soap-element-namespace-tag type) nstag)))))
+
+ (let ((base (soap-xs-simple-type-base type)))
+ (cond
+ ((soap-name-p base)
+ (setf (soap-xs-simple-type-base type)
+ (soap-wsdl-get base wsdl 'soap-xs-type-p)))
+ ((soap-xs-type-p base)
+ (soap-resolve-references base wsdl))
+ ((listp base)
+ (setf (soap-xs-simple-type-base type)
+ (mapcar (lambda (type)
+ (cond ((soap-name-p type)
+ (soap-wsdl-get type wsdl 'soap-xs-type-p))
+ ((soap-xs-type-p type)
+ (soap-resolve-references type wsdl)
+ type)
+ (t ; signal an error?
+ type)))
+ base)))
+ (t (error "Oops"))))
+ (dolist (attribute (soap-xs-type-attributes type))
+ (soap-resolve-references attribute wsdl))
+ (dolist (attribute-group (soap-xs-type-attribute-groups type))
+ (soap-resolve-references attribute-group wsdl)))
+
+(defun soap-encode-xs-simple-type-attributes (value type)
+ "Encode the XML attributes for VALUE according to TYPE.
+The xsi:type and an optional xsi:nil attributes are added. The
+attributes are inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-attributes' for
+`soap-xs-simple-type' objects."
+ (insert " xsi:type=\"" (soap-element-fq-name type) "\"")
+ (unless value (insert " xsi:nil=\"true\"")))
+
+(defun soap-encode-xs-simple-type (value type)
+ "Encode the VALUE according to TYPE.
+The data is inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-value' for
+`soap-xs-simple-type' objects."
+ (soap-validate-xs-simple-type value type)
+ (if (soap-xs-simple-type-is-list type)
+ (progn
+ (dolist (v (butlast value))
+ (soap-encode-value v (soap-xs-simple-type-base type))
+ (insert " "))
+ (soap-encode-value (car (last value)) (soap-xs-simple-type-base type)))
+ (soap-encode-value value (soap-xs-simple-type-base type))))
+
+(defun soap-decode-xs-simple-type (type node)
+ "Use TYPE, a `soap-xs-simple-type', to decode the contents of NODE.
+A LISP value is returned based on the contents of NODE and the
+type-info stored in TYPE.
+
+This is a specialization of `soap-decode-type' for
+`soap-xs-simple-type' objects."
+ (if (soap-xs-simple-type-is-list type)
+ ;; Technically, we could construct fake XML NODEs and pass them to
+ ;; soap-decode-value...
+ (split-string (car (xml-node-children node)))
+ (let ((value (soap-decode-type (soap-xs-simple-type-base type) node)))
+ (soap-validate-xs-simple-type value type))))
+
+;; Register methods for `soap-xs-simple-type'
+(let ((tag (aref (make-soap-xs-simple-type) 0)))
+ (put tag 'soap-resolve-references
+ #'soap-resolve-references-for-xs-simple-type)
+ (put tag 'soap-attribute-encoder #'soap-encode-xs-simple-type-attributes)
+ (put tag 'soap-encoder #'soap-encode-xs-simple-type)
+ (put tag 'soap-decoder #'soap-decode-xs-simple-type))
+
+;;;;; soap-xs-complex-type
+
+(defstruct (soap-xs-complex-type (:include soap-xs-type))
+ indicator ; sequence, choice, all, array
+ base
+ elements
+ optional?
+ multiple?
+ is-group)
+
+(defun soap-xs-parse-complex-type (node)
+ "Construct a `soap-xs-complex-type' by parsing the XML NODE."
+ (let ((name (xml-get-attribute-or-nil node 'name))
+ (id (xml-get-attribute-or-nil node 'id))
+ (node-name (soap-l2wk (xml-node-name node)))
+ type
+ attributes
+ attribute-groups)
+ (assert (memq node-name '(xsd:complexType xsd:complexContent xsd:group))
+ nil "unexpected node: %s" node-name)
+
+ (dolist (def (xml-node-children node))
+ (when (consp def) ; skip text nodes
+ (case (soap-l2wk (xml-node-name def))
+ (xsd:attribute (push (soap-xs-parse-attribute def) attributes))
+ (xsd:attributeGroup
+ (push (soap-xs-parse-attribute-group def)
+ attribute-groups))
+ (xsd:simpleContent (setq type (soap-xs-parse-simple-type def)))
+ ((xsd:sequence xsd:all xsd:choice)
+ (setq type (soap-xs-parse-sequence def)))
+ (xsd:complexContent
+ (dolist (def (xml-node-children def))
+ (when (consp def)
+ (case (soap-l2wk (xml-node-name def))
+ (xsd:attribute
+ (push (soap-xs-parse-attribute def) attributes))
+ (xsd:attributeGroup
+ (push (soap-xs-parse-attribute-group def)
+ attribute-groups))
+ ((xsd:extension xsd:restriction)
+ (setq type
+ (soap-xs-parse-extension-or-restriction def)))
+ ((xsd:sequence xsd:all xsd:choice)
+ (soap-xs-parse-sequence def)))))))))
+ (unless type
+ ;; the type has not been built, this is a shortcut for a simpleContent
+ ;; node
+ (setq type (make-soap-xs-complex-type)))
+
+ (setf (soap-xs-type-name type) name)
+ (setf (soap-xs-type-namespace-tag type) soap-target-xmlns)
+ (setf (soap-xs-type-id type) id)
+ (setf (soap-xs-type-attributes type)
+ (append attributes (soap-xs-type-attributes type)))
+ (setf (soap-xs-type-attribute-groups type)
+ (append attribute-groups (soap-xs-type-attribute-groups type)))
+ (when (soap-xs-complex-type-p type)
+ (setf (soap-xs-complex-type-is-group type)
+ (eq node-name 'xsd:group)))
+ type))
+
+(defun soap-xs-parse-sequence (node)
+ "Parse a sequence definition from XML NODE.
+Returns a `soap-xs-complex-type'"
+ (assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:sequence xsd:choice xsd:all))
+ nil
+ "unexpected node: %s" (soap-l2wk (xml-node-name node)))
+
+ (let ((type (make-soap-xs-complex-type)))
+
+ (setf (soap-xs-complex-type-indicator type)
+ (ecase (soap-l2wk (xml-node-name node))
+ (xsd:sequence 'sequence)
+ (xsd:all 'all)
+ (xsd:choice 'choice)))
+
+ (setf (soap-xs-complex-type-optional? type) (soap-node-optional node))
+ (setf (soap-xs-complex-type-multiple? type) (soap-node-multiple node))
+
+ (dolist (r (xml-node-children node))
+ (unless (stringp r) ; skip the white space
+ (case (soap-l2wk (xml-node-name r))
+ ((xsd:element xsd:group)
+ (push (soap-xs-parse-element r)
+ (soap-xs-complex-type-elements type)))
+ ((xsd:sequence xsd:choice xsd:all)
+ ;; an inline sequence, choice or all node
+ (let ((choice (soap-xs-parse-sequence r)))
+ (push (make-soap-xs-element :name nil :type^ choice)
+ (soap-xs-complex-type-elements type))))
+ (xsd:attribute
+ (push (soap-xs-parse-attribute r)
+ (soap-xs-type-attributes type)))
+ (xsd:attributeGroup
+ (push (soap-xs-parse-attribute-group r)
+ (soap-xs-type-attribute-groups type))))))
+
+ (setf (soap-xs-complex-type-elements type)
+ (nreverse (soap-xs-complex-type-elements type)))
+
+ type))
+
+(defun soap-xs-parse-extension-or-restriction (node)
+ "Parse an extension or restriction definition from XML NODE.
+Return a `soap-xs-complex-type'."
+ (assert (memq (soap-l2wk (xml-node-name node))
+ '(xsd:extension xsd:restriction))
+ nil
+ "unexpected node: %s" (soap-l2wk (xml-node-name node)))
+ (let (type
+ attributes
+ attribute-groups
+ array?
+ (base (xml-get-attribute-or-nil node 'base)))
+
+ ;; Array declarations are recognized specially, it is unclear to me how
+ ;; they could be treated generally...
+ (setq array?
+ (and (eq (soap-l2wk (xml-node-name node)) 'xsd:restriction)
+ (equal base (soap-wk2l "soapenc:Array"))))
+
+ (dolist (def (xml-node-children node))
+ (when (consp def) ; skip text nodes
+ (case (soap-l2wk (xml-node-name def))
+ ((xsd:sequence xsd:choice xsd:all)
+ (setq type (soap-xs-parse-sequence def)))
+ (xsd:attribute
+ (if array?
+ (let ((array-type
+ (soap-xml-get-attribute-or-nil1 def 'wsdl:arrayType)))
+ (when (and array-type
+ (string-match "^\\(.*\\)\\[\\]$" array-type))
+ ;; Override
+ (setq base (match-string 1 array-type))))
+ ;; else
+ (push (soap-xs-parse-attribute def) attributes)))
+ (xsd:attributeGroup
+ (push (soap-xs-parse-attribute-group def) attribute-groups)))))
+
+ (unless type
+ (setq type (make-soap-xs-complex-type))
+ (when array?
+ (setf (soap-xs-complex-type-indicator type) 'array)))
+
+ (setf (soap-xs-complex-type-base type) (soap-l2fq base))
+ (setf (soap-xs-complex-type-attributes type) attributes)
+ (setf (soap-xs-complex-type-attribute-groups type) attribute-groups)
+ type))
+
+(defun soap-resolve-references-for-xs-complex-type (type wsdl)
+ "Replace names in TYPE with the referenced objects in the WSDL.
+This is a specialization of `soap-resolve-references' for
+`soap-xs-complex-type' objects.
+
+See also `soap-wsdl-resolve-references'."
+
+ (let ((namespace (soap-element-namespace-tag type)))
+ (when namespace
+ (let ((nstag (car (rassoc namespace (soap-wsdl-alias-table wsdl)))))
+ (when nstag
+ (setf (soap-element-namespace-tag type) nstag)))))
+
+ (let ((base (soap-xs-complex-type-base type)))
+ (cond ((soap-name-p base)
+ (setf (soap-xs-complex-type-base type)
+ (soap-wsdl-get base wsdl 'soap-xs-type-p)))
+ ((soap-xs-type-p base)
+ (soap-resolve-references base wsdl))))
+ (let (all-elements)
+ (dolist (element (soap-xs-complex-type-elements type))
+ (if (soap-xs-element-is-group element)
+ ;; This is an xsd:group element that references an xsd:group node,
+ ;; which we treat as a complex type. We replace the reference
+ ;; element by inlining the elements of the referenced xsd:group
+ ;; (complex type) node.
+ (let ((type (soap-wsdl-get
+ (soap-xs-element-reference element)
+ wsdl (lambda (type)
+ (and
+ (soap-xs-complex-type-p type)
+ (soap-xs-complex-type-is-group type))))))
+ (dolist (element (soap-xs-complex-type-elements type))
+ (soap-resolve-references element wsdl)
+ (push element all-elements)))
+ ;; This is a non-xsd:group node so just add it directly.
+ (soap-resolve-references element wsdl)
+ (push element all-elements)))
+ (setf (soap-xs-complex-type-elements type) (nreverse all-elements)))
+ (dolist (attribute (soap-xs-type-attributes type))
+ (soap-resolve-references attribute wsdl))
+ (dolist (attribute-group (soap-xs-type-attribute-groups type))
+ (soap-resolve-references attribute-group wsdl)))
+
+(defun soap-encode-xs-complex-type-attributes (value type)
+ "Encode the XML attributes for encoding VALUE according to TYPE.
+The xsi:type and optional xsi:nil attributes are added, plus
+additional attributes needed for arrays types, if applicable. The
+attributes are inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-attributes' for
+`soap-xs-complex-type' objects."
+ (if (eq (soap-xs-complex-type-indicator type) 'array)
+ (let ((element-type (soap-xs-complex-type-base type)))
+ (insert " xsi:type=\"soapenc:Array\"")
+ (insert " soapenc:arrayType=\""
+ (soap-element-fq-name element-type)
+ "[" (format "%s" (length value)) "]" "\""))
+ ;; else
+ (progn
+ (dolist (a (soap-get-xs-attributes type))
+ (let ((element-name (soap-element-name a)))
+ (if (soap-xs-attribute-default a)
+ (insert " " element-name
+ "=\"" (soap-xs-attribute-default a) "\"")
+ (dolist (value-pair value)
+ (when (equal element-name (symbol-name (car value-pair)))
+ (insert " " element-name
+ "=\"" (cdr value-pair) "\""))))))
+ ;; If this is not an empty type, and we have no value, mark it as nil
+ (when (and (soap-xs-complex-type-indicator type) (null value))
+ (insert " xsi:nil=\"true\"")))))
+
+(defun soap-get-candidate-elements (element)
+ "Return a list of elements that are compatible with ELEMENT.
+The returned list includes ELEMENT's references and
+alternatives."
+ (let ((reference (soap-xs-element-reference element)))
+ ;; If the element is a reference, append the reference and its
+ ;; alternatives...
+ (if reference
+ (append (list reference)
+ (soap-xs-element-alternatives reference))
+ ;; ...otherwise append the element itself and its alternatives.
+ (append (list element)
+ (soap-xs-element-alternatives element)))))
+
+(defun soap-encode-xs-complex-type (value type)
+ "Encode the VALUE according to TYPE.
+The data is inserted in the current buffer at the current
+position.
+
+This is a specialization of `soap-encode-value' for
+`soap-xs-complex-type' objects."
+ (case (soap-xs-complex-type-indicator type)
+ (array
+ (error "soap-encode-xs-complex-type arrays are handled elsewhere"))
+ ((sequence choice all nil)
+ (let ((type-list (list type)))
+
+ ;; Collect all base types
+ (let ((base (soap-xs-complex-type-base type)))
+ (while base
+ (push base type-list)
+ (setq base (soap-xs-complex-type-base base))))
+
+ (dolist (type type-list)
+ (dolist (element (soap-xs-complex-type-elements type))
+ (catch 'done
+ (let ((instance-count 0))
+ (dolist (candidate (soap-get-candidate-elements element))
+ (let ((e-name (soap-xs-element-name candidate)))
+ (if e-name
+ (let ((e-name (intern e-name)))
+ (dolist (v value)
+ (when (equal (car v) e-name)
+ (incf instance-count)
+ (soap-encode-value (cdr v) candidate))))
+ (if (soap-xs-complex-type-indicator type)
+ (let ((current-point (point)))
+ ;; Check if encoding happened by checking if
+ ;; characters were inserted in the buffer.
+ (soap-encode-value value candidate)
+ (when (not (equal current-point (point)))
+ (incf instance-count)))
+ (dolist (v value)
+ (let ((current-point (point)))
+ (soap-encode-value v candidate)
+ (when (not (equal current-point (point)))
+ (incf instance-count))))))))
+ ;; Do some sanity checking
+ (let* ((indicator (soap-xs-complex-type-indicator type))
+ (element-type (soap-xs-element-type element))
+ (reference (soap-xs-element-reference element))
+ (e-name (or (soap-xs-element-name element)
+ (and reference
+ (soap-xs-element-name reference)))))
+ (cond ((and (eq indicator 'choice)
+ (> instance-count 0))
+ ;; This was a choice node and we encoded
+ ;; one instance.
+ (throw 'done t))
+ ((and (not (eq indicator 'choice))
+ (= instance-count 0)
+ (not (soap-xs-element-optional? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-optional-p
+ element-type))))
+ (soap-warning
+ "While encoding %s: missing non-nillable slot %s"
+ value e-name))
+ ((and (> instance-count 1)
+ (not (soap-xs-element-multiple? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-multiple-p
+ element-type))))
+ (soap-warning
+ (concat "While encoding %s: expected single,"
+ " found multiple elements for slot %s")
+ value e-name))))))))))
+ (t
+ (error "Don't know how to encode complex type: %s"
+ (soap-xs-complex-type-indicator type)))))
+
+(defun soap-xml-get-children-fq (node child-name)
+ "Return the children of NODE named CHILD-NAME.
+This is the same as `xml-get-children1', but NODE's local
+namespace is used to resolve the children's namespace tags."
+ (let (result)
+ (dolist (c (xml-node-children node))
+ (when (and (consp c)
+ (soap-with-local-xmlns node
+ ;; We use `ignore-errors' here because we want to silently
+ ;; skip nodes for which we cannot convert them to a
+ ;; well-known name.
+ (equal (ignore-errors
+ (soap-l2fq (xml-node-name c)))
+ child-name)))
+ (push c result)))
+ (nreverse result)))
+
+(defun soap-xs-element-get-fq-name (element wsdl)
+ "Return ELEMENT's fully-qualified name using WSDL's alias table.
+Return nil if ELEMENT does not have a name."
+ (let* ((ns-aliases (soap-wsdl-alias-table wsdl))
+ (ns-name (cdr (assoc
+ (soap-element-namespace-tag element)
+ ns-aliases))))
+ (when ns-name
+ (cons ns-name (soap-element-name element)))))
+
+(defun soap-xs-complex-type-optional-p (type)
+ "Return t if TYPE or any of TYPE's ancestor types is optional.
+Return nil otherwise."
+ (when type
+ (or (soap-xs-complex-type-optional? type)
+ (and (soap-xs-complex-type-p type)
+ (soap-xs-complex-type-optional-p
+ (soap-xs-complex-type-base type))))))
+
+(defun soap-xs-complex-type-multiple-p (type)
+ "Return t if TYPE or any of TYPE's ancestor types permits multiple elements.
+Return nil otherwise."
+ (when type
+ (or (soap-xs-complex-type-multiple? type)
+ (and (soap-xs-complex-type-p type)
+ (soap-xs-complex-type-multiple-p
+ (soap-xs-complex-type-base type))))))
+
+(defun soap-get-xs-attributes-from-groups (attribute-groups)
+ "Return a list of attributes from all ATTRIBUTE-GROUPS."
+ (let (attributes)
+ (dolist (group attribute-groups)
+ (let ((sub-groups (soap-xs-attribute-group-attribute-groups group)))
+ (setq attributes (append attributes
+ (soap-get-xs-attributes-from-groups sub-groups)
+ (soap-xs-attribute-group-attributes group)))))
+ attributes))
+
+(defun soap-get-xs-attributes (type)
+ "Return a list of all of TYPE's and TYPE's ancestors' attributes."
+ (let* ((base (and (soap-xs-complex-type-p type)
+ (soap-xs-complex-type-base type)))
+ (attributes (append (soap-xs-type-attributes type)
+ (soap-get-xs-attributes-from-groups
+ (soap-xs-type-attribute-groups type)))))
+ (if base
+ (append attributes (soap-get-xs-attributes base))
+ attributes)))
+
+(defun soap-decode-xs-attributes (type node)
+ "Use TYPE, a `soap-xs-complex-type', to decode the attributes of NODE."
+ (let (result)
+ (dolist (attribute (soap-get-xs-attributes type))
+ (let* ((name (soap-xs-attribute-name attribute))
+ (attribute-type (soap-xs-attribute-type attribute))
+ (symbol (intern name))
+ (value (xml-get-attribute-or-nil node symbol)))
+ ;; We don't support attribute uses: required, optional, prohibited.
+ (cond
+ ((soap-xs-basic-type-p attribute-type)
+ ;; Basic type values are validated by xml.el.
+ (when value
+ (push (cons symbol
+ ;; Create a fake XML node to satisfy the
+ ;; soap-decode-xs-basic-type API.
+ (soap-decode-xs-basic-type attribute-type
+ (list symbol nil value)))
+ result)))
+ ((soap-xs-simple-type-p attribute-type)
+ (when value
+ (push (cons symbol
+ (soap-validate-xs-simple-type value attribute-type))
+ result)))
+ (t
+ (error (concat "Attribute %s is of type %s which is"
+ " not a basic or simple type")
+ name (soap-name-p attribute))))))
+ result))
+
+(defun soap-decode-xs-complex-type (type node)
+ "Use TYPE, a `soap-xs-complex-type', to decode the contents of NODE.
+A LISP value is returned based on the contents of NODE and the
+type-info stored in TYPE.
+
+This is a specialization of `soap-decode-type' for
+`soap-xs-basic-type' objects."
+ (case (soap-xs-complex-type-indicator type)
+ (array
+ (let ((result nil)
+ (element-type (soap-xs-complex-type-base type)))
+ (dolist (node (xml-node-children node))
+ (when (consp node)
+ (push (soap-decode-type element-type node) result)))
+ (nreverse result)))
+ ((sequence choice all nil)
+ (let ((result nil)
+ (base (soap-xs-complex-type-base type)))
+ (when base
+ (setq result (nreverse (soap-decode-type base node))))
+ (catch 'done
+ (dolist (element (soap-xs-complex-type-elements type))
+ (let* ((instance-count 0)
+ (e-name (soap-xs-element-name element))
+ ;; Heuristic: guess if we need to decode using local
+ ;; namespaces.
+ (use-fq-names (string-match ":" (symbol-name (car node))))
+ (children (if e-name
+ (if use-fq-names
+ ;; Find relevant children
+ ;; using local namespaces by
+ ;; searching for the element's
+ ;; fully-qualified name.
+ (soap-xml-get-children-fq
+ node
+ (soap-xs-element-get-fq-name
+ element soap-current-wsdl))
+ ;; No local namespace resolution
+ ;; needed so use the element's
+ ;; name unqualified.
+ (xml-get-children node (intern e-name)))
+ ;; e-name is nil so a) we don't know which
+ ;; children to operate on, and b) we want to
+ ;; re-use soap-decode-xs-complex-type, which
+ ;; expects a node argument with a complex
+ ;; type; therefore we need to operate on the
+ ;; entire node. We wrap node in a list so
+ ;; that it will carry through as "node" in the
+ ;; loop below.
+ ;;
+ ;; For example:
+ ;;
+ ;; Element Type:
+ ;; <xs:complexType name="A">
+ ;; <xs:sequence>
+ ;; <xs:element name="B" type="t:BType"/>
+ ;; <xs:choice>
+ ;; <xs:element name="C" type="xs:string"/>
+ ;; <xs:element name="D" type="t:DType"/>
+ ;; </xs:choice>
+ ;; </xs:sequence>
+ ;; </xs:complexType>
+ ;;
+ ;; Node:
+ ;; <t:A>
+ ;; <t:B tag="b"/>
+ ;; <t:C>1</C>
+ ;; </t:A>
+ ;;
+ ;; soap-decode-type will be called below with:
+ ;;
+ ;; element =
+ ;; <xs:choice>
+ ;; <xs:element name="C" type="xs:string"/>
+ ;; <xs:element name="D" type="t:DType"/>
+ ;; </xs:choice>
+ ;; node =
+ ;; <t:A>
+ ;; <t:B tag="b"/>
+ ;; <t:C>1</C>
+ ;; </t:A>
+ (list node)))
+ (element-type (soap-xs-element-type element)))
+ (dolist (node children)
+ (incf instance-count)
+ (let* ((attributes
+ (soap-decode-xs-attributes element-type node))
+ ;; Attributes may specify xsi:type override.
+ (element-type
+ (if (soap-xml-get-attribute-or-nil1 node 'xsi:type)
+ (soap-wsdl-get
+ (soap-l2fq
+ (soap-xml-get-attribute-or-nil1 node
+ 'xsi:type))
+ soap-current-wsdl 'soap-xs-type-p t)
+ element-type))
+ (decoded-child (soap-decode-type element-type node)))
+ (if e-name
+ (push (cons (intern e-name)
+ (append attributes decoded-child)) result)
+ ;; When e-name is nil we don't want to introduce an extra
+ ;; level of nesting, so we splice the decoding into
+ ;; result.
+ (setq result (append decoded-child result)))))
+ (cond ((and (eq (soap-xs-complex-type-indicator type) 'choice)
+ ;; Choices can allow multiple values.
+ (not (soap-xs-complex-type-multiple-p type))
+ (> instance-count 0))
+ ;; This was a choice node, and we decoded one value.
+ (throw 'done t))
+
+ ;; Do some sanity checking
+ ((and (not (eq (soap-xs-complex-type-indicator type)
+ 'choice))
+ (= instance-count 0)
+ (not (soap-xs-element-optional? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-optional-p
+ element-type))))
+ (soap-warning "missing non-nillable slot %s" e-name))
+ ((and (> instance-count 1)
+ (not (soap-xs-complex-type-multiple-p type))
+ (not (soap-xs-element-multiple? element))
+ (and (soap-xs-complex-type-p element-type)
+ (not (soap-xs-complex-type-multiple-p
+ element-type))))
+ (soap-warning "expected single %s slot, found multiple"
+ e-name))))))
+ (nreverse result)))
+ (t
+ (error "Don't know how to decode complex type: %s"
+ (soap-xs-complex-type-indicator type)))))
+
+;; Register methods for `soap-xs-complex-type'
+(let ((tag (aref (make-soap-xs-complex-type) 0)))
+ (put tag 'soap-resolve-references
+ #'soap-resolve-references-for-xs-complex-type)
+ (put tag 'soap-attribute-encoder #'soap-encode-xs-complex-type-attributes)
+ (put tag 'soap-encoder #'soap-encode-xs-complex-type)
+ (put tag 'soap-decoder #'soap-decode-xs-complex-type))
+
+;;;; WSDL documents
+;;;;; WSDL document elements
+
+
(defstruct (soap-message (:include soap-element))
parts ; ALIST of NAME => WSDL-TYPE name
)
@@ -392,7 +1945,9 @@ binding) but the same name."
parameter-order
input ; (NAME . MESSAGE)
output ; (NAME . MESSAGE)
- faults) ; a list of (NAME . MESSAGE)
+ faults ; a list of (NAME . MESSAGE)
+ input-action ; WS-addressing action string
+ output-action) ; WS-addressing action string
(defstruct (soap-port-type (:include soap-element))
operations) ; a namespace of operations
@@ -403,8 +1958,10 @@ binding) but the same name."
(defstruct soap-bound-operation
operation ; SOAP-OPERATION
soap-action ; value for SOAPAction HTTP header
+ 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
+ ; http://www.w3.org/TR/wsdl#_soap:body
)
(defstruct (soap-binding (:include soap-element))
@@ -415,49 +1972,49 @@ binding) but the same name."
service-url
binding)
-(defun soap-default-xsd-types ()
- "Return a namespace containing some of the XMLSchema types."
- (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema")))
- (dolist (type '("string" "dateTime" "boolean"
- "long" "int" "integer" "unsignedInt" "byte" "float" "double"
- "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
- (soap-namespace-put
- (make-soap-basic-type :name type :kind (intern type))
- ns))
- ns))
-
-(defun soap-default-soapenc-types ()
- "Return a namespace containing some of the SOAPEnc types."
- (let ((ns (make-soap-namespace
- :name "http://schemas.xmlsoap.org/soap/encoding/")))
- (dolist (type '("string" "dateTime" "boolean"
- "long" "int" "integer" "unsignedInt" "byte" "float" "double"
- "base64Binary" "anyType" "anyURI" "Array" "byte[]"))
- (soap-namespace-put
- (make-soap-basic-type :name type :kind (intern type))
- ns))
- ns))
-
-(defun soap-type-p (element)
- "Return t if ELEMENT is a SOAP data type (basic or complex)."
- (or (soap-basic-type-p element)
- (soap-sequence-type-p element)
- (soap-array-type-p element)))
-
;;;;; The WSDL document
;; The WSDL data structure used for encoding/decoding SOAP messages
-(defstruct soap-wsdl
+(defstruct (soap-wsdl
+ ;; NOTE: don't call this constructor, see `soap-make-wsdl'
+ (:constructor soap-make-wsdl^)
+ (:copier soap-copy-wsdl))
origin ; file or URL from which this wsdl was loaded
+ current-file ; most-recently fetched file or URL
+ xmlschema-imports ; a list of schema imports
ports ; a list of SOAP-PORT instances
alias-table ; a list of namespace aliases
namespaces ; a list of namespaces
)
+(defun soap-make-wsdl (origin)
+ "Create a new WSDL document, loaded from ORIGIN, and intialize it."
+ (let ((wsdl (soap-make-wsdl^ :origin origin)))
+
+ ;; Add the XSD types to the wsdl document
+ (let ((ns (soap-make-xs-basic-types
+ "http://www.w3.org/2001/XMLSchema" "xsd")))
+ (soap-wsdl-add-namespace ns wsdl)
+ (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl))
+
+ ;; Add the soapenc types to the wsdl document
+ (let ((ns (soap-make-xs-basic-types
+ "http://schemas.xmlsoap.org/soap/encoding/" "soapenc")))
+ (soap-wsdl-add-namespace ns wsdl)
+ (soap-wsdl-add-alias "soapenc" (soap-namespace-name ns) wsdl))
+
+ wsdl))
+
(defun soap-wsdl-add-alias (alias name wsdl)
"Add a namespace ALIAS for NAME to the WSDL document."
- (push (cons alias name) (soap-wsdl-alias-table wsdl)))
+ (let ((existing (assoc alias (soap-wsdl-alias-table wsdl))))
+ (if existing
+ (unless (equal (cdr existing) name)
+ (warn "Redefining alias %s from %s to %s"
+ alias (cdr existing) name)
+ (push (cons alias name) (soap-wsdl-alias-table wsdl)))
+ (push (cons alias name) (soap-wsdl-alias-table wsdl)))))
(defun soap-wsdl-find-namespace (name wsdl)
"Find a namespace by NAME in the WSDL document."
@@ -473,11 +2030,11 @@ elements will be added to it."
(let ((existing (soap-wsdl-find-namespace (soap-namespace-name ns) wsdl)))
(if existing
;; Add elements from NS to EXISTING, replacing existing values.
- (maphash (lambda (key value)
+ (maphash (lambda (_key value)
(dolist (v value)
(soap-namespace-put v existing)))
(soap-namespace-elements ns))
- (push ns (soap-wsdl-namespaces wsdl)))))
+ (push ns (soap-wsdl-namespaces wsdl)))))
(defun soap-wsdl-get (name wsdl &optional predicate use-local-alias-table)
"Retrieve element NAME from the WSDL document.
@@ -488,9 +2045,9 @@ structure predicate for the type of element you want to retrieve.
For example, to retrieve a message named \"foo\" when other
elements named \"foo\" exist in the WSDL you could use:
- (soap-wsdl-get \"foo\" WSDL 'soap-message-p)
+ (soap-wsdl-get \"foo\" WSDL \\='soap-message-p)
-If USE-LOCAL-ALIAS-TABLE is not nil, `soap-local-xmlns` will be
+If USE-LOCAL-ALIAS-TABLE is not nil, `soap-local-xmlns' will be
used to resolve the namespace alias."
(let ((alias-table (soap-wsdl-alias-table wsdl))
namespace element-name element)
@@ -516,13 +2073,13 @@ used to resolve the namespace alias."
(ns-name (cdr (assoc ns-alias alias-table))))
(unless ns-name
(error "Soap-wsdl-get(%s): cannot find namespace alias %s"
- name ns-alias))
+ name ns-alias))
(setq namespace (soap-wsdl-find-namespace ns-name wsdl))
(unless namespace
(error
- "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s"
- name ns-name ns-alias))))
+ "Soap-wsdl-get(%s): unknown namespace %s, referenced as %s"
+ name ns-name ns-alias))))
(t
(error "Soap-wsdl-get(%s): bad name" name)))
@@ -532,7 +2089,7 @@ used to resolve the namespace alias."
(lambda (e)
(or (funcall 'soap-namespace-link-p e)
(funcall predicate e)))
- nil)))
+ nil)))
(unless element
(error "Soap-wsdl-get(%s): cannot find element" name))
@@ -540,92 +2097,96 @@ used to resolve the namespace alias."
(if (soap-namespace-link-p element)
;; NOTE: don't use the local alias table here
(soap-wsdl-get (soap-namespace-link-target element) wsdl predicate)
- element)))
+ element)))
+
+;;;;; soap-parse-schema
+
+(defun soap-parse-schema (node wsdl)
+ "Parse a schema NODE, placing the results in WSDL.
+Return a SOAP-NAMESPACE containing the elements."
+ (soap-with-local-xmlns node
+ (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
+ nil
+ "expecting an xsd:schema node, got %s"
+ (soap-l2wk (xml-node-name node)))
+
+ (let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
+
+ (dolist (def (xml-node-children node))
+ (unless (stringp def) ; skip text nodes
+ (case (soap-l2wk (xml-node-name def))
+ (xsd:import
+ ;; Imports will be processed later
+ ;; NOTE: we should expand the location now!
+ (let ((location (or
+ (xml-get-attribute-or-nil def 'schemaLocation)
+ (xml-get-attribute-or-nil def 'location))))
+ (when location
+ (push location (soap-wsdl-xmlschema-imports wsdl)))))
+ (xsd:element
+ (soap-namespace-put (soap-xs-parse-element def) ns))
+ (xsd:attribute
+ (soap-namespace-put (soap-xs-parse-attribute def) ns))
+ (xsd:attributeGroup
+ (soap-namespace-put (soap-xs-parse-attribute-group def) ns))
+ (xsd:simpleType
+ (soap-namespace-put (soap-xs-parse-simple-type def) ns))
+ ((xsd:complexType xsd:group)
+ (soap-namespace-put (soap-xs-parse-complex-type def) ns)))))
+ ns)))
;;;;; Resolving references for wsdl types
;; See `soap-wsdl-resolve-references', which is the main entry point for
;; resolving references
-(defun soap-resolve-references-for-element (element wsdl)
- "Resolve references in ELEMENT using the WSDL document.
-This is a generic function which invokes a specific function
-depending on the element type.
+(defun soap-resolve-references (element wsdl)
+ "Replace names in ELEMENT with the referenced objects in the WSDL.
+This is a generic function which invokes a specific resolver
+function depending on the type of the ELEMENT.
-If ELEMENT has no resolver function, it is silently ignored.
-
-All references are resolved in-place, that is the ELEMENT is
-updated."
+If ELEMENT has no resolver function, it is silently ignored."
(let ((resolver (get (aref element 0) 'soap-resolve-references)))
(when resolver
(funcall resolver element wsdl))))
-(defun soap-resolve-references-for-simple-type (type wsdl)
- "Resolve the base type for the simple TYPE using the WSDL
- document."
- (let ((kind (soap-basic-type-kind type)))
- (unless (symbolp kind)
- (let ((basic-type (soap-wsdl-get kind wsdl 'soap-basic-type-p)))
- (setf (soap-basic-type-kind type)
- (soap-basic-type-kind basic-type))))))
-
-(defun soap-resolve-references-for-sequence-type (type wsdl)
- "Resolve references for a sequence TYPE using WSDL document.
-See also `soap-resolve-references-for-element' and
-`soap-wsdl-resolve-references'"
- (let ((parent (soap-sequence-type-parent type)))
- (when (or (consp parent) (stringp parent))
- (setf (soap-sequence-type-parent type)
- (soap-wsdl-get
- parent wsdl
- ;; Prevent self references, see Bug#9
- (lambda (e) (and (not (eq e type)) (soap-type-p e)))))))
- (dolist (element (soap-sequence-type-elements type))
- (let ((element-type (soap-sequence-element-type element)))
- (cond ((or (consp element-type) (stringp element-type))
- (setf (soap-sequence-element-type element)
- (soap-wsdl-get
- element-type wsdl
- ;; Prevent self references, see Bug#9
- (lambda (e) (and (not (eq e type)) (soap-type-p e))))))
- ((soap-element-p element-type)
- ;; since the element already has a child element, it
- ;; could be an inline structure. we must resolve
- ;; references in it, because it might not be reached by
- ;; scanning the wsdl names.
- (soap-resolve-references-for-element element-type wsdl))))))
-
-(defun soap-resolve-references-for-array-type (type wsdl)
- "Resolve references for an array TYPE using WSDL.
-See also `soap-resolve-references-for-element' and
-`soap-wsdl-resolve-references'"
- (let ((element-type (soap-array-type-element-type type)))
- (when (or (consp element-type) (stringp element-type))
- (setf (soap-array-type-element-type type)
- (soap-wsdl-get
- element-type wsdl
- ;; Prevent self references, see Bug#9
- (lambda (e) (and (not (eq e type)) (soap-type-p e))))))))
-
(defun soap-resolve-references-for-message (message wsdl)
- "Resolve references for a MESSAGE type using the WSDL document.
-See also `soap-resolve-references-for-element' and
-`soap-wsdl-resolve-references'"
+ "Replace names in MESSAGE with the referenced objects in the WSDL.
+This is a generic function, called by `soap-resolve-references',
+you should use that function instead.
+
+See also `soap-wsdl-resolve-references'."
(let (resolved-parts)
(dolist (part (soap-message-parts message))
(let ((name (car part))
- (type (cdr part)))
+ (element (cdr part)))
(when (stringp name)
(setq name (intern name)))
- (when (or (consp type) (stringp type))
- (setq type (soap-wsdl-get type wsdl 'soap-type-p)))
- (push (cons name type) resolved-parts)))
- (setf (soap-message-parts message) (nreverse resolved-parts))))
+ (if (soap-name-p element)
+ (setq element (soap-wsdl-get
+ element wsdl
+ (lambda (x)
+ (or (soap-xs-type-p x) (soap-xs-element-p x)))))
+ ;; else, inline element, resolve recursively, as the element
+ ;; won't be reached.
+ (soap-resolve-references element wsdl)
+ (unless (soap-element-namespace-tag element)
+ (setf (soap-element-namespace-tag element)
+ (soap-element-namespace-tag message))))
+ (push (cons name element) resolved-parts)))
+ (setf (soap-message-parts message) (nreverse resolved-parts))))
(defun soap-resolve-references-for-operation (operation wsdl)
"Resolve references for an OPERATION type using the WSDL document.
-See also `soap-resolve-references-for-element' and
+See also `soap-resolve-references' and
`soap-wsdl-resolve-references'"
+
+ (let ((namespace (soap-element-namespace-tag operation)))
+ (when namespace
+ (let ((nstag (car (rassoc namespace (soap-wsdl-alias-table wsdl)))))
+ (when nstag
+ (setf (soap-element-namespace-tag operation) nstag)))))
+
(let ((input (soap-operation-input operation))
(counter 0))
(let ((name (car input))
@@ -633,10 +2194,10 @@ See also `soap-resolve-references-for-element' and
;; Name this part if it was not named
(when (or (null name) (equal name ""))
(setq name (format "in%d" (incf counter))))
- (when (or (consp message) (stringp message))
+ (when (soap-name-p message)
(setf (soap-operation-input operation)
(cons (intern name)
- (soap-wsdl-get message wsdl 'soap-message-p))))))
+ (soap-wsdl-get message wsdl 'soap-message-p))))))
(let ((output (soap-operation-output operation))
(counter 0))
@@ -644,10 +2205,10 @@ See also `soap-resolve-references-for-element' and
(message (cdr output)))
(when (or (null name) (equal name ""))
(setq name (format "out%d" (incf counter))))
- (when (or (consp message) (stringp message))
+ (when (soap-name-p message)
(setf (soap-operation-output operation)
(cons (intern name)
- (soap-wsdl-get message wsdl 'soap-message-p))))))
+ (soap-wsdl-get message wsdl 'soap-message-p))))))
(let ((resolved-faults nil)
(counter 0))
@@ -656,11 +2217,11 @@ See also `soap-resolve-references-for-element' and
(message (cdr fault)))
(when (or (null name) (equal name ""))
(setq name (format "fault%d" (incf counter))))
- (if (or (consp message) (stringp message))
+ (if (soap-name-p message)
(push (cons (intern name)
- (soap-wsdl-get message wsdl 'soap-message-p))
+ (soap-wsdl-get message wsdl 'soap-message-p))
resolved-faults)
- (push fault resolved-faults))))
+ (push fault resolved-faults))))
(setf (soap-operation-faults operation) resolved-faults))
(when (= (length (soap-operation-parameter-order operation)) 0)
@@ -672,42 +2233,44 @@ See also `soap-resolve-references-for-element' and
(mapcar (lambda (p)
(if (stringp p)
(intern p)
- p))
+ p))
(soap-operation-parameter-order operation))))
(defun soap-resolve-references-for-binding (binding wsdl)
- "Resolve references for a BINDING type using the WSDL document.
-See also `soap-resolve-references-for-element' and
+ "Resolve references for a BINDING type using the WSDL document.
+See also `soap-resolve-references' and
`soap-wsdl-resolve-references'"
- (when (or (consp (soap-binding-port-type binding))
- (stringp (soap-binding-port-type binding)))
+ (when (soap-name-p (soap-binding-port-type binding))
(setf (soap-binding-port-type binding)
(soap-wsdl-get (soap-binding-port-type binding)
- wsdl 'soap-port-type-p)))
+ wsdl 'soap-port-type-p)))
(let ((port-ops (soap-port-type-operations (soap-binding-port-type binding))))
(maphash (lambda (k v)
(setf (soap-bound-operation-operation v)
- (soap-namespace-get k port-ops 'soap-operation-p)))
+ (soap-namespace-get k port-ops 'soap-operation-p))
+ (let (resolved-headers)
+ (dolist (h (soap-bound-operation-soap-headers v))
+ (push (list (soap-wsdl-get (nth 0 h) wsdl)
+ (intern (nth 1 h))
+ (nth 2 h))
+ resolved-headers))
+ (setf (soap-bound-operation-soap-headers v)
+ (nreverse resolved-headers))))
(soap-binding-operations binding))))
(defun soap-resolve-references-for-port (port wsdl)
- "Resolve references for a PORT type using the WSDL document.
-See also `soap-resolve-references-for-element' and
-`soap-wsdl-resolve-references'"
- (when (or (consp (soap-port-binding port))
- (stringp (soap-port-binding port)))
+ "Replace names in PORT with the referenced objects in the WSDL.
+This is a generic function, called by `soap-resolve-references',
+you should use that function instead.
+
+See also `soap-wsdl-resolve-references'."
+ (when (soap-name-p (soap-port-binding port))
(setf (soap-port-binding port)
(soap-wsdl-get (soap-port-binding port) wsdl 'soap-binding-p))))
;; Install resolvers for our types
(progn
- (put (aref (make-soap-simple-type) 0) 'soap-resolve-references
- 'soap-resolve-references-for-simple-type)
- (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references
- 'soap-resolve-references-for-sequence-type)
- (put (aref (make-soap-array-type) 0) 'soap-resolve-references
- 'soap-resolve-references-for-array-type)
(put (aref (make-soap-message) 0) 'soap-resolve-references
'soap-resolve-references-for-message)
(put (aref (make-soap-operation) 0) 'soap-resolve-references
@@ -744,312 +2307,173 @@ traverse an element tree."
(soap-wsdl-add-alias nstag (soap-namespace-name ns) wsdl)
(throw 'done t)))))
- (maphash (lambda (name element)
+ (maphash (lambda (_name element)
(cond ((soap-element-p element) ; skip links
(incf nprocessed)
- (soap-resolve-references-for-element element wsdl)
- (setf (soap-element-namespace-tag element) nstag))
+ (soap-resolve-references element wsdl))
((listp element)
(dolist (e element)
(when (soap-element-p e)
(incf nprocessed)
- (soap-resolve-references-for-element e wsdl)
- (setf (soap-element-namespace-tag e) nstag))))))
+ (soap-resolve-references e wsdl))))))
(soap-namespace-elements ns)))))
- wsdl)
+ wsdl)
;;;;; Loading WSDL from XML documents
-(defun soap-load-wsdl-from-url (url)
- "Load a WSDL document from URL and return it.
-The returned WSDL document needs to be used for `soap-invoke'
-calls."
- (let ((url-request-method "GET")
+(defun soap-parse-server-response ()
+ "Error-check and parse the XML contents of the current buffer."
+ (let ((mime-part (mm-dissect-buffer t t)))
+ (unless mime-part
+ (error "Failed to decode response from server"))
+ (unless (equal (car (mm-handle-type mime-part)) "text/xml")
+ (error "Server response is not an XML document"))
+ (with-temp-buffer
+ (mm-insert-part mime-part)
+ (prog1
+ (car (xml-parse-region (point-min) (point-max)))
+ (kill-buffer)
+ (mm-destroy-part mime-part)))))
+
+(defun soap-fetch-xml-from-url (url wsdl)
+ "Load an XML document from URL and return it.
+The previously parsed URL is read from WSDL."
+ (message "Fetching from %s" url)
+ (let ((current-file (url-expand-file-name url (soap-wsdl-current-file wsdl)))
+ (url-request-method "GET")
(url-package-name "soap-client.el")
(url-package-version "1.0")
(url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
- (url-request-coding-system 'utf-8)
- (url-http-attempt-keepalives nil))
- (let ((buffer (url-retrieve-synchronously url)))
+ (url-http-attempt-keepalives t))
+ (setf (soap-wsdl-current-file wsdl) current-file)
+ (let ((buffer (url-retrieve-synchronously current-file)))
(with-current-buffer buffer
(declare (special url-http-response-status))
(if (> url-http-response-status 299)
(error "Error retrieving WSDL: %s" url-http-response-status))
- (let ((mime-part (mm-dissect-buffer t t)))
- (unless mime-part
- (error "Failed to decode response from server"))
- (unless (equal (car (mm-handle-type mime-part)) "text/xml")
- (error "Server response is not an XML document"))
- (with-temp-buffer
- (mm-insert-part mime-part)
- (let ((wsdl-xml (car (xml-parse-region (point-min) (point-max)))))
- (prog1
- (let ((wsdl (soap-parse-wsdl wsdl-xml)))
- (setf (soap-wsdl-origin wsdl) url)
- wsdl)
- (kill-buffer buffer)))))))))
-
-(defun soap-load-wsdl (file)
- "Load a WSDL document from FILE and return it."
- (with-temp-buffer
- (insert-file-contents file)
- (let ((xml (car (xml-parse-region (point-min) (point-max)))))
- (let ((wsdl (soap-parse-wsdl xml)))
- (setf (soap-wsdl-origin wsdl) file)
- wsdl))))
-
-(defun soap-parse-wsdl (node)
- "Construct a WSDL structure from NODE, which is an XML document."
+ (soap-parse-server-response)))))
+
+(defun soap-fetch-xml-from-file (file wsdl)
+ "Load an XML document from FILE and return it.
+The previously parsed file is read from WSDL."
+ (let* ((current-file (soap-wsdl-current-file wsdl))
+ (expanded-file (expand-file-name file
+ (if current-file
+ (file-name-directory current-file)
+ default-directory))))
+ (setf (soap-wsdl-current-file wsdl) expanded-file)
+ (with-temp-buffer
+ (insert-file-contents expanded-file)
+ (car (xml-parse-region (point-min) (point-max))))))
+
+(defun soap-fetch-xml (file-or-url wsdl)
+ "Load an XML document from FILE-OR-URL and return it.
+The previously parsed file or URL is read from WSDL."
+ (let ((current-file (or (soap-wsdl-current-file wsdl) file-or-url)))
+ (if (or (and current-file (file-exists-p current-file))
+ (file-exists-p file-or-url))
+ (soap-fetch-xml-from-file file-or-url wsdl)
+ (soap-fetch-xml-from-url file-or-url wsdl))))
+
+(defun soap-load-wsdl (file-or-url &optional wsdl)
+ "Load a document from FILE-OR-URL and return it.
+Build on WSDL if it is provided."
+ (let* ((wsdl (or wsdl (soap-make-wsdl file-or-url)))
+ (xml (soap-fetch-xml file-or-url wsdl)))
+ (soap-wsdl-resolve-references (soap-parse-wsdl xml wsdl))
+ wsdl))
+
+(defalias 'soap-load-wsdl-from-url 'soap-load-wsdl)
+
+(defun soap-parse-wsdl-phase-validate-node (node)
+ "Assert that NODE is valid."
(soap-with-local-xmlns node
+ (let ((node-name (soap-l2wk (xml-node-name node))))
+ (assert (eq node-name 'wsdl:definitions)
+ nil
+ "expecting wsdl:definitions node, got %s" node-name))))
- (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:definitions)
- nil
- "soap-parse-wsdl: expecting wsdl:definitions node, got %s"
- (soap-l2wk (xml-node-name node)))
-
- (let ((wsdl (make-soap-wsdl)))
-
- ;; Add the local alias table to the wsdl document -- it will be used for
- ;; all types in this document even after we finish parsing it.
- (setf (soap-wsdl-alias-table wsdl) soap-local-xmlns)
-
- ;; Add the XSD types to the wsdl document
- (let ((ns (soap-default-xsd-types)))
- (soap-wsdl-add-namespace ns wsdl)
- (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl))
-
- ;; Add the soapenc types to the wsdl document
- (let ((ns (soap-default-soapenc-types)))
- (soap-wsdl-add-namespace ns wsdl)
- (soap-wsdl-add-alias "soapenc" (soap-namespace-name ns) wsdl))
-
- ;; Find all the 'xsd:schema nodes which are children of wsdl:types nodes
- ;; and build our type-library
-
- (let ((types (car (soap-xml-get-children1 node 'wsdl:types))))
- (dolist (node (xml-node-children types))
- ;; We cannot use (xml-get-children node (soap-wk2l 'xsd:schema))
- ;; because each node can install its own alias type so the schema
- ;; nodes might have a different prefix.
- (when (consp node)
- (soap-with-local-xmlns node
- (when (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
- (soap-wsdl-add-namespace (soap-parse-schema node) wsdl))))))
-
- (let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
- (dolist (node (soap-xml-get-children1 node 'wsdl:message))
- (soap-namespace-put (soap-parse-message node) ns))
-
- (dolist (node (soap-xml-get-children1 node 'wsdl:portType))
- (let ((port-type (soap-parse-port-type node)))
- (soap-namespace-put port-type ns)
- (soap-wsdl-add-namespace
- (soap-port-type-operations port-type) wsdl)))
-
- (dolist (node (soap-xml-get-children1 node 'wsdl:binding))
- (soap-namespace-put (soap-parse-binding node) ns))
-
- (dolist (node (soap-xml-get-children1 node 'wsdl:service))
- (dolist (node (soap-xml-get-children1 node 'wsdl:port))
- (let ((name (xml-get-attribute node 'name))
- (binding (xml-get-attribute node 'binding))
- (url (let ((n (car (soap-xml-get-children1
- node 'wsdlsoap:address))))
- (xml-get-attribute n 'location))))
- (let ((port (make-soap-port
- :name name :binding (soap-l2fq binding 'tns)
- :service-url url)))
- (soap-namespace-put port ns)
- (push port (soap-wsdl-ports wsdl))))))
-
- (soap-wsdl-add-namespace ns wsdl))
-
- (soap-wsdl-resolve-references wsdl)
-
- wsdl)))
-
-(defun soap-parse-schema (node)
- "Parse a schema NODE.
-Return a SOAP-NAMESPACE containing the elements."
+(defun soap-parse-wsdl-phase-fetch-imports (node wsdl)
+ "Fetch and load files imported by NODE into WSDL."
(soap-with-local-xmlns node
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
- nil
- "soap-parse-schema: expecting an xsd:schema node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
- ;; NOTE: we only extract the complexTypes from the schema, we wouldn't
- ;; know how to handle basic types beyond the built in ones anyway.
- (dolist (node (soap-xml-get-children1 node 'xsd:simpleType))
- (soap-namespace-put (soap-parse-simple-type node) ns))
-
- (dolist (node (soap-xml-get-children1 node 'xsd:complexType))
- (soap-namespace-put (soap-parse-complex-type node) ns))
+ (dolist (node (soap-xml-get-children1 node 'wsdl:import))
+ (let ((location (xml-get-attribute-or-nil node 'location)))
+ (when location
+ (soap-load-wsdl location wsdl))))))
- (dolist (node (soap-xml-get-children1 node 'xsd:element))
- (soap-namespace-put (soap-parse-schema-element node) ns))
-
- ns)))
-
-(defun soap-parse-simple-type (node)
- "Parse NODE and construct a simple type from it."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:simpleType)
- nil
- "soap-parse-complex-type: expecting xsd:simpleType node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let ((name (xml-get-attribute-or-nil node 'name))
- type
- enumeration
- (restriction (car-safe
- (soap-xml-get-children1 node 'xsd:restriction))))
- (unless restriction
- (error "simpleType %s has no base type" name))
-
- (setq type (xml-get-attribute-or-nil restriction 'base))
- (dolist (e (soap-xml-get-children1 restriction 'xsd:enumeration))
- (push (xml-get-attribute e 'value) enumeration))
-
- (make-soap-simple-type :name name :kind type :enumeration enumeration)))
-
-(defun soap-parse-schema-element (node)
- "Parse NODE and construct a schema element from it."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element)
- nil
- "soap-parse-schema-element: expecting xsd:element node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let ((name (xml-get-attribute-or-nil node 'name))
- type)
- ;; A schema element that contains an inline complex type --
- ;; construct the actual complex type for it.
- (let ((type-node (soap-xml-get-children1 node 'xsd:complexType)))
- (when (> (length type-node) 0)
- (assert (= (length type-node) 1)) ; only one complex type
- ; definition per element
- (setq type (soap-parse-complex-type (car type-node)))))
- (setf (soap-element-name type) name)
- type))
-
-(defun soap-parse-complex-type (node)
- "Parse NODE and construct a complex type from it."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexType)
- nil
- "soap-parse-complex-type: expecting xsd:complexType node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let ((name (xml-get-attribute-or-nil node 'name))
- ;; Use a dummy type for the complex type, it will be replaced
- ;; with the real type below, except when the complex type node
- ;; is empty...
- (type (make-soap-sequence-type :elements nil)))
- (dolist (c (xml-node-children node))
- (when (consp c) ; skip string nodes, which are whitespace
- (let ((node-name (soap-l2wk (xml-node-name c))))
- (cond
- ;; The difference between xsd:all and xsd:sequence is that fields
- ;; in xsd:all are not ordered and they can occur only once. We
- ;; don't care about that difference in soap-client.el
- ((or (eq node-name 'xsd:sequence)
- (eq node-name 'xsd:all))
- (setq type (soap-parse-complex-type-sequence c)))
- ((eq node-name 'xsd:complexContent)
- (setq type (soap-parse-complex-type-complex-content c)))
- ((eq node-name 'xsd:attribute)
- ;; The name of this node comes from an attribute tag
- (let ((n (xml-get-attribute-or-nil c 'name)))
- (setq name n)))
- (t
- (error "Unknown node type %s" node-name))))))
- (setf (soap-element-name type) name)
- type))
-
-(defun soap-parse-sequence (node)
- "Parse NODE and a list of sequence elements that it defines.
-NODE is assumed to be an xsd:sequence node. In that case, each
-of its children is assumed to be a sequence element. Each
-sequence element is parsed constructing the corresponding type.
-A list of these types is returned."
- (assert (let ((n (soap-l2wk (xml-node-name node))))
- (memq n '(xsd:sequence xsd:all)))
- nil
- "soap-parse-sequence: expecting xsd:sequence or xsd:all node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let (elements)
- (dolist (e (soap-xml-get-children1 node 'xsd:element))
- (let ((name (xml-get-attribute-or-nil e 'name))
- (type (xml-get-attribute-or-nil e 'type))
- (nillable? (or (equal (xml-get-attribute-or-nil e 'nillable) "true")
- (let ((e (xml-get-attribute-or-nil e 'minOccurs)))
- (and e (equal e "0")))))
- (multiple? (let ((e (xml-get-attribute-or-nil e 'maxOccurs)))
- (and e (not (equal e "1"))))))
- (if type
- (setq type (soap-l2fq type 'tns))
-
- ;; The node does not have a type, maybe it has a complexType
- ;; defined inline...
- (let ((type-node (soap-xml-get-children1 e 'xsd:complexType)))
- (when (> (length type-node) 0)
- (assert (= (length type-node) 1)
- nil
- "only one complex type definition per element supported")
- (setq type (soap-parse-complex-type (car type-node))))))
-
- (push (make-soap-sequence-element
- :name (intern name) :type type :nillable? nillable?
- :multiple? multiple?)
- elements)))
- (nreverse elements)))
-
-(defun soap-parse-complex-type-sequence (node)
- "Parse NODE as a sequence type."
- (let ((elements (soap-parse-sequence node)))
- (make-soap-sequence-type :elements elements)))
-
-(defun soap-parse-complex-type-complex-content (node)
- "Parse NODE as a xsd:complexContent node.
-A sequence or an array type is returned depending on the actual
-contents."
- (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexContent)
- nil
- "soap-parse-complex-type-complex-content: expecting xsd:complexContent node, got %s"
- (soap-l2wk (xml-node-name node)))
- (let (array? parent elements)
- (let ((extension (car-safe (soap-xml-get-children1 node 'xsd:extension)))
- (restriction (car-safe
- (soap-xml-get-children1 node 'xsd:restriction))))
- ;; a complex content node is either an extension or a restriction
- (cond (extension
- (setq parent (xml-get-attribute-or-nil extension 'base))
- (setq elements (soap-parse-sequence
- (car (soap-xml-get-children1
- extension 'xsd:sequence)))))
- (restriction
- (let ((base (xml-get-attribute-or-nil restriction 'base)))
- (assert (equal base (soap-wk2l "soapenc:Array"))
- nil
- "restrictions supported only for soapenc:Array types, this is a %s"
- base))
- (setq array? t)
- (let ((attribute (car (soap-xml-get-children1
- restriction 'xsd:attribute))))
- (let ((array-type (soap-xml-get-attribute-or-nil1
- attribute 'wsdl:arrayType)))
- (when (string-match "^\\(.*\\)\\[\\]$" array-type)
- (setq parent (match-string 1 array-type))))))
-
- (t
- (error "Unknown complex type"))))
-
- (if parent
- (setq parent (soap-l2fq parent 'tns)))
+(defun soap-parse-wsdl-phase-parse-schema (node wsdl)
+ "Load types found in NODE into WSDL."
+ (soap-with-local-xmlns node
+ ;; Find all the 'xsd:schema nodes which are children of wsdl:types nodes and
+ ;; build our type-library.
+ (let ((types (car (soap-xml-get-children1 node 'wsdl:types))))
+ (dolist (node (xml-node-children types))
+ ;; We cannot use (xml-get-children node (soap-wk2l 'xsd:schema)) because
+ ;; each node can install its own alias type so the schema nodes might
+ ;; have a different prefix.
+ (when (consp node)
+ (soap-with-local-xmlns
+ node
+ (when (eq (soap-l2wk (xml-node-name node)) 'xsd:schema)
+ (soap-wsdl-add-namespace (soap-parse-schema node wsdl)
+ wsdl))))))))
+
+(defun soap-parse-wsdl-phase-fetch-schema (node wsdl)
+ "Fetch and load schema imports defined by NODE into WSDL."
+ (soap-with-local-xmlns node
+ (while (soap-wsdl-xmlschema-imports wsdl)
+ (let* ((import (pop (soap-wsdl-xmlschema-imports wsdl)))
+ (xml (soap-fetch-xml import wsdl)))
+ (soap-wsdl-add-namespace (soap-parse-schema xml wsdl) wsdl)))))
- (if array?
- (make-soap-array-type :element-type parent)
- (make-soap-sequence-type :parent parent :elements elements))))
+(defun soap-parse-wsdl-phase-finish-parsing (node wsdl)
+ "Finish parsing NODE into WSDL."
+ (soap-with-local-xmlns node
+ (let ((ns (make-soap-namespace :name (soap-get-target-namespace node))))
+ (dolist (node (soap-xml-get-children1 node 'wsdl:message))
+ (soap-namespace-put (soap-parse-message node) ns))
+
+ (dolist (node (soap-xml-get-children1 node 'wsdl:portType))
+ (let ((port-type (soap-parse-port-type node)))
+ (soap-namespace-put port-type ns)
+ (soap-wsdl-add-namespace
+ (soap-port-type-operations port-type) wsdl)))
+
+ (dolist (node (soap-xml-get-children1 node 'wsdl:binding))
+ (soap-namespace-put (soap-parse-binding node) ns))
+
+ (dolist (node (soap-xml-get-children1 node 'wsdl:service))
+ (dolist (node (soap-xml-get-children1 node 'wsdl:port))
+ (let ((name (xml-get-attribute node 'name))
+ (binding (xml-get-attribute node 'binding))
+ (url (let ((n (car (soap-xml-get-children1
+ node 'wsdlsoap:address))))
+ (xml-get-attribute n 'location))))
+ (let ((port (make-soap-port
+ :name name :binding (soap-l2fq binding 'tns)
+ :service-url url)))
+ (soap-namespace-put port ns)
+ (push port (soap-wsdl-ports wsdl))))))
+
+ (soap-wsdl-add-namespace ns wsdl))))
+
+(defun soap-parse-wsdl (node wsdl)
+ "Construct from NODE a WSDL structure, which is an XML document."
+ ;; Break this into phases to allow for asynchronous parsing.
+ (soap-parse-wsdl-phase-validate-node node)
+ ;; Makes synchronous calls.
+ (soap-parse-wsdl-phase-fetch-imports node wsdl)
+ (soap-parse-wsdl-phase-parse-schema node wsdl)
+ ;; Makes synchronous calls.
+ (soap-parse-wsdl-phase-fetch-schema node wsdl)
+ (soap-parse-wsdl-phase-finish-parsing node wsdl)
+ wsdl)
(defun soap-parse-message (node)
"Parse NODE as a wsdl:message and return the corresponding type."
(assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message)
nil
- "soap-parse-message: expecting wsdl:message node, got %s"
+ "expecting wsdl:message node, got %s"
(soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute-or-nil node 'name))
parts)
@@ -1061,97 +2485,111 @@ contents."
(when type
(setq type (soap-l2fq type 'tns)))
- (when element
- (setq element (soap-l2fq element 'tns)))
+ (if element
+ (setq element (soap-l2fq element 'tns))
+ ;; else
+ (setq element (make-soap-xs-element
+ :name name
+ :namespace-tag soap-target-xmlns
+ :type^ type)))
- (push (cons name (or type element)) parts)))
+ (push (cons name element) parts)))
(make-soap-message :name name :parts (nreverse parts))))
(defun soap-parse-port-type (node)
"Parse NODE as a wsdl:portType and return the corresponding port."
(assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType)
nil
- "soap-parse-port-type: expecting wsdl:portType node got %s"
+ "expecting wsdl:portType node got %s"
(soap-l2wk (xml-node-name node)))
- (let ((ns (make-soap-namespace
- :name (concat "urn:" (xml-get-attribute node 'name)))))
+ (let* ((soap-target-xmlns (concat "urn:" (xml-get-attribute node 'name)))
+ (ns (make-soap-namespace :name soap-target-xmlns)))
(dolist (node (soap-xml-get-children1 node 'wsdl:operation))
(let ((o (soap-parse-operation node)))
(let ((other-operation (soap-namespace-get
- (soap-element-name o) ns 'soap-operation-p)))
+ (soap-element-name o) ns 'soap-operation-p)))
(if other-operation
;; Unfortunately, the Confluence WSDL defines two operations
;; named "search" which differ only in parameter names...
(soap-warning "Discarding duplicate operation: %s"
- (soap-element-name o))
+ (soap-element-name o))
- (progn
- (soap-namespace-put o ns)
+ (progn
+ (soap-namespace-put o ns)
- ;; link all messages from this namespace, as this namespace
- ;; will be used for decoding the response.
- (destructuring-bind (name . message) (soap-operation-input o)
- (soap-namespace-put-link name message ns))
+ ;; link all messages from this namespace, as this namespace
+ ;; will be used for decoding the response.
+ (destructuring-bind (name . message) (soap-operation-input o)
+ (soap-namespace-put-link name message ns))
- (destructuring-bind (name . message) (soap-operation-output o)
- (soap-namespace-put-link name message ns))
+ (destructuring-bind (name . message) (soap-operation-output o)
+ (soap-namespace-put-link name message ns))
- (dolist (fault (soap-operation-faults o))
- (destructuring-bind (name . message) fault
- (soap-namespace-put-link name message ns 'replace)))
+ (dolist (fault (soap-operation-faults o))
+ (destructuring-bind (name . message) fault
+ (soap-namespace-put-link name message ns)))
- )))))
+ )))))
(make-soap-port-type :name (xml-get-attribute node 'name)
- :operations ns)))
+ :operations ns)))
(defun soap-parse-operation (node)
"Parse NODE as a wsdl:operation and return the corresponding type."
(assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation)
nil
- "soap-parse-operation: expecting wsdl:operation node, got %s"
+ "expecting wsdl:operation node, got %s"
(soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute node 'name))
(parameter-order (split-string
- (xml-get-attribute node 'parameterOrder)))
- input output faults)
+ (xml-get-attribute node 'parameterOrder)))
+ input output faults input-action output-action)
(dolist (n (xml-node-children node))
(when (consp n) ; skip string nodes which are whitespace
(let ((node-name (soap-l2wk (xml-node-name n))))
(cond
- ((eq node-name 'wsdl:input)
- (let ((message (xml-get-attribute n 'message))
- (name (xml-get-attribute n 'name)))
- (setq input (cons name (soap-l2fq message 'tns)))))
- ((eq node-name 'wsdl:output)
- (let ((message (xml-get-attribute n 'message))
- (name (xml-get-attribute n 'name)))
- (setq output (cons name (soap-l2fq message 'tns)))))
- ((eq node-name 'wsdl:fault)
- (let ((message (xml-get-attribute n 'message))
- (name (xml-get-attribute n 'name)))
- (push (cons name (soap-l2fq message 'tns)) faults)))))))
+ ((eq node-name 'wsdl:input)
+ (let ((message (xml-get-attribute n 'message))
+ (name (xml-get-attribute n 'name))
+ (action (soap-xml-get-attribute-or-nil1 n 'wsaw:Action)))
+ (setq input (cons name (soap-l2fq message 'tns)))
+ (setq input-action action)))
+ ((eq node-name 'wsdl:output)
+ (let ((message (xml-get-attribute n 'message))
+ (name (xml-get-attribute n 'name))
+ (action (soap-xml-get-attribute-or-nil1 n 'wsaw:Action)))
+ (setq output (cons name (soap-l2fq message 'tns)))
+ (setq output-action action)))
+ ((eq node-name 'wsdl:fault)
+ (let ((message (xml-get-attribute n 'message))
+ (name (xml-get-attribute n 'name)))
+ (push (cons name (soap-l2fq message 'tns)) faults)))))))
(make-soap-operation
:name name
+ :namespace-tag soap-target-xmlns
:parameter-order parameter-order
:input input
:output output
- :faults (nreverse faults))))
+ :faults (nreverse faults)
+ :input-action input-action
+ :output-action output-action)))
(defun soap-parse-binding (node)
"Parse NODE as a wsdl:binding and return the corresponding type."
(assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding)
nil
- "soap-parse-binding: expecting wsdl:binding node, got %s"
+ "expecting wsdl:binding node, got %s"
(soap-l2wk (xml-node-name node)))
(let ((name (xml-get-attribute node 'name))
(type (xml-get-attribute node 'type)))
(let ((binding (make-soap-binding :name name
- :port-type (soap-l2fq type 'tns))))
+ :port-type (soap-l2fq type 'tns))))
(dolist (wo (soap-xml-get-children1 node 'wsdl:operation))
(let ((name (xml-get-attribute wo 'name))
soap-action
+ soap-headers
+ soap-body
use)
(dolist (so (soap-xml-get-children1 wo 'wsdlsoap:operation))
(setq soap-action (xml-get-attribute-or-nil so 'soapAction)))
@@ -1162,9 +2600,24 @@ contents."
;; "use"-s for each of them...
(dolist (i (soap-xml-get-children1 wo 'wsdl:input))
- (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body))
- (setq use (or use
- (xml-get-attribute-or-nil b 'use)))))
+
+ ;; There can be multiple headers ...
+ (dolist (h (soap-xml-get-children1 i 'wsdlsoap:header))
+ (let ((message (soap-l2fq (xml-get-attribute-or-nil h 'message)))
+ (part (xml-get-attribute-or-nil h 'part))
+ (use (xml-get-attribute-or-nil h 'use)))
+ (when (and message part)
+ (push (list message part use) soap-headers))))
+
+ ;; ... but only one body
+ (let ((body (car (soap-xml-get-children1 i 'wsdlsoap:body))))
+ (setq soap-body (xml-get-attribute-or-nil body 'parts))
+ (when soap-body
+ (setq soap-body
+ (mapcar #'intern (split-string soap-body
+ nil
+ 'omit-nulls))))
+ (setq use (xml-get-attribute-or-nil body 'use))))
(unless use
(dolist (i (soap-xml-get-children1 wo 'wsdl:output))
@@ -1172,9 +2625,12 @@ contents."
(setq use (or use
(xml-get-attribute-or-nil b 'use))))))
- (puthash name (make-soap-bound-operation :operation name
- :soap-action soap-action
- :use (and use (intern use)))
+ (puthash name (make-soap-bound-operation
+ :operation name
+ :soap-action soap-action
+ :soap-headers (nreverse soap-headers)
+ :soap-body soap-body
+ :use (and use (intern use)))
(soap-binding-operations binding))))
binding)))
@@ -1190,10 +2646,6 @@ SOAP response.")
This is a dynamically bound variable used during decoding the
SOAP response.")
-(defvar soap-current-wsdl nil
- "The current WSDL document used when decoding the SOAP response.
-This is a dynamically bound variable.")
-
(defun soap-decode-type (type node)
"Use TYPE (an xsd type) to decode the contents of NODE.
@@ -1211,7 +2663,8 @@ decode function to perform the actual decoding."
(when decoded
(throw 'done decoded)))
- (string-match "^#\\(.*\\)$" href) ; TODO: check that it matched
+ (unless (string-match "^#\\(.*\\)$" href)
+ (error "Invalid multiRef: %s" href))
(let ((id (match-string 1 href)))
(dolist (mr soap-multi-refs)
@@ -1226,38 +2679,53 @@ decode function to perform the actual decoding."
(soap-with-local-xmlns node
(if (equal (soap-xml-get-attribute-or-nil1 node 'xsi:nil) "true")
nil
- (let ((decoder (get (aref type 0) 'soap-decoder)))
- (assert decoder nil "no soap-decoder for %s type"
- (aref type 0))
- (funcall decoder type node))))))))
+ ;; Handle union types.
+ (cond ((listp type)
+ (catch 'done
+ (dolist (union-member type)
+ (let* ((decoder (get (aref union-member 0)
+ 'soap-decoder))
+ (result (ignore-errors
+ (funcall decoder
+ union-member node))))
+ (when result (throw 'done result))))))
+ (t
+ (let ((decoder (get (aref type 0) 'soap-decoder)))
+ (assert decoder nil
+ "no soap-decoder for %s type" (aref type 0))
+ (funcall decoder type node))))))))))
(defun soap-decode-any-type (node)
"Decode NODE using type information inside it."
;; If the NODE has type information, we use that...
(let ((type (soap-xml-get-attribute-or-nil1 node 'xsi:type)))
+ (when type
+ (setq type (soap-l2fq type)))
(if type
- (let ((wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p)))
+ (let ((wtype (soap-wsdl-get type soap-current-wsdl 'soap-xs-type-p)))
(if wtype
(soap-decode-type wtype node)
- ;; The node has type info encoded in it, but we don't know how
- ;; to decode it...
- (error "Soap-decode-any-type: node has unknown type: %s" type)))
-
- ;; No type info in the node...
-
- (let ((contents (xml-node-children node)))
- (if (and (= (length contents) 1) (stringp (car contents)))
- ;; contents is just a string
- (car contents)
-
- ;; we assume the NODE is a sequence with every element a
- ;; structure name
- (let (result)
- (dolist (element contents)
- (let ((key (xml-node-name element))
- (value (soap-decode-any-type element)))
- (push (cons key value) result)))
- (nreverse result)))))))
+ ;; The node has type info encoded in it, but we don't know how
+ ;; to decode it...
+ (error "Node has unknown type: %s" type)))
+
+ ;; No type info in the node...
+
+ (let ((contents (xml-node-children node)))
+ (if (and (= (length contents) 1) (stringp (car contents)))
+ ;; contents is just a string
+ (car contents)
+
+ ;; we assume the NODE is a sequence with every element a
+ ;; structure name
+ (let (result)
+ (dolist (element contents)
+ ;; skip any string contents, assume they are whitespace
+ (unless (stringp element)
+ (let ((key (xml-node-name element))
+ (value (soap-decode-any-type element)))
+ (push (cons key value) result))))
+ (nreverse result)))))))
(defun soap-decode-array (node)
"Decode NODE as an Array using type information inside it."
@@ -1266,90 +2734,23 @@ decode function to perform the actual decoding."
(contents (xml-node-children node))
result)
(when type
- ;; Type is in the format "someType[NUM]" where NUM is the number of
- ;; elements in the array. We discard the [NUM] part.
- (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type))
- (setq wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p))
- (unless wtype
- ;; The node has type info encoded in it, but we don't know how to
- ;; decode it...
- (error "Soap-decode-array: node has unknown type: %s" type)))
+ ;; Type is in the format "someType[NUM]" where NUM is the number of
+ ;; elements in the array. We discard the [NUM] part.
+ (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type))
+ (setq wtype (soap-wsdl-get (soap-l2fq type)
+ soap-current-wsdl 'soap-xs-type-p))
+ (unless wtype
+ ;; The node has type info encoded in it, but we don't know how to
+ ;; decode it...
+ (error "Soap-decode-array: node has unknown type: %s" type)))
(dolist (e contents)
(when (consp e)
(push (if wtype
(soap-decode-type wtype e)
- (soap-decode-any-type e))
+ (soap-decode-any-type e))
result)))
(nreverse result)))
-(defun soap-decode-basic-type (type node)
- "Use TYPE to decode the contents of NODE.
-TYPE is a `soap-basic-type' struct, and NODE is an XML document.
-A LISP value is returned based on the contents of NODE and the
-type-info stored in TYPE."
- (let ((contents (xml-node-children node))
- (type-kind (soap-basic-type-kind type)))
-
- (if (null contents)
- nil
- (ecase type-kind
- ((string anyURI) (car contents))
- (dateTime (car contents)) ; TODO: convert to a date time
- ((long int integer unsignedInt byte float double) (string-to-number (car contents)))
- (boolean (string= (downcase (car contents)) "true"))
- (base64Binary (base64-decode-string (car contents)))
- (anyType (soap-decode-any-type node))
- (Array (soap-decode-array node))))))
-
-(defun soap-decode-sequence-type (type node)
- "Use TYPE to decode the contents of NODE.
-TYPE is assumed to be a sequence type and an ALIST with the
-contents of the NODE is returned."
- (let ((result nil)
- (parent (soap-sequence-type-parent type)))
- (when parent
- (setq result (nreverse (soap-decode-type parent node))))
- (dolist (element (soap-sequence-type-elements type))
- (let ((instance-count 0)
- (e-name (soap-sequence-element-name element))
- (e-type (soap-sequence-element-type element)))
- (dolist (node (xml-get-children node e-name))
- (incf instance-count)
- (push (cons e-name (soap-decode-type e-type node)) result))
- ;; Do some sanity checking
- (cond ((and (= instance-count 0)
- (not (soap-sequence-element-nillable? element)))
- (soap-warning "While decoding %s: missing non-nillable slot %s"
- (soap-element-name type) e-name))
- ((and (> instance-count 1)
- (not (soap-sequence-element-multiple? element)))
- (soap-warning "While decoding %s: multiple slots named %s"
- (soap-element-name type) e-name)))))
- (nreverse result)))
-
-(defun soap-decode-array-type (type node)
- "Use TYPE to decode the contents of NODE.
-TYPE is assumed to be an array type. Arrays are decoded as lists.
-This is because it is easier to work with list results in LISP."
- (let ((result nil)
- (element-type (soap-array-type-element-type type)))
- (dolist (node (xml-node-children node))
- (when (consp node)
- (push (soap-decode-type element-type node) result)))
- (nreverse result)))
-
-(progn
- (put (aref (make-soap-basic-type) 0)
- 'soap-decoder 'soap-decode-basic-type)
- ;; just use the basic type decoder for the simple type -- we accept any
- ;; value and don't do any validation on it.
- (put (aref (make-soap-simple-type) 0)
- 'soap-decoder 'soap-decode-basic-type)
- (put (aref (make-soap-sequence-type) 0)
- 'soap-decoder 'soap-decode-sequence-type)
- (put (aref (make-soap-array-type) 0)
- 'soap-decoder 'soap-decode-array-type))
-
;;;; Soap Envelope parsing
(define-error 'soap-error "SOAP error")
@@ -1361,40 +2762,44 @@ WSDL is used to decode the NODE"
(soap-with-local-xmlns node
(assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope)
nil
- "soap-parse-envelope: expecting soap:Envelope node, got %s"
+ "expecting soap:Envelope node, got %s"
(soap-l2wk (xml-node-name node)))
- (let ((body (car (soap-xml-get-children1 node 'soap:Body))))
+ (let ((headers (soap-xml-get-children1 node 'soap:Header))
+ (body (car (soap-xml-get-children1 node 'soap:Body))))
(let ((fault (car (soap-xml-get-children1 body 'soap:Fault))))
(when fault
(let ((fault-code (let ((n (car (xml-get-children
- fault 'faultcode))))
+ fault 'faultcode))))
(car-safe (xml-node-children n))))
(fault-string (let ((n (car (xml-get-children
fault 'faultstring))))
(car-safe (xml-node-children n))))
(detail (xml-get-children fault 'detail)))
- (while t
- (signal 'soap-error (list fault-code fault-string detail))))))
+ (while t
+ (signal 'soap-error (list fault-code fault-string detail))))))
;; First (non string) element of the body is the root node of he
;; response
(let ((response (if (eq (soap-bound-operation-use operation) 'literal)
;; For 'literal uses, the response is the actual body
body
- ;; ...otherwise the first non string element
- ;; of the body is the response
- (catch 'found
- (dolist (n (xml-node-children body))
- (when (consp n)
- (throw 'found n)))))))
- (soap-parse-response response operation wsdl body)))))
-
-(defun soap-parse-response (response-node operation wsdl soap-body)
+ ;; ...otherwise the first non string element
+ ;; of the body is the response
+ (catch 'found
+ (dolist (n (xml-node-children body))
+ (when (consp n)
+ (throw 'found n)))))))
+ (soap-parse-response response operation wsdl headers body)))))
+
+(defun soap-parse-response (response-node operation wsdl soap-headers soap-body)
"Parse RESPONSE-NODE and return the result as a LISP value.
OPERATION is the WSDL operation for which we expect the response,
WSDL is used to decode the NODE.
+SOAP-HEADERS is a list of the headers of the SOAP envelope or nil
+if there are no headers.
+
SOAP-BODY is the body of the SOAP envelope (of which
RESPONSE-NODE is a sub-node). It is used in case RESPONSE-NODE
reference multiRef parts which are external to RESPONSE-NODE."
@@ -1408,7 +2813,7 @@ reference multiRef parts which are external to RESPONSE-NODE."
(when (eq use 'encoded)
(let* ((received-message-name (soap-l2fq (xml-node-name response-node)))
(received-message (soap-wsdl-get
- received-message-name wsdl 'soap-message-p)))
+ received-message-name wsdl 'soap-message-p)))
(unless (eq received-message message)
(error "Unexpected message: got %s, expecting %s"
received-message-name
@@ -1425,42 +2830,52 @@ reference multiRef parts which are external to RESPONSE-NODE."
(setq node
(cond
- ((eq use 'encoded)
- (car (xml-get-children response-node tag)))
-
- ((eq use 'literal)
- (catch 'found
- (let* ((ns-aliases (soap-wsdl-alias-table wsdl))
- (ns-name (cdr (assoc
- (soap-element-namespace-tag type)
- ns-aliases)))
- (fqname (cons ns-name (soap-element-name type))))
- (dolist (c (xml-node-children response-node))
- (when (consp c)
- (soap-with-local-xmlns c
- (when (equal (soap-l2fq (xml-node-name c))
- fqname)
- (throw 'found c))))))))))
+ ((eq use 'encoded)
+ (car (xml-get-children response-node tag)))
+
+ ((eq use 'literal)
+ (catch 'found
+ (let* ((ns-aliases (soap-wsdl-alias-table wsdl))
+ (ns-name (cdr (assoc
+ (soap-element-namespace-tag type)
+ ns-aliases)))
+ (fqname (cons ns-name (soap-element-name type))))
+ (dolist (c (append (mapcar (lambda (header)
+ (car (xml-node-children
+ header)))
+ soap-headers)
+ (xml-node-children response-node)))
+ (when (consp c)
+ (soap-with-local-xmlns c
+ (when (equal (soap-l2fq (xml-node-name c))
+ fqname)
+ (throw 'found c))))))))))
(unless node
(error "Soap-parse-response(%s): cannot find message part %s"
(soap-element-name op) tag))
- (push (soap-decode-type type node) decoded-parts)))
+ (let ((decoded-value (soap-decode-type type node)))
+ (when decoded-value
+ (push decoded-value decoded-parts)))))
decoded-parts))))
;;;; SOAP type encoding
-(defvar soap-encoded-namespaces nil
- "A list of namespace tags used during encoding a message.
-This list is populated by `soap-encode-value' and used by
-`soap-create-envelope' to add aliases for these namespace to the
-XML request.
+(defun soap-encode-attributes (value type)
+ "Encode XML attributes for VALUE according to TYPE.
+This is a generic function which determines the attribute encoder
+for the type and calls that specialized function to do the work.
-This variable is dynamically bound in `soap-create-envelope'.")
+Attributes are inserted in the current buffer at the current
+position."
+ (let ((attribute-encoder (get (aref type 0) 'soap-attribute-encoder)))
+ (assert attribute-encoder nil
+ "no soap-attribute-encoder for %s type" (aref type 0))
+ (funcall attribute-encoder value type)))
-(defun soap-encode-value (xml-tag value type)
- "Encode inside an XML-TAG the VALUE using TYPE.
+(defun soap-encode-value (value type)
+ "Encode the VALUE using TYPE.
The resulting XML data is inserted in the current buffer
at (point)/
@@ -1470,190 +2885,24 @@ encoder function based on TYPE and calls that encoder to do the
work."
(let ((encoder (get (aref type 0) 'soap-encoder)))
(assert encoder nil "no soap-encoder for %s type" (aref type 0))
- ;; XML-TAG can be a string or a symbol, but we pass only string's to the
- ;; encoders
- (when (symbolp xml-tag)
- (setq xml-tag (symbol-name xml-tag)))
- (funcall encoder xml-tag value type))
- (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type)))
-
-(defun soap-encode-basic-type (xml-tag value type)
- "Encode inside XML-TAG the LISP VALUE according to TYPE.
-Do not call this function directly, use `soap-encode-value'
-instead."
- (let ((xsi-type (soap-element-fq-name type))
- (basic-type (soap-basic-type-kind type)))
-
- ;; try to classify the type based on the value type and use that type when
- ;; encoding
- (when (eq basic-type 'anyType)
- (cond ((stringp value)
- (setq xsi-type "xsd:string" basic-type 'string))
- ((integerp value)
- (setq xsi-type "xsd:int" basic-type 'int))
- ((memq value '(t nil))
- (setq xsi-type "xsd:boolean" basic-type 'boolean))
- (t
- (error
- "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value"
- xml-tag value xsi-type))))
+ (funcall encoder value type))
+ (when (soap-element-namespace-tag type)
+ (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type))))
- (insert "<" xml-tag " xsi:type=\"" xsi-type "\"")
-
- ;; We have some ambiguity here, as a nil value represents "false" when the
- ;; type is boolean, we will never have a "nil" boolean type...
-
- (if (or value (eq basic-type 'boolean))
- (progn
- (insert ">")
- (case basic-type
- ((string anyURI)
- (unless (stringp value)
- (error "Soap-encode-basic-type(%s, %s, %s): not a string value"
- xml-tag value xsi-type))
- (insert (url-insert-entities-in-string value)))
-
- (dateTime
- (cond ((and (consp value) ; is there a time-value-p ?
- (>= (length value) 2)
- (numberp (nth 0 value))
- (numberp (nth 1 value)))
- ;; Value is a (current-time) style value, convert
- ;; to a string
- (insert (format-time-string "%Y-%m-%dT%H:%M:%S" value)))
- ((stringp value)
- (insert (url-insert-entities-in-string value)))
- (t
- (error
- "Soap-encode-basic-type(%s, %s, %s): not a dateTime value"
- xml-tag value xsi-type))))
-
- (boolean
- (unless (memq value '(t nil))
- (error "Soap-encode-basic-type(%s, %s, %s): not a boolean value"
- xml-tag value xsi-type))
- (insert (if value "true" "false")))
-
- ((long int integer byte unsignedInt)
- (unless (integerp value)
- (error "Soap-encode-basic-type(%s, %s, %s): not an integer value"
- xml-tag value xsi-type))
- (when (and (eq basic-type 'unsignedInt) (< value 0))
- (error "Soap-encode-basic-type(%s, %s, %s): not a positive integer"
- xml-tag value xsi-type))
- (insert (number-to-string value)))
-
- ((float double)
- (unless (numberp value)
- (error "Soap-encode-basic-type(%s, %s, %s): not a number"
- xml-tag value xsi-type))
- (insert (number-to-string value)))
-
- (base64Binary
- (unless (stringp value)
- (error "Soap-encode-basic-type(%s, %s, %s): not a string value"
- xml-tag value xsi-type))
- (insert (base64-encode-string value)))
-
- (otherwise
- (error
- "Soap-encode-basic-type(%s, %s, %s): don't know how to encode"
- xml-tag value xsi-type))))
-
- (insert " xsi:nil=\"true\">"))
- (insert "</" xml-tag ">\n")))
-
-(defun soap-encode-simple-type (xml-tag value type)
- "Encode inside XML-TAG the LISP VALUE according to TYPE."
-
- ;; Validate VALUE against the simple type's enumeration, than just encode it
- ;; using `soap-encode-basic-type'
-
- (let ((enumeration (soap-simple-type-enumeration type)))
- (unless (and (> (length enumeration) 1)
- (member value enumeration))
- (error "soap-encode-simple-type(%s, %s, %s): bad value, should be one of %s"
- xml-tag value (soap-element-fq-name type) enumeration)))
-
- (soap-encode-basic-type xml-tag value type))
-
-(defun soap-encode-sequence-type (xml-tag value type)
- "Encode inside XML-TAG the LISP VALUE according to TYPE.
-Do not call this function directly, use `soap-encode-value'
-instead."
- (let ((xsi-type (soap-element-fq-name type)))
- (insert "<" xml-tag " xsi:type=\"" xsi-type "\"")
- (if value
- (progn
- (insert ">\n")
- (let ((parents (list type))
- (parent (soap-sequence-type-parent type)))
-
- (while parent
- (push parent parents)
- (setq parent (soap-sequence-type-parent parent)))
-
- (dolist (type parents)
- (dolist (element (soap-sequence-type-elements type))
- (let ((instance-count 0)
- (e-name (soap-sequence-element-name element))
- (e-type (soap-sequence-element-type element)))
- (dolist (v value)
- (when (equal (car v) e-name)
- (incf instance-count)
- (soap-encode-value e-name (cdr v) e-type)))
-
- ;; Do some sanity checking
- (cond ((and (= instance-count 0)
- (not (soap-sequence-element-nillable? element)))
- (soap-warning
- "While encoding %s: missing non-nillable slot %s"
- (soap-element-name type) e-name))
- ((and (> instance-count 1)
- (not (soap-sequence-element-multiple? element)))
- (soap-warning
- "While encoding %s: multiple slots named %s"
- (soap-element-name type) e-name))))))))
- (insert " xsi:nil=\"true\">"))
- (insert "</" xml-tag ">\n")))
-
-(defun soap-encode-array-type (xml-tag value type)
- "Encode inside XML-TAG the LISP VALUE according to TYPE.
-Do not call this function directly, use `soap-encode-value'
-instead."
- (unless (vectorp value)
- (error "Soap-encode: %s(%s) expects a vector, got: %s"
- xml-tag (soap-element-fq-name type) value))
- (let* ((element-type (soap-array-type-element-type type))
- (array-type (concat (soap-element-fq-name element-type)
- "[" (format "%s" (length value)) "]")))
- (insert "<" xml-tag
- " soapenc:arrayType=\"" array-type "\" "
- " xsi:type=\"soapenc:Array\">\n")
- (loop for i below (length value)
- do (soap-encode-value xml-tag (aref value i) element-type))
- (insert "</" xml-tag ">\n")))
-
-(progn
- (put (aref (make-soap-basic-type) 0)
- 'soap-encoder 'soap-encode-basic-type)
- (put (aref (make-soap-simple-type) 0)
- 'soap-encoder 'soap-encode-simple-type)
- (put (aref (make-soap-sequence-type) 0)
- 'soap-encoder 'soap-encode-sequence-type)
- (put (aref (make-soap-array-type) 0)
- 'soap-encoder 'soap-encode-array-type))
-
-(defun soap-encode-body (operation parameters wsdl)
+(defun soap-encode-body (operation parameters &optional service-url)
"Create the body of a SOAP request for OPERATION in the current buffer.
PARAMETERS is a list of parameters supplied to the OPERATION.
The OPERATION and PARAMETERS are encoded according to the WSDL
-document."
+document. SERVICE-URL should be provided when WS-Addressing is
+being used."
(let* ((op (soap-bound-operation-operation operation))
(use (soap-bound-operation-use operation))
(message (cdr (soap-operation-input op)))
- (parameter-order (soap-operation-parameter-order op)))
+ (parameter-order (soap-operation-parameter-order op))
+ (param-table (loop for formal in parameter-order
+ for value in parameters
+ collect (cons formal value))))
(unless (= (length parameter-order) (length parameters))
(error "Wrong number of parameters for %s: expected %d, got %s"
@@ -1661,62 +2910,73 @@ document."
(length parameter-order)
(length parameters)))
+ (let ((headers (soap-bound-operation-soap-headers operation))
+ (input-action (soap-operation-input-action op)))
+ (when headers
+ (insert "<soap:Header>\n")
+ (when input-action
+ (add-to-list 'soap-encoded-namespaces "wsa")
+ (insert "<wsa:Action>" input-action "</wsa:Action>\n")
+ (insert "<wsa:To>" service-url "</wsa:To>\n"))
+ (dolist (h headers)
+ (let* ((message (nth 0 h))
+ (part (assq (nth 1 h) (soap-message-parts message)))
+ (value (cdr (assoc (car part) (car parameters))))
+ (use (nth 2 h))
+ (element (cdr part)))
+ (when (eq use 'encoded)
+ (when (soap-element-namespace-tag element)
+ (add-to-list 'soap-encoded-namespaces
+ (soap-element-namespace-tag element)))
+ (insert "<" (soap-element-fq-name element) ">\n"))
+ (soap-encode-value value element)
+ (when (eq use 'encoded)
+ (insert "</" (soap-element-fq-name element) ">\n"))))
+ (insert "</soap:Header>\n")))
+
(insert "<soap:Body>\n")
(when (eq use 'encoded)
- (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag op))
+ (when (soap-element-namespace-tag op)
+ (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag op)))
(insert "<" (soap-element-fq-name op) ">\n"))
- (let ((param-table (loop for formal in parameter-order
- for value in parameters
- collect (cons formal value))))
- (dolist (part (soap-message-parts message))
- (let* ((param-name (car part))
- (type (cdr part))
- (tag-name (if (eq use 'encoded)
- param-name
- (soap-element-name type)))
- (value (cdr (assoc param-name param-table)))
- (start-pos (point)))
- (soap-encode-value tag-name value type)
- (when (eq use 'literal)
- ;; hack: add the xmlns attribute to the tag, the only way
- ;; ASP.NET web services recognize the namespace of the
- ;; element itself...
- (save-excursion
- (goto-char start-pos)
- (when (re-search-forward " ")
- (let* ((ns (soap-element-namespace-tag type))
- (namespace (cdr (assoc ns
- (soap-wsdl-alias-table wsdl)))))
- (when namespace
- (insert "xmlns=\"" namespace "\" ")))))))))
+ (dolist (part (soap-message-parts message))
+ (let* ((param-name (car part))
+ (element (cdr part))
+ (value (cdr (assoc param-name param-table))))
+ (when (or (null (soap-bound-operation-soap-body operation))
+ (member param-name
+ (soap-bound-operation-soap-body operation)))
+ (soap-encode-value value element))))
(when (eq use 'encoded)
(insert "</" (soap-element-fq-name op) ">\n"))
(insert "</soap:Body>\n")))
-(defun soap-create-envelope (operation parameters wsdl)
+(defun soap-create-envelope (operation parameters wsdl &optional service-url)
"Create a SOAP request envelope for OPERATION using PARAMETERS.
-WSDL is the wsdl document used to encode the PARAMETERS."
+WSDL is the wsdl document used to encode the PARAMETERS.
+SERVICE-URL should be provided when WS-Addressing is being used."
(with-temp-buffer
(let ((soap-encoded-namespaces '("xsi" "soap" "soapenc"))
(use (soap-bound-operation-use operation)))
;; Create the request body
- (soap-encode-body operation parameters wsdl)
+ (soap-encode-body operation parameters service-url)
;; Put the envelope around the body
(goto-char (point-min))
(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<soap:Envelope\n")
(when (eq use 'encoded)
- (insert " soapenc:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\"\n"))
+ (insert " soapenc:encodingStyle=\"\
+http://schemas.xmlsoap.org/soap/encoding/\"\n"))
(dolist (nstag soap-encoded-namespaces)
(insert " xmlns:" nstag "=\"")
(let ((nsname (cdr (assoc nstag soap-well-known-xmlns))))
(unless nsname
(setq nsname (cdr (assoc nstag (soap-wsdl-alias-table wsdl)))))
(insert nsname)
- (insert "\"\n")))
+ (insert "\"\n")))
(insert ">\n")
(goto-char (point-max))
(insert "</soap:Envelope>\n"))
@@ -1730,6 +2990,86 @@ WSDL is the wsdl document used to encode the PARAMETERS."
:type 'boolean
:group 'soap-client)
+(defun soap-invoke-internal (callback cbargs wsdl service operation-name
+ &rest parameters)
+ "Implement `soap-invoke' and `soap-invoke-async'.
+If CALLBACK is non-nil, operate asynchronously, then call CALLBACK as (apply
+CALLBACK RESPONSE CBARGS), where RESPONSE is the SOAP invocation result.
+If CALLBACK is nil, operate synchronously. WSDL, SERVICE,
+OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
+ (let ((port (catch 'found
+ (dolist (p (soap-wsdl-ports wsdl))
+ (when (equal service (soap-element-name p))
+ (throw 'found p))))))
+ (unless port
+ (error "Unknown SOAP service: %s" service))
+
+ (let* ((binding (soap-port-binding port))
+ (operation (gethash operation-name
+ (soap-binding-operations binding))))
+ (unless operation
+ (error "No operation %s for SOAP service %s" operation-name service))
+
+ (let ((url-request-method "POST")
+ (url-package-name "soap-client.el")
+ (url-package-version "1.0")
+ (url-request-data
+ ;; url-request-data expects a unibyte string already encoded...
+ (encode-coding-string
+ (soap-create-envelope operation parameters wsdl
+ (soap-port-service-url port))
+ 'utf-8))
+ (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
+ (url-http-attempt-keepalives t)
+ (url-request-extra-headers
+ (list
+ (cons "SOAPAction"
+ (concat "\"" (soap-bound-operation-soap-action
+ operation) "\""))
+ (cons "Content-Type"
+ "text/xml; charset=utf-8"))))
+ (if callback
+ (url-retrieve
+ (soap-port-service-url port)
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (let ((error-status (plist-get status :error)))
+ (if error-status
+ (signal (car error-status) (cdr error-status))
+ (apply callback
+ (soap-parse-envelope
+ (soap-parse-server-response)
+ operation wsdl)
+ cbargs)))
+ ;; Ensure the url-retrieve buffer is not leaked.
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer))))))
+ (let ((buffer (url-retrieve-synchronously
+ (soap-port-service-url port))))
+ (condition-case err
+ (with-current-buffer buffer
+ (declare (special url-http-response-status))
+ (if (null url-http-response-status)
+ (error "No HTTP response from server"))
+ (if (and soap-debug (> url-http-response-status 299))
+ ;; This is a warning because some SOAP errors come
+ ;; back with a HTTP response 500 (internal server
+ ;; error)
+ (warn "Error in SOAP response: HTTP code %s"
+ url-http-response-status))
+ (soap-parse-envelope (soap-parse-server-response)
+ operation wsdl))
+ (soap-error
+ ;; Propagate soap-errors -- they are error replies of the
+ ;; SOAP protocol and don't indicate a communication
+ ;; problem or a bug in this code.
+ (signal (car err) (cdr err)))
+ (error
+ (when soap-debug
+ (pop-to-buffer buffer))
+ (error (error-message-string err))))))))))
+
(defun soap-invoke (wsdl service operation-name &rest parameters)
"Invoke a SOAP operation and return the result.
@@ -1748,79 +3088,25 @@ NOTE: The SOAP service provider should document the available
operations and their parameters for the service. You can also
use the `soap-inspect' function to browse the available
operations in a WSDL document."
- (let ((port (catch 'found
- (dolist (p (soap-wsdl-ports wsdl))
- (when (equal service (soap-element-name p))
- (throw 'found p))))))
- (unless port
- (error "Unknown SOAP service: %s" service))
-
- (let* ((binding (soap-port-binding port))
- (operation (gethash operation-name
- (soap-binding-operations binding))))
- (unless operation
- (error "No operation %s for SOAP service %s" operation-name service))
-
- (let ((url-request-method "POST")
- (url-package-name "soap-client.el")
- (url-package-version "1.0")
- (url-http-version "1.0")
- (url-request-data
- ;; url-request-data expects a unibyte string already encoded...
- (encode-coding-string
- (soap-create-envelope operation parameters wsdl)
- 'utf-8))
- (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
- (url-request-coding-system 'utf-8)
- (url-http-attempt-keepalives t)
- (url-request-extra-headers (list
- (cons "SOAPAction"
- (soap-bound-operation-soap-action
- operation))
- (cons "Content-Type"
- "text/xml; charset=utf-8"))))
- (let ((buffer (url-retrieve-synchronously
- (soap-port-service-url port))))
- (condition-case err
- (with-current-buffer buffer
- (declare (special url-http-response-status))
- (if (null url-http-response-status)
- (error "No HTTP response from server"))
- (if (and soap-debug (> url-http-response-status 299))
- ;; This is a warning because some SOAP errors come
- ;; back with a HTTP response 500 (internal server
- ;; error)
- (warn "Error in SOAP response: HTTP code %s"
- url-http-response-status))
- (let ((mime-part (mm-dissect-buffer t t)))
- (unless mime-part
- (error "Failed to decode response from server"))
- (unless (equal (car (mm-handle-type mime-part)) "text/xml")
- (error "Server response is not an XML document"))
- (with-temp-buffer
- (mm-insert-part mime-part)
- (let ((response (car (xml-parse-region
- (point-min) (point-max)))))
- (prog1
- (soap-parse-envelope response operation wsdl)
- (kill-buffer buffer)
- (mm-destroy-part mime-part))))))
- (soap-error
- ;; Propagate soap-errors -- they are error replies of the
- ;; SOAP protocol and don't indicate a communication
- ;; problem or a bug in this code.
- (signal (car err) (cdr err)))
- (error
- (when soap-debug
- (pop-to-buffer buffer))
- (error (error-message-string err)))))))))
+ (apply #'soap-invoke-internal nil nil wsdl service operation-name parameters))
+
+(defun soap-invoke-async (callback cbargs wsdl service operation-name
+ &rest parameters)
+ "Like `soap-invoke', but call CALLBACK asynchronously with response.
+CALLBACK is called as (apply CALLBACK RESPONSE CBARGS), where
+RESPONSE is the SOAP invocation result. WSDL, SERVICE,
+OPERATION-NAME and PARAMETERS are as described in `soap-invoke'."
+ (unless callback
+ (error "Callback argument is nil"))
+ (apply #'soap-invoke-internal callback cbargs wsdl service operation-name
+ parameters))
(provide 'soap-client)
-;;; Local Variables:
-;;; eval: (outline-minor-mode 1)
-;;; outline-regexp: ";;;;+"
-;;; End:
+;; Local Variables:
+;; eval: (outline-minor-mode 1)
+;; outline-regexp: ";;;;+"
+;; End:
;;; soap-client.el ends here
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 874a68588c7..f6c7da6c7cd 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -1,12 +1,13 @@
-;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures
+;;;; soap-inspect.el -- Interactive WSDL inspector -*- lexical-binding: t -*-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Alexandru Harsanyi <AlexHarsanyi@gmail.com>
;; Created: October 2010
+;; Version: 3.0.1
;; Keywords: soap, web-services, comm, hypermedia
;; Package: soap-client
-;; Homepage: http://code.google.com/p/emacs-soap-client
+;; Homepage: https://github.com/alex-hhh/emacs-soap-client
;; This file is part of GNU Emacs.
@@ -55,86 +56,153 @@ will be called."
(funcall sample-value type)
(error "Cannot provide sample value for type %s" (aref type 0)))))
-(defun soap-sample-value-for-basic-type (type)
- "Provide a sample value for TYPE which is a basic type.
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (case (soap-basic-type-kind type)
- (string "a string value")
- (boolean t) ; could be nil as well
- ((long int) (random 4200))
- ;; TODO: we need better sample values for more types.
- (t (format "%s" (soap-basic-type-kind type)))))
-
-(defun soap-sample-value-for-simple-type (type)
- "Provide a sample value for TYPE which is a simple type.
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (let ((enumeration (soap-simple-type-enumeration type)))
- (if (> (length enumeration) 1)
- (elt enumeration (random (length enumeration)))
- (soap-sample-value-for-basic-type type))))
-
-(defun soap-sample-value-for-seqence-type (type)
- "Provide a sample value for TYPE which is a sequence type.
-Values for sequence types are ALISTS of (slot-name . VALUE) for
-each sequence element.
-
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (let ((sample-value nil))
- (dolist (element (soap-sequence-type-elements type))
- (push (cons (soap-sequence-element-name element)
- (soap-sample-value (soap-sequence-element-type element)))
- sample-value))
- (when (soap-sequence-type-parent type)
- (setq sample-value
- (append (soap-sample-value (soap-sequence-type-parent type))
- sample-value)))
- sample-value))
-
-(defun soap-sample-value-for-array-type (type)
- "Provide a sample value for TYPE which is an array type.
-Values for array types are LISP vectors of values which are
-array's element type.
-
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
- (let* ((element-type (soap-array-type-element-type type))
- (sample1 (soap-sample-value element-type))
- (sample2 (soap-sample-value element-type)))
- ;; Our sample value is a vector of two elements, but any number of
- ;; elements are permissible
- (vector sample1 sample2 '&etc)))
+(defun soap-sample-value-for-xs-basic-type (type)
+ "Provide a sample value for TYPE, an xs-basic-type.
+This is a specialization of `soap-sample-value' for xs-basic-type
+objects."
+ (case (soap-xs-basic-type-kind type)
+ (string "a string")
+ (anyURI "an URI")
+ (QName "a QName")
+ (dateTime "a time-value-p or string")
+ (boolean "t or nil")
+ ((long int integer byte unsignedInt) 42)
+ ((float double) 3.14)
+ (base64Binary "a string")
+ (t (format "%s" (soap-xs-basic-type-kind type)))))
+
+(defun soap-sample-value-for-xs-element (element)
+ "Provide a sample value for ELEMENT, a WSDL element.
+This is a specialization of `soap-sample-value' for xs-element
+objects."
+ (if (soap-xs-element-name element)
+ (cons (intern (soap-xs-element-name element))
+ (soap-sample-value (soap-xs-element-type element)))
+ (soap-sample-value (soap-xs-element-type element))))
+
+(defun soap-sample-value-for-xs-attribute (attribute)
+ "Provide a sample value for ATTRIBUTE, a WSDL attribute.
+This is a specialization of `soap-sample-value' for
+soap-xs-attribute objects."
+ (if (soap-xs-attribute-name attribute)
+ (cons (intern (soap-xs-attribute-name attribute))
+ (soap-sample-value (soap-xs-attribute-type attribute)))
+ (soap-sample-value (soap-xs-attribute-type attribute))))
+
+(defun soap-sample-value-for-xs-attribute-group (attribute-group)
+ "Provide a sample value for ATTRIBUTE-GROUP, a WSDL attribute group.
+This is a specialization of `soap-sample-value' for
+soap-xs-attribute objects."
+ (let ((sample-values nil))
+ (dolist (attribute (soap-xs-attribute-group-attributes attribute-group))
+ (if (soap-xs-attribute-name attribute)
+ (setq sample-values
+ (append sample-values
+ (cons (intern (soap-xs-attribute-name attribute))
+ (soap-sample-value (soap-xs-attribute-type
+ attribute)))))
+ (setq sample-values
+ (append sample-values
+ (soap-sample-value
+ (soap-xs-attribute-type attribute))))))))
+
+(defun soap-sample-value-for-xs-simple-type (type)
+ "Provide a sample value for TYPE, a `soap-xs-simple-type'.
+This is a specialization of `soap-sample-value' for
+`soap-xs-simple-type' objects."
+ (append
+ (mapcar 'soap-sample-value-for-xs-attribute
+ (soap-xs-type-attributes type))
+ (cond
+ ((soap-xs-simple-type-enumeration type)
+ (let ((enumeration (soap-xs-simple-type-enumeration type)))
+ (nth (random (length enumeration)) enumeration)))
+ ((soap-xs-simple-type-pattern type)
+ (format "a string matching %s" (soap-xs-simple-type-pattern type)))
+ ((soap-xs-simple-type-length-range type)
+ (destructuring-bind (low . high) (soap-xs-simple-type-length-range type)
+ (cond
+ ((and low high)
+ (format "a string between %d and %d chars long" low high))
+ (low (format "a string at least %d chars long" low))
+ (high (format "a string at most %d chars long" high))
+ (t (format "a string OOPS")))))
+ ((soap-xs-simple-type-integer-range type)
+ (destructuring-bind (min . max) (soap-xs-simple-type-integer-range type)
+ (cond
+ ((and min max) (+ min (random (- max min))))
+ (min (+ min (random 10)))
+ (max (random max))
+ (t (random 100)))))
+ ((consp (soap-xs-simple-type-base type)) ; an union of values
+ (let ((base (soap-xs-simple-type-base type)))
+ (soap-sample-value (nth (random (length base)) base))))
+ ((soap-xs-basic-type-p (soap-xs-simple-type-base type))
+ (soap-sample-value (soap-xs-simple-type-base type))))))
+
+(defun soap-sample-value-for-xs-complex-type (type)
+ "Provide a sample value for TYPE, a `soap-xs-complex-type'.
+This is a specialization of `soap-sample-value' for
+`soap-xs-complex-type' objects."
+ (append
+ (mapcar 'soap-sample-value-for-xs-attribute
+ (soap-xs-type-attributes type))
+ (case (soap-xs-complex-type-indicator type)
+ (array
+ (let* ((element-type (soap-xs-complex-type-base type))
+ (sample1 (soap-sample-value element-type))
+ (sample2 (soap-sample-value element-type)))
+ ;; Our sample value is a vector of two elements, but any number of
+ ;; elements are permissible
+ (vector sample1 sample2 '&etc)))
+ ((sequence choice all)
+ (let ((base (soap-xs-complex-type-base type)))
+ (let ((value (append (and base (soap-sample-value base))
+ (mapcar #'soap-sample-value
+ (soap-xs-complex-type-elements type)))))
+ (if (eq (soap-xs-complex-type-indicator type) 'choice)
+ (cons '***choice-of*** value)
+ value)))))))
(defun soap-sample-value-for-message (message)
"Provide a sample value for a WSDL MESSAGE.
-This is a specific function which should not be called directly,
-use `soap-sample-value' instead."
+This is a specialization of `soap-sample-value' for
+`soap-message' objects."
;; NOTE: parameter order is not considered.
(let (sample-value)
(dolist (part (soap-message-parts message))
- (push (cons (car part)
- (soap-sample-value (cdr part)))
- sample-value))
+ (push (soap-sample-value (cdr part)) sample-value))
(nreverse sample-value)))
(progn
;; Install soap-sample-value methods for our types
- (put (aref (make-soap-basic-type) 0) 'soap-sample-value
- 'soap-sample-value-for-basic-type)
+ (put (aref (make-soap-xs-basic-type) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-basic-type)
- (put (aref (make-soap-simple-type) 0) 'soap-sample-value
- 'soap-sample-value-for-simple-type)
+ (put (aref (make-soap-xs-element) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-element)
- (put (aref (make-soap-sequence-type) 0) 'soap-sample-value
- 'soap-sample-value-for-seqence-type)
+ (put (aref (make-soap-xs-attribute) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-attribute)
- (put (aref (make-soap-array-type) 0) 'soap-sample-value
- 'soap-sample-value-for-array-type)
+ (put (aref (make-soap-xs-attribute) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-attribute-group)
- (put (aref (make-soap-message) 0) 'soap-sample-value
- 'soap-sample-value-for-message) )
+ (put (aref (make-soap-xs-simple-type) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-simple-type)
+
+ (put (aref (make-soap-xs-complex-type) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-xs-complex-type)
+
+ (put (aref (make-soap-message) 0)
+ 'soap-sample-value
+ 'soap-sample-value-for-message))
@@ -184,7 +252,7 @@ entire WSDL can be inspected."
(define-button-type 'soap-client-describe-link
- 'face 'italic
+ 'face 'link
'help-echo "mouse-2, RET: describe item"
'follow-link t
'action (lambda (button)
@@ -193,10 +261,10 @@ entire WSDL can be inspected."
'skip t)
(define-button-type 'soap-client-describe-back-link
- 'face 'italic
+ 'face 'link
'help-echo "mouse-2, RET: browse the previous item"
'follow-link t
- 'action (lambda (button)
+ 'action (lambda (_button)
(let ((item (pop soap-inspect-previous-items)))
(when item
(setq soap-inspect-current-item nil)
@@ -210,52 +278,142 @@ entire WSDL can be inspected."
'type 'soap-client-describe-link
'item element))
-(defun soap-inspect-basic-type (basic-type)
- "Insert information about BASIC-TYPE into the current buffer."
- (insert "Basic type: " (soap-element-fq-name basic-type))
- (insert "\nSample value\n")
- (pp (soap-sample-value basic-type) (current-buffer)))
-
-(defun soap-inspect-simple-type (simple-type)
- "Insert information about SIMPLE-TYPE into the current buffer"
- (insert "Simple type: " (soap-element-fq-name simple-type) "\n")
- (insert "Base: " (symbol-name (soap-basic-type-kind simple-type)) "\n")
- (let ((enumeration (soap-simple-type-enumeration simple-type)))
- (when (> (length enumeration) 1)
- (insert "Valid values: ")
- (dolist (e enumeration)
- (insert "\"" e "\" ")))))
-
-(defun soap-inspect-sequence-type (sequence)
- "Insert information about SEQUENCE into the current buffer."
- (insert "Sequence type: " (soap-element-fq-name sequence) "\n")
- (when (soap-sequence-type-parent sequence)
- (insert "Parent: ")
- (soap-insert-describe-button
- (soap-sequence-type-parent sequence))
- (insert "\n"))
- (insert "Elements: \n")
- (dolist (element (soap-sequence-type-elements sequence))
- (insert "\t" (symbol-name (soap-sequence-element-name element))
- "\t")
- (soap-insert-describe-button
- (soap-sequence-element-type element))
- (when (soap-sequence-element-multiple? element)
- (insert " multiple"))
- (when (soap-sequence-element-nillable? element)
- (insert " optional"))
- (insert "\n"))
- (insert "Sample value:\n")
- (pp (soap-sample-value sequence) (current-buffer)))
-
-(defun soap-inspect-array-type (array)
- "Insert information about the ARRAY into the current buffer."
- (insert "Array name: " (soap-element-fq-name array) "\n")
- (insert "Element type: ")
- (soap-insert-describe-button
- (soap-array-type-element-type array))
+(defun soap-inspect-xs-basic-type (type)
+ "Insert information about TYPE, a soap-xs-basic-type, in the current buffer."
+ (insert "Basic type: " (soap-element-fq-name type))
+ (insert "\nSample value:\n")
+ (pp (soap-sample-value type) (current-buffer)))
+
+(defun soap-inspect-xs-element (element)
+ "Insert information about ELEMENT, a soap-xs-element, in the current buffer."
+ (insert "Element: " (soap-element-fq-name element))
+ (insert "\nType: ")
+ (soap-insert-describe-button (soap-xs-element-type element))
+ (insert "\nAttributes:")
+ (when (soap-xs-element-optional? element)
+ (insert " optional"))
+ (when (soap-xs-element-multiple? element)
+ (insert " multiple"))
+ (insert "\nSample value:\n")
+ (pp (soap-sample-value element) (current-buffer)))
+
+(defun soap-inspect-xs-attribute (attribute)
+ "Insert information about ATTRIBUTE, a soap-xs-attribute, in
+the current buffer."
+ (insert "Attribute: " (soap-element-fq-name attribute))
+ (insert "\nType: ")
+ (soap-insert-describe-button (soap-xs-attribute-type attribute))
(insert "\nSample value:\n")
- (pp (soap-sample-value array) (current-buffer)))
+ (pp (soap-sample-value attribute) (current-buffer)))
+
+(defun soap-inspect-xs-attribute-group (attribute-group)
+ "Insert information about ATTRIBUTE-GROUP, a
+soap-xs-attribute-group, in the current buffer."
+ (insert "Attribute group: " (soap-element-fq-name attribute-group))
+ (insert "\nSample values:\n")
+ (pp (soap-sample-value attribute-group) (current-buffer)))
+
+(defun soap-inspect-xs-simple-type (type)
+ "Insert information about TYPE, a soap-xs-simple-type, in the current buffer."
+ (insert "Simple type: " (soap-element-fq-name type))
+ (insert "\nBase: " )
+ (if (listp (soap-xs-simple-type-base type))
+ (let ((first-time t))
+ (dolist (b (soap-xs-simple-type-base type))
+ (unless first-time
+ (insert ", ")
+ (setq first-time nil))
+ (soap-insert-describe-button b)))
+ (soap-insert-describe-button (soap-xs-simple-type-base type)))
+ (insert "\nAttributes: ")
+ (dolist (attribute (soap-xs-simple-type-attributes type))
+ (let ((name (or (soap-xs-attribute-name attribute) "*inline*"))
+ (type (soap-xs-attribute-type attribute)))
+ (insert "\n\t")
+ (insert name)
+ (insert "\t")
+ (soap-insert-describe-button type)))
+ (when (soap-xs-simple-type-enumeration type)
+ (insert "\nEnumeraton values: ")
+ (dolist (e (soap-xs-simple-type-enumeration type))
+ (insert "\n\t")
+ (pp e)))
+ (when (soap-xs-simple-type-pattern type)
+ (insert "\nPattern: " (soap-xs-simple-type-pattern type)))
+ (when (car (soap-xs-simple-type-length-range type))
+ (insert "\nMin length: "
+ (number-to-string (car (soap-xs-simple-type-length-range type)))))
+ (when (cdr (soap-xs-simple-type-length-range type))
+ (insert "\nMin length: "
+ (number-to-string (cdr (soap-xs-simple-type-length-range type)))))
+ (when (car (soap-xs-simple-type-integer-range type))
+ (insert "\nMin value: "
+ (number-to-string (car (soap-xs-simple-type-integer-range type)))))
+ (when (cdr (soap-xs-simple-type-integer-range type))
+ (insert "\nMin value: "
+ (number-to-string (cdr (soap-xs-simple-type-integer-range type)))))
+ (insert "\nSample value:\n")
+ (pp (soap-sample-value type) (current-buffer)))
+
+(defun soap-inspect-xs-complex-type (type)
+ "Insert information about TYPE in the current buffer.
+TYPE is a `soap-xs-complex-type'"
+ (insert "Complex type: " (soap-element-fq-name type))
+ (insert "\nKind: ")
+ (case (soap-xs-complex-type-indicator type)
+ ((sequence all)
+ (insert "a sequence ")
+ (when (soap-xs-complex-type-base type)
+ (insert "extending ")
+ (soap-insert-describe-button (soap-xs-complex-type-base type)))
+ (insert "\nAttributes: ")
+ (dolist (attribute (soap-xs-complex-type-attributes type))
+ (let ((name (or (soap-xs-attribute-name attribute) "*inline*"))
+ (type (soap-xs-attribute-type attribute)))
+ (insert "\n\t")
+ (insert name)
+ (insert "\t")
+ (soap-insert-describe-button type)))
+ (insert "\nElements: ")
+ (let ((name-width 0)
+ (type-width 0))
+ (dolist (element (soap-xs-complex-type-elements type))
+ (let ((name (or (soap-xs-element-name element) "*inline*"))
+ (type (soap-xs-element-type element)))
+ (setq name-width (max name-width (length name)))
+ (setq type-width
+ (max type-width (length (soap-element-fq-name type))))))
+ (setq name-width (+ name-width 2))
+ (setq type-width (+ type-width 2))
+ (dolist (element (soap-xs-complex-type-elements type))
+ (let ((name (or (soap-xs-element-name element) "*inline*"))
+ (type (soap-xs-element-type element)))
+ (insert "\n\t")
+ (insert name)
+ (insert (make-string (- name-width (length name)) ?\ ))
+ (soap-insert-describe-button type)
+ (insert
+ (make-string
+ (- type-width (length (soap-element-fq-name type))) ?\ ))
+ (when (soap-xs-element-multiple? element)
+ (insert " multiple"))
+ (when (soap-xs-element-optional? element)
+ (insert " optional"))))))
+ (choice
+ (insert "a choice ")
+ (when (soap-xs-complex-type-base type)
+ (insert "extending ")
+ (soap-insert-describe-button (soap-xs-complex-type-base type)))
+ (insert "\nElements: ")
+ (dolist (element (soap-xs-complex-type-elements type))
+ (insert "\n\t")
+ (soap-insert-describe-button element)))
+ (array
+ (insert "an array of ")
+ (soap-insert-describe-button (soap-xs-complex-type-base type))))
+ (insert "\nSample value:\n")
+ (pp (soap-sample-value type) (current-buffer)))
+
(defun soap-inspect-message (message)
"Insert information about MESSAGE into the current buffer."
@@ -281,10 +439,11 @@ entire WSDL can be inspected."
(insert "\n\nSample invocation:\n")
(let ((sample-message-value
- (soap-sample-value (cdr (soap-operation-input operation))))
- (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation))))
+ (soap-sample-value (cdr (soap-operation-input operation))))
+ (funcall (list 'soap-invoke '*WSDL* "SomeService"
+ (soap-element-name operation))))
(let ((sample-invocation
- (append funcall (mapcar 'cdr sample-message-value))))
+ (append funcall (mapcar 'cdr sample-message-value))))
(pp sample-invocation (current-buffer)))))
(defun soap-inspect-port-type (port-type)
@@ -350,17 +509,23 @@ entire WSDL can be inspected."
(progn
;; Install the soap-inspect methods for our types
- (put (aref (make-soap-basic-type) 0) 'soap-inspect
- 'soap-inspect-basic-type)
+ (put (aref (make-soap-xs-basic-type) 0) 'soap-inspect
+ 'soap-inspect-xs-basic-type)
+
+ (put (aref (make-soap-xs-element) 0) 'soap-inspect
+ 'soap-inspect-xs-element)
+
+ (put (aref (make-soap-xs-simple-type) 0) 'soap-inspect
+ 'soap-inspect-xs-simple-type)
- (put (aref (make-soap-simple-type) 0) 'soap-inspect
- 'soap-inspect-simple-type)
+ (put (aref (make-soap-xs-complex-type) 0) 'soap-inspect
+ 'soap-inspect-xs-complex-type)
- (put (aref (make-soap-sequence-type) 0) 'soap-inspect
- 'soap-inspect-sequence-type)
+ (put (aref (make-soap-xs-attribute) 0) 'soap-inspect
+ 'soap-inspect-xs-attribute)
- (put (aref (make-soap-array-type) 0) 'soap-inspect
- 'soap-inspect-array-type)
+ (put (aref (make-soap-xs-attribute-group) 0) 'soap-inspect
+ 'soap-inspect-xs-attribute-group)
(put (aref (make-soap-message) 0) 'soap-inspect
'soap-inspect-message)
@@ -376,7 +541,7 @@ entire WSDL can be inspected."
(put (aref (make-soap-port) 0) 'soap-inspect
'soap-inspect-port)
- (put (aref (make-soap-wsdl) 0) 'soap-inspect
+ (put (aref (soap-make-wsdl "origin") 0) 'soap-inspect
'soap-inspect-wsdl))
(provide 'soap-inspect)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index d6173e01ecd..db9579573f6 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -1,6 +1,6 @@
;;; socks.el --- A Socks v5 Client for Emacs
-;; Copyright (C) 1996-2000, 2002, 2007-2013 Free Software Foundation,
+;; Copyright (C) 1996-2000, 2002, 2007-2015 Free Software Foundation,
;; Inc.
;; Author: William M. Perry <wmperry@gnu.org>
@@ -102,7 +102,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
;;; Customization support
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup socks nil
- "SOCKS Support"
+ "SOCKS support."
:version "22.2"
:prefix "socks-"
:group 'processes)
@@ -347,7 +347,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
;; could get a wrapper hook, or defer to open-network-stream-function.
(defvar socks-override-functions nil
- "Whether to overwrite the open-network-stream function with the SOCKSified
+ "Whether to overwrite the `open-network-stream' function with the SOCKSified
version.")
(require 'network-stream)
@@ -533,7 +533,7 @@ version.")
socks-tcp-services))))))
(defun socks-find-services-entry (service &optional udp)
- "Return the port # associated with SERVICE"
+ "Return the port # associated with SERVICE."
(if (= (hash-table-count socks-tcp-services) 0)
(socks-parse-services))
(gethash (downcase service)
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index e3c42f59315..6d9f408d5ca 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -1,10 +1,10 @@
;;; telnet.el --- run a telnet session from within an Emacs buffer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2013 Free Software
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: William F. Schelter
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, comm
;; This file is part of GNU Emacs.
@@ -237,7 +237,7 @@ Normally input is edited in Emacs and sent a line at a time."
(define-derived-mode telnet-mode comint-mode "Telnet"
"This mode is for using telnet (or rsh) from a buffer to another host.
It has most of the same commands as comint-mode.
-There is a variable ``telnet-interrupt-string'' which is the character
+There is a variable `telnet-interrupt-string' which is the character
sent to try to stop execution of a job on the remote host.
Data is sent to the remote host when RET is typed."
(set (make-local-variable 'window-point-insertion-type) t)
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 3d8d8decf47..48e6a42186c 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -1,6 +1,6 @@
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-;; Copyright (C) 1996-1999, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2002-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: comm, tls, gnutls, ssl
@@ -80,8 +80,7 @@ and `gnutls-cli' (version 2.0.1) output."
"List of strings containing commands to start TLS stream to a host.
Each entry in the list is tried until a connection is successful.
%h is replaced with server hostname, %p with port to connect to.
-The program should read input on stdin and write output to
-stdout.
+The program should read input on stdin and write output to stdout.
See `tls-checktrust' on how to check trusted root certs.
@@ -138,7 +137,7 @@ the external program knows about the root certificates you
consider trustworthy, e.g.:
\(setq tls-program
- '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
+ \\='(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"
\"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof\"))"
:type '(choice (const :tag "Always" t)
@@ -168,13 +167,18 @@ this to nil if you want to ignore host name mismatches."
:version "23.1" ;; No Gnus
:group 'tls)
-(defcustom tls-certtool-program (executable-find "certtool")
- "Name of GnuTLS certtool.
+(defcustom tls-certtool-program "certtool"
+ "Name of GnuTLS certtool.
Used by `tls-certificate-information'."
:version "22.1"
:type 'string
:group 'tls)
+(defalias 'tls-format-message
+ (if (fboundp 'format-message) 'format-message
+ ;; for Emacs < 25, and XEmacs, don't worry about quote translation.
+ 'format))
+
(defun tls-certificate-information (der)
"Parse X.509 certificate in DER format into an assoc list."
(let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
@@ -276,8 +280,8 @@ Fourth arg PORT is an integer specifying a port to connect to."
(message "The certificate presented by `%s' is \
NOT trusted." host))
(not (yes-or-no-p
- (format "The certificate presented by `%s' is \
-NOT trusted. Accept anyway? " host)))))
+ (tls-format-message "\
+The certificate presented by `%s' is NOT trusted. Accept anyway? " host)))))
(and tls-hostmismatch
(save-excursion
(goto-char (point-min))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 8ddbe254380..88dea6a7e35 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1,8 +1,8 @@
;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
-;; Author: Juergen Hoetzel <juergen@archlinux.org>
+;; Author: Jürgen Hötzel <juergen@archlinux.org>
;; Keywords: comm, processes
;; Package: tramp
@@ -34,12 +34,12 @@
;;; Code:
(require 'tramp)
-(require 'time-date)
;; Pacify byte-compiler.
+(defvar directory-listing-before-filename-regexp)
(defvar directory-sep-char)
-(defvar dired-move-to-filename-regexp)
+;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
:group 'tramp
@@ -47,11 +47,20 @@
:type 'string)
;;;###tramp-autoload
+(defcustom tramp-adb-connect-if-not-connected nil
+ "Try to run `adb connect' if provided device is not connected currently.
+It is used for TCP/IP devices."
+ :group 'tramp
+ :version "25.1"
+ :type 'boolean)
+
+;;;###tramp-autoload
(defconst tramp-adb-method "adb"
"*When this method name is used, forward all calls to Android Debug Bridge.")
+;;;###tramp-autoload
(defcustom tramp-adb-prompt
- "^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]]*@[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
+ "^\\(?:[[:digit:]]*|?\\)?\\(?:[[:alnum:]\e;[]*@[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'string
:version "24.4"
@@ -67,12 +76,13 @@
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
"[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date
- "[[:space:]]+\\(.*\\)$")) ; \6 filename
+ "[[:space:]]\\(.*\\)$")) ; \6 filename
;;;###tramp-autoload
(add-to-list 'tramp-methods
`(,tramp-adb-method
- (tramp-tmpdir "/data/local/tmp")))
+ (tramp-tmpdir "/data/local/tmp")
+ (tramp-default-port 5555)))
;;;###tramp-autoload
(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil ""))
@@ -123,6 +133,7 @@
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
@@ -134,13 +145,13 @@
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-adb-handle-insert-directory)
+ (insert-directory . tramp-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
- (make-symbolic-link . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
(set-file-acl . ignore)
@@ -184,13 +195,27 @@ pass to the OPERATION."
;; That's why we use `start-process'.
(let ((p (start-process
tramp-adb-program (current-buffer) tramp-adb-program "devices"))
+ (v (vector tramp-adb-method tramp-current-user
+ tramp-current-host nil nil))
result)
+ (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " "))
(tramp-compat-set-process-query-on-exit-flag p nil)
(while (eq 'run (process-status p))
- (sleep-for 0.1))
+ (accept-process-output p 0.1))
+ (accept-process-output p 0.1)
+ (tramp-message v 6 "\n%s" (buffer-string))
(goto-char (point-min))
(while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t)
(add-to-list 'result (list nil (match-string 1))))
+
+ ;; Replace ":" by "#".
+ (mapc
+ (lambda (elt)
+ (setcar
+ (cdr elt)
+ (tramp-compat-replace-regexp-in-string
+ ":" tramp-prefix-port-format (car (cdr elt)))))
+ result)
result))))
(defun tramp-adb-handle-expand-file-name (name &optional dir)
@@ -228,83 +253,90 @@ pass to the OPERATION."
;; code could be shared?
(defun tramp-adb-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property v localname "file-truename"
- (let ((result nil)) ; result steps in reverse order
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let* ((directory-sep-char ?/)
- (steps (tramp-compat-split-string localname "/"))
- (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"
- (mapconcat 'identity
- (append '("") (reverse result) (list thisstep))
- "/"))
- (setq symlink-target
- (nth 0 (file-attributes
- (tramp-make-tramp-file-name
- method user host
- (mapconcat 'identity
- (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 (tramp-compat-split-string
- symlink-target "/")
- 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
- (mapconcat 'identity (cons "" result) "/")
- "/"))
- (when (and is-dir (or (string= "" result)
- (not (string= (substring result -1) "/"))))
- (setq result (concat result "/"))))
-
- (tramp-message v 4 "True name of `%s' is `%s'" filename result)
- (tramp-make-tramp-file-name method user host result)))))
+ (format
+ "%s%s"
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-make-tramp-file-name
+ method user host
+ (with-tramp-file-property v localname "file-truename"
+ (let ((result nil)) ; result steps in reverse order
+ (tramp-message v 4 "Finding true name for `%s'" filename)
+ (let* ((directory-sep-char ?/)
+ (steps (tramp-compat-split-string localname "/"))
+ (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"
+ (mapconcat 'identity
+ (append '("") (reverse result) (list thisstep))
+ "/"))
+ (setq symlink-target
+ (nth 0 (file-attributes
+ (tramp-make-tramp-file-name
+ method user host
+ (mapconcat 'identity
+ (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 (tramp-compat-split-string
+ symlink-target "/")
+ 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
+ (mapconcat 'identity (cons "" result) "/")
+ "/"))
+ (when (and is-dir (or (string= "" result)
+ (not (string= (substring result -1) "/"))))
+ (setq result (concat result "/"))))
+
+ (tramp-message v 4 "True name of `%s' is `%s'" localname result)
+ result))))
+
+ ;; Preserve trailing "/".
+ (if (string-equal (file-name-nondirectory filename) "") "/" "")))
(defun tramp-adb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -313,13 +345,14 @@ pass to the OPERATION."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property
v localname (format "file-attributes-%s" id-format)
- (tramp-adb-barf-unless-okay
- v (format "%s -d -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)) "")
- (with-current-buffer (tramp-get-buffer v)
- (tramp-adb-sh-fix-ls-output)
- (cdar (tramp-do-parse-file-attributes-with-ls v id-format)))))))
+ (and
+ (tramp-adb-send-command-and-check
+ v (format "%s -d -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-buffer v)
+ (tramp-adb-sh-fix-ls-output)
+ (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))))
(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format)
"Parse `file-attributes' for Tramp files using the ls(1) command."
@@ -363,37 +396,47 @@ pass to the OPERATION."
"Like `directory-files-and-attributes' for Tramp files."
(when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil
- (with-tramp-file-property
- v localname (format "directory-files-attributes-%s-%s-%s-%s"
- full match id-format nosort)
- (tramp-adb-barf-unless-okay
- v (format "%s -a -l %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument localname)) "")
- (with-current-buffer (tramp-get-buffer v)
- (tramp-adb-sh-fix-ls-output)
- (let ((result (tramp-do-parse-file-attributes-with-ls
- v (or id-format 'integer))))
- (when full
- (setq result
- (mapcar
- (lambda (x)
- (cons (expand-file-name (car x) directory) (cdr x)))
- result)))
- (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 match (car x)))
- x))
- result))))))))
+ (copy-tree
+ (with-tramp-file-property
+ v localname (format "directory-files-and-attributes-%s-%s-%s-%s"
+ full match id-format nosort)
+ (with-current-buffer (tramp-get-buffer v)
+ (when (tramp-adb-send-command-and-check
+ v (format "%s -a -l %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument localname)))
+ ;; We insert also filename/. and filename/.., because "ls" doesn't.
+ (narrow-to-region (point) (point))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) "."))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) ".."))))
+ (widen))
+ (tramp-adb-sh-fix-ls-output)
+ (let ((result (tramp-do-parse-file-attributes-with-ls
+ v (or id-format 'integer))))
+ (when full
+ (setq result
+ (mapcar
+ (lambda (x)
+ (cons (expand-file-name (car x) directory) (cdr x)))
+ result)))
+ (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 match (car x)))
+ x))
+ result)))))))))
(defun tramp-adb-get-ls-command (vec)
(with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
- (if (zerop (tramp-adb-command-exit-status
- vec "ls --color=never -al /dev/null"))
+ (if (tramp-adb-send-command-and-check vec "ls --color=never -al /dev/null")
;; On CyanogenMod based system BusyBox is used and "ls" output
;; coloring is enabled by default. So we try to disable it
;; when possible.
@@ -407,9 +450,9 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(split-string
(apply 'concat
(mapcar (lambda (s)
- (replace-regexp-in-string
+ (tramp-compat-replace-regexp-in-string
"\\(.\\)" " -\\1"
- (replace-regexp-in-string "^-" "" s)))
+ (tramp-compat-replace-regexp-in-string "^-" "" s)))
;; FIXME: Warning about removed switches (long and non-dash).
(delq nil
(mapcar
@@ -417,35 +460,6 @@ Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"."
(and (not (string-match "\\(^--\\|^[^-]\\)" s)) s))
switches))))))
-(defun tramp-adb-handle-insert-directory
- (filename switches &optional _wildcard _full-directory-p)
- "Like `insert-directory' for Tramp files."
- (when (stringp switches)
- (setq switches (tramp-adb--gnu-switches-to-ash (split-string switches))))
- (with-parsed-tramp-file-name (file-truename filename) nil
- (with-current-buffer (tramp-get-buffer v)
- (let ((name (tramp-shell-quote-argument (directory-file-name localname)))
- (switch-d (member "-d" switches))
- (switch-t (member "-t" switches))
- (switches (mapconcat 'identity (remove "-t" switches) " ")))
- (tramp-adb-barf-unless-okay
- v (format "%s %s %s" (tramp-adb-get-ls-command v) switches name)
- "Cannot insert directory listing: %s" filename)
- (unless switch-d
- ;; We insert also filename/. and filename/.., because "ls" doesn't.
- (narrow-to-region (point) (point))
- (ignore-errors
- (tramp-adb-barf-unless-okay
- v (format "%s -d %s %s %s"
- (tramp-adb-get-ls-command v)
- switches
- (concat (file-name-as-directory name) ".")
- (concat (file-name-as-directory name) ".."))
- "Cannot insert directory listing: %s" filename))
- (widen))
- (tramp-adb-sh-fix-ls-output switch-t)))
- (insert-buffer-substring (tramp-get-buffer v))))
-
(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time)
"Insert dummy 0 in empty size columns.
Androids \"ls\" command doesn't insert size column for directories:
@@ -473,9 +487,7 @@ Emacs dired can't find files."
(insert " " (mapconcat 'identity sorted-lines "\n ")))
;; Add final newline.
(goto-char (point-max))
- (unless (= (point) (line-beginning-position))
- (insert "\n"))))
-
+ (unless (bolp) (insert "\n"))))
(defun tramp-adb-ls-output-time-less-p (a b)
"Sort \"ls\" output by time, descending."
@@ -484,16 +496,15 @@ Emacs dired can't find files."
(setq time-a (apply 'encode-time (parse-time-string (match-string 0 a))))
(string-match tramp-adb-ls-date-regexp b)
(setq time-b (apply 'encode-time (parse-time-string (match-string 0 b))))
- (tramp-time-less-p time-b time-a)))
+ (time-less-p time-b time-a)))
(defun tramp-adb-ls-output-name-less-p (a b)
"Sort \"ls\" output by name, ascending."
- (let (posa posb)
- (string-match dired-move-to-filename-regexp a)
- (setq posa (match-end 0))
- (string-match dired-move-to-filename-regexp b)
- (setq posb (match-end 0))
- (string-lessp (substring a posa) (substring b posb))))
+ (if (string-match directory-listing-before-filename-regexp a)
+ (let ((posa (match-end 0)))
+ (if (string-match directory-listing-before-filename-regexp b)
+ (let ((posb (match-end 0)))
+ (string-lessp (substring a posa) (substring b posb)))))))
(defun tramp-adb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -506,7 +517,8 @@ Emacs dired can't find files."
(tramp-adb-barf-unless-okay
v (format "mkdir %s" (tramp-shell-quote-argument localname))
"Couldn't make directory %s" dir)
- (tramp-flush-directory-property v (file-name-directory localname))))
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-directory-property v localname)))
(defun tramp-adb-handle-delete-directory (directory &optional recursive)
"Like `delete-directory' for Tramp files."
@@ -538,20 +550,22 @@ Emacs dired can't find files."
(with-tramp-file-property v localname "file-name-all-completions"
(save-match-data
(tramp-adb-send-command
- v (format "%s %s"
+ v (format "%s -a %s"
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
(mapcar
(lambda (f)
- (if (file-directory-p f)
+ (if (file-directory-p (expand-file-name f directory))
(file-name-as-directory f)
f))
(with-current-buffer (tramp-get-buffer v)
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n"))))))))))
+ (append
+ '("." "..")
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n")))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
@@ -563,11 +577,16 @@ Emacs dired can't find files."
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(with-tramp-progress-reporter
v 3 (format "Fetching %s to tmp file %s" filename tmpfile)
- (when (tramp-adb-execute-adb-command v "pull" localname tmpfile)
- (delete-file tmpfile)
+ ;; "adb pull ..." does not always return an error code.
+ (when (or (tramp-adb-execute-adb-command v "pull" localname tmpfile)
+ (not (file-exists-p tmpfile)))
+ (ignore-errors (delete-file tmpfile))
(tramp-error
v 'file-error "Cannot make local copy of file `%s'" filename))
- (set-file-modes tmpfile (file-modes filename)))
+ (set-file-modes
+ tmpfile
+ (logior (or (file-modes filename) 0)
+ (tramp-compat-octal-to-decimal "0400"))))
tmpfile)))
(defun tramp-adb-handle-file-writable-p (filename)
@@ -577,9 +596,8 @@ But handle the case, if the \"test\" command is not available."
(with-tramp-file-property v localname "file-writable-p"
(if (tramp-adb-find-test-command v)
(if (file-exists-p filename)
- (zerop
- (tramp-adb-command-exit-status
- v (format "test -w %s" (tramp-shell-quote-argument localname))))
+ (tramp-adb-send-command-and-check
+ v (format "test -w %s" (tramp-shell-quote-argument localname)))
(and
(file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename))))
@@ -599,9 +617,6 @@ But handle the case, if the \"test\" command is not available."
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (when append
- (tramp-error
- v 'file-error "Cannot append to file using Tramp (`%s')" filename))
(when (and confirm (file-exists-p filename))
(unless (y-or-n-p (format "File %s exists; overwrite anyway? "
filename))
@@ -612,14 +627,21 @@ But handle the case, if the \"test\" command is not available."
(tramp-flush-file-property v localname)
(let* ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok)
+ (set-file-modes
+ tmpfile
+ (logior (or (file-modes tmpfile) 0)
+ (tramp-compat-octal-to-decimal "0600"))))
(tramp-run-real-handler
'write-region
(list start end tmpfile append 'no-message lockname confirm))
(with-tramp-progress-reporter
- v 3 (format "Moving tmp file %s to %s" tmpfile filename)
+ v 3 (format-message
+ "Moving tmp file `%s' to `%s'" tmpfile filename)
(unwind-protect
(when (tramp-adb-execute-adb-command v "push" tmpfile localname)
- (tramp-error v 'file-error "Cannot write: `%s' filename"))
+ (tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))
(when (or (eq visit t) (stringp visit))
@@ -633,20 +655,21 @@ But handle the case, if the \"test\" command is not available."
(defun tramp-adb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
- (tramp-adb-barf-unless-okay
- v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname)
- "Error while changing file's mode %s" filename)))
+ (tramp-adb-send-command-and-check
+ v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname))))
(defun tramp-adb-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
(let ((time (if (or (null time) (equal time '(0 0)))
(current-time)
time)))
- (tramp-adb-command-exit-status
- ;; use shell arithmetic because of Emacs integer size limit
+ (tramp-adb-send-command-and-check
+ ;; Use shell arithmetic because of Emacs integer size limit.
v (format "touch -t $(( %d * 65536 + %d )) %s"
(car time) (cadr time)
(tramp-shell-quote-argument localname))))))
@@ -662,7 +685,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(if (file-directory-p filename)
(tramp-file-name-handler 'copy-directory filename newname keep-date t)
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(let ((tmpfile (file-local-copy filename)))
@@ -703,32 +727,36 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (with-parsed-tramp-file-name
- (if (file-remote-p filename) filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" newname filename)
-
- (if (and (tramp-equal-remote filename newname)
- (not (file-directory-p filename)))
- (progn
- (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-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "mv %s %s"
- (tramp-file-name-handler 'file-remote-p filename 'localname)
- localname)
- "Error renaming %s to %s" filename newname))
-
- ;; Rename by copy.
- (copy-file filename newname ok-if-already-exists t t)
- (delete-file filename)))))
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+
+ (if (and t1 t2
+ (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (let ((l1 (tramp-file-name-handler
+ 'file-remote-p filename 'localname))
+ (l2 (tramp-file-name-handler
+ 'file-remote-p newname 'localname)))
+ (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-property v (file-name-directory l1))
+ (tramp-flush-file-property v l1)
+ (tramp-flush-file-property v (file-name-directory l2))
+ (tramp-flush-file-property v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format "mv %s %s" l1 l2)
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file filename newname ok-if-already-exists t t)
+ (delete-file filename))))))
(defun tramp-adb-handle-process-file
(program &optional infile destination display &rest args)
@@ -799,16 +827,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; directory.
(condition-case nil
(progn
- (setq ret 0)
- (tramp-adb-barf-unless-okay
- v (format "(cd %s; %s)"
- (tramp-shell-quote-argument localname) command)
- "")
- ;; We should show the output anyway.
+ (setq ret
+ (if (tramp-adb-send-command-and-check
+ v
+ (format "(cd %s; %s)"
+ (tramp-shell-quote-argument localname) command))
+ ;; Set return status accordingly.
+ 0 1))
+ ;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
(insert-buffer-substring (tramp-get-connection-buffer v)))
- (when display (display-buffer outbuf))))
+ (when (and display (get-buffer-window outbuf t)) (redisplay))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
(quit
@@ -827,9 +857,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when tmpinput (delete-file tmpinput))
;; `process-file-side-effects' has been introduced with GNU
- ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
- ;; value 't'.
+ ;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(tramp-flush-directory-property v ""))
@@ -874,7 +904,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
- (tramp-compat-user-error "Shell command in progress")))
+ (tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
@@ -992,16 +1022,56 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil))))))
-;; Helper functions.
+(defun tramp-adb-get-device (vec)
+ "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-property nil)
+ (with-tramp-connection-property (tramp-get-connection-process vec) "device"
+ (let* ((method (tramp-file-name-method vec))
+ (host (tramp-file-name-host vec))
+ (port (tramp-file-name-port vec))
+ (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
+ (tramp-compat-replace-regexp-in-string
+ tramp-prefix-port-format ":"
+ (cond ((member host devices) host)
+ ;; This is the case when the host is connected to the default port.
+ ((member (format "%s%s%d" host tramp-prefix-port-format port)
+ devices)
+ (format "%s:%d" host port))
+ ;; An empty host name shall be mapped as well, when there
+ ;; is exactly one entry in `devices'.
+ ((and (zerop (length host)) (= (length devices) 1))
+ (car devices))
+ ;; Try to connect device.
+ ((and tramp-adb-connect-if-not-connected
+ (not (zerop (length host)))
+ (not (tramp-adb-execute-adb-command
+ vec "connect"
+ (tramp-compat-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.
+ (sleep-for 0.1)
+ host)
+ (t (tramp-error
+ vec 'file-error "Could not find device %s" host)))))))
(defun tramp-adb-execute-adb-command (vec &rest args)
"Returns nil on success error-output on failure."
- (when (> (length (tramp-file-name-host vec)) 0)
- (setq args (append (list "-s" (tramp-file-name-host vec)) args)))
+ (when (and (> (length (tramp-file-name-host vec)) 0)
+ ;; The -s switch is only available for ADB device commands.
+ (not (member (car args) (list "connect" "disconnect"))))
+ (setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
(with-temp-buffer
(prog1
(unless
- (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args))
+ (zerop
+ (apply 'tramp-call-process vec tramp-adb-program nil t nil args))
(buffer-string))
(tramp-message vec 6 "%s" (buffer-string)))))
@@ -1009,7 +1079,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Checks, whether the ash has a builtin \"test\" command.
This happens for Android >= 4.0."
(with-tramp-connection-property vec "test"
- (zerop (tramp-adb-command-exit-status vec "type test"))))
+ (tramp-adb-send-command-and-check vec "type test")))
;; Connection functions
@@ -1032,11 +1102,12 @@ This happens for Android >= 4.0."
(while (re-search-forward "\r+$" nil t)
(replace-match "" nil nil)))))
-(defun tramp-adb-command-exit-status
+(defun tramp-adb-send-command-and-check
(vec command)
- "Run COMMAND and return its exit status.
-Sends `echo $?' along with the COMMAND for checking the exit status. If
-COMMAND is nil, just sends `echo $?'. Returns the exit status found."
+ "Run COMMAND and check its exit status.
+Sends `echo $?' along with the COMMAND for checking the exit
+status. If COMMAND is nil, just sends `echo $?'. Returns nil if
+the exit status is not equal 0, and t otherwise."
(tramp-adb-send-command
vec (if command
(format "%s; echo tramp_exit_status $?" command)
@@ -1048,14 +1119,14 @@ COMMAND is nil, just sends `echo $?'. Returns the exit status found."
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
- (read (current-buffer))
+ (zerop (read (current-buffer)))
(let (buffer-read-only)
(delete-region (match-beginning 0) (point-max))))))
(defun tramp-adb-barf-unless-okay (vec command fmt &rest args)
"Run COMMAND, check exit status, throw error if exit status not okay.
FMT and ARGS are passed to `error'."
- (unless (zerop (tramp-adb-command-exit-status vec command))
+ (unless (tramp-adb-send-command-and-check vec command)
(apply 'tramp-error vec 'file-error fmt args)))
(defun tramp-adb-wait-for-output (proc &optional timeout)
@@ -1092,11 +1163,18 @@ FMT and ARGS are passed to `error'."
"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."
+ (tramp-check-proper-method-and-host vec)
+
(let* ((buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf))
(host (tramp-file-name-host vec))
(user (tramp-file-name-user vec))
- (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))))
+ (device (tramp-adb-get-device vec)))
+
+ ;; Set variables for proper tracing in `tramp-adb-parse-device-names'.
+ (setq tramp-current-method (tramp-file-name-method vec)
+ tramp-current-user (tramp-file-name-user vec)
+ tramp-current-host (tramp-file-name-host vec))
;; Maybe we know already that "su" is not supported. We cannot
;; use a connection property, because we have not checked yet
@@ -1108,19 +1186,13 @@ connection if a previous connection has died for some reason."
(and p (processp p) (memq (process-status p) '(run open)))
(save-match-data
(when (and p (processp p)) (delete-process p))
- (if (not devices)
- (tramp-error vec 'file-error "No device connected"))
- (if (and (> (length host) 0) (not (member host devices)))
+ (if (zerop (length device))
(tramp-error vec 'file-error "Device %s not connected" host))
- (if (and (> (length devices) 1) (zerop (length host)))
- (tramp-error
- vec 'file-error
- "Multiple Devices connected: No Host/Device specified"))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
(process-connection-type tramp-process-connection-type)
(args (if (> (length host) 0)
- (list "-s" host "shell")
+ (list "-s" device "shell")
(list "shell")))
(p (let ((default-directory
(tramp-compat-temporary-file-directory)))
@@ -1132,6 +1204,7 @@ connection if a previous connection has died for some reason."
(tramp-adb-wait-for-output p 30)
(unless (eq 'run (process-status p))
(tramp-error vec 'file-error "Terminated!"))
+ (tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
;; Check whether the properties have been changed. If
@@ -1151,17 +1224,17 @@ connection if a previous connection has died for some reason."
(read (current-buffer))))))
(when (and (stringp old-getprop)
(not (string-equal old-getprop new-getprop)))
- (tramp-cleanup vec)
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
old-getprop new-getprop)
+ (tramp-cleanup-connection vec t)
(tramp-adb-maybe-open-connection vec)))
;; Change user if indicated.
(when user
(tramp-adb-send-command vec (format "su %s" user))
- (unless (zerop (tramp-adb-command-exit-status vec nil))
+ (unless (tramp-adb-send-command-and-check vec nil)
(delete-process p)
(tramp-set-file-property vec "" "su-command-p" nil)
(tramp-error
@@ -1179,5 +1252,10 @@ connection if a previous connection has died for some reason."
(read (current-buffer)))
":" 'omit-nulls))))))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-adb 'force)))
+
(provide 'tramp-adb)
+
;;; tramp-adb.el ends here
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 118be597433..bfcfe158281 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,6 +1,6 @@
;;; tramp-cache.el --- file information caching for Tramp
-;; Copyright (C) 2000, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000, 2005-2015 Free Software Foundation, Inc.
;; Author: Daniel Pittman <daniel@inanna.danann.net>
;; Michael Albinus <michael.albinus@gmx.de>
@@ -66,7 +66,8 @@
Every entry has the form (REGEXP PROPERTY VALUE). The regexp
matches remote file names. It can be nil. PROPERTY is a string,
and VALUE the corresponding value. They are used, if there is no
-matching entry for PROPERTY in `tramp-cache-data'."
+matching entry for PROPERTY in `tramp-cache-data'. For more
+details see the info pages."
:group 'tramp
:version "24.4"
:type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
@@ -120,9 +121,10 @@ matching entries of `tramp-connection-properties'."
(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."
- ;; Unify localname.
+ ;; Unify localname. Remove hop from vector.
(setq key (copy-sequence key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (aset key 4 nil)
(let* ((hash (tramp-get-hash-table key))
(value (when (hash-table-p hash) (gethash property hash))))
(if
@@ -136,7 +138,7 @@ Returns DEFAULT if not set."
(tramp-time-diff (current-time) (car value))
remote-file-name-inhibit-cache))
(and (consp remote-file-name-inhibit-cache)
- (tramp-time-less-p
+ (time-less-p
remote-file-name-inhibit-cache (car value)))))
(setq value (cdr value))
(setq value default))
@@ -144,7 +146,7 @@ Returns DEFAULT if not set."
(tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (ignore-errors (symbol-value var)) 0)))
+ (val (or (and (boundp var) (symbol-value var)) 0)))
(set var (1+ val))))
value))
@@ -152,59 +154,75 @@ Returns DEFAULT if not set."
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
Returns VALUE."
- ;; Unify localname.
+ ;; Unify localname. Remove hop from vector.
(setq key (copy-sequence key))
(aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
+ (aset key 4 nil)
(let ((hash (tramp-get-hash-table key)))
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(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 (ignore-errors (symbol-value var)) 0)))
+ (val (or (and (boundp var) (symbol-value var)) 0)))
(set var (1+ val))))
value))
;;;###tramp-autoload
(defun tramp-flush-file-property (key file)
"Remove all properties of FILE in the cache context of KEY."
- ;; Remove file property of symlinks.
- (let ((truename (tramp-get-file-property key file "file-truename" nil)))
+ (let* ((file (tramp-run-real-handler
+ 'directory-file-name (list file)))
+ (truename (tramp-get-file-property key file "file-truename" nil)))
+ ;; Remove file properties of symlinks.
(when (and (stringp truename)
- (not (string-equal file truename)))
- (tramp-flush-file-property key truename)))
- ;; Unify localname.
- (setq key (copy-sequence key))
- (aset key 3 (tramp-run-real-handler 'directory-file-name (list file)))
- (tramp-message key 8 "%s" file)
- (remhash key tramp-cache-data))
+ (not (string-equal file (directory-file-name truename))))
+ (tramp-flush-file-property key truename))
+ ;; Unify localname. Remove hop from vector.
+ (setq key (copy-sequence key))
+ (aset key 3 file)
+ (aset key 4 nil)
+ (tramp-message key 8 "%s" file)
+ (remhash key tramp-cache-data)))
;;;###tramp-autoload
(defun tramp-flush-directory-property (key directory)
"Remove all properties of DIRECTORY in the cache context of KEY.
Remove also properties of all files in subdirectories."
- (let ((directory (tramp-run-real-handler
- 'directory-file-name (list directory))))
+ (let* ((directory (tramp-run-real-handler
+ 'directory-file-name (list directory)))
+ (truename (tramp-get-file-property key directory "file-truename" nil)))
+ ;; Remove file properties of symlinks.
+ (when (and (stringp truename)
+ (not (string-equal directory (directory-file-name truename))))
+ (tramp-flush-directory-property key truename))
(tramp-message key 8 "%s" directory)
(maphash
(lambda (key _value)
(when (and (stringp (tramp-file-name-localname key))
- (string-match directory (tramp-file-name-localname key)))
+ (string-match (regexp-quote directory)
+ (tramp-file-name-localname key)))
(remhash key tramp-cache-data)))
tramp-cache-data)))
;; Reverting or killing a buffer should also flush file properties.
;; They could have been changed outside Tramp. In eshell, "ls" would
;; not show proper directory contents when a file has been copied or
-;; deleted before.
+;; deleted before. We must apply `save-match-data', because it would
+;; corrupt other packages otherwise (reported from org).
(defun tramp-flush-file-function ()
- "Flush all Tramp cache properties from `buffer-file-name'."
- (let ((bfn (if (stringp (buffer-file-name))
- (buffer-file-name)
- default-directory)))
- (when (tramp-tramp-file-p bfn)
- (with-parsed-tramp-file-name bfn nil
- (tramp-flush-file-property v localname)))))
+ "Flush all Tramp cache properties from `buffer-file-name'.
+This is suppressed for temporary buffers."
+ (save-match-data
+ (unless (or (null (buffer-name))
+ (string-match "^\\( \\|\\*\\)" (buffer-name)))
+ (let ((bfn (if (stringp (buffer-file-name))
+ (buffer-file-name)
+ default-directory))
+ (tramp-verbose 0))
+ (when (tramp-tramp-file-p bfn)
+ (with-parsed-tramp-file-name bfn nil
+ (tramp-flush-file-property v localname)))))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
(add-hook 'eshell-pre-command-hook 'tramp-flush-file-function)
@@ -225,11 +243,12 @@ Remove also properties of all files in subdirectories."
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a vector.
If the value is not set for the connection, returns DEFAULT."
- ;; Unify key by removing localname from vector. Work with a copy in
- ;; order to avoid side effects.
+ ;; Unify key by removing localname and hop from vector. Work with a
+ ;; copy in order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
- (aset key 3 nil))
+ (aset key 3 nil)
+ (aset key 4 nil))
(let* ((hash (tramp-get-hash-table key))
(value (if (hash-table-p hash)
(gethash property hash default)
@@ -242,11 +261,12 @@ If the 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 vector.
PROPERTY is set persistent when KEY is a vector."
- ;; Unify key by removing localname from vector. Work with a copy in
- ;; order to avoid side effects.
+ ;; Unify key by removing localname and hop from vector. Work with a
+ ;; copy in order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
- (aset key 3 nil))
+ (aset key 3 nil)
+ (aset key 4 nil))
(let ((hash (tramp-get-hash-table key)))
(puthash property value hash)
(setq tramp-cache-data-changed t)
@@ -263,11 +283,12 @@ KEY identifies the connection, it is either a process or a vector."
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
- ;; Unify key by removing localname from vector. Work with a copy in
- ;; order to avoid side effects.
+ ;; Unify key by removing localname and hop from vector. Work with a
+ ;; copy in order to avoid side effects.
(when (vectorp key)
(setq key (copy-sequence key))
- (aset key 3 nil))
+ (aset key 3 nil)
+ (aset key 4 nil))
(tramp-message
key 7 "%s %s" key
(let ((hash (gethash key tramp-cache-data))
@@ -285,6 +306,21 @@ KEY identifies the connection, it is either a process or a vector."
(let (result)
(maphash
(lambda (key value)
+ ;; Remove text properties from KEY and VALUE.
+ ;; `substring-no-properties' does not exist in XEmacs.
+ (when (functionp 'substring-no-properties)
+ (when (vectorp key)
+ (dotimes (i (length key))
+ (when (stringp (aref key i))
+ (aset key i
+ (tramp-compat-funcall
+ 'substring-no-properties (aref key i))))))
+ (when (stringp key)
+ (setq key (tramp-compat-funcall 'substring-no-properties key)))
+ (when (stringp value)
+ (setq value
+ (tramp-compat-funcall 'substring-no-properties value))))
+ ;; Dump.
(let ((tmp (format
"(%s %s)"
(if (processp key)
@@ -336,7 +372,7 @@ KEY identifies the connection, it is either a process or a vector."
(remhash key cache)))
cache)
;; Dump it.
- (with-temp-buffer
+ (with-temp-file tramp-persistency-file-name
(insert
";; -*- emacs-lisp -*-"
;; `time-stamp-string' might not exist in all (X)Emacs flavors.
@@ -350,9 +386,7 @@ KEY identifies the connection, it is either a process or a vector."
";; Tramp connection history. Don't change this file.\n"
";; You can delete it, forcing Tramp to reapply the checks.\n\n"
(with-output-to-string
- (pp (read (format "(%s)" (tramp-cache-print cache))))))
- (write-region
- (point-min) (point-max) tramp-persistency-file-name))))))
+ (pp (read (format "(%s)" (tramp-cache-print cache)))))))))))
(unless noninteractive
(add-hook 'kill-emacs-hook 'tramp-dump-connection-properties))
@@ -390,6 +424,7 @@ for all methods. Resulting data are derived from connection history."
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
(let ((list (read (current-buffer)))
+ (tramp-verbose 0)
element key item)
(while (setq element (pop list))
(setq key (pop element))
@@ -405,7 +440,7 @@ for all methods. Resulting data are derived from connection history."
(clrhash tramp-cache-data))
(error
;; File is corrupted.
- (message "Tramp persistency file '%s' is corrupted: %s"
+ (message "Tramp persistency file `%s' is corrupted: %s"
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 937db34a346..22c139859f9 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -1,6 +1,6 @@
;;; tramp-cmds.el --- Interactive commands for Tramp
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -48,16 +48,15 @@
nil
(mapcar
(lambda (x)
- (with-current-buffer x
- (when (and (stringp default-directory)
- (file-remote-p default-directory))
- x)))
+ (with-current-buffer x (when (tramp-tramp-file-p default-directory) x)))
(buffer-list))))
;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec)
+(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
"Flush all connection related objects.
-This includes password cache, file cache, connection cache, buffers.
+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.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@@ -79,15 +78,20 @@ When called interactively, a Tramp connection has to be selected."
(completing-read
"Enter Tramp connection: " connections nil t
(try-completion "" connections)))
- (when (and name (file-remote-p name))
- (with-parsed-tramp-file-name name nil v))))))
+ (and (tramp-tramp-file-p name) (tramp-dissect-file-name name))))
+ nil nil))
(if (not vec)
;; Nothing to do.
(message "No Tramp connection found.")
;; Flush password cache.
- (tramp-clear-passwd vec)
+ (unless keep-password (tramp-clear-passwd vec))
+
+ ;; Cleanup `tramp-current-connection'. Otherwise, we would be
+ ;; suppressed in the test suite. We use `keep-password' as
+ ;; indicator; it is not worth to add a new argument.
+ (when keep-password (setq tramp-current-connection nil))
;; Flush file cache.
(tramp-flush-directory-property vec "")
@@ -101,7 +105,8 @@ When called interactively, a Tramp connection has to be selected."
;; Remove buffers.
(dolist
(buf (list (get-buffer (tramp-buffer-name vec))
- (get-buffer (tramp-debug-buffer-name vec))
+ (unless keep-debug
+ (get-buffer (tramp-debug-buffer-name vec)))
(tramp-get-connection-property vec "process-buffer" nil)))
(when (bufferp buf) (kill-buffer buf)))))
@@ -109,8 +114,7 @@ When called interactively, a Tramp connection has to be selected."
(defun tramp-cleanup-this-connection ()
"Flush all connection related objects of the current buffer's connection."
(interactive)
- (and (stringp default-directory)
- (file-remote-p default-directory)
+ (and (tramp-tramp-file-p default-directory)
(tramp-cleanup-connection
(tramp-dissect-file-name default-directory 'noexpand))))
@@ -153,8 +157,8 @@ This includes password cache, file cache, connection cache, buffers."
(interactive "P")
(if arg (insert tramp-version) (message tramp-version)))
-;; Make the `reporter` functionality available for making bug reports about
-;; the package. A most useful piece of code.
+;; Make the "reporter" functionality available for making bug reports about
+;; the package. A most useful piece of code.
(autoload 'reporter-submit-bug-report "reporter")
@@ -190,7 +194,9 @@ This includes password cache, file cache, connection cache, buffers."
'tramp-load-report-modules ; pre-hook
'tramp-append-tramp-buffers ; post-hook
- (propertize "\n" 'display "\
+ (tramp-compat-funcall
+ (if (functionp 'propertize) 'propertize 'progn)
+ "\n" 'display "\
Enter your bug report in this message, including as much detail
as you possibly can about the problem, what you did to cause it
and what the local and remote machines are.
@@ -230,8 +236,11 @@ buffer in your bug report.
(string-match
(concat "[^" (symbol-value 'mm-7bit-chars) "]") val))
(with-current-buffer reporter-eval-buffer
- (set varsym (format "(base64-decode-string \"%s\")"
- (base64-encode-string val))))))
+ (set
+ varsym
+ (format
+ "(decode-coding-string (base64-decode-string \"%s\") 'raw-text)"
+ (base64-encode-string (encode-coding-string val 'raw-text)))))))
;; Dump variable.
(tramp-compat-funcall 'reporter-dump-variable varsym mailbuf)
@@ -355,7 +364,7 @@ the debug buffer(s).")
(kill-buffer nil)
(switch-to-buffer curbuf)
(goto-char (point-max))
- (insert (propertize "\n" 'display "\n\
+ (insert (tramp-compat-funcall 'propertize "\n" 'display "\n\
This is a special notion of the `gnus/message' package. If you
use another mail agent (by copying the contents of this buffer)
please ensure that the buffers are attached to your email.\n\n"))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 71703fe6ab1..c57102881bf 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -1,6 +1,6 @@
;;; tramp-compat.el --- Tramp compatibility functions
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -35,6 +35,11 @@
(eval-and-compile
+ ;; GNU Emacs 22.
+ (unless (fboundp 'ignore-errors)
+ (load "cl" 'noerror)
+ (load "cl-macs" 'noerror))
+
;; Some packages must be required for XEmacs, because we compile
;; with -no-autoloads.
(when (featurep 'xemacs)
@@ -44,7 +49,8 @@
(require 'outline)
(require 'passwd)
(require 'pp)
- (require 'regexp-opt))
+ (require 'regexp-opt)
+ (require 'time-date))
(require 'advice)
(require 'custom)
@@ -94,7 +100,7 @@
(setq byte-compile-not-obsolete-vars '(directory-sep-char)))
;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
- ;; Besides `t', `nil', and integer, we use also timestamps (as
+ ;; Besides t, nil, and integer, we use also timestamps (as
;; returned by `current-time') internally.
(unless (boundp 'remote-file-name-inhibit-cache)
(defvar remote-file-name-inhibit-cache nil))
@@ -116,16 +122,6 @@
;; `tramp-handle-*' functions, because this would bypass the locking
;; mechanism.
- ;; `file-remote-p' has been introduced with Emacs 22. The version
- ;; of XEmacs is not a magic file name function (yet).
- (unless (fboundp 'file-remote-p)
- (defalias 'file-remote-p
- (lambda (file &optional identification connected)
- (when (tramp-tramp-file-p file)
- (tramp-compat-funcall
- 'tramp-file-name-handler
- 'file-remote-p file identification connected)))))
-
;; `process-file' does not exist in XEmacs.
(unless (fboundp 'process-file)
(defalias 'process-file
@@ -181,12 +177,16 @@
(lambda ()
(ad-remove-advice
'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
- (ad-activate 'file-expand-wildcards)))))
+ (ad-activate 'file-expand-wildcards))))
+
+ ;; `redisplay' does not exist in XEmacs.
+ (unless (fboundp 'redisplay)
+ (defalias 'redisplay 'ignore)))
;; `with-temp-message' does not exist in XEmacs.
(if (fboundp 'with-temp-message)
(defalias 'tramp-compat-with-temp-message 'with-temp-message)
- (defmacro tramp-compat-with-temp-message (message &rest body)
+ (defmacro tramp-compat-with-temp-message (_message &rest body)
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
@@ -313,13 +313,21 @@ Not actually used. Use `(format \"%o\" i)' instead?"
"Like `copy-file' for Tramp files (compat function)."
(cond
(preserve-extended-attributes
- (tramp-compat-funcall
- 'copy-file filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-file filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (wrong-number-of-arguments
+ (tramp-compat-copy-file
+ filename newname ok-if-already-exists keep-date preserve-uid-gid))))
(preserve-uid-gid
- (tramp-compat-funcall
- 'copy-file filename newname ok-if-already-exists keep-date
- preserve-uid-gid))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-file filename newname ok-if-already-exists keep-date
+ preserve-uid-gid)
+ (wrong-number-of-arguments
+ (tramp-compat-copy-file
+ filename newname ok-if-already-exists keep-date))))
(t
(copy-file filename newname ok-if-already-exists keep-date))))
@@ -408,6 +416,13 @@ Not actually used. Use `(format \"%o\" i)' instead?"
directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
(delete-directory directory))))
+;; MUST-SUFFIX doesn't exist on XEmacs.
+(defun tramp-compat-load (file &optional noerror nomessage nosuffix must-suffix)
+ "Like `load' for Tramp files (compat function)."
+ (if must-suffix
+ (tramp-compat-funcall 'load file noerror nomessage nosuffix must-suffix)
+ (load file noerror nomessage nosuffix)))
+
;; `number-sequence' does not exist in XEmacs. Implementation is
;; taken from Emacs 23.
(defun tramp-compat-number-sequence (from &optional to inc)
@@ -438,7 +453,7 @@ element is not omitted."
(delete "" (split-string string pattern)))
(defun tramp-compat-process-running-p (process-name)
- "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
+ "Returns t if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
(cond
;; GNU Emacs 22 on w32.
@@ -463,7 +478,7 @@ element is not omitted."
;; Fallback, if there is no Lisp support yet.
(t (let ((default-directory
- (if (file-remote-p default-directory)
+ (if (tramp-tramp-file-p default-directory)
(tramp-compat-temporary-file-directory)
default-directory))
(unix95 (getenv "UNIX95"))
@@ -512,19 +527,84 @@ EOL-TYPE can be one of `dos', `unix', or `mac'."
(cond ((eq eol-type 'dos) 'crlf)
((eq eol-type 'unix) 'lf)
((eq eol-type 'mac) 'cr)
- (t
- (error "Unknown EOL-TYPE `%s', must be %s"
- eol-type
- "`dos', `unix', or `mac'")))))
+ (t (error
+ "Unknown EOL-TYPE `%s', must be `dos', `unix', or `mac'"
+ eol-type)))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
-;; `user-error' has been added to Emacs 24.3.
-(defun tramp-compat-user-error (format &rest args)
- "Signal a pilot error."
- (apply (if (fboundp 'user-error) 'user-error 'error) format args))
+;; `replace-regexp-in-string' does not exist in XEmacs.
+;; Implementation is taken from Emacs 24.
+(if (fboundp 'replace-regexp-in-string)
+ (defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string)
+ (defun tramp-compat-replace-regexp-in-string
+ (regexp rep string &optional fixedcase literal subexp start)
+ "Replace all matches for REGEXP with REP in STRING.
+
+Return a new string containing the replacements.
+
+Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
+arguments with the same names of function `replace-match'. If START
+is non-nil, start replacements at that index in STRING.
+
+REP is either a string used as the NEWTEXT arg of `replace-match' or a
+function. If it is a function, it is called with the actual text of each
+match, and its value is used as the replacement text. When REP is called,
+the match data are the result of matching REGEXP against a substring
+of STRING.
+
+To replace only the first match (if any), make REGEXP match up to \\'
+and replace a sub-expression, e.g.
+ (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
+ => \" bar foo\""
+
+ (let ((l (length string))
+ (start (or start 0))
+ matches str mb me)
+ (save-match-data
+ (while (and (< start l) (string-match regexp string start))
+ (setq mb (match-beginning 0)
+ me (match-end 0))
+ ;; If we matched the empty string, make sure we advance by one char
+ (when (= me mb) (setq me (min l (1+ mb))))
+ ;; Generate a replacement for the matched substring.
+ ;; Operate only on the substring to minimize string consing.
+ ;; Set up match data for the substring for replacement;
+ ;; presumably this is likely to be faster than munging the
+ ;; match data directly in Lisp.
+ (string-match regexp (setq str (substring string mb me)))
+ (setq matches
+ (cons (replace-match (if (stringp rep)
+ rep
+ (funcall rep (match-string 0 str)))
+ fixedcase literal str subexp)
+ (cons (substring string start mb) ; unmatched prefix
+ matches)))
+ (setq start me))
+ ;; Reconstruct a string from the pieces.
+ (setq matches (cons (substring string start l) matches)) ; leftover
+ (apply #'concat (nreverse matches))))))
+
+;; `default-toplevel-value' has been declared in Emacs 24.
+(unless (fboundp 'default-toplevel-value)
+ (defalias 'default-toplevel-value 'symbol-value))
+
+;; `format-message' is new in Emacs 25, and does not exist in XEmacs.
+(unless (fboundp 'format-message)
+ (defalias 'format-message 'format))
+
+;; `delete-dups' does not exist in XEmacs 21.4.
+(if (fboundp 'delete-dups)
+ (defalias 'tramp-compat-delete-dups 'delete-dups)
+ (defun tramp-compat-delete-dups (list)
+ "Destructively remove `equal' duplicates from LIST.
+Store the result in LIST and return it. LIST must be a proper list.
+Of several `equal' occurrences of an element in LIST, the first
+one is kept."
+ (cl-delete-duplicates list '(:test equal :from-end) nil)))
(add-hook 'tramp-unload-hook
(lambda ()
+ (unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
(provide 'tramp-compat)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 9e1be06a2b1..23646a05fdf 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -1,6 +1,6 @@
;;; tramp-ftp.el --- Tramp convenience functions for Ange-FTP
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -120,17 +120,6 @@ present for backward compatibility."
tramp-ftp-method
'((tramp-parse-netrc "~/.netrc"))))
-;; If there is URL syntax, `substitute-in-file-name' needs special
-;; handling.
-(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name)
-(add-hook 'tramp-ftp-unload-hook
- (lambda ()
- (setplist 'substitute-in-file-name
- (delete 'ange-ftp
- (delete 'tramp-handle-substitute-in-file-name
- (symbol-plist
- 'substitute-in-file-name))))))
-
;;;###tramp-autoload
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
@@ -172,7 +161,7 @@ pass to the OPERATION."
;; We must copy it locally first, because there is no place in
;; ange-ftp for correct handling.
((and (memq operation '(copy-file rename-file))
- (file-remote-p (cadr args))
+ (tramp-tramp-file-p (cadr args))
(not (tramp-ftp-file-name-p (cadr args))))
(let* ((filename (car args))
(newname (cadr args))
@@ -189,12 +178,7 @@ pass to the OPERATION."
(ignore-errors (delete-file tmpfile)))))
;; Normally, the handlers must be discarded.
- ;; `inhibit-file-name-handlers' isn't sufficient, because the
- ;; local file name could be in Tramp syntax as well (for
- ;; example, returning VMS file names like "/DISK$CAM:/AAA").
- ;; That's why we set also `tramp-mode' to nil.
- (t (let* (;(tramp-mode nil)
- (inhibit-file-name-handlers
+ (t (let* ((inhibit-file-name-handlers
(list 'tramp-file-name-handler
'tramp-completion-file-name-handler
(and (eq inhibit-file-name-operation operation)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f70074ba6e9..b93c4cf57a5 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1,6 +1,6 @@
;;; tramp-gvfs.el --- Tramp access functions for GVFS daemon
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -47,16 +47,16 @@
;; discovered during development time, is given in respective
;; comments.
-;; The customer option `tramp-gvfs-methods' contains the list of
-;; supported connection methods. Per default, these are "dav",
-;; "davs", "obex" and "synce". Note that with "obex" it might be
-;; necessary to pair with the other bluetooth device, if it hasn't
+;; The custom option `tramp-gvfs-methods' contains the list of
+;; supported connection methods. Per default, these are "afp", "dav",
+;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might
+;; be necessary to pair with the other bluetooth device, if it hasn't
;; been done already. There might be also some few seconds delay in
;; discovering available bluetooth devices.
-;; Other possible connection methods are "ftp", "sftp" 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 Tramp
+;; Other possible connection methods are "ftp" 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 Tramp
;; implementation.
;; GVFS offers even more connection methods. The complete list of
@@ -78,10 +78,10 @@
;; For hostname completion, information is retrieved either from the
;; bluez daemon (for the "obex" method), the hal daemon (for the
-;; "synce" method), or from the zeroconf daemon (for the "dav",
+;; "synce" method), or from the zeroconf daemon (for the "afp", "dav",
;; "davs", and "sftp" methods). The zeroconf daemon is pre-configured
;; to discover services in the "local" domain. If another domain
-;; shall be used for discovering services, the customer option
+;; shall be used for discovering services, the custom option
;; `tramp-gvfs-zeroconf-domain' can be set accordingly.
;; Restrictions:
@@ -108,14 +108,14 @@
(eval-when-compile
(require 'cl)
(require 'custom))
-(defvar ls-lisp-use-insert-directory-program)
;;;###tramp-autoload
-(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
+(defcustom tramp-gvfs-methods '("afp" "dav" "davs" "obex" "sftp" "synce")
"List of methods for remote files, accessed with GVFS."
:group 'tramp
- :version "23.2"
- :type '(repeat (choice (const "dav")
+ :version "25.1"
+ :type '(repeat (choice (const "afp")
+ (const "dav")
(const "davs")
(const "ftp")
(const "obex")
@@ -128,6 +128,7 @@
;;;###tramp-autoload
(add-to-list 'tramp-default-user-alist '("\\`synce\\'" nil nil))
+;;;###tramp-autoload
(defcustom tramp-gvfs-zeroconf-domain "local"
"Zeroconf domain to be used for discovering services, like host names."
:group 'tramp
@@ -153,6 +154,7 @@
(defconst tramp-gvfs-enabled
(ignore-errors
(and (featurep 'dbusbind)
+ (tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
(or (tramp-compat-process-running-p "gvfs-fuse-daemon")
(tramp-compat-process-running-p "gvfsd-fuse"))))
@@ -167,9 +169,10 @@
;; Introspection data exist since GVFS 1.14. If there are no such
;; data, we expect an earlier interface.
(defconst tramp-gvfs-methods-mounttracker
- (dbus-introspect-get-method-names
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker)
+ (and tramp-gvfs-enabled
+ (dbus-introspect-get-method-names
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker))
"The list of supported methods of the mount tracking interface.")
(defconst tramp-gvfs-listmounts
@@ -187,9 +190,10 @@ It has been changed in GVFS 1.14.")
It has been changed in GVFS 1.14.")
(defconst tramp-gvfs-mountlocation-signature
- (dbus-introspect-get-signature
- :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
- tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation)
+ (and tramp-gvfs-enabled
+ (dbus-introspect-get-signature
+ :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker
+ tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation))
"The D-Bus signature of the \"mountLocation\" method.
It has been changed in GVFS 1.14.")
@@ -228,7 +232,8 @@ It has been changed in GVFS 1.14.")
;; ARRAY BYTE mount_prefix
;; ARRAY
;; STRUCT mount_spec_item
-;; STRING key (server, share, type, user, host, port)
+;; STRING key (type, user, domain, host, server,
+;; share, volume, port, ssl)
;; ARRAY BYTE value
;; ARRAY BYTE default_location Since GVFS 1.5 only !!!
@@ -372,6 +377,7 @@ It has been changed in GVFS 1.14.")
;; </signal>
;; </interface>
+;;;###tramp-autoload
(defcustom tramp-bluez-discover-devices-timeout 60
"Defines seconds since last bluetooth device discovery before rescanning.
A value of 0 would require an immediate discovery during hostname
@@ -439,6 +445,7 @@ Every entry is a list (NAME ADDRESS).")
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-gvfs-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@@ -450,13 +457,13 @@ Every entry is a list (NAME ADDRESS).")
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
;; `get-file-buffer' performed by default handler.
- (insert-directory . tramp-gvfs-handle-insert-directory)
- (insert-file-contents . tramp-gvfs-handle-insert-file-contents)
+ (insert-directory . tramp-handle-insert-directory)
+ (insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
- (make-symbolic-link . ignore)
+ (make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
(set-file-acl . ignore)
@@ -490,7 +497,7 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
(unless tramp-gvfs-enabled
- (tramp-compat-user-error "Package `tramp-gvfs' not supported"))
+ (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))
@@ -578,58 +585,127 @@ is no information where to trace the message.")
;; File name primitives.
+(defun tramp-gvfs-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-gvfs-handle-copy-file' and
+`tramp-gvfs-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))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (equal-remote (tramp-equal-remote filename newname))
+ (file-operation (intern (format "%s-file" op)))
+ (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error
+ v 'file-already-exists "File %s already exists" newname))
+
+ (if (or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed" nil))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (cond
+ (preserve-extended-attributes
+ (tramp-compat-funcall
+ file-operation
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes))
+ (preserve-uid-gid
+ (tramp-compat-funcall
+ file-operation filename tmpfile t keep-date preserve-uid-gid))
+ (t
+ (tramp-compat-funcall
+ file-operation filename tmpfile t keep-date)))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (apply
+ 'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ (list "--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed" nil)))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details."
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP, do not
+ ;; support direct copy/move. Try a fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)))))))
+
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files."
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
-
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))
-
- (if (or (and (tramp-tramp-file-p filename)
- (not (tramp-gvfs-file-name-p filename)))
- (and (tramp-tramp-file-p newname)
- (not (tramp-gvfs-file-name-p newname))))
-
- ;; We cannot copy directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (cond
- (preserve-extended-attributes
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes))
- (preserve-uid-gid
- (copy-file filename tmpfile t keep-date preserve-uid-gid))
- (t
- (copy-file filename tmpfile t keep-date)))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct copy.
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" filename newname)
- (unless
- (let ((args
- (append (if (or keep-date preserve-uid-gid)
- (list "--preserve")
- nil)
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname)))))
- (apply 'tramp-gvfs-send-command v "gvfs-copy" args))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "Copying failed, see buffer `%s' for details." (buffer-name)))))
-
- (when (file-remote-p newname)
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))))
+ (setq filename (expand-file-name filename))
+ (setq newname (expand-file-name newname))
+ (cond
+ ;; At least one file a Tramp file?
+ ((or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-gvfs-do-copy-or-rename-file
+ 'copy filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))
+ ;; Compat section.
+ (preserve-extended-attributes
+ (tramp-run-real-handler
+ 'copy-file
+ (list filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)))
+ (preserve-uid-gid
+ (tramp-run-real-handler
+ 'copy-file
+ (list filename newname ok-if-already-exists keep-date preserve-uid-gid)))
+ (t
+ (tramp-run-real-handler
+ 'copy-file (list filename newname ok-if-already-exists keep-date)))))
(defun tramp-gvfs-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
@@ -657,7 +733,7 @@ is no information where to trace the message.")
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)
+ (tramp-flush-file-property v localname)
(unless
(tramp-gvfs-send-command
v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm")
@@ -696,7 +772,7 @@ is no information where to trace the message.")
(unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; We do not pass "/..".
- (if (string-equal "smb" method)
+ (if (string-match "^\\(afp\\|smb\\)$" method)
(when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname)
(setq localname (replace-match "/" t t localname 1)))
(when (string-match "^/\\.\\./?" localname)
@@ -714,123 +790,120 @@ is no information where to trace the message.")
(defun tramp-gvfs-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used)
- dirp res-symlink-target res-numlinks res-uid res-gid res-access
- res-mod res-change res-size res-filemodes res-inode res-device)
- (with-parsed-tramp-file-name filename nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (tramp-message v 5 "file attributes: %s" localname)
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename))
- ;; Parse output ...
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (when (re-search-forward "attributes:" nil t)
- ;; ... directory or symlink
- (goto-char (point-min))
- (setq dirp (if (re-search-forward "type:\\s-+directory" nil t) t))
- (goto-char (point-min))
- (setq res-symlink-target
- (if (re-search-forward
- "standard::symlink-target:\\s-+\\(\\S-+\\)" nil t)
- (match-string 1)))
- ;; ... number links
- (goto-char (point-min))
- (setq res-numlinks
- (if (re-search-forward "unix::nlink:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1)) 0))
- ;; ... uid and gid
- (goto-char (point-min))
- (setq res-uid
- (or (if (eq id-format 'integer)
- (if (re-search-forward
- "unix::uid:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1)))
- (if (re-search-forward
- "owner::user:\\s-+\\(\\S-+\\)" nil t)
- (match-string 1)))
- (tramp-get-local-uid id-format)))
- (setq res-gid
- (or (if (eq id-format 'integer)
- (if (re-search-forward
- "unix::gid:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1)))
- (if (re-search-forward
- "owner::group:\\s-+\\(\\S-+\\)" nil t)
- (match-string 1)))
- (tramp-get-local-gid id-format)))
- ;; ... last access, modification and change time
- (goto-char (point-min))
- (setq res-access
- (if (re-search-forward
- "time::access:\\s-+\\([0-9]+\\)" nil t)
- (seconds-to-time (string-to-number (match-string 1)))
- '(0 0)))
- (goto-char (point-min))
- (setq res-mod
- (if (re-search-forward
- "time::modified:\\s-+\\([0-9]+\\)" nil t)
- (seconds-to-time (string-to-number (match-string 1)))
- '(0 0)))
- (goto-char (point-min))
- (setq res-change
- (if (re-search-forward
- "time::changed:\\s-+\\([0-9]+\\)" nil t)
- (seconds-to-time (string-to-number (match-string 1)))
- '(0 0)))
- ;; ... size
- (goto-char (point-min))
- (setq res-size
- (if (re-search-forward
- "standard::size:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1)) 0))
- ;; ... file mode flags
- (goto-char (point-min))
- (setq res-filemodes
- (if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t)
- (tramp-file-mode-from-int (match-string 1))
- (if dirp "drwx------" "-rwx------")))
- ;; ... inode and device
- (goto-char (point-min))
- (setq res-inode
- (if (re-search-forward "unix::inode:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1))
- (tramp-get-inode v)))
+ (ignore-errors
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used)
+ (process-environment (cons "LC_MESSAGES=C" process-environment))
+ dirp res-symlink-target res-numlinks res-uid res-gid res-access
+ res-mod res-change res-size res-filemodes res-inode res-device)
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (tramp-message v 5 "file attributes: %s" localname)
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name filename))
+ ;; Parse output ...
+ (with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
- (setq res-device
- (if (re-search-forward "unix::device:\\s-+\\([0-9]+\\)" nil t)
- (string-to-number (match-string 1))
- (tramp-get-device v)))
-
- ;; Return data gathered.
- (list
- ;; 0. t for directory, string (name linked to) for
- ;; symbolic link, or nil.
- (or dirp res-symlink-target)
- ;; 1. Number of links to file.
- res-numlinks
- ;; 2. File uid.
- res-uid
- ;; 3. File gid.
- res-gid
- ;; 4. Last access time, as a list of integers.
- ;; 5. Last modification time, likewise.
- ;; 6. Last status change time, likewise.
- res-access res-mod res-change
- ;; 7. Size in bytes (-1, if number is out of range).
- res-size
- ;; 8. File modes.
- res-filemodes
- ;; 9. t if file's gid would change if file were deleted
- ;; and recreated.
- nil
- ;; 10. Inode number.
- res-inode
- ;; 11. Device number.
- res-device
- )))))))
+ (when (re-search-forward "attributes:" nil t)
+ ;; ... directory or symlink
+ (goto-char (point-min))
+ (setq dirp (if (re-search-forward "type: directory" nil t) t))
+ (goto-char (point-min))
+ (setq res-symlink-target
+ (if (re-search-forward
+ "standard::symlink-target: \\(.+\\)$" nil t)
+ (match-string 1)))
+ ;; ... number links
+ (goto-char (point-min))
+ (setq res-numlinks
+ (if (re-search-forward "unix::nlink: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)) 0))
+ ;; ... uid and gid
+ (goto-char (point-min))
+ (setq res-uid
+ (if (eq id-format 'integer)
+ (if (re-search-forward "unix::uid: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ -1)
+ (if (re-search-forward "owner::user: \\(.+\\)$" nil t)
+ (match-string 1)
+ "UNKNOWN")))
+ (setq res-gid
+ (if (eq id-format 'integer)
+ (if (re-search-forward "unix::gid: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ -1)
+ (if (re-search-forward "owner::group: \\(.+\\)$" nil t)
+ (match-string 1)
+ "UNKNOWN")))
+ ;; ... last access, modification and change time
+ (goto-char (point-min))
+ (setq res-access
+ (if (re-search-forward "time::access: \\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ (goto-char (point-min))
+ (setq res-mod
+ (if (re-search-forward "time::modified: \\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ (goto-char (point-min))
+ (setq res-change
+ (if (re-search-forward "time::changed: \\([0-9]+\\)" nil t)
+ (seconds-to-time (string-to-number (match-string 1)))
+ '(0 0)))
+ ;; ... size
+ (goto-char (point-min))
+ (setq res-size
+ (if (re-search-forward "standard::size: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1)) 0))
+ ;; ... file mode flags
+ (goto-char (point-min))
+ (setq res-filemodes
+ (if (re-search-forward "unix::mode: \\([0-9]+\\)" nil t)
+ (tramp-file-mode-from-int
+ (string-to-number (match-string 1)))
+ (if dirp "drwx------" "-rwx------")))
+ ;; ... inode and device
+ (goto-char (point-min))
+ (setq res-inode
+ (if (re-search-forward "unix::inode: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ (tramp-get-inode v)))
+ (goto-char (point-min))
+ (setq res-device
+ (if (re-search-forward "unix::device: \\([0-9]+\\)" nil t)
+ (string-to-number (match-string 1))
+ (tramp-get-device v)))
+
+ ;; Return data gathered.
+ (list
+ ;; 0. t for directory, string (name linked to) for
+ ;; symbolic link, or nil.
+ (or dirp res-symlink-target)
+ ;; 1. Number of links to file.
+ res-numlinks
+ ;; 2. File uid.
+ res-uid
+ ;; 3. File gid.
+ res-gid
+ ;; 4. Last access time, as a list of integers.
+ ;; 5. Last modification time, likewise.
+ ;; 6. Last status change time, likewise.
+ res-access res-mod res-change
+ ;; 7. Size in bytes (-1, if number is out of range).
+ res-size
+ ;; 8. File modes.
+ res-filemodes
+ ;; 9. t if file's gid would change if file were deleted
+ ;; and recreated.
+ nil
+ ;; 10. Inode number.
+ res-inode
+ ;; 11. Device number.
+ res-device
+ ))))))))
(defun tramp-gvfs-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
@@ -895,7 +968,7 @@ is no information where to trace the message.")
entry)
;; Get a list of directories and files.
(tramp-gvfs-send-command
- v "gvfs-ls" (tramp-gvfs-url-file-name directory))
+ v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory))
;; Now grab the output.
(with-temp-buffer
@@ -924,24 +997,48 @@ is no information where to trace the message.")
v (concat localname filename)
"file-name-all-completions" result))))))))
-(defun tramp-gvfs-handle-file-notify-add-watch (file-name _flags _callback)
+(defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
- (let ((p (start-process
- "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
- "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
+ ;; We cannot watch directories, because `gvfs-monitor-dir' is not
+ ;; supported for gvfs-mounted directories.
+ (when (file-directory-p file-name)
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
+ (let* ((default-directory (file-name-directory file-name))
+ (events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed))))
+ (p (start-process
+ "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
+ "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
(if (not (processp p))
(tramp-error
- v 'file-notify-error "gvfs-monitor-file failed to start")
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name)
+ (tramp-message
+ v 6 "Run `%s', %S" (mapconcat 'identity (process-command p) " ") p)
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-process-put p 'events events)
+ (tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
- (set-process-filter p 'tramp-gvfs-file-gvfs-monitor-file-process-filter)
- (with-current-buffer (process-buffer p)
- (setq default-directory (file-name-directory file-name)))
+ (set-process-filter p 'tramp-gvfs-monitor-file-process-filter)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (tramp-accept-process-output p 1)
+ (unless (memq (process-status p) '(run open))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
p))))
-(defun tramp-gvfs-file-gvfs-monitor-file-process-filter (proc string)
- "Read output from \"gvfs-monitor-file\" and add corresponding file-notify events."
+(defun tramp-gvfs-monitor-file-process-filter (proc string)
+ "Read output from \"gvfs-monitor-file\" and add corresponding \
+file-notify events."
(let* ((rest-string (tramp-compat-process-get proc 'rest-string))
(dd (with-current-buffer (process-buffer proc) default-directory))
(ddu (regexp-quote (tramp-gvfs-url-file-name dd))))
@@ -950,8 +1047,10 @@ is no information where to trace the message.")
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
+ string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+ (when (string-match "Monitoring not supported" string)
+ (delete-process proc))
(while (string-match
(concat "^[\n\r]*"
@@ -959,10 +1058,10 @@ is no information where to trace the message.")
"File = \\([^\n\r]+\\)[\n\r]+"
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
- (let ((action (intern-soft
- (replace-regexp-in-string
- "_" "-" (downcase (match-string 2 string)))))
- (file (match-string 1 string)))
+ (let ((file (match-string 1 string))
+ (action (intern-soft
+ (tramp-compat-replace-regexp-in-string
+ "_" "-" (downcase (match-string 2 string))))))
(setq string (replace-match "" nil nil string))
;; File names are returned as URL paths. We must convert them.
(when (string-match ddu file)
@@ -998,103 +1097,40 @@ is no information where to trace the message.")
(and (file-directory-p (file-name-directory filename))
(file-writable-p (file-name-directory filename)))))))
-(defun tramp-gvfs-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
- "Like `insert-directory' for Tramp files."
- ;; gvfs-* output is hard to parse. So we let `ls-lisp' do the job.
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- (require 'ls-lisp)
- (let (ls-lisp-use-insert-directory-program)
- (tramp-run-real-handler
- 'insert-directory
- (list filename switches wildcard full-directory-p))))))
-
-(defun tramp-gvfs-handle-insert-file-contents
- (filename &optional visit beg end replace)
- "Like `insert-file-contents' for Tramp files."
- (barf-if-buffer-read-only)
- (setq filename (expand-file-name filename))
- (let (tmpfile result)
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error (list "File not found on remote host" filename))
-
- (setq tmpfile (file-local-copy filename)
- result (insert-file-contents tmpfile visit beg end replace)))
- ;; Save exit.
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (stringp tmpfile)
- (delete-file tmpfile)))
-
- ;; Result.
- (list filename (cadr result))))
-
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
+ (setq dir (directory-file-name (expand-file-name dir)))
(with-parsed-tramp-file-name dir nil
- (unless
- (apply
- 'tramp-gvfs-send-command v "gvfs-mkdir"
- (if parents
- (list "-p" (tramp-gvfs-url-file-name dir))
- (list (tramp-gvfs-url-file-name dir))))
- ;; Propagate the error.
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-directory-property v localname)
+ (save-match-data
+ (let ((ldir (file-name-directory dir)))
+ ;; Make missing directory parts. "gvfs-mkdir -p ..." does not
+ ;; work robust.
+ (when (and parents (not (file-directory-p ldir)))
+ (make-directory ldir parents))
+ ;; Just do it.
+ (unless (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
(defun tramp-gvfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename newname) nil
-
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))
-
- (if (or (and (tramp-tramp-file-p filename)
- (not (tramp-gvfs-file-name-p filename)))
- (and (tramp-tramp-file-p newname)
- (not (tramp-gvfs-file-name-p newname))))
-
- ;; We cannot move directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (rename-file filename tmpfile t)
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct move.
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
- (unless
- (tramp-gvfs-send-command
- v "gvfs-move"
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "Renaming failed, see buffer `%s' for details." (buffer-name)))))
-
- (when (file-remote-p filename)
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)))
-
- (when (file-remote-p newname)
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))))
+ ;; 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))
+ ;; At least one file a Tramp file?
+ (if (or (tramp-tramp-file-p filename)
+ (tramp-tramp-file-p newname))
+ (tramp-gvfs-do-copy-or-rename-file
+ 'rename filename newname ok-if-already-exists t t)
+ (tramp-run-real-handler
+ 'rename-file (list filename newname ok-if-already-exists))))
(defun tramp-gvfs-handle-write-region
- (start end filename &optional _append visit _lockname confirm)
+ (start end filename &optional append visit lockname confirm)
"Like `write-region' for Tramp files."
(with-parsed-tramp-file-name filename nil
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
@@ -1103,7 +1139,16 @@ is no information where to trace the message.")
(tramp-error v 'file-error "File not overwritten")))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (write-region start end tmpfile)
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
+ ;; We say `no-message' here because we don't want the visited file
+ ;; modtime data to be clobbered from the temp file. We call
+ ;; `set-visited-file-modtime' ourselves later on.
+ (tramp-run-real-handler
+ 'write-region
+ (if confirm ; don't pass this arg unless defined for backward compat.
+ (list start end tmpfile append 'no-message lockname confirm)
+ (list start end tmpfile append 'no-message lockname)))
(condition-case nil
(rename-file tmpfile filename 'ok-if-already-exists)
(error
@@ -1129,7 +1174,7 @@ is no information where to trace the message.")
(defun tramp-gvfs-url-file-name (filename)
"Return FILENAME in URL syntax."
;; "/" must NOT be hexlified.
- (let ((url-unreserved-chars (append '(?/) url-unreserved-chars))
+ (let ((url-unreserved-chars (cons ?/ url-unreserved-chars))
result)
(setq
result
@@ -1140,9 +1185,9 @@ is no information where to trace the message.")
(setq user
(concat (match-string 2 user) ";" (match-string 1 user))))
(url-parse-make-urlobj
- method (url-hexify-string user) nil
+ method (and user (url-hexify-string user)) nil
(tramp-file-name-real-host v) (tramp-file-name-port v)
- (url-hexify-string localname) nil nil t))
+ (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))))
@@ -1158,7 +1203,8 @@ is no information where to trace the message.")
(defun tramp-gvfs-file-name (object-path)
"Retrieve file name from D-Bus OBJECT-PATH."
(dbus-unescape-from-identifier
- (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path)))
+ (tramp-compat-replace-regexp-in-string
+ "^.*/\\([^/]+\\)$" "\\1" object-path)))
(defun tramp-bluez-address (device)
"Return bluetooth device address from a given bluetooth DEVICE name."
@@ -1201,10 +1247,14 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(zerop (logand flags tramp-gvfs-password-need-username))))
(setq user (read-string "User name: ")))
(when (and (zerop (length domain))
- (not (zerop (logand flags tramp-gvfs-password-need-domain))))
+ (not
+ (zerop (logand flags tramp-gvfs-password-need-domain))))
(setq domain (read-string "Domain name: ")))
(tramp-message l 6 "%S %S %S %d" message user domain flags)
+ (unless (tramp-get-connection-property l "first-password-request" nil)
+ (tramp-clear-passwd l))
+
(setq tramp-current-method l-method
tramp-current-user user
tramp-current-host l-host
@@ -1289,12 +1339,14 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(cadr (assoc "port" (cadr mount-spec)))))
(ssl (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "ssl" (cadr mount-spec)))))
- (prefix (concat (tramp-gvfs-dbus-byte-array-to-string
- (car mount-spec))
- (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "share" (cadr mount-spec)))))))
- (when (string-match "^smb" method)
- (setq method "smb"))
+ (prefix (concat
+ (tramp-gvfs-dbus-byte-array-to-string
+ (car mount-spec))
+ (tramp-gvfs-dbus-byte-array-to-string
+ (or (cadr (assoc "share" (cadr mount-spec)))
+ (cadr (assoc "volume" (cadr mount-spec))))))))
+ (when (string-match "^\\(afp\\|smb\\)" method)
+ (setq method (match-string 1 method)))
(when (string-equal "obex" method)
(setq host (tramp-bluez-device host)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
@@ -1371,12 +1423,15 @@ ADDRESS can have the form \"xx:xx:xx:xx:xx:xx\" or \"[xx:xx:xx:xx:xx:xx]\"."
(cadr (assoc "port" (cadr mount-spec)))))
(ssl (tramp-gvfs-dbus-byte-array-to-string
(cadr (assoc "ssl" (cadr mount-spec)))))
- (prefix (concat (tramp-gvfs-dbus-byte-array-to-string
- (car mount-spec))
- (tramp-gvfs-dbus-byte-array-to-string
- (cadr (assoc "share" (cadr mount-spec)))))))
- (when (string-match "^smb" method)
- (setq method "smb"))
+ (prefix (concat
+ (tramp-gvfs-dbus-byte-array-to-string
+ (car mount-spec))
+ (tramp-gvfs-dbus-byte-array-to-string
+ (or
+ (cadr (assoc "share" (cadr mount-spec)))
+ (cadr (assoc "volume" (cadr mount-spec))))))))
+ (when (string-match "^\\(afp\\|smb\\)" method)
+ (setq method (match-string 1 method)))
(when (string-equal "obex" method)
(setq host (tramp-bluez-device host)))
(when (and (string-equal "dav" method) (string-equal "true" ssl))
@@ -1416,48 +1471,43 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
(host (tramp-file-name-real-host vec))
(port (tramp-file-name-port vec))
(localname (tramp-file-name-localname vec))
- (ssl (if (string-match "^davs" method) "true" "false"))
- (mount-spec '(:array))
- (mount-pref "/"))
-
- (setq
- mount-spec
- (append
- mount-spec
- (cond
- ((string-equal "smb" method)
- (string-match "^/?\\([^/]+\\)" localname)
- (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
- (tramp-gvfs-mount-spec-entry "server" host)
- (tramp-gvfs-mount-spec-entry "share" (match-string 1 localname))))
- ((string-equal "obex" method)
- (list (tramp-gvfs-mount-spec-entry "type" method)
- (tramp-gvfs-mount-spec-entry
- "host" (concat "[" (tramp-bluez-address host) "]"))))
- ((string-match "^dav" method)
- (list (tramp-gvfs-mount-spec-entry "type" "dav")
- (tramp-gvfs-mount-spec-entry "host" host)
- (tramp-gvfs-mount-spec-entry "ssl" ssl)))
- (t
- (list (tramp-gvfs-mount-spec-entry "type" method)
- (tramp-gvfs-mount-spec-entry "host" host))))))
-
- (when user
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "user" user) 'append))
-
- (when domain
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "domain" domain) 'append))
-
- (when port
- (add-to-list
- 'mount-spec (tramp-gvfs-mount-spec-entry "port" (number-to-string port))
- 'append))
-
- (when (and (string-match "^dav" method)
- (string-match "^/?[^/]+" localname))
- (setq mount-pref (match-string 0 localname)))
+ (share (when (string-match "^/?\\([^/]+\\)" localname)
+ (match-string 1 localname)))
+ (ssl (when (string-match "^davs" method) "true" "false"))
+ (mount-spec
+ `(:array
+ ,@(cond
+ ((string-equal "smb" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "smb-share")
+ (tramp-gvfs-mount-spec-entry "server" host)
+ (tramp-gvfs-mount-spec-entry "share" share)))
+ ((string-equal "obex" method)
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry
+ "host" (concat "[" (tramp-bluez-address host) "]"))))
+ ((string-match "\\`dav" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "dav")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "ssl" ssl)))
+ ((string-equal "afp" method)
+ (list (tramp-gvfs-mount-spec-entry "type" "afp-volume")
+ (tramp-gvfs-mount-spec-entry "host" host)
+ (tramp-gvfs-mount-spec-entry "volume" share)))
+ (t
+ (list (tramp-gvfs-mount-spec-entry "type" method)
+ (tramp-gvfs-mount-spec-entry "host" host))))
+ ,@(when user
+ (list (tramp-gvfs-mount-spec-entry "user" user)))
+ ,@(when domain
+ (list (tramp-gvfs-mount-spec-entry "domain" domain)))
+ ,@(when port
+ (list (tramp-gvfs-mount-spec-entry
+ "port" (number-to-string port))))))
+ (mount-pref
+ (if (and (string-match "\\`dav" method)
+ (string-match "^/?[^/]+" localname))
+ (match-string 0 localname)
+ "/")))
;; Return.
`(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec)))
@@ -1469,6 +1519,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"."
"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."
+ (tramp-check-proper-method-and-host vec)
;; We set the file name, in case there are incoming D-Bus signals or
;; D-Bus errors.
@@ -1497,13 +1548,17 @@ connection if a previous connection has died for some reason."
(string-equal localname "/"))
(tramp-error vec 'file-error "Filename must contain a Windows share"))
+ (when (and (string-equal method "afp")
+ (string-equal localname "/"))
+ (tramp-error vec 'file-error "Filename must contain an AFP volume"))
+
(with-tramp-progress-reporter
vec 3
(if (zerop (length user))
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
- ;; Enable auth-source and password-cache.
+ ;; Enable `auth-source'.
(tramp-set-connection-property vec "first-password-request" t)
;; There will be a callback of "askPassword" when a password is
@@ -1546,7 +1601,7 @@ connection if a previous connection has died for some reason."
;; indicated by the "mounted" signal, i.e. the "fuse-mountpoint"
;; file property.
(with-timeout
- ((or (tramp-get-method-parameter method 'tramp-connection-timeout)
+ ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
tramp-connection-timeout)
(if (zerop (length (tramp-file-name-user vec)))
(tramp-error
@@ -1562,32 +1617,28 @@ connection if a previous connection has died for some reason."
;; is marked with the fuse-mountpoint "/". We shall react.
(when (string-equal
(tramp-get-file-property vec "/" "fuse-mountpoint" "") "/")
- (tramp-error vec 'file-error "FUSE mount denied"))
-
- ;; In `tramp-check-cached-permissions', the connection
- ;; properties {uig,gid}-{integer,string} are used. We set
- ;; them to their local counterparts.
- (tramp-set-connection-property
- vec "uid-integer" (tramp-get-local-uid 'integer))
- (tramp-set-connection-property
- vec "gid-integer" (tramp-get-local-gid 'integer))
- (tramp-set-connection-property
- vec "uid-string" (tramp-get-local-uid 'string))
- (tramp-set-connection-property
- vec "gid-string" (tramp-get-local-gid 'string))))))
+ (tramp-error vec 'file-error "FUSE mount denied")))))
+
+ ;; In `tramp-check-cached-permissions', the connection properties
+ ;; {uig,gid}-{integer,string} are used. We set them to their local
+ ;; counterparts.
+ (with-tramp-connection-property
+ vec "uid-integer" (tramp-get-local-uid 'integer))
+ (with-tramp-connection-property
+ vec "gid-integer" (tramp-get-local-gid 'integer))
+ (with-tramp-connection-property
+ vec "uid-string" (tramp-get-local-uid 'string))
+ (with-tramp-connection-property
+ vec "gid-string" (tramp-get-local-gid 'string)))
(defun tramp-gvfs-send-command (vec command &rest args)
"Send the COMMAND with its ARGS to connection VEC.
COMMAND is usually a command from the gvfs-* utilities.
-`call-process' is applied, and it returns `t' if the return code is zero."
- (let (result)
- (with-current-buffer (tramp-get-connection-buffer vec)
- (tramp-gvfs-maybe-open-connection vec)
- (erase-buffer)
- (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " "))
- (setq result (apply 'tramp-call-process command nil t nil args))
- (tramp-message vec 6 "\n%s" (buffer-string))
- (zerop result))))
+`call-process' is applied, and it returns t if the return code is zero."
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-gvfs-maybe-open-connection vec)
+ (erase-buffer)
+ (zerop (apply 'tramp-call-process vec command nil t nil args))))
;; D-Bus BLUEZ functions.
@@ -1637,9 +1688,10 @@ be used."
:system tramp-bluez-service (dbus-event-path-name last-input-event)
tramp-bluez-interface-adapter "StopDiscovery")))))
-(dbus-register-signal
- :system nil nil tramp-bluez-interface-adapter "PropertyChanged"
- 'tramp-bluez-property-changed)
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :system nil nil tramp-bluez-interface-adapter "PropertyChanged"
+ 'tramp-bluez-property-changed))
(defun tramp-bluez-device-found (device args)
"Signal handler for the \"org.bluez.Adapter.DeviceFound\" signal."
@@ -1650,9 +1702,10 @@ be used."
;; device, and call also SDP in order to find the obex service.
(add-to-list 'tramp-bluez-devices (list alias address))))
-(dbus-register-signal
- :system nil nil tramp-bluez-interface-adapter "DeviceFound"
- 'tramp-bluez-device-found)
+(when tramp-gvfs-enabled
+ (dbus-register-signal
+ :system nil nil tramp-bluez-interface-adapter "DeviceFound"
+ 'tramp-bluez-device-found))
(defun tramp-bluez-parse-device-names (_ignore)
"Return a list of (nil host) tuples allowed to access."
@@ -1661,19 +1714,20 @@ be used."
(tramp-bluez-list-devices)))
;; Add completion function for OBEX method.
-(when (member tramp-bluez-service (dbus-list-known-names :system))
+(when (and tramp-gvfs-enabled
+ (member tramp-bluez-service (dbus-list-known-names :system)))
(tramp-set-completion-function
"obex" '((tramp-bluez-parse-device-names ""))))
;; D-Bus zeroconf functions.
-(defun tramp-zeroconf-parse-workstation-device-names (_ignore)
+(defun tramp-zeroconf-parse-service-device-names (service)
"Return a list of (user host) tuples allowed to access."
(mapcar
(lambda (x)
(list nil (zeroconf-service-host x)))
- (zeroconf-list-services "_workstation._tcp")))
+ (zeroconf-list-services service)))
(defun tramp-zeroconf-parse-webdav-device-names (_ignore)
"Return a list of (user host) tuples allowed to access."
@@ -1693,15 +1747,20 @@ be used."
(list user host)))
(zeroconf-list-services "_webdav._tcp")))
-;; Add completion function for DAV and DAVS methods.
-(when (member zeroconf-service-avahi (dbus-list-known-names :system))
+;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods.
+(when (and tramp-gvfs-enabled
+ (member zeroconf-service-avahi (dbus-list-known-names :system)))
(zeroconf-init tramp-gvfs-zeroconf-domain)
(tramp-set-completion-function
- "sftp" '((tramp-zeroconf-parse-workstation-device-names "")))
+ "afp" '((tramp-zeroconf-parse-service-device-names "_afpovertcp._tcp")))
(tramp-set-completion-function
"dav" '((tramp-zeroconf-parse-webdav-device-names "")))
(tramp-set-completion-function
- "davs" '((tramp-zeroconf-parse-webdav-device-names ""))))
+ "davs" '((tramp-zeroconf-parse-webdav-device-names "")))
+ (tramp-set-completion-function
+ "sftp" '((tramp-zeroconf-parse-service-device-names "_workstation._tcp")))
+ (tramp-set-completion-function
+ "smb" '((tramp-zeroconf-parse-service-device-names "_smb._tcp"))))
;; D-Bus SYNCE functions.
@@ -1717,11 +1776,13 @@ They are retrieved from the hal daemon."
(when (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
:system tramp-hal-service device tramp-hal-interface-device
"PropertyExists" "sync.plugin")
- (add-to-list
- 'tramp-synce-devices
- (with-tramp-dbus-call-method tramp-gvfs-dbus-event-vector t
- :system tramp-hal-service device tramp-hal-interface-device
- "GetPropertyString" "pda.pocketpc.name"))))
+ (let ((prop
+ (with-tramp-dbus-call-method
+ tramp-gvfs-dbus-event-vector t
+ :system tramp-hal-service device tramp-hal-interface-device
+ "GetPropertyString" "pda.pocketpc.name")))
+ (unless (member prop tramp-synce-devices)
+ (push prop tramp-synce-devices)))))
(tramp-message tramp-gvfs-dbus-event-vector 10 "%s" tramp-synce-devices)
tramp-synce-devices))
@@ -1732,8 +1793,9 @@ They are retrieved from the hal daemon."
(tramp-synce-list-devices)))
;; Add completion function for SYNCE method.
-(tramp-set-completion-function
- "synce" '((tramp-synce-parse-device-names "")))
+(when tramp-gvfs-enabled
+ (tramp-set-completion-function
+ "synce" '((tramp-synce-parse-device-names ""))))
(add-hook 'tramp-unload-hook
(lambda ()
@@ -1743,7 +1805,7 @@ They are retrieved from the hal daemon."
;;; TODO:
-;; * Host name completion via smb-server or smb-network.
+;; * Host name completion via afp-server, smb-server or smb-network.
;; * Check how two shares of the same SMB server can be mounted in
;; parallel.
;; * Apply SDP on bluetooth devices, in order to filter out obex
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index 53dbdbc45d4..5e22f6a3b59 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -1,6 +1,6 @@
;;; tramp-gw.el --- Tramp utility functions for HTTP tunnels and SOCKS gateways
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -96,7 +96,7 @@
(unless (memq (process-status proc) '(run open))
(tramp-message
tramp-gw-vector 4 "Deleting auxiliary process `%s'" tramp-gw-gw-proc)
- (let* (tramp-verbose
+ (let* ((tramp-verbose 0)
(p (tramp-get-connection-property proc "process" nil)))
(when (processp p) (delete-process p)))))
@@ -111,7 +111,7 @@
(tramp-compat-set-process-query-on-exit-flag proc nil)
;; We don't want debug messages, because the corresponding debug
;; buffer might be undecided.
- (let (tramp-verbose)
+ (let ((tramp-verbose 0))
(tramp-set-connection-property tramp-gw-gw-proc "process" proc)
(tramp-set-connection-property proc "process" tramp-gw-gw-proc))
;; Set the process-filter functions for both processes.
@@ -125,9 +125,12 @@
(tramp-gw-process-filter tramp-gw-gw-proc s))))))
(defun tramp-gw-process-filter (proc string)
- (let (tramp-verbose)
- (process-send-string
- (tramp-get-connection-property proc "process" nil) string)))
+ (let ((tramp-verbose 0))
+ ;; The other process might have been stopped already. We don't
+ ;; want to be interrupted then.
+ (ignore-errors
+ (process-send-string
+ (tramp-get-connection-property proc "process" nil) string))))
;;;###tramp-autoload
(defun tramp-gw-open-connection (vec gw-vec target-vec)
@@ -195,11 +198,12 @@ instead of the host name declared in TARGET-VEC."
(setq tramp-gw-gw-proc
(funcall
socks-function
- (tramp-get-connection-name gw-vec)
- (tramp-get-connection-buffer gw-vec)
+ (let ((tramp-verbose 0)) (tramp-get-connection-name gw-vec))
+ (let ((tramp-verbose 0)) (tramp-get-connection-buffer gw-vec))
(tramp-file-name-real-host target-vec)
(tramp-file-name-port target-vec)))
(set-process-sentinel tramp-gw-gw-proc 'tramp-gw-gw-proc-sentinel)
+ (set-process-coding-system tramp-gw-gw-proc 'binary 'binary)
(tramp-compat-set-process-query-on-exit-flag tramp-gw-gw-proc nil)
(tramp-message
vec 4 "Opened %s process `%s'"
@@ -238,14 +242,14 @@ authentication is requested from proxy server, provide it."
tramp-gw-vector 6 "\n%s"
(format
"%s%s\r\n" command
- (replace-regexp-in-string ;; no password in trace!
+ (tramp-compat-replace-regexp-in-string ;; no password in trace!
"Basic [^\r\n]+" "Basic xxxxx" authentication t)))
(with-current-buffer buffer
;; Trap errors to be traced in the right trace buffer. Often,
;; proxies have a timeout of 60". We wait 65" in order to
;; receive an answer this case.
(ignore-errors
- (let (tramp-verbose)
+ (let ((tramp-verbose 0))
(tramp-wait-for-regexp proc 65 "\r?\n\r?\n")))
;; Check return code.
(goto-char (point-min))
@@ -260,6 +264,10 @@ authentication is requested from proxy server, provide it."
(200 (setq found t))
;; We need basic authentication.
(401 (setq authentication (tramp-gw-basic-authentication nil first)))
+ ;; Access forbidden.
+ (403 (tramp-error-with-buffer
+ (current-buffer) tramp-gw-vector 'file-error
+ "Connection to %s:%d forbidden." host service))
;; Target host not found.
(404 (tramp-error-with-buffer
(current-buffer) tramp-gw-vector 'file-error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e41ed36f597..1753c73f869 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1,6 +1,6 @@
;;; tramp-sh.el --- Tramp access functions for (s)sh-like connections
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; (copyright statements below in code to be updated with the above notice)
@@ -35,7 +35,12 @@
(defvar directory-sep-char)
(defvar tramp-gw-tunnel-method)
(defvar tramp-gw-socks-method)
+(defvar vc-handled-backends)
+(defvar vc-bzr-program)
+(defvar vc-git-program)
+(defvar vc-hg-program)
+;;;###tramp-autoload
(defcustom tramp-inline-compress-start-size 4096
"The minimum size of compressing where inline transfer.
When inline transfer, compress transferred data of file
@@ -44,6 +49,7 @@ If it is nil, no compression at all will be applied."
:group 'tramp
:type '(choice (const nil) integer))
+;;;###tramp-autoload
(defcustom tramp-copy-size-limit 10240
"The maximum file size where inline copying is preferred over an \
out-of-the-band copy.
@@ -60,6 +66,25 @@ files conditionalize this setup based on the TERM environment variable."
:group 'tramp
:type 'string)
+;;;###tramp-autoload
+(defcustom tramp-histfile-override ".tramp_history"
+ "When invoking a shell, override the HISTFILE with this value.
+When setting to a string, it redirects the shell history to that
+file. Be careful when setting to \"/dev/null\"; this might
+result in undesired results when using \"bash\" as shell.
+
+The value t, the default value, unsets any setting of HISTFILE,
+and sets both HISTFILESIZE and HISTSIZE to 0. If you set this
+variable to nil, however, the *override* is disabled, so the
+history will go to the default storage location,
+e.g. \"$HOME/.sh_history\"."
+ :group 'tramp
+ :version "25.1"
+ :type '(choice (const :tag "Do not override HISTFILE" nil)
+ (const :tag "Unset HISTFILE" t)
+ (string :tag "Redirect to a file")))
+
+;;;###tramp-autoload
(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m"
"Escape sequences produced by the \"ls\" command.")
@@ -72,13 +97,37 @@ files conditionalize this setup based on the TERM environment variable."
"///%s#$"
(md5 (concat (prin1-to-string process-environment) (current-time-string))))
"String used to recognize end of output.
-The '$' character at the end is quoted; the string cannot be
+The `$' character at the end is quoted; the string cannot be
detected as prompt when being sent on echoing hosts, therefore.")
;;;###tramp-autoload
(defconst tramp-initial-end-of-output "#$ "
"Prompt when establishing a connection.")
+(defconst tramp-end-of-heredoc (md5 tramp-end-of-output)
+ "String used to recognize end of heredoc strings.")
+
+;;;###tramp-autoload
+(defcustom tramp-use-ssh-controlmaster-options t
+ "Whether to use `tramp-ssh-controlmaster-options'."
+ :group 'tramp
+ :version "24.4"
+ :type 'boolean)
+
+(defvar tramp-ssh-controlmaster-options nil
+ "Which ssh Control* arguments to use.
+
+If it is a string, it should have the form
+\"-o ControlMaster=auto -o ControlPath='tramp.%%r@%%h:%%p'
+-o ControlPersist=no\". Percent characters in the ControlPath
+spec must be doubled, because the string is used as format string.
+
+Otherwise, it will be auto-detected by Tramp, if
+`tramp-use-ssh-controlmaster-options' is non-nil. The value
+depends on the installed local ssh version.
+
+The string is used in `tramp-methods'.")
+
;; Initialize `tramp-methods' with the supported methods.
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -86,6 +135,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "rsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "rcp")
(tramp-copy-args (("-p" "%k") ("-r")))
@@ -97,6 +147,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "remsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "rcp")
(tramp-copy-args (("-p" "%k")))
@@ -109,6 +160,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k") ("-q") ("-r") ("%c")))
@@ -126,6 +178,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
("-e" "none") ("-t" "-t") ("%h") ("/bin/sh")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "scp")
(tramp-copy-args (("-P" "%p") ("-p" "%k")
@@ -138,23 +191,13 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("sftp"
- (tramp-login-program "ssh")
- (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
- ("-e" "none") ("%h")))
- (tramp-async-args (("-q")))
- (tramp-remote-shell "/bin/sh")
- (tramp-remote-shell-args ("-c"))
- (tramp-copy-program "sftp")
- (tramp-copy-args ("%c"))))
- ;;;###tramp-autoload
-(add-to-list 'tramp-methods
'("rsync"
(tramp-login-program "ssh")
(tramp-login-args (("-l" "%u") ("-p" "%p") ("%c")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "rsync")
(tramp-copy-args (("-t" "%k") ("-r")))
@@ -168,6 +211,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "rsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -175,6 +219,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "remsh")
(tramp-login-args (("%h") ("-l" "%u")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -184,6 +229,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
("-e" "none") ("%h")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
("-o" "UserKnownHostsFile=/dev/null")
@@ -197,6 +243,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
("-e" "none") ("-t" "-t") ("%h") ("/bin/sh")))
(tramp-async-args (("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-gw-args (("-o" "GlobalKnownHostsFile=/dev/null")
("-o" "UserKnownHostsFile=/dev/null")
@@ -206,9 +253,27 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-methods
'("telnet"
(tramp-login-program "telnet")
- (tramp-login-args (("%h") ("%p")))
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
+ (tramp-remote-shell-args ("-c"))
+ (tramp-default-port 23)))
+;;;###tramp-autoload
+(add-to-list 'tramp-methods
+ '("nc"
+ (tramp-login-program "telnet")
+ (tramp-login-args (("%h") ("%p") ("2>/dev/null")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
+ (tramp-copy-program "nc")
+ ;; We use "-v" for better error tracking.
+ (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r")))
+ (tramp-remote-copy-program "nc")
+ ;; We use "-p" as required for newer busyboxes. For older
+ ;; busybox/nc versions, the value must be (("-l") ("%r")). This
+ ;; can be achieved by tweaking `tramp-connection-properties'.
+ (tramp-remote-copy-args (("-l") ("-p" "%r") ("2>/dev/null")))
(tramp-default-port 23)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
@@ -216,14 +281,21 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "su")
(tramp-login-args (("-") ("%u")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
'("sudo"
(tramp-login-program "sudo")
- (tramp-login-args (("-u" "%u") ("-s") ("-H") ("-p" "Password:")))
+ ;; The password template must be masked. Otherwise, it could be
+ ;; interpreted as password prompt if the remote host echoes the command.
+ (tramp-login-args (("-u" "%u") ("-s") ("-H")
+ ("-p" "P\"\"a\"\"s\"\"s\"\"w\"\"o\"\"r\"\"d\"\":")))
+ ;; Local $SHELL could be a nasty one, like zsh or fish. Let's override it.
+ (tramp-login-env (("SHELL") ("/bin/sh")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
;;;###tramp-autoload
@@ -232,6 +304,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "ksu")
(tramp-login-args (("%u") ("-q")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
;;;###tramp-autoload
@@ -240,35 +313,50 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "krlogin")
(tramp-login-args (("%h") ("-l" "%u") ("-x")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("plink"
+ `("plink"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ ;; ("%h") must be a single element, see `tramp-compute-multi-hops'.
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
`("plinkx"
(tramp-login-program "plink")
- ;; ("%h") must be a single element, see
- ;; `tramp-compute-multi-hops'.
- (tramp-login-args (("-load") ("%h") ("-t")
+ (tramp-login-args (("-load") ("%h") ("-t") ("\"")
(,(format
"env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
tramp-terminal-type
tramp-initial-end-of-output))
- ("/bin/sh")))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("pscp"
+ `("pscp"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("-p" "%k")
@@ -278,10 +366,17 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-default-port 22)))
;;;###tramp-autoload
(add-to-list 'tramp-methods
- '("psftp"
+ `("psftp"
(tramp-login-program "plink")
- (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h")))
+ (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t")
+ ("%h") ("\"")
+ (,(format
+ "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'"
+ tramp-terminal-type
+ tramp-initial-end-of-output))
+ ("/bin/sh") ("\"")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("-p" "%k")
@@ -294,6 +389,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-login-program "fsh")
(tramp-login-args (("%h") ("-l" "%u") ("sh" "-i")))
(tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i") ("-c"))
(tramp-copy-program "fcp")
(tramp-copy-args (("-p" "%k")))
@@ -313,7 +409,8 @@ detected as prompt when being sent on echoing hosts, therefore.")
(add-to-list 'tramp-default-user-alist
`(,(concat
"\\`"
- (regexp-opt '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp"))
+ (regexp-opt
+ '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))
"\\'")
nil ,(user-login-name)))
@@ -364,7 +461,6 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh)
- (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh)
(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh)
@@ -372,6 +468,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh)
(tramp-set-completion-function
"telnet" tramp-completion-function-alist-telnet)
+ (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet)
(tramp-set-completion-function "su" tramp-completion-function-alist-su)
(tramp-set-completion-function "sudo" tramp-completion-function-alist-su)
(tramp-set-completion-function "ksu" tramp-completion-function-alist-su)
@@ -381,6 +478,7 @@ detected as prompt when being sent on echoing hosts, therefore.")
(tramp-set-completion-function
"plinkx" tramp-completion-function-alist-putty)
(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh)
+ (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh)
(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)))
;; "getconf PATH" yields:
@@ -419,11 +517,10 @@ as given in your `~/.profile'."
;;;###tramp-autoload
(defcustom tramp-remote-process-environment
- `("HISTFILE=$HOME/.tramp_history" "HISTSIZE=1" "TMOUT=0" "LC_ALL=C"
+ `("TMOUT=0" "LC_CTYPE=''"
,(format "TERM=%s" tramp-terminal-type)
- "EMACS=t" ;; Deprecated.
,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
- "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=\"\""
+ "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
"autocorrect=" "correct=")
"List of environment variables to be set on the remote host.
@@ -434,8 +531,10 @@ which might have been set in the init files like ~/.profile.
Special handling is applied to the PATH environment, which should
not be set here. Instead, it should be set via `tramp-remote-path'."
:group 'tramp
+ :version "24.4"
:type '(repeat string))
+;;;###tramp-autoload
(defcustom tramp-sh-extra-args '(("/bash\\'" . "-norc -noprofile"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
@@ -485,9 +584,9 @@ This list is used for copying/renaming with out-of-band methods.
See `tramp-actions-before-shell' for more info.")
(defconst tramp-uudecode
- "(echo begin 600 /tmp/tramp.$$; tail +2) | uudecode
-cat /tmp/tramp.$$
-rm -f /tmp/tramp.$$"
+ "(echo begin 600 %t; tail -n +2) | uudecode
+cat %t
+rm -f %t"
"Shell function to implement `uudecode' to standard output.
Many systems support `uudecode -o /dev/stdout' or `uudecode -o -'
for this or `uudecode -p', but some systems don't, and for them
@@ -578,6 +677,7 @@ if (!@stat) {
if (($stat[2] & 0170000) == 0120000)
{
$type = readlink($ARGV[0]);
+ $type =~ s/\"/\\\\\"/g;
$type = \"\\\"$type\\\"\";
}
elsif (($stat[2] & 0170000) == 040000)
@@ -627,6 +727,7 @@ for($i = 0; $i < $n; $i++)
if (($stat[2] & 0170000) == 0120000)
{
$type = readlink($filename);
+ $type =~ s/\"/\\\\\"/g;
$type = \"\\\"$type\\\"\";
}
elsif (($stat[2] & 0170000) == 040000)
@@ -639,6 +740,7 @@ for($i = 0; $i < $n; $i++)
};
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\";
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
+ $filename =~ s/\"/\\\\\"/g;
printf(
\"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
$filename,
@@ -685,7 +787,7 @@ on the remote host.")
(defconst tramp-perl-encode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2015 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -723,7 +825,7 @@ This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-perl-decode
"%s -e '
# This script contributed by Juanma Barranquero <lektu@terra.es>.
-# Copyright (C) 2002-2013 Free Software Foundation, Inc.
+# Copyright (C) 2002-2015 Free Software Foundation, Inc.
use strict;
my %%trans = do {
@@ -774,6 +876,78 @@ Escape sequence %s is replaced with name of Perl binary.")
"Perl program to use for decoding a file.
Escape sequence %s is replaced with name of Perl binary.")
+(defconst tramp-awk-encode
+ "od -v -t x1 -A n | busybox awk '\\
+BEGIN {
+ b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
+ b16 = \"0123456789abcdef\"
+}
+{
+ for (c=1; c<=length($0); c++) {
+ d=index(b16, substr($0,c,1))
+ if (d--) {
+ for (b=1; b<=4; b++) {
+ o=o*2+int(d/8); d=(d*2)%%16
+ if (++obc==6) {
+ printf substr(b64,o+1,1)
+ if (++rc>75) { printf \"\\n\"; rc=0 }
+ obc=0; o=0
+ }
+ }
+ }
+ }
+}
+END {
+ if (obc) {
+ tail=(obc==2) ? \"==\\n\" : \"=\\n\"
+ while (obc++<6) { o=o*2 }
+ printf \"%%c\", substr(b64,o+1,1)
+ } else {
+ tail=\"\\n\"
+ }
+ printf tail
+}'"
+ "Awk program to use for encoding a file.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-awk-decode
+ "busybox awk '\\
+BEGIN {
+ b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
+}
+{
+ for (i=1; i<=length($0); i++) {
+ c=index(b64, substr($0,i,1))
+ if(c--) {
+ for(b=0; b<6; b++) {
+ o=o*2+int(c/32); c=(c*2)%%64
+ if(++obc==8) {
+ if (o) {
+ printf \"%%c\", o
+ } else {
+ system(\"dd if=/dev/zero bs=1 count=1 2>/dev/null\")
+ }
+ obc=0; o=0
+ }
+ }
+ }
+ }
+}'"
+ "Awk program to use for decoding a file.
+This string is passed to `format', so percent characters need to be doubled.")
+
+(defconst tramp-awk-coding-test
+ "test -c /dev/zero && \
+od -v -t x1 -A n </dev/null && \
+busybox awk '{}' </dev/null"
+ "Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.")
+
+(defconst tramp-stat-marker "/////"
+ "Marker in stat commands for file attributes.")
+
+(defconst tramp-stat-quoted-marker "\\/\\/\\/\\/\\/"
+ "Quoted marker in stat commands for file attributes.")
+
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
while read file; do
@@ -834,6 +1008,7 @@ of command line.")
(file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-sh-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . tramp-sh-handle-file-ownership-preserved-p)
(file-readable-p . tramp-sh-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
@@ -850,7 +1025,7 @@ of command line.")
(insert-file-contents-literally
. tramp-sh-handle-insert-file-contents-literally)
(load . tramp-handle-load)
- (make-auto-save-file-name . tramp-sh-handle-make-auto-save-file-name)
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
@@ -934,20 +1109,25 @@ target of the symlink differ."
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-make-tramp-file-name method user host
+ (format
+ "%s%s"
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-make-tramp-file-name
+ method user host
(with-tramp-file-property v localname "file-truename"
(let ((result nil)) ; result steps in reverse order
(tramp-message v 4 "Finding true name for `%s'" filename)
(cond
;; Use GNU readlink --canonicalize-missing where available.
((tramp-get-remote-readlink v)
- (setq result
- (tramp-send-command-and-read
- v
- (format "echo \"\\\"`%s --canonicalize-missing %s`\\\"\""
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))))
+ (tramp-send-command-and-check
+ v
+ (format "%s --canonicalize-missing %s"
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (setq result (buffer-substring (point-min) (point-at-eol)))))
;; Use Perl implementation.
((and (tramp-get-remote-perl v)
@@ -1038,7 +1218,10 @@ target of the symlink differ."
(setq result (concat result "/"))))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))
+ result))))
+
+ ;; Preserve trailing "/".
+ (if (string-equal (file-name-nondirectory filename) "") "/" "")))
;; Basic functions.
@@ -1060,23 +1243,24 @@ target of the symlink differ."
(defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
(unless id-format (setq id-format 'integer))
- ;; Don't modify `last-coding-system-used' by accident.
- (let ((last-coding-system-used last-coding-system-used))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (with-tramp-file-property
- v localname (format "file-attributes-%s" id-format)
- (save-excursion
- (tramp-convert-file-attributes
- v
- (or
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-file-attributes-with-stat v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-file-attributes-with-perl v localname id-format))
- (t nil))
- ;; The scripts could fail, for example with huge file size.
- (tramp-do-file-attributes-with-ls v localname id-format))))))))
+ (ignore-errors
+ ;; Don't modify `last-coding-system-used' by accident.
+ (let ((last-coding-system-used last-coding-system-used))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-file-property
+ v localname (format "file-attributes-%s" id-format)
+ (save-excursion
+ (tramp-convert-file-attributes
+ v
+ (or
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-file-attributes-with-stat v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-file-attributes-with-perl v localname id-format))
+ (t nil))
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-do-file-attributes-with-ls v localname id-format)))))))))
(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using the ls(1) command."
@@ -1086,15 +1270,19 @@ target of the symlink differ."
(tramp-message vec 5 "file attributes with ls: %s" localname)
(tramp-send-command
vec
- (format "(%s %s || %s -h %s) && %s %s %s"
+ (format "(%s %s || %s -h %s) && %s %s %s %s"
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
+ ;; On systems which have no quoting style, file names
+ ;; with special characters could fail.
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ "--quoting-style=c" "")
(if (eq id-format 'integer) "-ildn" "-ild")
(tramp-shell-quote-argument localname)))
- ;; parse `ls -l' output ...
+ ;; Parse `ls -l' output ...
(with-current-buffer (tramp-get-buffer vec)
(when (> (buffer-size) 0)
(goto-char (point-min))
@@ -1133,11 +1321,14 @@ target of the symlink differ."
;; From the file modes, figure out other stuff.
(setq symlinkp (eq ?l (aref res-filemodes 0)))
(setq dirp (eq ?d (aref res-filemodes 0)))
- ;; if symlink, find out file name pointed to
+ ;; If symlink, find out file name pointed to.
(when symlinkp
(search-forward "-> ")
- (setq res-symlink-target (buffer-substring (point) (point-at-eol))))
- ;; return data gathered
+ (setq res-symlink-target
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ (read (current-buffer))
+ (buffer-substring (point) (point-at-eol)))))
+ ;; Return data gathered.
(list
;; 0. t for directory, string (name linked to) for symbolic
;; link, or nil.
@@ -1160,9 +1351,9 @@ target of the symlink differ."
;; 8. File modes, as a string of ten letters or dashes as in ls -l.
res-filemodes
;; 9. t if file's gid would change if file were deleted and
- ;; recreated. Will be set in `tramp-convert-file-attributes'
+ ;; recreated. Will be set in `tramp-convert-file-attributes'.
t
- ;; 10. inode number.
+ ;; 10. Inode number.
res-inode
;; 11. Device number. Will be replaced by a virtual device number.
-1
@@ -1186,17 +1377,28 @@ target of the symlink differ."
(tramp-send-command-and-read
vec
(format
- ;; On Opsware, pdksh (which is the true name of ksh there) doesn't
- ;; parse correctly the sequence "((". Therefore, we add a space.
- "( (%s %s || %s -h %s) && %s -c '((\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)' %s || echo nil)"
+ (concat
+ ;; On Opsware, pdksh (which is the true name of ksh there)
+ ;; doesn't parse correctly the sequence "((". Therefore, we add
+ ;; a space. 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 %s || %s -h %s) && (%s -c "
+ "'((%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0 -1)' "
+ "%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)")
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "\"%U\"")
- (if (eq id-format 'integer) "%ge0" "\"%G\"")
- (tramp-shell-quote-argument localname))))
+ tramp-stat-marker tramp-stat-marker
+ (if (eq id-format 'integer)
+ "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker))
+ (if (eq id-format 'integer)
+ "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker))
+ tramp-stat-marker tramp-stat-marker
+ (tramp-shell-quote-argument localname)
+ tramp-stat-quoted-marker)))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@@ -1224,8 +1426,7 @@ target of the symlink differ."
(format "%s -ild %s"
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
- (setq attr (buffer-substring (point)
- (progn (end-of-line) (point)))))
+ (setq attr (buffer-substring (point) (point-at-eol))))
(tramp-set-file-property
v localname "visited-file-modtime-ild" attr))
(when (boundp 'last-coding-system-used)
@@ -1234,14 +1435,14 @@ target of the symlink differ."
;; This function makes the same assumption as
;; `tramp-sh-handle-set-visited-file-modtime'.
-(defun tramp-sh-handle-verify-visited-file-modtime (buf)
+(defun tramp-sh-handle-verify-visited-file-modtime (&optional buf)
"Like `verify-visited-file-modtime' for Tramp files.
At the time `verify-visited-file-modtime' calls this function, we
already know that the buffer is visiting a file and that
`visited-file-modtime' does not return 0. Do not call this
function directly, unless those two cases are already taken care
of."
- (with-current-buffer buf
+ (with-current-buffer (or buf (current-buffer))
(let ((f (buffer-file-name)))
;; There is no file visiting the buffer, or the buffer has no
;; recorded last modification time, or there is no established
@@ -1276,8 +1477,7 @@ of."
(tramp-get-ls-command v)
(tramp-shell-quote-argument localname)))
(with-current-buffer (tramp-get-buffer v)
- (setq attr (buffer-substring
- (point) (progn (end-of-line) (point)))))
+ (setq attr (buffer-substring (point) (point-at-eol))))
(equal
attr
(tramp-get-file-property
@@ -1289,6 +1489,7 @@ of."
(defun tramp-sh-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-file-property v localname)
;; FIXME: extract the proper text from chmod's stderr.
(tramp-barf-unless-okay
@@ -1300,31 +1501,39 @@ of."
(defun tramp-sh-handle-set-file-times (filename &optional time)
"Like `set-file-times' for Tramp files."
- (if (file-remote-p filename)
+ (if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
- (tramp-flush-file-property v localname)
- (let ((time (if (or (null time) (equal time '(0 0)))
- (current-time)
- time))
- ;; With GNU Emacs, `format-time-string' has an optional
- ;; parameter UNIVERSAL. This is preferred, because we
- ;; could handle the case when the remote host is located
- ;; in a different time zone as the local host.
- (utc (not (featurep 'xemacs))))
- (tramp-send-command-and-check
- v (format "%s touch -t %s %s"
- (if utc "env TZ=UTC" "")
- (if utc
- (format-time-string "%Y%m%d%H%M.%S" time t)
- (format-time-string "%Y%m%d%H%M.%S" time))
- (tramp-shell-quote-argument localname)))))
+ (when (tramp-get-remote-touch v)
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (let ((time (if (or (null time) (equal time '(0 0)))
+ (current-time)
+ time))
+ ;; With GNU Emacs, `format-time-string' has an
+ ;; optional parameter UNIVERSAL. This is preferred,
+ ;; because we could handle the case when the remote
+ ;; host is located in a different time zone as the
+ ;; local host.
+ (utc (not (featurep 'xemacs))))
+ (tramp-send-command-and-check
+ v (format
+ "%s %s %s %s"
+ (if utc "env TZ=UTC" "")
+ (tramp-get-remote-touch v)
+ (if (tramp-get-connection-property v "touch-t" nil)
+ (format "-t %s"
+ (if utc
+ (format-time-string "%Y%m%d%H%M.%S" time t)
+ (format-time-string "%Y%m%d%H%M.%S" time)))
+ "")
+ (tramp-shell-quote-argument localname))))))
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
(zerop
(tramp-call-process
- "touch" nil nil nil "-t"
+ nil "touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
@@ -1339,7 +1548,7 @@ be non-negative integers."
;; the majority of cases.
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used))
- (if (file-remote-p filename)
+ (if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(if (and (zerop (user-uid)) (tramp-local-host-p v))
;; If we are root on the local host, we can do it directly.
@@ -1354,24 +1563,19 @@ be non-negative integers."
(tramp-shell-quote-argument localname))))))
;; We handle also the local part, because there doesn't exist
- ;; `set-file-uid-gid'. On W32 "chown" might not work.
- (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
- "chown" nil nil nil
- (format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
+ ;; `set-file-uid-gid'. On W32 "chown" might not work. We add a
+ ;; timeout for this.
+ (with-timeout (5 nil)
+ (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-shell-quote-argument filename)))))))
(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"
- (let ((result (tramp-find-executable
- vec "getenforce" (tramp-get-remote-path vec) t t)))
- (and result
- (string-equal
- (tramp-send-command-and-read
- vec (format "echo \\\"`%S`\\\"" result))
- "Enforcing")))))
+ (with-tramp-connection-property (tramp-get-connection-process vec) "selinux-p"
+ (tramp-send-command-and-check vec "selinuxenabled")))
(defun tramp-sh-handle-file-selinux-context (filename)
"Like `file-selinux-context' for Tramp files."
@@ -1397,24 +1601,25 @@ be non-negative integers."
(defun tramp-sh-handle-set-file-selinux-context (filename context)
"Like `set-file-selinux-context' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (if (and (consp context)
- (tramp-remote-selinux-p v)
- (tramp-send-command-and-check
- v (format "chcon %s %s %s %s %s"
- (if (stringp (nth 0 context))
- (format "--user=%s" (nth 0 context)) "")
- (if (stringp (nth 1 context))
- (format "--role=%s" (nth 1 context)) "")
- (if (stringp (nth 2 context))
- (format "--type=%s" (nth 2 context)) "")
- (if (stringp (nth 3 context))
- (format "--range=%s" (nth 3 context)) "")
- (tramp-shell-quote-argument localname))))
- (progn
- (tramp-set-file-property v localname "file-selinux-context" context)
- t)
- (tramp-set-file-property v localname "file-selinux-context" 'undef)
- nil)))
+ (when (and (consp context)
+ (tramp-remote-selinux-p v))
+ (let ((user (and (stringp (nth 0 context)) (nth 0 context)))
+ (role (and (stringp (nth 1 context)) (nth 1 context)))
+ (type (and (stringp (nth 2 context)) (nth 2 context)))
+ (range (and (stringp (nth 3 context)) (nth 3 context))))
+ (when (tramp-send-command-and-check
+ v (format "chcon %s %s %s %s %s"
+ (if user (format "--user=%s" user) "")
+ (if role (format "--role=%s" role) "")
+ (if type (format "--type=%s" type) "")
+ (if range (format "--range=%s" range) "")
+ (tramp-shell-quote-argument localname)))
+ (if (and user role type range)
+ (tramp-set-file-property
+ v localname "file-selinux-context" context)
+ (tramp-set-file-property
+ v localname "file-selinux-context" 'undef))
+ t)))))
(defun tramp-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
@@ -1428,7 +1633,7 @@ be non-negative integers."
(when (and (tramp-remote-acl-p v)
(tramp-send-command-and-check
v (format
- "getfacl -ac %s 2>/dev/null"
+ "getfacl -ac %s"
(tramp-shell-quote-argument localname))))
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-max))
@@ -1443,14 +1648,17 @@ be non-negative integers."
(if (and (stringp acl-string) (tramp-remote-acl-p v)
(progn
(tramp-send-command
- v (format "setfacl --set-file=- %s <<'EOF'\n%s\nEOF\n"
- (tramp-shell-quote-argument localname) acl-string))
+ v (format "setfacl --set-file=- %s <<'%s'\n%s\n%s\n"
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ acl-string
+ tramp-end-of-heredoc))
(tramp-send-command-and-check v nil)))
;; Success.
(progn
(tramp-set-file-property v localname "file-acl" acl-string)
t)
- ;; In case of errors, we return `nil'.
+ ;; In case of errors, we return nil.
(tramp-set-file-property v localname "file-acl-string" 'undef)
nil)))
@@ -1517,7 +1725,7 @@ be non-negative integers."
(defun tramp-sh-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
- ;; `file-directory-p' is used as predicate for filename completion.
+ ;; `file-directory-p' is used as predicate for file name completion.
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
@@ -1570,13 +1778,15 @@ be non-negative integers."
(lambda (x)
(cons (car x)
(tramp-convert-file-attributes v (cdr x))))
- (cond
- ((tramp-get-remote-stat v)
- (tramp-do-directory-files-and-attributes-with-stat
- v localname id-format))
- ((tramp-get-remote-perl v)
- (tramp-do-directory-files-and-attributes-with-perl
- v localname id-format)))))))))
+ (or
+ (cond
+ ((tramp-get-remote-stat v)
+ (tramp-do-directory-files-and-attributes-with-stat
+ v localname id-format))
+ ((tramp-get-remote-perl v)
+ (tramp-do-directory-files-and-attributes-with-perl
+ v localname id-format))
+ (t nil)))))))))
result item)
(while temp
@@ -1586,9 +1796,12 @@ be non-negative integers."
(setcar item (expand-file-name (car item) directory)))
(push item result)))
- (if nosort
- result
- (sort result (lambda (x y) (string< (car x) (car y))))))))
+ (or (if nosort
+ result
+ (sort result (lambda (x y) (string< (car x) (car y)))))
+ ;; The scripts could fail, for example with huge file size.
+ (tramp-handle-directory-files-and-attributes
+ directory full match nosort id-format)))))
(defun tramp-do-directory-files-and-attributes-with-perl
(vec localname &optional id-format)
@@ -1613,19 +1826,30 @@ be non-negative integers."
vec
(format
(concat
- ;; We must care about filenames with spaces, or starting with
+ ;; 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
- ;; quote the filenames via sed.
- "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | "
+ ;; but it does not work on all remote systems. 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 | "
"xargs %s -c "
- "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'"
- " 2>/dev/null); echo \")\"")
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0 -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 characters could fail.
+ (if (tramp-get-ls-command-with-quoting-style vec)
+ "--quoting-style=shell" "")
(tramp-get-remote-stat vec)
- (if (eq id-format 'integer) "%ue0" "\"%U\"")
- (if (eq id-format 'integer) "%ge0" "\"%G\""))))
+ tramp-stat-marker tramp-stat-marker
+ tramp-stat-marker tramp-stat-marker
+ (if (eq id-format 'integer)
+ "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker))
+ (if (eq id-format 'integer)
+ "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker))
+ tramp-stat-marker tramp-stat-marker
+ tramp-stat-quoted-marker)))
;; This function should return "foo/" for directories and "bar" for
;; files.
@@ -1639,15 +1863,15 @@ be non-negative integers."
(mapcar
'list
(or
- ;; Try cache entries for filename, filename with last
- ;; character removed, filename with last two characters
+ ;; Try cache entries for `filename', `filename' with last
+ ;; character removed, `filename' with last two characters
;; removed, ..., and finally the empty string - all
;; concatenated to the local directory name.
(let ((remote-file-name-inhibit-cache
(or remote-file-name-inhibit-cache
tramp-completion-reread-directory-timeout)))
- ;; This is inefficient for very long filenames, pity
+ ;; This is inefficient for very long file names, pity
;; `reduce' is not available...
(car
(apply
@@ -1696,7 +1920,7 @@ be non-negative integers."
1 0)))
(format (concat
- "(\\cd %s 2>&1 && (%s %s -a 2>/dev/null"
+ "(cd %s 2>&1 && (%s -a %s 2>/dev/null"
;; `ls' with wildcard might fail with `Argument
;; list too long' error in some corner cases; if
;; `ls' fails after `cd' succeeded, chances are
@@ -1704,14 +1928,14 @@ be non-negative integers."
;; wildcard. This will return "too many" entries
;; but that isn't harmful.
" || %s -a 2>/dev/null)"
- " | while read f; do"
+ " | 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)
;; When `filename' is empty, just `ls' without
- ;; filename argument is more efficient than `ls *'
+ ;; `filename' argument is more efficient than `ls *'
;; for very large directories and might avoid the
;; `Argument list too long' error.
;;
@@ -1720,7 +1944,7 @@ be non-negative integers."
;; sub-directories.
(if (zerop (length filename))
"."
- (concat (tramp-shell-quote-argument filename) "* -d"))
+ (format "-d %s*" (tramp-shell-quote-argument filename)))
(tramp-get-ls-command v)
(tramp-get-test-command v))))
@@ -1784,21 +2008,21 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
- (when (and (not ok-if-already-exists)
+ (when (and (numberp ok-if-already-exists)
(file-exists-p newname)
- (not (numberp ok-if-already-exists))
- (y-or-n-p
+ (yes-or-no-p
(format
"File %s already exists; make it a new name anyway? "
newname)))
(tramp-error
- v2 'file-error
- "add-name-to-file: file %s already exists" newname))
+ v2 'file-error "add-name-to-file: file %s already exists" newname))
+ (when ok-if-already-exists (setq ln (concat ln " -f")))
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(tramp-barf-unless-okay
v1
- (format "%s %s %s" ln (tramp-shell-quote-argument v1-localname)
+ (format "%s %s %s" ln
+ (tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))
"error with add-name-to-file, see buffer `%s' for details"
(buffer-name))))))
@@ -1831,18 +2055,20 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
'copy-file (list filename newname ok-if-already-exists keep-date)))))
(defun tramp-sh-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
(let ((t1 (tramp-tramp-file-p dirname))
(t2 (tramp-tramp-file-p newname)))
(with-parsed-tramp-file-name (if t1 dirname newname) nil
- (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+ (if (and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
;; When DIRNAME and NEWNAME are remote, they must have
;; the same method.
(or (null t1) (null t2)
(string-equal
(tramp-file-name-method (tramp-dissect-file-name dirname))
- (tramp-file-name-method (tramp-dissect-file-name newname)))))
+ (tramp-file-name-method
+ (tramp-dissect-file-name newname)))))
;; scp or rsync DTRT.
(progn
(setq dirname (directory-file-name (expand-file-name dirname))
@@ -1859,7 +2085,10 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
'copy dirname newname keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents)))
+ 'copy-directory
+ (if copy-contents
+ (list dirname newname keep-date parents copy-contents)
+ (list dirname newname keep-date parents))))
;; When newname did exist, we have wrong cached values.
(when t2
@@ -1945,7 +2174,7 @@ file names."
;; create a new buffer, insert the contents of the
;; source file into it, then write out the buffer to
;; the target file. The advantage is that it doesn't
- ;; matter which filename handlers are used for the
+ ;; matter which file name handlers are used for the
;; source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
@@ -1983,32 +2212,36 @@ file names."
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
- (tramp-flush-file-property v1 (file-name-directory localname))
- (tramp-flush-file-property v1 localname)))
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)))
;; When newname did exist, we have wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
- (tramp-flush-file-property v2 (file-name-directory localname))
- (tramp-flush-file-property v2 localname)))))))
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname)))))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname 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.
KEEP-DATE is non-nil if NEWNAME should have the same timestamp as FILENAME."
- (with-temp-buffer
- ;; We must disable multibyte, because binary data shall not be
- ;; converted.
- (set-buffer-multibyte nil)
- (let ((coding-system-for-read 'binary)
- (jka-compr-inhibit t))
- (insert-file-contents-literally filename))
- ;; We don't want the target file to be compressed, so we let-bind
- ;; `jka-compr-inhibit' to t.
- (let ((coding-system-for-write 'binary)
- (jka-compr-inhibit t))
- (write-region (point-min) (point-max) newname)))
+ ;; We must disable multibyte, because binary data shall not be
+ ;; converted. We don't want the target file to be compressed, so we
+ ;; let-bind `jka-compr-inhibit' to t. `epa-file-handler' shall not
+ ;; be called either. We remove `tramp-file-name-handler' from
+ ;; `inhibit-file-name-handlers'; otherwise the file name handler for
+ ;; `insert-file-contents' might be deactivated in some corner cases.
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (jka-compr-inhibit t)
+ (inhibit-file-name-operation 'write-region)
+ (inhibit-file-name-handlers
+ (cons 'epa-file-handler
+ (remq 'tramp-file-name-handler inhibit-file-name-handlers))))
+ (with-temp-file newname
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename)))
;; KEEP-DATE handling.
(when keep-date (set-file-times newname (nth 5 (file-attributes filename))))
;; Set the mode.
@@ -2077,6 +2310,12 @@ the uid and gid from FILENAME."
;; We can do it directly.
((let (file-name-handler-alist)
(and (file-readable-p localname1)
+ ;; No sticky bit when renaming.
+ (or (eq op 'copy)
+ (zerop
+ (logand
+ (file-modes (file-name-directory localname1))
+ (tramp-compat-octal-to-decimal "1000"))))
(file-writable-p (file-name-directory localname2))
(or (file-directory-p localname2)
(file-writable-p localname2))))
@@ -2170,19 +2409,19 @@ the uid and gid from FILENAME."
(set-file-modes newname file-modes))))))
(defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date)
- "Invoke rcp program to copy.
+ "Invoke `scp' program to copy.
The method used must be an out-of-band method."
(let* ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(orig-vec (tramp-dissect-file-name (if t1 filename newname)))
- copy-program copy-args copy-env copy-keep-date port spec
- options source target)
+ copy-program copy-args copy-env copy-keep-date port listener spec
+ options source target remote-copy-program remote-copy-args)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(if (and t1 t2)
;; Both are Tramp files. We shall optimize it when the
- ;; methods for filename and newname are the same.
+ ;; methods for FILENAME and NEWNAME are the same.
(let* ((dir-flag (file-directory-p filename))
(tmpfile (tramp-compat-make-temp-file localname dir-flag)))
(if dir-flag
@@ -2215,15 +2454,20 @@ The method used must be an out-of-band method."
(aset v 3 localname)
;; Check which ones of source and target are Tramp files.
- (setq source (if t1 (tramp-make-copy-program-file-name v) filename)
- target (funcall
+ (setq source (if t1
+ (tramp-make-copy-program-file-name v)
+ (shell-quote-argument filename))
+ target (if t2
+ (tramp-make-copy-program-file-name v)
+ (shell-quote-argument
+ (funcall
(if (and (file-directory-p filename)
(string-equal
(file-name-nondirectory filename)
(file-name-nondirectory newname)))
'file-name-directory
'identity)
- (if t2 (tramp-make-copy-program-file-name v) newname)))
+ newname))))
;; Check for host and port number. We cannot use
;; `tramp-file-name-port', because this returns also
@@ -2239,6 +2483,13 @@ The method used must be an out-of-band method."
(setq user (or (tramp-file-name-user v)
(tramp-get-connection-property v "login-as" nil)))
+ ;; Check for listener port.
+ (when (tramp-get-method-parameter v 'tramp-remote-copy-args)
+ (setq listener (number-to-string (+ 50000 (random 10000))))
+ (while
+ (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener))
+ (setq listener (number-to-string (+ 50000 (random 10000))))))
+
;; Compose copy command.
(setq host (or host "")
user (or user "")
@@ -2246,17 +2497,14 @@ The method used must be an out-of-band method."
spec (format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" ""))
- options (format-spec
- (if tramp-use-ssh-controlmaster-options
- tramp-ssh-controlmaster-options "")
- spec)
+ options (format-spec (tramp-ssh-controlmaster-options v) spec)
spec (format-spec-make
- ?h host ?u user ?p port ?c options
+ ?h host ?u user ?p port ?r listener ?c options
?k (if keep-date " " ""))
- copy-program (tramp-get-method-parameter
- method 'tramp-copy-program)
+ copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
- method 'tramp-copy-keep-date)
+ v 'tramp-copy-keep-date)
+
copy-args
(delete
;; " " has either been a replacement of "%k" (when
@@ -2264,14 +2512,13 @@ The method used must be an out-of-band method."
;; for the whole keep-date sublist.
" "
(dolist
- (x
- (tramp-get-method-parameter method 'tramp-copy-args)
- copy-args)
+ (x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
(setq copy-args
(append
copy-args
(let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
(if (member "" y) '(" ") y))))))
+
copy-env
(delq
nil
@@ -2279,12 +2526,50 @@ The method used must be an out-of-band method."
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) (mapconcat 'identity x " ")))
- (tramp-get-method-parameter method 'tramp-copy-env))))
+ (tramp-get-method-parameter v 'tramp-copy-env)))
+
+ remote-copy-program
+ (tramp-get-method-parameter v 'tramp-remote-copy-program))
+
+ (dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
+ (setq remote-copy-args
+ (append
+ remote-copy-args
+ (let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
+ (if (member "" y) '(" ") y)))))
- ;; Check for program.
+ ;; Check for local copy program.
(unless (executable-find copy-program)
(tramp-error
- v 'file-error "Cannot find copy program: %s" copy-program))
+ v 'file-error "Cannot find local copy program: %s" copy-program))
+
+ ;; Install listener on the remote side. The prompt must be
+ ;; consumed later on, when the process does not listen anymore.
+ (when remote-copy-program
+ (unless (with-tramp-connection-property
+ v (concat "remote-copy-program-" remote-copy-program)
+ (tramp-find-executable
+ v remote-copy-program (tramp-get-remote-path v)))
+ (tramp-error
+ v 'file-error
+ "Cannot find remote listener: %s" remote-copy-program))
+ (setq remote-copy-program
+ (mapconcat
+ 'identity
+ (append
+ (list remote-copy-program) remote-copy-args
+ (list (if t1 (concat "<" source) (concat ">" target)) "&"))
+ " "))
+ (tramp-send-command v remote-copy-program)
+ (with-timeout
+ (60 (tramp-error
+ v 'file-error
+ "Listener process not running on remote host: `%s'"
+ remote-copy-program))
+ (tramp-send-command v (format "netstat -l | grep -q :%s" listener))
+ (while (not (tramp-send-command-and-check v nil))
+ (tramp-send-command
+ v (format "netstat -l | grep -q :%s" listener)))))
(with-temp-buffer
(unwind-protect
@@ -2301,31 +2586,37 @@ The method used must be an out-of-band method."
(tramp-message
orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
(setenv (pop copy-env) (pop copy-env)))
+ (setq
+ copy-args
+ (append
+ copy-args
+ (if remote-copy-program
+ (list (if t1 (concat ">" target) (concat "<" source)))
+ (list source target))))
;; Use an asynchronous process. By this, password can
- ;; be handled. The default directory must be local, in
- ;; order to apply the correct `copy-program'. We don't
- ;; set a timeout, because the copying of large files can
- ;; last longer than 60 secs.
- (let ((p (let ((default-directory
- (tramp-compat-temporary-file-directory)))
- (apply 'start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- copy-program
- (append
- copy-args
- (list
- (shell-quote-argument source)
- (shell-quote-argument target)
- "&&" "echo" "tramp_exit_status" "0"
- "||" "echo" "tramp_exit_status" "1"))))))
+ ;; be handled. We don't set a timeout, because the
+ ;; copying of large files can last longer than 60
+ ;; secs.
+ (let ((p (apply 'start-process-shell-command
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ copy-program
+ (append
+ copy-args
+ (list "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))))
(tramp-message
orig-vec 6 "%s"
(mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" orig-vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
- (tramp-process-actions
- p v nil tramp-actions-copy-out-of-band)
+
+ ;; We must adapt `tramp-local-end-of-line' for
+ ;; sending the password.
+ (let ((tramp-local-end-of-line tramp-rsh-end-of-line))
+ (tramp-process-actions
+ p v nil tramp-actions-copy-out-of-band))
;; Check the return code.
(goto-char (point-max))
@@ -2333,7 +2624,8 @@ The method used must be an out-of-band method."
(re-search-backward "tramp_exit_status [0-9]+" nil t)
(tramp-error
orig-vec 'file-error
- "Couldn't find exit status of `%s'" (process-command p)))
+ "Couldn't find exit status of `%s'"
+ (mapconcat 'identity (process-command p) " ")))
(skip-chars-forward "^ ")
(unless (zerop (read (current-buffer)))
(forward-line -1)
@@ -2343,9 +2635,15 @@ The method used must be an out-of-band method."
(buffer-substring (point-min) (point-at-eol))))))
;; Reset the transfer process properties.
- (tramp-message orig-vec 6 "\n%s" (buffer-string))
(tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)))
+ (tramp-set-connection-property v "process-buffer" nil)
+ ;; Clear the remote prompt.
+ (when (and remote-copy-program
+ (not (tramp-send-command-and-check v nil)))
+ ;; Houston, we have a problem! Likely, the listener is
+ ;; still running, so let's clear everything (but the
+ ;; cached password).
+ (tramp-cleanup-connection v 'keep-debug 'keep-password))))
;; Handle KEEP-DATE argument.
(when (and keep-date (not copy-keep-date))
@@ -2381,7 +2679,7 @@ The method used must be an out-of-band method."
(tramp-flush-file-property v (file-name-directory localname))
(tramp-flush-directory-property v localname)
(tramp-barf-unless-okay
- v (format "%s %s"
+ v (format "cd / && %s %s"
(if recursive "rm -rf" "rmdir")
(tramp-shell-quote-argument localname))
"Couldn't delete %s" directory)))
@@ -2485,11 +2783,12 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
(with-parsed-tramp-file-name filename nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
- (tramp-run-real-handler
- 'insert-directory (list filename switches wildcard full-directory-p))
+ (tramp-handle-insert-directory
+ filename switches wildcard full-directory-p)
(when (stringp switches)
(setq switches (split-string switches)))
(when (and (member "--dired" switches)
@@ -2500,8 +2799,8 @@ This is like `dired-recursive-delete-directory' for Tramp files."
'file-name-nondirectory (list localname)))
(setq localname (tramp-run-real-handler
'file-name-directory (list localname))))
- (unless full-directory-p
- (setq switches (add-to-list 'switches "-d" 'append)))
+ (unless (or full-directory-p (member "-d" switches))
+ (setq switches (append switches '("-d"))))
(setq switches (mapconcat 'tramp-shell-quote-argument switches " "))
(when wildcard
(setq switches (concat switches " " wildcard)))
@@ -2511,13 +2810,10 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(if full-directory-p "yes" "no"))
;; If `full-directory-p', we just say `ls -l FILENAME'.
;; Else we chdir to the parent directory, then say `ls -ld BASENAME'.
- ;; "--dired" returns byte positions. Therefore, the file names
- ;; must be encoded, which is guaranteed by "LC_ALL=en_US.utf8
- ;; LC_CTYPE=''".
(if full-directory-p
(tramp-send-command
v
- (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+ (format "%s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if wildcard
@@ -2533,7 +2829,7 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(tramp-run-real-handler 'file-name-directory (list localname))))
(tramp-send-command
v
- (format "env LC_ALL=en_US.utf8 LC_CTYPE='' %s %s %s 2>/dev/null"
+ (format "%s %s %s 2>/dev/null"
(tramp-get-ls-command v)
switches
(if (or wildcard
@@ -2544,69 +2840,73 @@ This is like `dired-recursive-delete-directory' for Tramp files."
(tramp-shell-quote-argument
(tramp-run-real-handler
'file-name-nondirectory (list localname)))))))
- (let ((beg (point)))
- ;; We cannot use `insert-buffer-substring' because the Tramp
- ;; buffer changes its contents before insertion due to calling
- ;; `expand-file' and alike.
- (insert
- (with-current-buffer (tramp-get-buffer v)
- (buffer-string)))
-
- ;; Check for "--dired" output.
- (forward-line -2)
- (when (looking-at "//SUBDIRED//")
- (forward-line -1))
- (when (looking-at "//DIRED//\\s-+")
- (let ((databeg (match-end 0))
- (end (point-at-eol)))
- ;; Now read the numeric positions of file names.
- (goto-char databeg)
- (while (< (point) end)
- (let ((start (+ beg (read (current-buffer))))
- (end (+ beg (read (current-buffer)))))
- (if (memq (char-after end) '(?\n ?\ ))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t))))))
- ;; Remove trailing lines.
- (goto-char (point-at-bol))
- (while (looking-at "//")
- (forward-line 1)
- (delete-region (match-beginning 0) (point)))
-
- ;; Some busyboxes are reluctant to discard colors.
- (unless (string-match "color" (tramp-get-connection-property v "ls" ""))
- (goto-char beg)
- (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
- (replace-match "")))
-
- ;; Decode the output, it could be multibyte.
- (decode-coding-region
- beg (point-max)
- (or file-name-coding-system
- (and (boundp 'default-file-name-coding-system)
- (symbol-value 'default-file-name-coding-system))))
-
- ;; The inserted file could be from somewhere else.
- (when (and (not wildcard) (not full-directory-p))
- (goto-char (point-max))
- (when (file-symlink-p filename)
- (goto-char (search-backward "->" beg 'noerror)))
- (search-backward
- (if (zerop (length (file-name-nondirectory filename)))
- "."
- (file-name-nondirectory filename))
- beg 'noerror)
- (replace-match (file-relative-name filename) t))
- (goto-char (point-max))))))
+ (save-restriction
+ (let ((beg (point)))
+ (narrow-to-region (point) (point))
+ ;; We cannot use `insert-buffer-substring' because the Tramp
+ ;; buffer changes its contents before insertion due to calling
+ ;; `expand-file' and alike.
+ (insert
+ (with-current-buffer (tramp-get-buffer v)
+ (buffer-string)))
+
+ ;; Check for "--dired" output.
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (forward-line -1))
+ (when (looking-at "//DIRED//\\s-+")
+ (let ((databeg (match-end 0))
+ (end (point-at-eol)))
+ ;; Now read the numeric positions of file names.
+ (goto-char databeg)
+ (while (< (point) end)
+ (let ((start (+ beg (read (current-buffer))))
+ (end (+ beg (read (current-buffer)))))
+ (if (memq (char-after end) '(?\n ?\ ))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t))))))
+ ;; Remove trailing lines.
+ (goto-char (point-at-bol))
+ (while (looking-at "//")
+ (forward-line 1)
+ (delete-region (match-beginning 0) (point)))
+
+ ;; Some busyboxes are reluctant to discard colors.
+ (unless
+ (string-match "color" (tramp-get-connection-property v "ls" ""))
+ (goto-char beg)
+ (while (re-search-forward tramp-color-escape-sequence-regexp nil t)
+ (replace-match "")))
+
+ ;; Decode the output, it could be multibyte.
+ (decode-coding-region
+ beg (point-max)
+ (or file-name-coding-system
+ (and (boundp 'default-file-name-coding-system)
+ (symbol-value 'default-file-name-coding-system))))
+
+ ;; The inserted file could be from somewhere else.
+ (when (and (not wildcard) (not full-directory-p))
+ (goto-char (point-max))
+ (when (file-symlink-p filename)
+ (goto-char (search-backward "->" beg 'noerror)))
+ (search-backward
+ (if (zerop (length (file-name-nondirectory filename)))
+ "."
+ (file-name-nondirectory filename))
+ beg 'noerror)
+ (replace-match (file-relative-name filename) t))
+
+ (goto-char (point-max)))))))
;; Canonicalization of file names.
(defun tramp-sh-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files.
-If the localname part of the given filename starts with \"/../\" then
-the result will be a local, non-Tramp, filename."
- ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+If the localname part of the given file name starts with \"/../\" then
+the result will be a local, non-Tramp, file name."
+ ;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
@@ -2637,7 +2937,7 @@ the result will be a local, non-Tramp, filename."
(setq uname
(with-tramp-connection-property v uname
(tramp-send-command
- v (format "cd %s; pwd" (tramp-shell-quote-argument uname)))
+ v (format "cd %s && pwd" (tramp-shell-quote-argument uname)))
(with-current-buffer (tramp-get-buffer v)
(goto-char (point-min))
(buffer-substring (point) (point-at-eol)))))
@@ -2677,28 +2977,64 @@ the result will be a local, non-Tramp, filename."
;; connection has been setup.
(defun tramp-sh-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
- (with-parsed-tramp-file-name default-directory nil
- ;; When PROGRAM is nil, we just provide a tty.
- (let ((command
- (when (stringp program)
- (format "cd %s; exec env PS1=%s %s"
- (tramp-shell-quote-argument localname)
- ;; Use a human-friendly prompt, for example for `shell'.
- (tramp-shell-quote-argument
- (format "%s %s"
- (file-remote-p default-directory)
- tramp-initial-end-of-output))
- (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
- ;; `start-file-process' has been started several time in
- ;; `eshell' and friends.
- (tramp-current-connection nil))
+ (with-parsed-tramp-file-name (expand-file-name default-directory) nil
+ (let* (;; 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 "sh$" program)
+ (string-equal "-c" (car args))
+ (= (length args) 2)))
+ ;; 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
+ (tramp-file-name-method v)
+ (tramp-file-name-user v)
+ (tramp-file-name-host v)
+ (tramp-file-name-localname v))
+ tramp-initial-end-of-output))
+ ;; We use as environment the difference to toplevel
+ ;; `process-environment'.
+ env
+ (env
+ (dolist
+ (elt
+ (cons prompt (nreverse (copy-sequence process-environment)))
+ env)
+ (or (member elt (default-toplevel-value 'process-environment))
+ (setq env (cons elt env)))))
+ (command
+ (when (stringp program)
+ (format "cd %s && exec %s env %s %s"
+ (tramp-shell-quote-argument localname)
+ (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "")
+ (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
+ ;; `start-file-process' has been started several times in
+ ;; `eshell' and friends.
+ (tramp-current-connection nil))
(unless buffer
;; BUFFER can be nil. We use a temporary buffer.
@@ -2724,7 +3060,7 @@ the result will be a local, non-Tramp, filename."
;; `verify-visited-file-modtime'.
(let ((buffer-undo-list t)
(buffer-read-only nil)
- (mark (point)))
+ (mark (point-max)))
(clear-visited-file-modtime)
(narrow-to-region (point-max) (point-max))
;; We call `tramp-maybe-open-connection', in order
@@ -2771,10 +3107,20 @@ the result will be a local, non-Tramp, filename."
(error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil
- (let (command input tmpinput stderr tmpstderr outbuf ret)
+ (let (command env input tmpinput stderr tmpstderr outbuf ret)
;; Compute command.
(setq command (mapconcat 'tramp-shell-quote-argument
(cons program args) " "))
+ ;; We use as environment the difference to toplevel `process-environment'.
+ (setq env
+ (dolist (elt (nreverse (copy-sequence process-environment)) env)
+ (or (member elt (default-toplevel-value 'process-environment))
+ (setq env (cons elt env)))))
+ (when env
+ (setq command
+ (format
+ "env %s %s"
+ (mapconcat 'tramp-shell-quote-argument env " ") command)))
;; Determine input.
(if (null infile)
(setq input "/dev/null")
@@ -2834,18 +3180,18 @@ the result will be a local, non-Tramp, filename."
(unwind-protect
(setq ret
(if (tramp-send-command-and-check
- v (format "\\cd %s; %s"
+ v (format "cd %s && %s"
(tramp-shell-quote-argument localname)
command)
t t)
0 1))
- ;; We should show the output anyway.
+ ;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
(insert
(with-current-buffer (tramp-get-connection-buffer v)
(buffer-string))))
- (when display (display-buffer outbuf))))
+ (when (and display (get-buffer-window outbuf t)) (redisplay))))
;; When the user did interrupt, we should do it also. We use
;; return code -1 as marker.
(quit
@@ -2864,9 +3210,9 @@ the result will be a local, non-Tramp, filename."
(when tmpinput (delete-file tmpinput))
;; `process-file-side-effects' has been introduced with GNU
- ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
- ;; value `t'.
+ ;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(tramp-flush-directory-property v ""))
@@ -2901,28 +3247,27 @@ the result will be a local, non-Tramp, filename."
(save-excursion
(with-tramp-progress-reporter
v 3
- (format "Encoding remote file `%s' with `%s'" filename rem-enc)
+ (format-message "Encoding remote file `%s' with `%s'"
+ filename rem-enc)
(tramp-barf-unless-okay
v (format rem-enc (tramp-shell-quote-argument localname))
"Encoding remote file failed"))
(with-tramp-progress-reporter
- v 3 (format "Decoding local file `%s' with `%s'"
- tmpfile loc-dec)
+ v 3 (format-message "Decoding local file `%s' with `%s'"
+ tmpfile loc-dec)
(if (functionp loc-dec)
;; If local decoding is a function, we call it.
;; We must disable multibyte, because
;; `uudecode-decode-region' doesn't handle it
- ;; correctly.
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-buffer-substring (tramp-get-buffer v))
- (funcall loc-dec (point-min) (point-max))
- ;; Unset `file-name-handler-alist'. Otherwise,
- ;; epa-file gets confused.
- (let (file-name-handler-alist
- (coding-system-for-write 'binary))
- (write-region (point-min) (point-max) tmpfile)))
+ ;; correctly. Unset `file-name-handler-alist'.
+ ;; Otherwise, epa-file gets confused.
+ (let (file-name-handler-alist
+ (coding-system-for-write 'binary))
+ (with-temp-file tmpfile
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring (tramp-get-buffer v))
+ (funcall loc-dec (point-min) (point-max))))
;; If tramp-decoding-function is not defined for this
;; method, we invoke tramp-decoding-command instead.
@@ -2932,7 +3277,8 @@ the result will be a local, non-Tramp, filename."
(let (file-name-handler-alist
(coding-system-for-write 'binary))
(with-current-buffer (tramp-get-buffer v)
- (write-region (point-min) (point-max) tmpfile2)))
+ (write-region
+ (point-min) (point-max) tmpfile2 nil 'no-message)))
(unwind-protect
(tramp-call-local-coding-command
loc-dec tmpfile2 tmpfile)
@@ -2967,7 +3313,8 @@ the result will be a local, non-Tramp, filename."
(if (fboundp 'find-buffer-file-type)
(symbol-function 'find-buffer-file-type)
nil))
- (inhibit-file-name-handlers '(jka-compr-handler image-file-handler))
+ (inhibit-file-name-handlers
+ '(epa-file-handler image-file-handler jka-compr-handler))
(inhibit-file-name-operation 'insert-file-contents))
(unwind-protect
(progn
@@ -2978,48 +3325,6 @@ the result will be a local, non-Tramp, filename."
(fset 'find-buffer-file-type find-buffer-file-type-function)
(fmakunbound 'find-buffer-file-type)))))
-(defun tramp-sh-handle-make-auto-save-file-name ()
- "Like `make-auto-save-file-name' for Tramp files.
-Returns a file name in `tramp-auto-save-directory' for autosaving this file."
- (let ((tramp-auto-save-directory tramp-auto-save-directory)
- (buffer-file-name
- (tramp-subst-strs-in-string
- '(("_" . "|")
- ("/" . "_a")
- (":" . "_b")
- ("|" . "__")
- ("[" . "_l")
- ("]" . "_r"))
- (buffer-file-name))))
- ;; File name must be unique. This is ensured with Emacs 22 (see
- ;; UNIQUIFY element of `auto-save-file-name-transforms'); but for
- ;; all other cases we must do it ourselves.
- (when (boundp 'auto-save-file-name-transforms)
- (mapc
- (lambda (x)
- (when (and (string-match (car x) buffer-file-name)
- (not (car (cddr x))))
- (setq tramp-auto-save-directory
- (or tramp-auto-save-directory
- (tramp-compat-temporary-file-directory)))))
- (symbol-value 'auto-save-file-name-transforms)))
- ;; Create directory.
- (when tramp-auto-save-directory
- (setq buffer-file-name
- (expand-file-name buffer-file-name tramp-auto-save-directory))
- (unless (file-exists-p tramp-auto-save-directory)
- (make-directory tramp-auto-save-directory t)))
- ;; Run plain `make-auto-save-file-name'. There might be an advice when
- ;; it is not a magic file name operation (since Emacs 22).
- ;; We must deactivate it temporarily.
- (if (not (ad-is-active 'make-auto-save-file-name))
- (tramp-run-real-handler 'make-auto-save-file-name nil)
- ;; else
- (ad-deactivate 'make-auto-save-file-name)
- (prog1
- (tramp-run-real-handler 'make-auto-save-file-name nil)
- (ad-activate 'make-auto-save-file-name)))))
-
;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname confirm)
@@ -3106,7 +3411,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(symbol-value 'last-coding-system-used))))
;; The permissions of the temporary file should be set. If
- ;; filename does not exist (eq modes nil) it has been
+ ;; FILENAME does not exist (eq modes nil) it has been
;; renamed to the backup file. This case `save-buffer'
;; handles permissions.
;; Ensure that it is still readable.
@@ -3117,7 +3422,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
- ;; method uses an rcp program. If so, we call it.
+ ;; method uses an scp program. If so, we call it.
;; Otherwise, both encoding and decoding command must be
;; specified. However, if the method _also_ specifies an
;; encoding function, then that is used for encoding the
@@ -3132,8 +3437,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(if (and (not (stringp start))
(= (or end (point-max)) (point-max))
(= (or start (point-min)) (point-min))
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
+ (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
(progn
(setq tramp-temp-buffer-file-name tmpfile)
(condition-case err
@@ -3158,8 +3462,9 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(set-buffer-multibyte nil)
;; Use encoding function or command.
(with-tramp-progress-reporter
- v 3 (format "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
(if (functionp loc-enc)
;; The following `let' is a workaround for
;; the base64.el that comes with pgnus-0.84.
@@ -3188,16 +3493,19 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; writes to remote file. Because this happens on
;; the remote host, we cannot use the function.
(with-tramp-progress-reporter
- v 3 (format "Decoding remote file `%s' using `%s'"
- filename rem-dec)
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
(goto-char (point-max))
(unless (bolp) (newline))
(tramp-send-command
v
(format
- (concat rem-dec " <<'EOF'\n%sEOF")
+ (concat rem-dec " <<'%s'\n%s%s")
(tramp-shell-quote-argument localname)
- (buffer-string)))
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc))
(tramp-barf-unless-okay
v nil
"Couldn't write region to `%s', decode using `%s' failed"
@@ -3209,7 +3517,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(erase-buffer)
(and
;; cksum runs locally, if possible.
- (zerop (tramp-call-process "cksum" tmpfile t))
+ (zerop (tramp-call-process v "cksum" tmpfile t))
;; cksum runs remotely.
(tramp-send-command-and-check
v
@@ -3235,7 +3543,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(tramp-error
v 'file-error
(concat "Method `%s' should specify both encoding and "
- "decoding command or an rcp program")
+ "decoding command or an scp program")
method))))
;; Make `last-coding-system-used' have the right value.
@@ -3252,7 +3560,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(when (or (eq visit t) (stringp visit))
(let ((file-attr (tramp-compat-file-attributes filename 'integer)))
(set-visited-file-modtime
- ;; We must pass modtime explicitly, because filename can
+ ;; We must pass modtime explicitly, because FILENAME can
;; be different from (buffer-file-name), f.e. if
;; `file-precious-flag' is set.
(nth 5 file-attr))
@@ -3288,10 +3596,13 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(tramp-compat-with-temp-message ""
(with-parsed-tramp-file-name file nil
(with-tramp-progress-reporter
- v 3 (format "Checking `vc-registered' for %s" file)
+ v 3 (format-message "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We
- ;; cannot reuse the old cache entries, therefore.
+ ;; cannot reuse the old cache entries, therefore. In
+ ;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
+ ;; could also be a timestamp as `current-time' returns. This
+ ;; means invalidate all cache entries with an older timestamp.
(let (tramp-vc-registered-file-names
(remote-file-name-inhibit-cache (current-time))
(file-name-handler-alist
@@ -3312,22 +3623,53 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(dolist
(elt
- (tramp-send-command-and-read
- v
- (format
- "tramp_vc_registered_read_file_names <<'EOF'\n%s\nEOF\n"
- (mapconcat 'tramp-shell-quote-argument
- tramp-vc-registered-file-names
- "\n"))))
+ (ignore-errors
+ ;; We cannot use `tramp-send-command-and-read',
+ ;; because this does not cooperate well with
+ ;; heredoc documents.
+ (tramp-send-command
+ v
+ (format
+ "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
+ tramp-end-of-heredoc
+ (mapconcat 'tramp-shell-quote-argument
+ tramp-vc-registered-file-names
+ "\n")
+ tramp-end-of-heredoc))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ ;; Read the expression.
+ (goto-char (point-min))
+ (read (current-buffer)))))
(tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset
- ;; `process-file-side-effects' in order to keep the cache when
- ;; `process-file' calls appear.
- (let (process-file-side-effects)
+ ;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
+ ;; in order to keep the cache.
+ (let ((vc-handled-backends 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)
+ (not (with-tramp-connection-property v vc-bzr-program
+ (tramp-find-executable
+ 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)
+ (not (with-tramp-connection-property v vc-git-program
+ (tramp-find-executable
+ 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)
+ (not (with-tramp-connection-property v vc-hg-program
+ (tramp-find-executable
+ v vc-hg-program (tramp-get-remote-path v)))))
+ (setq vc-handled-backends (remq 'Hg vc-handled-backends)))
+ ;; Run.
(ignore-errors
(tramp-run-real-handler 'vc-registered (list file))))))))
@@ -3337,17 +3679,18 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
Fall back to normal file name handler if no Tramp handler exists."
(when (and tramp-locked (not tramp-locker))
(setq tramp-locked nil)
- (signal 'file-error (list "Forbidden reentrant call of Tramp")))
+ (tramp-error
+ (car-safe tramp-current-connection) 'file-error
+ "Forbidden reentrant call of Tramp"))
(let ((tl tramp-locked))
+ (setq tramp-locked t)
(unwind-protect
- (progn
- (setq tramp-locked t)
- (let ((tramp-locker t))
- (save-match-data
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (apply (cdr fn) args)
- (tramp-run-real-handler operation args))))))
+ (let ((tramp-locker t))
+ (save-match-data
+ (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if fn
+ (apply (cdr fn) args)
+ (tramp-run-real-handler operation args)))))
(setq tramp-locked tl))))
(defun tramp-vc-file-name-handler (operation &rest args)
@@ -3380,42 +3723,70 @@ Fall back to normal file name handler if no Tramp handler exists."
"Like `file-notify-add-watch' for Tramp files."
(setq file-name (expand-file-name file-name))
(with-parsed-tramp-file-name file-name nil
- (let* ((default-directory (file-name-directory file-name))
- command events filter p)
+ (let ((default-directory (file-name-directory file-name))
+ command events filter p sequence)
(cond
;; gvfs-monitor-dir.
((setq command (tramp-get-remote-gvfs-monitor-dir v))
- (setq filter 'tramp-sh-file-gvfs-monitor-dir-process-filter
- p (start-file-process
- "gvfs-monitor-dir" (generate-new-buffer " *gvfs-monitor-dir*")
- command localname)))
+ (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter
+ events
+ (cond
+ ((and (memq 'change flags) (memq 'attribute-change flags))
+ '(created changed changes-done-hint moved deleted
+ attribute-changed))
+ ((memq 'change flags)
+ '(created changed changes-done-hint moved deleted))
+ ((memq 'attribute-change flags) '(attribute-changed)))
+ sequence `(,command ,localname)))
;; inotifywait.
((setq command (tramp-get-remote-inotifywait v))
- (setq filter 'tramp-sh-file-inotifywait-process-filter
+ (setq filter 'tramp-sh-inotifywait-process-filter
events
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
- "create,modify,move,delete,attrib")
- ((memq 'change flags) "create,modify,move,delete")
- ((memq 'attribute-change flags) "attrib"))
- p (start-file-process
- "inotifywait" (generate-new-buffer " *inotifywait*")
- command "-mq" "-e" events localname)))
+ (concat "create,modify,move,moved_from,moved_to,move_self,"
+ "delete,delete_self,attrib,ignored"))
+ ((memq 'change flags)
+ (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)))
;; None.
(t (tramp-error
v 'file-notify-error
"No file notification program found on %s"
(file-remote-p file-name))))
+ ;; Start process.
+ (setq p (apply
+ 'start-file-process
+ (file-name-nondirectory command)
+ (generate-new-buffer
+ (format " *%s*" (file-name-nondirectory command)))
+ sequence))
;; Return the process object as watch-descriptor.
(if (not (processp p))
(tramp-error
- v 'file-notify-error "`%s' failed to start on remote host" command)
+ v 'file-notify-error
+ "`%s' failed to start on remote host"
+ (mapconcat 'identity sequence " "))
+ (tramp-message v 6 "Run `%s', %S" (mapconcat 'identity sequence " ") p)
+ (tramp-set-connection-property p "vector" v)
+ ;; Needed for `tramp-sh-gvfs-monitor-dir-process-filter'.
+ (tramp-compat-process-put p 'events events)
+ (tramp-compat-process-put p 'watch-name localname)
(tramp-compat-set-process-query-on-exit-flag p nil)
(set-process-filter p filter)
+ ;; There might be an error if the monitor is not supported.
+ ;; Give the filter a chance to read the output.
+ (tramp-accept-process-output p 1)
+ (unless (memq (process-status p) '(run open))
+ (tramp-error
+ v 'file-notify-error "Monitoring not supported for `%s'" file-name))
p))))
-(defun tramp-sh-file-gvfs-monitor-dir-process-filter (proc string)
- "Read output from \"gvfs-monitor-dir\" and add corresponding file-notify events."
+(defun tramp-sh-gvfs-monitor-dir-process-filter (proc string)
+ "Read output from \"gvfs-monitor-dir\" and add corresponding \
+file-notify events."
(let ((remote-prefix
(with-current-buffer (process-buffer proc)
(file-remote-p default-directory)))
@@ -3425,8 +3796,10 @@ Fall back to normal file name handler if no Tramp handler exists."
(tramp-message proc 6 "%S\n%s" proc string)
(setq string (concat rest-string string)
;; Attribute change is returned in unused wording.
- string (replace-regexp-in-string
+ string (tramp-compat-replace-regexp-in-string
"ATTRIB CHANGED" "ATTRIBUTE_CHANGED" string))
+ (when (string-match "Monitoring not supported" string)
+ (delete-process proc))
(while (string-match
(concat "^[\n\r]*"
@@ -3435,29 +3808,36 @@ Fall back to normal file name handler if no Tramp handler exists."
"\\(Other = \\([^\n\r]+\\)[\n\r]+\\)?"
"Event = \\([^[:blank:]]+\\)[\n\r]+")
string)
- (let ((object
- (list
- proc
- (intern-soft
- (replace-regexp-in-string
- "_" "-" (downcase (match-string 4 string))))
- ;; File names are returned as absolute paths. We must
- ;; add the remote prefix.
- (concat remote-prefix (match-string 1 string))
- (when (match-string 3 string)
- (concat remote-prefix (match-string 3 string))))))
+ (let* ((file (match-string 1 string))
+ (file1 (match-string 3 string))
+ (object
+ (list
+ proc
+ (intern-soft
+ (tramp-compat-replace-regexp-in-string
+ "_" "-" (downcase (match-string 4 string))))
+ ;; File names are returned as absolute paths. We must
+ ;; add the remote prefix.
+ (concat remote-prefix file)
+ (when file1 (concat remote-prefix file1)))))
(setq string (replace-match "" nil nil string))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (and (member (cadr object) '(moved deleted))
+ (string-equal
+ file (tramp-compat-process-get proc 'watch-name)))
+ (delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the callback directly.
- (tramp-compat-funcall 'file-notify-callback object)))
+ (when (member (cadr object) (tramp-compat-process-get proc 'events))
+ (tramp-compat-funcall 'file-notify-callback object))))
;; Save rest of the string.
(when (zerop (length string)) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(tramp-compat-process-put proc 'rest-string string)))
-(defun tramp-sh-file-inotifywait-process-filter (proc string)
+(defun tramp-sh-inotifywait-process-filter (proc string)
"Read output from \"inotifywait\" and add corresponding file-notify events."
(tramp-message proc 6 "%S\n%s" proc string)
(dolist (line (split-string string "[\n\r]+" 'omit-nulls))
@@ -3475,9 +3855,13 @@ Fall back to normal file name handler if no Tramp handler exists."
proc
(mapcar
(lambda (x)
- (intern-soft (replace-regexp-in-string "_" "-" (downcase x))))
+ (intern-soft
+ (tramp-compat-replace-regexp-in-string "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit-nulls))
(match-string 3 line))))
+ ;; Remove watch when file or directory to be watched is deleted.
+ (when (equal (cadr object) 'ignored)
+ (delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the callback directly.
@@ -3493,30 +3877,24 @@ Only send the definition if it has not already been done."
(let ((scripts (tramp-get-connection-property
(tramp-get-connection-process vec) "scripts" nil)))
(unless (member name scripts)
- (with-tramp-progress-reporter vec 5 (format "Sending script `%s'" name)
+ (with-tramp-progress-reporter
+ vec 5 (format-message "Sending script `%s'" name)
+ ;; In bash, leading TABs like in `tramp-vc-registered-read-file-names'
+ ;; could result in unwanted command expansion. Avoid this.
+ (setq script (tramp-compat-replace-regexp-in-string
+ (make-string 1 ?\t) (make-string 8 ? ) script))
;; The script could contain a call of Perl. This is masked with `%s'.
(when (and (string-match "%s" script)
(not (tramp-get-remote-perl vec)))
(tramp-error vec 'file-error "No Perl available on remote host"))
(tramp-barf-unless-okay
vec
- (format "%s () {\n%s\n}" name
- (format script (tramp-get-remote-perl vec)))
+ (format "%s () {\n%s\n}"
+ name (format script (tramp-get-remote-perl vec)))
"Script %s sending failed" name)
(tramp-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts))))))
-(defun tramp-set-auto-save ()
- (when (and ;; ange-ftp has its own auto-save mechanism
- (eq (tramp-find-foreign-file-name-handler (buffer-file-name))
- 'tramp-sh-file-name-handler)
- auto-save-default)
- (auto-save-mode 1)))
-(add-hook 'find-file-hooks 'tramp-set-auto-save t)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (remove-hook 'find-file-hooks 'tramp-set-auto-save)))
-
(defun tramp-run-test (switch filename)
"Run `test' on the remote system, given a SWITCH and a FILENAME.
Returns the exit code of the `test' program."
@@ -3563,8 +3941,13 @@ This function expects to be in the right *tramp* buffer."
(let (result)
;; Check whether the executable is in $PATH. "which(1)" does not
;; report always a correct error code; therefore we check the
- ;; number of words it returns.
- (unless ignore-path
+ ;; number of words it returns. "SunOS 5.10" (and maybe "SunOS
+ ;; 5.11") have problems with this command, we disable the call
+ ;; therefore.
+ (unless (or ignore-path
+ (string-match
+ (regexp-opt '("SunOS 5.10" "SunOS 5.11"))
+ (tramp-get-connection-property vec "uname" "")))
(tramp-send-command vec (format "which \\%s | wc -w" progname))
(goto-char (point-min))
(if (looking-at "^\\s-*1$")
@@ -3583,11 +3966,14 @@ This function expects to be in the right *tramp* buffer."
(tramp-send-command
vec
(format (concat "while read d; "
- "do if test -x $d/%s -a -f $d/%s; "
+ "do if test -x $d/%s && test -f $d/%s; "
"then echo tramp_executable $d/%s; "
- "break; fi; done <<'EOF'\n"
- "%s\nEOF")
- progname progname progname (mapconcat 'identity dirlist "\n")))
+ "break; fi; done <<'%s'\n"
+ "%s\n%s")
+ progname progname progname
+ tramp-end-of-heredoc
+ (mapconcat 'identity dirlist "\n")
+ tramp-end-of-heredoc))
(goto-char (point-max))
(when (search-backward "tramp_executable " nil t)
(skip-chars-forward "^ ")
@@ -3666,39 +4052,46 @@ file exists and nonzero exit status otherwise."
(defun tramp-open-shell (vec shell)
"Opens shell SHELL."
(with-tramp-progress-reporter
- vec 5 (format "Opening remote shell `%s'" shell)
+ vec 5 (format-message "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
- (let ((tramp-end-of-output tramp-initial-end-of-output)
- (alist tramp-sh-extra-args)
+ (let ((alist tramp-sh-extra-args)
item extra-args)
(while (and alist (null extra-args))
(setq item (pop alist))
(when (string-match (car item) shell)
(setq extra-args (cdr item))))
+ ;; It is useful to set the prompt in the following command
+ ;; because some people have a setting for $PS1 which /bin/sh
+ ;; doesn't know about and thus /bin/sh will display a strange
+ ;; prompt. For example, if $PS1 has "${CWD}" in the value, then
+ ;; ksh will display the current working directory but /bin/sh
+ ;; will display a dollar sign. The following command line sets
+ ;; $PS1 to a sane value, and works under Bourne-ish shells as
+ ;; well as csh-like shells. We also unset the variable $ENV
+ ;; because that is read by some sh implementations (eg, bash
+ ;; when called as sh) on startup; this way, we avoid the startup
+ ;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
+ ;; the prompt in /bin/bash, it must be discarded as well.
+ ;; $HISTFILE is set according to `tramp-histfile-override'.
(tramp-send-command
vec (format
- "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ "exec env ENV='' %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ (if (stringp tramp-histfile-override)
+ (format "HISTFILE=%s"
+ (tramp-shell-quote-argument tramp-histfile-override))
+ (if tramp-histfile-override
+ "HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
+ ""))
(tramp-shell-quote-argument tramp-end-of-output)
shell (or extra-args ""))
t))
(tramp-set-connection-property
- (tramp-get-connection-process vec) "remote-shell" shell)
- ;; Setting prompts.
- (tramp-send-command
- vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output)) t)
- (tramp-send-command vec "PS2=''" t)
- (tramp-send-command vec "PS3=''" t)
- (tramp-send-command vec "PROMPT_COMMAND=''" t)))
+ (tramp-get-connection-process vec) "remote-shell" shell)))
(defun tramp-find-shell (vec)
"Opens a shell on the remote host which groks tilde expansion."
(with-current-buffer (tramp-get-buffer vec)
- (let ((default-shell
- (or
- (tramp-get-connection-property
- (tramp-get-connection-process vec) "remote-shell" nil)
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-shell)))
+ (let ((default-shell (tramp-get-method-parameter vec 'tramp-remote-shell))
shell)
(setq shell
(with-tramp-connection-property vec "remote-shell"
@@ -3757,29 +4150,12 @@ seconds. If not, it produces an error message with the given ERROR-ARGS."
Mainly sets the prompt and the echo correctly. PROC is the shell
process to set up. VEC specifies the connection."
(let ((tramp-end-of-output tramp-initial-end-of-output))
- ;; It is useful to set the prompt in the following command because
- ;; some people have a setting for $PS1 which /bin/sh doesn't know
- ;; about and thus /bin/sh will display a strange prompt. For
- ;; example, if $PS1 has "${CWD}" in the value, then ksh will
- ;; display the current working directory but /bin/sh will display
- ;; a dollar sign. The following command line sets $PS1 to a sane
- ;; value, and works under Bourne-ish shells as well as csh-like
- ;; shells. Daniel Pittman reports that the unusual positioning of
- ;; the single quotes makes it work under `rc', too. We also unset
- ;; the variable $ENV because that is read by some sh
- ;; implementations (eg, bash when called as sh) on startup; this
- ;; way, we avoid the startup file clobbering $PS1. $PROMPT_COMMAND
- ;; is another way to set the prompt in /bin/bash, it must be
- ;; discarded as well.
- (tramp-open-shell
- vec
- (or (tramp-get-connection-property vec "remote-shell" nil)
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-remote-shell)))
+ (tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
- ;; Disable echo.
+ ;; Disable tab and echo expansion.
(tramp-message vec 5 "Setting up remote shell environment")
- (tramp-send-command vec "stty -inlcr -echo kill '^U' erase '^H'" t)
+ (tramp-send-command
+ vec "stty tab0 -inlcr -onlcr -echo kill '^U' erase '^H'" t)
;; Check whether the echo has really been disabled. Some
;; implementations, like busybox of embedded GNU/Linux, don't
;; support disabling.
@@ -3795,23 +4171,22 @@ process to set up. VEC specifies the connection."
(tramp-message vec 5 "Setting shell prompt")
(tramp-send-command
- vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output)) t)
- (tramp-send-command vec "PS2=''" t)
- (tramp-send-command vec "PS3=''" t)
- (tramp-send-command vec "PROMPT_COMMAND=''" t)
+ vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''"
+ (tramp-shell-quote-argument tramp-end-of-output)) t)
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
(tramp-message vec 5 "Determining coding system")
- (tramp-send-command vec "echo foo ; echo bar" t)
(with-current-buffer (process-buffer proc)
- (goto-char (point-min))
(if (featurep 'mule)
;; Use MULE to select the right EOL convention for communicating
;; with the process.
- (let* ((cs (or (tramp-compat-funcall 'process-coding-system proc)
- (cons 'undecided 'undecided)))
- cs-decode cs-encode)
+ (let ((cs (or (and (memq 'utf-8 (coding-system-list))
+ (string-match "utf8" (tramp-get-remote-locale vec))
+ (cons 'utf-8 'utf-8))
+ (tramp-compat-funcall 'process-coding-system proc)
+ (cons 'undecided 'undecided)))
+ cs-decode cs-encode)
(when (symbolp cs) (setq cs (cons cs cs)))
(setq cs-decode (car cs))
(setq cs-encode (cdr cs))
@@ -3819,6 +4194,8 @@ process to set up. VEC specifies the connection."
(unless cs-encode (setq cs-encode 'undecided))
(setq cs-encode (tramp-compat-coding-system-change-eol-conversion
cs-encode 'unix))
+ (tramp-send-command vec "echo foo ; echo bar" t)
+ (goto-char (point-min))
(when (search-forward "\r" nil t)
(setq cs-decode (tramp-compat-coding-system-change-eol-conversion
cs-decode 'dos)))
@@ -3846,11 +4223,12 @@ process to set up. VEC specifies the connection."
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(when (and (stringp old-uname) (not (string-equal old-uname new-uname)))
- (tramp-cleanup vec)
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
old-uname new-uname)
+ ;; We want to keep the password.
+ (tramp-cleanup-connection vec t t)
(throw 'uname-changed (tramp-maybe-open-connection vec))))
;; Check whether the remote host suffers from buggy
@@ -3911,16 +4289,24 @@ process to set up. VEC specifies the connection."
;; Set the environment.
(tramp-message vec 5 "Setting default environment")
- (let ((env (copy-sequence tramp-remote-process-environment))
- unset item)
+ (let ((env (append `(,(tramp-get-remote-locale vec))
+ (copy-sequence tramp-remote-process-environment)))
+ unset vars item)
(while env
(setq item (tramp-compat-split-string (car env) "="))
(setcdr item (mapconcat 'identity (cdr item) "="))
(if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
- (tramp-send-command
- vec (format "%s=%s; export %s" (car item) (cdr item) (car item)) t)
+ (push (format "%s %s" (car item) (cdr item)) vars)
(push (car item) unset))
(setq env (cdr env)))
+ (when vars
+ (tramp-send-command
+ vec
+ (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s"
+ tramp-end-of-heredoc
+ (mapconcat 'identity vars "\n")
+ tramp-end-of-heredoc)
+ t))
(when unset
(tramp-send-command
vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
@@ -3947,7 +4333,7 @@ process to set up. VEC specifies the connection."
"List of local coding commands for inline transfer.
Each item is a list that looks like this:
-\(FORMAT ENCODING DECODING\)
+\(FORMAT ENCODING DECODING)
FORMAT is symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
@@ -3955,7 +4341,7 @@ FORMAT is symbol describing the encoding/decoding format. It can be
ENCODING and DECODING can be strings, giving commands, or symbols,
giving functions. If they are strings, then they can contain
the \"%s\" format specifier. If that specifier is present, the input
-filename will be put into the command line at that spot. If the
+file name will be put into the command line at that spot. If the
specifier is not present, the input should be read from standard
input.
@@ -3964,16 +4350,19 @@ and end of region, and are expected to replace the region contents
with the encoded or decoded results, respectively.")
(defconst tramp-remote-coding-commands
- '((b64 "base64" "base64 -d -i")
+ `((b64 "base64" "base64 -d -i")
;; "-i" is more robust with older base64 from GNU coreutils.
;; However, I don't know whether all base64 versions do supports
;; this option.
(b64 "base64" "base64 -d")
+ (b64 "openssl enc -base64" "openssl enc -d -base64")
(b64 "mimencode -b" "mimencode -u -b")
(b64 "mmencode -b" "mmencode -u -b")
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
+ ;; This is painful slow, so we put it on the end.
+ (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test)
(uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
@@ -3982,21 +4371,23 @@ with the encoded or decoded results, respectively.")
"List of remote coding commands for inline transfer.
Each item is a list that looks like this:
-\(FORMAT ENCODING DECODING [TEST]\)
+\(FORMAT ENCODING DECODING [TEST])
-FORMAT is symbol describing the encoding/decoding format. It can be
+FORMAT is a symbol describing the encoding/decoding format. It can be
`b64' for base64 encoding, `uu' for uu encoding, or `pack' for simple packing.
ENCODING and DECODING can be strings, giving commands, or symbols,
giving variables. If they are strings, then they can contain
the \"%s\" format specifier. If that specifier is present, the input
-filename will be put into the command line at that spot. If the
+file name will be put into the command line at that spot. If the
specifier is not present, the input should be read from standard
input.
-If they are variables, this variable is a string containing a Perl
-implementation for this functionality. This Perl program will be transferred
-to the remote host, and it is available as shell function with the same name.
+If they are variables, this variable is a string containing a
+Perl or Shell implementation for this functionality. This
+program will be transferred to the remote host, and it is
+available as shell function with the same name. A \"%t\" format
+specifier in the variable value denotes a temporary file.
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@@ -4049,6 +4440,11 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking remote test command `%s'" rem-test)
(unless (tramp-send-command-and-check vec rem-test t)
(throw 'wont-work-remote nil)))
+ ;; Check if remote perl exists when necessary.
+ (when (and (symbolp rem-enc)
+ (string-match "perl" (symbol-name rem-enc))
+ (not (tramp-get-remote-perl vec)))
+ (throw 'wont-work-remote nil))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
@@ -4071,10 +4467,25 @@ Goes through the list `tramp-local-coding-commands' and
(throw 'wont-work-remote nil))
(when (not (stringp rem-dec))
- (let ((name (symbol-name rem-dec)))
+ (let ((name (symbol-name rem-dec))
+ (value (symbol-value rem-dec))
+ tmpfile)
(while (string-match (regexp-quote "-") name)
(setq name (replace-match "_" nil t name)))
- (tramp-maybe-send-script vec (symbol-value rem-dec) name)
+ (when (string-match "\\(^\\|[^%]\\)%t" value)
+ (setq tmpfile
+ (make-temp-name
+ (expand-file-name
+ tramp-temp-name-prefix
+ (tramp-get-remote-tmpdir vec)))
+ value
+ (format-spec
+ value
+ (format-spec-make
+ ?t
+ (tramp-file-name-handler
+ 'file-remote-p tmpfile 'localname)))))
+ (tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
vec 5
@@ -4095,32 +4506,28 @@ Goes through the list `tramp-local-coding-commands' and
(setq rem-dec (nth 2 ritem))
(setq found t)))))))
- ;; Did we find something?
- (unless found
- (tramp-error
- vec 'file-error "Couldn't find an inline transfer encoding"))
-
- ;; Set connection properties. Since the commands are risky (due
- ;; to output direction), we cache them in the process cache.
- (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
- (tramp-set-connection-property p "local-encoding" loc-enc)
- (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
- (tramp-set-connection-property p "local-decoding" loc-dec)
- (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
- (tramp-set-connection-property p "remote-encoding" rem-enc)
- (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
- (tramp-set-connection-property p "remote-decoding" rem-dec))))
+ (when found
+ ;; Set connection properties. Since the commands are risky
+ ;; (due to output direction), we cache them in the process cache.
+ (tramp-message vec 5 "Using local encoding `%s'" loc-enc)
+ (tramp-set-connection-property p "local-encoding" loc-enc)
+ (tramp-message vec 5 "Using local decoding `%s'" loc-dec)
+ (tramp-set-connection-property p "local-decoding" loc-dec)
+ (tramp-message vec 5 "Using remote encoding `%s'" rem-enc)
+ (tramp-set-connection-property p "remote-encoding" rem-enc)
+ (tramp-message vec 5 "Using remote decoding `%s'" rem-dec)
+ (tramp-set-connection-property p "remote-decoding" rem-dec)))))
(defun tramp-call-local-coding-command (cmd input output)
"Call the local encoding or decoding command.
If CMD contains \"%s\", provide input file INPUT there in command.
Otherwise, INPUT is passed via standard input.
INPUT can also be nil which means `/dev/null'.
-OUTPUT can be a string (which specifies a filename), or t (which
+OUTPUT can be a string (which specifies a file name), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
(tramp-call-process
- tramp-encoding-shell
+ nil tramp-encoding-shell
(when (and input (not (string-match "%s" cmd))) input)
(if (eq output t) t nil)
nil
@@ -4137,7 +4544,7 @@ means discard it)."
"List of compress and decompress commands for inline transfer.
Each item is a list that looks like this:
-\(COMPRESS DECOMPRESS\)
+\(COMPRESS DECOMPRESS)
COMPRESS or DECOMPRESS are strings with the respective commands.")
@@ -4252,7 +4659,7 @@ Gateway hops are already opened."
?h (or (tramp-file-name-host (car target-alist)) ""))))
(with-parsed-tramp-file-name proxy l
;; Add the hop.
- (add-to-list 'target-alist l)
+ (push l target-alist)
;; Start next search.
(setq choices tramp-default-proxies-alist)))))
@@ -4270,29 +4677,24 @@ Gateway hops are already opened."
vec 'file-error
"Connection `%s' is not supported for gateway access." hop))
;; Open the gateway connection.
- (add-to-list
- 'target-alist
+ (push
(vector
(tramp-file-name-method hop) (tramp-file-name-user hop)
- (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil))
+ (tramp-compat-funcall 'tramp-gw-open-connection vec gw hop) nil nil)
+ target-alist)
;; For the password prompt, we need the correct values.
;; Therefore, we must remember the gateway vector. But we
;; cannot do it as connection property, because it shouldn't
;; be persistent. And we have no started process yet either.
- (tramp-set-file-property (car target-alist) "" "gateway" hop)))
+ (let ((tramp-verbose 0))
+ (tramp-set-file-property (car target-alist) "" "gateway" hop))))
;; Foreign and out-of-band methods are not supported for multi-hops.
(when (cdr target-alist)
(setq choices target-alist)
- (while choices
- (setq item (pop choices))
- (when
- (or
- (not
- (tramp-get-method-parameter
- (tramp-file-name-method item) 'tramp-login-program))
- (tramp-get-method-parameter
- (tramp-file-name-method item) 'tramp-copy-program))
+ (while (setq item (pop choices))
+ (when (or (not (tramp-get-method-parameter item 'tramp-login-program))
+ (tramp-get-method-parameter item 'tramp-copy-program))
(tramp-error
vec 'file-error
"Method `%s' is not supported for multi-hops."
@@ -4300,7 +4702,7 @@ Gateway hops are already opened."
;; In case the host name is not used for the remote shell
;; command, the user could be misguided by applying a random
- ;; hostname.
+ ;; host name.
(let* ((v (car target-alist))
(method (tramp-file-name-method v))
(host (tramp-file-name-host v)))
@@ -4309,8 +4711,7 @@ Gateway hops are already opened."
;; There are multi-hops.
(cdr target-alist)
;; The host name is used for the remote shell command.
- (member
- '("%h") (tramp-get-method-parameter method 'tramp-login-args))
+ (member '("%h") (tramp-get-method-parameter v 'tramp-login-args))
;; The host is local. We cannot use `tramp-local-host-p'
;; here, because it opens a connection as well.
(string-match tramp-local-host-regexp host))
@@ -4322,84 +4723,130 @@ Gateway hops are already opened."
;; Result.
target-alist))
+(defun tramp-ssh-controlmaster-options (vec)
+ "Return the Control* arguments of the local ssh."
+ (cond
+ ;; No options to be computed.
+ ((or (null tramp-use-ssh-controlmaster-options)
+ (null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))))
+ "")
+
+ ;; There is already a value to be used.
+ ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options)
+
+ ;; Determine the options.
+ (t (setq tramp-ssh-controlmaster-options "")
+ (let ((case-fold-search t))
+ (ignore-errors
+ (when (executable-find "ssh")
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlMaster")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options "-o ControlMaster=auto")))
+ (unless (zerop (length tramp-ssh-controlmaster-options))
+ (with-temp-buffer
+ ;; We use a non-existing IP address, in order to avoid
+ ;; useless connections, and DNS timeouts.
+ (tramp-call-process
+ vec "ssh" nil t nil "-o" "ControlPath=%C" "0.0.0.1")
+ (goto-char (point-min))
+ (setq tramp-ssh-controlmaster-options
+ (concat tramp-ssh-controlmaster-options
+ (if (search-forward-regexp "unknown.+key" nil t)
+ " -o ControlPath='tramp.%%r@%%h:%%p'"
+ " -o ControlPath='tramp.%%C'"))))
+ (with-temp-buffer
+ (tramp-call-process vec "ssh" nil t nil "-o" "ControlPersist")
+ (goto-char (point-min))
+ (when (search-forward-regexp "missing.+argument" nil t)
+ (setq tramp-ssh-controlmaster-options
+ (concat tramp-ssh-controlmaster-options
+ " -o ControlPersist=no"))))))))
+ tramp-ssh-controlmaster-options)))
+
(defun tramp-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."
- (catch 'uname-changed
- (let ((p (tramp-get-connection-process vec))
- (process-name (tramp-get-connection-property vec "process-name" nil))
- (process-environment (copy-sequence process-environment))
- (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
-
- ;; If Tramp opens the same connection within a short time frame,
- ;; there is a problem. We shall signal this.
- (unless (or (and p (processp p) (memq (process-status p) '(run open)))
- (not (equal (butlast (append vec nil) 2)
- (car tramp-current-connection)))
- (> (tramp-time-diff
- (current-time) (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
- ;; whether process is still alive. If it isn't, kill it. When
- ;; using ssh, it can sometimes happen that the remote end has
- ;; hung up but the local ssh client doesn't recognize this until
- ;; it tries to send some data to the remote end. So that's why
- ;; we try to send a command from time to time, then look again
- ;; whether the process is really alive.
- (condition-case nil
- (when (and (> (tramp-time-diff
- (current-time)
- (tramp-get-connection-property
- p "last-cmd-time" '(0 0 0)))
- 60)
- p (processp p) (memq (process-status p) '(run open)))
- (tramp-send-command vec "echo are you awake" t t)
- (unless (and (memq (process-status p) '(run open))
- (tramp-wait-for-output p 10))
- ;; The error will be caught locally.
- (tramp-error vec 'file-error "Awake did fail")))
- (file-error
- (tramp-cleanup vec)
- (setq p nil)))
-
- ;; New connection must be opened.
- (condition-case err
- (unless (and p (processp p) (memq (process-status p) '(run open)))
-
- ;; We call `tramp-get-buffer' in order to get a debug
- ;; buffer for messages from the beginning.
- (tramp-get-buffer vec)
-
- ;; If `non-essential' is non-nil, don't reopen a new connection.
- (when (and (boundp 'non-essential) (symbol-value 'non-essential))
- (throw 'non-essential 'non-essential))
-
- (with-tramp-progress-reporter
- vec 3
- (if (zerop (length (tramp-file-name-user vec)))
- (format "Opening connection for %s using %s"
- (tramp-file-name-host vec)
- (tramp-file-name-method vec))
- (format "Opening connection for %s@%s using %s"
- (tramp-file-name-user vec)
+ (tramp-check-proper-method-and-host vec)
+
+ (let ((p (tramp-get-connection-process vec))
+ (process-name (tramp-get-connection-property vec "process-name" nil))
+ (process-environment (copy-sequence process-environment))
+ (pos (with-current-buffer (tramp-get-connection-buffer vec) (point))))
+
+ ;; If Tramp opens the same connection within a short time frame,
+ ;; there is a problem. We shall signal this.
+ (unless (or (and p (processp p) (memq (process-status p) '(run open)))
+ (not (equal (butlast (append vec nil) 2)
+ (car tramp-current-connection)))
+ (> (tramp-time-diff
+ (current-time) (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
+ ;; whether process is still alive. If it isn't, kill it. When
+ ;; using ssh, it can sometimes happen that the remote end has hung
+ ;; up but the local ssh client doesn't recognize this until it
+ ;; tries to send some data to the remote end. So that's why we
+ ;; try to send a command from time to time, then look again
+ ;; whether the process is really alive.
+ (condition-case nil
+ (when (and (> (tramp-time-diff
+ (current-time)
+ (tramp-get-connection-property
+ p "last-cmd-time" '(0 0 0)))
+ 60)
+ p (processp p) (memq (process-status p) '(run open)))
+ (tramp-send-command vec "echo are you awake" t t)
+ (unless (and (memq (process-status p) '(run open))
+ (tramp-wait-for-output p 10))
+ ;; The error will be caught locally.
+ (tramp-error vec 'file-error "Awake did fail")))
+ (file-error
+ (tramp-cleanup-connection vec t)
+ (setq p nil)))
+
+ ;; New connection must be opened.
+ (condition-case err
+ (unless (and p (processp p) (memq (process-status p) '(run open)))
+
+ ;; If `non-essential' is non-nil, don't reopen a new connection.
+ (when (and (boundp 'non-essential) (symbol-value 'non-essential))
+ (throw 'non-essential 'non-essential))
+
+ (with-tramp-progress-reporter
+ vec 3
+ (if (zerop (length (tramp-file-name-user vec)))
+ (format "Opening connection for %s using %s"
(tramp-file-name-host vec)
- (tramp-file-name-method vec)))
+ (tramp-file-name-method vec))
+ (format "Opening connection for %s@%s using %s"
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-method vec)))
+ (catch 'uname-changed
;; Start new process.
(when (and p (processp p))
(delete-process p))
(setenv "TERM" tramp-terminal-type)
- (setenv "LC_ALL" "C")
+ (setenv "LC_ALL" "en_US.utf8")
+ (if (stringp tramp-histfile-override)
+ (setenv "HISTFILE" tramp-histfile-override)
+ (if tramp-histfile-override
+ (progn
+ (setenv "HISTFILE")
+ (setenv "HISTFILESIZE" "0")
+ (setenv "HISTSIZE" "0"))))
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))
;; We will apply `tramp-ssh-controlmaster-options'
;; only for the first hop.
- (options (if tramp-use-ssh-controlmaster-options
- tramp-ssh-controlmaster-options ""))
+ (options (tramp-ssh-controlmaster-options vec))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
(coding-system-for-read nil)
@@ -4440,20 +4887,20 @@ connection if a previous connection has died for some reason."
(l-host (tramp-file-name-host hop))
(l-port nil)
(login-program
- (tramp-get-method-parameter
- l-method 'tramp-login-program))
+ (tramp-get-method-parameter hop 'tramp-login-program))
(login-args
- (tramp-get-method-parameter
- l-method 'tramp-login-args))
+ (tramp-get-method-parameter hop 'tramp-login-args))
+ (login-env
+ (tramp-get-method-parameter hop 'tramp-login-env))
(async-args
- (tramp-get-method-parameter
- l-method 'tramp-async-args))
+ (tramp-get-method-parameter hop 'tramp-async-args))
(connection-timeout
(tramp-get-method-parameter
- l-method 'tramp-connection-timeout))
+ hop 'tramp-connection-timeout))
(gw-args
- (tramp-get-method-parameter l-method 'tramp-gw-args))
- (gw (tramp-get-file-property hop "" "gateway" nil))
+ (tramp-get-method-parameter hop 'tramp-gw-args))
+ (gw (let ((tramp-verbose 0))
+ (tramp-get-file-property hop "" "gateway" nil)))
(g-method (and gw (tramp-file-name-method gw)))
(g-user (and gw (tramp-file-name-user gw)))
(g-host (and gw (tramp-file-name-real-host gw)))
@@ -4481,8 +4928,10 @@ connection if a previous connection has died for some reason."
(setq login-args (append async-args login-args)))
;; Add gateway arguments if necessary.
- (when (and gw gw-args)
- (setq login-args (append gw-args login-args)))
+ (when gw
+ (tramp-set-connection-property p "gateway" t)
+ (when gw-args
+ (setq login-args (append gw-args login-args))))
;; Check for port number. Until now, there's no
;; need for handling like method, user, host.
@@ -4502,7 +4951,25 @@ connection if a previous connection has died for some reason."
tramp-current-user (or g-user l-user)
tramp-current-host (or g-host l-host))
- ;; Replace login-args place holders.
+ ;; Add login environment.
+ (when login-env
+ (setq
+ login-env
+ (mapcar
+ (lambda (x)
+ (setq x (mapcar (lambda (y) (format-spec y spec)) x))
+ (unless (member "" x) (mapconcat 'identity x " ")))
+ login-env))
+ (while login-env
+ (setq command
+ (format
+ "%s=%s %s"
+ (pop login-env)
+ (tramp-shell-quote-argument (pop login-env))
+ command)))
+ (setq command (concat "env " command)))
+
+ ;; Replace `login-args' place holders.
(setq
l-host (or l-host "")
l-user (or l-user "")
@@ -4542,13 +5009,13 @@ connection if a previous connection has died for some reason."
target-alist (cdr target-alist)))
;; Make initial shell settings.
- (tramp-open-connection-setup-interactive-shell p vec))))
+ (tramp-open-connection-setup-interactive-shell p vec)))))
- ;; When the user did interrupt, we must cleanup.
- (quit
- (tramp-cleanup vec)
- ;; Propagate the quit signal.
- (signal (car err) (cdr err)))))))
+ ;; When the user did interrupt, we must cleanup.
+ (quit
+ (tramp-cleanup-connection vec t)
+ ;; Propagate the quit signal.
+ (signal (car err) (cdr err))))))
(defun tramp-send-command (vec command &optional neveropen nooutput)
"Send the COMMAND to connection VEC.
@@ -4561,15 +5028,18 @@ function waits for output unless NOOUTPUT is set."
(when (tramp-get-connection-property p "remote-echo" nil)
;; We mark the command string that it can be erased in the output buffer.
(tramp-set-connection-property p "check-remote-echo" t)
+ ;; If we put `tramp-echo-mark' after a trailing newline (which
+ ;; is assumed to be unquoted) `tramp-send-string' doesn't see
+ ;; that newline and adds `tramp-rsh-end-of-line' right after
+ ;; `tramp-echo-mark', so the remote shell sees two consecutive
+ ;; trailing line endings and sends two prompts after executing
+ ;; the command, which confuses `tramp-wait-for-output'.
+ (when (and (not (string= command ""))
+ (string-equal (substring command -1) "\n"))
+ (setq command (substring command 0 -1)))
+ ;; No need to restore a trailing newline here since `tramp-send-string'
+ ;; makes sure that the string ends in `tramp-rsh-end-of-line', anyway.
(setq command (format "%s%s%s" tramp-echo-mark command tramp-echo-mark)))
- ;; Some busyboxes tend to close the connection when we use the
- ;; following syntax for here-documents. This we cannot test; it
- ;; shall be set via `tramp-connection-properties'.
- (when (and (string-match "<<'EOF'" command)
- (not (tramp-get-connection-property vec "busybox" nil)))
- ;; Unset $PS1 when using here documents, in order to avoid
- ;; multiple prompts.
- (setq command (concat "(PS1= ; " command "\n)")))
;; Send the command.
(tramp-message vec 6 "%s" command)
(tramp-send-string vec command)
@@ -4615,8 +5085,9 @@ function waits for output unless NOOUTPUT is set."
(defun tramp-send-command-and-check
(vec command &optional subshell dont-suppress-err)
"Run COMMAND and check its exit status.
-Sends `echo $?' along with the COMMAND for checking the exit status. If
-COMMAND is nil, just sends `echo $?'. Returns the exit status found.
+Sends `echo $?' along with the COMMAND for checking the exit status.
+If COMMAND is nil, just sends `echo $?'. Returns t if the exit
+status is 0, and nil otherwise.
If the optional argument SUBSHELL is non-nil, the command is
executed in a subshell, ie surrounded by parentheses. If
@@ -4646,8 +5117,9 @@ FMT and ARGS which are passed to `error'."
(or (tramp-send-command-and-check vec command)
(apply 'tramp-error vec 'file-error fmt args)))
-(defun tramp-send-command-and-read (vec command &optional noerror)
+(defun tramp-send-command-and-read (vec command &optional noerror marker)
"Run COMMAND and return the output, which must be a Lisp expression.
+If MARKER is a regexp, read the output after that string.
In case there is no valid Lisp expression and NOERROR is nil, it
raises an error."
(when (if noerror
@@ -4655,8 +5127,17 @@ raises an error."
(tramp-barf-unless-okay
vec command "`%s' returns with error" command))
(with-current-buffer (tramp-get-connection-buffer vec)
- ;; Read the expression.
(goto-char (point-min))
+ ;; Read the marker.
+ (when (stringp marker)
+ (condition-case nil
+ (re-search-forward marker)
+ (error (unless noerror
+ (tramp-error
+ vec 'file-error
+ "`%s' does not return the marker `%s': `%s'"
+ command marker (buffer-string))))))
+ ;; Read the expression.
(condition-case nil
(prog1 (read (current-buffer))
;; Error handling.
@@ -4755,20 +5236,27 @@ Return ATTR."
""))
(defun tramp-make-copy-program-file-name (vec)
- "Create a file name suitable to be passed to `rcp' and workalikes."
- (let ((user (tramp-file-name-user vec))
+ "Create a file name suitable for `scp', `pscp', or `nc' and workalikes."
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
(host (tramp-file-name-real-host vec))
- (localname (tramp-shell-quote-argument
- (tramp-file-name-localname vec))))
- (if (not (zerop (length user)))
- (format "%s@%s:%s" user host localname)
- (format "%s:%s" host localname))))
+ (localname (tramp-file-name-localname vec)))
+ (when (string-match tramp-ipv6-regexp host)
+ (setq host (format "[%s]" host)))
+ (unless (string-match "ftp$" method)
+ (setq localname (tramp-shell-quote-argument localname)))
+ (cond
+ ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
+ localname)
+ ((not (zerop (length user)))
+ (shell-quote-argument (format "%s@%s:%s" user host localname)))
+ (t (shell-quote-argument (format "%s:%s" host localname))))))
(defun tramp-method-out-of-band-p (vec size)
"Return t if this is an out-of-band method, nil otherwise."
(and
;; It shall be an out-of-band method.
- (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program)
+ (tramp-get-method-parameter vec 'tramp-copy-program)
;; There must be a size, otherwise the file doesn't exist.
(numberp size)
;; Either the file size is large enough, or (in rare cases) there
@@ -4804,19 +5292,30 @@ Return ATTR."
"/bin:/usr/bin")
"/bin:/usr/bin"))))
(own-remote-path
- (when elt2
- (condition-case nil
- (tramp-send-command-and-read vec "echo \\\"$PATH\\\"")
- (error
- (tramp-message
- vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.")
- nil)))))
+ ;; The login shell could return more than just the $PATH
+ ;; string. So we use `tramp-end-of-heredoc' as marker.
+ (when elt2
+ (tramp-send-command-and-read
+ vec
+ (format
+ "%s %s %s 'echo %s \\\"$PATH\\\"'"
+ (tramp-get-method-parameter vec 'tramp-remote-shell)
+ (mapconcat
+ 'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-login)
+ " ")
+ (mapconcat
+ 'identity
+ (tramp-get-method-parameter vec 'tramp-remote-shell-args)
+ " ")
+ (tramp-shell-quote-argument tramp-end-of-heredoc))
+ nil (regexp-quote tramp-end-of-heredoc)))))
;; Replace place holder `tramp-default-remote-path'.
(when elt1
(setcdr elt1
(append
- (tramp-compat-split-string default-remote-path ":")
+ (tramp-compat-split-string (or default-remote-path "") ":")
(cdr elt1)))
(setq remote-path (delq 'tramp-default-remote-path remote-path)))
@@ -4824,7 +5323,7 @@ Return ATTR."
(when elt2
(setcdr elt2
(append
- (tramp-compat-split-string own-remote-path ":")
+ (tramp-compat-split-string (or own-remote-path "") ":")
(cdr elt2)))
(setq remote-path (delq 'tramp-own-remote-path remote-path)))
@@ -4851,6 +5350,22 @@ Return ATTR."
x))
remote-path)))))
+(defun tramp-get-remote-locale (vec)
+ (with-tramp-connection-property vec "locale"
+ (tramp-send-command vec "locale -a")
+ (let ((candidates '("en_US.utf8" "C.utf8"))
+ locale)
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (while candidates
+ (goto-char (point-min))
+ (if (string-match (format "^%s\r?$" (regexp-quote (car candidates)))
+ (buffer-string))
+ (setq locale (car candidates)
+ candidates nil)
+ (setq candidates (cdr candidates)))))
+ ;; Return value.
+ (format "LC_ALL=%s" (or locale "C")))))
+
(defun tramp-get-ls-command (vec)
(with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
@@ -4886,6 +5401,17 @@ Return ATTR."
(tramp-send-command-and-check
vec (format "%s --dired -al /dev/null" (tramp-get-ls-command vec))))))
+(defun tramp-get-ls-command-with-quoting-style (vec)
+ (save-match-data
+ (with-tramp-connection-property vec "ls-quoting-style"
+ (tramp-message vec 5 "Checking, whether `ls --quoting-style=shell' works")
+ ;; Some "ls" versions are sensible wrt the order of arguments,
+ ;; they fail when "-al" is after the "--dired" argument (for
+ ;; example on FreeBSD).
+ (tramp-send-command-and-check
+ vec (format "%s --quoting-style=shell -al /dev/null"
+ (tramp-get-ls-command vec))))))
+
(defun tramp-get-test-command (vec)
(with-tramp-connection-property vec "test"
(tramp-message vec 5 "Finding a suitable `test' command")
@@ -4974,6 +5500,30 @@ Return ATTR."
(tramp-message vec 5 "Finding a suitable `trash' command")
(tramp-find-executable vec "trash" (tramp-get-remote-path vec))))
+(defun tramp-get-remote-touch (vec)
+ (with-tramp-connection-property vec "touch"
+ (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)))))
+ ;; Busyboxes do support the "-t" option only when they have been
+ ;; built with the DESKTOP config option. Let's check it.
+ (when result
+ (tramp-set-connection-property
+ vec "touch-t"
+ (tramp-send-command-and-check
+ vec
+ (format
+ "%s -t %s %s"
+ result
+ (format-time-string "%Y%m%d%H%M.%S")
+ (tramp-file-name-handler 'file-remote-p tmpfile 'localname))))
+ (delete-file tmpfile))
+ result)))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
(with-tramp-connection-property vec "gvfs-monitor-dir"
(tramp-message vec 5 "Finding a suitable `gvfs-monitor-dir' command")
@@ -4988,40 +5538,110 @@ Return ATTR."
(defun tramp-get-remote-id (vec)
(with-tramp-connection-property vec "id"
(tramp-message vec 5 "Finding POSIX `id' command")
- (or
- (catch 'id-found
- (let ((dl (tramp-get-remote-path vec))
- result)
- (while (and dl (setq result (tramp-find-executable vec "id" dl t t)))
- ;; Check POSIX parameter.
- (when (tramp-send-command-and-check vec (format "%s -u" result))
- (throw 'id-found result))
- (setq dl (cdr dl)))))
- (tramp-error vec 'file-error "Couldn't find a POSIX `id' command"))))
+ (catch 'id-found
+ (dolist (cmd '("id" "gid"))
+ (let ((dl (tramp-get-remote-path vec))
+ result)
+ (while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
+ ;; Check POSIX parameter.
+ (when (tramp-send-command-and-check vec (format "%s -u" result))
+ (throw 'id-found result))
+ (setq dl (cdr dl))))))))
+
+(defun tramp-get-remote-uid-with-id (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -u%s %s"
+ (tramp-get-remote-id vec)
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
+
+(defun tramp-get-remote-uid-with-perl (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -le '%s'"
+ (tramp-get-remote-perl vec)
+ (if (equal id-format 'integer)
+ "print $>"
+ "print \"\\\"\", scalar getpwuid($>), \"\\\"\""))))
+
+(defun tramp-get-remote-python (vec)
+ (with-tramp-connection-property vec "python"
+ (tramp-message vec 5 "Finding a suitable `python' command")
+ (or (tramp-find-executable vec "python" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python2" (tramp-get-remote-path vec))
+ (tramp-find-executable vec "python3" (tramp-get-remote-path vec)))))
+
+(defun tramp-get-remote-uid-with-python (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -c \"%s\""
+ (tramp-get-remote-python vec)
+ (if (equal id-format 'integer)
+ "import os; print (os.getuid())"
+ "import os, pwd; print ('\\\"' + pwd.getpwuid(os.getuid())[0] + '\\\"')"))))
(defun tramp-get-remote-uid (vec id-format)
(with-tramp-connection-property vec (format "uid-%s" id-format)
- (let ((res (tramp-send-command-and-read
- vec
- (format "%s -u%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
- ;; The command might not always return a number.
- (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
+ (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))) -1)
+ ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
+ (t res)))))
+
+(defun tramp-get-remote-gid-with-id (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -g%s %s"
+ (tramp-get-remote-id vec)
+ (if (equal id-format 'integer) "" "n")
+ (if (equal id-format 'integer)
+ "" "| sed -e s/^/\\\"/ -e s/\\$/\\\"/"))))
+
+(defun tramp-get-remote-gid-with-perl (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -le '%s'"
+ (tramp-get-remote-perl vec)
+ (if (equal id-format 'integer)
+ "print ($)=~/(\\d+)/)"
+ "print \"\\\"\", scalar getgrgid($)), \"\\\"\""))))
+
+(defun tramp-get-remote-gid-with-python (vec id-format)
+ (tramp-send-command-and-read
+ vec
+ (format "%s -c \"%s\""
+ (tramp-get-remote-python vec)
+ (if (equal id-format 'integer)
+ "import os; print (os.getgid())"
+ "import os, grp; print ('\\\"' + grp.getgrgid(os.getgid())[0] + '\\\"')"))))
(defun tramp-get-remote-gid (vec id-format)
(with-tramp-connection-property vec (format "gid-%s" id-format)
- (let ((res (tramp-send-command-and-read
- vec
- (format "%s -g%s %s"
- (tramp-get-remote-id vec)
- (if (equal id-format 'integer) "" "n")
- (if (equal id-format 'integer)
- "" "| sed -e s/^/\\\"/ -e s/\$/\\\"/")))))
- ;; The command might not always return a number.
- (if (and (equal id-format 'integer) (not (integerp res))) -1 res))))
+ (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))) -1)
+ ((and (equal id-format 'string) (not (stringp res))) "UNKNOWN")
+ (t res)))))
;; Some predefined connection properties.
(defun tramp-get-inline-compress (vec prop size)
@@ -5049,7 +5669,7 @@ If no corresponding command is found, nil is returned.
Otherwise, either a string is returned which contains a `%s' mark
to be used for the respective input or output file; or a Lisp
function cell is returned to be applied on a buffer."
- ;; We must catch the errors, because we want to return `nil', when
+ ;; We must catch the errors, because we want to return nil, when
;; no inline coding is found.
(ignore-errors
(let ((coding
@@ -5079,16 +5699,20 @@ function cell is returned to be applied on a buffer."
`(lambda (beg end)
(,coding beg end)
(let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
+ (coding-system-for-read 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(apply
- 'call-process-region (point-min) (point-max)
+ 'tramp-call-process-region ,vec (point-min) (point-max)
(car (split-string ,compress)) t t nil
(cdr (split-string ,compress)))))
`(lambda (beg end)
(let ((coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
+ (coding-system-for-read 'binary)
+ (default-directory
+ (tramp-compat-temporary-file-directory)))
(apply
- 'call-process-region beg end
+ 'tramp-call-process-region ,vec beg end
(car (split-string ,compress)) t t nil
(cdr (split-string ,compress))))
(,coding (point-min) (point-max)))))
@@ -5134,8 +5758,6 @@ function cell is returned to be applied on a buffer."
;; * Don't use globbing for directories with many files, as this is
;; likely to produce long command lines, and some shells choke on
;; long command lines.
-;; * Make it work for different encodings, and for different file name
-;; encodings, too. (Daniel Pittman)
;; * 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
@@ -5181,7 +5803,5 @@ function cell is returned to be applied on a buffer."
;; rsync).
;; * Keep a second connection open for out-of-band methods like scp or
;; rsync.
-;; * Try telnet+curl as new method. It might be useful for busybox,
-;; without built-in uuencode/uudecode.
;;; tramp-sh.el ends here
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 39e87f994c2..c95679584dc 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1,6 +1,6 @@
;;; tramp-smb.el --- Tramp access functions for SMB servers
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
@@ -70,11 +70,20 @@
tramp-smb-method
'((tramp-parse-netrc "~/.netrc"))))
+;;;###tramp-autoload
(defcustom tramp-smb-program "smbclient"
"Name of SMB client to run."
:group 'tramp
:type 'string)
+;;;###tramp-autoload
+(defcustom tramp-smb-acl-program "smbcacls"
+ "Name of SMB acls to run."
+ :group 'tramp
+ :type 'string
+ :version "24.4")
+
+;;;###tramp-autoload
(defcustom tramp-smb-conf "/dev/null"
"Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
@@ -129,11 +138,14 @@ call, letting the SMB client use the default one."
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
"NT_STATUS_FILE_IS_A_DIRECTORY"
+ "NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
+ "NT_STATUS_INVALID_LEVEL"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
"NT_STATUS_NOT_IMPLEMENTED"
+ "NT_STATUS_NO_LOGON_SERVERS"
"NT_STATUS_NO_SUCH_FILE"
"NT_STATUS_NO_SUCH_USER"
"NT_STATUS_OBJECT_NAME_COLLISION"
@@ -178,6 +190,26 @@ This list is used for tar-like copy of directories.
See `tramp-actions-before-shell' for more info.")
+(defconst tramp-smb-actions-get-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-get-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
+(defconst tramp-smb-actions-set-acl
+ '((tramp-password-prompt-regexp tramp-action-password)
+ (tramp-wrong-passwd-regexp tramp-action-permission-denied)
+ (tramp-smb-errors tramp-action-permission-denied)
+ (tramp-process-alive-regexp tramp-smb-action-set-acl))
+ "List of pattern/action pairs.
+This list is used for smbcacls actions.
+
+See `tramp-actions-before-shell' for more info.")
+
;; New handlers should be added here.
(defconst tramp-smb-file-name-handler-alist
'(;; `access-file' performed by default handler.
@@ -215,6 +247,7 @@ See `tramp-actions-before-shell' for more info.")
(file-newer-than-file-p . tramp-handle-file-newer-than-file-p)
(file-notify-add-watch . tramp-handle-file-notify-add-watch)
(file-notify-rm-watch . tramp-handle-file-notify-rm-watch)
+ (file-notify-valid-p . tramp-handle-file-notify-valid-p)
(file-ownership-preserved-p . ignore)
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
@@ -229,13 +262,13 @@ See `tramp-actions-before-shell' for more info.")
(insert-directory . tramp-smb-handle-insert-directory)
(insert-file-contents . tramp-handle-insert-file-contents)
(load . tramp-handle-load)
- ;; `make-auto-save-file-name' performed by default handler.
+ (make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
- (set-file-acl . ignore)
+ (set-file-acl . tramp-smb-handle-set-file-acl)
(set-file-modes . tramp-smb-handle-set-file-modes)
(set-file-selinux-context . ignore)
(set-file-times . ignore)
@@ -251,6 +284,7 @@ See `tramp-actions-before-shell' for more info.")
Operations not mentioned here will be handled by the default Emacs primitives.")
;; Options for remote processes via winexe.
+;;;###tramp-autoload
(defcustom tramp-smb-winexe-program "winexe"
"Name of winexe client to run.
If it isn't found in the local $PATH, the absolute path of winexe
@@ -259,6 +293,7 @@ shall be given. This is needed for remote processes."
:type 'string
:version "24.3")
+;;;###tramp-autoload
(defcustom tramp-smb-winexe-shell-command "powershell.exe"
"Shell to be used for processes on remote machines.
This must be Powershell V2 compatible."
@@ -266,6 +301,7 @@ This must be Powershell V2 compatible."
:type 'string
:version "24.3")
+;;;###tramp-autoload
(defcustom tramp-smb-winexe-shell-command-switch "-file -"
"Command switch used together with `tramp-smb-winexe-shell-command'.
This can be used to disable echo etc."
@@ -358,140 +394,152 @@ pass to the OPERATION."
(throw 'tramp-action 'ok)))))
(defun tramp-smb-handle-copy-directory
- (dirname newname &optional keep-date parents _copy-contents)
+ (dirname newname &optional keep-date parents copy-contents)
"Like `copy-directory' for Tramp files."
- (setq dirname (expand-file-name dirname)
- newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p dirname))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 dirname newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Copying %s to %s" dirname 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)))))
- (unwind-protect
- (progn
- (tramp-compat-copy-directory dirname tmpdir keep-date parents)
- (tramp-compat-copy-directory tmpdir newname keep-date parents))
- (tramp-compat-delete-directory tmpdir 'recursive))))
-
- ;; We can copy recursively.
- ((or t1 t2)
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname))
- (if t2 (setq v (tramp-dissect-file-name newname))))
- (if (not (file-directory-p newname))
- (make-directory newname parents))
-
- (setq tramp-current-method (tramp-file-name-method v)
- tramp-current-user (tramp-file-name-user v)
- tramp-current-host (tramp-file-name-real-host v))
-
- (let* ((real-user (tramp-file-name-real-user v))
- (real-host (tramp-file-name-real-host v))
- (domain (tramp-file-name-domain v))
- (port (tramp-file-name-port v))
- (share (tramp-smb-get-share v))
- (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))))
- (args (list tramp-smb-program
- (concat "//" real-host "/" share) "-E")))
-
- (if (not (zerop (length real-user)))
- (setq args (append args (list "-U" real-user)))
- (setq args (append args (list "-N"))))
-
- (when domain (setq args (append args (list "-W" domain))))
- (when port (setq args (append args (list "-p" port))))
- (when tramp-smb-conf
- (setq args (append args (list "-s" tramp-smb-conf))))
- (setq args
- (if t1
- ;; Source is remote.
- (append args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qc - *")
- "|" "tar" "xfC" "-"
- (shell-quote-argument tmpdir)))
- ;; Target is remote.
- (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
- "." "|")
- args
- (list "-D" (shell-quote-argument localname)
- "-c" (shell-quote-argument "tar qx -")))))
-
- (unwind-protect
- (with-temp-buffer
- ;; Set the transfer process properties.
- (tramp-set-connection-property
- v "process-name" (buffer-name (current-buffer)))
- (tramp-set-connection-property
- v "process-buffer" (current-buffer))
-
- (when t1
- ;; The smbclient tar command creates always complete
- ;; paths. We must emulate the directory structure,
- ;; and symlink to the real target.
- (make-directory
- (expand-file-name ".." (concat tmpdir localname)) 'parents)
- (make-symbolic-link
- newname (directory-file-name (concat tmpdir localname))))
-
- ;; Use an asynchronous processes. By this, password
- ;; can be handled.
- (let* ((default-directory tmpdir)
- (p (start-process-shell-command
- (tramp-get-connection-name v)
- (tramp-get-connection-buffer v)
- (mapconcat 'identity args " "))))
-
- (tramp-message
- v 6 "%s" (mapconcat 'identity (process-command p) " "))
- (tramp-compat-set-process-query-on-exit-flag p nil)
- (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
- (while (memq (process-status p) '(run open))
- (sit-for 0.1))
- (tramp-message v 6 "\n%s" (buffer-string))))
-
- ;; Reset the transfer process properties.
- (tramp-set-connection-property v "process-name" nil)
- (tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
-
- ;; Handle KEEP-DATE argument.
- (when keep-date
- (set-file-times newname (nth 5 (file-attributes dirname))))
-
- ;; Set the mode.
- (unless keep-date
- (set-file-modes newname (tramp-default-file-modes dirname)))
-
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname))))
-
- ;; We must do it file-wise.
- (t
- (tramp-run-real-handler
- 'copy-directory (list dirname newname keep-date parents))))))))
+ (if copy-contents
+ ;; We must do it file-wise.
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents copy-contents))
+
+ (setq dirname (expand-file-name dirname)
+ newname (expand-file-name newname))
+ (let ((t1 (tramp-tramp-file-p dirname))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 dirname newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" dirname 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)))))
+ (unwind-protect
+ (progn
+ (make-directory tmpdir)
+ (tramp-compat-copy-directory
+ dirname tmpdir keep-date 'parents)
+ (tramp-compat-copy-directory
+ (expand-file-name (file-name-nondirectory dirname) tmpdir)
+ newname keep-date parents))
+ (tramp-compat-delete-directory tmpdir 'recursive))))
+
+ ;; We can copy recursively.
+ ((or t1 t2)
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname))
+ (if t2 (setq v (tramp-dissect-file-name newname))))
+ (if (not (file-directory-p newname))
+ (make-directory newname parents))
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (file-name-as-directory
+ (tramp-compat-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))))
+ (args (list (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq args
+ (if t1
+ ;; Source is remote.
+ (append args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qc - *")
+ "|" "tar" "xfC" "-"
+ (shell-quote-argument tmpdir)))
+ ;; Target is remote.
+ (append (list "tar" "cfC" "-"
+ (shell-quote-argument dirname) "." "|")
+ args
+ (list "-D" (shell-quote-argument localname)
+ "-c" (shell-quote-argument "tar qx -")))))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ (when t1
+ ;; The smbclient tar command creates always
+ ;; complete paths. We must emulate the
+ ;; directory structure, and symlink to the real
+ ;; target.
+ (make-directory
+ (expand-file-name
+ ".." (concat tmpdir localname)) 'parents)
+ (make-symbolic-link
+ newname (directory-file-name (concat tmpdir localname))))
+
+ ;; Use an asynchronous processes. By this,
+ ;; password can be handled.
+ (let* ((default-directory tmpdir)
+ (p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+ (while (memq (process-status p) '(run open))
+ (sit-for 0.1))
+ (tramp-message v 6 "\n%s" (buffer-string))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)
+ (when t1 (tramp-compat-delete-directory tmpdir 'recurse))))
+
+ ;; Handle KEEP-DATE argument.
+ (when keep-date
+ (set-file-times newname (nth 5 (file-attributes dirname))))
+
+ ;; Set the mode.
+ (unless keep-date
+ (set-file-modes newname (tramp-default-file-modes dirname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname))))
+
+ ;; We must do it file-wise.
+ (t
+ (tramp-run-real-handler
+ 'copy-directory (list dirname newname keep-date parents)))))))))
(defun tramp-smb-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -502,7 +550,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
@@ -537,7 +586,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(unless (tramp-smb-send-command
v (format "put \"%s\" \"%s\""
filename (tramp-smb-get-localname v)))
- (tramp-error v 'file-error "Cannot copy `%s'" filename))))))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname))))))
;; KEEP-DATE handling.
(when keep-date
@@ -610,12 +660,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when full
(setq result
(mapcar
- (lambda (x) (expand-file-name x directory))
+ (lambda (x) (format "%s/%s" directory x))
result)))
;; Sort them if necessary.
(unless nosort (setq result (sort result 'string-lessp)))
- ;; That's it.
- result))
+ ;; Remove double entries.
+ (tramp-compat-delete-dups result)))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
@@ -647,22 +697,83 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
method user host
(tramp-run-real-handler 'expand-file-name (list localname))))))
+(defun tramp-smb-action-get-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ ;; There might be a hidden password prompt.
+ (widen)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (looking-at "^REVISION:")))
+ (forward-line)
+ (delete-region (point-min) (point)))
+ (while (and (not (eobp)) (looking-at "^.+:.+"))
+ (forward-line))
+ (delete-region (point) (point-max))
+ (throw 'tramp-action 'ok))))
+
(defun tramp-smb-handle-file-acl (filename)
"Like `file-acl' for Tramp files."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "file-acl"
- (when (tramp-smb-send-command
- v (format "getfacl \"%s\"" (tramp-smb-get-localname v)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (while (looking-at "^#")
- (forward-line)
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (delete-blank-lines)
- (when (> (point-max) (point-min))
- (tramp-compat-funcall
- 'substring-no-properties (buffer-string))))))))
+ (when (executable-find tramp-smb-acl-program)
+
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E")))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname) "2>/dev/null")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password
+ ;; can be handled.
+ (let ((p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-get-acl)
+ (when (> (point-max) (point-min))
+ (tramp-compat-funcall
+ 'substring-no-properties (buffer-string)))))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files."
@@ -671,7 +782,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property
v localname (format "file-attributes-%s" id-format)
- (if (and (tramp-smb-get-share v) (tramp-smb-get-stat-capability v))
+ (if (tramp-smb-get-stat-capability v)
(tramp-smb-do-file-attributes-with-stat v id-format)
;; Reading just the filename entry via "dir localname" is not
;; possible, because when filename is a directory, some
@@ -822,101 +933,109 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
+ (unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
(if full-directory-p
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
(with-parsed-tramp-file-name filename nil
- (save-match-data
- (let ((base (file-name-nondirectory filename))
- ;; We should not destroy the cache entry.
- (entries (copy-sequence
- (tramp-smb-get-file-entries
- (file-name-directory filename)))))
-
- (when wildcard
- (string-match "\\." base)
- (setq base (replace-match "\\\\." nil nil base))
- (string-match "\\*" base)
- (setq base (replace-match ".*" nil nil base))
- (string-match "\\?" base)
- (setq base (replace-match ".?" nil nil base)))
-
- ;; Filter entries.
- (setq entries
- (delq
- nil
- (if (or wildcard (zerop (length base)))
- ;; Check for matching entries.
- (mapcar
- (lambda (x)
- (when (string-match
- (format "^%s" base) (nth 0 x))
- x))
- entries)
- ;; We just need the only and only entry FILENAME.
- (list (assoc base entries)))))
-
- ;; Sort entries.
- (setq entries
- (sort
- entries
- (lambda (x y)
- (if (string-match "t" switches)
- ;; Sort by date.
- (tramp-time-less-p (nth 3 y) (nth 3 x))
- ;; Sort by name.
- (string-lessp (nth 0 x) (nth 0 y))))))
-
- ;; Handle "-F" switch.
- (when (string-match "F" switches)
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ (save-match-data
+ (let ((base (file-name-nondirectory filename))
+ ;; We should not destroy the cache entry.
+ (entries (copy-sequence
+ (tramp-smb-get-file-entries
+ (file-name-directory filename)))))
+
+ (when wildcard
+ (string-match "\\." base)
+ (setq base (replace-match "\\\\." nil nil base))
+ (string-match "\\*" base)
+ (setq base (replace-match ".*" nil nil base))
+ (string-match "\\?" base)
+ (setq base (replace-match ".?" nil nil base)))
+
+ ;; Filter entries.
+ (setq entries
+ (delq
+ nil
+ (if (or wildcard (zerop (length base)))
+ ;; Check for matching entries.
+ (mapcar
+ (lambda (x)
+ (when (string-match
+ (format "^%s" base) (nth 0 x))
+ x))
+ entries)
+ ;; We just need the only and only entry FILENAME.
+ (list (assoc base entries)))))
+
+ ;; Sort entries.
+ (setq entries
+ (sort
+ entries
+ (lambda (x y)
+ (if (string-match "t" switches)
+ ;; Sort by date.
+ (time-less-p (nth 3 y) (nth 3 x))
+ ;; Sort by name.
+ (string-lessp (nth 0 x) (nth 0 y))))))
+
+ ;; Handle "-F" switch.
+ (when (string-match "F" switches)
+ (mapc
+ (lambda (x)
+ (when (not (zerop (length (car x))))
+ (cond
+ ((char-equal ?d (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "/")))
+ ((char-equal ?x (string-to-char (nth 1 x)))
+ (setcar x (concat (car x) "*"))))))
+ entries))
+
+ ;; Print entries.
(mapc
(lambda (x)
- (when (not (zerop (length (car x))))
- (cond
- ((char-equal ?d (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "/")))
- ((char-equal ?x (string-to-char (nth 1 x)))
- (setcar x (concat (car x) "*"))))))
- entries))
-
- ;; Print entries.
- (mapc
- (lambda (x)
- (when (not (zerop (length (nth 0 x))))
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
- (insert
- (format
- "%10s %3d %-8s %-8s %8s %s "
- (or (nth 8 attr) (nth 1 x)) ; mode
- (or (nth 1 attr) 1) ; inode
- (or (nth 2 attr) "nobody") ; uid
- (or (nth 3 attr) "nogroup") ; gid
- (or (nth 7 attr) (nth 2 x)) ; size
- (format-time-string
- (if (tramp-time-less-p
- (tramp-time-subtract (current-time) (nth 3 x))
- tramp-half-a-year)
- "%b %e %R"
- "%b %e %Y")
- (nth 3 x)))) ; date
+ (when (not (zerop (length (nth 0 x))))
+ (when (string-match "l" switches)
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes filename 'string)))))
+ (insert
+ (format
+ "%10s %3d %-8s %-8s %8s %s "
+ (or (nth 8 attr) (nth 1 x)) ; mode
+ (or (nth 1 attr) 1) ; inode
+ (or (nth 2 attr) "nobody") ; uid
+ (or (nth 3 attr) "nogroup") ; gid
+ (or (nth 7 attr) (nth 2 x)) ; size
+ (format-time-string
+ (if (time-less-p (time-subtract (current-time) (nth 3 x))
+ tramp-half-a-year)
+ "%b %e %R"
+ "%b %e %Y")
+ (nth 3 x)))))) ; date
+
;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file
- ;; name of `default-directory'.
+ ;; from somewhere else, so we use the relative file name
+ ;; of `default-directory'.
(let ((start (point)))
(insert
(format
"%s\n"
(file-relative-name
(expand-file-name
- (nth 0 x) (file-name-directory filename)))))
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
(put-text-property start (1- (point)) 'dired-filename t))
(forward-line)
- (beginning-of-line))))
- entries)))))
+ (beginning-of-line)))
+ entries))))))
(defun tramp-smb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@@ -1110,8 +1229,8 @@ target of the symlink differ."
(error
(setq ret 1)))
- ;; We should show the output anyway.
- (when (and outbuf display) (display-buffer outbuf))
+ ;; We should redisplay the output.
+ (when (and display outbuf (get-buffer-window outbuf t)) (redisplay))
;; Cleanup. We remove all file cache values for the connection,
;; because the remote process could have changed them.
@@ -1122,9 +1241,9 @@ target of the symlink differ."
(kill-buffer (tramp-get-connection-property v "process-buffer" nil)))
;; `process-file-side-effects' has been introduced with GNU
- ;; Emacs 23.2. If set to `nil', no remote file will be changed
+ ;; Emacs 23.2. If set to nil, no remote file will be changed
;; by `program'. If it doesn't exist, we assume its default
- ;; value `t'.
+ ;; value t.
(unless (and (boundp 'process-file-side-effects)
(not (symbol-value 'process-file-side-effects)))
(tramp-flush-directory-property v ""))
@@ -1144,14 +1263,16 @@ target of the symlink differ."
(file-exists-p newname))
(tramp-error
(tramp-dissect-file-name
- (if (file-remote-p filename) filename newname))
+ (if (tramp-tramp-file-p filename) filename newname))
'file-already-exists newname))
(with-tramp-progress-reporter
- (tramp-dissect-file-name (if (file-remote-p filename) filename newname))
+ (tramp-dissect-file-name
+ (if (tramp-tramp-file-p filename) filename newname))
0 (format "Renaming %s to %s" filename newname)
- (if (and (tramp-equal-remote filename newname)
+ (if (and (not (file-exists-p newname))
+ (tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
@@ -1161,6 +1282,8 @@ target of the symlink differ."
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(unless (tramp-smb-get-share v2)
@@ -1178,6 +1301,86 @@ target of the symlink differ."
(tramp-compat-delete-directory filename 'recursive)
(delete-file filename)))))
+(defun tramp-smb-action-set-acl (proc vec)
+ "Read ACL data from connection buffer."
+ (when (not (memq (process-status proc) '(run open)))
+ ;; Accept pending output.
+ (while (tramp-accept-process-output proc 0.1))
+ (with-current-buffer (tramp-get-connection-buffer vec)
+ (tramp-message vec 10 "\n%s" (buffer-string))
+ (throw 'tramp-action 'ok))))
+
+(defun tramp-smb-handle-set-file-acl (filename acl-string)
+ "Like `set-file-acl' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name filename nil
+ (when (and (stringp acl-string) (executable-find tramp-smb-acl-program))
+ (setq tramp-current-method (tramp-file-name-method v)
+ tramp-current-user (tramp-file-name-user v)
+ tramp-current-host (tramp-file-name-real-host v))
+ (tramp-set-file-property v localname "file-acl" 'undef)
+
+ (let* ((real-user (tramp-file-name-real-user v))
+ (real-host (tramp-file-name-real-host v))
+ (domain (tramp-file-name-domain v))
+ (port (tramp-file-name-port v))
+ (share (tramp-smb-get-share v))
+ (localname (tramp-compat-replace-regexp-in-string
+ "\\\\" "/" (tramp-smb-get-localname v)))
+ (args (list (concat "//" real-host "/" share) "-E" "-S"
+ (tramp-compat-replace-regexp-in-string
+ "\n" "," acl-string))))
+
+ (if (not (zerop (length real-user)))
+ (setq args (append args (list "-U" real-user)))
+ (setq args (append args (list "-N"))))
+
+ (when domain (setq args (append args (list "-W" domain))))
+ (when port (setq args (append args (list "-p" port))))
+ (when tramp-smb-conf
+ (setq args (append args (list "-s" tramp-smb-conf))))
+ (setq
+ args
+ (append args (list (shell-quote-argument localname)
+ "&&" "echo" "tramp_exit_status" "0"
+ "||" "echo" "tramp_exit_status" "1")))
+
+ (unwind-protect
+ (with-temp-buffer
+ ;; Set the transfer process properties.
+ (tramp-set-connection-property
+ v "process-name" (buffer-name (current-buffer)))
+ (tramp-set-connection-property
+ v "process-buffer" (current-buffer))
+
+ ;; Use an asynchronous processes. By this, password can
+ ;; be handled.
+ (let ((p (apply
+ 'start-process
+ (tramp-get-connection-name v)
+ (tramp-get-connection-buffer v)
+ tramp-smb-acl-program args)))
+
+ (tramp-message
+ v 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" v)
+ (tramp-compat-set-process-query-on-exit-flag p nil)
+ (tramp-process-actions p v nil tramp-smb-actions-set-acl)
+ (goto-char (point-max))
+ (unless (re-search-backward "tramp_exit_status [0-9]+" nil t)
+ (tramp-error
+ v 'file-error
+ "Couldn't find exit status of `%s'" tramp-smb-acl-program))
+ (skip-chars-forward "^ ")
+ (when (zerop (read (current-buffer)))
+ ;; Success.
+ (tramp-set-file-property v localname "file-acl" acl-string)
+ t)))
+
+ ;; Reset the transfer process properties.
+ (tramp-set-connection-property v "process-name" nil)
+ (tramp-set-connection-property v "process-buffer" nil)))))))
+
(defun tramp-smb-handle-set-file-modes (filename mode)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
@@ -1257,9 +1460,6 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (unless (eq append nil)
- (tramp-error
- v 'file-error "Cannot append to file using Tramp (`%s')" filename))
;; XEmacs takes a coding system as the seventh argument, not `confirm'.
(when (and (not (featurep 'xemacs))
confirm (file-exists-p filename))
@@ -1272,6 +1472,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(tramp-flush-file-property v localname)
(let ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
+ (when (and append (file-exists-p filename))
+ (copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the visited file
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
@@ -1364,14 +1566,14 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
(while (not (eobp))
(setq entry (tramp-smb-read-file-entry share))
(forward-line)
- (when entry (add-to-list 'res entry))))
+ (when entry (push entry res))))
;; Cache share entries.
(unless share
(tramp-set-connection-property v "share-cache" res)))
;; Add directory itself.
- (add-to-list 'res '("" "drwxrwxrwx" 0 (0 0)))
+ (push '("" "drwxrwxrwx" 0 (0 0)) res)
;; There's a very strange error (debugged with XEmacs 21.4.14)
;; If there's no short delay, it returns nil. No idea about.
@@ -1541,11 +1743,12 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
(defun tramp-smb-get-stat-capability (vec)
"Check, whether the SMB server supports the STAT command."
;; When we are not logged in yet, we return nil.
- (if (let ((p (tramp-get-connection-process vec)))
- (and p (processp p) (memq (process-status p) '(run open))))
+ (if (and (tramp-smb-get-share vec)
+ (let ((p (tramp-get-connection-process vec)))
+ (and p (processp p) (memq (process-status p) '(run open)))))
(with-tramp-connection-property
(tramp-get-connection-process vec) "stat-capability"
- (tramp-smb-send-command vec "stat ."))))
+ (tramp-smb-send-command vec "stat \"/\""))))
;; Connection functions.
@@ -1564,6 +1767,8 @@ Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason.
If ARGUMENT is non-nil, use it as argument for
`tramp-smb-winexe-program', and suppress any checks."
+ (tramp-check-proper-method-and-host vec)
+
(let* ((share (tramp-smb-get-share vec))
(buf (tramp-get-connection-buffer vec))
(p (get-buffer-process buf)))
@@ -1672,6 +1877,7 @@ If ARGUMENT is non-nil, use it as argument for
(tramp-message
vec 6 "%s" (mapconcat 'identity (process-command p) " "))
+ (tramp-set-connection-property p "vector" vec)
(tramp-compat-set-process-query-on-exit-flag p nil)
;; Set variables for computing the prompt for reading password.
@@ -1717,11 +1923,15 @@ If ARGUMENT is non-nil, use it as argument for
(error
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
- (if (search-forward-regexp
- tramp-smb-wrong-passwd-regexp nil t)
+ (if (and (boundp 'auth-sources)
+ (symbol-value 'auth-sources)
+ (search-forward-regexp
+ tramp-smb-wrong-passwd-regexp nil t))
;; Disable `auth-source' and `password-cache'.
(let (auth-sources)
- (tramp-cleanup vec)
+ (tramp-message
+ vec 3 "Retry connection with new password")
+ (tramp-cleanup-connection vec t)
(tramp-smb-maybe-open-connection vec argument))
;; Propagate the error.
(signal (car err) (cdr err)))))))))))))
@@ -1785,10 +1995,6 @@ Returns nil if an error message has appeared."
(defun tramp-smb-call-winexe (vec)
"Apply a remote command, if possible, using `tramp-smb-winexe-program'."
- ;; We call `tramp-get-buffer' in order to get a debug buffer for
- ;; messages.
- (tramp-get-buffer vec)
-
;; Check for program.
(unless (executable-find tramp-smb-winexe-program)
(tramp-error
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 6cf5baeccd8..efa43b5880e 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -1,6 +1,6 @@
;;; tramp-uu.el --- uuencode in Lisp
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Keywords: comm, terminals
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index cd7d17b130c..2f811bb73ca 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,6 +1,6 @@
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Michael Albinus <michael.albinus@gmx.de>
@@ -49,9 +49,8 @@
;; http://lists.gnu.org/mailman/listinfo/tramp-devel
;;
;; For the adventurous, the current development sources are available
-;; via CVS. You can find instructions about this at the following URL:
+;; via Git. You can find instructions about this at the following URL:
;; http://savannah.gnu.org/projects/tramp/
-;; Click on "CVS" in the navigation bar near the top.
;;
;; Don't forget to put on your asbestos longjohns, first!
@@ -65,7 +64,7 @@
(defvar bkup-backup-directory-info)
(defvar directory-sep-char)
(defvar eshell-path-env)
-(defvar file-notify-descriptors)
+(defvar ls-lisp-use-insert-directory-program)
(defvar outline-regexp)
;;; User Customizable Internal Variables:
@@ -74,6 +73,7 @@
"Edit remote files with a combination of ssh, scp, etc."
:group 'files
:group 'comm
+ :link '(custom-manual "(tramp)Top")
:version "22.1")
;; Maybe we need once a real Tramp mode, with key bindings etc.
@@ -110,9 +110,9 @@ Any level x includes messages for all levels 1 .. x-1. The levels are
Each element looks like (REGEXP . DIRECTORY), with the same meaning like
in `backup-directory-alist'. If a Tramp file is backed up, and DIRECTORY
is a local file name, the backup directory is prepended with Tramp file
-name prefix \(method, user, host\) of file.
+name prefix \(method, user, host) of file.
-\(setq tramp-backup-directory-alist backup-directory-alist\)
+\(setq tramp-backup-directory-alist backup-directory-alist)
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
@@ -129,9 +129,9 @@ policy for local files."
It has the same meaning like `bkup-backup-directory-info' from package
`backup-dir'. If a Tramp file is backed up, and BACKUP-DIR is a local
file name, the backup directory is prepended with Tramp file name prefix
-\(method, user, host\) of file.
+\(method, user, host) of file.
-\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info\)
+\(setq tramp-bkup-backup-directory-info bkup-backup-directory-info)
gives the same backup policy for Tramp files on their hosts like the
policy for local files."
@@ -147,9 +147,11 @@ policy for local files."
(defcustom tramp-auto-save-directory nil
"Put auto-save files in this directory, if set.
-The idea is to use a local directory so that auto-saving is faster."
+The idea is to use a local directory so that auto-saving is faster.
+This setting has precedence over `auto-save-file-name-transforms'."
:group 'tramp
- :type '(choice (const nil) string))
+ :type '(choice (const :tag "Use default" nil)
+ (directory :tag "Auto save directory name")))
(defcustom tramp-encoding-shell
(if (memq system-type '(windows-nt))
@@ -208,6 +210,12 @@ pair of the form (KEY VALUE). The following KEYs are defined:
for it. Also note that \"/bin/sh\" exists on all Unixen,
this might not be true for the value that you decide to use.
You Have Been Warned.
+ * `tramp-remote-shell-login'
+ This specifies the arguments to let `tramp-remote-shell' run
+ as a login shell. It defaults to (\"-l\"), but some shells,
+ like ksh, require another argument. See
+ `tramp-connection-properties' for a way to overwrite the
+ default value.
* `tramp-remote-shell-args'
For implementation of `shell-command', this specifies the
arguments to let `tramp-remote-shell' run a single command.
@@ -230,6 +238,9 @@ pair of the form (KEY VALUE). The following KEYs are defined:
`tramp-make-tramp-temp-file'. \"%k\" indicates the keep-date
parameter of a program, if exists. \"%c\" adds additional
`tramp-ssh-controlmaster-options' options for the first hop.
+ * `tramp-login-env'
+ A list of environment variables and their values, which will
+ be set when calling `tramp-login-program'.
* `tramp-async-args'
When an asynchronous process is started, we know already that
the connection works. Therefore, we can pass additional
@@ -237,11 +248,21 @@ pair of the form (KEY VALUE). The following KEYs are defined:
tamper the process output.
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
- the file; this might be the absolute filename of rcp or the name of
- a workalike program.
+ the file; this might be the absolute filename of scp or the name of
+ a workalike program. It is always applied on the local host.
* `tramp-copy-args'
This specifies the list of parameters to pass to the above mentioned
program, the hints for `tramp-login-args' also apply here.
+ * `tramp-copy-env'
+ A list of environment variables and their values, which will
+ be set when calling `tramp-copy-program'.
+ * `tramp-remote-copy-program'
+ The listener program to be applied on remote side, if needed.
+ * `tramp-remote-copy-args'
+ The list of parameters to pass to the listener program, the hints
+ for `tramp-login-args' also apply here. Additionally, \"%r\" could
+ be used here and in `tramp-copy-args'. It denotes a randomly
+ chosen port for the remote listener.
* `tramp-copy-keep-date'
This specifies whether the copying program when the preserves the
timestamp of the original file.
@@ -269,7 +290,7 @@ pair of the form (KEY VALUE). The following KEYs are defined:
What does all this mean? Well, you should specify `tramp-login-program'
for all methods; this program is used to log in to the remote site. Then,
there are two ways to actually transfer the files between the local and the
-remote side. One way is using an additional rcp-like program. If you want
+remote side. One way is using an additional scp-like program. If you want
to do this, set `tramp-copy-program' in the method.
Another possibility for file transfer is inline transfer, i.e. the
@@ -287,40 +308,13 @@ are fit for gateways must have `tramp-default-port' at least.
Notes:
-When using `su' or `sudo' the phrase `open connection to a remote
-host' sounds strange, but it is used nevertheless, for consistency.
+When using `su' or `sudo' the phrase \"open connection to a remote
+host\" sounds strange, but it is used nevertheless, for consistency.
No connection is opened to a remote host, but `su' or `sudo' is
started on the local host. You should specify a remote host
`localhost' or the name of the local host. Another host name is
useful only in combination with `tramp-default-proxies-alist'.")
-;;;###tramp-autoload
-(defconst tramp-ssh-controlmaster-options
- (let ((result ""))
- (ignore-errors
- (with-temp-buffer
- (call-process "ssh" nil t nil "-o" "ControlMaster")
- (goto-char (point-min))
- (when (search-forward-regexp "Missing ControlMaster argument" nil t)
- (setq result "-o ControlPath=%t.%%r@%%h:%%p -o ControlMaster=auto")))
- (when result
- (with-temp-buffer
- (call-process "ssh" nil t nil "-o" "ControlPersist")
- (goto-char (point-min))
- (when (search-forward-regexp "Missing ControlPersist argument" nil t)
- (setq result (concat result " -o ControlPersist=no"))))))
- result)
- "Call ssh to detect whether it supports the Control* arguments.
-Return a string to be used in `tramp-methods'.")
-
-;;;###tramp-autoload
-(defcustom tramp-use-ssh-controlmaster-options
- (not (zerop (length tramp-ssh-controlmaster-options)))
- "Whether to use `tramp-ssh-controlmaster-options'."
- :group 'tramp
- :version "24.4"
- :type 'boolean)
-
(defcustom tramp-default-method
;; An external copy method seems to be preferred, because it performs
;; much better for large files, and it hasn't too serious delays
@@ -351,9 +345,7 @@ Return a string to be used in `tramp-methods'.")
(fboundp 'auth-source-search)
;; ssh-agent is running.
(getenv "SSH_AUTH_SOCK")
- (getenv "SSH_AGENT_PID")
- ;; We could reuse the connection.
- (> (length tramp-ssh-controlmaster-options) 0))
+ (getenv "SSH_AGENT_PID"))
"scp"
"ssh"))
;; Fallback.
@@ -472,15 +464,15 @@ host runs a registered shell, it shall be added to this list, too."
(concat
"\\`"
(regexp-opt
- (list "localhost" "localhost6" (system-name) "127\.0\.0\.1" "::1") t)
+ (list "localhost" "localhost6" (system-name) "127.0.0.1" "::1") t)
"\\'")
"Host names which are regarded as local host.")
(defvar tramp-completion-function-alist nil
"Alist of methods for remote files.
-This is a list of entries of the form \(NAME PAIR1 PAIR2 ...\).
+This is a list of entries of the form \(NAME PAIR1 PAIR2 ...).
Each NAME stands for a remote access method. Each PAIR is of the form
-\(FUNCTION FILE\). FUNCTION is responsible to extract user names and host
+\(FUNCTION FILE). FUNCTION is responsible to extract user names and host
names from FILE for completion. The following predefined FUNCTIONs exists:
* `tramp-parse-rhosts' for \"~/.rhosts\" like files,
@@ -493,7 +485,7 @@ names from FILE for completion. The following predefined FUNCTIONs exists:
* `tramp-parse-netrc' for \"~/.netrc\" like files.
* `tramp-parse-putty' for PuTTY registered sessions.
-FUNCTION can also be a customer defined function. For more details see
+FUNCTION can also be a user defined function. For more details see
the info pages.")
(defconst tramp-echo-mark-marker "_echo"
@@ -535,7 +527,7 @@ if you need to change this."
:type 'string)
(defcustom tramp-login-prompt-regexp
- ".*ogin\\( .*\\)?: *"
+ ".*\\(user\\|login\\)\\( .*\\)?: *"
"Regexp matching login-like prompts.
The regexp should match at end of buffer.
@@ -566,11 +558,15 @@ This regexp must match both `tramp-initial-end-of-output' and
:type 'regexp)
(defcustom tramp-password-prompt-regexp
- "^.*\\([pP]assword\\|[pP]assphrase\\).*:\^@? *"
+ (format "^.*\\(%s\\).*:\^@? *"
+ (if (boundp 'password-word-equivalents)
+ (regexp-opt (symbol-value 'password-word-equivalents))
+ "password\\|passphrase"))
"Regexp matching password-like prompts.
The regexp should match at end of buffer.
The `sudo' program appears to insert a `^@' character into the prompt."
+ :version "24.4"
:group 'tramp
:type 'regexp)
@@ -690,7 +686,7 @@ Useful for \"rsync\" like methods.")
;; Tramp only knows how to deal with `file-name-handler-alist', not
;; the other places.
-;; Currently, we have the choice between 'ftp, 'sep, and 'url.
+;; Currently, we have the choice between 'ftp and 'sep.
;;;###autoload
(defcustom tramp-syntax
(if (featurep 'xemacs) 'sep 'ftp)
@@ -699,20 +695,15 @@ Useful for \"rsync\" like methods.")
It can have the following values:
'ftp -- Ange-FTP respective EFS like syntax (GNU Emacs default)
- 'sep -- Syntax as defined for XEmacs (not available yet for GNU Emacs)
- 'url -- URL-like syntax."
+ 'sep -- Syntax as defined for XEmacs."
:group 'tramp
- :type (if (featurep 'xemacs)
- '(choice (const :tag "EFS" ftp)
- (const :tag "XEmacs" sep)
- (const :tag "URL" url))
- '(choice (const :tag "Ange-FTP" ftp)
- (const :tag "URL" url))))
+ :version "24.4"
+ :type `(choice (const :tag ,(if (featurep 'xemacs) "EFS" "Ange-FTP") ftp)
+ (const :tag "XEmacs" sep)))
(defconst tramp-prefix-format
(cond ((equal tramp-syntax 'ftp) "/")
((equal tramp-syntax 'sep) "/[")
- ((equal tramp-syntax 'url) "/")
(t (error "Wrong `tramp-syntax' defined")))
"String matching the very beginning of Tramp file names.
Used in `tramp-make-tramp-file-name'.")
@@ -729,7 +720,6 @@ Should always start with \"^\". Derived from `tramp-prefix-format'.")
(defconst tramp-postfix-method-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "/")
- ((equal tramp-syntax 'url) "://")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between method and user or host names.
Used in `tramp-make-tramp-file-name'.")
@@ -776,7 +766,6 @@ Derived from `tramp-postfix-user-format'.")
(defconst tramp-prefix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "[")
((equal tramp-syntax 'sep) "")
- ((equal tramp-syntax 'url) "[")
(t (error "Wrong `tramp-syntax' defined")))
"String matching left hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
@@ -796,7 +785,6 @@ Derived from `tramp-prefix-ipv6-format'.")
(defconst tramp-postfix-ipv6-format
(cond ((equal tramp-syntax 'ftp) "]")
((equal tramp-syntax 'sep) "")
- ((equal tramp-syntax 'url) "]")
(t (error "Wrong `tramp-syntax' defined")))
"String matching right hand side of IPv6 addresses.
Used in `tramp-make-tramp-file-name'.")
@@ -809,7 +797,6 @@ Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format
(cond ((equal tramp-syntax 'ftp) "#")
((equal tramp-syntax 'sep) "#")
- ((equal tramp-syntax 'url) ":")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and port numbers.")
@@ -838,7 +825,6 @@ Derived from `tramp-postfix-hop-format'.")
(defconst tramp-postfix-host-format
(cond ((equal tramp-syntax 'ftp) ":")
((equal tramp-syntax 'sep) "]")
- ((equal tramp-syntax 'url) "")
(t (error "Wrong `tramp-syntax' defined")))
"String matching delimiter between host names and localnames.
Used in `tramp-make-tramp-file-name'.")
@@ -858,7 +844,7 @@ Derived from `tramp-postfix-host-format'.")
"\\(?:" "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp "\\)?"
"\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
"\\(" "\\(?:" tramp-host-regexp "\\|"
- tramp-prefix-ipv6-regexp tramp-ipv6-regexp
+ tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
tramp-postfix-ipv6-regexp "\\)"
"\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")
"Regular expression matching a Tramp file name between prefix and postfix.")
@@ -894,8 +880,8 @@ See also `tramp-file-name-regexp'.")
;;;###autoload
(defconst tramp-file-name-regexp-unified
(if (memq system-type '(cygwin windows-nt))
- "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):"
- "\\`/\\([^[/|:]+\\|[^/|]+]\\):")
+ "\\`/\\(\\[.*\\]\\|[^/|:]\\{2,\\}[^/|]*\\):"
+ "\\`/[^/|:][^/|]*:")
"Value for `tramp-file-name-regexp' for unified remoting.
Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and
Tramp. See `tramp-file-name-structure' for more explanations.
@@ -909,15 +895,9 @@ XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
-(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://"
- "Value for `tramp-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-;;;###autoload
(defconst tramp-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-file-name-regexp-separate)
- ((equal tramp-syntax 'url) tramp-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp.
This regexp should match Tramp file names but no other file names.
@@ -928,7 +908,7 @@ and is a bit too general, then some files might be considered Tramp
files which are not really Tramp files.
Please note that the entry in `file-name-handler-alist' is made when
-this file \(tramp.el\) is loaded. This means that this variable must be set
+this file \(tramp.el) is loaded. This means that this variable must be set
before loading tramp.el. Alternatively, `file-name-handler-alist' can be
updated after changing this variable.
@@ -952,22 +932,15 @@ XEmacs uses a separate filename syntax for Tramp and EFS.
See `tramp-file-name-structure' for more explanations.")
;;;###autoload
-(defconst tramp-completion-file-name-regexp-url
- "\\`/[^/:]+\\(:\\(/\\(/[^/]*\\)?\\)?\\)?\\'"
- "Value for `tramp-completion-file-name-regexp' for URL-like remoting.
-See `tramp-file-name-structure' for more explanations.")
-
-;;;###autoload
(defconst tramp-completion-file-name-regexp
(cond ((equal tramp-syntax 'ftp) tramp-completion-file-name-regexp-unified)
((equal tramp-syntax 'sep) tramp-completion-file-name-regexp-separate)
- ((equal tramp-syntax 'url) tramp-completion-file-name-regexp-url)
(t (error "Wrong `tramp-syntax' defined")))
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
Please note that the entry in `file-name-handler-alist' is made when
-this file \(tramp.el\) is loaded. This means that this variable must be set
+this file \(tramp.el) is loaded. This means that this variable must be set
before loading tramp.el. Alternatively, `file-name-handler-alist' can be
updated after changing this variable.
@@ -999,14 +972,14 @@ checked via the following code:
(erase-buffer)
(let ((proc (start-process (buffer-name) (current-buffer)
\"ssh\" \"-l\" user host \"wc\" \"-c\")))
- (when (memq (process-status proc) '(run open))
+ (when (memq (process-status proc) \\='(run open))
(process-send-string proc (make-string sent ?\\ ))
(process-send-eof proc)
(process-send-eof proc))
(while (not (progn (goto-char (point-min))
(re-search-forward \"\\\\w+\" (point-max) t)))
(accept-process-output proc 1))
- (when (memq (process-status proc) '(run open))
+ (when (memq (process-status proc) \\='(run open))
(setq received (string-to-number (match-string 0)))
(delete-process proc)
(message \"Bytes sent: %s\\tBytes received: %s\" sent received)
@@ -1020,18 +993,18 @@ checked via the following code:
In the Emacs normally running Tramp, evaluate the above code
\(replace \"xxx\" and \"yyy\" by the remote user and host name,
-respectively\). You can do this, for example, by pasting it into
+respectively). You can do this, for example, by pasting it into
the `*scratch*' buffer and then hitting C-j with the cursor after the
last closing parenthesis. Note that it works only if you have configured
-\"ssh\" to run without password query, see ssh-agent\(1\).
+\"ssh\" to run without password query, see ssh-agent(1).
You will see the number of bytes sent successfully to the remote host.
If that number exceeds 1000, you can stop the execution by hitting
C-g, because your Emacs is likely clean.
When it is necessary to set `tramp-chunksize', you might consider to
-use an out-of-the-band method \(like \"scp\"\) instead of an internal one
-\(like \"ssh\"\), because setting `tramp-chunksize' to non-nil decreases
+use an out-of-the-band method \(like \"scp\") instead of an internal one
+\(like \"ssh\"), because setting `tramp-chunksize' to non-nil decreases
performance.
If your Emacs is buggy, the code stops and gives you an indication
@@ -1057,7 +1030,9 @@ opening a connection to a remote host."
(defcustom tramp-connection-timeout 60
"Defines the max time to wait for establishing a connection (in seconds).
-This can be overwritten for different connection types in `tramp-methods'."
+This can be overwritten for different connection types in `tramp-methods'.
+
+The timeout does not include the time reading a password."
:group 'tramp
:version "24.4"
:type 'integer)
@@ -1067,7 +1042,7 @@ This can be overwritten for different connection types in `tramp-methods'."
This is necessary as self defense mechanism, in order to avoid
yo-yo connection attempts when the remote host is unavailable.
-A value of 0 or `nil' suppresses this check. This might be
+A value of 0 or nil suppresses this check. This might be
necessary, when several out-of-order copy operations are
performed, or when several asynchronous processes will be started
in a short time frame. In those cases it is recommended to
@@ -1082,8 +1057,8 @@ A remote directory might have changed its contents. In order to
make it visible during file name completion in the minibuffer,
Tramp flushes its cache and rereads the directory contents when
more than `tramp-completion-reread-directory-timeout' seconds
-have been gone since last remote command execution. A value of `t'
-would require an immediate reread during filename completion, `nil'
+have been gone since last remote command execution. A value of t
+would require an immediate reread during filename completion, nil
means to use always cached values for the directory contents."
:group 'tramp
:type '(choice (const nil) (const t) integer))
@@ -1120,15 +1095,31 @@ calling HANDLER.")
;;; Internal functions which must come first:
+(defsubst tramp-user-error (vec-or-proc format &rest args)
+ "Signal a pilot error."
+ (apply
+ 'tramp-error vec-or-proc
+ (if (fboundp 'user-error) 'user-error 'error) format args))
+
;; Conversion functions between external representation and
;; internal data structure. Convenience functions for internal
;; data structure.
-(defun tramp-get-method-parameter (method param)
+(defun tramp-get-method-parameter (vec param)
"Return the method parameter PARAM.
-If the `tramp-methods' entry does not exist, return nil."
- (let ((entry (assoc param (assoc method tramp-methods))))
- (when entry (cadr entry))))
+If VEC is a vector, check first in connection properties.
+Afterwards, check in `tramp-methods'. If the `tramp-methods'
+entry does not exist, return nil."
+ (let ((hash-entry
+ (tramp-compat-replace-regexp-in-string
+ "^tramp-" "" (symbol-name param))))
+ (if (tramp-connection-property-p vec hash-entry)
+ ;; 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))))))
(defun tramp-file-name-p (vec)
"Check, whether VEC is a Tramp object."
@@ -1192,7 +1183,7 @@ If the `tramp-methods' entry does not exist, return nil."
(or (and (stringp host)
(string-match tramp-host-with-port-regexp host)
(string-to-number (match-string 2 host)))
- (tramp-get-method-parameter method 'tramp-default-port)))))
+ (tramp-get-method-parameter vec 'tramp-default-port)))))
;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
@@ -1232,30 +1223,40 @@ their replacement."
(if noninteractive
(warn "Method %s is obsolete, using %s"
result (substring result 0 -1))
- (unless (y-or-n-p (format "Method %s is obsolete, use %s? "
+ (unless (y-or-n-p (format "Method \"%s\" is obsolete, use \"%s\"? "
result (substring result 0 -1)))
- (tramp-compat-user-error "Method \"%s\" not supported" result)))
+ (tramp-user-error nil "Method \"%s\" not supported" result)))
(add-to-list 'tramp-warned-obsolete-methods result))
;; This works with the current set of `tramp-obsolete-methods'.
;; Must be improved, if their are more sophisticated replacements.
(setq result (substring result 0 -1)))
- result))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or method (null result) (null (functionp 'propertize)))
+ result
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-user (method user host)
"Return the right user string to use.
This is USER, if non-nil. Otherwise, do a lookup in
`tramp-default-user-alist'."
- (or user
- (let ((choices tramp-default-user-alist)
- luser item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or method ""))
- (string-match (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
- luser)
- tramp-default-user))
+ (let ((result
+ (or user
+ (let ((choices tramp-default-user-alist)
+ luser item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or method ""))
+ (string-match (or (nth 1 item) "") (or host "")))
+ (setq luser (nth 2 item))
+ (setq choices nil)))
+ luser)
+ tramp-default-user)))
+ ;; We must mark, whether a default value has been used. Not
+ ;; applicable for XEmacs.
+ (if (or user (null result) (null (functionp 'propertize)))
+ result
+ (tramp-compat-funcall 'propertize result 'tramp-default t))))
(defun tramp-find-host (method user host)
"Return the right host string to use.
@@ -1272,6 +1273,22 @@ This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
lhost)
tramp-default-host))
+(defun tramp-check-proper-method-and-host (vec)
+ "Check method and host name of VEC."
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-host vec))
+ (methods (mapcar 'car tramp-methods)))
+ (when (and method (not (member method methods)))
+ (tramp-cleanup-connection vec)
+ (tramp-user-error vec "Unknown method \"%s\"" method))
+ (when (and (equal tramp-syntax 'ftp) host
+ (or (null method) (get-text-property 0 'tramp-default method))
+ (or (null user) (get-text-property 0 'tramp-default user))
+ (member host methods))
+ (tramp-cleanup-connection vec)
+ (tramp-user-error vec "Host name must not match method \"%s\"" host))))
+
(defun tramp-dissect-file-name (name &optional nodefault)
"Return a `tramp-file-name' structure.
The structure consists of remote method, remote user, remote host
@@ -1280,7 +1297,7 @@ non-nil, the file name parts are not expanded to their default
values."
(save-match-data
(let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (tramp-compat-user-error "Not a Tramp file name: %s" name))
+ (unless match (tramp-user-error nil "Not a Tramp file name: \"%s\"" name))
(let ((method (match-string (nth 1 tramp-file-name-structure) name))
(user (match-string (nth 2 tramp-file-name-structure) name))
(host (match-string (nth 3 tramp-file-name-structure) name))
@@ -1290,12 +1307,7 @@ values."
(when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
(when (string-match tramp-postfix-ipv6-regexp host)
- (setq host (replace-match "" nil t host)))
- (when (and (equal tramp-syntax 'ftp) (null method) (null user)
- (member host (mapcar 'car tramp-methods))
- (not (tramp-completion-mode-p)))
- (tramp-compat-user-error
- "Host name must not match method `%s'" host)))
+ (setq host (replace-match "" nil t host))))
(if nodefault
(vector method user host localname hop)
(vector
@@ -1429,66 +1441,70 @@ The outline level is equal to the verbosity of the Tramp message."
"Append message to debug buffer.
Message is formatted with FMT-STRING as control string and the remaining
ARGUMENTS to actually emit the message (if applicable)."
- (when (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (tramp-get-debug-buffer vec)
- (goto-char (point-max))
- ;; Headline.
- (when (bobp)
+ (with-current-buffer (tramp-get-debug-buffer vec)
+ (goto-char (point-max))
+ ;; Headline.
+ (when (bobp)
+ (insert
+ (format
+ ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
+ (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
+ emacs-version tramp-version))
+ (when (>= tramp-verbose 10)
(insert
(format
- ";; %sEmacs: %s Tramp: %s -*- mode: outline; -*-"
- (if (featurep 'sxemacs) "SX" (if (featurep 'xemacs) "X" "GNU "))
- emacs-version tramp-version)))
- (unless (bolp)
- (insert "\n"))
- ;; Timestamp.
- (let ((now (current-time)))
- (insert (format-time-string "%T." now))
- (insert (format "%06d " (nth 2 now))))
- ;; Calling Tramp function. We suppress compat and trace
- ;; functions from being displayed.
- (let ((btn 1) btf fn)
- (while (not fn)
- (setq btf (nth 1 (backtrace-frame btn)))
- (if (not btf)
- (setq fn "")
- (when (symbolp btf)
- (setq fn (symbol-name btf))
- (unless
- (and
- (string-match "^tramp" fn)
- (not
- (string-match
- (concat
- "^"
- (regexp-opt
- '("tramp-backtrace"
- "tramp-compat-condition-case-unless-debug"
- "tramp-compat-funcall"
- "tramp-compat-with-temp-message"
- "tramp-condition-case-unless-debug"
- "tramp-debug-message"
- "tramp-error"
- "tramp-error-with-buffer"
- "tramp-message")
- t)
- "$")
- fn)))
- (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.
-; (let ((ffn (find-function-noselect (intern fn))))
-; (insert
-; (format
-; "%s:%d: "
-; (file-name-nondirectory (buffer-file-name (car ffn)))
-; (with-current-buffer (car ffn)
-; (1+ (count-lines (point-min) (cdr ffn)))))))
- (insert (format "%s " fn)))
- ;; The message.
- (insert (apply 'format fmt-string arguments)))))
+ "\n;; Location: %s Git: %s"
+ (locate-library "tramp") (tramp-repository-get-version)))))
+ (unless (bolp)
+ (insert "\n"))
+ ;; Timestamp.
+ (let ((now (current-time)))
+ (insert (format-time-string "%T." now))
+ (insert (format "%06d " (nth 2 now))))
+ ;; Calling Tramp function. We suppress compat and trace functions
+ ;; from being displayed.
+ (let ((btn 1) btf fn)
+ (while (not fn)
+ (setq btf (nth 1 (backtrace-frame btn)))
+ (if (not btf)
+ (setq fn "")
+ (when (symbolp btf)
+ (setq fn (symbol-name btf))
+ (unless
+ (and
+ (string-match "^tramp" fn)
+ (not
+ (string-match
+ (concat
+ "^"
+ (regexp-opt
+ '("tramp-backtrace"
+ "tramp-compat-condition-case-unless-debug"
+ "tramp-compat-funcall"
+ "tramp-compat-with-temp-message"
+ "tramp-condition-case-unless-debug"
+ "tramp-debug-message"
+ "tramp-error"
+ "tramp-error-with-buffer"
+ "tramp-message"
+ "tramp-user-error")
+ t)
+ "$")
+ fn)))
+ (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.
+; (let ((ffn (find-function-noselect (intern fn))))
+; (insert
+; (format
+; "%s:%d: "
+; (file-name-nondirectory (buffer-file-name (car ffn)))
+; (with-current-buffer (car ffn)
+; (1+ (count-lines (point-min) (cdr ffn)))))))
+ (insert (format "%s " fn)))
+ ;; The message.
+ (insert (apply #'format-message fmt-string arguments))))
(defvar tramp-message-show-message t
"Show Tramp message in the minibuffer.
@@ -1525,22 +1541,32 @@ applicable)."
arguments))
;; Log only when there is a minimum level.
(when (>= tramp-verbose 4)
- (when (and vec-or-proc
- (processp vec-or-proc)
- (buffer-name (process-buffer vec-or-proc)))
- (with-current-buffer (process-buffer vec-or-proc)
- ;; Translate proc to vec.
- (setq vec-or-proc (tramp-dissect-file-name default-directory))))
- (when (and vec-or-proc (vectorp vec-or-proc))
+ ;; Translate proc to vec.
+ (when (processp vec-or-proc)
+ (let ((tramp-verbose 0))
+ (setq vec-or-proc
+ (tramp-get-connection-property vec-or-proc "vector" nil))))
+ ;; Append connection buffer for error messages.
+ (when (= level 1)
+ (let ((tramp-verbose 0))
+ (with-current-buffer (tramp-get-connection-buffer vec-or-proc)
+ (setq fmt-string (concat fmt-string "\n%s")
+ arguments (append arguments (list (buffer-string)))))))
+ ;; Do it.
+ (when (vectorp vec-or-proc)
(apply 'tramp-debug-message
vec-or-proc
(concat (format "(%d) # " level) fmt-string)
arguments)))))))
-(defsubst tramp-backtrace (vec-or-proc)
+(defsubst tramp-backtrace (&optional vec-or-proc)
"Dump a backtrace into the debug buffer.
-This function is meant for debugging purposes."
- (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))))
+If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This
+function is meant for debugging purposes."
+ (if vec-or-proc
+ (tramp-message vec-or-proc 10 "\n%s" (with-output-to-string (backtrace)))
+ (if (>= tramp-verbose 10)
+ (with-output-to-temp-buffer "*debug tramp*" (backtrace)))))
(defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments)
"Emit an error.
@@ -1549,13 +1575,14 @@ signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised."
(let (tramp-message-show-message)
(tramp-backtrace vec-or-proc)
- (tramp-message
- vec-or-proc 1 "%s"
- (error-message-string
- (list signal
- (get signal 'error-message)
- (apply 'format fmt-string arguments))))
- (signal signal (list (apply 'format fmt-string arguments)))))
+ (when vec-or-proc
+ (tramp-message
+ vec-or-proc 1 "%s"
+ (error-message-string
+ (list signal
+ (get signal 'error-message)
+ (apply #'format-message fmt-string arguments)))))
+ (signal signal (list (apply #'format-message fmt-string arguments)))))
(defsubst tramp-error-with-buffer
(buf vec-or-proc signal fmt-string &rest arguments)
@@ -1576,11 +1603,13 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (and buf
tramp-message-show-message
(not (zerop tramp-verbose))
- (not (tramp-completion-mode-p)))
+ (not (tramp-completion-mode-p))
+ ;; Show only when Emacs has started already.
+ (current-message))
(let ((enable-recursive-minibuffers t))
;; `tramp-error' does not show messages. So we must do it
;; ourselves.
- (message fmt-string arguments)
+ (apply 'message fmt-string arguments)
;; Show buffer.
(pop-to-buffer buf)
(discard-input)
@@ -1606,18 +1635,19 @@ 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',
`host', `localname', `hop' to the components."
- `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
- (,(if var (intern (concat (symbol-name var) "-method")) 'method)
- (tramp-file-name-method ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-user")) 'user)
- (tramp-file-name-user ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-host")) 'host)
- (tramp-file-name-host ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-localname")) 'localname)
- (tramp-file-name-localname ,(or var 'v)))
- (,(if var (intern (concat (symbol-name var) "-hop")) 'hop)
- (tramp-file-name-hop ,(or var 'v))))
- ,@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))))
+ '(method user host localname hop))))
+ `(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,
+ ;; and then add here a dummy use of all those variables, so we don't get
+ ;; flooded by warnings about those vars `body' didn't use.
+ (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))
@@ -1635,24 +1665,27 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
If LEVEL does not fit for visible messages, there are only traces
without a visible progress reporter."
(declare (indent 3) (debug t))
- `(let ((result "failed")
- pr tm)
+ `(progn
(tramp-message ,vec ,level "%s..." ,message)
- ;; We start a pulsing progress reporter after 3 seconds. Feature
- ;; introduced in Emacs 24.1.
- (when (and tramp-message-show-message
- ;; Display only when there is a minimum level.
- (<= ,level (min tramp-verbose 3)))
- (ignore-errors
- (setq pr (tramp-compat-funcall 'make-progress-reporter ,message)
- tm (when pr
- (run-at-time 3 0.1 'tramp-progress-reporter-update pr)))))
- (unwind-protect
- ;; Execute the body.
- (prog1 (progn ,@body) (setq result "done"))
- ;; Stop progress reporter.
- (if tm (tramp-compat-funcall 'cancel-timer tm))
- (tramp-message ,vec ,level "%s...%s" ,message result))))
+ (let ((cookie "failed")
+ (tm
+ ;; We start a pulsing progress reporter after 3 seconds. Feature
+ ;; introduced in Emacs 24.1.
+ (when (and tramp-message-show-message
+ ;; Display only when there is a minimum level.
+ (<= ,level (min tramp-verbose 3)))
+ (ignore-errors
+ (let ((pr (tramp-compat-funcall
+ #'make-progress-reporter ,message)))
+ (when pr
+ (run-at-time 3 0.1
+ #'tramp-progress-reporter-update pr)))))))
+ (unwind-protect
+ ;; Execute the body.
+ (prog1 (progn ,@body) (setq cookie "done"))
+ ;; Stop progress reporter.
+ (if tm (tramp-compat-funcall 'cancel-timer tm))
+ (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
(tramp-compat-font-lock-add-keywords
'emacs-lisp-mode '("\\<with-tramp-progress-reporter\\>"))
@@ -1703,19 +1736,6 @@ letter into the file name. This function removes it."
(replace-match "/" nil t name)
name)))
-(defun tramp-cleanup (vec)
- "Cleanup connection VEC, but keep the debug buffer."
- (with-current-buffer (tramp-get-debug-buffer vec)
- ;; Keep the debug buffer.
- (rename-buffer
- (generate-new-buffer-name tramp-temp-buffer-name) 'unique)
- (tramp-cleanup-connection vec)
- (if (= (point-min) (point-max))
- (kill-buffer nil)
- (rename-buffer (tramp-debug-buffer-name vec) 'unique))
- ;; We call `tramp-get-buffer' in order to keep the debug buffer.
- (tramp-get-buffer vec)))
-
;;; Config Manipulation Functions:
;;;###tramp-autoload
@@ -1730,7 +1750,7 @@ Example:
(tramp-set-completion-function
\"ssh\"
- '((tramp-parse-sconfig \"/etc/ssh_config\")
+ \\='((tramp-parse-sconfig \"/etc/ssh_config\")
(tramp-parse-sconfig \"~/.ssh/config\")))"
(let ((r function-list)
@@ -1750,7 +1770,7 @@ Example:
(and (memq system-type '(cygwin windows-nt))
(zerop
(tramp-call-process
- "reg" nil nil nil "query" (nth 1 (car v)))))
+ v "reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
(setq r (delete (car v) r)))
@@ -1821,7 +1841,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; We do not want to send any remote command.
(non-essential t))
(when
- (file-remote-p
+ (tramp-tramp-file-p
(tramp-compat-funcall
'buffer-substring-no-properties end (point-max)))
(save-excursion
@@ -1932,8 +1952,7 @@ coding system might not be determined. This function repairs it."
(add-to-list
'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
-;;;###autoload
-(progn (defun tramp-run-real-handler (operation args)
+(defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
@@ -1947,7 +1966,7 @@ pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
- (apply operation args))))
+ (apply operation args)))
;;;###autoload
(progn (defun tramp-completion-run-real-handler (operation args)
@@ -2022,8 +2041,8 @@ ARGS are the arguments OPERATION has been called with."
'vm-imap-move-mail 'vm-pop-move-mail 'vm-spool-move-mail))
(save-match-data
(cond
- ((string-match tramp-file-name-regexp (nth 0 args)) (nth 0 args))
- ((string-match tramp-file-name-regexp (nth 1 args)) (nth 1 args))
+ ((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
+ ((tramp-tramp-file-p (nth 1 args)) (nth 1 args))
(t (buffer-file-name (current-buffer))))))
;; START END FILE.
((eq operation 'write-region)
@@ -2051,7 +2070,7 @@ ARGS are the arguments OPERATION has been called with."
'dired-print-file 'dired-shell-call-process))
default-directory)
;; PROC.
- ((eq operation 'file-notify-rm-watch)
+ ((member operation (list 'file-notify-rm-watch 'file-notify-valid-p))
(when (processp (nth 0 args))
(with-current-buffer (process-buffer (nth 0 args))
default-directory)))
@@ -2089,7 +2108,6 @@ ARGS are the arguments OPERATION has been called with."
(tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers)))
;; Main function.
-;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
Falls back to normal file name handler if no Tramp file name handler exists."
@@ -2131,14 +2149,14 @@ Falls back to normal file name handler if no Tramp file name handler exists."
((eq result 'non-essential)
(tramp-message
v 5 "Non-essential received in operation %s"
- (append (list operation) args))
+ (cons operation args))
(tramp-run-real-handler operation args))
((eq result 'suppress)
(let (tramp-message-show-message)
(tramp-message
v 1 "Suppress received in operation %s"
- (append (list operation) args))
- (tramp-cleanup v)
+ (cons operation args))
+ (tramp-cleanup-connection v t)
(tramp-run-real-handler operation args)))
(t result)))
@@ -2147,7 +2165,7 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(let (tramp-message-show-message)
(tramp-message
v 1 "Interrupt received in operation %s"
- (append (list operation) args)))
+ (cons operation args)))
;; Propagate the quit signal.
(signal (car err) (cdr err)))
@@ -2232,15 +2250,44 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(tramp-completion-run-real-handler operation args)))))
;;;###autoload
-(progn (defun tramp-register-file-name-handlers ()
+(progn (defun tramp-autoload-file-name-handler (operation &rest args)
+ "Load Tramp file name handler, and perform OPERATION."
+ ;; Avoid recursive loading of tramp.el. `temporary-file-directory'
+ ;; does not exist in XEmacs, so we must use something else.
+ (let ((default-directory "/"))
+ (load "tramp" nil t))
+ (apply operation args)))
+
+;; `tramp-autoload-file-name-handler' must be registered before
+;; evaluation of site-start and init files, because there might exist
+;; remote files already, f.e. files kept via recentf-mode. We cannot
+;; autoload `tramp-file-name-handler', because it would result in
+;; recursive loading of tramp.el when `default-directory' is set to
+;; remote.
+;;;###autoload
+(progn (defun tramp-register-autoload-file-name-handlers ()
+ "Add Tramp file name handlers to `file-name-handler-alist' during autoload."
+ (add-to-list 'file-name-handler-alist
+ (cons tramp-file-name-regexp
+ 'tramp-autoload-file-name-handler))
+ (put 'tramp-autoload-file-name-handler 'safe-magic t)
+ (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)))
+
+;;;###autoload
+(tramp-register-autoload-file-name-handlers)
+
+(defun tramp-register-file-name-handlers ()
"Add Tramp file name handlers to `file-name-handler-alist'."
;; Remove autoloaded handlers from file name handler alist. Useful,
;; if `tramp-syntax' has been changed.
- (let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
- (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
- (let ((a1 (rassq
- 'tramp-completion-file-name-handler file-name-handler-alist)))
- (setq file-name-handler-alist (delq a1 file-name-handler-alist)))
+ (dolist (fnh '(tramp-file-name-handler
+ tramp-completion-file-name-handler
+ tramp-autoload-file-name-handler))
+ (let ((a1 (rassq fnh file-name-handler-alist)))
+ (setq file-name-handler-alist (delq a1 file-name-handler-alist))))
;; Add the handlers.
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp 'tramp-file-name-handler))
@@ -2255,13 +2302,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(let ((entry (rassoc fnh file-name-handler-alist)))
(when entry
(setq file-name-handler-alist
- (cons entry (delete entry file-name-handler-alist))))))))
+ (cons entry (delete entry file-name-handler-alist)))))))
-;; `tramp-file-name-handler' must be registered before evaluation of
-;; site-start and init files, because there might exist remote files
-;; already, f.e. files kept via recentf-mode.
-;;;###autoload
-(tramp-register-file-name-handlers)
+(eval-after-load 'tramp (tramp-register-file-name-handlers))
(defun tramp-exists-file-name-handler (operation &rest args)
"Check, whether OPERATION runs a file name handler."
@@ -2356,7 +2399,8 @@ not in completion mode."
(and (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(or (not (tramp-completion-mode-p))
- (let ((p (tramp-get-connection-process v)))
+ (let* ((tramp-verbose 0)
+ (p (tramp-get-connection-process v)))
(and p (processp p) (memq (process-status p) '(run open))))))))
;; Method, host name and user name completion.
@@ -2512,64 +2556,40 @@ They are collected by `tramp-completion-dissect-file-name1'."
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
nil 1 2 nil))
- ;; "/method:user" "/[method/user" "/method://user"
+ ;; "/method:user" "/[method/user"
(tramp-completion-file-name-structure7
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp x-nil "\\)$")
1 2 nil nil))
- ;; "/method:host" "/[method/host" "/method://host"
+ ;; "/method:host" "/[method/host"
(tramp-completion-file-name-structure8
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 nil 2 nil))
- ;; "/method:[ipv6" "/[method/ipv6" "/method://[ipv6"
+ ;; "/method:[ipv6" "/[method/ipv6"
(tramp-completion-file-name-structure9
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 nil 2 nil))
- ;; "/method:user@host" "/[method/user@host" "/method://user@host"
+ ;; "/method:user@host" "/[method/user@host"
(tramp-completion-file-name-structure10
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
"\\(" tramp-host-regexp x-nil "\\)$")
1 2 3 nil))
- ;; "/method:user@[ipv6" "/[method/user@ipv6" "/method://user@[ipv6"
+ ;; "/method:user@[ipv6" "/[method/user@ipv6"
(tramp-completion-file-name-structure11
(list (concat tramp-prefix-regexp
"\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
"\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
- 1 2 3 nil))
- ;; "/method: "/method:/"
- (tramp-completion-file-name-structure12
- (list
- (if (equal tramp-syntax 'url)
- (concat tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)"
- "\\(" (substring tramp-postfix-method-regexp 0 1)
- "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
- "\\(" "\\)$")
- ;; Should not match if not URL syntax.
- (concat tramp-prefix-regexp "/$"))
- 1 3 nil nil))
- ;; "/method: "/method:/"
- (tramp-completion-file-name-structure13
- (list
- (if (equal tramp-syntax 'url)
- (concat tramp-prefix-regexp
- "\\(" tramp-method-regexp "\\)"
- "\\(" (substring tramp-postfix-method-regexp 0 1)
- "\\|" (substring tramp-postfix-method-regexp 1 2) "\\)"
- "\\(" "\\)$")
- ;; Should not match if not URL syntax.
- (concat tramp-prefix-regexp "/$"))
- 1 nil 3 nil)))
+ 1 2 3 nil)))
(mapc (lambda (structure)
(add-to-list 'result
@@ -2586,8 +2606,6 @@ They are collected by `tramp-completion-dissect-file-name1'."
tramp-completion-file-name-structure9
tramp-completion-file-name-structure10
tramp-completion-file-name-structure11
- tramp-completion-file-name-structure12
- tramp-completion-file-name-structure13
tramp-file-name-structure))
(delq nil result)))
@@ -2807,7 +2825,7 @@ User is always nil."
(if (memq system-type '(windows-nt))
(with-temp-buffer
(when (zerop (tramp-call-process
- "reg" nil t nil "query" registry-or-dirname))
+ nil "reg" nil t nil "query" registry-or-dirname))
(goto-char (point-min))
(loop while (not (eobp)) collect
(tramp-parse-putty-group registry-or-dirname))))
@@ -2886,7 +2904,7 @@ User is always nil."
(defun tramp-handle-file-accessible-directory-p (filename)
"Like `file-accessible-directory-p' for Tramp files."
(and (file-directory-p filename)
- (file-executable-p filename)))
+ (file-readable-p filename)))
(defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files."
@@ -2910,7 +2928,8 @@ User is always nil."
(tramp-file-name-user v)
(tramp-file-name-host v)
(tramp-run-real-handler
- 'file-name-as-directory (list (or (tramp-file-name-localname v) ""))))))
+ 'file-name-as-directory (list (or (tramp-file-name-localname v) "")))
+ (tramp-file-name-hop v))))
(defun tramp-handle-file-name-completion
(filename directory &optional predicate)
@@ -2938,7 +2957,8 @@ User is always nil."
(tramp-file-name-user v)
(tramp-file-name-host v)
(tramp-run-real-handler
- 'file-name-directory (list (or (tramp-file-name-localname v) ""))))))
+ 'file-name-directory (list (or (tramp-file-name-localname v) "")))
+ (tramp-file-name-hop v))))
(defun tramp-handle-file-name-nondirectory (file)
"Like `file-name-nondirectory' but aware of Tramp files."
@@ -2950,8 +2970,8 @@ User is always nil."
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
- (t (tramp-time-less-p (nth 5 (file-attributes file2))
- (nth 5 (file-attributes file1))))))
+ (t (time-less-p (nth 5 (file-attributes file2))
+ (nth 5 (file-attributes file1))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
@@ -2960,7 +2980,8 @@ User is always nil."
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
- (let ((tramp-verbose 3))
+ ;; We do not want traces in the debug buffer.
+ (let ((tramp-verbose (min tramp-verbose 3)))
(when (tramp-tramp-file-p filename)
(let* ((v (tramp-dissect-file-name filename))
(p (tramp-get-connection-process v))
@@ -2974,15 +2995,14 @@ User is always nil."
((eq identification 'user) user)
((eq identification 'host) host)
((eq identification 'localname) localname)
- (t (tramp-make-tramp-file-name method user host "")))))))))
+ ((eq identification 'hop) hop)
+ (t (tramp-make-tramp-file-name method user host "" hop)))))))))
(defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
(let ((x (car (file-attributes filename))))
(when (stringp x)
- ;; When Tramp is running on VMS, then `file-name-absolute-p'
- ;; might do weird things.
(if (file-name-absolute-p x)
(tramp-make-tramp-file-name method user host x)
x)))))
@@ -3029,6 +3049,38 @@ User is always nil."
(tramp-run-real-handler 'find-backup-file-name (list filename)))))
+(defun tramp-handle-insert-directory
+ (filename switches &optional wildcard full-directory-p)
+ "Like `insert-directory' for Tramp files."
+ (unless switches (setq switches ""))
+ ;; Mark trailing "/".
+ (when (and (zerop (length (file-name-nondirectory filename)))
+ (not full-directory-p))
+ (setq switches (concat switches "F")))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
+ (require 'ls-lisp)
+ (let (ls-lisp-use-insert-directory-program start)
+ (tramp-run-real-handler
+ 'insert-directory
+ (list filename switches wildcard full-directory-p))
+ ;; `ls-lisp' always returns full listings. We must remove
+ ;; superfluous parts.
+ (unless (string-match "l" switches)
+ (save-excursion
+ (goto-char (point-min))
+ (while (setq start
+ (text-property-not-all
+ (point) (point-at-eol) 'dired-filename t))
+ (delete-region
+ start
+ (or (text-property-any start (point-at-eol) 'dired-filename t)
+ (point-at-eol)))
+ (if (= (point-at-bol) (point-at-eol))
+ ;; Empty line.
+ (delete-region (point) (progn (forward-line) (point)))
+ (forward-line)))))))))
+
(defun tramp-handle-insert-file-contents
(filename &optional visit beg end replace)
"Like `insert-file-contents' for Tramp files."
@@ -3036,108 +3088,118 @@ User is always nil."
(setq filename (expand-file-name filename))
(let (result local-copy remote-copy)
(with-parsed-tramp-file-name filename nil
- (with-tramp-progress-reporter
- v 3 (format "Inserting `%s'" filename)
- (unwind-protect
- (if (not (file-exists-p filename))
- ;; We don't raise a Tramp error, because it might be
- ;; suppressed, like in `find-file-noselect-1'.
- (signal 'file-error
- (list "File not found on remote host" filename))
-
- (if (and (tramp-local-host-p v)
- (let (file-name-handler-alist)
- (file-readable-p localname)))
- ;; Short track: if we are on the local host, we can
- ;; run directly.
- (setq result
- (tramp-run-real-handler
- 'insert-file-contents
- (list localname visit beg end replace)))
-
- ;; When we shall insert only a part of the file, we
- ;; copy this part.
- (when (or beg end)
- (setq remote-copy (tramp-make-tramp-temp-file v))
- ;; This is defined in tramp-sh.el. Let's assume
- ;; this is loaded already.
- (tramp-compat-funcall
- 'tramp-send-command
- v
- (cond
- ((and beg end)
- (format "dd bs=1 skip=%d if=%s count=%d of=%s"
- beg (tramp-shell-quote-argument localname)
- (- end beg) remote-copy))
- (beg
- (format "dd bs=1 skip=%d if=%s of=%s"
- beg (tramp-shell-quote-argument localname)
- remote-copy))
- (end
- (format "dd bs=1 count=%d if=%s of=%s"
- end (tramp-shell-quote-argument localname)
- remote-copy)))))
-
- ;; `insert-file-contents-literally' takes care to
- ;; avoid calling jka-compr. By let-binding
- ;; `inhibit-file-name-operation', we propagate that
- ;; care to the `file-local-copy' operation.
- (setq local-copy
- (let ((inhibit-file-name-operation
- (when (eq inhibit-file-name-operation
- 'insert-file-contents)
- 'file-local-copy)))
- (cond
- ((stringp remote-copy)
- (file-local-copy
- (tramp-make-tramp-file-name
- method user host remote-copy)))
- ((stringp tramp-temp-buffer-file-name)
- (copy-file filename tramp-temp-buffer-file-name 'ok)
- tramp-temp-buffer-file-name)
- (t (file-local-copy filename)))))
-
- ;; When the file is not readable for the owner, it
- ;; cannot be inserted, even if it is readable for the
- ;; group or for everybody.
- (set-file-modes
- local-copy (tramp-compat-octal-to-decimal "0600"))
-
- (when (and (null remote-copy)
- (tramp-get-method-parameter
- method 'tramp-copy-keep-tmpfile))
- ;; We keep the local file for performance reasons,
- ;; useful for "rsync".
- (setq tramp-temp-buffer-file-name local-copy))
-
- ;; We must ensure that `file-coding-system-alist'
- ;; matches `local-copy'. We must also use `visit',
- ;; otherwise there might be an error in the
- ;; `revert-buffer' function under XEmacs.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist
- filename local-copy)))
- (setq result
- (insert-file-contents
- local-copy visit nil nil replace)))))
-
- ;; Save exit.
- (progn
- (when visit
- (setq buffer-file-name filename)
- (setq buffer-read-only (not (file-writable-p filename)))
- (set-visited-file-modtime)
- (set-buffer-modified-p nil))
- (when (and (stringp local-copy)
- (or remote-copy (null tramp-temp-buffer-file-name)))
- (delete-file local-copy))
- (when (stringp remote-copy)
- (delete-file
- (tramp-make-tramp-file-name method user host remote-copy)))))))
-
- ;; Result.
- (list (expand-file-name filename)
- (cadr result))))
+ (unwind-protect
+ (if (not (file-exists-p filename))
+ (tramp-error
+ v 'file-error "File `%s' not found on remote host" filename)
+
+ (with-tramp-progress-reporter
+ v 3 (format-message "Inserting `%s'" filename)
+ (condition-case err
+ (if (and (tramp-local-host-p v)
+ (let (file-name-handler-alist)
+ (file-readable-p localname)))
+ ;; Short track: if we are on the local host, we can
+ ;; run directly.
+ (setq result
+ (tramp-run-real-handler
+ 'insert-file-contents
+ (list localname visit beg end replace)))
+
+ ;; When we shall insert only a part of the file, we
+ ;; copy this part. This works only for the shell file
+ ;; name handlers.
+ (when (and (or beg end)
+ (tramp-get-method-parameter
+ v 'tramp-login-program))
+ (setq remote-copy (tramp-make-tramp-temp-file v))
+ ;; This is defined in tramp-sh.el. Let's assume
+ ;; this is loaded already.
+ (tramp-compat-funcall
+ 'tramp-send-command
+ v
+ (cond
+ ((and beg end)
+ (format "dd bs=1 skip=%d if=%s count=%d of=%s"
+ beg (tramp-shell-quote-argument localname)
+ (- end beg) remote-copy))
+ (beg
+ (format "dd bs=1 skip=%d if=%s of=%s"
+ beg (tramp-shell-quote-argument localname)
+ remote-copy))
+ (end
+ (format "dd bs=1 count=%d if=%s of=%s"
+ end (tramp-shell-quote-argument localname)
+ remote-copy))))
+ (setq tramp-temp-buffer-file-name nil beg nil end nil))
+
+ ;; `insert-file-contents-literally' takes care to
+ ;; avoid calling jka-compr.el and epa.el. By
+ ;; let-binding `inhibit-file-name-operation', we
+ ;; propagate that care to the `file-local-copy'
+ ;; operation.
+ (setq local-copy
+ (let ((inhibit-file-name-operation
+ (when (eq inhibit-file-name-operation
+ 'insert-file-contents)
+ 'file-local-copy)))
+ (cond
+ ((stringp remote-copy)
+ (file-local-copy
+ (tramp-make-tramp-file-name
+ method user host remote-copy)))
+ ((stringp tramp-temp-buffer-file-name)
+ (copy-file
+ filename tramp-temp-buffer-file-name 'ok)
+ tramp-temp-buffer-file-name)
+ (t (file-local-copy filename)))))
+
+ ;; When the file is not readable for the owner, it
+ ;; cannot be inserted, even if it is readable for the
+ ;; group or for everybody.
+ (set-file-modes
+ local-copy (tramp-compat-octal-to-decimal "0600"))
+
+ (when (and (null remote-copy)
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ ;; We keep the local file for performance reasons,
+ ;; useful for "rsync".
+ (setq tramp-temp-buffer-file-name local-copy))
+
+ ;; We must ensure that `file-coding-system-alist'
+ ;; matches `local-copy'. We must also use `visit',
+ ;; otherwise there might be an error in the
+ ;; `revert-buffer' function under XEmacs.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist
+ filename local-copy)))
+ (setq result
+ (insert-file-contents
+ local-copy visit beg end replace))))
+ (error
+ (add-hook 'find-file-not-found-functions
+ `(lambda () (signal ',(car err) ',(cdr err)))
+ nil t)
+ (signal (car err) (cdr err))))))
+
+ ;; Save exit.
+ (progn
+ (when visit
+ (setq buffer-file-name filename)
+ (setq buffer-read-only (not (file-writable-p filename)))
+ (set-visited-file-modtime)
+ (set-buffer-modified-p nil))
+ (when (and (stringp local-copy)
+ (or remote-copy (null tramp-temp-buffer-file-name)))
+ (delete-file local-copy))
+ (when (stringp remote-copy)
+ (delete-file
+ (tramp-make-tramp-file-name method user host remote-copy)))))
+
+ ;; Result.
+ (list (expand-file-name filename)
+ (cadr result)))))
(defun tramp-handle-load (file &optional noerror nomessage nosuffix must-suffix)
"Like `load' for Tramp files."
@@ -3163,12 +3225,18 @@ User is always nil."
(let ((tramp-message-show-message (not nomessage)))
(with-tramp-progress-reporter v 0 (format "Loading %s" file)
(let ((local-copy (file-local-copy file)))
- ;; MUST-SUFFIX doesn't exist on XEmacs, so let it default to nil.
(unwind-protect
- (load local-copy noerror t t)
+ (tramp-compat-load local-copy noerror t nosuffix must-suffix)
(delete-file local-copy)))))
t)))
+(defun tramp-handle-make-symbolic-link
+ (filename linkname &optional _ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files."
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename linkname) nil
+ (tramp-error v 'file-error "make-symbolic-link not supported")))
+
(defun tramp-handle-shell-command
(command &optional output-buffer error-buffer)
"Like `shell-command' for Tramp files."
@@ -3178,12 +3246,10 @@ User is always nil."
(args (append
(cons
(tramp-get-method-parameter
- (tramp-file-name-method
- (tramp-dissect-file-name default-directory))
+ (tramp-dissect-file-name default-directory)
'tramp-remote-shell)
(tramp-get-method-parameter
- (tramp-file-name-method
- (tramp-dissect-file-name default-directory))
+ (tramp-dissect-file-name default-directory)
'tramp-remote-shell-args))
(list (substring command 0 asynchronous))))
current-buffer-p
@@ -3214,7 +3280,7 @@ User is always nil."
(when p
(if (yes-or-no-p "A command is running. Kill it? ")
(ignore-errors (kill-process p))
- (tramp-compat-user-error "Shell command in progress")))
+ (tramp-user-error p "Shell command in progress")))
(if current-buffer-p
(progn
@@ -3229,11 +3295,12 @@ User is always nil."
;; Run the process.
(setq p (apply 'start-file-process "*Async Shell*" buffer args))
;; Display output.
- (pop-to-buffer output-buffer)
- (setq mode-line-process '(":%s"))
- (shell-mode)
- (set-process-sentinel p 'shell-command-sentinel)
- (set-process-filter p 'comint-output-filter))
+ (with-current-buffer output-buffer
+ (display-buffer output-buffer '(nil (allow-no-window . t)))
+ (setq mode-line-process '(":%s"))
+ (shell-mode)
+ (set-process-sentinel p 'shell-command-sentinel)
+ (set-process-filter p 'comint-output-filter)))
(prog1
;; Run the process.
@@ -3259,41 +3326,29 @@ User is always nil."
(defun tramp-handle-substitute-in-file-name (filename)
"Like `substitute-in-file-name' for Tramp files.
-\"//\" and \"/~\" substitute only in the local filename part.
-If the URL Tramp syntax is chosen, \"//\" as method delimiter and \"/~\" at
-beginning of local filename are not substituted."
+\"//\" and \"/~\" substitute only in the local filename part."
;; First, we must replace environment variables.
(setq filename (tramp-replace-environment-variables filename))
(with-parsed-tramp-file-name filename nil
- (if (equal tramp-syntax 'url)
- ;; We need to check localname only. The other parts cannot contain
- ;; "//" or "/~".
- (if (and (> (length localname) 1)
- (or (string-match "//" localname)
- (string-match "/~" localname 1)))
- (tramp-run-real-handler 'substitute-in-file-name (list filename))
- (tramp-make-tramp-file-name
- (when method (substitute-in-file-name method))
- (when user (substitute-in-file-name user))
- (when host (substitute-in-file-name host))
- (when localname
- (tramp-run-real-handler
- 'substitute-in-file-name (list localname)))))
- ;; Ignore in LOCALNAME everything before "//" or "/~".
- (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
- (setq filename
- (concat (file-remote-p filename)
- (replace-match "\\1" nil nil localname)))
- ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
- (when (string-match "~$" filename)
- (setq filename (concat filename "/"))))
+ ;; Ignore in LOCALNAME everything before "//" or "/~".
+ (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname))
+ (setq filename
+ (concat (file-remote-p filename)
+ (replace-match "\\1" nil nil localname)))
+ ;; "/m:h:~" does not work for completion. We use "/m:h:~/".
+ (when (string-match "~$" filename)
+ (setq filename (concat filename "/"))))
+ ;; We do not want to replace environment variables, again.
+ (let (process-environment)
(tramp-run-real-handler 'substitute-in-file-name (list filename)))))
(defun tramp-handle-unhandled-file-name-directory (_filename)
"Like `unhandled-file-name-directory' for Tramp files."
- ;; With Emacs 23, we could simply return `nil'. But we must keep it
- ;; for backward compatibility.
- (expand-file-name "~/"))
+ ;; Starting with Emacs 23, we must simply return nil. But we must
+ ;; keep backward compatibility, also with XEmacs. "~/" cannot be
+ ;; returned, because there might be machines without a HOME
+ ;; directory (like hydra).
+ (and (< emacs-major-version 23) "/"))
(defun tramp-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@@ -3352,7 +3407,7 @@ of."
(defun tramp-handle-file-notify-add-watch (filename _flags _callback)
"Like `file-notify-add-watch' for Tramp files."
;; This is the default handler. tramp-gvfs.el and tramp-sh.el have
- ;; its own one.
+ ;; their own one.
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
(tramp-error
@@ -3361,10 +3416,20 @@ of."
(defun tramp-handle-file-notify-rm-watch (proc)
"Like `file-notify-rm-watch' for Tramp files."
;; The descriptor must be a process object.
- (unless (and (processp proc) (gethash proc file-notify-descriptors))
+ (unless (processp proc)
(tramp-error proc 'file-notify-error "Not a valid descriptor %S" proc))
(tramp-message proc 6 "Kill %S" proc)
- (kill-process proc))
+ (delete-process proc))
+
+(defun tramp-handle-file-notify-valid-p (proc)
+ "Like `file-notify-valid-p' for Tramp files."
+ (and proc (processp proc) (memq (process-status proc) '(run open))
+ ;; Sometimes, the process is still in status `run' when the
+ ;; file or directory to be watched is deleted already.
+ (with-current-buffer (process-buffer proc)
+ (file-exists-p
+ (concat (file-remote-p default-directory)
+ (tramp-compat-process-get proc 'watch-name))))))
;;; Functions for establishing connection:
@@ -3389,7 +3454,14 @@ of."
(defun tramp-action-password (proc vec)
"Query the user for a password."
(with-current-buffer (process-buffer proc)
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ (case-fold-search t))
+ ;; Let's check whether a wrong password has been sent already.
+ ;; Sometimes, the process returns a new password request
+ ;; immediately after rejecting the previous (wrong) one.
+ (unless (tramp-get-connection-property vec "first-password-request" nil)
+ (tramp-clear-passwd vec))
+ (goto-char (point-min))
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(tramp-message vec 3 "Sending %s" (match-string 1))
;; We don't call `tramp-send-string' in order to hide the
@@ -3451,6 +3523,8 @@ The terminal type can be configured with `tramp-terminal-type'."
(defun tramp-action-out-of-band (proc vec)
"Check, whether an out-of-band copy has finished."
+ ;; There might be pending output for the exit status.
+ (tramp-accept-process-output proc 0.1)
(cond ((and (memq (process-status proc) '(stop exit))
(zerop (process-exit-status proc)))
(tramp-message vec 3 "Process has finished.")
@@ -3475,7 +3549,8 @@ The terminal type can be configured with `tramp-terminal-type'."
(defun tramp-process-one-action (proc vec actions)
"Wait for output from the shell and perform one action."
- (let (found todo item pattern action)
+ (let ((case-fold-search t)
+ found todo item pattern action)
(while (not found)
;; Reread output once all actions have been performed.
;; Obviously, the output was not complete.
@@ -3497,8 +3572,8 @@ The terminal type can be configured with `tramp-terminal-type'."
PROC and VEC indicate the remote connection to be used. POS, if
set, is the starting point of the region to be deleted in the
connection buffer."
- ;; Enable `auth-source' and `password-cache'. We must use
- ;; tramp-current-* variables in case we have several hops.
+ ;; Enable `auth-source'. We must use tramp-current-* variables in
+ ;; case we have several hops.
(tramp-set-connection-property
(tramp-dissect-file-name
(tramp-make-tramp-file-name
@@ -3529,11 +3604,12 @@ connection buffer."
(cond
((eq exit 'permission-denied) "Permission denied")
((eq exit 'process-died)
- (concat
- "Tramp failed to connect. If this happens repeatedly, try\n"
- " `M-x tramp-cleanup-this-connection'"))
+ (substitute-command-keys
+ (concat
+ "Tramp failed to connect. If this happens repeatedly, try\n"
+ " `\\[tramp-cleanup-this-connection]'")))
((eq exit 'timeout)
- (format
+ (format-message
"Timeout reached, see buffer `%s' for details"
(tramp-get-connection-buffer vec)))
(t "Login failed")))))
@@ -3548,15 +3624,19 @@ connection buffer."
This is needed in order to hide `last-coding-system-used', which is set
for process communication also."
(with-current-buffer (process-buffer proc)
- (tramp-message proc 10 "%s %s" proc (process-status proc))
- (let (buffer-read-only last-coding-system-used)
+ ;; FIXME: If there is a gateway process, we need communication
+ ;; between several processes. Too complicate to implement, so we
+ ;; read output from all processes.
+ (let ((p (if (tramp-get-connection-property proc "gateway" nil) nil proc))
+ buffer-read-only last-coding-system-used)
;; Under Windows XP, accept-process-output doesn't return
;; sometimes. So we add an additional timeout.
(with-timeout ((or timeout 1))
(if (featurep 'xemacs)
- (accept-process-output proc timeout timeout-msecs)
- (accept-process-output proc timeout timeout-msecs (and proc t)))))
- (tramp-message proc 10 "\n%s" (buffer-string))))
+ (accept-process-output p timeout timeout-msecs)
+ (accept-process-output p timeout timeout-msecs (and proc t))))
+ (tramp-message proc 10 "%s %s %s\n%s"
+ proc (process-status proc) p (buffer-string)))))
(defun tramp-check-for-regexp (proc regexp)
"Check, whether REGEXP is contained in process buffer of PROC.
@@ -3698,11 +3778,11 @@ Example:
(tramp-equal-remote \"/ssh::/etc\" \"/<your host name>:/home\")
-would yield `t'. On the other hand, the following check results in nil:
+would yield t. On the other hand, the following check results in nil:
(tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")"
- (and (stringp (file-remote-p file1))
- (stringp (file-remote-p file2))
+ (and (tramp-tramp-file-p file1)
+ (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2))))
;;;###tramp-autoload
@@ -3850,9 +3930,18 @@ be granted."
(or
result
(let ((file-attr
- (tramp-get-file-property
- vec (tramp-file-name-localname vec)
- (concat "file-attributes-" suffix) nil))
+ (or
+ (tramp-get-file-property
+ vec (tramp-file-name-localname vec)
+ (concat "file-attributes-" suffix) nil)
+ (tramp-compat-file-attributes
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (tramp-file-name-localname vec)
+ (tramp-file-name-hop vec))
+ (intern suffix))))
(remote-uid
(tramp-get-connection-property
vec (concat "uid-" suffix) nil))
@@ -3888,10 +3977,9 @@ be granted."
(stringp host)
(string-match tramp-local-host-regexp host)
;; The method shall be applied to one of the shell file name
- ;; handler. `tramp-local-host-p' is also called for "smb" and
+ ;; handlers. `tramp-local-host-p' is also called for "smb" and
;; alike, where it must fail.
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-login-program)
+ (tramp-get-method-parameter vec 'tramp-login-program)
;; The local temp directory must be writable for the other user.
(file-writable-p
(tramp-make-tramp-file-name
@@ -3907,18 +3995,19 @@ be granted."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
- (with-tramp-connection-property vec "tmpdir"
- (let ((dir (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- (or
- (tramp-get-method-parameter
- (tramp-file-name-method vec) 'tramp-tmpdir)
- "/tmp"))))
- (if (and (file-directory-p dir) (file-writable-p dir))
- dir
- (tramp-error vec 'file-error "Directory %s not accessible" dir)))))
+ (when (file-remote-p (tramp-get-connection-property vec "tmpdir" ""))
+ ;; Compatibility code: Cached value shall be the local path only.
+ (tramp-set-connection-property vec "tmpdir" 'undef))
+ (let ((dir (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
+ (with-tramp-connection-property vec "tmpdir"
+ (or (and (file-directory-p dir) (file-writable-p dir)
+ (tramp-file-name-handler 'file-remote-p dir 'localname))
+ (tramp-error vec 'file-error "Directory %s not accessible" dir)))
+ dir))
;;;###tramp-autoload
(defun tramp-make-tramp-temp-file (vec)
@@ -3954,6 +4043,48 @@ Return the local name of the temporary file."
'tramp-delete-temp-file-function)))
;;; Auto saving to a special directory:
+(defvar auto-save-file-name-transforms)
+
+(defun tramp-handle-make-auto-save-file-name ()
+ "Like `make-auto-save-file-name' for Tramp files.
+Returns a file name in `tramp-auto-save-directory' for autosaving
+this file, if that variable is non-nil."
+ (when (stringp tramp-auto-save-directory)
+ (setq tramp-auto-save-directory
+ (expand-file-name tramp-auto-save-directory)))
+ ;; Create directory.
+ (unless (or (null tramp-auto-save-directory)
+ (file-exists-p tramp-auto-save-directory))
+ (make-directory tramp-auto-save-directory t))
+
+ (let ((system-type 'not-windows)
+ (auto-save-file-name-transforms
+ (if (and (null tramp-auto-save-directory)
+ (boundp 'auto-save-file-name-transforms))
+ (symbol-value 'auto-save-file-name-transforms)))
+ (buffer-file-name
+ (if (null tramp-auto-save-directory)
+ buffer-file-name
+ (expand-file-name
+ (tramp-subst-strs-in-string
+ '(("_" . "|")
+ ("/" . "_a")
+ (":" . "_b")
+ ("|" . "__")
+ ("[" . "_l")
+ ("]" . "_r"))
+ (buffer-file-name))
+ tramp-auto-save-directory))))
+ ;; Run plain `make-auto-save-file-name'. There might be an advice when
+ ;; it is not a magic file name operation (since Emacs 22).
+ ;; We must deactivate it temporarily.
+ (if (not (ad-is-active 'make-auto-save-file-name))
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ ;; else
+ (ad-deactivate 'make-auto-save-file-name)
+ (prog1
+ (tramp-run-real-handler 'make-auto-save-file-name nil)
+ (ad-activate 'make-auto-save-file-name)))))
(unless (tramp-exists-file-name-handler 'make-auto-save-file-name)
(defadvice make-auto-save-file-name
@@ -4016,25 +4147,74 @@ ALIST is of the form ((FROM . TO) ...)."
;;; Compatibility functions section:
(defun tramp-call-process
- (program &optional infile destination display &rest args)
+ (vec program &optional infile destination display &rest args)
"Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadvised `call-process' to behave like `process-file'. The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1.
-Furthermore, traces are written with verbosity of 6."
- (tramp-message
- (vector tramp-current-method tramp-current-user tramp-current-host nil nil)
- 6 "%s %s %s" program infile args)
- (if (executable-find program)
- (apply 'call-process program infile destination display args)
- 1))
+It always returns a return code. The Lisp error raised when
+PROGRAM is nil is trapped also, returning 1. Furthermore, traces
+are written with verbosity of 6."
+ (let ((v (or vec
+ (vector tramp-current-method tramp-current-user
+ tramp-current-host nil nil)))
+ (destination (if (eq destination t) (current-buffer) destination))
+ result)
+ (tramp-message
+ v 6 "`%s %s' %s %s"
+ program (mapconcat 'identity args " ") infile destination)
+ (condition-case err
+ (with-temp-buffer
+ (setq result
+ (apply
+ 'call-process program infile (or destination t) display args))
+ ;; `result' could also be an error string.
+ (when (stringp result)
+ (signal 'file-error (list result)))
+ (with-current-buffer
+ (if (bufferp destination) destination (current-buffer))
+ (tramp-message v 6 "%d\n%s" result (buffer-string))))
+ (error
+ (setq result 1)
+ (tramp-message v 6 "%d\n%s" result (error-message-string err))))
+ result))
+
+(defun tramp-call-process-region
+ (vec start end program &optional delete buffer display &rest args)
+ "Calls `call-process-region' on the local host.
+It always returns a return code. The Lisp error raised when
+PROGRAM is nil is trapped also, returning 1. Furthermore, traces
+are written with verbosity of 6."
+ (let ((v (or vec
+ (vector tramp-current-method tramp-current-user
+ tramp-current-host nil nil)))
+ (buffer (if (eq buffer t) (current-buffer) buffer))
+ result)
+ (tramp-message
+ v 6 "`%s %s' %s %s %s %s"
+ program (mapconcat 'identity args " ") start end delete buffer)
+ (condition-case err
+ (progn
+ (setq result
+ (apply
+ 'call-process-region
+ start end program delete buffer display args))
+ ;; `result' could also be an error string.
+ (when (stringp result)
+ (signal 'file-error (list result)))
+ (with-current-buffer (if (bufferp buffer) buffer (current-buffer))
+ (if (zerop result)
+ (tramp-message v 6 "%d" result)
+ (tramp-message v 6 "%d\n%s" result (buffer-string)))))
+ (error
+ (setq result 1)
+ (tramp-message v 6 "%d\n%s" result (error-message-string err))))
+ result))
;;;###tramp-autoload
(defun tramp-read-passwd (proc &optional prompt)
"Read a password from user (compat function).
Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else."
- (let* ((key (tramp-make-tramp-file-name
+ (let* ((case-fold-search t)
+ (key (tramp-make-tramp-file-name
tramp-current-method tramp-current-user
tramp-current-host ""))
(pw-prompt
@@ -4042,47 +4222,66 @@ Invokes `password-read' if available, `read-passwd' else."
(with-current-buffer (process-buffer proc)
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
(format "%s for %s " (capitalize (match-string 1)) key))))
- auth-info auth-passwd)
- (with-parsed-tramp-file-name key nil
- (prog1
- (or
- ;; See if auth-sources contains something useful, if it's
- ;; bound. `auth-source-user-or-password' is an obsoleted
- ;; function, it has been replaced by `auth-source-search'.
- (and (boundp 'auth-sources)
- (tramp-get-connection-property v "first-password-request" nil)
- ;; Try with Tramp's current method.
- (if (fboundp 'auth-source-search)
- (setq auth-info
- (tramp-compat-funcall
- 'auth-source-search
- :max 1
- :user (or tramp-current-user t)
- :host tramp-current-host
- :port tramp-current-method)
- auth-passwd (plist-get (nth 0 auth-info) :secret)
- auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd))
- (tramp-compat-funcall
- 'auth-source-user-or-password
- "password" tramp-current-host tramp-current-method)))
- ;; Try the password cache.
- (when (functionp 'password-read)
- (unless (tramp-get-connection-property
- v "first-password-request" nil)
- (tramp-compat-funcall 'password-cache-remove key))
- (let ((password
- (tramp-compat-funcall 'password-read pw-prompt key)))
- (tramp-compat-funcall 'password-cache-add key password)
- password))
- ;; Else, get the password interactively.
- (read-passwd pw-prompt))
- (tramp-set-connection-property v "first-password-request" nil)))))
+ ;; We suspend the timers while reading the password.
+ (stimers (and (functionp 'with-timeout-suspend)
+ (tramp-compat-funcall 'with-timeout-suspend)))
+ auth-info auth-passwd)
+
+ (unwind-protect
+ (with-parsed-tramp-file-name key nil
+ (prog1
+ (or
+ ;; See if auth-sources contains something useful, if
+ ;; it's bound. `auth-source-user-or-password' is an
+ ;; obsoleted function, it has been replaced by
+ ;; `auth-source-search'.
+ (ignore-errors
+ (and (boundp 'auth-sources)
+ (tramp-get-connection-property
+ v "first-password-request" nil)
+ ;; Try with Tramp's current method.
+ (if (fboundp 'auth-source-search)
+ (setq auth-info
+ (tramp-compat-funcall
+ 'auth-source-search
+ :max 1
+ :user (or tramp-current-user t)
+ :host tramp-current-host
+ :port tramp-current-method)
+ auth-passwd (plist-get
+ (nth 0 auth-info) :secret)
+ auth-passwd (if (functionp auth-passwd)
+ (funcall auth-passwd)
+ auth-passwd))
+ (tramp-compat-funcall
+ 'auth-source-user-or-password
+ "password" tramp-current-host tramp-current-method))))
+ ;; Try the password cache.
+ (when (functionp 'password-read)
+ (let ((password
+ (tramp-compat-funcall 'password-read pw-prompt key)))
+ (tramp-compat-funcall 'password-cache-add key password)
+ password))
+ ;; Else, get the password interactively.
+ (read-passwd pw-prompt))
+ (tramp-set-connection-property v "first-password-request" nil)))
+ ;; Reenable the timers.
+ (and (functionp 'with-timeout-unsuspend)
+ (tramp-compat-funcall 'with-timeout-unsuspend stimers)))))
;;;###tramp-autoload
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
+ (let ((hop (tramp-file-name-hop vec)))
+ (when hop
+ ;; Clear also the passwords of the hops.
+ (tramp-clear-passwd
+ (tramp-dissect-file-name
+ (concat
+ tramp-prefix-format
+ (tramp-compat-replace-regexp-in-string
+ (concat tramp-postfix-hop-regexp "$")
+ tramp-postfix-host-format hop))))))
(tramp-compat-funcall
'password-cache-remove
(tramp-make-tramp-file-name
@@ -4103,26 +4302,6 @@ Invokes `password-read' if available, `read-passwd' else."
("oct" . 10) ("nov" . 11) ("dec" . 12))
"Alist mapping month names to integers.")
-;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
-;;;###tramp-autoload
-(defun tramp-time-less-p (t1 t2)
- "Say whether time value T1 is less than time value T2."
- (unless t1 (setq t1 '(0 0)))
- (unless t2 (setq t2 '(0 0)))
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2?
-(defun tramp-time-subtract (t1 t2)
- "Subtract two time values.
-Return the difference in the format of a time value."
- (unless t1 (setq t1 '(0 0)))
- (unless t2 (setq t2 '(0 0)))
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
;;;###tramp-autoload
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
@@ -4141,7 +4320,7 @@ T1 and T2 are time values (as returned by `current-time' for example)."
(if (< (length t1) 3) (append t1 '(0)) t1)
(if (< (length t2) 3) (append t2 '(0)) t2)))
(t
- (let ((time (tramp-time-subtract t1 t2)))
+ (let ((time (time-subtract t1 t2)))
(+ (* (car time) 65536.0)
(cadr time)
(/ (or (nth 2 time) 0) 1000000.0))))))
@@ -4163,7 +4342,7 @@ T1 and T2 are time values (as returned by `current-time' for example)."
;; This function should produce a string which is grokked by a Unix
;; shell, even if the Emacs is running on Windows. Since this is the
;; kludges section, we bind `system-type' in such a way that
-;; `shell-quote-arguments' behaves as if on Unix.
+;; `shell-quote-argument' behaves as if on Unix.
;;
;; Thanks to Mario DeWeerd for the hint that it is sufficient for this
;; function to work with Bourne-like shells.
@@ -4194,7 +4373,7 @@ Only works for Bourne-like shells."
(defun tramp-eshell-directory-change ()
"Set `eshell-path-env' to $PATH of the host related to `default-directory'."
(setq eshell-path-env
- (if (file-remote-p default-directory)
+ (if (tramp-tramp-file-p default-directory)
(with-parsed-tramp-file-name default-directory nil
(mapconcat
'identity
@@ -4236,8 +4415,6 @@ Only works for Bourne-like shells."
;;; TODO:
-;; * Rewrite `tramp-shell-quote-argument' to abstain from using
-;; `shell-quote-argument'.
;; * In Emacs 21, `insert-directory' shows total number of bytes used
;; by the files in that directory. Add this here.
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
@@ -4254,11 +4431,6 @@ Only works for Bourne-like shells."
;; tramp-server-local-variable-alist) to define any such variables
;; that they need to, which would then be let bound as appropriate
;; in tramp functions. (Jason Rumney)
-;; * IMHO, it's a drawback that currently Tramp doesn't support
-;; Unicode in Dired file names by default. Is it possible to
-;; improve Tramp to set LC_ALL to "C" only for commands where Tramp
-;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
-;; expects only English messages? (Juri Linkov)
;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
;; * I was wondering if it would be possible to use tramp even if I'm
;; actually using sshfs. But when I launch a command I would like
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 0e54cd60d98..5c42f3a828a 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -1,7 +1,7 @@
;;; trampver.el --- Transparent Remote Access, Multiple Protocol
;;; lisp/trampver.el. Generated from trampver.el.in by configure.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <kai.grossjohann@gmx.net>
;; Keywords: comm, processes
@@ -24,27 +24,45 @@
;;; Code:
-;; In the Tramp CVS repository, the version number and the bug report
+;; In the Tramp GIT repository, the version number and the bug report
;; address are auto-frobbed from configure.ac, so you should edit that
;; file and run "autoconf && ./configure" to change them. (X)Emacs
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.2.8-pre"
+(defconst tramp-version "2.2.13-pre"
"This version of Tramp.")
;;;###tramp-autoload
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
+;; `locate-dominating-file' does not exist in XEmacs. But it is not used here.
+(autoload 'locate-dominating-file "files")
+(autoload 'tramp-compat-replace-regexp-in-string "tramp-compat")
+
+(defun tramp-repository-get-version ()
+ "Try to return as a string the repository revision of the Tramp sources."
+ (unless (featurep 'xemacs)
+ (let ((dir (locate-dominating-file (locate-library "tramp") ".git")))
+ (when dir
+ (with-temp-buffer
+ (let ((default-directory (file-name-as-directory dir)))
+ (and (zerop
+ (ignore-errors
+ (call-process "git" nil '(t nil) nil "rev-parse" "HEAD")))
+ (not (zerop (buffer-size)))
+ (tramp-compat-replace-regexp-in-string
+ "\n" "" (buffer-string)))))))))
+
;; Check for (X)Emacs version.
(let ((x (if (or (>= emacs-major-version 22)
(and (featurep 'xemacs)
(= emacs-major-version 21)
(>= emacs-minor-version 4)))
"ok"
- (format "Tramp 2.2.8-pre is not fit for %s"
+ (format "Tramp 2.2.13-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index a7db6d0a73b..7cb017f39a3 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,6 +1,6 @@
;;; webjump.el --- programmable Web hotlist
-;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Neil W. Van Dyke <nwv@acm.org>
;; Created: 09-Aug-1996
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 2160443c395..794a4676a5e 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -1,6 +1,6 @@
;;; zeroconf.el --- Service browser using Avahi.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, hardware
@@ -197,7 +197,7 @@ The key of an entry is the concatenation of the service name and
service type of a discovered service. The value is the service
itself. The format of a service is
- \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)
+ \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS)
The INTERFACE is a number, which represents the network interface
the service is located at. The corresponding network interface
@@ -233,7 +233,7 @@ The key of an entry is the concatenation of the service name and
service type of a resolved service. The value is the service
itself. The format of a service is
- \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)
+ (INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS)
INTERFACE, PROTOCOL, NAME, TYPE, DOMAIN and FLAGS have the same
meaning as in `zeroconf-services-hash'.
@@ -275,7 +275,7 @@ supported keys depend on the service type.")
"Returns all discovered Avahi services for a given service type TYPE.
The service type is one of the returned values of
`zeroconf-list-service-types'. The return value is a list
-\(SERVICE1 SERVICE2 ...\). See `zeroconf-services-hash' for the
+\(SERVICE1 SERVICE2 ...). See `zeroconf-services-hash' for the
format of SERVICE."
(let (result)
(maphash
@@ -385,7 +385,7 @@ type used when registering FUNCTION."
NAME must be a string. The service must be of service type
TYPE. The resulting list has the format
- \(INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS\)."
+ (INTERFACE PROTOCOL NAME TYPE DOMAIN FLAGS)."
;; Due to the service browser, all known services are kept in
;; `zeroconf-services-hash'.
(gethash (concat name "/" type) zeroconf-services-hash nil))
@@ -395,7 +395,7 @@ TYPE. The resulting list has the format
NAME must be a string. The service must be of service type
TYPE. The resulting list has the format
- \(INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS\)."
+ (INTERFACE PROTOCOL NAME TYPE DOMAIN HOST APROTOCOL ADDRESS PORT TXT FLAGS)."
(let* ((name (zeroconf-service-name service))
(type (zeroconf-service-type service))
(key (concat name "/" type)))
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 19a06bfe8e5..0c49211869e 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -1,6 +1,6 @@
;;; newcomment.el --- (un)comment regions of buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: code extracted from Emacs-20's simple.el
;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca>
@@ -120,8 +120,9 @@ Comments might be indented to a different value in order not to go beyond
;;;###autoload
(defvar comment-start-skip nil
"Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair.")
+If there are any \\(...\\) pairs and `comment-use-syntax' is nil,
+the comment delimiter text is held to begin at the place matched
+by the close of the first pair.")
;;;###autoload
(put 'comment-start-skip 'safe-local-variable 'stringp)
@@ -178,6 +179,11 @@ comments always start in column zero.")
"Non-nil if nested comments should be quoted.
This should be locally set by each major mode if needed.")
+(defvar comment-quote-nested-function #'comment-quote-nested-default
+ "Function to quote nested comments in a region.
+It takes the same arguments as `comment-quote-nested-default',
+and is called with the buffer narrowed to a single comment.")
+
(defvar comment-continue nil
"Continuation string to insert for multiline comments.
This string will be added at the beginning of each line except the very
@@ -285,8 +291,8 @@ makes the comment easier to read. Default is 1. nil means 0."
This is useful when style-conventions require a certain minimal offset.
Python's PEP8 for example recommends two spaces, so you could do:
-\(add-hook 'python-mode-hook
- (lambda () (set (make-local-variable 'comment-inline-offset) 2)))
+\(add-hook \\='python-mode-hook
+ (lambda () (set (make-local-variable \\='comment-inline-offset) 2)))
See `comment-padding' for whole-line comments."
:version "24.3"
@@ -312,7 +318,7 @@ If `eol' it only comments out empty lines if comments are
terminated by the end of line (i.e. `comment-end' is empty)."
:type '(choice (const :tag "Never" nil)
(const :tag "Always" t)
- (const :tag "EOl-terminated" 'eol))
+ (const :tag "EOl-terminated" eol))
:group 'comment)
;;;;
@@ -378,7 +384,10 @@ function should first call this function explicitly."
;; In case comment-start has changed since last time.
(string-match comment-start-skip comment-start))
(set (make-local-variable 'comment-start-skip)
- (concat "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(\\s<+\\|"
+ (concat (unless (eq comment-use-syntax t)
+ ;; `syntax-ppss' will detect escaping.
+ "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)")
+ "\\(?:\\s<+\\|"
(regexp-quote (comment-string-strip comment-start t t))
;; Let's not allow any \s- but only [ \t] since \n
;; might be both a comment-end marker and \s-.
@@ -408,39 +417,58 @@ function should first call this function explicitly."
If UNP is non-nil, unquote nested comment markers."
(setq cs (comment-string-strip cs t t))
(setq ce (comment-string-strip ce t t))
- (when (and comment-quote-nested (> (length ce) 0))
- (let ((re (concat (comment-quote-re ce unp)
- "\\|" (comment-quote-re cs unp))))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (goto-char (match-beginning 0))
- (forward-char 1)
- (if unp (delete-char 1) (insert "\\"))
- (when (= (length ce) 1)
- ;; If the comment-end is a single char, adding a \ after that
- ;; "first" char won't deactivate it, so we turn such a CE
- ;; into !CS. I.e. for pascal, we turn } into !{
- (if (not unp)
- (when (string= (match-string 0) ce)
- (replace-match (concat "!" cs) t t))
- (when (and (< (point-min) (match-beginning 0))
- (string= (buffer-substring (1- (match-beginning 0))
- (1- (match-end 0)))
- (concat "!" cs)))
- (backward-char 2)
- (delete-char (- (match-end 0) (match-beginning 0)))
- (insert ce))))))))
+ (when (and comment-quote-nested
+ (> (length ce) 0))
+ (funcall comment-quote-nested-function cs ce unp)))
+
+(defun comment-quote-nested-default (cs ce unp)
+ "Quote comment delimiters in the buffer.
+It expects to be called with the buffer narrowed to a single comment.
+It is used as a default for `comment-quote-nested-function'.
+
+The arguments CS and CE are strings matching comment starting and
+ending delimiters respectively.
+
+If UNP is non-nil, comments are unquoted instead.
+
+To quote the delimiters, a \\ is inserted after the first
+character of CS or CE. If CE is a single character it will
+change CE into !CS."
+ (let ((re (concat (comment-quote-re ce unp)
+ "\\|" (comment-quote-re cs unp))))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (goto-char (match-beginning 0))
+ (forward-char 1)
+ (if unp (delete-char 1) (insert "\\"))
+ (when (= (length ce) 1)
+ ;; If the comment-end is a single char, adding a \ after that
+ ;; "first" char won't deactivate it, so we turn such a CE
+ ;; into !CS. I.e. for pascal, we turn } into !{
+ (if (not unp)
+ (when (string= (match-string 0) ce)
+ (replace-match (concat "!" cs) t t))
+ (when (and (< (point-min) (match-beginning 0))
+ (string= (buffer-substring (1- (match-beginning 0))
+ (1- (match-end 0)))
+ (concat "!" cs)))
+ (backward-char 2)
+ (delete-char (- (match-end 0) (match-beginning 0)))
+ (insert ce)))))))
;;;;
;;;; Navigation
;;;;
-(defvar comment-use-global-state nil
+(defvar comment-use-global-state t
"Non-nil means that the global syntactic context is used.
More specifically, it means that `syntax-ppss' is used to find out whether
-point is within a string or not. Major modes whose syntax is faithfully
-described by the syntax-tables can set this to non-nil so comment markers
-in strings will not confuse Emacs.")
+point is within a string or not. Major modes whose syntax is not faithfully
+described by the syntax-tables (or where `font-lock-syntax-table' is radically
+different from the main syntax table) can set this to nil,
+then `syntax-ppss' cache won't be used in comment-related routines.")
+
+(make-obsolete-variable 'comment-use-global-state 'comment-use-syntax "24.4")
(defun comment-search-forward (limit &optional noerror)
"Find a comment start between point and LIMIT.
@@ -515,30 +543,40 @@ Ensure that `comment-normalize-vars' has been called before you use this."
"Find the beginning of the enclosing comment.
Returns nil if not inside a comment, else moves point and returns
the same as `comment-search-backward'."
- ;; HACK ATTACK!
- ;; We should really test `in-string-p' but that can be expensive.
- (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
- (let ((pt (point))
- (cs (comment-search-backward nil t)))
- (when cs
- (if (save-excursion
- (goto-char cs)
- (and
- ;; For modes where comment-start and comment-end are the same,
- ;; the search above may have found a `ce' rather than a `cs'.
- (or (if comment-end-skip (not (looking-at comment-end-skip)))
- ;; Maybe font-lock knows that it's a `cs'?
- (eq (get-text-property (match-end 0) 'face)
- 'font-lock-comment-face)
- (unless (eq (get-text-property (point) 'face)
- 'font-lock-comment-face)
- ;; Let's assume it's a `cs' if we're on the same line.
- (>= (line-end-position) pt)))
- ;; Make sure that PT is not past the end of the comment.
- (if (comment-forward 1) (> (point) pt) (eobp))))
- cs
- (goto-char pt)
- nil)))))
+ (if (and comment-use-syntax comment-use-global-state)
+ (let ((state (syntax-ppss)))
+ (when (nth 4 state)
+ (goto-char (nth 8 state))
+ (prog1 (point)
+ (when (save-restriction
+ ;; `comment-start-skip' sometimes checks that the
+ ;; comment char is not escaped. (Bug#16971)
+ (narrow-to-region (point) (point-max))
+ (looking-at comment-start-skip))
+ (goto-char (match-end 0))))))
+ ;; Can't rely on the syntax table, let's guess based on font-lock.
+ (unless (eq (get-text-property (point) 'face) 'font-lock-string-face)
+ (let ((pt (point))
+ (cs (comment-search-backward nil t)))
+ (when cs
+ (if (save-excursion
+ (goto-char cs)
+ (and
+ ;; For modes where comment-start and comment-end are the same,
+ ;; the search above may have found a `ce' rather than a `cs'.
+ (or (if comment-end-skip (not (looking-at comment-end-skip)))
+ ;; Maybe font-lock knows that it's a `cs'?
+ (eq (get-text-property (match-end 0) 'face)
+ 'font-lock-comment-face)
+ (unless (eq (get-text-property (point) 'face)
+ 'font-lock-comment-face)
+ ;; Let's assume it's a `cs' if we're on the same line.
+ (>= (line-end-position) pt)))
+ ;; Make sure that PT is not past the end of the comment.
+ (if (comment-forward 1) (> (point) pt) (eobp))))
+ cs
+ (goto-char pt)
+ nil))))))
(defun comment-forward (&optional n)
"Skip forward over N comments.
@@ -1249,7 +1287,7 @@ Else, call `comment-indent'.
You can configure `comment-style' to change the way regions are commented."
(interactive "*P")
(comment-normalize-vars)
- (if (and mark-active transient-mark-mode)
+ (if (use-region-p)
(comment-or-uncomment-region (region-beginning) (region-end) arg)
(if (save-excursion (beginning-of-line) (not (looking-at "\\s-*$")))
;; FIXME: If there's no comment to kill on this line and ARG is
@@ -1373,22 +1411,12 @@ unless optional argument SOFT is non-nil."
;; If we're not inside a comment, just try to indent.
((not compos) (indent-according-to-mode))
(t
- (let* ((comment-column
- ;; The continuation indentation should be somewhere between
- ;; the current line's indentation (plus 2 for good measure)
- ;; and the current comment's indentation, with a preference
- ;; for comment-column.
- (save-excursion
- ;; FIXME: use prev line's info rather than first line's.
- (goto-char compos)
- (min (current-column) (max comment-column
- (+ 2 (current-indentation))))))
- (comstart (buffer-substring compos comin))
+ (let* ((comstart (buffer-substring compos comin))
(normalp
(string-match (regexp-quote (comment-string-strip
comment-start t t))
comstart))
- (comment-end
+ (comend
(if normalp comment-end
;; The comment starter is not the normal comment-start
;; so we can't just use comment-end.
@@ -1399,19 +1427,42 @@ unless optional argument SOFT is non-nil."
(buffer-substring
(save-excursion (comment-enter-backward) (point))
(point))
- nil t)))))
- (comment-start comstart)
- (continuep (or comment-multi-line
- (cadr (assoc comment-style comment-styles))))
- ;; Force comment-continue to be recreated from comment-start.
- ;; FIXME: wrong if comment-continue was set explicitly!
- ;; FIXME: use prev line's continuation if available.
- (comment-continue nil))
- (if (and comment-multi-line (> (length comment-end) 0))
+ nil t))))))
+ (if (and comment-multi-line (> (length comend) 0))
(indent-according-to-mode)
(insert-and-inherit ?\n)
(forward-char -1)
- (comment-indent continuep)
+ (let* ((comment-column
+ ;; The continuation indentation should be somewhere
+ ;; between the current line's indentation (plus 2 for
+ ;; good measure) and the current comment's indentation,
+ ;; with a preference for comment-column.
+ (save-excursion
+ ;; FIXME: use prev line's info rather than first
+ ;; line's.
+ (goto-char compos)
+ (min (current-column)
+ (max comment-column
+ (+ 2 (current-indentation))))))
+ (comment-indent-function
+ ;; If the previous comment is on its own line, then
+ ;; reuse its indentation unconditionally.
+ ;; Important for modes like Python/Haskell where
+ ;; auto-indentation is unreliable.
+ (if (save-excursion (goto-char compos)
+ (skip-chars-backward " \t")
+ (bolp))
+ (lambda () comment-column) comment-indent-function))
+ (comment-start comstart)
+ (comment-end comend)
+ (continuep (or comment-multi-line
+ (cadr (assoc comment-style
+ comment-styles))))
+ ;; Recreate comment-continue from comment-start.
+ ;; FIXME: wrong if comment-continue was set explicitly!
+ ;; FIXME: use prev line's continuation if available.
+ (comment-continue nil))
+ (comment-indent continuep))
(save-excursion
(let ((pt (point)))
(end-of-line)
@@ -1421,6 +1472,38 @@ unless optional argument SOFT is non-nil."
(end-of-line 0)
(insert comend))))))))))))
+;;;###autoload
+(defun comment-line (n)
+ "Comment or uncomment current line and leave point after it.
+With positive prefix, apply to N lines including current one.
+With negative prefix, apply to -N lines above. Also, further
+consecutive invocations of this command will inherit the negative
+argument.
+
+If region is active, comment lines in active region instead.
+Unlike `comment-dwim', this always comments whole lines."
+ (interactive "p")
+ (if (use-region-p)
+ (comment-or-uncomment-region
+ (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position))
+ (save-excursion
+ (goto-char (region-end))
+ (line-end-position)))
+ (when (and (eq last-command 'comment-line-backward)
+ (natnump n))
+ (setq n (- n)))
+ (let ((range
+ (list (line-beginning-position)
+ (goto-char (line-end-position n)))))
+ (comment-or-uncomment-region
+ (apply #'min range)
+ (apply #'max range)))
+ (forward-line 1)
+ (back-to-indentation)
+ (unless (natnump n) (setq this-command 'comment-line-backward))))
+
(provide 'newcomment)
;;; newcomment.el ends here
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 5c8c8f1dc68..ccd64fbafa9 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -1,6 +1,6 @@
;;; notifications.el --- Client interface to desktop notifications.
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm desktop notifications
@@ -349,7 +349,7 @@ BUS can be a string denoting a D-Bus connection, the default is `:session'."
notifications-path
notifications-interface
notifications-close-notification-method
- :int32 id))
+ :uint32 id))
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
diff --git a/lisp/novice.el b/lisp/novice.el
index 92ba3d5277b..18ffa5da0e5 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -1,9 +1,9 @@
;;; novice.el --- handling of disabled commands ("novice mode") for Emacs
-;; Copyright (C) 1985-1987, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1994, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal, help
;; This file is part of GNU Emacs.
@@ -65,7 +65,8 @@ If nil, the feature is disabled, i.e., all commands work normally.")
(if (stringp (get cmd 'disabled))
(princ (get cmd 'disabled))
(princ "It is disabled because new users often find it confusing.\n")
- (princ "Here's the first part of its description:\n\n")
+ (princ (substitute-command-keys
+ "Here's the first part of its description:\n\n"))
;; Keep only the first paragraph of the documentation.
(with-current-buffer "*Disabled Command*" ;; standard-output
(goto-char (point-max))
@@ -80,11 +81,11 @@ If nil, the feature is disabled, i.e., all commands work normally.")
(goto-char (point-max))
(indent-rigidly start (point) 3))))
(princ "\n\nDo you want to use this command anyway?\n\n")
- (princ "You can now type
+ (princ (substitute-command-keys "You can now type
y to try it and enable it (no questions if you use it again).
n to cancel--don't try the command, and it remains disabled.
SPC to try the command just this once, but leave it disabled.
-! to try it, and enable all disabled commands for this session only.")
+! to try it, and enable all disabled commands for this session only."))
;; Redundant since with-output-to-temp-buffer will do it anyway.
;; (with-current-buffer standard-output
;; (help-mode))
diff --git a/lisp/nxml/.gitignore b/lisp/nxml/.gitignore
deleted file mode 100644
index f18ed02a937..00000000000
--- a/lisp/nxml/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-*.elc
-subdirs.el
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index 7bcae56e08e..32917688df8 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -1,9 +1,9 @@
;;; nxml-enc.el --- XML encoding auto-detection
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el
index bd27c1ff03a..449d92bc32d 100644
--- a/lisp/nxml/nxml-glyph.el
+++ b/lisp/nxml/nxml-glyph.el
@@ -1,9 +1,9 @@
;;; nxml-glyph.el --- glyph-handling for nxml-mode
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index 3f0d277fb70..73abfd9ac96 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -1,9 +1,9 @@
;;; nxml-maint.el --- commands for maintainers of nxml-*.el
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index c45196f0316..0e2fca349a5 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1,9 +1,9 @@
-;;; nxml-mode.el --- a new XML mode
+;;; nxml-mode.el --- a new XML mode -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -46,6 +46,7 @@
(defgroup nxml nil
"New XML editing mode."
+ :link '(custom-manual "(nxml-mode) Top")
:group 'languages)
(defgroup nxml-faces nil
@@ -448,6 +449,9 @@ reference.")
(when rng-validate-mode
(rng-validate-while-idle (current-buffer)))))
+(defvar tildify-space-string)
+(defvar tildify-foreach-region-function)
+
;;;###autoload
(define-derived-mode nxml-mode text-mode "nXML"
;; We use C-c C-i instead of \\[nxml-balanced-close-start-tag-inline]
@@ -504,6 +508,19 @@ be treated as a single markup item, set the variable
Many aspects this mode can be customized using
\\[customize-group] nxml RET."
;; (kill-all-local-variables)
+ ;; If encoding does not allow non-break space character, use reference.
+ ;; FIXME: This duplicates code from sgml-mode, perhaps derive from it?
+ ;; FIXME: Perhaps use &nbsp; if possible (e.g. XHTML)?
+ (setq-local tildify-space-string
+ (if (equal (decode-coding-string
+ (encode-coding-string " " buffer-file-coding-system)
+ buffer-file-coding-system) " ")
+ " " "&#160;"))
+ ;; FIXME: Use the fact that we're parsing the document already
+ ;; rather than using regex-based filtering.
+ (setq-local tildify-foreach-region-function
+ (apply-partially 'tildify-foreach-ignore-environments
+ '(("<! *--" . "-- *>") ("<" . ">"))))
(set (make-local-variable 'mode-line-process) '((nxml-degraded "/degraded")))
;; We'll determine the fill prefix ourselves
(make-local-variable 'adaptive-fill-mode)
@@ -529,6 +546,7 @@ Many aspects this mode can be customized using
(setq comment-end-skip "[ \t\r\n]*-->")
(make-local-variable 'comment-line-break-function)
(setq comment-line-break-function 'nxml-newline-and-indent)
+ (setq-local comment-quote-nested-function 'nxml-comment-quote-nested)
(use-local-map nxml-mode-map)
(save-excursion
(save-restriction
@@ -540,14 +558,14 @@ Many aspects this mode can be customized using
(nxml-scan-prolog)))))
(add-hook 'completion-at-point-functions
#'nxml-completion-at-point-function nil t)
- (add-hook 'after-change-functions 'nxml-after-change nil t)
+ (setq-local syntax-propertize-function #'nxml-after-change)
(add-hook 'change-major-mode-hook 'nxml-cleanup nil t)
;; Emacs 23 handles the encoding attribute on the xml declaration
;; transparently to nxml-mode, so there is no longer a need for the below
;; hook. The hook also had the drawback of overriding explicit user
;; instruction to save as some encoding other than utf-8.
-;;; (add-hook 'write-contents-hooks 'nxml-prepare-to-save)
+ ;;(add-hook 'write-contents-hooks 'nxml-prepare-to-save)
(when (not (and (buffer-file-name) (file-exists-p (buffer-file-name))))
(when (and nxml-default-buffer-file-coding-system
(not (local-variable-p 'buffer-file-coding-system)))
@@ -561,8 +579,6 @@ Many aspects this mode can be customized using
nil ; font-lock-keywords-case-fold-search. XML is case sensitive
nil ; no special syntax table
nil ; no automatic syntactic fontification
- (font-lock-extend-after-change-region-function
- . nxml-extend-after-change-region)
(font-lock-extend-region-functions . (nxml-extend-region))
(jit-lock-contextually . t)
(font-lock-unfontify-region-function . nxml-unfontify-region)))
@@ -597,6 +613,7 @@ Many aspects this mode can be customized using
;;; Change management
+(defvar font-lock-beg) (defvar font-lock-end)
(defun nxml-debug-region (start end)
(interactive "r")
(let ((font-lock-beg start)
@@ -605,22 +622,16 @@ Many aspects this mode can be customized using
(goto-char font-lock-beg)
(set-mark font-lock-end)))
-(defun nxml-after-change (start end pre-change-length)
- ; In font-lock mode, nxml-after-change1 is called via
- ; nxml-extend-after-change-region instead so that the updated
- ; book-keeping information is available for fontification.
- (unless (or font-lock-mode nxml-degraded)
+(defun nxml-after-change (start end)
+ ;; Called via syntax-propertize-function.
+ (unless nxml-degraded
(nxml-with-degradation-on-error 'nxml-after-change
- (save-excursion
- (save-restriction
- (widen)
- (save-match-data
- (nxml-with-invisible-motion
- (with-silent-modifications
- (nxml-after-change1
- start end pre-change-length)))))))))
-
-(defun nxml-after-change1 (start end pre-change-length)
+ (save-restriction
+ (widen)
+ (nxml-with-invisible-motion
+ (nxml-after-change1 start end))))))
+
+(defun nxml-after-change1 (start end)
"After-change bookkeeping.
Returns a cons cell containing a possibly-enlarged change region.
You must call `nxml-extend-region' on this expanded region to obtain
@@ -628,23 +639,14 @@ the full extent of the area needing refontification.
For bookkeeping, call this function even when fontification is
disabled."
- (let ((pre-change-end (+ start pre-change-length)))
- ;; If the prolog might have changed, rescan the prolog
- (when (<= start
- ;; Add 2 so as to include the < and following char that
- ;; start the instance (document element), since changing
- ;; these can change where the prolog ends.
- (+ nxml-prolog-end 2))
- ;; end must be extended to at least the end of the old prolog in
- ;; case the new prolog is shorter
- (when (< pre-change-end nxml-prolog-end)
- (setq end
- ;; don't let end get out of range even if pre-change-length
- ;; is bogus
- (min (point-max)
- (+ end (- nxml-prolog-end pre-change-end)))))
- (nxml-scan-prolog)
- (setq start (point-min))))
+ ;; If the prolog might have changed, rescan the prolog.
+ (when (<= start
+ ;; Add 2 so as to include the < and following char that
+ ;; start the instance (document element), since changing
+ ;; these can change where the prolog ends.
+ (+ nxml-prolog-end 2))
+ (nxml-scan-prolog)
+ (setq start (point-min)))
(when (> end nxml-prolog-end)
(goto-char start)
@@ -653,8 +655,7 @@ disabled."
(setq end (max (nxml-scan-after-change start end)
end)))
- (nxml-debug-change "nxml-after-change1" start end)
- (cons start end))
+ (nxml-debug-change "nxml-after-change1" start end))
;;; Encodings
@@ -845,7 +846,6 @@ The XML declaration will declare an encoding depending on the buffer's
(font-lock-default-unfontify-region start end)
(nxml-clear-char-ref-extra-display start end))
-(defvar font-lock-beg) (defvar font-lock-end)
(defun nxml-extend-region ()
"Extend the region to hold the minimum area we can fontify with nXML.
Called with `font-lock-beg' and `font-lock-end' dynamically bound."
@@ -887,22 +887,9 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound."
(nxml-debug-change "nxml-extend-region" start end)
t)))
-(defun nxml-extend-after-change-region (start end pre-change-length)
- (unless nxml-degraded
- (nxml-with-degradation-on-error
- 'nxml-extend-after-change-region
- (save-excursion
- (save-restriction
- (widen)
- (save-match-data
- (nxml-with-invisible-motion
- (with-silent-modifications
- (nxml-after-change1
- start end pre-change-length)))))))))
-
(defun nxml-fontify-matcher (bound)
"Called as font-lock keyword matcher."
-
+ (syntax-propertize bound)
(unless nxml-degraded
(nxml-debug-change "nxml-fontify-matcher" (point) bound)
@@ -1364,6 +1351,18 @@ of the inserted start-tag or nil if none was inserted."
start-tag-indent)))))
inserted-start-tag-pos))
+(defun nxml-comment-quote-nested (_cs _ce unp)
+ "Quote nested comments in buffer.
+See `comment-quote-nested-function' for more information."
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward "-[\\]*-" nil t)
+ (goto-char (match-beginning 0))
+ (forward-char 1)
+ (if unp
+ (delete-char 1)
+ (insert "\\")))))
+
;;; Indentation
(defun nxml-indent-line ()
@@ -2597,7 +2596,7 @@ With a prefix argument, inserts the character directly."
(> (prefix-numeric-value arg) 0))))
(when (not (eq new nxml-char-ref-extra-display))
(setq nxml-char-ref-extra-display new)
- (font-lock-fontify-buffer))))
+ (font-lock-flush))))
(put 'nxml-char-ref 'evaporate t)
@@ -2660,8 +2659,9 @@ With a prefix argument, inserts the character directly."
(put 'entity-ref 'nxml-friendly-name "entity reference")
(put 'char-ref 'nxml-friendly-name "character reference")
-;;;###autoload
-(defalias 'xml-mode 'nxml-mode)
+;; Only do this in loaddefs, so that if someone defines a different
+;; alias in .emacs, loading this file afterwards does not clobber it.
+;;;###autoload(defalias 'xml-mode 'nxml-mode)
(provide 'nxml-mode)
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el
index cadb5e6adab..e55ecc36b01 100644
--- a/lisp/nxml/nxml-ns.el
+++ b/lisp/nxml/nxml-ns.el
@@ -1,9 +1,9 @@
-;;; nxml-ns.el --- XML namespace processing
+;;; nxml-ns.el --- XML namespace processing -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -56,12 +56,10 @@ namespace bindings (no default namespace and only the xml prefix bound).")
(equal nxml-ns-state state))
(defmacro nxml-ns-save (&rest body)
+ (declare (indent 0) (debug t))
`(let ((nxml-ns-state nxml-ns-initial-state))
,@body))
-(put 'nxml-ns-save 'lisp-indent-function 0)
-(def-edebug-spec nxml-ns-save t)
-
(defun nxml-ns-init ()
(setq nxml-ns-state nxml-ns-initial-state))
@@ -117,11 +115,12 @@ NS is a symbol or nil."
(setq current (cdr current))
(while (let ((binding (rassq ns current)))
(when binding
- (when (eq (nxml-ns-get-prefix (car binding)) ns)
- (add-to-list 'prefixes
- (car binding)))
- (setq current
- (cdr (member binding current))))))
+ (let ((prefix (car binding)))
+ (when (eq (nxml-ns-get-prefix prefix) ns)
+ (unless (member prefix prefixes)
+ (push prefix prefixes))))
+ (setq current
+ (cdr (member binding current))))))
prefixes))
(defun nxml-ns-prefix-for (ns)
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 5fe6cfefa83..c87cd5378fa 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -1,9 +1,9 @@
;;; nxml-outln.el --- outline support for nXML mode
-;; Copyright (C) 2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -1003,7 +1003,7 @@ immediately after the section's start-tag."
;;; Error handling
(defun nxml-report-outline-error (msg err)
- (error msg (apply 'format (cdr err))))
+ (error msg (apply #'format-message (cdr err))))
(defun nxml-outline-error (&rest args)
(signal 'nxml-outline-error args))
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index 964dd2d93c1..d8523ee9dbe 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -1,9 +1,9 @@
;;; nxml-parse.el --- XML parser, sharing infrastructure with nxml-mode
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -304,7 +304,7 @@ same way as well-formedness error."
(defun nxml-parse-error (position &rest args)
(nxml-signal-file-parse-error nxml-parse-file-name
(or position xmltok-start)
- (apply 'format args)))
+ (apply #'format-message args)))
(defun nxml-check-xmltok-errors ()
(when xmltok-errors
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 398c107cf01..5689b12c41e 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -1,9 +1,9 @@
;;; nxml-rap.el --- low-level support for random access parsing for nXML mode
-;; Copyright (C) 2003-2004, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2004, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -128,7 +128,7 @@ Return nil if the character at POS is not inside."
The change happened between START and END.
Return position after which lexical state is unchanged.
END must be > `nxml-prolog-end'. START must be outside
-any 'inside' regions and at the beginning of a token."
+any “inside” regions and at the beginning of a token."
(if (>= start nxml-scan-end)
nxml-scan-end
(let ((inside-remove-start start)
@@ -234,10 +234,10 @@ Sets variables like `nxml-token-after'."
xmltok-type))
(defun nxml-move-tag-backwards (bound)
- "Move point backwards outside any 'inside' regions or tags.
+ "Move point backwards outside any “inside” regions or tags.
Point will not move past `nxml-prolog-end'.
-Point will either be at BOUND or a '<' character starting a tag
-outside any 'inside' regions.
+Point will either be at BOUND or a `<' character starting a tag
+outside any “inside” regions.
As a precondition, point must be >= BOUND."
(nxml-move-outside-backwards)
(when (not (equal (char-after) ?<))
diff --git a/lisp/nxml/nxml-uchnm.el b/lisp/nxml/nxml-uchnm.el
index 07b05732d8b..1d92ab38791 100644
--- a/lisp/nxml/nxml-uchnm.el
+++ b/lisp/nxml/nxml-uchnm.el
@@ -1,9 +1,9 @@
;;; nxml-uchnm.el --- support for Unicode standard cha names in nxml-mode
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 75479160cbb..27b43824312 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -1,9 +1,9 @@
-;;; nxml-util.el --- utility functions for nxml-*.el
+;;; nxml-util.el --- utility functions for nxml-*.el -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -45,7 +45,7 @@
(defmacro nxml-debug-clear-inside (start end)
(when nxml-debug
- `(loop for overlay in (overlays-in ,start ,end)
+ `(cl-loop for overlay in (overlays-in ,start ,end)
if (overlay-get overlay 'nxml-inside-debug)
do (delete-overlay overlay)
finally (nxml-debug-change "nxml-clear-inside" ,start ,end))))
@@ -70,6 +70,7 @@ This is the inverse of `nxml-make-namespace'."
(nxml-make-namespace "http://www.w3.org/2000/xmlns/"))
(defmacro nxml-with-degradation-on-error (context &rest body)
+ (declare (indent 1) (debug t))
(if (not nxml-debug)
(let ((error-symbol (make-symbol "err")))
`(condition-case ,error-symbol
@@ -80,12 +81,10 @@ This is the inverse of `nxml-make-namespace'."
(defmacro nxml-with-invisible-motion (&rest body)
"Evaluate body without calling any point motion hooks."
+ (declare (indent 0) (debug t))
`(let ((inhibit-point-motion-hooks t))
,@body))
-(put 'nxml-with-invisible-motion 'lisp-indent-function 0)
-(def-edebug-spec nxml-with-invisible-motion t)
-
(defun nxml-display-file-parse-error (err)
(let* ((filename (nth 1 err))
(buffer (find-file-noselect filename))
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 6697195cebb..31864a4dfc3 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,9 +1,9 @@
;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
@@ -363,7 +363,7 @@ OVERRIDE is either nil, require or t."
"*")))
(defun rng-c-process-escapes ()
- ;; Check for any nuls, since we will use nul chars
+ ;; Check for any NULs, since we will use NUL chars
;; for internal purposes.
(let ((pos (search-forward "\C-@" nil t)))
(and pos
@@ -400,7 +400,7 @@ OVERRIDE is either nil, require or t."
(defun rng-c-error (&rest args)
(rng-c-signal-incorrect-schema rng-c-file-name
(rng-c-translate-position (point))
- (apply 'format args)))
+ (apply #'format-message args)))
(defun rng-c-parse-top-level (context)
(let ((rng-c-namespace-decls nil)
@@ -932,4 +932,3 @@ Current token after parse is token following ]."
(provide 'rng-cmpct)
;;; rng-cmpct.el
-
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index 1a55b5cf892..855bf93e8a9 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -1,9 +1,9 @@
;;; rng-dt.el --- datatype library interface for RELAX NG
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 63bf16516c2..601e54aeef5 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -1,9 +1,9 @@
;;; rng-loc.el --- locate the schema to use for validation
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index ff73e3718ec..be42e1029c1 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -1,9 +1,9 @@
;;; rng-maint.el --- commands for RELAX NG maintainers
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index 36bd23b3768..ef55e85f300 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -1,9 +1,9 @@
-;;; rng-match.el --- matching of RELAX NG patterns against XML events
+;;; rng-match.el --- matching of RELAX NG patterns against XML events -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
@@ -34,6 +34,7 @@
(require 'rng-pttrn)
(require 'rng-util)
(require 'rng-dt)
+(eval-when-compile (require 'cl-lib))
(defvar rng-not-allowed-ipattern nil)
(defvar rng-empty-ipattern nil)
@@ -63,38 +64,31 @@ Used to detect invalid recursive references.")
;;; Interned patterns
-(eval-when-compile
- (defun rng-ipattern-slot-accessor-name (slot-name)
- (intern (concat "rng-ipattern-get-"
- (symbol-name slot-name))))
-
- (defun rng-ipattern-slot-setter-name (slot-name)
- (intern (concat "rng-ipattern-set-"
- (symbol-name slot-name)))))
-
-(defmacro rng-ipattern-defslot (slot-name index)
- `(progn
- (defsubst ,(rng-ipattern-slot-accessor-name slot-name) (ipattern)
- (aref ipattern ,index))
- (defsubst ,(rng-ipattern-slot-setter-name slot-name) (ipattern value)
- (aset ipattern ,index value))))
-
-(rng-ipattern-defslot type 0)
-(rng-ipattern-defslot index 1)
-(rng-ipattern-defslot name-class 2)
-(rng-ipattern-defslot datatype 2)
-(rng-ipattern-defslot after 2)
-(rng-ipattern-defslot child 3)
-(rng-ipattern-defslot value-object 3)
-(rng-ipattern-defslot nullable 4)
-(rng-ipattern-defslot memo-text-typed 5)
-(rng-ipattern-defslot memo-map-start-tag-open-deriv 6)
-(rng-ipattern-defslot memo-map-start-attribute-deriv 7)
-(rng-ipattern-defslot memo-start-tag-close-deriv 8)
-(rng-ipattern-defslot memo-text-only-deriv 9)
-(rng-ipattern-defslot memo-mixed-text-deriv 10)
-(rng-ipattern-defslot memo-map-data-deriv 11)
-(rng-ipattern-defslot memo-end-tag-deriv 12)
+(cl-defstruct (rng--ipattern
+ (:constructor nil)
+ (:type vector)
+ (:copier nil)
+ (:constructor rng-make-ipattern
+ (type index name-class child nullable)))
+ type
+ index
+ name-class ;; Field also known as: `datatype' and `after'.
+ child ;; Field also known as: `value-object'.
+ nullable
+ (memo-text-typed 'unknown)
+ memo-map-start-tag-open-deriv
+ memo-map-start-attribute-deriv
+ memo-start-tag-close-deriv
+ memo-text-only-deriv
+ memo-mixed-text-deriv
+ memo-map-data-deriv
+ memo-end-tag-deriv)
+
+;; I think depending on the value of `type' the two fields after `index'
+;; are used sometimes for different purposes, hence the aliases here:
+(defalias 'rng--ipattern-datatype 'rng--ipattern-name-class)
+(defalias 'rng--ipattern-after 'rng--ipattern-name-class)
+(defalias 'rng--ipattern-value-object 'rng--ipattern-child)
(defconst rng-memo-map-alist-max 10)
@@ -142,25 +136,6 @@ therefore minimal overhead in successful lookups on small lists
(cons (cons key value)
(cdr mm))))))))
-(defsubst rng-make-ipattern (type index name-class child nullable)
- (vector type index name-class child nullable
- ;; 5 memo-text-typed
- 'unknown
- ;; 6 memo-map-start-tag-open-deriv
- nil
- ;; 7 memo-map-start-attribute-deriv
- nil
- ;; 8 memo-start-tag-close-deriv
- nil
- ;; 9 memo-text-only-deriv
- nil
- ;; 10 memo-mixed-text-deriv
- nil
- ;; 11 memo-map-data-deriv
- nil
- ;; 12 memo-end-tag-deriv
- nil))
-
(defun rng-ipattern-maybe-init ()
(unless rng-ipattern-table
(setq rng-ipattern-table (make-hash-table :test 'equal))
@@ -208,8 +183,8 @@ therefore minimal overhead in successful lookups on small lists
(if (eq child rng-not-allowed-ipattern)
rng-not-allowed-ipattern
(let ((key (list 'after
- (rng-ipattern-get-index child)
- (rng-ipattern-get-index after))))
+ (rng--ipattern-index child)
+ (rng--ipattern-index after))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'after
@@ -222,7 +197,7 @@ therefore minimal overhead in successful lookups on small lists
rng-not-allowed-ipattern
(let ((key (list 'attribute
name-class
- (rng-ipattern-get-index ipattern))))
+ (rng--ipattern-index ipattern))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'attribute
@@ -238,8 +213,8 @@ therefore minimal overhead in successful lookups on small lists
dt
nil
matches-anything)))
- (rng-ipattern-set-memo-text-typed ipattern
- (not matches-anything))
+ (setf (rng--ipattern-memo-text-typed ipattern)
+ (not matches-anything))
ipattern))))
(defun rng-intern-data-except (dt ipattern)
@@ -263,20 +238,20 @@ therefore minimal overhead in successful lookups on small lists
(defun rng-intern-one-or-more (ipattern)
(or (rng-intern-one-or-more-shortcut ipattern)
(let ((key (cons 'one-or-more
- (list (rng-ipattern-get-index ipattern)))))
+ (list (rng--ipattern-index ipattern)))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'one-or-more
nil
ipattern
- (rng-ipattern-get-nullable ipattern))))))
+ (rng--ipattern-nullable ipattern))))))
(defun rng-intern-one-or-more-shortcut (ipattern)
(cond ((eq ipattern rng-not-allowed-ipattern)
rng-not-allowed-ipattern)
((eq ipattern rng-empty-ipattern)
rng-empty-ipattern)
- ((eq (rng-ipattern-get-type ipattern) 'one-or-more)
+ ((eq (rng--ipattern-type ipattern) 'one-or-more)
ipattern)
(t nil)))
@@ -284,7 +259,7 @@ therefore minimal overhead in successful lookups on small lists
(if (eq ipattern rng-not-allowed-ipattern)
rng-not-allowed-ipattern
(let ((key (cons 'list
- (list (rng-ipattern-get-index ipattern)))))
+ (list (rng--ipattern-index ipattern)))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'list
@@ -299,7 +274,7 @@ therefore minimal overhead in successful lookups on small lists
(normalized (cdr tem)))
(or (rng-intern-group-shortcut normalized)
(let ((key (cons 'group
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'group
@@ -345,10 +320,10 @@ cdr is the normalized list."
(setq member (car ipatterns))
(setq ipatterns (cdr ipatterns))
(when nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'group)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'group)
(setq result
- (nconc (reverse (rng-ipattern-get-child member))
+ (nconc (reverse (rng--ipattern-child member))
result)))
((eq member rng-not-allowed-ipattern)
(setq result (list rng-not-allowed-ipattern))
@@ -363,7 +338,7 @@ cdr is the normalized list."
(normalized (cdr tem)))
(or (rng-intern-group-shortcut normalized)
(let ((key (cons 'interleave
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'interleave
@@ -383,10 +358,10 @@ cdr is the normalized list."
(setq member (car ipatterns))
(setq ipatterns (cdr ipatterns))
(when nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'interleave)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'interleave)
(setq result
- (append (rng-ipattern-get-child member)
+ (append (rng--ipattern-child member)
result)))
((eq member rng-not-allowed-ipattern)
(setq result (list rng-not-allowed-ipattern))
@@ -407,7 +382,7 @@ May alter IPATTERNS."
(rng-intern-choice1 normalized (car tem))))))
(defun rng-intern-optional (ipattern)
- (cond ((rng-ipattern-get-nullable ipattern) ipattern)
+ (cond ((rng--ipattern-nullable ipattern) ipattern)
((eq ipattern rng-not-allowed-ipattern) rng-empty-ipattern)
(t (rng-intern-choice1
;; This is sorted since the empty pattern
@@ -415,15 +390,15 @@ May alter IPATTERNS."
;; It cannot have a duplicate empty pattern,
;; since it is not nullable.
(cons rng-empty-ipattern
- (if (eq (rng-ipattern-get-type ipattern) 'choice)
- (rng-ipattern-get-child ipattern)
+ (if (eq (rng--ipattern-type ipattern) 'choice)
+ (rng--ipattern-child ipattern)
(list ipattern)))
t))))
(defun rng-intern-choice1 (normalized nullable)
(let ((key (cons 'choice
- (mapcar 'rng-ipattern-get-index normalized))))
+ (mapcar #'rng--ipattern-index normalized))))
(or (rng-get-ipattern key)
(rng-put-ipattern key
'choice
@@ -466,10 +441,10 @@ list is nullable and whose cdr is the normalized list."
(while cur
(setq member (car cur))
(or nullable
- (setq nullable (rng-ipattern-get-nullable member)))
- (cond ((eq (rng-ipattern-get-type member) 'choice)
+ (setq nullable (rng--ipattern-nullable member)))
+ (cond ((eq (rng--ipattern-type member) 'choice)
(setq final-tail
- (append (rng-ipattern-get-child member)
+ (append (rng--ipattern-child member)
final-tail))
(setq cur (cdr cur))
(setq sorted nil)
@@ -479,7 +454,7 @@ list is nullable and whose cdr is the normalized list."
(setcdr tail cur))
(t
(if (and sorted
- (let ((cur-index (rng-ipattern-get-index member)))
+ (let ((cur-index (rng--ipattern-index member)))
(if (>= prev-index cur-index)
(or (= prev-index cur-index) ; will remove it
(setq sorted nil)) ; won't remove it
@@ -501,8 +476,8 @@ list is nullable and whose cdr is the normalized list."
(rng-uniquify-eq (sort head 'rng-compare-ipattern))))))
(defun rng-compare-ipattern (p1 p2)
- (< (rng-ipattern-get-index p1)
- (rng-ipattern-get-index p2)))
+ (< (rng--ipattern-index p1)
+ (rng--ipattern-index p2)))
;;; Name classes
@@ -557,50 +532,50 @@ list may contain duplicates."
;;; Debugging utilities
(defun rng-ipattern-to-string (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(concat (rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
" </> "
(rng-ipattern-to-string
- (rng-ipattern-get-after ipattern))))
+ (rng--ipattern-after ipattern))))
((eq type 'element)
(concat "element "
(rng-name-class-to-string
- (rng-ipattern-get-name-class ipattern))
+ (rng--ipattern-name-class ipattern))
;; we can get cycles with elements so don't print it out
" {...}"))
((eq type 'attribute)
(concat "attribute "
(rng-name-class-to-string
- (rng-ipattern-get-name-class ipattern))
+ (rng--ipattern-name-class ipattern))
" { "
(rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
" } "))
((eq type 'empty) "empty")
((eq type 'text) "text")
((eq type 'not-allowed) "notAllowed")
((eq type 'one-or-more)
(concat (rng-ipattern-to-string
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
"+"))
((eq type 'choice)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
" | ")
")"))
((eq type 'group)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
", ")
")"))
((eq type 'interleave)
(concat "("
(mapconcat 'rng-ipattern-to-string
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
" & ")
")"))
(t (symbol-name type)))))
@@ -664,10 +639,10 @@ list may contain duplicates."
nil))
(defun rng-element-get-child (element)
- (let ((tem (rng-ipattern-get-child element)))
+ (let ((tem (rng--ipattern-child element)))
(if (vectorp tem)
tem
- (rng-ipattern-set-child element (rng-compile tem)))))
+ (setf (rng--ipattern-child element) (rng-compile tem)))))
(defun rng-compile-attribute (name-class pattern)
(rng-intern-attribute (rng-compile-name-class name-class)
@@ -839,17 +814,16 @@ list may contain duplicates."
;;; Derivatives
(defun rng-ipattern-text-typed-p (ipattern)
- (let ((memo (rng-ipattern-get-memo-text-typed ipattern)))
+ (let ((memo (rng--ipattern-memo-text-typed ipattern)))
(if (eq memo 'unknown)
- (rng-ipattern-set-memo-text-typed
- ipattern
- (rng-ipattern-compute-text-typed-p ipattern))
+ (setf (rng--ipattern-memo-text-typed ipattern)
+ (rng-ipattern-compute-text-typed-p ipattern))
memo)))
(defun rng-ipattern-compute-text-typed-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (let ((cur (rng-ipattern-get-child ipattern))
+ (let ((cur (rng--ipattern-child ipattern))
(ret nil))
(while (and cur (not ret))
(if (rng-ipattern-text-typed-p (car cur))
@@ -857,7 +831,7 @@ list may contain duplicates."
(setq cur (cdr cur))))
ret))
((eq type 'group)
- (let ((cur (rng-ipattern-get-child ipattern))
+ (let ((cur (rng--ipattern-child ipattern))
(ret nil)
member)
(while (and cur (not ret))
@@ -865,17 +839,17 @@ list may contain duplicates."
(if (rng-ipattern-text-typed-p member)
(setq ret t))
(setq cur
- (and (rng-ipattern-get-nullable member)
+ (and (rng--ipattern-nullable member)
(cdr cur))))
ret))
((eq type 'after)
- (rng-ipattern-text-typed-p (rng-ipattern-get-child ipattern)))
+ (rng-ipattern-text-typed-p (rng--ipattern-child ipattern)))
(t (and (memq type '(value list data data-except)) t)))))
(defun rng-start-tag-open-deriv (ipattern nm)
(or (rng-memo-map-get
nm
- (rng-ipattern-get-memo-map-start-tag-open-deriv ipattern))
+ (rng--ipattern-memo-map-start-tag-open-deriv ipattern))
(rng-ipattern-memo-start-tag-open-deriv
ipattern
nm
@@ -883,56 +857,54 @@ list may contain duplicates."
(defun rng-ipattern-memo-start-tag-open-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
- (rng-ipattern-set-memo-map-start-tag-open-deriv
- ipattern
- (rng-memo-map-add nm
- deriv
- (rng-ipattern-get-memo-map-start-tag-open-deriv
- ipattern))))
+ (setf (rng--ipattern-memo-map-start-tag-open-deriv ipattern)
+ (rng-memo-map-add nm
+ deriv
+ (rng--ipattern-memo-map-start-tag-open-deriv
+ ipattern))))
deriv)
(defun rng-compute-start-tag-open-deriv (ipattern nm)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (rng-transform-choice `(lambda (p)
- (rng-start-tag-open-deriv p ',nm))
+ (rng-transform-choice (lambda (p)
+ (rng-start-tag-open-deriv p nm))
ipattern))
((eq type 'element)
(if (rng-name-class-contains
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
nm)
(rng-intern-after (rng-element-get-child ipattern)
rng-empty-ipattern)
rng-not-allowed-ipattern))
((eq type 'group)
(rng-transform-group-nullable
- `(lambda (p) (rng-start-tag-open-deriv p ',nm))
+ (lambda (p) (rng-start-tag-open-deriv p nm))
'rng-cons-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-tag-open-deriv p ',nm))
+ (lambda (p) (rng-start-tag-open-deriv p nm))
'rng-subst-interleave-after
ipattern))
((eq type 'one-or-more)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-group (list p ,(rng-intern-optional ipattern))))
- (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((ip (rng-intern-optional ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-group (list p ip)))
+ (rng-start-tag-open-deriv (rng--ipattern-child ipattern)
+ nm))))
((eq type 'after)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-after p
- ,(rng-ipattern-get-after ipattern)))
- (rng-start-tag-open-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((nip (rng--ipattern-after ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-after p nip))
+ (rng-start-tag-open-deriv (rng--ipattern-child ipattern)
+ nm))))
(t rng-not-allowed-ipattern))))
(defun rng-start-attribute-deriv (ipattern nm)
(or (rng-memo-map-get
nm
- (rng-ipattern-get-memo-map-start-attribute-deriv ipattern))
+ (rng--ipattern-memo-map-start-attribute-deriv ipattern))
(rng-ipattern-memo-start-attribute-deriv
ipattern
nm
@@ -940,82 +912,79 @@ list may contain duplicates."
(defun rng-ipattern-memo-start-attribute-deriv (ipattern nm deriv)
(or (memq ipattern rng-const-ipatterns)
- (rng-ipattern-set-memo-map-start-attribute-deriv
- ipattern
- (rng-memo-map-add
- nm
- deriv
- (rng-ipattern-get-memo-map-start-attribute-deriv ipattern))))
+ (setf (rng--ipattern-memo-map-start-attribute-deriv ipattern)
+ (rng-memo-map-add
+ nm
+ deriv
+ (rng--ipattern-memo-map-start-attribute-deriv ipattern))))
deriv)
(defun rng-compute-start-attribute-deriv (ipattern nm)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
- (rng-transform-choice `(lambda (p)
- (rng-start-attribute-deriv p ',nm))
+ (rng-transform-choice (lambda (p)
+ (rng-start-attribute-deriv p nm))
ipattern))
((eq type 'attribute)
(if (rng-name-class-contains
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
nm)
- (rng-intern-after (rng-ipattern-get-child ipattern)
+ (rng-intern-after (rng--ipattern-child ipattern)
rng-empty-ipattern)
rng-not-allowed-ipattern))
((eq type 'group)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-attribute-deriv p ',nm))
+ (lambda (p) (rng-start-attribute-deriv p nm))
'rng-subst-group-after
ipattern))
((eq type 'interleave)
(rng-transform-interleave-single
- `(lambda (p) (rng-start-attribute-deriv p ',nm))
+ (lambda (p) (rng-start-attribute-deriv p nm))
'rng-subst-interleave-after
ipattern))
((eq type 'one-or-more)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-group (list p ,(rng-intern-optional ipattern))))
- (rng-start-attribute-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((ip (rng-intern-optional ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-group (list p ip)))
+ (rng-start-attribute-deriv (rng--ipattern-child ipattern)
+ nm))))
((eq type 'after)
- (rng-apply-after
- `(lambda (p)
- (rng-intern-after p ,(rng-ipattern-get-after ipattern)))
- (rng-start-attribute-deriv (rng-ipattern-get-child ipattern)
- nm)))
+ (let ((nip (rng--ipattern-after ipattern)))
+ (rng-apply-after
+ (lambda (p) (rng-intern-after p nip))
+ (rng-start-attribute-deriv (rng--ipattern-child ipattern)
+ nm))))
(t rng-not-allowed-ipattern))))
(defun rng-cons-group-after (x y)
- (rng-apply-after `(lambda (p) (rng-intern-group (cons p ',y)))
+ (rng-apply-after (lambda (p) (rng-intern-group (cons p y)))
x))
(defun rng-subst-group-after (new old list)
- (rng-apply-after `(lambda (p)
- (rng-intern-group (rng-substq p ,old ',list)))
+ (rng-apply-after (lambda (p)
+ (rng-intern-group (rng-substq p old list)))
new))
(defun rng-subst-interleave-after (new old list)
- (rng-apply-after `(lambda (p)
- (rng-intern-interleave (rng-substq p ,old ',list)))
+ (rng-apply-after (lambda (p)
+ (rng-intern-interleave (rng-substq p old list)))
new))
(defun rng-apply-after (f ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(rng-intern-after
- (rng-ipattern-get-child ipattern)
- (funcall f
- (rng-ipattern-get-after ipattern))))
+ (rng--ipattern-child ipattern)
+ (funcall f (rng--ipattern-after ipattern))))
((eq type 'choice)
- (rng-transform-choice `(lambda (x) (rng-apply-after ,f x))
+ (rng-transform-choice (lambda (x) (rng-apply-after f x))
ipattern))
(t rng-not-allowed-ipattern))))
(defun rng-start-tag-close-deriv (ipattern)
- (or (rng-ipattern-get-memo-start-tag-close-deriv ipattern)
- (rng-ipattern-set-memo-start-tag-close-deriv
- ipattern
- (rng-compute-start-tag-close-deriv ipattern))))
+ (or (rng--ipattern-memo-start-tag-close-deriv ipattern)
+ (setf (rng--ipattern-memo-start-tag-close-deriv ipattern)
+ (rng-compute-start-tag-close-deriv ipattern))))
(defconst rng-transform-map
'((choice . rng-transform-choice)
@@ -1025,7 +994,7 @@ list may contain duplicates."
(after . rng-transform-after-child)))
(defun rng-compute-start-tag-close-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'attribute)
rng-not-allowed-ipattern
(let ((transform (assq type rng-transform-map)))
@@ -1036,7 +1005,7 @@ list may contain duplicates."
ipattern)))))
(defun rng-ignore-attributes-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'attribute)
rng-empty-ipattern
(let ((transform (assq type rng-transform-map)))
@@ -1047,13 +1016,12 @@ list may contain duplicates."
ipattern)))))
(defun rng-text-only-deriv (ipattern)
- (or (rng-ipattern-get-memo-text-only-deriv ipattern)
- (rng-ipattern-set-memo-text-only-deriv
- ipattern
- (rng-compute-text-only-deriv ipattern))))
+ (or (rng--ipattern-memo-text-only-deriv ipattern)
+ (setf (rng--ipattern-memo-text-only-deriv ipattern)
+ (rng-compute-text-only-deriv ipattern))))
(defun rng-compute-text-only-deriv (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern)))
+ (let* ((type (rng--ipattern-type ipattern)))
(if (eq type 'element)
rng-not-allowed-ipattern
(let ((transform (assq type
@@ -1069,13 +1037,12 @@ list may contain duplicates."
ipattern)))))
(defun rng-mixed-text-deriv (ipattern)
- (or (rng-ipattern-get-memo-mixed-text-deriv ipattern)
- (rng-ipattern-set-memo-mixed-text-deriv
- ipattern
- (rng-compute-mixed-text-deriv ipattern))))
+ (or (rng--ipattern-memo-mixed-text-deriv ipattern)
+ (setf (rng--ipattern-memo-mixed-text-deriv ipattern)
+ (rng-compute-mixed-text-deriv ipattern))))
(defun rng-compute-mixed-text-deriv (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'text) ipattern)
((eq type 'after)
(rng-transform-after-child 'rng-mixed-text-deriv
@@ -1086,7 +1053,7 @@ list may contain duplicates."
((eq type 'one-or-more)
(rng-intern-group
(list (rng-mixed-text-deriv
- (rng-ipattern-get-child ipattern))
+ (rng--ipattern-child ipattern))
(rng-intern-optional ipattern))))
((eq type 'group)
(rng-transform-group-nullable
@@ -1100,39 +1067,38 @@ list may contain duplicates."
(rng-substq new old list)))
ipattern))
((and (eq type 'data)
- (not (rng-ipattern-get-memo-text-typed ipattern)))
+ (not (rng--ipattern-memo-text-typed ipattern)))
ipattern)
(t rng-not-allowed-ipattern))))
(defun rng-end-tag-deriv (ipattern)
- (or (rng-ipattern-get-memo-end-tag-deriv ipattern)
- (rng-ipattern-set-memo-end-tag-deriv
- ipattern
- (rng-compute-end-tag-deriv ipattern))))
+ (or (rng--ipattern-memo-end-tag-deriv ipattern)
+ (setf (rng--ipattern-memo-end-tag-deriv ipattern)
+ (rng-compute-end-tag-deriv ipattern))))
(defun rng-compute-end-tag-deriv (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
(rng-intern-choice
(mapcar 'rng-end-tag-deriv
- (rng-ipattern-get-child ipattern))))
+ (rng--ipattern-child ipattern))))
((eq type 'after)
- (if (rng-ipattern-get-nullable
- (rng-ipattern-get-child ipattern))
- (rng-ipattern-get-after ipattern)
+ (if (rng--ipattern-nullable
+ (rng--ipattern-child ipattern))
+ (rng--ipattern-after ipattern)
rng-not-allowed-ipattern))
(t rng-not-allowed-ipattern))))
(defun rng-data-deriv (ipattern value)
(or (rng-memo-map-get value
- (rng-ipattern-get-memo-map-data-deriv ipattern))
+ (rng--ipattern-memo-map-data-deriv ipattern))
(and (rng-memo-map-get
(cons value (rng-namespace-context-get-no-trace))
- (rng-ipattern-get-memo-map-data-deriv ipattern))
+ (rng--ipattern-memo-map-data-deriv ipattern))
(rng-memo-map-get
(cons value (apply (car rng-dt-namespace-context-getter)
(cdr rng-dt-namespace-context-getter)))
- (rng-ipattern-get-memo-map-data-deriv ipattern)))
+ (rng--ipattern-memo-map-data-deriv ipattern)))
(let* ((used-context (vector nil))
(rng-dt-namespace-context-getter
(cons 'rng-namespace-context-tracer
@@ -1161,66 +1127,65 @@ list may contain duplicates."
(defun rng-ipattern-memo-data-deriv (ipattern value context deriv)
(or (memq ipattern rng-const-ipatterns)
(> (length value) rng-memo-data-deriv-max-length)
- (rng-ipattern-set-memo-map-data-deriv
- ipattern
- (rng-memo-map-add (if context (cons value context) value)
- deriv
- (rng-ipattern-get-memo-map-data-deriv ipattern)
- t)))
+ (setf (rng--ipattern-memo-map-data-deriv ipattern)
+ (rng-memo-map-add (if context (cons value context) value)
+ deriv
+ (rng--ipattern-memo-map-data-deriv ipattern)
+ t)))
deriv)
(defun rng-compute-data-deriv (ipattern value)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'text) ipattern)
((eq type 'choice)
- (rng-transform-choice `(lambda (p) (rng-data-deriv p ,value))
+ (rng-transform-choice (lambda (p) (rng-data-deriv p value))
ipattern))
((eq type 'group)
(rng-transform-group-nullable
- `(lambda (p) (rng-data-deriv p ,value))
+ (lambda (p) (rng-data-deriv p value))
(lambda (x y) (rng-intern-group (cons x y)))
ipattern))
((eq type 'one-or-more)
(rng-intern-group (list (rng-data-deriv
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
value)
(rng-intern-optional ipattern))))
((eq type 'after)
- (let ((child (rng-ipattern-get-child ipattern)))
- (if (or (rng-ipattern-get-nullable
+ (let ((child (rng--ipattern-child ipattern)))
+ (if (or (rng--ipattern-nullable
(rng-data-deriv child value))
- (and (rng-ipattern-get-nullable child)
+ (and (rng--ipattern-nullable child)
(rng-blank-p value)))
- (rng-ipattern-get-after ipattern)
+ (rng--ipattern-after ipattern)
rng-not-allowed-ipattern)))
((eq type 'data)
- (if (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'data-except)
- (if (and (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (and (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
- (not (rng-ipattern-get-nullable
+ (not (rng--ipattern-nullable
(rng-data-deriv
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
value))))
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'value)
- (if (equal (rng-dt-make-value (rng-ipattern-get-datatype ipattern)
+ (if (equal (rng-dt-make-value (rng--ipattern-datatype ipattern)
value)
- (rng-ipattern-get-value-object ipattern))
+ (rng--ipattern-value-object ipattern))
rng-empty-ipattern
rng-not-allowed-ipattern))
((eq type 'list)
(let ((tokens (split-string value))
- (state (rng-ipattern-get-child ipattern)))
+ (state (rng--ipattern-child ipattern)))
(while (and tokens
(not (eq state rng-not-allowed-ipattern)))
(setq state (rng-data-deriv state (car tokens)))
(setq tokens (cdr tokens)))
- (if (rng-ipattern-get-nullable state)
+ (if (rng--ipattern-nullable state)
rng-empty-ipattern
rng-not-allowed-ipattern)))
;; don't think interleave can occur
@@ -1228,7 +1193,7 @@ list may contain duplicates."
(t rng-not-allowed-ipattern))))
(defun rng-transform-multi (f ipattern interner)
- (let* ((members (rng-ipattern-get-child ipattern))
+ (let* ((members (rng--ipattern-child ipattern))
(transformed (mapcar f members)))
(if (rng-members-eq members transformed)
ipattern
@@ -1244,22 +1209,22 @@ list may contain duplicates."
(rng-transform-multi f ipattern 'rng-intern-interleave))
(defun rng-transform-one-or-more (f ipattern)
- (let* ((child (rng-ipattern-get-child ipattern))
+ (let* ((child (rng--ipattern-child ipattern))
(transformed (funcall f child)))
(if (eq child transformed)
ipattern
(rng-intern-one-or-more transformed))))
(defun rng-transform-after-child (f ipattern)
- (let* ((child (rng-ipattern-get-child ipattern))
+ (let* ((child (rng--ipattern-child ipattern))
(transformed (funcall f child)))
(if (eq child transformed)
ipattern
(rng-intern-after transformed
- (rng-ipattern-get-after ipattern)))))
+ (rng--ipattern-after ipattern)))))
(defun rng-transform-interleave-single (f subster ipattern)
- (let ((children (rng-ipattern-get-child ipattern))
+ (let ((children (rng--ipattern-child ipattern))
found)
(while (and children (not found))
(let* ((child (car children))
@@ -1270,7 +1235,7 @@ list may contain duplicates."
(funcall subster
transformed
child
- (rng-ipattern-get-child ipattern))))))
+ (rng--ipattern-child ipattern))))))
(or found
rng-not-allowed-ipattern)))
@@ -1286,14 +1251,14 @@ nullable and y1 isn't, return a choice
(rng-transform-group-nullable-gen-choices
f
conser
- (rng-ipattern-get-child ipattern))))
+ (rng--ipattern-child ipattern))))
(defun rng-transform-group-nullable-gen-choices (f conser members)
(let ((head (car members))
(tail (cdr members)))
(if tail
(cons (funcall conser (funcall f head) tail)
- (if (rng-ipattern-get-nullable head)
+ (if (rng--ipattern-nullable head)
(rng-transform-group-nullable-gen-choices f conser tail)
nil))
(list (funcall f head)))))
@@ -1308,11 +1273,11 @@ nullable and y1 isn't, return a choice
(defun rng-ipattern-after (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'choice)
(rng-transform-choice 'rng-ipattern-after ipattern))
((eq type 'after)
- (rng-ipattern-get-after ipattern))
+ (rng--ipattern-after ipattern))
((eq type 'not-allowed)
ipattern)
(t (error "Internal error in rng-ipattern-after: unexpected type %s" type)))))
@@ -1321,7 +1286,7 @@ nullable and y1 isn't, return a choice
(rng-intern-after (rng-compile rng-any-content) ipattern))
(defun rng-ipattern-optionalize-elements (ipattern)
- (let* ((type (rng-ipattern-get-type ipattern))
+ (let* ((type (rng--ipattern-type ipattern))
(transform (assq type rng-transform-map)))
(cond (transform
(funcall (cdr transform)
@@ -1332,11 +1297,11 @@ nullable and y1 isn't, return a choice
(t ipattern))))
(defun rng-ipattern-empty-before-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (eq (rng-ipattern-get-child ipattern) rng-empty-ipattern))
+ (eq (rng--ipattern-child ipattern) rng-empty-ipattern))
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(ret t))
(while (and members ret)
(or (rng-ipattern-empty-before-p (car members))
@@ -1346,13 +1311,13 @@ nullable and y1 isn't, return a choice
(t nil))))
(defun rng-ipattern-possible-start-tags (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
(rng-ipattern-possible-start-tags
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
((memq type '(choice interleave))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-start-tags (car members)
@@ -1360,34 +1325,34 @@ nullable and y1 isn't, return a choice
(setq members (cdr members))))
accum)
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-start-tags (car members)
accum))
(setq members
- (and (rng-ipattern-get-nullable (car members))
+ (and (rng--ipattern-nullable (car members))
(cdr members)))))
accum)
((eq type 'element)
(if (eq (rng-element-get-child ipattern) rng-not-allowed-ipattern)
accum
(rng-name-class-possible-names
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
accum)))
((eq type 'one-or-more)
(rng-ipattern-possible-start-tags
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
(t accum))))
(defun rng-ipattern-start-tag-possible-p (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((memq type '(after one-or-more))
(rng-ipattern-start-tag-possible-p
- (rng-ipattern-get-child ipattern)))
+ (rng--ipattern-child ipattern)))
((memq type '(choice interleave))
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(possible nil))
(while (and members (not possible))
(setq possible
@@ -1395,13 +1360,13 @@ nullable and y1 isn't, return a choice
(setq members (cdr members)))
possible))
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
(possible nil))
(while (and members (not possible))
(setq possible
(rng-ipattern-start-tag-possible-p (car members)))
(setq members
- (and (rng-ipattern-get-nullable (car members))
+ (and (rng--ipattern-nullable (car members))
(cdr members))))
possible))
((eq type 'element)
@@ -1410,12 +1375,12 @@ nullable and y1 isn't, return a choice
(t nil))))
(defun rng-ipattern-possible-attributes (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-possible-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-possible-attributes (rng--ipattern-child ipattern)
accum))
((memq type '(choice interleave group))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-attributes (car members)
@@ -1424,21 +1389,21 @@ nullable and y1 isn't, return a choice
accum)
((eq type 'attribute)
(rng-name-class-possible-names
- (rng-ipattern-get-name-class ipattern)
+ (rng--ipattern-name-class ipattern)
accum))
((eq type 'one-or-more)
(rng-ipattern-possible-attributes
- (rng-ipattern-get-child ipattern)
+ (rng--ipattern-child ipattern)
accum))
(t accum))))
(defun rng-ipattern-possible-values (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-possible-values (rng-ipattern-get-child ipattern)
+ (rng-ipattern-possible-values (rng--ipattern-child ipattern)
accum))
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-possible-values (car members)
@@ -1446,18 +1411,18 @@ nullable and y1 isn't, return a choice
(setq members (cdr members))))
accum)
((eq type 'value)
- (let ((value-object (rng-ipattern-get-value-object ipattern)))
+ (let ((value-object (rng--ipattern-value-object ipattern)))
(if (stringp value-object)
(cons value-object accum)
accum)))
(t accum))))
(defun rng-ipattern-required-element (ipattern)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((memq type '(after one-or-more))
- (rng-ipattern-required-element (rng-ipattern-get-child ipattern)))
+ (rng-ipattern-required-element (rng--ipattern-child ipattern)))
((eq type 'choice)
- (let* ((members (rng-ipattern-get-child ipattern))
+ (let* ((members (rng--ipattern-child ipattern))
(required (rng-ipattern-required-element (car members))))
(while (and required
(setq members (cdr members)))
@@ -1466,16 +1431,16 @@ nullable and y1 isn't, return a choice
(setq required nil)))
required))
((eq type 'group)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
required)
(while (and (not (setq required
(rng-ipattern-required-element
(car members))))
- (rng-ipattern-get-nullable (car members))
+ (rng--ipattern-nullable (car members))
(setq members (cdr members))))
required))
((eq type 'interleave)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
required)
(while members
(let ((tem (rng-ipattern-required-element (car members))))
@@ -1491,19 +1456,19 @@ nullable and y1 isn't, return a choice
(setq members nil)))))
required))
((eq type 'element)
- (let ((nc (rng-ipattern-get-name-class ipattern)))
+ (let ((nc (rng--ipattern-name-class ipattern)))
(and (consp nc)
(not (eq (rng-element-get-child ipattern)
rng-not-allowed-ipattern))
nc))))))
(defun rng-ipattern-required-attributes (ipattern accum)
- (let ((type (rng-ipattern-get-type ipattern)))
+ (let ((type (rng--ipattern-type ipattern)))
(cond ((eq type 'after)
- (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-required-attributes (rng--ipattern-child ipattern)
accum))
((memq type '(interleave group))
- (let ((members (rng-ipattern-get-child ipattern)))
+ (let ((members (rng--ipattern-child ipattern)))
(while members
(setq accum
(rng-ipattern-required-attributes (car members)
@@ -1511,7 +1476,7 @@ nullable and y1 isn't, return a choice
(setq members (cdr members))))
accum)
((eq type 'choice)
- (let ((members (rng-ipattern-get-child ipattern))
+ (let ((members (rng--ipattern-child ipattern))
in-all in-this new-in-all)
(setq in-all
(rng-ipattern-required-attributes (car members)
@@ -1528,18 +1493,18 @@ nullable and y1 isn't, return a choice
(setq in-all new-in-all))
(append in-all accum)))
((eq type 'attribute)
- (let ((nc (rng-ipattern-get-name-class ipattern)))
+ (let ((nc (rng--ipattern-name-class ipattern)))
(if (consp nc)
(cons nc accum)
accum)))
((eq type 'one-or-more)
- (rng-ipattern-required-attributes (rng-ipattern-get-child ipattern)
+ (rng-ipattern-required-attributes (rng--ipattern-child ipattern)
accum))
(t accum))))
(defun rng-compile-error (&rest args)
(signal 'rng-compile-error
- (list (apply 'format args))))
+ (list (apply #'format-message args))))
(define-error 'rng-compile-error "Incorrect schema" 'rng-error)
@@ -1667,7 +1632,7 @@ for an end-tag is equivalent to empty."
ns))
(defun rng-match-nullable-p ()
- (rng-ipattern-get-nullable rng-match-state))
+ (rng--ipattern-nullable rng-match-state))
(defun rng-match-possible-start-tag-names ()
"Return a list of possible names that would be valid for start-tags.
@@ -1704,16 +1669,15 @@ be exhaustive."
(rng-ipattern-required-attributes rng-match-state nil))
(defmacro rng-match-save (&rest body)
+ (declare (indent 0) (debug t))
(let ((state (make-symbol "state")))
`(let ((,state rng-match-state))
(unwind-protect
(progn ,@body)
(setq rng-match-state ,state)))))
-(put 'rng-match-save 'lisp-indent-function 0)
-(def-edebug-spec rng-match-save t)
-
(defmacro rng-match-with-schema (schema &rest body)
+ (declare (indent 1) (debug t))
`(let ((rng-current-schema ,schema)
rng-match-state
rng-compile-table
@@ -1724,9 +1688,6 @@ be exhaustive."
(setq rng-match-state (rng-compile rng-current-schema))
,@body))
-(put 'rng-match-with-schema 'lisp-indent-function 1)
-(def-edebug-spec rng-match-with-schema t)
-
(provide 'rng-match)
;;; rng-match.el ends here
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index bc070136adb..30ae462d851 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -1,9 +1,9 @@
;;; rng-nxml.el --- make nxml-mode take advantage of rng-validate-mode
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index ab630fb8c79..30878b4aac4 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -1,9 +1,9 @@
;;; rng-parse.el --- parse an XML file and validate it against a schema
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index e3577097a50..3324dc40617 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -1,9 +1,9 @@
;;; rng-pttrn.el --- RELAX NG patterns
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 8c0d409d520..98b43848f01 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -1,9 +1,9 @@
;;; rng-uri.el --- URI parsing and manipulation
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -85,7 +85,7 @@ Signal an error if URI is not a valid file URL."
((not (string= (downcase scheme) "file"))
(rng-uri-error "URI `%s' does not use the `file:' scheme" uri)))
(when (not (member authority
- (cons system-name '(nil "" "localhost"))))
+ (cons (system-name) '(nil "" "localhost"))))
(rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'"
uri))
(when query
@@ -125,7 +125,7 @@ Signal an error if URI is not a valid file URL."
(t path))))
(defun rng-uri-error (&rest args)
- (signal 'rng-uri-error (list (apply 'format args))))
+ (signal 'rng-uri-error (list (apply #'format-message args))))
(define-error 'rng-uri-error "Invalid URI")
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index 7af6ae231c5..cde41248bee 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -1,9 +1,9 @@
;;; rng-util.el --- utility functions for RELAX NG library
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index fb8bd037bdc..61a96545a82 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -1,9 +1,9 @@
;;; rng-valid.el --- real-time validation of XML using RELAX NG
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
@@ -345,17 +345,11 @@ The schema is set like `rng-auto-set-schema'."
(defun rng-compute-mode-line-string ()
(cond (rng-validate-timer
- (concat " Validated:"
- (number-to-string
- ;; Use floor rather than round because we want
- ;; to show 99% rather than 100% for changes near
- ;; the end.
- (floor (if (eq (buffer-size) 0)
- 0.0
- (/ (* (- rng-validate-up-to-date-end (point-min))
- 100.0)
- (- (point-max) (point-min))))))
- "%%"))
+ (format " Validated:%d%%"
+ (if (= 0 (buffer-size))
+ 0
+ (floor (- rng-validate-up-to-date-end (point-min))
+ (- (point-max) (point-min))))))
((> rng-error-count 0)
(concat " "
(propertize "Invalid"
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 02a0383c140..9b585c0b7b8 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -1,9 +1,9 @@
;;; rng-xsd.el --- W3C XML Schema datatypes library for RELAX NG
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, RelaxNG
+;; Keywords: wp, hypermedia, languages, XML, RelaxNG
;; This file is part of GNU Emacs.
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 9bfcd21618d..fe6a6050be9 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -1,9 +1,9 @@
-;;; xmltok.el --- XML tokenization
+;;; xmltok.el --- XML tokenization -*- lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML
+;; Keywords: wp, hypermedia, languages, XML
;; This file is part of GNU Emacs.
@@ -142,6 +142,7 @@ string giving the error message and START and END are integers
indicating the position of the error.")
(defmacro xmltok-save (&rest body)
+ (declare (indent 0) (debug t))
`(let (xmltok-type
xmltok-start
xmltok-name-colon
@@ -152,9 +153,6 @@ indicating the position of the error.")
xmltok-errors)
,@body))
-(put 'xmltok-save 'lisp-indent-function 0)
-(def-edebug-spec xmltok-save t)
-
(defsubst xmltok-attribute-name-start (att)
(aref att 0))
@@ -411,7 +409,6 @@ Return the type of the token."
(eval-when-compile
(let* ((or "\\|")
(open "\\(?:")
- (gopen "\\(")
(close "\\)")
(name-start-char "[_[:alpha:]]")
(name-continue-not-start-char "[-.[:digit:]]")
@@ -753,7 +750,8 @@ Return the type of the token."
;; Need do this after the goto-char because
;; marked error should just apply to <!--
(xmltok-add-error "First following `--' not followed by `>'")
- 'not-well-formed)))))
+ (goto-char (point-max))
+ 'comment)))))
(defun xmltok-scan-attributes ()
(let ((recovering nil)
@@ -988,33 +986,6 @@ Return the type of the token."
(xmltok-valid-char-p n)
n)))
-(defun xmltok-unclosed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter)
- (let ((len-1 (1- (length delimiter))))
- (goto-char (max start (- change-start len-1)))
- (search-forward delimiter (min end (+ change-end len-1)) t)))
-
-;; Handles a <!-- with the next -- not followed by >
-
-(defun xmltok-semi-closed-reparse-p (change-start
- change-end
- pre-change-length
- start
- end
- delimiter
- delimiter-length)
- (or (<= (- end delimiter-length) change-end)
- (xmltok-unclosed-reparse-p change-start
- change-end
- pre-change-length
- start
- end
- delimiter)))
-
(defun xmltok-valid-char-p (n)
"Return non-nil if N is the Unicode code of a valid XML character."
(cond ((< n #x20) (memq n '(#xA #xD #x9)))
@@ -1072,7 +1043,7 @@ Adds to `xmltok-errors' as appropriate."
(setq xmltok-dtd xmltok-predefined-entity-alist)
(xmltok-scan-xml-declaration)
(xmltok-next-prolog-token)
- (while (condition-case err
+ (while (condition-case nil
(when (xmltok-parse-prolog-item)
(xmltok-next-prolog-token))
(xmltok-markup-declaration-parse-error
@@ -1371,7 +1342,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
(t
(let ((xmltok-start (1- (point)))
xmltok-type xmltok-replacement)
- (xmltok-scan-after-amp (lambda (start end)))
+ (xmltok-scan-after-amp (lambda (_start _end)))
(cond ((eq xmltok-type 'char-ref)
(setq value-parts
(cons (buffer-substring-no-properties
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index 8c0b26cdab9..7b1e6165583 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -1,9 +1,9 @@
;;; xsd-regexp.el --- translate W3C XML Schema regexps to Emacs regexps
-;; Copyright (C) 2003, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2007-2015 Free Software Foundation, Inc.
;; Author: James Clark
-;; Keywords: XML, regexp
+;; Keywords: wp, hypermedia, languages, XML, regexp
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/.gitignore b/lisp/obsolete/.gitignore
deleted file mode 100644
index e69de29bb2d..00000000000
--- a/lisp/obsolete/.gitignore
+++ /dev/null
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
index 763eceb1f03..65fc3700e79 100644
--- a/lisp/obsolete/abbrevlist.el
+++ b/lisp/obsolete/abbrevlist.el
@@ -1,9 +1,9 @@
;;; abbrevlist.el --- list one abbrev table alphabetically ordered
-;; Copyright (C) 1986, 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992, 2001-2015 Free Software Foundation, Inc.
;; Suggested by a previous version by Gildea.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: abbrev
;; Package: emacs
;; Obsolete-since: 24.1
diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el
index 9d8ffed4c9c..cbf4c819c5e 100644
--- a/lisp/obsolete/assoc.el
+++ b/lisp/obsolete/assoc.el
@@ -1,6 +1,6 @@
;;; assoc.el --- insert/delete functions on association lists -*- lexical-binding: t -*-
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Keywords: extensions
@@ -102,14 +102,14 @@ returned.
If no key-value pair matching KEY could be found in ALIST, or ALIST is
nil then nil is returned. ALIST is not altered."
- (defvar copy)
- (let ((copy (copy-alist alist)))
+ (defvar assoc--copy)
+ (let ((assoc--copy (copy-alist alist)))
(cond ((null alist) nil)
- ((progn (asort 'copy key)
- (anot-head-p copy key)) nil)
- ((cdr (car copy)))
+ ((progn (asort 'assoc--copy key) ; dynamic binding
+ (anot-head-p assoc--copy key)) nil)
+ ((cdr (car assoc--copy)))
(keynil-p nil)
- ((car (car copy)))
+ ((car (car assoc--copy)))
(t nil))))
diff --git a/lisp/obsolete/awk-mode.el b/lisp/obsolete/awk-mode.el
index 18f7f848926..10cd552fa83 100644
--- a/lisp/obsolete/awk-mode.el
+++ b/lisp/obsolete/awk-mode.el
@@ -1,9 +1,9 @@
;;; awk-mode.el --- AWK code editing commands for Emacs
-;; Copyright (C) 1988, 1994, 1996, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1996, 2000-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, languages
;; Obsolete-since: 22.1
diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el
index afef8c8d6e5..54b92b64f9c 100644
--- a/lisp/obsolete/bruce.el
+++ b/lisp/obsolete/bruce.el
@@ -1,10 +1,10 @@
-;;; bruce.el --- bruce phrase utility for overloading the Communications -*- no-byte-compile: t -*-
+;;; bruce.el --- bruce phrase utility for overloading the Communications
;;; Decency Act snoops, if any.
-;; Copyright (C) 1988, 1993, 1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1993, 1997, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; Created: Jan 1997
;; Obsolete-since: 24.3
diff --git a/lisp/progmodes/cc-compat.el b/lisp/obsolete/cc-compat.el
index 1f8782cc920..9a5754c0e10 100644
--- a/lisp/progmodes/cc-compat.el
+++ b/lisp/obsolete/cc-compat.el
@@ -1,6 +1,6 @@
;;; cc-compat.el --- cc-mode compatibility with c-mode.el confusion
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1994-1999 Barry A. Warsaw
@@ -8,6 +8,7 @@
;; Created: August 1994, split from cc-mode.el
;; Keywords: c languages
;; Package: cc-mode
+;; Obsolete-Since: 24.5
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index 2fffd361cff..d6918da3e56 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -1,6 +1,6 @@
;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
@@ -129,14 +129,6 @@
(if test-not (not (funcall test-not item elt))
(funcall (or test 'eql) item elt))))
-
-;;; Rounding functions with old-style multiple value returns.
-
-(defun cl-floor (a &optional b) (Values-list (floor* a b)))
-(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b)))
-(defun cl-round (a &optional b) (Values-list (round* a b)))
-(defun cl-truncate (a &optional b) (Values-list (truncate* a b)))
-
(defun safe-idiv (a b)
(let* ((q (/ (abs a) (abs b)))
(s (* (signum a) (signum b))))
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index e5e1fa00162..87dedacbe1d 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -1,6 +1,6 @@
;;; complete.el --- partial completion mechanism plus other goodies
-;; Copyright (C) 1990-1993, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1993, 1999-2015 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Keywords: abbrev convenience
@@ -963,7 +963,7 @@ or properties are considered."
Environment vars are converted to their values."
(interactive)
(let* ((end (point))
- (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']"
+ (beg (if (re-search-backward "[^\\][ \t\n\"`'][^ \t\n\"`']"
(point-min) t)
(+ (point) 2)
(point-min)))
diff --git a/lisp/emulation/crisp.el b/lisp/obsolete/crisp.el
index 4ece5d722f2..8bc6908260e 100644
--- a/lisp/emulation/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -1,9 +1,10 @@
;;; crisp.el --- CRiSP/Brief Emacs emulator
-;; Copyright (C) 1997-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
;; Keywords: emulations brief crisp
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
@@ -22,6 +23,8 @@
;;; Commentary:
+;; *Note: This package has now moved to elpa.gnu.org.*
+
;; Keybindings and minor functions to duplicate the functionality and
;; finger-feel of the CRiSP/Brief editor. This package is designed to
;; facilitate transitioning from Brief to (XE|E)macs with a minimum
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index 06eaa135582..54f6563b4ae 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -1,6 +1,6 @@
;;; cust-print.el --- handles print-level and print-circle
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Adapted-By: ESR
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index 2d9179041ed..3dc02c1bf03 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -1,6 +1,6 @@
;;; erc-hecomplete.el --- Provides Nick name completion for ERC
-;; Copyright (C) 2001-2002, 2004, 2006-2013 Free Software Foundation,
+;; Copyright (C) 2001-2002, 2004, 2006-2015 Free Software Foundation,
;; Inc.
;; Author: Alex Schroeder <alex@gnu.org>
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index 98f9b836a3b..3985d511eac 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -1,9 +1,9 @@
;;; fast-lock.el --- automagic text properties caching for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: faces files
;; Version: 3.14
;; Obsolete-since: 22.1
@@ -200,7 +200,7 @@
`(let* (,@(append varlist
'((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
- before-change-functions after-change-functions
+ (inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)))
,@body
(when (and (not modified) (buffer-modified-p))
@@ -336,7 +336,7 @@ If nil, means information for all faces will be saved.")
With arg, turn Fast Lock mode on if and only if arg is positive and the buffer
is associated with a file. Enable it automatically in your `~/.emacs' by:
- (setq font-lock-support-mode 'fast-lock-mode)
+ (setq font-lock-support-mode \\='fast-lock-mode)
If Fast Lock mode is enabled, and the current buffer does not contain any text
properties, any associated Font Lock cache is used if its timestamp matches the
@@ -538,7 +538,7 @@ If the same file has different cache file names when edited on different
machines, e.g., on one machine the cache file name has the prefix `#home',
perhaps due to automount, try putting in your `~/.emacs' something like:
- (setq directory-abbrev-alist (cons '(\"^/home/\" . \"/\") directory-abbrev-alist))
+ (setq directory-abbrev-alist (cons \\='(\"^/home/\" . \"/\") directory-abbrev-alist))
Emacs automagically removes the common `/tmp_mnt' automount prefix by default.
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/obsolete/gulp.el
index d3a43329366..f0223fa2e17 100644
--- a/lisp/emacs-lisp/gulp.el
+++ b/lisp/obsolete/gulp.el
@@ -1,10 +1,11 @@
;;; gulp.el --- ask for updates for Lisp packages
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Sam Shteingold <shteingd@math.ucla.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: maint
+;; Obsolete-since: 25.1
;; This file is part of GNU Emacs.
@@ -33,8 +34,9 @@
:prefix "-"
:group 'maint)
-(defcustom gulp-discard "^;+ *Maintainer: *FSF *$"
+(defcustom gulp-discard "^;+ *Maintainer: *\\(FSF\\|emacs-devel@gnu\\.org\\) *$"
"The regexp matching the packages not requiring the request for updates."
+ :version "24.4" ; added emacs-devel
:type 'regexp
:group 'gulp)
@@ -68,7 +70,7 @@ please send them to me ASAP.
Please don't send the whole file. Instead, please send a patch made with
`diff -c' that shows precisely the changes you would like me to install.
Also please include itemized change log entries for your changes;
-please use lisp/ChangeLog as a guide for the style and for what kinds
+please use lisp/ChangeLog* as a guide for the style and for what kinds
of information to include.
Thanks.")
@@ -135,7 +137,7 @@ is left in the `*gulp*' buffer at the end."
"Create the maintainer/package alist for files in FLIST in DIR.
That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
(save-excursion
- (let (mplist filen node mnt-tm mnt tm fl-tm)
+ (let (mplist filen node mnt tm fl-tm)
(get-buffer-create gulp-tmp-buffer)
(set-buffer gulp-tmp-buffer)
(setq buffer-undo-list t)
diff --git a/lisp/obsolete/iso-acc.el b/lisp/obsolete/iso-acc.el
index c3f8b3f4ec5..c612849c685 100644
--- a/lisp/obsolete/iso-acc.el
+++ b/lisp/obsolete/iso-acc.el
@@ -1,10 +1,10 @@
;;; iso-acc.el --- minor mode providing electric accent keys
-;; Copyright (C) 1993-1994, 1996, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1993-1994, 1996, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Johan Vromans
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
@@ -55,7 +55,7 @@
;;
;; If the pseudo-accent is followed by anything else than a
;; self-insert-command, the dead-key code is terminated, the
-;; pseudo-accent inserted 'as is' and the bell is rung to signal this.
+;; pseudo-accent inserted ‘as is’ and the bell is rung to signal this.
;;
;; Function `iso-accents-mode' can be used to enable the iso accents
;; minor mode, or disable it.
@@ -272,7 +272,7 @@ See the function `iso-accents-mode'."
(defcustom iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
"List of accent keys that become prefixes in ISO Accents mode.
-The default is (?' ?` ?^ ?\" ?~ ?/), which contains all the supported
+The default is (?\\=' ?\\=` ?^ ?\" ?~ ?/), which contains all the supported
accent keys. If you set this variable to a list in which some of those
characters are missing, the missing ones do not act as accents.
@@ -346,7 +346,7 @@ the language you choose)."
"Toggle ISO Accents mode, in which accents modify the following letter.
This permits easy insertion of accented characters according to ISO-8859-1.
When Iso-accents mode is enabled, accent character keys
-\(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
+\(\\=`, \\=', \", ^, / and ~) do not self-insert; instead, they modify the following
letter key so that it inserts an ISO accented letter.
You can customize ISO Accents mode to a particular language
diff --git a/lisp/obsolete/iso-insert.el b/lisp/obsolete/iso-insert.el
index 2c0adf32d12..3df786e1f2b 100644
--- a/lisp/obsolete/iso-insert.el
+++ b/lisp/obsolete/iso-insert.el
@@ -1,9 +1,9 @@
-;;; iso-insert.el --- insert functions for ISO 8859/1 -*- coding: utf-8;-*-
+;;; iso-insert.el --- insert functions for ISO 8859/1
-;; Copyright (C) 1987, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
diff --git a/lisp/obsolete/iso-swed.el b/lisp/obsolete/iso-swed.el
index c79a321c095..66847ddb270 100644
--- a/lisp/obsolete/iso-swed.el
+++ b/lisp/obsolete/iso-swed.el
@@ -1,9 +1,9 @@
;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
-;; Copyright (C) 1987, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
diff --git a/lisp/iswitchb.el b/lisp/obsolete/iswitchb.el
index 07873db38e1..4121e65c9dc 100644
--- a/lisp/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -1,10 +1,11 @@
;;; iswitchb.el --- switch between buffers using substrings
-;; Copyright (C) 1996-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Stephen Eglen <stephen@gnu.org>
;; Maintainer: Stephen Eglen <stephen@gnu.org>
;; Keywords: completion convenience
+;; Obsolete-since: 24.4
;; This file is part of GNU Emacs.
@@ -23,6 +24,8 @@
;;; Commentary:
+;; This file is obsolete - use icomplete-mode or ido-mode instead.
+
;; Installation:
;; To get the functions in this package bound to keys, use
;; M-x iswitchb-mode or customize the option `iswitchb-mode'.
@@ -172,10 +175,10 @@
;; iswitchb-read-buffer has been written to be a drop in replacement
;; for the normal buffer selection routine `read-buffer'. To use
;; iswitch for all buffer selections in Emacs, add:
-;; (setq read-buffer-function 'iswitchb-read-buffer)
+;; (setq read-buffer-function #'iswitchb-read-buffer)
;; (This variable was introduced in Emacs 20.3.)
;; XEmacs users can get the same behavior by doing:
-;; (defalias 'read-buffer 'iswitchb-read-buffer)
+;; (defalias 'read-buffer #'iswitchb-read-buffer)
;; since `read-buffer' is defined in lisp.
;; Using iswitchb for other completion tasks.
@@ -386,8 +389,8 @@ See documentation of `walk-windows' for useful values."
This hook is run during minibuffer setup if `iswitchb' is active.
For instance:
-\(add-hook 'iswitchb-minibuffer-setup-hook
- '\(lambda () (set (make-local-variable 'max-mini-window-height) 3)))
+\(add-hook \\='iswitchb-minibuffer-setup-hook
+ \\='\(lambda () (set (make-local-variable \\='max-mini-window-height) 3)))
will constrain the minibuffer to a maximum height of 3 lines when
iswitchb is running."
:type 'hook
@@ -583,7 +586,7 @@ in a separate window.
))))
(defun iswitchb-read-buffer (prompt &optional default require-match
- start matches-set)
+ _predicate start matches-set)
"Replacement for the built-in `read-buffer'.
Return the name of a buffer selected.
PROMPT is the prompt to give to the user.
@@ -1092,7 +1095,7 @@ Return the modified list with the last element prepended to it."
(and iswitchb-prompt-newbuffer
(y-or-n-p
- (format
+ (format-message
"No buffer matching `%s', create one? "
buf)))))
;; then create a new buffer
diff --git a/lisp/obsolete/keyswap.el b/lisp/obsolete/keyswap.el
index c12ebf941a2..1f27896eb49 100644
--- a/lisp/obsolete/keyswap.el
+++ b/lisp/obsolete/keyswap.el
@@ -1,6 +1,6 @@
-;;; keyswap.el --- swap BS and DEL keys -*- no-byte-compile: t -*-
+;;; keyswap.el --- swap BS and DEL keys
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Keywords: terminals
diff --git a/lisp/play/landmark.el b/lisp/obsolete/landmark.el
index cf86d7a9de5..91c33874b61 100644
--- a/lisp/play/landmark.el
+++ b/lisp/obsolete/landmark.el
@@ -1,16 +1,12 @@
-;;; landmark.el --- neural-network robot that learns landmarks
+;;; landmark.el --- Neural-network robot that learns landmarks -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Terrence Brannon (was: <brannon@rana.usc.edu>)
;; Created: December 16, 1996 - first release to usenet
-;; Keywords: games, gomoku, neural network, adaptive search, chemotaxis
-
-;;;_* Usage
-;;; Just type
-;;; M-x eval-buffer
-;;; M-x landmark-test-run
-
+;; Keywords: games, neural network, adaptive search, chemotaxis
+;; Version: 1.0
+;; Obsolete-since: 25.1
;; This file is part of GNU Emacs.
@@ -29,6 +25,11 @@
;;; Commentary:
+
+;; *Note: This package has now moved to elpa.gnu.org.*
+
+;; To try this, just type: M-x landmark-test-run
+
;; Landmark is a relatively non-participatory game in which a robot
;; attempts to maneuver towards a tree at the center of the window
;; based on unique olfactory cues from each of the 4 directions. If
@@ -228,15 +229,10 @@
'landmark-font-lock-face-X)))
"Font lock rules for Landmark.")
-(put 'landmark-mode 'front-sticky
- (put 'landmark-mode 'rear-nonsticky '(intangible)))
-(put 'landmark-mode 'intangible 1)
;; This one is for when they set view-read-only to t: Landmark cannot
;; allow View Mode to be activated in its buffer.
-(put 'landmark-mode 'mode-class 'special)
-
-(defun landmark-mode ()
- "Major mode for playing Landmark against Emacs.
+(define-derived-mode landmark-mode special-mode "Lm"
+ "Major mode for playing Lm against Emacs.
You and Emacs play in turn by marking a free square. You mark it with X
and Emacs marks it with O. The winner is the first to get five contiguous
marks horizontally, vertically or in diagonal.
@@ -247,16 +243,10 @@ Other useful commands:
\\{landmark-mode-map}
Entry to this mode calls the value of `landmark-mode-hook' if that value
is non-nil. One interesting value is `turn-on-font-lock'."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'landmark-mode
- mode-name "Landmark")
(landmark-display-statistics)
- (use-local-map landmark-mode-map)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(landmark-font-lock-keywords t)
- buffer-read-only t)
- (run-mode-hooks 'landmark-mode-hook))
+ (setq-local font-lock-defaults '(landmark-font-lock-keywords t))
+ (setq buffer-read-only t)
+ (add-hook 'post-command-hook #'landmark--intangible nil t))
;;;_ + THE SCORE TABLE.
@@ -691,8 +681,8 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE."
(landmark-prompt-for-other-game))
(t
(message "Let me think...")
- (let (square score)
- (setq square (landmark-strongest-square))
+ (let ((square (landmark-strongest-square))
+ score)
(cond ((null square)
(landmark-terminate-game 'nobody-won))
(t
@@ -734,8 +724,7 @@ along the DX, DY direction, considering that DVAL has been added on SQUARE."
(min (max (/ (+ (- (cdr click)
landmark-y-offset
1)
- (let ((inhibit-point-motion-hooks t))
- (count-lines 1 (window-start)))
+ (count-lines (point-min) (window-start))
landmark-square-height
(% landmark-square-height 2)
(/ landmark-square-height 2))
@@ -761,8 +750,8 @@ If the game is finished, this command requests for another game."
((not landmark-game-in-progress)
(landmark-prompt-for-other-game))
(t
- (let (square score)
- (setq square (landmark-point-square))
+ (let ((square (landmark-point-square))
+ score)
(cond ((null square)
(error "Your point is not on a square. Retry!"))
((not (zerop (aref landmark-board square)))
@@ -856,16 +845,15 @@ If the game is finished, this command requests for another game."
(defun landmark-point-y ()
"Return the board row where point is."
- (let ((inhibit-point-motion-hooks t))
- (1+ (/ (- (count-lines 1 (point)) landmark-y-offset (if (bolp) 0 1))
- landmark-square-height))))
+ (1+ (/ (- (count-lines (point-min) (point))
+ landmark-y-offset (if (bolp) 0 1))
+ landmark-square-height)))
(defun landmark-point-square ()
"Return the index of the square point is on."
- (let ((inhibit-point-motion-hooks t))
(landmark-xy-to-index (1+ (/ (- (current-column) landmark-x-offset)
landmark-square-width))
- (landmark-point-y))))
+ (landmark-point-y)))
(defun landmark-goto-square (index)
"Move point to square number INDEX."
@@ -873,23 +861,21 @@ If the game is finished, this command requests for another game."
(defun landmark-goto-xy (x y)
"Move point to square at X, Y coords."
- (let ((inhibit-point-motion-hooks t))
(goto-char (point-min))
- (forward-line (+ landmark-y-offset (* landmark-square-height (1- y)))))
+ (forward-line (+ landmark-y-offset (* landmark-square-height (1- y))))
(move-to-column (+ landmark-x-offset (* landmark-square-width (1- x)))))
(defun landmark-plot-square (square value)
- "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
+ "Draw `X', `O' or `.' on SQUARE depending on VALUE, leave point there."
(or (= value 1)
(landmark-goto-square square))
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
- (insert-and-inherit (cond ((= value 1) ?.)
- ((= value 2) ?N)
- ((= value 3) ?S)
- ((= value 4) ?E)
- ((= value 5) ?W)
- ((= value 6) ?^)))
+ (let ((inhibit-read-only t))
+ (insert (cond ((= value 1) ?.)
+ ((= value 2) ?N)
+ ((= value 3) ?S)
+ ((= value 4) ?E)
+ ((= value 5) ?W)
+ ((= value 6) ?^)))
(and (zerop value)
(add-text-properties (1- (point)) (point)
@@ -904,8 +890,7 @@ mouse-1: get robot moving, mouse-2: play on this square")))
"Display an N by M Landmark board."
(buffer-disable-undo (current-buffer))
(let ((inhibit-read-only t)
- (point 1) opoint
- (intangible t)
+ (point (point-min)) opoint
(i m) j x)
;; Try to minimize number of chars (because of text properties)
(setq tab-width
@@ -914,7 +899,7 @@ mouse-1: get robot moving, mouse-2: play on this square")))
(max (/ (+ (% landmark-x-offset landmark-square-width)
landmark-square-width 1) 2) 2)))
(erase-buffer)
- (newline landmark-y-offset)
+ (insert-char ?\n landmark-y-offset)
(while (progn
(setq j n
x (- landmark-x-offset landmark-square-width))
@@ -922,9 +907,7 @@ mouse-1: get robot moving, mouse-2: play on this square")))
(insert-char ?\t (/ (- (setq x (+ x landmark-square-width))
(current-column))
tab-width))
- (insert-char ? (- x (current-column)))
- (if (setq intangible (not intangible))
- (put-text-property point (point) 'intangible 2))
+ (insert-char ?\s (- x (current-column)))
(and (zerop j)
(= i (- m 2))
(progn
@@ -941,14 +924,7 @@ mouse-1: get robot moving, mouse-2: play on this square")))
(if (= i (1- m))
(setq opoint point))
(insert-char ?\n landmark-square-height))
- (or (eq (char-after 1) ?.)
- (put-text-property 1 2 'point-entered
- (lambda (_x _y) (if (bobp) (forward-char)))))
- (or intangible
- (put-text-property point (point) 'intangible 2))
- (put-text-property point (point) 'point-entered
- (lambda (_x _y) (if (eobp) (backward-char))))
- (put-text-property (point-min) (point) 'category 'landmark-mode))
+ (insert-char ?\n))
(landmark-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
(sit-for 0)) ; Display NOW
@@ -1010,8 +986,7 @@ mouse-1: get robot moving, mouse-2: play on this square")))
"Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
(save-excursion ; Not moving point from last square
(let ((depl (landmark-xy-to-index dx dy))
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (inhibit-read-only t))
;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
(while (/= square1 square2)
(landmark-goto-square square1)
@@ -1030,32 +1005,56 @@ mouse-1: get robot moving, mouse-2: play on this square")))
(setq landmark-n (1+ landmark-n))
(forward-line 1)
(indent-to column)
- (insert-and-inherit ?|))))
+ (insert ?|))))
((= dx -1) ; 1st Diagonal
(indent-to (prog1 (- (current-column) (/ landmark-square-width 2))
(forward-line (/ landmark-square-height 2))))
- (insert-and-inherit ?/))
+ (insert ?/))
(t ; 2nd Diagonal
(indent-to (prog1 (+ (current-column) (/ landmark-square-width 2))
(forward-line (/ landmark-square-height 2))))
- (insert-and-inherit ?\\))))))
+ (insert ?\\))))))
(sit-for 0)) ; Display NOW
;;;_ + CURSOR MOTION.
+(defvar-local landmark--last-pos 0)
+
+(defconst landmark--intangible-chars "- \t\n|/\\\\")
+
+(defun landmark--intangible ()
+ (when (or (eobp)
+ (save-excursion
+ (not (zerop (skip-chars-forward landmark--intangible-chars)))))
+ (if (<= landmark--last-pos (point)) ;Moving forward.
+ (progn
+ (skip-chars-forward landmark--intangible-chars)
+ (when (eobp)
+ (skip-chars-backward landmark--intangible-chars)
+ (forward-char -1)))
+ (skip-chars-backward landmark--intangible-chars)
+ (if (bobp)
+ (skip-chars-forward landmark--intangible-chars)
+ (forward-char -1))))
+ (setq landmark--last-pos (point)))
+
;; previous-line and next-line don't work right with intangible newlines
(defun landmark-move-down ()
"Move point down one row on the Landmark board."
(interactive)
(if (< (landmark-point-y) landmark-board-height)
- (forward-line 1)));;; landmark-square-height)))
+ (let ((col (current-column)))
+ (forward-line 1) ;;; landmark-square-height
+ (move-to-column col))))
(defun landmark-move-up ()
"Move point up one row on the Landmark board."
(interactive)
(if (> (landmark-point-y) 1)
- (forward-line (- landmark-square-height))))
+ (let ((col (current-column)))
+ (forward-line (- landmark-square-height))
+ (move-to-column col))))
(defun landmark-move-ne ()
"Move point North East on the Landmark board."
@@ -1146,7 +1145,7 @@ because it is overwritten by \"One moment please\"."
(defun landmark-print-distance ()
- (insert (format "tree: %S \n" (calc-distance-of-robot-from 'landmark-tree)))
+ (insert (format "tree: %S \n" (landmark-calc-distance-of-robot-from 'landmark-tree)))
(mapc 'landmark-print-distance-int landmark-directions))
@@ -1311,9 +1310,9 @@ After this limit is reached, landmark-random-move is called to push him out of i
;;;_ - landmark-plot-internal (sym)
(defun landmark-plot-internal (sym)
(landmark-plot-square (landmark-xy-to-index
- (get sym 'x)
- (get sym 'y))
- (get sym 'sym)))
+ (get sym 'x)
+ (get sym 'y))
+ (get sym 'sym)))
;;;_ - landmark-plot-landmarks ()
(defun landmark-plot-landmarks ()
(setq landmark-cx (/ landmark-board-width 2))
@@ -1344,26 +1343,24 @@ After this limit is reached, landmark-random-move is called to push him out of i
;;;_ + Distance-calculation functions
-;;;_ - square (a)
-(defun square (a)
- (* a a))
;;;_ - distance (x x0 y y0)
-(defun distance (x x0 y y0)
- (sqrt (+ (square (- x x0)) (square (- y y0)))))
+(defun landmark--distance (x x0 y y0)
+ (let ((dx (- x x0)) (dy (- y y0)))
+ (sqrt (+ (* dx dx) (* dy dy)))))
-;;;_ - calc-distance-of-robot-from (direction)
-(defun calc-distance-of-robot-from (direction)
+;;;_ - landmark-calc-distance-of-robot-from (direction)
+(defun landmark-calc-distance-of-robot-from (direction)
(put direction 'distance
- (distance (get direction 'x)
- (landmark-index-to-x (landmark-point-square))
- (get direction 'y)
- (landmark-index-to-y (landmark-point-square)))))
+ (landmark--distance (get direction 'x)
+ (landmark-index-to-x (landmark-point-square))
+ (get direction 'y)
+ (landmark-index-to-y (landmark-point-square)))))
-;;;_ - calc-smell-internal (sym)
-(defun calc-smell-internal (sym)
+;;;_ - landmark-calc-smell-internal (sym)
+(defun landmark-calc-smell-internal (sym)
(let ((r (get sym 'r))
- (d (calc-distance-of-robot-from sym)))
+ (d (landmark-calc-distance-of-robot-from sym)))
(if (> (* 0.5 (- 1 (/ d r))) 0)
(* 0.5 (- 1 (/ d r)))
0)))
@@ -1410,12 +1407,12 @@ After this limit is reached, landmark-random-move is called to push him out of i
(defun landmark-calc-current-smells ()
(mapc (lambda (direction)
- (put direction 'smell (calc-smell-internal direction)))
+ (put direction 'smell (landmark-calc-smell-internal direction)))
landmark-directions))
(defun landmark-calc-payoff ()
(put 'z 't-1 (get 'z 't))
- (put 'z 't (calc-smell-internal 'landmark-tree))
+ (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
(if (= (- (get 'z 't) (get 'z 't-1)) 0.0)
(cl-incf landmark-no-payoff)
(setf landmark-no-payoff 0)))
@@ -1456,8 +1453,9 @@ After this limit is reached, landmark-random-move is called to push him out of i
(message "e-w normalization"))))
(mapc (lambda (pair)
- (if (> (get (car pair) 'y_t) 0)
- (funcall (car (cdr pair)))))
+ (when (> (get (car pair) 'y_t) 0)
+ (funcall (car (cdr pair)))
+ (landmark--intangible)))
'(
(landmark-n landmark-move-up)
(landmark-s landmark-move-down)
@@ -1479,7 +1477,7 @@ After this limit is reached, landmark-random-move is called to push him out of i
(defun landmark-amble-robot ()
(interactive)
- (while (> (calc-distance-of-robot-from 'landmark-tree) 0)
+ (while (> (landmark-calc-distance-of-robot-from 'landmark-tree) 0)
(landmark-store-old-y_t)
(landmark-calc-current-smells)
@@ -1513,8 +1511,7 @@ If the game is finished, this command requests for another game."
((not landmark-game-in-progress)
(landmark-prompt-for-other-game))
(t
- (let (square)
- (setq square (landmark-point-square))
+ (let ((square (landmark-point-square)))
(cond ((null square)
(error "Your point is not on a square. Retry!"))
((not (zerop (aref landmark-board square)))
@@ -1525,7 +1522,7 @@ If the game is finished, this command requests for another game."
(landmark-store-old-y_t)
(landmark-calc-current-smells)
- (put 'z 't (calc-smell-internal 'landmark-tree))
+ (put 'z 't (landmark-calc-smell-internal 'landmark-tree))
(landmark-random-move)
@@ -1598,7 +1595,9 @@ If the game is finished, this command requests for another game."
;; distance on scent.
(defun landmark-set-landmark-signal-strengths ()
- (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5))
+ (setq landmark-tree-r (* (sqrt (+ (* landmark-cx landmark-cx)
+ (* landmark-cy landmark-cy)))
+ 1.5))
(mapc (lambda (direction)
(put direction 'r (* landmark-cx 1.1)))
landmark-ew)
@@ -1617,7 +1616,7 @@ If the game is finished, this command requests for another game."
"Run 100 Landmark games, each time saving the weights from the previous game."
(interactive)
(landmark 1)
- (dotimes (scratch-var 100)
+ (dotimes (_ 100)
(landmark 2)))
;;;###autoload
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index 7bb34230c44..d05a7d86dbc 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -1,9 +1,9 @@
;;; lazy-lock.el --- lazy demand-driven fontification for fast Font Lock mode
-;; Copyright (C) 1994-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: faces files
;; Version: 2.11
;; Obsolete-since: 22.1
@@ -466,7 +466,7 @@ See also `lazy-lock-stealth-load'."
With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it
automatically in your `~/.emacs' by:
- (setq font-lock-support-mode 'lazy-lock-mode)
+ (setq font-lock-support-mode \\='lazy-lock-mode)
For a newer font-lock support mode with similar functionality, see
`jit-lock-mode'. Eventually, Lazy Lock mode will be deprecated in
@@ -892,8 +892,7 @@ verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
(save-excursion
(save-match-data
(save-buffer-state
- ;; Ensure syntactic fontification is always correct.
- (font-lock-beginning-of-syntax-function next)
+ (next)
;; Find successive unfontified regions between BEG and END.
(condition-case data
(do-while beg
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el
index d2765580631..4db741bf406 100644
--- a/lisp/obsolete/ledit.el
+++ b/lisp/obsolete/ledit.el
@@ -1,8 +1,8 @@
;;; ledit.el --- Emacs side of ledit interface
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages
;; Obsolete-since: 24.3
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
index 843bce0cacf..96357da5fca 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -1,8 +1,8 @@
;;; levents.el --- emulate the Lucid event data type and associated functions
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: emulations
;; Obsolete-since: 23.2
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
index c8aca99afe3..97643826a9f 100644
--- a/lisp/obsolete/lmenu.el
+++ b/lisp/obsolete/lmenu.el
@@ -1,6 +1,6 @@
;;; lmenu.el --- emulate Lucid's menubar support
-;; Copyright (C) 1992-1994, 1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992-1994, 1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Keywords: emulations obsolete
@@ -131,7 +131,7 @@
(setq menu-items (cdr menu-items)))
menu))
-(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
;; XEmacs compatibility function
(defun popup-dialog-box (data)
@@ -160,9 +160,9 @@ The syntax, more precisely:
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 ]+ ] ')'"
+ partition := `nil'
+ button := `[' name callback active-p `]'
+ dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
(let ((name (car data))
(tail (cdr data))
converted
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index b68a191d55a..bfde826aa93 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -1,6 +1,6 @@
;;; longlines.el --- automatically wrap long lines -*- coding:utf-8 -*-
-;; Copyright (C) 2000-2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2015 Free Software Foundation, Inc.
;; Authors: Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
;; Alex Schroeder <alex@gnu.org>
@@ -143,7 +143,7 @@ newlines are indicated with a symbol."
'longlines-window-change-function nil t))
(let ((buffer-undo-list t)
(inhibit-read-only t)
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(mod (buffer-modified-p))
buffer-file-name buffer-file-truename)
;; Turning off undo is OK since (spaces + newlines) is
@@ -184,7 +184,7 @@ newlines are indicated with a symbol."
(if longlines-showing
(longlines-unshow-hard-newlines))
(let ((buffer-undo-list t)
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(inhibit-read-only t)
buffer-file-name buffer-file-truename)
(if longlines-decoded
@@ -464,14 +464,9 @@ This is called by `window-configuration-change-hook'."
(defun longlines-search-function ()
(cond
- (isearch-word
- (if isearch-forward 'word-search-forward 'word-search-backward))
- (isearch-regexp
- (if isearch-forward 're-search-forward 're-search-backward))
- (t
- (if isearch-forward
- 'longlines-search-forward
- 'longlines-search-backward))))
+ ((or isearch-regexp-function isearch-regexp) (isearch-search-fun-default))
+ (isearch-forward #'longlines-search-forward)
+ (t #'longlines-search-backward)))
(defun longlines-search-forward (string &optional bound noerror count)
(let ((search-spaces-regexp " *[ \n]"))
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
index 713c4e6676b..569abb60870 100644
--- a/lisp/obsolete/lucid.el
+++ b/lisp/obsolete/lucid.el
@@ -1,8 +1,8 @@
;;; lucid.el --- emulate some Lucid Emacs functions
-;; Copyright (C) 1993, 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1995, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: emulations
;; Obsolete-since: 23.2
@@ -30,27 +30,6 @@
(defalias 'current-time-seconds 'current-time)
-(defun read-number (prompt &optional integers-only)
- "Read a number from the minibuffer.
-Keep reentering the minibuffer until we get suitable input.
-If optional argument INTEGERS-ONLY is non-nil, insist on an integer."
- (interactive)
- (let (success
- (number nil)
- (predicate (if integers-only 'integerp 'numberp)))
- (while (not success)
- (let ((input-string (read-string prompt)))
- (condition-case ()
- (setq number (read input-string))
- (error))
- (if (funcall predicate number)
- (setq success t)
- (let ((cursor-in-echo-area t))
- (message "Please type %s"
- (if integers-only "an integer" "a number"))
- (sit-for 1)))))
- number))
-
(defun real-path-name (name &optional default)
(file-truename (expand-file-name name default)))
@@ -125,7 +104,7 @@ This is an XEmacs compatibility function."
(defun extent-at (pos &optional object property before)
(with-current-buffer (or object (current-buffer))
- (let ((overlays (overlays-at pos)))
+ (let ((overlays (overlays-at pos 'sorted)))
(when property
(let (filtered)
(while overlays
@@ -133,14 +112,6 @@ This is an XEmacs compatibility function."
(setq filtered (cons (car overlays) filtered)))
(setq overlays (cdr overlays)))
(setq overlays filtered)))
- (setq overlays
- (sort overlays
- (function (lambda (o1 o2)
- (let ((p1 (or (overlay-get o1 'priority) 0))
- (p2 (or (overlay-get o2 'priority) 0)))
- (or (> p1 p2)
- (and (= p1 p2)
- (> (overlay-start o1) (overlay-start o2)))))))))
(if before
(nth 1 (memq before overlays))
(car overlays)))))
diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el
index b6bf0d1e1b9..bcd468c2b06 100644
--- a/lisp/obsolete/mailpost.el
+++ b/lisp/obsolete/mailpost.el
@@ -6,7 +6,7 @@
;; This file is part of GNU Emacs.
;; Author: Gary Delp <delp@huey.Udel.Edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 13 Jan 1986
;; Keywords: mail
;; Obsolete-since: 24.3
@@ -75,12 +75,7 @@ site-init."
(if mail-interactive
(with-current-buffer errbuf
(erase-buffer))))
- (let ((m (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes 384)
- (setq temfile (make-temp-file ",rpost")))
- (set-default-file-modes m)))
+ (with-file-modes 384 (setq temfile (make-temp-file ",rpost")))
(apply 'call-process
(append (list (if (boundp 'post-mail-program)
post-mail-program
diff --git a/lisp/play/meese.el b/lisp/obsolete/meese.el
index d811dacb9bc..81739dfa6cb 100644
--- a/lisp/play/meese.el
+++ b/lisp/obsolete/meese.el
@@ -5,8 +5,9 @@
;; This file is part of GNU Emacs.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
+;; Obsolete-since: 24.4
;;; Commentary:
@@ -31,7 +32,7 @@
(insert-file-contents buffer-file-name t))
(rename-buffer (file-name-nondirectory buffer-file-name))))))
-(add-hook 'find-file-hook 'protect-innocence-hook)
+;;;(add-hook 'find-file-hook 'protect-innocence-hook)
(provide 'meese)
;;; meese.el ends here
diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el
index c6511fac992..865a4277dda 100644
--- a/lisp/obsolete/mouse-sel.el
+++ b/lisp/obsolete/mouse-sel.el
@@ -1,6 +1,6 @@
;;; mouse-sel.el --- multi-click selection support
-;; Copyright (C) 1993-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Mike Williams <mdub@bigfoot.com>
;; Keywords: mouse
@@ -97,8 +97,8 @@
;; In this mode, mouse-insert-selection just calls mouse-yank-at-click.
;;
;; Selection/kill-ring interaction is retained
-;; interprogram-cut-function = x-select-text
-;; interprogram-paste-function = x-selection-value
+;; interprogram-cut-function = gui-select-text
+;; interprogram-paste-function = gui-selection-value
;;
;; What you lose is the ability to select some text in
;; delete-selection-mode and yank over the top of it.
@@ -190,12 +190,9 @@ If nil, point will always be placed at the beginning of the region."
;;=== User Command ========================================================
-(defvar mouse-sel-has-been-enabled nil
- "Non-nil if Mouse Sel mode has been enabled at least once.")
-
(defvar mouse-sel-original-bindings nil)
-(defvar mouse-sel-original-interprogram-cut-function nil)
-(defvar mouse-sel-original-interprogram-paste-function nil)
+
+(defalias 'mouse-sel--ignore #'ignore)
;;;###autoload
(define-minor-mode mouse-sel-mode
@@ -242,14 +239,11 @@ kill ring; mouse-1 or mouse-3 kills it."
(global-set-key event (cdr binding)))))
mouse-sel-bound-events))
;; Update interprogram functions.
- (setq mouse-sel-original-interprogram-cut-function
- interprogram-cut-function
- mouse-sel-original-interprogram-paste-function
- interprogram-paste-function
- mouse-sel-has-been-enabled t)
(unless (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- (setq interprogram-cut-function nil
- interprogram-paste-function nil))))
+ (add-function :override interprogram-cut-function
+ #'mouse-sel--ignore)
+ (add-function :override interprogram-paste-function
+ #'mouse-sel--ignore))))
;; Restore original bindings
(remove-hook 'x-lost-selection-functions 'mouse-sel-lost-selection-hook)
@@ -257,11 +251,8 @@ kill ring; mouse-1 or mouse-3 kills it."
(global-set-key (car binding) (cdr binding)))
;; Restore the old values of these variables,
;; only if they were actually saved previously.
- (if mouse-sel-has-been-enabled
- (setq interprogram-cut-function
- mouse-sel-original-interprogram-cut-function
- interprogram-paste-function
- mouse-sel-original-interprogram-paste-function))))
+ (remove-function interprogram-cut-function #'mouse-sel--ignore)
+ (remove-function interprogram-paste-function #'mouse-sel--ignore)))
(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3")
@@ -301,15 +292,13 @@ where SELECTION-NAME = name of selection
SELECTION-THING-SYMBOL = name of variable where the current selection
type for this selection should be stored.")
-(declare-function x-select-text "term/common-win" (text))
-
(defvar mouse-sel-set-selection-function
(if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
- 'x-set-selection
+ 'gui-set-selection
(lambda (selection value)
(if (eq selection 'PRIMARY)
- (x-select-text value)
- (x-set-selection selection value))))
+ (gui-select-text value)
+ (gui-set-selection selection value))))
"Function to call to set selection.
Called with two arguments:
@@ -319,15 +308,14 @@ Called with two arguments:
This sets the selection, unless `mouse-sel-default-bindings'
is `interprogram-cut-paste'.")
-(declare-function x-selection-value "term/x-win" ())
(defvar mouse-sel-get-selection-function
(lambda (selection)
(if (eq selection 'PRIMARY)
- (or (x-selection-value)
- (bound-and-true-p x-last-selected-text)
- (bound-and-true-p x-last-selected-text-primary))
- (x-get-selection selection)))
+ (or (gui-selection-value)
+ (bound-and-true-p x-last-selected-text-primary)
+ gui--last-selected-text-primary)
+ (gui-get-selection selection)))
"Function to call to get the selection.
Called with one argument:
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
index 0aa5240aeb0..009ae53dd9d 100644
--- a/lisp/obsolete/old-emacs-lock.el
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -1,6 +1,6 @@
;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked
-;; Copyright (C) 1994, 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Tom Wurgler <twurgler@goodyear.com>
;; Created: 12/8/94
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
index 359c22c50ea..00b32145728 100644
--- a/lisp/obsolete/old-whitespace.el
+++ b/lisp/obsolete/old-whitespace.el
@@ -1,6 +1,6 @@
;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
;; Keywords: convenience
@@ -259,7 +259,7 @@ 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
+\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
whitespace-modes))\)
Or, alternately, you can use the Emacs `customize' command to set this."
diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el
index f25003e5652..35ec7fd33ca 100644
--- a/lisp/obsolete/options.el
+++ b/lisp/obsolete/options.el
@@ -1,8 +1,8 @@
;;; options.el --- edit Options command for Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Obsolete-since: 22.1
;; This file is part of GNU Emacs.
@@ -88,7 +88,7 @@ The Custom feature is intended to make this obsolete."
;; Edit Options mode is suitable only for specially formatted data.
(put 'Edit-options-mode 'mode-class 'special)
-(defun Edit-options-mode ()
+(define-derived-mode Edit-options-mode emacs-lisp-mode "Options"
"\\<Edit-options-mode-map>\
Major mode for editing Emacs user option settings.
Special commands are:
@@ -100,17 +100,9 @@ Changed values made by these commands take effect immediately.
Each variable description is a paragraph.
For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs."
- (kill-all-local-variables)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (use-local-map Edit-options-mode-map)
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate "[^\^@-\^?]")
- (make-local-variable 'paragraph-start)
- (setq paragraph-start "\t")
- (setq truncate-lines t)
- (setq major-mode 'Edit-options-mode)
- (setq mode-name "Options")
- (run-mode-hooks 'Edit-options-mode-hook))
+ (setq-local paragraph-separate "[^\^@-\^?]")
+ (setq-local paragraph-start "\t")
+ (setq-local truncate-lines t))
(defun Edit-options-set () (interactive)
(Edit-options-modify
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index c3a4b082be3..1e9f7e42628 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -1,6 +1,6 @@
;;; todo-mode.el --- major mode for editing TODO list files
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
@@ -272,7 +272,7 @@
This is useful in conjunction with `calendar' and `diary' if you use
-#include \"~/.todo-do\"
+#include \"~/.emacs.d/todo-do\"
in your diary file to include your todo list file as part of your
diary. With the default value \"*/*\" the diary displays each entry
@@ -284,10 +284,12 @@ the diary file somewhat."
:group 'todo)
(defcustom todo-file-do (locate-user-emacs-file "todo-do" ".todo-do")
"TODO mode list file."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'todo)
(defcustom todo-file-done (locate-user-emacs-file "todo-done" ".todo-done")
"TODO mode archive file."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'todo)
(defcustom todo-mode-hook nil
@@ -321,6 +323,7 @@ window."
Not in TODO format, but diary compatible.
Automatically generated when `todo-save-top-priorities' is non-nil."
+ :version "24.4" ; added locate-user-emacs-file
:type 'string
:group 'todo)
@@ -645,7 +648,7 @@ If point is on an empty line, insert the entry there."
(forward-line (1- todo-previous-line))
(let ((item (todo-item-string-start)))
(setq todo-previous-answer
- (y-or-n-p (concat "More important than '" item "'? ")))))
+ (y-or-n-p (format-message "More important than `%s'? " item)))))
todo-previous-answer)
(defalias 'todo-ask-p 'todo-more-important-p)
@@ -731,7 +734,7 @@ If point is on an empty line, insert the entry there."
Number of entries for each category is given by NOF-PRIORITIES which
defaults to `todo-show-priorities'.
-If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted
+If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
between each category.
INTERACTIVE should be non-nil if this function is called interactively."
@@ -916,7 +919,7 @@ If INCLUDE-SEP is non-nil, return point after the separator."
["Quit" todo-quit t]
))
-;; As calendar reads .todo-do before todo-mode is loaded.
+;; As calendar reads todo-file-do before todo-mode is loaded.
;;;###autoload
(define-derived-mode todo-mode nil "TODO"
"Major mode for editing TODO lists."
diff --git a/lisp/obsolete/patcomp.el b/lisp/obsolete/patcomp.el
index 9aacdd8f4c3..8545f0721fa 100644
--- a/lisp/obsolete/patcomp.el
+++ b/lisp/obsolete/patcomp.el
@@ -1,4 +1,4 @@
-;;; patcomp.el --- used by patch files to update Emacs releases -*- no-byte-compile: t -*-
+;;; patcomp.el --- used by patch files to update Emacs releases
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
index 9243a8135bf..d77676817e7 100644
--- a/lisp/obsolete/pc-mode.el
+++ b/lisp/obsolete/pc-mode.el
@@ -1,8 +1,8 @@
;;; pc-mode.el --- emulate certain key bindings used on PCs
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: emulations
;; Obsolete-since: 24.1
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 0f94dd69401..371c33848a5 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -2,7 +2,7 @@
;;; (or MAC GUI or MS-windoze (bah)) look-and-feel
;;; including key bindings.
-;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
;; Keywords: convenience emulations
@@ -337,7 +337,7 @@ but before calling PC Selection mode):
(cadr pc-select-meta-moves-sexps-key-bindings))
(if (or pc-select-selection-keys-only
(eq window-system 'x)
- (memq system-name '(ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt)))
nil
pc-select-tty-key-bindings)))
@@ -346,7 +346,7 @@ but before calling PC Selection mode):
(unless (or pc-select-selection-keys-only
(eq window-system 'x)
- (memq system-name '(ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt)))
;; it is not clear that we need the following line
;; I hope it doesn't do too much harm to leave it in, though...
(setq pc-select-old-M-delete-binding
@@ -355,7 +355,7 @@ but before calling PC Selection mode):
(when (and (not pc-select-selection-keys-only)
(or (eq window-system 'x)
- (memq system-name '(ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt)))
(fboundp 'normal-erase-is-backspace-mode))
(pc-select-save-and-set-mode normal-erase-is-backspace-mode 1
normal-erase-is-backspace))
@@ -378,24 +378,24 @@ but before calling PC Selection mode):
(current-global-map))
(unless (or pc-select-selection-keys-only
(eq window-system 'x)
- (memq system-name '(ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt)))
;; it is not clear that we need the following line
;; I hope it doesn't do too much harm to leave it in, though...
(define-key function-key-map [M-delete] [?\M-d]))
(when (and (not pc-select-selection-keys-only)
(or (eq window-system 'x)
- (memq system-name '(ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt)))
(fboundp 'normal-erase-is-backspace-mode))
(normal-erase-is-backspace-mode 1))
(setq highlight-nonselected-windows nil)
- (setq transient-mark-mode t)
+ (transient-mark-mode 1)
(setq mark-even-if-inactive t)
(delete-selection-mode 1))
;;else
(when pc-select-key-bindings-alist
(when (and (not pc-select-selection-keys-only)
(or (eq window-system 'x)
- (memq system-name '(ms-dos windows-nt))))
+ (memq system-type '(ms-dos windows-nt))))
(pc-select-restore-mode normal-erase-is-backspace-mode))
(pc-select-restore-keys
diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el
index 294ad2d81a5..c1ebe4f5cbb 100644
--- a/lisp/obsolete/pgg-def.el
+++ b/lisp/obsolete/pgg-def.el
@@ -1,6 +1,6 @@
;;; pgg-def.el --- functions/macros for defining PGG functions
-;; Copyright (C) 1999, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el
index bab4fe5eb30..f3d63eb7451 100644
--- a/lisp/obsolete/pgg-gpg.el
+++ b/lisp/obsolete/pgg-gpg.el
@@ -1,6 +1,6 @@
;;; pgg-gpg.el --- GnuPG support for PGG.
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption and gpg-agent support added by:
@@ -122,7 +122,7 @@
(insert-file-contents output-file-name)))
(set-buffer errors-buffer)
(if (memq status '(stop signal))
- (error "%s exited abnormally: '%s'" program exit-status))
+ (error "%s exited abnormally: `%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))))
(if passphrase-with-newline
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 3b572a81767..ed0912f39e0 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -1,6 +1,6 @@
;;; pgg-parse.el --- OpenPGP packet parsing
-;; Copyright (C) 1999, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/10/28
diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el
index 1be978c0561..af2d7a8e39f 100644
--- a/lisp/obsolete/pgg-pgp.el
+++ b/lisp/obsolete/pgg-pgp.el
@@ -1,6 +1,6 @@
;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
@@ -99,7 +99,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(pgg-convert-lbt-region (point-min)(point-max) 'LF)
(if (memq status '(stop signal))
- (error "%s exited abnormally: '%s'" program exit-status))
+ (error "%s exited abnormally: `%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))
@@ -202,15 +202,11 @@ passphrase cache or user."
(defun pgg-pgp-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let* ((orig-file (pgg-make-temp-file "pgg"))
- (args "+verbose=1 +batchmode +language=us")
- (orig-mode (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes 448)
- (let ((coding-system-for-write 'binary)
- jka-compr-compression-info-list jam-zcat-filename-list)
- (write-region start end orig-file)))
- (set-default-file-modes orig-mode))
+ (args "+verbose=1 +batchmode +language=us"))
+ (with-file-modes 448
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
(if (stringp signature)
(progn
(copy-file signature (setq signature (concat orig-file ".asc")))
diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el
index c453ce3e08e..bbc08c48348 100644
--- a/lisp/obsolete/pgg-pgp5.el
+++ b/lisp/obsolete/pgg-pgp5.el
@@ -1,6 +1,6 @@
;;; pgg-pgp5.el --- PGP 5.* support for PGG.
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999/11/02
@@ -35,22 +35,22 @@
:group 'pgg)
(defcustom pgg-pgp5-pgpe-program "pgpe"
- "PGP 5.* 'pgpe' executable."
+ "PGP 5.* `pgpe' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgps-program "pgps"
- "PGP 5.* 'pgps' executable."
+ "PGP 5.* `pgps' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpk-program "pgpk"
- "PGP 5.* 'pgpk' executable."
+ "PGP 5.* `pgpk' executable."
:group 'pgg-pgp5
:type 'string)
(defcustom pgg-pgp5-pgpv-program "pgpv"
- "PGP 5.* 'pgpv' executable."
+ "PGP 5.* `pgpv' executable."
:group 'pgg-pgp5
:type 'string)
@@ -115,7 +115,7 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(pgg-convert-lbt-region (point-min)(point-max) 'LF)
(if (memq status '(stop signal))
- (error "%s exited abnormally: '%s'" program exit-status))
+ (error "%s exited abnormally: `%s'" program exit-status))
(if (= 127 exit-status)
(error "%s could not be found" program))
@@ -208,15 +208,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(defun pgg-pgp5-verify-region (start end &optional signature)
"Verify region between START and END as the detached signature SIGNATURE."
(let ((orig-file (pgg-make-temp-file "pgg"))
- (args '("+verbose=1" "+batchmode=1" "+language=us"))
- (orig-mode (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes 448)
- (let ((coding-system-for-write 'binary)
- jka-compr-compression-info-list jam-zcat-filename-list)
- (write-region start end orig-file)))
- (set-default-file-modes orig-mode))
+ (args '("+verbose=1" "+batchmode=1" "+language=us")))
+ (with-file-modes 448
+ (let ((coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end orig-file)))
(when (stringp signature)
(copy-file signature (setq signature (concat orig-file ".asc")))
(setq args (append args (list signature))))
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index db94075e3e4..dd50d265849 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -1,6 +1,6 @@
;;; pgg.el --- glue for the various PGP implementations.
-;; Copyright (C) 1999-2000, 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2002-2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
diff --git a/lisp/net/rcompile.el b/lisp/obsolete/rcompile.el
index e7bfbf386f4..dfa3ce302e6 100644
--- a/lisp/net/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -1,11 +1,12 @@
;;; rcompile.el --- run a compilation on a remote machine
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Alon Albert <alon@milcse.rtsg.mot.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 1993 Oct 6
;; Keywords: tools, processes
+;; Obsolete-since: 24.4
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/resume.el b/lisp/obsolete/resume.el
index dc1b76db545..678786cc336 100644
--- a/lisp/obsolete/resume.el
+++ b/lisp/obsolete/resume.el
@@ -1,6 +1,6 @@
;;; resume.el --- process command line args from within a suspended Emacs job
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@bucsf.bu.edu>
;; Adapted-By: ESR
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
index 1b4af78828c..bcce640f0bf 100644
--- a/lisp/obsolete/s-region.el
+++ b/lisp/obsolete/s-region.el
@@ -1,6 +1,6 @@
;;; s-region.el --- set region using shift key
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: terminals
diff --git a/lisp/obsolete/scribe.el b/lisp/obsolete/scribe.el
index 2ba1bb4aa76..e28e0aba091 100644
--- a/lisp/obsolete/scribe.el
+++ b/lisp/obsolete/scribe.el
@@ -1,10 +1,10 @@
;;; scribe.el --- scribe mode, and its idiosyncratic commands
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
;; Author: William Sommerfeld
;; (according to ack.texi)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; Obsolete-since: 22.1
@@ -50,7 +50,7 @@
:group 'scribe)
(defcustom scribe-electric-quote nil
- "Non-nil makes insert of double quote use `` or '' depending on context."
+ "Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context."
:type 'boolean
:group 'scribe)
@@ -124,7 +124,7 @@ Interesting variables:
Non-nil makes Scribe mode use a different style of paragraph separation.
`scribe-electric-quote'
- Non-nil makes insert of double quote use `` or '' depending on context.
+ Non-nil makes insert of double quote use \\=`\\=` or \\='\\=' depending on context.
`scribe-electric-parenthesis'
Non-nil makes an open-parenthesis char (one of `([<{')
@@ -265,8 +265,8 @@ to skip backward."
(forward-char -1))
(defun scribe-insert-quote (count)
- "Insert ``, '' or \" according to preceding character.
-If `scribe-electric-quote' is non-nil, insert ``, '' or \" according
+ "Insert \\=`\\=`, \\='\\=' or \" according to preceding character.
+If `scribe-electric-quote' is non-nil, insert \\=`\\=`, \\='\\=' or \" according
to preceding character. With numeric arg N, always insert N \" characters.
Else just insert \"."
(interactive "P")
diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el
index 6c9ceb40692..251b72d38ec 100644
--- a/lisp/obsolete/spell.el
+++ b/lisp/obsolete/spell.el
@@ -1,8 +1,8 @@
;;; spell.el --- spelling correction interface for Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp, unix
;; Obsolete-since: 23.1
;; (not in obsolete/ directory then, but all functions marked obsolete)
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index ed2f3f3d8b6..de0b1d913ba 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -1,6 +1,6 @@
;;; sregex.el --- symbolic regular expressions
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Bob Glickstein <bobg+sregex@zanshin.com>
;; Maintainer: Bob Glickstein <bobg+sregex@zanshin.com>
@@ -262,15 +262,15 @@
This is exactly like `sregexq' (q.v.) except that it evaluates all its
arguments, so literal sregex clauses must be quoted. For example:
- (sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
+ (sregex \\='(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
An argument-evaluating sregex interpreter lets you reuse sregex
subexpressions:
- (let ((dotstar '(0+ any))
- (whitespace '(1+ (syntax ?-)))
- (digits '(1+ (char (?0 . ?9)))))
- (sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\""
+ (let ((dotstar \\='(0+ any))
+ (whitespace \\='(1+ (syntax ?-)))
+ (digits \\='(1+ (char (?0 . ?9)))))
+ (sregex \\='bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\""
(sregex--sequence exps nil))
(defmacro sregexq (&rest exps)
@@ -338,15 +338,15 @@ computed (i.e., non-constant) values in `sregexq' expressions. So
automatically quote its values. Literal sregex clauses must be
explicitly quoted like so:
- (sregex '(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
+ (sregex \\='(or \"Bob\" \"Robert\")) => \"Bob\\\\|Robert\"
but computed clauses can be included easily, allowing for the reuse
of common clauses:
- (let ((dotstar '(0+ any))
- (whitespace '(1+ (syntax ?-)))
- (digits '(1+ (char (?0 . ?9)))))
- (sregex 'bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\"
+ (let ((dotstar \\='(0+ any))
+ (whitespace \\='(1+ (syntax ?-)))
+ (digits \\='(1+ (char (?0 . ?9)))))
+ (sregex \\='bol dotstar \":\" whitespace digits)) => \"^.*:\\\\s-+[0-9]+\"
Here are the clauses allowed in an `sregex' or `sregexq' expression:
@@ -416,7 +416,7 @@ Here are the clauses allowed in an `sregex' or `sregexq' expression:
given set. See below for how to construct a CHAR-CLAUSE.
- the symbol `bot'
- Stands for \"\\\\`\", matching the empty string at the beginning of
+ Stands for \"\\\\\\=`\", matching the empty string at the beginning of
text (beginning of a string or of a buffer).
- the symbol `eot'
diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el
index 8df32dcd06d..c837eb3f94d 100644
--- a/lisp/obsolete/sup-mouse.el
+++ b/lisp/obsolete/sup-mouse.el
@@ -1,9 +1,9 @@
;;; sup-mouse.el --- supdup mouse support for lisp machines
-;; Copyright (C) 1985-1986, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2015 Free Software Foundation, Inc.
;; Author: Wolfgang Rupprecht
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 21 Nov 1986
;; Keywords: hardware
;; Obsolete-since: 24.4
diff --git a/lisp/obsolete/swedish.el b/lisp/obsolete/swedish.el
index 3fb3dbc2fff..0db7a364e6d 100644
--- a/lisp/obsolete/swedish.el
+++ b/lisp/obsolete/swedish.el
@@ -1,9 +1,9 @@
;;; swedish.el --- miscellaneous functions for dealing with Swedish
-;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: i18n
;; Obsolete-since: 22.1
diff --git a/lisp/obsolete/sym-comp.el b/lisp/obsolete/sym-comp.el
index bd049b85aa2..ac67963571c 100644
--- a/lisp/obsolete/sym-comp.el
+++ b/lisp/obsolete/sym-comp.el
@@ -1,6 +1,6 @@
;;; sym-comp.el --- mode-dependent symbol completion
-;; Copyright (C) 2004, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2008-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: extensions
@@ -165,9 +165,9 @@ Uses `symbol-completion-symbol-function' and
used something like this in a major mode which provides symbol
completion:
- (if (featurep 'hippie-exp)
- (set (make-local-variable 'hippie-expand-try-functions-list)
- (cons 'symbol-completion-try-complete
+ (if (featurep \\='hippie-exp)
+ (set (make-local-variable \\='hippie-expand-try-functions-list)
+ (cons \\='symbol-completion-try-complete
hippie-expand-try-functions-list)))"
(when (and symbol-completion-symbol-function
symbol-completion-completions-function)
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index 7f65d336899..f1a38d20f39 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -1,10 +1,10 @@
;;; terminal.el --- terminal emulator for GNU Emacs
-;; Copyright (C) 1986-1989, 1993-1994, 2001-2013 Free Software
+;; Copyright (C) 1986-1989, 1993-1994, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Obsolete-since: 24.4
;; Keywords: comm, terminals
@@ -291,7 +291,9 @@ Other chars following \"%s\" are interpreted as follows:\n"
;; not used.
(defun te-escape-extended-command-unread ()
(interactive)
- (setq unread-command-events (listify-key-sequence (this-command-keys)))
+ (setq unread-command-events
+ (nconc (listify-key-sequence (this-command-keys))
+ unread-command-events))
(te-escape-extended-command))
(defun te-set-escape-char (c)
diff --git a/lisp/emulation/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 1ec0ecc943c..d16cd274890 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -1,11 +1,12 @@
;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
-;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Version: 4.5
;; Keywords: emulations
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
@@ -647,7 +648,7 @@ GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
(make-variable-buffer-local 'tpu-mark-flag)
(defun tpu-set-mode-line (for-tpu)
- "Set ``minor-mode-alist'' for TPU-edt, or reset it to default Emacs."
+ "Set `minor-mode-alist' for TPU-edt, or reset it to default Emacs."
(let ((entries '((tpu-newline-and-indent-p tpu-newline-and-indent-string)
(tpu-rectangular-p tpu-rectangle-string)
(tpu-direction-string tpu-direction-string)
@@ -872,7 +873,7 @@ With argument, fill and justify."
(set-frame-width (selected-frame) width))
(defun tpu-toggle-newline-and-indent nil
- "Toggle between 'newline and indent' and 'simple newline'."
+ "Toggle between `newline-and-indent' and simple `newline'."
(interactive)
(cond (tpu-newline-and-indent-p
(setq tpu-newline-and-indent-string "")
@@ -1123,7 +1124,7 @@ if ARG is omitted or nil."
M-x help-for-help <CR> p <CR>
- Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'.
+ Where `M-x' might be any of `Gold-KP7', `Do', or `ESC-x'.
When you successfully invoke this part of the Emacs help facility, you
will see a buffer named `*Finder*' listing a number of topics. Look for
@@ -1312,7 +1313,7 @@ kill modified buffers without asking."
(if tpu-regexp-p "en" "dis"))))
(defun tpu-regexp-prompt (prompt)
- "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."
+ "Read a string, adding `RE ' to the prompt if tpu-regexp-p is set."
(let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt)))
(read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)))
@@ -2374,9 +2375,8 @@ If FILE is nil, try to load a default file. The default file names are
(goto-char (point-min))
(beep)
(and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
- (condition-case conditions
- (copy-file oldname newname)
- (error (message "Sorry, couldn't copy - %s." (cdr conditions)))))
+ (with-demoted-errors "Sorry, couldn't copy - %s."
+ (copy-file oldname newname)))
(kill-buffer "*TPU-Notice*")))
(defvar tpu-edt-old-global-values nil)
@@ -2439,8 +2439,7 @@ If FILE is nil, try to load a default file. The default file names are
(setq tpu-edt-mode nil))
-;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
-;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "ae3bca6f21640b5713a7c58c40f30847")
+;;;### (autoloads nil "tpu-extras" "tpu-extras.el" "cbbb448cff48fab904ac19805aa6f36a")
;;; Generated autoloads from tpu-extras.el
(autoload 'tpu-cursor-free-mode "tpu-extras" "\
diff --git a/lisp/emulation/tpu-extras.el b/lisp/obsolete/tpu-extras.el
index 7cdba4d6e6b..a71e45ea476 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/obsolete/tpu-extras.el
@@ -1,11 +1,12 @@
;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
-;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2015 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
;; Package: tpu-edt
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index bf14e58bde1..3115038999f 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -1,11 +1,12 @@
;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
-;; Copyright (C) 1993-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
;; Package: tpu-edt
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
@@ -80,7 +81,7 @@ suit your tastes (or to cope with those silly Sun and PC keypads).
Finally, you will be prompted for the name of the file to store the key
definitions. If you chose the default, TPU-edt will find it and load it
automatically. If you specify a different file name, you will need to
-set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
+set the variable `tpu-xkeys-file' before starting TPU-edt. Here's how
you might go about doing that in your init file.
(setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
diff --git a/lisp/vc/vc-arch.el b/lisp/obsolete/vc-arch.el
index f94e19271ee..e6540ce74d9 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -1,6 +1,6 @@
;;; vc-arch.el --- VC backend for the Arch version-control system -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -227,8 +227,11 @@ Only the value `maybe' can be trusted :-(."
(vc-file-setprop
file 'arch-root root)))))
-(defun vc-arch-register (files &optional rev _comment)
- (if rev (error "Explicit initial revision not supported for Arch"))
+(defun vc-arch-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (expand-file-name "{arch}" (vc-arch-root file)))
+
+(defun vc-arch-register (files &optional _comment)
(dolist (file files)
(let ((tagmet (vc-arch-tagging-method file)))
(if (and (memq tagmet '(tagline implicit)) comment-start)
@@ -258,10 +261,6 @@ Only the value `maybe' can be trusted :-(."
;; Strip the terminating newline.
(buffer-substring (point-min) (1- (point-max)))))))))
-(defun vc-arch-workfile-unchanged-p (_file)
- "Stub: arch workfiles are always considered to be in a changed state,"
- nil)
-
(defun vc-arch-state (file)
;; There's no checkout operation and merging is not done from VC
;; so the only operation that's state dependent that VC supports is commit
@@ -311,18 +310,19 @@ Only the value `maybe' can be trusted :-(."
'up-to-date
'edited)))))))))
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
+;; dir-status-files called from vc-dir, which loads vc,
+;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-arch-dir-status (dir callback)
- "Run 'tla inventory' for DIR and pass results to CALLBACK.
+(defun vc-arch-dir-status-files (dir _files callback)
+ "Run `tla inventory' for DIR and pass results to CALLBACK.
CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
`vc-dir-refresh'."
(let ((default-directory dir))
(vc-arch-command t 'async nil "changes"))
;; The updating could be done asynchronously.
- (vc-exec-after
- `(vc-arch-after-dir-status ',callback)))
+ (vc-run-delayed
+ (vc-arch-after-dir-status callback)))
(defun vc-arch-after-dir-status (callback)
(let* ((state-map '(("M " . edited)
@@ -397,7 +397,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(pcase (vc-state file)
((or `up-to-date `needs-update) ?-)
(`added ?@)
- (t ?:))
+ (_ ?:))
rev)))
(defun vc-arch-diff3-rej-p (rej)
@@ -437,8 +437,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(autoload 'vc-switches "vc")
-(defun vc-arch-checkin (files rev comment)
- (if rev (error "Committing to a specific revision is unsupported"))
+(defun vc-arch-checkin (files comment)
;; FIXME: This implementation probably only works for singleton filesets
(let ((summary (file-relative-name (car files) (vc-arch-root (car files)))))
;; Extract a summary from the comment.
@@ -449,7 +448,7 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--"
(vc-switches 'Arch 'checkin))))
-(defun vc-arch-diff (files &optional oldvers newvers buffer)
+(defun vc-arch-diff (files &optional oldvers newvers buffer async)
"Get a difference report using Arch between two versions of FILES."
;; FIXME: This implementation only works for singleton filesets. To make
;; it work for more cases, we have to either call `file-diffs' manually on
@@ -466,7 +465,6 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
(if newvers
(error "Diffing specific revisions not implemented")
(let* (process-file-side-effects
- (async (not vc-disable-async-diff))
;; Run the command from the root dir.
(default-directory (vc-arch-root file))
(status
@@ -493,8 +491,6 @@ CALLBACK expects (ENTRIES &optional MORE-TO-COME); see
"A wrapper around `vc-do-command' for use in vc-arch.el."
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-arch-program file flags))
-(defun vc-arch-init-revision () nil)
-
;;; Completion of versions and revisions.
(defun vc-arch--version-completion-table (root string)
diff --git a/lisp/obsolete/vc-mcvs.el b/lisp/obsolete/vc-mcvs.el
index 9f9bd7a0e76..d78f24bb1bb 100644
--- a/lisp/obsolete/vc-mcvs.el
+++ b/lisp/obsolete/vc-mcvs.el
@@ -1,6 +1,6 @@
;;; vc-mcvs.el --- VC backend for the Meta-CVS version-control system
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: None
diff --git a/lisp/emulation/vi.el b/lisp/obsolete/vi.el
index 9aae40c0d00..081b229ebca 100644
--- a/lisp/emulation/vi.el
+++ b/lisp/obsolete/vi.el
@@ -8,9 +8,12 @@
;; Author: Neal Ziring <nz@rsch.wisc.edu>
;; Felix S. T. Wu <wu@crys.wisc.edu>
;; Keywords: emulations
+;; Obsolete-since: 24.5
;;; Commentary:
+;; This file is obsolete. Consider using viper instead.
+
;; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring)
;; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu)
;; Last revision: 01/07/87 Wed (for GNU Emacs 18.33)
@@ -425,27 +428,27 @@ Major differences between this mode and real vi :
- Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are
not supported.
- Ex commands are not implemented; try ':' to get some hints.
- - No line undo (i.e. the 'U' command), but multi-undo is a standard feature.
+ - No line undo (i.e. the `U' command), but multi-undo is a standard feature.
* Modifications
- The stopping positions for some point motion commands (word boundary,
- pattern search) are slightly different from standard 'vi'.
+ pattern search) are slightly different from standard `vi'.
Also, no automatic wrap around at end of buffer for pattern searching.
- Since changes are done in two steps (deletion then insertion), you need
to undo twice to completely undo a change command. But this is not needed
for undoing a repeated change command.
- - No need to set/unset 'magic', to search for a string with regular expr
+ - No need to set/unset `magic', to search for a string with regular expr
in it just put a prefix arg for the search commands. Replace cmds too.
- ^R is bound to incremental backward search, so use ^L to redraw screen.
* Extensions
- Some standard (or modified) Emacs commands were integrated, such as
incremental search, query replace, transpose objects, and keyboard macros.
- - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to
+ - In command state, ^X links to the `ctl-x-map', and ESC can be linked to
esc-map or set undefined. These can give you the full power of Emacs.
- See vi-com-map for those keys that are extensions to standard vi, e.g.
`vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
- `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy.
+ `vi-mark-region', and `vi-quote-words'. Some of them are quite handy.
- Use \\[vi-switch-mode] to switch among different modes quickly.
Syntax table and abbrevs while in vi mode remain as they were in Emacs."
@@ -517,7 +520,7 @@ set sw=n M-x set-variable vi-shift-width n "
(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p)
"Go into insert state, the text entered will be repeated if REPETITION > 1.
If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T.
-In any case, the prefix-code will be done before each 'redo-insert'.
+In any case, the prefix-code will be done before each `redo-insert'.
This function expects `overwrite-mode' being set properly beforehand."
(if do-it-now-p (apply (car prefix-code) (cdr prefix-code)))
(setq vi-ins-point (point))
@@ -829,7 +832,7 @@ Possible prefix-arg cases are nil, INTEGER, (nil . CHAR) or (INTEGER . CHAR)."
(defun vi-goto-mark (mark-char &optional line-flag)
"Go to marked position or line (if line-flag is given).
-Goto mark '@' means jump into and pop the top mark on the mark ring."
+Goto mark `@' means jump into and pop the top mark on the mark ring."
(cond ((char-equal mark-char last-command-event) ; `` or ''
(exchange-point-and-mark) (if line-flag (back-to-indentation)))
((char-equal mark-char ?@) ; jump and pop mark
@@ -1197,7 +1200,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
(let ((aelt (assq char vi-mark-alist)))
(if aelt
(move-marker (cdr aelt) (point)) ; fixed 6/12/86
- (setq aelt (cons char (copy-marker (point))))
+ (setq aelt (cons char (point-marker)))
(setq vi-mark-alist (cons aelt vi-mark-alist))))))
(defun vi-find-matching-paren ()
@@ -1210,7 +1213,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
(defun vi-backward-blank-delimited-word (count)
"Backward COUNT blank-delimited words."
(interactive "p")
- (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count)
+ (if (re-search-backward "[ \t\n`][^ \t\n`]+" nil t count)
(if (not (bobp)) (forward-char 1))))
(defun vi-forward-blank-delimited-word (count)
diff --git a/lisp/emulation/vip.el b/lisp/obsolete/vip.el
index b32e6e7e35d..0c345e26f80 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/obsolete/vip.el
@@ -1,10 +1,11 @@
;;; vip.el --- a VI Package for GNU Emacs
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2013 Free Software
+;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Masahiko Sato <ms@sail.stanford.edu>
;; Keywords: emulations
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
@@ -23,6 +24,8 @@
;;; Commentary:
+;; This file is obsolete. Consider using viper instead.
+
;; A full-featured vi(1) emulator.
;;
;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
@@ -459,7 +462,8 @@ 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")
(let (com key (old-map (current-local-map)))
- (if events (setq unread-command-events events))
+ (if events (setq unread-command-events
+ (append events unread-command-events)))
(setq prefix-arg arg)
(use-local-map vip-emacs-local-map)
(unwind-protect
@@ -515,7 +519,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
- (setq unread-command-events (list char)))
+ (push char unread-command-events))
(defun vip-prefix-arg-com (char value com)
"Vi operator as prefix argument."
@@ -569,7 +573,7 @@ obtained so far, and COM is the command part obtained so far."
(while (= char ?U)
(vip-describe-arg prefix-arg)
(setq char (read-char)))
- (setq unread-command-events (list char)))
+ (push char unread-command-events))
;; as com is non-nil, this means that we have a command to execute
(if (or (= (car com) ?r) (= (car com) ?R))
;; execute appropriate region command.
diff --git a/lisp/emulation/ws-mode.el b/lisp/obsolete/ws-mode.el
index 03d7076195e..af637cacdb3 100644
--- a/lisp/emulation/ws-mode.el
+++ b/lisp/obsolete/ws-mode.el
@@ -1,10 +1,11 @@
;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
-;; Copyright (C) 1991, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2015 Free Software Foundation, Inc.
;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
;; Version: 0.7
;; Keywords: emulations
+;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
@@ -73,8 +74,7 @@
(define-key map "\C-x" 'save-buffers-kill-emacs)
(define-key map "y" 'ws-delete-block)
(define-key map "\C-y" 'ws-delete-block)
- map)
- "")
+ map))
(defvar wordstar-C-o-map
(let ((map (make-keymap)))
@@ -140,8 +140,7 @@
(define-key map "y" 'ws-kill-eol)
(define-key map "\C-y" 'ws-kill-eol)
(define-key map "\177" 'ws-kill-bol)
- map)
- "")
+ map))
(defvar wordstar-mode-map
(let ((map (make-keymap)))
@@ -170,17 +169,16 @@
(define-key map "\C-x" 'next-line)
(define-key map "\C-y" 'kill-complete-line)
(define-key map "\C-z" 'scroll-up-line)
- map)
- "")
+ map))
;; wordstar-C-j-map not yet implemented
-(defvar wordstar-C-j-map nil "")
+(defvar wordstar-C-j-map nil)
(put 'wordstar-mode 'mode-class 'special)
;;;###autoload
-(defun wordstar-mode ()
+(define-derived-mode wordstar-mode fundamental-mode "WordStar"
"Major mode with WordStar-like key bindings.
BUGS:
@@ -191,106 +189,7 @@ BUGS:
- Search and replace (C-q a) is only available in forward direction
No key bindings beginning with ESC are installed, they will work
-Emacs-like.
-
-The key bindings are:
-
- C-a backward-word
- C-b fill-paragraph
- C-c scroll-up-line
- C-d forward-char
- C-e previous-line
- C-f forward-word
- C-g delete-char
- C-h backward-char
- C-i indent-for-tab-command
- C-j help-for-help
- C-k ordstar-C-k-map
- C-l ws-repeat-search
- C-n open-line
- C-p quoted-insert
- C-r scroll-down-line
- C-s backward-char
- C-t kill-word
- C-u keyboard-quit
- C-v overwrite-mode
- C-w scroll-down
- C-x next-line
- C-y kill-complete-line
- C-z scroll-up
-
- C-k 0 ws-set-marker-0
- C-k 1 ws-set-marker-1
- C-k 2 ws-set-marker-2
- C-k 3 ws-set-marker-3
- C-k 4 ws-set-marker-4
- C-k 5 ws-set-marker-5
- C-k 6 ws-set-marker-6
- C-k 7 ws-set-marker-7
- C-k 8 ws-set-marker-8
- C-k 9 ws-set-marker-9
- C-k b ws-begin-block
- C-k c ws-copy-block
- C-k d save-buffers-kill-emacs
- C-k f find-file
- C-k h ws-show-markers
- C-k i ws-indent-block
- C-k k ws-end-block
- C-k p ws-print-block
- C-k q kill-emacs
- C-k r insert-file
- C-k s save-some-buffers
- C-k t ws-mark-word
- C-k u ws-exdent-block
- C-k C-u keyboard-quit
- C-k v ws-move-block
- C-k w ws-write-block
- C-k x kill-emacs
- C-k y ws-delete-block
-
- C-o c wordstar-center-line
- C-o b switch-to-buffer
- C-o j justify-current-line
- C-o k kill-buffer
- C-o l list-buffers
- C-o m auto-fill-mode
- C-o r set-fill-column
- C-o C-u keyboard-quit
- C-o wd delete-other-windows
- C-o wh split-window-right
- C-o wo other-window
- C-o wv split-window-below
-
- C-q 0 ws-find-marker-0
- C-q 1 ws-find-marker-1
- C-q 2 ws-find-marker-2
- C-q 3 ws-find-marker-3
- C-q 4 ws-find-marker-4
- C-q 5 ws-find-marker-5
- C-q 6 ws-find-marker-6
- C-q 7 ws-find-marker-7
- C-q 8 ws-find-marker-8
- C-q 9 ws-find-marker-9
- C-q a ws-query-replace
- C-q b ws-to-block-begin
- C-q c end-of-buffer
- C-q d end-of-line
- C-q f ws-search
- C-q k ws-to-block-end
- C-q l ws-undo
- C-q p ws-last-cursorp
- C-q r beginning-of-buffer
- C-q C-u keyboard-quit
- C-q w ws-last-error
- C-q y ws-kill-eol
- C-q DEL ws-kill-bol
-"
- (interactive)
- (kill-all-local-variables)
- (use-local-map wordstar-mode-map)
- (setq mode-name "WordStar")
- (setq major-mode 'wordstar-mode)
- (run-mode-hooks 'wordstar-mode-hook))
+Emacs-like.")
(defun wordstar-center-paragraph ()
diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el
index 0830d4248ef..39dd6a241f2 100644
--- a/lisp/obsolete/xesam.el
+++ b/lisp/obsolete/xesam.el
@@ -1,6 +1,6 @@
;;; xesam.el --- Xesam interface to search engines.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: tools, hypermedia
@@ -198,7 +198,7 @@ be different at least in one face property not set in that face."
"xesam:colorCount" "xesam:colorSpace" "xesam:columnCount" "xesam:comment"
"xesam:commentCharacterCount" "xesam:conflicts" "xesam:contactMedium"
"xesam:contactName" "xesam:contactNick" "xesam:contactPhoto"
- "xesam:contactURL" "xesam:contains" "xesam:contenKeyword"
+ "xesam:contactURL" "xesam:contains" "xesam:contentKeyword"
"xesam:contentComment" "xesam:contentCreated" "xesam:contentModified"
"xesam:contentType" "xesam:contributor" "xesam:copyright" "xesam:creator"
"xesam:definesClass" "xesam:definesFunction" "xesam:definesGlobalVariable"
@@ -378,7 +378,7 @@ If PROPERTY is not existing, retrieve it from ENGINE first."
(defun xesam-search-engines ()
"Return Xesam search engines, stored in `xesam-search-engines'.
The first search engine is the name owner of `xesam-service-search'.
-If there is no registered search engine at all, the function returns `nil'."
+If there is no registered search engine at all, the function returns nil."
(let ((services (dbus-ignore-errors
(dbus-list-queued-owners
:session xesam-service-search)))
diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el
index fb826d55866..908491d7370 100644
--- a/lisp/obsolete/yow.el
+++ b/lisp/obsolete/yow.el
@@ -1,8 +1,8 @@
;;; yow.el --- quote random zippyisms
-;; Copyright (C) 1993-1995, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 2000-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Author: Richard Mlynarik
;; Keywords: games
;; Obsolete-since: 24.4
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog.1
index 019fa8a358d..35e6ef1eccd 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog.1
@@ -1,3 +1,6809 @@
+2014-12-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ * org-clock.el (org-clock-save): Prefer (system-name) to system-name.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * org-archive.el (org-archive-subtree)
+ (org-archive-to-archive-sibling):
+ * org-clock.el (org-resolve-clocks, org-clock-get-sum-start)
+ (org-clock-special-range):
+ * org-timer.el (org-timer-seconds):
+ * org.el (org-read-date-analyze, org-get-cursor-date):
+ * ox-html.el (org-html-format-spec):
+ * ox-icalendar.el (org-icalendar--vtodo):
+ Omit unnecessary call to current-time.
+ * org-clock.el (org-clock-get-table-data): Omit unnecessary, lossy
+ conversion from floating point to Emacs time and back.
+ (org-resolve-clocks): Prefer two-argument floor.
+ * org-compat.el (org-float-time): Simplify to an alias because
+ time-to-seconds now behaves like float-time with respect to nil arg.
+ * org.el (org-get-cursor-date):
+ Don't call current-time twice to get the current time stamp,
+ as this can lead to inconsistent results.
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-12 Marco Wahl <marcowahlsoft@gmail.com>
+
+ * org-agenda.el (org-get-entries-from-diary):
+ Use `diary-fancy-display' instead of the obsolete
+ `diary-display-hook'.
+
+2014-10-12 Nicolas Goaziou <mail@nicolasgoaziou.fr>
+
+ * ox.el (org-export-async-start): Limit first argument to lambda
+ expressions.
+
+ * ox-publish.el (org-publish, org-publish-all)
+ (org-publish-current-file): Replace `ignore', per limit stated above.
+
+2014-10-12 Christopher Schmidt <ch@ristopher.com>
+
+ * org.el (orgstruct-make-binding): Do not use loop in interpreted code.
+
+2014-10-12 Mike McLean <mike.mclean@pobox.com> (tiny change)
+
+ * org-agenda.el (org-agenda-time-grid): Change docstring.
+
+2014-10-12 Nicolas Goaziou <mail@nicolasgoaziou.fr>
+
+ * ox.el (org-export-async-start): Allow to use symbols as function.
+
+2014-10-03 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * ob-sh.el (org-babel-sh-initiate-session): After initiating a
+ session, initialize the marker `comint-last-output-start' since it
+ is going to be used by the ANSI color filter without further
+ checks in Emacs 23 and throws an error.
+
+ * ob-lilypond.el: Change prefix from `ly-' to
+ `org-babel-lilypond-' throughout.
+
+ * org-footnote.el: Forward declare `org-element-context',
+ `org-element-property' and `org-element-type'.
+
+ * org.el: Add forward declarations for a number of functions that
+ the compiler otherwise warns about as potentially undefined at
+ runtime.
+
+ * ob-core.el: Add comment to forward declaration of
+ 'org-src-preserve-indentations'.
+
+ * ob-exp.el: Require org-src to import
+ 'org-src-preserve-indentations'.
+
+ * ob-haskell.el, ob-python.el: Remove superfluous forward
+ declaration of 'org-src-preserve-indentations', since it gets
+ imported by other requires.
+
+ * ob-core.el (org-every): Forward declare 'org-every'.
+
+ * ob-C.el: Require cl during compilation so that lexical-let is
+ known.
+
+ * org-entities.el: Remove superfluous require of org-macs.
+ Forward declare 'org-toggle-pretty-entities' and
+ 'org-pretty-entities'.
+
+ * ox.el (org-export-get-parent): Move definition of
+ 'org-export-get-parent' before first use. Leave comment at original
+ place of definition.
+
+ * org.el (org-uniquify): Move definition of 'org-uniquify' before
+ first use. Leave comment at original place of definition.
+
+ * ob-tangle.el (org-babel-tangle): When `file-name-directory'
+ returns nil, do not run make-directory. Remove superfluous when
+ clauses by using short-circuiting `and' instead.
+
+2014-10-03 Alex Kosorukoff <alex@3form.com> (tiny change)
+
+ * org-capture.el (org-capture-fill-template): Set `mark-active' to
+ nil.
+
+2014-10-03 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-prepare): Reset preset filters when
+ using sticky agendas.
+
+ * org-agenda.el (org-agenda-get-sexps): Don't add tags as text
+ properties.
+
+ * org-capture.el (org-capture-fill-template):
+ Take `org-extend-today-until' into account when setting the format time
+ string.
+
+ * org.el (org-paste-subtree): Fix match subexpression.
+
+ * org.el (org-fix-ellipsis-at-bol): Delete.
+ (org-mode, org-show-context, org-isearch-end): Don't use
+ `org-fix-ellipsis-at-bol'.
+
+ * org-agenda.el (org-agenda-filter-apply): Fix setting of
+ `org-agenda-filtered-by-category'.
+
+ * org.el (org-fontify-meta-lines-and-blocks-1): Fix handling
+ of `org-hidden-keywords'.
+
+ * org-agenda.el (org-cmp-ts): Fix agenda entry type checking.
+
+ * org-agenda.el (org-entries-lessp): Fix inactive timestamp
+ comparison.
+
+ * org-agenda.el (org-agenda-mode): Let `org-agenda-redo' DTRT
+ when agenda are sticky.
+ (org-agenda-tag-filter-while-redo): Delete.
+ (org-agenda-list, org-agenda-redo, org-agenda-filter-by-tag):
+ Remove unused code.
+ (org-agenda-clockreport-mode, org-agenda-set-mode-name):
+ Don't consider tag filters.
+
+ * org.el (org-fix-ellipsis-at-bol)
+ (org-first-headline-recenter): Use `set-window-start' instead
+ of `recenter'.
+
+ * org-agenda.el (org-recenter-heading): Delete.
+
+ * org.el (org-insert-heading): With one universal prefix argument
+ or `org-insert-heading-respect-content' set to `t', always respect
+ the content, i.e. don't insert a list item and don't convert
+ normal lines into headings. Update docstring.
+ (org-insert-heading-respect-content): Remove unused arg.
+ (org-insert-todo-heading-respect-content): Don't use
+ `org-insert-todo-heading-respect-content', use the second argument
+ of `org-insert-todo-heading' instead.
+
+ * org-mobile.el (org-mobile-edit): Use only one arg.
+
+ * org.el (org-overview): Don't call `recenter'.
+
+ * org-agenda.el (org-agenda-custom-commands-local-options):
+ Fix misquoted values.
+
+ * org.el (org-property-re): Also match null properties by default.
+ (org-entry-delete): Also delete null properties.
+ (org-read-property-value): Allow the empty string as a new value.
+ (org-delete-property): Throw a message when there is not property
+ to delete.
+
+ * org-agenda.el (org-agenda-insert-diary-make-new-entry):
+ Fix docstring.
+
+ * org.el (org-re-property): New parameter `allow-null' to match
+ property with a null value.
+ (org-entry-put): Correctly update a property with a null
+ value.
+
+ * ox-md.el (org-md-headline): When exporting with a HTML table of
+ contents, add HTML anchors to Markdown headlines.
+
+ * org.el (org-insert-heading): Don't insert an item when called
+ with two universal prefix arguments.
+
+ * org-agenda.el (org-agenda-finalize): Remove duplicate check for
+ 'org-hd-marker.
+
+ * org-agenda.el (org-agenda-prepare-window): New parameter
+ `filter-alist' to set the filters correctly when
+ `org-agenda-persistent-filter' is on.
+ (org-agenda-prepare): Use the new parameter for
+ `org-agenda-prepare-window'.
+
+ * org-compat.el (org-in-invisibility-spec-p): Tiny code cleanup.
+ (org-move-to-column): Only remove '(org-filtered) from
+ `buffer-invisibility-spec'.
+
+ * org-agenda.el (org-agenda-mode): Add buffer invisibility specs.
+ (org-agenda-filter-hide-line, org-agenda-remove-filter):
+ Set the 'invisible text property to 'org-filtered.
+ (org-agenda-show-new-time): Add the default face to avoid the
+ foreground of the last character on the line to leak into the
+ timestamp notification.
+
+ * org-agenda.el (org-get-time-of-day): Don't return time string
+ from within links.
+
+ * org-timer.el (org-timer-value-string): Always return a positive
+ value. Add docstring.
+
+ * org-capture.el (org-capture-steal-local-variables): Don't steal
+ `mark-active', which should be nil in the target buffer.
+
+ * org-agenda.el (org-agenda-remove-filter): Use `save-excursion'.
+
+ * org.el (org-move-subtree-down): Use `org-end-of-subtree' instead
+ of `outline-end-of-subtree'.
+ (outline-end-of-subtree): Remove advice.
+
+ * org-mouse.el (org-mouse-move-tree, org-mouse-do-remotely):
+ Use `org-end-of-subtree' instead of `outline-end-of-subtree'.
+
+ * org-agenda.el (org-cmp-ts): Argument `type' is not optional.
+ Don't quote it.
+
+ * org-habit.el (org-habit-insert-consistency-graphs): Don't remove
+ filter overlays as we don't use overlays for filters anymore.
+
+ * org-agenda.el (org-agenda-local-vars):
+ Add `org-agenda-top-headline-filter'.
+ (org-agenda-filter-by-category): Fix syntax.
+ (org-agenda-filter-show-all-top-filter): New function.
+ (org-agenda-filter-by-top-headline)
+ (org-agenda-filter-remove-all): Use the new function.
+ (org-agenda-filter-top-headline-apply): Use a dedicated symbol
+ `top-headline'.
+
+ * org.el (org-entry-properties): Ensure the special property is
+ not commented out when matched.
+
+ * org-agenda.el (org-agenda-write): Code cleanup.
+ (org-agenda-mark-filtered-text)
+ (org-agenda-unmark-filtered-text)
+ (org-agenda-fix-tags-filter-overlays-at): Delete.
+ (org-agenda-remove-marked-text): Use the `property' argument
+ instead of hard-coding 'org-filtered.
+ (org-agenda-filter-remove-all): Use `org-agenda-finalize'.
+ (org-agenda-filter-hide-line): Rewrite using text properties
+ instead of overlays.
+ (org-agenda-remove-filter): New function.
+ (org-agenda-filter-show-all-tag)
+ (org-agenda-filter-show-all-cat)
+ (org-agenda-filter-show-all-re): Rewrite using
+ `org-agenda-remove-filter'.
+
+ * org-attach.el (org-attach-dir): When the property is "inherited"
+ from a variable outside of the file, do not use
+ `org-entry-property-inherited-from' to find the attachment
+ position, assume we need to go back to the current headline.
+
+ * ob-R.el (org-babel-R-assign-elisp): Fix parsing of a
+ one-dimensional value.
+
+ * org.el (org-insert-heading): Fix bug when trying to insert a
+ heading when point is before the first headline and not at the
+ beginning of a line.
+
+ * org-table.el (org-table-eval-formula): Fix conversion of
+ inactive timestamps to active ones.
+
+ * org.el (org-set-regexps-and-options):
+ Allow `org-complex-heading-regexp-format' to match [/] and [%] cookies
+ when they are both before and after the heading.
+
+ * org-agenda.el (org-agenda-max-todos, org-agenda-max-tags)
+ (org-agenda-max-effort): Fix type strings.
+
+ * org-capture.el (org-capture-fill-template): Deactivate region
+ while trying to align tags on the current headline.
+
+ * org-agenda.el (org-agenda-finalize): Filter by top headline if
+ `org-agenda-top-headline-filter' is set.
+
+2014-10-03 Bernt Hansen <bernt@norang.ca>
+
+ * org-macs.el: Remove restriction when locating markers.
+
+2014-10-03 Dmitry Gorbik <dgorbik@me.com> (tiny change)
+
+ * org.el (org-fast-tag-selection): Fix window splitting.
+
+2014-10-03 Eric Schulte <schulte.eric@gmail.com>
+
+ * ob-screen.el (org-babel-screen-test): Use unpredictable name for
+ temporary file.
+
+ * ob-screen.el (org-babel-screen-session-write-temp-file):
+ Use unpredictable temp file name, fixes bug#17416.
+
+2014-10-03 Ian Kelling <ian@iankelling.org>
+
+ * ob-core.el (org-babel-insert-result): Test all list elements
+ against listp and (eq element 'hline) instead of checking just the
+ first.
+
+2014-10-03 Konstantin Kliakhandler <kosta@slumpy.org> (tiny change)
+
+ * org-agenda.el (org-agenda-redo): Reapply the filters correctly.
+
+2014-10-03 Kyle Meyer <kyle@kyleam.com> (tiny change)
+
+ * ox.el (org-export-show-temporary-export-buffer): Fix typo.
+
+2014-10-03 Matt Lundin <mdl@imapmail.org>
+
+ * ox-publish.el (org-publish-find-title, org-publish-find-date):
+ Make sure to call org-export-get-environment in copy of buffer if
+ emacs is already visiting. Otherwise, #+bind variables meant for
+ export can be set in live buffers.
+
+ * org.el (org-agenda-inhibit-startup): fix docstring to reflect
+ default value
+
+ * ox-publish.el (org-publish-find-title, org-publish-find-date):
+ Fix unnecessary invocations of org-mode with org-inhibit-startup.
+
+2014-10-03 Nick Dokos <ndokos@gmail.com>
+
+ * org-table.el (org-table-clean-before-export): The regexes match
+ spaces in addition to the special characters that might be used in
+ the first column as special marking characters. Remove the space
+ from the character class.
+
+ * ox-ascii.el (org-ascii-superscript): Change _ to ^ in the
+ output.
+
+2014-10-03 Nick Dokos <ndokos@redhat.com>
+
+ * org-table.el (org-table-show-reference): Call `set-window-start'
+ with the calculated values `min' and `max', not with
+ (point-min) and (point-max).
+
+2014-10-03 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ox-latex.el (org-latex-link): Improve test for unnumbered
+ headlines.
+
+ * ox-ascii.el (org-ascii--fill-string): Allow filling even when
+ `org-export-preserve-breaks' is non-nil.
+
+ * org.el (org-N-empty-lines-before-current): Make sure to delete
+ only empty lines, not trailing whitespaces.
+
+ * ox-html.el (org-html-headline): Make sure even listified
+ headlines have proper anchors so internal links can refer to them.
+ Small refactoring.
+
+ * org-src.el (org-edit-src-code): Fix regexp.
+ (org-edit-src-exit): Do not remove auto-save timer. This is
+ handled by the timer itself.
+
+ * org.el (org-re-property): Fix regexp. Improve docstring.
+
+ * org-element.el (org-element-property-drawer-parser)
+ (org-element-node-property-parser): Ignore lines that are not node
+ properties.
+ (org-element-node-property-interpreter): Allow nil properties.
+
+ * org.el (org-re-property): Fix regexp to match properties with
+ empty values.
+
+ * org-element.el (org-element-headline-interpreter): Take into
+ consideration `org-odd-levels-only' value. Small refactoring.
+
+ * ox-texinfo.el (org-texinfo--get-node): Return a node or anchor
+ name.
+ (org-texinfo--sanitize-content): Fix regexp.
+ (org-texinfo-link): Fix various bugs in link export.
+
+ * ox-beamer.el (org-beamer-link):
+ * ox-html.el (org-html-link):
+ * ox-latex.el (org-latex-link):
+ * ox-odt.el (org-odt-link): When radio link has no valid
+ target (e.g., this is a subtree export and the radio target is not
+ in the exported subtree), simply return contents.
+
+ * org.el (org-called-with-limited-levels): Initialize variable.
+
+ * org-agenda.el (org-agenda-write): Write headings in proper
+ order.
+
+ * org-element.el (org-element-table-interpreter):
+ Enhance docstring.
+
+ * ox-md.el (org-md-link): Allow custom link type export function.
+
+ * ox-texinfo.el (org-texinfo-template): Fix language and encoding
+ case.
+
+ * ox-md.el (org-md-separate-elements): Outside of lists, preserve
+ blank lines between paragraphs and plain lists.
+
+ * org-element.el (org-element-normalize-contents): Fix indentation
+ removal when there is an empty line within a verse block.
+
+ * ox-texinfo.el (org-texinfo--normalize-headlines): Properly add a
+ section to the contents.
+
+ * ox-texinfo.el (org-texinfo--normalize-headlines): Do not set pre
+ blanks since the value is now hard-coded.
+ (org-texinfo-headline): Force one blank line before contents, when non
+ empty. Refactoring.
+ (org-texinfo-src-block): Refactor code. Comply to predicate naming.
+
+ * ox-texinfo.el (org-texinfo--sanitize-node):
+ Handle " (not)allowed" case.
+
+ * ox-texinfo.el (org-texinfo-headline): Remove wrong code
+ comments.
+
+ * ox-texinfo.el (org-texinfo-headline): Remove `not-in-toc'
+ special case for tags.
+
+ * ox-texinfo.el (org-texinfo-headline): Remove LaTeXism (optional
+ arguments within square brackets).
+
+ * ox-texinfo.el (org-texinfo-info-process): Fix docstring.
+ (org-texinfo-compile): Do not check for impossible cases (e.g., if the
+ previous variable contains a function).
+
+ * ox-texinfo.el (org-texinfo-max-toc-depth): Fix docstring.
+
+ * ox-texinfo.el (org-texinfo--make-option-string,
+ org-texinfo--sanitize-headline,
+ org-texinfo--sanitize-headline-contents): Remove.
+
+ * ox-texinfo.el (org-texinfo--sanitize-node): "@", "{" and "}"
+ characters are allowed in a node name. So are "(" and ")" unless
+ "(" starts the name and there is ")" somewhere in the name.
+ Also trim and collapse whitespace characters. Renamed from
+ `org-texinfo--sanitize-menu'.
+ (org-texinfo--get-node): Do not sanitize node names over zealously.
+ Ensure returned node names are unique.
+ (org-texinfo-headline): Only add @node command where it makes sense.
+
+ * ox-texinfo.el (org-texinfo--sanitize-menu)
+ (org-texinfo--sanitize-content): Fix docstrings.
+
+ * ox-texinfo.el (org-texinfo--normalize-headlines): Make sure a
+ blank line always follows nodes.
+
+ * ox-texinfo.el (org-texinfo-make-menu): Change signature.
+ Remove some intermediate functions. Generate the full master menu when
+ asked.
+ (org-texinfo--build-menu): Use a simpler algorithm.
+ (org-texinfo--format-entries): Fix entries when both node and title
+ are different.
+ (org-texinfo--menu-entries): Rename from `org-texinfo--generate-menu-list'.
+ (org-texinfo-headline): Move menu handling to next function.
+ (org-texinfo-section): Handle menu for current parent.
+ (org-texinfo--menu-headlines, org-texinfo--generate-detailed):
+ Remove functions.
+ (org-texinfo--normalize-headlines): New function.
+
+ * ox-texinfo.el (org-texinfo-headline): Fix @appendix command.
+
+ * ox-texinfo.el (org-texinfo-headline): Do not sanitize heading
+ text for sectioning command.
+
+ * ox-texinfo.el (org-texinfo--generate-menu-list): ":COPYING: nil"
+ is expected to be equivalent to no COPYING property at all.
+
+ * ox-texinfo.el (org-texinfo-item): Fix blank lines between items.
+
+ * ox-texinfo.el (org-texinfo-plain-list): Fix format string.
+ Small refactoring.
+
+ * ox-texinfo.el (texinfo): Provide new export property.
+ (org-texinfo-template): Use dedicated title for hard copy, when
+ available.
+
+ * ox-texinfo.el (org-texinfo-headline): Always obey to a non-nil
+ :APPENDIX: property. Small refactoring.
+
+ * ox-texinfo.el (org-texinfo-verse-block): Generate somewhat
+ meaningful Texinfo code instead of LaTeX.
+
+ * ox-texinfo.el (org-texinfo-table): Remove reference to
+ "verbatim" attribute. Handle table.el tables. Tiny refactoring.
+ (org-texinfo-table--org-table, org-texinfo-table--table.el-table):
+ Remove functions.
+ (org-texinfo-table-column-widths): Indent code correctly. Ignore
+ special column, if any. Add a comment about the limitation on the
+ width computation.
+ (org-texinfo-table-row): Small refactoring.
+
+ * ox-texinfo.el (texinfo): Do not provide a default value for
+ @setfilename value.
+ (org-texinfo-filename): Remove variable.
+ (org-texinfo-template): Correctly find value for @setfilename command.
+ If none is possible, do not provide the command at all.
+
+ * ox.el (org-export-to-file): Provide output file name in
+ communication channel, through :output-file property.
+
+ * ox-texinfo.el (org-texinfo-template): Do not hardcode "Manual"
+ in top node.
+
+ * ox-texinfo.el (org-texinfo-classes): Change default value.
+ Update docstring.
+ (org-texinfo-template): Insert header string from current class after
+ "@settitle" command. Always provide "\input texinfo" at the beginning
+ of the output.
+
+ * ox-texinfo.el (org-texinfo-template): Remove spurious blank
+ lines in output. Refactor code.
+
+ * ox-texinfo.el (org-texinfo-template): Fix multi-line subtitles.
+
+ * ox-texinfo.el (org-texinfo-template): Make sure table of
+ contents are allowed before inserting them.
+
+ * ox-texinfo.el (org-texinfo-template): Check if copying data is
+ not nil before using it.
+
+ * ox-texinfo.el (org-texinfo-template): Fix multi-line subauthors.
+ Correctly add email, when provided. Check if author info is
+ wanted first.
+
+ * ox-texinfo.el (org-texinfo-node-description-column)
+ (org-texinfo-format-drawer-function): Fix docstrings.
+
+ * ox-texinfo.el (texinfo): Make sure comments are ignored.
+ (org-texinfo-comment, org-texinfo-comment-block): Remove functions.
+
+ * ox-texinfo.el (org-texinfo-template): Properly pad @direntry
+ description.
+
+ * org-element.el (org-element-headline-parser): Add missing
+ `:post-blank' property in docstring.
+
+ * ox-latex.el (org-latex-table-scientific-notation):
+ Set appropriate value.
+ (org-latex-listings-options): Fix docstring.
+
+ * ox.el (org-export-raw-special-block-p): New function.
+
+ * org-element.el (org-element-link-parser): Properly handle
+ multi-line links according to RFC 3986 when enclosed within square
+ brackets.
+
+ * org-element.el (org-element-parse-secondary-string): Clone all
+ local variables from current buffer before parsing a secondary
+ string. Small refactoring.
+ (org-element-object-variables): Remove variable.
+
+ * ox-odt.el (org-odt--format-paragraph): Change signature to
+ include info.
+ (org-odt-footnote-reference, org-odt-paragraph): Apply signature
+ change.
+
+ * org-clock.el (org-clocktable-indent-string): Use "\emsp" instead
+ of "\__", which is not supported anymore since Org 8.0.
+
+ * ox-odt.el (org-odt--paragraph-style): New function.
+ (org-odt--format-paragraph): Use new function to get proper style
+ to apply.
+
+ * org-element.el (org-element--current-element): Fix regexp.
+
+ * org-element.el (org-element--current-element): Fix regexp
+ matching latex environments. Discrepancy with regexp used in
+ `org-element-latex-environment-parser' introduced matching errors.
+
+ * ox-ascii.el (org-ascii--table-cell-width): Correctly export
+ tables with width cookies.
+
+ * org.el (org-insert-heading): Fix error when inserting a headline
+ before first headline, with point not at bol. Remove source block
+ check for consistency with behavior after first headline.
+ Tiny fix to docstring.
+
+ * org.el (org-scan-tags): Fix typo in docstring.
+
+ * ox.el (org-export--get-inbuffer-options): Return the empty
+ string instead of nil when TITLE keywords has no value.
+ (org-export--get-buffer-attributes): Do not set :title property
+ early.
+ (org-export--get-global-options): Do not ignore anymore nil values.
+ Small refactoring.
+ (org-export-as): Correctly set :title here.
+
+ * org-list.el (org-list-repair): Fix typo in docstring.
+
+ * ox-ascii.el (org-ascii--current-text-width): Tiny fix.
+
+ * ox-org.el (org-org-section): Tiny refactoring. Use appropriate
+ property.
+
+ * ox-org.el (org-org-headline): Ignore footnote sections.
+ (org-org-section): New function.
+
+ * ox-beamer.el (org-beamer-select-environment): Ignore persistent
+ tags when displaying environments.
+
+ * ox-ascii.el (org-ascii-indented-line-width): Update docstring.
+ (org-ascii-paragraph): Do not apply indentation to the very first line
+ of a section.
+
+ * ox-latex.el (org-latex-inlinetask): Skip body if contents are
+ empty.
+
+ * ox-html.el (org-html-standalone-image-p): Ensure paragraph
+ contains at least a link before return a non-nil value.
+ Clarify docstring.
+
+ * ox.el (org-export-data): Always return a string, as specified
+ by the docstring.
+
+ * ox-ascii.el (org-ascii--indent-string): Fix regexp to avoid
+ stack overflow in regexp matcher on very long lines.
+
+ * org-element.el (org-element-timestamp-parser): Fix docstring.
+
+ * ox-icalendar.el (org-icalendar-include-sexps,
+ org-icalendar-blocked-headline-p): Fix docstrings.
+ (org-icalendar-clear-blank-lines): Fix docstring and regexp.
+
+ * ox-icalendar.el (org-icalendar-entry):
+ Use `org-icalendar-with-timestamps'.
+
+2014-10-03 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * org.el (org-cycle-internal-local): Don't show a trailing
+ character when cycling a subtree that ends with a non-newline
+ character at the end of the buffer or the narrowed region.
+
+2014-10-03 Sebastien Vauban <sva-news-D0wtAvR13HarG/iDocfnWg@public.gmane.org>
+
+ * ox-ascii.el (org-ascii--box-string): Choose more universal
+ Unicode characters for boxquote corners.
+
+2014-10-03 Marco Wahl <marcowahlsoft@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-bulk-mark)
+ (org-agenda-bulk-mark-regexp, org-agenda-bulk-toggle-all):
+ Fix org-agenda-bulk-mark-all when time-grid is shown.
+
+2014-06-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * org-compat.el (activate-mark): Set transient-mark-mode buffer-locally.
+
+2014-06-22 Mario Lang <mlang@delysid.org>
+
+ * org-list.el (org-list-insert-item): The the -> the.
+
+ * org-bibtex.el (org-bibtex-fields): The the -> the.
+
+2013-06-22 Dmitry Antipov <dmantipov@yandex.ru>
+
+ * ob-core.el (org-babel-insert-result): Prefer point-min-marker
+ and point-max-marker.
+ * org-mouse.el (org-mouse-do-remotely): Prefer point-marker
+ to copy-marker of point.
+
+2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * org-compat.el (org-font-lock-ensure): New function.
+ * ox-odt.el (org-odt-do-format-code):
+ * ox-html.el (org-html-fontify-code):
+ * org.el (org-fontify-like-in-org-mode):
+ * org-src.el (org-src-font-lock-fontify-block):
+ * org-clock.el (org-clock-get-clocktable): Use it.
+ * ox-org.el (org-org-publish-to-org): Use it. Avoid using find-file
+ from Elisp.
+
+2014-05-12 Eric Schulte <eric.schulte@gmx.com>
+
+ * ob-screen.el (org-babel-screen-session-write-temp-file)
+ (org-babel-screen-test):
+ Use unpredictable names for temporary files. (Bug#17416)
+
+2014-04-22 Aaron Ecay <aaronecay@gmail.com>
+
+ * org-src.el (org-edit-src-exit): Place an undo boundary before
+ writing changes back to parent buffer.
+
+2014-04-22 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * ob-gnuplot.el (org-babel-gnuplot-process-vars):
+ `org-babel-gnuplot-table-to-data´ expects a table, so we need to
+ construct one when Babel hands us a vector.
+
+ * ob-ref.el (org-babel-ref-parse):
+ If `org-babel-current-src-block-location' is a marker, it can be from
+ another buffer, use marker-position instead in this case.
+
+2014-04-22 Arun Persaud <apersaud@lbl.gov> (tiny change)
+
+ * org-src.el (org-edit-src-exit): Don't add indentation on empty lines.
+
+2014-04-22 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-insert-heading): Fix behavior when point is at the
+ beginning of a heading or a list item. Enhance docstring.
+
+ * ox-html.el (org-html-infojs-install-script): Don't install
+ infojs scripts when #+INFOJS_OPT: is empty.
+
+ * org.el (org-mode): Fix the use of `org-*-element' functions for
+ C-M-a and C-M-e but fix C-M-e.
+
+ * org-agenda.el (org-agenda-search-view): Fix tag.
+
+ * org.el (org-check-before-invisible-edit): Don't just cycle, show
+ the subtree, as cycling may leave the current heading folded.
+ (org-contextualize-validate-key): Fix wrong test.
+
+ * org-bibtex.el (org-bibtex-headline): Don't throw an error when
+ trying to add a keyword field to a BibTeX entry that is not known
+ by BibTeX or defined by the user.
+ (org-bibtex, org-bibtex-no-export-tags): Fix docstrings.
+
+ * ox-latex.el (org-latex-src-block): Fix wrong propagation of
+ labels and captions when using the listings environment.
+
+ * org.el (org-sort-entries): Fix the number of blank lines to
+ keep for the last entry to sort.
+
+ * org-clock.el (org-clock-put-overlay): Fix display when
+ `org-indent-mode' is on.
+
+ * org.el (org-sort-entries): Allow to sort by clocking time.
+
+ * org-agenda.el (org-agenda-finalize): Apply all filters
+ correctly.
+
+ * org.el (org-update-dblock): Use `save-excursion' instead of
+ `save-window-excursion' so that blocks can edit other windows and
+ change the window layout.
+
+ * org-agenda.el (org-agenda-mode): Disable `indent-tabs-mode'.
+ (org-agenda-dim-blocked-tasks): Make overlays intangible.
+ (org-agenda-show-new-time): Fix bug when deleting a timestamp
+ right after changing it.
+ (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)
+ (org-agenda-get-sexps, org-agenda-filter-by-regexp)
+ (org-agenda-filter-top-headline-apply): Fix indentation.
+
+ * org.el (org-cycle): Try `org-try-cdlatex-tab' before trying
+ to edit/move as in a table.
+
+ * org-agenda.el (org-agenda-show-new-time): Don't use
+ `move-beginning-of-line' as it is slower and not needed.
+
+ * org-compat.el (org-move-to-column): Temporarily set
+ `buffer-invisibility-spec' more accurately.
+
+ * ox-latex.el (org-latex-text-markup-alist): Use \ul{...} for
+ underlining instead of \uline{...} as requiring the hyperref
+ package makes \uline{...} unusable on headline.
+
+ * org.el (org-latex-default-packages-alist): Add the "soul"
+ package.
+
+ * org.el (org-refresh-properties): Don't add the property to
+ the whole subtree, only to the part between the beginning of
+ the headline and the end of the "content", before any other
+ headline. This fix a bug about properties displayed as
+ inherited in the agenda, where Org properties are checked
+ against text properties.
+
+ * ox-latex.el (org-latex--text-markup): Replace newlines by
+ whitespaces in \verb constructs.
+
+ * org-agenda.el (org-agenda-filter-hide-line): Hide from the
+ beginning of the line to the beginning of the next line.
+ (org-agenda-show-new-time): Use `move-beginning-of-line' and
+ `move-end-of-line'.
+ (org-agenda-drag-line-forward): Adapt to the new definition of
+ hidden filtered lines.
+
+ * org-compat.el (org-move-to-column): Always ignore invisible
+ text in agenda buffer, and when there is both a bracket link
+ and '(org-link) as a member of `buffer-invisibility-spec'.
+ Add a docstring.
+
+ * org.el (org-align-tags-here): Add docstring and remove useless
+ arguments when calling `org-move-to-column'.
+
+ * org-table.el (org-table-copy-down)
+ (org-table-find-dataline, org-table-move-row)
+ (org-table-insert-hline, org-table-kill-row):
+ * org-agenda.el (org-agenda-next-item)
+ (org-agenda-previous-item, org-agenda-todo)
+ (org-agenda-priority, org-agenda-show-new-time)
+ (org-agenda-clock-in, org-agenda-clock-out): Remove useless
+ arguments when calling `org-move-to-column'.
+
+ * org.el (org-refile): Fix calling with a numeric prefix argument
+ of 3 to refile and keep.
+
+ * org-clock.el (org-clock-get-table-data): When :link is `t' in
+ the clocktable parameters, bracket links in the clocktable should
+ only contain their description, other C-c C-o will try to open the
+ bracket link at point instead of the headline.
+
+ * org-agenda.el (org-agenda-todo): Always restore the window state
+ after `org-agenda-change-all-lines' has been called.
+ (org-agenda-open-link): Don't throw an error when trying to open a
+ link when the point is on a place that is not associated with a
+ buffer.
+
+ * ox-latex.el (org-latex-link): Escape `%' characters.
+
+ * org.el (org-entry-get-with-inheritance): Remove wrong quote.
+ (org-entry-get): Only try to combine file properties with local
+ properties when the property drawer contains such local property,
+ not when the property drawer exists.
+
+ * ox-latex.el (org-latex-link):
+ * ox-html.el (org-html-link):
+ * ox-beamer.el (org-beamer-link): Fix links to radio targets.
+
+ * ox-ascii.el (org-ascii-link): For links to a radio target, use
+ the link, not the target.
+
+ * org.el (org-do-emphasis-faces): Explicitly prevent nested
+ emphasis.
+ (org-insert-heading): Don't remove whitespaces following an empty
+ headline.
+
+ * org-timer.el (org-timer-stop): Set `org-timer-current-timer' to
+ nil.
+
+ * org.el (org-store-link): Ensure desc is not nil before matching
+ a regexp against it. Fall back on an empty string when no
+ description is available.
+
+ * org-agenda.el (org-agenda-list-stuck-projects): Bugfix: set
+ `org-agenda-buffer-name'.
+
+ * org-capture.el (org-capture-finalize): Ensure to widen the
+ buffer when the target buffer is not initially narrowed.
+
+ * org-compat.el (org-move-to-column): Fix bug about ignoring
+ bracket links visibility status in tables with S-RET.
+
+ * org-src.el (org-edit-src-find-region-and-lang): Check if we are
+ in a table.el table last.
+
+ * org.el (org-delete-property): Don't suggest to delete the
+ CATEGORY property when the category is not explicitly set in the
+ property drawer. Also enforce matching when completing.
+ (org-insert-heading): Fix regression: with two universal prefixes,
+ insert heading at the end of the subtree.
+ (org-insert-todo-heading): Bugfix: only enforce the first TODO
+ state when arg is '(4).
+
+ * org-agenda.el (org-agenda-skip-subtree-if): Fix docstring.
+
+ * org.el (org-contextualize-validate-key): Fix bug: perform the
+ check even when (buffer-file-name) returns `nil'.
+
+ * org-colview.el (org-columns-display-here): Let-bind `fm'.
+
+ * org.el (org-emphasis-alist): Use `org-verbatim' for =text=
+ and `org-code' for ~text~.
+ (org-open-link-marker): Fix typo in docstring.
+
+ * org-colview.el (org-columns-display-here): Fix the column
+ view for numbers with a format specifier (e.g. {+; %5.1f}).
+
+ * org-src.el (org-edit-src-code): Throw a warning instead of
+ an error when loading the mode fails, otherwise the user is
+ left with unusable buffers.
+
+ * org-table.el (org-table-copy-down)
+ (org-table-find-dataline, org-table-move-row)
+ (org-table-insert-hline, org-table-kill-row):
+ Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so
+ that abbreviated rows don't interfer with setting the cursor back
+ at the correct position.
+
+ * org.el (org-agenda-prepare-buffers): Use `save-excursion'
+ instead of `save-window-excursion'.
+ (org-file-contents): Return an empty string instead of the
+ message.
+ (org-open-at-point): Fix bug when opening a plain link followed by
+ a bracket link.
+ (org-ctrl-c-ctrl-c): Fix behavior when hitting C-c C-c on LaTeX
+ formulas in tables.
+ (org-refile--get-location): New internal function using a wider
+ set of possible refile locations.
+ (org-refile-get-location): Use it.
+ (org-refile): Fix bug when refiling the last subtree of the
+ buffer: don't leave out the last character.
+ (org-sort-entries): Restore the point location when there is
+ nothing to sort.
+
+ * org-table.el (org-table-field-info): Throw a user error when not
+ at a table.
+
+ * org-agenda.el (org-agenda-drag-line-forward):
+ Call `org-agenda-mark-clocking-task' when done.
+ (org-agenda-mark-clocking-task): Small refactoring.
+
+ * org-compat.el (org-set-transient-map): Alias pointing at
+ `set-transient-map' if defined, at `set-temporary-overlay-map'
+ otherwise.
+
+ * org-agenda.el (org-agenda-next-item)
+ (org-agenda-previous-item, org-agenda-toggle-archive-tag)
+ (org-agenda-todo, org-agenda-priority, org-agenda-clock-in)
+ (org-agenda-clock-out): Put the cursor back on the correct
+ column, when possible.
+ (org-agenda-todo): When `org-clock-out-when-done' is `t', also
+ remove the current clock overlay.
+
+ * org.el (org-format-latex-options): Fix docstring.
+
+ * ox.el (org-export--get-subtree-options): When using the headline
+ as a title for a subtree export, only take the true heading, no
+ TODO keyword, no priority cookie, no tag.
+
+ * org.el (customize-package-emacs-version-alist): Fix Org version
+ for Emacs 24.4.
+
+ * org.el (org-demote): Ignore invisible text when aligning tags.
+ (org-set-tags): When JUST-ALIGN is 'ignore-column, ignore
+ invisible text when restoring the cursor to the correct column.
+
+ * ob-python.el (org-babel-python-var-to-python): Bugfix: Strip
+ properties before formatting the results.
+
+ * org-agenda.el (org-agenda-regexp-filter-preset): Fix typo in
+ docstring.
+ (org-agenda-reapply-filters): New function.
+ (org-agenda-drag-line-forward): Rewrite to fix a bug when used
+ in filtered agendas.
+ (org-agenda-drag-line-backward): Rewrite using
+ `org-agenda-drag-line-forward'.
+
+ * ob-table.el (org-sbe): Rename from `sbe'.
+
+ * org.el (org-store-link): When a link has been stored, always
+ returns it.
+
+ * ob-python.el (org-babel-python-var-to-python): Fix code typo.
+
+ * org-entities.el (org-entities-help): Prevent the display of
+ pretty entities, as this help buffer is meant to list literal
+ strings, not utf-8 representations.
+
+2014-04-22 Benjamin Drieu <bdrieu@april.org>
+
+ * org.el (org-store-link): Fix selection of the function to store
+ the link.
+
+2014-04-22 Ilya Shlyakhter <ilya_shl@alum.mit.edu>
+
+ * org.el (org-entry-get-with-inheritance): Temporarily let-bind
+ `org-file-properties', `org-global-properties' and
+ `org-global-properties-fixed' to nil before calling
+ `org-entry-get' on entries up the hierarchy from the queried
+ entry.
+
+2014-04-22 Justin Gordon <justin.gordon@gmail.com>
+
+ * ox-md.el (org-md-separate-elements): Fix blank line insertion
+ between elements.
+
+ * ox-md.el (org-md-inner-template): New function.
+
+2014-04-22 Leonard Randall <leonard.a.randall@gmail.com> (tiny change)
+
+ * org-bibtex.el (org-bibtex-headline): Fix insertion of keywords
+ of unknown BibTeX entries.
+
+2014-04-22 Markus Hauck <markus1189@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-get-scheduled):
+ If `org-agenda-skip-scheduled-if-deadline-is-shown' is set to
+ 'repeated-after-deadline, still show tasks without any deadline
+
+2014-04-22 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org-table.el (org-table-fix-formulas): Handle multiple #+TBLFM
+ lines with `forward-line'.
+
+2014-04-22 Michael Weylandt <michael.weylandt@gmail.com> (tiny change)
+
+ * ox-latex.el (org-latex-export-to-latex): Downcase the language
+ name when using minted highlighting for src block exports.
+
+2014-04-22 Nick Dokos <ndokos@gmail.com>
+
+ * org-mobile.el (org-mobile-create-index-file): delete :grouptags
+ entries from tags list when creating the org-mobile index file.
+
+2014-04-22 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ox.el (org-export-copy-to-kill-ring): Comply to docstrings
+ standards.
+
+ * org.el (org-sparse-tree): Fix code typo. Small refactoring.
+
+ * ox-latex.el (org-latex-link):
+ * ox-html.el (org-html-link): Do not expand absolute file names
+ and do not try to fix hierarchy part, as it is already taken care of
+ at the parser level.
+
+ * ox-md.el (org-md-link): Ditto. Also fix absolute file names.
+
+ * ox-odt.el (org-odt-link):
+ * ox-man.el (org-man-link):
+ * ox-texinfo.el (org-texinfo-link):
+ * org-element.el (org-element-link-parser): Fix ill-defined "file"
+ type links. Expand absolute file names in the process.
+
+ * org.el (org-make-link-regexps): Use `regexp-opt' instead of
+ `mapconcat' and `regexp-quote'.
+
+ * ox-html.el (org-html-link):
+ * ox-latex.el (org-latex-link):
+ * ox-man.el (org-man-link):
+ * ox-odt.el (org-odt-link):
+ * ox-html.el (org-html-link):
+ * ox-latex.el (org-latex-link):
+ * ox-man.el (org-man-link):
+ * ox-odt.el (org-odt-link):
+ * ox-texinfo.el (org-texinfo-link): Append "//" after some link
+ types.
+
+ * ox-md.el (org-md-link):
+ * org.el (org-make-link-regexps): Allow optional double slashes
+ after type. Small refactoring.
+
+ * org-element.el (org-element-headline-parser): Tiny refactoring.
+
+ * org-element.el (org-element-headline-parser): Correctly parse
+ blank lines after a headline.
+
+ * org-element.el (org-element-table-cell-parser)
+ (org-element-table-cell-successor): Recognize cell even when last
+ vertical bar is missing.
+
+ * ox-md.el (org-md-example-block): handle switches and references
+ in source blocks.
+
+ * org.el (org-latex-packages-alist)
+ (org-latex-default-packages-alist): Update docstrings.
+
+ * ox-ascii.el (org-ascii--unique-links): Ignore white spaces when
+ uniquifying links in section.
+
+ * ox-odt.el (org-odt-template): Ignore blank titles.
+
+ * ox-publish.el (org-publish-find-title): Fix (invalid-read-syntax
+ "#").
+
+ * ox-ascii.el (org-ascii-link):
+ * ox-beamer.el (org-beamer-link):
+ * ox-html.el (org-html-link):
+ * ox-latex.el (org-latex-link):
+ * ox-md.el (org-md-link):
+ * ox-odt.el (org-odt-link): Update radio target export according
+ to recent changes.
+
+ * org-element.el (org-element-all-successors)
+ (org-element-object-restrictions): Prioritize `link' over other
+ successors in order to find radio links starting with another
+ syntax object (e.g., an entity). Also allow text markup within
+ radio targets.
+ (org-element-link-parser): Add contents to radio targets.
+
+ * org.el (org-make-target-link-regexp): Fix regexp so it can match
+ targets starting with an Org object (e.g., an entity).
+ (org-ctrl-c-ctrl-c): Fix function when applied on an object contained
+ within a radio target.
+
+ * org.el (org-mode): Change "\" and "~" characters syntax from
+ `punctuation' to `symbol' so they are on par with other characters
+ used in Org syntax (e.g., "/", "*"...).
+
+ * ox-beamer.el (org-beamer-publish-to-pdf):
+ * ox-latex.el (org-latex-publish-to-pdf): Ensure ".tex" file is
+ generated in the same directory as the ".org" file.
+
+ * ox-latex.el (org-latex-headline): Hard-code "\underline" in
+ sections because "\uline" ("ulem" package) returns an error and
+ "\ul" ("soul" package) doesn't support chinese characters.
+
+ * ox-ascii.el (org-ascii-link): Correctly handle case mismatch
+ between radio targets and radio links.
+
+ * org-element.el (org-element-link-parser): "radio" links have
+ their path downcased to avoid introducing case mismatch with their
+ relative radio target. With this change it is also necessary to
+ add contents to them, since `:path' property no longer matches
+ real value of the link.
+ (org-element-radio-target-parser): Downcase value as explained
+ above. Store the initial value in a new `:raw-value' property.
+
+ * org-element.el (org-element-context): Fix parsing of bold
+ objects at the beginning of a headline.
+
+ * org-element.el (org-element-context): Fix timestamps parsing.
+
+ * ox-beamer.el (org-beamer-item): Insert the export snippet right
+ after the first \item, not all of them.
+
+ * org-element.el (org-element--list-struct): Fix regexp.
+
+ * org-element.el (org-element-inlinetask-parser): Fix parsing when
+ regular and degenerate inlinetasks are mixed in the section.
+
+ * ox-md.el (org-md-link): Generate md links to other Org files
+ instead of html links. Do not confuse caption and alt-text.
+ Provide "img" as default alt-text.
+
+ * org-element.el (org-element-normalize-contents): Do not ignore
+ empty lines when an object follows.
+ (org-element-interpret-data): Do not remove properties by
+ side-effect when interpreting a string, as it also removes them
+ from the parse tree, making the string unusable without its
+ :parent property.
+
+ * ob-exp.el (org-babel-exp-process-buffer): Also check
+ `org-src-preserve-indentation' to know when to preserve indentation.
+ (org-babel-exp-code-template): Include switches in template.
+ (org-babel-exp-code): Provide %switches placeholder.
+
+ * ox-latex.el (org-latex-plain-list): Do not automatically
+ enclose value for :options attribute within square brackets.
+ Instead, append them verbatim next to the block name, as special
+ blocks do.
+
+ * ob-exp.el (org-babel-exp-code): Fix export of src blocks with
+ flags.
+ (org-babel-exp-process-buffer): Make processing more robust when
+ results are inserted before source block or when source block is
+ followed by multiple blank lines.
+
+ * ox.el (org-export-insert-default-template): Only insert
+ keywords and options relatives to the selected back-end.
+ Ignore those relatives to its parent in the case of a derived back-end.
+
+ * ox-beamer.el: Remove unnecessary package definitions in default
+ class.
+
+ * ox-latex.el (org-latex-headline, org-latex-item): Fix items
+ starting with a square bracket.
+
+ * org.el (org-mode-restart): Fix turning off `org-indent-mode'
+ when necessary.
+ (org-get-previous-line-level): Do not call `org-current-level'
+ twice unless necessary. Also, avoid using `line-number-at-pos'
+ when the information needed is to know if point is in the first
+ line of the visible part of the buffer.
+
+ * ob-core.el (org-babel-get-inline-src-block-matches): Do not
+ compute line number if all is needed is to know if we're on the
+ first one.
+
+ * ox-md.el (org-md-item): Do not return an error when exporting
+ an empty item.
+
+ * ox-beamer.el (org-beamer-select-environment): Function doesn't
+ work if fast tag selection is disabled, so make sure it is always
+ on, independently on user's configuration.
+
+2014-04-22 Nikolai Weibull <now@disu.se> (tiny change)
+
+ * org.el (org-mode): Add guard around set-face-foreground.
+
+2014-04-22 Rasmus <w530@pank.eu>
+
+ * ox-html.el (org-html-html5-elements): Drop reference to hgroup.
+
+2014-04-22 Rick Frankel <rick@rickster.com>
+
+ * ox-html.el (org-html-link): Unescape org-escaped links an
+ re-escape for html (browser).
+
+2014-04-22 Sacha Chua <sacha@sachachua.com>
+
+ * org.el (org-refresh-properties): Don't throw an error when
+ reaching the end of the buffer.
+
+2014-04-22 Stefan-W. Hahn <stefan.hahn@s-hahn.de> (tiny change)
+
+ * org-bibtex.el (org-bibtex-read): Check string length before
+ using aref.
+
+2014-04-22 Yasushi SHOJI <yashi@atmark-techno.com>
+
+ * ox-ascii.el (org-ascii--current-text-width): Convert `length'
+ to `string-width'.
+ (org-ascii--build-title, org-ascii--build-toc)
+ (org-ascii--list-listings, org-ascii--list-tables)
+ (org-ascii-template--document-title)
+ (org-ascii-inner-template, org-ascii-format-inlinetask-default)
+ (org-ascii-format-inlinetask-default, org-ascii-item
+ (org-ascii--table-cell-width, org-ascii-table-cell)
+ (org-ascii--current-text-width): Likewise.
+
+2014-02-25 Glenn Morris <rgm@gnu.org>
+
+ * org-version.el (org-odt-data-dir):
+ Remove incorrect, duplicate definition. (Bug#16734)
+
+2014-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * org-irc.el (org-irc-ellipsify-description): Rename from
+ org-irc-elipsify-description. All uses changed.
+
+2013-01-07 Bastien Guerry <bzg@gnu.org>
+
+ * org-clock.el (org-clock-cancel-hook)
+ (org-clock-leftover-time): Fix typo in docstring.
+
+ * ox-odt.el (org-odt--frame): Add a draw:name property to the
+ draw:frame tag.
+ (org-odt-format-label): Don't use short-caption at all.
+
+ * org-rmail.el (org-rmail-follow-link): Don't raise an error when
+ no article is matched.
+
+ * org.el (org-set-tags): Ignore invisible text when restoring
+ cursor position.
+ (org-refile-get-location): Check for a refile position when the
+ position is not nil, otherwise allow to create the parent node if
+ the user requests it.
+ (org-refile-allow-creating-parent-nodes): Fix typo in
+ docstring.
+ (org-entry-get): Minor docstring enhancement.
+ (org-set-startup-visibility): Bugfix.
+ (org-shiftcontrolup, org-shiftcontroldown):
+ When `org-support-shift-select' is not `nil', let-bind it to nil if
+ point is on a clock log. Otherwise throw an error.
+
+ * ob-lob.el (org-babel-lob-files): Fix custom type.
+ (org-babel-lob-ingest): Small docstring fix.
+
+ * org-agenda.el (org-cmp-ts): Fix bug: interpret `late' as
+ `later than any date' instead of `later than today'.
+
+ * org.el (org-do-emphasis-faces): Handle false positives by
+ restarting the re-search one char after the beginning of the
+ match, not one char before its ending.
+ (org-entry-put): Check that the value provided is a string. If it
+ is nil, convert it to the empty string.
+
+ * ob-latex.el (org-babel-latex-htlatex-packages): Use repeat
+ instead of list as the defcustom type.
+
+ * ox.el (org-export-with-creator):
+ * org.el (org-loop-over-headlines-in-active-region)
+ (org-mouse-1-follows-link, org-provide-todo-statistics):
+ * org-agenda.el (org-agenda-custom-commands-local-options)
+ (org-agenda-start-with-log-mode)
+ (org-agenda-show-inherited-tags): Don't quote const values.
+
+ * ox-texinfo.el (org-texinfo-def-table-markup):
+ * org-inlinetask.el (org-inlinetask-show-first-star):
+ * ob-maxima.el (org-babel-maxima-command): Add type.
+
+ * org-table.el (org-table-fix-formulas): Handle multiple
+ #+tblfm: lines.
+
+ * ox.el (org-export-to-file): Fix typo in docstring.
+
+ * org.el (org-self-insert-command)
+ (orgtbl-self-insert-command): Change the value of the
+ `delete-selection' property to allow other commands like
+ `electric-pair-will-use-region' to be run before deletion.
+
+ * org-attach.el (vc-git): Require.
+ (org-attach-commit): Check whether git is installed.
+
+2013-01-07 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ox-icalendar.el (org-icalendar--combine-files): Make sure
+ anniversaries do not end up in *Message* buffer instead of the ICS
+ file.
+
+ * ox-html.el: Clean up "FIXME" comments.
+
+ * ox-publish.el (org-publish-resolve-external-fuzzy-link):
+ Fix docstring.
+
+ * ox.el (org-export-smart-quotes-regexps): Fix smart quote
+ detection when it is followed by an open parenthesis syntax class.
+
+ * org-element.el (org-element-inline-babel-call-successor):
+ Use original regexp to stay up-to-date with Babel changes.
+ (org-element--affiliated-re): Fix affiliated keyword regexp.
+
+ * ox-org.el (org-org-identity): Since back-end specific keywords
+ are stripped from output, also remove attr_backend keywords.
+ (org-babel-exp-process-buffer): Fix duplicate evaluation with
+ :wrap src.
+ (org-babel-exp-non-block-elements): Remove function.
+
+2013-01-07 Ted Wiles <thewiles@wharton.upenn.edu> (tiny change)
+
+ * org-habit.el (org-habit-parse-todo): Match all TODO keywords,
+ not just "TODO".
+
+2013-01-07 Miguel Ruiz <rbenit68@yahoo.es> (tiny change)
+
+ * ob-gnuplot.el (org-babel-gnuplot-quote-tsv-field): Fix code
+ typo.
+
+2013-01-07 Vladimir Lomov <lomov.vl@gmail.com> (tiny change)
+
+ * ox-html.el (org-html-style-default): New classes caption.t-above
+ and caption.t-bottom.
+ (org-html-table): Use new classes.
+
+2013-12-23 Chong Yidong <cyd@gnu.org>
+
+ * org.el (orgstruct-make-binding): Call set-transient-map instead
+ of old name set-temporary-overlay-map.
+
+2013-12-06 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * org-crypt.el: Declare `epg-context´.
+ (org-encrypt-string): Correct indentation.
+
+ * org.el (org-version): Replace `_version´ by `version1´.
+
+2013-12-06 Alexander Vorobiev <alexander.vorobiev@gmail.com> (tiny change)
+
+ * org-compat.el (org-get-x-clipboard): Use w32-get-clipboard-data
+ to get the clipboard data under Windows.
+
+2013-12-06 Bastien Guerry <bzg@gnu.org>
+
+ * ox.el (org-export-with-sub-superscripts):
+ * org.el (org-use-sub-superscripts): Fix version and enhance
+ docstring again.
+
+ * ox.el (org-export-with-sub-superscripts):
+ * org.el (org-use-sub-superscripts): Enhance docstrings.
+
+ * org-macs.el (org-autoload): Delete.
+
+ * org-docview.el ("docview"): Fix declarations and require
+ doc-view directly.
+
+ * org-id.el (org-id-copy)
+ (org-id-get-with-outline-path-completion)
+ (org-id-get-with-outline-drilling, org-id-new):
+
+ * org-colview.el:
+ (org-colview-initial-truncate-line-value)
+ (org-columns-open-link, org-string-to-number):
+ * org-clock.el:
+ (org-clock-put-overlay, org-count-quarter, org-clock-loaded):
+ * org-archive.el (org-get-local-archive-location):
+ * org-agenda.el (org-agenda-todo-custom-ignore-p):
+ Autoload.
+
+ * org.el (org-return-follows-link):
+ * ob-python.el (org-babel-python-command): Don't use :set.
+
+ * ox-odt.el (org-odt-content-template-file): Fix version.
+
+ * ox-texinfo.el (org-texinfo-filename): Fix default value.
+ (org-texinfo-format-headline-function): Use 'ignore as the
+ default value.
+ (org-texinfo-format-drawer-function): Use a function as the
+ default value. Update docstring.
+ (org-texinfo-drawer): Always use
+ `org-texinfo-format-drawer-function' as it is now a function
+ by default.
+ (org-texinfo-headline):
+ Compare `org-texinfo-format-headline-function' against 'ignore.
+ (org-texinfo-inlinetask):
+ Compare `org-texinfo-format-inlinetask-function' against 'ignore.
+
+ * ox-odt.el (org-odt-format-drawer-function): Use a function as
+ the default value. Update docstring.
+ (org-odt-format-headline-function)
+ (org-odt-format-inlinetask-function): Fix default value.
+ (org-odt-drawer): Always use `org-odt-format-drawer-function'
+ as it is now a function by default.
+ (org-odt-format-headline--wrap):
+ Compare `org-odt-format-headline-function' against 'ignore.
+
+ * ox-latex.el (org-latex-format-drawer-function): Use a function
+ as the default value. Update docstring.
+ (org-latex-format-inlinetask-function): Fix default value.
+ (org-latex-drawer): Always use
+ `org-latex-format-drawer-function' as it is now a function by
+ default.
+ (org-latex-inlinetask):
+ Compare `org-latex-format-inlinetask-function' against 'ignore.
+
+ * ox-html.el (org-html-format-drawer-function): Use a function as
+ the default value. Update docstring.
+ (org-html-format-headline-function)
+ (org-html-format-inlinetask-function): Fix default value.
+ (org-html--format-toc-headline)
+ (org-html-format-headline--wrap):
+ Compare `org-html-format-headline-function' against 'ignore.
+ (org-html-inlinetask):
+ Compare `org-html-format-inlinetask-function' against 'ignore.
+
+ * ox-ascii.el (org-ascii-format-drawer-function): Use a
+ function as the default value. Update docstring.
+ (org-ascii-drawer): Always use
+ `org-ascii-format-drawer-function' as it is now a function by
+ default.
+ (org-ascii-format-inlinetask-default): New function.
+ (org-ascii-format-inlinetask-function):
+ Use `org-ascii-format-inlinetask-default' as the default.
+
+ * org.el (org-mouse-1-follows-link): Use :set to set the default
+ value. Update custom type.
+ (org-log-note-headings): Fix order or list items in the custom
+ type.
+ (orgstruct-heading-prefix-regexp): Use an empty string as the
+ default value. Use 'regexp as the custom type.
+ (orgstruct-make-binding): Tiny docstring enhancement.
+ Assume `orgstruct-heading-prefix-regexp' is a string.
+
+ * org-agenda.el (org-agenda-search-view-max-outline-level):
+ Set default value to 0. Update docstring.
+ (org-agenda-deadline-leaders): Fix custom type.
+ (org-search-view):
+ Assume `org-agenda-search-view-max-outline-level' is a number.
+
+ * ob-ruby.el (org-babel-ruby-nil-to): Fix custom type.
+
+ * ob-python.el (org-babel-python-mode): Use :set to set the
+ default value.
+ (org-babel-python-None-to): Fix custom type.
+
+ * ob-plantuml.el (org-plantuml-jar-path): Fix default value.
+ (org-babel-execute:plantuml): Assume `org-plantuml-jar-path' is a
+ string.
+
+ * ob-latex.el (org-babel-latex-htlatex): Fix default value.
+ (org-babel-latex-htlatex-packages): Fix custom type.
+ (org-babel-execute:latex): Assume `org-babel-latex-htlatex' is a
+ string.
+
+ * ox-odt.el (org-odt-display-outline-level): Fix version.
+
+ * ox-odt.el (org-odt-inline-formula-rules)
+ (org-odt-inline-image-rules, org-odt-use-date-fields): Add version
+ and package-version.
+
+ * ox-html.el (org-html-format-drawer-function)
+ (org-html-format-headline-function)
+ (org-html-format-inlinetask-function)
+ (org-html-creator-string): Add version and package-version.
+
+ * ox-html.el (org-html-text-markup-alist): Fix version.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Autoload.
+
+ * ob-calc.el (org--var-syms): Rename from `var-syms'.
+
+ * ob-lilypond.el (ly-compile-lilyfile): Remove redundant
+ let-binding.
+
+ * ob-table.el (sbe): Move debug declaration.
+
+ * org-clock.el (org--msg-extra): Rename from `msg-extra'.
+
+2013-12-06 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * org.el (org-ctrl-c-ctrl-c): When point is on an unsupported
+ object, look for something to do at a higher level instead of
+ bailing out.
+
+ * ox-html.el (org-html-format-latex): Add an argument. Ensure
+ latex header is the same as specified in the original buffer when
+ exporting a LaTeX fragment or environment.
+ (org-html-latex-environment, org-html-latex-fragment):
+ Apply signature change.
+
+ * ox-publish.el (org-publish-cache-ctime-of-src): Return an error
+ when publishing a non-existent file.
+
+ * org-element.el (org-element-paragraph-separate): More accurate
+ regexp.
+
+ * org.el (org-entry-get): Widen buffer in order to retrieve
+ properties, as `org-entry-properties' and
+ `org-entry-get-with-inheritance' already do.
+
+ * ox-html.el (org-html--format-toc-headline): Add missing headline
+ number in TOC entries.
+
+ * org.el (org-entry-properties): Ignore narrowing when retrieving
+ current headline properties.
+
+2013-12-06 Thierry Volpiatto <thierry.volpiatto@gmail.com> (tiny change)
+
+ * org-crypt.el (org-encrypt-string, org-encrypt-entry)
+ (org-decrypt-entry): Fix warning.
+
+2013-11-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes.
+ * ob-python.el (org-babel-python-with-earmuffs):
+ Rename from org-babel-python-with-earmufs. All uses changed.
+ (org-babel-python-without-earmuffs):
+ Rename from org-babel-python-without-earmufs. All uses changed.
+
+2013-11-12 Bastien Guerry <bzg@gnu.org>
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Autoload.
+
+2013-11-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Address some byte-compiler warnings.
+ * ob-calc.el (org--var-syms): Rename from `var-syms'.
+ * ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding.
+ * ob-table.el (sbe): Move debug declaration.
+ * org-clock.el (org--msg-extra): Rename from `msg-extra'.
+ * org.el (org-version): Avoid var name starting with _.
+ (org-inhibit-startup, org-called-with-limited-levels)
+ (org-link-search-inhibit-query, org-time-was-given)
+ (org-end-time-was-given, org-def, org-defdecode, org-with-time):
+ * org-colview.el (org-agenda-overriding-columns-format):
+ * org-agenda.el (org-agenda-multi, org-depend-tag-blocked)
+ (org-agenda-show-log-scoped):
+ * ob-python.el (py-which-bufname, python-shell-buffer-name):
+ * ob-haskell.el (org-export-copy-to-kill-ring):
+ * ob-exp.el (org-link-search-inhibit-query):
+ * ob-R.el (ess-eval-visibly-p):
+ * ob-core.el (org-src-window-setup): Declare before use.
+ (org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'.
+ * ox-odt.el (org-odt-hfy-face-to-css):
+ * org-src.el (org-src-associate-babel-session, org-src-get-lang-mode):
+ * org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex)
+ (org-bibtex-check):
+ * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string)
+ (org-babel-tangle-single-block, org-babel-tangle-comment-links):
+ * ob-table.el (sbe):
+ * ob-sqlite.el (org-babel-sqlite-expand-vars):
+ * ob-sql.el (org-babel-sql-expand-vars):
+ * ob-shen.el (org-babel-execute:shen):
+ * ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate):
+ * ob-scala.el (org-babel-scala-evaluate):
+ * ob-ruby.el (org-babel-ruby-table-or-string)
+ (org-babel-ruby-evaluate):
+ * ob-python.el (org-babel-python-table-or-string)
+ (org-babel-python-evaluate-external-process)
+ (org-babel-python-evaluate-session):
+ * ob-picolisp.el (org-babel-execute:picolisp):
+ * ob-perl.el (org-babel-perl-evaluate):
+ * ob-maxima.el (org-babel-execute:maxima):
+ * ob-lisp.el (org-babel-execute:lisp):
+ * ob-java.el (org-babel-execute:java):
+ * ob-io.el (org-babel-io-evaluate):
+ * ob-haskell.el (org-babel-execute:haskell):
+ * ob-fortran.el (org-babel-execute:fortran):
+ * ob-exp.el (org-babel-exp-code):
+ * ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
+ * ob-ditaa.el (org-babel-execute:ditaa):
+ * ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash)
+ (org-babel-parse-header-arguments, org-babel-reassemble-table)
+ (org-babel-goto-src-block-head, org-babel-mark-block)
+ (org-babel-expand-noweb-references, org-babel-script-escape)
+ (org-babel-process-file-name):
+ * ob-clojure.el (org-babel-execute:clojure):
+ * ob-calc.el (org-babel-execute:calc):
+ * ob-awk.el (org-babel-execute:awk):
+ * ob-R.el (org-babel-expand-body:R):
+ * ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...).
+
+2013-11-12 Glenn Morris <rgm@gnu.org>
+
+ * ox-html.el (org-html-scripts): Add 2013 to copyright years.
+ (org-html-infojs-template): Copyright holder to FSF.
+
+2013-11-12 Aaron Ecay <aaronecay@gmail.com>
+
+ * ox-latex.el (org-latex-inline-image-rules): Add "svg" to
+ supported filetypes.
+ (org-latex--inline-image): Implement SVG files inclusion.
+ (org-latex-headline): Don’t insert alternate title if identical to
+ regular one.
+
+ * ob-python.el: Update the arglist passed to `declare-function'
+ for `run-python'.
+
+ * ob-tangle.el (org-babel-tangle): Use `light' argument to
+ `org-babel-get-src-block-info'.
+
+ * ob-core.el (org-babel-execute-src-block): Return nil in case of
+ `:results none'. Also run `org-babel-after-execute-hook' in this
+ circumstance.
+
+ * org-id.el (org-id-locations-save): Bind print-(level,length) to
+ nil in this function.
+
+ * ob-R.el (org-babel-R-graphics-devices): New defvar.
+ (org-babel-R-construct-graphics-device-call): Use it instead of a
+ hard-coded list of graphics devices.
+
+ * ob-core.el (org-babel-when-in-src-block): New macro.
+ (org-babel-execute-src-block-maybe)
+ (org-babel-expand-src-block-maybe)
+ (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.
+
+ * ob-exp.el (org-export-babel-evaluate): Add a 'inline-only
+ option.
+ (org-babel-exp-results): Implement 'inline-only for
+ `org-export-babel-evaluate'.
+
+ * org.el (org-edit-special): Use prefix arg.
+
+ * ob-awk.el (org-babel-expand-body:awk, ob-picolisp.el)
+ (org-babel-expand-body:picolisp): Remove optional arg.
+
+ * ob-R.el (org-babel-R-initiate-session): Handle case where the
+ session buffer exists, but does not have a live process.
+ (org-babel-R-construct-graphics-device-call): Change file
+ extension of tikz graphics files to .tikz.
+
+ * org-src.el (org-edit-src-exit): Don't modify the undo list when
+ inserting the code.
+
+ * ox-latex.el (org-latex-plain-text): Properly escape "~" for
+ LaTeX export.
+ (org-latex-image-default-option): Change default value to "".
+ (org-latex-image-default-width, org-latex-image-default-height):
+ New variables.
+ (org-latex-inline-image-rules): Make .tikz files as exportable
+ with LaTeX.
+ (org-latex--inline-image): Support tikz images. Also support
+ separate :width and :height parameters for images.
+
+ * org-bibtex.el (org-bibtex-ask): Use `visual-line-mode' instead
+ of longlines-mode.
+
+2013-11-12 Abdó Roig-Maranges <abdo.roig@gmail.com>
+
+ * org.el (org-format-latex): Do not re-generate a LaTeX preview if
+ the image already exists.
+
+ * org-agenda.el (org-agenda-search-view-max-outline-level):
+ New option to define the max level for the entries shown by the search
+ view. A value of 1 means to show the top parent of the entries.
+
+ * org.el (org-create-formula-image-with-dvipng): Fix bug that made
+ this function fail with no :foreground and :background attributes
+ set, due to bad handling of "Transparent" color. Fix bug when
+ colors are not `default'.
+ (org-format-latex-options): Add `auto' to docstring.
+ (org-format-latex): Get face colors at point and put them inside
+ opt.
+ (org-create-formula-image-with-imagemagick): Fix bug when handling
+ "Transparent" bg color.
+ (org-dvipng-color-format): Same as `org-latex-color-format' for
+ dvipng-style color specification.
+
+2013-11-12 Achim Gratz <Stromeko@Stromeko.DE>
+
+ * ob-core.el (org-babel-check-confirm-evaluate): Return result of
+ evaluating the function pointed to by `org-confirm-babel-evaluate'
+ when it is a functionp and its value as a variable otherwise.
+ (org-babel-get-rownames, org-table.el)
+ (org-table-transpose-table-at-point): Replace the inadvertent use
+ of mapcar* (from cl) by plain mapcar and direct cons manipulation.
+ (org-babel-params-from-properties):
+ Use `org-babel-current-src-block-location' for evaluating new-style
+ header-argument properties. Remove superfluous save-match-data
+ clauses. Comment which properties get evaluated where.
+ (org-babel-insert-header-arg, org-babel-parse-src-block-match):
+ Replace `if' with empty else part by `when' for readability.
+ (org-babel-params-from-properties): Inquire for language specific
+ and default header properties. Language specific header
+ properties take precedence over default header properties and
+ old-style header property specifications.
+
+ * org.el (org-re-property): Re-implement using full regex for
+ `org-re-property'. Add optional argument LITERAL to flag when
+ PROPERTY should to be regex-quoted. Move before definition of
+ `org-re-property'.
+ (org-re-property-keyword): Remove, functionality is subsumed by
+ `org-re-property'.
+ (org-property-re): Define using `org-re-property'.
+ Improve definition so that this regex can be
+ (org-entry-get, org-property-values): Adjust match number for
+ PROPVAL. (org-entry-put): Use `org-re-property' instead of
+ `org-re-property-keyword'.
+ used in all situations. Extend docstring with explanation of
+ matching groups.
+ (org-at-property-p): Implement using `org-element-at-point'.
+ (org-entry-properties, org-buffer-property-keys, org-indent-line):
+ Use `org-property-re' and adjust match group numbers accordingly.
+
+ * org-compat.el (define-obsolete-variable-alias)
+ (define-obsolete-function-alias): Actually remove the third (and
+ any following) argument from the argument list before calling the
+ advised function. Extend eval-and-compile clause and add advices
+ for functions that have different parameter lists in XEmacs.
+ Add variable definitions that XEmacs lacks .
+
+ * ob-fortran.el (org-every): Declare.
+
+ * org-element.el (org-element-node-property-parser):
+ Use `org-property-re' and adjust match group numbers accordingly.
+ Move `looking-at' out of the let clause to not rely on the
+ unspecified evaluation order inside the let.
+
+ * ob-eval.el, ob.el, org-macro.el, org-mhe.el: Require org-macs
+ and org-compat as necessary.
+
+ * ob-tangle.el (org-edit-special, org-store-link)
+ (org-open-link-from-string): Declare functions.
+
+ * org-macs.el (declare-function): Define macro to use autoload
+ instead for XEmacs.
+
+ * ox-html.el, ox-odt.el: XEmacs does not have table.el, so use
+ 'noerror on the require form.
+
+ * ox-texinfo.el (org-texinfo-table-column-widths): Fix spliced
+ argument list that XEmacs complains about by adding parenthesis.
+
+ * ob-octave.el (org-babel-octave-initiate-session): If octave-inf
+ can't be loaded, try octave instead before giving up.
+ Emacs 24.3.50 and upwards replaces octave-inf with just plain octave.
+
+ * org-id.el (org-id-update-id-locations): Autoload interactive
+ function.
+
+ * ob-core.el (org-babel-parse-inline-src-block-match):
+ * ob-exp.el (org-babel-exp-src-block): Give header arguments from
+ properties priority over default header arguments.
+
+ * ob-sh.el (org-babel-sh-var-to-sh): When detecting a table, the
+ first line could be the symbol `hline' rather than a list of table
+ cells, so check for that as well.
+
+ * org.el (org-table-clean-did-remove-column):
+ * org-table.el (org-table-clean-did-remove-column): Move defvar,
+ this dynamic variable is only used in org-table.
+
+ * org-table.el (org-table-colgroup-info): Remove unused defvar for
+ `org-table-colgroup-info'.
+ (org-table-clean-before-export): Let-bind regular expression
+ strings and remove unused matching group.
+ Use `org-table-clean-did-remove-column' in cond statement rather than
+ branching via if to avoid code duplication. Remove the code
+ associated with the removed `org-table-colgroup-info'.
+ (orgtbl-export): Remove unused internal function.
+
+ * org-macro.el (org-macro-expand): Do not try to interpret the
+ macro replacement text as a regex so that escaped backslashes and
+ commas in macro arguments will be interpreted correctly.
+
+ * ob-perl.el (org-babel-perl-wrapper-method): Select output handle
+ only after evaluation so that output is not mixed into results
+ eavaluation.
+ (org-babel-perl-evaluate): Fix the handling of results for
+ ":results output" to also parse tables. Use the same lambda
+ construction as in ob-sh.el to avoid code duplication.
+
+ * ob-exp.el (org-babel-exp-results, org-babel-lob-execute):
+ Suppress user confirmation of the emacs-lisp wrapper execution
+ around a lob call.
+
+ * ob-perl.el (org-babel-perl-wrapper-method): Use TAB as separator
+ for table results as expected by
+ `org-babel-import-elisp-from-file´.
+
+ * ob-core.el (org-babel-number-p): String match for any number
+ moved first so that the match data for the length check does not
+ become corrupted.
+ (org-babel-confirm-evaluate-answer-no): Dynamically scoped
+ variable, if bound non-nil the confirmation dialog will not be
+ initiated and denial of evaluation is assumed.
+ (org-babel-check-confirm-evaluate): New macro to establish
+ bindings based on INFO.
+ (org-babel-check-evaluate): New defsubst that checks if the
+ evaluation of a code block is disabled. Refactors the first part
+ of the original function `org-babel-confirm-evaluate´.
+ (org-babel-confirm-evaluate): New defsubst that checks if the user
+ should be queried and returns the answer. Keeps the second part
+ of the original function `org-babel-confirm-evaluate´.
+ Re-implement using bindings for common subexpressions.
+ (org-babel-execute-src-block): Do not ask for confirmation if the
+ cached result is current.
+ (org-babel-call-process-region-original): Change declaration into
+ definition with nil initial value at the beginning of the file and
+ drop the later definition. Add comment that the dynamic scoping
+ of this variable is done for tramp.
+
+ * org-table.el (org-table-eval-formula): The condition-case to
+ check for must be "error", not "user-error".
+
+ * ob-perl.el (org-babel-execute:perl): Pass `result-params´
+ through to `org-babel-perl-evaluate´.
+ (org-babel-variable-assignments:perl): Add "my" to variable
+ declaration so that it becomes compatible with "use strict;".
+ Use new internal formatting function `org-babel-perl--var-to-perl´.
+ (org-babel-perl--var-to-perl): New internal function, uses Perl
+ non-interpolating quoting on the string that defines the variable
+ to suppress spurious interpretation of it as Perl syntax.
+ (org-babel-perl-wrapper-method): Use a block and declare all
+ variables as "my", also use Perl quoting throughout. Redirect
+ STDOUT to the temporary file so that simply "print" will put the
+ results there. Check the return value and output in table form if
+ 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
+ `org-babel-perl-preface' and ibody. Implement results
+ interpretation so that tables are easier to produce.
+
+ * ob-eval.el (org-babel-eval): Use simplified version of
+ `org-babel--shell-command-on-region´, we are the only caller of
+ this function.
+ (org-babel--shell-command-on-region):
+ Replace `org-babel-shell-command-on-region´ with a much more simplified
+ internal version, remove superfluous DOCSTRING and interactive
+ clause, strip out all conditionals which were never used. Prevent
+ deletion of temporary input file to aid debugging when the symbol
+ `org-babel--debug-input´ is bound and has non-nil value.
+
+ * ob-tangle.el (org-babel-tangle): Do not change signature, a nil
+ arg is even documented in the manual.
+
+ * org-src.el: Change declaration of `org-babel-tangle´ to "arg"
+ for first argument.
+
+ * ob-core.el (org-babel-execute-src-block): Add binding for
+ merged-params to avoid multiple evaluation of
+ `org-babel-merge-params´. Rename cache? to cache-p, add binding
+ for cache-current-p and use it. Do not run
+ `org-babel-confirm-evaluate´ if source block has a cache and the
+ cache value is current (there is no evaluation involved in this
+ case).
+
+ * org.el (org-current-time): Replace call to obsolete function
+ `time-to-seconds´ with a call to compatibility function
+ `org-float-time´.
+
+ * org-compat.el (user-emacs-directory): If not bound, define as an
+ alias to `user-init-directory´ so that XEmacs continues to be
+ happy with Org.
+
+ * org-macs.el: New macro to allow the 5-argument form of load to
+ be used where possible without breaking compatibility with XEmacs.
+
+ * org.el (org-version, org-reload):
+ Use `org-load-noerror-mustsuffix´ instead of adding a fifth argument
+ to load directly. Guard against undefined variable load-suffixes,
+ which doesn't exist in XEmacs.
+
+ * org.el: Use
+ `org-define-obsolete-{function,variable}-alias´instead of
+ `define-obsolate{function,variable}-alias´.
+
+ * org-compat.el (user-error): Defalias to `error´ for Emacsen that
+ don't have it.
+
+ * ob-python.el (org-babel-python-hline-to)
+ (org-babel-python-None-to): Specify customize group as 'org-babel
+ and widget type as 'string.
+
+ * ob.el (org-babel-result-cond): Macro expansion needs to unquote
+ formal parameter `result-params´.
+
+ * org.el (org-reload): Major rewrite.
+
+ * org.el (org-clock-get-last-clock-out-time): Declare function.
+
+2013-11-12 Alan Schmitt <alan.schmitt@polytechnique.org>
+
+ * ob-ocaml.el (org-babel-prep-session:ocaml):
+ Use `save-window-excursion' around the code starting the tuareg
+ process.
+ (org-babel-ocaml-command): New option to specify the name of the
+ toplevel to run.
+ (org-babel-prep-session:ocaml): Directly call
+ `tuareg-run-process-if-needed' with `org-babel-ocaml-command' as
+ argument.
+ (org-babel-execute:ocaml): Always append ";;" at the end of the
+ expression before sending it to the toplevel. Do not remove the
+ type information if "verbatim" is a results parameter of the code
+ block.
+ (org-babel-ocaml-parse-output): Make sure the complete type is
+ taken into account when matching against known types.
+
+ * org-faces.el (org-footnote): Fix docstring.
+
+2013-11-12 Andreas Leha <andreas@lehas.net>
+
+ * ob-latex.el (org-babel-execute:latex): Add a tizk option that
+ copies the body of the block into a tikz file.
+
+2013-11-12 Arun Persaud <apersaud@lbl.gov>
+
+ * org-agenda.el (org-agenda-prefix-format): Add documentation for
+ the new %b option.
+ (org-prefix-has-breadcrumbs): Add flag, `t' when %b is set.
+ (org-agenda-format-item): Add breadcrumbs if requested.
+ (org-compile-prefix-format): Add compiled information for
+ breadcrumbs, add %b option.
+
+2013-11-12 Aurélien Aptel <aurelien.aptel@gmail.com> (tiny change)
+
+ * ox-html.el (org-html-code, org-html-verbatim): Remove fancy
+ string replacements for code and verbatim text when exporting to
+ HTML.
+
+2013-11-12 Bastien Guerry <bzg@gnu.org>
+
+ * org.el (org-align-tags-here): Fix bug: move to the correct
+ position.
+ (org-agenda-prepare-buffers): Restore the point position.
+ (org-insert-link): Don't remove brackets when they belong to a
+ timestamp in a headline.
+
+ * org-capture.el (org-capture-refile): Don't finalize prematurely.
+ (org-capture): Store :return-to-wconf earlier.
+ (org-capture-place-template): Don't store :return-to-wconf when
+ called from a capture template using `function', rely on the early
+ :return-to-wconf value store from `org-capture'.
+
+ * org-compat.el (org-move-to-column): New argument
+ `ignore-invisible' to turn on `buffer-invisibility-spec'.
+
+ * org-agenda.el (org-agenda-show-new-time): Ignore invisible text
+ when inserting the new time as a text property.
+ (org-agenda-filter-make-matcher): When filtering tags and hitting
+ space, filter out entries with tags, only keep those without tags.
+ (org-agenda-drag-line-forward, org-agenda-drag-line-backward):
+ Fix bugs: don't drag lines without text and don't drag lines
+ before/after hidden lines.
+
+ * ox-odt.el (org-odt-table-style-format): Use %s for inserting the
+ rel-width property as a string.
+ (org-odt-template): Fall back on a string for :rel-width.
+
+ * org.el (org-directory, org-default-notes-file)
+ (org-reverse-note-order): Don't use the `org-remember'
+ customization group.
+ (org-require-autoloaded-modules): Don't require
+ `org-remember'.
+
+ * org-capture.el: Update commentary section to reflect the fact
+ that org-remember.el is not used anymore.
+
+ * org.el (org-babel-load-file): Set `exported-file' correctly, in
+ case the file as been tangled using a buffer-local value.
+
+ * ob-tangle.el (org-babel-tangle-file): Return the list of tangled
+ files.
+
+ * ox-org.el (org-org-publish-to-org): When htmlizing an .org file,
+ ensure to show all headings and all blocks before fontifying.
+
+ * ob-shen.el (org-babel-ruby-var-to-ruby): Declare.
+
+ * ox.el: Fix comment: remove reference to the obsolete variable
+ `org-export-language-setup'.
+
+ * org.el (org-set-regexps-and-options-for-tags): Fix concatenation
+ of the tags list.
+
+ * ox-odt.el (org-odt-pixels-per-inch): Use 96.0 as the default.
+
+ * org.el (org-refile): With a numeric prefix argument of `3',
+ emulate (setq org-refile-keep t) and copy the subtree to the
+ target location, don't delete it.
+ (org-set-regexps-and-options-for-tags): Fix the setting of tag
+ groups when relying on `org-tag-alist', not on tags directly set
+ in the buffer with the #+TAGS option.
+
+ * org-agenda.el (org-agenda-archive-with): Save window excursion.
+
+ * org.el (org-forward-element, org-backward-element): Throw a
+ message instead of an error when trying to move from a position
+ where there is no element.
+ (org-clock-is-active): Fix docstring.
+
+ * org-list.el (org-sort-list): Use `x' instead of `c' for sorting
+ plain list by checked status.
+
+ * org.el (org-structure-template-alist): Fix custom type and
+ default value.
+ (org-set-regexps-and-options-for-tags): Enhance docstring.
+ (org-set-regexps-and-options): Make sure not to add
+ `org-tag-alist' twice when setting this variable through et
+ #+setupfile: directive.
+ (org-tags-expand): Use `with-syntax-table'.
+
+ * org-list.el (org-sort-list): Implement sorting by "checked"
+ status for check lists.
+
+ * org-table.el (org-table-sum): Fix rounding error when summing
+ times.
+
+ * ob-scheme.el (org-babel-scheme-execute-with-geiser): Fix code
+ typo. Add declarations.
+
+ * ox-html.el (org-html-link-use-abs-url): New option.
+ (org-html-link): Use it to prepend relative links with the value
+ of HTML_LINK_HOME, when defined.
+
+ * org.el (org-refile): Fix refiling the active region within an
+ list. Don't store the last refiled subtree in the kill ring.
+
+ * org.el (org-mode-map): Remap `forward-paragraph' and
+ `backward-paragraph' to `org-forward-element' and
+ `org-backward-element'.
+
+ * ox-html.el (org-html-begin-plain-list): New parameter
+ `ordered-num' to tell whether the list is ordered numerically.
+ (org-html-plain-list): Handle alphabetical ordered list.
+
+ * org-agenda.el (org-batch-agenda): Let-bind `org-agenda-sticky'
+ to nil during batch export.
+
+ * org.el (org-copy-subtree): Fix typo in docstring.
+ (org-scan-tags): Don't disable `case-fold-search' too early.
+
+ * org-agenda.el (org-agenda-skip-eval): Fix typo in docstring.
+
+ * org-capture.el (org-capture-set-target-location): Don't throw an
+ error when `org-time-was-given' is not bound.
+
+ * org-clock.el (org-clock-modify-effort-estimate):
+ Clarify docstring.
+
+ * org.el (org-set-regexps-and-options-for-tags): Return a list
+ with tag-related variables.
+ (org-set-regexps-and-options): Append tags from a setup file to
+ the local tags of the file.
+ (org-agenda-prepare-buffers): Set tags from a setup file by
+ calling `org-set-regexps-and-options' when necessary.
+ (org-set-regexps-and-options): Fix `org-deadline-time-hour-regexp'
+ and `org-scheduled-time-hour-regexp'.
+
+ * org-table.el (org-table-TBLFM-begin-regexp): Rename from
+ `org-TBLFM-begin-regexp'.
+ (org-table-calc-current-TBLFM): Rename from
+ `org-calc-current-TBLFM'.
+
+ * org.el (org-ctrl-c-ctrl-c): Require org-table if needed.
+ (org-refresh-properties): Put the text property on the whole
+ subtree, not just on the headline.
+ (org-get-outline-path): Remove statistical and checkboxes cookies.
+
+ * org-agenda.el (org-agenda, org-search-view, org-tags-view)
+ (org-agenda-get-day-entries, org-agenda-set-restriction-lock):
+ Use (current-buffer) as the value of `org-agenda-restrict'. Fix a bug
+ about narrowing to wrong region boundaries when
+ `org-agenda-restrict' is non-nil.
+
+ * org.el (org-agenda-text-search-extra-files): Fix typos in
+ docstring.
+ (org-insert-heading): Fix case when there the first heading starts
+ at the beginning of the buffer.
+
+ * ob-core.el (org-babel-expand-src-block):
+ Use `org-called-interactively-p'.
+
+ * org.el (org-agenda-prepare-buffers): Avoid duplicates in
+ `org-tag-alist-for-agenda' correctly.
+ (org-read-date-minibuffer-local-map): Check if we are at the
+ beginning of the prompt, not if we are after a whitespace.
+ Bind C-. to `calendar-goto-today'.
+
+ * org-clock.el (org-clock-in): Don't forward by one character when
+ setting the marker in the clock history.
+
+ * org.el (org-read-date-minibuffer-local-map):
+ Call `calendar-goto-today' only if there is a space before point in the
+ minibuffer prompt.
+ (org-insert-heading): Reveal context when called interactively.
+ Fix bug about wrong conversion of lines with :END: or #+end_ into
+ headlines.
+ (org-in-drawer-p): New function.
+ (org-meta-return): Use `org-catch-invisible-edits' and the
+ `org-in-drawer-p' to check whether we are within a drawer.
+
+ * org-list.el (org-sort-list): Fix infloop.
+
+ * org.el (org-clone-subtree-with-time-shift): Unconditionally ask
+ for a time shift if there is a time-stamp. Don't ask for a time
+ shift when called with a universal prefix argument.
+
+ * ob-core.el (org-babel-insert-result): Fix bug when inserting
+ results as a list: ensure we split a string containing "\n".
+
+ * ox-html.el: Fix copyright header.
+
+ * org.el (org-store-link): Don't add a search string when storing
+ a link from a radio target.
+ (org-open-at-point): Jump to the radio link (<<<radio>>>), not to
+ the simple target (<<target>>).
+
+ * org-table.el (org-table-get-remote-range): Fix typo.
+
+ * org-datetree.el (org-datetree-find-month-create)
+ (org-datetree-find-day-create): Add a docstring.
+ (org-datetree-find-year-create): Only match headlines with a
+ year or a year and one or more tags.
+
+ * org-crypt.el (org-crypt-check-auto-save)
+ (org-crypt-use-before-save-magic): Use `org-add-hook' when the
+ hooks are local hooks.
+
+ * org-agenda.el (org-agenda-mode): Use `org-add-hook' and merge
+ upstream change from Emacs 2013-04-18T00:12:33Z!monnier@iro.umontreal.ca.
+
+ * ob-core.el (org-babel-pop-to-session-maybe): Fix docstring.
+ (org-babel-pop-to-session-maybe): Use true function's name,
+ not its alias.
+
+ * org-agenda.el (org-agenda-drag-line-forward)
+ (org-agenda-drag-line-backward): New commands.
+ (org-agenda-mode-map): Bind the new commands to M-<down> and
+ M-<up> respectively.
+
+ * org.el (org-insert-heading): Fix insertion of items.
+
+ * org-capture.el (org-capture-use-agenda-date): Fix docstring.
+
+ * org-agenda.el (org-agenda-bulk-toggle): Fix docstring.
+ (org-agenda-bulk-toggle-all): New command.
+ (org-agenda-mode-map): Bind `org-agenda-bulk-toggle' to `M-m'
+ and `org-agenda-bulk-toggle-all' to `M-*'.
+ (org-agenda-menu): Add `org-agenda-bulk-toggle' and
+ `org-agenda-bulk-toggle-all'.
+ (org-agenda-bulk-mark, org-agenda-bulk-unmark): Jump to the
+ next headline, not the next line.
+
+ * org-capture.el (org-mks): Fix bug: let-bind `case-fold-search'
+ to nil while matching the first letter of a multi-letters
+ template.
+
+ * org.el (org-store-link): When a bracket link is found in a
+ headline, use the link description or the link path.
+ (org-flag-drawer, org-hide-block-toggle)
+ (org-goto-left, org-goto-right, org-promote)
+ (org-paste-subtree, org-narrow-to-block, org-sort-entries)
+ (org-insert-link, org-offer-links-in-entry, org-open-file)
+ (org-refile, org-refile-get-location)
+ (org-refile-check-position, org-prepare-dblock, org-todo)
+ (org-auto-repeat-maybe, org-show-todo-tree, org-sparse-tree)
+ (org-occur, org-priority, org-scan-tags)
+ (org-get-tags-string, org-property-action, org-set-effort)
+ (org-entry-put, org-insert-drawer)
+ (org-compute-property-at-point)
+ (org-property-next-allowed-value, org-evaluate-time-range)
+ (org-closest-date, org-timestamp-change)
+ (org-revert-all-org-buffers, org-cycle-agenda-files)
+ (org-agenda-file-to-front, org-remove-file)
+ (org-preview-latex-fragment, org-format-latex)
+ (org-create-math-formula, org-create-formula-image)
+ (org-speed-command-help, org-check-before-invisible-edit)
+ (org-modifier-cursor-error, org-hidden-tree-error)
+ (org-mark-subtree, org-kill-line, org-first-sibling-p)
+ (org-up-element, org-down-element)
+ (org-drag-element-backward, org-drag-element-forward)
+ (org-unindent-buffer, org-speedbar-set-agenda-restriction):
+ Use `user-error' instead of `error'.
+
+ * ox-latex.el (latex): Don't force exporting with smart quotes.
+
+ * ox.el (org-export-with-smart-quotes): Mention the need to use
+ the relevant Babel package when setting this option to non-nil.
+
+ * org-src.el (org-edit-src-turn-on-auto-save): New option.
+ (org-edit-src-code): Use it.
+ (org-edit-src-auto-save-idle-delay): Enhance docstring.
+
+ * org-capture.el (org-mks): Make cursor invisible.
+
+ * org.el (org-link-expand-abbrev): Save match data before before
+ calling the replacement function.
+
+ * org-list.el (org-sort-list): Don't move point when matching time
+ values.
+
+ * org.el (org-shifttab): Show the correct number of empty
+ headlines when called with a numeric prefix argument.
+ Enhance docstring.
+ (org-uniquify): Use `copy-sequence'.
+ (org-adaptive-fill-function, org-fill-paragraph): Throw a useful
+ error message when parse an element fails in the current buffer.
+
+ * ox.el (org-export-with-planning): Enhance docstring.
+
+ * org.el (org-closed-keep-when-no-todo): New option.
+ (org-todo): Use the new option.
+ (org-open-line): Rename from `org-ctrl-o'.
+ (org-mode-map): Use `remap'.
+ (org-cycle-emulate-tab, org-file-apps)
+ (org-set-font-lock-defaults)
+ (org-translate-link-from-planner, org-link-search)
+ (org-refile-get-targets, org-read-date-get-relative):
+ Minor code clean-up: fix dangling parentheses.
+
+ * org-agenda.el (org-agenda-entry-text-mode): Also check against
+ regexp filters.
+ (org-timeline): Handle `org-agenda-show-log'.
+
+ * org-clock.el (org-clock-select-task): Remove successive
+ duplicates in the clock history to consider.
+
+ * org.el (org-uniquify-alist): Improve docstring.
+ (org-make-tags-matcher, org-change-tag-in-region): Add buffer's
+ tags to the tags completion table.
+ (org-tags-expand): Prevent circular replacement of group tags.
+ Tiny docstring formatting.
+ (org-uniquify): Make a defsubst. Use `delete-dups' instead of
+ `add-to-list'.
+ (org-todo): Also remove the CLOSED planning information when
+ removing the TODO keyword.
+ (org-forward-heading-same-level): Fix bug when forwarding
+ to a hidden subtree of the same level.
+ (org-tags-expand): Use word delimiters when building the tag
+ search regexp.
+
+ * org-clock.el (org-clock-insert-selection-line): Don't display
+ the clockout time.
+
+ * org.el (org-emphasis-regexp-components): Make a defvar.
+ (org-emphasis-alist): New default value: don't set HTML tags.
+ (org-emphasize, org-set-emph-re): Use the new value of
+ `org-emphasis-alist'.
+
+ * org-mobile.el (org-mobile-edit): Insert new headings at the end
+ of the parent subtree. Use `org-at-heading-p' instead of the
+ obsolete `org-on-heading-p'.
+
+ * org.el (org-insert-heading): When called from a list item and
+ `org-insert-heading-respect-content' is non-nil, insert a heading,
+ not an item.
+ (org-insert-heading-respect-content): Fix docstring.
+ (org-insert-heading): When in a non-empty non-headline line,
+ convert the current line into a headline.
+
+ * org-table.el (org-table-copy-down): Don't move cursor when
+ getting the field.
+
+ * ox-icalendar.el (org-icalendar-export-current-agenda): Do not
+ evaluate babel code blocks.
+
+ * ox-html.el (html): Add more options.
+
+ * ox-publish.el (org-publish-project-alist): Add :with-planning in
+ docstring.
+
+ * ob-exp.el (org-babel-exp-src-block): Tiny docstring fix.
+
+ * ox-icalendar.el (org-icalendar--combine-files): Fix typo.
+
+ * org-mouse.el (org-mouse-agenda-context-menu): Fix a function's
+ name.
+
+ * ox.el (org-export-options-alist, org-export--skip-p):
+ Use `:with-planning' instead of `:with-plannings', to keep in sync
+ with the corresponding option's name.
+
+ * ob-core.el (org-babel-confirm-evaluate): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-undo, org-agenda)
+ (org-agenda-append-agenda)
+ (org-agenda-get-restriction-and-command, org-agenda-write)
+ (org-agenda-clock-cancel)
+ (org-agenda-diary-entry-in-org-file, org-agenda-diary-entry)
+ (org-agenda-execute-calendar-command)
+ (org-agenda-goto-calendar, org-agenda-convert-date)
+ (org-agenda-bulk-mark, org-agenda-bulk-action)
+ (org-agenda-show-the-flagging-note): Use `user-error' instead of
+ `error'.
+
+ * org-macs.el (org-with-remote-undo): Normalize argument names.
+
+ * org.el (org-store-log-note): Fix `buffer-undo-list' when called
+ after `org-agenda-todo'.
+ (org-add-log-note): Minor formatting fix.
+
+ * org-agenda.el (org-agenda-append-agenda): Set buffer read only.
+
+ * org-clock.el (org-clock-select-task): Throw a user error when
+ the clock history is empty.
+
+ * org-table.el (org-table-get-remote-range): Fix docstring: use
+ #+NAME instead of #+TBLNAME.
+
+ * ob-ref.el: Use #+NAME instead of #+TBLNAME in comment.
+
+ * ox-html.el (org-html-table-row-tags): Better example.
+
+ * org-clock.el (org-clock-select-task): Fix window to buffer.
+ Hide the cursor.
+ (org-clock-insert-selection-line): Add the clock-out time.
+
+ * ox-html.el (org-html-table-row-tags): Allow new dynamically
+ bound value `row-number'.
+ (org-html-table-row): Bind `row-number' to the number of the
+ row (first row is 0).
+
+ * org.el (org-minutes-to-clocksum-string): Round fractions of
+ minutes.
+
+ * ox-html.el (org-html-table-row-tags): Fix example in docstring.
+
+ * org-agenda.el (org-agenda-span-to-ndays): Enhance docstring.
+ (org-agenda-goto-date): Fix bug when going to a date in month
+ view.
+ (org-agenda-goto-date): Put the cursor on the agenda line with the
+ selected date.
+ (scheduled/deadline items with hour spec) then redo an agenda*.
+
+ * org-clock.el (org-clock-resolve): Enhance the content of the
+ help window.
+
+ * org-footnote.el (org-footnote-auto-label): Minor docstring fix.
+
+ * ox-odt.el (org-odt-link): Fix bug: convert & to &amp; in
+ links.
+
+ * ox-html.el (org-html-table-row): Dynamically bind
+ `rowgroup-number', `start-rowgroup-p', `end-rowgroup-p',
+ `top-row-p', `bottom-row-p'.
+ (org-html-table-row-tags): Update docstring: tell what variables
+ are dynamically bound.
+
+ * org-src.el (org-edit-src-code): Don't set
+ `buffer-auto-save-file-name' unless `auto-save-default' is
+ non-nil.
+
+ * ox.el (org-export-table-row-group): Fix typo in docstring.
+
+ * org-table.el (orgtbl-apply-fmt): Enhance docstring.
+
+ * org.el (org-file-contents): Make the message more prominent.
+
+ * ox.el (org-export-replace-region-by): New function.
+
+ * ox-texinfo.el (org-texinfo-convert-region-to-texinfo),
+ * ox-md.el (org-md-convert-region-to-md),
+ * ox-latex.el (org-latex-convert-region-to-latex),
+ * ox-html.el (org-html-convert-region-to-html): New functions to
+ replace the active region by its export into various backends.
+
+ * org-faces.el (org-agenda-restriction-lock): Use less flashy
+ colors.
+
+ * org-agenda.el
+ (org-agenda-restriction-lock-highlight-subtree): New option.
+ (org-agenda-top-headline-filter): Rename from
+ `org-agenda-top-headline-filter'.
+ (org-find-top-headline): Rename from `org-find-top-category'.
+ Add a docstring.
+ (org-agenda-filtered-by-top-headline): Rename from
+ `org-agenda-filtered-by-top-category'.
+ (org-agenda-filter-by-top-headline): Rename from
+ `org-agenda-filter-by-top-category'. Fix docstring.
+ (org-agenda-filter-top-headline-apply): Rename from
+ `org-agenda-filter-top-category-apply'. Fix docstring.
+ (org-agenda-mode-map): Update binding.
+ (org-agenda-get-todos): Set `todo-state' earlier so that we can
+ skip false-positives in time.
+
+ * org.el (org-get-todo-state): Add a docstring.
+ (org-ctrl-o): New command to insert a new row in tables
+ (like `M-S-<down>' does) and open a line elsewhere.
+ (org-mode-map): Bind the new command to `C-o'.
+ (org-set-regexps-and-options): Process tags from an external setup
+ file.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Enhance docstring.
+ (org-agenda-finalize-entries): Conditionally apply limits so
+ that we don't manipulate big lists uselessly.
+ (org-agenda-limit-entries): Limit exclusively. E.g., when
+ limiting to a maximum of "2 tags", don't limit among tagged
+ entries only, but limit among all entries.
+ (org-agenda-limit-interactively): New command.
+ (org-agenda-mode-map): Bind the new command to "~".
+ (org-agenda-redo): Small fix: don't use `eval'.
+
+ * org.el (org-ctrl-c-ctrl-c): Fix bug wrt updating checkboxes: the
+ list beginning should be stored using a marker so that updating
+ [%0] to [%50] will not throw an error.
+ (org-babel-load-file): Move `org-babel-load-file' from
+ ob-tangle.el to here so that it is correctly autoloaded by Emacs
+ before Org is required.
+
+ * org-mac-message.el: Delete.
+
+ * org.el (org-modules): org-mac-message.el is not a core package
+ anymore.
+
+ * org-table.el (orgtbl-to-generic): Fix bug when exporting the
+ cells of radio tables with 'hline.
+
+ * org.el (org-speed-commands-default): Use ?s for
+ `org-narrow-to-subtree'.
+
+ * org-agenda.el (org-agenda-start-on-weekday): Fix typo.
+ (org-agenda-start-day): Enhance docstring.
+
+ * org-src.el (org-src-native-tab-command-maybe): Check that we are
+ in a source code block.
+
+ * org-mobile.el: Remove useless defvar.
+
+ * org.el (org-indent-line): A line just below a line with a list
+ item is now indented depending on the indentation of this list
+ item.
+
+ * org.el (org-options-keywords): Add #+TARGET.
+
+ * org-clock.el (org-resolve-clocks-if-idle): Only try to resolve
+ last clock if the clock buffer still exists.
+ (org-clock-out, org-clock-cancel): Set markers to nil.
+
+ * ox-org.el (org-org-publish-to-org):
+ * ox-html.el (org-html-publish-to-html): Use the custom extension.
+
+ * org.el (org-cycle-internal-local): Fix invalid search bound when
+ `org-cycle-include-plain-lists' is set to 'integrate.
+
+ * org.el (org-sparse-tree-default-date-type): Add an option for
+ closed time-stamps.
+ (org-sparse-tree): Allow to check against closed time-stamps.
+ (org-re-timestamp): Handle closed time-stamps.
+ (org-closed-in-range): Delete.
+
+ * org-capture.el (org-capture-import-remember-templates):
+ Take care of adding :jump-to-captured option if needed.
+
+ * org.el (org-toggle-pretty-entities): Enhance messages.
+ (org-raise-scripts): Handle scripts like "a_b^c".
+
+ * org-capture.el (org-capture-templates): Document new option
+ :jump-to-captured in the docstring. Offer the complete list of
+ options when customizing.
+ (org-capture-finalize): Handle :jump-to-captured.
+
+ * org.el (org-agenda-prepare-buffers): Fix bugs: don't let-bind
+ `org-tag-alist' to nil and don't append duplicate tags to
+ `org-tag-alist-for-agenda'.
+ (org-store-link): Storing multiple links in the active region now
+ requires a triple prefix argument.
+ (org-store-link, org-link-search): Fix handling of links to #+NAME
+ and #+TARGET keywords.
+
+ * org-compat.el (org-ignore-region): Tiny docstring fix.
+
+ * org-capture.el (org-capture): Don't store multiple links over
+ lines in the active region.
+
+ * ox-odt.el (org-odt-special-block): Don't wrap annotations into
+ <text:p>...</text:p> at all.
+ (org-odt--fix-annotations): New function.
+ (org-odt--export-wrap): Use the new function to fix annotations
+ insertion in content.xml.
+
+ * org.el (org-mode-flyspell-verify): Require 'org-element so that
+ `org-element-affiliated-keywords' is defined.
+
+ * ox-odt.el (org-odt-special-block): Don't insert annotations
+ using style "Text_20_body".
+
+ * org.el (org-toggle-tags-groups): Correctly highlight group tags.
+ (org-tags-expand): Expand tags as words, with characters ?@
+ and ?_ being considered words constituents.
+ (org-set-regexps-and-options): Don't read setup files from
+ read-only buffers.
+ (org-file-contents): When no-error is non-nil, throw a less
+ intrusive message.
+
+ * org-agenda.el (org-agenda-scheduled-leaders)
+ (org-agenda-deadline-leaders): Re-align leaders to the left,
+ back to a 11 characters width.
+
+ * org.el (org-refile-cache-check-set): More informative message.
+
+ * org-agenda.el (org-tags-view): Set the matcher after preparing
+ the agenda, as `org-tag-groups-alist-for-agenda' might be needed.
+ (org-agenda-filter-make-matcher): New parameter `filter' and
+ `type'. Handle group tags.
+ (org-agenda-filter-expand-tags): New function.
+ (org-agenda-filter-apply): Handle group tags.
+
+ * org.el (org-blank-before-new-entry): Tiny docstring fix.
+ (org-tag-alist-for-agenda): Add docstring.
+ (org-tag-groups-alist-for-agenda): New global variable.
+ (org-tag-groups-alist): New buffer-local variable.
+ (org-tag-alist, org-tag-persistent-alist): Handle :grouptags.
+ (org-group-tags): New option.
+ (org-toggle-group-tags): New command.
+ (org-mode-map): Bind `org-toggle-group-tags' to `C-c C-x q'.
+ (org-set-regexps-and-options-for-tags): New function, factored
+ out from `org-set-regexps-and-options'.
+ (org-set-regexps-and-options): Don't handle tags, they are now
+ handled separately by `org-set-regexps-and-options-for-tags'.
+ (org-assign-fast-keys): Handle :grouptags.
+ (org-mode): Use `org-set-regexps-and-options-for-tags' on top
+ of `org-set-regexps-and-options'.
+ (org-fontify-meta-lines-and-blocks-1): Fontify group tags.
+ (org-make-tags-matcher): Expand group tags in the matcher.
+ (org-tags-expand): New function.
+ (org-tags-completion-function): Tiny code clean up.
+ (org-set-current-tags-overlay): Add a docstring.
+ (org-fast-tag-selection): Highlight group tags.
+ (org-agenda-prepare-buffers): Set `org-tag-alist-for-agenda'
+ and `org-tag-groups-alist-for-agenda'. Don't uniquify
+ `org-tag-alist-for-agenda' as we may need the grouping
+ information for filtering in the agenda buffer.
+ (org-uniquify-alist): New function.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/tags):
+ Handle :grouptags.
+
+ * org-faces.el (mode-line): New face for group tags.
+
+ * ob-core.el (org-babel-hash-show-time): Tiny docstring
+ enhancement.
+
+ * org-element.el (org-element-paragraph-separate): Use new name
+ `org-list-allow-alphabetical'.
+
+ * org-list.el (org-list-allow-alphabetical): Rename from
+ `org-alphabetical-lists'.
+ (org-list-empty-line-terminates-plain-lists): Rename from
+ `org-empty-line-terminates-plain-lists'.
+ (org-checkbox-hierarchical-statistics): Rename from
+ `org-hierarchical-checkbox-statistics'.
+
+ * org.el (org-image-actual-width): Update docstring.
+ (org-display-inline-images): Use the #+attr_html: :width syntax.
+ (org-modules): Remove deleted libraries, add new ones.
+
+ * ox-html.el (org-html-indent): Default to nil, as non-nil can
+ break indentation of source code blocks.
+ (org-html-link): Don't insert nil if there is no attributes.
+ (org-html-link--inline-image): Use the correct syntax for image
+ attributes. Allow :width :height and :alt as predefined
+ attributes for inline images.
+ (org-html-link, org-html-table): Use the standard syntax---
+ e.g. "#+attr_html: :options ..."--- to get attributes.
+
+ * ox.el (org-export-table-cell-alignment): Treat an empty cell as
+ a number if it follows a number.
+
+ * ox.el (org-export-as): Allow user functions in
+ `org-export-before-parsing-hook' to modify the point.
+
+ * org.el (org-entry-add-to-multivalued-property): Add the new
+ value by appending it at the end of the line.
+
+ * org-table.el (orgtbl-to-generic): New parameter `backend' to
+ export cells content using a specific backend.
+ (orgtbl-to-latex, orgtbl-to-texinfo): Export cells to LaTeX
+ and Texinfo before sending the table.
+
+ * ox.el (org-export-define-backend)
+ (org-export-define-derived-backend): Make defuns and update
+ docstrings.
+
+ * ox-texinfo.el (texinfo):
+ * ox-org.el (org):
+ * ox-odt.el (odt):
+ * ox-md.el (md):
+ * ox-man.el (man):
+ * ox-latex.el (latex):
+ * ox-icalendar.el (icalendar):
+ * ox-html.el (html):
+ * ox-beamer.el (beamer):
+ * ox-ascii.el (ascii): Use `org-export-define-backend' and
+ `org-export-define-derived-backend' as defuns, not macros.
+
+ * org.el (org-set-regexps-and-options):
+ Use `org-table-set-constants'.
+
+ * org-table.el (org-table-set-constants): New function.
+ (orgtbl-ctrl-c-ctrl-c): Use it.
+
+ * org-pcomplete.el
+ (pcomplete/org-mode/block-option/clocktable): Add parameters.
+
+ * org.el (org-options-keywords): Remove "INFOJS_OPT": it is added
+ through ox-html.el now.
+
+ * org-agenda.el (org-agenda-redo): Set filters after agenda has
+ been redone.
+
+ * org.el (org-store-link): When there is an active region, store
+ each line as a separate link.
+ (org-insert-all-links): Use a default description when links
+ do not have one already.
+
+ * org-agenda.el (org-agenda-redo): Fix code typo.
+
+ * org.el (org-link-display-format): Fix docstring.
+
+ * ox-publish.el (org-publish-org-to)
+ (org-publish-org-sitemap, org-publish-find-title)
+ (org-publish-find-date)
+ (org-publish-cache-file-needs-publishing):
+ Set `org-inhibit-startup' to t when visiting files for
+ publication.
+
+ * ox-org.el (org-org-publish-to-org): Kill buffers not visited at
+ publication time.
+
+ * org.el (org-set-font-lock-defaults): Set font-lock keywords
+ correctly for plain links.
+
+ * ox-texinfo.el (org-texinfo-logfiles-extensions)
+ (org-texinfo-remove-logfiles): New options.
+ (org-texinfo-compile): Use the new options to remove files
+ after compiling a Texinfo file.
+
+ * ox-texinfo.el (org-texinfo-coding-system): New option.
+ (org-texinfo-template): Add @documentlanguage and
+ @documentencoding.
+ (org-texinfo-headline): Add a space before tags.
+ (org-texinfo-export-to-texinfo, org-texinfo-export-to-info):
+ Use `org-texinfo-coding-system' as the coding system for
+ exported buffers.
+ (org-texinfo-publish-to-texinfo): New function.
+
+ * ox-texinfo.el (org-texinfo-filename)
+ (org-texinfo-info-process, org-texinfo-max-toc-depth)
+ (org-texinfo--sanitize-menu): Docstrings tiny fixes.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Only throw a
+ message when called interactively. Fix docstring position in the
+ defun.
+
+ * ox-html.el (org-html--build-meta-info): Fix setting of
+ http-equiv="Content-Type".
+
+ * org-agenda.el (org-agenda-mode-map): Use ?= for filtering by
+ regexp and ?| for removing all filters.
+ (org-agenda-filter-remove-all): New command.
+ (org-agenda-filter-show-all-re): Rename from
+ `org-agenda-filter-show-all-regexp'.
+ (org-agenda-filter-by-regexp):
+ Call `org-agenda-filter-show-all-re'.
+
+ * org-list.el (org-insert-item): Don't ask for a definition term
+ when insert an item in a description list.
+
+ * org-agenda.el (org-agenda-Quit): Set `org-agenda-buffer' to nil.
+ This prevents bugs when calling e.g., `org-diary' after quitting
+ an agenda window.
+ (org-agenda-entry-types): Move earlier in the file.
+ (org-agenda-custom-commands-local-options, org-diary)
+ (org-agenda-get-day-entries): Don't hardcode the default agenda
+ entry types, use `org-agenda-entry-types'.
+ (org-agenda-custom-commands): Fix default setting so that the
+ customize interface does not complain about a mismatch.
+
+ * org.el (org-export-backends): Add new backends.
+
+ * ox-html.el (org-html-indent): New option.
+ (org-html-use-unicode-chars): New option.
+ (org-html-pretty-output): Delete.
+ (org-html-final-function): Use the new options.
+
+ * ox-html.el (org-html-link): Fix handling of abbreviated links
+ which include a file: protocol.
+ (org-html--build-postamble): Default to today's date.
+ (org-html--build-meta-info): When #+DATE contains a time stamp,
+ parse it as a RFC 822 time string, otherwise simply insert the
+ date as a string.
+
+ * ox.el (org-export--copy-to-kill-ring-p): New function.
+ (org-export-copy-to-kill-ring): Use 'if-interactive as the
+ default.
+ (org-export-to-buffer, org-export-to-file):
+ Use `org-export--copy-to-kill-ring-p' and fix docstrings.
+
+ * ox-odt.el (org-odt-export-as-odf):
+ Use `org-export--copy-to-kill-ring-p'.
+
+ * org.el (org-set-font-lock-defaults): Fontify macros.
+
+ * org-faces.el (org-macro): New face.
+
+ * org.el (org-clone-subtree-with-time-shift): Only prompt for a
+ time shift when the entry at point has a time stamp and when the
+ command is called with a universal prefix argument.
+ (org-execute-file-search-functions): Docstring fix.
+
+ * org-compat.el (org-defvaralias): Fix declare form.
+
+ * org-clock.el (org-clocktable-defaults): Add :mstart parameter.
+ (org-clock-special-range): New argument mstart.
+ (org-dblock-write:clocktable, org-dblock-write:clocktable)
+ (org-clocktable-write-default, org-clocktable-steps)
+ (org-clock-get-table-data): Handle the :mstart parameter.
+
+ * org.el (org-map-entries): Use `save-window-excursion'.
+
+ * org-compat.el (org-defvaralias): New compatibility function.
+
+ * org-list.el (org-cycle-include-plain-lists): Also add to the
+ 'org-cycle customization group.
+ (org-list-allow-alphabetical)
+ (org-checkbox-hierarchical-statistics)
+ (org-list-empty-line-terminates-plain-lists)
+ (org-list-description-max-indent): Rename and add aliases to old
+ names.
+
+ * org-element.el (org-element-context): Prevent an error when
+ getting the context of a table rule.
+
+ * org.el (org-deadline-time-hour-regexp)
+ (org-scheduled-time-hour-regexp): New buffer local variables.
+ (org-set-regexps-and-options): Set the new variables.
+
+ * org-agenda.el (org-agenda-custom-commands-local-options):
+ Add :deadline* and :scheduled* to the list of possible agenda entry
+ types.
+ (org-agenda): Implement a new agenda type agenda* with :scheduled*
+ and :deadline* replacing :scheduled and :deadline respectively in
+ agenda entry types. In such agenda, only scheduled and deadline
+ items with a time specification [h]h:mm will be considered.
+ (org-agenda-entry-types): Document the new agenda entry types
+ :scheduled* and :deadline*.
+ (org-agenda-list): New parameter `with-hour'. Use :scheduled* and
+ :deadline*.
+ (org-agenda-get-day-entries): Handle :scheduled* and :deadline*.
+ (org-agenda-get-deadlines, org-agenda-get-scheduled):
+ New parameter `with-hour'. Use `org-deadline-time-hour-regexp' or
+ `org-scheduled-time-hour-regexp' as the search string if needed.
+ (org-agenda-to-appt): Use :scheduled* and :deadline* by default,
+ as other scheduled and deadline items don't have a time spec and
+ cannot be turned into appointments. Trim bracket links and use
+ only the description as the appointment text.
+ (org-agenda-get-restriction-and-command):
+ Add default description for the agenda* view.
+ (org-agenda-run-series): Handle agenda* views.
+
+ * org-faces.el (org-agenda-filter-tags)
+ (org-agenda-diary, org-agenda-calendar-event)
+ (org-agenda-calendar-sexp): Minor code clean up.
+ (org-agenda-filter-category): Docstring fix.
+ (org-agenda-filter-category): New face.
+
+ * org-agenda.el (org-agenda-local-vars):
+ Add `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'.
+ (org-agenda-mode-map): Use "|" for
+ `org-agenda-filtered-by-regexp'.
+ (org-agenda-re-filter-overlays): New variable.
+ (org-agenda-mark-filtered-text):
+ Use `org-agenda-re-filter-overlays'.
+ (org-agenda-finalize, org-agenda-redo): Allow regexp filtering.
+ (org-agenda-filter-by-category): Set `org-agenda-category-filter'
+ here instead of within `org-agenda-apply-filter'.
+ (org-agenda-regexp-filter): New variable.
+ (org-agenda-filter-by-regexp): New function to filter agenda
+ buffers by regexp.
+ (org-agenda-filter-make-matcher): Make matcher for regexp filters.
+ (org-agenda-filter-apply): Don't set `org-agenda-tag-filter' and
+ `org-agenda-category-filter'. Maybe apply regexp filter.
+ (org-agenda-filter-hide-line): Add docstring.
+ Hide regexp-filtered lines.
+ (org-agenda-filter-show-all-tag, org-agenda-filter-show-all-cat):
+ Add docstring.
+ (org-agenda-filter-show-all-regexp): New function.
+ (org-agenda-set-mode-name): Add regexp-filter information.
+ (org-agenda-custom-commands-local-options): Add regexp filter.
+ (org-agenda-regexp-filter-preset): New variable.
+ (org-agenda-prepare): Use the new variable.
+
+ * ox-odt.el (org-odt-code, org-odt-verbatim):
+ Use `org-odt--encode-plain-text'.
+
+ * ox-html.el (org-html-link): Minor code clean-up.
+
+ * org.el (org-insert-heading): DTRT when in a narrowed region.
+
+ * org-compat.el (org-buffer-narrowed-p): New compatibility
+ function.
+
+ * ox-html.el (org-html-format-inline-image): Fix missing string in
+ formatting string.
+
+ * org-agenda.el (org-agenda-skip-scheduled-if-deadline-is-shown):
+ New allowed value `repeated-after-deadline' which will prevent the
+ display of scheduled items when repeated after the current
+ deadline.
+ (org-agenda-get-scheduled): Handle the new value.
+
+ * org.el (org-time-string-to-absolute): Tiny docstring fix.
+
+ * ox-html.el (org-html-style-default): New classes `footpara' and
+ `footdef' for the footnotes paragraphs and definitions.
+ (org-html-format-footnote-definition): Wrap the footnote
+ defintions into their own div.
+ (org-html-paragraph): Don't add extra <br/> after a paragraph in a
+ footnote.
+ (org-html-container-element, org-html-divs): Mention that
+ org-info.js will not work when changing the defaults.
+
+ * ox-md.el (md): Export underlined text as verbatim.
+
+ * ox-html.el (org-html-style-default): New CSS .underline and
+ #org-div-home-and-up.
+ (org-html-text-markup-alist): Don't hardcode the style, use the
+ new class .underline.
+ (org-html-home/up-format): Don't hardcode the style, use
+ #org-div-home-and-up.
+ (org-html-center-block): Use the .center class.
+
+ * ox-md.el (org-md-underline): New function.
+
+ * org-agenda.el (org-sorting-choice): Fix default value.
+
+ * ox-html.el (org-html-format-footnote-definition)
+ (org-html-footnote-section): Don't wrap footnote definitions into
+ tables.
+ (org-html-paragraph): Add HTML style and class parameter when the
+ paragraph is in a footnote definition. Also allow to add an extra
+ string after the paragraph. Further parameters can be added for
+ paragraphs in other environments.
+ (org-html-template): Always include the title as <h1
+ class="title"></h1>, even when there is no title, as org-info.js
+ needs it.
+
+ * org-element.el (org-element-map): Fix tiny typo in docstring.
+
+ * org-agenda.el (org-agenda-day-view): Fix parameter's name.
+
+ * ox-html.el (org-html-format-inline-image): Don't add superfluous
+ <p></p> when there is an empty caption.
+
+ * org-agenda.el (org-agenda-refile): Enhance docstring. Allow to
+ clear the refile cache with C-0 or C-u C-u C-u.
+
+ * ox-md.el (org-md-export-as-markdown): Tiny docstring fix. Fix a
+ library keyword in the comment section.
+
+ * org.el (org-toggle-item): Convert all normal lines as items when
+ there is a region, and only convert the first line when called
+ with a universal prefix argument. This is consistent with the
+ behavior of `org-toggle-heading'.
+ (org-toggle-heading): When the region contains only normal lines,
+ a universal prefix arg will only convert the first line. This is
+ more consistent with `org-toggle-item'.
+ (orgstruct-setup): Add `org-ctrl-c-minus' and `org-ctrl-c-star'.
+ (customize-package-emacs-version-alist):
+ Update `customize-package-emacs-version-alist'.
+
+ * ox-texinfo.el (org-export-texinfo)
+ (org-texinfo-filename, org-texinfo-classes)
+ (org-texinfo-format-headline-function)
+ (org-texinfo-node-description-column)
+ (org-texinfo-active-timestamp-format)
+ (org-texinfo-link-with-unknown-path-format)
+ (org-texinfo-tables-verbatim)
+ (org-texinfo-table-scientific-notation)
+ (org-texinfo-text-markup-alist)
+ (org-texinfo-format-drawer-function)
+ (org-texinfo-format-inlinetask-function)
+ (org-texinfo-info-process):
+ * ox-odt.el (org-odt-format-drawer-function)
+ (org-odt-format-headline-function)
+ (org-odt-format-inlinetask-function):
+ * ox-md.el (org-export-md, org-md-headline-style): Fix :version
+ and :package-version keywords.
+
+ * org.el (org-time-clocksum-use-effort-durations): Don't set to t
+ by default as it will change many clocktables out there. Let the
+ user decides whether she wants to turn this on.
+
+ * org.el (org-agenda-inhibit-startup): Revert to nil as the default.
+
+ * org-agenda.el (org-agenda-dim-blocked-tasks): Revert to t as the
+ default.
+
+ * ox-html.el (org-html-style-default): More cosmetic tweaks.
+ (org-html-head-include-default-style): Minor docstring update.
+
+ * ox.el (org-export-snippet-translation-alist)
+ (org-export-coding-system, org-export-in-background)
+ (org-export-async-init-file, org-export-invisible-backends)
+ (org-export-dispatch-use-expert-ui):
+ * ox-texinfo.el (org-texinfo-filename, org-texinfo-classes)
+ (org-texinfo-format-headline-function)
+ (org-texinfo-node-description-column)
+ (org-texinfo-active-timestamp-format)
+ (org-texinfo-link-with-unknown-path-format)
+ (org-texinfo-tables-verbatim)
+ (org-texinfo-table-scientific-notation)
+ (org-texinfo-text-markup-alist)
+ (org-texinfo-format-drawer-function)
+ (org-texinfo-format-inlinetask-function)
+ (org-texinfo-info-process):
+ * ox-man.el (org-man-tables-centered)
+ (org-man-table-scientific-notation)
+ (org-man-source-highlight, org-man-source-highlight-langs)
+ (org-man-pdf-process, org-man-logfiles-extensions):
+ * ox-html.el (org-html-allow-name-attribute-in-anchors)
+ (org-html-coding-system, org-html-divs):
+ * ox-ascii.el (org-ascii-text-width)
+ (org-ascii-headline-spacing, org-ascii-indented-line-width)
+ (org-ascii-paragraph-spacing, org-ascii-charset)
+ (org-ascii-underline, org-ascii-bullets)
+ (org-ascii-links-to-notes)
+ (org-ascii-table-keep-all-vertical-lines)
+ (org-ascii-table-widen-columns)
+ (org-ascii-table-use-ascii-art)
+ (org-ascii-format-drawer-function)
+ (org-ascii-format-inlinetask-function):
+ * org.el (org-modules, org-export-backends)
+ (org-highlight-latex-and-related, orgstruct-setup-hook):
+ * org-attach.el (org-attach-git-annex-cutoff):
+ * org-archive.el (org-archive-file-header-format):
+ * org-agenda.el (org-agenda-todo-ignore-time-comparison-use-seconds):
+ * ob-python.el (org-babel-python-hline-to)
+ (org-babel-python-None-to):
+ * ob-ditaa.el (org-ditaa-eps-jar-path):
+ * ob-core.el (org-babel-results-keyword): Add :version and
+ :package-version.
+
+ * ox-ascii.el: Use utf-8-emacs as the file coding system.
+
+ * org-capture.el (org-capture-templates, org-capture-string)
+ (org-capture-steal-local-variables)
+ (org-capture-empty-lines-before)
+ (org-capture-empty-lines-after)
+ (org-capture-insert-template-here)
+ (org-capture-import-remember-templates): Fix or add docstring.
+
+ * ox-html.el (org-html-style-default): Cosmetic changes.
+ (org-html-postamble, org-html-preamble)
+ (org-html-preamble-format): Update docstring.
+
+ * org-agenda.el (org-agenda-format-date-aligned)
+ (org-agenda-time-of-day-to-ampm-maybe)
+ (org-scheduled-past-days)
+ (org-agenda-normalize-custom-commands)
+ (org-agenda-run-series, org-store-agenda-views): Fix or add
+ docstring.
+
+ * ox-latex.el:
+ (org-latex-table-scientific-notation, org-latex-verse-block):
+ Fix typos in docstrings.
+
+ * ox-html.el (org-html-text-markup-alist)
+ (org-html-pretty-output, org-html-link-org-files-as-html)
+ (org-html-postamble, org-html-preamble)
+ (org-html-format-inline-image, org-html-splice-attributes)
+ (org-export-splice-style, org-html-htmlize-region-for-paste)
+ (org-html-fix-class-name)
+ (org-html-format-footnote-reference)
+ (org-html-format-footnotes-section)
+ (org-html-footnote-section, org-html--anchor)
+ (org-html--todo, org-html--tags, org-html-format-headline)
+ (org-html-toc, org-html-format-section, org-html-checkbox)
+ (org-html-format-list-item, org-html-format-latex)
+ (org-html-encode-plain-text)
+ (org-html-table-first-row-data-cells)
+ (org-html-table--table.el-table, org-html-final-function):
+ Fix or add docstring.
+
+ * org.el (org-insert-heading): If the current item has a checkbox,
+ insert the new item with a checkbox.
+
+ * org.el (org-insert-heading): Don't delete spaces in empty
+ headlines.
+
+ * ox-odt.el (org-odt-keyword): Fix typo.
+
+ * ox-latex.el (org-latex-toc-command): Cosmetic docstring change.
+
+ * ox-html.el (org-html-encode-plain-text): Fix typo in docstring.
+
+ * org-faces.el (org-column): Update docstring.
+
+ * org-colview.el: Update error message.
+
+ * org.el (org-modules): Do not include org-mew.el, org-vm.el,
+ org-w3m.el, org-wl.el as these files are now part of contrib/.
+
+ * org-mew.el:
+ * org-vm.el:
+ * org-w3m.el:
+ * org-wl.el: Delete (moved to Org's contrib/ directory.)
+
+ * org-capture.el (org-mks): Move from org-mks.el.
+
+ * org-mks.el: Delete.
+
+ * ox-html.el (html): Update HTML options names.
+
+ * org.el (org-show-context): Don't try to fix ellipsis when
+ showing a subtree in agenda.
+
+ * ox-html.el (html): Reintroduce #+HTML_HEAD_EXTRA, previously
+ known as HTML_STYLE_EXTRA.
+ (org-html-head): Enhance docstring.
+ (org-html-head-extra): Reintroduce. Was `org-html-style-extra'.
+ (org-html--build-head): Rename from `org-html--build-head'.
+ Add information from `org-html-head-extra'.
+ (org-html-template): Use `org-html--build-head'.
+
+ * ox-html.el (org-html-display-buffer-mode): Delete.
+ (org-html-export-as-html): Use `set-auto-mode' instead of
+ `org-html-display-buffer-mode'.
+
+ * org-agenda.el (org-agenda-write): Overwrite file when called
+ non-interactively.
+
+ * org-mobile.el (org-mobile-edit): Workaround a
+ `org-insert-heading-respect-content' bug which prevents correct
+ insertion when point is invisible
+
+ * org.el (org-previous-line-empty-p): New parameter to allow
+ checking next line. Add a docstring.
+ (org-insert-heading): Handle two universal prefix arguments as
+ advertised in the docstring. Don't insert new lines when
+ creating a heading after the first heading in the current
+ subtree.
+ (org-insert-heading-respect-content): New optional argument
+ arg, passed to `org-insert-heading'.
+
+ * org.el (org-mode): Remove syntax entries.
+ Use `org-backward-element' and `org-forward-element' for
+ `beginning-of-defun-function' and `end-of-defun-function': this
+ allows using C-M-a and C-M-e before the first headline.
+
+ * ox-html.el (html): Remove :html-htmlized-css-url :options-alist.
+
+ * ox-org.el (org-org-htmlized-css-url): Rename from
+ `org-html-htmlized-org-css-url' and moved here from ox-html.el.
+ (org-org-publish-to-org): Handle :htmlized-source in
+ publishing projects.
+
+ * ox-html.el (org-html-style-default): Update docstring.
+ (org-html-infojs-install-script, org-html--build-style):
+ Update property names.
+ (org-html-head-include-scripts)
+ (org-html-head-include-default-style, org-html-head):
+ Respectively rename from `org-html-style-include-scripts',
+ `org-html-style-include-default' and `org-html-style', now
+ obsolete.
+ (org-html-style-extra): Delete.
+
+ * org-clock.el (org-clock-out): Fix bug: if a closing note needs
+ to be stored in the drawer where clocks are stored, let's
+ temporarily remove `org-clock-remove-empty-clock-drawer' from
+ `org-clock-out-hook'.
+
+ * ob-tangle.el (org-babel-tangle): Remove unused attempt of
+ prompting the user of the tangle file name since :tangle is always
+ set. Don't prompt for a tangle file name when called with two
+ universal prefix arg outside of a src block.
+ Use `org-babel-tangle-single-block'.
+ (org-babel-tangle-single-block): New function.
+ (org-babel-tangle-collect-blocks): Use the new function.
+
+ * org-table.el (org-table-convert-region, org-table-export)
+ (org-table-align, org-table-beginning-of-field)
+ (org-table-copy-down, org-table-check-inside-data-field)
+ (org-table-insert-column, org-table-find-dataline)
+ (org-table-delete-column, org-table-move-column)
+ (org-table-insert-row, org-table-insert-hline)
+ (org-table-kill-row, org-table-paste-rectangle)
+ (org-table-wrap-region, org-table-sum, org-table-get-formula)
+ (org-table-get-formula, org-table-get-stored-formulas)
+ (org-table-fix-formulas, org-table-maybe-eval-formula)
+ (org-table-rotate-recalc-marks, org-table-eval-formula)
+ (org-table-get-range, org-table-get-descriptor-line)
+ (org-table-find-row-type, org-table-recalculate)
+ (org-table-iterate, org-table-iterate-buffer-tables)
+ (org-table-formula-handle-first/last-rc)
+ (org-table-edit-formulas, org-table-fedit-shift-reference)
+ (org-rematch-and-replace, org-table-shift-refpart)
+ (org-table-fedit-finish, org-table-fedit-lisp-indent)
+ (org-table-show-reference, org-table-show-reference)
+ (org-table-show-reference, org-table-show-reference)
+ (org-table-force-dataline, orgtbl-error, orgtbl-export)
+ (orgtbl-send-replace-tbl, org-table-to-lisp)
+ (orgtbl-send-table, orgtbl-send-table, orgtbl-send-table)
+ (orgtbl-toggle-comment, orgtbl-insert-radio-table)
+ (orgtbl-to-unicode, org-table-get-remote-range)
+ (org-table-get-remote-range, org-table-copy-dow)
+ (org-table-check-inside-data-field, org-table-insert-colum)
+ (org-table-find-dataline, org-table-delete-colum)
+ (org-table-move-column, org-table-insert-ro)
+ (org-table-insert-hline, org-table-kill-ro)
+ (org-table-paste-rectangle, org-table-wrap-regio)
+ (org-table-sum, org-table-get-formul)
+ (org-table-get-stored-formulas, org-table-fix-formula)
+ (org-table-maybe-eval-formul, org-table-rotate-recalc-marks)
+ (org-table-eval-formul, org-table-get-range)
+ (org-table-get-descriptor-lin, org-table-find-row-type)
+ (org-table-recalculat, org-table-iterate)
+ (org-table-iterate-buffer-table)
+ (org-table-formula-handle-first/last-r)
+ (org-table-edit-formulas, org-table-fedit-shift-referenc)
+ (org-rematch-and-replace, org-table-shift-refpar)
+ (org-table-fedit-finish, org-table-fedit-lisp-inden)
+ (org-table-show-reference, org-table-force-datalin)
+ (orgtbl-error, orgtbl-export, orgtbl-send-replace-tb)
+ (org-table-to-lisp, orgtbl-send-tabl, orgtbl-toggle-comment)
+ (orgtbl-insert-radio-tabl, orgtbl-to-unicode)
+ (org-table-get-remote-range): Use `user-error' instead of
+ `error' for user errors.
+
+ * ob-core.el (org-babel-load-in-session): Throw a useful error
+ when there is no code block at point.
+
+ * ob-tangle.el (org-babel-tangle): Rename the ONLY-THIS-BLOCK
+ parameter to ARG. Allow two universal prefix arguments to tangle
+ by the target file of the block at point.
+ (org-babel-tangle-collect-blocks): New parameter TANGLE-FILE
+ to restrict the collection of blocks to those who will be
+ tangled in TARGET-FILE.
+
+ * org-src.el (org-edit-src-auto-save-idle-delay): Use a delay of 0
+ by default (i.e., deactivate auto-saving.)
+ (org-edit-src-code): Set `buffer-auto-save-file-name' for
+ auto-saving with `auto-save-mode'.
+
+ * org.el (org-deadline, org-schedule): When called with two
+ universal prefix arguments, set the warning time or the delay
+ 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.
+ (org-agenda-entry-text-mode): Don't allow in filtered views.
+ Don't show the maximum number of lines when turning off.
+
+ * ox-html.el (org-html-headline): Add comment.
+
+ * org.el (org-mode): Set `paragraph-start'.
+
+ * org-agenda.el (org-agenda-entry-text-leaders): New option.
+ (org-agenda-entry-text-show-here): Use it.
+
+ * ox-html.el (org-html-link--inline-image): Always retrieve
+ attributes for inline images.
+ (org-html-link): Fix trailing whitespace at the end of the opening
+ <a ...> HTML tag.
+ (org-html-headline): For headlines whose first element is a
+ headline and not a section, pretend there is an empty section (as
+ "") for the correct HTML div to be inserted.
+
+ * org-agenda.el (org-agenda-collect-markers)
+ (org-create-marker-find-array): Move to ox-icalendar.el.
+ (org-agenda-marker-table, org-check-agenda-marker-table):
+ Delete.
+
+ * ox-icalendar.el (org-icalendar-create-uid): New parameter
+ H-MARKERS to only update some headlines, not the whole file.
+ (org-icalendar--combine-files): When exporting to an .ics file
+ only add UID to the headlines shown in the agenda buffer.
+ (org-agenda-collect-markers, org-create-marker-find-array):
+ Move here.
+
+ * org-agenda.el (org-agenda-write): Ask before overwriting an
+ existing file.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/infojs_opt):
+ Use `org-html-infojs-opts-table'.
+
+ * ox-html.el (org-html-infojs-opts-table):
+ (org-html-use-infojs, org-html-infojs-options)
+ (org-html-infojs-template): Move from ox-jsinfo.el. Rename using
+ the org-html- prefix.
+ (org-html-infojs-install-script): Move from ox-jsinfo.el.
+
+ * ox-jsinfo.el: Delete.
+
+ * ox-html.el (org-html-section): Fix indentation.
+ (org-html-inner-template): Add the document title here, within the
+ "content" class, as the org-info.js needs it.
+ (org-html-template): Don't include the document's title here.
+ (org-html-format-inlinetask-function): Remove wrong example.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Don't collect
+ blocks in commented out headings.
+
+ * ox-latex.el (org-latex-logfiles-extensions)
+ (org-latex-remove-logfiles): Improve docstrings.
+
+ * org-capture.el (org-capture): Cosmetic fix.
+
+ * org-protocol.el (org-protocol-create-for-org)
+ (org-protocol-create): Small docstrings enhancements.
+
+ * org-protocol.el (org-protocol-capture): Small docstring fix.
+
+ * org.el (org-speed-command-activate): Only forbid in src code
+ blocks.
+
+ * org-indent.el
+ (org-indent-add-properties): Bugfix: prevent negative value for
+ `added-ind-per-lvl'.
+
+ * org.el (org-mode): Add `org-fix-ellipsis-at-bol' to
+ `isearch-mode-end-hook' so that any isearch fixes the problem with
+ ellipsis on the first line.
+ (org-fix-ellipsis-at-bol): New defsubst.
+ (org-show-context, org-isearch-end): Use it.
+
+ * org-agenda.el (org-agenda-deadline-leaders): New formatting
+ string for past deadlines.
+ (org-agenda-scheduled-leaders): Small change.
+ (org-agenda-get-deadlines): Use the new formatting string.
+
+ * ob-lob.el (org-babel-lob-execute): Rename cache? to cache-p.
+
+ * org.el (org-speed-command-activate): Don't activate speed
+ commands within blocks.
+
+ * org.el (org-show-context): Remove useless catch. Make sure the
+ top of the window is a visible headline.
+ (org-activate-plain-links): Remove unused catch.
+
+ * org-macs.el (org-get-alist-option): Return nil, not (nil), so
+ that `org-show-context' DTRT.
+
+ * org.el (org-imenu-get-tree): Fix bug when matching against empty
+ headlines.
+ (org-overview): Stay on current line.
+ (org-map-entries): Fix docstring.
+
+ * org-macs.el (org-unmodified): Update comment. Don't define
+ `with-silent-modifications' for emacsen that don't have it.
+
+ * org-compat.el (org-with-silent-modifications):
+ New compatibility macro.
+
+ * org.el (org-refresh-category-properties)
+ (org-refresh-properties, org-entry-blocked-p)
+ (org-agenda-prepare-buffers):
+
+ * org-indent.el (org-indent-remove-properties)
+ (org-indent-add-properties):
+
+ * org-colview.el (org-columns-display-here)
+ (org-columns-remove-overlays, org-columns-quit)
+ (org-columns-edit-value, org-columns-compute-all)
+ (org-columns-compute, org-agenda-colview-compute):
+
+ * org-clock.el (org-clock-sum): Use the compatibility macro
+ `org-with-silent-modifications' instead of
+ `with-silent-modifications'.
+
+ * org.el (org-sort-remove-invisible): Remove emphasis markers.
+
+ * org.el (org-sort-remove-invisible): Use defsust. Do not only
+ check against invisible links, truly returns the visible part of
+ the string.
+ (org-sort-remove-invisible): Add a docstring.
+ (org-sort-entries): Remove hidden links when comparing entries.
+
+ * org-list.el (org-sort-list): Remove hidden links when comparing
+ list items.
+
+ * ox-html.el (org-html-headline): Fix typo.
+ (org-html-format-headline--wrap): Cosmetic change.
+
+ * org.el (org-at-clock-log-p): Delete.
+
+ * org-clock.el (org-at-clock-log-p): Move here.
+
+ * ox-html.el (org-html-format-headline-function): Fix docstring.
+
+ * ob-sql.el (org-babel-execute:sql): Add header row delimiter for
+ both mysql and postgresql.
+
+ * org.el (org-agenda-prepare-buffers): Don't use
+ `with-silent-modifications' too early.
+
+ * org-macs.el: Add a comment on when to use `org-unmodified' and
+ when to use `with-silent-modifications'.
+
+ * org-colview.el (org-columns-display-here)
+ (org-columns-remove-overlays, org-columns-quit)
+ (org-columns-edit-value, org-columns-compute-all)
+ (org-columns-compute, org-agenda-colview-compute):
+ * org-clock.el (org-clock-sum):
+ * org.el (org-refresh-category-properties)
+ (org-refresh-properties, org-entry-blocked-p)
+ (org-agenda-prepare-buffers): Use `with-silent-modifications'
+ instead of `org-unmodified'.
+
+ * ox-publish.el (org-publish-sitemap-date-format): Small docstring
+ enhancement.
+
+ * ox-latex.el (org-latex-format-headline-default-function):
+ New option.
+ (org-latex-format-headline-function): Use the new option as
+ the default value.
+ (org-latex-toc-command): Don't add vertical space after the table
+ of contents.
+
+ * org.el (org-entry-blocked-p): Use `org-unmodified' instead of
+ `org-with-buffer-modified-unmodified'.
+ (org-agenda-prepare-buffers): Fix indentation.
+
+ * org-macs.el (org-unmodified): Rename from
+ `org-with-buffer-modified-unmodified'.
+ (org-with-buffer-modified-unmodified): Delete.
+
+ * ob-python.el (org-babel-python-command): Use a defcustom.
+ (org-babel-python-mode): Use a defcustom and default to
+ 'python-mode when featured.
+
+ * org-agenda.el (org-agenda-start-day): Refer to `org-read-date'
+ in the docstring.
+
+ * ox-org.el (org-org-publish-to-org): Autoload.
+
+ * org-protocol.el:
+ * org-bibtex.el: Remove remember support.
+
+ * org-clock.el (org-clock-heading-for-remember): Delete.
+ (org-clock-in): Do not set the heading for remember.
+
+ * org.el (org-move-subtree-down, org-forward-element)
+ (org-backward-element):
+
+ * org-table.el (org-table-previous-field)
+ (org-table-move-column, org-table-move-row):
+
+ * org-list.el (org-move-item-down, org-move-item-up)
+ (org-cycle-item-indentation): Use `user-error' when moving or
+ modifying the element at point is not possible.
+
+ * ox-html.el (org-html-table-header-tags)
+ (org-html-table-data-tags, org-html-table-row-tags)
+ (org-html-table-align-individual-fields): Use the
+ org-export-html group.
+ (org-html-inline-src-block, org-html-link): Fix error messages.
+ (org-html-begin-plain-list): Fix formatting, better FIXME
+ comment.
+
+ * org.el (org-fill-paragraph): Fill using
+ `org-mode-transpose-word-syntax-table'.
+
+ * ox-org.el (org-org-publish-to-org): New defun.
+
+ * ox-html.el (org-export-htmlize): Delete group.
+ (org-html-htmlize-output-type)
+ (org-html-htmlized-org-css-url)
+ (org-html-htmlize-region-for-paste): Rename from
+ org-export-htmlize-*.
+ (org-html-htmlize-generate-css, org-html-fontify-code):
+ Use the correct names.
+
+ * org-compat.el (org-file-equal-p): New compatibility function.
+
+ * ox.el (org-export-output-file-name): Use the new function.
+
+ * org-clock.el (org-clock-set-current)
+ (org-clock-delete-current): Delete.
+ (org-clock-in, org-clock-out): Set and delete
+ `org-clock-current-task'. Minor code clean-up.
+
+ * org-clock.el (org-clock-in, org-clock-in-last):
+ Tell `org-current-time' to always return a past time.
+
+ * org.el (org-current-time): New argument `past' to force
+ returning a past time when rounding.
+
+ * org-agenda.el (org-agenda-unmark-clocking-task): New function.
+ (org-agenda-mark-clocking-task): Use it.
+ (org-agenda-clock-in): Let the cursor where it is.
+ (org-agenda-clock-out): Ditto. Also remove the
+ `org-agenda-clocking' overlay.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Fix restriction
+ so that it ends at the beginning of the next headline at the same
+ level.
+
+ * org.el (org-set-effort, org-property-next-allowed-value):
+ When needed, update the current clock effort time.
+ (org-next-link): New parameter `search-backward'. Fix bug when at
+ a link with no 'org-link face, e.g., in a DONE headline. Throw a
+ message instead of an error.
+ (org-previous-link): Use `org-next-link'.
+
+ * org-agenda.el (org-agenda-format-item): Only set the breadcrumbs
+ when `org-prefix-has-breadcrumbs' is non-nil.
+
+ * org.el (org-mode): Don't make characters from
+ `org-emphasis-alist' word constituents.
+ (org-mode-transpose-word-syntax-table): Rename from
+ `org-syntax-table'.
+ (org-transpose-words):
+ Use `org-mode-transpose-word-syntax-table'.
+
+ * ox.el (org-export--dispatch-ui)
+ (org-export--dispatch-action): Use integers for control chars.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Put the
+ overlay until the end of the subtree, not the end of the
+ headline.
+
+ * org.el (org-entry-delete, org-delete-property): New optional
+ arg delete-empty-drawer, a string, to delete any empty drawer
+ with that name.
+ (org-toggle-ordered-property): Delete the drawer "PROPERTIES"
+ if empty.
+
+ * org-src.el (org-src-mode-map, org-edit-src-code)
+ (org-edit-fixed-width-region, org-edit-src-save): Use C-c C-k
+ for `org-edit-src-abort'.
+
+ * org.el (org-mode): Use org-unmodified during startup
+ initialization for functions that may be inhibited.
+
+ * org-table.el (org-table-align): Only set the window start
+ when table alignment is performed in the selected window.
+
+ * org-src.el (org-edit-src-auto-save-idle-delay): New option.
+ (org-src-ask-before-returning-to-edit-buffer): Make a defcustom.
+ (org-edit-src-code-timer): New timer variable.
+ (org-edit-src-code): Run the timer.
+ (org-edit-fixed-width-region): Enhance message.
+ (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
+ editing buffer.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option):
+ Require 'org-element. This fixes a bug about unbound variable
+ `org-element-affiliated-keywords' when trying to complete a
+ keyword before 'org-element was required.
+
+ * org-list.el (org-list-bullet-string): Replace match when there
+ is a match, otherwise just return the bullet.
+
+ * org-src.el (org-src-mode-map): New binding C-c k to abort
+ editing.
+ (org-edit-src-code): Mention the keybinding to abort editing
+ and go back to the correct position.
+ (org-edit-src-abort): New command to abort editing.
+
+ * ox-html.el (org-html--build-meta-info): Add a newline before
+ the title meta information.
+
+ * org.el (org-return-follows-link): Mention that this does not
+ affect the behavior of RET in tables.
+
+ * ox-html.el (org-html--build-mathjax-config): Only include
+ MathJax configuration if the resulting HTML contains LaTeX
+ fragments.
+
+ * org.el (org-syntax-table, org-transpose-words): Delete.
+ (org-mode): Syntactically Define {} and <> as parentheses.
+ (org-drag-line-forward, org-drag-line-backward):
+ New functions.
+ (org-shiftmetaup, org-shiftmetadown): Fall back on the new
+ functions instead of throwing an error.
+ (org-make-org-heading-search-string): Don't use statistic or [x/y]
+ cookies when creating a link.
+
+ * ox-html.el (org-html-table): Append #+attr_html attributes.
+
+ * org.el (org-emphasis-alist, org-protecting-blocks):
+ * org-src.el (org-edit-src-find-region-and-lang):
+ * org-list.el (org-list-forbidden-blocks):
+ * org-footnote.el (org-footnote-forbidden-blocks):
+ Remove references to the deleted DocBook exporter.
+
+ * org.el (org-end-of-line): Don't throw an error outside elements.
+
+ * ox-html.el (org-html-link): Don't throw an error if the value
+ of the :ID: property has not been generated by uuidgen.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/x):
+ Resurrect. Use `org-default-options' to initialize completion
+ fonctions for the most important keywords.
+
+ * org-macs.el (org-default-options): Rename and adapt from
+ `org-get-current-options'.
+
+ * org.el (org-options-keywords): Add keywords.
+
+ * ox-odt.el (org-odt-convert-read-params): Fix typo in prompt.
+
+ * ox-latex.el (org-latex-horizontal-rule): Fix typo in docstring.
+
+ * ox-html.el (org-html-display-buffer-mode): New option.
+ (org-html-export-as-html): Use it.
+
+ * ob-core.el (org-babel-insert-result): Fix bug when inserting
+ an empty string as the result.
+
+ * org.el (org-timestamp-change): New optional parameter
+ `suppress-tmp-delay' to suppress temporary delay like "--2d".
+ (org-auto-repeat-maybe): Suppress temporary delays.
+
+ * org-agenda.el (org-agenda-get-scheduled): When the delay is
+ of the form "--2d" and there is a repeater, ignore the delay
+ for further repeated occurrences.
+
+ * org-agenda.el (org-agenda-get-deadlines)
+ (org-agenda-get-scheduled): Minor refactoring.
+
+ * org.el (org-time-string-to-absolute): Tiny docstring enhancement.
+ (org-edit-special): Don't allow to edit when buffer is read only.
+
+ * ox-html.el (org-html-format-latex): Don't set `cache-relpath'
+ and `cache-dir' when `processing-type' is 'mathjax.
+ (org-html-format-latex): Fix conversion in non-file buffers.
+
+ * org.el (org-speed-commands-default): Bind `B' and `F' to
+ `org-previous-block' and `org-next-block'.
+ (org-read-date-minibuffer-local-map): Use "!" instead of "?" to
+ see today's diary as "?" is already bounded by Calendar.
+ (org-read-date-minibuffer-local-map): Use "." to go to today's
+ date.
+
+ * ob-core.el (org-babel-next-src-block)
+ (org-babel-previous-src-block): Rewrite using
+ `org-next-block'.
+
+ * org.el (org-next-block, org-previous-block): New navigation
+ commands.
+ (org-mode-map): Bind the new commands to C-c C-F and C-c C-B
+ respectively.
+
+ * org-agenda.el (org-agenda-write): Don't copy headlines' subtrees
+ when writing to an .org file.
+
+ * org.el (org-copy-subtree): New parameter `nosubtrees'.
+
+ * org-agenda.el (org-agenda-write): Allow writing to an .org file.
+
+ * org.el (org-paste-subtree): Fix typo in docstring.
+
+ * org-agenda.el (org-agenda-get-todos)
+ (org-agenda-get-timestamps): Use nil as `ts-date' for diary
+ sexpressions.
+ (org-agenda-get-todos): Skip diary sexps when trying to sort by
+ timestamp.
+ (org-agenda-max-entries, org-agenda-max-todos)
+ (org-agenda-max-tags, org-agenda-max-effort): New options.
+ (org-timeline, org-agenda-list, org-search-view)
+ (org-todo-list, org-tags-view): Tell `org-agenda-finalize-entries'
+ what agenda type we are currently finalizing for.
+ (org-agenda-finalize-entries): Limit the number of entries
+ depending on the new options.
+ (org-agenda-limit-entries): New function.
+
+ * org.el (org-deadline): Allow a double universal prefix argument
+ to insert/update a warning cookie.
+ (org-deadline): Allow a double universal prefix argument to
+ insert/update a delay cookie.
+
+ * org-agenda.el (org-agenda-skip-scheduled-delay-if-deadline):
+ New option. The structure of the possible values is copied
+ from `org-agenda-skip-deadline-prewarning-if-scheduled'.
+ (org-agenda-get-scheduled): Honor the two new option,
+ `org-scheduled-delay-days' and
+ `org-agenda-skip-deadline-prewarning-if-scheduled'. I.e. if a
+ scheduled entry has a delay cookie like "-2d" (similar to the
+ prewarning cookie for deadline), don't show the entry until
+ needed.
+
+ * org.el (org-deadline-warning-days): Small docstring fix.
+ (org-scheduled-delay-days): New option (see
+ `org-deadline-warning-days'.)
+ (org-get-wdays): Use the new option.
+
+ * org-agenda.el (org-agenda-sorting-strategy): Document the
+ 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
+ date.
+ (org-cmp-ts): New function to compare timestamps.
+ (org-em): Add a docstring.
+ (org-entries-lessp): Use `org-cmp-ts' to compare timestamps.
+ Implement the following sorting strategies: timestamp-up/down,
+ scheduled-up/down, deadline-up/down, ts-up/down (for active
+ timestamps) and tsia-up/down (for inactive timestamps.)
+
+ * ob-lilypond.el (ly-process-basic): Bugfix, don't use `pcase'.
+
+ * org.el (org-contextualize-validate-key): Check against two new
+ context predicates [not-]in-buffer.
+
+ * org-agenda.el (org-agenda-custom-commands-contexts):
+ Document the new [not-]in-buffer context predicates.
+
+ * ob-core.el (org-ts-regexp): Remove duplicate defconst'ing.
+ (org-babel-result-regexp): Don't use `org-ts-regexp', use a regexp
+ string directly.
+
+ * ob-lilypond.el (ly-process-basic): Don't use `ly-gen-png' and
+ friends, rely on the extension of the output file.
+
+ * org-archive.el (org-archive-file-header-format): New option.
+ (org-archive-subtree): Use it.
+
+ * ob-lilypond.el (ly-process-basic): Rely on ly-gen-png/pdf/eps to
+ set the output type.
+
+ * org.el (org-read-date-minibuffer-local-map): New variable.
+ (org-read-date): Use it.
+ (org-read-date-minibuffer-setup-hook): Mark as obsolete.
+ (org-read-date): Bind `!' to `diary-view-entries' in order to
+ check diary entries while setting an Org date.
+
+ * org-agenda.el (org-diary): Only keep the descriptions of the
+ links since Org links are not active in the diary buffer.
+
+ * org-faces.el (org-priority): New face.
+
+ * org.el (org-font-lock-add-priority-faces): Use the new face.
+
+ * org-agenda.el (org-agenda-fontify-priorities): Use the
+ org-priority face and add specific agenda face on top of it.
+
+ * org-agenda.el (org-agenda-show-clocking-issues)
+ (org-agenda-format-item): Let-bind
+ `org-time-clocksum-use-effort-durations' to nil.
+
+ * org.el (org-ctrl-c-ctrl-c): Only throw a message when using two
+ universal prefix arguments on a list where all items are already
+ in a transitory state. Refine the error when the checkbox cannot
+ be toggled.
+
+ * org.el ("org-loaddefs.el"): Load org-loaddefs.el before
+ requiring any org library. Also use `load', not
+ `org-load-noerror-mustsuffix'.
+ (org-effort-durations): Move up to fix a compiler warning.
+ (org-edit-special): Fix typo in docstring.
+ (org-time-clocksum-format): Add a version tag and add to the
+ 'org-clock group.
+ (org-time-clocksum-use-fractional): Ditto.
+ (org-time-clocksum-use-effort-durations): New option to allow
+ using `org-effort-durations' when computing clocksum durations.
+ (org-minutes-to-clocksum-string): Use the new option.
+
+ * org-clock.el (org-clocktable-write-default): Let-bind
+ `org-time-clocksum-use-effort-durations' to a new clocktable
+ parameter ":effort-durations".
+
+ * org-entities.el (org-entities): "neg" should be used in LaTeX
+ math mode. Add the "neg" entity.
+
+ * org-mobile.el (org-mobile-allpriorities): New option.
+ (org-mobile-create-index-file): Use the new option.
+
+ * org-latex.el (org-export-latex-inline-images): New option.
+
+ * org.el (org-forward-heading-same-level): Before the first
+ headline, go to the first headline.
+ (org-backward-heading-same-level): Before the first headline,
+ go to the beginning of the buffer, like
+ `outline-previous-visible-heading' does.
+
+ * org-exp.el (org-export-plist-vars): Don't use
+ `org-export-html-inline-images' to set the :inline-images
+ property, use distinct properties for the various backends.
+
+ * org-publish.el (org-publish-project-alist): Ditto.
+
+ * org-latex.el (org-export-latex-links): Use :latex-inline-images
+ instead of :inline-images.
+
+ * org-odt.el (org-compat): Require.
+
+ * org.el (org-parse-time-string): Allow strings supported by
+ tags/properties matcher (eg <now>, <yesterday>, <-7d>).
+
+ * org-clock.el (org-clock-rounding-minutes): New option to round
+ the time by N minutes in the past when clocking in or out.
+ (org-clock-in, org-clock-in-last, org-clock-out): Use the new
+ option.
+
+ * org.el (org-current-time): New optional parameter
+ `rounding-minutes' to override the use of
+ `org-time-stamp-rounding-minutes' for rounding.
+
+ * org-clock.el (org-clock-special-range): Small docstring fix.
+ New parameter 'weekstart to define the week start day.
+ (org-clock-special-range, org-dblock-write:clocktable)
+ (org-dblock-write:clocktable, org-clocktable-write-default)
+ (org-clocktable-steps, org-clock-get-table-data): Use the new
+ parameter.
+ (org-clocktable-defaults): Set monday as the starting day of the
+ week by setting :wstart to 1.
+
+ * org.el (org-store-link): Fix the naming of internal links to
+ lines starting with a keyword.
+
+ * org-agenda.el (org-agenda-Quit, org-agenda-quit)
+ (org-agenda-exit, org-agenda-kill-all-agenda-buffers):
+ Docstring fixes.
+
+ * org.el (org-last-set-property-value): New variable.
+ (org-read-property-name): Fix dangling parentheses.
+ (org-set-property-and-value): New command to manually set
+ both the property and the value. A prefix arg will use the
+ last property-value pair set without prompting the user.
+ (org-set-property): Set `org-last-set-property-value'.
+ (org-mode-map): Bind the new command to `C-c C-x P'.
+ (org-find-invisible-foreground): Delete.
+ (org-mode): Use `face-background' instead of
+ `org-find-invisible-foreground'.
+ (org-startup-options): New startup keywords.
+ (org-log-into-drawer): Update docstring to explain how to set this
+ variable through the startup keyword "logdrawer" and "nologdrawer".
+ (org-log-states-order-reversed): Document the new startup keywords
+ "logstatesreversed" and "nologstatesreversed".
+ (org-mode-map): Use `org-remap' instead of binding `M-t' to
+ `org-transpose-words' directly.
+ (org-syntax-table): New variable.
+ (org-transpose-words): New command, simply wrapping the new
+ syntax table around `transpose-words'.
+ (org-mode-map): Bind `org-transpose-words' to `M-t'.
+ (org-store-link): Use keyword at point as the search string.
+ Use `delq nil' instead of `delete nil'.
+ (org-make-org-heading-search-string): Rewrite using
+ org-element.el. Not an interactive function anymore.
+
+ * org-pcomplete.el (pcomplete/org-mode/drawer): Ditto.
+
+ * org-mobile.el (org-mobile-files-alist): Ditto.
+
+ * org.el (org-store-link): When creating a link to a heading with
+ a bracket link, don't escape this link with curly braces as the
+ escaped link is not active anyway; use the description instead.
+ If the headline only consists of a bracket link, add a star to the
+ description so that the user knows this is an internal link.
+
+ * org-w3m.el (org-w3m-store-link): New function.
+
+ * org.el (org-store-link): Update the error message when no method
+ is available for storing a link. Use `user-error' for this.
+ Remove handling w3m links from this function.
+ (org-insert-heading, org-insert-todo-heading): A double prefix arg
+ force the insertion of the subtree at the end of the parent
+ subtree.
+ (org-store-link): A double prefix argument now skips module
+ store-link functions to only use Org's core functions. Also, when
+ several modular store-link functions match, ask for which one to
+ use.
+ (org-cycle, org-cycle-internal-global)
+ (org-cycle-internal-local, org-display-outline-path): Let-bind
+ `message-log-max' to nil so that messages don't populate the
+ *Messages* buffer.
+
+ * org-table.el (org-table-eval-formula): Handle localized
+ time-stamps by internally converting them to english during
+ formulas evaluation.
+
+ * org.el (org-clock-timestamps-up): Fix declarations.
+
+ * ob-core.el (org-split-string): Declare function.
+
+ * org-html.el (org-html-export-list-line): Add CSS classes to
+ these list HTML tags: <ul> <dl> and <ol>.
+
+ * org-clock.el (org-clock-timestamps-up)
+ (org-clock-timestamps-down, org-clock-timestamps-change):
+ Add an optional argument N to change timestamps by several units.
+
+ * org.el (org-shiftcontrolup, org-shiftcontroldown): Ditto.
+
+ * org-exp.el (org-export-copy-to-kill-ring): Add a new choice
+ 'if-interactive and use it as the default.
+ (org-export-push-to-kill-ring): Use the new choice.
+
+ * org.el (org-block-entry-blocking): New variable.
+ (org-todo): Use it. Also use `user-error' when a TODO state
+ change is blocked.
+ (org-block-todo-from-children-or-siblings-or-parent):
+ Display `org-block-entry-blocking' in the user-error message.
+
+ * org.el (org-get-cursor-date): New optional argument WITH-TIME to
+ add the time of the day.
+
+ * org-capture.el (org-capture): When capturing from the agenda and
+ with a non-nil value for `org-capture-use-agenda-date', a `C-1'
+ prefix will set the capture time to the HH:MM of the current line
+ or the current HH:MM.
+
+ * org-agenda.el (org-agenda-capture): New optional argument
+ WITH-TIME: when set to 1, the capture time will be set to the
+ HH:MM time of the current line, or the current HH:MM time.
+
+ * org.el (org-latex-preview-ltxpng-directory): Fix docstring
+ formatting.
+ (org-deadline-close): Use `org-time-stamp-to-now'.
+ (org-time-stamp-to-now): Use `org-float-time' instead of the
+ obsolete `time-to-seconds' function.
+ (org-format-outline-path): Fix bug: add the separator string after
+ the prefix.
+ (org-display-inline-images): Search for #+ATTR within the current
+ paragraph.
+ (org-days-to-time): Make obsolete.
+ (org-time-stamp-to-now): Rename from `org-days-to-time'.
+ Allow to compare time-stamps based on seconds.
+
+ * org-agenda.el (org-agenda-todo-ignore-time-comparison-use-seconds):
+ New option to compare time stamps using seconds, not days.
+ (org-agenda-todo-custom-ignore-p)
+ (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item):
+ Use the new function's name and the new option.
+
+ * org-clock.el (org-clock-sound): Enhance docstring.
+ (org-notify): Use the parameter `play-sound' as argument for
+ `org-clock-play-sound'.
+ (org-clock-play-sound): New optional argument `clock-sound' to
+ override `org-clock-sound'.
+
+ * org-agenda.el (org-agenda-format-item): Fix initialization
+ of the level text property.
+
+ * org.el (org-format-outline-path): Small docstring
+ enhancement.
+ (org-display-outline-path): Fix order or arguments.
+
+ * org.el (org-activate-plain-links)
+ (org-activate-bracket-links): Add a new 'htmlize-link text
+ property, so that htmlize (> version 1.42) can linkify the
+ links.
+ (org-display-outline-path): Allow a string value for the
+ `as-string' parameter. Such a value will replace the "/"
+ separator in the output. New argument `as-string'.
+ (org-refile-keep): New variable.
+ (org-copy): New command to copy notes.
+ (org-refile): New parameter msg to override the "Refile" string in
+ the default prompt.
+ (org-mode-map): Bind "C-c M-w" to `org-copy'.
+ (org-refile-get-location): Use the current file name as the
+ default target when there is no refile history.
+ (org-cycle-hide-inline-tasks): New function to hide inline tasks
+ when cycling.
+ (org-cycle-hook): Use the new function.
+ (org-entry-put): Fix bug when updating the last clock.
+ (org-use-last-clock-out-time-as-effective-time): New option.
+ (org-current-effective-time): Use the new option.
+
+ * org-clock.el (org-clock-get-last-clock-out-time):
+ New function.
+
+ * org.el (org-toggle-inline-images): Only send a message when
+ called interactively.
+ (org-scan-tags): Fix the declaration and the use of
+ `org-agenda-format-item'.
+
+ * org-agenda.el (org-agenda-add-time-grid-maybe): Use the
+ correct number of parameters for `org-agenda-format-item'.
+ Add a docstring.
+
+ * org.el (org-outline-level): Go at the beginning of the
+ headline first to always return a sensible result.
+
+ * org-agenda.el (org-search-view, org-agenda-get-todos)
+ (org-agenda-get-timestamps, org-agenda-get-sexps)
+ (org-agenda-get-progress, org-agenda-get-deadlines)
+ (org-agenda-get-scheduled, org-agenda-get-blocks): Return the
+ correct level depending on `org-odd-levels-only'.
+ (org-agenda-prefix-format): A new specifier `%l' allows to insert
+ X spaces when the item is of level X.
+ (org-search-view, org-get-entries-from-diary)
+ (org-agenda-get-todos, org-agenda-get-timestamps)
+ (org-agenda-get-sexps, org-agenda-get-progress)
+ (org-agenda-get-deadlines, org-agenda-get-scheduled)
+ (org-agenda-get-blocks, org-agenda-change-all-lines): Add a
+ new text property 'level, a string with as many whitespaces as
+ the level of the item.
+ (org-agenda-format-item, org-compile-prefix-format):
+ Handle the new `%l' specifier.
+
+ * org-colview.el (org-columns-next-allowed-value): Add the
+ CLOCKSUM property to the list of properties that can be
+ changed interactively from the column view.
+
+ * org.el (org-entry-put): Allow to set the CLOCKSUM property
+ by updating the most recent clock. This is useful in the
+ column view when you want to use S-<left/right> to update the
+ last clock of the entry at point.
+ (org-image-actual-width): New choice: use #+ATTR* or fall back on
+ a number.
+ (org-display-inline-images): Implement the new choice.
+ (org-image-actual-width): Rename from `org-image-fixed-width'.
+ Update the docstring. Give more choice.
+ (org-display-inline-images): Use the option new choices.
+ (org-image-fixed-width): New option to set a fixed width for
+ inline images.
+ (org-display-inline-images): Use the new option.
+
+ * org-agenda.el (org-class): Allow to use holiday strings for
+ the `skip-weeks' arguments.
+
+ * org.el (org-mode): Set the syntax of the " character to "string
+ quote".
+
+ * org-agenda.el (org-agenda-append-agenda): Bugfix: correctly
+ check whether we are in `org-agenda-mode'.
+ (org-agenda): Set `org-agenda-buffer-name' correctly with sticky
+ agendas and non-custom commands.
+
+2013-11-12 Carsten Dominik <carsten.dominik@gmail.com>
+
+ * org-src.el (org-edit-src-exit): Let overlay survive after the
+ buffer has been saved.
+
+ * ox-texinfo.el (org-texinfo-export-to-texinfo): Use new style
+ backquoting.
+ (org-texinfo-export-to-info): Use new style backquoting.
+
+ * ob-latex.el (org-babel-execute:latex): Call `file-name-sans-extension'
+ instead of `file-base-name'.
+
+ * org.el (org-insert-heading): Improve whitespace behavior at
+ end of subtree.
+ (org-latex-default-packages-alist): Add the `rotating' package to
+ the list of default packages. Improve docstring.
+ (org-insert-property-drawer): Insert only after space in current
+ line.
+ (org-forward-paragraph, org-backward-paragraph): Do not deactivate
+ the mark.
+ (org-special-ctrl-o): New option.
+ (org-open-line): Don't do anything special unless `org-special-ctrl-o'
+ is non-nil.
+
+ * org-agenda.el (org-agenda-custom-commands-local-options):
+ (org-agenda-span, org-agenda-ndays-to-span)
+ (org-agenda-span-to-ndays, org-agenda-list, org-agenda-later)
+ (org-agenda-change-time-span, org-agenda-compute-starting-span):
+ Add support for fortnight view.
+ (org-agenda-menu): Add fortnight view command.
+ (org-agenda-fortnight-view): New command.
+
+ * org-timer.el (org-clock-sound): Silence compiler.
+
+ * org.el (org-beginning-of-line, org-end-of-line):
+ Bind deactivate-mark to avoid that this command deactivates it.
+ (org-make-tags-matcher): Do not interpret / in property value as
+ starter of TODO match.
+ (org-overview): Preserve point.
+ (org-read-date-minibuffer-local-map): Don't replace disputed keys
+ when defining this keymap.
+ (org-read-date): Remove unnecessary binding of
+ `org-replace-disputed-keys'.
+ (org-insert-heading): Allow to remove blank lines if the user does
+ not want any.
+ (org-unlogged-message): Fix typo in dostring.
+
+ * ob-ruby.el: New customizations `org-babel-ruby-hline-to' and
+ `org-babel-ruby-nil-to'
+ (org-babel-ruby-var-to-ruby): Convert incoming 'hlines.
+ (org-babel-ruby-table-or-string): Convert outgoing nils.
+
+ * org.el (org-file-apps-defaults-gnu): Use `xdg-open' to open
+ files where available.
+
+ * org-table.el (orgtbl-radio-table-templates): Improve docstring.
+
+ * org.el (org-unlogged-message): New function.
+ (org-cycle, org-cycle-internal-global, org-cycle-internal-local)
+ (org-global-cycle, org-display-outline-path):
+ Use `org-unlogged-message'.
+
+ * org-pcomplete.el (org-make-org-heading-search-string):
+ Fix function declaration.
+ (pcomplete/org-mode/searchhead): Remove incorrect second arguments
+ to `org-make-org-heading-search-string'.
+
+ * org.el (org-read-date): Turn off replacing disputed keys when
+ defining the minibuffer keys during date selection.
+ (org-insert-heading): Improve the empty line insertion behavior.
+ Basically, never remove empty lines, only add them.
+
+ * org-attach.el (org-attach-commit): Use vc-git to find the git
+ repository.
+
+ * org-compat.el (org-move-to-column): Turn off invisibility stuff
+ for moving the cursor to a column.
+
+ * org.el (org-modules): Update with the new module org-mac-link.
+ (org-display-outline-path): Do not log outline path in Message
+ buffer.
+ (org-agenda-ignore-drawer-properties): New option.
+ (org-agenda-prepare-buffers):
+ Honour `org-agenda-ignore-drawer-properties'.
+
+ * org-clock.el (org-clock-goto): Recenter to thrd line
+
+ * org-table.el (orgtbl-send-replace-tbl): Allow multiple spaces
+ between keywords in RECEIVE ORGTBL lines.
+
+ * org.el (org-bookmark-names-plist): New user option.
+ (org-set-regexps-and-options-for-tags): Use `org-bookmark-names-plist'.
+ (org-refile): Use `org-bookmark-names-plist'.
+
+ * org-capture.el (org-capture-bookmark-last-stored-position):
+ Use `org-bookmark-names-plist'.
+
+ * org.el (org-insert-heading): Rewritten from scratch.
+ (org-N-empty-lines-before-current): New function
+ (org-insert-heading-respect-content): Set the correct argument to
+ force a heading even in lists.
+
+ * org-colview.el (org-columns-display-here): Enforce fixed width
+ font.
+
+ * org-faces.el (org-column): Setting font width has been shifted
+ to org-colview.el.
+
+ * org.el (org-mode-flyspell-verify): Check for src block.
+
+ * org-table.el (org-table-convert-region): Fix interactive
+ statement.
+
+ * org-ctags.el (org-ctags-path-to-ctags): Avoid usine `case'.
+
+ * org.el (org-beginning-of-line, org-end-of-line):
+ Set disable-point-adjustment when the command ends next to invisible
+ text.
+
+ * ob-lob.el (org-babel-lob-files): Fix custom type.
+
+ * org-agenda.el (org-agenda-export-html-style, org-agenda-ndays)
+ (org-agenda-inactive-leader, org-agenda-day-face-function)
+ (org-agenda-auto-exclude-function): Fix custom type.
+
+ * org-bibtex.el (org-bibtex-prefix): Fix custom type.
+
+ * org-clock.el (org-clock-heading-function):
+ (org-show-notification-handler): Fix custom type.
+
+ * org-footnote.el (org-footnote-auto-adjust): Fix custom type.
+
+ * org-protocol.el (org-protocol-default-template-key): Fix custom
+ type.
+
+ * org.el (org-make-link-description-function):
+ (org-link-translation-function):
+ (org-link-frame-setup):
+ (org-refile-target-verify-function):
+ (org-get-priority-function):
+ (org-use-fast-tag-selection):
+ (org-columns-modify-value-for-display-function):
+ (org-sparse-tree-default-date-type):
+ * ox-html.el (org-html-postamble):
+ (org-html-postamble-format):
+ (org-html-preamble-format):
+ * ox-odt.el (org-odt-content-template-file):
+ * ox.el (org-export-with-archived-trees):
+ (org-export-initial-scope): Fix custom type.
+
+ * org.el (org-insert-heading): Fix problem with inserting heading.
+ Check for checkbox at the beginning of the item, not just at the
+ beginning of the line.
+ (org-small-year-to-year): Fix docstring typo.
+ (org-show-siblings): By default, also show siblings from a
+ bookmark jump.
+
+ * org-agenda.el (org-agenda-set-restriction-lock): Highlight only
+ the headline when agenda is restricted to a subtree. Do not
+ highlight the entire subtree.
+
+ * org-table.el (org-table-eval-formula): Work-around for calc-eval
+ regression.
+
+ * ox.el (org-export-dispatch): Make sure the last position marker
+ uses the base buffer if there is one.
+ (org-export-dispatch-last-position): New variable.
+ (org-export-dispatch): Save position of cursor at the moment when
+ the export command is called. Restore that position temporarily
+ when repeating the previous export command.
+
+ * org.el (org-insert-heading): Shrink whitespace at end of subtree
+ when `org-insert-heading-respect-content' is on.
+
+ * org-list.el (org-sort-list): Respect sorting-type and
+ getkey-func when they are specified in the call.
+
+ * org.el (org-sort-entries): Respect sorting-type and getkey-func
+ when they are specified in the call.
+ (org-format-outline-path): New argument SEPARATOR to specify a
+ string that is inserted between parts of the outline path.
+ (org-display-outline-path): New argument SEPARATOR, to specify a
+ string that is inserted between parts of the outline path.
+
+ * org-colview.el (org-dblock-write:columnview): Change the capture
+ of pos to after inserting the original content
+
+2013-11-12 Christian Moe <mail@christianmoe.com>
+
+ * ox-odt.el (org-odt-line-break, org-odt-plain-text):
+ Remove newline after line-break tag.
+
+2013-11-12 Christophe Junke <christophe.junke@inria.fr> (tiny change)
+
+ * org.el (org-set-font-lock-defaults): Let footnote fontifications
+ be done before other links' fontification. This allows links
+ appearing inside footnotes to be both visible and active.
+
+2013-11-12 Christopher Schmidt <christopher@ch.ristopher.com>
+
+ * org.el (orgstruct-setup): Major rewrite.
+ (orgstruct++-mode): Overwrite local non-org vars again.
+ (orgstruct-mode): Simplify implementation. Emulate outline's
+ buffer-invisiblity-spec.
+ (orgstruct-heading-prefix-regexp): Change default value to nil.
+ (orgstruct-error): Use `user-error' if available.
+ {pro,de}motion commands if `orgstruct-heading-prefix-regexp' is
+ non-nil. Always use `org-outline-level'. Bind org-shift*.
+ (orgstruct-make-binding): Major rewrite.
+ (org-cycle-global-status, org-cycle-subtree-status): Set state
+ property.
+ (org-heading-components): Use `org-heading-regexp' in
+ orgstruct-mode.
+ (orgstruct-heading-prefix-regexp, orgstruct-setup-hook):
+ New options.
+ (orgstruct-initialized): New variable.
+ (org-get-local-variables): Honour state property.
+ (org-run-like-in-org-mode): Use `let' instead of `progv'. Do not
+ override variables with non-default values.
+ (org-forward-heading-same-level): Do not skip to headlines on
+ another level. Handle negative prefix argument correctly.
+ (org-backward-heading-same-level):
+ Use `org-forward-heading-same-level'.
+
+2013-11-12 Craig Tanis <craig-tanis@utc.edu> (tiny change)
+
+ * ox-latex.el (org-latex-src-block): Change format string to position
+ caption after figure content.
+
+2013-11-12 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ * org.el (org-ctrl-c-ctrl-c): `C-c C-c' on a link is usually a
+ no-op. If that link is in a headline, act as if the `C-c C-c' was
+ called on the headline, not the link.
+
+ * ox-html.el (org-html-doctype-alist): New variable holding an
+ alist of (X)HTML doctypes
+ (org-html-xhtml-p, org-html-html5-p, org-html-close-tag):
+ New function.
+ (org-html-html5-fancy): New export option, determining whether or
+ not to use HTML5-specific elements.
+ (org-html-html5-elements): New variable, new HTML5 elements.
+ (org-html-special-block): Export special blocks to new HTML5
+ elements.
+ (org-html-format-inline-image): Use <figure> and <figcaption> for
+ standalone images.
+ (org-html-format-inline-image, org-html--build-meta-info)
+ (org-html--build-head, org-html--build-pre/postable)
+ (org-html-template, org-html-horizontal-rule)
+ (org-html-format-list-item, org-html-line-break, org-html-table)
+ (org-html-verse-block): Changes to allow flavored export.
+
+ * ox-latex.el (org-latex--org-table, org-latex-table-row):
+ Allow use of the "tabu" and "longtabu" table environments. New table
+ attribute :spread handles the width specification syntax of "tabu"
+ and "longtabu" table environments.
+
+2013-11-12 Eric Schulte <eric.schulte@gmx.com>
+
+ * org-bibtex.el (org-bibtex-read-buffer): Reads all bibtex entries
+ in a buffer.
+ (org-bibtex-read-file): Read all bibtex entries in a file.
+ (org-bibtex-import-from-file): Import all bibtex entries from a
+ file into the current buffer.
+
+ * ob-tangle.el (org-babel-load-file): When called with a prefix
+ argument the tangled emacs-lisp file will be byte compiled.
+
+ * ob-tangle.el (org-babel-tangle): Tangled files should not be
+ writable.
+
+ * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): Better about
+ when to fully escape the results or just print them close to
+ verbatim.
+
+ * ob.el (org-babel-result-cond): This function should now be used
+ by all language backends to handle the processing of raw code
+ block output into scalar results, table results, or ignored
+ results depending on the value of result-params.
+
+ * ob-C.el (org-babel-C-execute): Use org-babel-result-cond.
+
+ * ob-R.el (org-babel-R-evaluate-external-process)
+ (org-babel-R-evaluate-session):
+ * ob-awk.el (org-babel-execute:awk):
+ * ob-clojure.el (org-babel-execute:clojure):
+ * ob-emacs-lisp.el (org-babel-execute:emacs-lisp):
+ * ob-fortran.el (org-babel-execute:fortran):
+ * ob-io.el (org-babel-io-evaluate):
+ * ob-java.el (org-babel-execute:java):
+ * ob-lisp.el (org-babel-execute:lisp):
+ * ob-maxima.el (org-babel-execute:maxima):
+ * ob-picolisp.el (org-babel-execute:picolisp):
+ * ob-python.el (org-babel-python-evaluate-external-process):
+ (org-babel-python-evaluate-session):
+ * ob-scala.el (org-babel-scala-evaluate):
+ * ob-sh.el (org-babel-sh-evaluate):
+ * ob-shen.el (org-babel-execute:shen):
+ * ob-sql.el (org-babel-execute:sql):
+ * ob-sqlite.el (org-babel-execute:sqlite):
+ Use `org-babel-result-cond'.
+
+ * ob.el (org-babel-common-header-args-w-values): Add a new "none"
+ header argument.
+ (org-babel-execute-src-block): Don't do *any* result processing if
+ the "none" header argument has been specified.
+ (org-babel-sha1-hash): Remove the none header argument from header
+ arg lists when calculating cache sums.
+ (org-babel-insert-result): Flesh out some documentation.
+
+ * ob.el (org-babel-insert-result): Don't escape results in
+ drawers.
+
+ * ob-python.el (org-babel-python-hline-to): Customize hline
+ conversion to python.
+ (org-babel-python-None-to): Customize none conversion from python.
+ (org-babel-python-var-to-python): Use new variable.
+ (org-babel-python-table-or-string): Use new variable.
+
+ * org.el (org-babel-load-languages): Add ob-makefile to
+ `org-babel-load-languages'.
+
+ * ob-makefile.el: New file.
+
+ * ob-sh.el (org-babel-sh-evaluate): Don't could 0-length shebangs.
+
+ * org.el (org-format-latex): Simplify and now make use of the new
+ `org-create-formula-image' function.
+ (org-create-formula-image): Provides a simpler interface to the
+ two backend-specific functions.
+
+ * ob-core.el (org-babel-default-header-args): It is likely that
+ someone meant to set :padlines to "yes", but accidentally set
+ :padnewlines to "yes". Either way lets just remove this which
+ shouldn't have any functional effect.
+
+ * ob-haskell.el (org-babel-default-header-args:haskell):
+ Set :padlines to "no" by default.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Ignore inline
+ source block on #+ prefixed lines.
+
+ * ob-core.el (org-babel-merge-params): Replace `remove-if' with
+ `org-remove-if'. More careful to check that the colname- and
+ rowname-names header arguments exist during merge. When merging
+ parameters, if a variable is replaced with a new value, then
+ delete colnames/rownames for the original value of that variable.
+
+ * ob-ditaa.el (org-babel-ditaa-java-cmd): Make java executable
+ configurable for ditaa blocks.
+
+ * ob-sh.el (org-babel-sh-var-to-string): Fix bug in ob-sh when
+ dealing with list variables.
+
+ * ob-core.el (org-babel-demarcate-block):
+ Include `org-src-lang-modes' in block demarcation options.
+
+ * ob-C.el: Don't modify `org-babel-load-languages' from ob-*
+ files.
+
+ * ob-latex.el (org-babel-latex-htlatex): Set this variable to
+ "htlatex" (or path to said) to enable svg generation from latex
+ code blocks.
+ (org-babel-latex-htlatex-packages): Libraries required for
+ automatic svg generation.
+ (org-babel-execute:latex): Generate SVG images directly from latex
+ code blocks (assumes tikz).
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Use lob call name
+ when exporting.
+
+ * ob-scheme.el (org-babel-scheme-get-repl)
+ (org-babel-scheme-make-session-name)
+ (org-babel-scheme-execute-with-geiser, org-babel-execute:scheme):
+ Fix whitespace and indentation.
+
+ * ob-core.el (org-babel-set-current-result-hash): Update the
+ match-string holding the hash data, and correct overlay
+ maintenance.
+ (org-babel-find-named-result): Call lines are not results.
+ (org-babel-where-is-src-block-result): Don't implicitly name the
+ results of call lines.
+ (org-babel-exp-non-block-elements): There is now another element
+ on the call line info list.
+
+ * ob-lob.el (org-babel-lob-get-info): Return the name (if any) at
+ the end of the info list.
+ (org-babel-lob-execute): Pass the name through to execution.
+
+ * ob-core.el (org-babel-execute-src-block): Ensure that the
+ location is set before anything else is done.
+
+ * ob-ref.el (org-babel-ref-parse): Evaluate Emacs Lisp values in
+ header arguments at the location of the original code block.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Use new header
+ arguments.
+
+ * ob-core.el (org-babel-common-header-args-w-values): Mention new
+ header arguments.
+ (org-babel-expand-body:generic): Use new header arguments.
+ (org-babel-read-result): More robust matching of examplized
+ ranges.
+ (org-babel-result-end): More robust matching of examplized ranges.
+
+ * ob-gnuplot.el (org-babel-expand-body:gnuplot): Gnuplot, close
+ output terminal when opened.
+ (org-babel-gnuplot-prefix): Customization variable prefix gnuplot
+ code blocks.
+ (org-babel-expand-body:gnuplot): Customization variable prefix
+ gnuplot code blocks.
+
+ * ob-core.el (org-babel-params-from-properties): Now returns a
+ list of alists and does *not* call `org-babel-merge-params'.
+ (org-babel-parse-src-block-match):
+ (org-babel-parse-inline-src-block-match):
+ * ob-exp.el (org-babel-exp-src-block):
+ (org-babel-exp-non-block-elements):
+ * ob-lob.el (org-babel-lob-execute): Handle new list of lists
+ output of `org-babel-params-from-properties'.
+
+ * ob-gnuplot.el (org-babel-header-args:gnuplot): Term is a gnuplot
+ header argument.
+
+ * ob-tangle.el (org-babel-tangle): Fix bug in tangle-file.
+ Collect tangle modes, and only apply them to the file after all
+ tangling has completed, including the post-tangle-hook.
+
+ * ob-core.el (org-babel-read): Do not read #-prefix header-arg
+ value as emacs lisp.
+
+ * ob-core.el (org-babel-current-src-block-location):
+ (org-babel-execute-src-block):
+ * ob-exp.el (org-babel-exp-results):
+ * ob-lob.el (org-babel-lob-execute):
+ Rename `org-babel-current-exec-src-block-head' to
+ `org-babel-current-src-block-location'.
+
+ * ob-core.el (org-babel-common-header-args-w-values): Adding the
+ new :tangle-mode header argument.
+ (org-babel-read): Read values starting with a "#" character as
+ emacs lisp.
+
+ * ob-tangle.el (org-babel-tangle): Use the new :tangle-mode header
+ argument.
+
+ * org-pcomplete.el (pcomplete/org-mode/block-option/src): Use the
+ new :tangle-mode header argument.
+
+ * ob-exp.el (org-babel-exp-results): Save the code block location
+ into `org-babel-current-exec-src-block-head' during export.
+
+ * ob-comint.el (org-babel-comint-with-output): More robust edebug
+ spec.
+
+ * ob-lob.el (org-babel-lob-execute): Set the
+ `org-babel-current-exec-src-block-head' variable when executing
+ inline or lob style code.
+
+ * ob-core.el (org-babel-execute-src-block):
+ The `org-babel-current-exec-src-block-head' variable should point to
+ the outermost code block.
+
+ * org.el (org-some): An org-mode version of the cl some function.
+
+ * ob-fortran.el (org-babel-fortran-var-to-fortran): More careful
+ check if values are matrices.
+
+ * org.el (org-every): An Org-mode version of the cl every
+ function.
+
+ * ob-tangle.el (org-babel-tangle-jump-to-org):
+ Use `org-src-switch-to-buffer' to jump from src to org. Use the
+ existing `org-edit-src' functionality to jump back to the correct
+ point in the code block in the original Org-mode buffer.
+
+ * ob-gnuplot.el (org-babel-gnuplot-quote-tsv-field): Only wrap
+ gnuplot data values in " when necessary. Replace missing values
+ with blank space in gnuplot.
+ (org-babel-expand-body:gnuplot):
+ (org-babel-gnuplot-quote-timestamp-field): Fix indentation.
+ (org-babel-header-args:gnuplot): Declare the.
+ (org-babel-expand-body:gnuplot): Params is an alist not a plist.
+ (org-babel-header-args:gnuplot): Declare gnuplot-specific header
+ argument.
+ (*org-babel-gnuplot-missing*): Dynamic variable used to hold the
+ value of the missing header argument.
+ (org-babel-gnuplot-process-vars): Wrap in local binding for
+ missing value.
+ (org-babel-gnuplot-quote-tsv-field): Replace missing value with
+ the missing header argument value when present.
+
+ * ob-org.el (org-babel-expand-body:org): Allow insertion of
+ non-strings into Org code blocks.
+ (org-babel-inline-result-wrap): New option controlling the
+ wrapping of inline results.
+ (org-babel-examplize-region): Use the new defcustom.
+
+ * ox-beamer.el (org-beamer--format-frame): If contents is nil,
+ then replace it with an empty string.
+
+ * ob-core.el (org-babel-read): More restrictive elisp eval of
+ header arguments.
+
+ * ob-lob.el (org-babel-lob-execute): Include default elisp header
+ args in call lines.
+
+ * ob-core.el (org-babel-result-cond): Don't over-evaluate
+ result-params in macro.
+
+ * ob-ruby.el (org-babel-execute:ruby): Use `org-babel-result-cond'
+ in Ruby code blocks.
+ (org-babel-ruby-evaluate): Delay table processing.
+
+ * ob-js.el (org-babel-execute:js): Use `org-babel-result-cond' in
+ JavaScript code blocks.
+
+ * ob-scheme.el (org-babel-execute:scheme):
+ Use `org-babel-result-cond' in scheme code blocks.
+
+ * ob-ocaml.el (org-babel-execute:ocaml):
+ Use `org-babel-result-cond' in OCaml code blocks.
+
+ * ob-haskell.el (org-babel-execute:haskell):
+ Use `org-babel-result-cond' in Haskell code blocks.
+
+ * ob-core.el (org-babel-result-cond): The "raw", "org" and
+ "drawer" :results header argument values preclude table processing
+ unless the "table" argument is given as well.
+ (org-babel-execute-src-block): Make sure we process file results
+ before they are passed to the post-processing code block, and not
+ afterwards. Tangles these two header arguments in the code, but
+ makes for more intuitive behavior and enables important use cases.
+ (org-babel-read): Read code block values with earmuffs as Emacs
+ Lisp.
+ (org-babel-common-header-args-w-values): Add :post to the list of
+ header arguments.
+ (org-babel-execute-src-block): Post process results when the :post
+ header argument has been supplied.
+
+ * ob-R.el (org-babel-R-initiate-session): Remove unnecessary
+ save-excursion nested inside a save-window-excursion.
+
+ * ob-core.el (org-babel-src-name-w-name-regexp): Update the regexp
+ used to match code block names.
+ (org-babel-get-src-block-info): Remove the code used to parse this
+ alternate variable specification syntax.
+ (org-babel-insert-result): Cycle tables for :results org and
+ :results wrap.
+
+ * ob-python.el (org-babel-python-initiate-session-by-key): Fix a
+ bug pointed out by Gary Oberbrunner.
+ (org-babel-python-initiate-session-by-key): Add "-i" to the python
+ command on windows sessions. Actually setting new session names.
+ Pass Python buffer names to the new `run-python' command.
+ (org-babel-python-with-earmufs): Add earmufs to a buffer name.
+ (org-babel-python-without-earmufs): Remove earmufs from a buffer name.
+ (org-babel-python-initiate-session-by-key): Set the buffer name in
+ a way which is understandable by the new python.el
+ (org-babel-python-buffers): Change the default python buffer name.
+
+ * ob-core.el (org-babel-number-p): Don't interpret single "-" as a
+ number.
+
+ * ob-perl.el (org-babel-perl--var-to-perl): Print Perl variables
+ with a format string.
+
+ * ob-core.el (org-babel-where-is-src-block-result): Allow comments
+ between code blocks and un-named results.
+
+ * ob-sqlite.el (org-babel-sqlite-table-or-scalar): Don't read
+ sqlite output as lisp.
+
+ * ob-core.el (org-babel-check-confirm-evaluate): Refactoring.
+ (org-babel-confirm-evaluate): Fix whitespaces.
+ (org-babel-execute-src-block): A cond makes it more clear that we
+ definitely do not execute without user confirmation.
+ (org-babel-call-process-region-original): Fix line over 80 chars
+ long.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Update comment
+ to reflect changed variable name.
+
+ * ob-core.el (org-babel-expand-src-block): Return value of
+ expanded code block on non-interactive calls.
+
+ * ob-perl.el (org-babel-perl-var-wrap): Customizable wrapper for
+ variables in perl code.
+ (org-babel-perl-var-to-perl): Use said wrapper.
+
+ * ob-sql.el (org-babel-execute:sql): Use the org-babel-eval
+ command instead of shell-command.
+
+ * ob-ocaml.el (org-babel-prep-session:ocaml): Check that
+ `tuareg-run-caml' is defined before use.
+ (tuareg-run-ocaml): Declare for compiler.
+
+ * ob-core.el (org-babel-result-regexp): Simplify regexp given new
+ time hash layout.
+ (org-babel-current-result-hash): New match string.
+ (org-babel-hide-hash): New match string.
+ (org-babel-where-is-src-block-result): New match string, and
+ insert hashes in the new format.
+
+ * ob-core.el (org-ts-regexp): Declare.
+ (org-babel-result-regexp): Now matching time stamp as well.
+ (org-babel-hash-show-time): New variable controlling the display
+ of time stamps.
+ (org-babel-current-result-hash):
+ (org-babel-hide-all-hashes):
+ (org-babel-where-is-src-block-result): Use hash time stamps.
+
+ * ob-core.el: New file.
+
+ * org-macs.el: `org-load-noerror-mustsuffix' requires an autoload.
+
+2013-11-12 Feng Shu <tumashu@gmail.com>
+
+ * ox-odt.el (org-odt--translate-latex-fragments):
+ * ox-html.el (org-html-latex-environment)
+ (org-html-latex-fragment): Fix imagemagick support.
+
+ * org.el (org-create-formula-image-with-imagemagick):
+ Generate correct size formula image.
+ (org-format-latex-header): Change pagestyle command position.
+
+ * ox-latex.el (org-latex--caption/label-string): Allow to build a
+ caption string from `:caption' attribute of #+ATTR_LATEX.
+
+ * ox.el (org-export-dictionary): Add Simplified Chinese
+ translations for `org-export-dictionary'.
+
+2013-11-12 Florian Beck <fb@miszellen.de> (tiny change)
+
+ * org.el (org-activate-bracket-links): Remove escapes from the
+ help string.
+
+2013-11-12 Francesco Pizzolante <xxx@public.gmane.org> (tiny change)
+
+ * ox-html.el (org-html-headline): Normalize the construction of
+ outline-container DIVs by always using the inner headline ID.
+
+ * org.el (org-agenda-prepare-buffers): Protect with
+ `org-unmodified'.
+
+2013-11-12 Gregor Kappler <gregor@alcedo.(none)> (tiny change)
+
+ * ox.el (org-export-as): Make sure org-export-babel-evaluate is
+ not nil before calling `org-export-execute-babel-code'.
+
+2013-11-12 Grégoire Jadi <gregoire.jadi@gmail.com>
+
+ * org.el (org-reftex-citation): Fix contrib package name in the
+ docstring.
+ (org-preview-latex-fragment, org-display-inline-images):
+ Detect whether a graphic display is available before inlining images to
+ prevent an error.
+ (org-startup-with-latex-preview): New option.
+ (org-startup-options): New startup keywords for the new option.
+ (org-mode): Turn on/off LaTeX preview depending on the new option.
+ (org-reverse-string): Add `org-reverse-string' to reverse a
+ string.
+
+ * org-id.el (org-id-new, org-id-decode):
+ Replace `org-id-reverse-string' by `org-reverse-string'.
+
+ * ob-core.el (org-babel-trim): Replace `org-babel-reverse-string'
+ by `org-reverse-string' and declare it.
+
+2013-11-12 Gustav Wikström <gustav.erik@gmail.com> (tiny change)
+
+ * org-agenda.el (org-agenda-filter-by-category): Display all
+ filtered out categories.
+
+2013-11-12 Ilya Zonov <izonov@gmail.com> (tiny change)
+
+ * org-mouse.el (org-mouse-context-menu): Add a correct newtext
+ parameter for "All Set" and "All Clear" menu items.
+
+2013-11-12 Ingo Lohmar <i.lohmar@gmail.com> (tiny change)
+
+ * org.el (org-insert-todo-heading-respect-content): Pass correct
+ prefix arg to always insert heading.
+
+ * org-agenda.el
+ (org-agenda-propertize-selected-todo-keywords): New function to
+ highlight the current agenda todo keywords depending on
+ `org-todo-keyword-faces'.
+ (org-todo-list): Use the new function.
+
+2013-11-12 Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
+
+ * org-table.el (org-calc-current-TBLFM): New function to
+ re-calculate the table by applying the #+TBLFM in the line where
+ the point is. Ensure to remove the currently inserted TBLFM line,
+ when calling `org-table-recalculate' returns an error and the
+ processing stops.
+
+ * org.el (org-ctrl-c-ctrl-c): Call `org-calc-current-TBLFM' when
+ point is in the #+TBLFM line.
+
+ * org-table.el (org-TBLFM-begin): New function.
+ (org-TBLFM-begin-regexp): New variable.
+
+ * org.el (org-at-TBLFM-p): New function.
+ (org-TBLFM-regexp): New defconst.
+
+2013-11-12 Ivan Vilata i Balaguer <ivan@selidor.net> (tiny change)
+
+ * org-clock.el (org-clock-get-table-data): Pass tstart and tend
+ time strings through `org-matcher-time' to allow relative times
+ besides absolute ones, convert result to encoded time.
+
+2013-11-12 Jambunathan K <kjambunathan@gmail.com>
+
+ * ox-html.el (org-html-code, org-html-verbatim): Transcode value.
+ (org-html--tags, org-html-format-headline)
+ (org-html--format-toc-headline, org-html-checkbox)
+ (org-html-table-cell, org-html-timestamp)
+ (org-html-verse-block, org-html-special-string-regexps): Replace
+ named HTML entities with their numeric counterparts. This keeps
+ Freemind backend happy.
+
+ * org-odt.el (org-export-odt-schema-dir): Modify to accommodate
+ change in rnc file names.
+
+ * org-lparse.el (org-lparse-and-open)
+ (org-lparse-do-convert): Open exported files with system-specific
+ application.
+
+ * org-odt.el: Don't meddle with `org-file-apps'.
+
+2013-11-12 Jarmo Hurri <jarmo.hurri@syk.fi>
+
+ * org-table.el (org-define-lookup-function): New macro. Call it
+ to generate new lookup functions `org-lookup-first',
+ `org-lookup-last' and `org-lookup-all'.
+
+ * org-gnus.el (org-gnus-no-server): New option to start Gnus using
+ `gnus-no-server'.
+ (org-gnus-no-new-news): Use the new option.
+
+2013-11-12 Jonas Hoersch <coroa@online.de> (tiny change)
+
+ * org.el (org-cycle-hide-inline-tasks): Re-hide inline tasks when
+ switching to 'children visibility state.
+
+ * org-inlinetask.el (org-inlinetask-toggle-visibility): Don't use
+ `org-show-entry' as it cannot unfold an inlinetask properly.
+
+2013-11-12 Jonathan Leech-Pepin <jonathan.leechpepin@gmail.com>
+
+ * ox-texinfo.el: New file.
+
+2013-11-12 Joost Diepenmaat <joost@zeekat.nl> (tiny change)
+
+ * org.el (org-indent-region): BEGIN_SRC and END_SRC lines should
+ not be considered part of the source block for the purposes of
+ indentation.
+
+2013-11-12 Justus Piater <justus-dev@piater.name>
+
+ * org-agenda.el
+ (org-agenda-skip-deadline-prewarning-if-scheduled): Add an option
+ to skip the deadline prewarning if the scheduled date is in the
+ future.
+
+2013-11-12 Kodi Arfer <git@arfer.net> (tiny change)
+
+ * ox-html.el (org-html-toc): Use <nav> instead of <div> for the
+ root element when appropriate.
+ (org-html-paragraph): Wrap "Figure %d:" in <span
+ class="figure-number">.
+ (org-html-list-of-tables, org-html-table): Wrap "Table %d:" in
+ <span class="table-number">.
+ (org-html-list-of-listings): Wrap "Listing %d:" in
+ <span class="listing-number">.
+ (org-html-table): For HTML5, omit :html-table-attributes but not
+ :id or :attr_html.
+ (org-html--build-meta-info): Insert no timestamp when
+ :time-stamp-file is nil.
+
+2013-11-12 Lawrence Mitchell <wence@gmx.li>
+
+ * ox-html.el (org-html-close-tag): Add space before attr.
+
+ * ox.el (org-export-resolve-fuzzy-link): Look for fuzzy link in a
+ cache before trying to resolve it in the parse tree.
+
+2013-11-12 Le Wang <le.wang@agworld.com.au>
+
+ * org-src.el (org-edit-src-code): Use marker with insertion type t
+ to track end and remove hack requiring delete from beg to (1-
+ end).
+
+2013-11-12 Max Mikhanosha <max@openchat.com>
+
+ * org-habit.el (org-habit-get-faces): Add show done days green
+ option.
+
+ * org-agenda.el (org-agenda-format-item): Ensure effort is "" when
+ unset
+
+2013-11-12 Michael Brand <michael.ch.brand@gmail.com>
+
+ * org-table.el (org-table-eval-formula): Align the arrow pointing
+ to the error in a Calc formula to the other fomula debugger logs.
+
+ * org.el (org-link-escape-chars-browser): Add char double quote.
+ (org-open-at-point): Use the constant
+ `org-link-escape-chars-browser'.
+
+ * org-table.el (org-table-get-remote-range): Extend regexp to
+ match "#+NAME: table" additionally to "#+TBLNAME: table".
+
+ * org-table.el (org-table-eval-formula): Use `keep-empty' in more
+ places. Keep empty fields during preprocessing.
+ (org-table-make-reference): Use nan (not a number) for empty
+ fields in Calc formulas. A range with only empty fields should
+ not always return 0 but also empty string, consistent with field
+ reference of an empty field. Use future design for nan but
+ replicate current behavior.
+ (org-table-number-regexp): Extend 0x hex to fixed-point number,
+ add <radix>#<number>, add Calc infinite numbers uinf, -inf and
+ inf.
+
+2013-11-12 Muchenxuan Tong <demon386@gmail.com> (tiny change)
+
+ * org-mobile.el (org-mobile-push): Add `save-restriction'.
+
+2013-11-12 Nicolas Goaziou <n.goaziou@gmail.com>
+
+ * ox-latex.el (org-latex-compile): Remove all numbered temporary
+ files after compiling.
+
+ * org-element.el (org-element-headline-interpreter): Take into
+ consideration `org-odd-levels-only' when building a headline.
+
+ * ox-org.el (org-org-headline): Correctly set transcoded headline
+ level during subtree export.
+
+ * ox-html.el (org-html--format-toc-headline): TOC entries are
+ closer to regular headline formatting.
+
+ * org-element.el (org-element-context): Fix error when parsing
+ affiliated keywords, e.g. "caption".
+
+ * org.el (org-do-emphasis-faces): Look for verbatim status at
+ correct location.
+ (org-open-at-point): Check if link is non-nil before matching it.
+ (org-export-insert-default-template): Make sure strings are
+ properly quoted when inserting a template. Specifically, default
+ value for drawers should be d:(not "LOGBOOK"), not d:(not
+ LOGBOOK).
+ (org-insert-heading): Do not error out when inserting is to be
+ done at one of the buffer's boundaries.
+
+ * ox-latex.el (org-latex-listings-options): Use correct number of
+ backslash characters in the example.
+
+ * org-element.el (org-element-latex-or-entity-successor)
+ (org-element-latex-fragment-parser): Use `org-latex-regexps'
+ instead of `org-format-latex-options'.
+
+ * ox-ascii.el:
+ * ox-beamer.el:
+ * ox-html.el:
+ * ox-icalendar.el:
+ * ox-md.el: Remove comments at the beginning of the file since
+ the library is documented in Org manual.
+
+ * org-element.el (org-element--list-struct):
+ Use `org-match-string-no-properties'. Fix block parsing in lists.
+
+ * ox-publish.el (org-publish-all): Fix compilation problem.
+
+ * org-element.el (org-element-timestamp-interpreter):
+ Correctly interpret timestamps with delays.
+ (org-element-timestamp-parser)
+ (org-element-timestamp-interpreter): Parse warning delays.
+
+ * ox-beamer.el (org-beamer--format-section): Fix regression which
+ prevents frames from being propely exported.
+
+ * ox.el (org-export-with-backend): Ensure function will use
+ provided back-end.
+
+ * org-list.el (org-list-allow-alphabetical): Remove reference to
+ unused VALUE.
+
+ * ox-beamer.el (org-beamer--format-section): Protect fragile
+ commands in sections.
+
+ * org.el (org-ctrl-c-ctrl-c): When using C-c C-c at an item with
+ point on a link, make sure checkbox, if any, is toggled.
+
+ * ox-beamer.el (org-beamer--format-block): Return an error message
+ when using a special environment as a block type. Also check for
+ incomplete environment definitions.
+
+ * org-element.el (org-element-at-point): If point is at the end of
+ the buffer, and that buffer ends with a list, and there's no final
+ newline, return last element in last item instead of plain list.
+ Fix infloop when called on a blank line at the end of the buffer
+ after a headline.
+
+ * org.el (org-forward-paragraph, org-backward-paragraph):
+ New functions.
+
+ * org.el (org-meta-return): Allow M-RET to insert items within
+ drawers. Rewrite function.
+
+ * org-element.el (org-element-footnote-definition-parser):
+ Fix value for :contents-begin when first line of footnote definition
+ is empty besides the label.
+ (org-element-at-point): Return correct element when point is on a
+ blank line just below a headline.
+ (org-element-paragraph-parser):
+ Use `org-match-string-no-properties'. Small fixes to paragraph
+ parsing.
+
+ * org.el (org-adaptive-fill-function): Do not handle
+ `adaptive-fill-regexp' in comments as the behavior is not
+ satisfying.
+
+ * org-list.el (org-list-struct-apply-struct): Do not move item's
+ contents within a child above when repairing indentation.
+
+ * ox-html.el (org-html--build-meta-info): Fix output of meta tags
+ when properties are present.
+
+ * ox.el (org-export-collect-headlines): Do not build TOC for
+ headlines below H value.
+
+ * org-element.el (org-element-context): Modify misleading
+ comment.
+ (org-element-text-markup-successor)
+ (org-element-latex-or-entity-successor)
+ (org-element-export-snippet-successor)
+ (org-element-footnote-reference-successor)
+ (org-element-inline-babel-call-successor)
+ (org-element-inline-src-block-successor)
+ (org-element-line-break-successor, org-element-link-successor)
+ (org-element-plain-link-successor, org-element-macro-successor)
+ (org-element-radio-target-successor)
+ (org-element-statistics-cookie-successor)
+ (org-element-sub/superscript-successor)
+ (org-element-table-cell-successor, org-element-target-successor)
+ (org-element-timestamp-successor): Remove LIMIT argument.
+ (org-element--parse-objects, org-element--get-next-object-candidates):
+ Apply signature change to successors.
+ (org-element-context): Narrow buffer around object containers so
+ parsing of objects when using this function is done under the same
+ restrictions as in buffer parsing.
+
+ * ox.el (org-export-table-cell-alignment): Ensure required
+ variables are available. Use correct :test.
+ (org-export-table-cell-width): Modify key (now an element) and
+ value structure (now a vector) of cache so it can use `eq' as
+ test. Elements are circular lists so `equal' cannot apply on them.
+
+ * ox-publish.el (project-plist): Remove variable.
+
+ * ox.el (org-export-to-buffer, org-export-to-file):
+ Fix docstrings.
+
+ * ox-org.el (org-export-as-org): Add missing BODY-ONLY argument,
+ 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
+ instead of the current line.
+
+ * ob-core.el (org-babel-get-src-block-info): Look for indentation
+ value at the correct location.
+
+ * ox.el (org-export-data-with-backend): Set temporary back-end as
+ the new back-end in local communication channel.
+ (org-export-filter-apply-functions): Handle corner case where
+ back-end is nil. Only provide back-end name (a symbol) as second
+ argument of filters, not the full back-end (a vector).
+
+ * ox-publish.el (org-publish-find-title): Fix title when no
+ #+TITLE property is provided.
+
+ * ox.el (org-export-store-default-title): Remove-function.
+ (org-export--default-title): Remove variable.
+ (org-export-options-alist): Do not use a default value.
+ (org-export--get-buffer-attributes): Store a default title.
+ (org-export-as): Apply function removal.
+ (org-export--get-global-options): Do not set a property with an
+ explicitly nil value.
+
+ * ox-publish.el (org-publish-sitemap-sort-files)
+ (org-publish-sitemap-sort-folders)
+ (org-publish-sitemap-ignore-case, org-publish-sitemap-requested)
+ (org-publish-sitemap-date-format)
+ (org-publish-sitemap-file-entry-format): Set prefix to
+ "org-publish-sitemap" instead of "org-sitemap".
+ (org-publish-compare-directory-files)
+ (org-publish-get-base-files-1, org-publish-projects)
+ (org-publish-format-file-entry): Use new prefix.
+
+ * org-clock.el (org-clock-total-time-cell-format)
+ (org-clock-file-time-cell-format): Use correct type.
+
+ * ob-haskell.el:
+ * ox-ascii.el (org-ascii-export-as-ascii)
+ (org-ascii-export-to-ascii):
+ * ox-beamer.el (org-beamer-export-as-latex)
+ (org-beamer-export-to-latex, org-beamer-export-to-pdf):
+ * ox-html.el (org-html-export-as-html, org-html-export-to-html):
+ * ox-icalendar.el (org-icalendar-export-to-ics):
+ * ox-latex.el (org-latex-export-as-latex)
+ (org-latex-export-to-pdf):
+ * ox-man.el (org-man-export-to-man, org-man-export-to-pdf):
+ * ox-md.el (org-md-export-as-markdown, org-md-export-to-markdown):
+ * ox-odt.el (org-odt-export-to-odt):
+ * ox-org.el (org-org-export-as-org, org-org-export-to-org):
+ * ox-publish.el (org-publish-org-to):
+ * ox-texinfo.el (org-texinfo-export-to-texinfo)
+ (org-texinfo-export-to-info):
+ * ox.el (org-export-to-buffer): Add two arguments: one to trigger
+ asynchronous export and the other to do extra processing from
+ within the buffer.
+ (org-export-to-file): Add two arguments: one to trigger
+ asynchronous export and the other to do extra processing on the
+ output file.
+ (org-export-async-start): Small clean up.
+
+ * ox.el (org-export-as): Use new back-end structure.
+ (org-export-current-backend): New variable.
+ (org-export-as): Use new variable.
+
+ * ox-ascii.el (org-ascii-table): Remove spurious new line between
+ a table and the caption below.
+
+ * ox.el (org-export-to-file): Preserve coding system when writing
+ output.
+ (org-export-stack-mode-map): Fix compilation error with Emacs <
+ 24.
+ (org-export--dispatch-action): Maintain compatibility with Emacs
+ 23.
+
+ * org.el (org-adaptive-fill-function, org-fill-paragraph):
+ Add support for `adaptive-fill-regexp' in paragraphs and comments.
+ (org-indent-line): Fix indentation after a list.
+
+ * ox.el (org-export--get-inbuffer-options): Multiple options can
+ now be set through the same buffer keyword.
+
+ * org-element.el (org-element-plain-list-parser): Fix infloop when
+ parsing a list at the end of buffer, if buffer doesn't end at a
+ line beginning.
+ (org-element-link-parser): Do not url-decode parsed links.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Remove
+ spurious white spaces, excepted for source blocks' opening string.
+ Small refactoring.
+ (pcomplete/org-mode/file-option): Remove spurious colons from
+ block boundaries.
+
+ * ox-publish.el (org-publish-find-date): Also return date for
+ directories.
+ (org-publish-get-base-files-1): Fix :recursive parameter ignoring
+ extension restriction.
+
+ * ox-beamer.el: Remove strange indentation in default header.
+ (org-beamer-template): Fix missing newlines in header.
+
+ * ox-latex.el (org-latex-template): Fix missing newlines in
+ header.
+
+ * ox.el (org-export-insert-default-template):
+ Fix "wrong-type-argument" error in template insertion.
+
+ * org.el (org-fill-paragraph): Use empty commented lines as
+ separators when filling comments. This mimics default behavior
+ from "newcomment.el", which is not used in Org.
+
+ * ox-html.el (org-html-link): Add image attributes to "img" tag,
+ not to the "a" container. Also fix spacing for attributes.
+
+ * org.el (org-fill-paragraph): Do not mix consecutive comments
+ when filling any of them.
+
+ * ox-html.el (org-html-format-headline--wrap): Fix number of
+ arguments when setting `org-html-format-headline-function'.
+
+ * org-element.el (org-element-item-interpreter): This patch fixes
+ "(wrong-type-argument arrayp nil)" error when trying to interpret
+ empty items. Correctly interpret back plain lists with "*" items.
+ This fixes "This is not a list" error returned in this case.
+
+ * ox-latex.el (org-latex-listings): Update docstring.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option/options):
+ Apply changes to export back-end definiton.
+
+ * org.el (org-get-export-keywords): Apply changes to export
+ back-end definiton.
+
+ * ox-html.el (org-html--format-toc-headline): Make use of
+ anonymous back-ends.
+
+ * ox-odt.el (org-odt-footnote-reference): Make use of anonymous
+ back-ends.
+ (org-odt-format-label, org-odt-toc)
+ (org-odt-format-headline--wrap): Use `org-export-with-backend'
+ instead of `org-export-with-translations'.
+
+ * ox.el (org-export--registered-backends): Rename from
+ `org-export-registered-backends'.
+ (org-export-invisible-backends): Remove variable.
+ (org-export-get-backend, org-export-get-all-transcoders
+ org-export-get-all-options, org-export-get-all-filters):
+ New functions. It replaces `org-export-backend-translate-table'.
+ (org-export-barf-if-invalid-backend, org-export-derived-backend-p,
+ org-export-define-backend, org-export-define-derived-backend):
+ Rewrite functions using new representation.
+ (org-export-backend-translate-table): Remove function.
+ (org-export-get-environment): Use new function.
+ (org-export--get-subtree-options, org-export--parse-option-keyword,
+ org-export--get-inbuffer-options, org-export--get-global-options,
+ org-export-to-buffer org-export-to-file, org-export-string-as
+ org-export-replace-region-by): Update docstring.
+ (org-export-data-with-translations): Remove function.
+ Use `org-export-data-with-backend' with a temporary back-end instead.
+ (org-export-data-with-backend, org-export-as): Reflect new definition
+ for back-ends.
+ (org-export--dispatch-action, org-export--dispatch-ui): Reflect new
+ definition for back-ends and variable removal. Refactoring.
+ (org-export-filter-apply-functions): Call functions with
+ current back-end's name, not full back-end.
+
+ * org.el (org-export-backends, org-create-formula--latex-header):
+ Use new structure and variables.
+
+ * ox-html.el (org-html-inline-images): Change default value and
+ remove `maybe'.
+ (org-html-format-inline-image): Remove functions.
+ (org-html--wrap-image, org-html--format-image)
+ (org-html-inline-image-p): New functions.
+ (org-html-latex-environment, org-html-latex-fragment): Use new
+ functions.
+ (org-html-standalone-image-p): Use new functions. Also remove an
+ unused optional argument.
+ (org-html-link, org-html-paragraph): Correctly export hyperlinked
+ images.
+
+ * ox.el (org-export-dictionary): Update some translations.
+
+ * ox-odt.el (org-odt-label-styles, org-odt-category-map-alist):
+ Fix docstring.
+ (org-odt-format-label): Add docstring. Internationalize prefix.
+
+ * ox.el (org-export-dictionary): Add entry for colons.
+
+ * ox-odt.el (org-odt--suppress-some-translators): Remove function.
+
+ * ox-html.el (org-html-link): Remove left-over binding.
+
+ * ox-beamer.el (org-beamer-environments-extra): Allow to add raw
+ title in environment definition.
+ (org-beamer--format-block): Handle new placeholders.
+
+ * ox-html.el (org-html-link): Small refactoring.
+
+ * org-element.el (org-element--current-element):
+ Fix org-meta-return error at the end of buffer.
+
+ * ox-odt.el (org-odt-category-map-alist): Fix internationalization
+ of "Table" and "Listing".
+
+ * ox.el (org-export-dictionary): Remove useless dictionary
+ entries.
+
+ * ox-ascii.el (org-ascii--build-caption): Apply removal.
+
+ * ox.el (org-export-dictionary): Add spanish and german
+ translations.
+
+ * ox-odt.el (org-odt-link): Fuzzy links to an headline with a
+ description always use that description, even if the description
+ is the same as the headline title.
+ (org-odt-plain-text): Allow to turn smart quotes off.
+
+ * ox-latex.el (org-latex--get-footnote-counter): Remove function.
+
+ * org.el (org-setup-filling): Set `paragraph-start' and
+ `paragraph-separate'.
+ (org-fill-paragraph-separate-nobreak-p): Remove function.
+ (org-mode): Do not set `paragraph-start'.
+
+ * ox-html.el (html): Replace "HTML_HTML5_FANCY",
+ "HTML_INCLUDE_STYLE" and "HTML_INCLUDE_SCRIPTS" with,
+ respectively, ":html5-fancy", "html-style" and "html-scripts"
+ options.
+ (org-html-html5-fancy): Reformat docstring.
+ (org-html-template): Fix typo preventing insertion of link up/link
+ home anchors.
+
+ * org.el (org-create-formula--latex-header): Replace AUTO with
+ appropriate language when previewing snippets.
+
+ * ox-latex.el (org-latex-item): Allow hyperref and footnotemark in
+ items description tags. Also remove a unnecessary hack allowing
+ footnotemark with an optional argument in the tag.
+
+ * ox.el (org-export-resolve-fuzzy-link): Fix link resolution when
+ link lives before the first headline.
+
+ * org-element.el (org-element-special-block-parser): Fix typo in
+ regexp matching block type. Also quote the type so it can contain
+ special characters.
+
+ * ox-latex.el (org-latex-pdf-process): This argument can cause
+ problem with links with a relative path, since compilation happens
+ in a different directory.
+
+ * org.el (org-latex-default-packages-alist): Load "ulem" package
+ by default. Use "[normalem]" option to preserve \emph definition.
+
+ * ox-latex.el (org-latex-text-markup-alist): Use "\uline" and
+ "\sout" commands from "ulem" package.
+
+ * org.el (org-latex-default-packages-alist): Document need for
+ "soul" package.
+
+ * ox-latex.el (org-latex-text-markup-alist): Use \ul (from "soul"
+ package) instead of \underline for underline text.
+
+ * ox.el (org-export-read-attribute): Fix "Wrong argument type"
+ error when attributes start with :key "".
+
+ * org.el (org-fill-paragraph-separate-nobreak-p)
+ (org-fill-line-break-nobreak-p)
+ (org-fill-paragraph-with-timestamp-nobreak-p): Fix docstrings.
+
+ * org-element.el (org-element--list-struct): Fix failing
+ "plain-list-parser" test.
+
+ * ox-latex.el (org-latex-src-block): Handle :float attribute.
+ Its value can be set to "t", "multicolumn" or "nil". Also remove
+ :long-listing attribute, which is now replaced with :float nil.
+ (org-latex--org-table): Replace :float table with :float t.
+ (org-latex--inline-image): Replace :float figure with :float t.
+ (org-latex-long-listings): Remove variable.
+
+ * org-element.el (org-element--list-struct): New function.
+ (org-element-plain-list-parser, org-element--current-element):
+ Use new function.
+
+ * ox-man.el (org-man-compile):
+ * ox-texinfo.el (org-texinfo-compile): Use appropriate argument.
+
+ * ox-latex.el (org-latex-compile):
+ * ox-man.el (org-man-compile):
+ * ox-texinfo.el (org-texinfo-compile): Properly set working
+ directory.
+
+ * ox-latex.el (org-latex-compile):
+ * ox-texinfo.el (org-texinfo-compile): Make sure generated file
+ can be found by `file-exists-p'.
+
+ * ox-md.el (md): Delegate underscore transcoding to HTML back-end.
+
+ * org-element.el (org-element--remove-indentation):
+ Small optimization.
+ (org-element--remove-indentation): New function.
+ (org-element-example-block-parser, org-element-src-block-parser):
+ Use new function.
+ (org-element-src-block-interpreter): Update function according to
+ change.
+
+ * ox.el (org-export-unravel-code): Do not remove any indentation
+ since it now happens at the parser level.
+ (org-export-table-cell-width): Be sure to use cache even when
+ stored value is nil.
+ (org-export--default-title): Fix "Symbol's value as variable is
+ void: org-export--default-title".
+
+ * ox-ascii.el (org-ascii--table-cell-width): Cache results of this
+ internal function since it is called at each cell, though its
+ value only change column wise.
+
+ * ox.el (org-export-resolve-fuzzy-link): Change property name
+ holding cache.
+ (org-export-table-has-header-p, org-export-table-row-group)
+ (org-export-table-cell-width, org-export-table-cell-alignment):
+ Cache results.
+ (org-export-table-cell-address): Refactor.
+ (org-export-get-parent): Inline function.
+ (org-export-options-alist): Change default value for :title
+ property.
+ (org-export--default-title): New dynamically scoped variable.
+ (org-export-store-default-title): New function.
+ (org-export--get-buffer-attributes): Remove title handling.
+ (org-export--get-global-options): Revert "ox: Fix default title".
+ Refactor code.
+
+ * ox-html.el (org-html-format-latex): Provide a prefix for
+ temporary file when using dvipng, even if the current buffer isn't
+ associated to a file.
+
+ * ox.el (org-export-resolve-radio-link): Ignore whitespace
+ differences when resolving a radio link.
+ (org-export-resolve-radio-link): Fix radio target resolution.
+
+ * org-element.el (org-element--current-element): Be stricter when
+ matching arguments in LaTeX environments. In particular, do not
+ allow anything else than options and arguments in the opening
+ line.
+
+ * ox-html.el (org-html-inner-template): Remove code relative to
+ bibliography.
+ (org-html-bibliography): Remove function.
+
+ * ox-latex.el (org-latex-plain-text): Protect ^ char with \^{},
+ not only \^, so it doesn't become a diacritic.
+
+ * ox-html.el (org-html--build-meta-info): Fix code typo.
+
+ * ox.el (org-export-expand-include-keyword): Avoid using `read' to
+ determine file name.
+ (org-export--get-global-options): Properly set default title,
+ i.e. when to TITLE keyword is provided.
+
+ * org-element.el (org-element--parse-elements): Also parse visible
+ headlines within an otherwise compacted headline.
+
+ * ox.el (org-export-expand-include-keyword): Tolerate included
+ file names without double quotes.
+ (org-export-resolve-fuzzy-link): Fix caching process.
+
+ * ox-publish.el (org-publish-find-date): Fix "Invalid time
+ specification" error with timestamps in DATE.
+
+ * org-element.el (org-element--current-element): Allow the opening
+ string of a LaTeX environment to contain additional arguments.
+
+ * org.el (org-insert-heading): Refactor to use `org-in-item-p'
+ only once.
+
+ * ox.el (org-export-expand): Optionally add affiliated keywords to
+ results.
+
+ * ox-org.el (org-org-identity): Use new argument for
+ `org-export-expand'.
+
+ * org.el (org-fill-paragraph): Move to table beginning before
+ aligning the table when M-q is called from an affiliated keyword.
+
+ * org-list.el (org-list-allow-alphabetical): Properly update
+ `org-list-allow-alphabetical' when changed after org.el has been
+ loaded.
+
+ * org-element.el (org-element-fixed-width-interpreter):
+ Fix interpretation of fixed-width elements with a nil or empty string
+ value.
+
+ * ox-html.el (org-html-link): Don't skip the link description when
+ it matches the name of the headline it targets.
+
+ * ox-html.el (org-html-link): Don't skip the link description when
+ it matches the name of the headline it targets.
+
+ * ox-ascii.el (ascii): Remove inexistant function.
+
+ * ox-icalendar.el (icalendar): Ignore footnotes.
+ (org-icalendar--combine-files): Small refactoring.
+
+ * ox.el (org-export--skip-p, org-export--interpret-p):
+ When `org-export-with-footnotes' is nil, ignore completely footnotes
+ references and definitions instead of exporting them verbatim.
+
+ * ox-beamer.el (org-beamer--frame-level): Small refactoring.
+ (org-beamer--format-block, org-beamer-headline): Do not systematically
+ downcase environment names as some require upper case in their
+ names (e.g. noteNH and CJK).
+
+ * ox.el (org-export-with-timestamps): Only applies to isolated
+ timestamps, i.e. timestamps in a paragraph containing only
+ timestamps and empty strings.
+ (org-export--skip-p): Skip timestamps according to new behavior.
+
+ * ox-latex.el (org-latex--script-size): Handle consecutive
+ alterning sub and superscript.
+
+ * ox-org.el (org-org-identity): Fix docstring. Tiny refactoring.
+ (org-org-headline, org-org-keyword): Fix docstring.
+
+ * ox-latex.el (org-latex--script-size): Use \text command for
+ subscript and superscript. This is far superior to \mathrm, but
+ it requires "amstext" package. In particular, accented characters
+ are now allowed within sub/superscript.
+
+ * org.el (org-latex-default-packages-alist): Add "amstext"
+ package.
+
+ * ox-latex.el (org-latex--script-size): Fix error when using
+ sub/superscript within sub/superscript.
+
+ * ox-latex.el (org-latex--script-size): New function.
+ (org-latex-subscript, org-latex-superscript): Use new function.
+ Remove instructions since everything is documented in Org manual.
+
+ * ox.el (org-export-with-smart-quotes): Use LATEX instead of LaTeX
+ for keywords, the latter being hard to type, somewhat difficult to
+ read, and overall just pedantic.
+
+ * ox-latex.el (org-latex-classes): Be more explicit about
+ LATEX_HEADER_EXTRA.
+
+ * ox-html.el (org-html--build-meta-info): Fix invalid characters
+ in html attributes.
+
+ * ox.el (org-export-filters-alist): Remove macro filter.
+ (org-export-filter-macro-functions): Remove variable.
+
+ * ox-beamer.el (beamer): Install a default class set-up when
+ loading library.
+
+ * ox-latex.el (org-latex-classes): Update docstring.
+
+ * ox-latex.el (org-latex--inline-image): Remove specific default
+ image width for floats. If no width nor height is provided, it
+ should default to `org-latex-image-default-width' value.
+
+ * org.el (org-extract-attributes-from-string)
+ (org-attributes-to-string): Remove functions.
+
+ * ox-html.el (html): Rename :html-table-tag property into
+ :org-table-attributes.
+ (org-html-table-default-attributes): New variable.
+ (org-html-table-tag): Remove variable.
+ (org-html--make-attribute-string): New function.
+ (org-html-link--inline-image, org-html-table): Use new function.
+ (org-html-splice-attributes, org-export-splice-style):
+ Remove functions.
+ (org-html-inline-image-rules): Remove out of context part of the
+ docstring.
+
+ * ox.el (org-export-read-attribute): Allow to use empty strings in
+ attributes.
+
+ * ox-html.el (org-html-metadata-timestamp-format): New variable,
+ renamed from `org-html--timestamp-format'.
+ (org-html--build-meta-info, org-html-format-spec,
+ org-html--build-pre/postamble): Use new variable.
+
+ * ox.el (org-export-table-row-number): New function.
+ (org-export-table-cell-address): Use new function.
+
+ * org-element.el (org-element-table-cell-successor): Parse table
+ cells with missing ending space.
+
+ * ox-latex.el (org-latex--math-table): Fix inline-math table
+ environment.
+
+ * ox-html.el (org-html-doctype): Make value fit on a single line
+ so `org-export-insert-default-template' can handle it.
+ (org-html-creator-string): Change default value.
+
+ * ox.el (org-export-creator-string): Change default value.
+
+ * ox-html.el (org-html-postamble-format)
+ (org-html-preamble-format): Allow last modification time of source
+ in template. Fix docstrings.
+ (org-html-format-spec): Produce last modification time when the source
+ is a file.
+
+ * ox.el (org-export-with-archived-trees, org-export-with-author)
+ (org-export-with-clocks, org-export-with-date)
+ (org-export-creator-string, org-export-with-drawers)
+ (org-export-with-email, org-export-with-emphasize)
+ (org-export-exclude-tags, org-export-with-fixed-width)
+ (org-export-with-footnotes, org-export-with-latex)
+ (org-export-headline-levels, org-export-default-language)
+ (org-export-preserve-breaks, org-export-with-entities)
+ (org-export-with-inlinetasks, org-export-with-planning)
+ (org-export-with-priority, org-export-with-section-numbers)
+ (org-export-select-tags, org-export-with-smart-quotes)
+ (org-export-with-special-strings)
+ (org-export-with-statistics-cookies)
+ (org-export-with-sub-superscripts, org-export-with-toc)
+ (org-export-with-tables, org-export-with-tags)
+ (org-export-with-tasks, org-export-time-stamp-file)
+ (org-export-with-timestamps, org-export-with-todo-keywords):
+ Fix docstrings.
+
+ * ox-html.el (org-html-postamble-format): Slightly change default
+ value so "Generated by" string doesn't get duplicated.
+ (org-html-creator-string): Fix docstring.
+
+ * ox.el (org-export--get-inbuffer-options)
+ (org-export--list-bound-variables)
+ (org-export--generate-copy-script, org-export-string-as)
+ (org-export-expand-include-keyword)
+ (org-export--prepare-file-contents): Inhibit startup process when
+ calling `org-mode'.
+
+ * ox-publish.el (org-publish-find-date): Fix "bad timestamp" error
+ with some DATE values: :date property in communication channel is
+ no longer a string.
+
+ * ox.el (org-export-insert-default-template): New function.
+ (org-export--dispatch-ui, org-export--dispatch-action): Access to
+ the function through the dispatcher.
+
+ * ox-icalendar.el (org-icalendar-convert-timestamp):
+ Update docstring.
+ (org-icalendar-dtstamp): New function.
+ (org-icalendar--vevent, org-icalendar--vtodo): Use new function.
+
+ * ox-ascii.el (org-ascii-link):
+ * ox-html.el (org-html-keyword):
+ * ox-latex.el (org-latex-keyword, org-latex-link):
+ * ox-man.el (org-man-keyword):
+ * ox-md.el (org-md-link):
+ * ox-odt.el (org-odt-keyword):
+ * org.el (org-store-link, org-link-search, org-options-keywords):
+ Remove reference to TARGET keyword.
+
+ * ox.el (org-export-resolve-fuzzy-link, org-export-get-ordinal):
+ Do not use TARGET as a destination for links anymore.
+
+ * ox-org.el (org): Add a menu entry for the back-end.
+ (org-org-export-as-org, org-org-export-to-org): New functions.
+
+ * org.el (org-export-backends): Accept `org' as a loadable
+ back-end.
+
+ * ox-ascii.el (org-ascii-template--document-title): Use new function.
+
+ * ox-beamer.el (org-beamer-template): Use new function.
+
+ * ox-html.el (org-html-format-spec): Use new function.
+
+ * ox-latex.el (org-latex-template): Use new function.
+ (org-latex-date-timestamp-format): Remove variable.
+
+ * ox.el (org-export-date-timestamp-format): New variable.
+ (org-export-get-date): New function.
+
+ * ox-odt.el (org-odt--format-paragraph): New function.
+ (org-odt-paragraph): Use new function to limit code duplication.
+ (org-odt-footnote-reference): Change default style for paragraphs
+ when transcoding a footnote definition.
+
+ * org-macro.el (org-macro--collect-macros): Fix a bug where
+ reading a macro in a setup file would remove other macros read so
+ far from template. Change function signature.
+ (org-macro-initialize-templates): Apply signature change from function
+ above.
+
+ * ox.el (org-export--list-bound-variables): Rename from
+ `org-export--install-letbind-maybe'. Though, only return list of
+ bound variables instead of installing them as buffer-local
+ variables.
+ (org-export-get-environment): Use new function. Take care of the
+ installation of bound variables.
+ (org-export--generate-copy-script): Make sure non-Org variables are
+ also installed in buffer copy.
+
+ * ox.el (org-export-get-environment): Update comment.
+ (org-export--install-letbind-maybe): Go into SETUPFILE files and
+ handle BIND keywords there.
+
+ * ox-latex.el (org-latex-link): Do not prefix relative paths with
+ "file://".
+
+ * org.el (org-link-search): Preserve priority of #+TARGET over
+ #+NAME when resolving a link.
+
+ * ox-latex.el (org-latex-long-listings): New variable.
+ (org-latex-src-block): Use new variable.
+
+ * ox.el (org-export-data): White spaces after export snippets are
+ never ignored.
+
+ * org-element.el (org-element-macro-parser): Allow to escape
+ escaping character before a comma. Also do not trim spaces at
+ argument boundaries.
+
+ * ox.el (org-export-async-start): Use correct coding system so
+ unibyte characters do not appear in the resulting buffer or file.
+ (org-export--copy-to-kill-ring-p): Move function elsewhere in the
+ file.
+
+ * ox-latex.el (org-latex--inline-image): Fix error when no default
+ width, height and option are provided and no attribute is set for
+ the inline image.
+
+ * org.el (org-comment-or-uncomment-region): Fix commenting lines
+ beginning with a link.
+ (org-delete-char): Fix "Invalid use of `\\' in replacement text"
+ when deleting a character in a cell which contains "\"
+ (org-export-backends): Remove duplicates. Reorder alphabetically.
+
+ * ox-texinfo.el (org-texinfo-plain-list): Use `member' instead of
+ `memq' when matching strings.
+
+ * ox.el (org-export-read-attribute): Do not use `read' to read
+ attributes. Instead, extract keywords and values from it, which
+ means each value will be a string when non-nil.
+
+ * ox-beamer.el (org-beamer-plain-list): Use new attribute syntax.
+
+ * ox-html.el (org-html--textarea-block): Use new attribute syntax.
+
+ * ox-latex.el (org-latex--inline-image, org-latex--org-table)
+ (org-latex--math-table): Use new attribute syntax.
+
+ * ox-man.el (org-man-table--org-table): Use new attribute syntax.
+ Small refactoring.
+
+ * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell):
+ Use new attribute syntax.
+
+ * ox.el (org-export-async-start): Remove code evaluation queries
+ from asynchronous export.
+
+ * ox-latex.el (latex): Activate smart quotes by default.
+ (org-latex--inline-image): Don't insert a default width when
+ height is provided in a figure environment.
+ (org-latex--inline-image): Do not use default width
+ (resp. height) when an user height (resp. width) is provided.
+ Also, default height is only used when image is not wrapped within
+ a figure or wrapfigure environment, in order to preserve ratio.
+ (org-latex-image-default-width, org-latex-image-default-height):
+ Update docstring.
+
+ * ox-icalendar.el (org-icalendar-create-uid): Fix error when
+ `org-icalendar-store-UID' is non-nil.
+
+ * ox-latex.el (latex): Introduce new buffer keyword.
+ (org-latex-template): Use new keyword.
+
+ * ox-beamer.el (org-beamer-template): Use new keyword.
+
+ * org.el (org-create-formula--latex-header): Use new keyword.
+
+ * ox-beamer.el (org-beamer-column-view-format, org-beamer-theme)
+ (org-beamer-environments-extra): Add :version and
+ :package-version.
+
+ * ox-html.el (org-html-with-latex, org-html-inline-image-rules):
+ Add :version and :package-version.
+
+ * ox-latex.el (org-latex-inline-image-rules)
+ (org-latex-default-table-environment)
+ (org-latex-default-table-mode, org-latex-tables-booktabs)
+ (org-latex-table-scientific-notation, org-latex-known-errors):
+ Add :version and :package-version.
+
+ * ox-md.el (org-md-headline-style): Add :version and
+ :package-version.
+
+ * ox-odt.el (org-odt-with-latex): Add :version
+ and :package-version.
+
+ * ox.el (org-export-with-drawers, org-export-with-latex)
+ (org-export-with-inlinetasks, org-export-with-planning)
+ (org-export-with-smart-quotes, org-export-with-statistics-cookies)
+ (org-export-allow-bind-keywords, org-export-async-init-file):
+ Add :version and :package-version.
+
+ * ox-icalendar.el (org-icalendar-export-to-ics): Change back-end
+ name from `e-ascii' to `ascii'.
+
+ * ox.el (org-export--generate-copy-script): Call `org-mode' when
+ duplicating a buffer. It will properly set every variable, like
+ `comment-start'.
+ (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
+ generated from a TOC keyword.
+
+ * org.el (org-export-backends): Do not reset list of loaded
+ back-ends to variable's value after a reload.
+
+ * ox-latex.el (org-latex-src-block): Do not overwrite provided
+ numbering options in minted and listings.
+ (org-latex-headline): Don't add optional title on unnumbered
+ headlines.
+
+ * ox-html.el (html): Fix "HTML_HEAD" and "HTML_HEAD_EXTRA"
+ keywords. Allow multiple #+LATEX_HEAD and #+LATEX_HEAD_EXTRA
+ again.
+
+ * org.el (org-fill-paragraph): Small refactoring to
+ `org-fill-paragraph'. Do not look for table cells in a paragraph.
+
+ * org-element.el (org-element-object-restrictions):
+ Simplify restrictions within secondary strings and objects.
+
+ * org-list.el (org-list-send-list): Do not rely on
+ `org-list-parse-list'.
+ (org-list-to-latex, org-list-to-html, org-list-to-texinfo):
+ Use appropriate export back-end instead of using
+ `org-list-to-generic'.
+
+ * ox-html.el (org-html-inner-template): Remove contents div and
+ title.
+ (org-html-template): Add contents div and title.
+ (org-html-infojs-install-script): Can't activate jsinfo script
+ during a body-only export.
+
+ * ox.el (org-export-as): Store export options in :export-options
+ porperty 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.
+
+ * ox.el (org-export-format-code-default): Handle empty source
+ blocks more gracefully.
+
+ * ox-ascii.el (org-ascii-src-block): Handle empty blocks more
+ gracefully.
+
+ * org.el (org-export-backends): Update variable. `infojs' was
+ merged into ox-html and `freemind' was added.
+
+ * ox.el (org-export--selected-trees): Also mark inlinetasks with a
+ select tag.
+ (org-export--skip-p): Skip inlinetasks with a :noexport: tag.
+
+ * ob-tangle.el (org-babel-spec-to-string): Use dedicated function
+ for unescaping code.
+
+ * ox-html.el (org-html-link): Silence byte-compiler.
+ (html): Add infojs installation script in options filter.
+ (org-html-infojs-install-script): Remove check for back-end as we
+ can safely assume the function will be called from `html' back-end
+ or one of its derivative.
+
+ * ox-icalendar.el (org-agenda-collect-markers)
+ (org-create-marker-find-array): Remove functions.
+ (org-icalendar-export-current-agenda): Integrate previous
+ functions.
+
+ * ox-latex.el (org-latex-format-headline-default-function):
+ Use declarative shape to nest makup for TODO keywords.
+ Previous syntax generated errors during export.
+
+ * ox.el (org-export-async-start): Ignore `org-mode-hook' and
+ `kill-emacs-hook'. The first one has been run in the original
+ buffer. The second is not necessary and can pollute output to a
+ temporary buffer (e.g. with `org-clock-persistence-insinuate').
+
+ * ox-html.el (org-html-inner-template): Remove title.
+ (org-html-template): Add title.
+
+ * ox.el (org-export--get-min-level): Ignore footnote section when
+ computing minimal headline level.
+
+ * org.el (org-do-latex-and-related): Fix infloop when user
+ provides a wrong value for `org-highlight-latex-and-related'.
+ In this case, `org-latex-and-related-regexp' is the empty string and
+ generates an infloop since matching it doesn't move point.
+
+ * org-element.el (org-element-headline-parser):
+ Rename :optional-title into :alt-title.
+
+ * ox.el (org-export-get-alt-title): Rename from
+ `org-export-get-optional-title'.
+
+ * ox-ascii.el (org-ascii--build-title):
+ * ox-html.el (org-html--format-toc-headline):
+ * ox-latex.el (org-latex-headline):
+ * ox-texinfo.el (org-texinfo--get-node)
+ (org-texinfo--generate-menu-items): Apply name change.
+
+ * ox.el (org-export--get-inbuffer-options): Remove an optional
+ argument. Rewrite function. Properties read from a setupfile do
+ not overwrite anymore previously computed properties.
+ (org-export-get-environment): Apply changes to previous function.
+
+ * org.el (org-create-formula--latex-header): Apply arity change
+ from `org-export--get-inbuffer-options'.
+
+ * ox-latex.el (org-latex-compile): Add an optional argument for
+ latex snippet previewing.
+
+ * org.el (org-create-formula-image-with-imagemagick):
+ Use `org-latex-compile' instead of rewriting it.
+
+ * ox-html.el (org-html-fontify-code): Do not use [^\000] in
+ regexps that may match large strings.
+
+ * org.el (org-create-formula--latex-header): New function.
+ (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
+ elements in `org-export-get-previous-element'.
+
+ * org-element.el (org-element-all-successors): Add `plain-link'
+ successor.
+ (org-element-object-restrictions): Remove `link' within `link'.
+ Allow `plain-link' instead.
+ (org-element-plain-link-successor): New function.
+
+ * org.el (org-match-substring-regexp)
+ (org-match-substring-with-braces-regexp): Update regexp.
+ A sub/superscript cannot start anymore at the beginning of the line
+ or after a space.
+
+ * org-element.el (org-element--get-next-object-candidates):
+ Rewrite function to simplify algorithm.
+ (org-element-context, org-element--parse-elements): Apply changes.
+
+ * org.el (org-fill-paragraph): Apply changes.
+
+ * ox-html.el (org-html-link, org-html-link--inline-image):
+ Attributes specified to a paragraph only apply to first link
+ within.
+
+ * ox-latex.el (org-latex-headline): Do not add optional section
+ name when section is unnumbered.
+
+ * org.el (org-in-verbatim-emphasis): Fix false positive when point
+ is just after the closing emphasis marker.
+ (org-fill-paragraph): Do not move point when filling a table.
+
+ * ox-ascii.el (ascii): Add new filter.
+ (org-ascii-filter-comment-spacing): New function.
+ (org-latex-keyword): Remove "figures" value.
+
+ * ox-ascii.el (org-ascii--list-tables): Fix docstring.
+
+ * ox-html.el (org-html--format-toc-headline): Fix function name.
+ (org-html-toc, org-html--toc-text): Change to docstring.
+ (org-html-list-of-listings, org-html-list-of-tables):
+ New functions.
+ (org-html-keyword): Use new functions.
+ (org-html-src-block): Add an ID attribute when a name is given.
+
+ * org-element.el (org-element-footnote-definition-parser):
+ Require 2 blank lines to separate footnote definition.
+
+ * org-footnote.el (org-footnote-at-definition-p): Require 2 blank
+ lines to separate footnote definition.
+
+ * ox.el (org-export-stack): Rewrite.
+ (org-export-stack-refresh): Refactor.
+ (org-export-stack-remove, org-export-stack-view): Apply renaming.
+ (org-export-stack-mode-map): Use tabulated list map as a basis.
+ (org-export-stack--generate, org-export-stack--num-predicate):
+ New function.
+ (org-export-get-optional-title): Return regular title when no
+ optional title is found.
+
+ * ox-ascii.el (org-ascii--build-title): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-html.el (org-html--format-toc-headline): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-latex.el (org-latex-headline): Apply change to
+ `org-export-get-optional-title'.
+
+ * ox-ascii.el (org-ascii--build-title): Add an argument.
+ Use optional title when building a toc line.
+ (org-ascii--build-toc): Call `org-ascii--build-title' with
+ appropriate arguments.
+
+ * ox-latex.el (org-latex-headline): Use optional title for table
+ of contents.
+
+ * ox-html.el (org-html--toc-text): Rename from
+ `org-html-toc-text'. Add docstring.
+ (org-html--format-toc-headline): Rename from
+ `org-html-format-toc-headline'. Add docstring. Use optional
+ title if possible.
+ (org-html-toc): Add docstring.
+
+ * org-element.el (org-element-headline-parser): Node property
+ :OPTIONAL_TITLE: in a headline will be parsed and stored under
+ :optional-title property.
+
+ * ox.el (org-export-get-optional-title): New function.
+
+ * ox-latex.el (org-latex-format-headline-default-function):
+ Make the variable a function.
+
+ * ox-publish.el (org-publish-resolve-external-fuzzy-link):
+ No error when resolving external fuzzy links outside publishing.
+ Though search option for these links will not be resolved.
+
+ * ox-latex.el (org-latex-guess-inputenc): Set inputenc option
+ according to `org-export-coding-system'.
+
+ * ox.el (org-export--generate-copy-script):
+ Clone `buffer-file-coding-system' when creating a buffer copy.
+
+ * ox-html.el (org-html-link): Resolve external links with search
+ options like [[file.org::#custom-id]] or
+ [[file.org::*headline-search]].
+
+ * ox-publish.el (org-publish-collect-numbering)
+ (org-publish-resolve-external-fuzzy-link): New functions.
+ (org-publish-org-to): Add new collecting function to final output
+ filter. Move index collecting function to the same filter.
+ (org-publish-collect-index): Called from final output filter.
+
+ * ox-html.el (org-html-format-headline--wrap, org-html-headline):
+ Use :CUSTOM_ID, not :custom-id.
+
+ * org-element.el (org-element-latex-environment-parser): Fix wrong
+ value for :post-affiliated property when parsing a latex
+ environment.
+
+ * ox-latex.el (org-latex-property-drawer): Remove function.
+
+ * ox-ascii.el (org-ascii-filter-paragraph-spacing):
+ 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.
+
+ * ox-latex.el (org-latex-template): Allow to span documentclass
+ options accross multiple lines in template.
+
+ * ox-texinfo.el (org-texinfo--get-node): Upcase property name.
+ (org-texinfo--get-node): New function.
+ (org-texinfo-headline, org-texinfo-link): Use new function.
+
+ * ox-ascii.el (org-ascii-quote-block): Do not fill quote block
+ contents. Just indent them.
+
+ * ox-publish.el (org-publish-index-generate-theindex): Do not
+ create an "* Index" headline in "theindex.inc". Though, create an
+ "Index" title in fallback "theindex.org".
+
+ * ox-publish.el (org-publish-projects): Publish "theindex.org"
+ last, so that "theindex.inc" can be completed.
+
+ * ox-publish.el (org-publish-project-alist): Fix docstring.
+ (org-publish-collect-index): Fix typo.
+
+ * ox.el (org-export--dispatch-ui): Prevent invisible cursor from
+ highlighting brackets in UI
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Fix docstring.
+
+ * org.el (org-export-backends): Add new back-end in customize
+ interface.
+
+ * ox-beamer.el (org-beamer--get-label, org-beamer--frame-level)
+ (org-beamer--format-section, org-beamer--format-frame)
+ (org-beamer--format-block, org-beamer-headline): Apply changes to
+ properties.
+
+ * ox-html.el (org-html-headline, org-html-link, org-html-section):
+ Apply changes to properties.
+
+ * ox-icalendar.el (org-icalendar-create-uid)
+ (org-icalendar-blocked-headline-p, org-icalendar-entry)
+ (org-icalendar--valarm): Apply changes to properties.
+
+ * ox-odt.el (org-odt-headline): Apply changes
+
+ * ox-publish.el (org-publish-collect-index): Apply changes to
+ properties.
+
+ * ox-texinfo.el (org-texinfo--generate-menu-list)
+ (org-texinfo--generate-menu-items, org-texinfo-template)
+ (org-texinfo-headline, org-texinfo-link): Apply changes to
+ properties.
+
+ * ox.el (org-export-resolve-id-link, org-export-get-category):
+ Apply changes to properties.
+ (org-export-get-node-property): Update docstring.
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Upcase properties. This is done
+ to avoid confusion between properties from parser (e.g. `:end')
+ and properties from the property drawer (e.g. :END:).
+
+ * ox-publish.el (org-publish-index-generate-theindex): Preserve
+ order in file. Fix error when two index entries were identical.
+ Create again theindex.inc.
+
+ * org-element.el (org-element-map): Allow to map over any list.
+ Do not restrict mapping to object types.
+
+ * org-faces.el (org-latex-and-related): Rename from
+ `org-latex-and-export-specials', which wasn't appropriate anymore.
+
+ * org.el (org-highlight-latex-and-related)
+ (org-latex-and-related-regexp): New variables.
+ (org-compute-latex-and-related-regexp, org-do-latex-and-related):
+ New function, revived from a previous commit.
+ (org-set-regexps-and-options, org-set-font-lock-defaults): Use new
+ functions.
+ (org-set-regexps-and-options): Remove reference to LATEX_CLASS and
+ beamer back-end.
+
+ * ox-publish.el (org-publish-org-to): Small refactoring.
+
+ * ox.el (org-export-install-filters): Properly install filters
+ send through ext-plist mechanism.
+
+ * ox-publish.el (org-publish-org-to): Small refactoring.
+
+ * ox-html.el (org-html-keyword): Remove INDEX keyword handling.
+ ox-publish.el takes care of it already.
+
+ * org-macro.el: New file.
+
+ * org.el: Remove macro code.
+
+ * ox.el: Require new library
+
+ * ox.el (org-export-resolve-fuzzy-link): Ignore statistics cookies
+ when matching an headline.
+ (org-export--dispatch-ui): Display a help message in header line
+ for scrolling dispatcher's buffer
+ (org-export-resolve-radio-link): Radio targets are
+ case-insensitive.
+
+ * ox-icalendar.el (org-export-icalendar): Fix docstring.
+
+ * ox.el (org-export-dispatch): Fix docstring.
+ (org-export--dispatch-action): Small improvement to line by line
+ scrolling.
+ (org-export-resolve-fuzzy-link): Refactor. Whitespaces are not
+ significant when matching a fuzzy link.
+
+ * org-element.el (org-element-link-parser): Do not remove newlines
+ characters in paths anymore, since this is not required.
+
+ * ox.el (org-export--dispatch-ui): Rename from
+ `org-export-dispatch-ui'. Handle scrolling.
+ (org-export--dispatch-action): Rename from
+ `org-export-dispatch-action'. Implement scrolling.
+ (org-export-dispatch): Apply renaming.
+
+ * org.el (org-ctrl-c-ctrl-c): Do nothing when at a blank line,
+ but still run `org-ctrl-c-ctrl-c-final-hook'.
+ (org-end-of-line): Remove `ignore-error'.
+
+ * org-element.el (org-element-at-point): Return nil when in the
+ first empty lines of the buffer. Return headline when in empty
+ lines just after the headline.
+
+ * ox.el (org-export-output-file-name): Add a protection when
+ output file name is the same as the original org.
+
+ * ox-beamer.el (org-beamer-template): Add missing `class' argument
+ for `format-string'.
+
+ * ox-latex.el (org-latex-template): Add missing `class' argument
+ for `format-string'.
+
+ * ox.el (org-export-stack-mode): Fix docstring.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option):
+ Allow completion for ATTR_ prefixed keywords.
+
+ * org.el (org-options-keywords): Add missing colons.
+
+ * org-macs.el (org-default-options): Remove function.
+
+ * org-pcomplete.el (org-command-at-point): Fix bug with some file
+ options.
+ (pcomplete/org-mode/file-option/x): Remove macro.
+ (pcomplete/org-mode/file-option): Refactor code.
+ (pcomplete/org-mode/file-option/author)
+ (pcomplete/org-mode/file-option/date)
+ (pcomplete/org-mode/file-option/title)
+ (pcomplete/org-mode/file-option/tags)
+ (pcomplete/org-mode/file-option/select_tags)
+ (pcomplete/org-mode/file-option/priorities)
+ (pcomplete/org-mode/file-option/language)
+ (pcomplete/org-mode/file-option/filetags)
+ (pcomplete/org-mode/file-option/exclude_tags)
+ (pcomplete/org-mode/file-option/email): New functions.
+
+ * ox.el (org-export--collect-headline-numbering): Remove footnote
+ section from TOC.
+ (org-export-collect-headlines): Do not count footnote section when
+ numbering a headline.
+
+ * ox-beamer.el (org-beamer-plain-list): Also read #+attr_latex
+ attributes in order to determine list's options.
+
+ * ox-ascii.el (org-ascii-inner-template): New function.
+ (org-ascii-template): Use new function.
+ (org-ascii-export-as-ascii, org-ascii-export-to-ascii):
+ Update docstring.
+
+ * org-element.el (org-element-link-parser): Take into
+ consideration links filled and indented.
+
+ * org-element.el (org-element-link-parser): Remove all newline
+ characters in path property.
+
+ * ox.el (org-export-as): Call `inner-template' function, if
+ available.
+
+ * ox-html.el (org-html-inner-template): New function.
+ (org-html-template): Move all parts that should be inserted even
+ in a body-only export into `org-html-inner-template'.
+
+ * org.el (org-forward-element, org-backward-element): When no
+ headline is found at the same level, still move forward or
+ backward.
+
+ * org-element.el (org-element--current-element): Add a limit
+ argument.
+ (org-element--collect-affiliated-keywords): Fix parsing of orphaned
+ keyword at the end of an element.
+
+ * ox-texinfo.el (org-texinfo-src-block): Remove spurious newline
+ character as `org-export-format-code-default' already makes sure
+ the string returned will end with a single one.
+
+ * ox-latex.el (org-latex-headline): When a function returns a
+ sectioning command, only one placeholder should be required.
+
+ * org-element.el (org-element-nested-p): Do not inline function.
+
+ * ox.el (org-export-copy-buffer, org-export-with-buffer-copy)
+ (org-export--generate-copy-script): Move earlier in the file.
+
+ * ox-texinfo.el (org-texinfo-link): Do not transform path part of
+ internal links.
+
+ * org.el (org-org-menu): Small refactoring.
+
+ * ox-beamer.el (require):
+ * ox-icalendar.el (require):
+ * ox-jsinfo.el (require):
+ * ox-md.el (require): Require cl when compiling.
+
+ * org.el (org-export-backends):
+ * ox.el (org-export-dispatch): Fix docstring.
+
+ * ox.el (org-export-dispatch-ui): Widen UI by 2 characters.
+
+ * ox-latex.el (org-latex-special-block): Add :options attribute to
+ special blocks to specify options.
+
+ * ox-beamer.el (org-beamer-template): Add BEAMER_HEADER keywords
+ below LATEX_HEADER.
+
+ * ox-latex.el (org-latex-format-headline-function): Fix missing
+ parens in the docstring.
+
+ * org.el (org-export-backends): Remove `:initialize' function.
+
+ * org.el (org-reload): Also reload export back-ends in use.
+
+ * ox-latex.el (org-latex-example-block, org-latex-src-block):
+ Ignore element if it's empty. This fixes error "apply: Wrong
+ number of arguments: max, 0".
+
+ * ox-beamer.el (org-beamer-template): Provide an error when LaTeX
+ class is invalid.
+
+ * ox-latex.el (org-latex-template): Provide an error when LaTeX
+ class is invalid.
+
+ * org.el (org-modules): Remove export back-ends from the list.
+ Update docstring.
+ (org-export-backends): New variable.
+
+ * ox.el (org-export-async-start): Make sure export framework is
+ required in the external process.
+
+ * org.el (org-format-latex-header-extra, org-export-have-math):
+ Remove variables.
+ (org-latex-default-packages-alist): Rename from
+ `org-export-latex-default-packages-alist'.
+ (org-latex-packages-alist): Rename from
+ `org-export-latex-packages-alist'.
+ (org-try-cdlatex-tab, org-cdlatex-underscore-caret,
+ org-cdlatex-math-modify): Reorder in file.
+ (org-format-latex): Remove `org-format-latex-header-extra'.
+ (org-create-formula-image-with-dvipng,
+ org-create-formula-image-with-imagemagick): Apply variables renaming
+ and removal.
+
+ * org-entities.el (org-entities-user): Update docstring.
+
+ * ox-latex.el (org-latex-classes, org-latex-listings):
+ Update docstring.
+ (org-latex-guess-inputenc): Rename from `org-latex--guess-inputenc'.
+ (org-latex-guess-babel-language): Rename from
+ `org-latex--guess-babel-language'.
+ (org-latex-template): Apply renaming.
+
+ * ox-beamer.el (org-beamer-template): Apply renaming.
+
+ * ob-latex.el (org-babel-execute:latex): Apply variable renaming
+ and removal.
+ (org-babel-latex-tex-to-pdf): Call `org-latex-compile' instead of
+ copying it.
+
+ * org-macs.el (org-if-unprotected, org-if-unprotected-1)
+ (org-if-unprotected-at): Remove macros.
+ (org-re-search-forward-unprotected): Remove function.
+
+ * org.el (org-format-latex):
+ * org-list.el (org-list-struct):
+ * org-footnote.el (org-footnote-at-reference-p):
+ * org-capture.el (org-capture-fill-template): Remove reference to
+ `org-protected'.
+
+ * ob-exp.el (org-babel-exp-process-buffer): Rename from
+ `org-export-blocks-preprocess'.
+
+ * ox.el (org-export-execute-babel-code): Apply previous renaming.
+
+ * org-pcomplete.el (pcomplete/org-mode/file-option): Collect valid
+ keywords for completion without requiring the whole export
+ framework.
+ (pcomplete/org-mode/file-option/options): Rewrite using new export
+ framework. Only complete up to the colon.
+ (pcomplete/org-mode/file-option/x): Remove macro.
+ (pcomplete/org-mode/file-option/title)
+ (pcomplete/org-mode/file-option/author)
+ (pcomplete/org-mode/file-option/email)
+ (pcomplete/org-mode/file-option/date): Remove functions.
+ (pcomplete/org-mode/file-option/infojs_opt): New function.
+
+ * org-clock.el (org-clocktable-defaults)
+ (org-clocktable-write-default): Avoid requiring the whole export
+ framework just to check one variable.
+
+ * org-footnote.el (org-footnote-section): Update docstring.
+ (org-footnote-normalize): Remove all export related part from the
+ function.
+
+ * org-inlinetask.el (org-inlinetask-export)
+ (org-inlinetask-export-templates): Remove variables.
+ (org-inlinetask-export-handler): Remove function.
+
+ * org-plot.el: Remove dependency on `org-exp' library.
+
+ * org.el (org-additional-option-like-keywords): Remove variable.
+ (org-get-export-keywords): New function.
+ (org-options-keywords): Update default list of keywords.
+ (org-remove-flyspell-overlays-in): Apply changes to keywords
+ compilation.
+ (org-highlight-latex-fragments-and-specials)
+ (org-latex-and-specials-regexp)
+ (org-export-html-special-string-regexps): Remove variables.
+ (org-compute-latex-and-specials-regexp)
+ (org-do-latex-and-special-faces, org-remove-file-link-modifiers):
+ Remove functions.
+ (org-set-regexps-and-options, org-set-font-lock-defaults): Apply all
+ removals.
+ (org-use-sub-superscripts): Fix docstring. Remove unused group.
+ (org-match-sexp-depth): Make it a defconst instead of a defcustom
+ in order to remove `org-export-translation' group completely.
+
+ * ob-haskell.el (org-babel-haskell-export-to-lhs): Use new
+ exporter.
+
+ * ob-latex.el (org-babel-execute:latex): Use new exporter.
+
+ * ob-org.el (org-babel-execute:org): Use new exporter.
+
+ * org-agenda.el (org-agenda-menu, org-agenda-write): Use new
+ iCalendar export back-end.
+
+ * org-table.el (org-table-export, orgtbl-export):
+ Remove dependency on `org-exp' library.
+ (org-table-clean-before-export): New function.
+ (org-table-colgroup-info): New variable.
+ (orgtbl-to-html): Use to new HTML export back-end.
+
+ * org.el (org-modules): Remove modules relative to obsolete export
+ framework and add those relative to the new one.
+ (org-create-formula-image-with-dvipng, org-format-latex
+ org-create-formula-image-with-imagemagick): Use new exporter.
+ (org-indent-line): INCLUDE keywords are indented like regular
+ keywords.
+ (org-mode-map): Bind C-c C-e to new export dispatcher.
+ (org-menu): Install new exporter in menu.
+
+ * org-ascii.el:
+ * org-beamer.el:
+ * org-docbook.el:
+ * org-exp-blocks.el:
+ * org-exp.el:
+ * org-freemind.el:
+ * org-html.el:
+ * org-icalendar.el:
+ * org-jsinfo.el:
+ * org-latex.el:
+ * org-lparse.el:
+ * org-odt.el:
+ * org-publish.el:
+ * org-special-blocks.el:
+ * org-taskjuggler.el:
+ * org-xoxo.el: Remove
+
+ * ox-ascii.el:
+ * ox-beamer.el:
+ * ox-html.el:
+ * ox-icalendar.el:
+ * ox-jsinfo.el:
+ * ox-latex.el:
+ * ox-man.el:
+ * ox-md.el:
+ * ox-odt.el:
+ * ox-publish.el:
+ * ox-texinfo.el:
+ * ox.el: New file.
+
+ * ob-exp.el (org-export-blocks-preprocess): Do not use
+ `indent-code-rigidly' as it doesn't indent contents of strings.
+
+ * org-element.el (org-element-map): Change to function
+ indentation. Also complete docstring.
+
+ * org.el (org-ctrl-c-ctrl-c): Major rewrite function using
+ Elements.
+
+ * org-element.el (org-element-at-point): When point is before any
+ element, in the first blank lines of the buffer, return nil.
+ When point is within blank lines just after a headline, return that
+ headline.
+ (org-element-context): Return nil when point is within the blank at
+ the beginning of the buffer.
+
+ * org.el (org-edit-special): Fix regression.
+ (org-timestamp-has-time-p, org-timestamp-format)
+ (org-timestamp-split-range, org-timestamp-translate):
+ New functions.
+
+ * org-element.el (org-element-timestamp-interpreter):
+ Interpret timestamps ranges with repeaters.
+
+ * org.el (org-edit-special): Rewrite `org-edit-special' using Org
+ Elements tools. Behavior should be unchanged.
+
+ * org-element.el (org-element-context): Add an optional argument
+ so that (org-element-context) and (org-element-context
+ (org-element-at-point)) are equivalent.
+
+ * ob.el: Only use the :wrap argument up to the first space when
+ creating the #+END_ directive.
+
+ * org-element.el (org-element-object-variables): New variable.
+ (org-element-parse-secondary-string): Copy some buffer-local
+ variables to the temporary buffer created to parse the string so
+ links can still be properly expanded.
+ (org-element-link-parser): Link expansion and translation are applied
+ transparently for the parser.
+
+ * org-element.el (org-element-line-break-parser): Line break
+ includes the newline character following the backslashes.
+ (org-element-line-break-interpreter): Apply changes to line break
+ parsing.
+
+ * org.el (org-all-targets): Fix radio targets detection when
+ object is directly followed by a non-whitespace character.
+
+ * ob.el (org-babel-use-quick-and-dirty-noweb-expansion):
+ Rename from `org-babel-use-quick-and-dirty-noweb-expansion'.
+ (org-babel-expand-noweb-references): Use new variable name.
+
+ * org-element.el (org-element-timestamp-interpreter):
+ Fix timestamp interpreter when raw value isn't available.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): Make sure to parse
+ inline babel call or inline src block instead of the following
+ object.
+
+ * org-element.el (org-element-timestamp-parser): Timestamp with
+ time range has active/inactive-range type.
+ (org-element-block-name-alist): Do not reset
+ `org-element-block-name-alist' at each reload.
+ (org-element-object-restrictions): Allow timestamps in parsed
+ keywords (i.e. DATE).
+
+ * org-agenda.el (org-agenda-show-clocking-issues)
+ (org-agenda-format-item): Silence byte compiler.
+
+ * org-colview.el (org-agenda-columns): Silence byte compiler.
+
+ * org.el (org-properties-postprocess-alist): Silence byte
+ compiler.
+
+ * org-element.el (org-element-timestamp-parser): Return nil for
+ unspecified :hour-end and :minute-end properties.
+ (org-element-object-restrictions): Add footnote references objects
+ in table cells.
+ (org-element-interpret-data): Clear text properties when
+ interpreting a string .
+
+ * org-capture.el (org-capture--expand-keyword-in-embedded-elisp):
+ Fix docstring.
+
+ * org.el (org-adaptive-fill-function): Items do not have
+ a :post-affiliated property. Use :begin property instead.
+
+ * org-element.el (org-element-headline-parser)
+ (org-element-inlinetask-parser): Remove :clockedp property.
+
+ * org.el (org-adaptive-fill-function): All elements do not have a
+ :post-affiliated property.
+ (org-macro-replace-all): Signal an error when a circular macro
+ expansion happens.
+ (org-macro-initialize-templates): Fix docstring.
+
+ * org-element.el (org-element-map): Fix docstring.
+ (org-element-contents, org-element-set-contents)
+ (org-element-adopt-elements): Fix accessors and setters wrt
+ secondary strings.
+ (org-element-headline-parser)
+ (org-element-inlinetask-parser): Fix void-function
+ `org-clocking-buffer' error.
+ (org-element-context): Fix org-element-context on parsed keywords.
+ (org-element-context): Find objects in document and parsable
+ affiliated keywords.
+ (org-element-center-block-parser)
+ (org-element-drawer-parser, org-element-dynamic-block-parser)
+ (org-element-footnote-definition-parser)
+ (org-element-plain-list-parser)
+ (org-element-property-drawer-parser)
+ (org-element-quote-block-parser, org-element-special-block-parser)
+ (org-element-babel-call-parser, org-element-comment-parser)
+ (org-element-comment-block-parser, org-element-diary-sexp-parser)
+ (org-element-example-block-parser)
+ (org-element-export-block-parser, org-element-fixed-width-parser)
+ (org-element-horizontal-rule-parser, org-element-keyword-parser)
+ (org-element-latex-environment-parser)
+ (org-element-paragraph-parser, org-element-src-block-parser)
+ (org-element-table-parser, org-element-verse-block-parser):
+ Add `:post-affiliated' property to elements.
+ (org-element-inlinetask-parser): Remove affilated keywords.
+
+ * org.el (org-adaptive-fill-function): Use new property.
+
+ * org-element.el (org-element--collect-affiliated-keywords):
+ Allow duals keywords with only secondary value.
+ (org-element-timestamp-parser): Modify timestamp objects
+ properties.
+ (org-element-headline-parser, org-element-inlinetask-parser): Remove
+ `:timestamp' and `:clock' property. Add `:clockedp' property. Also,
+ set `:closed', `:deadline' and `:scheduled' values to timestamp
+ objects, not strings. Small refactoring.
+ (org-element-clock-parser): Rename `:time' property into `:duration'.
+ Also, set `:value' value as a timestamp object, not a string.
+ (org-element-planning-parser): Set `:closed', `:deadline' and
+ `:scheduled' values to timestamp objects, not strings.
+ (org-element-clock-interpreter, org-element-planning-interpreter)
+ (org-element-timestamp-interpreter): Update interpreters.
+ (org-element--current-element): Tiny refactoring.
+
+ * ob.el (org-babel-where-is-src-block-result): Insert new results
+ keyword in current narrowed part of buffer, if necessary.
+ Small refactoring.
+ (org-babel-insert-result): Do not widen buffer when new results have
+ to be inserted. Therefore, results inserted after the last block of
+ a narrowed buffer still belong to the narrowed part of the buffer.
+
+ * org-agenda.el (org-agenda-get-deadlines): Tiny stylistic change.
+
+ * org-element.el (org-element-paragraph-separate): Diary-sexp
+ elements can separate paragraphs.
+ (org-element-all-elements): Install new `diary-sexp' type.
+ (org-element--current-element): Recognize new `diary-sexp' elements.
+ (org-element-diary-sexp-parser)
+ (org-element-diary-sexp-interpreter): New functions.
+ (org-element-horizontal-rule-parser)
+ (org-element-keyword-parser, org-element--current-element):
+ Small refactoring.
+ (org-element-property): Access to text properties when argument is
+ a string.
+ (org-element-put-property): Correctly set property when target is
+ a string.
+ (org-element-adopt-elements): Also put :parent properties on
+ strings.
+
+ * ob-exp.el (org-babel-exp-code): Escape code when re-creating a
+ src blocks.
+ (org-export-blocks-preprocess): Pos can sometimes be set to a
+ value greater than start, because of indentation, and lead to a
+ search bound error.
+ (org-babel-exp-code): Remove comma-escaping special rule for Org
+ blocks.
+ (org-export-blocks-preprocess): Results of an evaluated code block
+ can be inserted within the blank lines after the block. Hence, if
+ the block has to be removed, delete everything down to the first
+ non-blank line after the end of block closing string, instead of
+ removing everything down to the very end of the block.
+
+ * org.el (org-all-targets): Make sure the regexp really matched a
+ radio target.
+ (org-macro-expand, org-macro-replace-all): Change signature.
+ The function now accepts an alist of templates so it doesn't have to
+ rely only on `org-macro-templates'.
+ (org-macro-initialize-templates): {{{date}}} is not anymore an
+ alias for {{{time}}}. During export, it will provide the value
+ stored in DATE keyword instead.
+
+ * org-element.el (org-element-object-restrictions): Allow links in
+ caption. Also allow inline-src-blocks and inline-babel-calls.
+ (org-element-map): Change signature.
+ (org-element-parsed-keywords): Remove document properties from the
+ value.
+ (org-element-dual-keywords): Fix docstring.
+ (org-element-document-properties): New variable
+ (org-element-all-elements): Add `node-property' as a new element
+ type.
+ (org-element-greater-elements): Add property-drawer element to
+ greater elements since they now contain node-property elements.
+ (org-element-drawer-parser): Small refactoring.
+ (org-element-property-drawer-parser): Move into Greater Elements
+ file section.
+ (org-element-node-property-parser,
+ org-element-node-property-interpreter): New functions.
+ (org-element--current-element, org-element-at-point)
+ (org-element--parse-elements): Handle new element type.
+ (org-element--collect-affiliated-keywords): Fix return value.
+ (org-element-center-block-parser)
+ (org-element-drawer-parser, org-element-dynamic-block-parser)
+ (org-element-footnote-definition-parser)
+ (org-element-plain-list-parser, org-element-quote-block-parser)
+ (org-element-special-block-parser, org-element-babel-call-parser)
+ (org-element-comment-parser, org-element-comment-block-parser)
+ (org-element-example-block-parser)
+ (org-element-export-block-parser, org-element-fixed-width-parser)
+ (org-element-horizontal-rule-parser, org-element-keyword-parser)
+ (org-element-latex-environment-parser)
+ (org-element-paragraph-parser, org-element-property-drawer-parser)
+ (org-element-src-block-parser, org-element-table-parser)
+ (org-element-verse-block-parser): Change signature. Now use an
+ additional argument: affiliated.
+ (org-element--current-element): Skip affiliated keywords and pass
+ them as an argument to parsers. It prevents to walk through these
+ keywords twice: the first time to get to the first line of the
+ element, and a second time to collect the affiliated keywords.
+
+ * ob-exp.el (org-babel-exp-non-block-elements): More accurate
+ white space handling when evaluating inline-src-block, babel-call
+ and inline-babel-call elements or objects. Also removed use of
+ `org-babel-examplize-region' since it would never be called
+ anyway; return value from `org-babel-exp-do-export' is never nil.
+ (org-export-blocks-preprocess): Preserve affiliated keywords when
+ replacing a code block.
+
+ * org-element.el (org-element-multiple-keywords): Allow multiple
+ caption keywords.
+
+ * ob-exp.el (org-export-blocks-preprocess): Fix block evaluation
+ when results are before the block.
+ (org-export-blocks-preprocess): Improve blank lines handling in
+ function. Add comments. Remove `org-export-blocks-postblock-hook'
+ since it's defined nowhere now (and doesn't need to, there's
+ `org-export-before-parsing-hook' already).
+
+ * org-exp-blocks.el: Delete.
+
+ * ob-exp.el (org-export-blocks-preprocess):
+ * ob-ditaa.el (org-ditaa-jar-path): Move from
+ "org-export-blocks.el".
+
+ * ob-exp.el (org-babel-exp-src-block): Remove unused argument.
+ (org-babel-exp-non-block-elements): Rewrite function using Org
+ Element.
+
+ * org-exp-blocks.el (org-export-blocks-preprocess):
+ Rewrite function using Org Element.
+
+ * org-element.el (org-element-recursive-objects)
+ (org-element-object-restrictions): Remove `macro' from recursive
+ object types.
+
+ * org.el (org-macro-initialize-templates): Small refactoring.
+ (org-mode): Initialize macros templates.
+ (org-macro-templates): New variable.
+ (org-macro-expand, org-macro-replace-all)
+ (org-macro-initialize-templates): New functions.
+
+ * org-element.el (org-element-link-type-is-file): New variable.
+ (org-element-link-parser): Extract search option and application
+ in "file"-type links.
+
+ * org.el (org-mode): Set back comment-start-skip so comment-dwin
+ can tell a keyword from a comment.
+
+2013-11-12 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ * org.el (org-time-stamp): When INACTIVE is non-nil, insert an
+ inactive timestamp also with double universal argument.
+ (org-set-regexps-and-options): Don't set font-lock defaults here.
+ (org-mode): Set font-lock defaults here.
+ (org-insert-link): Call `org-link-try-special-completion' from the
+ original buffer.
+
+2013-11-12 Oleh <oleh.krehel@gmail.com>
+
+ * 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.
+
+2013-11-12 Rasmus <rasmus@gmx.us> (tiny change)
+
+ * ox-latex.el (org-latex--inline-image): The pgf format is
+ associated to an inline image and treated like tikz files.
+
+2013-11-12 Richard Lawrence <richard.lawrence@berkeley.edu> (tiny change)
+
+ * org-agenda.el (org-cmp-ts): Avoid error when trying to
+ `string-match' against nil.
+
+2013-11-12 Rick Frankel <rick@rickster.com>
+
+ * ox-html.el (org-html-doctype): New function.
+ (org-html-template): Use `org-html-doctype' instead of inline
+ code.
+ (org-html-headline): Use the new
+ `org-html--container' function to set container element.
+ (org-html--container): Returns appropriate element for headline
+ container.
+ (org-html-divs): Extra character in doc string.
+ (org-babel-execute:sql): Unquote cmdline argument in
+ format string, dbish requires three separate arguments. Add dbi
+ to the list of engines with automatically added header separator.
+ (org-html--build-pre/postamble): Add css class to wrapper div
+ (defaults to `org-pre/postamble-class'). Move spec building to
+ separate function (`org-html-format-spec').
+ (org-html-format-spec): New function.
+ (org-pre/postamble-class): New variable.
+ (org-html--timestamp-format): New variable used in the metadata
+ and the pre/postamble.
+ (org-html-style-default): Make the preamble and postamble use the
+ same style. Make all anchors font-size %100. Remove margin from
+ the content section.
+ (org-html-container-element): Fix docstring.
+ (org-html-postamble-format, org-html-preamble-format):
+ Update docstrings.
+ (org-html-template): Use `org-html--build-pre/postamble'.
+ (org-html--build-pre/postamble): New function, combining the
+ pre/postamble generator. Merge lists of formatters from the
+ preamble and postamble. Fix bug, using :time-stamp-file instead
+ of :with-date for auto display of date: this brings usage in-line
+ with the latex and beamer exporter.
+ (org-html--build-postamble, org-html--build-postamble): Delete.
+ (define-backend): Add :html-doctype and :html-container
+ parameters.
+ (org-html-doctype): New option for doctype declaration.
+ (org-html-container-elemnt): New option for specifying the wrapper
+ container element.
+ (org-html-divs): Change to alist of three entries each containing
+ a key ('preamble, 'content, 'postamble), an HTML element type and
+ an id to allow setting container elements.
+ (org-html--build-preamble, org-html--build-postamble): Modify to
+ use `org-html-divs'.
+ (org-html-template): Modify to use doctype and container-element
+ settings.
+ (org-export-define-backend): Add css url option.
+ (org-export-htmlized-org-css-url): Modify docstring and options.
+ (org-html--build-style): Include css-url if specified.
+
+2013-11-12 Roberto Huelga Díaz <rhuelga@gmail.com> (tiny change)
+
+ * org-timer.el (org-timer-set-timer): Use the variable
+ `org-clock-sound' when calling `org-notify'.
+
+2013-11-12 Ryo TAKAISHI <ryo.takaishi.0@gmail.com>
+
+ * org-capture.el (org-capture--expand-keyword-in-embedded-elisp):
+ New function.
+ (org-capture-expand-embedded-elisp): Use the new function.
+
+ * ob-tangle.el (org-babel-tangle-collect-blocks): Change argument
+ name collid `org-babel-map-src-blocks' variable 'lang'.
+
+ * org-protocol.el (org-protocol-convert-query-to-plist):
+ New function.
+ (org-protocol-do-capture): Use new function.
+ (org-protocol-data-separator): Change default separator.
+
+2013-11-12 Rémi Vanicat <vanicat@debian.org> (tiny change)
+
+ * org-table.el (orgtbl-format-line): Fix bug when formatting line.
+
+2013-11-12 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * ox-latex.el (org-latex-listings): Don't quote const value.
+
+ * ob-C.el (org-babel-C-var-to-C): Add list support
+ (org-babel-C-val-to-C-list-type, org-babel-C-val-to-C-type)
+ (org-babel-C-format-val): New functions.
+ (org-babel-C-ensure-main-wrap, org-babel-execute:C)
+ (org-babel-execute:C++, rg-babel-execute:cpp)
+ (org-babel-C++-compiler, org-babel-C-compiler): Improve docstring.
+
+ * org-entities.el (org-entities): Add support for hbar.
+
+2013-11-12 Sacha Chua <sacha@sachachua.com> (tiny change)
+
+ * org.el (org-read-date-get-relative): Handle positive and
+ negative weekday specifications so that they don't return today.
+ If today is Friday, "fri" should mean next Friday. This changes
+ the previous behavior, which required you to specify "+2fri" in
+ order to mean next Friday if today was Friday. If you want to
+ schedule something for today, you can use ".".
+
+2013-11-12 Samuel Loury <konubinix@gmail.com> (tiny change)
+
+ * org.el (org-open-at-point): Open a plain link even if the cursor
+ is before it, which is consistent with the behavior with respect
+ to bracket and angle links.
+
+2013-11-12 Sean O'Halpin <sean.ohalpin@gmail.com> (tiny change)
+
+ * ob.el (org-babel-expand-noweb-references): Capture current noweb
+ start and end patterns then use them to set buffer locals in a
+ (with-temp-buffer ...) form.
+
+2013-11-12 Sebastien Vauban <xxx@public.gmane.org>
+
+ * ox-latex.el (org-latex-listings-langs): Update custom variable.
+
+ * ob-core.el (org-babel-parse-src-block-match): Fix order of list
+ of header arguments.
+
+ * org-clock.el (org-clock-goto-before-context): New option.
+ (org-clock-goto): Use the new option.
+ (org-clocktable-write-default): Insert the summary as a standard
+ #+CAPTION keyword for the (clock) table.
+
+2013-11-12 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> (tiny change)
+
+ * org-agenda.el (org-agenda-prefix-format): Small docstring
+ enhancement.
+
+2013-11-12 Suhail Shergill <suhailshergill@gmail.com> (tiny change)
+
+ * ob-core.el (org-babel-temp-file): For remote hosts, modify the
+ prefix and leave `temporary-file-directory' unchanged.
+
+2013-11-12 Suvayu Ali <fatkasuvayu+linux@gmail.com> (tiny change)
+
+ * org.el (org-speed-commands-default): Change default binding for
+ org-mark-subtree from "." to "@" to be more consistent with "C-c
+ @".
+
+2013-11-12 Tim Burt <tcburt@rochester.rr.com> (tiny change)
+
+ * org-datetree.el (org-datetree-find-year-create): Also match
+ headlines with tags.
+
+2013-11-12 Toby S. Cubitt <tsc25@cantab.net>
+
+ * org.el (org-time-clocksum-format)
+ (org-time-clocksum-fractional-format): In addition to a single
+ format string, the clocksum formats can now be plists specifying
+ separate formats for different time units.
+ (org-minutes-to-clocksum-string): New function to replace
+ `org-minutes-to-hh:mm-string', which converts a number of minutes
+ to a string according to the customization options.
+
+ * org-colview.el (org-columns-number-to-string): Use the new
+ `org-minutes-to-clocksum-string' function to format clocksum
+ durations.
+
+ * org-clock.el: Always call new `org-minutes-to-clocksum-string'
+ function when formatting time durations, instead of calling
+ `org-minutes-to-hh:mm-string' or passing
+ `org-time-clocksum-format' directly to format.
+
+2013-11-12 Tokuya Kameshima <kametoku@gmail.com>
+
+ * org-mew.el (org-mew-inbox-folder, org-mew-use-id-db)
+ (org-mew-subject-alist, org-mew-capture-inbox-folders)
+ (org-mew-capture-guess-alist): New options.
+ (org-mew-store-link, org-mew-open): Rewrite.
+ (org-mew-folder-name, org-mew-follow-link)
+ (org-mew-folder-eixsts-p, org-mew-get-msgnum)
+ (org-mew-open-by-message-id, org-mew-search, org-mew-capture)
+ (org-mew-capture-guess-selection-keys): New functions.
+
+2013-11-12 Trevor Murphy <trevor.m.murphy@gmail.com>
+
+ * org.el (org-get-compact-tod): Always pad minutes to two places.
+
+2013-11-12 Viktor Rosenfeld <listuser36@gmail.com> (tiny change)
+
+ * org.el (org-agenda-prepare-buffers): Add tags defined in
+ `org-tag-persistent-alist' to `org-tag-alist-for-agenda'.
+
+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
+ `yes-or-no-p' reversion message.
+
+ * ob-core.el (org-babel-where-is-src-block-head):
+ Return `point-marker' instead of `point'.
+
+2013-11-12 Yann Hodique <yann.hodique@gmail.com>
+
+ * org-publish.el (org-publish-org-to-taskjuggler): New function to
+ publish taskjuggler projects.
+
+2013-11-12 Yasushi Shoji <yashi@atmark-techno.com>
+
+ * org-clock.el (org-clock-x11idle-program-name): New option.
+ (org-x11idle-exists-p, org-x11-idle-seconds): Use it.
+
+2013-11-12 Yoshinari Nomura <nom@quickhack.net>
+
+ * ox-html.el (org-html--has-caption-p): New function.
+ (org-html-link--inline-image, org-html-table): Prepend ordinal
+ number to caption.
+ (org-html-link): Make numbered link by counting captioned figures
+ and tables.
+
+ * ox.el (org-export-dictionary): Add Japanese translations for
+ figures and tables. Add "Figure %d:" entry in the same manner
+ with "Table %d:".
+
+2013-11-12 Nicolas Richard <nrichard@ulb.ac.be>
+
+ * ob.el (org-babel-edit-distance): When insertion or deletion are
+ needed, make sure the distance is incremented. In addition, the
+ now obsolete mmin function was removed.
+
+2013-11-12 Oleh Krehel <wave@mail.ua>
+
+ * org-capture.el (org-capture-expand-embedded-elisp): Throw error
+ if result is not a string and not nil. If the result is nil,
+ treat it as if it was the empty string.
+
+ * org-clock.el (org-clock-notify-once-if-expired):
+ Honor `org-clock-sound'.
+
+2013-11-12 Rasmus Pank <rasmus.pank@gmail.com>
+
+ * org.el (org-format-latex-header): Remove eucal and amsmath.
+ (org-latex-default-packages-alist): Remove amstext and add
+ amsmath.
+
+ * ox-latex.el (org-latex-item): Use square as unchecked symbol.
+
+ * org.el (org-latex-default-packages-alist): Remove latexsym.
+
+ * org-entities.el (org-entities): Add support for ell, imath,
+ jmath, varphi, varpi, aleph, gimel, beth, dalet, cdots, S (§),
+ dag, ddag, colon, therefore, because, triangleq, leq, geq,
+ lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq, preccurlyeq,
+ succ, succeq, succurlyeq, setminus, nexist(s), mho, check, frown,
+ diamond. Changes loz, vert, checkmark, smile and tilde.
+
+ * ob-C.el: Added C++ to `org-babel-load-languages' automatically
+ after loading C.
+
+ * org-src.el (org-src-lang-modes): Add association between
+ language C++ and `c++-mode'.
+
+ * ox.el (org-export-smart-quotes-alist): Add ("da" "no" "nb"
+ "nn" "sv").
+ (org-export-dictionary): Add some entries ("da" "no" "nb" "nn"
+ "sv").
+ (org-export-default-language): Mention other variables affected by
+ language.
+
+ * ox-latex.el (org-latex-babel-language-alist): Add 'nb', 'nn',
+ and 'no' for Norwegian. Removed 'no-no'.
+ (org-latex-pdf-process): let `latexmk' be a preconfigured choice
+ and change the wording of the docstring.
+ (org-latex-guess-babel-language): Replace AUTO with language if
+ AUTO is the option of the LaTeX package Babel.
+ (org-latex-classes): Update documentation with respect
+ to `org-latex-guess-babel-language'.
+
+2013-11-12 Дядов Васил Стоянов <vdyadov@elvees.com> (tiny change)
+
+ * org-docview.el (org-docview-export): New function to export
+ docview links.
+
2013-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
* org-agenda.el (org-agenda-mode):
@@ -748,9 +7554,6 @@
(org-export-odt-schema-dir, org-odt-styles-dir): Infer the
correct directories without requiring other variables.
- * org-fixup.el (org-make-org-version, org-make-autoloads):
- Don't define `org-odt-data-dir' in org-version.el.
-
* org-loaddefs.el: New file.
* org.el ("org-loaddefs.el"): Don't throw an error if the file
@@ -891,7 +7694,7 @@
* org.el: Make `org-closest-date' aware of hours repeaters.
* org.el (org-end-of-line): Do not call `end-of-visual-line' when
- moving to the end of line. Also improve behaviour on elements that
+ moving to the end of line. Also improve behavior on elements that
can be hidden.
* org.el (org-sparse-tree): Allow to call `org-show-todo-tree'
@@ -912,7 +7715,7 @@
"29.03 16:40".
* org-element.el (org-element-center-block-parser)
- (org-element-drawer-parser, , org-element-footnote-definition-parser)
+ (org-element-drawer-parser, org-element-footnote-definition-parser)
(org-element-inlinetask-parser, org-element-plain-list-parser)
(org-element-quote-block-parser, org-element-special-block-parser)
(org-element-babel-call-parser, org-element-clock-parser)
@@ -1063,7 +7866,7 @@
* org.el (org-reload): Simplify file-re (orgtbl-*.el files do not
exist anymore). Keep org-*.el at the end of the files list.
- Explicitely load org-version.el (since it doesn't provide feature
+ Explicitly load org-version.el (since it doesn't provide feature
'org-version) at the very end, but ignore errors when it doesn't
exist. Add parameters 'full and 'message to the call of
(org-version) so that after reload the full version information is
@@ -1555,8 +8358,6 @@
* org-clock.el (org-dblock-write:clocktable)
(org-dblock-write:clocktable): Ditto.
- * org2rem.el (org2rem): Ditto.
-
* org-agenda.el (org-agenda): In sticky agendas, use the current
command's match to set the buffer name. This gives more
information to the user and allows to distinguish various agendas
@@ -2697,7 +9498,7 @@
* org-macs.el (orgstruct++-ignore-org-filling): New macro.
- * org-exp-block.el: Use `org-find-library-name' instead of
+ * org-exp-blocks.el: Use `org-find-library-name' instead of
`find-library-name'.
* org-compat.el (org-find-library-name): Convert into a macro to
@@ -2852,7 +9653,7 @@
* org.el (org-read-date): Set cursor-type to nil in the calendar.
* org-faces.el (org-date-selected): Use inverse video.
- Don't explicitely set bold to nil as it causes `customize-face' to show
+ Don't explicitly set bold to nil as it causes `customize-face' to show
the weight property and thus encourage the user to change it.
Warn in the docstring that using bold might cause problems when
displaying the calendar.
@@ -3028,7 +9829,7 @@
(org-agenda-run-series): Remove any old agenda markers in the
buffer that is going to take the new block agenda.
(org-prepare-agenda): Reset markers before erasing the buffer anc
- running `org-agenda-mode', because after that hte local variable
+ running `org-agenda-mode', because after that the local variable
`org-agenda-markers' will have gone away.
(org-agenda-Quit):
(org-finalize-agenda): Install the marker resetter into the
@@ -3572,7 +10373,7 @@
* org-clock.el (org-clock-idle-time): Org-mode assumed that
x11idle was an available command, and returned an idle time of 0
if it was not
- (never idle): Added checks so that org-idle-time will come from
+ (never idle): Add checks so that org-idle-time will come from
emacs' own current-idle-time if x11idle cannot be found or if it
cannot retrieve the idle time from X11
@@ -3933,7 +10734,7 @@
* org-agenda.el (org-agenda-skip-timestamp-if-deadline-is-shown):
Skip timestamp items in agenda view if item is already shown as a
deadline item.
- (org-agenda-skip-dealine-if-done): Pass deadline results to
+ (org-agenda-skip-deadline-if-done): Pass deadline results to
org-agenda-get-timestamps.
(org-agenda-get-timestamps): Optionally take list of deadline
results, so that timestamp results can be skipped if already
@@ -4320,11 +11121,6 @@
2012-04-01 Bastien Guerry <bzg@gnu.org>
- * org-mime.el (org-mime-htmlize):
- Set `org-export-with-LaTeX-fragments' correctly.
-
-2012-04-01 Bastien Guerry <bzg@gnu.org>
-
* org.el (org-set-tags): Don't add a column when there is only one
tag offered for completion.
@@ -5073,7 +11869,7 @@
2012-04-01 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-beginning-of-line, org-end-of-line): Fix special C-a
- and C-e behaviour with visual lines.
+ and C-e behavior with visual lines.
2012-04-01 Eric Schulte <eric.schulte@gmx.com>
@@ -5613,7 +12409,7 @@
* ob-emacs-lisp.el: A comment on the last line of an emacs-lisp
code block would cause an error when the block is was executed.
- This fix cures this behaviour.
+ This fix cures this behavior.
2012-04-01 Eric Schulte <eric.schulte@gmx.com>
@@ -6313,7 +13109,7 @@
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org.el (org-fontify-meta-lines-and-blocks-1):
- Recognize "name" as a valid keyword that can preceed a block.
+ Recognize "name" as a valid keyword that can precede a block.
2012-01-03 Eric Schulte <schulte.eric@gmail.com>
@@ -6837,7 +13633,7 @@
* ob.el (org-babel-params-from-properties): Now splits
multiple var arguments behind a single ":var".
- (org-babel-balanced-split): Separated balanced splitting of
+ (org-babel-balanced-split): Separate balanced splitting of
strings out into a new function.
(org-babel-parse-multiple-vars): Splits multiple var arguments
behind a single ":var".
@@ -7135,7 +13931,7 @@
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org-footnote.el (org-footnote-create-definition):
- Explicitely move point after tag, if it has just been
+ Explicitly move point after tag, if it has just been
inserted.
2012-01-03 Eric Schulte <schulte.eric@gmail.com>
@@ -7502,7 +14298,7 @@
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-separating-blank-lines-number):
- The behaviour of `org-back-over-empty-lines' depends on the
+ The behavior of `org-back-over-empty-lines' depends on the
associated value of `headline' in
`org-blank-before-new-entry', which is out of context in a
list.
@@ -7681,10 +14477,10 @@
(org-indent-initialize): Remove timer.
(org-indent-add-properties): Refactor code.
(org-indent-refresh-subtree, org-indent-refresh-section)
- (org-indent-refresh-buffer,org-indent-set-initial-properties):
+ (org-indent-refresh-buffer, org-indent-set-initial-properties):
Remove functions.
(org-indent-deleted-headline): New variable.
- (org-indent-notify-deleted-headline,org-indent-refresh-maybe):
+ (org-indent-notify-deleted-headline, org-indent-refresh-maybe):
New functions.
(org-indent-mode): Insert new functions into a hook.
@@ -7696,7 +14492,7 @@
section when promoting or demoting it.
(org-indent-add-properties): Rewrite function to proceed line by
line, as required by `wrap-prefix' specificity.
- (org-indent-refresh-section,org-indent-refresh-subtree): Refactor.
+ (org-indent-refresh-section, org-indent-refresh-subtree): Refactor.
(org-indent-refresh-view): New function.
(org-indent-refresh-to, org-indent-refresh-section):
Remove functions.
@@ -7844,10 +14640,6 @@
2012-01-03 Bastien Guerry <bzg@gnu.org>
- * org-mw.el (org-mw-export-lists): Fix list export.
-
-2012-01-03 Bastien Guerry <bzg@gnu.org>
-
* org-list.el (org-list-item-trim-br): New function.
(org-list-to-generic): New parameter :nobr to use the new
function.
@@ -8470,11 +15262,6 @@
2011-07-28 Bastien Guerry <bzg@gnu.org>
- * org-toc.el (org-toc-before-first-heading-p, org-toc-show)
- (org-toc-get-headlines-status): Use `org-outline-regexp-bol'.
-
-2011-07-28 Bastien Guerry <bzg@gnu.org>
-
* org.el (org-outline-regexp-bol): New defconst.
(org-outline-level, org-set-font-lock-defaults, org-cycle)
(org-overview, org-content, org-flag-drawer)
@@ -10468,7 +17255,7 @@
* org-list.el (org-list-in-valid-context-p): Rename from
`org-list-in-valid-block-p'.
- (org-at-item-p,org-list-search-generic): Use renamed function.
+ (org-at-item-p, org-list-search-generic): Use renamed function.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -10665,7 +17452,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
- * org-list.el (org-list-struct,org-in-item-p): Don't assume end of
+ * org-list.el (org-list-struct, org-in-item-p): Don't assume end of
blocks or drawers necessarily start somewhere. It it isn't the
case, treat them as normal text.
@@ -10814,7 +17601,7 @@
* org-list.el (org-list-to-generic): Set a default term for
ill-formed description lists. Do not insert newline characters
unless told to.
- (org-list-to-texinfo,org-list-to-html): Apply changes to
+ (org-list-to-texinfo, org-list-to-html): Apply changes to
`org-list-parse-liste'.
2011-07-28 Bastien Guerry <bzg@gnu.org>
@@ -11038,7 +17825,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-in-valid-block-p): New function.
- (org-at-item-p,org-list-search-generic): Use new function.
+ (org-at-item-p, org-list-search-generic): Use new function.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -11153,7 +17940,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
- * org.el (org-demote-subtree,org-promote-subtree):
+ * org.el (org-demote-subtree, org-promote-subtree):
Wrap `org-map-tree' into `org-with-limited-levels' macro, so it avoids
operating on inline tasks.
@@ -11283,11 +18070,6 @@
(org-export-html-preamble-format): Explain how to escape the
`%' character.
-2011-07-28 Bastien Guerry <bzg@gnu.org>
-
- * org-exp-bibtex.el (org-export-bibtex-preprocess):
- Use `org-export-current-backend'.
-
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
* ob.el (org-babel-read): Read string variable values wrapped in
@@ -11852,7 +18634,7 @@
function every at every line in a list. User will have to reload
Org if he change value of either `org-list-end-regexp' or
`org-empty-line-terminates-plain-lists'.
- (org-in-item-p,org-list-struct,org-list-parse-list): Apply change.
+ (org-in-item-p, org-list-struct, org-list-parse-list): Apply change.
* org-exp.el (org-export-mark-list-end)
(org-export-mark-list-properties): Apply change.
@@ -11933,7 +18715,7 @@
`org-search-backward-unenclosed'.
(org-list-search-forward): Rename from
`org-search-forward-unenclosed'.
- (org-toggle-checkbox,org-update-checkbox-count): Use new
+ (org-toggle-checkbox, org-update-checkbox-count): Use new
functions.
(org-sort-list): Using default regexp search functions as context
is not required in this case.
@@ -11960,7 +18742,7 @@
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
- * org.el (org-skip-over-state-notes,org-store-log-note): Use new
+ * org.el (org-skip-over-state-notes, org-store-log-note): Use new
accessors.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -11968,8 +18750,8 @@
* org-list.el (org-list-indent-item-generic): Remove error
messages happening before process. This belongs to interactive
functions.
- (org-indent-item,org-indent-item-tree)
- (org-outdent-item,org-outdent-item-tree): Ensure point or region
+ (org-indent-item, org-indent-item-tree)
+ (org-outdent-item, org-outdent-item-tree): Ensure point or region
is correct before computing list structure. Return an error
message otherwise.
@@ -11985,7 +18767,7 @@
text following a sub-list in the same item. See docstring for an
example of output.
(org-list-to-generic): Use new parsing function.
- (org-list-to-latex,org-list-to-html): Minor change for clearer
+ (org-list-to-latex, org-list-to-html): Minor change for clearer
export.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -12008,7 +18790,7 @@
was already the first item of the list at point.
(org-list-get-list-end): Function wasn't return value when item
was already the last item of the list at point.
- (org-list-struct-fix-box,org-update-checkbox-count): Now uses
+ (org-list-struct-fix-box, org-update-checkbox-count): Now uses
`org-list-get-children'.
2011-07-28 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -12033,7 +18815,7 @@
(org-list-exchange-items): Refactor and comment code. Now return
new struct instead of modifying it, as list sorting would
sometimes eat first item.
- (org-move-item-down,org-move-item-up): Reflect changes to
+ (org-move-item-down, org-move-item-up): Reflect changes to
`org-list-exchange-items'.
(org-insert-item): As `org-in-item-p' also computes item beginning
when applicable, reuse the result.
@@ -12610,8 +19392,8 @@
2011-07-28 Bastien Guerry <bzg@gnu.org>
- * org-agenda.el (org-agenda-repeating-timestamp-show-all): Allow
- to use a list of TODO keywords as the value of this variable.
+ * org-agenda.el (org-agenda-repeating-timestamp-show-all):
+ Allow to use a list of TODO keywords as the value of this variable.
The agenda will show repeating stamps for entries matching these TODO
keywords.
(org-agenda-get-timestamps, org-agenda-get-deadlines)
@@ -12937,21 +19719,9 @@
* ob-ref.el (org-babel-ref-parse): Allow passing empty strings
into code blocks.
-2011-07-28 David Maus <dmaus@ictsoc.de>
-
- * test-org-table.el
- (test-org-table/org-table-convert-refs-to-rc/3)
- (test-org-table/org-table-convert-refs-to-rc/2)
- (test-org-table/org-table-convert-refs-to-rc/1)
- (test-org-table/org-table-convert-refs-to-an/3)
- (test-org-table/org-table-convert-refs-to-an/2)
- (test-org-table/org-table-convert-refs-to-an/1): Provide tests for
- table formular format conversion.
-
2011-07-28 Carsten Dominik <carsten.dominik@gmail.com>
- * org.el (org-sort-entries): Fix sorting with a bold emphasis at
- bol.
+ * org.el (org-sort-entries): Fix sorting with a bold emphasis at bol.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
@@ -14654,7 +21424,7 @@
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
- * ob-exp.el (org-babel-exp-results): Replaced old function call.
+ * ob-exp.el (org-babel-exp-results): Replace old function call.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
@@ -14847,7 +21617,7 @@
2010-11-11 Noorul Islam <noorul@noorul.com>
- * org-latex.el (org-export-latex-links): Replaced hard coded
+ * org-latex.el (org-export-latex-links): Replace hard coded
hyperref format with custom variable
`org-export-latex-hyperref-format'.
@@ -15535,7 +22305,7 @@
2010-11-11 aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local>
* org-archive.el (org-get-local-archive-location):
- Use `org-carchive-location' as default.
+ Use `org-archive-location' as default.
2010-11-11 Eric Schulte <schulte.eric@gmail.com>
@@ -15933,7 +22703,7 @@
2010-11-11 Nicolas Goaziou <n.goaziou@gmail.com>
- * org-list.el : Removed unused variable
+ * org-list.el: Removed unused variable
`org-suppress-item-indentation'.
* org-list.el (org-renumber-ordered-list): Skip item if bullet
@@ -18631,7 +25401,7 @@
(org-ascii-replace-entities): New function.
2010-04-10 Carsten Dominik <carsten.dominik@gmail.com>
- Ulf Stegemann <ulf@zeitform.de>
+ Ulf Stegemann <ulf@zeitform.de>
* org-entities.el: New file.
@@ -26063,7 +32833,7 @@
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2008-2013 Free Software Foundation, Inc.
+ Copyright (C) 2008-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 42a98de8c05..733f74c1a42 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -1,6 +1,6 @@
;;; ob-C.el --- org-babel functions for C and similar languages
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -30,8 +30,9 @@
;; - not much in the way of error feedback
;;; Code:
+(eval-when-compile
+ (require 'cl))
(require 'ob)
-(require 'ob-eval)
(require 'cc-mode)
(declare-function org-entry-get "org"
@@ -45,24 +46,24 @@
(defvar org-babel-C-compiler "gcc"
"Command used to compile a C source code file into an
- executable.")
+executable.")
(defvar org-babel-C++-compiler "g++"
"Command used to compile a C++ source code file into an
- executable.")
+executable.")
(defvar org-babel-c-variant nil
"Internal variable used to hold which type of C (e.g. C or C++)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
- "Execute BODY according to PARAMS. This function calls
-`org-babel-execute:C++'."
+ "Execute BODY according to PARAMS.
+This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-execute:C++ (body params)
- "Execute a block of C++ code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C++ code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
@@ -71,8 +72,8 @@ header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
(defun org-babel-execute:C (body params)
- "Execute a block of C code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params)
@@ -104,20 +105,21 @@ or `org-babel-execute:C++'."
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) ""))))
- ((lambda (results)
- (org-babel-reassemble-table
- (if (member "vector" (cdr (assoc :result-params params)))
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file))
- (org-babel-read results))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (let ((results
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
+ ))
(defun org-babel-C-expand (body params)
"Expand a block of C or C++ code with org-babel according to
@@ -147,10 +149,10 @@ it's header arguments."
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
- "Wrap body in a \"main\" function call if none exists."
+ "Wrap BODY in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
- (format "int main() {\n%s\nreturn(0);\n}\n" body)))
+ (format "int main() {\n%s\nreturn 0;\n}\n" body)))
(defun org-babel-prep-session:C (session params)
"This function does nothing as C is a compiled language with no
@@ -164,6 +166,59 @@ support for sessions"
;; helper functions
+(defun org-babel-C-format-val (type val)
+ "Handle the FORMAT part of TYPE with the data from VAL."
+ (let ((format-data (cadr type)))
+ (if (stringp format-data)
+ (cons "" (format format-data val))
+ (funcall format-data val))))
+
+(defun org-babel-C-val-to-C-type (val)
+ "Determine the type of VAL.
+Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
+FORMAT can be either a format string or a function which is called with VAL."
+ (cond
+ ((integerp val) '("int" "%d"))
+ ((floatp val) '("double" "%f"))
+ ((or (listp val) (vectorp val))
+ (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
+ (list (car type)
+ (lambda (val)
+ (cons
+ (format "[%d]%s"
+ (length val)
+ (car (org-babel-C-format-val type (elt val 0))))
+ (concat "{ "
+ (mapconcat (lambda (v)
+ (cdr (org-babel-C-format-val type v)))
+ val
+ ", ")
+ " }"))))))
+ (t ;; treat unknown types as string
+ '("char" (lambda (val)
+ (let ((s (format "%s" val))) ;; convert to string for unknown types
+ (cons (format "[%d]" (1+ (length s)))
+ (concat "\"" s "\""))))))))
+
+(defun org-babel-C-val-to-C-list-type (val)
+ "Determine the C array type of a VAL."
+ (let (type)
+ (mapc
+ #'(lambda (i)
+ (let* ((tmp-type (org-babel-C-val-to-C-type i))
+ (type-name (car type))
+ (tmp-type-name (car tmp-type)))
+ (when (and type (not (string= type-name tmp-type-name)))
+ (if (and (member type-name '("int" "double" "int32_t"))
+ (member tmp-type-name '("int" "double" "int32_t")))
+ (setq tmp-type '("double" "" "%f"))
+ (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
+ type-name
+ tmp-type-name)))
+ (setq type tmp-type)))
+ val)
+ type))
+
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
@@ -174,22 +229,17 @@ of the same value."
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
- (cond
- ((integerp val)
- (format "int %S = %S;" var val))
- ((floatp val)
- (format "double %S = %S;" var val))
- ((or (integerp val))
- (format "char %S = '%S';" var val))
- ((stringp val)
- (format "char %S[%d] = \"%s\";"
- var (+ 1 (length val)) val))
- (t
- (format "u32 %S = %S;" var val)))))
-
+ (let* ((type-data (org-babel-C-val-to-C-type val))
+ (type (car type-data))
+ (formated (org-babel-C-format-val type-data val))
+ (suffix (car formated))
+ (data (cdr formated)))
+ (format "%s %s%s = %s;"
+ type
+ var
+ suffix
+ data))))
(provide 'ob-C)
-
-
;;; ob-C.el ends here
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 562f37d7b95..5bae9130c07 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -1,6 +1,6 @@
;;; ob-R.el --- org-babel functions for R code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Dan Davison
@@ -28,9 +28,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function orgtbl-to-tsv "org-table" (table params))
@@ -88,16 +85,22 @@
(or graphics-file (org-babel-R-graphical-output-file params))))
(mapconcat
#'identity
- ((lambda (inside)
- (if graphics-file
- (append
- (list (org-babel-R-construct-graphics-device-call
- graphics-file params))
- inside
- (list "dev.off()"))
- inside))
- (append (org-babel-variable-assignments:R params)
- (list body))) "\n")))
+ (let ((inside
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))))
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "dev.off()"))
+ inside))
+ "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
@@ -170,12 +173,11 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let ((max (apply #'max (mapcar #'length (org-remove-if-not
- #'sequencep value))))
- (min (apply #'min (mapcar #'length (org-remove-if-not
- #'sequencep value))))
- (transition-file (org-babel-temp-file "R-import-")))
- ;; ensure VALUE has an orgtbl structure (depth of at least 2)
+ (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value)))
+ (max (if lengths (apply 'max lengths) 0))
+ (min (if lengths (apply 'min lengths) 0))
+ (transition-file (org-babel-temp-file "R-import-")))
+ ;; Ensure VALUE has an orgtbl structure (depth of at least 2).
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert
@@ -212,6 +214,9 @@ This function is called by `org-babel-execute-src-block'."
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
+ (when (get-buffer session)
+ ;; Session buffer exists, but with dead process
+ (set-buffer session))
(require 'ess) (R)
(rename-buffer
(if (bufferp session)
@@ -234,31 +239,40 @@ current code buffer."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
+(defvar org-babel-R-graphics-devices
+ '((:bmp "bmp" "filename")
+ (:jpg "jpeg" "filename")
+ (:jpeg "jpeg" "filename")
+ (:tikz "tikz" "file")
+ (:tiff "tiff" "filename")
+ (:png "png" "filename")
+ (:svg "svg" "file")
+ (:pdf "pdf" "file")
+ (:ps "postscript" "file")
+ (:postscript "postscript" "file"))
+ "An alist mapping graphics file types to R functions.
+
+Each member of this list is a list with three members:
+1. the file extension of the graphics file, as an elisp :keyword
+2. the R graphics device function to call to generate such a file
+3. the name of the argument to this function which specifies the
+ file to write to (typically \"file\" or \"filename\")")
+
(defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device."
- (let ((devices
- '((:bmp . "bmp")
- (:jpg . "jpeg")
- (:jpeg . "jpeg")
- (:tex . "tikz")
- (:tiff . "tiff")
- (:png . "png")
- (:svg . "svg")
- (:pdf . "pdf")
- (:ps . "postscript")
- (:postscript . "postscript")))
- (allowed-args '(:width :height :bg :units :pointsize
- :antialias :quality :compression :res
- :type :family :title :fonts :version
- :paper :encoding :pagecentre :colormodel
- :useDingbats :horizontal))
- (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
- (match-string 1 out-file)))
- (extra-args (cdr (assq :R-dev-args params))) filearg args)
- (setq device (or (and device (cdr (assq (intern (concat ":" device))
- devices))) "png"))
- (setq filearg
- (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename"))
+ (let* ((allowed-args '(:width :height :bg :units :pointsize
+ :antialias :quality :compression :res
+ :type :family :title :fonts :version
+ :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
+ (match-string 1 out-file)))
+ (device-info (or (assq (intern (concat ":" device))
+ org-babel-R-graphics-devices)
+ (assq :png org-babel-R-graphics-devices)))
+ (extra-args (cdr (assq :R-dev-args params))) filearg args)
+ (setq device (nth 1 device-info))
+ (setq filearg (nth 2 device-info))
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
@@ -302,15 +316,16 @@ last statement in BODY, as elisp."
(format "{function ()\n{\n%s\n}}()" body)
(org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params))
- (with-temp-buffer
- (insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
+(defvar ess-eval-visibly-p)
+
(defun org-babel-R-evaluate-session
(session body result-type result-params column-names-p row-names-p)
"Evaluate BODY in SESSION.
@@ -335,11 +350,10 @@ last statement in BODY, as elisp."
"FALSE")
".Last.value" (org-babel-process-file-name tmp-file 'noquote)))
(org-babel-R-process-value-result
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params))
- (with-temp-buffer
- (insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output
diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el
index 4ea68df9a95..9782cf909bf 100644
--- a/lisp/org/ob-asymptote.el
+++ b/lisp/org/ob-asymptote.el
@@ -1,6 +1,6 @@
;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index 12d625acf2c..d17049a1df1 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -1,6 +1,6 @@
;;; ob-awk.el --- org-babel functions for awk evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -32,7 +32,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(require 'org-compat)
(eval-when-compile (require 'cl))
@@ -45,7 +44,7 @@
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
-(defun org-babel-expand-body:awk (body params &optional processed-params)
+(defun org-babel-expand-body:awk (body params)
"Expand BODY according to PARAMS, return the expanded body."
(dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
(setf body (replace-regexp-in-string
@@ -60,36 +59,33 @@ called by `org-babel-execute-src-block'"
(cmd-line (cdr (assoc :cmd-line params)))
(in-file (cdr (assoc :in-file params)))
(full-body (org-babel-expand-body:awk body params))
- (code-file ((lambda (file) (with-temp-file file (insert full-body)) file)
- (org-babel-temp-file "awk-")))
- (stdin ((lambda (stdin)
+ (code-file (let ((file (org-babel-temp-file "awk-")))
+ (with-temp-file file (insert full-body)) file))
+ (stdin (let ((stdin (cdr (assoc :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
- tmp)))
- (cdr (assoc :stdin params))))
+ tmp))))
(cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
"-f" code-file
cmd-line
in-file))
" ")))
(org-babel-reassemble-table
- ((lambda (results)
- (when results
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- results
- (let ((tmp (org-babel-temp-file "awk-results-")))
- (with-temp-file tmp (insert results))
- (org-babel-import-elisp-from-file tmp)))))
- (cond
- (stdin (with-temp-buffer
- (call-process-shell-command cmd stdin (current-buffer))
- (buffer-string)))
- (t (org-babel-eval cmd ""))))
+ (let ((results
+ (cond
+ (stdin (with-temp-buffer
+ (call-process-shell-command cmd stdin (current-buffer))
+ (buffer-string)))
+ (t (org-babel-eval cmd "")))))
+ (when results
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp (org-babel-temp-file "awk-results-")))
+ (with-temp-file tmp (insert results))
+ (org-babel-import-elisp-from-file tmp)))))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index a8e53c01b13..5dec244a1e5 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -1,6 +1,6 @@
;;; ob-calc.el --- org-babel functions for calc code evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -31,7 +31,6 @@
(unless (featurep 'xemacs)
(require 'calc-trail)
(require 'calc-store))
-(eval-when-compile (require 'ob-comint))
(declare-function calc-store-into "calc-store" (&optional var))
(declare-function calc-recall "calc-store" (&optional var))
@@ -43,13 +42,15 @@
(defun org-babel-expand-body:calc (body params)
"Expand BODY according to PARAMS, return the expanded body." body)
+(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc
+
(defun org-babel-execute:calc (body params)
"Execute a block of calc code with Babel."
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (var-syms (mapcar #'car vars))
- (var-names (mapcar #'symbol-name var-syms)))
+ (org--var-syms (mapcar #'car vars))
+ (var-names (mapcar #'symbol-name org--var-syms)))
(mapc
(lambda (pair)
(calc-push-list (list (cdr pair)))
@@ -67,33 +68,32 @@
;; complex expression
(t
(calc-push-list
- (list ((lambda (res)
- (cond
- ((numberp res) res)
- ((math-read-number res) (math-read-number res))
- ((listp res) (error "Calc error \"%s\" on input \"%s\""
- (cadr res) line))
- (t (replace-regexp-in-string
- "'" ""
- (calc-eval
- (math-evaluate-expr
- ;; resolve user variables, calc built in
- ;; variables are handled automatically
- ;; upstream by calc
- (mapcar #'org-babel-calc-maybe-resolve-var
- ;; parse line into calc objects
- (car (math-read-exprs line)))))))))
- (calc-eval line))))))))
+ (list (let ((res (calc-eval line)))
+ (cond
+ ((numberp res) res)
+ ((math-read-number res) (math-read-number res))
+ ((listp res) (error "Calc error \"%s\" on input \"%s\""
+ (cadr res) line))
+ (t (replace-regexp-in-string
+ "'" ""
+ (calc-eval
+ (math-evaluate-expr
+ ;; resolve user variables, calc built in
+ ;; variables are handled automatically
+ ;; upstream by calc
+ (mapcar #'org-babel-calc-maybe-resolve-var
+ ;; parse line into calc objects
+ (car (math-read-exprs line)))))))))
+ ))))))
(mapcar #'org-babel-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
(with-current-buffer (get-buffer "*Calculator*")
(calc-eval (calc-top 1)))))
-(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc
(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
- (if (and (equal 'var (car el)) (member (cadr el) var-syms))
+ (if (and (equal 'var (car el)) (member (cadr el) org--var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index b020498eb15..dd730a29822 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -1,6 +1,6 @@
;;; ob-clojure.el --- org-babel functions for clojure evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Joel Boehland
;; Eric Schulte
@@ -24,17 +24,17 @@
;;; Commentary:
-;;; support for evaluating clojure code, relies on slime for all eval
+;; Support for evaluating clojure code, relies on slime for all eval.
;;; Requirements:
-;;; - clojure (at least 1.2.0)
-;;; - clojure-mode
-;;; - slime
+;; - clojure (at least 1.2.0)
+;; - clojure-mode
+;; - slime
-;;; By far, the best way to install these components is by following
-;;; the directions as set out by Phil Hagelberg (Technomancy) on the
-;;; web page: http://technomancy.us/126
+;; By far, the best way to install these components is by following
+;; the directions as set out by Phil Hagelberg (Technomancy) on the
+;; web page: http://technomancy.us/126
;;; Code:
(require 'ob)
@@ -77,17 +77,16 @@
(require 'slime)
(with-temp-buffer
(insert (org-babel-expand-body:clojure body params))
- ((lambda (result)
- (let ((result-params (cdr (assoc :result-params params))))
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params))
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params))))))
+ (let ((result
+ (slime-eval
+ `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties (point-min) (point-max)))
+ (cdr (assoc :package params)))))
+ (let ((result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ result
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))))
(provide 'ob-clojure)
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 5ea3be2d5b6..bc6ee780811 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -1,6 +1,6 @@
;;; ob-comint.el --- org-babel functions for interaction with comint buffers
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
@@ -30,7 +30,7 @@
;; org-babel at large.
;;; Code:
-(require 'ob)
+(require 'ob-core)
(require 'org-compat)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -117,7 +117,7 @@ or user `keyboard-quit' during execution of body."
string-buffer))
(setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
-(def-edebug-spec org-babel-comint-with-output (form body))
+(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
new file mode 100644
index 00000000000..11cd2530dd7
--- /dev/null
+++ b/lisp/org/ob-core.el
@@ -0,0 +1,2775 @@
+;;; ob-core.el --- working with code blocks in org-mode
+
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+
+;; Authors: Eric Schulte
+;; Dan Davison
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(eval-when-compile
+ (require 'cl))
+(require 'ob-eval)
+(require 'org-macs)
+(require 'org-compat)
+
+(defconst org-babel-exeext
+ (if (memq system-type '(windows-nt cygwin))
+ ".exe"
+ nil))
+;; dynamically scoped for tramp
+(defvar org-babel-call-process-region-original nil)
+(defvar org-src-lang-modes)
+(defvar org-babel-library-of-babel)
+(declare-function show-all "outline" ())
+(declare-function org-every "org" (pred seq))
+(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
+(declare-function org-mark-ring-push "org" (&optional pos buffer))
+(declare-function tramp-compat-make-temp-file "tramp-compat"
+ (filename &optional dir-flag))
+(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
+(declare-function tramp-file-name-user "tramp" (vec))
+(declare-function tramp-file-name-host "tramp" (vec))
+(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-edit-src-code "org-src"
+ (&optional context code edit-buffer-name quietp))
+(declare-function org-edit-src-exit "org-src" (&optional context))
+(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
+(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body))
+(declare-function org-outline-overlay-data "org" (&optional use-markers))
+(declare-function org-set-outline-overlay-data "org" (data))
+(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+(declare-function org-make-options-regexp "org" (kwds &optional extra))
+(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-next-block "org" (arg &optional backward block-regexp))
+(declare-function org-previous-block "org" (arg &optional block-regexp))
+(declare-function org-show-context "org" (&optional key))
+(declare-function org-at-table-p "org" (&optional table-type))
+(declare-function org-cycle "org" (&optional arg))
+(declare-function org-uniquify "org" (list))
+(declare-function org-current-level "org" ())
+(declare-function org-table-import "org-table" (file arg))
+(declare-function org-add-hook "org-compat"
+ (hook function &optional append local))
+(declare-function org-table-align "org-table" ())
+(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function orgtbl-to-generic "org-table" (table params))
+(declare-function orgtbl-to-orgtbl "org-table" (table params))
+(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
+(declare-function org-babel-lob-get-info "ob-lob" nil)
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-babel-ref-parse "ob-ref" (assignment))
+(declare-function org-babel-ref-resolve "ob-ref" (ref))
+(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
+(declare-function org-babel-ref-headline-body "ob-ref" ())
+(declare-function org-babel-lob-execute-maybe "ob-lob" ())
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-at-item-p "org-list" ())
+(declare-function org-list-parse-list "org-list" (&optional delete))
+(declare-function org-list-to-generic "org-list" (LIST PARAMS))
+(declare-function org-list-struct "org-list" ())
+(declare-function org-list-prevs-alist "org-list" (struct))
+(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-escape-code-in-region "org-src" (beg end))
+(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-table-to-lisp "org-table" (&optional txt))
+(declare-function org-reverse-string "org" (string))
+(declare-function org-element-context "org-element" (&optional ELEMENT))
+
+(defgroup org-babel nil
+ "Code block evaluation and management in `org-mode' documents."
+ :tag "Babel"
+ :group 'org)
+
+(defcustom org-confirm-babel-evaluate t
+ "Confirm before evaluation.
+Require confirmation before interactively evaluating code
+blocks in Org-mode buffers. The default value of this variable
+is t, meaning confirmation is required for any code block
+evaluation. This variable can be set to nil to inhibit any
+future confirmation requests. This variable can also be set to a
+function which takes two arguments the language of the code block
+and the body of the code block. Such a function should then
+return a non-nil value if the user should be prompted for
+execution or nil if no prompt is required.
+
+Warning: Disabling confirmation may result in accidental
+evaluation of potentially harmful code. It may be advisable
+remove code block execution from C-c C-c as further protection
+against accidental code block evaluation. The
+`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
+remove code block execution from the C-c C-c keybinding."
+ :group 'org-babel
+ :version "24.1"
+ :type '(choice boolean function))
+;; don't allow this variable to be changed through file settings
+(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
+
+(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
+ "Remove code block evaluation from the C-c C-c key binding."
+ :group 'org-babel
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-babel-results-keyword "RESULTS"
+ "Keyword used to name results generated by code blocks.
+Should be either RESULTS or NAME however any capitalization may
+be used."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-noweb-wrap-start "<<"
+ "String used to begin a noweb reference in a code block.
+See also `org-babel-noweb-wrap-end'."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-noweb-wrap-end ">>"
+ "String used to end a noweb reference in a code block.
+See also `org-babel-noweb-wrap-start'."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-inline-result-wrap "=%s="
+ "Format string used to wrap inline results.
+This string must include a \"%s\" which will be replaced by the results."
+ :group 'org-babel
+ :type 'string)
+
+(defun org-babel-noweb-wrap (&optional regexp)
+ (concat org-babel-noweb-wrap-start
+ (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
+ org-babel-noweb-wrap-end))
+
+(defvar org-babel-src-name-regexp
+ "^[ \t]*#\\+name:[ \t]*"
+ "Regular expression used to match a source name line.")
+
+(defvar org-babel-multi-line-header-regexp
+ "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
+ "Regular expression used to match multi-line header arguments.")
+
+(defvar org-babel-src-name-w-name-regexp
+ (concat org-babel-src-name-regexp
+ "\\("
+ org-babel-multi-line-header-regexp
+ "\\)*"
+ "\\([^ ()\f\t\n\r\v]+\\)")
+ "Regular expression matching source name lines with a name.")
+
+(defvar org-babel-src-block-regexp
+ (concat
+ ;; (1) indentation (2) lang
+ "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
+ ;; (3) switches
+ "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
+ ;; (4) header arguments
+ "\\([^\n]*\\)\n"
+ ;; (5) body
+ "\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
+ "Regexp used to identify code blocks.")
+
+(defvar org-babel-inline-src-block-regexp
+ (concat
+ ;; (1) replacement target (2) lang
+ "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
+ ;; (3,4) (unused, headers)
+ "\\(\\|\\[\\(.*?\\)\\]\\)"
+ ;; (5) body
+ "{\\([^\f\n\r\v]+?\\)}\\)")
+ "Regexp used to identify inline src-blocks.")
+
+(defun org-babel-get-header (params key &optional others)
+ "Select only header argument of type KEY from a list.
+Optional argument OTHERS indicates that only the header that do
+not match KEY should be returned."
+ (delq nil
+ (mapcar
+ (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
+ params)))
+
+(defun org-babel-get-inline-src-block-matches()
+ "Set match data if within body of an inline source block.
+Returns non-nil if match-data set"
+ (let ((src-at-0-p (save-excursion
+ (beginning-of-line 1)
+ (string= "src" (thing-at-point 'word))))
+ (first-line-p (= (line-beginning-position) (point-min)))
+ (orig (point)))
+ (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
+ (first-line-p "[[:punct:] \t]src_")
+ (t "[[:punct:] \f\t\n\r\v]src_")))
+ (lower-limit (if first-line-p
+ nil
+ (- (point-at-bol) 1))))
+ (save-excursion
+ (when (or (and src-at-0-p (bobp))
+ (and (re-search-forward "}" (point-at-eol) t)
+ (re-search-backward search-for lower-limit t)
+ (> orig (point))))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ t ))))))
+
+(defvar org-babel-inline-lob-one-liner-regexp)
+(defun org-babel-get-lob-one-liner-matches()
+ "Set match data if on line of an lob one liner.
+Returns non-nil if match-data set"
+ (save-excursion
+ (unless (= (point) (point-at-bol)) ;; move before inline block
+ (re-search-backward "[ \f\t\n\r\v]" nil t))
+ (if (looking-at org-babel-inline-lob-one-liner-regexp)
+ t
+ nil)))
+
+(defun org-babel-get-src-block-info (&optional light)
+ "Get information on the current source block.
+
+Optional argument LIGHT does not resolve remote variable
+references; a process which could likely result in the execution
+of other code blocks.
+
+Returns a list
+ (language body header-arguments-alist switches name indent block-head)."
+ (let ((case-fold-search t) head info name indent)
+ ;; full code block
+ (if (setq head (org-babel-where-is-src-block-head))
+ (save-excursion
+ (goto-char head)
+ (setq info (org-babel-parse-src-block-match))
+ (setq indent (car (last info)))
+ (setq info (butlast info))
+ (while (and (forward-line -1)
+ (looking-at org-babel-multi-line-header-regexp))
+ (setf (nth 2 info)
+ (org-babel-merge-params
+ (nth 2 info)
+ (org-babel-parse-header-arguments (match-string 1)))))
+ (when (looking-at org-babel-src-name-w-name-regexp)
+ (setq name (org-no-properties (match-string 3)))))
+ ;; inline source block
+ (when (org-babel-get-inline-src-block-matches)
+ (setq info (org-babel-parse-inline-src-block-match))))
+ ;; resolve variable references and add summary parameters
+ (when (and info (not light))
+ (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
+ (when info (append info (list name indent head)))))
+
+(defvar org-current-export-file) ; dynamically bound
+(defmacro org-babel-check-confirm-evaluate (info &rest body)
+ "Evaluate BODY with special execution confirmation variables set.
+
+Specifically; NOEVAL will indicate if evaluation is allowed,
+QUERY will indicate if a user query is required, CODE-BLOCK will
+hold the language of the code block, and BLOCK-NAME will hold the
+name of the code block."
+ (declare (indent defun))
+ (org-with-gensyms
+ (lang block-body headers name eval eval-no export eval-no-export)
+ `(let* ((,lang (nth 0 ,info))
+ (,block-body (nth 1 ,info))
+ (,headers (nth 2 ,info))
+ (,name (nth 4 ,info))
+ (,eval (or (cdr (assoc :eval ,headers))
+ (when (assoc :noeval ,headers) "no")))
+ (,eval-no (or (equal ,eval "no")
+ (equal ,eval "never")))
+ (,export (org-bound-and-true-p org-current-export-file))
+ (,eval-no-export (and ,export (or (equal ,eval "no-export")
+ (equal ,eval "never-export"))))
+ (noeval (or ,eval-no ,eval-no-export))
+ (query (or (equal ,eval "query")
+ (and ,export (equal ,eval "query-export"))
+ (if (functionp org-confirm-babel-evaluate)
+ (funcall org-confirm-babel-evaluate
+ ,lang ,block-body)
+ org-confirm-babel-evaluate)))
+ (code-block (if ,info (format " %s " ,lang) " "))
+ (block-name (if ,name (format " (%s) " ,name) " ")))
+ ,@body)))
+
+(defsubst org-babel-check-evaluate (info)
+ "Check if code block INFO should be evaluated.
+Do not query the user."
+ (org-babel-check-confirm-evaluate info
+ (not (when noeval
+ (message "Evaluation of this%scode-block%sis disabled."
+ code-block block-name)))))
+
+ ;; dynamically scoped for asynchronous export
+(defvar org-babel-confirm-evaluate-answer-no)
+
+(defsubst org-babel-confirm-evaluate (info)
+ "Confirm evaluation of the code block INFO.
+
+If the variable `org-babel-confirm-evaluate-answer-no' is bound
+to a non-nil value, auto-answer with \"no\".
+
+This query can also be suppressed by setting the value of
+`org-confirm-babel-evaluate' to nil, in which case all future
+interactive code block evaluations will proceed without any
+confirmation from the user.
+
+Note disabling confirmation may result in accidental evaluation
+of potentially harmful code."
+ (org-babel-check-confirm-evaluate info
+ (not (when query
+ (unless
+ (and (not (org-bound-and-true-p
+ org-babel-confirm-evaluate-answer-no))
+ (yes-or-no-p
+ (format "Evaluate this%scode block%son your system? "
+ code-block block-name)))
+ (message "Evaluation of this%scode-block%sis aborted."
+ code-block block-name))))))
+
+;;;###autoload
+(defun org-babel-execute-safely-maybe ()
+ (unless org-babel-no-eval-on-ctrl-c-ctrl-c
+ (org-babel-execute-maybe)))
+
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
+
+;;;###autoload
+(defun org-babel-execute-maybe ()
+ (interactive)
+ (or (org-babel-execute-src-block-maybe)
+ (org-babel-lob-execute-maybe)))
+
+(defmacro org-babel-when-in-src-block (&rest body)
+ "Execute BODY if point is in a source block and return t.
+
+Otherwise do nothing and return nil."
+ `(if (or (org-babel-where-is-src-block-head)
+ (org-babel-get-inline-src-block-matches))
+ (progn
+ ,@body
+ t)
+ nil))
+
+(defun org-babel-execute-src-block-maybe ()
+ "Conditionally execute a source block.
+Detect if this is context for a Babel src-block and if so
+then run `org-babel-execute-src-block'."
+ (interactive)
+ (org-babel-when-in-src-block
+ (org-babel-eval-wipe-error-buffer)
+ (org-babel-execute-src-block current-prefix-arg)))
+
+;;;###autoload
+(defun org-babel-view-src-block-info ()
+ "Display information on the current source block.
+This includes header arguments, language and name, and is largely
+a window into the `org-babel-get-src-block-info' function."
+ (interactive)
+ (let ((info (org-babel-get-src-block-info 'light))
+ (full (lambda (it) (> (length it) 0)))
+ (printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
+ (when info
+ (with-help-window (help-buffer)
+ (let ((name (nth 4 info))
+ (lang (nth 0 info))
+ (switches (nth 3 info))
+ (header-args (nth 2 info)))
+ (when name (funcall printf "Name: %s\n" name))
+ (when lang (funcall printf "Lang: %s\n" lang))
+ (when (funcall full switches) (funcall printf "Switches: %s\n" switches))
+ (funcall printf "Header Arguments:\n")
+ (dolist (pair (sort header-args
+ (lambda (a b) (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+ (when (funcall full (cdr pair))
+ (funcall printf "\t%S%s\t%s\n"
+ (car pair)
+ (if (> (length (format "%S" (car pair))) 7) "" "\t")
+ (cdr pair)))))))))
+
+;;;###autoload
+(defun org-babel-expand-src-block-maybe ()
+ "Conditionally expand a source block.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-expand-src-block'."
+ (interactive)
+ (org-babel-when-in-src-block
+ (org-babel-expand-src-block current-prefix-arg)))
+
+;;;###autoload
+(defun org-babel-load-in-session-maybe ()
+ "Conditionally load a source block in a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-load-in-session'."
+ (interactive)
+ (org-babel-when-in-src-block
+ (org-babel-load-in-session current-prefix-arg)))
+
+(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
+
+;;;###autoload
+(defun org-babel-pop-to-session-maybe ()
+ "Conditionally pop to a session.
+Detect if this is context for a org-babel src-block and if so
+then run `org-babel-switch-to-session'."
+ (interactive)
+ (org-babel-when-in-src-block
+ (org-babel-switch-to-session current-prefix-arg)))
+
+(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
+
+(defconst org-babel-common-header-args-w-values
+ '((cache . ((no yes)))
+ (cmdline . :any)
+ (colnames . ((nil no yes)))
+ (comments . ((no link yes org both noweb)))
+ (dir . :any)
+ (eval . ((never query)))
+ (exports . ((code results both none)))
+ (epilogue . :any)
+ (file . :any)
+ (file-desc . :any)
+ (hlines . ((no yes)))
+ (mkdirp . ((yes no)))
+ (no-expand)
+ (noeval)
+ (noweb . ((yes no tangle no-export strip-export)))
+ (noweb-ref . :any)
+ (noweb-sep . :any)
+ (padline . ((yes no)))
+ (post . :any)
+ (prologue . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw html latex org code pp drawer)
+ (replace silent none append prepend)
+ (output value)))
+ (rownames . ((no yes)))
+ (sep . :any)
+ (session . :any)
+ (shebang . :any)
+ (tangle . ((tangle yes no :any)))
+ (tangle-mode . ((#o755 #o555 #o444 :any)))
+ (var . :any)
+ (wrap . :any)))
+
+(defconst org-babel-header-arg-names
+ (mapcar #'car org-babel-common-header-args-w-values)
+ "Common header arguments used by org-babel.
+Note that individual languages may define their own language
+specific header arguments as well.")
+
+(defvar org-babel-default-header-args
+ '((:session . "none") (:results . "replace") (:exports . "code")
+ (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
+ "Default arguments to use when evaluating a source block.")
+
+(defvar org-babel-default-inline-header-args
+ '((:session . "none") (:results . "replace") (:exports . "results"))
+ "Default arguments to use when evaluating an inline source block.")
+
+(defvar org-babel-data-names '("tblname" "results" "name"))
+
+(defvar org-babel-result-regexp
+ (concat "^[ \t]*#\\+"
+ (regexp-opt org-babel-data-names t)
+ "\\(\\[\\("
+ ;; FIXME The string below is `org-ts-regexp'
+ "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
+ " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
+ "Regular expression used to match result lines.
+If the results are associated with a hash key then the hash will
+be saved in the second match data.")
+
+(defvar org-babel-result-w-name-regexp
+ (concat org-babel-result-regexp
+ "\\([^ ()\f\t\n\r\v]+\\)\\((\\(.*\\))\\|\\)"))
+
+(defvar org-babel-min-lines-for-block-output 10
+ "The minimum number of lines for block output.
+If number of lines of output is equal to or exceeds this
+value, the output is placed in a #+begin_example...#+end_example
+block. Otherwise the output is marked as literal by inserting
+colons at the starts of the lines. This variable only takes
+effect if the :results output option is in effect.")
+
+(defvar org-babel-noweb-error-langs nil
+ "Languages for which Babel will raise literate programming errors.
+List of languages for which errors should be raised when the
+source code block satisfying a noweb reference in this language
+can not be resolved.")
+
+(defvar org-babel-hash-show 4
+ "Number of initial characters to show of a hidden results hash.")
+
+(defvar org-babel-hash-show-time nil
+ "Non-nil means show the time the code block was evaluated in the result hash.")
+
+(defvar org-babel-after-execute-hook nil
+ "Hook for functions to be called after `org-babel-execute-src-block'")
+
+(defun org-babel-named-src-block-regexp-for-name (name)
+ "This generates a regexp used to match a src block named NAME."
+ (concat org-babel-src-name-regexp (regexp-quote name)
+ "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
+ (substring org-babel-src-block-regexp 1)))
+
+(defun org-babel-named-data-regexp-for-name (name)
+ "This generates a regexp used to match data named NAME."
+ (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
+
+;;; functions
+(defvar call-process-region)
+(defvar org-babel-current-src-block-location nil
+ "Marker pointing to the src block currently being executed.
+This may also point to a call line or an inline code block. If
+multiple blocks are being executed (e.g., in chained execution
+through use of the :var header argument) this marker points to
+the outer-most code block.")
+
+;;;###autoload
+(defun org-babel-execute-src-block (&optional arg info params)
+ "Execute the current source code block.
+Insert the results of execution into the buffer. Source code
+execution and the collection and formatting of results can be
+controlled through a variety of header arguments.
+
+With prefix argument ARG, force re-execution even if an existing
+result cached in the buffer would otherwise have been returned.
+
+Optionally supply a value for INFO in the form returned by
+`org-babel-get-src-block-info'.
+
+Optionally supply a value for PARAMS which will be merged with
+the header arguments specified at the front of the source code
+block."
+ (interactive)
+ (let* ((org-babel-current-src-block-location
+ (or org-babel-current-src-block-location
+ (nth 6 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info
+ (copy-tree info)
+ (org-babel-get-src-block-info)))
+ (merged-params (org-babel-merge-params (nth 2 info) params)))
+ (when (org-babel-check-evaluate
+ (let ((i info)) (setf (nth 2 i) merged-params) i))
+ (let* ((params (if params
+ (org-babel-process-params merged-params)
+ (nth 2 info)))
+ (cachep (and (not arg) (cdr (assoc :cache params))
+ (string= "yes" (cdr (assoc :cache params)))))
+ (new-hash (when cachep (org-babel-sha1-hash info)))
+ (old-hash (when cachep (org-babel-current-result-hash)))
+ (cache-current-p (and (not arg) new-hash
+ (equal new-hash old-hash))))
+ (cond
+ (cache-current-p
+ (save-excursion ;; return cached result
+ (goto-char (org-babel-where-is-src-block-result nil info))
+ (end-of-line 1) (forward-char 1)
+ (let ((result (org-babel-read-result)))
+ (message (replace-regexp-in-string
+ "%" "%%" (format "%S" result))) result)))
+ ((org-babel-confirm-evaluate
+ (let ((i info)) (setf (nth 2 i) merged-params) i))
+ (let* ((lang (nth 0 info))
+ (result-params (cdr (assoc :result-params params)))
+ (body (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory (expand-file-name dir)))
+ default-directory))
+ (org-babel-call-process-region-original ;; for tramp handler
+ (or (org-bound-and-true-p
+ org-babel-call-process-region-original)
+ (symbol-function 'call-process-region)))
+ (indent (nth 5 info))
+ result cmd)
+ (unwind-protect
+ (let ((call-process-region
+ (lambda (&rest args)
+ (apply 'org-babel-tramp-handle-call-process-region
+ args))))
+ (let ((lang-check
+ (lambda (f)
+ (let ((f (intern (concat "org-babel-execute:" f))))
+ (when (fboundp f) f)))))
+ (setq cmd
+ (or (funcall lang-check lang)
+ (funcall lang-check
+ (symbol-name
+ (cdr (assoc lang org-src-lang-modes))))
+ (error "No org-babel-execute function for %s!"
+ lang))))
+ (message "executing %s code block%s..."
+ (capitalize lang)
+ (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
+ (if (member "none" result-params)
+ (progn
+ (funcall cmd body params)
+ (message "result silenced")
+ (setq result nil))
+ (setq result
+ (let ((result (funcall cmd body params)))
+ (if (and (eq (cdr (assoc :result-type params))
+ 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp result)))
+ (list (list result)) result)))
+ ;; If non-empty result and :file then write to :file.
+ (when (cdr (assoc :file params))
+ (when result
+ (with-temp-file (cdr (assoc :file params))
+ (insert
+ (org-babel-format-result
+ result (cdr (assoc :sep (nth 2 info)))))))
+ (setq result (cdr (assoc :file params))))
+ ;; Possibly perform post process provided its appropriate.
+ (when (cdr (assoc :post params))
+ (let ((*this* (if (cdr (assoc :file params))
+ (org-babel-result-to-file
+ (cdr (assoc :file params))
+ (when (assoc :file-desc params)
+ (or (cdr (assoc :file-desc params))
+ result)))
+ result)))
+ (setq result (org-babel-ref-resolve
+ (cdr (assoc :post params))))
+ (when (cdr (assoc :file params))
+ (setq result-params
+ (remove "file" result-params)))))
+ (org-babel-insert-result
+ result result-params info new-hash indent lang))
+ (run-hooks 'org-babel-after-execute-hook)
+ result)
+ (setq call-process-region
+ 'org-babel-call-process-region-original)))))))))
+
+(defun org-babel-expand-body:generic (body params &optional var-lines)
+ "Expand BODY with PARAMS.
+Expand a block of code with org-babel according to its header
+arguments. This generic implementation of body expansion is
+called for languages which have not defined their own specific
+org-babel-expand-body:lang function."
+ (let ((pro (cdr (assoc :prologue params)))
+ (epi (cdr (assoc :epilogue params))))
+ (mapconcat #'identity
+ (append (when pro (list pro))
+ var-lines
+ (list body)
+ (when epi (list epi)))
+ "\n")))
+
+;;;###autoload
+(defun org-babel-expand-src-block (&optional arg info params)
+ "Expand the current source code block.
+Expand according to the source code block's header
+arguments and pop open the results in a preview buffer."
+ (interactive)
+ (let* ((info (or info (org-babel-get-src-block-info)))
+ (lang (nth 0 info))
+ (params (setf (nth 2 info)
+ (sort (org-babel-merge-params (nth 2 info) params)
+ (lambda (el1 el2) (string< (symbol-name (car el1))
+ (symbol-name (car el2)))))))
+ (body (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info) (nth 1 info))))
+ (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
+ (assignments-cmd (intern (concat "org-babel-variable-assignments:"
+ lang)))
+ (expanded
+ (if (fboundp expand-cmd) (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
+ (if (org-called-interactively-p 'any)
+ (org-edit-src-code
+ nil expanded
+ (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
+ expanded)))
+
+(defun org-babel-edit-distance (s1 s2)
+ "Return the edit (levenshtein) distance between strings S1 S2."
+ (let* ((l1 (length s1))
+ (l2 (length s2))
+ (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
+ (number-sequence 1 (1+ l1)))))
+ (in (lambda (i j) (aref (aref dist i) j))))
+ (setf (aref (aref dist 0) 0) 0)
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist 0) j) j))
+ (dolist (i (number-sequence 1 l1))
+ (setf (aref (aref dist i) 0) i)
+ (dolist (j (number-sequence 1 l2))
+ (setf (aref (aref dist i) j)
+ (min
+ (1+ (funcall in (1- i) j))
+ (1+ (funcall in i (1- j)))
+ (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
+ (funcall in (1- i) (1- j)))))))
+ (funcall in l1 l2)))
+
+(defun org-babel-combine-header-arg-lists (original &rest others)
+ "Combine a number of lists of header argument names and arguments."
+ (let ((results (copy-sequence original)))
+ (dolist (new-list others)
+ (dolist (arg-pair new-list)
+ (let ((header (car arg-pair))
+ (args (cdr arg-pair)))
+ (setq results
+ (cons arg-pair (org-remove-if
+ (lambda (pair) (equal header (car pair)))
+ results))))))
+ results))
+
+;;;###autoload
+(defun org-babel-check-src-block ()
+ "Check for misspelled header arguments in the current code block."
+ (interactive)
+ ;; TODO: report malformed code block
+ ;; TODO: report incompatible combinations of header arguments
+ ;; TODO: report uninitialized variables
+ (let ((too-close 2) ;; <- control closeness to report potential match
+ (names (mapcar #'symbol-name org-babel-header-arg-names)))
+ (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
+ (and (org-babel-where-is-src-block-head)
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (match-string 4))))))
+ (dolist (name names)
+ (when (and (not (string= header name))
+ (<= (org-babel-edit-distance header name) too-close)
+ (not (member header names)))
+ (error "Supplied header \"%S\" is suspiciously close to \"%S\""
+ header name))))
+ (message "No suspicious header arguments found.")))
+
+;;;###autoload
+(defun org-babel-insert-header-arg ()
+ "Insert a header argument selecting from lists of common args and values."
+ (interactive)
+ (let* ((lang (car (org-babel-get-src-block-info 'light)))
+ (lang-headers (intern (concat "org-babel-header-args:" lang)))
+ (headers (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (when (boundp lang-headers) (eval lang-headers))))
+ (arg (org-icompleting-read
+ "Header Arg: "
+ (mapcar
+ (lambda (header-spec) (symbol-name (car header-spec)))
+ headers))))
+ (insert ":" arg)
+ (let ((vals (cdr (assoc (intern arg) headers))))
+ (when vals
+ (insert
+ " "
+ (cond
+ ((eq vals :any)
+ (read-from-minibuffer "value: "))
+ ((listp vals)
+ (mapconcat
+ (lambda (group)
+ (let ((arg (org-icompleting-read
+ "value: "
+ (cons "default" (mapcar #'symbol-name group)))))
+ (if (and arg (not (string= "default" arg)))
+ (concat arg " ")
+ "")))
+ vals ""))))))))
+
+;; Add support for completing-read insertion of header arguments after ":"
+(defun org-babel-header-arg-expand ()
+ "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts."
+ (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head))
+ (org-babel-enter-header-arg-w-completion (match-string 2))))
+
+(defun org-babel-enter-header-arg-w-completion (&optional lang)
+ "Insert header argument appropriate for LANG with completion."
+ (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
+ (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
+ (headers-w-values (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values lang-headers))
+ (headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
+ (header (org-completing-read "Header Arg: " headers))
+ (args (cdr (assoc (intern header) headers-w-values)))
+ (arg (when (and args (listp args))
+ (org-completing-read
+ (format "%s: " header)
+ (mapcar #'symbol-name (apply #'append args))))))
+ (insert (concat header " " (or arg "")))
+ (cons header arg)))
+
+(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
+
+;;;###autoload
+(defun org-babel-load-in-session (&optional arg info)
+ "Load the body of the current source-code block.
+Evaluate the header arguments for the source block before
+entering the session. After loading the body this pops open the
+session."
+ (interactive)
+ (let* ((info (or info (org-babel-get-src-block-info)))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (body (if (not info)
+ (user-error "No src code block at point")
+ (setf (nth 1 info)
+ (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))))
+ (session (cdr (assoc :session params)))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory dir)) default-directory))
+ (cmd (intern (concat "org-babel-load-session:" lang))))
+ (unless (fboundp cmd)
+ (error "No org-babel-load-session function for %s!" lang))
+ (pop-to-buffer (funcall cmd session body params))
+ (end-of-line 1)))
+
+;;;###autoload
+(defun org-babel-initiate-session (&optional arg info)
+ "Initiate session for current code block.
+If called with a prefix argument then resolve any variable
+references in the header arguments and assign these variables in
+the session. Copy the body of the code block to the kill ring."
+ (interactive "P")
+ (let* ((info (or info (org-babel-get-src-block-info (not arg))))
+ (lang (nth 0 info))
+ (body (nth 1 info))
+ (params (nth 2 info))
+ (session (cdr (assoc :session params)))
+ (dir (cdr (assoc :dir params)))
+ (default-directory
+ (or (and dir (file-name-as-directory dir)) default-directory))
+ (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
+ (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
+ (if (and (stringp session) (string= session "none"))
+ (error "This block is not using a session!"))
+ (unless (fboundp init-cmd)
+ (error "No org-babel-initiate-session function for %s!" lang))
+ (with-temp-buffer (insert (org-babel-trim body))
+ (copy-region-as-kill (point-min) (point-max)))
+ (when arg
+ (unless (fboundp prep-cmd)
+ (error "No org-babel-prep-session function for %s!" lang))
+ (funcall prep-cmd session params))
+ (funcall init-cmd session params)))
+
+;;;###autoload
+(defun org-babel-switch-to-session (&optional arg info)
+ "Switch to the session of the current code block.
+Uses `org-babel-initiate-session' to start the session. If called
+with a prefix argument then this is passed on to
+`org-babel-initiate-session'."
+ (interactive "P")
+ (pop-to-buffer (org-babel-initiate-session arg info))
+ (end-of-line 1))
+
+(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
+
+(defvar org-src-window-setup)
+
+;;;###autoload
+(defun org-babel-switch-to-session-with-code (&optional arg info)
+ "Switch to code buffer and display session."
+ (interactive "P")
+ (let ((swap-windows
+ (lambda ()
+ (let ((other-window-buffer (window-buffer (next-window))))
+ (set-window-buffer (next-window) (current-buffer))
+ (set-window-buffer (selected-window) other-window-buffer))
+ (other-window 1)))
+ (info (org-babel-get-src-block-info))
+ (org-src-window-setup 'reorganize-frame))
+ (save-excursion
+ (org-babel-switch-to-session arg info))
+ (org-edit-src-code)
+ (funcall swap-windows)))
+
+(defmacro org-babel-do-in-edit-buffer (&rest body)
+ "Evaluate BODY in edit buffer if there is a code block at point.
+Return t if a code block was found at point, nil otherwise."
+ `(let ((org-src-window-setup 'switch-invisibly))
+ (when (and (org-babel-where-is-src-block-head)
+ (org-edit-src-code nil nil nil))
+ (unwind-protect (progn ,@body)
+ (if (org-bound-and-true-p org-edit-src-from-org-mode)
+ (org-edit-src-exit)))
+ t)))
+(def-edebug-spec org-babel-do-in-edit-buffer (body))
+
+(defun org-babel-do-key-sequence-in-edit-buffer (key)
+ "Read key sequence and execute the command in edit buffer.
+Enter a key sequence to be executed in the language major-mode
+edit buffer. For example, TAB will alter the contents of the
+Org-mode code block according to the effect of TAB in the
+language major-mode buffer. For languages that support
+interactive sessions, this can be used to send code from the Org
+buffer to the session for evaluation using the native major-mode
+evaluation mechanisms."
+ (interactive "kEnter key-sequence to execute in edit buffer: ")
+ (org-babel-do-in-edit-buffer
+ (call-interactively
+ (key-binding (or key (read-key-sequence nil))))))
+
+(defvar org-bracket-link-regexp)
+
+(defun org-babel-active-location-p ()
+ (memq (car (save-match-data (org-element-context)))
+ '(babel-call inline-babel-call inline-src-block src-block)))
+
+;;;###autoload
+(defun org-babel-open-src-block-result (&optional re-run)
+ "If `point' is on a src block then open the results of the
+source code block, otherwise return nil. With optional prefix
+argument RE-RUN the source-code block is evaluated even if
+results already exist."
+ (interactive "P")
+ (let ((info (org-babel-get-src-block-info 'light)))
+ (when info
+ (save-excursion
+ ;; go to the results, if there aren't any then run the block
+ (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
+ (progn (org-babel-execute-src-block)
+ (org-babel-where-is-src-block-result))))
+ (end-of-line 1)
+ (while (looking-at "[\n\r\t\f ]") (forward-char 1))
+ ;; open the results
+ (if (looking-at org-bracket-link-regexp)
+ ;; file results
+ (org-open-at-point)
+ (let ((r (org-babel-format-result
+ (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
+ (pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
+ (delete-region (point-min) (point-max))
+ (insert r)))
+ t))))
+
+;;;###autoload
+(defmacro org-babel-map-src-blocks (file &rest body)
+ "Evaluate BODY forms on each source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer. During evaluation of BODY the following local variables
+are set relative to the currently matched code block.
+
+full-block ------- string holding the entirety of the code block
+beg-block -------- point at the beginning of the code block
+end-block -------- point at the end of the matched code block
+lang ------------- string holding the language of the code block
+beg-lang --------- point at the beginning of the lang
+end-lang --------- point at the end of the lang
+switches --------- string holding the switches
+beg-switches ----- point at the beginning of the switches
+end-switches ----- point at the end of the switches
+header-args ------ string holding the header-args
+beg-header-args -- point at the beginning of the header-args
+end-header-args -- point at the end of the header-args
+body ------------- string holding the body of the code block
+beg-body --------- point at the beginning of the body
+end-body --------- point at the end of the body"
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-src-block-regexp nil t)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 0))
+ (let ((full-block (match-string 0))
+ (beg-block (match-beginning 0))
+ (end-block (match-end 0))
+ (lang (match-string 2))
+ (beg-lang (match-beginning 2))
+ (end-lang (match-end 2))
+ (switches (match-string 3))
+ (beg-switches (match-beginning 3))
+ (end-switches (match-end 3))
+ (header-args (match-string 4))
+ (beg-header-args (match-beginning 4))
+ (end-header-args (match-end 4))
+ (body (match-string 5))
+ (beg-body (match-beginning 5))
+ (end-body (match-end 5)))
+ ,@body
+ (goto-char end-block)))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-src-blocks (form body))
+
+;;;###autoload
+(defmacro org-babel-map-inline-src-blocks (file &rest body)
+ "Evaluate BODY forms on each inline source-block in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-inline-src-block-regexp nil t)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-inline-src-blocks (form body))
+
+(defvar org-babel-lob-one-liner-regexp)
+
+;;;###autoload
+(defmacro org-babel-map-call-lines (file &rest body)
+ "Evaluate BODY forms on each call line in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file")))
+ `(let* ((,tempvar ,file)
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-call-lines (form body))
+
+;;;###autoload
+(defmacro org-babel-map-executables (file &rest body)
+ (declare (indent 1))
+ (let ((tempvar (make-symbol "file"))
+ (rx (make-symbol "rx")))
+ `(let* ((,tempvar ,file)
+ (,rx (concat "\\(" org-babel-src-block-regexp
+ "\\|" org-babel-inline-src-block-regexp
+ "\\|" org-babel-lob-one-liner-regexp "\\)"))
+ (visited-p (or (null ,tempvar)
+ (get-file-buffer (expand-file-name ,tempvar))))
+ (point (point)) to-be-removed)
+ (save-window-excursion
+ (when ,tempvar (find-file ,tempvar))
+ (setq to-be-removed (current-buffer))
+ (goto-char (point-min))
+ (while (re-search-forward ,rx nil t)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ (forward-char 1))
+ (save-match-data ,@body))
+ (goto-char (match-end 0))))
+ (unless visited-p (kill-buffer to-be-removed))
+ (goto-char point))))
+(def-edebug-spec org-babel-map-executables (form body))
+
+;;;###autoload
+(defun org-babel-execute-buffer (&optional arg)
+ "Execute source code blocks in a buffer.
+Call `org-babel-execute-src-block' on every source block in
+the current buffer."
+ (interactive "P")
+ (org-babel-eval-wipe-error-buffer)
+ (org-save-outline-visibility t
+ (org-babel-map-executables nil
+ (if (looking-at org-babel-lob-one-liner-regexp)
+ (org-babel-lob-execute-maybe)
+ (org-babel-execute-src-block arg)))))
+
+;;;###autoload
+(defun org-babel-execute-subtree (&optional arg)
+ "Execute source code blocks in a subtree.
+Call `org-babel-execute-src-block' on every source block in
+the current subtree."
+ (interactive "P")
+ (save-restriction
+ (save-excursion
+ (org-narrow-to-subtree)
+ (org-babel-execute-buffer arg)
+ (widen))))
+
+;;;###autoload
+(defun org-babel-sha1-hash (&optional info)
+ "Generate an sha1 hash based on the value of info."
+ (interactive)
+ (let ((print-level nil)
+ (info (or info (org-babel-get-src-block-info))))
+ (setf (nth 2 info)
+ (sort (copy-sequence (nth 2 info))
+ (lambda (a b) (string< (car a) (car b)))))
+ (let* ((rm (lambda (lst)
+ (dolist (p '("replace" "silent" "none"
+ "append" "prepend"))
+ (setq lst (remove p lst)))
+ lst))
+ (norm (lambda (arg)
+ (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
+ (copy-sequence (cdr arg))
+ (cdr arg))))
+ (when (and v (not (and (sequencep v)
+ (not (consp v))
+ (= (length v) 0))))
+ (cond
+ ((and (listp v) ; lists are sorted
+ (member (car arg) '(:result-params)))
+ (sort (funcall rm v) #'string<))
+ ((and (stringp v) ; strings are sorted
+ (member (car arg) '(:results :exports)))
+ (mapconcat #'identity (sort (funcall rm (split-string v))
+ #'string<) " "))
+ (t v)))))))
+ (let* ((it (format "%s-%s"
+ (mapconcat
+ #'identity
+ (delq nil (mapcar (lambda (arg)
+ (let ((normalized (funcall norm arg)))
+ (when normalized
+ (format "%S" normalized))))
+ (nth 2 info))) ":")
+ (nth 1 info)))
+ (hash (sha1 it)))
+ (when (org-called-interactively-p 'interactive) (message hash))
+ hash))))
+
+(defun org-babel-current-result-hash ()
+ "Return the current in-buffer hash."
+ (org-babel-where-is-src-block-result)
+ (org-no-properties (match-string 5)))
+
+(defun org-babel-set-current-result-hash (hash)
+ "Set the current in-buffer hash to HASH."
+ (org-babel-where-is-src-block-result)
+ (save-excursion (goto-char (match-beginning 5))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 5)
+ (goto-char (point-at-bol))
+ (org-babel-hide-hash)))
+
+(defun org-babel-hide-hash ()
+ "Hide the hash in the current results line.
+Only the initial `org-babel-hash-show' characters of the hash
+will remain visible."
+ (add-to-invisibility-spec '(org-babel-hide-hash . t))
+ (save-excursion
+ (when (and (re-search-forward org-babel-result-regexp nil t)
+ (match-string 5))
+ (let* ((start (match-beginning 5))
+ (hide-start (+ org-babel-hash-show start))
+ (end (match-end 5))
+ (hash (match-string 5))
+ ov1 ov2)
+ (setq ov1 (make-overlay start hide-start))
+ (setq ov2 (make-overlay hide-start end))
+ (overlay-put ov2 'invisible 'org-babel-hide-hash)
+ (overlay-put ov1 'babel-hash hash)))))
+
+(defun org-babel-hide-all-hashes ()
+ "Hide the hash in the current buffer.
+Only the initial `org-babel-hash-show' characters of each hash
+will remain visible. This function should be called as part of
+the `org-mode-hook'."
+ (save-excursion
+ (while (and (not org-babel-hash-show-time)
+ (re-search-forward org-babel-result-regexp nil t))
+ (goto-char (match-beginning 0))
+ (org-babel-hide-hash)
+ (goto-char (match-end 0)))))
+(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
+
+(defun org-babel-hash-at-point (&optional point)
+ "Return the value of the hash at POINT.
+The hash is also added as the last element of the kill ring.
+This can be called with C-c C-c."
+ (interactive)
+ (let ((hash (car (delq nil (mapcar
+ (lambda (ol) (overlay-get ol 'babel-hash))
+ (overlays-at (or point (point))))))))
+ (when hash (kill-new hash) (message hash))))
+(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
+
+(defun org-babel-result-hide-spec ()
+ "Hide portions of results lines.
+Add `org-babel-hide-result' as an invisibility spec for hiding
+portions of results lines."
+ (add-to-invisibility-spec '(org-babel-hide-result . t)))
+(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
+
+(defvar org-babel-hide-result-overlays nil
+ "Overlays hiding results.")
+
+(defun org-babel-result-hide-all ()
+ "Fold all results in the current buffer."
+ (interactive)
+ (org-babel-show-result-all)
+ (save-excursion
+ (while (re-search-forward org-babel-result-regexp nil t)
+ (save-excursion (goto-char (match-beginning 0))
+ (org-babel-hide-result-toggle-maybe)))))
+
+(defun org-babel-show-result-all ()
+ "Unfold all results in the current buffer."
+ (mapc 'delete-overlay org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays nil))
+
+;;;###autoload
+(defun org-babel-hide-result-toggle-maybe ()
+ "Toggle visibility of result at point."
+ (interactive)
+ (let ((case-fold-search t))
+ (if (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-babel-result-regexp))
+ (progn (org-babel-hide-result-toggle)
+ t) ;; to signal that we took action
+ nil))) ;; to signal that we did not
+
+(defun org-babel-hide-result-toggle (&optional force)
+ "Toggle the visibility of the current result."
+ (interactive)
+ (save-excursion
+ (beginning-of-line)
+ (if (re-search-forward org-babel-result-regexp nil t)
+ (let ((start (progn (beginning-of-line 2) (- (point) 1)))
+ (end (progn
+ (while (looking-at org-babel-multi-line-header-regexp)
+ (forward-line 1))
+ (goto-char (- (org-babel-result-end) 1)) (point)))
+ ov)
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-babel-hide-result))
+ (overlays-at start)))
+ (if (or (not force) (eq force 'off))
+ (mapc (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov)))
+ (overlays-at start)))
+ (setq ov (make-overlay start end))
+ (overlay-put ov 'invisible 'org-babel-hide-result)
+ ;; make the block accessible to isearch
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (member ov org-babel-hide-result-overlays)
+ (setq org-babel-hide-result-overlays
+ (delq ov org-babel-hide-result-overlays)))
+ (when (eq (overlay-get ov 'invisible)
+ 'org-babel-hide-result)
+ (delete-overlay ov))))
+ (push ov org-babel-hide-result-overlays)))
+ (error "Not looking at a result line"))))
+
+;; org-tab-after-check-for-cycling-hook
+(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
+;; Remove overlays when changing major mode
+(add-hook 'org-mode-hook
+ (lambda () (org-add-hook 'change-major-mode-hook
+ 'org-babel-show-result-all 'append 'local)))
+
+(defvar org-file-properties)
+(defun org-babel-params-from-properties (&optional lang)
+ "Retrieve parameters specified as properties.
+Return a list of association lists of source block params
+specified in the properties of the current outline entry."
+ (save-match-data
+ (list
+ ;; DEPRECATED header arguments specified as separate property at
+ ;; point of definition
+ (let (val sym)
+ (org-babel-parse-multiple-vars
+ (delq nil
+ (mapcar
+ (lambda (header-arg)
+ (and (setq val (org-entry-get (point) header-arg t))
+ (cons (intern (concat ":" header-arg))
+ (org-babel-read val))))
+ (mapcar
+ #'symbol-name
+ (mapcar
+ #'car
+ (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (progn
+ (setq sym (intern (concat "org-babel-header-args:" lang)))
+ (and (boundp sym) (eval sym))))))))))
+ ;; header arguments specified with the header-args property at
+ ;; point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ "header-args" 'inherit))
+ (when lang ;; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang) 'inherit))))))
+
+(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
+(defun org-babel-parse-src-block-match ()
+ "Parse the results from a match of the `org-babel-src-block-regexp'."
+ (let* ((block-indentation (length (match-string 1)))
+ (lang (org-no-properties (match-string 2)))
+ (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
+ (switches (match-string 3))
+ (body (org-no-properties
+ (let* ((body (match-string 5))
+ (sub-length (- (length body) 1)))
+ (if (and (> sub-length 0)
+ (string= "\n" (substring body sub-length)))
+ (substring body 0 sub-length)
+ (or body "")))))
+ (preserve-indentation (or org-src-preserve-indentation
+ (save-match-data
+ (string-match "-i\\>" switches)))))
+ (list lang
+ ;; get block body less properties, protective commas, and indentation
+ (with-temp-buffer
+ (save-match-data
+ (insert (org-unescape-code-in-string body))
+ (unless preserve-indentation (org-do-remove-indentation))
+ (buffer-string)))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (when (boundp lang-headers) (eval lang-headers))
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) ""))))))
+ switches
+ block-indentation)))
+
+(defun org-babel-parse-inline-src-block-match ()
+ "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
+ (let* ((lang (org-no-properties (match-string 2)))
+ (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
+ (list lang
+ (org-unescape-code-in-string (org-no-properties (match-string 5)))
+ (apply #'org-babel-merge-params
+ org-babel-default-inline-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) "")))))))))
+
+(defun org-babel-balanced-split (string alts)
+ "Split STRING on instances of ALTS.
+ALTS is a cons of two character options where each option may be
+either the numeric code of a single character or a list of
+character alternatives. For example to split on balanced
+instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
+ (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
+ (matched (lambda (ch last)
+ (if (consp alts)
+ (and (funcall matches ch (cdr alts))
+ (funcall matches last (car alts)))
+ (funcall matches ch alts))))
+ (balance 0) (last 0)
+ quote partial lst)
+ (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
+ (setq balance (+ balance
+ (cond ((or (equal 91 ch) (equal 40 ch)) 1)
+ ((or (equal 93 ch) (equal 41 ch)) -1)
+ (t 0))))
+ (when (and (equal 34 ch) (not (equal 92 last)))
+ (setq quote (not quote)))
+ (setq partial (cons ch partial))
+ (when (and (= balance 0) (not quote) (funcall matched ch last))
+ (setq lst (cons (apply #'string (nreverse
+ (if (consp alts)
+ (cddr partial)
+ (cdr partial))))
+ lst))
+ (setq partial nil))
+ (setq last ch))
+ (string-to-list string))
+ (nreverse (cons (apply #'string (nreverse partial)) lst))))
+
+(defun org-babel-join-splits-near-ch (ch list)
+ "Join splits where \"=\" is on either end of the split."
+ (let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
+ (first= (lambda (str) (= ch (aref str 0)))))
+ (reverse
+ (org-reduce (lambda (acc el)
+ (let ((head (car acc)))
+ (if (and head (or (funcall last= head) (funcall first= el)))
+ (cons (concat head el) (cdr acc))
+ (cons el acc))))
+ list :initial-value nil))))
+
+(defun org-babel-parse-header-arguments (arg-string)
+ "Parse a string of header arguments returning an alist."
+ (when (> (length arg-string) 0)
+ (org-babel-parse-multiple-vars
+ (delq nil
+ (mapcar
+ (lambda (arg)
+ (if (string-match
+ "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
+ arg)
+ (cons (intern (match-string 1 arg))
+ (org-babel-read (org-babel-chomp (match-string 2 arg))))
+ (cons (intern (org-babel-chomp arg)) nil)))
+ (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58))))
+ (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))))))))
+
+(defun org-babel-parse-multiple-vars (header-arguments)
+ "Expand multiple variable assignments behind a single :var keyword.
+
+This allows expression of multiple variables with one :var as
+shown below.
+
+#+PROPERTY: var foo=1, bar=2"
+ (let (results)
+ (mapc (lambda (pair)
+ (if (eq (car pair) :var)
+ (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
+ (org-babel-join-splits-near-ch
+ 61 (org-babel-balanced-split (cdr pair) 32)))
+ (push pair results)))
+ header-arguments)
+ (nreverse results)))
+
+(defun org-babel-process-params (params)
+ "Expand variables in PARAMS and add summary parameters."
+ (let* ((processed-vars (mapcar (lambda (el)
+ (if (consp (cdr el))
+ (cdr el)
+ (org-babel-ref-parse (cdr el))))
+ (org-babel-get-header params :var)))
+ (vars-and-names (if (and (assoc :colname-names params)
+ (assoc :rowname-names params))
+ (list processed-vars)
+ (org-babel-disassemble-tables
+ processed-vars
+ (cdr (assoc :hlines params))
+ (cdr (assoc :colnames params))
+ (cdr (assoc :rownames params)))))
+ (raw-result (or (cdr (assoc :results params)) ""))
+ (result-params (append
+ (split-string (if (stringp raw-result)
+ raw-result
+ (eval raw-result)))
+ (cdr (assoc :result-params params)))))
+ (append
+ (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
+ (list
+ (cons :colname-names (or (cdr (assoc :colname-names params))
+ (cadr vars-and-names)))
+ (cons :rowname-names (or (cdr (assoc :rowname-names params))
+ (caddr vars-and-names)))
+ (cons :result-params result-params)
+ (cons :result-type (cond ((member "output" result-params) 'output)
+ ((member "value" result-params) 'value)
+ (t 'value))))
+ (org-babel-get-header params :var 'other))))
+
+;; row and column names
+(defun org-babel-del-hlines (table)
+ "Remove all 'hlines from TABLE."
+ (remove 'hline table))
+
+(defun org-babel-get-colnames (table)
+ "Return the column names of TABLE.
+Return a cons cell, the `car' of which contains the TABLE less
+colnames, and the `cdr' of which contains a list of the column
+names."
+ (if (equal 'hline (nth 1 table))
+ (cons (cddr table) (car table))
+ (cons (cdr table) (car table))))
+
+(defun org-babel-get-rownames (table)
+ "Return the row names of TABLE.
+Return a cons cell, the `car' of which contains the TABLE less
+rownames, and the `cdr' of which contains a list of the rownames.
+Note: this function removes any hlines in TABLE."
+ (let* ((table (org-babel-del-hlines table))
+ (rownames (funcall (lambda ()
+ (let ((tp table))
+ (mapcar
+ (lambda (row)
+ (prog1
+ (pop (car tp))
+ (setq tp (cdr tp))))
+ table))))))
+ (cons table rownames)))
+
+(defun org-babel-put-colnames (table colnames)
+ "Add COLNAMES to TABLE if they exist."
+ (if colnames (apply 'list colnames 'hline table) table))
+
+(defun org-babel-put-rownames (table rownames)
+ "Add ROWNAMES to TABLE if they exist."
+ (if rownames
+ (mapcar (lambda (row)
+ (if (listp row)
+ (cons (or (pop rownames) "") row)
+ row)) table)
+ table))
+
+(defun org-babel-pick-name (names selector)
+ "Select one out of an alist of row or column names.
+SELECTOR can be either a list of names in which case those names
+will be returned directly, or an index into the list NAMES in
+which case the indexed names will be return."
+ (if (listp selector)
+ selector
+ (when names
+ (if (and selector (symbolp selector) (not (equal t selector)))
+ (cdr (assoc selector names))
+ (if (integerp selector)
+ (nth (- selector 1) names)
+ (cdr (car (last names))))))))
+
+(defun org-babel-disassemble-tables (vars hlines colnames rownames)
+ "Parse tables for further processing.
+Process the variables in VARS according to the HLINES,
+ROWNAMES and COLNAMES header arguments. Return a list consisting
+of the vars, cnames and rnames."
+ (let (cnames rnames)
+ (list
+ (mapcar
+ (lambda (var)
+ (when (listp (cdr var))
+ (when (and (not (equal colnames "no"))
+ (or colnames (and (equal (nth 1 (cdr var)) 'hline)
+ (not (member 'hline (cddr (cdr var)))))))
+ (let ((both (org-babel-get-colnames (cdr var))))
+ (setq cnames (cons (cons (car var) (cdr both))
+ cnames))
+ (setq var (cons (car var) (car both)))))
+ (when (and rownames (not (equal rownames "no")))
+ (let ((both (org-babel-get-rownames (cdr var))))
+ (setq rnames (cons (cons (car var) (cdr both))
+ rnames))
+ (setq var (cons (car var) (car both)))))
+ (when (and hlines (not (equal hlines "yes")))
+ (setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
+ var)
+ vars)
+ (reverse cnames) (reverse rnames))))
+
+(defun org-babel-reassemble-table (table colnames rownames)
+ "Add column and row names to a table.
+Given a TABLE and set of COLNAMES and ROWNAMES add the names
+to the table for reinsertion to org-mode."
+ (if (listp table)
+ (let ((table (if (and rownames (= (length table) (length rownames)))
+ (org-babel-put-rownames table rownames) table)))
+ (if (and colnames (listp (car table)) (= (length (car table))
+ (length colnames)))
+ (org-babel-put-colnames table colnames) table))
+ table))
+
+(defun org-babel-where-is-src-block-head ()
+ "Find where the current source block begins.
+Return the point at the beginning of the current source
+block. Specifically at the beginning of the #+BEGIN_SRC line.
+If the point is not on a source block then return nil."
+ (let ((initial (point)) (case-fold-search t) top bottom)
+ (or
+ (save-excursion ;; on a source name line or a #+header line
+ (beginning-of-line 1)
+ (and (or (looking-at org-babel-src-name-regexp)
+ (looking-at org-babel-multi-line-header-regexp))
+ (progn
+ (while (and (forward-line 1)
+ (or (looking-at org-babel-src-name-regexp)
+ (looking-at org-babel-multi-line-header-regexp))))
+ (looking-at org-babel-src-block-regexp))
+ (point)))
+ (save-excursion ;; on a #+begin_src line
+ (beginning-of-line 1)
+ (and (looking-at org-babel-src-block-regexp)
+ (point)))
+ (save-excursion ;; inside a src block
+ (and
+ (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
+ (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
+ (< top initial) (< initial bottom)
+ (progn (goto-char top) (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp))
+ (point-marker))))))
+
+;;;###autoload
+(defun org-babel-goto-src-block-head ()
+ "Go to the beginning of the current code block."
+ (interactive)
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head (goto-char head) (error "Not currently in a code block"))))
+
+;;;###autoload
+(defun org-babel-goto-named-src-block (name)
+ "Go to a named source-code block."
+ (interactive
+ (let ((completion-ignore-case t)
+ (case-fold-search t)
+ (under-point (thing-at-point 'line)))
+ (list (org-icompleting-read
+ "source-block name: " (org-babel-src-block-names) nil t
+ (cond
+ ;; noweb
+ ((string-match (org-babel-noweb-wrap) under-point)
+ (let ((block-name (match-string 1 under-point)))
+ (string-match "[^(]*" block-name)
+ (match-string 0 block-name)))
+ ;; #+call:
+ ((string-match org-babel-lob-one-liner-regexp under-point)
+ (let ((source-info (car (org-babel-lob-get-info))))
+ (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
+ (let ((source-name (match-string 1 source-info)))
+ source-name))))
+ ;; #+results:
+ ((string-match (concat "#\\+" org-babel-results-keyword
+ "\\:\s+\\([^\\(]*\\)") under-point)
+ (match-string 1 under-point))
+ ;; symbol-at-point
+ ((and (thing-at-point 'symbol))
+ (org-babel-find-named-block (thing-at-point 'symbol))
+ (thing-at-point 'symbol))
+ (""))))))
+ (let ((point (org-babel-find-named-block name)))
+ (if point
+ ;; taken from `org-open-at-point'
+ (progn (org-mark-ring-push) (goto-char point) (org-show-context))
+ (message "source-code block `%s' not found in this buffer" name))))
+
+(defun org-babel-find-named-block (name)
+ "Find a named source-code block.
+Return the location of the source block identified by source
+NAME, or nil if no such block exists. Set match data according to
+org-babel-named-src-block-regexp."
+ (save-excursion
+ (let ((case-fold-search t)
+ (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
+ (goto-char (point-min))
+ (when (or (re-search-forward regexp nil t)
+ (re-search-backward regexp nil t))
+ (match-beginning 0)))))
+
+(defun org-babel-src-block-names (&optional file)
+ "Returns the names of source blocks in FILE or the current buffer."
+ (save-excursion
+ (when file (find-file file)) (goto-char (point-min))
+ (let ((case-fold-search t) names)
+ (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
+ (setq names (cons (match-string 3) names)))
+ names)))
+
+;;;###autoload
+(defun org-babel-goto-named-result (name)
+ "Go to a named result."
+ (interactive
+ (let ((completion-ignore-case t))
+ (list (org-icompleting-read "source-block name: "
+ (org-babel-result-names) nil t))))
+ (let ((point (org-babel-find-named-result name)))
+ (if point
+ ;; taken from `org-open-at-point'
+ (progn (goto-char point) (org-show-context))
+ (message "result `%s' not found in this buffer" name))))
+
+(defun org-babel-find-named-result (name &optional point)
+ "Find a named result.
+Return the location of the result named NAME in the current
+buffer or nil if no such result exists."
+ (save-excursion
+ (let ((case-fold-search t))
+ (goto-char (or point (point-min)))
+ (catch 'is-a-code-block
+ (when (re-search-forward
+ (concat org-babel-result-regexp
+ "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
+ (when (and (string= "name" (downcase (match-string 1)))
+ (or (beginning-of-line 1)
+ (looking-at org-babel-src-block-regexp)
+ (looking-at org-babel-multi-line-header-regexp)
+ (looking-at org-babel-lob-one-liner-regexp)))
+ (throw 'is-a-code-block (org-babel-find-named-result name (point))))
+ (beginning-of-line 0) (point))))))
+
+(defun org-babel-result-names (&optional file)
+ "Returns the names of results in FILE or the current buffer."
+ (save-excursion
+ (when file (find-file file)) (goto-char (point-min))
+ (let ((case-fold-search t) names)
+ (while (re-search-forward org-babel-result-w-name-regexp nil t)
+ (setq names (cons (match-string 4) names)))
+ names)))
+
+;;;###autoload
+(defun org-babel-next-src-block (&optional arg)
+ "Jump to the next source block.
+With optional prefix argument ARG, jump forward ARG many source blocks."
+ (interactive "p")
+ (org-next-block arg nil org-babel-src-block-regexp))
+
+;;;###autoload
+(defun org-babel-previous-src-block (&optional arg)
+ "Jump to the previous source block.
+With optional prefix argument ARG, jump backward ARG many source blocks."
+ (interactive "p")
+ (org-previous-block arg org-babel-src-block-regexp))
+
+(defvar org-babel-load-languages)
+
+;;;###autoload
+(defun org-babel-mark-block ()
+ "Mark current src block."
+ (interactive)
+ (let ((head (org-babel-where-is-src-block-head)))
+ (when head
+ (save-excursion
+ (goto-char head)
+ (looking-at org-babel-src-block-regexp))
+ (push-mark (match-end 5) nil t)
+ (goto-char (match-beginning 5)))))
+
+(defun org-babel-demarcate-block (&optional arg)
+ "Wrap or split the code in the region or on the point.
+When called from inside of a code block the current block is
+split. When called from outside of a code block a new code block
+is created. In both cases if the region is demarcated and if the
+region is not active then the point is demarcated."
+ (interactive "P")
+ (let ((info (org-babel-get-src-block-info 'light))
+ (headers (progn (org-babel-where-is-src-block-head)
+ (match-string 4)))
+ (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
+ (if info
+ (mapc
+ (lambda (place)
+ (save-excursion
+ (goto-char place)
+ (let ((lang (nth 0 info))
+ (indent (make-string (nth 5 info) ? )))
+ (when (string-match "^[[:space:]]*$"
+ (buffer-substring (point-at-bol)
+ (point-at-eol)))
+ (delete-region (point-at-bol) (point-at-eol)))
+ (insert (concat
+ (if (looking-at "^") "" "\n")
+ indent "#+end_src\n"
+ (if arg stars indent) "\n"
+ indent "#+begin_src " lang
+ (if (> (length headers) 1)
+ (concat " " headers) headers)
+ (if (looking-at "[\n\r]")
+ ""
+ (concat "\n" (make-string (current-column) ? )))))))
+ (move-end-of-line 2))
+ (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
+ (let ((start (point))
+ (lang (org-icompleting-read
+ "Lang: "
+ (mapcar #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes))))))
+ (body (delete-and-extract-region
+ (if (org-region-active-p) (mark) (point)) (point))))
+ (insert (concat (if (looking-at "^") "" "\n")
+ (if arg (concat stars "\n") "")
+ "#+begin_src " lang "\n"
+ body
+ (if (or (= (length body) 0)
+ (string-match "[\r\n]$" body)) "" "\n")
+ "#+end_src\n"))
+ (goto-char start) (move-end-of-line 1)))))
+
+(defvar org-babel-lob-one-liner-regexp)
+(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
+ "Find where the current source block results begin.
+Return the point at the beginning of the result of the current
+source block. Specifically at the beginning of the results line.
+If no result exists for this block then create a results line
+following the source block."
+ (save-excursion
+ (let* ((case-fold-search t)
+ (on-lob-line (save-excursion
+ (beginning-of-line 1)
+ (looking-at org-babel-lob-one-liner-regexp)))
+ (inlinep (when (org-babel-get-inline-src-block-matches)
+ (match-end 0)))
+ (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
+ (head (unless on-lob-line (org-babel-where-is-src-block-head)))
+ found beg end)
+ (when head (goto-char head))
+ (org-with-wide-buffer
+ (setq
+ found ;; was there a result (before we potentially insert one)
+ (or
+ inlinep
+ (and
+ ;; named results:
+ ;; - return t if it is found, else return nil
+ ;; - if it does not need to be rebuilt, then don't set end
+ ;; - if it does need to be rebuilt then do set end
+ name (setq beg (org-babel-find-named-result name))
+ (prog1 beg
+ (when (and hash (not (string= hash (match-string 5))))
+ (goto-char beg) (setq end beg) ;; beginning of result
+ (forward-line 1)
+ (delete-region end (org-babel-result-end)) nil)))
+ (and
+ ;; unnamed results:
+ ;; - return t if it is found, else return nil
+ ;; - if it is found, and the hash doesn't match, delete and set end
+ (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
+ (progn (end-of-line 1)
+ (if (eobp) (insert "\n") (forward-char 1))
+ (setq end (point))
+ (or (and
+ (not name)
+ (progn ;; unnamed results line already exists
+ (catch 'non-comment
+ (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
+ (beginning-of-line 1)
+ (cond
+ ((looking-at (concat org-babel-result-regexp "\n"))
+ (throw 'non-comment t))
+ ((looking-at "^[ \t]*#") (end-of-line 1))
+ (t (throw 'non-comment nil))))))
+ (let ((this-hash (match-string 5)))
+ (prog1 (point)
+ ;; must remove and rebuild if hash!=old-hash
+ (if (and hash (not (string= hash this-hash)))
+ (prog1 nil
+ (forward-line 1)
+ (delete-region
+ end (org-babel-result-end)))
+ (setq end nil)))))))))))
+ (if (not (and insert end)) found
+ (goto-char end)
+ (unless beg
+ (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
+ (insert (concat
+ (when (wholenump indent) (make-string indent ? ))
+ "#+" org-babel-results-keyword
+ (when hash
+ (if org-babel-hash-show-time
+ (concat
+ "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]")
+ (concat "["hash"]")))
+ ":"
+ (when name (concat " " name)) "\n"))
+ (unless beg (insert "\n") (backward-char))
+ (beginning-of-line 0)
+ (if hash (org-babel-hide-hash))
+ (point)))))
+
+(defvar org-block-regexp)
+(defun org-babel-read-result ()
+ "Read the result at `point' into emacs-lisp."
+ (let ((case-fold-search t) result-string)
+ (cond
+ ((org-at-table-p) (org-babel-read-table))
+ ((org-at-item-p) (org-babel-read-list))
+ ((looking-at org-bracket-link-regexp) (org-babel-read-link))
+ ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
+ ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
+ (setq result-string
+ (org-babel-trim
+ (mapconcat (lambda (line)
+ (or (and (> (length line) 1)
+ (string-match "^[ \t]*: ?\\(.+\\)" line)
+ (match-string 1 line))
+ ""))
+ (split-string
+ (buffer-substring
+ (point) (org-babel-result-end)) "[\r\n]+")
+ "\n")))
+ (or (org-babel-number-p result-string) result-string))
+ ((looking-at org-babel-result-regexp)
+ (save-excursion (forward-line 1) (org-babel-read-result))))))
+
+(defun org-babel-read-table ()
+ "Read the table at `point' into emacs-lisp."
+ (mapcar (lambda (row)
+ (if (and (symbolp row) (equal row 'hline)) row
+ (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
+ (org-table-to-lisp)))
+
+(defun org-babel-read-list ()
+ "Read the list at `point' into emacs-lisp."
+ (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
+ (mapcar #'cadr (cdr (org-list-parse-list)))))
+
+(defvar org-link-types-re)
+(defun org-babel-read-link ()
+ "Read the link at `point' into emacs-lisp.
+If the path of the link is a file path it is expanded using
+`expand-file-name'."
+ (let* ((case-fold-search t)
+ (raw (and (looking-at org-bracket-link-regexp)
+ (org-no-properties (match-string 1))))
+ (type (and (string-match org-link-types-re raw)
+ (match-string 1 raw))))
+ (cond
+ ((not type) (expand-file-name raw))
+ ((string= type "file")
+ (and (string-match "file\\(.*\\):\\(.+\\)" raw)
+ (expand-file-name (match-string 2 raw))))
+ (t raw))))
+
+(defun org-babel-format-result (result &optional sep)
+ "Format RESULT for writing to file."
+ (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
+ (if (listp result)
+ ;; table result
+ (orgtbl-to-generic
+ result (list :sep (or sep "\t") :fmt echo-res))
+ ;; scalar result
+ (funcall echo-res result))))
+
+(defun org-babel-insert-result
+ (result &optional result-params info hash indent lang)
+ "Insert RESULT into the current buffer.
+By default RESULT is inserted after the end of the
+current source block. With optional argument RESULT-PARAMS
+controls insertion of results in the org-mode file.
+RESULT-PARAMS can take the following values:
+
+replace - (default option) insert results after the source block
+ replacing any previously inserted results
+
+silent -- no results are inserted into the Org-mode buffer but
+ the results are echoed to the minibuffer and are
+ ingested by Emacs (a potentially time consuming
+ process)
+
+file ---- the results are interpreted as a file path, and are
+ inserted into the buffer using the Org-mode file syntax
+
+list ---- the results are interpreted as an Org-mode list.
+
+raw ----- results are added directly to the Org-mode file. This
+ is a good option if you code block will output org-mode
+ formatted text.
+
+drawer -- results are added directly to the Org-mode file as with
+ \"raw\", but are wrapped in a RESULTS drawer, allowing
+ them to later be replaced or removed automatically.
+
+org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
+ They are not comma-escaped when inserted, but Org syntax
+ here will be discarded when exporting the file.
+
+html ---- results are added inside of a #+BEGIN_HTML block. This
+ is a good option if you code block will output html
+ formatted text.
+
+latex --- results are added inside of a #+BEGIN_LATEX block.
+ This is a good option if you code block will output
+ latex formatted text.
+
+code ---- the results are extracted in the syntax of the source
+ code of the language being evaluated and are added
+ inside of a #+BEGIN_SRC block with the source-code
+ language set appropriately. Note this relies on the
+ optional LANG argument."
+ (if (stringp result)
+ (progn
+ (setq result (org-no-properties result))
+ (when (member "file" result-params)
+ (setq result (org-babel-result-to-file
+ result (when (assoc :file-desc (nth 2 info))
+ (or (cdr (assoc :file-desc (nth 2 info)))
+ result))))))
+ (unless (listp result) (setq result (format "%S" result))))
+ (if (and result-params (member "silent" result-params))
+ (progn
+ (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ result)
+ (save-excursion
+ (let* ((inlinep
+ (save-excursion
+ (when (or (org-babel-get-inline-src-block-matches)
+ (org-babel-get-lob-one-liner-matches))
+ (goto-char (match-end 0))
+ (insert (if (listp result) "\n" " "))
+ (point))))
+ (existing-result (unless inlinep
+ (org-babel-where-is-src-block-result
+ t info hash indent)))
+ (results-switches
+ (cdr (assoc :results_switches (nth 2 info))))
+ (visible-beg (point-min-marker))
+ (visible-end (point-max-marker))
+ ;; When results exist outside of the current visible
+ ;; region of the buffer, be sure to widen buffer to
+ ;; update them.
+ (outside-scope-p (and existing-result
+ (or (> visible-beg existing-result)
+ (<= visible-end existing-result))))
+ beg end)
+ (when (and (stringp result) ; ensure results end in a newline
+ (not inlinep)
+ (> (length result) 0)
+ (not (or (string-equal (substring result -1) "\n")
+ (string-equal (substring result -1) "\r"))))
+ (setq result (concat result "\n")))
+ (unwind-protect
+ (progn
+ (when outside-scope-p (widen))
+ (if (not existing-result)
+ (setq beg (or inlinep (point)))
+ (goto-char existing-result)
+ (save-excursion
+ (re-search-forward "#" nil t)
+ (setq indent (- (current-column) 1)))
+ (forward-line 1)
+ (setq beg (point))
+ (cond
+ ((member "replace" result-params)
+ (delete-region (point) (org-babel-result-end)))
+ ((member "append" result-params)
+ (goto-char (org-babel-result-end)) (setq beg (point-marker)))
+ ((member "prepend" result-params)))) ; already there
+ (setq results-switches
+ (if results-switches (concat " " results-switches) ""))
+ (let ((wrap (lambda (start finish &optional no-escape)
+ (goto-char end) (insert (concat finish "\n"))
+ (goto-char beg) (insert (concat start "\n"))
+ (unless no-escape
+ (org-escape-code-in-region (min (point) end) end))
+ (goto-char end) (goto-char (point-at-eol))
+ (setq end (point-marker))))
+ (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
+ ;; insert results based on type
+ (cond
+ ;; do nothing for an empty result
+ ((null result))
+ ;; insert a list if preferred
+ ((member "list" result-params)
+ (insert
+ (org-babel-trim
+ (org-list-to-generic
+ (cons 'unordered
+ (mapcar
+ (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
+ (if (listp result) result (split-string result "\n" t))))
+ '(:splicep nil :istart "- " :iend "\n")))
+ "\n"))
+ ;; assume the result is a table if it's not a string
+ ((funcall proper-list-p result)
+ (goto-char beg)
+ (insert (concat (orgtbl-to-orgtbl
+ (if (org-every
+ (lambda (el) (or (listp el) (eq el 'hline)))
+ result)
+ result (list result))
+ '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
+ (goto-char beg) (when (org-at-table-p) (org-table-align)))
+ ((and (listp result) (not (funcall proper-list-p result)))
+ (insert (format "%s\n" result)))
+ ((member "file" result-params)
+ (when inlinep (goto-char inlinep))
+ (insert result))
+ (t (goto-char beg) (insert result)))
+ (when (funcall proper-list-p result) (goto-char (org-table-end)))
+ (setq end (point-marker))
+ ;; possibly wrap result
+ (cond
+ ((assoc :wrap (nth 2 info))
+ (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
+ (funcall wrap (concat "#+BEGIN_" name)
+ (concat "#+END_" (car (org-split-string name))))))
+ ((member "html" result-params)
+ (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
+ ((member "latex" result-params)
+ (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
+ ((member "org" result-params)
+ (goto-char beg) (if (org-at-table-p) (org-cycle))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
+ ((member "code" result-params)
+ (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
+ "#+END_SRC"))
+ ((member "raw" result-params)
+ (goto-char beg) (if (org-at-table-p) (org-cycle)))
+ ((or (member "drawer" result-params)
+ ;; Stay backward compatible with <7.9.2
+ (member "wrap" result-params))
+ (goto-char beg) (if (org-at-table-p) (org-cycle))
+ (funcall wrap ":RESULTS:" ":END:" 'no-escape))
+ ((and (not (funcall proper-list-p result))
+ (not (member "file" result-params)))
+ (org-babel-examplize-region beg end results-switches)
+ (setq end (point)))))
+ ;; possibly indent the results to match the #+results line
+ (when (and (not inlinep) (numberp indent) indent (> indent 0)
+ ;; in this case `table-align' does the work for us
+ (not (and (listp result)
+ (member "append" result-params))))
+ (indent-rigidly beg end indent))
+ (if (null result)
+ (if (member "value" result-params)
+ (message "Code block returned no value.")
+ (message "Code block produced no output."))
+ (message "Code block evaluation complete.")))
+ (when outside-scope-p (narrow-to-region visible-beg visible-end))
+ (set-marker visible-beg nil)
+ (set-marker visible-end nil))))))
+
+(defun org-babel-remove-result (&optional info)
+ "Remove the result of the current source block."
+ (interactive)
+ (let ((location (org-babel-where-is-src-block-result nil info)) start)
+ (when location
+ (setq start (- location 1))
+ (save-excursion
+ (goto-char location) (forward-line 1)
+ (delete-region start (org-babel-result-end))))))
+
+(defun org-babel-result-end ()
+ "Return the point at the end of the current set of results."
+ (save-excursion
+ (cond
+ ((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
+ ((org-at-item-p) (let* ((struct (org-list-struct))
+ (prvs (org-list-prevs-alist struct)))
+ (org-list-get-list-end (point-at-bol) struct prvs)))
+ ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:"))
+ (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
+ (forward-char 1) (point)))
+ (t
+ (let ((case-fold-search t))
+ (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)"))
+ (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
+ nil t)
+ (forward-char 1))
+ (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)")
+ (forward-line 1))))
+ (point)))))
+
+(defun org-babel-result-to-file (result &optional description)
+ "Convert RESULT into an `org-mode' link with optional DESCRIPTION.
+If the `default-directory' is different from the containing
+file's directory then expand relative links."
+ (when (stringp result)
+ (format "[[file:%s]%s]"
+ (if (and default-directory
+ buffer-file-name
+ (not (string= (expand-file-name default-directory)
+ (expand-file-name
+ (file-name-directory buffer-file-name)))))
+ (expand-file-name result default-directory)
+ result)
+ (if description (concat "[" description "]") ""))))
+
+(defvar org-babel-capitalize-examplize-region-markers nil
+ "Make true to capitalize begin/end example markers inserted by code blocks.")
+
+(defun org-babel-examplize-region (beg end &optional results-switches)
+ "Comment out region using the inline `==' or `: ' org example quote."
+ (interactive "*r")
+ (let ((chars-between (lambda (b e)
+ (not (string-match "^[\\s]*$" (buffer-substring b e)))))
+ (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
+ (upcase str) str))))
+ (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
+ (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (save-excursion
+ (goto-char beg)
+ (insert (format org-babel-inline-result-wrap
+ (prog1 (buffer-substring beg end)
+ (delete-region beg end)))))
+ (let ((size (count-lines beg end)))
+ (save-excursion
+ (cond ((= size 0)) ; do nothing for an empty result
+ ((< size org-babel-min-lines-for-block-output)
+ (goto-char beg)
+ (dotimes (n size)
+ (beginning-of-line 1) (insert ": ") (forward-line 1)))
+ (t
+ (goto-char beg)
+ (insert (if results-switches
+ (format "%s%s\n"
+ (funcall maybe-cap "#+begin_example")
+ results-switches)
+ (funcall maybe-cap "#+begin_example\n")))
+ (if (markerp end) (goto-char end) (forward-char (- end beg)))
+ (insert (funcall maybe-cap "#+end_example\n")))))))))
+
+(defun org-babel-update-block-body (new-body)
+ "Update the body of the current code block to NEW-BODY."
+ (if (not (org-babel-where-is-src-block-head))
+ (error "Not in a source block")
+ (save-match-data
+ (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
+ (indent-rigidly (match-beginning 5) (match-end 5) 2)))
+
+(defun org-babel-merge-params (&rest plists)
+ "Combine all parameter association lists in PLISTS.
+Later elements of PLISTS override the values of previous elements.
+This takes into account some special considerations for certain
+parameters when merging lists."
+ (let* ((results-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'results org-babel-common-header-args-w-values))))
+ (exports-exclusive-groups
+ (mapcar (lambda (group) (mapcar #'symbol-name group))
+ (cdr (assoc 'exports org-babel-common-header-args-w-values))))
+ (variable-index 0)
+ (e-merge (lambda (exclusive-groups &rest result-params)
+ ;; maintain exclusivity of mutually exclusive parameters
+ (let (output)
+ (mapc (lambda (new-params)
+ (mapc (lambda (new-param)
+ (mapc (lambda (exclusive-group)
+ (when (member new-param exclusive-group)
+ (mapcar (lambda (excluded-param)
+ (setq output
+ (delete
+ excluded-param
+ output)))
+ exclusive-group)))
+ exclusive-groups)
+ (setq output (org-uniquify
+ (cons new-param output))))
+ new-params))
+ result-params)
+ output)))
+ params results exports tangle noweb cache vars shebang comments padline
+ clearnames)
+
+ (mapc
+ (lambda (plist)
+ (mapc
+ (lambda (pair)
+ (case (car pair)
+ (:var
+ (let ((name (if (listp (cdr pair))
+ (cadr pair)
+ (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
+ (cdr pair))
+ (intern (match-string 1 (cdr pair)))))))
+ (if name
+ (setq vars
+ (append
+ (if (member name (mapcar #'car vars))
+ (progn
+ (push name clearnames)
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (unless (equal (car p) name) p))
+ vars)))
+ vars)
+ (list (cons name pair))))
+ ;; if no name is given and we already have named variables
+ ;; then assign to named variables in order
+ (if (and vars (nth variable-index vars))
+ (let ((name (car (nth variable-index vars))))
+ (push name clearnames) ; clear out colnames
+ ; and rownames
+ ; for replace vars
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" (cdr pair)))
+ (incf variable-index)))
+ (error "Variable \"%s\" must be assigned a default value"
+ (cdr pair))))))
+ (:results
+ (setq results (funcall e-merge results-exclusive-groups
+ results
+ (split-string
+ (let ((r (cdr pair)))
+ (if (stringp r) r (eval r)))))))
+ (:file
+ (when (cdr pair)
+ (setq results (funcall e-merge results-exclusive-groups
+ results '("file")))
+ (unless (or (member "both" exports)
+ (member "none" exports)
+ (member "code" exports))
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports '("results"))))
+ (setq params (cons pair (assq-delete-all (car pair) params)))))
+ (:exports
+ (setq exports (funcall e-merge exports-exclusive-groups
+ exports (split-string (cdr pair)))))
+ (:tangle ;; take the latest -- always overwrite
+ (setq tangle (or (list (cdr pair)) tangle)))
+ (:noweb
+ (setq noweb (funcall e-merge
+ '(("yes" "no" "tangle" "no-export"
+ "strip-export" "eval"))
+ noweb
+ (split-string (or (cdr pair) "")))))
+ (:cache
+ (setq cache (funcall e-merge '(("yes" "no")) cache
+ (split-string (or (cdr pair) "")))))
+ (:padline
+ (setq padline (funcall e-merge '(("yes" "no")) padline
+ (split-string (or (cdr pair) "")))))
+ (:shebang ;; take the latest -- always overwrite
+ (setq shebang (or (list (cdr pair)) shebang)))
+ (:comments
+ (setq comments (funcall e-merge '(("yes" "no")) comments
+ (split-string (or (cdr pair) "")))))
+ (t ;; replace: this covers e.g. :session
+ (setq params (cons pair (assq-delete-all (car pair) params))))))
+ plist))
+ plists)
+ (setq vars (reverse vars))
+ (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
+ ;; clear out col-names and row-names for replaced variables
+ (mapc
+ (lambda (name)
+ (mapc
+ (lambda (param)
+ (when (assoc param params)
+ (setf (cdr (assoc param params))
+ (org-remove-if (lambda (pair) (equal (car pair) name))
+ (cdr (assoc param params))))
+ (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params))))
+ (list :colname-names :rowname-names)))
+ clearnames)
+ (mapc
+ (lambda (hd)
+ (let ((key (intern (concat ":" (symbol-name hd))))
+ (val (eval hd)))
+ (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
+ '(results exports tangle noweb padline cache shebang comments))
+ params))
+
+(defvar org-babel-use-quick-and-dirty-noweb-expansion nil
+ "Set to true to use regular expressions to expand noweb references.
+This results in much faster noweb reference expansion but does
+not properly allow code blocks to inherit the \":noweb-ref\"
+header argument from buffer or subtree wide properties.")
+
+(defun org-babel-noweb-p (params context)
+ "Check if PARAMS require expansion in CONTEXT.
+CONTEXT may be one of :tangle, :export or :eval."
+ (let* (intersect
+ (intersect (lambda (as bs)
+ (when as
+ (if (member (car as) bs)
+ (car as)
+ (funcall intersect (cdr as) bs))))))
+ (funcall intersect (case context
+ (:tangle '("yes" "tangle" "no-export" "strip-export"))
+ (:eval '("yes" "no-export" "strip-export" "eval"))
+ (:export '("yes")))
+ (split-string (or (cdr (assoc :noweb params)) "")))))
+
+(defun org-babel-expand-noweb-references (&optional info parent-buffer)
+ "Expand Noweb references in the body of the current source code block.
+
+For example the following reference would be replaced with the
+body of the source-code block named `example-block'.
+
+<<example-block>>
+
+Note that any text preceding the <<foo>> construct on a line will
+be interposed between the lines of the replacement text. So for
+example if <<foo>> is placed behind a comment, then the entire
+replacement text will also be commented.
+
+This function must be called from inside of the buffer containing
+the source-code block which holds BODY.
+
+In addition the following syntax can be used to insert the
+results of evaluating the source-code block named `example-block'.
+
+<<example-block()>>
+
+Any optional arguments can be passed to example-block by placing
+the arguments inside the parenthesis following the convention
+defined by `org-babel-lob'. For example
+
+<<example-block(a=9)>>
+
+would set the value of argument \"a\" equal to \"9\". Note that
+these arguments are not evaluated in the current source-code
+block but are passed literally to the \"example-block\"."
+ (let* ((parent-buffer (or parent-buffer (current-buffer)))
+ (info (or info (org-babel-get-src-block-info 'light)))
+ (lang (nth 0 info))
+ (body (nth 1 info))
+ (ob-nww-start org-babel-noweb-wrap-start)
+ (ob-nww-end org-babel-noweb-wrap-end)
+ (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
+ (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
+ ":noweb-ref[ \t]+" "\\)"))
+ (new-body "")
+ (nb-add (lambda (text) (setq new-body (concat new-body text))))
+ (c-wrap (lambda (text)
+ (with-temp-buffer
+ (funcall (intern (concat lang "-mode")))
+ (comment-region (point) (progn (insert text) (point)))
+ (org-babel-trim (buffer-string)))))
+ index source-name evaluate prefix)
+ (with-temp-buffer
+ (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
+ (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
+ (insert body) (goto-char (point-min))
+ (setq index (point))
+ (while (and (re-search-forward (org-babel-noweb-wrap) nil t))
+ (save-match-data (setf source-name (match-string 1)))
+ (save-match-data (setq evaluate (string-match "(.*)" source-name)))
+ (save-match-data
+ (setq prefix
+ (buffer-substring (match-beginning 0)
+ (save-excursion
+ (beginning-of-line 1) (point)))))
+ ;; add interval to new-body (removing noweb reference)
+ (goto-char (match-beginning 0))
+ (funcall nb-add (buffer-substring index (point)))
+ (goto-char (match-end 0))
+ (setq index (point))
+ (funcall
+ nb-add
+ (with-current-buffer parent-buffer
+ (save-restriction
+ (widen)
+ (mapconcat ;; Interpose PREFIX between every line.
+ #'identity
+ (split-string
+ (if evaluate
+ (let ((raw (org-babel-ref-resolve source-name)))
+ (if (stringp raw) raw (format "%S" raw)))
+ (or
+ ;; Retrieve from the library of babel.
+ (nth 2 (assoc (intern source-name)
+ org-babel-library-of-babel))
+ ;; Return the contents of headlines literally.
+ (save-excursion
+ (when (org-babel-ref-goto-headline-id source-name)
+ (org-babel-ref-headline-body)))
+ ;; Find the expansion of reference in this buffer.
+ (let ((rx (concat rx-prefix source-name "[ \t\n]"))
+ expansion)
+ (save-excursion
+ (goto-char (point-min))
+ (if org-babel-use-quick-and-dirty-noweb-expansion
+ (while (re-search-forward rx nil t)
+ (let* ((i (org-babel-get-src-block-info 'light))
+ (body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion (cons sep (cons full expansion)))))
+ (org-babel-map-src-blocks nil
+ (let ((i (org-babel-get-src-block-info 'light)))
+ (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (nth 4 i))
+ source-name)
+ (let* ((body (org-babel-expand-noweb-references i))
+ (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ "\n"))
+ (full (if comment
+ (let ((cs (org-babel-tangle-comment-links i)))
+ (concat (funcall c-wrap (car cs)) "\n"
+ body "\n"
+ (funcall c-wrap (cadr cs))))
+ body)))
+ (setq expansion
+ (cons sep (cons full expansion)))))))))
+ (and expansion
+ (mapconcat #'identity (nreverse (cdr expansion)) "")))
+ ;; Possibly raise an error if named block doesn't exist.
+ (if (member lang org-babel-noweb-error-langs)
+ (error "%s" (concat
+ (org-babel-noweb-wrap source-name)
+ "could not be resolved (see "
+ "`org-babel-noweb-error-langs')"))
+ "")))
+ "[\n\r]") (concat "\n" prefix))))))
+ (funcall nb-add (buffer-substring index (point-max))))
+ new-body))
+
+(defun org-babel-script-escape (str &optional force)
+ "Safely convert tables into elisp lists."
+ (let ((escaped
+ (if (or force
+ (and (stringp str)
+ (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1))))))
+ (org-babel-read
+ (concat
+ "'"
+ (let (in-single in-double out)
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (case ch
+ (91 (if (or in-double in-single) ; [
+ (cons 91 out)
+ (cons 40 out)))
+ (93 (if (or in-double in-single) ; ]
+ (cons 93 out)
+ (cons 41 out)))
+ (123 (if (or in-double in-single) ; {
+ (cons 123 out)
+ (cons 40 out)))
+ (125 (if (or in-double in-single) ; }
+ (cons 125 out)
+ (cons 41 out)))
+ (44 (if (or in-double in-single) ; ,
+ (cons 44 out) (cons 32 out)))
+ (39 (if in-double ; '
+ (cons 39 out)
+ (setq in-single (not in-single)) (cons 34 out)))
+ (34 (if in-single ; "
+ (append (list 34 32) out)
+ (setq in-double (not in-double)) (cons 34 out)))
+ (t (cons ch out)))))
+ (string-to-list str))
+ (apply #'string (reverse out)))))
+ str)))
+ (condition-case nil (org-babel-read escaped) (error escaped))))
+
+(defun org-babel-read (cell &optional inhibit-lisp-eval)
+ "Convert the string value of CELL to a number if appropriate.
+Otherwise if cell looks like lisp (meaning it starts with a
+\"(\", \"\\='\", \"\\=`\" or a \"[\") then read it as lisp,
+otherwise return it unmodified as a string. Optional argument
+NO-LISP-EVAL inhibits lisp evaluation for situations in which is
+it not appropriate."
+ (if (and (stringp cell) (not (equal cell "")))
+ (or (org-babel-number-p cell)
+ (if (and (not inhibit-lisp-eval)
+ (or (member (substring cell 0 1) '("(" "'" "`" "["))
+ (string= cell "*this*")))
+ (eval (read cell))
+ (if (string= (substring cell 0 1) "\"")
+ (read cell)
+ (progn (set-text-properties 0 (length cell) nil cell) cell))))
+ cell))
+
+(defun org-babel-number-p (string)
+ "If STRING represents a number return its value."
+ (if (and (string-match "[0-9]+" string)
+ (string-match "^-?[0-9]*\\.?[0-9]*$" string)
+ (= (length (substring string (match-beginning 0)
+ (match-end 0)))
+ (length string)))
+ (string-to-number string)))
+
+(defun org-babel-import-elisp-from-file (file-name &optional separator)
+ "Read the results located at FILE-NAME into an elisp table.
+If the table is trivial, then return it as a scalar."
+ (let (result)
+ (save-window-excursion
+ (with-temp-buffer
+ (condition-case err
+ (progn
+ (org-table-import file-name separator)
+ (delete-file file-name)
+ (setq result (mapcar (lambda (row)
+ (mapcar #'org-babel-string-read row))
+ (org-table-to-lisp))))
+ (error (message "Error reading results: %s" err) nil)))
+ (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
+ (if (consp (car result))
+ (if (null (cdr (car result)))
+ (caar result)
+ result)
+ (car result))
+ result))))
+
+(defun org-babel-string-read (cell)
+ "Strip nested \"s from around strings."
+ (org-babel-read (or (and (stringp cell)
+ (string-match "\\\"\\(.+\\)\\\"" cell)
+ (match-string 1 cell))
+ cell) t))
+
+(defun org-babel-chomp (string &optional regexp)
+ "Strip trailing spaces and carriage returns from STRING.
+Default regexp used is \"[ \f\t\n\r\v]\" but can be
+overwritten by specifying a regexp as a second argument."
+ (let ((regexp (or regexp "[ \f\t\n\r\v]")))
+ (while (and (> (length string) 0)
+ (string-match regexp (substring string -1)))
+ (setq string (substring string 0 -1)))
+ string))
+
+(defun org-babel-trim (string &optional regexp)
+ "Strip leading and trailing spaces and carriage returns from STRING.
+Like `org-babel-chomp' only it runs on both the front and back
+of the string."
+ (org-babel-chomp (org-reverse-string
+ (org-babel-chomp (org-reverse-string string) regexp))
+ regexp))
+
+(defun org-babel-tramp-handle-call-process-region
+ (start end program &optional delete buffer display &rest args)
+ "Use Tramp to handle `call-process-region'.
+Fixes a bug in `tramp-handle-call-process-region'."
+ (if (and (featurep 'tramp) (file-remote-p default-directory))
+ (let ((tmpfile (tramp-compat-make-temp-file "")))
+ (write-region start end tmpfile)
+ (when delete (delete-region start end))
+ (unwind-protect
+ ;; (apply 'call-process program tmpfile buffer display args)
+ ;; bug in tramp
+ (apply 'process-file program tmpfile buffer display args)
+ (delete-file tmpfile)))
+ ;; org-babel-call-process-region-original is the original emacs
+ ;; definition. It is in scope from the let binding in
+ ;; org-babel-execute-src-block
+ (apply org-babel-call-process-region-original
+ start end program delete buffer display args)))
+
+(defun org-babel-local-file-name (file)
+ "Return the local name component of FILE."
+ (if (file-remote-p file)
+ (let (localname)
+ (with-parsed-tramp-file-name file nil
+ localname))
+ file))
+
+(defun org-babel-process-file-name (name &optional no-quote-p)
+ "Prepare NAME to be used in an external process.
+If NAME specifies a remote location, the remote portion of the
+name is removed, since in that case the process will be executing
+remotely. The file name is then processed by `expand-file-name'.
+Unless second argument NO-QUOTE-P is non-nil, the file name is
+additionally processed by `shell-quote-argument'"
+ (let ((f (expand-file-name (org-babel-local-file-name name))))
+ (if no-quote-p f (shell-quote-argument f))))
+
+(defvar org-babel-temporary-directory)
+(unless (or noninteractive (boundp 'org-babel-temporary-directory))
+ (defvar org-babel-temporary-directory
+ (or (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory)
+ org-babel-temporary-directory)
+ (make-temp-file "babel-" t))
+ "Directory to hold temporary files created to execute code blocks.
+Used by `org-babel-temp-file'. This directory will be removed on
+Emacs shutdown."))
+
+(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
+ "Call the code to parse raw string results according to RESULT-PARAMS."
+ (declare (indent 1)
+ (debug (form form &rest form)))
+ (org-with-gensyms (params)
+ `(let ((,params ,result-params))
+ (unless (member "none" ,params)
+ (if (or (member "scalar" ,params)
+ (member "verbatim" ,params)
+ (member "html" ,params)
+ (member "code" ,params)
+ (member "pp" ,params)
+ (and (or (member "output" ,params)
+ (member "raw" ,params)
+ (member "org" ,params)
+ (member "drawer" ,params))
+ (not (member "table" ,params))))
+ ,scalar-form
+ ,@table-forms)))))
+(def-edebug-spec org-babel-result-cond (form form body))
+
+(defun org-babel-temp-file (prefix &optional suffix)
+ "Create a temporary file in the `org-babel-temporary-directory'.
+Passes PREFIX and SUFFIX directly to `make-temp-file' with the
+value of `temporary-file-directory' temporarily set to the value
+of `org-babel-temporary-directory'."
+ (if (file-remote-p default-directory)
+ (let ((prefix
+ (concat (file-remote-p default-directory)
+ (expand-file-name prefix temporary-file-directory))))
+ (make-temp-file prefix nil suffix))
+ (let ((temporary-file-directory
+ (or (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory)
+ org-babel-temporary-directory)
+ temporary-file-directory)))
+ (make-temp-file prefix nil suffix))))
+
+(defun org-babel-remove-temporary-directory ()
+ "Remove `org-babel-temporary-directory' on Emacs shutdown."
+ (when (and (boundp 'org-babel-temporary-directory)
+ (file-exists-p org-babel-temporary-directory))
+ ;; taken from `delete-directory' in files.el
+ (condition-case nil
+ (progn
+ (mapc (lambda (file)
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (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
+ "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+ (delete-directory org-babel-temporary-directory))
+ (error
+ (message "Failed to remove temporary Org-babel directory %s"
+ (if (boundp 'org-babel-temporary-directory)
+ org-babel-temporary-directory
+ "[directory not defined]"))))))
+
+(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+
+(provide 'ob-core)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ob-core.el ends here
diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el
index a1205f5919e..a0f0ad1394a 100644
--- a/lisp/org/ob-css.el
+++ b/lisp/org/ob-css.el
@@ -1,6 +1,6 @@
;;; ob-css.el --- org-babel functions for css evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el
index d6bbbbce3a8..dbf63f1064c 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -1,6 +1,6 @@
;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -34,22 +34,43 @@
;; 3) we are adding the "file" and "cmdline" header arguments
;;
;; 4) there are no variables (at least for now)
-;;
-;; 5) it depends on a variable defined in org-exp-blocks (namely
-;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded
;;; Code:
(require 'ob)
(require 'org-compat)
-(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks
-
(defvar org-babel-default-header-args:ditaa
'((:results . "file")
(:exports . "results")
(:java . "-Dfile.encoding=UTF-8"))
"Default arguments for evaluating a ditaa source block.")
+(defcustom org-ditaa-jar-path (expand-file-name
+ "ditaa.jar"
+ (file-name-as-directory
+ (expand-file-name
+ "scripts"
+ (file-name-as-directory
+ (expand-file-name
+ "../contrib"
+ (file-name-directory (org-find-library-dir "org")))))))
+ "Path to the ditaa jar executable."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-ditaa-java-cmd "java"
+ "Java executable to use when evaluating ditaa blocks."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-ditaa-eps-jar-path
+ (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path))
+ "Path to the DitaaEps.jar executable."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defcustom org-ditaa-jar-option "-jar"
"Option for the ditaa jar file.
Do not leave leading or trailing spaces in this string."
@@ -61,24 +82,33 @@ Do not leave leading or trailing spaces in this string."
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file ((lambda (el)
- (or el
- (error
- "ditaa code block requires :file header argument")))
- (cdr (assoc :file params))))
+ (out-file (let ((el (cdr (assoc :file params))))
+ (or el
+ (error
+ "ditaa code block requires :file header argument"))))
(cmdline (cdr (assoc :cmdline params)))
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
- (cmd (concat "java " java " " org-ditaa-jar-option " "
+ (eps (cdr (assoc :eps params)))
+ (cmd (concat org-babel-ditaa-java-cmd
+ " " java " " org-ditaa-jar-option " "
(shell-quote-argument
- (expand-file-name org-ditaa-jar-path))
+ (expand-file-name
+ (if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
" " cmdline
" " (org-babel-process-file-name in-file)
- " " (org-babel-process-file-name out-file))))
+ " " (org-babel-process-file-name out-file)))
+ (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
+ (cdr (assoc :pdf params))))
+ (concat
+ "epstopdf"
+ " " (org-babel-process-file-name (concat in-file ".eps"))
+ " -o=" (org-babel-process-file-name out-file)))))
(unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))
(message cmd) (shell-command cmd)
+ (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd))
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:ditaa (session params)
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index b5e78802b2d..f4953a39eac 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -1,6 +1,6 @@
;;; ob-dot.el --- org-babel functions for dot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:dot
'((:results . "file") (:exports . "results"))
@@ -54,7 +53,7 @@
(value (cdr pair)))
(setq body
(replace-regexp-in-string
- (concat "\$" (regexp-quote name))
+ (concat "$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el
index d6073ca8ef9..f8611944820 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -1,6 +1,6 @@
;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -27,7 +27,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:emacs-lisp
'((:hlines . "yes") (:colnames . "no"))
@@ -55,23 +54,26 @@
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
- ((lambda (result)
- (if (or (member "scalar" (cdr (assoc :result-params params)))
- (member "verbatim" (cdr (assoc :result-params params))))
- (let ((print-level nil)
- (print-length nil))
- (format "%S" result))
- (org-babel-reassemble-table
- result
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
- (eval (read (format (if (member "output"
- (cdr (assoc :result-params params)))
- "(with-output-to-string %s)"
- "(progn %s)")
- (org-babel-expand-body:emacs-lisp body params)))))))
+ (let ((result
+ (eval (read (format (if (member "output"
+ (cdr (assoc :result-params params)))
+ "(with-output-to-string %s)"
+ "(progn %s)")
+ (org-babel-expand-body:emacs-lisp
+ body params))))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (let ((print-level nil)
+ (print-length nil))
+ (if (or (member "scalar" (cdr (assoc :result-params params)))
+ (member "verbatim" (cdr (assoc :result-params params))))
+ (format "%S" result)
+ (format "%s" result)))
+ (org-babel-reassemble-table
+ result
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params))))))))
(provide 'ob-emacs-lisp)
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index 22d2bcf288e..112525c34f4 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -1,6 +1,6 @@
;;; ob-eval.el --- org-babel functions for external code evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, comint
@@ -27,6 +27,7 @@
;; shell commands.
;;; Code:
+(require 'org-macs)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
@@ -50,8 +51,8 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer
(insert body)
(setq exit-code
- (org-babel-shell-command-on-region
- (point-min) (point-max) cmd t 'replace err-buff))
+ (org-babel--shell-command-on-region
+ (point-min) (point-max) cmd err-buff))
(if (or (not (numberp exit-code)) (> exit-code 0))
(progn
(with-current-buffer err-buff
@@ -64,79 +65,15 @@ STDERR with `org-babel-eval-error-notify'."
(with-temp-buffer (insert-file-contents file)
(buffer-string)))
-(defun org-babel-shell-command-on-region (start end command
- &optional output-buffer replace
- error-buffer display-error-buffer)
+(defun org-babel--shell-command-on-region (start end command error-buffer)
"Execute COMMAND in an inferior shell with region as input.
-Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region'
-
-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.
-
-To specify a coding system for converting non-ASCII characters in
-the input and output to the shell command, use
-\\[universal-coding-system-argument] before this command. By
-default, the input (from the current buffer) is encoded in the
-same coding system that will be used to save the file,
-`buffer-file-coding-system'. If the output is going to replace
-the region, then it is decoded from that same coding system.
-
-The noninteractive arguments are START, END, COMMAND,
-OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
-Noninteractive callers can specify coding systems by binding
-`coding-system-for-read' and `coding-system-for-write'.
-
-If the command generates output, the output may be displayed
-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*'. The output
-is available in that buffer in both cases.
-
-If there is output and an error, a message about the error
-appears at the end of the output.
-
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in the current buffer.
-In either case, the output is inserted after point (leaving mark after it).
-
-If REPLACE, the optional fifth argument, is non-nil, that means insert
-the output in place of text from START to END, putting point and mark
-around it.
-
-If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
-or buffer name to which to direct the command's standard error output.
-If it is nil, error output is mingled with regular output.
-If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
-were any errors. (This is always t, interactively.)
-In an interactive call, the variable `shell-command-default-error-buffer'
-specifies the value of ERROR-BUFFER."
- (interactive (let (string)
- (unless (mark)
- (error "The mark is not set now, so there is no region"))
- ;; Do this before calling region-beginning
- ;; and region-end, in case subprocess output
- ;; relocates them while we are in the minibuffer.
- (setq string (read-shell-command "Shell command on region: "))
- ;; call-interactively recognizes region-beginning and
- ;; region-end specially, leaving them in the history.
- (list (region-beginning) (region-end)
- string
- current-prefix-arg
- current-prefix-arg
- shell-command-default-error-buffer
- t)))
- (let ((input-file (org-babel-temp-file "input-"))
- (error-file (if error-buffer (org-babel-temp-file "scor-") nil))
+Stripped down version of shell-command-on-region for internal use
+in Babel only. This lets us work around errors in the original
+function in various versions of Emacs.
+"
+ (let ((input-file (org-babel-temp-file "ob-input-"))
+ (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil))
;; Unfortunately, `executable-find' does not support file name
;; handlers. Therefore, we could use it in the local case
;; only.
@@ -154,96 +91,26 @@ specifies the value of ERROR-BUFFER."
;; workaround for now.
(unless (file-remote-p default-directory)
(delete-file error-file))
- (if (or replace
- (and output-buffer
- (not (or (bufferp output-buffer) (stringp output-buffer)))))
- ;; Replace specified region with output from command.
- (let ((swap (and replace (< start end))))
- ;; Don't muck with mark unless REPLACE says we should.
- (goto-char start)
- (and replace (push-mark (point) 'nomsg))
- (write-region start end input-file)
- (delete-region start end)
- (setq exit-status
- (process-file shell-file-name input-file
- (if error-file
- (list output-buffer error-file)
- t)
- nil shell-command-switch command))
- ;; It is rude to delete a buffer which the command is not using.
- ;; (let ((shell-buffer (get-buffer "*Shell Command Output*")))
- ;; (and shell-buffer (not (eq shell-buffer (current-buffer)))
- ;; (kill-buffer shell-buffer)))
- ;; Don't muck with mark unless REPLACE says we should.
- (and replace swap (exchange-point-and-mark)))
- ;; 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*"))))
- (unwind-protect
- (if (eq buffer (current-buffer))
- ;; If the input is the same buffer as the output,
- ;; delete everything but the specified region,
- ;; then replace that region with the output.
- (progn (setq buffer-read-only nil)
- (delete-region (max start end) (point-max))
- (delete-region (point-min) (min start end))
- (write-region (point-min) (point-max) input-file)
- (delete-region (point-min) (point-max))
- (setq exit-status
- (process-file shell-file-name input-file
- (if error-file
- (list t error-file)
- t)
- nil shell-command-switch command)))
- ;; Clear the output buffer, then run the command with
- ;; output there.
- (let ((directory default-directory))
- (with-current-buffer buffer
- (setq buffer-read-only nil)
- (if (not output-buffer)
- (setq default-directory directory))
- (erase-buffer)))
- (setq exit-status
- (process-file shell-file-name nil
- (if error-file
- (list buffer error-file)
- buffer)
- nil shell-command-switch command)))
- ;; Report the output.
- (with-current-buffer buffer
- (setq mode-line-process
- (cond ((null exit-status)
- " - Error")
- ((stringp exit-status)
- (format " - Signal [%s]" exit-status))
- ((not (equal 0 exit-status))
- (format " - Exit [%d]" exit-status)))))
- (if (with-current-buffer buffer (> (point-max) (point-min)))
- ;; There's some output, display it
- (display-message-or-buffer buffer)
- ;; No output; error?
- (let ((output
- (if (and error-file
- (< 0 (nth 7 (file-attributes error-file))))
- "some error output"
- "no output")))
- (cond ((null exit-status)
- (message "(Shell command failed with error)"))
- ((equal 0 exit-status)
- (message "(Shell command succeeded with %s)"
- output))
- ((stringp exit-status)
- (message "(Shell command killed by signal %s)"
- exit-status))
- (t
- (message "(Shell command failed with code %d and %s)"
- exit-status output))))
- ;; Don't kill: there might be useful info in the undo-log.
- ;; (kill-buffer buffer)
- ))))
-
- (when (and input-file (file-exists-p input-file))
+ ;; we always call this with 'replace, remove conditional
+ ;; Replace specified region with output from command.
+ (let ((swap (< start end)))
+ (goto-char start)
+ (push-mark (point) 'nomsg)
+ (write-region start end input-file)
+ (delete-region start end)
+ (setq exit-status
+ (process-file shell-file-name input-file
+ (if error-file
+ (list t error-file)
+ t)
+ nil shell-command-switch command))
+ (when swap (exchange-point-and-mark)))
+
+ (when (and input-file (file-exists-p input-file)
+ ;; bind org-babel--debug-input around the call to keep
+ ;; the temporary input files available for inspection
+ (not (when (boundp 'org-babel--debug-input)
+ org-babel--debug-input)))
(delete-file input-file))
(when (and error-file (file-exists-p error-file))
@@ -258,8 +125,7 @@ specifies the value of ERROR-BUFFER."
(format-insert-file error-file nil)
;; Put point after the inserted errors.
(goto-char (- (point-max) pos-from-end)))
- (and display-error-buffer
- (display-buffer (current-buffer)))))
+ (current-buffer)))
(delete-file error-file))
exit-status))
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index 37a9f71cf59..92006f81756 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -1,6 +1,6 @@
;;; ob-exp.el --- Exportation of org-babel source blocks
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -23,8 +23,8 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-(require 'ob)
-(require 'org-exp-blocks)
+(require 'ob-core)
+(require 'org-src)
(eval-when-compile
(require 'cl))
@@ -35,23 +35,31 @@
(declare-function org-babel-lob-get-info "ob-lob" ())
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
+(declare-function org-between-regexps-p "org"
+ (start-re end-re &optional lim-up lim-down))
+(declare-function org-get-indentation "org" (&optional line))
(declare-function org-heading-components "org" ())
+(declare-function org-in-block-p "org" (names))
+(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
(declare-function org-fill-template "org" (template alist))
-(declare-function org-in-verbatim-emphasis "org" ())
-(declare-function org-in-block-p "org" (names))
-(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down))
-
-(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
-(org-export-blocks-add-block '(src org-babel-exp-src-block nil))
+(declare-function org-split-string "org" (string &optional separators))
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-context "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-escape-code-in-string "org-src" (s))
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
When set to nil no code will be evaluated as part of the export
-process."
+process. When set to 'inline-only, only inline code blocks will
+be executed."
:group 'org-babel
:version "24.1"
- :type 'boolean)
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "Only inline code" inline-only)
+ (const :tag "Always" t)))
(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
(defun org-babel-exp-get-export-buffer ()
@@ -62,6 +70,8 @@ process."
('otherwise
(error "Requested export buffer when `org-current-export-file' is nil"))))
+(defvar org-link-search-inhibit-query)
+
(defmacro org-babel-exp-in-export-file (lang &rest body)
(declare (indent 1))
`(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
@@ -86,10 +96,10 @@ process."
results)))
(def-edebug-spec org-babel-exp-in-export-file (form body))
-(defun org-babel-exp-src-block (body &rest headers)
+(defun org-babel-exp-src-block (&rest headers)
"Process source block for export.
-Depending on the 'export' headers argument in replace the source
-code block with...
+Depending on the `export' headers argument, replace the source
+code block like this:
both ---- display the code and the results
@@ -99,11 +109,12 @@ code ---- the default, display the code inside the block but do
results - just like none only the block is run on export ensuring
that it's results are present in the org-mode buffer
-none ----- do not display either code or results upon export"
+none ---- do not display either code or results upon export
+
+Assume point is at the beginning of block's starting line."
(interactive)
(unless noninteractive (message "org-babel-exp processing..."))
(save-excursion
- (goto-char (match-beginning 0))
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
(raw-params (nth 2 info)) hash)
@@ -114,11 +125,11 @@ none ----- do not display either code or results upon export"
(org-babel-exp-in-export-file lang
(setf (nth 2 info)
(org-babel-process-params
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- raw-params))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append (org-babel-params-from-properties lang)
+ (list raw-params))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
@@ -140,75 +151,138 @@ this template."
:type 'string)
(defvar org-babel-default-lob-header-args)
-(defun org-babel-exp-non-block-elements (start end)
- "Process inline source and call lines between START and END for export."
+(defun org-babel-exp-process-buffer ()
+ "Execute all Babel blocks in current buffer."
(interactive)
- (save-excursion
- (goto-char start)
- (unless (markerp end)
- (let ((m (make-marker)))
- (set-marker m end (current-buffer))
- (setq end m)))
- (let ((rx (concat "\\(" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)")))
- (while (and (< (point) (marker-position end))
- (re-search-forward rx end t))
- (if (save-excursion
- (goto-char (match-beginning 0))
- (looking-at org-babel-inline-src-block-regexp))
- (progn
- (forward-char 1)
- (let* ((info (save-match-data
- (org-babel-parse-inline-src-block-match)))
- (params (nth 2 info)))
- (save-match-data
- (goto-char (match-beginning 2))
- (unless (org-babel-in-example-or-verbatim)
- ;; expand noweb references in the original file
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
- (nth 1 info)))
- (let ((code-replacement (save-match-data
- (org-babel-exp-do-export
- info 'inline))))
- (if code-replacement
- (progn (replace-match code-replacement nil nil nil 1)
- (delete-char 1))
- (org-babel-examplize-region (match-beginning 1)
- (match-end 1))
- (forward-char 2)))))))
- (unless (org-babel-in-example-or-verbatim)
- (let* ((lob-info (org-babel-lob-get-info))
- (inlinep (match-string 11))
- (inline-start (match-end 11))
- (inline-end (match-end 0))
- (results (save-match-data
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
+ (save-window-excursion
+ (save-excursion
+ (let ((case-fold-search t)
+ (regexp (concat org-babel-inline-src-block-regexp "\\|"
+ org-babel-lob-one-liner-regexp "\\|"
+ "^[ \t]*#\\+BEGIN_SRC")))
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let* ((element (save-excursion
+ ;; If match is inline, point is at its
+ ;; end. Move backward so
+ ;; `org-element-context' can get the
+ ;; object, not the following one.
+ (backward-char)
+ (save-match-data (org-element-context))))
+ (type (org-element-type element))
+ (begin (copy-marker (org-element-property :begin element)))
+ (end (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (case type
+ (inline-src-block
+ (let* ((info (org-babel-parse-inline-src-block-match))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assoc :noweb params))
+ (string= "yes" (cdr (assoc :noweb params))))
+ (org-babel-expand-noweb-references
+ info (org-babel-exp-get-export-buffer))
+ (nth 1 info)))
+ (goto-char begin)
+ (let ((replacement (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove inline src
+ ;; block, including extra white space that
+ ;; might have been created when inserting
+ ;; results.
+ (delete-region begin
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then insert
+ ;; value.
+ (delete-region begin end)
+ (insert replacement)))))
+ ((babel-call inline-babel-call)
+ (let* ((lob-info (org-babel-lob-get-info))
+ (results
+ (org-babel-exp-do-export
+ (list "emacs-lisp" "results"
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (append
(org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat #'identity
- (butlast lob-info)
- " ")))))
- "" nil (car (last lob-info)))
- 'lob)))
- (rep (org-fill-template
- org-babel-exp-call-line-template
- `(("line" . ,(nth 0 lob-info))))))
- (if inlinep
- (save-excursion
- (goto-char inline-start)
- (delete-region inline-start inline-end)
- (insert rep))
- (replace-match rep t t)))))))))
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat 'identity
+ (butlast lob-info 2)
+ " ")))))))
+ "" (nth 3 lob-info) (nth 2 lob-info))
+ 'lob))
+ (rep (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" . ,(nth 0 lob-info))))))
+ ;; If replacement is empty, completely remove the
+ ;; object/element, including any extra white space
+ ;; that might have been created when including
+ ;; results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t") (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve following white
+ ;; spaces/newlines and then, insert replacement
+ ;; string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (src-block
+ (let* ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-get-indentation))
+ (headers
+ (cons
+ (org-element-property :language element)
+ (let ((params (org-element-property :parameters
+ element)))
+ (and params (org-split-string params "[ \t]+"))))))
+ ;; Take care of matched block: compute replacement
+ ;; string. In particular, a nil REPLACEMENT means
+ ;; the block should be left as-is while an empty
+ ;; string should remove the block.
+ (let ((replacement (progn (goto-char match-start)
+ (org-babel-exp-src-block headers))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (goto-char match-start)
+ (delete-region (point)
+ (save-excursion (goto-char end)
+ (line-end-position)))
+ (insert replacement)
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent
+ element))
+ ;; Indent only the code block markers.
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly match-start (point) ind)))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil)))))))
(defun org-babel-in-example-or-verbatim ()
"Return true if point is in example or verbatim code.
@@ -238,7 +312,7 @@ The function respects the value of the :exports header argument."
(org-babel-exp-code info)))))
(defcustom org-babel-exp-code-template
- "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
+ "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
@@ -248,6 +322,7 @@ and the following %keys may be used.
lang ------ the language of the code block
name ------ the name of the code block
body ------ the body of the code block
+ switches -- the switches associated to the code block
flags ----- the flags passed to the code block
In addition to the keys mentioned above, every header argument
@@ -269,14 +344,15 @@ replaced with its value."
(org-fill-template
org-babel-exp-code-template
`(("lang" . ,(nth 0 info))
- ("body" . ,(if (string= (nth 0 info) "org")
- (replace-regexp-in-string "^" "," (nth 1 info))
- (nth 1 info)))
+ ("body" . ,(org-escape-code-in-string (nth 1 info)))
+ ("switches" . ,(let ((f (nth 3 info)))
+ (and (org-string-nw-p f) (concat " " f))))
+ ("flags" . ,(let ((f (assq :flags (nth 2 info))))
+ (and f (concat " " (cdr f)))))
,@(mapcar (lambda (pair)
(cons (substring (symbol-name (car pair)) 1)
(format "%S" (cdr pair))))
(nth 2 info))
- ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
("name" . ,(or (nth 4 info) "")))))
(defun org-babel-exp-results (info type &optional silent hash)
@@ -285,14 +361,17 @@ Results are prepared in a manner suitable for export by org-mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
- (when (and org-export-babel-evaluate
+ (when (and (or (eq org-export-babel-evaluate t)
+ (and (eq type 'inline)
+ (eq org-export-babel-evaluate 'inline-only)))
(not (and hash (equal hash (org-babel-current-result-hash)))))
(let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
info (org-babel-exp-get-export-buffer))
(nth 1 info)))
- (info (copy-sequence info)))
+ (info (copy-sequence info))
+ (org-babel-current-src-block-location (point-marker)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
@@ -318,10 +397,10 @@ inhibit insertion of results into the buffer."
((equal type 'lob)
(save-excursion
(re-search-backward org-babel-lob-one-liner-regexp nil t)
- (org-babel-execute-src-block nil info)))))))))
-
-(provide 'ob-exp)
+ (let (org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil info))))))))))
+(provide 'ob-exp)
;;; ob-exp.el ends here
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 8d5012fb82d..aab78592806 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -1,6 +1,6 @@
;;; ob-fortran.el --- org-babel functions for fortran
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Authors: Sergey Litvinov
;; Eric Schulte
@@ -28,11 +28,11 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(require 'cc-mode)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
+(declare-function org-every "org" (pred seq))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -60,20 +60,20 @@
(mapconcat 'identity
(if (listp flags) flags (list flags)) " ")
(org-babel-process-file-name tmp-src-file)) ""))))
- ((lambda (results)
- (org-babel-reassemble-table
- (if (member "vector" (cdr (assoc :result-params params)))
- (let ((tmp-file (org-babel-temp-file "f-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file))
- (org-babel-read results))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
+ (let ((results
+ (org-babel-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "f-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
@@ -108,7 +108,7 @@ it's header arguments."
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (if vars (error "Cannot use :vars if 'program' statement is present"))
+ (if vars (error "Cannot use :vars if `program' statement is present"))
body)
(format "program main\n%s\nend program main\n" body)))
@@ -144,12 +144,17 @@ of the same value."
((stringp val)
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
+ ;; val is a matrix
+ ((and (listp val) (org-every #'listp val))
+ (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
+ var (length val) (length (car val))
+ (org-babel-fortran-transform-list val)
+ (length (car val)) (length val)))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (org-babel-fortran-transform-list val)))
(t
- (error (format "the type of parameter %s is not supported by ob-fortran"
- var))))))
+ (error "the type of parameter %s is not supported by ob-fortran" var)))))
(defun org-babel-fortran-transform-list (val)
"Return a fortran representation of enclose syntactic lists."
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 488d2508e6d..da7a398e78f 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -1,6 +1,6 @@
;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -39,8 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
(eval-when-compile (require 'cl))
(declare-function org-time-string-to-time "org" (s))
@@ -54,77 +52,122 @@
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
+(defvar org-babel-header-args:gnuplot
+ '((title . :any)
+ (lines . :any)
+ (sets . :any)
+ (x-labels . :any)
+ (y-labels . :any)
+ (timefmt . :any)
+ (time-ind . :any)
+ (missing . :any)
+ (term . :any))
+ "Gnuplot specific header args.")
+
(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar *org-babel-gnuplot-missing* nil)
+
+(defcustom *org-babel-gnuplot-terms*
+ '((eps . "postscript eps"))
+ "List of file extensions and the associated gnuplot terminal."
+ :group 'org-babel
+ :type '(repeat (cons (symbol :tag "File extension")
+ (string :tag "Gnuplot terminal"))))
+
(defun org-babel-gnuplot-process-vars (params)
"Extract variables from PARAMS and process the variables.
Dumps all vectors into files and returns an association list
of variable names and the related value to be used in the gnuplot
code."
- (mapcar
- (lambda (pair)
- (cons
- (car pair) ;; variable name
- (if (listp (cdr pair)) ;; variable value
- (org-babel-gnuplot-table-to-data
- (cdr pair) (org-babel-temp-file "gnuplot-") params)
- (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (mapcar
+ (lambda (pair)
+ (cons
+ (car pair) ;; variable name
+ (let* ((val (cdr pair)) ;; variable value
+ (lp (listp val)))
+ (if lp
+ (org-babel-gnuplot-table-to-data
+ (let* ((first (car val))
+ (tablep (or (listp first) (symbolp first))))
+ (if tablep val (mapcar 'list val)))
+ (org-babel-temp-file "gnuplot-") params)
+ val))))
+ (mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
(out-file (cdr (assoc :file params)))
- (term (or (cdr (assoc :term params))
- (when out-file (file-name-extension out-file))))
+ (prologue (cdr (assoc :prologue params)))
+ (epilogue (cdr (assoc :epilogue params)))
+ (term (or (cdr (assoc :term params))
+ (when out-file
+ (let ((ext (file-name-extension out-file)))
+ (or (cdr (assoc (intern (downcase ext))
+ *org-babel-gnuplot-terms*))
+ ext)))))
(cmdline (cdr (assoc :cmdline params)))
- (title (plist-get params :title))
- (lines (plist-get params :line))
- (sets (plist-get params :set))
- (x-labels (plist-get params :xlabels))
- (y-labels (plist-get params :ylabels))
- (timefmt (plist-get params :timefmt))
- (time-ind (or (plist-get params :timeind)
+ (title (cdr (assoc :title params)))
+ (lines (cdr (assoc :line params)))
+ (sets (cdr (assoc :set params)))
+ (x-labels (cdr (assoc :xlabels params)))
+ (y-labels (cdr (assoc :ylabels params)))
+ (timefmt (cdr (assoc :timefmt params)))
+ (time-ind (or (cdr (assoc :timeind params))
(when timefmt 1)))
+ (missing (cdr (assoc :missing params)))
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
;; append header argument settings to body
- (when title (funcall add-to-body (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
+ (when title (funcall add-to-body (format "set title '%s'" title)))
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
+ (when missing
+ (funcall add-to-body (format "set datafile missing '%s'" missing)))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
(funcall add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(funcall add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(funcall add-to-body "set xdata time")
(funcall add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
- (when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
+ (when out-file
+ ;; set the terminal at the top of the block
+ (funcall add-to-body (format "set output \"%s\"" out-file))
+ ;; and close the terminal at the bottom of the block
+ (setq body (concat body "\nset output\n")))
(when term (funcall add-to-body (format "set term %s" term)))
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
- (funcall add-to-body (mapconcat #'identity
- (org-babel-variable-assignments:gnuplot params)
- "\n"))
+ (funcall add-to-body
+ (mapconcat #'identity
+ (org-babel-variable-assignments:gnuplot params)
+ "\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
- vars))
+ vars)
+ (when prologue (funcall add-to-body prologue))
+ (when epilogue (setq body (concat body "\n" epilogue))))
body))
(defun org-babel-execute:gnuplot (body params)
@@ -201,7 +244,8 @@ then create one. Return the initialized session. The current
(defun org-babel-gnuplot-quote-timestamp-field (s)
"Convert S from timestamp to Unix time and export to gnuplot."
- (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s)))
+ (format-time-string org-babel-gnuplot-timestamp-fmt
+ (org-time-string-to-time s)))
(defvar org-table-number-regexp)
(defvar org-ts-regexp3)
@@ -212,7 +256,12 @@ then create one. Return the initialized session. The current
(if (string-match org-table-number-regexp s) s
(if (string-match org-ts-regexp3 s)
(org-babel-gnuplot-quote-timestamp-field s)
- (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
+ (if (zerop (length s))
+ (or *org-babel-gnuplot-missing* s)
+ (if (string-match "[ \"]" s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"")
+ "\"")
+ s)))))
(defun org-babel-gnuplot-table-to-data (table data-file params)
"Export TABLE to DATA-FILE in a format readable by gnuplot.
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index eca6d829c15..d984a0fe559 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -1,6 +1,6 @@
;;; ob-haskell.el --- org-babel functions for haskell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -40,7 +40,6 @@
;;; Code:
(require 'ob)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -53,7 +52,8 @@
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
-(defvar org-babel-default-header-args:haskell '())
+(defvar org-babel-default-header-args:haskell
+ '((:padlines . "no")))
(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
@@ -79,11 +79,12 @@
(cdr (member org-babel-haskell-eoe
(reverse (mapcar #'org-babel-trim raw)))))))
(org-babel-reassemble-table
- (cond
- ((equal result-type 'output)
- (mapconcat #'identity (reverse (cdr results)) "\n"))
- ((equal result-type 'value)
- (org-babel-haskell-table-or-string (car results))))
+ (let ((result
+ (case result-type
+ (output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ (value (car results)))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result (org-babel-haskell-table-or-string result)))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colname-names params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
@@ -146,9 +147,10 @@ specifying a variable of the same value."
(concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]")
(format "%S" var)))
-(defvar org-src-preserve-indentation)
-(declare-function org-export-as-latex "org-latex"
- (arg &optional ext-plist to-buffer body-only pub-dir))
+(defvar org-export-copy-to-kill-ring)
+(declare-function org-export-to-file "ox"
+ (backend file
+ &optional async subtreep visible-only body-only ext-plist))
(defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting
@@ -192,7 +194,11 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
(save-excursion
;; export to latex w/org and save as .lhs
- (find-file tmp-org-file) (funcall 'org-export-as-latex nil)
+ (require 'ox-latex)
+ (find-file tmp-org-file)
+ ;; Ensure we do not clutter kill ring with incomplete results.
+ (let (org-export-copy-to-kill-ring)
+ (org-export-to-file 'latex tmp-tex-file))
(kill-buffer nil)
(delete-file tmp-org-file)
(find-file tmp-tex-file)
diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el
index d4686a98eee..25e012de604 100644
--- a/lisp/org/ob-io.el
+++ b/lisp/org/ob-io.el
@@ -1,6 +1,6 @@
;;; ob-io.el --- org-babel functions for Io evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
@@ -33,9 +33,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -97,12 +94,11 @@ in BODY as elisp."
(value (let* ((src-file (org-babel-temp-file "io-"))
(wrapper (format org-babel-io-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
- ((lambda (raw)
- (if (member "code" result-params)
- raw
- (org-babel-io-table-or-string raw)))
- (org-babel-eval
- (concat org-babel-io-command " " src-file) ""))))))
+ (let ((raw (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-io-table-or-string raw)))))))
(defun org-babel-prep-session:io (session params)
diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el
index 96128ed1520..660262e7e43 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -1,6 +1,6 @@
;;; ob-java.el --- org-babel functions for java evaluation
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
@@ -56,19 +55,18 @@
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
- ((lambda (results)
- (org-babel-reassemble-table
- (if (member "vector" (cdr (assoc :result-params params)))
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file))
- (org-babel-read results))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- (org-babel-eval (concat org-babel-java-command
- " " cmdline " " classname) ""))))
+ (let ((results (org-babel-eval (concat org-babel-java-command
+ " " cmdline " " classname) "")))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "c-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
(provide 'ob-java)
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index 4e4c3abfa15..8d0cf7f2a05 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -1,6 +1,6 @@
;;; ob-js.el --- org-babel functions for Javascript
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, js
@@ -39,9 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg))
@@ -68,30 +65,32 @@ This function is called by `org-babel-execute-src-block'"
(let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
(result-type (cdr (assoc :result-type params)))
(full-body (org-babel-expand-body:generic
- body params (org-babel-variable-assignments:js params))))
- (org-babel-js-read
- (if (not (string= (cdr (assoc :session params)) "none"))
- ;; session evaluation
- (let ((session (org-babel-prep-session:js
- (cdr (assoc :session params)) params)))
- (nth 1
- (org-babel-comint-with-output
- (session (format "%S" org-babel-js-eoe) t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (list body (format "%S" org-babel-js-eoe))))))
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "js-script-")))
- (with-temp-file script-file
- (insert
- ;; return the value or the output
- (if (string= result-type "value")
- (format org-babel-js-function-wrapper full-body)
- full-body)))
- (org-babel-eval
- (format "%s %s" org-babel-js-cmd
- (org-babel-process-file-name script-file)) ""))))))
+ body params (org-babel-variable-assignments:js params)))
+ (result (if (not (string= (cdr (assoc :session params)) "none"))
+ ;; session evaluation
+ (let ((session (org-babel-prep-session:js
+ (cdr (assoc :session params)) params)))
+ (nth 1
+ (org-babel-comint-with-output
+ (session (format "%S" org-babel-js-eoe) t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line))
+ (comint-send-input nil t))
+ (list body (format "%S" org-babel-js-eoe))))))
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "js-script-")))
+ (with-temp-file script-file
+ (insert
+ ;; return the value or the output
+ (if (string= result-type "value")
+ (format org-babel-js-function-wrapper full-body)
+ full-body)))
+ (org-babel-eval
+ (format "%s %s" org-babel-js-cmd
+ (org-babel-process-file-name script-file)) "")))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ result (org-babel-js-read result))))
(defun org-babel-js-read (results)
"Convert RESULTS into an appropriate elisp value.
diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el
index 01a54ca87d3..440d8e86127 100644
--- a/lisp/org/ob-keys.el
+++ b/lisp/org/ob-keys.el
@@ -1,6 +1,6 @@
;;; ob-keys.el --- key bindings for org-babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -29,7 +29,7 @@
;; functions and their associated keys.
;;; Code:
-(require 'ob)
+(require 'ob-core)
(defvar org-babel-key-prefix "\C-c\C-v"
"The key prefix for Babel interactive key-bindings.
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index 104f971c678..811c9ef92c6 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -1,6 +1,6 @@
;;; ob-latex.el --- org-babel functions for latex "evaluation"
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -35,24 +35,32 @@
(declare-function org-create-formula-image "org" (string tofile options buffer))
(declare-function org-splice-latex-header "org"
(tpl def-pkg pkg snippets-p &optional extra))
-(declare-function org-export-latex-fix-inputenc "org-latex" ())
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-latex-compile "ox-latex" (file))
+
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
-(defvar org-format-latex-header)
-(defvar org-format-latex-header-extra)
-(defvar org-export-latex-packages-alist)
-(defvar org-export-latex-default-packages-alist)
-(defvar org-export-pdf-logfiles)
-(defvar org-latex-to-pdf-process)
-(defvar org-export-pdf-remove-logfiles)
-(defvar org-format-latex-options)
-(defvar org-export-latex-packages-alist)
+(defvar org-format-latex-header) ; From org.el
+(defvar org-format-latex-options) ; From org.el
+(defvar org-latex-default-packages-alist) ; From org.el
+(defvar org-latex-packages-alist) ; From org.el
(defvar org-babel-default-header-args:latex
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
+(defcustom org-babel-latex-htlatex ""
+ "The htlatex command to enable conversion of latex to SVG or HTML."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-latex-htlatex-packages
+ '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
+ "Packages to use for htlatex export."
+ :group 'org-babel
+ :type '(repeat (string)))
+
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
@@ -81,28 +89,32 @@ This function is called by `org-babel-execute-src-block'."
(width (and fit (cdr (assoc :pdfwidth params))))
(headers (cdr (assoc :headers params)))
(in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
- (org-export-latex-packages-alist
- (append (cdr (assoc :packages params))
- org-export-latex-packages-alist)))
+ (org-latex-packages-alist
+ (append (cdr (assoc :packages params)) org-latex-packages-alist)))
(cond
((and (string-match "\\.png$" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((or (string-match "\\.pdf$" out-file) imagemagick)
- (require 'org-latex)
+ ((string-match "\\.tikz$" out-file)
+ (when (file-exists-p out-file) (delete-file out-file))
+ (with-temp-file out-file
+ (insert body)))
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
(with-temp-file tex-file
+ (require 'ox-latex)
(insert
- (org-splice-latex-header
- org-format-latex-header
- (delq
- nil
- (mapcar
- (lambda (el)
- (unless (and (listp el) (string= "hyperref" (cadr el)))
- el))
- org-export-latex-default-packages-alist))
- org-export-latex-packages-alist
- org-format-latex-header-extra)
+ (org-latex-guess-inputenc
+ (org-splice-latex-header
+ org-format-latex-header
+ (delq
+ nil
+ (mapcar
+ (lambda (el)
+ (unless (and (listp el) (string= "hyperref" (cadr el)))
+ el))
+ org-latex-default-packages-alist))
+ org-latex-packages-alist
+ nil))
(if fit "\n\\usepackage[active, tightpage]{preview}\n" "")
(if border (format "\\setlength{\\PreviewBorder}{%s}" border) "")
(if height (concat "\n" (format "\\pdfpageheight %s" height)) "")
@@ -113,14 +125,10 @@ This function is called by `org-babel-execute-src-block'."
(mapconcat #'identity headers "\n")
headers) "\n")
"")
- (if org-format-latex-header-extra
- (concat "\n" org-format-latex-header-extra)
- "")
(if fit
(concat "\n\\begin{document}\n\\begin{preview}\n" body
"\n\\end{preview}\n\\end{document}\n")
- (concat "\n\\begin{document}\n" body "\n\\end{document}\n")))
- (org-export-latex-fix-inputenc))
+ (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))))
(when (file-exists-p out-file) (delete-file out-file))
(let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
(cond
@@ -131,70 +139,62 @@ This function is called by `org-babel-execute-src-block'."
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
+ ((and (or (string-match "\\.svg$" out-file)
+ (string-match "\\.html$" out-file))
+ (not (string= "" org-babel-latex-htlatex)))
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
+ (cond
+ ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
+ (if (string-match "\\.svg$" out-file)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ out-file)))
+ (error "SVG file produced but HTML file requested.")))
+ ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
+ (if (string-match "\\.html$" out-file)
+ (shell-command "mv %s %s"
+ (concat (file-name-sans-extension tex-file)
+ ".html")
+ out-file)
+ (error "HTML file produced but SVG file requested.")))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(match-string 1 out-file))))
nil) ;; signal that output has already been written to file
body))
-
(defun convert-pdf (pdffile out-file im-in-options im-out-options)
"Generate a file from a pdf file using imagemagick."
(let ((cmd (concat "convert " im-in-options " " pdffile " "
im-out-options " " out-file)))
- (message (concat "Converting pdffile file " cmd "..."))
+ (message "Converting pdffile file %s..." cmd)
(shell-command cmd)))
(defun org-babel-latex-tex-to-pdf (file)
- "Generate a pdf file according to the contents FILE.
-Extracted from `org-export-as-pdf' in org-latex.el."
- (let* ((wconfig (current-window-configuration))
- (default-directory (file-name-directory file))
- (base (file-name-sans-extension file))
- (pdffile (concat base ".pdf"))
- (cmds org-latex-to-pdf-process)
- (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
- output-dir cmd)
- (with-current-buffer outbuf (erase-buffer))
- (message (concat "Processing LaTeX file " file "..."))
- (setq output-dir (file-name-directory file))
- (if (and cmds (symbolp cmds))
- (funcall cmds (shell-quote-argument file))
- (while cmds
- (setq cmd (pop cmds))
- (while (string-match "%b" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument base))
- t t cmd)))
- (while (string-match "%f" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument file))
- t t cmd)))
- (while (string-match "%o" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument output-dir))
- t t cmd)))
- (shell-command cmd outbuf)))
- (message (concat "Processing LaTeX file " file "...done"))
- (if (not (file-exists-p pdffile))
- (error (concat "PDF file " pdffile " was not produced"))
- (set-window-configuration wconfig)
- (when org-export-pdf-remove-logfiles
- (dolist (ext org-export-pdf-logfiles)
- (setq file (concat base "." ext))
- (and (file-exists-p file) (delete-file file))))
- (message "Exporting to PDF...done")
- pdffile)))
+ "Generate a pdf file according to the contents FILE."
+ (require 'ox-latex)
+ (org-latex-compile file))
(defun org-babel-prep-session:latex (session params)
"Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
-(provide 'ob-latex)
-
-
+(provide 'ob-latex)
;;; ob-latex.el ends here
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
index 17911cc79c4..cda2d329cd8 100644
--- a/lisp/org/ob-ledger.el
+++ b/lisp/org/ob-ledger.el
@@ -1,6 +1,6 @@
;;; ob-ledger.el --- org-babel functions for ledger evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Keywords: literate programming, reproducible research, accounting
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index 0554a36ab02..04eab7c31dd 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -1,6 +1,6 @@
;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Martyn Jago
;; Keywords: babel language, literate programming
@@ -30,10 +30,7 @@
;; http://lilypond.org/manuals.html
;;; Code:
-
(require 'ob)
-(require 'ob-eval)
-(require 'ob-tangle)
(require 'outline)
(defalias 'lilypond-mode 'LilyPond-mode)
@@ -42,62 +39,62 @@
(defvar org-babel-default-header-args:lilypond '()
"Default header arguments for lilypond code blocks.
NOTE: The arguments are determined at lilypond compile time.
-See (ly-set-header-args)")
+See (org-babel-lilypond-set-header-args)")
-(defvar ly-compile-post-tangle t
+(defvar org-babel-lilypond-compile-post-tangle t
"Following the org-babel-tangle (C-c C-v t) command,
-ly-compile-post-tangle determines whether ob-lilypond should
+org-babel-lilypond-compile-post-tangle determines whether ob-lilypond should
automatically attempt to compile the resultant tangled file.
If the value is nil, no automated compilation takes place.
Default value is t")
-(defvar ly-display-pdf-post-tangle t
+(defvar org-babel-lilypond-display-pdf-post-tangle t
"Following a successful LilyPond compilation
-ly-display-pdf-post-tangle determines whether to automate the
+org-babel-lilypond-display-pdf-post-tangle determines whether to automate the
drawing / redrawing of the resultant pdf. If the value is nil,
the pdf is not automatically redrawn. Default value is t")
-(defvar ly-play-midi-post-tangle t
+(defvar org-babel-lilypond-play-midi-post-tangle t
"Following a successful LilyPond compilation
-ly-play-midi-post-tangle determines whether to automate the
+org-babel-lilypond-play-midi-post-tangle determines whether to automate the
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
-(defvar ly-OSX-ly-path
+(defvar org-babel-lilypond-OSX-ly-path
"/Applications/lilypond.app/Contents/Resources/bin/lilypond")
-(defvar ly-OSX-pdf-path "open")
-(defvar ly-OSX-midi-path "open")
+(defvar org-babel-lilypond-OSX-pdf-path "open")
+(defvar org-babel-lilypond-OSX-midi-path "open")
-(defvar ly-nix-ly-path "/usr/bin/lilypond")
-(defvar ly-nix-pdf-path "evince")
-(defvar ly-nix-midi-path "timidity")
+(defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond")
+(defvar org-babel-lilypond-nix-pdf-path "evince")
+(defvar org-babel-lilypond-nix-midi-path "timidity")
-(defvar ly-w32-ly-path "lilypond")
-(defvar ly-w32-pdf-path "")
-(defvar ly-w32-midi-path "")
+(defvar org-babel-lilypond-w32-ly-path "lilypond")
+(defvar org-babel-lilypond-w32-pdf-path "")
+(defvar org-babel-lilypond-w32-midi-path "")
-(defvar ly-gen-png nil
+(defvar org-babel-lilypond-gen-png nil
"Image generation (png) can be turned on by default by setting
-LY-GEN-PNG to t")
+ORG-BABEL-LILYPOND-GEN-PNG to t")
-(defvar ly-gen-svg nil
+(defvar org-babel-lilypond-gen-svg nil
"Image generation (SVG) can be turned on by default by setting
-LY-GEN-SVG to t")
+ORG-BABEL-LILYPOND-GEN-SVG to t")
-(defvar ly-gen-html nil
+(defvar org-babel-lilypond-gen-html nil
"HTML generation can be turned on by default by setting
-LY-GEN-HTML to t")
+ORG-BABEL-LILYPOND-GEN-HTML to t")
-(defvar ly-gen-pdf nil
+(defvar org-babel-lilypond-gen-pdf nil
"PDF generation can be turned on by default by setting
-LY-GEN-PDF to t")
+ORG-BABEL-LILYPOND-GEN-PDF to t")
-(defvar ly-use-eps nil
+(defvar org-babel-lilypond-use-eps nil
"You can force the compiler to use the EPS backend by setting
-LY-USE-EPS to t")
+ORG-BABEL-LILYPOND-USE-EPS to t")
-(defvar ly-arrange-mode nil
- "Arrange mode is turned on by setting LY-ARRANGE-MODE
+(defvar org-babel-lilypond-arrange-mode nil
+ "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-ARRANGE-MODE
to t. In Arrange mode the following settings are altered
from default...
:tangle yes, :noweb yes
@@ -114,7 +111,7 @@ blocks")
(value (cdr pair)))
(setq body
(replace-regexp-in-string
- (concat "\$" (regexp-quote name))
+ (concat "$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
body))))
vars)
@@ -126,20 +123,20 @@ Depending on whether we are in arrange mode either:
1. Attempt to execute lilypond block according to header settings
(This is the default basic mode)
2. Tangle all lilypond blocks and process the result (arrange mode)"
- (ly-set-header-args ly-arrange-mode)
- (if ly-arrange-mode
- (ly-tangle)
- (ly-process-basic body params)))
+ (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode)
+ (if org-babel-lilypond-arrange-mode
+ (org-babel-lilypond-tangle)
+ (org-babel-lilypond-process-basic body params)))
-(defun ly-tangle ()
+(defun org-babel-lilypond-tangle ()
"ob-lilypond specific tangle, attempts to invoke
=ly-execute-tangled-ly= if tangle is successful. Also passes
specific arguments to =org-babel-tangle="
(interactive)
(if (org-babel-tangle nil "yes" "lilypond")
- (ly-execute-tangled-ly) nil))
+ (org-babel-lilypond-execute-tangled-ly) nil))
-(defun ly-process-basic (body params)
+(defun org-babel-lilypond-process-basic (body params)
"Execute a lilypond block in basic mode."
(let* ((result-params (cdr (assoc :result-params params)))
(out-file (cdr (assoc :file params)))
@@ -151,11 +148,15 @@ specific arguments to =org-babel-tangle="
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
- (ly-determine-ly-path)
+ (org-babel-lilypond-determine-ly-path)
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
- "--png "
+ (or (cdr (assoc (file-name-extension out-file)
+ '(("pdf" . "--pdf ")
+ ("ps" . "--ps ")
+ ("png" . "--png "))))
+ "--png ")
"--output="
(file-name-sans-extension out-file)
" "
@@ -166,46 +167,45 @@ specific arguments to =org-babel-tangle="
"Return an error because LilyPond exporter does not support sessions."
(error "Sorry, LilyPond does not currently support sessions!"))
-(defun ly-execute-tangled-ly ()
+(defun org-babel-lilypond-execute-tangled-ly ()
"Compile result of block tangle with lilypond.
If error in compilation, attempt to mark the error in lilypond org file"
- (when ly-compile-post-tangle
- (let ((ly-tangled-file (ly-switch-extension
+ (when org-babel-lilypond-compile-post-tangle
+ (let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".lilypond"))
- (ly-temp-file (ly-switch-extension
+ (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".ly")))
- (if (file-exists-p ly-tangled-file)
+ (if (file-exists-p org-babel-lilypond-tangled-file)
(progn
- (when (file-exists-p ly-temp-file)
- (delete-file ly-temp-file))
- (rename-file ly-tangled-file
- ly-temp-file))
+ (when (file-exists-p org-babel-lilypond-temp-file)
+ (delete-file org-babel-lilypond-temp-file))
+ (rename-file org-babel-lilypond-tangled-file
+ org-babel-lilypond-temp-file))
(error "Error: Tangle Failed!") t)
(switch-to-buffer-other-window "*lilypond*")
(erase-buffer)
- (ly-compile-lilyfile ly-temp-file)
+ (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min))
- (if (not (ly-check-for-compile-error ly-temp-file))
+ (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file))
(progn
(other-window -1)
- (ly-attempt-to-open-pdf ly-temp-file)
- (ly-attempt-to-play-midi ly-temp-file))
+ (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
+ (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))
(error "Error in Compilation!")))) nil)
-(defun ly-compile-lilyfile (file-name &optional test)
+(defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
(message "Compiling LilyPond...")
- (let ((arg-1 (ly-determine-ly-path)) ;program
+ (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
- (arg-4 t) ;display
(arg-4 t) ;display
- (arg-5 (if ly-gen-png "--png" "")) ;&rest...
- (arg-6 (if ly-gen-html "--html" ""))
- (arg-7 (if ly-gen-pdf "--pdf" ""))
- (arg-8 (if ly-use-eps "-dbackend=eps" ""))
- (arg-9 (if ly-gen-svg "-dbackend=svg" ""))
+ (arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest...
+ (arg-6 (if org-babel-lilypond-gen-html "--html" ""))
+ (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" ""))
+ (arg-8 (if org-babel-lilypond-use-eps "-dbackend=eps" ""))
+ (arg-9 (if org-babel-lilypond-gen-svg "-dbackend=svg" ""))
(arg-10 (concat "--output=" (file-name-sans-extension file-name)))
(arg-11 file-name))
(if test
@@ -215,7 +215,7 @@ FILE-NAME is full path to lilypond (.ly) file"
arg-1 arg-2 arg-3 arg-4 arg-5 arg-6
arg-7 arg-8 arg-9 arg-10 arg-11))))
-(defun ly-check-for-compile-error (file-name &optional test)
+(defun org-babel-lilypond-check-for-compile-error (file-name &optional test)
"Check for compile error.
This is performed by parsing the *lilypond* buffer
containing the output message from the compilation.
@@ -226,24 +226,24 @@ nil as file-name since it is unused in this context"
(if (not test)
(if (not is-error)
nil
- (ly-process-compile-error file-name))
+ (org-babel-lilypond-process-compile-error file-name))
is-error)))
-(defun ly-process-compile-error (file-name)
+(defun org-babel-lilypond-process-compile-error (file-name)
"Process the compilation error that has occurred.
FILE-NAME is full path to lilypond file"
- (let ((line-num (ly-parse-line-num)))
- (let ((error-lines (ly-parse-error-line file-name line-num)))
- (ly-mark-error-line file-name error-lines)
+ (let ((line-num (org-babel-lilypond-parse-line-num)))
+ (let ((error-lines (org-babel-lilypond-parse-error-line file-name line-num)))
+ (org-babel-lilypond-mark-error-line file-name error-lines)
(error "Error: Compilation Failed!"))))
-(defun ly-mark-error-line (file-name line)
+(defun org-babel-lilypond-mark-error-line (file-name line)
"Mark the erroneous lines in the lilypond org buffer.
FILE-NAME is full path to lilypond file.
LINE is the erroneous line"
(switch-to-buffer-other-window
(concat (file-name-nondirectory
- (ly-switch-extension file-name ".org"))))
+ (org-babel-lilypond-switch-extension file-name ".org"))))
(let ((temp (point)))
(goto-char (point-min))
(setq case-fold-search nil)
@@ -254,7 +254,7 @@ LINE is the erroneous line"
(goto-char (- (point) (length line))))
(goto-char temp))))
-(defun ly-parse-line-num (&optional buffer)
+(defun org-babel-lilypond-parse-line-num (&optional buffer)
"Extract error line number."
(when buffer
(set-buffer buffer))
@@ -276,12 +276,12 @@ LINE is the erroneous line"
nil)))
nil)))
-(defun ly-parse-error-line (file-name lineNo)
+(defun org-babel-lilypond-parse-error-line (file-name lineNo)
"Extract the erroneous line from the tangled .ly file
FILE-NAME is full path to lilypond file.
LINENO is the number of the erroneous line"
(with-temp-buffer
- (insert-file-contents (ly-switch-extension file-name ".ly")
+ (insert-file-contents (org-babel-lilypond-switch-extension file-name ".ly")
nil nil nil t)
(if (> lineNo 0)
(progn
@@ -290,128 +290,128 @@ LINENO is the number of the erroneous line"
(buffer-substring (point) (point-at-eol)))
nil)))
-(defun ly-attempt-to-open-pdf (file-name &optional test)
+(defun org-babel-lilypond-attempt-to-open-pdf (file-name &optional test)
"Attempt to display the generated pdf file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
- (when ly-display-pdf-post-tangle
- (let ((pdf-file (ly-switch-extension file-name ".pdf")))
+ (when org-babel-lilypond-display-pdf-post-tangle
+ (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
(let ((cmd-string
- (concat (ly-determine-pdf-path) " " pdf-file)))
+ (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file)))
(if test
cmd-string
(start-process
"\"Audition pdf\""
"*lilypond*"
- (ly-determine-pdf-path)
+ (org-babel-lilypond-determine-pdf-path)
pdf-file)))
(message "No pdf file generated so can't display!")))))
-(defun ly-attempt-to-play-midi (file-name &optional test)
+(defun org-babel-lilypond-attempt-to-play-midi (file-name &optional test)
"Attempt to play the generated MIDI file
FILE-NAME is full path to lilypond file
If TEST is non-nil, the shell command is returned and is not run"
- (when ly-play-midi-post-tangle
- (let ((midi-file (ly-switch-extension file-name ".midi")))
+ (when org-babel-lilypond-play-midi-post-tangle
+ (let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
(let ((cmd-string
- (concat (ly-determine-midi-path) " " midi-file)))
+ (concat (org-babel-lilypond-determine-midi-path) " " midi-file)))
(if test
cmd-string
(start-process
"\"Audition midi\""
"*lilypond*"
- (ly-determine-midi-path)
+ (org-babel-lilypond-determine-midi-path)
midi-file)))
(message "No midi file generated so can't play!")))))
-(defun ly-determine-ly-path (&optional test)
+(defun org-babel-lilypond-determine-ly-path (&optional test)
"Return correct path to ly binary depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
- ly-OSX-ly-path)
+ org-babel-lilypond-OSX-ly-path)
((string= sys-type "windows-nt")
- ly-w32-ly-path)
- (t ly-nix-ly-path))))
+ org-babel-lilypond-w32-ly-path)
+ (t org-babel-lilypond-nix-ly-path))))
-(defun ly-determine-pdf-path (&optional test)
+(defun org-babel-lilypond-determine-pdf-path (&optional test)
"Return correct path to pdf viewer depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test system-type)))
(cond ((string= sys-type "darwin")
- ly-OSX-pdf-path)
+ org-babel-lilypond-OSX-pdf-path)
((string= sys-type "windows-nt")
- ly-w32-pdf-path)
- (t ly-nix-pdf-path))))
+ org-babel-lilypond-w32-pdf-path)
+ (t org-babel-lilypond-nix-pdf-path))))
-(defun ly-determine-midi-path (&optional test)
+(defun org-babel-lilypond-determine-midi-path (&optional test)
"Return correct path to midi player depending on OS
If TEST is non-nil, it contains a simulation of the OS for test purposes"
(let ((sys-type
(or test test system-type)))
(cond ((string= sys-type "darwin")
- ly-OSX-midi-path)
+ org-babel-lilypond-OSX-midi-path)
((string= sys-type "windows-nt")
- ly-w32-midi-path)
- (t ly-nix-midi-path))))
+ org-babel-lilypond-w32-midi-path)
+ (t org-babel-lilypond-nix-midi-path))))
-(defun ly-toggle-midi-play ()
+(defun org-babel-lilypond-toggle-midi-play ()
"Toggle whether midi will be played following a successful compilation."
(interactive)
- (setq ly-play-midi-post-tangle
- (not ly-play-midi-post-tangle))
+ (setq org-babel-lilypond-play-midi-post-tangle
+ (not org-babel-lilypond-play-midi-post-tangle))
(message (concat "Post-Tangle MIDI play has been "
- (if ly-play-midi-post-tangle
+ (if org-babel-lilypond-play-midi-post-tangle
"ENABLED." "DISABLED."))))
-(defun ly-toggle-pdf-display ()
+(defun org-babel-lilypond-toggle-pdf-display ()
"Toggle whether pdf will be displayed following a successful compilation."
(interactive)
- (setq ly-display-pdf-post-tangle
- (not ly-display-pdf-post-tangle))
+ (setq org-babel-lilypond-display-pdf-post-tangle
+ (not org-babel-lilypond-display-pdf-post-tangle))
(message (concat "Post-Tangle PDF display has been "
- (if ly-display-pdf-post-tangle
+ (if org-babel-lilypond-display-pdf-post-tangle
"ENABLED." "DISABLED."))))
-(defun ly-toggle-png-generation ()
+(defun org-babel-lilypond-toggle-png-generation ()
"Toggle whether png image will be generated by compilation."
(interactive)
- (setq ly-gen-png (not ly-gen-png))
+ (setq org-babel-lilypond-gen-png (not org-babel-lilypond-gen-png))
(message (concat "PNG image generation has been "
- (if ly-gen-png "ENABLED." "DISABLED."))))
+ (if org-babel-lilypond-gen-png "ENABLED." "DISABLED."))))
-(defun ly-toggle-html-generation ()
+(defun org-babel-lilypond-toggle-html-generation ()
"Toggle whether html will be generated by compilation."
(interactive)
- (setq ly-gen-html (not ly-gen-html))
+ (setq org-babel-lilypond-gen-html (not org-babel-lilypond-gen-html))
(message (concat "HTML generation has been "
- (if ly-gen-html "ENABLED." "DISABLED."))))
+ (if org-babel-lilypond-gen-html "ENABLED." "DISABLED."))))
-(defun ly-toggle-pdf-generation ()
+(defun org-babel-lilypond-toggle-pdf-generation ()
"Toggle whether pdf will be generated by compilation."
(interactive)
- (setq ly-gen-pdf (not ly-gen-pdf))
+ (setq org-babel-lilypond-gen-pdf (not org-babel-lilypond-gen-pdf))
(message (concat "PDF generation has been "
- (if ly-gen-pdf "ENABLED." "DISABLED."))))
+ (if org-babel-lilypond-gen-pdf "ENABLED." "DISABLED."))))
-(defun ly-toggle-arrange-mode ()
+(defun org-babel-lilypond-toggle-arrange-mode ()
"Toggle whether in Arrange mode or Basic mode."
(interactive)
- (setq ly-arrange-mode
- (not ly-arrange-mode))
+ (setq org-babel-lilypond-arrange-mode
+ (not org-babel-lilypond-arrange-mode))
(message (concat "Arrange mode has been "
- (if ly-arrange-mode "ENABLED." "DISABLED."))))
+ (if org-babel-lilypond-arrange-mode "ENABLED." "DISABLED."))))
-(defun ly-switch-extension (file-name ext)
+(defun org-babel-lilypond-switch-extension (file-name ext)
"Utility command to swap current FILE-NAME extension with EXT"
(concat (file-name-sans-extension
file-name) ext))
-(defun ly-get-header-args (mode)
+(defun org-babel-lilypond-get-header-args (mode)
"Default arguments to use when evaluating a lilypond
source block. These depend upon whether we are in arrange
mode i.e. ARRANGE-MODE is t"
@@ -425,11 +425,11 @@ mode i.e. ARRANGE-MODE is t"
'((:results . "file")
(:exports . "results")))))
-(defun ly-set-header-args (mode)
+(defun org-babel-lilypond-set-header-args (mode)
"Set org-babel-default-header-args:lilypond
-dependent on LY-ARRANGE-MODE"
+dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE"
(setq org-babel-default-header-args:lilypond
- (ly-get-header-args mode)))
+ (org-babel-lilypond-get-header-args mode)))
(provide 'ob-lilypond)
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index 4ff9718553b..c201e582c7a 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -1,6 +1,6 @@
;;; ob-lisp.el --- org-babel functions for common lisp evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Joel Boehland
;; Eric Schulte
@@ -75,23 +75,24 @@ current directory string."
"Execute a block of Common Lisp code with Babel."
(require 'slime)
(org-babel-reassemble-table
- ((lambda (result)
- (if (member "output" (cdr (assoc :result-params params)))
- (car result)
- (condition-case nil
- (read (org-babel-lisp-vector-to-list (cadr result)))
- (error (cadr result)))))
- (with-temp-buffer
- (insert (org-babel-expand-body:lisp body params))
- (slime-eval `(swank:eval-and-grab-output
- ,(let ((dir (if (assoc :dir params)
- (cdr (assoc :dir params))
- default-directory)))
- (format
- (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assoc :package params)))))
+ (let ((result
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (slime-eval `(swank:eval-and-grab-output
+ ,(let ((dir (if (assoc :dir params)
+ (cdr (assoc :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir)
+ "(progn %s)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assoc :package params))))))
+ (org-babel-result-cond (cdr (assoc :result-params params))
+ (car result)
+ (condition-case nil
+ (read (org-babel-lisp-vector-to-list (cadr result)))
+ (error (cadr result)))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index 3727829359e..c25470666c8 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -1,6 +1,6 @@
;;; ob-lob.el --- functions supporting the Library of Babel
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -25,7 +25,7 @@
;;; Code:
(eval-when-compile
(require 'cl))
-(require 'ob)
+(require 'ob-core)
(require 'ob-table)
(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
@@ -35,19 +35,18 @@
This is an association list. Populate the library by adding
files to `org-babel-lob-files'.")
-(defcustom org-babel-lob-files '()
+(defcustom org-babel-lob-files nil
"Files used to populate the `org-babel-library-of-babel'.
To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
:version "24.1"
- :type 'list)
+ :type '(repeat file))
(defvar org-babel-default-lob-header-args '((:exports . "results"))
"Default header arguments to use when exporting #+lob/call lines.")
(defun org-babel-lob-ingest (&optional file)
- "Add all named source-blocks defined in FILE to
-`org-babel-library-of-babel'."
+ "Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
(interactive "fFile: ")
(let ((lob-ingest-count 0))
(org-babel-map-src-blocks file
@@ -65,14 +64,14 @@ To add files to this list use the `org-babel-lob-ingest' command."
(defconst org-babel-block-lob-one-liner-regexp
(concat
- "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*?\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
+ "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
+ "(\\([^\n]*?\\))\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
"Regexp to match non-inline calls to predefined source block functions.")
(defconst org-babel-inline-lob-one-liner-regexp
(concat
- "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
- "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?")
+ "\\([^\n]*?\\)call_\\([^()\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
+ "(\\([^\n]*?\\))\\(\\[\\(.*?\\)\\]\\)?")
"Regexp to match inline calls to predefined source block functions.")
(defconst org-babel-lob-one-liner-regexp
@@ -114,29 +113,45 @@ if so then run the appropriate source block from the Library."
(or (funcall nonempty 8 19) ""))
(funcall nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))))))))
-
+ (match-string 2) (match-string 11)))
+ (save-excursion
+ (forward-line -1)
+ (and (looking-at (concat org-babel-src-name-regexp
+ "\\([^\n]*\\)$"))
+ (org-no-properties (match-string 1))))))))))
+
+(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
- (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
- (pre-params (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat #'identity (butlast info) " "))))))
+ (let* ((mkinfo (lambda (p)
+ (list "emacs-lisp" "results" p nil
+ (nth 3 info) ;; name
+ (nth 2 info))))
+ (pre-params (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-header-args:emacs-lisp
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat #'identity (butlast info 2)
+ " "))))))))
(pre-info (funcall mkinfo pre-params))
- (cache? (and (cdr (assoc :cache pre-params))
- (string= "yes" (cdr (assoc :cache pre-params)))))
- (new-hash (when cache? (org-babel-sha1-hash pre-info)))
- (old-hash (when cache? (org-babel-current-result-hash))))
- (if (and cache? (equal new-hash old-hash))
+ (cache-p (and (cdr (assoc :cache pre-params))
+ (string= "yes" (cdr (assoc :cache pre-params)))))
+ (new-hash (when cache-p (org-babel-sha1-hash pre-info)))
+ (old-hash (when cache-p (org-babel-current-result-hash)))
+ (org-babel-current-src-block-location (point-marker)))
+ (if (and cache-p (equal new-hash old-hash))
(save-excursion (goto-char (org-babel-where-is-src-block-result))
(forward-line 1)
(message "%S" (org-babel-read-result)))
- (prog1 (org-babel-execute-src-block
- nil (funcall mkinfo (org-babel-process-params pre-params)))
+ (prog1 (let* ((proc-params (org-babel-process-params pre-params))
+ org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil (funcall mkinfo proc-params)))
;; update the hash
(when new-hash (org-babel-set-current-result-hash new-hash))))))
diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el
new file mode 100644
index 00000000000..b43a9b39770
--- /dev/null
+++ b/lisp/org/ob-makefile.el
@@ -0,0 +1,48 @@
+;;; ob-makefile.el --- org-babel functions for makefile evaluation
+
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Thomas S. Dye
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file exists solely for tangling a Makefile from org-mode files.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-default-header-args:makefile '())
+
+(defun org-babel-execute:makefile (body params)
+ "Execute a block of makefile code.
+This function is called by `org-babel-execute-src-block'."
+ body)
+
+(defun org-babel-prep-session:makefile (session params)
+ "Return an error if the :session header argument is set. Make
+does not support sessions."
+ (error "Makefile sessions are nonsensical"))
+
+(provide 'ob-makefile)
+
+
+
+;;; ob-makefile.el ends here
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index 481ed24fef5..31464f9eff2 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -1,6 +1,6 @@
;;; ob-matlab.el --- org-babel support for matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index 4a91ca9b281..a44b3c382d2 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -1,6 +1,6 @@
;;; ob-maxima.el --- org-babel functions for maxima evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
@@ -43,7 +43,8 @@
(defcustom org-babel-maxima-command
(if (boundp 'maxima-command) maxima-command "maxima")
"Command used to call maxima on the shell."
- :group 'org-babel)
+ :group 'org-babel
+ :type 'string)
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
@@ -65,8 +66,8 @@
"\n")))
(defun org-babel-execute:maxima (body params)
- "Execute a block of Maxima entries with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of Maxima entries with org-babel.
+This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
(let ((result-params (split-string (or (cdr (assoc :results params)) "")))
(result
@@ -76,23 +77,22 @@ called by `org-babel-execute-src-block'."
org-babel-maxima-command in-file cmdline)))
(with-temp-file in-file (insert (org-babel-maxima-expand body params)))
(message cmd)
- ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
- (mapconcat
- #'identity
- (delq nil
- (mapcar (lambda (line)
- (unless (or (string-match "batch" line)
- (string-match "^rat: replaced .*$" line)
- (= 0 (length line)))
- line))
- (split-string raw "[\r\n]"))) "\n"))
- (org-babel-eval cmd "")))))
+ ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' "
+ (let ((raw (org-babel-eval cmd "")))
+ (mapconcat
+ #'identity
+ (delq nil
+ (mapcar (lambda (line)
+ (unless (or (string-match "batch" line)
+ (string-match "^rat: replaced .*$" line)
+ (string-match "^;;; Loading #P" line)
+ (= 0 (length line)))
+ line))
+ (split-string raw "[\r\n]"))) "\n")))))
(if (org-babel-maxima-graphical-output-file params)
nil
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- result
+ (org-babel-result-cond result-params
+ result
(let ((tmp-file (org-babel-temp-file "maxima-res-")))
(with-temp-file tmp-file (insert result))
(org-babel-import-elisp-from-file tmp-file))))))
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index 5838d7dec7e..6d57210c34e 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -1,6 +1,6 @@
;;; ob-msc.el --- org-babel functions for mscgen evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Juan Pechiar
;; Keywords: literate programming, reproducible research
@@ -55,7 +55,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:mscgen
'((:results . "file") (:exports . "results"))
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index bff41f8f1cf..e73af256086 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -1,6 +1,6 @@
;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -36,11 +36,11 @@
;;; Code:
(require 'ob)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
(declare-function tuareg-run-caml "ext:tuareg" ())
+(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
(defvar org-babel-tangle-lang-exts)
@@ -51,6 +51,13 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
+(defcustom org-babel-ocaml-command "ocaml"
+ "Name of the command for executing Ocaml code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
@@ -63,7 +70,7 @@
(session org-babel-ocaml-eoe-output t full-body)
(insert
(concat
- (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
+ (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
@@ -74,7 +81,14 @@
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
- (org-babel-ocaml-parse-output (org-babel-trim clean))
+ (let ((raw (org-babel-trim clean))
+ (result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ ;; strip type information from output unless verbatim is specified
+ (if (and (not (member "verbatim" result-params))
+ (string-match "= \\(.+\\)$" raw))
+ (match-string 1 raw) raw)
+ (org-babel-ocaml-parse-output raw)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -89,8 +103,10 @@
(stringp session))
session
tuareg-interactive-buffer-name)))
- (save-window-excursion (tuareg-run-caml)
- (get-buffer tuareg-interactive-buffer-name))))
+ (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
+ (tuareg-run-process-if-needed org-babel-ocaml-command)
+ (tuareg-run-caml)))
+ (get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables."
@@ -108,7 +124,7 @@
(defun org-babel-ocaml-parse-output (output)
"Parse OUTPUT.
OUTPUT is string output from an ocaml process."
- (let ((regexp "%s = \\(.+\\)$"))
+ (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 3394d579ae6..7ad474dfb4d 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -1,6 +1,6 @@
;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Dan Davison
;; Keywords: literate programming, reproducible research
@@ -30,9 +30,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function matlab-shell "ext:matlab-mode")
@@ -64,7 +61,7 @@ if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid)
else, dlmwrite('%s', ans, '\\t')
end")
-(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'")
+(defvar org-babel-octave-eoe-indicator "'org_babel_eoe'")
(defvar org-babel-octave-eoe-output "ans = org_babel_eoe")
@@ -130,7 +127,7 @@ specifying a variable of the same value."
(if (listp (car var)) "; " ",")) "]")
(cond
((stringp var)
- (format "\'%s\'" var))
+ (format "'%s'" var))
(t
(format "%s" var)))))
@@ -154,7 +151,8 @@ create. Return the initialized session."
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
- (if matlabp (require 'matlab) (require 'octave-inf))
+ (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
+ (require 'octave)))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index a5cd96a75b1..ab0db6765aa 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -1,6 +1,6 @@
;;; ob-org.el --- org-babel functions for org code block evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -29,7 +29,8 @@
;;; Code:
(require 'ob)
-(declare-function org-export-string "org-exp" (string fmt &optional dir))
+(declare-function org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
(defvar org-babel-default-header-args:org
'((:results . "raw silent") (:exports . "code"))
@@ -42,8 +43,9 @@
(defun org-babel-expand-body:org (body params)
(dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
(setq body (replace-regexp-in-string
- (regexp-quote (format "$%s" (car var))) (cdr var) body
- nil 'literal)))
+ (regexp-quote (format "$%s" (car var)))
+ (format "%s" (cdr var))
+ body nil 'literal)))
body)
(defun org-babel-execute:org (body params)
@@ -53,10 +55,10 @@ This function is called by `org-babel-execute-src-block'."
(body (org-babel-expand-body:org
(replace-regexp-in-string "^," "" body) params)))
(cond
- ((member "latex" result-params) (org-export-string
- (concat "#+Title: \n" body) "latex"))
- ((member "html" result-params) (org-export-string body "html"))
- ((member "ascii" result-params) (org-export-string body "ascii"))
+ ((member "latex" result-params)
+ (org-export-string-as (concat "#+Title: \n" body) 'latex t))
+ ((member "html" result-params) (org-export-string-as body 'html t))
+ ((member "ascii" result-params) (org-export-string-as body 'ascii t))
(t body))))
(defun org-babel-prep-session:org (session params)
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index b37df807aed..d27c18ee198 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -1,6 +1,6 @@
;;; ob-perl.el --- org-babel functions for perl evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
@@ -49,7 +48,7 @@ This function is called by `org-babel-execute-src-block'."
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
- (org-babel-perl-evaluate session full-body result-type)
+ (org-babel-perl-evaluate session full-body result-type result-params)
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
@@ -63,20 +62,33 @@ This function is called by `org-babel-execute-src-block'."
"Return list of perl statements assigning the block's variables."
(mapcar
(lambda (pair)
- (format "$%s=%s;"
- (car pair)
- (org-babel-perl-var-to-perl (cdr pair))))
+ (org-babel-perl--var-to-perl (cdr pair) (car pair)))
(mapcar #'cdr (org-babel-get-header params :var))))
;; helper functions
-(defun org-babel-perl-var-to-perl (var)
+(defvar org-babel-perl-var-wrap "q(%s)"
+ "Wrapper for variables inserted into Perl code.")
+
+(defvar org-babel-perl--lvl)
+(defun org-babel-perl--var-to-perl (var &optional varn)
"Convert an elisp value to a perl variable.
The elisp value, VAR, is converted to a string of perl source code
specifying a var of the same value."
- (if (listp var)
- (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]")
- (format "%S" var)))
+ (if varn
+ (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix)
+ (concat "my $" (symbol-name varn) "=" (when lvar "\n")
+ (org-babel-perl--var-to-perl var)
+ ";\n"))
+ (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ )))
+ (concat prefix
+ (if (listp var)
+ (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl)))
+ (concat "[\n"
+ (mapconcat #'org-babel-perl--var-to-perl var "")
+ prefix "]"))
+ (format "q(%s)" var))
+ (unless (zerop org-babel-perl--lvl) ",\n")))))
(defvar org-babel-perl-buffers '(:default . nil))
@@ -84,32 +96,60 @@ specifying a var of the same value."
"Return nil because sessions are not supported by perl."
nil)
-(defvar org-babel-perl-wrapper-method
- "
-sub main {
-%s
-}
-@r = main;
-open(o, \">%s\");
-print o join(\"\\n\", @r), \"\\n\"")
+(defvar org-babel-perl-wrapper-method "{
+ my $babel_sub = sub {
+ %s
+ };
+ open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/);
+ my $rv = &$babel_sub();
+ my $rt = ref $rv;
+ select $BOH;
+ if (qq(ARRAY) eq $rt) {
+ local $\\=$/;
+ local $,=qq(\t);
+ foreach my $rv ( @$rv ) {
+ my $rt = ref $rv;
+ if (qq(ARRAY) eq $rt) {
+ print @$rv;
+ } else {
+ print $rv;
+ }
+ }
+ } else {
+ print $rv;
+ }
+}")
+
+(defvar org-babel-perl-preface nil)
(defvar org-babel-perl-pp-wrapper-method
nil)
-(defun org-babel-perl-evaluate (session body &optional result-type)
+(defun org-babel-perl-evaluate (session ibody &optional result-type result-params)
"Pass BODY to the Perl process in SESSION.
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
(when session (error "Sessions are not supported for Perl"))
- (case result-type
- (output (org-babel-eval org-babel-perl-command body))
- (value (let ((tmp-file (org-babel-temp-file "perl-")))
- (org-babel-eval
- org-babel-perl-command
- (format org-babel-perl-wrapper-method body
- (org-babel-process-file-name tmp-file 'noquote)))
- (org-babel-eval-read-file tmp-file)))))
+ (let* ((body (concat org-babel-perl-preface ibody))
+ (tmp-file (org-babel-temp-file "perl-"))
+ (tmp-babel-file (org-babel-process-file-name
+ tmp-file 'noquote)))
+ (let ((results
+ (case result-type
+ (output
+ (with-temp-file tmp-file
+ (insert
+ (org-babel-eval org-babel-perl-command body))
+ (buffer-string)))
+ (value
+ (org-babel-eval org-babel-perl-command
+ (format org-babel-perl-wrapper-method
+ body tmp-babel-file))))))
+ (when results
+ (org-babel-result-cond result-params
+ (org-babel-eval-read-file tmp-file)
+ (org-babel-import-elisp-from-file tmp-file '(16)))))))
(provide 'ob-perl)
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
index 1029b6f2a94..5b696f1b1fc 100644
--- a/lisp/org/ob-picolisp.el
+++ b/lisp/org/ob-picolisp.el
@@ -1,6 +1,6 @@
;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Authors: Thorsten Jolitz
;; Eric Schulte
@@ -54,8 +54,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
-(require 'ob-comint)
(require 'comint)
(eval-when-compile (require 'cl))
@@ -80,7 +78,7 @@
:version "24.1"
:type 'string)
-(defun org-babel-expand-body:picolisp (body params &optional processed-params)
+(defun org-babel-expand-body:picolisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
(result-params (cdr (assoc :result-params params)))
@@ -101,16 +99,16 @@
called by `org-babel-execute-src-block'"
(message "executing Picolisp source code block")
(let* (
- ;; name of the session or "none"
+ ;; Name of the session or "none".
(session-name (cdr (assoc :session params)))
- ;; set the session if the session variable is non-nil
+ ;; Set the session if the session variable is non-nil.
(session (org-babel-picolisp-initiate-session session-name))
- ;; either OUTPUT or VALUE which should behave as described above
+ ;; Either OUTPUT or VALUE which should behave as described above.
(result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params)))
- ;; expand the body with `org-babel-expand-body:picolisp'
+ ;; Expand the body with `org-babel-expand-body:picolisp'.
(full-body (org-babel-expand-body:picolisp body params))
- ;; wrap body appropriately for the type of evaluation and results
+ ;; Wrap body appropriately for the type of evaluation and results.
(wrapped-body
(cond
((or (member "code" result-params)
@@ -120,58 +118,54 @@
(format "(print (out \"/dev/null\" %s))" full-body))
((member "value" result-params)
(format "(out \"/dev/null\" %s)" full-body))
- (t full-body))))
-
- ((lambda (result)
- (if (or (member "verbatim" result-params)
- (member "scalar" result-params)
- (member "output" result-params)
- (member "code" result-params)
- (member "pp" result-params)
- (= (length result) 0))
- result
- (read result)))
- (if (not (string= session-name "none"))
- ;; session based evaluation
- (mapconcat ;; <- joins the list back together into a single string
- #'identity
- (butlast ;; <- remove the org-babel-picolisp-eoe line
- (delq nil
- (mapcar
- (lambda (line)
- (org-babel-chomp ;; remove trailing newlines
- (when (> (length line) 0) ;; remove empty lines
- (cond
- ;; remove leading "-> " from return values
- ((and (>= (length line) 3)
- (string= "-> " (substring line 0 3)))
- (substring line 3))
- ;; remove trailing "-> <<return-value>>" on the
- ;; last line of output
- ((and (member "output" result-params)
- (string-match-p "->" line))
- (substring line 0 (string-match "->" line)))
- (t line)
- )
- ;; (if (and (>= (length line) 3) ;; remove leading "<- "
- ;; (string= "-> " (substring line 0 3)))
- ;; (substring line 3)
- ;; line)
- )))
- ;; returns a list of the output of each evaluated expression
- (org-babel-comint-with-output (session org-babel-picolisp-eoe)
- (insert wrapped-body) (comint-send-input)
- (insert "'" org-babel-picolisp-eoe) (comint-send-input)))))
- "\n")
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "picolisp-script-")))
- (with-temp-file script-file
- (insert (concat wrapped-body "(bye)")))
- (org-babel-eval
- (format "%s %s"
- org-babel-picolisp-cmd
- (org-babel-process-file-name script-file))
- ""))))))
+ (t full-body)))
+ (result
+ (if (not (string= session-name "none"))
+ ;; Session based evaluation.
+ (mapconcat ;; <- joins the list back into a single string
+ #'identity
+ (butlast ;; <- remove the org-babel-picolisp-eoe line
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (org-babel-chomp ;; Remove trailing newlines.
+ (when (> (length line) 0) ;; Remove empty lines.
+ (cond
+ ;; Remove leading "-> " from return values.
+ ((and (>= (length line) 3)
+ (string= "-> " (substring line 0 3)))
+ (substring line 3))
+ ;; Remove trailing "-> <<return-value>>" on the
+ ;; last line of output.
+ ((and (member "output" result-params)
+ (string-match-p "->" line))
+ (substring line 0 (string-match "->" line)))
+ (t line)
+ )
+ ;;(if (and (>= (length line) 3);Remove leading "<-"
+ ;; (string= "-> " (substring line 0 3)))
+ ;; (substring line 3)
+ ;; line)
+ )))
+ ;; Returns a list of the output of each evaluated exp.
+ (org-babel-comint-with-output
+ (session org-babel-picolisp-eoe)
+ (insert wrapped-body) (comint-send-input)
+ (insert "'" org-babel-picolisp-eoe)
+ (comint-send-input)))))
+ "\n")
+ ;; external evaluation
+ (let ((script-file (org-babel-temp-file "picolisp-script-")))
+ (with-temp-file script-file
+ (insert (concat wrapped-body "(bye)")))
+ (org-babel-eval
+ (format "%s %s"
+ org-babel-picolisp-cmd
+ (org-babel-process-file-name script-file))
+ "")))))
+ (org-babel-result-cond result-params
+ result
+ (read result))))
(defun org-babel-picolisp-initiate-session (&optional session-name)
"If there is not a current inferior-process-buffer in SESSION
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index bb52c376b4a..f0f72209f56 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -1,6 +1,6 @@
;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Zhang Weize
;; Keywords: literate programming, reproducible research
@@ -35,13 +35,12 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:plantuml
'((:results . "file") (:exports . "results"))
"Default arguments for evaluating a plantuml source block.")
-(defcustom org-plantuml-jar-path nil
+(defcustom org-plantuml-jar-path ""
"Path to the plantuml.jar file."
:group 'org-babel
:version "24.1"
@@ -56,7 +55,7 @@ This function is called by `org-babel-execute-src-block'."
(cmdline (cdr (assoc :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
(java (or (cdr (assoc :java params)) ""))
- (cmd (if (not org-plantuml-jar-path)
+ (cmd (if (string= "" org-plantuml-jar-path)
(error "`org-plantuml-jar-path' is not set")
(concat "java " java " -jar "
(shell-quote-argument
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index 79cc53ea0fa..eb74f93881b 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -1,6 +1,6 @@
;;; ob-python.el --- org-babel functions for python evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -28,29 +28,47 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function org-remove-indentation "org" )
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
-(declare-function run-python "ext:python" (&optional cmd noshow new))
+(declare-function run-python "ext:python" (cmd &optional dedicated show))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
(defvar org-babel-default-header-args:python '())
-(defvar org-babel-python-command "python"
- "Name of the command for executing Python code.")
+(defcustom org-babel-python-command "python"
+ "Name of the command for executing Python code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
-(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python)
+(defcustom org-babel-python-mode
+ (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
-This will typically be either 'python or 'python-mode.")
-
-(defvar org-src-preserve-indentation)
+This will typically be either 'python or 'python-mode."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'symbol)
+
+(defcustom org-babel-python-hline-to "None"
+ "Replace hlines in incoming tables with this when translating to python."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-python-None-to 'hline
+ "Replace `None' in python tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'symbol)
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
@@ -114,24 +132,45 @@ specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
(if (equal var 'hline)
- "None"
+ org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
- var))))
+ (if (stringp var) (substring-no-properties var) var)))))
(defun org-babel-python-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'None)
+ org-babel-python-None-to el))
+ res)
+ res)))
-(defvar org-babel-python-buffers '((:default . nil)))
+(defvar org-babel-python-buffers '((:default . "*Python*")))
(defun org-babel-python-session-buffer (session)
"Return the buffer associated with SESSION."
(cdr (assoc session org-babel-python-buffers)))
+(defun org-babel-python-with-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ name
+ (format "*%s*" name))))
+
+(defun org-babel-python-without-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ (substring name 1 (- (length name) 1))
+ name)))
+
(defvar py-default-interpreter)
+(defvar py-which-bufname)
+(defvar python-shell-buffer-name)
(defun org-babel-python-initiate-session-by-key (&optional session)
"Initiate a python session.
If there is not a current inferior-process-buffer in SESSION
@@ -139,13 +178,20 @@ then create. Return the initialized session."
(require org-babel-python-mode)
(save-window-excursion
(let* ((session (if session (intern session) :default))
- (python-buffer (org-babel-python-session-buffer session)))
+ (python-buffer (org-babel-python-session-buffer session))
+ (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ (concat org-babel-python-command " -i")
+ org-babel-python-command)))
(cond
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
- (if (version< "24.1" emacs-version)
- (run-python org-babel-python-command)
- (run-python)))
+ (if (not (version< "24.1" emacs-version))
+ (run-python cmd)
+ (unless python-buffer
+ (setq python-buffer (org-babel-python-with-earmuffs session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmuffs python-buffer)))
+ (run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise
@@ -160,7 +206,7 @@ then create. Return the initialized session."
(concat "Python-" (symbol-name session))))
(py-which-bufname bufname))
(py-shell)
- (setq python-buffer (concat "*" bufname "*"))))
+ (setq python-buffer (org-babel-python-with-earmuffs bufname))))
(t
(error "No function available for running an inferior Python")))
(setq org-babel-python-buffers
@@ -205,37 +251,34 @@ open('%s', 'w').write( pprint.pformat(main()) )")
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
- ((lambda (raw)
- (if (or (member "code" result-params)
- (member "pp" result-params)
- (and (member "output" result-params)
- (not (member "table" result-params))))
- raw
- (org-babel-python-table-or-string (org-babel-trim raw))))
- (case result-type
- (output (org-babel-eval org-babel-python-command
- (concat (if preamble (concat preamble "\n") "")
- body)))
- (value (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-eval
- org-babel-python-command
- (concat
- (if preamble (concat preamble "\n") "")
- (format
- (if (member "pp" result-params)
- org-babel-python-pp-wrapper-method
- org-babel-python-wrapper-method)
- (mapconcat
- (lambda (line) (format "\t%s" line))
- (split-string
- (org-remove-indentation
- (org-babel-trim body))
- "[\r\n]") "\n")
- (org-babel-process-file-name tmp-file 'noquote))))
- (org-babel-eval-read-file tmp-file))))))
+ (let ((raw
+ (case result-type
+ (output (org-babel-eval org-babel-python-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (value (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-eval
+ org-babel-python-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-python-pp-wrapper-method
+ org-babel-python-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-babel-trim body))
+ "[\r\n]") "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-python-table-or-string (org-babel-trim raw)))))
(defun org-babel-python-evaluate-session
- (session body &optional result-type result-params)
+ (session body &optional result-type result-params)
"Pass BODY to the Python process in SESSION.
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
@@ -252,42 +295,41 @@ last statement in BODY, as elisp."
(format "open('%s', 'w').write(pprint.pformat(_))"
(org-babel-process-file-name tmp-file 'noquote)))
(list (format "open('%s', 'w').write(str(_))"
- (org-babel-process-file-name tmp-file 'noquote)))))))
+ (org-babel-process-file-name tmp-file
+ 'noquote)))))))
(input-body (lambda (body)
(mapc (lambda (line) (insert line) (funcall send-wait))
(split-string body "[\r\n]"))
- (funcall send-wait))))
- ((lambda (results)
- (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
- (if (or (member "code" result-params)
- (member "pp" result-params)
- (and (member "output" result-params)
- (not (member "table" result-params))))
- results
- (org-babel-python-table-or-string results))))
- (case result-type
- (output
- (mapconcat
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator t body)
- (funcall input-body body)
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait))
- 2) "\n"))
- (value
- (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-comint-with-output
- (session org-babel-python-eoe-indicator nil body)
- (let ((comint-process-echoes nil))
- (funcall input-body body)
- (funcall dump-last-value tmp-file (member "pp" result-params))
- (funcall send-wait) (funcall send-wait)
- (insert org-babel-python-eoe-indicator)
- (funcall send-wait)))
- (org-babel-eval-read-file tmp-file)))))))
+ (funcall send-wait)))
+ (results
+ (case result-type
+ (output
+ (mapconcat
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator t body)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait))
+ 2) "\n"))
+ (value
+ (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-comint-with-output
+ (session org-babel-python-eoe-indicator nil body)
+ (let ((comint-process-echoes nil))
+ (funcall input-body body)
+ (funcall dump-last-value tmp-file
+ (member "pp" result-params))
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-python-eoe-indicator)
+ (funcall send-wait)))
+ (org-babel-eval-read-file tmp-file))))))
+ (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results)
+ (org-babel-result-cond result-params
+ results
+ (org-babel-python-table-or-string results)))))
(defun org-babel-python-read-string (string)
"Strip 's from around Python string."
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el
index 389c36318e2..5c1e13142da 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -1,6 +1,6 @@
;;; ob-ref.el --- org-babel functions for referencing external data
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -40,7 +40,7 @@
;; So an example of a simple src block referencing table data in the
;; same file would be
-;; #+TBLNAME: sandbox
+;; #+NAME: sandbox
;; | 1 | 2 | 3 |
;; | 4 | org-babel | 6 |
;;
@@ -49,7 +49,7 @@
;; #+end_src
;;; Code:
-(require 'ob)
+(require 'ob-core)
(eval-when-compile
(require 'cl))
@@ -83,7 +83,12 @@ the variable."
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
- (let ((out (org-babel-read ref)))
+ (let ((out (save-excursion
+ (when org-babel-current-src-block-location
+ (goto-char (if (markerp org-babel-current-src-block-location)
+ (marker-position org-babel-current-src-block-location)
+ org-babel-current-src-block-location)))
+ (org-babel-read ref))))
(if (equal out ref)
(if (string-match "^\".*\"$" ref)
(read ref)
@@ -133,7 +138,7 @@ the variable."
(setq ref (substring ref 0 (match-beginning 0))))
;; assign any arguments to pass to source block
(when (string-match
- "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref)
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref)
(setq new-refere (match-string 1 ref))
(setq new-header-args (match-string 3 ref))
(setq new-referent (match-string 5 ref))
@@ -171,7 +176,7 @@ the variable."
;; buffer (marker-buffer id-loc)
;; loc (marker-position id-loc))
;; (move-marker id-loc nil)
- (error "Reference '%s' not found in this buffer" ref))
+ (error "Reference `%s' not found in this buffer" ref))
(cond
(lob-info (setq type 'lob))
(id (setq type 'id))
@@ -219,7 +224,7 @@ returned, or an empty string or \"*\" both of which are
interpreted to mean the entire range and as such are equivalent
to \"0:-1\"."
(if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index))
- (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)")
+ (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\\*\\)")
(lgth (length lis))
(portion (match-string 1 index))
(remainder (substring index (match-end 0)))
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 747c6fc3da2..8dee01a5389 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -1,6 +1,6 @@
;;; ob-ruby.el --- org-babel functions for ruby evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -37,9 +37,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(declare-function run-ruby "ext:inf-ruby" (&optional command name))
@@ -53,6 +50,20 @@
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
+(defcustom org-babel-ruby-hline-to "nil"
+ "Replace hlines in incoming tables with this when translating to ruby."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-ruby-nil-to 'hline
+ "Replace nil in ruby tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'symbol)
+
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
@@ -71,7 +82,9 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-ruby-evaluate
session full-body result-type result-params))))
(org-babel-reassemble-table
- result
+ (org-babel-result-cond result-params
+ result
+ (org-babel-ruby-table-or-string result))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
@@ -116,13 +129,20 @@ Convert an elisp value into a string of ruby source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
- (format "%S" var)))
+ (if (equal var 'hline)
+ org-babel-ruby-hline-to
+ (format "%S" var))))
(defun org-babel-ruby-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'nil)
+ org-babel-ruby-nil-to el))
+ res)
+ res)))
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
@@ -181,12 +201,11 @@ return the value of the last statement in BODY, as elisp."
org-babel-ruby-pp-wrapper-method
org-babel-ruby-wrapper-method)
body (org-babel-process-file-name tmp-file 'noquote)))
- ((lambda (raw)
- (if (or (member "code" result-params)
- (member "pp" result-params))
- raw
- (org-babel-ruby-table-or-string raw)))
- (org-babel-eval-read-file tmp-file)))))
+ (let ((raw (org-babel-eval-read-file tmp-file)))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ raw
+ (org-babel-ruby-table-or-string raw))))))
;; comint session evaluation
(case result-type
(output
@@ -206,31 +225,27 @@ return the value of the last statement in BODY, as elisp."
(comint-send-input nil t)) 2)
"\n") "[\r\n]")) "\n"))
(value
- ((lambda (results)
- (if (or (member "code" result-params) (member "pp" result-params))
- results
- (org-babel-ruby-table-or-string results)))
- (let* ((tmp-file (org-babel-temp-file "ruby-"))
- (ppp (or (member "code" result-params)
- (member "pp" result-params))))
- (org-babel-comint-with-output
- (buffer org-babel-ruby-eoe-indicator t body)
- (when ppp (insert "require 'pp';") (comint-send-input nil t))
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (append
- (list body)
- (if (not ppp)
- (list (format org-babel-ruby-f-write
- (org-babel-process-file-name tmp-file 'noquote)))
- (list
- "results=_" "require 'pp'" "orig_out = $stdout"
- (format org-babel-ruby-pp-f-write
- (org-babel-process-file-name tmp-file 'noquote))))
- (list org-babel-ruby-eoe-indicator)))
- (comint-send-input nil t))
- (org-babel-eval-read-file tmp-file)))))))
+ (let* ((tmp-file (org-babel-temp-file "ruby-"))
+ (ppp (or (member "code" result-params)
+ (member "pp" result-params))))
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t body)
+ (when ppp (insert "require 'pp';") (comint-send-input nil t))
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (append
+ (list body)
+ (if (not ppp)
+ (list (format org-babel-ruby-f-write
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list
+ "results=_" "require 'pp'" "orig_out = $stdout"
+ (format org-babel-ruby-pp-f-write
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (list org-babel-ruby-eoe-indicator)))
+ (comint-send-input nil t))
+ (org-babel-eval-read-file tmp-file))))))
(defun org-babel-ruby-read-string (string)
"Strip \\\"s from around a ruby string."
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 60a10dbee59..a39248d78c7 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -1,6 +1,6 @@
;;; ob-sass.el --- org-babel functions for the sass css generation language
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
(defvar org-babel-default-header-args:sass '())
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
index 3a07b344b23..663ce29c196 100644
--- a/lisp/org/ob-scala.el
+++ b/lisp/org/ob-scala.el
@@ -1,6 +1,6 @@
;;; ob-scala.el --- org-babel functions for Scala evaluation
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Andrzej Lichnerowicz
;; Keywords: literate programming, reproducible research
@@ -31,9 +31,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -103,12 +100,11 @@ in BODY as elisp."
(let* ((src-file (org-babel-temp-file "scala-"))
(wrapper (format org-babel-scala-wrapper-method body)))
(with-temp-file src-file (insert wrapper))
- ((lambda (raw)
- (if (member "code" result-params)
- raw
- (org-babel-scala-table-or-string raw)))
- (org-babel-eval
- (concat org-babel-scala-command " " src-file) ""))))))
+ (let ((raw (org-babel-eval
+ (concat org-babel-scala-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-scala-table-or-string raw)))))))
(defun org-babel-prep-session:scala (session params)
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index bd7ea823f71..7d8e23f165f 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -1,8 +1,9 @@
;;; ob-scheme.el --- org-babel functions for Scheme
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte
+;; Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
@@ -33,30 +34,25 @@
;; - a working scheme implementation
;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
;;
-;; - for session based evaluation cmuscheme.el is required which is
-;; included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;; ELPA.
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
-(eval-when-compile (require 'cl))
+(require 'geiser nil t)
+(defvar geiser-repl--repl) ; Defined in geiser-repl.el
+(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
+(defvar geiser-default-implementation) ; Defined in geiser-impl.el
+(defvar geiser-active-implementations) ; Defined in geiser-impl.el
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(declare-function run-geiser "geiser-repl" (impl))
+(declare-function geiser-mode "geiser-mode" ())
+(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg))
+(declare-function geiser-repl-exit "geiser-repl" (&optional arg))
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
- "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
- "Name of command used to evaluate scheme blocks."
- :group 'org-babel
- :version "24.1"
- :type 'string)
-
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
@@ -68,70 +64,127 @@
")\n" body ")")
body)))
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+ "Remove dead buffers from the REPL map."
+ (maphash
+ (lambda (x y)
+ (when (not (buffer-name y))
+ (remhash x org-babel-scheme-repl-map)))
+ org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+ "Look up the scheme buffer for a session; return nil if it doesn't exist."
+ (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+ (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+ "Record the scheme buffer used for a given session."
+ (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+ "Returns the scheme implementation geiser associates with the buffer."
+ (with-current-buffer (set-buffer buffer)
+ geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+ "Switch to a scheme REPL, creating it if it doesn't exist:"
+ (let ((buffer (org-babel-scheme-get-session-buffer name)))
+ (or buffer
+ (progn
+ (run-geiser impl)
+ (if name
+ (progn
+ (rename-buffer name t)
+ (org-babel-scheme-set-session-buffer name (current-buffer))))
+ (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+ "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is `none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+ (let ((result
+ (cond ((not name)
+ (concat buffer " " (symbol-name impl) " REPL"))
+ ((string= name "none") nil)
+ (name))))
+ result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+ "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+ (let ((result nil))
+ (with-temp-buffer
+ (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+ (newline)
+ (insert (if output
+ (format "(with-output-to-string (lambda () %s))" code)
+ code))
+ (geiser-mode)
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (current-buffer))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (geiser-eval-region (point-min) (point-max))
+ (setq result
+ (if (equal (substring (current-message) 0 3) "=> ")
+ (replace-regexp-in-string "^=> " "" (current-message))
+ "\"An error occurred.\""))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer))
+ (setq result (if (or (string= result "#<void>")
+ (string= result "#<unspecified>"))
+ nil
+ (read result)))))
+ result))
+
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (let* ((result-type (cdr (assoc :result-type params)))
- (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
- org-babel-scheme-cmd))
- (full-body (org-babel-expand-body:scheme body params)))
- (read
- (if (not (string= (cdr (assoc :session params)) "none"))
- ;; session evaluation
- (let ((session (org-babel-prep-session:scheme
- (cdr (assoc :session params)) params)))
- (org-babel-comint-with-output
- (session (format "%S" org-babel-scheme-eoe) t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (list body (format "%S" org-babel-scheme-eoe)))))
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "scheme-script-")))
- (with-temp-file script-file
- (insert
- ;; return the value or the output
- (if (string= result-type "value")
- (format "(display %s)" full-body)
- full-body)))
- (org-babel-eval
- (format "%s %s" org-babel-scheme-cmd
- (org-babel-process-file-name script-file)) ""))))))
-
-(defun org-babel-prep-session:scheme (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (org-babel-scheme-initiate-session session))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (var-lines
- (mapcar
- (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
- vars)))
- (when session
- (org-babel-comint-in-buffer session
- (sit-for .5) (goto-char (point-max))
- (mapc (lambda (var)
- (insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines)))
- session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session."
- (require 'cmuscheme)
- (unless (string= session "none")
- (let ((session-buffer (save-window-excursion
- (run-scheme org-babel-scheme-cmd)
- (rename-buffer session)
- (current-buffer))))
- (if (org-babel-comint-buffer-livep session-buffer)
- (progn (sit-for .25) session-buffer)
- (sit-for .5)
- (org-babel-scheme-initiate-session session)))))
+ (let* ((source-buffer (current-buffer))
+ (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+ "^ ?\\*\\([^*]+\\)\\*" "\\1"
+ (buffer-name source-buffer))))
+ (save-excursion
+ (org-babel-reassemble-table
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (impl (or (when (cdr (assoc :scheme params))
+ (intern (cdr (assoc :scheme params))))
+ geiser-default-implementation
+ (car geiser-active-implementations)))
+ (session (org-babel-scheme-make-session-name
+ source-buffer-name (cdr (assoc :session params)) impl))
+ (full-body (org-babel-expand-body:scheme body params)))
+ (org-babel-scheme-execute-with-geiser
+ full-body ; code
+ (string= result-type "output") ; output?
+ impl ; implementation
+ (and (not (string= session "none")) session))) ; session
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params)))))))
(provide 'ob-scheme)
-
-
;;; ob-scheme.el ends here
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index 621110b2d49..54ae5e1e297 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -1,6 +1,6 @@
;;; ob-screen.el --- org-babel support for interactive terminal
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Benjamin Andresen
;; Keywords: literate programming, interactive shell
@@ -34,7 +34,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
(defvar org-babel-screen-location "screen"
"The command location for screen.
@@ -107,7 +106,7 @@ In case you want to use a different screen than one selected by your $PATH")
(defun org-babel-screen-session-write-temp-file (session body)
"Save BODY in a temp file that is named after SESSION."
- (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session)))
+ (let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile
(insert body)
@@ -122,7 +121,7 @@ The terminal should shortly flicker."
(interactive)
(let* ((session "org-babel-testing")
(random-string (format "%s" (random 99999)))
- (tmpfile "/tmp/org-babel-screen.test")
+ (tmpfile (org-babel-temp-file "ob-screen-test-"))
(body (concat "echo '" random-string "' > " tmpfile "\nexit\n"))
process tmp-string)
(org-babel-execute:screen body org-babel-default-header-args:screen)
diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el
index c0e6b15feb9..2ff5c20714f 100644
--- a/lisp/org/ob-sh.el
+++ b/lisp/org/ob-sh.el
@@ -1,6 +1,6 @@
;;; ob-sh.el --- org-babel functions for shell evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -27,9 +27,6 @@
;;; Code:
(require 'ob)
-(require 'ob-ref)
-(require 'ob-comint)
-(require 'ob-eval)
(require 'shell)
(eval-when-compile (require 'cl))
@@ -56,9 +53,9 @@ This will be passed to `shell-command-on-region'")
This function is called by `org-babel-execute-src-block'."
(let* ((session (org-babel-sh-initiate-session
(cdr (assoc :session params))))
- (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string
- (org-babel-ref-resolve stdin))))
- (cdr (assoc :stdin params))))
+ (stdin (let ((stdin (cdr (assoc :stdin params))))
+ (when stdin (org-babel-sh-var-to-string
+ (org-babel-ref-resolve stdin)))))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:sh params))))
(org-babel-reassemble-table
@@ -109,7 +106,7 @@ var of the same value."
"Convert an elisp value to a string."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
- ((and (listp var) (listp (car var)))
+ ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat echo-var var "\n"))
@@ -126,7 +123,13 @@ Emacs-lisp table, otherwise return the results as a string."
(when (and session (not (string= session "none")))
(save-window-excursion
(or (org-babel-comint-buffer-livep session)
- (progn (shell session) (get-buffer (current-buffer)))))))
+ (progn
+ (shell session)
+ ;; Needed for Emacs 23 since the marker is initially
+ ;; undefined and the filter functions try to use it without
+ ;; checking.
+ (set-marker comint-last-output-start (point))
+ (get-buffer (current-buffer)))))))
(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
"String to indicate that evaluation has completed.")
@@ -138,70 +141,69 @@ Emacs-lisp table, otherwise return the results as a string."
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY."
- ((lambda (results)
- (when results
- (let ((result-params (cdr (assoc :result-params params))))
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- results
- (let ((tmp-file (org-babel-temp-file "sh-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file))))))
- (cond
- (stdin ; external shell script w/STDIN
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (stdin-file (org-babel-temp-file "sh-stdin-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (with-temp-file stdin-file (insert stdin))
- (with-temp-buffer
- (call-process-shell-command
- (if shebang
- script-file
- (format "%s %s" org-babel-sh-command script-file))
- stdin-file
- (current-buffer))
- (buffer-string))))
- (session ; session evaluation
- (mapconcat
- #'org-babel-sh-strip-weird-long-prompt
- (mapcar
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-sh-eoe-output t body)
- (mapc
- (lambda (line)
- (insert line)
- (comint-send-input nil t)
- (while (save-excursion
- (goto-char comint-last-input-end)
- (not (re-search-forward
- comint-prompt-regexp nil t)))
- (accept-process-output (get-buffer-process (current-buffer)))))
- (append
- (split-string (org-babel-trim body) "\n")
- (list org-babel-sh-eoe-indicator))))
- 2)) "\n"))
- ('otherwise ; external shell script
- (if (and (cdr (assoc :shebang params))
- (> (length (cdr (assoc :shebang params))) 0))
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (org-babel-eval script-file ""))
- (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+ (let ((results
+ (cond
+ (stdin ; external shell script w/STDIN
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (string= "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (with-temp-file stdin-file (insert stdin))
+ (with-temp-buffer
+ (call-process-shell-command
+ (if shebang
+ script-file
+ (format "%s %s" org-babel-sh-command script-file))
+ stdin-file
+ (current-buffer))
+ (buffer-string))))
+ (session ; session evaluation
+ (mapconcat
+ #'org-babel-sh-strip-weird-long-prompt
+ (mapcar
+ #'org-babel-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-sh-eoe-output t body)
+ (mapc
+ (lambda (line)
+ (insert line)
+ (comint-send-input nil t)
+ (while (save-excursion
+ (goto-char comint-last-input-end)
+ (not (re-search-forward
+ comint-prompt-regexp nil t)))
+ (accept-process-output
+ (get-buffer-process (current-buffer)))))
+ (append
+ (split-string (org-babel-trim body) "\n")
+ (list org-babel-sh-eoe-indicator))))
+ 2)) "\n"))
+ ('otherwise ; external shell script
+ (if (and (cdr (assoc :shebang params))
+ (> (length (cdr (assoc :shebang params))) 0))
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (shebang (cdr (assoc :shebang params)))
+ (padline (not (equal "no" (cdr (assoc :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (org-babel-eval script-file ""))
+ (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
+ (when results
+ (let ((result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))))))
(defun org-babel-sh-strip-weird-long-prompt (string)
"Remove prompt cruft from a string of shell output."
diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el
index ec31546a0ac..190d69b7678 100644
--- a/lisp/org/ob-shen.el
+++ b/lisp/org/ob-shen.el
@@ -1,6 +1,6 @@
;;; ob-shen.el --- org-babel functions for Shen
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research, shen
@@ -36,6 +36,7 @@
(require 'ob)
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
(defvar org-babel-default-header-args:shen '()
"Default header arguments for shen code blocks.")
@@ -65,15 +66,14 @@ This function is called by `org-babel-execute-src-block'"
(let* ((result-type (cdr (assoc :result-type params)))
(result-params (cdr (assoc :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
- ((lambda (results)
- (if (or (member 'scalar result-params)
- (member 'verbatim result-params))
- results
- (condition-case nil (org-babel-script-escape results)
- (error results))))
- (with-temp-buffer
- (insert full-body)
- (call-interactively #'shen-eval-defun)))))
+ (let ((results
+ (with-temp-buffer
+ (insert full-body)
+ (call-interactively #'shen-eval-defun))))
+ (org-babel-result-cond result-params
+ results
+ (condition-case nil (org-babel-script-escape results)
+ (error results))))))
(provide 'ob-shen)
;;; ob-shen.el ends here
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 131fa46f147..6dff9adca86 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -1,6 +1,6 @@
;;; ob-sql.el --- org-babel functions for sql evaluation
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -32,12 +32,24 @@
;;
;; Also SQL evaluation generally takes place inside of a database.
;;
-;; For now lets just allow a generic ':cmdline' header argument.
+;; Header args used:
+;; - engine
+;; - cmdline
+;; - dbhost
+;; - dbuser
+;; - dbpassword
+;; - database
+;; - colnames (default, nil, means "yes")
+;; - result-params
+;; - out-file
+;; The following are used but not really implemented for SQL:
+;; - colname-names
+;; - rownames
+;; - rowname-names
;;
;; TODO:
;;
;; - support for sessions
-;; - add more useful header arguments (user, passwd, database, etc...)
;; - support for more engines (currently only supports mysql)
;; - what's a reasonable way to drop table data into SQL?
;;
@@ -52,30 +64,49 @@
(defvar org-babel-default-header-args:sql '())
-(defvar org-babel-header-args:sql
- '((engine . :any)
- (out-file . :any)))
+(defconst org-babel-header-args:sql
+ '((engine . :any)
+ (out-file . :any)
+ (dbhost . :any)
+ (dbuser . :any)
+ (dbpassword . :any)
+ (database . :any))
+ "SQL-specific header arguments.")
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars
body (mapcar #'cdr (org-babel-get-header params :var))))
+(defun dbstring-mysql (host user password database)
+ "Make MySQL cmd line args for database connection. Pass nil to omit that arg."
+ (combine-and-quote-strings
+ (remq nil
+ (list (when host (concat "-h" host))
+ (when user (concat "-u" user))
+ (when password (concat "-p" password))
+ (when database (concat "-D" database))))))
+
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
(let* ((result-params (cdr (assoc :result-params params)))
(cmdline (cdr (assoc :cmdline params)))
+ (dbhost (cdr (assoc :dbhost params)))
+ (dbuser (cdr (assoc :dbuser params)))
+ (dbpassword (cdr (assoc :dbpassword params)))
+ (database (cdr (assoc :database params)))
(engine (cdr (assoc :engine params)))
+ (colnames-p (not (equal "no" (cdr (assoc :colnames params)))))
(in-file (org-babel-temp-file "sql-in-"))
(out-file (or (cdr (assoc :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
(command (case (intern engine)
- ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s"
+ ('dbi (format "dbish --batch %s < %s | sed '%s' > %s"
(or cmdline "")
(org-babel-process-file-name in-file)
- "/^+/d;s/^\|//;$d"
+ "/^+/d;s/^|//;s/(NULL)/ /g;$d"
(org-babel-process-file-name out-file)))
('monetdb (format "mclient -f tab %s < %s > %s"
(or cmdline "")
@@ -85,7 +116,9 @@ This function is called by `org-babel-execute-src-block'."
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
- ('mysql (format "mysql %s < %s > %s"
+ ('mysql (format "mysql %s %s %s < %s > %s"
+ (dbstring-mysql dbhost dbuser dbpassword database)
+ (if colnames-p "" "-N")
(or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
@@ -102,28 +135,39 @@ This function is called by `org-babel-execute-src-block'."
(t ""))
(org-babel-expand-body:sql body params)))
(message command)
- (shell-command command)
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "html" result-params)
- (member "code" result-params)
- (equal (point-min) (point-max)))
- (with-temp-buffer
+ (org-babel-eval command "")
+ (org-babel-result-cond result-params
+ (with-temp-buffer
(progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
- ;; need to figure out what the delimiter is for the header row
- (with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (when (re-search-forward "^\\(-+\\)[^-]" nil t)
- (setq header-delim (match-string-no-properties 1)))
- (goto-char (point-max))
- (forward-char -1)
- (while (looking-at "\n")
- (delete-char 1)
- (goto-char (point-max))
- (forward-char -1))
- (write-file out-file))
+ (cond
+ ((or (eq (intern engine) 'mysql)
+ (eq (intern engine) 'dbi)
+ (eq (intern engine) 'postgresql))
+ ;; Add header row delimiter after column-names header in first line
+ (cond
+ (colnames-p
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (forward-line 1)
+ (insert "-\n")
+ (setq header-delim "-")
+ (write-file out-file)))))
+ (t
+ ;; Need to figure out the delimiter for the header row
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(-+\\)[^-]" nil t)
+ (setq header-delim (match-string-no-properties 1)))
+ (goto-char (point-max))
+ (forward-char -1)
+ (while (looking-at "\n")
+ (delete-char 1)
+ (goto-char (point-max))
+ (forward-char -1))
+ (write-file out-file))))
(org-table-import out-file '(16))
(org-babel-reassemble-table
(mapcar (lambda (x)
@@ -142,19 +186,17 @@ This function is called by `org-babel-execute-src-block'."
(lambda (pair)
(setq body
(replace-regexp-in-string
- (format "\$%s" (car pair))
- ((lambda (val)
- (if (listp val)
- ((lambda (data-file)
- (with-temp-file data-file
- (insert (orgtbl-to-csv
- val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
- data-file)
- (org-babel-temp-file "sql-data-"))
- (if (stringp val) val (format "%S" val))))
- (cdr pair))
+ (format "$%s" (car pair))
+ (let ((val (cdr pair)))
+ (if (listp val)
+ (let ((data-file (org-babel-temp-file "sql-data-")))
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (if (stringp val) val (format "%S" val))))
body)))
vars)
body)
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index c25e786fb61..18d7fc8fd6a 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -1,6 +1,6 @@
;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -27,8 +27,6 @@
;;; Code:
(require 'ob)
-(require 'ob-eval)
-(require 'ob-ref)
(declare-function org-fill-template "org" (template alist))
(declare-function org-table-convert-region "org-table"
@@ -98,43 +96,40 @@ This function is called by `org-babel-execute-src-block'."
(cons "db " db)))
;; body of the code block
(org-babel-expand-body:sqlite body params)))
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "html" result-params)
- (member "code" result-params)
- (equal (point-min) (point-max)))
- (buffer-string)
- (org-table-convert-region (point-min) (point-max)
- (if (or (member :csv others)
- (member :column others)
- (member :line others)
- (member :list others)
- (member :html others) separator)
- nil
- '(4)))
- (org-babel-sqlite-table-or-scalar
- (org-babel-sqlite-offset-colnames
- (org-table-to-lisp) headers-p))))))
+ (org-babel-result-cond result-params
+ (buffer-string)
+ (if (equal (point-min) (point-max))
+ ""
+ (org-table-convert-region (point-min) (point-max)
+ (if (or (member :csv others)
+ (member :column others)
+ (member :line others)
+ (member :list others)
+ (member :html others) separator)
+ nil
+ '(4)))
+ (org-babel-sqlite-table-or-scalar
+ (org-babel-sqlite-offset-colnames
+ (org-table-to-lisp) headers-p)))))))
(defun org-babel-sqlite-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
+ ;; FIXME: Redundancy with org-babel-sql-expand-vars!
(mapc
(lambda (pair)
(setq body
(replace-regexp-in-string
- (format "\$%s" (car pair))
- ((lambda (val)
- (if (listp val)
- ((lambda (data-file)
- (with-temp-file data-file
- (insert (orgtbl-to-csv
- val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
- data-file)
- (org-babel-temp-file "sqlite-data-"))
- (if (stringp val) val (format "%S" val))))
- (cdr pair))
+ (format "$%s" (car pair))
+ (let ((val (cdr pair)))
+ (if (listp val)
+ (let ((data-file (org-babel-temp-file "sqlite-data-")))
+ (with-temp-file data-file
+ (insert (orgtbl-to-csv
+ val '(:fmt (lambda (el) (if (stringp el)
+ el
+ (format "%S" el)))))))
+ data-file)
+ (if (stringp val) val (format "%S" val))))
body)))
vars)
body)
@@ -147,7 +142,7 @@ This function is called by `org-babel-execute-src-block'."
(mapcar (lambda (row)
(if (equal 'hline row)
'hline
- (mapcar #'org-babel-read row))) result)))
+ (mapcar #'org-babel-string-read row))) result)))
(defun org-babel-sqlite-offset-colnames (table headers-p)
"If HEADERS-P is non-nil then offset the first row as column names."
diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el
index 99951cab7bf..1f381dbe570 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -1,6 +1,6 @@
;;; ob-table.el --- support for calling org-babel functions from tables
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -24,7 +24,7 @@
;;; Commentary:
;; Should allow calling functions from org-mode tables using the
-;; function `sbe' as so...
+;; function `org-sbe' as so...
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
@@ -47,10 +47,10 @@
;; | 7 | |
;; | 8 | |
;; | 9 | |
-;; #+TBLFM: $2='(sbe 'fibbd (n $1))
+;; #+TBLFM: $2='(org-sbe 'fibbd (n $1))
;;; Code:
-(require 'ob)
+(require 'ob-core)
(defun org-babel-table-truncate-at-newline (string)
"Replace newline character with ellipses.
@@ -60,14 +60,14 @@ character and replace it with ellipses."
(concat (substring string 0 (match-beginning 0))
(if (match-string 1 string) "...")) string))
-(defmacro sbe (source-block &rest variables)
+(defmacro org-sbe (source-block &rest variables)
"Return the results of calling SOURCE-BLOCK with VARIABLES.
Each element of VARIABLES should be a two
element list, whose first element is the name of the variable and
second element is a string of its value. The following call to
-`sbe' would be equivalent to the following source code block.
+`org-sbe' would be equivalent to the following source code block.
- (sbe 'source-block (n $2) (m 3))
+ (org-sbe 'source-block (n $2) (m 3))
#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
results
@@ -84,7 +84,8 @@ the header argument which can then be passed before all variables
as shown in the example below.
| 1 | 2 | :file nothing.png | nothing.png |
-#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))"
+#+TBLFM: @1$4='(org-sbe test-sbe $3 (x $1) (y $2))"
+ (declare (debug (form form)))
(let* ((header-args (if (stringp (car variables)) (car variables) ""))
(variables (if (stringp (car variables)) (cdr variables) variables)))
(let* (quote
@@ -97,39 +98,41 @@ as shown in the example below.
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
- (prog1 (if quote
- (format "\"%s\"" el)
- (org-no-properties el))
+ (prog1
+ (cond
+ (quote (format "\"%s\"" el))
+ ((stringp el) (org-no-properties el))
+ (t el))
(setq quote nil))))
(cdr var)))))
variables)))
(unless (stringp source-block)
(setq source-block (symbol-name source-block)))
- ((lambda (result)
- (org-babel-trim (if (stringp result) result (format "%S" result))))
- (if (and source-block (> (length source-block) 0))
- (let ((params
- (eval `(org-babel-parse-header-arguments
- (concat
- ":var results="
- ,source-block
- "[" ,header-args "]"
- "("
- (mapconcat
- (lambda (var-spec)
- (if (> (length (cdr var-spec)) 1)
- (format "%S='%S"
- (car var-spec)
- (mapcar #'read (cdr var-spec)))
- (format "%S=%s"
- (car var-spec) (cadr var-spec))))
- ',variables ", ")
- ")")))))
- (org-babel-execute-src-block
- nil (list "emacs-lisp" "results" params)
- '((:results . "silent"))))
- "")))))
-(def-edebug-spec sbe (form form))
+ (let ((result
+ (if (and source-block (> (length source-block) 0))
+ (let ((params
+ ;; FIXME: Why `eval'?!?!?
+ (eval `(org-babel-parse-header-arguments
+ (concat
+ ":var results="
+ ,source-block
+ "[" ,header-args "]"
+ "("
+ (mapconcat
+ (lambda (var-spec)
+ (if (> (length (cdr var-spec)) 1)
+ (format "%S='%S"
+ (car var-spec)
+ (mapcar #'read (cdr var-spec)))
+ (format "%S=%s"
+ (car var-spec) (cadr var-spec))))
+ ',variables ", ")
+ ")")))))
+ (org-babel-execute-src-block
+ nil (list "emacs-lisp" "results" params)
+ '((:results . "silent"))))
+ "")))
+ (org-babel-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index c3b6a483ee6..732522c3773 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -1,6 +1,6 @@
;;; ob-tangle.el --- extract source code from org-mode files
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Keywords: literate programming, reproducible research
@@ -26,12 +26,14 @@
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
-(require 'ob)
(require 'org-src)
(eval-when-compile
(require 'cl))
+(declare-function org-edit-special "org" (&optional arg))
(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-store-link "org" (arg))
+(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-heading-components "org" ())
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
@@ -112,7 +114,7 @@ result. The default value is `org-babel-trim'."
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
- (find-file-noselect file)
+ (find-file-noselect file 'nowarn)
(with-current-buffer (get-file-buffer file)
(revert-buffer t t t)))
@@ -137,68 +139,48 @@ evaluating BODY."
(def-edebug-spec org-babel-with-temp-filebuffer (form body))
;;;###autoload
-(defun org-babel-load-file (file)
- "Load Emacs Lisp source code blocks in the Org-mode FILE.
-This function exports the source code using
-`org-babel-tangle' and then loads the resulting file using
-`load-file'."
- (interactive "fFile to load: ")
- (let* ((age (lambda (file)
- (float-time
- (time-subtract (current-time)
- (nth 5 (or (file-attributes (file-truename file))
- (file-attributes file)))))))
- (base-name (file-name-sans-extension file))
- (exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
- (unless (and (file-exists-p exported-file)
- (> (funcall age file) (funcall age exported-file)))
- (org-babel-tangle-file file exported-file "emacs-lisp"))
- (load-file exported-file)
- (message "Loaded %s" exported-file)))
-
-;;;###autoload
(defun org-babel-tangle-file (file &optional target-file lang)
"Extract the bodies of source code blocks in FILE.
Source code blocks are extracted with `org-babel-tangle'.
Optional argument TARGET-FILE can be used to specify a default
export file for all source blocks. Optional argument LANG can be
-used to limit the exported source code blocks by language."
+used to limit the exported source code blocks by language.
+Return a list whose CAR is the tangled file name."
(interactive "fFile to tangle: \nP")
(let ((visited-p (get-file-buffer (expand-file-name file)))
to-be-removed)
- (save-window-excursion
- (find-file file)
- (setq to-be-removed (current-buffer))
- (org-babel-tangle nil target-file lang))
- (unless visited-p
- (kill-buffer to-be-removed))))
+ (prog1
+ (save-window-excursion
+ (find-file file)
+ (setq to-be-removed (current-buffer))
+ (org-babel-tangle nil target-file lang))
+ (unless visited-p
+ (kill-buffer to-be-removed)))))
(defun org-babel-tangle-publish (_ filename pub-dir)
"Tangle FILENAME and place the results in PUB-DIR."
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload
-(defun org-babel-tangle (&optional only-this-block target-file lang)
+(defun org-babel-tangle (&optional arg target-file lang)
"Write code blocks to source-specific files.
Extract the bodies of all source code blocks from the current
-file into their own source-specific files. Optional argument
-TARGET-FILE can be used to specify a default export file for all
-source blocks. Optional argument LANG can be used to limit the
-exported source code blocks by language."
+file into their own source-specific files.
+With one universal prefix argument, only tangle the block at point.
+When two universal prefix arguments, only tangle blocks for the
+tangle file of the block at point.
+Optional argument TARGET-FILE can be used to specify a default
+export file for all source blocks. Optional argument LANG can be
+used to limit the exported source code blocks by language."
(interactive "P")
(run-hooks 'org-babel-pre-tangle-hook)
- ;; possibly restrict the buffer to the current code block
+ ;; Possibly Restrict the buffer to the current code block
(save-restriction
- (when only-this-block
- (unless (org-babel-where-is-src-block-head)
- (error "Point is not currently inside of a code block"))
- (save-match-data
- (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
- target-file)
- (setq target-file
- (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
- (narrow-to-region (match-beginning 0) (match-end 0)))
+ (when (equal arg '(4))
+ (let ((head (org-babel-where-is-src-block-head)))
+ (if head
+ (goto-char head)
+ (user-error "Point is not in a source code block"))))
(save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
@@ -206,6 +188,10 @@ exported source code blocks by language."
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle target-file)))
org-babel-default-header-args))
+ (tangle-file
+ (when (equal arg '(16))
+ (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
(lambda (by-lang)
@@ -224,8 +210,9 @@ exported source code blocks by language."
(lambda (spec)
(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
(let* ((tangle (funcall get-spec :tangle))
- (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
- (funcall get-spec :shebang)))
+ (she-bang (let ((sheb (funcall get-spec :shebang)))
+ (when (> (length sheb) 0) sheb)))
+ (tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
@@ -237,14 +224,15 @@ exported source code blocks by language."
(if (and ext (string= "yes" tangle))
(concat base-name "." ext) base-name))))
(when file-name
- ;; possibly create the parent directories for file
- (when ((lambda (m) (and m (not (string= m "no"))))
- (funcall get-spec :mkdirp))
- (make-directory (file-name-directory file-name) 'parents))
+ ;; Possibly create the parent directories for file.
+ (let ((m (funcall get-spec :mkdirp))
+ (fnd (file-name-directory file-name)))
+ (and m fnd (not (string= m "no"))
+ (make-directory fnd 'parents)))
;; delete any old versions of file
- (when (and (file-exists-p file-name)
- (not (member file-name path-collector)))
- (delete-file file-name))
+ (and (file-exists-p file-name)
+ (not (member file-name (mapcar #'car path-collector)))
+ (delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
@@ -261,24 +249,35 @@ exported source code blocks by language."
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
- (when she-bang (set-file-modes file-name #o755))
+ (when she-bang
+ (unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
+ (add-to-list 'path-collector
+ (cons file-name tangle-mode)
+ nil
+ (lambda (a b) (equal (car a) (car b))))))))
specs)))
- (org-babel-tangle-collect-blocks lang))
+ (if (equal arg '(4))
+ (org-babel-tangle-single-block 1 t)
+ (org-babel-tangle-collect-blocks lang tangle-file)))
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
- (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ (buffer-file-name
+ (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
- path-collector))
- path-collector))))
+ (mapcar #'car path-collector)))
+ ;; set permissions on tangled files
+ (mapc (lambda (pair)
+ (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
+ path-collector)
+ (mapcar #'car path-collector)))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@@ -298,10 +297,10 @@ references."
(defvar org-bracket-link-regexp)
(defun org-babel-spec-to-string (spec)
"Insert SPEC into the current file.
-Insert the source-code specified by SPEC into the current
-source code file. This function uses `comment-region' which
-assumes that the appropriate major-mode is set. SPEC has the
-form
+
+Insert the source-code specified by SPEC into the current source
+code file. This function uses `comment-region' which assumes
+that the appropriate major-mode is set. SPEC has the form:
(start-line file link source-name params body comment)"
(let* ((start-line (nth 0 spec))
@@ -316,9 +315,8 @@ form
(string= comments "yes") (string= comments "noweb")))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
+ (let ((le (eval el)))
+ (if (stringp le) le (format "%S" le)))))
'(start-line file link source-name)))
(insert-comment (lambda (text)
(when (and comments (not (string= comments "no"))
@@ -335,116 +333,137 @@ form
(insert
(format
"%s\n"
- (replace-regexp-in-string
- "^," ""
+ (org-unescape-code-in-string
(org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
(when link-p
(funcall
insert-comment
(org-fill-template org-babel-tangle-comment-format-end link-data)))))
-(defun org-babel-tangle-collect-blocks (&optional language)
+(defvar org-comment-string) ;; Defined in org.el
+(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
"Collect source blocks in the current Org-mode file.
Return an association list of source-code block specifications of
the form used by `org-babel-spec-to-string' grouped by language.
-Optional argument LANG can be used to limit the collected source
-code blocks by language."
- (let ((block-counter 1) (current-heading "") blocks)
+Optional argument LANGUAGE can be used to limit the collected
+source code blocks by language. Optional argument TANGLE-FILE
+can be used to limit the collected code blocks by target file."
+ (let ((block-counter 1) (current-heading "") blocks by-lang)
(org-babel-map-src-blocks (buffer-file-name)
- ((lambda (new-heading)
- (if (not (string= new-heading current-heading))
- (progn
- (setq block-counter 1)
- (setq current-heading new-heading))
- (setq block-counter (+ 1 block-counter))))
- (replace-regexp-in-string "[ \t]" "-"
- (condition-case nil
- (or (nth 4 (org-heading-components))
- "(dummy for heading without text)")
- (error (buffer-file-name)))))
- (let* ((start-line (save-restriction (widen)
- (+ 1 (line-number-at-pos (point)))))
- (file (buffer-file-name))
- (info (org-babel-get-src-block-info 'light))
- (src-lang (nth 0 info)))
- (unless (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (lambda (new-heading)
+ (if (not (string= new-heading current-heading))
+ (progn
+ (setq block-counter 1)
+ (setq current-heading new-heading))
+ (setq block-counter (+ 1 block-counter))))
+ (replace-regexp-in-string "[ \t]" "-"
+ (condition-case nil
+ (or (nth 4 (org-heading-components))
+ "(dummy for heading without text)")
+ (error (buffer-file-name))))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (src-lang (nth 0 info))
+ (src-tfile (cdr (assoc :tangle (nth 2 info)))))
+ (unless (or (string-match (concat "^" org-comment-string) current-heading)
+ (string= (cdr (assoc :tangle (nth 2 info))) "no")
+ (and tangle-file (not (equal tangle-file src-tfile))))
(unless (and language (not (string= language src-lang)))
- (let* ((info (org-babel-get-src-block-info))
- (params (nth 2 info))
- (extra (nth 3 info))
- (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
- (match-string 1 extra))
- org-coderef-label-format))
- (link ((lambda (link)
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link)))
- (org-no-properties
- (org-store-link nil))))
- (source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- current-heading block-counter))))
- (expand-cmd
- (intern (concat "org-babel-expand-body:" src-lang)))
- (assignments-cmd
- (intern (concat "org-babel-variable-assignments:" src-lang)))
- (body
- ((lambda (body) ;; run the tangle-body-hook
- (with-temp-buffer
- (insert body)
- (when (string-match "-r" extra)
- (goto-char (point-min))
- (while (re-search-forward
- (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
- (replace-match "")))
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string)))
- ((lambda (body) ;; expand the body in language specific manner
- (if (assoc :no-expand params)
- body
- (if (fboundp expand-cmd)
- (funcall expand-cmd body params)
- (org-babel-expand-body:generic
- body params
- (and (fboundp assignments-cmd)
- (funcall assignments-cmd params))))))
- (if (org-babel-noweb-p params :tangle)
- (org-babel-expand-noweb-references info)
- (nth 1 info)))))
- (comment
- (when (or (string= "both" (cdr (assoc :comments params)))
- (string= "org" (cdr (assoc :comments params))))
- ;; from the previous heading or code-block end
- (funcall
- org-babel-process-comment-text
- (buffer-substring
- (max (condition-case nil
- (save-excursion
- (org-back-to-heading t) ; sets match data
- (match-end 0))
- (error (point-min)))
- (save-excursion
- (if (re-search-backward
- org-babel-src-block-regexp nil t)
- (match-end 0)
- (point-min))))
- (point)))))
- by-lang)
- ;; add the spec for this block to blocks under it's language
- (setq by-lang (cdr (assoc src-lang blocks)))
- (setq blocks (delq (assoc src-lang blocks) blocks))
- (setq blocks (cons
- (cons src-lang
- (cons (list start-line file link
- source-name params body comment)
- by-lang)) blocks)))))))
- ;; ensure blocks in the correct order
+ ;; Add the spec for this block to blocks under it's language
+ (setq by-lang (cdr (assoc src-lang blocks)))
+ (setq blocks (delq (assoc src-lang blocks) blocks))
+ (setq blocks (cons
+ (cons src-lang
+ (cons
+ (org-babel-tangle-single-block
+ block-counter)
+ by-lang)) blocks))))))
+ ;; Ensure blocks are in the correct order
(setq blocks
(mapcar
(lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
blocks))
blocks))
+(defun org-babel-tangle-single-block
+ (block-counter &optional only-this-block)
+ "Collect the tangled source for current block.
+Return the list of block attributes needed by
+`org-babel-tangle-collect-blocks'.
+When ONLY-THIS-BLOCK is non-nil, return the full association
+list to be used by `org-babel-tangle' directly."
+ (let* ((info (org-babel-get-src-block-info))
+ (start-line
+ (save-restriction (widen)
+ (+ 1 (line-number-at-pos (point)))))
+ (file (buffer-file-name))
+ (src-lang (nth 0 info))
+ (params (nth 2 info))
+ (extra (nth 3 info))
+ (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
+ (match-string 1 extra))
+ org-coderef-label-format))
+ (link (let ((link (org-no-properties
+ (org-store-link nil))))
+ (and (string-match org-bracket-link-regexp link)
+ (match-string 1 link))))
+ (source-name
+ (intern (or (nth 4 info)
+ (format "%s:%d"
+ (or (ignore-errors (nth 4 (org-heading-components)))
+ "No heading")
+ block-counter))))
+ (expand-cmd
+ (intern (concat "org-babel-expand-body:" src-lang)))
+ (assignments-cmd
+ (intern (concat "org-babel-variable-assignments:" src-lang)))
+ (body
+ ;; Run the tangle-body-hook.
+ (let* ((body ;; Expand the body in language specific manner.
+ (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))
+ (body
+ (if (assoc :no-expand params)
+ body
+ (if (fboundp expand-cmd)
+ (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params
+ (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params)))))))
+ (with-temp-buffer
+ (insert body)
+ (when (string-match "-r" extra)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+ (replace-match "")))
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string))))
+ (comment
+ (when (or (string= "both" (cdr (assoc :comments params)))
+ (string= "org" (cdr (assoc :comments params))))
+ ;; From the previous heading or code-block end
+ (funcall
+ org-babel-process-comment-text
+ (buffer-substring
+ (max (condition-case nil
+ (save-excursion
+ (org-back-to-heading t) ; Sets match data
+ (match-end 0))
+ (error (point-min)))
+ (save-excursion
+ (if (re-search-backward
+ org-babel-src-block-regexp nil t)
+ (match-end 0)
+ (point-min))))
+ (point)))))
+ (result
+ (list start-line file link source-name params body comment)))
+ (if only-this-block
+ (list (cons src-lang (list result)))
+ result)))
+
(defun org-babel-tangle-comment-links ( &optional info)
"Return a list of begin and end link comments for the code block at point."
(let* ((start-line (org-babel-where-is-src-block-head))
@@ -455,9 +474,8 @@ code blocks by language."
(source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(link-data (mapcar (lambda (el)
(cons (symbol-name el)
- ((lambda (le)
- (if (stringp le) le (format "%S" le)))
- (eval el))))
+ (let ((le (eval el)))
+ (if (stringp le) le (format "%S" le)))))
'(start-line file link source-name))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
@@ -489,13 +507,15 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org-mode file."
(interactive)
(let ((mid (point))
- start end done
+ start body-start end done
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
(and (setq start (point-at-eol))
+ (setq body-start (save-excursion
+ (forward-line 2) (point-at-bol)))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
@@ -516,8 +536,19 @@ which enable the original code blocks to be found."
(org-babel-next-src-block
(string-to-number (match-string 1 block-name)))
(org-babel-goto-named-src-block block-name))
+ ;; position at the beginning of the code block body
+ (goto-char (org-babel-where-is-src-block-head))
+ (forward-line 1)
+ ;; Use org-edit-special to isolate the code.
+ (org-edit-special)
+ ;; Then move forward the correct number of characters in the
+ ;; code buffer.
+ (forward-char (- mid body-start))
+ ;; And return to the Org-mode buffer with the point in the right
+ ;; place.
+ (org-edit-src-exit)
(setq target-char (point)))
- (pop-to-buffer target-buffer)
+ (org-src-switch-to-buffer target-buffer t)
(prog1 body (goto-char target-char))))
(provide 'ob-tangle)
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index 724571481f7..42137c29ec0 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -1,9 +1,8 @@
;;; ob.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Authors: Eric Schulte
-;; Dan Davison
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -23,2564 +22,17 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'ob-eval)
(require 'org-macs)
(require 'org-compat)
-
-(defconst org-babel-exeext
- (if (memq system-type '(windows-nt cygwin))
- ".exe"
- nil))
-(defvar org-babel-call-process-region-original)
-(defvar org-src-lang-modes)
-(defvar org-babel-library-of-babel)
-(declare-function show-all "outline" ())
-(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
-(declare-function org-mark-ring-push "org" (&optional pos buffer))
-(declare-function tramp-compat-make-temp-file "tramp-compat"
- (filename &optional dir-flag))
-(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
-(declare-function tramp-file-name-user "tramp" (vec))
-(declare-function tramp-file-name-host "tramp" (vec))
-(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body))
-(declare-function org-icompleting-read "org" (&rest args))
-(declare-function org-edit-src-code "org-src"
- (&optional context code edit-buffer-name quietp))
-(declare-function org-edit-src-exit "org-src" (&optional context))
-(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body))
-(declare-function org-outline-overlay-data "org" (&optional use-markers))
-(declare-function org-set-outline-overlay-data "org" (data))
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
-(declare-function org-make-options-regexp "org" (kwds &optional extra))
-(declare-function org-do-remove-indentation "org" (&optional n))
-(declare-function org-show-context "org" (&optional key))
-(declare-function org-at-table-p "org" (&optional table-type))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-uniquify "org" (list))
-(declare-function org-current-level "org" ())
-(declare-function org-table-import "org-table" (file arg))
-(declare-function org-add-hook "org-compat"
- (hook function &optional append local))
-(declare-function org-table-align "org-table" ())
-(declare-function org-table-end "org-table" (&optional table-type))
-(declare-function orgtbl-to-generic "org-table" (table params))
-(declare-function orgtbl-to-orgtbl "org-table" (table params))
-(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
-(declare-function org-babel-lob-get-info "ob-lob" nil)
-(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
-(declare-function org-babel-ref-parse "ob-ref" (assignment))
-(declare-function org-babel-ref-resolve "ob-ref" (ref))
-(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
-(declare-function org-babel-ref-headline-body "ob-ref" ())
-(declare-function org-babel-lob-execute-maybe "ob-lob" ())
-(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-at-item-p "org-list" ())
-(declare-function org-list-parse-list "org-list" (&optional delete))
-(declare-function org-list-to-generic "org-list" (LIST PARAMS))
-(declare-function org-list-struct "org-list" ())
-(declare-function org-list-prevs-alist "org-list" (struct))
-(declare-function org-list-get-list-end "org-list" (item struct prevs))
-(declare-function org-remove-if "org" (predicate seq))
-(declare-function org-completing-read "org" (&rest args))
-(declare-function org-escape-code-in-region "org-src" (beg end))
-(declare-function org-unescape-code-in-string "org-src" (s))
-(declare-function org-table-to-lisp "org-table" (&optional txt))
-
-(defgroup org-babel nil
- "Code block evaluation and management in `org-mode' documents."
- :tag "Babel"
- :group 'org)
-
-(defcustom org-confirm-babel-evaluate t
- "Confirm before evaluation.
-Require confirmation before interactively evaluating code
-blocks in Org-mode buffers. The default value of this variable
-is t, meaning confirmation is required for any code block
-evaluation. This variable can be set to nil to inhibit any
-future confirmation requests. This variable can also be set to a
-function which takes two arguments the language of the code block
-and the body of the code block. Such a function should then
-return a non-nil value if the user should be prompted for
-execution or nil if no prompt is required.
-
-Warning: Disabling confirmation may result in accidental
-evaluation of potentially harmful code. It may be advisable
-remove code block execution from C-c C-c as further protection
-against accidental code block evaluation. The
-`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
-remove code block execution from the C-c C-c keybinding."
- :group 'org-babel
- :version "24.1"
- :type '(choice boolean function))
-;; don't allow this variable to be changed through file settings
-(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
-
-(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
- "Remove code block evaluation from the C-c C-c key binding."
- :group 'org-babel
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-babel-results-keyword "RESULTS"
- "Keyword used to name results generated by code blocks.
-Should be either RESULTS or NAME however any capitalization may
-be used."
- :group 'org-babel
- :type 'string)
-
-(defcustom org-babel-noweb-wrap-start "<<"
- "String used to begin a noweb reference in a code block.
-See also `org-babel-noweb-wrap-end'."
- :group 'org-babel
- :type 'string)
-
-(defcustom org-babel-noweb-wrap-end ">>"
- "String used to end a noweb reference in a code block.
-See also `org-babel-noweb-wrap-start'."
- :group 'org-babel
- :type 'string)
-
-(defun org-babel-noweb-wrap (&optional regexp)
- (concat org-babel-noweb-wrap-start
- (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
- org-babel-noweb-wrap-end))
-
-(defvar org-babel-src-name-regexp
- "^[ \t]*#\\+name:[ \t]*"
- "Regular expression used to match a source name line.")
-
-(defvar org-babel-multi-line-header-regexp
- "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
- "Regular expression used to match multi-line header arguments.")
-
-(defvar org-babel-src-name-w-name-regexp
- (concat org-babel-src-name-regexp
- "\\("
- org-babel-multi-line-header-regexp
- "\\)*"
- "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")
- "Regular expression matching source name lines with a name.")
-
-(defvar org-babel-src-block-regexp
- (concat
- ;; (1) indentation (2) lang
- "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
- ;; (3) switches
- "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
- ;; (4) header arguments
- "\\([^\n]*\\)\n"
- ;; (5) body
- "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
- "Regexp used to identify code blocks.")
-
-(defvar org-babel-inline-src-block-regexp
- (concat
- ;; (1) replacement target (2) lang
- "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
- ;; (3,4) (unused, headers)
- "\\(\\|\\[\\(.*?\\)\\]\\)"
- ;; (5) body
- "{\\([^\f\n\r\v]+?\\)}\\)")
- "Regexp used to identify inline src-blocks.")
-
-(defun org-babel-get-header (params key &optional others)
- "Select only header argument of type KEY from a list.
-Optional argument OTHERS indicates that only the header that do
-not match KEY should be returned."
- (delq nil
- (mapcar
- (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
- params)))
-
-(defun org-babel-get-inline-src-block-matches()
- "Set match data if within body of an inline source block.
-Returns non-nil if match-data set"
- (let ((src-at-0-p (save-excursion
- (beginning-of-line 1)
- (string= "src" (thing-at-point 'word))))
- (first-line-p (= 1 (line-number-at-pos)))
- (orig (point)))
- (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
- (first-line-p "[[:punct:] \t]src_")
- (t "[[:punct:] \f\t\n\r\v]src_")))
- (lower-limit (if first-line-p
- nil
- (- (point-at-bol) 1))))
- (save-excursion
- (when (or (and src-at-0-p (bobp))
- (and (re-search-forward "}" (point-at-eol) t)
- (re-search-backward search-for lower-limit t)
- (> orig (point))))
- (when (looking-at org-babel-inline-src-block-regexp)
- t ))))))
-
-(defvar org-babel-inline-lob-one-liner-regexp)
-(defun org-babel-get-lob-one-liner-matches()
- "Set match data if on line of an lob one liner.
-Returns non-nil if match-data set"
- (save-excursion
- (unless (= (point) (point-at-bol)) ;; move before inline block
- (re-search-backward "[ \f\t\n\r\v]" nil t))
- (if (looking-at org-babel-inline-lob-one-liner-regexp)
- t
- nil)))
-
-(defun org-babel-get-src-block-info (&optional light)
- "Get information on the current source block.
-
-Optional argument LIGHT does not resolve remote variable
-references; a process which could likely result in the execution
-of other code blocks.
-
-Returns a list
- (language body header-arguments-alist switches name indent)."
- (let ((case-fold-search t) head info name indent)
- ;; full code block
- (if (setq head (org-babel-where-is-src-block-head))
- (save-excursion
- (goto-char head)
- (setq info (org-babel-parse-src-block-match))
- (setq indent (car (last info)))
- (setq info (butlast info))
- (while (and (forward-line -1)
- (looking-at org-babel-multi-line-header-regexp))
- (setf (nth 2 info)
- (org-babel-merge-params
- (nth 2 info)
- (org-babel-parse-header-arguments (match-string 1)))))
- (when (looking-at org-babel-src-name-w-name-regexp)
- (setq name (org-no-properties (match-string 3)))
- (when (and (match-string 5) (> (length (match-string 5)) 0))
- (setf (nth 2 info) ;; merge functional-syntax vars and header-args
- (org-babel-merge-params
- (mapcar
- (lambda (ref) (cons :var ref))
- (mapcar
- (lambda (var) ;; check that each variable is initialized
- (if (string-match ".+=.+" var)
- var
- (error
- "variable \"%s\"%s must be assigned a default value"
- var (if name (format " in block \"%s\"" name) ""))))
- (org-babel-ref-split-args (match-string 5))))
- (nth 2 info))))))
- ;; inline source block
- (when (org-babel-get-inline-src-block-matches)
- (setq info (org-babel-parse-inline-src-block-match))))
- ;; resolve variable references and add summary parameters
- (when (and info (not light))
- (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
- (when info (append info (list name indent)))))
-
-(defvar org-current-export-file) ; dynamically bound
-(defun org-babel-confirm-evaluate (info)
- "Confirm evaluation of the code block INFO.
-This behavior can be suppressed by setting the value of
-`org-confirm-babel-evaluate' to nil, in which case all future
-interactive code block evaluations will proceed without any
-confirmation from the user.
-
-Note disabling confirmation may result in accidental evaluation
-of potentially harmful code."
- (let* ((eval (or (cdr (assoc :eval (nth 2 info)))
- (when (assoc :noeval (nth 2 info)) "no")))
- (query (cond ((equal eval "query") t)
- ((and (boundp 'org-current-export-file)
- org-current-export-file
- (equal eval "query-export")) t)
- ((functionp org-confirm-babel-evaluate)
- (funcall org-confirm-babel-evaluate
- (nth 0 info) (nth 1 info)))
- (t org-confirm-babel-evaluate))))
- (if (or (equal eval "never") (equal eval "no")
- (and (boundp 'org-current-export-file)
- org-current-export-file
- (or (equal eval "no-export")
- (equal eval "never-export")))
- (and query
- (not (yes-or-no-p
- (format "Evaluate this%scode block%son your system? "
- (if info (format " %s " (nth 0 info)) " ")
- (if (nth 4 info)
- (format " (%s) " (nth 4 info)) " "))))))
- (prog1 nil (message "Evaluation %s"
- (if (or (equal eval "never") (equal eval "no")
- (equal eval "no-export")
- (equal eval "never-export"))
- "Disabled" "Aborted")))
- t)))
-
-;;;###autoload
-(defun org-babel-execute-safely-maybe ()
- (unless org-babel-no-eval-on-ctrl-c-ctrl-c
- (org-babel-execute-maybe)))
-
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
-
-;;;###autoload
-(defun org-babel-execute-maybe ()
- (interactive)
- (or (org-babel-execute-src-block-maybe)
- (org-babel-lob-execute-maybe)))
-
-(defun org-babel-execute-src-block-maybe ()
- "Conditionally execute a source block.
-Detect if this is context for a Babel src-block and if so
-then run `org-babel-execute-src-block'."
- (interactive)
- (let ((info (org-babel-get-src-block-info)))
- (if info
- (progn (org-babel-eval-wipe-error-buffer)
- (org-babel-execute-src-block current-prefix-arg info) t) nil)))
-
-;;;###autoload
-(defun org-babel-view-src-block-info ()
- "Display information on the current source block.
-This includes header arguments, language and name, and is largely
-a window into the `org-babel-get-src-block-info' function."
- (interactive)
- (let ((info (org-babel-get-src-block-info 'light))
- (full (lambda (it) (> (length it) 0)))
- (printf (lambda (fmt &rest args) (princ (apply #'format fmt args)))))
- (when info
- (with-help-window (help-buffer)
- (let ((name (nth 4 info))
- (lang (nth 0 info))
- (switches (nth 3 info))
- (header-args (nth 2 info)))
- (when name (funcall printf "Name: %s\n" name))
- (when lang (funcall printf "Lang: %s\n" lang))
- (when (funcall full switches) (funcall printf "Switches: %s\n" switches))
- (funcall printf "Header Arguments:\n")
- (dolist (pair (sort header-args
- (lambda (a b) (string< (symbol-name (car a))
- (symbol-name (car b))))))
- (when (funcall full (cdr pair))
- (funcall printf "\t%S%s\t%s\n"
- (car pair)
- (if (> (length (format "%S" (car pair))) 7) "" "\t")
- (cdr pair)))))))))
-
-;;;###autoload
-(defun org-babel-expand-src-block-maybe ()
- "Conditionally expand a source block.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-expand-src-block'."
- (interactive)
- (let ((info (org-babel-get-src-block-info)))
- (if info
- (progn (org-babel-expand-src-block current-prefix-arg info) t)
- nil)))
-
-;;;###autoload
-(defun org-babel-load-in-session-maybe ()
- "Conditionally load a source block in a session.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-load-in-session'."
- (interactive)
- (let ((info (org-babel-get-src-block-info)))
- (if info
- (progn (org-babel-load-in-session current-prefix-arg info) t)
- nil)))
-
-(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe)
-
-;;;###autoload
-(defun org-babel-pop-to-session-maybe ()
- "Conditionally pop to a session.
-Detect if this is context for a org-babel src-block and if so
-then run `org-babel-pop-to-session'."
- (interactive)
- (let ((info (org-babel-get-src-block-info)))
- (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil)))
-
-(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe)
-
-(defconst org-babel-common-header-args-w-values
- '((cache . ((no yes)))
- (cmdline . :any)
- (colnames . ((nil no yes)))
- (comments . ((no link yes org both noweb)))
- (dir . :any)
- (eval . ((never query)))
- (exports . ((code results both none)))
- (file . :any)
- (file-desc . :any)
- (hlines . ((no yes)))
- (mkdirp . ((yes no)))
- (no-expand)
- (noeval)
- (noweb . ((yes no tangle no-export strip-export)))
- (noweb-ref . :any)
- (noweb-sep . :any)
- (padline . ((yes no)))
- (results . ((file list vector table scalar verbatim)
- (raw html latex org code pp drawer)
- (replace silent append prepend)
- (output value)))
- (rownames . ((no yes)))
- (sep . :any)
- (session . :any)
- (shebang . :any)
- (tangle . ((tangle yes no :any)))
- (var . :any)
- (wrap . :any)))
-
-(defconst org-babel-header-arg-names
- (mapcar #'car org-babel-common-header-args-w-values)
- "Common header arguments used by org-babel.
-Note that individual languages may define their own language
-specific header arguments as well.")
-
-(defvar org-babel-default-header-args
- '((:session . "none") (:results . "replace") (:exports . "code")
- (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")
- (:padnewline . "yes"))
- "Default arguments to use when evaluating a source block.")
-
-(defvar org-babel-default-inline-header-args
- '((:session . "none") (:results . "replace") (:exports . "results"))
- "Default arguments to use when evaluating an inline source block.")
-
-(defvar org-babel-data-names '("tblname" "results" "name"))
-
-(defvar org-babel-result-regexp
- (concat "^[ \t]*#\\+"
- (regexp-opt org-babel-data-names t)
- "\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
- "Regular expression used to match result lines.
-If the results are associated with a hash key then the hash will
-be saved in the second match data.")
-
-(defvar org-babel-result-w-name-regexp
- (concat org-babel-result-regexp
- "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)"))
-
-(defvar org-babel-min-lines-for-block-output 10
- "The minimum number of lines for block output.
-If number of lines of output is equal to or exceeds this
-value, the output is placed in a #+begin_example...#+end_example
-block. Otherwise the output is marked as literal by inserting
-colons at the starts of the lines. This variable only takes
-effect if the :results output option is in effect.")
-
-(defvar org-babel-noweb-error-langs nil
- "Languages for which Babel will raise literate programming errors.
-List of languages for which errors should be raised when the
-source code block satisfying a noweb reference in this language
-can not be resolved.")
-
-(defvar org-babel-hash-show 4
- "Number of initial characters to show of a hidden results hash.")
-
-(defvar org-babel-after-execute-hook nil
- "Hook for functions to be called after `org-babel-execute-src-block'")
-
-(defun org-babel-named-src-block-regexp-for-name (name)
- "This generates a regexp used to match a src block named NAME."
- (concat org-babel-src-name-regexp (regexp-quote name)
- "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
- (substring org-babel-src-block-regexp 1)))
-
-(defun org-babel-named-data-regexp-for-name (name)
- "This generates a regexp used to match data named NAME."
- (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
-
-;;; functions
-(defvar call-process-region)
-
-;;;###autoload
-(defun org-babel-execute-src-block (&optional arg info params)
- "Execute the current source code block.
-Insert the results of execution into the buffer. Source code
-execution and the collection and formatting of results can be
-controlled through a variety of header arguments.
-
-With prefix argument ARG, force re-execution even if an existing
-result cached in the buffer would otherwise have been returned.
-
-Optionally supply a value for INFO in the form returned by
-`org-babel-get-src-block-info'.
-
-Optionally supply a value for PARAMS which will be merged with
-the header arguments specified at the front of the source code
-block."
- (interactive)
- (let ((info (or info (org-babel-get-src-block-info))))
- (when (org-babel-confirm-evaluate
- (let ((i info))
- (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params))
- i))
- (let* ((lang (nth 0 info))
- (params (if params
- (org-babel-process-params
- (org-babel-merge-params (nth 2 info) params))
- (nth 2 info)))
- (cache? (and (not arg) (cdr (assoc :cache params))
- (string= "yes" (cdr (assoc :cache params)))))
- (result-params (cdr (assoc :result-params params)))
- (new-hash (when cache? (org-babel-sha1-hash info)))
- (old-hash (when cache? (org-babel-current-result-hash)))
- (body (setf (nth 1 info)
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info)
- (nth 1 info))))
- (dir (cdr (assoc :dir params)))
- (default-directory
- (or (and dir (file-name-as-directory (expand-file-name dir)))
- default-directory))
- (org-babel-call-process-region-original
- (if (boundp 'org-babel-call-process-region-original)
- org-babel-call-process-region-original
- (symbol-function 'call-process-region)))
- (indent (car (last info)))
- result cmd)
- (unwind-protect
- (let ((call-process-region
- (lambda (&rest args)
- (apply 'org-babel-tramp-handle-call-process-region args))))
- (let ((lang-check (lambda (f)
- (let ((f (intern (concat "org-babel-execute:" f))))
- (when (fboundp f) f)))))
- (setq cmd
- (or (funcall lang-check lang)
- (funcall lang-check (symbol-name
- (cdr (assoc lang org-src-lang-modes))))
- (error "No org-babel-execute function for %s!" lang))))
- (if (and (not arg) new-hash (equal new-hash old-hash))
- (save-excursion ;; return cached result
- (goto-char (org-babel-where-is-src-block-result nil info))
- (end-of-line 1) (forward-char 1)
- (setq result (org-babel-read-result))
- (message (replace-regexp-in-string
- "%" "%%" (format "%S" result))) result)
- (message "executing %s code block%s..."
- (capitalize lang)
- (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
- (setq result
- ((lambda (result)
- (if (and (eq (cdr (assoc :result-type params)) 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp result)))
- (list (list result)) result))
- (funcall cmd body params)))
- ;; if non-empty result and :file then write to :file
- (when (cdr (assoc :file params))
- (when result
- (with-temp-file (cdr (assoc :file params))
- (insert
- (org-babel-format-result
- result (cdr (assoc :sep (nth 2 info)))))))
- (setq result (cdr (assoc :file params))))
- (org-babel-insert-result
- result result-params info new-hash indent lang)
- (run-hooks 'org-babel-after-execute-hook)
- result))
- (setq call-process-region 'org-babel-call-process-region-original))))))
-
-(defun org-babel-expand-body:generic (body params &optional var-lines)
- "Expand BODY with PARAMS.
-Expand a block of code with org-babel according to its header
-arguments. This generic implementation of body expansion is
-called for languages which have not defined their own specific
-org-babel-expand-body:lang function."
- (mapconcat #'identity (append var-lines (list body)) "\n"))
-
-;;;###autoload
-(defun org-babel-expand-src-block (&optional arg info params)
- "Expand the current source code block.
-Expand according to the source code block's header
-arguments and pop open the results in a preview buffer."
- (interactive)
- (let* ((info (or info (org-babel-get-src-block-info)))
- (lang (nth 0 info))
- (params (setf (nth 2 info)
- (sort (org-babel-merge-params (nth 2 info) params)
- (lambda (el1 el2) (string< (symbol-name (car el1))
- (symbol-name (car el2)))))))
- (body (setf (nth 1 info)
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info) (nth 1 info))))
- (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
- (assignments-cmd (intern (concat "org-babel-variable-assignments:"
- lang)))
- (expanded
- (if (fboundp expand-cmd) (funcall expand-cmd body params)
- (org-babel-expand-body:generic
- body params (and (fboundp assignments-cmd)
- (funcall assignments-cmd params))))))
- (org-edit-src-code
- nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))))
-
-(defun org-babel-edit-distance (s1 s2)
- "Return the edit (levenshtein) distance between strings S1 S2."
- (let* ((l1 (length s1))
- (l2 (length s2))
- (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil))
- (number-sequence 1 (1+ l1)))))
- (in (lambda (i j) (aref (aref dist i) j)))
- (mmin (lambda (&rest lst) (apply #'min (remove nil lst)))))
- (setf (aref (aref dist 0) 0) 0)
- (dolist (i (number-sequence 1 l1))
- (dolist (j (number-sequence 1 l2))
- (setf (aref (aref dist i) j)
- (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1)
- (funcall mmin (funcall in (1- i) j)
- (funcall in i (1- j))
- (funcall in (1- i) (1- j)))))))
- (funcall in l1 l2)))
-
-(defun org-babel-combine-header-arg-lists (original &rest others)
- "Combine a number of lists of header argument names and arguments."
- (let ((results (copy-sequence original)))
- (dolist (new-list others)
- (dolist (arg-pair new-list)
- (let ((header (car arg-pair))
- (args (cdr arg-pair)))
- (setq results
- (cons arg-pair (org-remove-if
- (lambda (pair) (equal header (car pair)))
- results))))))
- results))
-
-;;;###autoload
-(defun org-babel-check-src-block ()
- "Check for misspelled header arguments in the current code block."
- (interactive)
- ;; TODO: report malformed code block
- ;; TODO: report incompatible combinations of header arguments
- ;; TODO: report uninitialized variables
- (let ((too-close 2) ;; <- control closeness to report potential match
- (names (mapcar #'symbol-name org-babel-header-arg-names)))
- (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1))
- (and (org-babel-where-is-src-block-head)
- (org-babel-parse-header-arguments
- (org-no-properties
- (match-string 4))))))
- (dolist (name names)
- (when (and (not (string= header name))
- (<= (org-babel-edit-distance header name) too-close)
- (not (member header names)))
- (error "Supplied header \"%S\" is suspiciously close to \"%S\""
- header name))))
- (message "No suspicious header arguments found.")))
-
-;;;###autoload
-(defun org-babel-insert-header-arg ()
- "Insert a header argument selecting from lists of common args and values."
- (interactive)
- (let* ((lang (car (org-babel-get-src-block-info 'light)))
- (lang-headers (intern (concat "org-babel-header-args:" lang)))
- (headers (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (if (boundp lang-headers) (eval lang-headers) nil)))
- (arg (org-icompleting-read
- "Header Arg: "
- (mapcar
- (lambda (header-spec) (symbol-name (car header-spec)))
- headers))))
- (insert ":" arg)
- (let ((vals (cdr (assoc (intern arg) headers))))
- (when vals
- (insert
- " "
- (cond
- ((eq vals :any)
- (read-from-minibuffer "value: "))
- ((listp vals)
- (mapconcat
- (lambda (group)
- (let ((arg (org-icompleting-read
- "value: "
- (cons "default" (mapcar #'symbol-name group)))))
- (if (and arg (not (string= "default" arg)))
- (concat arg " ")
- "")))
- vals ""))))))))
-
-;; Add support for completing-read insertion of header arguments after ":"
-(defun org-babel-header-arg-expand ()
- "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts."
- (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head))
- (org-babel-enter-header-arg-w-completion (match-string 2))))
-
-(defun org-babel-enter-header-arg-w-completion (&optional lang)
- "Insert header argument appropriate for LANG with completion."
- (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
- (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
- (headers-w-values (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values lang-headers))
- (headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
- (header (org-completing-read "Header Arg: " headers))
- (args (cdr (assoc (intern header) headers-w-values)))
- (arg (when (and args (listp args))
- (org-completing-read
- (format "%s: " header)
- (mapcar #'symbol-name (apply #'append args))))))
- (insert (concat header " " (or arg "")))
- (cons header arg)))
-
-(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand)
-
-;;;###autoload
-(defun org-babel-load-in-session (&optional arg info)
- "Load the body of the current source-code block.
-Evaluate the header arguments for the source block before
-entering the session. After loading the body this pops open the
-session."
- (interactive)
- (let* ((info (or info (org-babel-get-src-block-info)))
- (lang (nth 0 info))
- (params (nth 2 info))
- (body (setf (nth 1 info)
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info)
- (nth 1 info))))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
- (default-directory
- (or (and dir (file-name-as-directory dir)) default-directory))
- (cmd (intern (concat "org-babel-load-session:" lang))))
- (unless (fboundp cmd)
- (error "No org-babel-load-session function for %s!" lang))
- (pop-to-buffer (funcall cmd session body params))
- (end-of-line 1)))
-
-;;;###autoload
-(defun org-babel-initiate-session (&optional arg info)
- "Initiate session for current code block.
-If called with a prefix argument then resolve any variable
-references in the header arguments and assign these variables in
-the session. Copy the body of the code block to the kill ring."
- (interactive "P")
- (let* ((info (or info (org-babel-get-src-block-info (not arg))))
- (lang (nth 0 info))
- (body (nth 1 info))
- (params (nth 2 info))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
- (default-directory
- (or (and dir (file-name-as-directory dir)) default-directory))
- (init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
- (prep-cmd (intern (concat "org-babel-prep-session:" lang))))
- (if (and (stringp session) (string= session "none"))
- (error "This block is not using a session!"))
- (unless (fboundp init-cmd)
- (error "No org-babel-initiate-session function for %s!" lang))
- (with-temp-buffer (insert (org-babel-trim body))
- (copy-region-as-kill (point-min) (point-max)))
- (when arg
- (unless (fboundp prep-cmd)
- (error "No org-babel-prep-session function for %s!" lang))
- (funcall prep-cmd session params))
- (funcall init-cmd session params)))
-
-;;;###autoload
-(defun org-babel-switch-to-session (&optional arg info)
- "Switch to the session of the current code block.
-Uses `org-babel-initiate-session' to start the session. If called
-with a prefix argument then this is passed on to
-`org-babel-initiate-session'."
- (interactive "P")
- (pop-to-buffer (org-babel-initiate-session arg info))
- (end-of-line 1))
-
-(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session)
-
-;;;###autoload
-(defun org-babel-switch-to-session-with-code (&optional arg info)
- "Switch to code buffer and display session."
- (interactive "P")
- (let ((swap-windows
- (lambda ()
- (let ((other-window-buffer (window-buffer (next-window))))
- (set-window-buffer (next-window) (current-buffer))
- (set-window-buffer (selected-window) other-window-buffer))
- (other-window 1)))
- (info (org-babel-get-src-block-info))
- (org-src-window-setup 'reorganize-frame))
- (save-excursion
- (org-babel-switch-to-session arg info))
- (org-edit-src-code)
- (funcall swap-windows)))
-
-(defmacro org-babel-do-in-edit-buffer (&rest body)
- "Evaluate BODY in edit buffer if there is a code block at point.
-Return t if a code block was found at point, nil otherwise."
- `(let ((org-src-window-setup 'switch-invisibly))
- (when (and (org-babel-where-is-src-block-head)
- (org-edit-src-code nil nil nil))
- (unwind-protect (progn ,@body)
- (if (org-bound-and-true-p org-edit-src-from-org-mode)
- (org-edit-src-exit)))
- t)))
-(def-edebug-spec org-babel-do-in-edit-buffer (body))
-
-(defun org-babel-do-key-sequence-in-edit-buffer (key)
- "Read key sequence and execute the command in edit buffer.
-Enter a key sequence to be executed in the language major-mode
-edit buffer. For example, TAB will alter the contents of the
-Org-mode code block according to the effect of TAB in the
-language major-mode buffer. For languages that support
-interactive sessions, this can be used to send code from the Org
-buffer to the session for evaluation using the native major-mode
-evaluation mechanisms."
- (interactive "kEnter key-sequence to execute in edit buffer: ")
- (org-babel-do-in-edit-buffer
- (call-interactively
- (key-binding (or key (read-key-sequence nil))))))
-
-(defvar org-bracket-link-regexp)
-
-;;;###autoload
-(defun org-babel-open-src-block-result (&optional re-run)
- "If `point' is on a src block then open the results of the
-source code block, otherwise return nil. With optional prefix
-argument RE-RUN the source-code block is evaluated even if
-results already exist."
- (interactive "P")
- (let ((info (org-babel-get-src-block-info)))
- (when info
- (save-excursion
- ;; go to the results, if there aren't any then run the block
- (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result))
- (progn (org-babel-execute-src-block)
- (org-babel-where-is-src-block-result))))
- (end-of-line 1)
- (while (looking-at "[\n\r\t\f ]") (forward-char 1))
- ;; open the results
- (if (looking-at org-bracket-link-regexp)
- ;; file results
- (org-open-at-point)
- (let ((r (org-babel-format-result
- (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
- (pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
- (delete-region (point-min) (point-max))
- (insert r)))
- t))))
-
-;;;###autoload
-(defmacro org-babel-map-src-blocks (file &rest body)
- "Evaluate BODY forms on each source-block in FILE.
-If FILE is nil evaluate BODY forms on source blocks in current
-buffer. During evaluation of BODY the following local variables
-are set relative to the currently matched code block.
-
-full-block ------- string holding the entirety of the code block
-beg-block -------- point at the beginning of the code block
-end-block -------- point at the end of the matched code block
-lang ------------- string holding the language of the code block
-beg-lang --------- point at the beginning of the lang
-end-lang --------- point at the end of the lang
-switches --------- string holding the switches
-beg-switches ----- point at the beginning of the switches
-end-switches ----- point at the end of the switches
-header-args ------ string holding the header-args
-beg-header-args -- point at the beginning of the header-args
-end-header-args -- point at the end of the header-args
-body ------------- string holding the body of the code block
-beg-body --------- point at the beginning of the body
-end-body --------- point at the end of the body"
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
- (get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
- (save-window-excursion
- (when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
- (goto-char (point-min))
- (while (re-search-forward org-babel-src-block-regexp nil t)
- (goto-char (match-beginning 0))
- (let ((full-block (match-string 0))
- (beg-block (match-beginning 0))
- (end-block (match-end 0))
- (lang (match-string 2))
- (beg-lang (match-beginning 2))
- (end-lang (match-end 2))
- (switches (match-string 3))
- (beg-switches (match-beginning 3))
- (end-switches (match-end 3))
- (header-args (match-string 4))
- (beg-header-args (match-beginning 4))
- (end-header-args (match-end 4))
- (body (match-string 5))
- (beg-body (match-beginning 5))
- (end-body (match-end 5)))
- ,@body
- (goto-char end-block))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-src-blocks (form body))
-
-;;;###autoload
-(defmacro org-babel-map-inline-src-blocks (file &rest body)
- "Evaluate BODY forms on each inline source-block in FILE.
-If FILE is nil evaluate BODY forms on source blocks in current
-buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
- (get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
- (save-window-excursion
- (when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
- (goto-char (point-min))
- (while (re-search-forward org-babel-inline-src-block-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-inline-src-blocks (form body))
-
-(defvar org-babel-lob-one-liner-regexp)
-
-;;;###autoload
-(defmacro org-babel-map-call-lines (file &rest body)
- "Evaluate BODY forms on each call line in FILE.
-If FILE is nil evaluate BODY forms on source blocks in current
-buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
- (get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
- (save-window-excursion
- (when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
- (goto-char (point-min))
- (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-call-lines (form body))
-
-;;;###autoload
-(defmacro org-babel-map-executables (file &rest body)
- (declare (indent 1))
- (let ((tempvar (make-symbol "file"))
- (rx (make-symbol "rx")))
- `(let* ((,tempvar ,file)
- (,rx (concat "\\(" org-babel-src-block-regexp
- "\\|" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)"))
- (visited-p (or (null ,tempvar)
- (get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
- (save-window-excursion
- (when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
- (goto-char (point-min))
- (while (re-search-forward ,rx nil t)
- (goto-char (match-beginning 1))
- (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
- (save-match-data ,@body)
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-executables (form body))
-
-;;;###autoload
-(defun org-babel-execute-buffer (&optional arg)
- "Execute source code blocks in a buffer.
-Call `org-babel-execute-src-block' on every source block in
-the current buffer."
- (interactive "P")
- (org-babel-eval-wipe-error-buffer)
- (org-save-outline-visibility t
- (org-babel-map-executables nil
- (if (looking-at org-babel-lob-one-liner-regexp)
- (org-babel-lob-execute-maybe)
- (org-babel-execute-src-block arg)))))
-
-;;;###autoload
-(defun org-babel-execute-subtree (&optional arg)
- "Execute source code blocks in a subtree.
-Call `org-babel-execute-src-block' on every source block in
-the current subtree."
- (interactive "P")
- (save-restriction
- (save-excursion
- (org-narrow-to-subtree)
- (org-babel-execute-buffer arg)
- (widen))))
-
-;;;###autoload
-(defun org-babel-sha1-hash (&optional info)
- "Generate an sha1 hash based on the value of info."
- (interactive)
- (let ((print-level nil)
- (info (or info (org-babel-get-src-block-info))))
- (setf (nth 2 info)
- (sort (copy-sequence (nth 2 info))
- (lambda (a b) (string< (car a) (car b)))))
- (let* ((rm (lambda (lst)
- (dolist (p '("replace" "silent" "append" "prepend"))
- (setq lst (remove p lst)))
- lst))
- (norm (lambda (arg)
- (let ((v (if (and (listp (cdr arg)) (null (cddr arg)))
- (copy-sequence (cdr arg))
- (cdr arg))))
- (when (and v (not (and (sequencep v)
- (not (consp v))
- (= (length v) 0))))
- (cond
- ((and (listp v) ; lists are sorted
- (member (car arg) '(:result-params)))
- (sort (funcall rm v) #'string<))
- ((and (stringp v) ; strings are sorted
- (member (car arg) '(:results :exports)))
- (mapconcat #'identity (sort (funcall rm (split-string v))
- #'string<) " "))
- (t v)))))))
- ((lambda (hash)
- (when (org-called-interactively-p 'interactive) (message hash)) hash)
- (let ((it (format "%s-%s"
- (mapconcat
- #'identity
- (delq nil (mapcar (lambda (arg)
- (let ((normalized (funcall norm arg)))
- (when normalized
- (format "%S" normalized))))
- (nth 2 info))) ":")
- (nth 1 info))))
- (sha1 it))))))
-
-(defun org-babel-current-result-hash ()
- "Return the current in-buffer hash."
- (org-babel-where-is-src-block-result)
- (org-no-properties (match-string 3)))
-
-(defun org-babel-set-current-result-hash (hash)
- "Set the current in-buffer hash to HASH."
- (org-babel-where-is-src-block-result)
- (save-excursion (goto-char (match-beginning 3))
- ;; (mapc #'delete-overlay (overlays-at (point)))
- (replace-match hash nil nil nil 3)
- (org-babel-hide-hash)))
-
-(defun org-babel-hide-hash ()
- "Hide the hash in the current results line.
-Only the initial `org-babel-hash-show' characters of the hash
-will remain visible."
- (add-to-invisibility-spec '(org-babel-hide-hash . t))
- (save-excursion
- (when (and (re-search-forward org-babel-result-regexp nil t)
- (match-string 3))
- (let* ((start (match-beginning 3))
- (hide-start (+ org-babel-hash-show start))
- (end (match-end 3))
- (hash (match-string 3))
- ov1 ov2)
- (setq ov1 (make-overlay start hide-start))
- (setq ov2 (make-overlay hide-start end))
- (overlay-put ov2 'invisible 'org-babel-hide-hash)
- (overlay-put ov1 'babel-hash hash)))))
-
-(defun org-babel-hide-all-hashes ()
- "Hide the hash in the current buffer.
-Only the initial `org-babel-hash-show' characters of each hash
-will remain visible. This function should be called as part of
-the `org-mode-hook'."
- (save-excursion
- (while (re-search-forward org-babel-result-regexp nil t)
- (goto-char (match-beginning 0))
- (org-babel-hide-hash)
- (goto-char (match-end 0)))))
-(add-hook 'org-mode-hook 'org-babel-hide-all-hashes)
-
-(defun org-babel-hash-at-point (&optional point)
- "Return the value of the hash at POINT.
-The hash is also added as the last element of the kill ring.
-This can be called with C-c C-c."
- (interactive)
- (let ((hash (car (delq nil (mapcar
- (lambda (ol) (overlay-get ol 'babel-hash))
- (overlays-at (or point (point))))))))
- (when hash (kill-new hash) (message hash))))
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
-
-(defun org-babel-result-hide-spec ()
- "Hide portions of results lines.
-Add `org-babel-hide-result' as an invisibility spec for hiding
-portions of results lines."
- (add-to-invisibility-spec '(org-babel-hide-result . t)))
-(add-hook 'org-mode-hook 'org-babel-result-hide-spec)
-
-(defvar org-babel-hide-result-overlays nil
- "Overlays hiding results.")
-
-(defun org-babel-result-hide-all ()
- "Fold all results in the current buffer."
- (interactive)
- (org-babel-show-result-all)
- (save-excursion
- (while (re-search-forward org-babel-result-regexp nil t)
- (save-excursion (goto-char (match-beginning 0))
- (org-babel-hide-result-toggle-maybe)))))
-
-(defun org-babel-show-result-all ()
- "Unfold all results in the current buffer."
- (mapc 'delete-overlay org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays nil))
-
-;;;###autoload
-(defun org-babel-hide-result-toggle-maybe ()
- "Toggle visibility of result at point."
- (interactive)
- (let ((case-fold-search t))
- (if (save-excursion
- (beginning-of-line 1)
- (looking-at org-babel-result-regexp))
- (progn (org-babel-hide-result-toggle)
- t) ;; to signal that we took action
- nil))) ;; to signal that we did not
-
-(defun org-babel-hide-result-toggle (&optional force)
- "Toggle the visibility of the current result."
- (interactive)
- (save-excursion
- (beginning-of-line)
- (if (re-search-forward org-babel-result-regexp nil t)
- (let ((start (progn (beginning-of-line 2) (- (point) 1)))
- (end (progn
- (while (looking-at org-babel-multi-line-header-regexp)
- (forward-line 1))
- (goto-char (- (org-babel-result-end) 1)) (point)))
- ov)
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-babel-hide-result))
- (overlays-at start)))
- (if (or (not force) (eq force 'off))
- (mapc (lambda (ov)
- (when (member ov org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays
- (delq ov org-babel-hide-result-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-babel-hide-result)
- (delete-overlay ov)))
- (overlays-at start)))
- (setq ov (make-overlay start end))
- (overlay-put ov 'invisible 'org-babel-hide-result)
- ;; make the block accessible to isearch
- (overlay-put
- ov 'isearch-open-invisible
- (lambda (ov)
- (when (member ov org-babel-hide-result-overlays)
- (setq org-babel-hide-result-overlays
- (delq ov org-babel-hide-result-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-babel-hide-result)
- (delete-overlay ov))))
- (push ov org-babel-hide-result-overlays)))
- (error "Not looking at a result line"))))
-
-;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
-;; Remove overlays when changing major mode
-(add-hook 'org-mode-hook
- (lambda () (org-add-hook 'change-major-mode-hook
- 'org-babel-show-result-all 'append 'local)))
-
-(defvar org-file-properties)
-(defun org-babel-params-from-properties (&optional lang)
- "Retrieve parameters specified as properties.
-Return an association list of any source block params which
-may be specified in the properties of the current outline entry."
- (save-match-data
- (let (val sym)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val (org-entry-get (point) header-arg t))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
- (mapcar
- #'symbol-name
- (mapcar
- #'car
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (progn
- (setq sym (intern (concat "org-babel-header-args:" lang)))
- (and (boundp sym) (eval sym))))))))))))
-
-(defvar org-src-preserve-indentation)
-(defun org-babel-parse-src-block-match ()
- "Parse the results from a match of the `org-babel-src-block-regexp'."
- (let* ((block-indentation (length (match-string 1)))
- (lang (org-no-properties (match-string 2)))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
- (switches (match-string 3))
- (body (org-no-properties
- (let* ((body (match-string 5))
- (sub-length (- (length body) 1)))
- (if (and (> sub-length 0)
- (string= "\n" (substring body sub-length)))
- (substring body 0 sub-length)
- (or body "")))))
- (preserve-indentation (or org-src-preserve-indentation
- (save-match-data
- (string-match "-i\\>" switches)))))
- (list lang
- ;; get block body less properties, protective commas, and indentation
- (with-temp-buffer
- (save-match-data
- (insert (org-unescape-code-in-string body))
- (unless preserve-indentation (org-do-remove-indentation))
- (buffer-string)))
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))
- switches
- block-indentation)))
-
-(defun org-babel-parse-inline-src-block-match ()
- "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
- (let* ((lang (org-no-properties (match-string 2)))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
- (list lang
- (org-unescape-code-in-string (org-no-properties (match-string 5)))
- (org-babel-merge-params
- org-babel-default-inline-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))
-
-(defun org-babel-balanced-split (string alts)
- "Split STRING on instances of ALTS.
-ALTS is a cons of two character options where each option may be
-either the numeric code of a single character or a list of
-character alternatives. For example to split on balanced
-instances of \"[ \t]:\" set ALTS to '((32 9) . 58)."
- (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
- (matched (lambda (ch last)
- (if (consp alts)
- (and (funcall matches ch (cdr alts))
- (funcall matches last (car alts)))
- (funcall matches ch alts))))
- (balance 0) (last 0)
- quote partial lst)
- (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
- (setq balance (+ balance
- (cond ((or (equal 91 ch) (equal 40 ch)) 1)
- ((or (equal 93 ch) (equal 41 ch)) -1)
- (t 0))))
- (when (and (equal 34 ch) (not (equal 92 last)))
- (setq quote (not quote)))
- (setq partial (cons ch partial))
- (when (and (= balance 0) (not quote) (funcall matched ch last))
- (setq lst (cons (apply #'string (nreverse
- (if (consp alts)
- (cddr partial)
- (cdr partial))))
- lst))
- (setq partial nil))
- (setq last ch))
- (string-to-list string))
- (nreverse (cons (apply #'string (nreverse partial)) lst))))
-
-(defun org-babel-join-splits-near-ch (ch list)
- "Join splits where \"=\" is on either end of the split."
- (let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
- (first= (lambda (str) (= ch (aref str 0)))))
- (reverse
- (org-reduce (lambda (acc el)
- (let ((head (car acc)))
- (if (and head (or (funcall last= head) (funcall first= el)))
- (cons (concat head el) (cdr acc))
- (cons el acc))))
- list :initial-value nil))))
-
-(defun org-babel-parse-header-arguments (arg-string)
- "Parse a string of header arguments returning an alist."
- (when (> (length arg-string) 0)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (arg)
- (if (string-match
- "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)"
- arg)
- (cons (intern (match-string 1 arg))
- (org-babel-read (org-babel-chomp (match-string 2 arg))))
- (cons (intern (org-babel-chomp arg)) nil)))
- ((lambda (raw)
- (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))
- (org-babel-balanced-split arg-string '((32 9) . 58))))))))
-
-(defun org-babel-parse-multiple-vars (header-arguments)
- "Expand multiple variable assignments behind a single :var keyword.
-
-This allows expression of multiple variables with one :var as
-shown below.
-
-#+PROPERTY: var foo=1, bar=2"
- (let (results)
- (mapc (lambda (pair)
- (if (eq (car pair) :var)
- (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
- (org-babel-join-splits-near-ch
- 61 (org-babel-balanced-split (cdr pair) 32)))
- (push pair results)))
- header-arguments)
- (nreverse results)))
-
-(defun org-babel-process-params (params)
- "Expand variables in PARAMS and add summary parameters."
- (let* ((processed-vars (mapcar (lambda (el)
- (if (consp (cdr el))
- (cdr el)
- (org-babel-ref-parse (cdr el))))
- (org-babel-get-header params :var)))
- (vars-and-names (if (and (assoc :colname-names params)
- (assoc :rowname-names params))
- (list processed-vars)
- (org-babel-disassemble-tables
- processed-vars
- (cdr (assoc :hlines params))
- (cdr (assoc :colnames params))
- (cdr (assoc :rownames params)))))
- (raw-result (or (cdr (assoc :results params)) ""))
- (result-params (append
- (split-string (if (stringp raw-result)
- raw-result
- (eval raw-result)))
- (cdr (assoc :result-params params)))))
- (append
- (mapcar (lambda (var) (cons :var var)) (car vars-and-names))
- (list
- (cons :colname-names (or (cdr (assoc :colname-names params))
- (cadr vars-and-names)))
- (cons :rowname-names (or (cdr (assoc :rowname-names params))
- (caddr vars-and-names)))
- (cons :result-params result-params)
- (cons :result-type (cond ((member "output" result-params) 'output)
- ((member "value" result-params) 'value)
- (t 'value))))
- (org-babel-get-header params :var 'other))))
-
-;; row and column names
-(defun org-babel-del-hlines (table)
- "Remove all 'hlines from TABLE."
- (remove 'hline table))
-
-(defun org-babel-get-colnames (table)
- "Return the column names of TABLE.
-Return a cons cell, the `car' of which contains the TABLE less
-colnames, and the `cdr' of which contains a list of the column
-names."
- (if (equal 'hline (nth 1 table))
- (cons (cddr table) (car table))
- (cons (cdr table) (car table))))
-
-(defun org-babel-get-rownames (table)
- "Return the row names of TABLE.
-Return a cons cell, the `car' of which contains the TABLE less
-colnames, and the `cdr' of which contains a list of the column
-names. Note: this function removes any hlines in TABLE."
- (let* ((trans (lambda (table) (apply #'mapcar* #'list table)))
- (width (apply 'max
- (mapcar (lambda (el) (if (listp el) (length el) 0)) table)))
- (table (funcall trans (mapcar (lambda (row)
- (if (not (equal row 'hline))
- row
- (setq row '())
- (dotimes (n width)
- (setq row (cons 'hline row)))
- row))
- table))))
- (cons (mapcar (lambda (row) (if (equal (car row) 'hline) 'hline row))
- (funcall trans (cdr table)))
- (remove 'hline (car table)))))
-
-(defun org-babel-put-colnames (table colnames)
- "Add COLNAMES to TABLE if they exist."
- (if colnames (apply 'list colnames 'hline table) table))
-
-(defun org-babel-put-rownames (table rownames)
- "Add ROWNAMES to TABLE if they exist."
- (if rownames
- (mapcar (lambda (row)
- (if (listp row)
- (cons (or (pop rownames) "") row)
- row)) table)
- table))
-
-(defun org-babel-pick-name (names selector)
- "Select one out of an alist of row or column names.
-SELECTOR can be either a list of names in which case those names
-will be returned directly, or an index into the list NAMES in
-which case the indexed names will be return."
- (if (listp selector)
- selector
- (when names
- (if (and selector (symbolp selector) (not (equal t selector)))
- (cdr (assoc selector names))
- (if (integerp selector)
- (nth (- selector 1) names)
- (cdr (car (last names))))))))
-
-(defun org-babel-disassemble-tables (vars hlines colnames rownames)
- "Parse tables for further processing.
-Process the variables in VARS according to the HLINES,
-ROWNAMES and COLNAMES header arguments. Return a list consisting
-of the vars, cnames and rnames."
- (let (cnames rnames)
- (list
- (mapcar
- (lambda (var)
- (when (listp (cdr var))
- (when (and (not (equal colnames "no"))
- (or colnames (and (equal (nth 1 (cdr var)) 'hline)
- (not (member 'hline (cddr (cdr var)))))))
- (let ((both (org-babel-get-colnames (cdr var))))
- (setq cnames (cons (cons (car var) (cdr both))
- cnames))
- (setq var (cons (car var) (car both)))))
- (when (and rownames (not (equal rownames "no")))
- (let ((both (org-babel-get-rownames (cdr var))))
- (setq rnames (cons (cons (car var) (cdr both))
- rnames))
- (setq var (cons (car var) (car both)))))
- (when (and hlines (not (equal hlines "yes")))
- (setq var (cons (car var) (org-babel-del-hlines (cdr var))))))
- var)
- vars)
- (reverse cnames) (reverse rnames))))
-
-(defun org-babel-reassemble-table (table colnames rownames)
- "Add column and row names to a table.
-Given a TABLE and set of COLNAMES and ROWNAMES add the names
-to the table for reinsertion to org-mode."
- (if (listp table)
- ((lambda (table)
- (if (and colnames (listp (car table)) (= (length (car table))
- (length colnames)))
- (org-babel-put-colnames table colnames) table))
- (if (and rownames (= (length table) (length rownames)))
- (org-babel-put-rownames table rownames) table))
- table))
-
-(defun org-babel-where-is-src-block-head ()
- "Find where the current source block begins.
-Return the point at the beginning of the current source
-block. Specifically at the beginning of the #+BEGIN_SRC line.
-If the point is not on a source block then return nil."
- (let ((initial (point)) (case-fold-search t) top bottom)
- (or
- (save-excursion ;; on a source name line or a #+header line
- (beginning-of-line 1)
- (and (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))
- (progn
- (while (and (forward-line 1)
- (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (looking-at org-babel-src-block-regexp))
- (point)))
- (save-excursion ;; on a #+begin_src line
- (beginning-of-line 1)
- (and (looking-at org-babel-src-block-regexp)
- (point)))
- (save-excursion ;; inside a src block
- (and
- (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
- (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
- (< top initial) (< initial bottom)
- (progn (goto-char top) (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp))
- (point))))))
-
-;;;###autoload
-(defun org-babel-goto-src-block-head ()
- "Go to the beginning of the current code block."
- (interactive)
- ((lambda (head)
- (if head (goto-char head) (error "Not currently in a code block")))
- (org-babel-where-is-src-block-head)))
-
-;;;###autoload
-(defun org-babel-goto-named-src-block (name)
- "Go to a named source-code block."
- (interactive
- (let ((completion-ignore-case t)
- (case-fold-search t)
- (under-point (thing-at-point 'line)))
- (list (org-icompleting-read
- "source-block name: " (org-babel-src-block-names) nil t
- (cond
- ;; noweb
- ((string-match (org-babel-noweb-wrap) under-point)
- (let ((block-name (match-string 1 under-point)))
- (string-match "[^(]*" block-name)
- (match-string 0 block-name)))
- ;; #+call:
- ((string-match org-babel-lob-one-liner-regexp under-point)
- (let ((source-info (car (org-babel-lob-get-info))))
- (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
- (let ((source-name (match-string 1 source-info)))
- source-name))))
- ;; #+results:
- ((string-match (concat "#\\+" org-babel-results-keyword
- "\\:\s+\\([^\\(]*\\)") under-point)
- (match-string 1 under-point))
- ;; symbol-at-point
- ((and (thing-at-point 'symbol))
- (org-babel-find-named-block (thing-at-point 'symbol))
- (thing-at-point 'symbol))
- (""))))))
- (let ((point (org-babel-find-named-block name)))
- (if point
- ;; taken from `org-open-at-point'
- (progn (org-mark-ring-push) (goto-char point) (org-show-context))
- (message "source-code block '%s' not found in this buffer" name))))
-
-(defun org-babel-find-named-block (name)
- "Find a named source-code block.
-Return the location of the source block identified by source
-NAME, or nil if no such block exists. Set match data according to
-org-babel-named-src-block-regexp."
- (save-excursion
- (let ((case-fold-search t)
- (regexp (org-babel-named-src-block-regexp-for-name name)) msg)
- (goto-char (point-min))
- (when (or (re-search-forward regexp nil t)
- (re-search-backward regexp nil t))
- (match-beginning 0)))))
-
-(defun org-babel-src-block-names (&optional file)
- "Returns the names of source blocks in FILE or the current buffer."
- (save-excursion
- (when file (find-file file)) (goto-char (point-min))
- (let ((case-fold-search t) names)
- (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
- (setq names (cons (match-string 3) names)))
- names)))
-
-;;;###autoload
-(defun org-babel-goto-named-result (name)
- "Go to a named result."
- (interactive
- (let ((completion-ignore-case t))
- (list (org-icompleting-read "source-block name: "
- (org-babel-result-names) nil t))))
- (let ((point (org-babel-find-named-result name)))
- (if point
- ;; taken from `org-open-at-point'
- (progn (goto-char point) (org-show-context))
- (message "result '%s' not found in this buffer" name))))
-
-(defun org-babel-find-named-result (name &optional point)
- "Find a named result.
-Return the location of the result named NAME in the current
-buffer or nil if no such result exists."
- (save-excursion
- (let ((case-fold-search t))
- (goto-char (or point (point-min)))
- (catch 'is-a-code-block
- (when (re-search-forward
- (concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t)
- (when (and (string= "name" (downcase (match-string 1)))
- (or (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)))
- (throw 'is-a-code-block (org-babel-find-named-result name (point))))
- (beginning-of-line 0) (point))))))
-
-(defun org-babel-result-names (&optional file)
- "Returns the names of results in FILE or the current buffer."
- (save-excursion
- (when file (find-file file)) (goto-char (point-min))
- (let ((case-fold-search t) names)
- (while (re-search-forward org-babel-result-w-name-regexp nil t)
- (setq names (cons (match-string 4) names)))
- names)))
-
-;;;###autoload
-(defun org-babel-next-src-block (&optional arg)
- "Jump to the next source block.
-With optional prefix argument ARG, jump forward ARG many source blocks."
- (interactive "P")
- (when (looking-at org-babel-src-block-regexp) (forward-char 1))
- (condition-case nil
- (re-search-forward org-babel-src-block-regexp nil nil (or arg 1))
- (error (error "No further code blocks")))
- (goto-char (match-beginning 0)) (org-show-context))
-
-;;;###autoload
-(defun org-babel-previous-src-block (&optional arg)
- "Jump to the previous source block.
-With optional prefix argument ARG, jump backward ARG many source blocks."
- (interactive "P")
- (condition-case nil
- (re-search-backward org-babel-src-block-regexp nil nil (or arg 1))
- (error (error "No previous code blocks")))
- (goto-char (match-beginning 0)) (org-show-context))
-
-(defvar org-babel-load-languages)
-
-;;;###autoload
-(defun org-babel-mark-block ()
- "Mark current src block."
- (interactive)
- ((lambda (head)
- (when head
- (save-excursion
- (goto-char head)
- (looking-at org-babel-src-block-regexp))
- (push-mark (match-end 5) nil t)
- (goto-char (match-beginning 5))))
- (org-babel-where-is-src-block-head)))
-
-(defun org-babel-demarcate-block (&optional arg)
- "Wrap or split the code in the region or on the point.
-When called from inside of a code block the current block is
-split. When called from outside of a code block a new code block
-is created. In both cases if the region is demarcated and if the
-region is not active then the point is demarcated."
- (interactive "P")
- (let ((info (org-babel-get-src-block-info 'light))
- (headers (progn (org-babel-where-is-src-block-head)
- (match-string 4)))
- (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
- (if info
- (mapc
- (lambda (place)
- (save-excursion
- (goto-char place)
- (let ((lang (nth 0 info))
- (indent (make-string (nth 5 info) ? )))
- (when (string-match "^[[:space:]]*$"
- (buffer-substring (point-at-bol)
- (point-at-eol)))
- (delete-region (point-at-bol) (point-at-eol)))
- (insert (concat
- (if (looking-at "^") "" "\n")
- indent "#+end_src\n"
- (if arg stars indent) "\n"
- indent "#+begin_src " lang
- (if (> (length headers) 1)
- (concat " " headers) headers)
- (if (looking-at "[\n\r]")
- ""
- (concat "\n" (make-string (current-column) ? )))))))
- (move-end-of-line 2))
- (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
- (let ((start (point))
- (lang (org-icompleting-read "Lang: "
- (mapcar (lambda (el) (symbol-name (car el)))
- org-babel-load-languages)))
- (body (delete-and-extract-region
- (if (org-region-active-p) (mark) (point)) (point))))
- (insert (concat (if (looking-at "^") "" "\n")
- (if arg (concat stars "\n") "")
- "#+begin_src " lang "\n"
- body
- (if (or (= (length body) 0)
- (string-match "[\r\n]$" body)) "" "\n")
- "#+end_src\n"))
- (goto-char start) (move-end-of-line 1)))))
-
-(defvar org-babel-lob-one-liner-regexp)
-(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
- "Find where the current source block results begin.
-Return the point at the beginning of the result of the current
-source block. Specifically at the beginning of the results line.
-If no result exists for this block then create a results line
-following the source block."
- (save-excursion
- (let* ((case-fold-search t)
- (on-lob-line (save-excursion
- (beginning-of-line 1)
- (looking-at org-babel-lob-one-liner-regexp)))
- (inlinep (when (org-babel-get-inline-src-block-matches)
- (match-end 0)))
- (name (if on-lob-line
- (mapconcat #'identity (butlast (org-babel-lob-get-info)) "")
- (nth 4 (or info (org-babel-get-src-block-info 'light)))))
- (head (unless on-lob-line (org-babel-where-is-src-block-head)))
- found beg end)
- (when head (goto-char head))
- (setq
- found ;; was there a result (before we potentially insert one)
- (or
- inlinep
- (and
- ;; named results:
- ;; - return t if it is found, else return nil
- ;; - if it does not need to be rebuilt, then don't set end
- ;; - if it does need to be rebuilt then do set end
- name (setq beg (org-babel-find-named-result name))
- (prog1 beg
- (when (and hash (not (string= hash (match-string 3))))
- (goto-char beg) (setq end beg) ;; beginning of result
- (forward-line 1)
- (delete-region end (org-babel-result-end)) nil)))
- (and
- ;; unnamed results:
- ;; - return t if it is found, else return nil
- ;; - if it is found, and the hash doesn't match, delete and set end
- (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
- (progn (end-of-line 1)
- (if (eobp) (insert "\n") (forward-char 1))
- (setq end (point))
- (or (and (not name)
- (progn ;; unnamed results line already exists
- (re-search-forward "[^ \f\t\n\r\v]" nil t)
- (beginning-of-line 1)
- (looking-at
- (concat org-babel-result-regexp "\n")))
- (prog1 (point)
- ;; must remove and rebuild if hash!=old-hash
- (if (and hash (not (string= hash (match-string 3))))
- (prog1 nil
- (forward-line 1)
- (delete-region
- end (org-babel-result-end)))
- (setq end nil)))))))))
- (if (and insert end)
- (progn
- (goto-char end)
- (unless beg
- (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
- (insert (concat
- (if indent
- (mapconcat
- (lambda (el) " ")
- (org-number-sequence 1 indent) "")
- "")
- "#+" org-babel-results-keyword
- (when hash (concat "["hash"]"))
- ":"
- (when name (concat " " name)) "\n"))
- (unless beg (insert "\n") (backward-char))
- (beginning-of-line 0)
- (if hash (org-babel-hide-hash))
- (point))
- found))))
-
-(defvar org-block-regexp)
-(defun org-babel-read-result ()
- "Read the result at `point' into emacs-lisp."
- (let ((case-fold-search t) result-string)
- (cond
- ((org-at-table-p) (org-babel-read-table))
- ((org-at-item-p) (org-babel-read-list))
- ((looking-at org-bracket-link-regexp) (org-babel-read-link))
- ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
- ((looking-at "^[ \t]*: ")
- (setq result-string
- (org-babel-trim
- (mapconcat (lambda (line)
- (if (and (> (length line) 1)
- (string-match "^[ \t]*: \\(.+\\)" line))
- (match-string 1 line)
- line))
- (split-string
- (buffer-substring
- (point) (org-babel-result-end)) "[\r\n]+")
- "\n")))
- (or (org-babel-number-p result-string) result-string))
- ((looking-at org-babel-result-regexp)
- (save-excursion (forward-line 1) (org-babel-read-result))))))
-
-(defun org-babel-read-table ()
- "Read the table at `point' into emacs-lisp."
- (mapcar (lambda (row)
- (if (and (symbolp row) (equal row 'hline)) row
- (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
- (org-table-to-lisp)))
-
-(defun org-babel-read-list ()
- "Read the list at `point' into emacs-lisp."
- (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
- (mapcar #'cadr (cdr (org-list-parse-list)))))
-
-(defvar org-link-types-re)
-(defun org-babel-read-link ()
- "Read the link at `point' into emacs-lisp.
-If the path of the link is a file path it is expanded using
-`expand-file-name'."
- (let* ((case-fold-search t)
- (raw (and (looking-at org-bracket-link-regexp)
- (org-no-properties (match-string 1))))
- (type (and (string-match org-link-types-re raw)
- (match-string 1 raw))))
- (cond
- ((not type) (expand-file-name raw))
- ((string= type "file")
- (and (string-match "file\\(.*\\):\\(.+\\)" raw)
- (expand-file-name (match-string 2 raw))))
- (t raw))))
-
-(defun org-babel-format-result (result &optional sep)
- "Format RESULT for writing to file."
- (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r)))))
- (if (listp result)
- ;; table result
- (orgtbl-to-generic
- result (list :sep (or sep "\t") :fmt echo-res))
- ;; scalar result
- (funcall echo-res result))))
-
-(defun org-babel-insert-result
- (result &optional result-params info hash indent lang)
- "Insert RESULT into the current buffer.
-By default RESULT is inserted after the end of the
-current source block. With optional argument RESULT-PARAMS
-controls insertion of results in the org-mode file.
-RESULT-PARAMS can take the following values:
-
-replace - (default option) insert results after the source block
- replacing any previously inserted results
-
-silent -- no results are inserted
-
-file ---- the results are interpreted as a file path, and are
- inserted into the buffer using the Org-mode file syntax
-
-list ---- the results are interpreted as an Org-mode list.
-
-raw ----- results are added directly to the Org-mode file. This
- is a good option if you code block will output org-mode
- formatted text.
-
-drawer -- results are added directly to the Org-mode file as with
- \"raw\", but are wrapped in a RESULTS drawer, allowing
- them to later be replaced or removed automatically.
-
-org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
- They are not comma-escaped when inserted, but Org syntax
- here will be discarded when exporting the file.
-
-html ---- results are added inside of a #+BEGIN_HTML block. This
- is a good option if you code block will output html
- formatted text.
-
-latex --- results are added inside of a #+BEGIN_LATEX block.
- This is a good option if you code block will output
- latex formatted text.
-
-code ---- the results are extracted in the syntax of the source
- code of the language being evaluated and are added
- inside of a #+BEGIN_SRC block with the source-code
- language set appropriately. Note this relies on the
- optional LANG argument."
- (if (stringp result)
- (progn
- (setq result (org-no-properties result))
- (when (member "file" result-params)
- (setq result (org-babel-result-to-file
- result (when (assoc :file-desc (nth 2 info))
- (or (cdr (assoc :file-desc (nth 2 info)))
- result))))))
- (unless (listp result) (setq result (format "%S" result))))
- (if (and result-params (member "silent" result-params))
- (progn
- (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
- result)
- (save-excursion
- (let* ((inlinep
- (save-excursion
- (when (or (org-babel-get-inline-src-block-matches)
- (org-babel-get-lob-one-liner-matches))
- (goto-char (match-end 0))
- (insert (if (listp result) "\n" " "))
- (point))))
- (existing-result (unless inlinep
- (org-babel-where-is-src-block-result
- t info hash indent)))
- (results-switches
- (cdr (assoc :results_switches (nth 2 info))))
- beg end)
- (when (and (stringp result) ; ensure results end in a newline
- (not inlinep)
- (> (length result) 0)
- (not (or (string-equal (substring result -1) "\n")
- (string-equal (substring result -1) "\r"))))
- (setq result (concat result "\n")))
- (if (not existing-result)
- (setq beg (or inlinep (point)))
- (goto-char existing-result)
- (save-excursion
- (re-search-forward "#" nil t)
- (setq indent (- (current-column) 1)))
- (forward-line 1)
- (setq beg (point))
- (cond
- ((member "replace" result-params)
- (delete-region (point) (org-babel-result-end)))
- ((member "append" result-params)
- (goto-char (org-babel-result-end)) (setq beg (point-marker)))
- ((member "prepend" result-params)))) ; already there
- (setq results-switches
- (if results-switches (concat " " results-switches) ""))
- (let ((wrap (lambda (start finish)
- (goto-char end) (insert (concat finish "\n"))
- (goto-char beg) (insert (concat start "\n"))
- (org-escape-code-in-region (point) end)
- (goto-char end) (goto-char (point-at-eol))
- (setq end (point-marker))))
- (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
- ;; insert results based on type
- (cond
- ;; do nothing for an empty result
- ((null result))
- ;; insert a list if preferred
- ((member "list" result-params)
- (insert
- (org-babel-trim
- (org-list-to-generic
- (cons 'unordered
- (mapcar
- (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
- (if (listp result) result (list result))))
- '(:splicep nil :istart "- " :iend "\n")))
- "\n"))
- ;; assume the result is a table if it's not a string
- ((funcall proper-list-p result)
- (goto-char beg)
- (insert (concat (orgtbl-to-orgtbl
- (if (or (eq 'hline (car result))
- (and (listp (car result))
- (listp (cdr (car result)))))
- result (list result))
- '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
- (goto-char beg) (when (org-at-table-p) (org-table-align)))
- ((and (listp result) (not (funcall proper-list-p result)))
- (insert (format "%s\n" result)))
- ((member "file" result-params)
- (when inlinep (goto-char inlinep))
- (insert result))
- (t (goto-char beg) (insert result)))
- (when (funcall proper-list-p result) (goto-char (org-table-end)))
- (setq end (point-marker))
- ;; possibly wrap result
- (cond
- ((assoc :wrap (nth 2 info))
- (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
- (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
- ((member "html" result-params)
- (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
- ((member "latex" result-params)
- (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
- ((member "org" result-params)
- (funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
- ((member "code" result-params)
- (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
- "#+END_SRC"))
- ((member "raw" result-params)
- (goto-char beg) (if (org-at-table-p) (org-cycle)))
- ((or (member "drawer" result-params)
- ;; Stay backward compatible with <7.9.2
- (member "wrap" result-params))
- (funcall wrap ":RESULTS:" ":END:"))
- ((and (not (funcall proper-list-p result))
- (not (member "file" result-params)))
- (org-babel-examplize-region beg end results-switches)
- (setq end (point)))))
- ;; possibly indent the results to match the #+results line
- (when (and (not inlinep) (numberp indent) indent (> indent 0)
- ;; in this case `table-align' does the work for us
- (not (and (listp result)
- (member "append" result-params))))
- (indent-rigidly beg end indent))))
- (if (null result)
- (if (member "value" result-params)
- (message "Code block returned no value.")
- (message "Code block produced no output."))
- (message "Code block evaluation complete."))))
-
-(defun org-babel-remove-result (&optional info)
- "Remove the result of the current source block."
- (interactive)
- (let ((location (org-babel-where-is-src-block-result nil info)) start)
- (when location
- (setq start (- location 1))
- (save-excursion
- (goto-char location) (forward-line 1)
- (delete-region start (org-babel-result-end))))))
-
-(defun org-babel-result-end ()
- "Return the point at the end of the current set of results."
- (save-excursion
- (cond
- ((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
- ((org-at-item-p) (let* ((struct (org-list-struct))
- (prvs (org-list-prevs-alist struct)))
- (org-list-get-list-end (point-at-bol) struct prvs)))
- ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:"))
- (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
- (forward-char 1) (point)))
- (t
- (let ((case-fold-search t))
- (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)"))
- (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
- nil t)
- (forward-char 1))
- (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
- (forward-line 1))))
- (point)))))
-
-(defun org-babel-result-to-file (result &optional description)
- "Convert RESULT into an `org-mode' link with optional DESCRIPTION.
-If the `default-directory' is different from the containing
-file's directory then expand relative links."
- (when (stringp result)
- (format "[[file:%s]%s]"
- (if (and default-directory
- buffer-file-name
- (not (string= (expand-file-name default-directory)
- (expand-file-name
- (file-name-directory buffer-file-name)))))
- (expand-file-name result default-directory)
- result)
- (if description (concat "[" description "]") ""))))
-
-(defvar org-babel-capitalize-examplize-region-markers nil
- "Make true to capitalize begin/end example markers inserted by code blocks.")
-
-(defun org-babel-examplize-region (beg end &optional results-switches)
- "Comment out region using the inline '==' or ': ' org example quote."
- (interactive "*r")
- (let ((chars-between (lambda (b e)
- (not (string-match "^[\\s]*$" (buffer-substring b e)))))
- (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
- (upcase str) str))))
- (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
- (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
- (save-excursion
- (goto-char beg)
- (insert (format "=%s=" (prog1 (buffer-substring beg end)
- (delete-region beg end)))))
- (let ((size (count-lines beg end)))
- (save-excursion
- (cond ((= size 0)) ; do nothing for an empty result
- ((< size org-babel-min-lines-for-block-output)
- (goto-char beg)
- (dotimes (n size)
- (beginning-of-line 1) (insert ": ") (forward-line 1)))
- (t
- (goto-char beg)
- (insert (if results-switches
- (format "%s%s\n"
- (funcall maybe-cap "#+begin_example")
- results-switches)
- (funcall maybe-cap "#+begin_example\n")))
- (if (markerp end) (goto-char end) (forward-char (- end beg)))
- (insert (funcall maybe-cap "#+end_example\n")))))))))
-
-(defun org-babel-update-block-body (new-body)
- "Update the body of the current code block to NEW-BODY."
- (if (not (org-babel-where-is-src-block-head))
- (error "Not in a source block")
- (save-match-data
- (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
- (indent-rigidly (match-beginning 5) (match-end 5) 2)))
-
-(defun org-babel-merge-params (&rest plists)
- "Combine all parameter association lists in PLISTS.
-Later elements of PLISTS override the values of previous elements.
-This takes into account some special considerations for certain
-parameters when merging lists."
- (let* ((results-exclusive-groups
- (mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'results org-babel-common-header-args-w-values))))
- (exports-exclusive-groups
- (mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'exports org-babel-common-header-args-w-values))))
- (variable-index 0)
- (e-merge (lambda (exclusive-groups &rest result-params)
- ;; maintain exclusivity of mutually exclusive parameters
- (let (output)
- (mapc (lambda (new-params)
- (mapc (lambda (new-param)
- (mapc (lambda (exclusive-group)
- (when (member new-param exclusive-group)
- (mapcar (lambda (excluded-param)
- (setq output
- (delete
- excluded-param
- output)))
- exclusive-group)))
- exclusive-groups)
- (setq output (org-uniquify
- (cons new-param output))))
- new-params))
- result-params)
- output)))
- params results exports tangle noweb cache vars shebang comments padline)
-
- (mapc
- (lambda (plist)
- (mapc
- (lambda (pair)
- (case (car pair)
- (:var
- (let ((name (if (listp (cdr pair))
- (cadr pair)
- (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
- (cdr pair))
- (intern (match-string 1 (cdr pair)))))))
- (if name
- (setq vars
- (append
- (if (member name (mapcar #'car vars))
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars))
- vars)
- (list (cons name pair))))
- ;; if no name is given and we already have named variables
- ;; then assign to named variables in order
- (if (and vars (nth variable-index vars))
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name
- (car (nth variable-index vars)))
- "=" (cdr pair)))
- (incf variable-index))
- (error "Variable \"%s\" must be assigned a default value"
- (cdr pair))))))
- (:results
- (setq results (funcall e-merge results-exclusive-groups
- results
- (split-string
- (let ((r (cdr pair)))
- (if (stringp r) r (eval r)))))))
- (:file
- (when (cdr pair)
- (setq results (funcall e-merge results-exclusive-groups
- results '("file")))
- (unless (or (member "both" exports)
- (member "none" exports)
- (member "code" exports))
- (setq exports (funcall e-merge exports-exclusive-groups
- exports '("results"))))
- (setq params (cons pair (assq-delete-all (car pair) params)))))
- (:exports
- (setq exports (funcall e-merge exports-exclusive-groups
- exports (split-string (cdr pair)))))
- (:tangle ;; take the latest -- always overwrite
- (setq tangle (or (list (cdr pair)) tangle)))
- (:noweb
- (setq noweb (funcall e-merge
- '(("yes" "no" "tangle" "no-export"
- "strip-export" "eval"))
- noweb
- (split-string (or (cdr pair) "")))))
- (:cache
- (setq cache (funcall e-merge '(("yes" "no")) cache
- (split-string (or (cdr pair) "")))))
- (:padline
- (setq padline (funcall e-merge '(("yes" "no")) padline
- (split-string (or (cdr pair) "")))))
- (:shebang ;; take the latest -- always overwrite
- (setq shebang (or (list (cdr pair)) shebang)))
- (:comments
- (setq comments (funcall e-merge '(("yes" "no")) comments
- (split-string (or (cdr pair) "")))))
- (t ;; replace: this covers e.g. :session
- (setq params (cons pair (assq-delete-all (car pair) params))))))
- plist))
- plists)
- (setq vars (reverse vars))
- (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
- (mapc
- (lambda (hd)
- (let ((key (intern (concat ":" (symbol-name hd))))
- (val (eval hd)))
- (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
- '(results exports tangle noweb padline cache shebang comments))
- params))
-
-(defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil
- "Set to true to use regular expressions to expand noweb references.
-This results in much faster noweb reference expansion but does
-not properly allow code blocks to inherit the \":noweb-ref\"
-header argument from buffer or subtree wide properties.")
-
-(defun org-babel-noweb-p (params context)
- "Check if PARAMS require expansion in CONTEXT.
-CONTEXT may be one of :tangle, :export or :eval."
- (let* (intersect
- (intersect (lambda (as bs)
- (when as
- (if (member (car as) bs)
- (car as)
- (funcall intersect (cdr as) bs))))))
- (funcall intersect (case context
- (:tangle '("yes" "tangle" "no-export" "strip-export"))
- (:eval '("yes" "no-export" "strip-export" "eval"))
- (:export '("yes")))
- (split-string (or (cdr (assoc :noweb params)) "")))))
-
-(defun org-babel-expand-noweb-references (&optional info parent-buffer)
- "Expand Noweb references in the body of the current source code block.
-
-For example the following reference would be replaced with the
-body of the source-code block named 'example-block'.
-
-<<example-block>>
-
-Note that any text preceding the <<foo>> construct on a line will
-be interposed between the lines of the replacement text. So for
-example if <<foo>> is placed behind a comment, then the entire
-replacement text will also be commented.
-
-This function must be called from inside of the buffer containing
-the source-code block which holds BODY.
-
-In addition the following syntax can be used to insert the
-results of evaluating the source-code block named 'example-block'.
-
-<<example-block()>>
-
-Any optional arguments can be passed to example-block by placing
-the arguments inside the parenthesis following the convention
-defined by `org-babel-lob'. For example
-
-<<example-block(a=9)>>
-
-would set the value of argument \"a\" equal to \"9\". Note that
-these arguments are not evaluated in the current source-code
-block but are passed literally to the \"example-block\"."
- (let* ((parent-buffer (or parent-buffer (current-buffer)))
- (info (or info (org-babel-get-src-block-info)))
- (lang (nth 0 info))
- (body (nth 1 info))
- (ob-nww-start org-babel-noweb-wrap-start)
- (ob-nww-end org-babel-noweb-wrap-end)
- (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
- (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
- ":noweb-ref[ \t]+" "\\)"))
- (new-body "")
- (nb-add (lambda (text) (setq new-body (concat new-body text))))
- (c-wrap (lambda (text)
- (with-temp-buffer
- (funcall (intern (concat lang "-mode")))
- (comment-region (point) (progn (insert text) (point)))
- (org-babel-trim (buffer-string)))))
- index source-name evaluate prefix blocks-in-buffer)
- (with-temp-buffer
- (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
- (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
- (insert body) (goto-char (point-min))
- (setq index (point))
- (while (and (re-search-forward (org-babel-noweb-wrap) nil t))
- (save-match-data (setf source-name (match-string 1)))
- (save-match-data (setq evaluate (string-match "\(.*\)" source-name)))
- (save-match-data
- (setq prefix
- (buffer-substring (match-beginning 0)
- (save-excursion
- (beginning-of-line 1) (point)))))
- ;; add interval to new-body (removing noweb reference)
- (goto-char (match-beginning 0))
- (funcall nb-add (buffer-substring index (point)))
- (goto-char (match-end 0))
- (setq index (point))
- (funcall nb-add
- (with-current-buffer parent-buffer
- (save-restriction
- (widen)
- (mapconcat ;; interpose PREFIX between every line
- #'identity
- (split-string
- (if evaluate
- (let ((raw (org-babel-ref-resolve source-name)))
- (if (stringp raw) raw (format "%S" raw)))
- (or
- ;; retrieve from the library of babel
- (nth 2 (assoc (intern source-name)
- org-babel-library-of-babel))
- ;; return the contents of headlines literally
- (save-excursion
- (when (org-babel-ref-goto-headline-id source-name)
- (org-babel-ref-headline-body)))
- ;; find the expansion of reference in this buffer
- (let ((rx (concat rx-prefix source-name "[ \t\n]"))
- expansion)
- (save-excursion
- (goto-char (point-min))
- (if *org-babel-use-quick-and-dirty-noweb-expansion*
- (while (re-search-forward rx nil t)
- (let* ((i (org-babel-get-src-block-info 'light))
- (body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion (cons sep (cons full expansion)))))
- (org-babel-map-src-blocks nil
- (let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
- (nth 4 i))
- source-name)
- (let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
- "\n"))
- (full (if comment
- ((lambda (cs)
- (concat (funcall c-wrap (car cs)) "\n"
- body "\n"
- (funcall c-wrap (cadr cs))))
- (org-babel-tangle-comment-links i))
- body)))
- (setq expansion
- (cons sep (cons full expansion)))))))))
- (and expansion
- (mapconcat #'identity (nreverse (cdr expansion)) "")))
- ;; possibly raise an error if named block doesn't exist
- (if (member lang org-babel-noweb-error-langs)
- (error "%s" (concat
- (org-babel-noweb-wrap source-name)
- "could not be resolved (see "
- "`org-babel-noweb-error-langs')"))
- "")))
- "[\n\r]") (concat "\n" prefix))))))
- (funcall nb-add (buffer-substring index (point-max))))
- new-body))
-
-(defun org-babel-script-escape (str &optional force)
- "Safely convert tables into elisp lists."
- (let (in-single in-double out)
- ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped)))
- (if (or force
- (and (stringp str)
- (> (length str) 2)
- (or (and (string-equal "[" (substring str 0 1))
- (string-equal "]" (substring str -1)))
- (and (string-equal "{" (substring str 0 1))
- (string-equal "}" (substring str -1)))
- (and (string-equal "(" (substring str 0 1))
- (string-equal ")" (substring str -1))))))
- (org-babel-read
- (concat
- "'"
- (progn
- (mapc
- (lambda (ch)
- (setq
- out
- (case ch
- (91 (if (or in-double in-single) ; [
- (cons 91 out)
- (cons 40 out)))
- (93 (if (or in-double in-single) ; ]
- (cons 93 out)
- (cons 41 out)))
- (123 (if (or in-double in-single) ; {
- (cons 123 out)
- (cons 40 out)))
- (125 (if (or in-double in-single) ; }
- (cons 125 out)
- (cons 41 out)))
- (44 (if (or in-double in-single) ; ,
- (cons 44 out) (cons 32 out)))
- (39 (if in-double ; '
- (cons 39 out)
- (setq in-single (not in-single)) (cons 34 out)))
- (34 (if in-single ; "
- (append (list 34 32) out)
- (setq in-double (not in-double)) (cons 34 out)))
- (t (cons ch out)))))
- (string-to-list str))
- (apply #'string (reverse out)))))
- str))))
-
-(defun org-babel-read (cell &optional inhibit-lisp-eval)
- "Convert the string value of CELL to a number if appropriate.
-Otherwise if cell looks like lisp (meaning it starts with a
-\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise
-return it unmodified as a string. Optional argument NO-LISP-EVAL
-inhibits lisp evaluation for situations in which is it not
-appropriate."
- (if (and (stringp cell) (not (equal cell "")))
- (or (org-babel-number-p cell)
- (if (and (not inhibit-lisp-eval)
- (member (substring cell 0 1) '("(" "'" "`" "[")))
- (eval (read cell))
- (if (string= (substring cell 0 1) "\"")
- (read cell)
- (progn (set-text-properties 0 (length cell) nil cell) cell))))
- cell))
-
-(defun org-babel-number-p (string)
- "If STRING represents a number return its value."
- (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string)
- (= (length (substring string (match-beginning 0)
- (match-end 0)))
- (length string)))
- (string-to-number string)))
-
-(defun org-babel-import-elisp-from-file (file-name &optional separator)
- "Read the results located at FILE-NAME into an elisp table.
-If the table is trivial, then return it as a scalar."
- (let (result)
- (save-window-excursion
- (with-temp-buffer
- (condition-case err
- (progn
- (org-table-import file-name separator)
- (delete-file file-name)
- (setq result (mapcar (lambda (row)
- (mapcar #'org-babel-string-read row))
- (org-table-to-lisp))))
- (error (message "Error reading results: %s" err) nil)))
- (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
- (if (consp (car result))
- (if (null (cdr (car result)))
- (caar result)
- result)
- (car result))
- result))))
-
-(defun org-babel-string-read (cell)
- "Strip nested \"s from around strings."
- (org-babel-read (or (and (stringp cell)
- (string-match "\\\"\\(.+\\)\\\"" cell)
- (match-string 1 cell))
- cell) t))
-
-(defun org-babel-reverse-string (string)
- "Return the reverse of STRING."
- (apply 'string (reverse (string-to-list string))))
-
-(defun org-babel-chomp (string &optional regexp)
- "Strip trailing spaces and carriage returns from STRING.
-Default regexp used is \"[ \f\t\n\r\v]\" but can be
-overwritten by specifying a regexp as a second argument."
- (let ((regexp (or regexp "[ \f\t\n\r\v]")))
- (while (and (> (length string) 0)
- (string-match regexp (substring string -1)))
- (setq string (substring string 0 -1)))
- string))
-
-(defun org-babel-trim (string &optional regexp)
- "Strip leading and trailing spaces and carriage returns from STRING.
-Like `org-babel-chomp' only it runs on both the front and back
-of the string."
- (org-babel-chomp (org-babel-reverse-string
- (org-babel-chomp (org-babel-reverse-string string) regexp))
- regexp))
-
-(defvar org-babel-org-babel-call-process-region-original nil)
-(defun org-babel-tramp-handle-call-process-region
- (start end program &optional delete buffer display &rest args)
- "Use Tramp to handle `call-process-region'.
-Fixes a bug in `tramp-handle-call-process-region'."
- (if (and (featurep 'tramp) (file-remote-p default-directory))
- (let ((tmpfile (tramp-compat-make-temp-file "")))
- (write-region start end tmpfile)
- (when delete (delete-region start end))
- (unwind-protect
- ;; (apply 'call-process program tmpfile buffer display args)
- ;; bug in tramp
- (apply 'process-file program tmpfile buffer display args)
- (delete-file tmpfile)))
- ;; org-babel-call-process-region-original is the original emacs
- ;; definition. It is in scope from the let binding in
- ;; org-babel-execute-src-block
- (apply org-babel-call-process-region-original
- start end program delete buffer display args)))
-
-(defun org-babel-local-file-name (file)
- "Return the local name component of FILE."
- (if (file-remote-p file)
- (let (localname)
- (with-parsed-tramp-file-name file nil
- localname))
- file))
-
-(defun org-babel-process-file-name (name &optional no-quote-p)
- "Prepare NAME to be used in an external process.
-If NAME specifies a remote location, the remote portion of the
-name is removed, since in that case the process will be executing
-remotely. The file name is then processed by `expand-file-name'.
-Unless second argument NO-QUOTE-P is non-nil, the file name is
-additionally processed by `shell-quote-argument'"
- ((lambda (f) (if no-quote-p f (shell-quote-argument f)))
- (expand-file-name (org-babel-local-file-name name))))
-
-(defvar org-babel-temporary-directory)
-(unless (or noninteractive (boundp 'org-babel-temporary-directory))
- (defvar org-babel-temporary-directory
- (or (and (boundp 'org-babel-temporary-directory)
- (file-exists-p org-babel-temporary-directory)
- org-babel-temporary-directory)
- (make-temp-file "babel-" t))
- "Directory to hold temporary files created to execute code blocks.
-Used by `org-babel-temp-file'. This directory will be removed on
-Emacs shutdown."))
-
-(defun org-babel-temp-file (prefix &optional suffix)
- "Create a temporary file in the `org-babel-temporary-directory'.
-Passes PREFIX and SUFFIX directly to `make-temp-file' with the
-value of `temporary-file-directory' temporarily set to the value
-of `org-babel-temporary-directory'."
- (let ((temporary-file-directory
- (if (file-remote-p default-directory)
- (concat (file-remote-p default-directory) "/tmp")
- (or (and (boundp 'org-babel-temporary-directory)
- (file-exists-p org-babel-temporary-directory)
- org-babel-temporary-directory)
- temporary-file-directory))))
- (make-temp-file prefix nil suffix)))
-
-(defun org-babel-remove-temporary-directory ()
- "Remove `org-babel-temporary-directory' on Emacs shutdown."
- (when (and (boundp 'org-babel-temporary-directory)
- (file-exists-p org-babel-temporary-directory))
- ;; taken from `delete-directory' in files.el
- (condition-case nil
- (progn
- (mapc (lambda (file)
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (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
- "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
- (delete-directory org-babel-temporary-directory))
- (error
- (message "Failed to remove temporary Org-babel directory %s"
- (if (boundp 'org-babel-temporary-directory)
- org-babel-temporary-directory
- "[directory not defined]"))))))
-
-(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+(require 'ob-eval)
+(require 'ob-core)
+(require 'ob-comint)
+(require 'ob-exp)
+(require 'ob-keys)
+(require 'ob-table)
+(require 'ob-lob)
+(require 'ob-ref)
+(require 'ob-tangle)
(provide 'ob)
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 764b15ff6c5..0b3be562489 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -1,6 +1,6 @@
;;; org-agenda.el --- Dynamic task and appointment lists for Org
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -227,7 +227,9 @@ As the value of this option simply gets inserted into the HTML <head> header,
you can \"misuse\" it to also add other text to the header."
:group 'org-agenda-export
:group 'org-export-html
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-agenda-persistent-filter nil
"When set, keep filters from one agenda view to the next."
@@ -242,6 +244,11 @@ you can \"misuse\" it to also add other text to the header."
(defconst org-sorting-choice
'(choice
(const time-up) (const time-down)
+ (const timestamp-up) (const timestamp-down)
+ (const scheduled-up) (const scheduled-down)
+ (const deadline-up) (const deadline-down)
+ (const ts-up) (const ts-down)
+ (const tsia-up) (const tsia-down)
(const category-keep) (const category-up) (const category-down)
(const tag-down) (const tag-up)
(const priority-up) (const priority-down)
@@ -254,9 +261,50 @@ you can \"misuse\" it to also add other text to the header."
;; Keep custom values for `org-agenda-filter-preset' compatible with
;; the new variable `org-agenda-tag-filter-preset'.
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
- (defvaralias 'org-agenda-filter 'org-agenda-tag-filter))
+(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
+
+(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
+ "List of types searched for when creating the daily/weekly agenda.
+This variable is a list of symbols that controls the types of
+items that appear in the daily/weekly agenda. Allowed symbols in this
+list are are
+
+ :timestamp List items containing a date stamp or date range matching
+ the selected date. This includes sexp entries in angular
+ brackets.
+
+ :sexp List entries resulting from plain diary-like sexps.
+
+ :deadline List deadline due on that date. When the date is today,
+ also list any deadlines past due, or due within
+ `org-deadline-warning-days'. `:deadline' must appear before
+ `:scheduled' if the setting of
+ `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
+ any effect.
+
+ :deadline* Same as above, but only include the deadline if it has an
+ hour specification as [h]h:mm.
+
+ :scheduled List all items which are scheduled for the given date.
+ The diary for *today* also contains items which were
+ scheduled earlier and are not yet marked DONE.
+
+ :scheduled* Same as above, but only include the scheduled item if it
+ has an hour specification as [h]h:mm.
+
+By default, all four non-starred types are turned on.
+
+When :scheduled* or :deadline* are included, :schedule or :deadline
+will be ignored.
+
+Never set this variable globally using `setq', because then it
+will apply to all future agenda commands. Instead, bind it with
+`let' to scope it dynamically into the agenda-constructing
+command. A good way to set it is through options in
+`org-agenda-custom-commands'. For a more flexible (though
+somewhat less efficient) way of determining what is included in
+the daily/weekly agenda, see `org-agenda-skip-function'.")
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
@@ -280,10 +328,11 @@ you can \"misuse\" it to also add other text to the header."
(string))
(list :tag "Number of days in agenda"
(const org-agenda-span)
- (choice (const :tag "Day" 'day)
- (const :tag "Week" 'week)
- (const :tag "Month" 'month)
- (const :tag "Year" 'year)
+ (choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
(integer :tag "Custom")))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
@@ -311,13 +360,21 @@ you can \"misuse\" it to also add other text to the header."
(const :format "" quote)
(repeat
(string :tag "+tag or -tag"))))
+ (list :tag "Regexp filter preset"
+ (const org-agenda-regexp-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+regexp or -regexp"))))
(list :tag "Set daily/weekly entry types"
(const org-agenda-entry-types)
(list
(const :format "" quote)
- (set :greedy t :value (:deadline :scheduled :timestamp :sexp)
+ (set :greedy t :value ,org-agenda-entry-types
(const :deadline)
(const :scheduled)
+ (const :deadline*)
+ (const :scheduled*)
(const :timestamp)
(const :sexp))))
(list :tag "Standard skipping condition"
@@ -333,23 +390,27 @@ you can \"misuse\" it to also add other text to the header."
(repeat :inline t :tag "Conditions for skipping"
(choice
:tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp))
+ (list :tag "Regexp matches" :inline t
+ (const :format "" 'regexp)
+ (regexp))
+ (list :tag "Regexp does not match" :inline t
+ (const :format "" 'notregexp)
+ (regexp))
(list :tag "TODO state is" :inline t
(const 'todo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "Any not-done state" 'todo)
+ (const :tag "Any done state" 'done)
+ (const :tag "Any state" 'any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
(list :tag "TODO state is not" :inline t
(const 'nottodo)
(choice
- (const :tag "any not-done state" 'todo)
- (const :tag "any done state" 'done)
- (const :tag "any state" 'any)
+ (const :tag "Any not-done state" 'todo)
+ (const :tag "Any done state" 'done)
+ (const :tag "Any state" 'any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
@@ -371,8 +432,8 @@ This will be spliced into the custom type of
`org-agenda-custom-commands'.")
-(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's"
- ((agenda "") (alltodo))))
+(defcustom org-agenda-custom-commands
+ '(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
"Custom commands for the agenda.
These commands will be offered on the splash screen displayed by the
agenda dispatcher \\[org-agenda]. Each entry is a list like this:
@@ -436,7 +497,7 @@ are prefix commands. For the dispatcher to display useful information, you
should provide a description for the prefix, like
(setq org-agenda-custom-commands
- '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
+ \\='((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
(\"hl\" tags \"+HOME+Lisa\")
(\"hp\" tags \"+HOME+Peter\")
(\"hk\" tags \"+HOME+Kim\")))"
@@ -592,8 +653,8 @@ of custom agenda commands."
:tag "Org Agenda Match View"
:group 'org-agenda)
(defgroup org-agenda-search-view nil
- "Options concerning the general tags/property/todo match agenda view."
- :tag "Org Agenda Match View"
+ "Options concerning the search agenda view."
+ :tag "Org Agenda Search View"
:group 'org-agenda)
(defvar org-agenda-archives-mode nil
@@ -603,6 +664,13 @@ that are marked with the ARCHIVE tag will be included anyway. When this is
t, also all archive files associated with the current selection of agenda
files will be included.")
+(defcustom org-agenda-restriction-lock-highlight-subtree t
+ "Non-nil means highlight the whole subtree when restriction is active.
+Otherwise only highlight the headline. Highlighting the whole subtree is
+useful to ensure no edits happen beyond the restricted region."
+ :group 'org-agenda
+ :type 'boolean)
+
(defcustom org-agenda-skip-comment-trees t
"Non-nil means skip trees that start with the COMMENT keyword.
When nil, these trees are also scanned by agenda commands."
@@ -700,7 +768,7 @@ to make his option also apply to the tags-todo list."
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
(defcustom org-agenda-todo-ignore-deadlines nil
- "Non-nil means ignore some deadlined TODO items when making TODO list.
+ "Non-nil means ignore some deadline TODO items when making TODO list.
There are different motivations for using different values, please think
carefully when configuring this variable.
@@ -740,8 +808,24 @@ to make his option also apply to the tags-todo list."
(const :tag "Show all TODOs, even if they have a deadline" nil)
(integer :tag "Ignore if N or more days in past(-) or future(+).")))
+(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
+ "Time unit to use when possibly ignoring an agenda item.
+
+See the docstring of various `org-agenda-todo-ignore-*' options.
+The default is to compare time stamps using days. An item is thus
+considered to be in the future if it is at least one day after today.
+Non-nil means to compare time stamps using seconds. An item is then
+considered future if it has a time value later than current time."
+ :group 'org-agenda-skip
+ :group 'org-agenda-todo-list
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Compare time with days" nil)
+ (const :tag "Compare time with seconds" t)))
+
(defcustom org-agenda-tags-todo-honor-ignore-options nil
- "Non-nil means honor todo-list ...ignore options also in tags-todo search.
+ "Non-nil means honor todo-list ignores options also in tags-todo search.
The variables
`org-agenda-todo-ignore-with-date',
`org-agenda-todo-ignore-timestamp',
@@ -768,20 +852,29 @@ is DONE."
(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
"Non-nil means skip scheduling line if same entry shows because of deadline.
-In the agenda of today, an entry can show up multiple times because
-it is both scheduled and has a nearby deadline, and maybe a plain time
-stamp as well.
-When this variable is t, then only the deadline is shown and the fact that
-the entry is scheduled today or was scheduled previously is not shown.
-When this variable is nil, the entry will be shown several times. When
-the variable is the symbol `not-today', then skip scheduled previously,
-but not scheduled today."
+
+In the agenda of today, an entry can show up multiple times
+because it is both scheduled and has a nearby deadline, and maybe
+a plain time stamp as well.
+
+When this variable is nil, the entry will be shown several times.
+
+When set to t, then only the deadline is shown and the fact that
+the entry is scheduled today or was scheduled previously is not
+shown.
+
+When set to the symbol `not-today', skip scheduled previously,
+but not scheduled today.
+
+When set to the symbol `repeated-after-deadline', skip scheduled
+items if they are repeated beyond the current deadline."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type '(choice
(const :tag "Never" nil)
(const :tag "Always" t)
- (const :tag "Not when scheduled today" not-today)))
+ (const :tag "Not when scheduled today" not-today)
+ (const :tag "When repeated past deadline" repeated-after-deadline)))
(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
"Non-nil means skip timestamp line if same entry shows because of deadline.
@@ -813,9 +906,10 @@ deadlines are always turned off when the item is DONE."
This will apply on all days where a prewarning for the deadline would
be shown, but not at the day when the entry is actually due. On that day,
the deadline will be shown anyway.
-This variable may be set to nil, t, or a number which will then give
-the number of days before the actual deadline when the prewarnings
-should resume.
+This variable may be set to nil, t, the symbol `pre-scheduled',
+or a number which will then give the number of days before the actual
+deadline when the prewarnings should resume. The symbol `pre-scheduled'
+eliminates the deadline prewarning only prior to the scheduled date.
This can be used in a workflow where the first showing of the deadline will
trigger you to schedule it, and then you don't want to be reminded of it
because you will take care of it on the day when scheduled."
@@ -824,9 +918,26 @@ because you will take care of it on the day when scheduled."
:version "24.1"
:type '(choice
(const :tag "Always show prewarning" nil)
+ (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
(const :tag "Remove prewarning if entry is scheduled" t)
(integer :tag "Restart prewarning N days before deadline")))
+(defcustom org-agenda-skip-scheduled-delay-if-deadline nil
+ "Non-nil means skip scheduled delay when entry also has a deadline.
+This variable may be set to nil, t, the symbol `post-deadline',
+or a number which will then give the number of days after the actual
+scheduled date when the delay should expire. The symbol `post-deadline'
+eliminates the schedule delay when the date is posterior to the deadline."
+ :group 'org-agenda-skip
+ :group 'org-agenda-daily/weekly
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Always honor delay" nil)
+ (const :tag "Ignore delay if posterior to the deadline" post-deadline)
+ (const :tag "Ignore delay if entry has a deadline" t)
+ (integer :tag "Honor delay up until N days after the scheduled date")))
+
(defcustom org-agenda-skip-additional-timestamps-same-entry nil
"When nil, multiple same-day timestamps in entry make multiple agenda lines.
When non-nil, after the search for timestamps has matched once in an
@@ -840,7 +951,7 @@ entry, the rest of the entry will not be searched."
:group 'org-agenda-daily/weekly
:type 'boolean)
-(defcustom org-agenda-dim-blocked-tasks nil
+(defcustom org-agenda-dim-blocked-tasks t
"Non-nil means dim blocked tasks in the agenda display.
This causes some overhead during agenda construction, but if you
have turned on `org-enforce-todo-dependencies',
@@ -956,6 +1067,13 @@ removed from entry text before it is shown in the agenda."
:group 'org-agenda
:type '(repeat (regexp)))
+(defcustom org-agenda-entry-text-leaders " > "
+ "Text prepended to the entry text in agenda buffers."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda
+ :type 'string)
+
(defvar org-agenda-entry-text-cleanup-hook nil
"Hook that is run after basic cleanup of entry text to be shown in agenda.
This cleanup is done in a temporary buffer, so the function may inspect and
@@ -1013,7 +1131,8 @@ option will be ignored."
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type '(choice (const nil)
+ (integer)))
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
@@ -1024,13 +1143,14 @@ Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Day" day)
(const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
(const :tag "Month" month)
(const :tag "Year" year)
(integer :tag "Custom")))
(defcustom org-agenda-start-on-weekday 1
"Non-nil means start the overview always on the specified weekday.
-0 denotes Sunday, 1 denotes Monday etc.
+0 denotes Sunday, 1 denotes Monday, etc.
When nil, always start on the current day.
Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
@@ -1055,7 +1175,7 @@ a calendar-style date list like (month day year)."
(function :tag "Function")))
(defun org-agenda-format-date-aligned (date)
- "Format a date string for display in the daily/weekly agenda, or timeline.
+ "Format a DATE string for display in the daily/weekly agenda, or timeline.
This function makes sure that dates are aligned for easy reading."
(require 'cal-iso)
(let* ((dayname (calendar-day-name date))
@@ -1091,7 +1211,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
:type 'boolean)
(defun org-agenda-time-of-day-to-ampm (time)
- "Convert TIME of a string like '13:45' to an AM/PM style time string."
+ "Convert TIME of a string like `13:45' to an AM/PM style time string."
(let* ((hour-number (string-to-number (substring time 0 -3)))
(minute (substring time -2))
(ampm "am"))
@@ -1108,8 +1228,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
":" minute ampm)))
(defun org-agenda-time-of-day-to-ampm-maybe (time)
- "Conditionally convert TIME to AM/PM format
-based on `org-agenda-timegrid-use-ampm'"
+ "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'."
(if org-agenda-timegrid-use-ampm
(org-agenda-time-of-day-to-ampm time)
time))
@@ -1164,7 +1283,7 @@ shown, either today or the nearest into the future."
(const :tag "Don't show repeating stamps" nil)))
(defcustom org-scheduled-past-days 10000
- "No. of days to continue listing scheduled items that are not marked DONE.
+ "Number of days to continue listing scheduled items not marked DONE.
When an item is scheduled on a date, it shows up in the agenda on this
day and will be listed until it is marked done for the number of days
given here."
@@ -1242,12 +1361,12 @@ explanations on the possible values."
:group 'org-agenda-startup
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Don't show log items" nil)
- (const :tag "Show only log items" 'only)
- (const :tag "Show all possible log items" 'clockcheck)
+ (const :tag "Show only log items" only)
+ (const :tag "Show all possible log items" clockcheck)
(repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
- (choice (const :tag "Show closed log items" 'closed)
- (const :tag "Show clocked log items" 'clock)
- (const :tag "Show all logged state changes" 'state)))))
+ (choice (const :tag "Show closed log items" closed)
+ (const :tag "Show clocked log items" clock)
+ (const :tag "Show all logged state changes" state)))))
(defcustom org-agenda-start-with-clockreport-mode nil
"The initial value of clockreport-mode in a newly created agenda window."
@@ -1294,9 +1413,8 @@ boolean search."
:version "24.1"
:type 'boolean)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-search-view-search-words-only
- 'org-agenda-search-view-always-boolean))
+(org-defvaralias 'org-agenda-search-view-search-words-only
+ 'org-agenda-search-view-always-boolean)
(defcustom org-agenda-search-view-force-full-words nil
"Non-nil means, search words must be matches as complete words.
@@ -1305,6 +1423,16 @@ When nil, they may also match part of a word."
:version "24.1"
:type 'boolean)
+(defcustom org-agenda-search-view-max-outline-level 0
+ "Maximum outline level to display in search view.
+E.g. when this is set to 1, the search view will only
+show headlines of level 1. When set to 0, the default
+value, don't limit agenda view by outline level."
+ :group 'org-agenda-search-view
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'integer)
+
(defgroup org-agenda-time-grid nil
"Options concerning the time grid in the Org-mode Agenda."
:tag "Org Agenda Time Grid"
@@ -1344,6 +1472,7 @@ symbols specifying conditions when the grid should be displayed:
weekly if the agenda shows an entire week
today show grid on current date, independent of daily/weekly display
require-timed show grid only if at least one item has a time specification
+ remove-match skip grid times already present in an entry
The second item is a string which will be placed behind the grid time.
@@ -1393,6 +1522,16 @@ symbols are recognized:
time-up Put entries with time-of-day indications first, early first
time-down Put entries with time-of-day indications first, late first
+timestamp-up Sort by any timestamp, early first
+timestamp-down Sort by any timestamp, late first
+scheduled-up Sort by scheduled timestamp, early first
+scheduled-down Sort by scheduled timestamp, late first
+deadline-up Sort by deadline timestamp, early first
+deadline-down Sort by deadline timestamp, late first
+ts-up Sort by active timestamp, early first
+ts-down Sort by active timestamp, late first
+tsia-up Sort by inactive timestamp, early first
+tsia-down Sort by inactive timestamp, late first
category-keep Keep the default order of categories, corresponding to the
sequence in `org-agenda-files'.
category-up Sort alphabetically by category, A-Z.
@@ -1493,15 +1632,17 @@ This format works similar to a printf format, with the following meaning:
%c the category of the item, \"Diary\" for entries from the diary,
or as given by the CATEGORY keyword or derived from the file name
%e the effort required by the item
+ %l the level of the item (insert X space(s) if item is of level X)
%i the icon category of the item, see `org-agenda-category-icon-alist'
%T the last tag of the item (ignore inherited tags, which come first)
%t the HH:MM time-of-day specification if one applies to the entry
%s Scheduling/Deadline information, a short string
+ %b show breadcrumbs, i.e., the names of the higher levels
%(expression) Eval EXPRESSION and replace the control string
by the result
All specifiers work basically like the standard `%s' of printf, but may
-contain two additional characters: a question mark just after the `%'
+contain two additional characters: a question mark just after the `%'
and a whitespace/punctuation character just before the final letter.
If the first character after `%' is a question mark, the entire field
@@ -1511,11 +1652,11 @@ present, but zero width when absent. For example, \"%?-12t\" will
result in a 12 character time field if a time of the day is specified,
but will completely disappear in entries which do not contain a time.
-If there is punctuation or whitespace character just before the final
-format letter, this character will be appended to the field value if
-the value is not empty. For example, the format \"%-12:c\" leads to
-\"Diary: \" if the category is \"Diary\". If the category were be
-empty, no additional colon would be inserted.
+If there is punctuation or whitespace character just before the
+final format letter, this character will be appended to the field
+value if the value is not empty. For example, the format
+\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If
+the category is empty, no additional colon is inserted.
The default value for the agenda sublist is \" %-12:c%?-12t% s\",
which means:
@@ -1588,6 +1729,8 @@ this item is scheduled, due to automatic rescheduling of unfinished items
for the following day. So this number is one larger than the number of days
that passed since this item was scheduled first."
:group 'org-agenda-line-format
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(list
(string :tag "Scheduled today ")
(string :tag "Scheduled previously")))
@@ -1597,22 +1740,21 @@ that passed since this item was scheduled first."
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
:version "24.1"
- :type '(list
- (string :tag "Scheduled today ")
- (string :tag "Scheduled previously")))
+ :type 'string)
-(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ")
+(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
"Text preceding deadline items in the agenda view.
-This is a list with two strings. The first applies when the item has its
-deadline on the current day. The second applies when it is in the past or
-in the future, it may contain %d to capture how many days away the deadline
-is (was)."
+This is a list with three strings. The first applies when the item has its
+deadline on the current day. The second applies when the deadline is in the
+future, the third one when it is in the past. The strings may contain %d
+to capture the number of days."
:group 'org-agenda-line-format
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(list
- (string :tag "Deadline today ")
- (choice :tag "Deadline relative"
- (string :tag "Format string")
- (function))))
+ (string :tag "Deadline today ")
+ (string :tag "Deadline in the future ")
+ (string :tag "Deadline in the past ")))
(defcustom org-agenda-remove-times-when-in-prefix t
"Non-nil means remove duplicate time specifications in agenda items.
@@ -1668,7 +1810,7 @@ When set to nil, never show inherited tags in agenda lines."
:version "24.3"
:type '(choice
(const :tag "Show inherited tags when available" t)
- (const :tag "Always show inherited tags" 'always)
+ (const :tag "Always show inherited tags" always)
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
@@ -1716,9 +1858,8 @@ When this is the symbol `prefix', only remove tags when
(const :tag "Never" nil)
(const :tag "When prefix format contains %T" prefix)))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-remove-tags-when-in-prefix
- 'org-agenda-remove-tags))
+(org-defvaralias 'org-agenda-remove-tags-when-in-prefix
+ 'org-agenda-remove-tags)
(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
"Shift tags in agenda items to this column.
@@ -1728,8 +1869,7 @@ it means that the tags should be flushright to that column. For example,
:group 'org-agenda-line-format
:type 'integer)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column))
+(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
(defcustom org-agenda-fontify-priorities 'cookies
"Non-nil means highlight low and high priorities in agenda.
@@ -1762,7 +1902,7 @@ returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
:version "24.1"
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
@@ -1792,7 +1932,7 @@ list as second element:
For example, to display a 16px horizontal space for Emacs
category, you can use:
- (\"Emacs\" '(space . (:width (16))))"
+ (\"Emacs\" \\='(space . (:width (16))))"
:group 'org-agenda-line-format
:version "24.1"
:type '(alist :key-type (string :tag "Regexp matching category")
@@ -1835,7 +1975,7 @@ estimate."
:type 'boolean)
(defcustom org-agenda-auto-exclude-function nil
- "A function called with a tag to decide if it is filtered on '/ RET'.
+ "A function called with a tag to decide if it is filtered on `/ RET'.
The sole argument to the function, which is called once for each
possible tag, is a string giving the name of the tag. The
function should return either nil if the tag should be included
@@ -1844,14 +1984,14 @@ Note that for the purpose of tag filtering, only the lower-case version of
all tags will be considered, so that this function will only ever see
the lower-case version of all tags."
:group 'org-agenda
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
For example, this value makes those two functions available:
- '((?R set-category)
- (?C bulk-cut))
+ ((?R set-category)
+ (?C bulk-cut))
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
@@ -1887,8 +2027,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-keymap 'org-agenda-mode-map))
+(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
(defvar org-agenda-menu) ; defined later in this file.
(defvar org-agenda-restrict nil) ; defined later in this file.
@@ -1956,12 +2095,12 @@ When nil, `q' will kill the single agenda buffer."
org-agenda-bulk-marked-entries
org-agenda-undo-has-started-in
org-agenda-info
- org-agenda-tag-filter-overlays
- org-agenda-cat-filter-overlays
org-agenda-pre-window-conf
org-agenda-columns-active
org-agenda-tag-filter
org-agenda-category-filter
+ org-agenda-top-headline-filter
+ org-agenda-regexp-filter
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
org-agenda-filtered-by-category
@@ -2008,6 +2147,7 @@ The following commands are available:
;; Keep global-font-lock-mode from turning on font-lock-mode
(org-set-local 'font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
+ (setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
@@ -2015,16 +2155,17 @@ The following commands are available:
(org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
(org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
- (add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (substring-no-properties (funcall fun start end delete)))
- nil t)
+ (org-add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (substring-no-properties (funcall fun start end delete)))
+ nil t)
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
- org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
- org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
- org-agenda-show-log org-agenda-start-with-log-mode))
-
+ org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode))
+ (setq org-agenda-show-log org-agenda-start-with-log-mode)
+ (setq org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)
+ (add-to-invisibility-spec '(org-filtered))
+ (add-to-invisibility-spec '(org-link))
(easy-menu-change
'("Agenda") "Agenda Files"
(append
@@ -2049,8 +2190,12 @@ The following commands are available:
(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
+(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward)
+(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward)
(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
+(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle)
(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
+(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all)
(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks)
(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
@@ -2164,9 +2309,12 @@ The following commands are available:
(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
+(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
+(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
+(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
-(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category)
+(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@@ -2194,7 +2342,11 @@ The following commands are available:
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'week)
- :keys "v w (or just w)"]
+ :keys "v w"]
+ ["Fortnight View" org-agenda-fortnight-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'fortnight)
+ :keys "v f"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
@@ -2263,9 +2415,11 @@ The following commands are available:
("Bulk action"
["Mark entry" org-agenda-bulk-mark t]
["Mark all" org-agenda-bulk-mark-all t]
- ["Mark matching regexp" org-agenda-bulk-mark-regexp t]
["Unmark entry" org-agenda-bulk-unmark t]
- ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"])
+ ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
+ ["Toggle mark" org-agenda-bulk-toggle t]
+ ["Toggle all" org-agenda-bulk-toggle-all t]
+ ["Mark regexp" org-agenda-bulk-mark-regexp t])
["Act on all marked" org-agenda-bulk-action t]
"--"
("Tags and Properties"
@@ -2307,7 +2461,7 @@ The following commands are available:
["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
"--"
- ["Create iCalendar File" org-export-icalendar-combine-agenda-files t])
+ ["Create iCalendar File" org-icalendar-combine-agenda-files t])
"--"
["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
"--"
@@ -2336,12 +2490,12 @@ This undoes changes both in the agenda buffer and in the remote buffer
that have been changed along."
(interactive)
(or org-agenda-allow-remote-undo
- (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
+ (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
(if (not (eq this-command last-command))
(setq org-agenda-undo-has-started-in nil
org-agenda-pending-undo-list org-agenda-undo-list))
(if (not org-agenda-pending-undo-list)
- (error "No further undo information"))
+ (user-error "No further undo information"))
(let* ((entry (pop org-agenda-pending-undo-list))
buf line cmd rembuf)
(setq cmd (pop entry) line (pop entry))
@@ -2384,7 +2538,7 @@ For example, if you have a custom agenda command \"p\" and you
want this command to be accessible only from plain text files,
use this:
- '((\"p\" ((in-file . \"\\.txt\"))))
+ \\='((\"p\" ((in-file . \"\\.txt\"))))
Here are the available contexts definitions:
@@ -2392,6 +2546,8 @@ Here are the available contexts definitions:
in-mode: command displayed only in matching modes
not-in-file: command not displayed in matching files
not-in-mode: command not displayed in matching modes
+ in-buffer: command displayed only in matching buffers
+not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
@@ -2400,7 +2556,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- '((\"p\" \"q\" ((in-file . \"\\.txt\"))))
+ \\='((\"p\" \"q\" ((in-file . \"\\.txt\"))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
@@ -2417,11 +2573,89 @@ duplicates.)"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
+ (const :tag "In buffer" in-buffer)
+ (const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
(function :tag "Custom function"))))))
+(defcustom org-agenda-max-entries nil
+ "Maximum number of entries to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of entries")))))
+
+(defcustom org-agenda-max-todos nil
+ "Maximum number of TODOs to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of TODOs")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of TODOs")))))
+
+(defcustom org-agenda-max-tags nil
+ "Maximum number of tagged entries to display in an agenda.
+This can be nil (no limit) or an integer or an alist of agenda
+types with an associated number of entries to display in this
+type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of tagged entries")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of tagged entries")))))
+
+(defcustom org-agenda-max-effort nil
+ "Maximum cumulated effort duration for the agenda.
+This can be nil (no limit) or a number of minutes (as an integer)
+or an alist of agenda types with an associated number of minutes
+to limit entries to in this type."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-agenda-custom-commands
+ :type '(choice (symbol :tag "No limit" nil)
+ (integer :tag "Max number of minutes")
+ (repeat
+ (cons (choice :tag "Agenda type"
+ (const agenda)
+ (const todo)
+ (const tags)
+ (const search)
+ (const timeline))
+ (integer :tag "Max number of minutes")))))
+
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
@@ -2515,12 +2749,12 @@ Pressing `<' twice means to restrict to the current subtree or region
(put 'org-agenda-files 'org-restrict (list bfn))
(cond
((eq restriction 'region)
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(move-marker org-agenda-restrict-begin (region-beginning))
(move-marker org-agenda-restrict-end (region-end)))
((eq restriction 'subtree)
(save-excursion
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(org-back-to-heading t)
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
@@ -2541,6 +2775,8 @@ Pressing `<' twice means to restrict to the current subtree or region
(cond
((eq type 'agenda)
(org-let lprops '(org-agenda-list current-prefix-arg)))
+ ((eq type 'agenda*)
+ (org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
((eq type 'alltodo)
(org-let lprops '(org-todo-list current-prefix-arg)))
((eq type 'search)
@@ -2569,7 +2805,7 @@ Pressing `<' twice means to restrict to the current subtree or region
(org-let lprops '(funcall type org-match)))
((fboundp type)
(org-let lprops '(funcall type org-match)))
- (t (error "Invalid custom agenda command type %s" type))))
+ (t (user-error "Invalid custom agenda command type %s" type))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
@@ -2600,14 +2836,16 @@ Pressing `<' twice means to restrict to the current subtree or region
t t))
((equal org-keys "L")
(unless (derived-mode-p 'org-mode)
- (error "This is not an Org-mode file"))
+ (user-error "This is not an Org-mode file"))
(unless restriction
(put 'org-agenda-files 'org-restrict (list bfn))
(org-call-with-arg 'org-timeline arg)))
((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
((equal org-keys "!") (customize-variable 'org-stuck-projects))
- (t (error "Invalid agenda key"))))))
+ (t (user-error "Invalid agenda key"))))))
+
+(defvar org-agenda-multi)
(defun org-agenda-append-agenda ()
"Append another agenda view to the current one.
@@ -2615,14 +2853,16 @@ This function allows interactive building of block agendas.
Agenda views are separated by `org-agenda-block-separator'."
(interactive)
(unless (derived-mode-p 'org-agenda-mode)
- (error "Can only append from within agenda buffer"))
+ (user-error "Can only append from within agenda buffer"))
(let ((org-agenda-multi t))
(org-agenda)
(widen)
(org-agenda-finalize)
+ (setq buffer-read-only t)
(org-agenda-fit-window-to-buffer)))
(defun org-agenda-normalize-custom-commands (cmds)
+ "Normalize custom commands CMDS."
(delq nil
(mapcar
(lambda (x)
@@ -2697,6 +2937,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(cond
((string-match "\\S-" desc) desc)
((eq type 'agenda) "Agenda for current week or day")
+ ((eq type 'agenda*) "Appointments for current week or day")
((eq type 'alltodo) "List of all TODO entries")
((eq type 'search) "Word search")
((eq type 'stuck) "List of stuck projects")
@@ -2820,7 +3061,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(org-agenda-get-restriction-and-command prefix-descriptions))
((equal c ?q) (error "Abort"))
- (t (error "Invalid key %c" c))))))))
+ (t (user-error "Invalid key %c" c))))))))
(defun org-agenda-fit-window-to-buffer ()
"Fit the window to the buffer size."
@@ -2836,6 +3077,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(defvar org-agenda-overriding-arguments nil)
(defvar org-agenda-overriding-cmd-arguments nil)
(defun org-agenda-run-series (name series)
+ "Run agenda NAME as a SERIES of agenda commands."
(org-let (nth 1 series) '(org-agenda-prepare name))
;; We need to reset agenda markers here, because when constructing a
;; block agenda, the individual blocks do not do that.
@@ -2858,6 +3100,9 @@ L Timeline for current buffer # List stuck projects (!=configure)
((eq type 'agenda)
(org-let2 gprops lprops
'(call-interactively 'org-agenda-list)))
+ ((eq type 'agenda*)
+ (org-let2 gprops lprops
+ '(funcall 'org-agenda-list nil nil t)))
((eq type 'alltodo)
(org-let2 gprops lprops
'(call-interactively 'org-todo-list)))
@@ -2898,9 +3143,10 @@ longer string it is used as a tags/todo match string.
Parameters are alternating variable names and values that will be bound
before running the agenda command."
(org-eval-in-environment (org-make-parameter-alist parameters)
- (if (> (length cmd-key) 2)
- (org-tags-view nil cmd-key)
- (org-agenda nil cmd-key)))
+ (let (org-agenda-sticky)
+ (if (> (length cmd-key) 2)
+ (org-tags-view nil cmd-key)
+ (org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
(princ (buffer-string)))
@@ -3005,6 +3251,7 @@ This ensures the export commands can easily use it."
;;;###autoload
(defun org-store-agenda-views (&rest parameters)
+ "Store agenda views."
(interactive)
(eval (list 'org-batch-store-agenda-views)))
@@ -3060,10 +3307,12 @@ This ensures the export commands can easily use it."
(defun org-agenda-write (file &optional open nosettings agenda-bufname)
"Write the current buffer (an agenda view) as a file.
Depending on the extension of the file name, plain text (.txt),
-HTML (.html or .htm) or Postscript (.ps) is produced.
+HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
If the extension is .ics, run icalendar export over all files used
to construct the agenda and limit the export to entries listed in the
agenda now.
+If the extension is .org, collect all subtrees corresponding to the
+agenda entries and add them in an .org file.
With prefix argument OPEN, open the new file immediately.
If NOSETTINGS is given, do not scope the settings of
`org-agenda-exporter-settings' into the export commands. This is used when
@@ -3071,28 +3320,43 @@ the settings have already been scoped and we do not wish to overrule other,
higher priority settings.
If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(interactive "FWrite agenda to file: \nP")
- (if (not (file-writable-p file))
- (error "Cannot write agenda to file %s" file))
+ (if (or (not (file-writable-p file))
+ (and (file-exists-p file)
+ (if (org-called-interactively-p 'any)
+ (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
+ (user-error "Cannot write agenda to file %s" file))
(org-let (if nosettings nil org-agenda-exporter-settings)
'(save-excursion
(save-window-excursion
- (org-agenda-mark-filtered-text)
- (let ((bs (copy-sequence (buffer-string))) beg)
- (org-agenda-unmark-filtered-text)
+ (let ((bs (copy-sequence (buffer-string))) beg content)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
- (while (setq beg (text-property-any (point-min) (point-max)
- 'org-filtered t))
- (delete-region
- beg (or (next-single-property-change beg 'org-filtered)
- (point-max))))
(run-hooks 'org-agenda-before-write-hook)
(cond
((org-bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
+ ((string-match "\\.org\\'" file)
+ (let (content p m message-log-max)
+ (goto-char (point-min))
+ (while (setq p (next-single-property-change (point) 'org-hd-marker nil))
+ (goto-char p)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when m
+ (push (save-excursion
+ (set-buffer (marker-buffer m))
+ (goto-char m)
+ (org-copy-subtree 1 nil t t)
+ org-subtree-clip)
+ content)))
+ (find-file file)
+ (erase-buffer)
+ (dolist (s content) (org-paste-subtree 1 s))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (message "Org file written to %s" file)))
((string-match "\\.html?\\'" file)
(require 'htmlize)
(set-buffer (htmlize-buffer (current-buffer)))
@@ -3120,14 +3384,8 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(delete-file (concat (file-name-sans-extension file) ".ps"))
(message "PDF written to %s" file))
((string-match "\\.ics\\'" file)
- (require 'org-icalendar)
- (let ((org-agenda-marker-table
- (org-create-marker-find-array
- (org-agenda-collect-markers)))
- (org-icalendar-verify-function 'org-check-agenda-marker-table)
- (org-combined-agenda-icalendar-file file))
- (apply 'org-export-icalendar 'combine
- (org-agenda-files nil 'ifmode))))
+ (require 'ox-icalendar)
+ (org-icalendar-export-current-agenda (expand-file-name file)))
(t
(let ((bs (buffer-string)))
(find-file file)
@@ -3141,26 +3399,6 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
org-agenda-buffer-name)))
(when open (org-open-file file)))
-(defvar org-agenda-tag-filter-overlays nil)
-(defvar org-agenda-cat-filter-overlays nil)
-
-(defun org-agenda-mark-filtered-text ()
- "Mark all text hidden by filtering with a text property."
- (let ((inhibit-read-only t))
- (mapc
- (lambda (o)
- (when (equal (overlay-buffer o) (current-buffer))
- (put-text-property
- (overlay-start o) (overlay-end o)
- 'org-filtered t)))
- (append org-agenda-tag-filter-overlays
- org-agenda-cat-filter-overlays))))
-
-(defun org-agenda-unmark-filtered-text ()
- "Remove the filtering text property."
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(org-filtered t))))
-
(defun org-agenda-remove-marked-text (property &optional value)
"Delete all text marked with VALUE of PROPERTY.
VALUE defaults to t."
@@ -3169,7 +3407,7 @@ VALUE defaults to t."
(while (setq beg (text-property-any (point-min) (point-max)
property value))
(delete-region
- beg (or (next-single-property-change beg 'org-filtered)
+ beg (or (next-single-property-change beg property)
(point-max))))))
(defun org-agenda-add-entry-text ()
@@ -3278,43 +3516,6 @@ removed from the entry content. Currently only `planning' is allowed here."
(setq txt (buffer-substring (point-min) (point)))))))))
txt))
-(defun org-agenda-collect-markers ()
- "Collect the markers pointing to entries in the agenda buffer."
- (let (m markers)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (setq m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker)))
- (push m markers))
- (beginning-of-line 2)))
- (nreverse markers)))
-
-(defun org-create-marker-find-array (marker-list)
- "Create a alist of files names with all marker positions in that file."
- (let (f tbl m a p)
- (while (setq m (pop marker-list))
- (setq p (marker-position m)
- f (buffer-file-name (or (buffer-base-buffer
- (marker-buffer m))
- (marker-buffer m))))
- (if (setq a (assoc f tbl))
- (push (marker-position m) (cdr a))
- (push (list f p) tbl)))
- (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
- tbl)))
-
-(defvar org-agenda-marker-table nil) ; dynamically scoped parameter
-(defun org-check-agenda-marker-table ()
- "Check of the current entry is on the marker list."
- (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
- a)
- (and (setq a (assoc file org-agenda-marker-table))
- (save-match-data
- (save-excursion
- (org-back-to-heading t)
- (member (point) (cdr a)))))))
-
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
(or (derived-mode-p 'org-mode)
@@ -3329,8 +3530,8 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-agenda-name nil)
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
-(defvar org-agenda-top-category-filter nil)
-(defvar org-agenda-tag-filter-while-redo nil)
+(defvar org-agenda-regexp-filter nil)
+(defvar org-agenda-top-headline-filter nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
@@ -3351,6 +3552,15 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-regexp-filter-preset nil
+ "A preset of the regexp filter used for secondary agenda filtering.
+This must be a list of strings, each string must be a single regexp
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
(defun org-agenda-use-sticky-p ()
"Return non-nil if an agenda buffer named
@@ -3373,10 +3583,12 @@ generating a new one."
;; does not have org variables local
org-agenda-this-buffer-is-sticky))))
-(defun org-agenda-prepare-window (abuf)
- "Setup agenda buffer in the window."
- (let* ((awin (get-buffer-window abuf))
- wconf)
+(defun org-agenda-prepare-window (abuf filter-alist)
+ "Setup agenda buffer in the window.
+ABUF is the buffer for the agenda window.
+FILTER-ALIST is an alist of filters we need to apply when
+`org-agenda-persistent-filter' is non-nil."
+ (let* ((awin (get-buffer-window abuf)) wconf)
(cond
((equal (current-buffer) abuf) nil)
(awin (select-window awin))
@@ -3390,65 +3602,76 @@ generating a new one."
((equal org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf)))
- ;; additional test in case agenda is invoked from within agenda
- ;; buffer via elisp link
+ (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist)))
+ (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist)))
+ (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist)))
+ ;; Additional test in case agenda is invoked from within agenda
+ ;; buffer via elisp link.
(unless (equal (current-buffer) abuf)
(org-pop-to-buffer-same-window abuf))
(setq org-agenda-pre-window-conf
(or org-agenda-pre-window-conf wconf))))
(defun org-agenda-prepare (&optional name)
- (if (org-agenda-use-sticky-p)
- (progn
- ;; Popup existing buffer
- (org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
- (message "Sticky Agenda buffer, use `r' to refresh")
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
- (setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
- (unless org-agenda-persistent-filter
- (setq org-agenda-tag-filter nil
- org-agenda-category-filter nil))
- (put 'org-agenda-tag-filter :preset-filter
- org-agenda-tag-filter-preset)
- (put 'org-agenda-category-filter :preset-filter
- org-agenda-category-filter-preset)
- (if org-agenda-multi
+ (let ((filter-alist (if org-agenda-persistent-filter
+ (list `(tag . ,org-agenda-tag-filter)
+ `(re . ,org-agenda-regexp-filter)
+ `(car . ,org-agenda-category-filter)))))
+ (if (org-agenda-use-sticky-p)
(progn
- (setq buffer-read-only nil)
- (goto-char (point-max))
- (unless (or (bobp) org-agenda-compact-blocks
- (not org-agenda-block-separator))
- (insert "\n"
- (if (stringp org-agenda-block-separator)
- org-agenda-block-separator
- (make-string (window-width) org-agenda-block-separator))
- "\n"))
- (narrow-to-region (point) (point-max)))
- (setq org-done-keywords-for-agenda nil)
-
- ;; Setting any org variables that are in org-agenda-local-vars
- ;; list need to be done after the prepare call
- (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
- (setq buffer-read-only nil)
- (org-agenda-reset-markers)
- (let ((inhibit-read-only t)) (erase-buffer))
- (org-agenda-mode)
- (setq org-agenda-buffer (current-buffer))
- (setq org-agenda-contributing-files nil)
- (setq org-agenda-columns-active nil)
- (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-done-keywords-for-agenda
- (org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
- (setq org-agenda-last-prefix-arg current-prefix-arg)
- (setq org-agenda-this-buffer-name org-agenda-buffer-name)
- (and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
- (setq buffer-read-only nil)))
+ (put 'org-agenda-tag-filter :preset-filter nil)
+ (put 'org-agenda-category-filter :preset-filter nil)
+ (put 'org-agenda-regexp-filter :preset-filter nil)
+ ;; Popup existing buffer
+ (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
+ filter-alist)
+ (message "Sticky Agenda buffer, use `r' to refresh")
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
+ (setq org-todo-keywords-for-agenda nil)
+ (setq org-drawers-for-agenda nil)
+ (put 'org-agenda-tag-filter :preset-filter
+ org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter
+ org-agenda-category-filter-preset)
+ (put 'org-agenda-regexp-filter :preset-filter
+ org-agenda-regexp-filter-preset)
+ (if org-agenda-multi
+ (progn
+ (setq buffer-read-only nil)
+ (goto-char (point-max))
+ (unless (or (bobp) org-agenda-compact-blocks
+ (not org-agenda-block-separator))
+ (insert "\n"
+ (if (stringp org-agenda-block-separator)
+ org-agenda-block-separator
+ (make-string (window-width) org-agenda-block-separator))
+ "\n"))
+ (narrow-to-region (point) (point-max)))
+ (setq org-done-keywords-for-agenda nil)
+
+ ;; Setting any org variables that are in org-agenda-local-vars
+ ;; list need to be done after the prepare call
+ (org-agenda-prepare-window
+ (get-buffer-create org-agenda-buffer-name) filter-alist)
+ (setq buffer-read-only nil)
+ (org-agenda-reset-markers)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (org-agenda-mode)
+ (setq org-agenda-buffer (current-buffer))
+ (setq org-agenda-contributing-files nil)
+ (setq org-agenda-columns-active nil)
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (setq org-todo-keywords-for-agenda
+ (org-uniquify org-todo-keywords-for-agenda))
+ (setq org-done-keywords-for-agenda
+ (org-uniquify org-done-keywords-for-agenda))
+ (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
+ (setq org-agenda-last-prefix-arg current-prefix-arg)
+ (setq org-agenda-this-buffer-name org-agenda-buffer-name)
+ (and name (not org-agenda-name)
+ (org-set-local 'org-agenda-name name)))
+ (setq buffer-read-only nil))))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
(defun org-agenda-finalize ()
@@ -3480,12 +3703,7 @@ generating a new one."
(org-agenda-fontify-priorities))
(when (and org-agenda-dim-blocked-tasks org-blocker-hook)
(org-agenda-dim-blocked-tasks))
- ;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
- (when org-clock-current-task
- (save-restriction
- (widen)
- (org-agenda-mark-clocking-task)))
+ (org-agenda-mark-clocking-task)
(when org-agenda-entry-text-mode
(org-agenda-entry-text-hide)
(org-agenda-entry-text-show))
@@ -3505,38 +3723,60 @@ generating a new one."
(save-excursion
(goto-char (point-min))
(while (equal (forward-line) 0)
- (when (setq mrk (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-hd-marker)))
+ (when (setq mrk (get-text-property (point) 'org-hd-marker))
(put-text-property (point-at-bol) (point-at-eol)
'tags (org-with-point-at mrk
(delete-dups
(mapcar 'downcase (org-get-tags-at))))))))))
(run-hooks 'org-agenda-finalize-hook)
- (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
+ (when org-agenda-top-headline-filter
+ (org-agenda-filter-top-headline-apply
+ org-agenda-top-headline-filter))
+ (when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
+ (when (get 'org-agenda-tag-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
+ (when (get 'org-agenda-category-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-category-filter :preset-filter) 'category))
+ (when org-agenda-regexp-filter
+ (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
+ (when (get 'org-agenda-regexp-filter :preset-filter)
+ (org-agenda-filter-apply
+ (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
(org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
(defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
+ ;; We need to widen when `org-agenda-finalize' is called from
+ ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
+ (when org-clock-current-task
+ (save-restriction
+ (widen)
+ (org-agenda-unmark-clocking-task)
+ (when (marker-buffer org-clock-hd-marker)
+ (save-excursion
+ (goto-char (point-min))
+ (let (s ov)
+ (while (setq s (next-single-property-change (point) 'org-hd-marker))
+ (goto-char s)
+ (when (equal (org-get-at-bol 'org-hd-marker)
+ org-clock-hd-marker)
+ (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
+ (overlay-put ov 'type 'org-agenda-clocking)
+ (overlay-put ov 'face 'org-agenda-clocking)
+ (overlay-put ov 'help-echo
+ "The clock is running in this item")))))))))
+
+(defun org-agenda-unmark-clocking-task ()
+ "Unmark the current clocking task."
(mapc (lambda (o)
(if (eq (overlay-get o 'type) 'org-agenda-clocking)
(delete-overlay o)))
- (overlays-in (point-min) (point-max)))
- (when (marker-buffer org-clock-hd-marker)
- (save-excursion
- (goto-char (point-min))
- (let (s ov)
- (while (setq s (next-single-property-change (point) 'org-hd-marker))
- (goto-char s)
- (when (equal (org-get-at-bol 'org-hd-marker)
- org-clock-hd-marker)
- (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
- (overlay-put ov 'type 'org-agenda-clocking)
- (overlay-put ov 'face 'org-agenda-clocking)
- (overlay-put ov 'help-echo
- "The clock is running in this item")))))))
+ (overlays-in (point-min) (point-max))))
(defun org-agenda-fontify-priorities ()
"Make highest priority lines bold, and lowest italic."
@@ -3545,8 +3785,7 @@ generating a new one."
(delete-overlay o)))
(overlays-in (point-min) (point-max)))
(save-excursion
- (let ((inhibit-read-only t)
- b e p ov h l)
+ (let (b e p ov h l)
(goto-char (point-min))
(while (re-search-forward "\\[#\\(.\\)\\]" nil t)
(setq h (or (get-char-property (point) 'org-highest-priority)
@@ -3561,21 +3800,27 @@ generating a new one."
ov (make-overlay b e))
(overlay-put
ov 'face
- (cond ((org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-priority-faces))))
- ((and (listp org-agenda-fontify-priorities)
- (org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-agenda-fontify-priorities)))))
- ((equal p l) 'italic)
- ((equal p h) 'bold)))
+ (cons (cond ((org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-priority-faces))))
+ ((and (listp org-agenda-fontify-priorities)
+ (org-face-from-face-or-color
+ 'priority nil
+ (cdr (assoc p org-agenda-fontify-priorities)))))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold))
+ 'org-priority))
(overlay-put ov 'org-type 'org-priority)))))
+(defvar org-depend-tag-blocked)
+
(defun org-agenda-dim-blocked-tasks (&optional invisible)
+ "Dim currently blocked TODOs in the agenda display.
+When INVISIBLE is non-nil, hide currently blocked TODO instead of
+dimming them."
(interactive "P")
- "Dim currently blocked TODO's in the agenda display."
- (message "Dim or hide blocked tasks...")
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks..."))
(mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
(delete-overlay o)))
(overlays-in (point-min) (point-max)))
@@ -3602,10 +3847,12 @@ generating a new one."
e (point-at-eol)
ov (make-overlay b e))
(if invis1
- (overlay-put ov 'invisible t)
+ (progn (overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t))
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
- (message "Dim or hide blocked tasks...done"))
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
@@ -3640,7 +3887,7 @@ continue from there."
(throw :skip t))))
(defun org-agenda-skip-eval (form)
- "If FORM is a function or a list, call (or eval) is and return result.
+ "If FORM is a function or a list, call (or eval) it and return the result.
`save-excursion' and `save-match-data' are wrapped around the call, so point
and match data are returned to the previous state no matter what these
functions do."
@@ -3695,7 +3942,8 @@ This check for agenda markers in all agenda buffers currently active."
(error "No marker points to an entry here"))
(setq txt (concat "\n" (org-no-properties
(org-agenda-get-some-entry-text
- m org-agenda-entry-text-maxlines " > "))))
+ m org-agenda-entry-text-maxlines
+ org-agenda-entry-text-leaders))))
(when (string-match "\\S-" txt)
(setq o (make-overlay (point-at-bol) (point-at-eol)))
(overlay-put o 'evaporate t)
@@ -3735,6 +3983,7 @@ This check for agenda markers in all agenda buffers currently active."
;;; Agenda timeline
(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
+(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defun org-timeline (&optional dotodo)
"Show a time-sorted view of the entries in the current org file.
@@ -3746,6 +3995,7 @@ dates."
(interactive "P")
(let* ((dopast t)
(org-agenda-show-log-scoped org-agenda-show-log)
+ (org-agenda-show-log org-agenda-show-log-scoped)
(entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
(current-buffer))))
(date (calendar-current-date))
@@ -3762,9 +4012,11 @@ dates."
args
s e rtn d emptyp)
(setq org-agenda-redo-command
- (list 'progn
- (list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote dotodo))))
+ (list 'let
+ (list (list 'org-agenda-show-log 'org-agenda-show-log))
+ (list 'org-switch-to-buffer-other-window (current-buffer))
+ (list 'org-timeline (list 'quote dotodo))))
+ (put 'org-agenda-redo-command 'org-lprops nil)
(if (not dopast)
;; Remove past dates from the list of dates.
(setq day-numbers (delq nil (mapcar (lambda(x)
@@ -3815,12 +4067,13 @@ dates."
(put-text-property s (1- (point)) 'org-agenda-date-header t)
(if (equal d today)
(put-text-property s (1- (point)) 'org-today t))
- (and rtn (insert (org-agenda-finalize-entries rtn) "\n"))
+ (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
(put-text-property s (1- (point)) 'day d)))))
- (goto-char (point-min))
(goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
(point-min)))
- (add-text-properties (point-min) (point-max) '(org-agenda-type timeline))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
(org-agenda-finalize)
(setq buffer-read-only t)))
@@ -3874,46 +4127,16 @@ When EMPTY is non-nil, also include days without any entries."
(defvar org-agenda-start-day nil ; dynamically scoped parameter
"Start day for the agenda view.
-Custom commands can set this variable in the options section.")
+Custom commands can set this variable in the options section.
+This is usually a string like \"2007-11-01\", \"+2d\" or any other
+input allowed when reading a date through the Org calendar.
+See the docstring of `org-read-date' for details.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-arg-loc nil) ; local variable
-(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
- "List of types searched for when creating the daily/weekly agenda.
-This variable is a list of symbols that controls the types of
-items that appear in the daily/weekly agenda. Allowed symbols in this
-list are are
-
- :timestamp List items containing a date stamp or date range matching
- the selected date. This includes sexp entries in
- angular brackets.
-
- :sexp List entries resulting from plain diary-like sexps.
-
- :deadline List deadline due on that date. When the date is today,
- also list any deadlines past due, or due within
- `org-deadline-warning-days'. `:deadline' must appear before
- `:scheduled' if the setting of
- `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
- any effect.
-
- :scheduled List all items which are scheduled for the given date.
- The diary for *today* also contains items which were
- scheduled earlier and are not yet marked DONE.
-
-By default, all four types are turned on.
-
-Never set this variable globally using `setq', because then it
-will apply to all future agenda commands. Instead, bind it with
-`let' to scope it dynamically into the agenda-constructing
-command. A good way to set it is through options in
-`org-agenda-custom-commands'. For a more flexible (though
-somewhat less efficient) way of determining what is included in
-the daily/weekly agenda, see `org-agenda-skip-function'.")
-
(defvar org-agenda-buffer-tmp-name nil)
;;;###autoload
-(defun org-agenda-list (&optional arg start-day span)
+(defun org-agenda-list (&optional arg start-day span with-hour)
"Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.
@@ -3923,7 +4146,10 @@ span ARG days. Lisp programs should instead specify SPAN to change
the number of days. SPAN defaults to `org-agenda-span'.
START-DAY defaults to TODAY, or to the most recent match for the weekday
-given in `org-agenda-start-on-weekday'."
+given in `org-agenda-start-on-weekday'.
+
+When WITH-HOUR is non-nil, only include scheduled and deadline
+items if they have an hour specification like [h]h:mm."
(interactive "P")
(if org-agenda-overriding-arguments
(setq arg (car org-agenda-overriding-arguments)
@@ -3954,7 +4180,7 @@ given in `org-agenda-start-on-weekday'."
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
- (if (eq ndays 7)
+ (if (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
@@ -3973,7 +4199,7 @@ given in `org-agenda-start-on-weekday'."
s e rtn rtnall file date d start-pos end-pos todayp
clocktable-start clocktable-end filter)
(setq org-agenda-redo-command
- (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span)))
+ (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
(dotimes (n (1- ndays))
(push (1+ (car day-numbers)) day-numbers))
(setq day-numbers (nreverse day-numbers))
@@ -4016,9 +4242,26 @@ given in `org-agenda-start-on-weekday'."
(catch 'nextfile
(org-check-agenda-file file)
(let ((org-agenda-entry-types org-agenda-entry-types))
- (unless org-agenda-include-deadlines
+ ;; Starred types override non-starred equivalents
+ (when (member :deadline* org-agenda-entry-types)
(setq org-agenda-entry-types
(delq :deadline org-agenda-entry-types)))
+ (when (member :scheduled* org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :scheduled org-agenda-entry-types)))
+ ;; Honor with-hour
+ (when with-hour
+ (when (member :deadline org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :deadline org-agenda-entry-types))
+ (push :deadline* org-agenda-entry-types))
+ (when (member :scheduled org-agenda-entry-types)
+ (setq org-agenda-entry-types
+ (delq :scheduled org-agenda-entry-types))
+ (push :scheduled* org-agenda-entry-types)))
+ (unless org-agenda-include-deadlines
+ (setq org-agenda-entry-types
+ (delq :deadline* (delq :deadline org-agenda-entry-types))))
(cond
((memq org-agenda-show-log-scoped '(only clockcheck))
(setq rtn (org-agenda-get-day-entries
@@ -4056,7 +4299,7 @@ given in `org-agenda-start-on-weekday'."
(setq rtnall
(org-agenda-add-time-grid-maybe rtnall ndays todayp))
(if rtnall (insert ;; all entries
- (org-agenda-finalize-entries rtnall)
+ (org-agenda-finalize-entries rtnall 'agenda)
"\n"))
(put-text-property s (1- (point)) 'day d)
(put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
@@ -4069,14 +4312,6 @@ given in `org-agenda-start-on-weekday'."
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
- (when (and (eq org-agenda-clockreport-mode 'with-filter)
- (setq filter (or org-agenda-tag-filter-while-redo
- (get 'org-agenda-tag-filter :preset-filter))))
- (setq p (plist-put p :tags (mapconcat (lambda (x)
- (if (string-match "[<>=]" x)
- ""
- x))
- filter ""))))
(setq tbl (apply 'org-clock-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
@@ -4106,13 +4341,16 @@ given in `org-agenda-start-on-weekday'."
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
+ ((= n 14) 'fortnight)
(t n)))
(defun org-agenda-span-to-ndays (span &optional start-day)
- "Return ndays from SPAN, possibly starting at START-DAY."
+ "Return ndays from SPAN, possibly starting at START-DAY.
+START-DAY is an absolute time value."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
+ ((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
@@ -4206,7 +4444,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos inherited-tags
- marker category category-pos tags c neg re boolean
+ marker category category-pos level tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@@ -4323,7 +4561,7 @@ in `org-agenda-text-search-extra-files'."
(let ((case-fold-search t))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -4334,10 +4572,23 @@ in `org-agenda-text-search-extra-files'."
(goto-char (max (point-min) (1- (point))))
(while (re-search-forward regexp nil t)
(org-back-to-heading t)
+ (while (and (not (zerop org-agenda-search-view-max-outline-level))
+ (> (org-reduced-level (org-outline-level))
+ org-agenda-search-view-max-outline-level)
+ (forward-line -1)
+ (outline-back-to-heading t)))
(skip-chars-forward "* ")
(setq beg (point-at-bol)
beg1 (point)
- end (progn (outline-next-heading) (point)))
+ end (progn
+ (outline-next-heading)
+ (while (and (not (zerop org-agenda-search-view-max-outline-level))
+ (> (org-reduced-level (org-outline-level))
+ org-agenda-search-view-max-outline-level)
+ (forward-line 1)
+ (outline-next-heading)))
+ (point)))
+
(catch :skip
(goto-char beg)
(org-agenda-skip)
@@ -4352,12 +4603,14 @@ in `org-agenda-text-search-extra-files'."
(goto-char (1- end))
(throw :skip t)))
(if todo-only
- (cons (concat "^\*+[ \t]+" org-not-done-regexp)
+ (cons (concat "^\\*+[ \t]+"
+ org-not-done-regexp)
regexps+)
regexps+))
(goto-char beg)
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
+ level (make-string (org-reduced-level (org-outline-level)) ? )
category-pos (get-text-property (point) 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
@@ -4371,10 +4624,11 @@ in `org-agenda-text-search-extra-files'."
""
(buffer-substring-no-properties
beg1 (point-at-eol))
- category tags t))
+ level category tags t))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'org-todo-regexp org-todo-regexp
+ 'level level
'org-complex-heading-regexp org-complex-heading-regexp
'priority 1000 'org-category category
'org-category-position category-pos
@@ -4394,12 +4648,13 @@ in `org-agenda-text-search-extra-files'."
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
(setq pos (point))
(unless org-agenda-multi
- (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
+ (insert (substitute-command-keys
+ "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n"))
(add-text-properties pos (1- (point))
(list 'face 'org-agenda-structure))))
(org-agenda-mark-header-line (point-min))
(when rtnall
- (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4412,6 +4667,18 @@ in `org-agenda-text-search-extra-files'."
;;; Agenda TODO list
+(defun org-agenda-propertize-selected-todo-keywords (keywords)
+ "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
+ (concat
+ (if (or (equal keywords "ALL") (not keywords))
+ (propertize "ALL" 'face 'warning)
+ (mapconcat
+ (lambda (kw)
+ (propertize kw 'face (org-get-todo-face kw)))
+ (org-split-string keywords "|")
+ "|"))
+ "\n"))
+
(defvar org-select-this-todo-keyword nil)
(defvar org-last-arg nil)
@@ -4472,12 +4739,11 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(concat "ToDo: "
(or org-select-this-todo-keyword "ALL"))))
(org-agenda-mark-header-line (point-min))
- (setq pos (point))
- (insert (or org-select-this-todo-keyword "ALL") "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
+ (insert (org-agenda-propertize-selected-todo-keywords
+ org-select-this-todo-keyword))
(setq pos (point))
(unless org-agenda-multi
- (insert "Available with `N r': (0)[ALL]")
+ (insert (substitute-command-keys "Available with `N r': (0)[ALL]"))
(let ((n 0) s)
(mapc (lambda (x)
(setq s (format "(%d)%s" (setq n (1+ n)) x))
@@ -4489,7 +4755,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
(org-agenda-mark-header-line (point-min))
(when rtnall
- (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4517,8 +4783,6 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
buffer)
(when (and (stringp match) (not (string-match "\\S-" match)))
(setq match nil))
- (setq matcher (org-make-tags-matcher match)
- match (car matcher) matcher (cdr matcher))
(catch 'exit
(if org-agenda-sticky
(setq org-agenda-buffer-name
@@ -4526,7 +4790,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(format "*Org Agenda(%s:%s)*"
(or org-keys (or (and todo-only "M") "m")) match)
(format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
+ ;; Prepare agendas (and `org-tag-alist-for-agenda') before
+ ;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
+ (setq matcher (org-make-tags-matcher match)
+ match (car matcher) matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
@@ -4551,7 +4819,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(error "Agenda file %s is not in `org-mode'" file))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -4570,11 +4838,12 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
(setq pos (point))
(unless org-agenda-multi
- (insert "Press `C-u r' to search again with new search string\n"))
+ (insert (substitute-command-keys
+ "Press `C-u r' to search again with new search string\n")))
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
(org-agenda-mark-header-line (point-min))
(when rtnall
- (insert (org-agenda-finalize-entries rtnall) "\n"))
+ (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(add-text-properties (point-min) (point-max)
@@ -4640,7 +4909,7 @@ See `org-agenda-skip-if' for details."
(org-agenda-skip-if nil conditions))
(defun org-agenda-skip-subtree-if (&rest conditions)
- "Skip entry if any of CONDITIONS is true.
+ "Skip subtree if any of CONDITIONS is true.
See `org-agenda-skip-if' for details."
(org-agenda-skip-if t conditions))
@@ -4669,13 +4938,13 @@ the `regexp' or `notregexp' element.
`todo' and `nottodo' accept as an argument a list of todo
keywords, which may include \"*\" to match any todo keyword.
- (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\"))
+ (org-agenda-skip-entry-if \\='todo \\='(\"TODO\" \"WAITING\"))
would skip all entries with \"TODO\" or \"WAITING\" keywords.
Instead of a list, a keyword class may be given. For example:
- (org-agenda-skip-entry-if 'nottodo 'done)
+ (org-agenda-skip-entry-if \\='nottodo \\='done)
would skip entries that haven't been marked with any of \"DONE\"
keywords. Possible classes are: `todo', `done', `any'.
@@ -4809,6 +5078,7 @@ of what a project is and how to check if it stuck, customize the variable
(mapconcat 'identity re-list "\\|")
(error "No information how to identify unstuck projects")))
(org-tags-view nil matcher)
+ (setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
`(org-agenda-list-stuck-projects ,current-prefix-arg)))))
@@ -4822,8 +5092,7 @@ of what a project is and how to check if it stuck, customize the variable
"Get the (Emacs Calendar) diary entries for DATE."
(require 'diary-lib)
(let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
- (diary-display-hook '(fancy-diary-display))
- (diary-display-function 'fancy-diary-display)
+ (diary-display-function 'diary-fancy-display)
(pop-up-frames nil)
(diary-list-entries-hook
(cons 'org-diary-default-entry diary-list-entries-hook))
@@ -4863,7 +5132,7 @@ of what a project is and how to check if it stuck, customize the variable
(setq entries
(mapcar
(lambda (x)
- (setq x (org-agenda-format-item "" x "Diary" nil 'time))
+ (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
;; Extend the text properties to the beginning of the line
(org-add-props x (text-properties-at (1- (length x)) x)
'type "diary" 'date date 'face 'org-agenda-diary))
@@ -4953,8 +5222,8 @@ all files listed in `org-agenda-files' will be checked automatically:
&%%(org-diary)
-If you don't give any arguments (as in the example above), the default
-arguments (:deadline :scheduled :timestamp :sexp) are used.
+If you don't give any arguments (as in the example above), the default value
+of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
So the example above may also be written as
&%%(org-diary :deadline :timestamp :sexp :scheduled)
@@ -4970,7 +5239,7 @@ function from a program - use `org-agenda-get-day-entries' instead."
(org-agenda-reset-markers))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
- (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
+ (setq args (or args org-agenda-entry-types))
(let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
(list entry)
(org-agenda-files t)))
@@ -4988,8 +5257,11 @@ function from a program - use `org-agenda-get-day-entries' instead."
(while (setq file (pop files))
(setq rtn (apply 'org-agenda-get-day-entries file date args))
(setq results (append results rtn)))
- (if results
- (concat (org-agenda-finalize-entries results) "\n"))))
+ (when results
+ (setq results
+ (mapcar (lambda (i) (replace-regexp-in-string
+ org-bracket-link-regexp "\\3" i)) results))
+ (concat (org-agenda-finalize-entries results) "\n"))))
;;; Agenda entry finders
@@ -4999,7 +5271,7 @@ FILE is the path to a file to be checked for entries. DATE is date like
the one returned by `calendar-current-date'. ARGS are symbols indicating
which kind of entries should be extracted. For details about these, see
the documentation of `org-diary'."
- (setq args (or args '(:deadline :scheduled :timestamp :sexp)))
+ (setq args (or args org-agenda-entry-types))
(let* ((org-startup-folded nil)
(org-startup-align-all-tables nil)
(buffer (if (file-exists-p file)
@@ -5016,7 +5288,7 @@ the documentation of `org-diary'."
(let ((case-fold-search nil))
(save-excursion
(save-restriction
- (if org-agenda-restrict
+ (if (eq buffer org-agenda-restrict)
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
@@ -5039,16 +5311,29 @@ the documentation of `org-diary'."
((eq arg :scheduled)
(setq rtn (org-agenda-get-scheduled deadline-results))
(setq results (append results rtn)))
+ ((eq arg :scheduled*)
+ (setq rtn (org-agenda-get-scheduled deadline-results t))
+ (setq results (append results rtn)))
((eq arg :closed)
(setq rtn (org-agenda-get-progress))
(setq results (append results rtn)))
((eq arg :deadline)
(setq rtn (org-agenda-get-deadlines))
(setq deadline-results (copy-sequence rtn))
+ (setq results (append results rtn)))
+ ((eq arg :deadline*)
+ (setq rtn (org-agenda-get-deadlines t))
+ (setq deadline-results (copy-sequence rtn))
(setq results (append results rtn))))))))
results))))
+(defsubst org-em (x y list)
+ "Is X or Y a member of LIST?"
+ (or (memq x list) (memq y list)))
+
(defvar org-heading-keyword-regexp-format) ; defined in org.el
+(defvar org-agenda-sorting-strategy-selected nil)
+
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
@@ -5073,8 +5358,8 @@ the documentation of `org-diary'."
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
- marker priority category category-pos tags todo-state
- ee txt beg end inherited-tags)
+ marker priority category category-pos level tags todo-state ts-date ts-date-type
+ ee txt beg end inherited-tags todo-state-end-pos)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5082,6 +5367,10 @@ the documentation of `org-diary'."
(beginning-of-line)
(org-agenda-skip)
(setq beg (point) end (save-excursion (outline-next-heading) (point)))
+ (unless (and (setq todo-state (org-get-todo-state))
+ (setq todo-state-end-pos (match-end 2)))
+ (goto-char end)
+ (throw :skip nil))
(when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
(goto-char (1+ beg))
(or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
@@ -5089,6 +5378,33 @@ the documentation of `org-diary'."
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
+ ts-date (let (ts)
+ (save-match-data
+ (cond ((org-em 'scheduled-up 'scheduled-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "SCHEDULED")
+ ts-date-type " scheduled"))
+ ((org-em 'deadline-up 'deadline-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "DEADLINE")
+ ts-date-type " deadline"))
+ ((org-em 'ts-up 'ts-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "TIMESTAMP")
+ ts-date-type " timestamp"))
+ ((org-em 'tsia-up 'tsia-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get (point) "TIMESTAMP_IA")
+ ts-date-type " timestamp_ia"))
+ ((org-em 'timestamp-up 'timestamp-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (or (org-entry-get (point) "SCHEDULED")
+ (org-entry-get (point) "DEADLINE")
+ (org-entry-get (point) "TIMESTAMP")
+ (org-entry-get (point) "TIMESTAMP_IA"))
+ ts-date-type ""))
+ (t (setq ts-date-type "")))
+ (when ts (ignore-errors (org-time-string-to-absolute ts)))))
category-pos (get-text-property (point) 'org-category-position)
txt (org-trim
(buffer-substring (match-beginning 2) (match-end 0)))
@@ -5100,17 +5416,19 @@ the documentation of `org-diary'."
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
tags (org-get-tags-at nil (not inherited-tags))
- txt (org-agenda-format-item "" txt category tags t)
- priority (1+ (org-get-priority txt))
- todo-state (org-get-todo-state))
+ level (make-string (org-reduced-level (org-outline-level)) ? )
+ txt (org-agenda-format-item "" txt level category tags t)
+ priority (1+ (org-get-priority txt)))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
'priority priority 'org-category category
+ 'level level
+ 'ts-date ts-date
'org-category-position category-pos
- 'type "todo" 'todo-state todo-state)
+ 'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
- (goto-char (match-end 2))
+ (goto-char todo-state-end-pos)
(org-end-of-subtree 'invisible))))
(nreverse ee)))
@@ -5119,13 +5437,15 @@ the documentation of `org-diary'."
This function is invoked if `org-agenda-todo-ignore-deadlines',
`org-agenda-todo-ignore-scheduled' or
`org-agenda-todo-ignore-timestamp' is set to an integer."
- (let ((days (org-days-to-time time)))
+ (let ((days (org-time-stamp-to-now
+ time org-agenda-todo-ignore-time-comparison-use-seconds)))
(if (>= n 0)
(>= days n)
(<= days n))))
+;;;###autoload
(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- (&optional end)
+ (&optional end)
"Do we have a reason to ignore this TODO entry because it has a time stamp?"
(when (or org-agenda-todo-ignore-with-date
org-agenda-todo-ignore-scheduled
@@ -5139,9 +5459,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(re-search-forward org-scheduled-time-regexp end t)
(cond
((eq org-agenda-todo-ignore-scheduled 'future)
- (> (org-days-to-time (match-string 1)) 0))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-scheduled 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-scheduled)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-scheduled))
@@ -5153,9 +5475,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
((eq org-agenda-todo-ignore-deadlines 'far)
(not (org-deadline-close (match-string 1))))
((eq org-agenda-todo-ignore-deadlines 'future)
- (> (org-days-to-time (match-string 1)) 0))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-deadlines 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
@@ -5178,9 +5502,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(when (re-search-forward org-ts-regexp nil t)
(cond
((eq org-agenda-todo-ignore-timestamp 'future)
- (> (org-days-to-time (match-string 1)) 0))
+ (> (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((eq org-agenda-todo-ignore-timestamp 'past)
- (<= (org-days-to-time (match-string 1)) 0))
+ (<= (org-time-stamp-to-now
+ (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
((numberp org-agenda-todo-ignore-timestamp)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-timestamp))
@@ -5217,9 +5543,9 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category category-pos ee txt timestr tags
+ donep tmp priority category category-pos level ee txt timestr tags
b0 b3 e3 head todo-state end-of-match show-all warntime habitp
- inherited-tags)
+ inherited-tags ts-date)
(goto-char (point-min))
(while (setq end-of-match (re-search-forward regexp nil t))
(setq b0 (match-beginning 0)
@@ -5278,18 +5604,21 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
+ tags (org-get-tags-at nil (not inherited-tags))
+ level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq head (or (match-string 1) ""))
(setq txt (org-agenda-format-item
(if inactivep org-agenda-inactive-leader nil)
- head category tags timestr
+ head level category tags timestr
remove-re habitp)))
(setq priority (org-get-priority txt))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker)
- (org-add-props txt nil 'priority priority
+ (org-add-props txt props 'priority priority
+ 'org-marker marker 'org-hd-marker hdmarker
'org-category category 'date date
+ 'level level
+ 'ts-date
+ (ignore-errors (org-time-string-to-absolute timestr))
'org-category-position category-pos
'todo-state todo-state
'warntime warntime
@@ -5309,7 +5638,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category extra category-pos ee txt tags entry
+ marker category extra category-pos level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5326,6 +5655,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq result (org-diary-sexp-entry sexp sexp-entry date))
(when result
(setq marker (org-agenda-new-marker beg)
+ level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
category-pos (get-text-property beg 'org-category-position)
inherited-tags
@@ -5350,14 +5680,12 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(if (string-match "\\S-" r)
(setq txt r)
(setq txt "SEXP entry returned empty string"))
-
- (setq txt (org-agenda-format-item
- extra txt category tags 'time))
- (org-add-props txt props 'org-marker marker)
- (org-add-props txt nil
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos 'tags tags
- 'type "sexp" 'warntime warntime)
+ (setq txt (org-agenda-format-item extra txt level category tags 'time))
+ (org-add-props txt props 'org-marker marker
+ 'org-category category 'date date 'todo-state todo-state
+ 'org-category-position category-pos
+ 'level level
+ 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
@@ -5387,17 +5715,19 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-date day month year mark))))
-;; Define the` org-class' function
+;; Define the `org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
SKIP-WEEKS is any number of ISO weeks in the block period for which the
item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
`holidays', then any date that is known by the Emacs calendar to be a
-holiday will also be skipped."
+holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
+then those holidays will be skipped."
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
- (d (calendar-absolute-from-gregorian date)))
+ (d (calendar-absolute-from-gregorian date))
+ (h (when skip-weeks (calendar-check-holidays date))))
(and
(<= date1 d)
(<= d date2)
@@ -5406,8 +5736,8 @@ holiday will also be skipped."
(progn
(require 'cal-iso)
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
- (not (and (memq 'holidays skip-weeks)
- (calendar-check-holidays date)))
+ (not (or (and h (memq 'holidays skip-weeks))
+ (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
@@ -5430,7 +5760,6 @@ please use `org-class' instead."
dayname skip-weeks)))
(make-obsolete 'org-diary-class 'org-class "")
-(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
@@ -5465,7 +5794,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
- marker hdmarker priority category category-pos tags closedp
+ marker hdmarker priority category category-pos level tags closedp
statep clockp state ee txt extra timestr rest clocked inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5511,7 +5840,8 @@ please use `org-class' instead."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
+ tags (org-get-tags-at nil (not inherited-tags))
+ level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq txt (match-string 1))
(when extra
@@ -5524,12 +5854,13 @@ please use `org-class' instead."
(closedp "Closed: ")
(statep (concat "State: (" state ")"))
(t (concat "Clocked: (" clocked ")")))
- txt category tags timestr)))
+ txt level category tags timestr)))
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
'priority priority 'org-category category
'org-category-position category-pos
+ 'level level
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -5540,7 +5871,8 @@ please use `org-class' instead."
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
(interactive)
- (let* ((pl org-agenda-clock-consistency-checks)
+ (let* ((org-time-clocksum-use-effort-durations nil)
+ (pl org-agenda-clock-consistency-checks)
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
@@ -5589,13 +5921,13 @@ See also the user option `org-agenda-clock-consistency-checks'."
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
- (org-minutes-to-hh:mm-string
+ (org-minutes-to-clocksum-string
(floor (/ (float dt) 60.))))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
- (org-minutes-to-hh:mm-string
+ (org-minutes-to-clocksum-string
(floor (/ (float dt) 60.))))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
@@ -5655,8 +5987,10 @@ See also the user option `org-agenda-clock-consistency-checks'."
;; Nope, this gap is not OK
nil)))
-(defun org-agenda-get-deadlines ()
- "Return the deadline information for agenda display."
+(defun org-agenda-get-deadlines (&optional with-hour)
+ "Return the deadline information for agenda display.
+When WITH-HOUR is non-nil, only return deadlines with an hour
+specification like [h]h:mm."
(let* ((props (list 'mouse-face 'highlight
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
@@ -5664,26 +5998,21 @@ See also the user option `org-agenda-clock-consistency-checks'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp org-deadline-time-regexp)
+ (regexp (if with-hour
+ org-deadline-time-hour-regexp
+ org-deadline-time-regexp))
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- d2 diff dfrac wdays pos pos1 category category-pos
+ (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
+ (dl0 (car org-agenda-deadline-leaders))
+ (dl1 (nth 1 org-agenda-deadline-leaders))
+ (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
+ d2 diff dfrac wdays pos pos1 category category-pos level
tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr warntime inherited-tags)
+ show-all upcomingp donep timestr warntime inherited-tags ts-date)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (setq suppress-prewarning nil)
(catch :skip
(org-agenda-skip)
- (when (and org-agenda-skip-deadline-prewarning-if-scheduled
- (save-match-data
- (string-match org-scheduled-time-regexp
- (buffer-substring (point-at-bol)
- (point-at-eol)))))
- (setq suppress-prewarning
- (if (integerp org-agenda-skip-deadline-prewarning-if-scheduled)
- org-agenda-skip-deadline-prewarning-if-scheduled
- 0)))
(setq s (match-string 1)
txt nil
pos (1- (match-beginning 1))
@@ -5692,10 +6021,32 @@ See also the user option `org-agenda-clock-consistency-checks'."
(member todo-state
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
- (match-string 1) d1 'past show-all
- (current-buffer) pos)
- diff (- d2 d1)
- wdays (if suppress-prewarning
+ s d1 'past show-all (current-buffer) pos)
+ diff (- d2 d1))
+ (setq suppress-prewarning
+ (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (let ((item (buffer-substring (point-at-bol)
+ (point-at-eol))))
+ (save-match-data
+ (and (string-match
+ org-scheduled-time-regexp item)
+ (match-string 1 item)))))))
+ (cond
+ ((not ds) nil)
+ ;; The current item has a scheduled date (in ds), so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set prewarning to no earlier than scheduled.
+ (min (- d2 (org-time-string-to-absolute
+ ds d1 'past show-all (current-buffer) pos))
+ org-deadline-warning-days))
+ ;; Set prewarning to deadline.
+ (t 0))))
+ (setq wdays (if suppress-prewarning
(let ((org-deadline-warning-days suppress-prewarning))
(org-get-wdays s))
(org-get-wdays s))
@@ -5721,6 +6072,7 @@ See also the user option `org-agenda-clock-consistency-checks'."
(throw :skip nil)
(goto-char (match-end 0))
(setq pos1 (match-beginning 0))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(setq inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5738,22 +6090,25 @@ See also the user option `org-agenda-clock-consistency-checks'."
(concat (substring s (match-beginning 1)) " "))
(setq timestr 'time))
(setq txt (org-agenda-format-item
- (if (= diff 0)
- (car org-agenda-deadline-leaders)
- (if (functionp
- (nth 1 org-agenda-deadline-leaders))
- (funcall
- (nth 1 org-agenda-deadline-leaders)
- diff date)
- (format (nth 1 org-agenda-deadline-leaders)
- diff)))
- head category tags
+ (cond ((= diff 0) dl0)
+ ((> diff 0)
+ (if (functionp dl1)
+ (funcall dl1 diff date)
+ (format dl1 diff)))
+ (t
+ (if (functionp dl2)
+ (funcall dl2 diff date)
+ (format dl2 (if (string= dl2 dl1)
+ diff (abs diff))))))
+ head level category tags
(if (not (= diff 0)) nil timestr)))))
(when txt
(setq face (org-agenda-deadline-face dfrac))
(org-add-props txt props
'org-marker (org-agenda-new-marker pos)
'warntime warntime
+ 'level level
+ 'ts-date d2
'org-hd-marker (org-agenda-new-marker pos1)
'priority (+ (- diff)
(org-get-priority txt))
@@ -5775,8 +6130,10 @@ FRACTION is what fraction of the head-warning time has passed."
(while (setq f (pop faces))
(if (>= fraction (car f)) (throw 'exit (cdr f)))))))
-(defun org-agenda-get-scheduled (&optional deadline-results)
- "Return the scheduled information for agenda display."
+(defun org-agenda-get-scheduled (&optional deadline-results with-hour)
+ "Return the scheduled information for agenda display.
+When WITH-HOUR is non-nil, only return scheduled items with
+an hour specification like [h]h:mm."
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
@@ -5785,7 +6142,9 @@ FRACTION is what fraction of the head-warning time has passed."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
- (regexp org-scheduled-time-regexp)
+ (regexp (if with-hour
+ org-scheduled-time-hour-regexp
+ org-scheduled-time-regexp))
(todayp (org-agenda-todayp date)) ; DATE bound by calendar
(d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
mm
@@ -5794,9 +6153,10 @@ FRACTION is what fraction of the head-warning time has passed."
0 'org-hd-marker a))
(cons (marker-position mm) a)))
deadline-results))
- d2 diff pos pos1 category category-pos tags donep
+ d2 diff pos pos1 category category-pos level tags donep
ee txt head pastschedp todo-state face timestr s habitp show-all
- did-habit-check-p warntime inherited-tags)
+ did-habit-check-p warntime inherited-tags ts-date suppress-delay
+ ddays)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5809,18 +6169,50 @@ FRACTION is what fraction of the head-warning time has passed."
(member todo-state
org-agenda-repeating-timestamp-show-all))
d2 (org-time-string-to-absolute
- (match-string 1) d1 'past show-all
- (current-buffer) pos)
+ s d1 'past show-all (current-buffer) pos)
diff (- d2 d1)
warntime (get-text-property (point) 'org-appt-warntime))
(setq pastschedp (and todayp (< diff 0)))
(setq did-habit-check-p nil)
+ (setq suppress-delay
+ (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
+ (let ((item (buffer-substring (point-at-bol) (point-at-eol))))
+ (save-match-data
+ (and (string-match
+ org-deadline-time-regexp item)
+ (match-string 1 item)))))))
+ (cond
+ ((not ds) nil)
+ ;; The current item has a deadline date (in ds), so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than deadline.
+ (min (- d2 (org-time-string-to-absolute
+ ds d1 'past show-all (current-buffer) pos))
+ org-scheduled-delay-days))
+ (t 0))))
+ (setq ddays (if suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t))
+ (org-get-wdays s t)))
+ ;; Use a delay of 0 when there is a repeater and the delay is
+ ;; of the form --3d
+ (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
+ (< (org-time-string-to-absolute s)
+ (org-time-string-to-absolute
+ s d2 'past nil (current-buffer) pos)))
+ (setq ddays 0))
;; When to show a scheduled item in the calendar:
;; If it is on or past the date.
- (when (or (and (< diff 0)
+ (when (or (and (> ddays 0) (= diff (- ddays)))
+ (and (zerop ddays) (= diff 0))
+ (and (< (+ diff ddays) 0)
(< (abs diff) org-scheduled-past-days)
(and todayp (not org-agenda-only-exact-dates)))
- (= diff 0)
;; org-is-habit-p uses org-entry-get, which is expansive
;; so we go extra mile to only call it once
(and todayp
@@ -5842,6 +6234,11 @@ FRACTION is what fraction of the head-warning time has passed."
(org-is-habit-p))))
(setq category (org-get-category)
category-pos (get-text-property (point) 'org-category-position))
+ (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
+ 'repeated-after-deadline)
+ (org-get-deadline-time (point))
+ (<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
+ (throw :skip nil))
(if (not (re-search-backward "^\\*+[ \t]+" nil t))
(throw :skip nil)
(goto-char (match-end 0))
@@ -5854,7 +6251,7 @@ FRACTION is what fraction of the head-warning time has passed."
(throw :skip nil))
(if (and
(or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
- (and org-agenda-skip-scheduled-if-deadline-is-shown
+ (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
pastschedp))
(setq mm (assoc pos1 deadline-position-alist)))
(throw :skip nil)))
@@ -5865,7 +6262,9 @@ FRACTION is what fraction of the head-warning time has passed."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
+
tags (org-get-tags-at nil (not inherited-tags)))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(setq head (buffer-substring
(point)
(progn (skip-chars-forward "^\r\n") (point))))
@@ -5878,7 +6277,7 @@ FRACTION is what fraction of the head-warning time has passed."
(car org-agenda-scheduled-leaders)
(format (nth 1 org-agenda-scheduled-leaders)
(- 1 diff)))
- head category tags
+ head level category tags
(if (not (= diff 0)) nil timestr)
nil habitp))))
(when txt
@@ -5896,7 +6295,9 @@ FRACTION is what fraction of the head-warning time has passed."
'org-hd-marker (org-agenda-new-marker pos1)
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp d2 date)
+ 'ts-date d2
'warntime warntime
+ 'level level
'priority (if habitp
(org-habit-get-priority habitp)
(+ 94 (- 5 diff) (org-get-priority txt)))
@@ -5920,7 +6321,7 @@ FRACTION is what fraction of the head-warning time has passed."
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
marker hdmarker ee txt d1 d2 s1 s2 category category-pos
- todo-state tags pos head donep inherited-tags)
+ level todo-state tags pos head donep inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
@@ -5954,7 +6355,9 @@ FRACTION is what fraction of the head-warning time has passed."
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda org-agenda-use-tag-inheritance))))
+
tags (org-get-tags-at nil (not inherited-tags)))
+ (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
(looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
(setq head (match-string 1))
(let ((remove-re
@@ -5969,7 +6372,7 @@ FRACTION is what fraction of the head-warning time has passed."
(nth (if (= d1 d2) 0 1)
org-agenda-timerange-leaders)
(1+ (- d0 d1)) (1+ (- d2 d1)))
- head category tags
+ head level category tags
(cond ((and (= d1 d0) (= d2 d0))
(concat "<" start-time ">--<" end-time ">"))
((= d1 d0)
@@ -5980,6 +6383,7 @@ FRACTION is what fraction of the head-warning time has passed."
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker
'type "block" 'date date
+ 'level level
'todo-state todo-state
'priority (org-get-priority txt) 'org-category category
'org-category-position category-pos)
@@ -5999,6 +6403,9 @@ The flag is set if the currently compiled format contains a `%T'.")
(defvar org-prefix-has-effort nil
"A flag, set by `org-compile-prefix-format'.
The flag is set if the currently compiled format contains a `%e'.")
+(defvar org-prefix-has-breadcrumbs nil
+ "A flag, set by `org-compile-prefix-format'.
+The flag is set if the currently compiled format contains a `%b'.")
(defvar org-prefix-category-length nil
"Used by `org-compile-prefix-format' to remember the category field width.")
(defvar org-prefix-category-max-length nil
@@ -6012,20 +6419,23 @@ The flag is set if the currently compiled format contains a `%e'.")
(return (cadr entry))
(return (apply 'create-image (cdr entry)))))))
-(defun org-agenda-format-item (extra txt &optional category tags dotime
+(defun org-agenda-format-item (extra txt &optional level category tags dotime
remove-re habitp)
"Format TXT to be inserted into the agenda buffer.
-In particular, it adds the prefix and corresponding text properties. EXTRA
-must be a string and replaces the `%s' specifier in the prefix format.
-CATEGORY (string, symbol or nil) may be used to overrule the default
+In particular, add the prefix and corresponding text properties.
+
+EXTRA must be a string to replace the `%s' specifier in the prefix format.
+LEVEL may be a string to replace the `%l' specifier.
+CATEGORY (a string, a symbol or nil) may be used to overrule the default
category taken from local variable or file name. It will replace the `%c'
-specifier in the format. DOTIME, when non-nil, indicates that a
-time-of-day should be extracted from TXT for sorting of this entry, and for
-the `%t' specifier in the format. When DOTIME is a string, this string is
-searched for a time before TXT is. TAGS can be the tags of the headline.
+specifier in the format.
+DOTIME, when non-nil, indicates that a time-of-day should be extracted from
+TXT for sorting of this entry, and for the `%t' specifier in the format.
+When DOTIME is a string, this string is searched for a time before TXT is.
+TAGS can be the tags of the headline.
Any match of REMOVE-RE will be removed from TXT."
;; We keep the org-prefix-* variable values along with a compiled
- ;; formatter, so that multiple agendas existing at the same time, do
+ ;; formatter, so that multiple agendas existing at the same time do
;; not step on each other toes.
;;
;; It was inconvenient to make these variables buffer local in
@@ -6038,13 +6448,14 @@ Any match of REMOVE-RE will be removed from TXT."
do (set var value))
(save-match-data
;; Diary entries sometimes have extra whitespace at the beginning
- (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
+ (setq txt (org-trim txt))
;; Fix the tags part in txt
(setq txt (org-agenda-fix-displayed-tags
txt tags
org-agenda-show-inherited-tags
org-agenda-hide-tags-regexp))
+
(let* ((category (or category
(if (stringp org-category)
org-category
@@ -6065,7 +6476,7 @@ Any match of REMOVE-RE will be removed from TXT."
(and org-agenda-search-headline-for-time txt))))
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
- duration thecategory)
+ duration thecategory breadcrumbs)
(and (derived-mode-p 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
@@ -6093,10 +6504,12 @@ Any match of REMOVE-RE will be removed from TXT."
(if s2 (setq s2 (org-get-time-of-day s2 'string t)))
;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-minutes-to-hh:mm-string
- (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration))))
+ (let (org-time-clocksum-use-effort-durations)
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-minutes-to-clocksum-string
+ (+ (org-hh:mm-string-to-minutes s1)
+ org-agenda-default-appointment-duration)))))
;; Compute the duration
(when s2
@@ -6115,12 +6528,15 @@ Any match of REMOVE-RE will be removed from TXT."
(match-string 2 txt))
t t txt))))
(when (derived-mode-p 'org-mode)
- (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))
- (when effort
+ (setq effort (ignore-errors (get-text-property 0 'org-effort txt))))
+
+ ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as
+ ;; current buffer, so move this check outside of above
+ (if effort
(setq neffort (org-duration-string-to-minutes effort)
- effort (setq effort (concat "[" effort "]")))))
- ;; prevent erroring out with %e format when there is no effort
- (or effort (setq effort ""))
+ effort (setq effort (concat "[" effort "]")))
+ ;; prevent erroring out with %e format when there is no effort
+ (setq effort ""))
(when remove-re
(while (string-match remove-re txt)
@@ -6131,6 +6547,10 @@ Any match of REMOVE-RE will be removed from TXT."
(add-text-properties 0 (length txt) '(org-heading t) txt)
;; Prepare the variables needed in the eval of the compiled format
+ (if org-prefix-has-breadcrumbs
+ (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
+ (let ((s (org-display-outline-path nil nil "->" t)))
+ (if (eq "" s) "" (concat s "->"))))))
(setq time (cond (s2 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
"-" (org-agenda-time-of-day-to-ampm-maybe s2)
@@ -6143,7 +6563,8 @@ Any match of REMOVE-RE will be removed from TXT."
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category))
+ thecategory (copy-sequence category)
+ level (or level ""))
(if (string-match org-bracket-link-regexp category)
(progn
(setq l (if (match-end 3)
@@ -6171,7 +6592,9 @@ Any match of REMOVE-RE will be removed from TXT."
'duration duration
'effort effort
'effort-minutes neffort
+ 'breadcrumbs breadcrumbs
'txt txt
+ 'level level
'time time
'extra extra
'format org-prefix-format-compiled
@@ -6216,9 +6639,13 @@ The modified list may contain inherited tags, and tags matched by
s))
(defvar org-agenda-sorting-strategy) ;; because the def is in a let form
-(defvar org-agenda-sorting-strategy-selected nil)
(defun org-agenda-add-time-grid-maybe (list ndays todayp)
+ "Add a time-grid for agenda items which need it.
+
+LIST is the list of agenda items formatted by `org-agenda-list'.
+NDAYS is the span of the current agenda view.
+TODAYP is t when the current agenda view is on today."
(catch 'exit
(cond ((not org-agenda-use-time-grid) (throw 'exit list))
((and todayp (member 'today (car org-agenda-time-grid))))
@@ -6240,16 +6667,14 @@ The modified list may contain inherited tags, and tags matched by
(unless (and remove (member time have))
(setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
(push (org-agenda-format-item
- nil string "" nil
+ nil string nil "" nil
(concat (substring time 0 -2) ":" (substring time -2)))
new)
(put-text-property
2 (length (car new)) 'face 'org-time-grid (car new))))
(when (and todayp org-agenda-show-current-time-in-grid)
(push (org-agenda-format-item
- nil
- org-agenda-current-time-string
- "" nil
+ nil org-agenda-current-time-string nil "" nil
(format-time-string "%H:%M "))
new)
(put-text-property
@@ -6263,9 +6688,11 @@ The modified list may contain inherited tags, and tags matched by
"Compile the prefix format into a Lisp form that can be evaluated.
The resulting form and associated variable bindings is returned
and stored in the variable `org-prefix-format-compiled'."
- (setq org-prefix-has-time nil org-prefix-has-tag nil
+ (setq org-prefix-has-time nil
+ org-prefix-has-tag nil
org-prefix-category-length nil
- org-prefix-has-effort nil)
+ org-prefix-has-effort nil
+ org-prefix-has-breadcrumbs nil)
(let ((s (cond
((stringp org-agenda-prefix-format)
org-agenda-prefix-format)
@@ -6274,11 +6701,11 @@ and stored in the variable `org-prefix-format-compiled'."
(t " %-12:c%?-12t% s")))
(start 0)
varform vars var e c f opt)
- (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)"
+ (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
s start)
(setq var (or (cdr (assoc (match-string 4 s)
- '(("c" . category) ("t" . time) ("s" . extra)
- ("i" . category-icon) ("T" . tag) ("e" . effort))))
+ '(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
+ ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
'eval)
c (or (match-string 3 s) "")
opt (match-beginning 1)
@@ -6286,6 +6713,7 @@ and stored in the variable `org-prefix-format-compiled'."
(if (equal var 'time) (setq org-prefix-has-time t))
(if (equal var 'tag) (setq org-prefix-has-tag t))
(if (equal var 'effort) (setq org-prefix-has-effort t))
+ (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
(setq f (concat "%" (match-string 2 s) "s"))
(when (equal var 'category)
(setq org-prefix-category-length
@@ -6312,7 +6740,8 @@ and stored in the variable `org-prefix-format-compiled'."
`((org-prefix-has-time ,org-prefix-has-time)
(org-prefix-has-tag ,org-prefix-has-tag)
(org-prefix-category-length ,org-prefix-category-length)
- (org-prefix-has-effort ,org-prefix-has-effort))
+ (org-prefix-has-effort ,org-prefix-has-effort)
+ (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
`(format ,s ,@vars))))))
(defun org-set-sorting-strategy (key)
@@ -6332,8 +6761,10 @@ The optional STRING argument forces conversion into a 5 character wide string
HH:MM."
(save-match-data
(when
- (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (and
+ (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
+ (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (not (eq (get-text-property 1 'face s) 'org-link)))
(let* ((h (string-to-number (match-string 1 s)))
(m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
(ampm (if (match-end 4) (downcase (match-string 4 s))))
@@ -6372,14 +6803,69 @@ You can also use this function as a filter, by returning nil for lines
you don't want to have in the agenda at all. For this application, you
could bind the variable in the options section of a custom command.")
-(defun org-agenda-finalize-entries (list &optional nosort)
- "Sort and concatenate the agenda items."
- (setq list (mapcar 'org-agenda-highlight-todo list))
- (if nosort
- list
+(defun org-agenda-finalize-entries (list &optional type)
+ "Sort, limit and concatenate the LIST of agenda items.
+The optional argument TYPE tells the agenda type."
+ (let ((max-effort (cond ((listp org-agenda-max-effort)
+ (cdr (assoc type org-agenda-max-effort)))
+ (t org-agenda-max-effort)))
+ (max-todo (cond ((listp org-agenda-max-todos)
+ (cdr (assoc type org-agenda-max-todos)))
+ (t org-agenda-max-todos)))
+ (max-tags (cond ((listp org-agenda-max-tags)
+ (cdr (assoc type org-agenda-max-tags)))
+ (t org-agenda-max-tags)))
+ (max-entries (cond ((listp org-agenda-max-entries)
+ (cdr (assoc type org-agenda-max-entries)))
+ (t org-agenda-max-entries))) l)
(when org-agenda-before-sorting-filter-function
- (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list))))
- (mapconcat 'identity (sort list 'org-entries-lessp) "\n")))
+ (setq list
+ (delq nil
+ (mapcar
+ org-agenda-before-sorting-filter-function list))))
+ (setq list (mapcar 'org-agenda-highlight-todo list)
+ list (mapcar 'identity (sort list 'org-entries-lessp)))
+ (when max-effort
+ (setq list (org-agenda-limit-entries
+ list 'effort-minutes max-effort 'identity)))
+ (when max-todo
+ (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
+ (when max-tags
+ (setq list (org-agenda-limit-entries list 'tags max-tags)))
+ (when max-entries
+ (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
+ (mapconcat 'identity list "\n")))
+
+(defun org-agenda-limit-entries (list prop limit &optional fn)
+ "Limit the number of agenda entries."
+ (let ((include (and limit (< limit 0))))
+ (if limit
+ (let ((fun (or fn (lambda (p) (if p 1))))
+ (lim 0))
+ (delq nil
+ (mapcar
+ (lambda (e)
+ (let ((pval (funcall fun (get-text-property 1 prop e))))
+ (if pval (setq lim (+ lim pval)))
+ (cond ((and pval (<= lim (abs limit))) e)
+ ((and include (not pval)) e))))
+ list)))
+ list)))
+
+(defun org-agenda-limit-interactively ()
+ "In agenda, interactively limit entries to various maximums."
+ (interactive)
+ (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
+ (num (string-to-number (read-from-minibuffer "How many? "))))
+ (cond ((equal max ?e)
+ (let ((org-agenda-max-entries num)) (org-agenda-redo)))
+ ((equal max ?t)
+ (let ((org-agenda-max-todos num)) (org-agenda-redo)))
+ ((equal max ?T)
+ (let ((org-agenda-max-tags num)) (org-agenda-redo)))
+ ((equal max ?E)
+ (let ((org-agenda-max-effort num)) (org-agenda-redo)))))
+ (org-agenda-fit-window-to-buffer))
(defun org-agenda-highlight-todo (x)
(let ((org-done-keywords org-done-keywords-for-agenda)
@@ -6506,6 +6992,22 @@ could bind the variable in the options section of a custom command.")
(cond ((< ta tb) -1)
((< tb ta) +1))))
+(defsubst org-cmp-ts (a b type)
+ "Compare the timestamps values of entries A and B.
+When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
+\"timestamp_ia\", compare within each of these type. When TYPE
+is the empty string, compare all timestamps without respect of
+their type."
+ (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
+ (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
+ (get-text-property 1 'ts-date a))
+ def))
+ (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
+ (get-text-property 1 'ts-date b))
+ def)))
+ (cond ((< ta tb) -1)
+ ((< tb ta) +1))))
+
(defsubst org-cmp-habit-p (a b)
"Compare the todo states of strings A and B."
(let ((ha (get-text-property 1 'org-habit-p a))
@@ -6513,13 +7015,26 @@ could bind the variable in the options section of a custom command.")
(cond ((and ha (not hb)) -1)
((and (not ha) hb) +1))))
-(defsubst org-em (x y list) (or (memq x list) (memq y list)))
-
(defun org-entries-lessp (a b)
"Predicate for sorting agenda entries."
;; The following variables will be used when the form is evaluated.
;; So even though the compiler complains, keep them.
(let* ((ss org-agenda-sorting-strategy-selected)
+ (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
+ (org-cmp-ts a b "")))
+ (timestamp-down (if timestamp-up (- timestamp-up) nil))
+ (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
+ (org-cmp-ts a b "scheduled")))
+ (scheduled-down (if scheduled-up (- scheduled-up) nil))
+ (deadline-up (and (org-em 'deadline-up 'deadline-down ss)
+ (org-cmp-ts a b "deadline")))
+ (deadline-down (if deadline-up (- deadline-up) nil))
+ (tsia-up (and (org-em 'tsia-up 'tsia-down ss)
+ (org-cmp-ts a b "timestamp_ia")))
+ (tsia-down (if tsia-up (- tsia-up) nil))
+ (ts-up (and (org-em 'ts-up 'ts-down ss)
+ (org-cmp-ts a b "timestamp")))
+ (ts-down (if ts-up (- ts-up) nil))
(time-up (and (org-em 'time-up 'time-down ss)
(org-cmp-time a b)))
(time-down (if time-up (- time-up) nil))
@@ -6567,6 +7082,7 @@ could bind the variable in the options section of a custom command.")
'help-echo "Agendas are currently limited to this subtree.")
(org-detach-overlay org-agenda-restriction-lock-overlay)
+;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
"Set restriction lock for agenda, to current subtree or file.
Restriction will be the file if TYPE is `file', or if type is the
@@ -6582,15 +7098,19 @@ in the file. Otherwise, restriction will be to the current subtree."
(t 'file)))
(if (eq type 'subtree)
(progn
- (setq org-agenda-restrict t)
+ (setq org-agenda-restrict (current-buffer))
(setq org-agenda-overriding-restriction 'subtree)
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
(org-back-to-heading t)
- (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol))
+ (move-overlay org-agenda-restriction-lock-overlay
+ (point)
+ (if org-agenda-restriction-lock-highlight-subtree
+ (save-excursion (org-end-of-subtree t t) (point))
+ (point-at-eol)))
(move-marker org-agenda-restrict-begin (point))
(move-marker org-agenda-restrict-end
- (save-excursion (org-end-of-subtree t)))
+ (save-excursion (org-end-of-subtree t t)))
(message "Locking agenda restriction to subtree"))
(put 'org-agenda-files 'org-restrict
(list (buffer-file-name (buffer-base-buffer))))
@@ -6643,8 +7163,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(error "Not allowed in %s-type agenda buffers" org-agenda-type)
nil))))
-(defun org-agenda-Quit (&optional arg)
- "Exit agenda by removing the window or the buffer."
+(defun org-agenda-Quit ()
+ "Exit the agenda and kill buffers loaded by `org-agenda'.
+Also restore the window configuration."
(interactive)
(if org-agenda-columns-active
(org-columns-quit)
@@ -6663,6 +7184,7 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(kill-buffer buf)
(org-columns-remove-overlays)
(setq org-agenda-archives-mode nil)))
+ (setq org-agenda-buffer nil)
;; Maybe restore the pre-agenda window configuration.
(and org-agenda-restore-windows-after-quit
(not (eq org-agenda-window-setup 'other-frame))
@@ -6671,8 +7193,8 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(setq org-agenda-pre-window-conf nil))))
(defun org-agenda-quit ()
- "Exit agenda by killing agenda buffer or burying it when
-`org-agenda-sticky' is non-NIL"
+ "Exit the agenda and restore the window configuration.
+When `org-agenda-sticky' is non-nil, only bury the agenda."
(interactive)
(if (and (eq org-indirect-buffer-display 'other-window)
org-last-indirect-buffer)
@@ -6701,9 +7223,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search."
(org-agenda-Quit))))
(defun org-agenda-exit ()
- "Exit agenda by removing the window or the buffer.
-Also kill all Org-mode buffers which have been loaded by `org-agenda'.
-Org-mode buffers visited directly by the user will not be touched."
+ "Exit the agenda and restore the window configuration.
+Also kill Org-mode buffers loaded by `org-agenda'. Org-mode
+buffers visited directly by the user will not be touched."
(interactive)
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
@@ -6711,8 +7233,8 @@ Org-mode buffers visited directly by the user will not be touched."
(defun org-agenda-kill-all-agenda-buffers ()
"Kill all buffers in `org-agenda-mode'.
-This is used when toggling sticky agendas. You can also explicitly invoke it
-with `C-c a C-k'."
+This is used when toggling sticky agendas.
+You can also explicitly invoke it with `C-c a C-k'."
(interactive)
(let (blist)
(dolist (buf (buffer-list))
@@ -6740,10 +7262,11 @@ in the agenda."
(org-agenda-keep-modes t)
(tag-filter org-agenda-tag-filter)
(tag-preset (get 'org-agenda-tag-filter :preset-filter))
- (top-cat-filter org-agenda-top-category-filter)
+ (top-hl-filter org-agenda-top-headline-filter)
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
- (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
+ (re-filter org-agenda-regexp-filter)
+ (re-preset (get 'org-agenda-regexp-filter :preset-filter))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
@@ -6760,19 +7283,29 @@ in the agenda."
(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
+ (put 'org-agenda-regexp-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
(eval series-redo-cmd)
- (org-let lprops '(eval redo-cmd)))
+ (org-let lprops redo-cmd))
(setq org-agenda-undo-list nil
- org-agenda-pending-undo-list nil)
+ org-agenda-pending-undo-list nil
+ org-agenda-tag-filter tag-filter
+ org-agenda-category-filter cat-filter
+ org-agenda-regexp-filter re-filter
+ org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
- (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
- (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
- (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter))
+ (put 'org-agenda-regexp-filter :preset-filter re-preset)
+ (let ((tag (or tag-filter tag-preset))
+ (cat (or cat-filter cat-preset))
+ (re (or re-filter re-preset)))
+ (when tag (org-agenda-filter-apply tag 'tag))
+ (when cat (org-agenda-filter-apply cat 'category))
+ (when re (org-agenda-filter-apply re 'regexp)))
+ (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
@@ -6789,11 +7322,18 @@ The category is that of the current line."
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (get-text-property (point) 'org-category))))
- (if cat (org-agenda-filter-apply
- (list (concat (if strip "-" "+") cat)) 'category)
- (error "No category at point")))))
-
-(defun org-find-top-category (&optional pos)
+ (cond
+ ((and cat strip)
+ (org-agenda-filter-apply
+ (push (concat "-" cat) org-agenda-category-filter) 'category))
+ ((and cat)
+ (org-agenda-filter-apply
+ (setq org-agenda-category-filter
+ (list (concat "+" cat))) 'category))
+ (t (error "No category at point"))))))
+
+(defun org-find-top-headline (&optional pos)
+ "Find the topmost parent headline and return it."
(save-excursion
(with-current-buffer (if pos (marker-buffer pos) (current-buffer))
(if pos (goto-char pos))
@@ -6802,20 +7342,51 @@ The category is that of the current line."
(ignore-errors
(nth 4 (org-heading-components))))))
-(defvar org-agenda-filtered-by-top-category nil)
-
-(defun org-agenda-filter-by-top-category (strip)
- "Keep only those lines in the agenda buffer that have a specific category.
-The category is that of the current line."
+(defvar org-agenda-filtered-by-top-headline nil)
+(defun org-agenda-filter-by-top-headline (strip)
+ "Keep only those lines that are descendants from the same top headline.
+The top headline is that of the current line."
(interactive "P")
- (if org-agenda-filtered-by-top-category
+ (if org-agenda-filtered-by-top-headline
(progn
- (setq org-agenda-filtered-by-top-category nil
- org-agenda-top-category-filter nil)
- (org-agenda-filter-show-all-cat))
- (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker))))
- (if cat (org-agenda-filter-top-category-apply cat strip)
- (error "No top-level category at point")))))
+ (setq org-agenda-filtered-by-top-headline nil
+ org-agenda-top-headline-filter nil)
+ (org-agenda-filter-show-all-top-filter))
+ (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
+ (if toph (org-agenda-filter-top-headline-apply toph strip)
+ (error "No top-level headline at point")))))
+
+(defvar org-agenda-regexp-filter nil)
+(defun org-agenda-filter-by-regexp (strip)
+ "Filter agenda entries by a regular expression.
+Regexp filters are cumulative.
+With no prefix argument, keep entries matching the regexp.
+With one prefix argument, filter out entries matching the regexp.
+With two prefix arguments, remove the regexp filters."
+ (interactive "P")
+ (if (not (equal strip '(16)))
+ (let ((flt (concat (if (equal strip '(4)) "-" "+")
+ (read-from-minibuffer
+ (if (equal strip '(4))
+ "Filter out entries matching regexp: "
+ "Narrow to entries matching regexp: ")))))
+ (push flt org-agenda-regexp-filter)
+ (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
+ (org-agenda-filter-show-all-re)
+ (message "Regexp filter removed")))
+
+(defun org-agenda-filter-remove-all ()
+ "Remove all filters from the current agenda buffer."
+ (interactive)
+ (when org-agenda-tag-filter
+ (org-agenda-filter-show-all-tag))
+ (when org-agenda-category-filter
+ (org-agenda-filter-show-all-cat))
+ (when org-agenda-regexp-filter
+ (org-agenda-filter-show-all-re))
+ (when org-agenda-top-headline-filter
+ (org-agenda-filter-show-all-top-filter))
+ (org-agenda-finalize))
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
@@ -6881,7 +7452,7 @@ to switch to narrowing."
((equal char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
- (setq org-agenda-tag-filter '())
+ (setq org-agenda-tag-filter nil)
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
@@ -6918,8 +7489,7 @@ to switch to narrowing."
(org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
- (when (and maybe-refresh
- (eq org-agenda-clockreport-mode 'with-filter))
+ (when maybe-refresh
(org-agenda-redo))))
(defun org-agenda-get-represented-tags ()
@@ -6938,29 +7508,61 @@ to switch to narrowing."
(interactive "P")
(org-agenda-filter-by-tag strip char 'refine))
-(defun org-agenda-filter-make-matcher ()
+(defun org-agenda-filter-make-matcher (filter type)
"Create the form that tests a line for agenda filter."
(let (f f1)
- ;; first compute the tag-filter matcher
- (dolist (x (delete-dups
- (append (get 'org-agenda-tag-filter
- :preset-filter) org-agenda-tag-filter)))
- (if (member x '("-" "+"))
- (setq f1 (if (equal x "-") 'tags '(not tags)))
- (if (string-match "[<=>?]" x)
- (setq f1 (org-agenda-filter-effort-form x))
- (setq f1 (list 'member (downcase (substring x 1)) 'tags)))
- (if (equal (string-to-char x) ?-)
- (setq f1 (list 'not f1))))
- (push f1 f))
- ;; then compute the category-filter matcher
- (dolist (x (delete-dups
- (append (get 'org-agenda-category-filter
- :preset-filter) org-agenda-category-filter)))
- (if (equal "-" (substring x 0 1))
- (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
- (setq f1 (list 'equal (substring x 1) 'cat)))
- (push f1 f))
+ (cond
+ ;; Tag filter
+ ((eq type 'tag)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-tag-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
+ (ffunc
+ (lambda (nf0 nf01 fltr notgroup op)
+ (dolist (x fltr)
+ (if (member x '("-" "+"))
+ (setq nf01 (if (equal x "-") 'tags '(not tags)))
+ (if (string-match "[<=>?]" x)
+ (setq nf01 (org-agenda-filter-effort-form x))
+ (setq nf01 (list 'member (downcase (substring x 1))
+ 'tags)))
+ (when (equal (string-to-char x) ?-)
+ (setq nf01 (list 'not nf01))
+ (when (not notgroup) (setq op 'and))))
+ (push nf01 nf0))
+ (if notgroup
+ (push (cons 'and nf0) f)
+ (push (cons (or op 'or) nf0) f)))))
+ (cond ((equal filter '("+"))
+ (setq f (list (list 'not 'tags))))
+ ((equal nfilter filter)
+ (funcall ffunc f1 f filter t nil))
+ (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ ;; Category filter
+ ((eq type 'category)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-category-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
+ (setq f1 (list 'equal (substring x 1) 'cat)))
+ (push f1 f)))
+ ;; Regexp filter
+ ((eq type 'regexp)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-regexp-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (if (equal "-" (substring x 0 1))
+ (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
+ (setq f1 (list 'string-match (substring x 1) 'txt)))
+ (push f1 f))))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
@@ -6985,26 +7587,48 @@ If the line does not have an effort defined, return nil."
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
+(defun org-agenda-filter-expand-tags (filter &optional no-operator)
+ "Expand group tags in FILTER for the agenda.
+When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
+ (if org-group-tags
+ (let ((case-fold-search t) rtn)
+ (mapc
+ (lambda (f)
+ (let (f0 dir)
+ (if (string-match "^\\([+-]\\)\\(.+\\)" f)
+ (setq dir (match-string 1 f) f0 (match-string 2 f))
+ (setq dir (if no-operator "" "+") f0 f))
+ (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
+ (org-tags-expand f0 t t))
+ rtn))))
+ filter)
+ (reverse rtn))
+ filter))
+
(defun org-agenda-filter-apply (filter type)
"Set FILTER as the new agenda filter and apply it."
- (let (tags cat)
- (if (eq type 'tag)
- (setq org-agenda-tag-filter filter)
- (setq org-agenda-category-filter filter))
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher))
- (if (and (eq type 'category)
- (not (equal (substring (car filter) 0 1) "-")))
- ;; Only set `org-agenda-filtered-by-category' to t
- ;; when a unique category is used as the filter
- (setq org-agenda-filtered-by-category t))
+ ;; Deactivate `org-agenda-entry-text-mode' when filtering
+ (if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
+ (let (tags cat txt)
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ ;; Only set `org-agenda-filtered-by-category' to t when a unique
+ ;; category is used as the filter:
+ (setq org-agenda-filtered-by-category
+ (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-"))))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags (org-get-at-bol 'tags) ; used in eval
- cat (get-text-property (point) 'org-category))
+ (setq tags ; used in eval
+ (apply 'append
+ (mapcar (lambda (f)
+ (org-agenda-filter-expand-tags (list f) t))
+ (org-get-at-bol 'tags)))
+ cat (get-text-property (point) 'org-category)
+ txt (get-text-property (point) 'txt))
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-hide-line type))
(beginning-of-line 2))
@@ -7012,58 +7636,55 @@ If the line does not have an effort defined, return nil."
(if (get-char-property (point) 'invisible)
(ignore-errors (org-agenda-previous-line)))))
-(defun org-agenda-filter-top-category-apply (category &optional negative)
- "Set FILTER as the new agenda filter and apply it."
+(defun org-agenda-filter-top-headline-apply (hl &optional negative)
+ "Filter by top headline HL."
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(let* ((pos (org-get-at-bol 'org-hd-marker))
- (topcat (and pos (org-find-top-category pos))))
- (if (and topcat (funcall (if negative 'identity 'not)
- (string= category topcat)))
- (org-agenda-filter-hide-line 'category)))
+ (tophl (and pos (org-find-top-headline pos))))
+ (if (and tophl (funcall (if negative 'identity 'not)
+ (string= hl tophl)))
+ (org-agenda-filter-hide-line 'top-headline)))
(beginning-of-line 2)))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))
- (setq org-agenda-top-category-filter category
- org-agenda-filtered-by-top-category t))
+ (setq org-agenda-top-headline-filter hl
+ org-agenda-filtered-by-top-headline t))
(defun org-agenda-filter-hide-line (type)
- (let (ov)
- (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
- (point-at-eol)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'type type)
- (if (eq type 'tag)
- (push ov org-agenda-tag-filter-overlays)
- (push ov org-agenda-cat-filter-overlays))))
-
-(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
- (setq pos (or pos (point)))
+ "Hide lines with TYPE in the agenda buffer."
+ (let* ((b (max (point-min) (1- (point-at-bol))))
+ (e (point-at-eol)))
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ b e `(invisible org-filtered org-filter-type ,type)))))
+
+(defun org-agenda-remove-filter (type)
+ (interactive)
+ "Remove filter of type TYPE from the agenda buffer."
(save-excursion
- (dolist (ov (overlays-at pos))
- (when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tag))
+ (goto-char (point-min))
+ (let ((inhibit-read-only t) pos)
+ (while (setq pos (text-property-any (point) (point-max) 'org-filter-type type))
(goto-char pos)
- (if (< (overlay-start ov) (point-at-eol))
- (move-overlay ov (point-at-eol)
- (overlay-end ov)))))))
+ (remove-text-properties
+ (point) (next-single-property-change (point) 'org-filter-type)
+ `(invisible org-filtered org-filter-type ,type))))
+ (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
+ (setq org-agenda-filter-form nil)
+ (org-agenda-set-mode-name)
+ (org-agenda-finalize)))
(defun org-agenda-filter-show-all-tag nil
- (mapc 'delete-overlay org-agenda-tag-filter-overlays)
- (setq org-agenda-tag-filter-overlays nil
- org-agenda-tag-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
-
+ (org-agenda-remove-filter 'tag))
+(defun org-agenda-filter-show-all-re nil
+ (org-agenda-remove-filter 'regexp))
(defun org-agenda-filter-show-all-cat nil
- (mapc 'delete-overlay org-agenda-cat-filter-overlays)
- (setq org-agenda-cat-filter-overlays nil
- org-agenda-filtered-by-category nil
- org-agenda-category-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
+ (org-agenda-remove-filter 'category))
+(defun org-agenda-filter-show-all-top-filter nil
+ (org-agenda-remove-filter 'top-headline))
(defun org-agenda-manipulate-query-add ()
"Manipulate the query by adding a search term with positive selection.
@@ -7121,23 +7742,31 @@ Negative selection means regexp must not match for selection of an entry."
(let* ((org-read-date-prefer-future
(eval org-agenda-jump-prefer-future))
(date (org-read-date))
+ (day (time-to-days (org-time-string-to-time date)))
(org-agenda-sticky-orig org-agenda-sticky)
(org-agenda-buffer-tmp-name (buffer-name))
(args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(0-arg (or current-prefix-arg (car args)))
(2-arg (nth 2 args))
+ (with-hour-p (nth 4 org-agenda-redo-command))
(newcmd (list 'org-agenda-list 0-arg date
- (org-agenda-span-to-ndays 2-arg)))
+ (org-agenda-span-to-ndays
+ 2-arg (org-time-string-to-absolute date))
+ with-hour-p))
(newargs (cdr newcmd))
(inhibit-read-only t)
org-agenda-sticky)
(if (not (org-agenda-check-type t 'agenda))
- (error "Not available in non-agenda blocks")
+ (error "Not available in non-agenda views")
(add-text-properties (point-min) (point-max)
`(org-redo-cmd ,newcmd org-last-args ,newargs))
(org-agenda-redo)
- (setq org-agenda-sticky org-agenda-sticky-orig
- org-agenda-this-buffer-is-sticky org-agenda-sticky))))
+ (goto-char (point-min))
+ (while (not (or (= (or (get-text-property (point) 'day) 0) day)
+ (save-excursion (move-beginning-of-line 2) (eobp))))
+ (move-beginning-of-line 2))
+ (setq org-agenda-sticky org-agenda-sticky-orig
+ org-agenda-this-buffer-is-sticky org-agenda-sticky))))
(defun org-agenda-goto-today ()
"Go to today."
@@ -7203,6 +7832,8 @@ With prefix ARG, go forward that many times the current span."
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd)))
+ ((eq span 'fortnight)
+ (setq sd (+ (* 14 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
@@ -7232,7 +7863,7 @@ With prefix ARG, go backward that many times the current span."
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
- (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
+ (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(let ((a (read-char-exclusive)))
@@ -7240,6 +7871,7 @@ With prefix ARG, go backward that many times the current span."
(?\ (call-interactively 'org-agenda-reset-view))
(?d (call-interactively 'org-agenda-day-view))
(?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
(?m (call-interactively 'org-agenda-month-view))
(?y (call-interactively 'org-agenda-year-view))
(?l (call-interactively 'org-agenda-log-mode))
@@ -7264,11 +7896,11 @@ With prefix ARG, go backward that many times the current span."
"Switch to default view for agenda."
(interactive)
(org-agenda-change-time-span (or org-agenda-ndays org-agenda-span)))
-(defun org-agenda-day-view (&optional day-of-year)
+(defun org-agenda-day-view (&optional day-of-month)
"Switch to daily view for agenda.
-With argument DAY-OF-YEAR, switch to that day of the year."
+With argument DAY-OF-MONTH, switch to that day of the month."
(interactive "P")
- (org-agenda-change-time-span 'day day-of-year))
+ (org-agenda-change-time-span 'day day-of-month))
(defun org-agenda-week-view (&optional iso-week)
"Switch to daily view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
@@ -7278,6 +7910,15 @@ week 12 of year 2007. Years in the range 1938-2037 can also be
written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'week iso-week))
+(defun org-agenda-fortnight-view (&optional iso-week)
+ "Switch to daily view for agenda.
+With argument ISO-WEEK, switch to the corresponding ISO week.
+If ISO-WEEK has more then 2 digits, only the last two encode the
+week. Any digits before this encode a year. So 200712 means
+week 12 of year 2007. Years in the range 1938-2037 can also be
+written as 2-digit years."
+ (interactive "P")
+ (org-agenda-change-time-span 'fortnight iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
With argument MONTH, switch to that month."
@@ -7299,7 +7940,7 @@ written as 2-digit years."
(defun org-agenda-change-time-span (span &optional n)
"Change the agenda view to SPAN.
-SPAN may be `day', `week', `month', `year'."
+SPAN may be `day', `week', `fortnight', `month', `year'."
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args)))
@@ -7320,7 +7961,7 @@ SPAN may be `day', `week', `month', `year'."
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
-SPAN may be `day', `week', `month', `year'. The return value
+SPAN may be `day', `week', `fortnight', `month', `year'. The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
@@ -7333,7 +7974,7 @@ so that the date SD will be in that range."
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1))))
- ((eq span 'week)
+ ((or (eq span 'week) (eq span 'fortnight))
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
@@ -7418,27 +8059,31 @@ so that the date SD will be in that range."
(defun org-agenda-entry-text-mode (&optional arg)
"Toggle entry text mode in an agenda buffer."
(interactive "P")
- (setq org-agenda-entry-text-mode (or (integerp arg)
- (not org-agenda-entry-text-mode)))
- (org-agenda-entry-text-hide)
- (and org-agenda-entry-text-mode
- (let ((org-agenda-entry-text-maxlines
- (if (integerp arg) arg org-agenda-entry-text-maxlines)))
- (org-agenda-entry-text-show)))
- (org-agenda-set-mode-name)
- (message "Entry text mode is %s. Maximum number of lines is %d"
- (if org-agenda-entry-text-mode "on" "off")
- (if (integerp arg) arg org-agenda-entry-text-maxlines)))
-
-(defun org-agenda-clockreport-mode (&optional with-filter)
- "Toggle clocktable mode in an agenda buffer.
-With prefix arg WITH-FILTER, make the clocktable respect the current
-agenda filter."
- (interactive "P")
+ (if (or org-agenda-tag-filter
+ org-agenda-category-filter
+ org-agenda-regexp-filter
+ org-agenda-top-headline-filter)
+ (user-error "Can't show entry text in filtered views")
+ (setq org-agenda-entry-text-mode (or (integerp arg)
+ (not org-agenda-entry-text-mode)))
+ (org-agenda-entry-text-hide)
+ (and org-agenda-entry-text-mode
+ (let ((org-agenda-entry-text-maxlines
+ (if (integerp arg) arg org-agenda-entry-text-maxlines)))
+ (org-agenda-entry-text-show)))
+ (org-agenda-set-mode-name)
+ (message "Entry text mode is %s%s"
+ (if org-agenda-entry-text-mode "on" "off")
+ (if (not org-agenda-entry-text-mode) ""
+ (format " (maximum number of lines is %d)"
+ (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
+
+(defun org-agenda-clockreport-mode ()
+ "Toggle clocktable mode in an agenda buffer."
+ (interactive)
(org-agenda-check-type t 'agenda)
- (if with-filter
- (setq org-agenda-clockreport-mode 'with-filter)
- (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)))
+ (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
+ (setq org-agenda-start-with-clockreport-mode org-agenda-clockreport-mode)
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Clocktable mode is %s"
@@ -7459,6 +8104,7 @@ With a double `C-u' prefix arg, show *only* log items, nothing else."
nil 'clockcheck))
(special '(closed clock state))
(t (not org-agenda-show-log))))
+ (setq org-agenda-start-with-log-mode org-agenda-show-log)
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Log mode is %s"
@@ -7532,8 +8178,8 @@ When called with a prefix argument, include all archive files as well."
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
- (if (or org-agenda-category-filter (get 'org-agenda-category-filter
- :preset-filter))
+ (if (or org-agenda-category-filter
+ (get 'org-agenda-category-filter :preset-filter))
'(:eval (org-propertize
(concat " <"
(mapconcat
@@ -7544,10 +8190,9 @@ When called with a prefix argument, include all archive files as well."
"")
">")
'face 'org-agenda-filter-category
- 'help-echo "Category used in filtering"))
- "")
- (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
- :preset-filter))
+ 'help-echo "Category used in filtering")) "")
+ (if (or org-agenda-tag-filter
+ (get 'org-agenda-tag-filter :preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
@@ -7558,17 +8203,26 @@ When called with a prefix argument, include all archive files as well."
"")
"}")
'face 'org-agenda-filter-tags
- 'help-echo "Tags used in filtering"))
- "")
+ 'help-echo "Tags used in filtering")) "")
+ (if (or org-agenda-regexp-filter
+ (get 'org-agenda-regexp-filter :preset-filter))
+ '(:eval (org-propertize
+ (concat " ["
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-regexp-filter :preset-filter)
+ org-agenda-regexp-filter)
+ "")
+ "]")
+ 'face 'org-agenda-filter-regexp
+ 'help-echo "Regexp used in filtering")) "")
(if org-agenda-archives-mode
(if (eq org-agenda-archives-mode t)
" Archives"
(format " :%s:" org-archive-tag))
"")
- (if org-agenda-clockreport-mode
- (if (eq org-agenda-clockreport-mode 'with-filter)
- " Clock{}" " Clock")
- "")))
+ (if org-agenda-clockreport-mode " Clock" "")))
(force-mode-line-update))
(define-obsolete-function-alias
@@ -7734,7 +8388,7 @@ Point is in the buffer where the item originated.")
(if (and confirm
(not (y-or-n-p "Archive this subtree or entry? ")))
(error "Abort")
- (save-excursion
+ (save-window-excursion
(goto-char pos)
(let ((org-agenda-buffer-name bufname-orig))
(org-remove-subtree-entries-from-agenda))
@@ -7768,10 +8422,19 @@ If this information is not given, the function uses the tree at point."
(beginning-of-line 0))))))
(defun org-agenda-refile (&optional goto rfloc no-update)
- "Refile the item at point."
+ "Refile the item at point.
+
+When GOTO is 0 or '(64), clear the refile cache.
+When GOTO is '(16), go to the location of the last refiled item.
+RFLOC can be a refile location obtained in a different way.
+When NO-UPDATE is non-nil, don't redo the agenda buffer."
(interactive "P")
- (if (equal goto '(16))
- (org-refile-goto-last-stored)
+ (cond
+ ((member goto '(0 (64)))
+ (org-refile-cache-clear))
+ ((equal goto '(16))
+ (org-refile-goto-last-stored))
+ (t
(let* ((buffer-orig (buffer-name))
(marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
@@ -7789,7 +8452,7 @@ If this information is not given, the function uses the tree at point."
(let ((org-agenda-buffer-name buffer-orig))
(org-remove-subtree-entries-from-agenda))
(org-refile goto buffer rfloc)))))
- (unless no-update (org-agenda-redo))))
+ (unless no-update (org-agenda-redo)))))
(defun org-agenda-open-link (&optional arg)
"Open the link(s) in the current entry, if any.
@@ -7800,7 +8463,8 @@ It also looks at the text of the entry itself."
(org-get-at-bol 'org-marker)))
(buffer (and marker (marker-buffer marker)))
(prefix (buffer-substring (point-at-bol) (point-at-eol)))
- (lkall (org-offer-links-in-entry buffer marker arg prefix))
+ (lkall (and buffer (org-offer-links-in-entry
+ buffer marker arg prefix)))
(lk0 (car lkall))
(lk (if (stringp lk0) (list lk0) lk0))
(lkend (cdr lkall))
@@ -7926,7 +8590,8 @@ if it was hidden in the outline."
(interactive "p")
(let ((win (selected-window)))
(org-agenda-goto t)
- (org-recenter-heading 1)
+ (org-back-to-heading)
+ (set-window-start (selected-window) (point-at-bol))
(cond
((= more 0)
(hide-subtree)
@@ -7965,11 +8630,6 @@ if it was hidden in the outline."
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
-(defun org-recenter-heading (n)
- (save-excursion
- (org-back-to-heading)
- (recenter n)))
-
(defvar org-agenda-cycle-counter nil)
(defun org-agenda-cycle-show (&optional n)
"Show the current entry in another window, with default settings.
@@ -8107,8 +8767,12 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(org-back-to-heading)
(move-marker org-last-heading-marker (point))))
(beginning-of-line 1)
- (save-excursion
+ (save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
+ (when (org-bound-and-true-p org-clock-out-when-done)
+ (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
+ newhead)
+ (org-agenda-unmark-clocking-task))
(org-move-to-column col))))
(defun org-agenda-add-note (&optional arg)
@@ -8147,7 +8811,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(save-excursion (save-restriction (widen)
(goto-char hdmarker)
(org-get-tags-at)))))
- props m pl undone-face done-face finish new dotime cat tags)
+ props m pl undone-face done-face finish new dotime level cat tags)
(save-excursion
(goto-char (point-max))
(beginning-of-line 1)
@@ -8159,6 +8823,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime)
cat (org-get-at-bol 'org-category)
+ level (org-get-at-bol 'level)
tags thetags
new
(let ((org-prefix-format-compiled
@@ -8169,7 +8834,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(save-excursion
(save-restriction
(widen)
- (org-agenda-format-item extra newhead cat tags dotime)))))
+ (org-agenda-format-item extra newhead level cat tags dotime)))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
@@ -8244,7 +8909,8 @@ Called with a universal prefix arg, show the priority instead of setting it."
(unless org-enable-priority-commands
(error "Priority commands are disabled"))
(org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
+ (let* ((col (current-column))
+ (marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(hdmarker (org-get-at-bol 'org-hd-marker))
(buffer (marker-buffer hdmarker))
@@ -8263,7 +8929,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(end-of-line 1)
(setq newhead (org-get-heading)))
(org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
+ (org-move-to-column col)))))
;; FIXME: should fix the tags property of the agenda line.
(defun org-agenda-set-tags (&optional tag onoff)
@@ -8472,8 +9138,8 @@ Called with a universal prefix arg, show the priority instead of setting it."
(goto-char (point-max))
(while (not (bobp))
(when (equal marker (org-get-at-bol 'org-marker))
+ (remove-text-properties (point-at-bol) (point-at-eol) '(display))
(org-move-to-column (- (window-width) (length stamp)) t)
- (org-agenda-fix-tags-filter-overlays-at (point))
(if (featurep 'xemacs)
;; Use `duplicable' property to trigger undo recording
(let ((ex (make-extent nil nil))
@@ -8483,9 +9149,9 @@ Called with a universal prefix arg, show the priority instead of setting it."
ex (list 'invisible t 'end-glyph gl 'duplicable t))
(insert-extent ex (1- (point)) (point-at-eol)))
(add-text-properties
- (1- (point)) (point-at-eol)
+ (1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
- 'face 'secondary-selection))))
+ 'face '(secondary-selection default)))))
(beginning-of-line 1))
(beginning-of-line 0)))))
@@ -8560,9 +9226,9 @@ ARG is passed through to `org-deadline'."
(org-clock-in arg)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
- (hdmarker (or (org-get-at-bol 'org-hd-marker)
- marker))
+ (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
(pos (marker-position marker))
+ (col (current-column))
newhead)
(org-with-remote-undo (marker-buffer marker)
(with-current-buffer (marker-buffer marker)
@@ -8573,14 +9239,15 @@ ARG is passed through to `org-deadline'."
(org-cycle-hide-drawers 'children)
(org-clock-in arg)
(setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)))))
+ (org-agenda-change-all-lines newhead hdmarker))
+ (org-move-to-column col))))
(defun org-agenda-clock-out ()
"Stop the currently running clock."
(interactive)
(unless (marker-buffer org-clock-marker)
(error "No running clock"))
- (let ((marker (make-marker)) newhead)
+ (let ((marker (make-marker)) (col (current-column)) newhead)
(org-with-remote-undo (marker-buffer org-clock-marker)
(with-current-buffer (marker-buffer org-clock-marker)
(save-excursion
@@ -8592,13 +9259,15 @@ ARG is passed through to `org-deadline'."
(org-clock-out)
(setq newhead (org-get-heading))))))
(org-agenda-change-all-lines newhead marker)
- (move-marker marker nil)))
+ (move-marker marker nil)
+ (org-move-to-column col)
+ (org-agenda-unmark-clocking-task)))
(defun org-agenda-clock-cancel (&optional arg)
"Cancel the currently running clock."
(interactive "P")
(unless (marker-buffer org-clock-marker)
- (error "No running clock"))
+ (user-error "No running clock"))
(org-with-remote-undo (marker-buffer org-clock-marker)
(org-clock-cancel)))
@@ -8626,7 +9295,7 @@ buffer, display it in another window."
(setq d1 (calendar-cursor-to-date t)
d2 (car calendar-mark-ring))
(setq dp1 (get-text-property (point-at-bol) 'day))
- (unless dp1 (error "No date defined in current line"))
+ (unless dp1 (user-error "No date defined in current line"))
(setq d1 (calendar-gregorian-from-absolute dp1)
d2 (and (ignore-errors (mark))
(save-excursion
@@ -8650,7 +9319,7 @@ buffer, display it in another window."
((equal char ?b)
(setq text (read-string "Block entry: "))
(unless (and d1 d2 (not (equal d1 d2)))
- (error "No block of days selected"))
+ (user-error "No block of days selected"))
(org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
(and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
((equal char ?j)
@@ -8659,7 +9328,7 @@ buffer, display it in another window."
(require 'org-datetree)
(org-datetree-find-date-create d1)
(org-reveal t))
- (t (error "Invalid selection character `%c'" char)))))
+ (t (user-error "Invalid selection character `%c'" char)))))
(defcustom org-agenda-insert-diary-strategy 'date-tree
"Where in `org-agenda-diary-file' should new entries be added?
@@ -8717,7 +9386,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to
;; Use org-agenda-format-item to parse text for a time-range and
;; remove it. FIXME: This is a hack, we should refactor
;; that function to make time extraction available separately
- (setq fmt (org-agenda-format-item nil text nil nil t)
+ (setq fmt (org-agenda-format-item nil text nil nil nil t)
time (get-text-property 0 'time fmt)
time2 (if (> (length time) 0)
;; split-string removes trailing ...... if
@@ -8770,9 +9439,9 @@ a timestamp can be added there."
(if org-adapt-indentation (org-indent-to-column 2)))
(defun org-agenda-insert-diary-make-new-entry (text)
- "Make new entry as last child of current entry.
-Add TEXT as headline, and position the cursor in the second line so that
-a timestamp can be added there."
+ "Make a new entry with TEXT as the first child of the current subtree.
+Position the point in the line right after the new heading so
+that a timestamp can be added there."
(let ((org-show-following-heading t)
(org-show-siblings t)
(org-show-hierarchy-above t)
@@ -8819,11 +9488,11 @@ entries in that Org-mode file."
(point (point))
(mark (or (mark t) (point))))
(unless cmd
- (error "No command associated with <%c>" char))
+ (user-error "No command associated with <%c>" char))
(unless (and (get-text-property point 'day)
(or (not (equal ?b char))
(get-text-property mark 'day)))
- (error "Don't know which date to use for diary entry"))
+ (user-error "Don't know which date to use for diary entry"))
;; We implement this by hacking the `calendar-cursor-to-date' function
;; and the `calendar-mark-ring' variable. Saves a lot of code.
(let ((calendar-mark-ring
@@ -8844,7 +9513,7 @@ entries in that Org-mode file."
(org-agenda-check-type t 'agenda 'timeline)
(require 'diary-lib)
(unless (get-text-property (min (1- (point-max)) (point)) 'day)
- (error "Don't know which date to use for the calendar command"))
+ (user-error "Don't know which date to use for the calendar command"))
(let* ((oldf (symbol-function 'calendar-cursor-to-date))
(point (point))
(date (calendar-gregorian-from-absolute
@@ -8893,7 +9562,7 @@ argument, latitude and longitude will be prompted for."
(interactive)
(org-agenda-check-type t 'agenda 'timeline)
(let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
- (error "Don't know which date to open in calendar")))
+ (user-error "Don't know which date to open in calendar")))
(date (calendar-gregorian-from-absolute day))
(calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
@@ -8916,7 +9585,7 @@ This is a command that has to be installed in `calendar-mode-map'."
(let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
- (error "Don't know which date to convert"))
+ (user-error "Don't know which date to convert"))
(setq date (calendar-gregorian-from-absolute day))
(setq s (concat
"Gregorian: " (calendar-date-string date) "\n"
@@ -8928,7 +9597,7 @@ This is a command that has to be installed in `calendar-mode-map'."
"Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
"Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
"French: " (calendar-french-date-string date) "\n"
- "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n"
+ "Bahá’í: " (calendar-bahai-date-string date) " (until sunset)\n"
"Mayan: " (calendar-mayan-date-string date) "\n"
"Coptic: " (calendar-coptic-date-string date) "\n"
"Ethiopic: " (calendar-ethiopic-date-string date) "\n"
@@ -8952,14 +9621,17 @@ This is a command that has to be installed in `calendar-mode-map'."
(let* ((m (org-get-at-bol 'org-hd-marker))
ov)
(unless (org-agenda-bulk-marked-p)
- (unless m (error "Nothing to mark at point"))
+ (unless m (user-error "Nothing to mark at point"))
(push m org-agenda-bulk-marked-entries)
(setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
(org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
(org-get-todo-face "TODO")
'evaporate)
(overlay-put ov 'type 'org-marked-entry-overlay))
- (beginning-of-line 2)
+ (end-of-line 1)
+ (or (ignore-errors
+ (goto-char (next-single-property-change (point) 'org-hd-marker)))
+ (beginning-of-line 2))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(beginning-of-line 2))
(message "%d entries marked for bulk action"
@@ -8973,12 +9645,13 @@ This is a command that has to be installed in `calendar-mode-map'."
(defun org-agenda-bulk-mark-regexp (regexp)
"Mark entries matching REGEXP for future agenda bulk action."
(interactive "sMark entries matching regexp: ")
- (let ((entries-marked 0))
+ (let ((entries-marked 0) txt-at-point)
(save-excursion
(goto-char (point-min))
- (goto-char (next-single-property-change (point) 'txt))
- (while (re-search-forward regexp nil t)
- (when (string-match regexp (get-text-property (point) 'txt))
+ (goto-char (next-single-property-change (point) 'org-hd-marker))
+ (while (and (re-search-forward regexp nil t)
+ (setq txt-at-point (get-text-property (point) 'txt)))
+ (when (string-match regexp txt-at-point)
(setq entries-marked (1+ entries-marked))
(call-interactively 'org-agenda-bulk-mark))))
(if (not entries-marked)
@@ -8995,15 +9668,27 @@ This is a command that has to be installed in `calendar-mode-map'."
(setq org-agenda-bulk-marked-entries
(delete (org-get-at-bol 'org-hd-marker)
org-agenda-bulk-marked-entries))
- (beginning-of-line 2)
+ (end-of-line 1)
+ (or (ignore-errors
+ (goto-char (next-single-property-change (point) 'txt)))
+ (beginning-of-line 2))
(while (and (get-char-property (point) 'invisible) (not (eobp)))
(beginning-of-line 2))
(message "%d entries left marked for bulk action"
(length org-agenda-bulk-marked-entries)))
(t (message "No entry to unmark here")))))
+(defun org-agenda-bulk-toggle-all ()
+ "Toggle all marks for bulk action."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (while (ignore-errors
+ (goto-char (next-single-property-change (point) 'org-hd-marker)))
+ (org-agenda-bulk-toggle))))
+
(defun org-agenda-bulk-toggle ()
- "Toggle marking the entry at point for bulk action."
+ "Toggle the mark at point for bulk action."
(interactive)
(if (org-agenda-bulk-marked-p)
(org-agenda-bulk-unmark)
@@ -9044,14 +9729,14 @@ bulk action."
The prefix arg is passed through to the command if possible."
(interactive "P")
;; Make sure we have markers, and only valid ones
- (unless org-agenda-bulk-marked-entries (error "No entries are marked"))
+ (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
(mapc
(lambda (m)
(unless (and (markerp m)
(marker-buffer m)
(buffer-live-p (marker-buffer m))
(marker-position m))
- (error "Marker %s for bulk command is invalid" m)))
+ (user-error "Marker %s for bulk command is invalid" m)))
org-agenda-bulk-marked-entries)
;; Prompt for the bulk command
@@ -9130,7 +9815,7 @@ The prefix arg is passed through to the command if possible."
((equal action ?S)
(if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
- (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
+ (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
(let ((days (read-number
(format "Scatter tasks across how many %sdays: "
(if arg "week" "")) 7)))
@@ -9168,7 +9853,7 @@ The prefix arg is passed through to the command if possible."
(org-icompleting-read "Function: "
obarray 'fboundp t nil nil)))))
- (t (error "Invalid bulk action")))
+ (t (user-error "Invalid bulk action")))
;; Sort the markers, to make sure that parents are handled before children
(setq entries (sort entries
@@ -9202,15 +9887,57 @@ The prefix arg is passed through to the command if possible."
(if (not org-agenda-persistent-marks)
"" " (kept marked)"))))))
-(defun org-agenda-capture ()
- "Call `org-capture' with the date at point."
- (interactive)
+(defun org-agenda-capture (&optional with-time)
+ "Call `org-capture' with the date at point.
+With a `C-1' prefix, use the HH:MM value at point (if any) or the
+current HH:MM time."
+ (interactive "P")
(if (not (eq major-mode 'org-agenda-mode))
- (error "You cannot do this outside of agenda buffers")
+ (user-error "You cannot do this outside of agenda buffers")
(let ((org-overriding-default-time
- (org-get-cursor-date)))
+ (org-get-cursor-date (equal with-time 1))))
(call-interactively 'org-capture))))
+;;; Dragging agenda lines forward/backward
+
+(defun org-agenda-reapply-filters ()
+ "Re-apply all agenda filters."
+ (mapcar
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ `((,org-agenda-tag-filter tag)
+ (,org-agenda-category-filter category)
+ (,org-agenda-regexp-filter regexp)
+ (,(get 'org-agenda-tag-filter :preset-filter) tag)
+ (,(get 'org-agenda-category-filter :preset-filter) category)
+ (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
+
+(defun org-agenda-drag-line-forward (arg &optional backward)
+ "Drag an agenda line forward by ARG lines.
+When the optional argument `backward' is non-nil, move backward."
+ (interactive "p")
+ (let ((inhibit-read-only t) lst line)
+ (if (or (not (get-text-property (point) 'txt))
+ (save-excursion
+ (dotimes (n arg)
+ (move-beginning-of-line (if backward 0 2))
+ (push (not (get-text-property (point) 'txt)) lst))
+ (delq nil lst)))
+ (message "Cannot move line forward")
+ (let ((end (save-excursion (move-beginning-of-line 2) (point))))
+ (move-beginning-of-line 1)
+ (setq line (buffer-substring (point) end))
+ (delete-region (point) end)
+ (move-beginning-of-line (funcall (if backward '1- '1+) arg))
+ (insert line)
+ (org-agenda-reapply-filters)
+ (org-agenda-mark-clocking-task)
+ (move-beginning-of-line 0)))))
+
+(defun org-agenda-drag-line-backward (arg)
+ "Drag an agenda line backward by ARG lines."
+ (interactive "p")
+ (org-agenda-drag-line-forward arg t))
+
;;; Flagging notes
(defun org-agenda-show-the-flagging-note ()
@@ -9222,7 +9949,7 @@ tag and (if present) the flagging note."
(win (selected-window))
note heading newhead)
(unless hdmarker
- (error "No linked entry at point"))
+ (user-error "No linked entry at point"))
(if (and (eq this-command last-command)
(y-or-n-p "Unflag and remove any flagging note? "))
(progn
@@ -9232,7 +9959,7 @@ tag and (if present) the flagging note."
(message "Entry unflagged"))
(setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
(unless note
- (error "No flagging note"))
+ (user-error "No flagging note"))
(org-kill-new note)
(org-switch-to-buffer-other-window "*Flagging Note*")
(erase-buffer)
@@ -9279,16 +10006,17 @@ calling the function returns nil. This function takes one
argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
-either 'headline or 'category. For example:
+either `headline' or `category'. For example:
- '((headline \"IMPORTANT\")
- (category \"Work\"))
+ ((headline \"IMPORTANT\")
+ (category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
ARGS are symbols indicating what kind of entries to consider.
-By default `org-agenda-to-appt' will use :deadline, :scheduled
+By default `org-agenda-to-appt' will use :deadline*, :scheduled*
+\(i.e., deadlines and scheduled items with a hh:mm specification)
and :timestamp entries. See the docstring of `org-diary' for
details and examples.
@@ -9299,7 +10027,7 @@ to override `appt-message-warning-time'."
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
(let* ((cnt 0) ; count added events
- (scope (or args '(:deadline :scheduled :timestamp)))
+ (scope (or args '(:deadline* :scheduled* :timestamp)))
(org-agenda-new-buffers nil)
(org-deadline-warning-days 0)
;; Do not use `org-today' here because appt only takes
@@ -9321,7 +10049,10 @@ to override `appt-message-warning-time'."
;; Map thru entries and find if we should filter them out
(mapc
(lambda(x)
- (let* ((evt (org-trim (or (get-text-property 1 'txt x) "")))
+ (let* ((evt (org-trim
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3"
+ (or (get-text-property 1 'txt x) ""))))
(cat (get-text-property 1 'org-category x))
(tod (get-text-property 1 'time-of-day x))
(ok (or (null filter)
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 2fcfc8634fe..2637623abba 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -1,6 +1,6 @@
;;; org-archive.el --- Archiving for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -71,6 +71,15 @@ This variable is obsolete and has no effect anymore, instead add or remove
:group 'org-archive
:type 'boolean)
+(defcustom org-archive-file-header-format "\nArchived entries from file %s\n\n"
+ "The header format string for newly created archive files.
+When nil, no header will be inserted.
+When a string, a %s formatter will be replaced by the file name."
+ :group 'org-archive
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defcustom org-archive-subtree-add-inherited-tags 'infile
"Non-nil means append inherited tags when archiving a subtree."
:group 'org-archive
@@ -126,6 +135,7 @@ information."
(match-string 1))
(t org-archive-location))))))
+;;;###autoload
(defun org-add-archive-files (files)
"Splice the archive files into the list of files.
This implies visiting all these files and finding out what the
@@ -221,8 +231,7 @@ this heading."
(error "No file associated to buffer"))))
(olpath (mapconcat 'identity (org-get-outline-path) "/"))
(time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
+ (substring (cdr org-time-stamp-formats) 1 -1)))
category todo priority ltags itags atags
;; end of variables that will be used for saving context
location afile heading buffer level newfile-p infile-p visiting
@@ -278,9 +287,9 @@ this heading."
(let ((org-insert-mode-line-in-empty-file t)
(org-inhibit-startup t))
(call-interactively 'org-mode)))
- (when newfile-p
+ (when (and newfile-p org-archive-file-header-format)
(goto-char (point-max))
- (insert (format "\nArchived entries from file %s\n\n"
+ (insert (format org-archive-file-header-format
(buffer-file-name this-buffer))))
(when datetree-date
(require 'org-datetree)
@@ -431,8 +440,7 @@ sibling does not exist, it will be created at the end of the subtree."
(org-set-property
"ARCHIVE_TIME"
(format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)
- (current-time)))
+ (substring (cdr org-time-stamp-formats) 1 -1)))
(outline-up-heading 1 t)
(hide-subtree)
(org-cycle-show-empty-lines 'folded)
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el
deleted file mode 100644
index c5a4b3775e8..00000000000
--- a/lisp/org/org-ascii.el
+++ /dev/null
@@ -1,730 +0,0 @@
-;;; org-ascii.el --- ASCII export for Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;;; Code:
-
-(require 'org-exp)
-
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-export-ascii nil
- "Options specific for ASCII export of Org-mode files."
- :tag "Org Export ASCII"
- :group 'org-export)
-
-(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
- "Characters for underlining headings in ASCII export.
-In the given sequence, these characters will be used for level 1, 2, ..."
- :group 'org-export-ascii
- :type '(repeat character))
-
-(defcustom org-export-ascii-bullets '(?* ?+ ?-)
- "Bullet characters for headlines converted to lists in ASCII export.
-The first character is used for the first lest level generated in this
-way, and so on. If there are more levels than characters given here,
-the list will be repeated.
-Note that plain lists will keep the same bullets as the have in the
-Org-mode file."
- :group 'org-export-ascii
- :type '(repeat character))
-
-(defcustom org-export-ascii-links-to-notes t
- "Non-nil means convert links to notes before the next headline.
-When nil, the link will be exported in place. If the line becomes long
-in this way, it will be wrapped."
- :group 'org-export-ascii
- :type 'boolean)
-
-(defcustom org-export-ascii-table-keep-all-vertical-lines nil
- "Non-nil means keep all vertical lines in ASCII tables.
-When nil, vertical lines will be removed except for those needed
-for column grouping."
- :group 'org-export-ascii
- :type 'boolean)
-
-(defcustom org-export-ascii-table-widen-columns t
- "Non-nil means widen narrowed columns for export.
-When nil, narrowed columns will look in ASCII export just like in org-mode,
-i.e. with \"=>\" as ellipsis."
- :group 'org-export-ascii
- :type 'boolean)
-
-(defvar org-export-ascii-entities 'ascii
- "The ascii representation to be used during ascii export.
-Possible values are:
-
-ascii Only use plain ASCII characters
-latin1 Include Latin-1 character
-utf8 Use all UTF-8 characters")
-
-;;; Hooks
-
-(defvar org-export-ascii-final-hook nil
- "Hook run at the end of ASCII export, in the new buffer.")
-
-;;; ASCII export
-
-(defvar org-ascii-current-indentation nil) ; For communication
-
-;;;###autoload
-(defun org-export-as-latin1 (&rest args)
- "Like `org-export-as-ascii', use latin1 encoding for special symbols."
- (interactive)
- (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any)
- 'latin1 args))
-
-;;;###autoload
-(defun org-export-as-latin1-to-buffer (&rest args)
- "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols."
- (interactive)
- (org-export-as-encoding 'org-export-as-ascii-to-buffer
- (org-called-interactively-p 'any) 'latin1 args))
-
-;;;###autoload
-(defun org-export-as-utf8 (&rest args)
- "Like `org-export-as-ascii', use encoding for special symbols."
- (interactive)
- (org-export-as-encoding 'org-export-as-ascii
- (org-called-interactively-p 'any)
- 'utf8 args))
-
-;;;###autoload
-(defun org-export-as-utf8-to-buffer (&rest args)
- "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols."
- (interactive)
- (org-export-as-encoding 'org-export-as-ascii-to-buffer
- (org-called-interactively-p 'any) 'utf8 args))
-
-(defun org-export-as-encoding (command interactivep encoding &rest args)
- (let ((org-export-ascii-entities encoding))
- (if interactivep
- (call-interactively command)
- (apply command args))))
-
-
-;;;###autoload
-(defun org-export-as-ascii-to-buffer (arg)
- "Call `org-export-as-ascii` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-ascii'."
- (interactive "P")
- (org-export-as-ascii arg nil "*Org ASCII Export*")
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window "*Org ASCII Export*")))
-
-;;;###autoload
-(defun org-replace-region-by-ascii (beg end)
- "Assume the current region has org-mode syntax, and convert it to plain ASCII.
-This can be used in any buffer. For example, you could write an
-itemized list in org-mode syntax in a Mail buffer and then use this
-command to convert it."
- (interactive "r")
- (let (reg ascii buf pop-up-frames)
- (save-window-excursion
- (if (derived-mode-p 'org-mode)
- (setq ascii (org-export-region-as-ascii
- beg end t 'string))
- (setq reg (buffer-substring beg end)
- buf (get-buffer-create "*Org tmp*"))
- (with-current-buffer buf
- (erase-buffer)
- (insert reg)
- (org-mode)
- (setq ascii (org-export-region-as-ascii
- (point-min) (point-max) t 'string)))
- (kill-buffer buf)))
- (delete-region beg end)
- (insert ascii)))
-
-;;;###autoload
-(defun org-export-region-as-ascii (beg end &optional body-only buffer)
- "Convert region from BEG to END in org-mode buffer to plain ASCII.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted ASCII. If BUFFER is the symbol `string', return the
-produced ASCII as a string and leave not buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq ascii (org-export-region-as-ascii beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer."
- (interactive "r\nP")
- (when (org-called-interactively-p 'any)
- (setq buffer "*Org ASCII Export*"))
- (let ((transient-mark-mode t) (zmacs-regions t)
- ext-plist rtn)
- (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
- (goto-char end)
- (set-mark (point)) ;; to activate the region
- (goto-char beg)
- (setq rtn (org-export-as-ascii nil ext-plist buffer body-only))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (if (and (org-called-interactively-p 'any) (bufferp rtn))
- (switch-to-buffer-other-window rtn)
- rtn)))
-
-;;;###autoload
-(defun org-export-as-ascii (arg &optional ext-plist to-buffer body-only pub-dir)
- "Export the outline as a pretty ASCII file.
-If there is an active region, export only the region.
-The prefix ARG specifies how many levels of the outline should become
-underlined headlines, default is 3. Lower levels will become bulleted
-lists. EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When TO-BUFFER is non-nil, create a buffer with that
-name and export to that buffer. If TO-BUFFER is the symbol
-`string', don't leave any buffer behind but just return the
-resulting ASCII as a string. When BODY-ONLY is set, don't produce
-the file header and footer. When PUB-DIR is set, use this as the
-publishing directory."
- (interactive "P")
- (run-hooks 'org-export-first-hook)
- (setq-default org-todo-line-regexp org-todo-line-regexp)
- (let* ((opt-plist (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist)))
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (level-offset (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (+ (funcall outline-level)
- (if org-odd-levels-only 1 0)))
- 0))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- ;; The following two are dynamically scoped into other
- ;; routines below.
- (org-current-export-dir
- (or pub-dir (org-export-directory :html opt-plist)))
- (org-current-export-file buffer-file-name)
- (custom-times org-display-custom-times)
- (org-ascii-current-indentation '(0 . 0))
- (level 0) line txt
- (umax nil)
- (umax-toc nil)
- (case-fold-search nil)
- (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
- (filename (if to-buffer
- nil
- (concat (file-name-as-directory
- (or pub-dir
- (org-export-directory :ascii opt-plist)))
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory bfname)))
- ".txt")))
- (filename (and filename
- (if (equal (file-truename filename)
- (file-truename bfname))
- (concat filename ".txt")
- filename)))
- (buffer (if to-buffer
- (cond
- ((eq to-buffer 'string)
- (get-buffer-create "*Org ASCII Export*"))
- (t (get-buffer-create to-buffer)))
- (find-file-noselect filename)))
- (org-levels-open (make-vector org-level-max nil))
- (odd org-odd-levels-only)
- (date (plist-get opt-plist :date))
- (author (plist-get opt-plist :author))
- (title (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and (buffer-file-name)
- (file-name-sans-extension
- (file-name-nondirectory bfname)))
- "UNTITLED"))
- (email (plist-get opt-plist :email))
- (language (plist-get opt-plist :language))
- (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)"))
- (todo nil)
- (lang-words nil)
- (region
- (buffer-substring
- (if (org-region-active-p) (region-beginning) (point-min))
- (if (org-region-active-p) (region-end) (point-max))))
- (org-export-footnotes-seen nil)
- (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
- (lines (org-split-string
- (org-export-preprocess-string
- region
- :for-backend 'ascii
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get opt-plist :drawers)
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :timestamps (plist-get opt-plist :timestamps)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :verbatim-multiline t
- :select-tags (plist-get opt-plist :select-tags)
- :exclude-tags (plist-get opt-plist :exclude-tags)
- :archived-trees
- (plist-get opt-plist :archived-trees)
- :add-text (plist-get opt-plist :text))
- "\n"))
- thetoc have-headings first-heading-pos
- table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc)
- (let ((inhibit-read-only t))
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill t))))
-
- (setq org-min-level (org-get-min-level lines level-offset))
- (setq org-last-level org-min-level)
- (org-init-section-numbers)
- (setq lang-words (or (assoc language org-export-language-setup)
- (assoc "en" org-export-language-setup)))
- (set-buffer buffer)
- (erase-buffer)
- (fundamental-mode)
- (org-install-letbind)
- ;; create local variables for all options, to make sure all called
- ;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
- (org-set-local 'org-odd-levels-only odd)
- (setq umax (if arg (prefix-numeric-value arg)
- org-export-headline-levels))
- (setq umax-toc (if (integerp org-export-with-toc)
- (min org-export-with-toc umax)
- umax))
-
- ;; File header
- (unless body-only
- (when (and title (not (string= "" title)))
- (org-insert-centered title ?=)
- (insert "\n"))
-
- (if (and (or author email)
- org-export-author-info)
- (insert (concat (nth 1 lang-words) ": " (or author "")
- (if (and org-export-email-info
- email (string-match "\\S-" email))
- (concat " <" email ">") "")
- "\n")))
-
- (cond
- ((and date (string-match "%" date))
- (setq date (format-time-string date)))
- (date)
- (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
-
- (if (and date org-export-time-stamp-file)
- (insert (concat (nth 2 lang-words) ": " date"\n")))
-
- (unless (= (point) (point-min))
- (insert "\n\n")))
-
- (if (and org-export-with-toc (not body-only))
- (progn
- (push (concat (nth 3 lang-words) "\n") thetoc)
- (push (concat (make-string (string-width (nth 3 lang-words)) ?=)
- "\n") thetoc)
- (mapc #'(lambda (line)
- (if (string-match org-todo-line-regexp
- line)
- ;; This is a headline
- (progn
- (setq have-headings t)
- (setq level (- (match-end 1) (match-beginning 1)
- level-offset)
- level (org-tr-level level)
- txt (match-string 3 line)
- todo
- (or (and org-export-mark-todo-in-toc
- (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords)))
- ; TODO, not DONE
- (and org-export-mark-todo-in-toc
- (= level umax-toc)
- (org-search-todo-below
- line lines level))))
- (setq txt (org-html-expand-for-ascii txt))
-
- (while (string-match org-bracket-link-regexp txt)
- (setq txt
- (replace-match
- (match-string (if (match-end 2) 3 1) txt)
- t t txt)))
-
- (if (and (memq org-export-with-tags '(not-in-toc nil))
- (string-match
- (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$")
- txt))
- (setq txt (replace-match "" t t txt)))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt 1)))
-
- (if org-export-with-section-numbers
- (setq txt (concat (org-section-number level)
- " " txt)))
- (if (<= level umax-toc)
- (progn
- (push
- (concat
- (make-string
- (* (max 0 (- level org-min-level)) 4) ?\ )
- (format (if todo "%s (*)\n" "%s\n") txt))
- thetoc)
- (setq org-last-level level))
- ))))
- lines)
- (setq thetoc (if have-headings (nreverse thetoc) nil))))
-
- (org-init-section-numbers)
- (while (setq line (pop lines))
- (when (and link-buffer (string-match org-outline-regexp-bol line))
- (org-export-ascii-push-links (nreverse link-buffer))
- (setq link-buffer nil))
- (setq wrap nil)
- ;; Remove the quoted HTML tags.
- (setq line (org-html-expand-for-ascii line))
- ;; Replace links with the description when possible
- (while (string-match org-bracket-link-analytic-regexp++ line)
- (setq path (match-string 3 line)
- link (concat (match-string 1 line) path)
- type (match-string 2 line)
- desc0 (match-string 5 line)
- desc0 (replace-regexp-in-string "\\\\_" "_" desc0)
- desc (or desc0 link)
- desc (replace-regexp-in-string "\\\\_" "_" desc))
- (if (and (> (length link) 8)
- (equal (substring link 0 8) "coderef:"))
- (setq line (replace-match
- (format (org-export-get-coderef-format (substring link 8) desc)
- (cdr (assoc
- (substring link 8)
- org-export-code-refs)))
- t t line))
- (setq rpl (concat "[" desc "]"))
- (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- (setq rpl (or (save-match-data
- (funcall fnc (org-link-unescape path)
- desc0 'ascii))
- rpl))
- (when (and desc0 (not (equal desc0 link)))
- (if org-export-ascii-links-to-notes
- (push (cons desc0 link) link-buffer)
- (setq rpl (concat rpl " (" link ")")
- wrap (+ (length line) (- (length (match-string 0 line)))
- (length desc))))))
- (setq line (replace-match rpl t t line))))
- (when custom-times
- (setq line (org-translate-time line)))
- (cond
- ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
- ;; a Headline
- (setq first-heading-pos (or first-heading-pos (point)))
- (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
- level-offset))
- txt (match-string 2 line))
- (org-ascii-level-start level txt umax lines))
-
- ((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
- (if (not table-open)
- ;; New table starts
- (setq table-open t table-buffer nil))
- ;; Accumulate lines
- (setq table-buffer (cons line table-buffer))
- (when (or (not lines)
- (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
- (car lines))))
- (setq table-open nil
- table-buffer (nreverse table-buffer))
- (insert (mapconcat
- (lambda (x)
- (org-fix-indentation x org-ascii-current-indentation))
- (org-format-table-ascii table-buffer)
- "\n") "\n")))
- (t
- (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)"
- line)
- (setq line (replace-match "\\1\\3:" t nil line)))
- (setq line (org-fix-indentation line org-ascii-current-indentation))
- ;; Remove forced line breaks
- (if (string-match "\\\\\\\\[ \t]*$" line)
- (setq line (replace-match "" t t line)))
- (if (and org-export-with-fixed-width
- (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line))
- (setq line (replace-match "\\1" nil nil line))
- (if wrap (setq line (org-export-ascii-wrap line wrap))))
- (insert line "\n"))))
-
- (org-export-ascii-push-links (nreverse link-buffer))
-
- (normal-mode)
-
- ;; insert the table of contents
- (when thetoc
- (goto-char (point-min))
- (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t)
- (progn
- (goto-char (match-beginning 0))
- (replace-match ""))
- (goto-char first-heading-pos))
- (mapc 'insert thetoc)
- (or (looking-at "[ \t]*\n[ \t]*\n")
- (insert "\n\n")))
-
- ;; Convert whitespace place holders
- (goto-char (point-min))
- (let (beg end)
- (while (setq beg (next-single-property-change (point) 'org-whitespace))
- (setq end (next-single-property-change beg 'org-whitespace))
- (goto-char beg)
- (delete-region beg end)
- (insert (make-string (- end beg) ?\ ))))
-
- ;; remove display and invisible chars
- (let (beg end)
- (goto-char (point-min))
- (while (setq beg (next-single-property-change (point) 'display))
- (setq end (next-single-property-change beg 'display))
- (delete-region beg end)
- (goto-char beg)
- (insert "=>"))
- (goto-char (point-min))
- (while (setq beg (next-single-property-change (point) 'org-cwidth))
- (setq end (next-single-property-change beg 'org-cwidth))
- (delete-region beg end)
- (goto-char beg)))
- (run-hooks 'org-export-ascii-final-hook)
- (or to-buffer (save-buffer))
- (goto-char (point-min))
- (or (org-export-push-to-kill-ring "ASCII")
- (message "Exporting... done"))
- ;; Return the buffer or a string, according to how this function was called
- (if (eq to-buffer 'string)
- (prog1 (buffer-substring (point-min) (point-max))
- (kill-buffer (current-buffer)))
- (current-buffer))))
-
-;;;###autoload
-(defun org-export-ascii-preprocess (parameters)
- "Do extra work for ASCII export."
- ;;
- ;; Realign tables to get rid of narrowing
- (when org-export-ascii-table-widen-columns
- (let ((org-table-do-narrow nil))
- (goto-char (point-min))
- (org-ascii-replace-entities)
- (goto-char (point-min))
- (org-table-map-tables
- (lambda () (org-if-unprotected (org-table-align)))
- 'quietly)))
- ;; Put quotes around verbatim text
- (goto-char (point-min))
- (while (re-search-forward org-verbatim-re nil t)
- (org-if-unprotected-at (match-beginning 4)
- (goto-char (match-end 2))
- (backward-delete-char 1) (insert "'")
- (goto-char (match-beginning 2))
- (delete-char 1) (insert "`")
- (goto-char (match-end 2))))
- ;; Remove target markers
- (goto-char (point-min))
- (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t)
- (org-if-unprotected-at (match-beginning 1)
- (replace-match "\\1\\2")))
- ;; Remove list start counters
- (goto-char (point-min))
- (while (org-list-search-forward
- "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t)
- (replace-match ""))
- (remove-text-properties
- (point-min) (point-max)
- '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil)))
-
-(defun org-html-expand-for-ascii (line)
- "Handle quoted HTML for ASCII export."
- (if org-export-html-expand
- (while (string-match "@<[^<>\n]*>" line)
- ;; We just remove the tags for now.
- (setq line (replace-match "" nil nil line))))
- line)
-
-(defun org-ascii-replace-entities ()
- "Replace entities with the ASCII representation."
- (let (e)
- (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t)
- (org-if-unprotected-at (match-beginning 1)
- (setq e (org-entity-get-representation (match-string 1)
- org-export-ascii-entities))
- (and e (replace-match e t t))))))
-
-(defun org-export-ascii-wrap (line where)
- "Wrap LINE at or before WHERE."
- (let ((ind (org-get-indentation line))
- pos)
- (catch 'found
- (loop for i from where downto (/ where 2) do
- (and (equal (aref line i) ?\ )
- (setq pos i)
- (throw 'found t))))
- (if pos
- (concat (substring line 0 pos) "\n"
- (make-string ind ?\ )
- (substring line (1+ pos)))
- line)))
-
-(defun org-export-ascii-push-links (link-buffer)
- "Push out links in the buffer."
- (when link-buffer
- ;; We still have links to push out.
- (insert "\n")
- (let ((ind ""))
- (save-match-data
- (if (save-excursion
- (re-search-backward
- (concat "^\\(\\([ \t]*\\)\\|\\("
- org-outline-regexp
- "\\)\\)[^ \t\n]") nil t))
- (setq ind (or (match-string 2)
- (make-string (length (match-string 3)) ?\ )))))
- (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n"))
- link-buffer))
- (insert "\n")))
-
-(defun org-ascii-level-start (level title umax &optional lines)
- "Insert a new level in ASCII export."
- (let (char (n (- level umax 1)) (ind 0))
- (if (> level umax)
- (progn
- (insert (make-string (* 2 n) ?\ )
- (char-to-string (nth (% n (length org-export-ascii-bullets))
- org-export-ascii-bullets))
- " " title "\n")
- ;; find the indentation of the next non-empty line
- (catch 'stop
- (while lines
- (if (string-match "^\\* " (car lines)) (throw 'stop nil))
- (if (string-match "^\\([ \t]*\\)\\S-" (car lines))
- (throw 'stop (setq ind (org-get-indentation (car lines)))))
- (pop lines)))
- (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind)))
- (if (or (not (equal (char-before) ?\n))
- (not (equal (char-before (1- (point))) ?\n)))
- (insert "\n"))
- (setq char (or (nth (1- level) org-export-ascii-underline)
- (car (last org-export-ascii-underline))))
- (unless org-export-with-tags
- (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
- (setq title (replace-match "" t t title))))
- (if org-export-with-section-numbers
- (setq title (concat (org-section-number level) " " title)))
- (insert title "\n" (make-string (string-width title) char) "\n")
- (setq org-ascii-current-indentation '(0 . 0)))))
-
-(defun org-insert-centered (s &optional underline)
- "Insert the string S centered and underline it with character UNDERLINE."
- (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
- (insert (make-string ind ?\ ) s "\n")
- (if underline
- (insert (make-string ind ?\ )
- (make-string (string-width s) underline)
- "\n"))))
-
-(defvar org-table-colgroup-info nil)
-(defun org-format-table-ascii (lines)
- "Format a table for ascii export."
- (if (stringp lines)
- (setq lines (org-split-string lines "\n")))
- (if (not (string-match "^[ \t]*|" (car lines)))
- ;; Table made by table.el - test for spanning
- lines
-
- ;; A normal org table
- ;; Get rid of hlines at beginning and end
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (when org-export-table-remove-special-lines
- ;; Check if the table has a marking column. If yes remove the
- ;; column and the special lines
- (setq lines (org-table-clean-before-export lines)))
- ;; Get rid of the vertical lines except for grouping
- (if org-export-ascii-table-keep-all-vertical-lines
- lines
- (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info))
- rtn line vl1 start)
- (while (setq line (pop lines))
- (if (string-match org-table-hline-regexp line)
- (and (string-match "|\\(.*\\)|" line)
- (setq line (replace-match " \\1" t nil line)))
- (setq start 0 vl1 vl)
- (while (string-match "|" line start)
- (setq start (match-end 0))
- (or (pop vl1) (setq line (replace-match " " t t line)))))
- (push line rtn))
- (nreverse rtn)))))
-
-(defun org-colgroup-info-to-vline-list (info)
- (let (vl new last)
- (while info
- (setq last new new (pop info))
- (if (or (memq last '(:end :startend))
- (memq new '(:start :startend)))
- (push t vl)
- (push nil vl)))
- (setq vl (nreverse vl))
- (and vl (setcar vl nil))
- vl))
-
-(provide 'org-ascii)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-ascii.el ends here
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 3e665b79da8..71e2dbabdb2 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -1,6 +1,6 @@
;;; org-attach.el --- Manage file attachments to org-mode tasks
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@newartisans.com>
;; Keywords: org data task
@@ -41,6 +41,7 @@
(require 'cl))
(require 'org-id)
(require 'org)
+(require 'vc-git)
(defgroup org-attach nil
"Options concerning entry attachments in Org-mode."
@@ -54,6 +55,15 @@ where the Org file lives."
:group 'org-attach
:type 'directory)
+(defcustom org-attach-git-annex-cutoff (* 32 1024)
+ "If non-nil, files larger than this will be annexed instead of stored."
+ :group 'org-attach
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "None" nil)
+ (integer :tag "Bytes")))
+
(defcustom org-attach-auto-tag "ATTACH"
"Tag that will be triggered automatically when an entry has an attachment."
:group 'org-attach
@@ -198,7 +208,9 @@ the directory and (if necessary) the corresponding ID will be created."
(save-excursion
(save-restriction
(widen)
- (goto-char org-entry-property-inherited-from)
+ (if (marker-position org-entry-property-inherited-from)
+ (goto-char org-entry-property-inherited-from)
+ (org-back-to-heading t))
(let (org-attach-allow-inheritance)
(org-attach-dir create-if-not-exists-p)))))
(org-attach-check-absolute-path attach-dir)
@@ -252,18 +264,32 @@ the ATTACH_DIR property) their own attachment directory."
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
- (let ((dir (expand-file-name org-attach-directory)))
- (when (file-exists-p (expand-file-name ".git" dir))
+ (let* ((dir (expand-file-name org-attach-directory))
+ (git-dir (vc-git-root dir))
+ (changes 0))
+ (when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
- (shell-command "git add .")
- (shell-command "git ls-files --deleted" t)
- (mapc #'(lambda (file)
- (unless (string= file "")
- (shell-command
- (concat "git rm \"" file "\""))))
- (split-string (buffer-string) "\n"))
- (shell-command "git commit -m 'Synchronized attachments'")))))
+ (let ((have-annex
+ (and org-attach-git-annex-cutoff
+ (file-exists-p (expand-file-name "annex" git-dir)))))
+ (dolist (new-or-modified
+ (split-string
+ (shell-command-to-string
+ "git ls-files -zmo --exclude-standard") "\0" t))
+ (if (and have-annex
+ (>= (nth 7 (file-attributes new-or-modified))
+ org-attach-git-annex-cutoff))
+ (call-process "git" nil nil nil "annex" "add" new-or-modified)
+ (call-process "git" nil nil nil "add" new-or-modified))
+ (incf changes)))
+ (dolist (deleted
+ (split-string
+ (shell-command-to-string "git ls-files -z --deleted") "\0" t))
+ (call-process "git" nil nil nil "rm" deleted)
+ (incf changes))
+ (when (> changes 0)
+ (shell-command "git commit -m 'Synchronized attachments'"))))))
(defun org-attach-tag (&optional off)
"Turn the autotag on or (if OFF is set) off."
@@ -405,14 +431,14 @@ This ignores files starting with a \".\", and files ending in \"~\"."
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
- "Show the attachment directory of the current task in dired."
+ "Show the attachment directory of the current task.
+This will attempt to use an external program to show the directory."
(interactive "P")
(let ((attach-dir (org-attach-dir (not if-exists))))
(and attach-dir (org-open-file attach-dir))))
(defun org-attach-reveal-in-emacs ()
- "Show the attachment directory of the current task.
-This will attempt to use an external program to show the directory."
+ "Show the attachment directory of the current task in dired."
(interactive)
(let ((attach-dir (org-attach-dir t)))
(dired attach-dir)))
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index a45a26f0fe8..c4893850199 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -1,6 +1,6 @@
;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Authors: Carsten Dominik <carsten at orgmode dot org>
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
@@ -37,7 +37,7 @@
;; the diary using bbdb-anniv.el.
;;
;; Put the following in /somewhere/at/home/diary.org and make sure
-;; that this file is in `org-agenda-files`
+;; that this file is in `org-agenda-files'.
;;
;; %%(org-bbdb-anniversaries)
;;
@@ -116,8 +116,10 @@
(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout))
(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout))
-;; `bbdb-record-note' is part of BBDB v3.x
+;; `bbdb-record-note' was part of BBDB v3.x
(declare-function bbdb-record-note "ext:bbdb" (record label))
+;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+
+(declare-function bbdb-record-xfield "ext:bbdb" (record label))
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
@@ -306,14 +308,17 @@ The hash table is created on first use.")
"Create a hash with anniversaries extracted from BBDB, for fast access.
The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
(let ((old-bbdb (fboundp 'bbdb-record-getprop))
+ (record-func (if (fboundp 'bbdb-record-xfield)
+ 'bbdb-record-xfield
+ 'bbdb-record-note))
split tmp annivs)
(clrhash org-bbdb-anniv-hash)
(dolist (rec (bbdb-records))
(when (setq annivs (if old-bbdb
(bbdb-record-getprop
rec org-bbdb-anniversary-field)
- (bbdb-record-note
- rec org-bbdb-anniversary-field)))
+ (funcall record-func
+ rec org-bbdb-anniversary-field)))
(setq annivs (if old-bbdb
(bbdb-split annivs "\n")
;; parameter order is reversed in new bbdb
@@ -395,8 +400,11 @@ This is used by Org to re-create the anniversary hash table."
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."
(require 'bbdb-com)
- (concat "bbdb:"
- (bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
+ (let ((rec (bbdb-completing-read-record "Name: ")))
+ (concat "bbdb:"
+ (bbdb-record-name (if (listp rec)
+ (car rec)
+ rec)))))
(defun org-bbdb-anniv-export-ical ()
"Extract anniversaries from BBDB and convert them to icalendar format."
diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el
deleted file mode 100644
index 78b57a4c005..00000000000
--- a/lisp/org/org-beamer.el
+++ /dev/null
@@ -1,657 +0,0 @@
-;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
-;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
-;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
-;; Keywords: org, wp, tex
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library implement the special treatment needed by using the
-;; beamer class during LaTeX export.
-
-;;; Code:
-
-(require 'org)
-(require 'org-exp)
-
-(defvar org-export-latex-header)
-(defvar org-export-latex-options-plist)
-(defvar org-export-opt-plist)
-
-(defgroup org-beamer nil
- "Options specific for using the beamer class in LaTeX export."
- :tag "Org Beamer"
- :group 'org-export-latex)
-
-(defcustom org-beamer-use-parts nil
- ""
- :group 'org-beamer
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-beamer-frame-level 1
- "The level that should be interpreted as a frame.
-The levels above this one will be translated into a sectioning structure.
-Setting this to 2 will allow sections, 3 will allow subsections as well.
-You can set this to 4 as well, if you at the same time set
-`org-beamer-use-parts' to make the top levels `\part'."
- :group 'org-beamer
- :version "24.1"
- :type '(choice
- (const :tag "Frames need a BEAMER_env property" nil)
- (integer :tag "Specific level makes a frame")))
-
-(defcustom org-beamer-frame-default-options ""
- "Default options string to use for frames, should contains the [brackets].
-And example for this is \"[allowframebreaks]\"."
- :group 'org-beamer
- :version "24.1"
- :type '(string :tag "[options]"))
-
-(defcustom org-beamer-column-view-format
- "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)"
- "Default column view format that should be used to fill the template."
- :group 'org-beamer
- :version "24.1"
- :type '(choice
- (const :tag "Do not insert Beamer column view format" nil)
- (string :tag "Beamer column view format")))
-
-(defcustom org-beamer-themes
- "\\usetheme{default}\\usecolortheme{default}"
- "Default string to be used for extra heading stuff in beamer presentations.
-When a beamer template is filled, this will be the default for
-BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
- :group 'org-beamer
- :version "24.1"
- :type '(choice
- (const :tag "Do not insert Beamer themes" nil)
- (string :tag "Beamer themes")))
-
-(defconst org-beamer-column-widths
- "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
- "The column widths that should be installed as allowed property values.")
-
-(defconst org-beamer-transitions
- "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
- "Transitions available for beamer.
-These are just a completion help.")
-
-(defconst org-beamer-environments-default
- '(("frame" "f" "dummy- special handling hard coded" "dummy")
- ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}")
- ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}")
- ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}")
- ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}")
- ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}")
- ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}")
- ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}")
- ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}")
- ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
- ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
- ("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
- ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
- ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
- ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
- ("normal" "h" "%h" "") ; Emit the heading as normal text
- ("note" "n" "\\note%o%a{%h" "}")
- ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading
- ("ignoreheading" "i" "%%%% %h" ""))
- "Environments triggered by properties in Beamer export.
-These are the defaults - for user definitions, see
-`org-beamer-environments-extra'.
-\"normal\" is a special fake environment, which emit the heading as
-normal text. It is needed when an environment should be surrounded
-by normal text. Since beamer export converts nodes into environments,
-you need to have a node to end the environment.
-For example
-
- ** a frame
- some text
- *** Blocktitle :B_block:
- inside the block
- *** After the block :B_normal:
- continuing here
- ** next frame")
-
-(defcustom org-beamer-environments-extra nil
- "Environments triggered by tags in Beamer export.
-Each entry has 4 elements:
-
-name Name of the environment
-key Selection key for `org-beamer-select-environment'
-open The opening template for the environment, with the following escapes
- %a the action/overlay specification
- %A the default action/overlay specification
- %o the options argument of the template
- %h the headline text
- %H if there is headline text, that text in {} braces
- %U if there is headline text, that text in [] brackets
- %x the content of the BEAMER_extra property
-close The closing string of the environment."
-
- :group 'org-beamer
- :version "24.1"
- :type '(repeat
- (list
- (string :tag "Environment")
- (string :tag "Selection key")
- (string :tag "Begin")
- (string :tag "End"))))
-
-(defcustom org-beamer-inherited-properties nil
- "Properties that should be inherited during beamer export."
- :group 'org-beamer
- :type '(repeat
- (string :tag "Property")))
-
-(defvar org-beamer-frame-level-now nil)
-(defvar org-beamer-header-extra nil)
-(defvar org-beamer-export-is-beamer-p nil)
-(defvar org-beamer-inside-frame-at-level nil)
-(defvar org-beamer-columns-open nil)
-(defvar org-beamer-column-open nil)
-
-(defun org-beamer-cleanup-column-width (width)
- "Make sure the width is not empty, and that it has a unit."
- (setq width (org-trim (or width "")))
- (unless (string-match "\\S-" width) (setq width "0.5"))
- (if (string-match "\\`[.0-9]+\\'" width)
- (setq width (concat width "\\textwidth")))
- width)
-
-(defun org-beamer-open-column (&optional width opt)
- (org-beamer-close-column-maybe)
- (setq org-beamer-column-open t)
- (setq width (org-beamer-cleanup-column-width width))
- (insert (format "\\begin{column}%s{%s}\n" (or opt "") width)))
-(defun org-beamer-close-column-maybe ()
- (when org-beamer-column-open
- (setq org-beamer-column-open nil)
- (insert "\\end{column}\n")))
-(defun org-beamer-open-columns-maybe (&optional opts)
- (unless org-beamer-columns-open
- (setq org-beamer-columns-open t)
- (insert (format "\\begin{columns}%s\n" (or opts "")))))
-(defun org-beamer-close-columns-maybe ()
- (org-beamer-close-column-maybe)
- (when org-beamer-columns-open
- (setq org-beamer-columns-open nil)
- (insert "\\end{columns}\n")))
-
-(defun org-beamer-select-environment ()
- "Select the environment to be used by beamer for this entry.
-While this uses (for convenience) a tag selection interface, the result
-of this command will be that the BEAMER_env *property* of the entry is set.
-
-In addition to this, the command will also set a tag as a visual aid, but
-the tag does not have any semantic meaning."
- (interactive)
- (let* ((envs (append org-beamer-environments-extra
- org-beamer-environments-default))
- (org-tag-alist
- (append '((:startgroup))
- (mapcar (lambda (e) (cons (concat "B_" (car e))
- (string-to-char (nth 1 e))))
- envs)
- '((:endgroup))
- '(("BMCOL" . ?|))))
- (org-fast-tag-selection-single-key t))
- (org-set-tags)
- (let ((tags (or (ignore-errors (org-get-tags-string)) "")))
- (cond
- ((equal org-last-tag-selection-key ?|)
- (if (string-match ":BMCOL:" tags)
- (org-set-property "BEAMER_col" (read-string "Column width: "))
- (org-delete-property "BEAMER_col")))
- ((string-match (concat ":B_\\("
- (mapconcat 'car envs "\\|")
- "\\):")
- tags)
- (org-entry-put nil "BEAMER_env" (match-string 1 tags)))
- (t (org-entry-delete nil "BEAMER_env"))))))
-
-;;;###autoload
-(defun org-beamer-sectioning (level text)
- "Return the sectioning entry for the current headline.
-LEVEL is the reduced level of the headline.
-TEXT is the text of the headline, everything except the leading stars.
-The return value is a cons cell. The car is the headline text, usually
-just TEXT, but possibly modified if options have been extracted from the
-text. The cdr is the sectioning entry, similar to what is given
-in org-export-latex-classes."
- (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level))
- (default
- (if org-beamer-use-parts
- '((1 . ("\\part{%s}" . "\\part*{%s}"))
- (2 . ("\\section{%s}" . "\\section*{%s}"))
- (3 . ("\\subsection{%s}" . "\\subsection*{%s}")))
- '((1 . ("\\section{%s}" . "\\section*{%s}"))
- (2 . ("\\subsection{%s}" . "\\subsection*{%s}")))))
- (envs (append org-beamer-environments-extra
- org-beamer-environments-default))
- (props (org-get-text-property-any 0 'org-props text))
- (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra
- columns-option column-option
- env have-text ass tmp)
- (if (= frame-level 0) (setq frame-level nil))
- (when (and org-beamer-inside-frame-at-level
- (<= level org-beamer-inside-frame-at-level))
- (setq org-beamer-inside-frame-at-level nil))
- (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props))
- (if (and (string-match "\\`[0-9.]+\\'" tmp)
- (or (= (string-to-number tmp) 1.0)
- (= (string-to-number tmp) 0.0)))
- ;; column width 1 means close columns, go back to full width
- (org-beamer-close-columns-maybe)
- (when (setq ass (assoc "BEAMER_envargs" props))
- (let (case-fold-search)
- (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
- (setq columns-option (match-string 1 (cdr ass)))
- (setcdr ass (replace-match "" t t (cdr ass))))
- (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass))
- (setq column-option (match-string 1 (cdr ass)))
- (setcdr ass (replace-match "" t t (cdr ass))))))
- (org-beamer-open-columns-maybe columns-option)
- (org-beamer-open-column tmp column-option)))
- (cond
- ((or (equal (cdr (assoc "BEAMER_env" props)) "frame")
- (and frame-level (= level frame-level)))
- ;; A frame
- (org-beamer-get-special props)
-
- (setq in (org-fill-template
- "\\begin{frame}%a%A%o%T%S%x"
- (list (cons "a" (or org-beamer-action ""))
- (cons "A" (or org-beamer-defaction ""))
- (cons "o" (or org-beamer-option org-beamer-frame-default-options ""))
- (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
- (cons "h" "%s")
- (cons "T" (if (string-match "\\S-" text)
- "\n\\frametitle{%s}" ""))
- (cons "S" (if (string-match "\\\\\\\\" text)
- "\n\\framesubtitle{%s}" ""))))
- out (copy-sequence "\\end{frame}"))
- (org-add-props out
- '(org-insert-hook org-beamer-close-columns-maybe))
- (setq org-beamer-inside-frame-at-level level)
- (cons text (list in out in out)))
- ((and (setq env (cdr (assoc "BEAMER_env" props)))
- (setq ass (assoc env envs)))
- ;; A beamer environment selected by the BEAMER_env property
- (if (string-match "[ \t]+:[ \t]*$" text)
- (setq text (replace-match "" t t text)))
- (if (member env '("note" "noteNH"))
- ;; There should be no labels in a note, so we remove the targets
- ;; FIXME???
- (remove-text-properties 0 (length text) '(target nil) text))
- (org-beamer-get-special props)
- (setq text (org-trim text))
- (setq have-text (string-match "\\S-" text))
- (setq in (org-fill-template
- (nth 2 ass)
- (list (cons "a" (or org-beamer-action ""))
- (cons "A" (or org-beamer-defaction ""))
- (cons "o" (or org-beamer-option ""))
- (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) ""))
- (cons "h" "%s")
- (cons "H" (if have-text (concat "{" text "}") ""))
- (cons "U" (if have-text (concat "[" text "]") ""))))
- out (nth 3 ass))
- (cond
- ((equal out "\\end{columns}")
- (setq org-beamer-columns-open t)
- (setq out (org-add-props (copy-sequence out)
- '(org-insert-hook
- (lambda ()
- (org-beamer-close-column-maybe)
- (setq org-beamer-columns-open nil))))))
- ((equal out "\\end{column}")
- (org-beamer-open-columns-maybe)))
- (cons text (list in out in out)))
- ((and (not org-beamer-inside-frame-at-level)
- (or (not frame-level)
- (< level frame-level))
- (assoc level default))
- ;; Normal sectioning
- (cons text (cdr (assoc level default))))
- (t nil))))
-
-(defvar org-beamer-extra)
-(defvar org-beamer-option)
-(defvar org-beamer-action)
-(defvar org-beamer-defaction)
-(defvar org-beamer-environment)
-(defun org-beamer-get-special (props)
- "Extract an option, action, and default action string from text.
-The variables org-beamer-option, org-beamer-action, org-beamer-defaction,
-org-beamer-extra are all scoped into this function dynamically."
- (let (tmp)
- (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props))
- (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props))
- (when org-beamer-extra
- (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra)))
- (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props))
- (when tmp
- (setq tmp (copy-sequence tmp))
- (if (string-match "\\[<[^][<>]*>\\]" tmp)
- (setq org-beamer-defaction (match-string 0 tmp)
- tmp (replace-match "" t t tmp)))
- (if (string-match "\\[[^][]*\\]" tmp)
- (setq org-beamer-option (match-string 0 tmp)
- tmp (replace-match "" t t tmp)))
- (if (string-match "<[^<>]*>" tmp)
- (setq org-beamer-action (match-string 0 tmp)
- tmp (replace-match "" t t tmp))))))
-
-(defun org-beamer-assoc-not-empty (elt list)
- (let ((tmp (cdr (assoc elt list))))
- (and tmp (string-match "\\S-" tmp) tmp)))
-
-
-(defvar org-beamer-mode-map (make-sparse-keymap)
- "The keymap for `org-beamer-mode'.")
-(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
-
-;;;###autoload
-(define-minor-mode org-beamer-mode
- "Special support for editing Org-mode files made to export to beamer."
- nil " Bm" nil)
-(when (fboundp 'font-lock-add-keywords)
- (font-lock-add-keywords
- 'org-mode
- '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend))
- 'prepent))
-
-(defun org-beamer-place-default-actions-for-lists ()
- "Find default overlay specifications in items, and move them.
-The need to be after the begin statement of the environment."
- (when org-beamer-export-is-beamer-p
- (let (dovl)
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t)
- (if (setq dovl (cdr (assoc "BEAMER_dovl"
- (get-text-property (match-end 0)
- 'org-props))))
- (save-excursion
- (goto-char (1+ (match-end 1)))
- (insert dovl)))))))
-
-(defun org-beamer-amend-header ()
- "Add `org-beamer-header-extra' to the LaTeX header.
-If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line
-by itself, it will be replaced with `org-beamer-header-extra'. If not,
-the value will be inserted right after the documentclass statement."
- (when (and org-beamer-export-is-beamer-p
- org-beamer-header-extra)
- (goto-char (point-min))
- (cond
- ((re-search-forward
- "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t)
- (replace-match org-beamer-header-extra t t)
- (or (bolp) (insert "\n")))
- ((re-search-forward "^[ \t]*\\\\begin{document}" nil t)
- (beginning-of-line 1)
- (insert org-beamer-header-extra)
- (or (bolp) (insert "\n"))))))
-
-(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}"
- "If this regexp matches in a frame, the frame is marked as fragile."
- :group 'org-beamer
- :version "24.1"
- :type 'regexp)
-
-(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
- "The special face for beamer tags."
- :group 'org-beamer)
-
-
-;; Functions to initialize and post-process
-;; These functions will be hooked into various places in the export process
-
-(defun org-beamer-initialize-open-trackers ()
- "Reset variables that track if certain environments are open during export."
- (setq org-beamer-columns-open nil)
- (setq org-beamer-column-open nil)
- (setq org-beamer-inside-frame-at-level nil)
- (setq org-beamer-export-is-beamer-p nil))
-
-(defun org-beamer-after-initial-vars ()
- "Find special settings for beamer and store them.
-The effect is that these values will be accessible during export."
- ;; First verify that we are exporting using the beamer class
- (setq org-beamer-export-is-beamer-p
- (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}"
- org-export-latex-header))
- (when org-beamer-export-is-beamer-p
- ;; Find the frame level
- (setq org-beamer-frame-level-now
- (or (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (and (looking-at org-complex-heading-regexp)
- (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective))))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (and (re-search-forward
- "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t)
- (match-string 1))))
- (plist-get org-export-latex-options-plist :beamer-frame-level)
- org-beamer-frame-level))
- ;; Normalize the value so that the functions can trust the value
- (cond
- ((not org-beamer-frame-level-now)
- (setq org-beamer-frame-level-now nil))
- ((stringp org-beamer-frame-level-now)
- (setq org-beamer-frame-level-now
- (string-to-number org-beamer-frame-level-now))))
- ;; Find the header additions, most likely theme commands
- (setq org-beamer-header-extra
- (or (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (and (looking-at org-complex-heading-regexp)
- (org-entry-get nil "BEAMER_HEADER_EXTRA"
- 'selective))))
- (save-excursion
- (save-restriction
- (widen)
- (let ((txt ""))
- (goto-char (point-min))
- (while (re-search-forward
- "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$"
- nil t)
- (setq txt (concat txt "\n" (match-string 1))))
- (if (> (length txt) 0) (substring txt 1)))))
- (plist-get org-export-latex-options-plist
- :beamer-header-extra)))
- (let ((inhibit-read-only t)
- (case-fold-search nil)
- props)
- (org-unmodified
- (remove-text-properties (point-min) (point-max) '(org-props nil))
- (org-map-entries
- '(progn
- (setq props (org-entry-properties nil 'standard))
- (if (and (not (assoc "BEAMER_env" props))
- (looking-at ".*?:B_\\(note\\(NH\\)?\\):"))
- (push (cons "BEAMER_env" (match-string 1)) props))
- (when (org-bound-and-true-p org-beamer-inherited-properties)
- (mapc (lambda (p)
- (unless (assoc p props)
- (let ((v (org-entry-get nil p 'inherit)))
- (and v (push (cons p v) props)))))
- org-beamer-inherited-properties))
- (put-text-property (point-at-bol) (point-at-eol) 'org-props props)))
- (setq org-export-latex-options-plist
- (plist-put org-export-latex-options-plist :tags nil))))))
-
-(defun org-beamer-auto-fragile-frames ()
- "Mark any frames containing verbatim environments as fragile.
-This function will run in the final LaTeX document."
- (when org-beamer-export-is-beamer-p
- (let (opts)
- (goto-char (point-min))
- ;; Find something that might be fragile
- (while (re-search-forward org-beamer-fragile-re nil t)
- (save-excursion
- ;; Are we inside a frame here?
- (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?"
- nil t)
- (equal (match-string 1) "begin"))
- ;; yes, inside a frame, make sure "fragile" is one of the options
- (goto-char (match-end 0))
- (if (not (looking-at "\\[.*?\\]"))
- (insert "[fragile]")
- (setq opts (substring (match-string 0) 1 -1))
- (delete-region (match-beginning 0) (match-end 0))
- (setq opts (org-split-string opts ","))
- (add-to-list 'opts "fragile")
- (insert "[" (mapconcat 'identity opts ",") "]"))))))))
-
-(defcustom org-beamer-outline-frame-title "Outline"
- "Default title of a frame containing an outline."
- :group 'org-beamer
- :version "24.1"
- :type '(string :tag "Outline frame title")
- )
-
-(defcustom org-beamer-outline-frame-options nil
- "Outline frame options appended after \\begin{frame}.
-You might want to put e.g. [allowframebreaks=0.9] here. Remember to
-include square brackets."
- :group 'org-beamer
- :version "24.1"
- :type '(string :tag "Outline frame options")
- )
-
-(defun org-beamer-fix-toc ()
- "Fix the table of contents by removing the vspace line."
- (when org-beamer-export-is-beamer-p
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)"
- nil t)
- (replace-match
- (concat "\\\\begin{frame}" org-beamer-outline-frame-options
- "\n\\\\frametitle{"
- org-beamer-outline-frame-title
- "}\n\\1\\\\end{frame}")
- t nil)))))
-
-(defun org-beamer-property-changed (property value)
- "Track the BEAMER_env property with tags."
- (cond
- ((equal property "BEAMER_env")
- (save-excursion
- (org-back-to-heading t)
- (let ((tags (org-get-tags)))
- (setq tags (delq nil (mapcar (lambda (x)
- (if (string-match "^B_" x) nil x))
- tags)))
- (org-set-tags-to tags))
- (when (and value (stringp value) (string-match "\\S-" value))
- (org-toggle-tag (concat "B_" value) 'on))))
- ((equal property "BEAMER_col")
- (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value))
- 'on 'off)))))
-
-(defun org-beamer-select-beamer-code ()
- "Take code marked for BEAMER and turn it into marked for LaTeX."
- (when org-beamer-export-is-beamer-p
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t)
- (replace-match "\\1latex"))))
-
-;; OK, hook all these functions into appropriate places
-(add-hook 'org-export-first-hook
- 'org-beamer-initialize-open-trackers)
-(add-hook 'org-property-changed-functions
- 'org-beamer-property-changed)
-(add-hook 'org-export-latex-after-initial-vars-hook
- 'org-beamer-after-initial-vars)
-(add-hook 'org-export-latex-final-hook
- 'org-beamer-place-default-actions-for-lists)
-(add-hook 'org-export-latex-final-hook
- 'org-beamer-auto-fragile-frames)
-(add-hook 'org-export-latex-final-hook
- 'org-beamer-fix-toc)
-(add-hook 'org-export-latex-final-hook
- 'org-beamer-amend-header)
-(add-hook 'org-export-preprocess-before-selecting-backend-code-hook
- 'org-beamer-select-beamer-code)
-
-(defun org-insert-beamer-options-template (&optional kind)
- "Insert a settings template, to make sure users do this right."
- (interactive (progn
- (message "Current [s]ubtree or [g]lobal?")
- (if (equal (read-char-exclusive) ?g)
- (list 'global)
- (list 'subtree))))
- (if (eq kind 'subtree)
- (progn
- (org-back-to-heading t)
- (org-reveal)
- (org-entry-put nil "LaTeX_CLASS" "beamer")
- (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]")
- (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
- (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string
- org-beamer-frame-level))
- (when org-beamer-themes
- (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes))
- (when org-beamer-column-view-format
- (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
- (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC"))
- (insert "#+LaTeX_CLASS: beamer\n")
- (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
- (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n")
- (when org-beamer-themes
- (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n"))
- (when org-beamer-column-view-format
- (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
- (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n")))
-
-
-(defun org-beamer-allowed-property-values (property)
- "Supply allowed values for BEAMER properties."
- (cond
- ((and (equal property "BEAMER_env")
- (not (org-entry-get nil (concat property "_ALL") 'inherit)))
- ;; If no allowed values for BEAMER_env have been defined,
- ;; supply all defined environments
- (mapcar 'car (append org-beamer-environments-extra
- org-beamer-environments-default)))
- ((and (equal property "BEAMER_col")
- (not (org-entry-get nil (concat property "_ALL") 'inherit)))
- ;; If no allowed values for BEAMER_col have been defined,
- ;; supply some
- '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC"))
- (t nil)))
-
-(add-hook 'org-property-allowed-value-functions
- 'org-beamer-allowed-property-values)
-
-(provide 'org-beamer)
-
-;;; org-beamer.el ends here
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index 6ed6abc42b5..7227803e6be 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -1,11 +1,11 @@
;;; org-bibtex.el --- Org links to BibTeX entries
;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;;
-;; Authors: Bastien Guerry <bzg at altern dot org>
+;; Authors: Bastien Guerry <bzg@gnu.org>
;; Carsten Dominik <carsten dot dominik at gmail dot com>
;; Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: org, wp, remember
+;; Keywords: org, wp, capture
;;
;; This file is part of GNU Emacs.
;;
@@ -31,7 +31,7 @@
;; the link that contains the author name, the year and a short title.
;;
;; It also stores detailed information about the entry so that
-;; remember templates can access and enter this information easily.
+;; capture templates can access and enter this information easily.
;;
;; The available properties for each entry are listed here:
;;
@@ -41,14 +41,14 @@
;; :booktitle :month :annote :abstract
;; :key :btype
;;
-;; Here is an example of a remember template that use some of this
+;; Here is an example of a capture template that use some of this
;; information (:author :year :title :journal :pages):
;;
-;; (setq org-remember-templates
+;; (setq org-capture-templates
;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \
;; In %:journal, %:pages.")))
;;
-;; Let's say you want to remember this BibTeX entry:
+;; Let's say you want to capture this BibTeX entry:
;;
;; @Article{dolev83,
;; author = {Danny Dolev and Andrew C. Yao},
@@ -61,7 +61,7 @@
;; month = {Mars}
;; }
;;
-;; M-x `org-remember' on this entry will produce this buffer:
+;; M-x `org-capture' on this entry will produce this buffer:
;;
;; =====================================================================
;; * READ <== [point here]
@@ -94,7 +94,7 @@
;;
;; The link creation part has been part of Org-mode for a long time.
;;
-;; Creating better remember template information was inspired by a request
+;; Creating better capture template information was inspired by a request
;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112
;; and then implemented by Bastien Guerry.
;;
@@ -195,7 +195,7 @@
(:howpublished . "How something strange has been published. The first word should be capitalized.")
(:institution . "The sponsoring institution of a technical report.")
(:journal . "A journal name.")
- (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.")
+ (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \\cite command and at the beginning of the database entry.")
(:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,")
(:note . "Any additional information that can help the reader. The first word should be capitalized.")
(:number . "Any additional information that can help the reader. The first word should be capitalized.")
@@ -203,7 +203,7 @@
(:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
(:publisher . "The publisher’s name.")
(:school . "The name of the school where a thesis was written.")
- (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
+ (:series . "The name of a series or set of books. When citing an entire book, the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:volume . "The volume of a journal or multi-volume book.")
@@ -221,10 +221,12 @@
(defcustom org-bibtex-prefix nil
"Optional prefix for all bibtex property names.
-For example setting to 'BIB_' would allow interoperability with fireforg."
+For example setting to `BIB_' would allow interoperability with fireforg."
:group 'org-bibtex
:version "24.1"
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
@@ -277,7 +279,7 @@ not be exported."
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
-This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
+This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
:group 'org-bibtex
:version "24.1"
:type '(repeat :tag "Tag" (string)))
@@ -291,12 +293,13 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
;;; Utility functions
(defun org-bibtex-get (property)
- ((lambda (it) (when it (org-babel-trim it)))
- (let ((org-special-properties
- (delete "FILE" (copy-sequence org-special-properties))))
- (or
- (org-entry-get (point) (upcase property))
- (org-entry-get (point) (concat org-bibtex-prefix (upcase property)))))))
+ (let ((it (let ((org-special-properties
+ (delete "FILE" (copy-sequence org-special-properties))))
+ (or
+ (org-entry-get (point) (upcase property))
+ (org-entry-get (point) (concat org-bibtex-prefix
+ (upcase property)))))))
+ (when it (org-babel-trim it))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
@@ -368,7 +371,9 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
(bibtex-beginning-of-entry)
(if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t)
(progn (goto-char (match-end 1)) (insert ", "))
- (bibtex-make-field "keywords" t t))
+ (search-forward ",\n" nil t)
+ (insert " keywords={},\n")
+ (search-backward "}," nil t))
(insert (mapconcat #'identity tags ", ")))
(buffer-string))))))
@@ -382,8 +387,8 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t."
(princ (cdr (assoc field org-bibtex-fields))))
(with-current-buffer buf-name (visual-line-mode 1))
(org-fit-window-to-buffer (get-buffer-window buf-name))
- ((lambda (result) (when (> (length result) 0) result))
- (read-from-minibuffer (format "%s: " name))))))
+ (let ((result (read-from-minibuffer (format "%s: " name))))
+ (when (> (length result) 0) result)))))
(defun org-bibtex-autokey ()
"Generate an autokey for the current headline."
@@ -531,26 +536,27 @@ With optional argument OPTIONAL, also prompt for optional fields."
;;; Bibtex <-> Org-mode headline translation functions
(defun org-bibtex (&optional filename)
"Export each headline in the current file to a bibtex entry.
-Headlines are exported using `org-bibtex-export-headline'."
+Headlines are exported using `org-bibtex-headline'."
(interactive
(list (read-file-name
"Bibtex file: " nil nil nil
(file-name-nondirectory
(concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
- ((lambda (error-point)
- (when error-point
- (goto-char error-point)
- (message "Bibtex error at %S" (nth 4 (org-heading-components)))))
- (catch 'bib
- (let ((bibtex-entries (remove nil (org-map-entries
- (lambda ()
- (condition-case foo
- (org-bibtex-headline)
- (error (throw 'bib (point)))))))))
- (with-temp-file filename
- (insert (mapconcat #'identity bibtex-entries "\n")))
- (message "Successfully exported %d BibTeX entries to %s"
- (length bibtex-entries) filename) nil))))
+ (let ((error-point
+ (catch 'bib
+ (let ((bibtex-entries
+ (remove nil (org-map-entries
+ (lambda ()
+ (condition-case foo
+ (org-bibtex-headline)
+ (error (throw 'bib (point)))))))))
+ (with-temp-file filename
+ (insert (mapconcat #'identity bibtex-entries "\n")))
+ (message "Successfully exported %d BibTeX entries to %s"
+ (length bibtex-entries) filename) nil))))
+ (when error-point
+ (goto-char error-point)
+ (message "Bibtex error at %S" (nth 4 (org-heading-components))))))
(defun org-bibtex-check (&optional optional)
"Check the current headline for required fields.
@@ -558,8 +564,8 @@ With prefix argument OPTIONAL also prompt for optional fields."
(interactive "P")
(save-restriction
(org-narrow-to-subtree)
- (let ((type ((lambda (name) (when name (intern (concat ":" name))))
- (org-bibtex-get org-bibtex-type-property-name))))
+ (let ((type (let ((name (org-bibtex-get org-bibtex-type-property-name)))
+ (when name (intern (concat ":" name))))))
(when type (org-bibtex-fleshout type optional)))))
(defun org-bibtex-check-all (&optional optional)
@@ -609,7 +615,8 @@ This uses `bibtex-parse-entry'."
(strip-delim
(lambda (str) ; strip enclosing "..." and {...}
(dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
- (when (and (= (aref str 0) (car pair))
+ (when (and (> (length str) 1)
+ (= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
(setf str (substring str 1 (1- (length str)))))) str)))
(push (mapcar
@@ -623,6 +630,27 @@ This uses `bibtex-parse-entry'."
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
org-bibtex-entries)))
+(defun org-bibtex-read-buffer (buffer)
+ "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.
+Return the number of saved entries."
+ (interactive "bbuffer: ")
+ (let ((start-length (length org-bibtex-entries)))
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ (while (not (= (point) (point-min)))
+ (backward-char 1)
+ (org-bibtex-read)
+ (bibtex-beginning-of-entry))))
+ (let ((added (- (length org-bibtex-entries) start-length)))
+ (message "parsed %d entries" added)
+ added)))
+
+(defun org-bibtex-read-file (file)
+ "Read FILE with `org-bibtex-read-buffer'."
+ (interactive "ffile: ")
+ (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
+
(defun org-bibtex-write ()
"Insert a heading built from the first element of `org-bibtex-entries'."
(interactive)
@@ -664,6 +692,14 @@ This uses `bibtex-parse-entry'."
(org-bibtex-write)
(error "Yanked text does not appear to contain a BibTeX entry"))))
+(defun org-bibtex-import-from-file (file)
+ "Read bibtex entries from FILE and insert as Org-mode headlines after point."
+ (interactive "ffile: ")
+ (dotimes (_ (org-bibtex-read-file file))
+ (save-excursion (org-bibtex-write))
+ (re-search-forward org-property-end-re)
+ (open-line 1) (forward-char 1)))
+
(defun org-bibtex-export-to-kill-ring ()
"Export current headline to kill ring as bibtex entry."
(interactive)
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index 8a271b8d055..6a4b2bafb01 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1,6 +1,6 @@
;;; org-capture.el --- Fast note taking in Org-mode
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -24,14 +24,14 @@
;;
;;; Commentary:
-;; This file contains an alternative implementation of the same functionality
-;; that is also provided by org-remember.el. The implementation is more
+;; This file contains an alternative implementation of the functionality
+;; that used to be provided by org-remember.el. The implementation is more
;; streamlined, can produce more target types (e.g. plain list items or
;; table lines). Also, it does not use a temporary buffer for editing
;; the captured entry - instead it uses an indirect buffer that visits
;; the new entry already in the target buffer (this was an idea by Samuel
-;; Wales). John Wiegley's excellent `remember.el' is not needed for this
-;; implementation, even though we borrow heavily from its ideas.
+;; Wales). John Wiegley's excellent `remember.el' is not needed anymore
+;; for this implementation, even though we borrow heavily from its ideas.
;; This implementation heavily draws on ideas by James TD Smith and
;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration.
@@ -50,7 +50,6 @@
(eval-when-compile
(require 'cl))
(require 'org)
-(require 'org-mks)
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
@@ -182,6 +181,8 @@ properties are:
template only needs information that can be added
automatically.
+ :jump-to-captured When set, jump to the captured entry when finished.
+
:empty-lines Set this to the number of lines the should be inserted
before and after the new item. Default 0, only common
other value is 1.
@@ -200,7 +201,7 @@ properties are:
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
- When setting both to `t', the current clock will run and
+ When setting both to t, the current clock will run and
the previous one will not be resumed.
:unnarrowed Do not narrow the target buffer, simply show the
@@ -223,7 +224,9 @@ freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded in this order:
%[pathname] Insert the contents of the file given by `pathname'.
- %(sexp) Evaluate elisp `(sexp)' and replace with the result.
+ %(sexp) Evaluate elisp `(sexp)' and replace it with the results.
+ For convenience, %:keyword (see below) placeholders within
+ the expression will be expanded prior to this.
%<...> The result of format-time-string on the ... format specification.
%t Time stamp, date only.
%T Time stamp with date and time.
@@ -237,7 +240,7 @@ be replaced with content and expanded in this order:
%x Content of the X clipboard.
%k Title of currently clocked task.
%K Link to currently clocked task.
- %n User name (taken from `user-full-name').
+ %n User name (taken from the variable `user-full-name').
%f File visited by current buffer when org-capture was called.
%F Full path of the file or directory visited by current buffer.
%:keyword Specific information for certain link types, see below.
@@ -338,11 +341,15 @@ calendar | %:type %:date"
;; Give the most common options as checkboxes
:options (((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
+ ((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
+ ((const :format "%v " :empty-lines-before) (const 1))
+ ((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :unnarrowed) (const t))
+ ((const :format "%v " :table-line-pos) (const t))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-capture-before-finalize-hook nil
@@ -427,7 +434,8 @@ Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Rem" org-capture-mode-map
(org-set-local
'header-line-format
- "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))
+ (substitute-command-keys
+ "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
@@ -439,6 +447,7 @@ Turning on this mode runs the normal hook `org-capture-mode-hook'."
;;;###autoload
(defun org-capture-string (string &optional keys)
+ "Capture STRING with the template selected by KEYS."
(interactive "sInitial text: \n")
(let ((org-capture-initial string)
(org-capture-entry (org-capture-select-template keys)))
@@ -451,7 +460,7 @@ For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:
- '((\"c\" ((in-mode . \"message-mode\"))))
+ ((\"c\" ((in-mode . \"message-mode\"))))
Here are the available contexts definitions:
@@ -459,6 +468,8 @@ Here are the available contexts definitions:
in-mode: command displayed only in matching modes
not-in-file: command not displayed in matching files
not-in-mode: command not displayed in matching modes
+ in-buffer: command displayed only in matching buffers
+not-in-buffer: command not displayed in matching buffers
[function]: a custom function taking no argument
If you define several checks, the agenda command will be
@@ -467,7 +478,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- '((\"c\" \"d\" ((in-mode . \"message-mode\"))))
+ ((\"c\" \"d\" ((in-mode . \"message-mode\"))))
Here it means: in `message-mode buffers', use \"c\" as the
key for the capture template otherwise associated with \"d\".
@@ -484,6 +495,8 @@ to avoid duplicates.)"
(choice
(const :tag "In file" in-file)
(const :tag "Not in file" not-in-file)
+ (const :tag "In buffer" in-buffer)
+ (const :tag "Not in buffer" not-in-buffer)
(const :tag "In mode" in-mode)
(const :tag "Not in mode" not-in-mode))
(regexp))
@@ -491,7 +504,7 @@ to avoid duplicates.)"
(defcustom org-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
-When nil, you can still capturing using the date at point with \\[org-agenda-capture]]."
+When nil, you can still capture using the date at point with \\[org-agenda-capture]."
:group 'org-capture
:version "24.3"
:type 'boolean)
@@ -514,17 +527,19 @@ stored.
When called with a `C-0' (zero) prefix, insert a template at point.
-Lisp programs can set KEYS to a string associated with a template
+ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
If `org-capture-use-agenda-date' is non-nil, capturing from the
-agenda will use the date at point as the default date."
+agenda will use the date at point as the default date. Then, a
+`C-1' prefix will tell the capture process to use the HH:MM time
+of the day at point (if any) or the current HH:MM time."
(interactive "P")
(when (and org-capture-use-agenda-date
(eq major-mode 'org-agenda-mode))
(setq org-overriding-default-time
- (org-get-cursor-date)))
+ (org-get-cursor-date (equal goto 1))))
(cond
((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored))
@@ -563,8 +578,9 @@ agenda will use the date at point as the default date."
(file-name-nondirectory
(buffer-file-name orig-buf)))
:annotation annotation
- :initial initial)
- (org-capture-put :default-time
+ :initial initial
+ :return-to-wconf (current-window-configuration)
+ :default-time
(or org-overriding-default-time
(org-current-time)))
(org-capture-set-target-location)
@@ -579,7 +595,8 @@ agenda will use the date at point as the default date."
;;insert at point
(org-capture-insert-template-here)
(condition-case error
- (org-capture-place-template)
+ (org-capture-place-template
+ (equal (car (org-capture-get :target)) 'function))
((error quit)
(if (and (buffer-base-buffer (current-buffer))
(string-match "\\`CAPTURE-" (buffer-name)))
@@ -600,7 +617,7 @@ agenda will use the date at point as the default date."
(error
"Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish)
- (org-capture-finalize nil)))))))))
+ (org-capture-finalize)))))))))
(defun org-capture-get-template ()
"Get the template from a file or a function if necessary."
@@ -625,6 +642,8 @@ agenda will use the date at point as the default date."
With prefix argument STAY-WITH-CAPTURE, jump to the location of the
captured item after finalizing."
(interactive "P")
+ (when (org-capture-get :jump-to-captured)
+ (setq stay-with-capture t))
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
(error "This does not seem to be a capture buffer for Org-mode"))
@@ -723,7 +742,8 @@ captured item after finalizing."
(pos (org-capture-get :initial-target-position))
(ipt (org-capture-get :insertion-point))
(size (org-capture-get :captured-entry-size)))
- (when reg
+ (if (not reg)
+ (widen)
(cond ((< ipt (car reg))
;; insertion point is before the narrowed region
(narrow-to-region (+ size (car reg)) (+ size (cdr reg))))
@@ -771,14 +791,14 @@ already gone. Any prefix argument will be passed to the refile command."
(let ((pos (point))
(base (buffer-base-buffer (current-buffer)))
(org-refile-for-capture t))
- (org-capture-finalize)
(save-window-excursion
(with-current-buffer (or base (current-buffer))
(save-excursion
(save-restriction
(widen)
(goto-char pos)
- (call-interactively 'org-refile)))))))
+ (call-interactively 'org-refile)))))
+ (org-capture-finalize)))
(defun org-capture-kill ()
"Abort the current capture process."
@@ -893,7 +913,8 @@ Store them in the capture property list."
(current-time))))
(org-capture-put
:default-time
- (cond ((and (not org-time-was-given)
+ (cond ((and (or (not (boundp 'org-time-was-given))
+ (not org-time-was-given))
(not (= (time-to-days prompt-time) (org-today))))
;; Use 00:00 when no time is given for another date than today?
(apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
@@ -964,14 +985,17 @@ it. When it is a variable, retrieve the value. Return whatever we get."
(find-file-noselect (expand-file-name file org-directory)))))
(defun org-capture-steal-local-variables (buffer)
- "Install Org-mode local variables."
+ "Install Org-mode local variables of BUFFER."
(mapc (lambda (v)
(ignore-errors (org-set-local (car v) (cdr v))))
(buffer-local-variables buffer)))
-(defun org-capture-place-template ()
- "Insert the template at the target location, and display the buffer."
- (org-capture-put :return-to-wconf (current-window-configuration))
+(defun org-capture-place-template (&optional inhibit-wconf-store)
+ "Insert the template at the target location, and display the buffer.
+When `inhibit-wconf-store', don't store the window configuration, as it
+may have been stored before."
+ (unless inhibit-wconf-store
+ (org-capture-put :return-to-wconf (current-window-configuration)))
(delete-other-windows)
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
@@ -1250,8 +1274,11 @@ Of course, if exact position has been required, just put it there."
(save-restriction
(widen)
(goto-char pos)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))))))
(defun org-capture-narrow (beg end)
@@ -1261,7 +1288,7 @@ Of course, if exact position has been required, just put it there."
(goto-char beg)))
(defun org-capture-empty-lines-before (&optional n)
- "Arrange for the correct number of empty lines before the insertion point.
+ "Set the correct number of empty lines before the insertion point.
Point will be after the empty lines, so insertion can directly be done."
(setq n (or n (org-capture-get :empty-lines-before)
(org-capture-get :empty-lines) 0))
@@ -1271,7 +1298,7 @@ Point will be after the empty lines, so insertion can directly be done."
(if (> n 0) (newline n))))
(defun org-capture-empty-lines-after (&optional n)
- "Arrange for the correct number of empty lines after the inserted string.
+ "Set the correct number of empty lines after the inserted string.
Point will remain at the first line after the inserted text."
(setq n (or n (org-capture-get :empty-lines-after)
(org-capture-get :empty-lines) 0))
@@ -1284,6 +1311,7 @@ Point will remain at the first line after the inserted text."
(defvar org-clock-marker) ; Defined in org.el
(defun org-capture-insert-template-here ()
+ "Insert the capture template at point."
(let* ((template (org-capture-get :template))
(type (org-capture-get :type))
beg end pp)
@@ -1366,8 +1394,106 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(unless (org-kill-is-subtree-p tree)
(error "Template is not a valid Org entry or tree")))
-;;; The template code
+(defun org-mks (table title &optional prompt specials)
+ "Select a member of an alist with multiple keys.
+TABLE is the alist which should contain entries where the car is a string.
+There should be two types of entries.
+
+1. prefix descriptions like (\"a\" \"Description\")
+ This indicates that `a' is a prefix key for multi-letter selection, and
+ that there are entries following with keys like \"ab\", \"ax\"...
+
+2. Selectable members must have more than two elements, with the first
+ being the string of keys that lead to selecting it, and the second a
+ short description string of the item.
+
+The command will then make a temporary buffer listing all entries
+that can be selected with a single key, and all the single key
+prefixes. When you press the key for a single-letter entry, it is selected.
+When you press a prefix key, the commands (and maybe further prefixes)
+under this key will be shown and offered for selection.
+
+TITLE will be placed over the selection in the temporary buffer,
+PROMPT will be used when prompting for a key. SPECIAL is an alist with
+also (\"key\" \"description\") entries. When one of these is selection,
+only the bare key is returned."
+ (setq prompt (or prompt "Select: "))
+ (let (tbl orig-table dkey ddesc des-keys allowed-keys
+ current prefix rtn re pressed buffer (inhibit-quit t))
+ (save-window-excursion
+ (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
+ (setq orig-table table)
+ (catch 'exit
+ (while t
+ (erase-buffer)
+ (insert title "\n\n")
+ (setq tbl table
+ des-keys nil
+ allowed-keys nil
+ cursor-type nil)
+ (setq prefix (if current (concat current " ") ""))
+ (while tbl
+ (cond
+ ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
+ ;; This is a description on this level
+ (setq dkey (caar tbl) ddesc (cadar tbl))
+ (pop tbl)
+ (push dkey des-keys)
+ (push dkey allowed-keys)
+ (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n")
+ ;; Skip keys which are below this prefix
+ (setq re (concat "\\`" (regexp-quote dkey)))
+ (let (case-fold-search)
+ (while (and tbl (string-match re (caar tbl))) (pop tbl))))
+ ((= 2 (length (car tbl)))
+ ;; Not yet a usable description, skip it
+ )
+ (t
+ ;; usable entry on this level
+ (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n")
+ (push (caar tbl) allowed-keys)
+ (pop tbl))))
+ (when specials
+ (insert "-------------------------------------------------------------------------------\n")
+ (let ((sp specials))
+ (while sp
+ (insert (format "[%s] %s\n"
+ (caar sp) (nth 1 (car sp))))
+ (push (caar sp) allowed-keys)
+ (pop sp))))
+ (push "\C-g" allowed-keys)
+ (goto-char (point-min))
+ (if (not (pos-visible-in-window-p (point-max)))
+ (org-fit-window-to-buffer))
+ (message prompt)
+ (setq pressed (char-to-string (read-char-exclusive)))
+ (while (not (member pressed allowed-keys))
+ (message "Invalid key `%s'" pressed) (sit-for 1)
+ (message prompt)
+ (setq pressed (char-to-string (read-char-exclusive))))
+ (when (equal pressed "\C-g")
+ (kill-buffer buffer)
+ (error "Abort"))
+ (when (and (not (assoc pressed table))
+ (not (member pressed des-keys))
+ (assoc pressed specials))
+ (throw 'exit (setq rtn pressed)))
+ (unless (member pressed des-keys)
+ (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
+ orig-table))))
+ (setq current (concat current pressed))
+ (setq table (mapcar
+ (lambda (x)
+ (if (and (> (length (car x)) 1)
+ (equal (substring (car x) 0 1) pressed))
+ (cons (substring (car x) 1) (cdr x))
+ nil))
+ table))
+ (setq table (remove nil table)))))
+ (when buffer (kill-buffer buffer))
+ rtn))
+;;; The template code
(defun org-capture-select-template (&optional keys)
"Select a capture template.
Lisp programs can force the template by setting KEYS to a string."
@@ -1404,8 +1530,8 @@ The template may still contain \"%?\" for cursor positioning."
(v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)))
- (v-t (format-time-string (car org-time-stamp-formats) ct))
- (v-T (format-time-string (cdr org-time-stamp-formats) ct))
+ (v-t (format-time-string (car org-time-stamp-formats) ct1))
+ (v-T (format-time-string (cdr org-time-stamp-formats) ct1))
(v-u (concat "[" (substring v-t 1 -1) "]"))
(v-U (concat "[" (substring v-T 1 -1) "]"))
;; `initial' and `annotation' might habe been passed.
@@ -1462,7 +1588,7 @@ The template may still contain \"%?\" for cursor positioning."
(insert template)
(goto-char (point-min))
(org-capture-steal-local-variables buffer)
- (setq buffer-file-name nil)
+ (setq buffer-file-name nil mark-active nil)
;; %[] Insert contents of a file.
(goto-char (point-min))
@@ -1475,7 +1601,7 @@ The template may still contain \"%?\" for cursor positioning."
(delete-region start end)
(condition-case error
(insert-file-contents filename)
- (error (insert (format "%%![Couldn't insert %s: %s]"
+ (error (insert (format "%%![Could not insert %s: %s]"
filename error)))))))
;; %() embedded elisp
(org-capture-expand-embedded-elisp)
@@ -1496,10 +1622,8 @@ The template may still contain \"%?\" for cursor positioning."
(setq v-i (mapconcat 'identity
(org-split-string initial "\n")
(concat "\n" lead))))))
- (replace-match
- (or (org-add-props (eval (intern (concat "v-" (match-string 1))))
- '(org-protected t)) "")
- t t)))
+ (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "")
+ t t)))
;; From the property list
(when plist-p
@@ -1515,8 +1639,7 @@ The template may still contain \"%?\" for cursor positioning."
(let ((org-inhibit-startup t)) (org-mode))
;; Interactive template entries
(goto-char (point-min))
- (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
- (not (get-text-property (1- (point)) 'org-protected)))
+ (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
(unless (org-capture-escaped-%)
(setq char (if (match-end 3) (match-string-no-properties 3))
prompt (if (match-end 2) (match-string-no-properties 2)))
@@ -1552,7 +1675,9 @@ The template may still contain \"%?\" for cursor positioning."
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
(or (equal (char-after) ?:) (insert ":"))
- (and (org-at-heading-p) (org-set-tags nil 'align)))))
+ (and (org-at-heading-p)
+ (let ((org-ignore-region t))
+ (org-set-tags nil 'align))))))
((equal char "C")
(cond ((= (length clipboards) 1) (insert (car clipboards)))
((> (length clipboards) 1)
@@ -1621,9 +1746,29 @@ The template may still contain \"%?\" for cursor positioning."
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
- (let ((result (org-eval (read (current-buffer)))))
+ (let* ((sexp (read (current-buffer)))
+ (result (org-eval
+ (org-capture--expand-keyword-in-embedded-elisp sexp))))
(delete-region template-start (point))
- (insert result))))))
+ (when result
+ (if (stringp result)
+ (insert result)
+ (error "Capture template sexp `%s' must evaluate to string or nil"
+ sexp))))))))
+
+(defun org-capture--expand-keyword-in-embedded-elisp (attr)
+ "Recursively replace capture link keywords in ATTR sexp.
+Such keywords are prefixed with \"%:\". See
+`org-capture-template' for more information."
+ (cond ((consp attr)
+ (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr))
+ ((symbolp attr)
+ (let* ((attr-symbol (symbol-name attr))
+ (key (and (string-match "%\\(:.*\\)" attr-symbol)
+ (intern (match-string 1 attr-symbol)))))
+ (or (plist-get org-store-link-plist key)
+ attr)))
+ (t attr)))
(defun org-capture-inside-embedded-elisp-p ()
"Return non-nil if point is inside of embedded elisp %(sexp)."
@@ -1643,7 +1788,7 @@ The template may still contain \"%?\" for cursor positioning."
;;;###autoload
(defun org-capture-import-remember-templates ()
- "Set org-capture-templates to be similar to `org-remember-templates'."
+ "Set `org-capture-templates' to be similar to `org-remember-templates'."
(interactive)
(when (and (yes-or-no-p
"Import old remember templates into org-capture-templates? ")
@@ -1660,7 +1805,7 @@ The template may still contain \"%?\" for cursor positioning."
(position (or (nth 4 entry) org-remember-default-headline))
(type 'entry)
(prepend org-reverse-note-order)
- immediate target)
+ immediate target jump-to-captured)
(cond
((member position '(top bottom))
(setq target (list 'file file)
@@ -1674,9 +1819,13 @@ The template may still contain \"%?\" for cursor positioning."
(setq template (replace-match "" t t template)
immediate t))
+ (when (string-match "%&" template)
+ (setq jump-to-captured t))
+
(append (list key desc type target template)
(if prepend '(:prepend t))
- (if immediate '(:immediate-finish t)))))
+ (if immediate '(:immediate-finish t))
+ (if jump-to-captured '(:jump-to-captured t)))))
org-remember-templates))))
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index a536d025c04..b386eb11652 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -1,6 +1,6 @@
;;; org-clock.el --- The time clocking code for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -26,11 +26,11 @@
;; This file contains the time clocking code for Org-mode
-(require 'org-exp)
;;; Code:
(eval-when-compile
(require 'cl))
+(require 'org)
(declare-function calendar-absolute-from-iso "cal-iso" (&optional date))
(declare-function notifications-notify "notifications" (&rest params))
@@ -95,6 +95,24 @@ clocking out."
(repeat :tag "State list"
(string :tag "TODO keyword"))))
+(defcustom org-clock-rounding-minutes 0
+ "Rounding minutes when clocking in or out.
+The default value is 0 so that no rounding is done.
+When set to a non-integer value, use the car of
+`org-time-stamp-rounding-minutes', like for setting a time-stamp.
+
+E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47
+and you clock in: then the clock starts at 14:45. If you clock
+out within the next 5 minutes, the clock line will be removed;
+if you clock out 8 minutes after your clocked in, the clock
+out time will be 14:50."
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Minutes (0 for no rounding)")
+ (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp)))
+
(defcustom org-clock-out-remove-zero-time-clocks nil
"Non-nil means remove the clock line when the resulting time is zero."
:group 'org-clock
@@ -141,7 +159,7 @@ state to switch it to."
This is the string shown in the mode line when a clock is running.
The function is called with point at the beginning of the headline."
:group 'org-clock
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-clock-string-limit 0
"Maximum length of clock strings in the mode line. 0 means no limit."
@@ -177,7 +195,7 @@ Emacs initialization file."
(const :tag "No persistence" nil)))
(defcustom org-clock-persist-file (convert-standard-filename
- "~/.emacs.d/org-clock-save.el")
+ (concat user-emacs-directory "org-clock-save.el"))
"File to save clock data to."
:group 'org-clock
:type 'string)
@@ -193,17 +211,17 @@ Emacs initialization file."
:type 'boolean)
(defcustom org-clock-sound nil
- "Sound that will used for notifications.
-Possible values:
+ "Sound to use for notifications.
+Possible values are:
-nil no sound played.
-t standard Emacs beep
-file name play this sound file. If not possible, fall back to beep"
+nil No sound played
+t Standard Emacs beep
+file name Play this sound file, fall back to beep"
:group 'org-clock
:type '(choice
(const :tag "No sound" nil)
(const :tag "Standard beep" t)
- (file :tag "Play sound file")))
+ (file :tag "Play sound file")))
(define-obsolete-variable-alias 'org-clock-modeline-total
'org-clock-mode-line-total "24.3")
@@ -226,7 +244,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks"
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
-(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
(defcustom org-clock-task-overrun-text nil
"Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
@@ -245,6 +263,7 @@ The function or program will be called with the notification
string as argument."
:group 'org-clock
:type '(choice
+ (const nil)
(string :tag "Program")
(function :tag "Function")))
@@ -256,9 +275,11 @@ string as argument."
(defcustom org-clocktable-defaults
(list
:maxlevel 2
- :lang org-export-default-language
+ :lang (or (org-bound-and-true-p org-export-default-language) "en")
:scope 'file
:block nil
+ :wstart 1
+ :mstart 1
:tstart nil
:tend nil
:step nil
@@ -341,13 +362,13 @@ play with them."
"Format string for the total time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-file-time-cell-format "*%s*"
"Format string for the file time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
"When clocked in for a task, org-mode can display the current
@@ -368,8 +389,8 @@ nil current clock is not displayed"
(defcustom org-clock-frame-title-format '(t org-mode-line-string)
"The value for `frame-title-format' when clocking in.
-When `org-clock-clocked-in-display' is set to 'frame-title
-or 'both, clocking in will replace `frame-title-format' with
+When `org-clock-clocked-in-display' is set to `frame-title'
+or `both', clocking in will replace `frame-title-format' with
this value. Clocking out will restore `frame-title-format'.
`org-frame-title-string' is a format string using the same
@@ -378,6 +399,20 @@ specifications than `frame-title-format', which see."
:group 'org-clock
:type 'sexp)
+(defcustom org-clock-x11idle-program-name "x11idle"
+ "Name of the program which prints X11 idle time in milliseconds.
+
+You can find x11idle.c in the contrib/scripts directory of the
+Org git distribution. Or, you can do:
+
+ sudo apt-get install xprintidle
+
+if you are using Debian."
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -389,7 +424,7 @@ to add an effort property.")
"Hook run when stopping the current clock.")
(defvar org-clock-cancel-hook nil
- "Hook run when cancelling the current clock.")
+ "Hook run when canceling the current clock.")
(defvar org-clock-goto-hook nil
"Hook run when selecting the currently clocked-in entry.")
(defvar org-clock-has-been-used nil
@@ -403,11 +438,10 @@ to add an effort property.")
(defvar org-clock-mode-line-timer nil)
(defvar org-clock-idle-timer nil)
(defvar org-clock-heading) ; defined in org.el
-(defvar org-clock-heading-for-remember "")
(defvar org-clock-start-time "")
(defvar org-clock-leftover-time nil
- "If non-nil, user cancelled a clock; this is when leftover time started.")
+ "If non-nil, user canceled a clock; this is when leftover time started.")
(defvar org-clock-effort ""
"Effort estimate of the currently clocking task.")
@@ -481,46 +515,55 @@ of a different task.")
"Hook called in task selection just before prompting the user.")
(defun org-clock-select-task (&optional prompt)
- "Select a task that recently was associated with clocking."
+ "Select a task that was recently associated with clocking."
(interactive)
- (let (sel-list rpl (i 0) s)
- (save-window-excursion
- (org-switch-to-buffer-other-window
- (get-buffer-create "*Clock Task Select*"))
- (erase-buffer)
- (when (marker-buffer org-clock-default-task)
- (insert (org-add-props "Default Task\n" nil 'face 'bold))
- (setq s (org-clock-insert-selection-line ?d org-clock-default-task))
- (push s sel-list))
- (when (marker-buffer org-clock-interrupted-task)
- (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))
- (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))
- (push s sel-list))
- (when (org-clocking-p)
- (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))
- (setq s (org-clock-insert-selection-line ?c org-clock-marker))
- (push s sel-list))
- (insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
- (mapc
- (lambda (m)
- (when (marker-buffer m)
- (setq i (1+ i)
- s (org-clock-insert-selection-line
- (if (< i 10)
- (+ i ?0)
- (+ i (- ?A 10))) m))
- (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
- (push s sel-list)))
- org-clock-history)
- (run-hooks 'org-clock-before-select-task-hook)
- (org-fit-window-to-buffer)
- (message (or prompt "Select task for clocking:"))
- (setq rpl (read-char-exclusive))
- (cond
- ((eq rpl ?q) nil)
- ((eq rpl ?x) nil)
- ((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
- (t (error "Invalid task choice %c" rpl))))))
+ (let (och chl sel-list rpl (i 0) s)
+ ;; Remove successive dups from the clock history to consider
+ (mapc (lambda (c) (if (not (equal c (car och))) (push c och)))
+ org-clock-history)
+ (setq och (reverse och) chl (length och))
+ (if (zerop chl)
+ (user-error "No recent clock")
+ (save-window-excursion
+ (org-switch-to-buffer-other-window
+ (get-buffer-create "*Clock Task Select*"))
+ (erase-buffer)
+ (when (marker-buffer org-clock-default-task)
+ (insert (org-add-props "Default Task\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?d org-clock-default-task))
+ (push s sel-list))
+ (when (marker-buffer org-clock-interrupted-task)
+ (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task))
+ (push s sel-list))
+ (when (org-clocking-p)
+ (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold))
+ (setq s (org-clock-insert-selection-line ?c org-clock-marker))
+ (push s sel-list))
+ (insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
+ (mapc
+ (lambda (m)
+ (when (marker-buffer m)
+ (setq i (1+ i)
+ s (org-clock-insert-selection-line
+ (if (< i 10)
+ (+ i ?0)
+ (+ i (- ?A 10))) m))
+ (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
+ (push s sel-list)))
+ och)
+ (run-hooks 'org-clock-before-select-task-hook)
+ (goto-char (point-min))
+ ;; Set min-height relatively to circumvent a possible but in
+ ;; `fit-window-to-buffer'
+ (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
+ (message (or prompt "Select task for clocking:"))
+ (setq cursor-type nil rpl (read-char-exclusive))
+ (cond
+ ((eq rpl ?q) nil)
+ ((eq rpl ?x) nil)
+ ((assoc rpl sel-list) (cdr (assoc rpl sel-list)))
+ (t (user-error "Invalid task choice %c" rpl)))))))
(defun org-clock-insert-selection-line (i marker)
"Insert a line for the clock selection menu.
@@ -547,7 +590,7 @@ pointing to it."
org-odd-levels-only)
(length prefix)))))))
(when (and cat task)
- (insert (format "[%c] %-15s %s\n" i cat task))
+ (insert (format "[%c] %-12s %s\n" i cat task))
(cons i marker)))))
(defvar org-clock-task-overrun nil
@@ -560,30 +603,33 @@ pointing to it."
If an effort estimate was defined for the current item, use
01:30/01:50 format (clocked/estimated).
If not, show simply the clocked time like 01:50."
- (let* ((clocked-time (org-clock-get-clocked-time))
- (h (floor clocked-time 60))
- (m (- clocked-time (* 60 h))))
+ (let ((clocked-time (org-clock-get-clocked-time)))
(if org-clock-effort
(let* ((effort-in-minutes
(org-duration-string-to-minutes org-clock-effort))
- (effort-h (floor effort-in-minutes 60))
- (effort-m (- effort-in-minutes (* effort-h 60)))
(work-done-str
(org-propertize
- (format org-time-clocksum-format h m)
+ (org-minutes-to-clocksum-string clocked-time)
'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
'org-mode-line-clock-overrun 'org-mode-line-clock)))
- (effort-str (format org-time-clocksum-format effort-h effort-m))
+ (effort-str (org-minutes-to-clocksum-string effort-in-minutes))
(clockstr (org-propertize
(concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock)))
(format clockstr work-done-str))
- (org-propertize (format
- (concat "[" org-time-clocksum-format " (%s)]")
- h m org-clock-heading)
+ (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time)
+ (format " (%s)" org-clock-heading) "]")
'face 'org-mode-line-clock))))
+(defun org-clock-get-last-clock-out-time ()
+ "Get the last clock-out time for the current subtree."
+ (save-excursion
+ (let ((end (save-excursion (org-end-of-subtree))))
+ (when (re-search-forward (concat org-clock-string
+ ".*\\]--\\(\\[[^]]+\\]\\)") end t)
+ (org-time-string-to-time (match-string 1))))))
+
(defun org-clock-update-mode-line ()
(if org-clock-effort
(org-clock-notify-once-if-expired)
@@ -620,9 +666,12 @@ previous clocking intervals."
"Add to or set the effort estimate of the item currently being clocked.
VALUE can be a number of minutes, or a string with format hh:mm or mm.
When the string starts with a + or a - sign, the current value of the effort
-property will be changed by that amount.
-This will update the \"Effort\" property of currently clocked item, and
-the mode line."
+property will be changed by that amount. If the effort value is expressed
+as an `org-effort-durations' (e.g. \"3h\"), the modified value will be
+converted to a hh:mm duration.
+
+This command will update the \"Effort\" property of the currently
+clocked item, and the value displayed in the mode line."
(interactive)
(if (org-clock-is-active)
(let ((current org-clock-effort) sign)
@@ -646,7 +695,7 @@ the mode line."
(setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value)))))
(setq value (max 0 value)
- org-clock-effort (org-minutes-to-hh:mm-string value))
+ org-clock-effort (org-minutes-to-clocksum-string value))
(org-entry-put org-clock-marker "Effort" org-clock-effort)
(org-clock-update-mode-line)
(message "Effort is now %s" org-clock-effort))
@@ -668,14 +717,16 @@ Notification is shown only once."
(unless org-clock-notification-was-shown
(setq org-clock-notification-was-shown t)
(org-notify
- (format "Task '%s' should be finished by now. (%s)"
- org-clock-heading org-clock-effort) t))
+ (format-message "Task `%s' should be finished by now. (%s)"
+ org-clock-heading org-clock-effort)
+ org-clock-sound))
(setq org-clock-notification-was-shown nil)))))
(defun org-notify (notification &optional play-sound)
- "Send a NOTIFICATION and maybe PLAY-SOUND."
+ "Send a NOTIFICATION and maybe PLAY-SOUND.
+If PLAY-SOUND is non-nil, it overrides `org-clock-sound'."
(org-show-notification notification)
- (if play-sound (org-clock-play-sound)))
+ (if play-sound (org-clock-play-sound play-sound)))
(defun org-show-notification (notification)
"Show notification.
@@ -700,21 +751,23 @@ use libnotify if available, or fall back on a message."
;; a fall back option
(t (message "%s" notification))))
-(defun org-clock-play-sound ()
+(defun org-clock-play-sound (&optional clock-sound)
"Play sound as configured by `org-clock-sound'.
-Use alsa's aplay tool if available."
- (cond
- ((not org-clock-sound))
- ((eq org-clock-sound t) (beep t) (beep t))
- ((stringp org-clock-sound)
- (let ((file (expand-file-name org-clock-sound)))
- (if (file-exists-p file)
- (if (executable-find "aplay")
- (start-process "org-clock-play-notification" nil
- "aplay" file)
- (condition-case nil
- (play-sound-file file)
- (error (beep t) (beep t)))))))))
+Use alsa's aplay tool if available.
+If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
+ (let ((org-clock-sound (or clock-sound org-clock-sound)))
+ (cond
+ ((not org-clock-sound))
+ ((eq org-clock-sound t) (beep t) (beep t))
+ ((stringp org-clock-sound)
+ (let ((file (expand-file-name org-clock-sound)))
+ (if (file-exists-p file)
+ (if (executable-find "aplay")
+ (start-process "org-clock-play-notification" nil
+ "aplay" file)
+ (condition-case nil
+ (play-sound-file file)
+ (error (beep t) (beep t))))))))))
(defvar org-clock-mode-line-entry nil
"Information for the mode line about the running clock.")
@@ -885,25 +938,29 @@ was started."
(org-clock-jump-to-current-clock clock))
(unless org-clock-resolve-expert
(with-output-to-temp-buffer "*Org Clock*"
- (princ "Select a Clock Resolution Command:
+ (princ (format-message "Select a Clock Resolution Command:
-i/q/C-g Ignore this question; the same as keeping all the idle time.
+i/q Ignore this question; the same as keeping all the idle time.
k/K Keep X minutes of the idle time (default is all). If this
amount is less than the default, you will be clocked out
that many minutes after the time that idling began, and then
clocked back in at the present time.
-g/G Indicate that you \"got back\" X minutes ago. This is quite
- different from 'k': it clocks you out from the beginning of
+
+g/G Indicate that you “got back” X minutes ago. This is quite
+ different from `k': it clocks you out from the beginning of
the idle period and clock you back in X minutes ago.
+
s/S Subtract the idle time from the current clock. This is the
same as keeping 0 minutes.
+
C Cancel the open timer altogether. It will be as though you
never clocked in.
+
j/J Jump to the current clock, to make manual adjustments.
For all these options, using uppercase makes your final state
-to be CLOCKED OUT.")))
+to be CLOCKED OUT."))))
(org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
(let (char-pressed)
(when (featurep 'xemacs)
@@ -990,9 +1047,9 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(lambda (clock)
(format
"Dangling clock started %d mins ago"
- (floor
- (/ (- (org-float-time (current-time))
- (org-float-time (cdr clock))) 60))))))
+ (floor (- (org-float-time)
+ (org-float-time (cdr clock)))
+ 60)))))
(or last-valid
(cdr clock)))))))))))
@@ -1010,13 +1067,15 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling
(defvar org-x11idle-exists-p
;; Check that x11idle exists
(and (eq window-system 'x)
- (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0)
+ (eq 0 (call-process-shell-command
+ (format "command -v %s" org-clock-x11idle-program-name)))
;; Check that x11idle can retrieve the idle time
- (eq (call-process-shell-command "x11idle" nil nil nil) 0)))
+ ;; FIXME: Why "..-shell-command" rather than just `call-process'?
+ (eq 0 (call-process-shell-command org-clock-x11idle-program-name))))
(defun org-x11-idle-seconds ()
"Return the current X11 idle time in seconds."
- (/ (string-to-number (shell-command-to-string "x11idle")) 1000))
+ (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000))
(defun org-user-idle-seconds ()
"Return the number of seconds the user has been idle for.
@@ -1037,7 +1096,7 @@ This is performed after `org-clock-idle-time' minutes, to check
if the user really wants to stay clocked in after being idle for
so long."
(when (and org-clock-idle-time (not org-clock-resolving-clocks)
- org-clock-marker)
+ org-clock-marker (marker-buffer org-clock-marker))
(let* ((org-clock-user-idle-seconds (org-user-idle-seconds))
(org-clock-user-idle-start
(time-subtract (current-time)
@@ -1056,17 +1115,9 @@ so long."
60.0))))
org-clock-user-idle-start)))))
-(defvar org-clock-current-task nil
- "Task currently clocked in.")
-(defun org-clock-set-current ()
- "Set `org-clock-current-task' to the task currently clocked in."
- (setq org-clock-current-task (nth 4 (org-heading-components))))
-
-(defun org-clock-delete-current ()
- "Reset `org-clock-current-task' to nil."
- (setq org-clock-current-task nil))
-
+(defvar org-clock-current-task nil "Task currently clocked in.")
(defvar org-clock-out-time nil) ; store the time of the last clock-out
+(defvar org--msg-extra)
;;;###autoload
(defun org-clock-in (&optional select start-time)
@@ -1086,7 +1137,7 @@ make this the default behavior.)"
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
- ts selected-task target-pos (msg-extra "")
+ ts selected-task target-pos (org--msg-extra "")
(leftover (and (not org-clock-resolving-clocks)
org-clock-leftover-time)))
@@ -1156,14 +1207,9 @@ make this the default behavior.)"
(goto-char target-pos)
(org-back-to-heading t)
(or interrupting (move-marker org-clock-interrupted-task nil))
- (save-excursion
- (forward-char) ;; make sure the marker is not at the
- ;; beginning of the heading, since the
- ;; user is liking to insert stuff here
- ;; manually
- (run-hooks 'org-clock-in-prepare-hook)
- (org-clock-history-push))
- (org-clock-set-current)
+ (run-hooks 'org-clock-in-prepare-hook)
+ (org-clock-history-push)
+ (setq org-clock-current-task (nth 4 (org-heading-components)))
(cond ((functionp org-clock-in-switch-to-state)
(looking-at org-complex-heading-regexp)
(let ((newstate (funcall org-clock-in-switch-to-state
@@ -1174,30 +1220,22 @@ make this the default behavior.)"
org-clock-in-switch-to-state
"\\>"))))
(org-todo org-clock-in-switch-to-state)))
- (setq org-clock-heading-for-remember
- (and (looking-at org-complex-heading-regexp)
- (match-end 4)
- (org-trim (buffer-substring (match-end 1)
- (match-end 4)))))
(setq org-clock-heading
(cond ((and org-clock-heading-function
(functionp org-clock-heading-function))
(funcall org-clock-heading-function))
- ((and (looking-at org-complex-heading-regexp)
- (match-string 4))
+ ((nth 4 (org-heading-components))
(replace-regexp-in-string
"\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
- (match-string 4)))
+ (match-string-no-properties 4)))
(t "???")))
- (setq org-clock-heading (org-propertize org-clock-heading
- 'face nil))
(org-clock-find-position org-clock-in-resume)
(cond
((and org-clock-in-resume
(looking-at
(concat "^[ \t]*" org-clock-string
" \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
(message "Matched %s" (match-string 1))
(setq ts (concat "[" (match-string 1) "]"))
(goto-char (match-end 1))
@@ -1233,11 +1271,12 @@ make this the default behavior.)"
(y-or-n-p
(format
"You stopped another clock %d mins ago; start this one from then? "
- (/ (- (org-float-time (current-time))
+ (/ (- (org-float-time
+ (org-current-time org-clock-rounding-minutes t))
(org-float-time leftover)) 60)))
leftover)
start-time
- (current-time)))
+ (org-current-time org-clock-rounding-minutes t)))
(setq ts (org-insert-time-stamp org-clock-start-time
'with-hm 'inactive))))
(move-marker org-clock-marker (point) (buffer-base-buffer))
@@ -1270,7 +1309,7 @@ make this the default behavior.)"
(setq org-clock-idle-timer nil))
(setq org-clock-idle-timer
(run-with-timer 60 60 'org-resolve-clocks-if-idle))
- (message "Clock starts at %s - %s" ts msg-extra)
+ (message "Clock starts at %s - %s" ts org--msg-extra)
(run-hooks 'org-clock-in-hook)))))))
;;;###autoload
@@ -1288,8 +1327,9 @@ for a todo state to switch to, overriding the existing value
(if (equal arg '(4))
(org-clock-in (org-clock-select-task))
(let ((start-time (if (or org-clock-continuously (equal arg '(16)))
- (or org-clock-out-time (current-time))
- (current-time))))
+ (or org-clock-out-time
+ (org-current-time org-clock-rounding-minutes t))
+ (org-current-time org-clock-rounding-minutes t))))
(if (null org-clock-history)
(message "No last clock")
(let ((org-clock-in-switch-to-state
@@ -1315,7 +1355,6 @@ for a todo state to switch to, overriding the existing value
(org-back-to-heading t)
(move-marker org-clock-default-task (point))))
-(defvar msg-extra)
(defun org-clock-get-sum-start ()
"Return the time from which clock times should be counted.
This is for the currently running clock as it is displayed
@@ -1328,11 +1367,11 @@ decides which time to use."
(lr (org-entry-get nil "LAST_REPEAT")))
(cond
((equal cmt "current")
- (setq msg-extra "showing time in current clock instance")
+ (setq org--msg-extra "showing time in current clock instance")
(current-time))
((equal cmt "today")
- (setq msg-extra "showing today's task time.")
- (let* ((dt (decode-time (current-time))))
+ (setq org--msg-extra "showing today's task time.")
+ (let* ((dt (decode-time)))
(setq dt (append (list 0 0 0) (nthcdr 3 dt)))
(if org-extend-today-until
(setf (nth 2 dt) org-extend-today-until))
@@ -1340,12 +1379,12 @@ decides which time to use."
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
(not lr)))
- (setq msg-extra "showing entire task time.")
+ (setq org--msg-extra "showing entire task time.")
nil)
((or (equal cmt "repeat")
(and (or (not cmt) (equal cmt "auto"))
lr))
- (setq msg-extra "showing task time since last repeat.")
+ (setq org--msg-extra "showing task time since last repeat.")
(if (not lr)
nil
(org-time-string-to-time lr)))
@@ -1461,7 +1500,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
org-todo-keywords-1)
nil t "DONE")
org-clock-out-switch-to-state))
- (now (current-time))
+ (now (org-current-time org-clock-rounding-minutes))
ts te s h m remove)
(setq org-clock-out-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
@@ -1522,11 +1561,20 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
"\\>"))))
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
- (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m
- (if remove " => LINE REMOVED" ""))
- (run-hooks 'org-clock-out-hook)
+ (message (concat "Clock stopped at %s after "
+ (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s")
+ te (if remove " => LINE REMOVED" ""))
+ (let ((h org-clock-out-hook))
+ ;; If a closing note needs to be stored in the drawer
+ ;; where clocks are stored, let's temporarily disable
+ ;; `org-clock-remove-empty-clock-drawer'
+ (if (and (equal org-clock-into-drawer org-log-into-drawer)
+ (eq org-log-done 'note)
+ org-clock-out-when-done)
+ (setq h (delq 'org-clock-remove-empty-clock-drawer h)))
+ (mapc (lambda (f) (funcall f)) h))
(unless (org-clocking-p)
- (org-clock-delete-current)))))))
+ (setq org-clock-current-task nil)))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
@@ -1545,19 +1593,22 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(org-remove-empty-drawer-at clock-drawer (point))
(forward-line 1))))))
-(defun org-clock-timestamps-up nil
- "Increase CLOCK timestamps at cursor."
- (interactive)
- (org-clock-timestamps-change 'up))
+(defun org-clock-timestamps-up (&optional n)
+ "Increase CLOCK timestamps at cursor.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (org-clock-timestamps-change 'up n))
-(defun org-clock-timestamps-down nil
- "Increase CLOCK timestamps at cursor."
- (interactive)
- (org-clock-timestamps-change 'down))
+(defun org-clock-timestamps-down (&optional n)
+ "Increase CLOCK timestamps at cursor.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (org-clock-timestamps-change 'down n))
-(defun org-clock-timestamps-change (updown)
+(defun org-clock-timestamps-change (updown &optional n)
"Change CLOCK timestamps synchronously at cursor.
-UPDOWN tells whether to change 'up or 'down."
+UPDOWN tells whether to change 'up or 'down.
+Optional argument N tells to change by that many units."
(setq org-ts-what nil)
(when (org-at-timestamp-p t)
(let ((tschange (if (eq updown 'up) 'org-timestamp-up
@@ -1573,9 +1624,9 @@ UPDOWN tells whether to change 'up or 'down."
(if (<= begts2 (point)) (setq updatets1 t))
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
- (funcall tschange)
+ (funcall tschange n)
;; setq this so that (boundp 'org-ts-what is non-nil)
- (funcall tschange)
+ (funcall tschange n)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
(setq tdiff
@@ -1606,7 +1657,8 @@ UPDOWN tells whether to change 'up or 'down."
(save-excursion ; Do not replace this with `with-current-buffer'.
(org-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
+ (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")
+ (line-beginning-position))
(progn (delete-region (1- (point-at-bol)) (point-at-eol))
(org-remove-empty-drawer-at "LOGBOOK" (point)))
(message "Clock gone, cancel the timer anyway")
@@ -1620,6 +1672,12 @@ UPDOWN tells whether to change 'up or 'down."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1643,7 +1701,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(org-show-entry)
(org-back-to-heading t)
(org-cycle-hide-drawers 'children)
- (recenter)
+ (recenter org-clock-goto-before-context)
(org-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
@@ -1669,7 +1727,7 @@ each headline in the time range with point at the headline. Headlines for
which HEADLINE-FILTER returns nil are excluded from the clock summation.
PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(interactive)
- (org-unmodified
+ (org-with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
"[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
@@ -1784,12 +1842,9 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
(when org-remove-highlights-with-change
(org-add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
- (if org-time-clocksum-use-fractional
- (message (concat "Total file time: " org-time-clocksum-fractional-format
- " (%d hours and %d minutes)")
- (/ (+ (* h 60.0) m) 60.0) h m)
- (message (concat "Total file time: " org-time-clocksum-format
- " (%d hours and %d minutes)") h m h m))))
+ (message (concat "Total file time: "
+ (org-minutes-to-clocksum-string org-clock-file-total-minutes)
+ " (%d hours and %d minutes)") h m)))
(defvar org-clock-overlays nil)
(make-variable-buffer-local 'org-clock-overlays)
@@ -1799,27 +1854,20 @@ Use \\[org-clock-remove-overlays] to remove the subtree times."
If LEVEL is given, prefix time with a corresponding number of stars.
This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
- (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h)))
- (l (if level (org-get-valid-level level 0) 0))
- (fmt (concat "%s " (if org-time-clocksum-use-fractional
- org-time-clocksum-fractional-format
- org-time-clocksum-format) "%s"))
- (off 0)
+ (let* ((l (if level (org-get-valid-level level 0) 0))
ov tx)
- (org-move-to-column c)
- (unless (eolp) (skip-chars-backward "^ \t"))
- (skip-chars-backward " \t")
- (setq ov (make-overlay (point-at-bol) (point-at-eol))
- tx (concat (buffer-substring (point-at-bol) (point))
- (make-string (+ off (max 0 (- c (current-column)))) ?.)
- (org-add-props (if org-time-clocksum-use-fractional
- (format fmt
- (make-string l ?*)
- (/ (+ (* h 60.0) m) 60.0)
- (make-string (- 16 l) ?\ ))
- (format fmt
- (make-string l ?*) h m
- (make-string (- 16 l) ?\ )))
+ (beginning-of-line)
+ (when (looking-at org-complex-heading-regexp)
+ (goto-char (match-beginning 4)))
+ (setq ov (make-overlay (point) (point-at-eol))
+ tx (concat (buffer-substring-no-properties (point) (match-end 4))
+ (make-string
+ (max 0 (- (- 60 (current-column))
+ (- (match-end 4) (match-beginning 4))
+ (length (org-get-at-bol 'line-prefix)))) ?.)
+ (org-add-props (concat (make-string l ?*) " "
+ (org-minutes-to-clocksum-string time)
+ (make-string (- 16 l) ?\ ))
(list 'face 'org-clock-overlay))
""))
(if (not (featurep 'xemacs))
@@ -1828,6 +1876,7 @@ will be easy to remove."
(overlay-put ov 'end-glyph (make-glyph tx)))
(push ov org-clock-overlays)))
+;;;###autoload
(defun org-clock-remove-overlays (&optional beg end noremove)
"Remove the occur highlights from the buffer.
BEG and END are ignored. If NOREMOVE is nil, remove this function
@@ -1882,7 +1931,7 @@ fontified, and then returned."
(org-mode)
(org-create-dblock props)
(org-update-dblock)
- (font-lock-fontify-buffer)
+ (org-font-lock-ensure)
(forward-line 2)
(buffer-substring (point) (progn
(re-search-forward "^[ \t]*#\\+END" nil t)
@@ -1969,20 +2018,27 @@ buffer and update it."
((> startday 4)
(list 39 startday year)))))))
-(defun org-clock-special-range (key &optional time as-strings)
+(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
Key is a symbol specifying the range and can be one of `today', `yesterday',
`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
-A week starts Monday 0:00 and ends Sunday 24:00.
-The range is determined relative to TIME. TIME defaults to the current time.
+By default, a week starts Monday 0:00 and ends Sunday 24:00.
+The range is determined relative to TIME, which defaults to current time.
The return value is a cons cell with two internal times like the ones
-returned by `current time' or `encode-time'. if AS-STRINGS is non-nil,
-the returned times will be formatted strings."
+returned by `current time' or `encode-time'.
+If AS-STRINGS is non-nil, the returned times will be formatted strings.
+If WSTART is non-nil, use this number to specify the starting day of a
+week (monday is 1).
+If MSTART is non-nil, use this number to specify the starting day of a
+month (1 is the first day of the month).
+If you can combine both, the month starting day will have priority."
(if (integerp key) (setq key (intern (number-to-string key))))
- (let* ((tm (decode-time (or time (current-time))))
+ (let* ((tm (decode-time time))
(s 0) (m (nth 1 tm)) (h (nth 2 tm))
(d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
(dow (nth 6 tm))
+ (ws (or wstart 1))
+ (ms (or mstart 1))
(skey (symbol-name key))
(shift 0)
(q (cond ((>= (nth 4 tm) 10) 4)
@@ -2037,20 +2093,21 @@ the returned times will be formatted strings."
((memq key '(day today))
(setq d (+ d shift) h 0 m 0 h1 24 m1 0))
((memq key '(week thisweek))
- (setq diff (+ (* -7 shift) (if (= dow 0) 6 (1- dow)))
+ (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
m 0 h 0 d (- d diff) d1 (+ 7 d)))
((memq key '(month thismonth))
- (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0))
+ (setq d (or ms 1) h 0 m 0 d1 (or ms 1)
+ month (+ month shift) month1 (1+ month) h1 0 m1 0))
((memq key '(quarter thisq))
- ; compute if this shift remains in this year
- ; if not, compute how many years and quarters we have to shift (via floor*)
- ; and compute the shifted years, months and quarters
+ ;; Compute if this shift remains in this year. If not, compute
+ ;; how many years and quarters we have to shift (via floor*) and
+ ;; compute the shifted years, months and quarters.
(cond
((< (+ (- q 1) shift) 0) ; shift not in this year
(setq interval (* -1 (+ (- q 1) shift)))
- ; set tmp to ((years to shift) (quarters to shift))
+ ;; Set tmp to ((years to shift) (quarters to shift)).
(setq tmp (org-floor* interval 4))
- ; due to the use of floor, 0 quarters actually means 4
+ ;; Due to the use of floor, 0 quarters actually means 4.
(if (= 0 (nth 1 tmp))
(setq shiftedy (- y (nth 0 tmp))
shiftedm 1
@@ -2080,8 +2137,7 @@ the returned times will be formatted strings."
((memq key '(year thisyear))
(setq txt (format-time-string "the year %Y" ts)))
((memq key '(quarter thisq))
- (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))
- )
+ (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
(if as-strings
(list (format-time-string fm ts) (format-time-string fm te) txt)
(list ts te txt))))
@@ -2093,6 +2149,7 @@ the returned times will be formatted strings."
((= n 3) "3rd")
((= n 4) "4th")))
+;;;###autoload
(defun org-clocktable-shift (dir n)
"Try to shift the :block date of the clocktable at point.
Point must be in the #+BEGIN: line of a clocktable, or this function
@@ -2186,6 +2243,8 @@ the currently selected interval size."
(te (plist-get params :tend))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
+ (ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(step (plist-get params :step))
(timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
@@ -2196,7 +2255,7 @@ the currently selected interval size."
;; Check if we need to do steps
(when block
;; Get the range text for the header
- (setq cc (org-clock-special-range block nil t)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when step
;; Write many tables, in steps
@@ -2276,7 +2335,8 @@ from the dynamic block definition."
;; well-defined number of columns...
(let* ((hlchars '((1 . "*") (2 . "/")))
(lwords (assoc (or (plist-get params :lang)
- org-export-default-language)
+ (org-bound-and-true-p org-export-default-language)
+ "en")
org-clock-clocktable-language-setup))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
@@ -2284,10 +2344,14 @@ from the dynamic block definition."
(te (plist-get params :tend))
(header (plist-get params :header))
(narrow (plist-get params :narrow))
+ (ws (or (plist-get params :wstart) 1))
+ (ms (or (plist-get params :mstart) 1))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
(level-p (plist-get params :level))
+ (org-time-clocksum-use-effort-durations
+ (plist-get params :effort-durations))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
(ntcol (max 1 (or (plist-get params :tcolumns) 100)))
@@ -2326,7 +2390,7 @@ from the dynamic block definition."
(when block
;; Get the range text for the header
- (setq range-text (nth 2 (org-clock-special-range block nil t))))
+ (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
;; Compute the total time
(setq total-time (apply '+ (mapcar 'cadr tables)))
@@ -2339,13 +2403,14 @@ from the dynamic block definition."
(or header
;; Format the standard header
(concat
+ "#+CAPTION: "
(nth 9 lwords) " ["
(substring
(format-time-string (cdr org-time-stamp-formats))
1 -1)
"]"
(if block (concat ", for " range-text ".") "")
- "\n\n")))
+ "\n")))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
@@ -2378,7 +2443,7 @@ from the dynamic block definition."
(if properties (make-string (length properties) ?|) "") ; properties columns, maybe
(concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline
(format org-clock-total-time-cell-format
- (org-minutes-to-hh:mm-string (or total-time 0))) ; the time
+ (org-minutes-to-clocksum-string (or total-time 0))) ; the time
"|\n") ; close line
;; Now iterate over the tables and insert the data
@@ -2402,7 +2467,7 @@ from the dynamic block definition."
(if level-p "| " "") ; level column, maybe
(if timestamp "| " "") ; timestamp column, maybe
(if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time
+ (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time
;; Get the list of node entries and iterate over it
(setq entries (nth 2 tbl))
@@ -2435,7 +2500,7 @@ from the dynamic block definition."
hlc headline hlc "|" ; headline
(make-string (min (1- ntcol) (or (- level 1))) ?|)
; empty fields for higher levels
- hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time
+ hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time
"|\n" ; close line
)))))
;; When exporting subtrees or regions the region might be
@@ -2495,26 +2560,25 @@ from the dynamic block definition."
total-time))
(defun org-clocktable-indent-string (level)
- (if (= level 1)
- ""
- (let ((str "\\__"))
- (while (> level 2)
- (setq level (1- level)
- str (concat str "___")))
- (concat str " "))))
+ (if (= level 1) ""
+ (let ((str " "))
+ (dotimes (k (1- level) str)
+ (setq str (concat "\\emsp" str))))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
(let* ((p1 (copy-sequence params))
(ts (plist-get p1 :tstart))
(te (plist-get p1 :tend))
+ (ws (plist-get p1 :wstart))
+ (ms (plist-get p1 :mstart))
(step0 (plist-get p1 :step))
(step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get p1 :stepskip0))
(block (plist-get p1 :block))
- cc range-text step-time)
+ cc range-text step-time tsb)
(when block
- (setq cc (org-clock-special-range block nil t)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(cond
((numberp ts)
@@ -2532,17 +2596,21 @@ from the dynamic block definition."
(te
(setq te (org-float-time
(apply 'encode-time (org-parse-time-string te))))))
+ (setq tsb
+ (if (eq step0 'week)
+ (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws)))
+ ts))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
(setq p1 (plist-put p1 :block nil))
- (while (< ts te)
+ (while (< tsb te)
(or (bolp) (insert "\n"))
(setq p1 (plist-put p1 :tstart (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time ts))))
+ (seconds-to-time (max tsb ts)))))
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time (setq ts (+ ts step))))))
+ (seconds-to-time (min te (setq tsb (+ tsb step)))))))
(insert "\n" (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
@@ -2584,6 +2652,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
+ (ws (plist-get params :wstart))
+ (ms (plist-get params :mstart))
(block (plist-get params :block))
(link (plist-get params :link))
(tags (plist-get params :tags))
@@ -2595,7 +2665,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(setq org-clock-file-total-minutes nil)
(when block
- (setq cc (org-clock-special-range block nil t)
+ (setq cc (org-clock-special-range block nil t ws ms)
ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
@@ -2604,10 +2674,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(when (and te (listp te))
(setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te))))
;; Now the times are strings we can parse.
- (if ts (setq ts (org-float-time
- (apply 'encode-time (org-parse-time-string ts)))))
- (if te (setq te (org-float-time
- (apply 'encode-time (org-parse-time-string te)))))
+ (if ts (setq ts (org-matcher-time ts)))
+ (if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
(unless (null matcher)
@@ -2637,9 +2705,13 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(format "file:%s::%s"
(buffer-file-name)
(save-match-data
- (org-make-org-heading-search-string
- (match-string 2))))
- (match-string 2)))
+ (match-string 2)))
+ (org-make-org-heading-search-string
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (lambda (m) (or (match-string 3 m)
+ (match-string 1 m)))
+ (match-string 2)))))
tsp (when timestamp
(setq props (org-entry-properties (point)))
(or (cdr (assoc "SCHEDULED" props))
@@ -2686,6 +2758,7 @@ This function is made for clock tables."
(defvar org-clock-loaded nil
"Was the clock file loaded?")
+;;;###autoload
(defun org-clock-update-time-maybe ()
"If this is a CLOCK line, update it and return t.
Otherwise, return nil."
@@ -2742,8 +2815,8 @@ The details of what will be saved are regulated by the variable
(delete-region (point-min) (point-max))
;;Store clock
(insert (format ";; org-persist.el - %s at %s\n"
- system-name (format-time-string
- (cdr org-time-stamp-formats))))
+ (system-name) (format-time-string
+ (cdr org-time-stamp-formats))))
(if (and (memq org-clock-persist '(t clock))
(setq b (org-clocking-buffer))
(setq b (or (buffer-base-buffer b) b))
@@ -2751,9 +2824,7 @@ The details of what will be saved are regulated by the variable
(buffer-file-name b)
(or (not org-clock-persist-query-save)
(y-or-n-p (concat "Save current clock ("
- (substring-no-properties
- org-clock-heading)
- ") "))))
+ org-clock-heading ") "))))
(insert "(setq resume-clock '(\""
(buffer-file-name (org-clocking-buffer))
"\" . " (int-to-string (marker-position org-clock-marker))
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 5a59196baa1..396aa3711d3 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -1,6 +1,6 @@
;;; org-colview.el --- Column View in Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -36,7 +36,7 @@
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
(when (featurep 'xemacs)
- (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'"))
+ (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory"))
;;; Column View
@@ -169,10 +169,12 @@ This is the compiled version of the format.")
(get-text-property (point-at-bol) 'face))
'default))
(color (list :foreground (face-attribute ref-face :foreground)))
- (face (list color 'org-column ref-face))
- (face1 (list color 'org-agenda-column-dateline ref-face))
+ (font (list :height (face-attribute 'default :height)
+ :family (face-attribute 'default :family)))
+ (face (list color font 'org-column ref-face))
+ (face1 (list color font 'org-agenda-column-dateline ref-face))
(cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
- pom property ass width f string ov column val modval s2 title calc)
+ pom property ass width f fc string fm ov column val modval s2 title calc)
;; Check if the entry is in another buffer.
(unless props
(if (eq major-mode 'org-agenda-mode)
@@ -202,6 +204,8 @@ This is the compiled version of the format.")
(nth 2 column)
(length property))
f (format "%%-%d.%ds | " width width)
+ fm (nth 4 column)
+ fc (nth 5 column)
calc (nth 7 column)
val (or (cdr ass) "")
modval (cond ((and org-columns-modify-value-for-display-function
@@ -213,17 +217,18 @@ This is the compiled version of the format.")
(org-columns-cleanup-item
val org-columns-current-fmt-compiled
(or org-complex-heading-regexp cphr)))
+ (fc (org-columns-number-to-string
+ (org-columns-string-to-number val fm) fm fc))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
(org-columns-number-to-string
(funcall calc (org-columns-string-to-number
- val (nth 4 column)))
- (nth 4 column)))))
+ val fm)) fm))))
(setq s2 (org-columns-add-ellipses (or modval val) width))
(setq string (format f s2))
;; Create the overlay
- (org-unmodified
+ (org-with-silent-modifications
(setq ov (org-columns-new-overlay
beg (setq beg (1+ beg)) string (if dateline face1 face)))
(overlay-put ov 'keymap org-columns-map)
@@ -321,6 +326,7 @@ for the duration of the command.")
(defvar org-colview-initial-truncate-line-value nil
"Remember the value of `truncate-lines' across colview.")
+;;;###autoload
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
@@ -332,7 +338,7 @@ for the duration of the command.")
(remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
(move-marker org-columns-begin-marker nil)
(move-marker org-columns-top-level-marker nil)
- (org-unmodified
+ (org-with-silent-modifications
(mapc 'delete-overlay org-columns-overlays)
(setq org-columns-overlays nil)
(let ((inhibit-read-only t))
@@ -348,7 +354,7 @@ CPHR is the complex heading regexp to use for parsing ITEM."
(let (fixitem)
(if (not cphr)
item
- (unless (string-match "^\*+ " item)
+ (unless (string-match "^\\*+ " item)
(setq item (concat "* " item) fixitem t))
(if (string-match cphr item)
(setq item
@@ -363,7 +369,7 @@ CPHR is the complex heading regexp to use for parsing ITEM."
0 (1+ (match-end 1))
(list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
item))
- (if fixitem (replace-regexp-in-string "^\*+ " "" item) item))))
+ (if fixitem (replace-regexp-in-string "^\\*+ " "" item) item))))
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
@@ -384,7 +390,7 @@ CPHR is the complex heading regexp to use for parsing ITEM."
(defun org-columns-quit ()
"Remove the column overlays and in this way exit column editing."
(interactive)
- (org-unmodified
+ (org-with-silent-modifications
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
@@ -414,6 +420,10 @@ If yes, throw an error indicating that changing it does not make sense."
(org-columns-next-allowed-value)
(org-columns-edit-value "TAGS")))
+(defvar org-agenda-overriding-columns-format nil
+ "When set, overrides any other format definition for the agenda.
+Don't set this, this is meant for dynamic scoping.")
+
(defun org-columns-edit-value (&optional key)
"Edit the value of the property at point in column view.
Where possible, use the standard interface for changing this line."
@@ -488,7 +498,7 @@ Where possible, use the standard interface for changing this line."
(org-agenda-columns)))
(t
(let ((inhibit-read-only t))
- (org-unmodified
+ (org-with-silent-modifications
(remove-text-properties
(max (point-min) (1- bol)) eol '(read-only t)))
(unwind-protect
@@ -589,9 +599,9 @@ an integer, select that value."
(if (= nth -1) (setq nth 9)))
(when (equal key "ITEM")
(error "Cannot edit item headline from here"))
- (unless (or allowed (member key '("SCHEDULED" "DEADLINE")))
+ (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
(error "Allowed values for this property have not been defined"))
- (if (member key '("SCHEDULED" "DEADLINE"))
+ (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
(setq nval (if previous 'earlier 'later))
(if previous (setq allowed (reverse allowed)))
(cond
@@ -664,6 +674,7 @@ around it."
(let ((value (get-char-property (point) 'org-columns-value)))
(org-open-link-from-string value arg)))
+;;;###autoload
(defun org-columns-get-format-and-top-level ()
(let ((fmt (org-columns-get-format)))
(org-columns-goto-top-level)
@@ -899,10 +910,6 @@ display, or in the #+COLUMNS line of the current buffer."
(insert-before-markers "#+COLUMNS: " fmt "\n")))
(org-set-local 'org-columns-default-format fmt))))))
-(defvar org-agenda-overriding-columns-format nil
- "When set, overrides any other format definition for the agenda.
-Don't set this, this is meant for dynamic scoping.")
-
(defun org-columns-get-autowidth-alist (s cache)
"Derive the maximum column widths from the format and the cache."
(let ((start 0) rtn)
@@ -920,7 +927,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-columns-compute-all ()
"Compute all columns that have operators defined."
- (org-unmodified
+ (org-with-silent-modifications
(remove-text-properties (point-min) (point-max) '(org-summaries t)))
(let ((columns org-columns-current-fmt-compiled)
(org-columns-time (time-to-number-of-days (current-time)))
@@ -949,6 +956,8 @@ Don't set this, this is meant for dynamic scoping.")
(defvar org-inlinetask-min-level
(if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
+
+;;;###autoload
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
@@ -996,7 +1005,7 @@ Don't set this, this is meant for dynamic scoping.")
(if (assoc property sum-alist)
(setcdr (assoc property sum-alist) useval)
(push (cons property useval) sum-alist)
- (org-unmodified
+ (org-with-silent-modifications
(add-text-properties sumpos (1+ sumpos)
(list 'org-summaries sum-alist))))
(when (and val (not (equal val (if flag str val))))
@@ -1052,14 +1061,14 @@ Don't set this, this is meant for dynamic scoping.")
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum)))
+;;;###autoload
(defun org-columns-number-to-string (n fmt &optional printf)
"Convert a computed column number to a string value, according to FMT."
(cond
((memq fmt '(estimate)) (org-estimate-print n printf))
((not (numberp n)) "")
((memq fmt '(add_times max_times min_times mean_times))
- (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h))))))
- (format org-time-clocksum-format h m)))
+ (org-hours-to-clocksum-string n))
((eq fmt 'checkbox)
(cond ((= n (floor n)) "[X]")
((> n 1.) "[-]")
@@ -1077,7 +1086,7 @@ Don't set this, this is meant for dynamic scoping.")
(defun org-nofm-to-completion (n m &optional percent)
(if (not percent)
(format "[%d/%d]" n m)
- (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m)))))))
+ (format "[%d%%]" (round (* 100.0 n) m))))
(defun org-columns-string-to-number (s fmt)
@@ -1305,10 +1314,10 @@ PARAMS is a property list of parameters:
(if (eq 'hline x) x (cons "" x)))
tbl))
(setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
- (setq pos (point))
(when content-lines
(while (string-match "^#" (car content-lines))
(insert (pop content-lines) "\n")))
+ (setq pos (point))
(insert (org-listtable-to-string tbl))
(when (plist-get params :width)
(insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
@@ -1404,7 +1413,7 @@ and tailing newline characters."
;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum
(setq d (get-text-property (point) 'duration)))
- (setq d (org-minutes-to-hh:mm-string d))
+ (setq d (org-minutes-to-clocksum-string d))
(put-text-property 0 (length d) 'face 'org-warning d)
(push (cons org-effort-property d) p)))
(push (cons (org-current-line) p) cache))
@@ -1510,9 +1519,8 @@ This will add overlays to the date lines, to show the summary for each day."
(save-excursion
(save-restriction
(widen)
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(org-summaries t)))
+ (org-with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
(goto-char (point-min))
(org-columns-get-format-and-top-level)
(while (setq fm (pop fmt))
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 9292b994367..4c90cdae628 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -1,6 +1,6 @@
;;; org-compat.el --- Compatibility code for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -113,6 +113,41 @@ any other entries, and any resulting duplicates will be removed entirely."
;;;; Emacs/XEmacs compatibility
+(eval-and-compile
+ (defun org-defvaralias (new-alias base-variable &optional docstring)
+ "Compatibility function for defvaralias.
+Don't do the aliasing when `defvaralias' is not bound."
+ (declare (indent 1))
+ (when (fboundp 'defvaralias)
+ (defvaralias new-alias base-variable docstring)))
+
+ (when (and (not (boundp 'user-emacs-directory))
+ (boundp 'user-init-directory))
+ (org-defvaralias 'user-emacs-directory 'user-init-directory)))
+
+(when (featurep 'xemacs)
+ (defadvice custom-handle-keyword
+ (around org-custom-handle-keyword
+ activate preactivate)
+ "Remove custom keywords not recognized to avoid producing an error."
+ (cond
+ ((eq (ad-get-arg 1) :package-version))
+ (t ad-do-it)))
+ (defadvice define-obsolete-variable-alias
+ (around org-define-obsolete-variable-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defadvice define-obsolete-function-alias
+ (around org-define-obsolete-function-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defvar customize-package-emacs-version-alist nil)
+ (defvar temporary-file-directory (temp-directory)))
+
;; Keys
(defconst org-xemacs-key-equivalents
'(([mouse-1] . [button1])
@@ -155,10 +190,12 @@ If DELETE is non-nil, delete all those overlays."
found))
(defun org-get-x-clipboard (value)
- "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21."
- (if (eq window-system 'x)
- (let ((x (org-get-x-clipboard-compat value)))
- (if x (org-no-properties x)))))
+ "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21."
+ (cond ((eq window-system 'x)
+ (let ((x (org-get-x-clipboard-compat value)))
+ (if x (org-no-properties x))))
+ ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
+ (w32-get-clipboard-data))))
(defsubst org-decompose-region (beg end)
"Decompose from BEG to END."
@@ -204,7 +241,7 @@ ignored in this case."
(or window (selected-window)))
(defun org-number-sequence (from &optional to inc)
- "Call `number-sequence or emulate it."
+ "Call `number-sequence' or emulate it."
(if (fboundp 'number-sequence)
(number-sequence from to inc)
(if (or (not to) (= from to))
@@ -223,10 +260,16 @@ ignored in this case."
next (+ from (* n inc)))))
(nreverse seq)))))
+;; `set-transient-map' is only in Emacs >= 24.4
+(defalias 'org-set-transient-map
+ (if (fboundp 'set-transient-map)
+ 'set-transient-map
+ 'set-temporary-overlay-map))
+
;; Region compatibility
(defvar org-ignore-region nil
- "To temporarily disable the active region.")
+ "Non-nil means temporarily disable the active region.")
(defun org-region-active-p ()
"Is `transient-mark-mode' on and the region active?
@@ -252,7 +295,7 @@ Works on both Emacs and XEmacs."
(setq mark-active t)
(when (and (boundp 'transient-mark-mode)
(not transient-mark-mode))
- (setq transient-mark-mode 'lambda))
+ (set (make-local-variable 'transient-mark-mode) 'lambda))
(when (boundp 'zmacs-regions)
(setq zmacs-regions t)))))
@@ -269,8 +312,7 @@ Works on both Emacs and XEmacs."
(defun org-in-invisibility-spec-p (arg)
"Is ARG a member of `buffer-invisibility-spec'?"
(if (consp buffer-invisibility-spec)
- (member arg buffer-invisibility-spec)
- nil))
+ (member arg buffer-invisibility-spec)))
(defmacro org-xemacs-without-invisibility (&rest body)
"Turn off extents with invisibility while executing BODY."
@@ -301,9 +343,15 @@ Works on both Emacs and XEmacs."
(indent-line-to column)))
(defun org-move-to-column (column &optional force buffer)
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (move-to-column column force buffer))
- (move-to-column column force)))
+ "Move to column COLUMN.
+Pass COLUMN and FORCE to `move-to-column'.
+Pass BUFFER to the XEmacs version of `move-to-column'."
+ (let ((buffer-invisibility-spec
+ (remove '(org-filtered) buffer-invisibility-spec)))
+ (if (featurep 'xemacs)
+ (org-xemacs-without-invisibility
+ (move-to-column column force buffer))
+ (move-to-column column force))))
(defun org-get-x-clipboard-compat (value)
"Get the clipboard value on XEmacs or Emacs 21."
@@ -363,26 +411,26 @@ Works on both Emacs and XEmacs."
(when focus-follows-mouse
(set-mouse-position frame (1- (frame-width frame)) 0)))))
-(defun org-float-time (&optional time)
- "Convert time value TIME to a floating point number.
-TIME defaults to the current time."
- (if (featurep 'xemacs)
- (time-to-seconds (or time (current-time)))
- (float-time time)))
+(defalias 'org-float-time
+ (if (featurep 'xemacs) 'time-to-seconds 'float-time))
;; `user-error' is only available from 24.2.50 on
(unless (fboundp 'user-error)
(defalias 'user-error 'error))
+;; ‘format-message’ is available only from 25 on
+(unless (fboundp 'format-message)
+ (defalias 'format-message 'format))
+
(defmacro org-no-popups (&rest body)
"Suppress popup windows.
Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version."
- (if (org-version-check "24.2.50" "" :predicate)
- `(let (pop-up-frames display-buffer-alist)
- ,@body)
- `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
- ,@body)))
+ (if (org-version-check "24.2.50" "" :predicate)
+ `(let (pop-up-frames display-buffer-alist)
+ ,@body)
+ `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
+ ,@body)))
(if (fboundp 'string-match-p)
(defalias 'org-string-match-p 'string-match-p)
@@ -430,6 +478,11 @@ LIMIT."
(looking-at (concat "\\(?:" regexp "\\)\\'")))))
(not (null pos)))))
+(defalias 'org-font-lock-ensure
+ (if (fboundp 'org-font-lock-ensure)
+ #'font-lock-ensure
+ (lambda (_beg _end) (font-lock-fontify-buffer))))
+
(defun org-floor* (x &optional y)
"Return a list of the floor of X and the fractional part of X.
With two arguments, return floor and remainder of their quotient."
@@ -484,6 +537,29 @@ With two arguments, return floor and remainder of their quotient."
(defun org-release () "N/A")
(defun org-git-version () "N/A !!check installation!!"))))))
+(defun org-file-equal-p (f1 f2)
+ "Return t if files F1 and F2 are the same.
+Implements `file-equal-p' for older emacsen and XEmacs."
+ (if (fboundp 'file-equal-p)
+ (file-equal-p f1 f2)
+ (let (f1-attr f2-attr)
+ (and (setq f1-attr (file-attributes (file-truename f1)))
+ (setq f2-attr (file-attributes (file-truename f2)))
+ (equal f1-attr f2-attr)))))
+
+;; `buffer-narrowed-p' is available for Emacs >=24.3
+(defun org-buffer-narrowed-p ()
+ "Compatibility function for `buffer-narrowed-p'."
+ (if (fboundp 'buffer-narrowed-p)
+ (buffer-narrowed-p)
+ (/= (- (point-max) (point-min)) (buffer-size))))
+
+(defmacro org-with-silent-modifications (&rest body)
+ (if (fboundp 'with-silent-modifications)
+ `(with-silent-modifications ,@body)
+ `(org-unmodified ,@body)))
+(def-edebug-spec org-with-silent-modifications (body))
+
(provide 'org-compat)
;;; org-compat.el ends here
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index 2dfc4addcc2..2b3445e47cd 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -1,6 +1,6 @@
;;; org-crypt.el --- Public key encryption for org-mode entries
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Filename: org-crypt.el
@@ -73,6 +73,8 @@
compress-algorithm))
(declare-function epg-encrypt-string "epg"
(context plain recipients &optional sign always-trust))
+(defvar epg-context)
+
(defgroup org-crypt nil
"Org Crypt."
@@ -131,19 +133,20 @@ See `org-crypt-disable-auto-save'."
(and
(eq org-crypt-disable-auto-save 'ask)
(y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? ")))
- (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer))))
- ; The argument to auto-save-mode has to be "-1", since
- ; giving a "nil" argument toggles instead of disabling.
+ (message "org-decrypt: Disabling auto-save-mode for %s"
+ (or (buffer-file-name) (current-buffer)))
+ ;; The argument to auto-save-mode has to be "-1", since
+ ;; giving a "nil" argument toggles instead of disabling.
(auto-save-mode -1))
((eq org-crypt-disable-auto-save nil)
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
- (add-hook 'auto-save-hook
- (lambda ()
- (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
- (org-encrypt-entries))
- nil t))
+ (org-add-hook 'auto-save-hook
+ (lambda ()
+ (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
+ (org-encrypt-entries))
+ nil t))
(t nil))))
(defun org-crypt-key-for-heading ()
@@ -161,8 +164,8 @@ See `org-crypt-disable-auto-save'."
(if (and (string= crypt-key (get-text-property 0 'org-crypt-key str))
(string= (sha1 str) (get-text-property 0 'org-crypt-checksum str)))
(get-text-property 0 'org-crypt-text str)
- (let ((epg-context (epg-make-context nil t t)))
- (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))))
+ (set (make-local-variable 'epg-context) (epg-make-context nil t t))
+ (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))
(defun org-encrypt-entry ()
"Encrypt the content of the current headline."
@@ -170,11 +173,11 @@ See `org-crypt-disable-auto-save'."
(require 'epg)
(save-excursion
(org-back-to-heading t)
+ (set (make-local-variable 'epg-context) (epg-make-context nil t t))
(let ((start-heading (point)))
(forward-line)
(when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
(let ((folded (outline-invisible-p))
- (epg-context (epg-make-context nil t t))
(crypt-key (org-crypt-key-for-heading))
(beg (point))
end encrypted-text)
@@ -206,11 +209,11 @@ See `org-crypt-disable-auto-save'."
(forward-line)
(when (looking-at "-----BEGIN PGP MESSAGE-----")
(org-crypt-check-auto-save)
+ (set (make-local-variable 'epg-context) (epg-make-context nil t t))
(let* ((end (save-excursion
(search-forward "-----END PGP MESSAGE-----")
(forward-line)
(point)))
- (epg-context (epg-make-context nil t t))
(encrypted-text (buffer-substring-no-properties (point) end))
(decrypted-text
(decode-coding-string
@@ -264,7 +267,7 @@ See `org-crypt-disable-auto-save'."
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook
'org-mode-hook
- (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
+ (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t))))
(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 833c1dd6c1e..e5435e3abcc 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -1,6 +1,6 @@
;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Paul Sexton <eeeickythump@gmail.com>
@@ -63,19 +63,19 @@
;; with the same name as the link; then, if unsuccessful, ask the user if
;; he/she wants to rebuild the 'TAGS' database and try again; then ask if
;; the user wishes to append 'tag' as a new toplevel heading at the end of
-;; the buffer; and finally, defer to org's default behaviour which is to
+;; the buffer; and finally, defer to org's default behavior which is to
;; search the entire text of the current buffer for 'tag'.
;;
-;; This behaviour can be modified by changing the value of
+;; This behavior can be modified by changing the value of
;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my
-;; .emacs, which describes the same behaviour as the above paragraph with
+;; .emacs, which describes the same behavior as the above paragraph with
;; one difference:
;;
;; (setq org-ctags-open-link-functions
;; '(org-ctags-find-tag
;; org-ctags-ask-rebuild-tags-file-then-find-tag
;; org-ctags-ask-append-topic
-;; org-ctags-fail-silently)) ; <-- prevents org default behaviour
+;; org-ctags-fail-silently)) ; <-- prevents org default behavior
;;
;;
;; Usage
@@ -131,7 +131,7 @@
;;
;; (progn
;; (message "-- rebuilding tags tables...")
-;; (mapc 'org-create-tags tags-table-list))
+;; (mapc 'org-ctags-create-tags tags-table-list))
;;; Code:
@@ -156,11 +156,8 @@ Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
See the ctags documentation for more information.")
(defcustom org-ctags-path-to-ctags
- (case system-type
- (windows-nt "ctags.exe")
- (darwin "ctags-exuberant")
- (t "ctags-exuberant"))
- "Full path to the ctags executable file."
+ (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags")
+ "Name of the ctags executable file."
:group 'org-ctags
:version "24.1"
:type 'file)
@@ -397,7 +394,8 @@ the new file."
(org-open-file filename t))
((or (eql create t)
(and (eql create 'ask)
- (y-or-n-p (format "File `%s.org' not found; create?" name))))
+ (y-or-n-p (format-message
+ "File `%s.org' not found; create?" name))))
(org-ctags-open-file filename name))
(t ;; File does not exist, and we don't want to create it.
nil))))
@@ -436,8 +434,8 @@ the heading a destination for the tag `NAME'."
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
Wrapper for org-ctags-append-topic, which first asks the user if they want
to append a new topic."
- (if (y-or-n-p (format "Topic `%s' not found; append to end of buffer?"
- name))
+ (if (y-or-n-p (format-message
+ "Topic `%s' not found; append to end of buffer?" name))
(org-ctags-append-topic name narrowp)
nil))
@@ -458,7 +456,7 @@ to rebuild (update) the TAGS file."
Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
(if (and (buffer-file-name)
(y-or-n-p
- (format
+ (format-message
"Tag `%s' not found. Rebuild table `%s/TAGS' and look again?"
name
(file-name-directory (buffer-file-name)))))
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index e0f4d10bc2d..77dfd7d32cc 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -1,6 +1,6 @@
;;; org-datetree.el --- Create date entries in a tree
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -72,7 +72,8 @@ tree can be found."
(goto-char (prog1 (point) (widen))))))
(defun org-datetree-find-year-create (year)
- (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
+ "Find the YEAR datetree or create it."
+ (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
@@ -90,6 +91,7 @@ tree can be found."
(org-datetree-insert-line year)))))
(defun org-datetree-find-month-create (year month)
+ "Find the datetree for YEAR and MONTH or create it."
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
match)
@@ -109,6 +111,7 @@ tree can be found."
(org-datetree-insert-line year month)))))
(defun org-datetree-find-day-create (year month day)
+ "Find the datetree for YEAR, MONTH and DAY or create it."
(org-narrow-to-subtree)
(let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
match)
diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el
deleted file mode 100644
index 5253d9100a5..00000000000
--- a/lisp/org/org-docbook.el
+++ /dev/null
@@ -1,1453 +0,0 @@
-;;; org-docbook.el --- DocBook exporter for org-mode
-;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: org-docbook.el
-;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
-;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com>
-;; Keywords: org, wp, docbook
-;; Description: Converts an org-mode buffer into DocBook
-;; URL:
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library implements a DocBook exporter for org-mode. The basic
-;; idea and design is very similar to what `org-export-as-html' has.
-;; Code prototype was also started with `org-export-as-html'.
-;;
-;; Put this file into your load-path and the following line into your
-;; ~/.emacs:
-;;
-;; (require 'org-docbook)
-;;
-;; The interactive functions are similar to those of the HTML and LaTeX
-;; exporters:
-;;
-;; M-x `org-export-as-docbook'
-;; M-x `org-export-as-docbook-pdf'
-;; M-x `org-export-as-docbook-pdf-and-open'
-;; M-x `org-export-as-docbook-batch'
-;; M-x `org-export-as-docbook-to-buffer'
-;; M-x `org-export-region-as-docbook'
-;; M-x `org-replace-region-by-docbook'
-;;
-;; Note that, in order to generate PDF files using the DocBook XML files
-;; created by DocBook exporter, the following two variables have to be
-;; set based on what DocBook tools you use for XSLT processor and XSL-FO
-;; processor:
-;;
-;; org-export-docbook-xslt-proc-command
-;; org-export-docbook-xsl-fo-proc-command
-;;
-;; Check the document of these two variables to see examples of how they
-;; can be set.
-;;
-;; If the Org file to be exported contains special characters written in
-;; TeX-like syntax, like \alpha and \beta, you need to include the right
-;; entity file(s) in the DOCTYPE declaration for the DocBook XML file.
-;; This is required to make the DocBook XML file valid. The DOCTYPE
-;; declaration string can be set using the following variable:
-;;
-;; org-export-docbook-doctype
-;;
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'footnote)
-(require 'org)
-(require 'org-exp)
-(require 'org-html)
-(require 'format-spec)
-
-;;; Variables:
-
-(defvar org-docbook-para-open nil)
-(defvar org-export-docbook-inline-images t)
-(defvar org-export-docbook-link-org-files-as-docbook nil)
-
-(declare-function org-id-find-id-file "org-id" (id))
-
-;;; User variables:
-
-(defgroup org-export-docbook nil
- "Options for exporting Org-mode files to DocBook."
- :tag "Org Export DocBook"
- :group 'org-export)
-
-(defcustom org-export-docbook-extension ".xml"
- "Extension of DocBook XML files."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-header "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
- "Header of DocBook XML files."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-doctype nil
- "DOCTYPE declaration string for DocBook XML files.
-This can be used to include entities that are needed to handle
-special characters in Org files.
-
-For example, if the Org file to be exported contains XHTML
-entities, you can set this variable to:
-
-\"<!DOCTYPE article [
-<!ENTITY % xhtml1-symbol PUBLIC
-\"-//W3C//ENTITIES Symbol for HTML//EN//XML\"
-\"http://www.w3.org/2003/entities/2007/xhtml1-symbol.ent\"
->
-%xhtml1-symbol;
-]>
-\"
-
-If you want to process DocBook documents without an Internet
-connection, it is suggested that you download the required entity
-file(s) and use system identifier(s) (external files) in the
-DOCTYPE declaration."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-article-header "<article xmlns=\"http://docbook.org/ns/docbook\"
- xmlns:xlink=\"http://www.w3.org/1999/xlink\" version=\"5.0\" xml:lang=\"en\">"
- "Article header of DocBook XML files."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-section-id-prefix "sec-"
- "Prefix of section IDs used during exporting.
-This can be set before exporting to avoid same set of section IDs
-being used again and again, which can be a problem when multiple
-people work on the same document."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-footnote-id-prefix "fn-"
- "The prefix of footnote IDs used during exporting.
-Like `org-export-docbook-section-id-prefix', this variable can help
-avoid same set of footnote IDs being used multiple times."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-footnote-separator "<superscript>, </superscript>"
- "Text used to separate footnotes."
- :group 'org-export-docbook
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-docbook-emphasis-alist
- `(("*" "<emphasis role=\"bold\">" "</emphasis>")
- ("/" "<emphasis>" "</emphasis>")
- ("_" "<emphasis role=\"underline\">" "</emphasis>")
- ("=" "<code>" "</code>")
- ("~" "<literal>" "</literal>")
- ("+" "<emphasis role=\"strikethrough\">" "</emphasis>"))
- "A list of DocBook expressions to convert emphasis fontifiers.
-Each element of the list is a list of three elements.
-The first element is the character used as a marker for fontification.
-The second element is a format string to wrap fontified text with.
-The third element decides whether to protect converted text from other
-conversions."
- :group 'org-export-docbook
- :type 'alist)
-
-(defcustom org-export-docbook-default-image-attributes
- `(("align" . "\"center\"")
- ("valign". "\"middle\""))
- "Alist of default DocBook image attributes.
-These attributes will be inserted into element <imagedata> by
-default, but users can override them using `#+ATTR_DocBook:'."
- :group 'org-export-docbook
- :type 'alist)
-
-(defcustom org-export-docbook-inline-image-extensions
- '("jpeg" "jpg" "png" "gif" "svg")
- "Extensions of image files that can be inlined into DocBook."
- :group 'org-export-docbook
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-export-docbook-coding-system nil
- "Coding system for DocBook XML files."
- :group 'org-export-docbook
- :type 'coding-system)
-
-(defcustom org-export-docbook-xslt-stylesheet nil
- "File name of the XSLT stylesheet used by DocBook exporter.
-This XSLT stylesheet is used by
-`org-export-docbook-xslt-proc-command' to generate the Formatting
-Object (FO) files. You can use either `fo/docbook.xsl' that
-comes with DocBook, or any customization layer you may have."
- :group 'org-export-docbook
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-docbook-xslt-proc-command nil
- "Format of XSLT processor command used by DocBook exporter.
-This command is used to process a DocBook XML file to generate
-the Formatting Object (FO) file.
-
-The value of this variable should be a format control string that
-includes three arguments: `%i', `%o', and `%s'. During exporting
-time, `%i' is replaced by the input DocBook XML file name, `%o'
-is replaced by the output FO file name, and `%s' is replaced by
-`org-export-docbook-xslt-stylesheet' (or the #+XSLT option if it
-is specified in the Org file).
-
-For example, if you use Saxon as the XSLT processor, you may want
-to set the variable to
-
- \"java com.icl.saxon.StyleSheet -o %o %i %s\"
-
-If you use Xalan, you can set it to
-
- \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\"
-
-For xsltproc, the following string should work:
-
- \"xsltproc --output %o %s %i\"
-
-You can include additional stylesheet parameters in this command.
-Just make sure that they meet the syntax requirement of each
-processor."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-xsl-fo-proc-command nil
- "Format of XSL-FO processor command used by DocBook exporter.
-This command is used to process a Formatting Object (FO) file to
-generate the PDF file.
-
-The value of this variable should be a format control string that
-includes two arguments: `%i' and `%o'. During exporting time,
-`%i' is replaced by the input FO file name, and `%o' is replaced
-by the output PDF file name.
-
-For example, if you use FOP as the XSL-FO processor, you can set
-the variable to
-
- \"fop %i %o\""
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-keywords-markup "<literal>%s</literal>"
- "A printf format string to be applied to keywords by DocBook exporter."
- :group 'org-export-docbook
- :type 'string)
-
-(defcustom org-export-docbook-timestamp-markup "<emphasis>%s</emphasis>"
- "A printf format string to be applied to time stamps by DocBook exporter."
- :group 'org-export-docbook
- :type 'string)
-
-;;; Hooks
-
-(defvar org-export-docbook-final-hook nil
- "Hook run at the end of DocBook export, in the new buffer.")
-
-;;; Autoload functions:
-
-;;;###autoload
-(defun org-export-as-docbook-batch ()
- "Call `org-export-as-docbook' in batch style.
-This function can be used in batch processing.
-
-For example:
-
-$ emacs --batch
- --load=$HOME/lib/emacs/org.el
- --visit=MyOrgFile.org --funcall org-export-as-docbook-batch"
- (org-export-as-docbook))
-
-;;;###autoload
-(defun org-export-as-docbook-to-buffer ()
- "Call `org-export-as-docbook' with output to a temporary buffer.
-No file is created."
- (interactive)
- (org-export-as-docbook nil "*Org DocBook Export*")
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window "*Org DocBook Export*")))
-
-;;;###autoload
-(defun org-replace-region-by-docbook (beg end)
- "Replace the region from BEG to END with its DocBook export.
-It assumes the region has `org-mode' syntax, and then convert it to
-DocBook. This can be used in any buffer. For example, you could
-write an itemized list in `org-mode' syntax in an DocBook buffer and
-then use this command to convert it."
- (interactive "r")
- (let (reg docbook buf)
- (save-window-excursion
- (if (derived-mode-p 'org-mode)
- (setq docbook (org-export-region-as-docbook
- beg end t 'string))
- (setq reg (buffer-substring beg end)
- buf (get-buffer-create "*Org tmp*"))
- (with-current-buffer buf
- (erase-buffer)
- (insert reg)
- (org-mode)
- (setq docbook (org-export-region-as-docbook
- (point-min) (point-max) t 'string)))
- (kill-buffer buf)))
- (delete-region beg end)
- (insert docbook)))
-
-;;;###autoload
-(defun org-export-region-as-docbook (beg end &optional body-only buffer)
- "Convert region from BEG to END in `org-mode' buffer to DocBook.
-If prefix arg BODY-ONLY is set, omit file header and footer and
-only produce the region of converted text, useful for
-cut-and-paste operations. If BUFFER is a buffer or a string,
-use/create that buffer as a target of the converted DocBook. If
-BUFFER is the symbol `string', return the produced DocBook as a
-string and leave not buffer behind. For example, a Lisp program
-could call this function in the following way:
-
- (setq docbook (org-export-region-as-docbook beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer."
- (interactive "r\nP")
- (when (org-called-interactively-p 'any)
- (setq buffer "*Org DocBook Export*"))
- (let ((transient-mark-mode t)
- (zmacs-regions t)
- rtn)
- (goto-char end)
- (set-mark (point)) ;; To activate the region
- (goto-char beg)
- (setq rtn (org-export-as-docbook nil buffer body-only))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (if (and (org-called-interactively-p 'any) (bufferp rtn))
- (switch-to-buffer-other-window rtn)
- rtn)))
-
-;;;###autoload
-(defun org-export-as-docbook-pdf (&optional ext-plist to-buffer body-only pub-dir)
- "Export as DocBook XML file, and generate PDF file."
- (interactive "P")
- (if (or (not org-export-docbook-xslt-proc-command)
- (not (string-match "%[ios].+%[ios].+%[ios]" org-export-docbook-xslt-proc-command)))
- (error "XSLT processor command is not set correctly"))
- (if (or (not org-export-docbook-xsl-fo-proc-command)
- (not (string-match "%[io].+%[io]" org-export-docbook-xsl-fo-proc-command)))
- (error "XSL-FO processor command is not set correctly"))
- (message "Exporting to PDF...")
- (let* ((wconfig (current-window-configuration))
- (opt-plist
- (org-export-process-option-filters
- (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist))))
- (docbook-buf (org-export-as-docbook ext-plist to-buffer body-only pub-dir))
- (filename (buffer-file-name docbook-buf))
- (base (file-name-sans-extension filename))
- (fofile (concat base ".fo"))
- (pdffile (concat base ".pdf")))
- (and (file-exists-p pdffile) (delete-file pdffile))
- (message "Processing DocBook XML file...")
- (shell-command (format-spec org-export-docbook-xslt-proc-command
- (format-spec-make
- ?i (shell-quote-argument filename)
- ?o (shell-quote-argument fofile)
- ?s (shell-quote-argument
- (or (plist-get opt-plist :xslt)
- org-export-docbook-xslt-stylesheet)))))
- (shell-command (format-spec org-export-docbook-xsl-fo-proc-command
- (format-spec-make
- ?i (shell-quote-argument fofile)
- ?o (shell-quote-argument pdffile))))
- (message "Processing DocBook file...done")
- (if (not (file-exists-p pdffile))
- (error "PDF file was not produced")
- (set-window-configuration wconfig)
- (message "Exporting to PDF...done")
- pdffile)))
-
-;;;###autoload
-(defun org-export-as-docbook-pdf-and-open ()
- "Export as DocBook XML file, generate PDF file, and open it."
- (interactive)
- (let ((pdffile (org-export-as-docbook-pdf)))
- (if pdffile
- (org-open-file pdffile)
- (error "PDF file was not produced"))))
-
-(defvar org-heading-keyword-regexp-format) ; defined in org.el
-
-;;;###autoload
-(defun org-export-as-docbook (&optional ext-plist to-buffer body-only pub-dir)
- "Export the current buffer as a DocBook file.
-If there is an active region, export only the region. When
-HIDDEN is obsolete and does nothing. EXT-PLIST is a
-property list with external parameters overriding org-mode's
-default settings, but still inferior to file-local settings.
-When TO-BUFFER is non-nil, create a buffer with that name and
-export to that buffer. If TO-BUFFER is the symbol `string',
-don't leave any buffer behind but just return the resulting HTML
-as a string. When BODY-ONLY is set, don't produce the file
-header and footer, simply return the content of the document (all
-top-level sections). When PUB-DIR is set, use this as the
-publishing directory."
- (interactive "P")
- (run-hooks 'org-export-first-hook)
-
- ;; Make sure we have a file name when we need it.
- (when (and (not (or to-buffer body-only))
- (not buffer-file-name))
- (if (buffer-base-buffer)
- (org-set-local 'buffer-file-name
- (with-current-buffer (buffer-base-buffer)
- buffer-file-name))
- (error "Need a file name to be able to export")))
-
- (message "Exporting...")
- (setq-default org-todo-line-regexp org-todo-line-regexp)
- (setq-default org-deadline-line-regexp org-deadline-line-regexp)
- (setq-default org-done-keywords org-done-keywords)
- (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
- (let* ((opt-plist
- (org-export-process-option-filters
- (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist))))
- (link-validate (plist-get opt-plist :link-validation-function))
- valid
- (odd org-odd-levels-only)
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (level-offset (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (+ (funcall outline-level)
- (if org-odd-levels-only 1 0)))
- 0))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- ;; The following two are dynamically scoped into other
- ;; routines below.
- (org-current-export-dir
- (or pub-dir (org-export-directory :docbook opt-plist)))
- (org-current-export-file buffer-file-name)
- (level 0) (line "") (origline "") txt todo
- (filename (if to-buffer nil
- (expand-file-name
- (concat
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory buffer-file-name)))
- org-export-docbook-extension)
- (file-name-as-directory
- (or pub-dir (org-export-directory :docbook opt-plist))))))
- (current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
- (auto-insert nil); Avoid any auto-insert stuff for the new file
- (buffer (if to-buffer
- (cond
- ((eq to-buffer 'string)
- (get-buffer-create "*Org DocBook Export*"))
- (t (get-buffer-create to-buffer)))
- (find-file-noselect filename)))
- ;; org-levels-open is a global variable
- (org-levels-open (make-vector org-level-max nil))
- (date (plist-get opt-plist :date))
- (author (or (plist-get opt-plist :author)
- user-full-name))
- (email (plist-get opt-plist :email))
- firstname othername surname
- (title (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name)))
- "UNTITLED"))
- ;; We will use HTML table formatter to export tables to DocBook
- ;; format, so need to set html-table-tag here.
- (html-table-tag (plist-get opt-plist :html-table-tag))
- (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
- (quote-re (format org-heading-keyword-regexp-format
- org-quote-string))
- (inquote nil)
- (infixed nil)
- (inverse nil)
- (llt org-plain-list-ordered-item-terminator)
- (email (plist-get opt-plist :email))
- (language (plist-get opt-plist :language))
- (lang-words nil)
- cnt
- (start 0)
- (coding-system (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system))
- (coding-system-for-write (or org-export-docbook-coding-system
- coding-system))
- (save-buffer-coding-system (or org-export-docbook-coding-system
- coding-system))
- (charset (and coding-system-for-write
- (fboundp 'coding-system-get)
- (coding-system-get coding-system-for-write
- 'mime-charset)))
- (region
- (buffer-substring
- (if region-p (region-beginning) (point-min))
- (if region-p (region-end) (point-max))))
- (org-export-footnotes-seen nil)
- (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
- (lines
- (org-split-string
- (org-export-preprocess-string
- region
- :emph-multiline t
- :for-backend 'docbook
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get opt-plist :drawers)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :timestamps (plist-get opt-plist :timestamps)
- :archived-trees
- (plist-get opt-plist :archived-trees)
- :select-tags (plist-get opt-plist :select-tags)
- :exclude-tags (plist-get opt-plist :exclude-tags)
- :add-text
- (plist-get opt-plist :text)
- :LaTeX-fragments
- (plist-get opt-plist :LaTeX-fragments))
- "[\r\n]"))
- ;; Use literal output to show check boxes.
- (checkbox-start
- (nth 1 (assoc "=" org-export-docbook-emphasis-alist)))
- (checkbox-end
- (nth 2 (assoc "=" org-export-docbook-emphasis-alist)))
- table-open type
- table-buffer table-orig-buffer
- ind item-type starter
- rpl path attr caption label desc descp desc1 desc2 link
- fnc item-tag item-number
- footref-seen footnote-list
- id-file
- )
-
- ;; Fine detailed info about author name.
- (if (string-match "\\([^ ]+\\) \\(.+ \\)?\\([^ ]+\\)" author)
- (progn
- (setq firstname (match-string 1 author)
- othername (or (match-string 2 author) "")
- surname (match-string 3 author))))
-
- ;; Get all footnote text.
- (setq footnote-list
- (org-export-docbook-get-footnotes lines))
-
- (let ((inhibit-read-only t))
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill t))))
-
- (setq org-min-level (org-get-min-level lines level-offset))
- (setq org-last-level org-min-level)
- (org-init-section-numbers)
-
- ;; Get and save the date.
- (cond
- ((and date (string-match "%" date))
- (setq date (format-time-string date)))
- (date)
- (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
-
- ;; Get the language-dependent settings
- (setq lang-words (or (assoc language org-export-language-setup)
- (assoc "en" org-export-language-setup)))
-
- ;; Switch to the output buffer. Use fundamental-mode for now. We
- ;; could turn on nXML mode later and do some indentation.
- (set-buffer buffer)
- (let ((inhibit-read-only t)) (erase-buffer))
- (fundamental-mode)
- (org-install-letbind)
-
- (and (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system coding-system-for-write))
-
- ;; The main body...
- (let ((case-fold-search nil)
- (org-odd-levels-only odd))
-
- ;; Create local variables for all options, to make sure all called
- ;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
-
- ;; Insert DocBook file header, title, and author info.
- (unless body-only
- (insert org-export-docbook-header)
- (if org-export-docbook-doctype
- (insert org-export-docbook-doctype))
- (insert "<!-- Date: " date " -->\n")
- (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n"
- (org-version) emacs-major-version))
- (insert org-export-docbook-article-header)
- (insert (format
- "\n <title>%s</title>
- <info>
- <author>
- <personname>
- <firstname>%s</firstname> <othername>%s</othername> <surname>%s</surname>
- </personname>
- %s
- </author>
- </info>\n"
- (org-docbook-expand title)
- firstname othername surname
- (if (and org-export-email-info
- email (string-match "\\S-" email))
- (concat "<email>" email "</email>") "")
- )))
-
- (org-init-section-numbers)
-
- (org-export-docbook-open-para)
-
- ;; Loop over all the lines...
- (while (setq line (pop lines) origline line)
- (catch 'nextline
-
- ;; End of quote section?
- (when (and inquote (string-match org-outline-regexp-bol line))
- (insert "]]></programlisting>\n")
- (org-export-docbook-open-para)
- (setq inquote nil))
- ;; Inside a quote section?
- (when inquote
- (insert (org-docbook-protect line) "\n")
- (throw 'nextline nil))
-
- ;; Fixed-width, verbatim lines (examples)
- (when (and org-export-with-fixed-width
- (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
- (when (not infixed)
- (setq infixed t)
- (org-export-docbook-close-para-maybe)
- (insert "<programlisting><![CDATA["))
- (insert (match-string 3 line) "\n")
- (when (or (not lines)
- (not (string-match "^[ \t]*\\(:.*\\)"
- (car lines))))
- (setq infixed nil)
- (insert "]]></programlisting>\n")
- (org-export-docbook-open-para))
- (throw 'nextline nil))
-
- ;; Protected HTML
- (when (get-text-property 0 'org-protected line)
- (let (par (ind (get-text-property 0 'original-indentation line)))
- (when (re-search-backward
- "\\(<para>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
- (setq par (match-string 1))
- (replace-match "\\2\n"))
- (insert line "\n")
- (while (and lines
- (or (= (length (car lines)) 0)
- (not ind)
- (equal ind (get-text-property 0 'original-indentation (car lines))))
- (or (= (length (car lines)) 0)
- (get-text-property 0 'org-protected (car lines))))
- (insert (pop lines) "\n"))
- (and par (insert "<para>\n")))
- (throw 'nextline nil))
-
- ;; Start of block quotes and verses
- (when (or (equal "ORG-BLOCKQUOTE-START" line)
- (and (equal "ORG-VERSE-START" line)
- (setq inverse t)))
- (org-export-docbook-close-para-maybe)
- (insert "<blockquote>")
- ;; Check whether attribution for this blockquote exists.
- (let (tmp1
- attribution
- (end (if inverse "ORG-VERSE-END" "ORG-BLOCKQUOTE-END"))
- (quote-lines nil))
- (while (and (setq tmp1 (pop lines))
- (not (equal end tmp1)))
- (push tmp1 quote-lines))
- (push tmp1 lines) ; Put back quote end mark
- ;; Check the last line in the quote to see if it contains
- ;; the attribution.
- (setq tmp1 (pop quote-lines))
- (if (string-match "\\(^.*\\)\\(--[ \t]+\\)\\(.+\\)$" tmp1)
- (progn
- (setq attribution (match-string 3 tmp1))
- (when (save-match-data
- (string-match "[^ \t]" (match-string 1 tmp1)))
- (push (match-string 1 tmp1) lines)))
- (push tmp1 lines))
- (while (setq tmp1 (pop quote-lines))
- (push tmp1 lines))
- (when attribution
- (insert "<attribution>" attribution "</attribution>")))
- ;; Insert <literallayout> for verse.
- (if inverse
- (insert "\n<literallayout>")
- (org-export-docbook-open-para))
- (throw 'nextline nil))
-
- ;; End of block quotes
- (when (equal "ORG-BLOCKQUOTE-END" line)
- (org-export-docbook-close-para-maybe)
- (insert "</blockquote>\n")
- (org-export-docbook-open-para)
- (throw 'nextline nil))
-
- ;; End of verses
- (when (equal "ORG-VERSE-END" line)
- (insert "</literallayout>\n</blockquote>\n")
- (org-export-docbook-open-para)
- (setq inverse nil)
- (throw 'nextline nil))
-
- ;; Text centering. Element <para role="centered"> does not
- ;; seem to work with FOP, so for now we use <informaltable> to
- ;; center the text, which can contain multiple paragraphs.
- (when (equal "ORG-CENTER-START" line)
- (org-export-docbook-close-para-maybe)
- (insert "<informaltable frame=\"none\" colsep=\"0\" rowsep=\"0\">\n"
- "<tgroup align=\"center\" cols=\"1\">\n"
- "<tbody><row><entry>\n")
- (org-export-docbook-open-para)
- (throw 'nextline nil))
-
- (when (equal "ORG-CENTER-END" line)
- (org-export-docbook-close-para-maybe)
- (insert "</entry></row></tbody>\n"
- "</tgroup>\n</informaltable>\n")
- (org-export-docbook-open-para)
- (throw 'nextline nil))
-
- ;; Make targets to anchors. Note that currently FOP does not
- ;; seem to support <anchor> tags when generating PDF output,
- ;; but this can be used in DocBook --> HTML conversion.
- (setq start 0)
- (while (string-match
- "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
- (cond
- ((get-text-property (match-beginning 1) 'org-protected line)
- (setq start (match-end 1)))
- ((match-end 2)
- (setq line (replace-match
- (format "@<anchor xml:id=\"%s\"/>"
- (org-solidify-link-text (match-string 1 line)))
- t t line)))
- (t
- (setq line (replace-match
- (format "@<anchor xml:id=\"%s\"/>"
- (org-solidify-link-text (match-string 1 line)))
- t t line)))))
-
- ;; Put time stamps and related keywords into special mark-up
- ;; elements.
- (setq line (org-export-docbook-handle-time-stamps line))
-
- ;; Replace "&", "<" and ">" by "&amp;", "&lt;" and "&gt;".
- ;; Handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>").
- ;; Also handle sub_superscripts and check boxes.
- (or (string-match org-table-hline-regexp line)
- (setq line (org-docbook-expand line)))
-
- ;; Format the links
- (setq start 0)
- (while (string-match org-bracket-link-analytic-regexp++ line start)
- (setq start (match-beginning 0))
- (setq path (save-match-data (org-link-unescape
- (match-string 3 line))))
- (setq type (cond
- ((match-end 2) (match-string 2 line))
- ((save-match-data
- (or (file-name-absolute-p path)
- (string-match "^\\.\\.?/" path)))
- "file")
- (t "internal")))
- (setq path (org-extract-attributes (org-link-unescape path)))
- (setq attr (get-text-property 0 'org-attributes path)
- caption (get-text-property 0 'org-caption path)
- label (get-text-property 0 'org-label path))
- (setq desc1 (if (match-end 5) (match-string 5 line))
- desc2 (if (match-end 2) (concat type ":" path) path)
- descp (and desc1 (not (equal desc1 desc2)))
- desc (or desc1 desc2))
- ;; Make an image out of the description if that is so wanted
- (when (and descp (org-file-image-p
- desc org-export-docbook-inline-image-extensions))
- (save-match-data
- (if (string-match "^file:" desc)
- (setq desc (substring desc (match-end 0))))))
- ;; FIXME: do we need to unescape here somewhere?
- (cond
- ((equal type "internal")
- (setq rpl (format "<link linkend=\"%s\">%s</link>"
- (org-solidify-link-text
- (save-match-data (org-link-unescape path)) nil)
- (org-export-docbook-format-desc desc))))
- ((and (equal type "id")
- (setq id-file (org-id-find-id-file path)))
- ;; This is an id: link to another file (if it was the same file,
- ;; it would have become an internal link...)
- (save-match-data
- (setq id-file (file-relative-name
- id-file (file-name-directory org-current-export-file)))
- (setq id-file (concat (file-name-sans-extension id-file)
- org-export-docbook-extension))
- (setq rpl (format "<link xlink:href=\"%s#%s\">%s</link>"
- id-file path (org-export-docbook-format-desc desc)))))
- ((member type '("http" "https"))
- ;; Standard URL, just check if we need to inline an image
- (if (and (or (eq t org-export-docbook-inline-images)
- (and org-export-docbook-inline-images (not descp)))
- (org-file-image-p
- path org-export-docbook-inline-image-extensions))
- (setq rpl (org-export-docbook-format-image
- (concat type ":" path)))
- (setq link (concat type ":" path))
- (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
- (org-export-html-format-href link)
- (org-export-docbook-format-desc desc)))
- ))
- ((member type '("ftp" "mailto" "news"))
- ;; Standard URL
- (setq link (concat type ":" path))
- (setq rpl (format "<link xlink:href=\"%s\">%s</link>"
- (org-export-html-format-href link)
- (org-export-docbook-format-desc desc))))
- ((string= type "coderef")
- (setq rpl (format (org-export-get-coderef-format path (and descp desc))
- (cdr (assoc path org-export-code-refs)))))
- ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- ;; The link protocol has a function for format the link
- (setq rpl
- (save-match-data
- (funcall fnc (org-link-unescape path) desc1 'html))))
-
- ((string= type "file")
- ;; FILE link
- (let* ((filename path)
- (abs-p (file-name-absolute-p filename))
- thefile file-is-image-p search)
- (save-match-data
- (if (string-match "::\\(.*\\)" filename)
- (setq search (match-string 1 filename)
- filename (replace-match "" t nil filename)))
- (setq valid
- (if (functionp link-validate)
- (funcall link-validate filename current-dir)
- t))
- (setq file-is-image-p
- (org-file-image-p
- filename org-export-docbook-inline-image-extensions))
- (setq thefile (if abs-p (expand-file-name filename) filename))
- ;; Carry over the properties (expand-file-name will
- ;; discard the properties of filename)
- (add-text-properties 0 (1- (length thefile))
- (list 'org-caption caption
- 'org-attributes attr
- 'org-label label)
- thefile)
- (when (and org-export-docbook-link-org-files-as-docbook
- (string-match "\\.org$" thefile))
- (setq thefile (concat (substring thefile 0
- (match-beginning 0))
- org-export-docbook-extension))
- (if (and search
- ;; make sure this is can be used as target search
- (not (string-match "^[0-9]*$" search))
- (not (string-match "^\\*" search))
- (not (string-match "^/.*/$" search)))
- (setq thefile (concat thefile "#"
- (org-solidify-link-text
- (org-link-unescape search)))))
- (when (string-match "^file:" desc)
- (setq desc (replace-match "" t t desc))
- (if (string-match "\\.org$" desc)
- (setq desc (replace-match "" t t desc))))))
- (setq rpl (if (and file-is-image-p
- (or (eq t org-export-docbook-inline-images)
- (and org-export-docbook-inline-images
- (not descp))))
- (progn
- (message "image %s %s" thefile org-docbook-para-open)
- (org-export-docbook-format-image thefile))
- (format "<link xlink:href=\"%s\">%s</link>"
- thefile (org-export-docbook-format-desc desc))))
- (if (not valid) (setq rpl desc))))
-
- (t
- ;; Just publish the path, as default
- (setq rpl (concat "&lt;" type ":"
- (save-match-data (org-link-unescape path))
- "&gt;"))))
- (setq line (replace-match rpl t t line)
- start (+ start (length rpl))))
-
- ;; TODO items: can we do something better?!
- (if (and (string-match org-todo-line-regexp line)
- (match-beginning 2))
- (setq line
- (concat (substring line 0 (match-beginning 2))
- "[" (match-string 2 line) "]"
- (substring line (match-end 2)))))
-
- ;; Does this contain a reference to a footnote?
- (when org-export-with-footnotes
- (setq start 0)
- (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
- ;; Discard protected matches not clearly identified as
- ;; footnote markers.
- (if (or (get-text-property (match-beginning 2) 'org-protected line)
- (not (get-text-property (match-beginning 2) 'org-footnote line)))
- (setq start (match-end 2))
- (let* ((num (match-string 2 line))
- (footnote-def (assoc num footnote-list)))
- (if (assoc num footref-seen)
- (setq line (replace-match
- (format "%s<footnoteref linkend=\"%s%s\"/>"
- (match-string 1 line)
- org-export-docbook-footnote-id-prefix num)
- t t line))
- (setq line (replace-match
- (concat
- (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>"
- (match-string 1 line)
- org-export-docbook-footnote-id-prefix
- num
- (if footnote-def
- (save-match-data
- (org-docbook-expand (cdr footnote-def)))
- (format "FOOTNOTE DEFINITION NOT FOUND: %s" num)))
- ;; If another footnote is following the
- ;; current one, add a separator.
- (if (save-match-data
- (string-match "\\`\\[[0-9]+\\]"
- (substring line (match-end 0))))
- org-export-docbook-footnote-separator
- ""))
- t t line))
- (push (cons num 1) footref-seen))))))
-
- (cond
- ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
- ;; This is a headline
- (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
- level-offset))
- txt (match-string 2 line))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
- (org-export-docbook-level-start level txt)
- ;; QUOTES
- (when (string-match quote-re line)
- (org-export-docbook-close-para-maybe)
- (insert "<programlisting><![CDATA[")
- (setq inquote t)))
-
- ;; Tables: since version 4.3 of DocBook DTD, HTML tables are
- ;; supported. We can use existing HTML table exporter code
- ;; here.
- ((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
- (if (not table-open)
- ;; New table starts
- (setq table-open t
- table-buffer nil
- table-orig-buffer nil))
- ;; Accumulate lines
- (setq table-buffer (cons line table-buffer)
- table-orig-buffer (cons origline table-orig-buffer))
- (when (or (not lines)
- (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
- (car lines))))
- (setq table-open nil
- table-buffer (nreverse table-buffer)
- table-orig-buffer (nreverse table-orig-buffer))
- (org-export-docbook-close-para-maybe)
- (insert (org-export-docbook-finalize-table
- (org-format-table-html table-buffer table-orig-buffer
- 'no-css)))))
-
- ;; Normal lines
- (t
- ;; This line either is list item or end a list.
- (when (when (get-text-property 0 'list-item line)
- (setq line (org-export-docbook-list-line
- line
- (get-text-property 0 'list-item line)
- (get-text-property 0 'list-struct line)
- (get-text-property 0 'list-prevs line)))))
-
- ;; Empty lines start a new paragraph. If hand-formatted lists
- ;; are not fully interpreted, lines starting with "-", "+", "*"
- ;; also start a new paragraph.
- (if (and (string-match "^ [-+*]-\\|^[ \t]*$" line)
- (not inverse))
- (org-export-docbook-open-para))
-
- ;; Is this the start of a footnote?
- (when org-export-with-footnotes
- (when (and (boundp 'footnote-section-tag-regexp)
- (string-match (concat "^" footnote-section-tag-regexp)
- line))
- ;; ignore this line
- (throw 'nextline nil))
- ;; These footnote lines have been read and saved before,
- ;; ignore them at this time.
- (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
- (org-export-docbook-close-para-maybe)
- (throw 'nextline nil)))
-
- ;; FIXME: It might be a good idea to add an option to
- ;; support line break processing instruction <?linebreak?>.
- ;; Org-mode supports line break "\\" in HTML exporter, and
- ;; some DocBook users may also want to force line breaks
- ;; even though DocBook only supports that in
- ;; <literallayout>.
-
- (insert line "\n")))))
-
- ;; Properly close all local lists and other lists
- (when inquote
- (insert "]]></programlisting>\n")
- (org-export-docbook-open-para))
-
- ;; Close all open sections.
- (org-export-docbook-level-start 1 nil)
-
- (unless (plist-get opt-plist :buffer-will-be-killed)
- (normal-mode)
- (if (eq major-mode (default-value 'major-mode))
- (nxml-mode)))
-
- ;; Remove empty paragraphs. Replace them with a newline.
- (goto-char (point-min))
- (while (re-search-forward
- "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t)
- (when (not (get-text-property (match-beginning 1) 'org-protected))
- (replace-match "\n")
- (backward-char 1)))
- ;; Fill empty sections with <para></para>. This is to make sure
- ;; that the DocBook document generated is valid and well-formed.
- (goto-char (point-min))
- (while (re-search-forward
- "</title>\\([ \r\n\t]*\\)</section>" nil t)
- (when (not (get-text-property (match-beginning 0) 'org-protected))
- (replace-match "\n<para></para>\n" nil nil nil 1)))
- ;; Insert the last closing tag.
- (goto-char (point-max))
- (unless body-only
- (insert "</article>"))
- (run-hooks 'org-export-docbook-final-hook)
- (or to-buffer (save-buffer))
- (goto-char (point-min))
- (or (org-export-push-to-kill-ring "DocBook")
- (message "Exporting... done"))
- (if (eq to-buffer 'string)
- (prog1 (buffer-substring (point-min) (point-max))
- (kill-buffer (current-buffer)))
- (current-buffer)))))
-
-(defun org-export-docbook-open-para ()
- "Insert <para>, but first close previous paragraph if any."
- (org-export-docbook-close-para-maybe)
- (insert "\n<para>")
- (setq org-docbook-para-open t))
-
-(defun org-export-docbook-close-para-maybe ()
- "Close DocBook paragraph if there is one open."
- (when org-docbook-para-open
- (insert "</para>\n")
- (setq org-docbook-para-open nil)))
-
-(defun org-export-docbook-close-li (&optional type)
- "Close list if necessary."
- (org-export-docbook-close-para-maybe)
- (if (equal type "d")
- (insert "</listitem></varlistentry>\n")
- (insert "</listitem>\n")))
-
-(defun org-export-docbook-level-start (level title)
- "Insert a new level in DocBook export.
-When TITLE is nil, just close all open levels."
- (org-export-docbook-close-para-maybe)
- (let* ((target (and title (org-get-text-property-any 0 'target title)))
- (l org-level-max)
- section-number)
- (while (>= l level)
- (if (aref org-levels-open (1- l))
- (progn
- (insert "</section>\n")
- (aset org-levels-open (1- l) nil)))
- (setq l (1- l)))
- (when title
- ;; If title is nil, this means this function is called to close
- ;; all levels, so the rest is done only if title is given.
- ;;
- ;; Format tags: put them into a superscript like format.
- (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
- (setq title
- (replace-match
- (if org-export-with-tags
- (save-match-data
- (concat
- "<superscript>"
- (match-string 1 title)
- "</superscript>"))
- "")
- t t title)))
- (aset org-levels-open (1- level) t)
- (setq section-number (org-section-number level))
- (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>"
- org-export-docbook-section-id-prefix
- (replace-regexp-in-string "\\." "_" section-number)
- title))
- (org-export-docbook-open-para))))
-
-(defun org-docbook-expand (string)
- "Prepare STRING for DocBook export.
-Applies all active conversions. If there are links in the
-string, don't modify these."
- (let* ((re (concat org-bracket-link-regexp "\\|"
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
- m s l res)
- (while (setq m (string-match re string))
- (setq s (substring string 0 m)
- l (match-string 0 string)
- string (substring string (match-end 0)))
- (push (org-docbook-do-expand s) res)
- (push l res))
- (push (org-docbook-do-expand string) res)
- (apply 'concat (nreverse res))))
-
-(defun org-docbook-do-expand (s)
- "Apply all active conversions to translate special ASCII to DocBook."
- (setq s (org-html-protect s))
- (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
- (setq s (replace-match "<\\1>" t nil s)))
- (if org-export-with-emphasize
- (setq s (org-export-docbook-convert-emphasize s)))
- (if org-export-with-special-strings
- (setq s (org-export-docbook-convert-special-strings s)))
- (if org-export-with-sub-superscripts
- (setq s (org-export-docbook-convert-sub-super s)))
- (if org-export-with-TeX-macros
- (let ((start 0) wd rep)
- (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
- s start))
- (if (get-text-property (match-beginning 0) 'org-protected s)
- (setq start (match-end 0))
- (setq wd (match-string 1 s))
- (if (setq rep (org-entity-get-representation wd 'html))
- (setq s (replace-match rep t t s))
- (setq start (+ start (length wd))))))))
- s)
-
-(defun org-export-docbook-format-desc (desc)
- "Make sure DESC is valid as a description in a link."
- (save-match-data
- (org-docbook-do-expand desc)))
-
-(defun org-export-docbook-convert-emphasize (string)
- "Apply emphasis for DocBook exporting."
- (let ((s 0) rpl)
- (while (string-match org-emph-re string s)
- (if (not (equal
- (substring string (match-beginning 3) (1+ (match-beginning 3)))
- (substring string (match-beginning 4) (1+ (match-beginning 4)))))
- (setq s (match-beginning 0)
- rpl
- (concat
- (match-string 1 string)
- (nth 1 (assoc (match-string 3 string)
- org-export-docbook-emphasis-alist))
- (match-string 4 string)
- (nth 2 (assoc (match-string 3 string)
- org-export-docbook-emphasis-alist))
- (match-string 5 string))
- string (replace-match rpl t t string)
- s (+ s (- (length rpl) 2)))
- (setq s (1+ s))))
- string))
-
-(defun org-docbook-protect (string)
- (org-html-protect string))
-
-;; For now, simply return string as it is.
-(defun org-export-docbook-convert-special-strings (string)
- "Convert special characters in STRING to DocBook."
- string)
-
-(defun org-export-docbook-get-footnotes (lines)
- "Given a list of LINES, return a list of alist footnotes."
- (let ((list nil) line)
- (while (setq line (pop lines))
- (if (string-match "^[ \t]*\\[\\([0-9]+\\)\\] \\(.+\\)" line)
- (push (cons (match-string 1 line) (match-string 2 line))
- list)))
- list))
-
-(defun org-export-docbook-format-image (src)
- "Create image element in DocBook."
- (save-match-data
- (let* ((caption (org-find-text-property-in-string 'org-caption src))
- (attr (or (org-find-text-property-in-string 'org-attributes src)
- ""))
- (label (org-find-text-property-in-string 'org-label src))
- (default-attr org-export-docbook-default-image-attributes)
- tmp)
- (setq caption (and caption (org-html-do-expand caption)))
- (while (setq tmp (pop default-attr))
- (if (not (string-match (concat (car tmp) "=") attr))
- (setq attr (concat attr " " (car tmp) "=" (cdr tmp)))))
- (format "<mediaobject%s>
-<imageobject>\n<imagedata fileref=\"%s\" %s/>\n</imageobject>
-%s</mediaobject>"
- (if label (concat " xml:id=\"" label "\"") "")
- src attr
- (if caption
- (concat "<caption>\n<para>"
- caption
- "</para>\n</caption>\n")
- "")
- ))))
-
-(defun org-export-docbook-preprocess (parameters)
- "Extra preprocessing work for DocBook export."
- ;; Merge lines starting with "\par" to one line. Such lines are
- ;; regarded as the continuation of a long footnote.
- (goto-char (point-min))
- (while (re-search-forward "\n\\(\\\\par\\>\\)" nil t)
- (if (not (get-text-property (match-beginning 1) 'org-protected))
- (replace-match ""))))
-
-(defun org-export-docbook-finalize-table (table)
- "Clean up TABLE and turn it into DocBook format.
-This function adds a label to the table if it is available, and
-also changes TABLE to informaltable if caption does not exist.
-TABLE is a string containing the HTML code generated by
-`org-format-table-html' for a table in Org-mode buffer."
- (let (table-with-label)
- ;; Get the label if it exists, and move it into the <table> element.
- (setq table-with-label
- (if (string-match
- "^<table \\(\\(.\\|\n\\)+\\)<a name=\"\\(.+\\)\" id=\".+\"></a>\n\\(\\(.\\|\n\\)+\\)</table>"
- table)
- (replace-match (concat "<table xml:id=\"" (match-string 3 table) "\" "
- (match-string 1 table)
- (match-string 4 table)
- "</table>")
- nil t table)
- table))
- ;; Change <table> into <informaltable> if caption does not exist.
- (if (string-match
- "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>"
- table-with-label)
- (replace-match (concat "<informaltable "
- (match-string 1 table-with-label)
- (match-string 3 table-with-label)
- "</informaltable>")
- nil t table-with-label)
- table-with-label)))
-
-;; Note: This function is very similar to
-;; org-export-html-convert-sub-super. They can be merged in the future.
-(defun org-export-docbook-convert-sub-super (string)
- "Convert sub- and superscripts in STRING for DocBook."
- (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
- (while (string-match org-match-substring-regexp string s)
- (cond
- ((and requireb (match-end 8)) (setq s (match-end 2)))
- ((get-text-property (match-beginning 2) 'org-protected string)
- (setq s (match-end 2)))
- (t
- (setq s (match-end 1)
- key (if (string= (match-string 2 string) "_")
- "subscript"
- "superscript")
- c (or (match-string 8 string)
- (match-string 6 string)
- (match-string 5 string))
- string (replace-match
- (concat (match-string 1 string)
- "<" key ">" c "</" key ">")
- t t string)))))
- (while (string-match "\\\\\\([_^]\\)" string)
- (setq string (replace-match (match-string 1 string) t t string)))
- string))
-
-(defun org-export-docbook-protect-tags (string)
- "Change ``<...>'' in string STRING into ``@<...>''.
-This is normally needed when STRING contains DocBook elements
-that need to be preserved in later phase of DocBook exporting."
- (let ((start 0))
- (while (string-match "<\\([^>]*\\)>" string start)
- (setq string (replace-match
- "@<\\1>" t nil string)
- start (match-end 0)))
- string))
-
-(defun org-export-docbook-handle-time-stamps (line)
- "Format time stamps in string LINE."
- (let (replaced
- (kw-markup (org-export-docbook-protect-tags
- org-export-docbook-keywords-markup))
- (ts-markup (org-export-docbook-protect-tags
- org-export-docbook-timestamp-markup)))
- (while (string-match org-maybe-keyword-time-regexp line)
- (setq replaced
- (concat replaced
- (substring line 0 (match-beginning 0))
- (if (match-end 1)
- (format kw-markup
- (match-string 1 line)))
- " "
- (format ts-markup
- (substring (org-translate-time
- (match-string 3 line)) 1 -1)))
- line (substring line (match-end 0))))
- (concat replaced line)))
-
-(defun org-export-docbook-list-line (line pos struct prevs)
- "Insert list syntax in export buffer. Return LINE, maybe modified.
-
-POS is the item position or line position the line had before
-modifications to buffer. STRUCT is the list structure. PREVS is
-the alist of previous items."
- (let* ((get-type
- (function
- ;; Translate type of list containing POS to "ordered",
- ;; "variable" or "itemized".
- (lambda (pos struct prevs)
- (let ((type (org-list-get-list-type pos struct prevs)))
- (cond
- ((eq 'ordered type) "ordered")
- ((eq 'descriptive type) "variable")
- (t "itemized"))))))
- (get-closings
- (function
- ;; Return list of all items and sublists ending at POS, in
- ;; reverse order.
- (lambda (pos)
- (let (out)
- (catch 'exit
- (mapc (lambda (e)
- (let ((end (nth 6 e))
- (item (car e)))
- (cond
- ((= end pos) (push item out))
- ((>= item pos) (throw 'exit nil)))))
- struct))
- out)))))
- ;; First close any previous item, or list, ending at POS.
- (mapc (lambda (e)
- (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
- (first-item (org-list-get-list-begin e struct prevs))
- (type (funcall get-type first-item struct prevs)))
- ;; Ending for every item
- (org-export-docbook-close-para-maybe)
- (insert (if (equal type "variable")
- "</listitem></varlistentry>\n"
- "</listitem>\n"))
- ;; We're ending last item of the list: end list.
- (when lastp
- (insert (format "</%slist>\n" type))
- (org-export-docbook-open-para))))
- (funcall get-closings pos))
- (cond
- ;; At an item: insert appropriate tags in export buffer.
- ((assq pos struct)
- (string-match (concat "[ \t]*\\(\\S-+[ \t]*\\)"
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\][ \t]*\\)?"
- "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
- "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
- "\\(.*\\)")
- line)
- (let* ((checkbox (match-string 3 line))
- (desc-tag (or (match-string 4 line) "???"))
- (body (match-string 5 line))
- (list-beg (org-list-get-list-begin pos struct prevs))
- (firstp (= list-beg pos))
- ;; Always refer to first item to determine list type, in
- ;; case list is ill-formed.
- (type (funcall get-type list-beg struct prevs))
- ;; Special variables for ordered lists.
- (counter (let ((count-tmp (org-list-get-counter pos struct)))
- (cond
- ((not count-tmp) nil)
- ((string-match "[A-Za-z]" count-tmp)
- (- (string-to-char (upcase count-tmp)) 64))
- ((string-match "[0-9]+" count-tmp)
- count-tmp)))))
- ;; When FIRSTP, a new list or sub-list is starting.
- (when firstp
- (org-export-docbook-close-para-maybe)
- (insert (format "<%slist>\n" type)))
- (insert (cond
- ((equal type "variable")
- (format "<varlistentry><term>%s</term><listitem>" desc-tag))
- ((and (equal type "ordered") counter)
- (format "<listitem override=\"%s\">" counter))
- (t "<listitem>")))
- ;; For DocBook, we need to open a para right after tag
- ;; <listitem>.
- (org-export-docbook-open-para)
- ;; If line had a checkbox, some additional modification is required.
- (when checkbox (setq body (concat checkbox " " body)))
- ;; Return modified line
- body))
- ;; At a list ender: normal text follows: need <para>.
- ((equal "ORG-LIST-END-MARKER" line)
- (org-export-docbook-open-para)
- (throw 'nextline nil))
- ;; Not at an item: return line unchanged (side-effects only).
- (t line))))
-
-(provide 'org-docbook)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-docbook.el ends here
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index be99ad99a69..5c0e3e92328 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -1,6 +1,6 @@
;;; org-docview.el --- support for links to doc-view-mode buffers
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Jan Böcker <jan.boecker at jboecker dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -44,16 +44,27 @@
(require 'org)
+(require 'doc-view)
-(declare-function doc-view-goto-page "ext:doc-view" (page))
-(declare-function image-mode-window-get "ext:image-mode"
- (prop &optional winprops))
+(declare-function doc-view-goto-page "doc-view" (page))
+(declare-function image-mode-window-get "image-mode" (prop &optional winprops))
-(org-autoload "doc-view" '(doc-view-goto-page))
-
-(org-add-link-type "docview" 'org-docview-open)
+(org-add-link-type "docview" 'org-docview-open 'org-docview-export)
(add-hook 'org-store-link-functions 'org-docview-store-link)
+(defun org-docview-export (link description format)
+ "Export a docview link from Org files."
+ (let* ((path (when (string-match "\\(.+\\)::.+" link)
+ (match-string 1 link)))
+ (desc (or description link)))
+ (when (stringp path)
+ (setq path (org-link-escape (expand-file-name path)))
+ (cond
+ ((eq format 'html) (format "<a href=\"%s\">%s</a>" path desc))
+ ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
+ ((eq format 'ascii) (format "%s (%s)" desc path))
+ (t path)))))
+
(defun org-docview-open (link)
(when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
(let* ((path (match-string 1 link))
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 5be14771961..9f4cfa3ec66 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -1,6 +1,6 @@
;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -30,25 +30,28 @@
;; to at least one element.
;;
;; An element always starts and ends at the beginning of a line. With
-;; a few exceptions (namely `babel-call', `clock', `headline', `item',
-;; `keyword', `planning', `property-drawer' and `section' types), it
-;; can also accept a fixed set of keywords as attributes. Those are
-;; called "affiliated keywords" to distinguish them from other
-;; keywords, which are full-fledged elements. Almost all affiliated
-;; keywords are referenced in `org-element-affiliated-keywords'; the
-;; others are export attributes and start with "ATTR_" prefix.
+;; a few exceptions (`clock', `headline', `inlinetask', `item',
+;; `planning', `node-property', `quote-section' `section' and
+;; `table-row' types), it can also accept a fixed set of keywords as
+;; attributes. Those are called "affiliated keywords" to distinguish
+;; them from other keywords, which are full-fledged elements. Almost
+;; all affiliated keywords are referenced in
+;; `org-element-affiliated-keywords'; the others are export attributes
+;; and start with "ATTR_" prefix.
;;
;; Element containing other elements (and only elements) are called
;; greater elements. Concerned types are: `center-block', `drawer',
;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
-;; `item', `plain-list', `quote-block', `section' and `special-block'.
+;; `item', `plain-list', `property-drawer', `quote-block', `section'
+;; and `special-block'.
;;
;; Other element types are: `babel-call', `clock', `comment',
-;; `comment-block', `example-block', `export-block', `fixed-width',
-;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
-;; `planning', `property-drawer', `quote-section', `src-block',
-;; `table', `table-row' and `verse-block'. Among them, `paragraph'
-;; and `verse-block' types can contain Org objects and plain text.
+;; `comment-block', `diary-sexp', `example-block', `export-block',
+;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
+;; `node-property', `paragraph', `planning', `quote-section',
+;; `src-block', `table', `table-row' and `verse-block'. Among them,
+;; `paragraph' and `verse-block' types can contain Org objects and
+;; plain text.
;;
;; Objects are related to document's contents. Some of them are
;; recursive. Associated types are of the following: `bold', `code',
@@ -59,7 +62,7 @@
;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
;;
;; Some elements also have special properties whose value can hold
-;; objects themselves (i.e. an item tag or an headline name). Such
+;; objects themselves (e.g. an item tag or a headline name). Such
;; values are called "secondary strings". Any object belongs to
;; either an element or a secondary string.
;;
@@ -69,9 +72,15 @@
;; refer to the beginning and ending buffer positions of the
;; considered element or object, `:post-blank', which holds the number
;; of blank lines, or white spaces, at its end and `:parent' which
-;; refers to the element or object containing it. Greater elements
-;; and elements containing objects will also have `:contents-begin'
-;; and `:contents-end' properties to delimit contents.
+;; refers to the element or object containing it. Greater elements,
+;; elements and objects containing objects will also have
+;; `:contents-begin' and `:contents-end' properties to delimit
+;; contents. Eventually, greater elements and elements accepting
+;; affiliated keywords will have a `:post-affiliated' property,
+;; referring to the buffer position after all such keywords.
+;;
+;; At the lowest level, a `:parent' property is also attached to any
+;; string, as a text property.
;;
;; Lisp-wise, an element or an object can be represented as a list.
;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
@@ -107,11 +116,10 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl))
(require 'org)
+
;;; Definitions And Rules
;;
@@ -128,15 +136,19 @@
org-outline-regexp "\\|"
;; Footnote definitions.
"\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
"[ \t]*\\(?:"
;; Empty lines.
"$" "\\|"
;; Tables (any type).
"\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls, drawers (any type),
- ;; fixed-width areas and keywords. Note: this is only an
- ;; indication and need some thorough check.
- "[#:]" "\\|"
+ ;; Blocks (any type), Babel calls and keywords. Note: this
+ ;; is only an indication and need some thorough check.
+ "#\\(?:[+ ]\\|$\\)" "\\|"
+ ;; Drawers (any type) and fixed-width areas. This is also
+ ;; only an indication.
+ ":" "\\|"
;; Horizontal rules.
"-\\{5,\\}[ \t]*$" "\\|"
;; LaTeX environments.
@@ -150,7 +162,7 @@
;; Lists.
(let ((term (case org-plain-list-ordered-item-terminator
(?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
+ (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
(concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
"\\(?:[ \t]\\|$\\)"))
"\\)\\)")
@@ -160,24 +172,25 @@ is not sufficient to know if point is at a paragraph ending. See
`org-element-paragraph-parser' for more information.")
(defconst org-element-all-elements
- '(center-block clock comment comment-block drawer dynamic-block example-block
- export-block fixed-width footnote-definition headline
- horizontal-rule inlinetask item keyword latex-environment
- babel-call paragraph plain-list planning property-drawer
- quote-block quote-section section special-block src-block table
- table-row verse-block)
+ '(babel-call center-block clock comment comment-block diary-sexp drawer
+ dynamic-block example-block export-block fixed-width
+ footnote-definition headline horizontal-rule inlinetask item
+ keyword latex-environment node-property paragraph plain-list
+ planning property-drawer quote-block quote-section section
+ special-block src-block table table-row verse-block)
"Complete list of element types.")
(defconst org-element-greater-elements
'(center-block drawer dynamic-block footnote-definition headline inlinetask
- item plain-list quote-block section special-block table)
+ item plain-list property-drawer quote-block section
+ special-block table)
"List of recursive element types aka Greater Elements.")
(defconst org-element-all-successors
- '(export-snippet footnote-reference inline-babel-call inline-src-block
- latex-or-entity line-break link macro radio-target
- statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
+ '(link export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break macro plain-link
+ radio-target statistics-cookie sub/superscript table-cell target
+ text-markup timestamp)
"Complete list of successors.")
(defconst org-element-object-successor-alist
@@ -187,7 +200,6 @@ is not sufficient to know if point is at a paragraph ending. See
(verbatim . text-markup) (entity . latex-or-entity)
(latex-fragment . latex-or-entity))
"Alist of translations between object type and successor name.
-
Sharing the same successor comes handy when, for example, the
regexp matching one object can also match the other object.")
@@ -199,11 +211,11 @@ regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link macro subscript radio-target strike-through superscript
+ '(bold italic link subscript radio-target strike-through superscript
table-cell underline)
"List of recursive object types.")
-(defconst org-element-block-name-alist
+(defvar org-element-block-name-alist
'(("CENTER" . org-element-center-block-parser)
("COMMENT" . org-element-comment-block-parser)
("EXAMPLE" . org-element-example-block-parser)
@@ -214,26 +226,19 @@ regexp matching one object can also match the other object.")
Names must be uppercase. Any block whose name has no association
is parsed with `org-element-special-block-parser'.")
+(defconst org-element-link-type-is-file
+ '("file" "file+emacs" "file+sys" "docview")
+ "List of link types equivalent to \"file\".
+Only these types can accept search options and an explicit
+application to open them.")
+
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
"List of affiliated keywords as strings.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
are affiliated keywords and need not to be in this list.")
-(defconst org-element--affiliated-re
- (format "[ \t]*#\\+%s:"
- ;; Regular affiliated keywords.
- (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
- (regexp-opt org-element-affiliated-keywords)))
- "Regexp matching any affiliated keyword.
-
-Keyword name is put in match group 1. Moreover, if keyword
-belongs to `org-element-dual-keywords', put the dual value in
-match group 2.
-
-Don't modify it, set `org-element-affiliated-keywords' instead.")
-
(defconst org-element-keyword-translation-alist
'(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
@@ -242,8 +247,8 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
The key is the old name and the value the new one. The property
holding their value will be named after the translated name.")
-(defconst org-element-multiple-keywords '("HEADER")
- "List of affiliated keywords that can occur more that once in an element.
+(defconst org-element-multiple-keywords '("CAPTION" "HEADER")
+ "List of affiliated keywords that can occur more than once in an element.
Their value will be consed into a list of strings, which will be
returned as the value of the property.
@@ -251,11 +256,11 @@ returned as the value of the property.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
allow multiple occurrences and need not to be in this list.")
-(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
- "List of keywords whose value can be parsed.
+(defconst org-element-parsed-keywords '("CAPTION")
+ "List of affiliated keywords whose value can be parsed.
Their value will be stored as a secondary string: a list of
strings and objects.
@@ -264,10 +269,10 @@ This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
- "List of keywords which can have a secondary value.
+ "List of affiliated keywords which can have a secondary value.
In Org syntax, they can be written with optional square brackets
-before the colons. For example, results keyword can be
+before the colons. For example, RESULTS keyword can be
associated to a hash value with the following:
#+RESULTS[hash-string]: some-source
@@ -275,46 +280,65 @@ associated to a hash value with the following:
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
+ "List of properties associated to the whole document.
+Any keyword in this list will have its value parsed and stored as
+a secondary string.")
+
+(defconst org-element--affiliated-re
+ (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (concat
+ ;; Dual affiliated keywords.
+ (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
+ (regexp-opt org-element-dual-keywords))
+ "\\|"
+ ;; Regular affiliated keywords.
+ (format "\\(?1:%s\\)"
+ (regexp-opt
+ (org-remove-if
+ #'(lambda (keyword)
+ (member keyword org-element-dual-keywords))
+ org-element-affiliated-keywords)))
+ "\\|"
+ ;; Export attributes.
+ "\\(?1:ATTR_[-_A-Za-z0-9]+\\)"))
+ "Regexp matching any affiliated keyword.
+
+Keyword name is put in match group 1. Moreover, if keyword
+belongs to `org-element-dual-keywords', put the dual value in
+match group 2.
+
+Don't modify it, set `org-element-affiliated-keywords' instead.")
+
(defconst org-element-object-restrictions
- '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
- radio-target sub/superscript target text-markup timestamp)
- (footnote-reference export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break link macro
- radio-target sub/superscript target text-markup
- timestamp)
- (headline inline-babel-call inline-src-block latex-or-entity link macro
- radio-target statistics-cookie sub/superscript target text-markup
- timestamp)
- (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
- radio-target sub/superscript target text-markup timestamp)
- (italic export-snippet inline-babel-call inline-src-block latex-or-entity
- link radio-target sub/superscript target text-markup timestamp)
- (item export-snippet footnote-reference inline-babel-call latex-or-entity
- link macro radio-target sub/superscript target text-markup)
- (keyword latex-or-entity macro sub/superscript text-markup)
- (link export-snippet inline-babel-call inline-src-block latex-or-entity link
- sub/superscript text-markup)
- (macro macro)
- (paragraph export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break link macro
- radio-target statistics-cookie sub/superscript target text-markup
- timestamp)
- (radio-target export-snippet latex-or-entity sub/superscript)
- (strike-through export-snippet inline-babel-call inline-src-block
- latex-or-entity link radio-target sub/superscript target
- text-markup timestamp)
- (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
- sub/superscript target text-markup)
- (superscript export-snippet inline-babel-call inline-src-block
- latex-or-entity sub/superscript target text-markup)
- (table-cell export-snippet latex-or-entity link macro radio-target
- sub/superscript target text-markup timestamp)
- (table-row table-cell)
- (underline export-snippet inline-babel-call inline-src-block latex-or-entity
- link radio-target sub/superscript target text-markup timestamp)
- (verse-block footnote-reference inline-babel-call inline-src-block
- latex-or-entity line-break link macro radio-target
- sub/superscript target text-markup timestamp))
+ (let* ((standard-set
+ (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (standard-set-no-line-break (remq 'line-break standard-set)))
+ `((bold ,@standard-set)
+ (footnote-reference ,@standard-set)
+ (headline ,@standard-set-no-line-break)
+ (inlinetask ,@standard-set-no-line-break)
+ (italic ,@standard-set)
+ (item ,@standard-set-no-line-break)
+ (keyword ,@standard-set)
+ ;; Ignore all links excepted plain links in a link description.
+ ;; Also ignore radio-targets and line breaks.
+ (link export-snippet inline-babel-call inline-src-block latex-or-entity
+ macro plain-link statistics-cookie sub/superscript text-markup)
+ (paragraph ,@standard-set)
+ ;; Remove any variable object from radio target as it would
+ ;; prevent it from being properly recognized.
+ (radio-target latex-or-entity sub/superscript text-markup)
+ (strike-through ,@standard-set)
+ (subscript ,@standard-set)
+ (superscript ,@standard-set)
+ ;; Ignore inline babel call and inline src block as formulas are
+ ;; possible. Also ignore line breaks and statistics cookies.
+ (table-cell link export-snippet footnote-reference latex-or-entity macro
+ radio-target sub/superscript target text-markup timestamp)
+ (table-row table-cell)
+ (underline ,@standard-set)
+ (verse-block ,@standard-set)))
"Alist of objects restrictions.
CAR is an element or object type containing objects and CDR is
@@ -322,8 +346,8 @@ a list of successors that will be called within an element or
object of such type.
For example, in a `radio-target' object, one can only find
-entities, export snippets, latex-fragments, subscript and
-superscript.
+entities, latex-fragments, subscript, superscript and text
+markup.
This alist also applies to secondary string. For example, an
`headline' type element doesn't directly contain objects, but
@@ -363,11 +387,14 @@ It can also return the following special value:
(defsubst org-element-property (property element)
"Extract the value from the PROPERTY of an ELEMENT."
- (plist-get (nth 1 element) property))
+ (if (stringp element) (get-text-property 0 property element)
+ (plist-get (nth 1 element) property)))
(defsubst org-element-contents (element)
"Extract contents from an ELEMENT."
- (and (consp element) (nthcdr 2 element)))
+ (cond ((not (consp element)) nil)
+ ((symbolp (car element)) (nthcdr 2 element))
+ (t element)))
(defsubst org-element-restriction (element)
"Return restriction associated to ELEMENT.
@@ -379,14 +406,15 @@ element or object type."
(defsubst org-element-put-property (element property value)
"In ELEMENT set PROPERTY to VALUE.
Return modified element."
- (when (consp element)
- (setcar (cdr element) (plist-put (nth 1 element) property value)))
- element)
+ (if (stringp element) (org-add-props element nil property value)
+ (setcar (cdr element) (plist-put (nth 1 element) property value))
+ element))
(defsubst org-element-set-contents (element &rest contents)
"Set ELEMENT contents to CONTENTS.
Return modified element."
(cond ((not element) (list contents))
+ ((not (symbolp (car element))) contents)
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
@@ -415,18 +443,18 @@ objects, or a strings.
The function takes care of setting `:parent' property for CHILD.
Return parent element."
- (if (not parent) children
- ;; Link every child to PARENT.
- (mapc (lambda (child)
- (unless (stringp child)
- (org-element-put-property child :parent parent)))
- children)
- ;; Add CHILDREN at the end of PARENT contents.
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (mapc (lambda (child)
+ (org-element-put-property child :parent (or parent children)))
+ children)
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
(apply 'org-element-set-contents
parent
- (nconc (org-element-contents parent) children))
- ;; Return modified PARENT element.
- parent))
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children))
@@ -466,24 +494,27 @@ Return parent element."
;;;; Center Block
-(defun org-element-center-block-parser (limit)
+(defun org-element-center-block-parser (limit affiliated)
"Parse a center block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `center-block' and CDR is a plist
containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -493,9 +524,9 @@ Assume point is at the beginning of the block."
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
- (end (save-excursion (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (end (save-excursion
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'center-block
(nconc
(list :begin begin
@@ -503,8 +534,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-center-block-interpreter (center-block contents)
"Interpret CENTER-BLOCK element as Org syntax.
@@ -514,49 +546,51 @@ CONTENTS is the contents of the element."
;;;; Drawer
-(defun org-element-drawer-parser (limit)
+(defun org-element-drawer-parser (limit affiliated)
"Parse a drawer.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
;; Incomplete drawer: parse it as a paragraph.
- (org-element-paragraph-parser limit)
- (let ((drawer-end-line (match-beginning 0)))
- (save-excursion
- (let* ((case-fold-search t)
- (name (progn (looking-at org-drawer-regexp)
- (org-match-string-no-properties 1)))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- ;; Empty drawers have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) drawer-end-line)
- (point))))
- (contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'drawer
- (nconc
- (list :begin begin
- :end end
- :drawer-name name
- :hiddenp hidden
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (name (progn (looking-at org-drawer-regexp)
+ (org-match-string-no-properties 1)))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ ;; Empty drawers have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
+ (point))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :drawer-name name
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
@@ -568,29 +602,32 @@ CONTENTS is the contents of the element."
;;;; Dynamic Block
-(defun org-element-dynamic-block-parser (limit)
+(defun org-element-dynamic-block-parser (limit affiliated)
"Parse a dynamic block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments' and
-`:post-blank' keywords.
+`:contents-begin', `:contents-end', `:arguments', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
(let* ((name (progn (looking-at org-dblock-start-re)
(org-match-string-no-properties 1)))
(arguments (org-match-string-no-properties 3))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -601,8 +638,7 @@ Assume point is at beginning of dynamic block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'dynamic-block
(nconc
(list :begin begin
@@ -612,8 +648,9 @@ Assume point is at beginning of dynamic block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
@@ -627,38 +664,43 @@ CONTENTS is the contents of the element."
;;;; Footnote Definition
-(defun org-element-footnote-definition-parser (limit)
+(defun org-element-footnote-definition-parser (limit affiliated)
"Parse a footnote definition.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `footnote-definition' and CDR is
a plist containing `:label', `:begin' `:end', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
(org-match-string-no-properties 1)))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
(ending (save-excursion
(if (progn
(end-of-line)
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") limit 'move))
+ "^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
(match-beginning 0)
(point))))
- (contents-begin (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (and (/= (point) ending) (point))))
+ (contents-begin (progn
+ (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (cond ((= (point) ending) nil)
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
(contents-end (and contents-begin ending))
(end (progn (goto-char ending)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'footnote-definition
(nconc
(list :label label
@@ -666,8 +708,9 @@ Assume point is at the beginning of the footnote definition."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines ending end))
- (cadr keywords))))))
+ :post-blank (count-lines ending end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
@@ -680,19 +723,21 @@ CONTENTS is the contents of the footnote-definition."
;;;; Headline
(defun org-element-headline-parser (limit &optional raw-secondary-p)
- "Parse an headline.
+ "Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:begin', `:end',
-`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
-`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
-`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
-`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
-keywords.
+containing `:raw-value', `:title', `:alt-title', `:begin',
+`:end', `:pre-blank', `:hiddenp', `:contents-begin',
+`:contents-end', `:level', `:priority', `:tags',
+`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
+`:closed', `:quotedp', `:archivedp', `:commentedp',
+`:footnote-section-p' and `:post-blank' keywords.
The plist also contains any property set in the property drawer,
-with its name in lowercase, the underscores replaced with hyphens
-and colons at the beginning (i.e. `:custom-id').
+with its name in upper cases and colons added at the
+beginning (e.g., `:CUSTOM_ID').
+
+LIMIT is a buffer position bounding the search.
When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.
@@ -718,27 +763,39 @@ Assume point is at beginning of the headline."
(archivedp (member org-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
- ;; Normalize property names: ":SOME_PROP:" becomes
- ;; ":some-prop".
- (standard-props (let (plist)
- (mapc
- (lambda (p)
- (let ((p-name (downcase (car p))))
- (while (string-match "_" p-name)
- (setq p-name
- (replace-match "-" nil nil p-name)))
- (setq p-name (intern (concat ":" p-name)))
- (setq plist
- (plist-put plist p-name (cdr p)))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props (org-entry-properties nil 'special "CLOCK"))
- (scheduled (cdr (assoc "SCHEDULED" time-props)))
- (deadline (cdr (assoc "DEADLINE" time-props)))
- (clock (cdr (assoc "CLOCK" time-props)))
- (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the headline.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(begin (point))
- (end (save-excursion (goto-char (org-end-of-subtree t t))))
+ (end (min (save-excursion (org-end-of-subtree t t)) limit))
(pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
@@ -778,21 +835,22 @@ Assume point is at beginning of the headline."
:tags tags
:todo-keyword todo
:todo-type todo-type
- :scheduled scheduled
- :deadline deadline
- :timestamp timestamp
- :clock clock
:post-blank (count-lines
- (if (not contents-end) pos-after-head
- (goto-char contents-end)
- (forward-line)
- (point))
+ (or contents-end pos-after-head)
end)
:footnote-section-p footnote-section-p
:archivedp archivedp
:commentedp commentedp
:quotedp quotedp)
+ time-props
standard-props))))
+ (let ((alt-title (org-element-property :ALT_TITLE headline)))
+ (when alt-title
+ (org-element-put-property
+ headline :alt-title
+ (if raw-secondary-p alt-title
+ (org-element-parse-secondary-string
+ alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
@@ -812,38 +870,40 @@ CONTENTS is the contents of the element."
(org-element-property :tags headline))
(org-element-property :tags headline))))
(and tag-list
- (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (format ":%s:" (mapconcat #'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
(quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
- (heading (concat (make-string level ?*)
- (and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
- (and commentedp (concat " " org-comment-string))
- (and priority
- (format " [#%s]" (char-to-string priority)))
- (cond ((and org-footnote-section
- (org-element-property
- :footnote-section-p headline))
- (concat " " org-footnote-section))
- (title (concat " " title))))))
- (concat heading
- ;; Align tags.
- (when tags
- (cond
- ((zerop org-tags-column) (format " %s" tags))
- ((< org-tags-column 0)
- (concat
- (make-string
- (max (- (+ org-tags-column (length heading) (length tags))) 1)
- ? )
- tags))
- (t
- (concat
- (make-string (max (- org-tags-column (length heading)) 1) ? )
- tags))))
- (make-string (1+ pre-blank) 10)
- contents)))
+ (heading
+ (concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
+ ?*)
+ (and todo (concat " " todo))
+ (and quotedp (concat " " org-quote-string))
+ (and commentedp (concat " " org-comment-string))
+ (and priority (format " [#%s]" (char-to-string priority)))
+ " "
+ (if (and org-footnote-section
+ (org-element-property :footnote-section-p headline))
+ org-footnote-section
+ title))))
+ (concat
+ heading
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length heading) (length tags))) 1)
+ ?\s)
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length heading)) 1) ?\s)
+ tags))))
+ (make-string (1+ pre-blank) ?\n)
+ contents)))
;;;; Inlinetask
@@ -855,12 +915,11 @@ Return a list whose CAR is `inlinetask' and CDR is a plist
containing `:title', `:begin', `:end', `:hiddenp',
`:contents-begin' and `:contents-end', `:level', `:priority',
`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:timestamp', `:clock' and
-`:post-blank' keywords.
+`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
The plist also contains any property set in the property drawer,
-with its name in lowercase, the underscores replaced with hyphens
-and colons at the beginning (i.e. `:custom-id').
+with its name in upper cases and colons added at the
+beginning (e.g., `:CUSTOM_ID').
When optional argument RAW-SECONDARY-P is non-nil, inline-task's
title will not be parsed as a secondary string, but as a plain
@@ -868,8 +927,7 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (point))
(components (org-heading-components))
(todo (nth 2 components))
(todo-type (and todo
@@ -877,29 +935,43 @@ Assume point is at beginning of the inline task."
(tags (let ((raw-tags (nth 5 components)))
(and raw-tags (org-split-string raw-tags ":"))))
(raw-value (or (nth 4 components) ""))
- ;; Normalize property names: ":SOME_PROP:" becomes
- ;; ":some-prop".
- (standard-props (let (plist)
- (mapc
- (lambda (p)
- (let ((p-name (downcase (car p))))
- (while (string-match "_" p-name)
- (setq p-name
- (replace-match "-" nil nil p-name)))
- (setq p-name (intern (concat ":" p-name)))
- (setq plist
- (plist-put plist p-name (cdr p)))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props (org-entry-properties nil 'special "CLOCK"))
- (scheduled (cdr (assoc "SCHEDULED" time-props)))
- (deadline (cdr (assoc "DEADLINE" time-props)))
- (clock (cdr (assoc "CLOCK" time-props)))
- (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the inlinetask
+ ;; opening string.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(task-end (save-excursion
(end-of-line)
- (and (re-search-forward "^\\*+ END" limit t)
- (match-beginning 0))))
+ (and (re-search-forward org-outline-regexp-bol limit t)
+ (org-looking-at-p "END[ \t]*$")
+ (line-beginning-position))))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
(hidden (and contents-begin (org-invisible-p2)))
@@ -909,8 +981,7 @@ Assume point is at beginning of the inline task."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(inlinetask
(list 'inlinetask
(nconc
@@ -925,13 +996,9 @@ Assume point is at beginning of the inline task."
:tags tags
:todo-keyword todo
:todo-type todo-type
- :scheduled scheduled
- :deadline deadline
- :timestamp timestamp
- :clock clock
:post-blank (count-lines before-blank end))
- standard-props
- (cadr keywords)))))
+ time-props
+ standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
@@ -1063,7 +1130,11 @@ Assume point is at the beginning of the item."
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
CONTENTS is the contents of the element."
- (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
+ (let* ((bullet (let ((bullet (org-element-property :bullet item)))
+ (org-list-bullet-string
+ (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ")
+ ((eq org-plain-list-ordered-item-terminator ?\)) "1)")
+ (t "1.")))))
(checkbox (org-element-property :checkbox item))
(counter (org-element-property :counter item))
(tag (let ((tag (org-element-property :tag item)))
@@ -1082,40 +1153,127 @@ CONTENTS is the contents of the element."
(off "[ ] ")
(trans "[-] "))
(and tag (format "%s :: " tag))
- (let ((contents (replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
- (if item-starts-with-par-p (org-trim contents)
- (concat "\n" contents))))))
+ (when contents
+ (let ((contents (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
+ (if item-starts-with-par-p (org-trim contents)
+ (concat "\n" contents)))))))
;;;; Plain List
-(defun org-element-plain-list-parser (limit &optional structure)
+(defun org-element--list-struct (limit)
+ ;; Return structure of list at point. Internal function. See
+ ;; `org-list-struct' for details.
+ (let ((case-fold-search t)
+ (top-ind limit)
+ (item-re (org-item-re))
+ (drawers-re (concat ":\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ items struct)
+ (save-excursion
+ (catch 'exit
+ (while t
+ (cond
+ ;; At limit: end all items.
+ ((>= (point) limit)
+ (throw 'exit
+ (let ((end (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) end)))))
+ ;; At list end: end all items.
+ ((looking-at org-list-end-re)
+ (throw 'exit (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) (point)))))
+ ;; At a new item: end previous sibling.
+ ((looking-at item-re)
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
+ (setq top-ind (min top-ind ind))
+ (while (and items (<= ind (nth 1 (car items))))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (point))
+ (push item struct)))
+ (push (progn (looking-at org-list-full-item-re)
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data
+ (string-match "[-+*]" bullet))
+ (match-string-no-properties 4))
+ ;; Ending position, unknown so far.
+ nil)))
+ items))
+ (forward-line 1))
+ ;; Skip empty lines.
+ ((looking-at "^[ \t]*$") (forward-line))
+ ;; Skip inline tasks and blank lines along the way.
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (forward-line)
+ (let ((origin (point)))
+ (when (re-search-forward inlinetask-re limit t)
+ (if (org-looking-at-p "END[ \t]*$") (forward-line)
+ (goto-char origin)))))
+ ;; At some text line. Check if it ends any previous item.
+ (t
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (when (<= ind top-ind)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (while (<= ind (nth 1 (car items)))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (line-beginning-position))
+ (push item struct)
+ (unless items
+ (throw 'exit (sort struct 'car-less-than-car))))))
+ ;; Skip blocks (any type) and drawers contents.
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$"
+ (org-match-string-no-properties 1))
+ limit t)))
+ ((and (looking-at drawers-re)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
+ (forward-line))))))))
+
+(defun org-element-plain-list-parser (limit affiliated structure)
"Parse a plain list.
-Optional argument STRUCTURE, when non-nil, is the structure of
-the plain list being parsed.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value. STRUCTURE is the structure of the plain list being
+parsed.
Return a list whose CAR is `plain-list' and CDR is a plist
containing `:type', `:begin', `:end', `:contents-begin' and
-`:contents-end', `:structure' and `:post-blank' keywords.
+`:contents-end', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the list."
(save-excursion
- (let* ((struct (or structure (org-list-struct)))
+ (let* ((struct (or structure (org-element--list-struct limit)))
(prevs (org-list-prevs-alist struct))
- (parents (org-list-parents-alist struct))
(type (org-list-get-list-type (point) struct prevs))
(contents-begin (point))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
(contents-end
(progn (goto-char (org-list-get-list-end (point) struct prevs))
(unless (bolp) (forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
(nconc
@@ -1125,8 +1283,9 @@ Assume point is at the beginning of the list."
:contents-begin contents-begin
:contents-end contents-end
:structure struct
- :post-blank (count-lines contents-end end))
- (cadr keywords))))))
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-plain-list-interpreter (plain-list contents)
"Interpret PLAIN-LIST element as Org syntax.
@@ -1138,27 +1297,82 @@ CONTENTS is the contents of the element."
(buffer-string)))
+;;;; Property Drawer
+
+(defun org-element-property-drawer-parser (limit affiliated)
+ "Parse a property drawer.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `property-drawer' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+
+Assume point is at the beginning of the property drawer."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ;; Incomplete drawer: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (contents-begin
+ (progn
+ (forward-line)
+ (and (re-search-forward org-property-re drawer-end-line t)
+ (line-beginning-position))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'property-drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
+
+(defun org-element-property-drawer-interpreter (property-drawer contents)
+ "Interpret PROPERTY-DRAWER element as Org syntax.
+CONTENTS is the properties within the drawer."
+ (format ":PROPERTIES:\n%s:END:" contents))
+
+
;;;; Quote Block
-(defun org-element-quote-block-parser (limit)
+(defun org-element-quote-block-parser (limit affiliated)
"Parse a quote block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `quote-block' and CDR is a plist
containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -1169,8 +1383,7 @@ Assume point is at the beginning of the block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'quote-block
(nconc
(list :begin begin
@@ -1178,8 +1391,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-quote-block-interpreter (quote-block contents)
"Interpret QUOTE-BLOCK element as Org syntax.
@@ -1221,28 +1435,33 @@ CONTENTS is the contents of the element."
;;;; Special Block
-(defun org-element-special-block-parser (limit)
+(defun org-element-special-block-parser (limit affiliated)
"Parse a special block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `special-block' and CDR is a plist
containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end' and `:post-blank' keywords.
+`:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(upcase (match-string-no-properties 1)))))
(if (not (save-excursion
(re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
+ limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
@@ -1253,8 +1472,7 @@ Assume point is at the beginning of the block."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'special-block
(nconc
(list :type type
@@ -1263,8 +1481,9 @@ Assume point is at the beginning of the block."
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
@@ -1290,28 +1509,34 @@ CONTENTS is the contents of the element."
;;;; Babel Call
-(defun org-element-babel-call-parser (limit)
+(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info' and `:post-blank' as
-keywords."
+containing `:begin', `:end', `:info', `:post-blank' and
+`:post-affiliated' as keywords."
(save-excursion
(let ((case-fold-search t)
(info (progn (looking-at org-babel-block-lob-one-liner-regexp)
(org-babel-lob-get-info)))
- (begin (point-at-bol))
+ (begin (car affiliated))
+ (post-affiliated (point))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax.
@@ -1340,13 +1565,13 @@ as keywords."
(let* ((case-fold-search nil)
(begin (point))
(value (progn (search-forward org-clock-string (line-end-position) t)
- (org-skip-whitespace)
- (looking-at "\\[.*\\]")
- (org-match-string-no-properties 0)))
- (time (and (progn (goto-char (match-end 0))
- (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
- (status (if time 'closed 'running))
+ (skip-chars-forward " \t")
+ (org-element-timestamp-parser)))
+ (duration (and (search-forward " => " (line-end-position) t)
+ (progn (skip-chars-forward " \t")
+ (looking-at "\\(\\S-+\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ (status (if duration 'closed 'running))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
(skip-chars-backward " \t")
@@ -1356,7 +1581,7 @@ as keywords."
(list 'clock
(list :status status
:value value
- :time time
+ :duration duration
:begin begin
:end end
:post-blank post-blank)))))
@@ -1365,30 +1590,34 @@ as keywords."
"Interpret CLOCK element as Org syntax.
CONTENTS is nil."
(concat org-clock-string " "
- (org-element-property :value clock)
- (let ((time (org-element-property :time clock)))
- (and time
+ (org-element-timestamp-interpreter
+ (org-element-property :value clock) nil)
+ (let ((duration (org-element-property :duration clock)))
+ (and duration
(concat " => "
(apply 'format
"%2s:%02s"
- (org-split-string time ":")))))))
+ (org-split-string duration ":")))))))
;;;; Comment
-(defun org-element-comment-parser (limit)
+(defun org-element-comment-parser (limit affiliated)
"Parse a comment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank',
+`:post-affiliated' keywords.
Assume point is at comment beginning."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(value (prog2 (looking-at "[ \t]*# ?")
(buffer-substring-no-properties
(match-end 0) (line-end-position))
@@ -1408,15 +1637,15 @@ Assume point is at comment beginning."
(point)))
(end (progn (goto-char com-end)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'comment
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines com-end end))
- (cadr keywords))))))
+ :post-blank (count-lines com-end end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-comment-interpreter (comment contents)
"Interpret COMMENT element as Org syntax.
@@ -1426,33 +1655,35 @@ CONTENTS is nil."
;;;; Comment Block
-(defun org-element-comment-block-parser (limit)
+(defun org-element-comment-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties
contents-begin contents-end)))
(list 'comment-block
@@ -1461,8 +1692,9 @@ Assume point is at comment block beginning."
:end end
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-comment-block-interpreter (comment-block contents)
"Interpret COMMENT-BLOCK element as Org syntax.
@@ -1471,32 +1703,105 @@ CONTENTS is nil."
(org-remove-indentation (org-element-property :value comment-block))))
+;;;; Diary Sexp
+
+(defun org-element-diary-sexp-parser (limit affiliated)
+ "Parse a diary sexp.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `diary-sexp' and CDR is a plist
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords."
+ (save-excursion
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+ (org-match-string-no-properties 1)))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'diary-sexp
+ (nconc
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
+
+(defun org-element-diary-sexp-interpreter (diary-sexp contents)
+ "Interpret DIARY-SEXP as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value diary-sexp))
+
+
;;;; Example Block
-(defun org-element-example-block-parser (limit)
+(defun org-element--remove-indentation (s &optional n)
+ "Remove maximum common indentation in string S and return it.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible, or return
+S as-is otherwise. Unlike to `org-remove-indentation', this
+function doesn't call `untabify' on S."
+ (catch 'exit
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (setq n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw 'exit s)
+ (setq min-ind (min min-ind ind))))))
+ min-ind)))
+ (if (zerop n) s
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw 'exit s))
+ (t (org-indent-line-to (- ind n))))
+ (forward-line)))
+ (buffer-string)))))
+
+(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value' and `:post-blank' keywords."
+`:switches', `:value', `:post-blank' and `:post-affiliated'
+keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
(let* ((switches
- (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
+ (progn
+ (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (org-match-string-no-properties 1)))
;; Switches analysis
- (number-lines (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (and switches (string-match "-i\\>" switches)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent
+ (or org-src-preserve-indentation
+ (and switches (string-match "-i\\>" switches))))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
@@ -1507,24 +1812,28 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
;; line-numbers?
(use-labels
(or (not switches)
- (and retain-labels (not (string-match "-k\\>" switches)))))
- (label-fmt (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (and retain-labels
+ (not (string-match "-k\\>" switches)))))
+ (label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
;; Standard block parsing.
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end))
+ (and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'example-block
(nconc
(list :begin begin
@@ -1537,30 +1846,33 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
:use-labels use-labels
:label-fmt label-fmt
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-example-block-interpreter (example-block contents)
"Interpret EXAMPLE-BLOCK element as Org syntax.
CONTENTS is nil."
(let ((switches (org-element-property :switches example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
- (org-remove-indentation
- (org-escape-code-in-string
- (org-element-property :value example-block)))
+ (org-escape-code-in-string
+ (org-element-property :value example-block))
"#+END_EXAMPLE")))
;;;; Export Block
-(defun org-element-export-block-parser (limit)
+(defun org-element-export-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:type', `:hiddenp', `:value',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
@@ -1570,19 +1882,18 @@ Assume point is at export-block beginning."
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties contents-begin
contents-end)))
(list 'export-block
@@ -1592,8 +1903,9 @@ Assume point is at export-block beginning."
:type type
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-export-block-interpreter (export-block contents)
"Interpret EXPORT-BLOCK element as Org syntax.
@@ -1606,18 +1918,22 @@ CONTENTS is nil."
;;;; Fixed-width
-(defun org-element-fixed-width-parser (limit)
+(defun org-element-fixed-width-parser (limit affiliated)
"Parse a fixed-width section.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `fixed-width' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the fixed-width area."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
value
(end-area
(progn
@@ -1632,45 +1948,52 @@ Assume point is at the beginning of the fixed-width area."
(forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'fixed-width
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines end-area end))
- (cadr keywords))))))
+ :post-blank (count-lines end-area end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-fixed-width-interpreter (fixed-width contents)
"Interpret FIXED-WIDTH element as Org syntax.
CONTENTS is nil."
- (replace-regexp-in-string
- "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
+ (let ((value (org-element-property :value fixed-width)))
+ (and value
+ (replace-regexp-in-string
+ "^" ": "
+ (if (string-match "\n\\'" value) (substring value 0 -1) value)))))
;;;; Horizontal Rule
-(defun org-element-horizontal-rule-parser (limit)
+(defun org-element-horizontal-rule-parser (limit affiliated)
"Parse an horizontal rule.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `horizontal-rule' and CDR is a plist
-containing `:begin', `:end' and `:post-blank' keywords."
+containing `:begin', `:end', `:post-blank' and `:post-affiliated'
+keywords."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- (post-hr (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (post-hr (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'horizontal-rule
(nconc
(list :begin begin
:end end
- :post-blank (count-lines post-hr end))
- (cadr keywords))))))
+ :post-blank (count-lines post-hr end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
"Interpret HORIZONTAL-RULE element as Org syntax.
@@ -1680,31 +2003,36 @@ CONTENTS is nil."
;;;; Keyword
-(defun org-element-keyword-parser (limit)
+(defun org-element-keyword-parser (limit affiliated)
"Parse a keyword at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `keyword' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' keywords."
(save-excursion
- (let* ((case-fold-search t)
- (begin (point))
- (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
- (upcase (org-match-string-no-properties 1))))
- (value (org-trim (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
+ (upcase (org-match-string-no-properties 1))))
+ (value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'keyword
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-keyword-interpreter (keyword contents)
"Interpret KEYWORD element as Org syntax.
@@ -1716,39 +2044,41 @@ CONTENTS is nil."
;;;; Latex Environment
-(defun org-element-latex-environment-parser (limit)
+(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `latex-environment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the latex environment."
(save-excursion
- (let* ((case-fold-search t)
- (code-begin (point))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (regexp-quote (match-string 1))))
- (code-end
- (progn (re-search-forward
- (format "^[ \t]*\\\\end{%s}[ \t]*$" env) limit t)
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties code-begin code-end))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end))
- (cadr keywords))))))
+ (let ((case-fold-search t)
+ (code-begin (point)))
+ (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
+ (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t))
+ ;; Incomplete latex environment: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (let* ((code-end (progn (forward-line) (point)))
+ (begin (car affiliated))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated))))))))
(defun org-element-latex-environment-interpreter (latex-environment contents)
"Interpret LATEX-ENVIRONMENT element as Org syntax.
@@ -1756,28 +2086,58 @@ CONTENTS is nil."
(org-element-property :value latex-environment))
+;;;; Node Property
+
+(defun org-element-node-property-parser (limit)
+ "Parse a node-property at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `node-property' and CDR is a plist
+containing `:key', `:value', `:begin', `:end' and `:post-blank'
+keywords."
+ (looking-at org-property-re)
+ (let ((begin (point))
+ (key (org-match-string-no-properties 2))
+ (value (org-match-string-no-properties 3))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward org-property-re limit t)
+ (line-beginning-position)
+ limit))))
+ (list 'node-property
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank 0))))
+
+(defun org-element-node-property-interpreter (node-property contents)
+ "Interpret NODE-PROPERTY element as Org syntax.
+CONTENTS is nil."
+ (format org-property-format
+ (format ":%s:" (org-element-property :key node-property))
+ (or (org-element-property :value node-property) "")))
+
+
;;;; Paragraph
-(defun org-element-paragraph-parser (limit)
+(defun org-element-paragraph-parser (limit affiliated)
"Parse a paragraph.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `paragraph' and CDR is a plist
containing `:begin', `:end', `:contents-begin' and
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the paragraph."
(save-excursion
- (let* ((contents-begin (point))
- ;; INNER-PAR-P is non-nil when paragraph is at the
- ;; beginning of an item or a footnote reference. In that
- ;; case, we mustn't look for affiliated keywords since they
- ;; belong to the container.
- (inner-par-p (not (bolp)))
- (keywords (unless inner-par-p
- (org-element--collect-affiliated-keywords)))
- (begin (if inner-par-p contents-begin (car keywords)))
+ (let* ((begin (car affiliated))
+ (contents-begin (point))
(before-blank
(let ((case-fold-search t))
(end-of-line)
@@ -1787,8 +2147,8 @@ Assume point is at the beginning of the paragraph."
;; A matching `org-element-paragraph-separate' is not
;; necessarily the end of the paragraph. In
;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have check
- ;; if they are valid Org syntax (i.e. not an
+ ;; non-space character are ambiguous. We have to
+ ;; check if they are valid Org syntax (e.g., not an
;; incomplete keyword).
(beginning-of-line)
(while (not
@@ -1811,20 +2171,21 @@ Assume point is at the beginning of the paragraph."
(re-search-forward
"^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Stop at valid blocks.
- (and (looking-at
- "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid latex environments.
(and (looking-at
- "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
(save-excursion
(re-search-forward
(format "^[ \t]*\\\\end{%s}[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid keywords.
(looking-at "[ \t]*#\\+\\S-+:")
@@ -1841,16 +2202,16 @@ Assume point is at the beginning of the paragraph."
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'paragraph
(nconc
(list :begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines before-blank end))
- (cadr keywords))))))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-paragraph-interpreter (paragraph contents)
"Interpret PARAGRAPH element as Org syntax.
@@ -1879,13 +2240,11 @@ and `:post-blank' keywords."
(end (point))
closed deadline scheduled)
(goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position) t)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
(goto-char (match-end 1))
- (org-skip-whitespace)
- (let ((time (buffer-substring-no-properties
- (1+ (point)) (1- (match-end 0))))
- (keyword (match-string 1)))
+ (skip-chars-forward " \t" end)
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
(cond ((equal keyword org-closed-string) (setq closed time))
((equal keyword org-deadline-string) (setq deadline time))
(t (setq scheduled time)))))
@@ -1903,69 +2262,21 @@ CONTENTS is nil."
(mapconcat
'identity
(delq nil
- (list (let ((closed (org-element-property :closed planning)))
- (when closed (concat org-closed-string " [" closed "]")))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline (concat org-deadline-string " <" deadline ">")))
+ (list (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-element-timestamp-interpreter deadline nil))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
- (concat org-scheduled-string " <" scheduled ">")))))
+ (concat org-scheduled-string " "
+ (org-element-timestamp-interpreter scheduled nil))))
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-element-timestamp-interpreter closed nil))))))
" "))
-;;;; Property Drawer
-
-(defun org-element-property-drawer-parser (limit)
- "Parse a property drawer.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:properties' and `:post-blank' keywords.
-
-Assume point is at the beginning of the property drawer."
- (save-excursion
- (let ((case-fold-search t)
- (begin (point))
- (prop-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (properties
- (let (val)
- (while (not (looking-at "^[ \t]*:END:[ \t]*$"))
- (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
- (push (cons (org-match-string-no-properties 1)
- (org-trim
- (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- val))
- (forward-line))
- val))
- (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
- (point-at-bol)))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'property-drawer
- (list :begin begin
- :end end
- :hiddenp hidden
- :properties properties
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-property-drawer-interpreter (property-drawer contents)
- "Interpret PROPERTY-DRAWER element as Org syntax.
-CONTENTS is nil."
- (let ((props (org-element-property :properties property-drawer)))
- (concat
- ":PROPERTIES:\n"
- (mapconcat (lambda (p)
- (format org-property-format (format ":%s:" (car p)) (cdr p)))
- (nreverse props) "\n")
- "\n:END:")))
-
-
;;;; Quote Section
(defun org-element-quote-section-parser (limit)
@@ -1999,28 +2310,30 @@ CONTENTS is nil."
;;;; Src Block
-(defun org-element-src-block-parser (limit)
+(defun org-element-src-block-parser (limit affiliated)
"Parse a src block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value' and
-`:post-blank' keywords.
+`:use-labels', `:label-fmt', `:preserve-indent', `:value',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$"
limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- ;; Get beginning position.
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Get language as a string.
(language
(progn
@@ -2035,13 +2348,17 @@ Assume point is at the beginning of the block."
;; Get parameters.
(parameters (org-match-string-no-properties 3))
;; Switches analysis
- (number-lines (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (and switches (string-match "-i\\>" switches)))
- (label-fmt (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (or org-src-preserve-indentation
+ (and switches
+ (string-match "-i\\>" switches))))
+ (label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
;; Should labels be retained in (or stripped from)
;; src blocks?
(retain-labels
@@ -2052,19 +2369,24 @@ Assume point is at the beginning of the block."
;; line-numbers?
(use-labels
(or (not switches)
- (and retain-labels (not (string-match "-k\\>" switches)))))
+ (and retain-labels
+ (not (string-match "-k\\>" switches)))))
+ ;; Indentation.
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
;; Get visibility status.
(hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties (point) contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (point) contents-end))
+ (and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
;; Get position after ending blank lines.
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'src-block
(nconc
(list :language language
@@ -2081,8 +2403,9 @@ Assume point is at the beginning of the block."
:label-fmt label-fmt
:hiddenp hidden
:value value
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-src-block-interpreter (src-block contents)
"Interpret SRC-BLOCK element as Org syntax.
@@ -2092,15 +2415,13 @@ CONTENTS is nil."
(params (org-element-property :parameters src-block))
(value (let ((val (org-element-property :value src-block)))
(cond
- (org-src-preserve-indentation val)
- ((zerop org-edit-src-content-indentation)
- (org-remove-indentation val))
+ ((org-element-property :preserve-indent src-block) val)
+ ((zerop org-edit-src-content-indentation) val)
(t
(let ((ind (make-string
org-edit-src-content-indentation 32)))
(replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind
- (org-remove-indentation val) nil nil 1)))))))
+ "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
@@ -2111,22 +2432,25 @@ CONTENTS is nil."
;;;; Table
-(defun org-element-table-parser (limit)
+(defun org-element-table-parser (limit affiliated)
"Parse a table at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `table' and CDR is a plist containing
`:begin', `:end', `:tblfm', `:type', `:contents-begin',
-`:contents-end', `:value' and `:post-blank' keywords.
+`:contents-end', `:value', `:post-blank' and `:post-affiliated'
+keywords.
Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
(type (if (org-at-table.el-p) 'table.el 'org))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
(table-end
(if (re-search-forward org-table-any-border-regexp limit 'm)
(goto-char (match-beginning 0))
@@ -2138,8 +2462,7 @@ Assume point is at the beginning of the table."
acc))
(pos-before-blank (point))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'table
(nconc
(list :begin begin
@@ -2154,12 +2477,13 @@ Assume point is at the beginning of the table."
:value (and (eq type 'table.el)
(buffer-substring-no-properties
table-begin table-end))
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin)
+ (cdr affiliated))))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
-CONTENTS is nil."
+CONTENTS is a string, if table's type is `org', or nil."
(if (eq (org-element-property :type table) 'table.el)
(org-remove-indentation (org-element-property :value table))
(concat (with-temp-buffer (insert contents)
@@ -2211,33 +2535,35 @@ CONTENTS is the contents of the table row."
;;;; Verse Block
-(defun org-element-verse-block-parser (limit)
+(defun org-element-verse-block-parser (limit affiliated)
"Parse a verse block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp' and `:post-blank' keywords.
+`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(hidden (progn (forward-line) (org-invisible-p2)))
(contents-begin (point))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'verse-block
(nconc
(list :begin begin
@@ -2245,8 +2571,9 @@ Assume point is at beginning of the block."
:contents-begin contents-begin
:contents-end contents-end
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-verse-block-interpreter (verse-block contents)
"Interpret VERSE-BLOCK element as Org syntax.
@@ -2259,8 +2586,8 @@ CONTENTS is verse block contents."
;;
;; Unlike to elements, interstices can be found between objects.
;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (i.e. `code'
-;; and `verbatim' objects).
+;; for each object. Some objects share the same successor (e.g.,
+;; `code' and `verbatim' objects).
;;
;; A successor must accept a single argument bounding the search. It
;; will return either a cons cell whose CAR is the object's type, as
@@ -2270,7 +2597,7 @@ CONTENTS is verse block contents."
;; org-element-NAME-successor, where NAME is the name of the
;; successor, as defined in `org-element-all-successors'.
;;
-;; Some object types (i.e. `italic') are recursive. Restrictions on
+;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
@@ -2312,17 +2639,15 @@ Assume point is at the first star marker."
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor (limit)
+(defun org-element-text-markup-successor ()
"Search for the next text-markup object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is a symbol among `bold',
`italic', `underline', `strike-through', `code' and `verbatim'
and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re limit t)
+ (when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
@@ -2404,25 +2729,19 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor (limit)
+(defun org-element-latex-or-entity-successor ()
"Search for the next latex-fragment or entity object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `entity' or
`latex-fragment' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (let ((matchers
- (remove "begin" (plist-get org-format-latex-options :matchers)))
+ (let ((matchers (cdr org-latex-regexps))
;; ENTITY-RE matches both LaTeX commands and Org entities.
(entity-re
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
(when (re-search-forward
- (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
- matchers "\\|")
- "\\|" entity-re)
- limit t)
+ (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
@@ -2432,12 +2751,9 @@ Return value is a cons cell whose CAR is `entity' or
;; Determine its type to get the correct beginning position.
(cons 'latex-fragment
(catch 'return
- (mapc (lambda (e)
- (when (looking-at (nth 1 (assoc e org-latex-regexps)))
- (throw 'return
- (match-beginning
- (nth 2 (assoc e org-latex-regexps))))))
- matchers)
+ (dolist (e matchers)
+ (when (looking-at (nth 1 e))
+ (throw 'return (match-beginning (nth 2 e)))))
(point))))))))
@@ -2474,18 +2790,16 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor (limit)
+(defun org-element-export-snippet-successor ()
"Search for the next export-snippet object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `export-snippet' and CDR
its beginning position."
(save-excursion
(let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
- (search-forward "@@" limit t))
+ (search-forward "@@" nil t))
(cons 'export-snippet beg)))))
@@ -2541,21 +2855,19 @@ CONTENTS is nil."
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
-(defun org-element-footnote-reference-successor (limit)
+(defun org-element-footnote-reference-successor ()
"Search for the next footnote-reference object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `footnote-reference' and
CDR is beginning position."
(save-excursion
(catch 'exit
- (while (re-search-forward org-footnote-re limit t)
+ (while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
- (while (re-search-forward "[][]" limit t)
+ (while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
@@ -2598,20 +2910,14 @@ CONTENTS is nil."
main-source)
(and post-options (format "[%s]" post-options)))))
-(defun org-element-inline-babel-call-successor (limit)
+(defun org-element-inline-babel-call-successor ()
"Search for the next inline-babel-call object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
- ;; Use a simplified version of
- ;; `org-babel-inline-lob-one-liner-regexp'.
- (when (re-search-forward
- "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
- limit t)
- (cons 'inline-babel-call (match-beginning 0)))))
+ (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t)
+ (cons 'inline-babel-call (match-end 1)))))
;;;; Inline Src Block
@@ -2619,8 +2925,6 @@ CDR is beginning position."
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `inline-src-block' and CDR a plist
with `:begin', `:end', `:language', `:value', `:parameters' and
`:post-blank' as keywords.
@@ -2655,16 +2959,14 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor (limit)
+(defun org-element-inline-src-block-successor ()
"Search for the next inline-babel-call element.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
@@ -2702,29 +3004,28 @@ CONTENTS is the contents of the object."
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse latex fragment at point.
+ "Parse LaTeX fragment at point.
Return a list whose CAR is `latex-fragment' and CDR a plist with
`:value', `:begin', `:end', and `:post-blank' as keywords.
-Assume point is at the beginning of the latex fragment."
+Assume point is at the beginning of the LaTeX fragment."
(save-excursion
(let* ((begin (point))
(substring-match
(catch 'exit
- (mapc (lambda (e)
- (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
- (when (or (looking-at latex-regexp)
- (and (not (bobp))
- (save-excursion
- (backward-char)
- (looking-at latex-regexp))))
- (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
- (plist-get org-format-latex-options :matchers))
+ (dolist (e (cdr org-latex-regexps))
+ (let ((latex-regexp (nth 1 e)))
+ (when (or (looking-at latex-regexp)
+ (and (not (bobp))
+ (save-excursion
+ (backward-char)
+ (looking-at latex-regexp))))
+ (throw 'exit (nth 2 e)))))
;; None found: it's a macro.
(looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
0))
- (value (match-string-no-properties substring-match))
+ (value (org-match-string-no-properties substring-match))
(post-blank (progn (goto-char (match-end substring-match))
(skip-chars-forward " \t")))
(end (point)))
@@ -2748,22 +3049,23 @@ Return a list whose CAR is `line-break', and CDR a plist with
`:begin', `:end' and `:post-blank' keywords.
Assume point is at the beginning of the line break."
- (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
+ (list 'line-break
+ (list :begin (point)
+ :end (progn (forward-line) (point))
+ :post-blank 0)))
(defun org-element-line-break-interpreter (line-break contents)
"Interpret LINE-BREAK object as Org syntax.
CONTENTS is nil."
- "\\\\")
+ "\\\\\n")
-(defun org-element-line-break-successor (limit)
+(defun org-element-line-break-successor ()
"Search for the next line-break object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `line-break' and CDR is
beginning position."
(save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
(goto-char (match-beginning 1)))))
;; A line break can only happen on a non-empty line.
(when (and beg (re-search-backward "\\S-" (point-at-bol) t))
@@ -2776,72 +3078,98 @@ beginning position."
"Parse link at point.
Return a list whose CAR is `link' and CDR a plist with `:type',
-`:path', `:raw-link', `:begin', `:end', `:contents-begin',
-`:contents-end' and `:post-blank' as keywords.
+`:path', `:raw-link', `:application', `:search-option', `:begin',
+`:end', `:contents-begin', `:contents-end' and `:post-blank' as
+keywords.
Assume point is at the beginning of the link."
(save-excursion
(let ((begin (point))
end contents-begin contents-end link-end post-blank path type
- raw-link link)
+ raw-link link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp (looking-at org-target-link-regexp))
(setq type "radio"
link-end (match-end 0)
- path (org-match-string-no-properties 0)))
+ path (org-match-string-no-properties 0)
+ contents-begin (match-beginning 0)
+ contents-end (match-end 0)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
(setq contents-begin (match-beginning 3)
contents-end (match-end 3)
link-end (match-end 0)
- ;; RAW-LINK is the original link.
- raw-link (org-match-string-no-properties 1)
- link (org-translate-link
- (org-link-expand-abbrev
- (org-link-unescape raw-link))))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ raw-link (org-translate-link
+ (org-link-expand-abbrev
+ (org-match-string-no-properties 1))))
;; Determine TYPE of link and set PATH accordingly.
(cond
;; File type.
- ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
- (setq type "file" path link))
+ ((or (file-name-absolute-p raw-link)
+ (string-match "\\`\\.\\.?/" raw-link))
+ (setq type "file" path raw-link))
;; Explicit type (http, irc, bbdb...). See `org-link-types'.
- ((string-match org-link-re-with-space3 link)
- (setq type (match-string 1 link) path (match-string 2 link)))
+ ((string-match org-link-types-re raw-link)
+ (setq type (match-string 1 raw-link)
+ ;; According to RFC 3986, extra whitespace should be
+ ;; ignored when a URI is extracted.
+ path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
;; Id type: PATH is the id.
- ((string-match "^id:\\([-a-f0-9]+\\)" link)
- (setq type "id" path (match-string 1 link)))
+ ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link)
+ (setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "^(\\(.*\\))$" link)
- (setq type "coderef" path (match-string 1 link)))
+ ((string-match "\\`(\\(.*\\))\\'" raw-link)
+ (setq type "coderef" path (match-string 1 raw-link)))
;; Custom-id type: PATH is the name of the custom id.
- ((= (aref link 0) ?#)
- (setq type "custom-id" path (substring link 1)))
+ ((= (aref raw-link 0) ?#)
+ (setq type "custom-id" path (substring raw-link 1)))
;; Fuzzy type: Internal link either matches a target, an
;; headline name or nothing. PATH is the target or
;; headline's name.
- (t (setq type "fuzzy" path link))))
- ;; Type 3: Plain link, i.e. http://orgmode.org
+ (t (setq type "fuzzy" path raw-link))))
+ ;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
(setq raw-link (org-match-string-no-properties 0)
type (org-match-string-no-properties 1)
- path (org-match-string-no-properties 2)
- link-end (match-end 0)))
- ;; Type 4: Angular link, i.e. <http://orgmode.org>
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2)))
+ ;; Type 4: Angular link, e.g., <http://orgmode.org>
((looking-at org-angle-link-re)
(setq raw-link (buffer-substring-no-properties
(match-beginning 1) (match-end 2))
type (org-match-string-no-properties 1)
- path (org-match-string-no-properties 2)
- link-end (match-end 0))))
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2))))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
(setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
end (point))
+ ;; Special "file" type link processing.
+ (when (member type org-element-link-type-is-file)
+ ;; Extract opening application and search option.
+ (cond ((string-match "^file\\+\\(.*\\)$" type)
+ (setq application (match-string 1 type)))
+ ((not (string-match "^file" type))
+ (setq application type)))
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path)
+ path (replace-match "" nil nil path)))
+ ;; Normalize URI.
+ (when (and (not (org-string-match-p "\\`//" path))
+ (file-name-absolute-p path))
+ (setq path (concat "//" (expand-file-name path))))
+ ;; Make sure TYPE always reports "file".
+ (setq type "file"))
(list 'link
(list :type type
:path path
:raw-link (or raw-link path)
+ :application application
+ :search-option search-option
:begin begin
:end end
:contents-begin contents-begin
@@ -2858,20 +3186,26 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor (limit)
+(defun org-element-link-successor ()
"Search for the next link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(save-excursion
(let ((link-regexp
(if (not org-target-link-regexp) org-any-link-re
(concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp limit t)
+ (when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
+(defun org-element-plain-link-successor ()
+ "Search for the next plain link object.
+
+Return value is a cons cell whose CAR is `link' and CDR is
+beginning position."
+ (and (save-excursion (re-search-forward org-plain-link-re nil t))
+ (cons 'link (match-beginning 0))))
+
;;;; Macro
@@ -2891,20 +3225,19 @@ Assume point is at the macro."
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
- (args (let ((args (org-match-string-no-properties 3)) args2)
+ (args (let ((args (org-match-string-no-properties 3)))
(when args
;; Do not use `org-split-string' since empty
;; strings are meaningful here.
- (setq args (split-string args ","))
- (while args
- (while (string-match "\\\\\\'" (car args))
- ;; Repair bad splits, when comma is protected,
- ;; and thus not a real separator.
- (setcar (cdr args) (concat (substring (car args) 0 -1)
- "," (nth 1 args)))
- (pop args))
- (push (pop args) args2))
- (mapcar 'org-trim (nreverse args2))))))
+ (split-string
+ (replace-regexp-in-string
+ "\\(\\\\*\\)\\(,\\)"
+ (lambda (str)
+ (let ((len (length (match-string 1 str))))
+ (concat (make-string (/ len 2) ?\\)
+ (if (zerop (mod len 2)) "\000" ","))))
+ args nil t)
+ "\000")))))
(list 'macro
(list :key key
:value value
@@ -2918,17 +3251,15 @@ Assume point is at the macro."
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor (limit)
+(defun org-element-macro-successor ()
"Search for the next macro object.
-LIMIT bounds the search.
-
Return value is cons cell whose CAR is `macro' and CDR is
beginning position."
(save-excursion
(when (re-search-forward
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- limit t)
+ nil t)
(cons 'macro (match-beginning 0)))))
@@ -2964,15 +3295,13 @@ Assume point is at the radio target."
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor (limit)
+(defun org-element-radio-target-successor ()
"Search for the next radio-target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `radio-target' and CDR
is beginning position."
(save-excursion
- (when (re-search-forward org-radio-target-regexp limit t)
+ (when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
@@ -3004,15 +3333,13 @@ Assume point is at the beginning of the statistics-cookie."
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor (limit)
+(defun org-element-statistics-cookie-successor ()
"Search for the next statistics cookie object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `statistics-cookie' and
CDR is beginning position."
(save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
@@ -3085,16 +3412,14 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor (limit)
+(defun org-element-sub/superscript-successor ()
"Search for the next sub/superscript object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is either `subscript' or
`superscript' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp limit t)
+ (when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
@@ -3144,7 +3469,7 @@ CONTENTS is the contents of the object."
Return a list whose CAR is `table-cell' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
- (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
+ (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
(let* ((begin (match-beginning 0))
(end (match-end 0))
(contents-begin (match-beginning 1))
@@ -3161,14 +3486,12 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor (limit)
+(defun org-element-table-cell-successor ()
"Search for the next table-cell object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `table-cell' and CDR is
beginning position."
- (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
+ (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point))))
;;;; Target
@@ -3198,15 +3521,13 @@ Assume point is at the target."
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor (limit)
+(defun org-element-target-successor ()
"Search for the next target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
- (when (re-search-forward org-target-regexp limit t)
+ (when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
@@ -3216,51 +3537,202 @@ beginning position."
"Parse time stamp at point.
Return a list whose CAR is `timestamp', and CDR a plist with
-`:type', `:begin', `:end', `:value' and `:post-blank' keywords.
+`:type', `:raw-value', `:year-start', `:month-start',
+`:day-start', `:hour-start', `:minute-start', `:year-end',
+`:month-end', `:day-end', `:hour-end', `:minute-end',
+`:repeater-type', `:repeater-value', `:repeater-unit',
+`:warning-type', `:warning-value', `:warning-unit', `:begin',
+`:end' and `:post-blank' keywords.
Assume point is at the beginning of the timestamp."
(save-excursion
(let* ((begin (point))
(activep (eq (char-after) ?<))
- (main-value
+ (raw-value
(progn
- (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
- (match-string-no-properties 1)))
- (range-end (match-string-no-properties 3))
- (type (cond ((match-string 2) 'diary)
- ((and activep range-end) 'active-range)
- (activep 'active)
- (range-end 'inactive-range)
- (t 'inactive)))
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
- (end (point)))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
(list 'timestamp
- (list :type type
- :value main-value
- :range-end range-end
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props)))))
(defun org-element-timestamp-interpreter (timestamp contents)
"Interpret TIMESTAMP object as Org syntax.
CONTENTS is nil."
- (let ((type (org-element-property :type timestamp) ))
- (concat
- (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
- (org-element-property :value timestamp))
- (let ((range-end (org-element-property :range-end timestamp)))
- (when range-end
- (concat "--"
- (format (if (eq type 'inactive-range) "[%s]" "<%s>")
- range-end)))))))
-
-(defun org-element-timestamp-successor (limit)
+ ;; Use `:raw-value' if specified.
+ (or (org-element-property :raw-value timestamp)
+ ;; Otherwise, build timestamp string.
+ (let* ((repeat-string
+ (concat
+ (case (org-element-property :repeater-type timestamp)
+ (cumulate "+") (catch-up "++") (restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (warning-string
+ (concat
+ (case (org-element-property :warning-type timestamp)
+ (first "--")
+ (all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :warning-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING
+ ;; is the repeater string, if any.
+ (lambda (time activep &optional with-time-p hour-end minute-end)
+ (let ((ts (format-time-string
+ (funcall (if with-time-p 'cdr 'car)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (case type
+ ((active inactive)
+ (let* ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((active-range inactive-range)
+ (let ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))))))
+
+(defun org-element-timestamp-successor ()
"Search for the next timestamp object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `timestamp' and CDR is
beginning position."
(save-excursion
@@ -3270,7 +3742,7 @@ beginning position."
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- limit t)
+ nil t)
(cons 'timestamp (match-beginning 0)))))
@@ -3343,23 +3815,23 @@ CONTENTS is nil."
;; point.
;;
;; `org-element--current-element' makes use of special modes. They
-;; are activated for fixed element chaining (i.e. `plain-list' >
-;; `item') or fixed conditional element chaining (i.e. `headline' >
-;; `section'). Special modes are: `first-section', `section',
-;; `quote-section', `item' and `table-row'.
+;; are activated for fixed element chaining (e.g., `plain-list' >
+;; `item') or fixed conditional element chaining (e.g., `headline' >
+;; `section'). Special modes are: `first-section', `item',
+;; `node-property', `quote-section', `section' and `table-row'.
(defun org-element--current-element
(limit &optional granularity special structure)
"Parse the element starting at point.
-LIMIT bounds the search.
-
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
element.
Possible types are defined in `org-element-all-elements'.
+LIMIT bounds the search.
+
Optional argument GRANULARITY determines the depth of the
recursion. Allowed values are `headline', `greater-element',
`element', `object' or nil. When it is broader than `object' (or
@@ -3367,8 +3839,8 @@ nil), secondary values will not be parsed, since they only
contain objects.
Optional argument SPECIAL, when non-nil, can be either
-`first-section', `section', `quote-section', `table-row' and
-`item'.
+`first-section', `item', `node-property', `quote-section',
+`section', and `table-row'.
If STRUCTURE isn't provided but SPECIAL is set to `item', it will
be computed.
@@ -3376,13 +3848,6 @@ be computed.
This function assumes point is always at the beginning of the
element it has to parse."
(save-excursion
- ;; If point is at an affiliated keyword, try moving to the
- ;; beginning of the associated element. If none is found, the
- ;; keyword is orphaned and will be treated as plain text.
- (when (looking-at org-element--affiliated-re)
- (let ((opoint (point)))
- (while (looking-at org-element--affiliated-re) (forward-line))
- (when (looking-at "[ \t]*$") (goto-char opoint))))
(let ((case-fold-search t)
;; Determine if parsing depth allows for secondary strings
;; parsing. It only applies to elements referenced in
@@ -3394,6 +3859,8 @@ element it has to parse."
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
((eq special 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq special 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
@@ -3406,180 +3873,145 @@ element it has to parse."
limit)))
;; When not at bol, point is at the beginning of an item or
;; a footnote definition: next item is always a paragraph.
- ((not (bolp)) (org-element-paragraph-parser limit))
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
;; Planning and Clock.
- ((and (looking-at org-planning-or-clock-line-re))
+ ((looking-at org-planning-or-clock-line-re)
(if (equal (match-string 1) org-clock-string)
(org-element-clock-parser limit)
(org-element-planning-parser limit)))
;; Inlinetask.
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
- ;; LaTeX Environment.
- ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
- (if (save-excursion
- (re-search-forward
- (format "[ \t]*\\\\end{%s}[ \t]*"
- (regexp-quote (match-string 1)))
- nil t))
- (org-element-latex-environment-parser limit)
- (org-element-paragraph-parser limit)))
- ;; Drawer and Property Drawer.
- ((looking-at org-drawer-regexp)
- (let ((name (match-string 1)))
- (cond
- ((not (save-excursion
- (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
- (org-element-paragraph-parser limit))
- ((equal "PROPERTIES" name)
- (org-element-property-drawer-parser limit))
- (t (org-element-drawer-parser limit)))))
- ;; Fixed Width
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (org-element-fixed-width-parser limit))
- ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
- ;; Keywords.
- ((looking-at "[ \t]*#")
- (goto-char (match-end 0))
- (cond ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (let ((parser (assoc (upcase (match-string 1))
- org-element-block-name-alist)))
- (if parser (funcall (cdr parser) limit)
- (org-element-special-block-parser limit))))
- ((looking-at "\\+CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit))
- ((looking-at "\\+BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit))
- ((looking-at "\\+\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit))))
- ;; Footnote Definition.
- ((looking-at org-footnote-definition-re)
- (org-element-footnote-definition-parser limit))
- ;; Horizontal Rule.
- ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
- (org-element-horizontal-rule-parser limit))
- ;; Table.
- ((org-at-table-p t) (org-element-table-parser limit))
- ;; List.
- ((looking-at (org-item-re))
- (org-element-plain-list-parser limit (or structure (org-list-struct))))
- ;; Default element: Paragraph.
- (t (org-element-paragraph-parser limit))))))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
+ (cond
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer and Property Drawer.
+ ((looking-at org-drawer-regexp)
+ (if (equal (match-string 1) "PROPERTIES")
+ (org-element-property-drawer-parser limit affiliated)
+ (org-element-drawer-parser limit affiliated)))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#")
+ (goto-char (match-end 0))
+ (cond ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit affiliated))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (let ((parser (assoc (upcase (match-string 1))
+ org-element-block-name-alist)))
+ (if parser (funcall (cdr parser) limit affiliated)
+ (org-element-special-block-parser limit affiliated))))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))))
;; Most elements can have affiliated keywords. When looking for an
;; element beginning, we want to move before them, as they belong to
;; that element, and, in the meantime, collect information they give
;; into appropriate properties. Hence the following function.
-;;
-;; Usage of optional arguments may not be obvious at first glance:
-;;
-;; - TRANS-LIST is used to polish keywords names that have evolved
-;; during Org history. In example, even though =result= and
-;; =results= coexist, we want to have them under the same =result=
-;; property. It's also true for "srcname" and "name", where the
-;; latter seems to be preferred nowadays (thus the "name" property).
-;;
-;; - CONSED allows to regroup multi-lines keywords under the same
-;; property, while preserving their own identity. This is mostly
-;; used for "attr_latex" and al.
-;;
-;; - PARSED prepares a keyword value for export. This is useful for
-;; "caption". Objects restrictions for such keywords are defined in
-;; `org-element-object-restrictions'.
-;;
-;; - DUALS is used to take care of keywords accepting a main and an
-;; optional secondary values. For example "results" has its
-;; source's name as the main value, and may have an hash string in
-;; optional square brackets as the secondary one.
-;;
-;; A keyword may belong to more than one category.
-
-(defun org-element--collect-affiliated-keywords
- (&optional key-re trans-list consed parsed duals)
- "Collect affiliated keywords before point.
-Optional argument KEY-RE is a regexp matching keywords, which
-puts matched keyword in group 1. It defaults to
-`org-element--affiliated-re'.
-
-TRANS-LIST is an alist where key is the keyword and value the
-property name it should be translated to, without the colons. It
-defaults to `org-element-keyword-translation-alist'.
-
-CONSED is a list of strings. Any keyword belonging to that list
-will have its value consed. The check is done after keyword
-translation. It defaults to `org-element-multiple-keywords'.
-
-PARSED is a list of strings. Any keyword member of this list
-will have its value parsed. The check is done after keyword
-translation. If a keyword is a member of both CONSED and PARSED,
-it's value will be a list of parsed strings. It defaults to
-`org-element-parsed-keywords'.
-
-DUALS is a list of strings. Any keyword member of this list can
-have two parts: one mandatory and one optional. Its value is
-a cons cell whose CAR is the former, and the CDR the latter. If
-a keyword is a member of both PARSED and DUALS, both values will
-be parsed. It defaults to `org-element-dual-keywords'.
+(defun org-element--collect-affiliated-keywords (limit)
+ "Collect affiliated keywords from point down to LIMIT.
Return a list whose CAR is the position at the first of them and
-CDR a plist of keywords and values."
- (save-excursion
+CDR a plist of keywords and values and move point to the
+beginning of the first line after them.
+
+As a special case, if element doesn't start at the beginning of
+the line (e.g., a paragraph starting an item), CAR is current
+position of point and CDR is nil."
+ (if (not (bolp)) (list (point))
(let ((case-fold-search t)
- (key-re (or key-re org-element--affiliated-re))
- (trans-list (or trans-list org-element-keyword-translation-alist))
- (consed (or consed org-element-multiple-keywords))
- (parsed (or parsed org-element-parsed-keywords))
- (duals (or duals org-element-dual-keywords))
+ (origin (point))
;; RESTRICT is the list of objects allowed in parsed
;; keywords value.
(restrict (org-element-restriction 'keyword))
output)
- (unless (bobp)
- (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
- (let* ((raw-kwd (upcase (match-string 1)))
- ;; Apply translation to RAW-KWD. From there, KWD is
- ;; the official keyword.
- (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
- ;; Find main value for any keyword.
- (value
- (save-match-data
- (org-trim
- (buffer-substring-no-properties
- (match-end 0) (point-at-eol)))))
- ;; If KWD is a dual keyword, find its secondary
- ;; value. Maybe parse it.
- (dual-value
- (and (member kwd duals)
- (let ((sec (org-match-string-no-properties 2)))
- (if (or (not sec) (not (member kwd parsed))) sec
- (org-element-parse-secondary-string sec restrict)))))
- ;; Attribute a property name to KWD.
- (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
- ;; Now set final shape for VALUE.
- (when (member kwd parsed)
- (setq value (org-element-parse-secondary-string value restrict)))
- (when (member kwd duals)
- ;; VALUE is mandatory. Set it to nil if there is none.
- (setq value (and value (cons value dual-value))))
- ;; Attributes are always consed.
- (when (or (member kwd consed) (string-match "^ATTR_" kwd))
- (setq value (cons value (plist-get output kwd-sym))))
- ;; Eventually store the new value in OUTPUT.
- (setq output (plist-put output kwd-sym value))))
- (unless (looking-at key-re) (forward-line 1)))
- (list (point) output))))
+ (while (and (< (point) limit) (looking-at org-element--affiliated-re))
+ (let* ((raw-kwd (upcase (match-string 1)))
+ ;; Apply translation to RAW-KWD. From there, KWD is
+ ;; the official keyword.
+ (kwd (or (cdr (assoc raw-kwd
+ org-element-keyword-translation-alist))
+ raw-kwd))
+ ;; Find main value for any keyword.
+ (value
+ (save-match-data
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))))
+ ;; PARSEDP is non-nil when keyword should have its
+ ;; value parsed.
+ (parsedp (member kwd org-element-parsed-keywords))
+ ;; If KWD is a dual keyword, find its secondary
+ ;; value. Maybe parse it.
+ (dualp (member kwd org-element-dual-keywords))
+ (dual-value
+ (and dualp
+ (let ((sec (org-match-string-no-properties 2)))
+ (if (or (not sec) (not parsedp)) sec
+ (org-element-parse-secondary-string sec restrict)))))
+ ;; Attribute a property name to KWD.
+ (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
+ ;; Now set final shape for VALUE.
+ (when parsedp
+ (setq value (org-element-parse-secondary-string value restrict)))
+ (when dualp
+ (setq value (and (or value dual-value) (cons value dual-value))))
+ (when (or (member kwd org-element-multiple-keywords)
+ ;; Attributes can always appear on multiple lines.
+ (string-match "^ATTR_" kwd))
+ (setq value (cons value (plist-get output kwd-sym))))
+ ;; Eventually store the new value in OUTPUT.
+ (setq output (plist-put output kwd-sym value))
+ ;; Move to next keyword.
+ (forward-line)))
+ ;; If affiliated keywords are orphaned: move back to first one.
+ ;; They will be parsed as a paragraph.
+ (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
+ ;; Return value.
+ (cons origin output))))
@@ -3658,19 +4090,27 @@ looked after.
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
`:parent' property within the string."
- (with-temp-buffer
- (insert string)
- (let ((secondary (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (mapc (lambda (obj) (org-element-put-property obj :parent parent))
- secondary))))
-
-(defun org-element-map (data types fun &optional info first-match no-recursion)
+ (let ((local-variables (buffer-local-variables)))
+ (with-temp-buffer
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (org-set-local (car v) (cdr v)))))
+ (insert string)
+ (restore-buffer-modified-p nil)
+ (let ((secondary (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (when parent
+ (dolist (o secondary) (org-element-put-property o :parent parent)))
+ secondary))))
+
+(defun org-element-map
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
-DATA is an Org buffer parse tree, as returned by, i.e.,
-`org-element-parse-buffer'. TYPES is a symbol or list of symbols
-of elements or objects types (see `org-element-all-elements' and
+DATA is a parse tree, an element, an object, a string, or a list
+of such constructs. TYPES is a symbol or list of symbols of
+elements or objects types (see `org-element-all-elements' and
`org-element-all-objects' for a complete list of types). FUN is
the function called on the matching element or object. It has to
accept one argument: the element or object itself.
@@ -3687,37 +4127,45 @@ representing elements or objects types. `org-element-map' won't
enter any recursive element or object whose type belongs to that
list. Though, FUN can still be applied on them.
+When optional argument WITH-AFFILIATED is non-nil, FUN will also
+apply to matching objects within parsed affiliated keywords (see
+`org-element-parsed-keywords').
+
Nil values returned from FUN do not appear in the results.
Examples:
---------
+---------
Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
- \(org-element-map tree '(example-block src-block) 'identity)
+ (org-element-map tree \\='(example-block src-block) \\='identity)
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
- \(org-element-map
- tree 'headline
- \(lambda (hl)
- \(and (= (org-element-property :level hl) 1)
- \(member \"phone\" (org-element-property :tags hl))
- \(org-element-property :begin hl)))
+ (org-element-map tree \\='headline
+ (lambda (hl)
+ (and (= (org-element-property :level hl) 1)
+ (member \"phone\" (org-element-property :tags hl))
+ (org-element-property :begin hl)))
nil t)
-Eventually, this last example will return a flat list of all
-`bold' type objects containing a `latex-snippet' type object:
+The next example will return a flat list of all `plain-list' type
+elements in TREE that are not a sub-list themselves:
+
+ (org-element-map tree \\='plain-list \\='identity nil nil \\='plain-list)
+
+Eventually, this example will return a flat list of all `bold'
+type objects containing a `latex-snippet' type object, even
+looking into captions:
- \(org-element-map
- tree 'bold
- \(lambda (b)
- \(and (org-element-map b 'latex-snippet 'identity nil t)
- b)))"
+ (org-element-map tree \\='bold
+ (lambda (b)
+ (and (org-element-map b \\='latex-snippet \\='identity nil t) b))
+ nil nil nil t)"
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
(unless (listp types) (setq types (list types)))
(unless (listp no-recursion) (setq no-recursion (list no-recursion)))
@@ -3739,6 +4187,12 @@ Eventually, this last example will return a flat list of all
(setq category 'elements)))))
types)
category)))
+ ;; Compute properties for affiliated keywords if necessary.
+ (--affiliated-alist
+ (and with-affiliated
+ (mapcar (lambda (kwd)
+ (cons kwd (intern (concat ":" (downcase kwd)))))
+ org-element-affiliated-keywords)))
--acc
--walk-tree
(--walk-tree
@@ -3751,9 +4205,8 @@ Eventually, this last example will return a flat list of all
((not --data))
;; Ignored element in an export context.
((and info (memq --data (plist-get info :ignore-list))))
- ;; Secondary string: only objects can be found there.
- ((not --type)
- (when (eq --category 'objects) (mapc --walk-tree --data)))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
;; Unconditionally enter parse trees.
((eq --type 'org-data)
(mapc --walk-tree (org-element-contents --data)))
@@ -3768,12 +4221,40 @@ Eventually, this last example will return a flat list of all
(t (push result --acc)))))
;; If --DATA has a secondary string that can contain
;; objects with their type among TYPES, look into it.
- (when (eq --category 'objects)
+ (when (and (eq --category 'objects) (not (stringp --data)))
(let ((sec-prop
(assq --type org-element-secondary-value-alist)))
(when sec-prop
(funcall --walk-tree
(org-element-property (cdr sec-prop) --data)))))
+ ;; If --DATA has any affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (memq --type org-element-all-elements))
+ (mapc (lambda (kwd-pair)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property
+ (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of value.
+ ;; Preserve order for multiple keywords.
+ (cond
+ ((not value))
+ ((and (member kwd org-element-multiple-keywords)
+ (member kwd org-element-dual-keywords))
+ (mapc (lambda (line)
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (reverse value)))
+ ((member kwd org-element-multiple-keywords)
+ (mapc (lambda (line) (funcall --walk-tree line))
+ (reverse value)))
+ ((member kwd org-element-dual-keywords)
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value)))
+ (t (funcall --walk-tree value)))))
+ --affiliated-alist))
;; Determine if a recursion into --DATA is possible.
(cond
;; --TYPE is explicitly removed from recursion.
@@ -3793,6 +4274,7 @@ Eventually, this last example will return a flat list of all
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc))))
+(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
;;
@@ -3831,6 +4313,10 @@ elements.
Elements are accumulated into ACC."
(save-excursion
(goto-char beg)
+ ;; Visible only: skip invisible parts at the beginning of the
+ ;; element.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; When parsing only headlines, skip any text before first one.
(when (and (eq granularity 'headline) (not (org-at-heading-p)))
(org-with-limited-levels (outline-next-heading)))
@@ -3843,15 +4329,16 @@ Elements are accumulated into ACC."
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
+ ;; Visible only: skip invisible parts between siblings.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; Fill ELEMENT contents by side-effect.
(cond
- ;; If VISIBLE-ONLY is true and element is hidden or if it has
- ;; no contents, don't modify it.
- ((or (and visible-only (org-element-property :hiddenp element))
- (not cbeg)))
+ ;; If element has no contents, don't modify it.
+ ((not cbeg))
;; Greater element: parse it between `contents-begin' and
;; `contents-end'. Make sure GRANULARITY allows the
- ;; recursion, or ELEMENT is an headline, in which case going
+ ;; recursion, or ELEMENT is a headline, in which case going
;; inside is mandatory, in order to get sub-level headings.
((and (memq type org-element-greater-elements)
(or (memq granularity '(element object nil))
@@ -3866,6 +4353,7 @@ Elements are accumulated into ACC."
(if (org-element-property :quotedp element) 'quote-section
'section))
(plain-list 'item)
+ (property-drawer 'node-property)
(table 'table-row))
(and (memq type '(item plain-list))
(org-element-property :structure element))
@@ -3885,98 +4373,87 @@ Elements are accumulated into ACC."
Objects are accumulated in ACC.
-RESTRICTION is a list of object types which are allowed in the
-current object."
- (let (candidates)
+RESTRICTION is a list of object successors which are allowed in
+the current object."
+ (let ((candidates 'initial))
(save-excursion
- (goto-char beg)
- (while (and (< (point) end)
- (setq candidates (org-element--get-next-object-candidates
- end restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (let ((obj-beg (org-element-property :begin next-object)))
- (unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (save-restriction
- (narrow-to-region
- cont-beg
- (org-element-property :contents-end next-object))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
(org-element--parse-objects
- (point-min) (point-max) next-object
- (org-element-restriction next-object))))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (= (point) end)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
-
-(defun org-element--get-next-object-candidates (limit restriction objects)
+ cont-beg (org-element-property :contents-end next-object)
+ next-object (org-element-restriction next-object)))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (eobp)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc))))
+
+(defun org-element--get-next-object-candidates (restriction objects)
"Return an alist of candidates for the next object.
-LIMIT bounds the search, and RESTRICTION narrows candidates to
-some object types.
-
-Return value is an alist whose CAR is position and CDR the object
-type, as a symbol.
-
-OBJECTS is the previous candidates alist."
- ;; Filter out any object found but not belonging to RESTRICTION.
- (setq objects
- (org-remove-if-not
- (lambda (obj)
- (let ((type (car obj)))
- (memq (or (cdr (assq type org-element-object-successor-alist))
- type)
- restriction)))
- objects))
- (let (next-candidates types-to-search)
- ;; If no previous result, search every object type in RESTRICTION.
- ;; Otherwise, keep potential candidates (old objects located after
- ;; point) and ask to search again those which had matched before.
- (if (not objects) (setq types-to-search restriction)
- (mapc (lambda (obj)
- (if (< (cdr obj) (point)) (push (car obj) types-to-search)
- (push obj next-candidates)))
- objects))
- ;; Call the appropriate successor function for each type to search
- ;; and accumulate matches.
- (mapc
- (lambda (type)
- (let* ((successor-fun
- (intern
- (format "org-element-%s-successor"
- (or (cdr (assq type org-element-object-successor-alist))
- type))))
- (obj (funcall successor-fun limit)))
- (and obj (push obj next-candidates))))
- types-to-search)
- ;; Return alist.
- next-candidates))
+RESTRICTION is a list of object types, as symbols. Only
+candidates with such types are looked after.
+
+OBJECTS is the previous candidates alist. If it is set to
+`initial', no search has been done before, and all symbols in
+RESTRICTION should be looked after.
+
+Return value is an alist whose CAR is the object type and CDR its
+beginning position."
+ (delq
+ nil
+ (if (eq objects 'initial)
+ ;; When searching for the first time, look for every successor
+ ;; allowed in RESTRICTION.
+ (mapcar
+ (lambda (res)
+ (funcall (intern (format "org-element-%s-successor" res))))
+ restriction)
+ ;; Focus on objects returned during last search. Keep those
+ ;; still after point. Search again objects before it.
+ (mapcar
+ (lambda (obj)
+ (if (>= (cdr obj) (point)) obj
+ (let* ((type (car obj))
+ (succ (or (cdr (assq type org-element-object-successor-alist))
+ type)))
+ (and succ
+ (funcall (intern (format "org-element-%s-successor" succ)))))))
+ objects))))
@@ -4014,7 +4491,7 @@ Return Org syntax as a string."
(mapconcat
(lambda (obj) (org-element-interpret-data obj parent))
(org-element-contents data) ""))
- ;; Plain text.
+ ;; Plain text: return it.
((stringp data) data)
;; Element/Object without contents.
((not (org-element-contents data))
@@ -4083,7 +4560,7 @@ If there is no affiliated keyword, return the empty string."
;; All attribute keywords can have multiple lines.
(string-match "^ATTR_" keyword))
(mapconcat (lambda (line) (funcall keyword-to-org keyword line))
- value
+ (reverse value)
"")
(funcall keyword-to-org keyword value)))))
;; List all ELEMENT's properties matching an attribute line or an
@@ -4134,71 +4611,65 @@ indentation to compute maximal common indentation.
Return the normalized element that is element with global
indentation removed from its contents. The function assumes that
indentation is not done with TAB characters."
- (let* (ind-list ; for byte-compiler
- collect-inds ; for byte-compiler
- (collect-inds
- (function
- ;; Return list of indentations within BLOB. This is done by
- ;; walking recursively BLOB and updating IND-LIST along the
- ;; way. FIRST-FLAG is non-nil when the first string hasn't
- ;; been seen yet. It is required as this string is the only
- ;; one whose indentation doesn't happen after a newline
- ;; character.
- (lambda (blob first-flag)
- (mapc
- (lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (string-match "\\`\\( *\\)" object)
- (let ((len (length (match-string 1 object))))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq ind-list nil))
- (push len ind-list))))
- (cond
- ((stringp object)
- (let ((start 0))
- ;; Avoid matching blank or empty lines.
- (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
- (not (equal (match-string 2 object) " ")))
- (setq start (match-end 0))
- (push (length (match-string 1 object)) ind-list))))
- ((memq (org-element-type object) org-element-recursive-objects)
- (funcall collect-inds object first-flag))))
- (org-element-contents blob))))))
- ;; Collect indentation list in ELEMENT. Possibly remove first
- ;; value if IGNORE-FIRST is non-nil.
- (catch 'zero (funcall collect-inds element (not ignore-first)))
- (if (not ind-list) element
+ (let* ((min-ind most-positive-fixnum)
+ find-min-ind ; For byte-compiler.
+ (find-min-ind
+ ;; Return minimal common indentation within BLOB. This is
+ ;; done by walking recursively BLOB and updating MIN-IND
+ ;; along the way. FIRST-FLAG is non-nil when the first
+ ;; string hasn't been seen yet. It is required as this
+ ;; string is the only one whose indentation doesn't happen
+ ;; after a newline character.
+ (lambda (blob first-flag)
+ (dolist (object (org-element-contents blob))
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (string-match "\\` *" object)
+ (let ((len (match-end 0)))
+ ;; An indentation of zero means no string will be
+ ;; modified. Quit the process.
+ (if (zerop len) (throw 'zero (setq min-ind 0))
+ (setq min-ind (min len min-ind)))))
+ (cond
+ ((stringp object)
+ (dolist (line (cdr (org-split-string object " *\n")))
+ (unless (string= line "")
+ (setq min-ind (min (org-get-indentation line) min-ind)))))
+ ((memq (org-element-type object) org-element-recursive-objects)
+ (funcall find-min-ind object first-flag)))))))
+ ;; Find minimal indentation in ELEMENT.
+ (catch 'zero (funcall find-min-ind element (not ignore-first)))
+ (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element
;; Build ELEMENT back, replacing each string with the same
;; string minus common indentation.
(let* (build ; For byte compiler.
(build
(function
- (lambda (blob mci first-flag)
+ (lambda (blob first-flag)
;; Return BLOB with all its strings indentation
- ;; shortened from MCI white spaces. FIRST-FLAG is
- ;; non-nil when the first string hasn't been seen
+ ;; shortened from MIN-IND white spaces. FIRST-FLAG
+ ;; is non-nil when the first string hasn't been seen
;; yet.
(setcdr (cdr blob)
(mapcar
- (lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" mci) "" object)))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" mci) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object mci first-flag))
- (t object)))
+ #'(lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (setq object
+ (replace-regexp-in-string
+ (format "\\` \\{%d\\}" min-ind)
+ "" object)))
+ (cond
+ ((stringp object)
+ (replace-regexp-in-string
+ (format "\n \\{%d\\}" min-ind) "\n" object))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object first-flag))
+ (t object)))
(org-element-contents blob)))
blob))))
- (funcall build element (apply 'min ind-list) (not ignore-first))))))
+ (funcall build element (not ignore-first))))))
@@ -4242,7 +4713,7 @@ is always the element at point. The following positions contain
element's siblings, then parents, siblings of parents, until the
first element of current section."
(org-with-wide-buffer
- ;; If at an headline, parse it. It is the sole element that
+ ;; If at a headline, parse it. It is the sole element that
;; doesn't require to know about context. Be sure to disallow
;; secondary string parsing, though.
(if (org-with-limited-levels (org-at-heading-p))
@@ -4252,27 +4723,41 @@ first element of current section."
(list (org-element-headline-parser (point-max) t))))
;; Otherwise move at the beginning of the section containing
;; point.
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-with-limited-levels (org-before-first-heading-p))
- (goto-char (point-min))
- (org-back-to-heading)
- (forward-line)))
- (org-skip-whitespace)
- (beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (catch 'exit
- (while t
- (setq element
+ (catch 'exit
+ (let ((origin (point))
+ (end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct prevs parent)
+ (org-with-limited-levels
+ (if (org-before-first-heading-p)
+ ;; In empty lines at buffer's beginning, return nil.
+ (progn (goto-char (point-min))
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ (throw 'exit nil)))
+ (org-back-to-heading)
+ (forward-line)
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ ;; In blank lines just after the headline, point still
+ ;; belongs to the headline.
+ (throw 'exit
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (if (not keep-trail)
+ (org-element-headline-parser (point-max) t)
+ (list (org-element-headline-parser
+ (point-max) t))))))))
+ (beginning-of-line)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (while t
+ (setq element
(org-element--current-element end 'element special-flag struct)
- type (car element))
+ type (car element))
(org-element-put-property element :parent parent)
(when keep-trail (push element trail))
- (cond
+ (cond
;; 1. Skip any element ending before point. Also skip
;; element ending at point when we're sure that another
;; element has started.
@@ -4299,10 +4784,18 @@ first element of current section."
;; into elements with an explicit ending, but
;; return that element instead.
(and (= cend origin)
- (memq type
- '(center-block
- drawer dynamic-block inlinetask item
- plain-list quote-block special-block))))
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at the
+ ;; end of a buffer without a final new
+ ;; line, return last element in last
+ ;; item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
@@ -4318,7 +4811,7 @@ first element of current section."
(goto-char cbeg)))))))))))
;;;###autoload
-(defun org-element-context ()
+(defun org-element-context (&optional element)
"Return closest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -4328,81 +4821,127 @@ associated to it.
Possible types are defined in `org-element-all-elements' and
`org-element-all-objects'. Properties depend on element or
object type, but always include `:begin', `:end', `:parent' and
-`:post-blank'."
- (org-with-wide-buffer
- (let* ((origin (point))
- (element (org-element-at-point))
- (type (car element))
- end)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, move to beginning of the
- ;; element or secondary string and set END to the other side.
- (if (not (or (and (eq type 'item)
- (let ((tag (org-element-property :tag element)))
- (and tag
- (progn
- (beginning-of-line)
- (search-forward tag (point-at-eol))
- (goto-char (match-beginning 0))
- (and (>= origin (point))
- (<= origin
- ;; `1+' is required so some
- ;; successors can match
- ;; properly their object.
- (setq end (1+ (match-end 0)))))))))
- (and (memq type '(headline inlinetask))
- (progn (beginning-of-line)
- (skip-chars-forward "* ")
- (setq end (point-at-eol))))
- (and (memq type '(paragraph table-row verse-block))
- (let ((cbeg (org-element-property
- :contents-begin element))
- (cend (org-element-property
- :contents-end element)))
- (and (>= origin cbeg)
- (<= origin cend)
- (progn (goto-char cbeg) (setq end cend)))))))
- element
- (let ((restriction (org-element-restriction element))
- (parent element)
- candidates)
- (catch 'exit
- (while (setq candidates (org-element--get-next-object-candidates
- end restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin)
- (if (/= obj-end end) (goto-char obj-end)
- (throw 'exit
- (org-element-put-property
- object :parent parent))))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (> cbeg origin) (< cend origin))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- end cend)))))))
- parent))))))
-
-(defsubst org-element-nested-p (elem-A elem-B)
+`:post-blank'.
+
+Optional argument ELEMENT, when non-nil, is the closest element
+containing point, as returned by `org-element-at-point'.
+Providing it allows for quicker computation."
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ context)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, narrow buffer to the
+ ;; containing area. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((let ((post (org-element-property :post-affiliated element)))
+ (and post (< origin post)))
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
+ (cond
+ ((not (member-ignore-case (match-string 1)
+ org-element-parsed-keywords))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) origin)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= origin (match-beginning 2))
+ (< origin (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (not tag) (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= origin (point)) (< origin (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are located within
+ ;; their title.
+ ((memq type '(headline inlinetask))
+ (goto-char (org-element-property :begin element))
+ (skip-chars-forward "*")
+ (if (and (> origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element)))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
+ ;; At a parsed keyword, objects are located within value.
+ ((eq type 'keyword)
+ (if (not (member (org-element-property :key element)
+ org-element-document-properties))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward ":")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element))))
+ ;; At a planning line, if point is at a timestamp, return it,
+ ;; otherwise, return element.
+ ((eq type 'planning)
+ (dolist (p '(:closed :deadline :scheduled))
+ (let ((timestamp (org-element-property p element)))
+ (when (and timestamp
+ (<= (org-element-property :begin timestamp) origin)
+ (> (org-element-property :end timestamp) origin))
+ (throw 'objects-forbidden timestamp))))
+ (throw 'objects-forbidden element))
+ (t (throw 'objects-forbidden element)))
+ (goto-char (point-min))
+ (let ((restriction (org-element-restriction type))
+ (parent element)
+ (candidates 'initial))
+ (catch 'exit
+ (while (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit parent)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object))
+ (obj-end (org-element-property :end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive object or at
+ ;; an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and
+ ;; restrict search to the end of its contents.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property object :parent parent)
+ (setq parent object
+ restriction (org-element-restriction object)
+ candidates 'initial)))))))
+ parent))))))
+
+(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
(let ((beg-A (org-element-property :begin elem-A))
(beg-B (org-element-property :begin elem-B))
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 3f8cc9c6d6c..89d6b951588 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -1,6 +1,6 @@
;;; org-entities.el --- Support for special entities in Org-mode
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Ulf Stegemann <ulf at zeitform dot de>
@@ -27,9 +27,8 @@
;;; Code:
-(require 'org-macs)
-
-(declare-function org-table-align "org-table" ())
+(declare-function org-toggle-pretty-entities "org" ())
+(declare-function org-table-align "org-table" ())
(eval-when-compile
(require 'cl))
@@ -66,8 +65,8 @@ ASCII replacement Plain ASCII, no extensions. Symbols that cannot be
Latin1 replacement Use the special characters available in latin1.
utf-8 replacement Use the special characters available in utf-8.
-If you define new entities here that require specific LaTeX packages to be
-loaded, add these packages to `org-export-latex-packages-alist'."
+If you define new entities here that require specific LaTeX
+packages to be loaded, add these packages to `org-latex-packages-alist'."
:group 'org-entities
:version "24.1"
:type '(repeat
@@ -154,6 +153,9 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("real" "\\Re" t "&real;" "R" "R" "ℜ")
("image" "\\Im" t "&image;" "I" "I" "ℑ")
("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+ ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
+ ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
+ ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
"** Greek"
("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
@@ -203,6 +205,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
+ ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "ɸ")
("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
@@ -212,10 +215,15 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
"** Hebrew"
("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+ ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
+ ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
+ ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
+ ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
"** Dead languages"
("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
@@ -226,6 +234,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Punctuation"
"** Dots and Marks"
("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
@@ -253,20 +262,23 @@ loaded, add these packages to `org-export-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
- ("vert" "\\vert{}" t "&#124;" "|" "|" "|")
+ ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
("amp" "\\&" nil "&amp;" "&" "&" "&")
("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
- ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
("slash" "/" nil "/" "/" "/" "/")
("plus" "+" nil "+" "+" "+" "+")
("under" "\\_" nil "_" "_" "_" "_")
("equal" "=" nil "=" "=" "=" "=")
("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+ ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
"** Whitespace"
("nbsp" "~" nil "&nbsp;" " " " " " ")
@@ -297,6 +309,7 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("colon" "\\colon" t ":" ":" ":" ":")
("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
@@ -316,8 +329,9 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
- ("proptp" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("propto" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
+ ("neg" "\\neg{}" t "&not;" "[angled dash]" "¬" "¬")
("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
@@ -325,7 +339,9 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
("sim" "\\sim" t "&sim;" "~" "~" "∼")
("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
@@ -334,8 +350,26 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
+
+ ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("leq" "\\le" t "&le;" "<=" "<=" "≤")
("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
+ ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
+ ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
+ ("Ll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("lll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
+ ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
+ ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
+ ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
@@ -344,9 +378,12 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
+ ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
+ ("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
@@ -365,6 +402,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
("lang" "\\langle" t "&lang;" "<" "<" "⟨")
("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
+ ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
"** Arrows"
("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
@@ -435,7 +474,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
- ("checkmark" "\\checkmark" t "&#10003;" "[checkmark]" "[checkmark]" "✓")
+ ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
+ ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
"** Miscellaneous (seldom used)"
("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
@@ -450,7 +490,8 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("rlm" "" nil "&rlm;" "" "" "‏")
"** Smilies"
- ("smile" "\\smile" t "&#9786;" ":-)" ":-)" "⌣")
+ ("smile" "\\smile" t "&smile;" ":-)" ":-)" "⌣")
+ ("frown" "\\frown" t "&frown;" ":-(" ":-(" "⌢")
("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
@@ -462,10 +503,11 @@ loaded, add these packages to `org-export-latex-packages-alist'."
("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
- ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
- ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
- ("Diamond" "\\diamond" t "&diamond;" "[diamond]" "[diamond]" "⋄")
- ("loz" "\\diamond" t "&loz;" "[lozenge]" "[lozenge]" "◊")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫")
)
"Default entities used in Org-mode to produce special characters.
For details see `org-entities-user'.")
@@ -525,6 +567,7 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
(goto-char pos)
(org-table-align)))
+(defvar org-pretty-entities) ;; declare defcustom from org
(defun org-entities-help ()
"Create a Help buffer with all available entities."
(interactive)
@@ -555,7 +598,9 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
(princ (format " %-8s \\%-16s %-22s %-13s\n"
utf8 name latex html))))))
(with-current-buffer "*Org Entity Help*"
- (org-mode))
+ (org-mode)
+ (when org-pretty-entities
+ (org-toggle-pretty-entities)))
(select-window (get-buffer-window "*Org Entity Help*")))
diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el
index 5c26400077d..115b33367ed 100644
--- a/lisp/org/org-eshell.el
+++ b/lisp/org/org-eshell.el
@@ -1,6 +1,6 @@
;;; org-eshell.el - Support for links to working directories in eshell
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net>
diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el
deleted file mode 100644
index d3789ad3aa8..00000000000
--- a/lisp/org/org-exp-blocks.el
+++ /dev/null
@@ -1,402 +0,0 @@
-;;; org-exp-blocks.el --- pre-process blocks when exporting org files
-
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
-
-;; Author: Eric Schulte
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This is a utility for pre-processing blocks in org files before
-;; export using the `org-export-preprocess-hook'. It can be used for
-;; exporting new types of blocks from org-mode files and also for
-;; changing the default export behavior of existing org-mode blocks.
-;; The `org-export-blocks' and `org-export-interblocks' variables can
-;; be used to control how blocks and the spaces between blocks
-;; respectively are processed upon export.
-;;
-;; The type of a block is defined as the string following =#+begin_=,
-;; so for example the following block would be of type ditaa. Note
-;; that both upper or lower case are allowed in =#+BEGIN_= and
-;; =#+END_=.
-;;
-;; #+begin_ditaa blue.png -r -S
-;; +---------+
-;; | cBLU |
-;; | |
-;; | +----+
-;; | |cPNK|
-;; | | |
-;; +----+----+
-;; #+end_ditaa
-;;
-;;; Currently Implemented Block Types
-;;
-;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
-;; ascii pictures to actual images using ditaa
-;; http://ditaa.sourceforge.net/. To use this set
-;; `org-ditaa-jar-path' to the path to ditaa.jar on your
-;; system (should be set automatically in most cases) .
-;;
-;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
-;; graphs defined using the dot graphing language to images
-;; using the dot utility. For information on dot see
-;; http://www.graphviz.org/
-;;
-;; export-comment :: Wrap comments with titles and author information,
-;; in their own divs with author-specific ids allowing for
-;; css coloring of comments based on the author.
-;;
-;;; Adding new blocks
-;;
-;; When adding a new block type first define a formatting function
-;; along the same lines as `org-export-blocks-format-dot' and then use
-;; `org-export-blocks-add-block' to add your block type to
-;; `org-export-blocks'.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-(require 'find-func)
-(require 'org-compat)
-
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-remove-indentation "org" (code &optional n))
-
-(defvar org-protecting-blocks nil) ; From org.el
-
-(defun org-export-blocks-set (var value)
- "Set the value of `org-export-blocks' and install fontification."
- (set var value)
- (mapc (lambda (spec)
- (if (nth 2 spec)
- (setq org-protecting-blocks
- (delete (symbol-name (car spec))
- org-protecting-blocks))
- (add-to-list 'org-protecting-blocks
- (symbol-name (car spec)))))
- value))
-
-(defcustom org-export-blocks
- '((export-comment org-export-blocks-format-comment t)
- (ditaa org-export-blocks-format-ditaa nil)
- (dot org-export-blocks-format-dot nil))
- "Use this alist to associate block types with block exporting functions.
-The type of a block is determined by the text immediately
-following the '#+BEGIN_' portion of the block header. Each block
-export function should accept three arguments."
- :group 'org-export-general
- :type '(repeat
- (list
- (symbol :tag "Block name")
- (function :tag "Block formatter")
- (boolean :tag "Fontify content as Org syntax")))
- :set 'org-export-blocks-set)
-
-(defun org-export-blocks-add-block (block-spec)
- "Add a new block type to `org-export-blocks'.
-BLOCK-SPEC should be a three element list the first element of
-which should indicate the name of the block, the second element
-should be the formatting function called by
-`org-export-blocks-preprocess' and the third element a flag
-indicating whether these types of blocks should be fontified in
-org-mode buffers (see `org-protecting-blocks'). For example the
-BLOCK-SPEC for ditaa blocks is as follows.
-
- (ditaa org-export-blocks-format-ditaa nil)"
- (unless (member block-spec org-export-blocks)
- (setq org-export-blocks (cons block-spec org-export-blocks))
- (org-export-blocks-set 'org-export-blocks org-export-blocks)))
-
-(defcustom org-export-interblocks
- '()
- "Use this a-list to associate block types with block exporting functions.
-The type of a block is determined by the text immediately
-following the '#+BEGIN_' portion of the block header. Each block
-export function should accept three arguments."
- :group 'org-export-general
- :type 'alist)
-
-(defcustom org-export-blocks-witheld
- '(hidden)
- "List of block types (see `org-export-blocks') which should not be exported."
- :group 'org-export-general
- :type 'list)
-
-(defcustom org-export-blocks-postblock-hook nil
- "Run after blocks have been processed with `org-export-blocks-preprocess'."
- :group 'org-export-general
- :version "24.1"
- :type 'hook)
-
-(defun org-export-blocks-html-quote (body &optional open close)
- "Protect BODY from org html export.
-The optional OPEN and CLOSE tags will be inserted around BODY."
- (concat
- "\n#+BEGIN_HTML\n"
- (or open "")
- body (if (string-match "\n$" body) "" "\n")
- (or close "")
- "#+END_HTML\n"))
-
-(defun org-export-blocks-latex-quote (body &optional open close)
- "Protect BODY from org latex export.
-The optional OPEN and CLOSE tags will be inserted around BODY."
- (concat
- "\n#+BEGIN_LaTeX\n"
- (or open "")
- body (if (string-match "\n$" body) "" "\n")
- (or close "")
- "#+END_LaTeX\n"))
-
-(defvar org-src-preserve-indentation) ; From org-src.el
-(defun org-export-blocks-preprocess ()
- "Export all blocks according to the `org-export-blocks' block export alist.
-Does not export block types specified in specified in BLOCKS
-which defaults to the value of `org-export-blocks-witheld'."
- (interactive)
- (save-window-excursion
- (let ((case-fold-search t)
- (interblock (lambda (start end)
- (mapcar (lambda (pair) (funcall (second pair) start end))
- org-export-interblocks)))
- matched indentation type types func
- start end body headers preserve-indent progress-marker)
- (goto-char (point-min))
- (setq start (point))
- (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
- (while (re-search-forward beg-re nil t)
- (let* ((match-start (copy-marker (match-beginning 0)))
- (body-start (copy-marker (match-end 0)))
- (indentation (length (match-string 1)))
- (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
- (regexp-quote (downcase (match-string 2)))))
- (type (intern (downcase (match-string 2))))
- (headers (save-match-data
- (org-split-string (match-string 3) "[ \t]+")))
- (balanced 1)
- (preserve-indent (or org-src-preserve-indentation
- (member "-i" headers)))
- match-end)
- (while (and (not (zerop balanced))
- (re-search-forward inner-re nil t))
- (if (string= (downcase (match-string 1)) "end")
- (decf balanced)
- (incf balanced)))
- (when (not (zerop balanced))
- (error "Unbalanced begin/end_%s blocks with %S"
- type (buffer-substring match-start (point))))
- (setq match-end (copy-marker (match-end 0)))
- (unless preserve-indent
- (setq body (save-match-data (org-remove-indentation
- (buffer-substring
- body-start (match-beginning 0))))))
- (unless (memq type types) (setq types (cons type types)))
- (save-match-data (funcall interblock start match-start))
- (when (setq func (cadr (assoc type org-export-blocks)))
- (let ((replacement (save-match-data
- (if (memq type org-export-blocks-witheld) ""
- (apply func body headers)))))
- ;; ;; un-comment this code after the org-element merge
- ;; (save-match-data
- ;; (when (and replacement (string= replacement ""))
- ;; (delete-region
- ;; (car (org-element-collect-affiliated-keyword))
- ;; match-start)))
- (when replacement
- (delete-region match-start match-end)
- (goto-char match-start) (insert replacement)
- (if preserve-indent
- ;; indent only the code block markers
- (save-excursion
- (indent-line-to indentation) ; indent end_block
- (goto-char match-start)
- (indent-line-to indentation)) ; indent begin_block
- ;; indent everything
- (indent-code-rigidly match-start (point) indentation)))))
- ;; cleanup markers
- (set-marker match-start nil)
- (set-marker body-start nil)
- (set-marker match-end nil))
- (setq start (point))))
- (funcall interblock start (point-max))
- (run-hooks 'org-export-blocks-postblock-hook))))
-
-;;================================================================================
-;; type specific functions
-
-;;--------------------------------------------------------------------------------
-;; ditaa: create images from ASCII art using the ditaa utility
-(defcustom org-ditaa-jar-path (expand-file-name
- "ditaa.jar"
- (file-name-as-directory
- (expand-file-name
- "scripts"
- (file-name-as-directory
- (expand-file-name
- "../contrib"
- (file-name-directory (org-find-library-dir "org")))))))
- "Path to the ditaa jar executable."
- :group 'org-babel
- :type 'string)
-
-(defvar org-export-current-backend) ; dynamically bound in org-exp.el
-(defun org-export-blocks-format-ditaa (body &rest headers)
- "DEPRECATED: use begin_src ditaa code blocks
-
-Pass block BODY to the ditaa utility creating an image.
-Specify the path at which the image should be saved as the first
-element of headers, any additional elements of headers will be
-passed to the ditaa utility as command line arguments."
- (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
- (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
- (data-file (make-temp-file "org-ditaa"))
- (hash (progn
- (set-text-properties 0 (length body) nil body)
- (sha1 (prin1-to-string (list body args)))))
- (raw-out-file (if headers (car headers)))
- (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
- (cons (match-string 1 raw-out-file)
- (match-string 2 raw-out-file))
- (cons raw-out-file "png")))
- (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
- (unless (file-exists-p org-ditaa-jar-path)
- (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
- (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
- body
- (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
- (org-split-string body "\n")
- "\n")))
- (prog1
- (cond
- ((member org-export-current-backend '(html latex docbook))
- (unless (file-exists-p out-file)
- (mapc ;; remove old hashed versions of this file
- (lambda (file)
- (when (and (string-match (concat (regexp-quote (car out-file-parts))
- "_\\([[:alnum:]]+\\)\\."
- (regexp-quote (cdr out-file-parts)))
- file)
- (= (length (match-string 1 out-file)) 40))
- (delete-file (expand-file-name file
- (file-name-directory out-file)))))
- (directory-files (or (file-name-directory out-file)
- default-directory)))
- (with-temp-file data-file (insert body))
- (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
- (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
- (format "\n[[file:%s]]\n" out-file))
- (t (concat
- "\n#+BEGIN_EXAMPLE\n"
- body (if (string-match "\n$" body) "" "\n")
- "#+END_EXAMPLE\n")))
- (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
-
-;;--------------------------------------------------------------------------------
-;; dot: create graphs using the dot graphing language
-;; (require the dot executable to be in your path)
-(defun org-export-blocks-format-dot (body &rest headers)
- "DEPRECATED: use \"#+begin_src dot\" code blocks
-
-Pass block BODY to the dot graphing utility creating an image.
-Specify the path at which the image should be saved as the first
-element of headers, any additional elements of headers will be
-passed to the dot utility as command line arguments. Don't
-forget to specify the output type for the dot command, so if you
-are exporting to a file with a name like 'image.png' you should
-include a '-Tpng' argument, and your block should look like the
-following.
-
-#+begin_dot models.png -Tpng
-digraph data_relationships {
- \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
- \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
- \"data_requirement\" -> \"data_product\"
-}
-#+end_dot"
- (message "begin_dot blocks are DEPRECATED, use begin_src blocks")
- (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
- (data-file (make-temp-file "org-ditaa"))
- (hash (progn
- (set-text-properties 0 (length body) nil body)
- (sha1 (prin1-to-string (list body args)))))
- (raw-out-file (if headers (car headers)))
- (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
- (cons (match-string 1 raw-out-file)
- (match-string 2 raw-out-file))
- (cons raw-out-file "png")))
- (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
- (prog1
- (cond
- ((member org-export-current-backend '(html latex docbook))
- (unless (file-exists-p out-file)
- (mapc ;; remove old hashed versions of this file
- (lambda (file)
- (when (and (string-match (concat (regexp-quote (car out-file-parts))
- "_\\([[:alnum:]]+\\)\\."
- (regexp-quote (cdr out-file-parts)))
- file)
- (= (length (match-string 1 out-file)) 40))
- (delete-file (expand-file-name file
- (file-name-directory out-file)))))
- (directory-files (or (file-name-directory out-file)
- default-directory)))
- (with-temp-file data-file (insert body))
- (message (concat "dot " data-file " " args " -o " out-file))
- (shell-command (concat "dot " data-file " " args " -o " out-file)))
- (format "\n[[file:%s]]\n" out-file))
- (t (concat
- "\n#+BEGIN_EXAMPLE\n"
- body (if (string-match "\n$" body) "" "\n")
- "#+END_EXAMPLE\n")))
- (message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
-
-;;--------------------------------------------------------------------------------
-;; comment: export comments in author-specific css-stylable divs
-(defun org-export-blocks-format-comment (body &rest headers)
- "Format comment BODY by OWNER and return it formatted for export.
-Currently, this only does something for HTML export, for all
-other backends, it converts the comment into an EXAMPLE segment."
- (let ((owner (if headers (car headers)))
- (title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
- (cond
- ((eq org-export-current-backend 'html) ;; We are exporting to HTML
- (concat "#+BEGIN_HTML\n"
- "<div class=\"org-comment\""
- (if owner (format " id=\"org-comment-%s\" " owner))
- ">\n"
- (if owner (concat "<b>" owner "</b> ") "")
- (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
- "<p>\n"
- "#+END_HTML\n"
- body
- "\n#+BEGIN_HTML\n"
- "</p>\n"
- "</div>\n"
- "#+END_HTML\n"))
- (t ;; This is not HTML, so just make it an example.
- (concat "#+BEGIN_EXAMPLE\n"
- (if title (concat "Title:" title "\n") "")
- (if owner (concat "By:" owner "\n") "")
- body
- (if (string-match "\n\\'" body) "" "\n")
- "#+END_EXAMPLE\n")))))
-
-(provide 'org-exp-blocks)
-
-;;; org-exp-blocks.el ends here
diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el
deleted file mode 100644
index 82b9003e4fd..00000000000
--- a/lisp/org/org-exp.el
+++ /dev/null
@@ -1,3354 +0,0 @@
-;;; org-exp.el --- Export internals for Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;;; Code:
-
-(require 'org)
-(require 'org-macs)
-(require 'org-agenda)
-(require 'org-exp-blocks)
-(require 'ob-exp)
-(require 'org-src)
-
-(eval-when-compile
- (require 'cl))
-
-(declare-function org-export-latex-preprocess "org-latex" (parameters))
-(declare-function org-export-ascii-preprocess "org-ascii" (parameters))
-(declare-function org-export-html-preprocess "org-html" (parameters))
-(declare-function org-export-docbook-preprocess "org-docbook" (parameters))
-(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
-(declare-function org-export-htmlize-region-for-paste "org-html" (beg end))
-(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
-(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
-(declare-function org-table-cookie-line-p "org-table" (line))
-(declare-function org-table-colgroup-line-p "org-table" (line))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
-(declare-function org-unescape-code-in-region "org-src" (beg end))
-
-(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t)
-
-(autoload 'org-export-as-odt "org-odt"
- "Export the outline to a OpenDocument Text file." t)
-(autoload 'org-export-as-odt-and-open "org-odt"
- "Export the outline to a OpenDocument Text file and open it." t)
-
-(defgroup org-export nil
- "Options for exporting org-listings."
- :tag "Org Export"
- :group 'org)
-
-(defgroup org-export-general nil
- "General options for exporting Org-mode files."
- :tag "Org Export General"
- :group 'org-export)
-
-(defcustom org-export-allow-BIND 'confirm
- "Non-nil means allow #+BIND to define local variable values for export.
-This is a potential security risk, which is why the user must confirm the
-use of these lines."
- :group 'org-export-general
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Make the user confirm for each file" confirm)))
-
-;; FIXME
-(defvar org-export-publishing-directory nil)
-
-(defcustom org-export-show-temporary-export-buffer t
- "Non-nil means show buffer after exporting to temp buffer.
-When Org exports to a file, the buffer visiting that file is ever
-shown, but remains buried. However, when exporting to a temporary
-buffer, that buffer is popped up in a second window. When this variable
-is nil, the buffer remains buried also in these cases."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-copy-to-kill-ring t
- "Non-nil means exported stuff will also be pushed onto the kill ring."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-kill-product-buffer-when-displayed nil
- "Non-nil means kill the product buffer if it is displayed immediately.
-This applied to the commands `org-export-as-html-and-open' and
-`org-export-as-pdf-and-open'."
- :group 'org-export-general
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-run-in-background nil
- "Non-nil means export and publishing commands will run in background.
-This works by starting up a separate Emacs process visiting the same file
-and doing the export from there.
-Not all export commands are affected by this - only the ones which
-actually write to a file, and that do not depend on the buffer state.
-\\<org-mode-map>
-If this option is nil, you can still get background export by calling
-`org-export' with a double prefix arg: \
-\\[universal-argument] \\[universal-argument] \\[org-export].
-
-If this option is t, the double prefix can be used to exceptionally
-force an export command into the current process."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-initial-scope 'buffer
- "The initial scope when exporting with `org-export'.
-This variable can be either set to 'buffer or 'subtree."
- :group 'org-export-general
- :version "24.1"
- :type '(choice
- (const :tag "Export current buffer" 'buffer)
- (const :tag "Export current subtree" 'subtree)))
-
-(defcustom org-export-select-tags '("export")
- "Tags that select a tree for export.
-If any such tag is found in a buffer, all trees that do not carry one
-of these tags will be deleted before export.
-Inside trees that are selected like this, you can still deselect a
-subtree by tagging it with one of the `org-export-exclude-tags'."
- :group 'org-export-general
- :type '(repeat (string :tag "Tag")))
-
-(defcustom org-export-exclude-tags '("noexport")
- "Tags that exclude a tree from export.
-All trees carrying any of these tags will be excluded from export.
-This is without condition, so even subtrees inside that carry one of the
-`org-export-select-tags' will be removed."
- :group 'org-export-general
- :type '(repeat (string :tag "Tag")))
-
-;; FIXME: rename, this is a general variable
-(defcustom org-export-html-expand t
- "Non-nil means for HTML export, treat @<...> as HTML tag.
-When nil, these tags will be exported as plain text and therefore
-not be interpreted by a browser.
-
-This option can also be set with the +OPTIONS line, e.g. \"@:nil\"."
- :group 'org-export-html
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-special-strings t
- "Non-nil means interpret \"\-\", \"--\" and \"---\" for export.
-When this option is turned on, these strings will be exported as:
-
- Org HTML LaTeX
- -----+----------+--------
- \\- &shy; \\-
- -- &ndash; --
- --- &mdash; ---
- ... &hellip; \ldots
-
-This option can also be set with the +OPTIONS line, e.g. \"-:nil\"."
- :group 'org-export-translation
- :type 'boolean)
-
-(defcustom org-export-html-link-up ""
- "Where should the \"UP\" link of exported HTML pages lead?"
- :group 'org-export-html
- :group 'org-export-general
- :type '(string :tag "File or URL"))
-
-(defcustom org-export-html-link-home ""
- "Where should the \"HOME\" link of exported HTML pages lead?"
- :group 'org-export-html
- :group 'org-export-general
- :type '(string :tag "File or URL"))
-
-(defcustom org-export-language-setup
- '(("en" "Author" "Date" "Table of Contents" "Footnotes")
- ("ca" "Autor" "Data" "&Iacute;ndex" "Peus de p&agrave;gina")
- ("cs" "Autor" "Datum" "Obsah" "Pozn\xe1mky pod carou")
- ("da" "Ophavsmand" "Dato" "Indhold" "Fodnoter")
- ("de" "Autor" "Datum" "Inhaltsverzeichnis" "Fu&szlig;noten")
- ("eo" "A&#365;toro" "Dato" "Enhavo" "Piednotoj")
- ("es" "Autor" "Fecha" "&Iacute;ndice" "Pies de p&aacute;gina")
- ("fi" "Tekij&auml;" "P&auml;iv&auml;m&auml;&auml;r&auml;" "Sis&auml;llysluettelo" "Alaviitteet")
- ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page")
- ("hu" "Szerz&otilde;" "D&aacute;tum" "Tartalomjegyz&eacute;k" "L&aacute;bjegyzet")
- ("is" "H&ouml;fundur" "Dagsetning" "Efnisyfirlit" "Aftanm&aacute;lsgreinar")
- ("it" "Autore" "Data" "Indice" "Note a pi&egrave; di pagina")
- ;; Use numeric character entities for proper rendering of non-UTF8 documents
- ;; ("ja" "著者" "日付" "目次" "脚注")
- ("ja" "&#33879;&#32773;" "&#26085;&#20184;" "&#30446;&#27425;" "&#33050;&#27880;")
- ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten")
- ("no" "Forfatter" "Dato" "Innhold" "Fotnoter")
- ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l)
- ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk)
- ("pl" "Autor" "Data" "Spis tre&#x015b;ci" "Przypis")
- ;; Use numeric character entities for proper rendering of non-UTF8 documents
- ;; ("ru" "Автор" "Дата" "Содержание" "Сноски")
- ("ru" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;" "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;")
- ("sv" "F&ouml;rfattare" "Datum" "Inneh&aring;ll" "Fotnoter")
- ;; Use numeric character entities for proper rendering of non-UTF8 documents
- ;; ("uk" "Автор" "Дата" "Зміст" "Примітки")
- ("uk" "&#1040;&#1074;&#1090;&#1086;&#1088;" "&#1044;&#1072;&#1090;&#1072;" "&#1047;&#1084;&#1110;&#1089;&#1090;" "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;")
- ;; Use numeric character entities for proper rendering of non-UTF8 documents
- ;; ("zh-CN" "作者" "日期" "目录" "脚注")
- ("zh-CN" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#24405;" "&#33050;&#27880;")
- ;; Use numeric character entities for proper rendering of non-UTF8 documents
- ;; ("zh-TW" "作者" "日期" "目錄" "腳註")
- ("zh-TW" "&#20316;&#32773;" "&#26085;&#26399;" "&#30446;&#37636;" "&#33139;&#35387;"))
- "Terms used in export text, translated to different languages.
-Use the variable `org-export-default-language' to set the language,
-or use the +OPTION lines for a per-file setting."
- :group 'org-export-general
- :type '(repeat
- (list
- (string :tag "HTML language tag")
- (string :tag "Author")
- (string :tag "Date")
- (string :tag "Table of Contents")
- (string :tag "Footnotes"))))
-
-(defcustom org-export-default-language "en"
- "The default language for export and clocktable translations, as a string.
-This should have an association in `org-export-language-setup'
-and in `org-clock-clocktable-language-setup'."
- :group 'org-export-general
- :type 'string)
-
-(defcustom org-export-date-timestamp-format "%Y-%m-%d"
- "Time string format for Org timestamps in the #+DATE option."
- :group 'org-export-general
- :version "24.1"
- :type 'string)
-
-(defvar org-export-page-description ""
- "The page description, for the XHTML meta tag.
-This is best set with the #+DESCRIPTION line in a file, it does not make
-sense to set this globally.")
-
-(defvar org-export-page-keywords ""
- "The page description, for the XHTML meta tag.
-This is best set with the #+KEYWORDS line in a file, it does not make
-sense to set this globally.")
-
-(defcustom org-export-skip-text-before-1st-heading nil
- "Non-nil means skip all text before the first headline when exporting.
-When nil, that text is exported as well."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-headline-levels 3
- "The last level which is still exported as a headline.
-Inferior levels will produce itemize lists when exported.
-Note that a numeric prefix argument to an exporter function overrides
-this setting.
-
-This option can also be set with the +OPTIONS line, e.g. \"H:2\"."
- :group 'org-export-general
- :type 'integer)
-
-(defcustom org-export-with-section-numbers t
- "Non-nil means add section numbers to headlines when exporting.
-
-This option can also be set with the +OPTIONS line, e.g. \"num:t\"."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-section-number-format '((("1" ".")) . "")
- "Format of section numbers for export.
-The variable has two components.
-1. A list of lists, each indicating a counter type and a separator.
- The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\".
- It causes causes numeric, alphabetic, or roman counters, respectively.
- The separator is only used if another counter for a subsection is being
- added.
- If there are more numbered section levels than entries in this lists,
- then the last entry will be reused.
-2. A terminator string that will be added after the entire
- section number."
- :group 'org-export-general
- :type '(cons
- (repeat
- (list
- (string :tag "Counter Type")
- (string :tag "Separator ")))
- (string :tag "Terminator")))
-
-(defcustom org-export-with-toc t
- "Non-nil means create a table of contents in exported files.
-The TOC contains headlines with levels up to`org-export-headline-levels'.
-When an integer, include levels up to N in the toc, this may then be
-different from `org-export-headline-levels', but it will not be allowed
-to be larger than the number of headline levels.
-When nil, no table of contents is made.
-
-Headlines which contain any TODO items will be marked with \"(*)\" in
-ASCII export, and with red color in HTML output, if the option
-`org-export-mark-todo-in-toc' is set.
-
-In HTML output, the TOC will be clickable.
-
-This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"
-or \"toc:3\"."
- :group 'org-export-general
- :type '(choice
- (const :tag "No Table of Contents" nil)
- (const :tag "Full Table of Contents" t)
- (integer :tag "TOC to level")))
-
-(defcustom org-export-mark-todo-in-toc nil
- "Non-nil means mark TOC lines that contain any open TODO items."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-todo-keywords t
- "Non-nil means include TODO keywords in export.
-When nil, remove all these keywords from the export."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-tasks t
- "Non-nil means include TODO items for export.
-This may have the following values:
-t include tasks independent of state.
-todo include only tasks that are not yet done.
-done include only tasks that are already done.
-nil remove all tasks before export
-list of TODO kwds keep only tasks with these keywords"
- :group 'org-export-general
- :version "24.1"
- :type '(choice
- (const :tag "All tasks" t)
- (const :tag "No tasks" nil)
- (const :tag "Not-done tasks" todo)
- (const :tag "Only done tasks" done)
- (repeat :tag "Specific TODO keywords"
- (string :tag "Keyword"))))
-
-(defcustom org-export-with-priority nil
- "Non-nil means include priority cookies in export.
-When nil, remove priority cookies for export."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-preserve-breaks nil
- "Non-nil means preserve all line breaks when exporting.
-Normally, in HTML output paragraphs will be reformatted. In ASCII
-export, line breaks will always be preserved, regardless of this variable.
-
-This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-archived-trees 'headline
- "Whether subtrees with the ARCHIVE tag should be exported.
-This can have three different values
-nil Do not export, pretend this tree is not present
-t Do export the entire tree
-headline Only export the headline, but skip the tree below it."
- :group 'org-export-general
- :group 'org-archive
- :type '(choice
- (const :tag "not at all" nil)
- (const :tag "headline only" 'headline)
- (const :tag "entirely" t)))
-
-(defcustom org-export-author-info t
- "Non-nil means insert author name and email into the exported file.
-
-This option can also be set with the +OPTIONS line,
-e.g. \"author:nil\"."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-email-info nil
- "Non-nil means insert author name and email into the exported file.
-
-This option can also be set with the +OPTIONS line,
-e.g. \"email:t\"."
- :group 'org-export-general
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-creator-info t
- "Non-nil means the postamble should contain a creator sentence.
-This sentence is \"HTML generated by org-mode XX in emacs XXX\"."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-time-stamp-file t
- "Non-nil means insert a time stamp into the exported file.
-The time stamp shows when the file was created.
-
-This option can also be set with the +OPTIONS line,
-e.g. \"timestamp:nil\"."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-timestamps t
- "If nil, do not export time stamps and associated keywords."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-remove-timestamps-from-toc t
- "If t, remove timestamps from the table of contents entries."
- :group 'org-export-general
- :type 'boolean)
-
-(defcustom org-export-with-tags 'not-in-toc
- "If nil, do not export tags, just remove them from headlines.
-If this is the symbol `not-in-toc', tags will be removed from table of
-contents entries, but still be shown in the headlines of the document.
-
-This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"."
- :group 'org-export-general
- :type '(choice
- (const :tag "Off" nil)
- (const :tag "Not in TOC" not-in-toc)
- (const :tag "On" t)))
-
-(defcustom org-export-with-drawers nil
- "Non-nil means export with drawers like the property drawer.
-When t, all drawers are exported. This may also be a list of
-drawer names to export."
- :group 'org-export-general
- :type '(choice
- (const :tag "All drawers" t)
- (const :tag "None" nil)
- (repeat :tag "Selected drawers"
- (string :tag "Drawer name"))))
-
-(defvar org-export-first-hook nil
- "Hook called as the first thing in each exporter.
-Point will be still in the original buffer.
-Good for general initialization")
-
-(defvar org-export-preprocess-hook nil
- "Hook for preprocessing an export buffer.
-Pretty much the first thing when exporting is running this hook.
-Point will be in a temporary buffer that contains a copy of
-the original buffer, or of the section that is being exported.
-All the other hooks in the org-export-preprocess... category
-also work in that temporary buffer, already modified by various
-stages of the processing.")
-
-(defvar org-export-preprocess-after-include-files-hook nil
- "Hook for preprocessing an export buffer.
-This is run after the contents of included files have been inserted.")
-
-(defvar org-export-preprocess-after-tree-selection-hook nil
- "Hook for preprocessing an export buffer.
-This is run after selection of trees to be exported has happened.
-This selection includes tags-based selection, as well as removal
-of commented and archived trees.")
-
-(defvar org-export-preprocess-after-headline-targets-hook nil
- "Hook for preprocessing export buffer.
-This is run just after the headline targets have been defined and
-the target-alist has been set up.")
-
-(defvar org-export-preprocess-before-selecting-backend-code-hook nil
- "Hook for preprocessing an export buffer.
-This is run just before backend-specific blocks get selected.")
-
-(defvar org-export-preprocess-after-blockquote-hook nil
- "Hook for preprocessing an export buffer.
-This is run after blockquote/quote/verse/center have been marked
-with cookies.")
-
-(defvar org-export-preprocess-after-radio-targets-hook nil
- "Hook for preprocessing an export buffer.
-This is run after radio target processing.")
-
-(defvar org-export-preprocess-before-normalizing-links-hook nil
- "Hook for preprocessing an export buffer.
-This hook is run before links are normalized.")
-
-(defvar org-export-preprocess-before-backend-specifics-hook nil
- "Hook run before backend-specific functions are called during preprocessing.")
-
-(defvar org-export-preprocess-final-hook nil
- "Hook for preprocessing an export buffer.
-This is run as the last thing in the preprocessing buffer, just before
-returning the buffer string to the backend.")
-
-(defgroup org-export-translation nil
- "Options for translating special ascii sequences for the export backends."
- :tag "Org Export Translation"
- :group 'org-export)
-
-(defcustom org-export-with-emphasize t
- "Non-nil means interpret *word*, /word/, and _word_ as emphasized text.
-If the export target supports emphasizing text, the word will be
-typeset in bold, italic, or underlined, respectively. Works only for
-single words, but you can say: I *really* *mean* *this*.
-Not all export backends support this.
-
-This option can also be set with the +OPTIONS line, e.g. \"*:nil\"."
- :group 'org-export-translation
- :type 'boolean)
-
-(defcustom org-export-with-footnotes t
- "If nil, export [1] as a footnote marker.
-Lines starting with [1] will be formatted as footnotes.
-
-This option can also be set with the +OPTIONS line, e.g. \"f:nil\"."
- :group 'org-export-translation
- :type 'boolean)
-
-(defcustom org-export-with-TeX-macros t
- "Non-nil means interpret simple TeX-like macros when exporting.
-For example, HTML export converts \\alpha to &alpha; and \\AA to &Aring;.
-Not only real TeX macros will work here, but the standard HTML entities
-for math can be used as macro names as well. For a list of supported
-names in HTML export, see the constant `org-entities' and the user option
-`org-entities-user'.
-Not all export backends support this.
-
-This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"."
- :group 'org-export-translation
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-with-LaTeX-fragments t
- "Non-nil means process LaTeX math fragments for HTML display.
-When set, the exporter will find and process LaTeX environments if the
-\\begin line is the first non-white thing on a line. It will also find
-and process the math delimiters like $a=b$ and \\( a=b \\) for inline math,
-$$a=b$$ and \\=\\[ a=b \\] for display math.
-
-This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\".
-
-Allowed values are:
-
-nil Don't do anything.
-verbatim Keep everything in verbatim
-dvipng Process the LaTeX fragments to images.
- This will also include processing of non-math environments.
-imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
- to convert pdf files to png files.
-t Do MathJax preprocessing if there is at least on math snippet,
- and arrange for MathJax.js to be loaded.
-
-The default is nil, because this option needs the `dvipng' program which
-is not available on all systems."
- :group 'org-export-translation
- :group 'org-export-latex
- :type '(choice
- (const :tag "Do not process math in any way" nil)
- (const :tag "Obsolete, use dvipng setting" t)
- (const :tag "Use dvipng to make images" dvipng)
- (const :tag "Use imagemagick to make images" imagemagick)
- (const :tag "Use MathJax to display math" mathjax)
- (const :tag "Leave math verbatim" verbatim)))
-
-(defcustom org-export-with-fixed-width t
- "Non-nil means lines starting with \":\" will be in fixed width font.
-This can be used to have pre-formatted text, fragments of code etc. For
-example:
- : ;; Some Lisp examples
- : (while (defc cnt)
- : (ding))
-will be looking just like this in also HTML. See also the QUOTE keyword.
-Not all export backends support this.
-
-This option can also be set with the +OPTIONS line, e.g. \"::nil\"."
- :group 'org-export-translation
- :type 'boolean)
-
-(defgroup org-export-tables nil
- "Options for exporting tables in Org-mode."
- :tag "Org Export Tables"
- :group 'org-export)
-
-(defcustom org-export-with-tables t
- "If non-nil, lines starting with \"|\" define a table.
-For example:
-
- | Name | Address | Birthday |
- |-------------+----------+-----------|
- | Arthur Dent | England | 29.2.2100 |
-
-Not all export backends support this.
-
-This option can also be set with the +OPTIONS line, e.g. \"|:nil\"."
- :group 'org-export-tables
- :type 'boolean)
-
-(defcustom org-export-highlight-first-table-line t
- "Non-nil means highlight the first table line.
-In HTML export, this means use <th> instead of <td>.
-In tables created with table.el, this applies to the first table line.
-In Org-mode tables, all lines before the first horizontal separator
-line will be formatted with <th> tags."
- :group 'org-export-tables
- :type 'boolean)
-
-(defcustom org-export-table-remove-special-lines t
- "Remove special lines and marking characters in calculating tables.
-This removes the special marking character column from tables that are set
-up for spreadsheet calculations. It also removes the entire lines
-marked with `!', `_', or `^'. The lines with `$' are kept, because
-the values of constants may be useful to have."
- :group 'org-export-tables
- :type 'boolean)
-
-(defcustom org-export-table-remove-empty-lines t
- "Remove empty lines when exporting tables.
-This is the global equivalent of the :remove-nil-lines option
-when locally sending a table with #+ORGTBL."
- :group 'org-export-tables
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-prefer-native-exporter-for-tables nil
- "Non-nil means always export tables created with table.el natively.
-Natively means use the HTML code generator in table.el.
-When nil, Org-mode's own HTML generator is used when possible (i.e. if
-the table does not use row- or column-spanning). This has the
-advantage, that the automatic HTML conversions for math symbols and
-sub/superscripts can be applied. Org-mode's HTML generator is also
-much faster. The LaTeX exporter always use the native exporter for
-table.el tables."
- :group 'org-export-tables
- :type 'boolean)
-
-;;;; Exporting
-
-;;; Variables, constants, and parameter plists
-
-(defconst org-level-max 20)
-
-(defvar org-export-current-backend nil
- "During export, this will be bound to a symbol such as 'html,
- 'latex, 'docbook, 'ascii, etc, indicating which of the export
- backends is in use. Otherwise it has the value nil. Users
- should not attempt to change the value of this variable
- directly, but it can be used in code to test whether export is
- in progress, and if so, what the backend is.")
-
-(defvar org-current-export-file nil) ; dynamically scoped parameter
-(defvar org-current-export-dir nil) ; dynamically scoped parameter
-(defvar org-export-opt-plist nil
- "Contains the current option plist.")
-(defvar org-last-level nil) ; dynamically scoped variable
-(defvar org-min-level nil) ; dynamically scoped variable
-(defvar org-levels-open nil) ; dynamically scoped parameter
-(defvar org-export-footnotes-data nil
- "Alist of labels used in buffers, along with their definition.")
-(defvar org-export-footnotes-seen nil
- "Alist of labels encountered so far by the exporter, along with their definition.")
-
-
-(defconst org-export-plist-vars
- '((:link-up nil org-export-html-link-up)
- (:link-home nil org-export-html-link-home)
- (:language nil org-export-default-language)
- (:keywords nil org-export-page-keywords)
- (:description nil org-export-page-description)
- (:customtime nil org-display-custom-times)
- (:headline-levels "H" org-export-headline-levels)
- (:section-numbers "num" org-export-with-section-numbers)
- (:section-number-format nil org-export-section-number-format)
- (:table-of-contents "toc" org-export-with-toc)
- (:preserve-breaks "\\n" org-export-preserve-breaks)
- (:archived-trees nil org-export-with-archived-trees)
- (:emphasize "*" org-export-with-emphasize)
- (:sub-superscript "^" org-export-with-sub-superscripts)
- (:special-strings "-" org-export-with-special-strings)
- (:footnotes "f" org-export-with-footnotes)
- (:drawers "d" org-export-with-drawers)
- (:tags "tags" org-export-with-tags)
- (:todo-keywords "todo" org-export-with-todo-keywords)
- (:tasks "tasks" org-export-with-tasks)
- (:priority "pri" org-export-with-priority)
- (:TeX-macros "TeX" org-export-with-TeX-macros)
- (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments)
- (:latex-listings nil org-export-latex-listings)
- (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading)
- (:fixed-width ":" org-export-with-fixed-width)
- (:timestamps "<" org-export-with-timestamps)
- (:author nil user-full-name)
- (:email nil user-mail-address)
- (:author-info "author" org-export-author-info)
- (:email-info "email" org-export-email-info)
- (:creator-info "creator" org-export-creator-info)
- (:time-stamp-file "timestamp" org-export-time-stamp-file)
- (:tables "|" org-export-with-tables)
- (:table-auto-headline nil org-export-highlight-first-table-line)
- (:style-include-default nil org-export-html-style-include-default)
- (:style-include-scripts nil org-export-html-style-include-scripts)
- (:style nil org-export-html-style)
- (:style-extra nil org-export-html-style-extra)
- (:agenda-style nil org-agenda-export-html-style)
- (:convert-org-links nil org-export-html-link-org-files-as-html)
- (:inline-images nil org-export-html-inline-images)
- (:html-extension nil org-export-html-extension)
- (:html-preamble nil org-export-html-preamble)
- (:html-postamble nil org-export-html-postamble)
- (:xml-declaration nil org-export-html-xml-declaration)
- (:html-table-tag nil org-export-html-table-tag)
- (:expand-quoted-html "@" org-export-html-expand)
- (:timestamp nil org-export-html-with-timestamp)
- (:publishing-directory nil org-export-publishing-directory)
- (:select-tags nil org-export-select-tags)
- (:exclude-tags nil org-export-exclude-tags)
-
- (:latex-image-options nil org-export-latex-image-default-option))
- "List of properties that represent export/publishing variables.
-Each element is a list of 3 items:
-1. The property that is used internally, and also for org-publish-project-alist
-2. The string that can be used in the OPTION lines to set this option,
- or nil if this option cannot be changed in this way
-3. The customization variable that sets the default for this option."
- )
-
-(defun org-default-export-plist ()
- "Return the property list with default settings for the export variables."
- (let* ((infile (org-infile-export-plist))
- (letbind (plist-get infile :let-bind))
- (l org-export-plist-vars) rtn e s v)
- (while (setq e (pop l))
- (setq s (nth 2 e)
- v (cond
- ((assq s letbind) (nth 1 (assq s letbind)))
- ((boundp s) (symbol-value s)))
- rtn (cons (car e) (cons v rtn))))
- rtn))
-
-(defvar org-export-inbuffer-options-extra nil
- "List of additional in-buffer options that should be detected.
-Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL,
-etc. Extensions can add to this list to get their options detected, and they
-can then add a function to `org-export-options-filters' to process these
-options.
-Each element in this list must be a list, with the in-buffer keyword as car,
-and a property (a symbol) as the next element. All occurrences of the
-keyword will be found, the values concatenated with a space character
-in between, and the result stored in the export options property list.")
-
-(defvar org-export-options-filters nil
- "Functions to be called to finalize the export/publishing options.
-All these options are stored in a property list, and each of the functions
-in this hook gets a chance to modify this property list. Each function
-must accept the property list as an argument, and must return the (possibly
-modified) list.")
-
-;; FIXME: should we fold case here?
-
-(defun org-infile-export-plist ()
- "Return the property list with file-local settings for export."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((re (org-make-options-regexp
- (append
- '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
- "MATHJAX"
- "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE"
- "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS"
- "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS"
- "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT")
- (mapcar 'car org-export-inbuffer-options-extra))))
- (case-fold-search t)
- p key val text options mathjax a pr style
- latex-header latex-class latex-class-options macros letbind
- ext-setup-or-nil setup-file setup-dir setup-contents (start 0))
- (while (or (and ext-setup-or-nil
- (string-match re ext-setup-or-nil start)
- (setq start (match-end 0)))
- (and (setq ext-setup-or-nil nil start 0)
- (re-search-forward re nil t)))
- (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil))
- val (org-match-string-no-properties 2 ext-setup-or-nil))
- (cond
- ((setq a (assoc key org-export-inbuffer-options-extra))
- (setq pr (nth 1 a))
- (setq p (plist-put p pr (concat (plist-get p pr) " " val))))
- ((string-equal key "TITLE") (setq p (plist-put p :title val)))
- ((string-equal key "AUTHOR")(setq p (plist-put p :author val)))
- ((string-equal key "EMAIL") (setq p (plist-put p :email val)))
- ((string-equal key "DATE")
- ;; If date is an Org timestamp, convert it to a time
- ;; string using `org-export-date-timestamp-format'
- (when (string-match org-ts-regexp3 val)
- (setq val (format-time-string
- org-export-date-timestamp-format
- (apply 'encode-time (org-parse-time-string
- (match-string 0 val))))))
- (setq p (plist-put p :date val)))
- ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val)))
- ((string-equal key "DESCRIPTION")
- (setq p (plist-put p :description val)))
- ((string-equal key "LANGUAGE") (setq p (plist-put p :language val)))
- ((string-equal key "STYLE")
- (setq style (concat style "\n" val)))
- ((string-equal key "LATEX_HEADER")
- (setq latex-header (concat latex-header "\n" val)))
- ((string-equal key "LATEX_CLASS")
- (setq latex-class val))
- ((string-equal key "LATEX_CLASS_OPTIONS")
- (setq latex-class-options val))
- ((string-equal key "TEXT")
- (setq text (if text (concat text "\n" val) val)))
- ((string-equal key "OPTIONS")
- (setq options (concat val " " options)))
- ((string-equal key "MATHJAX")
- (setq mathjax (concat val " " mathjax)))
- ((string-equal key "BIND")
- (push (read (concat "(" val ")")) letbind))
- ((string-equal key "XSLT")
- (setq p (plist-put p :xslt val)))
- ((string-equal key "LINK_UP")
- (setq p (plist-put p :link-up val)))
- ((string-equal key "LINK_HOME")
- (setq p (plist-put p :link-home val)))
- ((string-equal key "EXPORT_SELECT_TAGS")
- (setq p (plist-put p :select-tags (org-split-string val))))
- ((string-equal key "EXPORT_EXCLUDE_TAGS")
- (setq p (plist-put p :exclude-tags (org-split-string val))))
- ((string-equal key "MACRO")
- (push val macros))
- ((equal key "SETUPFILE")
- (setq setup-file (org-remove-double-quotes (org-trim val))
- ;; take care of recursive inclusion of setupfiles
- setup-file (if (or (file-name-absolute-p val) (not setup-dir))
- (expand-file-name setup-file)
- (let ((default-directory setup-dir))
- (expand-file-name setup-file))))
- (setq setup-dir (file-name-directory setup-file))
- (setq setup-contents (org-file-contents setup-file 'noerror))
- (if (not ext-setup-or-nil)
- (setq ext-setup-or-nil setup-contents start 0)
- (setq ext-setup-or-nil
- (concat (substring ext-setup-or-nil 0 start)
- "\n" setup-contents "\n"
- (substring ext-setup-or-nil start)))))))
- (setq p (plist-put p :text text))
- (when (and letbind (org-export-confirm-letbind))
- (setq p (plist-put p :let-bind letbind)))
- (when style (setq p (plist-put p :style-extra style)))
- (when latex-header
- (setq p (plist-put p :latex-header-extra (substring latex-header 1))))
- (when latex-class
- (setq p (plist-put p :latex-class latex-class)))
- (when latex-class-options
- (setq p (plist-put p :latex-class-options latex-class-options)))
- (when options
- (setq p (org-export-add-options-to-plist p options)))
- (when mathjax
- (setq p (plist-put p :mathjax mathjax)))
- ;; Add macro definitions
- (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))"))
- (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))"))
- (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))
- (setq p (plist-put
- p :macro-modification-time
- (and (buffer-file-name)
- (file-exists-p (buffer-file-name))
- (concat
- "(eval (format-time-string \"$1\" '"
- (prin1-to-string (nth 5 (file-attributes
- (buffer-file-name))))
- "))"))))
- (setq p (plist-put p :macro-input-file (and (buffer-file-name)
- (file-name-nondirectory
- (buffer-file-name)))))
- (while (setq val (pop macros))
- (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val)
- (setq p (plist-put
- p (intern
- (concat ":macro-" (downcase (match-string 1 val))))
- (org-export-interpolate-newlines (match-string 2 val))))))
- p))))
-
-(defun org-export-interpolate-newlines (s)
- (while (string-match "\\\\n" s)
- (setq s (replace-match "\n" t t s)))
- s)
-
-(defvar org-export-allow-BIND-local nil)
-(defun org-export-confirm-letbind ()
- "Can we use #+BIND values during export?
-By default this will ask for confirmation by the user, to divert possible
-security risks."
- (cond
- ((not org-export-allow-BIND) nil)
- ((eq org-export-allow-BIND t) t)
- ((local-variable-p 'org-export-allow-BIND-local (current-buffer))
- org-export-allow-BIND-local)
- (t (org-set-local 'org-export-allow-BIND-local
- (yes-or-no-p "Allow BIND values in this buffer? ")))))
-
-(defun org-install-letbind ()
- "Install the values from #+BIND lines as local variables."
- (let ((letbind (plist-get org-export-opt-plist :let-bind))
- pair)
- (while (setq pair (pop letbind))
- (org-set-local (car pair) (nth 1 pair)))))
-
-(defun org-export-add-options-to-plist (p options)
- "Parse an OPTIONS line and set values in the property list P."
- (let (o)
- (when options
- (let ((op org-export-plist-vars))
- (while (setq o (pop op))
- (if (and (nth 1 o)
- (string-match (concat "\\(\\`\\|[ \t]\\)"
- (regexp-quote (nth 1 o))
- ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
- options))
- (setq p (plist-put p (car o)
- (car (read-from-string
- (match-string 2 options))))))))))
- p)
-
-(defun org-export-add-subtree-options (p pos)
- "Add options in subtree at position POS to property list P."
- (save-excursion
- (goto-char pos)
- (when (org-at-heading-p)
- (let (a)
- ;; This is actually read in `org-export-get-title-from-subtree'
- ;; (when (setq a (org-entry-get pos "EXPORT_TITLE"))
- ;; (setq p (plist-put p :title a)))
- (when (setq a (org-entry-get pos "EXPORT_TEXT"))
- (setq p (plist-put p :text a)))
- (when (setq a (org-entry-get pos "EXPORT_AUTHOR"))
- (setq p (plist-put p :author a)))
- (when (setq a (org-entry-get pos "EXPORT_DATE"))
- (setq p (plist-put p :date a)))
- (when (setq a (org-entry-get pos "EXPORT_OPTIONS"))
- (setq p (org-export-add-options-to-plist p a)))))
- p))
-
-(defun org-export-directory (type plist)
- (let* ((val (plist-get plist :publishing-directory))
- (dir (if (listp val)
- (or (cdr (assoc type val)) ".")
- val)))
- dir))
-
-(defun org-export-process-option-filters (plist)
- (let ((functions org-export-options-filters) f)
- (while (setq f (pop functions))
- (setq plist (funcall f plist))))
- plist)
-
-;;;###autoload
-(defun org-export (&optional arg)
- "Export dispatcher for Org-mode.
-When `org-export-run-in-background' is non-nil, try to run the command
-in the background. This will be done only for commands that write
-to a file. For details see the docstring of `org-export-run-in-background'.
-
-The prefix argument ARG will be passed to the exporter. However, if
-ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \
-that means to inverse the
-value of `org-export-run-in-background'.
-
-If `org-export-initial-scope' is set to 'subtree, try to export
-the current subtree, otherwise try to export the whole buffer.
-Pressing `1' will switch between these two options."
- (interactive "P")
- (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background))
- (subtree-p (or (org-region-active-p)
- (eq org-export-initial-scope 'subtree)))
- (regb (and (org-region-active-p) (region-beginning)))
- (rege (and (org-region-active-p) (region-end)))
- (help "[t] insert the export option template
-\[v] limit export to visible part of outline tree
-\[1] switch buffer/subtree export
-\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop)
-
-\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer
-
-\[h] export as HTML [H] to temporary buffer [R] export region
-\[b] export as HTML and open in browser
-
-\[l] export as LaTeX [L] to temporary buffer
-\[p] export as LaTeX and process to PDF [d] ... and open PDF file
-
-\[D] export as DocBook [V] export as DocBook, process to PDF, and open
-
-\[o] export as OpenDocument Text [O] ... and open
-
-\[j] export as TaskJuggler [J] ... and open
-
-\[m] export as Freemind mind map
-\[x] export as XOXO
-\[g] export using Wes Hardaker's generic exporter
-
-\[i] export current file as iCalendar file
-\[I] export all agenda files as iCalendar files [c] ...as one combined file
-
-\[F] publish current file [P] publish current project
-\[X] publish a project... [E] publish every projects")
- (cmds
- '((?t org-insert-export-options-template nil)
- (?v org-export-visible nil)
- (?a org-export-as-ascii t)
- (?A org-export-as-ascii-to-buffer t)
- (?n org-export-as-latin1 t)
- (?N org-export-as-latin1-to-buffer t)
- (?u org-export-as-utf8 t)
- (?U org-export-as-utf8-to-buffer t)
- (?h org-export-as-html t)
- (?b org-export-as-html-and-open t)
- (?H org-export-as-html-to-buffer nil)
- (?R org-export-region-as-html nil)
- (?x org-export-as-xoxo t)
- (?g org-export-generic t)
- (?D org-export-as-docbook t)
- (?V org-export-as-docbook-pdf-and-open t)
- (?o org-export-as-odt t)
- (?O org-export-as-odt-and-open t)
- (?j org-export-as-taskjuggler t)
- (?J org-export-as-taskjuggler-and-open t)
- (?m org-export-as-freemind t)
- (?l org-export-as-latex t)
- (?p org-export-as-pdf t)
- (?d org-export-as-pdf-and-open t)
- (?L org-export-as-latex-to-buffer nil)
- (?i org-export-icalendar-this-file t)
- (?I org-export-icalendar-all-agenda-files t)
- (?c org-export-icalendar-combine-agenda-files t)
- (?F org-publish-current-file t)
- (?P org-publish-current-project t)
- (?X org-publish t)
- (?E org-publish-all t)))
- r1 r2 ass
- (cpos (point)) (cbuf (current-buffer)) bpos)
- (save-excursion
- (save-window-excursion
- (if subtree-p
- (message "Export subtree: ")
- (message "Export buffer: "))
- (delete-other-windows)
- (with-output-to-temp-buffer "*Org Export/Publishing Help*"
- (princ help))
- (org-fit-window-to-buffer (get-buffer-window
- "*Org Export/Publishing Help*"))
- (while (eq (setq r1 (read-char-exclusive)) ?1)
- (cond (subtree-p
- (setq subtree-p nil)
- (message "Export buffer: "))
- ((not subtree-p)
- (setq subtree-p t)
- (setq bpos (point))
- (org-mark-subtree)
- (org-activate-mark)
- (setq regb (and (org-region-active-p) (region-beginning)))
- (setq rege (and (org-region-active-p) (region-end)))
- (message "Export subtree: "))))
- (when (eq r1 ?\ )
- (let ((case-fold-search t)
- (end (save-excursion (while (org-up-heading-safe)) (point))))
- (outline-next-heading)
- (if (re-search-backward
- "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-"
- end t)
- (progn
- (org-back-to-heading t)
- (setq subtree-p t)
- (setq bpos (point))
- (message "Select command (for subtree): ")
- (setq r1 (read-char-exclusive)))
- (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME")
- )))))
- (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay)
- (and bpos (goto-char bpos))
- (setq r2 (if (< r1 27) (+ r1 96) r1))
- (unless (setq ass (assq r2 cmds))
- (error "No command associated with key %c" r1))
- (if (and bg (nth 2 ass)
- (not (buffer-base-buffer))
- (not (org-region-active-p)))
- ;; execute in background
- (let ((p (start-process
- (concat "Exporting " (file-name-nondirectory (buffer-file-name)))
- "*Org Processes*"
- (expand-file-name invocation-name invocation-directory)
- "-batch"
- "-l" user-init-file
- "--eval" "(require 'org-exp)"
- "--eval" "(setq org-wait .2)"
- (buffer-file-name)
- "-f" (symbol-name (nth 1 ass)))))
- (set-process-sentinel p 'org-export-process-sentinel)
- (message "Background process \"%s\": started" p))
- ;; set the mark correctly when exporting a subtree
- (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb)))
-
- (call-interactively (nth 1 ass))
- (when (and bpos (get-buffer-window cbuf))
- (let ((cw (selected-window)))
- (select-window (get-buffer-window cbuf))
- (goto-char cpos)
- (deactivate-mark)
- (select-window cw))))))
-
-(defun org-export-process-sentinel (process status)
- (if (string-match "\n+\\'" status)
- (setq status (substring status 0 -1)))
- (message "Background process \"%s\": %s" process status))
-
-;;; General functions for all backends
-
-(defvar org-export-target-aliases nil
- "Alist of targets with invisible aliases.")
-(defvar org-export-preferred-target-alist nil
- "Alist of section id's with preferred aliases.")
-(defvar org-export-id-target-alist nil
- "Alist of section id's with preferred aliases.")
-(defvar org-export-code-refs nil
- "Alist of code references and line numbers.")
-
-(defun org-export-preprocess-string (string &rest parameters)
- "Cleanup STRING so that the true exported has a more consistent source.
-This function takes STRING, which should be a buffer-string of an org-file
-to export. It then creates a temporary buffer where it does its job.
-The result is then again returned as a string, and the exporter works
-on this string to produce the exported version."
- (interactive)
- (let* ((org-export-current-backend (or (plist-get parameters :for-backend)
- org-export-current-backend))
- (archived-trees (plist-get parameters :archived-trees))
- (inhibit-read-only t)
- (drawers org-drawers)
- (source-buffer (current-buffer))
- target-alist rtn)
-
- (setq org-export-target-aliases nil
- org-export-preferred-target-alist nil
- org-export-id-target-alist nil
- org-export-code-refs nil)
-
- (with-temp-buffer
- (erase-buffer)
- (insert string)
- (setq case-fold-search t)
-
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max)
- '(read-only t)))
-
- ;; Remove license-to-kill stuff
- ;; The caller marks some stuff for killing, stuff that has been
- ;; used to create the page title, for example.
- (org-export-kill-licensed-text)
-
- (let ((org-inhibit-startup t)) (org-mode))
- (setq case-fold-search t)
- (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)")
- (org-install-letbind)
-
- ;; Call the hook
- (run-hooks 'org-export-preprocess-hook)
-
- (untabify (point-min) (point-max))
-
- ;; Handle include files, and call a hook
- (org-export-handle-include-files-recurse)
- (run-hooks 'org-export-preprocess-after-include-files-hook)
-
- ;; Get rid of archived trees
- (org-export-remove-archived-trees archived-trees)
-
- ;; Remove comment environment and comment subtrees
- (org-export-remove-comment-blocks-and-subtrees)
-
- ;; Get rid of excluded trees, and call a hook
- (org-export-handle-export-tags (plist-get parameters :select-tags)
- (plist-get parameters :exclude-tags))
- (run-hooks 'org-export-preprocess-after-tree-selection-hook)
-
- ;; Get rid of tasks, depending on configuration
- (org-export-remove-tasks (plist-get parameters :tasks))
-
- ;; Prepare footnotes for export. During that process, footnotes
- ;; actually included in the exported part of the buffer go
- ;; though some transformations:
-
- ;; 1. They have their label normalized (like "[N]");
-
- ;; 2. They get moved at the same place in the buffer (usually at
- ;; its end, but backends may define another place via
- ;; `org-footnote-insert-pos-for-preprocessor');
-
- ;; 3. The are stored in `org-export-footnotes-seen', while
- ;; `org-export-preprocess-string' is applied to their
- ;; definition.
-
- ;; Line-wise exporters ignore `org-export-footnotes-seen', as
- ;; they interpret footnotes at the moment they see them in the
- ;; buffer. Context-wise exporters grab all the info needed in
- ;; that variable and delete moved definitions (as described in
- ;; 2nd step).
- (when (plist-get parameters :footnotes)
- (org-footnote-normalize nil parameters))
-
- ;; Change lists ending. Other parts of export may insert blank
- ;; lines and lists' structure could be altered.
- (org-export-mark-list-end)
-
- ;; Process the macros
- (org-export-preprocess-apply-macros)
- (run-hooks 'org-export-preprocess-after-macros-hook)
-
- ;; Export code blocks
- (org-export-blocks-preprocess)
-
- ;; Mark lists with properties
- (org-export-mark-list-properties)
-
- ;; Handle source code snippets
- (org-export-replace-src-segments-and-examples)
-
- ;; Protect short examples marked by a leading colon
- (org-export-protect-colon-examples)
-
- ;; Protected spaces
- (org-export-convert-protected-spaces)
-
- ;; Find all headings and compute the targets for them
- (setq target-alist (org-export-define-heading-targets target-alist))
-
- (run-hooks 'org-export-preprocess-after-headline-targets-hook)
-
- ;; Find HTML special classes for headlines
- (org-export-remember-html-container-classes)
-
- ;; Get rid of drawers
- (org-export-remove-or-extract-drawers
- drawers (plist-get parameters :drawers))
-
- ;; Get the correct stuff before the first headline
- (when (plist-get parameters :skip-before-1st-heading)
- (goto-char (point-min))
- (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t)
- (delete-region (point-min) (match-beginning 0))
- (goto-char (point-min))
- (insert "\n")))
- (when (plist-get parameters :add-text)
- (goto-char (point-min))
- (insert (plist-get parameters :add-text) "\n"))
-
- ;; Remove todo-keywords before exporting, if the user has requested so
- (org-export-remove-headline-metadata parameters)
-
- ;; Find targets in comments and move them out of comments,
- ;; but mark them as targets that should be invisible
- (setq target-alist (org-export-handle-invisible-targets target-alist))
-
- ;; Select and protect backend specific stuff, throw away stuff
- ;; that is specific for other backends
- (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook)
- (org-export-select-backend-specific-text)
-
- ;; Protect quoted subtrees
- (org-export-protect-quoted-subtrees)
-
- ;; Remove clock lines
- (org-export-remove-clock-lines)
-
- ;; Protect verbatim elements
- (org-export-protect-verbatim)
-
- ;; Blockquotes, verse, and center
- (org-export-mark-blockquote-verse-center)
- (run-hooks 'org-export-preprocess-after-blockquote-hook)
-
- ;; Remove timestamps, if the user has requested so
- (unless (plist-get parameters :timestamps)
- (org-export-remove-timestamps))
-
- ;; Attach captions to the correct object
- (setq target-alist (org-export-attach-captions-and-attributes target-alist))
-
- ;; Find matches for radio targets and turn them into internal links
- (org-export-mark-radio-links)
- (run-hooks 'org-export-preprocess-after-radio-targets-hook)
-
- ;; Find all links that contain a newline and put them into a single line
- (org-export-concatenate-multiline-links)
-
- ;; Normalize links: Convert angle and plain links into bracket links
- ;; and expand link abbreviations
- (run-hooks 'org-export-preprocess-before-normalizing-links-hook)
- (org-export-normalize-links)
-
- ;; Find all internal links. If they have a fuzzy match (i.e. not
- ;; a *dedicated* target match, let the link point to the
- ;; corresponding section.
- (org-export-target-internal-links target-alist)
-
- ;; Find multiline emphasis and put them into single line
- (when (plist-get parameters :emph-multiline)
- (org-export-concatenate-multiline-emphasis))
-
- ;; Remove special table lines, and store alignment information
- (org-store-forced-table-alignment)
- (when org-export-table-remove-special-lines
- (org-export-remove-special-table-lines))
-
- ;; Another hook
- (run-hooks 'org-export-preprocess-before-backend-specifics-hook)
-
- ;; Backend-specific preprocessing
- (let* ((backend-name (symbol-name org-export-current-backend))
- (f (intern (format "org-export-%s-preprocess" backend-name))))
- (require (intern (concat "org-" backend-name)) nil)
- (funcall f parameters))
-
- ;; Remove or replace comments
- (org-export-handle-comments (plist-get parameters :comments))
-
- ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines
- (org-export-handle-metalines)
-
- ;; Run the final hook
- (run-hooks 'org-export-preprocess-final-hook)
-
- (setq rtn (buffer-string)))
- rtn))
-
-(defun org-export-kill-licensed-text ()
- "Remove all text that is marked with a :org-license-to-kill property."
- (let (p)
- (while (setq p (text-property-any (point-min) (point-max)
- :org-license-to-kill t))
- (delete-region
- p (or (next-single-property-change p :org-license-to-kill)
- (point-max))))))
-
-(defvar org-export-define-heading-targets-headline-hook nil
- "Hook that is run when a headline was matched during target search.
-This is part of the preprocessing for export.")
-
-(defun org-export-define-heading-targets (target-alist)
- "Find all headings and define the targets for them.
-The new targets are added to TARGET-ALIST, which is also returned.
-Also find all ID and CUSTOM_ID properties and store them."
- (goto-char (point-min))
- (org-init-section-numbers)
- (let ((re (concat "^" org-outline-regexp
- "\\|"
- "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)"))
- level target last-section-target a id)
- (while (re-search-forward re nil t)
- (org-if-unprotected-at (match-beginning 0)
- (if (match-end 2)
- (progn
- (setq id (org-match-string-no-properties 2))
- (push (cons id target) target-alist)
- (setq a (or (assoc last-section-target org-export-target-aliases)
- (progn
- (push (list last-section-target)
- org-export-target-aliases)
- (car org-export-target-aliases))))
- (push (caar target-alist) (cdr a))
- (when (equal (match-string 1) "CUSTOM_ID")
- (if (not (assoc last-section-target
- org-export-preferred-target-alist))
- (push (cons last-section-target id)
- org-export-preferred-target-alist)))
- (when (equal (match-string 1) "ID")
- (if (not (assoc last-section-target
- org-export-id-target-alist))
- (push (cons last-section-target (concat "ID-" id))
- org-export-id-target-alist))))
- (setq level (org-reduced-level
- (save-excursion (goto-char (point-at-bol))
- (org-outline-level))))
- (setq target (org-solidify-link-text
- (format "sec-%s" (replace-regexp-in-string
- "\\." "-"
- (org-section-number level)))))
- (setq last-section-target target)
- (push (cons target target) target-alist)
- (add-text-properties
- (point-at-bol) (point-at-eol)
- (list 'target target))
- (run-hooks 'org-export-define-heading-targets-headline-hook)))))
- target-alist)
-
-(defun org-export-handle-invisible-targets (target-alist)
- "Find targets in comments and move them out of comments.
-Mark them as invisible targets."
- (let (target tmp a)
- (goto-char (point-min))
- (while (re-search-forward "^#.*?\\(<<<?\\([^>\r\n]+\\)>>>?\\).*" nil t)
- ;; Check if the line before or after is a headline with a target
- (if (setq target (or (get-text-property (point-at-bol 0) 'target)
- (get-text-property (point-at-bol 2) 'target)))
- (progn
- ;; use the existing target in a neighboring line
- (setq tmp (match-string 2))
- (replace-match "")
- (and (looking-at "\n") (delete-char 1))
- (push (cons (setq tmp (org-solidify-link-text tmp)) target)
- target-alist)
- (setq a (or (assoc target org-export-target-aliases)
- (progn
- (push (list target) org-export-target-aliases)
- (car org-export-target-aliases))))
- (push tmp (cdr a)))
- ;; Make an invisible target
- (replace-match "\\1(INVISIBLE)"))))
- target-alist)
-
-(defun org-export-target-internal-links (target-alist)
- "Find all internal links and assign targets to them.
-If a link has a fuzzy match (i.e. not a *dedicated* target match),
-let the link point to the corresponding section.
-This function also handles the id links, if they have a match in
-the current file."
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (org-if-unprotected-at (1+ (match-beginning 0))
- (let* ((org-link-search-must-match-exact-headline t)
- (md (match-data))
- (desc (match-end 2))
- (link (org-link-unescape (match-string 1)))
- (slink (org-solidify-link-text link))
- found props pos cref
- (target
- (cond
- ((= (string-to-char link) ?#)
- ;; user wants exactly this link
- link)
- ((cdr (assoc slink target-alist))
- (or (cdr (assoc (assoc slink target-alist)
- org-export-preferred-target-alist))
- (cdr (assoc slink target-alist))))
- ((and (string-match "^id:" link)
- (cdr (assoc (substring link 3) target-alist))))
- ((string-match "^(\\(.*\\))$" link)
- (setq cref (match-string 1 link))
- (concat "coderef:" cref))
- ((string-match org-link-types-re link) nil)
- ((or (file-name-absolute-p link)
- (string-match "^\\." link))
- nil)
- (t
- (let ((org-link-search-inhibit-query t))
- (save-excursion
- (setq found (condition-case nil (org-link-search link)
- (error nil)))
- (when (and found
- (or (org-at-heading-p)
- (not (eq found 'dedicated))))
- (or (get-text-property (point) 'target)
- (get-text-property
- (max (point-min)
- (1- (or (previous-single-property-change
- (point) 'target) 0)))
- 'target)))))))))
- (when target
- (set-match-data md)
- (goto-char (match-beginning 1))
- (setq props (text-properties-at (point)))
- (delete-region (match-beginning 1) (match-end 1))
- (setq pos (point))
- (insert target)
- (unless desc (insert "][" link))
- (add-text-properties pos (point) props))))))
-
-(defun org-export-remember-html-container-classes ()
- "Store the HTML_CONTAINER_CLASS properties in a text property."
- (goto-char (point-min))
- (let (class)
- (while (re-search-forward
- "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t)
- (setq class (match-string 1))
- (save-excursion
- (when (re-search-backward "^\\*" (point-min) t)
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol)
- 'html-container-class class))))))
-
-(defvar org-export-format-drawer-function nil
- "Function to be called to format the contents of a drawer.
-The function must accept two parameters:
- NAME the drawer name, like \"PROPERTIES\"
- CONTENT the content of the drawer.
-You can check the export backend through `org-export-current-backend'.
-The function should return the text to be inserted into the buffer.
-If this is nil, `org-export-format-drawer' is used as a default.")
-
-(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers)
- "Remove drawers, or extract and format the content.
-ALL-DRAWERS is a list of all drawer names valid in the current buffer.
-EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers
-whose content to keep. Any drawers that are in ALL-DRAWERS but not in
-EXP-DRAWERS will be removed."
- (goto-char (point-min))
- (let ((re (concat "^[ \t]*:\\("
- (mapconcat 'identity all-drawers "\\|")
- "\\):[ \t]*$"))
- name beg beg-content eol content)
- (while (re-search-forward re nil t)
- (org-if-unprotected
- (setq name (match-string 1))
- (setq beg (match-beginning 0)
- beg-content (1+ (point-at-eol))
- eol (point-at-eol))
- (if (not (and (re-search-forward
- "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" nil t)
- (match-end 1)))
- (goto-char eol)
- (goto-char (match-beginning 0))
- (and (looking-at ".*\n?") (replace-match ""))
- (setq content (buffer-substring beg-content (point)))
- (delete-region beg (point))
- (when (or (eq exp-drawers t)
- (member name exp-drawers))
- (setq content (funcall (or org-export-format-drawer-function
- 'org-export-format-drawer)
- name content))
- (insert content)))))))
-
-(defun org-export-format-drawer (name content)
- "Format the content of a drawer as a colon example."
- (if (string-match "[ \t]+\\'" content)
- (setq content (substring content (match-beginning 0))))
- (while (string-match "\\`[ \t]*\n" content)
- (setq content (substring content (match-end 0))))
- (setq content (org-remove-indentation content))
- (setq content (concat ": " (mapconcat 'identity
- (org-split-string content "\n")
- "\n: ")
- "\n"))
- (setq content (concat " : " (upcase name) "\n" content))
- (org-add-props content nil 'org-protected t))
-
-(defun org-export-handle-export-tags (select-tags exclude-tags)
- "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS.
-Both arguments are lists of tags.
-If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG
-will be removed.
-After that, all subtrees that are marked by EXCLUDE-TAGS will be
-removed as well."
- (remove-text-properties (point-min) (point-max) '(:org-delete t))
- (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote
- select-tags "\\|")
- "\\):"))
- (re-excl (concat ":\\(" (mapconcat 'regexp-quote
- exclude-tags "\\|")
- "\\):"))
- beg end cont)
- (goto-char (point-min))
- (when (and select-tags
- (re-search-forward
- (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t))
- ;; At least one tree is marked for export, this means
- ;; all the unmarked stuff needs to go.
- ;; Dig out the trees that should be exported
- (goto-char (point-min))
- (outline-next-heading)
- (setq beg (point))
- (put-text-property beg (point-max) :org-delete t)
- (while (re-search-forward re-sel nil t)
- (when (org-at-heading-p)
- (org-back-to-heading)
- (remove-text-properties
- (max (1- (point)) (point-min))
- (setq cont (save-excursion (org-end-of-subtree t t)))
- '(:org-delete t))
- (while (and (org-up-heading-safe)
- (get-text-property (point) :org-delete))
- (remove-text-properties (max (1- (point)) (point-min))
- (point-at-eol) '(:org-delete t)))
- (goto-char cont))))
- ;; Remove the trees explicitly marked for noexport
- (when exclude-tags
- (goto-char (point-min))
- (while (re-search-forward re-excl nil t)
- (when (org-at-heading-p)
- (org-back-to-heading t)
- (setq beg (point))
- (org-end-of-subtree t t)
- (delete-region beg (point))
- (when (featurep 'org-inlinetask)
- (org-inlinetask-remove-END-maybe)))))
- ;; Remove everything that is now still marked for deletion
- (goto-char (point-min))
- (while (setq beg (text-property-any (point-min) (point-max) :org-delete t))
- (setq end (or (next-single-property-change beg :org-delete)
- (point-max)))
- (delete-region beg end))))
-
-(defun org-export-remove-tasks (keep)
- "Remove tasks depending on configuration.
-When KEEP is nil, remove all tasks.
-When KEEP is `todo', remove the tasks that are DONE.
-When KEEP is `done', remove the tasks that are not yet done.
-When it is a list of strings, keep only tasks with these TODO keywords."
- (when (or (listp keep) (memq keep '(todo done nil)))
- (let ((re (concat "^\\*+[ \t]+\\("
- (mapconcat
- 'regexp-quote
- (cond ((not keep) org-todo-keywords-1)
- ((eq keep 'todo) org-done-keywords)
- ((eq keep 'done) org-not-done-keywords)
- ((listp keep)
- (org-delete-all keep (copy-sequence
- org-todo-keywords-1))))
- "\\|")
- "\\)\\($\\|[ \t]\\)"))
- (case-fold-search nil)
- beg)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (org-if-unprotected
- (setq beg (match-beginning 0))
- (org-end-of-subtree t t)
- (if (looking-at "^\\*+[ \t]+END[ \t]*$")
- ;; Kill the END line of the inline task
- (goto-char (min (point-max) (1+ (match-end 0)))))
- (delete-region beg (point)))))))
-
-(defun org-export-remove-archived-trees (export-archived-trees)
- "Remove archived trees.
-When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported.
-When it is t, the entire archived tree will be exported.
-When it is nil the entire tree including the headline will be removed
-from the buffer."
- (let ((re-archive (concat ":" org-archive-tag ":"))
- a b)
- (when (not (eq export-archived-trees t))
- (goto-char (point-min))
- (while (re-search-forward re-archive nil t)
- (if (not (org-at-heading-p t))
- (goto-char (point-at-eol))
- (beginning-of-line 1)
- (setq a (if export-archived-trees
- (1+ (point-at-eol)) (point))
- b (org-end-of-subtree t))
- (if (> b a) (delete-region a b)))))))
-
-(defun org-export-remove-headline-metadata (opts)
- "Remove meta data from the headline, according to user options."
- (let ((re org-complex-heading-regexp)
- (todo (plist-get opts :todo-keywords))
- (tags (plist-get opts :tags))
- (pri (plist-get opts :priority))
- (elts '(1 2 3 4 5))
- (case-fold-search nil)
- rpl)
- (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5))))
- (when (or (not todo) (not tags) (not pri))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (org-if-unprotected
- (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) ""))
- elts " "))
- (replace-match rpl t t))))))
-
-(defun org-export-remove-timestamps ()
- "Remove timestamps and keywords for export."
- (goto-char (point-min))
- (while (re-search-forward org-maybe-keyword-time-regexp nil t)
- (backward-char 1)
- (org-if-unprotected
- (unless (save-match-data (org-at-table-p))
- (replace-match "")
- (beginning-of-line 1)
- (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n")
- (replace-match ""))))))
-
-(defun org-export-remove-clock-lines ()
- "Remove clock lines for export."
- (goto-char (point-min))
- (let ((re (concat "^[ \t]*" org-clock-string ".*\n?")))
- (while (re-search-forward re nil t)
- (org-if-unprotected
- (replace-match "")))))
-
-(defvar org-heading-keyword-regexp-format) ; defined in org.el
-(defun org-export-protect-quoted-subtrees ()
- "Mark quoted subtrees with the protection property."
- (let ((org-re-quote (format org-heading-keyword-regexp-format
- org-quote-string)))
- (goto-char (point-min))
- (while (re-search-forward org-re-quote nil t)
- (goto-char (match-beginning 0))
- (end-of-line 1)
- (add-text-properties (point) (org-end-of-subtree t)
- '(org-protected t)))))
-
-(defun org-export-convert-protected-spaces ()
- "Convert strings like \\____ to protected spaces in all backends."
- (goto-char (point-min))
- (while (re-search-forward "\\\\__+" nil t)
- (org-if-unprotected-1
- (replace-match
- (org-add-props
- (cond
- ((eq org-export-current-backend 'latex)
- (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0))))
- ((eq org-export-current-backend 'html)
- (org-add-props (match-string 0) nil
- 'org-whitespace (- (match-end 0) (match-beginning 0))))
- ;; ((eq org-export-current-backend 'docbook))
- ((eq org-export-current-backend 'ascii)
- (org-add-props (match-string 0) '(org-whitespace t)))
- (t (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
- '(org-protected t))
- t t))))
-
-(defun org-export-protect-verbatim ()
- "Mark verbatim snippets with the protection property."
- (goto-char (point-min))
- (while (re-search-forward org-verbatim-re nil t)
- (org-if-unprotected
- (add-text-properties (match-beginning 4) (match-end 4)
- '(org-protected t org-verbatim-emph t))
- (goto-char (1+ (match-end 4))))))
-
-(defun org-export-protect-colon-examples ()
- "Protect lines starting with a colon."
- (goto-char (point-min))
- (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg)
- (while (re-search-forward re nil t)
- (beginning-of-line 1)
- (setq beg (point))
- (while (looking-at re)
- (end-of-line 1)
- (or (eobp) (forward-char 1)))
- (add-text-properties beg (if (bolp) (1- (point)) (point))
- '(org-protected t)))))
-
-(defvar org-export-backends
- '(docbook html beamer ascii latex)
- "List of Org supported export backends.")
-
-(defun org-export-select-backend-specific-text ()
- (let ((formatters org-export-backends)
- (case-fold-search t)
- backend backend-name beg beg-content end end-content ind)
-
- (while formatters
- (setq backend (pop formatters)
- backend-name (symbol-name backend))
-
- ;; Handle #+BACKEND: stuff
- (goto-char (point-min))
- (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name
- ":[ \t]*\\(.*\\)") nil t)
- (if (not (eq backend org-export-current-backend))
- (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
- (let ((ind (get-text-property (point-at-bol) 'original-indentation)))
- (replace-match "\\1\\2" t)
- (add-text-properties
- (point-at-bol) (min (1+ (point-at-eol)) (point-max))
- `(org-protected t original-indentation ,ind org-native-text t)))))
- ;; Delete #+ATTR_BACKEND: stuff of another backend. Those
- ;; matching the current backend will be taken care of by
- ;; `org-export-attach-captions-and-attributes'
- (goto-char (point-min))
- (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name
- ":[ \t]*\\(.*\\)") nil t)
- (setq ind (org-get-indentation))
- (when (not (eq backend org-export-current-backend))
- (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
- ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff
- (goto-char (point-min))
- (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?")
- nil t)
- (setq beg (match-beginning 0) beg-content (match-end 0))
- (setq ind (or (get-text-property beg 'original-indentation)
- (save-excursion (goto-char beg) (org-get-indentation))))
- (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?")
- nil t)
- (setq end (match-end 0) end-content (match-beginning 0))
- (if (eq backend org-export-current-backend)
- ;; yes, keep this
- (progn
- (add-text-properties
- beg-content end-content
- `(org-protected t original-indentation ,ind org-native-text t))
- ;; strip protective commas
- (org-unescape-code-in-region beg-content end-content)
- (delete-region (match-beginning 0) (match-end 0))
- (save-excursion
- (goto-char beg)
- (delete-region (point) (1+ (point-at-eol)))))
- ;; No, this is for a different backend, kill it
- (delete-region beg end)))))))
-
-(defun org-export-mark-blockquote-verse-center ()
- "Mark block quote and verse environments with special cookies.
-These special cookies will later be interpreted by the backend."
- ;; Blockquotes
- (let (type t1 ind beg end beg1 end1 content)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)"
- nil t)
- (setq ind (length (match-string 1))
- type (downcase (match-string 3))
- t1 (if (equal type "quote") "blockquote" type))
- (setq beg (match-beginning 0)
- beg1 (1+ (match-end 0)))
- (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t)
- (setq end1 (1- (match-beginning 0))
- end (+ (point-at-eol) (if (looking-at "\n$") 1 0)))
- (setq content (org-remove-indentation (buffer-substring beg1 end1)))
- (setq content (concat "ORG-" (upcase t1) "-START\n"
- content "\n"
- "ORG-" (upcase t1) "-END\n"))
- (delete-region beg end)
- (insert (org-add-props content nil 'original-indentation ind))))))
-
-(defun org-export-mark-list-end ()
- "Mark all list endings with a special string."
- (unless (eq org-export-current-backend 'ascii)
- (mapc
- (lambda (e)
- ;; For each type allowing list export, find every list, remove
- ;; ending regexp if needed, and insert org-list-end.
- (goto-char (point-min))
- (while (re-search-forward (org-item-beginning-re) nil t)
- (when (eq (nth 2 (org-list-context)) e)
- (let* ((struct (org-list-struct))
- (bottom (org-list-get-bottom-point struct))
- (top (point-at-bol))
- (top-ind (org-list-get-ind top struct)))
- (goto-char bottom)
- (when (and (not (looking-at "[ \t]*$"))
- (looking-at org-list-end-re))
- (replace-match ""))
- (unless (bolp) (insert "\n"))
- ;; As org-list-end is inserted at column 0, it would end
- ;; by indentation any list. It can be problematic when
- ;; there are lists within lists: the inner list end would
- ;; also become the outer list end. To avoid this, text
- ;; property `original-indentation' is added, as
- ;; `org-list-struct' pays attention to it when reading a
- ;; list.
- (insert (org-add-props
- "ORG-LIST-END-MARKER\n"
- (list 'original-indentation top-ind)))))))
- (cons nil org-list-export-context))))
-
-(defun org-export-mark-list-properties ()
- "Mark list with special properties.
-These special properties will later be interpreted by the backend."
- (let ((mark-list
- (function
- ;; Mark a list with 3 properties: `list-item' which is
- ;; position at beginning of line, `list-struct' which is
- ;; list structure, and `list-prevs' which is the alist of
- ;; item and its predecessor. Leave point at list ending.
- (lambda (ctxt)
- (let* ((struct (org-list-struct))
- (top (org-list-get-top-point struct))
- (bottom (org-list-get-bottom-point struct))
- (prevs (org-list-prevs-alist struct))
- poi)
- ;; Get every item and ending position, without dups and
- ;; without bottom point of list.
- (mapc (lambda (e)
- (let ((pos (car e))
- (end (nth 6 e)))
- (unless (memq pos poi)
- (push pos poi))
- (unless (or (= end bottom) (memq end poi))
- (push end poi))))
- struct)
- (setq poi (sort poi '<))
- ;; For every point of interest, mark the whole line with
- ;; its position in list.
- (mapc
- (lambda (e)
- (goto-char e)
- (add-text-properties (point-at-bol) (point-at-eol)
- (list 'list-item (point-at-bol)
- 'list-struct struct
- 'list-prevs prevs)))
- poi)
- ;; Take care of bottom point. As babel may have inserted
- ;; a new list in buffer, list ending isn't always
- ;; marked. Now mark every list ending and add properties
- ;; useful to line processing exporters.
- (goto-char bottom)
- (when (or (looking-at "^ORG-LIST-END-MARKER\n")
- (and (not (looking-at "[ \t]*$"))
- (looking-at org-list-end-re)))
- (replace-match ""))
- (unless (bolp) (insert "\n"))
- (insert
- (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom
- 'list-struct struct
- 'list-prevs prevs)))
- ;; Following property is used by LaTeX exporter.
- (add-text-properties top (point) (list 'list-context ctxt)))))))
- ;; Mark lists except for backends not interpreting them.
- (unless (eq org-export-current-backend 'ascii)
- (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
- (mapc
- (lambda (e)
- (goto-char (point-min))
- (while (re-search-forward (org-item-beginning-re) nil t)
- (let ((context (nth 2 (org-list-context))))
- (if (eq context e)
- (funcall mark-list e)
- (put-text-property (point-at-bol) (point-at-eol)
- 'list-context context)))))
- (cons nil org-list-export-context))))))
-
-(defun org-export-attach-captions-and-attributes (target-alist)
- "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties.
-If the next thing following is a table, add the text properties to the first
-table line. If it is a link, add it to the line containing the link."
- (goto-char (point-min))
- (remove-text-properties (point-min) (point-max)
- '(org-caption nil org-attributes nil))
- (let ((case-fold-search t)
- (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)"
- "\\|"
- "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)"
- "\\|"
- "^[ \t]*#\\+label:[ \t]+\\(.*\\)"
- "\\|"
- "^[ \t]*\\(|[^-]\\)"
- "\\|"
- "^[ \t]*\\[\\[.*\\]\\][ \t]*$"))
- cap shortn attr label end)
- (while (re-search-forward re nil t)
- (cond
- ;; there is a caption
- ((match-end 1)
- (progn
- (setq cap (concat cap (if cap " " "") (org-trim (match-string 1))))
- (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap)
- (setq shortn (match-string 1 cap)
- cap (match-string 2 cap)))
- (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
- ;; there is an attribute
- ((match-end 2)
- (progn
- (setq attr (concat attr (if attr " " "") (org-trim (match-string 2))))
- (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
- ;; there is a label
- ((match-end 3)
- (progn
- (setq label (org-trim (match-string 3)))
- (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))))
- (t
- (setq end (if (match-end 4)
- (let ((ee (org-table-end)))
- (prog1 (1- (marker-position ee)) (move-marker ee nil)))
- (point-at-eol)))
- (add-text-properties (point-at-bol) end
- (list 'org-caption cap
- 'org-caption-shortn shortn
- 'org-attributes attr
- 'org-label label))
- (if label (push (cons label label) target-alist))
- (goto-char end)
- (setq cap nil shortn nil attr nil label nil)))))
- target-alist)
-
-(defun org-export-remove-comment-blocks-and-subtrees ()
- "Remove the comment environment, and also commented subtrees."
- (let ((re-commented (format org-heading-keyword-regexp-format
- org-comment-string))
- case-fold-search)
- ;; Remove comment environment
- (goto-char (point-min))
- (setq case-fold-search t)
- (while (re-search-forward
- "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t)
- (replace-match "" t t))
- ;; Remove subtrees that are commented
- (goto-char (point-min))
- (setq case-fold-search nil)
- (while (re-search-forward re-commented nil t)
- (goto-char (match-beginning 0))
- (delete-region (point) (org-end-of-subtree t)))))
-
-(defun org-export-handle-comments (org-commentsp)
- "Remove comments, or convert to backend-specific format.
-ORG-COMMENTSP can be a format string for publishing comments.
-When it is nil, all comments will be removed."
- (let ((re "^[ \t]*#\\( \\|$\\)"))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (let ((pos (match-beginning 0))
- (end (progn (forward-line) (point))))
- (if (get-text-property pos 'org-protected)
- (forward-line)
- (if (not org-commentsp) (delete-region pos end)
- (add-text-properties pos end '(org-protected t))
- (replace-match
- (org-add-props
- (format org-commentsp (buffer-substring (match-end 0) end))
- nil 'org-protected t)
- t t)))))
- ;; Hack attack: previous implementation also removed keywords at
- ;; column 0. Brainlessly do it again.
- (goto-char (point-min))
- (while (re-search-forward "^#\\+" nil t)
- (unless (get-text-property (point-at-bol) 'org-protected)
- (delete-region (point-at-bol) (progn (forward-line) (point)))))))
-
-(defun org-export-handle-metalines ()
- "Remove tables and source blocks metalines.
-This function should only be called after all block processing
-has taken place."
- (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)")
- (case-fold-search t)
- pos)
- (goto-char (point-min))
- (while (or (looking-at re)
- (re-search-forward re nil t))
- (setq pos (match-beginning 0))
- (if (get-text-property (match-beginning 1) 'org-protected)
- (goto-char (1+ pos))
- (goto-char (1+ pos))
- (replace-match "")
- (goto-char (max (point-min) (1- pos)))))))
-
-(defun org-export-mark-radio-links ()
- "Find all matches for radio targets and turn them into internal links."
- (let ((re-radio (and org-target-link-regexp
- (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)"))))
- (goto-char (point-min))
- (when re-radio
- (while (re-search-forward re-radio nil t)
- (unless
- (save-match-data
- (or (org-in-regexp org-bracket-link-regexp)
- (org-in-regexp org-plain-link-re)
- (org-in-regexp "<<[^<>]+>>")))
- (org-if-unprotected
- (replace-match "\\1[[\\2]]")))))))
-
-(defun org-store-forced-table-alignment ()
- "Find table lines which force alignment, store the results in properties."
- (let (line cnt cookies)
- (goto-char (point-min))
- (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|"
- nil t)
- ;; OK, this looks like a table line with an alignment cookie
- (org-if-unprotected
- (setq line (buffer-substring (point-at-bol) (point-at-eol)))
- (when (and (org-at-table-p)
- (org-table-cookie-line-p line))
- (setq cnt 0 cookies nil)
- (mapc
- (lambda (x)
- (setq cnt (1+ cnt))
- (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x)
- (let ((align (and (match-end 1)
- (downcase (match-string 1 x))))
- (width (and (match-end 2)
- (string-to-number (match-string 2 x)))))
- (push (cons cnt (list align width)) cookies))))
- (org-split-string line "[ \t]*|[ \t]*"))
- (add-text-properties (org-table-begin) (org-table-end)
- (list 'org-col-cookies cookies))))
- (goto-char (point-at-eol)))))
-
-(defun org-export-remove-special-table-lines ()
- "Remove tables lines that are used for internal purposes.
-Also, store forced alignment information found in such lines."
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*|" nil t)
- (org-if-unprotected-at (1- (point))
- (beginning-of-line 1)
- (if (or (looking-at "[ \t]*| *[!_^] *|")
- (not
- (memq
- nil
- (mapcar
- (lambda (f)
- (or (and org-export-table-remove-empty-lines (= (length f) 0))
- (string-match
- "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f)))
- (org-split-string ;; FIXME, can't we do without splitting???
- (buffer-substring (point-at-bol) (point-at-eol))
- "[ \t]*|[ \t]*")))))
- (delete-region (max (point-min) (1- (point-at-bol)))
- (point-at-eol))
- (end-of-line 1)))))
-
-(defun org-export-protect-sub-super (s)
- (save-match-data
- (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s)
- (setq s (replace-match "\\1\\\\\\2" nil nil s)))
- s))
-
-(defun org-export-normalize-links ()
- "Convert all links to bracket links, and expand link abbreviations."
- (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
- (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
- nodesc)
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t))
- (goto-char (point-min))
- (while (re-search-forward re-plain-link nil t)
- (unless (get-text-property (match-beginning 0) 'org-normalized-link)
- (goto-char (1- (match-end 0)))
- (org-if-unprotected-at (1+ (match-beginning 0))
- (let* ((s (concat (match-string 1)
- "[[" (match-string 2) ":" (match-string 3)
- "][" (match-string 2) ":" (org-export-protect-sub-super
- (match-string 3))
- "]]")))
- ;; added 'org-link face to links
- (put-text-property 0 (length s) 'face 'org-link s)
- (replace-match s t t)))))
- (goto-char (point-min))
- (while (re-search-forward re-angle-link nil t)
- (goto-char (1- (match-end 0)))
- (org-if-unprotected
- (let* ((s (concat (match-string 1)
- "[[" (match-string 2) ":" (match-string 3)
- "][" (match-string 2) ":" (org-export-protect-sub-super
- (match-string 3))
- "]]")))
- (put-text-property 0 (length s) 'face 'org-link s)
- (replace-match s t t))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (goto-char (1- (match-end 0)))
- (setq nodesc (not (match-end 3)))
- (org-if-unprotected
- (let* ((xx (save-match-data
- (org-translate-link
- (org-link-expand-abbrev (match-string 1)))))
- (s (concat
- "[[" (org-add-props (copy-sequence xx)
- nil 'org-protected t 'org-no-description nodesc)
- "]"
- (if (match-end 3)
- (match-string 2)
- (concat "[" (copy-sequence xx)
- "]"))
- "]")))
- (put-text-property 0 (length s) 'face 'org-link s)
- (replace-match s t t))))))
-
-(defun org-export-concatenate-multiline-links ()
- "Find multi-line links and put it all into a single line.
-This is to make sure that the line-processing export backends
-can work correctly."
- (goto-char (point-min))
- (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
- (org-if-unprotected-at (match-beginning 1)
- (replace-match "\\1 \\3")
- (goto-char (match-beginning 0)))))
-
-(defun org-export-concatenate-multiline-emphasis ()
- "Find multi-line emphasis and put it all into a single line.
-This is to make sure that the line-processing export backends
-can work correctly."
- (goto-char (point-min))
- (while (re-search-forward org-emph-re nil t)
- (if (and (not (= (char-after (match-beginning 3))
- (char-after (match-beginning 4))))
- (save-excursion (goto-char (match-beginning 0))
- (save-match-data
- (and (not (org-at-table-p))
- (not (org-at-heading-p))))))
- (org-if-unprotected
- (subst-char-in-region (match-beginning 0) (match-end 0)
- ?\n ?\ t)
- (goto-char (1- (match-end 0))))
- (goto-char (1+ (match-beginning 0))))))
-
-(defun org-export-grab-title-from-buffer ()
- "Get a title for the current document, from looking at the buffer."
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (let ((end (if (looking-at org-outline-regexp)
- (point)
- (save-excursion (outline-next-heading) (point)))))
- (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t)
- ;; Mark the line so that it will not be exported as normal text.
- (unless (org-in-block-p org-list-forbidden-blocks)
- (org-unmodified
- (add-text-properties (match-beginning 0) (match-end 0)
- (list :org-license-to-kill t))))
- ;; Return the title string
- (org-trim (match-string 0)))))))
-
-(defun org-export-get-title-from-subtree ()
- "Return subtree title and exclude it from export."
- (let ((rbeg (region-beginning)) (rend (region-end))
- (inhibit-read-only t)
- (tags (plist-get (org-infile-export-plist) :tags))
- title)
- (save-excursion
- (goto-char rbeg)
- (when (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))
- (when (plist-member org-export-opt-plist :tags)
- (setq tags (or (plist-get org-export-opt-plist :tags) tags)))
- ;; This is a subtree, we take the title from the first heading
- (goto-char rbeg)
- (looking-at org-todo-line-tags-regexp)
- (setq title (if (and (eq tags t) (match-string 4))
- (format "%s\t%s" (match-string 3) (match-string 4))
- (match-string 3)))
- (org-unmodified
- (add-text-properties (point) (1+ (point-at-eol))
- (list :org-license-to-kill t)))
- (setq title (or (org-entry-get nil "EXPORT_TITLE") title))))
- title))
-
-(defun org-solidify-link-text (s &optional alist)
- "Take link text and make a safe target out of it."
- (save-match-data
- (let* ((rtn
- (mapconcat
- 'identity
- (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-"))
- (a (assoc rtn alist)))
- (or (cdr a) rtn))))
-
-(defun org-get-min-level (lines &optional offset)
- "Get the minimum level in LINES."
- (let ((re "^\\(\\*+\\) ") l)
- (catch 'exit
- (while (setq l (pop lines))
- (if (string-match re l)
- (throw 'exit (org-tr-level (- (length (match-string 1 l))
- (or offset 0))))))
- 1)))
-
-;; Variable holding the vector with section numbers
-(defvar org-section-numbers (make-vector org-level-max 0))
-
-(defun org-init-section-numbers ()
- "Initialize the vector for the section numbers."
- (let* ((level -1)
- (numbers (nreverse (org-split-string "" "\\.")))
- (depth (1- (length org-section-numbers)))
- (i depth) number-string)
- (while (>= i 0)
- (if (> i level)
- (aset org-section-numbers i 0)
- (setq number-string (or (car numbers) "0"))
- (if (string-match "\\`[A-Z]\\'" number-string)
- (aset org-section-numbers i
- (- (string-to-char number-string) ?A -1))
- (aset org-section-numbers i (string-to-number number-string)))
- (pop numbers))
- (setq i (1- i)))))
-
-(defun org-section-number (&optional level)
- "Return a string with the current section number.
-When LEVEL is non-nil, increase section numbers on that level."
- (let* ((depth (1- (length org-section-numbers)))
- (string "")
- (fmts (car org-export-section-number-format))
- (term (cdr org-export-section-number-format))
- (sep "")
- ctype fmt idx n)
- (when level
- (when (> level -1)
- (aset org-section-numbers
- level (1+ (aref org-section-numbers level))))
- (setq idx (1+ level))
- (while (<= idx depth)
- (if (not (= idx 1))
- (aset org-section-numbers idx 0))
- (setq idx (1+ idx))))
- (setq idx 0)
- (while (<= idx depth)
- (when (> (aref org-section-numbers idx) 0)
- (setq fmt (or (pop fmts) fmt)
- ctype (car fmt)
- n (aref org-section-numbers idx)
- string (if (> n 0)
- (concat string sep (org-number-to-counter n ctype))
- (concat string ".0"))
- sep (nth 1 fmt)))
- (setq idx (1+ idx)))
- (save-match-data
- (if (string-match "\\`\\([@0]\\.\\)+" string)
- (setq string (replace-match "" t nil string)))
- (if (string-match "\\(\\.0\\)+\\'" string)
- (setq string (replace-match "" t nil string))))
- (concat string term)))
-
-(defun org-number-to-counter (n type)
- "Concert number N to a string counter, according to TYPE.
-TYPE must be a string, any of:
- 1 number
- A A,B,....
- a a,b,....
- I upper case roman numeral
- i lower case roman numeral"
- (cond
- ((equal type "1") (number-to-string n))
- ((equal type "A") (char-to-string (+ ?A n -1)))
- ((equal type "a") (char-to-string (+ ?a n -1)))
- ((equal type "I") (org-number-to-roman n))
- ((equal type "i") (downcase (org-number-to-roman n)))
- (t (error "Invalid counter type `%s'" type))))
-
-(defun org-number-to-roman (n)
- "Convert integer N into a roman numeral."
- (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
- ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
- ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV")
- ( 1 . "I")))
- (res ""))
- (if (<= n 0)
- (number-to-string n)
- (while roman
- (if (>= n (caar roman))
- (setq n (- n (caar roman))
- res (concat res (cdar roman)))
- (pop roman)))
- res)))
-
-;;; Macros
-
-(defun org-export-preprocess-apply-macros ()
- "Replace macro references."
- (goto-char (point-min))
- (let (sy val key args args2 ind-str s n)
- (while (re-search-forward
- "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- nil t)
- (unless (save-match-data (save-excursion
- (goto-char (point-at-bol))
- (looking-at "[ \t]*#\\+macro")))
- ;; Get macro name (KEY), arguments (ARGS), and indentation of
- ;; current line (IND-STR) as strings.
- (setq key (downcase (match-string 1))
- args (match-string 3)
- ind-str (save-match-data (save-excursion
- (beginning-of-line)
- (looking-at "^\\([ \t]*\\).*")
- (match-string 1))))
- ;; When macro is defined, retrieve replacement text in VAL,
- ;; and proceed with expansion.
- (when (setq val (or (plist-get org-export-opt-plist
- (intern (concat ":macro-" key)))
- (plist-get org-export-opt-plist
- (intern (concat ":" key)))))
- (save-match-data
- ;; If arguments are provided, first retrieve them properly
- ;; (in ARGS, as a list), then replace them in VAL.
- (when args
- (setq args (org-split-string args ",") args2 nil)
- (while args
- (while (string-match "\\\\\\'" (car args))
- ;; Repair bad splits.
- (setcar (cdr args) (concat (substring (car args) 0 -1)
- "," (nth 1 args)))
- (pop args))
- (push (pop args) args2))
- (setq args (mapcar 'org-trim (nreverse args2)))
- (setq s 0)
- (while (string-match "\\$\\([0-9]+\\)" val s)
- (setq s (1+ (match-beginning 0))
- n (string-to-number (match-string 1 val)))
- (and (>= (length args) n)
- (setq val (replace-match (nth (1- n) args) t t val)))))
- ;; VAL starts with "(eval": it is a sexp, `eval' it.
- (when (string-match "\\`(eval\\>" val)
- (setq val (eval (read val))))
- ;; Ensure VAL is a string (or nil) and that each new line
- ;; is indented as the first one.
- (setq val (and val
- (mapconcat 'identity
- (org-split-string
- (if (stringp val) val (format "%s" val))
- "\n")
- (concat "\n" ind-str)))))
- ;; Eventually do the replacement, if VAL isn't nil. Move
- ;; point at beginning of macro for recursive expansions.
- (when val
- (replace-match val t t)
- (goto-char (match-beginning 0))))))))
-
-(defun org-export-apply-macros-in-string (s)
- "Apply the macros in string S."
- (when s
- (with-temp-buffer
- (insert s)
- (org-export-preprocess-apply-macros)
- (buffer-string))))
-
-;;; Include files
-
-(defun org-export-handle-include-files ()
- "Include the contents of include files, with proper formatting."
- (let ((case-fold-search t)
- params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines)
- (goto-char (point-min))
- (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t)
- (setq params (read (concat "(" (match-string 1) ")"))
- prefix (org-get-and-remove-property 'params :prefix)
- prefix1 (org-get-and-remove-property 'params :prefix1)
- minlevel (org-get-and-remove-property 'params :minlevel)
- addlevel (org-get-and-remove-property 'params :addlevel)
- lines (org-get-and-remove-property 'params :lines)
- file (org-symname-or-string (pop params))
- markup (org-symname-or-string (pop params))
- lang (and (member markup '("src" "SRC"))
- (org-symname-or-string (pop params)))
- switches (mapconcat #'(lambda (x) (format "%s" x)) params " ")
- start nil end nil)
- (delete-region (match-beginning 0) (match-end 0))
- (setq currentlevel (or (org-current-level) 0))
- (if (or (not file)
- (not (file-exists-p file))
- (not (file-readable-p file)))
- (insert (format "CANNOT INCLUDE FILE %s" file))
- (setq all (cons file all))
- (when markup
- (if (equal (downcase markup) "src")
- (setq start (format "#+begin_src %s %s\n"
- (or lang "fundamental")
- (or switches ""))
- end "#+end_src")
- (setq start (format "#+begin_%s %s\n" markup switches)
- end (format "#+end_%s" markup))))
- (insert (or start ""))
- (insert (org-get-file-contents (expand-file-name file)
- prefix prefix1 markup currentlevel minlevel addlevel lines))
- (or (bolp) (newline))
- (insert (or end ""))))
- all))
-
-(defun org-export-handle-include-files-recurse ()
- "Recursively include files aborting on circular inclusion."
- (let ((now (list org-current-export-file)) all)
- (while now
- (setq all (append now all))
- (setq now (org-export-handle-include-files))
- (let ((intersection
- (delq nil
- (mapcar (lambda (el) (when (member el all) el)) now))))
- (when intersection
- (error "Recursive #+INCLUDE: %S" intersection))))))
-
-(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines)
- "Get the contents of FILE and return them as a string.
-If PREFIX is a string, prepend it to each line. If PREFIX1
-is a string, prepend it to the first line instead of PREFIX.
-If MARKUP, don't protect org-like lines, the exporter will
-take care of the block they are in. If ADDLEVEL is a number,
-demote included file to current heading level+ADDLEVEL.
-If LINES is a string specifying a range of lines,
-include only those lines."
- (if (stringp markup) (setq markup (downcase markup)))
- (with-temp-buffer
- (insert-file-contents file)
- (when lines
- (let* ((lines (split-string lines "-"))
- (lbeg (string-to-number (car lines)))
- (lend (string-to-number (cadr lines)))
- (beg (if (zerop lbeg) (point-min)
- (goto-char (point-min))
- (forward-line (1- lbeg))
- (point)))
- (end (if (zerop lend) (point-max)
- (goto-char (point-min))
- (forward-line (1- lend))
- (point))))
- (narrow-to-region beg end)))
- (when (or prefix prefix1)
- (goto-char (point-min))
- (while (not (eobp))
- (insert (or prefix1 prefix))
- (setq prefix1 "")
- (beginning-of-line 2)))
- (buffer-string)
- (when (member markup '("src" "example"))
- (goto-char (point-min))
- (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t)
- (goto-char (match-beginning 0))
- (insert ",")
- (end-of-line 1)))
- (when minlevel
- (dotimes (lvl minlevel)
- (org-map-region 'org-demote (point-min) (point-max))))
- (when addlevel
- (let ((inclevel (or (if (org-before-first-heading-p)
- (1- (and (outline-next-heading)
- (org-current-level)))
- (1- (org-current-level)))
- 0)))
- (dotimes (level (- (+ parentlevel addlevel) inclevel))
- (org-map-region 'org-demote (point-min) (point-max)))))
- (buffer-string)))
-
-(defun org-get-and-remove-property (listvar prop)
- "Check if the value of LISTVAR contains PROP as a property.
-If yes, return the value of that property (i.e. the element following
-in the list) and remove property and value from the list in LISTVAR."
- (let ((list (symbol-value listvar)) m v)
- (when (setq m (member prop list))
- (setq v (nth 1 m))
- (if (equal (car list) prop)
- (set listvar (cddr list))
- (setcdr (nthcdr (- (length list) (length m) 1) list)
- (cddr m))
- (set listvar list)))
- v))
-
-(defun org-symname-or-string (s)
- (if (symbolp s)
- (if s (symbol-name s) s)
- s))
-
-;;; Fontification and line numbers for code examples
-
-(defvar org-export-last-code-line-counter-value 0)
-
-(defun org-export-replace-src-segments-and-examples ()
- "Replace source code segments with special code for export."
- (setq org-export-last-code-line-counter-value 0)
- (let ((case-fold-search t)
- lang code trans opts indent caption)
- (goto-char (point-min))
- (while (re-search-forward
- "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)"
- nil t)
- (if (match-end 1)
- (if (not (match-string 4))
- (error "Source block missing language specification: %s"
- (let* ((body (match-string 6))
- (nothing (message "body:%s" body))
- (preview (or (and (string-match
- "^[ \t]*\\([^\n\r]*\\)" body)
- (match-string 1 body)) body)))
- (if (> (length preview) 35)
- (concat (substring preview 0 32) "...")
- preview)))
- ;; src segments
- (setq lang (match-string 4)
- opts (match-string 5)
- code (match-string 6)
- indent (length (match-string 2))
- caption (get-text-property 0 'org-caption (match-string 0))))
- (setq lang nil
- opts (match-string 9)
- code (match-string 10)
- indent (length (match-string 8))
- caption (get-text-property 0 'org-caption (match-string 0))))
-
- (setq trans (org-export-format-source-code-or-example
- lang code opts indent caption))
- (replace-match trans t t))))
-
-(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el
-(defvar org-export-latex-listings) ;; defined in org-latex.el
-(defvar org-export-latex-listings-langs) ;; defined in org-latex.el
-(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el
-(defvar org-export-latex-minted-langs) ;; defined in org-latex.el
-(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el
-(defvar org-export-latex-listings-options) ;; defined in org-latex.el
-(defvar org-export-latex-minted-options) ;; defined in org-latex.el
-
-(defun org-remove-formatting-on-newlines-in-region (beg end)
- "Remove formatting on newline characters."
- (interactive "r")
- (save-excursion
- (goto-char beg)
- (while (progn (end-of-line) (< (point) end))
- (put-text-property (point) (1+ (point)) 'face nil)
- (forward-char 1))))
-
-(defun org-export-format-source-code-or-example
- (lang code &optional opts indent caption)
- "Format CODE from language LANG and return it formatted for export.
-The CODE is marked up in `org-export-current-backend' format.
-
-Check if a function by name
-\"org-<backend>-format-source-code-or-example\" is bound. If yes,
-use it as the custom formatter. Otherwise, use the default
-formatter. Default formatters are provided for docbook, html,
-latex and ascii backends. For example, use
-`org-html-format-source-code-or-example' to provide a custom
-formatter for export to \"html\".
-
-If LANG is nil, do not add any fontification.
-OPTS contains formatting options, like `-n' for triggering numbering lines,
-and `+n' for continuing previous numbering.
-Code formatting according to language currently only works for HTML.
-Numbering lines works for all three major backends (html, latex, and ascii).
-INDENT was the original indentation of the block."
- (save-match-data
- (let* ((backend-name (symbol-name org-export-current-backend))
- (backend-formatter
- (intern (format "org-%s-format-source-code-or-example"
- backend-name)))
- (backend-feature (intern (concat "org-" backend-name)))
- (backend-formatter
- (and (require (intern (concat "org-" backend-name)) nil)
- (fboundp backend-formatter) backend-formatter))
- num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt)
- (setq opts (or opts "")
- num (string-match "[-+]n\\>" opts)
- cont (string-match "\\+n\\>" opts)
- rpllbl (string-match "-r\\>" opts)
- keepp (string-match "-k\\>" opts)
- textareap (string-match "-t\\>" opts)
- preserve-indentp (or org-src-preserve-indentation
- (string-match "-i\\>" opts))
- cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts)
- (string-to-number (match-string 1 opts))
- 80)
- rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts)
- (string-to-number (match-string 1 opts))
- (org-count-lines code))
- fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts)
- (match-string 1 opts)))
- (when (and textareap (eq org-export-current-backend 'html))
- ;; we cannot use numbering or highlighting.
- (setq num nil cont nil lang nil))
- (if keepp (setq rpllbl 'keep))
- (setq rtn (if preserve-indentp code (org-remove-indentation code)))
- (when (string-match "^," rtn)
- (setq rtn (with-temp-buffer
- (insert rtn)
- ;; Free up the protected lines
- (goto-char (point-min))
- (while (re-search-forward "^," nil t)
- (if (or (equal lang "org")
- (save-match-data
- (looking-at "\\([*#]\\|[ \t]*#\\+\\)")))
- (replace-match ""))
- (end-of-line 1))
- (buffer-string))))
- ;; Now backend-specific coding
- (setq rtn
- (cond
- (backend-formatter
- (funcall backend-formatter rtn lang caption textareap cols rows num
- cont rpllbl fmt))
- ((eq org-export-current-backend 'docbook)
- (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
- (concat "<programlisting><![CDATA["
- rtn
- "]]></programlisting>\n"))
- ((eq org-export-current-backend 'html)
- ;; We are exporting to HTML
- (when lang
- (if (featurep 'xemacs)
- (require 'htmlize)
- (require 'htmlize nil t))
- (when (not (fboundp 'htmlize-region-for-paste))
- ;; we do not have htmlize.el, or an old version of it
- (setq lang nil)
- (message
- "htmlize.el 1.34 or later is needed for source code formatting")))
-
- (if lang
- (let* ((lang-m (when lang
- (or (cdr (assoc lang org-src-lang-modes))
- lang)))
- (mode (and lang-m (intern
- (concat
- (if (symbolp lang-m)
- (symbol-name lang-m)
- lang-m)
- "-mode"))))
- (org-inhibit-startup t)
- (org-startup-folded nil))
- (setq rtn
- (with-temp-buffer
- (insert rtn)
- (if (functionp mode)
- (funcall mode)
- (fundamental-mode))
- (font-lock-fontify-buffer)
- ;; markup each line separately
- (org-remove-formatting-on-newlines-in-region (point-min) (point-max))
- (org-src-mode)
- (set-buffer-modified-p nil)
- (org-export-htmlize-region-for-paste
- (point-min) (point-max))))
- (if (string-match "<pre\\([^>]*\\)>\n*" rtn)
- (setq rtn
- (concat
- (if caption
- (concat
- "<div class=\"org-src-container\">"
- (format
- "<label class=\"org-src-name\">%s</label>"
- caption))
- "")
- (replace-match
- (format "<pre class=\"src src-%s\">\n" lang)
- t t rtn)
- (if caption "</div>" "")))))
- (if textareap
- (setq rtn (concat
- (format "<p>\n<textarea cols=\"%d\" rows=\"%d\">"
- cols rows)
- rtn "</textarea>\n</p>\n"))
- (with-temp-buffer
- (insert rtn)
- (goto-char (point-min))
- (while (re-search-forward "[<>&]" nil t)
- (replace-match (cdr (assq (char-before)
- '((?&."&amp;")(?<."&lt;")(?>."&gt;"))))
- t t))
- (setq rtn (buffer-string)))
- (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n"))))
- (unless textareap
- (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt)))
- (if (string-match "\\(\\`<[^>]*>\\)\n" rtn)
- (setq rtn (replace-match "\\1" t nil rtn)))
- rtn)
- ((eq org-export-current-backend 'latex)
- (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
- (cond
- ((and lang org-export-latex-listings)
- (let* ((make-option-string
- (lambda (pair)
- (concat (first pair)
- (if (> (length (second pair)) 0)
- (concat "=" (second pair))))))
- (lang-sym (intern lang))
- (minted-p (eq org-export-latex-listings 'minted))
- (listings-p (not minted-p))
- (backend-lang
- (or (cadr
- (assq
- lang-sym
- (cond
- (minted-p org-export-latex-minted-langs)
- (listings-p org-export-latex-listings-langs))))
- lang))
- (custom-environment
- (cadr
- (assq
- lang-sym
- org-export-latex-custom-lang-environments))))
- (concat
- (when (and listings-p (not custom-environment))
- (format
- "\\lstset{%s}\n"
- (mapconcat
- make-option-string
- (append org-export-latex-listings-options
- `(("language" ,backend-lang))) ",")))
- (when (and caption org-export-latex-listings-w-names)
- (format
- "\n%s $\\equiv$ \n"
- (replace-regexp-in-string "_" "\\\\_" caption)))
- (cond
- (custom-environment
- (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-environment rtn custom-environment))
- (listings-p
- (format "\\begin{%s}\n%s\\end{%s}"
- "lstlisting" rtn "lstlisting"))
- (minted-p
- (format
- "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
- (mapconcat make-option-string
- org-export-latex-minted-options ",")
- backend-lang rtn))))))
- (t (concat (car org-export-latex-verbatim-wrap)
- rtn (cdr org-export-latex-verbatim-wrap)))))
- ((eq org-export-current-backend 'ascii)
- ;; This is not HTML or LaTeX, so just make it an example.
- (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt))
- (concat caption "\n"
- (concat
- (mapconcat
- (lambda (l) (concat " " l))
- (org-split-string rtn "\n")
- "\n")
- "\n")))
- (t
- (error "Don't know how to markup source or example block in %s"
- (upcase backend-name)))))
- (setq rtn
- (concat
- "\n#+BEGIN_" backend-name "\n"
- (org-add-props rtn
- '(org-protected t org-example t org-native-text t))
- "\n#+END_" backend-name "\n"))
- (org-add-props rtn nil 'original-indentation indent))))
-
-(defun org-export-number-lines (text &optional skip1 skip2 number cont
- replace-labels label-format preprocess)
- "Apply line numbers to literal examples and handle code references.
-Handle user-specified options under info node `(org)Literal
-examples' and return the modified source block.
-
-TEXT contains the source or example block.
-
-SKIP1 and SKIP2 are the number of lines that are to be skipped at
-the beginning and end of TEXT. Use these to skip over
-backend-specific lines pre-pended or appended to the original
-source block.
-
-NUMBER is non-nil if the literal example specifies \"+n\" or
-\"-n\" switch. If NUMBER is non-nil add line numbers.
-
-CONT is non-nil if the literal example specifies \"+n\" switch.
-If CONT is nil, start numbering this block from 1. Otherwise
-continue numbering from the last numbered block.
-
-REPLACE-LABELS is dual-purpose.
-1. It controls the retention of labels in the exported block.
-2. It specifies in what manner the links (or references) to a
- labeled line be formatted.
-
-REPLACE-LABELS is the symbol `keep' if the literal example
-specifies \"-k\" option, is numeric if the literal example
-specifies \"-r\" option and is nil otherwise.
-
-Handle REPLACE-LABELS as below:
-- If nil, retain labels in the exported block and use
- user-provided labels for referencing the labeled lines.
-- If it is a number, remove labels in the exported block and use
- one of line numbers or labels for referencing labeled lines based
- on NUMBER option.
-- If it is a keep, retain labels in the exported block and use
- one of line numbers or labels for referencing labeled lines
- based on NUMBER option.
-
-LABEL-FORMAT is the value of \"-l\" switch associated with
-literal example. See `org-coderef-label-format'.
-
-PREPROCESS is intended for backend-agnostic handling of source
-block numbering. When non-nil do the following:
-- do not number the lines
-- always strip the labels from exported block
-- do not make the labeled line a target of an incoming link.
- Instead mark the labeled line with `org-coderef' property and
- store the label in it."
- (setq skip1 (or skip1 0) skip2 (or skip2 0))
- (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0))
- (with-temp-buffer
- (insert text)
- (goto-char (point-max))
- (skip-chars-backward " \t\n\r")
- (delete-region (point) (point-max))
- (beginning-of-line (- 1 skip2))
- (let* ((last (org-current-line))
- (n org-export-last-code-line-counter-value)
- (nmax (+ n (- last skip1)))
- (fmt (format "%%%dd: " (length (number-to-string nmax))))
- (fm
- (cond
- ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>"
- fmt))
- ((eq org-export-current-backend 'ascii) fmt)
- ((eq org-export-current-backend 'latex) fmt)
- ((eq org-export-current-backend 'docbook) fmt)
- (t "")))
- (label-format (or label-format org-coderef-label-format))
- (label-pre (if (string-match "%s" label-format)
- (substring label-format 0 (match-beginning 0))
- label-format))
- (label-post (if (string-match "%s" label-format)
- (substring label-format (match-end 0))
- ""))
- (lbl-re
- (concat
- ".*?\\S-.*?\\([ \t]*\\("
- (regexp-quote label-pre)
- "\\([-a-zA-Z0-9_ ]+\\)"
- (regexp-quote label-post)
- "\\)\\)"))
- ref)
-
- (org-goto-line (1+ skip1))
- (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax))
- (when number (incf n))
- (if (or preprocess (not number))
- (forward-char 1)
- (insert (format fm n)))
- (when (looking-at lbl-re)
- (setq ref (match-string 3))
- (cond ((numberp replace-labels)
- ;; remove labels; use numbers for references when lines
- ;; are numbered, use labels otherwise
- (delete-region (match-beginning 1) (match-end 1))
- (push (cons ref (if (> n 0) n ref)) org-export-code-refs))
- ((eq replace-labels 'keep)
- ;; don't remove labels; use numbers for references when
- ;; lines are numbered, use labels otherwise
- (goto-char (match-beginning 2))
- (delete-region (match-beginning 2) (match-end 2))
- (unless preprocess
- (insert "(" ref ")"))
- (push (cons ref (if (> n 0) n (concat "(" ref ")")))
- org-export-code-refs))
- (t
- ;; don't remove labels and don't use numbers for
- ;; references
- (goto-char (match-beginning 2))
- (delete-region (match-beginning 2) (match-end 2))
- (unless preprocess
- (insert "(" ref ")"))
- (push (cons ref (concat "(" ref ")")) org-export-code-refs)))
- (when (and (eq org-export-current-backend 'html) (not preprocess))
- (save-excursion
- (beginning-of-line 1)
- (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">"
- ref))
- (end-of-line 1)
- (insert "</span>")))
- (when preprocess
- (add-text-properties
- (point-at-bol) (point-at-eol) (list 'org-coderef ref)))))
- (setq org-export-last-code-line-counter-value n)
- (goto-char (point-max))
- (newline)
- (buffer-string))))
-
-(defun org-search-todo-below (line lines level)
- "Search the subtree below LINE for any TODO entries."
- (let ((rest (cdr (memq line lines)))
- (re org-todo-line-regexp)
- line lv todo)
- (catch 'exit
- (while (setq line (pop rest))
- (if (string-match re line)
- (progn
- (setq lv (- (match-end 1) (match-beginning 1))
- todo (and (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords))))
- ; TODO, not DONE
- (if (<= lv level) (throw 'exit nil))
- (if todo (throw 'exit t))))))))
-
-;;;###autoload
-(defun org-export-visible (type arg)
- "Create a copy of the visible part of the current buffer, and export it.
-The copy is created in a temporary buffer and removed after use.
-TYPE is the final key (as a string) that also selects the export command in
-the \\<org-mode-map>\\[org-export] export dispatcher.
-As a special case, if the you type SPC at the prompt, the temporary
-org-mode file will not be removed but presented to you so that you can
-continue to use it. The prefix arg ARG is passed through to the exporting
-command."
- (interactive
- (list (progn
- (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer")
- (read-char-exclusive))
- current-prefix-arg))
- (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R)))
- (error "Invalid export key"))
- (let* ((binding (cdr (assoc type
- '(
- (?a . org-export-as-ascii)
- (?A . org-export-as-ascii-to-buffer)
- (?n . org-export-as-latin1)
- (?N . org-export-as-latin1-to-buffer)
- (?u . org-export-as-utf8)
- (?U . org-export-as-utf8-to-buffer)
- (?\C-a . org-export-as-ascii)
- (?b . org-export-as-html-and-open)
- (?\C-b . org-export-as-html-and-open)
- (?h . org-export-as-html)
- (?H . org-export-as-html-to-buffer)
- (?R . org-export-region-as-html)
- (?D . org-export-as-docbook)
-
- (?l . org-export-as-latex)
- (?p . org-export-as-pdf)
- (?d . org-export-as-pdf-and-open)
- (?L . org-export-as-latex-to-buffer)
-
- (?x . org-export-as-xoxo)))))
- (keepp (equal type ?\ ))
- (file buffer-file-name)
- (buffer (get-buffer-create "*Org Export Visible*"))
- s e)
- ;; Need to hack the drawers here.
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward org-drawer-regexp nil t)
- (goto-char (match-beginning 1))
- (or (outline-invisible-p) (org-flag-drawer nil))))
- (with-current-buffer buffer (erase-buffer))
- (save-excursion
- (setq s (goto-char (point-min)))
- (while (not (= (point) (point-max)))
- (goto-char (org-find-invisible))
- (append-to-buffer buffer s (point))
- (setq s (goto-char (org-find-visible))))
- (org-cycle-hide-drawers 'all)
- (goto-char (point-min))
- (unless keepp
- ;; Copy all comment lines to the end, to make sure #+ settings are
- ;; still available for the second export step. Kind of a hack, but
- ;; does do the trick.
- (if (looking-at "#[^\r\n]*")
- (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0))))
- (when (re-search-forward "^\\*+[ \t]+" nil t)
- (while (re-search-backward "[\n\r]#[^\n\r]*" nil t)
- (append-to-buffer buffer (1+ (match-beginning 0))
- (min (point-max) (1+ (match-end 0)))))))
- (set-buffer buffer)
- (let ((buffer-file-name file)
- (org-inhibit-startup t))
- (org-mode)
- (show-all)
- (unless keepp (funcall binding arg))))
- (if (not keepp)
- (kill-buffer buffer)
- (switch-to-buffer-other-window buffer)
- (goto-char (point-min)))))
-
-(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el
-
-(defun org-export-string (string fmt &optional dir)
- "Export STRING to FMT using existing export facilities.
-During export STRING is saved to a temporary file whose location
-could vary. Optional argument DIR can be used to force the
-directory in which the temporary file is created during export
-which can be useful for resolving relative paths. Dir defaults
-to the value of `temporary-file-directory'."
- (let ((temporary-file-directory (or dir temporary-file-directory))
- (tmp-file (make-temp-file "org-")))
- (unwind-protect
- (with-temp-buffer
- (insert string)
- (write-file tmp-file)
- (org-load-modules-maybe)
- (unless org-local-vars
- (setq org-local-vars (org-get-local-variables)))
- (eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode'
- (list 'let org-local-vars
- (list (intern (format "org-export-as-%s" fmt))
- nil nil ''string t dir))))
- (delete-file tmp-file))))
-
-;;;###autoload
-(defun org-export-as-org (arg &optional ext-plist to-buffer body-only pub-dir)
- "Make a copy with not-exporting stuff removed.
-The purpose of this function is to provide a way to export the source
-Org file of a webpage in Org format, but with sensitive and/or irrelevant
-stuff removed. This command will remove the following:
-
-- archived trees (if the variable `org-export-with-archived-trees' is nil)
-- comment blocks and trees starting with the COMMENT keyword
-- only trees that are consistent with `org-export-select-tags'
- and `org-export-exclude-tags'.
-
-The only arguments that will be used are EXT-PLIST and PUB-DIR,
-all the others will be ignored (but are present so that the general
-mechanism to call publishing functions will work).
-
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When PUB-DIR is set, use this as the publishing
-directory."
- (interactive "P")
- (let* ((opt-plist (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist)))
- (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
- (filename (concat (file-name-as-directory
- (or pub-dir
- (org-export-directory :org opt-plist)))
- (file-name-sans-extension
- (file-name-nondirectory bfname))
- ".org"))
- (filename (and filename
- (if (equal (file-truename filename)
- (file-truename bfname))
- (concat (file-name-sans-extension filename)
- "-source."
- (file-name-extension filename))
- filename)))
- (backup-inhibited t)
- (buffer (find-file-noselect filename))
- (region (buffer-string))
- str-ret)
- (save-excursion
- (org-pop-to-buffer-same-window buffer)
- (erase-buffer)
- (insert region)
- (let ((org-inhibit-startup t)) (org-mode))
- (org-install-letbind)
-
- ;; Get rid of archived trees
- (org-export-remove-archived-trees (plist-get opt-plist :archived-trees))
-
- ;; Remove comment environment and comment subtrees
- (org-export-remove-comment-blocks-and-subtrees)
-
- ;; Get rid of excluded trees
- (org-export-handle-export-tags (plist-get opt-plist :select-tags)
- (plist-get opt-plist :exclude-tags))
-
- (when (or (plist-get opt-plist :plain-source)
- (not (or (plist-get opt-plist :plain-source)
- (plist-get opt-plist :htmlized-source))))
- ;; Either nothing special is requested (default call)
- ;; or the plain source is explicitly requested
- ;; so: save it
- (save-buffer))
- (when (plist-get opt-plist :htmlized-source)
- ;; Make the htmlized version
- (require 'htmlize)
- (require 'org-html)
- (font-lock-fontify-buffer)
- (let* ((htmlize-output-type 'css)
- (newbuf (htmlize-buffer)))
- (with-current-buffer newbuf
- (when org-export-htmlized-org-css-url
- (goto-char (point-min))
- (and (re-search-forward
- "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*"
- nil t)
- (replace-match
- (format
- "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
- org-export-htmlized-org-css-url)
- t t)))
- (write-file (concat filename ".html")))
- (kill-buffer newbuf)))
- (set-buffer-modified-p nil)
- (if (equal to-buffer 'string)
- (progn (setq str-ret (buffer-string))
- (kill-buffer (current-buffer))
- str-ret)
- (kill-buffer (current-buffer))))))
-
-(defvar org-archive-location) ;; gets loaded with the org-archive require.
-(defun org-get-current-options ()
- "Return a string with current options as keyword options.
-Does include HTML export options as well as TODO and CATEGORY stuff."
- (require 'org-archive)
- (format
- "#+TITLE: %s
-#+AUTHOR: %s
-#+EMAIL: %s
-#+DATE: %s
-#+DESCRIPTION:
-#+KEYWORDS:
-#+LANGUAGE: %s
-#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s
-#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s
-%s
-#+EXPORT_SELECT_TAGS: %s
-#+EXPORT_EXCLUDE_TAGS: %s
-#+LINK_UP: %s
-#+LINK_HOME: %s
-#+XSLT:
-#+CATEGORY: %s
-#+SEQ_TODO: %s
-#+TYP_TODO: %s
-#+PRIORITIES: %c %c %c
-#+DRAWERS: %s
-#+STARTUP: %s %s %s %s %s
-#+TAGS: %s
-#+FILETAGS: %s
-#+ARCHIVE: %s
-#+LINK: %s
-"
- (buffer-name) (user-full-name) user-mail-address
- (format-time-string (substring (car org-time-stamp-formats) 1 -1))
- org-export-default-language
- org-export-headline-levels
- org-export-with-section-numbers
- org-export-with-toc
- org-export-preserve-breaks
- org-export-html-expand
- org-export-with-fixed-width
- org-export-with-tables
- org-export-with-sub-superscripts
- org-export-with-special-strings
- org-export-with-footnotes
- org-export-with-emphasize
- org-export-with-timestamps
- org-export-with-TeX-macros
- org-export-with-LaTeX-fragments
- org-export-skip-text-before-1st-heading
- org-export-with-drawers
- org-export-with-todo-keywords
- org-export-with-priority
- org-export-with-tags
- (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "")
- (mapconcat 'identity org-export-select-tags " ")
- (mapconcat 'identity org-export-exclude-tags " ")
- org-export-html-link-up
- org-export-html-link-home
- (or (ignore-errors
- (file-name-sans-extension
- (file-name-nondirectory (buffer-file-name (buffer-base-buffer)))))
- "NOFILENAME")
- "TODO FEEDBACK VERIFY DONE"
- "Me Jason Marie DONE"
- org-highest-priority org-lowest-priority org-default-priority
- (mapconcat 'identity org-drawers " ")
- (cdr (assoc org-startup-folded
- '((nil . "showall") (t . "overview") (content . "content"))))
- (if org-odd-levels-only "odd" "oddeven")
- (if org-hide-leading-stars "hidestars" "showstars")
- (if org-startup-align-all-tables "align" "noalign")
- (cond ((eq org-log-done t) "logdone")
- ((equal org-log-done 'note) "lognotedone")
- ((not org-log-done) "nologdone"))
- (or (mapconcat (lambda (x)
- (cond
- ((equal :startgroup (car x)) "{")
- ((equal :endgroup (car x)) "}")
- ((equal :newline (car x)) "")
- ((cdr x) (format "%s(%c)" (car x) (cdr x)))
- (t (car x))))
- (or org-tag-alist (org-get-buffer-tags)) " ") "")
- (mapconcat 'identity org-file-tags " ")
- org-archive-location
- "org file:~/org/%s.org"))
-
-(defun org-insert-export-options-template ()
- "Insert into the buffer a template with information for exporting."
- (interactive)
- (if (not (bolp)) (newline))
- (let ((s (org-get-current-options)))
- (and (string-match "#\\+CATEGORY" s)
- (setq s (substring s 0 (match-beginning 0))))
- (insert s)))
-
-(defvar org-table-colgroup-info nil)
-
-(defun org-table-clean-before-export (lines &optional maybe-quoted)
- "Check if the table has a marking column.
-If yes remove the column and the special lines."
- (setq org-table-colgroup-info nil)
- (if (memq nil
- (mapcar
- (lambda (x) (or (string-match "^[ \t]*|-" x)
- (string-match
- (if maybe-quoted
- "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|"
- "^[ \t]*| *\\([\#!$*_^ /]\\) *|")
- x)))
- lines))
- ;; No special marking column
- (progn
- (setq org-table-clean-did-remove-column nil)
- (delq nil
- (mapcar
- (lambda (x)
- (cond
- ((org-table-colgroup-line-p x)
- ;; This line contains colgroup info, extract it
- ;; and then discard the line
- (setq org-table-colgroup-info
- (mapcar (lambda (x)
- (cond ((member x '("<" "&lt;")) :start)
- ((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)))
- (org-split-string x "[ \t]*|[ \t]*")))
- nil)
- ((org-table-cookie-line-p x)
- ;; This line contains formatting cookies, discard it
- nil)
- (t x)))
- lines)))
- ;; there is a special marking column
- (setq org-table-clean-did-remove-column t)
- (delq nil
- (mapcar
- (lambda (x)
- (cond
- ((org-table-colgroup-line-p x)
- ;; This line contains colgroup info, extract it
- ;; and then discard the line
- (setq org-table-colgroup-info
- (mapcar (lambda (x)
- (cond ((member x '("<" "&lt;")) :start)
- ((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)))
- (cdr (org-split-string x "[ \t]*|[ \t]*"))))
- nil)
- ((org-table-cookie-line-p x)
- ;; This line contains formatting cookies, discard it
- nil)
- ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x)
- ;; ignore this line
- nil)
- ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
- (string-match "^\\([ \t]*\\)|[^|]*|" x))
- ;; remove the first column
- (replace-match "\\1|" t nil x))))
- lines))))
-
-(defun org-export-cleanup-toc-line (s)
- "Remove tags and timestamps from lines going into the toc."
- (if (not s)
- "" ; Return a string when argument is nil
- (when (memq org-export-with-tags '(not-in-toc nil))
- (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s)
- (setq s (replace-match "" t t s))))
- (when org-export-remove-timestamps-from-toc
- (while (string-match org-maybe-keyword-time-regexp s)
- (setq s (replace-match "" t t s))))
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (match-string (if (match-end 3) 3 1) s)
- t t s)))
- (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s)
- (setq s (replace-match "" t t s)))
- s))
-
-
-(defun org-get-text-property-any (pos prop &optional object)
- (or (get-text-property pos prop object)
- (and (setq pos (next-single-property-change pos prop object))
- (get-text-property pos prop object))))
-
-(defun org-export-get-coderef-format (path desc)
- (save-match-data
- (if (and desc (string-match
- (regexp-quote (concat "(" path ")"))
- desc))
- (replace-match "%s" t t desc)
- (or desc "%s"))))
-
-(defun org-export-push-to-kill-ring (format)
- "Push buffer content to kill ring.
-The depends on the variable `org-export-copy-to-kill-ring'."
- (when org-export-copy-to-kill-ring
- (org-kill-new (buffer-string))
- (when (fboundp 'x-set-selection)
- (ignore-errors (x-set-selection 'PRIMARY (buffer-string)))
- (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string))))
- (message "%s export done, pushed to kill ring and clipboard" format)))
-
-(provide 'org-exp)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-exp.el ends here
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 606db0814c2..46936f4b66f 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -1,6 +1,6 @@
;;; org-faces.el --- Face definitions for Org-mode.
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -202,7 +202,7 @@ set the properties in the `org-column' face. For example, set
Under XEmacs, the rules are simpler, because the XEmacs version of
column view defines special faces for each outline level. See the file
-`org-colview-xemacs.el' for details."
+`org-colview-xemacs.el' in Org's contrib/ directory for details."
:group 'org-faces)
(defface org-column-title
@@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file
"Face for column display of entry properties."
:group 'org-faces)
-(when (fboundp 'set-face-attribute)
- ;; Make sure that a fixed-width face is used when we have a column table.
- (set-face-attribute 'org-column nil
- :height (face-attribute 'default :height)
- :family (face-attribute 'default :family)))
-
(defface org-agenda-column-dateline
(org-compatible-face 'org-column
'((t nil)))
@@ -264,7 +258,7 @@ column view defines special faces for each outline level. See the file
'((((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t)))
- "Face for links."
+ "Face for footnotes."
:group 'org-faces)
(defface org-ellipsis
@@ -394,6 +388,14 @@ determines if it is a foreground or a background color."
(string :tag "Color")
(sexp :tag "Face")))))
+(defface org-priority ;; originally copied from font-lock-string-face
+ (org-compatible-face 'font-lock-keyword-face
+ '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
+ (t (:italic t))))
+ "Face used for priority cookies."
+ :group 'org-faces)
+
(defcustom org-priority-faces nil
"Faces for specific Priorities.
This is a list of cons cells, with priority character in the car
@@ -685,25 +687,28 @@ month and 365.24 days for a year)."
(defface org-agenda-restriction-lock
(org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:background "yellow1"))
- (((class color) (min-colors 88) (background dark)) (:background "skyblue4"))
- (((class color) (min-colors 16) (background light)) (:background "yellow1"))
- (((class color) (min-colors 16) (background dark)) (:background "skyblue4"))
+ '((((class color) (min-colors 88) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
(((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
(t (:inverse-video t))))
"Face for showing the agenda restriction lock."
:group 'org-faces)
(defface org-agenda-filter-tags
- (org-compatible-face 'mode-line
- nil)
+ (org-compatible-face 'mode-line nil)
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
+(defface org-agenda-filter-regexp
+ (org-compatible-face 'mode-line nil)
+ "Face for regexp(s) in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
(defface org-agenda-filter-category
- (org-compatible-face 'mode-line
- nil)
- "Face for tag(s) in the mode-line when filtering the agenda."
+ (org-compatible-face 'mode-line nil)
+ "Face for categories(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-time-grid ;; originally copied from font-lock-variable-name-face
@@ -718,20 +723,17 @@ month and 365.24 days for a year)."
"Face used to show the current time in the time grid.")
(defface org-agenda-diary
- (org-compatible-face 'default
- nil)
+ (org-compatible-face 'default nil)
"Face used for agenda entries that come from the Emacs diary."
:group 'org-faces)
(defface org-agenda-calendar-event
- (org-compatible-face 'default
- nil)
+ (org-compatible-face 'default nil)
"Face used to show events and appointments in the agenda."
:group 'org-faces)
(defface org-agenda-calendar-sexp
- (org-compatible-face 'default
- nil)
+ (org-compatible-face 'default nil)
"Face used to show events computed from a S-expression."
:group 'org-faces)
@@ -757,7 +759,7 @@ level org-n-level-faces"
:version "24.1"
:type 'boolean)
-(defface org-latex-and-export-specials
+(defface org-latex-and-related
(let ((font (cond ((assq :inherit custom-face-attributes)
'(:inherit underline))
(t '(:underline t)))))
@@ -770,8 +772,24 @@ level org-n-level-faces"
(((class color) (background dark))
(:foreground "burlywood"))
(t (,@font))))
- "Face used to highlight math latex and other special exporter stuff."
- :group 'org-faces)
+ "Face used to highlight LaTeX data, entities and sub/superscript."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defface org-macro
+ (org-compatible-face 'org-latex-and-related nil)
+ "Face for macros."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defface org-tag-group
+ (org-compatible-face 'org-tag nil)
+ "Face for group tags."
+ :group 'org-faces
+ :version "24.4"
+ :package-version '(Org . "8.0"))
(org-copy-face 'mode-line 'org-mode-line-clock
"Face used for clock display in mode line.")
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index 05ead8f0279..ab3c61efdf3 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -1,6 +1,6 @@
;;; org-feed.el --- Add RSS feed items to Org files
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -690,7 +690,8 @@ formatted as a string, not the original XML data."
(xml-node-children content)))))
(t
(setq entry (plist-put entry :description
- (format "Unknown '%s' content." type)))))))
+ (format-message
+ "Unknown `%s' content." type)))))))
entry))
(provide 'org-feed)
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 4cde24bf57f..5d853e62bc1 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -1,6 +1,6 @@
;;; org-footnote.el --- Footnote support in Org and elsewhere
;;
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -42,8 +42,6 @@
(declare-function org-back-to-heading "org" (&optional invisible-ok))
(declare-function org-combine-plists "org" (&rest plists))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
-(declare-function org-export-preprocess-string "org-exp"
- (string &rest parameters))
(declare-function org-fill-paragraph "org" (&optional justify))
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-id-uuid "org-id" ())
@@ -87,7 +85,7 @@
"Regular expression matching the definition of a footnote.")
(defconst org-footnote-forbidden-blocks
- '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src")
+ '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src")
"Names of blocks where footnotes are not allowed.")
(defgroup org-footnote nil
@@ -96,15 +94,19 @@
:group 'org)
(defcustom org-footnote-section "Footnotes"
- "Outline heading containing footnote definitions before export.
-This can be nil, to place footnotes locally at the end of the current
-outline node. If can also be the name of a special outline heading
-under which footnotes should be put.
+ "Outline heading containing footnote definitions.
+
+This can be nil, to place footnotes locally at the end of the
+current outline node. If can also be the name of a special
+outline heading under which footnotes should be put.
+
This variable defines the place where Org puts the definition
-automatically, i.e. when creating the footnote, and when sorting the notes.
-However, by hand you may place definitions *anywhere*.
-If this is a string, during export, all subtrees starting with this
-heading will be removed after extracting footnote definitions."
+automatically, i.e. when creating the footnote, and when sorting
+the notes. However, by hand you may place definitions
+*anywhere*.
+
+If this is a string, during export, all subtrees starting with
+this heading will be ignored."
:group 'org-footnote
:type '(choice
(string :tag "Collect footnotes under heading")
@@ -136,13 +138,13 @@ will be used to define the footnote at the reference position."
"Non-nil means define automatically new labels for footnotes.
Possible values are:
-nil prompt the user for each label
-t create unique labels of the form [fn:1], [fn:2], ...
-confirm like t, but let the user edit the created value. In particular,
- the label can be removed from the minibuffer, to create
+nil Prompt the user for each label.
+t Create unique labels of the form [fn:1], [fn:2], etc.
+confirm Like t, but let the user edit the created value.
+ The label can be removed from the minibuffer to create
an anonymous footnote.
random Automatically generate a unique, random label.
-plain Automatically create plain number labels like [1]"
+plain Automatically create plain number labels like [1]."
:group 'org-footnote
:type '(choice
(const :tag "Prompt for label" nil)
@@ -164,6 +166,7 @@ The main values of this variable can be set with in-buffer options:
#+STARTUP: nofnadjust"
:group 'org-footnote
:type '(choice
+ (const :tag "No adjustment" nil)
(const :tag "Renumber" renumber)
(const :tag "Sort" sort)
(const :tag "Renumber and Sort" t)))
@@ -182,8 +185,6 @@ extracted will be filled again."
(not (or (org-in-commented-line)
(org-in-indented-comment-line)
(org-inside-LaTeX-fragment-p)
- ;; Avoid protected environments (LaTeX export)
- (get-text-property (point) 'org-protected)
;; Avoid literal example.
(org-in-verbatim-emphasis)
(save-excursion
@@ -230,13 +231,7 @@ positions, and the definition, when inlined."
(org-in-regexp org-bracket-link-regexp))))
(and linkp (< (point) (cdr linkp))))))
;; Verify point doesn't belong to a LaTeX macro.
- ;; Beware though, when two footnotes are side by
- ;; side, once the first one is changed into LaTeX,
- ;; the second one might then be considered as an
- ;; optional argument of the command. Thus, check
- ;; the `org-protected' property of that command.
- (or (not (org-inside-latex-macro-p))
- (get-text-property (1- beg) 'org-protected)))
+ (not (org-inside-latex-macro-p)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
(and (or (not label) (match-string 1))
@@ -248,7 +243,7 @@ positions, and the definition, when inlined."
This matches only pure definitions like [1] or [fn:name] at the
beginning of a line. It does not match references like
-\[fn:name:definition], where the footnote text is included and
+[fn:name:definition], where the footnote text is included and
defined locally.
The return value will be nil if not at a footnote definition, and
@@ -257,11 +252,12 @@ otherwise."
(when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p))
(save-excursion
(end-of-line)
- ;; Footnotes definitions are separated by new headlines or blank
- ;; lines.
- (let ((lim (save-excursion (re-search-backward
- (concat org-outline-regexp-bol
- "\\|^[ \t]*$") nil t))))
+ ;; Footnotes definitions are separated by new headlines, another
+ ;; footnote definition or 2 blank lines.
+ (let ((lim (save-excursion
+ (re-search-backward
+ (concat org-outline-regexp-bol
+ "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
(let ((label (org-match-string-no-properties 1))
(beg (match-beginning 0))
@@ -277,7 +273,7 @@ otherwise."
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") bound 'move))
+ "^\\([ \t]*\n\\)\\{2,\\}") bound 'move))
(match-beginning 0)
(point)))))
(list label beg end
@@ -602,38 +598,15 @@ With prefix arg SPECIAL, offer additional commands in a menu."
(org-footnote-goto-previous-reference (car tmp)))
(t (org-footnote-new)))))
-(defvar org-footnote-insert-pos-for-preprocessor 'point-max
- "See `org-footnote-normalize'.")
-
-(defvar org-export-footnotes-seen) ; silence byte-compiler
-(defvar org-export-footnotes-data) ; silence byte-compiler
-
;;;###autoload
-(defun org-footnote-normalize (&optional sort-only export-props)
+(defun org-footnote-normalize (&optional sort-only)
"Collect the footnotes in various formats and normalize them.
This finds the different sorts of footnotes allowed in Org, and
-normalizes them to the usual [N] format that is understood by the
-Org-mode exporters.
+normalizes them to the usual [N] format.
When SORT-ONLY is set, only sort the footnote definitions into the
-referenced sequence.
-
-If Org is amidst an export process, EXPORT-PROPS will hold the
-export properties of the buffer.
-
-When EXPORT-PROPS is non-nil, the default action is to insert
-normalized footnotes towards the end of the pre-processing
-buffer. Some exporters (docbook, odt...) expect footnote
-definitions to be available before any references to them. Such
-exporters can let bind `org-footnote-insert-pos-for-preprocessor'
-to symbol `point-min' to achieve the desired behaviour.
-
-Additional note on `org-footnote-insert-pos-for-preprocessor':
-1. This variable has not effect when FOR-PREPROCESSOR is nil.
-2. This variable (potentially) obviates the need for extra scan
- of pre-processor buffer as witnessed in
- `org-export-docbook-get-footnotes'."
+referenced sequence."
;; This is based on Paul's function, but rewritten.
;;
;; Re-create `org-with-limited-levels', but not limited to Org
@@ -643,17 +616,12 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
org-inlinetask-min-level
(1- org-inlinetask-min-level)))
(nstars (and limit-level
- (if org-odd-levels-only
- (and limit-level (1- (* limit-level 2)))
+ (if org-odd-levels-only (1- (* limit-level 2))
limit-level)))
(org-outline-regexp
(concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
- ;; Determine the highest marker used so far.
- (ref-table (when export-props org-export-footnotes-seen))
- (count (if (and export-props ref-table)
- (apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table))
- 0))
- ins-point ref)
+ (count 0)
+ ins-point ref ref-table)
(save-excursion
;; 1. Find every footnote reference, extract the definition, and
;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
@@ -675,15 +643,10 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; Replace footnote reference with [MARKER]. Maybe fill
;; paragraph once done. If SORT-ONLY is non-nil, only move
;; to the end of reference found to avoid matching it twice.
- ;; If EXPORT-PROPS isn't nil, also add `org-footnote'
- ;; property to it, so it can be easily recognized by
- ;; exporters.
(if sort-only (goto-char (nth 2 ref))
(delete-region (nth 1 ref) (nth 2 ref))
(goto-char (nth 1 ref))
- (let ((new-ref (format "[%d]" marker)))
- (when export-props (org-add-props new-ref '(org-footnote t)))
- (insert new-ref))
+ (insert (format "[%d]" marker))
(and inlinep
org-footnote-fill-after-inline-note-extraction
(org-fill-paragraph)))
@@ -691,22 +654,9 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; type (INLINEP) and position (POS) to REF-TABLE if data
;; was unknown.
(unless a
- (let ((def (or (nth 3 ref) ; inline
- (and export-props
- (cdr (assoc lbl org-export-footnotes-data)))
+ (let ((def (or (nth 3 ref) ; Inline definition.
(nth 3 (org-footnote-get-definition lbl)))))
- (push (list lbl marker
- ;; When exporting, each definition goes
- ;; through `org-export-preprocess-string' so
- ;; it is ready to insert in the
- ;; backend-specific buffer.
- (if (and export-props def)
- (let ((parameters
- (org-combine-plists
- export-props
- '(:todo-keywords t :tags t :priority t))))
- (apply #'org-export-preprocess-string def parameters))
- def)
+ (push (list lbl marker def
;; Reference beginning position is a marker
;; to preserve it during further buffer
;; modifications.
@@ -728,14 +678,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(unless (bolp) (newline)))
;; No footnote section set: Footnotes will be added at the end
;; of the section containing their first reference.
- ;; Nevertheless, in an export situation, set insertion point to
- ;; `point-max' by default.
- ((derived-mode-p 'org-mode)
- (when export-props
- (goto-char (point-max))
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (delete-region (point) (point-max))))
+ ((derived-mode-p 'org-mode))
(t
;; Remove any left-over tag in the buffer, if one is set up.
(when org-footnote-tag-for-non-org-mode-files
@@ -753,14 +696,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(re-search-backward message-signature-separator nil t))
(beginning-of-line)
(goto-char (point-max)))))
- ;; During export, `org-footnote-insert-pos-for-preprocessor' has
- ;; precedence over previously found position.
- (setq ins-point
- (copy-marker
- (if (and export-props
- (eq org-footnote-insert-pos-for-preprocessor 'point-min))
- (point-min)
- (point))))
+ (setq ins-point (point-marker))
;; 3. Clean-up REF-TABLE.
(setq ref-table
(delq nil
@@ -791,26 +727,22 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
;; No footnote: exit.
((not ref-table))
;; Cases when footnotes should be inserted in one place.
- ((or (not (derived-mode-p 'org-mode))
- org-footnote-section
- export-props)
+ ((or (not (derived-mode-p 'org-mode)) org-footnote-section)
;; Insert again the section title, if any. Ensure that title,
;; or the subsequent footnotes, will be separated by a blank
;; lines from the rest of the document. In an Org buffer,
;; separate section with a blank line, unless explicitly
;; stated in `org-blank-before-new-entry'.
- (cond
- ((not (derived-mode-p 'org-mode))
- (skip-chars-backward " \t\n\r")
- (delete-region (point) ins-point)
- (unless (bolp) (newline))
- (when org-footnote-tag-for-non-org-mode-files
- (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
- ((and org-footnote-section (not export-props))
+ (if (not (derived-mode-p 'org-mode))
+ (progn (skip-chars-backward " \t\n\r")
+ (delete-region (point) ins-point)
+ (unless (bolp) (newline))
+ (when org-footnote-tag-for-non-org-mode-files
+ (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
(when (and (cdr (assq 'heading org-blank-before-new-entry))
(zerop (save-excursion (org-back-over-empty-lines))))
(insert "\n"))
- (insert "* " org-footnote-section "\n")))
+ (insert "* " org-footnote-section "\n"))
(set-marker ins-point nil)
;; Insert the footnotes, separated by a blank line.
(insert
@@ -820,10 +752,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor':
(set-marker (nth 4 x) nil)
(format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x)))
ref-table "\n"))
- (unless (eobp) (insert "\n\n"))
- ;; When exporting, add newly inserted markers along with their
- ;; associated definition to `org-export-footnotes-seen'.
- (when export-props (setq org-export-footnotes-seen ref-table)))
+ (unless (eobp) (insert "\n\n")))
;; Each footnote definition has to be inserted at the end of
;; the section where its first reference belongs.
(t
diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el
deleted file mode 100644
index 2ee58501ca1..00000000000
--- a/lisp/org/org-freemind.el
+++ /dev/null
@@ -1,1227 +0,0 @@
-;;; org-freemind.el --- Export Org files to freemind
-
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
-
-;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-
-;; --------------------------------------------------------------------
-;; Features that might be required by this library:
-;;
-;; `backquote', `bytecomp', `cl', `easymenu', `font-lock',
-;; `noutline', `org', `org-compat', `org-faces', `org-footnote',
-;; `org-list', `org-macs', `org-src', `outline', `syntax',
-;; `time-date', `xml'.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This file tries to implement some functions useful for
-;; transformation between org-mode and FreeMind files.
-;;
-;; Here are the commands you can use:
-;;
-;; M-x `org-freemind-from-org-mode'
-;; M-x `org-freemind-from-org-mode-node'
-;; M-x `org-freemind-from-org-sparse-tree'
-;;
-;; M-x `org-freemind-to-org-mode'
-;;
-;; M-x `org-freemind-show'
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Change log:
-;;
-;; 2009-02-15: Added check for next level=current+1
-;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'.
-;; 2009-10-25: Added support for `org-odd-levels-only'.
-;; Added y/n question before showing in FreeMind.
-;; 2009-11-04: Added support for #+BEGIN_HTML.
-;;
-;;; Code:
-
-(require 'xml)
-(require 'org)
- ;(require 'rx)
-(require 'org-exp)
-(eval-when-compile (require 'cl))
-
-(defgroup org-freemind nil
- "Customization group for org-freemind export/import."
- :group 'org)
-
-;; Fix-me: I am not sure these are useful:
-;;
-;; (defcustom org-freemind-main-fgcolor "black"
-;; "Color of main node's text."
-;; :type 'color
-;; :group 'org-freemind)
-
-;; (defcustom org-freemind-main-color "black"
-;; "Background color of main node."
-;; :type 'color
-;; :group 'org-freemind)
-
-;; (defcustom org-freemind-child-fgcolor "black"
-;; "Color of child nodes' text."
-;; :type 'color
-;; :group 'org-freemind)
-
-;; (defcustom org-freemind-child-color "black"
-;; "Background color of child nodes."
-;; :type 'color
-;; :group 'org-freemind)
-
-(defvar org-freemind-node-style nil "Internal use.")
-
-(defcustom org-freemind-node-styles nil
- "Styles to apply to node.
-NOT READY YET."
- :type '(repeat
- (list :tag "Node styles for file"
- (regexp :tag "File name")
- (repeat
- (list :tag "Node"
- (regexp :tag "Node name regexp")
- (set :tag "Node properties"
- (list :format "%v" (const :format "" node-style)
- (choice :tag "Style"
- :value bubble
- (const bubble)
- (const fork)))
- (list :format "%v" (const :format "" color)
- (color :tag "Color" :value "red"))
- (list :format "%v" (const :format "" background-color)
- (color :tag "Background color" :value "yellow"))
- (list :format "%v" (const :format "" edge-color)
- (color :tag "Edge color" :value "green"))
- (list :format "%v" (const :format "" edge-style)
- (choice :tag "Edge style" :value bezier
- (const :tag "Linear" linear)
- (const :tag "Bezier" bezier)
- (const :tag "Sharp Linear" sharp-linear)
- (const :tag "Sharp Bezier" sharp-bezier)))
- (list :format "%v" (const :format "" edge-width)
- (choice :tag "Edge width" :value thin
- (const :tag "Parent" parent)
- (const :tag "Thin" thin)
- (const 1)
- (const 2)
- (const 4)
- (const 8)))
- (list :format "%v" (const :format "" italic)
- (const :tag "Italic font" t))
- (list :format "%v" (const :format "" bold)
- (const :tag "Bold font" t))
- (list :format "%v" (const :format "" font-name)
- (string :tag "Font name" :value "SansSerif"))
- (list :format "%v" (const :format "" font-size)
- (integer :tag "Font size" :value 12)))))))
- :group 'org-freemind)
-
-;;;###autoload
-(defun org-export-as-freemind (&optional hidden ext-plist
- to-buffer body-only pub-dir)
- "Export the current buffer as a Freemind file.
-If there is an active region, export only the region. HIDDEN is
-obsolete and does nothing. EXT-PLIST is a property list with
-external parameters overriding org-mode's default settings, but
-still inferior to file-local settings. When TO-BUFFER is
-non-nil, create a buffer with that name and export to that
-buffer. If TO-BUFFER is the symbol `string', don't leave any
-buffer behind but just return the resulting HTML as a string.
-When BODY-ONLY is set, don't produce the file header and footer,
-simply return the content of the document (all top level
-sections). When PUB-DIR is set, use this as the publishing
-directory.
-
-See `org-freemind-from-org-mode' for more information."
- (interactive "P")
- (let* ((opt-plist (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist)))
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer))))
- (filename (concat (file-name-as-directory
- (or pub-dir
- (org-export-directory :ascii opt-plist)))
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory bfname)))
- ".mm")))
- (when (file-exists-p filename)
- (delete-file filename))
- (cond
- (subtree-p
- (org-freemind-from-org-mode-node (line-number-at-pos rbeg)
- filename))
- (t (org-freemind-from-org-mode bfname filename)))))
-
-;;;###autoload
-(defun org-freemind-show (mm-file)
- "Show file MM-FILE in Freemind."
- (interactive
- (list
- (save-match-data
- (let ((name (read-file-name "FreeMind file: "
- nil nil nil
- (if (buffer-file-name)
- (let* ((name-ext (file-name-nondirectory (buffer-file-name)))
- (name (file-name-sans-extension name-ext))
- (ext (file-name-extension name-ext)))
- (cond
- ((string= "mm" ext)
- name-ext)
- ((string= "org" ext)
- (let ((name-mm (concat name ".mm")))
- (if (file-exists-p name-mm)
- name-mm
- (message "Not exported to Freemind format yet")
- "")))
- (t
- "")))
- "")
- ;; Fix-me: Is this an Emacs bug?
- ;; This predicate function is never
- ;; called.
- (lambda (fn)
- (string-match "^mm$" (file-name-extension fn))))))
- (setq name (expand-file-name name))
- name))))
- (org-open-file mm-file))
-
-(defconst org-freemind-org-nfix "--org-mode: ")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Format converters
-
-(defun org-freemind-escape-str-from-org (org-str)
- "Do some html-escaping of ORG-STR and return the result.
-The characters \"&<> will be escaped."
- (let ((chars (append org-str nil))
- (fm-str ""))
- (dolist (cc chars)
- (setq fm-str
- (concat fm-str
- (if (< cc 160)
- (cond
- ((= cc ?\") "&quot;")
- ((= cc ?\&) "&amp;")
- ((= cc ?\<) "&lt;")
- ((= cc ?\>) "&gt;")
- (t (char-to-string cc)))
- ;; Formatting as &#number; is maybe needed
- ;; according to a bug report from kazuo
- ;; fujimoto, but I have now instead added a xml
- ;; processing instruction saying that the mm
- ;; file is utf-8:
- ;;
- ;; (format "&#x%x;" (- cc ;; ?\x800))
- (format "&#x%x;" (encode-char cc 'ucs))
- ))))
- fm-str))
-
-;;(org-freemind-unescape-str-to-org "&#x6d;A&#x224C;B&lt;C&#x3C;&#x3D;")
-;;(org-freemind-unescape-str-to-org "&#x3C;&lt;")
-(defun org-freemind-unescape-str-to-org (fm-str)
- "Do some html-unescaping of FM-STR and return the result.
-This is the opposite of `org-freemind-escape-str-from-org' but it
-will also unescape &#nn;."
- (let ((org-str fm-str))
- (setq org-str (replace-regexp-in-string "&quot;" "\"" org-str))
- (setq org-str (replace-regexp-in-string "&amp;" "&" org-str))
- (setq org-str (replace-regexp-in-string "&lt;" "<" org-str))
- (setq org-str (replace-regexp-in-string "&gt;" ">" org-str))
- (setq org-str (replace-regexp-in-string
- "&#x\\([a-f0-9]\\{2,4\\}\\);"
- (lambda (m)
- (char-to-string
- (+ (string-to-number (match-string 1 m) 16)
- 0 ;?\x800 ;; What is this for? Encoding?
- )))
- org-str))))
-
-;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ")
-;; (str2 (org-freemind-escape-str-from-org str1))
-;; (str3 (org-freemind-unescape-str-to-org str2)))
-;; (unless (string= str1 str3)
-;; (error "Error str3=%s" str3)))
-
-(defun org-freemind-convert-links-helper (matched)
- "Helper for `org-freemind-convert-links-from-org'.
-MATCHED is the link just matched."
- (let* ((link (match-string 1 matched))
- (text (match-string 2 matched))
- (ext (file-name-extension link))
- (col-pos (org-string-match-p ":" link))
- (is-img (and (image-type-from-file-name link)
- (let ((url-type (substring link 0 col-pos)))
- (member url-type '("file" "http" "https")))))
- )
- (if is-img
- ;; Fix-me: I can't find a way to get the border to "shrink
- ;; wrap" around the image using <div>.
- ;;
- ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">"
- ;; "<img src=\"" link "\" alt=\"" text "\" />"
- ;; "<br />"
- ;; "<i>" text "</i>"
- ;; "</div>")
- (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>"
- "<img src=\"" link "\" alt=\"" text "\" />"
- "<br />"
- "<i>" text "</i>"
- "</td></tr></table>")
- (concat "<a href=\"" link "\">" text "</a>"))))
-
-(defun org-freemind-convert-links-from-org (org-str)
- "Convert org links in ORG-STR to freemind links and return the result."
- (let ((fm-str (replace-regexp-in-string
- ;;(rx (not (any "[\""))
- ;; (submatch
- ;; "http"
- ;; (opt ?\s)
- ;; "://"
- ;; (1+
- ;; (any "-%.?@a-zA-Z0-9()_/:~=&#"))))
- "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)"
- "[[\\1][\\1]]"
- org-str
- nil ;; fixedcase
- nil ;; literal
- 1 ;; subexp
- )))
- (replace-regexp-in-string
- ;;(rx "[["
- ;; (submatch (*? nonl))
- ;; "]["
- ;; (submatch (*? nonl))
- ;; "]]")
- "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]"
- ;;"<a href=\"\\1\">\\2</a>"
- 'org-freemind-convert-links-helper
- fm-str t t)))
-
-;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>")
-(defun org-freemind-convert-links-to-org (fm-str)
- "Convert freemind links in FM-STR to org links and return the result."
- (let ((org-str (replace-regexp-in-string
- ;;(rx "<a"
- ;; space
- ;; (0+
- ;; (0+ (not (any ">")))
- ;; space)
- ;; "href=\""
- ;; (submatch (0+ (not (any "\""))))
- ;; "\""
- ;; (0+ (not (any ">")))
- ;; ">"
- ;; (submatch (0+ (not (any "<"))))
- ;; "</a>")
- "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>"
- "[[\\1][\\2]]"
- fm-str)))
- org-str))
-
-;; Fix-me:
-;;(defun org-freemind-convert-drawers-from-org (text)
-;; )
-
-;; (let* ((str1 "[[http://www.somewhere/][link-text]")
-;; (str2 (org-freemind-convert-links-from-org str1))
-;; (str3 (org-freemind-convert-links-to-org str2)))
-;; (unless (string= str1 str3)
-;; (error "Error str3=%s" str3)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Org => FreeMind
-
-(defvar org-freemind-bol-helper-base-indent nil)
-
-(defun org-freemind-bol-helper (matched)
- "Helper for `org-freemind-convert-text-p'.
-MATCHED is the link just matched."
- (let ((res "")
- (bi org-freemind-bol-helper-base-indent))
- (dolist (cc (append matched nil))
- (if (= 32 cc)
- ;;(setq res (concat res "&nbsp;"))
- ;; We need to use the numerical version. Otherwise Freemind
- ;; ver 0.9.0 RC9 can not export to html/javascript.
- (progn
- (if (< 0 bi)
- (setq bi (1- bi))
- (setq res (concat res "&#160;"))))
- (setq res (concat res (char-to-string cc)))))
- res))
-;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n "))
-
-(defun org-freemind-convert-text-p (text)
- "Convert TEXT to html with <p> paragraphs."
- ;; (string-match-p "[^ ]" " a")
- (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text))
- (setq text (org-freemind-escape-str-from-org text))
-
- (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text))
- (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text))
-
- (setq text (concat "<p>" text))
- (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text))
- (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text))
- (setq text (replace-regexp-in-string "\n" "<br />" text))
- (setq text (concat text "</p>"))
-
- (org-freemind-convert-links-from-org text))
-
-(defcustom org-freemind-node-css-style
- "p { margin-top: 3px; margin-bottom: 3px; }"
- "CSS style for Freemind nodes."
- ;; Fix-me: I do not understand this. It worked to export from Freemind
- ;; with this setting now, but not before??? Was this perhaps a java
- ;; bug or is it a windows xp bug (some resource gets exhausted if you
- ;; use sticky keys which I do).
- :version "24.1"
- :group 'org-freemind)
-
-(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp)
- "Convert text part of org node to freemind subnode or note.
-Convert the text part of the org node named NODE-NAME. The text
-is in the current buffer between START and END. Drawers matching
-DRAWERS-REGEXP are converted to freemind notes."
- ;; fix-me: doc
- (let ((text (buffer-substring-no-properties start end))
- (node-res "")
- (note-res ""))
- (save-match-data
- ;;(setq text (org-freemind-escape-str-from-org text))
- ;; First see if there is something that should be moved to the
- ;; note part:
- (let (drawers)
- (while (string-match drawers-regexp text)
- (setq drawers (cons (match-string 0 text) drawers))
- (setq text
- (concat (substring text 0 (match-beginning 0))
- (substring text (match-end 0))))
- )
- (when drawers
- (dolist (drawer drawers)
- (let ((lines (split-string drawer "\n")))
- (dolist (line lines)
- (setq note-res (concat
- note-res
- org-freemind-org-nfix line "<br />\n")))
- ))))
-
- (when (> (length note-res) 0)
- (setq note-res (concat
- "<richcontent TYPE=\"NOTE\"><html>\n"
- "<head>\n"
- "</head>\n"
- "<body>\n"
- note-res
- "</body>\n"
- "</html>\n"
- "</richcontent>\n")))
-
- ;; There is always an LF char:
- (when (> (length text) 1)
- (setq node-res (concat
- "<node style=\"bubble\" background_color=\"#eeee00\">\n"
- "<richcontent TYPE=\"NODE\"><html>\n"
- "<head>\n"
- (if (= 0 (length org-freemind-node-css-style))
- ""
- (concat
- "<style type=\"text/css\">\n"
- "<!--\n"
- org-freemind-node-css-style
- "-->\n"
- "</style>\n"))
- "</head>\n"
- "<body>\n"))
- (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML"))
- (end-html-mark (regexp-quote "#+END_HTML"))
- head
- end-pos
- end-pos-match
- )
- ;; Take care of #+BEGIN_HTML - #+END_HTML
- (while (string-match begin-html-mark text)
- (setq head (substring text 0 (match-beginning 0)))
- (setq end-pos-match (match-end 0))
- (setq node-res (concat node-res
- (org-freemind-convert-text-p head)))
- (setq text (substring text end-pos-match))
- (setq end-pos (string-match end-html-mark text))
- (if end-pos
- (setq end-pos-match (match-end 0))
- (message "org-freemind: Missing #+END_HTML")
- (setq end-pos (length text))
- (setq end-pos-match end-pos))
- (setq node-res (concat node-res
- (substring text 0 end-pos)))
- (setq text (substring text end-pos-match)))
- (setq node-res (concat node-res
- (org-freemind-convert-text-p text))))
- (setq node-res (concat
- node-res
- "</body>\n"
- "</html>\n"
- "</richcontent>\n"
- ;; Put a note that this is for the parent node
- ;; "<richcontent TYPE=\"NOTE\"><html>"
- ;; "<head>"
- ;; "</head>"
- ;; "<body>"
- ;; "<p>"
- ;; "-- This is more about \"" node-name "\" --"
- ;; "</p>"
- ;; "</body>"
- ;; "</html>"
- ;; "</richcontent>\n"
- note-res
- "</node>\n" ;; ok
- )))
- (list node-res note-res))))
-
-(defun org-freemind-write-node (mm-buffer drawers-regexp
- num-left-nodes base-level
- current-level next-level this-m2
- this-node-end
- this-children-visible
- next-node-start
- next-has-some-visible-child)
- (let* (this-icons
- this-bg-color
- this-m2-link
- this-m2-escaped
- this-rich-node
- this-rich-note
- )
- (when (string-match "TODO" this-m2)
- (setq this-m2 (replace-match "" nil nil this-m2))
- (add-to-list 'this-icons "button_cancel")
- (setq this-bg-color "#ffff88")
- (when (string-match "\\[#\\(.\\)\\]" this-m2)
- (let ((prior (string-to-char (match-string 1 this-m2))))
- (setq this-m2 (replace-match "" nil nil this-m2))
- (cond
- ((= prior ?A)
- (add-to-list 'this-icons "full-1")
- (setq this-bg-color "#ff0000"))
- ((= prior ?B)
- (add-to-list 'this-icons "full-2")
- (setq this-bg-color "#ffaa00"))
- ((= prior ?C)
- (add-to-list 'this-icons "full-3")
- (setq this-bg-color "#ffdd00"))
- ((= prior ?D)
- (add-to-list 'this-icons "full-4")
- (setq this-bg-color "#ffff00"))
- ((= prior ?E)
- (add-to-list 'this-icons "full-5"))
- ((= prior ?F)
- (add-to-list 'this-icons "full-6"))
- ((= prior ?G)
- (add-to-list 'this-icons "full-7"))
- ))))
- (setq this-m2 (org-trim this-m2))
- (when (string-match org-bracket-link-analytic-regexp this-m2)
- (setq this-m2-link (concat "link=\"" (match-string 1 this-m2)
- (match-string 3 this-m2) "\" ")
- this-m2 (replace-match "\\5" nil nil this-m2 0)))
- (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2))
- (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note
- this-m2-escaped
- this-node-end
- (1- next-node-start)
- drawers-regexp)))
- (setq this-rich-node (nth 0 node-notes))
- (setq this-rich-note (nth 1 node-notes)))
- (with-current-buffer mm-buffer
- (insert "<node " (if this-m2-link this-m2-link "")
- "text=\"" this-m2-escaped "\"")
- (org-freemind-get-node-style this-m2)
- (when (> next-level current-level)
- (unless (or this-children-visible
- next-has-some-visible-child)
- (insert " folded=\"true\"")))
- (when (and (= current-level (1+ base-level))
- (> num-left-nodes 0))
- (setq num-left-nodes (1- num-left-nodes))
- (insert " position=\"left\""))
- (when this-bg-color
- (insert " background_color=\"" this-bg-color "\""))
- (insert ">\n")
- (when this-icons
- (dolist (icon this-icons)
- (insert "<icon builtin=\"" icon "\"/>\n")))
- )
- (with-current-buffer mm-buffer
- ;;(when this-rich-note (insert this-rich-note))
- (when this-rich-node (insert this-rich-node))))
- num-left-nodes)
-
-(defun org-freemind-check-overwrite (file interactively)
- "Check if file FILE already exists.
-If FILE does not exist return t.
-
-If INTERACTIVELY is non-nil ask if the file should be replaced
-and return t/nil if it should/should not be replaced.
-
-Otherwise give an error say the file exists."
- (if (file-exists-p file)
- (if interactively
- (y-or-n-p (format "File %s exists, replace it? " file))
- (error "File %s already exists" file))
- t))
-
-(defvar org-freemind-node-pattern
- ;;(rx bol
- ;; (submatch (1+ "*"))
- ;; (1+ space)
- ;; (submatch (*? nonl))
- ;; eol)
- "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$")
-
-(defun org-freemind-look-for-visible-child (node-level)
- (save-excursion
- (save-match-data
- (let ((found-visible-child nil))
- (while (and (not found-visible-child)
- (re-search-forward org-freemind-node-pattern nil t))
- (let* ((m1 (match-string-no-properties 1))
- (level (length m1)))
- (if (>= node-level level)
- (setq found-visible-child 'none)
- (unless (get-char-property (line-beginning-position) 'invisible)
- (setq found-visible-child 'found)))))
- (eq found-visible-child 'found)
- ))))
-
-(defun org-freemind-goto-line (line)
- "Go to line number LINE."
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (1- line))))
-
-(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line)
- (with-current-buffer org-buffer
- (dolist (node-style org-freemind-node-styles)
- (when (org-string-match-p (car node-style) buffer-file-name)
- (setq org-freemind-node-style (cadr node-style))))
- ;;(message "org-freemind-node-style =%s" org-freemind-node-style)
- (save-match-data
- (let* ((drawers (copy-sequence org-drawers))
- drawers-regexp
- (num-top1-nodes 0)
- (num-top2-nodes 0)
- num-left-nodes
- (unclosed-nodes 0)
- (odd-only org-odd-levels-only)
- (first-time t)
- (current-level 1)
- base-level
- prev-node-end
- rich-text
- unfinished-tag
- node-at-line-level
- node-at-line-last)
- (with-current-buffer mm-buffer
- (erase-buffer)
- (setq buffer-file-coding-system 'utf-8)
- ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this:
- ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
- (insert "<map version=\"0.9.0\">\n")
- (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n"))
- (save-excursion
- ;; Get special buffer vars:
- (goto-char (point-min))
- (message "Writing Freemind file...")
- (while (re-search-forward "^#\\+DRAWERS:" nil t)
- (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position))))
- (setq drawers (append drawers (split-string dr-txt) nil))))
- (setq drawers-regexp
- (concat "^[[:blank:]]*:"
- (regexp-opt drawers)
- ;;(rx ":" (0+ blank)
- ;; "\n"
- ;; (*? anything)
- ;; "\n"
- ;; (0+ blank)
- ;; ":END:"
- ;; (0+ blank)
- ;; eol)
- ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$"
- ))
-
- (if node-at-line
- ;; Get number of top nodes and last line for this node
- (progn
- (org-freemind-goto-line node-at-line)
- (unless (looking-at org-freemind-node-pattern)
- (error "No node at line %s" node-at-line))
- (setq node-at-line-level (length (match-string-no-properties 1)))
- (forward-line)
- (setq node-at-line-last
- (catch 'last-line
- (while (re-search-forward org-freemind-node-pattern nil t)
- (let* ((m1 (match-string-no-properties 1))
- (level (length m1)))
- (if (<= level node-at-line-level)
- (progn
- (beginning-of-line)
- (throw 'last-line (1- (point))))
- (if (= level (1+ node-at-line-level))
- (setq num-top2-nodes (1+ num-top2-nodes))))))))
- (setq current-level node-at-line-level)
- (setq num-top1-nodes 1)
- (org-freemind-goto-line node-at-line))
-
- ;; First get number of top nodes
- (goto-char (point-min))
- (while (re-search-forward org-freemind-node-pattern nil t)
- (let* ((m1 (match-string-no-properties 1))
- (level (length m1)))
- (if (= level 1)
- (setq num-top1-nodes (1+ num-top1-nodes))
- (if (= level 2)
- (setq num-top2-nodes (1+ num-top2-nodes))))))
- ;; If there is more than one top node we need to insert a node
- ;; to keep them together.
- (goto-char (point-min))
- (when (> num-top1-nodes 1)
- (setq num-top2-nodes num-top1-nodes)
- (setq current-level 0)
- (let ((orig-name (if buffer-file-name
- (file-name-nondirectory (buffer-file-name))
- (buffer-name))))
- (with-current-buffer mm-buffer
- (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n"
- ;; Put a note that this is for the parent node
- "<richcontent TYPE=\"NOTE\"><html>"
- "<head>"
- "</head>"
- "<body>"
- "<p>"
- org-freemind-org-nfix "WHOLE FILE"
- "</p>"
- "</body>"
- "</html>"
- "</richcontent>\n")))))
-
- (setq num-left-nodes (floor num-top2-nodes 2))
- (setq base-level current-level)
- (let (this-m2
- this-node-end
- this-children-visible
- next-m2
- next-node-start
- next-level
- next-has-some-visible-child
- next-children-visible
- )
- (while (and
- (re-search-forward org-freemind-node-pattern nil t)
- (if node-at-line-last (<= (point) node-at-line-last) t)
- )
- (let* ((next-m1 (match-string-no-properties 1))
- (next-node-end (match-end 0))
- )
- (setq next-node-start (match-beginning 0))
- (setq next-m2 (match-string-no-properties 2))
- (setq next-level (length next-m1))
- (setq next-children-visible
- (not (eq 'outline
- (get-char-property (line-end-position) 'invisible))))
- (setq next-has-some-visible-child
- (if next-children-visible t
- (org-freemind-look-for-visible-child next-level)))
- (when this-m2
- (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)))
- (when (if (= num-top1-nodes 1) (> current-level base-level) t)
- (while (>= current-level next-level)
- (with-current-buffer mm-buffer
- (insert "</node>\n")
- (setq current-level
- (- current-level (if odd-only 2 1))))))
- (setq this-node-end (1+ next-node-end))
- (setq this-m2 next-m2)
- (setq current-level next-level)
- (setq this-children-visible next-children-visible)
- (forward-char)
- ))
-;;; (unless (if node-at-line-last
-;;; (>= (point) node-at-line-last)
-;;; nil)
- ;; Write last node:
- (setq this-m2 next-m2)
- (setq current-level next-level)
- (setq next-node-start (if node-at-line-last
- (1+ node-at-line-last)
- (point-max)))
- (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))
- (with-current-buffer mm-buffer (insert "</node>\n"))
- ;)
- )
- (with-current-buffer mm-buffer
- (while (> current-level base-level)
- (insert "</node>\n")
- (setq current-level
- (- current-level (if odd-only 2 1)))
- ))
- (with-current-buffer mm-buffer
- (insert "</map>")
- (delete-trailing-whitespace)
- (goto-char (point-min))
- ))))))
-
-(defun org-freemind-get-node-style (node-name)
- "NOT READY YET."
- ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble">
- ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/>
- (let (node-styles
- node-style)
- (dolist (style-list org-freemind-node-style)
- (let ((node-regexp (car style-list)))
- (message "node-regexp=%s node-name=%s" node-regexp node-name)
- (when (org-string-match-p node-regexp node-name)
- ;;(setq node-style (org-freemind-do-apply-node-style style-list))
- (setq node-style (cadr style-list))
- (when node-style
- (message "node-style=%s" node-style)
- (setq node-styles (append node-styles node-style)))
- )))))
-
-(defun org-freemind-do-apply-node-style (style-list)
- (message "style-list=%S" style-list)
- (let ((node-style 'fork)
- (color "red")
- (background-color "yellow")
- (edge-color "green")
- (edge-style 'bezier)
- (edge-width 'thin)
- (italic t)
- (bold t)
- (font-name "SansSerif")
- (font-size 12))
- (dolist (style (cadr style-list))
- (message " style=%s" style)
- (let ((what (car style)))
- (cond
- ((eq what 'node-style)
- (setq node-style (cadr style)))
- ((eq what 'color)
- (setq color (cadr style)))
- ((eq what 'background-color)
- (setq background-color (cadr style)))
-
- ((eq what 'edge-color)
- (setq edge-color (cadr style)))
-
- ((eq what 'edge-style)
- (setq edge-style (cadr style)))
-
- ((eq what 'edge-width)
- (setq edge-width (cadr style)))
-
- ((eq what 'italic)
- (setq italic (cadr style)))
-
- ((eq what 'bold)
- (setq bold (cadr style)))
-
- ((eq what 'font-name)
- (setq font-name (cadr style)))
-
- ((eq what 'font-size)
- (setq font-size (cadr style)))
- )
- (insert (format " style=\"%s\"" node-style))
- (insert (format " color=\"%s\"" color))
- (insert (format " background_color=\"%s\"" background-color))
- (insert ">\n")
- (insert "<edge")
- (insert (format " color=\"%s\"" edge-color))
- (insert (format " style=\"%s\"" edge-style))
- (insert (format " width=\"%s\"" edge-width))
- (insert "/>\n")
- (insert "<font")
- (insert (format " italic=\"%s\"" italic))
- (insert (format " bold=\"%s\"" bold))
- (insert (format " name=\"%s\"" font-name))
- (insert (format " size=\"%s\"" font-size))
- ))))
-
-;;;###autoload
-(defun org-freemind-from-org-mode-node (node-line mm-file)
- "Convert node at line NODE-LINE to the FreeMind file MM-FILE.
-See `org-freemind-from-org-mode' for more information."
- (interactive
- (progn
- (unless (org-back-to-heading nil)
- (error "Can't find org-mode node start"))
- (let* ((line (line-number-at-pos))
- (default-mm-file (concat (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- "nofile")
- "-line-" (number-to-string line)
- ".mm"))
- (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
- (list line mm-file))))
- (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
- (let ((org-buffer (current-buffer))
- (mm-buffer (find-file-noselect mm-file)))
- (org-freemind-write-mm-buffer org-buffer mm-buffer node-line)
- (with-current-buffer mm-buffer
- (basic-save-buffer)
- (when (org-called-interactively-p 'any)
- (switch-to-buffer-other-window mm-buffer)
- (when (y-or-n-p "Show in FreeMind? ")
- (org-freemind-show buffer-file-name)))))))
-
-;;;###autoload
-(defun org-freemind-from-org-mode (org-file mm-file)
- "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE.
-All the nodes will be opened or closed in Freemind just as you
-have them in `org-mode'.
-
-Note that exporting to Freemind also gives you an alternative way
-to export from `org-mode' to html. You can create a dynamic html
-version of the your org file, by first exporting to Freemind and
-then exporting from Freemind to html. The 'As
-XHTML (JavaScript)' version in Freemind works very well \(and you
-can use a CSS stylesheet to style it)."
- ;; Fix-me: better doc, include recommendations etc.
- (interactive
- (let* ((org-file buffer-file-name)
- (default-mm-file (concat
- (if org-file
- (file-name-nondirectory org-file)
- "nofile")
- ".mm"))
- (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
- (list org-file mm-file)))
- (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
- (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer)))
- (mm-buffer (find-file-noselect mm-file)))
- (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
- (with-current-buffer mm-buffer
- (basic-save-buffer)
- (when (org-called-interactively-p 'any)
- (switch-to-buffer-other-window mm-buffer)
- (when (y-or-n-p "Show in FreeMind? ")
- (org-freemind-show buffer-file-name)))))))
-
-;;;###autoload
-(defun org-freemind-from-org-sparse-tree (org-buffer mm-file)
- "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE."
- (interactive
- (let* ((org-file buffer-file-name)
- (default-mm-file (concat
- (if org-file
- (file-name-nondirectory org-file)
- "nofile")
- "-sparse.mm"))
- (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file)))
- (list (current-buffer) mm-file)))
- (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any))
- (let (org-buffer
- (mm-buffer (find-file-noselect mm-file)))
- (save-window-excursion
- (org-export-visible ?\ nil)
- (setq org-buffer (current-buffer)))
- (org-freemind-write-mm-buffer org-buffer mm-buffer nil)
- (with-current-buffer mm-buffer
- (basic-save-buffer)
- (when (org-called-interactively-p 'any)
- (switch-to-buffer-other-window mm-buffer)
- (when (y-or-n-p "Show in FreeMind? ")
- (org-freemind-show buffer-file-name)))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; FreeMind => Org
-
-;; (sort '(b a c) 'org-freemind-lt-symbols)
-(defun org-freemind-lt-symbols (sym-a sym-b)
- (string< (symbol-name sym-a) (symbol-name sym-b)))
-;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs)
-(defun org-freemind-lt-xml-attrs (attr-a attr-b)
- (string< (symbol-name (car attr-a)) (symbol-name (car attr-b))))
-
-;; xml-parse-region gives things like
-;; ((p nil "\n"
-;; (a
-;; ((href . "link"))
-;; "text")
-;; "\n"
-;; (b nil "hej")
-;; "\n"))
-
-;; '(a . nil)
-
-;; (org-freemind-symbols= 'a (car '(A B)))
-(defsubst org-freemind-symbols= (sym-a sym-b)
- "Return t if downcased names of SYM-A and SYM-B are equal.
-SYM-A and SYM-B should be symbols."
- (or (eq sym-a sym-b)
- (string= (downcase (symbol-name sym-a))
- (downcase (symbol-name sym-b)))))
-
-(defun org-freemind-get-children (parent path)
- "Find children node to PARENT from PATH.
-PATH should be a list of steps, where each step has the form
-
- '(NODE-NAME (ATTR-NAME . ATTR-VALUE))"
- ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val
- ;; Fix-me: case insensitive version for children?
- (let* ((children (if (not (listp (car parent)))
- (cddr parent)
- (let (cs)
- (dolist (p parent)
- (dolist (c (cddr p))
- (add-to-list 'cs c)))
- cs)
- ))
- (step (car path))
- (step-node (if (listp step) (car step) step))
- (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs)))
- (path-tail (cdr path))
- path-children)
- (dolist (child children)
- ;; skip xml.el formatting nodes
- (unless (stringp child)
- ;; compare node name
- (when (if (not step-node)
- t ;; any node name
- (org-freemind-symbols= step-node (car child)))
- (if (not step-attr-list)
- ;;(throw 'path-child child) ;; no attr to care about
- (add-to-list 'path-children child)
- (let* ((child-attr-list (cadr child))
- (step-attr-copy (copy-sequence step-attr-list)))
- (dolist (child-attr child-attr-list)
- ;; Compare attr names:
- (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr))
- ;; Compare values:
- (let ((step-val (cdar step-attr-copy))
- (child-val (cdr child-attr)))
- (when (if (not step-val)
- t ;; any value
- (string= step-val child-val))
- (setq step-attr-copy (cdr step-attr-copy))))))
- ;; Did we find all?
- (unless step-attr-copy
- ;;(throw 'path-child child)
- (add-to-list 'path-children child)
- ))))))
- (if path-tail
- (org-freemind-get-children path-children path-tail)
- path-children)))
-
-(defun org-freemind-get-richcontent-node (node)
- (let ((rc-nodes
- (org-freemind-get-children node '((richcontent (type . "NODE")) html body))))
- (when (> (length rc-nodes) 1)
- (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>"))
- (car rc-nodes)))
-
-(defun org-freemind-get-richcontent-note (node)
- (let ((rc-notes
- (org-freemind-get-children node '((richcontent (type . "NOTE")) html body))))
- (when (> (length rc-notes) 1)
- (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>"))
- (car rc-notes)))
-
-(defun org-freemind-test-get-tree-text ()
- (let ((node '(p nil "\n"
- (a
- ((href . "link"))
- "text")
- "\n"
- (b nil "hej")
- "\n")))
- (org-freemind-get-tree-text node)))
-;; (org-freemind-test-get-tree-text)
-
-(defun org-freemind-get-tree-text (node)
- (when node
- (let ((ntxt "")
- (link nil)
- (lf-after nil))
- (dolist (n node)
- (case n
- ;;(a (setq is-link t) )
- ((h1 h2 h3 h4 h5 h6 p)
- ;;(setq ntxt (concat "\n" ntxt))
- (setq lf-after 2))
- (br
- (setq lf-after 1))
- (t
- (cond
- ((stringp n)
- (when (string= n "\n") (setq n ""))
- (if link
- (setq ntxt (concat ntxt
- "[[" link "][" n "]]"))
- (setq ntxt (concat ntxt n))))
- ((and n (listp n))
- (if (symbolp (car n))
- (setq ntxt (concat ntxt (org-freemind-get-tree-text n)))
- ;; This should be the attributes:
- (dolist (att-val n)
- (let ((att (car att-val))
- (val (cdr att-val)))
- (when (eq att 'href)
- (setq link val))))))))))
- (if lf-after
- (setq ntxt (concat ntxt (make-string lf-after ?\n)))
- (setq ntxt (concat ntxt " ")))
- ;;(setq ntxt (concat ntxt (format "{%s}" n)))
- ntxt)))
-
-(defun org-freemind-get-richcontent-node-text (node)
- "Get the node text as from the richcontent node NODE."
- (save-match-data
- (let* ((rc (org-freemind-get-richcontent-node node))
- (txt (org-freemind-get-tree-text rc)))
- ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
- txt
- )))
-
-(defun org-freemind-get-richcontent-note-text (node)
- "Get the node text as from the richcontent note NODE."
- (save-match-data
- (let* ((rc (org-freemind-get-richcontent-note node))
- (txt (when rc (org-freemind-get-tree-text rc))))
- ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt)))
- txt
- )))
-
-(defun org-freemind-get-icon-names (node)
- (let* ((icon-nodes (org-freemind-get-children node '((icon ))))
- names)
- (dolist (icn icon-nodes)
- (setq names (cons (cdr (assq 'builtin (cadr icn))) names)))
- ;; (icon (builtin . "full-1"))
- names))
-
-(defun org-freemind-node-to-org (node level skip-levels)
- (let ((qname (car node))
- (attributes (cadr node))
- text
- ;; Fix-me: note is never inserted
- (note (org-freemind-get-richcontent-note-text node))
- (mark "-- This is more about ")
- (icons (org-freemind-get-icon-names node))
- (children (cddr node)))
- (when (< 0 (- level skip-levels))
- (dolist (attrib attributes)
- (case (car attrib)
- ('TEXT (setq text (cdr attrib)))
- ('text (setq text (cdr attrib)))))
- (unless text
- ;; There should be a richcontent node holding the text:
- (setq text (org-freemind-get-richcontent-node-text node)))
- (when icons
- (when (member "full-1" icons) (setq text (concat "[#A] " text)))
- (when (member "full-2" icons) (setq text (concat "[#B] " text)))
- (when (member "full-3" icons) (setq text (concat "[#C] " text)))
- (when (member "full-4" icons) (setq text (concat "[#D] " text)))
- (when (member "full-5" icons) (setq text (concat "[#E] " text)))
- (when (member "full-6" icons) (setq text (concat "[#F] " text)))
- (when (member "full-7" icons) (setq text (concat "[#G] " text)))
- (when (member "button_cancel" icons) (setq text (concat "TODO " text)))
- )
- (if (and note
- (string= mark (substring note 0 (length mark))))
- (progn
- (setq text (replace-regexp-in-string "\n $" "" text))
- (insert text))
- (case qname
- ('node
- (insert (make-string (- level skip-levels) ?*) " " text "\n")
- (when note
- (insert ":COMMENT:\n" note "\n:END:\n"))
- ))))
- (dolist (child children)
- (unless (or (null child)
- (stringp child))
- (org-freemind-node-to-org child (1+ level) skip-levels)))))
-
-;; Fix-me: put back special things, like drawers that are stored in
-;; the notes. Should maybe all notes contents be put in drawers?
-;;;###autoload
-(defun org-freemind-to-org-mode (mm-file org-file)
- "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE."
- (interactive
- (save-match-data
- (let* ((mm-file (buffer-file-name))
- (default-org-file (concat (file-name-nondirectory mm-file) ".org"))
- (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file)))
- (list mm-file org-file))))
- (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any))
- (let ((mm-buffer (find-file-noselect mm-file))
- (org-buffer (find-file-noselect org-file)))
- (with-current-buffer mm-buffer
- (let* ((xml-list (xml-parse-file mm-file))
- (top-node (cadr (cddar xml-list)))
- (note (org-freemind-get-richcontent-note-text top-node))
- (skip-levels
- (if (and note
- (string-match "^--org-mode: WHOLE FILE$" note))
- 1
- 0)))
- (with-current-buffer org-buffer
- (erase-buffer)
- (org-freemind-node-to-org top-node 1 skip-levels)
- (goto-char (point-min))
- (org-set-tags t t) ;; Align all tags
- )
- (switch-to-buffer-other-window org-buffer)
- )))))
-
-(provide 'org-freemind)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; coding: utf-8
-;; End:
-
-;;; org-freemind.el ends here
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 4419fdbe85d..06f00a4950c 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -1,6 +1,6 @@
;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Tassilo Horn <tassilo at member dot fsf dot org>
@@ -43,8 +43,7 @@
(declare-function gnus-summary-last-subject "gnus-sum" nil)
;; Customization variables
-(when (fboundp 'defvaralias)
- (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links))
+(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
(defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane.
@@ -61,11 +60,17 @@ Normally, this translation is done by querying the IMAP server,
which is usually very fast. Unfortunately, some (maybe badly
configured) IMAP servers don't support this operation quickly.
So if following a link to a Gnus article takes ages, try setting
-this variable to `t'."
+this variable to t."
:group 'org-link-store
:version "24.1"
:type 'boolean)
+(defcustom org-gnus-no-server nil
+ "Should Gnus be started using `gnus-no-server'?"
+ :group 'org-gnus
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
;; Install the link type
(org-add-link-type "gnus" 'org-gnus-open)
@@ -286,8 +291,8 @@ If `org-store-link' was called with a prefix arg the meaning of
(group (gnus-group-jump-to-group group))))
(defun org-gnus-no-new-news ()
- "Like `M-x gnus' but doesn't check for new news."
- (if (not (gnus-alive-p)) (gnus)))
+ "Like `\\[gnus]' but doesn't check for new news."
+ (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus))))
(provide 'org-gnus)
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index 8465ba45a27..e2be4608b67 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -1,6 +1,6 @@
;;; org-habit.el --- The habit tracking code for Org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -85,6 +85,12 @@ today's agenda, even if they are not scheduled."
:version "24.1"
:type 'character)
+(defcustom org-habit-show-done-always-green nil
+ "Non-nil means DONE days will always be green in the consistency graph.
+It will be green even if it was done after the deadline."
+ :group 'org-habit
+ :type 'boolean)
+
(defface org-habit-clear-face
'((((background light)) (:background "#8270f9"))
(((background dark)) (:background "blue")))
@@ -174,7 +180,7 @@ This list represents a \"habit\" for the rest of this module."
(error "Habit %s has no scheduled date" habit-entry))
(unless scheduled-repeat
(error
- "Habit '%s' has no scheduled repeat period or has an incorrect one"
+ "Habit `%s' has no scheduled repeat period or has an incorrect one"
habit-entry))
(setq sr-days (org-habit-duration-to-days scheduled-repeat))
(unless (> sr-days 0)
@@ -194,7 +200,9 @@ This list represents a \"habit\" for the rest of this module."
(count 0))
(unless reversed (goto-char end))
(while (and (< count maxdays)
- (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t))
+ (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]"
+ (regexp-opt org-done-keywords))
+ limit t))
(push (time-to-days
(org-time-string-to-time (match-string-no-properties 1)))
closed-dates)
@@ -272,8 +280,9 @@ Habits are assigned colors on the following basis:
(if donep
'(org-habit-ready-face . org-habit-ready-future-face)
'(org-habit-alert-face . org-habit-alert-future-face)))
- (t
- '(org-habit-overdue-face . org-habit-overdue-future-face)))))
+ ((and org-habit-show-done-always-green donep)
+ '(org-habit-ready-face . org-habit-ready-future-face))
+ (t '(org-habit-overdue-face . org-habit-overdue-future-face)))))
(defun org-habit-build-graph (habit starting current ending)
"Build a graph for the given HABIT, from STARTING to ENDING.
@@ -342,14 +351,7 @@ current time."
(let ((inhibit-read-only t) l c
(buffer-invisibility-spec '(org-link))
(moment (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0)))
- disabled-overlays)
- ;; Disable filters; this helps with alignment if there are links.
- (mapc (lambda (ol)
- (when (overlay-get ol 'invisible)
- (overlay-put ol 'invisible nil)
- (setq disabled-overlays (cons ol disabled-overlays))))
- (overlays-in (point-min) (point-max)))
+ (list 0 (* 3600 org-extend-today-until) 0))))
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (not (eobp))
@@ -365,9 +367,7 @@ current time."
(time-subtract moment (days-to-time org-habit-preceding-days))
moment
(time-add moment (days-to-time org-habit-following-days))))))
- (forward-line)))
- (mapc (lambda (ol) (overlay-put ol 'invisible t))
- disabled-overlays)))
+ (forward-line)))))
(defun org-habit-toggle-habits ()
"Toggle display of habits in an agenda buffer."
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el
deleted file mode 100644
index ca90f855aab..00000000000
--- a/lisp/org/org-html.el
+++ /dev/null
@@ -1,2761 +0,0 @@
-;;; org-html.el --- HTML export for Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;;; Code:
-
-(require 'org-exp)
-(require 'format-spec)
-
-(eval-when-compile (require 'cl))
-
-(declare-function org-id-find-id-file "org-id" (id))
-(declare-function htmlize-region "ext:htmlize" (beg end))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-
-(defgroup org-export-html nil
- "Options specific for HTML export of Org-mode files."
- :tag "Org Export HTML"
- :group 'org-export)
-
-(defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
-<h2 class=\"footnotes\">%s: </h2>
-<div id=\"text-footnotes\">
-%s
-</div>
-</div>"
- "Format for the footnotes section.
-Should contain a two instances of %s. The first will be replaced with the
-language-specific word for \"Footnotes\", the second one will be replaced
-by the footnotes themselves."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-footnote-format "<sup>%s</sup>"
- "The format for the footnote reference.
-%s will be replaced by the footnote reference itself."
- :group 'org-export-html
- :type 'string)
-
-
-(defcustom org-export-html-footnote-separator "<sup>, </sup>"
- "Text used to separate footnotes."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-html-coding-system nil
- "Coding system for HTML export, defaults to `buffer-file-coding-system'."
- :group 'org-export-html
- :type 'coding-system)
-
-(defcustom org-export-html-extension "html"
- "The extension for exported HTML files."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-xml-declaration
- '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
- ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
- "The extension for exported HTML files.
-%s will be replaced with the charset of the exported file.
-This may be a string, or an alist with export extensions
-and corresponding declarations."
- :group 'org-export-html
- :type '(choice
- (string :tag "Single declaration")
- (repeat :tag "Dependent on extension"
- (cons (string :tag "Extension")
- (string :tag "Declaration")))))
-
-(defcustom org-export-html-style-include-scripts t
- "Non-nil means include the JavaScript snippets in exported HTML files.
-The actual script is defined in `org-export-html-scripts' and should
-not be modified."
- :group 'org-export-html
- :type 'boolean)
-
-(defvar org-export-html-scripts
- "<script type=\"text/javascript\">
-/*
-@licstart The following is the entire license notice for the
-JavaScript code in this tag.
-
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
-
-The JavaScript code in this tag is free software: you can
-redistribute it and/or modify it under the terms of the GNU
-General Public License (GNU GPL) as published by the Free Software
-Foundation, either version 3 of the License, or (at your option)
-any later version. The code is distributed WITHOUT ANY WARRANTY;
-without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-
-As additional permission under GNU GPL version 3 section 7, you
-may distribute non-source (e.g., minimized or compacted) forms of
-that code without the copy of the GNU GPL normally required by
-section 4, provided you include this license notice and a URL
-through which recipients can access the Corresponding Source.
-
-
-@licend The above is the entire license notice
-for the JavaScript code in this tag.
-*/
-<!--/*--><![CDATA[/*><!--*/
- function CodeHighlightOn(elem, id)
- {
- var target = document.getElementById(id);
- if(null != target) {
- elem.cacheClassElem = elem.className;
- elem.cacheClassTarget = target.className;
- target.className = \"code-highlighted\";
- elem.className = \"code-highlighted\";
- }
- }
- function CodeHighlightOff(elem, id)
- {
- var target = document.getElementById(id);
- if(elem.cacheClassElem)
- elem.className = elem.cacheClassElem;
- if(elem.cacheClassTarget)
- target.className = elem.cacheClassTarget;
- }
-/*]]>*///-->
-</script>"
- "Basic JavaScript that is needed by HTML files produced by Org-mode.")
-
-(defconst org-export-html-style-default
- "<style type=\"text/css\">
- <!--/*--><![CDATA[/*><!--*/
- html { font-family: Times, serif; font-size: 12pt; }
- .title { text-align: center; }
- .todo { color: red; }
- .done { color: green; }
- .tag { background-color: #add8e6; font-weight:normal }
- .target { }
- .timestamp { color: #bebebe; }
- .timestamp-kwd { color: #5f9ea0; }
- .right {margin-left:auto; margin-right:0px; text-align:right;}
- .left {margin-left:0px; margin-right:auto; text-align:left;}
- .center {margin-left:auto; margin-right:auto; text-align:center;}
- p.verse { margin-left: 3% }
- pre {
- border: 1pt solid #AEBDCC;
- background-color: #F3F5F7;
- padding: 5pt;
- font-family: courier, monospace;
- font-size: 90%;
- overflow:auto;
- }
- table { border-collapse: collapse; }
- td, th { vertical-align: top; }
- th.right { text-align:center; }
- th.left { text-align:center; }
- th.center { text-align:center; }
- td.right { text-align:right; }
- td.left { text-align:left; }
- td.center { text-align:center; }
- dt { font-weight: bold; }
- div.figure { padding: 0.5em; }
- div.figure p { text-align: center; }
- div.inlinetask {
- padding:10px;
- border:2px solid gray;
- margin:10px;
- background: #ffffcc;
- }
- textarea { overflow-x: auto; }
- .linenr { font-size:smaller }
- .code-highlighted {background-color:#ffff00;}
- .org-info-js_info-navigation { border-style:none; }
- #org-info-js_console-label { font-size:10px; font-weight:bold;
- white-space:nowrap; }
- .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
- font-weight:bold; }
- /*]]>*/-->
-</style>"
- "The default style specification for exported HTML files.
-Please use the variables `org-export-html-style' and
-`org-export-html-style-extra' to add to this style. If you wish to not
-have the default style included, customize the variable
-`org-export-html-style-include-default'.")
-
-(defcustom org-export-html-style-include-default t
- "Non-nil means include the default style in exported HTML files.
-The actual style is defined in `org-export-html-style-default' and should
-not be modified. Use the variables `org-export-html-style' to add
-your own style information."
- :group 'org-export-html
- :type 'boolean)
-
-;;;###autoload
-(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
-
-(defcustom org-export-html-style ""
- "Org-wide style definitions for exported HTML files.
-
-This variable needs to contain the full HTML structure to provide a style,
-including the surrounding HTML tags. If you set the value of this variable,
-you should consider to include definitions for the following classes:
- title, todo, done, timestamp, timestamp-kwd, tag, target.
-
-For example, a valid value would be:
-
- <style type=\"text/css\">
- <![CDATA[
- p { font-weight: normal; color: gray; }
- h1 { color: black; }
- .title { text-align: center; }
- .todo, .timestamp-kwd { color: red; }
- .done { color: green; }
- ]]>
- </style>
-
-If you'd like to refer to an external style file, use something like
-
- <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
-
-As the value of this option simply gets inserted into the HTML <head> header,
-you can \"misuse\" it to add arbitrary text to the header.
-See also the variable `org-export-html-style-extra'."
- :group 'org-export-html
- :type 'string)
-;;;###autoload
-(put 'org-export-html-style 'safe-local-variable 'stringp)
-
-(defcustom org-export-html-style-extra ""
- "Additional style information for HTML export.
-The value of this variable is inserted into the HTML buffer right after
-the value of `org-export-html-style'. Use this variable for per-file
-settings of style information, and do not forget to surround the style
-settings with <style>...</style> tags."
- :group 'org-export-html
- :type 'string)
-;;;###autoload
-(put 'org-export-html-style-extra 'safe-local-variable 'stringp)
-
-(defcustom org-export-html-mathjax-options
- '((path "http://orgmode.org/mathjax/MathJax.js")
- (scale "100")
- (align "center")
- (indent "2em")
- (mathml nil))
- "Options for MathJax setup.
-
-path The path where to find MathJax
-scale Scaling for the HTML-CSS backend, usually between 100 and 133
-align How to align display math: left, center, or right
-indent If align is not center, how far from the left/right side?
-mathml Should a MathML player be used if available?
- This is faster and reduces bandwidth use, but currently
- sometimes has lower spacing quality. Therefore, the default is
- nil. When browsers get better, this switch can be flipped.
-
-You can also customize this for each buffer, using something like
-
-#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
- :group 'org-export-html
- :version "24.1"
- :type '(list :greedy t
- (list :tag "path (the path from where to load MathJax.js)"
- (const :format " " path) (string))
- (list :tag "scale (scaling for the displayed math)"
- (const :format " " scale) (string))
- (list :tag "align (alignment of displayed equations)"
- (const :format " " align) (string))
- (list :tag "indent (indentation with left or right alignment)"
- (const :format " " indent) (string))
- (list :tag "mathml (should MathML display be used is possible)"
- (const :format " " mathml) (boolean))))
-
-(defun org-export-html-mathjax-config (template options in-buffer)
- "Insert the user setup into the matchjax template."
- (let (name val (yes " ") (no "// ") x)
- (mapc
- (lambda (e)
- (setq name (car e) val (nth 1 e))
- (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- (if (not (stringp val)) (setq val (format "%s" val)))
- (setq template
- (replace-regexp-in-string
- (concat "%" (upcase (symbol-name name))) val template t t)))
- options)
- (setq val (nth 1 (assq 'mathml options)))
- (if (string-match (concat "\\<mathml:") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- ;; Exchange prefixes depending on mathml setting
- (if (not val) (setq x yes yes no no x))
- ;; Replace cookies to turn on or off the config/jax lines
- (if (string-match ":MMLYES:" template)
- (setq template (replace-match yes t t template)))
- (if (string-match ":MMLNO:" template)
- (setq template (replace-match no t t template)))
- ;; Return the modified template
- template))
-
-(defcustom org-export-html-mathjax-template
- "<script type=\"text/javascript\" src=\"%PATH\">
-/**
- *
- * @source: %PATH
- *
- * @licstart The following is the entire license notice for the
- * JavaScript code in %PATH.
- *
- * Copyright (C) 2012-2013 MathJax
- *
- * Licensed under the Apache License, Version 2.0 (the \"License\");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an \"AS IS\" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *
- * @licend The above is the entire license notice
- * for the JavaScript code in %PATH.
- *
- */
-
-/*
-@licstart The following is the entire license notice for the
-JavaScript code below.
-
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
-
-The JavaScript code below is free software: you can
-redistribute it and/or modify it under the terms of the GNU
-General Public License (GNU GPL) as published by the Free Software
-Foundation, either version 3 of the License, or (at your option)
-any later version. The code is distributed WITHOUT ANY WARRANTY;
-without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-
-As additional permission under GNU GPL version 3 section 7, you
-may distribute non-source (e.g., minimized or compacted) forms of
-that code without the copy of the GNU GPL normally required by
-section 4, provided you include this license notice and a URL
-through which recipients can access the Corresponding Source.
-
-
-@licend The above is the entire license notice
-for the JavaScript code below.
-*/
-<!--/*--><![CDATA[/*><!--*/
- MathJax.Hub.Config({
- // Only one of the two following lines, depending on user settings
- // First allows browser-native MathML display, second forces HTML/CSS
- :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
- :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
- extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
- \"TeX/noUndefined.js\"],
- tex2jax: {
- inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
- displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
- skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
- ignoreClass: \"tex2jax_ignore\",
- processEscapes: false,
- processEnvironments: true,
- preview: \"TeX\"
- },
- showProcessingMessages: true,
- displayAlign: \"%ALIGN\",
- displayIndent: \"%INDENT\",
-
- \"HTML-CSS\": {
- scale: %SCALE,
- availableFonts: [\"STIX\",\"TeX\"],
- preferredFont: \"TeX\",
- webFont: \"TeX\",
- imageFont: \"TeX\",
- showMathMenu: true,
- },
- MMLorHTML: {
- prefer: {
- MSIE: \"MML\",
- Firefox: \"MML\",
- Opera: \"HTML\",
- other: \"HTML\"
- }
- }
- });
-/*]]>*///-->
-</script>"
- "The MathJax setup for XHTML files."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-html-tag-class-prefix ""
- "Prefix to class names for TODO keywords.
-Each tag gets a class given by the tag itself, with this prefix.
-The default prefix is empty because it is nice to just use the keyword
-as a class name. But if you get into conflicts with other, existing
-CSS classes, then this prefix can be very useful."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-todo-kwd-class-prefix ""
- "Prefix to class names for TODO keywords.
-Each TODO keyword gets a class given by the keyword itself, with this prefix.
-The default prefix is empty because it is nice to just use the keyword
-as a class name. But if you get into conflicts with other, existing
-CSS classes, then this prefix can be very useful."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>"
- "Format for anchors in HTML headlines.
-It requires to %s: both will be replaced by the anchor referring
-to the headline (e.g. \"sec-2\"). When set to `nil', don't insert
-HTML anchors in headlines."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-html-preamble t
- "Non-nil means insert a preamble in HTML export.
-
-When `t', insert a string as defined by one of the formatting
-strings in `org-export-html-preamble-format'. When set to a
-string, this string overrides `org-export-html-preamble-format'.
-When set to a function, apply this function and insert the
-returned string. The function takes no argument, but you can
-use `opt-plist' to access the current export options.
-
-Setting :html-preamble in publishing projects will take
-precedence over this variable."
- :group 'org-export-html
- :type '(choice (const :tag "No preamble" nil)
- (const :tag "Default preamble" t)
- (string :tag "Custom format string")
- (function :tag "Function (must return a string)")))
-
-(defcustom org-export-html-preamble-format '(("en" ""))
- "Alist of languages and format strings for the HTML preamble.
-
-To enable the HTML exporter to use these formats, you need to set
-`org-export-html-preamble' to `t'.
-
-The first element of each list is the language code, as used for
-the #+LANGUAGE keyword.
-
-The second element of each list is a format string to format the
-preamble itself. This format string can contain these elements:
-
-%t stands for the title.
-%a stands for the author's name.
-%e stands for the author's email.
-%d stands for the date.
-
-If you need to use a \"%\" character, you need to escape it
-like that: \"%%\"."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-html-postamble 'auto
- "Non-nil means insert a postamble in HTML export.
-
-When `t', insert a string as defined by the format string in
-`org-export-html-postamble-format'. When set to a string, this
-string overrides `org-export-html-postamble-format'. When set to
-'auto, discard `org-export-html-postamble-format' and honor
-`org-export-author/email/creator-info' variables. When set to a
-function, apply this function and insert the returned string.
-The function takes no argument, but you can use `opt-plist' to
-access the current export options.
-
-Setting :html-postamble in publishing projects will take
-precedence over this variable."
- :group 'org-export-html
- :type '(choice (const :tag "No postamble" nil)
- (const :tag "Auto preamble" 'auto)
- (const :tag "Default format string" t)
- (string :tag "Custom format string")
- (function :tag "Function (must return a string)")))
-
-(defcustom org-export-html-postamble-format
- '(("en" "<p class=\"author\">Author: %a (%e)</p>
-<p class=\"date\">Date: %d</p>
-<p class=\"creator\">Generated by %c</p>
-<p class=\"xhtml-validation\">%v</p>
-"))
- "Alist of languages and format strings for the HTML postamble.
-
-To enable the HTML exporter to use these formats, you need to set
-`org-export-html-postamble' to `t'.
-
-The first element of each list is the language code, as used for
-the #+LANGUAGE keyword.
-
-The second element of each list is a format string to format the
-postamble itself. This format string can contain these elements:
-
-%a stands for the author's name.
-%e stands for the author's email.
-%d stands for the date.
-%c will be replaced by information about Org/Emacs versions.
-%v will be replaced by `org-export-html-validation-link'.
-
-If you need to use a \"%\" character, you need to escape it
-like that: \"%%\"."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-html-home/up-format
- "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
- <a accesskey=\"h\" href=\"%s\"> UP </a>
- |
- <a accesskey=\"H\" href=\"%s\"> HOME </a>
-</div>"
- "Snippet used to insert the HOME and UP links.
-This is a format string, the first %s will receive the UP link,
-the second the HOME link. If both `org-export-html-link-up' and
-`org-export-html-link-home' are empty, the entire snippet will be
-ignored."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-toplevel-hlevel 2
- "The <H> level for level 1 headings in HTML export.
-This is also important for the classes that will be wrapped around headlines
-and outline structure. If this variable is 1, the top-level headlines will
-be <h1>, and the corresponding classes will be outline-1, section-number-1,
-and outline-text-1. If this is 2, all of these will get a 2 instead.
-The default for this variable is 2, because we use <h1> for formatting the
-document title."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-html-link-org-files-as-html t
- "Non-nil means make file links to `file.org' point to `file.html'.
-When org-mode is exporting an org-mode file to HTML, links to
-non-html files are directly put into a href tag in HTML.
-However, links to other Org-mode files (recognized by the
-extension `.org.) should become links to the corresponding html
-file, assuming that the linked org-mode file will also be
-converted to HTML.
-When nil, the links still point to the plain `.org' file."
- :group 'org-export-html
- :type 'boolean)
-
-(defcustom org-export-html-inline-images 'maybe
- "Non-nil means inline images into exported HTML pages.
-This is done using an <img> tag. When nil, an anchor with href is used to
-link to the image. If this option is `maybe', then images in links with
-an empty description will be inlined, while images with a description will
-be linked only."
- :group 'org-export-html
- :type '(choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "When there is no description" maybe)))
-
-(defcustom org-export-html-inline-image-extensions
- '("png" "jpeg" "jpg" "gif" "svg")
- "Extensions of image files that can be inlined into HTML."
- :group 'org-export-html
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-export-html-table-tag
- "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
- "The HTML tag that is used to start a table.
-This must be a <table> tag, but you may change the options like
-borders and spacing."
- :group 'org-export-html
- :type 'string)
-
-(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
- "The opening tag for table header fields.
-This is customizable so that alignment options can be specified.
-The first %s will be filled with the scope of the field, either row or col.
-The second %s will be replaced by a style entry to align the field.
-See also the variable `org-export-html-table-use-header-tags-for-first-column'.
-See also the variable `org-export-html-table-align-individual-fields'."
- :group 'org-export-tables
- :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
-
-(defcustom org-export-table-data-tags '("<td%s>" . "</td>")
- "The opening tag for table data fields.
-This is customizable so that alignment options can be specified.
-The first %s will be filled with the scope of the field, either row or col.
-The second %s will be replaced by a style entry to align the field.
-See also the variable `org-export-html-table-align-individual-fields'."
- :group 'org-export-tables
- :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
-
-(defcustom org-export-table-row-tags '("<tr>" . "</tr>")
- "The opening tag for table data fields.
-This is customizable so that alignment options can be specified.
-Instead of strings, these can be Lisp forms that will be evaluated
-for each row in order to construct the table row tags. During evaluation,
-the variable `head' will be true when this is a header line, nil when this
-is a body line. And the variable `nline' will contain the line number,
-starting from 1 in the first header line. For example
-
- (setq org-export-table-row-tags
- (cons '(if head
- \"<tr>\"
- (if (= (mod nline 2) 1)
- \"<tr class=\\\"tr-odd\\\">\"
- \"<tr class=\\\"tr-even\\\">\"))
- \"</tr>\"))
-
-will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
- :group 'org-export-tables
- :type '(cons
- (choice :tag "Opening tag"
- (string :tag "Specify")
- (sexp))
- (choice :tag "Closing tag"
- (string :tag "Specify")
- (sexp))))
-
-(defcustom org-export-html-table-align-individual-fields t
- "Non-nil means attach style attributes for alignment to each table field.
-When nil, alignment will only be specified in the column tags, but this
-is ignored by some browsers (like Firefox, Safari). Opera does it right
-though."
- :group 'org-export-tables
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-html-table-use-header-tags-for-first-column nil
- "Non-nil means format column one in tables with header tags.
-When nil, also column one will use data tags."
- :group 'org-export-tables
- :type 'boolean)
-
-(defcustom org-export-html-validation-link
- "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
- "Link to HTML validation service."
- :group 'org-export-html
- :type 'string)
-
-;; FIXME Obsolete since Org 7.7
-;; Use the :timestamp option or `org-export-time-stamp-file' instead
-(defvar org-export-html-with-timestamp nil
- "If non-nil, write container for HTML-helper-mode timestamp.")
-
-;; FIXME Obsolete since Org 7.7
-(defvar org-export-html-html-helper-timestamp
- "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n"
- "The HTML tag used as timestamp delimiter for HTML-helper-mode.")
-
-(defcustom org-export-html-protect-char-alist
- '(("&" . "&amp;")
- ("<" . "&lt;")
- (">" . "&gt;"))
- "Alist of characters to be converted by `org-html-protect'."
- :group 'org-export-html
- :version "24.1"
- :type '(repeat (cons (string :tag "Character")
- (string :tag "HTML equivalent"))))
-
-(defgroup org-export-htmlize nil
- "Options for processing examples with htmlize.el."
- :tag "Org Export Htmlize"
- :group 'org-export-html)
-
-(defcustom org-export-htmlize-output-type 'inline-css
- "Output type to be used by htmlize when formatting code snippets.
-Choices are `css', to export the CSS selectors only, or `inline-css', to
-export the CSS attribute values inline in the HTML. We use as default
-`inline-css', in order to make the resulting HTML self-containing.
-
-However, this will fail when using Emacs in batch mode for export, because
-then no rich font definitions are in place. It will also not be good if
-people with different Emacs setup contribute HTML files to a website,
-because the fonts will represent the individual setups. In these cases,
-it is much better to let Org/Htmlize assign classes only, and to use
-a style file to define the look of these classes.
-To get a start for your css file, start Emacs session and make sure that
-all the faces you are interested in are defined, for example by loading files
-in all modes you want. Then, use the command
-\\[org-export-htmlize-generate-css] to extract class definitions."
- :group 'org-export-htmlize
- :type '(choice (const css) (const inline-css)))
-
-(defcustom org-export-htmlize-css-font-prefix "org-"
- "The prefix for CSS class names for htmlize font specifications."
- :group 'org-export-htmlize
- :type 'string)
-
-(defcustom org-export-htmlized-org-css-url nil
- "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
-Normally when creating an htmlized version of an Org buffer, htmlize will
-create CSS to define the font colors. However, this does not work when
-converting in batch mode, and it also can look bad if different people
-with different fontification setup work on the same website.
-When this variable is non-nil, creating an htmlized version of an Org buffer
-using `org-export-as-org' will remove the internal CSS section and replace it
-with a link to this URL."
- :group 'org-export-htmlize
- :type '(choice
- (const :tag "Keep internal css" nil)
- (string :tag "URL or local href")))
-
-;; FIXME: The following variable is obsolete since Org 7.7 but is
-;; still declared and checked within code for compatibility reasons.
-;; Use the custom variables `org-export-html-divs' instead.
-(defvar org-export-html-content-div "content"
- "The name of the container DIV that holds all the page contents.
-
-This variable is obsolete since Org version 7.7.
-Please set `org-export-html-divs' instead.")
-
-(defcustom org-export-html-divs '("preamble" "content" "postamble")
- "The name of the main divs for HTML export.
-This is a list of three strings, the first one for the preamble
-DIV, the second one for the content DIV and the third one for the
-postamble DIV."
- :group 'org-export-html
- :version "24.1"
- :type '(list
- (string :tag " Div for the preamble:")
- (string :tag " Div for the content:")
- (string :tag "Div for the postamble:")))
-
-(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z"
- "Format string to format the date and time.
-
-The default is an extended format of the ISO 8601 specification."
- :group 'org-export-html
- :version "24.1"
- :type 'string)
-
-;;; Hooks
-
-(defvar org-export-html-after-blockquotes-hook nil
- "Hook run during HTML export, after blockquote, verse, center are done.")
-
-(defvar org-export-html-final-hook nil
- "Hook run at the end of HTML export, in the new buffer.")
-
-;;; HTML export
-
-(defun org-export-html-preprocess (parameters)
- "Convert LaTeX fragments to images."
- (when (and org-current-export-file
- (plist-get parameters :LaTeX-fragments))
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
- (file-name-nondirectory
- org-current-export-file)))
- org-current-export-dir nil "Creating LaTeX image %s"
- nil nil
- (cond
- ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
- ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
- ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
- ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick)
- ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng))))
- (goto-char (point-min))
- (let (label l1)
- (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
- (org-if-unprotected-at (match-beginning 1)
- (setq label (match-string 1))
- (save-match-data
- (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label)
- (setq l1 (substring label (match-beginning 1)))
- (setq l1 label)))
- (replace-match (format "[[#%s][%s]]" label l1) t t)))))
-
-;;;###autoload
-(defun org-export-as-html-and-open (arg)
- "Export the outline as HTML and immediately open it with a browser.
-If there is an active region, export only the region.
-The prefix ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will become bulleted lists."
- (interactive "P")
- (org-export-as-html arg)
- (org-open-file buffer-file-name)
- (when org-export-kill-product-buffer-when-displayed
- (kill-buffer (current-buffer))))
-
-;;;###autoload
-(defun org-export-as-html-batch ()
- "Call the function `org-export-as-html'.
-This function can be used in batch processing as:
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-export-as-html-batch"
- (org-export-as-html org-export-headline-levels))
-
-;;;###autoload
-(defun org-export-as-html-to-buffer (arg)
- "Call `org-export-as-html` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-html'."
- (interactive "P")
- (org-export-as-html arg nil "*Org HTML Export*")
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window "*Org HTML Export*")))
-
-;;;###autoload
-(defun org-replace-region-by-html (beg end)
- "Assume the current region has org-mode syntax, and convert it to HTML.
-This can be used in any buffer. For example, you could write an
-itemized list in org-mode syntax in an HTML buffer and then use this
-command to convert it."
- (interactive "r")
- (let (reg html buf pop-up-frames)
- (save-window-excursion
- (if (derived-mode-p 'org-mode)
- (setq html (org-export-region-as-html
- beg end t 'string))
- (setq reg (buffer-substring beg end)
- buf (get-buffer-create "*Org tmp*"))
- (with-current-buffer buf
- (erase-buffer)
- (insert reg)
- (org-mode)
- (setq html (org-export-region-as-html
- (point-min) (point-max) t 'string)))
- (kill-buffer buf)))
- (delete-region beg end)
- (insert html)))
-
-;;;###autoload
-(defun org-export-region-as-html (beg end &optional body-only buffer)
- "Convert region from BEG to END in org-mode buffer to HTML.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted HTML. If BUFFER is the symbol `string', return the
-produced HTML as a string and leave not buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq html (org-export-region-as-html beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer."
- (interactive "r\nP")
- (when (org-called-interactively-p 'any)
- (setq buffer "*Org HTML Export*"))
- (let ((transient-mark-mode t) (zmacs-regions t)
- ext-plist rtn)
- (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
- (goto-char end)
- (set-mark (point)) ;; to activate the region
- (goto-char beg)
- (setq rtn (org-export-as-html nil ext-plist buffer body-only))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (if (and (org-called-interactively-p 'any) (bufferp rtn))
- (switch-to-buffer-other-window rtn)
- rtn)))
-
-(defvar html-table-tag nil) ; dynamically scoped into this.
-(defvar org-par-open nil)
-
-;;; org-html-cvt-link-fn
-(defconst org-html-cvt-link-fn
- nil
- "Function to convert link URLs to exportable URLs.
-Takes two arguments, TYPE and PATH.
-Returns exportable url as (TYPE PATH), or nil to signal that it
-didn't handle this case.
-Intended to be locally bound around a call to `org-export-as-html'." )
-
-(defun org-html-cvt-org-as-html (opt-plist type path)
- "Convert an org filename to an equivalent html filename.
-If TYPE is not file, just return `nil'.
-See variable `org-export-html-link-org-files-as-html'"
-
- (save-match-data
- (and
- org-export-html-link-org-files-as-html
- (string= type "file")
- (string-match "\\.org$" path)
- (progn
- (list
- "file"
- (concat
- (substring path 0 (match-beginning 0))
- "."
- (plist-get opt-plist :html-extension)))))))
-
-
-;;; org-html-should-inline-p
-(defun org-html-should-inline-p (filename descp)
- "Return non-nil if link FILENAME should be inlined.
-The decision to inline the FILENAME link is based on the current
-settings. DESCP is the boolean of whether there was a link
-description. See variables `org-export-html-inline-images' and
-`org-export-html-inline-image-extensions'."
- (declare (special
- org-export-html-inline-images
- org-export-html-inline-image-extensions))
- (and (or (eq t org-export-html-inline-images)
- (and org-export-html-inline-images (not descp)))
- (org-file-image-p
- filename org-export-html-inline-image-extensions)))
-
-;;; org-html-make-link
-(defun org-html-make-link (opt-plist type path fragment desc attr
- may-inline-p)
- "Make an HTML link.
-OPT-PLIST is an options list.
-TYPE is the device-type of the link (THIS://foo.html).
-PATH is the path of the link (http://THIS#location).
-FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
-DESC is the link description, if any.
-ATTR is a string of other attributes of the \"a\" element.
-MAY-INLINE-P allows inlining it as an image."
-
- (declare (special org-par-open))
- (save-match-data
- (let* ((filename path)
- ;;First pass. Just sanity stuff.
- (components-1
- (cond
- ((string= type "file")
- (list
- type
- ;;Substitute just if original path was absolute.
- ;;(Otherwise path must remain relative)
- (if (file-name-absolute-p path)
- (concat "file://" (expand-file-name path))
- path)))
- ((string= type "")
- (list nil path))
- (t (list type path))))
-
- ;;Second pass. Components converted so they can refer
- ;;to a remote site.
- (components-2
- (or
- (and org-html-cvt-link-fn
- (apply org-html-cvt-link-fn
- opt-plist components-1))
- (apply #'org-html-cvt-org-as-html
- opt-plist components-1)
- components-1))
- (type (first components-2))
- (thefile (second components-2)))
-
-
- ;;Third pass. Build final link except for leading type
- ;;spec.
- (cond
- ((or
- (not type)
- (string= type "http")
- (string= type "https")
- (string= type "file")
- (string= type "coderef"))
- (if fragment
- (setq thefile (concat thefile "#" fragment))))
-
- (t))
-
- ;;Final URL-build, for all types.
- (setq thefile
- (let
- ((str (org-export-html-format-href thefile)))
- (if (and type (not (or (string= "file" type)
- (string= "coderef" type))))
- (concat type ":" str)
- str)))
-
- (if (and
- may-inline-p
- ;;Can't inline a URL with a fragment.
- (not fragment))
- (progn
- (message "image %s %s" thefile org-par-open)
- (org-export-html-format-image thefile org-par-open))
- (concat
- "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
- (org-export-html-format-desc desc)
- "</a>")))))
-
-(defun org-html-handle-links (org-line opt-plist)
- "Return ORG-LINE with markup of Org mode links.
-OPT-PLIST is the export options list."
- (let ((start 0)
- (current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
- (link-validate (plist-get opt-plist :link-validation-function))
- type id-file fnc
- rpl path attr desc descp desc1 desc2 link)
- (while (string-match org-bracket-link-analytic-regexp++ org-line start)
- (setq start (match-beginning 0))
- (setq path (save-match-data (org-link-unescape
- (match-string 3 org-line))))
- (setq type (cond
- ((match-end 2) (match-string 2 org-line))
- ((save-match-data
- (or (file-name-absolute-p path)
- (string-match "^\\.\\.?/" path)))
- "file")
- (t "internal")))
- (setq path (org-extract-attributes path))
- (setq attr (get-text-property 0 'org-attributes path))
- (setq desc1 (if (match-end 5) (match-string 5 org-line))
- desc2 (if (match-end 2) (concat type ":" path) path)
- descp (and desc1 (not (equal desc1 desc2)))
- desc (or desc1 desc2))
- ;; Make an image out of the description if that is so wanted
- (when (and descp (org-file-image-p
- desc org-export-html-inline-image-extensions))
- (save-match-data
- (if (string-match "^file:" desc)
- (setq desc (substring desc (match-end 0)))))
- (setq desc (org-add-props
- (concat "<img src=\"" desc "\" "
- (when (save-match-data (string-match "width=" attr))
- (prog1 (concat attr " ") (setq attr "")))
- "alt=\""
- (file-name-nondirectory desc) "\"/>")
- '(org-protected t))))
- (cond
- ((equal type "internal")
- (let
- ((frag-0
- (if (= (string-to-char path) ?#)
- (substring path 1)
- path)))
- (setq rpl
- (org-html-make-link
- opt-plist
- ""
- ""
- (org-solidify-link-text
- (save-match-data (org-link-unescape frag-0))
- nil)
- desc attr nil))))
- ((and (equal type "id")
- (setq id-file (org-id-find-id-file path)))
- ;; This is an id: link to another file (if it was the same file,
- ;; it would have become an internal link...)
- (save-match-data
- (setq id-file (file-relative-name
- id-file
- (file-name-directory org-current-export-file)))
- (setq rpl
- (org-html-make-link opt-plist
- "file" id-file
- (concat (if (org-uuidgen-p path) "ID-") path)
- desc
- attr
- nil))))
- ((member type '("http" "https"))
- ;; standard URL, can inline as image
- (setq rpl
- (org-html-make-link opt-plist
- type path nil
- desc
- attr
- (org-html-should-inline-p path descp))))
- ((member type '("ftp" "mailto" "news"))
- ;; standard URL, can't inline as image
- (setq rpl
- (org-html-make-link opt-plist
- type path nil
- desc
- attr
- nil)))
-
- ((string= type "coderef")
- (let*
- ((coderef-str (format "coderef-%s" path))
- (attr-1
- (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
- coderef-str coderef-str)))
- (setq rpl
- (org-html-make-link opt-plist
- type "" coderef-str
- (format
- (org-export-get-coderef-format
- path
- (and descp desc))
- (cdr (assoc path org-export-code-refs)))
- attr-1
- nil))))
-
- ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- ;; The link protocol has a function for format the link
- (setq rpl
- (save-match-data
- (funcall fnc (org-link-unescape path) desc1 'html))))
-
- ((string= type "file")
- ;; FILE link
- (save-match-data
- (let*
- ((components
- (if
- (string-match "::\\(.*\\)" path)
- (list
- (replace-match "" t nil path)
- (match-string 1 path))
- (list path nil)))
-
- ;;The proper path, without a fragment
- (path-1
- (first components))
-
- ;;The raw fragment
- (fragment-0
- (second components))
-
- ;;Check the fragment. If it can't be used as
- ;;target fragment we'll pass nil instead.
- (fragment-1
- (if
- (and fragment-0
- (not (string-match "^[0-9]*$" fragment-0))
- (not (string-match "^\\*" fragment-0))
- (not (string-match "^/.*/$" fragment-0)))
- (org-solidify-link-text
- (org-link-unescape fragment-0))
- nil))
- (desc-2
- ;;Description minus "file:" and ".org"
- (if (string-match "^file:" desc)
- (let
- ((desc-1 (replace-match "" t t desc)))
- (if (string-match "\\.org$" desc-1)
- (replace-match "" t t desc-1)
- desc-1))
- desc)))
-
- (setq rpl
- (if
- (and
- (functionp link-validate)
- (not (funcall link-validate path-1 current-dir)))
- desc
- (org-html-make-link opt-plist
- "file" path-1 fragment-1 desc-2 attr
- (org-html-should-inline-p path-1 descp)))))))
-
- (t
- ;; just publish the path, as default
- (setq rpl (concat "<i>&lt;" type ":"
- (save-match-data (org-link-unescape path))
- "&gt;</i>"))))
- (setq org-line (replace-match rpl t t org-line)
- start (+ start (length rpl))))
- org-line))
-
-;;; org-export-as-html
-
-(defvar org-heading-keyword-regexp-format) ; defined in org.el
-
-;;;###autoload
-(defun org-export-as-html (arg &optional ext-plist to-buffer body-only pub-dir)
- "Export the outline as a pretty HTML file.
-If there is an active region, export only the region. The prefix
-ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will become bulleted
-lists. EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When TO-BUFFER is non-nil, create a buffer with that
-name and export to that buffer. If TO-BUFFER is the symbol
-`string', don't leave any buffer behind but just return the
-resulting HTML as a string. When BODY-ONLY is set, don't produce
-the file header and footer, simply return the content of
-<body>...</body>, without even the body tags themselves. When
-PUB-DIR is set, use this as the publishing directory."
- (interactive "P")
- (run-hooks 'org-export-first-hook)
-
- ;; Make sure we have a file name when we need it.
- (when (and (not (or to-buffer body-only))
- (not buffer-file-name))
- (if (buffer-base-buffer)
- (org-set-local 'buffer-file-name
- (with-current-buffer (buffer-base-buffer)
- buffer-file-name))
- (error "Need a file name to be able to export")))
-
- (message "Exporting...")
- (setq-default org-todo-line-regexp org-todo-line-regexp)
- (setq-default org-deadline-line-regexp org-deadline-line-regexp)
- (setq-default org-done-keywords org-done-keywords)
- (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
- (let* ((opt-plist
- (org-export-process-option-filters
- (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist))))
- (body-only (or body-only (plist-get opt-plist :body-only)))
- (style (concat (if (plist-get opt-plist :style-include-default)
- org-export-html-style-default)
- (plist-get opt-plist :style)
- (plist-get opt-plist :style-extra)
- "\n"
- (if (plist-get opt-plist :style-include-scripts)
- org-export-html-scripts)))
- (html-extension (plist-get opt-plist :html-extension))
- valid thetoc have-headings first-heading-pos
- (odd org-odd-levels-only)
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (level-offset (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (+ (funcall outline-level)
- (if org-odd-levels-only 1 0)))
- 0))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- ;; The following two are dynamically scoped into other
- ;; routines below.
- (org-current-export-dir
- (or pub-dir (org-export-directory :html opt-plist)))
- (org-current-export-file buffer-file-name)
- (level 0) (org-line "") (origline "") txt todo
- (umax nil)
- (umax-toc nil)
- (filename (if to-buffer nil
- (expand-file-name
- (concat
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory buffer-file-name)))
- "." html-extension)
- (file-name-as-directory
- (or pub-dir (org-export-directory :html opt-plist))))))
- (current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
- (auto-insert nil); Avoid any auto-insert stuff for the new file
- (buffer (if to-buffer
- (cond
- ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
- (t (get-buffer-create to-buffer)))
- (find-file-noselect filename)))
- (org-levels-open (make-vector org-level-max nil))
- (date (org-html-expand (plist-get opt-plist :date)))
- (author (org-html-expand (plist-get opt-plist :author)))
- (html-validation-link (or org-export-html-validation-link ""))
- (title (org-html-expand
- (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not body-only)
- (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name)))
- "UNTITLED")))
- (link-up (and (plist-get opt-plist :link-up)
- (string-match "\\S-" (plist-get opt-plist :link-up))
- (plist-get opt-plist :link-up)))
- (link-home (and (plist-get opt-plist :link-home)
- (string-match "\\S-" (plist-get opt-plist :link-home))
- (plist-get opt-plist :link-home)))
- (dummy (setq opt-plist (plist-put opt-plist :title title)))
- (html-table-tag (plist-get opt-plist :html-table-tag))
- (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
- (quote-re (format org-heading-keyword-regexp-format
- org-quote-string))
- (inquote nil)
- (infixed nil)
- (inverse nil)
- (email (plist-get opt-plist :email))
- (language (plist-get opt-plist :language))
- (keywords (org-html-expand (plist-get opt-plist :keywords)))
- (description (org-html-expand (plist-get opt-plist :description)))
- (num (plist-get opt-plist :section-numbers))
- (lang-words nil)
- (head-count 0) cnt
- (start 0)
- (coding-system (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system))
- (coding-system-for-write (or org-export-html-coding-system
- coding-system))
- (save-buffer-coding-system (or org-export-html-coding-system
- coding-system))
- (charset (and coding-system-for-write
- (fboundp 'coding-system-get)
- (coding-system-get coding-system-for-write
- 'mime-charset)))
- (region
- (buffer-substring
- (if region-p (region-beginning) (point-min))
- (if region-p (region-end) (point-max))))
- (org-export-have-math nil)
- (org-export-footnotes-seen nil)
- (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
- (custom-id (or (org-entry-get nil "CUSTOM_ID" t) ""))
- (footnote-def-prefix (format "fn-%s" custom-id))
- (footnote-ref-prefix (format "fnr-%s" custom-id))
- (lines
- (org-split-string
- (org-export-preprocess-string
- region
- :emph-multiline t
- :for-backend 'html
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get opt-plist :drawers)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :timestamps (plist-get opt-plist :timestamps)
- :archived-trees
- (plist-get opt-plist :archived-trees)
- :select-tags (plist-get opt-plist :select-tags)
- :exclude-tags (plist-get opt-plist :exclude-tags)
- :add-text
- (plist-get opt-plist :text)
- :LaTeX-fragments
- (plist-get opt-plist :LaTeX-fragments))
- "[\r\n]"))
- (mathjax
- (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax)
- (and org-export-have-math
- (eq (plist-get opt-plist :LaTeX-fragments) t)))
-
- (org-export-html-mathjax-config
- org-export-html-mathjax-template
- org-export-html-mathjax-options
- (or (plist-get opt-plist :mathjax) ""))
- ""))
- table-open
- table-buffer table-orig-buffer
- ind
- rpl path attr desc descp desc1 desc2 link
- snumber fnc
- footnotes footref-seen
- href)
-
- (let ((inhibit-read-only t))
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill t))))
-
- (message "Exporting...")
-
- (setq org-min-level (org-get-min-level lines level-offset))
- (setq org-last-level org-min-level)
- (org-init-section-numbers)
-
- (cond
- ((and date (string-match "%" date))
- (setq date (format-time-string date)))
- (date)
- (t (setq date (format-time-string org-export-html-date-format-string))))
-
- ;; Get the language-dependent settings
- (setq lang-words (or (assoc language org-export-language-setup)
- (assoc "en" org-export-language-setup)))
-
- ;; Switch to the output buffer
- (set-buffer buffer)
- (let ((inhibit-read-only t)) (erase-buffer))
- (fundamental-mode)
- (org-install-letbind)
-
- (and (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system coding-system-for-write))
-
- (let ((case-fold-search nil)
- (org-odd-levels-only odd))
- ;; create local variables for all options, to make sure all called
- ;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
- (setq umax (if arg (prefix-numeric-value arg)
- org-export-headline-levels))
- (setq umax-toc (if (integerp org-export-with-toc)
- (min org-export-with-toc umax)
- umax))
- (unless body-only
- ;; File header
- (insert (format
- "%s
-<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
- \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
-<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">
-<head>
-<title>%s</title>
-<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
-<meta name=\"title\" content=\"%s\"/>
-<meta name=\"generator\" content=\"Org-mode\"/>
-<meta name=\"generated\" content=\"%s\"/>
-<meta name=\"author\" content=\"%s\"/>
-<meta name=\"description\" content=\"%s\"/>
-<meta name=\"keywords\" content=\"%s\"/>
-%s
-%s
-</head>
-<body>
-%s
-"
- (format
- (or (and (stringp org-export-html-xml-declaration)
- org-export-html-xml-declaration)
- (cdr (assoc html-extension org-export-html-xml-declaration))
- (cdr (assoc "html" org-export-html-xml-declaration))
-
- "")
- (or charset "iso-8859-1"))
- language language
- title
- (or charset "iso-8859-1")
- title date author description keywords
- style
- mathjax
- (if (or link-up link-home)
- (concat
- (format org-export-html-home/up-format
- (or link-up link-home)
- (or link-home link-up))
- "\n")
- "")))
-
- ;; insert html preamble
- (when (plist-get opt-plist :html-preamble)
- (let ((html-pre (plist-get opt-plist :html-preamble))
- (html-pre-real-contents ""))
- (cond ((stringp html-pre)
- (setq html-pre-real-contents
- (format-spec html-pre `((?t . ,title) (?a . ,author)
- (?d . ,date) (?e . ,email)))))
- ((functionp html-pre)
- (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
- (if (stringp (funcall html-pre)) (insert (funcall html-pre)))
- (insert "\n</div>\n"))
- (t
- (setq html-pre-real-contents
- (format-spec
- (or (cadr (assoc (nth 0 lang-words)
- org-export-html-preamble-format))
- (cadr (assoc "en" org-export-html-preamble-format)))
- `((?t . ,title) (?a . ,author)
- (?d . ,date) (?e . ,email))))))
- ;; don't output an empty preamble DIV
- (unless (and (functionp html-pre)
- (equal html-pre-real-contents ""))
- (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
- (insert html-pre-real-contents)
- (insert "\n</div>\n"))))
-
- ;; begin wrap around body
- (insert (format "\n<div id=\"%s\">"
- ;; FIXME org-export-html-content-div is obsolete since 7.7
- (or org-export-html-content-div
- (nth 1 org-export-html-divs)))
- ;; FIXME this should go in the preamble but is here so
- ;; that org-infojs can still find it
- "\n<h1 class=\"title\">" title "</h1>\n"))
-
- ;; insert body
- (if org-export-with-toc
- (progn
- (push (format "<h%d>%s</h%d>\n"
- org-export-html-toplevel-hlevel
- (nth 3 lang-words)
- org-export-html-toplevel-hlevel)
- thetoc)
- (push "<div id=\"text-table-of-contents\">\n" thetoc)
- (push "<ul>\n<li>" thetoc)
- (setq lines
- (mapcar
- #'(lambda (org-line)
- (if (and (string-match org-todo-line-regexp org-line)
- (not (get-text-property 0 'org-protected org-line)))
- ;; This is a headline
- (progn
- (setq have-headings t)
- (setq level (- (match-end 1) (match-beginning 1)
- level-offset)
- level (org-tr-level level)
- txt (save-match-data
- (org-html-expand
- (org-export-cleanup-toc-line
- (match-string 3 org-line))))
- todo
- (or (and org-export-mark-todo-in-toc
- (match-beginning 2)
- (not (member (match-string 2 org-line)
- org-done-keywords)))
- ; TODO, not DONE
- (and org-export-mark-todo-in-toc
- (= level umax-toc)
- (org-search-todo-below
- org-line lines level))))
- (if (string-match
- (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
- (setq txt (replace-match
- "&nbsp;&nbsp;&nbsp;<span class=\"tag\">\\1</span>" t nil txt)))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
- (setq snumber (org-section-number level))
- (if (and num (if (integerp num)
- (>= num level)
- num))
- (setq txt (concat snumber " " txt)))
- (if (<= level (max umax umax-toc))
- (setq head-count (+ head-count 1)))
- (if (<= level umax-toc)
- (progn
- (if (> level org-last-level)
- (progn
- (setq cnt (- level org-last-level))
- (while (>= (setq cnt (1- cnt)) 0)
- (push "\n<ul>\n<li>" thetoc))
- (push "\n" thetoc)))
- (if (< level org-last-level)
- (progn
- (setq cnt (- org-last-level level))
- (while (>= (setq cnt (1- cnt)) 0)
- (push "</li>\n</ul>" thetoc))
- (push "\n" thetoc)))
- ;; Check for targets
- (while (string-match org-any-target-regexp org-line)
- (setq org-line (replace-match
- (concat "@<span class=\"target\">"
- (match-string 1 org-line) "@</span> ")
- t t org-line)))
- (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
- (setq txt (replace-match "" t t txt)))
- (setq href
- (replace-regexp-in-string
- "\\." "-" (format "sec-%s" snumber)))
- (setq href (org-solidify-link-text
- (or (cdr (assoc href
- org-export-preferred-target-alist)) href)))
- (push
- (format
- (if todo
- "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
- "</li>\n<li><a href=\"#%s\">%s</a>")
- href txt) thetoc)
-
- (setq org-last-level level)))))
- org-line)
- lines))
- (while (> org-last-level (1- org-min-level))
- (setq org-last-level (1- org-last-level))
- (push "</li>\n</ul>\n" thetoc))
- (push "</div>\n" thetoc)
- (setq thetoc (if have-headings (nreverse thetoc) nil))))
-
- (setq head-count 0)
- (org-init-section-numbers)
-
- (org-open-par)
-
- (while (setq org-line (pop lines) origline org-line)
- (catch 'nextline
-
- ;; end of quote section?
- (when (and inquote (string-match org-outline-regexp-bol org-line))
- (insert "</pre>\n")
- (org-open-par)
- (setq inquote nil))
- ;; inside a quote section?
- (when inquote
- (insert (org-html-protect org-line) "\n")
- (throw 'nextline nil))
-
- ;; Fixed-width, verbatim lines (examples)
- (when (and org-export-with-fixed-width
- (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line))
- (when (not infixed)
- (setq infixed t)
- (org-close-par-maybe)
-
- (insert "<pre class=\"example\">\n"))
- (insert (org-html-protect (match-string 3 org-line)) "\n")
- (when (or (not lines)
- (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
- (car lines))))
- (setq infixed nil)
- (insert "</pre>\n")
- (org-open-par))
- (throw 'nextline nil))
-
- ;; Protected HTML
- (when (and (get-text-property 0 'org-protected org-line)
- ;; Make sure it is the entire line that is protected
- (not (< (or (next-single-property-change
- 0 'org-protected org-line) 10000)
- (length org-line))))
- (let (par (ind (get-text-property 0 'original-indentation org-line)))
- (when (re-search-backward
- "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
- (setq par (match-string 1))
- (replace-match "\\2\n"))
- (insert org-line "\n")
- (while (and lines
- (or (= (length (car lines)) 0)
- (not ind)
- (equal ind (get-text-property 0 'original-indentation (car lines))))
- (or (= (length (car lines)) 0)
- (get-text-property 0 'org-protected (car lines))))
- (insert (pop lines) "\n"))
- (and par (insert "<p>\n")))
- (throw 'nextline nil))
-
- ;; Blockquotes, verse, and center
- (when (equal "ORG-BLOCKQUOTE-START" org-line)
- (org-close-par-maybe)
- (insert "<blockquote>\n")
- (org-open-par)
- (throw 'nextline nil))
- (when (equal "ORG-BLOCKQUOTE-END" org-line)
- (org-close-par-maybe)
- (insert "\n</blockquote>\n")
- (org-open-par)
- (throw 'nextline nil))
- (when (equal "ORG-VERSE-START" org-line)
- (org-close-par-maybe)
- (insert "\n<p class=\"verse\">\n")
- (setq org-par-open t)
- (setq inverse t)
- (throw 'nextline nil))
- (when (equal "ORG-VERSE-END" org-line)
- (insert "</p>\n")
- (setq org-par-open nil)
- (org-open-par)
- (setq inverse nil)
- (throw 'nextline nil))
- (when (equal "ORG-CENTER-START" org-line)
- (org-close-par-maybe)
- (insert "\n<div style=\"text-align: center\">")
- (org-open-par)
- (throw 'nextline nil))
- (when (equal "ORG-CENTER-END" org-line)
- (org-close-par-maybe)
- (insert "\n</div>")
- (org-open-par)
- (throw 'nextline nil))
- (run-hooks 'org-export-html-after-blockquotes-hook)
- (when inverse
- (let ((i (org-get-string-indentation org-line)))
- (if (> i 0)
- (setq org-line (concat (mapconcat 'identity
- (make-list (* 2 i) "\\nbsp") "")
- " " (org-trim org-line))))
- (unless (string-match "\\\\\\\\[ \t]*$" org-line)
- (setq org-line (concat org-line "\\\\")))))
-
- ;; make targets to anchors
- (setq start 0)
- (while (string-match
- "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start)
- (cond
- ((get-text-property (match-beginning 1) 'org-protected org-line)
- (setq start (match-end 1)))
- ((match-end 2)
- (setq org-line (replace-match
- (format
- "@<a name=\"%s\" id=\"%s\">@</a>"
- (org-solidify-link-text (match-string 1 org-line))
- (org-solidify-link-text (match-string 1 org-line)))
- t t org-line)))
- ((and org-export-with-toc (equal (string-to-char org-line) ?*))
- ;; FIXME: NOT DEPENDENT on TOC?????????????????????
- (setq org-line (replace-match
- (concat "@<span class=\"target\">"
- (match-string 1 org-line) "@</span> ")
- ;; (concat "@<i>" (match-string 1 org-line) "@</i> ")
- t t org-line)))
- (t
- (setq org-line (replace-match
- (concat "@<a name=\""
- (org-solidify-link-text (match-string 1 org-line))
- "\" class=\"target\">" (match-string 1 org-line)
- "@</a> ")
- t t org-line)))))
-
- (setq org-line (org-html-handle-time-stamps org-line))
-
- ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
- ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
- ;; Also handle sub_superscripts and checkboxes
- (or (string-match org-table-hline-regexp org-line)
- (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line)
- (setq org-line (org-html-expand org-line)))
-
- ;; Format the links
- (setq org-line (org-html-handle-links org-line opt-plist))
-
- ;; TODO items
- (if (and org-todo-line-regexp
- (string-match org-todo-line-regexp org-line)
- (match-beginning 2))
-
- (setq org-line
- (concat (substring org-line 0 (match-beginning 2))
- "<span class=\""
- (if (member (match-string 2 org-line)
- org-done-keywords)
- "done" "todo")
- " " (org-export-html-get-todo-kwd-class-name
- (match-string 2 org-line))
- "\">" (match-string 2 org-line)
- "</span>" (substring org-line (match-end 2)))))
-
- ;; Does this contain a reference to a footnote?
- (when org-export-with-footnotes
- (setq start 0)
- (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start)
- ;; Discard protected matches not clearly identified as
- ;; footnote markers.
- (if (or (get-text-property (match-beginning 2) 'org-protected org-line)
- (not (get-text-property (match-beginning 2) 'org-footnote org-line)))
- (setq start (match-end 2))
- (let ((n (match-string 2 org-line)) extra a)
- (if (setq a (assoc n footref-seen))
- (progn
- (setcdr a (1+ (cdr a)))
- (setq extra (format ".%d" (cdr a))))
- (setq extra "")
- (push (cons n 1) footref-seen))
- (setq org-line
- (replace-match
- (concat
- (format
- (concat "%s"
- (format org-export-html-footnote-format
- (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>")))
- (or (match-string 1 org-line) "") n extra n n)
- ;; If another footnote is following the
- ;; current one, add a separator.
- (if (save-match-data
- (string-match "\\`\\[[0-9]+\\]"
- (substring org-line (match-end 0))))
- org-export-html-footnote-separator
- ""))
- t t org-line))))))
-
- (cond
- ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line)
- ;; This is a headline
- (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
- level-offset))
- txt (or (match-string 2 org-line) ""))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
- (if (<= level (max umax umax-toc))
- (setq head-count (+ head-count 1)))
- (setq first-heading-pos (or first-heading-pos (point)))
- (org-html-level-start level txt umax
- (and org-export-with-toc (<= level umax))
- head-count opt-plist)
-
- ;; QUOTES
- (when (string-match quote-re org-line)
- (org-close-par-maybe)
- (insert "<pre>")
- (setq inquote t)))
-
- ((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
- (when (not table-open)
- ;; New table starts
- (setq table-open t table-buffer nil table-orig-buffer nil))
-
- ;; Accumulate lines
- (setq table-buffer (cons org-line table-buffer)
- table-orig-buffer (cons origline table-orig-buffer))
- (when (or (not lines)
- (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
- (car lines))))
- (setq table-open nil
- table-buffer (nreverse table-buffer)
- table-orig-buffer (nreverse table-orig-buffer))
- (org-close-par-maybe)
- (insert (org-format-table-html table-buffer table-orig-buffer))))
-
- ;; Normal lines
-
- (t
- ;; This line either is list item or end a list.
- (when (get-text-property 0 'list-item org-line)
- (setq org-line (org-html-export-list-line
- org-line
- (get-text-property 0 'list-item org-line)
- (get-text-property 0 'list-struct org-line)
- (get-text-property 0 'list-prevs org-line))))
-
- ;; Horizontal line
- (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
- (if org-par-open
- (insert "\n</p>\n<hr/>\n<p>\n")
- (insert "\n<hr/>\n"))
- (throw 'nextline nil))
-
- ;; Empty lines start a new paragraph. If hand-formatted lists
- ;; are not fully interpreted, lines starting with "-", "+", "*"
- ;; also start a new paragraph.
- (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par))
-
- ;; Is this the start of a footnote?
- (when org-export-with-footnotes
- (when (and (boundp 'footnote-section-tag-regexp)
- (string-match (concat "^" footnote-section-tag-regexp)
- org-line))
- ;; ignore this line
- (throw 'nextline nil))
- (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line)
- (org-close-par-maybe)
- (let ((n (match-string 1 org-line)))
- (setq org-par-open t
- org-line (replace-match
- (format
- (concat "<p class=\"footnote\">"
- (format org-export-html-footnote-format
- (concat
- "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>")))
- n n n) t t org-line)))))
- ;; Check if the line break needs to be conserved
- (cond
- ((string-match "\\\\\\\\[ \t]*$" org-line)
- (setq org-line (replace-match "<br/>" t t org-line)))
- (org-export-preserve-breaks
- (setq org-line (concat org-line "<br/>"))))
-
- ;; Check if a paragraph should be started
- (let ((start 0))
- (while (and org-par-open
- (string-match "\\\\par\\>" org-line start))
- ;; Leave a space in the </p> so that the footnote matcher
- ;; does not see this.
- (if (not (get-text-property (match-beginning 0)
- 'org-protected org-line))
- (setq org-line (replace-match "</p ><p >" t t org-line)))
- (setq start (match-end 0))))
-
- (insert org-line "\n")))))
-
- ;; Properly close all local lists and other lists
- (when inquote
- (insert "</pre>\n")
- (org-open-par))
-
- (org-html-level-start 1 nil umax
- (and org-export-with-toc (<= level umax))
- head-count opt-plist)
- ;; the </div> to close the last text-... div.
- (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
-
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
- nil t)
- (push (match-string 1) footnotes)
- (replace-match "\\4" t nil)
- (goto-char (match-beginning 0))))
- (when footnotes
- (insert (format org-export-html-footnotes-section
- (nth 4 lang-words)
- (mapconcat 'identity (nreverse footnotes) "\n"))
- "\n"))
- (let ((bib (org-export-html-get-bibliography)))
- (when bib
- (insert "\n" bib "\n")))
-
- (unless body-only
- ;; end wrap around body
- (insert "</div>\n")
-
- ;; export html postamble
- (let ((html-post (plist-get opt-plist :html-postamble))
- (email
- (mapconcat (lambda(e)
- (format "<a href=\"mailto:%s\">%s</a>" e e))
- (split-string email ",+ *")
- ", "))
- (creator-info
- (concat "<a href=\"http://orgmode.org\">Org</a> version "
- (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
- (number-to-string emacs-major-version))))
-
- (when (plist-get opt-plist :html-postamble)
- (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n")
- (cond ((stringp html-post)
- (insert (format-spec html-post
- `((?a . ,author) (?e . ,email)
- (?d . ,date) (?c . ,creator-info)
- (?v . ,html-validation-link)))))
- ((functionp html-post)
- (if (stringp (funcall html-post)) (insert (funcall html-post))))
- ((eq html-post 'auto)
- ;; fall back on default postamble
- (when (plist-get opt-plist :time-stamp-file)
- (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
- (when (and (plist-get opt-plist :author-info) author)
- (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
- (when (and (plist-get opt-plist :email-info) email)
- (insert "<p class=\"email\">" email "</p>\n"))
- (when (plist-get opt-plist :creator-info)
- (insert "<p class=\"creator\">"
- (concat "<a href=\"http://orgmode.org\">Org</a> version "
- (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version "
- (number-to-string emacs-major-version) "</p>\n")))
- (insert html-validation-link "\n"))
- (t
- (insert (format-spec
- (or (cadr (assoc (nth 0 lang-words)
- org-export-html-postamble-format))
- (cadr (assoc "en" org-export-html-postamble-format)))
- `((?a . ,author) (?e . ,email)
- (?d . ,date) (?c . ,creator-info)
- (?v . ,html-validation-link))))))
- (insert "\n</div>"))))
-
- ;; FIXME `org-export-html-with-timestamp' has been declared
- ;; obsolete since Org 7.7 -- don't forget to remove this.
- (if org-export-html-with-timestamp
- (insert org-export-html-html-helper-timestamp))
-
- (unless body-only (insert "\n</body>\n</html>\n"))
-
- (unless (plist-get opt-plist :buffer-will-be-killed)
- (normal-mode)
- (if (eq major-mode (default-value 'major-mode))
- (html-mode)))
-
- ;; insert the table of contents
- (goto-char (point-min))
- (when thetoc
- (if (or (re-search-forward
- "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
- (re-search-forward
- "\\[TABLE-OF-CONTENTS\\]" nil t))
- (progn
- (goto-char (match-beginning 0))
- (replace-match ""))
- (goto-char first-heading-pos)
- (when (looking-at "\\s-*</p>")
- (goto-char (match-end 0))
- (insert "\n")))
- (insert "<div id=\"table-of-contents\">\n")
- (let ((beg (point)))
- (mapc 'insert thetoc)
- (insert "</div>\n")
- (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t)
- (replace-match ""))))
- ;; remove empty paragraphs
- (goto-char (point-min))
- (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
- (replace-match ""))
- (goto-char (point-min))
- ;; Convert whitespace place holders
- (goto-char (point-min))
- (let (beg end n)
- (while (setq beg (next-single-property-change (point) 'org-whitespace))
- (setq n (get-text-property beg 'org-whitespace)
- end (next-single-property-change beg 'org-whitespace))
- (goto-char beg)
- (delete-region beg end)
- (insert (format "<span style=\"visibility:hidden;\">%s</span>"
- (make-string n ?x)))))
- ;; Remove empty lines at the beginning of the file.
- (goto-char (point-min))
- (when (looking-at "\\s-+\n") (replace-match ""))
- ;; Remove display properties
- (remove-text-properties (point-min) (point-max) '(display t))
- ;; Run the hook
- (run-hooks 'org-export-html-final-hook)
- (or to-buffer (save-buffer))
- (goto-char (point-min))
- (or (org-export-push-to-kill-ring "HTML")
- (message "Exporting... done"))
- (if (eq to-buffer 'string)
- (prog1 (buffer-substring (point-min) (point-max))
- (kill-buffer (current-buffer)))
- (current-buffer)))))
-
-(defun org-export-html-format-href (s)
- "Make sure the S is valid as a href reference in an XHTML document."
- (save-match-data
- (let ((start 0))
- (while (string-match "&" s start)
- (setq start (+ (match-beginning 0) 3)
- s (replace-match "&amp;" t t s)))))
- s)
-
-(defun org-export-html-format-desc (s)
- "Make sure the S is valid as a description in a link."
- (if (and s (not (get-text-property 1 'org-protected s)))
- (save-match-data
- (org-html-do-expand s))
- s))
-
-(defun org-export-html-format-image (src par-open)
- "Create image tag with source and attributes."
- (save-match-data
- (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src)
- (format "<img src=\"%s\" alt=\"%s\"/>"
- src (org-find-text-property-in-string 'org-latex-src src))
- (let* ((caption (org-find-text-property-in-string 'org-caption src))
- (attr (org-find-text-property-in-string 'org-attributes src))
- (label (org-find-text-property-in-string 'org-label src)))
- (setq caption (and caption (org-html-do-expand caption)))
- (concat
- (if caption
- (format "%s<div %sclass=\"figure\">
-<p>"
- (if org-par-open "</p>\n" "")
- (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
- (format "<img src=\"%s\"%s />"
- src
- (if (string-match "\\<alt=" (or attr ""))
- (concat " " attr )
- (concat " " attr " alt=\"" src "\"")))
- (if caption
- (format "</p>%s
-</div>%s"
- (concat "\n<p>" caption "</p>")
- (if org-par-open "\n<p>" ""))))))))
-
-(defun org-export-html-get-bibliography ()
- "Find bibliography, cut it out and return it."
- (catch 'exit
- (let (beg end (cnt 1) bib)
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
- (setq beg (match-beginning 0))
- (while (re-search-forward "</?div\\>" nil t)
- (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
- (when (= cnt 0)
- (and (looking-at ">") (forward-char 1))
- (setq bib (buffer-substring beg (point)))
- (delete-region beg (point))
- (throw 'exit bib))))
- nil))))
-
-(defvar org-table-number-regexp) ; defined in org-table.el
-(defun org-format-table-html (lines olines &optional no-css)
- "Find out which HTML converter to use and return the HTML code.
-NO-CSS is passed to the exporter."
- (if (stringp lines)
- (setq lines (org-split-string lines "\n")))
- (if (string-match "^[ \t]*|" (car lines))
- ;; A normal org table
- (org-format-org-table-html lines nil no-css)
- ;; Table made by table.el
- (or (org-format-table-table-html-using-table-generate-source
- olines (not org-export-prefer-native-exporter-for-tables))
- ;; We are here only when table.el table has NO col or row
- ;; spanning and the user prefers using org's own converter for
- ;; exporting of such simple table.el tables.
- (org-format-table-table-html lines))))
-
-(defvar org-table-number-fraction) ; defined in org-table.el
-(defun org-format-org-table-html (lines &optional splice no-css)
- "Format a table into HTML.
-LINES is a list of lines. Optional argument SPLICE means, do not
-insert header and surrounding <table> tags, just format the lines.
-Optional argument NO-CSS means use XHTML attributes instead of CSS
-for formatting. This is required for the DocBook exporter."
- (require 'org-table)
- ;; Get rid of hlines at beginning and end
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (when org-export-table-remove-special-lines
- ;; Check if the table has a marking column. If yes remove the
- ;; column and the special lines
- (setq lines (org-table-clean-before-export lines)))
-
- (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
- (label (org-find-text-property-in-string 'org-label (car lines)))
- (col-cookies (org-find-text-property-in-string 'org-col-cookies
- (car lines)))
- (attributes (org-find-text-property-in-string 'org-attributes
- (car lines)))
- (html-table-tag (org-export-splice-attributes
- html-table-tag attributes))
- (head (and org-export-highlight-first-table-line
- (delq nil (mapcar
- (lambda (x) (string-match "^[ \t]*|-" x))
- (cdr lines)))))
- (nline 0) fnum nfields i (cnt 0)
- tbopen org-line fields html gr colgropen rowstart rowend
- ali align aligns n)
- (setq caption (and caption (org-html-do-expand caption)))
- (when (and col-cookies org-table-clean-did-remove-column)
- (setq col-cookies
- (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
- (if splice (setq head nil))
- (unless splice (push (if head "<thead>" "<tbody>") html))
- (setq tbopen t)
- (while (setq org-line (pop lines))
- (catch 'next-line
- (if (string-match "^[ \t]*|-" org-line)
- (progn
- (unless splice
- (push (if head "</thead>" "</tbody>") html)
- (if lines (push "<tbody>" html) (setq tbopen nil)))
- (setq head nil) ;; head ends here, first time around
- ;; ignore this line
- (throw 'next-line t)))
- ;; Break the line into fields
- (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
- (unless fnum (setq fnum (make-vector (length fields) 0)
- nfields (length fnum)))
- (setq nline (1+ nline) i -1
- rowstart (eval (car org-export-table-row-tags))
- rowend (eval (cdr org-export-table-row-tags)))
- (push (concat rowstart
- (mapconcat
- (lambda (x)
- (setq i (1+ i) ali (format "@@class%03d@@" i))
- (if (and (< i nfields) ; make sure no rogue line causes an error here
- (string-match org-table-number-regexp x))
- (incf (aref fnum i)))
- (cond
- (head
- (concat
- (format (car org-export-table-header-tags)
- "col" ali)
- x
- (cdr org-export-table-header-tags)))
- ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
- (concat
- (format (car org-export-table-header-tags)
- "row" ali)
- x
- (cdr org-export-table-header-tags)))
- (t
- (concat (format (car org-export-table-data-tags) ali)
- x
- (cdr org-export-table-data-tags)))))
- fields "")
- rowend)
- html)))
- (unless splice (if tbopen (push "</tbody>" html)))
- (unless splice (push "</table>\n" html))
- (setq html (nreverse html))
- (unless splice
- ;; Put in col tags with the alignment (unfortunately often ignored...)
- (unless (car org-table-colgroup-info)
- (setq org-table-colgroup-info
- (cons :start (cdr org-table-colgroup-info))))
- (setq i 0)
- (push (mapconcat
- (lambda (x)
- (setq gr (pop org-table-colgroup-info)
- i (1+ i)
- align (if (nth 1 (assoc i col-cookies))
- (cdr (assoc (nth 1 (assoc i col-cookies))
- '(("l" . "left") ("r" . "right")
- ("c" . "center"))))
- (if (> (/ (float x) nline)
- org-table-number-fraction)
- "right" "left")))
- (push align aligns)
- (format (if no-css
- "%s<col align=\"%s\" />%s"
- "%s<col class=\"%s\" />%s")
- (if (memq gr '(:start :startend))
- (prog1
- (if colgropen
- "</colgroup>\n<colgroup>"
- "<colgroup>")
- (setq colgropen t))
- "")
- align
- (if (memq gr '(:end :startend))
- (progn (setq colgropen nil) "</colgroup>")
- "")))
- fnum "")
- html)
- (setq aligns (nreverse aligns))
- (if colgropen (setq html (cons (car html)
- (cons "</colgroup>" (cdr html)))))
- ;; Since the output of HTML table formatter can also be used in
- ;; DocBook document, include empty captions for the DocBook
- ;; export only so that it produces valid XML.
- (when (or caption (eq org-export-current-backend 'docbook))
- (push (format "<caption>%s</caption>" (or caption "")) html))
- (when label
- (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
- (push html-table-tag html))
- (setq html (mapcar
- (lambda (x)
- (replace-regexp-in-string
- "@@class\\([0-9]+\\)@@"
- (lambda (txt)
- (if (not org-export-html-table-align-individual-fields)
- ""
- (setq n (string-to-number (match-string 1 txt)))
- (format (if no-css " align=\"%s\"" " class=\"%s\"")
- (or (nth n aligns) "left"))))
- x))
- html))
- (concat (mapconcat 'identity html "\n") "\n")))
-
-(defun org-export-splice-attributes (tag attributes)
- "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
- (if (not attributes)
- tag
- (let (oldatt newatt)
- (setq oldatt (org-extract-attributes-from-string tag)
- tag (pop oldatt)
- newatt (cdr (org-extract-attributes-from-string attributes)))
- (while newatt
- (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
- (if (string-match ">" tag)
- (setq tag
- (replace-match (concat (org-attributes-to-string oldatt) ">")
- t t tag)))
- tag)))
-
-(defun org-format-table-table-html (lines)
- "Format a table generated by table.el into HTML.
-This conversion does *not* use `table-generate-source' from table.el.
-This has the advantage that Org-mode's HTML conversions can be used.
-But it has the disadvantage, that no cell- or row-spanning is allowed."
- (let (org-line field-buffer
- (head org-export-highlight-first-table-line)
- fields html empty i)
- (setq html (concat html-table-tag "\n"))
- (while (setq org-line (pop lines))
- (setq empty "&nbsp;")
- (catch 'next-line
- (if (string-match "^[ \t]*\\+-" org-line)
- (progn
- (if field-buffer
- (progn
- (setq
- html
- (concat
- html
- "<tr>"
- (mapconcat
- (lambda (x)
- (if (equal x "") (setq x empty))
- (if head
- (concat
- (format (car org-export-table-header-tags) "col" "")
- x
- (cdr org-export-table-header-tags))
- (concat (format (car org-export-table-data-tags) "") x
- (cdr org-export-table-data-tags))))
- field-buffer "\n")
- "</tr>\n"))
- (setq head nil)
- (setq field-buffer nil)))
- ;; Ignore this line
- (throw 'next-line t)))
- ;; Break the line into fields and store the fields
- (setq fields (org-split-string org-line "[ \t]*|[ \t]*"))
- (if field-buffer
- (setq field-buffer (mapcar
- (lambda (x)
- (concat x "<br/>" (pop fields)))
- field-buffer))
- (setq field-buffer fields))))
- (setq html (concat html "</table>\n"))
- html))
-
-(defun org-format-table-table-html-using-table-generate-source (lines
- &optional
- spanned-only)
- "Format a table into html, using `table-generate-source' from table.el.
-Use SPANNED-ONLY to suppress exporting of simple table.el tables.
-
-When SPANNED-ONLY is nil, all table.el tables are exported. When
-SPANNED-ONLY is non-nil, only tables with either row or column
-spans are exported.
-
-This routine returns the generated source or nil as appropriate.
-
-Refer docstring of `org-export-prefer-native-exporter-for-tables'
-for further information."
- (require 'table)
- (with-current-buffer (get-buffer-create " org-tmp1 ")
- (erase-buffer)
- (insert (mapconcat 'identity lines "\n"))
- (goto-char (point-min))
- (if (not (re-search-forward "|[^+]" nil t))
- (error "Error processing table"))
- (table-recognize-table)
- (when (or (not spanned-only)
- (let* ((dim (table-query-dimension))
- (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
- (not (= (* c r) cells))))
- (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
- (table-generate-source 'html " org-tmp2 ")
- (set-buffer " org-tmp2 ")
- (buffer-substring (point-min) (point-max)))))
-
-(defun org-export-splice-style (style extra)
- "Splice EXTRA into STYLE, just before \"</style>\"."
- (if (and (stringp extra)
- (string-match "\\S-" extra)
- (string-match "</style>" style))
- (concat (substring style 0 (match-beginning 0))
- "\n" extra "\n"
- (substring style (match-beginning 0)))
- style))
-
-(defun org-html-handle-time-stamps (s)
- "Format time stamps in string S, or remove them."
- (catch 'exit
- (let (r b)
- (when org-maybe-keyword-time-regexp
- (while (string-match org-maybe-keyword-time-regexp s)
- (or b (setq b (substring s 0 (match-beginning 0))))
- (setq r (concat
- r (substring s 0 (match-beginning 0))
- " @<span class=\"timestamp-wrapper\">"
- (if (match-end 1)
- (format "@<span class=\"timestamp-kwd\">%s @</span>"
- (match-string 1 s)))
- (format " @<span class=\"timestamp\">%s@</span>"
- (substring
- (org-translate-time (match-string 3 s)) 1 -1))
- "@</span>")
- s (substring s (match-end 0)))))
- ;; Line break if line started and ended with time stamp stuff
- (if (not r)
- s
- (setq r (concat r s))
- (unless (string-match "\\S-" (concat b s))
- (setq r (concat r "@<br/>")))
- r))))
-
-(defvar htmlize-buffer-places) ; from htmlize.el
-(defun org-export-htmlize-region-for-paste (beg end)
- "Convert the region to HTML, using htmlize.el.
-This is much like `htmlize-region-for-paste', only that it uses
-the settings define in the org-... variables."
- (let* ((htmlize-output-type org-export-htmlize-output-type)
- (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
- (htmlbuf (htmlize-region beg end)))
- (unwind-protect
- (with-current-buffer htmlbuf
- (buffer-substring (plist-get htmlize-buffer-places 'content-start)
- (plist-get htmlize-buffer-places 'content-end)))
- (kill-buffer htmlbuf))))
-
-(defun org-export-htmlize-generate-css ()
- "Create the CSS for all font definitions in the current Emacs session.
-Use this to create face definitions in your CSS style file that can then
-be used by code snippets transformed by htmlize.
-This command just produces a buffer that contains class definitions for all
-faces used in the current Emacs session. You can copy and paste the ones you
-need into your CSS file.
-
-If you then set `org-export-htmlize-output-type' to `css', calls to
-the function `org-export-htmlize-region-for-paste' will produce code
-that uses these same face definitions."
- (interactive)
- (require 'htmlize)
- (and (get-buffer "*html*") (kill-buffer "*html*"))
- (with-temp-buffer
- (let ((fl (face-list))
- (htmlize-css-name-prefix "org-")
- (htmlize-output-type 'css)
- f i)
- (while (setq f (pop fl)
- i (and f (face-attribute f :inherit)))
- (when (and (symbolp f) (or (not i) (not (listp i))))
- (insert (org-add-props (copy-sequence "1") nil 'face f))))
- (htmlize-region (point-min) (point-max))))
- (org-pop-to-buffer-same-window "*html*")
- (goto-char (point-min))
- (if (re-search-forward "<style" nil t)
- (delete-region (point-min) (match-beginning 0)))
- (if (re-search-forward "</style>" nil t)
- (delete-region (1+ (match-end 0)) (point-max)))
- (beginning-of-line 1)
- (if (looking-at " +") (replace-match ""))
- (goto-char (point-min)))
-
-(defun org-html-protect (s)
- "Convert characters to HTML equivalent.
-Possible conversions are set in `org-export-html-protect-char-alist'."
- (let ((cl org-export-html-protect-char-alist) c)
- (while (setq c (pop cl))
- (let ((start 0))
- (while (string-match (car c) s start)
- (setq s (replace-match (cdr c) t t s)
- start (1+ (match-beginning 0))))))
- s))
-
-(defun org-html-expand (string)
- "Prepare STRING for HTML export. Apply all active conversions.
-If there are links in the string, don't modify these. If STRING
-is nil, return nil."
- (when string
- (let* ((re (concat org-bracket-link-regexp "\\|"
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
- m s l res)
- (while (setq m (string-match re string))
- (setq s (substring string 0 m)
- l (match-string 0 string)
- string (substring string (match-end 0)))
- (push (org-html-do-expand s) res)
- (push l res))
- (push (org-html-do-expand string) res)
- (apply 'concat (nreverse res)))))
-
-(defun org-html-do-expand (s)
- "Apply all active conversions to translate special ASCII to HTML."
- (setq s (org-html-protect s))
- (if org-export-html-expand
- (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
- (setq s (replace-match "<\\1>" t nil s))))
- (if org-export-with-emphasize
- (setq s (org-export-html-convert-emphasize s)))
- (if org-export-with-special-strings
- (setq s (org-export-html-convert-special-strings s)))
- (if org-export-with-sub-superscripts
- (setq s (org-export-html-convert-sub-super s)))
- (if org-export-with-TeX-macros
- (let ((start 0) wd rep)
- (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
- s start))
- (if (get-text-property (match-beginning 0) 'org-protected s)
- (setq start (match-end 0))
- (setq wd (match-string 1 s))
- (if (setq rep (org-entity-get-representation wd 'html))
- (setq s (replace-match rep t t s))
- (setq start (+ start (length wd))))))))
- s)
-
-(defun org-export-html-convert-special-strings (string)
- "Convert special characters in STRING to HTML."
- (let ((all org-export-html-special-string-regexps)
- e a re rpl start)
- (while (setq a (pop all))
- (setq re (car a) rpl (cdr a) start 0)
- (while (string-match re string start)
- (if (get-text-property (match-beginning 0) 'org-protected string)
- (setq start (match-end 0))
- (setq string (replace-match rpl t nil string)))))
- string))
-
-(defun org-export-html-convert-sub-super (string)
- "Convert sub- and superscripts in STRING to HTML."
- (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
- (while (string-match org-match-substring-regexp string s)
- (cond
- ((and requireb (match-end 8)) (setq s (match-end 2)))
- ((get-text-property (match-beginning 2) 'org-protected string)
- (setq s (match-end 2)))
- (t
- (setq s (match-end 1)
- key (if (string= (match-string 2 string) "_") "sub" "sup")
- c (or (match-string 8 string)
- (match-string 6 string)
- (match-string 5 string))
- string (replace-match
- (concat (match-string 1 string)
- "<" key ">" c "</" key ">")
- t t string)))))
- (while (string-match "\\\\\\([_^]\\)" string)
- (setq string (replace-match (match-string 1 string) t t string)))
- string))
-
-(defun org-export-html-convert-emphasize (string)
- "Apply emphasis."
- (let ((s 0) rpl)
- (while (string-match org-emph-re string s)
- (if (not (equal
- (substring string (match-beginning 3) (1+ (match-beginning 3)))
- (substring string (match-beginning 4) (1+ (match-beginning 4)))))
- (setq s (match-beginning 0)
- rpl
- (concat
- (match-string 1 string)
- (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
- (match-string 4 string)
- (nth 3 (assoc (match-string 3 string)
- org-emphasis-alist))
- (match-string 5 string))
- string (replace-match rpl t t string)
- s (+ s (- (length rpl) 2)))
- (setq s (1+ s))))
- string))
-
-(defun org-open-par ()
- "Insert <p>, but first close previous paragraph if any."
- (org-close-par-maybe)
- (insert "\n<p>")
- (setq org-par-open t))
-(defun org-close-par-maybe ()
- "Close paragraph if there is one open."
- (when org-par-open
- (insert "</p>")
- (setq org-par-open nil)))
-(defun org-close-li (&optional type)
- "Close <li> if necessary."
- (org-close-par-maybe)
- (insert (if (equal type "d") "</dd>\n" "</li>\n")))
-
-(defvar body-only) ; dynamically scoped into this.
-(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist)
- "Insert a new level in HTML export.
-When TITLE is nil, just close all open levels."
- (org-close-par-maybe)
- (let* ((target (and title (org-get-text-property-any 0 'target title)))
- (extra-targets (and target
- (assoc target org-export-target-aliases)))
- (extra-class (and title (org-get-text-property-any 0 'html-container-class title)))
- (preferred (and target
- (cdr (assoc target org-export-preferred-target-alist))))
- (l org-level-max)
- (num (plist-get opt-plist :section-numbers))
- snumber snu href suffix)
- (setq extra-targets (remove (or preferred target) extra-targets))
- (setq extra-targets
- (mapconcat (lambda (x)
- (setq x (org-solidify-link-text
- (if (org-uuidgen-p x) (concat "ID-" x) x)))
- (if (stringp org-export-html-headline-anchor-format)
- (format org-export-html-headline-anchor-format x x)
- ""))
- extra-targets
- ""))
- (while (>= l level)
- (if (aref org-levels-open (1- l))
- (progn
- (org-html-level-close l umax)
- (aset org-levels-open (1- l) nil)))
- (setq l (1- l)))
- (when title
- ;; If title is nil, this means this function is called to close
- ;; all levels, so the rest is done only if title is given
- (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
- (setq title (replace-match
- (if org-export-with-tags
- (save-match-data
- (concat
- "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
- (mapconcat
- (lambda (x)
- (format "<span class=\"%s\">%s</span>"
- (org-export-html-get-tag-class-name x)
- x))
- (org-split-string (match-string 1 title) ":")
- "&nbsp;")
- "</span>"))
- "")
- t t title)))
- (if (> level umax)
- (progn
- (if (aref org-levels-open (1- level))
- (progn
- (org-close-li)
- (if target
- (insert (format "<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
- extra-targets title "<br/>\n")
- (insert "<li>" title "<br/>\n")))
- (aset org-levels-open (1- level) t)
- (org-close-par-maybe)
- (if target
- (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
- extra-targets title "<br/>\n")
- (insert "<ul>\n<li>" title "<br/>\n"))))
- (aset org-levels-open (1- level) t)
- (setq snumber (org-section-number level)
- snu (replace-regexp-in-string "\\." "-" snumber))
- (setq level (+ level org-export-html-toplevel-hlevel -1))
- (if (and num (not body-only))
- (setq title (concat
- (format "<span class=\"section-number-%d\">%s</span>"
- level
- (if (and num
- (if (integerp num)
- ;; fix up num to take into
- ;; account the top-level
- ;; heading value
- (>= (+ num org-export-html-toplevel-hlevel -1)
- level)
- num))
- snumber
- ""))
- " " title)))
- (unless (= head-count 1) (insert "\n</div>\n"))
- (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist)))
- (setq suffix (org-solidify-link-text (or href snu)))
- (setq href (org-solidify-link-text (or href (concat "sec-" snu))))
- (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
- suffix level (if extra-class (concat " " extra-class) "")
- level href
- extra-targets
- title level level suffix))
- (org-open-par)))))
-
-(defun org-export-html-get-tag-class-name (tag)
- "Turn tag into a valid class name.
-Replaces invalid characters with \"_\" and then prepends a prefix."
- (save-match-data
- (while (string-match "[^a-zA-Z0-9_]" tag)
- (setq tag (replace-match "_" t t tag))))
- (concat org-export-html-tag-class-prefix tag))
-
-(defun org-export-html-get-todo-kwd-class-name (kwd)
- "Turn todo keyword into a valid class name.
-Replaces invalid characters with \"_\" and then prepends a prefix."
- (save-match-data
- (while (string-match "[^a-zA-Z0-9_]" kwd)
- (setq kwd (replace-match "_" t t kwd))))
- (concat org-export-html-todo-kwd-class-prefix kwd))
-
-(defun org-html-level-close (level max-outline-level)
- "Terminate one level in HTML export."
- (if (<= level max-outline-level)
- (insert "</div>\n")
- (org-close-li)
- (insert "</ul>\n")))
-
-(defun org-html-export-list-line (org-line pos struct prevs)
- "Insert list syntax in export buffer. Return ORG-LINE, maybe modified.
-
-POS is the item position or org-line position the org-line had before
-modifications to buffer. STRUCT is the list structure. PREVS is
-the alist of previous items."
- (let* ((get-type
- (function
- ;; Translate type of list containing POS to "d", "o" or
- ;; "u".
- (lambda (pos struct prevs)
- (let ((type (org-list-get-list-type pos struct prevs)))
- (cond
- ((eq 'ordered type) "o")
- ((eq 'descriptive type) "d")
- (t "u"))))))
- (get-closings
- (function
- ;; Return list of all items and sublists ending at POS, in
- ;; reverse order.
- (lambda (pos)
- (let (out)
- (catch 'exit
- (mapc (lambda (e)
- (let ((end (nth 6 e))
- (item (car e)))
- (cond
- ((= end pos) (push item out))
- ((>= item pos) (throw 'exit nil)))))
- struct))
- out)))))
- ;; First close any previous item, or list, ending at POS.
- (mapc (lambda (e)
- (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
- (first-item (org-list-get-list-begin e struct prevs))
- (type (funcall get-type first-item struct prevs)))
- (org-close-par-maybe)
- ;; Ending for every item
- (org-close-li type)
- ;; We're ending last item of the list: end list.
- (when lastp
- (insert (format "</%sl>\n" type))
- (org-open-par))))
- (funcall get-closings pos))
- (cond
- ;; At an item: insert appropriate tags in export buffer.
- ((assq pos struct)
- (string-match
- (concat "[ \t]*\\(\\S-+[ \t]*\\)"
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
- "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
- "\\(.*\\)") org-line)
- (let* ((checkbox (match-string 3 org-line))
- (desc-tag (or (match-string 4 org-line) "???"))
- (body (or (match-string 5 org-line) ""))
- (list-beg (org-list-get-list-begin pos struct prevs))
- (firstp (= list-beg pos))
- ;; Always refer to first item to determine list type, in
- ;; case list is ill-formed.
- (type (funcall get-type list-beg struct prevs))
- (counter (let ((count-tmp (org-list-get-counter pos struct)))
- (cond
- ((not count-tmp) nil)
- ((string-match "[A-Za-z]" count-tmp)
- (- (string-to-char (upcase count-tmp)) 64))
- ((string-match "[0-9]+" count-tmp)
- count-tmp)))))
- (when firstp
- (org-close-par-maybe)
- (insert (format "<%sl>\n" type)))
- (insert (cond
- ((equal type "d")
- (format "<dt>%s</dt><dd>" desc-tag))
- ((and (equal type "o") counter)
- (format "<li value=\"%s\">" counter))
- (t "<li>")))
- ;; If line had a checkbox, some additional modification is required.
- (when checkbox
- (setq body
- (concat
- (cond
- ((string-match "X" checkbox) "<code>[X]</code> ")
- ((string-match " " checkbox) "<code>[&nbsp;]</code> ")
- (t "<code>[-]</code> "))
- body)))
- ;; Return modified line
- body))
- ;; At a list ender: go to next line (side-effects only).
- ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil))
- ;; Not at an item: return line unchanged (side-effects only).
- (t org-line))))
-
-(provide 'org-html)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-html.el ends here
diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el
deleted file mode 100644
index 12cd0584fa0..00000000000
--- a/lisp/org/org-icalendar.el
+++ /dev/null
@@ -1,692 +0,0 @@
-;;; org-icalendar.el --- iCalendar export for Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;;; Code:
-
-(require 'org-exp)
-
-(eval-when-compile (require 'cl))
-
-(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
-
-(defgroup org-export-icalendar nil
- "Options specific for iCalendar export of Org-mode files."
- :tag "Org Export iCalendar"
- :group 'org-export)
-
-(defcustom org-combined-agenda-icalendar-file "~/org.ics"
- "The file name for the iCalendar file covering all agenda files.
-This file is created with the command \\[org-export-icalendar-all-agenda-files].
-The file name should be absolute, the file will be overwritten without warning."
- :group 'org-export-icalendar
- :type 'file)
-
-(defcustom org-icalendar-alarm-time 0
- "Number of minutes for triggering an alarm for exported timed events.
-A zero value (the default) turns off the definition of an alarm trigger
-for timed events. If non-zero, alarms are created.
-
-- a single alarm per entry is defined
-- The alarm will go off N minutes before the event
-- only a DISPLAY action is defined."
- :group 'org-export-icalendar
- :version "24.1"
- :type 'integer)
-
-(defcustom org-icalendar-combined-name "OrgMode"
- "Calendar name for the combined iCalendar representing all agenda files."
- :group 'org-export-icalendar
- :type 'string)
-
-(defcustom org-icalendar-combined-description nil
- "Calendar description for the combined iCalendar (all agenda files)."
- :group 'org-export-icalendar
- :version "24.1"
- :type 'string)
-
-(defcustom org-icalendar-use-plain-timestamp t
- "Non-nil means make an event from every plain time stamp."
- :group 'org-export-icalendar
- :type 'boolean)
-
-(defcustom org-icalendar-honor-noexport-tag nil
- "Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
- :group 'org-export-icalendar
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
- "Contexts where iCalendar export should use a deadline time stamp.
-This is a list with several symbols in it. Valid symbol are:
-
-event-if-todo Deadlines in TODO entries become calendar events.
-event-if-not-todo Deadlines in non-TODO entries become calendar events.
-todo-due Use deadlines in TODO entries as due-dates"
- :group 'org-export-icalendar
- :type '(set :greedy t
- (const :tag "Deadlines in non-TODO entries become events"
- event-if-not-todo)
- (const :tag "Deadline in TODO entries become events"
- event-if-todo)
- (const :tag "Deadlines in TODO entries become due-dates"
- todo-due)))
-
-(defcustom org-icalendar-use-scheduled '(todo-start)
- "Contexts where iCalendar export should use a scheduling time stamp.
-This is a list with several symbols in it. Valid symbol are:
-
-event-if-todo Scheduling time stamps in TODO entries become an event.
-event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
-todo-start Scheduling time stamps in TODO entries become start date.
- Some calendar applications show TODO entries only after
- that date."
- :group 'org-export-icalendar
- :type '(set :greedy t
- (const :tag
- "SCHEDULED timestamps in non-TODO entries become events"
- event-if-not-todo)
- (const :tag "SCHEDULED timestamps in TODO entries become events"
- event-if-todo)
- (const :tag "SCHEDULED in TODO entries become start date"
- todo-start)))
-
-(defcustom org-icalendar-categories '(local-tags category)
- "Items that should be entered into the categories field.
-This is a list of symbols, the following are valid:
-
-category The Org-mode category of the current file or tree
-todo-state The todo state, if any
-local-tags The tags, defined in the current line
-all-tags All tags, including inherited ones."
- :group 'org-export-icalendar
- :type '(repeat
- (choice
- (const :tag "The file or tree category" category)
- (const :tag "The TODO state" todo-state)
- (const :tag "Tags defined in current line" local-tags)
- (const :tag "All tags, including inherited ones" all-tags))))
-
-(defcustom org-icalendar-include-todo nil
- "Non-nil means export to iCalendar files should also cover TODO items.
-Valid values are:
-nil don't include any TODO items
-t include all TODO items that are not in a DONE state
-unblocked include all TODO items that are not blocked
-all include both done and not done items."
- :group 'org-export-icalendar
- :type '(choice
- (const :tag "None" nil)
- (const :tag "Unfinished" t)
- (const :tag "Unblocked" unblocked)
- (const :tag "All" all)))
-
-(defvar org-icalendar-verify-function nil
- "Function to verify entries for iCalendar export.
-This can be set to a function that will be called at each entry that
-is considered for export to iCalendar. When the function returns nil,
-the entry will be skipped. When it returns a non-nil value, the entry
-will be considered for export.
-This is used internally when an agenda buffer is exported to an ics file,
-to make sure that only entries currently listed in the agenda will end
-up in the ics file. But for normal iCalendar export, you can use this
-for whatever you need.")
-
-(defcustom org-icalendar-include-bbdb-anniversaries nil
- "Non-nil means a combined iCalendar files should include anniversaries.
-The anniversaries are define in the BBDB database."
- :group 'org-export-icalendar
- :type 'boolean)
-
-(defcustom org-icalendar-include-sexps t
- "Non-nil means export to iCalendar files should also cover sexp entries.
-These are entries like in the diary, but directly in an Org-mode file."
- :group 'org-export-icalendar
- :type 'boolean)
-
-(defcustom org-icalendar-include-body 100
- "Amount of text below headline to be included in iCalendar export.
-This is a number of characters that should maximally be included.
-Properties, scheduling and clocking lines will always be removed.
-The text will be inserted into the DESCRIPTION field."
- :group 'org-export-icalendar
- :type '(choice
- (const :tag "Nothing" nil)
- (const :tag "Everything" t)
- (integer :tag "Max characters")))
-
-(defcustom org-icalendar-store-UID nil
- "Non-nil means store any created UIDs in properties.
-The iCalendar standard requires that all entries have a unique identifier.
-Org will create these identifiers as needed. When this variable is non-nil,
-the created UIDs will be stored in the ID property of the entry. Then the
-next time this entry is exported, it will be exported with the same UID,
-superseding the previous form of it. This is essential for
-synchronization services.
-This variable is not turned on by default because we want to avoid creating
-a property drawer in every entry if people are only playing with this feature,
-or if they are only using it locally."
- :group 'org-export-icalendar
- :type 'boolean)
-
-(defcustom org-icalendar-timezone (getenv "TZ")
- "The time zone string for iCalendar export.
-When nil or the empty string, use output from \(current-time-zone\)."
- :group 'org-export-icalendar
- :type '(choice
- (const :tag "Unspecified" nil)
- (string :tag "Time zone")))
-
-;; Backward compatibility with previous variable
-(defvar org-icalendar-use-UTC-date-time nil)
-(defcustom org-icalendar-date-time-format
- (if org-icalendar-use-UTC-date-time
- ":%Y%m%dT%H%M%SZ"
- ":%Y%m%dT%H%M%S")
- "Format-string for exporting icalendar DATE-TIME.
-See `format-time-string' for a full documentation. The only
-difference is that `org-icalendar-timezone' is used for %Z.
-
-Interesting value are:
- - \":%Y%m%dT%H%M%S\" for local time
- - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
- - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
-
- :group 'org-export-icalendar
- :version "24.1"
- :type '(choice
- (const :tag "Local time" ":%Y%m%dT%H%M%S")
- (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
- (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
- (string :tag "Explicit format")))
-
-(defun org-icalendar-use-UTC-date-timep ()
- (char-equal (elt org-icalendar-date-time-format
- (1- (length org-icalendar-date-time-format))) ?Z))
-
-;;; iCalendar export
-
-;;;###autoload
-(defun org-export-icalendar-this-file ()
- "Export current file as an iCalendar file.
-The iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'."
- (interactive)
- (org-export-icalendar nil buffer-file-name))
-
-;;;###autoload
-(defun org-export-icalendar-all-agenda-files ()
- "Export all files in the variable `org-agenda-files' to iCalendar .ics files.
-Each iCalendar file will be located in the same directory as the Org-mode
-file, but with extension `.ics'."
- (interactive)
- (apply 'org-export-icalendar nil (org-agenda-files t)))
-
-;;;###autoload
-(defun org-export-icalendar-combine-agenda-files ()
- "Export all files in `org-agenda-files' to a single combined iCalendar file.
-The file is stored under the name `org-combined-agenda-icalendar-file'."
- (interactive)
- (apply 'org-export-icalendar t (org-agenda-files t)))
-
-(defun org-export-icalendar (combine &rest files)
- "Create iCalendar files for all elements of FILES.
-If COMBINE is non-nil, combine all calendar entries into a single large
-file and store it under the name `org-combined-agenda-icalendar-file'."
- (save-excursion
- (org-agenda-prepare-buffers files)
- (let* ((dir (org-export-directory
- :ical (list :publishing-directory
- org-export-publishing-directory)))
- file ical-file ical-buffer category started org-agenda-new-buffers)
- (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*"))
- (when combine
- (setq ical-file
- (if (file-name-absolute-p org-combined-agenda-icalendar-file)
- org-combined-agenda-icalendar-file
- (expand-file-name org-combined-agenda-icalendar-file dir))
- ical-buffer (org-get-agenda-file-buffer ical-file))
- (set-buffer ical-buffer) (erase-buffer))
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (set-buffer (org-get-agenda-file-buffer file))
- (unless combine
- (setq ical-file (concat (file-name-as-directory dir)
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- ".ics"))
- (setq ical-buffer (org-get-agenda-file-buffer ical-file))
- (with-current-buffer ical-buffer (erase-buffer)))
- (setq category (or org-category
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))))
- (if (symbolp category) (setq category (symbol-name category)))
- (let ((standard-output ical-buffer))
- (if combine
- (and (not started) (setq started t)
- (org-icalendar-start-file org-icalendar-combined-name))
- (org-icalendar-start-file category))
- (org-icalendar-print-entries combine)
- (when (or (and combine (not files)) (not combine))
- (when (and combine org-icalendar-include-bbdb-anniversaries)
- (require 'org-bbdb)
- (org-bbdb-anniv-export-ical))
- (org-icalendar-finish-file)
- (set-buffer ical-buffer)
- (run-hooks 'org-before-save-iCalendar-file-hook)
- (save-buffer)
- (run-hooks 'org-after-save-iCalendar-file-hook)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))))
- (org-release-buffers org-agenda-new-buffers))))
-
-(defvar org-before-save-iCalendar-file-hook nil
- "Hook run before an iCalendar file has been saved.
-This can be used to modify the result of the export.")
-
-(defvar org-after-save-iCalendar-file-hook nil
- "Hook run after an iCalendar file has been saved.
-The iCalendar buffer is still current when this hook is run.
-A good way to use this is to tell a desktop calendar application to re-read
-the iCalendar file.")
-
-(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
-(defun org-icalendar-print-entries (&optional combine)
- "Print iCalendar entries for the current Org-mode file to `standard-output'.
-When COMBINE is non nil, add the category to each line."
- (require 'org-agenda)
- (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>"))
- (re2 (concat "--?-?\\(" org-ts-regexp "\\)"))
- (dts (org-icalendar-ts-to-string
- (format-time-string (cdr org-time-stamp-formats) (current-time))
- "DTSTART"))
- hd ts ts2 state status (inc t) pos b sexp rrule
- scheduledp deadlinep todo prefix due start tags
- tmp pri categories location summary desc uid alarm alarm-time
- (sexp-buffer (get-buffer-create "*ical-tmp*")))
- (org-refresh-category-properties)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward re1 nil t)
- (catch :skip
- (org-agenda-skip)
- (when org-icalendar-verify-function
- (unless (save-match-data (funcall org-icalendar-verify-function))
- (outline-next-heading)
- (backward-char 1)
- (throw :skip nil)))
- (setq pos (match-beginning 0)
- ts (match-string 0)
- tags (org-get-tags-at)
- inc t
- hd (condition-case nil
- (org-icalendar-cleanup-string
- (org-get-heading t))
- (error (throw :skip nil)))
- summary (org-icalendar-cleanup-string
- (org-entry-get nil "SUMMARY"))
- desc (org-icalendar-cleanup-string
- (or (org-entry-get nil "DESCRIPTION")
- (and org-icalendar-include-body (org-get-entry)))
- t org-icalendar-include-body)
- location (org-icalendar-cleanup-string
- (org-entry-get nil "LOCATION" 'selective))
- uid (if org-icalendar-store-UID
- (org-id-get-create)
- (or (org-id-get) (org-id-new)))
- categories (org-export-get-categories)
- alarm-time (get-text-property (point) 'org-appt-warntime)
- alarm-time (if alarm-time (string-to-number alarm-time) 0)
- alarm ""
- deadlinep nil scheduledp nil)
- (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos)
- deadlinep (string-match org-deadline-regexp tmp)
- scheduledp (string-match org-scheduled-regexp tmp)
- todo (org-get-todo-state))
- ;; donep (org-entry-is-done-p)
- (if (looking-at re2)
- (progn
- (goto-char (match-end 0))
- (setq ts2 (match-string 1)
- inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
- (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts)
- (progn
- (setq inc nil)
- (replace-match "\\1" t nil ts))
- ts)))
- (when (and (not org-icalendar-use-plain-timestamp)
- (not deadlinep) (not scheduledp))
- (throw :skip t))
- ;; don't export entries with a :noexport: tag
- (when (and org-icalendar-honor-noexport-tag
- (delq nil (mapcar (lambda(x)
- (member x org-export-exclude-tags)) tags)))
- (throw :skip t))
- (when (and
- deadlinep
- (if todo
- (not (memq 'event-if-todo org-icalendar-use-deadline))
- (not (memq 'event-if-not-todo org-icalendar-use-deadline))))
- (throw :skip t))
- (when (and
- scheduledp
- (if todo
- (not (memq 'event-if-todo org-icalendar-use-scheduled))
- (not (memq 'event-if-not-todo org-icalendar-use-scheduled))))
- (throw :skip t))
- (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-")))
- (if (or (string-match org-tr-regexp hd)
- (string-match org-ts-regexp hd))
- (setq hd (replace-match "" t t hd)))
- (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts)
- (setq rrule
- (concat "\nRRULE:FREQ="
- (cdr (assoc
- (match-string 2 ts)
- '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY")
- ("m" . "MONTHLY")("y" . "YEARLY"))))
- ";INTERVAL=" (match-string 1 ts)))
- (setq rrule ""))
- (setq summary (or summary hd))
- ;; create an alarm entry if the entry is timed. this is not very general in that:
- ;; (a) only one alarm per entry is defined,
- ;; (b) only minutes are allowed for the trigger period ahead of the start time, and
- ;; (c) only a DISPLAY action is defined.
- ;; [ESF]
- (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault))))
- (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
- (car t1) (nth 1 t1) (nth 2 t1))
- (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM"
- summary (or alarm-time org-icalendar-alarm-time)))
- (setq alarm "")))
- (if (string-match org-bracket-link-regexp summary)
- (setq summary
- (replace-match (if (match-end 3)
- (match-string 3 summary)
- (match-string 1 summary))
- t t summary)))
- (if deadlinep (setq summary (concat "DL: " summary)))
- (if scheduledp (setq summary (concat "S: " summary)))
- (if (string-match "\\`<%%" ts)
- (with-current-buffer sexp-buffer
- (let ((entry (substring ts 1 -1)))
- (put-text-property 0 1 'uid
- (concat " " prefix uid) entry)
- (insert entry " " summary "\n")))
- (princ (format "BEGIN:VEVENT
-UID: %s
-%s
-%s%s
-SUMMARY:%s%s%s
-CATEGORIES:%s%s
-END:VEVENT\n"
- (concat prefix uid)
- (org-icalendar-ts-to-string ts "DTSTART")
- (org-icalendar-ts-to-string ts2 "DTEND" inc)
- rrule summary
- (if (and desc (string-match "\\S-" desc))
- (concat "\nDESCRIPTION: " desc) "")
- (if (and location (string-match "\\S-" location))
- (concat "\nLOCATION: " location) "")
- categories
- alarm)))))
- (when (and org-icalendar-include-sexps
- (condition-case nil (require 'icalendar) (error nil))
- (fboundp 'icalendar-export-region))
- ;; Get all the literal sexps
- (goto-char (point-min))
- (while (re-search-forward "^&?%%(" nil t)
- (catch :skip
- (org-agenda-skip)
- (when org-icalendar-verify-function
- (unless (save-match-data (funcall org-icalendar-verify-function))
- (outline-next-heading)
- (backward-char 1)
- (throw :skip nil)))
- (setq b (match-beginning 0))
- (goto-char (1- (match-end 0)))
- (forward-sexp 1)
- (end-of-line 1)
- (setq sexp (buffer-substring b (point)))
- (with-current-buffer sexp-buffer
- (insert sexp "\n"))))
- (princ (org-diary-to-ical-string sexp-buffer))
- (kill-buffer sexp-buffer))
-
- (when org-icalendar-include-todo
- (setq prefix "TODO-")
- (goto-char (point-min))
- (while (re-search-forward org-complex-heading-regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (when org-icalendar-verify-function
- (unless (save-match-data
- (funcall org-icalendar-verify-function))
- (outline-next-heading)
- (backward-char 1)
- (throw :skip nil)))
- (setq state (match-string 2))
- (setq status (if (member state org-done-keywords)
- "COMPLETED" "NEEDS-ACTION"))
- (when (and state
- (cond
- ;; check if the state is one we should use
- ((eq org-icalendar-include-todo 'all)
- ;; all should be included
- t)
- ((eq org-icalendar-include-todo 'unblocked)
- ;; only undone entries that are not blocked
- (and (member state org-not-done-keywords)
- (or (not org-blocker-hook)
- (save-match-data
- (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position (point-at-bol)
- :from 'todo
- :to 'done))))))
- ((eq org-icalendar-include-todo t)
- ;; include everything that is not done
- (member state org-not-done-keywords))))
- (setq hd (match-string 4)
- summary (org-icalendar-cleanup-string
- (org-entry-get nil "SUMMARY"))
- desc (org-icalendar-cleanup-string
- (or (org-entry-get nil "DESCRIPTION")
- (and org-icalendar-include-body (org-get-entry)))
- t org-icalendar-include-body)
- location (org-icalendar-cleanup-string
- (org-entry-get nil "LOCATION" 'selective))
- due (and (member 'todo-due org-icalendar-use-deadline)
- (org-entry-get nil "DEADLINE"))
- start (and (member 'todo-start org-icalendar-use-scheduled)
- (org-entry-get nil "SCHEDULED"))
- categories (org-export-get-categories)
- uid (if org-icalendar-store-UID
- (org-id-get-create)
- (or (org-id-get) (org-id-new))))
- (and due (setq due (org-icalendar-ts-to-string due "DUE")))
- (and start (setq start (org-icalendar-ts-to-string start "DTSTART")))
-
- (if (string-match org-bracket-link-regexp hd)
- (setq hd (replace-match (if (match-end 3) (match-string 3 hd)
- (match-string 1 hd))
- t t hd)))
- (if (string-match org-priority-regexp hd)
- (setq pri (string-to-char (match-string 2 hd))
- hd (concat (substring hd 0 (match-beginning 1))
- (substring hd (match-end 1))))
- (setq pri org-default-priority))
- (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
- (- org-lowest-priority org-highest-priority))))))
-
- (princ (format "BEGIN:VTODO
-UID: %s
-%s
-SUMMARY:%s%s%s%s
-CATEGORIES:%s
-SEQUENCE:1
-PRIORITY:%d
-STATUS:%s
-END:VTODO\n"
- (concat prefix uid)
- (or start dts)
- (or summary hd)
- (if (and location (string-match "\\S-" location))
- (concat "\nLOCATION: " location) "")
- (if (and desc (string-match "\\S-" desc))
- (concat "\nDESCRIPTION: " desc) "")
- (if due (concat "\n" due) "")
- categories
- pri status)))))))))
-
-(defun org-export-get-categories ()
- "Get categories according to `org-icalendar-categories'."
- (let ((cs org-icalendar-categories) c rtn tmp)
- (while (setq c (pop cs))
- (cond
- ((eq c 'category) (push (org-get-category) rtn))
- ((eq c 'todo-state)
- (setq tmp (org-get-todo-state))
- (and tmp (push tmp rtn)))
- ((eq c 'local-tags)
- (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn)))
- ((eq c 'all-tags)
- (setq rtn (append (nreverse (org-get-tags-at (point))) rtn)))))
- (mapconcat 'identity (nreverse rtn) ",")))
-
-(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
- "Take out stuff and quote what needs to be quoted.
-When IS-BODY is non-nil, assume that this is the body of an item, clean up
-whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
-characters."
- (if (not s)
- nil
- (if is-body
- (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
- (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
- (while (string-match re s) (setq s (replace-match "" t t s)))
- (while (string-match re2 s) (setq s (replace-match "" t t s))))
- (setq s (replace-regexp-in-string "[[:space:]]+" " " s)))
- (let ((start 0))
- (while (string-match "\\([,;]\\)" s start)
- (setq start (+ (match-beginning 0) 2)
- s (replace-match "\\\\\\1" nil nil s))))
- (setq s (org-trim s))
- (when is-body
- (while (string-match "[ \t]*\n[ \t]*" s)
- (setq s (replace-match "\\n" t t s))))
- (if is-body
- (if maxlength
- (if (and (numberp maxlength)
- (> (length s) maxlength))
- (setq s (substring s 0 maxlength)))))
- s))
-
-(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength)
- "Take out stuff and quote what needs to be quoted.
-When IS-BODY is non-nil, assume that this is the body of an item, clean up
-whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH
-characters.
-This seems to be more like RFC 2455, but it causes problems, so it is
-not used right now."
- (if (not s)
- nil
- (if is-body
- (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?"))
- (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?")))
- (while (string-match re s) (setq s (replace-match "" t t s)))
- (while (string-match re2 s) (setq s (replace-match "" t t s)))
- (setq s (org-trim s))
- (while (string-match "[ \t]*\n[ \t]*" s)
- (setq s (replace-match "\\n" t t s)))
- (if maxlength
- (if (and (numberp maxlength)
- (> (length s) maxlength))
- (setq s (substring s 0 maxlength)))))
- (setq s (org-trim s)))
- (while (string-match "\"" s) (setq s (replace-match "''" t t s)))
- (when (string-match "[;,:]" s) (setq s (concat "\"" s "\"")))
- s))
-
-(defun org-icalendar-start-file (name)
- "Start an iCalendar file by inserting the header."
- (let ((user user-full-name)
- (name (or name "unknown"))
- (timezone (if (> (length org-icalendar-timezone) 0)
- org-icalendar-timezone
- (cadr (current-time-zone))))
- (description org-icalendar-combined-description))
- (princ
- (format "BEGIN:VCALENDAR
-VERSION:2.0
-X-WR-CALNAME:%s
-PRODID:-//%s//Emacs with Org-mode//EN
-X-WR-TIMEZONE:%s
-X-WR-CALDESC:%s
-CALSCALE:GREGORIAN\n" name user timezone description))))
-
-(defun org-icalendar-finish-file ()
- "Finish an iCalendar file by inserting the END statement."
- (princ "END:VCALENDAR\n"))
-
-(defun org-icalendar-ts-to-string (s keyword &optional inc)
- "Take a time string S and convert it to iCalendar format.
-KEYWORD is added in front, to make a complete line like DTSTART....
-When INC is non-nil, increase the hour by two (if time string contains
-a time), or the day by one (if it does not contain a time)."
- (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault)))
- t2 fmt have-time time)
- (if (not t1)
- ""
- (if (and (car t1) (nth 1 t1) (nth 2 t1))
- (setq t2 t1 have-time t)
- (setq t2 (org-parse-time-string s)))
- (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2))
- (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2)))
- (when inc
- (if have-time
- (if org-agenda-default-appointment-duration
- (setq mi (+ org-agenda-default-appointment-duration mi))
- (setq h (+ 2 h)))
- (setq d (1+ d))))
- (setq time (encode-time s mi h d m y)))
- (setq fmt (if have-time
- (replace-regexp-in-string "%Z"
- org-icalendar-timezone
- org-icalendar-date-time-format t)
- ";VALUE=DATE:%Y%m%d"))
- (concat keyword (format-time-string fmt time
- (and (org-icalendar-use-UTC-date-timep)
- have-time))))))
-
-(provide 'org-icalendar)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-icalendar.el ends here
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index ecf67f72f3a..5c85d7a133e 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -1,6 +1,6 @@
;;; org-id.el --- Global identifiers for Org-mode entries
;;
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -186,7 +186,7 @@ the link."
:type 'boolean)
(defcustom org-id-locations-file (convert-standard-filename
- "~/.emacs.d/.org-id-locations")
+ (concat user-emacs-directory ".org-id-locations"))
"The file for remembering in which file an ID was defined.
This variable is only relevant when `org-id-track-globally' is set."
:group 'org-id
@@ -233,6 +233,7 @@ With optional argument FORCE, force the creation of a new ID."
(org-entry-put (point) "ID" nil))
(org-id-get (point) 'create))
+;;;###autoload
(defun org-id-copy ()
"Copy the ID of the entry at point to the kill ring.
Create an ID if necessary."
@@ -258,6 +259,7 @@ In any case, the ID of the entry is returned."
(org-id-add-location id (buffer-file-name (buffer-base-buffer)))
id)))))
+;;;###autoload
(defun org-id-get-with-outline-path-completion (&optional targets)
"Use `outline-path-completion' to retrieve the ID of an entry.
TARGETS may be a setting for `org-refile-targets' to define
@@ -274,6 +276,7 @@ If necessary, the ID is created."
(prog1 (org-id-get pom 'create)
(move-marker pom nil))))
+;;;###autoload
(defun org-id-get-with-outline-drilling (&optional targets)
"Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
@@ -320,6 +323,7 @@ With optional argument MARKERP, return the position as a new marker."
;; Creating new IDs
+;;;###autoload
(defun org-id-new (&optional prefix)
"Create a new globally unique ID.
@@ -343,7 +347,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(unless (org-uuidgen-p unique)
(setq unique (org-id-uuid))))
((eq org-id-method 'org)
- (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
+ (let* ((etime (org-reverse-string (org-id-time-to-b36)))
(postfix (if org-id-include-domain
(progn
(require 'message)
@@ -376,9 +380,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(substring rnd 18 20)
(substring rnd 20 32))))
-(defun org-id-reverse-string (s)
- (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
-
(defun org-id-int-to-b36-one-digit (i)
"Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z."
(cond
@@ -432,7 +433,7 @@ and time is the usual three-integer representation of time."
(if (= 2 (length parts))
(setq prefix (car parts) time (nth 1 parts))
(setq prefix nil time (nth 0 parts)))
- (setq time (org-id-reverse-string time))
+ (setq time (org-reverse-string time))
(setq time (list (org-id-b36-to-int (substring time 0 4))
(org-id-b36-to-int (substring time 4 8))
(org-id-b36-to-int (substring time 8 12))))
@@ -440,6 +441,7 @@ and time is the usual three-integer representation of time."
;; Storing ID locations (files)
+;;;###autoload
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
@@ -530,7 +532,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(org-id-hash-to-alist org-id-locations)
org-id-locations)))
(with-temp-file org-id-locations-file
- (print out (current-buffer))))))
+ (let ((print-level nil)
+ (print-length nil))
+ (print out (current-buffer)))))))
(defun org-id-locations-load ()
"Read the data from `org-id-locations-file'."
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index 9719a1fa035..c8d33251bf8 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -1,5 +1,5 @@
;;; org-indent.el --- Dynamic indentation for Org-mode
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -88,7 +88,7 @@ This is used locally in each buffer being initialized.")
(defvar org-hide-leading-stars-before-indent-mode nil
"Used locally.")
(defvar org-indent-modified-headline-flag nil
- "Non-nil means the last deletion operated on an headline.
+ "Non-nil means the last deletion operated on a headline.
It is modified by `org-indent-notify-modified-headline'.")
@@ -147,8 +147,8 @@ useful to make it ever so slightly different."
(defsubst org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."
- (with-silent-modifications
- (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
+ (org-with-silent-modifications
+ (remove-text-properties beg end '(line-prefix nil wrap-prefix nil))))
;;;###autoload
(define-minor-mode org-indent-mode
@@ -182,11 +182,11 @@ during idle time."
(org-set-local 'org-hide-leading-stars-before-indent-mode
org-hide-leading-stars)
(org-set-local 'org-hide-leading-stars t))
- (add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (org-indent-remove-properties-from-string
- (funcall fun start end delete)))
- nil t)
+ (org-add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete)))
+ nil t)
(org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
(org-add-hook 'before-change-functions
'org-indent-notify-modified-headline nil 'local)
@@ -213,8 +213,7 @@ during idle time."
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
- (funcall fun start end delete)))
- t)
+ (funcall fun start end delete))))
(remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local)
(remove-hook 'before-change-functions
'org-indent-notify-modified-headline 'local)
@@ -343,50 +342,50 @@ stopped."
;; 2. For each line, set `line-prefix' and `wrap-prefix'
;; properties depending on the type of line (headline,
;; inline task, item or other).
- (with-silent-modifications
- (while (and (<= (point) end) (not (eobp)))
- (cond
- ;; When in asynchronous mode, check if interrupt is
- ;; required.
- ((and delay (input-pending-p)) (throw 'interrupt (point)))
- ;; In asynchronous mode, take a break of
- ;; `org-indent-agent-resume-delay' every DELAY to avoid
- ;; blocking any other idle timer or process output.
- ((and delay (time-less-p time-limit (current-time)))
- (setq org-indent-agent-resume-timer
- (run-with-idle-timer
- (time-add (current-idle-time)
- org-indent-agent-resume-delay)
- nil #'org-indent-initialize-agent))
- (throw 'interrupt (point)))
- ;; Headline or inline task.
- ((looking-at org-outline-regexp)
- (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
- (line (* added-ind-per-lvl (1- nstars)))
- (wrap (+ line (1+ nstars))))
- (cond
- ;; Headline: new value for PF.
- ((looking-at limited-re)
- (org-indent-set-line-properties line wrap t)
- (setq pf wrap))
- ;; End of inline task: PF-INLINE is now nil.
- ((looking-at "\\*+ end[ \t]*$")
- (org-indent-set-line-properties line wrap 'inline)
- (setq pf-inline nil))
- ;; Start of inline task. Determine if it contains
- ;; text, or if it is only one line long. Set
- ;; PF-INLINE accordingly.
- (t (org-indent-set-line-properties line wrap 'inline)
- (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
- ;; List item: `wrap-prefix' is set where body starts.
- ((org-at-item-p)
- (let* ((line (or pf-inline pf 0))
- (wrap (+ (org-list-item-body-column (point)) line)))
- (org-indent-set-line-properties line wrap nil)))
- ;; Normal line: use PF-INLINE, PF or nil as prefixes.
- (t (let* ((line (or pf-inline pf 0))
- (wrap (+ line (org-get-indentation))))
- (org-indent-set-line-properties line wrap nil))))))))))
+ (org-with-silent-modifications
+ (while (and (<= (point) end) (not (eobp)))
+ (cond
+ ;; When in asynchronous mode, check if interrupt is
+ ;; required.
+ ((and delay (input-pending-p)) (throw 'interrupt (point)))
+ ;; In asynchronous mode, take a break of
+ ;; `org-indent-agent-resume-delay' every DELAY to avoid
+ ;; blocking any other idle timer or process output.
+ ((and delay (time-less-p time-limit (current-time)))
+ (setq org-indent-agent-resume-timer
+ (run-with-idle-timer
+ (time-add (current-idle-time)
+ org-indent-agent-resume-delay)
+ nil #'org-indent-initialize-agent))
+ (throw 'interrupt (point)))
+ ;; Headline or inline task.
+ ((looking-at org-outline-regexp)
+ (let* ((nstars (- (match-end 0) (match-beginning 0) 1))
+ (line (* added-ind-per-lvl (1- nstars)))
+ (wrap (+ line (1+ nstars))))
+ (cond
+ ;; Headline: new value for PF.
+ ((looking-at limited-re)
+ (org-indent-set-line-properties line wrap t)
+ (setq pf wrap))
+ ;; End of inline task: PF-INLINE is now nil.
+ ((looking-at "\\*+ end[ \t]*$")
+ (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline nil))
+ ;; Start of inline task. Determine if it contains
+ ;; text, or if it is only one line long. Set
+ ;; PF-INLINE accordingly.
+ (t (org-indent-set-line-properties line wrap 'inline)
+ (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
+ ;; List item: `wrap-prefix' is set where body starts.
+ ((org-at-item-p)
+ (let* ((line (or pf-inline pf 0))
+ (wrap (+ (org-list-item-body-column (point)) line)))
+ (org-indent-set-line-properties line wrap nil)))
+ ;; Normal line: use PF-INLINE, PF or nil as prefixes.
+ (t (let* ((line (or pf-inline pf 0))
+ (wrap (+ line (org-get-indentation))))
+ (org-indent-set-line-properties line wrap nil))))))))))
(defun org-indent-notify-modified-headline (beg end)
"Set `org-indent-modified-headline-flag' depending on context.
@@ -413,7 +412,7 @@ range of inserted text. DUMMY is an unused argument.
This function is meant to be called by `after-change-functions'."
(when org-indent-mode
(save-match-data
- ;; If an headline was modified or inserted, set properties until
+ ;; If a headline was modified or inserted, set properties until
;; next headline.
(if (or org-indent-modified-headline-flag
(save-excursion
diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el
index 421dde8e204..1c18793d3a9 100644
--- a/lisp/org/org-info.el
+++ b/lisp/org/org-info.el
@@ -1,6 +1,6 @@
;;; org-info.el --- Support for links to Info nodes from within Org-Mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index 43913acacde..38b68e1884d 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -1,6 +1,6 @@
;;; org-inlinetask.el --- Tasks independent of outline hierarchy
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -27,31 +27,25 @@
;;; Commentary:
;;
;; This module implements inline tasks in Org-mode. Inline tasks are
-;; tasks that have all the properties of normal outline nodes, including
-;; the ability to store meta data like scheduling dates, TODO state, tags
-;; and properties. However, these nodes are treated specially by the
-;; visibility cycling and export commands.
+;; tasks that have all the properties of normal outline nodes,
+;; including the ability to store meta data like scheduling dates,
+;; TODO state, tags and properties. However, these nodes are treated
+;; specially by the visibility cycling.
;;
-;; Visibility cycling exempts these nodes from cycling. So whenever their
-;; parent is opened, so are these tasks. This will only work with
-;; `org-cycle', so if you are also using other commands to show/hide
-;; entries, you will occasionally find these tasks to behave like
-;; all other outline nodes, seemingly splitting the text of the parent
-;; into children.
+;; Visibility cycling exempts these nodes from cycling. So whenever
+;; their parent is opened, so are these tasks. This will only work
+;; with `org-cycle', so if you are also using other commands to
+;; show/hide entries, you will occasionally find these tasks to behave
+;; like all other outline nodes, seemingly splitting the text of the
+;; parent into children.
;;
-;; Export commands do not treat these nodes as part of the sectioning
-;; structure, but as a special inline text that is either removed, or
-;; formatted in some special way. This in handled by
-;; `org-inlinetask-export' and `org-inlinetask-export-templates'
-;; variables.
+;; Special fontification of inline tasks, so that they can be
+;; immediately recognized. From the stars of the headline, only the
+;; first and the last two will be visible, the others will be hidden
+;; using the `org-hide' face.
;;
-;; Special fontification of inline tasks, so that they can be immediately
-;; recognized. From the stars of the headline, only the first and the
-;; last two will be visible, the others will be hidden using the
-;; `org-hide' face.
-;;
-;; An inline task is identified solely by a minimum outline level, given
-;; by the variable `org-inlinetask-min-level', default 15.
+;; An inline task is identified solely by a minimum outline level,
+;; given by the variable `org-inlinetask-min-level', default 15.
;;
;; If you need to have a time planning line (DEADLINE etc), drawers,
;; for example LOGBOOK of PROPERTIES, or even normal text as part of
@@ -109,71 +103,9 @@ the value of this variable."
"Non-nil means display the first star of an inline task as additional marker.
When nil, the first star is not shown."
:tag "Org Inline Tasks"
- :group 'org-structure)
-
-(defcustom org-inlinetask-export t
- "Non-nil means export inline tasks.
-When nil, they will not be exported."
- :group 'org-inlinetask
+ :group 'org-structure
:type 'boolean)
-(defvar org-inlinetask-export-templates
- '((html "<div class=\"inlinetask\"><b>%s%s</b><br />%s</div>"
- '((unless (eq todo "")
- (format "<span class=\"%s %s\">%s%s</span> "
- class todo todo priority))
- heading content))
- (odt "%s" '((org-odt-format-inlinetask heading content
- todo priority tags)))
-
- (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}"
- '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority))
- heading content))
- (ascii " -- %s%s%s"
- '((unless (eq todo "") (format "%s%s " todo priority))
- heading
- (unless (eq content "")
- (format "\n ¦ %s"
- (mapconcat 'identity (org-split-string content "\n")
- "\n ¦ ")))))
- (docbook "<variablelist>
-<varlistentry>
-<term>%s%s</term>
-<listitem><para>%s</para></listitem>
-</varlistentry>
-</variablelist>"
- '((unless (eq todo "") (format "%s%s " todo priority))
- heading content)))
- "Templates for inline tasks in various exporters.
-
-This variable is an alist in the shape of \(BACKEND STRING OBJECTS\).
-
-BACKEND is the name of the backend for the template \(ascii, html...\).
-
-STRING is a format control string.
-
-OBJECTS is a list of elements to be substituted into the format
-string. They can be of any type, from a string to a form
-returning a value (thus allowing conditional insertion). A nil
-object will be substituted as the empty string. Obviously, there
-must be at least as many objects as %-sequences in the format
-string.
-
-Moreover, the following special keywords are provided: `todo',
-`priority', `heading', `content', `tags'. If some of them are not
-defined in an inline task, their value is the empty string.
-
-As an example, valid associations are:
-
-\(html \"<ul><li>%s <p>%s</p></li></ul>\" \(heading content\)\)
-
-or, with the additional package \"todonotes\" for LaTeX,
-
-\(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\"
- '\(\(unless \(eq todo \"\"\)
- \(format \"\\textsc{%s%s}\" todo priority\)\)
- heading content\)\)\)")
-
(defvar org-odd-levels-only)
(defvar org-keyword-time-regexp)
(defvar org-drawer-regexp)
@@ -328,89 +260,6 @@ If the task has an end part, also demote it."
(goto-char beg)
(org-fixup-indentation diff)))))))
-(defvar org-export-current-backend) ; dynamically bound in org-exp.el
-(defun org-inlinetask-export-handler ()
- "Handle headlines with level larger or equal to `org-inlinetask-min-level'.
-Either remove headline and meta data, or do special formatting."
- (goto-char (point-min))
- (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp))
- (inline-re (concat (org-inlinetask-outline-regexp) ".*")))
- (while (re-search-forward inline-re nil t)
- (let ((headline (match-string 0))
- (beg (point-at-bol))
- (end (copy-marker (save-excursion
- (org-inlinetask-goto-end) (point))))
- content)
- ;; Delete SCHEDULED, DEADLINE...
- (while (re-search-forward keywords-re end t)
- (delete-region (point-at-bol) (1+ (point-at-eol))))
- (goto-char beg)
- ;; Delete drawers
- (while (re-search-forward org-drawer-regexp end t)
- (when (save-excursion (re-search-forward org-property-end-re nil t))
- (delete-region beg (1+ (match-end 0)))))
- ;; Get CONTENT, if any.
- (goto-char beg)
- (forward-line 1)
- (unless (= (point) end)
- (setq content (buffer-substring (point)
- (save-excursion (goto-char end)
- (forward-line -1)
- (point)))))
- ;; Remove the task.
- (goto-char beg)
- (delete-region beg end)
- (when (and org-inlinetask-export
- (assq org-export-current-backend
- org-inlinetask-export-templates))
- ;; Format CONTENT, if appropriate.
- (setq content
- (if (not (and content (string-match "\\S-" content)))
- ""
- ;; Ensure CONTENT has minimal indentation, a single
- ;; newline character at its boundaries, and isn't
- ;; protected.
- (when (string-match "\\`\\([ \t]*\n\\)+" content)
- (setq content (substring content (match-end 0))))
- (when (string-match "[ \t\n]+\\'" content)
- (setq content (substring content 0 (match-beginning 0))))
- (org-add-props
- (concat "\n\n" (org-remove-indentation content) "\n\n")
- '(org-protected nil org-native-text nil))))
-
- (when (string-match org-complex-heading-regexp headline)
- (let* ((nil-to-str
- (function
- ;; Change nil arguments into empty strings.
- (lambda (el) (or (eval el) ""))))
- ;; Set up keywords provided to templates.
- (todo (or (match-string 2 headline) ""))
- (class (or (and (eq "" todo) "")
- (if (member todo org-done-keywords) "done" "todo")))
- (priority (or (match-string 3 headline) ""))
- (heading (or (match-string 4 headline) ""))
- (tags (or (match-string 5 headline) ""))
- ;; Read `org-inlinetask-export-templates'.
- (backend-spec (assq org-export-current-backend
- org-inlinetask-export-templates))
- (format-str (org-add-props (nth 1 backend-spec)
- '(org-protected t org-native-text t)))
- (tokens (cadr (nth 2 backend-spec)))
- ;; Build export string. Ensure it won't break
- ;; surrounding lists by giving it arbitrary high
- ;; indentation.
- (export-str (org-add-props
- (eval (append '(format format-str)
- (mapcar nil-to-str tokens)))
- '(original-indentation 1000))))
- ;; Ensure task starts a new paragraph.
- (unless (or (bobp)
- (save-excursion (forward-line -1)
- (looking-at "[ \t]*$")))
- (insert "\n"))
- (insert export-str)
- (unless (bolp) (insert "\n")))))))))
-
(defun org-inlinetask-get-current-indentation ()
"Get the indentation of the last non-while line above this one."
(save-excursion
@@ -467,7 +316,8 @@ Either remove headline and meta data, or do special formatting."
((= end start))
;; Inlinetask was folded: expand it.
((get-char-property (1+ start) 'invisible)
- (org-show-entry))
+ (outline-flag-region start end nil)
+ (org-cycle-hide-drawers 'children))
(t (outline-flag-region start end t)))))
(defun org-inlinetask-remove-END-maybe ()
@@ -476,9 +326,6 @@ Either remove headline and meta data, or do special formatting."
org-inlinetask-min-level))
(replace-match "")))
-(eval-after-load "org-exp"
- '(add-hook 'org-export-preprocess-before-backend-specifics-hook
- 'org-inlinetask-export-handler))
(eval-after-load "org"
'(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el
index afacae3ec34..1ec69d83738 100644
--- a/lisp/org/org-irc.el
+++ b/lisp/org/org-irc.el
@@ -1,6 +1,6 @@
;;; org-irc.el --- Store links to IRC sessions
;;
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
;; Author: Philip Jackson <emacs@shellarchive.co.uk>
;; Keywords: erc, irc, link, org
@@ -105,10 +105,10 @@ attributes that are found."
((eq major-mode 'erc-mode)
(org-irc-erc-store-link))))
-(defun org-irc-elipsify-description (string &optional after)
+(defun org-irc-ellipsify-description (string &optional after)
"Remove unnecessary white space from STRING and add ellipses if necessary.
Strip starting and ending white space from STRING and replace any
-chars that the value AFTER with '...'"
+chars that the value AFTER with `...'"
(let* ((after (number-to-string (or after 30)))
(replace-map (list (cons "^[ \t]*" "")
(cons "[ \t]*$" "")
@@ -158,7 +158,7 @@ the session itself."
(progn
(org-store-link-props
:type "file"
- :description (concat "'" (org-irc-elipsify-description
+ :description (concat "'" (org-irc-ellipsify-description
(cadr parsed-line) 20)
"' from an IRC conversation")
:link (concat "file:" (car parsed-line) "::"
@@ -172,7 +172,7 @@ the session itself."
(org-store-link-props
:type "irc"
:link (concat "irc:/" link-text)
- :description (concat "irc session '" link-text "'")
+ :description (concat "irc session `" link-text "'")
:server (car (car link))
:port (or (string-to-number (cadr (pop link))) erc-default-port)
:nick (pop link))
diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el
deleted file mode 100644
index 08c01108b98..00000000000
--- a/lisp/org/org-jsinfo.el
+++ /dev/null
@@ -1,262 +0,0 @@
-;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements the support for Sebastian Rose's JavaScript
-;; org-info.js to display an org-mode file exported to HTML in an
-;; Info-like way, or using folding similar to the outline structure
-;; org org-mode itself.
-
-;; Documentation for using this module is in the Org manual. The script
-;; itself is documented by Sebastian Rose in a file distributed with
-;; the script. FIXME: Accurate pointers!
-
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'org-exp)
-(require 'org-html)
-
-(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt))
-(add-hook 'org-export-options-filters 'org-infojs-handle-options)
-
-(defgroup org-infojs nil
- "Options specific for using org-info.js in HTML export of Org-mode files."
- :tag "Org Export HTML INFOJS"
- :group 'org-export-html)
-
-(defcustom org-export-html-use-infojs 'when-configured
- "Should Sebastian Rose's Java Script org-info.js be linked into HTML files?
-This option can be nil or t to never or always use the script. It can
-also be the symbol `when-configured', meaning that the script will be
-linked into the export file if and only if there is a \"#+INFOJS_OPT:\"
-line in the buffer. See also the variable `org-infojs-options'."
- :group 'org-export-html
- :group 'org-infojs
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "When configured in buffer" when-configured)
- (const :tag "Always" t)))
-
-(defconst org-infojs-opts-table
- '((path PATH "http://orgmode.org/org-info.js")
- (view VIEW "info")
- (toc TOC :table-of-contents)
- (ftoc FIXED_TOC "0")
- (tdepth TOC_DEPTH "max")
- (sdepth SECTION_DEPTH "max")
- (mouse MOUSE_HINT "underline")
- (buttons VIEW_BUTTONS "0")
- (ltoc LOCAL_TOC "1")
- (up LINK_UP :link-up)
- (home LINK_HOME :link-home))
- "JavaScript options, long form for script, default values.")
-
-(defvar org-infojs-options)
-(when (and (boundp 'org-infojs-options)
- (assq 'runs org-infojs-options))
- (setq org-infojs-options (delq (assq 'runs org-infojs-options)
- org-infojs-options)))
-
-(defcustom org-infojs-options
- (mapcar (lambda (x) (cons (car x) (nth 2 x)))
- org-infojs-opts-table)
- "Options settings for the INFOJS JavaScript.
-Each of the options must have an entry in `org-export-html/infojs-opts-table'.
-The value can either be a string that will be passed to the script, or
-a property. This property is then assumed to be a property that is defined
-by the Export/Publishing setup of Org.
-The `sdepth' and `tdepth' parameters can also be set to \"max\", which
-means to use the maximum value consistent with other options."
- :group 'org-infojs
- :type
- `(set :greedy t :inline t
- ,@(mapcar
- (lambda (x)
- (list 'cons (list 'const (car x))
- '(choice
- (symbol :tag "Publishing/Export property")
- (string :tag "Value"))))
- org-infojs-opts-table)))
-
-(defcustom org-infojs-template
- "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
-/**
- *
- * @source: %SCRIPT_PATH
- *
- * @licstart The following is the entire license notice for the
- * JavaScript code in %SCRIPT_PATH.
- *
- * Copyright (C) 2012-2013 Sebastian Rose
- *
- *
- * The JavaScript code in this tag is free software: you can
- * redistribute it and/or modify it under the terms of the GNU
- * General Public License (GNU GPL) as published by the Free Software
- * Foundation, either version 3 of the License, or (at your option)
- * any later version. The code is distributed WITHOUT ANY WARRANTY;
- * without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
- *
- * As additional permission under GNU GPL version 3 section 7, you
- * may distribute non-source (e.g., minimized or compacted) forms of
- * that code without the copy of the GNU GPL normally required by
- * section 4, provided you include this license notice and a URL
- * through which recipients can access the Corresponding Source.
- *
- * @licend The above is the entire license notice
- * for the JavaScript code in %SCRIPT_PATH.
- *
- */
-</script>
-
-<script type=\"text/javascript\">
-
-/*
-@licstart The following is the entire license notice for the
-JavaScript code in this tag.
-
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
-
-The JavaScript code in this tag is free software: you can
-redistribute it and/or modify it under the terms of the GNU
-General Public License (GNU GPL) as published by the Free Software
-Foundation, either version 3 of the License, or (at your option)
-any later version. The code is distributed WITHOUT ANY WARRANTY;
-without even the implied warranty of MERCHANTABILITY or FITNESS
-FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
-
-As additional permission under GNU GPL version 3 section 7, you
-may distribute non-source (e.g., minimized or compacted) forms of
-that code without the copy of the GNU GPL normally required by
-section 4, provided you include this license notice and a URL
-through which recipients can access the Corresponding Source.
-
-
-@licend The above is the entire license notice
-for the JavaScript code in this tag.
-*/
-
-<!--/*--><![CDATA[/*><!--*/
-%MANAGER_OPTIONS
-org_html_manager.setup(); // activate after the parameters are set
-/*]]>*///-->
-</script>"
- "The template for the export style additions when org-info.js is used.
-Option settings will replace the %MANAGER-OPTIONS cookie."
- :group 'org-infojs
- :type 'string)
-
-(defun org-infojs-handle-options (exp-plist)
- "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly."
- (if (or (not org-export-html-use-infojs)
- (and (eq org-export-html-use-infojs 'when-configured)
- (or (not (plist-get exp-plist :infojs-opt))
- (string-match "\\<view:nil\\>"
- (plist-get exp-plist :infojs-opt)))))
- ;; We do not want to use the script
- exp-plist
- ;; We do want to use the script, set it up
- (let ((template org-infojs-template)
- (ptoc (plist-get exp-plist :table-of-contents))
- (hlevels (plist-get exp-plist :headline-levels))
- tdepth sdepth s v e opt var val table default)
- (setq sdepth hlevels
- tdepth hlevels)
- (if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
- (setq v (plist-get exp-plist :infojs-opt)
- table org-infojs-opts-table)
- (while (setq e (pop table))
- (setq opt (car e) var (nth 1 e)
- default (cdr (assoc opt org-infojs-options)))
- (and (symbolp default) (not (memq default '(t nil)))
- (setq default (plist-get exp-plist default)))
- (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
- (setq val (match-string 1 v))
- (setq val default))
- (cond
- ((eq opt 'path)
- (setq template
- (replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
- ((eq opt 'sdepth)
- (if (integerp (read val))
- (setq sdepth (min (read val) hlevels))))
- ((eq opt 'tdepth)
- (if (integerp (read val))
- (setq tdepth (min (read val) hlevels))))
- (t
- (setq val
- (cond
- ((or (eq val t) (equal val "t")) "1")
- ((or (eq val nil) (equal val "nil")) "0")
- ((stringp val) val)
- (t (format "%s" val))))
- (push (cons var val) s))))
-
- ;; Now we set the depth of the *generated* TOC to SDEPTH, because the
- ;; toc will actually determine the splitting. How much of the toc will
- ;; actually be displayed is governed by the TDEPTH option.
- (setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
-
- ;; The table of contents should not show more sections then we generate
- (setq tdepth (min tdepth sdepth))
- (push (cons "TOC_DEPTH" tdepth) s)
-
- (setq s (mapconcat
- (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
- (car x) (cdr x)))
- s "\n"))
- (when (and s (> (length s) 0))
- (and (string-match "%MANAGER_OPTIONS" template)
- (setq s (replace-match s t t template))
- (setq exp-plist
- (plist-put
- exp-plist :style-extra
- (concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
- ;; This script absolutely needs the table of contents, to we change that
- ;; setting
- (if (not (plist-get exp-plist :table-of-contents))
- (setq exp-plist (plist-put exp-plist :table-of-contents t)))
- ;; Return the modified property list
- exp-plist)))
-
-(defun org-infojs-options-inbuffer-template ()
- (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"
- (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil)
- (let ((a (cdr (assoc 'toc org-infojs-options))))
- (cond ((memq a '(nil t)) a)
- (t (plist-get (org-infile-export-plist) :table-of-contents))))
- (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil)
- (cdr (assoc 'mouse org-infojs-options))
- (cdr (assoc 'buttons org-infojs-options))
- (cdr (assoc 'path org-infojs-options))))
-
-(provide 'org-infojs)
-(provide 'org-jsinfo)
-
-;;; org-jsinfo.el ends here
diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el
deleted file mode 100644
index 609bcbee103..00000000000
--- a/lisp/org/org-latex.el
+++ /dev/null
@@ -1,2901 +0,0 @@
-;;; org-latex.el --- LaTeX exporter for org-mode
-;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: org-latex.el
-;; Author: Bastien Guerry <bzg AT gnu DOT org>
-;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
-;; Keywords: org, wp, tex
-;; Description: Converts an org-mode buffer into LaTeX
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library implements a LaTeX exporter for org-mode.
-;;
-;; It is part of Org and will be autoloaded
-;;
-;; The interactive functions are similar to those of the HTML exporter:
-;;
-;; M-x `org-export-as-latex'
-;; M-x `org-export-as-pdf'
-;; M-x `org-export-as-pdf-and-open'
-;; M-x `org-export-as-latex-batch'
-;; M-x `org-export-as-latex-to-buffer'
-;; M-x `org-export-region-as-latex'
-;; M-x `org-replace-region-by-latex'
-;;
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'footnote)
-(require 'org)
-(require 'org-exp)
-(require 'org-macs)
-(require 'org-beamer)
-
-;;; Variables:
-(defvar org-export-latex-class nil)
-(defvar org-export-latex-class-options nil)
-(defvar org-export-latex-header nil)
-(defvar org-export-latex-append-header nil)
-(defvar org-export-latex-options-plist nil)
-(defvar org-export-latex-todo-keywords-1 nil)
-(defvar org-export-latex-complex-heading-re nil)
-(defvar org-export-latex-not-done-keywords nil)
-(defvar org-export-latex-done-keywords nil)
-(defvar org-export-latex-display-custom-times nil)
-(defvar org-export-latex-all-targets-re nil)
-(defvar org-export-latex-add-level 0)
-(defvar org-export-latex-footmark-seen nil
- "List of footnotes markers seen so far by exporter.")
-(defvar org-export-latex-sectioning "")
-(defvar org-export-latex-sectioning-depth 0)
-(defvar org-export-latex-special-keyword-regexp
- (concat "\\<\\(" org-scheduled-string "\\|"
- org-deadline-string "\\|"
- org-closed-string"\\)")
- "Regexp matching special time planning keywords plus the time after it.")
-(defvar org-re-quote) ; dynamically scoped from org.el
-(defvar org-commentsp) ; dynamically scoped from org.el
-
-;;; User variables:
-
-(defgroup org-export-latex nil
- "Options for exporting Org-mode files to LaTeX."
- :tag "Org Export LaTeX"
- :group 'org-export)
-
-(defcustom org-export-latex-default-class "article"
- "The default LaTeX class."
- :group 'org-export-latex
- :type '(string :tag "LaTeX class"))
-
-(defcustom org-export-latex-classes
- '(("article"
- "\\documentclass[11pt]{article}"
- ("\\section{%s}" . "\\section*{%s}")
- ("\\subsection{%s}" . "\\subsection*{%s}")
- ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
- ("\\paragraph{%s}" . "\\paragraph*{%s}")
- ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
- ("report"
- "\\documentclass[11pt]{report}"
- ("\\part{%s}" . "\\part*{%s}")
- ("\\chapter{%s}" . "\\chapter*{%s}")
- ("\\section{%s}" . "\\section*{%s}")
- ("\\subsection{%s}" . "\\subsection*{%s}")
- ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
- ("book"
- "\\documentclass[11pt]{book}"
- ("\\part{%s}" . "\\part*{%s}")
- ("\\chapter{%s}" . "\\chapter*{%s}")
- ("\\section{%s}" . "\\section*{%s}")
- ("\\subsection{%s}" . "\\subsection*{%s}")
- ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
- ("beamer"
- "\\documentclass{beamer}"
- org-beamer-sectioning
- ))
- "Alist of LaTeX classes and associated header and structure.
-If #+LaTeX_CLASS is set in the buffer, use its value and the
-associated information. Here is the structure of each cell:
-
- \(class-name
- header-string
- (numbered-section . unnumbered-section\)
- ...\)
-
-The header string
------------------
-
-The HEADER-STRING is the header that will be inserted into the LaTeX file.
-It should contain the \\documentclass macro, and anything else that is needed
-for this setup. To this header, the following commands will be added:
-
-- Calls to \\usepackage for all packages mentioned in the variables
- `org-export-latex-default-packages-alist' and
- `org-export-latex-packages-alist'. Thus, your header definitions should
- avoid to also request these packages.
-
-- Lines specified via \"#+LaTeX_HEADER:\"
-
-If you need more control about the sequence in which the header is built
-up, or if you want to exclude one of these building blocks for a particular
-class, you can use the following macro-like placeholders.
-
- [DEFAULT-PACKAGES] \\usepackage statements for default packages
- [NO-DEFAULT-PACKAGES] do not include any of the default packages
- [PACKAGES] \\usepackage statements for packages
- [NO-PACKAGES] do not include the packages
- [EXTRA] the stuff from #+LaTeX_HEADER
- [NO-EXTRA] do not include #+LaTeX_HEADER stuff
- [BEAMER-HEADER-EXTRA] the beamer extra headers
-
-So a header like
-
- \\documentclass{article}
- [NO-DEFAULT-PACKAGES]
- [EXTRA]
- \\providecommand{\\alert}[1]{\\textbf{#1}}
- [PACKAGES]
-
-will omit the default packages, and will include the #+LaTeX_HEADER lines,
-then have a call to \\providecommand, and then place \\usepackage commands
-based on the content of `org-export-latex-packages-alist'.
-
-If your header or `org-export-latex-default-packages-alist' inserts
-\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with
-a coding system derived from `buffer-file-coding-system'. See also the
-variable `org-export-latex-inputenc-alist' for a way to influence this
-mechanism.
-
-The sectioning structure
-------------------------
-
-The sectioning structure of the class is given by the elements following
-the header string. For each sectioning level, a number of strings is
-specified. A %s formatter is mandatory in each section string and will
-be replaced by the title of the section.
-
-Instead of a cons cell (numbered . unnumbered), you can also provide a list
-of 2 or 4 elements,
-
- (numbered-open numbered-close)
-
-or
-
- (numbered-open numbered-close unnumbered-open unnumbered-close)
-
-providing opening and closing strings for a LaTeX environment that should
-represent the document section. The opening clause should have a %s
-to represent the section title.
-
-Instead of a list of sectioning commands, you can also specify a
-function name. That function will be called with two parameters,
-the (reduced) level of the headline, and the headline text. The function
-must return a cons cell with the (possibly modified) headline text, and the
-sectioning list in the cdr."
- :group 'org-export-latex
- :type '(repeat
- (list (string :tag "LaTeX class")
- (string :tag "LaTeX header")
- (repeat :tag "Levels" :inline t
- (choice
- (cons :tag "Heading"
- (string :tag " numbered")
- (string :tag "unnumbered"))
- (list :tag "Environment"
- (string :tag "Opening (numbered)")
- (string :tag "Closing (numbered)")
- (string :tag "Opening (unnumbered)")
- (string :tag "Closing (unnumbered)"))
- (function :tag "Hook computing sectioning"))))))
-
-(defcustom org-export-latex-inputenc-alist nil
- "Alist of inputenc coding system names, and what should really be used.
-For example, adding an entry
-
- (\"utf8\" . \"utf8x\")
-
-will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
-are written as utf8 files."
- :group 'org-export-latex
- :version "24.1"
- :type '(repeat
- (cons
- (string :tag "Derived from buffer")
- (string :tag "Use this instead"))))
-
-
-(defcustom org-export-latex-emphasis-alist
- '(("*" "\\textbf{%s}" nil)
- ("/" "\\emph{%s}" nil)
- ("_" "\\underline{%s}" nil)
- ("+" "\\st{%s}" nil)
- ("=" "\\protectedtexttt" t)
- ("~" "\\verb" t))
- "Alist of LaTeX expressions to convert emphasis fontifiers.
-Each element of the list is a list of three elements.
-The first element is the character used as a marker for fontification.
-The second element is a format string to wrap fontified text with.
-If it is \"\\verb\", Org will automatically select a delimiter
-character that is not in the string. \"\\protectedtexttt\" will use \\texttt
-to typeset and try to protect special characters.
-The third element decides whether to protect converted text from other
-conversions."
- :group 'org-export-latex
- :type 'alist)
-
-(defcustom org-export-latex-title-command "\\maketitle"
- "The command used to insert the title just after \\begin{document}.
-If this string contains the formatting specification \"%s\" then
-it will be used as a format string, passing the title as an
-argument."
- :group 'org-export-latex
- :type 'string)
-
-(defcustom org-export-latex-import-inbuffer-stuff nil
- "Non-nil means define TeX macros for Org's inbuffer definitions.
-For example \orgTITLE for #+TITLE."
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-latex-date-format
- "\\today"
- "Format string for \\date{...}."
- :group 'org-export-latex
- :type 'string)
-
-(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}"
- "Markup for TODO keywords, as a printf format.
-This can be a single format for all keywords, a cons cell with separate
-formats for not-done and done states, or an association list with setup
-for individual keywords. If a keyword shows up for which there is no
-markup defined, the first one in the association list will be used."
- :group 'org-export-latex
- :type '(choice
- (string :tag "Default")
- (cons :tag "Distinguish undone and done"
- (string :tag "Not-DONE states")
- (string :tag "DONE states"))
- (repeat :tag "Per keyword markup"
- (cons
- (string :tag "Keyword")
- (string :tag "Markup")))))
-
-(defcustom org-export-latex-tag-markup "\\textbf{%s}"
- "Markup for tags, as a printf format."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-timestamp-markup "\\textit{%s}"
- "A printf format string to be applied to time stamps."
- :group 'org-export-latex
- :type 'string)
-
-(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}"
- "A printf format string to be applied to inactive time stamps."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}"
- "A printf format string to be applied to time stamps."
- :group 'org-export-latex
- :type 'string)
-
-(defcustom org-export-latex-href-format "\\href{%s}{%s}"
- "A printf format string to be applied to href links.
-The format must contain either two %s instances or just one.
-If it contains two %s instances, the first will be filled with
-the link, the second with the link description. If it contains
-only one, the %s will be filled with the link."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}"
- "A printf format string to be applied to hyperref links.
-The format must contain one or two %s instances. The first one
-will be filled with the link, the second with its description."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-hyperref-options-format
- "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n"
- "A format string for hyperref options.
-When non-nil, it must contain three %s format specifications
-which will respectively be replaced by the document's keywords,
-its description and the Org's version number, as a string. Set
-this option to the empty string if you don't want to include
-hyperref options altogether."
- :type 'string
- :version "24.3"
- :group 'org-export-latex)
-
-(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\,"
- "Text used to separate footnotes."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-quotes
- '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'"))
- ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`")))
- "Alist for quotes to use when converting english double-quotes.
-
-The CAR of each item in this alist is the language code.
-The CDR of each item in this alist is a list of three CONS:
-- the first CONS defines the opening quote;
-- the second CONS defines the closing quote;
-- the last CONS defines single quotes.
-
-For each item in a CONS, the first string is a regexp
-for allowed characters before/after the quote, the second
-string defines the replacement string for this quote."
- :group 'org-export-latex
- :version "24.1"
- :type '(list
- (cons :tag "Opening quote"
- (string :tag "Regexp for char before")
- (string :tag "Replacement quote "))
- (cons :tag "Closing quote"
- (string :tag "Regexp for char after ")
- (string :tag "Replacement quote "))
- (cons :tag "Single quote"
- (string :tag "Regexp for char before")
- (string :tag "Replacement quote "))))
-
-(defcustom org-export-latex-tables-verbatim nil
- "When non-nil, tables are exported verbatim."
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-latex-tables-centered t
- "When non-nil, tables are exported in a center environment."
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-latex-table-caption-above t
- "When non-nil, the caption is set above the table. When nil,
-the caption is set below the table."
- :group 'org-export-latex
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-latex-tables-column-borders nil
- "When non-nil, grouping columns can cause outer vertical lines in tables.
-When nil, grouping causes only separation lines between groups."
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-latex-tables-tstart nil
- "LaTeX command for top rule for tables."
- :group 'org-export-latex
- :version "24.1"
- :type '(choice
- (const :tag "Nothing" nil)
- (string :tag "String")
- (const :tag "Booktabs default: \\toprule" "\\toprule")))
-
-(defcustom org-export-latex-tables-hline "\\hline"
- "LaTeX command to use for a rule somewhere in the middle of a table."
- :group 'org-export-latex
- :version "24.1"
- :type '(choice
- (string :tag "String")
- (const :tag "Standard: \\hline" "\\hline")
- (const :tag "Booktabs default: \\midrule" "\\midrule")))
-
-(defcustom org-export-latex-tables-tend nil
- "LaTeX command for bottom rule for tables."
- :group 'org-export-latex
- :version "24.1"
- :type '(choice
- (const :tag "Nothing" nil)
- (string :tag "String")
- (const :tag "Booktabs default: \\bottomrule" "\\bottomrule")))
-
-(defcustom org-export-latex-low-levels 'itemize
- "How to convert sections below the current level of sectioning.
-This is specified by the `org-export-headline-levels' option or the
-value of \"H:\" in Org's #+OPTION line.
-
-This can be either nil (skip the sections), `description', `itemize',
-or `enumerate' (convert the sections as the corresponding list type), or
-a string to be used instead of \\section{%s}. In this latter case,
-the %s stands here for the inserted headline and is mandatory.
-
-It may also be a list of three string to define a user-defined environment
-that should be used. The first string should be the like
-\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up
-to two occurrences of %s for the title and a label, respectively. The third
-string should be like \"\\end{itemize\"."
- :group 'org-export-latex
- :type '(choice (const :tag "Ignore" nil)
- (const :tag "Convert as descriptive list" description)
- (const :tag "Convert as itemized list" itemize)
- (const :tag "Convert as enumerated list" enumerate)
- (list :tag "User-defined environment"
- :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s")
- (string :tag "Start")
- (string :tag "End")
- (string :tag "item"))
- (string :tag "Use a section string" :value "\\subparagraph{%s}")))
-
-(defcustom org-export-latex-list-parameters
- '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$")
- "Parameters for the LaTeX list exporter.
-These parameters will be passed on to `org-list-to-latex', which in turn
-will pass them (combined with the LaTeX default list parameters) to
-`org-list-to-generic'."
- :group 'org-export-latex
- :type 'plist)
-
-(defcustom org-export-latex-verbatim-wrap
- '("\\begin{verbatim}\n" . "\\end{verbatim}")
- "Environment to be wrapped around a fixed-width section in LaTeX export.
-This is a cons with two strings, to be added before and after the
-fixed-with text.
-
-Defaults to \\begin{verbatim} and \\end{verbatim}."
- :group 'org-export-translation
- :group 'org-export-latex
- :type '(cons (string :tag "Open")
- (string :tag "Close")))
-
-(defcustom org-export-latex-listings nil
- "Non-nil means export source code using the listings package.
-This package will fontify source code, possibly even with color.
-If you want to use this, you also need to make LaTeX use the
-listings package, and if you want to have color, the color
-package. Just add these to `org-export-latex-packages-alist',
-for example using customize, or with something like
-
- (require 'org-latex)
- (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\"))
- (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\"))
-
-Alternatively,
-
- (setq org-export-latex-listings 'minted)
-
-causes source code to be exported using the minted package as
-opposed to listings. If you want to use minted, you need to add
-the minted package to `org-export-latex-packages-alist', for
-example using customize, or with
-
- (require 'org-latex)
- (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\"))
-
-In addition, it is necessary to install
-pygments (http://pygments.org), and to configure the variable
-`org-latex-to-pdf-process' so that the -shell-escape option is
-passed to pdflatex.
-"
- :group 'org-export-latex
- :type 'boolean)
-
-(defcustom org-export-latex-listings-langs
- '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
- (c "C") (cc "C++")
- (fortran "fortran")
- (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
- (html "HTML") (xml "XML")
- (tex "TeX") (latex "TeX")
- (shell-script "bash")
- (gnuplot "Gnuplot")
- (ocaml "Caml") (caml "Caml")
- (sql "SQL") (sqlite "sql"))
- "Alist mapping languages to their listing language counterpart.
-The key is a symbol, the major mode symbol without the \"-mode\".
-The value is the string that should be inserted as the language parameter
-for the listings package. If the mode name and the listings name are
-the same, the language does not need an entry in this list - but it does not
-hurt if it is present."
- :group 'org-export-latex
- :type '(repeat
- (list
- (symbol :tag "Major mode ")
- (string :tag "Listings language"))))
-
-(defcustom org-export-latex-listings-w-names t
- "Non-nil means export names of named code blocks.
-Code blocks exported with the listings package (controlled by the
-`org-export-latex-listings' variable) can be named in the style
-of noweb."
- :group 'org-export-latex
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-export-latex-minted-langs
- '((emacs-lisp "common-lisp")
- (cc "c++")
- (cperl "perl")
- (shell-script "bash")
- (caml "ocaml"))
- "Alist mapping languages to their minted language counterpart.
-The key is a symbol, the major mode symbol without the \"-mode\".
-The value is the string that should be inserted as the language parameter
-for the minted package. If the mode name and the listings name are
-the same, the language does not need an entry in this list - but it does not
-hurt if it is present.
-
-Note that minted uses all lower case for language identifiers,
-and that the full list of language identifiers can be obtained
-with:
-pygmentize -L lexers
-"
- :group 'org-export-latex
- :version "24.1"
- :type '(repeat
- (list
- (symbol :tag "Major mode ")
- (string :tag "Listings language"))))
-
-(defcustom org-export-latex-listings-options nil
- "Association list of options for the latex listings package.
-
-These options are supplied as a comma-separated list to the
-\\lstset command. Each element of the association list should be
-a list containing two strings: the name of the option, and the
-value. For example,
-
- (setq org-export-latex-listings-options
- '((\"basicstyle\" \"\\small\")
- (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
-
-will typeset the code in a small size font with underlined, bold
-black keywords.
-
-Note that the same options will be applied to blocks of all
-languages."
- :group 'org-export-latex
- :version "24.1"
- :type '(repeat
- (list
- (string :tag "Listings option name ")
- (string :tag "Listings option value"))))
-
-(defcustom org-export-latex-minted-options nil
- "Association list of options for the latex minted package.
-
-These options are supplied within square brackets in
-\\begin{minted} environments. Each element of the alist should be
-a list containing two strings: the name of the option, and the
-value. For example,
-
- (setq org-export-latex-minted-options
- '((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
-
-will result in src blocks being exported with
-
-\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
-
-as the start of the minted environment. Note that the same
-options will be applied to blocks of all languages."
- :group 'org-export-latex
- :version "24.1"
- :type '(repeat
- (list
- (string :tag "Minted option name ")
- (string :tag "Minted option value"))))
-
-(defvar org-export-latex-custom-lang-environments nil
- "Association list mapping languages to language-specific latex
- environments used during export of src blocks by the listings
- and minted latex packages. For example,
-
- (setq org-export-latex-custom-lang-environments
- '((python \"pythoncode\")))
-
- would have the effect that if org encounters begin_src python
- during latex export it will output
-
- \\begin{pythoncode}
- <src block body>
- \\end{pythoncode}")
-
-(defcustom org-export-latex-remove-from-headlines
- '(:todo nil :priority nil :tags nil)
- "A plist of keywords to remove from headlines. OBSOLETE.
-Non-nil means remove this keyword type from the headline.
-
-Don't remove the keys, just change their values.
-
-Obsolete, this variable is no longer used. Use the separate
-variables `org-export-with-todo-keywords', `org-export-with-priority',
-and `org-export-with-tags' instead."
- :type 'plist
- :group 'org-export-latex)
-
-(defcustom org-export-latex-image-default-option "width=.9\\linewidth"
- "Default option for images."
- :group 'org-export-latex
- :type 'string)
-
-(defcustom org-latex-default-figure-position "htb"
- "Default position for latex figures."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-tabular-environment "tabular"
- "Default environment used to build tables."
- :group 'org-export-latex
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}"
- "Format string for links with unknown path type."
- :group 'org-export-latex
- :version "24.3"
- :type 'string)
-
-(defcustom org-export-latex-inline-image-extensions
- '("pdf" "jpeg" "jpg" "png" "ps" "eps")
- "Extensions of image files that can be inlined into LaTeX.
-Note that the image extension *actually* allowed depend on the way the
-LaTeX file is processed. When used with pdflatex, pdf, jpg and png images
-are OK. When processing through dvi to Postscript, only ps and eps are
-allowed. The default we use here encompasses both."
- :group 'org-export-latex
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-export-latex-coding-system nil
- "Coding system for the exported LaTeX file."
- :group 'org-export-latex
- :type 'coding-system)
-
-(defgroup org-export-pdf nil
- "Options for exporting Org-mode files to PDF, via LaTeX."
- :tag "Org Export PDF"
- :group 'org-export-latex
- :group 'org-export)
-
-(defcustom org-latex-to-pdf-process
- '("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f")
- "Commands to process a LaTeX file to a PDF file and process latex
-fragments to pdf files.By default,this is a list of strings,and each of
-strings will be given to the shell as a command. %f in the command will
-be replaced by the full file name, %b by the file base name (i.e. without
-extension) and %o by the base directory of the file.
-
-If you set `org-create-formula-image-program'
-`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a
-sublist which contains your own command(s) for LaTeX fragments
-previewing, like this:
-
- '(\"xelatex -interaction nonstopmode -output-directory %o %f\"
- \"xelatex -interaction nonstopmode -output-directory %o %f\"
- ;; use below command(s) to convert latex fragments
- (\"xelatex %f\"))
-
-With no such sublist, the default command used to convert LaTeX
-fragments will be the first string in the list.
-
-The reason why this is a list is that it usually takes several runs of
-`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever
-mechanism to detect which of these commands have to be run to get to a stable
-result, and it also does not do any error checking.
-
-By default, Org uses 3 runs of `pdflatex' to do the processing. If you
-have texi2dvi on your system and if that does not cause the infamous
-egrep/locale bug:
-
- http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
-
-then `texi2dvi' is the superior choice. Org does offer it as one
-of the customize options.
-
-Alternatively, this may be a Lisp function that does the processing, so you
-could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode.
-This function should accept the file name as its single argument."
- :group 'org-export-pdf
- :type '(choice
- (repeat :tag "Shell command sequence"
- (string :tag "Shell command"))
- (const :tag "2 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "2 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "xelatex,bibtex,xelatex,xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "texi2dvi"
- ("texi2dvi -p -b -c -V %f"))
- (const :tag "rubber"
- ("rubber -d --into %o %f"))
- (function)))
-
-(defcustom org-export-pdf-logfiles
- '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
- "The list of file extensions to consider as LaTeX logfiles."
- :group 'org-export-pdf
- :version "24.1"
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-export-pdf-remove-logfiles t
- "Non-nil means remove the logfiles produced by PDF production.
-These are the .aux, .log, .out, and .toc files."
- :group 'org-export-pdf
- :type 'boolean)
-
-;;; Hooks
-
-(defvar org-export-latex-after-initial-vars-hook nil
- "Hook run before LaTeX export.
-The exact moment is after the initial variables like org-export-latex-class
-have been determined from the environment.")
-
-(defvar org-export-latex-after-blockquotes-hook nil
- "Hook run during LaTeX export, after blockquote, verse, center are done.")
-
-(defvar org-export-latex-final-hook nil
- "Hook run in the finalized LaTeX buffer.")
-
-(defvar org-export-latex-after-save-hook nil
- "Hook run in the finalized LaTeX buffer, after it has been saved.")
-
-;;; Autoload functions:
-
-;;;###autoload
-(defun org-export-as-latex-batch ()
- "Call `org-export-as-latex', may be used in batch processing.
-For example:
-
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-export-as-latex-batch"
- (org-export-as-latex org-export-headline-levels))
-
-;;;###autoload
-(defun org-export-as-latex-to-buffer (arg)
- "Call `org-export-as-latex` with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to `org-export-as-latex'."
- (interactive "P")
- (org-export-as-latex arg nil "*Org LaTeX Export*")
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window "*Org LaTeX Export*")))
-
-;;;###autoload
-(defun org-replace-region-by-latex (beg end)
- "Replace the region from BEG to END with its LaTeX export.
-It assumes the region has `org-mode' syntax, and then convert it to
-LaTeX. This can be used in any buffer. For example, you could
-write an itemized list in `org-mode' syntax in an LaTeX buffer and
-then use this command to convert it."
- (interactive "r")
- (let (reg latex buf)
- (save-window-excursion
- (if (derived-mode-p 'org-mode)
- (setq latex (org-export-region-as-latex
- beg end t 'string))
- (setq reg (buffer-substring beg end)
- buf (get-buffer-create "*Org tmp*"))
- (with-current-buffer buf
- (erase-buffer)
- (insert reg)
- (org-mode)
- (setq latex (org-export-region-as-latex
- (point-min) (point-max) t 'string)))
- (kill-buffer buf)))
- (delete-region beg end)
- (insert latex)))
-
-;;;###autoload
-(defun org-export-region-as-latex (beg end &optional body-only buffer)
- "Convert region from BEG to END in `org-mode' buffer to LaTeX.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted LaTeX. If BUFFER is the symbol `string', return the
-produced LaTeX as a string and leave no buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq latex (org-export-region-as-latex beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer."
- (interactive "r\nP")
- (when (org-called-interactively-p 'any)
- (setq buffer "*Org LaTeX Export*"))
- (let ((transient-mark-mode t) (zmacs-regions t)
- ext-plist rtn)
- (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
- (goto-char end)
- (set-mark (point)) ;; to activate the region
- (goto-char beg)
- (setq rtn (org-export-as-latex
- nil ext-plist
- buffer body-only))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (if (and (org-called-interactively-p 'any) (bufferp rtn))
- (switch-to-buffer-other-window rtn)
- rtn)))
-
-;;;###autoload
-(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir)
- "Export current buffer to a LaTeX file.
-If there is an active region, export only the region. The prefix
-ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will be exported
-depending on `org-export-latex-low-levels'. The default is to
-convert them as description lists.
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local settings.
-When TO-BUFFER is non-nil, create a buffer with that name and export
-to that buffer. If TO-BUFFER is the symbol `string', don't leave any
-buffer behind and just return the resulting LaTeX as a string, with
-no LaTeX header.
-When BODY-ONLY is set, don't produce the file header and footer,
-simply return the content of \\begin{document}...\\end{document},
-without even the \\begin{document} and \\end{document} commands.
-When PUB-DIR is set, use this as the publishing directory."
- (interactive "P")
- (when (and (not body-only) arg (listp arg)) (setq body-only t))
- (run-hooks 'org-export-first-hook)
-
- ;; Make sure we have a file name when we need it.
- (when (and (not (or to-buffer body-only))
- (not buffer-file-name))
- (if (buffer-base-buffer)
- (org-set-local 'buffer-file-name
- (with-current-buffer (buffer-base-buffer)
- buffer-file-name))
- (error "Need a file name to be able to export")))
-
- (message "Exporting to LaTeX...")
- (org-unmodified
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill nil))))
- (org-update-radio-target-regexp)
- (org-export-latex-set-initial-vars ext-plist arg)
- (setq org-export-opt-plist org-export-latex-options-plist
- org-export-footnotes-data (org-footnote-all-labels 'with-defs)
- org-export-footnotes-seen nil
- org-export-latex-footmark-seen nil)
- (org-install-letbind)
- (run-hooks 'org-export-latex-after-initial-vars-hook)
- (let* ((wcf (current-window-configuration))
- (opt-plist
- (org-export-process-option-filters org-export-latex-options-plist))
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- ;; Make sure the variable contains the updated values.
- (org-export-latex-options-plist (setq org-export-opt-plist opt-plist))
- ;; The following two are dynamically scoped into other
- ;; routines below.
- (org-current-export-dir
- (or pub-dir (org-export-directory :html opt-plist)))
- (org-current-export-file buffer-file-name)
- (title (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name)))
- "No Title"))
- (filename
- (and (not to-buffer)
- (concat
- (file-name-as-directory
- (or pub-dir
- (org-export-directory :LaTeX org-export-latex-options-plist)))
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get rbeg "EXPORT_FILE_NAME" t))
- (file-name-nondirectory ;sans-extension
- (or buffer-file-name
- (error "Don't know which export file to use")))))
- ".tex")))
- (filename
- (and filename
- (if (equal (file-truename filename)
- (file-truename (or buffer-file-name "dummy.org")))
- (concat filename ".tex")
- filename)))
- (auto-insert nil); Avoid any auto-insert stuff for the new file
- (TeX-master (boundp 'TeX-master))
- (buffer (if to-buffer
- (if (eq to-buffer 'string)
- (get-buffer-create "*Org LaTeX Export*")
- (get-buffer-create to-buffer))
- (find-file-noselect filename)))
- (odd org-odd-levels-only)
- (header (org-export-latex-make-header title opt-plist))
- (skip (cond (subtree-p nil)
- (region-p nil)
- (t (plist-get opt-plist :skip-before-1st-heading))))
- (text (plist-get opt-plist :text))
- (org-export-preprocess-hook
- (cons
- `(lambda () (org-set-local 'org-complex-heading-regexp
- ,org-export-latex-complex-heading-re))
- org-export-preprocess-hook))
- (first-lines (if skip "" (org-export-latex-first-lines
- opt-plist
- (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (point-at-bol 2))
- rbeg)
- (if region-p rend))))
- (coding-system (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system))
- (coding-system-for-write (or org-export-latex-coding-system
- coding-system))
- (save-buffer-coding-system (or org-export-latex-coding-system
- coding-system))
- (region (buffer-substring
- (if region-p (region-beginning) (point-min))
- (if region-p (region-end) (point-max))))
- (text
- (and text (string-match "\\S-" text)
- (org-export-preprocess-string
- text
- :emph-multiline t
- :for-backend 'latex
- :comments nil
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :drawers (plist-get opt-plist :drawers)
- :timestamps (plist-get opt-plist :timestamps)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :add-text nil
- :skip-before-1st-heading skip
- :select-tags nil
- :exclude-tags nil
- :LaTeX-fragments nil)))
- (string-for-export
- (org-export-preprocess-string
- region
- :emph-multiline t
- :for-backend 'latex
- :comments nil
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :drawers (plist-get opt-plist :drawers)
- :timestamps (plist-get opt-plist :timestamps)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :add-text (if (eq to-buffer 'string) nil text)
- :skip-before-1st-heading skip
- :select-tags (plist-get opt-plist :select-tags)
- :exclude-tags (plist-get opt-plist :exclude-tags)
- :LaTeX-fragments nil)))
-
- (set-buffer buffer)
- (erase-buffer)
- (org-install-letbind)
-
- (and (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system coding-system-for-write))
-
- ;; insert the header and initial document commands
- (unless (or (eq to-buffer 'string) body-only)
- (insert header))
-
- ;; insert text found in #+TEXT
- (when (and text (not (eq to-buffer 'string)))
- (insert (org-export-latex-content
- text '(lists tables fixed-width keywords))
- "\n\n"))
-
- ;; insert lines before the first headline
- (unless (or skip (string-match "^\\*" first-lines))
- (insert first-lines))
-
- ;; export the content of headlines
- (org-export-latex-global
- (with-temp-buffer
- (insert string-for-export)
- (goto-char (point-min))
- (when (re-search-forward "^\\(\\*+\\) " nil t)
- (let* ((asters (length (match-string 1)))
- (level (if odd (- asters 2) (- asters 1))))
- (setq org-export-latex-add-level
- (if odd (1- (/ (1+ asters) 2)) (1- asters)))
- (org-export-latex-parse-global level odd)))))
-
- ;; finalization
- (unless body-only (insert "\n\\end{document}"))
-
- ;; Attach description terms to the \item macro
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t)
- (delete-region (match-beginning 1) (match-end 1)))
-
- ;; Relocate the table of contents
- (goto-char (point-min))
- (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
- (goto-char (point-min))
- (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t)
- (replace-match "\\tableofcontents" t t)))
-
- ;; Cleanup forced line ends in items where they are not needed
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin"
- nil t)
- (delete-region (match-beginning 1) (match-end 1)))
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*"
- nil t)
- (if (looking-at "[\n \t]+")
- (replace-match "\n")))
-
- ;; Ensure we have a final newline
- (goto-char (point-max))
- (or (eq (char-before) ?\n)
- (insert ?\n))
-
- (run-hooks 'org-export-latex-final-hook)
- (if to-buffer
- (unless (eq major-mode 'latex-mode) (latex-mode))
- (save-buffer))
- (org-export-latex-fix-inputenc)
- (run-hooks 'org-export-latex-after-save-hook)
- (goto-char (point-min))
- (or (org-export-push-to-kill-ring "LaTeX")
- (message "Exporting to LaTeX...done"))
- (prog1
- (if (eq to-buffer 'string)
- (prog1 (buffer-substring (point-min) (point-max))
- (kill-buffer (current-buffer)))
- (current-buffer))
- (set-window-configuration wcf))))
-
-;;;###autoload
-(defun org-export-as-pdf (arg &optional hidden ext-plist
- to-buffer body-only pub-dir)
- "Export as LaTeX, then process through to PDF."
- (interactive "P")
- (message "Exporting to PDF...")
- (let* ((wconfig (current-window-configuration))
- (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir))
- (file (buffer-file-name lbuf))
- (base (file-name-sans-extension (buffer-file-name lbuf)))
- (pdffile (concat base ".pdf"))
- (cmds (if (eq org-export-latex-listings 'minted)
- ;; automatically add -shell-escape when needed
- (mapcar (lambda (cmd)
- (replace-regexp-in-string
- "pdflatex " "pdflatex -shell-escape " cmd))
- org-latex-to-pdf-process)
- org-latex-to-pdf-process))
- (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))
- (bibtex-p (with-current-buffer lbuf
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "\\\\bibliography{" nil t))))
- cmd output-dir errors)
- (with-current-buffer outbuf (erase-buffer))
- (message (concat "Processing LaTeX file " file "..."))
- (setq output-dir (file-name-directory file))
- (with-current-buffer lbuf
- (save-excursion
- (if (and cmds (symbolp cmds))
- (funcall cmds (shell-quote-argument file))
- (while cmds
- (setq cmd (pop cmds))
- (cond
- ((not (listp cmd))
- (while (string-match "%b" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument base))
- t t cmd)))
- (while (string-match "%f" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument file))
- t t cmd)))
- (while (string-match "%o" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument output-dir))
- t t cmd)))
- (shell-command cmd outbuf)))))))
- (message (concat "Processing LaTeX file " file "...done"))
- (setq errors (org-export-latex-get-error outbuf))
- (if (not (file-exists-p pdffile))
- (error (concat "PDF file " pdffile " was not produced"
- (if errors (concat ":" errors "") "")))
- (set-window-configuration wconfig)
- (when org-export-pdf-remove-logfiles
- (dolist (ext org-export-pdf-logfiles)
- (setq file (concat base "." ext))
- (and (file-exists-p file) (delete-file file))))
- (message (concat
- "Exporting to PDF...done"
- (if errors
- (concat ", with some errors:" errors)
- "")))
- pdffile)))
-
-(defun org-export-latex-get-error (buf)
- "Collect the kinds of errors that remain in pdflatex processing."
- (with-current-buffer buf
- (save-excursion
- (goto-char (point-max))
- (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t)
- ;; OK, we are at the location of the final run
- (let ((pos (point)) (errors "") (case-fold-search t))
- (if (re-search-forward "Reference.*?undefined" nil t)
- (setq errors (concat errors " [undefined reference]")))
- (goto-char pos)
- (if (re-search-forward "Citation.*?undefined" nil t)
- (setq errors (concat errors " [undefined citation]")))
- (goto-char pos)
- (if (re-search-forward "Undefined control sequence" nil t)
- (setq errors (concat errors " [undefined control sequence]")))
- (and (org-string-nw-p errors) errors))))))
-
-;;;###autoload
-(defun org-export-as-pdf-and-open (arg)
- "Export as LaTeX, then process through to PDF, and open."
- (interactive "P")
- (let ((pdffile (org-export-as-pdf arg)))
- (if pdffile
- (progn
- (org-open-file pdffile)
- (when org-export-kill-product-buffer-when-displayed
- (kill-buffer (find-buffer-visiting
- (concat (file-name-sans-extension (buffer-file-name))
- ".tex")))))
- (error "PDF file was not produced"))))
-
-;;; Parsing functions:
-
-(defun org-export-latex-parse-global (level odd)
- "Parse the current buffer recursively, starting at LEVEL.
-If ODD is non-nil, assume the buffer only contains odd sections.
-Return a list reflecting the document structure."
- (save-excursion
- (goto-char (point-min))
- (let* ((cnt 0) output
- (depth org-export-latex-sectioning-depth))
- (while (org-re-search-forward-unprotected
- (concat "^\\(\\(?:\\*\\)\\{"
- (number-to-string (+ (if odd 2 1) level))
- "\\}\\) \\(.*\\)$")
- ;; make sure that there is no upper heading
- (when (> level 0)
- (save-excursion
- (save-match-data
- (org-re-search-forward-unprotected
- (concat "^\\(\\(?:\\*\\)\\{"
- (number-to-string level)
- "\\}\\) \\(.*\\)$") nil t)))) t)
- (setq cnt (1+ cnt))
- (let* ((pos (match-beginning 0))
- (heading (match-string 2))
- (nlevel (if odd (/ (+ 3 level) 2) (1+ level))))
- (save-excursion
- (narrow-to-region
- (point)
- (save-match-data
- (if (org-re-search-forward-unprotected
- (concat "^\\(\\(?:\\*\\)\\{"
- (number-to-string (+ (if odd 2 1) level))
- "\\}\\) \\(.*\\)$") nil t)
- (match-beginning 0)
- (point-max))))
- (goto-char (point-min))
- (setq output
- (append output
- (list
- (list
- `(pos . ,pos)
- `(level . ,nlevel)
- `(occur . ,cnt)
- `(heading . ,heading)
- `(content . ,(org-export-latex-parse-content))
- `(subcontent . ,(org-export-latex-parse-subcontent
- level odd)))))))
- (widen)))
- (list output))))
-
-(defun org-export-latex-parse-content ()
- "Extract the content of a section."
- (let ((beg (point))
- (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t)
- (progn (beginning-of-line) (point))
- (point-max))))
- (buffer-substring beg end)))
-
-(defun org-export-latex-parse-subcontent (level odd)
- "Extract the subcontent of a section at LEVEL.
-If ODD Is non-nil, assume subcontent only contains odd sections."
- (if (not (org-re-search-forward-unprotected
- (concat "^\\(\\(?:\\*\\)\\{"
- (number-to-string (+ (if odd 4 2) level))
- "\\}\\) \\(.*\\)$")
- nil t))
- nil ; subcontent is nil
- (org-export-latex-parse-global (+ (if odd 2 1) level) odd)))
-
-;;; Rendering functions:
-(defun org-export-latex-global (content)
- "Export CONTENT to LaTeX.
-CONTENT is an element of the list produced by
-`org-export-latex-parse-global'."
- (if (eq (car content) 'subcontent)
- (mapc 'org-export-latex-sub (cdr content))
- (org-export-latex-sub (car content))))
-
-(defun org-export-latex-sub (subcontent)
- "Export the list SUBCONTENT to LaTeX.
-SUBCONTENT is an alist containing information about the headline
-and its content."
- (let ((num (plist-get org-export-latex-options-plist :section-numbers)))
- (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent)))
-
-(defun org-export-latex-subcontent (subcontent num)
- "Export each cell of SUBCONTENT to LaTeX.
-If NUM is non-nil export numbered sections, otherwise use unnumbered
-sections. If NUM is an integer, export the highest NUM levels as
-numbered sections and lower levels as unnumbered sections."
- (let* ((heading (cdr (assoc 'heading subcontent)))
- (level (- (cdr (assoc 'level subcontent))
- org-export-latex-add-level))
- (occur (number-to-string (cdr (assoc 'occur subcontent))))
- (content (cdr (assoc 'content subcontent)))
- (subcontent (cadr (assoc 'subcontent subcontent)))
- (label (org-get-text-property-any 0 'target heading))
- (label-list (cons label (cdr (assoc label
- org-export-target-aliases))))
- (sectioning org-export-latex-sectioning)
- (depth org-export-latex-sectioning-depth)
- main-heading sub-heading ctnt)
- (when (symbolp (car sectioning))
- (setq sectioning (funcall (car sectioning) level heading))
- (when sectioning
- (setq heading (car sectioning)
- sectioning (cdr sectioning)
- ;; target property migh have changed...
- label (org-get-text-property-any 0 'target heading)
- label-list (cons label (cdr (assoc label
- org-export-target-aliases)))))
- (if sectioning (setq sectioning (make-list 10 sectioning)))
- (setq depth (if sectioning 10000 0)))
- (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading)
- (setq main-heading (substring heading 0 (match-beginning 0))
- sub-heading (substring heading (match-end 0))))
- (setq heading (org-export-latex-fontify-headline heading)
- sub-heading (and sub-heading
- (org-export-latex-fontify-headline sub-heading))
- main-heading (and main-heading
- (org-export-latex-fontify-headline main-heading)))
- (cond
- ;; Normal conversion
- ((<= level depth)
- (let* ((sec (nth (1- level) sectioning))
- (num (if (integerp num)
- (>= num level)
- num))
- start end)
- (if (consp (cdr sec))
- (setq start (nth (if num 0 2) sec)
- end (nth (if num 1 3) sec))
- (setq start (if num (car sec) (cdr sec))))
- (insert (format start (if main-heading main-heading heading)
- (or sub-heading "")))
- (insert "\n")
- (when label
- (insert (mapconcat (lambda (l) (format "\\label{%s}" l))
- label-list "\n") "\n"))
- (insert (org-export-latex-content content))
- (cond ((stringp subcontent) (insert subcontent))
- ((listp subcontent)
- (while (org-looking-back "\n\n") (backward-delete-char 1))
- (org-export-latex-sub subcontent)))
- (when (and end (string-match "[^ \t]" end))
- (let ((hook (org-get-text-property-any 0 'org-insert-hook end)))
- (and (functionp hook) (funcall hook)))
- (insert end "\n"))))
- ;; At a level under the hl option: we can drop this subsection
- ((> level depth)
- (cond ((eq org-export-latex-low-levels 'description)
- (if (string-match "% ends low level$"
- (buffer-substring (point-at-bol 0) (point)))
- (delete-region (point-at-bol 0) (point))
- (insert "\\begin{description}\n"))
- (insert (format "\n\\item[%s]%s~\n"
- heading
- (if label (format "\\label{%s}" label) "")))
- (insert (org-export-latex-content content))
- (cond ((stringp subcontent) (insert subcontent))
- ((listp subcontent) (org-export-latex-sub subcontent)))
- (insert "\\end{description} % ends low level\n"))
- ((memq org-export-latex-low-levels '(itemize enumerate))
- (if (string-match "% ends low level$"
- (buffer-substring (point-at-bol 0) (point)))
- (delete-region (point-at-bol 0) (point))
- (insert (format "\\begin{%s}\n"
- (symbol-name org-export-latex-low-levels))))
- (let ((ctnt (org-export-latex-content content)))
- (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) ""))
- "\n\\item %s\\\\\n%s%%"
- "\n\\item %s\n%s%%")
- heading
- (if label (format "\\label{%s}" label) "")))
- (insert ctnt))
- (cond ((stringp subcontent) (insert subcontent))
- ((listp subcontent) (org-export-latex-sub subcontent)))
- (insert (format "\\end{%s} %% ends low level\n"
- (symbol-name org-export-latex-low-levels))))
-
- ((and (listp org-export-latex-low-levels)
- org-export-latex-low-levels)
- (if (string-match "% ends low level$"
- (buffer-substring (point-at-bol 0) (point)))
- (delete-region (point-at-bol 0) (point))
- (insert (car org-export-latex-low-levels) "\n"))
- (insert (format (nth 2 org-export-latex-low-levels)
- heading
- (if label (format "\\label{%s}" label) "")))
- (insert (org-export-latex-content content))
- (cond ((stringp subcontent) (insert subcontent))
- ((listp subcontent) (org-export-latex-sub subcontent)))
- (insert (nth 1 org-export-latex-low-levels)
- " %% ends low level\n"))
-
- ((stringp org-export-latex-low-levels)
- (insert (format org-export-latex-low-levels heading) "\n")
- (when label (insert (format "\\label{%s}\n" label)))
- (insert (org-export-latex-content content))
- (cond ((stringp subcontent) (insert subcontent))
- ((listp subcontent) (org-export-latex-sub subcontent)))))))))
-
-;;; Exporting internals:
-(defun org-export-latex-set-initial-vars (ext-plist level)
- "Store org local variables required for LaTeX export.
-EXT-PLIST is an optional additional plist.
-LEVEL indicates the default depth for export."
- (setq org-export-latex-todo-keywords-1 org-todo-keywords-1
- org-export-latex-done-keywords org-done-keywords
- org-export-latex-not-done-keywords org-not-done-keywords
- org-export-latex-complex-heading-re org-complex-heading-regexp
- org-export-latex-display-custom-times org-display-custom-times
- org-export-latex-all-targets-re
- (org-make-target-link-regexp (org-all-targets))
- org-export-latex-options-plist
- (org-combine-plists (org-default-export-plist) ext-plist
- (org-infile-export-plist))
- org-export-latex-class
- (or (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (and (looking-at org-complex-heading-regexp)
- (org-entry-get nil "LaTeX_CLASS" 'selective))))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t)
- (match-string 1))))
- (plist-get org-export-latex-options-plist :latex-class)
- org-export-latex-default-class)
- org-export-latex-class-options
- (or (and (org-region-active-p)
- (save-excursion
- (goto-char (region-beginning))
- (and (looking-at org-complex-heading-regexp)
- (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective))))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t)
- (match-string 1))))
- (plist-get org-export-latex-options-plist :latex-class-options))
- org-export-latex-class
- (or (car (assoc org-export-latex-class org-export-latex-classes))
- (error "No definition for class `%s' in `org-export-latex-classes'"
- org-export-latex-class))
- org-export-latex-header
- (cadr (assoc org-export-latex-class org-export-latex-classes))
- org-export-latex-sectioning
- (cddr (assoc org-export-latex-class org-export-latex-classes))
- org-export-latex-sectioning-depth
- (or level
- (let ((hl-levels
- (plist-get org-export-latex-options-plist :headline-levels))
- (sec-depth (length org-export-latex-sectioning)))
- (if (> hl-levels sec-depth) sec-depth hl-levels))))
- (when (and org-export-latex-class-options
- (string-match "\\S-" org-export-latex-class-options)
- (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?"
- org-export-latex-header))
- (setq org-export-latex-header
- (concat (substring org-export-latex-header 0 (match-end 1))
- org-export-latex-class-options
- (substring org-export-latex-header (match-end 0))))))
-
-(defvar org-export-latex-format-toc-function
- 'org-export-latex-format-toc-default
- "The function formatting returning the string to create the table of contents.
-The function mus take one parameter, the depth of the table of contents.")
-
-(defun org-export-latex-make-header (title opt-plist)
- "Make the LaTeX header and return it as a string.
-TITLE is the current title from the buffer or region.
-OPT-PLIST is the options plist for current buffer."
- (let ((toc (plist-get opt-plist :table-of-contents))
- (author (org-export-apply-macros-in-string
- (plist-get opt-plist :author)))
- (email (replace-regexp-in-string
- "_" "\\\\_"
- (org-export-apply-macros-in-string
- (plist-get opt-plist :email))))
- (description (org-export-apply-macros-in-string
- (plist-get opt-plist :description)))
- (keywords (org-export-apply-macros-in-string
- (plist-get opt-plist :keywords))))
- (concat
- (if (plist-get opt-plist :time-stamp-file)
- (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
- ;; insert LaTeX custom header and packages from the list
- (org-splice-latex-header
- (org-export-apply-macros-in-string org-export-latex-header)
- org-export-latex-default-packages-alist
- org-export-latex-packages-alist nil
- (org-export-apply-macros-in-string
- (plist-get opt-plist :latex-header-extra)))
- ;; append another special variable
- (org-export-apply-macros-in-string org-export-latex-append-header)
- ;; define alert if not yet defined
- "\n\\providecommand{\\alert}[1]{\\textbf{#1}}"
- ;; insert the title
- (format
- "\n\n\\title{%s}\n"
- (org-export-latex-fontify-headline title))
- ;; insert author info
- (if (plist-get opt-plist :author-info)
- (format "\\author{%s%s}\n"
- (org-export-latex-fontify-headline (or author user-full-name))
- (if (and (plist-get opt-plist :email-info) email
- (string-match "\\S-" email))
- (format "\\thanks{%s}" email)
- ""))
- (format "%%\\author{%s}\n"
- (org-export-latex-fontify-headline (or author user-full-name))))
- ;; insert the date
- (format "\\date{%s}\n"
- (format-time-string
- (or (plist-get opt-plist :date)
- org-export-latex-date-format)))
- ;; add some hyperref options
- (format org-export-latex-hyperref-options-format
- (org-export-latex-fontify-headline keywords)
- (org-export-latex-fontify-headline description)
- (org-version))
- ;; beginning of the document
- "\n\\begin{document}\n\n"
- ;; insert the title command
- (when (string-match "\\S-" title)
- (if (string-match "%s" org-export-latex-title-command)
- (format org-export-latex-title-command title)
- org-export-latex-title-command))
- "\n\n"
- ;; table of contents
- (when (and org-export-with-toc
- (plist-get opt-plist :section-numbers))
- (funcall org-export-latex-format-toc-function
- (cond ((numberp toc)
- (min toc (plist-get opt-plist :headline-levels)))
- (toc (plist-get opt-plist :headline-levels))))))))
-
-(defun org-export-latex-format-toc-default (depth)
- (when depth
- (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n"
- depth)))
-
-(defun org-export-latex-first-lines (opt-plist &optional beg end)
- "Export the first lines before first headline.
-If BEG is non-nil, it is the beginning of the region.
-If END is non-nil, it is the end of the region."
- (save-excursion
- (goto-char (or beg (point-min)))
- (let* ((pt (point))
- (end (if (re-search-forward
- (concat "^" (org-get-limited-outline-regexp)) end t)
- (goto-char (match-beginning 0))
- (goto-char (or end (point-max))))))
- (prog1
- (org-export-latex-content
- (org-export-preprocess-string
- (buffer-substring pt end)
- :for-backend 'latex
- :emph-multiline t
- :add-text nil
- :comments nil
- :skip-before-1st-heading nil
- :LaTeX-fragments nil
- :timestamps (plist-get opt-plist :timestamps)
- :footnotes (plist-get opt-plist :footnotes)))
- (org-unmodified
- (let ((inhibit-read-only t)
- (limit (max pt (1- end))))
- (add-text-properties pt limit
- '(:org-license-to-kill t))
- (save-excursion
- (goto-char pt)
- (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t)
- (let ((case-fold-search t))
- (unless (org-string-match-p
- "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)"
- (match-string 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(:org-license-to-kill t))))))))))))
-
-
-(defvar org-export-latex-header-defs nil
- "The header definitions that might be used in the LaTeX body.")
-
-(defun org-export-latex-content (content &optional exclude-list)
- "Convert CONTENT string to LaTeX.
-Don't perform conversions that are in EXCLUDE-LIST. Recognized
-conversion types are: quotation-marks, emphasis, sub-superscript,
-links, keywords, lists, tables, fixed-width"
- (with-temp-buffer
- (org-install-letbind)
- (insert content)
- (unless (memq 'timestamps exclude-list)
- (org-export-latex-time-stamps))
- (unless (memq 'quotation-marks exclude-list)
- (org-export-latex-quotation-marks))
- (unless (memq 'emphasis exclude-list)
- (when (plist-get org-export-latex-options-plist :emphasize)
- (org-export-latex-fontify)))
- (unless (memq 'sub-superscript exclude-list)
- (org-export-latex-special-chars
- (plist-get org-export-latex-options-plist :sub-superscript)))
- (unless (memq 'links exclude-list)
- (org-export-latex-links))
- (unless (memq 'keywords exclude-list)
- (org-export-latex-keywords))
- (unless (memq 'lists exclude-list)
- (org-export-latex-lists))
- (unless (memq 'tables exclude-list)
- (org-export-latex-tables
- (plist-get org-export-latex-options-plist :tables)))
- (unless (memq 'fixed-width exclude-list)
- (org-export-latex-fixed-width
- (plist-get org-export-latex-options-plist :fixed-width)))
- ;; return string
- (buffer-substring (point-min) (point-max))))
-
-(defun org-export-latex-protect-string (s)
- "Add the org-protected property to string S."
- (add-text-properties 0 (length s) '(org-protected t) s) s)
-
-(defun org-export-latex-protect-char-in-string (char-list string)
- "Add org-protected text-property to char from CHAR-LIST in STRING."
- (with-temp-buffer
- (save-match-data
- (insert string)
- (goto-char (point-min))
- (while (re-search-forward (regexp-opt char-list) nil t)
- (add-text-properties (match-beginning 0)
- (match-end 0) '(org-protected t)))
- (buffer-string))))
-
-(defun org-export-latex-keywords-maybe (&optional remove-list)
- "Maybe remove keywords depending on rules in REMOVE-LIST."
- (goto-char (point-min))
- (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|"))
- (case-fold-search nil)
- (todo-markup org-export-latex-todo-keyword-markup)
- fmt)
- ;; convert TODO keywords
- (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t)
- (if (plist-get remove-list :todo)
- (replace-match "")
- (setq fmt (cond
- ((stringp todo-markup) todo-markup)
- ((and (consp todo-markup) (stringp (car todo-markup)))
- (if (member (match-string 1) org-export-latex-done-keywords)
- (cdr todo-markup) (car todo-markup)))
- (t (cdr (or (assoc (match-string 1) todo-markup)
- (car todo-markup))))))
- (replace-match (org-export-latex-protect-string
- (format fmt (match-string 1))) t t)))
- ;; convert priority string
- (when (re-search-forward "\\[\\\\#.\\]" nil t)
- (if (plist-get remove-list :priority)
- (replace-match "")
- (replace-match (format "\\textbf{%s}" (match-string 0)) t t)))
- ;; convert tags
- (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t)
- (if (or (not org-export-with-tags)
- (plist-get remove-list :tags))
- (replace-match "")
- (replace-match
- (org-export-latex-protect-string
- (format org-export-latex-tag-markup
- (save-match-data
- (replace-regexp-in-string
- "\\([_#]\\)" "\\\\\\1" (match-string 0)))))
- t t)))))
-
-(defun org-export-latex-fontify-headline (string)
- "Fontify special words in STRING."
- (with-temp-buffer
- ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at
- ;; the beginning of the buffer - inserting "\n" is safe here though.
- (insert "\n" string)
-
- ;; Preserve math snippets
-
- (let* ((matchers (plist-get org-format-latex-options :matchers))
- (re-list org-latex-regexps)
- beg end re e m n block off)
- ;; Check the different regular expressions
- (while (setq e (pop re-list))
- (setq m (car e) re (nth 1 e) n (nth 2 e)
- block (if (nth 3 e) "\n\n" ""))
- (setq off (if (member m '("$" "$1")) 1 0))
- (when (and (member m matchers) (not (equal m "begin")))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
- (add-text-properties beg end
- '(org-protected t org-latex-math t))))))
-
- ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
- (unless (eq (char-before (match-beginning 1)) ?\\)
- (org-if-unprotected-1
- (replace-match (org-export-latex-protect-string
- (concat "\\" (match-string 1)
- "{}")) t t)))))
- (goto-char (point-min))
- (let ((re (concat "\\\\\\([a-zA-Z]+\\)"
- "\\(?:<[^<>\n]*>\\)*"
- "\\(?:\\[[^][\n]*?\\]\\)*"
- "\\(?:<[^<>\n]*>\\)*"
- "\\("
- (org-create-multibrace-regexp "{" "}" 3)
- "\\)\\{1,3\\}")))
- (while (re-search-forward re nil t)
- (unless (or
- ;; check for comment line
- (save-excursion (goto-char (match-beginning 0))
- (org-in-indented-comment-line))
- ;; Check if this is a defined entity, so that is may need conversion
- (org-entity-get (match-string 1)))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-protected t)))))
- (when (plist-get org-export-latex-options-plist :emphasize)
- (org-export-latex-fontify))
- (org-export-latex-time-stamps)
- (org-export-latex-quotation-marks)
- (org-export-latex-keywords-maybe)
- (org-export-latex-special-chars
- (plist-get org-export-latex-options-plist :sub-superscript))
- (org-export-latex-links)
- (org-trim (buffer-string))))
-
-(defun org-export-latex-time-stamps ()
- "Format time stamps."
- (goto-char (point-min))
- (let ((org-display-custom-times org-export-latex-display-custom-times))
- (while (re-search-forward org-ts-regexp-both nil t)
- (org-if-unprotected-at (1- (point))
- (replace-match
- (org-export-latex-protect-string
- (format (if (string= "<" (substring (match-string 0) 0 1))
- org-export-latex-timestamp-markup
- org-export-latex-timestamp-inactive-markup)
- (substring (org-translate-time (match-string 0)) 1 -1)))
- t t)))))
-
-(defun org-export-latex-quotation-marks ()
- "Export quotation marks depending on language conventions."
- (mapc (lambda(l)
- (goto-char (point-min))
- (while (re-search-forward (car l) nil t)
- (let ((rpl (concat (match-string 1)
- (org-export-latex-protect-string
- (copy-sequence (cdr l))))))
- (org-if-unprotected-1
- (replace-match rpl t t)))))
- (cdr (or (assoc (plist-get org-export-latex-options-plist :language)
- org-export-latex-quotes)
- ;; falls back on english
- (assoc "en" org-export-latex-quotes)))))
-
-(defun org-export-latex-special-chars (sub-superscript)
- "Export special characters to LaTeX.
-If SUB-SUPERSCRIPT is non-nil, convert \\ and ^.
-See the `org-export-latex.el' code for a complete conversion table."
- (goto-char (point-min))
- (mapc (lambda(c)
- (goto-char (point-min))
- (while (re-search-forward c nil t)
- ;; Put the point where to check for org-protected
- (unless (get-text-property (match-beginning 2) 'org-protected)
- (cond ((member (match-string 2) '("\\$" "$"))
- (if (equal (match-string 2) "\\$")
- nil
- (replace-match "\\$" t t)))
- ((member (match-string 2) '("&" "%" "#"))
- (if (equal (match-string 1) "\\")
- (replace-match (match-string 2) t t)
- (replace-match (concat (match-string 1) "\\"
- (match-string 2)) t t)
- (backward-char 1)))
- ((equal (match-string 2) "...")
- (replace-match
- (concat (match-string 1)
- (org-export-latex-protect-string "\\ldots{}")) t t))
- ((equal (match-string 2) "~")
- (cond ((equal (match-string 1) "\\") nil)
- ((eq 'org-link (get-text-property 0 'face (match-string 2)))
- (replace-match (concat (match-string 1) "\\~") t t))
- (t (replace-match
- (org-export-latex-protect-string
- (concat (match-string 1) "\\~{}")) t t))))
- ((member (match-string 2) '("{" "}"))
- (unless (save-match-data (org-inside-latex-math-p))
- (if (equal (match-string 1) "\\")
- (replace-match (match-string 2) t t)
- (replace-match (concat (match-string 1) "\\"
- (match-string 2)) t t)))))
- (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p)))
- (cond ((equal (match-string 2) "\\")
- (replace-match (or (save-match-data
- (org-export-latex-treat-backslash-char
- (match-string 1)
- (or (match-string 3) "")))
- "") t t)
- (when (and (get-text-property (1- (point)) 'org-entity)
- (looking-at "{}"))
- ;; OK, this was an entity replacement, and the user
- ;; had terminated the entity with {}. Make sure
- ;; {} is protected as well, and remove the extra {}
- ;; inserted by the conversion.
- (put-text-property (point) (+ 2 (point)) 'org-protected t)
- (if (save-excursion (goto-char (max (- (point) 2) (point-min)))
- (looking-at "{}"))
- (replace-match ""))
- (forward-char 2))
- (backward-char 1))
- ((member (match-string 2) '("_" "^"))
- (replace-match (or (save-match-data
- (org-export-latex-treat-sub-super-char
- sub-superscript
- (match-string 2)
- (match-string 1)
- (match-string 3))) "") t t)
- (backward-char 1)))))))
- '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$"
- "\\(\\(\\\\?\\$\\)\\)"
- "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)"
- "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)"
- "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)"
- ;; (?\< . "\\textless{}")
- ;; (?\> . "\\textgreater{}")
- )))
-
-(defun org-inside-latex-math-p ()
- (get-text-property (point) 'org-latex-math))
-
-(defun org-export-latex-treat-sub-super-char
- (subsup char string-before string-after)
- "Convert the \"_\" and \"^\" characters to LaTeX.
-SUBSUP corresponds to the ^: option in the #+OPTIONS line.
-Convert CHAR depending on STRING-BEFORE and STRING-AFTER."
- (cond ((equal string-before "\\")
- (concat string-before char string-after))
- ((and (string-match "\\S-+" string-after))
- ;; this is part of a math formula
- (cond ((eq 'org-link (get-text-property 0 'face char))
- (concat string-before "\\" char string-after))
- ((save-match-data (org-inside-latex-math-p))
- (if subsup
- (cond ((eq 1 (length string-after))
- (concat string-before char string-after))
- ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after)
- (format "%s%s{%s}" string-before char
- (match-string 1 string-after))))))
- ((and (> (length string-after) 1)
- (or (eq subsup t)
- (and (equal subsup '{}) (eq (string-to-char string-after) ?\{)))
- (or (string-match "[{]?\\([^}]+\\)[}]?" string-after)
- (string-match "[(]?\\([^)]+\\)[)]?" string-after)))
-
- (org-export-latex-protect-string
- (format "%s$%s{%s}$" string-before char
- (if (and (> (match-end 1) (1+ (match-beginning 1)))
- (not (equal (substring string-after 0 2) "{\\")))
- (concat "\\mathrm{" (match-string 1 string-after) "}")
- (match-string 1 string-after)))))
- ((eq subsup t) (concat string-before "$" char string-after "$"))
- (t (org-export-latex-protect-string
- (concat string-before "\\" char "{}" string-after)))))
- (t (org-export-latex-protect-string
- (concat string-before "\\" char "{}" string-after)))))
-
-(defun org-export-latex-treat-backslash-char (string-before string-after)
- "Convert the \"$\" special character to LaTeX.
-The conversion is made depending of STRING-BEFORE and STRING-AFTER."
- (let ((ass (org-entity-get string-after)))
- (cond
- (ass (org-add-props
- (if (nth 2 ass)
- (concat string-before
- (org-export-latex-protect-string
- (concat "$" (nth 1 ass) "$")))
- (concat string-before (org-export-latex-protect-string
- (nth 1 ass))))
- nil 'org-entity t))
- ((and (not (string-match "^[ \n\t]" string-after))
- (not (string-match "[ \t]\\'\\|^" string-before)))
- ;; backslash is inside a word
- (concat string-before
- (org-export-latex-protect-string
- (concat "\\textbackslash{}" string-after))))
- ((not (or (equal string-after "")
- (string-match "^[ \t\n]" string-after)))
- ;; backslash might escape a character (like \#) or a user TeX
- ;; macro (like \setcounter)
- (concat string-before
- (org-export-latex-protect-string (concat "\\" string-after))))
- ((and (string-match "^[ \t\n]" string-after)
- (string-match "[ \t\n]\\'" string-before))
- ;; backslash is alone, convert it to $\backslash$
- (org-export-latex-protect-string
- (concat string-before "\\textbackslash{}" string-after)))
- (t (org-export-latex-protect-string
- (concat string-before "\\textbackslash{}" string-after))))))
-
-(defun org-export-latex-keywords ()
- "Convert special keywords to LaTeX."
- (goto-char (point-min))
- (while (re-search-forward org-export-latex-special-keyword-regexp nil t)
- (replace-match (format org-export-latex-timestamp-keyword-markup
- (match-string 0)) t t)
- (save-excursion
- (beginning-of-line 1)
- (unless (looking-at ".*\n[ \t]*\n")
- (end-of-line 1)
- (insert "\n")))))
-
-(defun org-export-latex-fixed-width (opt)
- "When OPT is non-nil convert fixed-width sections to LaTeX."
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t)
- (unless (get-text-property (point) 'org-example)
- (if opt
- (progn (goto-char (match-beginning 0))
- (insert "\\begin{verbatim}\n")
- (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
- (replace-match (concat (match-string 1)
- (match-string 2)) t t)
- (forward-line))
- (insert "\\end{verbatim}\n"))
- (progn (goto-char (match-beginning 0))
- (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$")
- (replace-match (concat "%" (match-string 1)
- (match-string 2)) t t)
- (forward-line)))))))
-
-(defvar org-table-last-alignment) ; defined in org-table.el
-(defvar org-table-last-column-widths) ; defined in org-table.el
-(declare-function orgtbl-to-latex "org-table" (table params) t)
-(defun org-export-latex-tables (insert)
- "Convert tables to LaTeX and INSERT it."
- ;; First, get the table.el tables
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t)
- (org-if-unprotected
- (require 'table)
- (org-export-latex-convert-table.el-table)))
-
- ;; And now the Org-mode tables
- (goto-char (point-min))
- (while (re-search-forward "^\\([ \t]*\\)|" nil t)
- (org-if-unprotected-at (1- (point))
- (org-table-align)
- (let* ((beg (org-table-begin))
- (end (org-table-end))
- (raw-table (buffer-substring beg end))
- (org-table-last-alignment (copy-sequence org-table-last-alignment))
- (org-table-last-column-widths (copy-sequence
- org-table-last-column-widths))
- fnum fields line lines olines gr colgropen line-fmt align
- caption width shortn label attr hfmt floatp placement
- longtblp tblenv tabular-env)
- (if org-export-latex-tables-verbatim
- (let* ((tbl (concat "\\begin{verbatim}\n" raw-table
- "\\end{verbatim}\n")))
- (apply 'delete-region (list beg end))
- (insert (org-export-latex-protect-string tbl)))
- (progn
- (setq caption (org-find-text-property-in-string
- 'org-caption raw-table)
- shortn (org-find-text-property-in-string
- 'org-caption-shortn raw-table)
- attr (org-find-text-property-in-string
- 'org-attributes raw-table)
- label (org-find-text-property-in-string
- 'org-label raw-table)
- longtblp (and attr (stringp attr)
- (string-match "\\<longtable\\>" attr))
- tblenv (if (and attr (stringp attr))
- (cond ((string-match "\\<sidewaystable\\>" attr)
- "sidewaystable")
- ((or (string-match (regexp-quote "table*") attr)
- (string-match "\\<multicolumn\\>" attr))
- "table*")
- (t "table"))
- "table")
- tabular-env
- (if (and attr (stringp attr)
- (string-match "\\(tabular.\\)" attr))
- (match-string 1 attr)
- org-export-latex-tabular-environment)
- width (and attr (stringp attr)
- (string-match "\\<width=\\([^ \t\n\r]+\\)" attr)
- (match-string 1 attr))
- align (and attr (stringp attr)
- (string-match "\\<align=\\([^ \t\n\r]+\\)" attr)
- (match-string 1 attr))
- hfmt (and attr (stringp attr)
- (string-match "\\<hfmt=\\(\\S-+\\)" attr)
- (match-string 1 attr))
- floatp (or caption label (string= "table*" tblenv))
- placement (if (and attr
- (stringp attr)
- (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
- (match-string 1 attr)
- (concat
- "[" org-latex-default-figure-position "]")))
- (setq caption (and caption (org-export-latex-fontify-headline caption)))
- (setq lines (org-split-string raw-table "\n"))
- (apply 'delete-region (list beg end))
- (when org-export-table-remove-special-lines
- (setq lines (org-table-clean-before-export lines 'maybe-quoted)))
- (when org-table-clean-did-remove-column
- (pop org-table-last-alignment)
- (pop org-table-last-column-widths))
- ;; make a format string to reflect alignment
- (setq olines lines)
- (while (and (not line-fmt) (setq line (pop olines)))
- (unless (string-match "^[ \t]*|-" line)
- (setq fields (org-split-string line "[ \t]*|[ \t]*"))
- (setq fnum (make-vector (length fields) 0))
- (setq line-fmt
- (mapconcat
- (lambda (x)
- (setq gr (pop org-table-colgroup-info))
- (format "%s%%s%s"
- (cond ((eq gr :start)
- (prog1 (if colgropen "|" "|")
- (setq colgropen t)))
- ((eq gr :startend)
- (prog1 (if colgropen "|" "|")
- (setq colgropen nil)))
- (t ""))
- (if (memq gr '(:end :startend))
- (progn (setq colgropen nil) "|")
- "")))
- fnum ""))))
- ;; fix double || in line-fmt
- (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt))
- ;; maybe remove the first and last "|"
- (when (and (not org-export-latex-tables-column-borders)
- (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt))
- (setq line-fmt (match-string 2 line-fmt)))
- ;; format alignment
- (unless align
- (setq align (apply 'format
- (cons line-fmt
- (mapcar (lambda (x) (if x "r" "l"))
- org-table-last-alignment)))))
- ;; prepare the table to send to orgtbl-to-latex
- (setq lines
- (mapcar
- (lambda(elem)
- (or (and (string-match "[ \t]*|-+" elem) 'hline)
- (org-split-string
- (progn (set-text-properties 0 (length elem) nil elem)
- (org-trim elem)) "|")))
- lines))
- (when insert
- (insert (org-export-latex-protect-string
- (concat
- (if longtblp
- (concat "\\begin{longtable}{" align "}\n")
- (if floatp
- (format "\\begin{%s}%s\n" tblenv placement)))
- (if (and floatp org-export-latex-table-caption-above)
- (format
- "\\caption%s{%s} %s"
- (if shortn (concat "[" shortn "]") "")
- (or caption "")
- (if label (format "\\label{%s}" label) "")))
- (if (and longtblp caption org-export-latex-table-caption-above)
- "\\\\\n" "\n")
- (if (and org-export-latex-tables-centered (not longtblp))
- "\\begin{center}\n")
- (if (not longtblp)
- (format "\\begin{%s}%s{%s}\n"
- tabular-env
- (if width (format "{%s}" width) "")
- align))
- (orgtbl-to-latex
- lines
- `(:tstart ,org-export-latex-tables-tstart
- :tend ,org-export-latex-tables-tend
- :hline ,org-export-latex-tables-hline
- :skipheadrule ,longtblp
- :hfmt ,hfmt
- :hlend ,(if longtblp
- (format "\\\\
-%s
-\\endhead
-%s\\multicolumn{%d}{r}{Continued on next page}\\
-\\endfoot
-\\endlastfoot"
- org-export-latex-tables-hline
- org-export-latex-tables-hline
- (length org-table-last-alignment))
- nil)))
- (if (not longtblp) (format "\n\\end{%s}" tabular-env))
- (if longtblp "\n" (if org-export-latex-tables-centered
- "\n\\end{center}\n" "\n"))
- (if (and floatp (not org-export-latex-table-caption-above))
- (format
- "\\caption%s{%s} %s"
- (if shortn (concat "[" shortn "]") "")
- (or caption "")
- (if label (format "\\label{%s}" label) "")))
- (if longtblp
- "\\end{longtable}"
- (if floatp (format "\\end{%s}" tblenv)))))
- "\n\n"))))))))
-
-(defun org-export-latex-convert-table.el-table ()
- "Replace table.el table at point with LaTeX code."
- (let (tbl caption shortn label line floatp attr align rmlines)
- (setq line (buffer-substring (point-at-bol) (point-at-eol))
- label (org-get-text-property-any 0 'org-label line)
- caption (org-get-text-property-any 0 'org-caption line)
- shortn (org-get-text-property-any 0 'org-caption-shortn line)
- attr (org-get-text-property-any 0 'org-attributes line)
- align (and attr (stringp attr)
- (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr)
- (match-string 1 attr))
- rmlines (and attr (stringp attr)
- (string-match "\\<rmlines\\>" attr))
- floatp (or label caption))
- (and (get-buffer "*org-export-table*")
- (kill-buffer (get-buffer "*org-export-table*")))
- (table-generate-source 'latex "*org-export-table*" "caption")
- (setq tbl (with-current-buffer "*org-export-table*"
- (buffer-string)))
- (while (string-match "^%.*\n" tbl)
- (setq tbl (replace-match "" t t tbl)))
- ;; fix the hlines
- (when rmlines
- (let ((n 0) lines)
- (setq lines (mapcar (lambda (x)
- (if (string-match "^\\\\hline$" x)
- (progn
- (setq n (1+ n))
- (if (= n 2) x nil))
- x))
- (org-split-string tbl "\n")))
- (setq tbl (mapconcat 'identity (delq nil lines) "\n"))))
- (when (and align (string-match "\\\\begin{tabular}{.*}" tbl))
- (setq tbl (replace-match (concat "\\begin{tabular}{" align "}")
- t t tbl)))
- (and (get-buffer "*org-export-table*")
- (kill-buffer (get-buffer "*org-export-table*")))
- (beginning-of-line 0)
- (while (looking-at "[ \t]*\\(|\\|\\+-\\)")
- (delete-region (point) (1+ (point-at-eol))))
- (when org-export-latex-tables-centered
- (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}")))
- (when floatp
- (setq tbl (concat "\\begin{table}\n"
- (if (not org-export-latex-table-caption-above) tbl)
- (format "\\caption%s{%s%s}\n"
- (if shortn (format "[%s]" shortn) "")
- (if label (format "\\label{%s}" label) "")
- (or caption ""))
- (if org-export-latex-table-caption-above tbl)
- "\n\\end{table}\n")))
- (insert (org-export-latex-protect-string tbl))))
-
-(defun org-export-latex-fontify ()
- "Convert fontification to LaTeX."
- (goto-char (point-min))
- (while (re-search-forward org-emph-re nil t)
- ;; The match goes one char after the *string*, except at the end of a line
- (let ((emph (assoc (match-string 3)
- org-export-latex-emphasis-alist))
- (beg (match-beginning 0))
- (end (match-end 0))
- rpl s)
- (unless emph
- (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\""
- (match-string 3)))
- (unless (or (and (get-text-property (- (point) 2) 'org-protected)
- (not (get-text-property
- (- (point) 2) 'org-verbatim-emph)))
- (equal (char-after (match-beginning 3))
- (char-after (1+ (match-beginning 3))))
- (save-excursion
- (goto-char (match-beginning 1))
- (save-match-data
- (and (org-at-table-p)
- (string-match
- "[|\n]" (buffer-substring beg end)))))
- (and (equal (match-string 3) "+")
- (save-match-data
- (string-match "\\`-+\\'" (match-string 4)))))
- (setq s (match-string 4))
- (setq rpl (concat (match-string 1)
- (org-export-latex-emph-format (cadr emph)
- (match-string 4))
- (match-string 5)))
- (if (caddr emph)
- (setq rpl (org-export-latex-protect-string rpl))
- (save-match-data
- (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl)
- (progn
- (add-text-properties (match-beginning 1) (match-end 1)
- '(org-protected t) rpl)
- (add-text-properties (match-beginning 3) (match-end 3)
- '(org-protected t) rpl)))))
- (replace-match rpl t t)))
- (backward-char)))
-
-(defun org-export-latex-emph-format (format string)
- "Format an emphasis string and handle the \\verb special case."
- (when (member format '("\\verb" "\\protectedtexttt"))
- (save-match-data
- (if (equal format "\\verb")
- (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (catch 'exit
- (loop for i from 0 to (1- (length ll)) do
- (if (not (string-match (regexp-quote (substring ll i (1+ i)))
- string))
- (progn
- (setq format (concat "\\verb" (substring ll i (1+ i))
- "%s" (substring ll i (1+ i))))
- (throw 'exit nil))))))
- (let ((start 0)
- (trans '(("\\" . "\\textbackslash{}")
- ("~" . "\\textasciitilde{}")
- ("^" . "\\textasciicircum{}")))
- (rtn "") char)
- (while (string-match "[\\{}$%&_#~^]" string)
- (setq char (match-string 0 string))
- (if (> (match-beginning 0) 0)
- (setq rtn (concat rtn (substring string
- 0 (match-beginning 0)))))
- (setq string (substring string (1+ (match-beginning 0))))
- (setq char (or (cdr (assoc char trans)) (concat "\\" char))
- rtn (concat rtn char)))
- (setq string (concat rtn string) format "\\texttt{%s}")
- (while (string-match "--" string)
- (setq string (replace-match "-{}-" t t string)))))))
- (format format string))
-
-(defun org-export-latex-links ()
- ;; Make sure to use the LaTeX hyperref and graphicx package
- ;; or send some warnings.
- "Convert links to LaTeX."
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-analytic-regexp++ nil t)
- (org-if-unprotected-1
- (goto-char (match-beginning 0))
- (let* ((re-radio org-export-latex-all-targets-re)
- (remove (list (match-beginning 0) (match-end 0)))
- (raw-path (org-extract-attributes (match-string 3)))
- (full-raw-path (concat (match-string 1) raw-path))
- (desc (match-string 5))
- (type (or (match-string 2)
- (if (or (file-name-absolute-p raw-path)
- (string-match "^\\.\\.?/" raw-path))
- "file")))
- (coderefp (equal type "coderef"))
- (caption (org-find-text-property-in-string 'org-caption raw-path))
- (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path))
- (attr (or (org-find-text-property-in-string 'org-attributes raw-path)
- (plist-get org-export-latex-options-plist :latex-image-options)))
- (label (org-find-text-property-in-string 'org-label raw-path))
- imgp radiop fnc
- ;; define the path of the link
- (path (cond
- ((member type '("coderef"))
- raw-path)
- ((member type '("http" "https" "ftp"))
- (concat type ":" raw-path))
- ((and re-radio (string-match re-radio raw-path))
- (setq radiop t))
- ((equal type "mailto")
- (concat type ":" raw-path))
- ((equal type "file")
- (if (and (org-file-image-p
- (expand-file-name (org-link-unescape raw-path))
- org-export-latex-inline-image-extensions)
- (or (get-text-property 0 'org-no-description raw-path)
- (equal desc full-raw-path)))
- (setq imgp t)
- (progn (setq raw-path (org-link-unescape raw-path))
- (when (string-match "\\(.+\\)::.+" raw-path)
- (setq raw-path (match-string 1 raw-path)))
- (if (file-exists-p raw-path)
- (concat type "://" (expand-file-name raw-path))
- (concat type "://" (org-export-directory
- :LaTeX org-export-latex-options-plist)
- raw-path))))))))
- ;; process with link inserting
- (apply 'delete-region remove)
- (setq caption (and caption (org-export-latex-fontify-headline caption)))
- (cond ((and imgp
- (plist-get org-export-latex-options-plist :inline-images))
- ;; OK, we need to inline an image
- (insert
- (org-export-latex-format-image raw-path caption label attr shortn)))
- (coderefp
- (insert (format
- (org-export-get-coderef-format path desc)
- (cdr (assoc path org-export-code-refs)))))
- (radiop (insert (format org-export-latex-hyperref-format
- (org-solidify-link-text raw-path) desc)))
- ((not type)
- (insert (format org-export-latex-hyperref-format
- (org-remove-initial-hash
- (org-solidify-link-text raw-path))
- desc)))
- (path
- (when (org-at-table-p)
- ;; There is a strange problem when we have a link in a table,
- ;; ampersands then cause a problem. I think this must be
- ;; a LaTeX issue, but we here implement a work-around anyway.
- (setq path (org-export-latex-protect-amp path)
- desc (org-export-latex-protect-amp desc)))
- (insert
- (if (string-match "%s.*%s" org-export-latex-href-format)
- (format org-export-latex-href-format path desc)
- (format org-export-latex-href-format path))))
-
- ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- ;; The link protocol has a function for formatting the link
- (insert
- (save-match-data
- (funcall fnc (org-link-unescape raw-path) desc 'latex))))
- ;; Unrecognized path type
- (t (insert (format org-export-latex-link-with-unknown-path-format desc))))))))
-
-
-(defun org-export-latex-format-image (path caption label attr &optional shortn)
- "Format the image element, depending on user settings."
- (let (ind floatp wrapp multicolumnp placement figenv)
- (setq floatp (or caption label))
- (setq ind (org-get-text-property-any 0 'original-indentation path))
- (when (and attr (stringp attr))
- (if (string-match "[ \t]*\\<wrap\\>" attr)
- (setq wrapp t floatp nil attr (replace-match "" t t attr)))
- (if (string-match "[ \t]*\\<float\\>" attr)
- (setq wrapp nil floatp t attr (replace-match "" t t attr)))
- (if (string-match "[ \t]*\\<multicolumn\\>" attr)
- (setq multicolumnp t attr (replace-match "" t t attr))))
-
- (setq placement
- (cond
- (wrapp "{l}{0.5\\textwidth}")
- (floatp (concat "[" org-latex-default-figure-position "]"))
- (t "")))
-
- (when (and attr (stringp attr)
- (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr))
- (setq placement (match-string 1 attr)
- attr (replace-match "" t t attr)))
- (setq attr (and attr (org-trim attr)))
- (when (or (not attr) (= (length attr) 0))
- (setq attr (cond (floatp "width=0.7\\textwidth")
- (wrapp "width=0.48\\textwidth")
- (t attr))))
- (setq figenv
- (cond
- (wrapp "\\begin{wrapfigure}%placement
-\\centering
-\\includegraphics[%attr]{%path}
-\\caption%shortn{%labelcmd%caption}
-\\end{wrapfigure}")
- (multicolumnp "\\begin{figure*}%placement
-\\centering
-\\includegraphics[%attr]{%path}
-\\caption%shortn{%labelcmd%caption}
-\\end{figure*}")
- (floatp "\\begin{figure}%placement
-\\centering
-\\includegraphics[%attr]{%path}
-\\caption%shortn{%labelcmd%caption}
-\\end{figure}")
- (t "\\includegraphics[%attr]{%path}")))
-
-
- (setq figenv (mapconcat 'identity (split-string figenv "\n")
- (save-excursion (beginning-of-line 1)
- (looking-at "[ \t]*")
- (concat "\n" (match-string 0)))))
-
- (if (and (not label) (not caption)
- (string-match "^\\\\caption{.*\n" figenv))
- (setq figenv (replace-match "" t t figenv)))
- (org-add-props
- (org-fill-template
- figenv
- (list (cons "path"
- (if (file-name-absolute-p path)
- (expand-file-name path)
- path))
- (cons "attr" attr)
- (cons "shortn" (if shortn (format "[%s]" shortn) ""))
- (cons "labelcmd" (if label (format "\\label{%s}"
- label)""))
- (cons "caption" (or caption ""))
- (cons "placement" (or placement ""))))
- nil 'original-indentation ind)))
-
-(defun org-export-latex-protect-amp (s)
- (while (string-match "\\([^\\\\]\\)\\(&\\)" s)
- (setq s (replace-match (concat (match-string 1 s) "\\" (match-string 2 s))
- t t s)))
- s)
-
-(defun org-remove-initial-hash (s)
- (if (string-match "\\`#" s)
- (substring s 1)
- s))
-(defvar org-latex-entities) ; defined below
-(defvar org-latex-entities-regexp) ; defined below
-
-(defun org-export-latex-preprocess (parameters)
- "Clean stuff in the LaTeX export."
- ;; Replace footnotes.
- (when (plist-get parameters :footnotes)
- (goto-char (point-min))
- (let (ref)
- (while (setq ref (org-footnote-get-next-reference))
- (let* ((beg (nth 1 ref))
- (lbl (car ref))
- (def (nth 1 (assoc (string-to-number lbl)
- (mapcar (lambda (e) (cdr e))
- org-export-footnotes-seen)))))
- ;; Fix body for footnotes ending on a link or a list and
- ;; remove definition from buffer.
- (setq def
- (concat def
- (if (string-match "ORG-LIST-END-MARKER\\'" def)
- "\n" " ")))
- (org-footnote-delete-definitions lbl)
- ;; Compute string to insert (FNOTE), and protect the outside
- ;; macro from further transformation. When footnote at
- ;; point is referring to a previously defined footnote, use
- ;; \footnotemark. Otherwise, use \footnote.
- (let ((fnote (if (member lbl org-export-latex-footmark-seen)
- (org-export-latex-protect-string
- (format "\\footnotemark[%s]" lbl))
- (push lbl org-export-latex-footmark-seen)
- (concat (org-export-latex-protect-string "\\footnote{")
- def
- (org-export-latex-protect-string "}"))))
- ;; Check if another footnote is immediately following.
- ;; If so, add a separator in-between.
- (sep (org-export-latex-protect-string
- (if (save-excursion (goto-char (1- (nth 2 ref)))
- (let ((next (org-footnote-get-next-reference)))
- (and next (= (nth 1 next) (nth 2 ref)))))
- org-export-latex-footnote-separator ""))))
- (when (org-at-heading-p)
- (setq fnote (concat (org-export-latex-protect-string "\\protect")
- fnote)))
- ;; Ensure a footnote at column 0 cannot end a list
- ;; containing it.
- (put-text-property 0 (length fnote) 'original-indentation 1000 fnote)
- ;; Replace footnote reference with FNOTE and, maybe, SEP.
- ;; `save-excursion' is required if there are two footnotes
- ;; in a row. In that case, point would be left at the
- ;; beginning of the second one, and
- ;; `org-footnote-get-next-reference' would then skip it.
- (goto-char beg)
- (delete-region beg (nth 2 ref))
- (save-excursion (insert fnote sep)))))))
-
- ;; Remove footnote section tag for LaTeX
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^" footnote-section-tag-regexp) nil t)
- (org-if-unprotected
- (replace-match "")))
- ;; Remove any left-over footnote definition.
- (mapc (lambda (fn) (org-footnote-delete-definitions (car fn)))
- org-export-footnotes-data)
- (mapc (lambda (fn) (org-footnote-delete-definitions fn))
- org-export-latex-footmark-seen)
-
- ;; Preserve line breaks
- (goto-char (point-min))
- (while (re-search-forward "\\\\\\\\" nil t)
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-protected t)))
-
- ;; Preserve latex environments
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t)
- (org-if-unprotected
- (let* ((start (progn (beginning-of-line) (point)))
- (end (and (re-search-forward
- (concat "^[ \t]*\\\\end{"
- (regexp-quote (match-string 1))
- "}") nil t)
- (point-at-eol))))
- (if end
- (add-text-properties start end '(org-protected t))
- (goto-char (point-at-eol))))))
-
- ;; Preserve math snippets
- (let* ((matchers (plist-get org-format-latex-options :matchers))
- (re-list org-latex-regexps)
- beg end re e m n block off)
- ;; Check the different regular expressions
- (while (setq e (pop re-list))
- (setq m (car e) re (nth 1 e) n (nth 2 e)
- block (if (nth 3 e) "\n\n" ""))
- (setq off (if (member m '("$" "$1")) 1 0))
- (when (and (member m matchers) (not (equal m "begin")))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0))
- (add-text-properties beg end '(org-protected t org-latex-math t))))))
-
- ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{}
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t)
- (unless (eq (char-before (match-beginning 1)) ?\\)
- (org-if-unprotected-1
- (replace-match (org-export-latex-protect-string
- (concat "\\" (match-string 1)
- "{}")) t t)))))
-
- ;; Convert blockquotes
- (goto-char (point-min))
- (while (search-forward "ORG-BLOCKQUOTE-START" nil t)
- (org-replace-match-keep-properties "\\begin{quote}" t t))
- (goto-char (point-min))
- (while (search-forward "ORG-BLOCKQUOTE-END" nil t)
- (org-replace-match-keep-properties "\\end{quote}" t t))
-
- ;; Convert verse
- (goto-char (point-min))
- (while (search-forward "ORG-VERSE-START" nil t)
- (org-replace-match-keep-properties "\\begin{verse}" t t)
- (beginning-of-line 2)
- (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp)))
- (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)")
- (goto-char (match-end 1))
- (org-replace-match-keep-properties
- (org-export-latex-protect-string
- (concat "\\hspace*{1cm}" (match-string 2))) t t)
- (beginning-of-line 1))
- (if (looking-at "[ \t]*$")
- (insert (org-export-latex-protect-string "\\vspace*{1em}"))
- (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$")
- (end-of-line 1)
- (insert "\\\\")))
- (beginning-of-line 2))
- (and (looking-at "[ \t]*ORG-VERSE-END.*")
- (org-replace-match-keep-properties "\\end{verse}" t t)))
-
- ;; Convert #+INDEX to LaTeX \\index.
- (goto-char (point-min))
- (let ((case-fold-search t) entry)
- (while (re-search-forward
- "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$"
- nil t)
- (setq entry
- (save-match-data
- (org-export-latex-protect-string
- (org-export-latex-fontify-headline (match-string 1)))))
- (replace-match (format "\\index{%s}" entry) t t)))
-
- ;; Convert center
- (goto-char (point-min))
- (while (search-forward "ORG-CENTER-START" nil t)
- (org-replace-match-keep-properties "\\begin{center}" t t))
- (goto-char (point-min))
- (while (search-forward "ORG-CENTER-END" nil t)
- (org-replace-match-keep-properties "\\end{center}" t t))
-
- (run-hooks 'org-export-latex-after-blockquotes-hook)
-
- ;; Convert horizontal rules
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t)
- (org-if-unprotected
- (replace-match (org-export-latex-protect-string "\\hrule") t t)))
-
- ;; Protect LaTeX commands like \command[...]{...} or \command{...}
- (goto-char (point-min))
- (let ((re (concat
- "\\\\\\([a-zA-Z]+\\*?\\)"
- "\\(?:<[^<>\n]*>\\)*"
- "\\(?:\\[[^][\n]*?\\]\\)*"
- "\\(?:<[^<>\n]*>\\)*"
- "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}")))
- (while (re-search-forward re nil t)
- (unless (or
- ;; Check for comment line.
- (save-excursion (goto-char (match-beginning 0))
- (org-in-indented-comment-line))
- ;; Check if this is a defined entity, so that is may
- ;; need conversion.
- (org-entity-get (match-string 1))
- ;; Do not protect interior of footnotes. Those have
- ;; already been taken care of earlier in the function.
- ;; Yet, keep looking inside them for more commands.
- (and (equal (match-string 1) "footnote")
- (goto-char (match-end 1))))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-protected t)))))
-
- ;; Special case for \nbsp
- (goto-char (point-min))
- (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t)
- (org-if-unprotected
- (replace-match (org-export-latex-protect-string "~"))))
-
- ;; Protect LaTeX entities
- (goto-char (point-min))
- (while (re-search-forward org-latex-entities-regexp nil t)
- (org-if-unprotected
- (add-text-properties (match-beginning 0) (match-end 0)
- '(org-protected t))))
-
- ;; Replace radio links
- (goto-char (point-min))
- (while (re-search-forward
- (concat "<<<?" org-export-latex-all-targets-re
- ">>>?\\((INVISIBLE)\\)?") nil t)
- (org-if-unprotected-at (+ (match-beginning 0) 2)
- (replace-match
- (concat
- (org-export-latex-protect-string
- (format "\\label{%s}" (save-match-data (org-solidify-link-text
- (match-string 1)))))
- (if (match-string 2) "" (match-string 1)))
- t t)))
-
- ;; Delete @<...> constructs
- ;; Thanks to Daniel Clemente for this regexp
- (goto-char (point-min))
- (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t)
- (org-if-unprotected
- (replace-match ""))))
-
-(defun org-export-latex-fix-inputenc ()
- "Set the coding system in inputenc to what the buffer is."
- (let* ((cs buffer-file-coding-system)
- (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs))
- "utf8")))
- (when opt
- ;; Translate if that is requested
- (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt))
- ;; find the \usepackage statement and replace the option
- (goto-char (point-min))
- (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
- nil t)
- (goto-char (match-beginning 1))
- (delete-region (match-beginning 1) (match-end 1))
- (insert opt))
- (and buffer-file-name
- (save-buffer)))))
-
-;;; List handling:
-
-(defun org-export-latex-lists ()
- "Convert plain text lists in current buffer into LaTeX lists."
- ;; `org-list-end-re' output has changed since preprocess from
- ;; org-exp.el. Make sure it is taken into account.
- (let ((org-list-end-re "^ORG-LIST-END-MARKER\n"))
- (mapc
- (lambda (e)
- ;; For each type of context allowed for list export (E), find
- ;; every list, parse it, delete it and insert resulting
- ;; conversion to latex (RES), while keeping the same
- ;; `original-indentation' property.
- (let (res)
- (goto-char (point-min))
- (while (re-search-forward (org-item-beginning-re) nil t)
- (when (and (eq (get-text-property (point) 'list-context) e)
- (not (get-text-property (point) 'org-example)))
- (beginning-of-line)
- (setq res
- (org-list-to-latex
- ;; Narrowing is needed because we're converting
- ;; from inner functions to outer ones.
- (save-restriction
- (narrow-to-region (point) (point-max))
- (org-list-parse-list t))
- org-export-latex-list-parameters))
- ;; Extend previous value of original-indentation to the
- ;; whole string
- (insert (org-add-props res nil 'original-indentation
- (org-find-text-property-in-string
- 'original-indentation res)))))))
- ;; List of allowed contexts for export, and the default one.
- (append org-list-export-context '(nil)))))
-
-(defconst org-latex-entities
- '("\\!"
- "\\'"
- "\\+"
- "\\,"
- "\\-"
- "\\:"
- "\\;"
- "\\<"
- "\\="
- "\\>"
- "\\Huge"
- "\\LARGE"
- "\\Large"
- "\\Styles"
- "\\\\"
- "\\`"
- "\\\""
- "\\addcontentsline"
- "\\address"
- "\\addtocontents"
- "\\addtocounter"
- "\\addtolength"
- "\\addvspace"
- "\\alph"
- "\\appendix"
- "\\arabic"
- "\\author"
- "\\begin{array}"
- "\\begin{center}"
- "\\begin{description}"
- "\\begin{enumerate}"
- "\\begin{eqnarray}"
- "\\begin{equation}"
- "\\begin{figure}"
- "\\begin{flushleft}"
- "\\begin{flushright}"
- "\\begin{itemize}"
- "\\begin{list}"
- "\\begin{minipage}"
- "\\begin{picture}"
- "\\begin{quotation}"
- "\\begin{quote}"
- "\\begin{tabbing}"
- "\\begin{table}"
- "\\begin{tabular}"
- "\\begin{thebibliography}"
- "\\begin{theorem}"
- "\\begin{titlepage}"
- "\\begin{verbatim}"
- "\\begin{verse}"
- "\\bf"
- "\\bf"
- "\\bibitem"
- "\\bigskip"
- "\\cdots"
- "\\centering"
- "\\circle"
- "\\cite"
- "\\cleardoublepage"
- "\\clearpage"
- "\\cline"
- "\\closing"
- "\\dashbox"
- "\\date"
- "\\ddots"
- "\\dotfill"
- "\\em"
- "\\fbox"
- "\\flushbottom"
- "\\fnsymbol"
- "\\footnote"
- "\\footnotemark"
- "\\footnotesize"
- "\\footnotetext"
- "\\frac"
- "\\frame"
- "\\framebox"
- "\\hfill"
- "\\hline"
- "\\hrulespace"
- "\\hspace"
- "\\huge"
- "\\hyphenation"
- "\\include"
- "\\includeonly"
- "\\indent"
- "\\input"
- "\\it"
- "\\kill"
- "\\label"
- "\\large"
- "\\ldots"
- "\\line"
- "\\linebreak"
- "\\linethickness"
- "\\listoffigures"
- "\\listoftables"
- "\\location"
- "\\makebox"
- "\\maketitle"
- "\\mark"
- "\\mbox"
- "\\medskip"
- "\\multicolumn"
- "\\multiput"
- "\\newcommand"
- "\\newcounter"
- "\\newenvironment"
- "\\newfont"
- "\\newlength"
- "\\newline"
- "\\newpage"
- "\\newsavebox"
- "\\newtheorem"
- "\\nocite"
- "\\nofiles"
- "\\noindent"
- "\\nolinebreak"
- "\\nopagebreak"
- "\\normalsize"
- "\\onecolumn"
- "\\opening"
- "\\oval"
- "\\overbrace"
- "\\overline"
- "\\pagebreak"
- "\\pagenumbering"
- "\\pageref"
- "\\pagestyle"
- "\\par"
- "\\parbox"
- "\\put"
- "\\raggedbottom"
- "\\raggedleft"
- "\\raggedright"
- "\\raisebox"
- "\\ref"
- "\\rm"
- "\\roman"
- "\\rule"
- "\\savebox"
- "\\sc"
- "\\scriptsize"
- "\\setcounter"
- "\\setlength"
- "\\settowidth"
- "\\sf"
- "\\shortstack"
- "\\signature"
- "\\sl"
- "\\small"
- "\\smallskip"
- "\\sqrt"
- "\\tableofcontents"
- "\\telephone"
- "\\thanks"
- "\\thispagestyle"
- "\\tiny"
- "\\title"
- "\\tt"
- "\\twocolumn"
- "\\typein"
- "\\typeout"
- "\\underbrace"
- "\\underline"
- "\\usebox"
- "\\usecounter"
- "\\value"
- "\\vdots"
- "\\vector"
- "\\verb"
- "\\vfill"
- "\\vline"
- "\\vspace")
- "A list of LaTeX commands to be protected when performing conversion.")
-
-(defconst org-latex-entities-regexp
- (let (names rest)
- (dolist (x org-latex-entities)
- (if (string-match "[a-zA-Z]$" x)
- (push x names)
- (push x rest)))
- (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)"
- "\\|\\(" (regexp-opt (nreverse rest)) "\\)")))
-
-(provide 'org-export-latex)
-(provide 'org-latex)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-latex.el ends here
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index 47476481625..c8266500fe3 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -1,9 +1,9 @@
;;; org-list.el --- Plain lists for Org-mode
;;
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT gnu DOT org>
+;; Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
@@ -94,6 +94,11 @@
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
+(declare-function outline-invisible-p "outline" (&optional pos))
+(declare-function outline-flag-region "outline" (from to flag))
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-previous-heading "outline" ())
+
(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-back-to-heading "org" (&optional invisible-ok))
@@ -107,10 +112,6 @@
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
-(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
-(declare-function org-inlinetask-goto-end "org-inlinetask" ())
-(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
-(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-at-heading-p "org" (&optional invisible-ok))
@@ -118,15 +119,21 @@
(declare-function org-remove-if "org" (predicate seq))
(declare-function org-reduced-level "org" (L))
(declare-function org-show-subtree "org" ())
+(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-trim "org" (s))
(declare-function org-uniquify "org" (list))
-(declare-function outline-invisible-p "outline" (&optional pos))
-(declare-function outline-flag-region "outline" (from to flag))
-(declare-function outline-next-heading "outline" ())
-(declare-function outline-previous-heading "outline" ())
+
+(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
+(declare-function org-inlinetask-goto-end "org-inlinetask" ())
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+
+(declare-function org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
+
@@ -154,6 +161,7 @@ plain list item with an implied large level number, all true
children and grand children of the outline heading will be
exposed in a children' view."
:group 'org-plain-lists
+ :group 'org-cycle
:type '(choice
(const :tag "Never" nil)
(const :tag "With cursor in plain list (recommended)" t)
@@ -209,14 +217,26 @@ Valid values are ?. and ?\). To get both terminators, use t."
(const :tag "paren like in \"2)\"" ?\))
(const :tag "both" t)))
-(defcustom org-alphabetical-lists nil
+(define-obsolete-variable-alias 'org-alphabetical-lists
+ 'org-list-allow-alphabetical "24.4") ; Since 8.0
+(defcustom org-list-allow-alphabetical nil
"Non-nil means single character alphabetical bullets are allowed.
+
Both uppercase and lowercase are handled. Lists with more than
26 items will fallback to standard numbering. Alphabetical
-counters like \"[@c]\" will be recognized."
+counters like \"[@c]\" will be recognized.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code after updating it:
+
+ (when (featurep \\='org-element) (load \"org-element\" t t))"
:group 'org-plain-lists
:version "24.1"
- :type 'boolean)
+ :type 'boolean
+ :set (lambda (var val)
+ (when (featurep 'org-element) (load "org-element" t t))
+ (set var val)))
(defcustom org-list-two-spaces-after-bullet-regexp nil
"A regular expression matching bullets that should have 2 spaces after them.
@@ -230,7 +250,9 @@ spaces instead of one after the bullet in each item of the list."
(const :tag "never" nil)
(regexp)))
-(defcustom org-empty-line-terminates-plain-lists nil
+(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists
+ 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0
+(defcustom org-list-empty-line-terminates-plain-lists nil
"Non-nil means an empty line ends all plain list levels.
Otherwise, two of them will be necessary."
:group 'org-plain-lists
@@ -282,7 +304,9 @@ This hook runs even if checkbox rule in
implement alternative ways of collecting statistics
information.")
-(defcustom org-hierarchical-checkbox-statistics t
+(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
+ 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0
+(defcustom org-checkbox-hierarchical-statistics t
"Non-nil means checkbox statistics counts only the state of direct children.
When nil, all boxes below the cookie are counted.
This can be set to nil on a per-node basis using a COOKIE_DATA property
@@ -290,7 +314,9 @@ with the word \"recursive\" in the value."
:group 'org-plain-lists
:type 'boolean)
-(defcustom org-description-max-indent 20
+(org-defvaralias 'org-description-max-indent
+ 'org-list-description-max-indent) ;; Since 8.0
+(defcustom org-list-description-max-indent 20
"Maximum indentation for the second line of a description list.
When the indentation would be larger than this, it will become
5 characters instead."
@@ -333,7 +359,7 @@ list, obtained by prompting the user."
(string :tag "Format"))))
(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "docbook" "html" "latex" "odt")
+ "html" "latex" "odt")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
@@ -348,10 +374,10 @@ specifically, type `block' is determined by the variable
;;; Predicates and regexps
-(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n"
+(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n"
"^[ \t]*\n[ \t]*\n")
"Regex corresponding to the end of a list.
-It depends on `org-empty-line-terminates-plain-lists'.")
+It depends on `org-list-empty-line-terminates-plain-lists'.")
(defconst org-list-full-item-re
(concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
@@ -371,7 +397,7 @@ group 4: description tag")
((= org-plain-list-ordered-item-terminator ?\)) ")")
((= org-plain-list-ordered-item-terminator ?.) "\\.")
(t "[.)]")))
- (alpha (if org-alphabetical-lists "\\|[A-Za-z]" "")))
+ (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" "")))
(concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
"\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
@@ -385,7 +411,7 @@ group 4: description tag")
(save-excursion
(goto-char (match-end 0))
(let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?"
- (if org-alphabetical-lists
+ (if org-list-allow-alphabetical
"\\([0-9]+\\|[A-Za-z]\\)"
"[0-9]+")
"\\][ \t]*\\)")))
@@ -405,7 +431,7 @@ group 4: description tag")
(context (org-list-context))
(lim-up (car context))
(drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
@@ -524,7 +550,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
;; Can't use org-drawers-regexp as this function might
;; be called in buffers not in Org mode.
(beg-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$")))
(when (save-excursion
(and (not (looking-at beg-re))
@@ -594,11 +620,11 @@ point-at-bol:
will get the following structure:
-\(\(1 0 \"- \" nil \"[X]\" nil 97\)
- \(18 2 \"1. \" nil nil nil 34\)
- \(34 2 \"5. \" \"5\" nil nil 55\)
- \(97 0 \"- \" nil nil nil 131\)
- \(109 2 \"+ \" nil nil \"tag\" 131\)
+ ((1 0 \"- \" nil \"[X]\" nil 97)
+ (18 2 \"1. \" nil nil nil 34)
+ (34 2 \"5. \" \"5\" nil nil 55)
+ (97 0 \"- \" nil nil nil 131)
+ (109 2 \"+ \" nil nil \"tag\" 131))
Assume point is at an item."
(save-excursion
@@ -610,12 +636,12 @@ Assume point is at an item."
(text-min-ind 10000)
(item-re (org-item-re))
(drawers-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(beg-cell (cons (point) (org-get-indentation)))
- ind itm-lst itm-lst-2 end-lst end-lst-2 struct
+ itm-lst itm-lst-2 end-lst end-lst-2 struct
(assoc-at-point
(function
;; Return association at point.
@@ -642,8 +668,7 @@ Assume point is at an item."
(save-excursion
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((<= (point) lim-up)
;; At upward limit: if we ended at an item, store it,
@@ -651,18 +676,10 @@ Assume point is at an item."
;; Jump to part 2.
(throw 'exit
(setq itm-lst
- (if (or (not (looking-at item-re))
- (get-text-property (point) 'org-example))
+ (if (not (looking-at item-re))
(memq (assq (car beg-cell) itm-lst) itm-lst)
(setq beg-cell (cons (point) ind))
(cons (funcall assoc-at-point ind) itm-lst)))))
- ;; At a verbatim block, go before its beginning. Move
- ;; from eol to ensure `previous-single-property-change'
- ;; will return a value.
- ((get-text-property (point) 'org-example)
- (goto-char (previous-single-property-change
- (point-at-eol) 'org-example nil lim-up))
- (forward-line -1))
;; Looking at a list ending regexp. Dismiss useless
;; data recorded above BEG-CELL. Jump to part 2.
((looking-at org-list-end-re)
@@ -711,8 +728,7 @@ Assume point is at an item."
;; position of items in END-LST-2.
(catch 'exit
(while t
- (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0)
- (org-get-indentation))))
+ (let ((ind (org-get-indentation)))
(cond
((>= (point) lim-down)
;; At downward limit: this is de facto the end of the
@@ -720,12 +736,6 @@ Assume point is at an item."
;; part 3.
(throw 'exit
(push (cons 0 (funcall end-before-blank)) end-lst-2)))
- ;; At a verbatim block, move to its end. Point is at bol
- ;; and 'org-example property is set by whole lines:
- ;; `next-single-property-change' always return a value.
- ((get-text-property (point) 'org-example)
- (goto-char
- (next-single-property-change (point) 'org-example nil lim-down)))
;; Looking at a list ending regexp. Save point as an
;; ending position and jump to part 3.
((looking-at org-list-end-re)
@@ -916,13 +926,13 @@ Value returned is the position of the first child of ITEM."
(< ind (org-list-get-ind child-maybe struct)))
child-maybe)))
-(defun org-list-get-next-item (item struct prevs)
+(defun org-list-get-next-item (item _struct prevs)
"Return next item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
(car (rassq item prevs)))
-(defun org-list-get-prev-item (item struct prevs)
+(defun org-list-get-prev-item (item _struct prevs)
"Return previous item in same sub-list as ITEM, or nil.
STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'."
@@ -954,7 +964,7 @@ items, as returned by `org-list-prevs-alist'."
(push next-item after-item))
(append before-item (list item) (nreverse after-item))))
-(defun org-list-get-children (item struct parents)
+(defun org-list-get-children (item _struct parents)
"List all children of ITEM, or nil.
STRUCT is the list structure. PARENTS is the alist of parents,
as returned by `org-list-parents-alist'."
@@ -972,7 +982,7 @@ STRUCT is the list structure."
(defun org-list-get-bottom-point (struct)
"Return point at bottom of list.
STRUCT is the list structure."
- (apply 'max
+ (apply #'max
(mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct)))
(defun org-list-get-list-begin (item struct prevs)
@@ -1097,8 +1107,9 @@ It determines the number of whitespaces to append by looking at
org-list-two-spaces-after-bullet-regexp bullet))
" "
" ")))
- (string-match "\\S-+\\([ \t]*\\)" bullet)
- (replace-match spaces nil nil bullet 1))))
+ (if (string-match "\\S-+\\([ \t]*\\)" bullet)
+ (replace-match spaces nil nil bullet 1)
+ bullet))))
(defun org-list-swap-items (beg-A beg-B struct)
"Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
@@ -1208,11 +1219,11 @@ some heuristics to guess the result."
(point))))))))
(cond
;; Trivial cases where there should be none.
- ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
;; When `org-blank-before-new-entry' says so, it is 1.
((eq insert-blank-p t) 1)
;; `plain-list-item' is 'auto. Count blank lines separating
- ;; neighbours items in list.
+ ;; neighbors' items in list.
(t (let ((next-p (org-list-get-next-item item struct prevs)))
(cond
;; Is there a next item?
@@ -1243,7 +1254,7 @@ some heuristics to guess the result."
If POS is before first character after bullet of the item, the
new item will be created before the current one.
-STRUCT is the list structure. PREVS is the the alist of previous
+STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'.
Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
@@ -1613,14 +1624,13 @@ bullets between START and END."
STRUCT is list structure. PREVS is the alist of previous items,
as returned by `org-list-prevs-alist'."
- (and org-alphabetical-lists
+ (and org-list-allow-alphabetical
(catch 'exit
(let ((item first) (ascii 64) (case-fold-search nil))
;; Pretend that bullets are uppercase and check if alphabet
;; is sufficient, taking counters into account.
(while item
- (let ((bul (org-list-get-bullet item struct))
- (count (org-list-get-counter item struct)))
+ (let ((count (org-list-get-counter item struct)))
;; Virtually determine current bullet
(if (and count (string-match "[a-zA-Z]" count))
;; Counters are not case-sensitive.
@@ -1717,7 +1727,7 @@ This function modifies STRUCT."
(replace-match "1" nil nil bullet))
;; Not an ordered list: keep bullet.
(t bullet)))))))))
- (mapc fix-bul (mapcar 'car struct))))
+ (mapc fix-bul (mapcar #'car struct))))
(defun org-list-struct-fix-ind (struct parents &optional bullet-size)
"Verify and correct indentation in STRUCT.
@@ -1745,7 +1755,7 @@ This function modifies STRUCT."
org-list-indent-offset))
;; If no parent, indent like top-point.
(org-list-set-ind item struct top-ind))))))
- (mapc new-ind (mapcar 'car (cdr struct)))))
+ (mapc new-ind (mapcar #'car (cdr struct)))))
(defun org-list-struct-fix-box (struct parents prevs &optional ordered)
"Verify and correct checkboxes in STRUCT.
@@ -1760,7 +1770,7 @@ break this rule, the function will return the blocking item. In
all others cases, the return value will be nil.
This function modifies STRUCT."
- (let ((all-items (mapcar 'car struct))
+ (let ((all-items (mapcar #'car struct))
(set-parent-box
(function
(lambda (item)
@@ -1851,9 +1861,10 @@ Initial position of cursor is restored after the changes."
(item-re (org-item-re))
(shift-body-ind
(function
- ;; Shift the indentation between END and BEG by DELTA.
- ;; Start from the line before END.
- (lambda (end beg delta)
+ ;; Shift the indentation between END and BEG by DELTA. If
+ ;; MAX-IND is non-nil, ensure that no line will be indented
+ ;; more than that number. Start from the line before END.
+ (lambda (end beg delta max-ind)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
@@ -1867,7 +1878,8 @@ Initial position of cursor is restored after the changes."
;; Shift only non-empty lines.
((org-looking-at-p "^[ \t]*\\S-")
(let ((i (org-get-indentation)))
- (org-indent-line-to (+ i delta)))))
+ (org-indent-line-to
+ (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
(forward-line -1)))))
(modify-item
(function
@@ -1903,53 +1915,60 @@ Initial position of cursor is restored after the changes."
(indent-to new-ind)))))))
;; 1. First get list of items and position endings. We maintain
;; two alists: ITM-SHIFT, determining indentation shift needed
- ;; at item, and END-POS, a pseudo-alist where key is ending
+ ;; at item, and END-LIST, a pseudo-alist where key is ending
;; position and value point.
(let (end-list acc-end itm-shift all-ends sliced-struct)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (ind-old (org-list-get-ind pos old-struct))
- (bul-pos (org-list-get-bullet pos struct))
- (bul-old (org-list-get-bullet pos old-struct))
- (ind-shift (- (+ ind-pos (length bul-pos))
- (+ ind-old (length bul-old))))
- (end-pos (org-list-get-item-end pos old-struct)))
- (push (cons pos ind-shift) itm-shift)
- (unless (assq end-pos old-struct)
- ;; To determine real ind of an ending position that
- ;; is not at an item, we have to find the item it
- ;; belongs to: it is the last item (ITEM-UP), whose
- ;; ending is further than the position we're
- ;; interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
- (push (cons end-pos item-up) end-list)))
- (push (cons end-pos pos) acc-end)))
- old-struct)
+ (dolist (e old-struct)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (ind-old (org-list-get-ind pos old-struct))
+ (bul-pos (org-list-get-bullet pos struct))
+ (bul-old (org-list-get-bullet pos old-struct))
+ (ind-shift (- (+ ind-pos (length bul-pos))
+ (+ ind-old (length bul-old))))
+ (end-pos (org-list-get-item-end pos old-struct)))
+ (push (cons pos ind-shift) itm-shift)
+ (unless (assq end-pos old-struct)
+ ;; To determine real ind of an ending position that
+ ;; is not at an item, we have to find the item it
+ ;; belongs to: it is the last item (ITEM-UP), whose
+ ;; ending is further than the position we're
+ ;; interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons end-pos item-up) end-list)))
+ (push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
- ;; same amount of indentation. The slices are returned in
- ;; reverse order so changes modifying buffer do not change
- ;; positions they refer to.
- (setq all-ends (sort (append (mapcar 'car itm-shift)
- (org-uniquify (mapcar 'car end-list)))
+ ;; same amount of indentation. Each slice follow the pattern
+ ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
+ ;; reverse order.
+ (setq all-ends (sort (append (mapcar #'car itm-shift)
+ (org-uniquify (mapcar #'car end-list)))
'<))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
- (ind (if (assq up struct)
- (cdr (assq up itm-shift))
- (cdr (assq (cdr (assq up end-list)) itm-shift)))))
- (push (list down up ind) sliced-struct)))
+ (itemp (assq up struct))
+ (item (if itemp up (cdr (assq up end-list))))
+ (ind (cdr (assq item itm-shift)))
+ ;; If we're not at an item, there's a child of the item
+ ;; point belongs to above. Make sure this slice isn't
+ ;; moved within that child by specifying a maximum
+ ;; indentation.
+ (max-ind (and (not itemp)
+ (+ (org-list-get-ind item struct)
+ (length (org-list-get-bullet item struct))
+ org-list-indent-offset))))
+ (push (list down up ind max-ind) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
- (mapc (lambda (e)
- (unless (zerop (nth 2 e)) (apply shift-body-ind e))
- (let* ((beg (nth 1 e))
- (cell (assq beg struct)))
- (unless (or (not cell) (equal cell (assq beg old-struct)))
- (funcall modify-item beg))))
- sliced-struct))
+ (dolist (e sliced-struct)
+ (unless (and (zerop (nth 2 e)) (not (nth 3 e)))
+ (apply shift-body-ind e))
+ (let* ((beg (nth 1 e))
+ (cell (assq beg struct)))
+ (unless (or (not cell) (equal cell (assq beg old-struct)))
+ (funcall modify-item beg)))))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))
@@ -1996,7 +2015,7 @@ previous item, plus ARGS extra arguments.
FUNCTION is applied on items in reverse order.
-As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\)
+As an example, \(org-apply-on-list \(lambda \(result) \(1+ result)) 0)
will return the number of items in the current list.
Sublists of the list are skipped. Cursor is always at the
@@ -2148,7 +2167,7 @@ the item, so this really moves item trees."
(prevs (org-list-prevs-alist struct))
(next-item (org-list-get-next-item (point-at-bol) struct prevs)))
(unless (or next-item org-list-use-circular-motion)
- (error "Cannot move this item further down"))
+ (user-error "Cannot move this item further down"))
(if (not next-item)
(setq struct (org-list-send-item item 'begin struct))
(setq struct (org-list-swap-items item next-item struct))
@@ -2169,7 +2188,7 @@ the item, so this really moves item trees."
(prevs (org-list-prevs-alist struct))
(prev-item (org-list-get-prev-item (point-at-bol) struct prevs)))
(unless (or prev-item org-list-use-circular-motion)
- (error "Cannot move this item further up"))
+ (user-error "Cannot move this item further up"))
(if (not prev-item)
(setq struct (org-list-send-item item 'end struct))
(setq struct (org-list-swap-items prev-item item struct)))
@@ -2203,9 +2222,8 @@ item is invisible."
;; If we're in a description list, ask for the new term.
(desc (when (eq (org-list-get-list-type itemp struct prevs)
'descriptive)
- (concat (read-string "Term: ") " :: "))))
- (setq struct
- (org-list-insert-item pos struct prevs checkbox desc))
+ " :: ")))
+ (setq struct (org-list-insert-item pos struct prevs checkbox desc))
(org-list-write-struct struct (org-list-parents-alist struct))
(when checkbox (org-update-checkbox-count-maybe))
(looking-at org-list-full-item-re)
@@ -2214,10 +2232,11 @@ item is invisible."
(string-match "[.)]" (match-string 1))))
(match-beginning 4)
(match-end 0)))
+ (if desc (backward-char 1))
t)))))
(defun org-list-repair ()
- "Fix indentation, bullets and checkboxes is the list at point."
+ "Fix indentation, bullets and checkboxes in the list at point."
(interactive)
(unless (org-at-item-p) (error "This is not a list"))
(let* ((struct (org-list-struct))
@@ -2307,7 +2326,7 @@ in subtree, ignoring drawers."
lim-up
lim-down
(drawer-re (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
+ (mapconcat #'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
"\\|" org-deadline-string
@@ -2315,7 +2334,7 @@ in subtree, ignoring drawers."
"\\|" org-clock-string "\\)"
" *[[<]\\([^]>]+\\)[]>]"))
(orderedp (org-entry-get nil "ORDERED"))
- (bounds
+ (_bounds
;; In a region, start at first item in region.
(cond
((org-region-active-p)
@@ -2371,7 +2390,7 @@ in subtree, ignoring drawers."
(bottom (copy-marker (org-list-get-bottom-point struct)))
(items-to-toggle (org-remove-if
(lambda (e) (or (< e lim-up) (> e lim-down)))
- (mapcar 'car struct))))
+ (mapcar #'car struct))))
(mapc (lambda (e) (org-list-set-checkbox
e struct
;; If there is no box at item, leave as-is
@@ -2429,7 +2448,7 @@ With optional prefix argument ALL, do this for the whole buffer."
(let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
(box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
(recursivep
- (or (not org-hierarchical-checkbox-statistics)
+ (or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
(bounds (if all
@@ -2453,7 +2472,7 @@ With optional prefix argument ALL, do this for the whole buffer."
(items
(cond
((and recursivep item) (org-list-get-subtree item s))
- (recursivep (mapcar 'car s))
+ (recursivep (mapcar #'car s))
(item (org-list-get-children item s par))
(t (org-list-get-all-items
(org-list-get-top-point s) s pre))))
@@ -2466,7 +2485,7 @@ With optional prefix argument ALL, do this for the whole buffer."
structs)
(cons c-on c-all)))))
(backup-end 1)
- cookies-list structs-bak box-num)
+ cookies-list structs-bak)
(goto-char (car bounds))
;; 1. Build an alist for each cookie found within BOUNDS. The
;; key will be position at beginning of cookie and values
@@ -2536,8 +2555,8 @@ With optional prefix argument ALL, do this for the whole buffer."
(checked (car (nth 3 cookie)))
(total (cdr (nth 3 cookie)))
(new (if percentp
- (format "[%d%%]" (/ (* 100 checked)
- (max 1 total)))
+ (format "[%d%%]" (floor (* 100.0 checked)
+ (max 1 total)))
(format "[%d/%d]" checked total))))
(goto-char beg)
(insert new)
@@ -2729,6 +2748,7 @@ If a region is active, all items inside will be moved."
(t (error "Not at an item")))))
(defvar org-tab-ind-state)
+(defvar org-adapt-indentation)
(defun org-cycle-item-indentation ()
"Cycle levels of indentation of an empty item.
The first run indents the item, if applicable. Subsequent runs
@@ -2771,7 +2791,7 @@ Return t at each successful move."
(cond
((ignore-errors (org-list-indent-item-generic 1 t struct)))
((ignore-errors (org-list-indent-item-generic -1 t struct)))
- (t (error "Cannot move item"))))
+ (t (user-error "Cannot move item"))))
t))))
(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
@@ -2787,13 +2807,14 @@ optional argument WITH-CASE, the sorting considers case as well.
The command prompts for the sorting type unless it has been given
to the function through the SORTING-TYPE argument, which needs to
-be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
-meaning of each character:
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the
+detailed meaning of each character:
n Numerically, by converting the beginning of the item to a number.
a Alphabetically. Only the first line of item is checked.
t By date/time, either the first active time stamp in the entry, if
any, or by the first inactive one. In a timer list, sort the timers.
+x By \"checked\" status of a check list.
Capital letters will reverse the sort order.
@@ -2801,7 +2822,10 @@ If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
a function to be called with point at the beginning of the
record. It must return either a string or a number that should
serve as the sorting key for that record. It will then use
-COMPARE-FUNC to compare entries."
+COMPARE-FUNC to compare entries.
+
+Sorting is done against the visible part of the headlines, it
+ignores hidden links."
(interactive "P")
(let* ((case-func (if with-case 'identity 'downcase))
(struct (org-list-struct))
@@ -2809,13 +2833,16 @@ COMPARE-FUNC to compare entries."
(start (org-list-get-list-begin (point-at-bol) struct prevs))
(end (org-list-get-list-end (point-at-bol) struct prevs))
(sorting-type
- (progn
- (message
- "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
- (read-char-exclusive)))
- (getkey-func (and (= (downcase sorting-type) ?f)
- (intern (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil)))))
+ (or sorting-type
+ (progn
+ (message
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
+ (read-char-exclusive))))
+ (getkey-func
+ (or getkey-func
+ (and (= (downcase sorting-type) ?f)
+ (intern (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil))))))
(message "Sorting items...")
(save-restriction
(narrow-to-region start end)
@@ -2826,10 +2853,11 @@ COMPARE-FUNC to compare entries."
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((= dcst ?t) '<)))
+ ((= dcst ?t) '<)
+ ((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
- (beginning-of-line)))
+ (or (eobp) (beginning-of-line))))
(end-record (lambda ()
(goto-char (org-list-get-item-end-before-blank
(point) struct))))
@@ -2838,21 +2866,28 @@ COMPARE-FUNC to compare entries."
(when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
(cond
((= dcst ?n)
- (string-to-number (buffer-substring (match-end 0)
- (point-at-eol))))
+ (string-to-number
+ (org-sort-remove-invisible
+ (buffer-substring (match-end 0) (point-at-eol)))))
((= dcst ?a)
(funcall case-func
- (buffer-substring (match-end 0) (point-at-eol))))
+ (org-sort-remove-invisible
+ (buffer-substring
+ (match-end 0) (point-at-eol)))))
((= dcst ?t)
(cond
;; If it is a timer list, convert timer to seconds
((org-at-item-timer-p)
(org-timer-hms-to-secs (match-string 1)))
- ((or (re-search-forward org-ts-regexp (point-at-eol) t)
- (re-search-forward org-ts-regexp-both
- (point-at-eol) t))
+ ((or (save-excursion
+ (re-search-forward org-ts-regexp (point-at-eol) t))
+ (save-excursion (re-search-forward org-ts-regexp-both
+ (point-at-eol) t)))
(org-time-string-to-seconds (match-string 0)))
(t (org-float-time now))))
+ ((= dcst ?x) (or (and (stringp (match-string 1))
+ (match-string 1))
+ ""))
((= dcst ?f)
(if getkey-func
(let ((value (funcall getkey-func)))
@@ -2896,22 +2931,22 @@ For example, the following list:
will be parsed as:
-\(ordered
- \(nil \"first item\"
- \(unordered
- \(nil \"sub-item one\"\)
- \(nil \"[CBON] sub-item two\"\)\)
- \"more text in first item\"\)
- \(3 \"last item\"\)\)
+ (ordered
+ (nil \"first item\"
+ (unordered
+ (nil \"sub-item one\")
+ (nil \"[CBON] sub-item two\"))
+ \"more text in first item\")
+ (3 \"last item\"))
Point is left at list end."
+ (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'.
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct))
(top (org-list-get-top-point struct))
(bottom (org-list-get-bottom-point struct))
out
- parse-item ; for byte-compiler
(get-text
(function
;; Return text between BEG and END, trimmed, with
@@ -3021,9 +3056,8 @@ for this list."
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
(re-search-backward "#\\+ORGLST" nil t)
- (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
- (if maybe
- (throw 'exit nil)
+ (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
+ (if maybe (throw 'exit nil)
(error "Don't know how to transform this list"))))
(let* ((name (match-string 1))
(transform (intern (match-string 2)))
@@ -3037,20 +3071,19 @@ for this list."
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
- (list (save-restriction
- (narrow-to-region top-point bottom-point)
- (org-list-parse-list)))
- beg txt)
+ (plain-list (buffer-substring-no-properties top-point bottom-point))
+ beg)
(unless (fboundp transform)
(error "No such transformation function %s" transform))
- (let ((txt (funcall transform list)))
+ (let ((txt (funcall transform plain-list)))
;; Find the insertion place
(save-excursion
(goto-char (point-min))
(unless (re-search-forward
(concat "BEGIN RECEIVE ORGLST +"
name
- "\\([ \t]\\|$\\)") nil t)
+ "\\([ \t]\\|$\\)")
+ nil t)
(error "Don't know where to insert translated list"))
(goto-char (match-beginning 0))
(beginning-of-line 2)
@@ -3198,80 +3231,40 @@ items."
items (or (eval isep) ""))))))))
(concat (funcall export-sublist list 0) "\n")))
-(defun org-list-to-latex (list &optional params)
+(defun org-list-to-latex (list &optional _params)
"Convert LIST into a LaTeX list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}"
- :ustart "\\begin{itemize}\n" :uend "\\end{itemize}"
- :dstart "\\begin{description}\n" :dend "\\end{description}"
- :dtstart "[" :dtend "] "
- :istart "\\item " :iend "\n"
- :icount (let ((enum (nth depth '("i" "ii" "iii" "iv"))))
- (if enum
- ;; LaTeX increments counter just before
- ;; using it, so set it to the desired
- ;; value, minus one.
- (format "\\setcounter{enum%s}{%s}\n\\item "
- enum (1- counter))
- "\\item "))
- :csep "\n"
- :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}"
- :cbtrans "\\texttt{[-]}")
- params)))
-
-(defun org-list-to-html (list &optional params)
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-latex)
+ (org-export-string-as list 'latex t))
+
+(defun org-list-to-html (list)
"Convert LIST into a HTML list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "<ol>\n" :oend "\n</ol>"
- :ustart "<ul>\n" :uend "\n</ul>"
- :dstart "<dl>\n" :dend "\n</dl>"
- :dtstart "<dt>" :dtend "</dt>\n"
- :ddstart "<dd>" :ddend "</dd>"
- :istart "<li>" :iend "</li>"
- :icount (format "<li value=\"%s\">" counter)
- :isep "\n" :lsep "\n" :csep "\n"
- :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>"
- :cbtrans "<code>[-]</code>")
- params)))
-
-(defun org-list-to-texinfo (list &optional params)
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-html)
+ (org-export-string-as list 'html t))
+
+(defun org-list-to-texinfo (list &optional _params)
"Convert LIST into a Texinfo list.
-LIST is as returned by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize"
- :ustart "@enumerate\n" :uend "@end enumerate"
- :dstart "@table @asis\n" :dend "@end table"
- :dtstart " " :dtend "\n"
- :istart "@item\n" :iend "\n"
- :icount "@item\n"
- :csep "\n"
- :cbon "@code{[X]}" :cboff "@code{[ ]}"
- :cbtrans "@code{[-]}")
- params)))
+LIST is as string representing the list to transform, as Org
+syntax. Return converted list as a string."
+ (require 'ox-texinfo)
+ (org-export-string-as list 'texinfo t))
(defun org-list-to-subtree (list &optional params)
"Convert LIST into an Org subtree.
LIST is as returned by `org-list-parse-list'. PARAMS is a property list
with overruling parameters for `org-list-to-generic'."
+ (defvar get-stars) (defvar org--blankp)
(let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
(level (org-reduced-level (or (org-current-level) 0)))
- (blankp (or (eq rule t)
+ (org--blankp (or (eq rule t)
(and (eq rule 'auto)
(save-excursion
(outline-previous-heading)
(org-previous-line-empty-p)))))
- (get-stars
+ (get-stars ;FIXME: Can't rename without renaming it in org.el as well!
(function
;; Return the string for the heading, depending on depth D
;; of current sub-list.
@@ -3286,12 +3279,12 @@ with overruling parameters for `org-list-to-generic'."
list
(org-combine-plists
'(:splice t
- :dtstart " " :dtend " "
- :istart (funcall get-stars depth)
- :icount (funcall get-stars depth)
- :isep (if blankp "\n\n" "\n")
- :csep (if blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ :dtstart " " :dtend " "
+ :istart (funcall get-stars depth)
+ :icount (funcall get-stars depth)
+ :isep (if org--blankp "\n\n" "\n")
+ :csep (if org--blankp "\n\n" "\n")
+ :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
params))))
(provide 'org-list)
diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el
deleted file mode 100644
index 11711353ff7..00000000000
--- a/lisp/org/org-lparse.el
+++ /dev/null
@@ -1,2303 +0,0 @@
-;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode
-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
-
-;; Author: Jambunathan K <kjambunathan at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `org-lparse' is the entry point for the generic line-oriented
-;; exporter. `org-do-lparse' is the genericized version of the
-;; original `org-export-as-html' routine.
-
-;; `org-lparse-native-backends' is a good starting point for
-;; exploring the generic exporter.
-
-;; Following new interactive commands are provided by this library.
-;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer'
-;; `org-replace-region-by', `org-lparse-region'.
-
-;; Note that the above routines correspond to the following routines
-;; in the html exporter `org-export-as-html',
-;; `org-export-as-html-and-open', `org-export-as-html-to-buffer',
-;; `org-replace-region-by-html' and `org-export-region-as-html'.
-
-;; The new interactive command `org-lparse-convert' can be used to
-;; convert documents between various formats. Use this to command,
-;; for example, to convert odt file to doc or pdf format.
-
-;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'org-exp)
-(require 'org-list)
-(require 'format-spec)
-
-(defun org-lparse-and-open (target-backend native-backend arg
- &optional file-or-buf)
- "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file.
-If there is an active region, export only the region. The prefix
-ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will become bulleted
-lists."
- (let (f (file-or-buf (or file-or-buf
- (org-lparse target-backend native-backend
- arg 'hidden))))
- (when file-or-buf
- (setq f (cond
- ((bufferp file-or-buf) buffer-file-name)
- ((file-exists-p file-or-buf) file-or-buf)
- (t (error "org-lparse-and-open: This shouldn't happen"))))
- (message "Opening file %s" f)
- (org-open-file f 'system)
- (when org-export-kill-product-buffer-when-displayed
- (kill-buffer (current-buffer))))))
-
-(defun org-lparse-batch (target-backend &optional native-backend)
- "Call the function `org-lparse'.
-This function can be used in batch processing as:
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-lparse-batch"
- (setq native-backend (or native-backend target-backend))
- (org-lparse target-backend native-backend
- org-export-headline-levels 'hidden))
-
-(defun org-lparse-to-buffer (backend arg)
- "Call `org-lparse' with output to a temporary buffer.
-No file is created. The prefix ARG is passed through to
-`org-lparse'."
- (let ((tempbuf (format "*Org %s Export*" (upcase backend))))
- (org-lparse backend backend arg nil nil tempbuf)
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window tempbuf))))
-
-(defun org-replace-region-by (backend beg end)
- "Assume the current region has org-mode syntax, and convert it to HTML.
-This can be used in any buffer. For example, you could write an
-itemized list in org-mode syntax in an HTML buffer and then use
-this command to convert it."
- (let (reg backend-string buf pop-up-frames)
- (save-window-excursion
- (if (derived-mode-p 'org-mode)
- (setq backend-string (org-lparse-region backend beg end t 'string))
- (setq reg (buffer-substring beg end)
- buf (get-buffer-create "*Org tmp*"))
- (with-current-buffer buf
- (erase-buffer)
- (insert reg)
- (org-mode)
- (setq backend-string (org-lparse-region backend (point-min)
- (point-max) t 'string)))
- (kill-buffer buf)))
- (delete-region beg end)
- (insert backend-string)))
-
-(defun org-lparse-region (backend beg end &optional body-only buffer)
- "Convert region from BEG to END in org-mode buffer to HTML.
-If prefix arg BODY-ONLY is set, omit file header, footer, and table of
-contents, and only produce the region of converted text, useful for
-cut-and-paste operations.
-If BUFFER is a buffer or a string, use/create that buffer as a target
-of the converted HTML. If BUFFER is the symbol `string', return the
-produced HTML as a string and leave not buffer behind. For example,
-a Lisp program could call this function in the following way:
-
- (setq html (org-lparse-region \"html\" beg end t 'string))
-
-When called interactively, the output buffer is selected, and shown
-in a window. A non-interactive call will only return the buffer."
- (let ((transient-mark-mode t) (zmacs-regions t)
- ext-plist rtn)
- (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
- (goto-char end)
- (set-mark (point)) ;; to activate the region
- (goto-char beg)
- (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (if (and (org-called-interactively-p 'any) (bufferp rtn))
- (switch-to-buffer-other-window rtn)
- rtn)))
-
-(defvar org-lparse-par-open nil)
-
-(defun org-lparse-should-inline-p (filename descp)
- "Return non-nil if link FILENAME should be inlined.
-The decision to inline the FILENAME link is based on the current
-settings. DESCP is the boolean of whether there was a link
-description. See variables `org-export-html-inline-images' and
-`org-export-html-inline-image-extensions'."
- (let ((inline-images (org-lparse-get 'INLINE-IMAGES))
- (inline-image-extensions
- (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
- (and (or (eq t inline-images) (and inline-images (not descp)))
- (org-file-image-p filename inline-image-extensions))))
-
-(defun org-lparse-format-org-link (line opt-plist)
- "Return LINE with markup of Org mode links.
-OPT-PLIST is the export options list."
- (let ((start 0)
- (current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
- (link-validate (plist-get opt-plist :link-validation-function))
- type id-file fnc
- rpl path attr desc descp desc1 desc2 link
- org-lparse-link-description-is-image)
- (while (string-match org-bracket-link-analytic-regexp++ line start)
- (setq org-lparse-link-description-is-image nil)
- (setq start (match-beginning 0))
- (setq path (save-match-data (org-link-unescape
- (match-string 3 line))))
- (setq type (cond
- ((match-end 2) (match-string 2 line))
- ((save-match-data
- (or (file-name-absolute-p path)
- (string-match "^\\.\\.?/" path)))
- "file")
- (t "internal")))
- (setq path (org-extract-attributes path))
- (setq attr (get-text-property 0 'org-attributes path))
- (setq desc1 (if (match-end 5) (match-string 5 line))
- desc2 (if (match-end 2) (concat type ":" path) path)
- descp (and desc1 (not (equal desc1 desc2)))
- desc (or desc1 desc2))
- ;; Make an image out of the description if that is so wanted
- (when (and descp (org-file-image-p
- desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS)))
- (setq org-lparse-link-description-is-image t)
- (save-match-data
- (if (string-match "^file:" desc)
- (setq desc (substring desc (match-end 0)))))
- (save-match-data
- (setq desc (org-add-props
- (org-lparse-format 'INLINE-IMAGE desc)
- '(org-protected t)))))
- (cond
- ((equal type "internal")
- (let
- ((frag-0
- (if (= (string-to-char path) ?#)
- (substring path 1)
- path)))
- (setq rpl
- (org-lparse-format
- 'ORG-LINK opt-plist "" "" (org-solidify-link-text
- (save-match-data
- (org-link-unescape frag-0))
- nil) desc attr descp))))
- ((and (equal type "id")
- (setq id-file (org-id-find-id-file path)))
- ;; This is an id: link to another file (if it was the same file,
- ;; it would have become an internal link...)
- (save-match-data
- (setq id-file (file-relative-name
- id-file
- (file-name-directory org-current-export-file)))
- (setq rpl
- (org-lparse-format
- 'ORG-LINK opt-plist type id-file
- (concat (if (org-uuidgen-p path) "ID-") path)
- desc attr descp))))
- ((member type '("http" "https"))
- ;; standard URL, can inline as image
- (setq rpl
- (org-lparse-format
- 'ORG-LINK opt-plist type path nil desc attr descp)))
- ((member type '("ftp" "mailto" "news"))
- ;; standard URL, can't inline as image
- (setq rpl
- (org-lparse-format
- 'ORG-LINK opt-plist type path nil desc attr descp)))
-
- ((string= type "coderef")
- (setq rpl (org-lparse-format
- 'ORG-LINK opt-plist type "" path desc nil descp)))
-
- ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- ;; The link protocol has a function for format the link
- (setq rpl (save-match-data
- (funcall fnc (org-link-unescape path)
- desc1 (and (boundp 'org-lparse-backend)
- (case org-lparse-backend
- (xhtml 'html)
- (t org-lparse-backend)))))))
- ((string= type "file")
- ;; FILE link
- (save-match-data
- (let*
- ((components
- (if
- (string-match "::\\(.*\\)" path)
- (list
- (replace-match "" t nil path)
- (match-string 1 path))
- (list path nil)))
-
- ;;The proper path, without a fragment
- (path-1
- (first components))
-
- ;;The raw fragment
- (fragment-0
- (second components))
-
- ;;Check the fragment. If it can't be used as
- ;;target fragment we'll pass nil instead.
- (fragment-1
- (if
- (and fragment-0
- (not (string-match "^[0-9]*$" fragment-0))
- (not (string-match "^\\*" fragment-0))
- (not (string-match "^/.*/$" fragment-0)))
- (org-solidify-link-text
- (org-link-unescape fragment-0))
- nil))
- (desc-2
- ;;Description minus "file:" and ".org"
- (if (string-match "^file:" desc)
- (let
- ((desc-1 (replace-match "" t t desc)))
- (if (string-match "\\.org$" desc-1)
- (replace-match "" t t desc-1)
- desc-1))
- desc)))
-
- (setq rpl
- (if
- (and
- (functionp link-validate)
- (not (funcall link-validate path-1 current-dir)))
- desc
- (org-lparse-format
- 'ORG-LINK opt-plist "file" path-1 fragment-1
- desc-2 attr descp))))))
-
- (t
- ;; just publish the path, as default
- (setq rpl (concat "<i>&lt;" type ":"
- (save-match-data (org-link-unescape path))
- "&gt;</i>"))))
- (setq line (replace-match rpl t t line)
- start (+ start (length rpl))))
- line))
-
-(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse'
-(defun org-lparse-stash-save-paragraph-state ()
- (assert (zerop org-lparse-par-open-stashed))
- (setq org-lparse-par-open-stashed org-lparse-par-open)
- (setq org-lparse-par-open nil))
-
-(defun org-lparse-stash-pop-paragraph-state ()
- (setq org-lparse-par-open org-lparse-par-open-stashed)
- (setq org-lparse-par-open-stashed 0))
-
-(defmacro with-org-lparse-preserve-paragraph-state (&rest body)
- `(let ((org-lparse-do-open-par org-lparse-par-open))
- (org-lparse-end-paragraph)
- ,@body
- (when org-lparse-do-open-par
- (org-lparse-begin-paragraph))))
-(def-edebug-spec with-org-lparse-preserve-paragraph-state (body))
-
-(defvar org-lparse-native-backends nil
- "List of native backends registered with `org-lparse'.
-A backend can use `org-lparse-register-backend' to add itself to
-this list.
-
-All native backends must implement a get routine and a mandatory
-set of callback routines.
-
-The get routine must be named as org-<backend>-get where backend
-is the name of the backend. The exporter uses `org-lparse-get'
-and retrieves the backend-specific callback by querying for
-ENTITY-CONTROL and ENTITY-FORMAT variables.
-
-For the sake of illustration, the html backend implements
-`org-xhtml-get'. It returns
-`org-xhtml-entity-control-callbacks-alist' and
-`org-xhtml-entity-format-callbacks-alist' as the values of
-ENTITY-CONTROL and ENTITY-FORMAT settings.")
-
-(defun org-lparse-register-backend (backend)
- "Make BACKEND known to `org-lparse' library.
-Add BACKEND to `org-lparse-native-backends'."
- (when backend
- (setq backend (cond
- ((symbolp backend) (symbol-name backend))
- ((stringp backend) backend)
- (t (error "Error while registering backend: %S" backend))))
- (add-to-list 'org-lparse-native-backends backend)))
-
-(defun org-lparse-unregister-backend (backend)
- (setq org-lparse-native-backends
- (remove (cond
- ((symbolp backend) (symbol-name backend))
- ((stringp backend) backend))
- org-lparse-native-backends))
- (message "Unregistered backend %S" backend))
-
-(defun org-lparse-do-reachable-formats (in-fmt)
- "Return verbose info about formats to which IN-FMT can be converted.
-Return a list where each element is of the
-form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
-`org-export-odt-convert-processes' for CONVERTER-PROCESS and see
-`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
- (let (reachable-formats)
- (dolist (backend org-lparse-native-backends reachable-formats)
- (let* ((converter (org-lparse-backend-get
- backend 'CONVERT-METHOD))
- (capabilities (org-lparse-backend-get
- backend 'CONVERT-CAPABILITIES)))
- (when converter
- (dolist (c capabilities)
- (when (member in-fmt (nth 1 c))
- (push (cons converter (nth 2 c)) reachable-formats))))))))
-
-(defun org-lparse-reachable-formats (in-fmt)
- "Return list of formats to which IN-FMT can be converted.
-The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
- (let (l)
- (mapc (lambda (e) (add-to-list 'l e))
- (apply 'append (mapcar
- (lambda (e) (mapcar 'car (cdr e)))
- (org-lparse-do-reachable-formats in-fmt))))
- l))
-
-(defun org-lparse-reachable-p (in-fmt out-fmt)
- "Return non-nil if IN-FMT can be converted to OUT-FMT."
- (catch 'done
- (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt)))
- (dolist (e reachable-formats)
- (let ((out-fmt-spec (assoc out-fmt (cdr e))))
- (when out-fmt-spec
- (throw 'done (cons (car e) out-fmt-spec))))))))
-
-(defun org-lparse-backend-is-native-p (backend)
- (member backend org-lparse-native-backends))
-
-(defun org-lparse (target-backend native-backend arg
- &optional hidden ext-plist
- to-buffer body-only pub-dir)
- "Export the outline to various formats.
-If there is an active region, export only the region. The
-outline is first exported to NATIVE-BACKEND and optionally
-converted to TARGET-BACKEND. See `org-lparse-native-backends'
-for list of known native backends. Each native backend can
-specify a converter and list of target backends it exports to
-using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get
-method. See `org-xhtml-get' for an illustrative example.
-
-ARG is a prefix argument that specifies how many levels of
-outline should become headlines. The default is 3. Lower levels
-will become bulleted lists.
-
-HIDDEN is obsolete and does nothing.
-
-EXT-PLIST is a property list that controls various aspects of
-export. The settings here override org-mode's default settings
-and but are inferior to file-local settings.
-
-TO-BUFFER dumps the exported lines to a buffer or a string
-instead of a file. If TO-BUFFER is the symbol `string' return the
-exported lines as a string. If TO-BUFFER is non-nil, create a
-buffer with that name and export to that buffer.
-
-BODY-ONLY controls the presence of header and footer lines in
-exported text. If BODY-ONLY is non-nil, don't produce the file
-header and footer, simply return the content of <body>...</body>,
-without even the body tags themselves.
-
-PUB-DIR specifies the publishing directory."
- (let* ((org-lparse-backend (intern native-backend))
- (org-lparse-other-backend (and target-backend
- (intern target-backend))))
- (add-hook 'org-export-preprocess-hook
- 'org-lparse-strip-experimental-blocks-maybe)
- (add-hook 'org-export-preprocess-after-blockquote-hook
- 'org-lparse-preprocess-after-blockquote)
- (unless (org-lparse-backend-is-native-p native-backend)
- (error "Don't know how to export natively to backend %s" native-backend))
-
- (unless (or (equal native-backend target-backend)
- (org-lparse-reachable-p native-backend target-backend))
- (error "Don't know how to export to backend %s %s" target-backend
- (format "via %s" native-backend)))
- (run-hooks 'org-export-first-hook)
- (prog1
- (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir)
- (remove-hook 'org-export-preprocess-hook
- 'org-lparse-strip-experimental-blocks-maybe)
- (remove-hook 'org-export-preprocess-after-blockquote-hook
- 'org-lparse-preprocess-after-blockquote))))
-
-(defcustom org-lparse-use-flashy-warning nil
- "Control flashing of messages logged with `org-lparse-warn'.
-When non-nil, messages are fontified with warning face and the
-exporter lingers for a while to catch user's attention."
- :type 'boolean
- :group 'org-lparse)
-
-(defun org-lparse-convert-read-params ()
- "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'.
-This is a helper routine for interactive use."
- (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
- (in-file (read-file-name "File to be converted: "
- nil buffer-file-name t))
- (in-fmt (file-name-extension in-file))
- (out-fmt-choices (org-lparse-reachable-formats in-fmt))
- (out-fmt
- (or (and out-fmt-choices
- (funcall input "Output format: "
- out-fmt-choices nil nil nil))
- (error
- "No known converter or no known output formats for %s files"
- in-fmt))))
- (list in-file out-fmt)))
-
-(eval-when-compile
- (require 'browse-url))
-
-(declare-function browse-url-file-url "browse-url" (file))
-
-(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg)
- "Workhorse routine for `org-export-odt-convert'."
- (require 'browse-url)
- (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
- (dummy (or (file-readable-p in-file)
- (error "Cannot read %s" in-file)))
- (in-fmt (file-name-extension in-file))
- (out-fmt (or out-fmt (error "Output format unspecified")))
- (how (or (org-lparse-reachable-p in-fmt out-fmt)
- (error "Cannot convert from %s format to %s format?"
- in-fmt out-fmt)))
- (convert-process (car how))
- (out-file (concat (file-name-sans-extension in-file) "."
- (nth 1 (or (cdr how) out-fmt))))
- (extra-options (or (nth 2 (cdr how)) ""))
- (out-dir (file-name-directory in-file))
- (cmd (format-spec convert-process
- `((?i . ,(shell-quote-argument in-file))
- (?I . ,(browse-url-file-url in-file))
- (?f . ,out-fmt)
- (?o . ,out-file)
- (?O . ,(browse-url-file-url out-file))
- (?d . , (shell-quote-argument out-dir))
- (?D . ,(browse-url-file-url out-dir))
- (?x . ,extra-options)))))
- (when (file-exists-p out-file)
- (delete-file out-file))
-
- (message "Executing %s" cmd)
- (let ((cmd-output (shell-command-to-string cmd)))
- (message "%s" cmd-output))
-
- (cond
- ((file-exists-p out-file)
- (message "Exported to %s" out-file)
- (when prefix-arg
- (message "Opening %s..." out-file)
- (org-open-file out-file 'system))
- out-file)
- (t
- (message "Export to %s failed" out-file)
- nil))))
-
-(defvar org-lparse-insert-tag-with-newlines 'both)
-
-;; Following variables are let-bound during `org-lparse'
-(defvar org-lparse-dyn-first-heading-pos)
-(defvar org-lparse-toc)
-(defvar org-lparse-entity-control-callbacks-alist)
-(defvar org-lparse-entity-format-callbacks-alist)
-(defvar org-lparse-backend nil
- "The native backend to which the document is currently exported.
-This variable is let bound during `org-lparse'. Valid values are
-one of the symbols corresponding to `org-lparse-native-backends'.
-
-Compare this variable with `org-export-current-backend' which is
-bound only during `org-export-preprocess-string' stage of the
-export process.
-
-See also `org-lparse-other-backend'.")
-
-(defvar org-lparse-other-backend nil
- "The target backend to which the document is currently exported.
-This variable is let bound during `org-lparse'. This variable is
-set to either `org-lparse-backend' or one of the symbols
-corresponding to OTHER-BACKENDS specification of the
-org-lparse-backend.
-
-For example, if a document is exported to \"odt\" then both
-org-lparse-backend and org-lparse-other-backend are bound to
-'odt. On the other hand, if a document is exported to \"odt\"
-and then converted to \"doc\" then org-lparse-backend is set to
-'odt and org-lparse-other-backend is set to 'doc.")
-
-(defvar org-lparse-body-only nil
- "Bind this to BODY-ONLY arg of `org-lparse'.")
-
-(defvar org-lparse-to-buffer nil
- "Bind this to TO-BUFFER arg of `org-lparse'.")
-
-(defun org-lparse-get-block-params (params)
- (save-match-data
- (when params
- (setq params (org-trim params))
- (unless (string-match "\\`(.*)\\'" params)
- (setq params (format "(%s)" params)))
- (ignore-errors (read params)))))
-
-(defvar org-heading-keyword-regexp-format) ; defined in org.el
-(defvar org-lparse-special-blocks '("list-table" "annotation"))
-(defun org-do-lparse (arg &optional hidden ext-plist
- to-buffer body-only pub-dir)
- "Export the outline to various formats.
-See `org-lparse' for more information. This function is a
-html-agnostic version of the `org-export-as-html' function in 7.5
-version."
- ;; Make sure we have a file name when we need it.
- (when (and (not (or to-buffer body-only))
- (not buffer-file-name))
- (if (buffer-base-buffer)
- (org-set-local 'buffer-file-name
- (with-current-buffer (buffer-base-buffer)
- buffer-file-name))
- (error "Need a file name to be able to export")))
-
- (org-lparse-warn
- (format "Exporting to %s using org-lparse..."
- (upcase (symbol-name
- (or org-lparse-backend org-lparse-other-backend)))))
-
- (setq-default org-todo-line-regexp org-todo-line-regexp)
- (setq-default org-deadline-line-regexp org-deadline-line-regexp)
- (setq-default org-done-keywords org-done-keywords)
- (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
- (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that
- ; we are interested in
- ; collecting styles
- org-lparse-encode-pending
- org-lparse-par-open
- (org-lparse-par-open-stashed 0)
-
- ;; list related vars
- (org-lparse-list-stack '())
-
- ;; list-table related vars
- org-lparse-list-table-p
- org-lparse-list-table:table-cell-open
- org-lparse-list-table:table-row
- org-lparse-list-table:lines
-
- org-lparse-outline-text-open
- (org-lparse-latex-fragment-fallback ; currently used only by
- ; odt exporter
- (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK))
- (if (and (org-check-external-command "latex" "" t)
- (org-check-external-command "dvipng" "" t))
- 'dvipng
- 'verbatim)))
- (org-lparse-insert-tag-with-newlines 'both)
- (org-lparse-to-buffer to-buffer)
- (org-lparse-body-only body-only)
- (org-lparse-entity-control-callbacks-alist
- (org-lparse-get 'ENTITY-CONTROL))
- (org-lparse-entity-format-callbacks-alist
- (org-lparse-get 'ENTITY-FORMAT))
- (opt-plist
- (org-export-process-option-filters
- (org-combine-plists (org-default-export-plist)
- ext-plist
- (org-infile-export-plist))))
- (body-only (or body-only (plist-get opt-plist :body-only)))
- valid org-lparse-dyn-first-heading-pos
- (odd org-odd-levels-only)
- (region-p (org-region-active-p))
- (rbeg (and region-p (region-beginning)))
- (rend (and region-p (region-end)))
- (subtree-p
- (if (plist-get opt-plist :ignore-subtree-p)
- nil
- (when region-p
- (save-excursion
- (goto-char rbeg)
- (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend))))))
- (level-offset (if subtree-p
- (save-excursion
- (goto-char rbeg)
- (+ (funcall outline-level)
- (if org-odd-levels-only 1 0)))
- 0))
- (opt-plist (setq org-export-opt-plist
- (if subtree-p
- (org-export-add-subtree-options opt-plist rbeg)
- opt-plist)))
- ;; The following two are dynamically scoped into other
- ;; routines below.
- (org-current-export-dir
- (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))
- (org-current-export-file buffer-file-name)
- (level 0) (line "") (origline "") txt todo
- (umax nil)
- (umax-toc nil)
- (filename (if to-buffer nil
- (expand-file-name
- (concat
- (file-name-sans-extension
- (or (and subtree-p
- (org-entry-get (region-beginning)
- "EXPORT_FILE_NAME" t))
- (file-name-nondirectory buffer-file-name)))
- "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist))
- (file-name-as-directory
- (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))))))
- (current-dir (if buffer-file-name
- (file-name-directory buffer-file-name)
- default-directory))
- (auto-insert nil) ; Avoid any auto-insert stuff for the new file
- (buffer (if to-buffer
- (cond
- ((eq to-buffer 'string)
- (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME)))
- (t (get-buffer-create to-buffer)))
- (find-file-noselect
- (or (let ((f (org-lparse-get 'INIT-METHOD)))
- (and f (functionp f) (funcall f filename)))
- filename))))
- (org-levels-open (make-vector org-level-max nil))
- (dummy (mapc
- (lambda(p)
- (let* ((val (plist-get opt-plist p))
- (val (org-xml-encode-org-text-skip-links val)))
- (setq opt-plist (plist-put opt-plist p val))))
- '(:date :author :keywords :description)))
- (date (plist-get opt-plist :date))
- (date (cond
- ((and date (string-match "%" date))
- (format-time-string date))
- (date date)
- (t (format-time-string "%Y-%m-%d %T %Z"))))
- (dummy (setq opt-plist (plist-put opt-plist :effective-date date)))
- (title (org-xml-encode-org-text-skip-links
- (or (and subtree-p (org-export-get-title-from-subtree))
- (plist-get opt-plist :title)
- (and (not body-only)
- (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (and buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name)))
- "UNTITLED")))
- (dummy (setq opt-plist (plist-put opt-plist :title title)))
- (html-table-tag (plist-get opt-plist :html-table-tag))
- (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)"))
- (quote-re (format org-heading-keyword-regexp-format
- org-quote-string))
- (org-lparse-dyn-current-environment nil)
- ;; Get the language-dependent settings
- (lang-words (or (assoc (plist-get opt-plist :language)
- org-export-language-setup)
- (assoc "en" org-export-language-setup)))
- (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words)))
- (head-count 0) cnt
- (start 0)
- (coding-system-for-write
- (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE))
- (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)))
- (save-buffer-coding-system
- (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE))
- (and (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)))
- (region
- (buffer-substring
- (if region-p (region-beginning) (point-min))
- (if region-p (region-end) (point-max))))
- (org-export-have-math nil)
- (org-export-footnotes-seen nil)
- (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
- (org-footnote-insert-pos-for-preprocessor 'point-min)
- (org-lparse-opt-plist opt-plist)
- (lines
- (org-split-string
- (org-export-preprocess-string
- region
- :emph-multiline t
- :for-backend (if (equal org-lparse-backend 'xhtml) ; hack
- 'html
- org-lparse-backend)
- :skip-before-1st-heading
- (plist-get opt-plist :skip-before-1st-heading)
- :drawers (plist-get opt-plist :drawers)
- :todo-keywords (plist-get opt-plist :todo-keywords)
- :tasks (plist-get opt-plist :tasks)
- :tags (plist-get opt-plist :tags)
- :priority (plist-get opt-plist :priority)
- :footnotes (plist-get opt-plist :footnotes)
- :timestamps (plist-get opt-plist :timestamps)
- :archived-trees
- (plist-get opt-plist :archived-trees)
- :select-tags (plist-get opt-plist :select-tags)
- :exclude-tags (plist-get opt-plist :exclude-tags)
- :add-text
- (plist-get opt-plist :text)
- :LaTeX-fragments
- (plist-get opt-plist :LaTeX-fragments))
- "[\r\n]"))
- table-open
- table-buffer table-orig-buffer
- ind
- rpl path attr desc descp desc1 desc2 link
- snumber fnc
- footnotes footref-seen
- org-lparse-output-buffer
- org-lparse-footnote-definitions
- org-lparse-footnote-number
- ;; collection
- org-lparse-collect-buffer
- (org-lparse-collect-count 0) ; things will get haywire if
- ; collections are chained. Use
- ; this variable to assert this
- ; pre-requisite
- org-lparse-toc
- href
- )
-
- (let ((inhibit-read-only t))
- (org-unmodified
- (remove-text-properties (point-min) (point-max)
- '(:org-license-to-kill t))))
-
- (message "Exporting...")
- (org-init-section-numbers)
-
- ;; Switch to the output buffer
- (setq org-lparse-output-buffer buffer)
- (set-buffer org-lparse-output-buffer)
- (let ((inhibit-read-only t)) (erase-buffer))
- (fundamental-mode)
- (org-install-letbind)
-
- (and (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system coding-system-for-write))
-
- (let ((case-fold-search nil)
- (org-odd-levels-only odd))
- ;; create local variables for all options, to make sure all called
- ;; functions get the correct information
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars)
- (setq umax (if arg (prefix-numeric-value arg)
- org-export-headline-levels))
- (setq umax-toc (if (integerp org-export-with-toc)
- (min org-export-with-toc umax)
- umax))
- (setq org-lparse-opt-plist
- (plist-put org-lparse-opt-plist :headline-levels umax))
-
- (when (and org-export-with-toc (not body-only))
- (setq lines (org-lparse-prepare-toc
- lines level-offset opt-plist umax-toc)))
-
- (unless body-only
- (org-lparse-begin 'DOCUMENT-CONTENT opt-plist)
- (org-lparse-begin 'DOCUMENT-BODY opt-plist))
-
- (setq head-count 0)
- (org-init-section-numbers)
-
- (org-lparse-begin-paragraph)
-
- (while (setq line (pop lines) origline line)
- (catch 'nextline
- (when (and (org-lparse-current-environment-p 'quote)
- (string-match org-outline-regexp-bol line))
- (org-lparse-end-environment 'quote))
-
- (when (org-lparse-current-environment-p 'quote)
- (org-lparse-insert 'LINE line)
- (throw 'nextline nil))
-
- ;; Fixed-width, verbatim lines (examples)
- (when (and org-export-with-fixed-width
- (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
- (when (not (org-lparse-current-environment-p 'fixedwidth))
- (org-lparse-begin-environment 'fixedwidth))
- (org-lparse-insert 'LINE (match-string 3 line))
- (when (or (not lines)
- (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
- (car lines))))
- (org-lparse-end-environment 'fixedwidth))
- (throw 'nextline nil))
-
- ;; Native Text
- (when (and (get-text-property 0 'org-native-text line)
- ;; Make sure it is the entire line that is protected
- (not (< (or (next-single-property-change
- 0 'org-native-text line) 10000)
- (length line))))
- (let ((ind (get-text-property 0 'original-indentation line)))
- (org-lparse-begin-environment 'native)
- (org-lparse-insert 'LINE line)
- (while (and lines
- (or (= (length (car lines)) 0)
- (not ind)
- (equal ind (get-text-property
- 0 'original-indentation (car lines))))
- (or (= (length (car lines)) 0)
- (get-text-property 0 'org-native-text (car lines))))
- (org-lparse-insert 'LINE (pop lines)))
- (org-lparse-end-environment 'native))
- (throw 'nextline nil))
-
- ;; Protected HTML
- (when (and (get-text-property 0 'org-protected line)
- ;; Make sure it is the entire line that is protected
- (not (< (or (next-single-property-change
- 0 'org-protected line) 10000)
- (length line))))
- (let ((ind (get-text-property 0 'original-indentation line)))
- (org-lparse-insert 'LINE line)
- (while (and lines
- (or (= (length (car lines)) 0)
- (not ind)
- (equal ind (get-text-property
- 0 'original-indentation (car lines))))
- (or (= (length (car lines)) 0)
- (get-text-property 0 'org-protected (car lines))))
- (org-lparse-insert 'LINE (pop lines))))
- (throw 'nextline nil))
-
- ;; Blockquotes, verse, and center
- (when (string-match
- "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line)
- (let* ((style (intern (downcase (match-string 1 line))))
- (env-options-plist (org-lparse-get-block-params
- (match-string 3 line)))
- (f (cdr (assoc (match-string 2 line)
- '(("START" . org-lparse-begin-environment)
- ("END" . org-lparse-end-environment))))))
- (when (memq style
- (append
- '(blockquote verse center)
- (mapcar 'intern org-lparse-special-blocks)))
- (funcall f style env-options-plist)
- (throw 'nextline nil))))
-
- (when (org-lparse-current-environment-p 'verse)
- (let ((i (org-get-string-indentation line)))
- (if (> i 0)
- (setq line (concat
- (let ((org-lparse-encode-pending t))
- (org-lparse-format 'SPACES (* 2 i)))
- " " (org-trim line))))
- (unless (string-match "\\\\\\\\[ \t]*$" line)
- (setq line (concat line "\\\\")))))
-
- ;; make targets to anchors
- (setq start 0)
- (while (string-match
- "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
- (cond
- ((get-text-property (match-beginning 1) 'org-protected line)
- (setq start (match-end 1)))
- ((match-end 2)
- (setq line (replace-match
- (let ((org-lparse-encode-pending t))
- (org-lparse-format
- 'ANCHOR "" (org-solidify-link-text
- (match-string 1 line))))
- t t line)))
- ((and org-export-with-toc (equal (string-to-char line) ?*))
- ;; FIXME: NOT DEPENDENT on TOC?????????????????????
- (setq line (replace-match
- (let ((org-lparse-encode-pending t))
- (org-lparse-format
- 'FONTIFY (match-string 1 line) "target"))
- ;; (concat "@<i>" (match-string 1 line) "@</i> ")
- t t line)))
- (t
- (setq line (replace-match
- (concat
- (let ((org-lparse-encode-pending t))
- (org-lparse-format
- 'ANCHOR (match-string 1 line)
- (org-solidify-link-text (match-string 1 line))
- "target")) " ")
- t t line)))))
-
- (let ((org-lparse-encode-pending t))
- (setq line (org-lparse-handle-time-stamps line)))
-
- ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
- ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
- ;; Also handle sub_superscripts and checkboxes
- (or (string-match org-table-hline-regexp line)
- (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
- (setq line (org-xml-encode-org-text-skip-links line)))
-
- (setq line (org-lparse-format-org-link line opt-plist))
-
- ;; TODO items
- (if (and org-todo-line-regexp
- (string-match org-todo-line-regexp line)
- (match-beginning 2))
- (setq line (concat
- (substring line 0 (match-beginning 2))
- (org-lparse-format 'TODO (match-string 2 line))
- (substring line (match-end 2)))))
-
- ;; Does this contain a reference to a footnote?
- (when org-export-with-footnotes
- (setq start 0)
- (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start)
- ;; Discard protected matches not clearly identified as
- ;; footnote markers.
- (if (or (get-text-property (match-beginning 2) 'org-protected line)
- (not (get-text-property (match-beginning 2) 'org-footnote line)))
- (setq start (match-end 2))
- (let ((n (match-string 2 line)) refcnt a)
- (if (setq a (assoc n footref-seen))
- (progn
- (setcdr a (1+ (cdr a)))
- (setq refcnt (cdr a)))
- (setq refcnt 1)
- (push (cons n 1) footref-seen))
- (setq line
- (replace-match
- (concat
- (or (match-string 1 line) "")
- (org-lparse-format
- 'FOOTNOTE-REFERENCE
- n (cdr (assoc n org-lparse-footnote-definitions))
- refcnt)
- ;; If another footnote is following the
- ;; current one, add a separator.
- (if (save-match-data
- (string-match "\\`\\[[0-9]+\\]"
- (substring line (match-end 0))))
- (ignore-errors
- (org-lparse-get 'FOOTNOTE-SEPARATOR))
- ""))
- t t line))))))
-
- (cond
- ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line)
- ;; This is a headline
- (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
- level-offset))
- txt (match-string 2 line))
- (if (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
- (if (<= level (max umax umax-toc))
- (setq head-count (+ head-count 1)))
- (unless org-lparse-dyn-first-heading-pos
- (setq org-lparse-dyn-first-heading-pos (point)))
- (org-lparse-begin-level level txt umax head-count)
-
- ;; QUOTES
- (when (string-match quote-re line)
- (org-lparse-begin-environment 'quote)))
-
- ((and org-export-with-tables
- (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
- (when (not table-open)
- ;; New table starts
- (setq table-open t table-buffer nil table-orig-buffer nil))
-
- ;; Accumulate lines
- (setq table-buffer (cons line table-buffer)
- table-orig-buffer (cons origline table-orig-buffer))
- (when (or (not lines)
- (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
- (car lines))))
- (setq table-open nil
- table-buffer (nreverse table-buffer)
- table-orig-buffer (nreverse table-orig-buffer))
- (org-lparse-end-paragraph)
- (when org-lparse-list-table-p
- (error "Regular tables are not allowed in a list-table block"))
- (org-lparse-insert 'TABLE table-buffer table-orig-buffer)))
-
- ;; Normal lines
- (t
- ;; This line either is list item or end a list.
- (when (get-text-property 0 'list-item line)
- (setq line (org-lparse-export-list-line
- line
- (get-text-property 0 'list-item line)
- (get-text-property 0 'list-struct line)
- (get-text-property 0 'list-prevs line))))
-
- ;; Horizontal line
- (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
- (with-org-lparse-preserve-paragraph-state
- (org-lparse-insert 'HORIZONTAL-LINE))
- (throw 'nextline nil))
-
- ;; Empty lines start a new paragraph. If hand-formatted lists
- ;; are not fully interpreted, lines starting with "-", "+", "*"
- ;; also start a new paragraph.
- (when (string-match "^ [-+*]-\\|^[ \t]*$" line)
- (when org-lparse-footnote-number
- (org-lparse-end-footnote-definition org-lparse-footnote-number)
- (setq org-lparse-footnote-number nil))
- (org-lparse-begin-paragraph))
-
- ;; Is this the start of a footnote?
- (when org-export-with-footnotes
- (when (and (boundp 'footnote-section-tag-regexp)
- (string-match (concat "^" footnote-section-tag-regexp)
- line))
- ;; ignore this line
- (throw 'nextline nil))
- (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
- (org-lparse-end-paragraph)
- (setq org-lparse-footnote-number (match-string 1 line))
- (setq line (replace-match "" t t line))
- (org-lparse-begin-footnote-definition org-lparse-footnote-number)))
- ;; Check if the line break needs to be conserved
- (cond
- ((string-match "\\\\\\\\[ \t]*$" line)
- (setq line (replace-match
- (org-lparse-format 'LINE-BREAK)
- t t line)))
- (org-export-preserve-breaks
- (setq line (concat line (org-lparse-format 'LINE-BREAK)))))
-
- ;; Check if a paragraph should be started
- (let ((start 0))
- (while (and org-lparse-par-open
- (string-match "\\\\par\\>" line start))
- (error "FIXME")
- ;; Leave a space in the </p> so that the footnote matcher
- ;; does not see this.
- (if (not (get-text-property (match-beginning 0)
- 'org-protected line))
- (setq line (replace-match "</p ><p >" t t line)))
- (setq start (match-end 0))))
-
- (org-lparse-insert 'LINE line)))))
-
- ;; Properly close all local lists and other lists
- (when (org-lparse-current-environment-p 'quote)
- (org-lparse-end-environment 'quote))
-
- (org-lparse-end-level 1 umax)
-
- ;; the </div> to close the last text-... div.
- (when (and (> umax 0) org-lparse-dyn-first-heading-pos)
- (org-lparse-end-outline-text-or-outline))
-
- (org-lparse-end 'DOCUMENT-BODY opt-plist)
- (unless body-only
- (org-lparse-end 'DOCUMENT-CONTENT))
-
- (org-lparse-end 'EXPORT)
-
- ;; kill collection buffer
- (when org-lparse-collect-buffer
- (kill-buffer org-lparse-collect-buffer))
-
- (goto-char (point-min))
- (or (org-export-push-to-kill-ring
- (upcase (symbol-name org-lparse-backend)))
- (message "Exporting... done"))
-
- (cond
- ((not to-buffer)
- (let ((f (org-lparse-get 'SAVE-METHOD)))
- (or (and f (functionp f) (funcall f filename opt-plist))
- (save-buffer)))
- (or (and (boundp 'org-lparse-other-backend)
- org-lparse-other-backend
- (not (equal org-lparse-backend org-lparse-other-backend))
- (org-lparse-do-convert
- buffer-file-name (symbol-name org-lparse-other-backend)))
- (current-buffer)))
- ((eq to-buffer 'string)
- (prog1 (buffer-substring (point-min) (point-max))
- (kill-buffer (current-buffer))))
- (t (current-buffer))))))
-
-(defun org-lparse-format-table (lines olines)
- "Returns backend-specific code for org-type and table-type tables."
- (if (stringp lines)
- (setq lines (org-split-string lines "\n")))
- (if (string-match "^[ \t]*|" (car lines))
- ;; A normal org table
- (org-lparse-format-org-table lines nil)
- ;; Table made by table.el
- (or (org-lparse-format-table-table-using-table-generate-source
- ;; FIXME: Need to take care of this during merge
- (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend)
- olines
- (not org-export-prefer-native-exporter-for-tables))
- ;; We are here only when table.el table has NO col or row
- ;; spanning and the user prefers using org's own converter for
- ;; exporting of such simple table.el tables.
- (org-lparse-format-table-table lines))))
-
-(defun org-lparse-table-get-colalign-info (lines)
- (let ((col-cookies (org-find-text-property-in-string
- 'org-col-cookies (car lines))))
- (when (and col-cookies org-table-clean-did-remove-column)
- (setq col-cookies
- (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies)))
- col-cookies))
-
-(defvar org-lparse-table-style)
-(defvar org-lparse-table-ncols)
-(defvar org-lparse-table-rownum)
-(defvar org-lparse-table-is-styled)
-(defvar org-lparse-table-begin-marker)
-(defvar org-lparse-table-num-numeric-items-per-column)
-(defvar org-lparse-table-colalign-info)
-(defvar org-lparse-table-colalign-vector)
-
-;; Following variables are defined in org-table.el
-(defvar org-table-number-fraction)
-(defvar org-table-number-regexp)
-(defun org-lparse-org-table-to-list-table (lines &optional splice)
- "Convert org-table to list-table.
-LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each
-element is a `string' representing a single row of org-table.
-Thus each ROW has vertical separators \"|\" separating the table
-fields. A ROW could also be a row-group separator of the form
-\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3
-...). ROW could either be symbol `:hrule' or a list of the
-form (FIELD1 FIELD2 FIELD3 ...) as appropriate."
- (let (line lines-1)
- (cond
- (splice
- (while (setq line (pop lines))
- (unless (string-match "^[ \t]*|-" line)
- (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))
- (t
- (while (setq line (pop lines))
- (cond
- ((string-match "^[ \t]*|-" line)
- (when lines
- (push :hrule lines-1)))
- (t
- (push (org-split-string line "[ \t]*|[ \t]*") lines-1))))))
- (nreverse lines-1)))
-
-(defun org-lparse-insert-org-table (lines &optional splice)
- "Format a org-type table into backend-specific code.
-LINES is a list of lines. Optional argument SPLICE means, do not
-insert header and surrounding <table> tags, just format the lines.
-Optional argument NO-CSS means use XHTML attributes instead of CSS
-for formatting. This is required for the DocBook exporter."
- (require 'org-table)
- ;; Get rid of hlines at beginning and end
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
- (setq lines (nreverse lines))
- (when org-export-table-remove-special-lines
- ;; Check if the table has a marking column. If yes remove the
- ;; column and the special lines
- (setq lines (org-table-clean-before-export lines)))
- (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
- (short-caption (or (org-find-text-property-in-string
- 'org-caption-shortn (car lines)) caption))
- (caption (and caption (org-xml-encode-org-text caption)))
- (short-caption (and short-caption
- (org-xml-encode-plain-text short-caption)))
- (label (org-find-text-property-in-string 'org-label (car lines)))
- (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines))
- (attributes (org-find-text-property-in-string 'org-attributes
- (car lines)))
- (head (and org-export-highlight-first-table-line
- (delq nil (mapcar
- (lambda (x) (string-match "^[ \t]*|-" x))
- (cdr lines))))))
- (setq lines (org-lparse-org-table-to-list-table lines splice))
- (org-lparse-insert-list-table
- lines splice caption label attributes head org-lparse-table-colalign-info
- short-caption)))
-
-(defun org-lparse-insert-list-table (lines &optional splice
- caption label attributes head
- org-lparse-table-colalign-info
- short-caption)
- (or (featurep 'org-table) ; required for
- (require 'org-table)) ; `org-table-number-regexp'
- (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0)
- tbopen fields line
- org-lparse-table-cur-rowgrp-is-hdr
- org-lparse-table-rowgrp-open
- org-lparse-table-num-numeric-items-per-column
- org-lparse-table-colalign-vector n
- org-lparse-table-rowgrp-info
- org-lparse-table-begin-marker
- (org-lparse-table-style 'org-table)
- org-lparse-table-is-styled)
- (cond
- (splice
- (setq org-lparse-table-is-styled nil)
- (while (setq line (pop lines))
- (insert (org-lparse-format-table-row line) "\n")))
- (t
- (setq org-lparse-table-is-styled t)
- (org-lparse-begin 'TABLE caption label attributes short-caption)
- (setq org-lparse-table-begin-marker (point))
- (org-lparse-begin-table-rowgroup head)
- (while (setq line (pop lines))
- (cond
- ((equal line :hrule)
- (org-lparse-begin-table-rowgroup))
- (t
- (insert (org-lparse-format-table-row line) "\n"))))
- (org-lparse-end 'TABLE-ROWGROUP)
- (org-lparse-end-table)))))
-
-(defun org-lparse-format-org-table (lines &optional splice)
- (with-temp-buffer
- (org-lparse-insert-org-table lines splice)
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun org-lparse-format-list-table (lines &optional splice)
- (with-temp-buffer
- (org-lparse-insert-list-table lines splice)
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun org-lparse-insert-table-table (lines)
- "Format a table generated by table.el into backend-specific code.
-This conversion does *not* use `table-generate-source' from table.el.
-This has the advantage that Org-mode's HTML conversions can be used.
-But it has the disadvantage, that no cell- or row-spanning is allowed."
- (let (line field-buffer
- (org-lparse-table-cur-rowgrp-is-hdr
- org-export-highlight-first-table-line)
- (caption nil)
- (short-caption nil)
- (attributes nil)
- (label nil)
- (org-lparse-table-style 'table-table)
- (org-lparse-table-is-styled nil)
- fields org-lparse-table-ncols i (org-lparse-table-rownum -1)
- (empty (org-lparse-format 'SPACES 1)))
- (org-lparse-begin 'TABLE caption label attributes short-caption)
- (while (setq line (pop lines))
- (cond
- ((string-match "^[ \t]*\\+-" line)
- (when field-buffer
- (let ((org-export-table-row-tags '("<tr>" . "</tr>"))
- ;; (org-export-html-table-use-header-tags-for-first-column nil)
- )
- (insert (org-lparse-format-table-row field-buffer empty)))
- (setq org-lparse-table-cur-rowgrp-is-hdr nil)
- (setq field-buffer nil)))
- (t
- ;; Break the line into fields and store the fields
- (setq fields (org-split-string line "[ \t]*|[ \t]*"))
- (if field-buffer
- (setq field-buffer (mapcar
- (lambda (x)
- (concat x (org-lparse-format 'LINE-BREAK)
- (pop fields)))
- field-buffer))
- (setq field-buffer fields)))))
- (org-lparse-end-table)))
-
-(defun org-lparse-format-table-table (lines)
- (with-temp-buffer
- (org-lparse-insert-table-table lines)
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defvar table-source-languages) ; defined in table.el
-(defun org-lparse-format-table-table-using-table-generate-source (backend
- lines
- &optional
- spanned-only)
- "Format a table into BACKEND, using `table-generate-source' from table.el.
-Use SPANNED-ONLY to suppress exporting of simple table.el tables.
-
-When SPANNED-ONLY is nil, all table.el tables are exported. When
-SPANNED-ONLY is non-nil, only tables with either row or column
-spans are exported.
-
-This routine returns the generated source or nil as appropriate.
-
-Refer docstring of `org-export-prefer-native-exporter-for-tables'
-for further information."
- (require 'table)
- (with-current-buffer (get-buffer-create " org-tmp1 ")
- (erase-buffer)
- (insert (mapconcat 'identity lines "\n"))
- (goto-char (point-min))
- (if (not (re-search-forward "|[^+]" nil t))
- (error "Error processing table"))
- (table-recognize-table)
- (when (or (not spanned-only)
- (let* ((dim (table-query-dimension))
- (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
- (not (= (* c r) cells))))
- (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
- (cond
- ((member backend table-source-languages)
- (table-generate-source backend " org-tmp2 ")
- (set-buffer " org-tmp2 ")
- (buffer-substring (point-min) (point-max)))
- (t
- ;; table.el doesn't support the given backend. Currently this
- ;; happens in case of odt export. Strip the table from the
- ;; generated document. A better alternative would be to embed
- ;; the table as ascii text in the output document.
- (org-lparse-warn
- (concat
- "Found table.el-type table in the source org file. "
- (format "table.el doesn't support %s backend. "
- (upcase (symbol-name backend)))
- "Skipping ahead ..."))
- "")))))
-
-(defun org-lparse-handle-time-stamps (s)
- "Format time stamps in string S, or remove them."
- (catch 'exit
- (let (r b)
- (when org-maybe-keyword-time-regexp
- (while (string-match org-maybe-keyword-time-regexp s)
- (or b (setq b (substring s 0 (match-beginning 0))))
- (setq r (concat
- r (substring s 0 (match-beginning 0)) " "
- (org-lparse-format
- 'FONTIFY
- (concat
- (if (match-end 1)
- (org-lparse-format
- 'FONTIFY
- (match-string 1 s) "timestamp-kwd"))
- " "
- (org-lparse-format
- 'FONTIFY
- (substring (org-translate-time (match-string 3 s)) 1 -1)
- "timestamp"))
- "timestamp-wrapper"))
- s (substring s (match-end 0)))))
-
- ;; Line break if line started and ended with time stamp stuff
- (if (not r)
- s
- (setq r (concat r s))
- (unless (string-match "\\S-" (concat b s))
- (setq r (concat r (org-lparse-format 'LINE-BREAK))))
- r))))
-
-(defun org-xml-encode-plain-text (s)
- "Convert plain text characters to HTML equivalent.
-Possible conversions are set in `org-export-html-protect-char-alist'."
- (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c)
- (while (setq c (pop cl))
- (let ((start 0))
- (while (string-match (car c) s start)
- (setq s (replace-match (cdr c) t t s)
- start (1+ (match-beginning 0))))))
- s))
-
-(defun org-xml-encode-org-text-skip-links (string)
- "Prepare STRING for HTML export. Apply all active conversions.
-If there are links in the string, don't modify these. If STRING
-is nil, return nil."
- (when string
- (let* ((re (concat org-bracket-link-regexp "\\|"
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
- m s l res)
- (while (setq m (string-match re string))
- (setq s (substring string 0 m)
- l (match-string 0 string)
- string (substring string (match-end 0)))
- (push (org-xml-encode-org-text s) res)
- (push l res))
- (push (org-xml-encode-org-text string) res)
- (apply 'concat (nreverse res)))))
-
-(defun org-xml-encode-org-text (s)
- "Apply all active conversions to translate special ASCII to HTML."
- (setq s (org-xml-encode-plain-text s))
- (if org-export-html-expand
- (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
- (setq s (replace-match "<\\1>" t nil s))))
- (if org-export-with-emphasize
- (setq s (org-lparse-apply-char-styles s)))
- (if org-export-with-special-strings
- (setq s (org-lparse-convert-special-strings s)))
- (if org-export-with-sub-superscripts
- (setq s (org-lparse-apply-sub-superscript-styles s)))
- (if org-export-with-TeX-macros
- (let ((start 0) wd rep)
- (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
- s start))
- (if (get-text-property (match-beginning 0) 'org-protected s)
- (setq start (match-end 0))
- (setq wd (match-string 1 s))
- (if (setq rep (org-lparse-format 'ORG-ENTITY wd))
- (setq s (replace-match rep t t s))
- (setq start (+ start (length wd))))))))
- s)
-
-(defun org-lparse-convert-special-strings (string)
- "Convert special characters in STRING to HTML."
- (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS))
- e a re rpl start)
- (while (setq a (pop all))
- (setq re (car a) rpl (cdr a) start 0)
- (while (string-match re string start)
- (if (get-text-property (match-beginning 0) 'org-protected string)
- (setq start (match-end 0))
- (setq string (replace-match rpl t nil string)))))
- string))
-
-(defun org-lparse-apply-sub-superscript-styles (string)
- "Apply subscript and superscript styles to STRING.
-Use `org-export-with-sub-superscripts' to control application of
-sub and superscript styles."
- (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
- (while (string-match org-match-substring-regexp string s)
- (cond
- ((and requireb (match-end 8)) (setq s (match-end 2)))
- ((get-text-property (match-beginning 2) 'org-protected string)
- (setq s (match-end 2)))
- (t
- (setq s (match-end 1)
- key (if (string= (match-string 2 string) "_")
- 'subscript 'superscript)
- c (or (match-string 8 string)
- (match-string 6 string)
- (match-string 5 string))
- string (replace-match
- (concat (match-string 1 string)
- (org-lparse-format 'FONTIFY c key))
- t t string)))))
- (while (string-match "\\\\\\([_^]\\)" string)
- (setq string (replace-match (match-string 1 string) t t string)))
- string))
-
-(defvar org-lparse-char-styles
- `(("*" bold)
- ("/" emphasis)
- ("_" underline)
- ("=" code)
- ("~" verbatim)
- ("+" strike))
- "Map Org emphasis markers to char styles.
-This is an alist where each element is of the
-form (ORG-EMPHASIS-CHAR . CHAR-STYLE).")
-
-(defun org-lparse-apply-char-styles (string)
- "Apply char styles to STRING.
-The variable `org-lparse-char-styles' controls how the Org
-emphasis markers are interpreted."
- (let ((s 0) rpl)
- (while (string-match org-emph-re string s)
- (if (not (equal
- (substring string (match-beginning 3) (1+ (match-beginning 3)))
- (substring string (match-beginning 4) (1+ (match-beginning 4)))))
- (setq s (match-beginning 0)
- rpl
- (concat
- (match-string 1 string)
- (org-lparse-format
- 'FONTIFY (match-string 4 string)
- (nth 1 (assoc (match-string 3 string)
- org-lparse-char-styles)))
- (match-string 5 string))
- string (replace-match rpl t t string)
- s (+ s (- (length rpl) 2)))
- (setq s (1+ s))))
- string))
-
-(defun org-lparse-export-list-line (line pos struct prevs)
- "Insert list syntax in export buffer. Return LINE, maybe modified.
-
-POS is the item position or line position the line had before
-modifications to buffer. STRUCT is the list structure. PREVS is
-the alist of previous items."
- (let* ((get-type
- (function
- ;; Translate type of list containing POS to "d", "o" or
- ;; "u".
- (lambda (pos struct prevs)
- (let ((type (org-list-get-list-type pos struct prevs)))
- (cond
- ((eq 'ordered type) "o")
- ((eq 'descriptive type) "d")
- (t "u"))))))
- (get-closings
- (function
- ;; Return list of all items and sublists ending at POS, in
- ;; reverse order.
- (lambda (pos)
- (let (out)
- (catch 'exit
- (mapc (lambda (e)
- (let ((end (nth 6 e))
- (item (car e)))
- (cond
- ((= end pos) (push item out))
- ((>= item pos) (throw 'exit nil)))))
- struct))
- out)))))
- ;; First close any previous item, or list, ending at POS.
- (mapc (lambda (e)
- (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
- (first-item (org-list-get-list-begin e struct prevs))
- (type (funcall get-type first-item struct prevs)))
- (org-lparse-end-paragraph)
- ;; Ending for every item
- (org-lparse-end-list-item-1 type)
- ;; We're ending last item of the list: end list.
- (when lastp
- (org-lparse-end-list type)
- (org-lparse-begin-paragraph))))
- (funcall get-closings pos))
- (cond
- ;; At an item: insert appropriate tags in export buffer.
- ((assq pos struct)
- (string-match
- (concat "[ \t]*\\(\\S-+[ \t]*\\)"
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
- "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
- "\\(.*\\)") line)
- (let* ((checkbox (match-string 3 line))
- (desc-tag (or (match-string 4 line) "???"))
- (body (or (match-string 5 line) ""))
- (list-beg (org-list-get-list-begin pos struct prevs))
- (firstp (= list-beg pos))
- ;; Always refer to first item to determine list type, in
- ;; case list is ill-formed.
- (type (funcall get-type list-beg struct prevs))
- (counter (let ((count-tmp (org-list-get-counter pos struct)))
- (cond
- ((not count-tmp) nil)
- ((string-match "[A-Za-z]" count-tmp)
- (- (string-to-char (upcase count-tmp)) 64))
- ((string-match "[0-9]+" count-tmp)
- count-tmp)))))
- (when firstp
- (org-lparse-end-paragraph)
- (org-lparse-begin-list type))
-
- (let ((arg (cond ((equal type "d") desc-tag)
- ((equal type "o") counter))))
- (org-lparse-begin-list-item type arg))
-
- ;; If line had a checkbox, some additional modification is required.
- (when checkbox
- (setq body
- (concat
- (org-lparse-format
- 'FONTIFY (concat
- "["
- (cond
- ((string-match "X" checkbox) "X")
- ((string-match " " checkbox)
- (org-lparse-format 'SPACES 1))
- (t "-"))
- "]")
- 'code)
- " "
- body)))
- ;; Return modified line
- body))
- ;; At a list ender: go to next line (side-effects only).
- ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
- ;; Not at an item: return line unchanged (side-effects only).
- (t line))))
-
-(defun org-lparse-bind-local-variables (opt-plist)
- (mapc (lambda (x)
- (set (make-local-variable (nth 2 x))
- (plist-get opt-plist (car x))))
- org-export-plist-vars))
-
-(defvar org-lparse-table-rowgrp-open)
-(defvar org-lparse-table-cur-rowgrp-is-hdr)
-(defvar org-lparse-footnote-number)
-(defvar org-lparse-footnote-definitions)
-(defvar org-lparse-output-buffer nil
- "Buffer to which `org-do-lparse' writes to.
-This buffer contains the contents of the to-be-created exported
-document.")
-
-(defcustom org-lparse-debug nil
- "Enable or Disable logging of `org-lparse' callbacks.
-The parameters passed to the backend-registered ENTITY-CONTROL
-and ENTITY-FORMAT callbacks are logged as comment strings in the
-exported buffer. (org-lparse-format 'COMMENT fmt args) is used
-for logging. Customize this variable only if you are an expert
-user. Valid values of this variable are:
-nil : Disable logging
-control : Log all invocations of `org-lparse-begin' and
- `org-lparse-end' callbacks.
-format : Log invocations of `org-lparse-format' callbacks.
-t : Log all invocations of `org-lparse-begin', `org-lparse-end'
- and `org-lparse-format' callbacks,"
- :group 'org-lparse
- :type '(choice
- (const :tag "Disable" nil)
- (const :tag "Format callbacks" format)
- (const :tag "Control callbacks" control)
- (const :tag "Format and Control callbacks" t)))
-
-(defun org-lparse-begin (entity &rest args)
- "Begin ENTITY in current buffer. ARGS is entity specific.
-ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc.
-
-Use (org-lparse-begin 'LIST \"o\") to begin a list in current
-buffer.
-
-See `org-xhtml-entity-control-callbacks-alist' for more
-information."
- (when (and (member org-lparse-debug '(t control))
- (not (eq entity 'DOCUMENT-CONTENT)))
- (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args)))
-
- (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist))))
- (unless f (error "Unknown entity: %s" entity))
- (apply f args)))
-
-(defun org-lparse-end (entity &rest args)
- "Close ENTITY in current buffer. ARGS is entity specific.
-ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM
-etc.
-
-Use (org-lparse-end 'LIST \"o\") to close a list in current
-buffer.
-
-See `org-xhtml-entity-control-callbacks-alist' for more
-information."
- (when (and (member org-lparse-debug '(t control))
- (not (eq entity 'DOCUMENT-CONTENT)))
- (insert (org-lparse-format 'COMMENT "%s END %S" entity args)))
-
- (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist))))
- (unless f (error "Unknown entity: %s" entity))
- (apply f args)))
-
-(defun org-lparse-begin-paragraph (&optional style)
- "Insert <p>, but first close previous paragraph if any."
- (org-lparse-end-paragraph)
- (org-lparse-begin 'PARAGRAPH style)
- (setq org-lparse-par-open t))
-
-(defun org-lparse-end-paragraph ()
- "Close paragraph if there is one open."
- (when org-lparse-par-open
- (org-lparse-end 'PARAGRAPH)
- (setq org-lparse-par-open nil)))
-
-(defun org-lparse-end-list-item-1 (&optional type)
- "Close <li> if necessary."
- (org-lparse-end-paragraph)
- (org-lparse-end-list-item (or type "u")))
-
-(define-obsolete-function-alias
- 'org-lparse-preprocess-after-blockquote-hook
- 'org-lparse-preprocess-after-blockquote
- "24.3")
-
-(defun org-lparse-preprocess-after-blockquote ()
- "Treat `org-lparse-special-blocks' specially."
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t)
- (when (member (downcase (match-string 2)) org-lparse-special-blocks)
- (replace-match
- (if (equal (downcase (match-string 1)) "begin")
- (format "ORG-%s-START %s" (upcase (match-string 2))
- (match-string 3))
- (format "ORG-%s-END %s" (upcase (match-string 2))
- (match-string 3))) t t))))
-
-(define-obsolete-function-alias
- 'org-lparse-strip-experimental-blocks-maybe-hook
- 'org-lparse-strip-experimental-blocks-maybe
- "24.3")
-
-(defun org-lparse-strip-experimental-blocks-maybe ()
- "Strip \"list-table\" and \"annotation\" blocks.
-Stripping happens only when the exported backend is not one of
-\"odt\" or \"xhtml\"."
- (when (not org-lparse-backend)
- (message "Stripping following blocks - %S" org-lparse-special-blocks)
- (goto-char (point-min))
- (let ((case-fold-search t))
- (while
- (re-search-forward
- "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*"
- nil t)
- (when (member (match-string 1) org-lparse-special-blocks)
- (replace-match "" t t))))))
-
-(defvar org-lparse-list-table-p nil
- "Non-nil if `org-do-lparse' is within a list-table.")
-
-(defvar org-lparse-dyn-current-environment nil)
-(defun org-lparse-begin-environment (style &optional env-options-plist)
- (case style
- (list-table
- (setq org-lparse-list-table-p t))
- (t (setq org-lparse-dyn-current-environment style)
- (org-lparse-begin 'ENVIRONMENT style env-options-plist))))
-
-(defun org-lparse-end-environment (style &optional env-options-plist)
- (case style
- (list-table
- (setq org-lparse-list-table-p nil))
- (t (org-lparse-end 'ENVIRONMENT style env-options-plist)
- (setq org-lparse-dyn-current-environment nil))))
-
-(defun org-lparse-current-environment-p (style)
- (eq org-lparse-dyn-current-environment style))
-
-(defun org-lparse-begin-footnote-definition (n)
- (org-lparse-begin-collect)
- (setq org-lparse-insert-tag-with-newlines nil)
- (org-lparse-begin 'FOOTNOTE-DEFINITION n))
-
-(defun org-lparse-end-footnote-definition (n)
- (org-lparse-end 'FOOTNOTE-DEFINITION n)
- (setq org-lparse-insert-tag-with-newlines 'both)
- (let ((footnote-def (org-lparse-end-collect)))
- ;; Cleanup newlines in footnote definition. This ensures that a
- ;; transcoded line is never (wrongly) broken in to multiple lines.
- (let ((pos 0))
- (while (string-match "[\r\n]+" footnote-def pos)
- (setq pos (1+ (match-beginning 0)))
- (setq footnote-def (replace-match " " t t footnote-def))))
- (push (cons n footnote-def) org-lparse-footnote-definitions)))
-
-(defvar org-lparse-collect-buffer nil
- "An auxiliary buffer named \"*Org Lparse Collect*\".
-`org-do-lparse' uses this as output buffer while collecting
-footnote definitions and table-cell contents of list-tables. See
-`org-lparse-begin-collect' and `org-lparse-end-collect'.")
-
-(defvar org-lparse-collect-count nil
- "Count number of calls to `org-lparse-begin-collect'.
-Use this counter to catch chained collections if they ever
-happen.")
-
-(defun org-lparse-begin-collect ()
- "Temporarily switch to `org-lparse-collect-buffer'.
-Also erase it's contents."
- (unless (zerop org-lparse-collect-count)
- (error "FIXME (org-lparse.el): Encountered chained collections"))
- (incf org-lparse-collect-count)
- (unless org-lparse-collect-buffer
- (setq org-lparse-collect-buffer
- (get-buffer-create "*Org Lparse Collect*")))
- (set-buffer org-lparse-collect-buffer)
- (erase-buffer))
-
-(defun org-lparse-end-collect ()
- "Switch to `org-lparse-output-buffer'.
-Return contents of `org-lparse-collect-buffer' as a `string'."
- (assert (> org-lparse-collect-count 0))
- (decf org-lparse-collect-count)
- (prog1 (buffer-string)
- (erase-buffer)
- (set-buffer org-lparse-output-buffer)))
-
-(defun org-lparse-format (entity &rest args)
- "Format ENTITY in backend-specific way and return it.
-ARGS is specific to entity being formatted.
-
-Use (org-lparse-format 'HEADING \"text\" 1) to format text as
-level 1 heading.
-
-See `org-xhtml-entity-format-callbacks-alist' for more information."
- (when (and (member org-lparse-debug '(t format))
- (not (equal entity 'COMMENT)))
- (insert (org-lparse-format 'COMMENT "%s: %S" entity args)))
- (cond
- ((consp entity)
- (let ((text (pop args)))
- (apply 'org-lparse-format 'TAGS entity text args)))
- (t
- (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist))))
- (unless f (error "Unknown entity: %s" entity))
- (apply f args)))))
-
-(defun org-lparse-insert (entity &rest args)
- (insert (apply 'org-lparse-format entity args)))
-
-(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc)
- (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
- (org-min-level (org-get-min-level lines level-offset))
- (org-last-level org-min-level)
- level)
- (with-temp-buffer
- (org-lparse-bind-local-variables opt-plist)
- (erase-buffer)
- (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc)
- (setq
- lines
- (mapcar
- #'(lambda (line)
- (when (and (string-match org-todo-line-regexp line)
- (not (get-text-property 0 'org-protected line))
- (<= (setq level (org-tr-level
- (- (match-end 1) (match-beginning 1)
- level-offset)))
- umax-toc))
- (let ((txt (save-match-data
- (org-xml-encode-org-text-skip-links
- (org-export-cleanup-toc-line
- (match-string 3 line)))))
- (todo (and
- org-export-mark-todo-in-toc
- (or (and (match-beginning 2)
- (not (member (match-string 2 line)
- org-done-keywords)))
- (and (= level umax-toc)
- (org-search-todo-below
- line lines level)))))
- tags)
- ;; Check for targets
- (while (string-match org-any-target-regexp line)
- (setq line
- (replace-match
- (let ((org-lparse-encode-pending t))
- (org-lparse-format 'FONTIFY
- (match-string 1 line) "target"))
- t t line)))
- (when (string-match
- (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
- (setq tags (match-string 1 txt)
- txt (replace-match "" t nil txt)))
- (when (string-match quote-re0 txt)
- (setq txt (replace-match "" t t txt)))
- (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
- (setq txt (replace-match "" t t txt)))
- (org-lparse-format
- 'TOC-ITEM
- (let* ((snumber (org-section-number level))
- (href (replace-regexp-in-string
- "\\." "-" (format "sec-%s" snumber)))
- (href
- (or
- (cdr (assoc
- href org-export-preferred-target-alist))
- href))
- (href (org-solidify-link-text href)))
- (org-lparse-format 'TOC-ENTRY snumber todo txt tags href))
- level org-last-level)
- (setq org-last-level level)))
- line)
- lines))
- (org-lparse-end 'TOC)
- (setq org-lparse-toc (buffer-string))))
- lines)
-
-(defun org-lparse-format-table-row (fields &optional text-for-empty-fields)
- (if org-lparse-table-ncols
- ;; second and subsequent rows of the table
- (when (and org-lparse-list-table-p
- (> (length fields) org-lparse-table-ncols))
- (error "Table row has %d columns but header row claims %d columns"
- (length fields) org-lparse-table-ncols))
- ;; first row of the table
- (setq org-lparse-table-ncols (length fields))
- (when org-lparse-table-is-styled
- (setq org-lparse-table-num-numeric-items-per-column
- (make-vector org-lparse-table-ncols 0))
- (setq org-lparse-table-colalign-vector
- (make-vector org-lparse-table-ncols nil))
- (let ((c -1))
- (while (< (incf c) org-lparse-table-ncols)
- (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info)))
- (align (nth 0 col-cookie)))
- (setf (aref org-lparse-table-colalign-vector c)
- (cond
- ((string= align "l") "left")
- ((string= align "r") "right")
- ((string= align "c") "center"))))))))
- (incf org-lparse-table-rownum)
- (let ((i -1))
- (org-lparse-format
- 'TABLE-ROW
- (mapconcat
- (lambda (x)
- (when (and (string= x "") text-for-empty-fields)
- (setq x text-for-empty-fields))
- (incf i)
- (let (col-cookie horiz-span)
- (when org-lparse-table-is-styled
- (when (and (< i org-lparse-table-ncols)
- (string-match org-table-number-regexp x))
- (incf (aref org-lparse-table-num-numeric-items-per-column i)))
- (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info))
- horiz-span (nth 1 col-cookie)))
- (org-lparse-format
- 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0))))
- fields "\n"))))
-
-(defun org-lparse-get (what &optional opt-plist)
- "Query for value of WHAT for the current backend `org-lparse-backend'.
-See also `org-lparse-backend-get'."
- (if (boundp 'org-lparse-backend)
- (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist)
- (error "org-lparse-backend is not bound yet")))
-
-(defun org-lparse-backend-get (backend what &optional opt-plist)
- "Query BACKEND for value of WHAT.
-Dispatch the call to `org-<backend>-user-get'. If that throws an
-error, dispatch the call to `org-<backend>-get'. See
-`org-xhtml-get' for all known settings queried for by
-`org-lparse' during the course of export."
- (assert (stringp backend) t)
- (unless (org-lparse-backend-is-native-p backend)
- (error "Unknown native backend %s" backend))
- (let ((backend-get-method (intern (format "org-%s-get" backend)))
- (backend-user-get-method (intern (format "org-%s-user-get" backend))))
- (cond
- ((functionp backend-get-method)
- (condition-case nil
- (funcall backend-user-get-method what opt-plist)
- (error (funcall backend-get-method what opt-plist))))
- (t
- (error "Native backend %s doesn't define %s" backend backend-get-method)))))
-
-(defun org-lparse-insert-tag (tag &rest args)
- (when (member org-lparse-insert-tag-with-newlines '(lead both))
- (insert "\n"))
- (insert (apply 'format tag args))
- (when (member org-lparse-insert-tag-with-newlines '(trail both))
- (insert "\n")))
-
-(defun org-lparse-get-targets-from-title (title)
- (let* ((target (org-get-text-property-any 0 'target title))
- (extra-targets (assoc target org-export-target-aliases))
- (target (or (cdr (assoc target org-export-preferred-target-alist))
- target)))
- (cons target (remove target extra-targets))))
-
-(defun org-lparse-suffix-from-snumber (snumber)
- (let* ((snu (replace-regexp-in-string "\\." "-" snumber))
- (href (cdr (assoc (concat "sec-" snu)
- org-export-preferred-target-alist))))
- (org-solidify-link-text (or href snu))))
-
-(defun org-lparse-begin-level (level title umax head-count)
- "Insert a new LEVEL in HTML export.
-When TITLE is nil, just close all open levels."
- (org-lparse-end-level level umax)
- (unless title (error "Why is heading nil"))
- (let* ((targets (org-lparse-get-targets-from-title title))
- (target (car targets)) (extra-targets (cdr targets))
- (target (and target (org-solidify-link-text target)))
- (extra-class (org-get-text-property-any 0 'html-container-class title))
- snumber tags level1 class)
- (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
- (setq tags (and org-export-with-tags (match-string 1 title)))
- (setq title (replace-match "" t t title)))
- (if (> level umax)
- (progn
- (if (aref org-levels-open (1- level))
- (org-lparse-end-list-item-1)
- (aset org-levels-open (1- level) t)
- (org-lparse-end-paragraph)
- (org-lparse-begin-list 'unordered))
- (org-lparse-begin-list-item
- 'unordered target (org-lparse-format
- 'HEADLINE title extra-targets tags)))
- (aset org-levels-open (1- level) t)
- (setq snumber (org-section-number level))
- (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))
- (unless (= head-count 1)
- (org-lparse-end-outline-text-or-outline))
- (org-lparse-begin-outline-and-outline-text
- level1 snumber title tags target extra-targets extra-class)
- (org-lparse-begin-paragraph))))
-
-(defun org-lparse-end-level (level umax)
- (org-lparse-end-paragraph)
- (loop for l from org-level-max downto level
- do (when (aref org-levels-open (1- l))
- ;; Terminate one level in HTML export
- (if (<= l umax)
- (org-lparse-end-outline-text-or-outline)
- (org-lparse-end-list-item-1)
- (org-lparse-end-list 'unordered))
- (aset org-levels-open (1- l) nil))))
-
-(defvar org-lparse-outline-text-open)
-(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags
- target extra-targets
- extra-class)
- (org-lparse-begin
- 'OUTLINE level1 snumber title tags target extra-targets extra-class)
- (org-lparse-begin-outline-text level1 snumber extra-class))
-
-(defun org-lparse-end-outline-text-or-outline ()
- (cond
- (org-lparse-outline-text-open
- (org-lparse-end 'OUTLINE-TEXT)
- (setq org-lparse-outline-text-open nil))
- (t (org-lparse-end 'OUTLINE))))
-
-(defun org-lparse-begin-outline-text (level1 snumber extra-class)
- (assert (not org-lparse-outline-text-open) t)
- (setq org-lparse-outline-text-open t)
- (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class))
-
-(defun org-lparse-html-list-type-to-canonical-list-type (ltype)
- (cdr (assoc ltype '(("o" . ordered)
- ("u" . unordered)
- ("d" . description)))))
-
-;; following vars are bound during `org-do-lparse'
-(defvar org-lparse-list-stack)
-(defvar org-lparse-list-table:table-row)
-(defvar org-lparse-list-table:lines)
-
-;; Notes on LIST-TABLES
-;; ====================
-;; Lists withing "list-table" blocks (as shown below)
-;;
-;; #+begin_list-table
-;; - Row 1
-;; - 1.1
-;; - 1.2
-;; - 1.3
-;; - Row 2
-;; - 2.1
-;; - 2.2
-;; - 2.3
-;; #+end_list-table
-;;
-;; will be exported as though it were a table as shown below.
-;;
-;; | Row 1 | 1.1 | 1.2 | 1.3 |
-;; | Row 2 | 2.1 | 2.2 | 2.3 |
-;;
-;; Note that org-tables are NOT multi-line and each line is mapped to
-;; a unique row in the exported document. So if an exported table
-;; needs to contain a single paragraph (with copious text) it needs to
-;; be typed up in a single line. Editing such long lines using the
-;; table editor will be a cumbersome task. Furthermore inclusion of
-;; multi-paragraph text in a table cell is well-nigh impossible.
-;;
-;; LIST-TABLEs are meant to circumvent the above problems with
-;; org-tables.
-;;
-;; Note that in the example above the list items could be paragraphs
-;; themselves and the list can be arbitrarily deep.
-;;
-;; Inspired by following thread:
-;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
-
-(defun org-lparse-begin-list (ltype)
- (push ltype org-lparse-list-stack)
- (let ((list-level (length org-lparse-list-stack)))
- (cond
- ((not org-lparse-list-table-p)
- (org-lparse-begin 'LIST ltype))
- ;; process LIST-TABLE
- ((= 1 list-level)
- ;; begin LIST-TABLE
- (setq org-lparse-list-table:lines nil)
- (setq org-lparse-list-table:table-row nil))
- ((= 2 list-level)
- (ignore))
- (t
- (org-lparse-begin 'LIST ltype)))))
-
-(defun org-lparse-end-list (ltype)
- (pop org-lparse-list-stack)
- (let ((list-level (length org-lparse-list-stack)))
- (cond
- ((not org-lparse-list-table-p)
- (org-lparse-end 'LIST ltype))
- ;; process LIST-TABLE
- ((= 0 list-level)
- ;; end LIST-TABLE
- (insert (org-lparse-format-list-table
- (nreverse org-lparse-list-table:lines))))
- ((= 1 list-level)
- (ignore))
- (t
- (org-lparse-end 'LIST ltype)))))
-
-(defun org-lparse-begin-list-item (ltype &optional arg headline)
- (let ((list-level (length org-lparse-list-stack)))
- (cond
- ((not org-lparse-list-table-p)
- (org-lparse-begin 'LIST-ITEM ltype arg headline))
- ;; process LIST-TABLE
- ((= 1 list-level)
- ;; begin TABLE-ROW for LIST-TABLE
- (setq org-lparse-list-table:table-row nil)
- (org-lparse-begin-list-table:table-cell))
- ((= 2 list-level)
- ;; begin TABLE-CELL for LIST-TABLE
- (org-lparse-begin-list-table:table-cell))
- (t
- (org-lparse-begin 'LIST-ITEM ltype arg headline)))))
-
-(defun org-lparse-end-list-item (ltype)
- (let ((list-level (length org-lparse-list-stack)))
- (cond
- ((not org-lparse-list-table-p)
- (org-lparse-end 'LIST-ITEM ltype))
- ;; process LIST-TABLE
- ((= 1 list-level)
- ;; end TABLE-ROW for LIST-TABLE
- (org-lparse-end-list-table:table-cell)
- (push (nreverse org-lparse-list-table:table-row)
- org-lparse-list-table:lines))
- ((= 2 list-level)
- ;; end TABLE-CELL for LIST-TABLE
- (org-lparse-end-list-table:table-cell))
- (t
- (org-lparse-end 'LIST-ITEM ltype)))))
-
-(defvar org-lparse-list-table:table-cell-open)
-(defun org-lparse-begin-list-table:table-cell ()
- (org-lparse-end-list-table:table-cell)
- (setq org-lparse-list-table:table-cell-open t)
- (org-lparse-begin-collect)
- (org-lparse-begin-paragraph))
-
-(defun org-lparse-end-list-table:table-cell ()
- (when org-lparse-list-table:table-cell-open
- (setq org-lparse-list-table:table-cell-open nil)
- (org-lparse-end-paragraph)
- (push (org-lparse-end-collect)
- org-lparse-list-table:table-row)))
-
-(defvar org-lparse-table-rowgrp-info)
-(defun org-lparse-begin-table-rowgroup (&optional is-header-row)
- (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info)
- (org-lparse-begin 'TABLE-ROWGROUP is-header-row))
-
-(defun org-lparse-end-table ()
- (when org-lparse-table-is-styled
- ;; column groups
- (unless (car org-table-colgroup-info)
- (setq org-table-colgroup-info
- (cons :start (cdr org-table-colgroup-info))))
-
- ;; column alignment
- (let ((c -1))
- (mapc
- (lambda (x)
- (incf c)
- (setf (aref org-lparse-table-colalign-vector c)
- (or (aref org-lparse-table-colalign-vector c)
- (if (> (/ (float x) (1+ org-lparse-table-rownum))
- org-table-number-fraction)
- "right" "left"))))
- org-lparse-table-num-numeric-items-per-column)))
- (org-lparse-end 'TABLE))
-
-(defvar org-lparse-encode-pending nil)
-
-(defun org-lparse-format-tags (tag text prefix suffix &rest args)
- (cond
- ((consp tag)
- (concat prefix (apply 'format (car tag) args) text suffix
- (format (cdr tag))))
- ((stringp tag) ; singleton tag
- (concat prefix (apply 'format tag args) text))))
-
-(defun org-xml-fix-class-name (kwd) ; audit callers of this function
- "Turn todo keyword into a valid class name.
-Replaces invalid characters with \"_\"."
- (save-match-data
- (while (string-match "[^a-zA-Z0-9_]" kwd)
- (setq kwd (replace-match "_" t t kwd))))
- kwd)
-
-(defun org-lparse-format-todo (todo)
- (org-lparse-format 'FONTIFY
- (concat
- (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX))
- (org-xml-fix-class-name todo))
- (list (if (member todo org-done-keywords) "done" "todo")
- todo)))
-
-(defun org-lparse-format-extra-targets (extra-targets)
- (if (not extra-targets) ""
- (mapconcat (lambda (x)
- (setq x (org-solidify-link-text
- (if (org-uuidgen-p x) (concat "ID-" x) x)))
- (org-lparse-format 'ANCHOR "" x))
- extra-targets "")))
-
-(defun org-lparse-format-org-tags (tags)
- (if (not tags) ""
- (org-lparse-format
- 'FONTIFY (mapconcat
- (lambda (x)
- (org-lparse-format
- 'FONTIFY x
- (concat
- (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX))
- (org-xml-fix-class-name x))))
- (org-split-string tags ":")
- (org-lparse-format 'SPACES 1)) "tag")))
-
-(defun org-lparse-format-section-number (&optional snumber level)
- (and org-export-with-section-numbers
- (not org-lparse-body-only) snumber level
- (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level))))
-
-(defun org-lparse-warn (msg)
- (if (not org-lparse-use-flashy-warning)
- (message msg)
- (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg)
- (message msg)
- (sleep-for 3)))
-
-(defun org-xml-format-href (s)
- "Make sure the S is valid as a href reference in an XHTML document."
- (save-match-data
- (let ((start 0))
- (while (string-match "&" s start)
- (setq start (+ (match-beginning 0) 3)
- s (replace-match "&amp;" t t s)))))
- s)
-
-(defun org-xml-format-desc (s)
- "Make sure the S is valid as a description in a link."
- (if (and s (not (get-text-property 1 'org-protected s)))
- (save-match-data
- (org-xml-encode-org-text s))
- s))
-
-(provide 'org-lparse)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-lparse.el ends here
diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el
deleted file mode 100644
index 5df68f56a05..00000000000
--- a/lisp/org/org-mac-message.el
+++ /dev/null
@@ -1,216 +0,0 @@
-;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
-
-;; Keywords: outlines, hypermedia, calendar, wp
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This file implements links to Apple Mail.app messages from within Org-mode.
-;; Org-mode does not load this module by default - if you would actually like
-;; this to happen then configure the variable `org-modules'.
-
-;; If you would like to create links to all flagged messages in an
-;; Apple Mail.app account, please customize the variable
-;; `org-mac-mail-account' and then call one of the following functions:
-
-;; (org-mac-message-insert-selected) copies a formatted list of links to
-;; the kill ring.
-
-;; (org-mac-message-insert-selected) inserts at point links to any
-;; messages selected in Mail.app.
-
-;; (org-mac-message-insert-flagged) searches within an org-mode buffer
-;; for a specific heading, creating it if it doesn't exist. Any
-;; message:// links within the first level of the heading are deleted
-;; and replaced with links to flagged messages.
-
-;;; Code:
-
-(require 'org)
-
-(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages."
- :tag "Org Mail.app"
- :group 'org-link)
-
-(defcustom org-mac-mail-account "customize"
- "The Mail.app account in which to search for flagged messages."
- :group 'org-mac-flagged-mail
- :type 'string)
-
-(org-add-link-type "message" 'org-mac-message-open)
-
-;; In mac.c, removed in Emacs 23.
-(declare-function do-applescript "org-mac-message" (script))
-(unless (fboundp 'do-applescript)
- ;; Need to fake this using shell-command-to-string
- (defun do-applescript (script)
- (let (start cmd return)
- (while (string-match "\n" script)
- (setq script (replace-match "\r" t t script)))
- (while (string-match "'" script start)
- (setq start (+ 2 (match-beginning 0))
- script (replace-match "\\'" t t script)))
- (setq cmd (concat "osascript -e '" script "'"))
- (setq return (shell-command-to-string cmd))
- (concat "\"" (org-trim return) "\""))))
-
-(defun org-mac-message-open (message-id)
- "Visit the message with the given MESSAGE-ID.
-This will use the command `open' with the message URL."
- (start-process (concat "open message:" message-id) nil
- "open" (concat "message://<" (substring message-id 2) ">")))
-
-(defun as-get-selected-mail ()
- "AppleScript to create links to selected messages in Mail.app."
- (do-applescript
- (concat
- "tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun as-get-flagged-mail ()
- "AppleScript to create links to flagged messages in Mail.app."
- (do-applescript
- (concat
- ;; Is Growl installed?
- "tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
- "end tell\n"
-
- ;; Get links
- "tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun org-mac-message-get-links (&optional select-or-flag)
- "Create links to the messages currently selected or flagged in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-messages in Mail.app and make a link out of it.
-When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
-the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
-The Org-syntax text will be pushed to the kill ring, and also returned."
- (interactive "sLink to (s)elected or (f)lagged messages: ")
- (setq select-or-flag (or select-or-flag "s"))
- (message "AppleScript: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (as-get-selected-mail)
- (if (string= select-or-flag "f")
- (as-get-flagged-mail)
- (error "Please select \"s\" or \"f\""))))
- (link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-(defun org-mac-message-insert-selected ()
- "Insert a link to the messages currently selected in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Mail.app and make a link out of it."
- (interactive)
- (insert (org-mac-message-get-links "s")))
-
-;; The following line is for backward compatibility
-(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
-
-(defun org-mac-message-insert-flagged (org-buffer org-heading)
- "Asks for an org buffer and a heading within it, and replace message links.
-If heading exists, delete all message:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of message:// links to flagged mail after heading."
- (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
- (with-current-buffer org-buffer
- (goto-char (point-min))
- (let ((isearch-forward t)
- (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
- (if (org-goto-local-search-headings org-heading nil t)
- (if (not (eobp))
- (progn
- (save-excursion
- (while (re-search-forward
- message-re (save-excursion (outline-next-heading)) t)
- (delete-region (match-beginning 0) (match-end 0)))
- (insert "\n" (org-mac-message-get-links "f")))
- (flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-message-get-links "f"))))))
-
-(provide 'org-mac-message)
-
-;;; org-mac-message.el ends here
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
new file mode 100644
index 00000000000..a79b539d54a
--- /dev/null
+++ b/lisp/org/org-macro.el
@@ -0,0 +1,193 @@
+;;; org-macro.el --- Macro Replacement Code for Org Mode
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Macros are expanded with `org-macro-replace-all', which relies
+;; internally on `org-macro-expand'.
+
+;; Default templates for expansion are stored in the buffer-local
+;; variable `org-macro-templates'. This variable is updated by
+;; `org-macro-initialize-templates', which recursively calls
+;; `org-macro--collect-macros' in order to read setup files.
+
+;; Along with macros defined through #+MACRO: keyword, default
+;; templates include the following hard-coded macros:
+;; {{{time(format-string)}}}, {{{property(node-property)}}},
+;; {{{input-file}}} and {{{modification-time(format-string)}}}.
+
+;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
+;; {{{email}}} and {{{title}}} macros.
+
+;;; Code:
+(require 'org-macs)
+
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-remove-double-quotes "org" (s))
+(declare-function org-mode "org" ())
+(declare-function org-file-contents "org" (file &optional noerror))
+(declare-function org-with-wide-buffer "org-macs" (&rest body))
+
+;;; Variables
+
+(defvar org-macro-templates nil
+ "Alist containing all macro templates in current buffer.
+Associations are in the shape of (NAME . TEMPLATE) where NAME
+stands for macro's name and template for its replacement value,
+both as strings. This is an internal variable. Do not set it
+directly, use instead:
+
+ #+MACRO: name template")
+(make-variable-buffer-local 'org-macro-templates)
+
+
+;;; Functions
+
+(defun org-macro--collect-macros ()
+ "Collect macro definitions in current buffer and setup files.
+Return an alist containing all macro templates found."
+ (let* (collect-macros ; For byte-compiler.
+ (collect-macros
+ (lambda (files templates)
+ ;; Return an alist of macro templates. FILES is a list of
+ ;; setup files names read so far, used to avoid circular
+ ;; dependencies. TEMPLATES is the alist collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element) "MACRO")
+ ;; Install macro in TEMPLATES.
+ (when (string-match
+ "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
+ (let* ((name (match-string 1 val))
+ (template (or (match-string 2 val) ""))
+ (old-cell (assoc name templates)))
+ (if old-cell (setcdr old-cell template)
+ (push (cons name template) templates))))
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-remove-double-quotes val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (org-mode)
+ (insert (org-file-contents file 'noerror))
+ (setq templates
+ (funcall collect-macros (cons file files)
+ templates)))))))))))
+ templates))))
+ (funcall collect-macros nil nil)))
+
+(defun org-macro-initialize-templates ()
+ "Collect macro templates defined in current buffer.
+Templates are stored in buffer-local variable
+`org-macro-templates'. In addition to buffer-defined macros, the
+function installs the following ones: \"property\",
+\"time\". and, if the buffer is associated to a file,
+\"input-file\" and \"modification-time\"."
+ (let* ((templates (org-macro--collect-macros))
+ (update-templates
+ (lambda (cell)
+ (let ((old-template (assoc (car cell) templates)))
+ (if old-template (setcdr old-template (cdr cell))
+ (push cell templates))))))
+ ;; Install hard-coded macros.
+ (mapc (lambda (cell) (funcall update-templates cell))
+ (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))")
+ (cons "time" "(eval (format-time-string \"$1\"))")))
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (when (and visited-file (file-exists-p visited-file))
+ (mapc (lambda (cell) (funcall update-templates cell))
+ (list (cons "input-file" (file-name-nondirectory visited-file))
+ (cons "modification-time"
+ (format "(eval (format-time-string \"$1\" '%s))"
+ (prin1-to-string
+ (nth 5 (file-attributes visited-file)))))))))
+ (setq org-macro-templates templates)))
+
+(defun org-macro-expand (macro templates)
+ "Return expanded MACRO, as a string.
+MACRO is an object, obtained, for example, with
+`org-element-context'. TEMPLATES is an alist of templates used
+for expansion. See `org-macro-templates' for a buffer-local
+default value. Return nil if no template was found."
+ (let ((template
+ ;; Macro names are case-insensitive.
+ (cdr (assoc-string (org-element-property :key macro) templates t))))
+ (when template
+ (let ((value (replace-regexp-in-string
+ "\\$[0-9]+"
+ (lambda (arg)
+ (or (nth (1- (string-to-number (substring arg 1)))
+ (org-element-property :args macro))
+ ;; No argument: remove place-holder.
+ ""))
+ template nil 'literal)))
+ ;; VALUE starts with "(eval": it is a s-exp, `eval' it.
+ (when (string-match "\\`(eval\\>" value)
+ (setq value (eval (read value))))
+ ;; Return string.
+ (format "%s" (or value ""))))))
+
+(defun org-macro-replace-all (templates)
+ "Replace all macros in current buffer by their expansion.
+TEMPLATES is an alist of templates used for expansion. See
+`org-macro-templates' for a buffer-local default value."
+ (save-excursion
+ (goto-char (point-min))
+ (let (record)
+ (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'macro)
+ (let* ((value (org-macro-expand object templates))
+ (begin (org-element-property :begin object))
+ (signature (list begin
+ object
+ (org-element-property :args object))))
+ ;; Avoid circular dependencies by checking if the same
+ ;; macro with the same arguments is expanded at the same
+ ;; position twice.
+ (if (member signature record)
+ (error "Circular macro expansion: %s"
+ (org-element-property :key object))
+ (when value
+ (push signature record)
+ (delete-region
+ begin
+ ;; Preserve white spaces after the macro.
+ (progn (goto-char (org-element-property :end object))
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Leave point before replacement in case of recursive
+ ;; expansions.
+ (save-excursion (insert value)))))))))))
+
+
+(provide 'org-macro)
+;;; org-macro.el ends here
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 57b2d8a577e..ea8e7b532aa 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -1,6 +1,6 @@
;;; org-macs.el --- Top-level definitions for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -33,7 +33,9 @@
(eval-and-compile
(unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional arglist fileonly)))
+ (defmacro declare-function (fn file &optional _arglist _fileonly)
+ `(autoload ',fn ,file)))
+
(if (>= emacs-major-version 23)
(defsubst org-char-to-string(c)
"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
@@ -46,13 +48,14 @@
(declare-function org-string-match-p "org-compat" (&rest args))
(defmacro org-with-gensyms (symbols &rest body)
+ (declare (debug (sexp body)) (indent 1))
`(let ,(mapcar (lambda (s)
- `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols)
+ `(,s (make-symbol (concat "--" (symbol-name ',s)))))
+ symbols)
,@body))
-(def-edebug-spec org-with-gensyms (sexp body))
-(put 'org-with-gensyms 'lisp-indent-function 1)
(defmacro org-called-interactively-p (&optional kind)
+ (declare (debug (&optional ("quote" symbolp)))) ;Why not just t?
(if (featurep 'xemacs)
`(interactive-p)
(if (or (> emacs-major-version 23)
@@ -61,20 +64,11 @@
;; defined with no argument in <=23.1
`(with-no-warnings (called-interactively-p ,kind))
`(interactive-p))))
-(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp)))
-
-(when (and (not (fboundp 'with-silent-modifications))
- (or (< emacs-major-version 23)
- (and (= emacs-major-version 23)
- (< emacs-minor-version 2))))
- (defmacro with-silent-modifications (&rest body)
- `(org-unmodified ,@body))
- (def-edebug-spec with-silent-modifications (body)))
(defmacro org-bound-and-true-p (var)
"Return the value of symbol VAR if it is bound, else nil."
+ (declare (debug (symbolp)))
`(and (boundp (quote ,var)) ,var))
-(def-edebug-spec org-bound-and-true-p (symbolp))
(defun org-string-nw-p (s)
"Is S a string with a non-white character?"
@@ -87,16 +81,6 @@
Otherwise return nil."
(and v (not (equal v "nil")) v))
-(defmacro org-unmodified (&rest body)
- "Execute body without changing `buffer-modified-p'.
-Also, do not record undo information."
- `(set-buffer-modified-p
- (prog1 (buffer-modified-p)
- (let ((buffer-undo-list t)
- (inhibit-modification-hooks t))
- ,@body))))
-(def-edebug-spec org-unmodified (body))
-
(defun org-substitute-posix-classes (re)
"Substitute posix classes in regular expression RE."
(let ((ss re))
@@ -113,10 +97,11 @@ Also, do not record undo information."
(defmacro org-re (s)
"Replace posix classes in regular expression."
+ (declare (debug (form)))
(if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
-(def-edebug-spec org-re (form))
(defmacro org-preserve-lc (&rest body)
+ (declare (debug (body)))
(org-with-gensyms (line col)
`(let ((,line (org-current-line))
(,col (current-column)))
@@ -124,18 +109,22 @@ Also, do not record undo information."
(progn ,@body)
(org-goto-line ,line)
(org-move-to-column ,col)))))
-(def-edebug-spec org-preserve-lc (body))
-;; Copied from bookmark.el
-(defmacro org-with-buffer-modified-unmodified (&rest body)
+;; Use `org-with-silent-modifications' to ignore cosmetic changes and
+;; `org-unmodified' to ignore real text modifications
+(defmacro org-unmodified (&rest body)
"Run BODY while preserving the buffer's `buffer-modified-p' state."
+ (declare (debug (body)))
(org-with-gensyms (was-modified)
`(let ((,was-modified (buffer-modified-p)))
(unwind-protect
- (progn ,@body)
- (set-buffer-modified-p ,was-modified)))))
+ (let ((buffer-undo-list t)
+ (inhibit-modification-hooks t))
+ ,@body)
+ (set-buffer-modified-p ,was-modified)))))
(defmacro org-without-partial-completion (&rest body)
+ (declare (debug (body)))
`(if (and (boundp 'partial-completion-mode)
partial-completion-mode
(fboundp 'partial-completion-mode))
@@ -145,7 +134,6 @@ Also, do not record undo information."
,@body)
(partial-completion-mode 1))
,@body))
-(def-edebug-spec org-without-partial-completion (body))
;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
(defmacro org-maybe-intangible (props)
@@ -162,60 +150,31 @@ We use a macro so that the test can happen at compilation time."
(defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY."
+ (declare (debug (form body)) (indent 1))
(org-with-gensyms (mpom)
`(let ((,mpom ,pom))
(save-excursion
(if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
- (save-excursion
- (goto-char (or ,mpom (point)))
- ,@body)))))
-(def-edebug-spec org-with-point-at (form body))
-(put 'org-with-point-at 'lisp-indent-function 1)
+ (org-with-wide-buffer
+ (goto-char (or ,mpom (point)))
+ ,@body)))))
(defmacro org-no-warnings (&rest body)
+ (declare (debug (body)))
(cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
-(def-edebug-spec org-no-warnings (body))
-
-(defmacro org-if-unprotected (&rest body)
- "Execute BODY if there is no `org-protected' text property at point."
- `(unless (get-text-property (point) 'org-protected)
- ,@body))
-(def-edebug-spec org-if-unprotected (body))
-(defmacro org-if-unprotected-1 (&rest body)
- "Execute BODY if there is no `org-protected' text property at point-1."
- `(unless (get-text-property (1- (point)) 'org-protected)
- ,@body))
-(def-edebug-spec org-if-unprotected-1 (body))
-
-(defmacro org-if-unprotected-at (pos &rest body)
- "Execute BODY if there is no `org-protected' text property at POS."
- `(unless (get-text-property ,pos 'org-protected)
- ,@body))
-(def-edebug-spec org-if-unprotected-at (form body))
-(put 'org-if-unprotected-at 'lisp-indent-function 1)
-
-(defun org-re-search-forward-unprotected (&rest args)
- "Like re-search-forward, but stop only in unprotected places."
- (catch 'exit
- (while t
- (unless (apply 're-search-forward args)
- (throw 'exit nil))
- (unless (get-text-property (match-beginning 0) 'org-protected)
- (throw 'exit (point))))))
-
-;; FIXME: Normalize argument names
-(defmacro org-with-remote-undo (_buffer &rest _body)
+(defmacro org-with-remote-undo (buffer &rest body)
"Execute BODY while recording undo information in two buffers."
+ (declare (debug (form body)) (indent 1))
(org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
`(let ((,cline (org-current-line))
(,cmd this-command)
(,buf1 (current-buffer))
- (,buf2 ,_buffer)
+ (,buf2 ,buffer)
(,undo1 buffer-undo-list)
- (,undo2 (with-current-buffer ,_buffer buffer-undo-list))
+ (,undo2 (with-current-buffer ,buffer buffer-undo-list))
,c1 ,c2)
- ,@_body
+ ,@body
(when org-agenda-allow-remote-undo
(setq ,c1 (org-verify-change-for-undo
,undo1 (with-current-buffer ,buf1 buffer-undo-list))
@@ -228,13 +187,11 @@ We use a macro so that the test can happen at compilation time."
;; remember which buffer to undo
(push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
org-agenda-undo-list))))))
-(def-edebug-spec org-with-remote-undo (form body))
-(put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body)
"Inhibit read-only for BODY."
+ (declare (debug (body)))
`(let ((inhibit-read-only t)) ,@body))
-(def-edebug-spec org-no-read-only (body))
(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t
rear-nonsticky t mouse-map t fontified t
@@ -324,14 +281,6 @@ we turn off invisibility temporarily. Use this in a `let' form."
(<= (match-beginning n) pos)
(>= (match-end n) pos)))
-(defun org-autoload (file functions)
- "Establish autoload for all FUNCTIONS in FILE, if not bound already."
- (let ((d (format "Documentation will be available after `%s.el' is loaded."
- file))
- f)
- (while (setq f (pop functions))
- (or (fboundp f) (autoload f file d t)))))
-
(defun org-match-line (re)
"Looking-at at the beginning of the current line."
(save-excursion
@@ -362,7 +311,7 @@ This means that the buffer may change while running BODY,
but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
- (declare (indent 1))
+ (declare (debug (form body)) (indent 1))
(org-with-gensyms (data rtn)
`(let ((,data (org-outline-overlay-data ,use-markers))
,rtn)
@@ -376,24 +325,28 @@ point nowhere."
(and (markerp (cdr c)) (move-marker (cdr c) nil)))
,data)))
,rtn)))
-(def-edebug-spec org-save-outline-visibility (form body))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
+ (declare (debug (body)))
`(save-excursion
(save-restriction
(widen)
,@body)))
-(def-edebug-spec org-with-wide-buffer (body))
(defmacro org-with-limited-levels (&rest body)
"Execute BODY with limited number of outline levels."
- `(let* ((org-called-with-limited-levels t)
- (org-outline-regexp (org-get-limited-outline-regexp))
- (outline-regexp org-outline-regexp)
- (org-outline-regexp-bol (concat "^" org-outline-regexp)))
- ,@body))
-(def-edebug-spec org-with-limited-levels (body))
+ (declare (debug (body)))
+ `(progn
+ (defvar org-called-with-limited-levels)
+ (defvar org-outline-regexp)
+ (defvar outline-regexp)
+ (defvar org-outline-regexp-bol)
+ (let* ((org-called-with-limited-levels t)
+ (org-outline-regexp (org-get-limited-outline-regexp))
+ (outline-regexp org-outline-regexp)
+ (org-outline-regexp-bol (concat "^" org-outline-regexp)))
+ ,@body)))
(defvar org-outline-regexp) ; defined in org.el
(defvar org-odd-levels-only) ; defined in org.el
@@ -414,9 +367,8 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(format-time-string string (seconds-to-time seconds))))
(defmacro org-eval-in-environment (environment form)
+ (declare (debug (form form)) (indent 1))
`(eval (list 'let ,environment ',form)))
-(def-edebug-spec org-eval-in-environment (form form))
-(put 'org-eval-in-environment 'lisp-indent-function 1)
(defun org-make-parameter-alist (flat)
"Return alist based on FLAT.
@@ -427,6 +379,13 @@ the value in cdr."
(cons (list (car flat) (cadr flat))
(org-make-parameter-alist (cddr flat)))))
+;;;###autoload
+(defmacro org-load-noerror-mustsuffix (file)
+ "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it."
+ (if (featurep 'xemacs)
+ `(load ,file 'noerror)
+ `(load ,file 'noerror nil nil 'mustsuffix)))
+
(provide 'org-macs)
;;; org-macs.el ends here
diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el
deleted file mode 100644
index 820988bdbb4..00000000000
--- a/lisp/org/org-mew.el
+++ /dev/null
@@ -1,136 +0,0 @@
-;;; org-mew.el --- Support for links to Mew messages from within Org-mode
-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
-
-;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements links to Mew messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'org)
-
-(defgroup org-mew nil
- "Options concerning the Mew link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-mew-link-to-refile-destination t
- "Create a link to the refile destination if the message is marked as refile."
- :group 'org-mew
- :type 'boolean)
-
-;; Declare external functions and variables
-(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
-(declare-function mew-case-folder "ext:mew-func" (case folder))
-(declare-function mew-header-get-value "ext:mew-header"
- (field &optional as-list))
-(declare-function mew-init "ext:mew" ())
-(declare-function mew-refile-get "ext:mew-refile" (msg))
-(declare-function mew-sinfo-get-case "ext:mew-summary" ())
-(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
-(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
-(declare-function mew-summary-get-mark "ext:mew-mark" ())
-(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
-(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
- (pattern folder src-msgs))
-(declare-function mew-summary-search-msg "ext:mew-const" (msg))
-(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
-(declare-function mew-summary-visit-folder "ext:mew-summary4"
- (folder &optional goend no-ls))
-(declare-function mew-window-push "ext:mew" ())
-(defvar mew-init-p)
-(defvar mew-summary-goto-line-then-display)
-
-;; Install the link type
-(org-add-link-type "mew" 'org-mew-open)
-(add-hook 'org-store-link-functions 'org-mew-store-link)
-
-;; Implementation
-(defun org-mew-store-link ()
- "Store a link to a Mew folder or message."
- (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
- (let* ((msgnum (mew-summary-message-number2))
- (mark-info (mew-summary-get-mark))
- (folder-name
- (if (and org-mew-link-to-refile-destination
- (eq mark-info ?o)) ; marked as refile
- (mew-case-folder (mew-sinfo-get-case)
- (nth 1 (mew-refile-get msgnum)))
- (mew-summary-folder-name)))
- message-id from to subject desc link date date-ts date-ts-ia)
- (save-window-excursion
- (if (fboundp 'mew-summary-set-message-buffer)
- (mew-summary-set-message-buffer folder-name msgnum)
- (set-buffer (mew-cache-hit folder-name msgnum t)))
- (setq message-id (mew-header-get-value "Message-Id:"))
- (setq from (mew-header-get-value "From:"))
- (setq to (mew-header-get-value "To:"))
- (setq date (mew-header-get-value "Date:"))
- (setq date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (setq date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
- (setq subject (mew-header-get-value "Subject:")))
- (org-store-link-props :type "mew" :from from :to to
- :subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (setq message-id (org-remove-angle-brackets message-id))
- (setq desc (org-email-link-description))
- (setq link (concat "mew:" folder-name "#" message-id))
- (org-add-link-props :link link :description desc)
- link)))
-
-(defun org-mew-open (path)
- "Follow the Mew message link specified by PATH."
- (let (folder msgnum)
- (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
- (setq folder (match-string 1 path))
- (setq msgnum (match-string 2 path)))
- ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
- (setq folder (match-string 1 path))
- (setq msgnum (match-string 4 path)))
- (t (error "Error in Mew link")))
- (require 'mew)
- (mew-window-push)
- (unless mew-init-p (mew-init))
- (mew-summary-visit-folder folder)
- (when msgnum
- (if (not (string-match "\\`[0-9]+\\'" msgnum))
- (let* ((pattern (concat "message-id=" msgnum))
- (msgs (mew-summary-pick-with-mewl pattern folder nil)))
- (setq msgnum (car msgs))))
- (if (mew-summary-search-msg msgnum)
- (if mew-summary-goto-line-then-display
- (mew-summary-display))
- (error "Message not found")))))
-
-(provide 'org-mew)
-
-;;; org-mew.el ends here
diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el
index 48767b7b797..e1844406406 100644
--- a/lisp/org/org-mhe.el
+++ b/lisp/org/org-mhe.el
@@ -1,6 +1,6 @@
;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -30,6 +30,7 @@
;;; Code:
+(require 'org-macs)
(require 'org)
;; Customization variables
diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el
deleted file mode 100644
index c614799db82..00000000000
--- a/lisp/org/org-mks.el
+++ /dev/null
@@ -1,134 +0,0 @@
-;;; org-mks.el --- Multi-key-selection for Org-mode
-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;; Commentary:
-;;
-
-;;; Code:
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defun org-mks (table title &optional prompt specials)
- "Select a member of an alist with multiple keys.
-TABLE is the alist which should contain entries where the car is a string.
-There should be two types of entries.
-
-1. prefix descriptions like (\"a\" \"Description\")
- This indicates that `a' is a prefix key for multi-letter selection, and
- that there are entries following with keys like \"ab\", \"ax\"...
-
-2. Selectable members must have more than two elements, with the first
- being the string of keys that lead to selecting it, and the second a
- short description string of the item.
-
-The command will then make a temporary buffer listing all entries
-that can be selected with a single key, and all the single key
-prefixes. When you press the key for a single-letter entry, it is selected.
-When you press a prefix key, the commands (and maybe further prefixes)
-under this key will be shown and offered for selection.
-
-TITLE will be placed over the selection in the temporary buffer,
-PROMPT will be used when prompting for a key. SPECIAL is an alist with
-also (\"key\" \"description\") entries. When one of these is selection,
-only the bare key is returned."
- (setq prompt (or prompt "Select: "))
- (let (tbl orig-table dkey ddesc des-keys allowed-keys
- current prefix rtn re pressed buffer (inhibit-quit t))
- (save-window-excursion
- (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
- (setq orig-table table)
- (catch 'exit
- (while t
- (erase-buffer)
- (insert title "\n\n")
- (setq tbl table
- des-keys nil
- allowed-keys nil)
- (setq prefix (if current (concat current " ") ""))
- (while tbl
- (cond
- ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
- ;; This is a description on this level
- (setq dkey (caar tbl) ddesc (cadar tbl))
- (pop tbl)
- (push dkey des-keys)
- (push dkey allowed-keys)
- (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n")
- ;; Skip keys which are below this prefix
- (setq re (concat "\\`" (regexp-quote dkey)))
- (while (and tbl (string-match re (caar tbl))) (pop tbl)))
- ((= 2 (length (car tbl)))
- ;; Not yet a usable description, skip it
- )
- (t
- ;; usable entry on this level
- (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n")
- (push (caar tbl) allowed-keys)
- (pop tbl))))
- (when specials
- (insert "-------------------------------------------------------------------------------\n")
- (let ((sp specials))
- (while sp
- (insert (format "[%s] %s\n"
- (caar sp) (nth 1 (car sp))))
- (push (caar sp) allowed-keys)
- (pop sp))))
- (push "\C-g" allowed-keys)
- (goto-char (point-min))
- (if (not (pos-visible-in-window-p (point-max)))
- (org-fit-window-to-buffer))
- (message prompt)
- (setq pressed (char-to-string (read-char-exclusive)))
- (while (not (member pressed allowed-keys))
- (message "Invalid key `%s'" pressed) (sit-for 1)
- (message prompt)
- (setq pressed (char-to-string (read-char-exclusive))))
- (when (equal pressed "\C-g")
- (kill-buffer buffer)
- (error "Abort"))
- (when (and (not (assoc pressed table))
- (not (member pressed des-keys))
- (assoc pressed specials))
- (throw 'exit (setq rtn pressed)))
- (unless (member pressed des-keys)
- (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
- orig-table))))
- (setq current (concat current pressed))
- (setq table (mapcar
- (lambda (x)
- (if (and (> (length (car x)) 1)
- (equal (substring (car x) 0 1) pressed))
- (cons (substring (car x) 1) (cdr x))
- nil))
- table))
- (setq table (remove nil table)))))
- (when buffer (kill-buffer buffer))
- rtn))
-
-(provide 'org-mks)
-
-;;; org-mks.el ends here
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index 293d2a000c0..ce74206ec35 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -1,5 +1,5 @@
;;; org-mobile.el --- Code for asymmetric sync with a mobile device
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -76,6 +76,13 @@ org-agenda-text-search-extra-files
:group 'org-mobile
:type 'directory)
+(defcustom org-mobile-allpriorities "A B C"
+ "Default set of priority cookies for the index file."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string
+ :group 'org-mobile)
+
(defcustom org-mobile-use-encryption nil
"Non-nil means keep only encrypted files on the WebDAV server.
Encryption uses AES-256, with a password given in
@@ -276,7 +283,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(list f))
(t nil)))
org-mobile-files)))
- (files (delete
+ (files (delq
nil
(mapcar (lambda (f)
(unless (and (not (string= org-mobile-files-exclude-regexp ""))
@@ -300,8 +307,6 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
(push (cons file link-name) rtn)))
(nreverse rtn)))
-(defvar org-agenda-filter)
-
;;;###autoload
(defun org-mobile-push ()
"Push the current state of Org affairs to the target directory.
@@ -314,23 +319,24 @@ create all custom agenda views, for upload to the mobile phone."
(org-agenda-tag-filter org-agenda-tag-filter)
(org-agenda-redo-command org-agenda-redo-command))
(save-excursion
- (save-window-excursion
- (run-hooks 'org-mobile-pre-push-hook)
- (org-mobile-check-setup)
- (org-mobile-prepare-file-lists)
- (message "Creating agendas...")
- (let ((inhibit-redisplay t)
- (org-agenda-files (mapcar 'car org-mobile-files-alist)))
- (org-mobile-create-sumo-agenda))
- (message "Creating agendas...done")
- (org-save-all-org-buffers) ; to save any IDs created by this process
- (message "Copying files...")
- (org-mobile-copy-agenda-files)
- (message "Writing index file...")
- (org-mobile-create-index-file)
- (message "Writing checksums...")
- (org-mobile-write-checksums)
- (run-hooks 'org-mobile-post-push-hook)))
+ (save-restriction
+ (save-window-excursion
+ (run-hooks 'org-mobile-pre-push-hook)
+ (org-mobile-check-setup)
+ (org-mobile-prepare-file-lists)
+ (message "Creating agendas...")
+ (let ((inhibit-redisplay t)
+ (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+ (org-mobile-create-sumo-agenda))
+ (message "Creating agendas...done")
+ (org-save-all-org-buffers) ; to save any IDs created by this process
+ (message "Copying files...")
+ (org-mobile-copy-agenda-files)
+ (message "Writing index file...")
+ (org-mobile-create-index-file)
+ (message "Writing checksums...")
+ (org-mobile-write-checksums)
+ (run-hooks 'org-mobile-post-push-hook))))
(setq org-agenda-buffer-name org-agenda-curbuf-name
org-agenda-this-buffer-name org-agenda-curbuf-name))
(redraw-display)
@@ -454,6 +460,7 @@ agenda view showing the flagged items."
((stringp x) x)
((eq (car x) :startgroup) "{")
((eq (car x) :endgroup) "}")
+ ((eq (car x) :grouptags) nil)
((eq (car x) :newline) nil)
((listp x) (car x))))
def-tags))
@@ -463,7 +470,7 @@ agenda view showing the flagged items."
(setq tags (append def-tags tags nil))
(insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
(insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
- (insert "#+ALLPRIORITIES: A B C" "\n")
+ (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
(when (file-exists-p (expand-file-name
org-mobile-directory "agendas.org"))
(insert "* [[file:agendas.org][Agenda Views]]\n"))
@@ -1061,8 +1068,11 @@ be returned that indicates what went wrong."
(t (error "Heading changed in MobileOrg and on the computer")))))
((eq what 'addheading)
- (if (org-on-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
+ ;; Workaround a `org-insert-heading-respect-content' bug
+ ;; which prevents correct insertion when point is invisible
+ (org-show-subtree)
(end-of-line 1)
(org-insert-heading-respect-content t)
(org-demote))
@@ -1073,7 +1083,7 @@ be returned that indicates what went wrong."
((eq what 'refile)
(org-copy-subtree)
(org-with-point-at (org-mobile-locate-entry new)
- (if (org-on-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
(setq level (org-get-valid-level (funcall outline-level) 1))
(org-end-of-subtree t t)
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index fac43e4bc49..a1ddc5db79c 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -1,6 +1,6 @@
;;; org-mouse.el --- Better mouse support for org-mode
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
@@ -191,7 +191,7 @@ Changing this variable requires a restart of Emacs to get activated."
(interactive)
(end-of-line)
(skip-chars-backward "\t ")
- (when (org-looking-back ":[A-Za-z]+:")
+ (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position))
(skip-chars-backward ":A-Za-z")
(skip-chars-backward "\t ")))
@@ -378,7 +378,7 @@ nor a function, elements of KEYWORDS are used directly."
(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
"Regular expression matching the priority indicator.
Differs from `org-priority-regexp' in that it doesn't contain the
-leading '.*?'.")
+leading `.*?'.")
(defun org-mouse-get-priority (&optional default)
"Return the priority of the current headline.
@@ -539,7 +539,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
((stringp (nth 2 entry))
(concat (org-mouse-agenda-type (nth 1 entry))
(nth 2 entry)))
- (t "Agenda Command '%s'"))
+ (t "Agenda Command `%s'"))
30))))
"--"
["Delete Blank Lines" delete-blank-lines
@@ -566,7 +566,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(save-excursion (org-apply-on-list wrap-fun nil)))))
(defun org-mouse-bolp ()
- "Return true if there only spaces, tabs, and '*' before point.
+ "Return true if there only spaces, tabs, and `*' before point.
This means, between the beginning of line and the point."
(save-excursion
(skip-chars-backward " \t*") (bolp)))
@@ -645,7 +645,7 @@ This means, between the beginning of line and the point."
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t")))
+ (org-looking-back " \\|\t" (- (point) 2))))
(org-mouse-popup-global-menu))
((funcall get-context :checkbox)
(popup-menu
@@ -656,11 +656,11 @@ This means, between the beginning of line and the point."
["All Clear" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
- (replace-match "[ ]"))))]
+ (replace-match "[ ] "))))]
["All Set" (org-mouse-for-each-item
(lambda ()
(when (save-excursion (org-at-item-checkbox-p))
- (replace-match "[X]"))))]
+ (replace-match "[X] "))))]
["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
["All Remove" (org-mouse-for-each-item
(lambda ()
@@ -708,9 +708,9 @@ This means, between the beginning of line and the point."
((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
(popup-menu
`(nil
- [,(format "Display '%s'" (match-string 1))
+ [,(format-message "Display `%s'" (match-string 1))
(org-tags-view nil ,(match-string 1))]
- [,(format "Sparse Tree '%s'" (match-string 1))
+ [,(format-message "Sparse Tree `%s'" (match-string 1))
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
@@ -953,20 +953,23 @@ This means, between the beginning of line and the point."
(point)
(save-excursion (goto-char start)
(org-back-to-heading) (point))))
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(end-of-line)
(if (eobp) (newline) (forward-char))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(when (bolp) (delete-char -1))))))))))
@@ -1003,9 +1006,9 @@ This means, between the beginning of line and the point."
(org-mouse-main-buffer (current-buffer)))
(when (eq (with-current-buffer buffer major-mode) 'org-mode)
(let ((endmarker (with-current-buffer buffer
- (outline-end-of-subtree)
- (forward-char 1)
- (copy-marker (point)))))
+ (org-end-of-subtree nil t)
+ (unless (eobp) (forward-char 1))
+ (point-marker))))
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
@@ -1015,7 +1018,7 @@ This means, between the beginning of line and the point."
(and (outline-next-heading)
(org-flag-heading nil))) ; show the next heading
(org-back-to-heading)
- (setq marker (copy-marker (point)))
+ (setq marker (point-marker))
(goto-char (max (point-at-bol) (- (point-at-eol) anticol)))
(funcall command)
(message "_cmd: %S" org-mouse-cmd)
@@ -1056,7 +1059,7 @@ This means, between the beginning of line and the point."
["Convert" org-agenda-convert-date
(org-agenda-check-type nil 'agenda 'timeline)]
"--"
- ["Create iCalendar file" org-export-icalendar-combine-agenda-files t])
+ ["Create iCalendar file" org-icalendar-combine-agenda-files t])
"--"
["Day View" org-agenda-day-view
:active (org-agenda-check-type nil 'agenda)
diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el
deleted file mode 100644
index 92228f37eb8..00000000000
--- a/lisp/org/org-odt.el
+++ /dev/null
@@ -1,2859 +0,0 @@
-;;; org-odt.el --- OpenDocument Text exporter for Org-mode
-
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
-
-;; Author: Jambunathan K <kjambunathan at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'org-lparse)
-
-(defgroup org-export-odt nil
- "Options specific for ODT export of Org-mode files."
- :tag "Org Export ODT"
- :group 'org-export
- :version "24.1")
-
-(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse
-(defun org-odt-insert-toc ()
- (goto-char (point-min))
- (cond
- ((re-search-forward
- "\\(<text:p [^>]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(</text:p>\\)?"
- nil t)
- (replace-match ""))
- (t
- (goto-char org-lparse-dyn-first-heading-pos)))
- (insert (org-odt-format-toc)))
-
-(defun org-odt-end-export ()
- (org-odt-insert-toc)
- (org-odt-fixup-label-references)
-
- ;; remove empty paragraphs
- (goto-char (point-min))
- (while (re-search-forward
- "<text:p\\( text:style-name=\"Text_20_body\"\\)?>[ \r\n\t]*</text:p>"
- nil t)
- (replace-match ""))
- (goto-char (point-min))
-
- ;; Convert whitespace place holders
- (goto-char (point-min))
- (let (beg end n)
- (while (setq beg (next-single-property-change (point) 'org-whitespace))
- (setq n (get-text-property beg 'org-whitespace)
- end (next-single-property-change beg 'org-whitespace))
- (goto-char beg)
- (delete-region beg end)
- (insert (format "<span style=\"visibility:hidden;\">%s</span>"
- (make-string n ?x)))))
-
- ;; Remove empty lines at the beginning of the file.
- (goto-char (point-min))
- (when (looking-at "\\s-+\n") (replace-match ""))
-
- ;; Remove display properties
- (remove-text-properties (point-min) (point-max) '(display t)))
-
-(defvar org-odt-suppress-xref nil)
-(defconst org-export-odt-special-string-regexps
- '(("\\\\-" . "&#x00ad;\\1") ; shy
- ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
- ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
- ("\\.\\.\\." . "&#x2026;")) ; hellip
- "Regular expressions for special string conversion.")
-
-(defconst org-odt-lib-dir (file-name-directory load-file-name)
- "Location of ODT exporter.
-Use this to infer values of `org-odt-styles-dir' and
-`org-export-odt-schema-dir'.")
-
-(defvar org-odt-data-dir nil
- "Data directory for ODT exporter.
-Use this to infer values of `org-odt-styles-dir' and
-`org-export-odt-schema-dir'.")
-
-(defconst org-odt-schema-dir-list
- (list
- (and org-odt-data-dir
- (expand-file-name "./schema/" org-odt-data-dir)) ; bail out
- (eval-when-compile
- (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
- (expand-file-name "./schema/" org-odt-data-dir))))
- "List of directories to search for OpenDocument schema files.
-Use this list to set the default value of
-`org-export-odt-schema-dir'. The entries in this list are
-populated heuristically based on the values of `org-odt-lib-dir'
-and `org-odt-data-dir'.")
-
-(defcustom org-export-odt-schema-dir
- (let* ((schema-dir
- (catch 'schema-dir
- (message "Debug (org-odt): Searching for OpenDocument schema files...")
- (mapc
- (lambda (schema-dir)
- (when schema-dir
- (message "Debug (org-odt): Trying %s..." schema-dir)
- (when (and (file-readable-p
- (expand-file-name "od-manifest-schema-v1.2-cs01.rnc"
- schema-dir))
- (file-readable-p
- (expand-file-name "od-schema-v1.2-cs01.rnc"
- schema-dir))
- (file-readable-p
- (expand-file-name "schemas.xml" schema-dir)))
- (message "Debug (org-odt): Using schema files under %s"
- schema-dir)
- (throw 'schema-dir schema-dir))))
- org-odt-schema-dir-list)
- (message "Debug (org-odt): No OpenDocument schema files installed")
- nil)))
- schema-dir)
- "Directory that contains OpenDocument schema files.
-
-This directory contains:
-1. rnc files for OpenDocument schema
-2. a \"schemas.xml\" file that specifies locating rules needed
- for auto validation of OpenDocument XML files.
-
-Use the customize interface to set this variable. This ensures
-that `rng-schema-locating-files' is updated and auto-validation
-of OpenDocument XML takes place based on the value
-`rng-nxml-auto-validate-flag'.
-
-The default value of this variable varies depending on the
-version of org in use and is initialized from
-`org-odt-schema-dir-list'. The OASIS schema files are available
-only in the org's private git repository. It is *not* bundled
-with GNU ELPA tar or standard Emacs distribution."
- :type '(choice
- (const :tag "Not set" nil)
- (directory :tag "Schema directory"))
- :group 'org-export-odt
- :version "24.1"
- :set
- (lambda (var value)
- "Set `org-export-odt-schema-dir'.
-Also add it to `rng-schema-locating-files'."
- (let ((schema-dir value))
- (set var
- (if (and
- (file-readable-p
- (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir))
- (file-readable-p
- (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir))
- (file-readable-p
- (expand-file-name "schemas.xml" schema-dir)))
- schema-dir
- (when value
- (message "Error (org-odt): %s has no OpenDocument schema files"
- value))
- nil)))
- (when org-export-odt-schema-dir
- (eval-after-load 'rng-loc
- '(add-to-list 'rng-schema-locating-files
- (expand-file-name "schemas.xml"
- org-export-odt-schema-dir))))))
-
-(defconst org-odt-styles-dir-list
- (list
- (and org-odt-data-dir
- (expand-file-name "./styles/" org-odt-data-dir)) ; bail out
- (eval-when-compile
- (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
- (expand-file-name "./styles/" org-odt-data-dir)))
- (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
- (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
- (expand-file-name "./org/" data-directory) ; system
- )
- "List of directories to search for OpenDocument styles files.
-See `org-odt-styles-dir'. The entries in this list are populated
-heuristically based on the values of `org-odt-lib-dir' and
-`org-odt-data-dir'.")
-
-(defconst org-odt-styles-dir
- (let* ((styles-dir
- (catch 'styles-dir
- (message "Debug (org-odt): Searching for OpenDocument styles files...")
- (mapc (lambda (styles-dir)
- (when styles-dir
- (message "Debug (org-odt): Trying %s..." styles-dir)
- (when (and (file-readable-p
- (expand-file-name
- "OrgOdtContentTemplate.xml" styles-dir))
- (file-readable-p
- (expand-file-name
- "OrgOdtStyles.xml" styles-dir)))
- (message "Debug (org-odt): Using styles under %s"
- styles-dir)
- (throw 'styles-dir styles-dir))))
- org-odt-styles-dir-list)
- nil)))
- (unless styles-dir
- (error "Error (org-odt): Cannot find factory styles files, aborting"))
- styles-dir)
- "Directory that holds auxiliary XML files used by the ODT exporter.
-
-This directory contains the following XML files -
- \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
- XML files are used as the default values of
- `org-export-odt-styles-file' and
- `org-export-odt-content-template-file'.
-
-The default value of this variable varies depending on the
-version of org in use and is initialized from
-`org-odt-styles-dir-list'. Note that the user could be using org
-from one of: org's own private git repository, GNU ELPA tar or
-standard Emacs.")
-
-(defvar org-odt-file-extensions
- '(("odt" . "OpenDocument Text")
- ("ott" . "OpenDocument Text Template")
- ("odm" . "OpenDocument Master Document")
- ("ods" . "OpenDocument Spreadsheet")
- ("ots" . "OpenDocument Spreadsheet Template")
- ("odg" . "OpenDocument Drawing (Graphics)")
- ("otg" . "OpenDocument Drawing Template")
- ("odp" . "OpenDocument Presentation")
- ("otp" . "OpenDocument Presentation Template")
- ("odi" . "OpenDocument Image")
- ("odf" . "OpenDocument Formula")
- ("odc" . "OpenDocument Chart")))
-
-(mapc
- (lambda (desc)
- ;; Let Emacs open all OpenDocument files in archive mode
- (add-to-list 'auto-mode-alist
- (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
- org-odt-file-extensions)
-
-;; register the odt exporter with the pre-processor
-(add-to-list 'org-export-backends 'odt)
-
-;; register the odt exporter with org-lparse library
-(org-lparse-register-backend 'odt)
-
-(defun org-odt-unload-function ()
- (org-lparse-unregister-backend 'odt)
- (remove-hook 'org-export-preprocess-after-blockquote-hook
- 'org-export-odt-preprocess-latex-fragments)
- nil)
-
-(defcustom org-export-odt-content-template-file nil
- "Template file for \"content.xml\".
-The exporter embeds the exported content just before
-\"</office:text>\" element.
-
-If unspecified, the file named \"OrgOdtContentTemplate.xml\"
-under `org-odt-styles-dir' is used."
- :type 'file
- :group 'org-export-odt
- :version "24.1")
-
-(defcustom org-export-odt-styles-file nil
- "Default styles file for use with ODT export.
-Valid values are one of:
-1. nil
-2. path to a styles.xml file
-3. path to a *.odt or a *.ott file
-4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
-...))
-
-In case of option 1, an in-built styles.xml is used. See
-`org-odt-styles-dir' for more information.
-
-In case of option 3, the specified file is unzipped and the
-styles.xml embedded therein is used.
-
-In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
-and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
-generated odt file. Use relative path for specifying the
-FILE-MEMBERS. styles.xml must be specified as one of the
-FILE-MEMBERS.
-
-Use options 1, 2 or 3 only if styles.xml alone suffices for
-achieving the desired formatting. Use option 4, if the styles.xml
-references additional files like header and footer images for
-achieving the desired formatting.
-
-Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
-a per-file basis. For example,
-
-#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
-#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
- :group 'org-export-odt
- :version "24.1"
- :type
- '(choice
- (const :tag "Factory settings" nil)
- (file :must-match t :tag "styles.xml")
- (file :must-match t :tag "ODT or OTT file")
- (list :tag "ODT or OTT file + Members"
- (file :must-match t :tag "ODF Text or Text Template file")
- (cons :tag "Members"
- (file :tag " Member" "styles.xml")
- (repeat (file :tag "Member"))))))
-
-(eval-after-load 'org-exp
- '(add-to-list 'org-export-inbuffer-options-extra
- '("ODT_STYLES_FILE" :odt-styles-file)))
-
-(defconst org-export-odt-tmpdir-prefix "%s-")
-(defconst org-export-odt-bookmark-prefix "OrgXref.")
-(defvar org-odt-zip-dir nil
- "Temporary directory that holds XML files during export.")
-
-(defvar org-export-odt-embed-images t
- "Should the images be copied in to the odt file or just linked?")
-
-(defvar org-export-odt-inline-images 'maybe)
-(defcustom org-export-odt-inline-image-extensions
- '("png" "jpeg" "jpg" "gif")
- "Extensions of image files that can be inlined into HTML."
- :type '(repeat (string :tag "Extension"))
- :group 'org-export-odt
- :version "24.1")
-
-(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch
- "Scaling factor for converting images pixels to inches.
-Use this for sizing of embedded images. See Info node `(org)
-Images in ODT export' for more information."
- :type 'float
- :group 'org-export-odt
- :version "24.1")
-
-(defcustom org-export-odt-create-custom-styles-for-srcblocks t
- "Whether custom styles for colorized source blocks be automatically created.
-When this option is turned on, the exporter creates custom styles
-for source blocks based on the advice of `htmlfontify'. Creation
-of custom styles happen as part of `org-odt-hfy-face-to-css'.
-
-When this option is turned off exporter does not create such
-styles.
-
-Use the latter option if you do not want the custom styles to be
-based on your current display settings. It is necessary that the
-styles.xml already contains needed styles for colorizing to work.
-
-This variable is effective only if
-`org-export-odt-fontify-srcblocks' is turned on."
- :group 'org-export-odt
- :version "24.1"
- :type 'boolean)
-
-(defvar org-export-odt-default-org-styles-alist
- '((paragraph . ((default . "Text_20_body")
- (fixedwidth . "OrgFixedWidthBlock")
- (verse . "OrgVerse")
- (quote . "Quotations")
- (blockquote . "Quotations")
- (center . "OrgCenter")
- (left . "OrgLeft")
- (right . "OrgRight")
- (title . "OrgTitle")
- (subtitle . "OrgSubtitle")
- (footnote . "Footnote")
- (src . "OrgSrcBlock")
- (illustration . "Illustration")
- (table . "Table")
- (definition-term . "Text_20_body_20_bold")
- (horizontal-line . "Horizontal_20_Line")))
- (character . ((default . "Default")
- (bold . "Bold")
- (emphasis . "Emphasis")
- (code . "OrgCode")
- (verbatim . "OrgCode")
- (strike . "Strikethrough")
- (underline . "Underline")
- (subscript . "OrgSubscript")
- (superscript . "OrgSuperscript")))
- (list . ((ordered . "OrgNumberedList")
- (unordered . "OrgBulletedList")
- (description . "OrgDescriptionList"))))
- "Default styles for various entities.")
-
-(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist)
-(defun org-odt-get-style-name-for-entity (category &optional entity)
- (let ((entity (or entity 'default)))
- (or
- (cdr (assoc entity (cdr (assoc category
- org-export-odt-org-styles-alist))))
- (cdr (assoc entity (cdr (assoc category
- org-export-odt-default-org-styles-alist))))
- (error "Cannot determine style name for entity %s of type %s"
- entity category))))
-
-(defcustom org-export-odt-preferred-output-format nil
- "Automatically post-process to this format after exporting to \"odt\".
-Interactive commands `org-export-as-odt' and
-`org-export-as-odt-and-open' export first to \"odt\" format and
-then use `org-export-odt-convert-process' to convert the
-resulting document to this format. During customization of this
-variable, the list of valid values are populated based on
-`org-export-odt-convert-capabilities'.
-
-You can set this option on per-file basis using file local
-values. See Info node `(emacs) File Variables'."
- :group 'org-export-odt
- :version "24.1"
- :type '(choice :convert-widget
- (lambda (w)
- (apply 'widget-convert (widget-type w)
- (eval (car (widget-get w :args)))))
- `((const :tag "None" nil)
- ,@(mapcar (lambda (c)
- `(const :tag ,c ,c))
- (org-lparse-reachable-formats "odt")))))
-;;;###autoload
-(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp)
-
-(defmacro org-odt-cleanup-xml-buffers (&rest body)
- `(let ((org-odt-zip-dir
- (make-temp-file
- (format org-export-odt-tmpdir-prefix "odf") t))
- (--cleanup-xml-buffers
- (function
- (lambda nil
- (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
- "meta.xml" "styles.xml")))
- ;; kill all xml buffers
- (mapc (lambda (file)
- (with-current-buffer
- (find-file-noselect
- (expand-file-name file org-odt-zip-dir) t)
- (set-buffer-modified-p nil)
- (kill-buffer)))
- xml-files))
- ;; delete temporary directory.
- (org-delete-directory org-odt-zip-dir t)))))
- (condition-case err
- (prog1 (progn ,@body)
- (funcall --cleanup-xml-buffers))
- ((quit error)
- (funcall --cleanup-xml-buffers)
- (message "OpenDocument export failed: %s"
- (error-message-string err))))))
-
-;;;###autoload
-(defun org-export-as-odt-and-open (arg)
- "Export the outline as ODT and immediately open it with a browser.
-If there is an active region, export only the region.
-The prefix ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will become bulleted lists."
- (interactive "P")
- (org-odt-cleanup-xml-buffers
- (org-lparse-and-open
- (or org-export-odt-preferred-output-format "odt") "odt" arg)))
-
-;;;###autoload
-(defun org-export-as-odt-batch ()
- "Call the function `org-lparse-batch'.
-This function can be used in batch processing as:
-emacs --batch
- --load=$HOME/lib/emacs/org.el
- --eval \"(setq org-export-headline-levels 2)\"
- --visit=MyFile --funcall org-export-as-odt-batch"
- (org-odt-cleanup-xml-buffers (org-lparse-batch "odt")))
-
-;;; org-export-as-odt
-;;;###autoload
-(defun org-export-as-odt (arg &optional hidden ext-plist
- to-buffer body-only pub-dir)
- "Export the outline as a OpenDocumentText file.
-If there is an active region, export only the region. The prefix
-ARG specifies how many levels of the outline should become
-headlines. The default is 3. Lower levels will become bulleted
-lists. HIDDEN is obsolete and does nothing.
-EXT-PLIST is a property list with external parameters overriding
-org-mode's default settings, but still inferior to file-local
-settings. When TO-BUFFER is non-nil, create a buffer with that
-name and export to that buffer. If TO-BUFFER is the symbol
-`string', don't leave any buffer behind but just return the
-resulting XML as a string. When BODY-ONLY is set, don't produce
-the file header and footer, simply return the content of
-<body>...</body>, without even the body tags themselves. When
-PUB-DIR is set, use this as the publishing directory."
- (interactive "P")
- (org-odt-cleanup-xml-buffers
- (org-lparse (or org-export-odt-preferred-output-format "odt")
- "odt" arg hidden ext-plist to-buffer body-only pub-dir)))
-
-(defvar org-odt-entity-control-callbacks-alist
- `((EXPORT
- . (org-odt-begin-export org-odt-end-export))
- (DOCUMENT-CONTENT
- . (org-odt-begin-document-content org-odt-end-document-content))
- (DOCUMENT-BODY
- . (org-odt-begin-document-body org-odt-end-document-body))
- (TOC
- . (org-odt-begin-toc org-odt-end-toc))
- (ENVIRONMENT
- . (org-odt-begin-environment org-odt-end-environment))
- (FOOTNOTE-DEFINITION
- . (org-odt-begin-footnote-definition org-odt-end-footnote-definition))
- (TABLE
- . (org-odt-begin-table org-odt-end-table))
- (TABLE-ROWGROUP
- . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup))
- (LIST
- . (org-odt-begin-list org-odt-end-list))
- (LIST-ITEM
- . (org-odt-begin-list-item org-odt-end-list-item))
- (OUTLINE
- . (org-odt-begin-outline org-odt-end-outline))
- (OUTLINE-TEXT
- . (org-odt-begin-outline-text org-odt-end-outline-text))
- (PARAGRAPH
- . (org-odt-begin-paragraph org-odt-end-paragraph)))
- "")
-
-(defvar org-odt-entity-format-callbacks-alist
- `((EXTRA-TARGETS . org-lparse-format-extra-targets)
- (ORG-TAGS . org-lparse-format-org-tags)
- (SECTION-NUMBER . org-lparse-format-section-number)
- (HEADLINE . org-odt-format-headline)
- (TOC-ENTRY . org-odt-format-toc-entry)
- (TOC-ITEM . org-odt-format-toc-item)
- (TAGS . org-odt-format-tags)
- (SPACES . org-odt-format-spaces)
- (TABS . org-odt-format-tabs)
- (LINE-BREAK . org-odt-format-line-break)
- (FONTIFY . org-odt-format-fontify)
- (TODO . org-lparse-format-todo)
- (LINK . org-odt-format-link)
- (INLINE-IMAGE . org-odt-format-inline-image)
- (ORG-LINK . org-odt-format-org-link)
- (HEADING . org-odt-format-heading)
- (ANCHOR . org-odt-format-anchor)
- (TABLE . org-lparse-format-table)
- (TABLE-ROW . org-odt-format-table-row)
- (TABLE-CELL . org-odt-format-table-cell)
- (FOOTNOTES-SECTION . ignore)
- (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference)
- (HORIZONTAL-LINE . org-odt-format-horizontal-line)
- (COMMENT . org-odt-format-comment)
- (LINE . org-odt-format-line)
- (ORG-ENTITY . org-odt-format-org-entity))
- "")
-
-;;;_. callbacks
-;;;_. control callbacks
-;;;_ , document body
-(defun org-odt-begin-office-body ()
- ;; automatic styles
- (insert-file-contents
- (or org-export-odt-content-template-file
- (expand-file-name "OrgOdtContentTemplate.xml"
- org-odt-styles-dir)))
- (goto-char (point-min))
- (re-search-forward "</office:text>" nil nil)
- (delete-region (match-beginning 0) (point-max)))
-
-;; Following variable is let bound when `org-do-lparse' is in
-;; progress. See org-html.el.
-(defvar org-lparse-toc)
-(defun org-odt-format-toc ()
- (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n")))
-
-(defun org-odt-format-preamble (opt-plist)
- (let* ((title (plist-get opt-plist :title))
- (author (plist-get opt-plist :author))
- (date (plist-get opt-plist :date))
- (iso-date (org-odt-format-date date))
- (date (org-odt-format-date date "%d %b %Y"))
- (email (plist-get opt-plist :email))
- ;; switch on or off above vars based on user settings
- (author (and (plist-get opt-plist :author-info) (or author email)))
- (email (and (plist-get opt-plist :email-info) email))
- (date (and (plist-get opt-plist :time-stamp-file) date)))
- (concat
- ;; title
- (when title
- (concat
- (org-odt-format-stylized-paragraph
- 'title (org-odt-format-tags
- '("<text:title>" . "</text:title>") title))
- ;; separator
- "<text:p text:style-name=\"OrgTitle\"/>"))
- (cond
- ((and author (not email))
- ;; author only
- (concat
- (org-odt-format-stylized-paragraph
- 'subtitle
- (org-odt-format-tags
- '("<text:initial-creator>" . "</text:initial-creator>")
- author))
- ;; separator
- "<text:p text:style-name=\"OrgSubtitle\"/>"))
- ((and author email)
- ;; author and email
- (concat
- (org-odt-format-stylized-paragraph
- 'subtitle
- (org-odt-format-link
- (org-odt-format-tags
- '("<text:initial-creator>" . "</text:initial-creator>")
- author) (concat "mailto:" email)))
- ;; separator
- "<text:p text:style-name=\"OrgSubtitle\"/>")))
- ;; date
- (when date
- (concat
- (org-odt-format-stylized-paragraph
- 'subtitle
- (org-odt-format-tags
- '("<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">"
- . "</text:date>") date "N75" iso-date))
- ;; separator
- "<text:p text:style-name=\"OrgSubtitle\"/>")))))
-
-(defun org-odt-begin-document-body (opt-plist)
- (org-odt-begin-office-body)
- (insert (org-odt-format-preamble opt-plist))
- (setq org-lparse-dyn-first-heading-pos (point)))
-
-(defvar org-lparse-body-only) ; let bound during org-do-lparse
-(defvar org-lparse-to-buffer) ; let bound during org-do-lparse
-(defun org-odt-end-document-body (opt-plist)
- (unless org-lparse-body-only
- (org-lparse-insert-tag "</office:text>")
- (org-lparse-insert-tag "</office:body>")))
-
-(defun org-odt-begin-document-content (opt-plist)
- (ignore))
-
-(defun org-odt-end-document-content ()
- (org-lparse-insert-tag "</office:document-content>"))
-
-(defun org-odt-begin-outline (level1 snumber title tags
- target extra-targets class)
- (org-lparse-insert
- 'HEADING (org-lparse-format
- 'HEADLINE title extra-targets tags snumber level1)
- level1 target))
-
-(defun org-odt-end-outline ()
- (ignore))
-
-(defun org-odt-begin-outline-text (level1 snumber class)
- (ignore))
-
-(defun org-odt-end-outline-text ()
- (ignore))
-
-(defun org-odt-begin-section (style &optional name)
- (let ((default-name (car (org-odt-add-automatic-style "Section"))))
- (org-lparse-insert-tag
- "<text:section text:style-name=\"%s\" text:name=\"%s\">"
- style (or name default-name))))
-
-(defun org-odt-end-section ()
- (org-lparse-insert-tag "</text:section>"))
-
-(defun org-odt-begin-paragraph (&optional style)
- (org-lparse-insert-tag
- "<text:p%s>" (org-odt-get-extra-attrs-for-paragraph-style style)))
-
-(defun org-odt-end-paragraph ()
- (org-lparse-insert-tag "</text:p>"))
-
-(defun org-odt-get-extra-attrs-for-paragraph-style (style)
- (let (style-name)
- (setq style-name
- (cond
- ((stringp style) style)
- ((symbolp style) (org-odt-get-style-name-for-entity
- 'paragraph style))))
- (unless style-name
- (error "Don't know how to handle paragraph style %s" style))
- (format " text:style-name=\"%s\"" style-name)))
-
-(defun org-odt-format-stylized-paragraph (style text)
- (org-odt-format-tags
- '("<text:p%s>" . "</text:p>") text
- (org-odt-get-extra-attrs-for-paragraph-style style)))
-
-(defvar org-lparse-opt-plist) ; bound during org-do-lparse
-(defun org-odt-format-author (&optional author)
- (when (setq author (or author (plist-get org-lparse-opt-plist :author)))
- (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author)))
-
-(defun org-odt-format-date (&optional org-ts fmt)
- (save-match-data
- (let* ((time
- (and (stringp org-ts)
- (string-match org-ts-regexp0 org-ts)
- (apply 'encode-time
- (org-fix-decoded-time
- (org-parse-time-string (match-string 0 org-ts) t)))))
- date)
- (cond
- (fmt (format-time-string fmt time))
- (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time))
- (format "%s:%s" (substring date 0 -2) (substring date -2)))))))
-
-(defun org-odt-begin-annotation (&optional author date)
- (org-lparse-insert-tag "<office:annotation>")
- (when (setq author (org-odt-format-author author))
- (insert author))
- (insert (org-odt-format-tags
- '("<dc:date>" . "</dc:date>")
- (org-odt-format-date
- (or date (plist-get org-lparse-opt-plist :date)))))
- (org-lparse-begin-paragraph))
-
-(defun org-odt-end-annotation ()
- (org-lparse-insert-tag "</office:annotation>"))
-
-(defun org-odt-begin-environment (style env-options-plist)
- (case style
- (annotation
- (org-lparse-stash-save-paragraph-state)
- (org-odt-begin-annotation (plist-get env-options-plist 'author)
- (plist-get env-options-plist 'date)))
- ((blockquote verse center quote)
- (org-lparse-begin-paragraph style)
- (list))
- ((fixedwidth native)
- (org-lparse-end-paragraph)
- (list))
- (t (error "Unknown environment %s" style))))
-
-(defun org-odt-end-environment (style env-options-plist)
- (case style
- (annotation
- (org-lparse-end-paragraph)
- (org-odt-end-annotation)
- (org-lparse-stash-pop-paragraph-state))
- ((blockquote verse center quote)
- (org-lparse-end-paragraph)
- (list))
- ((fixedwidth native)
- (org-lparse-begin-paragraph)
- (list))
- (t (error "Unknown environment %s" style))))
-
-(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse
-(defvar org-odt-list-stack-stashed)
-(defun org-odt-begin-list (ltype)
- (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
- ltype))
- (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype))
- (extra (concat (if (or org-lparse-list-table-p
- (and (= 1 (length org-lparse-list-stack))
- (null org-odt-list-stack-stashed)))
- " text:continue-numbering=\"false\""
- " text:continue-numbering=\"true\"")
- (when style-name
- (format " text:style-name=\"%s\"" style-name)))))
- (case ltype
- ((ordered unordered description)
- (org-lparse-end-paragraph)
- (org-lparse-insert-tag "<text:list%s>" extra))
- (t (error "Unknown list type: %s" ltype)))))
-
-(defun org-odt-end-list (ltype)
- (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
- ltype))
- (if ltype
- (org-lparse-insert-tag "</text:list>")
- (error "Unknown list type: %s" ltype)))
-
-(defun org-odt-begin-list-item (ltype &optional arg headline)
- (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
- ltype))
- (case ltype
- (ordered
- (assert (not headline) t)
- (let* ((counter arg) (extra ""))
- (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
- (length org-odt-list-stack-stashed))
- "<text:list-header>" "<text:list-item>"))
- (org-lparse-begin-paragraph)))
- (unordered
- (let* ((id arg) (extra ""))
- (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
- (length org-odt-list-stack-stashed))
- "<text:list-header>" "<text:list-item>"))
- (org-lparse-begin-paragraph)
- (insert (if headline (org-odt-format-target headline id)
- (org-odt-format-bookmark "" id)))))
- (description
- (assert (not headline) t)
- (let ((term (or arg "(no term)")))
- (insert
- (org-odt-format-tags
- '("<text:list-item>" . "</text:list-item>")
- (org-odt-format-stylized-paragraph 'definition-term term)))
- (org-lparse-begin-list-item 'unordered)
- (org-lparse-begin-list 'description)
- (org-lparse-begin-list-item 'unordered)))
- (t (error "Unknown list type"))))
-
-(defun org-odt-end-list-item (ltype)
- (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype)
- ltype))
- (case ltype
- ((ordered unordered)
- (org-lparse-insert-tag (if (= (length org-lparse-list-stack)
- (length org-odt-list-stack-stashed))
- (prog1 "</text:list-header>"
- (setq org-odt-list-stack-stashed nil))
- "</text:list-item>")))
- (description
- (org-lparse-end-list-item-1)
- (org-lparse-end-list 'description)
- (org-lparse-end-list-item-1))
- (t (error "Unknown list type"))))
-
-(defun org-odt-discontinue-list ()
- (let ((stashed-stack org-lparse-list-stack))
- (loop for list-type in stashed-stack
- do (org-lparse-end-list-item-1 list-type)
- (org-lparse-end-list list-type))
- (setq org-odt-list-stack-stashed stashed-stack)))
-
-(defun org-odt-continue-list ()
- (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed))
- (loop for list-type in org-odt-list-stack-stashed
- do (org-lparse-begin-list list-type)
- (org-lparse-begin-list-item list-type)))
-
-;; Following variables are let bound when table emission is in
-;; progress. See org-lparse.el.
-(defvar org-lparse-table-begin-marker)
-(defvar org-lparse-table-ncols)
-(defvar org-lparse-table-rowgrp-open)
-(defvar org-lparse-table-rownum)
-(defvar org-lparse-table-cur-rowgrp-is-hdr)
-(defvar org-lparse-table-is-styled)
-(defvar org-lparse-table-rowgrp-info)
-(defvar org-lparse-table-colalign-vector)
-
-(defvar org-odt-table-style nil
- "Table style specified by \"#+ATTR_ODT: <style-name>\" line.
-This is set during `org-odt-begin-table'.")
-
-(defvar org-odt-table-style-spec nil
- "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.")
-
-(defcustom org-export-odt-table-styles
- '(("OrgEquation" "OrgEquation"
- ((use-first-column-styles . t)
- (use-last-column-styles . t))))
- "Specify how Table Styles should be derived from a Table Template.
-This is a list where each element is of the
-form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
-
-TABLE-STYLE-NAME is the style associated with the table through
-`org-odt-table-style'.
-
-TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
-TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
-below) that is included in
-`org-export-odt-content-template-file'.
-
-TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
- \"TableCell\"
-PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
- \"TableParagraph\"
-TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
- \"FirstRow\" | \"LastRow\" |
- \"EvenRow\" | \"OddRow\" |
- \"EvenColumn\" | \"OddColumn\" | \"\"
-where \"+\" above denotes string concatenation.
-
-TABLE-CELL-OPTIONS is an alist where each element is of the
-form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
-TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
- `use-last-row-styles' |
- `use-first-column-styles' |
- `use-last-column-styles' |
- `use-banding-rows-styles' |
- `use-banding-columns-styles' |
- `use-first-row-styles'
-ON-OR-OFF := `t' | `nil'
-
-For example, with the following configuration
-
-\(setq org-export-odt-table-styles
- '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\"
- \(\(use-first-row-styles . t\)
- \(use-first-column-styles . t\)\)\)
- \(\"TableWithHeaderColumns\" \"Custom\"
- \(\(use-first-column-styles . t\)\)\)\)\)
-
-1. A table associated with \"TableWithHeaderRowsAndColumns\"
- style will use the following table-cell styles -
- \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
- \"CustomTableCell\" and the following paragraph styles
- \"CustomFirstRowTableParagraph\",
- \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
- as appropriate.
-
-2. A table associated with \"TableWithHeaderColumns\" style will
- use the following table-cell styles -
- \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
- following paragraph styles
- \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
- as appropriate..
-
-Note that TABLE-TEMPLATE-NAME corresponds to the
-\"<table:table-template>\" elements contained within
-\"<office:styles>\". The entries (TABLE-STYLE-NAME
-TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
-\"table:template-name\" and \"table:use-first-row-styles\" etc
-attributes of \"<table:table>\" element. Refer ODF-1.2
-specification for more information. Also consult the
-implementation filed under `org-odt-get-table-cell-styles'.
-
-The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
-formatting of numbered display equations. Do not delete this
-style from the list."
- :group 'org-export-odt
- :version "24.1"
- :type '(choice
- (const :tag "None" nil)
- (repeat :tag "Table Styles"
- (list :tag "Table Style Specification"
- (string :tag "Table Style Name")
- (string :tag "Table Template Name")
- (alist :options (use-first-row-styles
- use-last-row-styles
- use-first-column-styles
- use-last-column-styles
- use-banding-rows-styles
- use-banding-columns-styles)
- :key-type symbol
- :value-type (const :tag "True" t))))))
-
-(defvar org-odt-table-style-format
- "
-<style:style style:name=\"%s\" style:family=\"table\">
- <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
-</style:style>
-"
- "Template for auto-generated Table styles.")
-
-(defvar org-odt-automatic-styles '()
- "Registry of automatic styles for various OBJECT-TYPEs.
-The variable has the following form:
-\(\(OBJECT-TYPE-A
- \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\)
- \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\)
- \(OBJECT-TYPE-B
- \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\)
- \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\)
- ...\).
-
-OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
-OBJECT-PROPS is (typically) a plist created by passing
-\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'.
-
-Use `org-odt-add-automatic-style' to add update this variable.'")
-
-(defvar org-odt-object-counters nil
- "Running counters for various OBJECT-TYPEs.
-Use this to generate automatic names and style-names. See
-`org-odt-add-automatic-style'.")
-
-(defun org-odt-write-automatic-styles ()
- "Write automatic styles to \"content.xml\"."
- (with-current-buffer
- (find-file-noselect (expand-file-name "content.xml") t)
- ;; position the cursor
- (goto-char (point-min))
- (re-search-forward " </office:automatic-styles>" nil t)
- (goto-char (match-beginning 0))
- ;; write automatic table styles
- (loop for (style-name props) in
- (plist-get org-odt-automatic-styles 'Table) do
- (when (setq props (or (plist-get props :rel-width) 96))
- (insert (format org-odt-table-style-format style-name props))))))
-
-(defun org-odt-add-automatic-style (object-type &optional object-props)
- "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
-OBJECT-PROPS is (typically) a plist created by passing
-\"#+ATTR_ODT: \" option of the object in question to
-`org-lparse-get-block-params'.
-
-Use `org-odt-object-counters' to generate an automatic
-OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
-new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
-. STYLE-NAME)."
- (assert (stringp object-type))
- (let* ((object (intern object-type))
- (seqvar object)
- (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
- (object-name (format "%s%d" object-type seqno)) style-name)
- (setq org-odt-object-counters
- (plist-put org-odt-object-counters seqvar seqno))
- (when object-props
- (setq style-name (format "Org%s" object-name))
- (setq org-odt-automatic-styles
- (plist-put org-odt-automatic-styles object
- (append (list (list style-name object-props))
- (plist-get org-odt-automatic-styles object)))))
- (cons object-name style-name)))
-
-(defvar org-odt-table-indentedp nil)
-(defun org-odt-begin-table (caption label attributes short-caption)
- (setq org-odt-table-indentedp (not (null org-lparse-list-stack)))
- (when org-odt-table-indentedp
- ;; Within the Org file, the table is appearing within a list item.
- ;; OpenDocument doesn't allow table to appear within list items.
- ;; Temporarily terminate the list, emit the table and then
- ;; re-continue the list.
- (org-odt-discontinue-list)
- ;; Put the Table in an indented section.
- (let ((level (length org-odt-list-stack-stashed)))
- (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level))))
- (setq attributes (org-lparse-get-block-params attributes))
- (setq org-odt-table-style (plist-get attributes :style))
- (setq org-odt-table-style-spec
- (assoc org-odt-table-style org-export-odt-table-styles))
- (when (or label caption)
- (insert
- (org-odt-format-stylized-paragraph
- 'table (org-odt-format-entity-caption label caption "__Table__"))))
- (let ((automatic-name (org-odt-add-automatic-style "Table" attributes)))
- (org-lparse-insert-tag
- "<table:table table:name=\"%s\" table:style-name=\"%s\">"
- (or short-caption (car automatic-name))
- (or (nth 1 org-odt-table-style-spec)
- (cdr automatic-name) "OrgTable")))
- (setq org-lparse-table-begin-marker (point)))
-
-(defvar org-lparse-table-colalign-info)
-(defun org-odt-end-table ()
- (goto-char org-lparse-table-begin-marker)
- (loop for level from 0 below org-lparse-table-ncols
- do (let* ((col-cookie (and org-lparse-table-is-styled
- (cdr (assoc (1+ level)
- org-lparse-table-colalign-info))))
- (extra-columns (or (nth 1 col-cookie) 0)))
- (dotimes (i (1+ extra-columns))
- (insert
- (org-odt-format-tags
- "<table:table-column table:style-name=\"%sColumn\"/>"
- "" (or (nth 1 org-odt-table-style-spec) "OrgTable"))))
- (insert "\n")))
- ;; fill style attributes for table cells
- (when org-lparse-table-is-styled
- (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t)
- (let* ((spec (match-string 1))
- (r (string-to-number (match-string 2)))
- (c (string-to-number (match-string 3)))
- (cell-styles (org-odt-get-table-cell-styles
- r c org-odt-table-style-spec))
- (table-cell-style (car cell-styles))
- (table-cell-paragraph-style (cdr cell-styles)))
- (cond
- ((equal spec "table-cell:p")
- (replace-match table-cell-paragraph-style t t))
- ((equal spec "table-cell:style-name")
- (replace-match table-cell-style t t))))))
- (goto-char (point-max))
- (org-lparse-insert-tag "</table:table>")
- (when org-odt-table-indentedp
- (org-odt-end-section)
- (org-odt-continue-list)))
-
-(defun org-odt-begin-table-rowgroup (&optional is-header-row)
- (when org-lparse-table-rowgrp-open
- (org-lparse-end 'TABLE-ROWGROUP))
- (org-lparse-insert-tag (if is-header-row
- "<table:table-header-rows>"
- "<table:table-rows>"))
- (setq org-lparse-table-rowgrp-open t)
- (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row))
-
-(defun org-odt-end-table-rowgroup ()
- (when org-lparse-table-rowgrp-open
- (setq org-lparse-table-rowgrp-open nil)
- (org-lparse-insert-tag
- (if org-lparse-table-cur-rowgrp-is-hdr
- "</table:table-header-rows>" "</table:table-rows>"))))
-
-(defun org-odt-format-table-row (row)
- (org-odt-format-tags
- '("<table:table-row>" . "</table:table-row>") row))
-
-(defun org-odt-get-table-cell-styles (r c &optional style-spec)
- "Retrieve styles applicable to a table cell.
-R and C are (zero-based) row and column numbers of the table
-cell. STYLE-SPEC is an entry in `org-export-odt-table-styles'
-applicable to the current table. It is `nil' if the table is not
-associated with any style attributes.
-
-Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
-
-When STYLE-SPEC is nil, style the table cell the conventional way
-- choose cell borders based on row and column groupings and
-choose paragraph alignment based on `org-col-cookies' text
-property. See also
-`org-odt-get-paragraph-style-cookie-for-table-cell'.
-
-When STYLE-SPEC is non-nil, ignore the above cookie and return
-styles congruent with the ODF-1.2 specification."
- (cond
- (style-spec
-
- ;; LibreOffice - particularly the Writer - honors neither table
- ;; templates nor custom table-cell styles. Inorder to retain
- ;; inter-operability with LibreOffice, only automatic styles are
- ;; used for styling of table-cells. The current implementation is
- ;; congruent with ODF-1.2 specification and hence is
- ;; future-compatible.
-
- ;; Additional Note: LibreOffice's AutoFormat facility for tables -
- ;; which recognizes as many as 16 different cell types - is much
- ;; richer. Unfortunately it is NOT amenable to easy configuration
- ;; by hand.
-
- (let* ((template-name (nth 1 style-spec))
- (cell-style-selectors (nth 2 style-spec))
- (cell-type
- (cond
- ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
- (= c 0)) "FirstColumn")
- ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
- (= c (1- org-lparse-table-ncols))) "LastColumn")
- ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
- (= r 0)) "FirstRow")
- ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
- (= r org-lparse-table-rownum))
- "LastRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
- (= (% r 2) 1)) "EvenRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
- (= (% r 2) 0)) "OddRow")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
- (= (% c 2) 1)) "EvenColumn")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
- (= (% c 2) 0)) "OddColumn")
- (t ""))))
- (cons
- (concat template-name cell-type "TableCell")
- (concat template-name cell-type "TableParagraph"))))
- (t
- (cons
- (concat
- "OrgTblCell"
- (cond
- ((= r 0) "T")
- ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T")
- (t ""))
- (when (= r org-lparse-table-rownum) "B")
- (cond
- ((= c 0) "")
- ((or (memq (nth c org-table-colgroup-info) '(:start :startend))
- (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L")
- (t "")))
- (capitalize (aref org-lparse-table-colalign-vector c))))))
-
-(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c)
- (concat
- (and (not org-odt-table-style-spec)
- (cond
- (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading")
- ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS))
- "OrgTableHeading")
- (t "OrgTableContents")))
- (and org-lparse-table-is-styled
- (format "@@table-cell:p@@%03d@@%03d@@" r c))))
-
-(defun org-odt-get-style-name-cookie-for-table-cell (r c)
- (when org-lparse-table-is-styled
- (format "@@table-cell:style-name@@%03d@@%03d@@" r c)))
-
-(defun org-odt-format-table-cell (data r c horiz-span)
- (concat
- (let* ((paragraph-style-cookie
- (org-odt-get-paragraph-style-cookie-for-table-cell r c))
- (style-name-cookie
- (org-odt-get-style-name-cookie-for-table-cell r c))
- (extra (and style-name-cookie
- (format " table:style-name=\"%s\"" style-name-cookie)))
- (extra (concat extra
- (and (> horiz-span 0)
- (format " table:number-columns-spanned=\"%d\""
- (1+ horiz-span))))))
- (org-odt-format-tags
- '("<table:table-cell%s>" . "</table:table-cell>")
- (if org-lparse-list-table-p data
- (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra))
- (let (s)
- (dotimes (i horiz-span)
- (setq s (concat s "\n<table:covered-table-cell/>"))) s)
- "\n"))
-
-(defun org-odt-begin-footnote-definition (n)
- (org-lparse-begin-paragraph 'footnote))
-
-(defun org-odt-end-footnote-definition (n)
- (org-lparse-end-paragraph))
-
-(defun org-odt-begin-toc (lang-specific-heading max-level)
- ;; Strings in `org-export-language-setup' can contain named html
- ;; entities. Replace those with utf-8 equivalents.
- (let ((i 0) entity rpl)
- (while (string-match "&\\([^#].*?\\);" lang-specific-heading i)
- (setq entity (match-string 1 lang-specific-heading))
- (if (not (setq rpl (org-entity-get-representation entity 'utf8)))
- (setq i (match-end 0))
- (setq i (+ (match-beginning 0) (length rpl)))
- (setq lang-specific-heading
- (replace-match rpl t t lang-specific-heading)))))
- (insert
- (format "
- <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\">
- <text:table-of-content-source text:outline-level=\"%d\">
- <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
-" max-level lang-specific-heading))
- (loop for level from 1 upto 10
- do (insert (format
- "
- <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
- <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
- <text:index-entry-chapter/>
- <text:index-entry-text/>
- <text:index-entry-link-end/>
- </text:table-of-content-entry-template>
-" level level)))
-
- (insert
- (format "
- </text:table-of-content-source>
-
- <text:index-body>
- <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
- <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
- </text:index-title>
-" lang-specific-heading)))
-
-(defun org-odt-end-toc ()
- (insert "
- </text:index-body>
- </text:table-of-content>
-"))
-
-(defun org-odt-format-toc-entry (snumber todo headline tags href)
- (setq headline (concat
- (and org-export-with-section-numbers
- (concat snumber ". "))
- headline
- (and tags
- (concat
- (org-lparse-format 'SPACES 3)
- (org-lparse-format 'FONTIFY tags "tag")))))
- (when todo
- (setq headline (org-lparse-format 'FONTIFY headline "todo")))
-
- (let ((org-odt-suppress-xref t))
- (org-odt-format-link headline (concat "#" href))))
-
-(defun org-odt-format-toc-item (toc-entry level org-last-level)
- (let ((style (format "Contents_20_%d"
- (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1))))
- (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n")))
-
-;; Following variable is let bound during 'ORG-LINK callback. See
-;; org-html.el
-(defvar org-lparse-link-description-is-image nil)
-(defun org-odt-format-link (desc href &optional attr)
- (cond
- ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref))
- (setq href (substring href 1))
- (let ((xref-format "text"))
- (when (numberp desc)
- (setq desc (format "%d" desc) xref-format "number"))
- (when (listp desc)
- (setq desc (mapconcat 'identity desc ".") xref-format "chapter"))
- (setq href (concat org-export-odt-bookmark-prefix href))
- (org-odt-format-tags
- '("<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" .
- "</text:bookmark-ref>")
- desc xref-format href)))
- (org-lparse-link-description-is-image
- (org-odt-format-tags
- '("<draw:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</draw:a>")
- desc href (or attr "")))
- (t
- (org-odt-format-tags
- '("<text:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</text:a>")
- desc href (or attr "")))))
-
-(defun org-odt-format-spaces (n)
- (cond
- ((= n 1) " ")
- ((> n 1) (concat
- " " (org-odt-format-tags "<text:s text:c=\"%d\"/>" "" (1- n))))
- (t "")))
-
-(defun org-odt-format-tabs (&optional n)
- (let ((tab "<text:tab/>")
- (n (or n 1)))
- (insert tab)))
-
-(defun org-odt-format-line-break ()
- (org-odt-format-tags "<text:line-break/>" ""))
-
-(defun org-odt-format-horizontal-line ()
- (org-odt-format-stylized-paragraph 'horizontal-line ""))
-
-(defun org-odt-encode-plain-text (line &optional no-whitespace-filling)
- (setq line (org-xml-encode-plain-text line))
- (if no-whitespace-filling line
- (org-odt-fill-tabs-and-spaces line)))
-
-(defun org-odt-format-line (line)
- (case org-lparse-dyn-current-environment
- (fixedwidth (concat
- (org-odt-format-stylized-paragraph
- 'fixedwidth (org-odt-encode-plain-text line)) "\n"))
- (t (concat line "\n"))))
-
-(defun org-odt-format-comment (fmt &rest args)
- (let ((comment (apply 'format fmt args)))
- (format "\n<!-- %s -->\n" comment)))
-
-(defun org-odt-format-org-entity (wd)
- (org-entity-get-representation wd 'utf8))
-
-(defun org-odt-fill-tabs-and-spaces (line)
- (replace-regexp-in-string
- "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s)
- (cond
- ((string= s "\t") (org-odt-format-tabs))
- (t (org-odt-format-spaces (length s))))) line))
-
-(defcustom org-export-odt-fontify-srcblocks t
- "Specify whether or not source blocks need to be fontified.
-Turn this option on if you want to colorize the source code
-blocks in the exported file. For colorization to work, you need
-to make available an enhanced version of `htmlfontify' library."
- :type 'boolean
- :group 'org-export-odt
- :version "24.1")
-
-(defun org-odt-format-source-line-with-line-number-and-label
- (line rpllbl num fontifier par-style)
-
- (let ((keep-label (not (numberp rpllbl)))
- (ref (org-find-text-property-in-string 'org-coderef line)))
- (setq line (concat line (and keep-label ref (format "(%s)" ref))))
- (setq line (funcall fontifier line))
- (when ref
- (setq line (org-odt-format-target line (concat "coderef-" ref))))
- (setq line (org-odt-format-stylized-paragraph par-style line))
- (if (not num) line
- (org-odt-format-tags '("<text:list-item>" . "</text:list-item>") line))))
-
-(defun org-odt-format-source-code-or-example-plain
- (lines lang caption textareap cols rows num cont rpllbl fmt)
- "Format source or example blocks much like fixedwidth blocks.
-Use this when `org-export-odt-fontify-srcblocks' option is turned
-off."
- (let* ((lines (org-split-string lines "[\r\n]"))
- (line-count (length lines))
- (i 0))
- (mapconcat
- (lambda (line)
- (incf i)
- (org-odt-format-source-line-with-line-number-and-label
- line rpllbl num 'org-odt-encode-plain-text
- (if (= i line-count) "OrgFixedWidthBlockLastLine"
- "OrgFixedWidthBlock")))
- lines "\n")))
-
-(defvar org-src-block-paragraph-format
- "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
- <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
- <style:background-image/>
- </style:paragraph-properties>
- <style:text-properties fo:color=\"%s\"/>
- </style:style>"
- "Custom paragraph style for colorized source and example blocks.
-This style is much the same as that of \"OrgFixedWidthBlock\"
-except that the foreground and background colors are set
-according to the default face identified by the `htmlfontify'.")
-
-(defvar hfy-optimisations)
-(declare-function hfy-face-to-style "htmlfontify" (fn))
-(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
-
-(defun org-odt-hfy-face-to-css (fn)
- "Create custom style for face FN.
-When FN is the default face, use it's foreground and background
-properties to create \"OrgSrcBlock\" paragraph style. Otherwise
-use it's color attribute to create a character style whose name
-is obtained from FN. Currently all attributes of FN other than
-color are ignored.
-
-The style name for a face FN is derived using the following
-operations on the face name in that order - de-dash, CamelCase
-and prefix with \"OrgSrc\". For example,
-`font-lock-function-name-face' is associated with
-\"OrgSrcFontLockFunctionNameFace\"."
- (let* ((css-list (hfy-face-to-style fn))
- (style-name ((lambda (fn)
- (concat "OrgSrc"
- (mapconcat
- 'capitalize (split-string
- (hfy-face-or-def-to-name fn) "-")
- ""))) fn))
- (color-val (cdr (assoc "color" css-list)))
- (background-color-val (cdr (assoc "background" css-list)))
- (style (and org-export-odt-create-custom-styles-for-srcblocks
- (cond
- ((eq fn 'default)
- (format org-src-block-paragraph-format
- background-color-val color-val))
- (t
- (format
- "
-<style:style style:name=\"%s\" style:family=\"text\">
- <style:text-properties fo:color=\"%s\"/>
- </style:style>" style-name color-val))))))
- (cons style-name style)))
-
-(defun org-odt-insert-custom-styles-for-srcblocks (styles)
- "Save STYLES used for colorizing of source blocks.
-Update styles.xml with styles that were collected as part of
-`org-odt-hfy-face-to-css' callbacks."
- (when styles
- (with-current-buffer
- (find-file-noselect (expand-file-name "styles.xml") t)
- (goto-char (point-min))
- (when (re-search-forward "</office:styles>" nil t)
- (goto-char (match-beginning 0))
- (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n")))))
-
-(defun org-odt-format-source-code-or-example-colored
- (lines lang caption textareap cols rows num cont rpllbl fmt)
- "Format source or example blocks using `htmlfontify-string'.
-Use this routine when `org-export-odt-fontify-srcblocks' option
-is turned on."
- (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
- (mode (and lang-m (intern (concat (if (symbolp lang-m)
- (symbol-name lang-m)
- lang-m) "-mode"))))
- (org-inhibit-startup t)
- (org-startup-folded nil)
- (lines (with-temp-buffer
- (insert lines)
- (if (functionp mode) (funcall mode) (fundamental-mode))
- (font-lock-fontify-buffer)
- (buffer-string)))
- (hfy-html-quote-regex "\\([<\"&> ]\\)")
- (hfy-html-quote-map '(("\"" "&quot;")
- ("<" "&lt;")
- ("&" "&amp;")
- (">" "&gt;")
- (" " "<text:s/>")
- (" " "<text:tab/>")))
- (hfy-face-to-css 'org-odt-hfy-face-to-css)
- (hfy-optimisations-1 (copy-sequence hfy-optimisations))
- (hfy-optimisations (add-to-list 'hfy-optimisations-1
- 'body-text-only))
- (hfy-begin-span-handler
- (lambda (style text-block text-id text-begins-block-p)
- (insert (format "<text:span text:style-name=\"%s\">" style))))
- (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
- (when (fboundp 'htmlfontify-string)
- (let* ((lines (org-split-string lines "[\r\n]"))
- (line-count (length lines))
- (i 0))
- (mapconcat
- (lambda (line)
- (incf i)
- (org-odt-format-source-line-with-line-number-and-label
- line rpllbl num 'htmlfontify-string
- (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock")))
- lines "\n")))))
-
-(defun org-odt-format-source-code-or-example (lines lang caption textareap
- cols rows num cont
- rpllbl fmt)
- "Format source or example blocks for export.
-Use `org-odt-format-source-code-or-example-plain' or
-`org-odt-format-source-code-or-example-colored' depending on the
-value of `org-export-odt-fontify-srcblocks."
- (setq lines (org-export-number-lines
- lines 0 0 num cont rpllbl fmt 'preprocess)
- lines (funcall
- (or (and org-export-odt-fontify-srcblocks
- (or (featurep 'htmlfontify)
- ;; htmlfontify.el was introduced in Emacs 23.2
- ;; So load it with some caution
- (require 'htmlfontify nil t))
- (fboundp 'htmlfontify-string)
- 'org-odt-format-source-code-or-example-colored)
- 'org-odt-format-source-code-or-example-plain)
- lines lang caption textareap cols rows num cont rpllbl fmt))
- (if (not num) lines
- (let ((extra (format " text:continue-numbering=\"%s\""
- (if cont "true" "false"))))
- (org-odt-format-tags
- '("<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>"
- . "</text:list>") lines extra))))
-
-(defun org-odt-remap-stylenames (style-name)
- (or
- (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper")
- ("timestamp" . "OrgTimestamp")
- ("timestamp-kwd" . "OrgTimestampKeyword")
- ("tag" . "OrgTag")
- ("todo" . "OrgTodo")
- ("done" . "OrgDone")
- ("target" . "OrgTarget"))))
- style-name))
-
-(defun org-odt-format-fontify (text style &optional id)
- (let* ((style-name
- (cond
- ((stringp style)
- (org-odt-remap-stylenames style))
- ((symbolp style)
- (org-odt-get-style-name-for-entity 'character style))
- ((listp style)
- (assert (< 1 (length style)))
- (let ((parent-style (pop style)))
- (mapconcat (lambda (s)
- ;; (assert (stringp s) t)
- (org-odt-remap-stylenames s)) style "")
- (org-odt-remap-stylenames parent-style)))
- (t (error "Don't how to handle style %s" style)))))
- (org-odt-format-tags
- '("<text:span text:style-name=\"%s\">" . "</text:span>")
- text style-name)))
-
-(defun org-odt-relocate-relative-path (path dir)
- (if (file-name-absolute-p path) path
- (file-relative-name (expand-file-name path dir)
- (expand-file-name "eyecandy" dir))))
-
-(defun org-odt-format-inline-image (thefile)
- (let* ((thelink (if (file-name-absolute-p thefile) thefile
- (org-xml-format-href
- (org-odt-relocate-relative-path
- thefile org-current-export-file))))
- (href
- (org-odt-format-tags
- "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
- (if org-export-odt-embed-images
- (org-odt-copy-image-file thefile) thelink))))
- (org-export-odt-format-image thefile href)))
-
-(defvar org-odt-entity-labels-alist nil
- "Associate Labels with the Labeled entities.
-Each element of the alist is of the form (LABEL-NAME
-CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as
-that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the
-type of the entity that LABEL-NAME is attached to. CATEGORY-NAME
-can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is
-the unique number assigned to the referenced entity on a
-per-CATEGORY basis. It is generated sequentially and is 1-based.
-LABEL-STYLE-NAME is a key `org-odt-label-styles'.
-
-See `org-odt-add-label-definition' and
-`org-odt-fixup-label-references'.")
-
-(defun org-export-odt-format-formula (src href)
- (save-match-data
- (let* ((caption (org-find-text-property-in-string 'org-caption src))
- (short-caption
- (or (org-find-text-property-in-string 'org-caption-shortn src)
- caption))
- (caption (and caption (org-xml-format-desc caption)))
- (short-caption (and short-caption
- (org-xml-encode-plain-text short-caption)))
- (label (org-find-text-property-in-string 'org-label src))
- (latex-frag (org-find-text-property-in-string 'org-latex-src src))
- (embed-as (or (and latex-frag
- (org-find-text-property-in-string
- 'org-latex-src-embed-type src))
- (if (or caption label) 'paragraph 'character)))
- width height)
- (when latex-frag
- (setq href (org-propertize href :title "LaTeX Fragment"
- :description latex-frag)))
- (cond
- ((eq embed-as 'character)
- (org-odt-format-entity "InlineFormula" href width height))
- (t
- (org-lparse-end-paragraph)
- (org-lparse-insert-list-table
- `((,(org-odt-format-entity
- (if (not (or caption label)) "DisplayFormula"
- "CaptionedDisplayFormula")
- href width height :caption caption :label label
- :short-caption short-caption)
- ,(if (not (or caption label)) ""
- (let* ((label-props (car org-odt-entity-labels-alist)))
- (setcar (last label-props) "math-label")
- (apply 'org-odt-format-label-definition
- caption label-props)))))
- nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1)))
- (throw 'nextline nil))))))
-
-(defvar org-odt-embedded-formulas-count 0)
-(defun org-odt-copy-formula-file (path)
- "Returns the internal name of the file"
- (let* ((src-file (expand-file-name
- path (file-name-directory org-current-export-file)))
- (target-dir (format "Formula-%04d/"
- (incf org-odt-embedded-formulas-count)))
- (target-file (concat target-dir "content.xml")))
- (when (not org-lparse-to-buffer)
- (message "Embedding %s as %s ..."
- (substring-no-properties path) target-file)
-
- (make-directory target-dir)
- (org-odt-create-manifest-file-entry
- "application/vnd.oasis.opendocument.formula" target-dir "1.2")
-
- (case (org-odt-is-formula-link-p src-file)
- (mathml
- (copy-file src-file target-file 'overwrite))
- (odf
- (org-odt-zip-extract-one src-file "content.xml" target-dir))
- (t
- (error "%s is not a formula file" src-file)))
-
- (org-odt-create-manifest-file-entry "text/xml" target-file))
- target-file))
-
-(defun org-odt-format-inline-formula (thefile)
- (let* ((thelink (if (file-name-absolute-p thefile) thefile
- (org-xml-format-href
- (org-odt-relocate-relative-path
- thefile org-current-export-file))))
- (href
- (org-odt-format-tags
- "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" ""
- (file-name-directory (org-odt-copy-formula-file thefile)))))
- (org-export-odt-format-formula thefile href)))
-
-(defun org-odt-is-formula-link-p (file)
- (let ((case-fold-search nil))
- (cond
- ((string-match "\\.\\(mathml\\|mml\\)\\'" file)
- 'mathml)
- ((string-match "\\.odf\\'" file)
- 'odf))))
-
-(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr
- descp)
- "Make a OpenDocument link.
-OPT-PLIST is an options list.
-TYPE-1 is the device-type of the link (THIS://foo.html).
-PATH is the path of the link (http://THIS#location).
-FRAGMENT is the fragment part of the link, if any (foo.html#THIS).
-DESC is the link description, if any.
-ATTR is a string of other attributes of the a element."
- (declare (special org-lparse-par-open))
- (save-match-data
- (let* ((may-inline-p
- (and (member type-1 '("http" "https" "file"))
- (org-lparse-should-inline-p path descp)
- (not fragment)))
- (type (if (equal type-1 "id") "file" type-1))
- (filename path)
- (thefile path)
- sec-frag sec-nos)
- (cond
- ;; check for inlined images
- ((and (member type '("file"))
- (not fragment)
- (org-file-image-p
- filename org-export-odt-inline-image-extensions)
- (or (eq t org-export-odt-inline-images)
- (and org-export-odt-inline-images (not descp))))
- (org-odt-format-inline-image thefile))
- ;; check for embedded formulas
- ((and (member type '("file"))
- (not fragment)
- (org-odt-is-formula-link-p filename)
- (or (not descp)))
- (org-odt-format-inline-formula thefile))
- ;; code references
- ((string= type "coderef")
- (let* ((ref fragment)
- (lineno-or-ref (cdr (assoc ref org-export-code-refs)))
- (desc (and descp desc))
- (org-odt-suppress-xref nil)
- (href (org-xml-format-href (concat "#coderef-" ref))))
- (cond
- ((and (numberp lineno-or-ref) (not desc))
- (org-odt-format-link lineno-or-ref href))
- ((and (numberp lineno-or-ref) desc
- (string-match (regexp-quote (concat "(" ref ")")) desc))
- (format (replace-match "%s" t t desc)
- (org-odt-format-link lineno-or-ref href)))
- (t
- (setq desc (format
- (if (and desc (string-match
- (regexp-quote (concat "(" ref ")"))
- desc))
- (replace-match "%s" t t desc)
- (or desc "%s"))
- lineno-or-ref))
- (org-odt-format-link (org-xml-format-desc desc) href)))))
- ;; links to headlines
- ((and (string= type "")
- (or (not thefile) (string= thefile ""))
- (plist-get org-lparse-opt-plist :section-numbers)
- (get-text-property 0 'org-no-description fragment)
- (setq sec-frag fragment)
- (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)
- (and (setq sec-frag
- (loop for alias in org-export-target-aliases do
- (when (member fragment (cdr alias))
- (return (car alias)))))
- (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag)))
- (setq sec-nos (org-split-string (match-string 1 sec-frag) "-"))
- (<= (length sec-nos) (plist-get org-lparse-opt-plist
- :headline-levels)))
- (let ((org-odt-suppress-xref nil))
- (org-odt-format-link sec-nos (concat "#" sec-frag) attr)))
- (t
- (when (string= type "file")
- (setq thefile
- (cond
- ((file-name-absolute-p path)
- (concat "file://" (expand-file-name path)))
- (t (org-odt-relocate-relative-path
- thefile org-current-export-file)))))
-
- (when (and (member type '("" "http" "https" "file")) fragment)
- (setq thefile (concat thefile "#" fragment)))
-
- (setq thefile (org-xml-format-href thefile))
-
- (when (not (member type '("" "file")))
- (setq thefile (concat type ":" thefile)))
-
- (let ((org-odt-suppress-xref
- ;; Typeset link to headlines with description, as a
- ;; regular hyperlink.
- (and (string= type "")
- (not (get-text-property 0 'org-no-description fragment)))))
- (org-odt-format-link
- (org-xml-format-desc desc) thefile attr)))))))
-
-(defun org-odt-format-heading (text level &optional id)
- (let* ((text (if id (org-odt-format-target text id) text)))
- (org-odt-format-tags
- '("<text:h text:style-name=\"Heading_20_%s\" text:outline-level=\"%s\">" .
- "</text:h>") text level level)))
-
-(defun org-odt-format-headline (title extra-targets tags
- &optional snumber level)
- (concat
- (org-lparse-format 'EXTRA-TARGETS extra-targets)
-
- ;; No need to generate section numbers. They are auto-generated by
- ;; the application
-
- ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ")
- title
- (and tags (concat (org-lparse-format 'SPACES 3)
- (org-lparse-format 'ORG-TAGS tags)))))
-
-(defun org-odt-format-anchor (text name &optional class)
- (org-odt-format-target text name))
-
-(defun org-odt-format-bookmark (text id)
- (if id
- (org-odt-format-tags "<text:bookmark text:name=\"%s\"/>" text id)
- text))
-
-(defun org-odt-format-target (text id)
- (let ((name (concat org-export-odt-bookmark-prefix id)))
- (concat
- (and id (org-odt-format-tags
- "<text:bookmark-start text:name=\"%s\"/>" "" name))
- (org-odt-format-bookmark text id)
- (and id (org-odt-format-tags
- "<text:bookmark-end text:name=\"%s\"/>" "" name)))))
-
-(defun org-odt-format-footnote (n def)
- (let ((id (concat "fn" n))
- (note-class "footnote")
- (par-style "Footnote"))
- (org-odt-format-tags
- '("<text:note text:id=\"%s\" text:note-class=\"%s\">" .
- "</text:note>")
- (concat
- (org-odt-format-tags
- '("<text:note-citation>" . "</text:note-citation>")
- n)
- (org-odt-format-tags
- '("<text:note-body>" . "</text:note-body>")
- def))
- id note-class)))
-
-(defun org-odt-format-footnote-reference (n def refcnt)
- (if (= refcnt 1)
- (org-odt-format-footnote n def)
- (org-odt-format-footnote-ref n)))
-
-(defun org-odt-format-footnote-ref (n)
- (let ((note-class "footnote")
- (ref-format "text")
- (ref-name (concat "fn" n)))
- (org-odt-format-tags
- '("<text:span text:style-name=\"%s\">" . "</text:span>")
- (org-odt-format-tags
- '("<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">" . "</text:note-ref>")
- n note-class ref-format ref-name)
- "OrgSuperscript")))
-
-(defun org-odt-get-image-name (file-name)
- (require 'sha1)
- (file-relative-name
- (expand-file-name
- (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures")))
-
-(defun org-export-odt-format-image (src href)
- "Create image tag with source and attributes."
- (save-match-data
- (let* ((caption (org-find-text-property-in-string 'org-caption src))
- (short-caption
- (or (org-find-text-property-in-string 'org-caption-shortn src)
- caption))
- (caption (and caption (org-xml-format-desc caption)))
- (short-caption (and short-caption
- (org-xml-encode-plain-text short-caption)))
- (attr (org-find-text-property-in-string 'org-attributes src))
- (label (org-find-text-property-in-string 'org-label src))
- (latex-frag (org-find-text-property-in-string
- 'org-latex-src src))
- (category (and latex-frag "__DvipngImage__"))
- (attr-plist (org-lparse-get-block-params attr))
- (user-frame-anchor
- (car (assoc-string (plist-get attr-plist :anchor)
- '(("as-char") ("paragraph") ("page")) t)))
- (user-frame-style
- (and user-frame-anchor (plist-get attr-plist :style)))
- (user-frame-attrs
- (and user-frame-anchor (plist-get attr-plist :attributes)))
- (user-frame-params
- (list user-frame-style user-frame-attrs user-frame-anchor))
- (embed-as (cond
- (latex-frag
- (symbol-name
- (case (org-find-text-property-in-string
- 'org-latex-src-embed-type src)
- (paragraph 'paragraph)
- (t 'as-char))))
- (user-frame-anchor)
- (t "paragraph")))
- (size (org-odt-image-size-from-file
- src (plist-get attr-plist :width)
- (plist-get attr-plist :height)
- (plist-get attr-plist :scale) nil embed-as))
- (width (car size)) (height (cdr size)))
- (when latex-frag
- (setq href (org-propertize href :title "LaTeX Fragment"
- :description latex-frag)))
- (let ((frame-style-handle (concat (and (or caption label) "Captioned")
- embed-as "Image")))
- (org-odt-format-entity
- frame-style-handle href width height
- :caption caption :label label :category category
- :short-caption short-caption
- :user-frame-params user-frame-params)))))
-
-(defun org-odt-format-object-description (title description)
- (concat (and title (org-odt-format-tags
- '("<svg:title>" . "</svg:title>")
- (org-odt-encode-plain-text title t)))
- (and description (org-odt-format-tags
- '("<svg:desc>" . "</svg:desc>")
- (org-odt-encode-plain-text description t)))))
-
-(defun org-odt-format-frame (text width height style &optional
- extra anchor-type)
- (let ((frame-attrs
- (concat
- (if width (format " svg:width=\"%0.2fcm\"" width) "")
- (if height (format " svg:height=\"%0.2fcm\"" height) "")
- extra
- (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")))))
- (org-odt-format-tags
- '("<draw:frame draw:style-name=\"%s\"%s>" . "</draw:frame>")
- (concat text (org-odt-format-object-description
- (get-text-property 0 :title text)
- (get-text-property 0 :description text)))
- style frame-attrs)))
-
-(defun org-odt-format-textbox (text width height style &optional
- extra anchor-type)
- (org-odt-format-frame
- (org-odt-format-tags
- '("<draw:text-box %s>" . "</draw:text-box>")
- text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
- (unless width
- (format " fo:min-width=\"%0.2fcm\"" (or width .2)))))
- width nil style extra anchor-type))
-
-(defun org-odt-format-inlinetask (heading content
- &optional todo priority tags)
- (org-odt-format-stylized-paragraph
- nil (org-odt-format-textbox
- (concat (org-odt-format-stylized-paragraph
- "OrgInlineTaskHeading"
- (org-lparse-format
- 'HEADLINE (concat (org-lparse-format-todo todo) " " heading)
- nil tags))
- content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
-
-(defvar org-odt-entity-frame-styles
- '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char"))
- ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph"))
- ("PageImage" "__Figure__" ("OrgPageImage" nil "page"))
- ("CaptionedAs-CharImage" "__Figure__"
- ("OrgCaptionedImage"
- " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
- ("OrgInlineImage" nil "as-char"))
- ("CaptionedParagraphImage" "__Figure__"
- ("OrgCaptionedImage"
- " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
- ("OrgImageCaptionFrame" nil "paragraph"))
- ("CaptionedPageImage" "__Figure__"
- ("OrgCaptionedImage"
- " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
- ("OrgPageImageCaptionFrame" nil "page"))
- ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char"))
- ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char"))
- ("CaptionedDisplayFormula" "__MathFormula__"
- ("OrgCaptionedFormula" nil "paragraph")
- ("OrgFormulaCaptionFrame" nil "as-char"))))
-
-(defun org-odt-merge-frame-params(default-frame-params user-frame-params)
- (if (not user-frame-params) default-frame-params
- (assert (= (length default-frame-params) 3))
- (assert (= (length user-frame-params) 3))
- (loop for user-frame-param in user-frame-params
- for default-frame-param in default-frame-params
- collect (or user-frame-param default-frame-param))))
-
-(defun* org-odt-format-entity (entity href width height
- &key caption label category
- user-frame-params short-caption)
- (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t))
- default-frame-params frame-params)
- (cond
- ((not (or caption label))
- (setq default-frame-params (nth 2 entity-style))
- (setq frame-params (org-odt-merge-frame-params
- default-frame-params user-frame-params))
- (apply 'org-odt-format-frame href width height frame-params))
- (t
- (setq default-frame-params (nth 3 entity-style))
- (setq frame-params (org-odt-merge-frame-params
- default-frame-params user-frame-params))
- (apply 'org-odt-format-textbox
- (org-odt-format-stylized-paragraph
- 'illustration
- (concat
- (apply 'org-odt-format-frame href width height
- (let ((entity-style-1 (copy-sequence
- (nth 2 entity-style))))
- (setcar (cdr entity-style-1)
- (concat
- (cadr entity-style-1)
- (and short-caption
- (format " draw:name=\"%s\" "
- short-caption))))
-
- entity-style-1))
- (org-odt-format-entity-caption
- label caption (or category (nth 1 entity-style)))))
- width height frame-params)))))
-
-(defvar org-odt-embedded-images-count 0)
-(defun org-odt-copy-image-file (path)
- "Returns the internal name of the file"
- (let* ((image-type (file-name-extension path))
- (media-type (format "image/%s" image-type))
- (src-file (expand-file-name
- path (file-name-directory org-current-export-file)))
- (target-dir "Images/")
- (target-file
- (format "%s%04d.%s" target-dir
- (incf org-odt-embedded-images-count) image-type)))
- (when (not org-lparse-to-buffer)
- (message "Embedding %s as %s ..."
- (substring-no-properties path) target-file)
-
- (when (= 1 org-odt-embedded-images-count)
- (make-directory target-dir)
- (org-odt-create-manifest-file-entry "" target-dir))
-
- (copy-file src-file target-file 'overwrite)
- (org-odt-create-manifest-file-entry media-type target-file))
- target-file))
-
-(defvar org-export-odt-image-size-probe-method
- (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
- '(emacs fixed))
- "Ordered list of methods for determining image sizes.")
-
-(defvar org-export-odt-default-image-sizes-alist
- '(("as-char" . (5 . 0.4))
- ("paragraph" . (5 . 5)))
- "Hardcoded image dimensions one for each of the anchor
- methods.")
-
-;; A4 page size is 21.0 by 29.7 cms
-;; The default page settings has 2cm margin on each of the sides. So
-;; the effective text area is 17.0 by 25.7 cm
-(defvar org-export-odt-max-image-size '(17.0 . 20.0)
- "Limiting dimensions for an embedded image.")
-
-(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type)
- (let* ((dpi (or dpi org-export-odt-pixels-per-inch))
- (anchor-type (or anchor-type "paragraph"))
- (--pixels-to-cms
- (function
- (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)
- (and size-in-pixels
- (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
- (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))))
- (case probe-method
- (emacs
- (let ((size-in-pixels
- (ignore-errors ; Emacs could be in batch mode
- (clear-image-cache)
- (image-size (create-image file) 'pixels))))
- (funcall --size-in-cms size-in-pixels dpi)))
- (imagemagick
- (let ((size-in-pixels
- (let ((dim (shell-command-to-string
- (format "identify -format \"%%w:%%h\" \"%s\"" file))))
- (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
- (cons (string-to-number (match-string 1 dim))
- (string-to-number (match-string 2 dim)))))))
- (funcall --size-in-cms size-in-pixels dpi)))
- (t (cdr (assoc-string anchor-type
- org-export-odt-default-image-sizes-alist))))))
-
-(defun org-odt-image-size-from-file (file &optional user-width
- user-height scale dpi embed-as)
- (unless (file-name-absolute-p file)
- (setq file (expand-file-name
- file (file-name-directory org-current-export-file))))
- (let* (size width height)
- (unless (and user-height user-width)
- (loop for probe-method in org-export-odt-image-size-probe-method
- until size
- do (setq size (org-odt-do-image-size
- probe-method file dpi embed-as)))
- (or size (error "Cannot determine image size, aborting"))
- (setq width (car size) height (cdr size)))
- (cond
- (scale
- (setq width (* width scale) height (* height scale)))
- ((and user-height user-width)
- (setq width user-width height user-height))
- (user-height
- (setq width (* user-height (/ width height)) height user-height))
- (user-width
- (setq height (* user-width (/ height width)) width user-width))
- (t (ignore)))
- ;; ensure that an embedded image fits comfortably within a page
- (let ((max-width (car org-export-odt-max-image-size))
- (max-height (cdr org-export-odt-max-image-size)))
- (when (or (> width max-width) (> height max-height))
- (let* ((scale1 (/ max-width width))
- (scale2 (/ max-height height))
- (scale (min scale1 scale2)))
- (setq width (* scale width) height (* scale height)))))
- (cons width height)))
-
-(defvar org-odt-entity-counts-plist nil
- "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs.
-See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.")
-
-(defvar org-odt-label-styles
- '(("math-formula" "%c" "text" "(%n)")
- ("math-label" "(%n)" "text" "(%n)")
- ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
- ("value" "%e %n: %c" "value" "%n"))
- "Specify how labels are applied and referenced.
-This is an alist where each element is of the
-form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
-LABEL-REF-FMT).
-
-LABEL-ATTACH-FMT controls how labels and captions are attached to
-an entity. It may contain following specifiers - %e, %n and %c.
-%e is replaced with the CATEGORY-NAME. %n is replaced with
-\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
-with CAPTION. See `org-odt-format-label-definition'.
-
-LABEL-REF-MODE and LABEL-REF-FMT controls how label references
-are generated. The following XML is generated for a label
-reference - \"<text:sequence-ref
-text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
-</text:sequence-ref>\". LABEL-REF-FMT may contain following
-specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
-%n is replaced with SEQNO. See
-`org-odt-format-label-reference'.")
-
-(defcustom org-export-odt-category-strings
- '(("en" "Table" "Figure" "Equation" "Equation"))
- "Specify category strings for various captionable entities.
-Captionable entity can be one of a Table, an Embedded Image, a
-LaTeX fragment (generated with dvipng) or a Math Formula.
-
-For example, when `org-export-default-language' is \"en\", an
-embedded image will be captioned as \"Figure 1: Orgmode Logo\".
-If you want the images to be captioned instead as \"Illustration
-1: Orgmode Logo\", then modify the entry for \"en\" as shown
-below.
-
- \(setq org-export-odt-category-strings
- '\(\(\"en\" \"Table\" \"Illustration\"
- \"Equation\" \"Equation\"\)\)\)"
- :group 'org-export-odt
- :version "24.1"
- :type '(repeat (list (string :tag "Language tag")
- (choice :tag "Table"
- (const :tag "Use Default" nil)
- (string :tag "Category string"))
- (choice :tag "Figure"
- (const :tag "Use Default" nil)
- (string :tag "Category string"))
- (choice :tag "Math Formula"
- (const :tag "Use Default" nil)
- (string :tag "Category string"))
- (choice :tag "Dvipng Image"
- (const :tag "Use Default" nil)
- (string :tag "Category string")))))
-
-(defvar org-odt-category-map-alist
- '(("__Table__" "Table" "value")
- ("__Figure__" "Illustration" "value")
- ("__MathFormula__" "Text" "math-formula")
- ("__DvipngImage__" "Equation" "value")
- ;; ("__Table__" "Table" "category-and-value")
- ;; ("__Figure__" "Figure" "category-and-value")
- ;; ("__DvipngImage__" "Equation" "category-and-value")
- )
- "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
-This is a list where each entry is of the form \\(CATEGORY-HANDLE
-OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the
-captionable entity in question. OD-VARIABLE is the OpenDocument
-sequence counter associated with the entity. These counters are
-declared within
-\"<text:sequence-decls>...</text:sequence-decls>\" block of
-`org-export-odt-content-template-file'. LABEL-STYLE is a key
-into `org-odt-label-styles' and specifies how a given entity
-should be captioned and referenced.
-
-The position of a CATEGORY-HANDLE in this list is used as an
-index in to per-language entry for
-`org-export-odt-category-strings' to retrieve a CATEGORY-NAME.
-This CATEGORY-NAME is then used for qualifying the user-specified
-captions on export.")
-
-(defun org-odt-add-label-definition (label default-category)
- "Create an entry in `org-odt-entity-labels-alist' and return it."
- (let* ((label-props (assoc default-category org-odt-category-map-alist))
- ;; identify the sequence number
- (counter (nth 1 label-props))
- (sequence-var (intern counter))
- (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var)
- 0)))
- ;; assign an internal label, if user has not provided one
- (label (if label (substring-no-properties label)
- (format "%s-%s" default-category seqno)))
- ;; identify label style
- (label-style (nth 2 label-props))
- ;; grok language setting
- (en-strings (assoc-default "en" org-export-odt-category-strings))
- (lang (plist-get org-lparse-opt-plist :language))
- (lang-strings (assoc-default lang org-export-odt-category-strings))
- ;; retrieve localized category sting
- (pos (- (length org-odt-category-map-alist)
- (length (memq label-props org-odt-category-map-alist))))
- (category (or (nth pos lang-strings) (nth pos en-strings)))
- (label-props (list label category counter seqno label-style)))
- ;; synchronize internal counters
- (setq org-odt-entity-counts-plist
- (plist-put org-odt-entity-counts-plist sequence-var seqno))
- ;; stash label properties for later retrieval
- (push label-props org-odt-entity-labels-alist)
- label-props))
-
-(defun org-odt-format-label-definition (caption label category counter
- seqno label-style)
- (assert label)
- (format-spec
- (cadr (assoc-string label-style org-odt-label-styles t))
- `((?e . ,category)
- (?n . ,(org-odt-format-tags
- '("<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">" . "</text:sequence>")
- (format "%d" seqno) label counter counter))
- (?c . ,(or caption "")))))
-
-(defun org-odt-format-label-reference (label category counter
- seqno label-style)
- (assert label)
- (save-match-data
- (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
- (fmt1 (car fmt))
- (fmt2 (cadr fmt)))
- (org-odt-format-tags
- '("<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">"
- . "</text:sequence-ref>")
- (format-spec fmt2 `((?e . ,category)
- (?n . ,(format "%d" seqno)))) fmt1 label))))
-
-(defun org-odt-fixup-label-references ()
- (goto-char (point-min))
- (while (re-search-forward
- "<text:sequence-ref text:ref-name=\"\\([^\"]+\\)\">[ \t\n]*</text:sequence-ref>"
- nil t)
- (let* ((label (match-string 1))
- (label-def (assoc label org-odt-entity-labels-alist))
- (rpl (and label-def
- (apply 'org-odt-format-label-reference label-def))))
- (if rpl (replace-match rpl t t)
- (org-lparse-warn
- (format "Unable to resolve reference to label \"%s\"" label))))))
-
-(defun org-odt-format-entity-caption (label caption category)
- (if (not (or label caption)) ""
- (apply 'org-odt-format-label-definition caption
- (org-odt-add-label-definition label category))))
-
-(defun org-odt-format-tags (tag text &rest args)
- (let ((prefix (when org-lparse-encode-pending "@"))
- (suffix (when org-lparse-encode-pending "@")))
- (apply 'org-lparse-format-tags tag text prefix suffix args)))
-
-(defvar org-odt-manifest-file-entries nil)
-(defun org-odt-init-outfile (filename)
- (unless (executable-find "zip")
- ;; Not at all OSes ship with zip by default
- (error "Executable \"zip\" needed for creating OpenDocument files"))
-
- (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir)))
- ;; init conten.xml
- (require 'nxml-mode)
- (let ((nxml-auto-insert-xml-declaration-flag nil))
- (find-file-noselect content-file t))
-
- ;; reset variables
- (setq org-odt-manifest-file-entries nil
- org-odt-embedded-images-count 0
- org-odt-embedded-formulas-count 0
- org-odt-entity-labels-alist nil
- org-odt-list-stack-stashed nil
- org-odt-automatic-styles nil
- org-odt-object-counters nil
- org-odt-entity-counts-plist nil)
- content-file))
-
-(defcustom org-export-odt-prettify-xml nil
- "Specify whether or not the xml output should be prettified.
-When this option is turned on, `indent-region' is run on all
-component xml buffers before they are saved. Turn this off for
-regular use. Turn this on if you need to examine the xml
-visually."
- :group 'org-export-odt
- :version "24.1"
- :type 'boolean)
-
-(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse
-(defun org-odt-save-as-outfile (target opt-plist)
- ;; write automatic styles
- (org-odt-write-automatic-styles)
-
- ;; write meta file
- (org-odt-update-meta-file opt-plist)
-
- ;; write styles file
- (when (equal org-lparse-backend 'odt)
- (org-odt-update-styles-file opt-plist))
-
- ;; create mimetype file
- (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend)))
- (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
-
- ;; create a manifest entry for content.xml
- (org-odt-create-manifest-file-entry "text/xml" "content.xml")
-
- ;; write out the manifest entries before zipping
- (org-odt-write-manifest-file)
-
- (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml"
- "meta.xml")))
- (when (equal org-lparse-backend 'odt)
- (push "styles.xml" xml-files))
-
- ;; save all xml files
- (mapc (lambda (file)
- (with-current-buffer
- (find-file-noselect (expand-file-name file) t)
- ;; prettify output if needed
- (when org-export-odt-prettify-xml
- (indent-region (point-min) (point-max)))
- (save-buffer 0)))
- xml-files)
-
- (let* ((target-name (file-name-nondirectory target))
- (target-dir (file-name-directory target))
- (cmds `(("zip" "-mX0" ,target-name "mimetype")
- ("zip" "-rmTq" ,target-name "."))))
- (when (file-exists-p target)
- ;; FIXME: If the file is locked this throws a cryptic error
- (delete-file target))
-
- (let ((coding-system-for-write 'no-conversion) exitcode err-string)
- (message "Creating odt file...")
- (mapc
- (lambda (cmd)
- (message "Running %s" (mapconcat 'identity cmd " "))
- (setq err-string
- (with-output-to-string
- (setq exitcode
- (apply 'call-process (car cmd)
- nil standard-output nil (cdr cmd)))))
- (or (zerop exitcode)
- (ignore (message "%s" err-string))
- (error "Unable to create odt file (%S)" exitcode)))
- cmds))
-
- ;; move the file from outdir to target-dir
- (rename-file target-name target-dir)))
-
- (message "Created %s" target)
- (set-buffer (find-file-noselect target t)))
-
-(defconst org-odt-manifest-file-entry-tag
- "
-<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
-
-(defun org-odt-create-manifest-file-entry (&rest args)
- (push args org-odt-manifest-file-entries))
-
-(defun org-odt-write-manifest-file ()
- (make-directory "META-INF")
- (let ((manifest-file (expand-file-name "META-INF/manifest.xml")))
- (with-current-buffer
- (let ((nxml-auto-insert-xml-declaration-flag nil))
- (find-file-noselect manifest-file t))
- (insert
- "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
- <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
- (mapc
- (lambda (file-entry)
- (let* ((version (nth 2 file-entry))
- (extra (if version
- (format " manifest:version=\"%s\"" version)
- "")))
- (insert
- (format org-odt-manifest-file-entry-tag
- (nth 0 file-entry) (nth 1 file-entry) extra))))
- org-odt-manifest-file-entries)
- (insert "\n</manifest:manifest>"))))
-
-(defun org-odt-update-meta-file (opt-plist)
- (let ((date (org-odt-format-date (plist-get opt-plist :date)))
- (author (or (plist-get opt-plist :author) ""))
- (email (plist-get opt-plist :email))
- (keywords (plist-get opt-plist :keywords))
- (description (plist-get opt-plist :description))
- (title (plist-get opt-plist :title)))
- (write-region
- (concat
- "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
- <office:document-meta
- xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
- xmlns:xlink=\"http://www.w3.org/1999/xlink\"
- xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
- xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
- xmlns:ooo=\"http://openoffice.org/2004/office\"
- office:version=\"1.2\">
- <office:meta>" "\n"
- (org-odt-format-author)
- (org-odt-format-tags
- '("\n<meta:initial-creator>" . "</meta:initial-creator>") author)
- (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date)
- (org-odt-format-tags
- '("\n<meta:creation-date>" . "</meta:creation-date>") date)
- (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>")
- (when org-export-creator-info
- (format "Org-%s/Emacs-%s"
- (org-version)
- emacs-version)))
- (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords)
- (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description)
- (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title)
- "\n"
- " </office:meta>" "</office:document-meta>")
- nil (expand-file-name "meta.xml")))
-
- ;; create a manifest entry for meta.xml
- (org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
-
-(defun org-odt-update-styles-file (opt-plist)
- ;; write styles file
- (let ((styles-file (plist-get opt-plist :odt-styles-file)))
- (org-odt-copy-styles-file (and styles-file
- (read (org-trim styles-file)))))
-
- ;; Update styles.xml - take care of outline numbering
- (with-current-buffer
- (find-file-noselect (expand-file-name "styles.xml") t)
- ;; Don't make automatic backup of styles.xml file. This setting
- ;; prevents the backed-up styles.xml file from being zipped in to
- ;; odt file. This is more of a hackish fix. Better alternative
- ;; would be to fix the zip command so that the output odt file
- ;; includes only the needed files and excludes any auto-generated
- ;; extra files like backups and auto-saves etc etc. Note that
- ;; currently the zip command zips up the entire temp directory so
- ;; that any auto-generated files created under the hood ends up in
- ;; the resulting odt file.
- (set (make-local-variable 'backup-inhibited) t)
-
- ;; Import local setting of `org-export-with-section-numbers'
- (org-lparse-bind-local-variables opt-plist)
- (org-odt-configure-outline-numbering
- (if org-export-with-section-numbers org-export-headline-levels 0)))
-
- ;; Write custom styles for source blocks
- (org-odt-insert-custom-styles-for-srcblocks
- (mapconcat
- (lambda (style)
- (format " %s\n" (cddr style)))
- hfy-user-sheet-assoc "")))
-
-(defun org-odt-write-mimetype-file (format)
- ;; create mimetype file
- (let ((mimetype
- (case format
- (odt "application/vnd.oasis.opendocument.text")
- (odf "application/vnd.oasis.opendocument.formula")
- (t (error "Unknown OpenDocument backend %S" org-lparse-backend)))))
- (write-region mimetype nil (expand-file-name "mimetype"))
- mimetype))
-
-(defun org-odt-finalize-outfile ()
- (org-odt-delete-empty-paragraphs))
-
-(defun org-odt-delete-empty-paragraphs ()
- (goto-char (point-min))
- (let ((open "<text:p[^>]*>")
- (close "</text:p>"))
- (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t)
- (replace-match ""))))
-
-(defcustom org-export-odt-convert-processes
- '(("LibreOffice"
- "soffice --headless --convert-to %f%x --outdir %d %i")
- ("unoconv"
- "unoconv -f %f -o %d %i"))
- "Specify a list of document converters and their usage.
-The converters in this list are offered as choices while
-customizing `org-export-odt-convert-process'.
-
-This variable is a list where each element is of the
-form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
-of the converter. CONVERTER-CMD is the shell command for the
-converter and can contain format specifiers. These format
-specifiers are interpreted as below:
-
-%i input file name in full
-%I input file name as a URL
-%f format of the output file
-%o output file name in full
-%O output file name as a URL
-%d output dir in full
-%D output dir as a URL.
-%x extra options as set in `org-export-odt-convert-capabilities'."
- :group 'org-export-odt
- :version "24.1"
- :type
- '(choice
- (const :tag "None" nil)
- (alist :tag "Converters"
- :key-type (string :tag "Converter Name")
- :value-type (group (string :tag "Command line")))))
-
-(defcustom org-export-odt-convert-process "LibreOffice"
- "Use this converter to convert from \"odt\" format to other formats.
-During customization, the list of converter names are populated
-from `org-export-odt-convert-processes'."
- :group 'org-export-odt
- :version "24.1"
- :type '(choice :convert-widget
- (lambda (w)
- (apply 'widget-convert (widget-type w)
- (eval (car (widget-get w :args)))))
- `((const :tag "None" nil)
- ,@(mapcar (lambda (c)
- `(const :tag ,(car c) ,(car c)))
- org-export-odt-convert-processes))))
-
-(defcustom org-export-odt-convert-capabilities
- '(("Text"
- ("odt" "ott" "doc" "rtf" "docx")
- (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
- ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
- ("Web"
- ("html")
- (("pdf" "pdf") ("odt" "odt") ("html" "html")))
- ("Spreadsheet"
- ("ods" "ots" "xls" "csv" "xlsx")
- (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
- ("xls" "xls") ("xlsx" "xlsx")))
- ("Presentation"
- ("odp" "otp" "ppt" "pptx")
- (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
- ("pptx" "pptx") ("odg" "odg"))))
- "Specify input and output formats of `org-export-odt-convert-process'.
-More correctly, specify the set of input and output formats that
-the user is actually interested in.
-
-This variable is an alist where each element is of the
-form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
-INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
-alist where each element is of the form (OUTPUT-FMT
-OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
-
-The variable is interpreted as follows:
-`org-export-odt-convert-process' can take any document that is in
-INPUT-FMT-LIST and produce any document that is in the
-OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
-OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
-serves dual purposes:
-- It is used for populating completion candidates during
- `org-export-odt-convert' commands.
-- It is used as the value of \"%f\" specifier in
- `org-export-odt-convert-process'.
-
-EXTRA-OPTIONS is used as the value of \"%x\" specifier in
-`org-export-odt-convert-process'.
-
-DOCUMENT-CLASS is used to group a set of file formats in
-INPUT-FMT-LIST in to a single class.
-
-Note that this variable inherently captures how LibreOffice based
-converters work. LibreOffice maps documents of various formats
-to classes like Text, Web, Spreadsheet, Presentation etc and
-allow document of a given class (irrespective of it's source
-format) to be converted to any of the export formats associated
-with that class.
-
-See default setting of this variable for an typical
-configuration."
- :group 'org-export-odt
- :version "24.1"
- :type
- '(choice
- (const :tag "None" nil)
- (alist :tag "Capabilities"
- :key-type (string :tag "Document Class")
- :value-type
- (group (repeat :tag "Input formats" (string :tag "Input format"))
- (alist :tag "Output formats"
- :key-type (string :tag "Output format")
- :value-type
- (group (string :tag "Output file extension")
- (choice
- (const :tag "None" nil)
- (string :tag "Extra options"))))))))
-
-(declare-function org-create-math-formula "org"
- (latex-frag &optional mathml-file))
-
-;;;###autoload
-(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg)
- "Convert IN-FILE to format OUT-FMT using a command line converter.
-IN-FILE is the file to be converted. If unspecified, it defaults
-to variable `buffer-file-name'. OUT-FMT is the desired output
-format. Use `org-export-odt-convert-process' as the converter.
-If PREFIX-ARG is non-nil then the newly converted file is opened
-using `org-open-file'."
- (interactive
- (append (org-lparse-convert-read-params) current-prefix-arg))
- (org-lparse-do-convert in-file out-fmt prefix-arg))
-
-(defun org-odt-get (what &optional opt-plist)
- (case what
- (BACKEND 'odt)
- (EXPORT-DIR (org-export-directory :html opt-plist))
- (FILE-NAME-EXTENSION "odt")
- (EXPORT-BUFFER-NAME "*Org ODT Export*")
- (ENTITY-CONTROL org-odt-entity-control-callbacks-alist)
- (ENTITY-FORMAT org-odt-entity-format-callbacks-alist)
- (INIT-METHOD 'org-odt-init-outfile)
- (FINAL-METHOD 'org-odt-finalize-outfile)
- (SAVE-METHOD 'org-odt-save-as-outfile)
- (CONVERT-METHOD
- (and org-export-odt-convert-process
- (cadr (assoc-string org-export-odt-convert-process
- org-export-odt-convert-processes t))))
- (CONVERT-CAPABILITIES
- (and org-export-odt-convert-process
- (cadr (assoc-string org-export-odt-convert-process
- org-export-odt-convert-processes t))
- org-export-odt-convert-capabilities))
- (TOPLEVEL-HLEVEL 1)
- (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps)
- (INLINE-IMAGES 'maybe)
- (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg"))
- (PLAIN-TEXT-MAP '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
- (TABLE-FIRST-COLUMN-AS-LABELS nil)
- (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript))
- (CODING-SYSTEM-FOR-WRITE 'utf-8)
- (CODING-SYSTEM-FOR-SAVE 'utf-8)
- (t (error "Unknown property: %s" what))))
-
-(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse
-(defun org-export-odt-do-preprocess-latex-fragments ()
- "Convert LaTeX fragments to images."
- (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments))
- (latex-frag-opt ; massage the options
- (or (and (member latex-frag-opt '(mathjax t))
- (not (and (fboundp 'org-format-latex-mathml-available-p)
- (org-format-latex-mathml-available-p)))
- (prog1 org-lparse-latex-fragment-fallback
- (org-lparse-warn
- (concat
- "LaTeX to MathML converter not available. "
- (format "Using %S instead."
- org-lparse-latex-fragment-fallback)))))
- latex-frag-opt))
- cache-dir display-msg)
- (cond
- ((eq latex-frag-opt 'dvipng)
- (setq cache-dir org-latex-preview-ltxpng-directory)
- (setq display-msg "Creating LaTeX image %s"))
- ((member latex-frag-opt '(mathjax t))
- (setq latex-frag-opt 'mathml)
- (setq cache-dir "ltxmathml/")
- (setq display-msg "Creating MathML formula %s")))
- (when (and org-current-export-file)
- (org-format-latex
- (concat cache-dir (file-name-sans-extension
- (file-name-nondirectory org-current-export-file)))
- org-current-export-dir nil display-msg
- nil nil latex-frag-opt))))
-
-(defadvice org-format-latex-as-mathml
- (after org-odt-protect-latex-fragment activate)
- "Encode LaTeX fragment as XML.
-Do this when translation to MathML fails."
- (when (or (not (> (length ad-return-value) 0))
- (get-text-property 0 'org-protected ad-return-value))
- (setq ad-return-value
- (org-propertize (org-odt-encode-plain-text (ad-get-arg 0))
- 'org-protected t))))
-
-(defun org-export-odt-preprocess-latex-fragments ()
- (when (equal org-export-current-backend 'odt)
- (org-export-odt-do-preprocess-latex-fragments)))
-
-(defun org-export-odt-preprocess-label-references ()
- (goto-char (point-min))
- (let (label label-components category value pretty-label)
- (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
- (org-if-unprotected-at (match-beginning 1)
- (replace-match
- (let ((org-lparse-encode-pending t)
- (label (match-string 1)))
- ;; markup generated below is mostly an eye-candy. At
- ;; pre-processing stage, there is no information on which
- ;; entity a label reference points to. The actual markup
- ;; is generated as part of `org-odt-fixup-label-references'
- ;; which gets called at the fag end of export. By this
- ;; time we would have seen and collected all the label
- ;; definitions in `org-odt-entity-labels-alist'.
- (org-odt-format-tags
- '("<text:sequence-ref text:ref-name=\"%s\">" .
- "</text:sequence-ref>")
- "" (org-add-props label '(org-protected t)))) t t)))))
-
-;; process latex fragments as part of
-;; `org-export-preprocess-after-blockquote-hook'. Note that this hook
-;; is the one that is closest and well before the call to
-;; `org-export-attach-captions-and-attributes' in
-;; `org-export-preprocess-string'. The above arrangement permits
-;; captions, labels and attributes to be attached to png images
-;; generated out of latex equations.
-(add-hook 'org-export-preprocess-after-blockquote-hook
- 'org-export-odt-preprocess-latex-fragments)
-
-(defun org-export-odt-preprocess (parameters)
- (org-export-odt-preprocess-label-references))
-
-(declare-function archive-zip-extract "arc-mode" (archive name))
-(defun org-odt-zip-extract-one (archive member &optional target)
- (require 'arc-mode)
- (let* ((target (or target default-directory))
- (archive (expand-file-name archive))
- (archive-zip-extract
- (list "unzip" "-qq" "-o" "-d" target))
- exit-code command-output)
- (setq command-output
- (with-temp-buffer
- (setq exit-code (archive-zip-extract archive member))
- (buffer-string)))
- (unless (zerop exit-code)
- (message command-output)
- (error "Extraction failed"))))
-
-(defun org-odt-zip-extract (archive members &optional target)
- (when (atom members) (setq members (list members)))
- (mapc (lambda (member)
- (org-odt-zip-extract-one archive member target))
- members))
-
-(defun org-odt-copy-styles-file (&optional styles-file)
- ;; Non-availability of styles.xml is not a critical error. For now
- ;; throw an error purely for aesthetic reasons.
- (setq styles-file (or styles-file
- org-export-odt-styles-file
- (expand-file-name "OrgOdtStyles.xml"
- org-odt-styles-dir)
- (error "org-odt: Missing styles file?")))
- (cond
- ((listp styles-file)
- (let ((archive (nth 0 styles-file))
- (members (nth 1 styles-file)))
- (org-odt-zip-extract archive members)
- (mapc
- (lambda (member)
- (when (org-file-image-p member)
- (let* ((image-type (file-name-extension member))
- (media-type (format "image/%s" image-type)))
- (org-odt-create-manifest-file-entry media-type member))))
- members)))
- ((and (stringp styles-file) (file-exists-p styles-file))
- (let ((styles-file-type (file-name-extension styles-file)))
- (cond
- ((string= styles-file-type "xml")
- (copy-file styles-file "styles.xml" t))
- ((member styles-file-type '("odt" "ott"))
- (org-odt-zip-extract styles-file "styles.xml")))))
- (t
- (error (format "Invalid specification of styles.xml file: %S"
- org-export-odt-styles-file))))
-
- ;; create a manifest entry for styles.xml
- (org-odt-create-manifest-file-entry "text/xml" "styles.xml"))
-
-(defun org-odt-configure-outline-numbering (level)
- "Outline numbering is retained only upto LEVEL.
-To disable outline numbering pass a LEVEL of 0."
- (goto-char (point-min))
- (let ((regex
- "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
- (replacement
- "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
- (while (re-search-forward regex nil t)
- (when (> (string-to-number (match-string 2)) level)
- (replace-match replacement t nil))))
- (save-buffer 0))
-
-;;;###autoload
-(defun org-export-as-odf (latex-frag &optional odf-file)
- "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
-Use `org-create-math-formula' to convert LATEX-FRAG first to
-MathML. When invoked as an interactive command, use
-`org-latex-regexps' to infer LATEX-FRAG from currently active
-region. If no LaTeX fragments are found, prompt for it. Push
-MathML source to kill ring, if `org-export-copy-to-kill-ring' is
-non-nil."
- (interactive
- `(,(let (frag)
- (setq frag (and (setq frag (and (org-region-active-p)
- (buffer-substring (region-beginning)
- (region-end))))
- (loop for e in org-latex-regexps
- thereis (when (string-match (nth 1 e) frag)
- (match-string (nth 2 e) frag)))))
- (read-string "LaTeX Fragment: " frag nil frag))
- ,(let ((odf-filename (expand-file-name
- (concat
- (file-name-sans-extension
- (or (file-name-nondirectory buffer-file-name)))
- "." "odf")
- (file-name-directory buffer-file-name))))
- (read-file-name "ODF filename: " nil odf-filename nil
- (file-name-nondirectory odf-filename)))))
- (org-odt-cleanup-xml-buffers
- (let* ((org-lparse-backend 'odf)
- org-lparse-opt-plist
- (filename (or odf-file
- (expand-file-name
- (concat
- (file-name-sans-extension
- (or (file-name-nondirectory buffer-file-name)))
- "." "odf")
- (file-name-directory buffer-file-name))))
- (buffer (find-file-noselect (org-odt-init-outfile filename)))
- (coding-system-for-write 'utf-8)
- (save-buffer-coding-system 'utf-8))
- (set-buffer buffer)
- (set-buffer-file-coding-system coding-system-for-write)
- (let ((mathml (org-create-math-formula latex-frag)))
- (unless mathml (error "No Math formula created"))
- (insert mathml)
- (or (org-export-push-to-kill-ring
- (upcase (symbol-name org-lparse-backend)))
- (message "Exporting... done")))
- (org-odt-save-as-outfile filename nil))))
-
-;;;###autoload
-(defun org-export-as-odf-and-open ()
- "Export LaTeX fragment as OpenDocument formula and immediately open it.
-Use `org-export-as-odf' to read LaTeX fragment and OpenDocument
-formula file."
- (interactive)
- (org-lparse-and-open
- nil nil nil (call-interactively 'org-export-as-odf)))
-
-(provide 'org-odt)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-odt.el ends here
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 7ae80b02e2f..30d3b1cab25 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -1,6 +1,6 @@
;;; org-pcomplete.el --- In-buffer completion code
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; John Wiegley <johnw at gnu dot org>
@@ -35,9 +35,8 @@
(require 'pcomplete)
(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-get-current-options "org-exp" ())
(declare-function org-make-org-heading-search-string "org"
- (&optional string heading))
+ (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
@@ -46,7 +45,6 @@
;;;; Customization variables
-;; Unused. Cf org-completion.
(defgroup org-complete nil
"Outline-based notes management and organizer."
:tag "Org"
@@ -110,11 +108,11 @@ When completing for #+STARTUP, for example, this function returns
(let ((thing (org-thing-at-point)))
(cond
((string= "file-option" (car thing))
- (concat (car thing) "/" (downcase (cdr thing))))
+ (concat (car thing)
+ (and (cdr thing) (concat "/" (downcase (cdr thing))))))
((string= "block-option" (car thing))
(concat (car thing) "/" (downcase (cdr thing))))
- (t
- (car thing)))))
+ (t (car thing)))))
(defun org-parse-arguments ()
"Parse whitespace separated arguments in the current region."
@@ -141,21 +139,86 @@ When completing for #+STARTUP, for example, this function returns
(car (org-thing-at-point)))
pcomplete-default-completion-function))))
-(defvar org-options-keywords) ; From org.el
-(defvar org-additional-option-like-keywords) ; From org.el
+(defvar org-options-keywords) ; From org.el
+(defvar org-element-block-name-alist) ; From org-element.el
+(defvar org-element-affiliated-keywords) ; From org-element.el
+(declare-function org-get-export-keywords "org" ())
(defun pcomplete/org-mode/file-option ()
"Complete against all valid file options."
- (require 'org-exp)
+ (require 'org-element)
(pcomplete-here
(org-pcomplete-case-double
- (mapcar (lambda (x)
- (if (= ?: (aref x (1- (length x))))
- (concat x " ")
- x))
- (append org-options-keywords
- org-additional-option-like-keywords)))
+ (append (mapcar (lambda (keyword) (concat keyword " "))
+ org-options-keywords)
+ (mapcar (lambda (keyword) (concat keyword ": "))
+ org-element-affiliated-keywords)
+ (let (block-names)
+ (dolist (block-info org-element-block-name-alist block-names)
+ (let ((name (car block-info)))
+ (push (format "END_%s" name) block-names)
+ (push (concat "BEGIN_"
+ name
+ ;; Since language is compulsory in
+ ;; source blocks, add a space.
+ (and (equal name "SRC") " "))
+ block-names)
+ (push (format "ATTR_%s: " name) block-names))))
+ (mapcar (lambda (keyword) (concat keyword ": "))
+ (org-get-export-keywords))))
(substring pcomplete-stub 2)))
+(defun pcomplete/org-mode/file-option/author ()
+ "Complete arguments for the #+AUTHOR file option."
+ (pcomplete-here (list user-full-name)))
+
+(defvar org-time-stamp-formats)
+(defun pcomplete/org-mode/file-option/date ()
+ "Complete arguments for the #+DATE file option."
+ (pcomplete-here (list (format-time-string (car org-time-stamp-formats)))))
+
+(defun pcomplete/org-mode/file-option/email ()
+ "Complete arguments for the #+EMAIL file option."
+ (pcomplete-here (list user-mail-address)))
+
+(defvar org-export-exclude-tags)
+(defun pcomplete/org-mode/file-option/exclude_tags ()
+ "Complete arguments for the #+EXCLUDE_TAGS file option."
+ (require 'ox)
+ (pcomplete-here
+ (and org-export-exclude-tags
+ (list (mapconcat 'identity org-export-exclude-tags " ")))))
+
+(defvar org-file-tags)
+(defun pcomplete/org-mode/file-option/filetags ()
+ "Complete arguments for the #+FILETAGS file option."
+ (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " "))))
+
+(defvar org-export-default-language)
+(defun pcomplete/org-mode/file-option/language ()
+ "Complete arguments for the #+LANGUAGE file option."
+ (require 'ox)
+ (pcomplete-here
+ (pcomplete-uniqify-list
+ (list org-export-default-language "en"))))
+
+(defvar org-default-priority)
+(defvar org-highest-priority)
+(defvar org-lowest-priority)
+(defun pcomplete/org-mode/file-option/priorities ()
+ "Complete arguments for the #+PRIORITIES file option."
+ (pcomplete-here (list (format "%c %c %c"
+ org-highest-priority
+ org-lowest-priority
+ org-default-priority))))
+
+(defvar org-export-select-tags)
+(defun pcomplete/org-mode/file-option/select_tags ()
+ "Complete arguments for the #+SELECT_TAGS file option."
+ (require 'ox)
+ (pcomplete-here
+ (and org-export-select-tags
+ (list (mapconcat 'identity org-export-select-tags " ")))))
+
(defvar org-startup-options)
(defun pcomplete/org-mode/file-option/startup ()
"Complete arguments for the #+STARTUP file option."
@@ -170,37 +233,57 @@ When completing for #+STARTUP, for example, this function returns
(setq opts (delete "showstars" opts)))))
opts))))
-(defmacro pcomplete/org-mode/file-option/x (option)
- "Complete arguments for OPTION."
- `(while
- (pcomplete-here
- (pcomplete-uniqify-list
- (delq nil
- (mapcar (lambda(o)
- (when (string-match (concat "^[ \t]*#\\+"
- ,option ":[ \t]+\\(.*\\)[ \t]*$") o)
- (match-string 1 o)))
- (split-string (org-get-current-options) "\n")))))))
-
-(defun pcomplete/org-mode/file-option/options ()
- "Complete arguments for the #+OPTIONS file option."
- (pcomplete/org-mode/file-option/x "OPTIONS"))
+(defvar org-tag-alist)
+(defun pcomplete/org-mode/file-option/tags ()
+ "Complete arguments for the #+TAGS file option."
+ (pcomplete-here
+ (list
+ (mapconcat (lambda (x)
+ (cond
+ ((eq :startgroup (car x)) "{")
+ ((eq :endgroup (car x)) "}")
+ ((eq :grouptags (car x)) ":")
+ ((eq :newline (car x)) "\\n")
+ ((cdr x) (format "%s(%c)" (car x) (cdr x)))
+ (t (car x))))
+ org-tag-alist " "))))
(defun pcomplete/org-mode/file-option/title ()
"Complete arguments for the #+TITLE file option."
- (pcomplete/org-mode/file-option/x "TITLE"))
-
-(defun pcomplete/org-mode/file-option/author ()
- "Complete arguments for the #+AUTHOR file option."
- (pcomplete/org-mode/file-option/x "AUTHOR"))
+ (pcomplete-here
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list (or (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file)))
+ (buffer-name (buffer-base-buffer)))))))
-(defun pcomplete/org-mode/file-option/email ()
- "Complete arguments for the #+EMAIL file option."
- (pcomplete/org-mode/file-option/x "EMAIL"))
-(defun pcomplete/org-mode/file-option/date ()
- "Complete arguments for the #+DATE file option."
- (pcomplete/org-mode/file-option/x "DATE"))
+(declare-function org-export-backend-options "org-export" (cl-x))
+(defun pcomplete/org-mode/file-option/options ()
+ "Complete arguments for the #+OPTIONS file option."
+ (while (pcomplete-here
+ (pcomplete-uniqify-list
+ (append
+ ;; Hard-coded OPTION items always available.
+ '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:"
+ "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:"
+ "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:"
+ "|:" "tags:" "tasks:" "<:" "todo:")
+ ;; OPTION items from registered back-ends.
+ (let (items)
+ (dolist (backend (org-bound-and-true-p
+ org-export--registered-backends))
+ (dolist (option (org-export-backend-options backend))
+ (let ((item (nth 2 option)))
+ (when item (push (concat item ":") items)))))
+ items))))))
+
+(defun pcomplete/org-mode/file-option/infojs_opt ()
+ "Complete arguments for the #+INFOJS_OPT file option."
+ (while (pcomplete-here
+ (pcomplete-uniqify-list
+ (mapcar (lambda (item) (format "%s:" (car item)))
+ (org-bound-and-true-p org-html-infojs-opts-table))))))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names."
@@ -243,7 +326,7 @@ This needs more work, to handle headings with lots of spaces in them."
(let (tbl)
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
- (match-string-no-properties 3) t)
+ (match-string-no-properties 3))
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
@@ -291,7 +374,7 @@ This needs more work, to handle headings with lots of spaces in them."
(cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
(pcomplete-here cpllist
(substring pcomplete-stub 1)
- (unless (or (not (delete
+ (unless (or (not (delq
nil
(mapcar (lambda(x)
(string-match (substring pcomplete-stub 1) x))
@@ -313,16 +396,16 @@ Complete a language in the first field, the header arguments and switches."
'("-n" "-r" "-l"
":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
- ":session" ":shebang" ":tangle" ":var"))))
+ ":session" ":shebang" ":tangle" ":tangle-mode" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line."
- (while (pcomplete-here '(":maxlevel" ":scope"
+ (while (pcomplete-here '(":maxlevel" ":scope" ":lang"
":tstart" ":tend" ":block" ":step"
":stepskip0" ":fileskip0"
":emphasize" ":link" ":narrow" ":indent"
":tcolumns" ":level" ":compact" ":timestamp"
- ":formula" ":formatter"))))
+ ":formula" ":formatter" ":wstart" ":mstart"))))
(defun org-pcomplete-case-double (list)
"Return list with both upcase and downcase version of all strings in LIST."
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 02d747d5441..fd6b4edbd0a 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -1,6 +1,6 @@
;;; org-plot.el --- Support for plotting from Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
@@ -30,7 +30,6 @@
;;; Code:
(require 'org)
-(require 'org-exp)
(require 'org-table)
(eval-when-compile
(require 'cl))
@@ -95,7 +94,7 @@ Return value is the point at the beginning of the table."
(goto-char (org-table-begin)))
(defun org-plot/collect-options (&optional params)
- "Collect options from an org-plot '#+Plot:' line.
+ "Collect options from an org-plot `#+Plot:' line.
Accepts an optional property list PARAMS, to which the options
will be added. Returns the resulting property list."
(interactive)
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 18c6d6d70a4..339f2b74afd 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -1,8 +1,8 @@
;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
;;
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;;
-;; Authors: Bastien Guerry <bzg AT gnu DOT org>
+;; Authors: Bastien Guerry <bzg@gnu.org>
;; Daniel M German <dmg AT uvic DOT org>
;; Sebastian Rose <sebastian_rose AT gmx DOT de>
;; Ross Patterson <me AT rpatterson DOT net>
@@ -91,11 +91,6 @@
;; Org-link of which the page title will be the description part. If text
;; was select in the browser, that text will be the body of the entry.
;;
-;; * Call `org-protocol-remember' by using the sub-protocol \"remember\".
-;; This is provided for backward compatibility.
-;; You may read `org-capture' as `org-remember' throughout this file if
-;; you still use `org-remember'.
-;;
;; You may use the same bookmark URL for all those standard handlers and just
;; adjust the sub-protocol used:
;;
@@ -155,8 +150,7 @@ for `org-protocol-the-protocol' and sub-protocols defined in
;;; Variables:
(defconst org-protocol-protocol-alist-default
- '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t)
- ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t)
+ '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t)
("org-store-link" :protocol "store-link" :function org-protocol-store-link)
("org-open-source" :protocol "open-source" :function org-protocol-open-source))
"Default protocols to use.
@@ -203,7 +197,7 @@ Possible properties are:
Example:
(setq org-protocol-project-alist
- '((\"http://orgmode.org/worg/\"
+ \\='((\"http://orgmode.org/worg/\"
:online-suffix \".php\"
:working-suffix \".org\"
:base-url \"http://orgmode.org/worg/\"
@@ -257,7 +251,7 @@ kill-client - If t, kill the client immediately, once the sub-protocol is
Here is an example:
(setq org-protocol-protocol-alist
- '((\"my-protocol\"
+ \\='((\"my-protocol\"
:protocol \"my-protocol\"
:function my-protocol-handler-function)
(\"your-protocol\"
@@ -271,12 +265,14 @@ Here is an example:
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol
- :type 'string)
+ :type '(choice (const nil) (string)))
-(defcustom org-protocol-data-separator "/+"
+(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
This should be a single regexp string."
:group 'org-protocol
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type 'string)
;;; Helper functions:
@@ -297,7 +293,7 @@ nil, assume \"/+\". The results of that splitting are returned
as a list. If UNHEXIFY is non-nil, hex-decode each split part.
If UNHEXIFY is a function, use that function to decode each split
part."
- (let* ((sep (or separator "/+"))
+ (let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
(if (fboundp unhexify)
@@ -307,7 +303,7 @@ part."
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Greedy handlers might receive a list like this from emacsclient:
- '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
+ ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclients working directory. This
function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows:
@@ -351,7 +347,7 @@ returned list."
(defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient:
- '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
+ ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
(if (null l) ()
@@ -369,9 +365,9 @@ link's URL to the `kill-ring'.
The location for a browser's bookmark has to look like this:
- javascript:location.href='org-protocol://store-link://'+ \\
+ javascript:location.href=\\='org-protocol://store-link://\\='+ \\
encodeURIComponent(location.href)
- encodeURIComponent(document.title)+'/'+ \\
+ encodeURIComponent(document.title)+\\='/\\='+ \\
Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
could contain slashes and the location definitely will.
@@ -391,54 +387,42 @@ The sub-protocol used to reach this function is set in
uri))
nil)
-(defun org-protocol-remember (info)
- "Process an org-protocol://remember:// style url.
-
-The location for a browser's bookmark has to look like this:
-
- javascript:location.href='org-protocol://remember://'+ \\
- encodeURIComponent(location.href)+'/' \\
- encodeURIComponent(document.title)+'/'+ \\
- encodeURIComponent(window.getSelection())
-
-See the docs for `org-protocol-capture' for more information."
-
- (if (and (boundp 'org-stored-links)
- (fboundp 'org-capture)
- (org-protocol-do-capture info 'org-remember))
- (message "Item remembered."))
- nil)
-
(defun org-protocol-capture (info)
"Process an org-protocol://capture:// style url.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
-This function detects an URL, title and optional text, separated by '/'
-The location for a browser's bookmark has to look like this:
+This function detects an URL, title and optional text, separated
+by `/'. The location for a browser's bookmark looks like this:
- javascript:location.href='org-protocol://capture://'+ \\
- encodeURIComponent(location.href)+'/' \\
- encodeURIComponent(document.title)+'/'+ \\
+ javascript:location.href=\\='org-protocol://capture://\\='+ \\
+ encodeURIComponent(location.href)+\\='/\\=' \\
+ encodeURIComponent(document.title)+\\='/\\='+ \\
encodeURIComponent(window.getSelection())
By default, it uses the character `org-protocol-default-template-key',
which should be associated with a template in `org-capture-templates'.
But you may prepend the encoded URL with a character and a slash like so:
- javascript:location.href='org-protocol://capture://b/'+ ...
+ javascript:location.href=\\='org-protocol://capture://b/\\='+ ...
Now template ?b will be used."
(if (and (boundp 'org-stored-links)
- (fboundp 'org-capture)
- (org-protocol-do-capture info 'org-capture))
+ (org-protocol-do-capture info))
(message "Item captured."))
nil)
-(defun org-protocol-do-capture (info capture-func)
- "Support `org-capture' and `org-remember' alike.
-CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
+(defun org-protocol-convert-query-to-plist (query)
+ "Convert query string that is part of url to property list."
+ (if query
+ (apply 'append (mapcar (lambda (x)
+ (let ((c (split-string x "=")))
+ (list (intern (concat ":" (car c))) (cadr c))))
+ (split-string query "&")))))
+
+(defun org-protocol-do-capture (info)
+ "Support `org-capture'."
(let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
(template (or (and (>= 2 (length (car parts))) (pop parts))
org-protocol-default-template-key))
@@ -449,8 +433,8 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(region (or (caddr parts) ""))
(orglink (org-make-link-string
url (if (string-match "[^[:space:]]" title) title url)))
- (org-capture-link-is-already-stored t) ;; avoid call to org-store-link
- remember-annotation-functions)
+ (query (or (org-protocol-convert-query-to-plist (cadddr parts)) ""))
+ (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
(setq org-stored-links
(cons (list url title) org-stored-links))
(kill-new orglink)
@@ -458,9 +442,10 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
:link url
:description title
:annotation orglink
- :initial region)
+ :initial region
+ :query query)
(raise-frame)
- (funcall capture-func nil template)))
+ (funcall 'org-capture nil template)))
(defun org-protocol-open-source (fname)
"Process an org-protocol://open-source:// style url.
@@ -470,7 +455,7 @@ in `org-protocol-project-alist'.
The location for a browser's bookmark should look like this:
- javascript:location.href='org-protocol://open-source://'+ \\
+ javascript:location.href=\\='org-protocol://open-source://\\='+ \\
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
@@ -576,7 +561,7 @@ as filename."
(let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
- (if (eq fname t) ;; greedy? We need the `t' return value.
+ (if (eq fname t) ;; greedy? We need the t return value.
(progn
(ad-set-arg 0 nil)
(throw 'greedy t))
@@ -588,9 +573,9 @@ as filename."
(defun org-protocol-create-for-org ()
"Create a org-protocol project for the current file's Org-mode project.
-This works, if the file visited is part of a publishing project in
-`org-publish-project-alist'. This function calls `org-protocol-create' to do
-most of the work."
+The visited file needs to be part of a publishing project in
+`org-publish-project-alist' for this to work. The function
+delegates most of the work to `org-protocol-create'."
(interactive)
(require 'org-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
@@ -600,10 +585,11 @@ most of the work."
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
-An org-protocol project is an entry in `org-protocol-project-alist'
-which is used by `org-protocol-open-source'.
-Optionally use project-plist to initialize the defaults for this project. If
-project-plist is the CDR of an element in `org-publish-project-alist', reuse
+An org-protocol project is an entry in
+`org-protocol-project-alist' which is used by
+`org-protocol-open-source'. Optionally use PROJECT-PLIST to
+initialize the defaults for this project. If PROJECT-PLIST is
+the cdr of an element in `org-publish-project-alist', reuse
:base-directory, :html-extension and :base-extension."
(interactive)
(let ((working-dir (expand-file-name
diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el
deleted file mode 100644
index 20c6a6860aa..00000000000
--- a/lisp/org/org-publish.el
+++ /dev/null
@@ -1,1198 +0,0 @@
-;;; org-publish.el --- publish related org-mode files as a website
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
-
-;; Author: David O'Toole <dto@gnu.org>
-;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
-;; Keywords: hypermedia, outlines, wp
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This program allow configurable publishing of related sets of
-;; Org-mode files as a complete website.
-;;
-;; org-publish.el can do the following:
-;;
-;; + Publish all one's org-files to HTML or PDF
-;; + Upload HTML, images, attachments and other files to a web server
-;; + Exclude selected private pages from publishing
-;; + Publish a clickable sitemap of pages
-;; + Manage local timestamps for publishing only changed files
-;; + Accept plugin functions to extend range of publishable content
-;;
-;; Documentation for publishing is in the manual.
-
-;;; Code:
-
-
-(eval-when-compile
- (require 'cl))
-(require 'org)
-(require 'org-exp)
-(require 'format-spec)
-
-(eval-and-compile
- (unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional arglist fileonly))))
-
-(defvar org-publish-initial-buffer nil
- "The buffer `org-publish' has been called from.")
-
-(defvar org-publish-temp-files nil
- "Temporary list of files to be published.")
-
-;; Here, so you find the variable right before it's used the first time:
-(defvar org-publish-cache nil
- "This will cache timestamps and titles for files in publishing projects.
-Blocks could hash sha1 values here.")
-
-(defgroup org-publish nil
- "Options for publishing a set of Org-mode and related files."
- :tag "Org Publishing"
- :group 'org)
-
-(defcustom org-publish-project-alist nil
- "Association list to control publishing behavior.
-Each element of the alist is a publishing 'project.' The CAR of
-each element is a string, uniquely identifying the project. The
-CDR of each element is in one of the following forms:
-
-1. A well-formed property list with an even number of elements, alternating
- keys and values, specifying parameters for the publishing process.
-
- (:property value :property value ... )
-
-2. A meta-project definition, specifying of a list of sub-projects:
-
- (:components (\"project-1\" \"project-2\" ...))
-
-When the CDR of an element of org-publish-project-alist is in
-this second form, the elements of the list after :components are
-taken to be components of the project, which group together files
-requiring different publishing options. When you publish such a
-project with \\[org-publish], the components all publish.
-
-When a property is given a value in org-publish-project-alist, its
-setting overrides the value of the corresponding user variable
-\(if any) during publishing. However, options set within a file
-override everything.
-
-Most properties are optional, but some should always be set:
-
- :base-directory Directory containing publishing source files
- :base-extension Extension (without the dot!) of source files.
- This can be a regular expression. If not given,
- \"org\" will be used as default extension.
- :publishing-directory Directory (possibly remote) where output
- files will be published
-
-The :exclude property may be used to prevent certain files from
-being published. Its value may be a string or regexp matching
-file names you don't want to be published.
-
-The :include property may be used to include extra files. Its
-value may be a list of filenames to include. The filenames are
-considered relative to the base directory.
-
-When both :include and :exclude properties are given values, the
-exclusion step happens first.
-
-One special property controls which back-end function to use for
-publishing files in the project. This can be used to extend the
-set of file types publishable by org-publish, as well as the set
-of output formats.
-
- :publishing-function Function to publish file. The default is
- `org-publish-org-to-html', but other
- values are possible. May also be a
- list of functions, in which case
- each function in the list is invoked
- in turn.
-
-Another property allows you to insert code that prepares a
-project for publishing. For example, you could call GNU Make on a
-certain makefile, to ensure published files are built up to date.
-
- :preparation-function Function to be called before publishing
- this project. This may also be a list
- of functions.
- :completion-function Function to be called after publishing
- this project. This may also be a list
- of functions.
-
-Some properties control details of the Org publishing process,
-and are equivalent to the corresponding user variables listed in
-the right column. See the documentation for those variables to
-learn more about their use and default values.
-
- :language `org-export-default-language'
- :headline-levels `org-export-headline-levels'
- :section-numbers `org-export-with-section-numbers'
- :table-of-contents `org-export-with-toc'
- :emphasize `org-export-with-emphasize'
- :sub-superscript `org-export-with-sub-superscripts'
- :TeX-macros `org-export-with-TeX-macros'
- :fixed-width `org-export-with-fixed-width'
- :tables `org-export-with-tables'
- :table-auto-headline `org-export-highlight-first-table-line'
- :style `org-export-html-style'
- :convert-org-links `org-export-html-link-org-files-as-html'
- :inline-images `org-export-html-inline-images'
- :expand-quoted-html `org-export-html-expand'
- :timestamp `org-export-html-with-timestamp'
- :publishing-directory `org-export-publishing-directory'
- :html-preamble `org-export-html-preamble'
- :html-postamble `org-export-html-postamble'
- :author `user-full-name'
- :email `user-mail-address'
-
-The following properties may be used to control publishing of a
-sitemap of files or summary page for a given project.
-
- :auto-sitemap Whether to publish a sitemap during
- `org-publish-current-project' or `org-publish-all'.
- :sitemap-filename Filename for output of sitemap. Defaults
- to 'sitemap.org' (which becomes 'sitemap.html').
- :sitemap-title Title of sitemap page. Defaults to name of file.
- :sitemap-function Plugin function to use for generation of sitemap.
- Defaults to `org-publish-org-sitemap', which
- generates a plain list of links to all files
- in the project.
- :sitemap-style Can be `list' (sitemap is just an itemized list
- of the titles of the files involved) or
- `tree' (the directory structure of the source
- files is reflected in the sitemap). Defaults to
- `tree'.
- :sitemap-sans-extension Remove extension from sitemap's
- filenames. Useful to have cool
- URIs (see
- http://www.w3.org/Provider/Style/URI).
- Defaults to nil.
-
- If you create a sitemap file, adjust the sorting like this:
-
- :sitemap-sort-folders Where folders should appear in the sitemap.
- Set this to `first' (default) or `last' to
- display folders first or last, respectively.
- Any other value will mix files and folders.
- :sitemap-sort-files The site map is normally sorted alphabetically.
- You can change this behaviour setting this to
- `chronologically', `anti-chronologically' or nil.
- :sitemap-ignore-case Should sorting be case-sensitive? Default nil.
-
-The following properties control the creation of a concept index.
-
- :makeindex Create a concept index.
-
-Other properties affecting publication.
-
- :body-only Set this to 't' to publish only the body of the
- documents, excluding everything outside and
- including the <body> tags in HTML, or
- \begin{document}..\end{document} in LaTeX."
- :group 'org-publish
- :type 'alist)
-
-(defcustom org-publish-use-timestamps-flag t
- "Non-nil means use timestamp checking to publish only changed files.
-When nil, do no timestamp checking and always publish all files."
- :group 'org-publish
- :type 'boolean)
-
-(defcustom org-publish-timestamp-directory (convert-standard-filename
- "~/.org-timestamps/")
- "Name of directory in which to store publishing timestamps."
- :group 'org-publish
- :type 'directory)
-
-(defcustom org-publish-list-skipped-files t
- "Non-nil means show message about files *not* published."
- :group 'org-publish
- :type 'boolean)
-
-(defcustom org-publish-before-export-hook nil
- "Hook run before export on the Org file.
-The hook may modify the file in arbitrary ways before publishing happens.
-The original version of the buffer will be restored after publishing."
- :group 'org-publish
- :type 'hook)
-
-(defcustom org-publish-after-export-hook nil
- "Hook run after export on the exported buffer.
-Any changes made by this hook will be saved."
- :group 'org-publish
- :type 'hook)
-
-(defcustom org-publish-sitemap-sort-files 'alphabetically
- "How sitemaps files should be sorted by default?
-Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil.
-If `alphabetically', files will be sorted alphabetically.
-If `chronologically', files will be sorted with older modification time first.
-If `anti-chronologically', files will be sorted with newer modification time first.
-nil won't sort files.
-
-You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-sort-files'."
- :group 'org-publish
- :version "24.1"
- :type 'symbol)
-
-(defcustom org-publish-sitemap-sort-folders 'first
- "A symbol, denoting if folders are sorted first in sitemaps.
-Possible values are `first', `last', and nil.
-If `first', folders will be sorted before files.
-If `last', folders are sorted to the end after the files.
-Any other value will not mix files and folders.
-
-You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-sort-folders'."
- :group 'org-publish
- :version "24.1"
- :type 'symbol)
-
-(defcustom org-publish-sitemap-sort-ignore-case nil
- "Sort sitemaps case insensitively by default?
-
-You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-ignore-case'."
- :group 'org-publish
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
- "Format for `format-time-string' which is used to print a date
-in the sitemap."
- :group 'org-publish
- :version "24.1"
- :type 'string)
-
-(defcustom org-publish-sitemap-file-entry-format "%t"
- "How a sitemap file entry is formatted.
-You could use brackets to delimit on what part the link will be.
-
-%t is the title.
-%a is the author.
-%d is the date formatted using `org-publish-sitemap-date-format'."
- :group 'org-publish
- :version "24.1"
- :type 'string)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Sanitize-plist (FIXME why?)
-
-(defun org-publish-sanitize-plist (plist)
- ;; FIXME document
- (mapcar (lambda (x)
- (or (cdr (assq x '((:index-filename . :sitemap-filename)
- (:index-title . :sitemap-title)
- (:index-function . :sitemap-function)
- (:index-style . :sitemap-style)
- (:auto-index . :auto-sitemap))))
- x))
- plist))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Timestamp-related functions
-
-(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
- "Return path to timestamp file for filename FILENAME."
- (setq filename (concat filename "::" (or pub-dir "") "::"
- (format "%s" (or pub-func ""))))
- (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
-
-(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir)
- "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC.
-TRUE-PUB-DIR is where the file will truly end up. Currently we are not using
-this - maybe it can eventually be used to check if the file is present at
-the target location, and how old it is. Right now we cannot do this, because
-we do not know under what file name the file will be stored - the publishing
-function can still decide about that independently."
- (let ((rtn
- (if org-publish-use-timestamps-flag
- (org-publish-cache-file-needs-publishing
- filename pub-dir pub-func base-dir)
- ;; don't use timestamps, always return t
- t)))
- (if rtn
- (message "Publishing file %s using `%s'" filename pub-func)
- (when org-publish-list-skipped-files
- (message "Skipping unmodified file %s" filename)))
- rtn))
-
-(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir)
- "Update publishing timestamp for file FILENAME.
-If there is no timestamp, create one."
- (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
- (stamp (org-publish-cache-ctime-of-src filename)))
- (org-publish-cache-set key stamp)))
-
-(defun org-publish-remove-all-timestamps ()
- "Remove all files in the timestamp directory."
- (let ((dir org-publish-timestamp-directory)
- files)
- (when (and (file-exists-p dir)
- (file-directory-p dir))
- (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
- (org-publish-reset-cache))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Compatibility aliases
-
-;; Delete-dups is not in Emacs <22
-(if (fboundp 'delete-dups)
- (defalias 'org-publish-delete-dups 'delete-dups)
- (defun org-publish-delete-dups (list)
- "Destructively remove `equal' duplicates from LIST.
-Store the result in LIST and return it. LIST must be a proper list.
-Of several `equal' occurrences of an element in LIST, the first
-one is kept.
-
-This is a compatibility function for Emacsen without `delete-dups'."
- ;; Code from `subr.el' in Emacs 22:
- (let ((tail list))
- (while tail
- (setcdr tail (delete (car tail) (cdr tail)))
- (setq tail (cdr tail))))
- list))
-
-(declare-function org-publish-delete-dups "org-publish" (list))
-(declare-function find-lisp-find-files "find-lisp" (directory regexp))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Getting project information out of org-publish-project-alist
-
-(defun org-publish-expand-projects (projects-alist)
- "Expand projects in PROJECTS-ALIST.
-This splices all the components into the list."
- (let ((rest projects-alist) rtn p components)
- (while (setq p (pop rest))
- (if (setq components (plist-get (cdr p) :components))
- (setq rest (append
- (mapcar (lambda (x) (assoc x org-publish-project-alist))
- components)
- rest))
- (push p rtn)))
- (nreverse (org-publish-delete-dups (delq nil rtn)))))
-
-(defvar org-sitemap-sort-files)
-(defvar org-sitemap-sort-folders)
-(defvar org-sitemap-ignore-case)
-(defvar org-sitemap-requested)
-(defvar org-sitemap-date-format)
-(defvar org-sitemap-file-entry-format)
-(defun org-publish-compare-directory-files (a b)
- "Predicate for `sort', that sorts folders and files for sitemap."
- (let ((retval t))
- (when (or org-sitemap-sort-files org-sitemap-sort-folders)
- ;; First we sort files:
- (when org-sitemap-sort-files
- (cond ((equal org-sitemap-sort-files 'alphabetically)
- (let* ((adir (file-directory-p a))
- (aorg (and (string-match "\\.org$" a) (not adir)))
- (bdir (file-directory-p b))
- (borg (and (string-match "\\.org$" b) (not bdir)))
- (A (if aorg
- (concat (file-name-directory a)
- (org-publish-find-title a)) a))
- (B (if borg
- (concat (file-name-directory b)
- (org-publish-find-title b)) b)))
- (setq retval (if org-sitemap-ignore-case
- (not (string-lessp (upcase B) (upcase A)))
- (not (string-lessp B A))))))
- ((or (equal org-sitemap-sort-files 'chronologically)
- (equal org-sitemap-sort-files 'anti-chronologically))
- (let* ((adate (org-publish-find-date a))
- (bdate (org-publish-find-date b))
- (A (+ (lsh (car adate) 16) (cadr adate)))
- (B (+ (lsh (car bdate) 16) (cadr bdate))))
- (setq retval (if (equal org-sitemap-sort-files 'chronologically)
- (<= A B)
- (>= A B)))))))
- ;; Directory-wise wins:
- (when org-sitemap-sort-folders
- ;; a is directory, b not:
- (cond
- ((and (file-directory-p a) (not (file-directory-p b)))
- (setq retval (equal org-sitemap-sort-folders 'first)))
- ;; a is not a directory, but b is:
- ((and (not (file-directory-p a)) (file-directory-p b))
- (setq retval (equal org-sitemap-sort-folders 'last))))))
- retval))
-
-(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir)
- "Set `org-publish-temp-files' with files from BASE-DIR directory.
-If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
-non-nil, restrict this list to the files matching the regexp
-MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
-SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
-matching the regexp SKIP-DIR when recursing through BASE-DIR."
- (mapc (lambda (f)
- (let ((fd-p (file-directory-p f))
- (fnd (file-name-nondirectory f)))
- (if (and fd-p recurse
- (not (string-match "^\\.+$" fnd))
- (if skip-dir (not (string-match skip-dir fnd)) t))
- (org-publish-get-base-files-1 f recurse match skip-file skip-dir)
- (unless (or fd-p ;; this is a directory
- (and skip-file (string-match skip-file fnd))
- (not (file-exists-p (file-truename f)))
- (not (string-match match fnd)))
-
- (pushnew f org-publish-temp-files)))))
- (if org-sitemap-requested
- (sort (directory-files base-dir t (unless recurse match))
- 'org-publish-compare-directory-files)
- (directory-files base-dir t (unless recurse match)))))
-
-(defun org-publish-get-base-files (project &optional exclude-regexp)
- "Return a list of all files in PROJECT.
-If EXCLUDE-REGEXP is set, this will be used to filter out
-matching filenames."
- (let* ((project-plist (cdr project))
- (base-dir (file-name-as-directory
- (plist-get project-plist :base-directory)))
- (include-list (plist-get project-plist :include))
- (recurse (plist-get project-plist :recursive))
- (extension (or (plist-get project-plist :base-extension) "org"))
- ;; sitemap-... variables are dynamically scoped for
- ;; org-publish-compare-directory-files:
- (org-sitemap-requested
- (plist-get project-plist :auto-sitemap))
- (sitemap-filename
- (or (plist-get project-plist :sitemap-filename)
- "sitemap.org"))
- (org-sitemap-sort-folders
- (if (plist-member project-plist :sitemap-sort-folders)
- (plist-get project-plist :sitemap-sort-folders)
- org-publish-sitemap-sort-folders))
- (org-sitemap-sort-files
- (cond ((plist-member project-plist :sitemap-sort-files)
- (plist-get project-plist :sitemap-sort-files))
- ;; For backward compatibility:
- ((plist-member project-plist :sitemap-alphabetically)
- (if (plist-get project-plist :sitemap-alphabetically)
- 'alphabetically nil))
- (t org-publish-sitemap-sort-files)))
- (org-sitemap-ignore-case
- (if (plist-member project-plist :sitemap-ignore-case)
- (plist-get project-plist :sitemap-ignore-case)
- org-publish-sitemap-sort-ignore-case))
- (match (if (eq extension 'any)
- "^[^\\.]"
- (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
- ;; Make sure `org-sitemap-sort-folders' has an accepted value
- (unless (memq org-sitemap-sort-folders '(first last))
- (setq org-sitemap-sort-folders nil))
-
- (setq org-publish-temp-files nil)
- (if org-sitemap-requested
- (pushnew (expand-file-name (concat base-dir sitemap-filename))
- org-publish-temp-files))
- (org-publish-get-base-files-1 base-dir recurse match
- ;; FIXME distinguish exclude regexp
- ;; for skip-file and skip-dir?
- exclude-regexp exclude-regexp)
- (mapc (lambda (f)
- (pushnew
- (expand-file-name (concat base-dir f))
- org-publish-temp-files))
- include-list)
- org-publish-temp-files))
-
-(defun org-publish-get-project-from-filename (filename &optional up)
- "Return the project that FILENAME belongs to."
- (let* ((filename (expand-file-name filename))
- project-name)
-
- (catch 'p-found
- (dolist (prj org-publish-project-alist)
- (unless (plist-get (cdr prj) :components)
- ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
- (let* ((r (plist-get (cdr prj) :recursive))
- (b (expand-file-name (file-name-as-directory
- (plist-get (cdr prj) :base-directory))))
- (x (or (plist-get (cdr prj) :base-extension) "org"))
- (e (plist-get (cdr prj) :exclude))
- (i (plist-get (cdr prj) :include))
- (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
- (when
- (or
- (and
- i (member filename
- (mapcar
- (lambda (file) (expand-file-name file b))
- i)))
- (and
- (not (and e (string-match e filename)))
- (string-match xm filename)))
- (setq project-name (car prj))
- (throw 'p-found project-name))))))
- (when up
- (dolist (prj org-publish-project-alist)
- (if (member project-name (plist-get (cdr prj) :components))
- (setq project-name (car prj)))))
- (assoc project-name org-publish-project-alist)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Pluggable publishing back-end functions
-
-(defun org-publish-org-to (format plist filename pub-dir)
- "Publish an org file to FORMAT.
-PLIST is the property list for the given project.
-FILENAME is the filename of the org file to be published.
-PUB-DIR is the publishing directory."
- (require 'org)
- (unless (file-exists-p pub-dir)
- (make-directory pub-dir t))
- (let ((visiting (find-buffer-visiting filename)))
- (save-excursion
- (org-pop-to-buffer-same-window (or visiting (find-file filename)))
- (let* ((plist (cons :buffer-will-be-killed (cons t plist)))
- (init-buf (current-buffer))
- (init-point (point))
- (init-buf-string (buffer-string))
- export-buf-or-file)
- ;; run hooks before exporting
- (run-hooks 'org-publish-before-export-hook)
- ;; export the possibly modified buffer
- (setq export-buf-or-file
- (funcall (intern (concat "org-export-as-" format))
- (plist-get plist :headline-levels)
- plist nil
- (plist-get plist :body-only)
- pub-dir))
- (when (and (bufferp export-buf-or-file)
- (buffer-live-p export-buf-or-file))
- (set-buffer export-buf-or-file)
- ;; run hooks after export and save export
- (progn (run-hooks 'org-publish-after-export-hook)
- (if (buffer-modified-p) (save-buffer)))
- (kill-buffer export-buf-or-file))
- ;; maybe restore buffer's content
- (set-buffer init-buf)
- (when (buffer-modified-p init-buf)
- (erase-buffer)
- (insert init-buf-string)
- (save-buffer)
- (goto-char init-point))
- (unless visiting
- (kill-buffer init-buf))))))
-
-(defmacro org-publish-with-aux-preprocess-maybe (&rest body)
- "Execute BODY with a modified hook to preprocess for index."
- `(let ((org-export-preprocess-after-headline-targets-hook
- (if (plist-get project-plist :makeindex)
- (cons 'org-publish-aux-preprocess
- org-export-preprocess-after-headline-targets-hook)
- org-export-preprocess-after-headline-targets-hook)))
- ,@body))
-(def-edebug-spec org-publish-with-aux-preprocess-maybe (body))
-
-(defvar project-plist)
-(defun org-publish-org-to-latex (plist filename pub-dir)
- "Publish an org file to LaTeX.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "latex" plist filename pub-dir)))
-
-(defun org-publish-org-to-pdf (plist filename pub-dir)
- "Publish an org file to PDF (via LaTeX).
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "pdf" plist filename pub-dir)))
-
-(defun org-publish-org-to-html (plist filename pub-dir)
- "Publish an org file to HTML.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "html" plist filename pub-dir)))
-
-(defun org-publish-org-to-org (plist filename pub-dir)
- "Publish an org file to HTML.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-org-to "org" plist filename pub-dir))
-
-(defun org-publish-org-to-ascii (plist filename pub-dir)
- "Publish an org file to ASCII.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "ascii" plist filename pub-dir)))
-
-(defun org-publish-org-to-latin1 (plist filename pub-dir)
- "Publish an org file to Latin-1.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "latin1" plist filename pub-dir)))
-
-(defun org-publish-org-to-utf8 (plist filename pub-dir)
- "Publish an org file to UTF-8.
-See `org-publish-org-to' to the list of arguments."
- (org-publish-with-aux-preprocess-maybe
- (org-publish-org-to "utf8" plist filename pub-dir)))
-
-(defun org-publish-attachment (plist filename pub-dir)
- "Publish a file with no transformation of any kind.
-See `org-publish-org-to' to the list of arguments."
- ;; make sure eshell/cp code is loaded
- (unless (file-directory-p pub-dir)
- (make-directory pub-dir t))
- (or (equal (expand-file-name (file-name-directory filename))
- (file-name-as-directory (expand-file-name pub-dir)))
- (copy-file filename
- (expand-file-name (file-name-nondirectory filename) pub-dir)
- t)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Publishing files, sets of files, and indices
-
-(defun org-publish-file (filename &optional project no-cache)
- "Publish file FILENAME from PROJECT.
-If NO-CACHE is not nil, do not initialize org-publish-cache and
-write it to disk. This is needed, since this function is used to
-publish single files, when entire projects are published.
-See `org-publish-projects'."
- (let* ((project
- (or project
- (or (org-publish-get-project-from-filename filename)
- (error "File %s not part of any known project"
- (abbreviate-file-name filename)))))
- (project-plist (cdr project))
- (ftname (expand-file-name filename))
- (publishing-function
- (or (plist-get project-plist :publishing-function)
- 'org-publish-org-to-html))
- (base-dir
- (file-name-as-directory
- (expand-file-name
- (or (plist-get project-plist :base-directory)
- (error "Project %s does not have :base-directory defined"
- (car project))))))
- (pub-dir
- (file-name-as-directory
- (file-truename
- (or (eval (plist-get project-plist :publishing-directory))
- (error "Project %s does not have :publishing-directory defined"
- (car project))))))
- tmp-pub-dir)
-
- (unless no-cache
- (org-publish-initialize-cache (car project)))
-
- (setq tmp-pub-dir
- (file-name-directory
- (concat pub-dir
- (and (string-match (regexp-quote base-dir) ftname)
- (substring ftname (match-end 0))))))
- (if (listp publishing-function)
- ;; allow chain of publishing functions
- (mapc (lambda (f)
- (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir)
- (funcall f project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp filename pub-dir f base-dir)))
- publishing-function)
- (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir)
- (funcall publishing-function project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp
- filename pub-dir publishing-function base-dir)))
- (unless no-cache (org-publish-write-cache-file))))
-
-(defun org-publish-projects (projects)
- "Publish all files belonging to the PROJECTS alist.
-If :auto-sitemap is set, publish the sitemap too.
-If :makeindex is set, also produce a file theindex.org."
- (mapc
- (lambda (project)
- ;; Each project uses its own cache file:
- (org-publish-initialize-cache (car project))
- (let*
- ((project-plist (cdr project))
- (exclude-regexp (plist-get project-plist :exclude))
- (sitemap-p (plist-get project-plist :auto-sitemap))
- (sitemap-filename (or (plist-get project-plist :sitemap-filename)
- "sitemap.org"))
- (sitemap-function (or (plist-get project-plist :sitemap-function)
- 'org-publish-org-sitemap))
- (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format)
- org-publish-sitemap-date-format))
- (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format)
- org-publish-sitemap-file-entry-format))
- (preparation-function (plist-get project-plist :preparation-function))
- (completion-function (plist-get project-plist :completion-function))
- (files (org-publish-get-base-files project exclude-regexp)) file)
- (when preparation-function (run-hooks 'preparation-function))
- (if sitemap-p (funcall sitemap-function project sitemap-filename))
- (while (setq file (pop files))
- (org-publish-file file project t))
- (when (plist-get project-plist :makeindex)
- (org-publish-index-generate-theindex
- (plist-get project-plist :base-directory))
- (org-publish-file (expand-file-name
- "theindex.org"
- (plist-get project-plist :base-directory))
- project t))
- (when completion-function (run-hooks 'completion-function))
- (org-publish-write-cache-file)))
- (org-publish-expand-projects projects)))
-
-(defun org-publish-org-sitemap (project &optional sitemap-filename)
- "Create a sitemap of pages in set defined by PROJECT.
-Optionally set the filename of the sitemap with SITEMAP-FILENAME.
-Default for SITEMAP-FILENAME is 'sitemap.org'."
- (let* ((project-plist (cdr project))
- (dir (file-name-as-directory
- (plist-get project-plist :base-directory)))
- (localdir (file-name-directory dir))
- (indent-str (make-string 2 ?\ ))
- (exclude-regexp (plist-get project-plist :exclude))
- (files (nreverse (org-publish-get-base-files project exclude-regexp)))
- (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
- (sitemap-title (or (plist-get project-plist :sitemap-title)
- (concat "Sitemap for project " (car project))))
- (sitemap-style (or (plist-get project-plist :sitemap-style)
- 'tree))
- (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension))
- (visiting (find-buffer-visiting sitemap-filename))
- (ifn (file-name-nondirectory sitemap-filename))
- file sitemap-buffer)
- (with-current-buffer (setq sitemap-buffer
- (or visiting (find-file sitemap-filename)))
- (erase-buffer)
- (insert (concat "#+TITLE: " sitemap-title "\n\n"))
- (while (setq file (pop files))
- (let ((fn (file-name-nondirectory file))
- (link (file-relative-name file dir))
- (oldlocal localdir))
- (when sitemap-sans-extension
- (setq link (file-name-sans-extension link)))
- ;; sitemap shouldn't list itself
- (unless (equal (file-truename sitemap-filename)
- (file-truename file))
- (if (eq sitemap-style 'list)
- (message "Generating list-style sitemap for %s" sitemap-title)
- (message "Generating tree-style sitemap for %s" sitemap-title)
- (setq localdir (concat (file-name-as-directory dir)
- (file-name-directory link)))
- (unless (string= localdir oldlocal)
- (if (string= localdir dir)
- (setq indent-str (make-string 2 ?\ ))
- (let ((subdirs
- (split-string
- (directory-file-name
- (file-name-directory
- (file-relative-name localdir dir))) "/"))
- (subdir "")
- (old-subdirs (split-string
- (file-relative-name oldlocal dir) "/")))
- (setq indent-str (make-string 2 ?\ ))
- (while (string= (car old-subdirs) (car subdirs))
- (setq indent-str (concat indent-str (make-string 2 ?\ )))
- (pop old-subdirs)
- (pop subdirs))
- (dolist (d subdirs)
- (setq subdir (concat subdir d "/"))
- (insert (concat indent-str " + " d "\n"))
- (setq indent-str (make-string
- (+ (length indent-str) 2) ?\ )))))))
- ;; This is common to 'flat and 'tree
- (let ((entry
- (org-publish-format-file-entry org-sitemap-file-entry-format
- file project-plist))
- (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
- (cond ((string-match-p regexp entry)
- (string-match regexp entry)
- (insert (concat indent-str " + " (match-string 1 entry)
- "[[file:" link "]["
- (match-string 2 entry)
- "]]" (match-string 3 entry) "\n")))
- (t
- (insert (concat indent-str " + [[file:" link "]["
- entry
- "]]\n"))))))))
- (save-buffer))
- (or visiting (kill-buffer sitemap-buffer))))
-
-(defun org-publish-format-file-entry (fmt file project-plist)
- (format-spec fmt
- `((?t . ,(org-publish-find-title file t))
- (?d . ,(format-time-string org-sitemap-date-format
- (org-publish-find-date file)))
- (?a . ,(or (plist-get project-plist :author) user-full-name)))))
-
-(defun org-publish-find-title (file &optional reset)
- "Find the title of FILE in project."
- (or
- (and (not reset) (org-publish-cache-get-file-property file :title nil t))
- (let* ((visiting (find-buffer-visiting file))
- (buffer (or visiting (find-file-noselect file)))
- title)
- (with-current-buffer buffer
- (let* ((opt-plist (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist))))
- (setq title
- (or (plist-get opt-plist :title)
- (and (not
- (plist-get opt-plist :skip-before-1st-heading))
- (org-export-grab-title-from-buffer))
- (file-name-nondirectory (file-name-sans-extension file))))))
- (unless visiting
- (kill-buffer buffer))
- (org-publish-cache-set-file-property file :title title)
- title)))
-
-(defun org-publish-find-date (file)
- "Find the date of FILE in project.
-If FILE provides a #+date keyword use it else use the file
-system's modification time.
-
-It returns time in `current-time' format."
- (let ((visiting (find-buffer-visiting file)))
- (save-excursion
- (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t)))
- (let* ((plist (org-infile-export-plist))
- (date (plist-get plist :date)))
- (unless visiting
- (kill-buffer (current-buffer)))
- (if date
- (org-time-string-to-time date)
- (when (file-exists-p file)
- (nth 5 (file-attributes file))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Interactive publishing functions
-
-;;;###autoload
-(defalias 'org-publish-project 'org-publish)
-
-;;;###autoload
-(defun org-publish (project &optional force)
- "Publish PROJECT."
- (interactive
- (list
- (assoc (org-icompleting-read
- "Publish project: "
- org-publish-project-alist nil t)
- org-publish-project-alist)
- current-prefix-arg))
- (setq org-publish-initial-buffer (current-buffer))
- (save-window-excursion
- (let* ((org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (org-publish-projects
- (if (stringp project)
- ;; If this function is called in batch mode,
- ;; project is still a string here.
- (list (assoc project org-publish-project-alist))
- (list project))))))
-
-;;;###autoload
-(defun org-publish-all (&optional force)
- "Publish all projects.
-With prefix argument, remove all files in the timestamp
-directory and force publishing all files."
- (interactive "P")
- (when force
- (org-publish-remove-all-timestamps))
- (save-window-excursion
- (let ((org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (org-publish-projects org-publish-project-alist))))
-
-;;;###autoload
-(defun org-publish-current-file (&optional force)
- "Publish the current file.
-With prefix argument, force publish the file."
- (interactive "P")
- (save-window-excursion
- (let ((org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (org-publish-file (buffer-file-name)))))
-
-;;;###autoload
-(defun org-publish-current-project (&optional force)
- "Publish the project associated with the current file.
-With a prefix argument, force publishing of all files in
-the project."
- (interactive "P")
- (save-window-excursion
- (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up))
- (org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (if (not project)
- (error "File %s is not part of any known project" (buffer-file-name)))
- ;; FIXME: force is not used here?
- (org-publish project))))
-
-
-;;; Index generation
-
-(defun org-publish-aux-preprocess ()
- "Find index entries and write them to an .orgx file."
- (let ((case-fold-search t)
- entry index target)
- (goto-char (point-min))
- (while
- (and
- (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t)
- (> (match-end 1) (match-beginning 1)))
- (setq entry (match-string 1))
- (when (eq org-export-current-backend 'latex)
- (replace-match (format "\\index{%s}" entry) t t))
- (save-excursion
- (ignore-errors (org-back-to-heading t))
- (setq target (get-text-property (point) 'target))
- (setq target (or (cdr (assoc target org-export-preferred-target-alist))
- (cdr (assoc target org-export-id-target-alist))
- target ""))
- (push (cons entry target) index)))
- (with-temp-file
- (concat
- (file-name-directory org-current-export-file) "."
- (file-name-sans-extension
- (file-name-nondirectory org-current-export-file)) ".orgx")
- (dolist (entry (nreverse index))
- (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry)))))))
-
-(defun org-publish-index-generate-theindex (directory)
- "Generate the index from all .orgx files in DIRECTORY."
- (require 'find-lisp)
- (let* ((fulldir (file-name-as-directory
- (expand-file-name directory)))
- (full-files (find-lisp-find-files directory "\\.orgx\\'"))
- (re (concat "\\`" fulldir))
- (files (mapcar (lambda (f) (if (string-match re f)
- (substring f (match-end 0))
- f))
- full-files))
- (default-directory directory)
- index origfile buf target entry ibuffer
- main last-main letter last-letter file sub link tgext)
- ;; `files' contains the list of relative file names
- (dolist (file files)
- (setq origfile
- (concat (file-name-directory file)
- (substring (file-name-nondirectory file) 1 -1)))
- (setq buf (find-file-noselect file))
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t)
- (setq target (match-string 1)
- entry (match-string 2))
- (push (list entry origfile target) index)))
- (kill-buffer buf))
- (setq index (sort index (lambda (a b) (string< (downcase (car a))
- (downcase (car b))))))
- (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory)))
- (with-current-buffer ibuffer
- (erase-buffer)
- (insert "* Index\n")
- (setq last-letter nil)
- (dolist (idx index)
- (setq entry (car idx) file (nth 1 idx) target (nth 2 idx))
- (if (and (stringp target) (string-match "\\S-" target))
- (setq tgext (concat "::#" target))
- (setq tgext ""))
- (setq letter (upcase (substring entry 0 1)))
- (when (not (equal letter last-letter))
- (insert "** " letter "\n")
- (setq last-letter letter))
- (if (string-match "!" entry)
- (setq main (substring entry 0 (match-beginning 0))
- sub (substring entry (match-end 0)))
- (setq main nil sub nil last-main nil))
- (when (and main (not (equal main last-main)))
- (insert " - " main "\n")
- (setq last-main main))
- (setq link (concat "[[file:" file tgext "]"
- "[" (or sub entry) "]]"))
- (if (and main sub)
- (insert " - " link "\n")
- (insert " - " link "\n")))
- (save-buffer))
- (kill-buffer ibuffer)
- ;; Create theindex.org if it doesn't exist already
- (let ((index-file (expand-file-name "theindex.org" directory)))
- (unless (file-exists-p index-file)
- (setq ibuffer (find-file-noselect index-file))
- (with-current-buffer ibuffer
- (erase-buffer)
- (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n")
- (save-buffer))
- (kill-buffer ibuffer)))))
-
-;; Caching functions:
-
-(defun org-publish-write-cache-file (&optional free-cache)
- "Write `org-publish-cache' to file.
-If FREE-CACHE, empty the cache."
- (or org-publish-cache
- (error "`org-publish-write-cache-file' called, but no cache present"))
-
- (let ((cache-file (org-publish-cache-get ":cache-file:")))
- (or cache-file
- (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
- (with-temp-file cache-file
- (let ((print-level nil)
- (print-length nil))
- (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
- (maphash (lambda (k v)
- (insert
- (format (concat "(puthash %S "
- (if (or (listp v) (symbolp v))
- "'" "")
- "%S org-publish-cache)\n") k v)))
- org-publish-cache)))
- (when free-cache (org-publish-reset-cache))))
-
-(defun org-publish-initialize-cache (project-name)
- "Initialize the projects cache if not initialized yet and return it."
-
- (or project-name
- (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
-
- (unless (file-exists-p org-publish-timestamp-directory)
- (make-directory org-publish-timestamp-directory t))
- (if (not (file-directory-p org-publish-timestamp-directory))
- (error "Org publish timestamp: %s is not a directory"
- org-publish-timestamp-directory))
-
- (unless (and org-publish-cache
- (string= (org-publish-cache-get ":project:") project-name))
- (let* ((cache-file (concat
- (expand-file-name org-publish-timestamp-directory)
- project-name
- ".cache"))
- (cexists (file-exists-p cache-file)))
-
- (when org-publish-cache
- (org-publish-reset-cache))
-
- (if cexists
- (load-file cache-file)
- (setq org-publish-cache
- (make-hash-table :test 'equal :weakness nil :size 100))
- (org-publish-cache-set ":project:" project-name)
- (org-publish-cache-set ":cache-file:" cache-file))
- (unless cexists (org-publish-write-cache-file nil))))
- org-publish-cache)
-
-(defun org-publish-reset-cache ()
- "Empty org-publish-cache and reset it nil."
- (message "%s" "Resetting org-publish-cache")
- (if (hash-table-p org-publish-cache)
- (clrhash org-publish-cache))
- (setq org-publish-cache nil))
-
-(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir)
- "Check the timestamp of the last publishing of FILENAME.
-Return `t', if the file needs publishing. The function also
-checks if any included files have been more recently published,
-so that the file including them will be republished as well."
- (or org-publish-cache
- (error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
- (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
- (pstamp (org-publish-cache-get key))
- (visiting (find-buffer-visiting filename))
- (case-fold-search t)
- included-files-ctime buf)
-
- (when (equal (file-name-extension filename) "org")
- (setq buf (find-file (expand-file-name filename)))
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
- (let* ((included-file (expand-file-name (match-string 1))))
- (add-to-list 'included-files-ctime
- (org-publish-cache-ctime-of-src included-file) t))))
- ;; FIXME don't kill current buffer
- (unless visiting (kill-buffer buf)))
- (if (null pstamp)
- t
- (let ((ctime (org-publish-cache-ctime-of-src filename)))
- (or (< pstamp ctime)
- (when included-files-ctime
- (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
- included-files-ctime))))))))))
-
-(defun org-publish-cache-set-file-property (filename property value &optional project-name)
- "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
-Use cache file of PROJECT-NAME. If the entry does not exist, it will be
-created. Return VALUE."
- ;; Evtl. load the requested cache file:
- (if project-name (org-publish-initialize-cache project-name))
- (let ((pl (org-publish-cache-get filename)))
- (if pl
- (progn
- (plist-put pl property value)
- value)
- (org-publish-cache-get-file-property
- filename property value nil project-name))))
-
-(defun org-publish-cache-get-file-property
- (filename property &optional default no-create project-name)
- "Return the value for a PROPERTY of file FILENAME in publishing cache.
-Use cache file of PROJECT-NAME. Return the value of that PROPERTY or
-DEFAULT, if the value does not yet exist.
-If the entry will be created, unless NO-CREATE is not nil."
- ;; Evtl. load the requested cache file:
- (if project-name (org-publish-initialize-cache project-name))
- (let ((pl (org-publish-cache-get filename))
- (retval nil))
- (if pl
- (if (plist-member pl property)
- (setq retval (plist-get pl property))
- (setq retval default))
- ;; no pl yet:
- (unless no-create
- (org-publish-cache-set filename (list property default)))
- (setq retval default))
- retval))
-
-(defun org-publish-cache-get (key)
- "Return the value stored in `org-publish-cache' for key KEY.
-Returns nil, if no value or nil is found, or the cache does not
-exist."
- (or org-publish-cache
- (error "`org-publish-cache-get' called, but no cache present"))
- (gethash key org-publish-cache))
-
-(defun org-publish-cache-set (key value)
- "Store KEY VALUE pair in `org-publish-cache'.
-Returns value on success, else nil."
- (or org-publish-cache
- (error "`org-publish-cache-set' called, but no cache present"))
- (puthash key value org-publish-cache))
-
-(defun org-publish-cache-ctime-of-src (file)
- "Get the ctime of filename F as an integer."
- (let ((attr (file-attributes
- (expand-file-name (or (file-symlink-p file) file)
- (file-name-directory file)))))
- (+ (lsh (car (nth 5 attr)) 16)
- (cadr (nth 5 attr)))))
-
-(provide 'org-publish)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-publish.el ends here
diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el
deleted file mode 100644
index cb1fdbbb933..00000000000
--- a/lisp/org/org-remember.el
+++ /dev/null
@@ -1,1156 +0,0 @@
-;;; org-remember.el --- Fast note taking in Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file contains the system to take fast notes with Org-mode.
-;; This system is used together with John Wiegley's `remember.el'.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-(require 'org)
-(require 'org-compat)
-(require 'org-datetree)
-
-(declare-function remember-mode "remember" ())
-(declare-function remember "remember" (&optional initial))
-(declare-function remember-buffer-desc "remember" ())
-(declare-function remember-finalize "remember" ())
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-
-(defvar remember-save-after-remembering)
-(defvar remember-register)
-(defvar remember-buffer)
-(defvar remember-handler-functions)
-(defvar remember-annotation-functions)
-(defvar org-clock-heading)
-(defvar org-clock-heading-for-remember)
-
-(defgroup org-remember nil
- "Options concerning interaction with remember.el."
- :tag "Org Remember"
- :group 'org)
-
-(defcustom org-remember-store-without-prompt t
- "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \
-stores the remember note without further prompts.
-It then uses the file and headline specified by the template or (if the
-template does not specify them) by the variables `org-default-notes-file'
-and `org-remember-default-headline'. To force prompting anyway, use
-\\[universal-argument] \\[org-remember-finalize] to file the note.
-
-When this variable is nil, \\[org-remember-finalize] gives you the prompts, and
-\\[universal-argument] \\[org-remember-finalize] triggers the fast track."
- :group 'org-remember
- :type 'boolean)
-
-(defcustom org-remember-interactive-interface 'refile
- "The interface to be used for interactive filing of remember notes.
-This is only used when the interactive mode for selecting a filing
-location is used (see the variable `org-remember-store-without-prompt').
-Allowed values are:
-outline The interface shows an outline of the relevant file
- and the correct heading is found by moving through
- the outline or by searching with incremental search.
-outline-path-completion Headlines in the current buffer are offered via
- completion.
-refile Use the refile interface, and offer headlines,
- possibly from different buffers."
- :group 'org-remember
- :type '(choice
- (const :tag "Refile" refile)
- (const :tag "Outline" outline)
- (const :tag "Outline-path-completion" outline-path-completion)))
-
-(defcustom org-remember-default-headline ""
- "The headline that should be the default location in the notes file.
-When filing remember notes, the cursor will start at that position.
-You can set this on a per-template basis with the variable
-`org-remember-templates'."
- :group 'org-remember
- :type 'string)
-
-(defcustom org-remember-templates nil
- "Templates for the creation of remember buffers.
-When nil, just let remember make the buffer.
-When non-nil, this is a list of (up to) 6-element lists. In each entry,
-the first element is the name of the template, which should be a single
-short word. The second element is a character, a unique key to select
-this template. The third element is the template.
-
-The fourth element is optional and can specify a destination file for
-remember items created with this template. The default file is given
-by `org-default-notes-file'. If the file name is not an absolute path,
-it will be interpreted relative to `org-directory'.
-
-An optional fifth element can specify the headline in that file that should
-be offered first when the user is asked to file the entry. The default
-headline is given in the variable `org-remember-default-headline'. When
-this element is `top' or `bottom', the note will be placed as a level-1
-entry at the beginning or end of the file, respectively.
-
-An optional sixth element specifies the contexts in which the template
-will be offered to the user. This element can be a list of major modes
-or a function, and the template will only be offered if `org-remember'
-is called from a mode in the list, or if the function returns t.
-Templates that specify t or nil for the context will always be added
-to the list of selectable templates.
-
-The template specifies the structure of the remember buffer. It should have
-a first line starting with a star, to act as the org-mode headline.
-Furthermore, the following %-escapes will be replaced with content:
-
- %^{PROMPT} prompt the user for a string and replace this sequence with it.
- A default value and a completion table can be specified like this:
- %^{prompt|default|completion2|completion3|...}
- The arrow keys access a prompt-specific history.
- %a annotation, normally the link created with `org-store-link'
- %A like %a, but prompt for the description part
- %i initial content, copied from the active region. If %i is
- indented, the entire inserted text will be indented as well.
- %t time stamp, date only
- %T time stamp with date and time
- %u, %U like the above, but inactive time stamps
- %^t like %t, but prompt for date. Similarly %^T, %^u, %^U.
- You may define a prompt like %^{Please specify birthday}t
- %n user name (taken from `user-full-name')
- %c current kill ring head
- %x content of the X clipboard
- %:keyword specific information for certain link types, see below
- %^C interactive selection of which kill or clip to use
- %^L like %^C, but insert as link
- %k title of the currently clocked task
- %K link to the currently clocked task
- %^g prompt for tags, completing tags in the target file
- %^G prompt for tags, completing all tags in all agenda files
- %^{PROP}p Prompt the user for a value for property PROP
- %[PATHNAME] insert the contents of the file given by PATHNAME
- %(SEXP) evaluate elisp `(SEXP)' and replace with the result
- %! store this note immediately after completing the template\
- \\<org-remember-mode-map>
- (skipping the \\[org-remember-finalize] that normally triggers storing)
- %& jump to target location immediately after storing note
- %? after completing the template, position cursor here.
-
-Apart from these general escapes, you can access information specific to the
-link type that is created. For example, calling `remember' in emails or gnus
-will record the author and the subject of the message, which you can access
-with %:fromname and %:subject, respectively. Here is a complete list of what
-is recorded for each link type.
-
-Link type | Available information
--------------------+------------------------------------------------------
-bbdb | %:type %:name %:company
-vm, wl, mh, rmail | %:type %:subject %:message-id
- | %:from %:fromname %:fromaddress
- | %:to %:toname %:toaddress
- | %:fromto (either \"to NAME\" or \"from NAME\")
-gnus | %:group, for messages also all email fields and
- | %:org-date (the Date: header in Org format)
-w3, w3m | %:type %:url
-info | %:type %:file %:node
-calendar | %:type %:date"
- :group 'org-remember
- :get (lambda (var) ; Make sure all entries have at least 5 elements
- (mapcar (lambda (x)
- (if (not (stringp (car x))) (setq x (cons "" x)))
- (cond ((= (length x) 4) (append x '(nil)))
- ((= (length x) 3) (append x '(nil nil)))
- (t x)))
- (default-value var)))
- :type '(repeat
- :tag "enabled"
- (list :value ("" ?a "\n" nil nil nil)
- (string :tag "Name")
- (character :tag "Selection Key")
- (string :tag "Template")
- (choice :tag "Destination file"
- (file :tag "Specify")
- (function :tag "Function")
- (const :tag "Use `org-default-notes-file'" nil))
- (choice :tag "Destin. headline"
- (string :tag "Specify")
- (function :tag "Function")
- (const :tag "Use `org-remember-default-headline'" nil)
- (const :tag "At beginning of file" top)
- (const :tag "At end of file" bottom)
- (const :tag "In a date tree" date-tree))
- (choice :tag "Context"
- (const :tag "Use in all contexts" nil)
- (const :tag "Use in all contexts" t)
- (repeat :tag "Use only if in major mode"
- (symbol :tag "Major mode"))
- (function :tag "Perform a check against function")))))
-
-(defcustom org-remember-delete-empty-lines-at-end t
- "Non-nil means clean up final empty lines in remember buffer."
- :group 'org-remember
- :type 'boolean)
-
-(defcustom org-remember-before-finalize-hook nil
- "Hook that is run right before a remember process is finalized.
-The remember buffer is still current when this hook runs."
- :group 'org-remember
- :type 'hook)
-
-(defvar org-remember-mode-map (make-sparse-keymap)
- "Keymap for `org-remember-mode', a minor mode.
-Use this map to set additional keybindings for when Org-mode is used
-for a Remember buffer.")
-(defvar org-remember-mode-hook nil
- "Hook for the minor `org-remember-mode'.")
-
-(define-minor-mode org-remember-mode
- "Minor mode for special key bindings in a remember buffer."
- nil " Rem" org-remember-mode-map
- (run-hooks 'org-remember-mode-hook))
-(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize)
-(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill)
-
-(defcustom org-remember-clock-out-on-exit 'query
- "Non-nil means stop the clock when exiting a clocking remember buffer.
-This only applies if the clock is running in the remember buffer. If the
-clock is not stopped, it continues to run in the storage location.
-Instead of nil or t, this may also be the symbol `query' to prompt the
-user each time a remember buffer with a running clock is filed away."
- :group 'org-remember
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Query user" query)))
-
-(defcustom org-remember-backup-directory nil
- "Directory where to store all remember buffers, for backup purposes.
-After a remember buffer has been stored successfully, the backup file
-will be removed. However, if you forget to finish the remember process,
-the file will remain there.
-See also `org-remember-auto-remove-backup-files'."
- :group 'org-remember
- :type '(choice
- (const :tag "No backups" nil)
- (directory :tag "Directory")))
-
-(defcustom org-remember-auto-remove-backup-files t
- "Non-nil means remove remember backup files after successfully storage.
-When remember is finished successfully, with storing the note at the
-desired target, remove the backup files related to this remember process
-and show a message about remaining backup files, from previous, unfinished
-remember sessions.
-Backup files will only be made at all, when `org-remember-backup-directory'
-is set."
- :group 'org-remember
- :type 'boolean)
-
-(defcustom org-remember-warn-about-backups t
- "Non-nil means warn about backup files in `org-remember-backup-directory'.
-
-Set this to nil if you find that you don't need the warning.
-
-If you cancel remember calls frequently and know when they
-contain useful information (because you know that you made an
-error or Emacs crashed, for example) nil is more useful. In the
-opposite case, the default, t, is more useful."
- :group 'org-remember
- :type 'boolean)
-
-;;;###autoload
-(defun org-remember-insinuate ()
- "Setup remember.el for use with Org-mode."
- (org-require-remember)
- (setq remember-annotation-functions '(org-remember-annotation))
- (setq remember-handler-functions '(org-remember-handler))
- (add-hook 'remember-mode-hook 'org-remember-apply-template))
-
-;;;###autoload
-(defun org-remember-annotation ()
- "Return a link to the current location as an annotation for remember.el.
-If you are using Org-mode files as target for data storage with
-remember.el, then the annotations should include a link compatible with the
-conventions in Org-mode. This function returns such a link."
- (org-store-link nil))
-
-(defconst org-remember-help
- "Select a destination location for the note.
-UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store
-RET on headline -> Store as sublevel entry to current headline
-RET at beg-of-buf -> Append to file as level 2 headline
-<left>/<right> -> before/after current headline, same headings level")
-
-(defvar org-jump-to-target-location nil)
-(defvar org-remember-previous-location nil)
-(defvar org-remember-reference-date nil)
-(defvar org-force-remember-template-char) ;; dynamically scoped
-
-;; Save the major mode of the buffer we called remember from
-(defvar org-select-template-temp-major-mode nil)
-
-;; Temporary store the buffer where remember was called from
-(defvar org-select-template-original-buffer nil)
-
-(defun org-select-remember-template (&optional use-char)
- (when org-remember-templates
- (let* ((pre-selected-templates
- (mapcar
- (lambda (tpl)
- (let ((ctxt (nth 5 tpl))
- (mode org-select-template-temp-major-mode)
- (buf org-select-template-original-buffer))
- (and (or (not ctxt) (eq ctxt t)
- (and (listp ctxt) (memq mode ctxt))
- (and (functionp ctxt)
- (with-current-buffer buf
- ;; Protect the user-defined function from error
- (condition-case nil (funcall ctxt) (error nil)))))
- tpl)))
- org-remember-templates))
- ;; If no template at this point, add the default templates:
- (pre-selected-templates1
- (if (not (delq nil pre-selected-templates))
- (mapcar (lambda(x) (if (not (nth 5 x)) x))
- org-remember-templates)
- pre-selected-templates))
- ;; Then unconditionally add template for any contexts
- (pre-selected-templates2
- (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x))
- org-remember-templates)
- (delq nil pre-selected-templates1)))
- (templates (mapcar (lambda (x)
- (if (stringp (car x))
- (append (list (nth 1 x) (car x)) (cddr x))
- (append (list (car x) "") (cdr x))))
- (delq nil pre-selected-templates2)))
- msg
- (char (or use-char
- (cond
- ((= (length templates) 1)
- (caar templates))
- ((and (boundp 'org-force-remember-template-char)
- org-force-remember-template-char)
- (if (stringp org-force-remember-template-char)
- (string-to-char org-force-remember-template-char)
- org-force-remember-template-char))
- (t
- (setq msg (format
- "Select template: %s%s"
- (mapconcat
- (lambda (x)
- (cond
- ((not (string-match "\\S-" (nth 1 x)))
- (format "[%c]" (car x)))
- ((equal (downcase (car x))
- (downcase (aref (nth 1 x) 0)))
- (format "[%c]%s" (car x)
- (substring (nth 1 x) 1)))
- (t (format "[%c]%s" (car x) (nth 1 x)))))
- templates " ")
- (if (assoc ?C templates)
- ""
- " [C]customize templates")))
- (let ((inhibit-quit t) char0)
- (while (not char0)
- (message msg)
- (setq char0 (read-char-exclusive))
- (when (and (not (assoc char0 templates))
- (not (equal char0 ?\C-g))
- (not (equal char0 ?C)))
- (message "No such template \"%c\"" char0)
- (ding) (sit-for 1)
- (setq char0 nil)))
- (when (equal char0 ?\C-g)
- (jump-to-register remember-register)
- (kill-buffer remember-buffer)
- (error "Abort"))
- (when (not (assoc char0 templates))
- (jump-to-register remember-register)
- (kill-buffer remember-buffer)
- (customize-variable 'org-remember-templates)
- (error "Customize templates"))
- char0))))))
- (cddr (assoc char templates)))))
-
-;;;###autoload
-(defun org-remember-apply-template (&optional use-char skip-interactive)
- "Initialize *remember* buffer with template, invoke `org-mode'.
-This function should be placed into `remember-mode-hook' and in fact requires
-to be run from that hook to function properly."
- (when (and (boundp 'initial) (stringp initial))
- (setq initial (org-no-properties initial)))
- (if org-remember-templates
- (let* ((entry (org-select-remember-template use-char))
- (ct (or org-overriding-default-time (org-current-time)))
- (dct (decode-time ct))
- (ct1
- (if (< (nth 2 dct) org-extend-today-until)
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
- ct))
- (tpl (car entry))
- (plist-p (if org-store-link-plist t nil))
- (file (if (and (nth 1 entry)
- (or (and (stringp (nth 1 entry))
- (string-match "\\S-" (nth 1 entry)))
- (functionp (nth 1 entry))))
- (nth 1 entry)
- org-default-notes-file))
- (headline (nth 2 entry))
- (v-c (and (> (length kill-ring) 0) (current-kill 0)))
- (v-x (or (org-get-x-clipboard 'PRIMARY)
- (org-get-x-clipboard 'CLIPBOARD)
- (org-get-x-clipboard 'SECONDARY)))
- (v-t (format-time-string (car org-time-stamp-formats) ct))
- (v-T (format-time-string (cdr org-time-stamp-formats) ct))
- (v-u (concat "[" (substring v-t 1 -1) "]"))
- (v-U (concat "[" (substring v-T 1 -1) "]"))
- ;; `initial' and `annotation' are bound in `remember'.
- ;; But if the property list has them, we prefer those values
- (v-i (or (plist-get org-store-link-plist :initial)
- (and (boundp 'initial) (symbol-value 'initial))
- ""))
- (v-a (or (plist-get org-store-link-plist :annotation)
- (and (boundp 'annotation) (symbol-value 'annotation))
- ""))
- ;; Is the link empty? Then we do not want it...
- (v-a (if (equal v-a "[[]]") "" v-a))
- (clipboards (remove nil (list v-i
- (org-get-x-clipboard 'PRIMARY)
- (org-get-x-clipboard 'CLIPBOARD)
- (org-get-x-clipboard 'SECONDARY)
- v-c)))
- (v-A (if (and v-a
- (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
- (replace-match "[\\1[%^{Link description}]]" nil nil v-a)
- v-a))
- (v-n user-full-name)
- (v-k (if (marker-buffer org-clock-marker)
- (org-no-properties org-clock-heading)))
- (v-K (if (marker-buffer org-clock-marker)
- (org-make-link-string
- (buffer-file-name (marker-buffer org-clock-marker))
- org-clock-heading)))
- v-I
- (org-startup-folded nil)
- (org-inhibit-startup t)
- org-time-was-given org-end-time-was-given x
- prompt completions char time pos default histvar)
-
- (when (functionp file)
- (setq file (funcall file)))
- (when (functionp headline)
- (setq headline (funcall headline)))
- (when (and file (not (file-name-absolute-p file)))
- (setq file (expand-file-name file org-directory)))
-
- (setq org-store-link-plist
- (plist-put org-store-link-plist :annotation v-a)
- org-store-link-plist
- (plist-put org-store-link-plist :initial v-i))
-
- (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1))
- (erase-buffer)
- (insert (substitute-command-keys
- (format
- "# %s \"%s\" -> \"* %s\"
-# C-u C-c C-c like C-c C-c, and immediately visit note at target location
-# C-0 C-c C-c \"%s\" -> \"* %s\"
-# %s to select file and header location interactively.
-# C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item
-# To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n"
- (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c")
- (abbreviate-file-name (or file org-default-notes-file))
- (or headline "")
- (or (car org-remember-previous-location) "???")
- (or (cdr org-remember-previous-location) "???")
- (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c"))))
- (insert tpl)
-
- ;; %[] Insert contents of a file.
- (goto-char (point-min))
- (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
- (unless (org-remember-escaped-%)
- (let ((start (match-beginning 0))
- (end (match-end 0))
- (filename (expand-file-name (match-string 1))))
- (goto-char start)
- (delete-region start end)
- (condition-case error
- (insert-file-contents filename)
- (error (insert (format "%%![Couldn't insert %s: %s]"
- filename error)))))))
- ;; Simple %-escapes
- (goto-char (point-min))
- (let ((init (and (boundp 'initial)
- (symbol-value 'initial))))
- (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
- (unless (org-remember-escaped-%)
- (when (and init (equal (match-string 0) "%i"))
- (save-match-data
- (let* ((lead (buffer-substring
- (point-at-bol) (match-beginning 0))))
- (setq v-i (mapconcat 'identity
- (org-split-string init "\n")
- (concat "\n" lead))))))
- (replace-match
- (or (eval (intern (concat "v-" (match-string 1)))) "")
- t t))))
-
- ;; %() embedded elisp
- (goto-char (point-min))
- (while (re-search-forward "%\\((.+)\\)" nil t)
- (unless (org-remember-escaped-%)
- (goto-char (match-beginning 0))
- (let ((template-start (point)))
- (forward-char 1)
- (let ((result
- (condition-case error
- (eval (read (current-buffer)))
- (error (format "%%![Error: %s]" error)))))
- (delete-region template-start (point))
- (insert result)))))
-
- ;; From the property list
- (when plist-p
- (goto-char (point-min))
- (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
- (unless (org-remember-escaped-%)
- (and (setq x (or (plist-get org-store-link-plist
- (intern (match-string 1))) ""))
- (replace-match x t t)))))
-
- ;; Turn on org-mode in the remember buffer, set local variables
- (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))
- (if (and file (string-match "\\S-" file) (not (file-directory-p file)))
- (org-set-local 'org-default-notes-file file))
- (if headline
- (org-set-local 'org-remember-default-headline headline))
- (org-set-local 'org-remember-reference-date
- (list (nth 4 dct) (nth 3 dct) (nth 5 dct)))
- ;; Interactive template entries
- (goto-char (point-min))
- (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
- (unless (org-remember-escaped-%)
- (setq char (if (match-end 3) (match-string 3))
- prompt (if (match-end 2) (match-string 2)))
- (goto-char (match-beginning 0))
- (replace-match "")
- (setq completions nil default nil)
- (when prompt
- (setq completions (org-split-string prompt "|")
- prompt (pop completions)
- default (car completions)
- histvar (intern (concat
- "org-remember-template-prompt-history::"
- (or prompt "")))
- completions (mapcar 'list completions)))
- (cond
- ((member char '("G" "g"))
- (let* ((org-last-tags-completion-table
- (org-global-tags-completion-table
- (if (equal char "G") (org-agenda-files) (and file (list file)))))
- (org-add-colon-after-tag-completion t)
- (ins (org-icompleting-read
- (if prompt (concat prompt ": ") "Tags: ")
- 'org-tags-completion-function nil nil nil
- 'org-tags-history)))
- (setq ins (mapconcat 'identity
- (org-split-string ins (org-re "[^[:alnum:]_@#%]+"))
- ":"))
- (when (string-match "\\S-" ins)
- (or (equal (char-before) ?:) (insert ":"))
- (insert ins)
- (or (equal (char-after) ?:) (insert ":")))))
- ((equal char "C")
- (cond ((= (length clipboards) 1) (insert (car clipboards)))
- ((> (length clipboards) 1)
- (insert (read-string "Clipboard/kill value: "
- (car clipboards) '(clipboards . 1)
- (car clipboards))))))
- ((equal char "L")
- (cond ((= (length clipboards) 1)
- (org-insert-link 0 (car clipboards)))
- ((> (length clipboards) 1)
- (org-insert-link 0 (read-string "Clipboard/kill value: "
- (car clipboards)
- '(clipboards . 1)
- (car clipboards))))))
- ((equal char "p")
- (let*
- ((prop (org-no-properties prompt))
- (pall (concat prop "_ALL"))
- (allowed
- (with-current-buffer
- (or (find-buffer-visiting file)
- (find-file-noselect file))
- (or (cdr (assoc pall org-file-properties))
- (cdr (assoc pall org-global-properties))
- (cdr (assoc pall org-global-properties-fixed)))))
- (existing (with-current-buffer
- (or (find-buffer-visiting file)
- (find-file-noselect file))
- (mapcar 'list (org-property-values prop))))
- (propprompt (concat "Value for " prop ": "))
- (val (if allowed
- (org-completing-read
- propprompt
- (mapcar 'list (org-split-string allowed "[ \t]+"))
- nil 'req-match)
- (org-completing-read-no-i propprompt existing nil nil
- "" nil ""))))
- (org-set-property prop val)))
- (char
- ;; These are the date/time related ones
- (setq org-time-was-given (equal (upcase char) char))
- (setq time (org-read-date (equal (upcase char) "U") t nil
- prompt))
- (org-insert-time-stamp time org-time-was-given
- (member char '("u" "U"))
- nil nil (list org-end-time-was-given)))
- (t
- (let (org-completion-use-ido)
- (insert (org-without-partial-completion
- (org-completing-read-no-i
- (concat (if prompt prompt "Enter string")
- (if default (concat " [" default "]"))
- ": ")
- completions nil nil nil histvar default))))))))
-
- (goto-char (point-min))
- (if (re-search-forward "%\\?" nil t)
- (replace-match "")
- (and (re-search-forward "^[^#\n]" nil t) (backward-char 1))))
- (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)))
- (when (save-excursion
- (goto-char (point-min))
- (re-search-forward "%&" nil t))
- (replace-match "")
- (org-set-local 'org-jump-to-target-location t))
- (when org-remember-backup-directory
- (unless (file-directory-p org-remember-backup-directory)
- (make-directory org-remember-backup-directory))
- (org-set-local 'auto-save-file-name-transforms nil)
- (setq buffer-file-name
- (expand-file-name
- (format-time-string "remember-%Y-%m-%d-%H-%M-%S")
- org-remember-backup-directory))
- (save-buffer)
- (org-set-local 'auto-save-visited-file-name t)
- (auto-save-mode 1))
- (when (save-excursion
- (goto-char (point-min))
- (re-search-forward "%!" nil t))
- (replace-match "")
- (add-hook 'post-command-hook 'org-remember-finish-immediately 'append)))
-
-(defun org-remember-escaped-% ()
- (if (equal (char-before (match-beginning 0)) ?\\)
- (progn
- (delete-region (1- (match-beginning 0)) (match-beginning 0))
- t)
- nil))
-
-
-(defun org-remember-finish-immediately ()
- "File remember note immediately.
-This should be run in `post-command-hook' and will remove itself
-from that hook."
- (remove-hook 'post-command-hook 'org-remember-finish-immediately)
- (org-remember-finalize))
-
-(defun org-remember-visit-immediately ()
- "File remember note immediately.
-This should be run in `post-command-hook' and will remove itself
-from that hook."
- (org-remember '(16))
- (goto-char (or (text-property-any
- (point) (save-excursion (org-end-of-subtree t t))
- 'org-position-cursor t)
- (point)))
- (message "%s"
- (format
- (substitute-command-keys
- "Restore window configuration with \\[jump-to-register] %c")
- remember-register)))
-
-(defvar org-clock-marker) ; Defined in org.el
-(defun org-remember-finalize ()
- "Finalize the remember process."
- (interactive)
- (unless org-remember-mode
- (error "This does not seem to be a remember buffer for Org-mode"))
- (run-hooks 'org-remember-before-finalize-hook)
- (unless (fboundp 'remember-finalize)
- (defalias 'remember-finalize 'remember-buffer))
- (when (and org-clock-marker
- (equal (marker-buffer org-clock-marker) (current-buffer)))
- ;; the clock is running in this buffer.
- (when (and (equal (marker-buffer org-clock-marker) (current-buffer))
- (or (eq org-remember-clock-out-on-exit t)
- (and org-remember-clock-out-on-exit
- (y-or-n-p "The clock is running in this buffer. Clock out now? "))))
- (let (org-log-note-clock-out) (org-clock-out))))
- (when buffer-file-name
- (do-auto-save))
- (remember-finalize))
-
-(defun org-remember-kill ()
- "Abort the current remember process."
- (interactive)
- (let ((org-note-abort t))
- (org-remember-finalize)))
-
-;;;###autoload
-(defun org-remember (&optional goto org-force-remember-template-char)
- "Call `remember'. If this is already a remember buffer, re-apply template.
-If there is an active region, make sure remember uses it as initial content
-of the remember buffer.
-
-When called interactively with a \\[universal-argument] \
-prefix argument GOTO, don't remember
-anything, just go to the file/headline where the selected template usually
-stores its notes. With a double prefix argument \
-\\[universal-argument] \\[universal-argument], go to the last
-note stored by remember.
-
-Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character
-associated with a template in `org-remember-templates'."
- (interactive "P")
- (org-require-remember)
- (cond
- ((equal goto '(4)) (org-go-to-remember-target))
- ((equal goto '(16)) (org-remember-goto-last-stored))
- (t
- ;; set temporary variables that will be needed in
- ;; `org-select-remember-template'
- (setq org-select-template-temp-major-mode major-mode)
- (setq org-select-template-original-buffer (current-buffer))
- (if org-remember-mode
- (progn
- (when (< (length org-remember-templates) 2)
- (error "No other template available"))
- (erase-buffer)
- (let ((annotation (plist-get org-store-link-plist :annotation))
- (initial (plist-get org-store-link-plist :initial)))
- (org-remember-apply-template))
- (message "Press C-c C-c to remember data"))
- (if (org-region-active-p)
- (org-do-remember (buffer-substring (point) (mark)))
- (org-do-remember))))))
-
-(defvar org-remember-last-stored-marker (make-marker)
- "Marker pointing to the entry most recently stored with `org-remember'.")
-
-(defun org-remember-goto-last-stored ()
- "Go to the location where the last remember note was stored."
- (interactive)
- (org-goto-marker-or-bmk org-remember-last-stored-marker
- "org-remember-last-stored")
- (message "This is the last note stored by remember"))
-
-(defun org-go-to-remember-target (&optional template-key)
- "Go to the target location of a remember template.
-The user is queried for the template."
- (interactive)
- (let* (org-select-template-temp-major-mode
- (entry (org-select-remember-template template-key))
- (file (nth 1 entry))
- (heading (nth 2 entry))
- visiting)
- (unless (and file (stringp file) (string-match "\\S-" file))
- (setq file org-default-notes-file))
- (when (and file (not (file-name-absolute-p file)))
- (setq file (expand-file-name file org-directory)))
- (unless (and heading (stringp heading) (string-match "\\S-" heading))
- (setq heading org-remember-default-headline))
- (setq visiting (org-find-base-buffer-visiting file))
- (if (not visiting) (find-file-noselect file))
- (org-pop-to-buffer-same-window (or visiting (get-file-buffer file)))
- (widen)
- (goto-char (point-min))
- (if (re-search-forward
- (format org-complex-heading-regexp-format (regexp-quote heading))
- nil t)
- (goto-char (match-beginning 0))
- (error "Target headline not found: %s" heading))))
-
-;; FIXME (bzg): let's clean up of final empty lines happen only once
-;; (see the org-remember-delete-empty-lines-at-end option below)
-;;;###autoload
-(defun org-remember-handler ()
- "Store stuff from remember.el into an org file.
-When the template has specified a file and a headline, the entry is filed
-there, or in the location defined by `org-default-notes-file' and
-`org-remember-default-headline'.
-\\<org-remember-mode-map>
-If no defaults have been defined, or if the current prefix argument
-is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive
-process is used to select the target location.
-
-When the prefix is 0 (i.e. when remember is exited with \
-C-0 \\[org-remember-finalize]),
-the entry is filed to the same location as the previous note.
-
-When the prefix is 2 (i.e. when remember is exited with \
-C-2 \\[org-remember-finalize]),
-the entry is filed as a subentry of the entry where the clock is
-currently running.
-
-When \\[universal-argument] has been used as prefix argument, the
-note is stored and Emacs moves point to the new location of the
-note, so that editing can be continued there (similar to
-inserting \"%&\" into the template).
-
-Before storing the note, the function ensures that the text has an
-org-mode-style headline, i.e. a first line that starts with
-a \"*\". If not, a headline is constructed from the current date and
-some additional data.
-
-If the variable `org-adapt-indentation' is non-nil, the entire text is
-also indented so that it starts in the same column as the headline
-\(i.e. after the stars).
-
-See also the variable `org-reverse-note-order'."
- (when (and (equal current-prefix-arg 2)
- (not (marker-buffer org-clock-marker)))
- (error "No running clock"))
- (when (org-bound-and-true-p org-jump-to-target-location)
- (let* ((end (min (point-max) (1+ (point))))
- (beg (point)))
- (if (= end beg) (setq beg (1- beg)))
- (put-text-property beg end 'org-position-cursor t)))
- (goto-char (point-min))
- (while (looking-at "^[ \t]*\n\\|^# .*\n")
- (replace-match ""))
- (when org-remember-delete-empty-lines-at-end
- (goto-char (point-max))
- (beginning-of-line 1)
- (while (and (looking-at "[ \t]*$\\|[ \t]*# .*") (> (point) 1))
- (delete-region (1- (point)) (point-max))
- (beginning-of-line 1)))
- (catch 'quit
- (if org-note-abort (throw 'quit t))
- (let* ((visitp (org-bound-and-true-p org-jump-to-target-location))
- (backup-file
- (and buffer-file-name
- (equal (file-name-directory buffer-file-name)
- (file-name-as-directory
- (expand-file-name org-remember-backup-directory)))
- (string-match "^remember-[0-9]\\{4\\}"
- (file-name-nondirectory buffer-file-name))
- buffer-file-name))
-
- (dummy
- (unless (string-match "\\S-" (buffer-string))
- (message "Nothing to remember")
- (and backup-file
- (ignore-errors
- (delete-file backup-file)
- (delete-file (concat backup-file "~"))))
- (set-buffer-modified-p nil)
- (throw 'quit t)))
- (reference-date org-remember-reference-date)
- (previousp (and (member current-prefix-arg '((16) 0))
- org-remember-previous-location))
- (clockp (equal current-prefix-arg 2))
- (clocksp (equal current-prefix-arg 3))
- (fastp (org-xor (equal current-prefix-arg 1)
- org-remember-store-without-prompt))
- (file (cond
- (fastp org-default-notes-file)
- ((and (eq org-remember-interactive-interface 'refile)
- org-refile-targets)
- org-default-notes-file)
- ((not previousp)
- (org-get-org-file))))
- (heading org-remember-default-headline)
- (visiting (and file (org-find-base-buffer-visiting file)))
- (org-startup-folded nil)
- (org-startup-align-all-tables nil)
- (org-goto-start-pos 1)
- spos exitcmd level reversed txt text-before-node-creation)
- (when (equal current-prefix-arg '(4))
- (setq visitp t))
- (when previousp
- (setq file (car org-remember-previous-location)
- visiting (and file (org-find-base-buffer-visiting file))
- heading (cdr org-remember-previous-location)
- fastp t))
- (when (or clockp clocksp)
- (setq file (buffer-file-name (marker-buffer org-clock-marker))
- visiting (and file (org-find-base-buffer-visiting file))
- heading org-clock-heading-for-remember
- fastp t))
- (setq current-prefix-arg nil)
- ;; Modify text so that it becomes a nice subtree which can be inserted
- ;; into an org tree.
- (when org-remember-delete-empty-lines-at-end
- (goto-char (point-min))
- (if (re-search-forward "[ \t\n]+\\'" nil t)
- ;; remove empty lines at end
- (replace-match "")))
- (goto-char (point-min))
- (setq text-before-node-creation (buffer-string))
- (unless (looking-at org-outline-regexp)
- ;; add a headline
- (insert (concat "* " (current-time-string)
- " (" (remember-buffer-desc) ")\n"))
- (backward-char 1)
- (when org-adapt-indentation
- (while (re-search-forward "^" nil t)
- (insert " "))))
- ;; Delete final empty lines
- (when org-remember-delete-empty-lines-at-end
- (goto-char (point-min))
- (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t)
- (replace-match "\n\n")
- (if (re-search-forward "[ \t\n]*\\'")
- (replace-match "\n"))))
- (goto-char (point-min))
- (setq txt (buffer-string))
- (org-save-markers-in-region (point-min) (point-max))
- (set-buffer-modified-p nil)
- (when (and (eq org-remember-interactive-interface 'refile)
- (not fastp))
- (org-refile nil (or visiting (find-file-noselect file)))
- (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
- (save-excursion
- (bookmark-jump "org-refile-last-stored")
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point)))
- (throw 'quit t))
- ;; Find the file
- (with-current-buffer (or visiting (find-file-noselect file))
- (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom)))
- (error "Target files for notes must be in Org-mode if not filing to top/bottom"))
- (save-excursion
- (save-restriction
- (widen)
- (setq reversed (org-notes-order-reversed-p))
-
- ;; Find the default location
- (when heading
- (cond
- ((not (derived-mode-p 'org-mode))
- (if (eq heading 'top)
- (goto-char (point-min))
- (goto-char (point-max))
- (or (bolp) (newline)))
- (insert text-before-node-creation)
- (when remember-save-after-remembering
- (save-buffer)
- (if (not visiting) (kill-buffer (current-buffer))))
- (throw 'quit t))
- ((eq heading 'top)
- (goto-char (point-min))
- (or (looking-at org-outline-regexp)
- (re-search-forward org-outline-regexp nil t))
- (setq org-goto-start-pos (or (match-beginning 0) (point-min))))
- ((eq heading 'bottom)
- (goto-char (point-max))
- (or (bolp) (newline))
- (setq org-goto-start-pos (point)))
- ((eq heading 'date-tree)
- (org-datetree-find-date-create reference-date)
- (setq reversed nil)
- (setq org-goto-start-pos (point)))
- ((and (stringp heading) (string-match "\\S-" heading))
- (goto-char (point-min))
- (if (re-search-forward
- (format org-complex-heading-regexp-format
- (regexp-quote heading))
- nil t)
- (setq org-goto-start-pos (match-beginning 0))
- (when fastp
- (goto-char (point-max))
- (unless (bolp) (newline))
- (insert "* " heading "\n")
- (setq org-goto-start-pos (point-at-bol 0)))))
- (t (goto-char (point-min)) (setq org-goto-start-pos (point)
- heading 'top))))
-
- ;; Ask the User for a location, using the appropriate interface
- (cond
- ((and fastp (memq heading '(top bottom)))
- (setq spos org-goto-start-pos
- exitcmd (if (eq heading 'top) 'left nil)))
- (fastp (setq spos org-goto-start-pos
- exitcmd 'return))
- ((eq org-remember-interactive-interface 'outline)
- (setq spos (org-get-location (current-buffer)
- org-remember-help)
- exitcmd (cdr spos)
- spos (car spos)))
- ((eq org-remember-interactive-interface 'outline-path-completion)
- (let ((org-refile-targets '((nil . (:maxlevel . 10))))
- (org-refile-use-outline-path t))
- (setq spos (org-refile-get-location "Heading")
- exitcmd 'return
- spos (nth 3 spos))))
- (t (error "This should not happen")))
- (if (not spos) (throw 'quit nil)) ; return nil to show we did
- ; not handle this note
- (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately))
- (goto-char spos)
- (cond ((org-at-heading-p t)
- (org-back-to-heading t)
- (setq level (funcall outline-level))
- (cond
- ((eq exitcmd 'return)
- ;; sublevel of current
- (setq org-remember-previous-location
- (cons (abbreviate-file-name file)
- (org-get-heading 'notags)))
- (if reversed
- (outline-next-heading)
- (org-end-of-subtree t)
- (if (not (bolp))
- (if (looking-at "[ \t]*\n")
- (beginning-of-line 2)
- (end-of-line 1)
- (insert "\n"))))
- (org-paste-subtree (if clocksp
- level
- (org-get-valid-level level 1)) txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point)))
- ((eq exitcmd 'left)
- ;; before current
- (org-paste-subtree level txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point)))
- ((eq exitcmd 'right)
- ;; after current
- (org-end-of-subtree t)
- (org-paste-subtree level txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point)))
- (t (error "This should not happen"))))
-
- ((eq heading 'bottom)
- (org-paste-subtree 1 txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point)))
-
- ((and (bobp) (not reversed))
- ;; Put it at the end, one level below level 1
- (save-restriction
- (widen)
- (goto-char (point-max))
- (if (not (bolp)) (newline))
- (org-paste-subtree (org-get-valid-level 1 1) txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point))))
-
- ((and (bobp) reversed)
- ;; Put it at the start, as level 1
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward org-outline-regexp-bol nil t)
- (beginning-of-line 1)
- (org-paste-subtree 1 txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point))))
- (t
- ;; Put it right there, with automatic level determined by
- ;; org-paste-subtree or from prefix arg
- (org-paste-subtree
- (if (numberp current-prefix-arg) current-prefix-arg)
- txt)
- (and org-auto-align-tags (org-set-tags nil t))
- (bookmark-set "org-remember-last-stored")
- (move-marker org-remember-last-stored-marker (point))))
-
- (when remember-save-after-remembering
- (save-buffer)
- (if (and (not visiting)
- (not (equal (marker-buffer org-clock-marker)
- (current-buffer))))
- (kill-buffer (current-buffer))))
- (when org-remember-auto-remove-backup-files
- (when backup-file
- (ignore-errors
- (delete-file backup-file)
- (delete-file (concat backup-file "~"))))
- (when org-remember-backup-directory
- (let ((n (length
- (directory-files
- org-remember-backup-directory nil
- "^remember-.*[0-9]$"))))
- (when (and org-remember-warn-about-backups
- (> n 0))
- (message
- "%d backup files (unfinished remember calls) in %s"
- n org-remember-backup-directory))))))))))
-
- t) ;; return t to indicate that we took care of this note.
-
-(defun org-do-remember (&optional initial)
- "Call remember."
- (remember initial))
-
-(defun org-require-remember ()
- "Make sure remember is loaded, or install our own emergency version of it."
- (condition-case nil
- (require 'remember)
- (error
- ;; Lets install our own micro version of remember
- (defvar remember-register ?R)
- (defvar remember-mode-hook nil)
- (defvar remember-handler-functions nil)
- (defvar remember-buffer "*Remember*")
- (defvar remember-save-after-remembering t)
- (defvar remember-annotation-functions '(buffer-file-name))
- (defun remember-finalize ()
- (run-hook-with-args-until-success 'remember-handler-functions)
- (when (equal remember-buffer (buffer-name))
- (kill-buffer (current-buffer))
- (jump-to-register remember-register)))
- (defun remember-mode ()
- (fundamental-mode)
- (setq mode-name "Remember")
- (run-hooks 'remember-mode-hook))
- (defun remember (&optional initial)
- (window-configuration-to-register remember-register)
- (let* ((annotation (run-hook-with-args-until-success
- 'remember-annotation-functions)))
- (switch-to-buffer-other-window (get-buffer-create remember-buffer))
- (remember-mode)))
- (defun remember-buffer-desc ()
- (buffer-substring (point-min) (save-excursion (goto-char (point-min))
- (point-at-eol)))))))
-
-(provide 'org-remember)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-remember.el ends here
diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el
index e2f9fbeef60..da515e29c49 100644
--- a/lisp/org/org-rmail.el
+++ b/lisp/org/org-rmail.el
@@ -1,6 +1,6 @@
;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -95,7 +95,10 @@
(defun org-rmail-follow-link (folder article)
"Follow an Rmail link to FOLDER and ARTICLE."
(require 'rmail)
- (setq article (org-add-angle-brackets article))
+ (cond ((null article) (setq article ""))
+ ((stringp article)
+ (setq article (org-add-angle-brackets article)))
+ (t (user-error "Wrong RMAIL link format")))
(let (message-number)
(save-excursion
(save-window-excursion
@@ -105,8 +108,7 @@
(rmail-widen)
(goto-char (point-max))
(if (re-search-backward
- (concat "^Message-ID:\\s-+" (regexp-quote
- (or article "")))
+ (concat "^Message-ID:\\s-+" (regexp-quote article))
nil t)
(rmail-what-message))))))
(if message-number
diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el
deleted file mode 100644
index bbf5fef4bc1..00000000000
--- a/lisp/org/org-special-blocks.el
+++ /dev/null
@@ -1,104 +0,0 @@
-;;; org-special-blocks.el --- handle Org special blocks
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
-
-;; Author: Chris Gray <chrismgray@gmail.com>
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-
-;; This package generalizes the #+begin_foo and #+end_foo tokens.
-
-;; To use, put the following in your init file:
-;;
-;; (require 'org-special-blocks)
-
-;; The tokens #+begin_center, #+begin_verse, etc. existed previously.
-;; This package generalizes them (at least for the LaTeX and html
-;; exporters). When a #+begin_foo token is encountered by the LaTeX
-;; exporter, it is expanded into \begin{foo}. The text inside the
-;; environment is not protected, as text inside environments generally
-;; is. When #+begin_foo is encountered by the html exporter, a div
-;; with class foo is inserted into the HTML file. It is up to the
-;; user to add this class to his or her stylesheet if this div is to
-;; mean anything.
-
-(require 'org-html)
-(require 'org-compat)
-
-(declare-function org-open-par "org-html" ())
-(declare-function org-close-par-maybe "org-html" ())
-
-(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$"
- "A regexp indicating the names of blocks that should be ignored
-by org-special-blocks. These blocks will presumably be
-interpreted by other mechanisms.")
-
-(defvar org-export-current-backend) ; dynamically bound in org-exp.el
-(defun org-special-blocks-make-special-cookies ()
- "Adds special cookies when #+begin_foo and #+end_foo tokens are
-seen. This is run after a few special cases are taken care of."
- (when (or (eq org-export-current-backend 'html)
- (eq org-export-current-backend 'latex))
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t)
- (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2))
- (replace-match
- (if (equal (downcase (match-string 1)) "begin")
- (concat "ORG-" (match-string 2) "-START")
- (concat "ORG-" (match-string 2) "-END"))
- t t)))))
-
-(add-hook 'org-export-preprocess-after-blockquote-hook
- 'org-special-blocks-make-special-cookies)
-
-(defun org-special-blocks-convert-latex-special-cookies ()
- "Converts the special cookies into LaTeX blocks."
- (goto-char (point-min))
- (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t)
- (replace-match
- (if (equal (match-string 3) "START")
- (concat "\\begin{" (match-string 1) "}" (match-string 2))
- (concat "\\end{" (match-string 1) "}"))
- t t)))
-
-
-(add-hook 'org-export-latex-after-blockquotes-hook
- 'org-special-blocks-convert-latex-special-cookies)
-
-(defvar org-line)
-(defun org-special-blocks-convert-html-special-cookies ()
- "Converts the special cookies into div blocks."
- ;; Uses the dynamically-bound variable `org-line'.
- (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line))
- (message "%s" (match-string 1))
- (when (equal (match-string 2 org-line) "START")
- (org-close-par-maybe)
- (insert "\n<div class=\"" (match-string 1 org-line) "\">")
- (org-open-par))
- (when (equal (match-string 2 org-line) "END")
- (org-close-par-maybe)
- (insert "\n</div>")
- (org-open-par))
- (throw 'nextline nil)))
-
-(add-hook 'org-export-html-after-blockquotes-hook
- 'org-special-blocks-convert-html-special-cookies)
-
-(provide 'org-special-blocks)
-
-;;; org-special-blocks.el ends here
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 501d30ab1d7..c970fe6c851 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -1,9 +1,9 @@
;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT gnu DOT org>
+;; Bastien Guerry <bzg@gnu.org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
@@ -64,6 +64,30 @@ there are kept outside the narrowed region."
(const :tag "from `lang' element")
(const :tag "from `style' element")))))
+(defcustom org-edit-src-turn-on-auto-save nil
+ "Non-nil means turn `auto-save-mode' on when editing a source block.
+This will save the content of the source code editing buffer into
+a newly created file, not the base buffer for this source block.
+
+If you want to regularly save the base buffer instead of the source
+code editing buffer, see `org-edit-src-auto-save-idle-delay' instead."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-edit-src-auto-save-idle-delay 0
+ "Delay before saving a source code buffer back into its base buffer.
+When a positive integer N, save after N seconds of idle time.
+When 0 (the default), don't auto-save.
+
+If you want to save the source code buffer itself, don't use this.
+Check `org-edit-src-turn-on-auto-save' instead."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
(defcustom org-coderef-label-format "(ref:%s)"
"The default coderef format.
This format string will be used to search for coderef labels in literal
@@ -142,10 +166,10 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
(const reorganize-frame)))
(defvar org-src-mode-hook nil
- "Hook run after Org switched a source code snippet to its Emacs mode.
+ "Hook run after Org switched a source code snippet to its Emacs mode.
This hook will run
-- when editing a source code snippet with \"C-c '\".
+- when editing a source code snippet with `\\[org-src-mode-map]'.
- When formatting a source code snippet for export with htmlize.
You may want to use this hook for example to turn off `outline-minor-mode'
@@ -155,7 +179,7 @@ but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
- ("calc" . fundamental) ("C" . c) ("cpp" . c++)
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
("screen" . shell-script))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
@@ -174,6 +198,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(defvar org-src-mode-map (make-sparse-keymap))
(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
+(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort)
(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
(defvar org-edit-src-force-single-line nil)
@@ -186,22 +211,27 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(defvar org-edit-src-block-indentation nil)
(defvar org-edit-src-saved-temp-window-config nil)
-(defvar org-src-ask-before-returning-to-edit-buffer t
+(defcustom org-src-ask-before-returning-to-edit-buffer t
"If nil, when org-edit-src code is used on a block that already
has an active edit buffer, it will switch to that edit buffer
immediately; otherwise it will ask whether you want to return to
-the existing edit buffer.")
+the existing edit buffer."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
(defvar org-src-babel-info nil)
(define-minor-mode org-src-mode
"Minor mode for language major mode buffers generated by org.
This minor mode is turned on in two situations:
-- when editing a source code snippet with \"C-c '\".
+- when editing a source code snippet with `\\[org-src-mode-map]'.
- When formatting a source code snippet for export with htmlize.
There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'")
+(defvar org-edit-src-code-timer nil)
(defun org-edit-src-code (&optional context code edit-buffer-name)
"Edit the source CODE block at point.
The code is copied to a separate buffer and the appropriate mode
@@ -240,9 +270,8 @@ the display of windows containing the Org buffer and the code buffer."
(setq beg (move-marker beg (nth 0 info))
end (move-marker end (nth 1 info))
msg (if allow-write-back-p
- (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)")
- "Exit with C-c ' (C-c and single quote)")
+ "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort"
+ "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
code (or code (buffer-substring-no-properties beg end))
lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
(nth 2 info))
@@ -318,7 +347,7 @@ the display of windows containing the Org buffer and the code buffer."
(condition-case e
(funcall lang-f)
(error
- (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
+ (message "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
;; Remove protecting commas from visible part of buffer.
@@ -336,11 +365,30 @@ the display of windows containing the Org buffer and the code buffer."
(org-src-mode)
(set-buffer-modified-p nil)
(setq buffer-file-name nil)
+ (when org-edit-src-turn-on-auto-save
+ (setq buffer-auto-save-file-name
+ (concat (make-temp-name "org-src-")
+ (format-time-string "-%Y-%d-%m") ".txt")))
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg))
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
(when (fboundp edit-prep-func)
- (funcall edit-prep-func full-info))))
+ (funcall edit-prep-func full-info)))
+ (or org-edit-src-code-timer
+ (zerop org-edit-src-auto-save-idle-delay)
+ (setq org-edit-src-code-timer
+ (run-with-idle-timer
+ org-edit-src-auto-save-idle-delay t
+ (lambda ()
+ (cond
+ ((org-string-match-p "\\`\\*Org Src" (buffer-name))
+ (when (buffer-modified-p) (org-edit-src-save)))
+ ((not (org-some (lambda (b)
+ (org-string-match-p "\\`\\*Org Src"
+ (buffer-name b)))
+ (buffer-list)))
+ (cancel-timer org-edit-src-code-timer)
+ (setq org-edit-src-code-timer nil))))))))
t)))
(defun org-edit-src-continue (e)
@@ -419,8 +467,7 @@ the fragment in the Org-mode buffer."
(let ((line (org-current-line))
(col (current-column))
(case-fold-search t)
- (msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)"))
+ (msg "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
(org-mode-p (derived-mode-p 'org-mode))
(beg (make-marker))
(end (make-marker))
@@ -520,22 +567,12 @@ the language, a switch telling if the content should be in a single line."
("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
- ("^[ \t]*#\\+docbook:" "\n" "xml" single-line)
("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)"
"\n" "fundamental" macro-definition)
- ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml")
)))
(pos (point))
re1 re2 single beg end lang lfmt match-re1 ind entry)
(catch 'exit
- (when (org-at-table.el-p)
- (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
- (setq beg (1+ (point-at-eol)))
- (goto-char beg)
- (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
- (progn (goto-char (point-max)) (newline)))
- (setq end (1- (point-at-bol)))
- (throw 'exit (list beg end 'table.el nil nil 0)))
(while (setq entry (pop re-list))
(setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
single (nth 3 entry))
@@ -566,7 +603,15 @@ the language, a switch telling if the content should be in a single line."
(throw 'exit
(list (match-end 0) end
(org-edit-src-get-lang lang)
- single lfmt ind))))))))))))
+ single lfmt ind)))))))))
+ (when (org-at-table.el-p)
+ (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
+ (setq beg (1+ (point-at-eol)))
+ (goto-char beg)
+ (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
+ (progn (goto-char (point-max)) (newline)))
+ (setq end (1- (point-at-bol)))
+ (throw 'exit (list beg end 'table.el nil nil 0))))))
(defun org-edit-src-get-lang (lang)
"Extract the src language."
@@ -688,8 +733,8 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(unless (or single preserve-indentation (= total-nindent 0))
(setq indent (make-string total-nindent ?\ ))
(goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match indent)))
+ (while (re-search-forward "\\(^\\).+" nil t)
+ (replace-match indent nil nil nil 1)))
(if (org-bound-and-true-p org-edit-src-picture)
(setq total-nindent (+ total-nindent 2)))
(setq code (buffer-string))
@@ -699,12 +744,17 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
(if (eq context 'save) (save-buffer)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil))
(kill-buffer buffer))
(goto-char beg)
(when allow-write-back-p
+ (undo-boundary)
(delete-region beg (max beg end))
(unless (string-match "\\`[ \t]*\\'" code)
(insert code))
+ ;; Make sure the overlay stays in place
+ (when (eq context 'save) (move-overlay ovl beg (point)))
(goto-char beg)
(if single (just-one-space)))
(if (memq t (mapcar (lambda (overlay)
@@ -714,8 +764,9 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
;; Block is hidden; put point at start of block
(beginning-of-line 0)
;; Block is visible, put point where it was in the code buffer
- (org-goto-line (1- (+ (org-current-line) line)))
- (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))
+ (when allow-write-back-p
+ (org-goto-line (1- (+ (org-current-line) line)))
+ (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))))
(unless (eq context 'save)
(move-marker beg nil)
(move-marker end nil)))
@@ -724,6 +775,12 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(set-window-configuration org-edit-src-saved-temp-window-config)
(setq org-edit-src-saved-temp-window-config nil))))
+(defun org-edit-src-abort ()
+ "Abort editing of the src code and return to the Org buffer."
+ (interactive)
+ (let (org-edit-src-allow-write-back-p)
+ (org-edit-src-exit 'exit)))
+
(defmacro org-src-in-org-buffer (&rest body)
`(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
(save-window-excursion
@@ -743,9 +800,11 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(defun org-edit-src-save ()
"Save parent buffer with current state source-code buffer."
(interactive)
- (org-src-in-org-buffer (save-buffer)))
+ (if (string-match "Fixed Width" (buffer-name))
+ (user-error "%s" "Use C-c ' to save and exit, C-c C-k to abort editing")
+ (org-src-in-org-buffer (save-buffer))))
-(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang))
+(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang))
(defun org-src-tangle (arg)
"Tangle the parent buffer."
@@ -778,8 +837,9 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(let ((session (cdr (assoc :session (nth 2 info)))))
(and session (not (string= session "none"))
(org-babel-comint-buffer-livep session)
- ((lambda (f) (and (fboundp f) (funcall f session)))
- (intern (format "org-babel-%s-associate-session" (nth 0 info)))))))
+ (let ((f (intern (format "org-babel-%s-associate-session"
+ (nth 0 info)))))
+ (and (fboundp f) (funcall f session))))))
(defun org-src-babel-configure-edit-buffer ()
(when org-src-babel-info
@@ -805,9 +865,9 @@ This command is not bound to a key by default, to avoid conflicts
with language major mode bindings. To bind it to C-c @ in all
language major modes, you could use
- (add-hook 'org-src-mode-hook
+ (add-hook \\='org-src-mode-hook
(lambda () (define-key org-src-mode-map \"\\C-c@\"
- 'org-src-do-key-sequence-at-code-block)))
+ \\='org-src-do-key-sequence-at-code-block)))
In that case, for example, C-c @ t issued in code edit buffers
would tangle the current Org code block, C-c @ e would execute
@@ -829,9 +889,9 @@ issued in the language major mode buffer."
(defun org-src-native-tab-command-maybe ()
"Perform language-specific TAB action.
-Alter code block according to effect of TAB in the language major
-mode."
+Alter code block according to what TAB does in the language major mode."
(and org-src-tab-acts-natively
+ (org-in-src-block-p)
(not (equal this-command 'org-shifttab))
(let ((org-src-strip-leading-and-trailing-blank-lines nil))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
@@ -856,7 +916,7 @@ fontification of code blocks see `org-src-fontify-block' and
(delete-region (point-min) (point-max))
(insert string " ") ;; so there's a final property change
(unless (eq major-mode lang-mode) (funcall lang-mode))
- (font-lock-fontify-buffer)
+ (org-font-lock-ensure)
(setq pos (point-min))
(while (setq next (next-single-property-change pos 'face))
(put-text-property
@@ -887,8 +947,9 @@ fontification of code blocks see `org-src-fontify-block' and
LANG is a string, and the returned major mode is a symbol."
(intern
(concat
- ((lambda (l) (if (symbolp l) (symbol-name l) l))
- (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
+ (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
+ (if (symbolp l) (symbol-name l) l))
+ "-mode")))
(provide 'org-src)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 00b2eb4d028..174e36ed632 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -1,6 +1,6 @@
;;; org-table.el --- The table editor for Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -38,13 +38,11 @@
(require 'cl))
(require 'org)
-(declare-function org-table-clean-before-export "org-exp"
- (lines &optional maybe-quoted))
-(declare-function org-format-org-table-html "org-html" (lines &optional splice))
+(declare-function org-export-string-as "ox"
+ (string backend &optional body-only ext-plist))
(declare-function aa2u "ext:ascii-art-to-unicode" ())
(defvar orgtbl-mode) ; defined below
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
-(defvar org-export-html-table-tag) ; defined in org-exp.el
(defvar constants-unit-system)
(defvar org-table-follow-field-mode)
@@ -54,6 +52,8 @@ This can be used to add additional functionality after the table is sent
to the receiver position, otherwise, if table is not sent, the functions
are not run.")
+(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ")
+
(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
"Non-nil means use the optimized table editor version for `orgtbl-mode'.
In the optimized version, the table editor takes over all simple keys that
@@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective."
| | |
"))
"Templates for radio tables in different major modes.
+Each template must define lines that will be treated as a comment and that
+must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\"
+lines where \"%n\" will be replaced with the name of the table during
+insertion of the template. The transformed table will later be inserted
+between these lines.
+
+The template should also contain a minimal table in a multiline comment.
+If multiline comments are not possible in the buffer language,
+you can pack it into a string that will not be used when the code
+is compiled or executed. Above the table will you need a line with
+the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to
+convert the table into a data structure useful in the
+language of the buffer. Check the manual for the section on
+\"Translator functions\", and more generally check out
+http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax
+
All occurrences of %n in a template will be replaced with the name of the
table, obtained by prompting the user."
:group 'org-table
@@ -112,7 +128,7 @@ table, obtained by prompting the user."
:type 'string)
(defcustom org-table-number-regexp
- "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$"
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$"
"Regular expression for recognizing numbers in table columns.
If a table column contains mostly numbers, it will be aligned to the
right. If not, it will be aligned to the left.
@@ -136,10 +152,10 @@ Other options offered by the customize interface are more restrictive."
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
(const :tag "Exponential, Floating point, Integer"
"^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
- (const :tag "Very General Number-Like, including hex"
- "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
- (const :tag "Very General Number-Like, including hex, allows comma as decimal mark"
- "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$")
+ (const :tag "Very General Number-Like, including hex and Calc radix"
+ "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[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][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
(string :tag "Regexp:")))
(defcustom org-table-number-fraction 0.5
@@ -419,6 +435,40 @@ available parameters."
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
+(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
+(defun org-table-clean-before-export (lines &optional maybe-quoted)
+ "Check if the table has a marking column.
+If yes remove the column and the special lines."
+ (let ((special (if maybe-quoted
+ "^[ \t]*| *\\\\?[#!$*_^/ ] *|"
+ "^[ \t]*| *[#!$*_^/ ] *|"))
+ (ignore (if maybe-quoted
+ "^[ \t]*| *\\\\?[!$_^/] *|"
+ "^[ \t]*| *[!$_^/] *|")))
+ (setq org-table-clean-did-remove-column
+ (not (memq nil
+ (mapcar
+ (lambda (line)
+ (or (string-match org-table-hline-regexp line)
+ (string-match special line)))
+ lines))))
+ (delq nil
+ (mapcar
+ (lambda (line)
+ (cond
+ ((or (org-table-colgroup-line-p line) ;; colgroup info
+ (org-table-cookie-line-p line) ;; formatting cookies
+ (and org-table-clean-did-remove-column
+ (string-match ignore line))) ;; non-exportable data
+ nil)
+ ((and org-table-clean-did-remove-column
+ (or (string-match "^\\([ \t]*\\)|-+\\+" line)
+ (string-match "^\\([ \t]*\\)|[^|]*|" line)))
+ ;; remove the first column
+ (replace-match "\\1|" t nil line))
+ (t line)))
+ lines))))
+
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
@@ -495,15 +545,15 @@ slightly, to make sure a beginning of line in the first line is included.
SEPARATOR specifies the field separator in the lines. It can have the
following values:
-'(4) Use the comma as a field separator
-'(16) Use a TAB as field separator
+(4) Use the comma as a field separator
+(16) Use a TAB as field separator
integer When a number, use that many spaces as field separator
nil When nil, the command tries to be smart and figure out the
separator in the following way:
- when each line contains a TAB, assume TAB-separated material
- when each line contains a comma, assume CSV material
- else, assume one or more SPACE characters as separator."
- (interactive "rP")
+ (interactive "r\nP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
@@ -539,7 +589,7 @@ nil When nil, the command tries to be smart and figure out the
((equal separator '(16)) "^\\|\t")
((integerp separator)
(if (< separator 1)
- (error "Number of spaces in separator must be >= 1")
+ (user-error "Number of spaces in separator must be >= 1")
(format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
(t (error "This should not happen"))))
(while (re-search-forward re end t)
@@ -579,9 +629,7 @@ whether it is set locally or up in the hierarchy, then on the
extension of the given file name, and finally on the variable
`org-table-export-default-format'."
(interactive)
- (unless (org-at-table-p)
- (error "No table at point"))
- (require 'org-exp)
+ (unless (org-at-table-p) (user-error "No table at point"))
(org-table-align) ;; make sure we have everything we need
(let* ((beg (org-table-begin))
(end (org-table-end))
@@ -598,13 +646,13 @@ extension of the given file name, and finally on the variable
(setq file (read-file-name "Export table to: "))
(unless (or (not (file-exists-p file))
(y-or-n-p (format "Overwrite file %s? " file)))
- (error "Abort")))
+ (user-error "File not written")))
(if (file-directory-p file)
- (error "This is a directory path, not a file"))
+ (user-error "This is a directory path, not a file"))
(if (and (buffer-file-name)
(equal (file-truename file)
(file-truename (buffer-file-name))))
- (error "Please specify a file name that is different from current"))
+ (user-error "Please specify a file name that is different from current"))
(setq fileext (concat (file-name-extension file) "$"))
(unless format
(setq deffmt-readable
@@ -641,7 +689,7 @@ extension of the given file name, and finally on the variable
skipcols i0)))
(unless (fboundp transform)
- (error "No such transformation function %s" transform))
+ (user-error "No such transformation function %s" transform))
(setq txt (funcall transform table params))
(with-current-buffer (find-file-noselect file)
@@ -652,7 +700,7 @@ extension of the given file name, and finally on the variable
(save-buffer))
(kill-buffer buf)
(message "Export done."))
- (error "TABLE_EXPORT_FORMAT invalid"))))
+ (user-error "TABLE_EXPORT_FORMAT invalid"))))
(defvar org-table-aligned-begin-marker (make-marker)
"Marker at the beginning of the table last aligned.
@@ -760,7 +808,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(error
(kill-region beg end)
(org-table-create org-table-default-size)
- (error "Empty table - created default table")))
+ (user-error "Empty table - created default table")))
;; A list of empty strings to fill any short rows on output
(setq emptystrings (make-list maxfields ""))
;; Check for special formatting.
@@ -787,7 +835,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
(setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
(unless (> f1 1)
- (error "Cannot narrow field starting with wide link \"%s\""
+ (user-error "Cannot narrow field starting with wide link \"%s\""
(match-string 0 xx)))
(add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
(add-text-properties (- f1 2) f1
@@ -860,12 +908,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(org-goto-line winstartline)
(setq winstart (point-at-bol))
(org-goto-line linepos)
- (set-window-start (selected-window) winstart 'noforce)
+ (when (eq (window-buffer (selected-window)) (current-buffer))
+ (set-window-start (selected-window) winstart 'noforce))
(org-table-goto-column colpos)
(and org-table-overlay-coordinates (org-table-overlay-coordinates))
(setq org-table-may-need-update nil)
))
+;;;###autoload
(defun org-table-begin (&optional table-type)
"Find the beginning of the table and return its position.
With argument TABLE-TYPE, go to the beginning of a table.el-type table."
@@ -879,6 +929,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table."
(beginning-of-line 2)
(point))))
+;;;###autoload
(defun org-table-end (&optional table-type)
"Find the end of the table and return its position.
With argument TABLE-TYPE, go to the end of a table.el-type table."
@@ -978,7 +1029,7 @@ Before doing so, re-align the table if necessary."
(progn
(re-search-backward "|" (org-table-begin))
(re-search-backward "|" (org-table-begin)))
- (error (error "Cannot move to previous table field")))
+ (error (user-error "Cannot move to previous table field")))
(while (looking-at "|\\(-\\|[ \t]*$\\)")
(re-search-backward "|" (org-table-begin)))
(if (looking-at "| ?")
@@ -994,7 +1045,7 @@ With numeric argument N, move N-1 fields forward first."
(setq n (1- n))
(org-table-previous-field))
(if (not (re-search-backward "|" (point-at-bol 0) t))
- (error "No more table fields before the current")
+ (user-error "No more table fields before the current")
(goto-char (match-end 0))
(and (looking-at " ") (forward-char 1)))
(if (>= (point) pos) (org-table-beginning-of-field 2))))
@@ -1055,7 +1106,7 @@ copying. In the case of a timestamp, increment by one day."
(interactive "p")
(let* ((colpos (org-table-current-column))
(col (current-column))
- (field (org-table-get-field))
+ (field (save-excursion (org-table-get-field)))
(non-empty (string-match "[^ \t]" field))
(beg (org-table-begin))
(orig-n n)
@@ -1091,7 +1142,7 @@ copying. In the case of a timestamp, increment by one day."
(org-table-maybe-recalculate-line))
(org-table-align)
(org-move-to-column col))
- (error "No non-empty field found"))))
+ (user-error "No non-empty field found"))))
(defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field?
@@ -1103,7 +1154,7 @@ This actually throws an error, so it aborts the current command."
(looking-at "[ \t]*$"))
(if noerror
nil
- (error "Not in table data field"))
+ (user-error "Not in table data field"))
t))
(defvar org-table-clip nil
@@ -1150,6 +1201,7 @@ Return t when the line exists, nil if it does not exist."
(< (setq cnt (1+ cnt)) N)))
(= cnt N)))
+;;;###autoload
(defun org-table-blank-field ()
"Blank the current table field or active region."
(interactive)
@@ -1189,6 +1241,7 @@ is always the old value."
(defun org-table-field-info (arg)
"Show info about the current field, and highlight any reference at point."
(interactive "P")
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-get-specials)
(save-excursion
(let* ((pos (point))
@@ -1286,7 +1339,7 @@ However, when FORCE is non-nil, create new columns if necessary."
"Insert a new column into the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(let* ((col (max 1 (org-table-current-column)))
(beg (org-table-begin))
@@ -1326,7 +1379,7 @@ However, when FORCE is non-nil, create new columns if necessary."
(if (and (org-at-table-p)
(not (org-at-table-hline-p)))
t
- (error
+ (user-error
"Please position cursor in a data line for column operations")))))
(defun org-table-line-to-dline (line &optional above)
@@ -1356,7 +1409,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"Delete a column from the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
@@ -1400,7 +1453,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
"Move the current column to the right. With arg LEFT, move to the left."
(interactive "P")
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
@@ -1411,9 +1464,9 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(linepos (org-current-line))
(colpos (if left (1- col) (1+ col))))
(if (and left (= col 1))
- (error "Cannot move column further left"))
+ (user-error "Cannot move column further left"))
(if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
- (error "Cannot move column further right"))
+ (user-error "Cannot move column further right"))
(goto-char beg)
(while (< (point) end)
(if (org-at-table-hline-p)
@@ -1461,7 +1514,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(beginning-of-line tonew)
(unless (org-at-table-p)
(goto-char pos)
- (error "Cannot move row further"))
+ (user-error "Cannot move row further"))
(setq hline2p (looking-at org-table-hline-regexp))
(goto-char pos)
(beginning-of-line 1)
@@ -1486,7 +1539,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
With prefix ARG, insert below the current line."
(interactive "P")
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
(new (org-table-clean-line line)))
;; Fix the first field if necessary
@@ -1508,7 +1561,7 @@ With prefix ARG, insert below the current line."
With prefix ABOVE, insert above the current line."
(interactive "P")
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(when (eobp) (insert "\n") (backward-char 1))
(if (not (string-match "|[ \t]*$" (org-current-line-string)))
(org-table-align))
@@ -1558,7 +1611,7 @@ In particular, this does handle wide and invisible characters."
"Delete the current row or horizontal line from the table."
(interactive)
(if (not (org-at-table-p))
- (error "Not at a table"))
+ (user-error "Not at a table"))
(let ((col (current-column))
(dline (org-table-current-dline)))
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
@@ -1710,7 +1763,7 @@ the table is enlarged as needed. The process ignores horizontal separator
lines."
(interactive)
(unless (and org-table-clip (listp org-table-clip))
- (error "First cut/copy a region to paste!"))
+ (user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field)
(let* ((clip org-table-clip)
(line (org-current-line))
@@ -1796,11 +1849,16 @@ will be transposed as
Note that horizontal lines disappeared."
(interactive)
- (let ((contents
- (apply #'mapcar* #'list
- ;; remove 'hline from list
- (delq nil (mapcar (lambda (x) (when (listp x) x))
- (org-table-to-lisp))))))
+ (let* ((table (delete 'hline (org-table-to-lisp)))
+ (contents (mapcar (lambda (p)
+ (let ((tp table))
+ (mapcar
+ (lambda (rown)
+ (prog1
+ (pop (car tp))
+ (setq tp (cdr tp))))
+ table)))
+ (car table))))
(delete-region (org-table-begin) (org-table-end))
(insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
contents ""))
@@ -1839,7 +1897,7 @@ blank, and the content is appended to the field above."
nlines)
(org-table-cut-region (region-beginning) (region-end))
(if (> (length (car org-table-clip)) 1)
- (error "Region must be limited to single column"))
+ (user-error "Region must be limited to single column"))
(setq nlines (if arg
(if (< arg 1)
(+ (length org-table-clip) arg)
@@ -2008,12 +2066,12 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(setq col (org-table-current-column))
(goto-char (org-table-begin))
(unless (re-search-forward "^[ \t]*|[^-]" nil t)
- (error "No table data"))
+ (user-error "No table data"))
(org-table-goto-column col)
(setq beg (point))
(goto-char (org-table-end))
(unless (re-search-backward "^[ \t]*|[^-]" nil t)
- (error "No table data"))
+ (user-error "No table data"))
(org-table-goto-column col)
(setq end (point))))
(let* ((items (apply 'append (org-table-copy-region beg end)))
@@ -2031,7 +2089,7 @@ If NLAST is a number, only the NLAST fields will actually be summed."
h (floor (/ diff 3600)) diff (mod diff 3600)
m (floor (/ diff 60)) diff (mod diff 60)
s diff)
- (format "%d:%02d:%02d" h m s))))
+ (format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)
(if (org-called-interactively-p 'interactive)
(message "%s"
@@ -2098,7 +2156,7 @@ When NAMED is non-nil, look for a named equation."
(int-to-string (org-table-current-column))))
(dummy (and (or nameass refass) (not named)
(not (y-or-n-p "Replace existing field formula with column formula? " ))
- (error "Abort")))
+ (message "Formula not replaced")))
(name (or name ref))
(org-table-may-need-update nil)
(stored (cdr (assoc scol stored-list)))
@@ -2122,7 +2180,7 @@ When NAMED is non-nil, look for a named equation."
;; remove formula
(setq stored-list (delq (assoc scol stored-list) stored-list))
(org-table-store-formulas stored-list)
- (error "Formula removed"))
+ (user-error "Formula removed"))
(if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
(if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
(if (and name (not named))
@@ -2207,7 +2265,7 @@ When NAMED is non-nil, look for a named equation."
(message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
(ding)
(sit-for 2))
- (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
+ (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
(push scol seen))))))
(nreverse eq-alist)))
@@ -2217,7 +2275,7 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace.
For all numbers larger than LIMIT, shift them by DELTA."
(save-excursion
(goto-char (org-table-end))
- (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
+ (while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
(let ((msg "The formulas in #+TBLFM have been updated")
(re (concat key "\\([0-9]+\\)"))
(re2
@@ -2231,8 +2289,9 @@ For all numbers larger than LIMIT, shift them by DELTA."
(while (re-search-forward re2 (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
(if (equal (char-before (match-beginning 0)) ?.)
- (error "Change makes TBLFM term %s invalid, use undo to recover"
- (match-string 0))
+ (user-error
+ "Change makes TBLFM term %s invalid, use undo to recover"
+ (match-string 0))
(replace-match "")))))
(while (re-search-forward re (point-at-eol) t)
(unless (save-match-data (org-in-regexp "remote([^)]+?)"))
@@ -2243,7 +2302,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
(message msg))
((and limit (> n limit))
(replace-match (concat key (int-to-string (+ n delta))) t t)
- (message msg)))))))))
+ (message msg))))))
+ (forward-line))))
(defun org-table-get-specials ()
"Get the column names and local parameters for this table."
@@ -2291,7 +2351,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
(string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
(push (cons field v) org-table-local-parameters)
(push (list field line col) org-table-named-field-locations))))
- ;; Analyse the line types
+ ;; Analyze the line types.
(goto-char beg)
(setq org-table-current-begin-line (org-current-line)
org-table-current-begin-pos (point)
@@ -2338,7 +2398,7 @@ If yes, store the formula and apply it."
(equal (substring eq 0 (min 2 (length eq))) "'("))
(org-table-eval-formula (if named '(4) nil)
(org-table-formula-from-user eq))
- (error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
+ (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
(defvar org-recalc-commands nil
"List of commands triggering the recalculation of a line.
@@ -2363,7 +2423,7 @@ after prompting for the marking character.
After each change, a message will be displayed indicating the meaning
of the new mark."
(interactive)
- (unless (org-at-table-p) (error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
(beg (org-table-begin))
(end (org-table-end))
@@ -2382,13 +2442,13 @@ of the new mark."
(setq newchar (char-to-string (read-char-exclusive))
forcenew (car (assoc newchar org-recalc-marks))))
(if (and newchar (not forcenew))
- (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
+ (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
newchar))
(if l1 (org-goto-line l1))
(save-excursion
(beginning-of-line 1)
(unless (looking-at org-table-dataline-regexp)
- (error "Not at a table data line")))
+ (user-error "Not at a table data line")))
(unless have-col
(org-table-goto-column 1)
(org-table-insert-column)
@@ -2483,7 +2543,7 @@ not overwrite the stored one."
(or suppress-analysis (org-table-get-specials))
(if (equal arg '(16))
(let ((eq (org-table-current-field-formula)))
- (or eq (error "No equation active for current field"))
+ (or eq (user-error "No equation active for current field"))
(org-table-get-field nil eq)
(org-table-align)
(setq org-table-may-need-update t))
@@ -2557,7 +2617,10 @@ not overwrite the stored one."
fields)))
(if (eq numbers t)
(setq fields (mapcar
- (lambda (x) (number-to-string (string-to-number x)))
+ (lambda (x)
+ (if (string-match "\\S-" x)
+ (number-to-string (string-to-number x))
+ x))
fields)))
(setq ndown (1- ndown))
(setq form (copy-sequence formula)
@@ -2612,7 +2675,7 @@ not overwrite the stored one."
(if (not (save-match-data
(string-match (regexp-quote form) formrpl)))
(setq form (replace-match formrpl t t form))
- (error "Spreadsheet error: invalid reference \"%s\"" form)))
+ (user-error "Spreadsheet error: invalid reference \"%s\"" form)))
;; Insert simple ranges
(while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
(setq form
@@ -2630,11 +2693,12 @@ not overwrite the stored one."
(setq n (+ (string-to-number (match-string 1 form))
(if (match-end 2) n0 0))
x (nth (1- (if (= n 0) n0 (max n 1))) fields))
- (unless x (error "Invalid field specifier \"%s\""
+ (unless x (user-error "Invalid field specifier \"%s\""
(match-string 0 form)))
(setq form (replace-match
(save-match-data
- (org-table-make-reference x nil numbers lispp))
+ (org-table-make-reference
+ x keep-empty numbers lispp))
t t form)))
(if lispp
@@ -2646,12 +2710,24 @@ not overwrite the stored one."
(string-to-number ev)
duration-output-format) ev))
(or (fboundp 'calc-eval)
- (error "Calc does not seem to be installed, and is needed to evaluate the formula"))
- ;; "Inactivate" time-stamps so that Calc can handle them
- (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))
+ ;; Use <...> time-stamps so that Calc can handle them
+ (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form)
+ (setq form (replace-match "<\\1>" nil nil form)))
+ ;; I18n-ize local time-stamps by setting (system-time-locale "C")
+ (when (string-match org-ts-regexp2 form)
+ (let* ((ts (match-string 0 form))
+ (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts))))
+ (system-time-locale "C")
+ (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
+ (cdr org-time-stamp-formats))
+ (car org-time-stamp-formats))))
+ (setq form (replace-match (format-time-string tf tsp) t t form))))
+
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
form
- (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num)))
+ (calc-eval (cons form org-tbl-calc-modes)
+ (when (and (not keep-empty) numbers) 'num)))
ev (if duration (org-table-time-seconds-to-string
(if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
(string-to-number (org-table-time-string-to-seconds ev))
@@ -2667,7 +2743,7 @@ $xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
(if (listp ev)
- (princ (format " %s^\nError: %s"
+ (princ (format " %s^\nError: %s"
(make-string (car ev) ?\-) (nth 1 ev)))
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
ev (or fmt "NONE")
@@ -2678,7 +2754,7 @@ $1-> %s\n" orig formula form0 form))
(unless (let (inhibit-redisplay)
(y-or-n-p "Debugging Formula. Continue to next? "))
(org-table-align)
- (error "Abort"))
+ (user-error "Abort"))
(delete-window bw)
(message "")))
(if (listp ev) (setq fmt nil ev "#ERROR"))
@@ -2716,7 +2792,7 @@ in the buffer and column1 and column2 are table column numbers."
(let ((thisline (org-current-line))
beg end c1 c2 r1 r2 rangep tmp)
(unless (string-match org-table-range-regexp desc)
- (error "Invalid table range specifier `%s'" desc))
+ (user-error "Invalid table range specifier `%s'" desc))
(setq rangep (match-end 3)
r1 (and (match-end 1) (match-string 1 desc))
r2 (and (match-end 4) (match-string 4 desc))
@@ -2784,7 +2860,7 @@ and TABLE is a vector with line types."
;; 1 2 3 4 5 6
(and (not (match-end 3)) (not (match-end 6)))
(and (match-end 3) (match-end 6) (not (match-end 5))))
- (error "Invalid row descriptor `%s'" desc))
+ (user-error "Invalid row descriptor `%s'" desc))
(let* ((hdir (and (match-end 2) (match-string 2 desc)))
(hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
(odir (and (match-end 5) (match-string 5 desc)))
@@ -2798,7 +2874,7 @@ and TABLE is a vector with line types."
(setq i 0 hdir "+")
(if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
(if (and (not hn) on (not odir))
- (error "Should never happen");;(aref org-table-dlines on)
+ (user-error "Should never happen");;(aref org-table-dlines on)
(if (and hn (> hn 0))
(setq i (org-table-find-row-type table i 'hline (equal hdir "-")
nil hn cline desc)))
@@ -2818,41 +2894,56 @@ and TABLE is a vector with line types."
(cond
((eq org-table-relative-ref-may-cross-hline t) t)
((eq org-table-relative-ref-may-cross-hline 'error)
- (error "Row descriptor %s used in line %d crosses hline" desc cline))
+ (user-error "Row descriptor %s used in line %d crosses hline" desc cline))
(t (setq i (- i (if backwards -1 1))
n 1)
nil))
t)))
(setq n (1- n)))
(if (or (< i 0) (>= i l))
- (error "Row descriptor %s used in line %d leads outside table"
+ (user-error "Row descriptor %s used in line %d leads outside table"
desc cline)
i)))
(defun org-table-rewrite-old-row-references (s)
(if (string-match "&[-+0-9I]" s)
- (error "Formula contains old &row reference, please rewrite using @-syntax")
+ (user-error "Formula contains old &row reference, please rewrite using @-syntax")
s))
(defun org-table-make-reference (elements keep-empty numbers lispp)
"Convert list ELEMENTS to something appropriate to insert into formula.
KEEP-EMPTY indicated to keep empty fields, default is to skip them.
NUMBERS indicates that everything should be converted to numbers.
-LISPP means to return something appropriate for a Lisp list."
- (if (stringp elements) ; just a single val
+LISPP non-nil means to return something appropriate for a Lisp
+list, 'literal is for the format specifier L."
+ ;; Calc nan (not a number) is used for the conversion of the empty
+ ;; field to a reference for several reasons: (i) It is accepted in a
+ ;; Calc formula (e. g. "" or "()" would result in a Calc error).
+ ;; (ii) In a single field (not in range) it can be distinguished
+ ;; from "(nan)" which is the reference made from a single field
+ ;; containing "nan".
+ (if (stringp elements)
+ ;; field reference
(if lispp
(if (eq lispp 'literal)
elements
- (prin1-to-string (if numbers (string-to-number elements) elements)))
- (if (equal elements "") (setq elements "0"))
- (if numbers (setq elements (number-to-string (string-to-number elements))))
- (concat "(" elements ")"))
+ (if (and (eq elements "") (not keep-empty))
+ ""
+ (prin1-to-string
+ (if numbers (string-to-number elements) elements))))
+ (if (string-match "\\S-" elements)
+ (progn
+ (when numbers (setq elements (number-to-string
+ (string-to-number elements))))
+ (concat "(" elements ")"))
+ (if (or (not keep-empty) numbers) "(0)" "nan")))
+ ;; range reference
(unless keep-empty
(setq elements
(delq nil
(mapcar (lambda (x) (if (string-match "\\S-" x) x nil))
elements))))
- (setq elements (or elements '("0")))
+ (setq elements (or elements '())) ; if delq returns nil then we need '()
(if lispp
(mapconcat
(lambda (x)
@@ -2862,11 +2953,33 @@ LISPP means to return something appropriate for a Lisp list."
elements " ")
(concat "[" (mapconcat
(lambda (x)
- (if numbers (number-to-string (string-to-number x)) x))
+ (if (string-match "\\S-" x)
+ (if numbers
+ (number-to-string (string-to-number x))
+ x)
+ (if (or (not keep-empty) numbers) "0" "nan")))
elements
",") "]"))))
;;;###autoload
+(defun org-table-set-constants ()
+ "Set `org-table-formula-constants-local' in the current buffer."
+ (let (cst consts const-str)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
+ (setq const-str (substring-no-properties (match-string 1)))
+ (setq consts (append consts (org-split-string const-str "[ \t]+")))
+ (when consts
+ (let (e)
+ (while (setq e (pop consts))
+ (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
+ (if (assoc-string (match-string 1 e) cst)
+ (setq cst (delete (assoc-string (match-string 1 e) cst) cst)))
+ (push (cons (match-string 1 e) (match-string 2 e)) cst)))
+ (setq org-table-formula-constants-local cst)))))))
+
+;;;###autoload
(defun org-table-recalculate (&optional all noalign)
"Recalculate the current table line by applying all stored formulas.
With prefix arg ALL, do this for all lines in the table.
@@ -2879,7 +2992,7 @@ known that the table will be realigned a little later anyway."
(interactive "P")
(or (memq this-command org-recalc-commands)
(setq org-recalc-commands (cons this-command org-recalc-commands)))
- (unless (org-at-table-p) (error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(if (or (eq all 'iterate) (equal all '(16)))
(org-table-iterate)
(org-table-get-specials)
@@ -2902,7 +3015,7 @@ known that the table will be realigned a little later anyway."
(car x)) 1)
(cdr x)))
(if (assoc (car x) eqlist1)
- (error "\"%s=\" formula tries to overwrite existing formula for column %s"
+ (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
lhs1 (car x))))
(cons
(org-table-formula-handle-first/last-rc (car x))
@@ -2947,7 +3060,7 @@ known that the table will be realigned a little later anyway."
(if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
(nth 2 a))))
(when (member name1 seen-fields)
- (error "Several field/range formulas try to set %s" name1))
+ (user-error "Several field/range formulas try to set %s" name1))
(push name1 seen-fields)
(and (not a)
@@ -2956,7 +3069,7 @@ known that the table will be realigned a little later anyway."
(condition-case nil
(aref org-table-dlines
(string-to-number (match-string 1 name)))
- (error (error "Invalid row number in %s"
+ (error (user-error "Invalid row number in %s"
name)))
(string-to-number (match-string 2 name)))))
(when (and a (or all (equal (nth 1 a) thisline)))
@@ -3026,7 +3139,7 @@ with the prefix ARG."
(message "Convergence after %d iterations" i)
(message "Table was already stable"))
(throw 'exit t)))
- (error "No convergence after %d iterations" i))))
+ (user-error "No convergence after %d iterations" i))))
;;;###autoload
(defun org-table-recalculate-buffer-tables ()
@@ -3057,7 +3170,40 @@ with the prefix ARG."
(message "Convergence after %d iterations" (- imax i))
(throw 'exit t))
(setq checksum c1)))
- (error "No convergence after %d iterations" imax))))))
+ (user-error "No convergence after %d iterations" imax))))))
+
+(defun org-table-calc-current-TBLFM (&optional arg)
+ "Apply the #+TBLFM in the line at point to the table."
+ (interactive "P")
+ (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
+ (let ((formula (buffer-substring
+ (point-at-bol)
+ (point-at-eol)))
+ s e)
+ (save-excursion
+ ;; Insert a temporary formula at right after the table
+ (goto-char (org-table-TBLFM-begin))
+ (setq s (point-marker))
+ (insert (concat formula "\n"))
+ (setq e (point-marker))
+ ;; Recalculate the table
+ (beginning-of-line 0) ; move to the inserted line
+ (skip-chars-backward " \r\n\t")
+ (if (org-at-table-p)
+ (unwind-protect
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ ;; delete the formula inserted temporarily
+ (delete-region s e))))))
+
+(defun org-table-TBLFM-begin ()
+ "Find the beginning of the TBLFM lines and return its position.
+Return nil when the beginning of TBLFM line was not found."
+ (save-excursion
+ (when (progn (forward-line 1)
+ (re-search-backward
+ org-table-TBLFM-begin-regexp
+ nil t))
+ (point-at-bol 2))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
@@ -3102,7 +3248,7 @@ formulas that use a range of rows or columns, it may often be better
to anchor the formula with \"I\" row markers, or to offset from the
borders of the table using the @< @> $< $> makers."
(let (n nmax len char (start 0))
- (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)"
+ (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^)]+)\\)"
s start)
(if (match-end 3)
(setq start (match-end 3))
@@ -3115,7 +3261,7 @@ borders of the table using the @< @> $< $> makers."
len
(- nmax len -1)))
(if (or (< n 1) (> n nmax))
- (error "Reference \"%s\" in expression \"%s\" points outside table"
+ (user-error "Reference \"%s\" in expression \"%s\" points outside table"
(match-string 0 s) s))
(setq start (match-beginning 0))
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
@@ -3214,7 +3360,7 @@ Parameters get priority."
(interactive)
(when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
(beginning-of-line 0))
- (unless (org-at-table-p) (error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-get-specials)
(let ((key (org-table-current-field-formula 'key 'noerror))
(eql (sort (org-table-get-stored-formulas 'noerror)
@@ -3258,7 +3404,7 @@ Parameters get priority."
(if (eq org-table-use-standard-references t)
(org-table-fedit-toggle-ref-type))
(org-goto-line startline)
- (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands.")))
+ (message "%s" "Edit formulas, finish with C-c C-c or C-c '. See menu for more commands.")))
(defun org-table-fedit-post-command ()
(when (not (memq this-command '(lisp-complete-symbol)))
@@ -3436,7 +3582,7 @@ minutes or seconds."
((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&")
(if (memq dir '(left right))
(org-rematch-and-replace 1 (eq dir 'left))
- (error "Cannot shift reference in this direction")))
+ (user-error "Cannot shift reference in this direction")))
((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
;; A B3-like reference
(if (memq dir '(up down))
@@ -3451,7 +3597,7 @@ minutes or seconds."
(defun org-rematch-and-replace (n &optional decr hline)
"Re-match the group N, and replace it with the shifted reference."
- (or (match-end n) (error "Cannot shift reference in this direction"))
+ (or (match-end n) (user-error "Cannot shift reference in this direction"))
(goto-char (match-beginning n))
(and (looking-at (regexp-quote (match-string n)))
(replace-match (org-table-shift-refpart (match-string 0) decr hline)
@@ -3487,7 +3633,7 @@ a translation reference."
(org-number-to-letters
(max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
- (t (error "Cannot shift reference"))))))
+ (t (user-error "Cannot shift reference"))))))
(defun org-table-fedit-toggle-coordinates ()
"Toggle the display of coordinates in the referenced table."
@@ -3519,14 +3665,14 @@ With prefix ARG, apply the new formulas to the table."
(while (string-match "[ \t]*\n[ \t]*" form)
(setq form (replace-match " " t t form)))
(when (assoc var eql)
- (error "Double formulas for %s" var))
+ (user-error "Double formulas for %s" var))
(push (cons var form) eql)))
(setq org-pos nil)
(set-window-configuration org-window-configuration)
(select-window sel-win)
(goto-char pos)
(unless (org-at-table-p)
- (error "Lost table position - cannot install formulas"))
+ (user-error "Lost table position - cannot install formulas"))
(org-table-store-formulas eql)
(move-marker pos nil)
(kill-buffer "*Edit Formulas*")
@@ -3556,14 +3702,14 @@ With prefix ARG, apply the new formulas to the table."
(call-interactively 'lisp-indent-line))
((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
((not (fboundp 'pp-buffer))
- (error "Cannot pretty-print. Command `pp-buffer' is not available"))
+ (user-error "Cannot pretty-print. Command `pp-buffer' is not available"))
((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
(goto-char (- (match-end 0) 2))
(setq beg (point))
(setq ind (make-string (current-column) ?\ ))
(condition-case nil (forward-sexp 1)
(error
- (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
+ (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
(setq end (point))
(save-restriction
(narrow-to-region beg end)
@@ -3615,7 +3761,7 @@ With prefix ARG, apply the new formulas to the table."
((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
((org-at-regexp-p "\\$[0-9]+") 'column)
((not local) nil)
- (t (error "No reference at point")))
+ (t (user-error "No reference at point")))
match (and what (or match (match-string 0))))
(when (and match (not (equal (match-beginning 0) (point-at-bol))))
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
@@ -3682,7 +3828,7 @@ With prefix ARG, apply the new formulas to the table."
(goto-char (match-beginning 1))
(org-table-highlight-rectangle)
(message "Named column (column %s)" (cdr e)))
- (error "Column name not found")))
+ (user-error "Column name not found")))
((eq what 'column)
;; column number
(org-table-goto-column (string-to-number (substring match 1)))
@@ -3695,10 +3841,10 @@ With prefix ARG, apply the new formulas to the table."
(goto-char (match-beginning 1))
(org-table-highlight-rectangle)
(message "Local parameter."))
- (error "Parameter not found")))
+ (user-error "Parameter not found")))
(t
(cond
- ((not var) (error "No reference at point"))
+ ((not var) (user-error "No reference at point"))
((setq e (assoc var org-table-formula-constants-local))
(message "Local Constant: $%s=%s in #+CONSTANTS line."
var (cdr e)))
@@ -3708,7 +3854,7 @@ With prefix ARG, apply the new formulas to the table."
((setq e (and (fboundp 'constants-get) (constants-get var)))
(message "Constant: $%s=%s, from `constants.el'%s."
var e (format " (%s units)" constants-unit-system)))
- (t (error "Undefined name $%s" var)))))
+ (t (user-error "Undefined name $%s" var)))))
(goto-char pos)
(when (and org-show-positions
(not (memq this-command '(org-table-fedit-scroll
@@ -3717,9 +3863,10 @@ With prefix ARG, apply the new formulas to the table."
(push org-table-current-begin-pos org-show-positions)
(let ((min (apply 'min org-show-positions))
(max (apply 'max org-show-positions)))
- (goto-char min) (recenter 0)
+ (set-window-start (selected-window) min)
(goto-char max)
- (or (pos-visible-in-window-p max) (recenter -1))))
+ (or (pos-visible-in-window-p max)
+ (set-window-start (selected-window) max))))
(select-window win))))
(defun org-table-force-dataline ()
@@ -3734,7 +3881,7 @@ With prefix ARG, apply the new formulas to the table."
(goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
p1 p2)))
((or p1 p2) (goto-char (or p1 p2)))
- (t (error "No table dataline around here"))))))
+ (t (user-error "No table dataline around here"))))))
(defun org-table-fedit-line-up ()
"Move cursor one line up in the window showing the table."
@@ -3982,7 +4129,7 @@ to execute outside of tables."
'(arg)
(concat "In tables, run `" (symbol-name fun) "'.\n"
"Outside of tables, run the binding of `"
- (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
+ (mapconcat #'key-description keys "' or `")
"'.")
'(interactive "p")
(list 'if
@@ -3999,7 +4146,7 @@ to execute outside of tables."
(defun orgtbl-error ()
"Error when there is no default binding for a table key."
(interactive)
- (error "This key has no function outside tables"))
+ (user-error "This key has no function outside tables"))
(defun orgtbl-setup ()
"Setup orgtbl keymaps."
@@ -4151,7 +4298,7 @@ to execute outside of tables."
If it is a table to be sent away to a receiver, do it.
With prefix arg, also recompute table."
(interactive "P")
- (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str)
+ (let ((case-fold-search t) (pos (point)) action)
(save-excursion
(beginning-of-line 1)
(setq action (cond
@@ -4169,17 +4316,7 @@ With prefix arg, also recompute table."
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
- (setq const-str (substring-no-properties (match-string 1)))
- (setq consts (append consts (org-split-string const-str "[ \t]+")))
- (when consts
- (let (e)
- (while (setq e (pop consts))
- (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
- (push (cons (match-string 1 e) (match-string 2 e)) cst)))
- (setq org-table-formula-constants-local cst)))))
+ (org-table-set-constants)
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
@@ -4264,31 +4401,6 @@ overwritten, and the table is not marked as requiring realignment."
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
"Regular expression matching exponentials as produced by calc.")
-(defun orgtbl-export (table target)
- (require 'org-exp)
- (let ((func (intern (concat "orgtbl-to-" (symbol-name target))))
- (lines (org-split-string table "[ \t]*\n[ \t]*"))
- org-table-last-alignment org-table-last-column-widths
- maxcol column)
- (if (not (fboundp func))
- (error "Cannot export orgtbl table to %s" target))
- (setq lines (org-table-clean-before-export lines))
- (setq table
- (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- lines))
- (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0))
- table)))
- (loop for i from (1- maxcol) downto 0 do
- (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table))
- (setq column (delq nil column))
- (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths)
- (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment))
- (funcall func table nil)))
-
(defun orgtbl-gather-send-defs ()
"Gather a plist of :name, :transform, :params for each destination before
a radio table."
@@ -4311,15 +4423,15 @@ a radio table."
(save-excursion
(goto-char (point-min))
(unless (re-search-forward
- (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
- (error "Don't know where to insert translated table"))
+ (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
+ (user-error "Don't know where to insert translated table"))
(goto-char (match-beginning 0))
(beginning-of-line 2)
(save-excursion
(let ((beg (point)))
(unless (re-search-forward
- (concat "END RECEIVE ORGTBL +" name) nil t)
- (error "Cannot find end of insertion region"))
+ (concat "END +RECEIVE +ORGTBL +" name) nil t)
+ (user-error "Cannot find end of insertion region"))
(beginning-of-line 1)
(delete-region beg (point))))
(insert txt "\n")))
@@ -4332,7 +4444,7 @@ for a horizontal separator line, or a list of field values as strings.
The table is taken from the parameter TXT, or from the buffer at point."
(unless txt
(unless (org-at-table-p)
- (error "No table at point")))
+ (user-error "No table at point")))
(let* ((txt (or txt
(buffer-substring-no-properties (org-table-begin)
(org-table-end))))
@@ -4351,7 +4463,7 @@ With argument MAYBE, fail quietly if no transformation is defined for
this table."
(interactive)
(catch 'exit
- (unless (org-at-table-p) (error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
;; when non-interactive, we assume align has just happened.
(when (org-called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
@@ -4359,7 +4471,7 @@ this table."
(org-table-end)))
(ntbl 0))
(unless dests (if maybe (throw 'exit nil)
- (error "Don't know how to transform this table")))
+ (user-error "Don't know how to transform this table")))
(dolist (dest dests)
(let* ((name (plist-get dest :name))
(transform (plist-get dest :transform))
@@ -4392,7 +4504,7 @@ this table."
skipcols i0))
(txt (if (fboundp transform)
(funcall transform table params)
- (error "No such transformation function %s" transform))))
+ (user-error "No such transformation function %s" transform))))
(orgtbl-send-replace-tbl name txt))
(setq ntbl (1+ ntbl)))
(message "Table converted and installed at %d receiver location%s"
@@ -4422,7 +4534,7 @@ First element has index 0, or I0 if given."
(commented (save-excursion (beginning-of-line 1)
(cond ((looking-at re1) t)
((looking-at re2) nil)
- (t (error "Not at an org table")))))
+ (t (user-error "Not at an org table")))))
(re (if commented re1 re2))
beg end)
(save-excursion
@@ -4440,7 +4552,7 @@ First element has index 0, or I0 if given."
(let* ((e (assq major-mode orgtbl-radio-table-templates))
(txt (nth 1 e))
name pos)
- (unless e (error "No radio table setup defined for %s" major-mode))
+ (unless e (user-error "No radio table setup defined for %s" major-mode))
(setq name (read-string "Table name: "))
(while (string-match "%n" txt)
(setq txt (replace-match name t t txt)))
@@ -4474,7 +4586,8 @@ First element has index 0, or I0 if given."
fmt))
(defsubst orgtbl-apply-fmt (fmt &rest args)
- "Apply format FMT to the arguments. NIL FMTs return the first argument."
+ "Apply format FMT to arguments ARGS.
+When FMT is nil, return the first argument from ARGS."
(cond ((functionp fmt) (apply fmt args))
(fmt (apply 'format fmt args))
(args (car args))
@@ -4504,7 +4617,7 @@ First element has index 0, or I0 if given."
f)))
line)))
(push (if *orgtbl-lfmt*
- (orgtbl-apply-fmt *orgtbl-lfmt* line)
+ (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line)
(concat (orgtbl-eval-str *orgtbl-lstart*)
(mapconcat 'identity line *orgtbl-sep*)
(orgtbl-eval-str *orgtbl-lend*)))
@@ -4523,12 +4636,15 @@ First element has index 0, or I0 if given."
(orgtbl-format-line prevline))))))
;;;###autoload
-(defun orgtbl-to-generic (table params)
+(defun orgtbl-to-generic (table params &optional backend)
"Convert the orgtbl-mode TABLE to some other format.
This generic routine can be used for many standard cases.
TABLE is a list, each entry either the symbol `hline' for a horizontal
separator line, or a list of fields for that line.
PARAMS is a property list of parameters that can influence the conversion.
+A third optional argument BACKEND can be used to convert the content of
+the cells using a specific export back-end.
+
For the generic converter, some parameters are obligatory: you need to
specify either :lfmt, or all of (:lstart :lend :sep).
@@ -4599,22 +4715,31 @@ directly by `orgtbl-send-table'. See manual."
(*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
(*orgtbl-fmt* (plist-get params :fmt))
*orgtbl-rtn*)
-
+ ;; Convert cells content to backend BACKEND
+ (when backend
+ (setq *orgtbl-table*
+ (mapcar
+ (lambda(r)
+ (if (listp r)
+ (mapcar
+ (lambda (c)
+ (org-trim (org-export-string-as c backend t '(:with-tables t))))
+ r)
+ r))
+ *orgtbl-table*)))
;; Put header
(unless splicep
(when (plist-member params :tstart)
(let ((tstart (orgtbl-eval-str (plist-get params :tstart))))
(if tstart (push tstart *orgtbl-rtn*)))))
-
- ;; Do we have a heading section? If so, format it and handle the
- ;; trailing hline.
+ ;; If we have a heading, format it and handle the trailing hline.
(if (and (not splicep)
(or (consp (car *orgtbl-table*))
(consp (nth 1 *orgtbl-table*)))
(memq 'hline (cdr *orgtbl-table*)))
(progn
(when (eq 'hline (car *orgtbl-table*))
- ;; there is a hline before the first data line
+ ;; There is a hline before the first data line
(and hline (push hline *orgtbl-rtn*))
(pop *orgtbl-table*))
(let* ((*orgtbl-lstart* (or (plist-get params :hlstart)
@@ -4632,15 +4757,12 @@ directly by `orgtbl-send-table'. See manual."
(orgtbl-format-section 'hline))
(if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
(pop *orgtbl-table*)))
-
;; Now format the main section.
(orgtbl-format-section nil)
-
(unless splicep
(when (plist-member params :tend)
(let ((tend (orgtbl-eval-str (plist-get params :tend))))
(if tend (push tend *orgtbl-rtn*)))))
-
(mapconcat (if remove-newlines
(lambda (tend)
(replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
@@ -4698,7 +4820,8 @@ this function is called."
:tend "\\end{tabular}"
:lstart "" :lend " \\\\" :sep " & "
:efmt "%s\\,(%s)" :hline "\\hline")))
- (orgtbl-to-generic table (org-combine-plists params2 params))))
+ (require 'ox-latex)
+ (orgtbl-to-generic table (org-combine-plists params2 params) 'latex)))
;;;###autoload
(defun orgtbl-to-html (table params)
@@ -4714,22 +4837,14 @@ Currently this function recognizes the following parameters:
The general parameters :skip and :skipcols have already been applied when
this function is called. The function does *not* use `orgtbl-to-generic',
so you cannot specify parameters for it."
- (let* ((splicep (plist-get params :splice))
- (html-table-tag org-export-html-table-tag)
- html)
- ;; Just call the formatter we already have
- ;; We need to make text lines for it, so put the fields back together.
- (setq html (org-format-org-table-html
- (mapcar
- (lambda (x)
- (if (eq x 'hline)
- "|----+----|"
- (concat "| " (mapconcat 'org-html-expand x " | ") " |")))
- table)
- splicep))
- (if (string-match "\n+\\'" html)
- (setq html (replace-match "" t t html)))
- html))
+ (require 'ox-html)
+ (let ((output (org-export-string-as
+ (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t))))
+ (if (not (plist-get params :splice)) output
+ (org-trim
+ (replace-regexp-in-string
+ "\\`<table .*>\n" ""
+ (replace-regexp-in-string "</table>\n*\\'" "" output))))))
;;;###autoload
(defun orgtbl-to-texinfo (table params)
@@ -4768,7 +4883,8 @@ this function is called."
:tend "@end multitable"
:lstart "@item " :lend "" :sep " @tab "
:hlstart "@headitem ")))
- (orgtbl-to-generic table (org-combine-plists params2 params))))
+ (require 'ox-texinfo)
+ (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo)))
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
@@ -4815,22 +4931,22 @@ it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
(unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links))
(push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el"
"Link to ascii-art-to-unicode.el") org-stored-links))
- (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
+ (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
(buffer-string)))
(defun org-table-get-remote-range (name-or-id form)
"Get a field value or a list of values in a range from table at ID.
-NAME-OR-ID may be the name of a table in the current file as set by
-a \"#+TBLNAME:\" directive. The first table following this line
+NAME-OR-ID may be the name of a table in the current file as set
+by a \"#+NAME:\" directive. The first table following this line
will then be used. Alternatively, it may be an ID referring to
-any entry, also in a different file. In this case, the first table
-in that entry will be referenced.
+any entry, also in a different file. In this case, the first
+table in that entry will be referenced.
FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
\"@I$2..@II$2\". All the references must be absolute, not relative.
The return value is either a single string for a single field, or a
-list of the fields in the rectangle ."
+list of the fields in the rectangle."
(save-match-data
(let ((case-fold-search t) (id-loc nil)
;; Protect a bunch of variables from being overwritten
@@ -4851,12 +4967,13 @@ list of the fields in the rectangle ."
(save-excursion
(goto-char (point-min))
(if (re-search-forward
- (concat "^[ \t]*#\\+tblname:[ \t]*" (regexp-quote name-or-id) "[ \t]*$")
+ (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
+ (regexp-quote name-or-id) "[ \t]*$")
nil t)
(setq buffer (current-buffer) loc (match-beginning 0))
(setq id-loc (org-id-find name-or-id 'marker))
(unless (and id-loc (markerp id-loc))
- (error "Can't find remote table \"%s\"" name-or-id))
+ (user-error "Can't find remote table \"%s\"" name-or-id))
(setq buffer (marker-buffer id-loc)
loc (marker-position id-loc))
(move-marker id-loc nil)))
@@ -4868,7 +4985,7 @@ list of the fields in the rectangle ."
(forward-char 1)
(unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
(not (match-beginning 1)))
- (error "Cannot find a table at NAME or ID %s" name-or-id))
+ (user-error "Cannot find a table at NAME or ID %s" name-or-id))
(setq tbeg (point-at-bol))
(org-table-get-specials)
(setq form (org-table-formula-substitute-names
@@ -4879,6 +4996,38 @@ list of the fields in the rectangle ."
(org-table-get-range (match-string 0 form) tbeg 1))
form)))))))))
+(defmacro org-define-lookup-function (mode)
+ (let ((mode-str (symbol-name mode))
+ (first-p (equal mode 'first))
+ (all-p (equal mode 'all)))
+ (let ((plural-str (if all-p "s" "")))
+ `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
+ ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
+If R-LIST is nil, return matching element%s of S-LIST.
+If PREDICATE is not nil, use it instead of `equal' to match VAL.
+Matching is done by (PREDICATE VAL S), where S is an element of S-LIST.
+This function is generated by a call to the macro `org-define-lookup-function'."
+ mode-str plural-str plural-str plural-str)
+ (let ,(let ((lvars '((p (or predicate 'equal))
+ (sl s-list)
+ (rl (or r-list s-list))
+ (ret nil))))
+ (if first-p (add-to-list 'lvars '(match-p nil)))
+ lvars)
+ (while ,(if first-p '(and (not match-p) sl) 'sl)
+ (progn
+ (if (funcall p val (car sl))
+ (progn
+ ,(if first-p '(setq match-p t))
+ (let ((rval (car rl)))
+ (setq ret ,(if all-p '(append ret (list rval)) 'rval)))))
+ (setq sl (cdr sl) rl (cdr rl))))
+ ret)))))
+
+(org-define-lookup-function first)
+(org-define-lookup-function last)
+(org-define-lookup-function all)
+
(provide 'org-table)
;; Local variables:
diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el
deleted file mode 100644
index bd4c10b2ee5..00000000000
--- a/lisp/org/org-taskjuggler.el
+++ /dev/null
@@ -1,699 +0,0 @@
-;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode
-;;
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: org-taskjuggler.el
-;; Author: Christian Egli
-;; Maintainer: Christian Egli
-;; Keywords: org, taskjuggler, project planning
-;; Description: Converts an org-mode buffer into a taskjuggler project plan
-;; URL:
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;; Commentary:
-;;
-;; This library implements a TaskJuggler exporter for org-mode.
-;; TaskJuggler uses a text format to define projects, tasks and
-;; resources, so it is a natural fit for org-mode. It can produce all
-;; sorts of reports for tasks or resources in either HTML, CSV or PDF.
-;; The current version of TaskJuggler requires KDE but the next
-;; version is implemented in Ruby and should therefore run on any
-;; platform.
-;;
-;; The exporter is a bit different from other exporters, such as the
-;; HTML and LaTeX exporters for example, in that it does not export
-;; all the nodes of a document or strictly follow the order of the
-;; nodes in the document.
-;;
-;; Instead the TaskJuggler exporter looks for a tree that defines the
-;; tasks and a optionally tree that defines the resources for this
-;; project. It then creates a TaskJuggler file based on these trees
-;; and the attributes defined in all the nodes.
-;;
-;; * Installation
-;;
-;; Put this file into your load-path and the following line into your
-;; ~/.emacs:
-;;
-;; (require 'org-taskjuggler)
-;;
-;; The interactive functions are similar to those of the HTML and LaTeX
-;; exporters:
-;;
-;; M-x `org-export-as-taskjuggler'
-;; M-x `org-export-as-taskjuggler-and-open'
-;;
-;; * Tasks
-;;
-;; Let's illustrate the usage with a small example. Create your tasks
-;; as you usually do with org-mode. Assign efforts to each task using
-;; properties (it's easiest to do this in the column view). You should
-;; end up with something similar to the example by Peter Jones in
-;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
-;; Now mark the top node of your tasks with a tag named
-;; "taskjuggler_project" (or whatever you customized
-;; `org-export-taskjuggler-project-tag' to). You are now ready to
-;; export the project plan with `org-export-as-taskjuggler-and-open'
-;; which will export the project plan and open a Gantt chart in
-;; TaskJugglerUI.
-;;
-;; * Resources
-;;
-;; Next you can define resources and assign those to work on specific
-;; tasks. You can group your resources hierarchically. Tag the top
-;; node of the resources with "taskjuggler_resource" (or whatever you
-;; customized `org-export-taskjuggler-resource-tag' to). You can
-;; optionally assign an identifier (named "resource_id") to the
-;; resources (using the standard org properties commands) or you can
-;; let the exporter generate identifiers automatically (the exporter
-;; picks the first word of the headline as the identifier as long as
-;; it is unique, see the documentation of
-;; `org-taskjuggler-get-unique-id'). Using that identifier you can
-;; then allocate resources to tasks. This is again done with the
-;; "allocate" property on the tasks. Do this in column view or when on
-;; the task type
-;;
-;; C-c C-x p allocate RET <resource_id> RET
-;;
-;; Once the allocations are done you can again export to TaskJuggler
-;; and check in the Resource Allocation Graph which person is working
-;; on what task at what time.
-;;
-;; * Export of properties
-;;
-;; The exporter also takes TODO state information into consideration,
-;; i.e. if a task is marked as done it will have the corresponding
-;; attribute in TaskJuggler ("complete 100"). Also it will export any
-;; property on a task resource or resource node which is known to
-;; TaskJuggler, such as limits, vacation, shift, booking, efficiency,
-;; journalentry, rate for resources or account, start, note, duration,
-;; end, journalentry, milestone, reference, responsible, scheduling,
-;; etc for tasks.
-;;
-;; * Dependencies
-;;
-;; The exporter will handle dependencies that are defined in the tasks
-;; either with the ORDERED attribute (see TODO dependencies in the Org
-;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
-;; alternatively with a depends attribute. Both the BLOCKER and the
-;; depends attribute can be either "previous-sibling" or a reference
-;; to an identifier (named "task_id") which is defined for another
-;; task in the project. BLOCKER and the depends attribute can define
-;; multiple dependencies separated by either space or comma. You can
-;; also specify optional attributes on the dependency by simply
-;; appending it. The following examples should illustrate this:
-;;
-;; * Training material
-;; :PROPERTIES:
-;; :task_id: training_material
-;; :ORDERED: t
-;; :END:
-;; ** Markup Guidelines
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :END:
-;; ** Workflow Guidelines
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :END:
-;; * Presentation
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :BLOCKER: training_material { gapduration 1d } some_other_task
-;; :END:
-;;
-;;;; * TODO
-;; - Use SCHEDULED and DEADLINE information (not just start and end
-;; properties).
-;; - Look at org-file-properties, org-global-properties and
-;; org-global-properties-fixed
-;; - What about property inheritance and org-property-inherit-p?
-;; - Use TYPE_TODO as an way to assign resources
-;; - Make sure multiple dependency definitions (i.e. BLOCKER on
-;; previous-sibling and on a specific task_id) in multiple
-;; attributes are properly exported.
-;;
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'org)
-(require 'org-exp)
-
-;;; User variables:
-
-(defgroup org-export-taskjuggler nil
- "Options for exporting Org-mode files to TaskJuggler."
- :tag "Org Export TaskJuggler"
- :group 'org-export)
-
-(defcustom org-export-taskjuggler-extension ".tjp"
- "Extension of TaskJuggler files."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-taskjuggler-project-tag "taskjuggler_project"
- "Tag, property or todo used to find the tree containing all
-the tasks for the project."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource"
- "Tag, property or todo used to find the tree containing all the
-resources for the project."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-taskjuggler-target-version 2.4
- "Which version of TaskJuggler the exporter is targeting."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'number)
-
-(defcustom org-export-taskjuggler-default-project-version "1.0"
- "Default version string for the project."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'string)
-
-(defcustom org-export-taskjuggler-default-project-duration 280
- "Default project duration if no start and end date have been defined
-in the root node of the task tree, i.e. the tree that has been marked
-with `org-export-taskjuggler-project-tag'"
- :group 'org-export-taskjuggler
- :version "24.1"
- :type 'integer)
-
-(defcustom org-export-taskjuggler-default-reports
- '("taskreport \"Gantt Chart\" {
- headline \"Project Gantt Chart\"
- columns hierarchindex, name, start, end, effort, duration, completed, chart
- timeformat \"%Y-%m-%d\"
- hideresource 1
- loadunit shortauto
-}"
- "resourcereport \"Resource Graph\" {
- headline \"Resource Allocation Graph\"
- columns no, name, utilization, freeload, chart
- loadunit shortauto
- sorttasks startup
- hidetask ~isleaf()
-}")
- "Default reports for the project."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type '(repeat (string :tag "Report")))
-
-(defcustom org-export-taskjuggler-default-global-properties
- "shift s40 \"Part time shift\" {
- workinghours wed, thu, fri off
-}
-"
- "Default global properties for the project. Here you typically
-define global properties such as shifts, accounts, rates,
-vacation, macros and flags. Any property that is allowed within
-the TaskJuggler file can be inserted. You could for example
-include another TaskJuggler file.
-
-The global properties are inserted after the project declaration
-but before any resource and task declarations."
- :group 'org-export-taskjuggler
- :version "24.1"
- :type '(string :tag "Preamble"))
-
-;;; Hooks
-
-(defvar org-export-taskjuggler-final-hook nil
- "Hook run at the end of TaskJuggler export, in the new buffer.")
-
-;;; Autoload functions:
-
-;; avoid compiler warning about free variable
-(defvar org-export-taskjuggler-old-level)
-
-;;;###autoload
-(defun org-export-as-taskjuggler ()
- "Export parts of the current buffer as a TaskJuggler file.
-The exporter looks for a tree with tag, property or todo that
-matches `org-export-taskjuggler-project-tag' and takes this as
-the tasks for this project. The first node of this tree defines
-the project properties such as project name and project period.
-If there is a tree with tag, property or todo that matches
-`org-export-taskjuggler-resource-tag' this three is taken as
-resources for the project. If no resources are specified, a
-default resource is created and allocated to the project. Also
-the taskjuggler project will be created with default reports as
-defined in `org-export-taskjuggler-default-reports'."
- (interactive)
-
- (message "Exporting...")
- (setq-default org-done-keywords org-done-keywords)
- (let* ((tasks
- (org-taskjuggler-resolve-dependencies
- (org-taskjuggler-assign-task-ids
- (org-taskjuggler-compute-task-leafiness
- (org-map-entries
- 'org-taskjuggler-components
- org-export-taskjuggler-project-tag nil 'archive 'comment)))))
- (resources
- (org-taskjuggler-assign-resource-ids
- (org-map-entries
- 'org-taskjuggler-components
- org-export-taskjuggler-resource-tag nil 'archive 'comment)))
- (filename (expand-file-name
- (concat
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- org-export-taskjuggler-extension)))
- (buffer (find-file-noselect filename))
- (old-buffer (current-buffer))
- (org-export-taskjuggler-old-level 0)
- task resource)
- (unless tasks
- (error "No tasks specified"))
- ;; add a default resource
- (unless resources
- (setq resources
- `((("resource_id" . ,(user-login-name))
- ("headline" . ,user-full-name)
- ("level" . 1)))))
- ;; add a default allocation to the first task if none was given
- (unless (assoc "allocate" (car tasks))
- (let ((task (car tasks))
- (resource-id (cdr (assoc "resource_id" (car resources)))))
- (setcar tasks (push (cons "allocate" resource-id) task))))
- ;; add a default start date to the first task if none was given
- (unless (assoc "start" (car tasks))
- (let ((task (car tasks))
- (time-string (format-time-string "%Y-%m-%d")))
- (setcar tasks (push (cons "start" time-string) task))))
- ;; add a default version if none was given
- (unless (assoc "version" (car tasks))
- (let ((task (car tasks))
- (version org-export-taskjuggler-default-project-version))
- (setcar tasks (push (cons "version" version) task))))
- (with-current-buffer buffer
- (erase-buffer)
- (org-clone-local-variables old-buffer "^org-")
- (org-taskjuggler-open-project (car tasks))
- (insert org-export-taskjuggler-default-global-properties)
- (insert "\n")
- (dolist (resource resources)
- (let ((level (cdr (assoc "level" resource))))
- (org-taskjuggler-close-maybe level)
- (org-taskjuggler-open-resource resource)
- (setq org-export-taskjuggler-old-level level)))
- (org-taskjuggler-close-maybe 1)
- (setq org-export-taskjuggler-old-level 0)
- (dolist (task tasks)
- (let ((level (cdr (assoc "level" task))))
- (org-taskjuggler-close-maybe level)
- (org-taskjuggler-open-task task)
- (setq org-export-taskjuggler-old-level level)))
- (org-taskjuggler-close-maybe 1)
- (org-taskjuggler-insert-reports)
- (save-buffer)
- (or (org-export-push-to-kill-ring "TaskJuggler")
- (message "Exporting... done"))
- (current-buffer))))
-
-;;;###autoload
-(defun org-export-as-taskjuggler-and-open ()
- "Export the current buffer as a TaskJuggler file and open it
-with the TaskJuggler GUI."
- (interactive)
- (let* ((file-name (buffer-file-name (org-export-as-taskjuggler)))
- (process-name "TaskJugglerUI")
- (command (concat process-name " " file-name)))
- (start-process-shell-command process-name nil command)))
-
-(defun org-taskjuggler-targeting-tj3-p ()
- "Return true if we are targeting TaskJuggler III."
- (>= org-export-taskjuggler-target-version 3.0))
-
-(defun org-taskjuggler-parent-is-ordered-p ()
- "Return true if the parent of the current node has a property
-\"ORDERED\". Return nil otherwise."
- (save-excursion
- (and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
-
-(defun org-taskjuggler-components ()
- "Return an alist containing all the pertinent information for
-the current node such as the headline, the level, todo state
-information, all the properties, etc."
- (let* ((props (org-entry-properties))
- (components (org-heading-components))
- (level (nth 1 components))
- (headline
- (replace-regexp-in-string
- "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines
- (parent-ordered (org-taskjuggler-parent-is-ordered-p)))
- (push (cons "level" level) props)
- (push (cons "headline" headline) props)
- (push (cons "parent-ordered" parent-ordered) props)))
-
-(defun org-taskjuggler-assign-task-ids (tasks)
- "Given a list of tasks return the same list assigning a unique id
-and the full path to each task. Taskjuggler takes hierarchical ids.
-For that reason we have to make ids locally unique and we have to keep
-a path to the current task."
- (let ((previous-level 0)
- unique-ids unique-id
- path
- task resolved-tasks tmp)
- (dolist (task tasks resolved-tasks)
- (let ((level (cdr (assoc "level" task))))
- (cond
- ((< previous-level level)
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (dotimes (tmp (- level previous-level))
- (push (list unique-id) unique-ids)
- (push unique-id path)))
- ((= previous-level level)
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (push unique-id (car unique-ids))
- (setcar path unique-id))
- ((> previous-level level)
- (dotimes (tmp (- previous-level level))
- (pop unique-ids)
- (pop path))
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (push unique-id (car unique-ids))
- (setcar path unique-id)))
- (push (cons "unique-id" unique-id) task)
- (push (cons "path" (mapconcat 'identity (reverse path) ".")) task)
- (setq previous-level level)
- (setq resolved-tasks (append resolved-tasks (list task)))))))
-
-(defun org-taskjuggler-compute-task-leafiness (tasks)
- "Figure out if each task is a leaf by looking at it's level,
-and the level of its successor. If the successor is higher (ie
-deeper), then it's not a leaf."
- (let (new-list)
- (while (car tasks)
- (let ((task (car tasks))
- (successor (car (cdr tasks))))
- (cond
- ;; if a task has no successors it is a leaf
- ((null successor)
- (push (cons (cons "leaf-node" t) task) new-list))
- ;; if the successor has a lower level than task it is a leaf
- ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task)))
- (push (cons (cons "leaf-node" t) task) new-list))
- ;; otherwise examine the rest of the tasks
- (t (push task new-list))))
- (setq tasks (cdr tasks)))
- (nreverse new-list)))
-
-(defun org-taskjuggler-assign-resource-ids (resources)
- "Given a list of resources return the same list, assigning a
-unique id to each resource."
- (let (unique-ids new-list)
- (dolist (resource resources new-list)
- (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
- (push (cons "unique-id" unique-id) resource)
- (push unique-id unique-ids)
- (push resource new-list)))
- (nreverse new-list)))
-
-(defun org-taskjuggler-resolve-dependencies (tasks)
- (let ((previous-level 0)
- siblings
- task resolved-tasks)
- (dolist (task tasks resolved-tasks)
- (let* ((level (cdr (assoc "level" task)))
- (depends (cdr (assoc "depends" task)))
- (parent-ordered (cdr (assoc "parent-ordered" task)))
- (blocker (cdr (assoc "BLOCKER" task)))
- (blocked-on-previous
- (and blocker (string-match "previous-sibling" blocker)))
- (dependencies
- (org-taskjuggler-resolve-explicit-dependencies
- (append
- (and depends (org-taskjuggler-tokenize-dependencies depends))
- (and blocker (org-taskjuggler-tokenize-dependencies blocker)))
- tasks))
- previous-sibling)
- ; update previous sibling info
- (cond
- ((< previous-level level)
- (dotimes (tmp (- level previous-level))
- (push task siblings)))
- ((= previous-level level)
- (setq previous-sibling (car siblings))
- (setcar siblings task))
- ((> previous-level level)
- (dotimes (tmp (- previous-level level))
- (pop siblings))
- (setq previous-sibling (car siblings))
- (setcar siblings task)))
- ; insert a dependency on previous sibling if the parent is
- ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
- (when (or (and previous-sibling parent-ordered) blocked-on-previous)
- (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
- ; store dependency information
- (when dependencies
- (push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
- (setq previous-level level)
- (setq resolved-tasks (append resolved-tasks (list task)))))))
-
-(defun org-taskjuggler-tokenize-dependencies (dependencies)
- "Split a dependency property value DEPENDENCIES into the
-individual dependencies and return them as a list while keeping
-the optional arguments (such as gapduration) for the
-dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
- (cond
- ((string-match "^ *$" dependencies) nil)
- ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
- (cons
- (substring dependencies (match-beginning 1) (match-end 1))
- (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0)))))
- (t (error (format "invalid dependency id %s" dependencies)))))
-
-(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks)
- "For each dependency in DEPENDENCIES try to find a
-corresponding task with a matching property \"task_id\" in TASKS.
-Return a list containing the resolved links for all DEPENDENCIES
-where a matching tasks was found. If the dependency is
-\"previous-sibling\" it is ignored (as this is dealt with in
-`org-taskjuggler-resolve-dependencies'). If there is no matching
-task the dependency is ignored and a warning is displayed ."
- (unless (null dependencies)
- (let*
- ;; the dependency might have optional attributes such as "{
- ;; gapduration 5d }", so only use the first string as id for the
- ;; dependency
- ((dependency (car dependencies))
- (id (car (split-string dependency)))
- (optional-attributes
- (mapconcat 'identity (cdr (split-string dependency)) " "))
- (path (org-taskjuggler-find-task-with-id id tasks)))
- (cond
- ;; ignore previous sibling dependencies
- ((equal (car dependencies) "previous-sibling")
- (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))
- ;; if the id is found in another task use its path
- ((not (null path))
- (cons (mapconcat 'identity (list path optional-attributes) " ")
- (org-taskjuggler-resolve-explicit-dependencies
- (cdr dependencies) tasks)))
- ;; warn about dangling dependency but otherwise ignore it
- (t (display-warning
- 'org-export-taskjuggler
- (format "No task with matching property \"task_id\" found for id %s" id))
- (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
-
-(defun org-taskjuggler-find-task-with-id (id tasks)
- "Find ID in tasks. If found return the path of task. Otherwise
-return nil."
- (let ((task-id (cdr (assoc "task_id" (car tasks))))
- (path (cdr (assoc "path" (car tasks)))))
- (cond
- ((null tasks) nil)
- ((equal task-id id) path)
- (t (org-taskjuggler-find-task-with-id id (cdr tasks))))))
-
-(defun org-taskjuggler-get-unique-id (item unique-ids)
- "Return a unique id for an ITEM which can be a task or a resource.
-The id is derived from the headline and made unique against
-UNIQUE-IDS. If the (downcased) first token of the headline is not
-unique try to add more (downcased) tokens of the headline or
-finally add more underscore characters (\"_\")."
- (let* ((headline (cdr (assoc "headline" item)))
- (parts (split-string headline))
- (id (org-taskjuggler-clean-id (downcase (pop parts)))))
- ; try to add more parts of the headline to make it unique
- (while (and (member id unique-ids) (car parts))
- (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
- ; if its still not unique add "_"
- (while (member id unique-ids)
- (setq id (concat id "_")))
- id))
-
-(defun org-taskjuggler-clean-id (id)
- "Clean and return ID to make it acceptable for taskjuggler."
- (and id
- ;; replace non-ascii by _
- (replace-regexp-in-string
- "[^a-zA-Z0-9_]" "_"
- ;; make sure id doesn't start with a number
- (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))))
-
-(defun org-taskjuggler-open-project (project)
- "Insert the beginning of a project declaration. All valid
-attributes from the PROJECT alist are inserted. If no end date is
-specified it is calculated
-`org-export-taskjuggler-default-project-duration' days from now."
- (let* ((unique-id (cdr (assoc "unique-id" project)))
- (headline (cdr (assoc "headline" project)))
- (version (cdr (assoc "version" project)))
- (start (cdr (assoc "start" project)))
- (end (cdr (assoc "end" project))))
- (insert
- (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n"
- unique-id headline version start
- org-export-taskjuggler-default-project-duration))))
-
-(defun org-taskjuggler-filter-and-join (items)
- "Filter all nil elements from ITEMS and join the remaining ones
-with separator \"\n\"."
- (let ((filtered-items (remq nil items)))
- (and filtered-items (mapconcat 'identity filtered-items "\n"))))
-
-(defun org-taskjuggler-get-attributes (item attributes)
- "Return all attribute as a single formatted string. ITEM is an
-alist representing either a resource or a task. ATTRIBUTES is a
-list of symbols. Only entries from ITEM are considered that are
-listed in ATTRIBUTES."
- (org-taskjuggler-filter-and-join
- (mapcar
- (lambda (attribute)
- (org-taskjuggler-filter-and-join
- (org-taskjuggler-get-attribute item attribute)))
- attributes)))
-
-(defun org-taskjuggler-get-attribute (item attribute)
- "Return a list of strings containing the properly formatted
-taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist).
-If the ATTRIBUTE is not in ITEM return nil."
- (cond
- ((null item) nil)
- ((equal (symbol-name attribute) (car (car item)))
- (cons (format "%s %s" (symbol-name attribute) (cdr (car item)))
- (org-taskjuggler-get-attribute (cdr item) attribute)))
- (t (org-taskjuggler-get-attribute (cdr item) attribute))))
-
-(defun org-taskjuggler-open-resource (resource)
- "Insert the beginning of a resource declaration. All valid
-attributes from the RESOURCE alist are inserted. If the RESOURCE
-defines a property \"resource_id\" it will be used as the id for
-this resource. Otherwise it will use the ID property. If neither
-is defined it will calculate a unique id for the resource using
-`org-taskjuggler-get-unique-id'."
- (let ((id (org-taskjuggler-clean-id
- (or (cdr (assoc "resource_id" resource))
- (cdr (assoc "ID" resource))
- (cdr (assoc "unique-id" resource)))))
- (headline (cdr (assoc "headline" resource)))
- (attributes '(limits vacation shift booking efficiency journalentry rate)))
- (insert
- (concat
- "resource " id " \"" headline "\" {\n "
- (org-taskjuggler-get-attributes resource attributes) "\n"))))
-
-(defun org-taskjuggler-clean-effort (effort)
- "Translate effort strings into a format acceptable to taskjuggler,
-i.e. REAL UNIT. A valid effort string can be anything that is
-accepted by `org-duration-string-to-minutes´."
- (cond
- ((null effort) effort)
- (t (let* ((minutes (org-duration-string-to-minutes effort))
- (hours (/ minutes 60.0)))
- (format "%.1fh" hours)))))
-
-(defun org-taskjuggler-get-priority (priority)
- "Return a priority between 1 and 1000 based on PRIORITY, an
-org-mode priority string."
- (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority)))
- (- org-lowest-priority org-highest-priority))))
-
-(defun org-taskjuggler-open-task (task)
- (let* ((unique-id (cdr (assoc "unique-id" task)))
- (headline (cdr (assoc "headline" task)))
- (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
- (depends (cdr (assoc "depends" task)))
- (allocate (cdr (assoc "allocate" task)))
- (priority-raw (cdr (assoc "PRIORITY" task)))
- (priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
- (state (cdr (assoc "TODO" task)))
- (complete (or (and (member state org-done-keywords) "100")
- (cdr (assoc "complete" task))))
- (parent-ordered (cdr (assoc "parent-ordered" task)))
- (previous-sibling (cdr (assoc "previous-sibling" task)))
- (milestone (or (cdr (assoc "milestone" task))
- (and (assoc "leaf-node" task)
- (not (or effort
- (cdr (assoc "duration" task))
- (cdr (assoc "end" task))
- (cdr (assoc "period" task)))))))
- (attributes
- '(account start note duration endbuffer endcredit end
- flags journalentry length maxend maxstart minend
- minstart period reference responsible scheduling
- startbuffer startcredit statusnote)))
- (insert
- (concat
- "task " unique-id " \"" headline "\" {\n"
- (if (and parent-ordered previous-sibling)
- (format " depends %s\n" previous-sibling)
- (and depends (format " depends %s\n" depends)))
- (and allocate (format " purge %s\n allocate %s\n"
- (or (and (org-taskjuggler-targeting-tj3-p) "allocate")
- "allocations")
- allocate))
- (and complete (format " complete %s\n" complete))
- (and effort (format " effort %s\n" effort))
- (and priority (format " priority %s\n" priority))
- (and milestone (format " milestone\n"))
-
- (org-taskjuggler-get-attributes task attributes)
- "\n"))))
-
-(defun org-taskjuggler-close-maybe (level)
- (while (> org-export-taskjuggler-old-level level)
- (insert "}\n")
- (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level)))
- (when (= org-export-taskjuggler-old-level level)
- (insert "}\n")))
-
-(defun org-taskjuggler-insert-reports ()
- (let (report)
- (dolist (report org-export-taskjuggler-default-reports)
- (insert report "\n"))))
-
-(provide 'org-taskjuggler)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-taskjuggler.el ends here
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index 2351c4c1989..55717ab7b03 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -1,6 +1,6 @@
;;; org-timer.el --- The relative timer code for Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -156,12 +156,14 @@ With prefix arg STOP, stop it entirely."
(org-timer-set-mode-line 'pause)
(message "Timer paused at %s" (org-timer-value-string)))))
+(defvar org-timer-current-timer nil)
(defun org-timer-stop ()
"Stop the relative timer."
(interactive)
(run-hooks 'org-timer-stop-hook)
(setq org-timer-start-time nil
- org-timer-pause-time nil)
+ org-timer-pause-time nil
+ org-timer-current-timer nil)
(org-timer-set-mode-line 'off)
(message "Timer stopped"))
@@ -184,14 +186,17 @@ it in the buffer."
(insert (org-timer-value-string))))
(defun org-timer-value-string ()
- (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds)))))
+ "Set the timer string."
+ (format org-timer-format
+ (org-timer-secs-to-hms
+ (abs (floor (org-timer-seconds))))))
(defvar org-timer-timer-is-countdown nil)
(defun org-timer-seconds ()
(if org-timer-timer-is-countdown
(- (org-float-time org-timer-start-time)
- (org-float-time (current-time)))
- (- (org-float-time (or org-timer-pause-time (current-time)))
+ (org-float-time))
+ (- (org-float-time org-timer-pause-time)
(org-float-time org-timer-start-time))))
;;;###autoload
@@ -344,7 +349,6 @@ VALUE can be `on', `off', or `pause'."
(concat " <" (substring (org-timer-value-string) 0 -1) ">"))
(force-mode-line-update)))
-(defvar org-timer-current-timer nil)
(defun org-timer-cancel-timer ()
"Cancel the current timer."
(interactive)
@@ -370,6 +374,8 @@ VALUE can be `on', `off', or `pause'."
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
+(defvar org-clock-sound)
+
;;;###autoload
(defun org-timer-set-timer (&optional opt)
"Prompt for a duration and set a timer.
@@ -429,7 +435,7 @@ replace any running timer."
(run-with-timer
secs nil `(lambda ()
(setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) t)
+ (org-notify ,(format "%s: time out" hl) ,org-clock-sound)
(setq org-timer-timer-is-countdown nil)
(org-timer-set-mode-line 'off)
(run-hooks 'org-timer-done-hook))))
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 4fa865308e9..aae65cc6d37 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,17 +5,14 @@
(defun org-release ()
"The release version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-release "7.9.3f"))
+ (let ((org-release "8.2.10"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-git-version "release_7.9.3f-17-g7524ef"))
+ (let ((org-git-version "release_8.2.10"))
org-git-version))
-;;;###autoload
-(defvar org-odt-data-dir "/usr/share/emacs/etc/org"
- "The location of ODT styles.")
(provide 'org-version)
diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el
deleted file mode 100644
index fc2a34b8fe5..00000000000
--- a/lisp/org/org-vm.el
+++ /dev/null
@@ -1,180 +0,0 @@
-;;; org-vm.el --- Support for links to VM messages from within Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;;
-;; Support for IMAP folders added
-;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
-;; Requires VM 8.2.0a or later.
-;;
-;; 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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;; This file implements links to VM messages and folders from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'org)
-
-;; Declare external functions and variables
-(declare-function vm-preview-current-message "ext:vm-page" ())
-(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
-(declare-function vm-get-header-contents "ext:vm-summary"
- (message header-name-regexp &optional clump-sep))
-(declare-function vm-isearch-narrow "ext:vm-search" ())
-(declare-function vm-isearch-update "ext:vm-search" ())
-(declare-function vm-select-folder-buffer "ext:vm-macro" ())
-(declare-function vm-su-message-id "ext:vm-summary" (m))
-(declare-function vm-su-subject "ext:vm-summary" (m))
-(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
-(declare-function vm-imap-folder-p "ext:vm-save" ())
-(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
-(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
-(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
-(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
-(defvar vm-message-pointer)
-(defvar vm-folder-directory)
-
-;; Install the link type
-(org-add-link-type "vm" 'org-vm-open)
-(org-add-link-type "vm-imap" 'org-vm-imap-open)
-(add-hook 'org-store-link-functions 'org-vm-store-link)
-
-;; Implementation
-(defun org-vm-store-link ()
- "Store a link to a VM folder or message."
- (when (and (or (eq major-mode 'vm-summary-mode)
- (eq major-mode 'vm-presentation-mode))
- (save-window-excursion
- (vm-select-folder-buffer) buffer-file-name))
- (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
- (vm-follow-summary-cursor)
- (save-excursion
- (vm-select-folder-buffer)
- (let* ((message (car vm-message-pointer))
- (subject (vm-su-subject message))
- (to (vm-get-header-contents message "To"))
- (from (vm-get-header-contents message "From"))
- (message-id (vm-su-message-id message))
- (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
- (date (vm-get-header-contents message "Date"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
- folder desc link)
- (if (vm-imap-folder-p)
- (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
- (setq folder (vm-imap-folder-for-spec spec)))
- (progn
- (setq folder (abbreviate-file-name buffer-file-name))
- (if (and vm-folder-directory
- (string-match (concat "^" (regexp-quote vm-folder-directory))
- folder))
- (setq folder (replace-match "" t t folder)))))
- (setq message-id (org-remove-angle-brackets message-id))
- (org-store-link-props :type link-type :from from :to to :subject subject
- :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (setq desc (org-email-link-description))
- (setq link (concat (concat link-type ":") folder "#" message-id))
- (org-add-link-props :link link :description desc)
- link))))
-
-(defun org-vm-open (path)
- "Follow a VM message link specified by PATH."
- (let (folder article)
- (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
- (error "Error in VM link"))
- (setq folder (match-string 1 path)
- article (match-string 3 path))
- ;; The prefix argument will be interpreted as read-only
- (org-vm-follow-link folder article current-prefix-arg)))
-
-(defun org-vm-follow-link (&optional folder article readonly)
- "Follow a VM link to FOLDER and ARTICLE."
- (require 'vm)
- (setq article (org-add-angle-brackets article))
- (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
- ;; ange-ftp or efs or tramp access
- (let ((user (or (match-string 1 folder) (user-login-name)))
- (host (match-string 2 folder))
- (file (match-string 3 folder)))
- (cond
- ((featurep 'tramp)
- ;; use tramp to access the file
- (if (featurep 'xemacs)
- (setq folder (format "[%s@%s]%s" user host file))
- (setq folder (format "/%s@%s:%s" user host file))))
- (t
- ;; use ange-ftp or efs
- (require (if (featurep 'xemacs) 'efs 'ange-ftp))
- (setq folder (format "/%s@%s:%s" user host file))))))
- (when folder
- (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
- (when article
- (org-vm-select-message (org-add-angle-brackets article)))))
-
-(defun org-vm-imap-open (path)
- "Follow a VM link to an IMAP folder."
- (require 'vm-imap)
- (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
- (let* ((account-name (match-string 1 path))
- (mailbox-name (match-string 2 path))
- (message-id (match-string 3 path))
- (account-spec (vm-imap-parse-spec-to-list
- (vm-imap-spec-for-account account-name)))
- (mailbox-spec (mapconcat 'identity
- (append (butlast account-spec 4)
- (cons mailbox-name
- (last account-spec 3)))
- ":")))
- (funcall (cdr (assq 'vm-imap org-link-frame-setup))
- mailbox-spec)
- (when message-id
- (org-vm-select-message (org-add-angle-brackets message-id))))))
-
-(defun org-vm-select-message (message-id)
- "Go to the message with message-id in the current folder."
- (require 'vm-search)
- (sit-for 0.1)
- (vm-select-folder-buffer)
- (widen)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (not (re-search-forward
- (concat "^" "message-id: *" (regexp-quote message-id))))
- (error "Could not find the specified message in this folder"))
- (vm-isearch-update)
- (vm-isearch-narrow)
- (vm-preview-current-message)
- (vm-summarize)))
-
-(provide 'org-vm)
-
-
-
-;;; org-vm.el ends here
diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el
index e1cc99627ea..24693de8927 100644
--- a/lisp/org/org-w3m.el
+++ b/lisp/org/org-w3m.el
@@ -1,6 +1,6 @@
;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Andy Stewart <lazycat dot manatee at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -8,12 +8,12 @@
;;
;; This file is part of GNU Emacs.
;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
+;; 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.
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; 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.
@@ -43,6 +43,19 @@
(require 'org)
+(defvar w3m-current-url)
+(defvar w3m-current-title)
+
+(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(defun org-w3m-store-link ()
+ "Store a link to a w3m buffer."
+ (when (eq major-mode 'w3m-mode)
+ (org-store-link-props
+ :type "w3m"
+ :link w3m-current-url
+ :url (url-view-url t)
+ :description (or w3m-current-title w3m-current-url))))
+
(defun org-w3m-copy-for-org-mode ()
"Copy current buffer content or active region with `org-mode' style links.
This will encode `link-title' and `link-location' with
diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el
deleted file mode 100644
index b755c023e78..00000000000
--- a/lisp/org/org-wl.el
+++ /dev/null
@@ -1,316 +0,0 @@
-;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
-;; David Maus <dmaus at ictsoc dot de>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements links to Wanderlust messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'org)
-
-(defgroup org-wl nil
- "Options concerning the Wanderlust link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-wl-link-to-refile-destination t
- "Create a link to the refile destination if the message is marked as refile."
- :group 'org-wl
- :type 'boolean)
-
-(defcustom org-wl-link-remove-filter nil
- "Remove filter condition if message is filter folder."
- :group 'org-wl
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-wl-shimbun-prefer-web-links nil
- "If non-nil create web links for shimbun messages."
- :group 'org-wl
- :version "24.1"
- :type 'boolean)
-
-(defcustom org-wl-nntp-prefer-web-links nil
- "If non-nil create web links for nntp messages.
-When folder name contains string \"gmane\" link to gmane,
-googlegroups otherwise."
- :type 'boolean
- :version "24.1"
- :group 'org-wl)
-
-(defcustom org-wl-disable-folder-check t
- "Disable check for new messages when open a link."
- :type 'boolean
- :version "24.1"
- :group 'org-wl)
-
-(defcustom org-wl-namazu-default-index nil
- "Default namazu search index."
- :type 'directory
- :version "24.1"
- :group 'org-wl)
-
-;; Declare external functions and variables
-(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
-(declare-function elmo-message-entity-field "ext:elmo-msgdb"
- (entity field &optional type))
-(declare-function elmo-message-field "ext:elmo"
- (folder number field &optional type) t)
-(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t)
-;; Backward compatibility to old version of wl
-(declare-function wl "ext:wl" () t)
-(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
-(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
- (&optional id))
-(declare-function wl-summary-jump-to-msg "ext:wl-summary"
- (&optional number beg end))
-(declare-function wl-summary-line-from "ext:wl-summary" ())
-(declare-function wl-summary-line-subject "ext:wl-summary" ())
-(declare-function wl-summary-message-number "ext:wl-summary" ())
-(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
-(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
-(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
- (&optional folder sticky))
-(declare-function wl-folder-get-petname "ext:wl-folder" (name))
-(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
- (&optional getid))
-(declare-function wl-folder-buffer-group-p "ext:wl-folder")
-(defvar wl-init)
-(defvar wl-summary-buffer-elmo-folder)
-(defvar wl-summary-buffer-folder-name)
-(defvar wl-folder-group-regexp)
-(defvar wl-auto-check-folder-name)
-(defvar elmo-nntp-default-server)
-
-(defconst org-wl-folder-types
- '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool)
- ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search)
- ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal))
- "List of folder indicators. See Wanderlust manual, section 3.")
-
-;; Install the link type
-(org-add-link-type "wl" 'org-wl-open)
-(add-hook 'org-store-link-functions 'org-wl-store-link)
-
-;; Implementation
-
-(defun org-wl-folder-type (folder)
- "Return symbol that indicates the type of FOLDER.
-FOLDER is the wanderlust folder name. The first character of the
-folder name determines the folder type."
- (let* ((indicator (substring folder 0 1))
- (type (cdr (assoc indicator org-wl-folder-types))))
- ;; maybe access or file folder
- (when (not type)
- (setq type
- (cond
- ((and (>= (length folder) 5)
- (string= (substring folder 0 5) "file:"))
- 'file)
- ((and (>= (length folder) 7)
- (string= (substring folder 0 7) "access:"))
- 'access)
- (t
- nil))))
- type))
-
-(defun org-wl-message-field (field entity)
- "Return content of FIELD in ENTITY.
-FIELD is a symbol of a rfc822 message header field.
-ENTITY is a message entity."
- (let ((content (elmo-message-entity-field entity field 'string)))
- (if (listp content) (car content) content)))
-
-(defun org-wl-store-link ()
- "Store a link to a WL message or folder."
- (unless (eobp)
- (cond
- ((memq major-mode '(wl-summary-mode mime-view-mode))
- (org-wl-store-link-message))
- ((eq major-mode 'wl-folder-mode)
- (org-wl-store-link-folder))
- (t
- nil))))
-
-(defun org-wl-store-link-folder ()
- "Store a link to a WL folder."
- (let* ((folder (wl-folder-get-entity-from-buffer))
- (petname (wl-folder-get-petname folder))
- (link (concat "wl:" folder)))
- (save-excursion
- (beginning-of-line)
- (unless (and (wl-folder-buffer-group-p)
- (looking-at wl-folder-group-regexp))
- (org-store-link-props :type "wl" :description petname
- :link link)
- link))))
-
-(defun org-wl-store-link-message ()
- "Store a link to a WL message."
- (save-excursion
- (let ((buf (if (eq major-mode 'wl-summary-mode)
- (current-buffer)
- (and (boundp 'wl-message-buffer-cur-summary-buffer)
- wl-message-buffer-cur-summary-buffer))))
- (when buf
- (with-current-buffer buf
- (let* ((msgnum (wl-summary-message-number))
- (mark-info (wl-summary-registered-temp-mark msgnum))
- (folder-name
- (if (and org-wl-link-to-refile-destination
- mark-info
- (equal (nth 1 mark-info) "o")) ; marked as refile
- (nth 2 mark-info)
- wl-summary-buffer-folder-name))
- (folder-type (org-wl-folder-type folder-name))
- (wl-message-entity
- (if (fboundp 'elmo-message-entity)
- (elmo-message-entity
- wl-summary-buffer-elmo-folder msgnum)
- (elmo-msgdb-overview-get-entity
- msgnum (wl-summary-buffer-msgdb))))
- (message-id
- (org-wl-message-field 'message-id wl-message-entity))
- (message-id-no-brackets
- (org-remove-angle-brackets message-id))
- (from (org-wl-message-field 'from wl-message-entity))
- (to (org-wl-message-field 'to wl-message-entity))
- (xref (org-wl-message-field 'xref wl-message-entity))
- (subject (org-wl-message-field 'subject wl-message-entity))
- (date (org-wl-message-field 'date wl-message-entity))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
- desc link)
-
- ;; remove text properties of subject string to avoid possible bug
- ;; when formatting the subject
- ;; (Emacs bug #5306, fixed)
- (set-text-properties 0 (length subject) nil subject)
-
- ;; maybe remove filter condition
- (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
- (while (eq (org-wl-folder-type folder-name) 'filter)
- (setq folder-name
- (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
-
- ;; maybe create http link
- (cond
- ((and (eq folder-type 'shimbun)
- org-wl-shimbun-prefer-web-links xref)
- (org-store-link-props :type "http" :link xref :description subject
- :from from :to to :message-id message-id
- :message-id-no-brackets message-id-no-brackets
- :subject subject))
- ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
- (setq link
- (format
- (if (string-match "gmane\\." folder-name)
- "http://mid.gmane.org/%s"
- "http://groups.google.com/groups/search?as_umsgid=%s")
- (org-fixup-message-id-for-http message-id)))
- (org-store-link-props :type "http" :link link :description subject
- :from from :to to :message-id message-id
- :message-id-no-brackets message-id-no-brackets
- :subject subject))
- (t
- (org-store-link-props :type "wl" :from from :to to
- :subject subject :message-id message-id
- :message-id-no-brackets message-id-no-brackets)
- (setq desc (org-email-link-description))
- (setq link (concat "wl:" folder-name "#" message-id-no-brackets))
- (org-add-link-props :link link :description desc)))
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (or link xref)))))))
-
-(defun org-wl-open-nntp (path)
- "Follow the nntp: link specified by PATH."
- (let* ((spec (split-string path "/"))
- (server (split-string (nth 2 spec) "@"))
- (group (nth 3 spec))
- (article (nth 4 spec)))
- (org-wl-open
- (concat "-" group ":" (if (cdr server)
- (car (split-string (car server) ":"))
- "")
- (if (string= elmo-nntp-default-server (nth 2 spec))
- ""
- (concat "@" (or (cdr server) (car server))))
- (if article (concat "#" article) "")))))
-
-(defun org-wl-open (path)
- "Follow the WL message link specified by PATH.
-When called with one prefix, open message in namazu search folder
-with `org-wl-namazu-default-index' as search index. When called
-with two prefixes or `org-wl-namazu-default-index' is nil, ask
-for namazu index."
- (require 'wl)
- (let ((wl-auto-check-folder-name
- (if org-wl-disable-folder-check
- 'none
- wl-auto-check-folder-name)))
- (unless wl-init (wl))
- ;; XXX: The imap-uw's MH folder names start with "%#".
- (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path))
- (error "Error in Wanderlust link"))
- (let ((folder (match-string 1 path))
- (article (match-string 3 path)))
- ;; maybe open message in namazu search folder
- (when current-prefix-arg
- (setq folder (concat "[" article "]"
- (if (and (equal current-prefix-arg '(4))
- org-wl-namazu-default-index)
- org-wl-namazu-default-index
- (read-directory-name "Namazu index: ")))))
- (if (not (elmo-folder-exists-p (org-no-warnings
- (wl-folder-get-elmo-folder folder))))
- (error "No such folder: %s" folder))
- (let ((old-buf (current-buffer))
- (old-point (point-marker)))
- (wl-folder-goto-folder-subr folder)
- (with-current-buffer old-buf
- ;; XXX: `wl-folder-goto-folder-subr' moves point to the
- ;; beginning of the current line. So, restore the point
- ;; in the old buffer.
- (goto-char old-point))
- (when article
- (if (org-string-match-p "@" article)
- (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
- article))
- (or (wl-summary-jump-to-msg (string-to-number article))
- (error "No such message: %s" article)))
- (wl-summary-redisplay))))))
-
-(provide 'org-wl)
-
-;;; org-wl.el ends here
diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el
deleted file mode 100644
index 1083fe16c53..00000000000
--- a/lisp/org/org-xoxo.el
+++ /dev/null
@@ -1,129 +0,0 @@
-;;; org-xoxo.el --- XOXO export for Org-mode
-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;; XOXO export
-
-;;; Code:
-
-(require 'org-exp)
-
-(defvar org-export-xoxo-final-hook nil
- "Hook run after XOXO export, in the new buffer.")
-
-(defun org-export-as-xoxo-insert-into (buffer &rest output)
- (with-current-buffer buffer
- (apply 'insert output)))
-(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
-
-;;;###autoload
-(defun org-export-as-xoxo (&optional buffer)
- "Export the org buffer as XOXO.
-The XOXO buffer is named *xoxo-<source buffer name>*"
- (interactive (list (current-buffer)))
- (run-hooks 'org-export-first-hook)
- ;; A quickie abstraction
-
- ;; Output everything as XOXO
- (with-current-buffer (get-buffer buffer)
- (let* ((pos (point))
- (opt-plist (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist)))
- (filename (concat (file-name-as-directory
- (org-export-directory :xoxo opt-plist))
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- ".html"))
- (out (find-file-noselect filename))
- (last-level 1)
- (hanging-li nil))
- (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed.
- ;; Check the output buffer is empty.
- (with-current-buffer out (erase-buffer))
- ;; Kick off the output
- (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n")
- (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't)
- (let* ((hd (match-string-no-properties 1))
- (level (length hd))
- (text (concat
- (match-string-no-properties 2)
- (save-excursion
- (goto-char (match-end 0))
- (let ((str ""))
- (catch 'loop
- (while 't
- (forward-line)
- (if (looking-at "^[ \t]\\(.*\\)")
- (setq str (concat str (match-string-no-properties 1)))
- (throw 'loop str)))))))))
-
- ;; Handle level rendering
- (cond
- ((> level last-level)
- (org-export-as-xoxo-insert-into out "\n<ol>\n"))
-
- ((< level last-level)
- (dotimes (- (- last-level level) 1)
- (if hanging-li
- (org-export-as-xoxo-insert-into out "</li>\n"))
- (org-export-as-xoxo-insert-into out "</ol>\n"))
- (when hanging-li
- (org-export-as-xoxo-insert-into out "</li>\n")
- (setq hanging-li nil)))
-
- ((equal level last-level)
- (if hanging-li
- (org-export-as-xoxo-insert-into out "</li>\n")))
- )
-
- (setq last-level level)
-
- ;; And output the new li
- (setq hanging-li 't)
- (if (equal ?+ (elt text 0))
- (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>")
- (org-export-as-xoxo-insert-into out "<li>" text))))
-
- ;; Finally finish off the ol
- (dotimes (- last-level 1)
- (if hanging-li
- (org-export-as-xoxo-insert-into out "</li>\n"))
- (org-export-as-xoxo-insert-into out "</ol>\n"))
-
- (goto-char pos)
- ;; Finish the buffer off and clean it up.
- (switch-to-buffer-other-window out)
- (indent-region (point-min) (point-max) nil)
- (run-hooks 'org-export-xoxo-final-hook)
- (save-buffer)
- (goto-char (point-min))
- )))
-
-(provide 'org-xoxo)
-
-;; Local variables:
-;; generated-autoload-file: "org-loaddefs.el"
-;; End:
-
-;;; org-xoxo.el ends here
diff --git a/lisp/org/org.el b/lisp/org/org.el
index cc4c93f22eb..7a6d6cc1b3f 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1,10 +1,10 @@
;;; org.el --- Outline-based notes management and organizer
;; Carstens outline-mode for keeping track of everything.
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Maintainer: Bastien Guerry <bzg at gnu dot org>
+;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
;;
@@ -22,7 +22,6 @@
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
@@ -78,10 +77,13 @@
(require 'find-func)
(require 'format-spec)
-(load "org-loaddefs.el" t t)
+(load "org-loaddefs.el" t t t)
-;; `org-outline-regexp' ought to be a defconst but is let-binding in
-;; some places -- e.g. see the macro org-with-limited-levels.
+(require 'org-macs)
+(require 'org-compat)
+
+;; `org-outline-regexp' ought to be a defconst but is let-bound in
+;; some places -- e.g. see the macro `org-with-limited-levels'.
;;
;; In Org buffers, the value of `outline-regexp' is that of
;; `org-outline-regexp'. The only function still directly relying on
@@ -96,42 +98,77 @@ This is similar to `org-outline-regexp' but additionally makes
sure that we are at the beginning of the line.")
(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Matches an headline, putting stars and text into groups.
+ "Matches a headline, putting stars and text into groups.
Stars are put in group 1 and the trimmed body in group 2.")
;; Emacs 22 calendar compatibility: Make sure the new variables are available
-(when (fboundp 'defvaralias)
- (unless (boundp 'calendar-view-holidays-initially-flag)
- (defvaralias 'calendar-view-holidays-initially-flag
- 'view-calendar-holidays-initially))
- (unless (boundp 'calendar-view-diary-initially-flag)
- (defvaralias 'calendar-view-diary-initially-flag
- 'view-diary-entries-initially))
- (unless (boundp 'diary-fancy-buffer)
- (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)))
+(unless (boundp 'calendar-view-holidays-initially-flag)
+ (org-defvaralias 'calendar-view-holidays-initially-flag
+ 'view-calendar-holidays-initially))
+(unless (boundp 'calendar-view-diary-initially-flag)
+ (org-defvaralias 'calendar-view-diary-initially-flag
+ 'view-diary-entries-initially))
+(unless (boundp 'diary-fancy-buffer)
+ (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))
+
+(declare-function org-add-archive-files "org-archive" (files))
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-clock-timestamps-up "org-clock" ())
-(declare-function org-clock-timestamps-down "org-clock" ())
+(declare-function org-clock-get-last-clock-out-time "org-clock" ())
+(declare-function org-clock-timestamps-up "org-clock" (&optional n))
+(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
+(declare-function org-clock-update-time-maybe "org-clock" ())
+(declare-function org-clocktable-shift "org-clock" (dir n))
(declare-function orgtbl-mode "org-table" (&optional arg))
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
-(declare-function org-beamer-mode "org-beamer" ())
+(declare-function org-beamer-mode "ox-beamer" ())
(declare-function org-table-edit-field "org-table" (arg))
(declare-function org-table-justify-field-maybe "org-table" (&optional new))
+(declare-function org-table-set-constants "org-table" ())
+(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
(declare-function org-id-get-create "org-id" (&optional force))
(declare-function org-id-find-id-file "org-id" (id))
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
+(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-table-align "org-table" ())
+(declare-function org-table-begin "org-table" (&optional table-type))
+(declare-function org-table-blank-field "org-table" ())
+(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function org-table-insert-row "org-table" (&optional arg))
(declare-function org-table-paste-rectangle "org-table" ())
(declare-function org-table-maybe-eval-formula "org-table" ())
(declare-function org-table-maybe-recalculate-line "org-table" ())
+(declare-function org-element--parse-objects "org-element"
+ (beg end acc restriction))
+(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-interpret-data "org-element"
+ (data &optional parent))
+(declare-function org-element-map "org-element"
+ (data types fun &optional info first-match no-recursion))
+(declare-function org-element-nested-p "org-element" (elem-a elem-b))
+(declare-function org-element-parse-buffer "org-element"
+ (&optional granularity visible-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element"
+ (element property value))
+(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
+(declare-function org-element--parse-objects "org-element"
+ (beg end acc restriction))
+(declare-function org-element-parse-buffer "org-element"
+ (&optional granularity visible-only))
+(declare-function org-element-restriction "org-element" (element))
+(declare-function org-element-type "org-element" (element))
+
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -151,6 +188,35 @@ Stars are put in group 1 and the trimmed body in group 2.")
(intern (concat "org-babel-expand-body:" lang)))))))
org-babel-load-languages))
+(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
+;;;###autoload
+(defun org-babel-load-file (file &optional compile)
+ "Load Emacs Lisp source code blocks in the Org-mode FILE.
+This function exports the source code using `org-babel-tangle'
+and then loads the resulting file using `load-file'. With prefix
+arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
+file to byte-code before it is loaded."
+ (interactive "fFile to load: \nP")
+ (require 'ob-core)
+ (let* ((age (lambda (file)
+ (float-time
+ (time-subtract (current-time)
+ (nth 5 (or (file-attributes (file-truename file))
+ (file-attributes file)))))))
+ (base-name (file-name-sans-extension file))
+ (exported-file (concat base-name ".el")))
+ ;; tangle if the org-mode file is newer than the elisp file
+ (unless (and (file-exists-p exported-file)
+ (> (funcall age file) (funcall age exported-file)))
+ (setq exported-file
+ (car (org-babel-tangle-file file exported-file "emacs-lisp"))))
+ (message "%s %s"
+ (if compile
+ (progn (byte-compile-file exported-file 'load)
+ "Compiled and loaded")
+ (progn (load-file exported-file) "Loaded"))
+ exported-file)))
+
(defcustom org-babel-load-languages '((emacs-lisp . t))
"Languages which can be evaluated in Org-mode buffers.
This list can be used to load support for any of the languages
@@ -188,6 +254,7 @@ requirements) is loaded."
(const :tag "Ledger" ledger)
(const :tag "Lilypond" lilypond)
(const :tag "Lisp" lisp)
+ (const :tag "Makefile" makefile)
(const :tag "Maxima" maxima)
(const :tag "Matlab" matlab)
(const :tag "Mscgen" mscgen)
@@ -220,7 +287,6 @@ identifier."
:group 'org-id)
;;; Version
-(require 'org-compat)
(org-check-version)
;;;###autoload
@@ -231,11 +297,13 @@ When FULL is non-nil, use a verbose version string.
When MESSAGE is non-nil, display a message with the version."
(interactive "P")
(let* ((org-dir (ignore-errors (org-find-library-dir "org")))
- (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs.el")))
+ (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (list ".el"))
+ (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs")))
(org-trash (or
(and (fboundp 'org-release) (fboundp 'org-git-version))
- (load (concat org-dir "org-version.el")
- 'noerror 'nomessage 'nosuffix)))
+ (org-load-noerror-mustsuffix (concat org-dir "org-version"))))
+ (load-suffixes save-load-suffixes)
(org-version (org-release))
(git-version (org-git-version))
(version (format "Org-mode version %s (%s @ %s)"
@@ -246,13 +314,13 @@ When MESSAGE is non-nil, display a message with the version."
org-install-dir
(concat "mixed installation! " org-install-dir " and " org-dir))
"org-loaddefs.el can not be found!")))
- (_version (if full version org-version)))
+ (version1 (if full version org-version)))
(if (org-called-interactively-p 'interactive)
(if here
(insert version)
(message version))
- (if message (message _version))
- _version)))
+ (if message (message version1))
+ version1)))
(defconst org-version (org-version))
@@ -301,24 +369,25 @@ When MESSAGE is non-nil, display a message with the version."
(when (featurep 'org)
(org-load-modules-maybe 'force)))
-(when (org-bound-and-true-p org-modules)
- (let ((a (member 'org-infojs org-modules)))
- (and a (setcar a 'org-jsinfo))))
-
-(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl)
+(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
"Modules that should always be loaded together with org.el.
+
If a description starts with <C>, the file is not part of Emacs
-and loading it will require that you have downloaded and properly installed
-the org-mode distribution.
+and loading it will require that you have downloaded and properly
+installed the Org mode distribution.
You can also use this system to load external packages (i.e. neither Org
core modules, nor modules from the CONTRIB directory). Just add symbols
to the end of the list. If the package is called org-xyz.el, then you need
-to add the symbol `xyz', and the package must have a call to
+to add the symbol `xyz', and the package must have a call to:
- (provide 'org-xyz)"
+ (provide \\='org-xyz)
+
+For export specific modules, see also `org-export-backends'."
:group 'org
:set 'org-set-modules
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type
'(set :greedy t
(const :tag " bbdb: Links to BBDB entries" org-bbdb)
@@ -327,26 +396,20 @@ to add the symbol `xyz', and the package must have a call to
(const :tag " ctags: Access to Emacs tags with links" org-ctags)
(const :tag " docview: Links to doc-view buffers" org-docview)
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
+ (const :tag " habit: Track your consistency with habits" org-habit)
(const :tag " id: Global IDs for identifying entries" org-id)
(const :tag " info: Links to Info nodes" org-info)
- (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo)
- (const :tag " habit: Track your consistency with habits" org-habit)
(const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask)
(const :tag " irc: Links to IRC/ERC chat sessions" org-irc)
- (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message)
- (const :tag " mew Links to Mew folders/messages" org-mew)
(const :tag " mhe: Links to MHE folders/messages" org-mhe)
+ (const :tag " mouse: Additional mouse support" org-mouse)
(const :tag " protocol: Intercept calls from emacsclient" org-protocol)
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
- (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks)
- (const :tag " vm: Links to VM folders/messages" org-vm)
- (const :tag " wl: Links to Wanderlust folders/messages" org-wl)
(const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
- (const :tag " mouse: Additional mouse support" org-mouse)
- (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler)
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
(const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
+ (const :tag "C bullets: Add overlays to headlines stars" org-bullets)
(const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
(const :tag "C collector: Collect properties into tables" org-collector)
@@ -354,35 +417,137 @@ to add the symbol `xyz', and the package must have a call to
(const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill)
(const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
(const :tag "C eshell Support for links to working directories in eshell" org-eshell)
- (const :tag "C eval: Include command output as text" org-eval)
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
+ (const :tag "C eval: Include command output as text" org-eval)
(const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
- (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex)
+ (const :tag "C favtable: Lookup table of favorite references and links" org-favtable)
(const :tag "C git-link: Provide org links to specific file version" org-git-link)
(const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
-
(const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
-
(const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
(const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
- (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
- (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
- (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
+ (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
+ (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
+ (const :tag "C mew: Links to Mew folders/messages" org-mew)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
+ (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
(const :tag "C registry: A registry for Org-mode links" org-registry)
- (const :tag "C org2rem: Convert org appointments into reminders" org2rem)
(const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
(const :tag "C secretary: Team management with org-mode" org-secretary)
(const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
(const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
(const :tag "C track: Keep up with Org-mode development" org-track)
(const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
+ (const :tag "C vm: Links to VM folders/messages" org-vm)
(const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
+ (const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
+(defvar org-export--registered-backends) ; From ox.el.
+(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
+(declare-function org-export-backend-name "ox" (backend))
+(defcustom org-export-backends '(ascii html icalendar latex)
+ "List of export back-ends that should be always available.
+
+If a description starts with <C>, the file is not part of Emacs
+and loading it will require that you have downloaded and properly
+installed the Org mode distribution.
+
+Unlike to `org-modules', libraries in this list will not be
+loaded along with Org, but only once the export framework is
+needed.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code, where VAL stands for the new
+value of the variable, after updating it:
+
+ (progn
+ (setq org-export--registered-backends
+ (org-remove-if-not
+ (lambda (backend)
+ (let ((name (org-export-backend-name backend)))
+ (or (memq name val)
+ (catch \\='parentp
+ (dolist (b val)
+ (and (org-export-derived-backend-p b name)
+ (throw \\='parentp t)))))))
+ org-export--registered-backends))
+ (let ((new-list (mapcar \\='org-export-backend-name
+ org-export--registered-backends)))
+ (dolist (backend val)
+ (cond
+ ((not (load (format \"ox-%s\" backend) t t))
+ (message \"Problems while trying to load export back-end \\=`%s\\='\"
+ backend))
+ ((not (memq backend new-list)) (push backend new-list))))
+ (set-default \\='org-export-backends new-list)))
+
+Adding a back-end to this list will also pull the back-end it
+depends on, if any."
+ :group 'org
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :initialize 'custom-initialize-set
+ :set (lambda (var val)
+ (if (not (featurep 'ox)) (set-default var val)
+ ;; Any back-end not required anymore (not present in VAL and not
+ ;; a parent of any back-end in the new value) is removed from the
+ ;; list of registered back-ends.
+ (setq org-export--registered-backends
+ (org-remove-if-not
+ (lambda (backend)
+ (let ((name (org-export-backend-name backend)))
+ (or (memq name val)
+ (catch 'parentp
+ (dolist (b val)
+ (and (org-export-derived-backend-p b name)
+ (throw 'parentp t)))))))
+ org-export--registered-backends))
+ ;; Now build NEW-LIST of both new back-ends and required
+ ;; parents.
+ (let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
+ (dolist (backend val)
+ (cond
+ ((not (load (format "ox-%s" backend) t t))
+ (message "Problems while trying to load export back-end `%s'"
+ backend))
+ ((not (memq backend new-list)) (push backend new-list))))
+ ;; Set VAR to that list with fixed dependencies.
+ (set-default var new-list))))
+ :type '(set :greedy t
+ (const :tag " ascii Export buffer to ASCII format" ascii)
+ (const :tag " beamer Export buffer to Beamer presentation" beamer)
+ (const :tag " html Export buffer to HTML format" html)
+ (const :tag " icalendar Export buffer to iCalendar format" icalendar)
+ (const :tag " latex Export buffer to LaTeX format" latex)
+ (const :tag " man Export buffer to MAN format" man)
+ (const :tag " md Export buffer to Markdown format" md)
+ (const :tag " odt Export buffer to ODT format" odt)
+ (const :tag " org Export buffer to Org format" org)
+ (const :tag " texinfo Export buffer to Texinfo format" texinfo)
+ (const :tag "C confluence Export buffer to Confluence Wiki format" confluence)
+ (const :tag "C deck Export buffer to deck.js presentations" deck)
+ (const :tag "C freemind Export buffer to Freemind mindmap format" freemind)
+ (const :tag "C groff Export buffer to Groff format" groff)
+ (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter)
+ (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss)
+ (const :tag "C s5 Export buffer to s5 presentations" s5)
+ (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
+
+(eval-after-load 'ox
+ '(mapc
+ (lambda (backend)
+ (condition-case nil (require (intern (format "ox-%s" backend)))
+ (error (message "Problems while trying to load export back-end `%s'"
+ backend))))
+ org-export-backends))
+
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
@@ -430,7 +595,7 @@ XEmacs user should have this variable set to nil, because
(defcustom org-loop-over-headlines-in-active-region nil
"Shall some commands act upon headlines in the active region?
-When set to `t', some commands will be performed in all headlines
+When set to t, some commands will be performed in all headlines
within the active region.
When set to `start-level', some commands will be performed in all
@@ -447,7 +612,7 @@ The list of commands is: `org-schedule', `org-deadline',
already archived entries."
:type '(choice (const :tag "Don't loop" nil)
(const :tag "All headlines in active region" t)
- (const :tag "In active region, headlines at the same level than the first one" 'start-level)
+ (const :tag "In active region, headlines at the same level than the first one" start-level)
(string :tag "Tags/Property/Todo matcher"))
:version "24.1"
:group 'org-todo
@@ -498,12 +663,18 @@ the following lines anywhere in the buffer:
(const :tag "Globally (slow on startup in large files)" t)))
(defcustom org-use-sub-superscripts t
- "Non-nil means interpret \"_\" and \"^\" for export.
-When this option is turned on, you can use TeX-like syntax for sub- and
-superscripts. Several characters after \"_\" or \"^\" will be
-considered as a single item - so grouping with {} is normally not
-needed. For example, the following things will be parsed as single
-sub- or superscripts.
+ "Non-nil means interpret \"_\" and \"^\" for display.
+
+If you want to control how Org exports those characters, see
+`org-export-with-sub-superscripts'. `org-use-sub-superscripts'
+used to be an alias for `org-export-with-sub-superscripts' in
+Org <8.0, it is not anymore.
+
+When this option is turned on, you can use TeX-like syntax for
+sub- and superscripts within the buffer. Several characters after
+\"_\" or \"^\" will be considered as a single item - so grouping
+with {} is normally not needed. For example, the following things
+will be parsed as single sub- or superscripts:
10^24 or 10^tau several digits will be considered 1 item.
10^-12 or 10^-tau a leading sign with digits or a word
@@ -511,27 +682,19 @@ sub- or superscripts.
terminated by almost any nonword/nondigit char.
x_{i^2} or x^(2-i) braces or parenthesis do grouping.
-Still, ambiguity is possible - so when in doubt use {} to enclose the
-sub/superscript. If you set this variable to the symbol `{}',
+Still, ambiguity is possible. So when in doubt, use {} to enclose
+the sub/superscript. If you set this variable to the symbol `{}',
the braces are *required* in order to trigger interpretations as
sub/superscript. This can be helpful in documents that need \"_\"
-frequently in plain text.
-
-Not all export backends support this, but HTML does.
-
-This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"."
+frequently in plain text."
:group 'org-startup
- :group 'org-export-translation
- :version "24.1"
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(choice
(const :tag "Always interpret" t)
(const :tag "Only with braces" {})
(const :tag "Never interpret" nil)))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts))
-
-
(defcustom org-startup-with-beamer-mode nil
"Non-nil means turn on `org-beamer-mode' on startup.
This can also be configured on a per-file basis by adding one of
@@ -563,6 +726,18 @@ the following lines anywhere in the buffer:
:version "24.1"
:type 'boolean)
+(defcustom org-startup-with-latex-preview nil
+ "Non-nil means preview LaTeX fragments when loading a new Org file.
+
+This can also be configured on a per-file basis by adding one of
+the following lines anywhere in the buffer:
+ #+STARTUP: latexpreview
+ #+STARTUP: nolatexpreview"
+ :group 'org-startup
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defcustom org-insert-mode-line-in-empty-file nil
"Non-nil means insert the first line setting Org-mode in empty files.
When the function `org-mode' is called interactively in an empty file, this
@@ -602,8 +777,7 @@ it work for ESC."
:group 'org-startup
:type 'boolean)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys))
+(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
(defcustom org-disputed-keys
'(([(shift up)] . [(meta p)])
@@ -649,10 +823,11 @@ Also apply the translations defined in `org-xemacs-key-equivalents'."
(defcustom org-ellipsis nil
"The ellipsis to use in the Org-mode outline.
-When nil, just use the standard three dots. When a string, use that instead,
+When nil, just use the standard three dots.
+When a string, use that string instead.
When a face, use the standard 3 dots, but with the specified face.
The change affects only Org-mode (which will then use its own display table).
-Changing this requires executing `M-x org-mode' in a buffer to become
+Changing this requires executing `\\[org-mode]' in a buffer to become
effective."
:group 'org-startup
:type '(choice (const :tag "Default" nil)
@@ -695,6 +870,14 @@ Changes become only effective after restarting Emacs."
:group 'org-keywords
:type 'string)
+(defcustom org-closed-keep-when-no-todo nil
+ "Remove CLOSED: time-stamp when switching back to a non-todo state?"
+ :group 'org-todo
+ :group 'org-keywords
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
org-scheduled-string "\\|"
org-deadline-string "\\|"
@@ -786,7 +969,7 @@ contexts. See `org-show-hierarchy-above' for valid contexts."
:group 'org-reveal-location
:type org-context-choice)
-(defcustom org-show-siblings '((default . nil) (isearch t))
+(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t))
"Non-nil means show all sibling heading when revealing a location.
Org-mode often shows locations in an org-mode file which might have
been invisible before. When this is set, the sibling of the current entry
@@ -800,7 +983,9 @@ use the command \\[org-reveal] to show more context.
Instead of t, this can also be an alist specifying this option for different
contexts. See `org-show-hierarchy-above' for valid contexts."
:group 'org-reveal-location
- :type org-context-choice)
+ :type org-context-choice
+ :version "24.4"
+ :package-version '(Org . "8.0"))
(defcustom org-show-entry-below '((default . nil))
"Non-nil means show the entry below a headline when revealing a location.
@@ -865,6 +1050,21 @@ commands in the Help buffer using the `?' speed command."
(function)
(sexp))))))
+(defcustom org-bookmark-names-plist
+ '(:last-capture "org-capture-last-stored"
+ :last-refile "org-refile-last-stored"
+ :last-capture-marker "org-capture-last-stored-marker")
+ "Names for bookmarks automatically set by some Org commands.
+This can provide strings as names for a number of bookmarks Org sets
+automatically. The following keys are currently implemented:
+ :last-capture
+ :last-capture-marker
+ :last-refile
+When a key does not show up in the property list, the corresponding bookmark
+is not set."
+ :group 'org-structure
+ :type 'plist)
+
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
:tag "Org Cycle"
@@ -957,8 +1157,7 @@ visibility is cycled."
(const :tag "Only in completely white lines" white)
(const :tag "Before first char in a line" whitestart)
(const :tag "Everywhere except in headlines" t)
- (const :tag "Everywhere except at bol in headlines" exc-hl-bol)
- ))
+ (const :tag "Everywhere except at bol in headlines" exc-hl-bol)))
(defcustom org-cycle-separator-lines 2
"Number of empty lines needed to keep an empty line between collapsed trees.
@@ -990,6 +1189,7 @@ the values `folded', `children', or `subtree'."
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-hide-drawers
+ org-cycle-hide-inline-tasks
org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
@@ -1083,8 +1283,7 @@ This may also be a cons cell where the behavior for `C-a' and
(const :tag "off" nil)
(const :tag "on: before tags first" t)
(const :tag "reversed: after tags first" reversed)))))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e))
+(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
(defcustom org-special-ctrl-k nil
"Non-nil means `C-k' will behave specially in headlines.
@@ -1111,6 +1310,11 @@ OK to kill that hidden subtree. When nil, kill without remorse."
(const :tag "Protect hidden subtrees with a security query" t)
(const :tag "Never kill a hidden subtree with C-k" error)))
+(defcustom org-special-ctrl-o t
+ "Non-nil means, make `C-o' insert a row in tables."
+ :group 'org-edit-structure
+ :type 'boolean)
+
(defcustom org-catch-invisible-edits nil
"Check if in invisible region before inserting or deleting a character.
Valid values are:
@@ -1180,9 +1384,8 @@ default the value to be used for all contexts not explicitly
(defcustom org-insert-heading-respect-content nil
"Non-nil means insert new headings after the current subtree.
When nil, the new heading is created directly after the current line.
-The commands \\[org-insert-heading-respect-content] and
-\\[org-insert-todo-heading-respect-content] turn this variable on
-for the duration of the command."
+The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn
+this variable on for the duration of the command."
:group 'org-structure
:type 'boolean)
@@ -1194,9 +1397,9 @@ and a boolean flag as CDR. The cdr may also be the symbol `auto', in
which case Org will look at the surrounding headings/items and try to
make an intelligent decision whether to insert a blank line or not.
-For plain lists, if the variable `org-empty-line-terminates-plain-lists' is
-set, the setting here is ignored and no empty line is inserted, to avoid
-breaking the list structure."
+For plain lists, if `org-list-empty-line-terminates-plain-lists' is set,
+the setting here is ignored and no empty line is inserted to avoid breaking
+the list structure."
:group 'org-edit-structure
:type '(list
(cons (const heading)
@@ -1249,7 +1452,7 @@ changed by an edit command."
(defcustom org-remove-highlights-with-change t
"Non-nil means any change to the buffer will remove temporary highlights.
Such highlights are created by `org-occur' and `org-clock-display'.
-When nil, `C-c C-c needs to be used to get rid of the highlights.
+When nil, `C-c C-c' needs to be used to get rid of the highlights.
The highlights created by `org-preview-latex-fragment' always need
`C-c C-c' to be removed."
:group 'org-sparse-trees
@@ -1345,8 +1548,8 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g.
[[linkkey:tag][description]]
-The 'linkkey' must be a word word, starting with a letter, followed
-by letters, numbers, '-' or '_'.
+The `linkkey' must be a word word, starting with a letter, followed
+by letters, numbers, `-' or `_'.
If REPLACE is a string, the tag will simply be appended to create the link.
If the string contains \"%s\", the tag will be inserted there. If the string
@@ -1372,7 +1575,7 @@ See the manual for examples."
"Non-nil means Org will display descriptive links.
E.g. [[http://orgmode.org][Org website]] will be displayed as
\"Org Website\", hiding the link itself and just displaying its
-description. When set to `nil', Org will display the full links
+description. When set to nil, Org will display the full links
literally.
You can interactively set the value of this variable by calling
@@ -1430,7 +1633,7 @@ two parameters: the first one is the link, the second one is the
description generated by `org-insert-link'. The function should
return the description to use."
:group 'org-link
- :type 'function)
+ :type '(choice (const nil) (function)))
(defgroup org-link-store nil
"Options concerning storing links in Org-mode."
@@ -1519,7 +1722,7 @@ Org contains a function for this, so if you set this variable to
`org-translate-link-from-planner', you should be able follow many
links created by planner."
:group 'org-link-follow
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-follow-link-hook nil
"Hook that is run after a link has been followed."
@@ -1535,7 +1738,8 @@ implementation is bad."
:type 'boolean)
(defcustom org-return-follows-link nil
- "Non-nil means on links RET will follow the link."
+ "Non-nil means on links RET will follow the link.
+In tables, the special behavior of RET has precedence."
:group 'org-link-follow
:type 'boolean)
@@ -1545,7 +1749,12 @@ implementation is bad."
A longer mouse click will still set point. Does not work on XEmacs.
Needs to be set before org.el is loaded."
:group 'org-link-follow
- :type 'boolean)
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "A double click follows the link" double)
+ (const :tag "Unconditionally follow the link with mouse-1" t)
+ (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450)))
(defcustom org-mark-ring-length 4
"Number of different positions to be recorded in the ring.
@@ -1600,6 +1809,11 @@ another window."
(const vm-visit-folder)
(const vm-visit-folder-other-window)
(const vm-visit-folder-other-frame)))
+ (cons (const vm-imap)
+ (choice
+ (const vm-visit-imap-folder)
+ (const vm-visit-imap-folder-other-window)
+ (const vm-visit-imap-folder-other-frame)))
(cons (const gnus)
(choice
(const gnus)
@@ -1746,12 +1960,10 @@ The system \"open\" is used for most files.
See `org-file-apps'.")
(defcustom org-file-apps
- '(
- (auto-mode . emacs)
+ '((auto-mode . emacs)
("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
- ("\\.pdf\\'" . default)
- )
+ ("\\.pdf\\'" . default))
"External applications for opening `file:path' items in a document.
Org-mode uses system defaults for different file types, but
you can use this variable to set the application for a given file
@@ -1770,7 +1982,7 @@ file identifier are
filename matches the regexp. If you want to
use groups here, use shy groups.
- Example: (\"\\.x?html\\'\" . \"firefox %s\")
+ Example: (\"\\.x?html\\\\='\" . \"firefox %s\")
(\"\\(?:xhtml\\|html\\)\" . \"firefox %s\")
to open *.html and *.xhtml with firefox.
@@ -1786,7 +1998,7 @@ file identifier are
In a custom lisp form, you can access the group matches with
(match-string n link).
- Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\")
+ Example: (\"\\.pdf::\\(\\d+\\)\\\\='\" . \"evince -p %1 %s\")
to open [[file:document.pdf::5]] with evince at page 5.
`directory' Matches a directory
@@ -1865,16 +2077,14 @@ following situations:
note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
with `org-directory' as the default path."
:group 'org-refile
- :group 'org-remember
:group 'org-capture
:type 'directory)
(defcustom org-default-notes-file (convert-standard-filename "~/.notes")
"Default target for storing notes.
-Used as a fall back file for org-remember.el and org-capture.el, for
-templates that do not specify a target file."
+Used as a fall back file for org-capture.el, for templates that
+do not specify a target file."
:group 'org-refile
- :group 'org-remember
:group 'org-capture
:type '(choice
(const :tag "Default from remember-data-file" nil)
@@ -1904,7 +2114,6 @@ outline-path-completion Headlines in the current buffer are offered via
When nil, new notes will be filed to the end of a file or entry.
This can also be a list with cons cells of regular expressions that
are matched against file names, and values."
- :group 'org-remember
:group 'org-capture
:group 'org-refile
:type '(choice
@@ -2000,7 +2209,9 @@ should be continued. For example, the function may decide that the entire
subtree of the current entry should be excluded and move point to the end
of the subtree."
:group 'org-refile
- :type 'function)
+ :type '(choice
+ (const nil)
+ (function)))
(defcustom org-refile-use-cache nil
"Non-nil means cache refile targets to speed up the process.
@@ -2046,7 +2257,7 @@ fast, while still showing the whole path to the entry."
"Non-nil means allow to create new nodes as refile targets.
New nodes are then created by adding \"/new node name\" to the completion
of an existing node. When the value of this variable is `confirm',
-new node creation must be confirmed by the user (recommended)
+new node creation must be confirmed by the user (recommended).
When nil, the completion must match an existing entry.
Note that, if the new heading is not seen by the criteria
@@ -2157,7 +2368,12 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(defvar org-done-keywords-for-agenda nil)
(defvar org-drawers-for-agenda nil)
(defvar org-todo-keyword-alist-for-agenda nil)
-(defvar org-tag-alist-for-agenda nil)
+(defvar org-tag-alist-for-agenda nil
+ "Alist of all tags from all agenda files.")
+(defvar org-tag-groups-alist-for-agenda nil
+ "Alist of all groups tags from all current agenda files.")
+(defvar org-tag-groups-alist nil)
+(make-variable-buffer-local 'org-tag-groups-alist)
(defvar org-agenda-contributing-files nil)
(defvar org-not-done-keywords nil)
(make-variable-buffer-local 'org-not-done-keywords)
@@ -2223,7 +2439,7 @@ current entry each time a todo state is changed."
:group 'org-todo
:type '(choice
(const :tag "Yes, only for TODO entries" t)
- (const :tag "Yes, including all entries" 'all-headlines)
+ (const :tag "Yes, including all entries" all-headlines)
(repeat :tag "Yes, for TODOs in this list"
(string :tag "TODO keyword"))
(other :tag "No TODO statistics" nil)))
@@ -2271,7 +2487,7 @@ TODO state changes
------------------
:type todo-state-change
:from previous state (keyword as a string), or nil, or a symbol
- 'todo' or 'done', to indicate the general type of state.
+ `todo' or `done', to indicate the general type of state.
:to new state, like in :from")
(defcustom org-enforce-todo-dependencies nil
@@ -2470,12 +2686,12 @@ agenda log mode depends on the format of these entries."
"Heading when changing todo state (todo sequence only)"
state) string)
(cons (const :tag "Heading when just taking a note" note) string)
- (cons (const :tag "Heading when clocking out" clock-out) string)
- (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
(cons (const :tag "Heading when rescheduling" reschedule) string)
+ (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string)
(cons (const :tag "Heading when changing deadline" redeadline) string)
(cons (const :tag "Heading when deleting a deadline" deldeadline) string)
- (cons (const :tag "Heading when refiling" refile) string)))
+ (cons (const :tag "Heading when refiling" refile) string)
+ (cons (const :tag "Heading when clocking out" clock-out) string)))
(unless (assq 'note org-log-note-headings)
(push '(note . "%t") org-log-note-headings))
@@ -2491,6 +2707,11 @@ also set this to a string to define the drawer of your choice.
A value of t is also allowed, representing \"LOGBOOK\".
+A value of t or nil can also be set with on a per-file-basis with
+
+ #+STARTUP: logdrawer
+ #+STARTUP: nologdrawer
+
If this variable is set, `org-log-state-notes-insert-after-drawers'
will be ignored.
@@ -2503,8 +2724,7 @@ a subtree."
(const :tag "LOGBOOK" t)
(string :tag "Other")))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer))
+(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
(defun org-log-into-drawer ()
"Return the value of `org-log-into-drawer', but let properties overrule.
@@ -2532,7 +2752,12 @@ set."
(defcustom org-log-states-order-reversed t
"Non-nil means the latest state note will be directly after heading.
-When nil, the state change notes will be ordered according to time."
+When nil, the state change notes will be ordered according to time.
+
+This option can also be set with on a per-file-basis with
+
+ #+STARTUP: logstatesreversed
+ #+STARTUP: nologstatesreversed"
:group 'org-todo
:group 'org-progress
:type 'boolean)
@@ -2629,7 +2854,9 @@ The user can set a different function here, which should take a string
as an argument and return the numeric priority."
:group 'org-priorities
:version "24.1"
- :type 'function)
+ :type '(choice
+ (const nil)
+ (function)))
(defgroup org-time nil
"Options concerning time stamps and deadlines in Org-mode."
@@ -2705,26 +2932,137 @@ commands, if custom time display is turned on at the time of export."
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-time-clocksum-format "%d:%02d"
+(defcustom org-time-clocksum-format
+ '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
"The format string used when creating CLOCKSUM lines.
-This is also used when org-mode generates a time duration."
+This is also used when Org mode generates a time duration.
+
+The value can be a single format string containing two
+%-sequences, which will be filled with the number of hours and
+minutes in that order.
+
+Alternatively, the value can be a plist associating any of the
+keys :years, :months, :weeks, :days, :hours or :minutes with
+format strings. The time duration is formatted using only the
+time components that are needed and concatenating the results.
+If a time unit in absent, it falls back to the next smallest
+unit.
+
+The keys :require-years, :require-months, :require-days,
+:require-weeks, :require-hours, :require-minutes are also
+meaningful. A non-nil value for these keys indicates that the
+corresponding time component should always be included, even if
+its value is 0.
+
+
+For example,
+
+ (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
+ :require-minutes t)
+
+means durations longer than a day will be expressed in days,
+hours and minutes, and durations less than a day will always be
+expressed in hours and minutes (even for durations less than an
+hour).
+
+The value
+
+ (:days \"%dd\" :minutes \"%dm\")
+
+means durations longer than a day will be expressed in days and
+minutes, and durations less than a day will be expressed entirely
+in minutes (even for durations longer than an hour)."
:group 'org-time
- :type 'string)
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice (string :tag "Format string")
+ (set :tag "Plist"
+ (group :inline t (const :tag "Years" :years)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show years" :require-years)
+ (const t))
+ (group :inline t (const :tag "Months" :months)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show months" :require-months)
+ (const t))
+ (group :inline t (const :tag "Weeks" :weeks)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show weeks" :require-weeks)
+ (const t))
+ (group :inline t (const :tag "Days" :days)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show days" :require-days)
+ (const t))
+ (group :inline t (const :tag "Hours" :hours)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show hours" :require-hours)
+ (const t))
+ (group :inline t (const :tag "Minutes" :minutes)
+ (string :tag "Format string"))
+ (group :inline t
+ (const :tag "Always show minutes" :require-minutes)
+ (const t)))))
(defcustom org-time-clocksum-use-fractional nil
- "If non-nil, \\[org-clock-display] uses fractional times.
-org-mode generates a time duration."
+ "When non-nil, \\[org-clock-display] uses fractional times.
+See `org-time-clocksum-format' for more on time clock formats."
+ :group 'org-time
+ :group 'org-clock
+ :version "24.3"
+ :type 'boolean)
+
+(defcustom org-time-clocksum-use-effort-durations nil
+ "When non-nil, \\[org-clock-display] uses effort durations.
+E.g. by default, one day is considered to be a 8 hours effort,
+so a task that has been clocked for 16 hours will be displayed
+as during 2 days in the clock display or in the clocktable.
+
+See `org-effort-durations' on how to set effort durations
+and `org-time-clocksum-format' for more on time clock formats."
:group 'org-time
+ :group 'org-clock
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type 'boolean)
(defcustom org-time-clocksum-fractional-format "%.2f"
- "The format string used when creating CLOCKSUM lines, or when
-org-mode generates a time duration."
+ "The format string used when creating CLOCKSUM lines,
+or when Org mode generates a time duration, if
+`org-time-clocksum-use-fractional' is enabled.
+
+The value can be a single format string containing one
+%-sequence, which will be filled with the number of hours as
+a float.
+
+Alternatively, the value can be a plist associating any of the
+keys :years, :months, :weeks, :days, :hours or :minutes with
+a format string. The time duration is formatted using the
+largest time unit which gives a non-zero integer part. If all
+specified formats have zero integer part, the smallest time unit
+is used."
:group 'org-time
- :type 'string)
+ :type '(choice (string :tag "Format string")
+ (set (group :inline t (const :tag "Years" :years)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Months" :months)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Weeks" :weeks)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Days" :days)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Hours" :hours)
+ (string :tag "Format string"))
+ (group :inline t (const :tag "Minutes" :minutes)
+ (string :tag "Format string")))))
(defcustom org-deadline-warning-days 14
- "No. of days before expiration during which a deadline becomes active.
+ "Number of days before expiration during which a deadline becomes active.
This variable governs the display in sparse trees and in the agenda.
When 0 or negative, it means use this number (the absolute value of it)
even if a deadline has a different individual lead time specified.
@@ -2734,6 +3072,21 @@ Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type 'integer)
+(defcustom org-scheduled-delay-days 0
+ "Number of days before a scheduled item becomes active.
+This variable governs the display in sparse trees and in the agenda.
+The default value (i.e. 0) means: don't delay scheduled item.
+When negative, it means use this number (the absolute value of it)
+even if a scheduled item has a different individual delay time
+specified.
+
+Custom commands can set this variable in the options section."
+ :group 'org-time
+ :group 'org-agenda-daily/weekly
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
(defcustom org-read-date-prefer-future t
"Non-nil means assume future for incomplete date input from user.
This affects the following situations:
@@ -2821,14 +3174,19 @@ minibuffer will also be active, and you can simply enter the date as well.
When nil, only the minibuffer will be available."
:group 'org-time
:type 'boolean)
-(if (fboundp 'defvaralias)
- (defvaralias 'org-popup-calendar-for-date-prompt
- 'org-read-date-popup-calendar))
+(org-defvaralias 'org-popup-calendar-for-date-prompt
+ 'org-read-date-popup-calendar)
+(make-obsolete-variable
+ 'org-read-date-minibuffer-setup-hook
+ "Set `org-read-date-minibuffer-local-map' instead." "24.4")
(defcustom org-read-date-minibuffer-setup-hook nil
"Hook to be used to set up keys for the date/time interface.
-Add key definitions to `minibuffer-local-map', which will be a temporary
-copy."
+Add key definitions to `minibuffer-local-map', which will be a
+temporary copy.
+
+WARNING: This option is obsolete, you should use
+`org-read-date-minibuffer-local-map' to set up keys."
:group 'org-time
:type 'hook)
@@ -2856,6 +3214,15 @@ For example, if `org-extend-today-until' is 8, and it's 4am, then the
:version "24.1"
:type 'boolean)
+(defcustom org-use-last-clock-out-time-as-effective-time nil
+ "When non-nil, use the last clock out time for `org-todo'.
+Note that this option has precedence over the combined use of
+`org-use-effective-time' and `org-extend-today-until'."
+ :group 'org-time
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defcustom org-edit-timestamp-down-means-later nil
"Non-nil means S-down will increase the time in a time stamp.
When nil, S-up will increase."
@@ -2890,6 +3257,8 @@ See the manual for details."
(list :tag "Start radio group"
(const :startgroup)
(option (string :tag "Group description")))
+ (list :tag "Group tags delimiter"
+ (const :grouptags))
(list :tag "End radio group"
(const :endgroup)
(option (string :tag "Group description")))
@@ -2912,6 +3281,7 @@ To disable these tags on a per-file basis, insert anywhere in the file:
(cons (string :tag "Tag name")
(character :tag "Access char"))
(const :tag "Start radio group" (:startgroup))
+ (const :tag "Group tags delimiter" (:grouptags))
(const :tag "End radio group" (:endgroup))
(const :tag "New line" (:newline)))))
@@ -2921,10 +3291,10 @@ Instead of customizing this variable directly, you might want to
set it locally for capture buffers, because there no list of
tags in that file can be created dynamically (there are none).
- (add-hook 'org-capture-mode-hook
+ (add-hook \\='org-capture-mode-hook
(lambda ()
(set (make-local-variable
- 'org-complete-tags-always-offer-all-agenda-tags)
+ \\='org-complete-tags-always-offer-all-agenda-tags)
t)))"
:group 'org-tags
:version "24.1"
@@ -2949,7 +3319,7 @@ automatically if necessary."
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
- (const :tag "When selection characters are configured" 'auto)))
+ (const :tag "When selection characters are configured" auto)))
(defcustom org-fast-tag-selection-single-key nil
"Non-nil means fast tag selection exits after first change.
@@ -3094,7 +3464,7 @@ and the clock summary:
(let ((clocksum (org-clock-sum-current-item))
(effort (org-duration-string-to-minutes
(org-entry-get (point) \"Effort\"))))
- (org-minutes-to-hh:mm-string (- effort clocksum))))))"
+ (org-minutes-to-clocksum-string (- effort clocksum))))))"
:group 'org-properties
:version "24.1"
:type '(alist :key-type (string :tag "Property")
@@ -3170,7 +3540,7 @@ value The value that should be modified.
The function should return the value that should be displayed,
or nil if the normal value should be used."
:group 'org-properties
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-effort-property "Effort"
"The property that is being used to keep track of effort estimates.
@@ -3263,23 +3633,22 @@ regular expression will be included."
(defcustom org-agenda-text-search-extra-files nil
"List of extra files to be searched by text search commands.
-These files will be search in addition to the agenda files by the
+These files will be searched in addition to the agenda files by the
commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'.
Note that these files will only be searched for text search commands,
not for the other agenda views like todo lists, tag searches or the weekly
agenda. This variable is intended to list notes and possibly archive files
that should also be searched by these two commands.
In fact, if the first element in the list is the symbol `agenda-archives',
-than all archive files of all agenda files will be added to the search
+then all archive files of all agenda files will be added to the search
scope."
:group 'org-agenda
:type '(set :greedy t
(const :tag "Agenda Archives" agenda-archives)
(repeat :inline t (file))))
-(if (fboundp 'defvaralias)
- (defvaralias 'org-agenda-multi-occur-extra-files
- 'org-agenda-text-search-extra-files))
+(org-defvaralias 'org-agenda-multi-occur-extra-files
+ 'org-agenda-text-search-extra-files)
(defcustom org-agenda-skip-unavailable-files nil
"Non-nil means to just skip non-reachable files in `org-agenda-files'.
@@ -3340,19 +3709,21 @@ points to a file, `org-agenda-diary-entry' will be used instead."
This is a property list with the following properties:
:foreground the foreground color for images embedded in Emacs, e.g. \"Black\".
`default' means use the foreground of the default face.
+ `auto' means use the foreground from the text face.
:background the background color, or \"Transparent\".
`default' means use the background of the default face.
+ `auto' means use the background from the text face.
:scale a scaling factor for the size of the images, to get more pixels
:html-foreground, :html-background, :html-scale
the same numbers for HTML export.
:matchers a list indicating which matchers should be used to
find LaTeX fragments. Valid members of this list are:
- \"begin\" find environments
- \"$1\" find single characters surrounded by $.$
- \"$\" find math expressions surrounded by $...$
- \"$$\" find math expressions surrounded by $$....$$
- \"\\(\" find math expressions surrounded by \\(...\\)
- \"\\ [\" find math expressions surrounded by \\ [...\\]"
+ \"begin\" find environments
+ \"$1\" find single characters surrounded by $.$
+ \"$\" find math expressions surrounded by $...$
+ \"$$\" find math expressions surrounded by $$....$$
+ \"\\(\" find math expressions surrounded by \\(...\\)
+ \"\\=\\[\" find math expressions surrounded by \\=\\[...\\]"
:group 'org-latex
:type 'plist)
@@ -3408,9 +3779,10 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
(const :tag "imagemagick" imagemagick)))
(defcustom org-latex-preview-ltxpng-directory "ltxpng/"
- "Path to store latex preview images. A relative path here creates many
- directories relative to the processed org files paths. An absolute path
- puts all preview images at the same place."
+ "Path to store latex preview images.
+A relative path here creates many directories relative to the
+processed org files paths. An absolute path puts all preview
+images at the same place."
:group 'org-latex
:version "24.3"
:type 'string)
@@ -3430,11 +3802,9 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
-\\usepackage{amsmath}
-\\usepackage[mathscr]{eucal}
+[PACKAGES]
+[DEFAULT-PACKAGES]
\\pagestyle{empty} % do not remove
-\[PACKAGES]
-\[DEFAULT-PACKAGES]
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
@@ -3451,14 +3821,12 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
"The document header used for processing LaTeX fragments.
It is imperative that this header make sure that no page number
appears on the page. The package defined in the variables
-`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist'
-will either replace the placeholder \"[PACKAGES]\" in this header, or they
-will be appended."
+`org-latex-default-packages-alist' and `org-latex-packages-alist'
+will either replace the placeholder \"[PACKAGES]\" in this
+header, or they will be appended."
:group 'org-latex
:type 'string)
-(defvar org-format-latex-header-extra nil)
-
(defun org-set-packages-alist (var val)
"Set the packages alist and make sure it has 3 elements per entry."
(set var (mapcar (lambda (x)
@@ -3468,7 +3836,6 @@ will be appended."
val)))
(defun org-get-packages-alist (var)
-
"Get the packages alist and make sure it has 3 elements per entry."
(mapcar (lambda (x)
(if (and (consp x) (= (length x) 2))
@@ -3476,10 +3843,7 @@ will be appended."
x))
(default-value var)))
-;; The following variables are defined here because is it also used
-;; when formatting latex fragments. Originally it was part of the
-;; LaTeX exporter, which is why the name includes "export".
-(defcustom org-export-latex-default-packages-alist
+(defcustom org-latex-default-packages-alist
'(("AUTO" "inputenc" t)
("T1" "fontenc" t)
("" "fixltx2e" nil)
@@ -3487,36 +3851,52 @@ will be appended."
("" "longtable" nil)
("" "float" nil)
("" "wrapfig" nil)
- ("" "soul" t)
+ ("" "rotating" nil)
+ ("normalem" "ulem" t)
+ ("" "amsmath" t)
("" "textcomp" t)
("" "marvosym" t)
("" "wasysym" t)
- ("" "latexsym" t)
("" "amssymb" t)
("" "hyperref" nil)
- "\\tolerance=1000"
- )
+ "\\tolerance=1000")
"Alist of default packages to be inserted in the header.
-Change this only if one of the packages here causes an incompatibility
-with another package you are using.
-The packages in this list are needed by one part or another of Org-mode
-to function properly.
+
+Change this only if one of the packages here causes an
+incompatibility with another package you are using.
+
+The packages in this list are needed by one part or another of
+Org mode to function properly:
- inputenc, fontenc: for basic font and character selection
-- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used
- for interpreting the entities in `org-entities'. You can skip some of these
- packages if you don't use any of the symbols in it.
+- fixltx2e: Important patches of LaTeX itself
- graphicx: for including images
+- longtable: For multipage tables
- float, wrapfig: for figure placement
-- longtable: for long tables
+- rotating: for sideways figures and tables
+- ulem: for underline and strike-through
+- amsmath: for subscript and superscript and math environments
+- textcomp, marvosymb, wasysym, amssymb: for various symbols used
+ for interpreting the entities in `org-entities'. You can skip
+ some of these packages if you don't use any of their symbols.
- hyperref: for cross references
-Therefore you should not modify this variable unless you know what you
-are doing. The one reason to change it anyway is that you might be loading
-some other package that conflicts with one of the default packages.
-Each cell is of the format \( \"options\" \"package\" snippet-flag\).
-If SNIPPET-FLAG is t, the package also needs to be included when
-compiling LaTeX snippets into images for inclusion into HTML."
+Therefore you should not modify this variable unless you know
+what you are doing. The one reason to change it anyway is that
+you might be loading some other package that conflicts with one
+of the default packages. Each element is either a cell or
+a string.
+
+A cell is of the format:
+
+ ( \"options\" \"package\" SNIPPET-FLAG).
+
+If SNIPPET-FLAG is non-nil, the package also needs to be included
+when compiling LaTeX snippets into images for inclusion into
+non-LaTeX output.
+
+A string will be inserted as-is in the header of the document."
+ :group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
@@ -3529,17 +3909,29 @@ compiling LaTeX snippets into images for inclusion into HTML."
(boolean :tag "Snippet"))
(string :tag "A line of LaTeX"))))
-(defcustom org-export-latex-packages-alist nil
+(defcustom org-latex-packages-alist nil
"Alist of packages to be inserted in every LaTeX header.
-These will be inserted after `org-export-latex-default-packages-alist'.
-Each cell is of the format \( \"options\" \"package\" snippet-flag \).
-SNIPPET-FLAG, when t, indicates that this package is also needed when
-turning LaTeX snippets into images for inclusion into HTML.
+
+These will be inserted after `org-latex-default-packages-alist'.
+Each element is either a cell or a string.
+
+A cell is of the format:
+
+ (\"options\" \"package\" SNIPPET-FLAG)
+
+SNIPPET-FLAG, when non-nil, indicates that this package is also
+needed when turning LaTeX snippets into images for inclusion into
+non-LaTeX output.
+
+A string will be inserted as-is in the header of the document.
+
Make sure that you only list packages here which:
-- you want in every file
-- do not conflict with the default packages in
- `org-export-latex-default-packages-alist'
-- do not conflict with the setup in `org-format-latex-header'."
+
+ - you want in every file;
+ - do not conflict with the setup in `org-format-latex-header';
+ - do not conflict with the default packages in
+ `org-latex-default-packages-alist'."
+ :group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
@@ -3551,7 +3943,6 @@ Make sure that you only list packages here which:
(boolean :tag "Snippet"))
(string :tag "A line of LaTeX"))))
-
(defgroup org-appearance nil
"Settings for Org-mode appearance."
:tag "Org Appearance"
@@ -3583,7 +3974,7 @@ lines to the buffer:
(defcustom org-hidden-keywords nil
"List of symbols corresponding to keywords to be hidden the org buffer.
-For example, a value '(title) for this list will make the document's title
+For example, a value \\='(title) for this list will make the document's title
appear in the buffer without the initial #+TITLE: keyword."
:group 'org-appearance
:version "24.1"
@@ -3622,10 +4013,22 @@ org-level-* faces."
:group 'org-appearance
:type 'boolean)
-(defcustom org-highlight-latex-fragments-and-specials nil
- "Non-nil means fontify what is treated specially by the exporters."
+(defcustom org-highlight-latex-and-related nil
+ "Non-nil means highlight LaTeX related syntax in the buffer.
+When non nil, the value should be a list containing any of the
+following symbols:
+ `latex' Highlight LaTeX snippets and environments.
+ `script' Highlight subscript and superscript.
+ `entities' Highlight entities."
:group 'org-appearance
- :type 'boolean)
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "No highlighting" nil)
+ (set :greedy t :tag "Highlight"
+ (const :tag "LaTeX snippets and environments" latex)
+ (const :tag "Subscript and superscript" script)
+ (const :tag "Entities" entities))))
(defcustom org-hide-emphasis-markers nil
"Non-nil mean font-lock should hide the emphasis marker characters."
@@ -3674,7 +4077,7 @@ After a match, the match groups contain these elements:
(body1 (concat body "*?"))
(markers (mapconcat 'car org-emphasis-alist ""))
(vmarkers (mapconcat
- (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) ""))
+ (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
org-emphasis-alist "")))
;; make sure special characters appear at the right position in the class
(if (string-match "\\^" markers)
@@ -3714,7 +4117,10 @@ After a match, the match groups contain these elements:
"\\3\\)"
"\\([" post "]\\|$\\)")))))
-(defcustom org-emphasis-regexp-components
+;; This used to be a defcustom (Org <8.0) but allowing the users to
+;; set this option proved cumbersome. See this message/thread:
+;; http://article.gmane.org/gmane.emacs.orgmode/68681
+(defvar org-emphasis-regexp-components
'(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
"Components used to build the regular expression for emphasis.
This is a list with five entries. Terminology: In an emphasis string
@@ -3730,48 +4136,36 @@ body-regexp A regexp like \".\" to match a body character. Don't use
non-shy groups here, and don't allow newline here.
newline The maximum number of newlines allowed in an emphasis exp.
-Use customize to modify this, or restart Emacs after changing it."
- :group 'org-appearance
- :set 'org-set-emph-re
- :type '(list
- (sexp :tag "Allowed chars in pre ")
- (sexp :tag "Allowed chars in post ")
- (sexp :tag "Forbidden chars in border ")
- (sexp :tag "Regexp for body ")
- (integer :tag "number of newlines allowed")
- (option (boolean :tag "Please ignore this button"))))
+You need to reload Org or to restart Emacs after customizing this.")
(defcustom org-emphasis-alist
- `(("*" bold "<b>" "</b>")
- ("/" italic "<i>" "</i>")
- ("_" underline "<span style=\"text-decoration:underline;\">" "</span>")
- ("=" org-code "<code>" "</code>" verbatim)
- ("~" org-verbatim "<code>" "</code>" verbatim)
- ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))
- "<del>" "</del>")
- )
- "Special syntax for emphasized text.
-Text starting and ending with a special character will be emphasized, for
-example *bold*, _underlined_ and /italic/. This variable sets the marker
-characters, the face to be used by font-lock for highlighting in Org-mode
-Emacs buffers, and the HTML tags to be used for this.
-For LaTeX export, see the variable `org-export-latex-emphasis-alist'.
-For DocBook export, see the variable `org-export-docbook-emphasis-alist'.
-Use customize to modify this, or restart Emacs after changing it."
+ `(("*" bold)
+ ("/" italic)
+ ("_" underline)
+ ("=" org-verbatim verbatim)
+ ("~" org-code verbatim)
+ ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))))
+ "Alist of characters and faces to emphasize text.
+Text starting and ending with a special character will be emphasized,
+for example *bold*, _underlined_ and /italic/. This variable sets the
+marker characters and the face to be used by font-lock for highlighting
+in Org-mode Emacs buffers.
+
+You need to reload Org or to restart Emacs after customizing this."
:group 'org-appearance
:set 'org-set-emph-re
+ :version "24.4"
+ :package-version '(Org . "8.0")
:type '(repeat
(list
(string :tag "Marker character")
(choice
(face :tag "Font-lock-face")
(plist :tag "Face property list"))
- (string :tag "HTML start tag")
- (string :tag "HTML end tag")
(option (const verbatim)))))
(defvar org-protecting-blocks
- '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R")
+ '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R")
"Blocks that contain text that is quoted, i.e. not processed as Org syntax.
This is needed for font-lock setup.")
@@ -3838,7 +4232,7 @@ Normal means, no org-mode-specific context."
(declare-function org-agenda-skip "org-agenda" ())
(declare-function
org-agenda-format-item "org-agenda"
- (extra txt &optional category tags dotime noprefix remove-re habitp))
+ (extra txt &optional level category tags dotime noprefix remove-re habitp))
(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
(declare-function org-agenda-change-all-lines "org-agenda"
(newhead hdmarker &optional fixface just-this))
@@ -3856,16 +4250,12 @@ Normal means, no org-mode-specific context."
(declare-function org-indent-mode "org-indent" (&optional arg))
(declare-function parse-time-string "parse-time" (string))
(declare-function org-attach-reveal "org-attach" (&optional if-exists))
-(declare-function org-export-latex-fix-inputenc "org-latex" ())
(declare-function orgtbl-send-table "org-table" (&optional maybe))
(defvar remember-data-file)
(defvar texmathp-why)
(declare-function speedbar-line-directory "speedbar" (&optional depth))
(declare-function table--at-cell-p "table" (position &optional object at-column))
-(defvar w3m-current-url)
-(defvar w3m-current-title)
-
(defvar org-latex-regexps)
;;; Autoload and prepare some org modules
@@ -3887,11 +4277,8 @@ Normal means, no org-mode-specific context."
"Detect the first line outside a table when searching from within it.
This works for both table types.")
-;; Autoload the functions in org-table.el that are needed by functions here.
-
-(eval-and-compile
- (org-autoload "org-table"
- '(org-table-begin org-table-blank-field org-table-end)))
+(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
+ "Detect a #+TBLFM line.")
;;;###autoload
(defun turn-on-orgtbl ()
@@ -3951,7 +4338,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(looking-at org-table-hline-regexp))
nil))
-(defvar org-table-clean-did-remove-column nil)
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
(save-excursion
@@ -3960,7 +4346,8 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(goto-char (point-min))
(while (re-search-forward org-table-any-line-regexp nil t)
(unless quietly
- (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))))
+ (message "Mapping tables: %d%%"
+ (floor (* 100.0 (point)) (buffer-size))))
(beginning-of-line 1)
(when (and (looking-at org-table-line-regexp)
;; Exclude tables in src/example/verbatim/clocktable blocks
@@ -3971,22 +4358,19 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(re-search-forward org-table-any-border-regexp nil 1))))
(unless quietly (message "Mapping tables: done")))
-;; Declare and autoload functions from org-exp.el & Co
-
-(declare-function org-default-export-plist "org-exp")
-(declare-function org-infile-export-plist "org-exp")
-(declare-function org-get-current-options "org-exp")
-
-;; Declare and autoload functions from org-agenda.el
-
-(eval-and-compile
- (org-autoload "org-agenda"
- '(org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))
-
(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
(declare-function org-clock-update-mode-line "org-clock" ())
(declare-function org-resolve-clocks "org-clock"
(&optional also-non-dangling-p prompt last-valid))
+
+(defun org-at-TBLFM-p (&optional pos)
+ "Return t when point (or POS) is in #+TBLFM line."
+ (save-excursion
+ (let ((pos pos)))
+ (goto-char (or pos (point)))
+ (beginning-of-line 1)
+ (looking-at org-TBLFM-regexp)))
+
(defvar org-clock-start-time)
(defvar org-clock-marker (make-marker)
"Marker recording the last clock-in.")
@@ -3995,15 +4379,10 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(defvar org-clock-heading ""
"The heading of the current clock entry.")
(defun org-clock-is-active ()
- "Return non-nil if clock is currently running.
-The return value is actually the clock marker."
+ "Return the buffer where the clock is currently running.
+Return nil if no clock is running."
(marker-buffer org-clock-marker))
-(eval-and-compile
- (org-autoload "org-clock" '(org-clock-remove-overlays
- org-clock-update-time-maybe
- org-clocktable-shift)))
-
(defun org-check-running-clock ()
"Check if the current buffer contains the running clock.
If yes, offer to stop it and to save the buffer with the changes."
@@ -4026,14 +4405,6 @@ If yes, offer to stop it and to save the buffer with the changes."
(add-hook 'org-mode-hook 'org-clock-load)
(add-hook 'kill-emacs-hook 'org-clock-save))
-;; Define the variable already here, to make sure we have it.
-(defvar org-indent-mode nil
- "Non-nil if Org-Indent mode is enabled.
-Use the command `org-indent-mode' to change this variable.")
-
-;; Autoload archiving code
-;; The stuff that is needed for cycling and tags has to be defined here.
-
(defgroup org-archive nil
"Options concerning archiving in Org-mode."
:tag "Org Archive"
@@ -4150,12 +4521,13 @@ Otherwise, these types are allowed:
inactive: only inactive timestamps (<...)
scheduled: only scheduled timestamps
deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+ :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline)
(const :tag "All timestamps" all)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
(const :tag "Only scheduled timestamps" scheduled)
- (const :tag "Only deadline timestamps" deadline))
+ (const :tag "Only deadline timestamps" deadline)
+ (const :tag "Only closed timestamps" closed))
:version "24.3"
:group 'org-sparse-trees)
@@ -4202,33 +4574,18 @@ Otherwise, these types are allowed:
(defalias 'org-advertized-archive-subtree 'org-archive-subtree)
-(eval-and-compile
- (org-autoload "org-archive"
- '(org-add-archive-files)))
-
-;; Autoload Column View Code
+;; Declare Column View Code
(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
(declare-function org-columns-get-format-and-top-level "org-colview" ())
(declare-function org-columns-compute "org-colview" (property))
-(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview")
- '(org-columns-number-to-string
- org-columns-get-format-and-top-level
- org-columns-compute
- org-columns-remove-overlays))
-
-;; Autoload ID code
+;; Declare ID code
(declare-function org-id-store-link "org-id")
(declare-function org-id-locations-load "org-id")
(declare-function org-id-locations-save "org-id")
(defvar org-id-track-globally)
-(org-autoload "org-id"
- '(org-id-new
- org-id-copy
- org-id-get-with-outline-path-completion
- org-id-get-with-outline-drilling))
;;; Variables for pre-computed regular expressions, all buffer local
@@ -4274,6 +4631,9 @@ Also put tags into group 4 if tags are present.")
(defvar org-deadline-time-regexp nil
"Matches the DEADLINE keyword together with a time stamp.")
(make-variable-buffer-local 'org-deadline-time-regexp)
+(defvar org-deadline-time-hour-regexp nil
+ "Matches the DEADLINE keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-deadline-time-hour-regexp)
(defvar org-deadline-line-regexp nil
"Matches the DEADLINE keyword and the rest of the line.")
(make-variable-buffer-local 'org-deadline-line-regexp)
@@ -4283,6 +4643,9 @@ Also put tags into group 4 if tags are present.")
(defvar org-scheduled-time-regexp nil
"Matches the SCHEDULED keyword together with a time stamp.")
(make-variable-buffer-local 'org-scheduled-time-regexp)
+(defvar org-scheduled-time-hour-regexp nil
+ "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
+(make-variable-buffer-local 'org-scheduled-time-hour-regexp)
(defvar org-closed-time-regexp nil
"Matches the CLOSED keyword together with a time stamp.")
(make-variable-buffer-local 'org-closed-time-regexp)
@@ -4357,6 +4720,8 @@ After a match, the following groups carry important information:
("noalign" org-startup-align-all-tables nil)
("inlineimages" org-startup-with-inline-images t)
("noinlineimages" org-startup-with-inline-images nil)
+ ("latexpreview" org-startup-with-latex-preview t)
+ ("nolatexpreview" org-startup-with-latex-preview nil)
("customtime" org-display-custom-times t)
("logdone" org-log-done time)
("lognotedone" org-log-done note)
@@ -4365,6 +4730,10 @@ After a match, the following groups carry important information:
("nolognoteclock-out" org-log-note-clock-out nil)
("logrepeat" org-log-repeat state)
("lognoterepeat" org-log-repeat note)
+ ("logdrawer" org-log-into-drawer t)
+ ("nologdrawer" org-log-into-drawer nil)
+ ("logstatesreversed" org-log-states-order-reversed t)
+ ("nologstatesreversed" org-log-states-order-reversed nil)
("nologrepeat" org-log-repeat nil)
("logreschedule" org-log-reschedule time)
("lognotereschedule" org-log-reschedule note)
@@ -4413,19 +4782,122 @@ means to push this value onto the list in the variable.")
"Regular expression for hiding blocks.")
(defconst org-heading-keyword-regexp-format
"^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching an headline with some keyword.
+ "Printf format for a regexp matching a headline with some keyword.
This regexp will match the headline of any node which has the
exact keyword that is put into the format. The keyword isn't in
any group by default, but the stars and the body are.")
(defconst org-heading-keyword-maybe-regexp-format
"^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching an headline, possibly with some keyword.
+ "Printf format for a regexp matching a headline, possibly with some keyword.
This regexp can match any headline with the specified keyword, or
without a keyword. The keyword isn't in any group by default,
but the stars and the body are.")
+(defcustom org-group-tags t
+ "When non-nil (the default), use group tags.
+This can be turned on/off through `org-toggle-tags-groups'."
+ :group 'org-tags
+ :group 'org-startup
+ :type 'boolean)
+
+(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
+
+(defun org-toggle-tags-groups ()
+ "Toggle support for group tags.
+Support for group tags is controlled by the option
+`org-group-tags', which is non-nil by default."
+ (interactive)
+ (setq org-group-tags (not org-group-tags))
+ (cond ((and (derived-mode-p 'org-agenda-mode)
+ org-group-tags)
+ (org-agenda-redo))
+ ((derived-mode-p 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode))))
+ (message "Groups tags support has been turned %s"
+ (if org-group-tags "on" "off")))
+
+(defun org-set-regexps-and-options-for-tags ()
+ "Precompute variables used for tags."
+ (when (derived-mode-p 'org-mode)
+ (org-set-local 'org-file-tags nil)
+ (let ((re (org-make-options-regexp '("FILETAGS" "TAGS")))
+ (splitre "[ \t]+")
+ (start 0)
+ tags ftags key value)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (setq key (upcase (org-match-string-no-properties 1))
+ value (org-match-string-no-properties 2))
+ (if (stringp value) (setq value (org-trim value)))
+ (cond
+ ((equal key "TAGS")
+ (setq tags (append tags (if tags '("\\n") nil)
+ (org-split-string value splitre))))
+ ((equal key "FILETAGS")
+ (when (string-match "\\S-" value)
+ (setq ftags
+ (append
+ ftags
+ (apply 'append
+ (mapcar (lambda (x) (org-split-string x ":"))
+ (org-split-string value)))))))))))
+ ;; Process the file tags.
+ (and ftags (org-set-local 'org-file-tags
+ (mapcar 'org-add-prop-inherited ftags)))
+ (org-set-local 'org-tag-groups-alist nil)
+ ;; Process the tags.
+ (when (and (not tags) org-tag-alist)
+ (setq tags
+ (mapcar
+ (lambda (tg) (cond ((eq (car tg) :startgroup) "{")
+ ((eq (car tg) :endgroup) "}")
+ ((eq (car tg) :grouptags) ":")
+ ((eq (car tg) :newline) "\n")
+ (t (concat (car tg)
+ (if (characterp (cdr tg))
+ (format "(%s)" (char-to-string (cdr tg))) "")))))
+ org-tag-alist)))
+ (let (tgs g)
+ (dolist (e tags)
+ (cond
+ ((equal e "{")
+ (progn (push '(:startgroup) tgs)
+ (when (equal (nth 1 tags) ":")
+ (push (list (replace-regexp-in-string
+ "(.+)$" "" (nth 0 tags)))
+ org-tag-groups-alist)
+ (setq g 0))))
+ ((equal e ":") (push '(:grouptags) tgs))
+ ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil)))
+ ((equal e "\\n") (push '(:newline) tgs))
+ ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
+ (push (cons (match-string 1 e)
+ (string-to-char (match-string 2 e)))
+ tgs)
+ (if (and g (> g 0))
+ (setcar org-tag-groups-alist
+ (append (car org-tag-groups-alist)
+ (list (match-string 1 e)))))
+ (if g (setq g (1+ g))))
+ (t (push (list e) tgs)
+ (if (and g (> g 0))
+ (setcar org-tag-groups-alist
+ (append (car org-tag-groups-alist) (list e))))
+ (if g (setq g (1+ g))))))
+ (org-set-local 'org-tag-alist nil)
+ (dolist (e tgs)
+ (or (and (stringp (car e))
+ (assoc (car e) org-tag-alist))
+ (push e org-tag-alist)))
+ ;; Return a list with tag variables
+ (list org-file-tags org-tag-alist org-tag-groups-alist)))))
+
+(defvar org-ota nil)
(defun org-set-regexps-and-options ()
- "Precompute regular expressions for current buffer."
+ "Precompute regular expressions used in the current buffer."
(when (derived-mode-p 'org-mode)
(org-set-local 'org-todo-kwd-alist nil)
(org-set-local 'org-todo-key-alist nil)
@@ -4436,27 +4908,43 @@ but the stars and the body are.")
(org-set-local 'org-todo-sets nil)
(org-set-local 'org-todo-log-states nil)
(org-set-local 'org-file-properties nil)
- (org-set-local 'org-file-tags nil)
(let ((re (org-make-options-regexp
- '("CATEGORY" "TODO" "COLUMNS"
- "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES"
- "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS"
- "OPTIONS")
+ '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE"
+ "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
+ "SETUPFILE" "OPTIONS")
"\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
(splitre "[ \t]+")
(scripts org-use-sub-superscripts)
- kwds kws0 kwsa key log value cat arch tags const links hw dws
- tail sep kws1 prio props ftags drawers beamer-p
- ext-setup-or-nil setup-contents (start 0))
+ kwds kws0 kwsa key log value cat arch const links hw dws
+ tail sep kws1 prio props drawers ext-setup-or-nil setup-contents
+ (start 0))
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
- (while (or (and ext-setup-or-nil
- (string-match re ext-setup-or-nil start)
- (setq start (match-end 0)))
- (and (setq ext-setup-or-nil nil start 0)
- (re-search-forward re nil t)))
+ (while
+ (or (and
+ ext-setup-or-nil
+ (not org-ota)
+ (let (ret)
+ (with-temp-buffer
+ (insert ext-setup-or-nil)
+ (let ((major-mode 'org-mode) org-ota)
+ (setq ret (save-match-data
+ (org-set-regexps-and-options-for-tags)))))
+ ;; Append setupfile tags to existing tags
+ (setq org-ota t)
+ (setq org-file-tags
+ (delq nil (append org-file-tags (nth 0 ret)))
+ org-tag-alist
+ (delq nil (append org-tag-alist (nth 1 ret)))
+ org-tag-groups-alist
+ (delq nil (append org-tag-groups-alist (nth 2 ret))))))
+ (and ext-setup-or-nil
+ (string-match re ext-setup-or-nil start)
+ (setq start (match-end 0)))
+ (and (setq ext-setup-or-nil nil start 0)
+ (re-search-forward re nil t)))
(setq key (upcase (match-string 1 ext-setup-or-nil))
value (org-match-string-no-properties 2 ext-setup-or-nil))
(if (stringp value) (setq value (org-trim value)))
@@ -4470,10 +4958,8 @@ but the stars and the body are.")
((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
;; general TODO-like setup
(push (cons (intern (downcase (match-string 1 key)))
- (org-split-string value splitre)) kwds))
- ((equal key "TAGS")
- (setq tags (append tags (if tags '("\\n") nil)
- (org-split-string value splitre))))
+ (org-split-string value splitre))
+ kwds))
((equal key "COLUMNS")
(org-set-local 'org-columns-default-format value))
((equal key "LINK")
@@ -4488,22 +4974,14 @@ but the stars and the body are.")
(setq props (org-update-property-plist (match-string 1 value)
(match-string 2 value)
props))))
- ((equal key "FILETAGS")
- (when (string-match "\\S-" value)
- (setq ftags
- (append
- ftags
- (apply 'append
- (mapcar (lambda (x) (org-split-string x ":"))
- (org-split-string value)))))))
((equal key "DRAWERS")
(setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
((equal key "CONSTANTS")
- (setq const (append const (org-split-string value splitre))))
+ (org-table-set-constants))
((equal key "STARTUP")
(let ((opts (org-split-string value splitre))
- l var val)
- (while (setq l (pop opts))
+ var val)
+ (dolist (l opts)
(when (setq l (assoc l org-startup-options))
(setq var (nth 1 l) val (nth 2 l))
(if (not (nth 3 l))
@@ -4516,12 +4994,12 @@ but the stars and the body are.")
(setq arch value)
(remove-text-properties 0 (length arch)
'(face t fontified t) arch))
- ((equal key "LATEX_CLASS")
- (setq beamer-p (equal value "beamer")))
((equal key "OPTIONS")
(if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value)
(setq scripts (read (match-string 2 value)))))
- ((equal key "SETUPFILE")
+ ((and (equal key "SETUPFILE")
+ ;; Prevent checking in Gnus messages
+ (not buffer-read-only))
(setq setup-contents (org-file-contents
(expand-file-name
(org-remove-double-quotes value))
@@ -4553,8 +5031,6 @@ but the stars and the body are.")
(org-set-local 'org-lowest-priority (nth 1 prio))
(org-set-local 'org-default-priority (nth 2 prio)))
(and props (org-set-local 'org-file-properties (nreverse props)))
- (and ftags (org-set-local 'org-file-tags
- (mapcar 'org-add-prop-inherited ftags)))
(and drawers (org-set-local 'org-drawers drawers))
(and arch (org-set-local 'org-archive-location arch))
(and links (setq org-link-abbrev-alist-local (nreverse links)))
@@ -4567,8 +5043,8 @@ but the stars and the body are.")
(default-value 'org-todo-keywords)))))
(setq kwds (reverse kwds)))
(setq kwds (nreverse kwds))
- (let (inter kws kw)
- (while (setq kws (pop kwds))
+ (let (inter kw)
+ (dolist (kws kwds)
(let ((kws (or
(run-hook-with-args-until-success
'org-todo-setup-filter-hook kws)
@@ -4605,33 +5081,6 @@ but the stars and the body are.")
org-todo-kwd-alist (nreverse org-todo-kwd-alist)
org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
- ;; Process the constants
- (when const
- (let (e cst)
- (while (setq e (pop const))
- (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
- (push (cons (match-string 1 e) (match-string 2 e)) cst)))
- (setq org-table-formula-constants-local cst)))
-
- ;; Process the tags.
- (when tags
- (let (e tgs)
- (while (setq e (pop tags))
- (cond
- ((equal e "{") (push '(:startgroup) tgs))
- ((equal e "}") (push '(:endgroup) tgs))
- ((equal e "\\n") (push '(:newline) tgs))
- ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
- (push (cons (match-string 1 e)
- (string-to-char (match-string 2 e)))
- tgs))
- (t (push (list e) tgs))))
- (org-set-local 'org-tag-alist nil)
- (while (setq e (pop tgs))
- (or (and (stringp (car e))
- (assoc (car e) org-tag-alist))
- (push e org-tag-alist)))))
-
;; Compute the regular expressions and other local variables.
;; Using `org-outline-regexp-bol' would complicate them much,
;; because of the fixed white space at the end of that string.
@@ -4673,9 +5122,9 @@ but the stars and the body are.")
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +"
;; Stats cookies can be stuck to body.
- "\\(?:\\[[0-9%%/]+\\] *\\)?"
+ "\\(?:\\[[0-9%%/]+\\] *\\)*"
"\\(%s\\)"
- "\\(?: *\\[[0-9%%/]+\\]\\)?"
+ "\\(?: *\\[[0-9%%/]+\\]\\)*"
"\\)"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
"[ \t]*$")
@@ -4688,12 +5137,18 @@ but the stars and the body are.")
org-deadline-regexp (concat "\\<" org-deadline-string)
org-deadline-time-regexp
(concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+ org-deadline-time-hour-regexp
+ (concat "\\<" org-deadline-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
org-deadline-line-regexp
(concat "\\<\\(" org-deadline-string "\\).*")
org-scheduled-regexp
(concat "\\<" org-scheduled-string)
org-scheduled-time-regexp
(concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+ org-scheduled-time-hour-regexp
+ (concat "\\<" org-scheduled-string
+ " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
org-closed-time-regexp
(concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
org-keyword-time-regexp
@@ -4717,21 +5172,17 @@ but the stars and the body are.")
org-all-time-keywords
(mapcar (lambda (w) (substring w 0 -1))
(list org-scheduled-string org-deadline-string
- org-clock-string org-closed-string))
- )
- (org-compute-latex-and-specials-regexp)
- (org-set-font-lock-defaults))))
+ org-clock-string org-closed-string)))
+ (setq org-ota nil)
+ (org-compute-latex-and-related-regexp))))
(defun org-file-contents (file &optional noerror)
"Return the contents of FILE, as a string."
- (if (or (not file)
- (not (file-readable-p file)))
- (if noerror
- (progn
- (message "Cannot read file \"%s\"" file)
- (ding) (sit-for 2)
- "")
- (error "Cannot read file \"%s\"" file))
+ (if (or (not file) (not (file-readable-p file)))
+ (if (not noerror)
+ (error "Cannot read file \"%s\"" file)
+ (message "Cannot read file \"%s\"" file)
+ "")
(with-temp-buffer
(insert-file-contents file)
(buffer-string))))
@@ -4761,9 +5212,9 @@ This will extract info from a string like \"WAIT(w@/!)\"."
(defun org-assign-fast-keys (alist)
"Assign fast keys to a keyword-key alist.
Respect keys that are already there."
- (let (new e (alt ?0))
- (while (setq e (pop alist))
- (if (or (memq (car e) '(:newline :endgroup :startgroup))
+ (let (new (alt ?0))
+ (dolist (e alist)
+ (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
(cdr e)) ;; Key already assigned.
(push e new)
(let ((clist (string-to-list (downcase (car e))))
@@ -4813,7 +5264,6 @@ This variable is set by `org-before-change-function'.
"Every change indicates that a table might need an update."
(setq org-table-may-need-update t))
(defvar org-mode-map)
-(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param.
(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param.
(defvar org-inhibit-logging nil) ; Dynamically-scoped param.
@@ -4834,7 +5284,7 @@ This variable is set by `org-before-change-function'.
(require 'easymenu)
(require 'overlay)
-(require 'org-macs)
+;; (require 'org-macs) moved higher up in the file before it is first used
(require 'org-entities)
;; (require 'org-compat) moved higher up in the file before it is first used
(require 'org-faces)
@@ -4842,15 +5292,10 @@ This variable is set by `org-before-change-function'.
(require 'org-pcomplete)
(require 'org-src)
(require 'org-footnote)
+(require 'org-macro)
;; babel
(require 'ob)
-(require 'ob-table)
-(require 'ob-lob)
-(require 'ob-ref)
-(require 'ob-tangle)
-(require 'ob-comint)
-(require 'ob-keys)
;;;###autoload
(define-derived-mode org-mode outline-mode "Org"
@@ -4887,8 +5332,9 @@ The following commands are available:
(define-key org-mode-map [menu-bar show] 'undefined))
(org-load-modules-maybe)
- (easy-menu-add org-org-menu)
- (easy-menu-add org-tbl-menu)
+ (when (featurep 'xemacs)
+ (easy-menu-add org-org-menu)
+ (easy-menu-add org-tbl-menu))
(org-install-agenda-files-menu)
(if org-descriptive-links (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-cwidth))
@@ -4910,13 +5356,19 @@ The following commands are available:
org-ellipsis)))
(if (stringp org-ellipsis) org-ellipsis "..."))))
(setq buffer-display-table org-display-table))
+ (org-set-regexps-and-options-for-tags)
(org-set-regexps-and-options)
+ (org-set-font-lock-defaults)
(when (and org-tag-faces (not org-tags-special-faces-re))
;; tag faces set outside customize.... force initialization.
(org-set-tag-faces 'org-tag-faces org-tag-faces))
;; Calc embedded
(org-set-local 'calc-embedded-open-mode "# ")
+ ;; Modify a few syntax entries
(modify-syntax-entry ?@ "w")
+ (modify-syntax-entry ?\" "\"")
+ (modify-syntax-entry ?\\ "_")
+ (modify-syntax-entry ?~ "_")
(if org-startup-truncated (setq truncate-lines t))
(when org-startup-indented (require 'org-indent) (org-indent-mode 1))
(org-set-local 'font-lock-unfontify-region-function
@@ -4927,18 +5379,25 @@ The following commands are available:
'local)
;; Check for running clock before killing a buffer
(org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ ;; Initialize macros templates.
+ (org-macro-initialize-templates)
+ ;; Initialize radio targets.
+ (org-update-radio-target-regexp)
;; Indentation.
(org-set-local 'indent-line-function 'org-indent-line)
(org-set-local 'indent-region-function 'org-indent-region)
- ;; Initialize radio targets.
- (org-update-radio-target-regexp)
;; Filling and auto-filling.
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
;; Beginning/end of defun
- (org-set-local 'beginning-of-defun-function 'org-back-to-heading)
- (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t)))
+ (org-set-local 'beginning-of-defun-function 'org-backward-element)
+ (org-set-local 'end-of-defun-function
+ (lambda ()
+ (if (not (org-at-heading-p))
+ (org-forward-element)
+ (org-forward-element)
+ (forward-char -1))))
;; Next error for sparse trees
(org-set-local 'next-error-function 'org-occur-next-match)
;; Make sure dependence stuff works reliably, even for users who set it
@@ -4972,8 +5431,7 @@ The following commands are available:
(org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
;; Emacs 22 deals with this through a special variable
(org-set-local 'outline-isearch-open-invisible-function
- (lambda (&rest ignore) (org-show-context 'isearch)))
- (org-add-hook 'isearch-mode-end-hook 'org-fix-ellipsis-at-bol 'append 'local))
+ (lambda (&rest ignore) (org-show-context 'isearch))))
;; Setup the pcomplete hooks
(set (make-local-variable 'pcomplete-command-completion-function)
@@ -4994,17 +5452,33 @@ The following commands are available:
(= (point-min) (point-max)))
(insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
- (and org-startup-with-beamer-mode (org-beamer-mode))
- (when org-startup-align-all-tables
- (let ((bmp (buffer-modified-p)))
- (org-table-map-tables 'org-table-align 'quietly)
- (set-buffer-modified-p bmp)))
- (when org-startup-with-inline-images
- (org-display-inline-images))
- (unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility)))
+ (org-unmodified
+ (and org-startup-with-beamer-mode (org-beamer-mode))
+ (when org-startup-align-all-tables
+ (org-table-map-tables 'org-table-align 'quietly))
+ (when org-startup-with-inline-images
+ (org-display-inline-images))
+ (when org-startup-with-latex-preview
+ (org-preview-latex-fragment))
+ (unless org-inhibit-startup-visibility-stuff
+ (org-set-startup-visibility))))
;; Try to set org-hide correctly
- (set-face-foreground 'org-hide (org-find-invisible-foreground)))
+ (let ((foreground (org-find-invisible-foreground)))
+ (if foreground
+ (set-face-foreground 'org-hide foreground))))
+
+;; Update `customize-package-emacs-version-alist'
+(add-to-list 'customize-package-emacs-version-alist
+ '(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
+ ("7.8.11" . "24.1") ("7.9.4" . "24.3")
+ ("8.2.6" . "24.4")))
+
+(defvar org-mode-transpose-word-syntax-table
+ (let ((st (make-syntax-table)))
+ (mapc (lambda(c) (modify-syntax-entry
+ (string-to-char (car c)) "w p" st))
+ org-emphasis-alist)
+ st))
(when (fboundp 'abbrev-table-put)
(abbrev-table-put org-mode-abbrev-table
@@ -5012,9 +5486,6 @@ The following commands are available:
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
-(defsubst org-fix-ellipsis-at-bol ()
- (save-excursion (goto-char (window-start)) (recenter 0)))
-
(defun org-find-invisible-foreground ()
(let ((candidates (remove
"unspecified-bg"
@@ -5029,15 +5500,23 @@ The following commands are available:
(list (face-foreground 'org-hide))))))
(car (remove nil candidates))))
-(defun org-current-time ()
- "Current time, possibly rounded to `org-time-stamp-rounding-minutes'."
- (if (> (car org-time-stamp-rounding-minutes) 1)
- (let ((r (car org-time-stamp-rounding-minutes))
- (time (decode-time)))
- (apply 'encode-time
- (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
- (nthcdr 2 time))))
- (current-time)))
+(defun org-current-time (&optional rounding-minutes past)
+ "Current time, possibly rounded to ROUNDING-MINUTES.
+When ROUNDING-MINUTES is not an integer, fall back on the car of
+`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure
+the rounding returns a past time."
+ (let ((r (or (and (integerp rounding-minutes) rounding-minutes)
+ (car org-time-stamp-rounding-minutes)))
+ (time (decode-time)) res)
+ (if (< r 1)
+ (current-time)
+ (setq res
+ (apply 'encode-time
+ (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r)))))
+ (nthcdr 2 time))))
+ (if (and past (< (org-float-time (time-subtract (current-time) res)) 0))
+ (seconds-to-time (- (org-float-time res) (* r 60)))
+ res))))
(defun org-today ()
"Return today date, considering `org-extend-today-until'."
@@ -5088,11 +5567,8 @@ Here is what the match groups contain after a match:
(defvar org-any-link-re nil
"Regular expression matching any link.")
-(defcustom org-match-sexp-depth 3
- "Number of stacked braces for sub/superscript matching.
-This has to be set before loading org.el to be effective."
- :group 'org-export-translation ; ??????????????????????????/
- :type 'integer)
+(defconst org-match-sexp-depth 3
+ "Number of stacked braces for sub/superscript matching.")
(defun org-create-multibrace-regexp (left right n)
"Create a regular expression which will match a balanced sexp.
@@ -5114,7 +5590,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-regexp
(concat
- "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(\\S-\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
"\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
@@ -5124,7 +5600,7 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defvar org-match-substring-with-braces-regexp
(concat
- "\\([^\\]\\|^\\)\\([_^]\\)\\("
+ "\\(\\S-\\)\\([_^]\\)\\("
"\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
@@ -5132,59 +5608,55 @@ stacked delimiters is N. Escaping delimiters is not possible."
(defun org-make-link-regexps ()
"Update the link regular expressions.
This should be called after the variable `org-link-types' has changed."
- (setq org-link-types-re
- (concat
- "\\`\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):")
- org-link-re-with-space
- (concat
- "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
- "\\([^" org-non-link-chars " ]"
- "[^" org-non-link-chars "]*"
- "[^" org-non-link-chars " ]\\)>?")
- org-link-re-with-space2
- (concat
- "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
- "\\([^" org-non-link-chars " ]"
- "[^\t\n\r]*"
- "[^" org-non-link-chars " ]\\)>?")
- org-link-re-with-space3
- (concat
- "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
- "\\([^" org-non-link-chars " ]"
- "[^\t\n\r]*\\)")
- org-angle-link-re
- (concat
- "<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
- "\\([^" org-non-link-chars " ]"
- "[^" org-non-link-chars "]*"
- "\\)>")
- org-plain-link-re
- (concat
- "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):"
- (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
- ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
- org-bracket-link-regexp
- "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
- org-bracket-link-analytic-regexp
- (concat
- "\\[\\["
- "\\(\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):\\)?"
- "\\([^]]+\\)"
- "\\]"
- "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
- "\\]")
- org-bracket-link-analytic-regexp++
- (concat
- "\\[\\["
- "\\(\\(" (mapconcat 'regexp-quote (cons "coderef" org-link-types) "\\|") "\\):\\)?"
- "\\([^]]+\\)"
- "\\]"
- "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
- "\\]")
- org-any-link-re
- (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
- org-angle-link-re "\\)\\|\\("
- org-plain-link-re "\\)")))
+ (let ((types-re (regexp-opt org-link-types t)))
+ (setq org-link-types-re
+ (concat "\\`" types-re ":")
+ org-link-re-with-space
+ (concat "<?" types-re ":"
+ "\\([^" org-non-link-chars " ]"
+ "[^" org-non-link-chars "]*"
+ "[^" org-non-link-chars " ]\\)>?")
+ org-link-re-with-space2
+ (concat "<?" types-re ":"
+ "\\([^" org-non-link-chars " ]"
+ "[^\t\n\r]*"
+ "[^" org-non-link-chars " ]\\)>?")
+ org-link-re-with-space3
+ (concat "<?" types-re ":"
+ "\\([^" org-non-link-chars " ]"
+ "[^\t\n\r]*\\)")
+ org-angle-link-re
+ (concat "<" types-re ":"
+ "\\([^" org-non-link-chars " ]"
+ "[^" org-non-link-chars "]*"
+ "\\)>")
+ org-plain-link-re
+ (concat
+ "\\<" types-re ":"
+ (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
+ ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
+ org-bracket-link-regexp
+ "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
+ org-bracket-link-analytic-regexp
+ (concat
+ "\\[\\["
+ "\\(" types-re ":\\)?"
+ "\\([^]]+\\)"
+ "\\]"
+ "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
+ "\\]")
+ org-bracket-link-analytic-regexp++
+ (concat
+ "\\[\\["
+ "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?"
+ "\\([^]]+\\)"
+ "\\]"
+ "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
+ "\\]")
+ org-any-link-re
+ (concat "\\(" org-bracket-link-regexp "\\)\\|\\("
+ org-angle-link-re "\\)\\|\\("
+ org-plain-link-re "\\)"))))
(org-make-link-regexps)
@@ -5223,25 +5695,31 @@ The time stamps may be either active or inactive.")
"Run through the buffer and add overlays to emphasized strings."
(let (rtn a)
(while (and (not rtn) (re-search-forward org-emph-re limit t))
- (if (not (= (char-after (match-beginning 3))
- (char-after (match-beginning 4))))
- (progn
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 4 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(font-lock-multiline t org-emphasis t))
- (when org-hide-emphasis-markers
- (add-text-properties (match-end 4) (match-beginning 5)
- '(invisible org-link))
- (add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link)))))
- (backward-char 1))
+ (let* ((border (char-after (match-beginning 3)))
+ (bre (regexp-quote (char-to-string border))))
+ (if (and (not (= border (char-after (match-beginning 4))))
+ (not (save-match-data
+ (string-match (concat bre ".*" bre)
+ (replace-regexp-in-string
+ "\n" " "
+ (substring (match-string 2) 1 -1))))))
+ (progn
+ (setq rtn t)
+ (setq a (assoc (match-string 3) org-emphasis-alist))
+ (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
+ 'face
+ (nth 1 a))
+ (and (nth 2 a)
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ '(font-lock-multiline t org-emphasis t))
+ (when org-hide-emphasis-markers
+ (add-text-properties (match-end 4) (match-beginning 5)
+ '(invisible org-link))
+ (add-text-properties (match-beginning 3) (match-end 3)
+ '(invisible org-link))))))
+ (goto-char (1+ (match-beginning 0))))
rtn))
(defun org-emphasize (&optional char)
@@ -5249,36 +5727,27 @@ The time stamps may be either active or inactive.")
If there is an active region, change that region to a new emphasis.
If there is no region, just insert the marker characters and position
the cursor between them.
-CHAR should be either the marker character, or the first character of the
-HTML tag associated with that emphasis. If CHAR is a space, the means
-to remove the emphasis of the selected region.
-If char is not given (for example in an interactive call) it
-will be prompted for."
+CHAR should be the marker character. If it is a space, it means to
+remove the emphasis of the selected region.
+If CHAR is not given (for example in an interactive call) it will be
+prompted for."
(interactive)
- (let ((eal org-emphasis-alist) e det
- (erc org-emphasis-regexp-components)
+ (let ((erc org-emphasis-regexp-components)
(prompt "")
- (string "") beg end move tag c s)
+ (string "") beg end move c s)
(if (org-region-active-p)
(setq beg (region-beginning) end (region-end)
string (buffer-substring beg end))
(setq move t))
- (while (setq e (pop eal))
- (setq tag (car (org-split-string (nth 2 e) "[ <>/]+"))
- c (aref tag 0))
- (push (cons c (string-to-char (car e))) det)
- (setq prompt (concat prompt (format " [%s%c]%s" (car e) c
- (substring tag 1)))))
- (setq det (nreverse det))
(unless char
- (message "%s" (concat "Emphasis marker or tag:" prompt))
+ (message "Emphasis marker or tag: [%s]"
+ (mapconcat (lambda(e) (car e)) org-emphasis-alist ""))
(setq char (read-char-exclusive)))
- (setq char (or (cdr (assoc char det)) char))
(if (equal char ?\ )
(setq s "" move nil)
(unless (assoc (char-to-string char) org-emphasis-alist)
- (error "No such emphasis marker: \"%c\"" char))
+ (user-error "No such emphasis marker: \"%c\"" char))
(setq s (char-to-string char)))
(while (and (> (length string) 1)
(equal (substring string 0 1) (substring string -1))
@@ -5305,17 +5774,19 @@ will be prompted for."
(defun org-activate-plain-links (limit)
"Run through the buffer and add overlays to links."
- (let (f)
+ (let (f hl)
(when (and (re-search-forward (concat org-plain-link-re) limit t)
(not (org-in-src-block-p)))
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(setq f (get-text-property (match-beginning 0) 'face))
- (unless (or (org-in-src-block-p)
- (eq f 'org-tag)
- (and (listp f) (memq 'org-tag f)))
+ (setq hl (org-match-string-no-properties 0))
+ (if (or (eq f 'org-tag)
+ (and (listp f) (memq 'org-tag f)))
+ nil
(add-text-properties (match-beginning 0) (match-end 0)
(list 'mouse-face 'highlight
'face 'org-link
+ 'htmlize-link `(:uri ,hl)
'keymap org-mouse-map))
(org-rear-nonsticky-at (match-end 0)))
t)))
@@ -5349,7 +5820,7 @@ by a #."
(error (message "org-mode fontification error"))))
(defun org-fontify-meta-lines-and-blocks-1 (limit)
- "Fontify #+ lines and blocks, in the correct ways."
+ "Fontify #+ lines and blocks."
(let ((case-fold-search t))
(if (re-search-forward
"^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
@@ -5363,7 +5834,7 @@ by a #."
(dc3 (downcase (match-string 3)))
end end1 quoting block-type ovl)
(cond
- ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:"))
+ ((member dc1 '("+html:" "+ascii:" "+latex:"))
;; a single line of backend-specific content
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
(remove-text-properties (match-beginning 0) (match-end 0)
@@ -5420,7 +5891,7 @@ by a #."
((member dc1 '("+title:" "+author:" "+email:" "+date:"))
(add-text-properties
beg (match-end 3)
- (if (member (intern (substring dc1 0 -1)) org-hidden-keywords)
+ (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
'(font-lock-fontified t invisible t)
'(font-lock-fontified t face org-document-info-keyword)))
(add-text-properties
@@ -5482,17 +5953,16 @@ by a #."
"Run through the buffer and add overlays to bracketed links."
(if (and (re-search-forward org-bracket-link-regexp limit t)
(not (org-in-src-block-p)))
- (let* ((help (concat "LINK: "
- (org-match-string-no-properties 1)))
- ;; FIXME: above we should remove the escapes.
- ;; but that requires another match, protecting match data,
- ;; a lot of overhead for font-lock.
+ (let* ((hl (org-match-string-no-properties 1))
+ (help (concat "LINK: " (save-match-data (org-link-unescape hl))))
(ip (org-maybe-intangible
(list 'invisible 'org-link
'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help)))
+ 'font-lock-multiline t 'help-echo help
+ 'htmlize-link `(:uri ,hl))))
(vp (list 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help)))
+ 'font-lock-multiline t 'help-echo help
+ 'htmlize-link `(:uri ,hl))))
;; We need to remove the invisible property here. Table narrowing
;; may have made some of this invisible.
(org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
@@ -5573,97 +6043,55 @@ by a #."
(goto-char e)
t)))
-(defvar org-latex-and-specials-regexp nil
- "Regular expression for highlighting export special stuff.")
+(defvar org-latex-and-related-regexp nil
+ "Regular expression for highlighting LaTeX, entities and sub/superscript.")
(defvar org-match-substring-regexp)
(defvar org-match-substring-with-braces-regexp)
-;; This should be with the exporter code, but we also use if for font-locking
-(defconst org-export-html-special-string-regexps
- '(("\\\\-" . "&shy;")
- ("---\\([^-]\\)" . "&mdash;\\1")
- ("--\\([^-]\\)" . "&ndash;\\1")
- ("\\.\\.\\." . "&hellip;"))
- "Regular expressions for special string conversion.")
-
-
-(defun org-compute-latex-and-specials-regexp ()
- "Compute regular expression for stuff treated specially by exporters."
- (if (not org-highlight-latex-fragments-and-specials)
- (org-set-local 'org-latex-and-specials-regexp nil)
- (require 'org-exp)
- (let*
- ((matchers (plist-get org-format-latex-options :matchers))
- (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x))
- org-latex-regexps)))
- (org-export-allow-BIND nil)
- (options (org-combine-plists (org-default-export-plist)
- (org-infile-export-plist)))
- (org-export-with-sub-superscripts (plist-get options :sub-superscript))
- (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments))
- (org-export-with-TeX-macros (plist-get options :TeX-macros))
- (org-export-html-expand (plist-get options :expand-quoted-html))
- (org-export-with-special-strings (plist-get options :special-strings))
- (re-sub
- (cond
- ((equal org-export-with-sub-superscripts '{})
- (list org-match-substring-with-braces-regexp))
- (org-export-with-sub-superscripts
- (list org-match-substring-regexp))))
- (re-latex
- (if org-export-with-LaTeX-fragments
- (mapcar (lambda (x) (nth 1 x)) latexs)))
- (re-macros
- (if org-export-with-TeX-macros
- (list (concat "\\\\"
- (regexp-opt
- (append
-
- (delq nil
- (mapcar 'car-safe
- (append org-entities-user
- org-entities)))
- (if (boundp 'org-latex-entities)
- (mapcar (lambda (x)
- (or (car-safe x) x))
- org-latex-entities)
- nil))
- 'words))) ; FIXME
- ))
- ;; (list "\\\\\\(?:[a-zA-Z]+\\)")))
- (re-special (if org-export-with-special-strings
- (mapcar (lambda (x) (car x))
- org-export-html-special-string-regexps)))
- (re-rest
- (delq nil
- (list
- (if org-export-html-expand "@<[^>\n]+>")
- ))))
- (org-set-local
- 'org-latex-and-specials-regexp
- (mapconcat 'identity (append re-latex re-sub re-macros re-special
- re-rest) "\\|")))))
-
-(defun org-do-latex-and-special-faces (limit)
- "Run through the buffer and add overlays to links."
- (when org-latex-and-specials-regexp
- (let (rtn d)
- (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp
- limit t))
- (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0))
- 'face))
- '(org-code org-verbatim underline)))
- (progn
- (setq rtn t
- d (cond ((member (char-after (1+ (match-beginning 0)))
- '(?_ ?^)) 1)
- (t 0)))
- (font-lock-prepend-text-property
- (+ d (match-beginning 0)) (match-end 0)
- 'face 'org-latex-and-export-specials)
- (add-text-properties (+ d (match-beginning 0)) (match-end 0)
- '(font-lock-multiline t)))))
- rtn)))
+(defun org-compute-latex-and-related-regexp ()
+ "Compute regular expression for LaTeX, entities and sub/superscript.
+Result depends on variable `org-highlight-latex-and-related'."
+ (org-set-local
+ 'org-latex-and-related-regexp
+ (let* ((re-sub
+ (cond ((not (memq 'script org-highlight-latex-and-related)) nil)
+ ((eq org-use-sub-superscripts '{})
+ (list org-match-substring-with-braces-regexp))
+ (org-use-sub-superscripts (list org-match-substring-regexp))))
+ (re-latex
+ (when (memq 'latex org-highlight-latex-and-related)
+ (let ((matchers (plist-get org-format-latex-options :matchers)))
+ (delq nil
+ (mapcar (lambda (x)
+ (and (member (car x) matchers) (nth 1 x)))
+ org-latex-regexps)))))
+ (re-entities
+ (when (memq 'entities org-highlight-latex-and-related)
+ (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))))
+ (mapconcat 'identity (append re-latex re-entities re-sub) "\\|"))))
+
+(defun org-do-latex-and-related (limit)
+ "Highlight LaTeX snippets and environments, entities and sub/superscript.
+LIMIT bounds the search for syntax to highlight. Stop at first
+highlighted object, if any. Return t if some highlighting was
+done, nil otherwise."
+ (when (org-string-nw-p org-latex-and-related-regexp)
+ (catch 'found
+ (while (re-search-forward org-latex-and-related-regexp limit t)
+ (unless (memq (car-safe (get-text-property (1+ (match-beginning 0))
+ 'face))
+ '(org-code org-verbatim underline))
+ (let ((offset (if (memq (char-after (1+ (match-beginning 0)))
+ '(?_ ?^))
+ 1
+ 0)))
+ (font-lock-prepend-text-property
+ (+ offset (match-beginning 0)) (match-end 0)
+ 'face 'org-latex-and-related)
+ (add-text-properties (+ offset (match-beginning 0)) (match-end 0)
+ '(font-lock-multiline t)))
+ (throw 'found t)))
+ nil)))
(defun org-restart-font-lock ()
"Restart `font-lock-mode', to force refontification."
@@ -5673,13 +6101,17 @@ by a #."
(defun org-all-targets (&optional radio)
"Return a list of all targets in this file.
-With optional argument RADIO, only find radio targets."
- (let ((re (if radio org-radio-target-regexp org-target-regexp))
- rtn)
+When optional argument RADIO is non-nil, only find radio
+targets."
+ (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn)
(save-excursion
(goto-char (point-min))
(while (re-search-forward re nil t)
- (add-to-list 'rtn (downcase (org-match-string-no-properties 1))))
+ ;; Make sure point is really within the object.
+ (backward-char)
+ (let ((obj (org-element-context)))
+ (when (memq (org-element-type obj) '(radio-target target))
+ (add-to-list 'rtn (downcase (org-element-property :value obj))))))
rtn)))
(defun org-make-target-link-regexp (targets)
@@ -5688,7 +6120,7 @@ The regular expression finds the targets also if there is a line break
between words."
(and targets
(concat
- "\\<\\("
+ "\\_<\\("
(mapconcat
(lambda (x)
(setq x (regexp-quote x))
@@ -5697,7 +6129,7 @@ between words."
x)
targets
"\\|")
- "\\)\\>")))
+ "\\)\\_>")))
(defun org-activate-tags (limit)
(if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t)
@@ -5711,18 +6143,44 @@ between words."
(defun org-outline-level ()
"Compute the outline level of the heading at point.
-This function assumes that the cursor is at the beginning of a line matched
-by `outline-regexp'. Otherwise it returns garbage.
If this is called at a normal headline, the level is the number of stars.
Use `org-reduced-level' to remove the effect of `org-odd-levels'."
(save-excursion
- (looking-at org-outline-regexp)
- (1- (- (match-end 0) (match-beginning 0)))))
+ (if (not (condition-case nil
+ (org-back-to-heading t)
+ (error nil)))
+ 0
+ (looking-at org-outline-regexp)
+ (1- (- (match-end 0) (match-beginning 0))))))
(defvar org-font-lock-keywords nil)
-(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
- "Regular expression matching a property line.")
+(defsubst org-re-property (property &optional literal allow-null)
+ "Return a regexp matching a PROPERTY line.
+
+When optional argument LITERAL is non-nil, do not quote PROPERTY.
+This is useful when PROPERTY is a regexp. When ALLOW-NULL is
+non-nil, match properties even without a value.
+
+Match group 3 is set to the value when it exists. If there is no
+value and ALLOW-NULL is non-nil, it is set to the empty string."
+ (concat
+ "^\\(?4:[ \t]*\\)"
+ (format "\\(?1::\\(?2:%s\\):\\)"
+ (if literal property (regexp-quote property)))
+ (if allow-null
+ "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$"
+ "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))
+
+(defconst org-property-re
+ (org-re-property ".*?" 'literal t)
+ "Regular expression matching a property line.
+There are four matching groups:
+1: :PROPKEY: including the leading and trailing colon,
+2: PROPKEY without the leading and trailing colon,
+3: PROPVAL without leading or trailing spaces,
+4: the indentation of the current line,
+5: trailing whitespace.")
(defvar org-font-lock-hook nil
"Functions to be called for special font lock stuff.")
@@ -5770,12 +6228,17 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Links
(if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
(if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
- (if (memq 'plain lk) '(org-activate-plain-links))
+ (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
(if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
(if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
(if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
(if (memq 'footnote lk) '(org-activate-footnote-links))
+ ;; Targets.
+ (list org-any-target-regexp '(0 'org-target t))
+ ;; Diary sexps.
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
+ ;; Macro
+ '("{{{.+}}}" (0 'org-macro t))
'(org-hide-wide-columns (0 nil append))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
@@ -5794,6 +6257,12 @@ needs to be inserted at a specific position in the font-lock sequence.")
'(org-font-lock-add-priority-faces)
;; Tags
'(org-font-lock-add-tag-faces)
+ ;; Tags groups
+ (if (and org-group-tags org-tag-groups-alist)
+ (list (concat org-outline-regexp-bol ".+\\(:"
+ (regexp-opt (mapcar 'car org-tag-groups-alist))
+ ":\\).*$")
+ '(1 'org-tag-group prepend)))
;; Special keywords
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
@@ -5819,7 +6288,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\(.*:" org-archive-tag ":.*\\)")
'(1 'org-archived prepend))
;; Specials
- '(org-do-latex-and-special-faces)
+ '(org-do-latex-and-related)
'(org-fontify-entities)
'(org-raise-scripts)
;; Code
@@ -5831,8 +6300,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
"\\)"))
'(2 'org-special-keyword t))
;; Blocks and meta lines
- '(org-fontify-meta-lines-and-blocks)
- )))
+ '(org-fontify-meta-lines-and-blocks))))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
(run-hooks 'org-font-lock-set-keywords-hook)
;; Now set the full font-lock-keywords
@@ -5847,11 +6315,11 @@ needs to be inserted at a specific position in the font-lock sequence.")
(org-set-local 'org-pretty-entities (not org-pretty-entities))
(org-restart-font-lock)
(if org-pretty-entities
- (message "Entities are displayed as UTF8 characters")
+ (message "Entities are now displayed as UTF8 characters")
(save-restriction
(widen)
(org-decompose-region (point-min) (point-max))
- (message "Entities are displayed plain"))))
+ (message "Entities are now displayed as plain text"))))
(defvar org-custom-properties-overlays nil
"List of overlays used for custom properties.")
@@ -5907,7 +6375,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(insert s)
(let ((org-odd-levels-only odd-levels))
(org-mode)
- (font-lock-fontify-buffer)
+ (org-font-lock-ensure)
(buffer-string))))
(defvar org-m nil)
@@ -5960,10 +6428,10 @@ When FACE-OR-COLOR is not a string, just return it."
(add-text-properties
(match-beginning 0) (match-end 0)
(list 'face (or (org-face-from-face-or-color
- 'priority 'org-special-keyword
+ 'priority 'org-priority
(cdr (assoc (char-after (match-beginning 1))
org-priority-faces)))
- 'org-special-keyword)
+ 'org-priority)
'font-lock-fontified t)))))
(defun org-get-tag-face (kwd)
@@ -6021,10 +6489,10 @@ and subscripts."
(keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
(goto-char (point-at-bol))
(setq table-p (org-looking-at-p org-table-dataline-regexp)
- comment-p (org-looking-at-p "[ \t]*#"))
+ comment-p (org-looking-at-p "^[ \t]*#[ +]"))
(goto-char pos)
- ;; FIXME: Should we go back one character here, for a_b^c
- ;; (goto-char (1- pos)) ;????????????????????
+ ;; Handle a_b^c
+ (if (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
(if (or comment-p emph-p link-p keyw-p)
t
(put-text-property (match-beginning 3) (match-end 0)
@@ -6052,11 +6520,18 @@ and subscripts."
(defvar org-cycle-global-status nil)
(make-variable-buffer-local 'org-cycle-global-status)
+(put 'org-cycle-global-status 'org-state t)
(defvar org-cycle-subtree-status nil)
(make-variable-buffer-local 'org-cycle-subtree-status)
+(put 'org-cycle-subtree-status 'org-state t)
(defvar org-inlinetask-min-level)
+(defun org-unlogged-message (&rest args)
+ "Display a message, but avoid logging it in the *Messages* buffer."
+ (let ((message-log-max nil))
+ (apply 'message args)))
+
;;;###autoload
(defun org-cycle (&optional arg)
"TAB-action and visibility cycling for Org-mode.
@@ -6142,16 +6617,19 @@ in special contexts.
((equal arg '(16))
(setq last-command 'dummy)
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties"))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64))
(show-all)
- (message "Entire buffer visible, including drawers"))
+ (org-unlogged-message "Entire buffer visible, including drawers"))
+
+ ;; Try cdlatex TAB completion
+ ((org-try-cdlatex-tab))
;; Table: enter it or move to the next field.
((org-at-table-p 'any)
(if (org-at-table.el-p)
- (message "Use C-c ' to edit table.el tables")
+ (message "%s" "Use C-c ' to edit table.el tables")
(if arg (org-table-edit-field t)
(org-table-justify-field-maybe)
(call-interactively 'org-table-next-field))))
@@ -6184,8 +6662,6 @@ in special contexts.
(or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol))))
(org-inlinetask-toggle-visibility))
- ((org-try-cdlatex-tab))
-
;; At an item/headline: delegate to `org-cycle-internal-local'.
((and (or (and org-cycle-include-plain-lists (org-at-item-p))
(save-excursion (beginning-of-line 1)
@@ -6233,9 +6709,9 @@ in special contexts.
;; We just created the overview - now do table of contents
;; This can be slow in very large buffers, so indicate action
(run-hook-with-args 'org-pre-cycle-hook 'contents)
- (unless ga (message "CONTENTS..."))
+ (unless ga (org-unlogged-message "CONTENTS..."))
(org-content)
- (unless ga (message "CONTENTS...done"))
+ (unless ga (org-unlogged-message "CONTENTS...done"))
(setq org-cycle-global-status 'contents)
(run-hook-with-args 'org-cycle-hook 'contents))
@@ -6244,7 +6720,7 @@ in special contexts.
;; We just showed the table of contents - now show everything
(run-hook-with-args 'org-pre-cycle-hook 'all)
(show-all)
- (unless ga (message "SHOW ALL"))
+ (unless ga (org-unlogged-message "SHOW ALL"))
(setq org-cycle-global-status 'all)
(run-hook-with-args 'org-cycle-hook 'all))
@@ -6252,10 +6728,13 @@ in special contexts.
;; Default action: go to overview
(run-hook-with-args 'org-pre-cycle-hook 'overview)
(org-overview)
- (unless ga (message "OVERVIEW"))
+ (unless ga (org-unlogged-message "OVERVIEW"))
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))))
+(defvar org-called-with-limited-levels nil
+ "Non-nil when `org-with-limited-levels' is currently active.")
+
(defun org-cycle-internal-local ()
"Do the local cycling action."
(let ((goal-column 0) eoh eol eos has-children children-skipped struct)
@@ -6271,7 +6750,8 @@ in special contexts.
(setq has-children (org-list-has-child-p (point) struct)))
(org-back-to-heading)
(setq eoh (save-excursion (outline-end-of-heading) (point)))
- (setq eos (save-excursion (1- (org-end-of-subtree t t))))
+ (setq eos (save-excursion (org-end-of-subtree t t)
+ (when (bolp) (backward-char)) (point)))
(setq has-children
(or (save-excursion
(let ((level (funcall outline-level)))
@@ -6298,7 +6778,7 @@ in special contexts.
;; Nothing is hidden behind this heading
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'empty))
- (message "EMPTY ENTRY")
+ (org-unlogged-message "EMPTY ENTRY")
(setq org-cycle-subtree-status nil)
(save-excursion
(goto-char eos)
@@ -6332,8 +6812,8 @@ in special contexts.
(end (org-list-get-bottom-point struct)))
(mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
(org-list-get-all-items (point) struct prevs))
- (goto-char end))))))
- (message "CHILDREN")
+ (goto-char (if (< end eos) end eos)))))))
+ (org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
@@ -6349,7 +6829,8 @@ in special contexts.
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
(outline-flag-region eoh eos nil)
- (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (org-unlogged-message
+ (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
(setq org-cycle-subtree-status 'subtree)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'subtree)))
@@ -6357,7 +6838,7 @@ in special contexts.
;; Default action: hide the subtree.
(run-hook-with-args 'org-pre-cycle-hook 'folded)
(outline-flag-region eoh eos t)
- (message "FOLDED")
+ (org-unlogged-message "FOLDED")
(setq org-cycle-subtree-status 'folded)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'folded))))))
@@ -6377,7 +6858,7 @@ With a numeric prefix, show all headlines up to that level."
(setq org-cycle-global-status 'contents))
((equal arg '(4))
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties."))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
(t
(org-cycle '(4))))))
@@ -6385,10 +6866,12 @@ With a numeric prefix, show all headlines up to that level."
"Set the visibility required by startup options and properties."
(cond
((eq org-startup-folded t)
- (org-cycle '(4)))
+ (org-overview))
((eq org-startup-folded 'content)
- (let ((this-command 'org-cycle) (last-command 'org-cycle))
- (org-cycle '(4)) (org-cycle '(4)))))
+ (org-content))
+ ((or (eq org-startup-folded 'showeverything)
+ (eq org-startup-folded nil))
+ (show-all)))
(unless (eq org-startup-folded 'showeverything)
(if org-hide-block-startup (org-hide-block-all))
(org-set-visibility-according-to-property 'no-cleanup)
@@ -6433,26 +6916,26 @@ With a numeric prefix, show all headlines up to that level."
;; buffers, where outline-regexp is needed.
(defun org-overview ()
"Switch to overview mode, showing only top-level headlines.
-Really, this shows all headlines with level equal or greater than the level
+This shows all headlines with a level equal or greater than the level
of the first headline in the buffer. This is important, because if the
first headline is not level one, then (hide-sublevels 1) gives confusing
results."
(interactive)
- (let ((l (org-current-line))
- (level (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (concat "^" outline-regexp) nil t)
- (progn
- (goto-char (match-beginning 0))
- (funcall outline-level))))))
- (and level (hide-sublevels level))
- (recenter '(4))
- (org-goto-line l)))
+ (save-excursion
+ (let ((level
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" outline-regexp) nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (funcall outline-level))))))
+ (and level (hide-sublevels level)))))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
With numerical argument N, show content up to level N."
(interactive "P")
+ (org-overview)
(save-excursion
;; Visit all headings and show their offspring
(and (integerp arg) (org-overview))
@@ -6468,7 +6951,6 @@ With numerical argument N, show content up to level N."
(show-branches))
(if (bobp) (throw 'exit nil))))))
-
(defun org-optimize-window-after-visibility-change (state)
"Adjust the window after a change in outline visibility.
This function is the default value of the hook `org-cycle-hook'."
@@ -6611,6 +7093,21 @@ open and agenda-wise Org files."
(while (re-search-forward org-drawer-regexp end t)
(org-flag-drawer t))))))
+(defun org-cycle-hide-inline-tasks (state)
+ "Re-hide inline tasks when switching to 'contents or 'children
+visibility state."
+ (case state
+ (contents
+ (when (org-bound-and-true-p org-inlinetask-min-level)
+ (hide-sublevels (1- org-inlinetask-min-level))))
+ (children
+ (when (featurep 'org-inlinetask)
+ (save-excursion
+ (while (and (outline-next-heading)
+ (org-inlinetask-at-task-p))
+ (org-inlinetask-toggle-visibility)
+ (org-inlinetask-goto-end)))))))
+
(defun org-flag-drawer (flag)
"When FLAG is non-nil, hide the drawer we are within.
Otherwise make it visible."
@@ -6622,20 +7119,18 @@ Otherwise make it visible."
"^[ \t]*:END:"
(save-excursion (outline-next-heading) (point)) t)
(outline-flag-region b (point-at-eol) flag)
- (error ":END: line missing at position %s" b))))))
+ (user-error ":END: line missing at position %s" b))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
(pos-visible-in-window-p
(save-excursion (org-end-of-subtree t) (point))))
-(defun org-first-headline-recenter (&optional N)
- "Move cursor to the first headline and recenter the headline.
-Optional argument N means put the headline into the Nth line of the window."
+(defun org-first-headline-recenter ()
+ "Move cursor to the first headline and recenter the headline."
(goto-char (point-min))
(when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (beginning-of-line)
- (recenter (prefix-numeric-value N))))
+ (set-window-start (selected-window) (point-at-bol))))
;;; Saving and restoring visibility
@@ -6754,7 +7249,7 @@ Optional arguments START and END can be used to limit the range."
'org-hide-block)
(delete-overlay ov))))
(push ov org-hide-block-overlays)))
- (error "Not looking at a source block"))))
+ (user-error "Not looking at a source block"))))
;; org-tab-after-check-for-cycling-hook
(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
@@ -6773,9 +7268,8 @@ Optional arguments START and END can be used to limit the range."
(setq org-goto-map
(let ((map (make-sparse-keymap)))
(let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command
- mouse-drag-region universal-argument org-occur))
- cmd)
- (while (setq cmd (pop cmds))
+ mouse-drag-region universal-argument org-occur)))
+ (dolist (cmd cmds)
(substitute-key-definition cmd cmd map global-map)))
(suppress-keymap map)
(org-defkey map "\C-m" 'org-goto-ret)
@@ -6808,11 +7302,10 @@ Optional arguments START and END can be used to limit the range."
(defconst org-goto-help
"Browse buffer copy, to find location or copy text.%s
RET=jump to location C-g=quit and return to previous location
-\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
+[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
(defvar org-goto-start-pos) ; dynamically scoped parameter
-;; FIXME: Docstring does not mention both interfaces
(defun org-goto (&optional alternative-interface)
"Look up a different location in the current file, keeping current visibility.
@@ -6948,7 +7441,7 @@ or nil."
(setq org-goto-selected-point (point)
org-goto-exit-command 'left)
(throw 'exit nil))
- (error "Not on a heading")))
+ (user-error "Not on a heading")))
(defun org-goto-right ()
"Finish `org-goto' by going to the new location."
@@ -6958,7 +7451,7 @@ or nil."
(setq org-goto-selected-point (point)
org-goto-exit-command 'right)
(throw 'exit nil))
- (error "Not on a heading")))
+ (user-error "Not on a heading")))
(defun org-goto-quit ()
"Finish `org-goto' without cursor motion."
@@ -7060,132 +7553,195 @@ frame is not changed."
;;; Inserting headlines
-(defun org-previous-line-empty-p ()
+(defun org-previous-line-empty-p (&optional next)
+ "Is the previous line a blank line?
+When NEXT is non-nil, check the next line instead."
(save-excursion
(and (not (bobp))
- (or (beginning-of-line 0) t)
+ (or (beginning-of-line (if next 2 0)) t)
(save-match-data
(looking-at "[ \t]*$")))))
-(defun org-insert-heading (&optional force-heading invisible-ok)
- "Insert a new heading or item with same depth at point.
-If point is in a plain list and FORCE-HEADING is nil, create a new list item.
-If point is at the beginning of a headline, insert a sibling before the
-current headline. If point is not at the beginning, split the line,
-create the new headline with the text in the current line after point
-\(but see also the variable `org-M-RET-may-split-line').
+(defun org-insert-heading (&optional arg invisible-ok)
+ "Insert a new heading or an item with the same depth at point.
+
+If point is at the beginning of a heading or a list item, insert
+a new heading or a new item above the current one. If point is
+at the beginning of a normal line, turn the line into a heading.
+
+If point is in the middle of a headline or a list item, split the
+headline or the item and create a new headline/item with the text
+in the current line after point \(see `org-M-RET-may-split-line'
+on how to modify this behavior).
+
+With one universal prefix argument, set the user option
+`org-insert-heading-respect-content' to t for the duration of
+the command. This modifies the behavior described above in this
+ways: on list items and at the beginning of normal lines, force
+the insertion of a heading after the current subtree.
-When INVISIBLE-OK is set, stop at invisible headlines when going back.
-This is important for non-interactive uses of the command."
+With two universal prefix arguments, insert the heading at the
+end of the grandparent subtree. For example, if point is within
+a 2nd-level heading, then it will insert a 2nd-level heading at
+the end of the 1st-level parent heading.
+
+When INVISIBLE-OK is set, stop at invisible headlines when going
+back. This is important for non-interactive uses of the
+command."
(interactive "P")
- (if (or (= (buffer-size) 0)
+ (if (org-called-interactively-p 'any) (org-reveal))
+ (let ((itemp (org-in-item-p))
+ (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
+ (respect-content (or org-insert-heading-respect-content
+ (equal arg '(4))))
+ (initial-content "")
+ (adjust-empty-lines t))
+
+ (cond
+
+ ((or (= (buffer-size) 0)
(and (not (save-excursion
(and (ignore-errors (org-back-to-heading invisible-ok))
(org-at-heading-p))))
- (or force-heading (not (org-in-item-p)))))
- (progn
- (insert "\n* ")
- (run-hooks 'org-insert-heading-hook))
- (when (or force-heading (not (org-insert-item)))
- (let* ((empty-line-p nil)
- (level nil)
- (on-heading (org-at-heading-p))
- (head (save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading invisible-ok)
- (when (and (not on-heading)
- (featurep 'org-inlinetask)
- (integerp org-inlinetask-min-level)
- (>= (length (match-string 0))
- org-inlinetask-min-level))
- ;; Find a heading level before the inline task
- (while (and (setq level (org-up-heading-safe))
- (>= level org-inlinetask-min-level)))
- (if (org-at-heading-p)
- (org-back-to-heading invisible-ok)
- (error "This should not happen")))
- (setq empty-line-p (org-previous-line-empty-p))
- (match-string 0))
- (error "*"))))
- (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a))
- pos hide-previous previous-pos)
- (cond
- ((and (org-at-heading-p) (bolp)
- (or (bobp)
- (save-excursion (backward-char 1) (not (outline-invisible-p)))))
- ;; insert before the current line
- (open-line (if blank 2 1)))
- ((and (bolp)
- (not org-insert-heading-respect-content)
- (or (bobp)
- (save-excursion
- (backward-char 1) (not (outline-invisible-p)))))
- ;; insert right here
- nil)
- (t
- ;; somewhere in the line
- (save-excursion
- (setq previous-pos (point-at-bol))
- (end-of-line)
- (setq hide-previous (outline-invisible-p)))
- (and org-insert-heading-respect-content (org-show-subtree))
- (let ((split
- (and (org-get-alist-option org-M-RET-may-split-line 'headline)
- (save-excursion
- (let ((p (point)))
- (goto-char (point-at-bol))
- (and (looking-at org-complex-heading-regexp)
- (match-beginning 4)
- (> p (match-beginning 4)))))))
- tags pos)
- (cond
- (org-insert-heading-respect-content
- (org-end-of-subtree nil t)
- (when (featurep 'org-inlinetask)
- (while (and (not (eobp))
- (looking-at "\\(\\*+\\)[ \t]+")
- (>= (length (match-string 1))
- org-inlinetask-min-level))
- (org-end-of-subtree nil t)))
- (or (bolp) (newline))
- (or (org-previous-line-empty-p)
- (and blank (newline)))
- (open-line 1))
- ((org-at-heading-p)
- (when hide-previous
- (show-children)
- (org-show-entry))
- (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
- (setq tags (and (match-end 2) (match-string 2)))
- (and (match-end 1)
- (delete-region (match-beginning 1) (match-end 1)))
- (setq pos (point-at-bol))
- (or split (end-of-line 1))
- (delete-horizontal-space)
- (if (string-match "\\`\\*+\\'"
- (buffer-substring (point-at-bol) (point)))
- (insert " "))
- (newline (if blank 2 1))
- (when tags
+ (or arg (not itemp))))
+ ;; At beginning of buffer or so high up that only a heading
+ ;; makes sense.
+ (cond ((and (bolp) (not respect-content)) (insert "* "))
+ ((not respect-content)
+ (unless may-split (end-of-line))
+ (insert "\n* "))
+ ((re-search-forward org-outline-regexp-bol nil t)
+ (beginning-of-line)
+ (insert "* \n")
+ (backward-char))
+ (t (goto-char (point-max))
+ (insert "\n* ")))
+ (run-hooks 'org-insert-heading-hook))
+
+ ((and itemp (not (member arg '((4) (16)))))
+ ;; Insert an item
+ (org-insert-item))
+
+ (t
+ ;; Maybe move at the end of the subtree
+ (when (equal arg '(16))
+ (org-up-heading-safe)
+ (org-end-of-subtree t))
+ ;; Insert a heading
+ (save-restriction
+ (widen)
+ (let* ((level nil)
+ (on-heading (org-at-heading-p))
+ (empty-line-p (if on-heading
+ (org-previous-line-empty-p)
+ ;; We will decide later
+ nil))
+ ;; Get a level string to fall back on
+ (fix-level
+ (if (org-before-first-heading-p) "*"
+ (save-excursion
+ (org-back-to-heading t)
+ (if (org-previous-line-empty-p) (setq empty-line-p t))
+ (looking-at org-outline-regexp)
+ (make-string (1- (length (match-string 0))) ?*))))
+ (stars
(save-excursion
- (goto-char pos)
- (end-of-line 1)
- (insert " " tags)
- (org-set-tags nil 'align))))
- (t
- (or split (end-of-line 1))
- (newline (if blank 2 1)))))))
- (insert head) (just-one-space)
- (setq pos (point))
- (end-of-line 1)
- (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
- (when (and org-insert-heading-respect-content hide-previous)
- (save-excursion
- (goto-char previous-pos)
- (hide-subtree)))
- (run-hooks 'org-insert-heading-hook)))))
+ (condition-case nil
+ (progn
+ (org-back-to-heading invisible-ok)
+ (when (and (not on-heading)
+ (featurep 'org-inlinetask)
+ (integerp org-inlinetask-min-level)
+ (>= (length (match-string 0))
+ org-inlinetask-min-level))
+ ;; Find a heading level before the inline task
+ (while (and (setq level (org-up-heading-safe))
+ (>= level org-inlinetask-min-level)))
+ (if (org-at-heading-p)
+ (org-back-to-heading invisible-ok)
+ (error "This should not happen")))
+ (unless (and (save-excursion
+ (save-match-data
+ (org-backward-heading-same-level
+ 1 invisible-ok))
+ (= (point) (match-beginning 0)))
+ (not (org-previous-line-empty-p t)))
+ (setq empty-line-p (or empty-line-p
+ (org-previous-line-empty-p))))
+ (match-string 0))
+ (error (or fix-level "* ")))))
+ (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
+ (blank (if (eq blank-a 'auto) empty-line-p blank-a))
+ pos hide-previous previous-pos)
+
+ ;; If we insert after content, move there and clean up whitespace
+ (when (and respect-content
+ (not (org-looking-at-p org-outline-regexp-bol)))
+ (if (not (org-before-first-heading-p))
+ (org-end-of-subtree nil t)
+ (re-search-forward org-outline-regexp-bol)
+ (beginning-of-line 0))
+ (skip-chars-backward " \r\n")
+ (and (not (looking-back "^\\*+" (line-beginning-position)))
+ (looking-at "[ \t]+") (replace-match ""))
+ (unless (eobp) (forward-char 1))
+ (when (looking-at "^\\*")
+ (unless (bobp) (backward-char 1))
+ (insert "\n")))
+
+ ;; If we are splitting, grab the text that should be moved to the new headline
+ (when may-split
+ (if (org-on-heading-p)
+ ;; This is a heading, we split intelligently (keeping tags)
+ (let ((pos (point)))
+ (goto-char (point-at-bol))
+ (unless (looking-at org-complex-heading-regexp)
+ (error "This should not happen"))
+ (when (and (match-beginning 4)
+ (> pos (match-beginning 4))
+ (< pos (match-end 4)))
+ (setq initial-content (buffer-substring pos (match-end 4)))
+ (goto-char pos)
+ (delete-region (point) (match-end 4))
+ (if (looking-at "[ \t]*$")
+ (replace-match "")
+ (insert (make-string (length initial-content) ?\ )))
+ (setq initial-content (org-trim initial-content)))
+ (goto-char pos))
+ ;; a normal line
+ (setq initial-content
+ (org-trim (buffer-substring (point) (point-at-eol))))
+ (delete-region (point) (point-at-eol))))
+
+ ;; If we are at the beginning of the line, insert before it. Else after
+ (cond
+ ((and (bolp) (looking-at "[ \t]*$")))
+ ((and (bolp) (not (looking-at "[ \t]*$")))
+ (open-line 1))
+ (t
+ (goto-char (point-at-eol))
+ (insert "\n")))
+
+ ;; Insert the new heading
+ (insert stars)
+ (just-one-space)
+ (insert initial-content)
+ (when adjust-empty-lines
+ (if (or (not blank)
+ (and blank (not (org-previous-line-empty-p))))
+ (org-N-empty-lines-before-current (if blank 1 0))))
+ (run-hooks 'org-insert-heading-hook)))))))
+
+(defun org-N-empty-lines-before-current (N)
+ "Make the number of empty lines before current exactly N.
+So this will delete or add empty lines."
+ (save-excursion
+ (beginning-of-line)
+ (let ((p (point)))
+ (skip-chars-backward " \r\t\n")
+ (unless (bolp) (forward-line))
+ (delete-region (point) p))
+ (when (> N 0) (insert (make-string N ?\n)))))
(defun org-get-heading (&optional no-tags no-todo)
"Return the heading of the current entry, without the stars.
@@ -7208,6 +7764,8 @@ When NO-TODO is non-nil, don't include TODO keywords."
(t (looking-at org-heading-regexp)
(match-string 2)))))
+(defvar orgstruct-mode) ; defined below
+
(defun org-heading-components ()
"Return the components of the current heading.
This is a list with the following elements:
@@ -7219,13 +7777,24 @@ This is a list with the following elements:
- the tags string, or nil."
(save-excursion
(org-back-to-heading t)
- (if (let (case-fold-search) (looking-at org-complex-heading-regexp))
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- (org-match-string-no-properties 2)
- (and (match-end 3) (aref (match-string 3) 2))
- (org-match-string-no-properties 4)
- (org-match-string-no-properties 5)))))
+ (if (let (case-fold-search)
+ (looking-at
+ (if orgstruct-mode
+ org-heading-regexp
+ org-complex-heading-regexp)))
+ (if orgstruct-mode
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ nil
+ nil
+ (match-string 2)
+ nil)
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ (org-match-string-no-properties 2)
+ (and (match-end 3) (aref (match-string 3) 2))
+ (org-match-string-no-properties 4)
+ (org-match-string-no-properties 5))))))
(defun org-get-entry ()
"Get the entry text, after heading, entire subtree."
@@ -7241,32 +7810,32 @@ This is a list with the following elements:
(org-move-subtree-down)
(end-of-line 1))
-(defun org-insert-heading-respect-content (invisible-ok)
+(defun org-insert-heading-respect-content (&optional invisible-ok)
"Insert heading with `org-insert-heading-respect-content' set to t."
- (interactive "P")
- (let ((org-insert-heading-respect-content t))
- (org-insert-heading t invisible-ok)))
+ (interactive)
+ (org-insert-heading '(4) invisible-ok))
(defun org-insert-todo-heading-respect-content (&optional force-state)
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
- (interactive "P")
- (let ((org-insert-heading-respect-content t))
- (org-insert-todo-heading force-state t)))
+ (interactive)
+ (org-insert-todo-heading force-state '(4)))
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
If the heading has no TODO state, or if the state is DONE, use the first
-state (TODO by default). Also with prefix arg, force first state."
+state (TODO by default). Also with one prefix arg, force first state. With
+two prefix args, force inserting at the end of the parent subtree."
(interactive "P")
(when (or force-heading (not (org-insert-item 'checkbox)))
- (org-insert-heading force-heading)
+ (org-insert-heading (or (and (equal arg '(16)) '(16))
+ force-heading))
(save-excursion
(org-back-to-heading)
(outline-previous-heading)
(looking-at org-todo-line-regexp))
(let*
((new-mark-x
- (if (or arg
+ (if (or (equal arg '(4))
(not (match-beginning 2))
(member (match-string 2) org-done-keywords))
(car org-todo-keywords-1)
@@ -7376,14 +7945,10 @@ The level is the number of stars at the beginning of the headline."
"Return the outline depth of the last headline before the current line.
Returns 0 for the first headline in the buffer, and nil if before the
first headline."
- (let ((current-level (org-current-level))
- (prev-level (when (> (line-number-at-pos) 1)
- (save-excursion
- (beginning-of-line 0)
- (org-current-level)))))
- (cond ((null current-level) nil) ; Before first headline
- ((null prev-level) 0) ; At first headline
- (prev-level))))
+ (and (org-current-level)
+ (or (and (/= (line-beginning-position) (point-min))
+ (save-excursion (beginning-of-line 0) (org-current-level)))
+ 0)))
(defun org-reduced-level (l)
"Compute the effective level of a heading.
@@ -7417,8 +7982,6 @@ even level numbers will become the next higher odd number."
(define-obsolete-function-alias 'org-get-legal-level
'org-get-valid-level "23.1")))
-(defvar org-called-with-limited-levels nil) ;; Dynamically bound in
-;; ̀org-with-limited-levels'
(defun org-promote ()
"Promote the current heading higher up the tree.
If the region is active in `transient-mark-mode', promote all headings
@@ -7433,11 +7996,11 @@ in the region."
org-allow-promoting-top-level-subtree)
(replace-match "# " nil t))
((= level 1)
- (error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
(t (replace-match up-head nil t)))
;; Fixup tag positioning
(unless (= level 1)
- (and org-auto-align-tags (org-set-tags nil t))
+ (and org-auto-align-tags (org-set-tags nil 'ignore-column))
(if org-adapt-indentation (org-fixup-indentation (- diff))))
(run-hooks 'org-after-promote-entry-hook)))
@@ -7453,7 +8016,7 @@ in the region."
(diff (abs (- level (length down-head) -1))))
(replace-match down-head nil t)
;; Fixup tag positioning
- (and org-auto-align-tags (org-set-tags nil t))
+ (and org-auto-align-tags (org-set-tags nil 'ignore-column))
(if org-adapt-indentation (org-fixup-indentation diff))
(run-hooks 'org-after-demote-entry-hook)))
@@ -7612,7 +8175,8 @@ case."
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (outline-invisible-p)))
- (outline-end-of-subtree))
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char))))
(outline-next-heading)
(setq ne-end (org-back-over-empty-lines))
(setq end (point))
@@ -7627,7 +8191,7 @@ case."
(while (> cnt 0)
(or (and (funcall movfunc) (looking-at org-outline-regexp))
(progn (goto-char beg0)
- (error "Cannot move past superior level or buffer limit")))
+ (user-error "Cannot move past superior level or buffer limit")))
(setq cnt (1- cnt)))
(if (> arg 0)
;; Moving forward - still need to move over subtree
@@ -7687,9 +8251,9 @@ This is a short-hand for marking the subtree and then cutting it."
(interactive "p")
(org-copy-subtree n 'cut))
-(defun org-copy-subtree (&optional n cut force-store-markers)
- "Cut the current subtree into the clipboard.
-With prefix arg N, cut this many sequential subtrees.
+(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees)
+ "Copy the current subtree it in the clipboard.
+With prefix arg N, copy this many sequential subtrees.
This is a short-hand for marking the subtree and then copying it.
If CUT is non-nil, actually cut the subtree.
If FORCE-STORE-MARKERS is non-nil, store the relative locations
@@ -7703,12 +8267,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(setq beg (point))
(skip-chars-forward " \t\r\n")
(save-match-data
- (save-excursion (outline-end-of-heading)
- (setq folded (outline-invisible-p)))
- (condition-case nil
- (org-forward-heading-same-level (1- n) t)
- (error nil))
- (org-end-of-subtree t t))
+ (if nosubtrees
+ (outline-next-heading)
+ (save-excursion (outline-end-of-heading)
+ (setq folded (outline-invisible-p)))
+ (condition-case nil
+ (org-forward-heading-same-level (1- n) t)
+ (error nil))
+ (org-end-of-subtree t t)))
(setq end (point))
(goto-char beg0)
(when (> end beg)
@@ -7727,7 +8293,7 @@ The entire subtree is promoted or demoted in order to match a new headline
level.
If the cursor is at the beginning of a headline, the same level as
-that headline is used to paste the tree
+that headline is used to paste the tree.
If not, the new level is derived from the *visible* headings
before and after the insertion point, and taken to be the inferior headline
@@ -7748,7 +8314,7 @@ the inserted text when done."
(interactive "P")
(setq tree (or tree (and kill-ring (current-kill 0))))
(unless (org-kill-is-subtree-p tree)
- (error "%s"
+ (user-error "%s"
(substitute-command-keys
"The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(org-with-limited-levels
@@ -7763,7 +8329,7 @@ the inserted text when done."
(string-match
"^\\*+$" (buffer-substring
(point-at-bol) (point))))
- (- (match-end 1) (match-beginning 1)))
+ (- (match-end 0) (match-beginning 0)))
((and (bolp)
(looking-at org-outline-regexp))
(- (match-end 0) (point) 1))))
@@ -7909,7 +8475,7 @@ If yes, remember the marker and the distance to BEG."
"^[ \t]*#\\+end_.*")))
(if blockp
(narrow-to-region (car blockp) (cdr blockp))
- (error "Not in a block"))))
+ (user-error "Not in a block"))))
(eval-when-compile
(defvar org-property-drawer-re))
@@ -7920,8 +8486,10 @@ If yes, remember the marker and the distance to BEG."
The clones will be inserted as siblings.
In interactive use, the user will be prompted for the number of
-clones to be produced, and for a time SHIFT, which may be a
-repeater as used in time stamps, for example `+3d'.
+clones to be produced. If the entry has a timestamp, the user
+will also be prompted for a time shift, which may be a repeater
+as used in time stamps, for example `+3d'. To disable this,
+you can call the function with a universal prefix argument.
When a valid repeater is given and the entry contains any time
stamps, the clones will become a sequence in time, with time
@@ -7940,10 +8508,22 @@ the following will happen:
to past the last clone.
In this way you can spell out a number of instances of a repeating task,
and still retain the repeater to cover future instances of the task."
- (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ")
- (let (beg end template task idprop
- shift-n shift-what doshift nmin nmax (n-no-remove -1)
- (drawer-re org-drawer-regexp))
+ (interactive "nNumber of clones to produce: ")
+ (let ((shift
+ (or shift
+ (if (and (not (equal current-prefix-arg '(4)))
+ (save-excursion
+ (re-search-forward org-ts-regexp-both
+ (save-excursion
+ (org-end-of-subtree t)
+ (point)) t)))
+ (read-from-minibuffer
+ "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
+ ""))) ;; No time shift
+ (n-no-remove -1)
+ (drawer-re org-drawer-regexp)
+ beg end template task idprop
+ shift-n shift-what doshift nmin nmax)
(if (not (and (integerp n) (> n 0)))
(error "Invalid number of replications %s" n))
(if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
@@ -7986,7 +8566,8 @@ and still retain the repeater to cover future instances of the task."
(goto-char (point-min))
(while (re-search-forward drawer-re nil t)
(mapc (lambda (d)
- (org-remove-empty-drawer-at d (point))) org-drawers)))
+ (org-remove-empty-drawer-at d (point)))
+ org-drawers)))
(goto-char (point-min))
(when doshift
(while (re-search-forward org-ts-regexp-both nil t)
@@ -8015,11 +8596,17 @@ Optional argument WITH-CASE means sort case-sensitively."
(org-call-with-arg 'org-sort-entries with-case))))
(defun org-sort-remove-invisible (s)
+ "Remove invisible links from string S."
(remove-text-properties 0 (length s) org-rm-props s)
(while (string-match org-bracket-link-regexp s)
(setq s (replace-match (if (match-end 2)
(match-string 3 s)
- (match-string 1 s)) t t s)))
+ (match-string 1 s))
+ t t s)))
+ (let ((st (format " %s " s)))
+ (while (string-match org-emph-re st)
+ (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
+ (setq s (substring st 1 -1)))
s)
(defvar org-priority-regexp) ; defined later in the file
@@ -8038,7 +8625,7 @@ Else, if the cursor is before the first entry, sort the top-level items.
Else, the children of the entry at point are sorted.
Sorting can be alphabetically, numerically, by date/time as given by
-a time stamp, by a property or by priority.
+a time stamp, by a property, by priority order, or by a custom function.
The command prompts for the sorting type unless it has been given to the
function through the SORTING-TYPE argument, which needs to be a character,
@@ -8064,7 +8651,10 @@ called with point at the beginning of the record. It must return either
a string or a number that should serve as the sorting key for that record.
Comparing entries ignores case by default. However, with an optional argument
-WITH-CASE, the sorting considers case as well."
+WITH-CASE, the sorting considers case as well.
+
+Sorting is done against the visible part of the headlines, it ignores hidden
+links."
(interactive "P")
(let ((case-func (if with-case 'identity 'downcase))
(cmstr
@@ -8073,7 +8663,8 @@ WITH-CASE, the sorting considers case as well."
(when (equal (marker-buffer org-clock-marker) (current-buffer))
(save-excursion
(goto-char org-clock-marker)
- (looking-back "^.*") (match-string-no-properties 0))))
+ (buffer-substring-no-properties (line-beginning-position)
+ (point)))))
start beg end stars re re2
txt what tmp)
;; Find beginning and end of region to sort
@@ -8092,7 +8683,8 @@ WITH-CASE, the sorting considers case as well."
(setq start (point)
end (progn (org-end-of-subtree t t)
(or (bolp) (insert "\n"))
- (org-back-over-empty-lines)
+ (when (>= (org-back-over-empty-lines) 1)
+ (forward-line 1))
(point))
what "children")
(goto-char start)
@@ -8115,7 +8707,7 @@ WITH-CASE, the sorting considers case as well."
(show-all)))
(setq beg (point))
- (if (>= beg end) (error "Nothing to sort"))
+ (when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
(looking-at "\\(\\*+\\)")
(setq stars (match-string 1)
@@ -8124,7 +8716,7 @@ WITH-CASE, the sorting considers case as well."
txt (buffer-substring beg end))
(if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
(if (and (not (equal stars "*")) (string-match re2 txt))
- (error "Region to sort contains a level above the first entry"))
+ (user-error "Region to sort contains a level above the first entry"))
(unless sorting-type
(message
@@ -8134,13 +8726,15 @@ WITH-CASE, the sorting considers case as well."
what)
(setq sorting-type (read-char-exclusive))
- (and (= (downcase sorting-type) ?f)
- (setq getkey-func
- (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil))
- (setq getkey-func (intern getkey-func)))
+ (unless getkey-func
+ (and (= (downcase sorting-type) ?f)
+ (setq getkey-func
+ (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil))
+ (setq getkey-func (intern getkey-func))))
(and (= (downcase sorting-type) ?r)
+ (not property)
(setq property
(org-icompleting-read "Property: "
(mapcar 'list (org-buffer-property-keys t))
@@ -8174,11 +8768,11 @@ WITH-CASE, the sorting considers case as well."
(cond
((= dcst ?n)
(if (looking-at org-complex-heading-regexp)
- (string-to-number (match-string 4))
+ (string-to-number (org-sort-remove-invisible (match-string 4)))
nil))
((= dcst ?a)
(if (looking-at org-complex-heading-regexp)
- (funcall case-func (match-string 4))
+ (funcall case-func (org-sort-remove-invisible (match-string 4)))
nil))
((= dcst ?t)
(let ((end (save-excursion (outline-next-heading) (point))))
@@ -8296,12 +8890,23 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
;; command. There might be problems if any of the keys is otherwise
;; used as a prefix key.
-;; Another challenge is that the key binding for TAB can be tab or \C-i,
-;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
-;; addresses this by checking explicitly for both bindings.
+(defcustom orgstruct-heading-prefix-regexp ""
+ "Regexp that matches the custom prefix of Org headlines in
+orgstruct(++)-mode."
+ :group 'org
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'regexp)
+;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
+
+(defcustom orgstruct-setup-hook nil
+ "Hook run after orgstruct-mode-map is filled."
+ :group 'org
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'hook)
-(defvar orgstruct-mode-map (make-sparse-keymap)
- "Keymap for the minor `orgstruct-mode'.")
+(defvar orgstruct-initialized nil)
(defvar org-local-vars nil
"List of local variables, for use by `orgstruct-mode'.")
@@ -8312,26 +8917,17 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
This mode is for using Org-mode structure commands in other
modes. The following keys behave as if Org-mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode).
-
-M-up Move entry/item up
-M-down Move entry/item down
-M-left Promote
-M-right Demote
-M-S-up Move entry/item up
-M-S-down Move entry/item down
-M-S-left Promote subtree
-M-S-right Demote subtree
-M-q Fill paragraph and items like in Org-mode
-C-c ^ Sort entries
-C-c - Cycle list bullet
-TAB Cycle item visibility
-M-RET Insert new heading/item
-S-M-RET Insert new TODO heading / Checkbox item
-C-c C-c Set tags / toggle checkbox"
- nil " OrgStruct" nil
- (org-load-modules-maybe)
- (and (orgstruct-setup) (defun orgstruct-setup () nil)))
+defined by Org-mode)."
+ nil " OrgStruct" (make-sparse-keymap)
+ (funcall (if orgstruct-mode
+ 'add-to-invisibility-spec
+ 'remove-from-invisibility-spec)
+ '(outline . t))
+ (when orgstruct-mode
+ (org-load-modules-maybe)
+ (unless orgstruct-initialized
+ (orgstruct-setup)
+ (setq orgstruct-initialized t))))
;;;###autoload
(defun turn-on-orgstruct ()
@@ -8355,6 +8951,8 @@ buffer. It will also recognize item context in multiline items."
org-fb-vars))
(orgstruct-mode 1)
(setq org-fb-vars nil)
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
(let (var val)
(mapc
(lambda (x)
@@ -8379,107 +8977,166 @@ buffer. It will also recognize item context in multiline items."
(defun orgstruct-error ()
"Error when there is no default binding for a structure key."
(interactive)
- (error "This key has no function outside structure elements"))
+ (funcall (if (fboundp 'user-error)
+ 'user-error
+ 'error)
+ "This key has no function outside structure elements"))
(defun orgstruct-setup ()
- "Setup orgstruct keymaps."
- (let ((nfunc 0)
- (bindings
- (list
- '([(meta up)] org-metaup)
- '([(meta down)] org-metadown)
- '([(meta left)] org-metaleft)
- '([(meta right)] org-metaright)
- '([(meta shift up)] org-shiftmetaup)
- '([(meta shift down)] org-shiftmetadown)
- '([(meta shift left)] org-shiftmetaleft)
- '([(meta shift right)] org-shiftmetaright)
- '([?\e (up)] org-metaup)
- '([?\e (down)] org-metadown)
- '([?\e (left)] org-metaleft)
- '([?\e (right)] org-metaright)
- '([?\e (shift up)] org-shiftmetaup)
- '([?\e (shift down)] org-shiftmetadown)
- '([?\e (shift left)] org-shiftmetaleft)
- '([?\e (shift right)] org-shiftmetaright)
- '([(shift up)] org-shiftup)
- '([(shift down)] org-shiftdown)
- '([(shift left)] org-shiftleft)
- '([(shift right)] org-shiftright)
- '("\C-c\C-c" org-ctrl-c-ctrl-c)
- '("\M-q" fill-paragraph)
- '("\C-c^" org-sort)
- '("\C-c-" org-cycle-list-bullet)))
- elt key fun cmd)
- (while (setq elt (pop bindings))
- (setq nfunc (1+ nfunc))
- (setq key (org-key (car elt))
- fun (nth 1 elt)
- cmd (orgstruct-make-binding fun nfunc key))
- (org-defkey orgstruct-mode-map key cmd))
-
- ;; Prevent an error for users who forgot to make autoloads
- (require 'org-element)
-
- ;; Special treatment needed for TAB and RET
- (org-defkey orgstruct-mode-map [(tab)]
- (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i"))
- (org-defkey orgstruct-mode-map "\C-i"
- (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)]))
-
- (org-defkey orgstruct-mode-map "\M-\C-m"
- (orgstruct-make-binding 'org-insert-heading 105
- "\M-\C-m" [(meta return)]))
- (org-defkey orgstruct-mode-map [(meta return)]
- (orgstruct-make-binding 'org-insert-heading 106
- [(meta return)] "\M-\C-m"))
-
- (org-defkey orgstruct-mode-map [(shift meta return)]
- (orgstruct-make-binding 'org-insert-todo-heading 107
- [(meta return)] "\M-\C-m"))
-
- (org-defkey orgstruct-mode-map "\e\C-m"
- (orgstruct-make-binding 'org-insert-heading 108
- "\e\C-m" [?\e (return)]))
- (org-defkey orgstruct-mode-map [?\e (return)]
- (orgstruct-make-binding 'org-insert-heading 109
- [?\e (return)] "\e\C-m"))
- (org-defkey orgstruct-mode-map [?\e (shift return)]
- (orgstruct-make-binding 'org-insert-todo-heading 110
- [?\e (return)] "\e\C-m"))
-
- (unless org-local-vars
- (setq org-local-vars (org-get-local-variables)))
-
- t))
-
-(defun orgstruct-make-binding (fun n &rest keys)
+ "Setup orgstruct keymap."
+ (dolist (cell '((org-demote . t)
+ (org-metaleft . t)
+ (org-metaright . t)
+ (org-promote . t)
+ (org-shiftmetaleft . t)
+ (org-shiftmetaright . t)
+ org-backward-element
+ org-backward-heading-same-level
+ org-ctrl-c-ret
+ org-ctrl-c-minus
+ org-ctrl-c-star
+ org-cycle
+ org-forward-heading-same-level
+ org-insert-heading
+ org-insert-heading-respect-content
+ org-kill-note-or-show-branches
+ org-mark-subtree
+ org-meta-return
+ org-metadown
+ org-metaup
+ org-narrow-to-subtree
+ org-promote-subtree
+ org-reveal
+ org-shiftdown
+ org-shiftleft
+ org-shiftmetadown
+ org-shiftmetaup
+ org-shiftright
+ org-shifttab
+ org-shifttab
+ org-shiftup
+ org-show-subtree
+ org-sort
+ org-up-element
+ outline-demote
+ outline-next-visible-heading
+ outline-previous-visible-heading
+ outline-promote
+ outline-up-heading
+ show-children))
+ (let ((f (or (car-safe cell) cell))
+ (disable-when-heading-prefix (cdr-safe cell)))
+ (when (fboundp f)
+ (let ((new-bindings))
+ (dolist (binding (nconc (where-is-internal f org-mode-map)
+ (where-is-internal f outline-mode-map)))
+ (push binding new-bindings)
+ ;; TODO use local-function-key-map
+ (dolist (rep '(("<tab>" . "TAB")
+ ("<return>" . "RET")
+ ("<escape>" . "ESC")
+ ("<delete>" . "DEL")))
+ (setq binding (read-kbd-macro
+ (let ((case-fold-search))
+ (replace-regexp-in-string
+ (regexp-quote (cdr rep))
+ (car rep)
+ (key-description binding)))))
+ (pushnew binding new-bindings :test 'equal)))
+ (dolist (binding new-bindings)
+ (let ((key (lookup-key orgstruct-mode-map binding)))
+ (when (or (not key) (numberp key))
+ (condition-case nil
+ (org-defkey orgstruct-mode-map
+ binding
+ (orgstruct-make-binding f binding disable-when-heading-prefix))
+ (error nil)))))))))
+ (run-hooks 'orgstruct-setup-hook))
+
+(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
"Create a function for binding in the structure minor mode.
-FUN is the command to call inside a table. N is used to create a unique
-command name. KEYS are keys that should be checked in for a command
-to execute outside of tables."
- (eval
- (list 'defun
- (intern (concat "orgstruct-hijacker-command-" (int-to-string n)))
- '(arg)
- (concat "In Structure, run `" (symbol-name fun) "'.\n"
- "Outside of structure, run the binding of `"
- (mapconcat (lambda (x) (format "%s" x)) keys "' or `")
- "'.")
- '(interactive "p")
- (list 'if
- `(org-context-p 'headline 'item
- (and orgstruct-is-++
- ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t)
- 'item-body))
- (list 'org-run-like-in-org-mode (list 'quote fun))
- (list 'let '(orgstruct-mode)
- (list 'call-interactively
- (append '(or)
- (mapcar (lambda (k)
- (list 'key-binding k))
- keys)
- '('orgstruct-error))))))))
+FUN is the command to call inside a table. KEY is the key that
+should be checked in for a command to execute outside of tables.
+Non-nil `disable-when-heading-prefix' means to disable the command
+if `orgstruct-heading-prefix-regexp' is not empty."
+ (let ((name (concat "orgstruct-hijacker-" (symbol-name fun))))
+ (let ((nname name)
+ (i 0))
+ (while (fboundp (intern nname))
+ (setq nname (format "%s-%d" name (setq i (1+ i)))))
+ (setq name (intern nname)))
+ (eval
+ (let ((bindings '((org-heading-regexp
+ (concat "^"
+ orgstruct-heading-prefix-regexp
+ "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$"))
+ (org-outline-regexp
+ (concat orgstruct-heading-prefix-regexp "\\*+ "))
+ (org-outline-regexp-bol
+ (concat "^" org-outline-regexp))
+ (outline-regexp org-outline-regexp)
+ (outline-heading-end-regexp "\n")
+ (outline-level 'org-outline-level)
+ (outline-heading-alist))))
+ `(defun ,name (arg)
+ ,(concat "In Structure, run `" (symbol-name fun) "'.\n"
+ "Outside of structure, run the binding of `"
+ (key-description key) "'."
+ (when disable-when-heading-prefix
+ (concat
+ "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n"
+ "back to the default binding due to limitations of Org's implementation of\n"
+ "`" (symbol-name fun) "'.")))
+ (interactive "p")
+ (let* ((disable
+ ,(and disable-when-heading-prefix
+ '(not (string= orgstruct-heading-prefix-regexp ""))))
+ (fallback
+ (or disable
+ (not
+ (let* ,bindings
+ (org-context-p 'headline 'item
+ ,(when (memq fun
+ '(org-insert-heading
+ org-insert-heading-respect-content
+ org-meta-return))
+ '(when orgstruct-is-++
+ 'item-body))))))))
+ (if fallback
+ (let* ((orgstruct-mode)
+ (binding
+ (let ((key ,key))
+ (catch 'exit
+ (dolist
+ (rep
+ '(nil
+ ("<\\([^>]*\\)tab>" . "\\1TAB")
+ ("<\\([^>]*\\)return>" . "\\1RET")
+ ("<\\([^>]*\\)escape>" . "\\1ESC")
+ ("<\\([^>]*\\)delete>" . "\\1DEL"))
+ nil)
+ (when rep
+ (setq key (read-kbd-macro
+ (let ((case-fold-search))
+ (replace-regexp-in-string
+ (car rep)
+ (cdr rep)
+ (key-description key))))))
+ (when (key-binding key)
+ (throw 'exit (key-binding key))))))))
+ (if (keymapp binding)
+ (org-set-transient-map binding)
+ (let ((func (or binding
+ (unless disable
+ 'orgstruct-error))))
+ (when func
+ (call-interactively func)))))
+ (org-run-like-in-org-mode
+ (lambda ()
+ (interactive)
+ (let* ,bindings
+ (call-interactively ',fun)))))))))
+ name))
(defun org-contextualize-keys (alist contexts)
"Return valid elements in ALIST depending on CONTEXTS.
@@ -8495,10 +9152,11 @@ definitions."
(list (car c) (car c) (cadr c)))
((string= "" (cadr c))
(list (car c) (car c) (caddr c)))
- (t c))) contexts))
- (a alist) c r s)
+ (t c)))
+ contexts))
+ (a alist) r s)
;; loop over all commands or templates
- (while (setq c (pop a))
+ (dolist (c a)
(let (vrules repl)
(cond
((not (assoc (car c) contexts))
@@ -8508,7 +9166,8 @@ definitions."
(car c) contexts)))
(mapc (lambda (vr)
(when (not (equal (car vr) (cadr vr)))
- (setq repl vr))) vrules)
+ (setq repl vr)))
+ vrules)
(if (not repl) (push c r)
(push (cadr repl) s)
(push
@@ -8525,14 +9184,16 @@ definitions."
(let ((tpl (car x)))
(when (not (delq
nil
- (mapcar (lambda(y)
- (equal y tpl)) s))) x)))
+ (mapcar (lambda (y)
+ (equal y tpl))
+ s)))
+ x)))
(reverse r))))))
(defun org-contextualize-validate-key (key contexts)
"Check CONTEXTS for agenda or capture KEY."
- (let (r rr res)
- (while (setq r (pop contexts))
+ (let (rr res)
+ (dolist (r contexts)
(mapc
(lambda (rr)
(when
@@ -8543,11 +9204,15 @@ definitions."
(string-match (cdr rr) (buffer-file-name)))
(and (eq (car rr) 'in-mode)
(string-match (cdr rr) (symbol-name major-mode)))
+ (and (eq (car rr) 'in-buffer)
+ (string-match (cdr rr) (buffer-name)))
(when (and (eq (car rr) 'not-in-file)
(buffer-file-name))
(not (string-match (cdr rr) (buffer-file-name))))
(when (eq (car rr) 'not-in-mode)
- (not (string-match (cdr rr) (symbol-name major-mode)))))))
+ (not (string-match (cdr rr) (symbol-name major-mode))))
+ (when (eq (car rr) 'not-in-buffer)
+ (not (string-match (cdr rr) (buffer-name)))))))
(push r res)))
(car (last r))))
(delete-dups (delq nil res))))
@@ -8576,17 +9241,18 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(setq varlist (buffer-local-variables)))
(kill-buffer "*Org tmp*")
(delq nil
- (mapcar
- (lambda (x)
- (setq x
- (if (symbolp x)
- (list x)
- (list (car x) (list 'quote (cdr x)))))
- (if (string-match
- "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
- (symbol-name (car x)))
- x nil))
- varlist))))
+ (mapcar
+ (lambda (x)
+ (setq x
+ (if (symbolp x)
+ (list x)
+ (list (car x) (cdr x))))
+ (if (and (not (get (car x) 'org-state))
+ (string-match
+ "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
+ (symbol-name (car x))))
+ x nil))
+ varlist))))
(defun org-clone-local-variables (from-buffer &optional regexp)
"Clone local variables from FROM-BUFFER.
@@ -8609,8 +9275,14 @@ call CMD."
(org-load-modules-maybe)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
- (eval (list 'let org-local-vars
- (list 'call-interactively (list 'quote cmd)))))
+ (let (binds)
+ (dolist (var org-local-vars)
+ (when (or (not (boundp (car var)))
+ (eq (symbol-value (car var))
+ (default-value (car var))))
+ (push (list (car var) `(quote ,(cadr var))) binds)))
+ (eval `(let ,binds
+ (call-interactively (quote ,cmd))))))
;;;; Archiving
@@ -8636,7 +9308,7 @@ call CMD."
((symbolp org-category) (symbol-name org-category))
(t org-category)))
beg end cat pos optionp)
- (org-unmodified
+ (org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
@@ -8661,7 +9333,7 @@ DPROP is the drawer property and TPROP is the corresponding text
property to set."
(let ((case-fold-search t)
(inhibit-read-only t) p)
- (org-unmodified
+ (org-with-silent-modifications
(save-excursion
(save-restriction
(widen)
@@ -8671,7 +9343,7 @@ property to set."
(save-excursion
(org-back-to-heading t)
(put-text-property
- (point-at-bol) (point-at-eol) tprop p))))))))
+ (point-at-bol) (or (outline-next-heading) (point-max)) tprop p))))))))
;;;; Link Stuff
@@ -8692,7 +9364,9 @@ property to set."
(cond
((symbolp rpl) (funcall rpl tag))
((string-match "%(\\([^)]+\\))" rpl)
- (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl))
+ (replace-match
+ (save-match-data
+ (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl))
((string-match "%s" rpl) (replace-match (or tag "") t t rpl))
((string-match "%h" rpl)
(replace-match (url-hexify-string (or tag "")) t t rpl))
@@ -8774,191 +9448,241 @@ type. For a simple example of an export function, see `org-bbdb.el'."
This link is added to `org-stored-links' and can later be inserted
into an org-buffer with \\[org-insert-link].
-For some link types, a prefix arg is interpreted:
-For links to usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'."
- (interactive "P")
- (org-load-modules-maybe)
- (setq org-store-link-plist nil) ; reset
- (org-with-limited-levels
- (let (link cpltxt desc description search txt custom-id agenda-link)
- (cond
+For some link types, a prefix arg is interpreted.
+For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
+For file links, arg negates `org-context-in-file-links'.
- ((run-hook-with-args-until-success 'org-store-link-functions)
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist :description) link)))
+A double prefix arg force skipping storing functions that are not
+part of Org's core.
- ((org-src-edit-buffer-p)
- (let (label gc)
- (while (or (not label)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (regexp-quote (format org-coderef-label-format label))
- nil t))))
- (when label (message "Label exists already") (sit-for 2))
- (setq label (read-string "Code line label: " label)))
- (end-of-line 1)
- (setq link (format org-coderef-label-format label))
- (setq gc (- 79 (length link)))
- (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
- (insert link)
- (setq link (concat "(" label ")") desc nil)))
-
- ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
- ;; We are in the agenda, link to referenced location
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link
- (if (org-called-interactively-p 'any)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
-
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-props :type "calendar" :date cd)))
-
- ((eq major-mode 'help-mode)
- (setq link (concat "help:" (save-excursion
- (goto-char (point-min))
- (looking-at "^[^ ]+")
- (match-string 0))))
- (org-store-link-props :type "help"))
-
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-store-link-props :type "w3" :url (url-view-url t)))
-
- ((eq major-mode 'w3m-mode)
- (setq cpltxt (or w3m-current-title w3m-current-url)
- link w3m-current-url)
- (org-store-link-props :type "w3m" :url (url-view-url t)))
-
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
-
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-store-link-props :type "image" :file buffer-file-name))
-
- ((eq major-mode 'dired-mode)
- ;; link to the file in the current line
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
-
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+A triple prefix arg force storing a link for each line in the
+active region."
+ (interactive "P")
+ (org-load-modules-maybe)
+ (if (and (equal arg '(64)) (org-region-active-p))
+ (save-excursion
+ (let ((end (region-end)))
+ (goto-char (region-beginning))
+ (set-mark (point))
+ (while (< (point-at-eol) end)
+ (move-end-of-line 1) (activate-mark)
+ (let (current-prefix-arg)
+ (call-interactively 'org-store-link))
+ (move-beginning-of-line 2)
+ (set-mark (point)))))
+ (org-with-limited-levels
+ (setq org-store-link-plist nil)
+ (let (link cpltxt desc description search
+ txt custom-id agenda-link sfuns sfunsn)
(cond
- ((org-in-regexp "<<\\(.*?\\)>>")
- (setq cpltxt
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::" (match-string 1))
- link cpltxt))
- ((and (featurep 'org-id)
- (or (eq org-id-link-to-org-use-id t)
- (and (org-called-interactively-p 'any)
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
- ;; We can make a link using the ID.
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist :description)))
- (error
- ;; probably before first headline, link to file only
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
- ;; Just link to current headline
+
+ ;; Store a link using an external link type
+ ((and (not (equal arg '(16)))
+ (setq sfuns
+ (delq
+ nil (mapcar (lambda (f)
+ (let (fs) (if (funcall f) (push f fs))))
+ org-store-link-functions))
+ sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+ (or (and (cdr sfuns)
+ (funcall (intern
+ (completing-read
+ "Which function for creating the link? "
+ sfunsn nil t (car sfunsn)))))
+ (funcall (caar sfuns)))
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist
+ :description)
+ link))))
+
+ ;; Store a link from a source code buffer
+ ((org-src-edit-buffer-p)
+ (let (label gc)
+ (while (or (not label)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (regexp-quote (format org-coderef-label-format label))
+ nil t))))
+ (when label (message "Label exists already") (sit-for 2))
+ (setq label (read-string "Code line label: " label)))
+ (end-of-line 1)
+ (setq link (format org-coderef-label-format label))
+ (setq gc (- 79 (length link)))
+ (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
+ (insert link)
+ (setq link (concat "(" label ")") desc nil)))
+
+ ;; We are in the agenda, link to referenced location
+ ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (setq agenda-link
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-props :type "calendar" :date cd)))
+
+ ((eq major-mode 'help-mode)
+ (setq link (concat "help:" (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0))))
+ (org-store-link-props :type "help"))
+
+ ((eq major-mode 'w3-mode)
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (url-view-url t))
+ (org-store-link-props :type "w3" :url (url-view-url t)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ;; In dired, store a link to the file of the current line
+ ((eq major-mode 'dired-mode)
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link cpltxt)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ;; Store a link using the target at point
+ ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
+ (setq cpltxt
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))
+ "::" (match-string 1))
+ link cpltxt))
+ ((and (featurep 'org-id)
+ (or (eq org-id-link-to-org-use-id t)
+ (and (org-called-interactively-p 'any)
+ (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-id-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not custom-id))))
+ (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
+ ;; Store a link using the ID at point
+ (setq link (condition-case nil
+ (prog1 (org-id-store-link)
+ (setq desc (or (plist-get org-store-link-plist
+ :description)
+ "")))
+ (error
+ ;; Probably before first headline, link only to file
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))))))
+ (t
+ ;; Just link to current headline
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context search string
+ (when (org-xor org-context-in-file-links arg)
+ (let* ((ee (org-element-at-point))
+ (et (org-element-type ee))
+ (ev (plist-get (cadr ee) :value))
+ (ek (plist-get (cadr ee) :key))
+ (eok (and (stringp ek) (string-match "name" ek))))
+ (setq txt (cond
+ ((org-at-heading-p) nil)
+ ((and (eq et 'keyword) eok) ev)
+ ((org-region-active-p)
+ (buffer-substring (region-beginning) (region-end)))))
+ (when (or (null txt) (string-match "\\S-" txt))
+ (setq cpltxt
+ (concat cpltxt "::"
+ (condition-case nil
+ (org-make-org-heading-search-string txt)
+ (error "")))
+ desc (or (and (eq et 'keyword) eok ev)
+ (nth 4 (ignore-errors (org-heading-components)))
+ "NONE")))))
+ (if (string-match "::\\'" cpltxt)
+ (setq cpltxt (substring cpltxt 0 -2)))
+ (setq link cpltxt))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
+ ;; Add a context string.
(when (org-xor org-context-in-file-links arg)
- (setq txt (cond
- ((org-at-heading-p) nil)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))))
- (when (or (null txt) (string-match "\\S-" txt))
+ (setq txt (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ ;; Only use search option if there is some text.
+ (when (string-match "\\S-" txt)
(setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-make-org-heading-search-string txt)
- (error "")))
- desc (or (nth 4 (ignore-errors
- (org-heading-components))) "NONE"))))
- (if (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
- (setq link cpltxt))))
-
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string
- (when (org-xor org-context-in-file-links arg)
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link cpltxt))
-
- ((org-called-interactively-p 'interactive)
- (error "Cannot link to a buffer which is not visiting a file"))
-
- (t (setq link nil)))
-
- (if (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (if (equal desc "NONE") (setq desc nil))
-
- (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
- (progn
- (setq org-stored-links
- (cons (list link desc) org-stored-links))
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
- "::#" custom-id))
- (setq org-stored-links
- (cons (list link desc) org-stored-links))))
- (or agenda-link (and link (org-make-link-string link desc)))))))
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((org-called-interactively-p 'interactive)
+ (user-error "No method for storing a link from this buffer"))
+
+ (t (setq link nil)))
+
+ ;; We're done setting link and desc, clean up
+ (if (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (cond ((equal desc "NONE") (setq desc nil))
+ ((and desc (string-match org-bracket-link-analytic-regexp desc))
+ (let ((d0 (match-string 3 desc))
+ (p0 (match-string 5 desc)))
+ (setq desc
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (concat (or p0 d0)
+ (if (equal (length (match-string 0 desc))
+ (length desc)) "*" "")) desc)))))
+
+ ;; Return the link
+ (if (not (and (or (org-called-interactively-p 'any)
+ executing-kbd-macro)
+ link))
+ (or agenda-link (and link (org-make-link-string link desc)))
+ (push (list link desc) org-stored-links)
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:" (abbreviate-file-name
+ (buffer-file-name)) "::#" custom-id))
+ (push (list link desc) org-stored-links))
+ (car org-stored-links))))))
(defun org-store-link-props (&rest plist)
"Store link properties, extract names and addresses."
@@ -9015,24 +9739,16 @@ according to FMT (default from `org-email-link-description-format')."
(setq fmt (replace-match "from %f" t t fmt))))
(org-replace-escapes fmt table)))
-(defun org-make-org-heading-search-string (&optional string heading)
- "Make search string for STRING or current headline."
- (interactive)
- (let ((s (or string (org-get-heading)))
+(defun org-make-org-heading-search-string (&optional string)
+ "Make search string for the current headline or STRING."
+ (let ((s (or string
+ (and (derived-mode-p 'org-mode)
+ (save-excursion
+ (org-back-to-heading t)
+ (org-element-property :raw-value (org-element-at-point))))))
(lines org-context-in-file-links))
- (unless (and string (not heading))
- ;; We are using a headline, clean up garbage in there.
- (if (string-match org-todo-regexp s)
- (setq s (replace-match "" t t s)))
- (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s)
- (setq s (replace-match "" t t s)))
- (setq s (org-trim s))
- (if (string-match (concat "^\\(" org-quote-string "\\|"
- org-comment-string "\\)") s)
- (setq s (replace-match "" t t s)))
- (while (string-match org-ts-regexp s)
- (setq s (replace-match "" t t s))))
(or string (setq s (concat "*" s))) ; Add * for headlines
+ (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s))
(when (and string (integerp lines) (> lines 0))
(let ((slines (org-split-string s "\n")))
(when (< lines (length slines))
@@ -9079,7 +9795,7 @@ according to FMT (default from `org-email-link-description-format')."
This is the list that is used for internal purposes.")
(defconst org-link-escape-chars-browser
- '(?\ )
+ '(?\ ?\")
"List of escapes for characters that are problematic in links.
This is the list that is used before handing over to the browser.")
@@ -9202,7 +9918,7 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(let ((links (copy-sequence org-stored-links)) l)
(while (setq l (if keep (pop links) (pop org-stored-links)))
(insert "- ")
- (org-insert-link nil (car l) (cadr l))
+ (org-insert-link nil (car l) (or (cadr l) "<no description>"))
(insert "\n"))))
(defun org-link-fontify-links-to-this-file ()
@@ -9270,6 +9986,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
be used as the default description."
(interactive "P")
(let* ((wcf (current-window-configuration))
+ (origbuf (current-buffer))
(region (if (org-region-active-p)
(buffer-substring (region-beginning) (region-end))))
(remove (and region (list (region-beginning) (region-end))))
@@ -9324,20 +10041,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(unwind-protect
(progn
(setq link
- (let ((org-completion-use-ido nil)
- (org-completion-use-iswitchb nil))
- (org-completing-read
- "Link: "
- (append
- (mapcar (lambda (x) (list (concat x ":")))
- all-prefixes)
- (mapcar 'car org-stored-links)
- (mapcar 'cadr org-stored-links))
- nil nil nil
- 'tmphist
- (caar org-stored-links))))
+ (org-completing-read
+ "Link: "
+ (append
+ (mapcar (lambda (x) (concat x ":"))
+ all-prefixes)
+ (mapcar 'car org-stored-links))
+ nil nil nil
+ 'tmphist
+ (caar org-stored-links)))
(if (not (string-match "\\S-" link))
- (error "No link selected"))
+ (user-error "No link selected"))
(mapc (lambda(l)
(when (equal link (cadr l)) (setq link (car l) auto-desc t)))
org-stored-links)
@@ -9345,7 +10059,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(and (equal ":" (substring link -1))
(member (substring link 0 -1) all-prefixes)
(setq link (substring link 0 -1))))
- (setq link (org-link-try-special-completion link))))
+ (setq link (with-current-buffer origbuf
+ (org-link-try-special-completion link)))))
(set-window-configuration wcf)
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
@@ -9357,7 +10072,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(setq org-stored-links (delq (assoc link org-stored-links)
org-stored-links)))
- (if (string-match org-plain-link-re link)
+ (if (and (string-match org-plain-link-re link)
+ (not (string-match org-ts-regexp link)))
;; URL-like link, normalize the use of angular brackets.
(setq link (org-remove-angle-brackets link)))
@@ -9429,7 +10145,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(defun org-file-complete-link (&optional arg)
"Create a file link using completion."
(let (file link)
- (setq file (read-file-name "File: "))
+ (setq file (org-iread-file-name "File: "))
(let ((pwd (file-name-as-directory (expand-file-name ".")))
(pwd1 (file-name-as-directory (abbreviate-file-name
(expand-file-name ".")))))
@@ -9447,6 +10163,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(t (setq link (concat "file:" file)))))
link))
+(defun org-iread-file-name (&rest args)
+ "Read-file-name using `ido-mode' speedup if available.
+ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'.
+See `read-file-name' for a description of parameters."
+ (org-without-partial-completion
+ (if (and org-completion-use-ido
+ (fboundp 'ido-read-file-name)
+ (boundp 'ido-mode) ido-mode
+ (listp (second args)))
+ (let ((ido-enter-matching-directory nil))
+ (apply 'ido-read-file-name args))
+ (apply 'read-file-name args))))
+
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
(let ((enable-recursive-minibuffers t)
@@ -9507,23 +10236,6 @@ from."
(org-add-props s nil 'org-attr attr))
s))
-(defun org-extract-attributes-from-string (tag)
- (let (key value attr)
- (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag)
- (setq key (match-string 1 tag) value (match-string 2 tag)
- tag (replace-match "" t t tag)
- attr (plist-put attr (intern key) value)))
- (cons tag attr)))
-
-(defun org-attributes-to-string (plist)
- "Format a property list into an HTML attribute list."
- (let ((s "") key value)
- (while plist
- (setq key (pop plist) value (pop plist))
- (and value
- (setq s (concat s " " (symbol-name key) "=\"" value "\""))))
- s))
-
;;; Opening/following a link
(defvar org-link-search-failed nil)
@@ -9545,45 +10257,35 @@ If it decides that it is not responsible for this link, it must return
nil to indicate that that Org-mode can continue with other options
like exact and fuzzy text search.")
-(defun org-next-link ()
+(defun org-next-link (&optional search-backward)
"Move forward to the next link.
If the link is in hidden text, expose it."
- (interactive)
+ (interactive "P")
(when (and org-link-search-failed (eq this-command last-command))
(goto-char (point-min))
(message "Link search wrapped back to beginning of buffer"))
(setq org-link-search-failed nil)
(let* ((pos (point))
(ct (org-context))
- (a (assoc :link ct)))
- (if a (goto-char (nth 2 a)))
- (if (re-search-forward org-any-link-re nil t)
+ (a (assoc :link ct))
+ (srch-fun (if search-backward 're-search-backward 're-search-forward)))
+ (cond (a (goto-char (nth (if search-backward 1 2) a)))
+ ((looking-at org-any-link-re)
+ ;; Don't stay stuck at link without an org-link face
+ (forward-char (if search-backward -1 1))))
+ (if (funcall srch-fun org-any-link-re nil t)
(progn
(goto-char (match-beginning 0))
(if (outline-invisible-p) (org-show-context)))
(goto-char pos)
(setq org-link-search-failed t)
- (error "No further link found"))))
+ (message "No further link found"))))
(defun org-previous-link ()
"Move backward to the previous link.
If the link is in hidden text, expose it."
(interactive)
- (when (and org-link-search-failed (eq this-command last-command))
- (goto-char (point-max))
- (message "Link search wrapped back to end of buffer"))
- (setq org-link-search-failed nil)
- (let* ((pos (point))
- (ct (org-context))
- (a (assoc :link ct)))
- (if a (goto-char (nth 1 a)))
- (if (re-search-backward org-any-link-re nil t)
- (progn
- (goto-char (match-beginning 0))
- (if (outline-invisible-p) (org-show-context)))
- (goto-char pos)
- (setq org-link-search-failed t)
- (error "No further link found"))))
+ (funcall 'org-next-link t))
(defun org-translate-link (s)
"Translate a link string if a translation function has been defined."
@@ -9614,8 +10316,7 @@ This is still an experimental function, your mileage may vary."
;; A typical message link. Planner has the id after the final slash,
;; we separate it with a hash mark
(setq path (concat (match-string 1 path) "#"
- (org-remove-angle-brackets (match-string 2 path)))))
- )
+ (org-remove-angle-brackets (match-string 2 path))))))
(cons type path))
(defun org-find-file-at-mouse (ev)
@@ -9638,7 +10339,7 @@ See the docstring of `org-open-file' for details."
This is saved in case the need arises to restore it.")
(defvar org-open-link-marker (make-marker)
- "Marker pointing to the location where `org-open-at-point; was called.")
+ "Marker pointing to the location where `org-open-at-point' was called.")
;;;###autoload
(defun org-open-at-point-global ()
@@ -9671,6 +10372,7 @@ Functions in this hook must return t if they identify and follow
a link at point. If they don't find anything interesting at point,
they must return nil.")
+(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
(defun org-open-at-point (&optional arg reference-buffer)
"Open link at or after point.
@@ -9717,7 +10419,8 @@ application the system uses for this file type."
(let (type path link line search (pos (point)))
(catch 'match
(save-excursion
- (skip-chars-forward "^]\n\r")
+ (or (org-in-regexp org-plain-link-re)
+ (skip-chars-forward "^]\n\r"))
(when (org-in-regexp org-bracket-link-regexp 1)
(setq link (org-extract-attributes
(org-link-unescape (org-match-string-no-properties 1))))
@@ -9743,17 +10446,29 @@ application the system uses for this file type."
(or (previous-single-property-change pos 'org-linked-text)
(point-min))
(or (next-single-property-change pos 'org-linked-text)
- (point-max))))
+ (point-max)))
+ ;; Ensure we will search for a <<<radio>>> link, not
+ ;; a simple reference like <<ref>>
+ path (concat "<" path))
(throw 'match t))
(save-excursion
- (let ((plinkpos (org-in-regexp org-plain-link-re)))
- (when (or (org-in-regexp org-angle-link-re)
- (and plinkpos (goto-char (car plinkpos))
- (save-match-data (not (looking-back "\\[\\[")))))
- (setq type (match-string 1)
- path (org-link-unescape (match-string 2)))
- (throw 'match t))))
+ (when (or (org-in-regexp org-angle-link-re)
+ (let ((match (org-in-regexp org-plain-link-re)))
+ ;; Check a plain link is not within a bracket link
+ (and match
+ (save-excursion
+ (save-match-data
+ (progn
+ (goto-char (car match))
+ (not (org-in-regexp org-bracket-link-regexp)))))))
+ (let ((line_ending (save-excursion (end-of-line) (point))))
+ ;; We are in a line before a plain or bracket link
+ (or (re-search-forward org-plain-link-re line_ending t)
+ (re-search-forward org-bracket-link-regexp line_ending t))))
+ (setq type (match-string 1)
+ path (org-link-unescape (match-string 2)))
+ (throw 'match t)))
(save-excursion
(when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
(setq type "tags"
@@ -9814,16 +10529,24 @@ application the system uses for this file type."
(apply cmd (nreverse args1))))
((member type '("http" "https" "ftp" "news"))
- (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
- (org-link-escape
- path org-link-escape-chars-browser)
- path))))
+ (browse-url
+ (concat type ":"
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ path)
+ (org-link-escape path org-link-escape-chars-browser)
+ path))))
((string= type "doi")
- (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path)
- (org-link-escape
- path org-link-escape-chars-browser)
- path))))
+ (browse-url
+ (concat org-doi-server-url
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ path)
+ (org-link-escape path org-link-escape-chars-browser)
+ path))))
((member type '("message"))
(browse-url (concat type ":" path)))
@@ -9879,8 +10602,15 @@ application the system uses for this file type."
(error "Abort"))))
((and (string= type "thisfile")
- (run-hook-with-args-until-success
- 'org-open-link-functions path)))
+ (or (run-hook-with-args-until-success
+ 'org-open-link-functions path)
+ (and link
+ (string-match "^id:" link)
+ (or (featurep 'org-id) (require 'org-id))
+ (progn
+ (funcall (nth 1 (assoc "id" org-link-protocols))
+ (substring path 3))
+ t)))))
((string= type "thisfile")
(if arg
@@ -9900,6 +10630,10 @@ application the system uses for this file type."
(move-marker org-open-link-marker nil)
(run-hook-with-args 'org-follow-link-hook)))
+(defsubst org-uniquify (list)
+ "Non-destructively remove duplicate elements from LIST."
+ (let ((res (copy-sequence list))) (delete-dups res)))
+
(defun org-offer-links-in-entry (buffer marker &optional nth zero)
"Offer links in the current entry and return the selected link.
If there is only one link, return it.
@@ -9958,7 +10692,7 @@ there is one, return it."
(setq nth (- c ?0))
(if have-zero (setq nth (1+ nth)))
(unless (and (integerp nth) (>= (length links) nth))
- (error "Invalid link selection"))
+ (user-error "Invalid link selection"))
(setq link (nth (1- nth) links)))))
(cons link end))))))
@@ -9972,15 +10706,7 @@ there is one, return it."
(defun org-open-file-with-emacs (path)
"Open file at PATH in Emacs."
(org-open-file path 'emacs))
-(defun org-remove-file-link-modifiers ()
- "Remove the file link modifiers in `file+sys:' and `file+emacs:' links."
- (goto-char (point-min))
- (while (re-search-forward "\\<file\\+\\(sys\\|emacs\\):" nil t)
- (org-if-unprotected
- (replace-match "file:" t t))))
-(eval-after-load "org-exp"
- '(add-hook 'org-export-preprocess-before-normalizing-links-hook
- 'org-remove-file-link-modifiers))
+
;;; File search
@@ -10019,16 +10745,15 @@ does handle the search, it must return a non-nil value to keep
other functions from trying.
Each function can access the current prefix argument through the
-variable `current-prefix-argument'. Note that a single prefix is
-used to force opening a link in Emacs, so it may be good to only
-use a numeric or double prefix to guide the search function.
+variable `current-prefix-arg'. Note that a single prefix is used
+to force opening a link in Emacs, so it may be good to only use a
+numeric or double prefix to guide the search function.
In case this is needed, a function in this hook can also restore
the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)")
-(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
(defun org-link-search (s &optional type avoid-pos stealth)
"Search for a link search option.
If S is surrounded by forward slashes, it is interpreted as a
@@ -10060,7 +10785,8 @@ visibility around point, thus ignoring
(goto-char (point-min))
(and
(re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
+ (concat "^[ \t]*:CUSTOM_ID:[ \t]+"
+ (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
(setq type 'dedicated
pos (match-beginning 0))))
;; There is an exact target for this
@@ -10079,14 +10805,6 @@ visibility around point, thus ignoring
(goto-char (point-min))
(and
(re-search-forward
- (format "^[ \t]*#\\+TARGET: %s" (regexp-quote s0)) nil t)
- (setq type 'dedicated pos (match-beginning 0))))
- ;; Found an invisible target.
- (goto-char pos))
- ((save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
(format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t)
(setq type 'dedicated pos (match-beginning 0))))
;; Found an element with a matching #+name affiliated keyword.
@@ -10109,8 +10827,6 @@ visibility around point, thus ignoring
(cond
((derived-mode-p 'org-mode)
(org-occur (match-string 1 s)))
- ;;((eq major-mode 'dired-mode)
- ;; (grep (concat "grep -n -e '" (match-string 1 s) "' *")))
(t (org-do-occur (match-string 1 s)))))
((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline)
(and (equal (string-to-char s) ?*) (setq s (substring s 1)))
@@ -10149,9 +10865,11 @@ visibility around point, thus ignoring
re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
"\\)" markers)
- re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]")
+ re2a_ (concat "\\(" (mapconcat 'downcase words
+ "[ \t\r\n]+") "\\)[ \t\r\n]")
re2a (concat "[ \t\r\n]" re2a_)
- re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
+ re4_ (concat "\\(" (mapconcat 'downcase words
+ "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
re4 (concat "[^a-zA-Z_]" re4_)
re1 (concat pre re2 post)
@@ -10162,21 +10880,20 @@ visibility around point, thus ignoring
re4 (concat pre (if pre re4_ re4))
reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
"\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
- re5 "\\)"
- ))
+ re5 "\\)"))
(cond
((eq type 'org-occur) (org-occur reall))
((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
(t (goto-char (point-min))
(setq type 'fuzzy)
- (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated))
+ (if (or (and (org-search-not-self 1 re0 nil t)
+ (setq type 'dedicated))
(org-search-not-self 1 re1 nil t)
(org-search-not-self 1 re2 nil t)
(org-search-not-self 1 re2a nil t)
(org-search-not-self 1 re3 nil t)
(org-search-not-self 1 re4 nil t)
- (org-search-not-self 1 re5 nil t)
- )
+ (org-search-not-self 1 re5 nil t))
(goto-char (match-beginning 1))
(goto-char pos)
(error "No match"))))))
@@ -10190,7 +10907,7 @@ visibility around point, thus ignoring
enclose the position of `org-open-link-marker'."
(let ((m org-open-link-marker))
(catch 'exit
- (while (apply 're-search-forward args)
+ (while (apply #'re-search-forward args)
(unless (get-text-property (match-end group) 'intangible) ; Emacs 21
(goto-char (match-end group))
(if (and (or (not (eq (marker-buffer m) (current-buffer)))
@@ -10416,7 +11133,7 @@ If the file does not exist, an error is thrown."
(if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
(not (file-exists-p file))
(not org-open-non-existing-files))
- (error "No such file: %s" file))
+ (user-error "No such file: %s" file))
(cond
((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
;; Remove quotes around the file name - we'll use shell-quote-argument.
@@ -10442,9 +11159,9 @@ If the file does not exist, an error is thrown."
(setq match-index (+ match-index 1)))))
(save-window-excursion
+ (message "Running %s...done" cmd)
(start-process-shell-command cmd nil cmd)
- (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
- ))
+ (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))))
((or (stringp cmd)
(eq cmd 'emacs))
(funcall (cdr (assq 'file org-link-frame-setup)) file)
@@ -10470,7 +11187,7 @@ org-open-file.
It assumes that is the case when the entry uses a regular
expression which has at least one grouping construct and the
action is either a lisp form or a command string containing
-'%1', i.e. using at least one subexpression match as a
+`%1', i.e. using at least one subexpression match as a
parameter."
(let ((selector (car entry))
(action (cdr entry)))
@@ -10541,12 +11258,9 @@ on the system \"/user@host:\"."
((eq t org-reverse-note-order) t)
((not (listp org-reverse-note-order)) nil)
(t (catch 'exit
- (let ((all org-reverse-note-order)
- entry)
- (while (setq entry (pop all))
- (if (string-match (car entry) buffer-file-name)
- (throw 'exit (cdr entry))))
- nil)))))
+ (dolist (entry org-reverse-note-order)
+ (if (string-match (car entry) buffer-file-name)
+ (throw 'exit (cdr entry))))))))
(defvar org-refile-target-table nil
"The list of refile targets, created by `org-refile'.")
@@ -10581,9 +11295,10 @@ on the system \"/user@host:\"."
(let (marker)
(catch 'exit
(while (and set (setq marker (nth 3 (pop set))))
- ;; if org-refile-use-outline-path is 'file, marker may be nil
+ ;; If `org-refile-use-outline-path' is 'file, marker may be nil
(when (and marker (null (marker-buffer marker)))
- (message "not found") (sit-for 3)
+ (message "Please regenerate the refile cache with `C-0 C-c C-w'")
+ (sit-for 3)
(throw 'exit nil)))
t)))
@@ -10610,10 +11325,10 @@ on the system \"/user@host:\"."
(let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word
(entries (or org-refile-targets '((nil . (:level . 1)))))
- targets tgs txt re files f desc descre fast-path-p level pos0)
+ targets tgs txt re files desc descre fast-path-p level pos0)
(message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer))
- (while (setq entry (pop entries))
+ (dolist (entry entries)
(setq files (car entry) desc (cdr entry))
(setq fast-path-p nil)
(cond
@@ -10646,7 +11361,7 @@ on the system \"/user@host:\"."
(cdr desc)))
"\\}[ \t]")))
(t (error "Bad refiling target description %s" desc)))
- (while (setq f (pop files))
+ (dolist (f files)
(with-current-buffer
(if (bufferp f) f (org-get-agenda-file-buffer f))
(or
@@ -10674,7 +11389,7 @@ on the system \"/user@host:\"."
(setq level (org-reduced-level
(- (match-end 1) (match-beginning 1)))
txt (org-link-display-format (match-string 4))
- txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt)
+ txt (replace-regexp-in-string "\\( *[[0-9]+/?[0-9]*%?]\\)+$" "" txt)
re (format org-complex-heading-regexp-format
(regexp-quote (match-string 4))))
(when org-refile-use-outline-path
@@ -10701,8 +11416,7 @@ on the system \"/user@host:\"."
(goto-char (point-at-eol))))))))
(when org-refile-use-cache
(org-refile-cache-put tgs (buffer-file-name) descre))
- (setq targets (append tgs targets))
- ))))
+ (setq targets (append tgs targets))))))
(message "Getting targets...done")
(nreverse targets)))
@@ -10734,14 +11448,21 @@ avoiding backtracing. Refile target collection makes use of that."
(widen)
(while (org-up-heading-safe)
(when (looking-at org-complex-heading-regexp)
- (push (org-match-string-no-properties 4) rtn)))
+ (push (org-trim
+ (replace-regexp-in-string
+ ;; Remove statistical/checkboxes cookies
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-match-string-no-properties 4)))
+ rtn)))
rtn)))))
-(defun org-format-outline-path (path &optional width prefix)
+(defun org-format-outline-path (path &optional width prefix separator)
"Format the outline path PATH for display.
-Width is the maximum number of characters that is available.
-Prefix is a prefix to be included in the returned string,
-such as the file name."
+WIDTH is the maximum number of characters that is available.
+PREFIX is a prefix to be included in the returned string,
+such as the file name.
+SEPARATOR is inserted between the different parts of the path,
+the default is \"/\"."
(setq width (or width 79))
(if prefix (setq width (- width (length prefix))))
(if (not path)
@@ -10757,6 +11478,7 @@ such as the file name."
(total (1+ (length prefix))))
(setq maxwidth (max maxwidth 10))
(concat prefix
+ (if prefix (or separator "/"))
(mapconcat
(lambda (h)
(setq n (1+ n))
@@ -10773,24 +11495,35 @@ such as the file name."
(nth (% (1- n) org-n-level-faces)
org-level-faces))
h)
- path "/")))))
+ path (or separator "/"))))))
+
+(defun org-display-outline-path (&optional file current separator just-return-string)
+ "Display the current outline path in the echo area.
-(defun org-display-outline-path (&optional file current)
- "Display the current outline path in the echo area."
+If FILE is non-nil, prepend the output with the file name.
+If CURRENT is non-nil, append the current heading to the output.
+SEPARATOR is passed through to `org-format-outline-path'. It separates
+the different parts of the path and defaults to \"/\".
+If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
(interactive "P")
- (let* ((bfn (buffer-file-name (buffer-base-buffer)))
- (case-fold-search nil)
- (path (and (derived-mode-p 'org-mode) (org-get-outline-path))))
+ (let* (case-fold-search
+ (bfn (buffer-file-name (buffer-base-buffer)))
+ (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
+ res)
(if current (setq path (append path
(save-excursion
(org-back-to-heading t)
(if (looking-at org-complex-heading-regexp)
(list (match-string 4)))))))
- (message "%s"
- (org-format-outline-path
- path
- (1- (frame-width))
- (and file bfn (concat (file-name-nondirectory bfn) "/"))))))
+ (setq res
+ (org-format-outline-path
+ path
+ (1- (frame-width))
+ (and file bfn (concat (file-name-nondirectory bfn) separator))
+ separator))
+ (if just-return-string
+ (org-no-properties res)
+ (org-unlogged-message "%s" res))))
(defvar org-refile-history nil
"History for refiling operations.")
@@ -10801,7 +11534,16 @@ Note that this is still *before* the stuff will be removed from
the *old* location.")
(defvar org-capture-last-stored-marker)
-(defun org-refile (&optional goto default-buffer rfloc)
+(defvar org-refile-keep nil
+ "Non-nil means `org-refile' will copy instead of refile.")
+
+(defun org-copy ()
+ "Like `org-refile', but copy."
+ (interactive)
+ (let ((org-refile-keep t))
+ (funcall 'org-refile nil nil nil "Copy")))
+
+(defun org-refile (&optional goto default-buffer rfloc msg)
"Move the entry or entries at point to another heading.
The list of target headings is compiled using the information in
`org-refile-targets', which see.
@@ -10820,10 +11562,19 @@ and not actually move anything.
With a double prefix arg \\[universal-argument] \\[universal-argument], \
go to the location where the last refiling operation has put the subtree.
-With a prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `3', emulate `org-refile-keep'
+being set to t and copy to the target location, don't move it.
+Beware that keeping refiled entries may result in duplicated ID
+properties.
RFLOC can be a refile location obtained in a different way.
+MSG is a string to replace \"Refile\" in the default prompt with
+another verb. E.g. `org-copy' sets this parameter to \"Copy\".
+
See also `org-refile-use-outline-path' and `org-completion-use-ido'.
If you are using target caching (see `org-refile-use-cache'),
@@ -10834,12 +11585,15 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(interactive "P")
(if (member goto '(0 (64)))
(org-refile-cache-clear)
- (let* ((cbuf (current-buffer))
+ (let* ((actionmsg (cond (msg msg)
+ ((equal goto 3) "Refile (and keep)")
+ (t "Refile")))
+ (cbuf (current-buffer))
(regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
- (region-length (and regionp (- region-end region-start)))
(filename (buffer-file-name (buffer-base-buffer cbuf)))
+ (org-refile-keep (if (equal goto 3) t org-refile-keep))
pos it nbuf file re level reversed)
(setq last-command nil)
(when regionp
@@ -10849,8 +11603,10 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(unless (or (org-kill-is-subtree-p
(buffer-substring region-start region-end))
(prog1 org-refile-active-region-within-subtree
- (org-toggle-heading)))
- (error "The region is not a (sequence of) subtree(s)")))
+ (let ((s (point-at-eol)))
+ (org-toggle-heading)
+ (setq region-end (+ (- (point-at-eol) s) region-end)))))
+ (user-error "The region is not a (sequence of) subtree(s)")))
(if (equal goto '(16))
(org-refile-goto-last-stored)
(when (or
@@ -10866,14 +11622,15 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(setq it (or rfloc
(let (heading-text)
(save-excursion
- (unless goto
+ (unless (and goto (listp goto))
(org-back-to-heading t)
(setq heading-text
(nth 4 (org-heading-components))))
+
(org-refile-get-location
- (cond (goto "Goto")
- (regionp "Refile region to")
- (t (concat "Refile subtree \""
+ (cond ((and goto (listp goto)) "Goto")
+ (regionp (concat actionmsg " region to"))
+ (t (concat actionmsg " subtree \""
heading-text "\" to")))
default-buffer
(and (not (equal '(4) goto))
@@ -10895,7 +11652,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
- (if goto
+ (if (and goto (not (equal goto 3)))
(progn
(org-pop-to-buffer-same-window nbuf)
(goto-char pos)
@@ -10930,30 +11687,38 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(if (not (bolp)) (newline))
(org-paste-subtree level)
(when org-log-refile
- (org-add-log-setup 'refile nil nil 'findpos
- org-log-refile)
+ (org-add-log-setup 'refile nil nil 'findpos org-log-refile)
(unless (eq org-log-refile 'note)
(save-excursion (org-add-log-note))))
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-set-tags nil t)))
- (with-demoted-errors
- (bookmark-set "org-refile-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
;; If we are refiling for capture, make sure that the
;; last-capture pointers point here
(when (org-bound-and-true-p org-refile-for-capture)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored-marker"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(run-hooks 'org-after-refile-insert-hook))))
- (if regionp
- (delete-region (point) (+ (point) region-length))
- (org-cut-subtree))
+ (unless org-refile-keep
+ (if regionp
+ (delete-region (point) (+ (point) (- region-end region-start)))
+ (delete-region
+ (and (org-back-to-heading t) (point))
+ (min (1+ (buffer-size)) (org-end-of-subtree t t) (point)))))
(when (featurep 'org-inlinetask)
(org-inlinetask-remove-END-maybe))
(setq org-markers-to-move nil)
- (message "Refiled to \"%s\" in file %s" (car it) file)))))))
+ (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file)))))))
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
@@ -10961,6 +11726,17 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(bookmark-jump "org-refile-last-stored")
(message "This is the location of the last refile"))
+(defun org-refile--get-location (refloc tbl)
+ "When user refile to REFLOC, find the associated target in TBL.
+Also check `org-refile-target-table'."
+ (car (delq
+ nil
+ (mapcar
+ (lambda (r) (or (assoc r tbl)
+ (assoc r org-refile-target-table)))
+ (list (replace-regexp-in-string "/$" "" refloc)
+ (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc))))))
+
(defun org-refile-get-location (&optional prompt default-buffer new-nodes
no-exclude)
"Prompt the user for a refile location, using PROMPT.
@@ -10982,12 +11758,8 @@ this is used for the GOTO interface."
(setq org-refile-target-table
(org-refile-get-targets default-buffer excluded-entries)))
(unless org-refile-target-table
- (error "No refile targets"))
- (let* ((prompt (concat prompt
- (and (car org-refile-history)
- (concat " (default " (car org-refile-history) ")"))
- ": "))
- (cbuf (current-buffer))
+ (user-error "No refile targets"))
+ (let* ((cbuf (current-buffer))
(partial-completion-mode nil)
(cfn (buffer-file-name (buffer-base-buffer cbuf)))
(cfunc (if (and org-refile-use-outline-path
@@ -10995,6 +11767,7 @@ this is used for the GOTO interface."
'org-olpath-completing-read
'org-icompleting-read))
(extra (if org-refile-use-outline-path "/" ""))
+ (cbnex (concat (buffer-name) extra))
(filename (and cfn (expand-file-name cfn)))
(tbl (mapcar
(lambda (x)
@@ -11007,14 +11780,19 @@ this is used for the GOTO interface."
(cons (concat (car x) extra) (cdr x))))
org-refile-target-table))
(completion-ignore-case t)
+ cdef
+ (prompt (concat prompt
+ (or (and (car org-refile-history)
+ (concat " (default " (car org-refile-history) ")"))
+ (and (assoc cbnex tbl) (setq cdef cbnex)
+ (concat " (default " cbnex ")"))) ": "))
pa answ parent-target child parent old-hist)
(setq old-hist org-refile-history)
(setq answ (funcall cfunc prompt tbl nil (not new-nodes)
- nil 'org-refile-history (car org-refile-history)))
- (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl)))
- (org-refile-check-position pa)
- (if pa
+ nil 'org-refile-history (or cdef (car org-refile-history))))
+ (if (setq pa (org-refile--get-location answ tbl))
(progn
+ (org-refile-check-position pa)
(when (or (not org-refile-history)
(not (eq old-hist org-refile-history))
(not (equal (car pa) (car org-refile-history))))
@@ -11029,15 +11807,14 @@ this is used for the GOTO interface."
(progn
(setq parent (match-string 1 answ)
child (match-string 2 answ))
- (setq parent-target (or (assoc parent tbl)
- (assoc (concat parent "/") tbl)))
+ (setq parent-target (org-refile--get-location parent tbl))
(when (and parent-target
(or (eq new-nodes t)
(and (eq new-nodes 'confirm)
(y-or-n-p (format "Create new node \"%s\"? "
child)))))
(org-refile-new-child parent-target child)))
- (error "Invalid target location")))))
+ (user-error "Invalid target location")))))
(declare-function org-string-nw-p "org-macs" (s))
(defun org-refile-check-position (refile-pointer)
@@ -11047,7 +11824,7 @@ this is used for the GOTO interface."
(pos (nth 3 refile-pointer))
buffer)
(if (and (not (markerp pos)) (not file))
- (error "Please save the buffer to a file before refiling")
+ (user-error "Please save the buffer to a file before refiling")
(when (org-string-nw-p re)
(setq buffer (if (markerp pos)
(marker-buffer pos)
@@ -11060,7 +11837,7 @@ this is used for the GOTO interface."
(goto-char pos)
(beginning-of-line 1)
(unless (org-looking-at-p re)
- (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))))
+ (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))))
(defun org-refile-new-child (parent-target child)
"Use refile target PARENT-TARGET to add new CHILD below it."
@@ -11161,7 +11938,7 @@ PLIST must contain a :name entry which is used as name of the block."
This empties the block, puts the cursor at the insert position and returns
the property list including an extra property :name with the block name."
(unless (looking-at org-dblock-start-re)
- (error "Not at a dynamic block"))
+ (user-error "Not at a dynamic block"))
(let* ((begdel (1+ (match-end 0)))
(name (org-no-properties (match-string 1)))
(params (append (list :name name)
@@ -11212,8 +11989,9 @@ blocks in the buffer."
This means to empty the block, parse for parameters and then call
the correct writing function."
(interactive)
- (save-window-excursion
- (let* ((pos (point))
+ (save-excursion
+ (let* ((win (selected-window))
+ (pos (point))
(line (org-current-line))
(params (org-prepare-dblock))
(name (plist-get params :name))
@@ -11226,6 +12004,7 @@ the correct writing function."
(when (and indent (> indent 0))
(setq indent (make-string indent ?\ ))
(save-excursion
+ (select-window win)
(org-beginning-of-dblock)
(forward-line 1)
(while (not (looking-at org-dblock-end-re))
@@ -11260,75 +12039,45 @@ This function can be used in a hook."
;;;; Completion
-(defconst org-additional-option-like-keywords
- '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:"
- "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:"
- "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:"
- "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:"
- "BEGIN:" "END:"
- "ORGTBL" "TBLFM:" "TBLNAME:"
- "BEGIN_EXAMPLE" "END_EXAMPLE"
- "BEGIN_VERBATIM" "END_VERBATIM"
- "BEGIN_QUOTE" "END_QUOTE"
- "BEGIN_VERSE" "END_VERSE"
- "BEGIN_CENTER" "END_CENTER"
- "BEGIN_SRC" "END_SRC"
- "BEGIN_RESULT" "END_RESULT"
- "BEGIN_lstlisting" "END_lstlisting"
- "NAME:" "RESULTS:"
- "HEADER:" "HEADERS:"
- "COLUMNS:" "PROPERTY:"
- "CAPTION:" "LABEL:"
- "SETUPFILE:"
- "INCLUDE:" "INDEX:"
- "BIND:"
- "MACRO:"))
+(declare-function org-export-backend-name "org-export" (cl-x))
+(declare-function org-export-backend-options "org-export" (cl-x))
+(defun org-get-export-keywords ()
+ "Return a list of all currently understood export keywords.
+Export keywords include options, block names, attributes and
+keywords relative to each registered export back-end."
+ (let (keywords)
+ (dolist (backend
+ (org-bound-and-true-p org-export--registered-backends)
+ (delq nil keywords))
+ ;; Back-end name (for keywords, like #+LATEX:)
+ (push (upcase (symbol-name (org-export-backend-name backend))) keywords)
+ (dolist (option-entry (org-export-backend-options backend))
+ ;; Back-end options.
+ (push (nth 1 option-entry) keywords)))))
(defconst org-options-keywords
- '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:"
- "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:"
- "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:"
- "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:"
- "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:"
- "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:"
- "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:"))
-
-(defconst org-additional-option-like-keywords-for-flyspell
- (delete-dups
- (split-string
- (mapconcat (lambda(k)
- (replace-regexp-in-string
- "_\\|:" " "
- (concat k " " (downcase k) " " (upcase k))))
- (append org-options-keywords org-additional-option-like-keywords)
- " ")
- " +" t)))
+ '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
+ "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:"
+ "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:"
+ "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:"
+ "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
(defcustom org-structure-template-alist
- '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC"
- "<src lang=\"?\">\n\n</src>")
- ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE"
- "<example>\n?\n</example>")
- ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE"
- "<quote>\n?\n</quote>")
- ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE"
- "<verse>\n?\n</verse>")
- ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM"
- "<verbatim>\n?\n</verbatim>")
- ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER"
- "<center>\n?\n</center>")
+ '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>")
+ ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>")
+ ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "<quote>\n?\n</quote>")
+ ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>")
+ ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>")
+ ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>")
("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX"
"<literal style=\"latex\">\n?\n</literal>")
- ("L" "#+LaTeX: "
- "<literal style=\"latex\">?</literal>")
+ ("L" "#+LaTeX: " "<literal style=\"latex\">?</literal>")
("h" "#+BEGIN_HTML\n?\n#+END_HTML"
"<literal style=\"html\">\n?\n</literal>")
- ("H" "#+HTML: "
- "<literal style=\"html\">?</literal>")
- ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII")
- ("A" "#+ASCII: ")
- ("i" "#+INDEX: ?"
- "#+INDEX: ?")
+ ("H" "#+HTML: " "<literal style=\"html\">?</literal>")
+ ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "")
+ ("A" "#+ASCII: " "")
+ ("i" "#+INDEX: ?" "#+INDEX: ?")
("I" "#+INCLUDE: %file ?"
"<include file=%file markup=\"?\">"))
"Structure completion elements.
@@ -11336,16 +12085,17 @@ This is a list of abbreviation keys and values. The value gets inserted
if you type `<' followed by the key and then press the completion key,
usually `M-TAB'. %file will be replaced by a file name after prompting
for the file using completion. The cursor will be placed at the position
-of the `?` in the template.
+of the `?' in the template.
There are two templates for each key, the first uses the original Org syntax,
the second uses Emacs Muse-like syntax tags. These Muse-like tags become
the default when the /org-mtags.el/ module has been loaded. See also the
variable `org-mtags-prefer-muse-templates'."
:group 'org-completion
:type '(repeat
- (string :tag "Key")
- (string :tag "Template")
- (string :tag "Muse Template")))
+ (list
+ (string :tag "Key")
+ (string :tag "Template")
+ (string :tag "Muse Template"))))
(defun org-try-structure-completion ()
"Try to complete a structure template before point.
@@ -11429,10 +12179,12 @@ nil or a string to be used for the todo mark." )
(let* ((ct (org-current-time))
(dct (decode-time ct))
(ct1
- (if (and org-use-effective-time
- (< (nth 2 dct) org-extend-today-until))
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
- ct)))
+ (cond
+ (org-use-last-clock-out-time-as-effective-time
+ (or (org-clock-get-last-clock-out-time) ct))
+ ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until))
+ (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)))
+ (t ct))))
ct1))
(defun org-todo-yesterday (&optional arg)
@@ -11445,6 +12197,9 @@ nil or a string to be used for the todo mark." )
(org-extend-today-until (1+ hour)))
(org-todo arg))))
+(defvar org-block-entry-blocking ""
+ "First entry preventing the TODO state change.")
+
(defun org-todo (&optional arg)
"Change the TODO state of an item.
The state of an item is given by a keyword at the start of the heading,
@@ -11467,13 +12222,13 @@ With a triple \\[universal-argument] prefix, circumvent any state blocking.
With a numeric prefix arg of 0, inhibit note taking for the change.
For calling through lisp, arg is also interpreted in the following way:
-'none -> empty state
-\"\"(empty string) -> switch to empty state
-'done -> switch to DONE
-'nextset -> switch to the next set of keywords
-'previousset -> switch to the previous set of keywords
-\"WAITING\" -> switch to the specified keyword, but only if it
- really is a member of `org-todo-keywords'."
+`none' -> empty state
+\"\" (empty string) -> switch to empty state
+`done' -> switch to DONE
+`nextset' -> switch to the next set of keywords
+`previousset' -> switch to the previous set of keywords
+\"WAITING\" -> switch to the specified keyword, but only if it
+ really is a member of `org-todo-keywords'."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
@@ -11536,8 +12291,7 @@ For calling through lisp, arg is also interpreted in the following way:
(not org-todo-key-trigger)))
;; Read a state with completion
(org-icompleting-read
- "State: " (mapcar (lambda(x) (list x))
- org-todo-keywords-1)
+ "State: " (mapcar 'list org-todo-keywords-1)
nil t))
((eq arg 'right)
(if this
@@ -11568,7 +12322,7 @@ For calling through lisp, arg is also interpreted in the following way:
(car org-todo-heads))))
((car (member arg org-todo-keywords-1)))
((stringp arg)
- (error "State `%s' not valid in this file" arg))
+ (user-error "State `%s' not valid in this file" arg))
((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
((null member) (or head (car org-todo-keywords-1)))
@@ -11599,9 +12353,11 @@ For calling through lisp, arg is also interpreted in the following way:
(run-hook-with-args-until-failure
'org-blocker-hook change-plist))))
(if (org-called-interactively-p 'interactive)
- (error "TODO state change from %s to %s blocked" this org-state)
+ (user-error "TODO state change from %s to %s blocked (by \"%s\")"
+ this org-state org-block-entry-blocking)
;; fail silently
- (message "TODO state change from %s to %s blocked" this org-state)
+ (message "TODO state change from %s to %s blocked (by \"%s\")"
+ this org-state org-block-entry-blocking)
(throw 'exit nil))))
(store-match-data match-data)
(replace-match next t t)
@@ -11632,9 +12388,10 @@ For calling through lisp, arg is also interpreted in the following way:
(nth 2 (assoc this org-todo-log-states))))
(if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
(setq dolog 'time))
- (when (and org-state
- (member org-state org-not-done-keywords)
- (not (member this org-not-done-keywords)))
+ (when (or (and (not org-state) (not org-closed-keep-when-no-todo))
+ (and org-state
+ (member org-state org-not-done-keywords)
+ (not (member this org-not-done-keywords))))
;; This is now a todo state and was not one before
;; If there was a CLOSED time stamp, get rid of it.
(org-add-planning-info nil nil 'closed))
@@ -11715,7 +12472,8 @@ changes. Such blocking occurs when:
;; completed
(if (and (not (org-entry-is-done-p))
(org-entry-is-todo-p))
- (throw 'dont-block nil))
+ (progn (setq org-block-entry-blocking (org-get-heading))
+ (throw 'dont-block nil)))
(outline-next-heading)
(setq child-level (funcall outline-level))))))
;; Otherwise, if the task's parent has the :ORDERED: property, and
@@ -11728,6 +12486,7 @@ changes. Such blocking occurs when:
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t))
+ (setq org-block-entry-blocking (match-string 0))
(throw 'dont-block nil)) ; block, there is an older sibling not done.
;; Search further up the hierarchy, to see if an ancestor is blocked
(while t
@@ -11739,7 +12498,8 @@ changes. Such blocking occurs when:
(if (not parent-pos) (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
- (re-search-forward org-not-done-heading-regexp pos t))
+ (re-search-forward org-not-done-heading-regexp pos t)
+ (setq org-block-entry-blocking (org-get-heading)))
(throw 'dont-block nil)))))))) ; block, older sibling not done.
(defcustom org-track-ordered-property-with-tag nil
@@ -11772,7 +12532,7 @@ See variable `org-track-ordered-property-with-tag'."
(org-back-to-heading)
(if (org-entry-get nil "ORDERED")
(progn
- (org-delete-property "ORDERED")
+ (org-delete-property "ORDERED" "PROPERTIES")
(and tag (org-toggle-tag tag 'off))
(message "Subtasks can be completed in arbitrary order"))
(org-entry-put nil "ORDERED" "t")
@@ -11816,16 +12576,15 @@ changes because there are unchecked boxes in this entry."
(defun org-entry-blocked-p ()
"Is the current entry blocked?"
- (org-with-buffer-modified-unmodified
+ (org-with-silent-modifications
(if (org-entry-get nil "NOBLOCKING")
nil ;; Never block this entry
- (not
- (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position (point)
- :from 'todo
- :to 'done))))))
+ (not (run-hook-with-args-until-failure
+ 'org-blocker-hook
+ (list :type 'todo-state-change
+ :position (point)
+ :from 'todo
+ :to 'done))))))
(defun org-update-statistics-cookies (all)
"Update the statistics cookie, either from TODO or from checkboxes.
@@ -11928,7 +12687,8 @@ statistics everywhere."
(outline-next-heading)))
(setq new
(if is-percent
- (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all)))
+ (format "[%d%%]" (floor (* 100.0 cnt-done)
+ (max 1 cnt-all)))
(format "[%d/%d]" cnt-done cnt-all))
ndel (- (match-end 0) checkbox-beg))
;; handle overlays when updating cookie from column view
@@ -11983,20 +12743,19 @@ This hook runs even if there is no statistics cookie present, in which case
(defun org-local-logging (value)
"Get logging settings from a property VALUE."
- (let* (words w a)
- ;; directly set the variables, they are already local.
- (setq org-log-done nil
- org-log-repeat nil
- org-todo-log-states nil)
- (setq words (org-split-string value))
- (while (setq w (pop words))
+ ;; Directly set the variables, they are already local.
+ (setq org-log-done nil
+ org-log-repeat nil
+ org-todo-log-states nil)
+ (dolist (w (org-split-string value))
+ (let* (a)
(cond
((setq a (assoc w org-startup-options))
- (and (member (nth 1 a) '(org-log-done org-log-repeat))
- (set (nth 1 a) (nth 2 a))))
+ (and (member (nth 1 a) '(org-log-done org-log-repeat))
+ (set (nth 1 a) (nth 2 a))))
((setq a (org-extract-log-state-settings w))
- (and (member (car a) org-todo-keywords-1)
- (push a org-todo-log-states)))))))
+ (and (member (car a) org-todo-keywords-1)
+ (push a org-todo-log-states)))))))
(defun org-get-todo-sequence-head (kwd)
"Return the head of the TODO sequence to which KWD belongs.
@@ -12026,7 +12785,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(expert nil)
(fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth))
- tg cnt e c tbl
+ tg cnt c tbl
groups ingroup)
(save-excursion
(save-window-excursion
@@ -12036,7 +12795,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(erase-buffer)
(org-set-local 'org-done-keywords done-keywords)
(setq tbl fulltable cnt 0)
- (while (setq e (pop tbl))
+ (dolist (e tbl)
(cond
((equal e '(:startgroup))
(push '() groups) (setq ingroup t)
@@ -12088,6 +12847,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(member (org-get-todo-state) org-done-keywords))
(defun org-get-todo-state ()
+ "Return the TODO keyword of the current subtree."
(save-excursion
(org-back-to-heading t)
(and (looking-at org-todo-line-regexp)
@@ -12180,7 +12940,7 @@ This function is run automatically after each state change to a DONE state."
what (match-string 3 ts))
(if (equal what "w") (setq n (* n 7) what "d"))
(if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
- (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
+ (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
;; Preparation, see if we need to modify the start date for the change
(when (match-end 1)
(setq time (save-match-data (org-time-string-to-time ts)))
@@ -12207,7 +12967,7 @@ This function is run automatically after each state change to a DONE state."
(org-at-timestamp-p t)
(setq ts (match-string 1))
(string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
- (org-timestamp-change n (cdr (assoc what whata)))
+ (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t))
(setq msg (concat msg type " " org-last-changed-timestamp " "))))
(setq org-log-post-message msg)
(message "%s" msg))))
@@ -12232,13 +12992,14 @@ of `org-todo-keywords-1'."
((<= (prefix-numeric-value arg) (length org-todo-keywords-1))
(regexp-quote (nth (1- (prefix-numeric-value arg))
org-todo-keywords-1)))
- (t (error "Invalid prefix argument: %s" arg)))))
+ (t (user-error "Invalid prefix argument: %s" arg)))))
(message "%d TODO entries found"
(org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
-(defun org-deadline (&optional remove time)
+(defun org-deadline (arg &optional time)
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
-With argument REMOVE, remove any deadline from the item.
+With one universal prefix argument, remove any deadline from the item.
+With two universal prefix arguments, prompt for a warning delay.
With argument TIME, set the deadline at the corresponding date. TIME
can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
@@ -12247,22 +13008,43 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-deadline ',remove ,time)
+ `(org-deadline ',arg ,time)
org-loop-over-headlines-in-active-region
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "DEADLINE"))
+ (old-date-time (if old-date (org-time-string-to-time old-date)))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-redeadline)
- (org-add-log-setup 'deldeadline nil old-date 'findpos
- org-log-redeadline))
- (org-remove-timestamp-with-keyword org-deadline-string)
- (message "Item no longer has a deadline."))
+ (cond
+ ((equal arg '(4))
+ (when (and old-date org-log-redeadline)
+ (org-add-log-setup 'deldeadline nil old-date 'findpos
+ org-log-redeadline))
+ (org-remove-timestamp-with-keyword org-deadline-string)
+ (message "Item no longer has a deadline."))
+ ((equal arg '(16))
+ (save-excursion
+ (org-back-to-heading t)
+ (if (re-search-forward
+ org-deadline-time-regexp
+ (save-excursion (outline-next-heading) (point)) t)
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
+ (replace-match
+ (concat org-deadline-string
+ " <" rpl
+ (format " -%dd"
+ (abs
+ (- (time-to-days
+ (save-match-data
+ (org-read-date nil t nil "Warn starting from" old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))
+ (user-error "No deadline information to update"))))
+ (t
(org-add-planning-info 'deadline time 'closed)
(when (and old-date org-log-redeadline
(not (equal old-date
@@ -12282,11 +13064,12 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
- (message "Deadline on %s" org-last-inserted-timestamp)))))
+ (message "Deadline on %s" org-last-inserted-timestamp))))))
-(defun org-schedule (&optional remove time)
+(defun org-schedule (arg &optional time)
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
-With argument REMOVE, remove any scheduling date from the item.
+With one universal prefix argument, remove any scheduling date from the item.
+With two universal prefix arguments, prompt for a delay cookie.
With argument TIME, scheduled at the corresponding date. TIME can
either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
@@ -12295,22 +13078,44 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- `(org-schedule ',remove ,time)
+ `(org-schedule ',arg ,time)
org-loop-over-headlines-in-active-region
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
(let* ((old-date (org-entry-get nil "SCHEDULED"))
+ (old-date-time (if old-date (org-time-string-to-time old-date)))
(repeater (and old-date
(string-match
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
old-date)
(match-string 1 old-date))))
- (if remove
- (progn
- (when (and old-date org-log-reschedule)
- (org-add-log-setup 'delschedule nil old-date 'findpos
- org-log-reschedule))
- (org-remove-timestamp-with-keyword org-scheduled-string)
- (message "Item is no longer scheduled."))
+ (cond
+ ((equal arg '(4))
+ (progn
+ (when (and old-date org-log-reschedule)
+ (org-add-log-setup 'delschedule nil old-date 'findpos
+ org-log-reschedule))
+ (org-remove-timestamp-with-keyword org-scheduled-string)
+ (message "Item is no longer scheduled.")))
+ ((equal arg '(16))
+ (save-excursion
+ (org-back-to-heading t)
+ (if (re-search-forward
+ org-scheduled-time-regexp
+ (save-excursion (outline-next-heading) (point)) t)
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
+ (replace-match
+ (concat org-scheduled-string
+ " <" rpl
+ (format " -%dd"
+ (abs
+ (- (time-to-days
+ (save-match-data
+ (org-read-date nil t nil "Delay until" old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))
+ (user-error "No scheduled information to update"))))
+ (t
(org-add-planning-info 'scheduled time 'closed)
(when (and old-date org-log-reschedule
(not (equal old-date
@@ -12330,7 +13135,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(concat (substring org-last-inserted-timestamp 0 -1)
" " repeater
(substring org-last-inserted-timestamp -1))))))
- (message "Scheduled to %s" org-last-inserted-timestamp)))))
+ (message "Scheduled to %s" org-last-inserted-timestamp))))))
(defun org-get-scheduled-time (pom &optional inherit)
"Get the scheduled time as a time tuple, of a format suitable
@@ -12366,6 +13171,9 @@ nil."
(delete-region (point-at-bol)
(min (point-max) (1+ (point-at-eol))))))))))
+(defvar org-time-was-given) ; dynamically scoped parameter
+(defvar org-end-time-was-given) ; dynamically scoped parameter
+
(defun org-add-planning-info (what &optional time &rest remove)
"Insert new timestamp with keyword in the line directly after the headline.
WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
@@ -12578,7 +13386,7 @@ EXTRA is additional text that will be inserted into the notes buffer."
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
(if (memq org-log-note-how '(time state))
- (let (current-prefix-arg) (org-store-log-note))
+ (let (current-prefix-arg) (org-store-log-note))
(let ((org-inhibit-startup t)) (org-mode))
(insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
@@ -12609,10 +13417,10 @@ EXTRA is additional text that will be inserted into the notes buffer."
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
"Finish taking a log note, and insert it to where it belongs."
- (let ((txt (buffer-string))
- (note (cdr (assq org-log-note-purpose org-log-note-headings)))
- lines ind bul)
+ (let ((txt (buffer-string)))
(kill-buffer (current-buffer))
+ (let ((note (cdr (assq org-log-note-purpose org-log-note-headings)))
+ lines ind bul)
(while (string-match "\\`# .*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
(if (string-match "\\s-+\\'" txt)
@@ -12679,12 +13487,19 @@ EXTRA is additional text that will be inserted into the notes buffer."
(insert (pop lines))))
(message "Note stored")
(org-back-to-heading t)
- (org-cycle-hide-drawers 'children)))))
- (set-window-configuration org-log-note-window-configuration)
- (with-current-buffer (marker-buffer org-log-note-return-to)
- (goto-char org-log-note-return-to))
- (move-marker org-log-note-return-to nil)
- (and org-log-post-message (message "%s" org-log-post-message)))
+ (org-cycle-hide-drawers 'children))
+ ;; Fix `buffer-undo-list' when `org-store-log-note' is called
+ ;; from within `org-add-log-note' because `buffer-undo-list'
+ ;; is then modified outside of `org-with-remote-undo'.
+ (when (eq this-command 'org-agenda-todo)
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))))))
+ ;; Don't add undo information when called from `org-agenda-todo'
+ (let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
+ (set-window-configuration org-log-note-window-configuration)
+ (with-current-buffer (marker-buffer org-log-note-return-to)
+ (goto-char org-log-note-return-to))
+ (move-marker org-log-note-return-to nil)
+ (and org-log-post-message (message "%s" org-log-post-message))))
(defun org-remove-empty-drawer-at (drawer pos)
"Remove an empty drawer DRAWER at position POS.
@@ -12715,46 +13530,44 @@ a Show deadlines and scheduled items after a date.
d Show deadlines due within `org-deadline-warning-days'.
D Show deadlines and scheduled items between a date range."
(interactive "P")
- (let (ans kwd value ts-type)
- (setq type (or type org-sparse-tree-default-date-type))
- (setq org-ts-type type)
- (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s"
- (cond ((eq type 'all) "all timestamps")
- ((eq type 'scheduled) "only scheduled")
- ((eq type 'deadline) "only deadline")
- ((eq type 'active) "only active timestamps")
- ((eq type 'inactive) "only inactive timestamps")
- ((eq type 'scheduled-or-deadline) "scheduled/deadline")
- (t "scheduled/deadline")))
- (setq ans (read-char-exclusive))
- (cond
- ((equal ans ?c)
- (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive)))))
- ((equal ans ?d)
- (call-interactively 'org-check-deadlines))
- ((equal ans ?b)
- (call-interactively 'org-check-before-date))
- ((equal ans ?a)
- (call-interactively 'org-check-after-date))
- ((equal ans ?D)
- (call-interactively 'org-check-dates-range))
- ((equal ans ?t)
- (call-interactively 'org-show-todo-tree))
- ((equal ans ?T)
- (org-show-todo-tree '(4)))
- ((member ans '(?T ?m))
- (call-interactively 'org-match-sparse-tree))
- ((member ans '(?p ?P))
- (setq kwd (org-icompleting-read "Property: "
- (mapcar 'list (org-buffer-property-keys))))
- (setq value (org-icompleting-read "Value: "
- (mapcar 'list (org-property-values kwd))))
- (unless (string-match "\\`{.*}\\'" value)
- (setq value (concat "\"" value "\"")))
- (org-match-sparse-tree arg (concat kwd "=" value)))
- ((member ans '(?r ?R ?/))
- (call-interactively 'org-occur))
- (t (error "No such sparse tree command \"%c\"" ans)))))
+ (setq type (or type org-sparse-tree-default-date-type))
+ (setq org-ts-type type)
+ (message "Sparse tree: [/]regexp [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"
+ (case type
+ (all "all timestamps")
+ (scheduled "only scheduled")
+ (deadline "only deadline")
+ (active "only active timestamps")
+ (inactive "only inactive timestamps")
+ (scheduled-or-deadline "scheduled/deadline")
+ (closed "with a closed time-stamp")
+ (otherwise "scheduled/deadline")))
+ (let ((answer (read-char-exclusive)))
+ (case answer
+ (?c
+ (org-sparse-tree
+ arg
+ (cadr (memq type '(scheduled-or-deadline all scheduled deadline active
+ inactive closed)))))
+ (?d (call-interactively #'org-check-deadlines))
+ (?b (call-interactively #'org-check-before-date))
+ (?a (call-interactively #'org-check-after-date))
+ (?D (call-interactively #'org-check-dates-range))
+ (?t (call-interactively #'org-show-todo-tree))
+ (?T (org-show-todo-tree '(4)))
+ (?m (call-interactively #'org-match-sparse-tree))
+ ((?p ?P)
+ (let* ((kwd (org-icompleting-read
+ "Property: " (mapcar #'list (org-buffer-property-keys))))
+ (value (org-icompleting-read
+ "Value: " (mapcar #'list (org-property-values kwd)))))
+ (unless (string-match "\\`{.*}\\'" value)
+ (setq value (concat "\"" value "\"")))
+ (org-match-sparse-tree arg (concat kwd "=" value))))
+ ((?r ?R ?/) (call-interactively #'org-occur))
+ (otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
(defvar org-occur-highlights nil
"List of overlays used for occur matches.")
@@ -12783,7 +13596,7 @@ If CALLBACK is non-nil, it is a function which is called to confirm
that the match should indeed be shown."
(interactive "sRegexp: \nP")
(when (equal regexp "")
- (error "Regexp cannot be empty"))
+ (user-error "Regexp cannot be empty"))
(unless keep-previous
(org-remove-occur-highlights nil nil t))
(push (cons regexp callback) org-occur-parameters)
@@ -12866,8 +13679,7 @@ How much context is shown depends upon the variables
(error nil))
(not (bobp)))
(org-flag-heading nil)
- (when siblings-p (org-show-siblings)))))
- (org-fix-ellipsis-at-bol)))
+ (when siblings-p (org-show-siblings)))))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
@@ -12940,7 +13752,7 @@ ACTION can be `set', `up', `down', or a character."
(if (equal action '(4))
(org-show-priority)
(unless org-enable-priority-commands
- (error "Priority commands are disabled"))
+ (user-error "Priority commands are disabled"))
(setq action (or action 'set))
(let (current new news have remove)
(save-excursion
@@ -12964,7 +13776,7 @@ ACTION can be `set', `up', `down', or a character."
(setq new (upcase new)))
(cond ((equal new ?\ ) (setq remove t))
((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority))
- (error "Priority must be between `%c' and `%c'"
+ (user-error "Priority must be between `%c' and `%c'"
org-highest-priority org-lowest-priority))))
((eq action 'up)
(setq new (if have
@@ -12986,7 +13798,7 @@ ACTION can be `set', `up', `down', or a character."
(if org-priority-start-cycle-with-default
org-default-priority
(1+ org-default-priority))))))
- (t (error "Invalid action")))
+ (t (user-error "Invalid action")))
(if (or (< (upcase new) org-highest-priority)
(> (upcase new) org-lowest-priority))
(if (and (memq action '(up down))
@@ -13003,7 +13815,7 @@ ACTION can be `set', `up', `down', or a character."
(replace-match "" t t nil 1)
(replace-match news t t nil 2))
(if remove
- (error "No priority cookie found in line")
+ (user-error "No priority cookie found in line")
(let ((case-fold-search nil))
(looking-at org-todo-line-regexp))
(if (match-end 2)
@@ -13098,7 +13910,6 @@ headlines matching this string."
(abbreviate-file-name
(or (buffer-file-name (buffer-base-buffer))
(buffer-name (buffer-base-buffer)))))))
- (case-fold-search nil)
(org-map-continue-from nil)
lspos tags tags-list
(tags-alist (list (cons 0 org-file-tags)))
@@ -13111,13 +13922,14 @@ headlines matching this string."
(when (eq action 'sparse-tree)
(org-overview)
(org-remove-occur-highlights))
- (while (re-search-forward re nil t)
+ (while (let (case-fold-search)
+ (re-search-forward re nil t))
(setq org-map-continue-from nil)
(catch :skip
(setq todo (if (match-end 1) (org-match-string-no-properties 2))
tags (if (match-end 4) (org-match-string-no-properties 4)))
(goto-char (setq lspos (match-beginning 0)))
- (setq level (org-reduced-level (funcall outline-level))
+ (setq level (org-reduced-level (org-outline-level))
category (org-get-category))
(setq i llast llast level)
;; remove tag lists from same and sublevels
@@ -13182,7 +13994,7 @@ headlines matching this string."
(if (eq org-tags-match-list-sublevels 'indented)
(make-string (1- level) ?.) "")
(org-get-heading))
- category
+ level category
tags-list)
priority (org-get-priority txt))
(goto-char lspos)
@@ -13197,7 +14009,7 @@ headlines matching this string."
(save-excursion
(setq rtn1 (funcall action))
(push rtn1 rtn)))
- (t (error "Invalid action")))
+ (t (user-error "Invalid action")))
;; if we are to skip sublevels, jump to end of subtree
(unless org-tags-match-list-sublevels
@@ -13300,11 +14112,14 @@ See also `org-scan-tags'.
"
(declare (special todo-only))
(unless (boundp 'todo-only)
- (error "org-make-tags-matcher expects todo-only to be scoped in"))
+ (error "`org-make-tags-matcher' expects todo-only to be scoped in"))
(unless match
- ;; Get a new match request, with completion
+ ;; Get a new match request, with completion against the global
+ ;; tags table and the local tags in current buffer
(let ((org-last-tags-completion-table
- (org-global-tags-completion-table)))
+ (org-uniquify
+ (delq nil (append (org-get-buffer-tags)
+ (org-global-tags-completion-table))))))
(setq match (org-completing-read-no-i
"Match: " 'org-tags-completion-function nil nil nil
'org-tags-history))))
@@ -13314,9 +14129,20 @@ See also `org-scan-tags'.
(re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
minus tag mm
tagsmatch todomatch tagsmatcher todomatcher kwd matcher
- orterms term orlist re-p str-p level-p level-op time-p
- prop-p pn pv po gv rest)
- (if (string-match "/+" match)
+ orterms orlist re-p str-p level-p level-op time-p
+ prop-p pn pv po gv rest (start 0) (ss 0))
+ ;; Expand group tags
+ (setq match (org-tags-expand match))
+
+ ;; Check if there is a TODO part of this match, which would be the
+ ;; part after a "/". TO make sure that this slash is not part of
+ ;; a property value to be matched against, we also check that there
+ ;; is no " after that slash.
+ ;; First, find the last slash
+ (while (string-match "/+" match ss)
+ (setq start (match-beginning 0) ss (match-end 0)))
+ (if (and (string-match "/+" match start)
+ (not (save-match-data (string-match "\"" match start))))
;; match contains also a todo-matching request
(progn
(setq tagsmatch (substring match 0 (match-beginning 0))
@@ -13332,7 +14158,7 @@ See also `org-scan-tags'.
(if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
(setq tagsmatcher t)
(setq orterms (org-split-string tagsmatch "|") orlist nil)
- (while (setq term (pop orterms))
+ (dolist (term orterms)
(while (and (equal (substring term -1) "\\") orterms)
(setq term (concat term "|" (pop orterms)))) ; repair bad split
(while (string-match re term)
@@ -13393,7 +14219,7 @@ See also `org-scan-tags'.
(if (or (not todomatch) (not (string-match "\\S-" todomatch)))
(setq todomatcher t)
(setq orterms (org-split-string todomatch "|") orlist nil)
- (while (setq term (pop orterms))
+ (dolist (term orterms)
(while (string-match re term)
(setq minus (and (match-end 1)
(equal (match-string 1 term) "-"))
@@ -13422,6 +14248,63 @@ See also `org-scan-tags'.
matcher)))
(cons match0 matcher)))
+(defun org-tags-expand (match &optional single-as-list downcased)
+ "Expand group tags in MATCH.
+
+This replaces every group tag in MATCH with a regexp tag search.
+For example, a group tag \"Work\" defined as { Work : Lab Conf }
+will be replaced like this:
+
+ Work => {\\(?:Work\\|Lab\\|Conf\\)}
+ +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
+ -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+
+Replacing by a regexp preserves the structure of the match.
+E.g., this expansion
+
+ Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
+
+will match anything tagged with \"Lab\" and \"Home\", or tagged
+with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
+
+When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
+assumed to be a single group tag, and the function will return
+the list of tags in this group.
+
+When DOWNCASE is non-nil, expand downcased TAGS."
+ (if org-group-tags
+ (let* ((case-fold-search t)
+ (stable org-mode-syntax-table)
+ (tal (or org-tag-groups-alist-for-agenda
+ org-tag-groups-alist))
+ (tal (if downcased
+ (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
+ (tml (mapcar 'car tal))
+ (rtnmatch match) rpl)
+ ;; @ and _ are allowed as word-components in tags
+ (modify-syntax-entry ?@ "w" stable)
+ (modify-syntax-entry ?_ "w" stable)
+ (while (and tml
+ (with-syntax-table stable
+ (string-match
+ (concat "\\(?1:[+-]?\\)\\(?2:\\<"
+ (regexp-opt tml) "\\>\\)")
+ rtnmatch)))
+ (let* ((dir (match-string 1 rtnmatch))
+ (tag (match-string 2 rtnmatch))
+ (tag (if downcased (downcase tag) tag)))
+ (setq tml (delete tag tml))
+ (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
+ (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
+ (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
+ (if (stringp rpl) (org-add-props rpl '(grouptag t)))
+ (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (if single-as-list
+ (or (reverse rpl) (list rtnmatch))
+ rtnmatch))
+ (if single-as-list (list (if downcased (downcase match) match))
+ match)))
+
(defun org-op-to-function (op &optional stringp)
"Turn an operator into the appropriate function."
(setq op
@@ -13542,7 +14425,8 @@ ignore inherited ones."
(reverse (delete-dups
(reverse (append
(org-remove-uninherited-tags
- org-file-tags) tags)))))))))
+ org-file-tags)
+ tags)))))))))
(defun org-add-prop-inherited (s)
(add-text-properties 0 (length s) '(inherited t) s)
@@ -13582,6 +14466,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(defun org-align-tags-here (to-col)
;; Assumes that this is a headline
+ "Align tags on the current headline to TO-COL."
(let ((pos (point)) (col (current-column)) ncol tags-l p)
(beginning-of-line 1)
(if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
@@ -13600,7 +14485,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state."
(insert (make-string (- ncol (current-column)) ?\ ))
(setq ncol (current-column))
(when indent-tabs-mode (tabify p (point-at-eol)))
- (org-move-to-column (min ncol col) t))
+ (org-move-to-column (min ncol col)))
(goto-char pos))))
(defun org-set-tags-command (&optional arg just-align)
@@ -13658,15 +14543,16 @@ If DATA is nil or the empty string, any tags will be removed."
(defvar org-indent-indentation-per-level)
(defun org-set-tags (&optional arg just-align)
"Set the tags for the current headline.
-With prefix ARG, realign all tags in headings in the current buffer."
+With prefix ARG, realign all tags in headings in the current buffer.
+When JUST-ALIGN is non-nil, only align tags."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
'region-start-level 'region))
org-loop-over-headlines-in-active-region)
(org-map-entries
- ;; We don't use ARG and JUST-ALIGN here these args are not
- ;; useful when looping over headlines
+ ;; We don't use ARG and JUST-ALIGN here because these args
+ ;; are not useful when looping over headlines.
`(org-set-tags)
org-loop-over-headlines-in-active-region
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
@@ -13744,7 +14630,7 @@ With prefix ARG, realign all tags in headings in the current buffer."
(goto-char (match-beginning 0))
(setq c0 (current-column)
;; compute offset for the case of org-indent-mode active
- di (if org-indent-mode
+ di (if (org-bound-and-true-p org-indent-mode)
(* (1- org-indent-indentation-per-level) (1- level))
0)
p0 (if (equal (char-before) ?*) (1+ (point)) (point))
@@ -13766,7 +14652,9 @@ This works in the agenda, and also in an org-mode buffer."
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
(if (derived-mode-p 'org-mode)
- (org-get-buffer-tags)
+ (org-uniquify
+ (delq nil (append (org-get-buffer-tags)
+ (org-global-tags-completion-table))))
(org-global-tags-completion-table))))
(org-icompleting-read
"Tag: " 'org-tags-completion-function nil nil nil
@@ -13818,15 +14706,14 @@ This works in the agenda, and also in an org-mode buffer."
rtn)
((eq flag t)
;; all-completions
- (all-completions s2 ctable confirm)
- )
+ (all-completions s2 ctable confirm))
((eq flag 'lambda)
;; exact match?
- (assoc s2 ctable)))
- ))
+ (assoc s2 ctable)))))
(defun org-fast-tag-insert (kwd tags face &optional end)
- "Insert KDW, and the TAGS, the latter with face FACE. Also insert END."
+ "Insert KDW, and the TAGS, the latter with face FACE.
+Also insert END."
(insert (format "%-12s" (concat kwd ":"))
(org-add-props (mapconcat 'identity tags " ") nil 'face face)
(or end "")))
@@ -13842,6 +14729,7 @@ This works in the agenda, and also in an org-mode buffer."
(insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
(defun org-set-current-tags-overlay (current prefix)
+ "Add an overlay to CURRENT tag with PREFIX."
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
(if (featurep 'xemacs)
(org-overlay-display org-tags-overlay (concat prefix s)
@@ -13870,7 +14758,7 @@ Returns the new tags string, or nil to not change the current settings."
(ncol (/ (- (window-width) 4) fwidth))
(i-face 'org-done)
(c-face 'org-todo)
- tg cnt e c char c1 c2 ntable tbl rtn
+ tg cnt c char c1 c2 ntable tbl rtn
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
@@ -13896,8 +14784,8 @@ Returns the new tags string, or nil to not change the current settings."
(if expert
(set-buffer (get-buffer-create " *Org tags*"))
(delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
+ (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
+ (org-switch-to-buffer-other-window " *Org tags*"))
(erase-buffer)
(org-set-local 'org-done-keywords done-keywords)
(org-fast-tag-insert "Inherited" inherited i-face "\n")
@@ -13905,7 +14793,7 @@ Returns the new tags string, or nil to not change the current settings."
(org-fast-tag-show-exit exit-after-next)
(org-set-current-tags-overlay current ov-prefix)
(setq tbl fulltable char ?a cnt 0)
- (while (setq e (pop tbl))
+ (dolist (e tbl)
(cond
((equal (car e) :startgroup)
(push '() groups) (setq ingroup t)
@@ -13924,6 +14812,7 @@ Returns the new tags string, or nil to not change the current settings."
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
+ ((equal e '(:grouptags)) nil)
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -13939,11 +14828,13 @@ Returns the new tags string, or nil to not change the current settings."
(setq c (or c2 char)))
(if ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
- (cond
- ((not (assoc tg table))
- (org-get-todo-face tg))
- ((member tg current) c-face)
- ((member tg inherited) i-face))))
+ (cond
+ ((not (assoc tg table))
+ (org-get-todo-face tg))
+ ((member tg current) c-face)
+ ((member tg inherited) i-face))))
+ (if (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
(if (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
@@ -14045,7 +14936,7 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-tags-string ()
"Get the TAGS string in the current headline."
(unless (org-at-heading-p t)
- (error "Not on a heading"))
+ (user-error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
(if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
@@ -14194,7 +15085,7 @@ a *different* entry, you cannot use these techniques."
((eq scope 'file-with-archives)
(setq scope (org-add-archive-files (list (buffer-file-name))))))
(org-agenda-prepare-buffers scope)
- (while (setq file (pop scope))
+ (dolist (file scope)
(with-current-buffer (org-find-base-buffer-visiting file)
(save-excursion
(save-restriction
@@ -14248,16 +15139,6 @@ Being in this list makes sure that they are offered for completion.")
org-property-end-re "\\)\n?")
"Matches an entire clock drawer.")
-(defsubst org-re-property (property)
- "Return a regexp matching a PROPERTY line.
-Match group 1 will be set to the value."
- (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
-
-(defsubst org-re-property-keyword (property)
- "Return a regexp matching a PROPERTY line, possibly with no
-value for the property."
- (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?"))
-
(defun org-property-action ()
"Do an action on properties."
(interactive)
@@ -14274,13 +15155,15 @@ value for the property."
(call-interactively 'org-delete-property-globally))
((equal c ?c)
(call-interactively 'org-compute-property-at-point))
- (t (error "No such property action %c" c)))))
+ (t (user-error "No such property action %c" c)))))
(defun org-inc-effort ()
"Increment the value of the effort property in the current entry."
(interactive)
(org-set-effort nil t))
+(defvar org-clock-effort) ;; Defined in org-clock.el
+(defvar org-clock-current-task) ;; Defined in org-clock.el
(defun org-set-effort (&optional value increment)
"Set the effort property of the current entry.
With numerical prefix arg, use the nth allowed value, 0 stands for the
@@ -14294,6 +15177,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(cur (org-entry-get nil prop))
(allowed (org-property-get-allowed-values nil prop 'table))
(existing (mapcar 'list (org-property-values prop)))
+ (heading (nth 4 (org-heading-components)))
rpl
(val (cond
((stringp value) value)
@@ -14302,7 +15186,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(car (org-last allowed))))
((and allowed increment)
(or (caadr (member (list cur) allowed))
- (error "Allowed effort values are not set")))
+ (user-error "Allowed effort values are not set")))
(allowed
(message "Select 1-9,0, [RET%s]: %s"
(if cur (concat "=" cur) "")
@@ -14327,18 +15211,17 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(save-excursion
(org-back-to-heading t)
(put-text-property (point-at-bol) (point-at-eol) 'org-effort val))
+ (when (string= heading org-clock-current-task)
+ (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort))
+ (org-clock-update-mode-line))
(message "%s is now %s" prop val)))
(defun org-at-property-p ()
"Is cursor inside a property drawer?"
(save-excursion
- (beginning-of-line 1)
- (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)"))
- (save-match-data ;; Used by calling procedures
- (let ((p (point))
- (range (unless (org-before-first-heading-p)
- (org-get-property-block))))
- (and range (<= (car range) p) (< p (cdr range))))))))
+ (when (equal 'node-property (car (org-element-at-point)))
+ (beginning-of-line 1)
+ (looking-at org-property-re))))
(defun org-get-property-block (&optional beg end force)
"Return the (beg . end) range of the body of the property drawer.
@@ -14385,104 +15268,105 @@ is a string only get exactly this property. SPECIFIC can be a string, the
specific property we are interested in. Specifying it can speed
things up because then unnecessary parsing is avoided."
(setq which (or which 'all))
- (org-with-point-at pom
- (let ((clockstr (substring org-clock-string 0 -1))
- (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
- (case-fold-search nil)
- beg end range props sum-props key key1 value string clocksum clocksumt)
- (save-excursion
- (when (condition-case nil
- (and (derived-mode-p 'org-mode) (org-back-to-heading t))
- (error nil))
- (setq beg (point))
- (setq sum-props (get-text-property (point) 'org-summaries))
- (setq clocksum (get-text-property (point) :org-clock-minutes)
- clocksumt (get-text-property (point) :org-clock-minutes-today))
- (outline-next-heading)
- (setq end (point))
- (when (memq which '(all special))
- ;; Get the special properties, like TODO and tags
- (goto-char beg)
- (when (and (or (not specific) (string= specific "TODO"))
- (looking-at org-todo-line-regexp) (match-end 2))
- (push (cons "TODO" (org-match-string-no-properties 2)) props))
- (when (and (or (not specific) (string= specific "PRIORITY"))
- (looking-at org-priority-regexp))
- (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
- (when (or (not specific) (string= specific "FILE"))
- (push (cons "FILE" buffer-file-name) props))
- (when (and (or (not specific) (string= specific "TAGS"))
- (setq value (org-get-tags-string))
- (string-match "\\S-" value))
- (push (cons "TAGS" value) props))
- (when (and (or (not specific) (string= specific "ALLTAGS"))
- (setq value (org-get-tags-at)))
- (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
- ":"))
- props))
- (when (or (not specific) (string= specific "BLOCKED"))
- (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
- (when (or (not specific)
- (member specific
- '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
- "TIMESTAMP" "TIMESTAMP_IA")))
- (catch 'match
- (while (re-search-forward org-maybe-keyword-time-regexp end t)
- (setq key (if (match-end 1)
- (substring (org-match-string-no-properties 1)
- 0 -1))
- string (if (equal key clockstr)
- (org-trim
- (buffer-substring-no-properties
- (match-beginning 3) (goto-char
- (point-at-eol))))
- (substring (org-match-string-no-properties 3)
- 1 -1)))
- ;; Get the correct property name from the key. This is
- ;; necessary if the user has configured time keywords.
- (setq key1 (concat key ":"))
- (cond
- ((not key)
- (setq key
- (if (= (char-after (match-beginning 3)) ?\[)
- "TIMESTAMP_IA" "TIMESTAMP")))
- ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
- ((equal key1 org-deadline-string) (setq key "DEADLINE"))
- ((equal key1 org-closed-string) (setq key "CLOSED"))
- ((equal key1 org-clock-string) (setq key "CLOCK")))
- (if (and specific (equal key specific) (not (equal key "CLOCK")))
- (progn
- (push (cons key string) props)
- ;; no need to search further if match is found
- (throw 'match t))
- (when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props)))))))
-
- (when (memq which '(all standard))
- ;; Get the standard properties, like :PROP: ...
- (setq range (org-get-property-block beg end))
- (when range
- (goto-char (car range))
- (while (re-search-forward
- (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?")
- (cdr range) t)
- (setq key (org-match-string-no-properties 1)
- value (org-trim (or (org-match-string-no-properties 2) "")))
- (unless (member key excluded)
- (push (cons key (or value "")) props)))))
- (if clocksum
- (push (cons "CLOCKSUM"
- (org-columns-number-to-string (/ (float clocksum) 60.)
- 'add_times))
- props))
- (if clocksumt
- (push (cons "CLOCKSUM_T"
- (org-columns-number-to-string (/ (float clocksumt) 60.)
- 'add_times))
- props))
- (unless (assoc "CATEGORY" props)
- (push (cons "CATEGORY" (org-get-category)) props))
- (append sum-props (nreverse props)))))))
+ (org-with-wide-buffer
+ (org-with-point-at pom
+ (let ((clockstr (substring org-clock-string 0 -1))
+ (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
+ (case-fold-search nil)
+ beg end range props sum-props key key1 value string clocksum clocksumt)
+ (when (and (derived-mode-p 'org-mode)
+ (ignore-errors (org-back-to-heading t)))
+ (setq beg (point))
+ (setq sum-props (get-text-property (point) 'org-summaries))
+ (setq clocksum (get-text-property (point) :org-clock-minutes)
+ clocksumt (get-text-property (point) :org-clock-minutes-today))
+ (outline-next-heading)
+ (setq end (point))
+ (when (memq which '(all special))
+ ;; Get the special properties, like TODO and tags
+ (goto-char beg)
+ (when (and (or (not specific) (string= specific "TODO"))
+ (looking-at org-todo-line-regexp) (match-end 2))
+ (push (cons "TODO" (org-match-string-no-properties 2)) props))
+ (when (and (or (not specific) (string= specific "PRIORITY"))
+ (looking-at org-priority-regexp))
+ (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
+ (when (or (not specific) (string= specific "FILE"))
+ (push (cons "FILE" buffer-file-name) props))
+ (when (and (or (not specific) (string= specific "TAGS"))
+ (setq value (org-get-tags-string))
+ (string-match "\\S-" value))
+ (push (cons "TAGS" value) props))
+ (when (and (or (not specific) (string= specific "ALLTAGS"))
+ (setq value (org-get-tags-at)))
+ (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
+ ":"))
+ props))
+ (when (or (not specific) (string= specific "BLOCKED"))
+ (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
+ (when (or (not specific)
+ (member specific
+ '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
+ "TIMESTAMP" "TIMESTAMP_IA")))
+ (catch 'match
+ (while (and (re-search-forward org-maybe-keyword-time-regexp end t)
+ (not (text-property-any 0 (length (match-string 0))
+ 'face 'font-lock-comment-face
+ (match-string 0))))
+ (setq key (if (match-end 1)
+ (substring (org-match-string-no-properties 1)
+ 0 -1))
+ string (if (equal key clockstr)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-beginning 3) (goto-char
+ (point-at-eol))))
+ (substring (org-match-string-no-properties 3)
+ 1 -1)))
+ ;; Get the correct property name from the key. This is
+ ;; necessary if the user has configured time keywords.
+ (setq key1 (concat key ":"))
+ (cond
+ ((not key)
+ (setq key
+ (if (= (char-after (match-beginning 3)) ?\[)
+ "TIMESTAMP_IA" "TIMESTAMP")))
+ ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
+ ((equal key1 org-deadline-string) (setq key "DEADLINE"))
+ ((equal key1 org-closed-string) (setq key "CLOSED"))
+ ((equal key1 org-clock-string) (setq key "CLOCK")))
+ (if (and specific (equal key specific) (not (equal key "CLOCK")))
+ (progn
+ (push (cons key string) props)
+ ;; no need to search further if match is found
+ (throw 'match t))
+ (when (or (equal key "CLOCK") (not (assoc key props)))
+ (push (cons key string) props)))))))
+
+ (when (memq which '(all standard))
+ ;; Get the standard properties, like :PROP: ...
+ (setq range (org-get-property-block beg end))
+ (when range
+ (goto-char (car range))
+ (while (re-search-forward org-property-re
+ (cdr range) t)
+ (setq key (org-match-string-no-properties 2)
+ value (org-trim (or (org-match-string-no-properties 3) "")))
+ (unless (member key excluded)
+ (push (cons key (or value "")) props)))))
+ (if clocksum
+ (push (cons "CLOCKSUM"
+ (org-columns-number-to-string (/ (float clocksum) 60.)
+ 'add_times))
+ props))
+ (if clocksumt
+ (push (cons "CLOCKSUM_T"
+ (org-columns-number-to-string (/ (float clocksumt) 60.)
+ 'add_times))
+ props))
+ (unless (assoc "CATEGORY" props)
+ (push (cons "CATEGORY" (org-get-category)) props))
+ (append sum-props (nreverse props)))))))
(defun org-entry-get (pom property &optional inherit literal-nil)
"Get value of PROPERTY for entry or content at point-or-marker POM.
@@ -14493,6 +15377,8 @@ in `org-use-property-inheritance' selects PROPERTY for inheritance.
If the property is present but empty, the return value is the empty string.
If the property is not present at all, nil is returned.
+Return the value as a string.
+
If LITERAL-NIL is set, return the string value \"nil\" as a string,
do not interpret it as the list atom nil. This is used for inheritance
when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
@@ -14502,30 +15388,38 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
t))
(org-entry-get-with-inheritance property literal-nil)
(if (member property org-special-properties)
- ;; We need a special property. Use `org-entry-properties' to
- ;; retrieve it, but specify the wanted property
+ ;; We need a special property. Use `org-entry-properties'
+ ;; to retrieve it, but specify the wanted property
(cdr (assoc property (org-entry-properties nil 'special property)))
- (let ((range (org-get-property-block)))
- (when (and range (not (eq (car range) (cdr range))))
- (let* ((props (list (or (assoc property org-file-properties)
- (assoc property org-global-properties)
- (assoc property org-global-properties-fixed))))
- (ap (lambda (key)
- (when (re-search-forward
- (org-re-property key) (cdr range) t)
- (setq props
- (org-update-property-plist
- key
- (if (match-end 1)
- (org-match-string-no-properties 1) "")
- props)))))
- val)
- (goto-char (car range))
- (funcall ap property)
- (goto-char (car range))
- (while (funcall ap (concat property "+")))
- (setq val (cdr (assoc property props)))
- (when val (if literal-nil val (org-not-nil val))))))))))
+ (org-with-wide-buffer
+ (let ((range (org-get-property-block)))
+ (when (and range (not (eq (car range) (cdr range)))
+ (save-excursion
+ (goto-char (car range))
+ (re-search-forward
+ (concat (org-re-property property) "\\|"
+ (org-re-property (concat property "+")))
+ (cdr range) t)))
+ (let* ((props
+ (list (or (assoc property org-file-properties)
+ (assoc property org-global-properties)
+ (assoc property org-global-properties-fixed))))
+ (ap (lambda (key)
+ (when (re-search-forward
+ (org-re-property key) (cdr range) t)
+ (setq props
+ (org-update-property-plist
+ key
+ (if (match-end 3)
+ (org-match-string-no-properties 3) "")
+ props)))))
+ val)
+ (goto-char (car range))
+ (funcall ap property)
+ (goto-char (car range))
+ (while (funcall ap (concat property "+")))
+ (setq val (cdr (assoc property props)))
+ (when val (if literal-nil val (org-not-nil val)))))))))))
(defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR.
@@ -14535,8 +15429,10 @@ If yes, return this value. If not, return the current value of the variable."
(read prop)
(symbol-value var))))
-(defun org-entry-delete (pom property)
- "Delete the property PROPERTY from entry at point-or-marker POM."
+(defun org-entry-delete (pom property &optional delete-empty-drawer)
+ "Delete the property PROPERTY from entry at point-or-marker POM.
+When optional argument DELETE-EMPTY-DRAWER is a string, it defines
+an empty drawer to delete."
(org-with-point-at pom
(if (member property org-special-properties)
nil ; cannot delete these properties.
@@ -14544,10 +15440,13 @@ If yes, return this value. If not, return the current value of the variable."
(if (and range
(goto-char (car range))
(re-search-forward
- (org-re-property property)
+ (org-re-property property nil t)
(cdr range) t))
(progn
(delete-region (match-beginning 0) (1+ (point-at-eol)))
+ (and delete-empty-drawer
+ (org-remove-empty-drawer-at
+ delete-empty-drawer (car range)))
t)
nil)))))
@@ -14559,7 +15458,7 @@ If yes, return this value. If not, return the current value of the variable."
(values (and old (org-split-string old "[ \t]"))))
(setq value (org-entry-protect-space value))
(unless (member value values)
- (setq values (cons value values))
+ (setq values (append values (list value)))
(org-entry-put pom property
(mapconcat 'identity values " ")))))
@@ -14632,7 +15531,7 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(widen)
(catch 'ex
(while t
- (when (setq tmp (org-entry-get nil property nil 'literal-nil))
+ (when (setq tmp (org-entry-get nil property nil literal-nil))
(or (ignore-errors (org-back-to-heading t))
(goto-char (point-min)))
(move-marker org-entry-property-inherited-from (point))
@@ -14651,25 +15550,39 @@ Each hook function should accept two arguments, the name of the property
and the new value.")
(defun org-entry-put (pom property value)
- "Set PROPERTY to VALUE for entry at point-or-marker POM."
+ "Set PROPERTY to VALUE for entry at point-or-marker POM.
+If the value is nil, it is converted to the empty string.
+If it is not a string, an error is raised."
+ (cond ((null value) (setq value ""))
+ ((not (stringp value))
+ (error "Properties values should be strings.")))
(org-with-point-at pom
(org-back-to-heading t)
(let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
range)
(cond
((equal property "TODO")
- (when (and (stringp value) (string-match "\\S-" value)
+ (when (and (string-match "\\S-" value)
(not (member value org-todo-keywords-1)))
- (error "\"%s\" is not a valid TODO state" value))
+ (user-error "\"%s\" is not a valid TODO state" value))
(if (or (not value)
(not (string-match "\\S-" value)))
(setq value 'none))
(org-todo value)
(org-set-tags nil 'align))
((equal property "PRIORITY")
- (org-priority (if (and value (stringp value) (string-match "\\S-" value))
+ (org-priority (if (and value (string-match "\\S-" value))
(string-to-char value) ?\ ))
(org-set-tags nil 'align))
+ ((equal property "CLOCKSUM")
+ (if (not (re-search-forward
+ (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t))
+ (error "Cannot find a clock log")
+ (goto-char (- (match-end 1) 2))
+ (cond
+ ((eq value 'earlier) (org-timestamp-down))
+ ((eq value 'later) (org-timestamp-up)))
+ (org-clock-sum-current-item)))
((equal property "SCHEDULED")
(if (re-search-forward org-scheduled-time-regexp end t)
(cond
@@ -14692,7 +15605,7 @@ and the new value.")
(setq range (org-get-property-block beg end 'force))
(goto-char (car range))
(if (re-search-forward
- (org-re-property-keyword property) (cdr range) t)
+ (org-re-property property nil t) (cdr range) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(goto-char (match-beginning 0)))
@@ -14722,10 +15635,9 @@ formats in the current buffer."
(while (re-search-forward org-property-start-re nil t)
(setq range (org-get-property-block))
(goto-char (car range))
- (while (re-search-forward
- (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):")
+ (while (re-search-forward org-property-re
(cdr range) t)
- (add-to-list 'rtn (org-match-string-no-properties 1)))
+ (add-to-list 'rtn (org-match-string-no-properties 2)))
(outline-next-heading))))
(when include-specials
@@ -14763,7 +15675,7 @@ formats in the current buffer."
(let ((re (org-re-property key))
values)
(while (re-search-forward re nil t)
- (add-to-list 'values (org-trim (match-string 1))))
+ (add-to-list 'values (org-trim (match-string 3))))
(delete "" values)))))
(defun org-insert-property-drawer ()
@@ -14792,7 +15704,9 @@ formats in the current buffer."
(beginning-of-line 1)))
(org-skip-over-state-notes)
(skip-chars-backward " \t\n\r")
- (if (eq (char-before) ?*) (forward-char 1))
+ (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n)))
+ (forward-char 1))
+ (goto-char (point-at-eol))
(let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
(beginning-of-line 0)
(org-indent-to-column indent)
@@ -14849,7 +15763,7 @@ Point is left between drawer's boundaries."
(beginning-of-line)
(when (save-excursion
(re-search-forward org-outline-regexp-bol rend t))
- (error "Drawers cannot contain headlines"))
+ (user-error "Drawers cannot contain headlines"))
;; Position point at the beginning of the first
;; non-blank line in region. Insert drawer's opening
;; there, then indent it.
@@ -14902,11 +15816,10 @@ This is computed according to `org-property-set-functions-alist'."
(funcall set-function prompt
(mapcar 'list (org-property-values property))
nil nil "" nil cur)))))
- (if (equal val "")
- cur
- val)))
+ (org-trim val)))
(defvar org-last-set-property nil)
+(defvar org-last-set-property-value nil)
(defun org-read-property-name ()
"Read a property name."
(let* ((completion-ignore-case t)
@@ -14924,8 +15837,7 @@ This is computed according to `org-property-set-functions-alist'."
": ")
(mapcar 'list keys)
nil nil nil nil
- default-prop
- )))
+ default-prop)))
(if (member property keys)
property
(or (cdr (assoc (downcase property)
@@ -14933,6 +15845,23 @@ This is computed according to `org-property-set-functions-alist'."
keys)))
property))))
+(defun org-set-property-and-value (use-last)
+ "Allow to set [PROPERTY]: [value] direction from prompt.
+When use-default, don't even ask, just use the last
+\"[PROPERTY]: [value]\" string from the history."
+ (interactive "P")
+ (let* ((completion-ignore-case t)
+ (pv (or (and use-last org-last-set-property-value)
+ (org-completing-read
+ "Enter a \"[Property]: [value]\" pair: "
+ nil nil nil nil nil
+ org-last-set-property-value)))
+ prop val)
+ (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv)
+ (setq prop (match-string 1 pv)
+ val (match-string 2 pv))
+ (org-set-property prop val))))
+
(defun org-set-property (property value)
"In the current entry, set PROPERTY to VALUE.
When called interactively, this will prompt for a property name, offering
@@ -14945,22 +15874,30 @@ in the current file."
(value (or value (org-read-property-value property)))
(fn (cdr (assoc property org-properties-postprocess-alist))))
(setq org-last-set-property property)
+ (setq org-last-set-property-value (concat property ": " value))
;; Possibly postprocess the inserted value:
(when fn (setq value (funcall fn value)))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value))))
-(defun org-delete-property (property)
- "In the current entry, delete PROPERTY."
+(defun org-delete-property (property &optional delete-empty-drawer)
+ "In the current entry, delete PROPERTY.
+When optional argument DELETE-EMPTY-DRAWER is a string, it defines
+an empty drawer to delete."
(interactive
(let* ((completion-ignore-case t)
- (prop (org-icompleting-read "Property: "
- (org-entry-properties nil 'standard))))
+ (cat (org-entry-get (point) "CATEGORY"))
+ (props0 (org-entry-properties nil 'standard))
+ (props (if cat props0
+ (delete `("CATEGORY" . ,(org-get-category)) props0)))
+ (prop (if (< 1 (length props))
+ (org-icompleting-read "Property: " props nil t)
+ (caar props))))
(list prop)))
- (message "Property %s %s" property
- (if (org-entry-delete nil property)
- "deleted"
- "was not present in the entry")))
+ (if (not property)
+ (message "No property to delete in this entry")
+ (org-entry-delete nil property delete-empty-drawer)
+ (message "Property \"%s\" deleted" property)))
(defun org-delete-property-globally (property)
"Remove PROPERTY globally, from all entries."
@@ -14990,11 +15927,11 @@ This looks for an enclosing column format, extracts the operator and
then applies it to the property in the column format's scope."
(interactive)
(unless (org-at-property-p)
- (error "Not at a property"))
+ (user-error "Not at a property"))
(let ((prop (org-match-string-no-properties 2)))
(org-columns-get-format-and-top-level)
(unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
- (error "No operator defined for property %s" prop))
+ (user-error "No operator defined for property %s" prop))
(org-columns-compute prop)))
(defvar org-property-allowed-value-functions nil
@@ -15047,22 +15984,23 @@ completion."
"Switch to the next allowed value for this property."
(interactive)
(unless (org-at-property-p)
- (error "Not at a property"))
+ (user-error "Not at a property"))
(let* ((prop (car (save-match-data (org-split-string (match-string 1) ":"))))
(key (match-string 2))
(value (match-string 3))
(allowed (or (org-property-get-allowed-values (point) key)
(and (member value '("[ ]" "[-]" "[X]"))
'("[ ]" "[X]"))))
+ (heading (save-match-data (nth 4 (org-heading-components))))
nval)
(unless allowed
- (error "Allowed values for this property have not been defined"))
+ (user-error "Allowed values for this property have not been defined"))
(if previous (setq allowed (reverse allowed)))
(if (member value allowed)
(setq nval (car (cdr (member value allowed)))))
(setq nval (or nval (car allowed)))
(if (equal nval value)
- (error "Only one allowed value for this property"))
+ (user-error "Only one allowed value for this property"))
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
(org-indent-line)
@@ -15071,7 +16009,10 @@ completion."
(when (equal prop org-effort-property)
(save-excursion
(org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)))
+ (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))
+ (when (string= org-clock-current-task heading)
+ (setq org-clock-effort nval)
+ (org-clock-update-mode-line)))
(run-hook-with-args 'org-property-changed-functions key nval)))
(defun org-find-olp (path &optional this-buffer)
@@ -15101,7 +16042,7 @@ only headings."
(widen)
(setq limit (point-max))
(goto-char (point-min))
- (while (setq heading (pop path))
+ (dolist (heading path)
(setq re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(setq cnt 0 pos (point))
@@ -15146,7 +16087,7 @@ When the target headline is found, return a marker to this location."
nil "\\`[^.#].*\\.org\\'"))
file visiting m buffer)
(catch 'found
- (while (setq file (pop files))
+ (dolist (file files)
(message "trying %s" file)
(setq visiting (org-find-base-buffer-visiting file))
(setq buffer (or visiting (find-file-noselect file)))
@@ -15182,8 +16123,6 @@ Return the position where this entry starts, or nil if there is no such entry."
(defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil
"The last time stamp inserted with `org-insert-time-stamp'.")
-(defvar org-time-was-given) ; dynamically scoped parameter
-(defvar org-end-time-was-given) ; dynamically scoped parameter
(defvar org-ts-what) ; dynamically scoped parameter
(defun org-time-stamp (arg &optional inactive)
@@ -15201,7 +16140,10 @@ If there is already a timestamp at the cursor, it will be
modified.
With two universal prefix arguments, insert an active timestamp
-with the current time without prompting the user."
+with the current time without prompting the user.
+
+When called from lisp, the timestamp is inactive if INACTIVE is
+non-nil."
(interactive "P")
(let* ((ts nil)
(default-time
@@ -15248,7 +16190,7 @@ with the current time without prompting the user."
" " repeater ">"))))
(message "Timestamp updated"))
((equal arg '(16))
- (org-insert-time-stamp (current-time) t))
+ (org-insert-time-stamp (current-time) t inactive))
(t
(setq time (let ((this-command this-command))
(org-read-date arg 'totime nil nil default-time default-input inactive)))
@@ -15270,7 +16212,7 @@ with the current time without prompting the user."
(setq dh (- h2 h1) dm (- m2 m1))
(if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
(concat t1 "+" (number-to-string dh)
- (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
+ (and (/= 0 dm) (format ":%02d" dm)))))))
(defun org-time-stamp-inactive (&optional arg)
"Insert an inactive time stamp.
@@ -15299,6 +16241,80 @@ So these are more for recording a certain time/date."
(defvar org-read-date-analyze-forced-year nil)
(defvar org-read-date-inactive)
+(defvar org-read-date-minibuffer-local-map
+ (let* ((org-replace-disputed-keys nil)
+ (map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (org-defkey map (kbd ".")
+ (lambda () (interactive)
+ ;; Are we at the beginning of the prompt?
+ (if (looking-back "^[^:]+: ")
+ (org-eval-in-calendar '(calendar-goto-today))
+ (insert "."))))
+ (org-defkey map (kbd "C-.")
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-goto-today))))
+ (org-defkey map [(meta shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey map [(meta shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey map [(meta shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey map [(meta shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey map [?\e (shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-month 1))))
+ (org-defkey map [?\e (shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-month 1))))
+ (org-defkey map [?\e (shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-year 1))))
+ (org-defkey map [?\e (shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-year 1))))
+ (org-defkey map [(shift up)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-week 1))))
+ (org-defkey map [(shift down)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-week 1))))
+ (org-defkey map [(shift left)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-backward-day 1))))
+ (org-defkey map [(shift right)]
+ (lambda () (interactive)
+ (org-eval-in-calendar '(calendar-forward-day 1))))
+ (org-defkey map "!"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(diary-view-entries))
+ (message "")))
+ (org-defkey map ">"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-left 1))))
+ (org-defkey map "<"
+ (lambda () (interactive)
+ (org-eval-in-calendar '(scroll-calendar-right 1))))
+ (org-defkey map "\C-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-left-three-months 1))))
+ (org-defkey map "\M-v"
+ (lambda () (interactive)
+ (org-eval-in-calendar
+ '(calendar-scroll-right-three-months 1))))
+ map)
+ "Keymap for minibuffer commands when using `org-read-date'.")
+
+(defvar org-def)
+(defvar org-defdecode)
+(defvar org-with-time)
+
(defun org-read-date (&optional org-with-time to-time from-string prompt
default-time default-input inactive)
"Read a date, possibly a time, and make things smooth for the user.
@@ -15319,7 +16335,8 @@ mean next year. For details, see the manual. A few examples:
12:45 --> today 12:45
22 sept 0:34 --> currentyear-09-22 0:34
12 --> currentyear-currentmonth-12
- Fri --> nearest Friday (today or later)
+ Fri --> nearest Friday after today
+ -Tue --> last Tuesday
etc.
Furthermore you can specify a relative date by giving, as the *first* thing
@@ -15338,7 +16355,7 @@ While prompting, a calendar is popped up - you can also select the
date with the mouse (button 1). The calendar shows a period of three
months. To scroll it to other months, use the keys `>' and `<'.
If you don't like the calendar, turn it off with
- \(setq org-read-date-popup-calendar nil)
+ (setq org-read-date-popup-calendar nil)
With optional argument TO-TIME, the date will immediately be converted
to an internal time.
@@ -15391,61 +16408,11 @@ user."
(org-eval-in-calendar nil t)
(let* ((old-map (current-local-map))
(map (copy-keymap calendar-mode-map))
- (minibuffer-local-map (copy-keymap minibuffer-local-map)))
+ (minibuffer-local-map
+ (copy-keymap org-read-date-minibuffer-local-map)))
(org-defkey map (kbd "RET") 'org-calendar-select)
(org-defkey map [mouse-1] 'org-calendar-select-mouse)
(org-defkey map [mouse-2] 'org-calendar-select-mouse)
- (org-defkey minibuffer-local-map [(meta shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey minibuffer-local-map [(meta shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey minibuffer-local-map [(meta shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey minibuffer-local-map [(meta shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey minibuffer-local-map [?\e (shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-month 1))))
- (org-defkey minibuffer-local-map [?\e (shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-month 1))))
- (org-defkey minibuffer-local-map [?\e (shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-year 1))))
- (org-defkey minibuffer-local-map [?\e (shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-year 1))))
- (org-defkey minibuffer-local-map [(shift up)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-week 1))))
- (org-defkey minibuffer-local-map [(shift down)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-week 1))))
- (org-defkey minibuffer-local-map [(shift left)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-backward-day 1))))
- (org-defkey minibuffer-local-map [(shift right)]
- (lambda () (interactive)
- (org-eval-in-calendar '(calendar-forward-day 1))))
- (org-defkey minibuffer-local-map ">"
- (lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-left 1))))
- (org-defkey minibuffer-local-map "<"
- (lambda () (interactive)
- (org-eval-in-calendar '(scroll-calendar-right 1))))
- (org-defkey minibuffer-local-map "\C-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-left-three-months 1))))
- (org-defkey minibuffer-local-map "\M-v"
- (lambda () (interactive)
- (org-eval-in-calendar
- '(calendar-scroll-right-three-months 1))))
- (run-hooks 'org-read-date-minibuffer-setup-hook)
(unwind-protect
(progn
(use-local-map map)
@@ -15494,9 +16461,6 @@ user."
(nth 2 final) (nth 1 final))
(format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final))))))
-(defvar org-def)
-(defvar org-defdecode)
-(defvar org-with-time)
(defun org-read-date-display ()
"Display the current date prompt interpretation in the minibuffer."
(when org-read-date-display-live
@@ -15537,7 +16501,7 @@ user."
(defun org-read-date-analyze (ans org-def org-defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
- (let ((nowdecode (decode-time (current-time)))
+ (let ((nowdecode (decode-time))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
iso-year iso-weekday iso-week iso-year iso-date futurep kill-year)
@@ -15695,7 +16659,7 @@ user."
(deltan
(setq futurep nil)
(unless deltadef
- (let ((now (decode-time (current-time))))
+ (let ((now (decode-time)))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
(cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
((equal deltaw "w") (setq day (+ day (* 7 deltan))))
@@ -15757,7 +16721,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
(if wday1
(progn
(setq delta (mod (+ 7 (- wday1 wday)) 7))
- (if (= dir ?-) (setq delta (- delta 7)))
+ (if (= delta 0) (setq delta 7))
+ (if (= dir ?-)
+ (progn
+ (setq delta (- delta 7))
+ (if (= delta 0) (setq delta -7))))
(if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
(list delta "d" rel))
(list (* n (if (= dir ?-) -1 1)) what rel)))))
@@ -15913,32 +16881,44 @@ Don't touch the rest."
(let ((n 0))
(mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
-(defun org-days-to-time (timestamp-string)
- "Difference between TIMESTAMP-STRING and now in days."
- (- (time-to-days (org-time-string-to-time timestamp-string))
- (time-to-days (current-time))))
+(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4")
+
+(defun org-time-stamp-to-now (timestamp-string &optional seconds)
+ "Difference between TIMESTAMP-STRING and now in days.
+If SECONDS is non-nil, return the difference in seconds."
+ (let ((fdiff (if seconds 'org-float-time 'time-to-days)))
+ (- (funcall fdiff (org-time-string-to-time timestamp-string))
+ (funcall fdiff (current-time)))))
(defun org-deadline-close (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
(setq ndays (or ndays (org-get-wdays timestamp-string)))
- (and (< (org-days-to-time timestamp-string) ndays)
+ (and (< (org-time-stamp-to-now timestamp-string) ndays)
(not (org-entry-is-done-p))))
-(defun org-get-wdays (ts)
- "Get the deadline lead time appropriate for timestring TS."
- (cond
- ((<= org-deadline-warning-days 0)
- ;; 0 or negative, enforce this value no matter what
- (- org-deadline-warning-days))
- ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
- ;; lead time is specified.
- (floor (* (string-to-number (match-string 1 ts))
- (cdr (assoc (match-string 2 ts)
- '(("d" . 1) ("w" . 7)
- ("m" . 30.4) ("y" . 365.25)
- ("h" . 0.041667)))))))
- ;; go for the default.
- (t org-deadline-warning-days)))
+(defun org-get-wdays (ts &optional delay zero-delay)
+ "Get the deadline lead time appropriate for timestring TS.
+When DELAY is non-nil, get the delay time for scheduled items
+instead of the deadline lead time. When ZERO-DELAY is non-nil
+and `org-scheduled-delay-days' is 0, enforce 0 as the delay,
+don't try to find the delay cookie in the scheduled timestamp."
+ (let ((tv (if delay org-scheduled-delay-days
+ org-deadline-warning-days)))
+ (cond
+ ((or (and delay (< tv 0))
+ (and delay zero-delay (<= tv 0))
+ (and (not delay) (<= tv 0)))
+ ;; Enforce this value no matter what
+ (- tv))
+ ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts)
+ ;; lead time is specified.
+ (floor (* (string-to-number (match-string 1 ts))
+ (cdr (assoc (match-string 2 ts)
+ '(("d" . 1) ("w" . 7)
+ ("m" . 30.4) ("y" . 365.25)
+ ("h" . 0.041667)))))))
+ ;; go for the default.
+ (t tv))))
(defun org-calendar-select-mouse (ev)
"Return to `org-read-date' with the date currently selected.
@@ -15981,14 +16961,16 @@ Allowed values for TYPE are:
inactive: only inactive timestamps ([...])
scheduled: only scheduled timestamps
deadline: only deadline timestamps
+ closed: only closed time-stamps
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
- (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
+ (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>\r\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
((eq type 'active) org-ts-regexp)
- ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")
+ ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]")
((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
+ ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"))
((eq type 'scheduled-or-deadline)
(concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
@@ -16052,7 +17034,7 @@ days in order to avoid rounding problems."
(goto-char (point-at-bol))
(re-search-forward org-tr-regexp-both (point-at-eol) t))
(if (not (org-at-date-range-p t))
- (error "Not at a time-stamp range, and none found in current line")))
+ (user-error "Not at a time-stamp range, and none found in current line")))
(let* ((ts1 (match-string 1))
(ts2 (match-string 2))
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
@@ -16120,7 +17102,7 @@ days in order to avoid rounding problems."
(error (error "Bad timestamp `%s'%s\nError was: %s"
s (if (not (and buffer pos))
""
- (format " at %d in buffer `%s'" pos buffer))
+ (format-message " at %d in buffer `%s'" pos buffer))
(cdr errdata)))))
(defun org-time-string-to-seconds (s)
@@ -16129,10 +17111,10 @@ days in order to avoid rounding problems."
(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
"Convert a time stamp to an absolute day number.
-If there is a specifier for a cyclic time stamp, get the closest date to
-DAYNR.
+If there is a specifier for a cyclic time stamp, get the closest
+date to DAYNR.
PREFER and SHOW-ALL are passed through to `org-closest-date'.
-The variable date is bound by the calendar when this is called."
+The variable `date' is bound by the calendar when this is called."
(cond
((and daynr (string-match "\\`%%\\((.*)\\)" s))
(if (org-diary-sexp-entry (match-string 1 s) "" date)
@@ -16148,7 +17130,7 @@ The variable date is bound by the calendar when this is called."
(error (error "Bad timestamp `%s'%s\nError was: %s"
s (if (not (and buffer pos))
""
- (format " at %d in buffer `%s'" pos buffer))
+ (format-message " at %d in buffer `%s'" pos buffer))
(cdr errdata))))))))
(defun org-days-to-iso-week (days)
@@ -16158,7 +17140,7 @@ The variable date is bound by the calendar when this is called."
(defun org-small-year-to-year (year)
"Convert 2-digit years into 4-digit years.
-38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007.
+38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037.
The year 2000 cannot be abbreviated. Any year larger than 99
is returned unchanged."
(if (< year 38)
@@ -16256,7 +17238,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
(if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
(setq dn (string-to-number (match-string 1 change))
dw (cdr (assoc (match-string 2 change) a1)))
- (error "Invalid change specifier: %s" change))
+ (user-error "Invalid change specifier: %s" change))
(if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
(cond
((eq dw 'hour)
@@ -16323,17 +17305,19 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp."
This should be a lot faster than the normal `parse-time-string'.
If time is not given, defaults to 0:00. However, with optional NODEFAULT,
hour and minute fields will be nil if not given."
- (if (string-match org-ts-regexp0 s)
- (list 0
- (if (or (match-beginning 8) (not nodefault))
- (string-to-number (or (match-string 8 s) "0")))
- (if (or (match-beginning 7) (not nodefault))
- (string-to-number (or (match-string 7 s) "0")))
- (string-to-number (match-string 4 s))
- (string-to-number (match-string 3 s))
- (string-to-number (match-string 2 s))
- nil nil nil)
- (error "Not a standard Org-mode time string: %s" s)))
+ (cond ((string-match org-ts-regexp0 s)
+ (list 0
+ (if (or (match-beginning 8) (not nodefault))
+ (string-to-number (or (match-string 8 s) "0")))
+ (if (or (match-beginning 7) (not nodefault))
+ (string-to-number (or (match-string 7 s) "0")))
+ (string-to-number (match-string 4 s))
+ (string-to-number (match-string 3 s))
+ (string-to-number (match-string 2 s))
+ nil nil nil))
+ ((string-match "^<[^>]+>$" s)
+ (decode-time (seconds-to-time (org-matcher-time s))))
+ (t (error "Not a standard Org-mode time string: %s" s))))
(defun org-timestamp-up (&optional arg)
"Increase the date item at the cursor by one.
@@ -16423,11 +17407,12 @@ With prefix ARG, change that many days."
(defvar org-clock-history) ; defined in org-clock.el
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
-(defun org-timestamp-change (n &optional what updown)
+(defun org-timestamp-change (n &optional what updown suppress-tmp-delay)
"Change the date in the time stamp at point.
The date will be changed by N times WHAT. WHAT can be `day', `month',
`year', `minute', `second'. If WHAT is not given, the cursor position
-in the timestamp determines what will be changed."
+in the timestamp determines what will be changed.
+When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(let ((origin (point)) origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
@@ -16435,7 +17420,7 @@ in the timestamp determines what will be changed."
extra rem
ts time time0 fixnext clrgx)
(if (not (org-at-timestamp-p t))
- (error "Not at a timestamp"))
+ (user-error "Not at a timestamp"))
(if (and (not what) (eq org-ts-what 'bracket))
(org-toggle-timestamp-type)
;; Point isn't on brackets. Remember the part of the time-stamp
@@ -16451,10 +17436,12 @@ in the timestamp determines what will be changed."
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
(replace-match "")
- (if (string-match
- "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
- ts)
- (setq extra (match-string 1 ts)))
+ (when (string-match
+ "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
+ ts)
+ (setq extra (match-string 1 ts))
+ (if suppress-tmp-delay
+ (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
(if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
(setq with-hm t))
(setq time0 (org-parse-time-string ts))
@@ -16518,7 +17505,7 @@ in the timestamp determines what will be changed."
;; Maybe adjust the closest clock in `org-clock-history'
(when org-clock-adjust-closest
(if (not (and (org-at-clock-log-p)
- (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m))
+ (< 1 (length (delq nil (mapcar 'marker-position
org-clock-history))))))
(message "No clock to adjust")
(cond ((save-excursion ; fix previous clock?
@@ -16637,27 +17624,6 @@ If there is already a time stamp at the cursor position, update it."
(org-insert-time-stamp
(encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
-(defun org-minutes-to-hh:mm-string (m)
- "Compute H:MM from a number of minutes."
- (let ((h (/ m 60)))
- (setq m (- m (* 60 h)))
- (format org-time-clocksum-format h m)))
-
-(defun org-hh:mm-string-to-minutes (s)
- "Convert a string H:MM to a number of minutes.
-If the string is just a number, interpret it as minutes.
-In fact, the first hh:mm or number in the string will be taken,
-there can be extra stuff in the string.
-If no number is found, the return value is 0."
- (cond
- ((integerp s) s)
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (+ (* (string-to-number (match-string 1 s)) 60)
- (string-to-number (match-string 2 s))))
- ((string-match "\\([0-9]+\\)" s)
- (string-to-number (match-string 1 s)))
- (t 0)))
-
(defcustom org-effort-durations
`(("h" . 60)
("d" . ,(* 60 8))
@@ -16679,15 +17645,169 @@ effort string \"2hours\" is equivalent to 120 minutes."
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
-(defcustom org-agenda-inhibit-startup t
+(defun org-minutes-to-clocksum-string (m)
+ "Format number of minutes as a clocksum string.
+The format is determined by `org-time-clocksum-format',
+`org-time-clocksum-use-fractional' and
+`org-time-clocksum-fractional-format' and
+`org-time-clocksum-use-effort-durations'."
+ (let ((clocksum "")
+ (m (round m)) ; Don't allow fractions of minutes
+ h d w mo y fmt n)
+ (setq h (if org-time-clocksum-use-effort-durations
+ (cdr (assoc "h" org-effort-durations)) 60)
+ d (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "d" org-effort-durations)) h) 24)
+ w (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
+ mo (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
+ y (if org-time-clocksum-use-effort-durations
+ (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
+ ;; fractional format
+ (if org-time-clocksum-use-fractional
+ (cond
+ ;; single format string
+ ((stringp org-time-clocksum-fractional-format)
+ (format org-time-clocksum-fractional-format (/ m (float h))))
+ ;; choice of fractional formats for different time units
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
+ (> (/ (truncate m) (* y d h)) 0))
+ (format fmt (/ m (* y d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
+ (> (/ (truncate m) (* mo d h)) 0))
+ (format fmt (/ m (* mo d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
+ (> (/ (truncate m) (* w d h)) 0))
+ (format fmt (/ m (* w d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
+ (> (/ (truncate m) (* d h)) 0))
+ (format fmt (/ m (* d (float h)))))
+ ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
+ (> (/ (truncate m) h) 0))
+ (format fmt (/ m (float h))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
+ (format fmt m))
+ ;; fall back to smallest time unit with a format
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
+ (format fmt (/ m (float h))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
+ (format fmt (/ m (* d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
+ (format fmt (/ m (* w d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
+ (format fmt (/ m (* mo d (float h)))))
+ ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
+ (format fmt (/ m (* y d (float h))))))
+ ;; standard (non-fractional) format, with single format string
+ (if (stringp org-time-clocksum-format)
+ (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
+ ;; separate formats components
+ (and (setq fmt (plist-get org-time-clocksum-format :years))
+ (or (> (setq n (/ (truncate m) (* y d h))) 0)
+ (plist-get org-time-clocksum-format :require-years))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n y d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :months))
+ (or (> (setq n (/ (truncate m) (* mo d h))) 0)
+ (plist-get org-time-clocksum-format :require-months))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n mo d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :weeks))
+ (or (> (setq n (/ (truncate m) (* w d h))) 0)
+ (plist-get org-time-clocksum-format :require-weeks))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n w d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :days))
+ (or (> (setq n (/ (truncate m) (* d h))) 0)
+ (plist-get org-time-clocksum-format :require-days))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n d h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :hours))
+ (or (> (setq n (/ (truncate m) h)) 0)
+ (plist-get org-time-clocksum-format :require-hours))
+ (setq clocksum (concat clocksum (format fmt n))
+ m (- m (* n h))))
+ (and (setq fmt (plist-get org-time-clocksum-format :minutes))
+ (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
+ (setq clocksum (concat clocksum (format fmt m))))
+ ;; return formatted time duration
+ clocksum))))
+
+(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string)
+(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string
+ "Org mode version 8.0")
+
+(defun org-hours-to-clocksum-string (n)
+ (org-minutes-to-clocksum-string (* n 60)))
+
+(defun org-hh:mm-string-to-minutes (s)
+ "Convert a string H:MM to a number of minutes.
+If the string is just a number, interpret it as minutes.
+In fact, the first hh:mm or number in the string will be taken,
+there can be extra stuff in the string.
+If no number is found, the return value is 0."
+ (cond
+ ((integerp s) s)
+ ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
+ (+ (* (string-to-number (match-string 1 s)) 60)
+ (string-to-number (match-string 2 s))))
+ ((string-match "\\([0-9]+\\)" s)
+ (string-to-number (match-string 1 s)))
+ (t 0)))
+
+(defcustom org-image-actual-width t
+ "Should we use the actual width of images when inlining them?
+
+When set to t, always use the image width.
+
+When set to a number, use imagemagick (when available) to set
+the image's width to this value.
+
+When set to a number in a list, try to get the width from any
+#+ATTR.* keyword if it matches a width specification like
+
+ #+ATTR_HTML: :width 300px
+
+and fall back on that number if none is found.
+
+When set to nil, try to get the width from an #+ATTR.* keyword
+and fall back on the original width if none is found.
+
+This requires Emacs >= 24.1, build with imagemagick support."
+ :group 'org-appearance
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Use the image width" t)
+ (integer :tag "Use a number of pixels")
+ (list :tag "Use #+ATTR* or a number of pixels" (integer))
+ (const :tag "Use #+ATTR* or don't resize" nil)))
+
+(defcustom org-agenda-inhibit-startup nil
"Inhibit startup when preparing agenda buffers.
-When this variable is `t' (the default), the initialization of
-the Org agenda buffers is inhibited: e.g. the visibility state
-is not set, the tables are not re-aligned, etc."
+When this variable is t, the initialization of the Org agenda
+buffers is inhibited: e.g. the visibility state is not set, the
+tables are not re-aligned, etc."
:type 'boolean
:version "24.3"
:group 'org-agenda)
+(defcustom org-agenda-ignore-drawer-properties nil
+ "Avoid updating text properties when building the agenda.
+Properties are used to prepare buffers for effort estimates, appointments,
+and subtree-local categories.
+If you don't use these in the agenda, you can add them to this list and
+agenda building will be a bit faster.
+The value is a list, with zero or more of the symbols `effort', `appt',
+or `category'."
+ :type '(set :greedy t
+ (const effort)
+ (const appt)
+ (const category))
+ :version "24.3"
+ :group 'org-agenda)
+
(defun org-duration-string-to-minutes (s &optional output-to-string)
"Convert a duration string S to minutes.
@@ -16733,7 +17853,7 @@ changes from another. I believe the procedure must be like this:
3. M-x org-revert-all-org-buffers"
(interactive)
(unless (yes-or-no-p "Revert all Org buffers from their files? ")
- (error "Abort"))
+ (user-error "Abort"))
(save-excursion
(save-window-excursion
(mapc
@@ -16792,7 +17912,7 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
((eq predicate 'files)
(lambda (b) (with-current-buffer b (derived-mode-p 'org-mode))))
((eq predicate 'export)
- (lambda (b) (string-match "\*Org .*Export" (buffer-name b))))
+ (lambda (b) (string-match "\\*Org .*Export" (buffer-name b))))
((eq predicate 'agenda)
(lambda (b)
(with-current-buffer b
@@ -16801,7 +17921,7 @@ If EXCLUDE-TMP is non-nil, ignore temporary buffers."
(member (file-truename bfn) agenda-files)))))
(t (lambda (b) (with-current-buffer b
(or (derived-mode-p 'org-mode)
- (string-match "\*Org .*Export"
+ (string-match "\\*Org .*Export"
(buffer-name b)))))))))
(delq nil
(mapcar
@@ -16923,9 +18043,9 @@ If the current buffer does not, find the first agenda file."
(files (append fs (list (car fs))))
(tcf (if buffer-file-name (file-truename buffer-file-name)))
file)
- (unless files (error "No agenda files"))
+ (unless files (user-error "No agenda files"))
(catch 'exit
- (while (setq file (pop files))
+ (dolist (file files)
(if (equal (file-truename file) tcf)
(when (car files)
(find-file (car files))
@@ -16945,7 +18065,7 @@ end of the list."
(org-agenda-files t)))
(ctf (file-truename
(or buffer-file-name
- (error "Please save the current buffer to a file"))))
+ (user-error "Please save the current buffer to a file"))))
x had)
(setq x (assoc ctf file-alist) had x)
@@ -16965,7 +18085,7 @@ Optional argument FILE means use this file instead of the current."
(interactive)
(let* ((org-agenda-skip-unavailable-files nil)
(file (or file buffer-file-name
- (error "Current buffer does not visit a file")))
+ (user-error "Current buffer does not visit a file")))
(true-file (file-truename file))
(afile (abbreviate-file-name file))
(files (delq nil (mapcar
@@ -17011,8 +18131,8 @@ it to the list of buffers which might be released later."
"Release all buffers in list, asking the user for confirmation when needed.
When a buffer is unmodified, it is just killed. When modified, it is saved
\(if the user agrees) and then killed."
- (let (buf file)
- (while (setq buf (pop blist))
+ (let (file)
+ (dolist (buf blist)
(setq file (buffer-file-name buf))
(when (and (buffer-modified-p buf)
file
@@ -17029,20 +18149,33 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(inhibit-read-only t)
(org-inhibit-startup org-agenda-inhibit-startup)
(rea (concat ":" org-archive-tag ":"))
- bmp file re)
+ file re pos)
+ (setq org-tag-alist-for-agenda nil
+ org-tag-groups-alist-for-agenda nil)
(save-excursion
(save-restriction
- (while (setq file (pop files))
+ (dolist (file files)
(catch 'nextfile
(if (bufferp file)
(set-buffer file)
(org-check-agenda-file file)
(set-buffer (org-get-agenda-file-buffer file)))
(widen)
- (setq bmp (buffer-modified-p))
- (org-refresh-category-properties)
- (org-refresh-properties org-effort-property 'org-effort)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
+ (org-set-regexps-and-options-for-tags)
+ (setq pos (point))
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (search-forward "#+setupfile" nil t)
+ ;; Don't set all regexps and options systematically as
+ ;; this is only run for setting agenda tags from setup
+ ;; file
+ (org-set-regexps-and-options)))
+ (or (memq 'category org-agenda-ignore-drawer-properties)
+ (org-refresh-category-properties))
+ (or (memq 'effort org-agenda-ignore-drawer-properties)
+ (org-refresh-properties org-effort-property 'org-effort))
+ (or (memq 'appt org-agenda-ignore-drawer-properties)
+ (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1))
(setq org-done-keywords-for-agenda
@@ -17052,29 +18185,36 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(setq org-drawers-for-agenda
(append org-drawers-for-agenda org-drawers))
(setq org-tag-alist-for-agenda
- (append org-tag-alist-for-agenda org-tag-alist))
-
- (save-excursion
- (remove-text-properties (point-min) (point-max) pall)
- (when org-agenda-skip-archived-trees
- (goto-char (point-min))
- (while (re-search-forward rea nil t)
- (if (org-at-heading-p t)
- (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
- (goto-char (point-min))
- (setq re (format org-heading-keyword-regexp-format
- org-comment-string))
- (while (re-search-forward re nil t)
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc)))
- (set-buffer-modified-p bmp)))))
+ (org-uniquify
+ (append org-tag-alist-for-agenda
+ org-tag-alist
+ org-tag-persistent-alist)))
+ (if org-group-tags
+ (setq org-tag-groups-alist-for-agenda
+ (org-uniquify-alist
+ (append org-tag-groups-alist-for-agenda org-tag-groups-alist))))
+ (org-with-silent-modifications
+ (save-excursion
+ (remove-text-properties (point-min) (point-max) pall)
+ (when org-agenda-skip-archived-trees
+ (goto-char (point-min))
+ (while (re-search-forward rea nil t)
+ (if (org-at-heading-p t)
+ (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
+ (goto-char (point-min))
+ (setq re (format org-heading-keyword-regexp-format
+ org-comment-string))
+ (while (re-search-forward re nil t)
+ (add-text-properties
+ (match-beginning 0) (org-end-of-subtree t) pc))))
+ (goto-char pos)))))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
(setq org-todo-keyword-alist-for-agenda
- (org-uniquify org-todo-keyword-alist-for-agenda)
- org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda))))
+ (org-uniquify org-todo-keyword-alist-for-agenda))))
-;;;; Embedded LaTeX
+
+;;;; CDLaTeX minor mode
(defvar org-cdlatex-mode-map (make-sparse-keymap)
"Keymap for the minor `org-cdlatex-mode'.")
@@ -17124,6 +18264,58 @@ an embedded LaTeX fragment, let texmathp do its job.
"Unconditionally turn on `org-cdlatex-mode'."
(org-cdlatex-mode 1))
+(defun org-try-cdlatex-tab ()
+ "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
+It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
+ - inside a LaTeX fragment, or
+ - after the first word in a line, where an abbreviation expansion could
+ insert a LaTeX environment."
+ (when org-cdlatex-mode
+ (cond
+ ;; Before any word on the line: No expansion possible.
+ ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
+ ;; Just after first word on the line: Expand it. Make sure it
+ ;; cannot happen on headlines, though.
+ ((save-excursion
+ (skip-chars-backward "a-zA-Z0-9*")
+ (skip-chars-backward " \t")
+ (and (bolp) (not (org-at-heading-p))))
+ (cdlatex-tab) t)
+ ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
+
+(defun org-cdlatex-underscore-caret (&optional arg)
+ "Execute `cdlatex-sub-superscript' in LaTeX fragments.
+Revert to the normal definition outside of these fragments."
+ (interactive "P")
+ (if (org-inside-LaTeX-fragment-p)
+ (call-interactively 'cdlatex-sub-superscript)
+ (let (org-cdlatex-mode)
+ (call-interactively (key-binding (vector last-input-event))))))
+
+(defun org-cdlatex-math-modify (&optional arg)
+ "Execute `cdlatex-math-modify' in LaTeX fragments.
+Revert to the normal definition outside of these fragments."
+ (interactive "P")
+ (if (org-inside-LaTeX-fragment-p)
+ (call-interactively 'cdlatex-math-modify)
+ (let (org-cdlatex-mode)
+ (call-interactively (key-binding (vector last-input-event))))))
+
+
+
+;;;; LaTeX fragments
+
+(defvar org-latex-regexps
+ '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
+ ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
+ ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
+ ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
+ ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
+ "Regular expressions for matching embedded LaTeX.")
+
(defun org-inside-LaTeX-fragment-p ()
"Test if point is inside a LaTeX fragment.
I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
@@ -17174,43 +18366,6 @@ looks only before point, not after."
(org-in-regexp
"\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
-(defun org-try-cdlatex-tab ()
- "Check if it makes sense to execute `cdlatex-tab', and do it if yes.
-It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
- - inside a LaTeX fragment, or
- - after the first word in a line, where an abbreviation expansion could
- insert a LaTeX environment."
- (when org-cdlatex-mode
- (cond
- ;; Before any word on the line: No expansion possible.
- ((save-excursion (skip-chars-backward " \t") (bolp)) nil)
- ;; Just after first word on the line: Expand it. Make sure it
- ;; cannot happen on headlines, though.
- ((save-excursion
- (skip-chars-backward "a-zA-Z0-9*")
- (skip-chars-backward " \t")
- (and (bolp) (not (org-at-heading-p))))
- (cdlatex-tab) t)
- ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
-
-(defun org-cdlatex-underscore-caret (&optional arg)
- "Execute `cdlatex-sub-superscript' in LaTeX fragments.
-Revert to the normal definition outside of these fragments."
- (interactive "P")
- (if (org-inside-LaTeX-fragment-p)
- (call-interactively 'cdlatex-sub-superscript)
- (let (org-cdlatex-mode)
- (call-interactively (key-binding (vector last-input-event))))))
-
-(defun org-cdlatex-math-modify (&optional arg)
- "Execute `cdlatex-math-modify' in LaTeX fragments.
-Revert to the normal definition outside of these fragments."
- (interactive "P")
- (if (org-inside-LaTeX-fragment-p)
- (call-interactively 'cdlatex-math-modify)
- (let (org-cdlatex-mode)
- (call-interactively (key-binding (vector last-input-event))))))
-
(defvar org-latex-fragment-image-overlays nil
"List of overlays carrying the images of latex fragments.")
(make-variable-buffer-local 'org-latex-fragment-image-overlays)
@@ -17232,51 +18387,40 @@ display all fragments in the buffer.
The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(interactive "P")
(unless buffer-file-name
- (error "Can't preview LaTeX fragment in a non-file buffer"))
- (org-remove-latex-fragment-image-overlays)
- (save-excursion
- (save-restriction
- (let (beg end at msg)
- (cond
- ((or (equal subtree '(16))
- (not (save-excursion
- (re-search-backward org-outline-regexp-bol nil t))))
- (setq beg (point-min) end (point-max)
- msg "Creating images for buffer...%s"))
- ((equal subtree '(4))
- (org-back-to-heading)
- (setq beg (point) end (org-end-of-subtree t)
- msg "Creating images for subtree...%s"))
- (t
- (if (setq at (org-inside-LaTeX-fragment-p))
- (goto-char (max (point-min) (- (cdr at) 2)))
- (org-back-to-heading))
- (setq beg (point) end (progn (outline-next-heading) (point))
- msg (if at "Creating image...%s"
- "Creating images for entry...%s"))))
- (message msg "")
- (narrow-to-region beg end)
- (goto-char beg)
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
- (file-name-nondirectory
- buffer-file-name)))
- default-directory 'overlays msg at 'forbuffer
- org-latex-create-formula-image-program)
- (message msg "done. Use `C-c C-c' to remove images.")))))
-
-(defvar org-latex-regexps
- '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
- ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
- ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
- "Regular expressions for matching embedded LaTeX.")
+ (user-error "Can't preview LaTeX fragment in a non-file buffer"))
+ (when (display-graphic-p)
+ (org-remove-latex-fragment-image-overlays)
+ (save-excursion
+ (save-restriction
+ (let (beg end at msg)
+ (cond
+ ((or (equal subtree '(16))
+ (not (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t))))
+ (setq beg (point-min) end (point-max)
+ msg "Creating images for buffer...%s"))
+ ((equal subtree '(4))
+ (org-back-to-heading)
+ (setq beg (point) end (org-end-of-subtree t)
+ msg "Creating images for subtree...%s"))
+ (t
+ (if (setq at (org-inside-LaTeX-fragment-p))
+ (goto-char (max (point-min) (- (cdr at) 2)))
+ (org-back-to-heading))
+ (setq beg (point) end (progn (outline-next-heading) (point))
+ msg (if at "Creating image...%s"
+ "Creating images for entry...%s"))))
+ (message msg "")
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (org-format-latex
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
+ (file-name-nondirectory
+ buffer-file-name)))
+ default-directory 'overlays msg at 'forbuffer
+ org-latex-create-formula-image-program)
+ (message msg "done. Use `C-c C-c' to remove images."))))))
-(defvar org-export-have-math nil) ;; dynamic scoping
(defun org-format-latex (prefix &optional dir overlays msg at
forbuffer processing-type)
"Replace LaTeX fragments with links to an image, and produce images.
@@ -17287,86 +18431,72 @@ Some of the options can be changed using the variable
(absprefix (expand-file-name prefix dir))
(todir (file-name-directory absprefix))
(opt org-format-latex-options)
+ (optnew org-format-latex-options)
(matchers (plist-get opt :matchers))
(re-list org-latex-regexps)
- (org-format-latex-header-extra
- (plist-get (org-infile-export-plist) :latex-header-extra))
- (cnt 0) txt hash link beg end re e checkdir
- executables-checked string
+ (cnt 0) txt hash link beg end re checkdir
+ string
m n block-type block linkfile movefile ov)
;; Check the different regular expressions
- (while (setq e (pop re-list))
+ (dolist (e re-list)
(setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
block (if block-type "\n\n" ""))
(when (member m matchers)
(goto-char (point-min))
(while (re-search-forward re nil t)
(when (and (or (not at) (equal (cdr at) (match-beginning n)))
- (not (get-text-property (match-beginning n)
- 'org-protected))
(or (not overlays)
(not (eq (get-char-property (match-beginning n)
'org-overlay-type)
'org-latex-overlay))))
- (setq org-export-have-math t)
(cond
- ((eq processing-type 'verbatim)
- ;; Leave the text verbatim, just protect it
- (add-text-properties (match-beginning n) (match-end n)
- '(org-protected t)))
+ ((eq processing-type 'verbatim))
((eq processing-type 'mathjax)
- ;; Prepare for MathJax processing
+ ;; Prepare for MathJax processing.
(setq string (match-string n))
- (if (member m '("$" "$1"))
- (save-excursion
- (delete-region (match-beginning n) (match-end n))
- (goto-char (match-beginning n))
- (insert (org-add-props (concat "\\(" (substring string 1 -1)
- "\\)")
- '(org-protected t))))
- (add-text-properties (match-beginning n) (match-end n)
- '(org-protected t))))
+ (when (member m '("$" "$1"))
+ (save-excursion
+ (delete-region (match-beginning n) (match-end n))
+ (goto-char (match-beginning n))
+ (insert (concat "\\(" (substring string 1 -1) "\\)")))))
((or (eq processing-type 'dvipng)
(eq processing-type 'imagemagick))
- ;; Process to an image
+ ;; Process to an image.
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
cnt (1+ cnt))
- (let (print-length print-level) ; make sure full list is printed
+ (let ((face (face-at-point))
+ (fg (plist-get opt :foreground))
+ (bg (plist-get opt :background))
+ ;; Ensure full list is printed.
+ print-length print-level)
+ (when forbuffer
+ ;; Get the colors from the face at point.
+ (goto-char beg)
+ (when (eq fg 'auto)
+ (setq fg (face-attribute face :foreground nil 'default)))
+ (when (eq bg 'auto)
+ (setq bg (face-attribute face :background nil 'default)))
+ (setq optnew (copy-sequence opt))
+ (plist-put optnew :foreground fg)
+ (plist-put optnew :background bg))
(setq hash (sha1 (prin1-to-string
(list org-format-latex-header
- org-format-latex-header-extra
- org-export-latex-default-packages-alist
- org-export-latex-packages-alist
+ org-latex-default-packages-alist
+ org-latex-packages-alist
org-format-latex-options
- forbuffer txt)))
+ forbuffer txt fg bg)))
linkfile (format "%s_%s.png" prefix hash)
movefile (format "%s_%s.png" absprefix hash)))
(setq link (concat block "[[file:" linkfile "]]" block))
(if msg (message msg cnt))
(goto-char beg)
- (unless checkdir ; make sure the directory exists
+ (unless checkdir ; Ensure the directory exists.
(setq checkdir t)
(or (file-directory-p todir) (make-directory todir t)))
- (cond
- ((eq processing-type 'dvipng)
- (unless executables-checked
- (org-check-external-command
- "latex" "needed to convert LaTeX fragments to images")
- (org-check-external-command
- "dvipng" "needed to convert LaTeX fragments to images")
- (setq executables-checked t))
- (unless (file-exists-p movefile)
- (org-create-formula-image-with-dvipng
- txt movefile opt forbuffer)))
- ((eq processing-type 'imagemagick)
- (unless executables-checked
- (org-check-external-command
- "convert" "you need to install imagemagick")
- (setq executables-checked t))
- (unless (file-exists-p movefile)
- (org-create-formula-image-with-imagemagick
- txt movefile opt forbuffer))))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image
+ txt movefile optnew forbuffer processing-type))
(if overlays
(progn
(mapc (lambda (o)
@@ -17396,10 +18526,8 @@ Some of the options can be changed using the variable
(if block-type 'paragraph 'character))))))
((eq processing-type 'mathml)
;; Process to MathML
- (unless executables-checked
- (unless (save-match-data (org-format-latex-mathml-available-p))
- (error "LaTeX to MathML converter not configured"))
- (setq executables-checked t))
+ (unless (save-match-data (org-format-latex-mathml-available-p))
+ (user-error "LaTeX to MathML converter not configured"))
(setq txt (match-string n)
beg (match-beginning n) end (match-end n)
cnt (1+ cnt))
@@ -17409,7 +18537,7 @@ Some of the options can be changed using the variable
(insert (org-format-latex-as-mathml
txt block-type prefix dir)))
(t
- (error "Unknown conversion type %s for latex fragments"
+ (error "Unknown conversion type %s for LaTeX fragments"
processing-type)))))))))
(defun org-create-math-formula (latex-frag &optional mathml-file)
@@ -17425,7 +18553,7 @@ inspection."
(buffer-substring-no-properties
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
- (unless latex-frag (error "Invalid latex-frag"))
+ (unless latex-frag (error "Invalid LaTeX fragment"))
(let* ((tmp-in-file (file-relative-name
(make-temp-name (expand-file-name "ltxmathml-in"))))
(ignore (write-region latex-frag nil tmp-in-file))
@@ -17440,7 +18568,7 @@ inspection."
mathml shell-command-output)
(when (org-called-interactively-p 'any)
(unless (org-format-latex-mathml-available-p)
- (error "LaTeX to MathML converter not configured")))
+ (user-error "LaTeX to MathML converter not configured")))
(message "Running %s" cmd)
(setq shell-command-output (shell-command-to-string cmd))
(setq mathml
@@ -17497,14 +18625,57 @@ inspection."
'org-latex-src-embed-type (if latex-frag-type
'paragraph 'character)))
;; Failed conversion. Return the LaTeX fragment verbatim
- (add-text-properties
- 0 (1- (length latex-frag)) '(org-protected t) latex-frag)
latex-frag)))
+(defun org-create-formula-image (string tofile options buffer &optional type)
+ "Create an image from LaTeX source using dvipng or convert.
+This function calls either `org-create-formula-image-with-dvipng'
+or `org-create-formula-image-with-imagemagick' depending on the
+value of `org-latex-create-formula-image-program' or on the value
+of the optional TYPE variable.
+
+Note: ultimately these two function should be combined as they
+share a good deal of logic."
+ (org-check-external-command
+ "latex" "needed to convert LaTeX fragments to images")
+ (funcall
+ (case (or type org-latex-create-formula-image-program)
+ ('dvipng
+ (org-check-external-command
+ "dvipng" "needed to convert LaTeX fragments to images")
+ #'org-create-formula-image-with-dvipng)
+ ('imagemagick
+ (org-check-external-command
+ "convert" "you need to install imagemagick")
+ #'org-create-formula-image-with-imagemagick)
+ (t (error
+ "Invalid value of `org-latex-create-formula-image-program'")))
+ string tofile options buffer))
+
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export--get-global-options "ox" (&optional backend))
+(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-latex-guess-babel-language "ox-latex" (header info))
+(defun org-create-formula--latex-header ()
+ "Return LaTeX header appropriate for previewing a LaTeX snippet."
+ (let ((info (org-combine-plists (org-export--get-global-options
+ (org-export-get-backend 'latex))
+ (org-export--get-inbuffer-options
+ (org-export-get-backend 'latex)))))
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-splice-latex-header
+ org-format-latex-header
+ org-latex-default-packages-alist
+ org-latex-packages-alist t
+ (plist-get info :latex-header)))
+ info)))
+
;; This function borrows from Ganesh Swami's latex2png.el
(defun org-create-formula-image-with-dvipng (string tofile options buffer)
"This calls dvipng."
- (require 'org-latex)
+ (require 'ox-latex)
(let* ((tmpdir (if (featurep 'xemacs)
(temp-directory)
temporary-file-directory))
@@ -17522,17 +18693,14 @@ inspection."
"Black"))
(bg (or (plist-get options (if buffer :background :html-background))
"Transparent")))
- (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)))
- (if (eq bg 'default) (setq bg (org-dvipng-color :background)))
- (with-temp-file texfile
- (insert (org-splice-latex-header
- org-format-latex-header
- org-export-latex-default-packages-alist
- org-export-latex-packages-alist t
- org-format-latex-header-extra))
- (insert "\n\\begin{document}\n" string "\n\\end{document}\n")
- (require 'org-latex)
- (org-export-latex-fix-inputenc))
+ (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))
+ (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg))))
+ (if (eq bg 'default) (setq bg (org-dvipng-color :background))
+ (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg))))
+ (let ((latex-header (org-create-formula--latex-header)))
+ (with-temp-file texfile
+ (insert latex-header)
+ (insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
(let ((dir default-directory))
(condition-case nil
(progn
@@ -17569,10 +18737,10 @@ inspection."
(delete-file (concat texfilebase e))))
pngfile))))
-(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el
+(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
"This calls convert, which is included into imagemagick."
- (require 'org-latex)
+ (require 'ox-latex)
(let* ((tmpdir (if (featurep 'xemacs)
(temp-directory)
temporary-file-directory))
@@ -17585,7 +18753,7 @@ inspection."
(font-height (face-font 'default))
(face-attribute 'default :height nil)))
(scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (dpi (number-to-string (* scale (floor (if buffer fnh 120.)))))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"black"))
(bg (or (plist-get options (if buffer :background :html-background))
@@ -17594,54 +18762,19 @@ inspection."
(setq fg (org-latex-color-format fg)))
(if (eq bg 'default) (setq bg (org-latex-color :background))
(setq bg (org-latex-color-format
- (if (string= bg "Transparent")(setq bg "white")))))
- (with-temp-file texfile
- (insert (org-splice-latex-header
- org-format-latex-header
- org-export-latex-default-packages-alist
- org-export-latex-packages-alist t
- org-format-latex-header-extra))
- (insert "\n\\begin{document}\n"
- "\\definecolor{fg}{rgb}{" fg "}\n"
- "\\definecolor{bg}{rgb}{" bg "}\n"
- "\n\\pagecolor{bg}\n"
- "\n{\\color{fg}\n"
- string
- "\n}\n"
- "\n\\end{document}\n" )
- (require 'org-latex)
- (org-export-latex-fix-inputenc))
- (let ((dir default-directory) cmd cmds latex-frags-cmds)
- (condition-case nil
- (progn
- (cd tmpdir)
- (setq cmds org-latex-to-pdf-process)
- (while cmds
- (setq latex-frags-cmds (pop cmds))
- (if (listp latex-frags-cmds)
- (setq cmds nil)
- (setq latex-frags-cmds (list (car org-latex-to-pdf-process)))))
- (while latex-frags-cmds
- (setq cmd (pop latex-frags-cmds))
- (while (string-match "%b" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument texfile))
- t t cmd)))
- (while (string-match "%f" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument (file-name-nondirectory texfile)))
- t t cmd)))
- (while (string-match "%o" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument (file-name-directory texfile)))
- t t cmd)))
- (setq cmd (split-string cmd))
- (eval (append (list 'call-process (pop cmd) nil nil nil) cmd))))
- (error nil))
- (cd dir))
+ (if (string= bg "Transparent") "white" bg))))
+ (let ((latex-header (org-create-formula--latex-header)))
+ (with-temp-file texfile
+ (insert latex-header)
+ (insert "\n\\begin{document}\n"
+ "\\definecolor{fg}{rgb}{" fg "}\n"
+ "\\definecolor{bg}{rgb}{" bg "}\n"
+ "\n\\pagecolor{bg}\n"
+ "\n{\\color{fg}\n"
+ string
+ "\n}\n"
+ "\n\\end{document}\n")))
+ (org-latex-compile texfile t)
(if (not (file-exists-p pdffile))
(progn (message "Failed to create pdf file from %s" texfile) nil)
(condition-case nil
@@ -17652,7 +18785,7 @@ inspection."
"-antialias"
pdffile
"-quality" "100"
- ;; "-sharpen" "0x1.0"
+ ;; "-sharpen" "0x1.0"
pngfile)
(call-process "convert" nil nil nil
"-density" dpi
@@ -17660,7 +18793,7 @@ inspection."
"-antialias"
pdffile
"-quality" "100"
- ; "-sharpen" "0x1.0"
+ ;; "-sharpen" "0x1.0"
pngfile))
(error nil))
(if (not (file-exists-p pngfile))
@@ -17745,6 +18878,12 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
((eq attr :background) 'background))))
(color-values (face-attribute 'default attr nil))))))
+(defun org-dvipng-color-format (color-name)
+ "Convert COLOR-NAME to a RGB color value for dvipng."
+ (apply 'format "rgb %s %s %s"
+ (mapcar 'org-normalize-color
+ (color-values color-name))))
+
(defun org-latex-color (attr)
"Return a RGB color for the LaTeX color package."
(apply 'format "%s,%s,%s"
@@ -17766,8 +18905,9 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
"Return string to be used as color value for an RGB component."
(format "%g" (/ value 65535.0)))
-;; Image display
+
+;; Image display
(defvar org-inline-image-overlays nil)
(make-variable-buffer-local 'org-inline-image-overlays)
@@ -17781,7 +18921,8 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(org-remove-inline-images)
(message "Inline image display turned off"))
(org-display-inline-images include-linked)
- (if org-inline-image-overlays
+ (if (and (org-called-interactively-p)
+ org-inline-image-overlays)
(message "%d images displayed inline"
(length org-inline-image-overlays))
(message "No images to display inline"))))
@@ -17805,35 +18946,54 @@ When REFRESH is set, refresh existing images between BEG and END.
This will create new image displays only if necessary.
BEG and END default to the buffer boundaries."
(interactive "P")
- (unless refresh
- (org-remove-inline-images)
- (if (fboundp 'clear-image-cache) (clear-image-cache)))
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char beg)
- (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
- "\\)\\]" (if include-linked "" "\\]")))
- old file ov img)
- (while (re-search-forward re end t)
- (setq old (get-char-property-and-overlay (match-beginning 1)
- 'org-image-overlay))
- (setq file (expand-file-name
- (concat (or (match-string 3) "") (match-string 4))))
- (when (file-exists-p file)
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (setq img (save-match-data (create-image file)))
- (when img
- (setq ov (make-overlay (match-beginning 0) (match-end 0)))
- (overlay-put ov 'display img)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays)))))))))
+ (when (display-graphic-p)
+ (unless refresh
+ (org-remove-inline-images)
+ (if (fboundp 'clear-image-cache) (clear-image-cache)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+ (goto-char beg)
+ (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]" (if include-linked "" "\\]")))
+ (case-fold-search t)
+ old file ov img type attrwidth width)
+ (while (re-search-forward re end t)
+ (setq old (get-char-property-and-overlay (match-beginning 1)
+ 'org-image-overlay)
+ file (expand-file-name
+ (concat (or (match-string 3) "") (match-string 4))))
+ (when (image-type-available-p 'imagemagick)
+ (setq attrwidth (if (or (listp org-image-actual-width)
+ (null org-image-actual-width))
+ (save-excursion
+ (save-match-data
+ (when (re-search-backward
+ "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
+ (save-excursion
+ (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
+ (string-to-number (match-string 1))))))
+ width (cond ((eq org-image-actual-width t) nil)
+ ((null org-image-actual-width) attrwidth)
+ ((numberp org-image-actual-width)
+ org-image-actual-width)
+ ((listp org-image-actual-width)
+ (or attrwidth (car org-image-actual-width))))
+ type (if width 'imagemagick)))
+ (when (file-exists-p file)
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (setq img (save-match-data (create-image file type nil :width width)))
+ (when img
+ (setq ov (make-overlay (match-beginning 0) (match-end 0)))
+ (overlay-put ov 'display img)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put ov 'modification-hooks
+ (list 'org-display-inline-remove-overlay))
+ (push ov org-inline-image-overlays))))))))))
(define-obsolete-function-alias
'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
@@ -17902,7 +19062,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-i" 'org-cycle)
(org-defkey org-mode-map [(tab)] 'org-cycle)
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
-(org-defkey org-mode-map "\M-\t" 'pcomplete)
+(org-defkey org-mode-map "\M-\t" #'pcomplete)
;; The following line is necessary under Suse GNU/Linux
(unless (featurep 'xemacs)
(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
@@ -17969,7 +19129,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [?\C-c (right)] 'org-shiftright)
(org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright)
(org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)
- (org-defkey org-mode-map [?\e (tab)] 'pcomplete)
+ (org-defkey org-mode-map [?\e (tab)] #'pcomplete)
(org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading)
(org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft)
(org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright)
@@ -17996,13 +19156,16 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-_" 'org-down-element)
(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level)
(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level)
+(org-defkey org-mode-map "\C-c\M-f" 'org-next-block)
+(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block)
(org-defkey org-mode-map "\C-c$" 'org-archive-subtree)
-(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree)
+(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-archive-subtree)
(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default)
(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer)
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
+(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups)
(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
@@ -18010,6 +19173,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-d" 'org-deadline)
(org-defkey org-mode-map "\C-c;" 'org-toggle-comment)
(org-defkey org-mode-map "\C-c\C-w" 'org-refile)
+(org-defkey org-mode-map "\C-c\M-w" 'org-copy)
(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
@@ -18044,6 +19208,9 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
+(org-defkey org-mode-map [remap open-line] 'org-open-line)
+(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
+(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-j" 'org-return-indent)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
@@ -18058,7 +19225,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-a" 'org-attach)
(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
-(org-defkey org-mode-map "\C-c\C-e" 'org-export)
+(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch)
(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
@@ -18089,6 +19256,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox)
(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property)
+(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value)
(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
@@ -18123,6 +19291,8 @@ BEG and END default to the buffer boundaries."
("p" . (org-speed-move-safe 'outline-previous-visible-heading))
("f" . (org-speed-move-safe 'org-forward-heading-same-level))
("b" . (org-speed-move-safe 'org-backward-heading-same-level))
+ ("F" . org-next-block)
+ ("B" . org-previous-block)
("u" . (org-speed-move-safe 'outline-up-heading))
("j" . org-goto)
("g" . (org-refile t))
@@ -18130,6 +19300,7 @@ BEG and END default to the buffer boundaries."
("c" . org-cycle)
("C" . org-shifttab)
(" " . org-display-outline-path)
+ ("s" . org-narrow-to-subtree)
("=" . org-columns)
("Outline Structure Editing")
("U" . org-shiftmetaup)
@@ -18143,7 +19314,7 @@ BEG and END default to the buffer boundaries."
("^" . org-sort)
("w" . org-refile)
("a" . org-archive-subtree-default-with-confirmation)
- ("." . org-mark-subtree)
+ ("@" . org-mark-subtree)
("#" . org-toggle-comment)
("Clock Commands")
("I" . org-clock-in)
@@ -18190,7 +19361,7 @@ BEG and END default to the buffer boundaries."
"Show the available speed commands."
(interactive)
(if (not org-use-speed-commands)
- (error "Speed commands are not activated, customize `org-use-speed-commands'")
+ (user-error "Speed commands are not activated, customize `org-use-speed-commands'")
(with-output-to-temp-buffer "*Help*"
(princ "User-defined Speed commands\n===========================\n")
(mapc 'org-print-speed-command org-speed-commands-user)
@@ -18338,7 +19509,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(when (or (memq invisible-at-point '(outline org-hide-block t))
(memq invisible-before-point '(outline org-hide-block t)))
(if (eq org-catch-invisible-edits 'error)
- (error "Editing in invisible areas is prohibited - make visible first"))
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
(if (and org-custom-properties-overlays
(y-or-n-p "Display invisible properties in this buffer? "))
(org-toggle-custom-properties-visibility)
@@ -18347,7 +19518,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(if invisible-before-point
(goto-char (previous-single-char-property-change
(point) 'invisible)))
- (org-cycle))
+ (show-subtree))
(cond
((eq org-catch-invisible-edits 'show)
;; That's it, we do the edit after showing
@@ -18359,7 +19530,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'."
(message "Unfolding invisible region around point before editing"))
(t
;; Don't do the edit, make the user repeat it in full visibility
- (error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+ (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
(defun org-fix-tags-on-the-fly ()
(when (and (equal (char-after (point-at-bol)) ?*)
@@ -18411,9 +19582,8 @@ because, in this case the deletion might narrow the column."
(let ((pos (point))
(noalign (looking-at "[^|\n\r]* |"))
(c org-table-may-need-update))
- (replace-match (concat
- (substring (match-string 0) 1 -1)
- " |"))
+ (replace-match
+ (concat (substring (match-string 0) 1 -1) " |") nil t)
(goto-char pos)
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
@@ -18423,8 +19593,14 @@ because, in this case the deletion might narrow the column."
(org-fix-tags-on-the-fly))))
;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
-(put 'org-self-insert-command 'delete-selection t)
-(put 'orgtbl-self-insert-command 'delete-selection t)
+(put 'org-self-insert-command 'delete-selection
+ (lambda ()
+ (not (run-hook-with-args-until-success
+ 'self-insert-uses-region-functions))))
+(put 'orgtbl-self-insert-command 'delete-selection
+ (lambda ()
+ (not (run-hook-with-args-until-success
+ 'self-insert-uses-region-functions))))
(put 'org-delete-char 'delete-selection 'supersede)
(put 'org-delete-backward-char 'delete-selection 'supersede)
(put 'org-yank 'delete-selection 'yank)
@@ -18439,9 +19615,6 @@ because, in this case the deletion might narrow the column."
(put 'org-self-insert-command 'pabbrev-expand-after-command t)
(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
-;; How to do this: Measure non-white length of current string
-;; If equal to column width, we should realign.
-
(defun org-remap (map &rest commands)
"In MAP, remap the functions given in COMMANDS.
COMMANDS is a list of alternating OLDDEF NEWDEF command names."
@@ -18452,6 +19625,16 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey map (vector 'remap old) new)
(substitute-key-definition old new map global-map)))))
+(defun org-transpose-words ()
+ "Transpose words for Org.
+This uses the `org-mode-transpose-word-syntax-table' syntax
+table, which interprets characters in `org-emphasis-alist' as
+word constituents."
+ (interactive)
+ (with-syntax-table org-mode-transpose-word-syntax-table
+ (call-interactively 'transpose-words)))
+(org-remap org-mode-map 'transpose-words 'org-transpose-words)
+
(when (eq org-enable-table-editor 'optimized)
;; If the user wants maximum table support, we need to hijack
;; some standard editing functions
@@ -18577,13 +19760,13 @@ See `org-ctrl-c-ctrl-c-hook' for more information.")
(defun org-modifier-cursor-error ()
"Throw an error, a modified cursor command was applied in wrong context."
- (error "This command is active in special context like tables, headlines or items"))
+ (user-error "This command is active in special context like tables, headlines or items"))
(defun org-shiftselect-error ()
"Throw an error because Shift-Cursor command was applied in wrong context."
(if (and (boundp 'shift-select-mode) shift-select-mode)
- (error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
- (error "This command works only in special context like headlines or timestamps")))
+ (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (user-error "This command works only in special context like headlines or timestamps")))
(defun org-call-for-shift-select (cmd)
(let ((this-command-keys-shift-translated t))
@@ -18591,9 +19774,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information.")
(defun org-shifttab (&optional arg)
"Global visibility cycling or move to previous table field.
-Calls `org-cycle' with argument t, or `org-table-previous-field', depending
-on context.
-See the individual commands for more information."
+Call `org-table-previous-field' within a table.
+When ARG is nil, cycle globally through visibility states.
+When ARG is a numeric prefix, show contents of this level."
(interactive "P")
(cond
((org-at-table-p) (call-interactively 'org-table-previous-field))
@@ -18601,6 +19784,7 @@ See the individual commands for more information."
(let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg)))
(message "Content view to level: %d" arg)
(org-content (prefix-numeric-value arg2))
+ (org-cycle-show-empty-lines t)
(setq org-cycle-global-status 'overview)))
(t (call-interactively 'org-global-cycle))))
@@ -18649,7 +19833,7 @@ See the individual commands for more information."
((org-at-item-p) (call-interactively 'org-move-item-up))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-up)))
- (t (org-modifier-cursor-error))))
+ (t (call-interactively 'org-drag-line-backward))))
(defun org-shiftmetadown (&optional arg)
"Move subtree down or insert table row.
@@ -18664,10 +19848,10 @@ See the individual commands for more information."
((org-at-item-p) (call-interactively 'org-move-item-down))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-down)))
- (t (org-modifier-cursor-error))))
+ (t (call-interactively 'org-drag-line-forward))))
(defsubst org-hidden-tree-error ()
- (error
+ (user-error
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
(defun org-metaleft (&optional arg)
@@ -18757,18 +19941,6 @@ this function returns t, nil otherwise."
(throw 'exit t))))
nil))))
-(org-autoload "org-element" '(org-element-at-point org-element-type))
-
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
-(declare-function org-element-type "org-element" (element))
-(declare-function org-element-contents "org-element" (element))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion))
-(declare-function org-element-nested-p "org-element" (elem-a elem-b))
-(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
-(declare-function org-element--parse-objects "org-element" (beg end acc restriction))
-(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
-
(defun org-metaup (&optional arg)
"Move subtree up or move table row up.
Calls `org-move-subtree-up' or `org-table-move-row' or
@@ -18959,23 +20131,23 @@ Depending on context, this does one of the following:
(org-call-for-shift-select 'backward-word))
(t (org-shiftselect-error))))
-(defun org-shiftcontrolup ()
- "Change timestamps synchronously up in CLOCK log lines."
- (interactive)
- (cond ((and (not org-support-shift-select)
- (org-at-clock-log-p)
- (org-at-timestamp-p t))
- (org-clock-timestamps-up))
- (t (org-shiftselect-error))))
-
-(defun org-shiftcontroldown ()
- "Change timestamps synchronously down in CLOCK log lines."
- (interactive)
- (cond ((and (not org-support-shift-select)
- (org-at-clock-log-p)
- (org-at-timestamp-p t))
- (org-clock-timestamps-down))
- (t (org-shiftselect-error))))
+(defun org-shiftcontrolup (&optional n)
+ "Change timestamps synchronously up in CLOCK log lines.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (let (org-support-shift-select)
+ (org-clock-timestamps-up n))
+ (user-error "Not at a clock log")))
+
+(defun org-shiftcontroldown (&optional n)
+ "Change timestamps synchronously down in CLOCK log lines.
+Optional argument N tells to change by that many units."
+ (interactive "P")
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (let (org-support-shift-select)
+ (org-clock-timestamps-down n))
+ (user-error "Not at a clock log")))
(defun org-ctrl-c-ret ()
"Call `org-table-hline-and-move' or `org-insert-heading' dep. on context."
@@ -19040,38 +20212,51 @@ See the individual commands for more information."
(eq 'fixed-width (org-element-type (org-element-at-point)))))
(defun org-edit-special (&optional arg)
- "Call a special editor for the stuff at point.
+ "Call a special editor for the element at point.
When at a table, call the formula editor with `org-table-edit-formulas'.
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
-When in an #+include line, visit the included file.
+When at an #+INCLUDE keyword, visit the included file.
On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
- (interactive)
- ;; possibly prep session before editing source
- (when (and (org-in-src-block-p) arg)
- (let* ((info (org-babel-get-src-block-info))
- (lang (nth 0 info))
- (params (nth 2 info))
- (session (cdr (assoc :session params))))
- (when (and info session) ;; we are in a source-code block with a session
- (funcall
- (intern (concat "org-babel-prep-session:" lang)) session params))))
- (cond ;; proceed with `org-edit-special'
- ((save-excursion
- (beginning-of-line 1)
- (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)"))
- (find-file (org-trim (match-string 1))))
- ((org-at-table.el-p) (org-edit-src-code))
- ((or (org-at-table-p)
- (save-excursion
- (beginning-of-line 1)
- (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:"))))
- (call-interactively 'org-table-edit-formulas))
- ((org-in-block-p '("src" "example" "latex" "html")) (org-edit-src-code))
- ((org-in-fixed-width-region-p) (org-edit-fixed-width-region))
- ((org-at-regexp-p org-any-link-re) (call-interactively 'ffap))
- (t (user-error "No special environment to edit here"))))
+ (interactive "P")
+ (let ((element (org-element-at-point)))
+ (assert (not buffer-read-only) nil
+ "Buffer is read-only: %s" (buffer-name))
+ (case (org-element-type element)
+ (src-block
+ (if (not arg) (org-edit-src-code)
+ (let* ((info (org-babel-get-src-block-info))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (session (cdr (assq :session params))))
+ (if (not session) (org-edit-src-code)
+ ;; At a src-block with a session and function called with
+ ;; an ARG: switch to the buffer related to the inferior
+ ;; process.
+ (switch-to-buffer
+ (funcall (intern (concat "org-babel-prep-session:" lang))
+ session params))))))
+ (keyword
+ (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
+ (find-file
+ (org-remove-double-quotes
+ (car (org-split-string (org-element-property :value element)))))
+ (user-error "No special environment to edit here")))
+ (table
+ (if (eq (org-element-property :type element) 'table.el)
+ (org-edit-src-code)
+ (call-interactively 'org-table-edit-formulas)))
+ ;; Only Org tables contain `table-row' type elements.
+ (table-row (call-interactively 'org-table-edit-formulas))
+ ((example-block export-block) (org-edit-src-code))
+ (fixed-width (org-edit-fixed-width-region))
+ (otherwise
+ ;; No notable element at point. Though, we may be at a link,
+ ;; which is an object. Thus, scan deeper.
+ (if (eq (org-element-type (org-element-context element)) 'link)
+ (call-interactively 'ffap)
+ (user-error "No special environment to edit here"))))))
(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
@@ -19119,143 +20304,179 @@ This command does many different things, depending on context:
evaluation requires confirmation. Code block evaluation can be
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
(interactive "P")
- (let ((org-enable-table-editor t))
- (cond
- ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
- org-occur-highlights
- org-latex-fragment-image-overlays)
- (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
- (org-remove-occur-highlights)
- (org-remove-latex-fragment-image-overlays)
- (message "Temporary highlights/overlays removed from current buffer"))
- ((and (local-variable-p 'org-finish-function (current-buffer))
- (fboundp org-finish-function))
- (funcall org-finish-function))
- ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
- ((org-in-regexp org-ts-regexp-both)
- (org-timestamp-change 0 'day))
- ((or (looking-at org-property-start-re)
- (org-at-property-p))
- (call-interactively 'org-property-action))
- ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp))
- ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]")
- (or (org-at-heading-p) (org-at-item-p)))
- (call-interactively 'org-update-statistics-cookies))
- ((org-at-heading-p) (call-interactively 'org-set-tags))
- ((org-at-table.el-p)
- (message "Use C-c ' to edit table.el tables"))
- ((org-at-table-p)
- (org-table-maybe-eval-formula)
- (if arg
- (call-interactively 'org-table-recalculate)
- (org-table-maybe-recalculate-line))
- (call-interactively 'org-table-align)
- (orgtbl-send-table 'maybe))
- ((or (org-footnote-at-reference-p)
- (org-footnote-at-definition-p))
- (call-interactively 'org-footnote-action))
- ((org-at-item-checkbox-p)
- ;; Cursor at a checkbox: repair list and update checkboxes. Send
- ;; list only if at top item.
- (let* ((cbox (match-string 1))
- (struct (org-list-struct))
- (old-struct (copy-tree struct))
- (parents (org-list-parents-alist struct))
- (orderedp (org-entry-get nil "ORDERED"))
- (firstp (= (org-list-get-top-point struct) (point-at-bol)))
- block-item)
- ;; Use a light version of `org-toggle-checkbox' to avoid
- ;; computing list structure twice.
- (let ((new-box (cond
- ((equal arg '(16)) "[-]")
- ((equal arg '(4)) nil)
- ((equal "[X]" cbox) "[ ]")
- (t "[X]"))))
- (if (and firstp arg)
- ;; If at first item of sub-list, remove check-box from
- ;; every item at the same level.
- (mapc
- (lambda (pos) (org-list-set-checkbox pos struct new-box))
- (org-list-get-all-items
- (point-at-bol) struct (org-list-prevs-alist struct)))
- (org-list-set-checkbox (point-at-bol) struct new-box)))
- ;; Replicate `org-list-write-struct', while grabbing a return
- ;; value from `org-list-struct-fix-box'.
- (org-list-struct-fix-ind struct parents 2)
- (org-list-struct-fix-item-end struct)
- (let ((prevs (org-list-prevs-alist struct)))
- (org-list-struct-fix-bul struct prevs)
- (org-list-struct-fix-ind struct parents)
- (setq block-item
- (org-list-struct-fix-box struct parents prevs orderedp)))
- (if (equal struct old-struct)
- (user-error "Cannot toggle this checkbox (unchecked subitems?)")
- (org-list-struct-apply-struct struct old-struct)
- (org-update-checkbox-count-maybe))
- (when block-item
- (message
- "Checkboxes were removed due to unchecked box at line %d"
- (org-current-line block-item)))
- (when firstp (org-list-send-list 'maybe))))
- ((org-at-item-p)
- ;; Cursor at an item: repair list. Do checkbox related actions
- ;; only if function was called with an argument. Send list only
- ;; if at top item.
- (let* ((struct (org-list-struct))
- (firstp (= (org-list-get-top-point struct) (point-at-bol)))
- old-struct)
- (when arg
- (setq old-struct (copy-tree struct))
- (if firstp
- ;; If at first item of sub-list, add check-box to every
- ;; item at the same level.
- (mapc
- (lambda (pos)
- (unless (org-list-get-checkbox pos struct)
- (org-list-set-checkbox pos struct "[ ]")))
- (org-list-get-all-items
- (point-at-bol) struct (org-list-prevs-alist struct)))
- (org-list-set-checkbox (point-at-bol) struct "[ ]")))
- (org-list-write-struct
- struct (org-list-parents-alist struct) old-struct)
- (when arg (org-update-checkbox-count-maybe))
- (when firstp (org-list-send-list 'maybe))))
- ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re))
- ;; Dynamic block
- (beginning-of-line 1)
- (save-excursion (org-update-dblock)))
- ((save-excursion
- (let ((case-fold-search t))
- (beginning-of-line 1)
- (looking-at "[ \t]*#\\+\\([a-z]+\\)")))
- (cond
- ((or (equal (match-string 1) "TBLFM")
- (equal (match-string 1) "tblfm"))
- ;; Recalculate the table before this line
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-backward " \r\n\t")
- (if (org-at-table-p)
- (org-call-with-arg 'org-table-recalculate (or arg t)))))
- (t
- (let ((org-inhibit-startup-visibility-stuff t)
- (org-startup-align-all-tables nil))
- (when (boundp 'org-table-coordinate-overlays)
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil))
- (org-save-outline-visibility 'use-markers (org-mode-restart)))
- (message "Local setup has been refreshed"))))
- ((org-clock-update-time-maybe))
- (t
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (error "C-c C-c can do nothing useful at this location"))))))
+ (cond
+ ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
+ org-occur-highlights
+ org-latex-fragment-image-overlays)
+ (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
+ (org-remove-occur-highlights)
+ (org-remove-latex-fragment-image-overlays)
+ (message "Temporary highlights/overlays removed from current buffer"))
+ ((and (local-variable-p 'org-finish-function (current-buffer))
+ (fboundp org-finish-function))
+ (funcall org-finish-function))
+ ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
+ (t
+ (let* ((context (org-element-context)) (type (org-element-type context)))
+ ;; Test if point is within a blank line.
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-error "C-c C-c can do nothing useful at this location"))
+ (case type
+ ;; When at a link, act according to the parent instead.
+ (link (setq context (org-element-property :parent context))
+ (setq type (org-element-type context)))
+ ;; Unsupported object types: refer to the first supported
+ ;; element or object containing it.
+ ((bold code entity export-snippet inline-babel-call inline-src-block
+ italic latex-fragment line-break macro strike-through subscript
+ superscript underline verbatim)
+ (while (and (setq context (org-element-property :parent context))
+ (not (memq (setq type (org-element-type context))
+ '(radio-target paragraph verse-block
+ table-cell)))))))
+ ;; For convenience: at the first line of a paragraph on the
+ ;; same line as an item, apply function on that item instead.
+ (when (eq type 'paragraph)
+ (let ((parent (org-element-property :parent context)))
+ (when (and (eq (org-element-type parent) 'item)
+ (= (point-at-bol) (org-element-property :begin parent)))
+ (setq context parent type 'item))))
+ ;; Act according to type of element or object at point.
+ (case type
+ (clock (org-clock-update-time-maybe))
+ (dynamic-block
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated context))
+ (org-update-dblock)))
+ (footnote-definition
+ (goto-char (org-element-property :post-affiliated context))
+ (call-interactively 'org-footnote-action))
+ (footnote-reference (call-interactively 'org-footnote-action))
+ ((headline inlinetask)
+ (save-excursion (goto-char (org-element-property :begin context))
+ (call-interactively 'org-set-tags)))
+ (item
+ ;; At an item: a double C-u set checkbox to "[-]"
+ ;; unconditionally, whereas a single one will toggle its
+ ;; presence. Without a universal argument, if the item
+ ;; has a checkbox, toggle it. Otherwise repair the list.
+ (let* ((box (org-element-property :checkbox context))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (parents (org-list-parents-alist struct))
+ (prevs (org-list-prevs-alist struct))
+ (orderedp (org-not-nil (org-entry-get nil "ORDERED"))))
+ (org-list-set-checkbox
+ (org-element-property :begin context) struct
+ (cond ((equal arg '(16)) "[-]")
+ ((and (not box) (equal arg '(4))) "[ ]")
+ ((or (not box) (equal arg '(4))) nil)
+ ((eq box 'on) "[ ]")
+ (t "[X]")))
+ ;; Mimic `org-list-write-struct' but with grabbing
+ ;; a return value from `org-list-struct-fix-box'.
+ (org-list-struct-fix-ind struct parents 2)
+ (org-list-struct-fix-item-end struct)
+ (org-list-struct-fix-bul struct prevs)
+ (org-list-struct-fix-ind struct parents)
+ (let ((block-item
+ (org-list-struct-fix-box struct parents prevs orderedp)))
+ (if (and box (equal struct old-struct))
+ (if (equal arg '(16))
+ (message "Checkboxes already reset")
+ (user-error "Cannot toggle this checkbox: %s"
+ (if (eq box 'on)
+ "all subitems checked"
+ "unchecked subitems")))
+ (org-list-struct-apply-struct struct old-struct)
+ (org-update-checkbox-count-maybe))
+ (when block-item
+ (message "Checkboxes were removed due to empty box at line %d"
+ (org-current-line block-item))))))
+ (keyword
+ (let ((org-inhibit-startup-visibility-stuff t)
+ (org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc 'delete-overlay org-table-coordinate-overlays)
+ (setq org-table-coordinate-overlays nil))
+ (org-save-outline-visibility 'use-markers (org-mode-restart)))
+ (message "Local setup has been refreshed"))
+ (plain-list
+ ;; At a plain list, with a double C-u argument, set
+ ;; checkboxes of each item to "[-]", whereas a single one
+ ;; will toggle their presence according to the state of the
+ ;; first item in the list. Without an argument, repair the
+ ;; list.
+ (let* ((begin (org-element-property :contents-begin context))
+ (beginm (move-marker (make-marker) begin))
+ (struct (org-element-property :structure context))
+ (old-struct (copy-tree struct))
+ (first-box (save-excursion
+ (goto-char begin)
+ (looking-at org-list-full-item-re)
+ (match-string-no-properties 3)))
+ (new-box (cond ((equal arg '(16)) "[-]")
+ ((equal arg '(4)) (unless first-box "[ ]"))
+ ((equal first-box "[X]") "[ ]")
+ (t "[X]"))))
+ (cond
+ (arg
+ (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box))
+ (org-list-get-all-items
+ begin struct (org-list-prevs-alist struct))))
+ ((and first-box (eq (point) begin))
+ ;; For convenience, when point is at bol on the first
+ ;; item of the list and no argument is provided, simply
+ ;; toggle checkbox of that item, if any.
+ (org-list-set-checkbox begin struct new-box)))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (org-update-checkbox-count-maybe)
+ (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
+ ((property-drawer node-property)
+ (call-interactively 'org-property-action))
+ ((radio-target target)
+ (call-interactively 'org-update-radio-target-regexp))
+ (statistics-cookie
+ (call-interactively 'org-update-statistics-cookies))
+ ((table table-cell table-row)
+ ;; At a table, recalculate every field and align it. Also
+ ;; send the table if necessary. If the table has
+ ;; a `table.el' type, just give up. At a table row or
+ ;; cell, maybe recalculate line but always align table.
+ (if (eq (org-element-property :type context) 'table.el)
+ (message "%s" "Use C-c ' to edit table.el tables")
+ (let ((org-enable-table-editor t))
+ (if (or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe)))
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively 'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align)))))))
+ (timestamp (org-timestamp-change 0 'day))
+ (otherwise
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-error
+ "C-c C-c can do nothing useful at this location")))))))))
(defun org-mode-restart ()
- "Restart Org-mode, to scan again for special lines.
-Also updates the keyword regular expressions."
(interactive)
- (org-mode)
- (message "Org-mode restarted"))
+ (let ((indent-status (org-bound-and-true-p org-indent-mode)))
+ (funcall major-mode)
+ (hack-local-variables)
+ (when (and indent-status (not (org-bound-and-true-p org-indent-mode)))
+ (org-indent-mode -1)))
+ (message "%s restarted" major-mode))
(defun org-kill-note-or-show-branches ()
"If this is a Note buffer, abort storing the note. Else call `show-branches'."
@@ -19267,6 +20488,18 @@ Also updates the keyword regular expressions."
(let ((org-note-abort t))
(funcall org-finish-function))))
+(defun org-open-line (n)
+ "Insert a new row in tables, call `open-line' elsewhere.
+If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
+ (interactive "*p")
+ (cond
+ ((not org-special-ctrl-o)
+ (open-line n))
+ ((org-at-table-p)
+ (org-table-insert-row))
+ (t
+ (open-line n))))
+
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
Calls `org-table-next-row' or `newline', depending on context.
@@ -19347,13 +20580,13 @@ Calls `org-table-insert-hline', `org-toggle-item', or
"Convert headings or normal lines to items, items to normal lines.
If there is no active region, only the current line is considered.
-If the first non blank line in the region is an headline, convert
+If the first non blank line in the region is a headline, convert
all headlines to items, shifting text accordingly.
If it is an item, convert all items to normal lines.
-If it is normal text, change region into an item. With a prefix
-argument ARG, change each line in region into an item."
+If it is normal text, change region into a list of items.
+With a prefix argument ARG, change the region in a single item."
(interactive "P")
(let ((shift-text
(function
@@ -19446,19 +20679,10 @@ argument ARG, change each line in region into an item."
(funcall shift-text
(+ start-ind (* (1+ delta) bul-len))
(min end section-end)))))))
- ;; Case 3. Normal line with ARG: turn each non-item line into
- ;; an item.
- (arg
- (while (< (point) end)
- (unless (or (org-at-heading-p) (org-at-item-p))
- (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
- (replace-match
- (concat "\\1" (org-list-bullet-string "-") "\\2"))))
- (forward-line)))
- ;; Case 4. Normal line without ARG: make the first line of
- ;; region an item, and shift indentation of others
- ;; lines to set them as item's body.
- (t (let* ((bul (org-list-bullet-string "-"))
+ ;; Case 3. Normal line with ARG: make the first line of region
+ ;; an item, and shift indentation of others lines to
+ ;; set them as item's body.
+ (arg (let* ((bul (org-list-bullet-string "-"))
(bul-len (length bul))
(ref-ind (org-get-indentation)))
(skip-chars-forward " \t")
@@ -19471,29 +20695,40 @@ argument ARG, change each line in region into an item."
(+ ref-ind bul-len)
(min end (save-excursion (or (outline-next-heading)
(point)))))
- (forward-line)))))))))
+ (forward-line))))
+ ;; Case 4. Normal line without ARG: turn each non-item line
+ ;; into an item.
+ (t
+ (while (< (point) end)
+ (unless (or (org-at-heading-p) (org-at-item-p))
+ (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+ (replace-match
+ (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+ (forward-line))))))))
(defun org-toggle-heading (&optional nstars)
"Convert headings to normal text, or items or text to headings.
-If there is no active region, only the current line is considered.
+If there is no active region, only convert the current line.
With a \\[universal-argument] prefix, convert the whole list at
point into heading.
In a region:
-- If the first non blank line is an headline, remove the stars
+- If the first non blank line is a headline, remove the stars
from all headlines in the region.
-- If it is a normal line turn each and every normal line (i.e. not an
- heading or an item) in the region into a heading.
+- If it is a normal line, turn each and every normal line (i.e.,
+ not an heading or an item) in the region into headings. If you
+ want to convert only the first line of this region, use one
+ universal prefix argument.
- If it is a plain list item, turn all plain list items into headings.
When converting a line into a heading, the number of stars is chosen
such that the lines become children of the current entry. However,
-when a prefix argument is given, its value determines the number of
-stars to add."
+when a numeric prefix argument is given, its value determines the
+number of stars to add."
(interactive "P")
(let ((skip-blanks
(function
@@ -19511,7 +20746,7 @@ stars to add."
;; do not consider the last line to be in the region.
(when (and current-prefix-arg (org-at-item-p))
- (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1))
+ (if (listp current-prefix-arg) (setq current-prefix-arg 1))
(org-mark-element))
(if (org-region-active-p)
@@ -19537,10 +20772,9 @@ stars to add."
;; One star will be added by `org-list-to-subtree'.
((org-at-item-p)
(let* ((stars (make-string
- (if nstars
- ;; subtract the star that will be added again by
- ;; `org-list-to-subtree'
- (1- (prefix-numeric-value current-prefix-arg))
+ ;; subtract the star that will be added again by
+ ;; `org-list-to-subtree'
+ (if (numberp nstars) (1- nstars)
(or (org-current-level) 0))
?*))
(add-stars
@@ -19558,42 +20792,47 @@ stars to add."
(insert
(org-list-to-subtree
(org-list-parse-list t)
- '(:istart (concat stars add-stars (funcall get-stars depth))
- :icount (concat stars add-stars (funcall get-stars depth)))))))
+ `(:istart (concat ',stars ',add-stars (funcall get-stars depth))
+ :icount (concat ',stars ',add-stars (funcall get-stars depth)))))))
(setq toggled t))
(forward-line))))
;; Case 3. Started at normal text: make every line an heading,
;; skipping headlines and items.
- (t (let* ((stars (make-string
- (if nstars
- (prefix-numeric-value current-prefix-arg)
- (or (org-current-level) 0))
- ?*))
+ (t (let* ((stars
+ (make-string
+ (if (numberp nstars) nstars (or (org-current-level) 0)) ?*))
(add-stars
(cond (nstars "") ; stars from prefix only
((equal stars "") "*") ; before first heading
(org-odd-levels-only "**") ; inside heading, odd
(t "*"))) ; inside heading, oddeven
- (rpl (concat stars add-stars " ")))
- (while (< (point) end)
+ (rpl (concat stars add-stars " "))
+ (lend (if (listp nstars) (save-excursion (end-of-line) (point)))))
+ (while (< (point) (if (equal nstars '(4)) lend end))
(when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
(replace-match (concat rpl (match-string 2))) (setq toggled t))
(forward-line)))))))
(unless toggled (message "Cannot toggle heading from here"))))
-(defun org-meta-return (&optional arg)
+(defun org-meta-return (&optional _arg)
"Insert a new heading or wrap a region in a table.
-Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
-See the individual commands for more information."
- (interactive "P")
- (cond
- ((run-hook-with-args-until-success 'org-metareturn-hook))
- ((or (org-at-drawer-p) (org-at-property-p))
- (newline-and-indent))
- ((org-at-table-p)
- (call-interactively 'org-table-wrap-region))
- (t (call-interactively 'org-insert-heading))))
+Calls `org-insert-heading' or `org-table-wrap-region', depending
+on context. See the individual commands for more information."
+ (interactive)
+ (org-check-before-invisible-edit 'insert)
+ (or (run-hook-with-args-until-success 'org-metareturn-hook)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (when (eq type 'table-row)
+ (setq element (org-element-property :parent element))
+ (setq type 'table))
+ (if (and (eq type 'table)
+ (eq (org-element-property :type element) 'org)
+ (>= (point) (org-element-property :contents-begin element))
+ (< (point) (org-element-property :contents-end element)))
+ (call-interactively 'org-table-wrap-region)
+ (call-interactively 'org-insert-heading)))))
;;; Menu entries
@@ -19715,7 +20954,7 @@ See the individual commands for more information."
("Archive"
["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)]
"--"
- ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)]
+ ["Move Subtree to Archive file" org-archive-subtree (org-in-subtree-not-table-p)]
["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)]
["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)]
)
@@ -19826,7 +21065,7 @@ See the individual commands for more information."
["Timeline" org-timeline t]
["Tags/Property tree" org-match-sparse-tree t])
"--"
- ["Export/Publish..." org-export t]
+ ["Export/Publish..." org-export-dispatch t]
("LaTeX"
["Org CDLaTeX mode" org-cdlatex-mode :style toggle
:selected org-cdlatex-mode]
@@ -19836,8 +21075,7 @@ See the individual commands for more information."
(org-inside-LaTeX-fragment-p)]
["Insert citation" org-reftex-citation t]
"--"
- ["Template for BEAMER" (progn (require 'org-beamer)
- (org-insert-beamer-options-template)) t])
+ ["Template for BEAMER" (org-beamer-insert-options-template) t])
"--"
("MobileOrg"
["Push Files and Views" org-mobile-push t]
@@ -19879,6 +21117,7 @@ output buffer into your mail program, as it gives us important
information about your Org-mode version and configuration."
(interactive)
(require 'reporter)
+ (defvar reporter-prompt-for-summary-p)
(org-load-modules-maybe)
(org-require-autoloaded-modules)
(let ((reporter-prompt-for-summary-p "Bug report subject: "))
@@ -19952,55 +21191,63 @@ Your bug report will be posted to the Org-mode mailing list.
(defun org-require-autoloaded-modules ()
(interactive)
(mapc 'require
- '(org-agenda org-archive org-ascii org-attach org-clock org-colview
- org-docbook org-exp org-html org-icalendar
- org-id org-latex
- org-publish org-remember org-table
- org-timer org-xoxo)))
+ '(org-agenda org-archive org-attach org-clock org-colview org-id
+ org-table org-timer)))
;;;###autoload
(defun org-reload (&optional uncompiled)
"Reload all org lisp files.
With prefix arg UNCOMPILED, load the uncompiled versions."
(interactive "P")
- (require 'find-func)
- (let* ((file-re "^org\\(-.*\\)?\\.el")
- (dir-org (file-name-directory (org-find-library-dir "org")))
- (dir-org-contrib (ignore-errors
- (file-name-directory
- (org-find-library-dir "org-contribdir"))))
- (babel-files
- (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el"))
- (append (list nil "comint" "eval" "exp" "keys"
- "lob" "ref" "table" "tangle")
- (delq nil
- (mapcar
- (lambda (lang)
- (when (cdr lang) (symbol-name (car lang))))
- org-babel-load-languages)))))
- (files
- (append babel-files
- (and dir-org-contrib
- (directory-files dir-org-contrib t file-re))
- (directory-files dir-org t file-re)))
- (remove-re (concat (if (featurep 'xemacs)
- "org-colview" "org-colview-xemacs")
- "\\'")))
- (setq files (mapcar 'file-name-sans-extension files))
- (setq files (mapcar
- (lambda (x) (if (string-match remove-re x) nil x))
- files))
- (setq files (delq nil files))
- (mapc
- (lambda (f)
- (when (featurep (intern (file-name-nondirectory f)))
- (if (and (not uncompiled)
- (file-exists-p (concat f ".elc")))
- (load (concat f ".elc") nil nil 'nosuffix)
- (load (concat f ".el") nil nil 'nosuffix))))
- files)
- (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix))
- (org-version nil 'full 'message))
+ (require 'loadhist)
+ (let* ((org-dir (org-find-library-dir "org"))
+ (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
+ (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
+ (remove-re (mapconcat 'identity
+ (mapcar (lambda (f) (concat "^" f "$"))
+ (list (if (featurep 'xemacs)
+ "org-colview"
+ "org-colview-xemacs")
+ "org" "org-loaddefs" "org-version"))
+ "\\|"))
+ (feats (delete-dups
+ (mapcar 'file-name-sans-extension
+ (mapcar 'file-name-nondirectory
+ (delq nil
+ (mapcar 'feature-file
+ features))))))
+ (lfeat (append
+ (sort
+ (setq feats
+ (delq nil (mapcar
+ (lambda (f)
+ (if (and (string-match feature-re f)
+ (not (string-match remove-re f)))
+ f nil))
+ feats)))
+ 'string-lessp)
+ (list "org-version" "org")))
+ (load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes))
+ load-uncore load-misses)
+ (setq load-misses
+ (delq 't
+ (mapcar (lambda (f)
+ (or (org-load-noerror-mustsuffix (concat org-dir f))
+ (and (string= org-dir contrib-dir)
+ (org-load-noerror-mustsuffix (concat contrib-dir f)))
+ (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f))
+ (add-to-list 'load-uncore f 'append)
+ 't)
+ f))
+ lfeat)))
+ (if load-uncore
+ (message "The following feature%s found in load-path, please check if that's correct:\n%s"
+ (if (> (length load-uncore) 1) "s were" " was") load-uncore))
+ (if load-misses
+ (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
+ (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
+ (message "Successfully reloaded Org\n%s" (org-version nil 'full)))))
;;;###autoload
(defun org-customize ()
@@ -20088,7 +21335,10 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(defun org-in-verbatim-emphasis ()
(save-match-data
- (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~")))))
+ (and (org-in-regexp org-emph-re 2)
+ (>= (point) (match-beginning 3))
+ (<= (point) (match-end 4))
+ (member (match-string 3) '("=" "~")))))
(defun org-goto-marker-or-bmk (marker &optional bookmark)
"Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
@@ -20127,11 +21377,13 @@ upon the next fontification round."
'invisible 'org-link s))
(setq s (concat (substring s 0 b)
(substring s (or (next-single-property-change
- b 'invisible s) (length s)))))))
+ b 'invisible s)
+ (length s)))))))
(while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
(setq s (concat (substring s 0 b)
(substring s (or (next-single-property-change
- b 'org-cwidth s) (length s))))))
+ b 'org-cwidth s)
+ (length s))))))
(setq l (string-width s) b -1)
(while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
(setq l (- l (get-text-property b 'org-dwidth-n s))))
@@ -20228,11 +21480,9 @@ N may optionally be the number of spaces to remove."
(defun org-fill-template (template alist)
"Find each %key of ALIST in TEMPLATE and replace it."
- (let ((case-fold-search nil)
- entry key value)
- (setq alist (sort (copy-sequence alist)
- (lambda (a b) (< (length (car a)) (length (car b))))))
- (while (setq entry (pop alist))
+ (let ((case-fold-search nil))
+ (dolist (entry (sort (copy-sequence alist)
+ (lambda (a b) (< (length (car a)) (length (car b))))))
(setq template
(replace-regexp-in-string
(concat "%" (regexp-quote (car entry)))
@@ -20543,23 +21793,35 @@ block from point."
names))
nil)))
-(defun org-occur-in-agenda-files (regexp &optional nlines)
+(defun org-in-drawer-p ()
+ "Is point within a drawer?"
+ (save-match-data
+ (let ((case-fold-search t)
+ (lim-up (save-excursion (outline-previous-heading)))
+ (lim-down (save-excursion (outline-next-heading))))
+ (org-between-regexps-p
+ (concat "^[ \t]*:" (regexp-opt org-drawers) ":")
+ "^[ \t]*:end:.*$"
+ lim-up lim-down))))
+
+(defun org-occur-in-agenda-files (regexp &optional _nlines)
"Call `multi-occur' with buffers for all agenda files."
- (interactive "sOrg-files matching: \np")
+ (interactive "sOrg-files matching: ")
(let* ((files (org-agenda-files))
- (tnames (mapcar 'file-truename files))
- (extra org-agenda-text-search-extra-files)
- f)
+ (tnames (mapcar #'file-truename files))
+ (extra org-agenda-text-search-extra-files))
(when (eq (car extra) 'agenda-archives)
(setq extra (cdr extra))
(setq files (org-add-archive-files files)))
- (while (setq f (pop extra))
+ (dolist (f extra)
(unless (member (file-truename f) tnames)
- (add-to-list 'files f 'append)
- (add-to-list 'tnames (file-truename f) 'append)))
+ (unless (member f files) (setq files (append files (list f))))
+ (setq tnames (append tnames (list (file-truename f))))))
(multi-occur
(mapcar (lambda (x)
(with-current-buffer
+ ;; FIXME: Why not just (find-file-noselect x)?
+ ;; Is it to avoid the "revert buffer" prompt?
(or (get-file-buffer x) (find-file-noselect x))
(widen)
(current-buffer)))
@@ -20598,11 +21860,34 @@ for the search purpose."
(error "Unable to create a link to here"))))
(org-occur-in-agenda-files (regexp-quote link))))
-(defun org-uniquify (list)
- "Remove duplicate elements from LIST."
- (let (res)
- (mapc (lambda (x) (add-to-list 'res x 'append)) list)
- res))
+(defun org-reverse-string (string)
+ "Return the reverse of STRING."
+ (apply 'string (reverse (string-to-list string))))
+
+;; defsubst org-uniquify must be defined before first use
+
+(defun org-uniquify-alist (alist)
+ "Merge elements of ALIST with the same key.
+
+For example, in this alist:
+
+\(org-uniquify-alist \\='((a 1) (b 2) (a 3)))
+ => \\='((a 1 3) (b 2))
+
+merge (a 1) and (a 3) into (a 1 3).
+
+The function returns the new ALIST."
+ (let (rtn)
+ (mapc
+ (lambda (e)
+ (let (n)
+ (if (not (assoc (car e) rtn))
+ (push e rtn)
+ (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
+ (setq rtn (assq-delete-all (car e) rtn))
+ (push n rtn))))
+ alist)
+ rtn))
(defun org-delete-all (elts list)
"Remove all elements in ELTS from LIST."
@@ -20649,6 +21934,20 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but
(setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
cl-accum))
+(defun org-every (pred seq)
+ "Return true if PREDICATE is true of every element of SEQ.
+Adapted from `every' in cl.el."
+ (catch 'org-every
+ (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq)
+ t))
+
+(defun org-some (pred seq)
+ "Return true if PREDICATE is true of any element of SEQ.
+Adapted from `some' in cl.el."
+ (catch 'org-some
+ (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq)
+ nil))
+
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
@@ -20707,7 +22006,7 @@ so values can contain further %-escapes if they are define later in TABLE."
(case-fold-search nil)
(pchg 0)
e re rpl)
- (while (setq e (pop tbl))
+ (dolist (e tbl)
(setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
(when (and (cdr e) (string-match re (cdr e)))
(let ((sref (substring (cdr e) (match-beginning 0) (match-end 0)))
@@ -20764,21 +22063,32 @@ If EXTENSIONS is given, only match these."
(save-match-data
(string-match (org-image-file-name-regexp extensions) file)))
-(defun org-get-cursor-date ()
+(defun org-get-cursor-date (&optional with-time)
"Return the date at cursor in as a time.
This works in the calendar and in the agenda, anywhere else it just
-returns the current time."
- (let (date day defd)
+returns the current time.
+If WITH-TIME is non-nil, returns the time of the event at point (in
+the agenda) or the current time of the day."
+ (let (date day defd tp hod mod)
+ (when with-time
+ (setq tp (get-text-property (point) 'time))
+ (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp))
+ (setq hod (string-to-number (match-string 1 tp))
+ mod (string-to-number (match-string 2 tp))))
+ (or tp (let ((now (decode-time)))
+ (setq hod (nth 2 now)
+ mod (nth 1 now)))))
(cond
((eq major-mode 'calendar-mode)
(setq date (calendar-cursor-to-date)
- defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
+ defd (encode-time 0 (or mod 0) (or hod 0)
+ (nth 1 date) (nth 0 date) (nth 2 date))))
((eq major-mode 'org-agenda-mode)
(setq day (get-text-property (point) 'day))
(if day
(setq date (calendar-gregorian-from-absolute day)
- defd (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))))
+ defd (encode-time 0 (or mod 0) (or hod 0)
+ (nth 1 date) (nth 0 date) (nth 2 date))))))
(or defd (current-time))))
(defun org-mark-subtree (&optional up)
@@ -20789,13 +22099,14 @@ hierarchy of headlines by UP levels before marking the subtree."
(interactive "P")
(org-with-limited-levels
(cond ((org-at-heading-p) (beginning-of-line))
- ((org-before-first-heading-p) (error "Not in a subtree"))
+ ((org-before-first-heading-p) (user-error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
(when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
(if (org-called-interactively-p 'any)
(call-interactively 'org-mark-element)
(org-mark-element)))
+
;;; Indentation
(defun org-indent-line ()
@@ -20817,8 +22128,6 @@ hierarchy of headlines by UP levels before marking the subtree."
(cond
;; Headings
((looking-at org-outline-regexp) (setq column 0))
- ;; Included files
- ((looking-at "#\\+include:") (setq column 0))
;; Footnote definition
((looking-at org-footnote-definition-re) (setq column 0))
;; Literal examples
@@ -20874,15 +22183,16 @@ hierarchy of headlines by UP levels before marking the subtree."
(re-search-backward "[ \t]*#\\+begin_"nil t))
(looking-at "[ \t]*[\n:#|]")
(looking-at org-footnote-definition-re)
- (and (ignore-errors (goto-char (org-in-item-p)))
- (goto-char
- (org-list-get-top-point (org-list-struct))))
(and (not inline-task-p)
(featurep 'org-inlinetask)
(org-inlinetask-in-task-p)
(or (org-inlinetask-goto-beginning) t))))
(beginning-of-line 0))
(cond
+ ;; There was a list item above.
+ ((ignore-errors (goto-char (org-in-item-p)))
+ (goto-char (org-list-get-top-point (org-list-struct)))
+ (setq column (org-get-indentation)))
;; There was an heading above.
((looking-at "\\*+[ \t]+")
(if (not org-adapt-indentation)
@@ -20903,11 +22213,10 @@ hierarchy of headlines by UP levels before marking the subtree."
;; Special polishing for properties, see `org-property-format'
(setq column (current-column))
(beginning-of-line 1)
- (if (looking-at
- "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
- (replace-match (concat (match-string 1)
+ (if (looking-at org-property-re)
+ (replace-match (concat (match-string 4)
(format org-property-format
- (match-string 2) (match-string 3)))
+ (match-string 1) (match-string 3)))
t t))
(org-move-to-column column))))
@@ -20959,7 +22268,7 @@ hierarchy of headlines by UP levels before marking the subtree."
(let ((line-end (org-current-line end)))
(goto-char start)
(while (< (org-current-line) line-end)
- (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe))
+ (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe))
(t (call-interactively 'org-indent-line)))
(move-beginning-of-line 2)))))
@@ -20980,102 +22289,115 @@ hierarchy of headlines by UP levels before marking the subtree."
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
+(defvar org-element-paragraph-separate) ; org-element.el
(defun org-setup-filling ()
- (interactive)
+ (require 'org-element)
;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate)
(org-set-local
'fill-nobreak-predicate
(org-uniquify
(append fill-nobreak-predicate
- '(org-fill-paragraph-separate-nobreak-p
- org-fill-line-break-nobreak-p
+ '(org-fill-line-break-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
+ (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
+ (org-set-local 'paragraph-start paragraph-ending)
+ (org-set-local 'paragraph-separate paragraph-ending))
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
(org-set-local 'auto-fill-inhibit-regexp nil)
(org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
(org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'comment-line-break-function 'org-comment-line-break-function))
-(defvar org-element-paragraph-separate) ; org-element.el
-(defun org-fill-paragraph-separate-nobreak-p ()
- "Non-nil when a line break at point would insert a new item."
- (looking-at (substring org-element-paragraph-separate 1)))
-
(defun org-fill-line-break-nobreak-p ()
- "Non-nil when a line break at point would create an Org line break."
+ "Non-nil when a new line at point would create an Org line break."
(save-excursion
(skip-chars-backward "[ \t]")
(skip-chars-backward "\\\\")
(looking-at "\\\\\\\\\\($\\|[^\\\\]\\)")))
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
- "Non-nil when a line break at point would insert a new item."
+ "Non-nil when a new line at point would split a timestamp."
(and (org-at-timestamp-p t)
(not (looking-at org-ts-regexp-both))))
(declare-function message-in-body-p "message" ())
-(defvar org-element--affiliated-re) ; From org-element.el
(defvar orgtbl-line-start-regexp) ; From org-table.el
(defun org-adaptive-fill-function ()
"Compute a fill prefix for the current line.
Return fill prefix, as a string, or nil if current line isn't
-meant to be filled."
- (let (prefix)
- (catch 'exit
- (when (derived-mode-p 'message-mode)
- (save-excursion
- (beginning-of-line)
- (cond ((or (not (message-in-body-p))
- (looking-at orgtbl-line-start-regexp))
- (throw 'exit nil))
- ((looking-at message-cite-prefix-regexp)
- (throw 'exit (match-string-no-properties 0)))
- ((looking-at org-outline-regexp)
- (throw 'exit (make-string (length (match-string 0)) ? ))))))
- (org-with-wide-buffer
- (let* ((p (line-beginning-position))
- (element (save-excursion (beginning-of-line) (org-element-at-point)))
- (type (org-element-type element))
- (post-affiliated
- (save-excursion
- (goto-char (org-element-property :begin element))
- (while (looking-at org-element--affiliated-re) (forward-line))
- (point))))
- (unless (< p post-affiliated)
- (case type
- (comment (looking-at "[ \t]*# ?") (match-string 0))
- (footnote-definition "")
- ((item plain-list)
- (make-string (org-list-item-body-column post-affiliated) ? ))
- (paragraph
- ;; Fill prefix is usually the same as the current line,
- ;; except if the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
+meant to be filled. For convenience, if `adaptive-fill-regexp'
+matches in paragraphs or comments, use it."
+ (catch 'exit
+ (when (derived-mode-p 'message-mode)
+ (save-excursion
+ (beginning-of-line)
+ (cond ((or (not (message-in-body-p))
+ (looking-at orgtbl-line-start-regexp))
+ (throw 'exit nil))
+ ((looking-at message-cite-prefix-regexp)
+ (throw 'exit (match-string-no-properties 0)))
+ ((looking-at org-outline-regexp)
+ (throw 'exit (make-string (length (match-string 0)) ? ))))))
+ (org-with-wide-buffer
+ (let* ((p (line-beginning-position))
+ (element (save-excursion
+ (beginning-of-line)
+ (or (ignore-errors (org-element-at-point))
+ (user-error "An element cannot be parsed line %d"
+ (line-number-at-pos (point))))))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (unless (and post-affiliated (< p post-affiliated))
+ (case type
+ (comment
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*")
+ (concat (match-string 0) "# ")))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column
+ (or post-affiliated
+ (org-element-property :begin element)))
+ ? ))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; unless the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (save-excursion
+ (beginning-of-line)
(cond ((eq (org-element-type parent) 'item)
(make-string (org-list-item-body-column
(org-element-property :begin parent))
? ))
- ((save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0))
- (t ""))))
- (comment-block
- ;; Only fill contents if P is within block boundaries.
- (let* ((cbeg (save-excursion (goto-char post-affiliated)
- (forward-line)
- (point)))
- (cend (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0)
- "")))))))))))
+ ((and adaptive-fill-regexp
+ ;; Locally disable
+ ;; `adaptive-fill-function' to let
+ ;; `fill-context-prefix' handle
+ ;; `adaptive-fill-regexp' variable.
+ (let (adaptive-fill-function)
+ (fill-context-prefix
+ post-affiliated
+ (org-element-property :end element)))))
+ ((looking-at "[ \t]+") (match-string 0))
+ (t "")))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ ""))))))))))
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
-(defvar org-element-all-objects) ; From org-element.el
(defun org-fill-paragraph (&optional justify)
"Fill element at point, when applicable.
@@ -21104,94 +22426,120 @@ a footnote definition, try to fill the first paragraph within."
(paragraph-separate
(cadadr (assoc 'paragraph-separate org-fb-vars))))
(fill-paragraph nil))
- (save-excursion
+ (with-syntax-table org-mode-transpose-word-syntax-table
;; Move to end of line in order to get the first paragraph
;; within a plain list or a footnote definition.
- (end-of-line)
- (let ((element (org-element-at-point)))
+ (let ((element (save-excursion
+ (end-of-line)
+ (or (ignore-errors (org-element-at-point))
+ (user-error "An element cannot be parsed line %d"
+ (line-number-at-pos (point)))))))
;; First check if point is in a blank line at the beginning of
;; the buffer. In that case, ignore filling.
- (if (< (point) (org-element-property :begin element)) t
- (case (org-element-type element)
- ;; Use major mode filling function is src blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
- ;; Align Org tables, leave table.el tables as-is.
- (table-row (org-table-align) t)
- (table
- (when (eq (org-element-property :type element) 'org)
- (org-table-align))
- t)
- (paragraph
- ;; Paragraphs may contain `line-break' type objects.
- (let ((beg (max (point-min)
- (org-element-property :contents-begin element)))
- (end (min (point-max)
- (org-element-property :contents-end element))))
- ;; Do nothing if point is at an affiliated keyword.
- (if (< (point) beg) t
- (when (derived-mode-p 'message-mode)
- ;; In `message-mode', do not fill following
- ;; citation in current paragraph nor text before
- ;; message body.
- (let ((body-start (save-excursion (message-goto-body))))
- (when body-start (setq beg (max body-start beg))))
- (when (save-excursion
- (re-search-forward
- (concat "^" message-cite-prefix-regexp) end t))
- (setq end (match-beginning 0))))
- ;; Fill paragraph, taking line breaks into
- ;; consideration. For that, slice the paragraph
- ;; using line breaks as separators, and fill the
- ;; parts in reverse order to avoid messing with
- ;; markers.
- (save-excursion
- (goto-char end)
- (mapc
- (lambda (pos)
- (fill-region-as-paragraph pos (point) justify)
- (goto-char pos))
- ;; Find the list of ending positions for line
- ;; breaks in the current paragraph. Add paragraph
- ;; beginning to include first slice.
- (nreverse
- (cons
- beg
- (org-element-map
- (org-element--parse-objects
- beg end nil org-element-all-objects)
- 'line-break
- (lambda (lb) (org-element-property :end lb)))))))
- t)))
- ;; Contents of `comment-block' type elements should be
- ;; filled as plain text, but only if point is within block
- ;; markers.
- (comment-block
- (let* ((case-fold-search t)
- (beg (save-excursion
- (goto-char (org-element-property :begin element))
- (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
- (forward-line)
- (point)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (re-search-backward "^[ \t]*#\\+end_comment" nil t)
- (line-beginning-position))))
- (when (and (>= (point) beg) (< (point) end))
- (fill-region-as-paragraph
- (save-excursion
- (end-of-line)
- (re-search-backward "^[ \t]*$" beg 'move)
- (line-beginning-position))
- (save-excursion
- (beginning-of-line)
- (re-search-forward "^[ \t]*$" end 'move)
- (line-beginning-position))
- justify)))
- t)
- ;; Fill comments.
- (comment (fill-comment-paragraph justify))
- ;; Ignore every other element.
- (otherwise t)))))))
+ (case (org-element-type element)
+ ;; Use major mode filling function is src blocks.
+ (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (org-table-align)))
+ t)
+ (paragraph
+ ;; Paragraphs may contain `line-break' type objects.
+ (let ((beg (max (point-min)
+ (org-element-property :contents-begin element)))
+ (end (min (point-max)
+ (org-element-property :contents-end element))))
+ ;; Do nothing if point is at an affiliated keyword.
+ (if (< (line-end-position) beg) t
+ (when (derived-mode-p 'message-mode)
+ ;; In `message-mode', do not fill following citation
+ ;; in current paragraph nor text before message body.
+ (let ((body-start (save-excursion (message-goto-body))))
+ (when body-start (setq beg (max body-start beg))))
+ (when (save-excursion
+ (re-search-forward
+ (concat "^" message-cite-prefix-regexp) end t))
+ (setq end (match-beginning 0))))
+ ;; Fill paragraph, taking line breaks into account.
+ ;; For that, slice the paragraph using line breaks as
+ ;; separators, and fill the parts in reverse order to
+ ;; avoid messing with markers.
+ (save-excursion
+ (goto-char end)
+ (mapc
+ (lambda (pos)
+ (fill-region-as-paragraph pos (point) justify)
+ (goto-char pos))
+ ;; Find the list of ending positions for line breaks
+ ;; in the current paragraph. Add paragraph
+ ;; beginning to include first slice.
+ (nreverse
+ (cons beg
+ (org-element-map
+ (org-element--parse-objects
+ beg end nil (org-element-restriction 'paragraph))
+ 'line-break
+ (lambda (lb) (org-element-property :end lb)))))))
+ t)))
+ ;; Contents of `comment-block' type elements should be
+ ;; filled as plain text, but only if point is within block
+ ;; markers.
+ (comment-block
+ (let* ((case-fold-search t)
+ (beg (save-excursion
+ (goto-char (org-element-property :begin element))
+ (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
+ (forward-line)
+ (point)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (re-search-backward "^[ \t]*#\\+end_comment" nil t)
+ (line-beginning-position))))
+ (if (or (< (point) beg) (> (point) end)) t
+ (fill-region-as-paragraph
+ (save-excursion (end-of-line)
+ (re-search-backward "^[ \t]*$" beg 'move)
+ (line-beginning-position))
+ (save-excursion (beginning-of-line)
+ (re-search-forward "^[ \t]*$" end 'move)
+ (line-beginning-position))
+ justify))))
+ ;; Fill comments.
+ (comment
+ (let ((begin (org-element-property :post-affiliated element))
+ (end (org-element-property :end element)))
+ (when (and (>= (point) begin) (<= (point) end))
+ (let ((begin (save-excursion
+ (end-of-line)
+ (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
+ (progn (forward-line) (point))
+ begin)))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
+ (1- (line-beginning-position))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))))
+ ;; Do not fill comments when at a blank line.
+ (when (> end begin)
+ (let ((fill-prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#")
+ (let ((comment-prefix (match-string 0)))
+ (goto-char (match-end 0))
+ (if (looking-at adaptive-fill-regexp)
+ (concat comment-prefix (match-string 0))
+ (concat comment-prefix " "))))))
+ (save-excursion
+ (fill-region-as-paragraph begin end justify))))))
+ t))
+ ;; Ignore every other element.
+ (otherwise t))))))
(defun org-auto-fill-function ()
"Auto-fill function."
@@ -21252,7 +22600,7 @@ If the line is empty, insert comment at its beginning."
(insert "# "))
(defvar comment-empty-lines) ; From newcomment.el.
-(defun org-comment-or-uncomment-region (beg end &rest ignore)
+(defun org-comment-or-uncomment-region (beg end &rest _)
"Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only
contains commented lines. Otherwise, comment them."
@@ -21298,11 +22646,102 @@ contains commented lines. Otherwise, comment them."
(goto-char (point-min))
(while (not (eobp))
(unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
- (org-move-to-column min-indent t)
+ ;; Don't get fooled by invisible text (e.g. link path)
+ ;; when moving to column MIN-INDENT.
+ (let ((buffer-invisibility-spec nil))
+ (org-move-to-column min-indent t))
(insert comment-start))
(forward-line))))))))
+;;; Planning
+
+;; This section contains tools to operate on timestamp objects, as
+;; returned by, e.g. `org-element-context'.
+
+(defun org-timestamp-has-time-p (timestamp)
+ "Non-nil when TIMESTAMP has a time specified."
+ (org-element-property :hour-start timestamp))
+
+(defun org-timestamp-format (timestamp format &optional end utc)
+ "Format a TIMESTAMP element into a string.
+
+FORMAT is a format specifier to be passed to
+`format-time-string'.
+
+When optional argument END is non-nil, use end of date-range or
+time-range, if possible.
+
+When optional argument UTC is non-nil, time will be expressed as
+Universal Time."
+ (format-time-string
+ format
+ (apply 'encode-time
+ (cons 0
+ (mapcar
+ (lambda (prop) (or (org-element-property prop timestamp) 0))
+ (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+ '(:minute-start :hour-start :day-start :month-start
+ :year-start)))))
+ utc))
+
+(defun org-timestamp-split-range (timestamp &optional end)
+ "Extract a timestamp object from a date or time range.
+
+TIMESTAMP is a timestamp object. END, when non-nil, means extract
+the end of the range. Otherwise, extract its start.
+
+Return a new timestamp object sharing the same parent as
+TIMESTAMP."
+ (let ((type (org-element-property :type timestamp)))
+ (if (memq type '(active inactive diary)) timestamp
+ (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp)))))
+ ;; Set new type.
+ (org-element-put-property
+ split-ts :type (if (eq type 'active-range) 'active 'inactive))
+ ;; Copy start properties over end properties if END is
+ ;; non-nil. Otherwise, copy end properties over `start' ones.
+ (let ((p-alist '((:minute-start . :minute-end)
+ (:hour-start . :hour-end)
+ (:day-start . :day-end)
+ (:month-start . :month-end)
+ (:year-start . :year-end))))
+ (dolist (p-cell p-alist)
+ (org-element-put-property
+ split-ts
+ (funcall (if end 'car 'cdr) p-cell)
+ (org-element-property
+ (funcall (if end 'cdr 'car) p-cell) split-ts)))
+ ;; Eventually refresh `:raw-value'.
+ (org-element-put-property split-ts :raw-value nil)
+ (org-element-put-property
+ split-ts :raw-value (org-element-interpret-data split-ts)))))))
+
+(defun org-timestamp-translate (timestamp &optional boundary)
+ "Apply `org-translate-time' on a TIMESTAMP object.
+When optional argument BOUNDARY is non-nil, it is either the
+symbol `start' or `end'. In this case, only translate the
+starting or ending part of TIMESTAMP if it is a date or time
+range. Otherwise, translate both parts."
+ (if (and (not boundary)
+ (memq (org-element-property :type timestamp)
+ '(active-range inactive-range)))
+ (concat
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-timestamp-split-range timestamp)))
+ "--"
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-timestamp-split-range timestamp t))))
+ (org-translate-time
+ (org-element-property
+ :raw-value
+ (if (not boundary) timestamp
+ (org-timestamp-split-range timestamp (eq boundary 'end)))))))
+
+
+
;;; Other stuff.
(defun org-toggle-fixed-width-section (arg)
@@ -21353,6 +22792,10 @@ this line is also exported in fixed-width font."
(goto-char (match-end 0))
(insert org-quote-string " ")))))))
+(defvar reftex-docstruct-symbol)
+(defvar reftex-cite-format)
+(defvar org--rds)
+
(defun org-reftex-citation ()
"Use reftex-citation to insert a citation into the buffer.
This looks for a line like
@@ -21365,11 +22808,11 @@ to work in this buffer and calls `reftex-citation' to insert a citation
into the buffer.
Export of such citations to both LaTeX and HTML is handled by the contributed
-package org-exp-bibtex by Taru Karttunen."
+package ox-bibtex by Taru Karttunen."
(interactive)
- (let ((reftex-docstruct-symbol 'rds)
+ (let ((reftex-docstruct-symbol 'org--rds)
(reftex-cite-format "\\cite{%l}")
- rds bib)
+ org--rds bib)
(save-excursion
(save-restriction
(widen)
@@ -21380,7 +22823,7 @@ package org-exp-bibtex by Taru Karttunen."
(re-search-backward re nil t))))
(error "No bibliography defined in file")
(setq bib (concat (match-string 1) ".bib")
- rds (list (list 'bib bib)))))))
+ org--rds (list (list 'bib bib)))))))
(call-interactively 'reftex-citation)))
;;;; Functions extending outline functionality
@@ -21396,7 +22839,7 @@ beyond the end of the headline."
(special (if (consp org-special-ctrl-a/e)
(car org-special-ctrl-a/e)
org-special-ctrl-a/e))
- refpos)
+ deactivate-mark refpos)
(if (org-bound-and-true-p visual-line-mode)
(beginning-of-visual-line 1)
(beginning-of-line 1))
@@ -21448,7 +22891,10 @@ beyond the end of the headline."
(when (and (= (point) pos) (eq last-command this-command))
(goto-char after-bullet))))))))
(org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(defun org-end-of-line (&optional arg)
"Go to the end of the line.
@@ -21461,7 +22907,8 @@ the cursor is already beyond the end of the headline."
(move-fun (cond ((org-bound-and-true-p visual-line-mode)
'end-of-visual-line)
((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line))))
+ (t 'end-of-line)))
+ deactivate-mark)
(if (or (not special) arg) (call-interactively move-fun)
(let* ((element (save-excursion (beginning-of-line)
(org-element-at-point)))
@@ -21485,25 +22932,28 @@ the cursor is already beyond the end of the headline."
;; after it. Use `end-of-line' to stay on current line.
(call-interactively 'end-of-line))
(t (call-interactively move-fun)))))
- (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
-(defun org-backward-sentence (&optional arg)
+(defun org-backward-sentence (&optional _arg)
"Go to beginning of sentence, or beginning of table field.
This will call `backward-sentence' or `org-table-beginning-of-field',
depending on context."
- (interactive "P")
+ (interactive)
(cond
((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
(t (call-interactively 'backward-sentence))))
-(defun org-forward-sentence (&optional arg)
+(defun org-forward-sentence (&optional _arg)
"Go to end of sentence, or end of table field.
This will call `forward-sentence' or `org-table-end-of-field',
depending on context."
- (interactive "P")
+ (interactive)
(cond
((org-at-table-p) (call-interactively 'org-table-end-of-field))
(t (call-interactively 'forward-sentence))))
@@ -21511,9 +22961,9 @@ depending on context."
(define-key org-mode-map "\M-a" 'org-backward-sentence)
(define-key org-mode-map "\M-e" 'org-forward-sentence)
-(defun org-kill-line (&optional arg)
+(defun org-kill-line (&optional _arg)
"Kill line, to tags or end of line."
- (interactive "P")
+ (interactive)
(cond
((or (not org-special-ctrl-k)
(bolp)
@@ -21522,7 +22972,7 @@ depending on context."
org-ctrl-k-protect-subtree)
(if (or (eq org-ctrl-k-protect-subtree 'error)
(not (y-or-n-p "Kill hidden subtree along with headline? ")))
- (error "C-k aborted - would kill hidden subtree")))
+ (user-error "C-k aborted as it would kill a hidden subtree")))
(call-interactively
(if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
@@ -21555,7 +23005,7 @@ no special treatment. In particular, a simple \\[universal-argument] prefix \
will just
plainly yank the text as it is.
-\[1] The test checks if the first non-white line is a heading
+[1] The test checks if the first non-white line is a heading
and if there are no other headings with fewer stars."
(interactive "P")
(org-yank-generic 'yank arg))
@@ -21741,7 +23191,7 @@ make a significant difference in outlines with very many siblings."
(let ((re org-outline-regexp-bol)
level l)
(unless (org-at-heading-p t)
- (error "Not at a heading"))
+ (user-error "Not at a heading"))
(setq level (funcall outline-level))
(save-excursion
(if (not (re-search-backward re nil t))
@@ -21871,14 +23321,6 @@ If there is no such heading, return nil."
(forward-char -1))))))
(point))
-(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
- "Use Org version in org-mode, for dramatic speed-up."
- (if (derived-mode-p 'org-mode)
- (progn
- (org-end-of-subtree nil t)
- (unless (eobp) (backward-char 1)))
- ad-do-it))
-
(defun org-end-of-meta-data-and-drawers ()
"Jump to the first text after meta data and drawers in the current entry.
This will move over empty lines, lines with planning time stamps,
@@ -21899,77 +23341,248 @@ clocking lines, and drawers."
(point)))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
- "Move forward to the arg'th subheading at same level as this one.
+ "Move forward to the ARG'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading.
Normally this only looks at visible headings, but when INVISIBLE-OK is
non-nil it will also look at invisible ones."
(interactive "p")
- (org-back-to-heading invisible-ok)
- (org-at-heading-p)
- (let* ((level (- (match-end 0) (match-beginning 0) 1))
- (re (format "^\\*\\{1,%d\\} " level))
- l)
- (forward-char 1)
- (while (> arg 0)
- (while (and (re-search-forward re nil 'move)
- (setq l (- (match-end 0) (match-beginning 0) 1))
- (= l level)
- (not invisible-ok)
- (progn (backward-char 1) (outline-invisible-p)))
- (if (< l level) (setq arg 1)))
- (setq arg (1- arg)))
+ (if (not (ignore-errors (org-back-to-heading invisible-ok)))
+ (if (and arg (< arg 0))
+ (goto-char (point-min))
+ (outline-next-heading))
+ (org-at-heading-p)
+ (let ((level (- (match-end 0) (match-beginning 0) 1))
+ (f (if (and arg (< arg 0))
+ 're-search-backward
+ 're-search-forward))
+ (count (if arg (abs arg) 1))
+ (result (point)))
+ (while (and (prog1 (> count 0)
+ (forward-char (if (and arg (< arg 0)) -1 1)))
+ (funcall f org-outline-regexp-bol nil 'move))
+ (let ((l (- (match-end 0) (match-beginning 0) 1)))
+ (cond ((< l level) (setq count 0))
+ ((and (= l level)
+ (or invisible-ok
+ (progn
+ (goto-char (line-beginning-position))
+ (not (outline-invisible-p)))))
+ (setq count (1- count))
+ (when (eq l level)
+ (setq result (point)))))))
+ (goto-char result))
(beginning-of-line 1)))
(defun org-backward-heading-same-level (arg &optional invisible-ok)
- "Move backward to the arg'th subheading at same level as this one.
+ "Move backward to the ARG'th subheading at same level as this one.
Stop at the first and last subheadings of a superior heading."
(interactive "p")
- (org-back-to-heading)
- (org-at-heading-p)
- (let* ((level (- (match-end 0) (match-beginning 0) 1))
- (re (format "^\\*\\{1,%d\\} " level))
- l)
- (while (> arg 0)
- (while (and (re-search-backward re nil 'move)
- (setq l (- (match-end 0) (match-beginning 0) 1))
- (= l level)
- (not invisible-ok)
- (outline-invisible-p))
- (if (< l level) (setq arg 1)))
- (setq arg (1- arg)))))
+ (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok))
+
+(defun org-next-block (arg &optional backward block-regexp)
+ "Jump to the next block.
+With a prefix argument ARG, jump forward ARG many source blocks.
+When BACKWARD is non-nil, jump to the previous block.
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+ (interactive "p")
+ (let ((re (or block-regexp org-block-regexp))
+ (re-search-fn (or (and backward 're-search-backward)
+ 're-search-forward)))
+ (if (looking-at re) (forward-char 1))
+ (condition-case nil
+ (funcall re-search-fn re nil nil arg)
+ (error (error "No %s code blocks" (if backward "previous" "further" ))))
+ (goto-char (match-beginning 0)) (org-show-context)))
+
+(defun org-previous-block (arg &optional block-regexp)
+ "Jump to the previous block.
+With a prefix argument ARG, jump backward ARG many source blocks.
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+ (interactive "p")
+ (org-next-block arg t block-regexp))
+
+(defun org-forward-paragraph ()
+ "Move forward to beginning of next paragraph or equivalent.
+
+The function moves point to the beginning of the next visible
+structural element, which can be a paragraph, a table, a list
+item, etc. It also provides some special moves for convenience:
+
+ - On an affiliated keyword, jump to the beginning of the
+ relative element.
+ - On an item or a footnote definition, move to the second
+ element inside, if any.
+ - On a table or a property drawer, jump after it.
+ - On a verse or source block, stop after blank lines."
+ (interactive)
+ (when (eobp) (user-error "Cannot move further down"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (end (let ((end (org-element-property :end element)) (parent element))
+ (while (and (setq parent (org-element-property :parent parent))
+ (= (org-element-property :contents-end parent) end))
+ (setq end (org-element-property :end parent)))
+ end)))
+ (cond ((not element)
+ (skip-chars-forward " \r\t\n")
+ (or (eobp) (beginning-of-line)))
+ ;; On affiliated keywords, move to element's beginning.
+ ((and post-affiliated (< (point) post-affiliated))
+ (goto-char post-affiliated))
+ ;; At a table row, move to the end of the table. Similarly,
+ ;; at a node property, move to the end of the property
+ ;; drawer.
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :end (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char end))
+ ;; Consider blank lines as separators in verse and source
+ ;; blocks to ease editing.
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-end
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (beginning-of-line)
+ (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
+ (if (not (re-search-forward "^[ \t]*$" contents-end t))
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (if (= (point) contents-end) (goto-char end)
+ (beginning-of-line))))
+ ;; With no contents, just skip element.
+ ((not contents-begin) (goto-char end))
+ ;; If contents are invisible, skip the element altogether.
+ ((outline-invisible-p (line-end-position))
+ (case type
+ (headline
+ (org-with-limited-levels (outline-next-visible-heading 1)))
+ ;; At a plain list, make sure we move to the next item
+ ;; instead of skipping the whole list.
+ (plain-list (forward-char)
+ (org-forward-paragraph))
+ (otherwise (goto-char end))))
+ ((>= (point) contents-end) (goto-char end))
+ ((>= (point) contents-begin)
+ ;; This can only happen on paragraphs and plain lists.
+ (case type
+ (paragraph (goto-char end))
+ ;; At a plain list, try to move to second element in
+ ;; first item, if possible.
+ (plain-list (end-of-line)
+ (org-forward-paragraph))))
+ ;; When contents start on the middle of a line (e.g. in
+ ;; items and footnote definitions), try to reach first
+ ;; element starting after current line.
+ ((> (line-end-position) contents-begin)
+ (end-of-line)
+ (org-forward-paragraph))
+ (t (goto-char contents-begin)))))
+
+(defun org-backward-paragraph ()
+ "Move backward to start of previous paragraph or equivalent.
+
+The function moves point to the beginning of the current
+structural element, which can be a paragraph, a table, a list
+item, etc., or to the beginning of the previous visible one if
+point is already there. It also provides some special moves for
+convenience:
+
+ - On an affiliated keyword, jump to the first one.
+ - On a table or a property drawer, move to its beginning.
+ - On a verse or source block, stop before blank lines."
+ (interactive)
+ (when (bobp) (user-error "Cannot move further up"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((not element) (goto-char (point-min)))
+ ((= (point) begin)
+ (backward-char)
+ (org-backward-paragraph))
+ ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :post-affiliated (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char begin))
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-begin
+ (save-excursion (goto-char begin) (forward-line) (point))))
+ (if (= (point) contents-begin) (goto-char post-affiliated)
+ ;; Inside a verse block, see blank lines as paragraph
+ ;; separators.
+ (let ((origin (point)))
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (when (re-search-backward "^[ \t]*$" contents-begin 'move)
+ (skip-chars-forward " \r\t\n" origin)
+ (if (= (point) origin) (goto-char contents-begin)
+ (beginning-of-line))))))
+ ((not contents-begin) (goto-char (or post-affiliated begin)))
+ ((eq type 'paragraph)
+ (goto-char contents-begin)
+ ;; When at first paragraph in an item or a footnote definition,
+ ;; move directly to beginning of line.
+ (let ((parent-contents
+ (org-element-property
+ :contents-begin (org-element-property :parent element))))
+ (when (and parent-contents (= parent-contents contents-begin))
+ (beginning-of-line))))
+ ;; At the end of a greater element, move to the beginning of the
+ ;; last element within.
+ ((>= (point) contents-end)
+ (goto-char (1- contents-end))
+ (org-backward-paragraph))
+ (t (goto-char (or post-affiliated begin))))
+ ;; Ensure we never leave point invisible.
+ (when (outline-invisible-p (point)) (beginning-of-visual-line))))
(defun org-forward-element ()
"Move forward by one element.
Move to the next element at the same level, when possible."
(interactive)
- (cond ((eobp) (error "Cannot move further down"))
+ (cond ((eobp) (user-error "Cannot move further down"))
((org-with-limited-levels (org-at-heading-p))
(let ((origin (point)))
- (org-forward-heading-same-level 1)
+ (goto-char (org-end-of-subtree nil t))
(unless (org-with-limited-levels (org-at-heading-p))
(goto-char origin)
- (error "Cannot move further down"))))
+ (user-error "Cannot move further down"))))
(t
(let* ((elem (org-element-at-point))
(end (org-element-property :end elem))
(parent (org-element-property :parent elem)))
- (if (and parent (= (org-element-property :contents-end parent) end))
- (goto-char (org-element-property :end parent))
- (goto-char end))))))
+ (cond ((and parent (= (org-element-property :contents-end parent) end))
+ (goto-char (org-element-property :end parent)))
+ ((integer-or-marker-p end) (goto-char end))
+ (t (message "No element at point")))))))
(defun org-backward-element ()
"Move backward by one element.
Move to the previous element at the same level, when possible."
(interactive)
- (cond ((bobp) (error "Cannot move further up"))
+ (cond ((bobp) (user-error "Cannot move further up"))
((org-with-limited-levels (org-at-heading-p))
- ;; At an headline, move to the previous one, if any, or stay
+ ;; At a headline, move to the previous one, if any, or stay
;; here.
(let ((origin (point)))
- (org-backward-heading-same-level 1)
- (unless (org-with-limited-levels (org-at-heading-p))
- (goto-char origin)
- (error "Cannot move further up"))))
+ (org-with-limited-levels (org-backward-heading-same-level 1))
+ ;; When current headline has no sibling above, move to its
+ ;; parent.
+ (when (= (point) origin)
+ (or (org-with-limited-levels (org-up-heading-safe))
+ (progn (goto-char origin)
+ (user-error "Cannot move further up"))))))
(t
(let* ((trail (org-element-at-point 'keep-trail))
(elem (car trail))
@@ -21978,6 +23591,7 @@ Move to the previous element at the same level, when possible."
(cond
;; Move to beginning of current element if point isn't
;; there already.
+ ((null beg) (message "No element at point"))
((/= (point) beg) (goto-char beg))
(prev-elem (goto-char (org-element-property :begin prev-elem)))
((org-before-first-heading-p) (goto-char (point-min)))
@@ -21987,12 +23601,12 @@ Move to the previous element at the same level, when possible."
"Move to upper element."
(interactive)
(if (org-with-limited-levels (org-at-heading-p))
- (unless (org-up-heading-safe) (error "No surrounding element"))
+ (unless (org-up-heading-safe) (user-error "No surrounding element"))
(let* ((elem (org-element-at-point))
(parent (org-element-property :parent elem)))
(if parent (goto-char (org-element-property :begin parent))
(if (org-with-limited-levels (org-before-first-heading-p))
- (error "No surrounding element")
+ (user-error "No surrounding element")
(org-with-limited-levels (org-back-to-heading)))))))
(defvar org-element-greater-elements)
@@ -22008,8 +23622,8 @@ Move to the previous element at the same level, when possible."
;; If contents are hidden, first disclose them.
(when (org-element-property :hiddenp element) (org-cycle))
(goto-char (or (org-element-property :contents-begin element)
- (error "No content for this element"))))
- (t (error "No inner element")))))
+ (user-error "No content for this element"))))
+ (t (user-error "No inner element")))))
(defun org-drag-element-backward ()
"Move backward element at point."
@@ -22021,7 +23635,7 @@ Move to the previous element at the same level, when possible."
;; Error out if no previous element or previous element is
;; a parent of the current one.
(if (or (not prev-elem) (org-element-nested-p elem prev-elem))
- (error "Cannot drag element backward")
+ (user-error "Cannot drag element backward")
(let ((pos (point)))
(org-element-swap-A-B prev-elem elem)
(goto-char (+ (org-element-property :begin prev-elem)
@@ -22033,14 +23647,14 @@ Move to the previous element at the same level, when possible."
(let* ((pos (point))
(elem (org-element-at-point)))
(when (= (point-max) (org-element-property :end elem))
- (error "Cannot drag element forward"))
+ (user-error "Cannot drag element forward"))
(goto-char (org-element-property :end elem))
(let ((next-elem (org-element-at-point)))
(when (or (org-element-nested-p elem next-elem)
(and (eq (org-element-type next-elem) 'headline)
(not (eq (org-element-type elem) 'headline))))
(goto-char pos)
- (error "Cannot drag element forward"))
+ (user-error "Cannot drag element forward"))
;; Compute new position of point: it's shifted by NEXT-ELEM
;; body's length (without final blanks) and by the length of
;; blanks between ELEM and NEXT-ELEM.
@@ -22061,6 +23675,25 @@ Move to the previous element at the same level, when possible."
(org-element-swap-A-B elem next-elem)
(goto-char (+ pos size-next size-blank))))))
+(defun org-drag-line-forward (arg)
+ "Drag the line at point ARG lines forward."
+ (interactive "p")
+ (dotimes (n (abs arg))
+ (let ((c (current-column)))
+ (if (< 0 arg)
+ (progn
+ (beginning-of-line 2)
+ (transpose-lines 1)
+ (beginning-of-line 0))
+ (transpose-lines 1)
+ (beginning-of-line -1))
+ (org-move-to-column c))))
+
+(defun org-drag-line-backward (arg)
+ "Drag the line at point ARG lines backward."
+ (interactive "p")
+ (org-drag-line-forward (- arg)))
+
(defun org-mark-element ()
"Put point at beginning of this element, mark at end.
@@ -22114,7 +23747,7 @@ Relative indentation (between items, inside blocks, etc.) isn't
modified."
(interactive)
(unless (eq major-mode 'org-mode)
- (error "Cannot un-indent a buffer not in Org mode"))
+ (user-error "Cannot un-indent a buffer not in Org mode"))
(let* ((parse-tree (org-element-parse-buffer 'greater-element))
unindent-tree ; For byte-compiler.
(unindent-tree
@@ -22184,8 +23817,7 @@ Show the heading too, if it is currently invisible."
isearch-mode-end-hook-quit)
;; Only when the isearch was not quitted.
(org-add-hook 'post-command-hook 'org-isearch-post-command
- 'append 'local)))
- (org-fix-ellipsis-at-bol)))
+ 'append 'local)))))
(defun org-isearch-post-command ()
"Remove self from hook, and show context."
@@ -22244,8 +23876,8 @@ Show the heading too, if it is currently invisible."
(org-show-context 'org-goto))))))
(defun org-link-display-format (link)
- "Replace a link with either the description, or the link target
-if no description is present"
+ "Replace a link with its the description.
+If there is no description, use the link target."
(save-match-data
(if (string-match org-bracket-link-analytic-regexp link)
(replace-match (if (match-end 5)
@@ -22302,14 +23934,16 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(let ((default-directory dir))
(expand-file-name txt)))
(unless (derived-mode-p 'org-mode)
- (error "Cannot restrict to non-Org-mode file"))
+ (user-error "Cannot restrict to non-Org-mode file"))
(org-agenda-set-restriction-lock 'file)))
- (t (error "Don't know how to restrict Org-mode's agenda")))
+ (t (user-error "Don't know how to restrict Org-mode's agenda")))
(move-overlay org-speedbar-restriction-lock-overlay
(point-at-bol) (point-at-eol))
(setq current-prefix-arg nil)
(org-agenda-maybe-redo)))
+(defvar speedbar-file-key-map)
+(declare-function speedbar-add-supported-extension "speedbar" (extension))
(eval-after-load "speedbar"
'(progn
(speedbar-add-supported-extension ".org")
@@ -22323,9 +23957,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
;;; Fixes and Hacks for problems with other packages
;; Make flyspell not check words in links, to not mess up our keymap
+(defvar org-element-affiliated-keywords) ; From org-element.el
+(defvar org-element-block-name-alist) ; From org-element.el
(defun org-mode-flyspell-verify ()
"Don't let flyspell put overlays at active buttons, or on
{todo,all-time,additional-option-like}-keywords."
+ (require 'org-element) ; For `org-element-affiliated-keywords'
(let ((pos (max (1- (point)) (point-min)))
(word (thing-at-point 'word)))
(and (not (get-text-property pos 'keymap))
@@ -22334,7 +23971,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(not (member word org-all-time-keywords))
(not (member word org-options-keywords))
(not (member word (mapcar 'car org-startup-options)))
- (not (member word org-additional-option-like-keywords-for-flyspell)))))
+ (not (member-ignore-case word org-element-affiliated-keywords))
+ (not (member-ignore-case word (org-get-export-keywords)))
+ (not (member-ignore-case
+ word (mapcar 'car org-element-block-name-alist)))
+ (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
+ (not (org-in-src-block-p)))))
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
@@ -22375,32 +24017,10 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(org-show-context 'bookmark-jump)))
;; Make session.el ignore our circular variable
+(defvar session-globals-exclude)
(eval-after-load "session"
'(add-to-list 'session-globals-exclude 'org-mark-ring))
-;;;; Experimental code
-
-(defun org-closed-in-range ()
- "Sparse tree of items closed in a certain time range.
-Still experimental, may disappear in the future."
- (interactive)
- ;; Get the time interval from the user.
- (let* ((time1 (org-float-time
- (org-read-date nil 'to-time nil "Starting date: ")))
- (time2 (org-float-time
- (org-read-date nil 'to-time nil "End date:")))
- ;; callback function
- (callback (lambda ()
- (let ((time
- (org-float-time
- (apply 'encode-time
- (org-parse-time-string
- (match-string 1))))))
- ;; check if time in interval
- (and (>= time time1) (<= time time2))))))
- ;; make tree, check each match with the callback
- (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback)))
-
;;;; Finish up
(provide 'org)
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
new file mode 100644
index 00000000000..a3284d9b905
--- /dev/null
+++ b/lisp/org/ox-ascii.el
@@ -0,0 +1,1971 @@
+;;; ox-ascii.el --- ASCII Back-End for Org Export Engine
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements an ASCII back-end for Org generic exporter.
+;; See Org manual for more information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+(require 'ox-publish)
+
+(declare-function aa2u "ext:ascii-art-to-unicode" ())
+
+;;; Define Back-End
+;;
+;; The following setting won't allow to modify preferred charset
+;; through a buffer keyword or an option item, but, since the property
+;; will appear in communication channel nonetheless, it allows to
+;; override `org-ascii-charset' variable on the fly by the ext-plist
+;; mechanism.
+;;
+;; We also install a filter for headlines and sections, in order to
+;; control blank lines separating them in output string.
+
+(org-export-define-backend 'ascii
+ '((bold . org-ascii-bold)
+ (center-block . org-ascii-center-block)
+ (clock . org-ascii-clock)
+ (code . org-ascii-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-ascii-drawer)
+ (dynamic-block . org-ascii-dynamic-block)
+ (entity . org-ascii-entity)
+ (example-block . org-ascii-example-block)
+ (export-block . org-ascii-export-block)
+ (export-snippet . org-ascii-export-snippet)
+ (fixed-width . org-ascii-fixed-width)
+ (footnote-reference . org-ascii-footnote-reference)
+ (headline . org-ascii-headline)
+ (horizontal-rule . org-ascii-horizontal-rule)
+ (inline-src-block . org-ascii-inline-src-block)
+ (inlinetask . org-ascii-inlinetask)
+ (inner-template . org-ascii-inner-template)
+ (italic . org-ascii-italic)
+ (item . org-ascii-item)
+ (keyword . org-ascii-keyword)
+ (latex-environment . org-ascii-latex-environment)
+ (latex-fragment . org-ascii-latex-fragment)
+ (line-break . org-ascii-line-break)
+ (link . org-ascii-link)
+ (paragraph . org-ascii-paragraph)
+ (plain-list . org-ascii-plain-list)
+ (plain-text . org-ascii-plain-text)
+ (planning . org-ascii-planning)
+ (quote-block . org-ascii-quote-block)
+ (quote-section . org-ascii-quote-section)
+ (radio-target . org-ascii-radio-target)
+ (section . org-ascii-section)
+ (special-block . org-ascii-special-block)
+ (src-block . org-ascii-src-block)
+ (statistics-cookie . org-ascii-statistics-cookie)
+ (strike-through . org-ascii-strike-through)
+ (subscript . org-ascii-subscript)
+ (superscript . org-ascii-superscript)
+ (table . org-ascii-table)
+ (table-cell . org-ascii-table-cell)
+ (table-row . org-ascii-table-row)
+ (target . org-ascii-target)
+ (template . org-ascii-template)
+ (timestamp . org-ascii-timestamp)
+ (underline . org-ascii-underline)
+ (verbatim . org-ascii-verbatim)
+ (verse-block . org-ascii-verse-block))
+ :export-block "ASCII"
+ :menu-entry
+ '(?t "Export to Plain Text"
+ ((?A "As ASCII buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii))))
+ (?a "As ASCII file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii))))
+ (?L "As Latin1 buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1))))
+ (?l "As Latin1 file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1))))
+ (?U "As UTF-8 buffer"
+ (lambda (a s v b)
+ (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8))))
+ (?u "As UTF-8 file"
+ (lambda (a s v b)
+ (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8))))))
+ :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines)
+ (:filter-parse-tree org-ascii-filter-paragraph-spacing
+ org-ascii-filter-comment-spacing)
+ (:filter-section . org-ascii-filter-headline-blank-lines))
+ :options-alist '((:ascii-charset nil nil org-ascii-charset)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-ascii nil
+ "Options for exporting Org mode files to ASCII."
+ :tag "Org Export ASCII"
+ :group 'org-export)
+
+(defcustom org-ascii-text-width 72
+ "Maximum width of exported text.
+This number includes margin size, as set in
+`org-ascii-global-margin'."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-global-margin 0
+ "Width of the left margin, in number of characters."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-inner-margin 2
+ "Width of the inner margin, in number of characters.
+Inner margin is applied between each headline."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-quote-margin 6
+ "Width of margin used for quoting text, in characters.
+This margin is applied on both sides of the text."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-inlinetask-width 30
+ "Width of inline tasks, in number of characters.
+This number ignores any margin."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+(defcustom org-ascii-headline-spacing '(1 . 2)
+ "Number of blank lines inserted around headlines.
+
+This variable can be set to a cons cell. In that case, its car
+represents the number of blank lines present before headline
+contents whereas its cdr reflects the number of blank lines after
+contents.
+
+A nil value replicates the number of blank lines found in the
+original Org buffer at the same place."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Replicate original spacing" nil)
+ (cons :tag "Set a uniform spacing"
+ (integer :tag "Number of blank lines before contents")
+ (integer :tag "Number of blank lines after contents"))))
+
+(defcustom org-ascii-indented-line-width 'auto
+ "Additional indentation width for the first line in a paragraph.
+If the value is an integer, indent the first line of each
+paragraph by this width, unless it is located at the beginning of
+a section, in which case indentation is removed from that line.
+If it is the symbol `auto' preserve indentation from original
+document."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Number of white spaces characters")
+ (const :tag "Preserve original width" auto)))
+
+(defcustom org-ascii-paragraph-spacing 'auto
+ "Number of white lines between paragraphs.
+If the value is an integer, add this number of blank lines
+between contiguous paragraphs. If is it the symbol `auto', keep
+the same number of blank lines as in the original document."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (integer :tag "Number of blank lines")
+ (const :tag "Preserve original spacing" auto)))
+
+(defcustom org-ascii-charset 'ascii
+ "The charset allowed to represent various elements and objects.
+Possible values are:
+`ascii' Only use plain ASCII characters
+`latin1' Include Latin-1 characters
+`utf-8' Use all UTF-8 characters"
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "ASCII" ascii)
+ (const :tag "Latin-1" latin1)
+ (const :tag "UTF-8" utf-8)))
+
+(defcustom org-ascii-underline '((ascii ?= ?~ ?-)
+ (latin1 ?= ?~ ?-)
+ (utf-8 ?═ ?─ ?╌ ?┄ ?┈))
+ "Characters for underlining headings in ASCII export.
+
+Alist whose key is a symbol among `ascii', `latin1' and `utf-8'
+and whose value is a list of characters.
+
+For each supported charset, this variable associates a sequence
+of underline characters. In a sequence, the characters will be
+used in order for headlines level 1, 2, ... If no character is
+available for a given level, the headline won't be underlined."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(list
+ (cons :tag "Underline characters sequence"
+ (const :tag "ASCII charset" ascii)
+ (repeat character))
+ (cons :tag "Underline characters sequence"
+ (const :tag "Latin-1 charset" latin1)
+ (repeat character))
+ (cons :tag "Underline characters sequence"
+ (const :tag "UTF-8 charset" utf-8)
+ (repeat character))))
+
+(defcustom org-ascii-bullets '((ascii ?* ?+ ?-)
+ (latin1 ?§ ?¶)
+ (utf-8 ?◊))
+ "Bullet characters for headlines converted to lists in ASCII export.
+
+Alist whose key is a symbol among `ascii', `latin1' and `utf-8'
+and whose value is a list of characters.
+
+The first character is used for the first level considered as low
+level, and so on. If there are more levels than characters given
+here, the list will be repeated.
+
+Note that this variable doesn't affect plain lists
+representation."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(list
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "ASCII charset" ascii)
+ (repeat character))
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "Latin-1 charset" latin1)
+ (repeat character))
+ (cons :tag "Bullet characters for low level headlines"
+ (const :tag "UTF-8 charset" utf-8)
+ (repeat character))))
+
+(defcustom org-ascii-links-to-notes t
+ "Non-nil means convert links to notes before the next headline.
+When nil, the link will be exported in place. If the line
+becomes long in this way, it will be wrapped."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-table-keep-all-vertical-lines nil
+ "Non-nil means keep all vertical lines in ASCII tables.
+When nil, vertical lines will be removed except for those needed
+for column grouping."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-table-widen-columns t
+ "Non-nil means widen narrowed columns for export.
+When nil, narrowed columns will look in ASCII export just like in
+Org mode, i.e. with \"=>\" as ellipsis."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-table-use-ascii-art nil
+ "Non-nil means table.el tables are turned into ascii-art.
+
+It only makes sense when export charset is `utf-8'. It is nil by
+default since it requires ascii-art-to-unicode.el package. You
+can download it here:
+
+ http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-caption-above nil
+ "When non-nil, place caption string before the element.
+Otherwise, place it right after it."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-ascii-verbatim-format "`%s'"
+ "Format string used for verbatim text and inline code."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-ascii-format-drawer-function
+ (lambda (name contents width) contents)
+ "Function called to format a drawer in ASCII.
+
+The function must accept three parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+ WIDTH the text width within the drawer.
+
+The function should return either the string to be exported or
+nil to ignore the drawer.
+
+The default value simply returns the value of CONTENTS."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+(defcustom org-ascii-format-inlinetask-function
+ 'org-ascii-format-inlinetask-default
+ "Function called to format an inlinetask in ASCII.
+
+The function must accept nine parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+ WIDTH the width of the inlinetask, as a number.
+ INLINETASK the inlinetask itself.
+ INFO the info channel.
+
+The function should return either the string to be exported or
+nil to ignore the inline task."
+ :group 'org-export-ascii
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'function)
+
+
+
+;;; Internal Functions
+
+;; Internal functions fall into three categories.
+
+;; The first one is about text formatting. The core function is
+;; `org-ascii--current-text-width', which determines the current
+;; text width allowed to a given element. In other words, it helps
+;; keeping each line width within maximum text width defined in
+;; `org-ascii-text-width'. Once this information is known,
+;; `org-ascii--fill-string', `org-ascii--justify-string',
+;; `org-ascii--box-string' and `org-ascii--indent-string' can
+;; operate on a given output string.
+
+;; The second category contains functions handling elements listings,
+;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc'
+;; returns a complete table of contents, `org-ascii--list-listings'
+;; returns a list of referenceable src-block elements, and
+;; `org-ascii--list-tables' does the same for table elements.
+
+;; The third category includes general helper functions.
+;; `org-ascii--build-title' creates the title for a given headline
+;; or inlinetask element. `org-ascii--build-caption' returns the
+;; caption string associated to a table or a src-block.
+;; `org-ascii--describe-links' creates notes about links for
+;; insertion at the end of a section. It uses
+;; `org-ascii--unique-links' to get the list of links to describe.
+;; Eventually, `org-ascii--translate' translates a string according
+;; to language and charset specification.
+
+
+(defun org-ascii--fill-string (s text-width info &optional justify)
+ "Fill a string with specified text-width and return it.
+
+S is the string being filled. TEXT-WIDTH is an integer
+specifying maximum length of a line. INFO is the plist used as
+a communication channel.
+
+Optional argument JUSTIFY can specify any type of justification
+among `left', `center', `right' or `full'. A nil value is
+equivalent to `left'. For a justification that doesn't also fill
+string, see `org-ascii--justify-string'.
+
+Return nil if S isn't a string."
+ (when (stringp s)
+ (let ((double-space-p sentence-end-double-space))
+ (with-temp-buffer
+ (let ((fill-column text-width)
+ (use-hard-newlines t)
+ (sentence-end-double-space double-space-p))
+ (insert (if (plist-get info :preserve-breaks)
+ (replace-regexp-in-string "\n" hard-newline s)
+ s))
+ (fill-region (point-min) (point-max) justify))
+ (buffer-string)))))
+
+(defun org-ascii--justify-string (s text-width how)
+ "Justify string S.
+TEXT-WIDTH is an integer specifying maximum length of a line.
+HOW determines the type of justification: it can be `left',
+`right', `full' or `center'."
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ (let ((fill-column text-width)
+ ;; Disable `adaptive-fill-mode' so it doesn't prevent
+ ;; filling lines matching `adaptive-fill-regexp'.
+ (adaptive-fill-mode nil))
+ (while (< (point) (point-max))
+ (justify-current-line how)
+ (forward-line)))
+ (buffer-string)))
+
+(defun org-ascii--indent-string (s width)
+ "Indent string S by WIDTH white spaces.
+Empty lines are not indented."
+ (when (stringp s)
+ (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" (make-string width ?\s) s nil nil 1)))
+
+(defun org-ascii--box-string (s info)
+ "Return string S with a partial box to its left.
+INFO is a plist used as a communication channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (format (if utf8p "┌────\n%s\n└────" ",----\n%s\n`----")
+ (replace-regexp-in-string
+ "^" (if utf8p "│ " "| ")
+ ;; Remove last newline character.
+ (replace-regexp-in-string "\n[ \t]*\\'" "" s)))))
+
+(defun org-ascii--current-text-width (element info)
+ "Return maximum text width for ELEMENT's contents.
+INFO is a plist used as a communication channel."
+ (case (org-element-type element)
+ ;; Elements with an absolute width: `headline' and `inlinetask'.
+ (inlinetask org-ascii-inlinetask-width)
+ (headline
+ (- org-ascii-text-width
+ (let ((low-level-rank (org-export-low-level-p element info)))
+ (if low-level-rank (* low-level-rank 2) org-ascii-global-margin))))
+ ;; Elements with a relative width: store maximum text width in
+ ;; TOTAL-WIDTH.
+ (otherwise
+ (let* ((genealogy (cons element (org-export-get-genealogy element)))
+ ;; Total width is determined by the presence, or not, of an
+ ;; inline task among ELEMENT parents.
+ (total-width
+ (if (loop for parent in genealogy
+ thereis (eq (org-element-type parent) 'inlinetask))
+ org-ascii-inlinetask-width
+ ;; No inlinetask: Remove global margin from text width.
+ (- org-ascii-text-width
+ org-ascii-global-margin
+ (let ((parent (org-export-get-parent-headline element)))
+ ;; Inner margin doesn't apply to text before first
+ ;; headline.
+ (if (not parent) 0
+ (let ((low-level-rank
+ (org-export-low-level-p parent info)))
+ ;; Inner margin doesn't apply to contents of
+ ;; low level headlines, since they've got their
+ ;; own indentation mechanism.
+ (if low-level-rank (* low-level-rank 2)
+ org-ascii-inner-margin))))))))
+ (- total-width
+ ;; Each `quote-block', `quote-section' and `verse-block' above
+ ;; narrows text width by twice the standard margin size.
+ (+ (* (loop for parent in genealogy
+ when (memq (org-element-type parent)
+ '(quote-block quote-section verse-block))
+ count parent)
+ 2 org-ascii-quote-margin)
+ ;; Text width within a plain-list is restricted by
+ ;; indentation of current item. If that's the case,
+ ;; compute it with the help of `:structure' property from
+ ;; parent item, if any.
+ (let ((parent-item
+ (if (eq (org-element-type element) 'item) element
+ (loop for parent in genealogy
+ when (eq (org-element-type parent) 'item)
+ return parent))))
+ (if (not parent-item) 0
+ ;; Compute indentation offset of the current item,
+ ;; that is the sum of the difference between its
+ ;; indentation and the indentation of the top item in
+ ;; the list and current item bullet's length. Also
+ ;; remove checkbox length, and tag length (for
+ ;; description lists) or bullet length.
+ (let ((struct (org-element-property :structure parent-item))
+ (beg-item (org-element-property :begin parent-item)))
+ (+ (- (org-list-get-ind beg-item struct)
+ (org-list-get-ind
+ (org-list-get-top-point struct) struct))
+ (string-width (or (org-ascii--checkbox parent-item info)
+ ""))
+ (string-width
+ (or (org-list-get-tag beg-item struct)
+ (org-list-get-bullet beg-item struct)))))))))))))
+
+(defun org-ascii--build-title
+ (element info text-width &optional underline notags toc)
+ "Format ELEMENT title and return it.
+
+ELEMENT is either an `headline' or `inlinetask' element. INFO is
+a plist used as a communication channel. TEXT-WIDTH is an
+integer representing the maximum length of a line.
+
+When optional argument UNDERLINE is non-nil, underline title,
+without the tags, according to `org-ascii-underline'
+specifications.
+
+If optional argument NOTAGS is non-nil, no tags will be added to
+the title.
+
+When optional argument TOC is non-nil, use optional title if
+possible. It doesn't apply to `inlinetask' elements."
+ (let* ((headlinep (eq (org-element-type element) 'headline))
+ (numbers
+ ;; Numbering is specific to headlines.
+ (and headlinep (org-export-numbered-headline-p element info)
+ ;; All tests passed: build numbering string.
+ (concat
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number element info) ".")
+ " ")))
+ (text
+ (org-trim
+ (org-export-data
+ (if (and toc headlinep) (org-export-get-alt-title element info)
+ (org-element-property :title element))
+ info)))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword element)))
+ (and todo (concat (org-export-data todo info) " ")))))
+ (tags (and (not notags)
+ (plist-get info :with-tags)
+ (let ((tag-list (org-export-get-tags element info)))
+ (and tag-list
+ (format ":%s:"
+ (mapconcat 'identity tag-list ":"))))))
+ (priority
+ (and (plist-get info :with-priority)
+ (let ((char (org-element-property :priority element)))
+ (and char (format "(#%c) " char)))))
+ (first-part (concat numbers todo priority text)))
+ (concat
+ first-part
+ ;; Align tags, if any.
+ (when tags
+ (format
+ (format " %%%ds"
+ (max (- text-width (1+ (string-width first-part)))
+ (string-width tags)))
+ tags))
+ ;; Maybe underline text, if ELEMENT type is `headline' and an
+ ;; underline character has been defined.
+ (when (and underline headlinep)
+ (let ((under-char
+ (nth (1- (org-export-get-relative-level element info))
+ (cdr (assq (plist-get info :ascii-charset)
+ org-ascii-underline)))))
+ (and under-char
+ (concat "\n"
+ (make-string (/ (string-width first-part)
+ (char-width under-char))
+ under-char))))))))
+
+(defun org-ascii--has-caption-p (element info)
+ "Non-nil when ELEMENT has a caption affiliated keyword.
+INFO is a plist used as a communication channel. This function
+is meant to be used as a predicate for `org-export-get-ordinal'."
+ (org-element-property :caption element))
+
+(defun org-ascii--build-caption (element info)
+ "Return caption string for ELEMENT, if applicable.
+
+INFO is a plist used as a communication channel.
+
+The caption string contains the sequence number of ELEMENT along
+with its real caption. Return nil when ELEMENT has no affiliated
+caption keyword."
+ (let ((caption (org-export-get-caption element)))
+ (when caption
+ ;; Get sequence number of current src-block among every
+ ;; src-block with a caption.
+ (let ((reference
+ (org-export-get-ordinal
+ element info nil 'org-ascii--has-caption-p))
+ (title-fmt (org-ascii--translate
+ (case (org-element-type element)
+ (table "Table %d:")
+ (src-block "Listing %d:"))
+ info)))
+ (org-ascii--fill-string
+ (concat (format title-fmt reference)
+ " "
+ (org-export-data caption info))
+ (org-ascii--current-text-width element info) info)))))
+
+(defun org-ascii--build-toc (info &optional n keyword)
+ "Return a table of contents.
+
+INFO is a plist used as a communication channel.
+
+Optional argument N, when non-nil, is an integer specifying the
+depth of the table.
+
+Optional argument KEYWORD specifies the TOC keyword, if any, from
+which the table of contents generation has been initiated."
+ (let ((title (org-ascii--translate "Table of Contents" info)))
+ (concat
+ title "\n"
+ (make-string (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-ascii-global-margin))))
+ (mapconcat
+ (lambda (headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (indent (* (1- level) 3)))
+ (concat
+ (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
+ (org-ascii--build-title
+ headline info (- text-width indent) nil
+ (or (not (plist-get info :with-tags))
+ (eq (plist-get info :with-tags) 'not-in-toc))
+ 'toc))))
+ (org-export-collect-headlines info n) "\n")))))
+
+(defun org-ascii--list-listings (keyword info)
+ "Return a list of listings.
+
+KEYWORD is the keyword that initiated the list of listings
+generation. INFO is a plist used as a communication channel."
+ (let ((title (org-ascii--translate "List of Listings" info)))
+ (concat
+ title "\n"
+ (make-string (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-ascii-global-margin)))
+ ;; Use a counter instead of retrieving ordinal of each
+ ;; src-block.
+ (count 0))
+ (mapconcat
+ (lambda (src-block)
+ ;; Store initial text so its length can be computed. This is
+ ;; used to properly align caption right to it in case of
+ ;; filling (like contents of a description list item).
+ (let* ((initial-text
+ (format (org-ascii--translate "Listing %d:" info)
+ (incf count)))
+ (initial-width (string-width initial-text)))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-ascii--indent-string
+ (org-ascii--fill-string
+ ;; Use short name in priority, if available.
+ (let ((caption (or (org-export-get-caption src-block t)
+ (org-export-get-caption src-block))))
+ (org-export-data caption info))
+ (- text-width initial-width) info)
+ initial-width)))))
+ (org-export-collect-listings info) "\n")))))
+
+(defun org-ascii--list-tables (keyword info)
+ "Return a list of tables.
+
+KEYWORD is the keyword that initiated the list of tables
+generation. INFO is a plist used as a communication channel."
+ (let ((title (org-ascii--translate "List of Tables" info)))
+ (concat
+ title "\n"
+ (make-string (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n"
+ (let ((text-width
+ (if keyword (org-ascii--current-text-width keyword info)
+ (- org-ascii-text-width org-ascii-global-margin)))
+ ;; Use a counter instead of retrieving ordinal of each
+ ;; src-block.
+ (count 0))
+ (mapconcat
+ (lambda (table)
+ ;; Store initial text so its length can be computed. This is
+ ;; used to properly align caption right to it in case of
+ ;; filling (like contents of a description list item).
+ (let* ((initial-text
+ (format (org-ascii--translate "Table %d:" info)
+ (incf count)))
+ (initial-width (string-width initial-text)))
+ (concat
+ initial-text " "
+ (org-trim
+ (org-ascii--indent-string
+ (org-ascii--fill-string
+ ;; Use short name in priority, if available.
+ (let ((caption (or (org-export-get-caption table t)
+ (org-export-get-caption table))))
+ (org-export-data caption info))
+ (- text-width initial-width) info)
+ initial-width)))))
+ (org-export-collect-tables info) "\n")))))
+
+(defun org-ascii--unique-links (element info)
+ "Return a list of unique link references in ELEMENT.
+ELEMENT is either a headline element or a section element. INFO
+is a plist used as a communication channel."
+ (let* (seen
+ (unique-link-p
+ (function
+ ;; Return LINK if it wasn't referenced so far, or nil.
+ ;; Update SEEN links along the way.
+ (lambda (link)
+ (let ((footprint
+ ;; Normalize description in footprints.
+ (cons (org-element-property :raw-link link)
+ (let ((contents (org-element-contents link)))
+ (and contents
+ (replace-regexp-in-string
+ "[ \r\t\n]+" " "
+ (org-trim
+ (org-element-interpret-data contents))))))))
+ ;; Ignore LINK if it hasn't been translated already.
+ ;; It can happen if it is located in an affiliated
+ ;; keyword that was ignored.
+ (when (and (org-string-nw-p
+ (gethash link (plist-get info :exported-data)))
+ (not (member footprint seen)))
+ (push footprint seen) link)))))
+ ;; If at a section, find parent headline, if any, in order to
+ ;; count links that might be in the title.
+ (headline
+ (if (eq (org-element-type element) 'headline) element
+ (or (org-export-get-parent-headline element) element))))
+ ;; Get all links in HEADLINE.
+ (org-element-map headline 'link
+ (lambda (l) (funcall unique-link-p l)) info nil nil t)))
+
+(defun org-ascii--describe-links (links width info)
+ "Return a string describing a list of links.
+
+LINKS is a list of link type objects, as returned by
+`org-ascii--unique-links'. WIDTH is the text width allowed for
+the output string. INFO is a plist used as a communication
+channel."
+ (mapconcat
+ (lambda (link)
+ (let ((type (org-element-property :type link))
+ (anchor (let ((desc (org-element-contents link)))
+ (if desc (org-export-data desc info)
+ (org-element-property :raw-link link)))))
+ (cond
+ ;; Coderefs, radio links and fuzzy links are ignored.
+ ((member type '("coderef" "radio" "fuzzy")) nil)
+ ;; Id and custom-id links: Headlines refer to their numbering.
+ ((member type '("custom-id" "id"))
+ (let ((dest (org-export-resolve-id-link link info)))
+ (concat
+ (org-ascii--fill-string
+ (format
+ "[%s] %s"
+ anchor
+ (if (not dest) (org-ascii--translate "Unknown reference" info)
+ (format
+ (org-ascii--translate "See section %s" info)
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number dest info) "."))))
+ width info) "\n\n")))
+ ;; Do not add a link that cannot be resolved and doesn't have
+ ;; any description: destination is already visible in the
+ ;; paragraph.
+ ((not (org-element-contents link)) nil)
+ (t
+ (concat
+ (org-ascii--fill-string
+ (format "[%s] %s" anchor (org-element-property :raw-link link))
+ width info)
+ "\n\n")))))
+ links ""))
+
+(defun org-ascii--checkbox (item info)
+ "Return checkbox string for ITEM or nil.
+INFO is a plist used as a communication channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (case (org-element-property :checkbox item)
+ (on (if utf8p "☑ " "[X] "))
+ (off (if utf8p "☐ " "[ ] "))
+ (trans (if utf8p "☒ " "[-] ")))))
+
+
+
+;;; Template
+
+(defun org-ascii-template--document-title (info)
+ "Return document title, as a string.
+INFO is a plist used as a communication channel."
+ (let* ((text-width org-ascii-text-width)
+ ;; Links in the title will not be resolved later, so we make
+ ;; sure their path is located right after them.
+ (org-ascii-links-to-notes nil)
+ (title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info)))
+ (date (and (plist-get info :with-date)
+ (org-export-data (org-export-get-date info) info))))
+ ;; There are two types of title blocks depending on the presence
+ ;; of a title to display.
+ (if (string= title "")
+ ;; Title block without a title. DATE is positioned at the top
+ ;; right of the document, AUTHOR to the top left and EMAIL
+ ;; just below.
+ (cond
+ ((and (org-string-nw-p date) (org-string-nw-p author))
+ (concat
+ author
+ (make-string (- text-width (string-width date) (string-width author))
+ ?\s)
+ date
+ (when (org-string-nw-p email) (concat "\n" email))
+ "\n\n\n"))
+ ((and (org-string-nw-p date) (org-string-nw-p email))
+ (concat
+ email
+ (make-string (- text-width (string-width date) (string-width email))
+ ?\s)
+ date "\n\n\n"))
+ ((org-string-nw-p date)
+ (concat
+ (org-ascii--justify-string date text-width 'right)
+ "\n\n\n"))
+ ((and (org-string-nw-p author) (org-string-nw-p email))
+ (concat author "\n" email "\n\n\n"))
+ ((org-string-nw-p author) (concat author "\n\n\n"))
+ ((org-string-nw-p email) (concat email "\n\n\n")))
+ ;; Title block with a title. Document's TITLE, along with the
+ ;; AUTHOR and its EMAIL are both overlined and an underlined,
+ ;; centered. Date is just below, also centered.
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ ;; Format TITLE. It may be filled if it is too wide,
+ ;; that is wider than the two thirds of the total width.
+ (title-len (min (length title) (/ (* 2 text-width) 3)))
+ (formatted-title (org-ascii--fill-string title title-len info))
+ (line
+ (make-string
+ (min (+ (max title-len
+ (string-width (or author ""))
+ (string-width (or email "")))
+ 2)
+ text-width) (if utf8p ?━ ?_))))
+ (org-ascii--justify-string
+ (concat line "\n"
+ (unless utf8p "\n")
+ (upcase formatted-title)
+ (cond
+ ((and (org-string-nw-p author) (org-string-nw-p email))
+ (concat (if utf8p "\n\n\n" "\n\n") author "\n" email))
+ ((org-string-nw-p author)
+ (concat (if utf8p "\n\n\n" "\n\n") author))
+ ((org-string-nw-p email)
+ (concat (if utf8p "\n\n\n" "\n\n") email)))
+ "\n" line
+ (when (org-string-nw-p date) (concat "\n\n\n" date))
+ "\n\n\n") text-width 'center)))))
+
+(defun org-ascii-inner-template (contents info)
+ "Return complete document string after ASCII conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (org-element-normalize-string
+ (org-ascii--indent-string
+ (concat
+ ;; 1. Document's body.
+ contents
+ ;; 2. Footnote definitions.
+ (let ((definitions (org-export-collect-footnote-definitions
+ (plist-get info :parse-tree) info))
+ ;; Insert full links right inside the footnote definition
+ ;; as they have no chance to be inserted later.
+ (org-ascii-links-to-notes nil))
+ (when definitions
+ (concat
+ "\n\n\n"
+ (let ((title (org-ascii--translate "Footnotes" info)))
+ (concat
+ title "\n"
+ (make-string
+ (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
+ "\n\n"
+ (let ((text-width (- org-ascii-text-width org-ascii-global-margin)))
+ (mapconcat
+ (lambda (ref)
+ (let ((id (format "[%s] " (car ref))))
+ ;; Distinguish between inline definitions and
+ ;; full-fledged definitions.
+ (org-trim
+ (let ((def (nth 2 ref)))
+ (if (eq (org-element-type def) 'org-data)
+ ;; Full-fledged definition: footnote ID is
+ ;; inserted inside the first parsed paragraph
+ ;; (FIRST), if any, to be sure filling will
+ ;; take it into consideration.
+ (let ((first (car (org-element-contents def))))
+ (if (not (eq (org-element-type first) 'paragraph))
+ (concat id "\n" (org-export-data def info))
+ (push id (nthcdr 2 first))
+ (org-export-data def info)))
+ ;; Fill paragraph once footnote ID is inserted
+ ;; in order to have a correct length for first
+ ;; line.
+ (org-ascii--fill-string
+ (concat id (org-export-data def info))
+ text-width info))))))
+ definitions "\n\n"))))))
+ org-ascii-global-margin)))
+
+(defun org-ascii-template (contents info)
+ "Return complete document string after ASCII conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ ;; 1. Build title block.
+ (org-ascii--indent-string
+ (concat (org-ascii-template--document-title info)
+ ;; 2. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (org-ascii--build-toc info (and (wholenump depth) depth))
+ "\n\n\n"))))
+ org-ascii-global-margin)
+ ;; 3. Document's body.
+ contents
+ ;; 4. Creator. Ignore `comment' value as there are no comments in
+ ;; ASCII. Justify it to the bottom right.
+ (org-ascii--indent-string
+ (let ((creator-info (plist-get info :with-creator))
+ (text-width (- org-ascii-text-width org-ascii-global-margin)))
+ (unless (or (not creator-info) (eq creator-info 'comment))
+ (concat
+ "\n\n\n"
+ (org-ascii--fill-string
+ (plist-get info :creator) text-width info 'right))))
+ org-ascii-global-margin)))
+
+(defun org-ascii--translate (s info)
+ "Translate string S according to specified language and charset.
+INFO is a plist used as a communication channel."
+ (let ((charset (intern (format ":%s" (plist-get info :ascii-charset)))))
+ (org-export-translate s charset info)))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-ascii-bold (bold contents info)
+ "Transcode BOLD from Org to ASCII.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "*%s*" contents))
+
+
+;;;; Center Block
+
+(defun org-ascii-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-ascii--justify-string
+ contents (org-ascii--current-text-width center-block info) 'center))
+
+
+;;;; Clock
+
+(defun org-ascii-clock (clock contents info)
+ "Transcode a CLOCK object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat org-clock-string " "
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":")))))))
+
+
+;;;; Code
+
+(defun org-ascii-code (code contents info)
+ "Return a CODE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format org-ascii-verbatim-format (org-element-property :value code)))
+
+
+;;;; Drawer
+
+(defun org-ascii-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((name (org-element-property :drawer-name drawer))
+ (width (org-ascii--current-text-width drawer info)))
+ (funcall org-ascii-format-drawer-function name contents width)))
+
+
+;;;; Dynamic Block
+
+(defun org-ascii-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Entity
+
+(defun org-ascii-entity (entity contents info)
+ "Transcode an ENTITY object from Org to ASCII.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property
+ (intern (concat ":" (symbol-name (plist-get info :ascii-charset))))
+ entity))
+
+
+;;;; Example Block
+
+(defun org-ascii-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-ascii--box-string
+ (org-export-format-code-default example-block info) info))
+
+
+;;;; Export Snippet
+
+(defun org-ascii-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'ascii)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-ascii-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "ASCII")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Fixed Width
+
+(defun org-ascii-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-ascii--box-string
+ (org-remove-indentation
+ (org-element-property :value fixed-width)) info))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored. They are compiled at the end of
+;; the document, by `org-ascii-inner-template'.
+
+
+;;;; Footnote Reference
+
+(defun org-ascii-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "[%s]" (org-export-get-footnote-number footnote-reference info)))
+
+
+;;;; Headline
+
+(defun org-ascii-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to ASCII.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ ;; Don't export footnote section, which will be handled at the end
+ ;; of the template.
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((low-level-rank (org-export-low-level-p headline info))
+ (width (org-ascii--current-text-width headline info))
+ ;; Blank lines between headline and its contents.
+ ;; `org-ascii-headline-spacing', when set, overwrites
+ ;; original buffer's spacing.
+ (pre-blanks
+ (make-string
+ (if org-ascii-headline-spacing (car org-ascii-headline-spacing)
+ (org-element-property :pre-blank headline)) ?\n))
+ ;; Even if HEADLINE has no section, there might be some
+ ;; links in its title that we shouldn't forget to describe.
+ (links
+ (unless (or (eq (caar (org-element-contents headline)) 'section))
+ (let ((title (org-element-property :title headline)))
+ (when (consp title)
+ (org-ascii--describe-links
+ (org-ascii--unique-links title info) width info))))))
+ ;; Deep subtree: export it as a list item.
+ (if low-level-rank
+ (concat
+ ;; Bullet.
+ (let ((bullets (cdr (assq (plist-get info :ascii-charset)
+ org-ascii-bullets))))
+ (char-to-string
+ (nth (mod (1- low-level-rank) (length bullets)) bullets)))
+ " "
+ ;; Title.
+ (org-ascii--build-title headline info width) "\n"
+ ;; Contents, indented by length of bullet.
+ pre-blanks
+ (org-ascii--indent-string
+ (concat contents
+ (when (org-string-nw-p links) (concat "\n\n" links)))
+ 2))
+ ;; Else: Standard headline.
+ (concat
+ (org-ascii--build-title headline info width 'underline)
+ "\n" pre-blanks
+ (concat (when (org-string-nw-p links) links) contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-ascii-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((text-width (org-ascii--current-text-width horizontal-rule info))
+ (spec-width
+ (org-export-read-attribute :attr_ascii horizontal-rule :width)))
+ (org-ascii--justify-string
+ (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width))
+ (string-to-number spec-width)
+ text-width)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-))
+ text-width 'center)))
+
+
+;;;; Inline Src Block
+
+(defun org-ascii-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (format org-ascii-verbatim-format
+ (org-element-property :value inline-src-block)))
+
+
+;;;; Inlinetask
+
+(defun org-ascii-format-inlinetask-default
+ (todo type priority name tags contents width inlinetask info)
+ "Format an inline task element for ASCII export.
+See `org-ascii-format-inlinetask-function' for a description
+of the parameters."
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ (width (or width org-ascii-inlinetask-width)))
+ (org-ascii--indent-string
+ (concat
+ ;; Top line, with an additional blank line if not in UTF-8.
+ (make-string width (if utf8p ?━ ?_)) "\n"
+ (unless utf8p (concat (make-string width ? ) "\n"))
+ ;; Add title. Fill it if wider than inlinetask.
+ (let ((title (org-ascii--build-title inlinetask info width)))
+ (if (<= (string-width title) width) title
+ (org-ascii--fill-string title width info)))
+ "\n"
+ ;; If CONTENTS is not empty, insert it along with
+ ;; a separator.
+ (when (org-string-nw-p contents)
+ (concat (make-string width (if utf8p ?─ ?-)) "\n" contents))
+ ;; Bottom line.
+ (make-string width (if utf8p ?━ ?_)))
+ ;; Flush the inlinetask to the right.
+ (- org-ascii-text-width org-ascii-global-margin
+ (if (not (org-export-get-parent-headline inlinetask)) 0
+ org-ascii-inner-margin)
+ (org-ascii--current-text-width inlinetask info)))))
+
+(defun org-ascii-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((width (org-ascii--current-text-width inlinetask info)))
+ (funcall org-ascii-format-inlinetask-function
+ ;; todo.
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property
+ :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info))))
+ ;; todo-type
+ (org-element-property :todo-type inlinetask)
+ ;; priority
+ (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))
+ ;; title
+ (org-export-data (org-element-property :title inlinetask) info)
+ ;; tags
+ (and (plist-get info :with-tags)
+ (org-element-property :tags inlinetask))
+ ;; contents and width
+ contents width inlinetask info)))
+
+
+;;;; Italic
+
+(defun org-ascii-italic (italic contents info)
+ "Transcode italic from Org to ASCII.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "/%s/" contents))
+
+
+;;;; Item
+
+(defun org-ascii-item (item contents info)
+ "Transcode an ITEM element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ (checkbox (org-ascii--checkbox item info))
+ (list-type (org-element-property :type (org-export-get-parent item)))
+ (bullet
+ ;; First parent of ITEM is always the plain-list. Get
+ ;; `:type' property from it.
+ (org-list-bullet-string
+ (case list-type
+ (descriptive
+ (concat checkbox
+ (org-export-data (org-element-property :tag item) info)
+ ": "))
+ (ordered
+ ;; Return correct number for ITEM, paying attention to
+ ;; counters.
+ (let* ((struct (org-element-property :structure item))
+ (bul (org-element-property :bullet item))
+ (num (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))))
+ (replace-regexp-in-string "[0-9]+" num bul)))
+ (t (let ((bul (org-element-property :bullet item)))
+ ;; Change bullets into more visible form if UTF-8 is active.
+ (if (not utf8p) bul
+ (replace-regexp-in-string
+ "-" "•"
+ (replace-regexp-in-string
+ "+" "⁃"
+ (replace-regexp-in-string "*" "‣" bul))))))))))
+ (concat
+ bullet
+ (unless (eq list-type 'descriptive) checkbox)
+ ;; Contents: Pay attention to indentation. Note: check-boxes are
+ ;; already taken care of at the paragraph level so they don't
+ ;; interfere with indentation.
+ (let ((contents (org-ascii--indent-string contents (string-width bullet))))
+ (if (eq (org-element-type (car (org-element-contents item))) 'paragraph)
+ (org-trim contents)
+ (concat "\n" contents))))))
+
+
+;;;; Keyword
+
+(defun org-ascii-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "ASCII") value)
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (org-ascii--build-toc
+ info (and (wholenump depth) depth) keyword)))
+ ((string= "tables" value)
+ (org-ascii--list-tables keyword info))
+ ((string= "listings" value)
+ (org-ascii--list-listings keyword info))))))))
+
+
+;;;; Latex Environment
+
+(defun org-ascii-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (when (plist-get info :with-latex)
+ (org-remove-indentation (org-element-property :value latex-environment))))
+
+
+;;;; Latex Fragment
+
+(defun org-ascii-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (when (plist-get info :with-latex)
+ (org-element-property :value latex-fragment)))
+
+
+;;;; Line Break
+
+(defun org-ascii-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+ information." hard-newline)
+
+
+;;;; Link
+
+(defun org-ascii-link (link desc info)
+ "Transcode a LINK object from Org to ASCII.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information."
+ (let ((raw-link (org-element-property :raw-link link))
+ (type (org-element-property :type link)))
+ (cond
+ ((string= type "coderef")
+ (let ((ref (org-element-property :path link)))
+ (format (org-export-get-coderef-format ref desc)
+ (org-export-resolve-coderef ref info))))
+ ;; Do not apply a special syntax on radio links. Though, use
+ ;; transcoded target's contents as output.
+ ((string= type "radio") desc)
+ ;; Do not apply a special syntax on fuzzy links pointing to
+ ;; targets.
+ ((string= type "fuzzy")
+ (let ((destination (org-export-resolve-fuzzy-link link info)))
+ (if (org-string-nw-p desc) desc
+ (when destination
+ (let ((number
+ (org-export-get-ordinal
+ destination info nil 'org-ascii--has-caption-p)))
+ (when number
+ (if (atom number) (number-to-string number)
+ (mapconcat 'number-to-string number "."))))))))
+ (t
+ (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
+ (concat
+ (format "[%s]" desc)
+ (unless org-ascii-links-to-notes (format " (%s)" raw-link))))))))
+
+
+;;;; Paragraph
+
+(defun org-ascii-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to ASCII.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (org-ascii--fill-string
+ (if (not (wholenump org-ascii-indented-line-width)) contents
+ (concat
+ ;; Do not indent first paragraph in a section.
+ (unless (and (not (org-export-get-previous-element paragraph info))
+ (eq (org-element-type (org-export-get-parent paragraph))
+ 'section))
+ (make-string org-ascii-indented-line-width ?\s))
+ (replace-regexp-in-string "\\`[ \t]+" "" contents)))
+ (org-ascii--current-text-width paragraph info) info))
+
+
+;;;; Plain List
+
+(defun org-ascii-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to ASCII.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-ascii-plain-text (text info)
+ "Transcode a TEXT string from Org to ASCII.
+INFO is a plist used as a communication channel."
+ (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
+ (when (and utf8p (plist-get info :with-smart-quotes))
+ (setq text (org-export-activate-smart-quotes text :utf-8 info)))
+ (if (not (plist-get info :with-special-strings)) text
+ (setq text (replace-regexp-in-string "\\\\-" "" text))
+ (if (not utf8p) text
+ ;; Usual replacements in utf-8 with proper option set.
+ (replace-regexp-in-string
+ "\\.\\.\\." "…"
+ (replace-regexp-in-string
+ "--" "–"
+ (replace-regexp-in-string "---" "—" text)))))))
+
+
+;;;; Planning
+
+(defun org-ascii-planning (planning contents info)
+ "Transcode a PLANNING element from Org to ASCII.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (mapconcat
+ 'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-translate-time
+ (org-element-property :raw-value closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-translate-time
+ (org-element-property :raw-value deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " "
+ (org-translate-time
+ (org-element-property :raw-value scheduled)))))))
+ " "))
+
+
+;;;; Quote Block
+
+(defun org-ascii-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-ascii--indent-string contents org-ascii-quote-margin))
+
+
+;;;; Quote Section
+
+(defun org-ascii-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((width (org-ascii--current-text-width quote-section info))
+ (value
+ (org-export-data
+ (org-remove-indentation (org-element-property :value quote-section))
+ info)))
+ (org-ascii--indent-string
+ value
+ (+ org-ascii-quote-margin
+ ;; Don't apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline quote-section)))
+ (if (org-export-low-level-p headline info) 0
+ org-ascii-inner-margin))))))
+
+
+;;;; Radio Target
+
+(defun org-ascii-radio-target (radio-target contents info)
+ "Transcode a RADIO-TARGET object from Org to ASCII.
+CONTENTS is the contents of the target. INFO is a plist holding
+contextual information."
+ contents)
+
+
+;;;; Section
+
+(defun org-ascii-section (section contents info)
+ "Transcode a SECTION element from Org to ASCII.
+CONTENTS is the contents of the section. INFO is a plist holding
+contextual information."
+ (org-ascii--indent-string
+ (concat
+ contents
+ (when org-ascii-links-to-notes
+ ;; Add list of links at the end of SECTION.
+ (let ((links (org-ascii--describe-links
+ (org-ascii--unique-links section info)
+ (org-ascii--current-text-width section info) info)))
+ ;; Separate list of links and section contents.
+ (when (org-string-nw-p links) (concat "\n\n" links)))))
+ ;; Do not apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline section)))
+ (if (or (not headline) (org-export-low-level-p headline info)) 0
+ org-ascii-inner-margin))))
+
+
+;;;; Special Block
+
+(defun org-ascii-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Src Block
+
+(defun org-ascii-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to ASCII.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let ((caption (org-ascii--build-caption src-block info))
+ (code (org-export-format-code-default src-block info)))
+ (if (equal code "") ""
+ (concat
+ (when (and caption org-ascii-caption-above) (concat caption "\n"))
+ (org-ascii--box-string code info)
+ (when (and caption (not org-ascii-caption-above))
+ (concat "\n" caption))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-ascii-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+
+;;;; Subscript
+
+(defun org-ascii-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to ASCII.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (org-element-property :use-brackets-p subscript)
+ (format "_{%s}" contents)
+ (format "_%s" contents)))
+
+
+;;;; Superscript
+
+(defun org-ascii-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to ASCII.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (if (org-element-property :use-brackets-p superscript)
+ (format "^{%s}" contents)
+ (format "^%s" contents)))
+
+
+;;;; Strike-through
+
+(defun org-ascii-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to ASCII.
+CONTENTS is text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "+%s+" contents))
+
+
+;;;; Table
+
+(defun org-ascii-table (table contents info)
+ "Transcode a TABLE element from Org to ASCII.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (let ((caption (org-ascii--build-caption table info)))
+ (concat
+ ;; Possibly add a caption string above.
+ (when (and caption org-ascii-caption-above) (concat caption "\n"))
+ ;; Insert table. Note: "table.el" tables are left unmodified.
+ (cond ((eq (org-element-property :type table) 'org) contents)
+ ((and org-ascii-table-use-ascii-art
+ (eq (plist-get info :ascii-charset) 'utf-8)
+ (require 'ascii-art-to-unicode nil t))
+ (with-temp-buffer
+ (insert (org-remove-indentation
+ (org-element-property :value table)))
+ (goto-char (point-min))
+ (aa2u)
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (buffer-substring (point-min) (point))))
+ (t (org-remove-indentation (org-element-property :value table))))
+ ;; Possible add a caption string below.
+ (and (not org-ascii-caption-above) caption))))
+
+
+;;;; Table Cell
+
+(defun org-ascii--table-cell-width (table-cell info)
+ "Return width of TABLE-CELL.
+
+INFO is a plist used as a communication channel.
+
+Width of a cell is determined either by a width cookie in the
+same column as the cell, or by the maximum cell's length in that
+column.
+
+When `org-ascii-table-widen-columns' is non-nil, width cookies
+are ignored."
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent row))
+ (col (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells)))))
+ (cache
+ (or (plist-get info :ascii-table-cell-width-cache)
+ (plist-get (setq info
+ (plist-put info :ascii-table-cell-width-cache
+ (make-hash-table :test 'equal)))
+ :ascii-table-cell-width-cache)))
+ (key (cons table col)))
+ (or (gethash key cache)
+ (puthash
+ key
+ (let ((cookie-width (org-export-table-cell-width table-cell info)))
+ (or (and (not org-ascii-table-widen-columns) cookie-width)
+ (let ((contents-width
+ (let ((max-width 0))
+ (org-element-map table 'table-row
+ (lambda (row)
+ (setq max-width
+ (max (string-width
+ (org-export-data
+ (org-element-contents
+ (elt (org-element-contents row) col))
+ info))
+ max-width)))
+ info)
+ max-width)))
+ (cond ((not cookie-width) contents-width)
+ (org-ascii-table-widen-columns
+ (max cookie-width contents-width))
+ (t cookie-width)))))
+ cache))))
+
+(defun org-ascii-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL object from Org to ASCII.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ ;; Determine column width. When `org-ascii-table-widen-columns'
+ ;; is nil and some width cookie has set it, use that value.
+ ;; Otherwise, compute the maximum width among transcoded data of
+ ;; each cell in the column.
+ (let ((width (org-ascii--table-cell-width table-cell info)))
+ ;; When contents are too large, truncate them.
+ (unless (or org-ascii-table-widen-columns
+ (<= (string-width (or contents "")) width))
+ (setq contents (concat (substring contents 0 (- width 2)) "=>")))
+ ;; Align contents correctly within the cell.
+ (let* ((indent-tabs-mode nil)
+ (data
+ (when contents
+ (org-ascii--justify-string
+ contents width
+ (org-export-table-cell-alignment table-cell info)))))
+ (setq contents
+ (concat data
+ (make-string (- width (string-width (or data ""))) ?\s))))
+ ;; Return cell.
+ (concat (format " %s " contents)
+ (when (memq 'right (org-export-table-cell-borders table-cell info))
+ (if (eq (plist-get info :ascii-charset) 'utf-8) "│" "|")))))
+
+
+;;;; Table Row
+
+(defun org-ascii-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to ASCII.
+CONTENTS is the row contents. INFO is a plist used as
+a communication channel."
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let ((build-hline
+ (function
+ (lambda (lcorner horiz vert rcorner)
+ (concat
+ (apply
+ 'concat
+ (org-element-map table-row 'table-cell
+ (lambda (cell)
+ (let ((width (org-ascii--table-cell-width cell info))
+ (borders (org-export-table-cell-borders cell info)))
+ (concat
+ ;; In order to know if CELL starts the row, do
+ ;; not compare it with the first cell in the
+ ;; row as there might be a special column.
+ ;; Instead, compare it with first exportable
+ ;; cell, obtained with `org-element-map'.
+ (when (and (memq 'left borders)
+ (eq (org-element-map table-row 'table-cell
+ 'identity info t)
+ cell))
+ lcorner)
+ (make-string (+ 2 width) (string-to-char horiz))
+ (cond
+ ((not (memq 'right borders)) nil)
+ ((eq (car (last (org-element-contents table-row))) cell)
+ rcorner)
+ (t vert)))))
+ info)) "\n"))))
+ (utf8p (eq (plist-get info :ascii-charset) 'utf-8))
+ (borders (org-export-table-cell-borders
+ (org-element-map table-row 'table-cell 'identity info t)
+ info)))
+ (concat (cond
+ ((and (memq 'top borders) (or utf8p (memq 'above borders)))
+ (if utf8p (funcall build-hline "┍" "━" "┯" "┑")
+ (funcall build-hline "+" "-" "+" "+")))
+ ((memq 'above borders)
+ (if utf8p (funcall build-hline "├" "─" "┼" "┤")
+ (funcall build-hline "+" "-" "+" "+"))))
+ (when (memq 'left borders) (if utf8p "│" "|"))
+ contents "\n"
+ (when (and (memq 'bottom borders) (or utf8p (memq 'below borders)))
+ (if utf8p (funcall build-hline "┕" "━" "┷" "┙")
+ (funcall build-hline "+" "-" "+" "+")))))))
+
+
+;;;; Timestamp
+
+(defun org-ascii-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-ascii-plain-text (org-timestamp-translate timestamp) info))
+
+
+;;;; Underline
+
+(defun org-ascii-underline (underline contents info)
+ "Transcode UNDERLINE from Org to ASCII.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "_%s_" contents))
+
+
+;;;; Verbatim
+
+(defun org-ascii-verbatim (verbatim contents info)
+ "Return a VERBATIM object from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format org-ascii-verbatim-format
+ (org-element-property :value verbatim)))
+
+
+;;;; Verse Block
+
+(defun org-ascii-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to ASCII.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (let ((verse-width (org-ascii--current-text-width verse-block info)))
+ (org-ascii--indent-string
+ (org-ascii--justify-string contents verse-width 'left)
+ org-ascii-quote-margin)))
+
+
+
+;;; Filters
+
+(defun org-ascii-filter-headline-blank-lines (headline back-end info)
+ "Filter controlling number of blank lines after a headline.
+
+HEADLINE is a string representing a transcoded headline.
+BACK-END is symbol specifying back-end used for export. INFO is
+plist containing the communication channel.
+
+This function only applies to `ascii' back-end. See
+`org-ascii-headline-spacing' for information."
+ (if (not org-ascii-headline-spacing) headline
+ (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))
+
+(defun org-ascii-filter-paragraph-spacing (tree back-end info)
+ "Filter controlling number of blank lines between paragraphs.
+
+TREE is the parse tree. BACK-END is the symbol specifying
+back-end used for export. INFO is a plist used as
+a communication channel.
+
+See `org-ascii-paragraph-spacing' for information."
+ (when (wholenump org-ascii-paragraph-spacing)
+ (org-element-map tree 'paragraph
+ (lambda (p)
+ (when (eq (org-element-type (org-export-get-next-element p info))
+ 'paragraph)
+ (org-element-put-property
+ p :post-blank org-ascii-paragraph-spacing)))))
+ tree)
+
+(defun org-ascii-filter-comment-spacing (tree backend info)
+ "Filter removing blank lines between comments.
+TREE is the parse tree. BACK-END is the symbol specifying
+back-end used for export. INFO is a plist used as
+a communication channel."
+ (org-element-map tree '(comment comment-block)
+ (lambda (c)
+ (when (memq (org-element-type (org-export-get-next-element c info))
+ '(comment comment-block))
+ (org-element-put-property c :post-blank 0))))
+ tree)
+
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-ascii-export-as-ascii
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a text buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, strip title and
+table of contents from output.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org ASCII Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'ascii "*Org ASCII Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
+
+;;;###autoload
+(defun org-ascii-export-to-ascii
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a text file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, strip title and
+table of contents from output.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".txt" subtreep)))
+ (org-export-to-file 'ascii file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-ascii-publish-to-ascii (plist filename pub-dir)
+ "Publish an Org file to ASCII.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir))
+
+;;;###autoload
+(defun org-ascii-publish-to-latin1 (plist filename pub-dir)
+ "Publish an Org file to Latin-1.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir))
+
+;;;###autoload
+(defun org-ascii-publish-to-utf8 (plist filename pub-dir)
+ "Publish an org file to UTF-8.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to
+ 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir))
+
+
+(provide 'ox-ascii)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; coding: utf-8
+;; End:
+
+;;; ox-ascii.el ends here
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
new file mode 100644
index 00000000000..765f289adc8
--- /dev/null
+++ b/lisp/org/ox-beamer.el
@@ -0,0 +1,1183 @@
+;;; ox-beamer.el --- Beamer Back-End for Org Export Engine
+
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
+;; Nicolas Goaziou <n.goaziou AT gmail DOT com>
+;; Keywords: org, wp, tex
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements both a Beamer back-end, derived from the
+;; LaTeX one and a minor mode easing structure edition of the
+;; document. See Org manual for more information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-latex)
+
+;; Install a default set-up for Beamer export.
+(unless (assoc "beamer" org-latex-classes)
+ (add-to-list 'org-latex-classes
+ '("beamer"
+ "\\documentclass[presentation]{beamer}"
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))))
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-beamer nil
+ "Options specific for using the beamer class in LaTeX export."
+ :tag "Org Beamer"
+ :group 'org-export
+ :version "24.2")
+
+(defcustom org-beamer-frame-level 1
+ "The level at which headlines become frames.
+
+Headlines at a lower level will be translated into a sectioning
+structure. At a higher level, they will be translated into
+blocks.
+
+If a headline with a \"BEAMER_env\" property set to \"frame\" is
+found within a tree, its level locally overrides this number.
+
+This variable has no effect on headlines with the \"BEAMER_env\"
+property set to either \"ignoreheading\", \"appendix\", or
+\"note\", which will respectively, be invisible, become an
+appendix or a note.
+
+This integer is relative to the minimal level of a headline
+within the parse tree, defined as 1."
+ :group 'org-export-beamer
+ :type 'integer)
+
+(defcustom org-beamer-frame-default-options ""
+ "Default options string to use for frames.
+For example, it could be set to \"allowframebreaks\"."
+ :group 'org-export-beamer
+ :type '(string :tag "[options]"))
+
+(defcustom org-beamer-column-view-format
+ "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)"
+ "Column view format that should be used to fill the template."
+ :group 'org-export-beamer
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not insert Beamer column view format" nil)
+ (string :tag "Beamer column view format")))
+
+(defcustom org-beamer-theme "default"
+ "Default theme used in Beamer presentations."
+ :group 'org-export-beamer
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not insert a Beamer theme" nil)
+ (string :tag "Beamer theme")))
+
+(defcustom org-beamer-environments-extra nil
+ "Environments triggered by tags in Beamer export.
+Each entry has 4 elements:
+
+name Name of the environment
+key Selection key for `org-beamer-select-environment'
+open The opening template for the environment, with the following escapes
+ %a the action/overlay specification
+ %A the default action/overlay specification
+ %o the options argument of the template
+ %h the headline text
+ %r the raw headline text (i.e. without any processing)
+ %H if there is headline text, that raw text in {} braces
+ %U if there is headline text, that raw text in [] brackets
+close The closing string of the environment."
+ :group 'org-export-beamer
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type '(repeat
+ (list
+ (string :tag "Environment")
+ (string :tag "Selection key")
+ (string :tag "Begin")
+ (string :tag "End"))))
+
+(defcustom org-beamer-outline-frame-title "Outline"
+ "Default title of a frame containing an outline."
+ :group 'org-export-beamer
+ :type '(string :tag "Outline frame title"))
+
+(defcustom org-beamer-outline-frame-options ""
+ "Outline frame options appended after \\begin{frame}.
+You might want to put e.g. \"allowframebreaks=0.9\" here."
+ :group 'org-export-beamer
+ :type '(string :tag "Outline frame options"))
+
+
+
+;;; Internal Variables
+
+(defconst org-beamer-column-widths
+ "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
+"The column widths that should be installed as allowed property values.")
+
+(defconst org-beamer-environments-special
+ '(("againframe" "A")
+ ("appendix" "x")
+ ("column" "c")
+ ("columns" "C")
+ ("frame" "f")
+ ("fullframe" "F")
+ ("ignoreheading" "i")
+ ("note" "n")
+ ("noteNH" "N"))
+ "Alist of environments treated in a special way by the back-end.
+Keys are environment names, as strings, values are bindings used
+in `org-beamer-select-environment'. Environments listed here,
+along with their binding, are hard coded and cannot be modified
+through `org-beamer-environments-extra' variable.")
+
+(defconst org-beamer-environments-default
+ '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}")
+ ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}")
+ ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}")
+ ("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}")
+ ("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}")
+ ("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}")
+ ("theorem" "t" "\\begin{theorem}%a%U" "\\end{theorem}")
+ ("definition" "d" "\\begin{definition}%a%U" "\\end{definition}")
+ ("example" "e" "\\begin{example}%a%U" "\\end{example}")
+ ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}")
+ ("proof" "p" "\\begin{proof}%a%U" "\\end{proof}")
+ ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}"))
+ "Environments triggered by properties in Beamer export.
+These are the defaults - for user definitions, see
+`org-beamer-environments-extra'.")
+
+(defconst org-beamer-verbatim-elements
+ '(code example-block fixed-width inline-src-block src-block verbatim)
+ "List of element or object types producing verbatim text.
+This is used internally to determine when a frame should have the
+\"fragile\" option.")
+
+
+
+;;; Internal functions
+
+(defun org-beamer--normalize-argument (argument type)
+ "Return ARGUMENT string with proper boundaries.
+
+TYPE is a symbol among the following:
+`action' Return ARGUMENT within angular brackets.
+`defaction' Return ARGUMENT within both square and angular brackets.
+`option' Return ARGUMENT within square brackets."
+ (if (not (string-match "\\S-" argument)) ""
+ (case type
+ (action (if (string-match "\\`<.*>\\'" argument) argument
+ (format "<%s>" argument)))
+ (defaction (cond
+ ((string-match "\\`\\[<.*>\\]\\'" argument) argument)
+ ((string-match "\\`<.*>\\'" argument)
+ (format "[%s]" argument))
+ ((string-match "\\`\\[\\(.*\\)\\]\\'" argument)
+ (format "[<%s>]" (match-string 1 argument)))
+ (t (format "[<%s>]" argument))))
+ (option (if (string-match "\\`\\[.*\\]\\'" argument) argument
+ (format "[%s]" argument)))
+ (otherwise argument))))
+
+(defun org-beamer--element-has-overlay-p (element)
+ "Non-nil when ELEMENT has an overlay specified.
+An element has an overlay specification when it starts with an
+`beamer' export-snippet whose value is between angular brackets.
+Return overlay specification, as a string, or nil."
+ (let ((first-object (car (org-element-contents element))))
+ (when (eq (org-element-type first-object) 'export-snippet)
+ (let ((value (org-element-property :value first-object)))
+ (and (string-match "\\`<.*>\\'" value) value)))))
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'beamer 'latex
+ :export-block "BEAMER"
+ :menu-entry
+ '(?l 1
+ ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex)
+ (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex)
+ (?P "As PDF file (Beamer)" org-beamer-export-to-pdf)
+ (?O "As PDF file and open (Beamer)"
+ (lambda (a s v b)
+ (if a (org-beamer-export-to-pdf t s v b)
+ (org-open-file (org-beamer-export-to-pdf nil s v b)))))))
+ :options-alist
+ '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme)
+ (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t)
+ (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t)
+ (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t)
+ (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t)
+ (:beamer-header-extra "BEAMER_HEADER" nil nil newline)
+ ;; Modify existing properties.
+ (:headline-levels nil "H" org-beamer-frame-level)
+ (:latex-class "LATEX_CLASS" nil "beamer" t))
+ :translate-alist '((bold . org-beamer-bold)
+ (export-block . org-beamer-export-block)
+ (export-snippet . org-beamer-export-snippet)
+ (headline . org-beamer-headline)
+ (item . org-beamer-item)
+ (keyword . org-beamer-keyword)
+ (link . org-beamer-link)
+ (plain-list . org-beamer-plain-list)
+ (radio-target . org-beamer-radio-target)
+ (target . org-beamer-target)
+ (template . org-beamer-template)))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-beamer-bold (bold contents info)
+ "Transcode BLOCK object into Beamer code.
+CONTENTS is the text being bold. INFO is a plist used as
+a communication channel."
+ (format "\\alert%s{%s}"
+ (or (org-beamer--element-has-overlay-p bold) "")
+ contents))
+
+
+;;;; Export Block
+
+(defun org-beamer-export-block (export-block contents info)
+ "Transcode an EXPORT-BLOCK element into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (when (member (org-element-property :type export-block) '("BEAMER" "LATEX"))
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-beamer-export-snippet (export-snippet contents info)
+ "Transcode an EXPORT-SNIPPET object into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((backend (org-export-snippet-backend export-snippet))
+ (value (org-element-property :value export-snippet)))
+ ;; Only "latex" and "beamer" snippets are retained.
+ (cond ((eq backend 'latex) value)
+ ;; Ignore "beamer" snippets specifying overlays.
+ ((and (eq backend 'beamer)
+ (or (org-export-get-previous-element export-snippet info)
+ (not (string-match "\\`<.*>\\'" value))))
+ value))))
+
+
+;;;; Headline
+;;
+;; The main function to translate a headline is
+;; `org-beamer-headline'.
+;;
+;; Depending on the level at which a headline is considered as
+;; a frame (given by `org-beamer--frame-level'), the headline is
+;; either a section (`org-beamer--format-section'), a frame
+;; (`org-beamer--format-frame') or a block
+;; (`org-beamer--format-block').
+;;
+;; `org-beamer-headline' also takes care of special environments
+;; like "ignoreheading", "note", "noteNH", "appendix" and
+;; "againframe".
+
+(defun org-beamer--get-label (headline info)
+ "Return label for HEADLINE, as a string.
+
+INFO is a plist used as a communication channel.
+
+The value is either the label specified in \"BEAMER_opt\"
+property, or a fallback value built from headline's number. This
+function assumes HEADLINE will be treated as a frame."
+ (let ((opt (org-element-property :BEAMER_OPT headline)))
+ (if (and (org-string-nw-p opt)
+ (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt))
+ (match-string 1 opt)
+ (format "sec-%s"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number headline info)
+ "-")))))
+
+(defun org-beamer--frame-level (headline info)
+ "Return frame level in subtree containing HEADLINE.
+INFO is a plist used as a communication channel."
+ (or
+ ;; 1. Look for "frame" environment in parents, starting from the
+ ;; farthest.
+ (catch 'exit
+ (mapc (lambda (parent)
+ (let ((env (org-element-property :BEAMER_ENV parent)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (throw 'exit (org-export-get-relative-level parent info)))))
+ (nreverse (org-export-get-genealogy headline)))
+ nil)
+ ;; 2. Look for "frame" environment in HEADLINE.
+ (let ((env (org-element-property :BEAMER_ENV headline)))
+ (and env (member-ignore-case env '("frame" "fullframe"))
+ (org-export-get-relative-level headline info)))
+ ;; 3. Look for "frame" environment in sub-tree.
+ (org-element-map headline 'headline
+ (lambda (hl)
+ (let ((env (org-element-property :BEAMER_ENV hl)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (org-export-get-relative-level hl info))))
+ info 'first-match)
+ ;; 4. No "frame" environment in tree: use default value.
+ (plist-get info :headline-levels)))
+
+(defun org-beamer--format-section (headline contents info)
+ "Format HEADLINE as a sectioning part.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ (let ((latex-headline
+ (org-export-with-backend
+ ;; We create a temporary export back-end which behaves the
+ ;; same as current one, but adds "\protect" in front of the
+ ;; output of some objects.
+ (org-export-create-backend
+ :parent 'latex
+ :transcoders
+ (let ((protected-output
+ (function
+ (lambda (object contents info)
+ (let ((code (org-export-with-backend
+ 'beamer object contents info)))
+ (if (org-string-nw-p code) (concat "\\protect" code)
+ code))))))
+ (mapcar #'(lambda (type) (cons type protected-output))
+ '(bold footnote-reference italic strike-through timestamp
+ underline))))
+ headline
+ contents
+ info))
+ (mode-specs (org-element-property :BEAMER_ACT headline)))
+ (if (and mode-specs
+ (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{"
+ latex-headline))
+ ;; Insert overlay specifications.
+ (replace-match (concat (match-string 1 latex-headline)
+ (format "<%s>" mode-specs))
+ nil nil latex-headline 1)
+ latex-headline)))
+
+(defun org-beamer--format-frame (headline contents info)
+ "Format HEADLINE as a frame.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ (let ((fragilep
+ ;; FRAGILEP is non-nil when HEADLINE contains an element
+ ;; among `org-beamer-verbatim-elements'.
+ (org-element-map headline org-beamer-verbatim-elements 'identity
+ info 'first-match)))
+ (concat "\\begin{frame}"
+ ;; Overlay specification, if any. When surrounded by
+ ;; square brackets, consider it as a default
+ ;; specification.
+ (let ((action (org-element-property :BEAMER_ACT headline)))
+ (cond
+ ((not action) "")
+ ((string-match "\\`\\[.*\\]\\'" action )
+ (org-beamer--normalize-argument action 'defaction))
+ (t (org-beamer--normalize-argument action 'action))))
+ ;; Options, if any.
+ (let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
+ (options
+ ;; Collect options from default value and headline's
+ ;; properties. Also add a label for links.
+ (append
+ (org-split-string org-beamer-frame-default-options ",")
+ (and beamer-opt
+ (org-split-string
+ ;; Remove square brackets if user provided
+ ;; them.
+ (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
+ (match-string 1 beamer-opt))
+ ","))
+ ;; Provide an automatic label for the frame
+ ;; unless the user specified one.
+ (unless (and beamer-opt
+ (string-match "\\(^\\|,\\)label=" beamer-opt))
+ (list
+ (format "label=%s"
+ (org-beamer--get-label headline info)))))))
+ ;; Change options list into a string.
+ (org-beamer--normalize-argument
+ (mapconcat
+ 'identity
+ (if (or (not fragilep) (member "fragile" options)) options
+ (cons "fragile" options))
+ ",")
+ 'option))
+ ;; Title.
+ (let ((env (org-element-property :BEAMER_ENV headline)))
+ (format "{%s}"
+ (if (and env (equal (downcase env) "fullframe")) ""
+ (org-export-data
+ (org-element-property :title headline) info))))
+ "\n"
+ ;; The following workaround is required in fragile frames
+ ;; as Beamer will append "\par" to the beginning of the
+ ;; contents. So we need to make sure the command is
+ ;; separated from the contents by at least one space. If
+ ;; it isn't, it will create "\parfirst-word" command and
+ ;; remove the first word from the contents in the PDF
+ ;; output.
+ (if (not fragilep) contents
+ (replace-regexp-in-string "\\`\n*" "\\& " (or contents "")))
+ "\\end{frame}")))
+
+(defun org-beamer--format-block (headline contents info)
+ "Format HEADLINE as a block.
+CONTENTS holds the contents of the headline. INFO is a plist
+used as a communication channel."
+ (let* ((column-width (org-element-property :BEAMER_COL headline))
+ ;; ENVIRONMENT defaults to "block" if none is specified and
+ ;; there is no column specification. If there is a column
+ ;; specified but still no explicit environment, ENVIRONMENT
+ ;; is "column".
+ (environment (let ((env (org-element-property :BEAMER_ENV headline)))
+ (cond
+ ;; "block" is the fallback environment.
+ ((and (not env) (not column-width)) "block")
+ ;; "column" only.
+ ((not env) "column")
+ ;; Use specified environment.
+ (t env))))
+ (raw-title (org-element-property :raw-value headline))
+ (env-format
+ (cond ((member environment '("column" "columns")) nil)
+ ((assoc environment
+ (append org-beamer-environments-extra
+ org-beamer-environments-default)))
+ (t (user-error "Wrong block type at a headline named \"%s\""
+ raw-title))))
+ (title (org-export-data (org-element-property :title headline) info))
+ (options (let ((options (org-element-property :BEAMER_OPT headline)))
+ (if (not options) ""
+ (org-beamer--normalize-argument options 'option))))
+ ;; Start a "columns" environment when explicitly requested or
+ ;; when there is no previous headline or the previous
+ ;; headline do not have a BEAMER_column property.
+ (parent-env (org-element-property
+ :BEAMER_ENV (org-export-get-parent-headline headline)))
+ (start-columns-p
+ (or (equal environment "columns")
+ (and column-width
+ (not (and parent-env
+ (equal (downcase parent-env) "columns")))
+ (or (org-export-first-sibling-p headline info)
+ (not (org-element-property
+ :BEAMER_COL
+ (org-export-get-previous-element
+ headline info)))))))
+ ;; End the "columns" environment when explicitly requested or
+ ;; when there is no next headline or the next headline do not
+ ;; have a BEAMER_column property.
+ (end-columns-p
+ (or (equal environment "columns")
+ (and column-width
+ (not (and parent-env
+ (equal (downcase parent-env) "columns")))
+ (or (org-export-last-sibling-p headline info)
+ (not (org-element-property
+ :BEAMER_COL
+ (org-export-get-next-element headline info))))))))
+ (concat
+ (when start-columns-p
+ ;; Column can accept options only when the environment is
+ ;; explicitly defined.
+ (if (not (equal environment "columns")) "\\begin{columns}\n"
+ (format "\\begin{columns}%s\n" options)))
+ (when column-width
+ (format "\\begin{column}%s{%s}\n"
+ ;; One can specify placement for column only when
+ ;; HEADLINE stands for a column on its own.
+ (if (equal environment "column") options "")
+ (format "%s\\textwidth" column-width)))
+ ;; Block's opening string.
+ (when (nth 2 env-format)
+ (concat
+ (org-fill-template
+ (nth 2 env-format)
+ (nconc
+ ;; If BEAMER_act property has its value enclosed in square
+ ;; brackets, it is a default overlay specification and
+ ;; overlay specification is empty. Otherwise, it is an
+ ;; overlay specification and the default one is nil.
+ (let ((action (org-element-property :BEAMER_ACT headline)))
+ (cond
+ ((not action) (list (cons "a" "") (cons "A" "")))
+ ((string-match "\\`\\[.*\\]\\'" action)
+ (list
+ (cons "A" (org-beamer--normalize-argument action 'defaction))
+ (cons "a" "")))
+ (t
+ (list (cons "a" (org-beamer--normalize-argument action 'action))
+ (cons "A" "")))))
+ (list (cons "o" options)
+ (cons "h" title)
+ (cons "r" raw-title)
+ (cons "H" (if (equal raw-title "") ""
+ (format "{%s}" raw-title)))
+ (cons "U" (if (equal raw-title "") ""
+ (format "[%s]" raw-title))))))
+ "\n"))
+ contents
+ ;; Block's closing string, if any.
+ (and (nth 3 env-format) (concat (nth 3 env-format) "\n"))
+ (when column-width "\\end{column}\n")
+ (when end-columns-p "\\end{columns}"))))
+
+(defun org-beamer-headline (headline contents info)
+ "Transcode HEADLINE element into Beamer code.
+CONTENTS is the contents of the headline. INFO is a plist used
+as a communication channel."
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info))
+ (frame-level (org-beamer--frame-level headline info))
+ (environment (let ((env (org-element-property :BEAMER_ENV headline)))
+ (or (org-string-nw-p env) "block"))))
+ (cond
+ ;; Case 1: Resume frame specified by "BEAMER_ref" property.
+ ((equal environment "againframe")
+ (let ((ref (org-element-property :BEAMER_REF headline)))
+ ;; Reference to frame being resumed is mandatory. Ignore
+ ;; the whole headline if it isn't provided.
+ (when (org-string-nw-p ref)
+ (concat "\\againframe"
+ ;; Overlay specification.
+ (let ((overlay (org-element-property :BEAMER_ACT headline)))
+ (when overlay
+ (org-beamer--normalize-argument
+ overlay
+ (if (string-match "^\\[.*\\]$" overlay) 'defaction
+ 'action))))
+ ;; Options.
+ (let ((options (org-element-property :BEAMER_OPT headline)))
+ (when options
+ (org-beamer--normalize-argument options 'option)))
+ ;; Resolve reference provided by "BEAMER_ref"
+ ;; property. This is done by building a minimal fake
+ ;; link and calling the appropriate resolve function,
+ ;; depending on the reference syntax.
+ (let* ((type
+ (progn
+ (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref)
+ (cond
+ ((or (not (match-string 1 ref))
+ (equal (match-string 1 ref) "*")) 'fuzzy)
+ ((equal (match-string 1 ref) "id:") 'id)
+ (t 'custom-id))))
+ (link (list 'link (list :path (match-string 2 ref))))
+ (target (if (eq type 'fuzzy)
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ ;; Now use user-defined label provided in TARGET
+ ;; headline, or fallback to standard one.
+ (format "{%s}" (org-beamer--get-label target info)))))))
+ ;; Case 2: Creation of an appendix is requested.
+ ((equal environment "appendix")
+ (concat "\\appendix"
+ (org-element-property :BEAMER_ACT headline)
+ "\n"
+ (make-string (org-element-property :pre-blank headline) ?\n)
+ contents))
+ ;; Case 3: Ignore heading.
+ ((equal environment "ignoreheading")
+ (concat (make-string (org-element-property :pre-blank headline) ?\n)
+ contents))
+ ;; Case 4: HEADLINE is a note.
+ ((member environment '("note" "noteNH"))
+ (format "\\note{%s}"
+ (concat (and (equal environment "note")
+ (concat
+ (org-export-data
+ (org-element-property :title headline) info)
+ "\n"))
+ (org-trim contents))))
+ ;; Case 5: HEADLINE is a frame.
+ ((= level frame-level)
+ (org-beamer--format-frame headline contents info))
+ ;; Case 6: Regular section, extracted from
+ ;; `org-latex-classes'.
+ ((< level frame-level)
+ (org-beamer--format-section headline contents info))
+ ;; Case 7: Otherwise, HEADLINE is a block.
+ (t (org-beamer--format-block headline contents info))))))
+
+
+;;;; Item
+
+(defun org-beamer-item (item contents info)
+ "Transcode an ITEM element into Beamer code.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let ((action (let ((first-element (car (org-element-contents item))))
+ (and (eq (org-element-type first-element) 'paragraph)
+ (org-beamer--element-has-overlay-p first-element))))
+ (output (org-export-with-backend 'latex item contents info)))
+ (if (or (not action) (not (string-match "\\\\item" output))) output
+ ;; If the item starts with a paragraph and that paragraph starts
+ ;; with an export snippet specifying an overlay, insert it after
+ ;; \item command.
+ (replace-match (concat "\\\\item" action) nil nil output))))
+
+
+;;;; Keyword
+
+(defun org-beamer-keyword (keyword contents info)
+ "Transcode a KEYWORD element into Beamer code.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ ;; Handle specifically BEAMER and TOC (headlines only) keywords.
+ ;; Otherwise, fallback to `latex' back-end.
+ (cond
+ ((equal key "BEAMER") value)
+ ((and (equal key "TOC") (string-match "\\<headlines\\>" value))
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc)))
+ (options (and (string-match "\\[.*?\\]" value)
+ (match-string 0 value))))
+ (concat
+ (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth))
+ "\\tableofcontents" options)))
+ (t (org-export-with-backend 'latex keyword contents info)))))
+
+
+;;;; Link
+
+(defun org-beamer-link (link contents info)
+ "Transcode a LINK object into Beamer code.
+CONTENTS is the description part of the link. INFO is a plist
+used as a communication channel."
+ (let ((type (org-element-property :type link))
+ (path (org-element-property :path link)))
+ ;; Use \hyperlink command for all internal links.
+ (cond
+ ((equal type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) contents
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-beamer--element-has-overlay-p link) "")
+ (org-export-solidify-link-text
+ (org-element-property :value destination))
+ contents))))
+ ((and (member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ (headline
+ (let ((label
+ (format "sec-%s"
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number
+ destination info)
+ "-"))))
+ (if (and (plist-get info :section-numbers) (not contents))
+ (format "\\ref{%s}" label)
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-beamer--element-has-overlay-p link) "")
+ label
+ contents))))
+ (target
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not contents) (format "\\ref{%s}" path)
+ (format "\\hyperlink%s{%s}{%s}"
+ (or (org-beamer--element-has-overlay-p link) "")
+ path
+ contents))))))))
+ ;; Otherwise, use `latex' back-end.
+ (t (org-export-with-backend 'latex link contents info)))))
+
+
+;;;; Plain List
+;;
+;; Plain lists support `:environment', `:overlay' and `:options'
+;; attributes.
+
+(defun org-beamer-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element into Beamer code.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (attributes (org-combine-plists
+ (org-export-read-attribute :attr_latex plain-list)
+ (org-export-read-attribute :attr_beamer plain-list)))
+ (latex-type (let ((env (plist-get attributes :environment)))
+ (cond (env)
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'descriptive) "description")
+ (t "itemize")))))
+ (org-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s%s\n%s\\end{%s}"
+ latex-type
+ ;; Default overlay specification, if any.
+ (org-beamer--normalize-argument
+ (or (plist-get attributes :overlay) "")
+ 'defaction)
+ ;; Second optional argument depends on the list type.
+ (org-beamer--normalize-argument
+ (or (plist-get attributes :options) "")
+ 'option)
+ ;; Eventually insert contents and close environment.
+ contents
+ latex-type))))
+
+
+;;;; Radio Target
+
+(defun org-beamer-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object into Beamer code.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "\\hypertarget%s{%s}{%s}"
+ (or (org-beamer--element-has-overlay-p radio-target) "")
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+
+;;;; Target
+
+(defun org-beamer-target (target contents info)
+ "Transcode a TARGET object into Beamer code.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\hypertarget{%s}{}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Template
+;;
+;; Template used is similar to the one used in `latex' back-end,
+;; excepted for the table of contents and Beamer themes.
+
+(defun org-beamer-template (contents info)
+ "Return complete document string after Beamer conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let ((title (org-export-data (plist-get info :title) info)))
+ (concat
+ ;; 1. Time-stamp.
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; 2. Document class and packages.
+ (let* ((class (plist-get info :latex-class))
+ (class-options (plist-get info :latex-class-options))
+ (header (nth 1 (assoc class org-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if (not class-options) header
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
+ class-options header t nil 1)))))
+ (if (not document-class-string)
+ (user-error "Unknown LaTeX class `%s'" class)
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-element-normalize-string
+ (org-splice-latex-header
+ document-class-string
+ org-latex-default-packages-alist
+ org-latex-packages-alist nil
+ (concat (org-element-normalize-string
+ (plist-get info :latex-header))
+ (org-element-normalize-string
+ (plist-get info :latex-header-extra))
+ (plist-get info :beamer-header-extra)))))
+ info)))
+ ;; 3. Insert themes.
+ (let ((format-theme
+ (function
+ (lambda (prop command)
+ (let ((theme (plist-get info prop)))
+ (when theme
+ (concat command
+ (if (not (string-match "\\[.*\\]" theme))
+ (format "{%s}\n" theme)
+ (format "%s{%s}\n"
+ (match-string 0 theme)
+ (org-trim
+ (replace-match "" nil nil theme)))))))))))
+ (mapconcat (lambda (args) (apply format-theme args))
+ '((:beamer-theme "\\usetheme")
+ (:beamer-color-theme "\\usecolortheme")
+ (:beamer-font-theme "\\usefonttheme")
+ (:beamer-inner-theme "\\useinnertheme")
+ (:beamer-outer-theme "\\useoutertheme"))
+ ""))
+ ;; 4. Possibly limit depth for headline numbering.
+ (let ((sec-num (plist-get info :section-numbers)))
+ (when (integerp sec-num)
+ (format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
+ ;; 5. Author.
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info))))
+ (cond ((and author email (not (string= "" email)))
+ (format "\\author{%s\\thanks{%s}}\n" author email))
+ (author (format "\\author{%s}\n" author))
+ (t "\\author{}\n")))
+ ;; 6. Date.
+ (let ((date (and (plist-get info :with-date) (org-export-get-date info))))
+ (format "\\date{%s}\n" (org-export-data date info)))
+ ;; 7. Title
+ (format "\\title{%s}\n" title)
+ ;; 8. Hyperref options.
+ (when (plist-get info :latex-hyperref-p)
+ (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
+ (or (plist-get info :keywords) "")
+ (or (plist-get info :description) "")
+ (if (not (plist-get info :with-creator)) ""
+ (plist-get info :creator))))
+ ;; 9. Document start.
+ "\\begin{document}\n\n"
+ ;; 10. Title command.
+ (org-element-normalize-string
+ (cond ((string= "" title) nil)
+ ((not (stringp org-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-latex-title-command)
+ (format org-latex-title-command title))
+ (t org-latex-title-command)))
+ ;; 11. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (format "\\begin{frame}%s{%s}\n"
+ (org-beamer--normalize-argument
+ org-beamer-outline-frame-options 'option)
+ org-beamer-outline-frame-title)
+ (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%d}\n" depth))
+ "\\tableofcontents\n"
+ "\\end{frame}\n\n")))
+ ;; 12. Document's body.
+ contents
+ ;; 13. Creator.
+ (let ((creator-info (plist-get info :with-creator)))
+ (cond
+ ((not creator-info) "")
+ ((eq creator-info 'comment)
+ (format "%% %s\n" (plist-get info :creator)))
+ (t (concat (plist-get info :creator) "\n"))))
+ ;; 14. Document end.
+ "\\end{document}")))
+
+
+
+;;; Minor Mode
+
+
+(defvar org-beamer-mode-map (make-sparse-keymap)
+ "The keymap for `org-beamer-mode'.")
+(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment)
+
+;;;###autoload
+(define-minor-mode org-beamer-mode
+ "Support for editing Beamer oriented Org mode files."
+ nil " Bm" 'org-beamer-mode-map)
+
+(when (fboundp 'font-lock-add-keywords)
+ (font-lock-add-keywords
+ 'org-mode
+ '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend))
+ 'prepend))
+
+(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40))))
+ "The special face for beamer tags."
+ :group 'org-export-beamer)
+
+(defun org-beamer-property-changed (property value)
+ "Track the BEAMER_env property with tags.
+PROPERTY is the name of the modified property. VALUE is its new
+value."
+ (cond
+ ((equal property "BEAMER_env")
+ (save-excursion
+ (org-back-to-heading t)
+ ;; Filter out Beamer-related tags and install environment tag.
+ (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x))
+ (org-get-tags)))
+ (env-tag (and (org-string-nw-p value) (concat "B_" value))))
+ (org-set-tags-to (if env-tag (cons env-tag tags) tags))
+ (when env-tag (org-toggle-tag env-tag 'on)))))
+ ((equal property "BEAMER_col")
+ (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off)))))
+
+(add-hook 'org-property-changed-functions 'org-beamer-property-changed)
+
+(defun org-beamer-allowed-property-values (property)
+ "Supply allowed values for PROPERTY."
+ (cond
+ ((and (equal property "BEAMER_env")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_env have been defined,
+ ;; supply all defined environments
+ (mapcar 'car (append org-beamer-environments-special
+ org-beamer-environments-extra
+ org-beamer-environments-default)))
+ ((and (equal property "BEAMER_col")
+ (not (org-entry-get nil (concat property "_ALL") 'inherit)))
+ ;; If no allowed values for BEAMER_col have been defined,
+ ;; supply some
+ (org-split-string org-beamer-column-widths " "))))
+
+(add-hook 'org-property-allowed-value-functions
+ 'org-beamer-allowed-property-values)
+
+
+
+;;; Commands
+
+;;;###autoload
+(defun org-beamer-export-as-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a Beamer buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org BEAMER Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'beamer "*Org BEAMER Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+;;;###autoload
+(defun org-beamer-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a Beamer presentation (tex).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-beamer-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a Beamer presentation (PDF).
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return PDF file's name."
+ (interactive)
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+;;;###autoload
+(defun org-beamer-select-environment ()
+ "Select the environment to be used by beamer for this entry.
+While this uses (for convenience) a tag selection interface, the
+result of this command will be that the BEAMER_env *property* of
+the entry is set.
+
+In addition to this, the command will also set a tag as a visual
+aid, but the tag does not have any semantic meaning."
+ (interactive)
+ ;; Make sure `org-beamer-environments-special' has a higher
+ ;; priority than `org-beamer-environments-extra'.
+ (let* ((envs (append org-beamer-environments-special
+ org-beamer-environments-extra
+ org-beamer-environments-default))
+ (org-tag-alist
+ (append '((:startgroup))
+ (mapcar (lambda (e) (cons (concat "B_" (car e))
+ (string-to-char (nth 1 e))))
+ envs)
+ '((:endgroup))
+ '(("BMCOL" . ?|))))
+ (org-tag-persistent-alist nil)
+ (org-use-fast-tag-selection t)
+ (org-fast-tag-selection-single-key t))
+ (org-set-tags)
+ (let ((tags (or (ignore-errors (org-get-tags-string)) "")))
+ (cond
+ ;; For a column, automatically ask for its width.
+ ((eq org-last-tag-selection-key ?|)
+ (if (string-match ":BMCOL:" tags)
+ (org-set-property "BEAMER_col" (read-string "Column width: "))
+ (org-delete-property "BEAMER_col")))
+ ;; For an "againframe" section, automatically ask for reference
+ ;; to resumed frame and overlay specifications.
+ ((eq org-last-tag-selection-key ?A)
+ (if (equal (org-entry-get nil "BEAMER_env") "againframe")
+ (progn (org-entry-delete nil "BEAMER_env")
+ (org-entry-delete nil "BEAMER_ref")
+ (org-entry-delete nil "BEAMER_act"))
+ (org-entry-put nil "BEAMER_env" "againframe")
+ (org-set-property
+ "BEAMER_ref"
+ (read-string "Frame reference (*Title, #custom-id, id:...): "))
+ (org-set-property "BEAMER_act"
+ (read-string "Overlay specification: "))))
+ ((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags)
+ (org-entry-put nil "BEAMER_env" (match-string 1 tags)))
+ (t (org-entry-delete nil "BEAMER_env"))))))
+
+;;;###autoload
+(defun org-beamer-insert-options-template (&optional kind)
+ "Insert a settings template, to make sure users do this right."
+ (interactive (progn
+ (message "Current [s]ubtree or [g]lobal?")
+ (if (eq (read-char-exclusive) ?g) (list 'global)
+ (list 'subtree))))
+ (if (eq kind 'subtree)
+ (progn
+ (org-back-to-heading t)
+ (org-reveal)
+ (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer")
+ (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]")
+ (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
+ (when org-beamer-column-view-format
+ (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
+ (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths))
+ (insert "#+LaTeX_CLASS: beamer\n")
+ (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
+ (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n"))
+ (when org-beamer-column-view-format
+ (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
+ (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n")))
+
+;;;###autoload
+(defun org-beamer-publish-to-latex (plist filename pub-dir)
+ "Publish an Org file to a Beamer presentation (LaTeX).
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'beamer filename ".tex" plist pub-dir))
+
+;;;###autoload
+(defun org-beamer-publish-to-pdf (plist filename pub-dir)
+ "Publish an Org file to a Beamer presentation (PDF, via LaTeX).
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in
+ ;; working directory and then moved to publishing directory.
+ (org-publish-attachment
+ plist
+ (org-latex-compile
+ (org-publish-org-to
+ 'beamer filename ".tex" plist (file-name-directory filename)))
+ pub-dir))
+
+
+(provide 'ox-beamer)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-beamer.el ends here
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
new file mode 100644
index 00000000000..2b2d92ee2fc
--- /dev/null
+++ b/lisp/org/ox-html.el
@@ -0,0 +1,3437 @@
+;;; ox-html.el --- HTML Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a HTML back-end for Org generic exporter.
+;; See Org manual for more information.
+
+;;; Code:
+
+;;; Dependencies
+
+(require 'ox)
+(require 'ox-publish)
+(require 'format-spec)
+(eval-when-compile (require 'cl) (require 'table nil 'noerror))
+
+
+;;; Function Declarations
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function htmlize-region "ext:htmlize" (beg end))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
+(declare-function mm-url-decode-entities "mm-url" ())
+
+;;; Define Back-End
+
+(org-export-define-backend 'html
+ '((bold . org-html-bold)
+ (center-block . org-html-center-block)
+ (clock . org-html-clock)
+ (code . org-html-code)
+ (drawer . org-html-drawer)
+ (dynamic-block . org-html-dynamic-block)
+ (entity . org-html-entity)
+ (example-block . org-html-example-block)
+ (export-block . org-html-export-block)
+ (export-snippet . org-html-export-snippet)
+ (fixed-width . org-html-fixed-width)
+ (footnote-definition . org-html-footnote-definition)
+ (footnote-reference . org-html-footnote-reference)
+ (headline . org-html-headline)
+ (horizontal-rule . org-html-horizontal-rule)
+ (inline-src-block . org-html-inline-src-block)
+ (inlinetask . org-html-inlinetask)
+ (inner-template . org-html-inner-template)
+ (italic . org-html-italic)
+ (item . org-html-item)
+ (keyword . org-html-keyword)
+ (latex-environment . org-html-latex-environment)
+ (latex-fragment . org-html-latex-fragment)
+ (line-break . org-html-line-break)
+ (link . org-html-link)
+ (paragraph . org-html-paragraph)
+ (plain-list . org-html-plain-list)
+ (plain-text . org-html-plain-text)
+ (planning . org-html-planning)
+ (property-drawer . org-html-property-drawer)
+ (quote-block . org-html-quote-block)
+ (quote-section . org-html-quote-section)
+ (radio-target . org-html-radio-target)
+ (section . org-html-section)
+ (special-block . org-html-special-block)
+ (src-block . org-html-src-block)
+ (statistics-cookie . org-html-statistics-cookie)
+ (strike-through . org-html-strike-through)
+ (subscript . org-html-subscript)
+ (superscript . org-html-superscript)
+ (table . org-html-table)
+ (table-cell . org-html-table-cell)
+ (table-row . org-html-table-row)
+ (target . org-html-target)
+ (template . org-html-template)
+ (timestamp . org-html-timestamp)
+ (underline . org-html-underline)
+ (verbatim . org-html-verbatim)
+ (verse-block . org-html-verse-block))
+ :export-block "HTML"
+ :filters-alist '((:filter-options . org-html-infojs-install-script)
+ (:filter-final-output . org-html-final-function))
+ :menu-entry
+ '(?h "Export to HTML"
+ ((?H "As HTML buffer" org-html-export-as-html)
+ (?h "As HTML file" org-html-export-to-html)
+ (?o "As HTML file and open"
+ (lambda (a s v b)
+ (if a (org-html-export-to-html t s v b)
+ (org-open-file (org-html-export-to-html nil s v b)))))))
+ :options-alist
+ '((:html-extension nil nil org-html-extension)
+ (:html-link-org-as-html nil nil org-html-link-org-files-as-html)
+ (:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
+ (:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
+ (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
+ (:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
+ (:html-link-up "HTML_LINK_UP" nil org-html-link-up)
+ (:html-mathjax "HTML_MATHJAX" nil "" space)
+ (:html-postamble nil "html-postamble" org-html-postamble)
+ (:html-preamble nil "html-preamble" org-html-preamble)
+ (:html-head "HTML_HEAD" nil org-html-head newline)
+ (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline)
+ (:html-head-include-default-style nil "html-style" org-html-head-include-default-style)
+ (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts)
+ (:html-table-attributes nil nil org-html-table-default-attributes)
+ (:html-table-row-tags nil nil org-html-table-row-tags)
+ (:html-xml-declaration nil nil org-html-xml-declaration)
+ (:html-inline-images nil nil org-html-inline-images)
+ (:infojs-opt "INFOJS_OPT" nil nil)
+ ;; Redefine regular options.
+ (:creator "CREATOR" nil org-html-creator-string)
+ (:with-latex nil "tex" org-html-with-latex)
+ ;; Retrieve LaTeX header for fragments.
+ (:latex-header "LATEX_HEADER" nil nil newline)))
+
+
+;;; Internal Variables
+
+(defvar org-html-format-table-no-css)
+(defvar htmlize-buffer-places) ; from htmlize.el
+
+(defvar org-html--pre/postamble-class "status"
+ "CSS class used for pre/postamble")
+
+(defconst org-html-doctype-alist
+ '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
+\"http://www.w3.org/TR/html4/strict.dtd\">")
+ ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+\"http://www.w3.org/TR/html4/loose.dtd\">")
+ ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\"
+\"http://www.w3.org/TR/html4/frameset.dtd\">")
+
+ ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
+ ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">")
+ ("xhtml-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">")
+ ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">")
+
+ ("html5" . "<!DOCTYPE html>")
+ ("xhtml5" . "<!DOCTYPE html>"))
+ "An alist mapping (x)html flavors to specific doctypes.")
+
+(defconst org-html-html5-elements
+ '("article" "aside" "audio" "canvas" "details" "figcaption"
+ "figure" "footer" "header" "menu" "meter" "nav" "output"
+ "progress" "section" "video")
+ "New elements in html5.
+
+For blocks that should contain headlines, use the HTML_CONTAINER
+property on the headline itself.")
+
+(defconst org-html-special-string-regexps
+ '(("\\\\-" . "&#x00ad;") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-html-scripts
+ "<script type=\"text/javascript\">
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012-2013 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+<!--/*--><![CDATA[/*><!--*/
+ function CodeHighlightOn(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(null != target) {
+ elem.cacheClassElem = elem.className;
+ elem.cacheClassTarget = target.className;
+ target.className = \"code-highlighted\";
+ elem.className = \"code-highlighted\";
+ }
+ }
+ function CodeHighlightOff(elem, id)
+ {
+ var target = document.getElementById(id);
+ if(elem.cacheClassElem)
+ elem.className = elem.cacheClassElem;
+ if(elem.cacheClassTarget)
+ target.className = elem.cacheClassTarget;
+ }
+/*]]>*///-->
+</script>"
+ "Basic JavaScript that is needed by HTML files produced by Org mode.")
+
+(defconst org-html-style-default
+ "<style type=\"text/css\">
+ <!--/*--><![CDATA[/*><!--*/
+ .title { text-align: center; }
+ .todo { font-family: monospace; color: red; }
+ .done { color: green; }
+ .tag { background-color: #eee; font-family: monospace;
+ padding: 2px; font-size: 80%; font-weight: normal; }
+ .timestamp { color: #bebebe; }
+ .timestamp-kwd { color: #5f9ea0; }
+ .right { margin-left: auto; margin-right: 0px; text-align: right; }
+ .left { margin-left: 0px; margin-right: auto; text-align: left; }
+ .center { margin-left: auto; margin-right: auto; text-align: center; }
+ .underline { text-decoration: underline; }
+ #postamble p, #preamble p { font-size: 90%; margin: .2em; }
+ p.verse { margin-left: 3%; }
+ pre {
+ border: 1px solid #ccc;
+ box-shadow: 3px 3px 3px #eee;
+ padding: 8pt;
+ font-family: monospace;
+ overflow: auto;
+ margin: 1.2em;
+ }
+ pre.src {
+ position: relative;
+ overflow: visible;
+ padding-top: 1.2em;
+ }
+ pre.src:before {
+ display: none;
+ position: absolute;
+ background-color: white;
+ top: -10px;
+ right: 10px;
+ padding: 3px;
+ border: 1px solid black;
+ }
+ pre.src:hover:before { display: inline;}
+ pre.src-sh:before { content: 'sh'; }
+ pre.src-bash:before { content: 'sh'; }
+ pre.src-emacs-lisp:before { content: 'Emacs Lisp'; }
+ pre.src-R:before { content: 'R'; }
+ pre.src-perl:before { content: 'Perl'; }
+ pre.src-java:before { content: 'Java'; }
+ pre.src-sql:before { content: 'SQL'; }
+
+ table { border-collapse:collapse; }
+ caption.t-above { caption-side: top; }
+ caption.t-bottom { caption-side: bottom; }
+ td, th { vertical-align:top; }
+ th.right { text-align: center; }
+ th.left { text-align: center; }
+ th.center { text-align: center; }
+ td.right { text-align: right; }
+ td.left { text-align: left; }
+ td.center { text-align: center; }
+ dt { font-weight: bold; }
+ .footpara:nth-child(2) { display: inline; }
+ .footpara { display: block; }
+ .footdef { margin-bottom: 1em; }
+ .figure { padding: 1em; }
+ .figure p { text-align: center; }
+ .inlinetask {
+ padding: 10px;
+ border: 2px solid gray;
+ margin: 10px;
+ background: #ffffcc;
+ }
+ #org-div-home-and-up
+ { text-align: right; font-size: 70%; white-space: nowrap; }
+ textarea { overflow-x: auto; }
+ .linenr { font-size: smaller }
+ .code-highlighted { background-color: #ffff00; }
+ .org-info-js_info-navigation { border-style: none; }
+ #org-info-js_console-label
+ { font-size: 10px; font-weight: bold; white-space: nowrap; }
+ .org-info-js_search-highlight
+ { background-color: #ffff00; color: #000000; font-weight: bold; }
+ /*]]>*/-->
+</style>"
+ "The default style specification for exported HTML files.
+You can use `org-html-head' and `org-html-head-extra' to add to
+this style. If you don't want to include this default style,
+customize `org-html-head-include-default-style'.")
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-html nil
+ "Options for exporting Org mode files to HTML."
+ :tag "Org Export HTML"
+ :group 'org-export)
+
+;;;; Handle infojs
+
+(defvar org-html-infojs-opts-table
+ '((path PATH "http://orgmode.org/org-info.js")
+ (view VIEW "info")
+ (toc TOC :with-toc)
+ (ftoc FIXED_TOC "0")
+ (tdepth TOC_DEPTH "max")
+ (sdepth SECTION_DEPTH "max")
+ (mouse MOUSE_HINT "underline")
+ (buttons VIEW_BUTTONS "0")
+ (ltoc LOCAL_TOC "1")
+ (up LINK_UP :html-link-up)
+ (home LINK_HOME :html-link-home))
+ "JavaScript options, long form for script, default values.")
+
+(defcustom org-html-use-infojs 'when-configured
+ "Non-nil when Sebastian Rose's Java Script org-info.js should be active.
+This option can be nil or t to never or always use the script.
+It can also be the symbol `when-configured', meaning that the
+script will be linked into the export file if and only if there
+is a \"#+INFOJS_OPT:\" line in the buffer. See also the variable
+`org-html-infojs-options'."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "When configured in buffer" when-configured)
+ (const :tag "Always" t)))
+
+(defcustom org-html-infojs-options
+ (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table)
+ "Options settings for the INFOJS JavaScript.
+Each of the options must have an entry in `org-html-infojs-opts-table'.
+The value can either be a string that will be passed to the script, or
+a property. This property is then assumed to be a property that is defined
+by the Export/Publishing setup of Org.
+The `sdepth' and `tdepth' parameters can also be set to \"max\", which
+means to use the maximum value consistent with other options."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type
+ `(set :greedy t :inline t
+ ,@(mapcar
+ (lambda (x)
+ (list 'cons (list 'const (car x))
+ '(choice
+ (symbol :tag "Publishing/Export property")
+ (string :tag "Value"))))
+ org-html-infojs-opts-table)))
+
+(defcustom org-html-infojs-template
+ "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
+/**
+ *
+ * @source: %SCRIPT_PATH
+ *
+ * @licstart The following is the entire license notice for the
+ * JavaScript code in %SCRIPT_PATH.
+ *
+ * Copyright (C) 2012-2013 Free Software Foundation, Inc.
+ *
+ *
+ * The JavaScript code in this tag is free software: you can
+ * redistribute it and/or modify it under the terms of the GNU
+ * General Public License (GNU GPL) as published by the Free Software
+ * Foundation, either version 3 of the License, or (at your option)
+ * any later version. The code is distributed WITHOUT ANY WARRANTY;
+ * without even the implied warranty of MERCHANTABILITY or FITNESS
+ * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+ *
+ * As additional permission under GNU GPL version 3 section 7, you
+ * may distribute non-source (e.g., minimized or compacted) forms of
+ * that code without the copy of the GNU GPL normally required by
+ * section 4, provided you include this license notice and a URL
+ * through which recipients can access the Corresponding Source.
+ *
+ * @licend The above is the entire license notice
+ * for the JavaScript code in %SCRIPT_PATH.
+ *
+ */
+</script>
+
+<script type=\"text/javascript\">
+
+/*
+@licstart The following is the entire license notice for the
+JavaScript code in this tag.
+
+Copyright (C) 2012-2013 Free Software Foundation, Inc.
+
+The JavaScript code in this tag is free software: you can
+redistribute it and/or modify it under the terms of the GNU
+General Public License (GNU GPL) as published by the Free Software
+Foundation, either version 3 of the License, or (at your option)
+any later version. The code is distributed WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS
+FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
+
+As additional permission under GNU GPL version 3 section 7, you
+may distribute non-source (e.g., minimized or compacted) forms of
+that code without the copy of the GNU GPL normally required by
+section 4, provided you include this license notice and a URL
+through which recipients can access the Corresponding Source.
+
+
+@licend The above is the entire license notice
+for the JavaScript code in this tag.
+*/
+
+<!--/*--><![CDATA[/*><!--*/
+%MANAGER_OPTIONS
+org_html_manager.setup(); // activate after the parameters are set
+/*]]>*///-->
+</script>"
+ "The template for the export style additions when org-info.js is used.
+Option settings will replace the %MANAGER-OPTIONS cookie."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defun org-html-infojs-install-script (exp-plist backend)
+ "Install script in export options when appropriate.
+EXP-PLIST is a plist containing export options. BACKEND is the
+export back-end currently used."
+ (unless (or (memq 'body-only (plist-get exp-plist :export-options))
+ (not org-html-use-infojs)
+ (and (eq org-html-use-infojs 'when-configured)
+ (or (not (plist-get exp-plist :infojs-opt))
+ (string= "" (plist-get exp-plist :infojs-opt))
+ (string-match "\\<view:nil\\>"
+ (plist-get exp-plist :infojs-opt)))))
+ (let* ((template org-html-infojs-template)
+ (ptoc (plist-get exp-plist :with-toc))
+ (hlevels (plist-get exp-plist :headline-levels))
+ (sdepth hlevels)
+ (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels))
+ (options (plist-get exp-plist :infojs-opt))
+ (table org-html-infojs-opts-table)
+ style)
+ (dolist (entry table)
+ (let* ((opt (car entry))
+ (var (nth 1 entry))
+ ;; Compute default values for script option OPT from
+ ;; `org-html-infojs-options' variable.
+ (default
+ (let ((default (cdr (assq opt org-html-infojs-options))))
+ (if (and (symbolp default) (not (memq default '(t nil))))
+ (plist-get exp-plist default)
+ default)))
+ ;; Value set through INFOJS_OPT keyword has precedence
+ ;; over the default one.
+ (val (if (and options
+ (string-match (format "\\<%s:\\(\\S-+\\)" opt)
+ options))
+ (match-string 1 options)
+ default)))
+ (case opt
+ (path (setq template
+ (replace-regexp-in-string
+ "%SCRIPT_PATH" val template t t)))
+ (sdepth (when (integerp (read val))
+ (setq sdepth (min (read val) sdepth))))
+ (tdepth (when (integerp (read val))
+ (setq tdepth (min (read val) tdepth))))
+ (otherwise (setq val
+ (cond
+ ((or (eq val t) (equal val "t")) "1")
+ ((or (eq val nil) (equal val "nil")) "0")
+ ((stringp val) val)
+ (t (format "%s" val))))
+ (push (cons var val) style)))))
+ ;; Now we set the depth of the *generated* TOC to SDEPTH,
+ ;; because the toc will actually determine the splitting. How
+ ;; much of the toc will actually be displayed is governed by the
+ ;; TDEPTH option.
+ (setq exp-plist (plist-put exp-plist :with-toc sdepth))
+ ;; The table of contents should not show more sections than we
+ ;; generate.
+ (setq tdepth (min tdepth sdepth))
+ (push (cons "TOC_DEPTH" tdepth) style)
+ ;; Build style string.
+ (setq style (mapconcat
+ (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x)
+ (cdr x)))
+ style "\n"))
+ (when (and style (> (length style) 0))
+ (and (string-match "%MANAGER_OPTIONS" template)
+ (setq style (replace-match style t t template))
+ (setq exp-plist
+ (plist-put
+ exp-plist :html-head-extra
+ (concat (or (plist-get exp-plist :html-head-extra) "")
+ "\n"
+ style)))))
+ ;; This script absolutely needs the table of contents, so we
+ ;; change that setting.
+ (unless (plist-get exp-plist :with-toc)
+ (setq exp-plist (plist-put exp-plist :with-toc t)))
+ ;; Return the modified property list.
+ exp-plist)))
+
+;;;; Bold, etc.
+
+(defcustom org-html-text-markup-alist
+ '((bold . "<b>%s</b>")
+ (code . "<code>%s</code>")
+ (italic . "<i>%s</i>")
+ (strike-through . "<del>%s</del>")
+ (underline . "<span class=\"underline\">%s</span>")
+ (verbatim . "<code>%s</code>"))
+ "Alist of HTML expressions to convert text markup.
+
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underline' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (symbol :tag "Markup type")
+ :value-type (string :tag "Format string"))
+ :options '(bold code italic strike-through underline verbatim))
+
+(defcustom org-html-indent nil
+ "Non-nil means to indent the generated HTML.
+Warning: non-nil may break indentation of source code blocks."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-html-use-unicode-chars nil
+ "Non-nil means to use unicode characters instead of HTML entities."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Drawers
+
+(defcustom org-html-format-drawer-function
+ (lambda (name contents) contents)
+ "Function called to format a drawer in HTML code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behavior:
+
+The default value simply returns the value of CONTENTS."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+;;;; Footnotes
+
+(defcustom org-html-footnotes-section "<div id=\"footnotes\">
+<h2 class=\"footnotes\">%s: </h2>
+<div id=\"text-footnotes\">
+%s
+</div>
+</div>"
+ "Format for the footnotes section.
+Should contain a two instances of %s. The first will be replaced with the
+language-specific word for \"Footnotes\", the second one will be replaced
+by the footnotes themselves."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-footnote-format "<sup>%s</sup>"
+ "The format for the footnote reference.
+%s will be replaced by the footnote reference itself."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-footnote-separator "<sup>, </sup>"
+ "Text used to separate footnotes."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Headline
+
+(defcustom org-html-toplevel-hlevel 2
+ "The <H> level for level 1 headings in HTML export.
+This is also important for the classes that will be wrapped around headlines
+and outline structure. If this variable is 1, the top-level headlines will
+be <h1>, and the corresponding classes will be outline-1, section-number-1,
+and outline-text-1. If this is 2, all of these will get a 2 instead.
+The default for this variable is 2, because we use <h1> for formatting the
+document title."
+ :group 'org-export-html
+ :type 'integer)
+
+(defcustom org-html-format-headline-function 'ignore
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags (string or nil).
+
+The function result will be used in the section format string."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+;;;; HTML-specific
+
+(defcustom org-html-allow-name-attribute-in-anchors t
+ "When nil, do not set \"name\" attribute in anchors.
+By default, anchors are formatted with both \"id\" and \"name\"
+attributes, when appropriate."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Inlinetasks
+
+(defcustom org-html-format-inlinetask-function 'ignore
+ "Function called to format an inlinetask in HTML code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+;;;; LaTeX
+
+(defcustom org-html-with-latex org-export-with-latex
+ "Non-nil means process LaTeX math snippets.
+
+When set, the exporter will process LaTeX environments and
+fragments.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"tex:mathjax\". Allowed values are:
+
+nil Ignore math snippets.
+`verbatim' Keep everything in verbatim
+`dvipng' Process the LaTeX fragments to images. This will also
+ include processing of non-math environments.
+`imagemagick' Convert the LaTeX fragments to pdf files and use
+ imagemagick to convert pdf files to png files.
+`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+t Synonym for `mathjax'."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (const :tag "Use dvipng to make images" dvipng)
+ (const :tag "Use imagemagick to make images" imagemagick)
+ (const :tag "Use MathJax to display math" mathjax)
+ (const :tag "Leave math verbatim" verbatim)))
+
+;;;; Links :: Generic
+
+(defcustom org-html-link-org-files-as-html t
+ "Non-nil means make file links to `file.org' point to `file.html'.
+When `org-mode' is exporting an `org-mode' file to HTML, links to
+non-html files are directly put into a href tag in HTML.
+However, links to other Org-mode files (recognized by the
+extension `.org') should become links to the corresponding html
+file, assuming that the linked `org-mode' file will also be
+converted to HTML.
+When nil, the links still point to the plain `.org' file."
+ :group 'org-export-html
+ :type 'boolean)
+
+;;;; Links :: Inline images
+
+(defcustom org-html-inline-images t
+ "Non-nil means inline images into exported HTML pages.
+This is done using an <img> tag. When nil, an anchor with href is used to
+link to the image."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
+
+(defcustom org-html-inline-image-rules
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
+ ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
+ ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'"))
+ "Rules characterizing image files that can be inlined into HTML.
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+;;;; Plain Text
+
+(defcustom org-html-protect-char-alist
+ '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;"))
+ "Alist of characters to be converted by `org-html-protect'."
+ :group 'org-export-html
+ :type '(repeat (cons (string :tag "Character")
+ (string :tag "HTML equivalent"))))
+
+;;;; Src Block
+
+(defcustom org-html-htmlize-output-type 'inline-css
+ "Output type to be used by htmlize when formatting code snippets.
+Choices are `css', to export the CSS selectors only, or `inline-css', to
+export the CSS attribute values inline in the HTML. We use as default
+`inline-css', in order to make the resulting HTML self-containing.
+
+However, this will fail when using Emacs in batch mode for export, because
+then no rich font definitions are in place. It will also not be good if
+people with different Emacs setup contribute HTML files to a website,
+because the fonts will represent the individual setups. In these cases,
+it is much better to let Org/Htmlize assign classes only, and to use
+a style file to define the look of these classes.
+To get a start for your css file, start Emacs session and make sure that
+all the faces you are interested in are defined, for example by loading files
+in all modes you want. Then, use the command
+\\[org-html-htmlize-generate-css] to extract class definitions."
+ :group 'org-export-html
+ :type '(choice (const css) (const inline-css)))
+
+(defcustom org-html-htmlize-font-prefix "org-"
+ "The prefix for CSS class names for htmlize font specifications."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Table
+
+(defcustom org-html-table-default-attributes
+ '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides")
+ "Default attributes and values which will be used in table tags.
+This is a plist where attributes are symbols, starting with
+colons, and values are strings.
+
+When exporting to HTML5, these values will be disregarded."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(plist :key-type (symbol :tag "Property")
+ :value-type (string :tag "Value")))
+
+(defcustom org-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
+ "The opening tag for table header fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-html-table-use-header-tags-for-first-column'.
+See also the variable `org-html-table-align-individual-fields'."
+ :group 'org-export-html
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-html-table-data-tags '("<td%s>" . "</td>")
+ "The opening tag for table data fields.
+This is customizable so that alignment options can be specified.
+The first %s will be filled with the scope of the field, either row or col.
+The second %s will be replaced by a style entry to align the field.
+See also the variable `org-html-table-align-individual-fields'."
+ :group 'org-export-html
+ :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
+
+(defcustom org-html-table-row-tags '("<tr>" . "</tr>")
+ "The opening and ending tags for table rows.
+This is customizable so that alignment options can be specified.
+Instead of strings, these can be Lisp forms that will be
+evaluated for each row in order to construct the table row tags.
+
+During evaluation, these variables will be dynamically bound so that
+you can reuse them:
+
+ `row-number': row number (0 is the first row)
+ `rowgroup-number': group number of current row
+ `start-rowgroup-p': non-nil means the row starts a group
+ `end-rowgroup-p': non-nil means the row ends a group
+ `top-row-p': non-nil means this is the top row
+ `bottom-row-p': non-nil means this is the bottom row
+
+For example:
+
+\(setq org-html-table-row-tags
+ (cons \\='(cond (top-row-p \"<tr class=\\\"tr-top\\\">\")
+ (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\")
+ (t (if (= (mod row-number 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\")))
+ \"</tr>\"))
+
+will use the \"tr-top\" and \"tr-bottom\" classes for the top row
+and the bottom row, and otherwise alternate between \"tr-odd\" and
+\"tr-even\" for odd and even rows."
+ :group 'org-export-html
+ :type '(cons
+ (choice :tag "Opening tag"
+ (string :tag "Specify")
+ (sexp))
+ (choice :tag "Closing tag"
+ (string :tag "Specify")
+ (sexp))))
+
+(defcustom org-html-table-align-individual-fields t
+ "Non-nil means attach style attributes for alignment to each table field.
+When nil, alignment will only be specified in the column tags, but this
+is ignored by some browsers (like Firefox, Safari). Opera does it right
+though."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defcustom org-html-table-use-header-tags-for-first-column nil
+ "Non-nil means format column one in tables with header tags.
+When nil, also column one will use data tags."
+ :group 'org-export-html
+ :type 'boolean)
+
+(defcustom org-html-table-caption-above t
+ "When non-nil, place caption string at the beginning of the table.
+Otherwise, place it near the end."
+ :group 'org-export-html
+ :type 'boolean)
+
+;;;; Tags
+
+(defcustom org-html-tag-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each tag gets a class given by the tag itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Template :: Generic
+
+(defcustom org-html-extension "html"
+ "The extension for exported HTML files."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-xml-declaration
+ '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
+ ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
+ "The extension for exported HTML files.
+%s will be replaced with the charset of the exported file.
+This may be a string, or an alist with export extensions
+and corresponding declarations.
+
+This declaration only applies when exporting to XHTML."
+ :group 'org-export-html
+ :type '(choice
+ (string :tag "Single declaration")
+ (repeat :tag "Dependent on extension"
+ (cons (string :tag "Extension")
+ (string :tag "Declaration")))))
+
+(defcustom org-html-coding-system 'utf-8
+ "Coding system for HTML export.
+Use utf-8 as the default value."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'coding-system)
+
+(defcustom org-html-doctype "xhtml-strict"
+ "Document type definition to use for exported HTML files.
+Can be set with the in-buffer HTML_DOCTYPE property or for
+publishing, with :html-doctype."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-html-html5-fancy nil
+ "Non-nil means using new HTML5 elements.
+This variable is ignored for anything other than HTML5 export.
+
+For compatibility with Internet Explorer, it's probably a good
+idea to download some form of the html5shiv (for instance
+https://code.google.com/p/html5shiv/) and add it to your
+HTML_HEAD_EXTRA, so that your pages don't break for users of IE
+versions 8 and below."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-html-container-element "div"
+ "HTML element to use for wrapping top level sections.
+Can be set with the in-buffer HTML_CONTAINER property or for
+publishing, with :html-container.
+
+Note that changing the default will prevent you from using
+org-info.js for your website."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-html-divs
+ '((preamble "div" "preamble")
+ (content "div" "content")
+ (postamble "div" "postamble"))
+ "Alist of the three section elements for HTML export.
+The car of each entry is one of 'preamble, 'content or 'postamble.
+The cdrs of each entry are the ELEMENT_TYPE and ID for each
+section of the exported document.
+
+Note that changing the default will prevent you from using
+org-info.js for your website."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(list :greedy t
+ (list :tag "Preamble"
+ (const :format "" preamble)
+ (string :tag "element") (string :tag " id"))
+ (list :tag "Content"
+ (const :format "" content)
+ (string :tag "element") (string :tag " id"))
+ (list :tag "Postamble" (const :format "" postamble)
+ (string :tag " id") (string :tag "element"))))
+
+(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M"
+ "Format used for timestamps in preamble, postamble and metadata.
+See `format-time-string' for more information on its components."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+;;;; Template :: Mathjax
+
+(defcustom org-html-mathjax-options
+ '((path "http://orgmode.org/mathjax/MathJax.js")
+ (scale "100")
+ (align "center")
+ (indent "2em")
+ (mathml nil))
+ "Options for MathJax setup.
+
+path The path where to find MathJax
+scale Scaling for the HTML-CSS backend, usually between 100 and 133
+align How to align display math: left, center, or right
+indent If align is not center, how far from the left/right side?
+mathml Should a MathML player be used if available?
+ This is faster and reduces bandwidth use, but currently
+ sometimes has lower spacing quality. Therefore, the default is
+ nil. When browsers get better, this switch can be flipped.
+
+You can also customize this for each buffer, using something like
+
+#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+ :group 'org-export-html
+ :type '(list :greedy t
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "mathml (should MathML display be used is possible)"
+ (const :format " " mathml) (boolean))))
+
+(defcustom org-html-mathjax-template
+ "<script type=\"text/javascript\" src=\"%PATH\"></script>
+<script type=\"text/javascript\">
+<!--/*--><![CDATA[/*><!--*/
+ MathJax.Hub.Config({
+ // Only one of the two following lines, depending on user settings
+ // First allows browser-native MathML display, second forces HTML/CSS
+ :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
+ :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
+ extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
+ \"TeX/noUndefined.js\"],
+ tex2jax: {
+ inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
+ displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
+ skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
+ ignoreClass: \"tex2jax_ignore\",
+ processEscapes: false,
+ processEnvironments: true,
+ preview: \"TeX\"
+ },
+ showProcessingMessages: true,
+ displayAlign: \"%ALIGN\",
+ displayIndent: \"%INDENT\",
+
+ \"HTML-CSS\": {
+ scale: %SCALE,
+ availableFonts: [\"STIX\",\"TeX\"],
+ preferredFont: \"TeX\",
+ webFont: \"TeX\",
+ imageFont: \"TeX\",
+ showMathMenu: true,
+ },
+ MMLorHTML: {
+ prefer: {
+ MSIE: \"MML\",
+ Firefox: \"MML\",
+ Opera: \"HTML\",
+ other: \"HTML\"
+ }
+ }
+ });
+/*]]>*///-->
+</script>"
+ "The MathJax setup for XHTML files."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Template :: Postamble
+
+(defcustom org-html-postamble 'auto
+ "Non-nil means insert a postamble in HTML export.
+
+When set to 'auto, check against the
+`org-export-with-author/email/creator/date' variables to set the
+content of the postamble. When set to a string, use this string
+as the postamble. When t, insert a string as defined by the
+formatting string in `org-html-postamble-format'.
+
+When set to a function, apply this function and insert the
+returned string. The function takes the property list of export
+options as its only argument.
+
+Setting :html-postamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No postamble" nil)
+ (const :tag "Auto postamble" auto)
+ (const :tag "Default formatting string" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-html-postamble-format
+ '(("en" "<p class=\"author\">Author: %a (%e)</p>
+<p class=\"date\">Date: %d</p>
+<p class=\"creator\">%c</p>
+<p class=\"validation\">%v</p>"))
+ "Alist of languages and format strings for the HTML postamble.
+
+The first element of each list is the language code, as used for
+the LANGUAGE keyword. See `org-export-default-language'.
+
+The second element of each list is a format string to format the
+postamble itself. This format string can contain these elements:
+
+ %t stands for the title.
+ %a stands for the author's name.
+ %e stands for the author's email.
+ %d stands for the date.
+ %c will be replaced by `org-html-creator-string'.
+ %v will be replaced by `org-html-validation-link'.
+ %T will be replaced by the export time.
+ %C will be replaced by the last modification time.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\"."
+ :group 'org-export-html
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
+
+(defcustom org-html-validation-link
+ "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>"
+ "Link to HTML validation service."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-creator-string
+ (format "<a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)"
+ emacs-version
+ (if (fboundp 'org-version) (org-version) "unknown version"))
+ "Information about the creator of the HTML document.
+This option can also be set on with the CREATOR keyword."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(string :tag "Creator string"))
+
+;;;; Template :: Preamble
+
+(defcustom org-html-preamble t
+ "Non-nil means insert a preamble in HTML export.
+
+When t, insert a string as defined by the formatting string in
+`org-html-preamble-format'. When set to a string, use this
+formatting string instead (see `org-html-postamble-format' for an
+example of such a formatting string).
+
+When set to a function, apply this function and insert the
+returned string. The function takes the property list of export
+options as its only argument.
+
+Setting :html-preamble in publishing projects will take
+precedence over this variable."
+ :group 'org-export-html
+ :type '(choice (const :tag "No preamble" nil)
+ (const :tag "Default preamble" t)
+ (string :tag "Custom formatting string")
+ (function :tag "Function (must return a string)")))
+
+(defcustom org-html-preamble-format '(("en" ""))
+ "Alist of languages and format strings for the HTML preamble.
+
+The first element of each list is the language code, as used for
+the LANGUAGE keyword. See `org-export-default-language'.
+
+The second element of each list is a format string to format the
+preamble itself. This format string can contain these elements:
+
+ %t stands for the title.
+ %a stands for the author's name.
+ %e stands for the author's email.
+ %d stands for the date.
+ %c will be replaced by `org-html-creator-string'.
+ %v will be replaced by `org-html-validation-link'.
+ %T will be replaced by the export time.
+ %C will be replaced by the last modification time.
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+See the default value of `org-html-postamble-format' for an
+example."
+ :group 'org-export-html
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
+
+(defcustom org-html-link-up ""
+ "Where should the \"UP\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-html-link-home ""
+ "Where should the \"HOME\" link of exported HTML pages lead?"
+ :group 'org-export-html
+ :type '(string :tag "File or URL"))
+
+(defcustom org-html-link-use-abs-url nil
+ "Should we prepend relative links with HTML_LINK_HOME?"
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
+
+(defcustom org-html-home/up-format
+ "<div id=\"org-div-home-and-up\">
+ <a accesskey=\"h\" href=\"%s\"> UP </a>
+ |
+ <a accesskey=\"H\" href=\"%s\"> HOME </a>
+</div>"
+ "Snippet used to insert the HOME and UP links.
+This is a format string, the first %s will receive the UP link,
+the second the HOME link. If both `org-html-link-up' and
+`org-html-link-home' are empty, the entire snippet will be
+ignored."
+ :group 'org-export-html
+ :type 'string)
+
+;;;; Template :: Scripts
+
+(define-obsolete-variable-alias
+ 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4")
+(defcustom org-html-head-include-scripts t
+ "Non-nil means include the JavaScript snippets in exported HTML files.
+The actual script is defined in `org-html-scripts' and should
+not be modified."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+;;;; Template :: Styles
+
+(define-obsolete-variable-alias
+ 'org-html-style-include-default 'org-html-head-include-default-style "24.4")
+(defcustom org-html-head-include-default-style t
+ "Non-nil means include the default style in exported HTML files.
+The actual style is defined in `org-html-style-default' and
+should not be modified. Use `org-html-head' to use your own
+style information."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+;;;###autoload
+(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
+
+(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
+(defcustom org-html-head ""
+ "Org-wide head definitions for exported HTML files.
+
+This variable can contain the full HTML structure to provide a
+style, including the surrounding HTML tags. You can consider
+including definitions for the following classes: title, todo,
+done, timestamp, timestamp-kwd, tag, target.
+
+For example, a valid value would be:
+
+ <style type=\"text/css\">
+ <![CDATA[
+ p { font-weight: normal; color: gray; }
+ h1 { color: black; }
+ .title { text-align: center; }
+ .todo, .timestamp-kwd { color: red; }
+ .done { color: green; }
+ ]]>
+ </style>
+
+If you want to refer to an external style, use something like
+
+ <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\" />
+
+As the value of this option simply gets inserted into the HTML
+<head> header, you can use it to add any arbitrary text to the
+header.
+
+You can set this on a per-file basis using #+HTML_HEAD:,
+or for publication projects using the :html-head property."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+;;;###autoload
+(put 'org-html-head 'safe-local-variable 'stringp)
+
+(defcustom org-html-head-extra ""
+ "More head information to add in the HTML output.
+
+You can set this on a per-file basis using #+HTML_HEAD_EXTRA:,
+or for publication projects using the :html-head-extra property."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+;;;###autoload
+(put 'org-html-head-extra 'safe-local-variable 'stringp)
+
+;;;; Todos
+
+(defcustom org-html-todo-kwd-class-prefix ""
+ "Prefix to class names for TODO keywords.
+Each TODO keyword gets a class given by the keyword itself, with this prefix.
+The default prefix is empty because it is nice to just use the keyword
+as a class name. But if you get into conflicts with other, existing
+CSS classes, then this prefix can be very useful."
+ :group 'org-export-html
+ :type 'string)
+
+
+;;; Internal Functions
+
+(defun org-html-xhtml-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (string-match-p "xhtml" dt)))
+
+(defun org-html-html5-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (member dt '("html5" "xhtml5" "<!doctype html>"))))
+
+(defun org-html-close-tag (tag attr info)
+ (concat "<" tag " " attr
+ (if (org-html-xhtml-p info) " />" ">")))
+
+(defun org-html-doctype (info)
+ "Return correct html doctype tag from `org-html-doctype-alist',
+or the literal value of :html-doctype from INFO if :html-doctype
+is not found in the alist.
+INFO is a plist used as a communication channel."
+ (let ((dt (plist-get info :html-doctype)))
+ (or (cdr (assoc dt org-html-doctype-alist)) dt)))
+
+(defun org-html--make-attribute-string (attributes)
+ "Return a list of attributes, as a string.
+ATTRIBUTES is a plist where values are either strings or nil. An
+attributes with a nil value will be omitted from the result."
+ (let (output)
+ (dolist (item attributes (mapconcat 'identity (nreverse output) " "))
+ (cond ((null item) (pop output))
+ ((symbolp item) (push (substring (symbol-name item) 1) output))
+ (t (let ((key (car output))
+ (value (replace-regexp-in-string
+ "\"" "&quot;" (org-html-encode-plain-text item))))
+ (setcar output (format "%s=\"%s\"" key value))))))))
+
+(defun org-html--wrap-image (contents info &optional caption label)
+ "Wrap CONTENTS string within an appropriate environment for images.
+INFO is a plist used as a communication channel. When optional
+arguments CAPTION and LABEL are given, use them for caption and
+\"id\" attribute."
+ (let ((html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))))
+ (format (if html5-fancy "\n<figure%s>%s%s\n</figure>"
+ "\n<div%s class=\"figure\">%s%s\n</div>")
+ ;; ID.
+ (if (not (org-string-nw-p label)) ""
+ (format " id=\"%s\"" (org-export-solidify-link-text label)))
+ ;; Contents.
+ (format "\n<p>%s</p>" contents)
+ ;; Caption.
+ (if (not (org-string-nw-p caption)) ""
+ (format (if html5-fancy "\n<figcaption>%s</figcaption>"
+ "\n<p>%s</p>")
+ caption)))))
+
+(defun org-html--format-image (source attributes info)
+ "Return \"img\" tag with given SOURCE and ATTRIBUTES.
+SOURCE is a string specifying the location of the image.
+ATTRIBUTES is a plist, as returned by
+`org-export-read-attribute'. INFO is a plist used as
+a communication channel."
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p "^ltxpng/" source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ attributes))
+ info))
+
+(defun org-html--textarea-block (element)
+ "Transcode ELEMENT into a textarea block.
+ELEMENT is either a src block or an example block."
+ (let* ((code (car (org-export-unravel-code element)))
+ (attr (org-export-read-attribute :attr_html element)))
+ (format "<p>\n<textarea cols=\"%s\" rows=\"%s\">\n%s</textarea>\n</p>"
+ (or (plist-get attr :width) 80)
+ (or (plist-get attr :height) (org-count-lines code))
+ code)))
+
+(defun org-html--has-caption-p (element &optional info)
+ "Non-nil when ELEMENT has a caption affiliated keyword.
+INFO is a plist used as a communication channel. This function
+is meant to be used as a predicate for `org-export-get-ordinal' or
+a value to `org-html-standalone-image-predicate'."
+ (org-element-property :caption element))
+
+;;;; Table
+
+(defun org-html-htmlize-region-for-paste (beg end)
+ "Convert the region between BEG and END to HTML, using htmlize.el.
+This is much like `htmlize-region-for-paste', only that it uses
+the settings define in the org-... variables."
+ (let* ((htmlize-output-type org-html-htmlize-output-type)
+ (htmlize-css-name-prefix org-html-htmlize-font-prefix)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
+
+;;;###autoload
+(defun org-html-htmlize-generate-css ()
+ "Create the CSS for all font definitions in the current Emacs session.
+Use this to create face definitions in your CSS style file that can then
+be used by code snippets transformed by htmlize.
+This command just produces a buffer that contains class definitions for all
+faces used in the current Emacs session. You can copy and paste the ones you
+need into your CSS file.
+
+If you then set `org-html-htmlize-output-type' to `css', calls
+to the function `org-html-htmlize-region-for-paste' will
+produce code that uses these same face definitions."
+ (interactive)
+ (require 'htmlize)
+ (and (get-buffer "*html*") (kill-buffer "*html*"))
+ (with-temp-buffer
+ (let ((fl (face-list))
+ (htmlize-css-name-prefix "org-")
+ (htmlize-output-type 'css)
+ f i)
+ (while (setq f (pop fl)
+ i (and f (face-attribute f :inherit)))
+ (when (and (symbolp f) (or (not i) (not (listp i))))
+ (insert (org-add-props (copy-sequence "1") nil 'face f))))
+ (htmlize-region (point-min) (point-max))))
+ (org-pop-to-buffer-same-window "*html*")
+ (goto-char (point-min))
+ (if (re-search-forward "<style" nil t)
+ (delete-region (point-min) (match-beginning 0)))
+ (if (re-search-forward "</style>" nil t)
+ (delete-region (1+ (match-end 0)) (point-max)))
+ (beginning-of-line 1)
+ (if (looking-at " +") (replace-match ""))
+ (goto-char (point-min)))
+
+(defun org-html--make-string (n string)
+ "Build a string by concatenating N times STRING."
+ (let (out) (dotimes (i n out) (setq out (concat string out)))))
+
+(defun org-html-fix-class-name (kwd) ; audit callers of this function
+ "Turn todo keyword KWD into a valid class name.
+Replaces invalid characters with \"_\"."
+ (save-match-data
+ (while (string-match "[^a-zA-Z0-9_]" kwd)
+ (setq kwd (replace-match "_" t t kwd))))
+ kwd)
+
+(defun org-html-format-footnote-reference (n def refcnt)
+ "Format footnote reference N with definition DEF into HTML."
+ (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt))))
+ (format org-html-footnote-format
+ (let* ((id (format "fnr.%s%s" n extra))
+ (href (format " href=\"#fn.%s\"" n))
+ (attributes (concat " class=\"footref\"" href)))
+ (org-html--anchor id n attributes)))))
+
+(defun org-html-format-footnotes-section (section-name definitions)
+ "Format footnotes section SECTION-NAME."
+ (if (not definitions) ""
+ (format org-html-footnotes-section section-name definitions)))
+
+(defun org-html-format-footnote-definition (fn)
+ "Format the footnote definition FN."
+ (let ((n (car fn)) (def (cdr fn)))
+ (format
+ "<div class=\"footdef\">%s %s</div>\n"
+ (format org-html-footnote-format
+ (let* ((id (format "fn.%s" n))
+ (href (format " href=\"#fnr.%s\"" n))
+ (attributes (concat " class=\"footnum\"" href)))
+ (org-html--anchor id n attributes)))
+ def)))
+
+(defun org-html-footnote-section (info)
+ "Format the footnote section.
+INFO is a plist used as a communication channel."
+ (let* ((fn-alist (org-export-collect-footnote-definitions
+ (plist-get info :parse-tree) info))
+ (fn-alist
+ (loop for (n type raw) in fn-alist collect
+ (cons n (if (eq (org-element-type raw) 'org-data)
+ (org-trim (org-export-data raw info))
+ (format "<p>%s</p>"
+ (org-trim (org-export-data raw info))))))))
+ (when fn-alist
+ (org-html-format-footnotes-section
+ (org-html--translate "Footnotes" info)
+ (format
+ "\n%s\n"
+ (mapconcat 'org-html-format-footnote-definition fn-alist "\n"))))))
+
+
+;;; Template
+
+(defun org-html--build-meta-info (info)
+ "Return meta tags for exported document.
+INFO is a plist used as a communication channel."
+ (let ((protect-string
+ (lambda (str)
+ (replace-regexp-in-string
+ "\"" "&quot;" (org-html-encode-plain-text str))))
+ (title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth
+ ;; Return raw Org syntax, skipping non
+ ;; exportable objects.
+ (org-element-interpret-data
+ (org-element-map auth
+ (cons 'plain-text org-element-all-objects)
+ 'identity info))))))
+ (description (plist-get info :description))
+ (keywords (plist-get info :keywords))
+ (charset (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system
+ 'mime-charset))
+ "iso-8859-1")))
+ (concat
+ (format "<title>%s</title>\n" title)
+ (when (plist-get info :time-stamp-file)
+ (format-time-string
+ (concat "<!-- " org-html-metadata-timestamp-format " -->\n")))
+ (format
+ (if (org-html-html5-p info)
+ (org-html-close-tag "meta" " charset=\"%s\"" info)
+ (org-html-close-tag
+ "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
+ info))
+ charset) "\n"
+ (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info)
+ "\n"
+ (and (org-string-nw-p author)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"author\" content=\"%s\""
+ (funcall protect-string author))
+ info)
+ "\n"))
+ (and (org-string-nw-p description)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"description\" content=\"%s\"\n"
+ (funcall protect-string description))
+ info)
+ "\n"))
+ (and (org-string-nw-p keywords)
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"keywords\" content=\"%s\""
+ (funcall protect-string keywords))
+ info)
+ "\n")))))
+
+(defun org-html--build-head (info)
+ "Return information for the <head>..</head> of the HTML output.
+INFO is a plist used as a communication channel."
+ (org-element-normalize-string
+ (concat
+ (when (plist-get info :html-head-include-default-style)
+ (org-element-normalize-string org-html-style-default))
+ (org-element-normalize-string (plist-get info :html-head))
+ (org-element-normalize-string (plist-get info :html-head-extra))
+ (when (and (plist-get info :html-htmlized-css-url)
+ (eq org-html-htmlize-output-type 'css))
+ (org-html-close-tag "link"
+ (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
+ (plist-get info :html-htmlized-css-url))
+ info))
+ (when (plist-get info :html-head-include-scripts) org-html-scripts))))
+
+(defun org-html--build-mathjax-config (info)
+ "Insert the user setup into the mathjax template.
+INFO is a plist used as a communication channel."
+ (when (and (memq (plist-get info :with-latex) '(mathjax t))
+ (org-element-map (plist-get info :parse-tree)
+ '(latex-fragment latex-environment) 'identity info t))
+ (let ((template org-html-mathjax-template)
+ (options org-html-mathjax-options)
+ (in-buffer (or (plist-get info :html-mathjax) ""))
+ name val (yes " ") (no "// ") x)
+ (mapc
+ (lambda (e)
+ (setq name (car e) val (nth 1 e))
+ (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ (if (not (stringp val)) (setq val (format "%s" val)))
+ (if (string-match (concat "%" (upcase (symbol-name name))) template)
+ (setq template (replace-match val t t template))))
+ options)
+ (setq val (nth 1 (assq 'mathml options)))
+ (if (string-match (concat "\\<mathml:") in-buffer)
+ (setq val (car (read-from-string
+ (substring in-buffer (match-end 0))))))
+ ;; Exchange prefixes depending on mathml setting.
+ (if (not val) (setq x yes yes no no x))
+ ;; Replace cookies to turn on or off the config/jax lines.
+ (if (string-match ":MMLYES:" template)
+ (setq template (replace-match yes t t template)))
+ (if (string-match ":MMLNO:" template)
+ (setq template (replace-match no t t template)))
+ ;; Return the modified template.
+ (org-element-normalize-string template))))
+
+(defun org-html-format-spec (info)
+ "Return format specification for elements that can be
+used in the preamble or postamble."
+ `((?t . ,(org-export-data (plist-get info :title) info))
+ (?d . ,(org-export-data (org-export-get-date info) info))
+ (?T . ,(format-time-string org-html-metadata-timestamp-format))
+ (?a . ,(org-export-data (plist-get info :author) info))
+ (?e . ,(mapconcat
+ (lambda (e)
+ (format "<a href=\"mailto:%s\">%s</a>" e e))
+ (split-string (plist-get info :email) ",+ *")
+ ", "))
+ (?c . ,(plist-get info :creator))
+ (?C . ,(let ((file (plist-get info :input-file)))
+ (format-time-string org-html-metadata-timestamp-format
+ (if file (nth 5 (file-attributes file))))))
+ (?v . ,(or org-html-validation-link ""))))
+
+(defun org-html--build-pre/postamble (type info)
+ "Return document preamble or postamble as a string, or nil.
+TYPE is either 'preamble or 'postamble, INFO is a plist used as a
+communication channel."
+ (let ((section (plist-get info (intern (format ":html-%s" type))))
+ (spec (org-html-format-spec info)))
+ (when section
+ (let ((section-contents
+ (if (functionp section) (funcall section info)
+ (cond
+ ((stringp section) (format-spec section spec))
+ ((eq section 'auto)
+ (let ((date (cdr (assq ?d spec)))
+ (author (cdr (assq ?a spec)))
+ (email (cdr (assq ?e spec)))
+ (creator (cdr (assq ?c spec)))
+ (timestamp (cdr (assq ?T spec)))
+ (validation-link (cdr (assq ?v spec))))
+ (concat
+ (when (and (plist-get info :with-date)
+ (org-string-nw-p date))
+ (format "<p class=\"date\">%s: %s</p>\n"
+ (org-html--translate "Date" info)
+ date))
+ (when (and (plist-get info :with-author)
+ (org-string-nw-p author))
+ (format "<p class=\"author\">%s: %s</p>\n"
+ (org-html--translate "Author" info)
+ author))
+ (when (and (plist-get info :with-email)
+ (org-string-nw-p email))
+ (format "<p class=\"email\">%s: %s</p>\n"
+ (org-html--translate "Email" info)
+ email))
+ (when (plist-get info :time-stamp-file)
+ (format
+ "<p class=\"date\">%s: %s</p>\n"
+ (org-html--translate "Created" info)
+ (format-time-string org-html-metadata-timestamp-format)))
+ (when (plist-get info :with-creator)
+ (format "<p class=\"creator\">%s</p>\n" creator))
+ (format "<p class=\"validation\">%s</p>\n"
+ validation-link))))
+ (t (format-spec
+ (or (cadr (assoc
+ (plist-get info :language)
+ (eval (intern
+ (format "org-html-%s-format" type)))))
+ (cadr
+ (assoc
+ "en"
+ (eval
+ (intern (format "org-html-%s-format" type))))))
+ spec))))))
+ (when (org-string-nw-p section-contents)
+ (concat
+ (format "<%s id=\"%s\" class=\"%s\">\n"
+ (nth 1 (assq type org-html-divs))
+ (nth 2 (assq type org-html-divs))
+ org-html--pre/postamble-class)
+ (org-element-normalize-string section-contents)
+ (format "</%s>\n" (nth 1 (assq type org-html-divs)))))))))
+
+(defun org-html-inner-template (contents info)
+ "Return body of document string after HTML conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth (org-html-toc depth info)))
+ ;; Document contents.
+ contents
+ ;; Footnotes section.
+ (org-html-footnote-section info)))
+
+(defun org-html-template (contents info)
+ "Return complete document string after HTML conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (concat
+ (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
+ (let ((decl (or (and (stringp org-html-xml-declaration)
+ org-html-xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ org-html-xml-declaration))
+ (cdr (assoc "html" org-html-xml-declaration))
+
+ "")))
+ (when (not (or (eq nil decl) (string= "" decl)))
+ (format "%s\n"
+ (format decl
+ (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system 'mime-charset))
+ "iso-8859-1"))))))
+ (org-html-doctype info)
+ "\n"
+ (concat "<html"
+ (when (org-html-xhtml-p info)
+ (format
+ " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
+ (plist-get info :language) (plist-get info :language)))
+ ">\n")
+ "<head>\n"
+ (org-html--build-meta-info info)
+ (org-html--build-head info)
+ (org-html--build-mathjax-config info)
+ "</head>\n"
+ "<body>\n"
+ (let ((link-up (org-trim (plist-get info :html-link-up)))
+ (link-home (org-trim (plist-get info :html-link-home))))
+ (unless (and (string= link-up "") (string= link-home ""))
+ (format org-html-home/up-format
+ (or link-up link-home)
+ (or link-home link-up))))
+ ;; Preamble.
+ (org-html--build-pre/postamble 'preamble info)
+ ;; Document contents.
+ (format "<%s id=\"%s\">\n"
+ (nth 1 (assq 'content org-html-divs))
+ (nth 2 (assq 'content org-html-divs)))
+ ;; Document title.
+ (let ((title (plist-get info :title)))
+ (format "<h1 class=\"title\">%s</h1>\n" (org-export-data (or title "") info)))
+ contents
+ (format "</%s>\n"
+ (nth 1 (assq 'content org-html-divs)))
+ ;; Postamble.
+ (org-html--build-pre/postamble 'postamble info)
+ ;; Closing document.
+ "</body>\n</html>"))
+
+(defun org-html--translate (s info)
+ "Translate string S according to specified language.
+INFO is a plist used as a communication channel."
+ (org-export-translate s :html info))
+
+;;;; Anchor
+
+(defun org-html--anchor (&optional id desc attributes)
+ "Format a HTML anchor."
+ (let* ((name (and org-html-allow-name-attribute-in-anchors id))
+ (attributes (concat (and id (format " id=\"%s\"" id))
+ (and name (format " name=\"%s\"" name))
+ attributes)))
+ (format "<a%s>%s</a>" attributes (or desc ""))))
+
+;;;; Todo
+
+(defun org-html--todo (todo)
+ "Format TODO keywords into HTML."
+ (when todo
+ (format "<span class=\"%s %s%s\">%s</span>"
+ (if (member todo org-done-keywords) "done" "todo")
+ org-html-todo-kwd-class-prefix (org-html-fix-class-name todo)
+ todo)))
+
+;;;; Tags
+
+(defun org-html--tags (tags)
+ "Format TAGS into HTML."
+ (when tags
+ (format "<span class=\"tag\">%s</span>"
+ (mapconcat
+ (lambda (tag)
+ (format "<span class=\"%s\">%s</span>"
+ (concat org-html-tag-class-prefix
+ (org-html-fix-class-name tag))
+ tag))
+ tags "&#xa0;"))))
+
+;;;; Headline
+
+(defun* org-html-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ "Format a headline in HTML."
+ (let ((section-number
+ (when section-number
+ (format "<span class=\"section-number-%d\">%s</span> "
+ level section-number)))
+ (todo (org-html--todo todo))
+ (tags (org-html--tags tags)))
+ (concat section-number todo (and todo " ") text
+ (and tags "&#xa0;&#xa0;&#xa0;") tags)))
+
+;;;; Src Code
+
+(defun org-html-fontify-code (code lang)
+ "Color CODE with htmlize library.
+CODE is a string representing the source code to colorize. LANG
+is the language used for CODE, as a string, or nil."
+ (when code
+ (cond
+ ;; Case 1: No lang. Possibly an example block.
+ ((not lang)
+ ;; Simple transcoding.
+ (org-html-encode-plain-text code))
+ ;; Case 2: No htmlize or an inferior version of htmlize
+ ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste)))
+ ;; Emit a warning.
+ (message "Cannot fontify src block (htmlize.el >= 1.34 required)")
+ ;; Simple transcoding.
+ (org-html-encode-plain-text code))
+ (t
+ ;; Map language
+ (setq lang (or (assoc-default lang org-src-lang-modes) lang))
+ (let* ((lang-mode (and lang (intern (format "%s-mode" lang)))))
+ (cond
+ ;; Case 1: Language is not associated with any Emacs mode
+ ((not (functionp lang-mode))
+ ;; Simple transcoding.
+ (org-html-encode-plain-text code))
+ ;; Case 2: Default. Fontify code.
+ (t
+ ;; htmlize
+ (setq code (with-temp-buffer
+ ;; Switch to language-specific mode.
+ (funcall lang-mode)
+ (insert code)
+ ;; Fontify buffer.
+ (org-font-lock-ensure)
+ ;; Remove formatting on newline characters.
+ (save-excursion
+ (let ((beg (point-min))
+ (end (point-max)))
+ (goto-char beg)
+ (while (progn (end-of-line) (< (point) end))
+ (put-text-property (point) (1+ (point)) 'face nil)
+ (forward-char 1))))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ ;; Htmlize region.
+ (org-html-htmlize-region-for-paste
+ (point-min) (point-max))))
+ ;; Strip any enclosing <pre></pre> tags.
+ (let* ((beg (and (string-match "\\`<pre[^>]*>\n*" code) (match-end 0)))
+ (end (and beg (string-match "</pre>\\'" code))))
+ (if (and beg end) (substring code beg end) code)))))))))
+
+(defun org-html-do-format-code
+ (code &optional lang refs retain-labels num-start)
+ "Format CODE string as source code.
+Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
+respectively, the language of the source code, as a string, an
+alist between line numbers and references (as returned by
+`org-export-unravel-code'), a boolean specifying if labels should
+appear in the source code, and the number associated to the first
+line of code."
+ (let* ((code-lines (org-split-string code "\n"))
+ (code-length (length code-lines))
+ (num-fmt
+ (and num-start
+ (format "%%%ds: "
+ (length (number-to-string (+ code-length num-start))))))
+ (code (org-html-fontify-code code lang)))
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (setq loc
+ (concat
+ ;; Add line number, if needed.
+ (when num-start
+ (format "<span class=\"linenr\">%s</span>"
+ (format num-fmt line-num)))
+ ;; Transcoded src line.
+ loc
+ ;; Add label, if needed.
+ (when (and ref retain-labels) (format " (%s)" ref))))
+ ;; Mark transcoded line as an anchor, if needed.
+ (if (not ref) loc
+ (format "<span id=\"coderef-%s\" class=\"coderef-off\">%s</span>"
+ ref loc)))
+ num-start refs)))
+
+(defun org-html-format-code (element info)
+ "Format contents of ELEMENT as source code.
+ELEMENT is either an example block or a src block. INFO is
+a plist used as a communication channel."
+ (let* ((lang (org-element-property :language element))
+ ;; Extract code and references.
+ (code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (refs (cdr code-info))
+ ;; Does the src block contain labels?
+ (retain-labels (org-element-property :retain-labels element))
+ ;; Does it have line numbers?
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0))))
+ (org-html-do-format-code code lang refs retain-labels num-start)))
+
+
+;;; Tables of Contents
+
+(defun org-html-toc (depth info)
+ "Build a table of contents.
+DEPTH is an integer specifying the depth of the table. INFO is a
+plist used as a communication channel. Return the table of
+contents as a string, or nil if it is empty."
+ (let ((toc-entries
+ (mapcar (lambda (headline)
+ (cons (org-html--format-toc-headline headline info)
+ (org-export-get-relative-level headline info)))
+ (org-export-collect-headlines info depth)))
+ (outer-tag (if (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))
+ "nav"
+ "div")))
+ (when toc-entries
+ (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "Table of Contents" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-table-of-contents\">"
+ (org-html--toc-text toc-entries)
+ "</div>\n"
+ (format "</%s>\n" outer-tag)))))
+
+(defun org-html--toc-text (toc-entries)
+ "Return innards of a table of contents, as a string.
+TOC-ENTRIES is an alist where key is an entry title, as a string,
+and value is its relative level, as an integer."
+ (let* ((prev-level (1- (cdar toc-entries)))
+ (start-level prev-level))
+ (concat
+ (mapconcat
+ (lambda (entry)
+ (let ((headline (car entry))
+ (level (cdr entry)))
+ (concat
+ (let* ((cnt (- level prev-level))
+ (times (if (> cnt 0) (1- cnt) (- cnt)))
+ rtn)
+ (setq prev-level level)
+ (concat
+ (org-html--make-string
+ times (cond ((> cnt 0) "\n<ul>\n<li>")
+ ((< cnt 0) "</li>\n</ul>\n")))
+ (if (> cnt 0) "\n<ul>\n<li>" "</li>\n<li>")))
+ headline)))
+ toc-entries "")
+ (org-html--make-string (- prev-level start-level) "</li>\n</ul>\n"))))
+
+(defun org-html--format-toc-headline (headline info)
+ "Return an appropriate table of contents entry for HEADLINE.
+INFO is a plist used as a communication channel."
+ (let* ((headline-number (org-export-get-headline-number headline info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data-with-backend
+ (org-export-get-alt-title headline info)
+ ;; Create an anonymous back-end that will ignore any
+ ;; footnote-reference, link, radio-target and target
+ ;; in table of contents.
+ (org-export-create-backend
+ :parent 'html
+ :transcoders '((footnote-reference . ignore)
+ (link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore)))
+ info))
+ (tags (and (eq (plist-get info :with-tags) t)
+ (org-export-get-tags headline info))))
+ (format "<a href=\"#%s\">%s</a>"
+ ;; Label.
+ (org-export-solidify-link-text
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-"
+ (mapconcat #'number-to-string headline-number "-"))))
+ ;; Body.
+ (concat
+ (and (not (org-export-low-level-p headline info))
+ (org-export-numbered-headline-p headline info)
+ (concat (mapconcat #'number-to-string headline-number ".")
+ ". "))
+ (apply (if (not (eq org-html-format-headline-function 'ignore))
+ (lambda (todo todo-type priority text tags &rest ignore)
+ (funcall org-html-format-headline-function
+ todo todo-type priority text tags))
+ #'org-html-format-headline)
+ todo todo-type priority text tags :section-number nil)))))
+
+(defun org-html-list-of-listings (info)
+ "Build a list of listings.
+INFO is a plist used as a communication channel. Return the list
+of listings as a string, or nil if it is empty."
+ (let ((lol-entries (org-export-collect-listings info)))
+ (when lol-entries
+ (concat "<div id=\"list-of-listings\">\n"
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "List of Listings" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-list-of-listings\">\n<ul>\n"
+ (let ((count 0)
+ (initial-fmt (format "<span class=\"listing-number\">%s</span>"
+ (org-html--translate "Listing %d:" info))))
+ (mapconcat
+ (lambda (entry)
+ (let ((label (org-element-property :name entry))
+ (title (org-trim
+ (org-export-data
+ (or (org-export-get-caption entry t)
+ (org-export-get-caption entry))
+ info))))
+ (concat
+ "<li>"
+ (if (not label)
+ (concat (format initial-fmt (incf count)) " " title)
+ (format "<a href=\"#%s\">%s %s</a>"
+ (org-export-solidify-link-text label)
+ (format initial-fmt (incf count))
+ title))
+ "</li>")))
+ lol-entries "\n"))
+ "\n</ul>\n</div>\n</div>"))))
+
+(defun org-html-list-of-tables (info)
+ "Build a list of tables.
+INFO is a plist used as a communication channel. Return the list
+of tables as a string, or nil if it is empty."
+ (let ((lol-entries (org-export-collect-tables info)))
+ (when lol-entries
+ (concat "<div id=\"list-of-tables\">\n"
+ (format "<h%d>%s</h%d>\n"
+ org-html-toplevel-hlevel
+ (org-html--translate "List of Tables" info)
+ org-html-toplevel-hlevel)
+ "<div id=\"text-list-of-tables\">\n<ul>\n"
+ (let ((count 0)
+ (initial-fmt (format "<span class=\"table-number\">%s</span>"
+ (org-html--translate "Table %d:" info))))
+ (mapconcat
+ (lambda (entry)
+ (let ((label (org-element-property :name entry))
+ (title (org-trim
+ (org-export-data
+ (or (org-export-get-caption entry t)
+ (org-export-get-caption entry))
+ info))))
+ (concat
+ "<li>"
+ (if (not label)
+ (concat (format initial-fmt (incf count)) " " title)
+ (format "<a href=\"#%s\">%s %s</a>"
+ (org-export-solidify-link-text label)
+ (format initial-fmt (incf count))
+ title))
+ "</li>")))
+ lol-entries "\n"))
+ "\n</ul>\n</div>\n</div>"))))
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-html-bold (bold contents info)
+ "Transcode BOLD from Org to HTML.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Center Block
+
+(defun org-html-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (format "<div class=\"center\">\n%s</div>" contents))
+
+;;;; Clock
+
+(defun org-html-clock (clock contents info)
+ "Transcode a CLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<p>
+<span class=\"timestamp-wrapper\">
+<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>%s
+</span>
+</p>"
+ org-clock-string
+ (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
+
+;;;; Code
+
+(defun org-html-code (code contents info)
+ "Transcode CODE from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s")
+ (org-html-encode-plain-text (org-element-property :value code))))
+
+;;;; Drawer
+
+(defun org-html-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (if (functionp org-html-format-drawer-function)
+ (funcall org-html-format-drawer-function
+ (org-element-property :drawer-name drawer)
+ contents)
+ ;; If there's no user defined function: simply
+ ;; display contents of the drawer.
+ contents))
+
+;;;; Dynamic Block
+
+(defun org-html-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ contents)
+
+;;;; Entity
+
+(defun org-html-entity (entity contents info)
+ "Transcode an ENTITY object from Org to HTML.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property :html entity))
+
+;;;; Example Block
+
+(defun org-html-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (if (org-export-read-attribute :attr_html example-block :textarea)
+ (org-html--textarea-block example-block)
+ (format "<pre class=\"example\">\n%s</pre>"
+ (org-html-format-code example-block info))))
+
+;;;; Export Snippet
+
+(defun org-html-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (when (eq (org-export-snippet-backend export-snippet) 'html)
+ (org-element-property :value export-snippet)))
+
+;;;; Export Block
+
+(defun org-html-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "HTML")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+;;;; Fixed Width
+
+(defun org-html-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "<pre class=\"example\">\n%s</pre>"
+ (org-html-do-format-code
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+;;;; Footnote Reference
+
+(defun org-html-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ org-html-footnote-separator))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (org-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 100))
+ ;; Inline definitions are secondary strings.
+ ((eq (org-element-property :type footnote-reference) 'inline)
+ (org-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1))
+ ;; Non-inline footnotes definitions are full Org data.
+ (t (org-html-format-footnote-reference
+ (org-export-get-footnote-number footnote-reference info)
+ "IGNORED" 1)))))
+
+;;;; Headline
+
+(defun org-html-format-headline--wrap
+ (headline info &optional format-function &rest extra-keys)
+ "Transcode a HEADLINE element from Org to HTML.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((level (+ (org-export-get-relative-level headline info)
+ (1- org-html-toplevel-hlevel)))
+ (headline-number (org-export-get-headline-number headline info))
+ (section-number (and (not (org-export-low-level-p headline info))
+ (org-export-numbered-headline-p headline info)
+ (mapconcat 'number-to-string
+ headline-number ".")))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (headline-label (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-" (mapconcat 'number-to-string
+ headline-number "-"))))
+ (format-function
+ (cond ((functionp format-function) format-function)
+ ((not (eq org-html-format-headline-function 'ignore))
+ (lambda (todo todo-type priority text tags &rest ignore)
+ (funcall org-html-format-headline-function
+ todo todo-type priority text tags)))
+ (t 'org-html-format-headline))))
+ (apply format-function
+ todo todo-type priority text tags
+ :headline-label headline-label :level level
+ :section-number section-number extra-keys)))
+
+(defun org-html-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to HTML.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((contents (or contents ""))
+ (numberedp (org-export-numbered-headline-p headline info))
+ (level (org-export-get-relative-level headline info))
+ (text (org-export-data (org-element-property :title headline) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (section-number (mapconcat #'number-to-string
+ (org-export-get-headline-number
+ headline info) "-"))
+ (ids (delq 'nil
+ (list (org-element-property :CUSTOM_ID headline)
+ (concat "sec-" section-number)
+ (org-element-property :ID headline))))
+ (preferred-id (car ids))
+ (extra-ids (mapconcat
+ (lambda (id)
+ (org-html--anchor
+ (org-export-solidify-link-text
+ (if (org-uuidgen-p id) (concat "ID-" id) id))))
+ (cdr ids) ""))
+ ;; Create the headline text.
+ (full-text (org-html-format-headline--wrap headline info)))
+ (if (org-export-low-level-p headline info)
+ ;; This is a deep sub-tree: export it as a list item.
+ (let* ((type (if numberedp 'ordered 'unordered))
+ (itemized-body
+ (org-html-format-list-item
+ contents type nil info nil
+ (concat (org-html--anchor preferred-id) extra-ids
+ full-text))))
+ (concat
+ (and (org-export-first-sibling-p headline info)
+ (org-html-begin-plain-list type))
+ itemized-body
+ (and (org-export-last-sibling-p headline info)
+ (org-html-end-plain-list type))))
+ ;; Standard headline. Export it as a section.
+ (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
+ (level1 (+ level (1- org-html-toplevel-hlevel)))
+ (first-content (car (org-element-contents headline))))
+ (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
+ (org-html--container headline info)
+ (format "outline-container-%s"
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-" section-number)))
+ (concat (format "outline-%d" level1) (and extra-class " ")
+ extra-class)
+ (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
+ level1 preferred-id extra-ids full-text level1)
+ ;; When there is no section, pretend there is an
+ ;; empty one to get the correct <div class="outline-
+ ;; ...> which is needed by `org-info.js'.
+ (if (not (eq (org-element-type first-content) 'section))
+ (concat (org-html-section first-content "" info)
+ contents)
+ contents)
+ (org-html--container headline info)))))))
+
+(defun org-html--container (headline info)
+ (or (org-element-property :HTML_CONTAINER headline)
+ (if (= 1 (org-export-get-relative-level headline info))
+ (plist-get info :html-container)
+ "div")))
+
+;;;; Horizontal Rule
+
+(defun org-html-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-html-close-tag "hr" nil info))
+
+;;;; Inline Src Block
+
+(defun org-html-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (code (org-element-property :value inline-src-block)))
+ (error "Cannot export inline src block")))
+
+;;;; Inlinetask
+
+(defun org-html-format-section (text class &optional id)
+ "Format a section with TEXT into a HTML div with CLASS and ID."
+ (let ((extra (concat (when id (format " id=\"%s\"" id)))))
+ (concat (format "<div class=\"%s\"%s>\n" class extra) text "</div>\n")))
+
+(defun org-html-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (cond
+ ;; If `org-html-format-inlinetask-function' is not 'ignore, call it
+ ;; with appropriate arguments.
+ ((not (eq org-html-format-inlinetask-function 'ignore))
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-html-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-html-format-headline--wrap
+ inlinetask info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
+ (org-html-format-headline--wrap inlinetask info)
+ (org-html-close-tag "br" nil info)
+ contents))))
+
+;;;; Italic
+
+(defun org-html-italic (italic contents info)
+ "Transcode ITALIC from Org to HTML.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents))
+
+;;;; Item
+
+(defun org-html-checkbox (checkbox)
+ "Format CHECKBOX into HTML."
+ (case checkbox (on "<code>[X]</code>")
+ (off "<code>[&#xa0;]</code>")
+ (trans "<code>[-]</code>")
+ (t "")))
+
+(defun org-html-format-list-item (contents type checkbox info
+ &optional term-counter-id
+ headline)
+ "Format a list item into HTML."
+ (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
+ (br (org-html-close-tag "br" nil info)))
+ (concat
+ (case type
+ (ordered
+ (let* ((counter term-counter-id)
+ (extra (if counter (format " value=\"%s\"" counter) "")))
+ (concat
+ (format "<li%s>" extra)
+ (when headline (concat headline br)))))
+ (unordered
+ (let* ((id term-counter-id)
+ (extra (if id (format " id=\"%s\"" id) "")))
+ (concat
+ (format "<li%s>" extra)
+ (when headline (concat headline br)))))
+ (descriptive
+ (let* ((term term-counter-id))
+ (setq term (or term "(no term)"))
+ ;; Check-boxes in descriptive lists are associated to tag.
+ (concat (format "<dt> %s </dt>"
+ (concat checkbox term))
+ "<dd>"))))
+ (unless (eq type 'descriptive) checkbox)
+ contents
+ (case type
+ (ordered "</li>")
+ (unordered "</li>")
+ (descriptive "</dd>")))))
+
+(defun org-html-item (item contents info)
+ "Transcode an ITEM element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((plain-list (org-export-get-parent item))
+ (type (org-element-property :type plain-list))
+ (counter (org-element-property :counter item))
+ (checkbox (org-element-property :checkbox item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag (org-export-data tag info)))))
+ (org-html-format-list-item
+ contents type checkbox info (or tag counter))))
+
+;;;; Keyword
+
+(defun org-html-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "HTML") value)
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (org-html-toc depth info)))
+ ((string= "listings" value) (org-html-list-of-listings info))
+ ((string= "tables" value) (org-html-list-of-tables info))))))))
+
+;;;; Latex Environment
+
+(defun org-html-format-latex (latex-frag processing-type info)
+ "Format a LaTeX fragment LATEX-FRAG into HTML.
+PROCESSING-TYPE designates the tool used for conversion. It is
+a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil
+and t. See `org-html-with-latex' for more information. INFO is
+a plist containing export properties."
+ (let ((cache-relpath "") (cache-dir ""))
+ (unless (eq processing-type 'mathjax)
+ (let ((bfn (or (buffer-file-name)
+ (make-temp-name
+ (expand-file-name "latex" temporary-file-directory))))
+ (latex-header
+ (let ((header (plist-get info :latex-header)))
+ (and header
+ (concat (mapconcat
+ (lambda (line) (concat "#+LATEX_HEADER: " line))
+ (org-split-string header "\n")
+ "\n")
+ "\n")))))
+ (setq cache-relpath
+ (concat "ltxpng/"
+ (file-name-sans-extension
+ (file-name-nondirectory bfn)))
+ cache-dir (file-name-directory bfn))
+ ;; Re-create LaTeX environment from original buffer in
+ ;; temporary buffer so that dvipng/imagemagick can properly
+ ;; turn the fragment into an image.
+ (setq latex-frag (concat latex-header latex-frag))))
+ (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
+ nil nil processing-type)
+ (buffer-string))))
+
+(defun org-html-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((processing-type (plist-get info :with-latex))
+ (latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (attributes (org-export-read-attribute :attr_html latex-environment)))
+ (case processing-type
+ ((t mathjax)
+ (org-html-format-latex latex-frag 'mathjax info))
+ ((dvipng imagemagick)
+ (let ((formula-link
+ (org-html-format-latex latex-frag processing-type info)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ ;; Do not provide a caption or a name to be consistent with
+ ;; `mathjax' handling.
+ (org-html--wrap-image
+ (org-html--format-image
+ (match-string 1 formula-link) attributes info) info))))
+ (t latex-frag))))
+
+;;;; Latex Fragment
+
+(defun org-html-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((latex-frag (org-element-property :value latex-fragment))
+ (processing-type (plist-get info :with-latex)))
+ (case processing-type
+ ((t mathjax)
+ (org-html-format-latex latex-frag 'mathjax info))
+ ((dvipng imagemagick)
+ (let ((formula-link
+ (org-html-format-latex latex-frag processing-type info)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ (org-html--format-image (match-string 1 formula-link) nil info))))
+ (t latex-frag))))
+
+;;;; Line Break
+
+(defun org-html-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (concat (org-html-close-tag "br" nil info) "\n"))
+
+;;;; Link
+
+(defun org-html-inline-image-p (link info)
+ "Non-nil when LINK is meant to appear as an image.
+INFO is a plist used as a communication channel. LINK is an
+inline image when it has no description and targets an image
+file (see `org-html-inline-image-rules' for more information), or
+if its description is a single link targeting an image file."
+ (if (not (org-element-contents link))
+ (org-export-inline-image-p link org-html-inline-image-rules)
+ (not
+ (let ((link-count 0))
+ (org-element-map (org-element-contents link)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj)
+ (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link (if (= link-count 1) t
+ (incf link-count)
+ (not (org-export-inline-image-p
+ obj org-html-inline-image-rules))))
+ (otherwise t)))
+ info t)))))
+
+(defvar org-html-standalone-image-predicate)
+(defun org-html-standalone-image-p (element info)
+ "Non-nil if ELEMENT is a standalone image.
+
+INFO is a plist holding contextual information.
+
+An element or object is a standalone image when
+
+ - its type is `paragraph' and its sole content, save for white
+ spaces, is a link that qualifies as an inline image;
+
+ - its type is `link' and its containing paragraph has no other
+ content save white spaces.
+
+Bind `org-html-standalone-image-predicate' to constrain paragraph
+further. For example, to check for only captioned standalone
+images, set it to:
+
+ (lambda (paragraph) (org-element-property :caption paragraph))"
+ (let ((paragraph (case (org-element-type element)
+ (paragraph element)
+ (link (org-export-get-parent element)))))
+ (and (eq (org-element-type paragraph) 'paragraph)
+ (or (not (fboundp 'org-html-standalone-image-predicate))
+ (funcall org-html-standalone-image-predicate paragraph))
+ (catch 'exit
+ (let ((link-count 0))
+ (org-element-map (org-element-contents paragraph)
+ (cons 'plain-text org-element-all-objects)
+ #'(lambda (obj)
+ (when (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link (or (> (incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (otherwise t))
+ (throw 'exit nil)))
+ info nil 'link)
+ (= link-count 1))))))
+
+(defun org-html-link (link desc info)
+ "Transcode a LINK object from Org to HTML.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((home (when (plist-get info :html-link-home)
+ (org-trim (plist-get info :html-link-home))))
+ (use-abs-url (plist-get info :html-link-use-abs-url))
+ (link-org-files-as-html-maybe
+ (function
+ (lambda (raw-path info)
+ "Treat links to `file.org' as links to `file.html', if needed.
+ See `org-html-link-org-files-as-html'."
+ (cond
+ ((and org-html-link-org-files-as-html
+ (string= ".org"
+ (downcase (file-name-extension raw-path "."))))
+ (concat (file-name-sans-extension raw-path) "."
+ (plist-get info :html-extension)))
+ (t raw-path)))))
+ (type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (org-string-nw-p desc))
+ (path
+ (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (org-link-escape
+ (org-link-unescape
+ (concat type ":" raw-path)) org-link-escape-chars-browser))
+ ((string= type "file")
+ ;; Treat links to ".org" files as ".html", if needed.
+ (setq raw-path
+ (funcall link-org-files-as-html-maybe raw-path info))
+ ;; If file path is absolute, prepend it with protocol
+ ;; component - "file:".
+ (cond
+ ((file-name-absolute-p raw-path)
+ (setq raw-path (concat "file:" raw-path)))
+ ((and home use-abs-url)
+ (setq raw-path (concat (file-name-as-directory home) raw-path))))
+ ;; Add search option, if any. A search option can be
+ ;; relative to a custom-id or a headline title. Any other
+ ;; option is ignored.
+ (let ((option (org-element-property :search-option link)))
+ (cond ((not option) raw-path)
+ ((eq (aref option 0) ?#) (concat raw-path option))
+ ;; External fuzzy link: try to resolve it if path
+ ;; belongs to current project, if any.
+ ((eq (aref option 0) ?*)
+ (concat
+ raw-path
+ (let ((numbers
+ (org-publish-resolve-external-fuzzy-link
+ (org-element-property :path link) option)))
+ (and numbers (concat "#sec-"
+ (mapconcat 'number-to-string
+ numbers "-"))))))
+ (t raw-path))))
+ (t raw-path)))
+ ;; Extract attributes from parent's paragraph. HACK: Only do
+ ;; this for the first link in parent (inner image link for
+ ;; inline images). This is needed as long as attributes
+ ;; cannot be set on a per link basis.
+ (attributes-plist
+ (let* ((parent (org-export-get-parent-element link))
+ (link (let ((container (org-export-get-parent link)))
+ (if (and (eq (org-element-type container) 'link)
+ (org-html-inline-image-p link info))
+ container
+ link))))
+ (and (eq (org-element-map parent 'link 'identity info t) link)
+ (org-export-read-attribute :attr_html parent))))
+ (attributes
+ (let ((attr (org-html--make-attribute-string attributes-plist)))
+ (if (org-string-nw-p attr) (concat " " attr) "")))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and org-html-inline-images
+ (org-export-inline-image-p link org-html-inline-image-rules))
+ (org-html--format-image path attributes-plist info))
+ ;; Radio target: Transcode target's contents and use them as
+ ;; link's description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) desc
+ (format "<a href=\"#%s\"%s>%s</a>"
+ (org-export-solidify-link-text
+ (org-element-property :value destination))
+ attributes desc))))
+ ;; Links pointing to a headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; ID link points to an external file.
+ (plain-text
+ (let ((fragment (concat "ID-" path))
+ ;; Treat links to ".org" files as ".html", if needed.
+ (path (funcall link-org-files-as-html-maybe
+ destination info)))
+ (format "<a href=\"%s#%s\"%s>%s</a>"
+ path fragment attributes (or desc destination))))
+ ;; Fuzzy link points nowhere.
+ ((nil)
+ (format "<i>%s</i>"
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; Link points to a headline.
+ (headline
+ (let ((href
+ ;; What href to use?
+ (cond
+ ;; Case 1: Headline is linked via it's CUSTOM_ID
+ ;; property. Use CUSTOM_ID.
+ ((string= type "custom-id")
+ (org-element-property :CUSTOM_ID destination))
+ ;; Case 2: Headline is linked via it's ID property
+ ;; or through other means. Use the default href.
+ ((member type '("id" "fuzzy"))
+ (format "sec-%s"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) "-")))
+ (t (error "Shouldn't reach here"))))
+ ;; What description to use?
+ (desc
+ ;; Case 1: Headline is numbered and LINK has no
+ ;; description. Display section number.
+ (if (and (org-export-numbered-headline-p destination info)
+ (not desc))
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) ".")
+ ;; Case 2: Either the headline is un-numbered or
+ ;; LINK has a custom description. Display LINK's
+ ;; description or headline's title.
+ (or desc (org-export-data (org-element-property
+ :title destination) info)))))
+ (format "<a href=\"#%s\"%s>%s</a>"
+ (org-export-solidify-link-text href) attributes desc)))
+ ;; Fuzzy link points to a target or an element.
+ (t
+ (let* ((path (org-export-solidify-link-text path))
+ (org-html-standalone-image-predicate 'org-html--has-caption-p)
+ (number (cond
+ (desc nil)
+ ((org-html-standalone-image-p destination info)
+ (org-export-get-ordinal
+ (org-element-map destination 'link
+ 'identity info t)
+ info 'link 'org-html-standalone-image-p))
+ (t (org-export-get-ordinal
+ destination info nil 'org-html--has-caption-p))))
+ (desc (cond (desc)
+ ((not number) "No description for this link")
+ ((numberp number) (number-to-string number))
+ (t (mapconcat 'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>" path attributes desc))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (let ((fragment (concat "coderef-" path)))
+ (format "<a href=\"#%s\"%s%s>%s</a>"
+ fragment
+ (org-trim
+ (format (concat "class=\"coderef\""
+ " onmouseover=\"CodeHighlightOn(this, '%s');\""
+ " onmouseout=\"CodeHighlightOff(this, '%s');\"")
+ fragment fragment))
+ attributes
+ (format (org-export-get-coderef-format path desc)
+ (org-export-resolve-coderef path info)))))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'html))
+ ;; External link with a description part.
+ ((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
+ ;; External link without a description part.
+ (path (format "<a href=\"%s\"%s>%s</a>" path attributes path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "<i>%s</i>" desc)))))
+
+;;;; Paragraph
+
+(defun org-html-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to HTML.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let* ((parent (org-export-get-parent paragraph))
+ (parent-type (org-element-type parent))
+ (style '((footnote-definition " class=\"footpara\"")))
+ (extra (or (cadr (assoc parent-type style)) "")))
+ (cond
+ ((and (eq (org-element-type parent) 'item)
+ (= (org-element-property :begin paragraph)
+ (org-element-property :contents-begin parent)))
+ ;; Leading paragraph in a list item have no tags.
+ contents)
+ ((org-html-standalone-image-p paragraph info)
+ ;; Standalone image.
+ (let ((caption
+ (let ((raw (org-export-data
+ (org-export-get-caption paragraph) info))
+ (org-html-standalone-image-predicate
+ 'org-html--has-caption-p))
+ (if (not (org-string-nw-p raw)) raw
+ (concat
+ "<span class=\"figure-number\">"
+ (format (org-html--translate "Figure %d:" info)
+ (org-export-get-ordinal
+ (org-element-map paragraph 'link
+ 'identity info t)
+ info nil 'org-html-standalone-image-p))
+ "</span> " raw))))
+ (label (org-element-property :name paragraph)))
+ (org-html--wrap-image contents info caption label)))
+ ;; Regular paragraph.
+ (t (format "<p%s>\n%s</p>" extra contents)))))
+
+;;;; Plain List
+
+;; FIXME Maybe arg1 is not needed because <li value="20"> already sets
+;; the correct value for the item counter
+(defun org-html-begin-plain-list (type &optional arg1)
+ "Insert the beginning of the HTML list depending on TYPE.
+When ARG1 is a string, use it as the start parameter for ordered
+lists."
+ (case type
+ (ordered
+ (format "<ol class=\"org-ol\"%s>"
+ (if arg1 (format " start=\"%d\"" arg1) "")))
+ (unordered "<ul class=\"org-ul\">")
+ (descriptive "<dl class=\"org-dl\">")))
+
+(defun org-html-end-plain-list (type)
+ "Insert the end of the HTML list depending on TYPE."
+ (case type
+ (ordered "</ol>")
+ (unordered "</ul>")
+ (descriptive "</dl>")))
+
+(defun org-html-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to HTML.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item
+ (type (org-element-property :type plain-list)))
+ (format "%s\n%s%s"
+ (org-html-begin-plain-list type)
+ contents (org-html-end-plain-list type))))
+
+;;;; Plain Text
+
+(defun org-html-convert-special-strings (string)
+ "Convert special characters in STRING to HTML."
+ (let ((all org-html-special-string-regexps)
+ e a re rpl start)
+ (while (setq a (pop all))
+ (setq re (car a) rpl (cdr a) start 0)
+ (while (string-match re string start)
+ (setq string (replace-match rpl t nil string))))
+ string))
+
+(defun org-html-encode-plain-text (text)
+ "Convert plain text characters from TEXT to HTML equivalent.
+Possible conversions are set in `org-html-protect-char-alist'."
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
+ org-html-protect-char-alist)
+ text)
+
+(defun org-html-plain-text (text info)
+ "Transcode a TEXT string from Org to HTML.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (let ((output text))
+ ;; Protect following characters: <, >, &.
+ (setq output (org-html-encode-plain-text output))
+ ;; Handle smart quotes. Be sure to provide original string since
+ ;; OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :html info text)))
+ ;; Handle special strings.
+ (when (plist-get info :with-special-strings)
+ (setq output (org-html-convert-special-strings output)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (concat (org-html-close-tag "br" nil info) "\n") output)))
+ ;; Return value.
+ output))
+
+
+;; Planning
+
+(defun org-html-planning (planning contents info)
+ "Transcode a PLANNING element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>"))
+ (format
+ "<p><span class=\"timestamp-wrapper\">%s</span></p>"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (format span-fmt org-closed-string
+ (org-translate-time
+ (org-element-property :raw-value closed)))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (format span-fmt org-deadline-string
+ (org-translate-time
+ (org-element-property :raw-value deadline)))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (format span-fmt org-scheduled-string
+ (org-translate-time
+ (org-element-property :raw-value scheduled)))))))
+ " "))))
+
+;;;; Property Drawer
+
+(defun org-html-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+;;;; Quote Block
+
+(defun org-html-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (format "<blockquote>\n%s</blockquote>" contents))
+
+;;;; Quote Section
+
+(defun org-html-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "<pre>\n%s</pre>" value))))
+
+;;;; Section
+
+(defun org-html-section (section contents info)
+ "Transcode a SECTION element from Org to HTML.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ (let ((parent (org-export-get-parent-headline section)))
+ ;; Before first headline: no container, just return CONTENTS.
+ (if (not parent) contents
+ ;; Get div's class and id references.
+ (let* ((class-num (+ (org-export-get-relative-level parent info)
+ (1- org-html-toplevel-hlevel)))
+ (section-number
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number parent info) "-")))
+ ;; Build return value.
+ (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>"
+ class-num
+ (or (org-element-property :CUSTOM_ID parent) section-number)
+ contents)))))
+
+;;;; Radio Target
+
+(defun org-html-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to HTML.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (let ((id (org-export-solidify-link-text
+ (org-element-property :value radio-target))))
+ (org-html--anchor id text)))
+
+;;;; Special Block
+
+(defun org-html-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((block-type (downcase
+ (org-element-property :type special-block)))
+ (contents (or contents ""))
+ (html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy)
+ (member block-type org-html-html5-elements)))
+ (attributes (org-export-read-attribute :attr_html special-block)))
+ (unless html5-fancy
+ (let ((class (plist-get attributes :class)))
+ (setq attributes (plist-put attributes :class
+ (if class (concat class " " block-type)
+ block-type)))))
+ (setq attributes (org-html--make-attribute-string attributes))
+ (when (not (equal attributes ""))
+ (setq attributes (concat " " attributes)))
+ (if html5-fancy
+ (format "<%s%s>\n%s</%s>" block-type attributes
+ contents block-type)
+ (format "<div%s>\n%s\n</div>" attributes contents))))
+
+;;;; Src Block
+
+(defun org-html-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to HTML.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (if (org-export-read-attribute :attr_html src-block :textarea)
+ (org-html--textarea-block src-block)
+ (let ((lang (org-element-property :language src-block))
+ (caption (org-export-get-caption src-block))
+ (code (org-html-format-code src-block info))
+ (label (let ((lbl (org-element-property :name src-block)))
+ (if (not lbl) ""
+ (format " id=\"%s\""
+ (org-export-solidify-link-text lbl))))))
+ (if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
+ (format
+ "<div class=\"org-src-container\">\n%s%s\n</div>"
+ (if (not caption) ""
+ (format "<label class=\"org-src-name\">%s</label>"
+ (org-export-data caption info)))
+ (format "\n<pre class=\"src src-%s\"%s>%s</pre>" lang label code))))))
+
+;;;; Statistics Cookie
+
+(defun org-html-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((cookie-value (org-element-property :value statistics-cookie)))
+ (format "<code>%s</code>" cookie-value)))
+
+;;;; Strike-Through
+
+(defun org-html-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to HTML.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Subscript
+
+(defun org-html-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to HTML.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<sub>%s</sub>" contents))
+
+;;;; Superscript
+
+(defun org-html-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to HTML.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<sup>%s</sup>" contents))
+
+;;;; Table Cell
+
+(defun org-html-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to HTML.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((table-row (org-export-get-parent table-cell))
+ (table (org-export-get-parent-table table-cell))
+ (cell-attrs
+ (if (not org-html-table-align-individual-fields) ""
+ (format (if (and (boundp 'org-html-format-table-no-css)
+ org-html-format-table-no-css)
+ " align=\"%s\"" " class=\"%s\"")
+ (org-export-table-cell-alignment table-cell info)))))
+ (when (or (not contents) (string= "" (org-trim contents)))
+ (setq contents "&#xa0;"))
+ (cond
+ ((and (org-export-table-has-header-p table info)
+ (= 1 (org-export-table-row-group table-row info)))
+ (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs)
+ contents (cdr org-html-table-header-tags)))
+ ((and org-html-table-use-header-tags-for-first-column
+ (zerop (cdr (org-export-table-cell-address table-cell info))))
+ (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs)
+ contents (cdr org-html-table-header-tags)))
+ (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs)
+ contents (cdr org-html-table-data-tags))))))
+
+;;;; Table Row
+
+(defun org-html-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to HTML.
+CONTENTS is the contents of the row. INFO is a plist used as a
+communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((rowgroup-number (org-export-table-row-group table-row info))
+ (row-number (org-export-table-row-number table-row info))
+ (start-rowgroup-p
+ (org-export-table-row-starts-rowgroup-p table-row info))
+ (end-rowgroup-p
+ (org-export-table-row-ends-rowgroup-p table-row info))
+ ;; `top-row-p' and `end-rowgroup-p' are not used directly
+ ;; but should be set so that `org-html-table-row-tags' can
+ ;; use them (see the docstring of this variable.)
+ (top-row-p (and (equal start-rowgroup-p '(top))
+ (equal end-rowgroup-p '(below top))))
+ (bottom-row-p (and (equal start-rowgroup-p '(above))
+ (equal end-rowgroup-p '(bottom above))))
+ (rowgroup-tags
+ (cond
+ ;; Case 1: Row belongs to second or subsequent rowgroups.
+ ((not (= 1 rowgroup-number))
+ '("<tbody>" . "\n</tbody>"))
+ ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups.
+ ((org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ '("<thead>" . "\n</thead>"))
+ ;; Case 2: Row is from first and only row group.
+ (t '("<tbody>" . "\n</tbody>")))))
+ (concat
+ ;; Begin a rowgroup?
+ (when start-rowgroup-p (car rowgroup-tags))
+ ;; Actual table row
+ (concat "\n" (eval (car org-html-table-row-tags))
+ contents
+ "\n"
+ (eval (cdr org-html-table-row-tags)))
+ ;; End a rowgroup?
+ (when end-rowgroup-p (cdr rowgroup-tags))))))
+
+;;;; Table
+
+(defun org-html-table-first-row-data-cells (table info)
+ "Transcode the first row of TABLE.
+INFO is a plist used as a communication channel."
+ (let ((table-row
+ (org-element-map table 'table-row
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule) row))
+ info 'first-match))
+ (special-column-p (org-export-table-has-special-column-p table)))
+ (if (not special-column-p) (org-element-contents table-row)
+ (cdr (org-element-contents table-row)))))
+
+(defun org-html-table--table.el-table (table info)
+ "Format table.el tables into HTML.
+INFO is a plist used as a communication channel."
+ (when (eq (org-element-property :type table) 'table.el)
+ (require 'table)
+ (let ((outbuf (with-current-buffer
+ (get-buffer-create "*org-export-table*")
+ (erase-buffer) (current-buffer))))
+ (with-temp-buffer
+ (insert (org-element-property :value table))
+ (goto-char 1)
+ (re-search-forward "^[ \t]*|[^|]" nil t)
+ (table-generate-source 'html outbuf))
+ (with-current-buffer outbuf
+ (prog1 (org-trim (buffer-string))
+ (kill-buffer) )))))
+
+(defun org-html-table (table contents info)
+ "Transcode a TABLE element from Org to HTML.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (case (org-element-property :type table)
+ ;; Case 1: table.el table. Convert it using appropriate tools.
+ (table.el (org-html-table--table.el-table table info))
+ ;; Case 2: Standard table.
+ (t
+ (let* ((label (org-element-property :name table))
+ (caption (org-export-get-caption table))
+ (number (org-export-get-ordinal
+ table info nil 'org-html--has-caption-p))
+ (attributes
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (and label (list :id (org-export-solidify-link-text label)))
+ (and (not (org-html-html5-p info))
+ (plist-get info :html-table-attributes))
+ (org-export-read-attribute :attr_html table))))
+ (alignspec
+ (if (and (boundp 'org-html-format-table-no-css)
+ org-html-format-table-no-css)
+ "align=\"%s\"" "class=\"%s\""))
+ (table-column-specs
+ (function
+ (lambda (table info)
+ (mapconcat
+ (lambda (table-cell)
+ (let ((alignment (org-export-table-cell-alignment
+ table-cell info)))
+ (concat
+ ;; Begin a colgroup?
+ (when (org-export-table-cell-starts-colgroup-p
+ table-cell info)
+ "\n<colgroup>")
+ ;; Add a column. Also specify it's alignment.
+ (format "\n%s"
+ (org-html-close-tag
+ "col" (concat " " (format alignspec alignment)) info))
+ ;; End a colgroup?
+ (when (org-export-table-cell-ends-colgroup-p
+ table-cell info)
+ "\n</colgroup>"))))
+ (org-html-table-first-row-data-cells table info) "\n")))))
+ (format "<table%s>\n%s\n%s\n%s</table>"
+ (if (equal attributes "") "" (concat " " attributes))
+ (if (not caption) ""
+ (format (if org-html-table-caption-above
+ "<caption class=\"t-above\">%s</caption>"
+ "<caption class=\"t-bottom\">%s</caption>")
+ (concat
+ "<span class=\"table-number\">"
+ (format (org-html--translate "Table %d:" info) number)
+ "</span> " (org-export-data caption info))))
+ (funcall table-column-specs table info)
+ contents)))))
+
+;;;; Target
+
+(defun org-html-target (target contents info)
+ "Transcode a TARGET object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((id (org-export-solidify-link-text
+ (org-element-property :value target))))
+ (org-html--anchor id)))
+
+;;;; Timestamp
+
+(defun org-html-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-html-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
+ (replace-regexp-in-string "--" "&#x2013;" value))))
+
+;;;; Underline
+
+(defun org-html-underline (underline contents info)
+ "Transcode UNDERLINE from Org to HTML.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s")
+ contents))
+
+;;;; Verbatim
+
+(defun org-html-verbatim (verbatim contents info)
+ "Transcode VERBATIM from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s")
+ (org-html-encode-plain-text (org-element-property :value verbatim))))
+
+;;;; Verse Block
+
+(defun org-html-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to HTML.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ ;; Replace each newline character with line break. Also replace
+ ;; each blank line with a line break.
+ (setq contents (replace-regexp-in-string
+ "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info))
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (format "%s\n" (org-html-close-tag "br" nil info)) contents)))
+ ;; Replace each white space at beginning of a line with a
+ ;; non-breaking space.
+ (while (string-match "^[ \t]+" contents)
+ (let* ((num-ws (length (match-string 0 contents)))
+ (ws (let (out) (dotimes (i num-ws out)
+ (setq out (concat out "&#xa0;"))))))
+ (setq contents (replace-match ws nil t contents))))
+ (format "<p class=\"verse\">\n%s</p>" contents))
+
+
+;;; Filter Functions
+
+(defun org-html-final-function (contents backend info)
+ "Filter to indent the HTML and convert HTML entities."
+ (with-temp-buffer
+ (insert contents)
+ (set-auto-mode t)
+ (if org-html-indent
+ (indent-region (point-min) (point-max)))
+ (when org-html-use-unicode-chars
+ (require 'mm-url)
+ (mm-url-decode-entities))
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-html-export-as-html
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to an HTML buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"<body>\" and \"</body>\" tags.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org HTML Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'html "*Org HTML Export*"
+ async subtreep visible-only body-only ext-plist
+ (lambda () (set-auto-mode t))))
+
+;;;###autoload
+(defun org-html-convert-region-to-html ()
+ "Assume the current region has org-mode syntax, and convert it to HTML.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an HTML buffer and use this
+command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'html))
+
+;;;###autoload
+(defun org-html-export-to-html
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a HTML file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"<body>\" and \"</body>\" tags.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let* ((extension (concat "." org-html-extension))
+ (file (org-export-output-file-name extension subtreep))
+ (org-export-coding-system org-html-coding-system))
+ (org-export-to-file 'html file
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-html-publish-to-html (plist filename pub-dir)
+ "Publish an org file to HTML.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'html filename
+ (concat "." (or (plist-get plist :html-extension)
+ org-html-extension "html"))
+ plist pub-dir))
+
+
+(provide 'ox-html)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-html.el ends here
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
new file mode 100644
index 00000000000..3da52243d30
--- /dev/null
+++ b/lisp/org/ox-icalendar.el
@@ -0,0 +1,984 @@
+;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine
+
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Nicolas Goaziou <n dot goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements an iCalendar back-end for Org generic
+;; exporter. See Org manual for more information.
+;;
+;; It is expected to conform to RFC 5545.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-ascii)
+(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-icalendar nil
+ "Options specific for iCalendar export back-end."
+ :tag "Org Export iCalendar"
+ :group 'org-export)
+
+(defcustom org-icalendar-combined-agenda-file "~/org.ics"
+ "The file name for the iCalendar file covering all agenda files.
+This file is created with the command \\[org-icalendar-combine-agenda-files].
+The file name should be absolute. It will be overwritten without warning."
+ :group 'org-export-icalendar
+ :type 'file)
+
+(defcustom org-icalendar-alarm-time 0
+ "Number of minutes for triggering an alarm for exported timed events.
+
+A zero value (the default) turns off the definition of an alarm trigger
+for timed events. If non-zero, alarms are created.
+
+- a single alarm per entry is defined
+- The alarm will go off N minutes before the event
+- only a DISPLAY action is defined."
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type 'integer)
+
+(defcustom org-icalendar-combined-name "OrgMode"
+ "Calendar name for the combined iCalendar representing all agenda files."
+ :group 'org-export-icalendar
+ :type 'string)
+
+(defcustom org-icalendar-combined-description ""
+ "Calendar description for the combined iCalendar (all agenda files)."
+ :group 'org-export-icalendar
+ :type 'string)
+
+(defcustom org-icalendar-exclude-tags nil
+ "Tags that exclude a tree from export.
+This variable allows to specify different exclude tags from other
+back-ends. It can also be set with the ICAL_EXCLUDE_TAGS
+keyword."
+ :group 'org-export-icalendar
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
+ "Contexts where iCalendar export should use a deadline time stamp.
+
+This is a list with several symbols in it. Valid symbol are:
+`event-if-todo' Deadlines in TODO entries become calendar events.
+`event-if-not-todo' Deadlines in non-TODO entries become calendar events.
+`todo-due' Use deadlines in TODO entries as due-dates"
+ :group 'org-export-icalendar
+ :type '(set :greedy t
+ (const :tag "Deadlines in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "Deadline in TODO entries become events"
+ event-if-todo)
+ (const :tag "Deadlines in TODO entries become due-dates"
+ todo-due)))
+
+(defcustom org-icalendar-use-scheduled '(todo-start)
+ "Contexts where iCalendar export should use a scheduling time stamp.
+
+This is a list with several symbols in it. Valid symbol are:
+`event-if-todo' Scheduling time stamps in TODO entries become an event.
+`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event.
+`todo-start' Scheduling time stamps in TODO entries become start date.
+ Some calendar applications show TODO entries only after
+ that date."
+ :group 'org-export-icalendar
+ :type '(set :greedy t
+ (const :tag
+ "SCHEDULED timestamps in non-TODO entries become events"
+ event-if-not-todo)
+ (const :tag "SCHEDULED timestamps in TODO entries become events"
+ event-if-todo)
+ (const :tag "SCHEDULED in TODO entries become start date"
+ todo-start)))
+
+(defcustom org-icalendar-categories '(local-tags category)
+ "Items that should be entered into the \"categories\" field.
+
+This is a list of symbols, the following are valid:
+`category' The Org mode category of the current file or tree
+`todo-state' The todo state, if any
+`local-tags' The tags, defined in the current line
+`all-tags' All tags, including inherited ones."
+ :group 'org-export-icalendar
+ :type '(repeat
+ (choice
+ (const :tag "The file or tree category" category)
+ (const :tag "The TODO state" todo-state)
+ (const :tag "Tags defined in current line" local-tags)
+ (const :tag "All tags, including inherited ones" all-tags))))
+
+(defcustom org-icalendar-with-timestamps 'active
+ "Non-nil means make an event from plain time stamps.
+
+It can be set to `active', `inactive', t or nil, in order to make
+an event from, respectively, only active timestamps, only
+inactive ones, all of them or none.
+
+This variable has precedence over `org-export-with-timestamps'.
+It can also be set with the #+OPTIONS line, e.g. \"<:t\"."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "All timestamps" t)
+ (const :tag "Only active timestamps" active)
+ (const :tag "Only inactive timestamps" inactive)
+ (const :tag "No timestamp" nil)))
+
+(defcustom org-icalendar-include-todo nil
+ "Non-nil means create VTODO components from TODO items.
+
+Valid values are:
+nil don't include any task.
+t include tasks that are not in DONE state.
+`unblocked' include all TODO items that are not blocked.
+`all' include both done and not done items."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "None" nil)
+ (const :tag "Unfinished" t)
+ (const :tag "Unblocked" unblocked)
+ (const :tag "All" all)
+ (repeat :tag "Specific TODO keywords"
+ (string :tag "Keyword"))))
+
+(defcustom org-icalendar-include-bbdb-anniversaries nil
+ "Non-nil means a combined iCalendar file should include anniversaries.
+The anniversaries are defined in the BBDB database."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-include-sexps t
+ "Non-nil means export to iCalendar files should also cover sexp entries.
+These are entries like in the diary, but directly in an Org file."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-include-body t
+ "Amount of text below headline to be included in iCalendar export.
+This is a number of characters that should maximally be included.
+Properties, scheduling and clocking lines will always be removed.
+The text will be inserted into the DESCRIPTION field."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "Nothing" nil)
+ (const :tag "Everything" t)
+ (integer :tag "Max characters")))
+
+(defcustom org-icalendar-store-UID nil
+ "Non-nil means store any created UIDs in properties.
+
+The iCalendar standard requires that all entries have a unique identifier.
+Org will create these identifiers as needed. When this variable is non-nil,
+the created UIDs will be stored in the ID property of the entry. Then the
+next time this entry is exported, it will be exported with the same UID,
+superseding the previous form of it. This is essential for
+synchronization services.
+
+This variable is not turned on by default because we want to avoid creating
+a property drawer in every entry if people are only playing with this feature,
+or if they are only using it locally."
+ :group 'org-export-icalendar
+ :type 'boolean)
+
+(defcustom org-icalendar-timezone (getenv "TZ")
+ "The time zone string for iCalendar export.
+When nil or the empty string, use output
+from (current-time-zone)."
+ :group 'org-export-icalendar
+ :type '(choice
+ (const :tag "Unspecified" nil)
+ (string :tag "Time zone")))
+
+(defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S"
+ "Format-string for exporting icalendar DATE-TIME.
+
+See `format-time-string' for a full documentation. The only
+difference is that `org-icalendar-timezone' is used for %Z.
+
+Interesting value are:
+ - \":%Y%m%dT%H%M%S\" for local time
+ - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
+ - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
+ :group 'org-export-icalendar
+ :version "24.1"
+ :type '(choice
+ (const :tag "Local time" ":%Y%m%dT%H%M%S")
+ (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
+ (const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
+ (string :tag "Explicit format")))
+
+(defvar org-icalendar-after-save-hook nil
+ "Hook run after an iCalendar file has been saved.
+This hook is run with the name of the file as argument. A good
+way to use this is to tell a desktop calendar application to
+re-read the iCalendar file.")
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'icalendar 'ascii
+ :translate-alist '((clock . ignore)
+ (footnote-definition . ignore)
+ (footnote-reference . ignore)
+ (headline . org-icalendar-entry)
+ (inlinetask . ignore)
+ (planning . ignore)
+ (section . ignore)
+ (inner-template . (lambda (c i) c))
+ (template . org-icalendar-template))
+ :options-alist
+ '((:exclude-tags
+ "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
+ (:with-timestamps nil "<" org-icalendar-with-timestamps)
+ (:with-vtodo nil nil org-icalendar-include-todo)
+ ;; The following property will be non-nil when export has been
+ ;; started from org-agenda-mode. In this case, any entry without
+ ;; a non-nil "ICALENDAR_MARK" property will be ignored.
+ (:icalendar-agenda-view nil nil nil))
+ :filters-alist
+ '((:filter-headline . org-icalendar-clear-blank-lines))
+ :menu-entry
+ '(?c "Export to iCalendar"
+ ((?f "Current file" org-icalendar-export-to-ics)
+ (?a "All agenda files"
+ (lambda (a s v b) (org-icalendar-export-agenda-files a)))
+ (?c "Combine all agenda files"
+ (lambda (a s v b) (org-icalendar-combine-agenda-files a))))))
+
+
+
+;;; Internal Functions
+
+(defun org-icalendar-create-uid (file &optional bell h-markers)
+ "Set ID property on headlines missing it in FILE.
+When optional argument BELL is non-nil, inform the user with
+a message if the file was modified. With optional argument
+H-MARKERS non-nil, it is a list of markers for the headlines
+which will be updated."
+ (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
+ modified-flag)
+ (org-map-entries
+ (lambda ()
+ (let ((entry (org-element-at-point)))
+ (unless (or (< (point) pt) (org-element-property :ID entry))
+ (org-id-get-create)
+ (setq modified-flag t)
+ (forward-line))
+ (when h-markers (setq org-map-continue-from (pop h-markers)))))
+ nil nil 'comment)
+ (when (and bell modified-flag)
+ (message "ID properties created in file \"%s\"" file)
+ (sit-for 2))))
+
+(defun org-icalendar-blocked-headline-p (headline info)
+ "Non-nil when HEADLINE is considered to be blocked.
+
+INFO is a plist used as a communication channel.
+
+A headline is blocked when either
+
+ - it has children which are not all in a completed state;
+
+ - it has a parent with the property :ORDERED:, and there are
+ siblings prior to it with incomplete status;
+
+ - its parent is blocked because it has siblings that should be
+ done first or is a child of a blocked grandparent entry."
+ (or
+ ;; Check if any child is not done.
+ (org-element-map headline 'headline
+ (lambda (hl) (eq (org-element-property :todo-type hl) 'todo))
+ info 'first-match)
+ ;; Check :ORDERED: node property.
+ (catch 'blockedp
+ (let ((current headline))
+ (mapc (lambda (parent)
+ (cond
+ ((not (org-element-property :todo-keyword parent))
+ (throw 'blockedp nil))
+ ((org-not-nil (org-element-property :ORDERED parent))
+ (let ((sibling current))
+ (while (setq sibling (org-export-get-previous-element
+ sibling info))
+ (when (eq (org-element-property :todo-type sibling) 'todo)
+ (throw 'blockedp t)))))
+ (t (setq current parent))))
+ (org-export-get-genealogy headline))
+ nil))))
+
+(defun org-icalendar-use-UTC-date-time-p ()
+ "Non-nil when `org-icalendar-date-time-format' requires UTC time."
+ (char-equal (elt org-icalendar-date-time-format
+ (1- (length org-icalendar-date-time-format))) ?Z))
+
+(defvar org-agenda-default-appointment-duration) ; From org-agenda.el.
+(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc)
+ "Convert TIMESTAMP to iCalendar format.
+
+TIMESTAMP is a timestamp object. KEYWORD is added in front of
+it, in order to make a complete line (e.g. \"DTSTART\").
+
+When optional argument END is non-nil, use end of time range.
+Also increase the hour by two (if time string contains a time),
+or the day by one (if it does not contain a time) when no
+explicit ending time is specified.
+
+When optional argument UTC is non-nil, time will be expressed in
+Universal Time, ignoring `org-icalendar-date-time-format'."
+ (let* ((year-start (org-element-property :year-start timestamp))
+ (year-end (org-element-property :year-end timestamp))
+ (month-start (org-element-property :month-start timestamp))
+ (month-end (org-element-property :month-end timestamp))
+ (day-start (org-element-property :day-start timestamp))
+ (day-end (org-element-property :day-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (with-time-p minute-start)
+ (equal-bounds-p
+ (equal (list year-start month-start day-start hour-start minute-start)
+ (list year-end month-end day-end hour-end minute-end)))
+ (mi (cond ((not with-time-p) 0)
+ ((not end) minute-start)
+ ((and org-agenda-default-appointment-duration equal-bounds-p)
+ (+ minute-end org-agenda-default-appointment-duration))
+ (t minute-end)))
+ (h (cond ((not with-time-p) 0)
+ ((not end) hour-start)
+ ((or (not equal-bounds-p)
+ org-agenda-default-appointment-duration)
+ hour-end)
+ (t (+ hour-end 2))))
+ (d (cond ((not end) day-start)
+ ((not with-time-p) (1+ day-end))
+ (t day-end)))
+ (m (if end month-end month-start))
+ (y (if end year-end year-start)))
+ (concat
+ keyword
+ (format-time-string
+ (cond (utc ":%Y%m%dT%H%M%SZ")
+ ((not with-time-p) ";VALUE=DATE:%Y%m%d")
+ (t (replace-regexp-in-string "%Z"
+ org-icalendar-timezone
+ org-icalendar-date-time-format
+ t)))
+ ;; Convert timestamp into internal time in order to use
+ ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
+ (encode-time 0 mi h d m y)
+ (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p)))))))
+
+(defun org-icalendar-dtstamp ()
+ "Return DTSTAMP property, as a string."
+ (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t))
+
+(defun org-icalendar-get-categories (entry info)
+ "Return categories according to `org-icalendar-categories'.
+ENTRY is a headline or an inlinetask element. INFO is a plist
+used as a communication channel."
+ (mapconcat
+ 'identity
+ (org-uniquify
+ (let (categories)
+ (mapc (lambda (type)
+ (case type
+ (category
+ (push (org-export-get-category entry info) categories))
+ (todo-state
+ (let ((todo (org-element-property :todo-keyword entry)))
+ (and todo (push todo categories))))
+ (local-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info))
+ categories)))
+ (all-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info nil t))
+ categories)))))
+ org-icalendar-categories)
+ ;; Return list of categories, following specified order.
+ (nreverse categories))) ","))
+
+(defun org-icalendar-transcode-diary-sexp (sexp uid summary)
+ "Transcode a diary sexp into iCalendar format.
+SEXP is the diary sexp being transcoded, as a string. UID is the
+unique identifier for the entry. SUMMARY defines a short summary
+or subject for the event."
+ (when (require 'icalendar nil t)
+ (org-element-normalize-string
+ (with-temp-buffer
+ (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp
+ (concat (substring sexp 1 -1) " " summary))))
+ (put-text-property 0 1 'uid uid sexp)
+ (insert sexp "\n"))
+ (org-diary-to-ical-string (current-buffer))))))
+
+(defun org-icalendar-cleanup-string (s)
+ "Cleanup string S according to RFC 5545."
+ (when s
+ ;; Protect "\", "," and ";" characters. and replace newline
+ ;; characters with literal \n.
+ (replace-regexp-in-string
+ "[ \t]*\n" "\\n"
+ (replace-regexp-in-string "[\\,;]" "\\\\\\&" s)
+ nil t)))
+
+(defun org-icalendar-fold-string (s)
+ "Fold string S according to RFC 5545."
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (line)
+ ;; Limit each line to a maximum of 75 characters. If it is
+ ;; longer, fold it by using "\n " as a continuation marker.
+ (let ((len (length line)))
+ (if (<= len 75) line
+ (let ((folded-line (substring line 0 75))
+ (chunk-start 75)
+ chunk-end)
+ ;; Since continuation marker takes up one character on the
+ ;; line, real contents must be split at 74 chars.
+ (while (< (setq chunk-end (+ chunk-start 74)) len)
+ (setq folded-line
+ (concat folded-line "\n "
+ (substring line chunk-start chunk-end))
+ chunk-start chunk-end))
+ (concat folded-line "\n " (substring line chunk-start))))))
+ (org-split-string s "\n") "\n")))
+
+
+
+;;; Filters
+
+(defun org-icalendar-clear-blank-lines (headline back-end info)
+ "Remove blank lines in HEADLINE export.
+HEADLINE is a string representing a transcoded headline.
+BACK-END and INFO are ignored."
+ (replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" headline))
+
+
+
+;;; Transcode Functions
+
+;;;; Headline and Inlinetasks
+
+;; The main function is `org-icalendar-entry', which extracts
+;; information from a headline or an inlinetask (summary,
+;; description...) and then delegates code generation to
+;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending
+;; on the component needed.
+
+;; Obviously, `org-icalendar--valarm' handles alarms, which can
+;; happen within a VTODO component.
+
+(defun org-icalendar-entry (entry contents info)
+ "Transcode ENTRY element into iCalendar format.
+
+ENTRY is either a headline or an inlinetask. CONTENTS is
+ignored. INFO is a plist used as a communication channel.
+
+This function is called on every headline, the section below
+it (minus inlinetasks) being its contents. It tries to create
+VEVENT and VTODO components out of scheduled date, deadline date,
+plain timestamps, diary sexps. It also calls itself on every
+inlinetask within the section."
+ (unless (org-element-property :footnote-section-p entry)
+ (let* ((type (org-element-type entry))
+ ;; Determine contents really associated to the entry. For
+ ;; a headline, limit them to section, if any. For an
+ ;; inlinetask, this is every element within the task.
+ (inside
+ (if (eq type 'inlinetask)
+ (cons 'org-data (cons nil (org-element-contents entry)))
+ (let ((first (car (org-element-contents entry))))
+ (and (eq (org-element-type first) 'section)
+ (cons 'org-data
+ (cons nil (org-element-contents first))))))))
+ (concat
+ (unless (and (plist-get info :icalendar-agenda-view)
+ (not (org-element-property :ICALENDAR-MARK entry)))
+ (let ((todo-type (org-element-property :todo-type entry))
+ (uid (or (org-element-property :ID entry) (org-id-new)))
+ (summary (org-icalendar-cleanup-string
+ (or (org-element-property :SUMMARY entry)
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc (org-icalendar-cleanup-string
+ (org-element-property :LOCATION entry)))
+ ;; Build description of the entry from associated
+ ;; section (headline) or contents (inlinetask).
+ (desc
+ (org-icalendar-cleanup-string
+ (or (org-element-property :DESCRIPTION entry)
+ (let ((contents (org-export-data inside info)))
+ (cond
+ ((not (org-string-nw-p contents)) nil)
+ ((wholenump org-icalendar-include-body)
+ (let ((contents (org-trim contents)))
+ (substring
+ contents 0 (min (length contents)
+ org-icalendar-include-body))))
+ (org-icalendar-include-body (org-trim contents)))))))
+ (cat (org-icalendar-get-categories entry info)))
+ (concat
+ ;; Events: Delegate to `org-icalendar--vevent' to
+ ;; generate "VEVENT" component from scheduled, deadline,
+ ;; or any timestamp in the entry.
+ (let ((deadline (org-element-property :deadline entry)))
+ (and deadline
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-deadline)
+ (org-icalendar--vevent
+ entry deadline (concat "DL-" uid)
+ (concat "DL: " summary) loc desc cat)))
+ (let ((scheduled (org-element-property :scheduled entry)))
+ (and scheduled
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-scheduled)
+ (org-icalendar--vevent
+ entry scheduled (concat "SC-" uid)
+ (concat "S: " summary) loc desc cat)))
+ ;; When collecting plain timestamps from a headline and
+ ;; its title, skip inlinetasks since collection will
+ ;; happen once ENTRY is one of them.
+ (let ((counter 0))
+ (mapconcat
+ #'identity
+ (org-element-map (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'timestamp
+ (lambda (ts)
+ (when (let ((type (org-element-property :type ts)))
+ (case (plist-get info :with-timestamps)
+ (active (memq type '(active active-range)))
+ (inactive (memq type '(inactive inactive-range)))
+ ((t) t)))
+ (let ((uid (format "TS%d-%s" (incf counter) uid)))
+ (org-icalendar--vevent
+ entry ts uid summary loc desc cat))))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))
+ ;; Task: First check if it is appropriate to export it.
+ ;; If so, call `org-icalendar--vtodo' to transcode it
+ ;; into a "VTODO" component.
+ (when (and todo-type
+ (case (plist-get info :with-vtodo)
+ (all t)
+ (unblocked
+ (and (eq type 'headline)
+ (not (org-icalendar-blocked-headline-p
+ entry info))))
+ ((t) (eq todo-type 'todo))))
+ (org-icalendar--vtodo entry uid summary loc desc cat))
+ ;; Diary-sexp: Collect every diary-sexp element within
+ ;; ENTRY and its title, and transcode them. If ENTRY is
+ ;; a headline, skip inlinetasks: they will be handled
+ ;; separately.
+ (when org-icalendar-include-sexps
+ (let ((counter 0))
+ (mapconcat #'identity
+ (org-element-map
+ (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'diary-sexp
+ (lambda (sexp)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :value sexp)
+ (format "DS%d-%s" (incf counter) uid)
+ summary))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))))))
+ ;; If ENTRY is a headline, call current function on every
+ ;; inlinetask within it. In agenda export, this is independent
+ ;; from the mark (or lack thereof) on the entry.
+ (when (eq type 'headline)
+ (mapconcat #'identity
+ (org-element-map inside 'inlinetask
+ (lambda (task) (org-icalendar-entry task nil info))
+ info) ""))
+ ;; Don't forget components from inner entries.
+ contents))))
+
+(defun org-icalendar--vevent
+ (entry timestamp uid summary location description categories)
+ "Create a VEVENT component.
+
+ENTRY is either a headline or an inlinetask element. TIMESTAMP
+is a timestamp object defining the date-time of the event. UID
+is the unique identifier for the event. SUMMARY defines a short
+summary or subject for the event. LOCATION defines the intended
+venue for the event. DESCRIPTION provides the complete
+description of the event. CATEGORIES defines the categories the
+event belongs to.
+
+Return VEVENT component as a string."
+ (org-icalendar-fold-string
+ (if (eq (org-element-property :type timestamp) 'diary)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :raw-value timestamp) uid summary)
+ (concat "BEGIN:VEVENT\n"
+ (org-icalendar-dtstamp) "\n"
+ "UID:" uid "\n"
+ (org-icalendar-convert-timestamp timestamp "DTSTART") "\n"
+ (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n"
+ ;; RRULE.
+ (when (org-element-property :repeater-type timestamp)
+ (format "RRULE:FREQ=%s;INTERVAL=%d\n"
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "HOURLY") (day "DAILY") (week "WEEKLY")
+ (month "MONTHLY") (year "YEARLY"))
+ (org-element-property :repeater-value timestamp)))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ ;; VALARM.
+ (org-icalendar--valarm entry timestamp summary)
+ "END:VEVENT"))))
+
+(defun org-icalendar--vtodo
+ (entry uid summary location description categories)
+ "Create a VTODO component.
+
+ENTRY is either a headline or an inlinetask element. UID is the
+unique identifier for the task. SUMMARY defines a short summary
+or subject for the task. LOCATION defines the intended venue for
+the task. DESCRIPTION provides the complete description of the
+task. CATEGORIES defines the categories the task belongs to.
+
+Return VTODO component as a string."
+ (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
+ (org-element-property :scheduled entry))
+ ;; If we can't use a scheduled time for some
+ ;; reason, start task now.
+ (let ((now (decode-time)))
+ (list 'timestamp
+ (list :type 'active
+ :minute-start (nth 1 now)
+ :hour-start (nth 2 now)
+ :day-start (nth 3 now)
+ :month-start (nth 4 now)
+ :year-start (nth 5 now)))))))
+ (org-icalendar-fold-string
+ (concat "BEGIN:VTODO\n"
+ "UID:TODO-" uid "\n"
+ (org-icalendar-dtstamp) "\n"
+ (org-icalendar-convert-timestamp start "DTSTART") "\n"
+ (and (memq 'todo-due org-icalendar-use-deadline)
+ (org-element-property :deadline entry)
+ (concat (org-icalendar-convert-timestamp
+ (org-element-property :deadline entry) "DUE")
+ "\n"))
+ "SUMMARY:" summary "\n"
+ (and (org-string-nw-p location) (format "LOCATION:%s\n" location))
+ (and (org-string-nw-p description)
+ (format "DESCRIPTION:%s\n" description))
+ "CATEGORIES:" categories "\n"
+ "SEQUENCE:1\n"
+ (format "PRIORITY:%d\n"
+ (let ((pri (or (org-element-property :priority entry)
+ org-default-priority)))
+ (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri))
+ (- org-lowest-priority
+ org-highest-priority)))))))
+ (format "STATUS:%s\n"
+ (if (eq (org-element-property :todo-type entry) 'todo)
+ "NEEDS-ACTION"
+ "COMPLETED"))
+ "END:VTODO"))))
+
+(defun org-icalendar--valarm (entry timestamp summary)
+ "Create a VALARM component.
+
+ENTRY is the calendar entry triggering the alarm. TIMESTAMP is
+the start date-time of the entry. SUMMARY defines a short
+summary or subject for the task.
+
+Return VALARM component as a string, or nil if it isn't allowed."
+ ;; Create a VALARM entry if the entry is timed. This is not very
+ ;; general in that:
+ ;; (a) only one alarm per entry is defined,
+ ;; (b) only minutes are allowed for the trigger period ahead of the
+ ;; start time,
+ ;; (c) only a DISPLAY action is defined. [ESF]
+ (let ((alarm-time
+ (let ((warntime
+ (org-element-property :APPT_WARNTIME entry)))
+ (if warntime (string-to-number warntime) 0))))
+ (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0))
+ (org-element-property :hour-start timestamp)
+ (format "BEGIN:VALARM
+ACTION:DISPLAY
+DESCRIPTION:%s
+TRIGGER:-P0DT0H%dM0S
+END:VALARM\n"
+ summary
+ (if (zerop alarm-time) org-icalendar-alarm-time alarm-time)))))
+
+
+;;;; Template
+
+(defun org-icalendar-template (contents info)
+ "Return complete document string after iCalendar conversion.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ (org-icalendar--vcalendar
+ ;; Name.
+ (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer))
+ (file-name-nondirectory
+ (file-name-sans-extension (plist-get info :input-file))))
+ ;; Owner.
+ (if (not (plist-get info :with-author)) ""
+ (org-export-data (plist-get info :author) info))
+ ;; Timezone.
+ (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone
+ (cadr (current-time-zone)))
+ ;; Description.
+ (org-export-data (plist-get info :title) info)
+ contents))
+
+(defun org-icalendar--vcalendar (name owner tz description contents)
+ "Create a VCALENDAR component.
+NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving,
+respectively, the name of the calendar, its owner, the timezone
+used, a short description and the other components included."
+ (concat (format "BEGIN:VCALENDAR
+VERSION:2.0
+X-WR-CALNAME:%s
+PRODID:-//%s//Emacs with Org mode//EN
+X-WR-TIMEZONE:%s
+X-WR-CALDESC:%s
+CALSCALE:GREGORIAN\n"
+ (org-icalendar-cleanup-string name)
+ (org-icalendar-cleanup-string owner)
+ (org-icalendar-cleanup-string tz)
+ (org-icalendar-cleanup-string description))
+ contents
+ "END:VCALENDAR\n"))
+
+
+
+;;; Interactive Functions
+
+;;;###autoload
+(defun org-icalendar-export-to-ics
+ (&optional async subtreep visible-only body-only)
+ "Export current buffer to an iCalendar file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\".
+
+Return ICS file name."
+ (interactive)
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (when (and file org-icalendar-store-UID)
+ (org-icalendar-create-uid file 'warn-user)))
+ ;; Export part. Since this back-end is backed up by `ascii', ensure
+ ;; links will not be collected at the end of sections.
+ (let ((outfile (org-export-output-file-name ".ics" subtreep)))
+ (org-export-to-file 'icalendar outfile
+ async subtreep visible-only body-only '(:ascii-charset utf-8)
+ (lambda (file)
+ (run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
+
+;;;###autoload
+(defun org-icalendar-export-agenda-files (&optional async)
+ "Export all agenda files to iCalendar files.
+When optional argument ASYNC is non-nil, export happens in an
+external process."
+ (interactive)
+ (if async
+ ;; Asynchronous export is not interactive, so we will not call
+ ;; `org-check-agenda-file'. Instead we remove any non-existent
+ ;; agenda file from the list.
+ (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (org-export-async-start
+ (lambda (results)
+ (mapc (lambda (f) (org-export-add-to-stack f 'icalendar))
+ results))
+ `(let (output-files)
+ (mapc (lambda (file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (push (expand-file-name (org-icalendar-export-to-ics))
+ output-files)))
+ ',files)
+ output-files)))
+ (let ((files (org-agenda-files t)))
+ (org-agenda-prepare-buffers files)
+ (unwind-protect
+ (mapc (lambda (file)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (org-icalendar-export-to-ics))))
+ files)
+ (org-release-buffers org-agenda-new-buffers)))))
+
+;;;###autoload
+(defun org-icalendar-combine-agenda-files (&optional async)
+ "Combine all agenda files into a single iCalendar file.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+The file is stored under the name chosen in
+`org-icalendar-combined-agenda-file'."
+ (interactive)
+ (if async
+ (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (org-export-async-start
+ (lambda (dummy)
+ (org-export-add-to-stack
+ (expand-file-name org-icalendar-combined-agenda-file)
+ 'icalendar))
+ `(apply 'org-icalendar--combine-files nil ',files)))
+ (apply 'org-icalendar--combine-files nil (org-agenda-files t))))
+
+(defun org-icalendar-export-current-agenda (file)
+ "Export current agenda view to an iCalendar FILE.
+This function assumes major mode for current buffer is
+`org-agenda-mode'."
+ (let (org-export-babel-evaluate ; Don't evaluate Babel block
+ (org-icalendar-combined-agenda-file file)
+ (marker-list
+ ;; Collect the markers pointing to entries in the current
+ ;; agenda buffer.
+ (let (markers)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((m (or (org-get-at-bol 'org-hd-marker)
+ (org-get-at-bol 'org-marker))))
+ (and m (push m markers)))
+ (beginning-of-line 2)))
+ (nreverse markers))))
+ (apply 'org-icalendar--combine-files
+ ;; Build restriction alist.
+ (let (restriction)
+ ;; Sort markers in each association within RESTRICTION.
+ (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
+ (dolist (m marker-list restriction)
+ (let* ((pos (marker-position m))
+ (file (buffer-file-name
+ (org-base-buffer (marker-buffer m))))
+ (file-markers (assoc file restriction)))
+ ;; Add POS in FILE association if one exists
+ ;; or create a new association for FILE.
+ (if file-markers (push pos (cdr file-markers))
+ (push (list file pos) restriction))))))
+ (org-agenda-files nil 'ifmode))))
+
+(defun org-icalendar--combine-files (restriction &rest files)
+ "Combine entries from multiple files into an iCalendar file.
+RESTRICTION, when non-nil, is an alist where key is a file name
+and value a list of buffer positions pointing to entries that
+should appear in the calendar. It only makes sense if the
+function was called from an agenda buffer. FILES is a list of
+files to build the calendar from."
+ (org-agenda-prepare-buffers files)
+ (unwind-protect
+ (progn
+ (with-temp-file org-icalendar-combined-agenda-file
+ (insert
+ (org-icalendar--vcalendar
+ ;; Name.
+ org-icalendar-combined-name
+ ;; Owner.
+ user-full-name
+ ;; Timezone.
+ (or (org-string-nw-p org-icalendar-timezone)
+ (cadr (current-time-zone)))
+ ;; Description.
+ org-icalendar-combined-description
+ ;; Contents.
+ (concat
+ ;; Agenda contents.
+ (mapconcat
+ (lambda (file)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (let ((marks (cdr (assoc (expand-file-name file)
+ restriction))))
+ ;; Create ID if necessary.
+ (when org-icalendar-store-UID
+ (org-icalendar-create-uid file t marks))
+ (unless (and restriction (not marks))
+ ;; Add a hook adding :ICALENDAR_MARK: property
+ ;; to each entry appearing in agenda view.
+ ;; Use `apply-partially' because the function
+ ;; still has to accept one argument.
+ (let ((org-export-before-processing-hook
+ (cons (apply-partially
+ (lambda (m-list dummy)
+ (mapc (lambda (m)
+ (org-entry-put
+ m "ICALENDAR-MARK" "t"))
+ m-list))
+ (sort marks '>))
+ org-export-before-processing-hook)))
+ (org-export-as
+ 'icalendar nil nil t
+ (list :ascii-charset 'utf-8
+ :icalendar-agenda-view restriction))))))))
+ files "")
+ ;; BBDB anniversaries.
+ (when (and org-icalendar-include-bbdb-anniversaries
+ (require 'org-bbdb nil t))
+ (with-output-to-string (org-bbdb-anniv-export-ical)))))))
+ (run-hook-with-args 'org-icalendar-after-save-hook
+ org-icalendar-combined-agenda-file))
+ (org-release-buffers org-agenda-new-buffers)))
+
+
+(provide 'ox-icalendar)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-icalendar.el ends here
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
new file mode 100644
index 00000000000..51f7b17a8bf
--- /dev/null
+++ b/lisp/org/ox-latex.el
@@ -0,0 +1,2951 @@
+;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; See Org manual for details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+(require 'ox-publish)
+
+(defvar org-latex-default-packages-alist)
+(defvar org-latex-packages-alist)
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'latex
+ '((bold . org-latex-bold)
+ (center-block . org-latex-center-block)
+ (clock . org-latex-clock)
+ (code . org-latex-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-latex-drawer)
+ (dynamic-block . org-latex-dynamic-block)
+ (entity . org-latex-entity)
+ (example-block . org-latex-example-block)
+ (export-block . org-latex-export-block)
+ (export-snippet . org-latex-export-snippet)
+ (fixed-width . org-latex-fixed-width)
+ (footnote-definition . org-latex-footnote-definition)
+ (footnote-reference . org-latex-footnote-reference)
+ (headline . org-latex-headline)
+ (horizontal-rule . org-latex-horizontal-rule)
+ (inline-src-block . org-latex-inline-src-block)
+ (inlinetask . org-latex-inlinetask)
+ (italic . org-latex-italic)
+ (item . org-latex-item)
+ (keyword . org-latex-keyword)
+ (latex-environment . org-latex-latex-environment)
+ (latex-fragment . org-latex-latex-fragment)
+ (line-break . org-latex-line-break)
+ (link . org-latex-link)
+ (paragraph . org-latex-paragraph)
+ (plain-list . org-latex-plain-list)
+ (plain-text . org-latex-plain-text)
+ (planning . org-latex-planning)
+ (property-drawer . (lambda (&rest args) ""))
+ (quote-block . org-latex-quote-block)
+ (quote-section . org-latex-quote-section)
+ (radio-target . org-latex-radio-target)
+ (section . org-latex-section)
+ (special-block . org-latex-special-block)
+ (src-block . org-latex-src-block)
+ (statistics-cookie . org-latex-statistics-cookie)
+ (strike-through . org-latex-strike-through)
+ (subscript . org-latex-subscript)
+ (superscript . org-latex-superscript)
+ (table . org-latex-table)
+ (table-cell . org-latex-table-cell)
+ (table-row . org-latex-table-row)
+ (target . org-latex-target)
+ (template . org-latex-template)
+ (timestamp . org-latex-timestamp)
+ (underline . org-latex-underline)
+ (verbatim . org-latex-verbatim)
+ (verse-block . org-latex-verse-block))
+ :export-block '("LATEX" "TEX")
+ :menu-entry
+ '(?l "Export to LaTeX"
+ ((?L "As LaTeX buffer" org-latex-export-as-latex)
+ (?l "As LaTeX file" org-latex-export-to-latex)
+ (?p "As PDF file" org-latex-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-latex-export-to-pdf t s v b)
+ (org-open-file (org-latex-export-to-pdf nil s v b)))))))
+ :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
+ (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+ (:latex-header "LATEX_HEADER" nil nil newline)
+ (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
+ (:latex-hyperref-p nil "texht" org-latex-with-hyperref t)
+ ;; Redefine regular options.
+ (:date "DATE" nil "\\today" t)))
+
+
+
+;;; Internal Variables
+
+(defconst org-latex-babel-language-alist
+ '(("af" . "afrikaans")
+ ("bg" . "bulgarian")
+ ("bt-br" . "brazilian")
+ ("ca" . "catalan")
+ ("cs" . "czech")
+ ("cy" . "welsh")
+ ("da" . "danish")
+ ("de" . "germanb")
+ ("de-at" . "naustrian")
+ ("de-de" . "ngerman")
+ ("el" . "greek")
+ ("en" . "english")
+ ("en-au" . "australian")
+ ("en-ca" . "canadian")
+ ("en-gb" . "british")
+ ("en-ie" . "irish")
+ ("en-nz" . "newzealand")
+ ("en-us" . "american")
+ ("es" . "spanish")
+ ("et" . "estonian")
+ ("eu" . "basque")
+ ("fi" . "finnish")
+ ("fr" . "frenchb")
+ ("fr-ca" . "canadien")
+ ("gl" . "galician")
+ ("hr" . "croatian")
+ ("hu" . "hungarian")
+ ("id" . "indonesian")
+ ("is" . "icelandic")
+ ("it" . "italian")
+ ("la" . "latin")
+ ("ms" . "malay")
+ ("nl" . "dutch")
+ ("nb" . "norsk")
+ ("nn" . "nynorsk")
+ ("no" . "norsk")
+ ("pl" . "polish")
+ ("pt" . "portuguese")
+ ("ro" . "romanian")
+ ("ru" . "russian")
+ ("sa" . "sanskrit")
+ ("sb" . "uppersorbian")
+ ("sk" . "slovak")
+ ("sl" . "slovene")
+ ("sq" . "albanian")
+ ("sr" . "serbian")
+ ("sv" . "swedish")
+ ("ta" . "tamil")
+ ("tr" . "turkish")
+ ("uk" . "ukrainian"))
+ "Alist between language code and corresponding Babel option.")
+
+(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
+ ("qbordermatrix" . "\\cr")
+ ("kbordermatrix" . "\\\\"))
+ "Alist between matrix macros and their row ending.")
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-latex nil
+ "Options for exporting Org mode files to LaTeX."
+ :tag "Org Export LaTeX"
+ :group 'org-export)
+
+
+;;;; Preamble
+
+(defcustom org-latex-default-class "article"
+ "The default LaTeX class."
+ :group 'org-export-latex
+ :type '(string :tag "LaTeX class"))
+
+(defcustom org-latex-classes
+ '(("article"
+ "\\documentclass[11pt]{article}"
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
+ ("\\paragraph{%s}" . "\\paragraph*{%s}")
+ ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
+ ("report"
+ "\\documentclass[11pt]{report}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
+ ("book"
+ "\\documentclass[11pt]{book}"
+ ("\\part{%s}" . "\\part*{%s}")
+ ("\\chapter{%s}" . "\\chapter*{%s}")
+ ("\\section{%s}" . "\\section*{%s}")
+ ("\\subsection{%s}" . "\\subsection*{%s}")
+ ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))
+ "Alist of LaTeX classes and associated header and structure.
+If #+LATEX_CLASS is set in the buffer, use its value and the
+associated information. Here is the structure of each cell:
+
+ (class-name
+ header-string
+ (numbered-section . unnumbered-section)
+ ...)
+
+The header string
+-----------------
+
+The HEADER-STRING is the header that will be inserted into the
+LaTeX file. It should contain the \\documentclass macro, and
+anything else that is needed for this setup. To this header, the
+following commands will be added:
+
+- Calls to \\usepackage for all packages mentioned in the
+ variables `org-latex-default-packages-alist' and
+ `org-latex-packages-alist'. Thus, your header definitions
+ should avoid to also request these packages.
+
+- Lines specified via \"#+LATEX_HEADER:\" and
+ \"#+LATEX_HEADER_EXTRA:\" keywords.
+
+If you need more control about the sequence in which the header
+is built up, or if you want to exclude one of these building
+blocks for a particular class, you can use the following
+macro-like placeholders.
+
+ [DEFAULT-PACKAGES] \\usepackage statements for default packages
+ [NO-DEFAULT-PACKAGES] do not include any of the default packages
+ [PACKAGES] \\usepackage statements for packages
+ [NO-PACKAGES] do not include the packages
+ [EXTRA] the stuff from #+LATEX_HEADER(_EXTRA)
+ [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) stuff
+
+So a header like
+
+ \\documentclass{article}
+ [NO-DEFAULT-PACKAGES]
+ [EXTRA]
+ \\providecommand{\\alert}[1]{\\textbf{#1}}
+ [PACKAGES]
+
+will omit the default packages, and will include the
+#+LATEX_HEADER and #+LATEX_HEADER_EXTRA lines, then have a call
+to \\providecommand, and then place \\usepackage commands based
+on the content of `org-latex-packages-alist'.
+
+If your header, `org-latex-default-packages-alist' or
+`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\",
+AUTO will automatically be replaced with a coding system derived
+from `buffer-file-coding-system'. See also the variable
+`org-latex-inputenc-alist' for a way to influence this mechanism.
+
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
+AUTO will be replaced with the language related to the language
+code specified by `org-export-default-language', which see. Note
+that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
+are permitted.
+
+The sectioning structure
+------------------------
+
+The sectioning structure of the class is given by the elements
+following the header string. For each sectioning level, a number
+of strings is specified. A %s formatter is mandatory in each
+section string and will be replaced by the title of the section.
+
+Instead of a cons cell (numbered . unnumbered), you can also
+provide a list of 2 or 4 elements,
+
+ (numbered-open numbered-close)
+
+or
+
+ (numbered-open numbered-close unnumbered-open unnumbered-close)
+
+providing opening and closing strings for a LaTeX environment
+that should represent the document section. The opening clause
+should have a %s to represent the section title.
+
+Instead of a list of sectioning commands, you can also specify
+a function name. That function will be called with two
+parameters, the (reduced) level of the headline, and a predicate
+non-nil when the headline should be numbered. It must return
+a format string in which the section title will be added."
+ :group 'org-export-latex
+ :type '(repeat
+ (list (string :tag "LaTeX class")
+ (string :tag "LaTeX header")
+ (repeat :tag "Levels" :inline t
+ (choice
+ (cons :tag "Heading"
+ (string :tag " numbered")
+ (string :tag "unnumbered"))
+ (list :tag "Environment"
+ (string :tag "Opening (numbered)")
+ (string :tag "Closing (numbered)")
+ (string :tag "Opening (unnumbered)")
+ (string :tag "Closing (unnumbered)"))
+ (function :tag "Hook computing sectioning"))))))
+
+(defcustom org-latex-inputenc-alist nil
+ "Alist of inputenc coding system names, and what should really be used.
+For example, adding an entry
+
+ (\"utf8\" . \"utf8x\")
+
+will cause \\usepackage[utf8x]{inputenc} to be used for buffers that
+are written as utf8 files."
+ :group 'org-export-latex
+ :type '(repeat
+ (cons
+ (string :tag "Derived from buffer")
+ (string :tag "Use this instead"))))
+
+(defcustom org-latex-title-command "\\maketitle"
+ "The command used to insert the title just after \\begin{document}.
+If this string contains the formatting specification \"%s\" then
+it will be used as a formatting string, passing the title as an
+argument."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-toc-command "\\tableofcontents\n\n"
+ "LaTeX command to set the table of contents, list of figures, etc.
+This command only applies to the table of contents generated with
+the toc:nil option, not to those generated with #+TOC keyword."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-with-hyperref t
+ "Toggle insertion of \\hypersetup{...} in the preamble."
+ :group 'org-export-latex
+ :type 'boolean)
+
+;;;; Headline
+
+(defcustom org-latex-format-headline-function
+ 'org-latex-format-headline-default-function
+ "Function for formatting the headline's text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags as a list of strings (list of strings or nil).
+
+The function result will be used in the section format string.
+
+Use `org-latex-format-headline-default-function' by default,
+which format headlines like for Org version prior to 8.0."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; Footnotes
+
+(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\,"
+ "Text used to separate footnotes."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Timestamps
+
+(defcustom org-latex-active-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-inactive-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-diary-timestamp-format "\\textit{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Links
+
+(defcustom org-latex-image-default-option ""
+ "Default option for images."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-image-default-width ".9\\linewidth"
+ "Default width for images.
+This value will not be used if a height is provided."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-image-default-height ""
+ "Default height for images.
+This value will not be used if a width is provided, or if the
+image is wrapped within a \"figure\" or \"wrapfigure\"
+environment."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-default-figure-position "htb"
+ "Default position for latex figures."
+ :group 'org-export-latex
+ :type 'string)
+
+(defcustom org-latex-inline-image-rules
+ '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
+ "Rules characterizing image files that can be inlined into LaTeX.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path.
+
+Note that, by default, the image extension *actually* allowed
+depend on the way the LaTeX file is processed. When used with
+pdflatex, pdf, jpg and png images are OK. When processing
+through dvi to Postscript, only ps and eps are allowed. The
+default we use here encompasses both."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-latex-link-with-unknown-path-format "\\texttt{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-latex
+ :type 'string)
+
+
+;;;; Tables
+
+(defcustom org-latex-default-table-environment "tabular"
+ "Default environment used to build tables."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-latex-default-table-mode 'table
+ "Default mode for tables.
+
+Value can be a symbol among:
+
+ `table' Regular LaTeX table.
+
+ `math' In this mode, every cell is considered as being in math
+ mode and the complete table will be wrapped within a math
+ environment. It is particularly useful to write matrices.
+
+ `inline-math' This mode is almost the same as `math', but the
+ math environment will be inlined.
+
+ `verbatim' The table is exported as it appears in the Org
+ buffer, within a verbatim environment.
+
+This value can be overridden locally with, i.e. \":mode math\" in
+LaTeX attributes.
+
+When modifying this variable, it may be useful to change
+`org-latex-default-table-environment' accordingly."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice (const :tag "Table" table)
+ (const :tag "Matrix" math)
+ (const :tag "Inline matrix" inline-math)
+ (const :tag "Verbatim" verbatim)))
+
+(defcustom org-latex-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-latex-tables-booktabs nil
+ "When non-nil, display tables in a formal \"booktabs\" style.
+This option assumes that the \"booktabs\" package is properly
+loaded in the header of the document. This value can be ignored
+locally with \":booktabs t\" and \":booktabs nil\" LaTeX
+attributes."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-latex-table-caption-above t
+ "When non-nil, place caption string at the beginning of the table.
+Otherwise, place it near the end."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-latex-table-scientific-notation "%s\\,(%s)"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e., \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting" nil)))
+
+
+;;;; Text markup
+
+(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}")
+ (code . verb)
+ (italic . "\\emph{%s}")
+ (strike-through . "\\sout{%s}")
+ (underline . "\\uline{%s}")
+ (verbatim . protectedtexttt))
+ "Alist of LaTeX expressions to convert text markup.
+
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underline' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
+
+Value can also be set to the following symbols: `verb' and
+`protectedtexttt'. For the former, Org will use \"\\verb\" to
+create a format string and select a delimiter character that
+isn't in the string. For the latter, Org will use \"\\texttt\"
+to typeset and try to protect special characters.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-latex
+ :type 'alist
+ :options '(bold code italic strike-through underline verbatim))
+
+
+;;;; Drawers
+
+(defcustom org-latex-format-drawer-function
+ (lambda (name contents) contents)
+ "Function called to format a drawer in LaTeX code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+The default function simply returns the value of CONTENTS."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-latex-format-inlinetask-function 'ignore
+ "Function called to format an inlinetask in LaTeX code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behavior:
+
+\(defun org-latex-format-inlinetask (todo type priority name tags contents)
+\"Format an inline task element for LaTeX export.\"
+ (let ((full-title
+ (concat
+ (when todo
+ (format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
+ (when priority (format \"\\\\framebox{\\\\#%c} \" priority))
+ title
+ (when tags
+ (format \"\\\\hfill{}\\\\textsc{:%s:}\"
+ (mapconcat \\='identity tags \":\")))))
+ (format (concat \"\\\\begin{center}\\n\"
+ \"\\\\fbox{\\n\"
+ \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
+ \"%s\\n\\n\"
+ \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
+ \"%s\"
+ \"\\\\end{minipage}}\"
+ \"\\\\end{center}\")
+ full-title contents))"
+ :group 'org-export-latex
+ :type 'function)
+
+
+;; Src blocks
+
+(defcustom org-latex-listings nil
+ "Non-nil means export source code using the listings package.
+
+This package will fontify source code, possibly even with color.
+If you want to use this, you also need to make LaTeX use the
+listings package, and if you want to have color, the color
+package. Just add these to `org-latex-packages-alist', for
+example using customize, or with something like:
+
+ (require \\='ox-latex)
+ (add-to-list \\='org-latex-packages-alist \\='(\"\" \"listings\"))
+ (add-to-list \\='org-latex-packages-alist \\='(\"\" \"color\"))
+
+Alternatively,
+
+ (setq org-latex-listings \\='minted)
+
+causes source code to be exported using the minted package as
+opposed to listings. If you want to use minted, you need to add
+the minted package to `org-latex-packages-alist', for example
+using customize, or with
+
+ (require \\='ox-latex)
+ (add-to-list \\='org-latex-packages-alist \\='(\"\" \"minted\"))
+
+In addition, it is necessary to install pygments
+\(http://pygments.org), and to configure the variable
+`org-latex-pdf-process' so that the -shell-escape option is
+passed to pdflatex.
+
+The minted choice has possible repercussions on the preview of
+latex fragments (see `org-preview-latex-fragment'). If you run
+into previewing problems, please consult
+
+ http://orgmode.org/worg/org-tutorials/org-latex-preview.html"
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Use listings" t)
+ (const :tag "Use minted" minted)
+ (const :tag "Export verbatim" nil)))
+
+(defcustom org-latex-listings-langs
+ '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
+ (c "C") (cc "C++")
+ (fortran "fortran")
+ (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
+ (html "HTML") (xml "XML")
+ (tex "TeX") (latex "[LaTeX]TeX")
+ (shell-script "bash")
+ (gnuplot "Gnuplot")
+ (ocaml "Caml") (caml "Caml")
+ (sql "SQL") (sqlite "sql"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the listings package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present."
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+(defcustom org-latex-listings-options nil
+ "Association list of options for the latex listings package.
+
+These options are supplied as a comma-separated list to the
+\\lstset command. Each element of the association list should be
+a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-latex-listings-options
+ '((\"basicstyle\" \"\\\\small\")
+ (\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\")))
+
+will typeset the code in a small size font with underlined, bold
+black keywords.
+
+Note that the same options will be applied to blocks of all
+languages."
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (string :tag "Listings option name ")
+ (string :tag "Listings option value"))))
+
+(defcustom org-latex-minted-langs
+ '((emacs-lisp "common-lisp")
+ (cc "c++")
+ (cperl "perl")
+ (shell-script "bash")
+ (caml "ocaml"))
+ "Alist mapping languages to their minted language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the minted package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present.
+
+Note that minted uses all lower case for language identifiers,
+and that the full list of language identifiers can be obtained
+with:
+
+ pygmentize -L lexers"
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Minted language"))))
+
+(defcustom org-latex-minted-options nil
+ "Association list of options for the latex minted package.
+
+These options are supplied within square brackets in
+\\begin{minted} environments. Each element of the alist should
+be a list containing two strings: the name of the option, and the
+value. For example,
+
+ (setq org-latex-minted-options
+ '((\"bgcolor\" \"bg\") (\"frame\" \"lines\")))
+
+will result in src blocks being exported with
+
+\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
+
+as the start of the minted environment. Note that the same
+options will be applied to blocks of all languages."
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (string :tag "Minted option name ")
+ (string :tag "Minted option value"))))
+
+(defvar org-latex-custom-lang-environments nil
+ "Alist mapping languages to language-specific LaTeX environments.
+
+It is used during export of src blocks by the listings and minted
+latex packages. For example,
+
+ (setq org-latex-custom-lang-environments
+ '((python \"pythoncode\")))
+
+would have the effect that if org encounters begin_src python
+during latex export it will output
+
+ \\begin{pythoncode}
+ <src block body>
+ \\end{pythoncode}")
+
+
+;;;; Compilation
+
+(defcustom org-latex-pdf-process
+ '("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f")
+ "Commands to process a LaTeX file to a PDF file.
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+full file name, %b by the file base name (i.e. without directory
+and extension parts) and %o by the base directory of the file.
+
+The reason why this is a list is that it usually takes several
+runs of `pdflatex', maybe mixed with a call to `bibtex'. Org
+does not have a clever mechanism to detect which of these
+commands have to be run to get to a stable result, and it also
+does not do any error checking.
+
+By default, Org uses 3 runs of `pdflatex' to do the processing.
+If you have texi2dvi on your system and if that does not cause
+the infamous egrep/locale bug:
+
+ http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
+
+then `texi2dvi' is the superior choice as it automates the LaTeX
+build process by calling the \"correct\" combinations of
+auxiliary programs. Org does offer `texi2dvi' as one of the
+customize options. Alternatively, `rubber' and `latexmk' also
+provide similar functionality. The latter supports `biber' out
+of the box.
+
+Alternatively, this may be a Lisp function that does the
+processing, so you could use this to apply the machinery of
+AUCTeX or the Emacs LaTeX mode. This function should accept the
+file name as its single argument."
+ :group 'org-export-pdf
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
+ ("pdflatex -interaction nonstopmode -output-directory %o %f"
+ "bibtex %b"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"
+ "pdflatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "2 runs of xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "xelatex,bibtex,xelatex,xelatex"
+ ("xelatex -interaction nonstopmode -output-directory %o %f"
+ "bibtex %b"
+ "xelatex -interaction nonstopmode -output-directory %o %f"
+ "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "texi2dvi"
+ ("texi2dvi -p -b -V %f"))
+ (const :tag "rubber"
+ ("rubber -d --into %o %f"))
+ (const :tag "latexmk"
+ ("latexmk -g -pdf %f"))
+ (function)))
+
+(defcustom org-latex-logfiles-extensions
+ '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ "The list of file extensions to consider as LaTeX logfiles.
+The logfiles will be remove if `org-latex-remove-logfiles' is
+non-nil."
+ :group 'org-export-latex
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-latex-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+By default, logfiles are files with these extensions: .aux, .idx,
+.log, .out, .toc, .nav, .snm and .vrb. To define the set of
+logfiles to remove, set `org-latex-logfiles-extensions'."
+ :group 'org-export-latex
+ :type 'boolean)
+
+(defcustom org-latex-known-errors
+ '(("Reference.*?undefined" . "[undefined reference]")
+ ("Citation.*?undefined" . "[undefined citation]")
+ ("Undefined control sequence" . "[undefined control sequence]")
+ ("^! LaTeX.*?Error" . "[LaTeX error]")
+ ("^! Package.*?Error" . "[package error]")
+ ("Runaway argument" . "Runaway argument"))
+ "Alist of regular expressions and associated messages for the user.
+The regular expressions are used to find possible errors in the
+log of a latex-run."
+ :group 'org-export-latex
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat
+ (cons
+ (string :tag "Regexp")
+ (string :tag "Message"))))
+
+
+
+;;; Internal Functions
+
+(defun org-latex--caption/label-string (element info)
+ "Return caption and label LaTeX string for ELEMENT.
+
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
+
+For non-floats, see `org-latex--wrap-label'."
+ (let* ((label (org-element-property :name element))
+ (label-str (if (not (org-string-nw-p label)) ""
+ (format "\\label{%s}"
+ (org-export-solidify-link-text label))))
+ (main (org-export-get-caption element))
+ (short (org-export-get-caption element t))
+ (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption)))
+ (cond
+ ((org-string-nw-p caption-from-attr-latex)
+ (concat caption-from-attr-latex "\n"))
+ ((and (not main) (equal label-str "")) "")
+ ((not main) (concat label-str "\n"))
+ ;; Option caption format with short name.
+ (short (format "\\caption[%s]{%s%s}\n"
+ (org-export-data short info)
+ label-str
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\caption{%s%s}\n" label-str (org-export-data main info))))))
+
+(defun org-latex-guess-inputenc (header)
+ "Set the coding system in inputenc to what the buffer is.
+
+HEADER is the LaTeX header string. This function only applies
+when specified inputenc option is \"AUTO\".
+
+Return the new header, as a string."
+ (let* ((cs (or (ignore-errors
+ (latexenc-coding-system-to-inputenc
+ (or org-export-coding-system buffer-file-coding-system)))
+ "utf8")))
+ (if (not cs) header
+ ;; First translate if that is requested.
+ (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs))
+ ;; Then find the \usepackage statement and replace the option.
+ (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}"
+ cs header t nil 1))))
+
+(defun org-latex-guess-babel-language (header info)
+ "Set Babel's language according to LANGUAGE keyword.
+
+HEADER is the LaTeX header string. INFO is the plist used as
+a communication channel.
+
+Insertion of guessed language only happens when Babel package has
+explicitly been loaded. Then it is added to the rest of
+package's options.
+
+The argument to Babel may be \"AUTO\" which is then replaced with
+the language of the document or `org-export-default-language'
+unless language in question is already loaded.
+
+Return the new header."
+ (let ((language-code (plist-get info :language)))
+ ;; If no language is set or Babel package is not loaded, return
+ ;; HEADER as-is.
+ (if (or (not (stringp language-code))
+ (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
+ header
+ (let ((options (save-match-data
+ (org-split-string (match-string 1 header) ",[ \t]*")))
+ (language (cdr (assoc language-code
+ org-latex-babel-language-alist))))
+ ;; If LANGUAGE is already loaded, return header without AUTO.
+ ;; Otherwise, replace AUTO with language or append language if
+ ;; AUTO is not present.
+ (replace-match
+ (mapconcat (lambda (option) (if (equal "AUTO" option) language option))
+ (cond ((member language options) (delete "AUTO" options))
+ ((member "AUTO" options) options)
+ (t (append options (list language))))
+ ", ")
+ t nil header 1)))))
+
+(defun org-latex--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-latex--make-option-string (options)
+ "Return a comma separated string of keywords and values.
+OPTIONS is an alist where the key is the options keyword as
+a string, and the value a list containing the keyword value, or
+nil."
+ (mapconcat (lambda (pair)
+ (concat (first pair)
+ (when (> (length (second pair)) 0)
+ (concat "=" (second pair)))))
+ options
+ ","))
+
+(defun org-latex--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-latex--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output
+ (concat (format "\\label{%s}\n" (org-export-solidify-link-text label))
+ output))))
+
+(defun org-latex--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-latex-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-latex-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ;; Handle the `verb' special case: Find and appropriate separator
+ ;; and use "\\verb" command.
+ ((eq 'verb fmt)
+ (let ((separator (org-latex--find-verb-separator text)))
+ (concat "\\verb" separator
+ (replace-regexp-in-string "\n" " " text)
+ separator)))
+ ;; Handle the `protectedtexttt' special case: Protect some
+ ;; special chars and use "\texttt{%s}" format string.
+ ((eq 'protectedtexttt fmt)
+ (let ((start 0)
+ (trans '(("\\" . "\\textbackslash{}")
+ ("~" . "\\textasciitilde{}")
+ ("^" . "\\textasciicircum{}")))
+ (rtn "")
+ char)
+ (while (string-match "[\\{}$%&_#~^]" text)
+ (setq char (match-string 0 text))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
+ (setq text (substring text (1+ (match-beginning 0))))
+ (setq char (or (cdr (assoc char trans)) (concat "\\" char))
+ rtn (concat rtn char)))
+ (setq text (concat rtn text)
+ fmt "\\texttt{%s}")
+ (while (string-match "--" text)
+ (setq text (replace-match "-{}-" t t text)))
+ (format fmt text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
+
+(defun org-latex--delayed-footnotes-definitions (element info)
+ "Return footnotes definitions in ELEMENT as a string.
+
+INFO is a plist used as a communication channel.
+
+Footnotes definitions are returned within \"\\footnotetxt{}\"
+commands.
+
+This function is used within constructs that don't support
+\"\\footnote{}\" command (i.e. an item's tag). In that case,
+\"\\footnotemark\" is used within the construct and the function
+just outside of it."
+ (mapconcat
+ (lambda (ref)
+ (format
+ "\\footnotetext[%s]{%s}"
+ (org-export-get-footnote-number ref info)
+ (org-trim
+ (org-export-data
+ (org-export-get-footnote-definition ref info) info))))
+ ;; Find every footnote reference in ELEMENT.
+ (let* (all-refs
+ search-refs ; For byte-compiler.
+ (search-refs
+ (function
+ (lambda (data)
+ ;; Return a list of all footnote references never seen
+ ;; before in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (ref)
+ (when (org-export-footnote-first-reference-p ref info)
+ (push ref all-refs)
+ (when (eq (org-element-property :type ref) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition ref info)))))
+ info)
+ (reverse all-refs)))))
+ (funcall search-refs element))
+ ""))
+
+
+
+;;; Template
+
+(defun org-latex-template (contents info)
+ "Return complete document string after LaTeX conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let ((title (org-export-data (plist-get info :title) info)))
+ (concat
+ ;; Time-stamp.
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; Document class and packages.
+ (let* ((class (plist-get info :latex-class))
+ (class-options (plist-get info :latex-class-options))
+ (header (nth 1 (assoc class org-latex-classes)))
+ (document-class-string
+ (and (stringp header)
+ (if (not class-options) header
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
+ class-options header t nil 1)))))
+ (if (not document-class-string)
+ (user-error "Unknown LaTeX class `%s'" class)
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-element-normalize-string
+ (org-splice-latex-header
+ document-class-string
+ org-latex-default-packages-alist
+ org-latex-packages-alist nil
+ (concat (org-element-normalize-string
+ (plist-get info :latex-header))
+ (plist-get info :latex-header-extra)))))
+ info)))
+ ;; Possibly limit depth for headline numbering.
+ (let ((sec-num (plist-get info :section-numbers)))
+ (when (integerp sec-num)
+ (format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
+ ;; Author.
+ (let ((author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (and (plist-get info :with-email)
+ (org-export-data (plist-get info :email) info))))
+ (cond ((and author email (not (string= "" email)))
+ (format "\\author{%s\\thanks{%s}}\n" author email))
+ ((or author email) (format "\\author{%s}\n" (or author email)))))
+ ;; Date.
+ (let ((date (and (plist-get info :with-date) (org-export-get-date info))))
+ (format "\\date{%s}\n" (org-export-data date info)))
+ ;; Title
+ (format "\\title{%s}\n" title)
+ ;; Hyperref options.
+ (when (plist-get info :latex-hyperref-p)
+ (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
+ (or (plist-get info :keywords) "")
+ (or (plist-get info :description) "")
+ (if (not (plist-get info :with-creator)) ""
+ (plist-get info :creator))))
+ ;; Document start.
+ "\\begin{document}\n\n"
+ ;; Title command.
+ (org-element-normalize-string
+ (cond ((string= "" title) nil)
+ ((not (stringp org-latex-title-command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s"
+ org-latex-title-command)
+ (format org-latex-title-command title))
+ (t org-latex-title-command)))
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%d}\n" depth))
+ org-latex-toc-command)))
+ ;; Document's body.
+ contents
+ ;; Creator.
+ (let ((creator-info (plist-get info :with-creator)))
+ (cond
+ ((not creator-info) "")
+ ((eq creator-info 'comment)
+ (format "%% %s\n" (plist-get info :creator)))
+ (t (concat (plist-get info :creator) "\n"))))
+ ;; Document end.
+ "\\end{document}")))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-latex-bold (bold contents info)
+ "Transcode BOLD from Org to LaTeX.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (org-latex--text-markup contents 'bold))
+
+
+;;;; Center Block
+
+(defun org-latex-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-latex--wrap-label
+ center-block
+ (format "\\begin{center}\n%s\\end{center}" contents)))
+
+
+;;;; Clock
+
+(defun org-latex-clock (clock contents info)
+ "Transcode a CLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "\\noindent"
+ (format "\\textbf{%s} " org-clock-string)
+ (format org-latex-inactive-timestamp-format
+ (concat (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " (%s)" time)))))
+ "\\\\"))
+
+
+;;;; Code
+
+(defun org-latex-code (code contents info)
+ "Transcode a CODE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-latex--text-markup (org-element-property :value code) 'code))
+
+
+;;;; Drawer
+
+(defun org-latex-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (funcall org-latex-format-drawer-function
+ name contents)))
+ (org-latex--wrap-label drawer output)))
+
+
+;;;; Dynamic Block
+
+(defun org-latex-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-latex--wrap-label dynamic-block contents))
+
+
+;;;; Entity
+
+(defun org-latex-entity (entity contents info)
+ "Transcode an ENTITY object from Org to LaTeX.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :latex entity)))
+ (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent)))
+
+
+;;;; Example Block
+
+(defun org-latex-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (when (org-string-nw-p (org-element-property :value example-block))
+ (org-latex--wrap-label
+ example-block
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default example-block info)))))
+
+
+;;;; Export Block
+
+(defun org-latex-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (member (org-element-property :type export-block) '("LATEX" "TEX"))
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Export Snippet
+
+(defun org-latex-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'latex)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Fixed Width
+
+(defun org-latex-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-latex--wrap-label
+ fixed-width
+ (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+
+;;;; Footnote Reference
+
+(defun org-latex-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ org-latex-footnote-separator))
+ (cond
+ ;; Use \footnotemark if the footnote has already been defined.
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (format "\\footnotemark[%s]{}"
+ (org-export-get-footnote-number footnote-reference info)))
+ ;; Use \footnotemark if reference is within another footnote
+ ;; reference, footnote definition or table cell.
+ ((loop for parent in (org-export-get-genealogy footnote-reference)
+ thereis (memq (org-element-type parent)
+ '(footnote-reference footnote-definition table-cell)))
+ "\\footnotemark")
+ ;; Otherwise, define it with \footnote command.
+ (t
+ (let ((def (org-export-get-footnote-definition footnote-reference info)))
+ (concat
+ (format "\\footnote{%s}" (org-trim (org-export-data def info)))
+ ;; Retrieve all footnote references within the footnote and
+ ;; add their definition after it, since LaTeX doesn't support
+ ;; them inside.
+ (org-latex--delayed-footnotes-definitions def info)))))))
+
+
+;;;; Headline
+
+(defun org-latex-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to LaTeX.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((class (plist-get info :latex-class))
+ (level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ (class-sectioning (assoc class org-latex-classes))
+ ;; Section formatting will set two placeholders: one for
+ ;; the title and the other for the contents.
+ (section-fmt
+ (let ((sec (if (functionp (nth 2 class-sectioning))
+ (funcall (nth 2 class-sectioning) level numberedp)
+ (nth (1+ level) class-sectioning))))
+ (cond
+ ;; No section available for that LEVEL.
+ ((not sec) nil)
+ ;; Section format directly returned by a function. Add
+ ;; placeholder for contents.
+ ((stringp sec) (concat sec "\n%s"))
+ ;; (numbered-section . unnumbered-section)
+ ((not (consp (cdr sec)))
+ (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s"))
+ ;; (numbered-open numbered-close)
+ ((= (length sec) 2)
+ (when numberedp (concat (car sec) "\n%s" (nth 1 sec))))
+ ;; (num-in num-out no-num-in no-num-out)
+ ((= (length sec) 4)
+ (if numberedp (concat (car sec) "\n%s" (nth 1 sec))
+ (concat (nth 2 sec) "\n%s" (nth 3 sec)))))))
+ ;; Create a temporary export back-end that hard-codes
+ ;; "\underline" within "\section" and alike.
+ (section-back-end
+ (org-export-create-backend
+ :parent 'latex
+ :transcoders
+ '((underline . (lambda (o c i) (format "\\underline{%s}" c))))))
+ (text
+ (org-export-data-with-backend
+ (org-element-property :title headline) section-back-end info))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ ;; Create the headline text along with a no-tag version.
+ ;; The latter is required to remove tags from toc.
+ (full-text (funcall org-latex-format-headline-function
+ todo todo-type priority text tags))
+ ;; Associate \label to the headline for internal links.
+ (headline-label
+ (format "\\label{sec-%s}\n"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number headline info)
+ "-")))
+ (pre-blanks
+ (make-string (org-element-property :pre-blank headline) 10)))
+ (if (or (not section-fmt) (org-export-low-level-p headline info))
+ ;; This is a deep sub-tree: export it as a list item. Also
+ ;; export as items headlines for which no section format has
+ ;; been found.
+ (let ((low-level-body
+ (concat
+ ;; If headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize)))
+ ;; Itemize headline
+ "\\item"
+ (and full-text (org-string-match-p "\\`[ \t]*\\[" full-text)
+ "\\relax")
+ " " full-text "\n"
+ headline-label
+ pre-blanks
+ contents)))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before
+ ;; any blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize))
+ low-level-body)))
+ ;; This is a standard headline. Export it as a section. Add
+ ;; an alternative heading when possible, and when this is not
+ ;; identical to the usual heading.
+ (let ((opt-title
+ (funcall org-latex-format-headline-function
+ todo todo-type priority
+ (org-export-data-with-backend
+ (org-export-get-alt-title headline info)
+ section-back-end info)
+ (and (eq (plist-get info :with-tags) t) tags))))
+ (if (and numberedp opt-title
+ (not (equal opt-title full-text))
+ (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt))
+ (format (replace-match "\\1[%s]" nil nil section-fmt 1)
+ ;; Replace square brackets with parenthesis
+ ;; since square brackets are not supported in
+ ;; optional arguments.
+ (replace-regexp-in-string
+ "\\[" "(" (replace-regexp-in-string "\\]" ")" opt-title))
+ full-text
+ (concat headline-label pre-blanks contents))
+ ;; Impossible to add an alternative heading. Fallback to
+ ;; regular sectioning format string.
+ (format section-fmt full-text
+ (concat headline-label pre-blanks contents))))))))
+
+(defun org-latex-format-headline-default-function
+ (todo todo-type priority text tags)
+ "Default format function for a headline.
+See `org-latex-format-headline-function' for details."
+ (concat
+ (and todo (format "{\\bfseries\\sffamily %s} " todo))
+ (and priority (format "\\framebox{\\#%c} " priority))
+ text
+ (and tags
+ (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":")))))
+
+
+;;;; Horizontal Rule
+
+(defun org-latex-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((attr (org-export-read-attribute :attr_latex horizontal-rule))
+ (prev (org-export-get-previous-element horizontal-rule info)))
+ (concat
+ ;; Make sure the rule doesn't start at the end of the current
+ ;; line by separating it with a blank line from previous element.
+ (when (and prev
+ (let ((prev-blank (org-element-property :post-blank prev)))
+ (or (not prev-blank) (zerop prev-blank))))
+ "\n")
+ (org-latex--wrap-label
+ horizontal-rule
+ (format "\\rule{%s}{%s}"
+ (or (plist-get attr :width) "\\linewidth")
+ (or (plist-get attr :thickness) "0.5pt"))))))
+
+
+;;;; Inline Src Block
+
+(defun org-latex-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block))
+ (separator (org-latex--find-verb-separator code)))
+ (cond
+ ;; Do not use a special package: transcode it verbatim.
+ ((not org-latex-listings)
+ (concat "\\verb" separator code separator))
+ ;; Use minted package.
+ ((eq org-latex-listings 'minted)
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (mint-lang (or (cadr (assq (intern org-lang)
+ org-latex-minted-langs))
+ (downcase org-lang)))
+ (options (org-latex--make-option-string
+ org-latex-minted-options)))
+ (concat (format "\\mint%s{%s}"
+ (if (string= options "") "" (format "[%s]" options))
+ mint-lang)
+ separator code separator)))
+ ;; Use listings package.
+ (t
+ ;; Maybe translate language's name.
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (lst-lang (or (cadr (assq (intern org-lang)
+ org-latex-listings-langs))
+ org-lang))
+ (options (org-latex--make-option-string
+ (append org-latex-listings-options
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator))))))
+
+
+;;;; Inlinetask
+
+(defun org-latex-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((title (org-export-data (org-element-property :title inlinetask) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (org-element-property :todo-type inlinetask))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))))
+ ;; If `org-latex-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (not (eq org-latex-format-inlinetask-function 'ignore))
+ (funcall org-latex-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (org-latex--wrap-label
+ inlinetask
+ (let ((full-title
+ (concat
+ (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ title
+ (when tags (format "\\hfill{}\\textsc{:%s:}"
+ (mapconcat #'identity tags ":"))))))
+ (concat "\\begin{center}\n"
+ "\\fbox{\n"
+ "\\begin{minipage}[c]{.6\\textwidth}\n"
+ full-title "\n\n"
+ (and (org-string-nw-p contents)
+ (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
+ "\\end{minipage}\n"
+ "}\n"
+ "\\end{center}"))))))
+
+
+;;;; Italic
+
+(defun org-latex-italic (italic contents info)
+ "Transcode ITALIC from Org to LaTeX.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (org-latex--text-markup contents 'italic))
+
+
+;;;; Item
+
+(defun org-latex-item (item contents info)
+ "Transcode an ITEM element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((counter
+ (let ((count (org-element-property :counter item))
+ (level
+ ;; Determine level of current item to determine the
+ ;; correct LaTeX counter to use (enumi, enumii...).
+ (let ((parent item) (level 0))
+ (while (memq (org-element-type
+ (setq parent (org-export-get-parent parent)))
+ '(plain-list item))
+ (when (and (eq (org-element-type parent) 'plain-list)
+ (eq (org-element-property :type parent)
+ 'ordered))
+ (incf level)))
+ level)))
+ (and count
+ (< level 5)
+ (format "\\setcounter{enum%s}{%s}\n"
+ (nth (1- level) '("i" "ii" "iii" "iv"))
+ (1- count)))))
+ (checkbox (case (org-element-property :checkbox item)
+ (on "$\\boxtimes$ ")
+ (off "$\\square$ ")
+ (trans "$\\boxminus$ ")))
+ (tag (let ((tag (org-element-property :tag item)))
+ ;; Check-boxes must belong to the tag.
+ (and tag (format "[{%s}] "
+ (concat checkbox
+ (org-export-data tag info)))))))
+ (concat counter
+ "\\item"
+ (cond
+ (tag)
+ (checkbox (concat " " checkbox))
+ ;; Without a tag or a check-box, if CONTENTS starts with
+ ;; an opening square bracket, add "\relax" to "\item",
+ ;; unless the brackets comes from an initial export
+ ;; snippet (i.e. it is inserted willingly by the user).
+ ((and contents
+ (org-string-match-p "\\`[ \t]*\\[" contents)
+ (not (let ((e (car (org-element-contents item))))
+ (and (eq (org-element-type e) 'paragraph)
+ (let ((o (car (org-element-contents e))))
+ (and (eq (org-element-type o) 'export-snippet)
+ (eq (org-export-snippet-backend o)
+ 'latex)))))))
+ "\\relax ")
+ (t " "))
+ (and contents (org-trim contents))
+ ;; If there are footnotes references in tag, be sure to
+ ;; add their definition at the end of the item. This
+ ;; workaround is necessary since "\footnote{}" command is
+ ;; not supported in tags.
+ (and tag
+ (org-latex--delayed-footnotes-definitions
+ (org-element-property :tag item) info)))))
+
+
+;;;; Keyword
+
+(defun org-latex-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "LATEX") value)
+ ((string= key "INDEX") (format "\\index{%s}" value))
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (concat
+ (when (wholenump depth)
+ (format "\\setcounter{tocdepth}{%s}\n" depth))
+ "\\tableofcontents")))
+ ((string= "tables" value) "\\listoftables")
+ ((string= "listings" value)
+ (cond
+ ((eq org-latex-listings 'minted) "\\listoflistings")
+ (org-latex-listings "\\lstlistoflistings")
+ ;; At the moment, src blocks with a caption are wrapped
+ ;; into a figure environment.
+ (t "\\listoffigures")))))))))
+
+
+;;;; Latex Environment
+
+(defun org-latex-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (plist-get info :with-latex)
+ (let ((label (org-element-property :name latex-environment))
+ (value (org-remove-indentation
+ (org-element-property :value latex-environment))))
+ (if (not (org-string-nw-p label)) value
+ ;; Environment is labeled: label must be within the environment
+ ;; (otherwise, a reference pointing to that element will count
+ ;; the section instead).
+ (with-temp-buffer
+ (insert value)
+ (goto-char (point-min))
+ (forward-line)
+ (insert
+ (format "\\label{%s}\n" (org-export-solidify-link-text label)))
+ (buffer-string))))))
+
+
+;;;; Latex Fragment
+
+(defun org-latex-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (plist-get info :with-latex)
+ (org-element-property :value latex-fragment)))
+
+
+;;;; Line Break
+
+(defun org-latex-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "\\\\\n")
+
+
+;;;; Link
+
+(defun org-latex--inline-image (link info)
+ "Return LaTeX code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (let* ((parent (org-export-get-parent-element link))
+ (path (let ((raw-path (org-element-property :path link)))
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (expand-file-name raw-path))))
+ (filetype (file-name-extension path))
+ (caption (org-latex--caption/label-string parent info))
+ ;; Retrieve latex attributes from the element around.
+ (attr (org-export-read-attribute :attr_latex parent))
+ (float (let ((float (plist-get attr :float)))
+ (cond ((and (not float) (plist-member attr :float)) nil)
+ ((string= float "wrap") 'wrap)
+ ((string= float "multicolumn") 'multicolumn)
+ ((or float
+ (org-element-property :caption parent)
+ (org-string-nw-p (plist-get attr :caption)))
+ 'figure))))
+ (placement
+ (let ((place (plist-get attr :placement)))
+ (cond (place (format "%s" place))
+ ((eq float 'wrap) "{l}{0.5\\textwidth}")
+ ((eq float 'figure)
+ (format "[%s]" org-latex-default-figure-position))
+ (t ""))))
+ (comment-include (if (plist-get attr :comment-include) "%" ""))
+ ;; It is possible to specify width and height in the
+ ;; ATTR_LATEX line, and also via default variables.
+ (width (cond ((plist-get attr :width))
+ ((plist-get attr :height) "")
+ ((eq float 'wrap) "0.48\\textwidth")
+ (t org-latex-image-default-width)))
+ (height (cond ((plist-get attr :height))
+ ((or (plist-get attr :width)
+ (memq float '(figure wrap))) "")
+ (t org-latex-image-default-height)))
+ (options (let ((opt (or (plist-get attr :options)
+ org-latex-image-default-option)))
+ (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt
+ (match-string 1 opt))))
+ image-code)
+ (if (member filetype '("tikz" "pgf"))
+ ;; For tikz images:
+ ;; - use \input to read in image file.
+ ;; - if options are present, wrap in a tikzpicture environment.
+ ;; - if width or height are present, use \resizebox to change
+ ;; the image size.
+ (progn
+ (setq image-code (format "\\input{%s}" path))
+ (when (org-string-nw-p options)
+ (setq image-code
+ (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}"
+ options
+ image-code)))
+ (when (or (org-string-nw-p width) (org-string-nw-p height))
+ (setq image-code (format "\\resizebox{%s}{%s}{%s}"
+ (if (org-string-nw-p width) width "!")
+ (if (org-string-nw-p height) height "!")
+ image-code))))
+ ;; For other images:
+ ;; - add width and height to options.
+ ;; - include the image with \includegraphics.
+ (when (org-string-nw-p width)
+ (setq options (concat options ",width=" width)))
+ (when (org-string-nw-p height)
+ (setq options (concat options ",height=" height)))
+ (setq image-code
+ (format "\\includegraphics%s{%s}"
+ (cond ((not (org-string-nw-p options)) "")
+ ((= (aref options 0) ?,)
+ (format "[%s]"(substring options 1)))
+ (t (format "[%s]" options)))
+ path))
+ (when (equal filetype "svg")
+ (setq image-code (replace-regexp-in-string "^\\\\includegraphics"
+ "\\includesvg"
+ image-code
+ nil t))
+ (setq image-code (replace-regexp-in-string "\\.svg}"
+ "}"
+ image-code
+ nil t))))
+ ;; Return proper string, depending on FLOAT.
+ (case float
+ (wrap (format "\\begin{wrapfigure}%s
+\\centering
+%s%s
+%s\\end{wrapfigure}" placement comment-include image-code caption))
+ (multicolumn (format "\\begin{figure*}%s
+\\centering
+%s%s
+%s\\end{figure*}" placement comment-include image-code caption))
+ (figure (format "\\begin{figure}%s
+\\centering
+%s%s
+%s\\end{figure}" placement comment-include image-code caption))
+ (otherwise image-code))))
+
+(defun org-latex-link (link desc info)
+ "Transcode a LINK object from Org to LaTeX.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (replace-regexp-in-string
+ "%" "\\%" (org-element-property :path link) nil t))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (imagep (org-export-inline-image-p
+ link org-latex-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((and (string= type "file") (file-name-absolute-p raw-path))
+ (concat "file:" raw-path))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; Image file.
+ (imagep (org-latex--inline-image link info))
+ ;; Radio link: Transcode target's contents and use them as link's
+ ;; description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) desc
+ (format "\\hyperref[%s]{%s}"
+ (org-export-solidify-link-text
+ (org-element-property :value destination))
+ desc))))
+ ;; Links pointing to a headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "\\href{%s}{%s}" destination desc)
+ (format "\\url{%s}" destination)))
+ ;; Fuzzy link points nowhere.
+ ('nil
+ (format org-latex-link-with-unknown-path-format
+ (or desc
+ (org-export-data
+ (org-element-property :raw-link link) info))))
+ ;; LINK points to a headline. If headlines are numbered
+ ;; and the link has no description, display headline's
+ ;; number. Otherwise, display description or headline's
+ ;; title.
+ (headline
+ (let ((label
+ (format "sec-%s"
+ (mapconcat
+ 'number-to-string
+ (org-export-get-headline-number destination info)
+ "-"))))
+ (if (and (not desc)
+ (org-export-numbered-headline-p destination info))
+ (format "\\ref{%s}" label)
+ (format "\\hyperref[%s]{%s}" label
+ (or desc
+ (org-export-data
+ (org-element-property :title destination) info))))))
+ ;; Fuzzy link points to a target. Do as above.
+ (otherwise
+ (let ((path (org-export-solidify-link-text path)))
+ (if (not desc) (format "\\ref{%s}" path)
+ (format "\\hyperref[%s]{%s}" path desc)))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (format (org-export-get-coderef-format path desc)
+ (org-export-resolve-coderef path info)))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'latex))
+ ;; External link with a description part.
+ ((and path desc) (format "\\href{%s}{%s}" path desc))
+ ;; External link without a description part.
+ (path (format "\\url{%s}" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format org-latex-link-with-unknown-path-format desc)))))
+
+
+;;;; Paragraph
+
+(defun org-latex-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to LaTeX.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ contents)
+
+
+;;;; Plain List
+
+(defun org-latex-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to LaTeX.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((type (org-element-property :type plain-list))
+ (attr (org-export-read-attribute :attr_latex plain-list))
+ (latex-type (let ((env (plist-get attr :environment)))
+ (cond (env (format "%s" env))
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'descriptive) "description")
+ (t "itemize")))))
+ (org-latex--wrap-label
+ plain-list
+ (format "\\begin{%s}%s\n%s\\end{%s}"
+ latex-type
+ (or (plist-get attr :options) "")
+ contents
+ latex-type))))
+
+
+;;;; Plain Text
+
+(defun org-latex-plain-text (text info)
+ "Transcode a TEXT string from Org to LaTeX.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (let ((specialp (plist-get info :with-special-strings))
+ (output text))
+ ;; Protect %, #, &, $, _, { and }.
+ (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output)
+ (setq output
+ (replace-match
+ (format "\\%s" (match-string 2 output)) nil t output 2)))
+ ;; Protect ^.
+ (setq output
+ (replace-regexp-in-string
+ "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2))
+ ;; Protect \. If special strings are used, be careful not to
+ ;; protect "\" in "\-" constructs.
+ (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\")))
+ (setq output
+ (replace-regexp-in-string
+ (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols)
+ "$\\backslash$" output nil t 1)))
+ ;; Protect ~.
+ (setq output
+ (replace-regexp-in-string
+ "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :latex info text)))
+ ;; LaTeX into \LaTeX{} and TeX into \TeX{}.
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start)
+ (setq output (replace-match
+ (format "\\%s{}" (match-string 1 output)) nil t output)
+ start (match-end 0))))
+ ;; Convert special strings.
+ (when specialp
+ (setq output
+ (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output)))
+ ;; Return value.
+ output))
+
+
+;;;; Planning
+
+(defun org-latex-planning (planning contents info)
+ "Transcode a PLANNING element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "\\noindent"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "\\textbf{%s} " org-closed-string)
+ (format org-latex-inactive-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value closed))))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "\\textbf{%s} " org-deadline-string)
+ (format org-latex-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value deadline))))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "\\textbf{%s} " org-scheduled-string)
+ (format org-latex-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value scheduled))))))))
+ " ")
+ "\\\\"))
+
+
+;;;; Quote Block
+
+(defun org-latex-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-latex--wrap-label
+ quote-block
+ (format "\\begin{quote}\n%s\\end{quote}" contents)))
+
+
+;;;; Quote Section
+
+(defun org-latex-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
+
+
+;;;; Radio Target
+
+(defun org-latex-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to LaTeX.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "\\label{%s}%s"
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+
+;;;; Section
+
+(defun org-latex-section (section contents info)
+ "Transcode a SECTION element from Org to LaTeX.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Special Block
+
+(defun org-latex-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block)))
+ (opt (org-export-read-attribute :attr_latex special-block :options)))
+ (concat (format "\\begin{%s}%s\n" type (or opt ""))
+ ;; Insert any label or caption within the block
+ ;; (otherwise, a reference pointing to that element will
+ ;; count the section instead).
+ (org-latex--caption/label-string special-block info)
+ contents
+ (format "\\end{%s}" type))))
+
+
+;;;; Src Block
+
+(defun org-latex-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to LaTeX.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (when (org-string-nw-p (org-element-property :value src-block))
+ (let* ((lang (org-element-property :language src-block))
+ (caption (org-element-property :caption src-block))
+ (label (org-element-property :name src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-latex-custom-lang-environments))))
+ (num-start (case (org-element-property :number-lines src-block)
+ (continued (org-export-get-loc src-block info))
+ (new 0)))
+ (retain-labels (org-element-property :retain-labels src-block))
+ (attributes (org-export-read-attribute :attr_latex src-block))
+ (float (plist-get attributes :float)))
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-latex-listings)
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
+ org-latex-default-figure-position
+ caption-str))
+ ((or caption float)
+ (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
+ caption-str))
+ (t "%s"))))
+ (format
+ float-env
+ (concat (format "\\begin{verbatim}\n%s\\end{verbatim}"
+ (org-export-format-code-default src-block info))))))
+ ;; Case 2. Custom environment.
+ (custom-env (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-env
+ (org-export-format-code-default src-block info)
+ custom-env))
+ ;; Case 3. Use minted package.
+ ((eq org-latex-listings 'minted)
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{listing*}\n%%s\n%s\\end{listing*}"
+ caption-str))
+ ((or caption float)
+ (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
+ caption-str))
+ (t "%s")))
+ (body
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ ;; Options.
+ (org-latex--make-option-string
+ (if (or (not num-start)
+ (assoc "linenos" org-latex-minted-options))
+ org-latex-minted-options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ org-latex-minted-options)))
+ ;; Language.
+ (or (cadr (assq (intern lang) org-latex-minted-langs))
+ (downcase lang))
+ ;; Source code.
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'length
+ (org-split-string (car code-info)
+ "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line
+ ;; of code.
+ (concat (make-string (+ (- max-width (length loc)) 6)
+ ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))
+ ;; Return value.
+ (format float-env body)))
+ ;; Case 4. Use listings package.
+ (t
+ (let ((lst-lang
+ (or (cadr (assq (intern lang) org-latex-listings-langs)) lang))
+ (caption-str
+ (when caption
+ (let ((main (org-export-get-caption src-block))
+ (secondary (org-export-get-caption src-block t)))
+ (if (not secondary)
+ (format "{%s}" (org-export-data main info))
+ (format "{[%s]%s}"
+ (org-export-data secondary info)
+ (org-export-data main info)))))))
+ (concat
+ ;; Options.
+ (format
+ "\\lstset{%s}\n"
+ (org-latex--make-option-string
+ (append
+ org-latex-listings-options
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" org-latex-listings-options)))
+ `(("float" ,org-latex-default-figure-position))))
+ `(("language" ,lst-lang))
+ (if label `(("label" ,label)) '(("label" " ")))
+ (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
+ (cond ((assoc "numbers" org-latex-listings-options) nil)
+ ((not num-start) '(("numbers" "none")))
+ ((zerop num-start) '(("numbers" "left")))
+ (t `(("numbers" "left")
+ ("firstnumber"
+ ,(number-to-string (1+ num-start)))))))))
+ ;; Source code.
+ (format
+ "\\begin{lstlisting}\n%s\\end{lstlisting}"
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'length
+ (org-split-string (car code-info) "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line of
+ ;; code
+ (concat (make-string (+ (- max-width (length loc)) 6) ? )
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info))))))))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-latex-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (replace-regexp-in-string
+ "%" "\\%" (org-element-property :value statistics-cookie) nil t))
+
+
+;;;; Strike-Through
+
+(defun org-latex-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to LaTeX.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (org-latex--text-markup contents 'strike-through))
+
+
+;;;; Subscript
+
+(defun org-latex--script-size (object info)
+ "Transcode a subscript or superscript object.
+OBJECT is an Org object. INFO is a plist used as a communication
+channel."
+ (let ((in-script-p
+ ;; Non-nil if object is already in a sub/superscript.
+ (let ((parent object))
+ (catch 'exit
+ (while (setq parent (org-export-get-parent parent))
+ (let ((type (org-element-type parent)))
+ (cond ((memq type '(subscript superscript))
+ (throw 'exit t))
+ ((memq type org-element-all-elements)
+ (throw 'exit nil))))))))
+ (type (org-element-type object))
+ (output ""))
+ (org-element-map (org-element-contents object)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj)
+ (case (org-element-type obj)
+ ((entity latex-fragment)
+ (let ((data (org-trim (org-export-data obj info))))
+ (string-match
+ "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'"
+ data)
+ (setq output
+ (concat output
+ (match-string 1 data)
+ (let ((blank (org-element-property :post-blank obj)))
+ (and blank (> blank 0) "\\ "))))))
+ (plain-text
+ (setq output
+ (format "%s\\text{%s}" output (org-export-data obj info))))
+ (otherwise
+ (setq output
+ (concat output
+ (org-export-data obj info)
+ (let ((blank (org-element-property :post-blank obj)))
+ (and blank (> blank 0) "\\ ")))))))
+ info nil org-element-recursive-objects)
+ ;; Result. Do not wrap into math mode if already in a subscript
+ ;; or superscript. Do not wrap into curly brackets if OUTPUT is
+ ;; a single character. Also merge consecutive subscript and
+ ;; superscript into the same math snippet.
+ (concat (and (not in-script-p)
+ (let ((prev (org-export-get-previous-element object info)))
+ (or (not prev)
+ (not (eq (org-element-type prev)
+ (if (eq type 'subscript) 'superscript
+ 'subscript)))
+ (let ((blank (org-element-property :post-blank prev)))
+ (and blank (> blank 0)))))
+ "$")
+ (if (eq (org-element-type object) 'subscript) "_" "^")
+ (and (> (length output) 1) "{")
+ output
+ (and (> (length output) 1) "}")
+ (and (not in-script-p)
+ (or (let ((blank (org-element-property :post-blank object)))
+ (and blank (> blank 0)))
+ (not (eq (org-element-type
+ (org-export-get-next-element object info))
+ (if (eq type 'subscript) 'superscript
+ 'subscript))))
+ "$"))))
+
+(defun org-latex-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to LaTeX.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (org-latex--script-size subscript info))
+
+
+;;;; Superscript
+
+(defun org-latex-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to LaTeX.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (org-latex--script-size superscript info))
+
+
+;;;; Table
+;;
+;; `org-latex-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" mode. Otherwise, it
+;; delegates the job to either `org-latex--table.el-table',
+;; `org-latex--org-table' or `org-latex--math-table' functions,
+;; depending of the type of the table and the mode requested.
+;;
+;; `org-latex--align-string' is a subroutine used to build alignment
+;; string for Org tables.
+
+(defun org-latex-table (table contents info)
+ "Transcode a TABLE element from Org to LaTeX.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (if (eq (org-element-property :type table) 'table.el)
+ ;; "table.el" table. Convert it using appropriate tools.
+ (org-latex--table.el-table table info)
+ (let ((type (or (org-export-read-attribute :attr_latex table :mode)
+ org-latex-default-table-mode)))
+ (cond
+ ;; Case 1: Verbatim table.
+ ((string= type "verbatim")
+ (format "\\begin{verbatim}\n%s\n\\end{verbatim}"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+ ;; Case 2: Matrix.
+ ((or (string= type "math") (string= type "inline-math"))
+ (org-latex--math-table table info))
+ ;; Case 3: Standard table.
+ (t (concat (org-latex--org-table table contents info)
+ ;; When there are footnote references within the
+ ;; table, insert their definition just after it.
+ (org-latex--delayed-footnotes-definitions table info)))))))
+
+(defun org-latex--align-string (table info)
+ "Return an appropriate LaTeX alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (or (org-export-read-attribute :attr_latex table :align)
+ (let (align)
+ ;; Extract column groups and alignment from first (non-rule)
+ ;; row.
+ (org-element-map
+ (org-element-map table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row) 'standard) row))
+ info 'first-match)
+ 'table-cell
+ (lambda (cell)
+ (let ((borders (org-export-table-cell-borders cell info)))
+ ;; Check left border for the first cell only.
+ (when (and (memq 'left borders) (not align))
+ (push "|" align))
+ (push (case (org-export-table-cell-alignment cell info)
+ (left "l")
+ (right "r")
+ (center "c"))
+ align)
+ (when (memq 'right borders) (push "|" align))))
+ info)
+ (apply 'concat (nreverse align)))))
+
+(defun org-latex--org-table (table contents info)
+ "Return appropriate LaTeX code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' property and
+`table' as its `:mode' attribute."
+ (let* ((caption (org-latex--caption/label-string table info))
+ (attr (org-export-read-attribute :attr_latex table))
+ ;; Determine alignment string.
+ (alignment (org-latex--align-string table info))
+ ;; Determine environment for the table: longtable, tabular...
+ (table-env (or (plist-get attr :environment)
+ org-latex-default-table-environment))
+ ;; If table is a float, determine environment: table, table*
+ ;; or sidewaystable.
+ (float-env (unless (member table-env '("longtable" "longtabu"))
+ (let ((float (plist-get attr :float)))
+ (cond
+ ((and (not float) (plist-member attr :float)) nil)
+ ((string= float "sidewaystable") "sidewaystable")
+ ((string= float "multicolumn") "table*")
+ ((or float
+ (org-element-property :caption table)
+ (org-string-nw-p (plist-get attr :caption)))
+ "table")))))
+ ;; Extract others display options.
+ (fontsize (let ((font (plist-get attr :font)))
+ (and font (concat font "\n"))))
+ (width (plist-get attr :width))
+ (spreadp (plist-get attr :spread))
+ (placement (or (plist-get attr :placement)
+ (format "[%s]" org-latex-default-figure-position)))
+ (centerp (if (plist-member attr :center) (plist-get attr :center)
+ org-latex-tables-centered)))
+ ;; Prepare the final format string for the table.
+ (cond
+ ;; Longtable.
+ ((equal "longtable" table-env)
+ (concat (and fontsize (concat "{" fontsize))
+ (format "\\begin{longtable}{%s}\n" alignment)
+ (and org-latex-table-caption-above
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ contents
+ (and (not org-latex-table-caption-above)
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ "\\end{longtable}\n"
+ (and fontsize "}")))
+ ;; Longtabu
+ ((equal "longtabu" table-env)
+ (concat (and fontsize (concat "{" fontsize))
+ (format "\\begin{longtabu}%s{%s}\n"
+ (if width
+ (format " %s %s "
+ (if spreadp "spread" "to") width) "")
+ alignment)
+ (and org-latex-table-caption-above
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ contents
+ (and (not org-latex-table-caption-above)
+ (org-string-nw-p caption)
+ (concat caption "\\\\\n"))
+ "\\end{longtabu}\n"
+ (and fontsize "}")))
+ ;; Others.
+ (t (concat (cond
+ (float-env
+ (concat (format "\\begin{%s}%s\n" float-env placement)
+ (if org-latex-table-caption-above caption "")
+ (when centerp "\\centering\n")
+ fontsize))
+ (centerp (concat "\\begin{center}\n" fontsize))
+ (fontsize (concat "{" fontsize)))
+ (cond ((equal "tabu" table-env)
+ (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}"
+ (if width (format
+ (if spreadp " spread %s " " to %s ")
+ width) "")
+ alignment
+ contents))
+ (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}"
+ table-env
+ (if width (format "{%s}" width) "")
+ alignment
+ contents
+ table-env)))
+ (cond
+ (float-env
+ (concat (if org-latex-table-caption-above "" caption)
+ (format "\n\\end{%s}" float-env)))
+ (centerp "\n\\end{center}")
+ (fontsize "}")))))))
+
+(defun org-latex--table.el-table (table info)
+ "Return appropriate LaTeX code for a table.el table.
+
+TABLE is the table type element to transcode. INFO is a plist
+used as a communication channel.
+
+This function assumes TABLE has `table.el' as its `:type'
+property."
+ (require 'table)
+ ;; Ensure "*org-export-table*" buffer is empty.
+ (with-current-buffer (get-buffer-create "*org-export-table*")
+ (erase-buffer))
+ (let ((output (with-temp-buffer
+ (insert (org-element-property :value table))
+ (goto-char 1)
+ (re-search-forward "^[ \t]*|[^|]" nil t)
+ (table-generate-source 'latex "*org-export-table*")
+ (with-current-buffer "*org-export-table*"
+ (org-trim (buffer-string))))))
+ (kill-buffer (get-buffer "*org-export-table*"))
+ ;; Remove left out comments.
+ (while (string-match "^%.*\n" output)
+ (setq output (replace-match "" t t output)))
+ (let ((attr (org-export-read-attribute :attr_latex table)))
+ (when (plist-get attr :rmlines)
+ ;; When the "rmlines" attribute is provided, remove all hlines
+ ;; but the the one separating heading from the table body.
+ (let ((n 0) (pos 0))
+ (while (and (< (length output) pos)
+ (setq pos (string-match "^\\\\hline\n?" output pos)))
+ (incf n)
+ (unless (= n 2) (setq output (replace-match "" nil nil output))))))
+ (let ((centerp (if (plist-member attr :center) (plist-get attr :center)
+ org-latex-tables-centered)))
+ (if (not centerp) output
+ (format "\\begin{center}\n%s\n\\end{center}" output))))))
+
+(defun org-latex--math-table (table info)
+ "Return appropriate LaTeX code for a matrix.
+
+TABLE is the table type element to transcode. INFO is a plist
+used as a communication channel.
+
+This function assumes TABLE has `org' as its `:type' property and
+`inline-math' or `math' as its `:mode' attribute.."
+ (let* ((caption (org-latex--caption/label-string table info))
+ (attr (org-export-read-attribute :attr_latex table))
+ (inlinep (equal (plist-get attr :mode) "inline-math"))
+ (env (or (plist-get attr :environment)
+ org-latex-default-table-environment))
+ (contents
+ (mapconcat
+ (lambda (row)
+ ;; Ignore horizontal rules.
+ (when (eq (org-element-property :type row) 'standard)
+ ;; Return each cell unmodified.
+ (concat
+ (mapconcat
+ (lambda (cell)
+ (substring (org-element-interpret-data cell) 0 -1))
+ (org-element-map row 'table-cell 'identity info) "&")
+ (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
+ "\n")))
+ (org-element-map table 'table-row 'identity info) ""))
+ ;; Variables related to math clusters (contiguous math tables
+ ;; of the same type).
+ (mode (org-export-read-attribute :attr_latex table :mode))
+ (prev (org-export-get-previous-element table info))
+ (next (org-export-get-next-element table info))
+ (same-mode-p
+ (lambda (table)
+ ;; Non-nil when TABLE has the same mode as current table.
+ (string= (or (org-export-read-attribute :attr_latex table :mode)
+ org-latex-default-table-mode)
+ mode))))
+ (concat
+ ;; Opening string. If TABLE is in the middle of a table cluster,
+ ;; do not insert any.
+ (cond ((and prev
+ (eq (org-element-type prev) 'table)
+ (memq (org-element-property :post-blank prev) '(0 nil))
+ (funcall same-mode-p prev))
+ nil)
+ (inlinep "\\(")
+ ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption))
+ (t "\\["))
+ ;; Prefix.
+ (or (plist-get attr :math-prefix) "")
+ ;; Environment. Also treat special cases.
+ (cond ((equal env "array")
+ (let ((align (org-latex--align-string table info)))
+ (format "\\begin{array}{%s}\n%s\\end{array}" align contents)))
+ ((assoc env org-latex-table-matrix-macros)
+ (format "\\%s%s{\n%s}"
+ env
+ (or (plist-get attr :math-arguments) "")
+ contents))
+ (t (format "\\begin{%s}\n%s\\end{%s}" env contents env)))
+ ;; Suffix.
+ (or (plist-get attr :math-suffix) "")
+ ;; Closing string. If TABLE is in the middle of a table cluster,
+ ;; do not insert any. If it closes such a cluster, be sure to
+ ;; close the cluster with a string matching the opening string.
+ (cond ((and next
+ (eq (org-element-type next) 'table)
+ (memq (org-element-property :post-blank table) '(0 nil))
+ (funcall same-mode-p next))
+ nil)
+ (inlinep "\\)")
+ ;; Find cluster beginning to know which environment to use.
+ ((let ((cluster-beg table) prev)
+ (while (and (setq prev (org-export-get-previous-element
+ cluster-beg info))
+ (memq (org-element-property :post-blank prev)
+ '(0 nil))
+ (funcall same-mode-p prev))
+ (setq cluster-beg prev))
+ (and (or (org-element-property :caption cluster-beg)
+ (org-element-property :name cluster-beg))
+ "\n\\end{equation}")))
+ (t "\\]")))))
+
+
+;;;; Table Cell
+
+(defun org-latex-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to LaTeX.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-latex-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-latex-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) " & ")))
+
+
+;;;; Table Row
+
+(defun org-latex-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to LaTeX.
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((attr (org-export-read-attribute :attr_latex
+ (org-export-get-parent table-row)))
+ (longtablep (member (or (plist-get attr :environment)
+ org-latex-default-table-environment)
+ '("longtable" "longtabu")))
+ (booktabsp (if (plist-member attr :booktabs)
+ (plist-get attr :booktabs)
+ org-latex-tables-booktabs))
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (borders (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (concat
+ ;; When BOOKTABS are activated enforce top-rule even when no
+ ;; hline was specifically marked.
+ (cond ((and booktabsp (memq 'top borders)) "\\toprule\n")
+ ((and (memq 'top borders) (memq 'above borders)) "\\hline\n"))
+ contents "\\\\\n"
+ (cond
+ ;; Special case for long tables. Define header and footers.
+ ((and longtablep (org-export-table-row-ends-header-p table-row info))
+ (format "%s
+\\endhead
+%s\\multicolumn{%d}{r}{Continued on next page} \\\\
+\\endfoot
+\\endlastfoot"
+ (if booktabsp "\\midrule" "\\hline")
+ (if booktabsp "\\midrule" "\\hline")
+ ;; Number of columns.
+ (cdr (org-export-table-dimensions
+ (org-export-get-parent-table table-row) info))))
+ ;; When BOOKTABS are activated enforce bottom rule even when
+ ;; no hline was specifically marked.
+ ((and booktabsp (memq 'bottom borders)) "\\bottomrule")
+ ((and (memq 'bottom borders) (memq 'below borders)) "\\hline")
+ ((memq 'below borders) (if booktabsp "\\midrule" "\\hline")))))))
+
+
+;;;; Target
+
+(defun org-latex-target (target contents info)
+ "Transcode a TARGET object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\label{%s}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;;; Timestamp
+
+(defun org-latex-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-latex-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range) (format org-latex-active-timestamp-format value))
+ ((inactive inactive-range)
+ (format org-latex-inactive-timestamp-format value))
+ (otherwise (format org-latex-diary-timestamp-format value)))))
+
+
+;;;; Underline
+
+(defun org-latex-underline (underline contents info)
+ "Transcode UNDERLINE from Org to LaTeX.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (org-latex--text-markup contents 'underline))
+
+
+;;;; Verbatim
+
+(defun org-latex-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to LaTeX.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-latex--text-markup (org-element-property :value verbatim) 'verbatim))
+
+
+;;;; Verse Block
+
+(defun org-latex-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to LaTeX.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (org-latex--wrap-label
+ verse-block
+ ;; In a verse environment, add a line break to each newline
+ ;; character and change each white space at beginning of a line
+ ;; into a space of 1 em. Also change each blank line with
+ ;; a vertical space of 1 em.
+ (progn
+ (setq contents (replace-regexp-in-string
+ "^ *\\\\\\\\$" "\\\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents)))
+ (while (string-match "^[ \t]+" contents)
+ (let ((new-str (format "\\hspace*{%dem}"
+ (length (match-string 0 contents)))))
+ (setq contents (replace-match new-str nil t contents))))
+ (format "\\begin{verse}\n%s\\end{verse}" contents))))
+
+
+
+;;; End-user functions
+
+;;;###autoload
+(defun org-latex-export-as-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer as a LaTeX buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org LATEX Export*\", which
+will be displayed when `org-export-show-temporary-export-buffer'
+is non-nil."
+ (interactive)
+ (org-export-to-buffer 'latex "*Org LATEX Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+;;;###autoload
+(defun org-latex-convert-region-to-latex ()
+ "Assume the current region has org-mode syntax, and convert it to LaTeX.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an LaTeX buffer and use this
+command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'latex))
+
+;;;###autoload
+(defun org-latex-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a LaTeX file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist)))
+
+;;;###autoload
+(defun org-latex-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to LaTeX then process through to PDF.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return PDF file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+(defun org-latex-compile (texfile &optional snippet)
+ "Compile a TeX file.
+
+TEXFILE is the name of the file being compiled. Processing is
+done through the command specified in `org-latex-pdf-process'.
+
+When optional argument SNIPPET is non-nil, TEXFILE is a temporary
+file used to preview a LaTeX snippet. In this case, do not
+create a log buffer and do not bother removing log files.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile)))
+ (full-name (file-truename texfile))
+ (out-dir (file-name-directory texfile))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p texfile)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (unless snippet (message "Processing LaTeX file %s..." texfile))
+ (save-window-excursion
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-latex-pdf-process)
+ (funcall org-latex-pdf-process (shell-quote-argument texfile)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org PDF LaTeX Output*" buffer.
+ ((consp org-latex-pdf-process)
+ (let ((outbuf (and (not snippet)
+ (get-buffer-create "*Org PDF LaTeX Output*"))))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-latex-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (and (not snippet) (org-latex--collect-errors outbuf)))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat out-dir base-name ".pdf")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p pdffile))
+ (error "PDF file %s wasn't produced%s" pdffile
+ (if errors (concat ": " errors) ""))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when (and (not snippet) org-latex-remove-logfiles)
+ (dolist (file (directory-files
+ out-dir t
+ (concat (regexp-quote base-name)
+ "\\(?:\\.[0-9]+\\)?"
+ "\\."
+ (regexp-opt org-latex-logfiles-extensions))))
+ (delete-file file)))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))))
+
+(defun org-latex--collect-errors (buffer)
+ "Collect some kind of errors from \"pdflatex\" command output.
+
+BUFFER is the buffer containing output.
+
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t)
+ (let ((case-fold-search t)
+ (errors ""))
+ (dolist (latex-error org-latex-known-errors)
+ (when (save-excursion (re-search-forward (car latex-error) nil t))
+ (setq errors (concat errors " " (cdr latex-error)))))
+ (and (org-string-nw-p errors) (org-trim errors)))))))
+
+;;;###autoload
+(defun org-latex-publish-to-latex (plist filename pub-dir)
+ "Publish an Org file to LaTeX.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'latex filename ".tex" plist pub-dir))
+
+;;;###autoload
+(defun org-latex-publish-to-pdf (plist filename pub-dir)
+ "Publish an Org file to PDF (via LaTeX).
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ ;; Unlike to `org-latex-publish-to-latex', PDF file is generated
+ ;; in working directory and then moved to publishing directory.
+ (org-publish-attachment
+ plist
+ (org-latex-compile
+ (org-publish-org-to
+ 'latex filename ".tex" plist (file-name-directory filename)))
+ pub-dir))
+
+
+(provide 'ox-latex)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-latex.el ends here
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
new file mode 100644
index 00000000000..09ad1866c0e
--- /dev/null
+++ b/lisp/org/ox-man.el
@@ -0,0 +1,1254 @@
+;; ox-man.el --- Man Back-End for Org Export Engine
+
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Luis R Anaya <papoanaya aroba hot mail punto com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a Man back-end for Org generic exporter.
+;;
+;; To test it, run
+;;
+;; M-: (org-export-to-buffer 'man "*Test Man*") RET
+;;
+;; in an org-mode buffer then switch to the buffer to see the Man
+;; export. See ox.el for more details on how this exporter works.
+;;
+;; It introduces one new buffer keywords:
+;; "MAN_CLASS_OPTIONS".
+
+;;; Code:
+
+(require 'ox)
+
+(eval-when-compile (require 'cl))
+
+(defvar org-export-man-default-packages-alist)
+(defvar org-export-man-packages-alist)
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'man
+ '((babel-call . org-man-babel-call)
+ (bold . org-man-bold)
+ (center-block . org-man-center-block)
+ (clock . org-man-clock)
+ (code . org-man-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-man-drawer)
+ (dynamic-block . org-man-dynamic-block)
+ (entity . org-man-entity)
+ (example-block . org-man-example-block)
+ (export-block . org-man-export-block)
+ (export-snippet . org-man-export-snippet)
+ (fixed-width . org-man-fixed-width)
+ (footnote-definition . org-man-footnote-definition)
+ (footnote-reference . org-man-footnote-reference)
+ (headline . org-man-headline)
+ (horizontal-rule . org-man-horizontal-rule)
+ (inline-babel-call . org-man-inline-babel-call)
+ (inline-src-block . org-man-inline-src-block)
+ (inlinetask . org-man-inlinetask)
+ (italic . org-man-italic)
+ (item . org-man-item)
+ (keyword . org-man-keyword)
+ (line-break . org-man-line-break)
+ (link . org-man-link)
+ (paragraph . org-man-paragraph)
+ (plain-list . org-man-plain-list)
+ (plain-text . org-man-plain-text)
+ (planning . org-man-planning)
+ (property-drawer . (lambda (&rest args) ""))
+ (quote-block . org-man-quote-block)
+ (quote-section . org-man-quote-section)
+ (radio-target . org-man-radio-target)
+ (section . org-man-section)
+ (special-block . org-man-special-block)
+ (src-block . org-man-src-block)
+ (statistics-cookie . org-man-statistics-cookie)
+ (strike-through . org-man-strike-through)
+ (subscript . org-man-subscript)
+ (superscript . org-man-superscript)
+ (table . org-man-table)
+ (table-cell . org-man-table-cell)
+ (table-row . org-man-table-row)
+ (target . org-man-target)
+ (template . org-man-template)
+ (timestamp . org-man-timestamp)
+ (underline . org-man-underline)
+ (verbatim . org-man-verbatim)
+ (verse-block . org-man-verse-block))
+ :export-block "MAN"
+ :menu-entry
+ '(?m "Export to MAN"
+ ((?m "As MAN file" org-man-export-to-man)
+ (?p "As PDF file" org-man-export-to-pdf)
+ (?o "As PDF file and open"
+ (lambda (a s v b)
+ (if a (org-man-export-to-pdf t s v b)
+ (org-open-file (org-man-export-to-pdf nil s v b)))))))
+ :options-alist
+ '((:man-class "MAN_CLASS" nil nil t)
+ (:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
+ (:man-header-extra "MAN_HEADER" nil nil newline)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-man nil
+ "Options for exporting Org mode files to Man."
+ :tag "Org Export Man"
+ :group 'org-export)
+
+;;; Tables
+
+(defcustom org-man-tables-centered t
+ "When non-nil, tables are exported in a center environment."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-man-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+(defcustom org-man-table-scientific-notation "%sE%s"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting")))
+
+
+;;; Inlinetasks
+;; Src blocks
+
+(defcustom org-man-source-highlight nil
+ "Use GNU source highlight to embellish source blocks "
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+(defcustom org-man-source-highlight-langs
+ '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
+ (scheme "scheme")
+ (c "c") (cc "cpp") (csharp "csharp") (d "d")
+ (fortran "fortran") (cobol "cobol") (pascal "pascal")
+ (ada "ada") (asm "asm")
+ (perl "perl") (cperl "perl")
+ (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
+ (java "java") (javascript "javascript")
+ (tex "latex")
+ (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
+ (ocaml "caml") (caml "caml")
+ (sql "sql") (sqlite "sql")
+ (html "html") (css "css") (xml "xml")
+ (bat "bat") (bison "bison") (clipper "clipper")
+ (ldap "ldap") (opa "opa")
+ (php "php") (postscript "postscript") (prolog "prolog")
+ (properties "properties") (makefile "makefile")
+ (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
+ "Alist mapping languages to their listing language counterpart.
+The key is a symbol, the major mode symbol without the \"-mode\".
+The value is the string that should be inserted as the language
+parameter for the listings package. If the mode name and the
+listings name are the same, the language does not need an entry
+in this list - but it does not hurt if it is present."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat
+ (list
+ (symbol :tag "Major mode ")
+ (string :tag "Listings language"))))
+
+
+
+(defvar org-man-custom-lang-environments nil
+ "Alist mapping languages to language-specific Man environments.
+
+It is used during export of src blocks by the listings and
+man packages. For example,
+
+ (setq org-man-custom-lang-environments
+ '((python \"pythoncode\")))
+
+would have the effect that if org encounters begin_src python
+during man export."
+)
+
+
+;;; Compilation
+
+(defcustom org-man-pdf-process
+ '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
+
+ "Commands to process a Man file to a PDF file.
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+full file name, %b by the file base name (i.e. without directory
+and extension parts) and %o by the base directory of the file.
+
+
+By default, Org uses 3 runs of to do the processing.
+
+Alternatively, this may be a Lisp function that does the
+processing. This function should accept the file name as
+its single argument."
+ :group 'org-export-pdf
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (repeat :tag "Shell command sequence"
+ (string :tag "Shell command"))
+ (const :tag "2 runs of pdfgroff"
+ ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" ))
+ (const :tag "3 runs of pdfgroff"
+ ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"
+ "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf"))
+ (function)))
+
+(defcustom org-man-logfiles-extensions
+ '("log" "out" "toc")
+ "The list of file extensions to consider as Man logfiles."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-man-remove-logfiles t
+ "Non-nil means remove the logfiles produced by PDF production.
+These are the .aux, .log, .out, and .toc files."
+ :group 'org-export-man
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+
+;;; Internal Functions
+
+(defun org-man--caption/label-string (element info)
+ "Return caption and label Man string for ELEMENT.
+
+INFO is a plist holding contextual information. If there's no
+caption nor label, return the empty string.
+
+For non-floats, see `org-man--wrap-label'."
+ (let ((label (org-element-property :label element))
+ (main (org-export-get-caption element))
+ (short (org-export-get-caption element t)))
+ (cond ((and (not main) (not label)) "")
+ ((not main) (format "\\fI%s\\fP" label))
+ ;; Option caption format with short name.
+ (short (format "\\fR%s\\fP - \\fI\\P - %s\n"
+ (org-export-data short info)
+ (org-export-data main info)))
+ ;; Standard caption format.
+ (t (format "\\fR%s\\fP" (org-export-data main info))))))
+
+(defun org-man--wrap-label (element output)
+ "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
+This function shouldn't be used for floats. See
+`org-man--caption/label-string'."
+ (let ((label (org-element-property :name element)))
+ (if (or (not output) (not label) (string= output "") (string= label ""))
+ output
+ (concat (format "%s\n.br\n" label) output))))
+
+
+
+;;; Template
+
+(defun org-man-template (contents info)
+ "Return complete document string after Man conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (attr (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (list (plist-get info :man-class-options))
+ " "))))
+ (section-item (plist-get attr :section-id)))
+
+ (concat
+
+ (cond
+ ((and title (stringp section-item))
+ (format ".TH \"%s\" \"%s\" \n" title section-item))
+ ((and (string= "" title) (stringp section-item))
+ (format ".TH \"%s\" \"%s\" \n" " " section-item))
+ (title
+ (format ".TH \"%s\" \"1\" \n" title))
+ (t
+ ".TH \" \" \"1\" "))
+ contents)))
+
+
+
+
+;;; Transcode Functions
+
+;;; Babel Call
+;;
+;; Babel Calls are ignored.
+
+
+;;; Bold
+
+(defun org-man-bold (bold contents info)
+ "Transcode BOLD from Org to Man.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "\\fB%s\\fP" contents))
+
+
+;;; Center Block
+
+(defun org-man-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to Man.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ (org-man--wrap-label
+ center-block
+ (format ".ce %d\n.nf\n%s\n.fi"
+ (- (length (split-string contents "\n")) 1 )
+ contents)))
+
+
+;;; Clock
+
+(defun org-man-clock (clock contents info)
+ "Transcode a CLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ "" )
+
+
+;;; Code
+
+(defun org-man-code (code contents info)
+ "Transcode a CODE object from Org to Man.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "\\fC%s\\fP" code))
+
+
+;;; Comment
+;;
+;; Comments are ignored.
+
+
+;;; Comment Block
+;;
+;; Comment Blocks are ignored.
+
+
+;;; Drawer
+
+(defun org-man-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to Man.
+ DRAWER holds the drawer information
+ CONTENTS holds the contents of the block.
+ INFO is a plist holding contextual information. "
+ contents)
+
+
+;;; Dynamic Block
+
+(defun org-man-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ (org-man--wrap-label dynamic-block contents))
+
+
+;;; Entity
+
+(defun org-man-entity (entity contents info)
+ "Transcode an ENTITY object from Org to Man.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property :utf-8 entity))
+
+
+;;; Example Block
+
+(defun org-man-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-man--wrap-label
+ example-block
+ (format ".RS\n.nf\n%s\n.fi\n.RE"
+ (org-export-format-code-default example-block info))))
+
+
+;;; Export Block
+
+(defun org-man-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "MAN")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;; Export Snippet
+
+(defun org-man-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'man)
+ (org-element-property :value export-snippet)))
+
+
+;;; Fixed Width
+
+(defun org-man-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-man--wrap-label
+ fixed-width
+ (format "\\fC\n%s\\fP"
+ (org-remove-indentation
+ (org-element-property :value fixed-width)))))
+
+
+;;; Footnote Definition
+;;
+;; Footnote Definitions are ignored.
+
+;;; Footnote References
+;;
+;; Footnote References are Ignored
+
+
+;;; Headline
+
+(defun org-man-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to Man.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (case level
+ (1 ".SH \"%s\"\n%s")
+ (2 ".SS \"%s\"\n%s")
+ (3 ".SS \"%s\"\n%s")
+ (t nil)))
+ (text (org-export-data (org-element-property :title headline) info)))
+
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (let ((low-level-body
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "%s\n" ".RS"))
+ ;; Itemize headline
+ ".TP\n.ft I\n" text "\n.ft\n"
+ contents ".RE")))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'" ""
+ low-level-body))))
+
+ ;; Case 3. Standard headline. Export it as a section.
+ (t (format section-fmt text contents )))))
+
+;;; Horizontal Rule
+;; Not supported
+
+;;; Inline Babel Call
+;;
+;; Inline Babel Calls are ignored.
+
+;;; Inline Src Block
+
+(defun org-man-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block)))
+ (cond
+ (org-man-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory ))
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+ (org-lang (org-element-property :language inline-src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-man-source-highlight-langs)))
+
+ (cmd (concat (expand-file-name "source-highlight")
+ " -s " lst-lang
+ " -f groff_man"
+ " -i " in-file
+ " -o " out-file )))
+
+ (if lst-lang
+ (let ((code-block "" ))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n"
+ code))))
+
+ ;; Do not use a special package: transcode it verbatim.
+ (t
+ (concat ".RS\n.nf\n" "\\fC" "\n" code "\n"
+ "\\fP\n.fi\n.RE\n")))))
+
+
+;;; Inlinetask
+;;; Italic
+
+(defun org-man-italic (italic contents info)
+ "Transcode ITALIC from Org to Man.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "\\fI%s\\fP" contents))
+
+
+;;; Item
+
+
+(defun org-man-item (item contents info)
+
+ "Transcode an ITEM element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+
+ (let* ((bullet (org-element-property :bullet item))
+ (type (org-element-property :type (org-element-property :parent item)))
+ (checkbox (case (org-element-property :checkbox item)
+ (on "\\o'\\(sq\\(mu'") ;;
+ (off "\\(sq ") ;;
+ (trans "\\o'\\(sq\\(mi'" ))) ;;
+
+ (tag (let ((tag (org-element-property :tag item)))
+ ;; Check-boxes must belong to the tag.
+ (and tag (format "\\fB%s\\fP"
+ (concat checkbox
+ (org-export-data tag info)))))))
+
+ (if (and (null tag )
+ (null checkbox))
+ (let* ((bullet (org-trim bullet))
+ (marker (cond ((string= "-" bullet) "\\(em")
+ ((string= "*" bullet) "\\(bu")
+ ((eq type 'ordered)
+ (format "%s " (org-trim bullet)))
+ (t "\\(dg"))))
+ (concat ".IP " marker " 4\n"
+ (org-trim (or contents " " ))))
+ ; else
+ (concat ".TP\n" (or tag (concat " " checkbox)) "\n"
+ (org-trim (or contents " " ))))))
+
+;;; Keyword
+
+
+(defun org-man-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "MAN") value)
+ ((string= key "INDEX") nil)
+ ((string= key "TOC" ) nil))))
+
+
+;;; Line Break
+
+(defun org-man-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ ".br\n")
+
+
+;;; Link
+
+
+(defun org-man-link (link desc info)
+ "Transcode a LINK object from Org to Man.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((and (string= type "file") (file-name-absolute-p raw-path))
+ (concat "file:" raw-path))
+ (t raw-path)))
+ protocol)
+ (cond
+ ;; External link with a description part.
+ ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
+ ;; External link without a description part.
+ (path (format "\\fI%s\\fP" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "\\fI%s\\fP" desc)))))
+
+
+;;; Paragraph
+
+(defun org-man-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to Man.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (let ((parent (plist-get (nth 1 paragraph) :parent)))
+ (when parent
+ (let ((parent-type (car parent))
+ (fixed-paragraph ""))
+ (cond ((and (eq parent-type 'item)
+ (plist-get (nth 1 parent) :bullet ))
+ (setq fixed-paragraph (concat "" contents)))
+ ((eq parent-type 'section)
+ (setq fixed-paragraph (concat ".PP\n" contents)))
+ ((eq parent-type 'footnote-definition)
+ (setq fixed-paragraph contents))
+ (t (setq fixed-paragraph (concat "" contents))))
+ fixed-paragraph ))))
+
+
+;;; Plain List
+
+(defun org-man-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to Man.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ contents)
+
+;;; Plain Text
+
+(defun org-man-plain-text (text info)
+ "Transcode a TEXT string from Org to Man.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (let ((output text))
+ ;; Protect various chars.
+ (setq output (replace-regexp-in-string
+ "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
+ "$\\" output nil t 1))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n"
+ output)))
+ ;; Return value.
+ output))
+
+
+
+;;; Planning
+
+
+;;; Property Drawer
+
+
+;;; Quote Block
+
+(defun org-man-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (org-man--wrap-label
+ quote-block
+ (format ".RS\n%s\n.RE" contents)))
+
+;;; Quote Section
+
+(defun org-man-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format ".RS\\fI%s\\fP\n.RE\n" value))))
+
+
+;;; Radio Target
+
+(defun org-man-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to Man.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ text )
+
+
+;;; Section
+
+(defun org-man-section (section contents info)
+ "Transcode a SECTION element from Org to Man.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;; Special Block
+
+(defun org-man-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to Man.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block))))
+ (org-man--wrap-label
+ special-block
+ (format "%s\n" contents))))
+
+
+;;; Src Block
+
+(defun org-man-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to Man.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (code (org-element-property :value src-block))
+ (custom-env (and lang
+ (cadr (assq (intern lang)
+ org-man-custom-lang-environments))))
+ (num-start (case (org-element-property :number-lines src-block)
+ (continued (org-export-get-loc src-block info))
+ (new 0)))
+ (retain-labels (org-element-property :retain-labels src-block)))
+ (cond
+ ;; Case 1. No source fontification.
+ ((not org-man-source-highlight)
+ (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
+ (org-export-format-code-default src-block info)))
+ (org-man-source-highlight
+ (let* ((tmpdir (if (featurep 'xemacs)
+ temp-directory
+ temporary-file-directory ))
+
+ (in-file (make-temp-name
+ (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name
+ (expand-file-name "reshilite" tmpdir)))
+
+ (org-lang (org-element-property :language src-block))
+ (lst-lang (cadr (assq (intern org-lang)
+ org-man-source-highlight-langs)))
+
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_man "
+ " -i " in-file
+ " -o " out-file)))
+
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))))
+
+
+;;; Statistics Cookie
+
+(defun org-man-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+
+;;; Strike-Through
+
+(defun org-man-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Man.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "\\fI%s\\fP" contents))
+
+;;; Subscript
+
+(defun org-man-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to Man.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\d\\s-2%s\\s+2\\u" contents))
+
+;;; Superscript "^_%s$
+
+(defun org-man-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to Man.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "\\u\\s-2%s\\s+2\\d" contents))
+
+
+;;; Table
+;;
+;; `org-man-table' is the entry point for table transcoding. It
+;; takes care of tables with a "verbatim" attribute. Otherwise, it
+;; delegates the job to either `org-man-table--table.el-table' or
+;; `org-man-table--org-table' functions, depending of the type of
+;; the table.
+;;
+;; `org-man-table--align-string' is a subroutine used to build
+;; alignment string for Org tables.
+
+(defun org-man-table (table contents info)
+ "Transcode a TABLE element from Org to Man.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (cond
+ ;; Case 1: verbatim table.
+ ((or org-man-tables-verbatim
+ (let ((attr (read (format "(%s)"
+ (mapconcat
+ #'identity
+ (org-element-property :attr_man table)
+ " ")))))
+
+ (and attr (plist-get attr :verbatim))))
+
+ (format ".nf\n\\fC%s\\fP\n.fi"
+ ;; Re-create table, without affiliated keywords.
+ (org-trim
+ (org-element-interpret-data
+ `(table nil ,@(org-element-contents table))))))
+ ;; Case 2: Standard table.
+ (t (org-man-table--org-table table contents info))))
+
+(defun org-man-table--align-string (divider table info)
+ "Return an appropriate Man alignment string.
+TABLE is the considered table. INFO is a plist used as
+a communication channel."
+ (let (alignment)
+ ;; Extract column groups and alignment from first (non-rule) row.
+ (org-element-map
+ (org-element-map table 'table-row
+ (lambda (row)
+ (and (eq (org-element-property :type row) 'standard) row))
+ info 'first-match)
+ 'table-cell
+ (lambda (cell)
+ (let* ((borders (org-export-table-cell-borders cell info))
+ (raw-width (org-export-table-cell-width cell info))
+ (width-cm (when raw-width (/ raw-width 5)))
+ (width (if raw-width (format "w(%dc)"
+ (if (< width-cm 1) 1 width-cm)) "")))
+ ;; Check left border for the first cell only.
+ (when (and (memq 'left borders) (not alignment))
+ (push "|" alignment))
+ (push
+ (case (org-export-table-cell-alignment cell info)
+ (left (concat "l" width divider))
+ (right (concat "r" width divider))
+ (center (concat "c" width divider)))
+ alignment)
+ (when (memq 'right borders) (push "|" alignment))))
+ info)
+ (apply 'concat (reverse alignment))))
+
+(defun org-man-table--org-table (table contents info)
+ "Return appropriate Man code for an Org table.
+
+TABLE is the table type element to transcode. CONTENTS is its
+contents, as a string. INFO is a plist used as a communication
+channel.
+
+This function assumes TABLE has `org' as its `:type' attribute."
+ (let* ((attr (org-export-read-attribute :attr_man table))
+ (label (org-element-property :name table))
+ (caption (and (not (plist-get attr :disable-caption))
+ (org-man--caption/label-string table info)))
+ (divider (if (plist-get attr :divider) "|" " "))
+
+ ;; Determine alignment string.
+ (alignment (org-man-table--align-string divider table info))
+ ;; Extract others display options.
+
+ (lines (org-split-string contents "\n"))
+
+ (attr-list
+ (delq nil
+ (list
+ (and (plist-get attr :expand) "expand")
+ (let ((placement (plist-get attr :placement)))
+ (cond ((string= placement 'center) "center")
+ ((string= placement 'left) nil)
+ (t (if org-man-tables-centered "center" ""))))
+ (or (plist-get attr :boxtype) "box"))))
+
+ (title-line (plist-get attr :title-line))
+ (long-cells (plist-get attr :long-cells))
+
+ (table-format (concat
+ (format "%s" (or (car attr-list) "" ))
+ (or
+ (let ((output-list '()))
+ (when (cdr attr-list)
+ (dolist (attr-item (cdr attr-list))
+ (setq output-list (concat output-list (format ",%s" attr-item)))))
+ output-list)
+ "")))
+
+ (first-line (when lines (org-split-string (car lines) "\t"))))
+ ;; Prepare the final format string for the table.
+
+
+ (cond
+ ;; Others.
+ (lines (concat ".TS\n " table-format ";\n"
+
+ (format "%s.\n"
+ (let ((final-line ""))
+ (when title-line
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "cb" divider))))
+
+ (setq final-line (concat final-line "\n"))
+
+ (if alignment
+ (setq final-line (concat final-line alignment))
+ (dotimes (i (length first-line))
+ (setq final-line (concat final-line "c" divider))))
+ final-line ))
+
+ (format "%s.TE\n"
+ (let ((final-line "")
+ (long-line "")
+ (lines (org-split-string contents "\n")))
+
+ (dolist (line-item lines)
+ (setq long-line "")
+
+ (if long-cells
+ (progn
+ (if (string= line-item "_")
+ (setq long-line (format "%s\n" line-item))
+ ;; else string =
+ (let ((cell-item-list (org-split-string line-item "\t")))
+ (dolist (cell-item cell-item-list)
+
+ (cond ((eq cell-item (car (last cell-item-list)))
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t\n" cell-item ))))
+ (t
+ (setq long-line (concat long-line
+ (format "T{\n%s\nT}\t" cell-item ))))))
+ long-line))
+ ;; else long cells
+ (setq final-line (concat final-line long-line )))
+
+ (setq final-line (concat final-line line-item "\n"))))
+ final-line))
+
+ (and caption (format ".TB \"%s\"" caption)))))))
+
+;;; Table Cell
+
+(defun org-man-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to Man
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-man-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-man-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents )
+ (when (org-export-get-next-element table-cell info) "\t")))
+
+
+;;; Table Row
+
+(defun org-man-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to Man
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((attr (mapconcat 'identity
+ (org-element-property
+ :attr_man (org-export-get-parent table-row))
+ " "))
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (borders
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (concat
+ ;; Mark horizontal lines
+ (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
+ contents
+
+ (cond
+ ;; When BOOKTABS are activated enforce bottom rule even when
+ ;; no hline was specifically marked.
+ ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
+ ((memq 'below borders) "\n_"))))))
+
+
+;;; Target
+
+(defun org-man-target (target contents info)
+ "Transcode a TARGET object from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "\\fI%s\\fP"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+
+;;; Timestamp
+
+(defun org-man-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to Man.
+ CONTENTS is nil. INFO is a plist holding contextual
+ information."
+ "" )
+
+
+;;; Underline
+
+(defun org-man-underline (underline contents info)
+ "Transcode UNDERLINE from Org to Man.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "\\fI%s\\fP" contents))
+
+
+;;; Verbatim
+
+(defun org-man-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to Man.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format ".nf\n%s\n.fi" contents))
+
+
+;;; Verse Block
+
+(defun org-man-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to Man.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (format ".RS\n.ft I\n%s\n.ft\n.RE" contents))
+
+
+
+;;; Interactive functions
+
+(defun org-man-export-to-man
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a Man file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only the body
+without any markers.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".man" subtreep)))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist)))
+
+(defun org-man-export-to-pdf
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to Groff then process through to PDF.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write between
+markers.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return PDF file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".man" subtreep)))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
+
+(defun org-man-compile (file)
+ "Compile a Groff file.
+
+FILE is the name of the file being compiled. Processing is done
+through the command specified in `org-man-pdf-process'.
+
+Return PDF file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
+ (full-name (file-truename file))
+ (out-dir (file-name-directory file))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p file)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (message "Processing Groff file %s..." file)
+ (save-window-excursion
+ (cond
+ ;; A function is provided: Apply it.
+ ((functionp org-man-pdf-process)
+ (funcall org-man-pdf-process (shell-quote-argument file)))
+ ;; A list is provided: Replace %b, %f and %o with appropriate
+ ;; values in each command before applying it. Output is
+ ;; redirected to "*Org PDF Groff Output*" buffer.
+ ((consp org-man-pdf-process)
+ (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
+ (mapc
+ (lambda (command)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ org-man-pdf-process)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-man-collect-errors outbuf))))
+ (t (error "No valid command to process to PDF")))
+ (let ((pdffile (concat out-dir base-name ".pdf")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p pdffile))
+ (error "PDF file %s wasn't produced%s" pdffile
+ (if errors (concat ": " errors) ""))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when org-man-remove-logfiles
+ (dolist (ext org-man-logfiles-extensions)
+ (let ((file (concat out-dir base-name "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ pdffile))))
+
+(defun org-man-collect-errors (buffer)
+ "Collect some kind of errors from \"groff\" output
+BUFFER is the buffer containing output.
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-max))
+ ;; Find final run
+ nil )))
+
+
+(provide 'ox-man)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-man.el ends here
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
new file mode 100644
index 00000000000..2da005b45cd
--- /dev/null
+++ b/lisp/org/ox-md.el
@@ -0,0 +1,515 @@
+;;; ox-md.el --- Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Keywords: org, wp, markdown
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a Markdown back-end (vanilla flavor) for
+;; Org exporter, based on `html' back-end. See Org manual for more
+;; information.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-html)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-md nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defcustom org-md-headline-style 'atx
+ "Style used to format headlines.
+This variable can be set to either `atx' or `setext'."
+ :group 'org-export-md
+ :type '(choice
+ (const :tag "Use \"atx\" style" atx)
+ (const :tag "Use \"Setext\" style" setext)))
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'md 'html
+ :export-block '("MD" "MARKDOWN")
+ :filters-alist '((:filter-parse-tree . org-md-separate-elements))
+ :menu-entry
+ '(?m "Export to Markdown"
+ ((?M "To temporary buffer"
+ (lambda (a s v b) (org-md-export-as-markdown a s v)))
+ (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (if a (org-md-export-to-markdown t s v)
+ (org-open-file (org-md-export-to-markdown nil s v)))))))
+ :translate-alist '((bold . org-md-bold)
+ (code . org-md-verbatim)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (example-block . org-md-example-block)
+ (fixed-width . org-md-example-block)
+ (footnote-definition . ignore)
+ (footnote-reference . ignore)
+ (headline . org-md-headline)
+ (horizontal-rule . org-md-horizontal-rule)
+ (inline-src-block . org-md-verbatim)
+ (inner-template . org-md-inner-template)
+ (italic . org-md-italic)
+ (item . org-md-item)
+ (line-break . org-md-line-break)
+ (link . org-md-link)
+ (paragraph . org-md-paragraph)
+ (plain-list . org-md-plain-list)
+ (plain-text . org-md-plain-text)
+ (quote-block . org-md-quote-block)
+ (quote-section . org-md-example-block)
+ (section . org-md-section)
+ (src-block . org-md-example-block)
+ (template . org-md-template)
+ (verbatim . org-md-verbatim)))
+
+
+
+;;; Filters
+
+(defun org-md-separate-elements (tree backend info)
+ "Fix blank lines between elements.
+
+TREE is the parse tree being exported. BACKEND is the export
+back-end used. INFO is a plist used as a communication channel.
+
+Enforce a blank line between elements. There are three
+exceptions to this rule:
+
+ 1. Preserve blank lines between sibling items in a plain list,
+
+ 2. Outside of plain lists, preserve blank lines between
+ a paragraph and a plain list,
+
+ 3. In an item, remove any blank line before the very first
+ paragraph and the next sub-list.
+
+Assume BACKEND is `md'."
+ (org-element-map tree (remq 'item org-element-all-elements)
+ (lambda (e)
+ (cond
+ ((not (and (eq (org-element-type e) 'paragraph)
+ (eq (org-element-type (org-export-get-next-element e info))
+ 'plain-list)))
+ (org-element-put-property e :post-blank 1))
+ ((not (eq (org-element-type (org-element-property :parent e)) 'item)))
+ (t (org-element-put-property
+ e :post-blank (if (org-export-get-previous-element e info) 1 0))))))
+ ;; Return updated tree.
+ tree)
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-md-bold (bold contents info)
+ "Transcode BOLD object into Markdown format.
+CONTENTS is the text within bold markup. INFO is a plist used as
+a communication channel."
+ (format "**%s**" contents))
+
+
+;;;; Code and Verbatim
+
+(defun org-md-verbatim (verbatim contents info)
+ "Transcode VERBATIM object into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((value (org-element-property :value verbatim)))
+ (format (cond ((not (string-match "`" value)) "`%s`")
+ ((or (string-match "\\``" value)
+ (string-match "`\\'" value))
+ "`` %s ``")
+ (t "``%s``"))
+ value)))
+
+
+;;;; Example Block and Src Block
+
+(defun org-md-example-block (example-block contents info)
+ "Transcode EXAMPLE-BLOCK element into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (replace-regexp-in-string
+ "^" " "
+ (org-remove-indentation
+ (org-export-format-code-default example-block info))))
+
+
+;;;; Headline
+
+(defun org-md-headline (headline contents info)
+ "Transcode HEADLINE element into Markdown format.
+CONTENTS is the headline contents. INFO is a plist used as
+a communication channel."
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (title (org-export-data (org-element-property :title headline) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword
+ headline)))
+ (and todo (concat (org-export-data todo info) " ")))))
+ (tags (and (plist-get info :with-tags)
+ (let ((tag-list (org-export-get-tags headline info)))
+ (and tag-list
+ (format " :%s:"
+ (mapconcat 'identity tag-list ":"))))))
+ (priority
+ (and (plist-get info :with-priority)
+ (let ((char (org-element-property :priority headline)))
+ (and char (format "[#%c] " char)))))
+ (anchor
+ (when (plist-get info :with-toc)
+ (org-html--anchor
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-"))))))
+ ;; Headline text without tags.
+ (heading (concat todo priority title)))
+ (cond
+ ;; Cannot create a headline. Fall-back to a list.
+ ((or (org-export-low-level-p headline info)
+ (not (memq org-md-headline-style '(atx setext)))
+ (and (eq org-md-headline-style 'atx) (> level 6))
+ (and (eq org-md-headline-style 'setext) (> level 2)))
+ (let ((bullet
+ (if (not (org-export-numbered-headline-p headline info)) "-"
+ (concat (number-to-string
+ (car (last (org-export-get-headline-number
+ headline info))))
+ "."))))
+ (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags
+ "\n\n"
+ (and contents
+ (replace-regexp-in-string "^" " " contents)))))
+ ;; Use "Setext" style.
+ ((eq org-md-headline-style 'setext)
+ (concat heading tags anchor "\n"
+ (make-string (length heading) (if (= level 1) ?= ?-))
+ "\n\n"
+ contents))
+ ;; Use "atx" style.
+ (t (concat (make-string level ?#) " " heading tags anchor "\n\n" contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-md-horizontal-rule (horizontal-rule contents info)
+ "Transcode HORIZONTAL-RULE element into Markdown format.
+CONTENTS is the horizontal rule contents. INFO is a plist used
+as a communication channel."
+ "---")
+
+
+;;;; Italic
+
+(defun org-md-italic (italic contents info)
+ "Transcode ITALIC object into Markdown format.
+CONTENTS is the text within italic markup. INFO is a plist used
+as a communication channel."
+ (format "*%s*" contents))
+
+
+;;;; Item
+
+(defun org-md-item (item contents info)
+ "Transcode ITEM element into Markdown format.
+CONTENTS is the item contents. INFO is a plist used as
+a communication channel."
+ (let* ((type (org-element-property :type (org-export-get-parent item)))
+ (struct (org-element-property :structure item))
+ (bullet (if (not (eq type 'ordered)) "-"
+ (concat (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))
+ "."))))
+ (concat bullet
+ (make-string (- 4 (length bullet)) ? )
+ (case (org-element-property :checkbox item)
+ (on "[X] ")
+ (trans "[-] ")
+ (off "[ ] "))
+ (let ((tag (org-element-property :tag item)))
+ (and tag (format "**%s:** "(org-export-data tag info))))
+ (and contents
+ (org-trim (replace-regexp-in-string "^" " " contents))))))
+
+
+;;;; Line Break
+
+(defun org-md-line-break (line-break contents info)
+ "Transcode LINE-BREAK object into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ " \n")
+
+
+;;;; Link
+
+(defun org-md-link (link contents info)
+ "Transcode LINE-BREAK object into Markdown format.
+CONTENTS is the link's description. INFO is a plist used as
+a communication channel."
+ (let ((link-org-files-as-md
+ (function
+ (lambda (raw-path)
+ ;; Treat links to `file.org' as links to `file.md'.
+ (if (string= ".org" (downcase (file-name-extension raw-path ".")))
+ (concat (file-name-sans-extension raw-path) ".md")
+ raw-path))))
+ (type (org-element-property :type link)))
+ (cond
+ ((member type '("custom-id" "id"))
+ (let ((destination (org-export-resolve-id-link link info)))
+ (if (stringp destination) ; External file.
+ (let ((path (funcall link-org-files-as-md destination)))
+ (if (not contents) (format "<%s>" path)
+ (format "[%s](%s)" contents path)))
+ (concat
+ (and contents (concat contents " "))
+ (format "(%s)"
+ (format (org-export-translate "See section %s" :html info)
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info)
+ ".")))))))
+ ((org-export-inline-image-p link org-html-inline-image-rules)
+ (let ((path (let ((raw-path (org-element-property :path link)))
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (expand-file-name raw-path))))
+ (caption (org-export-data
+ (org-export-get-caption
+ (org-export-get-parent-element link)) info)))
+ (format "![img](%s)"
+ (if (not (org-string-nw-p caption)) path
+ (format "%s \"%s\"" path caption)))))
+ ((string= type "coderef")
+ (let ((ref (org-element-property :path link)))
+ (format (org-export-get-coderef-format ref contents)
+ (org-export-resolve-coderef ref info))))
+ ((equal type "radio") contents)
+ ((equal type "fuzzy")
+ (let ((destination (org-export-resolve-fuzzy-link link info)))
+ (if (org-string-nw-p contents) contents
+ (when destination
+ (let ((number (org-export-get-ordinal destination info)))
+ (when number
+ (if (atom number) (number-to-string number)
+ (mapconcat 'number-to-string number "."))))))))
+ ;; Link type is handled by a special function.
+ ((let ((protocol (nth 2 (assoc type org-link-protocols))))
+ (and (functionp protocol)
+ (funcall protocol
+ (org-link-unescape (org-element-property :path link))
+ contents
+ 'md))))
+ (t (let* ((raw-path (org-element-property :path link))
+ (path
+ (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((string= type "file")
+ (let ((path (funcall link-org-files-as-md raw-path)))
+ (if (not (file-name-absolute-p path)) path
+ ;; If file path is absolute, prepend it
+ ;; with "file:" component.
+ (concat "file:" path))))
+ (t raw-path))))
+ (if (not contents) (format "<%s>" path)
+ (format "[%s](%s)" contents path)))))))
+
+
+;;;; Paragraph
+
+(defun org-md-paragraph (paragraph contents info)
+ "Transcode PARAGRAPH element into Markdown format.
+CONTENTS is the paragraph contents. INFO is a plist used as
+a communication channel."
+ (let ((first-object (car (org-element-contents paragraph))))
+ ;; If paragraph starts with a #, protect it.
+ (if (and (stringp first-object) (string-match "\\`#" first-object))
+ (replace-regexp-in-string "\\`#" "\\#" contents nil t)
+ contents)))
+
+
+;;;; Plain List
+
+(defun org-md-plain-list (plain-list contents info)
+ "Transcode PLAIN-LIST element into Markdown format.
+CONTENTS is the plain-list contents. INFO is a plist used as
+a communication channel."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-md-plain-text (text info)
+ "Transcode a TEXT string into Markdown format.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (when (plist-get info :with-smart-quotes)
+ (setq text (org-export-activate-smart-quotes text :html info)))
+ ;; Protect ambiguous #. This will protect # at the beginning of
+ ;; a line, but not at the beginning of a paragraph. See
+ ;; `org-md-paragraph'.
+ (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text))
+ ;; Protect ambiguous !
+ (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1))
+ ;; Protect `, *, _ and \
+ (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text))
+ ;; Handle special strings, if required.
+ (when (plist-get info :with-special-strings)
+ (setq text (org-html-convert-special-strings text)))
+ ;; Handle break preservation, if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text)))
+ ;; Return value.
+ text)
+
+
+;;;; Quote Block
+
+(defun org-md-quote-block (quote-block contents info)
+ "Transcode QUOTE-BLOCK element into Markdown format.
+CONTENTS is the quote-block contents. INFO is a plist used as
+a communication channel."
+ (replace-regexp-in-string
+ "^" "> "
+ (replace-regexp-in-string "\n\\'" "" contents)))
+
+
+;;;; Section
+
+(defun org-md-section (section contents info)
+ "Transcode SECTION element into Markdown format.
+CONTENTS is the section contents. INFO is a plist used as
+a communication channel."
+ contents)
+
+
+;;;; Template
+
+(defun org-md-inner-template (contents info)
+ "Return body of document after converting it to Markdown syntax.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ ;; Make sure CONTENTS is separated from table of contents and
+ ;; footnotes with at least a blank line.
+ (org-trim (org-html-inner-template (concat "\n" contents "\n") info)))
+
+(defun org-md-template (contents info)
+ "Return complete document string after Markdown conversion.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ contents)
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-md-export-as-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org MD Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'md "*Org MD Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
+
+;;;###autoload
+(defun org-md-convert-region-to-md ()
+ "Assume the current region has org-mode syntax, and convert it to Markdown.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in a Markdown buffer and use
+this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'md))
+
+
+;;;###autoload
+(defun org-md-export-to-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (org-export-to-file 'md outfile async subtreep visible-only)))
+
+
+(provide 'ox-md)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-md.el ends here
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
new file mode 100644
index 00000000000..9abda33f59d
--- /dev/null
+++ b/lisp/org/ox-odt.el
@@ -0,0 +1,4387 @@
+;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode
+
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
+
+;; Author: Jambunathan K <kjambunathan at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl)
+ (require 'table nil 'noerror))
+(require 'format-spec)
+(require 'ox)
+(require 'org-compat)
+
+;;; Define Back-End
+
+(org-export-define-backend 'odt
+ '((bold . org-odt-bold)
+ (center-block . org-odt-center-block)
+ (clock . org-odt-clock)
+ (code . org-odt-code)
+ (drawer . org-odt-drawer)
+ (dynamic-block . org-odt-dynamic-block)
+ (entity . org-odt-entity)
+ (example-block . org-odt-example-block)
+ (export-block . org-odt-export-block)
+ (export-snippet . org-odt-export-snippet)
+ (fixed-width . org-odt-fixed-width)
+ (footnote-definition . org-odt-footnote-definition)
+ (footnote-reference . org-odt-footnote-reference)
+ (headline . org-odt-headline)
+ (horizontal-rule . org-odt-horizontal-rule)
+ (inline-src-block . org-odt-inline-src-block)
+ (inlinetask . org-odt-inlinetask)
+ (italic . org-odt-italic)
+ (item . org-odt-item)
+ (keyword . org-odt-keyword)
+ (latex-environment . org-odt-latex-environment)
+ (latex-fragment . org-odt-latex-fragment)
+ (line-break . org-odt-line-break)
+ (link . org-odt-link)
+ (paragraph . org-odt-paragraph)
+ (plain-list . org-odt-plain-list)
+ (plain-text . org-odt-plain-text)
+ (planning . org-odt-planning)
+ (property-drawer . org-odt-property-drawer)
+ (quote-block . org-odt-quote-block)
+ (quote-section . org-odt-quote-section)
+ (radio-target . org-odt-radio-target)
+ (section . org-odt-section)
+ (special-block . org-odt-special-block)
+ (src-block . org-odt-src-block)
+ (statistics-cookie . org-odt-statistics-cookie)
+ (strike-through . org-odt-strike-through)
+ (subscript . org-odt-subscript)
+ (superscript . org-odt-superscript)
+ (table . org-odt-table)
+ (table-cell . org-odt-table-cell)
+ (table-row . org-odt-table-row)
+ (target . org-odt-target)
+ (template . org-odt-template)
+ (timestamp . org-odt-timestamp)
+ (underline . org-odt-underline)
+ (verbatim . org-odt-verbatim)
+ (verse-block . org-odt-verse-block))
+ :export-block "ODT"
+ :filters-alist '((:filter-parse-tree
+ . (org-odt--translate-latex-fragments
+ org-odt--translate-description-lists
+ org-odt--translate-list-tables)))
+ :menu-entry
+ '(?o "Export to ODT"
+ ((?o "As ODT file" org-odt-export-to-odt)
+ (?O "As ODT file and open"
+ (lambda (a s v b)
+ (if a (org-odt-export-to-odt t s v)
+ (org-open-file (org-odt-export-to-odt nil s v) 'system))))))
+ :options-alist
+ '((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ ;; Redefine regular option.
+ (:with-latex nil "tex" org-odt-with-latex)))
+
+
+;;; Dependencies
+
+;;; Hooks
+
+;;; Function Declarations
+
+(declare-function org-id-find-id-file "org-id" (id))
+(declare-function hfy-face-to-style "htmlfontify" (fn))
+(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
+(declare-function archive-zip-extract "arc-mode" (archive name))
+(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file))
+(declare-function browse-url-file-url "browse-url" (file))
+
+
+
+;;; Internal Variables
+
+(defconst org-odt-lib-dir
+ (file-name-directory load-file-name)
+ "Location of ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-odt-schema-dir'.")
+
+(defvar org-odt-data-dir
+ (expand-file-name "../../etc/" org-odt-lib-dir)
+ "Data directory for ODT exporter.
+Use this to infer values of `org-odt-styles-dir' and
+`org-odt-schema-dir'.")
+
+(defconst org-odt-special-string-regexps
+ '(("\\\\-" . "&#x00ad;\\1") ; shy
+ ("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
+ ("--\\([^-]\\)" . "&#x2013;\\1") ; ndash
+ ("\\.\\.\\." . "&#x2026;")) ; hellip
+ "Regular expressions for special string conversion.")
+
+(defconst org-odt-schema-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./schema/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./schema/" org-odt-data-dir))))
+ "List of directories to search for OpenDocument schema files.
+Use this list to set the default value of
+`org-odt-schema-dir'. The entries in this list are
+populated heuristically based on the values of `org-odt-lib-dir'
+and `org-odt-data-dir'.")
+
+(defconst org-odt-styles-dir-list
+ (list
+ (and org-odt-data-dir
+ (expand-file-name "./styles/" org-odt-data-dir)) ; bail out
+ (eval-when-compile
+ (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
+ (expand-file-name "./styles/" org-odt-data-dir)))
+ (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
+ (expand-file-name "./org/" data-directory) ; system
+ )
+ "List of directories to search for OpenDocument styles files.
+See `org-odt-styles-dir'. The entries in this list are populated
+heuristically based on the values of `org-odt-lib-dir' and
+`org-odt-data-dir'.")
+
+(defconst org-odt-styles-dir
+ (let* ((styles-dir
+ (catch 'styles-dir
+ (message "Debug (ox-odt): Searching for OpenDocument styles files...")
+ (mapc (lambda (styles-dir)
+ (when styles-dir
+ (message "Debug (ox-odt): Trying %s..." styles-dir)
+ (when (and (file-readable-p
+ (expand-file-name
+ "OrgOdtContentTemplate.xml" styles-dir))
+ (file-readable-p
+ (expand-file-name
+ "OrgOdtStyles.xml" styles-dir)))
+ (message "Debug (ox-odt): Using styles under %s"
+ styles-dir)
+ (throw 'styles-dir styles-dir))))
+ org-odt-styles-dir-list)
+ nil)))
+ (unless styles-dir
+ (error "Error (ox-odt): Cannot find factory styles files, aborting"))
+ styles-dir)
+ "Directory that holds auxiliary XML files used by the ODT exporter.
+
+This directory contains the following XML files -
+ \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
+ XML files are used as the default values of
+ `org-odt-styles-file' and
+ `org-odt-content-template-file'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using org
+from one of: org's own private git repository, GNU ELPA tar or
+standard Emacs.")
+
+(defconst org-odt-bookmark-prefix "OrgXref.")
+
+(defconst org-odt-manifest-file-entry-tag
+ "\n<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>")
+
+(defconst org-odt-file-extensions
+ '(("odt" . "OpenDocument Text")
+ ("ott" . "OpenDocument Text Template")
+ ("odm" . "OpenDocument Master Document")
+ ("ods" . "OpenDocument Spreadsheet")
+ ("ots" . "OpenDocument Spreadsheet Template")
+ ("odg" . "OpenDocument Drawing (Graphics)")
+ ("otg" . "OpenDocument Drawing Template")
+ ("odp" . "OpenDocument Presentation")
+ ("otp" . "OpenDocument Presentation Template")
+ ("odi" . "OpenDocument Image")
+ ("odf" . "OpenDocument Formula")
+ ("odc" . "OpenDocument Chart")))
+
+(defconst org-odt-table-style-format
+ "
+<style:style style:name=\"%s\" style:family=\"table\">
+ <style:table-properties style:rel-width=\"%s%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/>
+</style:style>
+"
+ "Template for auto-generated Table styles.")
+
+(defvar org-odt-automatic-styles '()
+ "Registry of automatic styles for various OBJECT-TYPEs.
+The variable has the following form:
+ ((OBJECT-TYPE-A
+ ((OBJECT-NAME-A.1 OBJECT-PROPS-A.1)
+ (OBJECT-NAME-A.2 OBJECT-PROPS-A.2) ...))
+ (OBJECT-TYPE-B
+ ((OBJECT-NAME-B.1 OBJECT-PROPS-B.1)
+ (OBJECT-NAME-B.2 OBJECT-PROPS-B.2) ...))
+ ...).
+
+OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option to `org-odt-parse-block-attributes'.
+
+Use `org-odt-add-automatic-style' to add update this variable.'")
+
+(defvar org-odt-object-counters nil
+ "Running counters for various OBJECT-TYPEs.
+Use this to generate automatic names and style-names. See
+`org-odt-add-automatic-style'.")
+
+(defvar org-odt-src-block-paragraph-format
+ "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
+ <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
+ <style:background-image/>
+ </style:paragraph-properties>
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>"
+ "Custom paragraph style for colorized source and example blocks.
+This style is much the same as that of \"OrgFixedWidthBlock\"
+except that the foreground and background colors are set
+according to the default face identified by the `htmlfontify'.")
+
+(defvar hfy-optimizations)
+(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1")
+(defvar org-odt-embedded-formulas-count 0)
+(defvar org-odt-embedded-images-count 0)
+(defvar org-odt-image-size-probe-method
+ (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675
+ '(emacs fixed))
+ "Ordered list of methods for determining image sizes.")
+
+(defvar org-odt-default-image-sizes-alist
+ '(("as-char" . (5 . 0.4))
+ ("paragraph" . (5 . 5)))
+ "Hardcoded image dimensions one for each of the anchor
+ methods.")
+
+;; A4 page size is 21.0 by 29.7 cms
+;; The default page settings has 2cm margin on each of the sides. So
+;; the effective text area is 17.0 by 25.7 cm
+(defvar org-odt-max-image-size '(17.0 . 20.0)
+ "Limiting dimensions for an embedded image.")
+
+(defconst org-odt-label-styles
+ '(("math-formula" "%c" "text" "(%n)")
+ ("math-label" "(%n)" "text" "(%n)")
+ ("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
+ ("value" "%e %n: %c" "value" "%n"))
+ "Specify how labels are applied and referenced.
+
+This is an alist where each element is of the form:
+
+ (STYLE-NAME ATTACH-FMT REF-MODE REF-FMT)
+
+ATTACH-FMT controls how labels and captions are attached to an
+entity. It may contain following specifiers - %e and %c. %e is
+replaced with the CATEGORY-NAME. %n is replaced with
+\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
+with CAPTION.
+
+REF-MODE and REF-FMT controls how label references are generated.
+The following XML is generated for a label reference -
+\"<text:sequence-ref text:reference-format=\"REF-MODE\" ...>
+REF-FMT </text:sequence-ref>\". REF-FMT may contain following
+specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
+%n is replaced with SEQNO.
+
+See also `org-odt-format-label'.")
+
+(defvar org-odt-category-map-alist
+ '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p)
+ ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)
+ ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p)
+ ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p)
+ ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p))
+ "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
+
+This is a list where each entry is of the form:
+
+ (CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE)
+
+CATEGORY_HANDLE identifies the captionable entity in question.
+
+OD-VARIABLE is the OpenDocument sequence counter associated with
+the entity. These counters are declared within
+\"<text:sequence-decls>...</text:sequence-decls>\" block of
+`org-odt-content-template-file'.
+
+LABEL-STYLE is a key into `org-odt-label-styles' and specifies
+how a given entity should be captioned and referenced.
+
+CATEGORY-NAME is used for qualifying captions on export.
+
+ENUMERATOR-PREDICATE is used for assigning a sequence number to
+the entity. See `org-odt--enumerate'.")
+
+(defvar org-odt-manifest-file-entries nil)
+(defvar hfy-user-sheet-assoc)
+
+(defvar org-odt-zip-dir nil
+ "Temporary work directory for OpenDocument exporter.")
+
+
+
+;;; User Configuration Variables
+
+(defgroup org-export-odt nil
+ "Options for exporting Org mode files to ODT."
+ :tag "Org Export ODT"
+ :group 'org-export)
+
+
+;;;; Debugging
+
+(defcustom org-odt-prettify-xml nil
+ "Specify whether or not the xml output should be prettified.
+When this option is turned on, `indent-region' is run on all
+component xml buffers before they are saved. Turn this off for
+regular use. Turn this on if you need to examine the xml
+visually."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+
+;;;; Document schema
+
+(require 'rng-loc)
+(defcustom org-odt-schema-dir
+ (let* ((schema-dir
+ (catch 'schema-dir
+ (message "Debug (ox-odt): Searching for OpenDocument schema files...")
+ (mapc
+ (lambda (schema-dir)
+ (when schema-dir
+ (message "Debug (ox-odt): Trying %s..." schema-dir)
+ (when (and (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc"
+ schema-dir))
+ (file-expand-wildcards
+ (expand-file-name "od-schema*.rnc"
+ schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ (message "Debug (ox-odt): Using schema files under %s"
+ schema-dir)
+ (throw 'schema-dir schema-dir))))
+ org-odt-schema-dir-list)
+ (message "Debug (ox-odt): No OpenDocument schema files installed")
+ nil)))
+ schema-dir)
+ "Directory that contains OpenDocument schema files.
+
+This directory contains:
+1. rnc files for OpenDocument schema
+2. a \"schemas.xml\" file that specifies locating rules needed
+ for auto validation of OpenDocument XML files.
+
+Use the customize interface to set this variable. This ensures
+that `rng-schema-locating-files' is updated and auto-validation
+of OpenDocument XML takes place based on the value
+`rng-nxml-auto-validate-flag'.
+
+The default value of this variable varies depending on the
+version of org in use and is initialized from
+`org-odt-schema-dir-list'. The OASIS schema files are available
+only in the org's private git repository. It is *not* bundled
+with GNU ELPA tar or standard Emacs distribution."
+ :type '(choice
+ (const :tag "Not set" nil)
+ (directory :tag "Schema directory"))
+ :group 'org-export-odt
+ :version "24.1"
+ :set
+ (lambda (var value)
+ "Set `org-odt-schema-dir'.
+Also add it to `rng-schema-locating-files'."
+ (let ((schema-dir value))
+ (set var
+ (if (and
+ (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc" schema-dir))
+ (file-expand-wildcards
+ (expand-file-name "od-schema*.rnc" schema-dir))
+ (file-readable-p
+ (expand-file-name "schemas.xml" schema-dir)))
+ schema-dir
+ (when value
+ (message "Error (ox-odt): %s has no OpenDocument schema files"
+ value))
+ nil)))
+ (when org-odt-schema-dir
+ (eval-after-load 'rng-loc
+ '(add-to-list 'rng-schema-locating-files
+ (expand-file-name "schemas.xml"
+ org-odt-schema-dir))))))
+
+
+;;;; Document styles
+
+(defcustom org-odt-content-template-file nil
+ "Template file for \"content.xml\".
+The exporter embeds the exported content just before
+\"</office:text>\" element.
+
+If unspecified, the file named \"OrgOdtContentTemplate.xml\"
+under `org-odt-styles-dir' is used."
+ :type '(choice (const nil)
+ (file))
+ :group 'org-export-odt
+ :version "24.3")
+
+(defcustom org-odt-styles-file nil
+ "Default styles file for use with ODT export.
+Valid values are one of:
+1. nil
+2. path to a styles.xml file
+3. path to a *.odt or a *.ott file
+4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2
+...))
+
+In case of option 1, an in-built styles.xml is used. See
+`org-odt-styles-dir' for more information.
+
+In case of option 3, the specified file is unzipped and the
+styles.xml embedded therein is used.
+
+In case of option 4, the specified ODT-OR-OTT-FILE is unzipped
+and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the
+generated odt file. Use relative path for specifying the
+FILE-MEMBERS. styles.xml must be specified as one of the
+FILE-MEMBERS.
+
+Use options 1, 2 or 3 only if styles.xml alone suffices for
+achieving the desired formatting. Use option 4, if the styles.xml
+references additional files like header and footer images for
+achieving the desired formatting.
+
+Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on
+a per-file basis. For example,
+
+#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or
+#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "Factory settings" nil)
+ (file :must-match t :tag "styles.xml")
+ (file :must-match t :tag "ODT or OTT file")
+ (list :tag "ODT or OTT file + Members"
+ (file :must-match t :tag "ODF Text or Text Template file")
+ (cons :tag "Members"
+ (file :tag " Member" "styles.xml")
+ (repeat (file :tag "Member"))))))
+
+(defcustom org-odt-display-outline-level 2
+ "Outline levels considered for enumerating captioned entities."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'integer)
+
+;;;; Document conversion
+
+(defcustom org-odt-convert-processes
+ '(("LibreOffice"
+ "soffice --headless --convert-to %f%x --outdir %d %i")
+ ("unoconv"
+ "unoconv -f %f -o %d %i"))
+ "Specify a list of document converters and their usage.
+The converters in this list are offered as choices while
+customizing `org-odt-convert-process'.
+
+This variable is a list where each element is of the
+form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name
+of the converter. CONVERTER-CMD is the shell command for the
+converter and can contain format specifiers. These format
+specifiers are interpreted as below:
+
+%i input file name in full
+%I input file name as a URL
+%f format of the output file
+%o output file name in full
+%O output file name as a URL
+%d output dir in full
+%D output dir as a URL.
+%x extra options as set in `org-odt-convert-capabilities'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Converters"
+ :key-type (string :tag "Converter Name")
+ :value-type (group (string :tag "Command line")))))
+
+(defcustom org-odt-convert-process "LibreOffice"
+ "Use this converter to convert from \"odt\" format to other formats.
+During customization, the list of converter names are populated
+from `org-odt-convert-processes'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,(car c) ,(car c)))
+ org-odt-convert-processes))))
+
+(defcustom org-odt-convert-capabilities
+ '(("Text"
+ ("odt" "ott" "doc" "rtf" "docx")
+ (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott")
+ ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html")))
+ ("Web"
+ ("html")
+ (("pdf" "pdf") ("odt" "odt") ("html" "html")))
+ ("Spreadsheet"
+ ("ods" "ots" "xls" "csv" "xlsx")
+ (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods")
+ ("xls" "xls") ("xlsx" "xlsx")))
+ ("Presentation"
+ ("odp" "otp" "ppt" "pptx")
+ (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt")
+ ("pptx" "pptx") ("odg" "odg"))))
+ "Specify input and output formats of `org-odt-convert-process'.
+More correctly, specify the set of input and output formats that
+the user is actually interested in.
+
+This variable is an alist where each element is of the
+form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST).
+INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an
+alist where each element is of the form (OUTPUT-FMT
+OUTPUT-FILE-EXTENSION EXTRA-OPTIONS).
+
+The variable is interpreted as follows:
+`org-odt-convert-process' can take any document that is in
+INPUT-FMT-LIST and produce any document that is in the
+OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have
+OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT
+serves dual purposes:
+- It is used for populating completion candidates during
+ `org-odt-convert' commands.
+- It is used as the value of \"%f\" specifier in
+ `org-odt-convert-process'.
+
+EXTRA-OPTIONS is used as the value of \"%x\" specifier in
+`org-odt-convert-process'.
+
+DOCUMENT-CLASS is used to group a set of file formats in
+INPUT-FMT-LIST in to a single class.
+
+Note that this variable inherently captures how LibreOffice based
+converters work. LibreOffice maps documents of various formats
+to classes like Text, Web, Spreadsheet, Presentation etc and
+allow document of a given class (irrespective of its source
+format) to be converted to any of the export formats associated
+with that class.
+
+See default setting of this variable for an typical
+configuration."
+ :group 'org-export-odt
+ :version "24.1"
+ :type
+ '(choice
+ (const :tag "None" nil)
+ (alist :tag "Capabilities"
+ :key-type (string :tag "Document Class")
+ :value-type
+ (group (repeat :tag "Input formats" (string :tag "Input format"))
+ (alist :tag "Output formats"
+ :key-type (string :tag "Output format")
+ :value-type
+ (group (string :tag "Output file extension")
+ (choice
+ (const :tag "None" nil)
+ (string :tag "Extra options"))))))))
+
+(defcustom org-odt-preferred-output-format nil
+ "Automatically post-process to this format after exporting to \"odt\".
+Command `org-odt-export-to-odt' exports first to \"odt\" format
+and then uses `org-odt-convert-process' to convert the
+resulting document to this format. During customization of this
+variable, the list of valid values are populated based on
+`org-odt-convert-capabilities'.
+
+You can set this option on per-file basis using file local
+values. See Info node `(emacs) File Variables'."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice :convert-widget
+ (lambda (w)
+ (apply 'widget-convert (widget-type w)
+ (eval (car (widget-get w :args)))))
+ `((const :tag "None" nil)
+ ,@(mapcar (lambda (c)
+ `(const :tag ,c ,c))
+ (org-odt-reachable-formats "odt")))))
+;;;###autoload
+(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
+
+
+;;;; Drawers
+
+(defcustom org-odt-format-drawer-function
+ (lambda (name contents) contents)
+ "Function called to format a drawer in ODT code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+The default value simply returns the value of CONTENTS."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'function)
+
+
+;;;; Headline
+
+(defcustom org-odt-format-headline-function 'ignore
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags string, separated with colons (string or nil).
+
+The function result will be used as headline text."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; Inlinetasks
+
+(defcustom org-odt-format-inlinetask-function 'ignore
+ "Function called to format an inlinetask in ODT code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a string.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+;;;; LaTeX
+
+(defcustom org-odt-with-latex org-export-with-latex
+ "Non-nil means process LaTeX math snippets.
+
+When set, the exporter will process LaTeX environments and
+fragments.
+
+This option can also be set with the +OPTIONS line,
+e.g. \"tex:mathjax\". Allowed values are:
+
+nil Ignore math snippets.
+`verbatim' Keep everything in verbatim
+`dvipng' Process the LaTeX fragments to images. This will also
+ include processing of non-math environments.
+`imagemagick' Convert the LaTeX fragments to pdf files and use
+ imagemagick to convert pdf files to png files.
+`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+t Synonym for `mathjax'."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (const :tag "Use dvipng to make images" dvipng)
+ (const :tag "Use imagemagick to make images" imagemagick)
+ (const :tag "Use MathJax to display math" mathjax)
+ (const :tag "Leave math verbatim" verbatim)))
+
+
+;;;; Links
+
+(defcustom org-odt-inline-formula-rules
+ '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'"))
+ "Rules characterizing formula files that can be inlined into ODT.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-odt-inline-image-rules
+ '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'"))
+ "Rules characterizing image files that can be inlined into ODT.
+
+A rule consists in an association whose key is the type of link
+to consider, and value is a regexp that will be matched against
+link's path."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(alist :key-type (string :tag "Type")
+ :value-type (regexp :tag "Path")))
+
+(defcustom org-odt-pixels-per-inch 96.0
+ "Scaling factor for converting images pixels to inches.
+Use this for sizing of embedded images. See Info node `(org)
+Images in ODT export' for more information."
+ :type 'float
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.1"))
+
+
+;;;; Src Block
+
+(defcustom org-odt-create-custom-styles-for-srcblocks t
+ "Whether custom styles for colorized source blocks be automatically created.
+When this option is turned on, the exporter creates custom styles
+for source blocks based on the advice of `htmlfontify'. Creation
+of custom styles happen as part of `org-odt-hfy-face-to-css'.
+
+When this option is turned off exporter does not create such
+styles.
+
+Use the latter option if you do not want the custom styles to be
+based on your current display settings. It is necessary that the
+styles.xml already contains needed styles for colorizing to work.
+
+This variable is effective only if
+`org-odt-fontify-srcblocks' is turned on."
+ :group 'org-export-odt
+ :version "24.1"
+ :type 'boolean)
+
+(defcustom org-odt-fontify-srcblocks t
+ "Specify whether or not source blocks need to be fontified.
+Turn this option on if you want to colorize the source code
+blocks in the exported file. For colorization to work, you need
+to make available an enhanced version of `htmlfontify' library."
+ :type 'boolean
+ :group 'org-export-odt
+ :version "24.1")
+
+
+;;;; Table
+
+(defcustom org-odt-table-styles
+ '(("OrgEquation" "OrgEquation"
+ ((use-first-column-styles . t)
+ (use-last-column-styles . t)))
+ ("TableWithHeaderRowAndColumn" "Custom"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ ("TableWithFirstRowandLastRow" "Custom"
+ ((use-first-row-styles . t)
+ (use-last-row-styles . t)))
+ ("GriddedTable" "Custom" nil))
+ "Specify how Table Styles should be derived from a Table Template.
+This is a list where each element is of the
+form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS).
+
+TABLE-STYLE-NAME is the style associated with the table through
+\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line.
+
+TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
+TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
+below) that is included in
+`org-odt-content-template-file'.
+
+TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableCell\"
+PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
+ \"TableParagraph\"
+TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" |
+ \"FirstRow\" | \"LastRow\" |
+ \"EvenRow\" | \"OddRow\" |
+ \"EvenColumn\" | \"OddColumn\" | \"\"
+where \"+\" above denotes string concatenation.
+
+TABLE-CELL-OPTIONS is an alist where each element is of the
+form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF).
+TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' |
+ `use-last-row-styles' |
+ `use-first-column-styles' |
+ `use-last-column-styles' |
+ `use-banding-rows-styles' |
+ `use-banding-columns-styles' |
+ `use-first-row-styles'
+ON-OR-OFF := t | nil
+
+For example, with the following configuration
+
+\(setq org-odt-table-styles
+ '((\"TableWithHeaderRowsAndColumns\" \"Custom\"
+ ((use-first-row-styles . t)
+ (use-first-column-styles . t)))
+ (\"TableWithHeaderColumns\" \"Custom\"
+ ((use-first-column-styles . t)))))
+
+1. A table associated with \"TableWithHeaderRowsAndColumns\"
+ style will use the following table-cell styles -
+ \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\",
+ \"CustomTableCell\" and the following paragraph styles
+ \"CustomFirstRowTableParagraph\",
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate.
+
+2. A table associated with \"TableWithHeaderColumns\" style will
+ use the following table-cell styles -
+ \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the
+ following paragraph styles
+ \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\"
+ as appropriate..
+
+Note that TABLE-TEMPLATE-NAME corresponds to the
+\"<table:table-template>\" elements contained within
+\"<office:styles>\". The entries (TABLE-STYLE-NAME
+TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to
+\"table:template-name\" and \"table:use-first-row-styles\" etc
+attributes of \"<table:table>\" element. Refer ODF-1.2
+specification for more information. Also consult the
+implementation filed under `org-odt-get-table-cell-styles'.
+
+The TABLE-STYLE-NAME \"OrgEquation\" is used internally for
+formatting of numbered display equations. Do not delete this
+style from the list."
+ :group 'org-export-odt
+ :version "24.1"
+ :type '(choice
+ (const :tag "None" nil)
+ (repeat :tag "Table Styles"
+ (list :tag "Table Style Specification"
+ (string :tag "Table Style Name")
+ (string :tag "Table Template Name")
+ (alist :options (use-first-row-styles
+ use-last-row-styles
+ use-first-column-styles
+ use-last-column-styles
+ use-banding-rows-styles
+ use-banding-columns-styles)
+ :key-type symbol
+ :value-type (const :tag "True" t))))))
+
+;;;; Timestamps
+
+(defcustom org-odt-use-date-fields nil
+ "Non-nil, if timestamps should be exported as date fields.
+
+When nil, export timestamps as plain text.
+
+When non-nil, map `org-time-stamp-custom-formats' to a pair of
+OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\"
+respectively. A timestamp with no time component is formatted
+with style \"OrgDate1\" while one with explicit hour and minutes
+is formatted with style \"OrgDate2\".
+
+This feature is experimental. Most (but not all) of the common
+%-specifiers in `format-time-string' are supported.
+Specifically, locale-dependent specifiers like \"%c\", \"%x\" are
+formatted as canonical Org timestamps. For finer control, avoid
+these %-specifiers.
+
+Textual specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\"
+etc., are displayed by the application in the default language
+and country specified in `org-odt-styles-file'. Note that the
+default styles file uses language \"en\" and country \"GB\". You
+can localize the week day and month strings in the exported
+document by setting the default language and country either using
+the application UI or through a custom styles file.
+
+See `org-odt--build-date-styles' for implementation details."
+ :group 'org-export-odt
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+
+;;; Internal functions
+
+;;;; Date
+
+(defun org-odt--format-timestamp (timestamp &optional end iso-date-p)
+ (let* ((format-timestamp
+ (lambda (timestamp format &optional end utc)
+ (if timestamp
+ (org-timestamp-format timestamp format end utc)
+ (format-time-string format nil utc))))
+ (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")))
+ (funcall format-timestamp timestamp format end))))
+ (if iso-date-p iso-date
+ (let* ((style (if has-time-p "OrgDate2" "OrgDate1"))
+ ;; LibreOffice does not care about end goes as content
+ ;; within the "<text:date>...</text:date>" field. The
+ ;; displayed date is automagically corrected to match the
+ ;; format requested by "style:data-style-name" attribute. So
+ ;; don't bother about formatting the date contents to be
+ ;; compatible with "OrgDate1" and "OrgDateTime" styles. A
+ ;; simple Org-style date should suffice.
+ (date (let* ((formats
+ (if org-display-custom-times
+ (cons (substring
+ (car org-time-stamp-custom-formats) 1 -1)
+ (substring
+ (cdr org-time-stamp-custom-formats) 1 -1))
+ '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M")))
+ (format (if has-time-p (cdr formats) (car formats))))
+ (funcall format-timestamp timestamp format end)))
+ (repeater (let ((repeater-type (org-element-property
+ :repeater-type timestamp))
+ (repeater-value (org-element-property
+ :repeater-value timestamp))
+ (repeater-unit (org-element-property
+ :repeater-unit timestamp)))
+ (concat
+ (case repeater-type
+ (catchup "++") (restart ".+") (cumulate "+"))
+ (when repeater-value
+ (number-to-string repeater-value))
+ (case repeater-unit
+ (hour "h") (day "d") (week "w") (month "m")
+ (year "y"))))))
+ (concat
+ (format "<text:date text:date-value=\"%s\" style:data-style-name=\"%s\" text:fixed=\"true\">%s</text:date>"
+ iso-date style date)
+ (and (not (string= repeater "")) " ")
+ repeater)))))
+
+;;;; Frame
+
+(defun org-odt--frame (text width height style &optional extra
+ anchor-type &rest title-and-desc)
+ (let ((frame-attrs
+ (concat
+ (if width (format " svg:width=\"%0.2fcm\"" width) "")
+ (if height (format " svg:height=\"%0.2fcm\"" height) "")
+ extra
+ (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))
+ (format " draw:name=\"%s\""
+ (car (org-odt-add-automatic-style "Frame"))))))
+ (format
+ "\n<draw:frame draw:style-name=\"%s\"%s>\n%s\n</draw:frame>"
+ style frame-attrs
+ (concat text
+ (let ((title (car title-and-desc))
+ (desc (cadr title-and-desc)))
+ (concat (when title
+ (format "<svg:title>%s</svg:title>"
+ (org-odt--encode-plain-text title t)))
+ (when desc
+ (format "<svg:desc>%s</svg:desc>"
+ (org-odt--encode-plain-text desc t)))))))))
+
+
+;;;; Library wrappers
+
+(defun org-odt--zip-extract (archive members target)
+ (when (atom members) (setq members (list members)))
+ (mapc (lambda (member)
+ (require 'arc-mode)
+ (let* ((--quote-file-name
+ ;; This is shamelessly stolen from `archive-zip-extract'.
+ (lambda (name)
+ (if (or (not (memq system-type '(windows-nt ms-dos)))
+ (and (boundp 'w32-quote-process-args)
+ (null w32-quote-process-args)))
+ (shell-quote-argument name)
+ name)))
+ (target (funcall --quote-file-name target))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed"))))
+ members))
+
+;;;; Target
+
+(defun org-odt--target (text id)
+ (if (not id) text
+ (concat
+ (format "\n<text:bookmark-start text:name=\"OrgXref.%s\"/>" id)
+ (format "\n<text:bookmark text:name=\"%s\"/>" id) text
+ (format "\n<text:bookmark-end text:name=\"OrgXref.%s\"/>" id))))
+
+;;;; Textbox
+
+(defun org-odt--textbox (text width height style &optional
+ extra anchor-type)
+ (org-odt--frame
+ (format "\n<draw:text-box %s>%s\n</draw:text-box>"
+ (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2))
+ (and (not width)
+ (format " fo:min-width=\"%0.2fcm\"" (or width .2))))
+ text)
+ width nil style extra anchor-type))
+
+
+
+;;;; Table of Contents
+
+(defun org-odt-begin-toc (index-title depth)
+ (concat
+ (format "
+ <text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">
+ <text:table-of-content-source text:outline-level=\"%d\">
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+" depth index-title)
+
+ (let ((levels (number-sequence 1 10)))
+ (mapconcat
+ (lambda (level)
+ (format
+ "
+ <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\">
+ <text:index-entry-link-start text:style-name=\"Internet_20_link\"/>
+ <text:index-entry-chapter/>
+ <text:index-entry-text/>
+ <text:index-entry-link-end/>
+ </text:table-of-content-entry-template>
+" level level)) levels ""))
+
+ (format "
+ </text:table-of-content-source>
+
+ <text:index-body>
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>
+ " index-title)))
+
+(defun org-odt-end-toc ()
+ (format "
+ </text:index-body>
+ </text:table-of-content>
+"))
+
+(defun* org-odt-format-toc-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (setq text
+ (concat
+ ;; Section number.
+ (when section-number (concat section-number ". "))
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords)
+ "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags"
+ (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : "))))))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ headline-label text))
+
+(defun org-odt-toc (depth info)
+ (assert (wholenump depth))
+ ;; When a headline is marked as a radio target, as in the example below:
+ ;;
+ ;; ** <<<Some Heading>>>
+ ;; Some text.
+ ;;
+ ;; suppress generation of radio targets. i.e., Radio targets are to
+ ;; be marked as targets within /document body/ and *not* within
+ ;; /TOC/, as otherwise there will be duplicated anchors one in TOC
+ ;; and one in the document body.
+ ;;
+ ;; FIXME-1: Currently exported headings are memoized. `org-export.el'
+ ;; doesn't provide a way to disable memoization. So this doesn't
+ ;; work.
+ ;;
+ ;; FIXME-2: Are there any other objects that need to be suppressed
+ ;; within TOC?
+ (let* ((title (org-export-translate "Table of Contents" :utf-8 info))
+ (headlines (org-export-collect-headlines
+ info (and (wholenump depth) depth)))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders (mapcar
+ (lambda (type) (cons type (lambda (d c i) c)))
+ (list 'radio-target)))))
+ (when headlines
+ (concat
+ (org-odt-begin-toc title depth)
+ (mapconcat
+ (lambda (headline)
+ (let* ((entry (org-odt-format-headline--wrap
+ headline backend info 'org-odt-format-toc-headline))
+ (level (org-export-get-relative-level headline info))
+ (style (format "Contents_20_%d" level)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ style entry)))
+ headlines "\n")
+ (org-odt-end-toc)))))
+
+
+;;;; Document styles
+
+(defun org-odt-add-automatic-style (object-type &optional object-props)
+ "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS.
+OBJECT-PROPS is (typically) a plist created by passing
+\"#+ATTR_ODT: \" option of the object in question to
+`org-odt-parse-block-attributes'.
+
+Use `org-odt-object-counters' to generate an automatic
+OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
+new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
+. STYLE-NAME)."
+ (assert (stringp object-type))
+ (let* ((object (intern object-type))
+ (seqvar object)
+ (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
+ (object-name (format "%s%d" object-type seqno)) style-name)
+ (setq org-odt-object-counters
+ (plist-put org-odt-object-counters seqvar seqno))
+ (when object-props
+ (setq style-name (format "Org%s" object-name))
+ (setq org-odt-automatic-styles
+ (plist-put org-odt-automatic-styles object
+ (append (list (list style-name object-props))
+ (plist-get org-odt-automatic-styles object)))))
+ (cons object-name style-name)))
+
+;;;; Checkbox
+
+(defun org-odt--checkbox (item)
+ "Return check-box string associated to ITEM."
+ (let ((checkbox (org-element-property :checkbox item)))
+ (if (not checkbox) ""
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (case checkbox
+ (on "[&#x2713;] ") ; CHECK MARK
+ (off "[ ] ")
+ (trans "[-] "))))))
+
+;;; Template
+
+(defun org-odt--build-date-styles (fmt style)
+ ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way
+ ;; to modify the date fields. A date could be modified by
+ ;; offsetting in days. That's about it. Also, date and time may
+ ;; have to be emitted as two fields - a date field and a time field
+ ;; - separately.
+
+ ;; One can add Form Controls to date and time fields so that they
+ ;; can be easily modified. But then, the exported document will
+ ;; become tightly coupled with LibreOffice and may not function
+ ;; properly with other OpenDocument applications.
+
+ ;; I have a strange feeling that Date styles are a bit flaky at the
+ ;; moment.
+
+ ;; The feature is experimental.
+ (when (and fmt style)
+ (let* ((fmt-alist
+ '(("%A" . "<number:day-of-week number:style=\"long\"/>")
+ ("%B" . "<number:month number:textual=\"true\" number:style=\"long\"/>")
+ ("%H" . "<number:hours number:style=\"long\"/>")
+ ("%M" . "<number:minutes number:style=\"long\"/>")
+ ("%S" . "<number:seconds number:style=\"long\"/>")
+ ("%V" . "<number:week-of-year/>")
+ ("%Y" . "<number:year number:style=\"long\"/>")
+ ("%a" . "<number:day-of-week number:style=\"short\"/>")
+ ("%b" . "<number:month number:textual=\"true\" number:style=\"short\"/>")
+ ("%d" . "<number:day number:style=\"long\"/>")
+ ("%e" . "<number:day number:style=\"short\"/>")
+ ("%h" . "<number:month number:textual=\"true\" number:style=\"short\"/>")
+ ("%k" . "<number:hours number:style=\"short\"/>")
+ ("%m" . "<number:month number:style=\"long\"/>")
+ ("%p" . "<number:am-pm/>")
+ ("%y" . "<number:year number:style=\"short\"/>")))
+ (case-fold-search nil)
+ (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|"))
+ match rpl (start 0) (filler-beg 0) filler-end filler output)
+ (mapc
+ (lambda (pair)
+ (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
+ '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
+ ("%C" . "Y") ; replace century with year
+ ("%D" . "%m/%d/%y")
+ ("%G" . "Y") ; year corresponding to iso week
+ ("%I" . "%H") ; hour on a 12-hour clock
+ ("%R" . "%H:%M")
+ ("%T" . "%H:%M:%S")
+ ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
+ ("%Z" . "") ; time zone name
+ ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
+ ("%g" . "%y")
+ ("%X" . "%x" ) ; locale's pref. time format
+ ("%j" . "") ; day of the year
+ ("%l" . "%k") ; like %I blank-padded
+ ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
+ ("%n" . "<text:line-break/>")
+ ("%r" . "%I:%M:%S %p")
+ ("%t" . "<text:tab/>")
+ ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
+ ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
+ ("%z" . "") ; time zone in numeric form
+ ))
+ (while (string-match re fmt start)
+ (setq match (match-string 0 fmt))
+ (setq rpl (assoc-default match fmt-alist))
+ (setq start (match-end 0))
+ (setq filler-end (match-beginning 0))
+ (setq filler (substring fmt (prog1 filler-beg
+ (setq filler-beg (match-end 0)))
+ filler-end))
+ (setq filler (and (not (string= filler ""))
+ (format "<number:text>%s</number:text>"
+ (org-odt--encode-plain-text filler))))
+ (setq output (concat output "\n" filler "\n" rpl)))
+ (setq filler (substring fmt filler-beg))
+ (unless (string= filler "")
+ (setq output (concat output
+ (format "\n<number:text>%s</number:text>"
+ (org-odt--encode-plain-text filler)))))
+ (format "\n<number:date-style style:name=\"%s\" %s>%s\n</number:date-style>"
+ style
+ (concat " number:automatic-order=\"true\""
+ " number:format-source=\"fixed\"")
+ output ))))
+
+(defun org-odt-template (contents info)
+ "Return complete document string after ODT conversion.
+CONTENTS is the transcoded contents string. RAW-DATA is the
+original parsed data. INFO is a plist holding export options."
+ ;; Write meta file.
+ (let ((title (org-export-data (plist-get info :title) info))
+ (author (let ((author (plist-get info :author)))
+ (if (not author) "" (org-export-data author info))))
+ (email (plist-get info :email))
+ (keywords (plist-get info :keywords))
+ (description (plist-get info :description)))
+ (write-region
+ (concat
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <office:document-meta
+ xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\"
+ xmlns:xlink=\"http://www.w3.org/1999/xlink\"
+ xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
+ xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\"
+ xmlns:ooo=\"http://openoffice.org/2004/office\"
+ office:version=\"1.2\">
+ <office:meta>\n"
+ (format "<dc:creator>%s</dc:creator>\n" author)
+ (format "<meta:initial-creator>%s</meta:initial-creator>\n" author)
+ ;; Date, if required.
+ (when (plist-get info :with-date)
+ ;; Check if DATE is specified as an Org-timestamp. If yes,
+ ;; include it as meta information. Otherwise, just use
+ ;; today's date.
+ (let* ((date (let ((date (plist-get info :date)))
+ (and (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp)
+ (car date)))))
+ (let ((iso-date (org-odt--format-timestamp date nil 'iso-date)))
+ (concat
+ (format "<dc:date>%s</dc:date>\n" iso-date)
+ (format "<meta:creation-date>%s</meta:creation-date>\n"
+ iso-date)))))
+ (format "<meta:generator>%s</meta:generator>\n"
+ (let ((creator-info (plist-get info :with-creator)))
+ (if (or (not creator-info) (eq creator-info 'comment)) ""
+ (plist-get info :creator))))
+ (format "<meta:keyword>%s</meta:keyword>\n" keywords)
+ (format "<dc:subject>%s</dc:subject>\n" description)
+ (format "<dc:title>%s</dc:title>\n" title)
+ "\n"
+ " </office:meta>\n" "</office:document-meta>")
+ nil (concat org-odt-zip-dir "meta.xml"))
+ ;; Add meta.xml in to manifest.
+ (org-odt-create-manifest-file-entry "text/xml" "meta.xml"))
+
+ ;; Update styles file.
+ ;; Copy styles.xml. Also dump htmlfontify styles, if there is any.
+ ;; Write styles file.
+ (let* ((styles-file (plist-get info :odt-styles-file))
+ (styles-file (and styles-file (read (org-trim styles-file))))
+ ;; Non-availability of styles.xml is not a critical
+ ;; error. For now, throw an error.
+ (styles-file (or styles-file
+ org-odt-styles-file
+ (expand-file-name "OrgOdtStyles.xml"
+ org-odt-styles-dir)
+ (error "org-odt: Missing styles file?"))))
+ (cond
+ ((listp styles-file)
+ (let ((archive (nth 0 styles-file))
+ (members (nth 1 styles-file)))
+ (org-odt--zip-extract archive members org-odt-zip-dir)
+ (mapc
+ (lambda (member)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-create-manifest-file-entry media-type member))))
+ members)))
+ ((and (stringp styles-file) (file-exists-p styles-file))
+ (let ((styles-file-type (file-name-extension styles-file)))
+ (cond
+ ((string= styles-file-type "xml")
+ (copy-file styles-file (concat org-odt-zip-dir "styles.xml") t))
+ ((member styles-file-type '("odt" "ott"))
+ (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir)))))
+ (t
+ (error "Invalid specification of styles.xml file: %S"
+ org-odt-styles-file)))
+
+ ;; create a manifest entry for styles.xml
+ (org-odt-create-manifest-file-entry "text/xml" "styles.xml")
+
+ ;; FIXME: Who is opening an empty styles.xml before this point?
+ (with-current-buffer
+ (find-file-noselect (concat org-odt-zip-dir "styles.xml") t)
+ (revert-buffer t t)
+
+ ;; Write custom styles for source blocks
+ ;; Save STYLES used for colorizing of source blocks.
+ ;; Update styles.xml with styles that were collected as part of
+ ;; `org-odt-hfy-face-to-css' callbacks.
+ (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style)))
+ hfy-user-sheet-assoc "")))
+ (when styles
+ (goto-char (point-min))
+ (when (re-search-forward "</office:styles>" nil t)
+ (goto-char (match-beginning 0))
+ (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n"))))
+
+ ;; Update styles.xml - take care of outline numbering
+
+ ;; Don't make automatic backup of styles.xml file. This setting
+ ;; prevents the backed-up styles.xml file from being zipped in to
+ ;; odt file. This is more of a hackish fix. Better alternative
+ ;; would be to fix the zip command so that the output odt file
+ ;; includes only the needed files and excludes any auto-generated
+ ;; extra files like backups and auto-saves etc etc. Note that
+ ;; currently the zip command zips up the entire temp directory so
+ ;; that any auto-generated files created under the hood ends up in
+ ;; the resulting odt file.
+ (set (make-local-variable 'backup-inhibited) t)
+
+ ;; Outline numbering is retained only upto LEVEL.
+ ;; To disable outline numbering pass a LEVEL of 0.
+
+ (goto-char (point-min))
+ (let ((regex
+ "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>")
+ (replacement
+ "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">"))
+ (while (re-search-forward regex nil t)
+ (unless (let ((sec-num (plist-get info :section-numbers))
+ (level (string-to-number (match-string 2))))
+ (if (wholenump sec-num) (<= level sec-num) sec-num))
+ (replace-match replacement t nil))))
+ (save-buffer 0)))
+ ;; Update content.xml.
+
+ (let* ( ;; `org-display-custom-times' should be accessed right
+ ;; within the context of the Org buffer. So obtain its
+ ;; value before moving on to temp-buffer context down below.
+ (custom-time-fmts
+ (if org-display-custom-times
+ (cons (substring (car org-time-stamp-custom-formats) 1 -1)
+ (substring (cdr org-time-stamp-custom-formats) 1 -1))
+ '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
+ (with-temp-buffer
+ (insert-file-contents
+ (or org-odt-content-template-file
+ (expand-file-name "OrgOdtContentTemplate.xml"
+ org-odt-styles-dir)))
+ ;; Write automatic styles.
+ ;; - Position the cursor.
+ (goto-char (point-min))
+ (re-search-forward " </office:automatic-styles>" nil t)
+ (goto-char (match-beginning 0))
+ ;; - Dump automatic table styles.
+ (loop for (style-name props) in
+ (plist-get org-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) "96"))
+ (insert (format org-odt-table-style-format style-name props))))
+ ;; - Dump date-styles.
+ (when org-odt-use-date-fields
+ (insert (org-odt--build-date-styles (car custom-time-fmts)
+ "OrgDate1")
+ (org-odt--build-date-styles (cdr custom-time-fmts)
+ "OrgDate2")))
+ ;; Update display level.
+ ;; - Remove existing sequence decls. Also position the cursor.
+ (goto-char (point-min))
+ (when (re-search-forward "<text:sequence-decls" nil t)
+ (delete-region (match-beginning 0)
+ (re-search-forward "</text:sequence-decls>" nil nil)))
+ ;; Update sequence decls according to user preference.
+ (insert
+ (format
+ "\n<text:sequence-decls>\n%s\n</text:sequence-decls>"
+ (mapconcat
+ (lambda (x)
+ (format
+ "<text:sequence-decl text:display-outline-level=\"%d\" text:name=\"%s\"/>"
+ org-odt-display-outline-level (nth 1 x)))
+ org-odt-category-map-alist "\n")))
+ ;; Position the cursor to document body.
+ (goto-char (point-min))
+ (re-search-forward "</office:text>" nil nil)
+ (goto-char (match-beginning 0))
+
+ ;; Preamble - Title, Author, Date etc.
+ (insert
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (author (and (plist-get info :with-author)
+ (let ((auth (plist-get info :author)))
+ (and auth (org-export-data auth info)))))
+ (email (plist-get info :email))
+ ;; Switch on or off above vars based on user settings
+ (author (and (plist-get info :with-author) (or author email)))
+ (email (and (plist-get info :with-email) email)))
+ (concat
+ ;; Title.
+ (when (org-string-nw-p title)
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgTitle" (format "\n<text:title>%s</text:title>" title))
+ ;; Separator.
+ "\n<text:p text:style-name=\"OrgTitle\"/>"))
+ (cond
+ ((and author (not email))
+ ;; Author only.
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (format "<text:initial-creator>%s</text:initial-creator>" author))
+ ;; Separator.
+ "\n<text:p text:style-name=\"OrgSubtitle\"/>"))
+ ((and author email)
+ ;; Author and E-mail.
+ (concat
+ (format
+ "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ (concat "mailto:" email)
+ (format "<text:initial-creator>%s</text:initial-creator>" author)))
+ ;; Separator.
+ "\n<text:p text:style-name=\"OrgSubtitle\"/>")))
+ ;; Date, if required.
+ (when (plist-get info :with-date)
+ (let* ((date (plist-get info :date))
+ ;; Check if DATE is specified as a timestamp.
+ (timestamp (and (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp)
+ (car date))))
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (if (and org-odt-use-date-fields timestamp)
+ (org-odt--format-timestamp (car date))
+ (org-export-data (plist-get info :date) info)))
+ ;; Separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>"))))))
+ ;; Table of Contents
+ (let* ((with-toc (plist-get info :with-toc))
+ (depth (and with-toc (if (wholenump with-toc)
+ with-toc
+ (plist-get info :headline-levels)))))
+ (when depth (insert (or (org-odt-toc depth info) ""))))
+ ;; Contents.
+ (insert contents)
+ ;; Return contents.
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-odt-bold (bold contents info)
+ "Transcode BOLD from Org to ODT.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Bold" contents))
+
+
+;;;; Center Block
+
+(defun org-odt-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the center block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Clock
+
+(defun org-odt-clock (clock contents info)
+ "Transcode a CLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let ((timestamp (org-element-property :value clock))
+ (duration (org-element-property :duration clock)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (if (eq (org-element-type (org-export-get-next-element clock info))
+ 'clock) "OrgClock" "OrgClockLastLine")
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgClockKeyword" org-clock-string)
+ (org-odt-timestamp timestamp contents info)
+ (and duration (format " (%s)" duration))))))
+
+
+;;;; Code
+
+(defun org-odt-code (code contents info)
+ "Transcode a CODE object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-odt--encode-plain-text
+ (org-element-property :value code))))
+
+
+;;;; Comment
+
+;; Comments are ignored.
+
+
+;;;; Comment Block
+
+;; Comment Blocks are ignored.
+
+
+;;;; Drawer
+
+(defun org-odt-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (funcall org-odt-format-drawer-function
+ name contents)))
+ output))
+
+
+;;;; Dynamic Block
+
+(defun org-odt-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information. See `org-export-data'."
+ contents)
+
+
+;;;; Entity
+
+(defun org-odt-entity (entity contents info)
+ "Transcode an ENTITY object from Org to ODT.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (org-element-property :utf-8 entity))
+
+
+;;;; Example Block
+
+(defun org-odt-example-block (example-block contents info)
+ "Transcode a EXAMPLE-BLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-odt-format-code example-block info))
+
+
+;;;; Export Snippet
+
+(defun org-odt-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'odt)
+ (org-element-property :value export-snippet)))
+
+
+;;;; Export Block
+
+(defun org-odt-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "ODT")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+
+;;;; Fixed Width
+
+(defun org-odt-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-odt-do-format-code (org-element-property :value fixed-width)))
+
+
+;;;; Footnote Definition
+
+;; Footnote Definitions are ignored.
+
+
+;;;; Footnote Reference
+
+(defun org-odt-footnote-reference (footnote-reference contents info)
+ "Transcode a FOOTNOTE-REFERENCE element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((--format-footnote-definition
+ (function
+ (lambda (n def)
+ (setq n (format "%d" n))
+ (let ((id (concat "fn" n))
+ (note-class "footnote")
+ (par-style "Footnote"))
+ (format
+ "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
+ id note-class
+ (concat
+ (format "<text:note-citation>%s</text:note-citation>" n)
+ (format "<text:note-body>%s</text:note-body>" def)))))))
+ (--format-footnote-reference
+ (function
+ (lambda (n)
+ (setq n (format "%d" n))
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript"
+ (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
+ note-class ref-format ref-name n)))))))
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (and (eq (org-element-type prev) 'footnote-reference)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript" ",")))
+ ;; Transcode footnote reference.
+ (let ((n (org-export-get-footnote-number footnote-reference info)))
+ (cond
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (funcall --format-footnote-reference n))
+ ;; Inline definitions are secondary strings.
+ ;; Non-inline footnotes definitions are full Org data.
+ (t
+ (let* ((raw (org-export-get-footnote-definition
+ footnote-reference info))
+ (def
+ (let ((def (org-trim
+ (org-export-data-with-backend
+ raw
+ (org-export-create-backend
+ :parent 'odt
+ :transcoders
+ '((paragraph . (lambda (p c i)
+ (org-odt--format-paragraph
+ p c i
+ "Footnote"
+ "OrgFootnoteCenter"
+ "OrgFootnoteQuotations")))))
+ info))))
+ (if (eq (org-element-type raw) 'org-data) def
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Footnote" def)))))
+ (funcall --format-footnote-definition n def))))))))
+
+
+;;;; Headline
+
+(defun* org-odt-format-headline
+ (todo todo-type priority text tags
+ &key level section-number headline-label &allow-other-keys)
+ (concat
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ "<text:tab/>"
+ (format "<text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags" (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : "))))))
+
+(defun org-odt-format-headline--wrap (headline backend info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode a HEADLINE element using BACKEND.
+INFO is a plist holding contextual information."
+ (setq backend (or backend (plist-get info :back-end)))
+ (let* ((level (+ (org-export-get-relative-level headline info)))
+ (headline-number (org-export-get-headline-number headline info))
+ (section-number (and (org-export-numbered-headline-p headline info)
+ (mapconcat 'number-to-string
+ headline-number ".")))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo
+ (org-export-data-with-backend todo backend info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data-with-backend
+ (org-element-property :title headline) backend info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (headline-label (concat "sec-" (mapconcat 'number-to-string
+ headline-number "-")))
+ (format-function (cond
+ ((functionp format-function) format-function)
+ ((not (eq org-odt-format-headline-function 'ignore))
+ (function*
+ (lambda (todo todo-type priority text tags
+ &allow-other-keys)
+ (funcall org-odt-format-headline-function
+ todo todo-type priority text tags))))
+ (t 'org-odt-format-headline))))
+ (apply format-function
+ todo todo-type priority text tags
+ :headline-label headline-label :level level
+ :section-number section-number extra-keys)))
+
+(defun org-odt-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to ODT.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ ;; Case 1: This is a footnote section: ignore it.
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((text (org-export-data (org-element-property :title headline) info))
+ ;; Create the headline text.
+ (full-text (org-odt-format-headline--wrap headline nil info))
+ ;; Get level relative to current parsed data.
+ (level (org-export-get-relative-level headline info))
+ ;; Get canonical label for the headline.
+ (id (concat "sec-" (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-")))
+ ;; Get user-specified labels for the headline.
+ (extra-ids (list (org-element-property :CUSTOM_ID headline)
+ (org-element-property :ID headline)))
+ ;; Extra targets.
+ (extra-targets
+ (mapconcat (lambda (x)
+ (when x
+ (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x)))
+ (org-odt--target
+ "" (org-export-solidify-link-text x)))))
+ extra-ids ""))
+ ;; Title.
+ (anchored-title (org-odt--target full-text id)))
+ (cond
+ ;; Case 2. This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((org-export-low-level-p headline info)
+ ;; Build the real contents of the sub-tree.
+ (concat
+ (and (org-export-first-sibling-p headline info)
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ ;; Choose style based on list type.
+ (if (org-export-numbered-headline-p headline info)
+ "OrgNumberedList" "OrgBulletedList")
+ ;; If top-level list, re-start numbering. Otherwise,
+ ;; continue numbering.
+ (format "text:continue-numbering=\"%s\""
+ (let* ((parent (org-export-get-parent-headline
+ headline)))
+ (if (and parent
+ (org-export-low-level-p parent info))
+ "true" "false")))))
+ (let ((headline-has-table-p
+ (let ((section (assq 'section (org-element-contents headline))))
+ (assq 'table (and section (org-element-contents section))))))
+ (format "\n<text:list-item>\n%s\n%s"
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (concat extra-targets anchored-title))
+ contents)
+ (if headline-has-table-p
+ "</text:list-header>"
+ "</text:list-item>")))
+ (and (org-export-last-sibling-p headline info)
+ "</text:list>")))
+ ;; Case 3. Standard headline. Export it as a section.
+ (t
+ (concat
+ (format
+ "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\">%s</text:h>"
+ (format "Heading_20_%s" level)
+ level
+ (concat extra-targets anchored-title))
+ contents))))))
+
+
+;;;; Horizontal Rule
+
+(defun org-odt-horizontal-rule (horizontal-rule contents info)
+ "Transcode an HORIZONTAL-RULE object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Horizontal_20_Line" ""))
+
+
+;;;; Inline Babel Call
+
+;; Inline Babel Calls are ignored.
+
+
+;;;; Inline Src Block
+
+(defun org-odt--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-odt-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (code (org-element-property :value inline-src-block))
+ (separator (org-odt--find-verb-separator code)))
+ (error "FIXME")))
+
+
+;;;; Inlinetask
+
+(defun org-odt-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (cond
+ ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it
+ ;; with appropriate arguments.
+ ((not (eq org-odt-format-inlinetask-function 'ignore))
+ (let ((format-function
+ (function*
+ (lambda (todo todo-type priority text tags
+ &key contents &allow-other-keys)
+ (funcall org-odt-format-inlinetask-function
+ todo todo-type priority text tags contents)))))
+ (org-odt-format-headline--wrap
+ inlinetask nil info format-function :contents contents)))
+ ;; Otherwise, use a default template.
+ (t
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-odt--textbox
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgInlineTaskHeading"
+ (org-odt-format-headline--wrap inlinetask nil info))
+ contents)
+ nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))))
+
+;;;; Italic
+
+(defun org-odt-italic (italic contents info)
+ "Transcode ITALIC from Org to ODT.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" contents))
+
+
+;;;; Item
+
+(defun org-odt-item (item contents info)
+ "Transcode an ITEM element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((plain-list (org-export-get-parent item))
+ (type (org-element-property :type plain-list))
+ (counter (org-element-property :counter item))
+ (tag (let ((tag (org-element-property :tag item)))
+ (and tag
+ (concat (org-odt--checkbox item)
+ (org-export-data tag info))))))
+ (case type
+ ((ordered unordered descriptive-1 descriptive-2)
+ (format "\n<text:list-item>\n%s\n%s"
+ contents
+ (let* ((--element-has-a-table-p
+ (function
+ (lambda (element info)
+ (loop for el in (org-element-contents element)
+ thereis (eq (org-element-type el) 'table))))))
+ (cond
+ ((funcall --element-has-a-table-p item info)
+ "</text:list-header>")
+ (t "</text:list-item>")))))
+ (t (error "Unknown list type: %S" type)))))
+
+;;;; Keyword
+
+(defun org-odt-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "ODT") value)
+ ((string= key "INDEX")
+ ;; FIXME
+ (ignore))
+ ((string= key "TOC")
+ (let ((value (downcase value)))
+ (cond
+ ((string-match "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "[0-9]+" value)
+ (string-to-number (match-string 0 value)))
+ (plist-get info :with-toc))))
+ (when (wholenump depth) (org-odt-toc depth info))))
+ ((member value '("tables" "figures" "listings"))
+ ;; FIXME
+ (ignore))))))))
+
+
+;;;; Latex Environment
+
+
+;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml))
+;; (defadvice org-format-latex-as-mathml ; FIXME
+;; (after org-odt-protect-latex-fragment activate)
+;; "Encode LaTeX fragment as XML.
+;; Do this when translation to MathML fails."
+;; (unless (> (length ad-return-value) 0)
+;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0)))))
+
+(defun org-odt-latex-environment (latex-environment contents info)
+ "Transcode a LATEX-ENVIRONMENT element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let* ((latex-frag (org-remove-indentation
+ (org-element-property :value latex-environment))))
+ (org-odt-do-format-code latex-frag)))
+
+
+;;;; Latex Fragment
+
+;; (when latex-frag ; FIXME
+;; (setq href (org-propertize href :title "LaTeX Fragment"
+;; :description latex-frag)))
+;; handle verbatim
+;; provide descriptions
+
+(defun org-odt-latex-fragment (latex-fragment contents info)
+ "Transcode a LATEX-FRAGMENT object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let* ((latex-frag (org-element-property :value latex-fragment))
+ (processing-type (plist-get info :with-latex)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-odt--encode-plain-text latex-frag t))))
+
+
+;;;; Line Break
+
+(defun org-odt-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "<text:line-break/>")
+
+
+;;;; Link
+
+;;;; Links :: Label references
+
+(defun org-odt--enumerate (element info &optional predicate n)
+ (when predicate (assert (funcall predicate element info)))
+ (let* ((--numbered-parent-headline-at-<=-n
+ (function
+ (lambda (element n info)
+ (loop for x in (org-export-get-genealogy element)
+ thereis (and (eq (org-element-type x) 'headline)
+ (<= (org-export-get-relative-level x info) n)
+ (org-export-numbered-headline-p x info)
+ x)))))
+ (--enumerate
+ (function
+ (lambda (element scope info &optional predicate)
+ (let ((counter 0))
+ (org-element-map (or scope (plist-get info :parse-tree))
+ (org-element-type element)
+ (lambda (el)
+ (and (or (not predicate) (funcall predicate el info))
+ (incf counter)
+ (eq element el)
+ counter))
+ info 'first-match)))))
+ (scope (funcall --numbered-parent-headline-at-<=-n
+ element (or n org-odt-display-outline-level) info))
+ (ordinal (funcall --enumerate element scope info predicate))
+ (tag
+ (concat
+ ;; Section number.
+ (and scope
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number scope info) "."))
+ ;; Separator.
+ (and scope ".")
+ ;; Ordinal.
+ (number-to-string ordinal))))
+ tag))
+
+(defun org-odt-format-label (element info op)
+ "Return a label for ELEMENT.
+
+ELEMENT is a `link', `table', `src-block' or `paragraph' type
+element. INFO is a plist used as a communication channel. OP is
+either `definition' or `reference', depending on the purpose of
+the generated string.
+
+Return value is a string if OP is set to `reference' or a cons
+cell like CAPTION . SHORT-CAPTION) where CAPTION and
+SHORT-CAPTION are strings."
+ (assert (memq (org-element-type element) '(link table src-block paragraph)))
+ (let* ((caption-from
+ (case (org-element-type element)
+ (link (org-export-get-parent-element element))
+ (t element)))
+ ;; Get label and caption.
+ (label (org-element-property :name caption-from))
+ (caption (org-export-get-caption caption-from))
+ (caption (and caption (org-export-data caption info)))
+ ;; FIXME: We don't use short-caption for now
+ (short-caption nil))
+ (when (or label caption)
+ (let* ((default-category
+ (case (org-element-type element)
+ (table "__Table__")
+ (src-block "__Listing__")
+ ((link paragraph)
+ (cond
+ ((org-odt--enumerable-latex-image-p element info)
+ "__DvipngImage__")
+ ((org-odt--enumerable-image-p element info)
+ "__Figure__")
+ ((org-odt--enumerable-formula-p element info)
+ "__MathFormula__")
+ (t (error "Don't know how to format label for link: %S"
+ element))))
+ (t (error "Don't know how to format label for element type: %s"
+ (org-element-type element)))))
+ seqno)
+ (assert default-category)
+ (destructuring-bind (counter label-style category predicate)
+ (assoc-default default-category org-odt-category-map-alist)
+ ;; Compute sequence number of the element.
+ (setq seqno (org-odt--enumerate element info predicate))
+ ;; Localize category string.
+ (setq category (org-export-translate category :utf-8 info))
+ (case op
+ ;; Case 1: Handle Label definition.
+ (definition
+ ;; Assign an internal label, if user has not provided one
+ (setq label (org-export-solidify-link-text
+ (or label (format "%s-%s" default-category seqno))))
+ (cons
+ (concat
+ ;; Sneak in a bookmark. The bookmark is used when the
+ ;; labeled element is referenced with a link that
+ ;; provides its own description.
+ (format "\n<text:bookmark text:name=\"%s\"/>" label)
+ ;; Label definition: Typically formatted as below:
+ ;; CATEGORY SEQ-NO: LONG CAPTION
+ ;; with translation for correct punctuation.
+ (format-spec
+ (org-export-translate
+ (cadr (assoc-string label-style org-odt-label-styles t))
+ :utf-8 info)
+ `((?e . ,category)
+ (?n . ,(format
+ "<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">%s</text:sequence>"
+ label counter counter seqno))
+ (?c . ,(or caption "")))))
+ short-caption))
+ ;; Case 2: Handle Label reference.
+ (reference
+ (assert label)
+ (setq label (org-export-solidify-link-text label))
+ (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
+ (fmt1 (car fmt))
+ (fmt2 (cadr fmt)))
+ (format "<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:sequence-ref>"
+ fmt1 label (format-spec fmt2 `((?e . ,category)
+ (?n . ,seqno))))))
+ (t (error "Unknown %S on label" op))))))))
+
+
+;;;; Links :: Inline Images
+
+(defun org-odt--copy-image-file (path)
+ "Returns the internal name of the file"
+ (let* ((image-type (file-name-extension path))
+ (media-type (format "image/%s" image-type))
+ (target-dir "Images/")
+ (target-file
+ (format "%s%04d.%s" target-dir
+ (incf org-odt-embedded-images-count) image-type)))
+ (message "Embedding %s as %s..."
+ (substring-no-properties path) target-file)
+
+ (when (= 1 org-odt-embedded-images-count)
+ (make-directory (concat org-odt-zip-dir target-dir))
+ (org-odt-create-manifest-file-entry "" target-dir))
+
+ (copy-file path (concat org-odt-zip-dir target-file) 'overwrite)
+ (org-odt-create-manifest-file-entry media-type target-file)
+ target-file))
+
+(defun org-odt--image-size (file &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)))))
+ (--size-in-cms
+ (function
+ (lambda (size-in-pixels dpi)
+ (and size-in-pixels
+ (cons (funcall --pixels-to-cms (car size-in-pixels) dpi)
+ (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))
+ (dpi (or dpi org-odt-pixels-per-inch))
+ (anchor-type (or embed-as "paragraph"))
+ (user-width (and (not scale) user-width))
+ (user-height (and (not scale) user-height))
+ (size
+ (and
+ (not (and user-height user-width))
+ (or
+ ;; Use Imagemagick.
+ (and (executable-find "identify")
+ (let ((size-in-pixels
+ (let ((dim (shell-command-to-string
+ (format "identify -format \"%%w:%%h\" \"%s\""
+ file))))
+ (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim)
+ (cons (string-to-number (match-string 1 dim))
+ (string-to-number (match-string 2 dim)))))))
+ (funcall --size-in-cms size-in-pixels dpi)))
+ ;; Use Emacs.
+ (let ((size-in-pixels
+ (ignore-errors ; Emacs could be in batch mode
+ (clear-image-cache)
+ (image-size (create-image file) 'pixels))))
+ (funcall --size-in-cms size-in-pixels dpi))
+ ;; Use hard-coded values.
+ (cdr (assoc-string anchor-type
+ org-odt-default-image-sizes-alist))
+ ;; Error out.
+ (error "Cannot determine image size, aborting"))))
+ (width (car size)) (height (cdr size)))
+ (cond
+ (scale
+ (setq width (* width scale) height (* height scale)))
+ ((and user-height user-width)
+ (setq width user-width height user-height))
+ (user-height
+ (setq width (* user-height (/ width height)) height user-height))
+ (user-width
+ (setq height (* user-width (/ height width)) width user-width))
+ (t (ignore)))
+ ;; ensure that an embedded image fits comfortably within a page
+ (let ((max-width (car org-odt-max-image-size))
+ (max-height (cdr org-odt-max-image-size)))
+ (when (or (> width max-width) (> height max-height))
+ (let* ((scale1 (/ max-width width))
+ (scale2 (/ max-height height))
+ (scale (min scale1 scale2)))
+ (setq width (* scale width) height (* scale height)))))
+ (cons width height)))
+
+(defun org-odt-link--inline-image (element info)
+ "Return ODT code for an inline image.
+LINK is the link pointing to the inline image. INFO is a plist
+used as a communication channel."
+ (assert (eq (org-element-type element) 'link))
+ (let* ((src (let* ((type (org-element-property :type element))
+ (raw-path (org-element-property :path element)))
+ (cond ((member type '("http" "https"))
+ (concat type ":" raw-path))
+ ((file-name-absolute-p raw-path)
+ (expand-file-name raw-path))
+ (t raw-path))))
+ (src-expanded (if (file-name-absolute-p src) src
+ (expand-file-name src (file-name-directory
+ (plist-get info :input-file)))))
+ (href (format
+ "\n<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>"
+ (org-odt--copy-image-file src-expanded)))
+ ;; Extract attributes from #+ATTR_ODT line.
+ (attr-from (case (org-element-type element)
+ (link (org-export-get-parent-element element))
+ (t element)))
+ ;; Convert attributes to a plist.
+ (attr-plist (org-export-read-attribute :attr_odt attr-from))
+ ;; Handle `:anchor', `:style' and `:attributes' properties.
+ (user-frame-anchor
+ (car (assoc-string (plist-get attr-plist :anchor)
+ '(("as-char") ("paragraph") ("page")) t)))
+ (user-frame-style
+ (and user-frame-anchor (plist-get attr-plist :style)))
+ (user-frame-attrs
+ (and user-frame-anchor (plist-get attr-plist :attributes)))
+ (user-frame-params
+ (list user-frame-style user-frame-attrs user-frame-anchor))
+ ;; (embed-as (or embed-as user-frame-anchor "paragraph"))
+ ;;
+ ;; Handle `:width', `:height' and `:scale' properties. Read
+ ;; them as numbers since we need them for computations.
+ (size (org-odt--image-size
+ src-expanded
+ (let ((width (plist-get attr-plist :width)))
+ (and width (read width)))
+ (let ((length (plist-get attr-plist :length)))
+ (and length (read length)))
+ (let ((scale (plist-get attr-plist :scale)))
+ (and scale (read scale)))
+ nil ; embed-as
+ "paragraph" ; FIXME
+ ))
+ (width (car size)) (height (cdr size))
+ (standalone-link-p (org-odt--standalone-link-p element info))
+ (embed-as (if standalone-link-p "paragraph" "as-char"))
+ (captions (org-odt-format-label element info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ (entity (concat (and caption "Captioned") embed-as "Image"))
+ ;; Check if this link was created by LaTeX-to-PNG converter.
+ (replaces (org-element-property
+ :replaces (if (not standalone-link-p) element
+ (org-export-get-parent-element element))))
+ ;; If yes, note down the type of the element - LaTeX Fragment
+ ;; or LaTeX environment. It will go in to frame title.
+ (title (and replaces (capitalize
+ (symbol-name (org-element-type replaces)))))
+
+ ;; If yes, note down its contents. It will go in to frame
+ ;; description. This quite useful for debugging.
+ (desc (and replaces (org-element-property :value replaces))))
+ (org-odt--render-image/formula entity href width height
+ captions user-frame-params title desc)))
+
+
+;;;; Links :: Math formula
+
+(defun org-odt-link--inline-formula (element info)
+ (let* ((src (let* ((type (org-element-property :type element))
+ (raw-path (org-element-property :path element)))
+ (cond
+ ((file-name-absolute-p raw-path)
+ (expand-file-name raw-path))
+ (t raw-path))))
+ (src-expanded (if (file-name-absolute-p src) src
+ (expand-file-name src (file-name-directory
+ (plist-get info :input-file)))))
+ (href
+ (format
+ "\n<draw:object %s xlink:href=\"%s\" xlink:type=\"simple\"/>"
+ " xlink:show=\"embed\" xlink:actuate=\"onLoad\""
+ (file-name-directory (org-odt--copy-formula-file src-expanded))))
+ (standalone-link-p (org-odt--standalone-link-p element info))
+ (embed-as (if standalone-link-p 'paragraph 'character))
+ (captions (org-odt-format-label element info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ ;; Check if this link was created by LaTeX-to-MathML
+ ;; converter.
+ (replaces (org-element-property
+ :replaces (if (not standalone-link-p) element
+ (org-export-get-parent-element element))))
+ ;; If yes, note down the type of the element - LaTeX Fragment
+ ;; or LaTeX environment. It will go in to frame title.
+ (title (and replaces (capitalize
+ (symbol-name (org-element-type replaces)))))
+
+ ;; If yes, note down its contents. It will go in to frame
+ ;; description. This quite useful for debugging.
+ (desc (and replaces (org-element-property :value replaces)))
+ width height)
+ (cond
+ ((eq embed-as 'character)
+ (org-odt--render-image/formula "InlineFormula" href width height
+ nil nil title desc))
+ (t
+ (let* ((equation (org-odt--render-image/formula
+ "CaptionedDisplayFormula" href width height
+ captions nil title desc))
+ (label
+ (let* ((org-odt-category-map-alist
+ '(("__MathFormula__" "Text" "math-label" "Equation"
+ org-odt--enumerable-formula-p))))
+ (car (org-odt-format-label element info 'definition)))))
+ (concat equation "<text:tab/>" label))))))
+
+(defun org-odt--copy-formula-file (src-file)
+ "Returns the internal name of the file"
+ (let* ((target-dir (format "Formula-%04d/"
+ (incf org-odt-embedded-formulas-count)))
+ (target-file (concat target-dir "content.xml")))
+ ;; Create a directory for holding formula file. Also enter it in
+ ;; to manifest.
+ (make-directory (concat org-odt-zip-dir target-dir))
+ (org-odt-create-manifest-file-entry
+ "application/vnd.oasis.opendocument.formula" target-dir "1.2")
+ ;; Copy over the formula file from user directory to zip
+ ;; directory.
+ (message "Embedding %s as %s..." src-file target-file)
+ (let ((case-fold-search nil))
+ (cond
+ ;; Case 1: Mathml.
+ ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file)
+ (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite))
+ ;; Case 2: OpenDocument formula.
+ ((string-match "\\.odf\\'" src-file)
+ (org-odt--zip-extract src-file "content.xml"
+ (concat org-odt-zip-dir target-dir)))
+ (t (error "%s is not a formula file" src-file))))
+ ;; Enter the formula file in to manifest.
+ (org-odt-create-manifest-file-entry "text/xml" target-file)
+ target-file))
+
+;;;; Targets
+
+(defun org-odt--render-image/formula (cfg-key href width height &optional
+ captions user-frame-params
+ &rest title-and-desc)
+ (let* ((frame-cfg-alist
+ ;; Each element of this alist is of the form (CFG-HANDLE
+ ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS).
+
+ ;; CFG-HANDLE is the key to the alist.
+
+ ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the
+ ;; frame params for INNER-FRAME and OUTER-FRAME
+ ;; respectively. See below.
+
+ ;; Configurations that are meant to be applied to
+ ;; non-captioned image/formula specifies no
+ ;; OUTER-FRAME-PARAMS.
+
+ ;; TERMINOLOGY
+ ;; ===========
+ ;; INNER-FRAME :: Frame that directly surrounds an
+ ;; image/formula.
+
+ ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This
+ ;; frame also contains the caption, if any.
+
+ ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME
+ ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note
+ ;; that these are the last three arguments
+ ;; to `org-odt--frame'.
+
+ ;; Note that an un-captioned image/formula requires just an
+ ;; INNER-FRAME, while a captioned image/formula requires
+ ;; both an INNER and an OUTER-FRAME.
+ '(("As-CharImage" ("OrgInlineImage" nil "as-char"))
+ ("ParagraphImage" ("OrgDisplayImage" nil "paragraph"))
+ ("PageImage" ("OrgPageImage" nil "page"))
+ ("CaptionedAs-CharImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgInlineImage" nil "as-char"))
+ ("CaptionedParagraphImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgImageCaptionFrame" nil "paragraph"))
+ ("CaptionedPageImage"
+ ("OrgCaptionedImage"
+ " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph")
+ ("OrgPageImageCaptionFrame" nil "page"))
+ ("InlineFormula" ("OrgInlineFormula" nil "as-char"))
+ ("DisplayFormula" ("OrgDisplayFormula" nil "as-char"))
+ ("CaptionedDisplayFormula"
+ ("OrgCaptionedFormula" nil "paragraph")
+ ("OrgFormulaCaptionFrame" nil "paragraph"))))
+ (caption (car captions)) (short-caption (cdr captions))
+ ;; Retrieve inner and outer frame params, from configuration.
+ (frame-cfg (assoc-string cfg-key frame-cfg-alist t))
+ (inner (nth 1 frame-cfg))
+ (outer (nth 2 frame-cfg))
+ ;; User-specified frame params (from #+ATTR_ODT spec)
+ (user user-frame-params)
+ (--merge-frame-params (function
+ (lambda (default user)
+ "Merge default and user frame params."
+ (if (not user) default
+ (assert (= (length default) 3))
+ (assert (= (length user) 3))
+ (loop for u in user
+ for d in default
+ collect (or u d)))))))
+ (cond
+ ;; Case 1: Image/Formula has no caption.
+ ;; There is only one frame, one that surrounds the image
+ ;; or formula.
+ ((not caption)
+ ;; Merge user frame params with that from configuration.
+ (setq inner (funcall --merge-frame-params inner user))
+ (apply 'org-odt--frame href width height
+ (append inner title-and-desc)))
+ ;; Case 2: Image/Formula is captioned or labeled.
+ ;; There are two frames: The inner one surrounds the
+ ;; image or formula. The outer one contains the
+ ;; caption/sequence number.
+ (t
+ ;; Merge user frame params with outer frame params.
+ (setq outer (funcall --merge-frame-params outer user))
+ ;; Short caption, if specified, goes as part of inner frame.
+ (setq inner (let ((frame-params (copy-sequence inner)))
+ (setcar (cdr frame-params)
+ (concat
+ (cadr frame-params)
+ (when short-caption
+ (format " draw:name=\"%s\" " short-caption))))
+ frame-params))
+ (apply 'org-odt--textbox
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Illustration"
+ (concat
+ (apply 'org-odt--frame href width height
+ (append inner title-and-desc))
+ caption))
+ width height outer)))))
+
+(defun org-odt--enumerable-p (element info)
+ ;; Element should have a caption or label.
+ (or (org-element-property :caption element)
+ (org-element-property :name element)))
+
+(defun org-odt--enumerable-image-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label. It SHOULD NOT be a
+ ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX
+ ;; processing.)
+ (lambda (p)
+ (and (not (org-element-property :replaces p))
+ (or (org-element-property :caption p)
+ (org-element-property :name p))))
+ ;; Link should point to an image file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-image-rules))))
+
+(defun org-odt--enumerable-latex-image-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label. It SHOULD also be a
+ ;; replacement element. (i.e., It SHOULD be a result of LaTeX
+ ;; processing.)
+ (lambda (p)
+ (and (org-element-property :replaces p)
+ (or (org-element-property :caption p)
+ (org-element-property :name p))))
+ ;; Link should point to an image file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-image-rules))))
+
+(defun org-odt--enumerable-formula-p (element info)
+ (org-odt--standalone-link-p
+ element info
+ ;; Paragraph should have a caption or label.
+ (lambda (p)
+ (or (org-element-property :caption p)
+ (org-element-property :name p)))
+ ;; Link should point to a MathML or ODF file.
+ (lambda (l)
+ (assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l org-odt-inline-formula-rules))))
+
+(defun org-odt--standalone-link-p (element info &optional
+ paragraph-predicate
+ link-predicate)
+ "Test if ELEMENT is a standalone link for the purpose ODT export.
+INFO is a plist holding contextual information.
+
+Return non-nil, if ELEMENT is of type paragraph satisfying
+PARAGRAPH-PREDICATE and its sole content, save for whitespaces,
+is a link that satisfies LINK-PREDICATE.
+
+Return non-nil, if ELEMENT is of type link satisfying
+LINK-PREDICATE and its containing paragraph satisfies
+PARAGRAPH-PREDICATE in addition to having no other content save for
+leading and trailing whitespaces.
+
+Return nil, otherwise."
+ (let ((p (case (org-element-type element)
+ (paragraph element)
+ (link (and (or (not link-predicate)
+ (funcall link-predicate element))
+ (org-export-get-parent element)))
+ (t nil))))
+ (when (and p (eq (org-element-type p) 'paragraph))
+ (when (or (not paragraph-predicate)
+ (funcall paragraph-predicate p))
+ (let ((contents (org-element-contents p)))
+ (loop for x in contents
+ with inline-image-count = 0
+ always (case (org-element-type x)
+ (plain-text
+ (not (org-string-nw-p x)))
+ (link
+ (and (or (not link-predicate)
+ (funcall link-predicate x))
+ (= (incf inline-image-count) 1)))
+ (t nil))))))))
+
+(defun org-odt-link--infer-description (destination info)
+ ;; DESTINATION is a HEADLINE, a "<<target>>" or an element (like
+ ;; paragraph, verse-block etc) to which a "#+NAME: label" can be
+ ;; attached. Note that labels that are attached to captioned
+ ;; entities - inline images, math formulae and tables - get resolved
+ ;; as part of `org-odt-format-label' and `org-odt--enumerate'.
+
+ ;; Create a cross-reference to DESTINATION but make best-efforts to
+ ;; create a *meaningful* description. Check item numbers, section
+ ;; number and section title in that order.
+
+ ;; NOTE: Counterpart of `org-export-get-ordinal'.
+ ;; FIXME: Handle footnote-definition footnote-reference?
+ (let* ((genealogy (org-export-get-genealogy destination))
+ (data (reverse genealogy))
+ (label (case (org-element-type destination)
+ (headline
+ (format "sec-%s" (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ destination info) "-")))
+ (target
+ (org-element-property :value destination))
+ (t (error "FIXME: Resolve %S" destination)))))
+ (or
+ (let* ( ;; Locate top-level list.
+ (top-level-list
+ (loop for x on data
+ when (eq (org-element-type (car x)) 'plain-list)
+ return x))
+ ;; Get list item nos.
+ (item-numbers
+ (loop for (plain-list item . rest) on top-level-list by #'cddr
+ until (not (eq (org-element-type plain-list) 'plain-list))
+ collect (when (eq (org-element-property :type
+ plain-list)
+ 'ordered)
+ (1+ (length (org-export-get-previous-element
+ item info t))))))
+ ;; Locate top-most listified headline.
+ (listified-headlines
+ (loop for x on data
+ when (and (eq (org-element-type (car x)) 'headline)
+ (org-export-low-level-p (car x) info))
+ return x))
+ ;; Get listified headline numbers.
+ (listified-headline-nos
+ (loop for el in listified-headlines
+ when (eq (org-element-type el) 'headline)
+ collect (when (org-export-numbered-headline-p el info)
+ (1+ (length (org-export-get-previous-element
+ el info t)))))))
+ ;; Combine item numbers from both the listified headlines and
+ ;; regular list items.
+
+ ;; Case 1: Check if all the parents of list item are numbered.
+ ;; If yes, link to the item proper.
+ (let ((item-numbers (append listified-headline-nos item-numbers)))
+ (when (and item-numbers (not (memq nil item-numbers)))
+ (format "<text:bookmark-ref text:reference-format=\"number-all-superior\" text:ref-name=\"%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (mapconcat (lambda (n) (if (not n) " "
+ (concat (number-to-string n) ".")))
+ item-numbers "")))))
+ ;; Case 2: Locate a regular and numbered headline in the
+ ;; hierarchy. Display its section number.
+ (let ((headline (loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info))
+ (org-export-numbered-headline-p el info))
+ return el)))
+ ;; We found one.
+ (when headline
+ (format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (mapconcat 'number-to-string (org-export-get-headline-number
+ headline info) "."))))
+ ;; Case 4: Locate a regular headline in the hierarchy. Display
+ ;; its title.
+ (let ((headline (loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info)))
+ return el)))
+ ;; We found one.
+ (when headline
+ (format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text label)
+ (let ((title (org-element-property :title headline)))
+ (org-export-data title info)))))
+ (error "FIXME?"))))
+
+(defun org-odt-link (link desc info)
+ "Transcode a LINK object from Org to ODT.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (imagep (org-export-inline-image-p
+ link org-odt-inline-image-rules))
+ (path (cond
+ ((member type '("http" "https" "ftp" "mailto"))
+ (concat type ":" raw-path))
+ ((and (string= type "file") (file-name-absolute-p raw-path))
+ (concat "file:" raw-path))
+ (t raw-path)))
+ ;; Convert & to &amp; for correct XML representation
+ (path (replace-regexp-in-string "&" "&amp;" path))
+ protocol)
+ (cond
+ ;; Image file.
+ ((and (not desc) (org-export-inline-image-p
+ link org-odt-inline-image-rules))
+ (org-odt-link--inline-image link info))
+ ;; Formula file.
+ ((and (not desc) (org-export-inline-image-p
+ link org-odt-inline-formula-rules))
+ (org-odt-link--inline-formula link info))
+ ;; Radio target: Transcode target's contents and use them as
+ ;; link's description.
+ ((string= type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) desc
+ (format
+ "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ (org-export-solidify-link-text
+ (org-element-property :value destination))
+ desc))))
+ ;; Links pointing to a headline: Find destination and build
+ ;; appropriate referencing command.
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ;; Case 1: Fuzzy link points nowhere.
+ ('nil
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis"
+ (or desc
+ (org-export-data (org-element-property :raw-link link)
+ info))))
+ ;; Case 2: Fuzzy link points to a headline.
+ (headline
+ ;; If there's a description, create a hyperlink.
+ ;; Otherwise, try to provide a meaningful description.
+ (if (not desc) (org-odt-link--infer-description destination info)
+ (let* ((headline-no
+ (org-export-get-headline-number destination info))
+ (label
+ (format "sec-%s"
+ (mapconcat 'number-to-string headline-no "-"))))
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ label desc))))
+ ;; Case 3: Fuzzy link points to a target.
+ (target
+ ;; If there's a description, create a hyperlink.
+ ;; Otherwise, try to provide a meaningful description.
+ (if (not desc) (org-odt-link--infer-description destination info)
+ (let ((label (org-element-property :value destination)))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-solidify-link-text label)
+ desc))))
+ ;; Case 4: Fuzzy link points to some element (e.g., an
+ ;; inline image, a math formula or a table).
+ (otherwise
+ (let ((label-reference
+ (ignore-errors (org-odt-format-label
+ destination info 'reference))))
+ (cond ((not label-reference)
+ (org-odt-link--infer-description destination info))
+ ;; LINK has no description. Create
+ ;; a cross-reference showing entity's sequence
+ ;; number.
+ ((not desc) label-reference)
+ ;; LINK has description. Insert a hyperlink with
+ ;; user-provided description.
+ (t
+ (let ((label (org-element-property :name destination)))
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-solidify-link-text label)
+ desc)))))))))
+ ;; Coderef: replace link with the reference name or the
+ ;; equivalent line number.
+ ((string= type "coderef")
+ (let* ((line-no (format "%d" (org-export-resolve-coderef path info)))
+ (href (concat "coderef-" path)))
+ (format
+ (org-export-get-coderef-format path desc)
+ (format
+ "<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
+ href line-no))))
+ ;; Link type is handled by a special function.
+ ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
+ (funcall protocol (org-link-unescape path) desc 'odt))
+ ;; External link with a description part.
+ ((and path desc)
+ (let ((link-contents (org-element-contents link)))
+ ;; Check if description is a link to an inline image.
+ (if (and (not (cdr link-contents))
+ (let ((desc-element (car link-contents)))
+ (and (eq (org-element-type desc-element) 'link)
+ (org-export-inline-image-p
+ desc-element org-odt-inline-image-rules))))
+ ;; Format link as a clickable image.
+ (format "\n<draw:a xlink:type=\"simple\" xlink:href=\"%s\">\n%s\n</draw:a>"
+ path desc)
+ ;; Otherwise, format it as a regular link.
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ path desc))))
+ ;; External link without a description part.
+ (path
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"%s\">%s</text:a>"
+ path path))
+ ;; No path, only description. Try to do something useful.
+ (t (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Emphasis" desc)))))
+
+
+;;;; Paragraph
+
+(defun org-odt--paragraph-style (paragraph)
+ "Return style of PARAGRAPH.
+Style is a symbol among `quoted', `centered' and nil."
+ (let ((up paragraph))
+ (while (and (setq up (org-element-property :parent up))
+ (not (memq (org-element-type up)
+ '(center-block quote-block section)))))
+ (case (org-element-type up)
+ (center-block 'centered)
+ (quote-block 'quoted))))
+
+(defun org-odt--format-paragraph (paragraph contents info default center quote)
+ "Format paragraph according to given styles.
+PARAGRAPH is a paragraph type element. CONTENTS is the
+transcoded contents of that paragraph, as a string. INFO is
+a plist used as a communication channel. DEFAULT, CENTER and
+QUOTE are, respectively, style to use when paragraph belongs to
+no special environment, a center block, or a quote block."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (case (org-odt--paragraph-style paragraph)
+ (quoted quote)
+ (centered center)
+ (otherwise default))
+ ;; If PARAGRAPH is a leading paragraph in an item that has
+ ;; a checkbox, splice checkbox and paragraph contents
+ ;; together.
+ (concat (let ((parent (org-element-property :parent paragraph)))
+ (and (eq (org-element-type parent) 'item)
+ (not (org-export-get-previous-element paragraph info))
+ (org-odt--checkbox parent)))
+ contents)))
+
+(defun org-odt-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to ODT.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ (org-odt--format-paragraph
+ paragraph contents info
+ (or (org-element-property :style paragraph) "Text_20_body")
+ "OrgCenter"
+ "Quotations"))
+
+
+;;;; Plain List
+
+(defun org-odt-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to ODT.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>"
+ ;; Choose style based on list type.
+ (case (org-element-property :type plain-list)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "OrgDescriptionList"))
+ ;; If top-level list, re-start numbering. Otherwise,
+ ;; continue numbering.
+ (format "text:continue-numbering=\"%s\""
+ (let* ((parent (org-export-get-parent plain-list)))
+ (if (and parent (eq (org-element-type parent) 'item))
+ "true" "false")))
+ contents))
+
+;;;; Plain Text
+
+(defun org-odt--encode-tabs-and-spaces (line)
+ (replace-regexp-in-string
+ "\\([\t]\\|\\([ ]+\\)\\)"
+ (lambda (s)
+ (cond
+ ((string= s "\t") "<text:tab/>")
+ (t (let ((n (length s)))
+ (cond
+ ((= n 1) " ")
+ ((> n 1) (concat " " (format "<text:s text:c=\"%d\"/>" (1- n))))
+ (t ""))))))
+ line))
+
+(defun org-odt--encode-plain-text (text &optional no-whitespace-filling)
+ (mapc
+ (lambda (pair)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
+ '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (if no-whitespace-filling text
+ (org-odt--encode-tabs-and-spaces text)))
+
+(defun org-odt-plain-text (text info)
+ "Transcode a TEXT string from Org to ODT.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (let ((output text))
+ ;; Protect &, < and >.
+ (setq output (org-odt--encode-plain-text output t))
+ ;; Handle smart quotes. Be sure to provide original string since
+ ;; OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (mapc
+ (lambda (pair)
+ (setq output
+ (replace-regexp-in-string (car pair) (cdr pair) output t nil)))
+ org-odt-special-string-regexps))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" "<text:line-break/>" output t)))
+ ;; Return value.
+ output))
+
+
+;;;; Planning
+
+(defun org-odt-planning (planning contents info)
+ "Transcode a PLANNING element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgPlanning"
+ (concat
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgClosedKeyword" org-closed-string)
+ (org-odt-timestamp closed contents info))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgDeadlineKeyword" org-deadline-string)
+ (org-odt-timestamp deadline contents info))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgScheduledKeyword" org-deadline-string)
+ (org-odt-timestamp scheduled contents info)))))))
+
+
+;;;; Property Drawer
+
+(defun org-odt-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+
+;;;; Quote Block
+
+(defun org-odt-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+
+;;;; Quote Section
+
+(defun org-odt-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (org-odt-do-format-code value))))
+
+
+;;;; Section
+
+(defun org-odt-format-section (text style &optional name)
+ (let ((default-name (car (org-odt-add-automatic-style "Section"))))
+ (format "\n<text:section text:style-name=\"%s\" %s>\n%s\n</text:section>"
+ style
+ (format "text:name=\"%s\"" (or name default-name))
+ text)))
+
+
+(defun org-odt-section (section contents info) ; FIXME
+ "Transcode a SECTION element from Org to ODT.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ contents)
+
+;;;; Radio Target
+
+(defun org-odt-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to ODT.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (org-odt--target
+ text (org-export-solidify-link-text
+ (org-element-property :value radio-target))))
+
+
+;;;; Special Block
+
+(defun org-odt-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((type (downcase (org-element-property :type special-block)))
+ (attributes (org-export-read-attribute :attr_odt special-block)))
+ (cond
+ ;; Annotation.
+ ((string= type "annotation")
+ (let* ((author (or (plist-get attributes :author)
+ (let ((author (plist-get info :author)))
+ (and author (org-export-data author info)))))
+ (date (or (plist-get attributes :date)
+ ;; FIXME: Is `car' right thing to do below?
+ (car (plist-get info :date)))))
+ (format "\n<text:p>%s</text:p>"
+ (format "<office:annotation>\n%s\n</office:annotation>"
+ (concat
+ (and author
+ (format "<dc:creator>%s</dc:creator>" author))
+ (and date
+ (format "<dc:date>%s</dc:date>"
+ (org-odt--format-timestamp date nil 'iso-date)))
+ contents)))))
+ ;; Textbox.
+ ((string= type "textbox")
+ (let ((width (plist-get attributes :width))
+ (height (plist-get attributes :height))
+ (style (plist-get attributes :style))
+ (extra (plist-get attributes :extra))
+ (anchor (plist-get attributes :anchor)))
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body" (org-odt--textbox contents width height
+ style extra anchor))))
+ (t contents))))
+
+
+;;;; Src Block
+
+(defun org-odt-hfy-face-to-css (fn)
+ "Create custom style for face FN.
+When FN is the default face, use its foreground and background
+properties to create \"OrgSrcBlock\" paragraph style. Otherwise
+use its color attribute to create a character style whose name
+is obtained from FN. Currently all attributes of FN other than
+color are ignored.
+
+The style name for a face FN is derived using the following
+operations on the face name in that order - de-dash, CamelCase
+and prefix with \"OrgSrc\". For example,
+`font-lock-function-name-face' is associated with
+\"OrgSrcFontLockFunctionNameFace\"."
+ (let* ((css-list (hfy-face-to-style fn))
+ (style-name (concat "OrgSrc"
+ (mapconcat
+ 'capitalize (split-string
+ (hfy-face-or-def-to-name fn) "-")
+ "")))
+ (color-val (cdr (assoc "color" css-list)))
+ (background-color-val (cdr (assoc "background" css-list)))
+ (style (and org-odt-create-custom-styles-for-srcblocks
+ (cond
+ ((eq fn 'default)
+ (format org-odt-src-block-paragraph-format
+ background-color-val color-val))
+ (t
+ (format
+ "
+<style:style style:name=\"%s\" style:family=\"text\">
+ <style:text-properties fo:color=\"%s\"/>
+ </style:style>" style-name color-val))))))
+ (cons style-name style)))
+
+(defun org-odt-htmlfontify-string (line)
+ (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (hfy-html-quote-map '(("\"" "&quot;")
+ ("<" "&lt;")
+ ("&" "&amp;")
+ (">" "&gt;")
+ (" " "<text:s/>")
+ (" " "<text:tab/>")))
+ (hfy-face-to-css 'org-odt-hfy-face-to-css)
+ (hfy-optimizations-1 (copy-sequence hfy-optimizations))
+ (hfy-optimizations (add-to-list 'hfy-optimizations-1
+ 'body-text-only))
+ (hfy-begin-span-handler
+ (lambda (style text-block text-id text-begins-block-p)
+ (insert (format "<text:span text:style-name=\"%s\">" style))))
+ (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
+ (org-no-warnings (htmlfontify-string line))))
+
+(defun org-odt-do-format-code
+ (code &optional lang refs retain-labels num-start)
+ (let* ((lang (or (assoc-default lang org-src-lang-modes) lang))
+ (lang-mode (and lang (intern (format "%s-mode" lang))))
+ (code-lines (org-split-string code "\n"))
+ (code-length (length code-lines))
+ (use-htmlfontify-p (and (functionp lang-mode)
+ org-odt-fontify-srcblocks
+ (require 'htmlfontify nil t)
+ (fboundp 'htmlfontify-string)))
+ (code (if (not use-htmlfontify-p) code
+ (with-temp-buffer
+ (insert code)
+ (funcall lang-mode)
+ (org-font-lock-ensure)
+ (buffer-string))))
+ (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string
+ 'org-odt--encode-plain-text))
+ (par-style (if use-htmlfontify-p "OrgSrcBlock"
+ "OrgFixedWidthBlock"))
+ (i 0))
+ (assert (= code-length (length (org-split-string code "\n"))))
+ (setq code
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (setq par-style
+ (concat par-style (and (= (incf i) code-length) "LastLine")))
+
+ (setq loc (concat loc (and ref retain-labels (format " (%s)" ref))))
+ (setq loc (funcall fontifier loc))
+ (when ref
+ (setq loc (org-odt--target loc (concat "coderef-" ref))))
+ (assert par-style)
+ (setq loc (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ par-style loc))
+ (if (not line-num) loc
+ (format "\n<text:list-item>%s\n</text:list-item>" loc)))
+ num-start refs))
+ (cond
+ ((not num-start) code)
+ ((= num-start 0)
+ (format
+ "\n<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>%s</text:list>"
+ " text:continue-numbering=\"false\"" code))
+ (t
+ (format
+ "\n<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>%s</text:list>"
+ " text:continue-numbering=\"true\"" code)))))
+
+(defun org-odt-format-code (element info)
+ (let* ((lang (org-element-property :language element))
+ ;; Extract code and references.
+ (code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (refs (cdr code-info))
+ ;; Does the src block contain labels?
+ (retain-labels (org-element-property :retain-labels element))
+ ;; Does it have line numbers?
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0))))
+ (org-odt-do-format-code code lang refs retain-labels num-start)))
+
+(defun org-odt-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to ODT.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((lang (org-element-property :language src-block))
+ (attributes (org-export-read-attribute :attr_odt src-block))
+ (captions (org-odt-format-label src-block info 'definition))
+ (caption (car captions)) (short-caption (cdr captions)))
+ (concat
+ (and caption
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Listing" caption))
+ (let ((--src-block (org-odt-format-code src-block info)))
+ (if (not (plist-get attributes :textbox)) --src-block
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-odt--textbox --src-block nil nil nil)))))))
+
+
+;;;; Statistics Cookie
+
+(defun org-odt-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((cookie-value (org-element-property :value statistics-cookie)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" cookie-value)))
+
+
+;;;; Strike-Through
+
+(defun org-odt-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to ODT.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Strikethrough" contents))
+
+
+;;;; Subscript
+
+(defun org-odt-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to ODT.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSubscript" contents))
+
+
+;;;; Superscript
+
+(defun org-odt-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to ODT.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript" contents))
+
+
+;;;; Table Cell
+
+(defun org-odt-table-style-spec (element info)
+ (let* ((table (org-export-get-parent-table element))
+ (table-attributes (org-export-read-attribute :attr_odt table))
+ (table-style (plist-get table-attributes :style)))
+ (assoc table-style org-odt-table-styles)))
+
+(defun org-odt-get-table-cell-styles (table-cell info)
+ "Retrieve styles applicable to a table cell.
+R and C are (zero-based) row and column numbers of the table
+cell. STYLE-SPEC is an entry in `org-odt-table-styles'
+applicable to the current table. It is nil if the table is not
+associated with any style attributes.
+
+Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME).
+
+When STYLE-SPEC is nil, style the table cell the conventional way
+- choose cell borders based on row and column groupings and
+choose paragraph alignment based on `org-col-cookies' text
+property. See also
+`org-odt-get-paragraph-style-cookie-for-table-cell'.
+
+When STYLE-SPEC is non-nil, ignore the above cookie and return
+styles congruent with the ODF-1.2 specification."
+ (let* ((table-cell-address (org-export-table-cell-address table-cell info))
+ (r (car table-cell-address)) (c (cdr table-cell-address))
+ (style-spec (org-odt-table-style-spec table-cell info))
+ (table-dimensions (org-export-table-dimensions
+ (org-export-get-parent-table table-cell)
+ info)))
+ (when style-spec
+ ;; LibreOffice - particularly the Writer - honors neither table
+ ;; templates nor custom table-cell styles. Inorder to retain
+ ;; inter-operability with LibreOffice, only automatic styles are
+ ;; used for styling of table-cells. The current implementation is
+ ;; congruent with ODF-1.2 specification and hence is
+ ;; future-compatible.
+
+ ;; Additional Note: LibreOffice's AutoFormat facility for tables -
+ ;; which recognizes as many as 16 different cell types - is much
+ ;; richer. Unfortunately it is NOT amenable to easy configuration
+ ;; by hand.
+ (let* ((template-name (nth 1 style-spec))
+ (cell-style-selectors (nth 2 style-spec))
+ (cell-type
+ (cond
+ ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ (= c 0)) "FirstColumn")
+ ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ (= (1+ c) (cdr table-dimensions)))
+ "LastColumn")
+ ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ (= r 0)) "FirstRow")
+ ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ (= (1+ r) (car table-dimensions)))
+ "LastRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 1)) "EvenRow")
+ ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ (= (% r 2) 0)) "OddRow")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 1)) "EvenColumn")
+ ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ (= (% c 2) 0)) "OddColumn")
+ (t ""))))
+ (concat template-name cell-type)))))
+
+(defun org-odt-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((table-cell-address (org-export-table-cell-address table-cell info))
+ (r (car table-cell-address))
+ (c (cdr table-cell-address))
+ (horiz-span (or (org-export-table-cell-width table-cell info) 0))
+ (table-row (org-export-get-parent table-cell))
+ (custom-style-prefix (org-odt-get-table-cell-styles
+ table-cell info))
+ (paragraph-style
+ (or
+ (and custom-style-prefix
+ (format "%sTableParagraph" custom-style-prefix))
+ (concat
+ (cond
+ ((and (= 1 (org-export-table-row-group table-row info))
+ (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info))
+ "OrgTableHeading")
+ ((let* ((table (org-export-get-parent-table table-cell))
+ (table-attrs (org-export-read-attribute :attr_odt table))
+ (table-header-columns
+ (let ((cols (plist-get table-attrs :header-columns)))
+ (and cols (read cols)))))
+ (<= c (cond ((wholenump table-header-columns)
+ (- table-header-columns 1))
+ (table-header-columns 0)
+ (t -1))))
+ "OrgTableHeading")
+ (t "OrgTableContents"))
+ (capitalize (symbol-name (org-export-table-cell-alignment
+ table-cell info))))))
+ (cell-style-name
+ (or
+ (and custom-style-prefix (format "%sTableCell"
+ custom-style-prefix))
+ (concat
+ "OrgTblCell"
+ (when (or (org-export-table-row-starts-rowgroup-p table-row info)
+ (zerop r)) "T")
+ (when (org-export-table-row-ends-rowgroup-p table-row info) "B")
+ (when (and (org-export-table-cell-starts-colgroup-p table-cell info)
+ (not (zerop c)) ) "L"))))
+ (cell-attributes
+ (concat
+ (format " table:style-name=\"%s\"" cell-style-name)
+ (and (> horiz-span 0)
+ (format " table:number-columns-spanned=\"%d\""
+ (1+ horiz-span))))))
+ (unless contents (setq contents ""))
+ (concat
+ (assert paragraph-style)
+ (format "\n<table:table-cell%s>\n%s\n</table:table-cell>"
+ cell-attributes
+ (let ((table-cell-contents (org-element-contents table-cell)))
+ (if (memq (org-element-type (car table-cell-contents))
+ org-element-all-elements)
+ contents
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ paragraph-style contents))))
+ (let (s)
+ (dotimes (i horiz-span s)
+ (setq s (concat s "\n<table:covered-table-cell/>"))))
+ "\n")))
+
+
+;;;; Table Row
+
+(defun org-odt-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to ODT.
+CONTENTS is the contents of the row. INFO is a plist used as a
+communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((rowgroup-tags
+ (if (and (= 1 (org-export-table-row-group table-row info))
+ (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info))
+ ;; If the row belongs to the first rowgroup and the
+ ;; table has more than one row groups, then this row
+ ;; belongs to the header row group.
+ '("\n<table:table-header-rows>" . "\n</table:table-header-rows>")
+ ;; Otherwise, it belongs to non-header row group.
+ '("\n<table:table-rows>" . "\n</table:table-rows>"))))
+ (concat
+ ;; Does this row begin a rowgroup?
+ (when (org-export-table-row-starts-rowgroup-p table-row info)
+ (car rowgroup-tags))
+ ;; Actual table row
+ (format "\n<table:table-row>\n%s\n</table:table-row>" contents)
+ ;; Does this row end a rowgroup?
+ (when (org-export-table-row-ends-rowgroup-p table-row info)
+ (cdr rowgroup-tags))))))
+
+
+;;;; Table
+
+(defun org-odt-table-first-row-data-cells (table info)
+ (let ((table-row
+ (org-element-map table 'table-row
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule) row))
+ info 'first-match))
+ (special-column-p (org-export-table-has-special-column-p table)))
+ (if (not special-column-p) (org-element-contents table-row)
+ (cdr (org-element-contents table-row)))))
+
+(defun org-odt--table (table contents info)
+ "Transcode a TABLE element from Org to ODT.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (case (org-element-property :type table)
+ ;; Case 1: table.el doesn't support export to OD format. Strip
+ ;; such tables from export.
+ (table.el
+ (prog1 nil
+ (message
+ (concat
+ "(ox-odt): Found table.el-type table in the source Org file."
+ " table.el doesn't support export to ODT format."
+ " Stripping the table from export."))))
+ ;; Case 2: Native Org tables.
+ (otherwise
+ (let* ((captions (org-odt-format-label table info 'definition))
+ (caption (car captions)) (short-caption (cdr captions))
+ (attributes (org-export-read-attribute :attr_odt table))
+ (custom-table-style (nth 1 (org-odt-table-style-spec table info)))
+ (table-column-specs
+ (function
+ (lambda (table info)
+ (let* ((table-style (or custom-table-style "OrgTable"))
+ (column-style (format "%sColumn" table-style)))
+ (mapconcat
+ (lambda (table-cell)
+ (let ((width (1+ (or (org-export-table-cell-width
+ table-cell info) 0)))
+ (s (format
+ "\n<table:table-column table:style-name=\"%s\"/>"
+ column-style))
+ out)
+ (dotimes (i width out) (setq out (concat s out)))))
+ (org-odt-table-first-row-data-cells table info) "\n"))))))
+ (concat
+ ;; caption.
+ (when caption
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Table" caption))
+ ;; begin table.
+ (let* ((automatic-name
+ (org-odt-add-automatic-style "Table" attributes)))
+ (format
+ "\n<table:table table:style-name=\"%s\"%s>"
+ (or custom-table-style (cdr automatic-name) "OrgTable")
+ (concat (when short-caption
+ (format " table:name=\"%s\"" short-caption)))))
+ ;; column specification.
+ (funcall table-column-specs table info)
+ ;; actual contents.
+ "\n" contents
+ ;; end table.
+ "</table:table>")))))
+
+(defun org-odt-table (table contents info)
+ "Transcode a TABLE element from Org to ODT.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information.
+
+Use `org-odt--table' to typeset the table. Handle details
+pertaining to indentation here."
+ (let* ((--element-preceded-by-table-p
+ (function
+ (lambda (element info)
+ (loop for el in (org-export-get-previous-element element info t)
+ thereis (eq (org-element-type el) 'table)))))
+ (--walk-list-genealogy-and-collect-tags
+ (function
+ (lambda (table info)
+ (let* ((genealogy (org-export-get-genealogy table))
+ (list-genealogy
+ (when (eq (org-element-type (car genealogy)) 'item)
+ (loop for el in genealogy
+ when (memq (org-element-type el)
+ '(item plain-list))
+ collect el)))
+ (llh-genealogy
+ (apply 'nconc
+ (loop for el in genealogy
+ when (and (eq (org-element-type el) 'headline)
+ (org-export-low-level-p el info))
+ collect
+ (list el
+ (assq 'headline
+ (org-element-contents
+ (org-export-get-parent el)))))))
+ parent-list)
+ (nconc
+ ;; Handle list genealogy.
+ (loop for el in list-genealogy collect
+ (case (org-element-type el)
+ (plain-list
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (case (org-element-property :type el)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "OrgDescriptionList"))
+ "text:continue-numbering=\"true\"")))
+ (item
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((funcall --element-preceded-by-table-p
+ parent-list info)
+ '("</text:list-header>" . "<text:list-header>"))
+ (t '("</text:list-item>" . "<text:list-item>"))))))
+ ;; Handle low-level headlines.
+ (loop for el in llh-genealogy
+ with step = 'item collect
+ (case step
+ (plain-list
+ (setq step 'item) ; Flip-flop
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (if (org-export-numbered-headline-p
+ el info)
+ "OrgNumberedList"
+ "OrgBulletedList")
+ "text:continue-numbering=\"true\"")))
+ (item
+ (setq step 'plain-list) ; Flip-flop
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((let ((section? (org-export-get-previous-element
+ parent-list info)))
+ (and section?
+ (eq (org-element-type section?) 'section)
+ (assq 'table (org-element-contents section?))))
+ '("</text:list-header>" . "<text:list-header>"))
+ (t
+ '("</text:list-item>" . "<text:list-item>")))))))))))
+ (close-open-tags (funcall --walk-list-genealogy-and-collect-tags
+ table info)))
+ ;; OpenDocument schema does not permit table to occur within a
+ ;; list item.
+
+ ;; One solution - the easiest and lightweight, in terms of
+ ;; implementation - is to put the table in an indented text box
+ ;; and make the text box part of the list-item. Unfortunately if
+ ;; the table is big and spans multiple pages, the text box could
+ ;; overflow. In this case, the following attribute will come
+ ;; handy.
+
+ ;; ,---- From OpenDocument-v1.1.pdf
+ ;; | 15.27.28 Overflow behavior
+ ;; |
+ ;; | For text boxes contained within text document, the
+ ;; | style:overflow-behavior property specifies the behavior of text
+ ;; | boxes where the containing text does not fit into the text
+ ;; | box.
+ ;; |
+ ;; | If the attribute's value is clip, the text that does not fit
+ ;; | into the text box is not displayed.
+ ;; |
+ ;; | If the attribute value is auto-create-new-frame, a new frame
+ ;; | will be created on the next page, with the same position and
+ ;; | dimensions of the original frame.
+ ;; |
+ ;; | If the style:overflow-behavior property's value is
+ ;; | auto-create-new-frame and the text box has a minimum width or
+ ;; | height specified, then the text box will grow until the page
+ ;; | bounds are reached before a new frame is created.
+ ;; `----
+
+ ;; Unfortunately, LibreOffice-3.4.6 doesn't honor
+ ;; auto-create-new-frame property and always resorts to clipping
+ ;; the text box. This results in table being truncated.
+
+ ;; So we solve the problem the hard (and fun) way using list
+ ;; continuations.
+
+ ;; The problem only becomes more interesting if you take in to
+ ;; account the following facts:
+ ;;
+ ;; - Description lists are simulated as plain lists.
+ ;; - Low-level headlines can be listified.
+ ;; - In Org-mode, a table can occur not only as a regular list
+ ;; item, but also within description lists and low-level
+ ;; headlines.
+
+ ;; See `org-odt-translate-description-lists' and
+ ;; `org-odt-translate-low-level-headlines' for how this is
+ ;; tackled.
+
+ (concat "\n"
+ ;; Discontinue the list.
+ (mapconcat 'car close-open-tags "\n")
+ ;; Put the table in an indented section.
+ (let* ((table (org-odt--table table contents info))
+ (level (/ (length (mapcar 'car close-open-tags)) 2))
+ (style (format "OrgIndentedSection-Level-%d" level)))
+ (when table (org-odt-format-section table style)))
+ ;; Continue the list.
+ (mapconcat 'cdr (nreverse close-open-tags) "\n"))))
+
+
+;;;; Target
+
+(defun org-odt-target (target contents info)
+ "Transcode a TARGET object from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-element-property :value target)))
+ (org-odt--target "" (org-export-solidify-link-text value))))
+
+
+;;;; Timestamp
+
+(defun org-odt-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((raw-value (org-element-property :raw-value timestamp))
+ (type (org-element-property :type timestamp)))
+ (if (not org-odt-use-date-fields)
+ (let ((value (org-odt-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp" value))
+ ((inactive inactive-range)
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp" value))
+ (otherwise value)))
+ (case type
+ (active
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp"
+ (format "&lt;%s&gt;" (org-odt--format-timestamp timestamp))))
+ (inactive
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp"
+ (format "[%s]" (org-odt--format-timestamp timestamp))))
+ (active-range
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgActiveTimestamp"
+ (format "&lt;%s&gt;&#x2013;&lt;%s&gt;"
+ (org-odt--format-timestamp timestamp)
+ (org-odt--format-timestamp timestamp 'end))))
+ (inactive-range
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgInactiveTimestamp"
+ (format "[%s]&#x2013;[%s]"
+ (org-odt--format-timestamp timestamp)
+ (org-odt--format-timestamp timestamp 'end))))
+ (otherwise
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgDiaryTimestamp"
+ (org-odt-plain-text (org-timestamp-translate timestamp)
+ info)))))))
+
+
+;;;; Underline
+
+(defun org-odt-underline (underline contents info)
+ "Transcode UNDERLINE from Org to ODT.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "Underline" contents))
+
+
+;;;; Verbatim
+
+(defun org-odt-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to ODT.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (format "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgCode" (org-odt--encode-plain-text
+ (org-element-property :value verbatim))))
+
+
+;;;; Verse Block
+
+(defun org-odt-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to ODT.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ ;; Add line breaks to each line of verse.
+ (setq contents (replace-regexp-in-string
+ "\\(<text:line-break/>\\)?[ \t]*\n"
+ "<text:line-break/>" contents))
+ ;; Replace tabs and spaces.
+ (setq contents (org-odt--encode-tabs-and-spaces contents))
+ ;; Surround it in a verse environment.
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgVerse" contents))
+
+
+
+;;; Filters
+
+;;;; LaTeX fragments
+
+(defun org-odt--translate-latex-fragments (tree backend info)
+ (let ((processing-type (plist-get info :with-latex))
+ (count 0))
+ ;; Normalize processing-type to one of dvipng, mathml or verbatim.
+ ;; If the desired converter is not available, force verbatim
+ ;; processing.
+ (case processing-type
+ ((t mathml)
+ (if (and (fboundp 'org-format-latex-mathml-available-p)
+ (org-format-latex-mathml-available-p))
+ (setq processing-type 'mathml)
+ (message "LaTeX to MathML converter not available.")
+ (setq processing-type 'verbatim)))
+ ((dvipng imagemagick)
+ (unless (and (org-check-external-command "latex" "" t)
+ (org-check-external-command
+ (if (eq processing-type 'dvipng) "dvipng" "convert") "" t))
+ (message "LaTeX to PNG converter not available.")
+ (setq processing-type 'verbatim)))
+ (otherwise
+ (message "Unknown LaTeX option. Forcing verbatim.")
+ (setq processing-type 'verbatim)))
+
+ ;; Store normalized value for later use.
+ (when (plist-get info :with-latex)
+ (plist-put info :with-latex processing-type))
+ (message "Formatting LaTeX using %s" processing-type)
+
+ ;; Convert `latex-fragment's and `latex-environment's.
+ (when (memq processing-type '(mathml dvipng imagemagick))
+ (org-element-map tree '(latex-fragment latex-environment)
+ (lambda (latex-*)
+ (incf count)
+ (let* ((latex-frag (org-element-property :value latex-*))
+ (input-file (plist-get info :input-file))
+ (cache-dir (file-name-directory input-file))
+ (cache-subdir (concat
+ (case processing-type
+ ((dvipng imagemagick) "ltxpng/")
+ (mathml "ltxmathml/"))
+ (file-name-sans-extension
+ (file-name-nondirectory input-file))))
+ (display-msg
+ (case processing-type
+ ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count))
+ (mathml (format "Creating MathML snippet %d..." count))))
+ ;; Get an Org-style link to PNG image or the MathML
+ ;; file.
+ (org-link
+ (let ((link (with-temp-buffer
+ (insert latex-frag)
+ (org-format-latex cache-subdir cache-dir
+ nil display-msg
+ nil nil processing-type)
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (if (not (string-match "file:\\([^]]*\\)" link))
+ (prog1 nil (message "LaTeX Conversion failed."))
+ link))))
+ (when org-link
+ ;; Conversion succeeded. Parse above Org-style link to a
+ ;; `link' object.
+ (let* ((link (car (org-element-map (with-temp-buffer
+ (org-mode)
+ (insert org-link)
+ (org-element-parse-buffer))
+ 'link 'identity))))
+ ;; Orphan the link.
+ (org-element-put-property link :parent nil)
+ (let* (
+ (replacement
+ (case (org-element-type latex-*)
+ ;; Case 1: LaTeX environment.
+ ;; Mimic a "standalone image or formula" by
+ ;; enclosing the `link' in a `paragraph'.
+ ;; Copy over original attributes, captions to
+ ;; the enclosing paragraph.
+ (latex-environment
+ (org-element-adopt-elements
+ (list 'paragraph
+ (list :style "OrgFormula"
+ :name (org-element-property :name
+ latex-*)
+ :caption (org-element-property :caption
+ latex-*)))
+ link))
+ ;; Case 2: LaTeX fragment.
+ ;; No special action.
+ (latex-fragment link))))
+ ;; Note down the object that link replaces.
+ (org-element-put-property replacement :replaces
+ (list (org-element-type latex-*)
+ (list :value latex-frag)))
+ ;; Replace now.
+ (org-element-set-element latex-* replacement))))))
+ info)))
+ tree)
+
+
+;;;; Description lists
+
+;; This translator is necessary to handle indented tables in a uniform
+;; manner. See comment in `org-odt--table'.
+
+(defun org-odt--translate-description-lists (tree backend info)
+ ;; OpenDocument has no notion of a description list. So simulate it
+ ;; using plain lists. Description lists in the exported document
+ ;; are typeset in the same manner as they are in a typical HTML
+ ;; document.
+ ;;
+ ;; Specifically, a description list like this:
+ ;;
+ ;; ,----
+ ;; | - term-1 :: definition-1
+ ;; | - term-2 :: definition-2
+ ;; `----
+ ;;
+ ;; gets translated in to the following form:
+ ;;
+ ;; ,----
+ ;; | - term-1
+ ;; | - definition-1
+ ;; | - term-2
+ ;; | - definition-2
+ ;; `----
+ ;;
+ ;; Further effect is achieved by fixing the OD styles as below:
+ ;;
+ ;; 1. Set the :type property of the simulated lists to
+ ;; `descriptive-1' and `descriptive-2'. Map these to list-styles
+ ;; that has *no* bullets whatsoever.
+ ;;
+ ;; 2. The paragraph containing the definition term is styled to be
+ ;; in bold.
+ ;;
+ (org-element-map tree 'plain-list
+ (lambda (el)
+ (when (equal (org-element-property :type el) 'descriptive)
+ (org-element-set-element
+ el
+ (apply 'org-element-adopt-elements
+ (list 'plain-list (list :type 'descriptive-1))
+ (mapcar
+ (lambda (item)
+ (org-element-adopt-elements
+ (list 'item (list :checkbox (org-element-property
+ :checkbox item)))
+ (list 'paragraph (list :style "Text_20_body_20_bold")
+ (or (org-element-property :tag item) "(no term)"))
+ (org-element-adopt-elements
+ (list 'plain-list (list :type 'descriptive-2))
+ (apply 'org-element-adopt-elements
+ (list 'item nil)
+ (org-element-contents item)))))
+ (org-element-contents el)))))
+ nil)
+ info)
+ tree)
+
+;;;; List tables
+
+;; Lists that are marked with attribute `:list-table' are called as
+;; list tables. They will be rendered as a table within the exported
+;; document.
+
+;; Consider an example. The following list table
+;;
+;; #+attr_odt :list-table t
+;; - Row 1
+;; - 1.1
+;; - 1.2
+;; - 1.3
+;; - Row 2
+;; - 2.1
+;; - 2.2
+;; - 2.3
+;;
+;; will be exported as though it were an Org table like the one show
+;; below.
+;;
+;; | Row 1 | 1.1 | 1.2 | 1.3 |
+;; | Row 2 | 2.1 | 2.2 | 2.3 |
+;;
+;; Note that org-tables are NOT multi-line and each line is mapped to
+;; a unique row in the exported document. So if an exported table
+;; needs to contain a single paragraph (with copious text) it needs to
+;; be typed up in a single line. Editing such long lines using the
+;; table editor will be a cumbersome task. Furthermore inclusion of
+;; multi-paragraph text in a table cell is well-nigh impossible.
+;;
+;; A LIST-TABLE circumvents above problems.
+;;
+;; Note that in the example above the list items could be paragraphs
+;; themselves and the list can be arbitrarily deep.
+;;
+;; Inspired by following thread:
+;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
+
+;; Translate lists to tables
+
+(defun org-odt--translate-list-tables (tree backend info)
+ (org-element-map tree 'plain-list
+ (lambda (l1-list)
+ (when (org-export-read-attribute :attr_odt l1-list :list-table)
+ ;; Replace list with table.
+ (org-element-set-element
+ l1-list
+ ;; Build replacement table.
+ (apply 'org-element-adopt-elements
+ (list 'table '(:type org :attr_odt (":style \"GriddedTable\"")))
+ (org-element-map l1-list 'item
+ (lambda (l1-item)
+ (let* ((l1-item-contents (org-element-contents l1-item))
+ l1-item-leading-text l2-list)
+ ;; Remove Level-2 list from the Level-item. It
+ ;; will be subsequently attached as table-cells.
+ (let ((cur l1-item-contents) prev)
+ (while (and cur (not (eq (org-element-type (car cur))
+ 'plain-list)))
+ (setq prev cur)
+ (setq cur (cdr cur)))
+ (when prev
+ (setcdr prev nil)
+ (setq l2-list (car cur)))
+ (setq l1-item-leading-text l1-item-contents))
+ ;; Level-1 items start a table row.
+ (apply 'org-element-adopt-elements
+ (list 'table-row (list :type 'standard))
+ ;; Leading text of level-1 item define
+ ;; the first table-cell.
+ (apply 'org-element-adopt-elements
+ (list 'table-cell nil)
+ l1-item-leading-text)
+ ;; Level-2 items define subsequent
+ ;; table-cells of the row.
+ (org-element-map l2-list 'item
+ (lambda (l2-item)
+ (apply 'org-element-adopt-elements
+ (list 'table-cell nil)
+ (org-element-contents l2-item)))
+ info nil 'item))))
+ info nil 'item))))
+ nil)
+ info)
+ tree)
+
+
+;;; Interactive functions
+
+(defun org-odt-create-manifest-file-entry (&rest args)
+ (push args org-odt-manifest-file-entries))
+
+(defun org-odt-write-manifest-file ()
+ (make-directory (concat org-odt-zip-dir "META-INF"))
+ (let ((manifest-file (concat org-odt-zip-dir "META-INF/manifest.xml")))
+ (with-current-buffer
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect manifest-file t))
+ (insert
+ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
+ <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
+ (mapc
+ (lambda (file-entry)
+ (let* ((version (nth 2 file-entry))
+ (extra (if (not version) ""
+ (format " manifest:version=\"%s\"" version))))
+ (insert
+ (format org-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
+ org-odt-manifest-file-entries)
+ (insert "\n</manifest:manifest>"))))
+
+(defmacro org-odt--export-wrap (out-file &rest body)
+ `(let* ((--out-file ,out-file)
+ (out-file-type (file-name-extension --out-file))
+ (org-odt-xml-files '("META-INF/manifest.xml" "content.xml"
+ "meta.xml" "styles.xml"))
+ ;; Initialize temporary workarea. All files that end up in
+ ;; the exported document get parked/created here.
+ (org-odt-zip-dir (file-name-as-directory
+ (make-temp-file (format "%s-" out-file-type) t)))
+ (org-odt-manifest-file-entries nil)
+ (--cleanup-xml-buffers
+ (function
+ (lambda nil
+ ;; Kill all XML buffers.
+ (mapc (lambda (file)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))))
+ org-odt-xml-files)
+ ;; Delete temporary directory and also other embedded
+ ;; files that get copied there.
+ (delete-directory org-odt-zip-dir t)))))
+ (condition-case err
+ (progn
+ (unless (executable-find "zip")
+ ;; Not at all OSes ship with zip by default
+ (error "Executable \"zip\" needed for creating OpenDocument files"))
+ ;; Do export. This creates a bunch of xml files ready to be
+ ;; saved and zipped.
+ (progn ,@body)
+ ;; Create a manifest entry for content.xml.
+ (org-odt-create-manifest-file-entry "text/xml" "content.xml")
+ ;; Write mimetype file
+ (let* ((mimetypes
+ '(("odt" . "application/vnd.oasis.opendocument.text")
+ ("odf" . "application/vnd.oasis.opendocument.formula")))
+ (mimetype (cdr (assoc-string out-file-type mimetypes t))))
+ (unless mimetype
+ (error "Unknown OpenDocument backend %S" out-file-type))
+ (write-region mimetype nil (concat org-odt-zip-dir "mimetype"))
+ (org-odt-create-manifest-file-entry mimetype "/" "1.2"))
+ ;; Write out the manifest entries before zipping
+ (org-odt-write-manifest-file)
+ ;; Save all XML files.
+ (mapc (lambda (file)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ ;; Prettify output if needed.
+ (when org-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))))
+ org-odt-xml-files)
+ ;; Run zip.
+ (let* ((target --out-file)
+ (target-name (file-name-nondirectory target))
+ (cmds `(("zip" "-mX0" ,target-name "mimetype")
+ ("zip" "-rmTq" ,target-name "."))))
+ ;; If a file with same name as the desired output file
+ ;; exists, remove it.
+ (when (file-exists-p target)
+ (delete-file target))
+ ;; Zip up the xml files.
+ (let ((coding-system-for-write 'no-conversion) exitcode err-string)
+ (message "Creating ODT file...")
+ ;; Switch temporarily to content.xml. This way Zip
+ ;; process will inherit `org-odt-zip-dir' as the current
+ ;; directory.
+ (with-current-buffer
+ (find-file-noselect (concat org-odt-zip-dir "content.xml") t)
+ (mapc
+ (lambda (cmd)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (error (concat "Unable to create OpenDocument file."
+ " Zip failed with error (%s)")
+ err-string)))
+ cmds)))
+ ;; Move the zip file from temporary work directory to
+ ;; user-mandated location.
+ (rename-file (concat org-odt-zip-dir target-name) target)
+ (message "Created %s" (expand-file-name target))
+ ;; Cleanup work directory and work files.
+ (funcall --cleanup-xml-buffers)
+ ;; Open the OpenDocument file in archive-mode for
+ ;; examination.
+ (find-file-noselect target t)
+ ;; Return exported file.
+ (cond
+ ;; Case 1: Conversion desired on exported file. Run the
+ ;; converter on the OpenDocument file. Return the
+ ;; converted file.
+ (org-odt-preferred-output-format
+ (or (org-odt-convert target org-odt-preferred-output-format)
+ target))
+ ;; Case 2: No further conversion. Return exported
+ ;; OpenDocument file.
+ (t target))))
+ (error
+ ;; Cleanup work directory and work files.
+ (funcall --cleanup-xml-buffers)
+ (message "OpenDocument export failed: %s"
+ (error-message-string err))))))
+
+
+;;;; Export to OpenDocument formula
+
+;;;###autoload
+(defun org-odt-export-as-odf (latex-frag &optional odf-file)
+ "Export LATEX-FRAG as OpenDocument formula file ODF-FILE.
+Use `org-create-math-formula' to convert LATEX-FRAG first to
+MathML. When invoked as an interactive command, use
+`org-latex-regexps' to infer LATEX-FRAG from currently active
+region. If no LaTeX fragments are found, prompt for it. Push
+MathML source to kill ring depending on the value of
+`org-export-copy-to-kill-ring'."
+ (interactive
+ `(,(let (frag)
+ (setq frag (and (setq frag (and (region-active-p)
+ (buffer-substring (region-beginning)
+ (region-end))))
+ (loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
+ (read-string "LaTeX Fragment: " frag nil frag))
+ ,(let ((odf-filename (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name))))
+ (read-file-name "ODF filename: " nil odf-filename nil
+ (file-name-nondirectory odf-filename)))))
+ (let ((filename (or odf-file
+ (expand-file-name
+ (concat
+ (file-name-sans-extension
+ (or (file-name-nondirectory buffer-file-name)))
+ "." "odf")
+ (file-name-directory buffer-file-name)))))
+ (org-odt--export-wrap
+ filename
+ (let* ((buffer (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect (concat org-odt-zip-dir
+ "content.xml") t))))
+ (coding-system-for-write 'utf-8)
+ (save-buffer-coding-system 'utf-8))
+ (set-buffer buffer)
+ (set-buffer-file-coding-system coding-system-for-write)
+ (let ((mathml (org-create-math-formula latex-frag)))
+ (unless mathml (error "No Math formula created"))
+ (insert mathml)
+ ;; Add MathML to kill ring, if needed.
+ (when (org-export--copy-to-kill-ring-p)
+ (org-kill-new (buffer-string))))))))
+
+;;;###autoload
+(defun org-odt-export-as-odf-and-open ()
+ "Export LaTeX fragment as OpenDocument formula and immediately open it.
+Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument
+formula file."
+ (interactive)
+ (org-open-file (call-interactively 'org-odt-export-as-odf) 'system))
+
+
+;;;; Export to OpenDocument Text
+
+;;;###autoload
+(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to a ODT file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".odt" subtreep)))
+ (if async
+ (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt))
+ `(expand-file-name
+ (org-odt--export-wrap
+ ,outfile
+ (let* ((org-odt-embedded-images-count 0)
+ (org-odt-embedded-formulas-count 0)
+ (org-odt-automatic-styles nil)
+ (org-odt-object-counters nil)
+ ;; Let `htmlfontify' know that we are interested in
+ ;; collecting styles.
+ (hfy-user-sheet-assoc nil))
+ ;; Initialize content.xml and kick-off the export
+ ;; process.
+ (let ((out-buf
+ (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect
+ (concat org-odt-zip-dir "content.xml") t))))
+ (output (org-export-as
+ 'odt ,subtreep ,visible-only nil ,ext-plist)))
+ (with-current-buffer out-buf
+ (erase-buffer)
+ (insert output)))))))
+ (org-odt--export-wrap
+ outfile
+ (let* ((org-odt-embedded-images-count 0)
+ (org-odt-embedded-formulas-count 0)
+ (org-odt-automatic-styles nil)
+ (org-odt-object-counters nil)
+ ;; Let `htmlfontify' know that we are interested in collecting
+ ;; styles.
+ (hfy-user-sheet-assoc nil))
+ ;; Initialize content.xml and kick-off the export process.
+ (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist))
+ (out-buf (progn
+ (require 'nxml-mode)
+ (let ((nxml-auto-insert-xml-declaration-flag nil))
+ (find-file-noselect
+ (concat org-odt-zip-dir "content.xml") t)))))
+ (with-current-buffer out-buf (erase-buffer) (insert output))))))))
+
+
+;;;; Convert between OpenDocument and other formats
+
+(defun org-odt-reachable-p (in-fmt out-fmt)
+ "Return non-nil if IN-FMT can be converted to OUT-FMT."
+ (catch 'done
+ (let ((reachable-formats (org-odt-do-reachable-formats in-fmt)))
+ (dolist (e reachable-formats)
+ (let ((out-fmt-spec (assoc out-fmt (cdr e))))
+ (when out-fmt-spec
+ (throw 'done (cons (car e) out-fmt-spec))))))))
+
+(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg)
+ "Workhorse routine for `org-odt-convert'."
+ (require 'browse-url)
+ (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
+ (dummy (or (file-readable-p in-file)
+ (error "Cannot read %s" in-file)))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt (or out-fmt (error "Output format unspecified")))
+ (how (or (org-odt-reachable-p in-fmt out-fmt)
+ (error "Cannot convert from %s format to %s format?"
+ in-fmt out-fmt)))
+ (convert-process (car how))
+ (out-file (concat (file-name-sans-extension in-file) "."
+ (nth 1 (or (cdr how) out-fmt))))
+ (extra-options (or (nth 2 (cdr how)) ""))
+ (out-dir (file-name-directory in-file))
+ (cmd (format-spec convert-process
+ `((?i . ,(shell-quote-argument in-file))
+ (?I . ,(browse-url-file-url in-file))
+ (?f . ,out-fmt)
+ (?o . ,out-file)
+ (?O . ,(browse-url-file-url out-file))
+ (?d . , (shell-quote-argument out-dir))
+ (?D . ,(browse-url-file-url out-dir))
+ (?x . ,extra-options)))))
+ (when (file-exists-p out-file)
+ (delete-file out-file))
+
+ (message "Executing %s" cmd)
+ (let ((cmd-output (shell-command-to-string cmd)))
+ (message "%s" cmd-output))
+
+ (cond
+ ((file-exists-p out-file)
+ (message "Exported to %s" out-file)
+ (when prefix-arg
+ (message "Opening %s..." out-file)
+ (org-open-file out-file 'system))
+ out-file)
+ (t
+ (message "Export to %s failed" out-file)
+ nil))))
+
+(defun org-odt-do-reachable-formats (in-fmt)
+ "Return verbose info about formats to which IN-FMT can be converted.
+Return a list where each element is of the
+form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
+`org-odt-convert-processes' for CONVERTER-PROCESS and see
+`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST."
+ (let* ((converter
+ (and org-odt-convert-process
+ (cadr (assoc-string org-odt-convert-process
+ org-odt-convert-processes t))))
+ (capabilities
+ (and org-odt-convert-process
+ (cadr (assoc-string org-odt-convert-process
+ org-odt-convert-processes t))
+ org-odt-convert-capabilities))
+ reachable-formats)
+ (when converter
+ (dolist (c capabilities)
+ (when (member in-fmt (nth 1 c))
+ (push (cons converter (nth 2 c)) reachable-formats))))
+ reachable-formats))
+
+(defun org-odt-reachable-formats (in-fmt)
+ "Return list of formats to which IN-FMT can be converted.
+The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
+ (let (l)
+ (mapc (lambda (e) (add-to-list 'l e))
+ (apply 'append (mapcar
+ (lambda (e) (mapcar 'car (cdr e)))
+ (org-odt-do-reachable-formats in-fmt))))
+ l))
+
+(defun org-odt-convert-read-params ()
+ "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'.
+This is a helper routine for interactive use."
+ (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read))
+ (in-file (read-file-name "File to be converted: "
+ nil buffer-file-name t))
+ (in-fmt (file-name-extension in-file))
+ (out-fmt-choices (org-odt-reachable-formats in-fmt))
+ (out-fmt
+ (or (and out-fmt-choices
+ (funcall input "Output format: "
+ out-fmt-choices nil nil nil))
+ (error
+ "No known converter or no known output formats for %s files"
+ in-fmt))))
+ (list in-file out-fmt)))
+
+;;;###autoload
+(defun org-odt-convert (&optional in-file out-fmt prefix-arg)
+ "Convert IN-FILE to format OUT-FMT using a command line converter.
+IN-FILE is the file to be converted. If unspecified, it defaults
+to variable `buffer-file-name'. OUT-FMT is the desired output
+format. Use `org-odt-convert-process' as the converter.
+If PREFIX-ARG is non-nil then the newly converted file is opened
+using `org-open-file'."
+ (interactive
+ (append (org-odt-convert-read-params) current-prefix-arg))
+ (org-odt-do-convert in-file out-fmt prefix-arg))
+
+;;; Library Initializations
+
+(mapc
+ (lambda (desc)
+ ;; Let Emacs open all OpenDocument files in archive mode
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
+ org-odt-file-extensions)
+
+(provide 'ox-odt)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-odt.el ends here
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
new file mode 100644
index 00000000000..5904ca2cc72
--- /dev/null
+++ b/lisp/org/ox-org.el
@@ -0,0 +1,284 @@
+;;; ox-org.el --- Org Back-End for Org Export Engine
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Keywords: org, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ox)
+(declare-function htmlize-buffer "htmlize" (&optional buffer))
+
+(defgroup org-export-org nil
+ "Options for exporting Org mode files to Org."
+ :tag "Org Export Org"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(define-obsolete-variable-alias
+ 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
+(defcustom org-org-htmlized-css-url nil
+ "URL pointing to the CSS defining colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer,
+htmlize will create the CSS to define the font colors. However,
+this does not work when converting in batch mode, and it also can
+look bad if different people with different fontification setup
+work on the same website. When this variable is non-nil,
+creating an htmlized version of an Org buffer using
+`org-org-export-as-org' will include a link to this URL if the
+setting of `org-html-htmlize-output-type' is 'css."
+ :group 'org-export-org
+ :type '(choice
+ (const :tag "Don't include external stylesheet link" nil)
+ (string :tag "URL or local href")))
+
+(org-export-define-backend 'org
+ '((babel-call . org-org-identity)
+ (bold . org-org-identity)
+ (center-block . org-org-identity)
+ (clock . org-org-identity)
+ (code . org-org-identity)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (diary-sexp . org-org-identity)
+ (drawer . org-org-identity)
+ (dynamic-block . org-org-identity)
+ (entity . org-org-identity)
+ (example-block . org-org-identity)
+ (fixed-width . org-org-identity)
+ (footnote-definition . ignore)
+ (footnote-reference . org-org-identity)
+ (headline . org-org-headline)
+ (horizontal-rule . org-org-identity)
+ (inline-babel-call . org-org-identity)
+ (inline-src-block . org-org-identity)
+ (inlinetask . org-org-identity)
+ (italic . org-org-identity)
+ (item . org-org-identity)
+ (keyword . org-org-keyword)
+ (latex-environment . org-org-identity)
+ (latex-fragment . org-org-identity)
+ (line-break . org-org-identity)
+ (link . org-org-identity)
+ (node-property . org-org-identity)
+ (paragraph . org-org-identity)
+ (plain-list . org-org-identity)
+ (planning . org-org-identity)
+ (property-drawer . org-org-identity)
+ (quote-block . org-org-identity)
+ (quote-section . org-org-identity)
+ (radio-target . org-org-identity)
+ (section . org-org-section)
+ (special-block . org-org-identity)
+ (src-block . org-org-identity)
+ (statistics-cookie . org-org-identity)
+ (strike-through . org-org-identity)
+ (subscript . org-org-identity)
+ (superscript . org-org-identity)
+ (table . org-org-identity)
+ (table-cell . org-org-identity)
+ (table-row . org-org-identity)
+ (target . org-org-identity)
+ (timestamp . org-org-identity)
+ (underline . org-org-identity)
+ (verbatim . org-org-identity)
+ (verse-block . org-org-identity))
+ :menu-entry
+ '(?O "Export to Org"
+ ((?O "As Org buffer" org-org-export-as-org)
+ (?o "As Org file" org-org-export-to-org)
+ (?v "As Org file and open"
+ (lambda (a s v b)
+ (if a (org-org-export-to-org t s v b)
+ (org-open-file (org-org-export-to-org nil s v b))))))))
+
+(defun org-org-identity (blob contents info)
+ "Transcode BLOB element or object back into Org syntax.
+CONTENTS is its contents, as a string or nil. INFO is ignored."
+ (let ((case-fold-search t))
+ (replace-regexp-in-string
+ "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
+ (org-export-expand blob contents t))))
+
+(defun org-org-headline (headline contents info)
+ "Transcode HEADLINE element back into Org syntax.
+CONTENTS is its contents, as a string or nil. INFO is ignored."
+ (unless (org-element-property :footnote-section-p headline)
+ (unless (plist-get info :with-todo-keywords)
+ (org-element-put-property headline :todo-keyword nil))
+ (unless (plist-get info :with-tags)
+ (org-element-put-property headline :tags nil))
+ (unless (plist-get info :with-priority)
+ (org-element-put-property headline :priority nil))
+ (org-element-put-property headline :level
+ (org-export-get-relative-level headline info))
+ (org-element-headline-interpreter headline contents)))
+
+(defun org-org-keyword (keyword contents info)
+ "Transcode KEYWORD element back into Org syntax.
+CONTENTS is nil. INFO is ignored. This function ignores
+keywords targeted at other export back-ends."
+ (unless (member (org-element-property :key keyword)
+ (mapcar
+ (lambda (block-cons)
+ (and (eq (cdr block-cons) 'org-element-export-block-parser)
+ (car block-cons)))
+ org-element-block-name-alist))
+ (org-element-keyword-interpreter keyword nil)))
+
+(defun org-org-section (section contents info)
+ "Transcode SECTION element back into Org syntax.
+CONTENTS is the contents of the section. INFO is a plist used as
+a communication channel."
+ (concat
+ (org-element-normalize-string contents)
+ ;; Insert footnote definitions appearing for the first time in this
+ ;; section. Indeed, some of them may not be available to narrowing
+ ;; so we make sure all of them are included in the result.
+ (let ((footnotes-alist
+ (org-element-map section 'footnote-reference
+ (lambda (fn)
+ (and (eq (org-element-property :type fn) 'standard)
+ (org-export-footnote-first-reference-p fn info)
+ (cons (org-element-property :label fn)
+ (org-export-get-footnote-definition fn info))))
+ info)))
+ (and footnotes-alist
+ (concat "\n"
+ (mapconcat
+ (lambda (d)
+ (org-element-normalize-string
+ (concat (format "[%s] "(car d))
+ (org-export-data (cdr d) info))))
+ footnotes-alist "\n"))))
+ (make-string (or (org-element-property :post-blank section) 0) ?\n)))
+
+;;;###autoload
+(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to an Org buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Export is done in a buffer named \"*Org ORG Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'org "*Org ORG Export*"
+ async subtreep visible-only nil ext-plist (lambda () (org-mode))))
+
+;;;###autoload
+(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)
+ "Export current buffer to an org file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".org" subtreep)))
+ (org-export-to-file 'org outfile
+ async subtreep visible-only nil ext-plist)))
+
+;;;###autoload
+(defun org-org-publish-to-org (plist filename pub-dir)
+ "Publish an org file to org.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'org filename ".org" plist pub-dir)
+ (when (plist-get plist :htmlized-source)
+ (require 'htmlize)
+ (require 'ox-html)
+ (let* ((org-inhibit-startup t)
+ (htmlize-output-type 'css)
+ (html-ext (concat "." (or (plist-get plist :html-extension)
+ org-html-extension "html")))
+ (visitingp (find-buffer-visiting filename))
+ (work-buffer (or visitingp (find-file-noselect filename)))
+ newbuf)
+ (with-current-buffer work-buffer
+ (org-font-lock-ensure)
+ (show-all)
+ (org-show-block-all)
+ (setq newbuf (htmlize-buffer)))
+ (with-current-buffer newbuf
+ (when org-org-htmlized-css-url
+ (goto-char (point-min))
+ (and (re-search-forward
+ "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
+ (replace-match
+ (format
+ "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
+ org-org-htmlized-css-url)
+ t t)))
+ (write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
+ (kill-buffer newbuf)
+ (unless visitingp (kill-buffer work-buffer)))
+ ;; FIXME: Why? Which buffer is this supposed to apply to?
+ (set-buffer-modified-p nil)))
+
+
+(provide 'ox-org)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-org.el ends here
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
new file mode 100644
index 00000000000..52d925adbf9
--- /dev/null
+++ b/lisp/org/ox-publish.el
@@ -0,0 +1,1247 @@
+;;; ox-publish.el --- Publish Related Org Mode Files as a Website
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
+
+;; Author: David O'Toole <dto@gnu.org>
+;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
+;; Keywords: hypermedia, outlines, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This program allow configurable publishing of related sets of
+;; Org mode files as a complete website.
+;;
+;; ox-publish.el can do the following:
+;;
+;; + Publish all one's Org files to a given export back-end
+;; + Upload HTML, images, attachments and other files to a web server
+;; + Exclude selected private pages from publishing
+;; + Publish a clickable sitemap of pages
+;; + Manage local timestamps for publishing only changed files
+;; + Accept plugin functions to extend range of publishable content
+;;
+;; Documentation for publishing is in the manual.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'format-spec)
+(require 'ox)
+
+
+
+;;; Variables
+
+(defvar org-publish-temp-files nil
+ "Temporary list of files to be published.")
+
+;; Here, so you find the variable right before it's used the first time:
+(defvar org-publish-cache nil
+ "This will cache timestamps and titles for files in publishing projects.
+Blocks could hash sha1 values here.")
+
+(defgroup org-publish nil
+ "Options for publishing a set of Org-mode and related files."
+ :tag "Org Publishing"
+ :group 'org)
+
+(defcustom org-publish-project-alist nil
+ "Association list to control publishing behavior.
+Each element of the alist is a publishing “project”. The CAR of
+each element is a string, uniquely identifying the project. The
+CDR of each element is in one of the following forms:
+
+1. A well-formed property list with an even number of elements,
+ alternating keys and values, specifying parameters for the
+ publishing process.
+
+ (:property value :property value ... )
+
+2. A meta-project definition, specifying of a list of
+ sub-projects:
+
+ (:components (\"project-1\" \"project-2\" ...))
+
+When the CDR of an element of org-publish-project-alist is in
+this second form, the elements of the list after `:components'
+are taken to be components of the project, which group together
+files requiring different publishing options. When you publish
+such a project with \\[org-publish], the components all publish.
+
+When a property is given a value in `org-publish-project-alist',
+its setting overrides the value of the corresponding user
+variable (if any) during publishing. However, options set within
+a file override everything.
+
+Most properties are optional, but some should always be set:
+
+ `:base-directory'
+
+ Directory containing publishing source files.
+
+ `:base-extension'
+
+ Extension (without the dot!) of source files. This can be
+ a regular expression. If not given, \"org\" will be used as
+ default extension.
+
+ `:publishing-directory'
+
+ Directory (possibly remote) where output files will be
+ published.
+
+The `:exclude' property may be used to prevent certain files from
+being published. Its value may be a string or regexp matching
+file names you don't want to be published.
+
+The `:include' property may be used to include extra files. Its
+value may be a list of filenames to include. The filenames are
+considered relative to the base directory.
+
+When both `:include' and `:exclude' properties are given values,
+the exclusion step happens first.
+
+One special property controls which back-end function to use for
+publishing files in the project. This can be used to extend the
+set of file types publishable by `org-publish', as well as the
+set of output formats.
+
+ `:publishing-function'
+
+ Function to publish file. Each back-end may define its
+ own (i.e. `org-latex-publish-to-pdf',
+ `org-html-publish-to-html'). May be a list of functions, in
+ which case each function in the list is invoked in turn.
+
+Another property allows you to insert code that prepares
+a project for publishing. For example, you could call GNU Make
+on a certain makefile, to ensure published files are built up to
+date.
+
+ `:preparation-function'
+
+ Function to be called before publishing this project. This
+ may also be a list of functions.
+
+ `:completion-function'
+
+ Function to be called after publishing this project. This
+ may also be a list of functions.
+
+Some properties control details of the Org publishing process,
+and are equivalent to the corresponding user variables listed in
+the right column. Back-end specific properties may also be
+included. See the back-end documentation for more information.
+
+ :author `user-full-name'
+ :creator `org-export-creator-string'
+ :email `user-mail-address'
+ :exclude-tags `org-export-exclude-tags'
+ :headline-levels `org-export-headline-levels'
+ :language `org-export-default-language'
+ :preserve-breaks `org-export-preserve-breaks'
+ :section-numbers `org-export-with-section-numbers'
+ :select-tags `org-export-select-tags'
+ :time-stamp-file `org-export-time-stamp-file'
+ :with-archived-trees `org-export-with-archived-trees'
+ :with-author `org-export-with-author'
+ :with-creator `org-export-with-creator'
+ :with-date `org-export-with-date'
+ :with-drawers `org-export-with-drawers'
+ :with-email `org-export-with-email'
+ :with-emphasize `org-export-with-emphasize'
+ :with-entities `org-export-with-entities'
+ :with-fixed-width `org-export-with-fixed-width'
+ :with-footnotes `org-export-with-footnotes'
+ :with-inlinetasks `org-export-with-inlinetasks'
+ :with-latex `org-export-with-latex'
+ :with-priority `org-export-with-priority'
+ :with-smart-quotes `org-export-with-smart-quotes'
+ :with-special-strings `org-export-with-special-strings'
+ :with-statistics-cookies' `org-export-with-statistics-cookies'
+ :with-sub-superscript `org-export-with-sub-superscripts'
+ :with-toc `org-export-with-toc'
+ :with-tables `org-export-with-tables'
+ :with-tags `org-export-with-tags'
+ :with-tasks `org-export-with-tasks'
+ :with-timestamps `org-export-with-timestamps'
+ :with-planning `org-export-with-planning'
+ :with-todo-keywords `org-export-with-todo-keywords'
+
+The following properties may be used to control publishing of
+a site-map of files or summary page for a given project.
+
+ `:auto-sitemap'
+
+ Whether to publish a site-map during
+ `org-publish-current-project' or `org-publish-all'.
+
+ `:sitemap-filename'
+
+ Filename for output of sitemap. Defaults to \"sitemap.org\".
+
+ `:sitemap-title'
+
+ Title of site-map page. Defaults to name of file.
+
+ `:sitemap-function'
+
+ Plugin function to use for generation of site-map. Defaults
+ to `org-publish-org-sitemap', which generates a plain list of
+ links to all files in the project.
+
+ `:sitemap-style'
+
+ Can be `list' (site-map is just an itemized list of the
+ titles of the files involved) or `tree' (the directory
+ structure of the source files is reflected in the site-map).
+ Defaults to `tree'.
+
+ `:sitemap-sans-extension'
+
+ Remove extension from site-map's file-names. Useful to have
+ cool URIs (see http://www.w3.org/Provider/Style/URI).
+ Defaults to nil.
+
+If you create a site-map file, adjust the sorting like this:
+
+ `:sitemap-sort-folders'
+
+ Where folders should appear in the site-map. Set this to
+ `first' (default) or `last' to display folders first or last,
+ respectively. Any other value will mix files and folders.
+
+ `:sitemap-sort-files'
+
+ The site map is normally sorted alphabetically. You can
+ change this behavior setting this to `anti-chronologically',
+ `chronologically', or nil.
+
+ `:sitemap-ignore-case'
+
+ Should sorting be case-sensitive? Default nil.
+
+The following property control the creation of a concept index.
+
+ `:makeindex'
+
+ Create a concept index. The file containing the index has to
+ be called \"theindex.org\". If it doesn't exist in the
+ project, it will be generated. Contents of the index are
+ stored in the file \"theindex.inc\", which can be included in
+ \"theindex.org\".
+
+Other properties affecting publication.
+
+ `:body-only'
+
+ Set this to t to publish only the body of the documents."
+ :group 'org-export-publish
+ :type 'alist)
+
+(defcustom org-publish-use-timestamps-flag t
+ "Non-nil means use timestamp checking to publish only changed files.
+When nil, do no timestamp checking and always publish all files."
+ :group 'org-export-publish
+ :type 'boolean)
+
+(defcustom org-publish-timestamp-directory
+ (convert-standard-filename "~/.org-timestamps/")
+ "Name of directory in which to store publishing timestamps."
+ :group 'org-export-publish
+ :type 'directory)
+
+(defcustom org-publish-list-skipped-files t
+ "Non-nil means show message about files *not* published."
+ :group 'org-export-publish
+ :type 'boolean)
+
+(defcustom org-publish-sitemap-sort-files 'alphabetically
+ "Method to sort files in site-maps.
+Possible values are `alphabetically', `chronologically',
+`anti-chronologically' and nil.
+
+If `alphabetically', files will be sorted alphabetically. If
+`chronologically', files will be sorted with older modification
+time first. If `anti-chronologically', files will be sorted with
+newer modification time first. nil won't sort files.
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-sort-files'."
+ :group 'org-export-publish
+ :type 'symbol)
+
+(defcustom org-publish-sitemap-sort-folders 'first
+ "A symbol, denoting if folders are sorted first in sitemaps.
+Possible values are `first', `last', and nil.
+If `first', folders will be sorted before files.
+If `last', folders are sorted to the end after the files.
+Any other value will not mix files and folders.
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-sort-folders'."
+ :group 'org-export-publish
+ :type 'symbol)
+
+(defcustom org-publish-sitemap-sort-ignore-case nil
+ "Non-nil when site-map sorting should ignore case.
+
+You can overwrite this default per project in your
+`org-publish-project-alist', using `:sitemap-ignore-case'."
+ :group 'org-export-publish
+ :type 'boolean)
+
+(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
+ "Format for printing a date in the sitemap.
+See `format-time-string' for allowed formatters."
+ :group 'org-export-publish
+ :type 'string)
+
+(defcustom org-publish-sitemap-file-entry-format "%t"
+ "Format string for site-map file entry.
+You could use brackets to delimit on what part the link will be.
+
+%t is the title.
+%a is the author.
+%d is the date formatted using `org-publish-sitemap-date-format'."
+ :group 'org-export-publish
+ :type 'string)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Timestamp-related functions
+
+(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
+ "Return path to timestamp file for filename FILENAME."
+ (setq filename (concat filename "::" (or pub-dir "") "::"
+ (format "%s" (or pub-func ""))))
+ (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
+
+(defun org-publish-needed-p
+ (filename &optional pub-dir pub-func true-pub-dir base-dir)
+ "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
+TRUE-PUB-DIR is where the file will truly end up. Currently we
+are not using this - maybe it can eventually be used to check if
+the file is present at the target location, and how old it is.
+Right now we cannot do this, because we do not know under what
+file name the file will be stored - the publishing function can
+still decide about that independently."
+ (let ((rtn (if (not org-publish-use-timestamps-flag) t
+ (org-publish-cache-file-needs-publishing
+ filename pub-dir pub-func base-dir))))
+ (if rtn (message "Publishing file %s using `%s'" filename pub-func)
+ (when org-publish-list-skipped-files
+ (message "Skipping unmodified file %s" filename)))
+ rtn))
+
+(defun org-publish-update-timestamp
+ (filename &optional pub-dir pub-func base-dir)
+ "Update publishing timestamp for file FILENAME.
+If there is no timestamp, create one."
+ (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (stamp (org-publish-cache-ctime-of-src filename)))
+ (org-publish-cache-set key stamp)))
+
+(defun org-publish-remove-all-timestamps ()
+ "Remove all files in the timestamp directory."
+ (let ((dir org-publish-timestamp-directory)
+ files)
+ (when (and (file-exists-p dir) (file-directory-p dir))
+ (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (org-publish-reset-cache))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Getting project information out of `org-publish-project-alist'
+
+(defun org-publish-expand-projects (projects-alist)
+ "Expand projects in PROJECTS-ALIST.
+This splices all the components into the list."
+ (let ((rest projects-alist) rtn p components)
+ (while (setq p (pop rest))
+ (if (setq components (plist-get (cdr p) :components))
+ (setq rest (append
+ (mapcar (lambda (x) (assoc x org-publish-project-alist))
+ components)
+ rest))
+ (push p rtn)))
+ (nreverse (delete-dups (delq nil rtn)))))
+
+(defvar org-publish-sitemap-sort-files)
+(defvar org-publish-sitemap-sort-folders)
+(defvar org-publish-sitemap-ignore-case)
+(defvar org-publish-sitemap-requested)
+(defvar org-publish-sitemap-date-format)
+(defvar org-publish-sitemap-file-entry-format)
+(defun org-publish-compare-directory-files (a b)
+ "Predicate for `sort', that sorts folders and files for sitemap."
+ (let ((retval t))
+ (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
+ ;; First we sort files:
+ (when org-publish-sitemap-sort-files
+ (case org-publish-sitemap-sort-files
+ (alphabetically
+ (let* ((adir (file-directory-p a))
+ (aorg (and (string-match "\\.org$" a) (not adir)))
+ (bdir (file-directory-p b))
+ (borg (and (string-match "\\.org$" b) (not bdir)))
+ (A (if aorg (concat (file-name-directory a)
+ (org-publish-find-title a)) a))
+ (B (if borg (concat (file-name-directory b)
+ (org-publish-find-title b)) b)))
+ (setq retval (if org-publish-sitemap-ignore-case
+ (not (string-lessp (upcase B) (upcase A)))
+ (not (string-lessp B A))))))
+ ((anti-chronologically chronologically)
+ (let* ((adate (org-publish-find-date a))
+ (bdate (org-publish-find-date b))
+ (A (+ (lsh (car adate) 16) (cadr adate)))
+ (B (+ (lsh (car bdate) 16) (cadr bdate))))
+ (setq retval
+ (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
+ (>= A B)))))))
+ ;; Directory-wise wins:
+ (when org-publish-sitemap-sort-folders
+ ;; a is directory, b not:
+ (cond
+ ((and (file-directory-p a) (not (file-directory-p b)))
+ (setq retval (equal org-publish-sitemap-sort-folders 'first)))
+ ;; a is not a directory, but b is:
+ ((and (not (file-directory-p a)) (file-directory-p b))
+ (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
+ retval))
+
+(defun org-publish-get-base-files-1
+ (base-dir &optional recurse match skip-file skip-dir)
+ "Set `org-publish-temp-files' with files from BASE-DIR directory.
+If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
+non-nil, restrict this list to the files matching the regexp
+MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
+SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
+matching the regexp SKIP-DIR when recursing through BASE-DIR."
+ (mapc (lambda (f)
+ (let ((fd-p (file-directory-p f))
+ (fnd (file-name-nondirectory f)))
+ (if (and fd-p recurse
+ (not (string-match "^\\.+$" fnd))
+ (if skip-dir (not (string-match skip-dir fnd)) t))
+ (org-publish-get-base-files-1
+ f recurse match skip-file skip-dir)
+ (unless (or fd-p ;; this is a directory
+ (and skip-file (string-match skip-file fnd))
+ (not (file-exists-p (file-truename f)))
+ (not (string-match match fnd)))
+
+ (pushnew f org-publish-temp-files)))))
+ (let ((all-files (if (not recurse) (directory-files base-dir t match)
+ ;; If RECURSE is non-nil, we want all files
+ ;; matching MATCH and sub-directories.
+ (org-remove-if-not
+ (lambda (file)
+ (or (file-directory-p file)
+ (and match (string-match match file))))
+ (directory-files base-dir t)))))
+ (if (not org-publish-sitemap-requested) all-files
+ (sort all-files 'org-publish-compare-directory-files)))))
+
+(defun org-publish-get-base-files (project &optional exclude-regexp)
+ "Return a list of all files in PROJECT.
+If EXCLUDE-REGEXP is set, this will be used to filter out
+matching filenames."
+ (let* ((project-plist (cdr project))
+ (base-dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (include-list (plist-get project-plist :include))
+ (recurse (plist-get project-plist :recursive))
+ (extension (or (plist-get project-plist :base-extension) "org"))
+ ;; sitemap-... variables are dynamically scoped for
+ ;; org-publish-compare-directory-files:
+ (org-publish-sitemap-requested
+ (plist-get project-plist :auto-sitemap))
+ (sitemap-filename
+ (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
+ (org-publish-sitemap-sort-folders
+ (if (plist-member project-plist :sitemap-sort-folders)
+ (plist-get project-plist :sitemap-sort-folders)
+ org-publish-sitemap-sort-folders))
+ (org-publish-sitemap-sort-files
+ (cond ((plist-member project-plist :sitemap-sort-files)
+ (plist-get project-plist :sitemap-sort-files))
+ ;; For backward compatibility:
+ ((plist-member project-plist :sitemap-alphabetically)
+ (if (plist-get project-plist :sitemap-alphabetically)
+ 'alphabetically nil))
+ (t org-publish-sitemap-sort-files)))
+ (org-publish-sitemap-ignore-case
+ (if (plist-member project-plist :sitemap-ignore-case)
+ (plist-get project-plist :sitemap-ignore-case)
+ org-publish-sitemap-sort-ignore-case))
+ (match (if (eq extension 'any) "^[^\\.]"
+ (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
+ ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
+ ;; value.
+ (unless (memq org-publish-sitemap-sort-folders '(first last))
+ (setq org-publish-sitemap-sort-folders nil))
+
+ (setq org-publish-temp-files nil)
+ (if org-publish-sitemap-requested
+ (pushnew (expand-file-name (concat base-dir sitemap-filename))
+ org-publish-temp-files))
+ (org-publish-get-base-files-1 base-dir recurse match
+ ;; FIXME distinguish exclude regexp
+ ;; for skip-file and skip-dir?
+ exclude-regexp exclude-regexp)
+ (mapc (lambda (f)
+ (pushnew
+ (expand-file-name (concat base-dir f))
+ org-publish-temp-files))
+ include-list)
+ org-publish-temp-files))
+
+(defun org-publish-get-project-from-filename (filename &optional up)
+ "Return the project that FILENAME belongs to."
+ (let* ((filename (expand-file-name filename))
+ project-name)
+
+ (catch 'p-found
+ (dolist (prj org-publish-project-alist)
+ (unless (plist-get (cdr prj) :components)
+ ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
+ (let* ((r (plist-get (cdr prj) :recursive))
+ (b (expand-file-name (file-name-as-directory
+ (plist-get (cdr prj) :base-directory))))
+ (x (or (plist-get (cdr prj) :base-extension) "org"))
+ (e (plist-get (cdr prj) :exclude))
+ (i (plist-get (cdr prj) :include))
+ (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
+ (when
+ (or (and i
+ (member filename
+ (mapcar (lambda (file)
+ (expand-file-name file b))
+ i)))
+ (and (not (and e (string-match e filename)))
+ (string-match xm filename)))
+ (setq project-name (car prj))
+ (throw 'p-found project-name))))))
+ (when up
+ (dolist (prj org-publish-project-alist)
+ (if (member project-name (plist-get (cdr prj) :components))
+ (setq project-name (car prj)))))
+ (assoc project-name org-publish-project-alist)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Tools for publishing functions in back-ends
+
+(defun org-publish-org-to (backend filename extension plist &optional pub-dir)
+ "Publish an Org file to a specified back-end.
+
+BACKEND is a symbol representing the back-end used for
+transcoding. FILENAME is the filename of the Org file to be
+published. EXTENSION is the extension used for the output
+string, with the leading dot. PLIST is the property list for the
+given project.
+
+Optional argument PUB-DIR, when non-nil is the publishing
+directory.
+
+Return output file name."
+ (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
+ ;; Check if a buffer visiting FILENAME is already open.
+ (let* ((org-inhibit-startup t)
+ (visitingp (find-buffer-visiting filename))
+ (work-buffer (or visitingp (find-file-noselect filename))))
+ (prog1 (with-current-buffer work-buffer
+ (let ((output-file
+ (org-export-output-file-name extension nil pub-dir))
+ (body-p (plist-get plist :body-only)))
+ (org-export-to-file backend output-file
+ nil nil nil body-p
+ ;; Add `org-publish-collect-numbering' and
+ ;; `org-publish-collect-index' to final output
+ ;; filters. The latter isn't dependent on
+ ;; `:makeindex', since we want to keep it up-to-date
+ ;; in cache anyway.
+ (org-combine-plists
+ plist
+ `(:filter-final-output
+ ,(cons 'org-publish-collect-numbering
+ (cons 'org-publish-collect-index
+ (plist-get plist :filter-final-output))))))))
+ ;; Remove opened buffer in the process.
+ (unless visitingp (kill-buffer work-buffer)))))
+
+(defun org-publish-attachment (plist filename pub-dir)
+ "Publish a file with no transformation of any kind.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (unless (file-directory-p pub-dir)
+ (make-directory pub-dir t))
+ (or (equal (expand-file-name (file-name-directory filename))
+ (file-name-as-directory (expand-file-name pub-dir)))
+ (copy-file filename
+ (expand-file-name (file-name-nondirectory filename) pub-dir)
+ t)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Publishing files, sets of files, and indices
+
+(defun org-publish-file (filename &optional project no-cache)
+ "Publish file FILENAME from PROJECT.
+If NO-CACHE is not nil, do not initialize org-publish-cache and
+write it to disk. This is needed, since this function is used to
+publish single files, when entire projects are published.
+See `org-publish-projects'."
+ (let* ((project
+ (or project
+ (or (org-publish-get-project-from-filename filename)
+ (error "File %s not part of any known project"
+ (abbreviate-file-name filename)))))
+ (project-plist (cdr project))
+ (ftname (expand-file-name filename))
+ (publishing-function
+ (or (plist-get project-plist :publishing-function)
+ (error "No publishing function chosen")))
+ (base-dir
+ (file-name-as-directory
+ (expand-file-name
+ (or (plist-get project-plist :base-directory)
+ (error "Project %s does not have :base-directory defined"
+ (car project))))))
+ (pub-dir
+ (file-name-as-directory
+ (file-truename
+ (or (eval (plist-get project-plist :publishing-directory))
+ (error "Project %s does not have :publishing-directory defined"
+ (car project))))))
+ tmp-pub-dir)
+
+ (unless no-cache (org-publish-initialize-cache (car project)))
+
+ (setq tmp-pub-dir
+ (file-name-directory
+ (concat pub-dir
+ (and (string-match (regexp-quote base-dir) ftname)
+ (substring ftname (match-end 0))))))
+ (if (listp publishing-function)
+ ;; allow chain of publishing functions
+ (mapc (lambda (f)
+ (when (org-publish-needed-p
+ filename pub-dir f tmp-pub-dir base-dir)
+ (funcall f project-plist filename tmp-pub-dir)
+ (org-publish-update-timestamp filename pub-dir f base-dir)))
+ publishing-function)
+ (when (org-publish-needed-p
+ filename pub-dir publishing-function tmp-pub-dir base-dir)
+ (funcall publishing-function project-plist filename tmp-pub-dir)
+ (org-publish-update-timestamp
+ filename pub-dir publishing-function base-dir)))
+ (unless no-cache (org-publish-write-cache-file))))
+
+(defun org-publish-projects (projects)
+ "Publish all files belonging to the PROJECTS alist.
+If `:auto-sitemap' is set, publish the sitemap too. If
+`:makeindex' is set, also produce a file theindex.org."
+ (mapc
+ (lambda (project)
+ ;; Each project uses its own cache file:
+ (org-publish-initialize-cache (car project))
+ (let* ((project-plist (cdr project))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (sitemap-p (plist-get project-plist :auto-sitemap))
+ (sitemap-filename (or (plist-get project-plist :sitemap-filename)
+ "sitemap.org"))
+ (sitemap-function (or (plist-get project-plist :sitemap-function)
+ 'org-publish-org-sitemap))
+ (org-publish-sitemap-date-format
+ (or (plist-get project-plist :sitemap-date-format)
+ org-publish-sitemap-date-format))
+ (org-publish-sitemap-file-entry-format
+ (or (plist-get project-plist :sitemap-file-entry-format)
+ org-publish-sitemap-file-entry-format))
+ (preparation-function
+ (plist-get project-plist :preparation-function))
+ (completion-function (plist-get project-plist :completion-function))
+ (files (org-publish-get-base-files project exclude-regexp))
+ (theindex
+ (expand-file-name "theindex.org"
+ (plist-get project-plist :base-directory))))
+ (when preparation-function (run-hooks 'preparation-function))
+ (if sitemap-p (funcall sitemap-function project sitemap-filename))
+ ;; Publish all files from PROJECT excepted "theindex.org". Its
+ ;; publishing will be deferred until "theindex.inc" is
+ ;; populated.
+ (dolist (file files)
+ (unless (equal file theindex)
+ (org-publish-file file project t)))
+ ;; Populate "theindex.inc", if needed, and publish
+ ;; "theindex.org".
+ (when (plist-get project-plist :makeindex)
+ (org-publish-index-generate-theindex
+ project (plist-get project-plist :base-directory))
+ (org-publish-file theindex project t))
+ (when completion-function (run-hooks 'completion-function))
+ (org-publish-write-cache-file)))
+ (org-publish-expand-projects projects)))
+
+(defun org-publish-org-sitemap (project &optional sitemap-filename)
+ "Create a sitemap of pages in set defined by PROJECT.
+Optionally set the filename of the sitemap with SITEMAP-FILENAME.
+Default for SITEMAP-FILENAME is `sitemap.org'."
+ (let* ((project-plist (cdr project))
+ (dir (file-name-as-directory
+ (plist-get project-plist :base-directory)))
+ (localdir (file-name-directory dir))
+ (indent-str (make-string 2 ?\ ))
+ (exclude-regexp (plist-get project-plist :exclude))
+ (files (nreverse
+ (org-publish-get-base-files project exclude-regexp)))
+ (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
+ (sitemap-title (or (plist-get project-plist :sitemap-title)
+ (concat "Sitemap for project " (car project))))
+ (sitemap-style (or (plist-get project-plist :sitemap-style)
+ 'tree))
+ (sitemap-sans-extension
+ (plist-get project-plist :sitemap-sans-extension))
+ (visiting (find-buffer-visiting sitemap-filename))
+ (ifn (file-name-nondirectory sitemap-filename))
+ file sitemap-buffer)
+ (with-current-buffer
+ (let ((org-inhibit-startup t))
+ (setq sitemap-buffer
+ (or visiting (find-file sitemap-filename))))
+ (erase-buffer)
+ (insert (concat "#+TITLE: " sitemap-title "\n\n"))
+ (while (setq file (pop files))
+ (let ((fn (file-name-nondirectory file))
+ (link (file-relative-name file dir))
+ (oldlocal localdir))
+ (when sitemap-sans-extension
+ (setq link (file-name-sans-extension link)))
+ ;; sitemap shouldn't list itself
+ (unless (equal (file-truename sitemap-filename)
+ (file-truename file))
+ (if (eq sitemap-style 'list)
+ (message "Generating list-style sitemap for %s" sitemap-title)
+ (message "Generating tree-style sitemap for %s" sitemap-title)
+ (setq localdir (concat (file-name-as-directory dir)
+ (file-name-directory link)))
+ (unless (string= localdir oldlocal)
+ (if (string= localdir dir)
+ (setq indent-str (make-string 2 ?\ ))
+ (let ((subdirs
+ (split-string
+ (directory-file-name
+ (file-name-directory
+ (file-relative-name localdir dir))) "/"))
+ (subdir "")
+ (old-subdirs (split-string
+ (file-relative-name oldlocal dir) "/")))
+ (setq indent-str (make-string 2 ?\ ))
+ (while (string= (car old-subdirs) (car subdirs))
+ (setq indent-str (concat indent-str (make-string 2 ?\ )))
+ (pop old-subdirs)
+ (pop subdirs))
+ (dolist (d subdirs)
+ (setq subdir (concat subdir d "/"))
+ (insert (concat indent-str " + " d "\n"))
+ (setq indent-str (make-string
+ (+ (length indent-str) 2) ?\ )))))))
+ ;; This is common to 'flat and 'tree
+ (let ((entry
+ (org-publish-format-file-entry
+ org-publish-sitemap-file-entry-format file project-plist))
+ (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
+ (cond ((string-match-p regexp entry)
+ (string-match regexp entry)
+ (insert (concat indent-str " + " (match-string 1 entry)
+ "[[file:" link "]["
+ (match-string 2 entry)
+ "]]" (match-string 3 entry) "\n")))
+ (t
+ (insert (concat indent-str " + [[file:" link "]["
+ entry
+ "]]\n"))))))))
+ (save-buffer))
+ (or visiting (kill-buffer sitemap-buffer))))
+
+(defun org-publish-format-file-entry (fmt file project-plist)
+ (format-spec
+ fmt
+ `((?t . ,(org-publish-find-title file t))
+ (?d . ,(format-time-string org-publish-sitemap-date-format
+ (org-publish-find-date file)))
+ (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+
+(defun org-publish-find-title (file &optional reset)
+ "Find the title of FILE in project."
+ (or
+ (and (not reset) (org-publish-cache-get-file-property file :title nil t))
+ (let* ((org-inhibit-startup t)
+ (visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file))))
+ (with-current-buffer buffer
+ (let ((title
+ (let ((property
+ (plist-get
+ ;; protect local variables in open buffers
+ (if visiting
+ (org-export-with-buffer-copy (org-export-get-environment))
+ (org-export-get-environment))
+ :title)))
+ (if property
+ (org-no-properties (org-element-interpret-data property))
+ (file-name-nondirectory (file-name-sans-extension file))))))
+ (unless visiting (kill-buffer buffer))
+ (org-publish-cache-set-file-property file :title title)
+ title)))))
+
+(defun org-publish-find-date (file)
+ "Find the date of FILE in project.
+This function assumes FILE is either a directory or an Org file.
+If FILE is an Org file and provides a DATE keyword use it. In
+any other case use the file system's modification time. Return
+time in `current-time' format."
+ (if (file-directory-p file) (nth 5 (file-attributes file))
+ (let* ((org-inhibit-startup t)
+ (visiting (find-buffer-visiting file))
+ (file-buf (or visiting (find-file-noselect file nil)))
+ (date (plist-get
+ (with-current-buffer file-buf
+ (if visiting
+ (org-export-with-buffer-copy (org-export-get-environment))
+ (org-export-get-environment)))
+ :date)))
+ (unless visiting (kill-buffer file-buf))
+ ;; DATE is either a timestamp object or a secondary string. If it
+ ;; is a timestamp or if the secondary string contains a timestamp,
+ ;; convert it to internal format. Otherwise, use FILE
+ ;; modification time.
+ (cond ((eq (org-element-type date) 'timestamp)
+ (org-time-string-to-time (org-element-interpret-data date)))
+ ((let ((ts (and (consp date) (assq 'timestamp date))))
+ (and ts
+ (let ((value (org-element-interpret-data ts)))
+ (and (org-string-nw-p value)
+ (org-time-string-to-time value))))))
+ ((file-exists-p file) (nth 5 (file-attributes file)))
+ (t (error "No such file: \"%s\"" file))))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Interactive publishing functions
+
+;;;###autoload
+(defalias 'org-publish-project 'org-publish)
+
+;;;###autoload
+(defun org-publish (project &optional force async)
+ "Publish PROJECT.
+
+PROJECT is either a project name, as a string, or a project
+alist (see `org-publish-project-alist' variable).
+
+When optional argument FORCE is non-nil, force publishing all
+files in PROJECT. With a non-nil optional argument ASYNC,
+publishing will be done asynchronously, in another process."
+ (interactive
+ (list
+ (assoc (org-icompleting-read
+ "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ current-prefix-arg))
+ (let ((project-alist (if (not (stringp project)) (list project)
+ ;; If this function is called in batch mode,
+ ;; project is still a string here.
+ (list (assoc project org-publish-project-alist)))))
+ (if async
+ (org-export-async-start (lambda (results) nil)
+ `(let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-projects ',project-alist)))
+ (save-window-excursion
+ (let* ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-projects project-alist))))))
+
+;;;###autoload
+(defun org-publish-all (&optional force async)
+ "Publish all projects.
+With prefix argument FORCE, remove all files in the timestamp
+directory and force publishing all projects. With a non-nil
+optional argument ASYNC, publishing will be done asynchronously,
+in another process."
+ (interactive "P")
+ (if async
+ (org-export-async-start (lambda (results) nil)
+ `(progn
+ (when ',force (org-publish-remove-all-timestamps))
+ (let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-projects ',org-publish-project-alist))))
+ (when force (org-publish-remove-all-timestamps))
+ (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-projects org-publish-project-alist)))))
+
+
+;;;###autoload
+(defun org-publish-current-file (&optional force async)
+ "Publish the current file.
+With prefix argument FORCE, force publish the file. When
+optional argument ASYNC is non-nil, publishing will be done
+asynchronously, in another process."
+ (interactive "P")
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (if async
+ (org-export-async-start (lambda (results) nil)
+ `(let ((org-publish-use-timestamps-flag
+ (if ',force nil ,org-publish-use-timestamps-flag)))
+ (org-publish-file ,file)))
+ (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (if force nil org-publish-use-timestamps-flag)))
+ (org-publish-file file))))))
+
+;;;###autoload
+(defun org-publish-current-project (&optional force async)
+ "Publish the project associated with the current file.
+With a prefix argument, force publishing of all files in
+the project."
+ (interactive "P")
+ (save-window-excursion
+ (let ((project (org-publish-get-project-from-filename
+ (buffer-file-name (buffer-base-buffer)) 'up)))
+ (if project (org-publish project force async)
+ (error "File %s is not part of any known project"
+ (buffer-file-name (buffer-base-buffer)))))))
+
+
+
+;;; Index generation
+
+(defun org-publish-collect-index (output backend info)
+ "Update index for a file in cache.
+
+OUTPUT is the output from transcoding current file. BACKEND is
+the back-end that was used for transcoding. INFO is a plist
+containing publishing and export options.
+
+The index relative to current file is stored as an alist. An
+association has the following shape: (TERM FILE-NAME PARENT),
+where TERM is the indexed term, as a string, FILE-NAME is the
+original full path of the file where the term in encountered, and
+PARENT is a reference to the headline, if any, containing the
+original index keyword. When non-nil, this reference is a cons
+cell. Its CAR is a symbol among `id', `custom-id' and `name' and
+its CDR is a string."
+ (let ((file (plist-get info :input-file)))
+ (org-publish-cache-set-file-property
+ file :index
+ (delete-dups
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "INDEX")
+ (let ((parent (org-export-get-parent-headline k)))
+ (list (org-element-property :value k)
+ file
+ (cond
+ ((not parent) nil)
+ ((let ((id (org-element-property :ID parent)))
+ (and id (cons 'id id))))
+ ((let ((id (org-element-property :CUSTOM_ID parent)))
+ (and id (cons 'custom-id id))))
+ (t (cons 'name
+ ;; Remove statistics cookie.
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value parent)))))))))
+ info))))
+ ;; Return output unchanged.
+ output)
+
+(defun org-publish-index-generate-theindex (project directory)
+ "Retrieve full index from cache and build \"theindex.org\".
+PROJECT is the project the index relates to. DIRECTORY is the
+publishing directory."
+ (let ((all-files (org-publish-get-base-files
+ project (plist-get (cdr project) :exclude)))
+ full-index)
+ ;; Compile full index and sort it alphabetically.
+ (dolist (file all-files
+ (setq full-index
+ (sort (nreverse full-index)
+ (lambda (a b) (string< (downcase (car a))
+ (downcase (car b)))))))
+ (let ((index (org-publish-cache-get-file-property file :index)))
+ (dolist (term index)
+ (unless (member term full-index) (push term full-index)))))
+ ;; Write "theindex.inc" in DIRECTORY.
+ (with-temp-file (expand-file-name "theindex.inc" directory)
+ (let ((current-letter nil) (last-entry nil))
+ (dolist (idx full-index)
+ (let* ((entry (org-split-string (car idx) "!"))
+ (letter (upcase (substring (car entry) 0 1)))
+ ;; Transform file into a path relative to publishing
+ ;; directory.
+ (file (file-relative-name
+ (nth 1 idx)
+ (plist-get (cdr project) :base-directory))))
+ ;; Check if another letter has to be inserted.
+ (unless (string= letter current-letter)
+ (insert (format "* %s\n" letter)))
+ ;; Compute the first difference between last entry and
+ ;; current one: it tells the level at which new items
+ ;; should be added.
+ (let* ((rank (if (equal entry last-entry) (1- (length entry))
+ (loop for n from 0 to (length entry)
+ unless (equal (nth n entry) (nth n last-entry))
+ return n)))
+ (len (length (nthcdr rank entry))))
+ ;; For each term after the first difference, create
+ ;; a new sub-list with the term as body. Moreover,
+ ;; linkify the last term.
+ (dotimes (n len)
+ (insert
+ (concat
+ (make-string (* (+ rank n) 2) ? ) " - "
+ (if (not (= (1- len) n)) (nth (+ rank n) entry)
+ ;; Last term: Link it to TARGET, if possible.
+ (let ((target (nth 2 idx)))
+ (format
+ "[[%s][%s]]"
+ ;; Destination.
+ (case (car target)
+ ('nil (format "file:%s" file))
+ (id (format "id:%s" (cdr target)))
+ (custom-id (format "file:%s::#%s" file (cdr target)))
+ (otherwise (format "file:%s::*%s" file (cdr target))))
+ ;; Description.
+ (car (last entry)))))
+ "\n"))))
+ (setq current-letter letter last-entry entry))))
+ ;; Create "theindex.org", if it doesn't exist yet, and provide
+ ;; a default index file.
+ (let ((index.org (expand-file-name "theindex.org" directory)))
+ (unless (file-exists-p index.org)
+ (with-temp-file index.org
+ (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
+
+
+
+;;; External Fuzzy Links Resolution
+;;
+;; This part implements tools to resolve [[file.org::*Some headline]]
+;; links, where "file.org" belongs to the current project.
+
+(defun org-publish-collect-numbering (output backend info)
+ (org-publish-cache-set-file-property
+ (plist-get info :input-file) :numbering
+ (mapcar (lambda (entry)
+ (cons (org-split-string
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value (car entry))))
+ (cdr entry)))
+ (plist-get info :headline-numbering)))
+ ;; Return output unchanged.
+ output)
+
+(defun org-publish-resolve-external-fuzzy-link (file fuzzy)
+ "Return numbering for headline matching FUZZY search in FILE.
+
+Return value is a list of numbers, or nil. This function allows
+to resolve external fuzzy links like:
+
+ [[file.org::*fuzzy][description]]"
+ (when org-publish-cache
+ (cdr (assoc (org-split-string
+ (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
+ (org-publish-cache-get-file-property
+ (expand-file-name file) :numbering nil t)))))
+
+
+
+;;; Caching functions
+
+(defun org-publish-write-cache-file (&optional free-cache)
+ "Write `org-publish-cache' to file.
+If FREE-CACHE, empty the cache."
+ (unless org-publish-cache
+ (error "`org-publish-write-cache-file' called, but no cache present"))
+
+ (let ((cache-file (org-publish-cache-get ":cache-file:")))
+ (unless cache-file
+ (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
+ (with-temp-file cache-file
+ (let (print-level print-length)
+ (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
+ (maphash (lambda (k v)
+ (insert
+ (format (concat "(puthash %S "
+ (if (or (listp v) (symbolp v))
+ "'" "")
+ "%S org-publish-cache)\n") k v)))
+ org-publish-cache)))
+ (when free-cache (org-publish-reset-cache))))
+
+(defun org-publish-initialize-cache (project-name)
+ "Initialize the projects cache if not initialized yet and return it."
+
+ (unless project-name
+ (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
+
+ (unless (file-exists-p org-publish-timestamp-directory)
+ (make-directory org-publish-timestamp-directory t))
+ (unless (file-directory-p org-publish-timestamp-directory)
+ (error "Org publish timestamp: %s is not a directory"
+ org-publish-timestamp-directory))
+
+ (unless (and org-publish-cache
+ (string= (org-publish-cache-get ":project:") project-name))
+ (let* ((cache-file
+ (concat
+ (expand-file-name org-publish-timestamp-directory)
+ project-name ".cache"))
+ (cexists (file-exists-p cache-file)))
+
+ (when org-publish-cache (org-publish-reset-cache))
+
+ (if cexists (load-file cache-file)
+ (setq org-publish-cache
+ (make-hash-table :test 'equal :weakness nil :size 100))
+ (org-publish-cache-set ":project:" project-name)
+ (org-publish-cache-set ":cache-file:" cache-file))
+ (unless cexists (org-publish-write-cache-file nil))))
+ org-publish-cache)
+
+(defun org-publish-reset-cache ()
+ "Empty org-publish-cache and reset it nil."
+ (message "%s" "Resetting org-publish-cache")
+ (when (hash-table-p org-publish-cache)
+ (clrhash org-publish-cache))
+ (setq org-publish-cache nil))
+
+(defun org-publish-cache-file-needs-publishing
+ (filename &optional pub-dir pub-func base-dir)
+ "Check the timestamp of the last publishing of FILENAME.
+Return non-nil if the file needs publishing. Also check if
+any included files have been more recently published, so that
+the file including them will be republished as well."
+ (unless org-publish-cache
+ (error
+ "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+ (let* ((case-fold-search t)
+ (key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (pstamp (org-publish-cache-get key))
+ (org-inhibit-startup t)
+ (visiting (find-buffer-visiting filename))
+ included-files-ctime buf)
+
+ (when (equal (file-name-extension filename) "org")
+ (setq buf (find-file (expand-file-name filename)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
+ (let* ((included-file (expand-file-name (match-string 1))))
+ (add-to-list 'included-files-ctime
+ (org-publish-cache-ctime-of-src included-file) t))))
+ (unless visiting (kill-buffer buf)))
+ (if (null pstamp) t
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (or (< pstamp ctime)
+ (when included-files-ctime
+ (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
+ included-files-ctime))))))))))
+
+(defun org-publish-cache-set-file-property
+ (filename property value &optional project-name)
+ "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
+Use cache file of PROJECT-NAME. If the entry does not exist, it
+will be created. Return VALUE."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename)))
+ (if pl (progn (plist-put pl property value) value)
+ (org-publish-cache-get-file-property
+ filename property value nil project-name))))
+
+(defun org-publish-cache-get-file-property
+ (filename property &optional default no-create project-name)
+ "Return the value for a PROPERTY of file FILENAME in publishing cache.
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY
+or DEFAULT, if the value does not yet exist. If the entry will
+be created, unless NO-CREATE is not nil."
+ ;; Evtl. load the requested cache file:
+ (if project-name (org-publish-initialize-cache project-name))
+ (let ((pl (org-publish-cache-get filename)) retval)
+ (if pl
+ (if (plist-member pl property)
+ (setq retval (plist-get pl property))
+ (setq retval default))
+ ;; no pl yet:
+ (unless no-create
+ (org-publish-cache-set filename (list property default)))
+ (setq retval default))
+ retval))
+
+(defun org-publish-cache-get (key)
+ "Return the value stored in `org-publish-cache' for key KEY.
+Returns nil, if no value or nil is found, or the cache does not
+exist."
+ (unless org-publish-cache
+ (error "`org-publish-cache-get' called, but no cache present"))
+ (gethash key org-publish-cache))
+
+(defun org-publish-cache-set (key value)
+ "Store KEY VALUE pair in `org-publish-cache'.
+Returns value on success, else nil."
+ (unless org-publish-cache
+ (error "`org-publish-cache-set' called, but no cache present"))
+ (puthash key value org-publish-cache))
+
+(defun org-publish-cache-ctime-of-src (file)
+ "Get the ctime of FILE as an integer."
+ (let ((attr (file-attributes
+ (expand-file-name (or (file-symlink-p file) file)
+ (file-name-directory file)))))
+ (if (not attr) (error "No such file: \"%s\"" file)
+ (+ (lsh (car (nth 5 attr)) 16)
+ (cadr (nth 5 attr))))))
+
+
+(provide 'ox-publish)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-publish.el ends here
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
new file mode 100644
index 00000000000..67daf6f979e
--- /dev/null
+++ b/lisp/org/ox-texinfo.el
@@ -0,0 +1,1595 @@
+;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; See Org manual for details.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox)
+
+(defvar orgtbl-exp-regexp)
+
+
+
+;;; Define Back-End
+
+(org-export-define-backend 'texinfo
+ '((bold . org-texinfo-bold)
+ (center-block . org-texinfo-center-block)
+ (clock . org-texinfo-clock)
+ (code . org-texinfo-code)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (drawer . org-texinfo-drawer)
+ (dynamic-block . org-texinfo-dynamic-block)
+ (entity . org-texinfo-entity)
+ (example-block . org-texinfo-example-block)
+ (export-block . org-texinfo-export-block)
+ (export-snippet . org-texinfo-export-snippet)
+ (fixed-width . org-texinfo-fixed-width)
+ (footnote-definition . org-texinfo-footnote-definition)
+ (footnote-reference . org-texinfo-footnote-reference)
+ (headline . org-texinfo-headline)
+ (inline-src-block . org-texinfo-inline-src-block)
+ (inlinetask . org-texinfo-inlinetask)
+ (italic . org-texinfo-italic)
+ (item . org-texinfo-item)
+ (keyword . org-texinfo-keyword)
+ (line-break . org-texinfo-line-break)
+ (link . org-texinfo-link)
+ (paragraph . org-texinfo-paragraph)
+ (plain-list . org-texinfo-plain-list)
+ (plain-text . org-texinfo-plain-text)
+ (planning . org-texinfo-planning)
+ (property-drawer . org-texinfo-property-drawer)
+ (quote-block . org-texinfo-quote-block)
+ (quote-section . org-texinfo-quote-section)
+ (radio-target . org-texinfo-radio-target)
+ (section . org-texinfo-section)
+ (special-block . org-texinfo-special-block)
+ (src-block . org-texinfo-src-block)
+ (statistics-cookie . org-texinfo-statistics-cookie)
+ (subscript . org-texinfo-subscript)
+ (superscript . org-texinfo-superscript)
+ (table . org-texinfo-table)
+ (table-cell . org-texinfo-table-cell)
+ (table-row . org-texinfo-table-row)
+ (target . org-texinfo-target)
+ (template . org-texinfo-template)
+ (timestamp . org-texinfo-timestamp)
+ (verbatim . org-texinfo-verbatim)
+ (verse-block . org-texinfo-verse-block))
+ :export-block "TEXINFO"
+ :filters-alist
+ '((:filter-headline . org-texinfo-filter-section-blank-lines)
+ (:filter-parse-tree . org-texinfo--normalize-headlines)
+ (:filter-section . org-texinfo-filter-section-blank-lines))
+ :menu-entry
+ '(?i "Export to Texinfo"
+ ((?t "As TEXI file" org-texinfo-export-to-texinfo)
+ (?i "As INFO file" org-texinfo-export-to-info)))
+ :options-alist
+ '((:texinfo-filename "TEXINFO_FILENAME" nil nil t)
+ (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t)
+ (:texinfo-header "TEXINFO_HEADER" nil nil newline)
+ (:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline)
+ (:subtitle "SUBTITLE" nil nil newline)
+ (:subauthor "SUBAUTHOR" nil nil newline)
+ (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t)
+ (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t)
+ (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t)
+ (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)))
+
+
+
+;;; User Configurable Variables
+
+(defgroup org-export-texinfo nil
+ "Options for exporting Org mode files to Texinfo."
+ :tag "Org Export Texinfo"
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-export)
+
+;;;; Preamble
+
+(defcustom org-texinfo-coding-system nil
+ "Default document encoding for Texinfo output.
+
+If nil it will default to `buffer-file-coding-system'."
+ :group 'org-export-texinfo
+ :type 'coding-system)
+
+(defcustom org-texinfo-default-class "info"
+ "The default Texinfo class."
+ :group 'org-export-texinfo
+ :type '(string :tag "Texinfo class"))
+
+(defcustom org-texinfo-classes
+ '(("info"
+ "@documentencoding AUTO\n@documentlanguage AUTO"
+ ("@chapter %s" . "@unnumbered %s")
+ ("@section %s" . "@unnumberedsec %s")
+ ("@subsection %s" . "@unnumberedsubsec %s")
+ ("@subsubsection %s" . "@unnumberedsubsubsec %s")))
+ "Alist of Texinfo classes and associated header and structure.
+If #+TEXINFO_CLASS is set in the buffer, use its value and the
+associated information. Here is the structure of each cell:
+
+ (class-name
+ header-string
+ (numbered-section . unnumbered-section)
+ ...)
+
+
+The header string
+-----------------
+
+The header string is inserted in the header of the generated
+document, right after \"@setfilename\" and \"@settitle\"
+commands.
+
+If it contains the special string
+
+ \"@documentencoding AUTO\"
+
+\"AUTO\" will be replaced with an appropriate coding system. See
+`org-texinfo-coding-system' for more information. Likewise, if
+the string contains the special string
+
+ \"@documentlanguage AUTO\"
+
+\"AUTO\" will be replaced with the language defined in the
+buffer, through #+LANGUAGE keyword, or globally, with
+`org-export-default-language', which see.
+
+
+The sectioning structure
+------------------------
+
+The sectioning structure of the class is given by the elements
+following the header string. For each sectioning level, a number
+of strings is specified. A %s formatter is mandatory in each
+section string and will be replaced by the title of the section.
+
+Instead of a list of sectioning commands, you can also specify
+a function name. That function will be called with two
+parameters, the reduced) level of the headline, and a predicate
+non-nil when the headline should be numbered. It must return
+a format string in which the section title will be added."
+ :group 'org-export-texinfo
+ :version "24.4"
+ :package-version '(Org . "8.2")
+ :type '(repeat
+ (list (string :tag "Texinfo class")
+ (string :tag "Texinfo header")
+ (repeat :tag "Levels" :inline t
+ (choice
+ (cons :tag "Heading"
+ (string :tag " numbered")
+ (string :tag "unnumbered"))
+ (function :tag "Hook computing sectioning"))))))
+
+;;;; Headline
+
+(defcustom org-texinfo-format-headline-function 'ignore
+ "Function to format headline text.
+
+This function will be called with 5 arguments:
+TODO the todo keyword (string or nil).
+TODO-TYPE the type of todo (symbol: `todo', `done', nil)
+PRIORITY the priority of the headline (integer or nil)
+TEXT the main headline text (string).
+TAGS the tags as a list of strings (list of strings or nil).
+
+The function result will be used in the section format string.
+
+As an example, one could set the variable to the following, in
+order to reproduce the default set-up:
+
+\(defun org-texinfo-format-headline (todo todo-type priority text tags)
+ \"Default format function for a headline.\"
+ (concat (when todo
+ (format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
+ (when priority
+ (format \"\\\\framebox{\\\\#%c} \" priority))
+ text
+ (when tags
+ (format \"\\\\hfill{}\\\\textsc{%s}\"
+ (mapconcat \\='identity tags \":\"))))"
+ :group 'org-export-texinfo
+ :type 'function)
+
+;;;; Node listing (menu)
+
+(defcustom org-texinfo-node-description-column 32
+ "Column at which to start the description in the node listings.
+If a node title is greater than this length, the description will
+be placed after the end of the title."
+ :group 'org-export-texinfo
+ :type 'integer)
+
+;;;; Timestamps
+
+(defcustom org-texinfo-active-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to active timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to inactive timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+(defcustom org-texinfo-diary-timestamp-format "@emph{%s}"
+ "A printf format string to be applied to diary timestamps."
+ :group 'org-export-texinfo
+ :type 'string)
+
+;;;; Links
+
+(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}"
+ "Format string for links with unknown path type."
+ :group 'org-export-texinfo
+ :type 'string)
+
+;;;; Tables
+
+(defcustom org-texinfo-tables-verbatim nil
+ "When non-nil, tables are exported verbatim."
+ :group 'org-export-texinfo
+ :type 'boolean)
+
+(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)"
+ "Format string to display numbers in scientific notation.
+The format should have \"%s\" twice, for mantissa and exponent
+\(i.e. \"%s\\\\times10^{%s}\").
+
+When nil, no transformation is made."
+ :group 'org-export-texinfo
+ :type '(choice
+ (string :tag "Format string")
+ (const :tag "No formatting" nil)))
+
+(defcustom org-texinfo-def-table-markup "@samp"
+ "Default setting for @table environments."
+ :group 'org-export-texinfo
+ :type 'string)
+
+;;;; Text markup
+
+(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
+ (code . code)
+ (italic . "@emph{%s}")
+ (verbatim . verb)
+ (comment . "@c %s"))
+ "Alist of Texinfo expressions to convert text markup.
+
+The key must be a symbol among `bold', `italic' and `comment'.
+The value is a formatting string to wrap fontified text with.
+
+Value can also be set to the following symbols: `verb' and
+`code'. For the former, Org will use \"@verb\" to
+create a format string and select a delimiter character that
+isn't in the string. For the latter, Org will use \"@code\"
+to typeset and try to protect special characters.
+
+If no association can be found for a given markup, text will be
+returned as-is."
+ :group 'org-export-texinfo
+ :type 'alist
+ :options '(bold code italic verbatim comment))
+
+;;;; Drawers
+
+(defcustom org-texinfo-format-drawer-function
+ (lambda (name contents) contents)
+ "Function called to format a drawer in Texinfo code.
+
+The function must accept two parameters:
+ NAME the drawer name, like \"LOGBOOK\"
+ CONTENTS the contents of the drawer.
+
+The function should return the string to be exported.
+
+The default function simply returns the value of CONTENTS."
+ :group 'org-export-texinfo
+ :version "24.4"
+ :package-version '(Org . "8.2")
+ :type 'function)
+
+;;;; Inlinetasks
+
+(defcustom org-texinfo-format-inlinetask-function 'ignore
+ "Function called to format an inlinetask in Texinfo code.
+
+The function must accept six parameters:
+ TODO the todo keyword, as a string
+ TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
+ PRIORITY the inlinetask priority, as a string
+ NAME the inlinetask name, as a string.
+ TAGS the inlinetask tags, as a list of strings.
+ CONTENTS the contents of the inlinetask, as a string.
+
+The function should return the string to be exported.
+
+For example, the variable could be set to the following function
+in order to mimic default behavior:
+
+\(defun org-texinfo-format-inlinetask (todo type priority name tags contents)
+\"Format an inline task element for Texinfo export.\"
+ (let ((full-title
+ (concat
+ (when todo
+ (format \"@strong{%s} \" todo))
+ (when priority (format \"#%c \" priority))
+ title
+ (when tags
+ (format \":%s:\"
+ (mapconcat \\='identity tags \":\")))))
+ (format (concat \"@center %s\n\n\"
+ \"%s\"
+ \"\n\"))
+ full-title contents))"
+ :group 'org-export-texinfo
+ :type 'function)
+
+;;;; Compilation
+
+(defcustom org-texinfo-info-process '("makeinfo %f")
+ "Commands to process a Texinfo file to an INFO file.
+This is list of strings, each of them will be given to the shell
+as a command. %f in the command will be replaced by the full
+file name, %b by the file base name (i.e without extension) and
+%o by the base directory of the file."
+ :group 'org-export-texinfo
+ :type '(repeat :tag "Shell command sequence"
+ (string :tag "Shell command")))
+
+(defcustom org-texinfo-logfiles-extensions
+ '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr")
+ "The list of file extensions to consider as Texinfo logfiles.
+The logfiles will be remove if `org-texinfo-remove-logfiles' is
+non-nil."
+ :group 'org-export-texinfo
+ :type '(repeat (string :tag "Extension")))
+
+(defcustom org-texinfo-remove-logfiles t
+ "Non-nil means remove the logfiles produced by compiling a Texinfo file.
+By default, logfiles are files with these extensions: .aux, .toc,
+.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove,
+set `org-texinfo-logfiles-extensions'."
+ :group 'org-export-latex
+ :type 'boolean)
+
+;;; Constants
+
+(defconst org-texinfo-max-toc-depth 4
+ "Maximum depth for creation of detailed menu listings.
+Beyond this depth, Texinfo will not recognize the nodes and will
+cause errors. Left as a constant in case this value ever
+changes.")
+
+(defconst org-texinfo-supported-coding-systems
+ '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u")
+ "List of coding systems supported by Texinfo, as strings.
+Specified coding system will be matched against these strings.
+If two strings share the same prefix (e.g. \"ISO-8859-1\" and
+\"ISO-8859-15\"), the most specific one has to be listed first.")
+
+
+;;; Internal Functions
+
+(defun org-texinfo-filter-section-blank-lines (headline back-end info)
+ "Filter controlling number of blank lines after a section."
+ (let ((blanks (make-string 2 ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))
+
+(defun org-texinfo--normalize-headlines (tree back-end info)
+ "Normalize headlines in TREE.
+
+BACK-END is the symbol specifying back-end used for export. INFO
+is a plist used as a communication channel.
+
+Make sure every headline in TREE contains a section, since those
+are required to install a menu. Also put exactly one blank line
+at the end of each section.
+
+Return new tree."
+ (org-element-map tree 'headline
+ (lambda (hl)
+ (org-element-put-property hl :post-blank 1)
+ (let ((contents (org-element-contents hl)))
+ (when contents
+ (let ((first (org-element-map contents '(headline section)
+ #'identity info t)))
+ (unless (eq (org-element-type first) 'section)
+ (apply #'org-element-set-contents
+ hl
+ (cons `(section (:parent ,hl)) contents)))))))
+ info)
+ tree)
+
+(defun org-texinfo--find-verb-separator (s)
+ "Return a character not used in string S.
+This is used to choose a separator for constructs like \\verb."
+ (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
+ (loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
+
+(defun org-texinfo--text-markup (text markup)
+ "Format TEXT depending on MARKUP text markup.
+See `org-texinfo-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist))))
+ (cond
+ ;; No format string: Return raw text.
+ ((not fmt) text)
+ ((eq 'verb fmt)
+ (let ((separator (org-texinfo--find-verb-separator text)))
+ (concat "@verb{" separator text separator "}")))
+ ((eq 'code fmt)
+ (let ((start 0)
+ (rtn "")
+ char)
+ (while (string-match "[@{}]" text)
+ (setq char (match-string 0 text))
+ (if (> (match-beginning 0) 0)
+ (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
+ (setq text (substring text (1+ (match-beginning 0))))
+ (setq char (concat "@" char)
+ rtn (concat rtn char)))
+ (setq text (concat rtn text)
+ fmt "@code{%s}")
+ (format fmt text)))
+ ;; Else use format string.
+ (t (format fmt text)))))
+
+(defun org-texinfo--get-node (blob info)
+ "Return node or anchor associated to BLOB.
+BLOB is an element or object. INFO is a plist used as
+a communication channel. The function guarantees the node or
+anchor name is unique."
+ (let ((cache (plist-get info :texinfo-node-cache)))
+ (or (cdr (assq blob cache))
+ (let ((name
+ (org-texinfo--sanitize-node
+ (case (org-element-type blob)
+ (headline
+ (org-export-data (org-export-get-alt-title blob info) info))
+ ((radio-target target) (org-element-property :value blob))
+ (otherwise (or (org-element-property :name blob) ""))))))
+ ;; Ensure NAME is unique.
+ (while (rassoc name cache) (setq name (concat name "x")))
+ (plist-put info :texinfo-node-cache (cons (cons blob name) cache))
+ name))))
+
+;;;; Menu sanitizing
+
+(defun org-texinfo--sanitize-node (title)
+ "Bend string TITLE to node line requirements.
+Trim string and collapse multiple whitespace characters as they
+are not significant. Also remove the following characters: @
+{ } ( ) : . ,"
+ (replace-regexp-in-string
+ "[:,.]" ""
+ (replace-regexp-in-string
+ "\\`(\\(.*)\\)" "[\\1"
+ (org-trim (replace-regexp-in-string "[ \t]\\{2,\\}" " " title)))))
+
+;;;; Content sanitizing
+
+(defun org-texinfo--sanitize-content (text)
+ "Escape special characters in string TEXT.
+Special characters are: @ { }"
+ (replace-regexp-in-string "[@{}]" "@\\&" text))
+
+;;; Template
+
+(defun org-texinfo-template (contents info)
+ "Return complete document string after Texinfo conversion.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let ((title (org-export-data (plist-get info :title) info))
+ ;; Copying data is the contents of the first headline in
+ ;; parse tree with a non-nil copying property.
+ (copying (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (hl)
+ (and (org-not-nil (org-element-property :COPYING hl))
+ (org-element-contents hl)))
+ info t)))
+ (concat
+ "\\input texinfo @c -*- texinfo -*-\n"
+ "@c %**start of header\n"
+ (let ((file (or (plist-get info :texinfo-filename)
+ (let ((f (plist-get info :output-file)))
+ (and f (concat (file-name-sans-extension f) ".info"))))))
+ (and file (format "@setfilename %s\n" file)))
+ (format "@settitle %s\n" title)
+ ;; Insert class-defined header.
+ (org-element-normalize-string
+ (let ((header (nth 1 (assoc (plist-get info :texinfo-class)
+ org-texinfo-classes)))
+ (coding
+ (catch 'coding-system
+ (let ((case-fold-search t)
+ (name (symbol-name (or org-texinfo-coding-system
+ buffer-file-coding-system))))
+ (dolist (system org-texinfo-supported-coding-systems "UTF-8")
+ (when (org-string-match-p (regexp-quote system) name)
+ (throw 'coding-system system))))))
+ (language (plist-get info :language))
+ (case-fold-search nil))
+ ;; Auto coding system.
+ (replace-regexp-in-string
+ "^@documentencoding \\(AUTO\\)$"
+ coding
+ (replace-regexp-in-string
+ "^@documentlanguage \\(AUTO\\)$" language header t nil 1) t nil 1)))
+ ;; Additional header options set by #+TEXINFO_HEADER.
+ (let ((texinfo-header (plist-get info :texinfo-header)))
+ (and texinfo-header (org-element-normalize-string texinfo-header)))
+ "@c %**end of header\n\n"
+ ;; Additional options set by #+TEXINFO_POST_HEADER.
+ (let ((texinfo-post-header (plist-get info :texinfo-post-header)))
+ (and texinfo-post-header
+ (org-element-normalize-string texinfo-post-header)))
+ ;; Copying.
+ (and copying
+ (format "@copying\n%s@end copying\n\n"
+ (org-element-normalize-string
+ (org-export-data copying info))))
+ ;; Info directory information. Only supply if both title and
+ ;; category are provided.
+ (let ((dircat (plist-get info :texinfo-dircat))
+ (dirtitle
+ (let ((title (plist-get info :texinfo-dirtitle)))
+ (and title
+ (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title)
+ (format "* %s." (match-string 1 title))))))
+ (when (and dircat dirtitle)
+ (concat "@dircategory " dircat "\n"
+ "@direntry\n"
+ (let ((dirdesc
+ (let ((desc (plist-get info :texinfo-dirdesc)))
+ (cond ((not desc) nil)
+ ((org-string-match-p "\\.$" desc) desc)
+ (t (concat desc "."))))))
+ (if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle))
+ "\n"
+ "@end direntry\n\n")))
+ ;; Title
+ "@finalout\n"
+ "@titlepage\n"
+ (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title))
+ (let ((subtitle (plist-get info :subtitle)))
+ (and subtitle
+ (org-element-normalize-string
+ (replace-regexp-in-string "^" "@subtitle " subtitle))))
+ (when (plist-get info :with-author)
+ (concat
+ ;; Primary author.
+ (let ((author (org-string-nw-p
+ (org-export-data (plist-get info :author) info)))
+ (email (and (plist-get info :with-email)
+ (org-string-nw-p
+ (org-export-data (plist-get info :email) info)))))
+ (cond ((and author email)
+ (format "@author %s (@email{%s})\n" author email))
+ (author (format "@author %s\n" author))
+ (email (format "@author @email{%s}\n" email))))
+ ;; Other authors.
+ (let ((subauthor (plist-get info :subauthor)))
+ (and subauthor
+ (org-element-normalize-string
+ (replace-regexp-in-string "^" "@author " subauthor))))))
+ (and copying "@page\n@vskip 0pt plus 1filll\n@insertcopying\n")
+ "@end titlepage\n\n"
+ ;; Table of contents.
+ (and (plist-get info :with-toc) "@contents\n\n")
+ ;; Configure Top Node when not for Tex
+ "@ifnottex\n"
+ "@node Top\n"
+ (format "@top %s\n" title)
+ (and copying "@insertcopying\n")
+ "@end ifnottex\n\n"
+ ;; Menu.
+ (org-texinfo-make-menu (plist-get info :parse-tree) info 'master)
+ "\n"
+ ;; Document's body.
+ contents "\n"
+ ;; Creator.
+ (case (plist-get info :with-creator)
+ ((nil) nil)
+ (comment (format "@c %s\n" (plist-get info :creator)))
+ (otherwise (concat (plist-get info :creator) "\n")))
+ ;; Document end.
+ "@bye")))
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(defun org-texinfo-bold (bold contents info)
+ "Transcode BOLD from Org to Texinfo.
+CONTENTS is the text with bold markup. INFO is a plist holding
+contextual information."
+ (org-texinfo--text-markup contents 'bold))
+
+;;;; Center Block
+
+(defun org-texinfo-center-block (center-block contents info)
+ "Transcode a CENTER-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist used
+as a communication channel."
+ contents)
+
+;;;; Clock
+
+(defun org-texinfo-clock (clock contents info)
+ "Transcode a CLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "@noindent"
+ (format "@strong{%s} " org-clock-string)
+ (format org-texinfo-inactive-timestamp-format
+ (concat (org-translate-time
+ (org-element-property :raw-value
+ (org-element-property :value clock)))
+ (let ((time (org-element-property :duration clock)))
+ (and time (format " (%s)" time)))))
+ "@*"))
+
+;;;; Code
+
+(defun org-texinfo-code (code contents info)
+ "Transcode a CODE object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-texinfo--text-markup (org-element-property :value code) 'code))
+
+;;;; Drawer
+
+(defun org-texinfo-drawer (drawer contents info)
+ "Transcode a DRAWER element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((name (org-element-property :drawer-name drawer))
+ (output (funcall org-texinfo-format-drawer-function
+ name contents)))
+ output))
+
+;;;; Dynamic Block
+
+(defun org-texinfo-dynamic-block (dynamic-block contents info)
+ "Transcode a DYNAMIC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ contents)
+
+;;;; Entity
+
+(defun org-texinfo-entity (entity contents info)
+ "Transcode an ENTITY object from Org to Texinfo.
+CONTENTS are the definition itself. INFO is a plist holding
+contextual information."
+ (let ((ent (org-element-property :latex entity)))
+ (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent)))
+
+;;;; Example Block
+
+(defun org-texinfo-example-block (example-block contents info)
+ "Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "@verbatim\n%s@end verbatim"
+ (org-export-format-code-default example-block info)))
+
+;;;; Export Block
+
+(defun org-texinfo-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (string= (org-element-property :type export-block) "TEXINFO")
+ (org-remove-indentation (org-element-property :value export-block))))
+
+;;;; Export Snippet
+
+(defun org-texinfo-export-snippet (export-snippet contents info)
+ "Transcode a EXPORT-SNIPPET object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (when (eq (org-export-snippet-backend export-snippet) 'texinfo)
+ (org-element-property :value export-snippet)))
+
+;;;; Fixed Width
+
+(defun org-texinfo-fixed-width (fixed-width contents info)
+ "Transcode a FIXED-WIDTH element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (format "@example\n%s\n@end example"
+ (org-remove-indentation
+ (org-texinfo--sanitize-content
+ (org-element-property :value fixed-width)))))
+
+;;;; Footnote Reference
+
+(defun org-texinfo-footnote-reference (footnote contents info)
+ "Create a footnote reference for FOOTNOTE.
+
+FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a
+plist holding contextual information."
+ (let ((def (org-export-get-footnote-definition footnote info)))
+ (format "@footnote{%s}"
+ (org-trim (org-export-data def info)))))
+
+;;;; Headline
+
+(defun org-texinfo-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to Texinfo.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information."
+ (let* ((class (plist-get info :texinfo-class))
+ (level (org-export-get-relative-level headline info))
+ (numberedp (org-export-numbered-headline-p headline info))
+ (class-sectioning (assoc class org-texinfo-classes))
+ ;; Find the index type, if any.
+ (index (org-element-property :INDEX headline))
+ ;; Create node info, to insert it before section formatting.
+ ;; Use custom menu title if present.
+ (node (format "@node %s\n" (org-texinfo--get-node headline info)))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (if (org-not-nil (org-element-property :APPENDIX headline))
+ "@appendix %s\n%s"
+ (let ((sec (if (and (symbolp (nth 2 class-sectioning))
+ (fboundp (nth 2 class-sectioning)))
+ (funcall (nth 2 class-sectioning) level numberedp)
+ (nth (1+ level) class-sectioning))))
+ (cond
+ ;; No section available for that LEVEL.
+ ((not sec) nil)
+ ;; Section format directly returned by a function.
+ ((stringp sec) sec)
+ ;; (numbered-section . unnumbered-section)
+ ((not (consp (cdr sec)))
+ (concat (if (or index (not numberedp)) (cdr sec) (car sec))
+ "\n%s"))))))
+ (todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (full-text (if (not (eq org-texinfo-format-headline-function 'ignore))
+ ;; User-defined formatting function.
+ (funcall org-texinfo-format-headline-function
+ todo todo-type priority text tags)
+ ;; Default formatting.
+ (concat
+ (when todo
+ (format "@strong{%s} " todo))
+ (when priority (format "@emph{#%s} " priority))
+ text
+ (when tags
+ (format " :%s:"
+ (mapconcat 'identity tags ":"))))))
+ (contents (if (org-string-nw-p contents) (concat "\n" contents) "")))
+ (cond
+ ;; Case 1: This is a footnote section: ignore it.
+ ((org-element-property :footnote-section-p headline) nil)
+ ;; Case 2: This is the `copying' section: ignore it
+ ;; This is used elsewhere.
+ ((org-not-nil (org-element-property :COPYING headline)) nil)
+ ;; Case 3: An index. If it matches one of the known indexes,
+ ;; print it as such following the contents, otherwise
+ ;; print the contents and leave the index up to the user.
+ (index
+ (concat node
+ (format
+ section-fmt
+ full-text
+ (concat contents
+ (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
+ (concat "\n@printindex " index))))))
+ ;; Case 4: This is a deep sub-tree: export it as a list item.
+ ;; Also export as items headlines for which no section
+ ;; format has been found.
+ ((or (not section-fmt) (org-export-low-level-p headline info))
+ ;; Build the real contents of the sub-tree.
+ (concat (and (org-export-first-sibling-p headline info)
+ (format "@%s\n" (if numberedp 'enumerate 'itemize)))
+ "@item\n" full-text "\n"
+ contents
+ (if (org-export-last-sibling-p headline info)
+ (format "@end %s" (if numberedp 'enumerate 'itemize))
+ "\n")))
+ ;; Case 5: Standard headline. Export it as a section.
+ (t (concat node (format section-fmt full-text contents))))))
+
+;;;; Inline Src Block
+
+(defun org-texinfo-inline-src-block (inline-src-block contents info)
+ "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let* ((code (org-element-property :value inline-src-block))
+ (separator (org-texinfo--find-verb-separator code)))
+ (concat "@verb{" separator code separator "}")))
+
+;;;; Inlinetask
+
+(defun org-texinfo-inlinetask (inlinetask contents info)
+ "Transcode an INLINETASK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let ((title (org-export-data (org-element-property :title inlinetask) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (org-element-property :todo-type inlinetask))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask))))
+ ;; If `org-texinfo-format-inlinetask-function' is provided, call it
+ ;; with appropriate arguments.
+ (if (not (eq org-texinfo-format-inlinetask-function 'ignore))
+ (funcall org-texinfo-format-inlinetask-function
+ todo todo-type priority title tags contents)
+ ;; Otherwise, use a default template.
+ (let ((full-title
+ (concat
+ (when todo (format "@strong{%s} " todo))
+ (when priority (format "#%c " priority))
+ title
+ (when tags (format ":%s:"
+ (mapconcat 'identity tags ":"))))))
+ (format (concat "@center %s\n\n"
+ "%s"
+ "\n")
+ full-title contents)))))
+
+;;;; Italic
+
+(defun org-texinfo-italic (italic contents info)
+ "Transcode ITALIC from Org to Texinfo.
+CONTENTS is the text with italic markup. INFO is a plist holding
+contextual information."
+ (org-texinfo--text-markup contents 'italic))
+
+;;;; Item
+
+(defun org-texinfo-item (item contents info)
+ "Transcode an ITEM element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (format "@item%s\n%s"
+ (let ((tag (org-element-property :tag item)))
+ (if tag (concat " " (org-export-data tag info)) ""))
+ (or contents "")))
+
+;;;; Keyword
+
+(defun org-texinfo-keyword (keyword contents info)
+ "Transcode a KEYWORD element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((key (org-element-property :key keyword))
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string= key "TEXINFO") value)
+ ((string= key "CINDEX") (format "@cindex %s" value))
+ ((string= key "FINDEX") (format "@findex %s" value))
+ ((string= key "KINDEX") (format "@kindex %s" value))
+ ((string= key "PINDEX") (format "@pindex %s" value))
+ ((string= key "TINDEX") (format "@tindex %s" value))
+ ((string= key "VINDEX") (format "@vindex %s" value)))))
+
+;;;; Line Break
+
+(defun org-texinfo-line-break (line-break contents info)
+ "Transcode a LINE-BREAK object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "@*\n")
+
+;;;; Link
+
+(defun org-texinfo-link (link desc info)
+ "Transcode a LINK object from Org to Texinfo.
+
+DESC is the description part of the link, or the empty string.
+INFO is a plist holding contextual information. See
+`org-export-data'."
+ (let* ((type (org-element-property :type link))
+ (raw-path (org-element-property :path link))
+ ;; Ensure DESC really exists, or set it to nil.
+ (desc (and (not (string= desc "")) desc))
+ (path (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((and (string= type "file") (file-name-absolute-p raw-path))
+ (concat "file:" raw-path))
+ (t raw-path)))
+ protocol)
+ (cond
+ ((equal type "radio")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (if (not destination) desc
+ (format "@ref{%s,,%s}"
+ (org-texinfo--get-node destination info)
+ desc))))
+ ((member type '("custom-id" "id" "fuzzy"))
+ (let ((destination
+ (if (equal type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (case (org-element-type destination)
+ ((nil)
+ (format org-texinfo-link-with-unknown-path-format
+ (org-texinfo--sanitize-content path)))
+ ;; Id link points to an external file.
+ (plain-text
+ (if desc (format "@uref{file://%s,%s}" destination desc)
+ (format "@uref{file://%s}" destination)))
+ (headline
+ (format "@ref{%s,%s}"
+ (org-texinfo--get-node destination info)
+ (cond
+ (desc)
+ ((org-export-numbered-headline-p destination info)
+ (org-export-data
+ (org-element-property :title destination) info))
+ (t
+ (mapconcat
+ #'number-to-string
+ (org-export-get-headline-number destination info) ".")))))
+ (otherwise
+ (let ((topic
+ (or desc
+ (if (and (eq (org-element-type destination) 'headline)
+ (not (org-export-numbered-headline-p
+ destination info)))
+ (org-export-data
+ (org-element-property :title destination) info))
+ (let ((n (org-export-get-ordinal destination info)))
+ (cond
+ ((not n) nil)
+ ((integerp n) n)
+ (t (mapconcat #'number-to-string n ".")))))))
+ (when topic
+ (format "@ref{%s,,%s}"
+ (org-texinfo--get-node destination info)
+ topic)))))))
+ ((equal type "info")
+ (let* ((info-path (split-string path "[:#]"))
+ (info-manual (car info-path))
+ (info-node (or (cadr info-path) "top"))
+ (title (or desc "")))
+ (format "@ref{%s,%s,,%s,}" info-node title info-manual)))
+ ((string= type "mailto")
+ (format "@email{%s}"
+ (concat (org-texinfo--sanitize-content path)
+ (and desc (concat "," desc)))))
+ ((let ((protocol (nth 2 (assoc type org-link-protocols))))
+ (and (functionp protocol)
+ (funcall protocol (org-link-unescape path) desc 'texinfo))))
+ ;; External link with a description part.
+ ((and path desc) (format "@uref{%s,%s}" path desc))
+ ;; External link without a description part.
+ (path (format "@uref{%s}" path))
+ ;; No path, only description. Try to do something useful.
+ (t (format org-texinfo-link-with-unknown-path-format desc)))))
+
+
+;;;; Menu
+
+(defun org-texinfo-make-menu (scope info &optional master)
+ "Create the menu for inclusion in the Texinfo document.
+
+SCOPE is a headline or a full parse tree. INFO is the
+communication channel, as a plist.
+
+When optional argument MASTER is non-nil, generate a master menu,
+including detailed node listing."
+ (let ((menu (org-texinfo--build-menu scope info)))
+ (when (org-string-nw-p menu)
+ (org-element-normalize-string
+ (format
+ "@menu\n%s@end menu"
+ (concat menu
+ (when master
+ (let ((detailmenu
+ (org-texinfo--build-menu
+ scope info
+ (let ((toc-depth (plist-get info :with-toc)))
+ (if (wholenump toc-depth) toc-depth
+ org-texinfo-max-toc-depth)))))
+ (when (org-string-nw-p detailmenu)
+ (concat "\n@detailmenu\n"
+ "--- The Detailed Node Listing ---\n\n"
+ detailmenu
+ "@end detailmenu\n"))))))))))
+
+(defun org-texinfo--build-menu (scope info &optional level)
+ "Build menu for entries within SCOPE.
+SCOPE is a headline or a full parse tree. INFO is a plist
+containing contextual information. When optional argument LEVEL
+is an integer, build the menu recursively, down to this depth."
+ (cond
+ ((not level)
+ (org-texinfo--format-entries (org-texinfo--menu-entries scope info) info))
+ ((zerop level) nil)
+ (t
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (h)
+ (let ((entries (org-texinfo--menu-entries h info)))
+ (when entries
+ (concat
+ (format "%s\n\n%s\n"
+ (org-export-data (org-export-get-alt-title h info) info)
+ (org-texinfo--format-entries entries info))
+ (org-texinfo--build-menu h info (1- level))))))
+ (org-texinfo--menu-entries scope info) "")))))
+
+(defun org-texinfo--format-entries (entries info)
+ "Format all direct menu entries in SCOPE, as a string.
+SCOPE is either a headline or a full Org document. INFO is
+a plist containing contextual information."
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (h)
+ (let* ((title (org-export-data
+ (org-export-get-alt-title h info) info))
+ (node (org-texinfo--get-node h info))
+ (entry (concat "* " title ":"
+ (if (string= title node) ":"
+ (concat " " node ". "))))
+ (desc (org-element-property :DESCRIPTION h)))
+ (if (not desc) entry
+ (format (format "%%-%ds %%s" org-texinfo-node-description-column)
+ entry desc))))
+ entries "\n")))
+
+(defun org-texinfo--menu-entries (scope info)
+ "List direct children in SCOPE needing a menu entry.
+SCOPE is a headline or a full parse tree. INFO is a plist
+holding contextual information."
+ (let* ((cache (or (plist-get info :texinfo-entries-cache)
+ (plist-get (plist-put info :texinfo-entries-cache
+ (make-hash-table :test #'eq))
+ :texinfo-entries-cache)))
+ (cached-entries (gethash scope cache 'no-cache)))
+ (if (not (eq cached-entries 'no-cache)) cached-entries
+ (puthash scope
+ (org-element-map (org-element-contents scope) 'headline
+ (lambda (h)
+ (and (not (org-not-nil (org-element-property :COPYING h)))
+ (not (org-element-property :footnote-section-p h))
+ (not (org-export-low-level-p h info))
+ h))
+ info nil 'headline)
+ cache))))
+
+;;;; Paragraph
+
+(defun org-texinfo-paragraph (paragraph contents info)
+ "Transcode a PARAGRAPH element from Org to Texinfo.
+CONTENTS is the contents of the paragraph, as a string. INFO is
+the plist used as a communication channel."
+ contents)
+
+;;;; Plain List
+
+(defun org-texinfo-plain-list (plain-list contents info)
+ "Transcode a PLAIN-LIST element from Org to Texinfo.
+CONTENTS is the contents of the list. INFO is a plist holding
+contextual information."
+ (let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
+ (indic (or (plist-get attr :indic) org-texinfo-def-table-markup))
+ (table-type (plist-get attr :table-type))
+ (type (org-element-property :type plain-list))
+ (list-type (cond
+ ((eq type 'ordered) "enumerate")
+ ((eq type 'unordered) "itemize")
+ ((member table-type '("ftable" "vtable")) table-type)
+ (t "table"))))
+ (format "@%s\n%s@end %s"
+ (if (eq type 'descriptive) (concat list-type " " indic) list-type)
+ contents
+ list-type)))
+
+;;;; Plain Text
+
+(defun org-texinfo-plain-text (text info)
+ "Transcode a TEXT string from Org to Texinfo.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ ;; First protect @, { and }.
+ (let ((output (org-texinfo--sanitize-content text)))
+ ;; Activate smart quotes. Be sure to provide original TEXT string
+ ;; since OUTPUT may have been modified.
+ (when (plist-get info :with-smart-quotes)
+ (setq output
+ (org-export-activate-smart-quotes output :texinfo info text)))
+ ;; LaTeX into @LaTeX{} and TeX into @TeX{}
+ (let ((case-fold-search nil)
+ (start 0))
+ (while (string-match "\\(\\(?:La\\)?TeX\\)" output start)
+ (setq output (replace-match
+ (format "@%s{}" (match-string 1 output)) nil t output)
+ start (match-end 0))))
+ ;; Convert special strings.
+ (when (plist-get info :with-special-strings)
+ (while (string-match (regexp-quote "...") output)
+ (setq output (replace-match "@dots{}" nil t output))))
+ ;; Handle break preservation if required.
+ (when (plist-get info :preserve-breaks)
+ (setq output (replace-regexp-in-string
+ "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output)))
+ ;; Return value.
+ output))
+
+;;;; Planning
+
+(defun org-texinfo-planning (planning contents info)
+ "Transcode a PLANNING element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (concat
+ "@noindent"
+ (mapconcat
+ 'identity
+ (delq nil
+ (list
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat
+ (format "@strong{%s} " org-closed-string)
+ (format org-texinfo-inactive-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value closed))))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat
+ (format "@strong{%s} " org-deadline-string)
+ (format org-texinfo-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value deadline))))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat
+ (format "@strong{%s} " org-scheduled-string)
+ (format org-texinfo-active-timestamp-format
+ (org-translate-time
+ (org-element-property :raw-value scheduled))))))))
+ " ")
+ "@*"))
+
+;;;; Property Drawer
+
+(defun org-texinfo-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ ;; The property drawer isn't exported but we want separating blank
+ ;; lines nonetheless.
+ "")
+
+;;;; Quote Block
+
+(defun org-texinfo-quote-block (quote-block contents info)
+ "Transcode a QUOTE-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist
+holding contextual information."
+ (let* ((title (org-element-property :name quote-block))
+ (start-quote (concat "@quotation"
+ (if title
+ (format " %s" title)))))
+ (format "%s\n%s@end quotation" start-quote contents)))
+
+;;;; Quote Section
+
+(defun org-texinfo-quote-section (quote-section contents info)
+ "Transcode a QUOTE-SECTION element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (let ((value (org-remove-indentation
+ (org-element-property :value quote-section))))
+ (when value (format "@verbatim\n%s@end verbatim" value))))
+
+;;;; Radio Target
+
+(defun org-texinfo-radio-target (radio-target text info)
+ "Transcode a RADIO-TARGET object from Org to Texinfo.
+TEXT is the text of the target. INFO is a plist holding
+contextual information."
+ (format "@anchor{%s}%s"
+ (org-export-solidify-link-text
+ (org-element-property :value radio-target))
+ text))
+
+;;;; Section
+
+(defun org-texinfo-section (section contents info)
+ "Transcode a SECTION element from Org to Texinfo.
+CONTENTS holds the contents of the section. INFO is a plist
+holding contextual information."
+ (concat contents
+ (let ((parent (org-export-get-parent-headline section)))
+ (and parent (org-texinfo-make-menu parent info)))))
+
+;;;; Special Block
+
+(defun org-texinfo-special-block (special-block contents info)
+ "Transcode a SPECIAL-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the block. INFO is a plist used
+as a communication channel."
+ contents)
+
+;;;; Src Block
+
+(defun org-texinfo-src-block (src-block contents info)
+ "Transcode a SRC-BLOCK element from Org to Texinfo.
+CONTENTS holds the contents of the item. INFO is a plist holding
+contextual information."
+ (let ((lispp (org-string-match-p "lisp"
+ (org-element-property :language src-block)))
+ (code (org-texinfo--sanitize-content
+ (org-export-format-code-default src-block info))))
+ (format (if lispp "@lisp\n%s@end lisp" "@example\n%s@end example") code)))
+
+;;;; Statistics Cookie
+
+(defun org-texinfo-statistics-cookie (statistics-cookie contents info)
+ "Transcode a STATISTICS-COOKIE object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (org-element-property :value statistics-cookie))
+
+;;;; Subscript
+
+(defun org-texinfo-subscript (subscript contents info)
+ "Transcode a SUBSCRIPT object from Org to Texinfo.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "@math{_%s}" contents))
+
+;;;; Superscript
+
+(defun org-texinfo-superscript (superscript contents info)
+ "Transcode a SUPERSCRIPT object from Org to Texinfo.
+CONTENTS is the contents of the object. INFO is a plist holding
+contextual information."
+ (format "@math{^%s}" contents))
+
+;;;; Table
+
+(defun org-texinfo-table (table contents info)
+ "Transcode a TABLE element from Org to Texinfo.
+CONTENTS is the contents of the table. INFO is a plist holding
+contextual information."
+ (if (eq (org-element-property :type table) 'table.el)
+ (format "@verbatim\n%s@end verbatim"
+ (org-element-normalize-string
+ (org-element-property :value table)))
+ (let* ((col-width (org-export-read-attribute :attr_texinfo table :columns))
+ (columns
+ (if col-width (format "@columnfractions %s" col-width)
+ (org-texinfo-table-column-widths table info))))
+ (format "@multitable %s\n%s@end multitable"
+ columns
+ contents))))
+
+(defun org-texinfo-table-column-widths (table info)
+ "Determine the largest table cell in each column to process alignment.
+TABLE is the table element to transcode. INFO is a plist used as
+a communication channel."
+ (let ((widths (make-vector (cdr (org-export-table-dimensions table info)) 0)))
+ (org-element-map table 'table-row
+ (lambda (row)
+ (let ((idx 0))
+ (org-element-map row 'table-cell
+ (lambda (cell)
+ ;; Length of the cell in the original buffer is only an
+ ;; approximation of the length of the cell in the
+ ;; output. It can sometimes fail (e.g. it considers
+ ;; "/a/" being larger than "ab").
+ (let ((w (- (org-element-property :contents-end cell)
+ (org-element-property :contents-begin cell))))
+ (aset widths idx (max w (aref widths idx))))
+ (incf idx))
+ info)))
+ info)
+ (format "{%s}" (mapconcat (lambda (w) (make-string w ?a)) widths "} {"))))
+
+;;;; Table Cell
+
+(defun org-texinfo-table-cell (table-cell contents info)
+ "Transcode a TABLE-CELL element from Org to Texinfo.
+CONTENTS is the cell contents. INFO is a plist used as
+a communication channel."
+ (concat (if (and contents
+ org-texinfo-table-scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format org-texinfo-table-scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents)
+ (when (org-export-get-next-element table-cell info) "\n@tab ")))
+
+;;;; Table Row
+
+(defun org-texinfo-table-row (table-row contents info)
+ "Transcode a TABLE-ROW element from Org to Texinfo.
+CONTENTS is the contents of the row. INFO is a plist used as
+a communication channel."
+ ;; Rules are ignored since table separators are deduced from
+ ;; borders of the current row.
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let ((rowgroup-tag
+ (if (and (= 1 (org-export-table-row-group table-row info))
+ (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info))
+ "@headitem "
+ "@item ")))
+ (concat rowgroup-tag contents "\n"))))
+
+;;;; Target
+
+(defun org-texinfo-target (target contents info)
+ "Transcode a TARGET object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "@anchor{%s}"
+ (org-export-solidify-link-text (org-element-property :value target))))
+
+;;;; Timestamp
+
+(defun org-texinfo-timestamp (timestamp contents info)
+ "Transcode a TIMESTAMP object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (let ((value (org-texinfo-plain-text
+ (org-timestamp-translate timestamp) info)))
+ (case (org-element-property :type timestamp)
+ ((active active-range)
+ (format org-texinfo-active-timestamp-format value))
+ ((inactive inactive-range)
+ (format org-texinfo-inactive-timestamp-format value))
+ (t (format org-texinfo-diary-timestamp-format value)))))
+
+;;;; Verbatim
+
+(defun org-texinfo-verbatim (verbatim contents info)
+ "Transcode a VERBATIM object from Org to Texinfo.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim))
+
+;;;; Verse Block
+
+(defun org-texinfo-verse-block (verse-block contents info)
+ "Transcode a VERSE-BLOCK element from Org to Texinfo.
+CONTENTS is verse block contents. INFO is a plist holding
+contextual information."
+ (format "@display\n%s@end display" contents))
+
+
+;;; Interactive functions
+
+(defun org-texinfo-export-to-texinfo
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to a Texinfo file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".texi" subtreep))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist)))
+
+(defun org-texinfo-export-to-info
+ (&optional async subtreep visible-only body-only ext-plist)
+ "Export current buffer to Texinfo then process through to INFO.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only write code
+between \"\\begin{document}\" and \"\\end{document}\".
+
+EXT-PLIST, when provided, is a property list with external
+parameters overriding Org default settings, but still inferior to
+file-local settings.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+Return INFO file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".texi" subtreep))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-texinfo-compile file)))))
+
+;;;###autoload
+(defun org-texinfo-publish-to-texinfo (plist filename pub-dir)
+ "Publish an org file to Texinfo.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'texinfo filename ".texi" plist pub-dir))
+
+;;;###autoload
+(defun org-texinfo-convert-region-to-texinfo ()
+ "Assume the current region has org-mode syntax, and convert it to Texinfo.
+This can be used in any buffer. For example, you can write an
+itemized list in org-mode syntax in an Texinfo buffer and use
+this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'texinfo))
+
+(defun org-texinfo-compile (file)
+ "Compile a texinfo file.
+
+FILE is the name of the file being compiled. Processing is
+done through the command specified in `org-texinfo-info-process'.
+
+Return INFO file name or an error if it couldn't be produced."
+ (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
+ (full-name (file-truename file))
+ (out-dir (file-name-directory file))
+ ;; Properly set working directory for compilation.
+ (default-directory (if (file-name-absolute-p file)
+ (file-name-directory full-name)
+ default-directory))
+ errors)
+ (message "Processing Texinfo file %s..." file)
+ (save-window-excursion
+ ;; Replace %b, %f and %o with appropriate values in each command
+ ;; before applying it. Output is redirected to "*Org INFO
+ ;; Texinfo Output*" buffer.
+ (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*")))
+ (dolist (command org-texinfo-info-process)
+ (shell-command
+ (replace-regexp-in-string
+ "%b" (shell-quote-argument base-name)
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir) command t t) t t) t t)
+ outbuf))
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-texinfo-collect-errors outbuf)))
+ (let ((infofile (concat out-dir base-name ".info")))
+ ;; Check for process failure. Provide collected errors if
+ ;; possible.
+ (if (not (file-exists-p infofile))
+ (error "INFO file %s wasn't produced%s" infofile
+ (if errors (concat ": " errors) ""))
+ ;; Else remove log files, when specified, and signal end of
+ ;; process to user, along with any error encountered.
+ (when org-texinfo-remove-logfiles
+ (dolist (ext org-texinfo-logfiles-extensions)
+ (let ((file (concat out-dir base-name "." ext)))
+ (when (file-exists-p file) (delete-file file)))))
+ (message (concat "Process completed"
+ (if (not errors) "."
+ (concat " with errors: " errors)))))
+ ;; Return output file name.
+ infofile))))
+
+(defun org-texinfo-collect-errors (buffer)
+ "Collect some kind of errors from \"makeinfo\" command output.
+
+BUFFER is the buffer containing output.
+
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ ;; Find final "makeinfo" run.
+ (when t
+ (let ((case-fold-search t)
+ (errors ""))
+ (when (save-excursion
+ (re-search-forward "perhaps incorrect sectioning?" nil t))
+ (setq errors (concat errors " [incorrect sectioning]")))
+ (when (save-excursion
+ (re-search-forward "missing close brace" nil t))
+ (setq errors (concat errors " [syntax error]")))
+ (when (save-excursion
+ (re-search-forward "Unknown command" nil t))
+ (setq errors (concat errors " [undefined @command]")))
+ (when (save-excursion
+ (re-search-forward "No matching @end" nil t))
+ (setq errors (concat errors " [block incomplete]")))
+ (when (save-excursion
+ (re-search-forward "requires a sectioning" nil t))
+ (setq errors (concat errors " [invalid section command]")))
+ (when (save-excursion
+ (re-search-forward "\\[unexpected\ ]" nil t))
+ (setq errors (concat errors " [unexpected error]")))
+ (when (save-excursion
+ (re-search-forward "misplaced " nil t))
+ (setq errors (concat errors " [syntax error]")))
+ (and (org-string-nw-p errors) (org-trim errors)))))))
+
+
+(provide 'ox-texinfo)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-texinfo.el ends here
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
new file mode 100644
index 00000000000..2fa03866281
--- /dev/null
+++ b/lisp/org/ox.el
@@ -0,0 +1,6241 @@
+;;; ox.el --- Generic Export Engine for Org Mode
+
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This library implements a generic export engine for Org, built on
+;; its syntactical parser: Org Elements.
+;;
+;; Besides that parser, the generic exporter is made of three distinct
+;; parts:
+;;
+;; - The communication channel consists in a property list, which is
+;; created and updated during the process. Its use is to offer
+;; every piece of information, would it be about initial environment
+;; or contextual data, all in a single place. The exhaustive list
+;; of properties is given in "The Communication Channel" section of
+;; this file.
+;;
+;; - The transcoder walks the parse tree, ignores or treat as plain
+;; text elements and objects according to export options, and
+;; eventually calls back-end specific functions to do the real
+;; transcoding, concatenating their return value along the way.
+;;
+;; - The filter system is activated at the very beginning and the very
+;; end of the export process, and each time an element or an object
+;; has been converted. It is the entry point to fine-tune standard
+;; output from back-end transcoders. See "The Filter System"
+;; section for more information.
+;;
+;; The core function is `org-export-as'. It returns the transcoded
+;; buffer as a string.
+;;
+;; An export back-end is defined with `org-export-define-backend'.
+;; This function can also support specific buffer keywords, OPTION
+;; keyword's items and filters. Refer to function's documentation for
+;; more information.
+;;
+;; If the new back-end shares most properties with another one,
+;; `org-export-define-derived-backend' can be used to simplify the
+;; process.
+;;
+;; Any back-end can define its own variables. Among them, those
+;; customizable should belong to the `org-export-BACKEND' group.
+;;
+;; Tools for common tasks across back-ends are implemented in the
+;; following part of the file.
+;;
+;; Then, a wrapper macro for asynchronous export,
+;; `org-export-async-start', along with tools to display results. are
+;; given in the penultimate part.
+;;
+;; Eventually, a dispatcher (`org-export-dispatch') for standard
+;; back-ends is provided in the last one.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'org-element)
+(require 'org-macro)
+(require 'ob-exp)
+
+(declare-function org-publish "ox-publish" (project &optional force async))
+(declare-function org-publish-all "ox-publish" (&optional force async))
+(declare-function
+ org-publish-current-file "ox-publish" (&optional force async))
+(declare-function org-publish-current-project "ox-publish"
+ (&optional force async))
+
+(defvar org-publish-project-alist)
+(defvar org-table-number-fraction)
+(defvar org-table-number-regexp)
+
+
+
+;;; Internal Variables
+;;
+;; Among internal variables, the most important is
+;; `org-export-options-alist'. This variable define the global export
+;; options, shared between every exporter, and how they are acquired.
+
+(defconst org-export-max-depth 19
+ "Maximum nesting depth for headlines, counting from 0.")
+
+(defconst org-export-options-alist
+ '((:author "AUTHOR" nil user-full-name t)
+ (:creator "CREATOR" nil org-export-creator-string)
+ (:date "DATE" nil nil t)
+ (:description "DESCRIPTION" nil nil newline)
+ (:email "EMAIL" nil user-mail-address t)
+ (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split)
+ (:headline-levels nil "H" org-export-headline-levels)
+ (:keywords "KEYWORDS" nil nil space)
+ (:language "LANGUAGE" nil org-export-default-language t)
+ (:preserve-breaks nil "\\n" org-export-preserve-breaks)
+ (:section-numbers nil "num" org-export-with-section-numbers)
+ (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
+ (:time-stamp-file nil "timestamp" org-export-time-stamp-file)
+ (:title "TITLE" nil nil space)
+ (:with-archived-trees nil "arch" org-export-with-archived-trees)
+ (:with-author nil "author" org-export-with-author)
+ (:with-clocks nil "c" org-export-with-clocks)
+ (:with-creator nil "creator" org-export-with-creator)
+ (:with-date nil "date" org-export-with-date)
+ (:with-drawers nil "d" org-export-with-drawers)
+ (:with-email nil "email" org-export-with-email)
+ (:with-emphasize nil "*" org-export-with-emphasize)
+ (:with-entities nil "e" org-export-with-entities)
+ (:with-fixed-width nil ":" org-export-with-fixed-width)
+ (:with-footnotes nil "f" org-export-with-footnotes)
+ (:with-inlinetasks nil "inline" org-export-with-inlinetasks)
+ (:with-latex nil "tex" org-export-with-latex)
+ (:with-planning nil "p" org-export-with-planning)
+ (:with-priority nil "pri" org-export-with-priority)
+ (:with-smart-quotes nil "'" org-export-with-smart-quotes)
+ (:with-special-strings nil "-" org-export-with-special-strings)
+ (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
+ (:with-sub-superscript nil "^" org-export-with-sub-superscripts)
+ (:with-toc nil "toc" org-export-with-toc)
+ (:with-tables nil "|" org-export-with-tables)
+ (:with-tags nil "tags" org-export-with-tags)
+ (:with-tasks nil "tasks" org-export-with-tasks)
+ (:with-timestamps nil "<" org-export-with-timestamps)
+ (:with-todo-keywords nil "todo" org-export-with-todo-keywords))
+ "Alist between export properties and ways to set them.
+
+The CAR of the alist is the property name, and the CDR is a list
+like (KEYWORD OPTION DEFAULT BEHAVIOR) where:
+
+KEYWORD is a string representing a buffer keyword, or nil. Each
+ property defined this way can also be set, during subtree
+ export, through a headline property named after the keyword
+ with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE
+ property).
+OPTION is a string that could be found in an #+OPTIONS: line.
+DEFAULT is the default value for the property.
+BEHAVIOR determines how Org should handle multiple keywords for
+ the same property. It is a symbol among:
+ nil Keep old value and discard the new one.
+ t Replace old value with the new one.
+ `space' Concatenate the values, separating them with a space.
+ `newline' Concatenate the values, separating them with
+ a newline.
+ `split' Split values at white spaces, and cons them to the
+ previous list.
+
+Values set through KEYWORD and OPTION have precedence over
+DEFAULT.
+
+All these properties should be back-end agnostic. Back-end
+specific properties are set through `org-export-define-backend'.
+Properties redefined there have precedence over these.")
+
+(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS")
+ "List of in-buffer keywords that require special treatment.
+These keywords are not directly associated to a property. The
+way they are handled must be hard-coded into
+`org-export--get-inbuffer-options' function.")
+
+(defconst org-export-filters-alist
+ '((:filter-bold . org-export-filter-bold-functions)
+ (:filter-babel-call . org-export-filter-babel-call-functions)
+ (:filter-center-block . org-export-filter-center-block-functions)
+ (:filter-clock . org-export-filter-clock-functions)
+ (:filter-code . org-export-filter-code-functions)
+ (:filter-comment . org-export-filter-comment-functions)
+ (:filter-comment-block . org-export-filter-comment-block-functions)
+ (:filter-diary-sexp . org-export-filter-diary-sexp-functions)
+ (:filter-drawer . org-export-filter-drawer-functions)
+ (:filter-dynamic-block . org-export-filter-dynamic-block-functions)
+ (:filter-entity . org-export-filter-entity-functions)
+ (:filter-example-block . org-export-filter-example-block-functions)
+ (:filter-export-block . org-export-filter-export-block-functions)
+ (:filter-export-snippet . org-export-filter-export-snippet-functions)
+ (:filter-final-output . org-export-filter-final-output-functions)
+ (:filter-fixed-width . org-export-filter-fixed-width-functions)
+ (:filter-footnote-definition . org-export-filter-footnote-definition-functions)
+ (:filter-footnote-reference . org-export-filter-footnote-reference-functions)
+ (:filter-headline . org-export-filter-headline-functions)
+ (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions)
+ (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions)
+ (:filter-inline-src-block . org-export-filter-inline-src-block-functions)
+ (:filter-inlinetask . org-export-filter-inlinetask-functions)
+ (:filter-italic . org-export-filter-italic-functions)
+ (:filter-item . org-export-filter-item-functions)
+ (:filter-keyword . org-export-filter-keyword-functions)
+ (:filter-latex-environment . org-export-filter-latex-environment-functions)
+ (:filter-latex-fragment . org-export-filter-latex-fragment-functions)
+ (:filter-line-break . org-export-filter-line-break-functions)
+ (:filter-link . org-export-filter-link-functions)
+ (:filter-node-property . org-export-filter-node-property-functions)
+ (:filter-options . org-export-filter-options-functions)
+ (:filter-paragraph . org-export-filter-paragraph-functions)
+ (:filter-parse-tree . org-export-filter-parse-tree-functions)
+ (:filter-plain-list . org-export-filter-plain-list-functions)
+ (:filter-plain-text . org-export-filter-plain-text-functions)
+ (:filter-planning . org-export-filter-planning-functions)
+ (:filter-property-drawer . org-export-filter-property-drawer-functions)
+ (:filter-quote-block . org-export-filter-quote-block-functions)
+ (:filter-quote-section . org-export-filter-quote-section-functions)
+ (:filter-radio-target . org-export-filter-radio-target-functions)
+ (:filter-section . org-export-filter-section-functions)
+ (:filter-special-block . org-export-filter-special-block-functions)
+ (:filter-src-block . org-export-filter-src-block-functions)
+ (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions)
+ (:filter-strike-through . org-export-filter-strike-through-functions)
+ (:filter-subscript . org-export-filter-subscript-functions)
+ (:filter-superscript . org-export-filter-superscript-functions)
+ (:filter-table . org-export-filter-table-functions)
+ (:filter-table-cell . org-export-filter-table-cell-functions)
+ (:filter-table-row . org-export-filter-table-row-functions)
+ (:filter-target . org-export-filter-target-functions)
+ (:filter-timestamp . org-export-filter-timestamp-functions)
+ (:filter-underline . org-export-filter-underline-functions)
+ (:filter-verbatim . org-export-filter-verbatim-functions)
+ (:filter-verse-block . org-export-filter-verse-block-functions))
+ "Alist between filters properties and initial values.
+
+The key of each association is a property name accessible through
+the communication channel. Its value is a configurable global
+variable defining initial filters.
+
+This list is meant to install user specified filters. Back-end
+developers may install their own filters using
+`org-export-define-backend'. Filters defined there will always
+be prepended to the current list, so they always get applied
+first.")
+
+(defconst org-export-default-inline-image-rule
+ `(("file" .
+ ,(format "\\.%s\\'"
+ (regexp-opt
+ '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm"
+ "xpm" "pbm" "pgm" "ppm") t))))
+ "Default rule for link matching an inline image.
+This rule applies to links with no description. By default, it
+will be considered as an inline image if it targets a local file
+whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\",
+\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\".
+See `org-export-inline-image-p' for more information about
+rules.")
+
+(defvar org-export-async-debug nil
+ "Non-nil means asynchronous export process should leave data behind.
+
+This data is found in the appropriate \"*Org Export Process*\"
+buffer, and in files prefixed with \"org-export-process\" and
+located in `temporary-file-directory'.
+
+When non-nil, it will also set `debug-on-error' to a non-nil
+value in the external process.")
+
+(defvar org-export-stack-contents nil
+ "Record asynchronously generated export results and processes.
+This is an alist: its CAR is the source of the
+result (destination file or buffer for a finished process,
+original buffer for a running one) and its CDR is a list
+containing the back-end used, as a symbol, and either a process
+or the time at which it finished. It is used to build the menu
+from `org-export-stack'.")
+
+(defvar org-export--registered-backends nil
+ "List of backends currently available in the exporter.
+This variable is set with `org-export-define-backend' and
+`org-export-define-derived-backend' functions.")
+
+(defvar org-export-dispatch-last-action nil
+ "Last command called from the dispatcher.
+The value should be a list. Its CAR is the action, as a symbol,
+and its CDR is a list of export options.")
+
+(defvar org-export-dispatch-last-position (make-marker)
+ "The position where the last export command was created using the dispatcher.
+This marker will be used with `C-u C-c C-e' to make sure export repetition
+uses the same subtree if the previous command was restricted to a subtree.")
+
+;; For compatibility with Org < 8
+(defvar org-export-current-backend nil
+ "Name, if any, of the back-end used during an export process.
+
+Its value is a symbol such as `html', `latex', `ascii', or nil if
+the back-end is anonymous (see `org-export-create-backend') or if
+there is no export process in progress.
+
+It can be used to teach Babel blocks how to act differently
+according to the back-end used.")
+
+
+;;; User-configurable Variables
+;;
+;; Configuration for the masses.
+;;
+;; They should never be accessed directly, as their value is to be
+;; stored in a property list (cf. `org-export-options-alist').
+;; Back-ends will read their value from there instead.
+
+(defgroup org-export nil
+ "Options for exporting Org mode files."
+ :tag "Org Export"
+ :group 'org)
+
+(defgroup org-export-general nil
+ "General options for export engine."
+ :tag "Org Export General"
+ :group 'org-export)
+
+(defcustom org-export-with-archived-trees 'headline
+ "Whether sub-trees with the ARCHIVE tag should be exported.
+
+This can have three different values:
+nil Do not export, pretend this tree is not present.
+t Do export the entire tree.
+`headline' Only export the headline, but skip the tree below it.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"arch:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Not at all" nil)
+ (const :tag "Headline only" headline)
+ (const :tag "Entirely" t)))
+
+(defcustom org-export-with-author t
+ "Non-nil means insert author name into the exported file.
+This option can also be set with the OPTIONS keyword,
+e.g. \"author:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-clocks nil
+ "Non-nil means export CLOCK keywords.
+This option can also be set with the OPTIONS keyword,
+e.g. \"c:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-creator 'comment
+ "Non-nil means the postamble should contain a creator sentence.
+
+The sentence can be set in `org-export-creator-string' and
+defaults to \"Generated by Org mode XX in Emacs XXX.\".
+
+If the value is `comment' insert it as a comment."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "No creator sentence" nil)
+ (const :tag "Sentence as a comment" comment)
+ (const :tag "Insert the sentence" t)))
+
+(defcustom org-export-with-date t
+ "Non-nil means insert date in the exported document.
+This option can also be set with the OPTIONS keyword,
+e.g. \"date:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-date-timestamp-format nil
+ "Time-stamp format string to use for DATE keyword.
+
+The format string, when specified, only applies if date consists
+in a single time-stamp. Otherwise its value will be ignored.
+
+See `format-time-string' for details on how to build this
+string."
+ :group 'org-export-general
+ :type '(choice
+ (string :tag "Time-stamp format string")
+ (const :tag "No format string" nil)))
+
+(defcustom org-export-creator-string
+ (format "Emacs %s (Org mode %s)"
+ emacs-version
+ (if (fboundp 'org-version) (org-version) "unknown version"))
+ "Information about the creator of the document.
+This option can also be set on with the CREATOR keyword."
+ :group 'org-export-general
+ :type '(string :tag "Creator string"))
+
+(defcustom org-export-with-drawers '(not "LOGBOOK")
+ "Non-nil means export contents of standard drawers.
+
+When t, all drawers are exported. This may also be a list of
+drawer names to export. If that list starts with `not', only
+drawers with such names will be ignored.
+
+This variable doesn't apply to properties drawers.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"d:nil\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "All drawers" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected drawers"
+ (string :tag "Drawer name"))
+ (list :tag "Ignored drawers"
+ (const :format "" not)
+ (repeat :tag "Specify names of drawers to ignore during export"
+ :inline t
+ (string :tag "Drawer name")))))
+
+(defcustom org-export-with-email nil
+ "Non-nil means insert author email into the exported file.
+This option can also be set with the OPTIONS keyword,
+e.g. \"email:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-emphasize t
+ "Non-nil means interpret *word*, /word/, _word_ and +word+.
+
+If the export target supports emphasizing text, the word will be
+typeset in bold, italic, with an underline or strike-through,
+respectively.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"*:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-exclude-tags '("noexport")
+ "Tags that exclude a tree from export.
+
+All trees carrying any of these tags will be excluded from
+export. This is without condition, so even subtrees inside that
+carry one of the `org-export-select-tags' will be removed.
+
+This option can also be set with the EXCLUDE_TAGS keyword."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-export-with-fixed-width t
+ "Non-nil means lines starting with \":\" will be in fixed width font.
+
+This can be used to have pre-formatted text, fragments of code
+etc. For example:
+ : ;; Some Lisp examples
+ : (while (defc cnt)
+ : (ding))
+will be looking just like this in also HTML. See also the QUOTE
+keyword. Not all export backends support this.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"::nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-footnotes t
+ "Non-nil means Org footnotes should be exported.
+This option can also be set with the OPTIONS keyword,
+e.g. \"f:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-latex t
+ "Non-nil means process LaTeX environments and fragments.
+
+This option can also be set with the OPTIONS line,
+e.g. \"tex:verbatim\". Allowed values are:
+
+nil Ignore math snippets.
+`verbatim' Keep everything in verbatim.
+t Allow export of math snippets."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Do not process math in any way" nil)
+ (const :tag "Interpret math snippets" t)
+ (const :tag "Leave math verbatim" verbatim)))
+
+(defcustom org-export-headline-levels 3
+ "The last level which is still exported as a headline.
+
+Inferior levels will usually produce itemize or enumerate lists
+when exported, but back-end behavior may differ.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"H:2\"."
+ :group 'org-export-general
+ :type 'integer)
+
+(defcustom org-export-default-language "en"
+ "The default language for export and clocktable translations, as a string.
+This may have an association in
+`org-clock-clocktable-language-setup',
+`org-export-smart-quotes-alist' and `org-export-dictionary'.
+This option can also be set with the LANGUAGE keyword."
+ :group 'org-export-general
+ :type '(string :tag "Language"))
+
+(defcustom org-export-preserve-breaks nil
+ "Non-nil means preserve all line breaks when exporting.
+This option can also be set with the OPTIONS keyword,
+e.g. \"\\n:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-entities t
+ "Non-nil means interpret entities when exporting.
+
+For example, HTML export converts \\alpha to &alpha; and \\AA to
+&Aring;.
+
+For a list of supported names, see the constant `org-entities'
+and the user option `org-entities-user'.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"e:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-inlinetasks t
+ "Non-nil means inlinetasks should be exported.
+This option can also be set with the OPTIONS keyword,
+e.g. \"inline:nil\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-with-planning nil
+ "Non-nil means include planning info in export.
+
+Planning info is the line containing either SCHEDULED:,
+DEADLINE:, CLOSED: time-stamps, or a combination of them.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"p:t\"."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-with-priority nil
+ "Non-nil means include priority cookies in export.
+This option can also be set with the OPTIONS keyword,
+e.g. \"pri:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-section-numbers t
+ "Non-nil means add section numbers to headlines when exporting.
+
+When set to an integer n, numbering will only happen for
+headlines whose relative level is higher or equal to n.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"num:t\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-select-tags '("export")
+ "Tags that select a tree for export.
+
+If any such tag is found in a buffer, all trees that do not carry
+one of these tags will be ignored during export. Inside trees
+that are selected like this, you can still deselect a subtree by
+tagging it with one of the `org-export-exclude-tags'.
+
+This option can also be set with the SELECT_TAGS keyword."
+ :group 'org-export-general
+ :type '(repeat (string :tag "Tag")))
+
+(defcustom org-export-with-smart-quotes nil
+ "Non-nil means activate smart quotes during export.
+This option can also be set with the OPTIONS keyword,
+e.g., \"':t\".
+
+When setting this to non-nil, you need to take care of
+using the correct Babel package when exporting to LaTeX.
+E.g., you can load Babel for french like this:
+
+#+LATEX_HEADER: \\usepackage[french]{babel}"
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-with-special-strings t
+ "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export.
+
+When this option is turned on, these strings will be exported as:
+
+ Org HTML LaTeX UTF-8
+ -----+----------+--------+-------
+ \\- &shy; \\-
+ -- &ndash; -- –
+ --- &mdash; --- —
+ ... &hellip; \\ldots …
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"-:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-statistics-cookies t
+ "Non-nil means include statistics cookies in export.
+This option can also be set with the OPTIONS keyword,
+e.g. \"stat:nil\""
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-with-sub-superscripts t
+ "Non-nil means interpret \"_\" and \"^\" for export.
+
+If you want to control how Org displays those characters, see
+`org-use-sub-superscripts'. `org-export-with-sub-superscripts'
+used to be an alias for `org-use-sub-superscripts' in Org <8.0,
+it is not anymore.
+
+When this option is turned on, you can use TeX-like syntax for
+sub- and superscripts and see them exported correctly.
+
+You can also set the option with #+OPTIONS: ^:t
+
+Several characters after \"_\" or \"^\" will be considered as a
+single item - so grouping with {} is normally not needed. For
+example, the following things will be parsed as single sub- or
+superscripts:
+
+ 10^24 or 10^tau several digits will be considered 1 item.
+ 10^-12 or 10^-tau a leading sign with digits or a word
+ x^2-y^3 will be read as x^2 - y^3, because items are
+ terminated by almost any nonword/nondigit char.
+ x_{i^2} or x^(2-i) braces or parenthesis do grouping.
+
+Still, ambiguity is possible. So when in doubt, use {} to enclose
+the sub/superscript. If you set this variable to the symbol `{}',
+the braces are *required* in order to trigger interpretations as
+sub/superscript. This can be helpful in documents that need \"_\"
+frequently in plain text."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "Interpret them" t)
+ (const :tag "Curly brackets only" {})
+ (const :tag "Do not interpret them" nil)))
+
+(defcustom org-export-with-toc t
+ "Non-nil means create a table of contents in exported files.
+
+The TOC contains headlines with levels up
+to`org-export-headline-levels'. When an integer, include levels
+up to N in the toc, this may then be different from
+`org-export-headline-levels', but it will not be allowed to be
+larger than the number of headline levels. When nil, no table of
+contents is made.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"toc:nil\" or \"toc:3\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "No Table of Contents" nil)
+ (const :tag "Full Table of Contents" t)
+ (integer :tag "TOC to level")))
+
+(defcustom org-export-with-tables t
+ "If non-nil, lines starting with \"|\" define a table.
+For example:
+
+ | Name | Address | Birthday |
+ |-------------+----------+-----------|
+ | Arthur Dent | England | 29.2.2100 |
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"|:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-tags t
+ "If nil, do not export tags, just remove them from headlines.
+
+If this is the symbol `not-in-toc', tags will be removed from
+table of contents entries, but still be shown in the headlines of
+the document.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"tags:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Off" nil)
+ (const :tag "Not in TOC" not-in-toc)
+ (const :tag "On" t)))
+
+(defcustom org-export-with-tasks t
+ "Non-nil means include TODO items for export.
+
+This may have the following values:
+t include tasks independent of state.
+`todo' include only tasks that are not yet done.
+`done' include only tasks that are already done.
+nil ignore all tasks.
+list of keywords include tasks with these keywords.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"tasks:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All tasks" t)
+ (const :tag "No tasks" nil)
+ (const :tag "Not-done tasks" todo)
+ (const :tag "Only done tasks" done)
+ (repeat :tag "Specific TODO keywords"
+ (string :tag "Keyword"))))
+
+(defcustom org-export-time-stamp-file t
+ "Non-nil means insert a time stamp into the exported file.
+The time stamp shows when the file was created. This option can
+also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-with-timestamps t
+ "Non nil means allow timestamps in export.
+
+It can be set to any of the following values:
+ t export all timestamps.
+ `active' export active timestamps only.
+ `inactive' export inactive timestamps only.
+ nil do not export timestamps
+
+This only applies to timestamps isolated in a paragraph
+containing only timestamps. Other timestamps are always
+exported.
+
+This option can also be set with the OPTIONS keyword, e.g.
+\"<:nil\"."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "All timestamps" t)
+ (const :tag "Only active timestamps" active)
+ (const :tag "Only inactive timestamps" inactive)
+ (const :tag "No timestamp" nil)))
+
+(defcustom org-export-with-todo-keywords t
+ "Non-nil means include TODO keywords in export.
+When nil, remove all these keywords from the export. This option
+can also be set with the OPTIONS keyword, e.g. \"todo:nil\"."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-allow-bind-keywords nil
+ "Non-nil means BIND keywords can define local variable values.
+This is a potential security risk, which is why the default value
+is nil. You can also allow them through local buffer variables."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-snippet-translation-alist nil
+ "Alist between export snippets back-ends and exporter back-ends.
+
+This variable allows to provide shortcuts for export snippets.
+
+For example, with a value of \((\"h\" . \"html\")), the
+HTML back-end will recognize the contents of \"@@h:<b>@@\" as
+HTML code while every other back-end will ignore it."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(repeat
+ (cons (string :tag "Shortcut")
+ (string :tag "Back-end"))))
+
+(defcustom org-export-coding-system nil
+ "Coding system for the exported file."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'coding-system)
+
+(defcustom org-export-copy-to-kill-ring 'if-interactive
+ "Non-nil means pushing export output to the kill ring.
+This variable is ignored during asynchronous export."
+ :group 'org-export-general
+ :version "24.3"
+ :type '(choice
+ (const :tag "Always" t)
+ (const :tag "When export is done interactively" if-interactive)
+ (const :tag "Never" nil)))
+
+(defcustom org-export-initial-scope 'buffer
+ "The initial scope when exporting with `org-export-dispatch'.
+This variable can be either set to `buffer' or `subtree'."
+ :group 'org-export-general
+ :type '(choice
+ (const :tag "Export current buffer" buffer)
+ (const :tag "Export current subtree" subtree)))
+
+(defcustom org-export-show-temporary-export-buffer t
+ "Non-nil means show buffer after exporting to temp buffer.
+When Org exports to a file, the buffer visiting that file is never
+shown, but remains buried. However, when exporting to
+a temporary buffer, that buffer is popped up in a second window.
+When this variable is nil, the buffer remains buried also in
+these cases."
+ :group 'org-export-general
+ :type 'boolean)
+
+(defcustom org-export-in-background nil
+ "Non-nil means export and publishing commands will run in background.
+Results from an asynchronous export are never displayed
+automatically. But you can retrieve them with \\[org-export-stack]."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+(defcustom org-export-async-init-file user-init-file
+ "File used to initialize external export process.
+Value must be an absolute file name. It defaults to user's
+initialization file. Though, a specific configuration makes the
+process faster and the export more portable."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(file :must-match t))
+
+(defcustom org-export-dispatch-use-expert-ui nil
+ "Non-nil means using a non-intrusive `org-export-dispatch'.
+In that case, no help buffer is displayed. Though, an indicator
+for current export scope is added to the prompt (\"b\" when
+output is restricted to body only, \"s\" when it is restricted to
+the current subtree, \"v\" when only visible elements are
+considered for export, \"f\" when publishing functions should be
+passed the FORCE argument and \"a\" when the export should be
+asynchronous). Also, [?] allows to switch back to standard
+mode."
+ :group 'org-export-general
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
+
+
+;;; Defining Back-ends
+;;
+;; An export back-end is a structure with `org-export-backend' type
+;; and `name', `parent', `transcoders', `options', `filters', `blocks'
+;; and `menu' slots.
+;;
+;; At the lowest level, a back-end is created with
+;; `org-export-create-backend' function.
+;;
+;; A named back-end can be registered with
+;; `org-export-register-backend' function. A registered back-end can
+;; later be referred to by its name, with `org-export-get-backend'
+;; function. Also, such a back-end can become the parent of a derived
+;; back-end from which slot values will be inherited by default.
+;; `org-export-derived-backend-p' can check if a given back-end is
+;; derived from a list of back-end names.
+;;
+;; `org-export-get-all-transcoders', `org-export-get-all-options' and
+;; `org-export-get-all-filters' return the full alist of transcoders,
+;; options and filters, including those inherited from ancestors.
+;;
+;; At a higher level, `org-export-define-backend' is the standard way
+;; to define an export back-end. If the new back-end is similar to
+;; a registered back-end, `org-export-define-derived-backend' may be
+;; used instead.
+;;
+;; Eventually `org-export-barf-if-invalid-backend' returns an error
+;; when a given back-end hasn't been registered yet.
+
+(defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
+ name parent transcoders options filters blocks menu)
+
+(defun org-export-get-backend (name)
+ "Return export back-end named after NAME.
+NAME is a symbol. Return nil if no such back-end is found."
+ (catch 'found
+ (dolist (b org-export--registered-backends)
+ (when (eq (org-export-backend-name b) name)
+ (throw 'found b)))))
+
+(defun org-export-register-backend (backend)
+ "Register BACKEND as a known export back-end.
+BACKEND is a structure with `org-export-backend' type."
+ ;; Refuse to register an unnamed back-end.
+ (unless (org-export-backend-name backend)
+ (error "Cannot register a unnamed export back-end"))
+ ;; Refuse to register a back-end with an unknown parent.
+ (let ((parent (org-export-backend-parent backend)))
+ (when (and parent (not (org-export-get-backend parent)))
+ (error "Cannot use unknown \"%s\" back-end as a parent" parent)))
+ ;; Register dedicated export blocks in the parser.
+ (dolist (name (org-export-backend-blocks backend))
+ (add-to-list 'org-element-block-name-alist
+ (cons name 'org-element-export-block-parser)))
+ ;; If a back-end with the same name as BACKEND is already
+ ;; registered, replace it with BACKEND. Otherwise, simply add
+ ;; BACKEND to the list of registered back-ends.
+ (let ((old (org-export-get-backend (org-export-backend-name backend))))
+ (if old (setcar (memq old org-export--registered-backends) backend)
+ (push backend org-export--registered-backends))))
+
+(defun org-export-barf-if-invalid-backend (backend)
+ "Signal an error if BACKEND isn't defined."
+ (unless (org-export-backend-p backend)
+ (error "Unknown \"%s\" back-end: Aborting export" backend)))
+
+(defun org-export-derived-backend-p (backend &rest backends)
+ "Non-nil if BACKEND is derived from one of BACKENDS.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. BACKENDS is constituted of symbols."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (catch 'exit
+ (while (org-export-backend-parent backend)
+ (when (memq (org-export-backend-name backend) backends)
+ (throw 'exit t))
+ (setq backend
+ (org-export-get-backend (org-export-backend-parent backend))))
+ (memq (org-export-backend-name backend) backends))))
+
+(defun org-export-get-all-transcoders (backend)
+ "Return full translation table for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are element or object types, as symbols, and values are
+transcoders.
+
+Unlike to `org-export-backend-transcoders', this function
+also returns transcoders inherited from parent back-ends,
+if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((transcoders (org-export-backend-transcoders backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq transcoders
+ (append transcoders (org-export-backend-transcoders backend))))
+ transcoders)))
+
+(defun org-export-get-all-options (backend)
+ "Return export options for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. See `org-export-options-alist'
+for the shape of the return value.
+
+Unlike to `org-export-backend-options', this function also
+returns options inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((options (org-export-backend-options backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq options (append options (org-export-backend-options backend))))
+ options)))
+
+(defun org-export-get-all-filters (backend)
+ "Return complete list of filters for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are symbols and values lists of functions.
+
+Unlike to `org-export-backend-filters', this function also
+returns filters inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((filters (org-export-backend-filters backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq filters (append filters (org-export-backend-filters backend))))
+ filters)))
+
+(defun org-export-define-backend (backend transcoders &rest body)
+ "Define a new back-end BACKEND.
+
+TRANSCODERS is an alist between object or element types and
+functions handling them.
+
+These functions should return a string without any trailing
+space, or nil. They must accept three arguments: the object or
+element itself, its contents or nil when it isn't recursive and
+the property list used as a communication channel.
+
+Contents, when not nil, are stripped from any global indentation
+\(although the relative one is preserved). They also always end
+with a single newline character.
+
+If, for a given type, no function is found, that element or
+object type will simply be ignored, along with any blank line or
+white space at its end. The same will happen if the function
+returns the nil value. If that function returns the empty
+string, the type will be ignored, but the blank lines or white
+spaces will be kept.
+
+In addition to element and object types, one function can be
+associated to the `template' (or `inner-template') symbol and
+another one to the `plain-text' symbol.
+
+The former returns the final transcoded string, and can be used
+to add a preamble and a postamble to document's body. It must
+accept two arguments: the transcoded string and the property list
+containing export options. A function associated to `template'
+will not be applied if export has option \"body-only\".
+A function associated to `inner-template' is always applied.
+
+The latter, when defined, is to be called on every text not
+recognized as an element or an object. It must accept two
+arguments: the text string and the information channel. It is an
+appropriate place to protect special chars relative to the
+back-end.
+
+BODY can start with pre-defined keyword arguments. The following
+keywords are understood:
+
+ :export-block
+
+ String, or list of strings, representing block names that
+ will not be parsed. This is used to specify blocks that will
+ contain raw code specific to the back-end. These blocks
+ still have to be handled by the relative `export-block' type
+ translator.
+
+ :filters-alist
+
+ Alist between filters and function, or list of functions,
+ specific to the back-end. See `org-export-filters-alist' for
+ a list of all allowed filters. Filters defined here
+ shouldn't make a back-end test, as it may prevent back-ends
+ derived from this one to behave properly.
+
+ :menu-entry
+
+ Menu entry for the export dispatcher. It should be a list
+ like:
+
+ (KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
+
+ where :
+
+ KEY is a free character selecting the back-end.
+
+ DESCRIPTION-OR-ORDINAL is either a string or a number.
+
+ If it is a string, is will be used to name the back-end in
+ its menu entry. If it is a number, the following menu will
+ be displayed as a sub-menu of the back-end with the same
+ KEY. Also, the number will be used to determine in which
+ order such sub-menus will appear (lowest first).
+
+ ACTION-OR-MENU is either a function or an alist.
+
+ If it is an action, it will be called with four
+ arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and
+ BODY-ONLY. See `org-export-as' for further explanations on
+ some of them.
+
+ If it is an alist, associations should follow the
+ pattern:
+
+ (KEY DESCRIPTION ACTION)
+
+ where KEY, DESCRIPTION and ACTION are described above.
+
+ Valid values include:
+
+ (?m \"My Special Back-end\" my-special-export-function)
+
+ or
+
+ (?l \"Export to LaTeX\"
+ (?p \"As PDF file\" org-latex-export-to-pdf)
+ (?o \"As PDF file and open\"
+ (lambda (a s v b)
+ (if a (org-latex-export-to-pdf t s v b)
+ (org-open-file
+ (org-latex-export-to-pdf nil s v b)))))))
+
+ or the following, which will be added to the previous
+ sub-menu,
+
+ (?l 1
+ ((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex)
+ (?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf)))
+
+ :options-alist
+
+ Alist between back-end specific properties introduced in
+ communication channel and how their value are acquired. See
+ `org-export-options-alist' for more information about
+ structure of the values."
+ (declare (indent 1))
+ (let (blocks filters menu-entry options contents)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (t (pop body))))
+ (org-export-register-backend
+ (org-export-create-backend :name backend
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
+
+(defun org-export-define-derived-backend (child parent &rest body)
+ "Create a new back-end as a variant of an existing one.
+
+CHILD is the name of the derived back-end. PARENT is the name of
+the parent back-end.
+
+BODY can start with pre-defined keyword arguments. The following
+keywords are understood:
+
+ :export-block
+
+ String, or list of strings, representing block names that
+ will not be parsed. This is used to specify blocks that will
+ contain raw code specific to the back-end. These blocks
+ still have to be handled by the relative `export-block' type
+ translator.
+
+ :filters-alist
+
+ Alist of filters that will overwrite or complete filters
+ defined in PARENT back-end. See `org-export-filters-alist'
+ for a list of allowed filters.
+
+ :menu-entry
+
+ Menu entry for the export dispatcher. See
+ `org-export-define-backend' for more information about the
+ expected value.
+
+ :options-alist
+
+ Alist of back-end specific properties that will overwrite or
+ complete those defined in PARENT back-end. Refer to
+ `org-export-options-alist' for more information about
+ structure of the values.
+
+ :translate-alist
+
+ Alist of element and object types and transcoders that will
+ overwrite or complete transcode table from PARENT back-end.
+ Refer to `org-export-define-backend' for detailed information
+ about transcoders.
+
+As an example, here is how one could define \"my-latex\" back-end
+as a variant of `latex' back-end with a custom template function:
+
+ (org-export-define-derived-backend \\='my-latex \\='latex
+ :translate-alist \\='((template . my-latex-template-fun)))
+
+The back-end could then be called with, for example:
+
+ (org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
+ (declare (indent 2))
+ (let (blocks filters menu-entry options transcoders contents)
+ (while (keywordp (car body))
+ (case (pop body)
+ (:export-block (let ((names (pop body)))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (:translate-alist (setq transcoders (pop body)))
+ (t (pop body))))
+ (org-export-register-backend
+ (org-export-create-backend :name child
+ :parent parent
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
+
+
+
+;;; The Communication Channel
+;;
+;; During export process, every function has access to a number of
+;; properties. They are of two types:
+;;
+;; 1. Environment options are collected once at the very beginning of
+;; the process, out of the original buffer and configuration.
+;; Collecting them is handled by `org-export-get-environment'
+;; function.
+;;
+;; Most environment options are defined through the
+;; `org-export-options-alist' variable.
+;;
+;; 2. Tree properties are extracted directly from the parsed tree,
+;; just before export, by `org-export-collect-tree-properties'.
+;;
+;; Here is the full list of properties available during transcode
+;; process, with their category and their value type.
+;;
+;; + `:author' :: Author's name.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:back-end' :: Current back-end used for transcoding.
+;; - category :: tree
+;; - type :: symbol
+;;
+;; + `:creator' :: String to write as creation information.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:date' :: String to use as date.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:description' :: Description text for the current data.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:email' :: Author's email.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:exclude-tags' :: Tags for exclusion of subtrees from export
+;; process.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `:export-options' :: List of export options available for current
+;; process.
+;; - category :: none
+;; - type :: list of symbols, among `subtree', `body-only' and
+;; `visible-only'.
+;;
+;; + `:exported-data' :: Hash table used for memoizing
+;; `org-export-data'.
+;; - category :: tree
+;; - type :: hash table
+;;
+;; + `:filetags' :: List of global tags for buffer. Used by
+;; `org-export-get-tags' to get tags with inheritance.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `:footnote-definition-alist' :: Alist between footnote labels and
+;; their definition, as parsed data. Only non-inlined footnotes
+;; are represented in this alist. Also, every definition isn't
+;; guaranteed to be referenced in the parse tree. The purpose of
+;; this property is to preserve definitions from oblivion
+;; (i.e. when the parse tree comes from a part of the original
+;; buffer), it isn't meant for direct use in a back-end. To
+;; retrieve a definition relative to a reference, use
+;; `org-export-get-footnote-definition' instead.
+;; - category :: option
+;; - type :: alist (STRING . LIST)
+;;
+;; + `:headline-levels' :: Maximum level being exported as an
+;; headline. Comparison is done with the relative level of
+;; headlines in the parse tree, not necessarily with their
+;; actual level.
+;; - category :: option
+;; - type :: integer
+;;
+;; + `:headline-offset' :: Difference between relative and real level
+;; of headlines in the parse tree. For example, a value of -1
+;; means a level 2 headline should be considered as level
+;; 1 (cf. `org-export-get-relative-level').
+;; - category :: tree
+;; - type :: integer
+;;
+;; + `:headline-numbering' :: Alist between headlines and their
+;; numbering, as a list of numbers
+;; (cf. `org-export-get-headline-number').
+;; - category :: tree
+;; - type :: alist (INTEGER . LIST)
+;;
+;; + `:id-alist' :: Alist between ID strings and destination file's
+;; path, relative to current directory. It is used by
+;; `org-export-resolve-id-link' to resolve ID links targeting an
+;; external file.
+;; - category :: option
+;; - type :: alist (STRING . STRING)
+;;
+;; + `:ignore-list' :: List of elements and objects that should be
+;; ignored during export.
+;; - category :: tree
+;; - type :: list of elements and objects
+;;
+;; + `:input-buffer' :: Name of input buffer.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:input-file' :: Full path to input file, if any.
+;; - category :: option
+;; - type :: string or nil
+;;
+;; + `:keywords' :: List of keywords attached to data.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:language' :: Default language used for translations.
+;; - category :: option
+;; - type :: string
+;;
+;; + `:output-file' :: Full path to output file, if any.
+;; - category :: option
+;; - type :: string or nil
+;;
+;; + `:parse-tree' :: Whole parse tree, available at any time during
+;; transcoding.
+;; - category :: option
+;; - type :: list (as returned by `org-element-parse-buffer')
+;;
+;; + `:preserve-breaks' :: Non-nil means transcoding should preserve
+;; all line breaks.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:section-numbers' :: Non-nil means transcoding should add
+;; section numbers to headlines.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees
+;; in transcoding. When such a tag is present, subtrees without
+;; it are de facto excluded from the process. See
+;; `use-select-tags'.
+;; - category :: option
+;; - type :: list of strings
+;;
+;; + `:time-stamp-file' :: Non-nil means transcoding should insert
+;; a time stamp in the output.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:translate-alist' :: Alist between element and object types and
+;; transcoding functions relative to the current back-end.
+;; Special keys `inner-template', `template' and `plain-text' are
+;; also possible.
+;; - category :: option
+;; - type :: alist (SYMBOL . FUNCTION)
+;;
+;; + `:with-archived-trees' :: Non-nil when archived subtrees should
+;; also be transcoded. If it is set to the `headline' symbol,
+;; only the archived headline's name is retained.
+;; - category :: option
+;; - type :: symbol (nil, t, `headline')
+;;
+;; + `:with-author' :: Non-nil means author's name should be included
+;; in the output.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-clocks' :: Non-nil means clock keywords should be exported.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-creator' :: Non-nil means a creation sentence should be
+;; inserted at the end of the transcoded string. If the value
+;; is `comment', it should be commented.
+;; - category :: option
+;; - type :: symbol (`comment', nil, t)
+;;
+;; + `:with-date' :: Non-nil means output should contain a date.
+;; - category :: option
+;; - type :. symbol (nil, t)
+;;
+;; + `:with-drawers' :: Non-nil means drawers should be exported. If
+;; its value is a list of names, only drawers with such names
+;; will be transcoded. If that list starts with `not', drawer
+;; with these names will be skipped.
+;; - category :: option
+;; - type :: symbol (nil, t) or list of strings
+;;
+;; + `:with-email' :: Non-nil means output should contain author's
+;; email.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-emphasize' :: Non-nil means emphasized text should be
+;; interpreted.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-fixed-width' :: Non-nil if transcoder should interpret
+;; strings starting with a colon as a fixed-with (verbatim) area.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-footnotes' :: Non-nil if transcoder should interpret
+;; footnotes.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-latex' :: Non-nil means `latex-environment' elements and
+;; `latex-fragment' objects should appear in export output. When
+;; this property is set to `verbatim', they will be left as-is.
+;; - category :: option
+;; - type :: symbol (`verbatim', nil, t)
+;;
+;; + `:with-planning' :: Non-nil means transcoding should include
+;; planning info.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-priority' :: Non-nil means transcoding should include
+;; priority cookies.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in
+;; plain text.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-special-strings' :: Non-nil means transcoding should
+;; interpret special strings in plain text.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-sub-superscript' :: Non-nil means transcoding should
+;; interpret subscript and superscript. With a value of "{}",
+;; only interpret those using curly brackets.
+;; - category :: option
+;; - type :: symbol (nil, {}, t)
+;;
+;; + `:with-tables' :: Non-nil means transcoding should interpret
+;; tables.
+;; - category :: option
+;; - type :: symbol (nil, t)
+;;
+;; + `:with-tags' :: Non-nil means transcoding should keep tags in
+;; headlines. A `not-in-toc' value will remove them from the
+;; table of contents, if any, nonetheless.
+;; - category :: option
+;; - type :: symbol (nil, t, `not-in-toc')
+;;
+;; + `:with-tasks' :: Non-nil means transcoding should include
+;; headlines with a TODO keyword. A `todo' value will only
+;; include headlines with a todo type keyword while a `done'
+;; value will do the contrary. If a list of strings is provided,
+;; only tasks with keywords belonging to that list will be kept.
+;; - category :: option
+;; - type :: symbol (t, todo, done, nil) or list of strings
+;;
+;; + `:with-timestamps' :: Non-nil means transcoding should include
+;; time stamps. Special value `active' (resp. `inactive') ask to
+;; export only active (resp. inactive) timestamps. Otherwise,
+;; completely remove them.
+;; - category :: option
+;; - type :: symbol: (`active', `inactive', t, nil)
+;;
+;; + `:with-toc' :: Non-nil means that a table of contents has to be
+;; added to the output. An integer value limits its depth.
+;; - category :: option
+;; - type :: symbol (nil, t or integer)
+;;
+;; + `:with-todo-keywords' :: Non-nil means transcoding should
+;; include TODO keywords.
+;; - category :: option
+;; - type :: symbol (nil, t)
+
+
+;;;; Environment Options
+;;
+;; Environment options encompass all parameters defined outside the
+;; scope of the parsed data. They come from five sources, in
+;; increasing precedence order:
+;;
+;; - Global variables,
+;; - Buffer's attributes,
+;; - Options keyword symbols,
+;; - Buffer keywords,
+;; - Subtree properties.
+;;
+;; The central internal function with regards to environment options
+;; is `org-export-get-environment'. It updates global variables with
+;; "#+BIND:" keywords, then retrieve and prioritize properties from
+;; the different sources.
+;;
+;; The internal functions doing the retrieval are:
+;; `org-export--get-global-options',
+;; `org-export--get-buffer-attributes',
+;; `org-export--parse-option-keyword',
+;; `org-export--get-subtree-options' and
+;; `org-export--get-inbuffer-options'
+;;
+;; Also, `org-export--list-bound-variables' collects bound variables
+;; along with their value in order to set them as buffer local
+;; variables later in the process.
+
+(defun org-export-get-environment (&optional backend subtreep ext-plist)
+ "Collect export options from the current buffer.
+
+Optional argument BACKEND is an export back-end, as returned by
+`org-export-create-backend'.
+
+When optional argument SUBTREEP is non-nil, assume the export is
+done against the current sub-tree.
+
+Third optional argument EXT-PLIST is a property list with
+external parameters overriding Org default settings, but still
+inferior to file-local settings."
+ ;; First install #+BIND variables since these must be set before
+ ;; global options are read.
+ (dolist (pair (org-export--list-bound-variables))
+ (org-set-local (car pair) (nth 1 pair)))
+ ;; Get and prioritize export options...
+ (org-combine-plists
+ ;; ... from global variables...
+ (org-export--get-global-options backend)
+ ;; ... from an external property list...
+ ext-plist
+ ;; ... from in-buffer settings...
+ (org-export--get-inbuffer-options backend)
+ ;; ... and from subtree, when appropriate.
+ (and subtreep (org-export--get-subtree-options backend))
+ ;; Eventually add misc. properties.
+ (list
+ :back-end
+ backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ :footnote-definition-alist
+ ;; Footnotes definitions must be collected in the original
+ ;; buffer, as there's no insurance that they will still be in
+ ;; the parse tree, due to possible narrowing.
+ (let (alist)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-footnote-definition-re nil t)
+ (let ((def (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type def) 'footnote-definition)
+ (push
+ (cons (org-element-property :label def)
+ (let ((cbeg (org-element-property :contents-begin def)))
+ (when cbeg
+ (org-element--parse-elements
+ cbeg (org-element-property :contents-end def)
+ nil nil nil nil (list 'org-data nil)))))
+ alist))))
+ alist))
+ :id-alist
+ ;; Collect id references.
+ (let (alist)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t)
+ (let ((link (org-element-context)))
+ (when (eq (org-element-type link) 'link)
+ (let* ((id (org-element-property :path link))
+ (file (org-id-find-id-file id)))
+ (when file
+ (push (cons id (file-relative-name file)) alist)))))))
+ alist))))
+
+(defun org-export--parse-option-keyword (options &optional backend)
+ "Parse an OPTIONS line and return values as a plist.
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies which back-end
+specific items to read, if any."
+ (let* ((all
+ ;; Priority is given to back-end specific options.
+ (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist))
+ plist)
+ (dolist (option all)
+ (let ((property (car option))
+ (item (nth 2 option)))
+ (when (and item
+ (not (plist-member plist property))
+ (string-match (concat "\\(\\`\\|[ \t]\\)"
+ (regexp-quote item)
+ ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
+ options))
+ (setq plist (plist-put plist
+ property
+ (car (read-from-string
+ (match-string 2 options))))))))
+ plist))
+
+(defun org-export--get-subtree-options (&optional backend)
+ "Get export options in subtree at point.
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies back-end used
+for export. Return options as a plist."
+ ;; For each buffer keyword, create a headline property setting the
+ ;; same property in communication channel. The name for the property
+ ;; is the keyword with "EXPORT_" appended to it.
+ (org-with-wide-buffer
+ (let (prop plist)
+ ;; Make sure point is at a heading.
+ (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
+ ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's
+ ;; title (with no todo keyword, priority cookie or tag) as its
+ ;; fallback value.
+ (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE")
+ (progn (looking-at org-complex-heading-regexp)
+ (org-match-string-no-properties 4))))
+ (setq plist
+ (plist-put
+ plist :title
+ (org-element-parse-secondary-string
+ prop (org-element-restriction 'keyword)))))
+ ;; EXPORT_OPTIONS are parsed in a non-standard way.
+ (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
+ (setq plist
+ (nconc plist (org-export--parse-option-keyword prop backend))))
+ ;; Handle other keywords. TITLE keyword is excluded as it has
+ ;; been handled already.
+ (let ((seen '("TITLE")))
+ (mapc
+ (lambda (option)
+ (let ((property (car option))
+ (keyword (nth 1 option)))
+ (when (and keyword (not (member keyword seen)))
+ (let* ((subtree-prop (concat "EXPORT_" keyword))
+ ;; Export properties are not case-sensitive.
+ (value (let ((case-fold-search t))
+ (org-entry-get (point) subtree-prop))))
+ (push keyword seen)
+ (when (and value (not (plist-member plist property)))
+ (setq plist
+ (plist-put
+ plist
+ property
+ (cond
+ ;; Parse VALUE if required.
+ ((member keyword org-element-document-properties)
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))
+ ;; If BEHAVIOR is `split' expected value is
+ ;; a list of strings, not a string.
+ ((eq (nth 4 option) 'split) (org-split-string value))
+ (t value)))))))))
+ ;; Look for both general keywords and back-end specific
+ ;; options, with priority given to the latter.
+ (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist)))
+ ;; Return value.
+ plist)))
+
+(defun org-export--get-inbuffer-options (&optional backend)
+ "Return current buffer export options, as a plist.
+
+Optional argument BACKEND, when non-nil, is an export back-end,
+as returned by, e.g., `org-export-create-backend'. It specifies
+which back-end specific options should also be read in the
+process.
+
+Assume buffer is in Org mode. Narrowing, if any, is ignored."
+ (let* (plist
+ get-options ; For byte-compiler.
+ (case-fold-search t)
+ (options (append
+ ;; Priority is given to back-end specific options.
+ (and backend (org-export-get-all-options backend))
+ org-export-options-alist))
+ (regexp (format "^[ \t]*#\\+%s:"
+ (regexp-opt (nconc (delq nil (mapcar 'cadr options))
+ org-export-special-keywords))))
+ (find-properties
+ (lambda (keyword)
+ ;; Return all properties associated to KEYWORD.
+ (let (properties)
+ (dolist (option options properties)
+ (when (equal (nth 1 option) keyword)
+ (pushnew (car option) properties))))))
+ (get-options
+ (lambda (&optional files plist)
+ ;; Recursively read keywords in buffer. FILES is a list
+ ;; of files read so far. PLIST is the current property
+ ;; list obtained.
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((key (org-element-property :key element))
+ (val (org-element-property :value element)))
+ (cond
+ ;; Options in `org-export-special-keywords'.
+ ((equal key "SETUPFILE")
+ (let ((file (expand-file-name
+ (org-remove-double-quotes (org-trim val)))))
+ ;; Avoid circular dependencies.
+ (unless (member file files)
+ (with-temp-buffer
+ (insert (org-file-contents file 'noerror))
+ (let ((org-inhibit-startup t)) (org-mode))
+ (setq plist (funcall get-options
+ (cons file files) plist))))))
+ ((equal key "OPTIONS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (org-export--parse-option-keyword val backend))))
+ ((equal key "FILETAGS")
+ (setq plist
+ (org-combine-plists
+ plist
+ (list :filetags
+ (org-uniquify
+ (append (org-split-string val ":")
+ (plist-get plist :filetags)))))))
+ (t
+ ;; Options in `org-export-options-alist'.
+ (dolist (property (funcall find-properties key))
+ (let ((behavior (nth 4 (assq property options))))
+ (setq plist
+ (plist-put
+ plist property
+ ;; Handle value depending on specified
+ ;; BEHAVIOR.
+ (case behavior
+ (space
+ (if (not (plist-get plist property))
+ (org-trim val)
+ (concat (plist-get plist property)
+ " "
+ (org-trim val))))
+ (newline
+ (org-trim
+ (concat (plist-get plist property)
+ "\n"
+ (org-trim val))))
+ (split `(,@(plist-get plist property)
+ ,@(org-split-string val)))
+ ('t val)
+ (otherwise
+ (if (not (plist-member plist property)) val
+ (plist-get plist property))))))))))))))
+ ;; Return final value.
+ plist))))
+ ;; Read options in the current buffer.
+ (setq plist (funcall get-options
+ (and buffer-file-name (list buffer-file-name)) nil))
+ ;; Parse keywords specified in `org-element-document-properties'
+ ;; and return PLIST.
+ (dolist (keyword org-element-document-properties plist)
+ (dolist (property (funcall find-properties keyword))
+ (let ((value (plist-get plist property)))
+ (when (stringp value)
+ (setq plist
+ (plist-put plist property
+ (or (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ ;; When TITLE keyword sets an empty
+ ;; string, make sure it doesn't
+ ;; appear as nil in the plist.
+ (and (eq property :title) ""))))))))))
+
+(defun org-export--get-buffer-attributes ()
+ "Return properties related to buffer attributes, as a plist."
+ ;; Store full path of input file name, or nil. For internal use.
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list :input-file visited-file
+ :input-buffer (buffer-name (buffer-base-buffer)))))
+
+(defun org-export--get-global-options (&optional backend)
+ "Return global export options as a plist.
+Optional argument BACKEND, if non-nil, is an export back-end, as
+returned by, e.g., `org-export-create-backend'. It specifies
+which back-end specific export options should also be read in the
+process."
+ (let (plist
+ ;; Priority is given to back-end specific options.
+ (all (append (and backend (org-export-get-all-options backend))
+ org-export-options-alist)))
+ (dolist (cell all plist)
+ (let ((prop (car cell)))
+ (unless (plist-member plist prop)
+ (setq plist
+ (plist-put
+ plist
+ prop
+ ;; Evaluate default value provided. If keyword is
+ ;; a member of `org-element-document-properties',
+ ;; parse it as a secondary string before storing it.
+ (let ((value (eval (nth 3 cell))))
+ (if (and (stringp value)
+ (member (nth 1 cell)
+ org-element-document-properties))
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ value)))))))))
+
+(defun org-export--list-bound-variables ()
+ "Return variables bound from BIND keywords in current buffer.
+Also look for BIND keywords in setup files. The return value is
+an alist where associations are (VARIABLE-NAME VALUE)."
+ (when org-export-allow-bind-keywords
+ (let* (collect-bind ; For byte-compiler.
+ (collect-bind
+ (lambda (files alist)
+ ;; Return an alist between variable names and their
+ ;; value. FILES is a list of setup files names read so
+ ;; far, used to avoid circular dependencies. ALIST is
+ ;; the alist collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (let ((val (org-element-property :value element)))
+ (if (equal (org-element-property :key element) "BIND")
+ (push (read (format "(%s)" val)) alist)
+ ;; Enter setup file.
+ (let ((file (expand-file-name
+ (org-remove-double-quotes val))))
+ (unless (member file files)
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert (org-file-contents file 'noerror))
+ (setq alist
+ (funcall collect-bind
+ (cons file files)
+ alist))))))))))
+ alist)))))
+ ;; Return value in appropriate order of appearance.
+ (nreverse (funcall collect-bind nil nil)))))
+
+;; defsubst org-export-get-parent must be defined before first use,
+;; was originally defined in the topology section
+
+(defsubst org-export-get-parent (blob)
+ "Return BLOB parent or nil.
+BLOB is the element or object considered."
+ (org-element-property :parent blob))
+
+;;;; Tree Properties
+;;
+;; Tree properties are information extracted from parse tree. They
+;; are initialized at the beginning of the transcoding process by
+;; `org-export-collect-tree-properties'.
+;;
+;; Dedicated functions focus on computing the value of specific tree
+;; properties during initialization. Thus,
+;; `org-export--populate-ignore-list' lists elements and objects that
+;; should be skipped during export, `org-export--get-min-level' gets
+;; the minimal exportable level, used as a basis to compute relative
+;; level for headlines. Eventually
+;; `org-export--collect-headline-numbering' builds an alist between
+;; headlines and their numbering.
+
+(defun org-export-collect-tree-properties (data info)
+ "Extract tree properties from parse tree.
+
+DATA is the parse tree from which information is retrieved. INFO
+is a list holding export options.
+
+Following tree properties are set or updated:
+
+`:exported-data' Hash table used to memoize results from
+ `org-export-data'.
+
+`:footnote-definition-alist' List of footnotes definitions in
+ original buffer and current parse tree.
+
+`:headline-offset' Offset between true level of headlines and
+ local level. An offset of -1 means a headline
+ of level 2 should be considered as a level
+ 1 headline in the context.
+
+`:headline-numbering' Alist of all headlines as key an the
+ associated numbering as value.
+
+`:ignore-list' List of elements that should be ignored during
+ export.
+
+Return updated plist."
+ ;; Install the parse tree in the communication channel, in order to
+ ;; use `org-export-get-genealogy' and al.
+ (setq info (plist-put info :parse-tree data))
+ ;; Get the list of elements and objects to ignore, and put it into
+ ;; `:ignore-list'. Do not overwrite any user ignore that might have
+ ;; been done during parse tree filtering.
+ (setq info
+ (plist-put info
+ :ignore-list
+ (append (org-export--populate-ignore-list data info)
+ (plist-get info :ignore-list))))
+ ;; Compute `:headline-offset' in order to be able to use
+ ;; `org-export-get-relative-level'.
+ (setq info
+ (plist-put info
+ :headline-offset
+ (- 1 (org-export--get-min-level data info))))
+ ;; Update footnotes definitions list with definitions in parse tree.
+ ;; This is required since buffer expansion might have modified
+ ;; boundaries of footnote definitions contained in the parse tree.
+ ;; This way, definitions in `footnote-definition-alist' are bound to
+ ;; match those in the parse tree.
+ (let ((defs (plist-get info :footnote-definition-alist)))
+ (org-element-map data 'footnote-definition
+ (lambda (fn)
+ (push (cons (org-element-property :label fn)
+ `(org-data nil ,@(org-element-contents fn)))
+ defs)))
+ (setq info (plist-put info :footnote-definition-alist defs)))
+ ;; Properties order doesn't matter: get the rest of the tree
+ ;; properties.
+ (nconc
+ `(:headline-numbering ,(org-export--collect-headline-numbering data info)
+ :exported-data ,(make-hash-table :test 'eq :size 4001))
+ info))
+
+(defun org-export--get-min-level (data options)
+ "Return minimum exportable headline's level in DATA.
+DATA is parsed tree as returned by `org-element-parse-buffer'.
+OPTIONS is a plist holding export options."
+ (catch 'exit
+ (let ((min-level 10000))
+ (mapc
+ (lambda (blob)
+ (when (and (eq (org-element-type blob) 'headline)
+ (not (org-element-property :footnote-section-p blob))
+ (not (memq blob (plist-get options :ignore-list))))
+ (setq min-level (min (org-element-property :level blob) min-level)))
+ (when (= min-level 1) (throw 'exit 1)))
+ (org-element-contents data))
+ ;; If no headline was found, for the sake of consistency, set
+ ;; minimum level to 1 nonetheless.
+ (if (= min-level 10000) 1 min-level))))
+
+(defun org-export--collect-headline-numbering (data options)
+ "Return numbering of all exportable headlines in a parse tree.
+
+DATA is the parse tree. OPTIONS is the plist holding export
+options.
+
+Return an alist whose key is a headline and value is its
+associated numbering \(in the shape of a list of numbers) or nil
+for a footnotes section."
+ (let ((numbering (make-vector org-export-max-depth 0)))
+ (org-element-map data 'headline
+ (lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((relative-level
+ (1- (org-export-get-relative-level headline options))))
+ (cons
+ headline
+ (loop for n across numbering
+ for idx from 0 to org-export-max-depth
+ when (< idx relative-level) collect n
+ when (= idx relative-level) collect (aset numbering idx (1+ n))
+ when (> idx relative-level) do (aset numbering idx 0))))))
+ options)))
+
+(defun org-export--populate-ignore-list (data options)
+ "Return list of elements and objects to ignore during export.
+DATA is the parse tree to traverse. OPTIONS is the plist holding
+export options."
+ (let* (ignore
+ walk-data
+ ;; First find trees containing a select tag, if any.
+ (selected (org-export--selected-trees data options))
+ (walk-data
+ (lambda (data)
+ ;; Collect ignored elements or objects into IGNORE-LIST.
+ (let ((type (org-element-type data)))
+ (if (org-export--skip-p data options selected) (push data ignore)
+ (if (and (eq type 'headline)
+ (eq (plist-get options :with-archived-trees) 'headline)
+ (org-element-property :archivedp data))
+ ;; If headline is archived but tree below has
+ ;; to be skipped, add it to ignore list.
+ (mapc (lambda (e) (push e ignore))
+ (org-element-contents data))
+ ;; Move into secondary string, if any.
+ (let ((sec-prop
+ (cdr (assq type org-element-secondary-value-alist))))
+ (when sec-prop
+ (mapc walk-data (org-element-property sec-prop data))))
+ ;; Move into recursive objects/elements.
+ (mapc walk-data (org-element-contents data))))))))
+ ;; Main call.
+ (funcall walk-data data)
+ ;; Return value.
+ ignore))
+
+(defun org-export--selected-trees (data info)
+ "Return list of headlines and inlinetasks with a select tag in their tree.
+DATA is parsed data as returned by `org-element-parse-buffer'.
+INFO is a plist holding export options."
+ (let* (selected-trees
+ walk-data ; For byte-compiler.
+ (walk-data
+ (function
+ (lambda (data genealogy)
+ (let ((type (org-element-type data)))
+ (cond
+ ((memq type '(headline inlinetask))
+ (let ((tags (org-element-property :tags data)))
+ (if (loop for tag in (plist-get info :select-tags)
+ thereis (member tag tags))
+ ;; When a select tag is found, mark full
+ ;; genealogy and every headline within the tree
+ ;; as acceptable.
+ (setq selected-trees
+ (append
+ genealogy
+ (org-element-map data '(headline inlinetask)
+ 'identity)
+ selected-trees))
+ ;; If at a headline, continue searching in tree,
+ ;; recursively.
+ (when (eq type 'headline)
+ (mapc (lambda (el)
+ (funcall walk-data el (cons data genealogy)))
+ (org-element-contents data))))))
+ ((or (eq type 'org-data)
+ (memq type org-element-greater-elements))
+ (mapc (lambda (el) (funcall walk-data el genealogy))
+ (org-element-contents data)))))))))
+ (funcall walk-data data nil)
+ selected-trees))
+
+(defun org-export--skip-p (blob options selected)
+ "Non-nil when element or object BLOB should be skipped during export.
+OPTIONS is the plist holding export options. SELECTED, when
+non-nil, is a list of headlines or inlinetasks belonging to
+a tree with a select tag."
+ (case (org-element-type blob)
+ (clock (not (plist-get options :with-clocks)))
+ (drawer
+ (let ((with-drawers-p (plist-get options :with-drawers)))
+ (or (not with-drawers-p)
+ (and (consp with-drawers-p)
+ ;; If `:with-drawers' value starts with `not', ignore
+ ;; every drawer whose name belong to that list.
+ ;; Otherwise, ignore drawers whose name isn't in that
+ ;; list.
+ (let ((name (org-element-property :drawer-name blob)))
+ (if (eq (car with-drawers-p) 'not)
+ (member-ignore-case name (cdr with-drawers-p))
+ (not (member-ignore-case name with-drawers-p))))))))
+ ((footnote-definition footnote-reference)
+ (not (plist-get options :with-footnotes)))
+ ((headline inlinetask)
+ (let ((with-tasks (plist-get options :with-tasks))
+ (todo (org-element-property :todo-keyword blob))
+ (todo-type (org-element-property :todo-type blob))
+ (archived (plist-get options :with-archived-trees))
+ (tags (org-element-property :tags blob)))
+ (or
+ (and (eq (org-element-type blob) 'inlinetask)
+ (not (plist-get options :with-inlinetasks)))
+ ;; Ignore subtrees with an exclude tag.
+ (loop for k in (plist-get options :exclude-tags)
+ thereis (member k tags))
+ ;; When a select tag is present in the buffer, ignore any tree
+ ;; without it.
+ (and selected (not (memq blob selected)))
+ ;; Ignore commented sub-trees.
+ (org-element-property :commentedp blob)
+ ;; Ignore archived subtrees if `:with-archived-trees' is nil.
+ (and (not archived) (org-element-property :archivedp blob))
+ ;; Ignore tasks, if specified by `:with-tasks' property.
+ (and todo
+ (or (not with-tasks)
+ (and (memq with-tasks '(todo done))
+ (not (eq todo-type with-tasks)))
+ (and (consp with-tasks) (not (member todo with-tasks))))))))
+ ((latex-environment latex-fragment) (not (plist-get options :with-latex)))
+ (planning (not (plist-get options :with-planning)))
+ (statistics-cookie (not (plist-get options :with-statistics-cookies)))
+ (table-cell
+ (and (org-export-table-has-special-column-p
+ (org-export-get-parent-table blob))
+ (not (org-export-get-previous-element blob options))))
+ (table-row (org-export-table-row-is-special-p blob options))
+ (timestamp
+ ;; `:with-timestamps' only applies to isolated timestamps
+ ;; objects, i.e. timestamp objects in a paragraph containing only
+ ;; timestamps and whitespaces.
+ (when (let ((parent (org-export-get-parent-element blob)))
+ (and (memq (org-element-type parent) '(paragraph verse-block))
+ (not (org-element-map parent
+ (cons 'plain-text
+ (remq 'timestamp org-element-all-objects))
+ (lambda (obj)
+ (or (not (stringp obj)) (org-string-nw-p obj)))
+ options t))))
+ (case (plist-get options :with-timestamps)
+ ('nil t)
+ (active
+ (not (memq (org-element-property :type blob) '(active active-range))))
+ (inactive
+ (not (memq (org-element-property :type blob)
+ '(inactive inactive-range)))))))))
+
+
+;;; The Transcoder
+;;
+;; `org-export-data' reads a parse tree (obtained with, i.e.
+;; `org-element-parse-buffer') and transcodes it into a specified
+;; back-end output. It takes care of filtering out elements or
+;; objects according to export options and organizing the output blank
+;; lines and white space are preserved. The function memoizes its
+;; results, so it is cheap to call it within transcoders.
+;;
+;; It is possible to modify locally the back-end used by
+;; `org-export-data' or even use a temporary back-end by using
+;; `org-export-data-with-backend'.
+;;
+;; Internally, three functions handle the filtering of objects and
+;; elements during the export. In particular,
+;; `org-export-ignore-element' marks an element or object so future
+;; parse tree traversals skip it, `org-export--interpret-p' tells which
+;; elements or objects should be seen as real Org syntax and
+;; `org-export-expand' transforms the others back into their original
+;; shape
+;;
+;; `org-export-transcoder' is an accessor returning appropriate
+;; translator function for a given element or object.
+
+(defun org-export-transcoder (blob info)
+ "Return appropriate transcoder for BLOB.
+INFO is a plist containing export directives."
+ (let ((type (org-element-type blob)))
+ ;; Return contents only for complete parse trees.
+ (if (eq type 'org-data) (lambda (blob contents info) contents)
+ (let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
+ (and (functionp transcoder) transcoder)))))
+
+(defun org-export-data (data info)
+ "Convert DATA into current back-end format.
+
+DATA is a parse tree, an element or an object or a secondary
+string. INFO is a plist holding export options.
+
+Return a string."
+ (or (gethash data (plist-get info :exported-data))
+ (let* ((type (org-element-type data))
+ (results
+ (cond
+ ;; Ignored element/object.
+ ((memq data (plist-get info :ignore-list)) nil)
+ ;; Plain text.
+ ((eq type 'plain-text)
+ (org-export-filter-apply-functions
+ (plist-get info :filter-plain-text)
+ (let ((transcoder (org-export-transcoder data info)))
+ (if transcoder (funcall transcoder data info) data))
+ info))
+ ;; Uninterpreted element/object: change it back to Org
+ ;; syntax and export again resulting raw string.
+ ((not (org-export--interpret-p data info))
+ (org-export-data
+ (org-export-expand
+ data
+ (mapconcat (lambda (blob) (org-export-data blob info))
+ (org-element-contents data)
+ ""))
+ info))
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
+ ;; Element/Object without contents or, as a special
+ ;; case, headline with archive tag and archived trees
+ ;; restricted to title only.
+ ((or (not (org-element-contents data))
+ (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees) 'headline)
+ (org-element-property :archivedp data)))
+ (let ((transcoder (org-export-transcoder data info)))
+ (or (and (functionp transcoder)
+ (funcall transcoder data nil info))
+ ;; Export snippets never return a nil value so
+ ;; that white spaces following them are never
+ ;; ignored.
+ (and (eq type 'export-snippet) ""))))
+ ;; Element/Object with contents.
+ (t
+ (let ((transcoder (org-export-transcoder data info)))
+ (when transcoder
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp
+ (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (element) (org-export-data element info))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing contents of the
+ ;; first paragraph in an item or
+ ;; a footnote definition, ignore
+ ;; first line's indentation: there is
+ ;; none and it might be misleading.
+ (when (eq type 'paragraph)
+ (let ((parent (org-export-get-parent data)))
+ (and
+ (eq (car (org-element-contents parent))
+ data)
+ (memq (org-element-type parent)
+ '(footnote-definition item))))))))
+ "")))
+ (funcall transcoder data
+ (if (not greaterp) contents
+ (org-element-normalize-string contents))
+ info))))))))
+ ;; Final result will be memoized before being returned.
+ (puthash
+ data
+ (cond
+ ((not results) "")
+ ((memq type '(org-data plain-text nil)) results)
+ ;; Append the same white space between elements or objects
+ ;; as in the original buffer, and call appropriate filters.
+ (t
+ (let ((results
+ (org-export-filter-apply-functions
+ (plist-get info (intern (format ":filter-%s" type)))
+ (let ((post-blank (or (org-element-property :post-blank data)
+ 0)))
+ (if (memq type org-element-all-elements)
+ (concat (org-element-normalize-string results)
+ (make-string post-blank ?\n))
+ (concat results (make-string post-blank ?\s))))
+ info)))
+ results)))
+ (plist-get info :exported-data)))))
+
+(defun org-export-data-with-backend (data backend info)
+ "Convert DATA into BACKEND format.
+
+DATA is an element, an object, a secondary string or a string.
+BACKEND is a symbol. INFO is a plist used as a communication
+channel.
+
+Unlike to `org-export-with-backend', this function will
+recursively convert DATA using BACKEND translation table."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-data
+ data
+ ;; Set-up a new communication channel with translations defined in
+ ;; BACKEND as the translate table and a new hash table for
+ ;; memoization.
+ (org-combine-plists
+ info
+ (list :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ ;; Size of the hash table is reduced since this function
+ ;; will probably be used on small trees.
+ :exported-data (make-hash-table :test 'eq :size 401)))))
+
+(defun org-export--interpret-p (blob info)
+ "Non-nil if element or object BLOB should be interpreted during export.
+If nil, BLOB will appear as raw Org syntax. Check is done
+according to export options INFO, stored as a plist."
+ (case (org-element-type blob)
+ ;; ... entities...
+ (entity (plist-get info :with-entities))
+ ;; ... emphasis...
+ ((bold italic strike-through underline)
+ (plist-get info :with-emphasize))
+ ;; ... fixed-width areas.
+ (fixed-width (plist-get info :with-fixed-width))
+ ;; ... LaTeX environments and fragments...
+ ((latex-environment latex-fragment)
+ (let ((with-latex-p (plist-get info :with-latex)))
+ (and with-latex-p (not (eq with-latex-p 'verbatim)))))
+ ;; ... sub/superscripts...
+ ((subscript superscript)
+ (let ((sub/super-p (plist-get info :with-sub-superscript)))
+ (if (eq sub/super-p '{})
+ (org-element-property :use-brackets-p blob)
+ sub/super-p)))
+ ;; ... tables...
+ (table (plist-get info :with-tables))
+ (otherwise t)))
+
+(defun org-export-expand (blob contents &optional with-affiliated)
+ "Expand a parsed element or object to its original state.
+
+BLOB is either an element or an object. CONTENTS is its
+contents, as a string or nil.
+
+When optional argument WITH-AFFILIATED is non-nil, add affiliated
+keywords before output."
+ (let ((type (org-element-type blob)))
+ (concat (and with-affiliated (memq type org-element-all-elements)
+ (org-element--interpret-affiliated-keywords blob))
+ (funcall (intern (format "org-element-%s-interpreter" type))
+ blob contents))))
+
+(defun org-export-ignore-element (element info)
+ "Add ELEMENT to `:ignore-list' in INFO.
+
+Any element in `:ignore-list' will be skipped when using
+`org-element-map'. INFO is modified by side effects."
+ (plist-put info :ignore-list (cons element (plist-get info :ignore-list))))
+
+
+
+;;; The Filter System
+;;
+;; Filters allow end-users to tweak easily the transcoded output.
+;; They are the functional counterpart of hooks, as every filter in
+;; a set is applied to the return value of the previous one.
+;;
+;; Every set is back-end agnostic. Although, a filter is always
+;; called, in addition to the string it applies to, with the back-end
+;; used as argument, so it's easy for the end-user to add back-end
+;; specific filters in the set. The communication channel, as
+;; a plist, is required as the third argument.
+;;
+;; From the developer side, filters sets can be installed in the
+;; process with the help of `org-export-define-backend', which
+;; internally stores filters as an alist. Each association has a key
+;; among the following symbols and a function or a list of functions
+;; as value.
+;;
+;; - `:filter-options' applies to the property list containing export
+;; options. Unlike to other filters, functions in this list accept
+;; two arguments instead of three: the property list containing
+;; export options and the back-end. Users can set its value through
+;; `org-export-filter-options-functions' variable.
+;;
+;; - `:filter-parse-tree' applies directly to the complete parsed
+;; tree. Users can set it through
+;; `org-export-filter-parse-tree-functions' variable.
+;;
+;; - `:filter-final-output' applies to the final transcoded string.
+;; Users can set it with `org-export-filter-final-output-functions'
+;; variable
+;;
+;; - `:filter-plain-text' applies to any string not recognized as Org
+;; syntax. `org-export-filter-plain-text-functions' allows users to
+;; configure it.
+;;
+;; - `:filter-TYPE' applies on the string returned after an element or
+;; object of type TYPE has been transcoded. A user can modify
+;; `org-export-filter-TYPE-functions'
+;;
+;; All filters sets are applied with
+;; `org-export-filter-apply-functions' function. Filters in a set are
+;; applied in a LIFO fashion. It allows developers to be sure that
+;; their filters will be applied first.
+;;
+;; Filters properties are installed in communication channel with
+;; `org-export-install-filters' function.
+;;
+;; Eventually, two hooks (`org-export-before-processing-hook' and
+;; `org-export-before-parsing-hook') are run at the beginning of the
+;; export process and just before parsing to allow for heavy structure
+;; modifications.
+
+
+;;;; Hooks
+
+(defvar org-export-before-processing-hook nil
+ "Hook run at the beginning of the export process.
+
+This is run before include keywords and macros are expanded and
+Babel code blocks executed, on a copy of the original buffer
+being exported. Visibility and narrowing are preserved. Point
+is at the beginning of the buffer.
+
+Every function in this hook will be called with one argument: the
+back-end currently used, as a symbol.")
+
+(defvar org-export-before-parsing-hook nil
+ "Hook run before parsing an export buffer.
+
+This is run after include keywords and macros have been expanded
+and Babel code blocks executed, on a copy of the original buffer
+being exported. Visibility and narrowing are preserved. Point
+is at the beginning of the buffer.
+
+Every function in this hook will be called with one argument: the
+back-end currently used, as a symbol.")
+
+
+;;;; Special Filters
+
+(defvar org-export-filter-options-functions nil
+ "List of functions applied to the export options.
+Each filter is called with two arguments: the export options, as
+a plist, and the back-end, as a symbol. It must return
+a property list containing export options.")
+
+(defvar org-export-filter-parse-tree-functions nil
+ "List of functions applied to the parsed tree.
+Each filter is called with three arguments: the parse tree, as
+returned by `org-element-parse-buffer', the back-end, as
+a symbol, and the communication channel, as a plist. It must
+return the modified parse tree to transcode.")
+
+(defvar org-export-filter-plain-text-functions nil
+ "List of functions applied to plain text.
+Each filter is called with three arguments: a string which
+contains no Org syntax, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
+(defvar org-export-filter-final-output-functions nil
+ "List of functions applied to the transcoded string.
+Each filter is called with three arguments: the full transcoded
+string, the back-end, as a symbol, and the communication channel,
+as a plist. It must return a string that will be used as the
+final export output.")
+
+
+;;;; Elements Filters
+
+(defvar org-export-filter-babel-call-functions nil
+ "List of functions applied to a transcoded babel-call.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-center-block-functions nil
+ "List of functions applied to a transcoded center block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-clock-functions nil
+ "List of functions applied to a transcoded clock.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-comment-functions nil
+ "List of functions applied to a transcoded comment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-comment-block-functions nil
+ "List of functions applied to a transcoded comment-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-diary-sexp-functions nil
+ "List of functions applied to a transcoded diary-sexp.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-drawer-functions nil
+ "List of functions applied to a transcoded drawer.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-dynamic-block-functions nil
+ "List of functions applied to a transcoded dynamic-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-example-block-functions nil
+ "List of functions applied to a transcoded example-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-export-block-functions nil
+ "List of functions applied to a transcoded export-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-fixed-width-functions nil
+ "List of functions applied to a transcoded fixed-width.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-footnote-definition-functions nil
+ "List of functions applied to a transcoded footnote-definition.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-headline-functions nil
+ "List of functions applied to a transcoded headline.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-horizontal-rule-functions nil
+ "List of functions applied to a transcoded horizontal-rule.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inlinetask-functions nil
+ "List of functions applied to a transcoded inlinetask.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-item-functions nil
+ "List of functions applied to a transcoded item.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-keyword-functions nil
+ "List of functions applied to a transcoded keyword.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-latex-environment-functions nil
+ "List of functions applied to a transcoded latex-environment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-node-property-functions nil
+ "List of functions applied to a transcoded node-property.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-paragraph-functions nil
+ "List of functions applied to a transcoded paragraph.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-plain-list-functions nil
+ "List of functions applied to a transcoded plain-list.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-planning-functions nil
+ "List of functions applied to a transcoded planning.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-property-drawer-functions nil
+ "List of functions applied to a transcoded property-drawer.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-quote-block-functions nil
+ "List of functions applied to a transcoded quote block.
+Each filter is called with three arguments: the transcoded quote
+data, as a string, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
+(defvar org-export-filter-quote-section-functions nil
+ "List of functions applied to a transcoded quote-section.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-section-functions nil
+ "List of functions applied to a transcoded section.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-special-block-functions nil
+ "List of functions applied to a transcoded special block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-src-block-functions nil
+ "List of functions applied to a transcoded src-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-functions nil
+ "List of functions applied to a transcoded table.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-cell-functions nil
+ "List of functions applied to a transcoded table-cell.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-table-row-functions nil
+ "List of functions applied to a transcoded table-row.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-verse-block-functions nil
+ "List of functions applied to a transcoded verse block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+
+;;;; Objects Filters
+
+(defvar org-export-filter-bold-functions nil
+ "List of functions applied to transcoded bold text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-code-functions nil
+ "List of functions applied to transcoded code text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-entity-functions nil
+ "List of functions applied to a transcoded entity.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-export-snippet-functions nil
+ "List of functions applied to a transcoded export-snippet.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-footnote-reference-functions nil
+ "List of functions applied to a transcoded footnote-reference.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inline-babel-call-functions nil
+ "List of functions applied to a transcoded inline-babel-call.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-inline-src-block-functions nil
+ "List of functions applied to a transcoded inline-src-block.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-italic-functions nil
+ "List of functions applied to transcoded italic text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-latex-fragment-functions nil
+ "List of functions applied to a transcoded latex-fragment.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-line-break-functions nil
+ "List of functions applied to a transcoded line-break.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-link-functions nil
+ "List of functions applied to a transcoded link.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-radio-target-functions nil
+ "List of functions applied to a transcoded radio-target.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-statistics-cookie-functions nil
+ "List of functions applied to a transcoded statistics-cookie.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-strike-through-functions nil
+ "List of functions applied to transcoded strike-through text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-subscript-functions nil
+ "List of functions applied to a transcoded subscript.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-superscript-functions nil
+ "List of functions applied to a transcoded superscript.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-target-functions nil
+ "List of functions applied to a transcoded target.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-timestamp-functions nil
+ "List of functions applied to a transcoded timestamp.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-underline-functions nil
+ "List of functions applied to transcoded underline text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+(defvar org-export-filter-verbatim-functions nil
+ "List of functions applied to transcoded verbatim text.
+Each filter is called with three arguments: the transcoded data,
+as a string, the back-end, as a symbol, and the communication
+channel, as a plist. It must return a string or nil.")
+
+
+;;;; Filters Tools
+;;
+;; Internal function `org-export-install-filters' installs filters
+;; hard-coded in back-ends (developer filters) and filters from global
+;; variables (user filters) in the communication channel.
+;;
+;; Internal function `org-export-filter-apply-functions' takes care
+;; about applying each filter in order to a given data. It ignores
+;; filters returning a nil value but stops whenever a filter returns
+;; an empty string.
+
+(defun org-export-filter-apply-functions (filters value info)
+ "Call every function in FILTERS.
+
+Functions are called with arguments VALUE, current export
+back-end's name and INFO. A function returning a nil value will
+be skipped. If it returns the empty string, the process ends and
+VALUE is ignored.
+
+Call is done in a LIFO fashion, to be sure that developer
+specified filters, if any, are called first."
+ (catch 'exit
+ (let* ((backend (plist-get info :back-end))
+ (backend-name (and backend (org-export-backend-name backend))))
+ (dolist (filter filters value)
+ (let ((result (funcall filter value backend-name info)))
+ (cond ((not result) value)
+ ((equal value "") (throw 'exit nil))
+ (t (setq value result))))))))
+
+(defun org-export-install-filters (info)
+ "Install filters properties in communication channel.
+INFO is a plist containing the current communication channel.
+Return the updated communication channel."
+ (let (plist)
+ ;; Install user-defined filters with `org-export-filters-alist'
+ ;; and filters already in INFO (through ext-plist mechanism).
+ (mapc (lambda (p)
+ (let* ((prop (car p))
+ (info-value (plist-get info prop))
+ (default-value (symbol-value (cdr p))))
+ (setq plist
+ (plist-put plist prop
+ ;; Filters in INFO will be called
+ ;; before those user provided.
+ (append (if (listp info-value) info-value
+ (list info-value))
+ default-value)))))
+ org-export-filters-alist)
+ ;; Prepend back-end specific filters to that list.
+ (mapc (lambda (p)
+ ;; Single values get consed, lists are appended.
+ (let ((key (car p)) (value (cdr p)))
+ (when value
+ (setq plist
+ (plist-put
+ plist key
+ (if (atom value) (cons value (plist-get plist key))
+ (append value (plist-get plist key))))))))
+ (org-export-get-all-filters (plist-get info :back-end)))
+ ;; Return new communication channel.
+ (org-combine-plists info plist)))
+
+
+
+;;; Core functions
+;;
+;; This is the room for the main function, `org-export-as', along with
+;; its derivative, `org-export-string-as'.
+;; `org-export--copy-to-kill-ring-p' determines if output of these
+;; function should be added to kill ring.
+;;
+;; Note that `org-export-as' doesn't really parse the current buffer,
+;; but a copy of it (with the same buffer-local variables and
+;; visibility), where macros and include keywords are expanded and
+;; Babel blocks are executed, if appropriate.
+;; `org-export-with-buffer-copy' macro prepares that copy.
+;;
+;; File inclusion is taken care of by
+;; `org-export-expand-include-keyword' and
+;; `org-export--prepare-file-contents'. Structure wise, including
+;; a whole Org file in a buffer often makes little sense. For
+;; example, if the file contains a headline and the include keyword
+;; was within an item, the item should contain the headline. That's
+;; why file inclusion should be done before any structure can be
+;; associated to the file, that is before parsing.
+;;
+;; `org-export-insert-default-template' is a command to insert
+;; a default template (or a back-end specific template) at point or in
+;; current subtree.
+
+(defun org-export-copy-buffer ()
+ "Return a copy of the current buffer.
+The copy preserves Org buffer-local variables, visibility and
+narrowing."
+ (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer)))
+ (new-buf (generate-new-buffer (buffer-name))))
+ (with-current-buffer new-buf
+ (funcall copy-buffer-fun)
+ (set-buffer-modified-p nil))
+ new-buf))
+
+(defmacro org-export-with-buffer-copy (&rest body)
+ "Apply BODY in a copy of the current buffer.
+The copy preserves local variables, visibility and contents of
+the original buffer. Point is at the beginning of the buffer
+when BODY is applied."
+ (declare (debug t))
+ (org-with-gensyms (buf-copy)
+ `(let ((,buf-copy (org-export-copy-buffer)))
+ (unwind-protect
+ (with-current-buffer ,buf-copy
+ (goto-char (point-min))
+ (progn ,@body))
+ (and (buffer-live-p ,buf-copy)
+ ;; Kill copy without confirmation.
+ (progn (with-current-buffer ,buf-copy
+ (restore-buffer-modified-p nil))
+ (kill-buffer ,buf-copy)))))))
+
+(defun org-export--generate-copy-script (buffer)
+ "Generate a function duplicating BUFFER.
+
+The copy will preserve local variables, visibility, contents and
+narrowing of the original buffer. If a region was active in
+BUFFER, contents will be narrowed to that region instead.
+
+The resulting function can be evaluated at a later time, from
+another buffer, effectively cloning the original buffer there.
+
+The function assumes BUFFER's major mode is `org-mode'."
+ (with-current-buffer buffer
+ `(lambda ()
+ (let ((inhibit-modification-hooks t))
+ ;; Set major mode. Ignore `org-mode-hook' as it has been run
+ ;; already in BUFFER.
+ (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode))
+ ;; Copy specific buffer local variables and variables set
+ ;; through BIND keywords.
+ ,@(let ((bound-variables (org-export--list-bound-variables))
+ vars)
+ (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars)
+ (when (consp entry)
+ (let ((var (car entry))
+ (val (cdr entry)))
+ (and (not (eq var 'org-font-lock-keywords))
+ (or (memq var
+ '(default-directory
+ buffer-file-name
+ buffer-file-coding-system))
+ (assq var bound-variables)
+ (string-match "^\\(org-\\|orgtbl-\\)"
+ (symbol-name var)))
+ ;; Skip unreadable values, as they cannot be
+ ;; sent to external process.
+ (or (not val) (ignore-errors (read (format "%S" val))))
+ (push `(set (make-local-variable (quote ,var))
+ (quote ,val))
+ vars))))))
+ ;; Whole buffer contents.
+ (insert
+ ,(org-with-wide-buffer
+ (buffer-substring-no-properties
+ (point-min) (point-max))))
+ ;; Narrowing.
+ ,(if (org-region-active-p)
+ `(narrow-to-region ,(region-beginning) ,(region-end))
+ `(narrow-to-region ,(point-min) ,(point-max)))
+ ;; Current position of point.
+ (goto-char ,(point))
+ ;; Overlays with invisible property.
+ ,@(let (ov-set)
+ (mapc
+ (lambda (ov)
+ (let ((invis-prop (overlay-get ov 'invisible)))
+ (when invis-prop
+ (push `(overlay-put
+ (make-overlay ,(overlay-start ov)
+ ,(overlay-end ov))
+ 'invisible (quote ,invis-prop))
+ ov-set))))
+ (overlays-in (point-min) (point-max)))
+ ov-set)))))
+
+;;;###autoload
+(defun org-export-as
+ (backend &optional subtreep visible-only body-only ext-plist)
+ "Transcode current Org buffer into BACKEND code.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+If narrowing is active in the current buffer, only transcode its
+narrowed part.
+
+If a region is active, transcode that region.
+
+When optional argument SUBTREEP is non-nil, transcode the
+sub-tree at point, extracting information from the headline
+properties first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+When optional argument BODY-ONLY is non-nil, only return body
+code, without surrounding template.
+
+Optional argument EXT-PLIST, when provided, is a property list
+with external parameters overriding Org default settings, but
+still inferior to file-local settings.
+
+Return code as a string."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
+ (save-excursion
+ (save-restriction
+ ;; Narrow buffer to an appropriate region or subtree for
+ ;; parsing. If parsing subtree, be sure to remove main headline
+ ;; too.
+ (cond ((org-region-active-p)
+ (narrow-to-region (region-beginning) (region-end)))
+ (subtreep
+ (org-narrow-to-subtree)
+ (goto-char (point-min))
+ (forward-line)
+ (narrow-to-region (point) (point-max))))
+ ;; Initialize communication channel with original buffer
+ ;; attributes, unavailable in its copy.
+ (let* ((org-export-current-backend (org-export-backend-name backend))
+ (info (org-combine-plists
+ (list :export-options
+ (delq nil
+ (list (and subtreep 'subtree)
+ (and visible-only 'visible-only)
+ (and body-only 'body-only))))
+ (org-export--get-buffer-attributes)))
+ tree)
+ ;; Update communication channel and get parse tree. Buffer
+ ;; isn't parsed directly. Instead, a temporary copy is
+ ;; created, where include keywords, macros are expanded and
+ ;; code blocks are evaluated.
+ (org-export-with-buffer-copy
+ ;; Run first hook with current back-end's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
+ (org-export-expand-include-keyword)
+ ;; Update macro templates since #+INCLUDE keywords might have
+ ;; added some new ones.
+ (org-macro-initialize-templates)
+ (org-macro-replace-all org-macro-templates)
+ (org-export-execute-babel-code)
+ ;; Update radio targets since keyword inclusion might have
+ ;; added some more.
+ (org-update-radio-target-regexp)
+ ;; Run last hook with current back-end's name as argument.
+ (goto-char (point-min))
+ (save-excursion
+ (run-hook-with-args 'org-export-before-parsing-hook
+ (org-export-backend-name backend)))
+ ;; Update communication channel with environment. Also
+ ;; install user's and developer's filters.
+ (setq info
+ (org-export-install-filters
+ (org-combine-plists
+ info (org-export-get-environment backend subtreep ext-plist))))
+ ;; Special case: provide original file name or buffer name as
+ ;; default value for :title property.
+ (unless (plist-get info :title)
+ (plist-put
+ info :title
+ (let ((file (plist-get info :input-file)))
+ (if file (file-name-sans-extension (file-name-nondirectory file))
+ (plist-get info :input-buffer)))))
+ ;; Expand export-specific set of macros: {{{author}}},
+ ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done
+ ;; once regular macros have been expanded, since document
+ ;; keywords may contain one of them.
+ (org-macro-replace-all
+ (list (cons "author"
+ (org-element-interpret-data (plist-get info :author)))
+ (cons "date"
+ (org-element-interpret-data (plist-get info :date)))
+ ;; EMAIL is not a parsed keyword: store it as-is.
+ (cons "email" (or (plist-get info :email) ""))
+ (cons "title"
+ (org-element-interpret-data (plist-get info :title)))))
+ ;; Call options filters and update export options. We do not
+ ;; use `org-export-filter-apply-functions' here since the
+ ;; arity of such filters is different.
+ (let ((backend-name (org-export-backend-name backend)))
+ (dolist (filter (plist-get info :filter-options))
+ (let ((result (funcall filter info backend-name)))
+ (when result (setq info result)))))
+ ;; Parse buffer and call parse-tree filter on it.
+ (setq tree
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree)
+ (org-element-parse-buffer nil visible-only) info))
+ ;; Now tree is complete, compute its properties and add them
+ ;; to communication channel.
+ (setq info
+ (org-combine-plists
+ info (org-export-collect-tree-properties tree info)))
+ ;; Eventually transcode TREE. Wrap the resulting string into
+ ;; a template.
+ (let* ((body (org-element-normalize-string
+ (or (org-export-data tree info) "")))
+ (inner-template (cdr (assq 'inner-template
+ (plist-get info :translate-alist))))
+ (full-body (if (not (functionp inner-template)) body
+ (funcall inner-template body info)))
+ (template (cdr (assq 'template
+ (plist-get info :translate-alist)))))
+ ;; Remove all text properties since they cannot be
+ ;; retrieved from an external process. Finally call
+ ;; final-output filter and return result.
+ (org-no-properties
+ (org-export-filter-apply-functions
+ (plist-get info :filter-final-output)
+ (if (or (not (functionp template)) body-only) full-body
+ (funcall template full-body info))
+ info))))))))
+
+;;;###autoload
+(defun org-export-string-as (string backend &optional body-only ext-plist)
+ "Transcode STRING into BACKEND code.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+When optional argument BODY-ONLY is non-nil, only return body
+code, without preamble nor postamble.
+
+Optional argument EXT-PLIST, when provided, is a property list
+with external parameters overriding Org default settings, but
+still inferior to file-local settings.
+
+Return code as a string."
+ (with-temp-buffer
+ (insert string)
+ (let ((org-inhibit-startup t)) (org-mode))
+ (org-export-as backend nil nil body-only ext-plist)))
+
+;;;###autoload
+(defun org-export-replace-region-by (backend)
+ "Replace the active region by its export to BACKEND.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end."
+ (if (not (org-region-active-p))
+ (user-error "No active region to replace")
+ (let* ((beg (region-beginning))
+ (end (region-end))
+ (str (buffer-substring beg end)) rpl)
+ (setq rpl (org-export-string-as str backend t))
+ (delete-region beg end)
+ (insert rpl))))
+
+;;;###autoload
+(defun org-export-insert-default-template (&optional backend subtreep)
+ "Insert all export keywords with default values at beginning of line.
+
+BACKEND is a symbol referring to the name of a registered export
+back-end, for which specific export options should be added to
+the template, or `default' for default template. When it is nil,
+the user will be prompted for a category.
+
+If SUBTREEP is non-nil, export configuration will be set up
+locally for the subtree through node properties."
+ (interactive)
+ (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer"))
+ (when (and subtreep (org-before-first-heading-p))
+ (user-error "No subtree to set export options for"))
+ (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point))))
+ (backend
+ (or backend
+ (intern
+ (org-completing-read
+ "Options category: "
+ (cons "default"
+ (mapcar (lambda (b)
+ (symbol-name (org-export-backend-name b)))
+ org-export--registered-backends))))))
+ options keywords)
+ ;; Populate OPTIONS and KEYWORDS.
+ (dolist (entry (cond ((eq backend 'default) org-export-options-alist)
+ ((org-export-backend-p backend)
+ (org-export-backend-options backend))
+ (t (org-export-backend-options
+ (org-export-get-backend backend)))))
+ (let ((keyword (nth 1 entry))
+ (option (nth 2 entry)))
+ (cond
+ (keyword (unless (assoc keyword keywords)
+ (let ((value
+ (if (eq (nth 4 entry) 'split)
+ (mapconcat 'identity (eval (nth 3 entry)) " ")
+ (eval (nth 3 entry)))))
+ (push (cons keyword value) keywords))))
+ (option (unless (assoc option options)
+ (push (cons option (eval (nth 3 entry))) options))))))
+ ;; Move to an appropriate location in order to insert options.
+ (unless subtreep (beginning-of-line))
+ ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the
+ ;; list of available keywords.
+ (when (assoc "TITLE" keywords)
+ (let ((title
+ (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file))))
+ (buffer-name (buffer-base-buffer)))))
+ (if (not subtreep) (insert (format "#+TITLE: %s\n" title))
+ (org-entry-put node "EXPORT_TITLE" title))))
+ (when (assoc "DATE" keywords)
+ (let ((date (with-temp-buffer (org-insert-time-stamp (current-time)))))
+ (if (not subtreep) (insert "#+DATE: " date "\n")
+ (org-entry-put node "EXPORT_DATE" date))))
+ (when (assoc "AUTHOR" keywords)
+ (let ((author (cdr (assoc "AUTHOR" keywords))))
+ (if subtreep (org-entry-put node "EXPORT_AUTHOR" author)
+ (insert
+ (format "#+AUTHOR:%s\n"
+ (if (not (org-string-nw-p author)) ""
+ (concat " " author)))))))
+ (when (assoc "EMAIL" keywords)
+ (let ((email (cdr (assoc "EMAIL" keywords))))
+ (if subtreep (org-entry-put node "EXPORT_EMAIL" email)
+ (insert
+ (format "#+EMAIL:%s\n"
+ (if (not (org-string-nw-p email)) ""
+ (concat " " email)))))))
+ ;; Then (multiple) OPTIONS lines. Never go past fill-column.
+ (when options
+ (let ((items
+ (mapcar
+ #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt)))
+ (sort options (lambda (k1 k2) (string< (car k1) (car k2)))))))
+ (if subtreep
+ (org-entry-put
+ node "EXPORT_OPTIONS" (mapconcat 'identity items " "))
+ (while items
+ (insert "#+OPTIONS:")
+ (let ((width 10))
+ (while (and items
+ (< (+ width (length (car items)) 1) fill-column))
+ (let ((item (pop items)))
+ (insert " " item)
+ (incf width (1+ (length item))))))
+ (insert "\n")))))
+ ;; And the rest of keywords.
+ (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2)))))
+ (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL"))
+ (let ((val (cdr key)))
+ (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
+ (insert
+ (format "#+%s:%s\n"
+ (car key)
+ (if (org-string-nw-p val) (format " %s" val) "")))))))))
+
+(defun org-export-expand-include-keyword (&optional included dir)
+ "Expand every include keyword in buffer.
+Optional argument INCLUDED is a list of included file names along
+with their line restriction, when appropriate. It is used to
+avoid infinite recursion. Optional argument DIR is the current
+working directory. It is used to properly resolve relative
+paths."
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type element) 'keyword)
+ (beginning-of-line)
+ ;; Extract arguments from keyword's value.
+ (let* ((value (org-element-property :value element))
+ (ind (org-get-indentation))
+ (file (and (string-match
+ "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
+ (prog1 (expand-file-name
+ (org-remove-double-quotes
+ (match-string 1 value))
+ dir)
+ (setq value (replace-match "" nil nil value)))))
+ (lines
+ (and (string-match
+ ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
+ value)
+ (prog1 (match-string 1 value)
+ (setq value (replace-match "" nil nil value)))))
+ (env (cond ((string-match "\\<example\\>" value) 'example)
+ ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
+ (match-string 1 value))))
+ ;; Minimal level of included file defaults to the child
+ ;; level of the current headline, if any, or one. It
+ ;; only applies is the file is meant to be included as
+ ;; an Org one.
+ (minlevel
+ (and (not env)
+ (if (string-match ":minlevel +\\([0-9]+\\)" value)
+ (prog1 (string-to-number (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))
+ (let ((cur (org-current-level)))
+ (if cur (1+ (org-reduced-level cur)) 1))))))
+ ;; Remove keyword.
+ (delete-region (point) (progn (forward-line) (point)))
+ (cond
+ ((not file) nil)
+ ((not (file-readable-p file))
+ (error "Cannot include file %s" file))
+ ;; Check if files has already been parsed. Look after
+ ;; inclusion lines too, as different parts of the same file
+ ;; can be included too.
+ ((member (list file lines) included)
+ (error "Recursive file inclusion: %s" file))
+ (t
+ (cond
+ ((eq env 'example)
+ (insert
+ (let ((ind-str (make-string ind ? ))
+ (contents
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n"
+ ind-str contents ind-str))))
+ ((stringp env)
+ (insert
+ (let ((ind-str (make-string ind ? ))
+ (contents
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n"
+ ind-str env contents ind-str))))
+ (t
+ (insert
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (insert
+ (org-export--prepare-file-contents file lines ind minlevel))
+ (org-export-expand-include-keyword
+ (cons (list file lines) included)
+ (file-name-directory file))
+ (buffer-string)))))))))))))
+
+(defun org-export--prepare-file-contents (file &optional lines ind minlevel)
+ "Prepare the contents of FILE for inclusion and return them as a string.
+
+When optional argument LINES is a string specifying a range of
+lines, include only those lines.
+
+Optional argument IND, when non-nil, is an integer specifying the
+global indentation of returned contents. Since its purpose is to
+allow an included file to stay in the same environment it was
+created \(i.e., a list item), it doesn't apply past the first
+headline encountered.
+
+Optional argument MINLEVEL, when non-nil, is an integer
+specifying the level that any top-level headline in the included
+file should have."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when lines
+ (let* ((lines (split-string lines "-"))
+ (lbeg (string-to-number (car lines)))
+ (lend (string-to-number (cadr lines)))
+ (beg (if (zerop lbeg) (point-min)
+ (goto-char (point-min))
+ (forward-line (1- lbeg))
+ (point)))
+ (end (if (zerop lend) (point-max)
+ (goto-char (point-min))
+ (forward-line (1- lend))
+ (point))))
+ (narrow-to-region beg end)))
+ ;; Remove blank lines at beginning and end of contents. The logic
+ ;; behind that removal is that blank lines around include keyword
+ ;; override blank lines in included file.
+ (goto-char (point-min))
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (delete-region (point) (point-max))
+ ;; If IND is set, preserve indentation of include keyword until
+ ;; the first headline encountered.
+ (when ind
+ (unless (eq major-mode 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode)))
+ (goto-char (point-min))
+ (let ((ind-str (make-string ind ? )))
+ (while (not (or (eobp) (looking-at org-outline-regexp-bol)))
+ ;; Do not move footnote definitions out of column 0.
+ (unless (and (looking-at org-footnote-definition-re)
+ (eq (org-element-type (org-element-at-point))
+ 'footnote-definition))
+ (insert ind-str))
+ (forward-line))))
+ ;; When MINLEVEL is specified, compute minimal level for headlines
+ ;; in the file (CUR-MIN), and remove stars to each headline so
+ ;; that headlines with minimal level have a level of MINLEVEL.
+ (when minlevel
+ (unless (eq major-mode 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode)))
+ (org-with-limited-levels
+ (let ((levels (org-map-entries
+ (lambda () (org-reduced-level (org-current-level))))))
+ (when levels
+ (let ((offset (- minlevel (apply 'min levels))))
+ (unless (zerop offset)
+ (when org-odd-levels-only (setq offset (* offset 2)))
+ ;; Only change stars, don't bother moving whole
+ ;; sections.
+ (org-map-entries
+ (lambda () (if (< offset 0) (delete-char (abs offset))
+ (insert (make-string offset ?*)))))))))))
+ (org-element-normalize-string (buffer-string))))
+
+(defun org-export-execute-babel-code ()
+ "Execute every Babel code in the visible part of current buffer."
+ ;; Get a pristine copy of current buffer so Babel references can be
+ ;; properly resolved.
+ (let ((reference (org-export-copy-buffer)))
+ (unwind-protect (let ((org-current-export-file reference))
+ (org-babel-exp-process-buffer))
+ (kill-buffer reference))))
+
+(defun org-export--copy-to-kill-ring-p ()
+ "Return a non-nil value when output should be added to the kill ring.
+See also `org-export-copy-to-kill-ring'."
+ (if (eq org-export-copy-to-kill-ring 'if-interactive)
+ (not (or executing-kbd-macro noninteractive))
+ (eq org-export-copy-to-kill-ring t)))
+
+
+
+;;; Tools For Back-Ends
+;;
+;; A whole set of tools is available to help build new exporters. Any
+;; function general enough to have its use across many back-ends
+;; should be added here.
+
+;;;; For Affiliated Keywords
+;;
+;; `org-export-read-attribute' reads a property from a given element
+;; as a plist. It can be used to normalize affiliated keywords'
+;; syntax.
+;;
+;; Since captions can span over multiple lines and accept dual values,
+;; their internal representation is a bit tricky. Therefore,
+;; `org-export-get-caption' transparently returns a given element's
+;; caption as a secondary string.
+
+(defun org-export-read-attribute (attribute element &optional property)
+ "Turn ATTRIBUTE property from ELEMENT into a plist.
+
+When optional argument PROPERTY is non-nil, return the value of
+that property within attributes.
+
+This function assumes attributes are defined as \":keyword
+value\" pairs. It is appropriate for `:attr_html' like
+properties.
+
+All values will become strings except the empty string and
+\"nil\", which will become nil. Also, values containing only
+double quotes will be read as-is, which means that \"\" value
+will become the empty string."
+ (let* ((prepare-value
+ (lambda (str)
+ (save-match-data
+ (cond ((member str '(nil "" "nil")) nil)
+ ((string-match "^\"\\(\"+\\)?\"$" str)
+ (or (match-string 1 str) ""))
+ (t str)))))
+ (attributes
+ (let ((value (org-element-property attribute element)))
+ (when value
+ (let ((s (mapconcat 'identity value " ")) result)
+ (while (string-match
+ "\\(?:^\\|[ \t]+\\)\\(:[-a-zA-Z0-9_]+\\)\\([ \t]+\\|$\\)"
+ s)
+ (let ((value (substring s 0 (match-beginning 0))))
+ (push (funcall prepare-value value) result))
+ (push (intern (match-string 1 s)) result)
+ (setq s (substring s (match-end 0))))
+ ;; Ignore any string before first property with `cdr'.
+ (cdr (nreverse (cons (funcall prepare-value s) result))))))))
+ (if property (plist-get attributes property) attributes)))
+
+(defun org-export-get-caption (element &optional shortp)
+ "Return caption from ELEMENT as a secondary string.
+
+When optional argument SHORTP is non-nil, return short caption,
+as a secondary string, instead.
+
+Caption lines are separated by a white space."
+ (let ((full-caption (org-element-property :caption element)) caption)
+ (dolist (line full-caption (cdr caption))
+ (let ((cap (funcall (if shortp 'cdr 'car) line)))
+ (when cap
+ (setq caption (nconc (list " ") (copy-sequence cap) caption)))))))
+
+
+;;;; For Derived Back-ends
+;;
+;; `org-export-with-backend' is a function allowing to locally use
+;; another back-end to transcode some object or element. In a derived
+;; back-end, it may be used as a fall-back function once all specific
+;; cases have been treated.
+
+(defun org-export-with-backend (backend data &optional contents info)
+ "Call a transcoder from BACKEND on DATA.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. DATA is an Org element, object, secondary
+string or string. CONTENTS, when non-nil, is the transcoded
+contents of DATA element, as a string. INFO, when non-nil, is
+the communication channel used for export, as a plist."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
+ (let ((type (org-element-type data)))
+ (if (memq type '(nil org-data)) (error "No foreign transcoder available")
+ (let* ((all-transcoders (org-export-get-all-transcoders backend))
+ (transcoder (cdr (assq type all-transcoders))))
+ (if (not (functionp transcoder))
+ (error "No foreign transcoder available")
+ (funcall
+ transcoder data contents
+ (org-combine-plists
+ info (list :back-end backend
+ :translate-alist all-transcoders
+ :exported-data (make-hash-table :test 'eq :size 401)))))))))
+
+
+;;;; For Export Snippets
+;;
+;; Every export snippet is transmitted to the back-end. Though, the
+;; latter will only retain one type of export-snippet, ignoring
+;; others, based on the former's target back-end. The function
+;; `org-export-snippet-backend' returns that back-end for a given
+;; export-snippet.
+
+(defun org-export-snippet-backend (export-snippet)
+ "Return EXPORT-SNIPPET targeted back-end as a symbol.
+Translation, with `org-export-snippet-translation-alist', is
+applied."
+ (let ((back-end (org-element-property :back-end export-snippet)))
+ (intern
+ (or (cdr (assoc back-end org-export-snippet-translation-alist))
+ back-end))))
+
+
+;;;; For Footnotes
+;;
+;; `org-export-collect-footnote-definitions' is a tool to list
+;; actually used footnotes definitions in the whole parse tree, or in
+;; a headline, in order to add footnote listings throughout the
+;; transcoded data.
+;;
+;; `org-export-footnote-first-reference-p' is a predicate used by some
+;; back-ends, when they need to attach the footnote definition only to
+;; the first occurrence of the corresponding label.
+;;
+;; `org-export-get-footnote-definition' and
+;; `org-export-get-footnote-number' provide easier access to
+;; additional information relative to a footnote reference.
+
+(defun org-export-collect-footnote-definitions (data info)
+ "Return an alist between footnote numbers, labels and definitions.
+
+DATA is the parse tree from which definitions are collected.
+INFO is the plist used as a communication channel.
+
+Definitions are sorted by order of references. They either
+appear as Org data or as a secondary string for inlined
+footnotes. Unreferenced definitions are ignored."
+ (let* (num-alist
+ collect-fn ; for byte-compiler.
+ (collect-fn
+ (function
+ (lambda (data)
+ ;; Collect footnote number, label and definition in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (fn)
+ (when (org-export-footnote-first-reference-p fn info)
+ (let ((def (org-export-get-footnote-definition fn info)))
+ (push
+ (list (org-export-get-footnote-number fn info)
+ (org-element-property :label fn)
+ def)
+ num-alist)
+ ;; Also search in definition for nested footnotes.
+ (when (eq (org-element-property :type fn) 'standard)
+ (funcall collect-fn def)))))
+ ;; Don't enter footnote definitions since it will happen
+ ;; when their first reference is found.
+ info nil 'footnote-definition)))))
+ (funcall collect-fn (plist-get info :parse-tree))
+ (reverse num-alist)))
+
+(defun org-export-footnote-first-reference-p (footnote-reference info)
+ "Non-nil when a footnote reference is the first one for its label.
+
+FOOTNOTE-REFERENCE is the footnote reference being considered.
+INFO is the plist used as a communication channel."
+ (let ((label (org-element-property :label footnote-reference)))
+ ;; Anonymous footnotes are always a first reference.
+ (if (not label) t
+ ;; Otherwise, return the first footnote with the same LABEL and
+ ;; test if it is equal to FOOTNOTE-REFERENCE.
+ (let* (search-refs ; for byte-compiler.
+ (search-refs
+ (function
+ (lambda (data)
+ (org-element-map data 'footnote-reference
+ (lambda (fn)
+ (cond
+ ((string= (org-element-property :label fn) label)
+ (throw 'exit fn))
+ ;; If FN isn't inlined, be sure to traverse its
+ ;; definition before resuming search. See
+ ;; comments in `org-export-get-footnote-number'
+ ;; for more information.
+ ((eq (org-element-property :type fn) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition fn info)))))
+ ;; Don't enter footnote definitions since it will
+ ;; happen when their first reference is found.
+ info 'first-match 'footnote-definition)))))
+ (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree)))
+ footnote-reference)))))
+
+(defun org-export-get-footnote-definition (footnote-reference info)
+ "Return definition of FOOTNOTE-REFERENCE as parsed data.
+INFO is the plist used as a communication channel. If no such
+definition can be found, return the \"DEFINITION NOT FOUND\"
+string."
+ (let ((label (org-element-property :label footnote-reference)))
+ (or (org-element-property :inline-definition footnote-reference)
+ (cdr (assoc label (plist-get info :footnote-definition-alist)))
+ "DEFINITION NOT FOUND.")))
+
+(defun org-export-get-footnote-number (footnote info)
+ "Return number associated to a footnote.
+
+FOOTNOTE is either a footnote reference or a footnote definition.
+INFO is the plist used as a communication channel."
+ (let* ((label (org-element-property :label footnote))
+ seen-refs
+ search-ref ; For byte-compiler.
+ (search-ref
+ (function
+ (lambda (data)
+ ;; Search footnote references through DATA, filling
+ ;; SEEN-REFS along the way.
+ (org-element-map data 'footnote-reference
+ (lambda (fn)
+ (let ((fn-lbl (org-element-property :label fn)))
+ (cond
+ ;; Anonymous footnote match: return number.
+ ((and (not fn-lbl) (eq fn footnote))
+ (throw 'exit (1+ (length seen-refs))))
+ ;; Labels match: return number.
+ ((and label (string= label fn-lbl))
+ (throw 'exit (1+ (length seen-refs))))
+ ;; Anonymous footnote: it's always a new one.
+ ;; Also, be sure to return nil from the `cond' so
+ ;; `first-match' doesn't get us out of the loop.
+ ((not fn-lbl) (push 'inline seen-refs) nil)
+ ;; Label not seen so far: add it so SEEN-REFS.
+ ;;
+ ;; Also search for subsequent references in
+ ;; footnote definition so numbering follows
+ ;; reading logic. Note that we don't have to care
+ ;; about inline definitions, since
+ ;; `org-element-map' already traverses them at the
+ ;; right time.
+ ;;
+ ;; Once again, return nil to stay in the loop.
+ ((not (member fn-lbl seen-refs))
+ (push fn-lbl seen-refs)
+ (funcall search-ref
+ (org-export-get-footnote-definition fn info))
+ nil))))
+ ;; Don't enter footnote definitions since it will
+ ;; happen when their first reference is found.
+ info 'first-match 'footnote-definition)))))
+ (catch 'exit (funcall search-ref (plist-get info :parse-tree)))))
+
+
+;;;; For Headlines
+;;
+;; `org-export-get-relative-level' is a shortcut to get headline
+;; level, relatively to the lower headline level in the parsed tree.
+;;
+;; `org-export-get-headline-number' returns the section number of an
+;; headline, while `org-export-number-to-roman' allows to convert it
+;; to roman numbers.
+;;
+;; `org-export-low-level-p', `org-export-first-sibling-p' and
+;; `org-export-last-sibling-p' are three useful predicates when it
+;; comes to fulfill the `:headline-levels' property.
+;;
+;; `org-export-get-tags', `org-export-get-category' and
+;; `org-export-get-node-property' extract useful information from an
+;; headline or a parent headline. They all handle inheritance.
+;;
+;; `org-export-get-alt-title' tries to retrieve an alternative title,
+;; as a secondary string, suitable for table of contents. It falls
+;; back onto default title.
+
+(defun org-export-get-relative-level (headline info)
+ "Return HEADLINE relative level within current parsed tree.
+INFO is a plist holding contextual information."
+ (+ (org-element-property :level headline)
+ (or (plist-get info :headline-offset) 0)))
+
+(defun org-export-low-level-p (headline info)
+ "Non-nil when HEADLINE is considered as low level.
+
+INFO is a plist used as a communication channel.
+
+A low level headlines has a relative level greater than
+`:headline-levels' property value.
+
+Return value is the difference between HEADLINE relative level
+and the last level being considered as high enough, or nil."
+ (let ((limit (plist-get info :headline-levels)))
+ (when (wholenump limit)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (> level limit) (- level limit))))))
+
+(defun org-export-get-headline-number (headline info)
+ "Return HEADLINE numbering as a list of numbers.
+INFO is a plist holding contextual information."
+ (cdr (assoc headline (plist-get info :headline-numbering))))
+
+(defun org-export-numbered-headline-p (headline info)
+ "Return a non-nil value if HEADLINE element should be numbered.
+INFO is a plist used as a communication channel."
+ (let ((sec-num (plist-get info :section-numbers))
+ (level (org-export-get-relative-level headline info)))
+ (if (wholenump sec-num) (<= level sec-num) sec-num)))
+
+(defun org-export-number-to-roman (n)
+ "Convert integer N into a roman numeral."
+ (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
+ ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL")
+ ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV")
+ ( 1 . "I")))
+ (res ""))
+ (if (<= n 0)
+ (number-to-string n)
+ (while roman
+ (if (>= n (caar roman))
+ (setq n (- n (caar roman))
+ res (concat res (cdar roman)))
+ (pop roman)))
+ res)))
+
+(defun org-export-get-tags (element info &optional tags inherited)
+ "Return list of tags associated to ELEMENT.
+
+ELEMENT has either an `headline' or an `inlinetask' type. INFO
+is a plist used as a communication channel.
+
+Select tags (see `org-export-select-tags') and exclude tags (see
+`org-export-exclude-tags') are removed from the list.
+
+When non-nil, optional argument TAGS should be a list of strings.
+Any tag belonging to this list will also be removed.
+
+When optional argument INHERITED is non-nil, tags can also be
+inherited from parent headlines and FILETAGS keywords."
+ (org-remove-if
+ (lambda (tag) (or (member tag (plist-get info :select-tags))
+ (member tag (plist-get info :exclude-tags))
+ (member tag tags)))
+ (if (not inherited) (org-element-property :tags element)
+ ;; Build complete list of inherited tags.
+ (let ((current-tag-list (org-element-property :tags element)))
+ (mapc
+ (lambda (parent)
+ (mapc
+ (lambda (tag)
+ (when (and (memq (org-element-type parent) '(headline inlinetask))
+ (not (member tag current-tag-list)))
+ (push tag current-tag-list)))
+ (org-element-property :tags parent)))
+ (org-export-get-genealogy element))
+ ;; Add FILETAGS keywords and return results.
+ (org-uniquify (append (plist-get info :filetags) current-tag-list))))))
+
+(defun org-export-get-node-property (property blob &optional inherited)
+ "Return node PROPERTY value for BLOB.
+
+PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an
+element or object.
+
+If optional argument INHERITED is non-nil, the value can be
+inherited from a parent headline.
+
+Return value is a string or nil."
+ (let ((headline (if (eq (org-element-type blob) 'headline) blob
+ (org-export-get-parent-headline blob))))
+ (if (not inherited) (org-element-property property blob)
+ (let ((parent headline) value)
+ (catch 'found
+ (while parent
+ (when (plist-member (nth 1 parent) property)
+ (throw 'found (org-element-property property parent)))
+ (setq parent (org-element-property :parent parent))))))))
+
+(defun org-export-get-category (blob info)
+ "Return category for element or object BLOB.
+
+INFO is a plist used as a communication channel.
+
+CATEGORY is automatically inherited from a parent headline, from
+#+CATEGORY: keyword or created out of original file name. If all
+fail, the fall-back value is \"???\"."
+ (or (let ((headline (if (eq (org-element-type blob) 'headline) blob
+ (org-export-get-parent-headline blob))))
+ ;; Almost like `org-export-node-property', but we cannot trust
+ ;; `plist-member' as every headline has a `:CATEGORY'
+ ;; property, would it be nil or equal to "???" (which has the
+ ;; same meaning).
+ (let ((parent headline) value)
+ (catch 'found
+ (while parent
+ (let ((category (org-element-property :CATEGORY parent)))
+ (and category (not (equal "???" category))
+ (throw 'found category)))
+ (setq parent (org-element-property :parent parent))))))
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (kwd)
+ (when (equal (org-element-property :key kwd) "CATEGORY")
+ (org-element-property :value kwd)))
+ info 'first-match)
+ (let ((file (plist-get info :input-file)))
+ (and file (file-name-sans-extension (file-name-nondirectory file))))
+ "???"))
+
+(defun org-export-get-alt-title (headline info)
+ "Return alternative title for HEADLINE, as a secondary string.
+INFO is a plist used as a communication channel. If no optional
+title is defined, fall-back to the regular title."
+ (or (org-element-property :alt-title headline)
+ (org-element-property :title headline)))
+
+(defun org-export-first-sibling-p (headline info)
+ "Non-nil when HEADLINE is the first sibling in its sub-tree.
+INFO is a plist used as a communication channel."
+ (not (eq (org-element-type (org-export-get-previous-element headline info))
+ 'headline)))
+
+(defun org-export-last-sibling-p (headline info)
+ "Non-nil when HEADLINE is the last sibling in its sub-tree.
+INFO is a plist used as a communication channel."
+ (not (org-export-get-next-element headline info)))
+
+
+;;;; For Keywords
+;;
+;; `org-export-get-date' returns a date appropriate for the document
+;; to about to be exported. In particular, it takes care of
+;; `org-export-date-timestamp-format'.
+
+(defun org-export-get-date (info &optional fmt)
+ "Return date value for the current document.
+
+INFO is a plist used as a communication channel. FMT, when
+non-nil, is a time format string that will be applied on the date
+if it consists in a single timestamp object. It defaults to
+`org-export-date-timestamp-format' when nil.
+
+A proper date can be a secondary string, a string or nil. It is
+meant to be translated with `org-export-data' or alike."
+ (let ((date (plist-get info :date))
+ (fmt (or fmt org-export-date-timestamp-format)))
+ (cond ((not date) nil)
+ ((and fmt
+ (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp))
+ (org-timestamp-format (car date) fmt))
+ (t date))))
+
+
+;;;; For Links
+;;
+;; `org-export-solidify-link-text' turns a string into a safer version
+;; for links, replacing most non-standard characters with hyphens.
+;;
+;; `org-export-get-coderef-format' returns an appropriate format
+;; string for coderefs.
+;;
+;; `org-export-inline-image-p' returns a non-nil value when the link
+;; provided should be considered as an inline image.
+;;
+;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links
+;; (i.e. links with "fuzzy" as type) within the parsed tree, and
+;; returns an appropriate unique identifier when found, or nil.
+;;
+;; `org-export-resolve-id-link' returns the first headline with
+;; specified id or custom-id in parse tree, the path to the external
+;; file with the id or nil when neither was found.
+;;
+;; `org-export-resolve-coderef' associates a reference to a line
+;; number in the element it belongs, or returns the reference itself
+;; when the element isn't numbered.
+
+(defun org-export-solidify-link-text (s)
+ "Take link text S and make a safe target out of it."
+ (save-match-data
+ (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-")))
+
+(defun org-export-get-coderef-format (path desc)
+ "Return format string for code reference link.
+PATH is the link path. DESC is its description."
+ (save-match-data
+ (cond ((not desc) "%s")
+ ((string-match (regexp-quote (concat "(" path ")")) desc)
+ (replace-match "%s" t t desc))
+ (t desc))))
+
+(defun org-export-inline-image-p (link &optional rules)
+ "Non-nil if LINK object points to an inline image.
+
+Optional argument is a set of RULES defining inline images. It
+is an alist where associations have the following shape:
+
+ (TYPE . REGEXP)
+
+Applying a rule means apply REGEXP against LINK's path when its
+type is TYPE. The function will return a non-nil value if any of
+the provided rules is non-nil. The default rule is
+`org-export-default-inline-image-rule'.
+
+This only applies to links without a description."
+ (and (not (org-element-contents link))
+ (let ((case-fold-search t)
+ (rules (or rules org-export-default-inline-image-rule)))
+ (catch 'exit
+ (mapc
+ (lambda (rule)
+ (and (string= (org-element-property :type link) (car rule))
+ (string-match (cdr rule)
+ (org-element-property :path link))
+ (throw 'exit t)))
+ rules)
+ ;; Return nil if no rule matched.
+ nil))))
+
+(defun org-export-resolve-coderef (ref info)
+ "Resolve a code reference REF.
+
+INFO is a plist used as a communication channel.
+
+Return associated line number in source code, or REF itself,
+depending on src-block or example element's switches."
+ (org-element-map (plist-get info :parse-tree) '(example-block src-block)
+ (lambda (el)
+ (with-temp-buffer
+ (insert (org-trim (org-element-property :value el)))
+ (let* ((label-fmt (regexp-quote
+ (or (org-element-property :label-fmt el)
+ org-coderef-label-format)))
+ (ref-re
+ (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
+ (replace-regexp-in-string "%s" ref label-fmt nil t))))
+ ;; Element containing REF is found. Resolve it to either
+ ;; a label or a line number, as needed.
+ (when (re-search-backward ref-re nil t)
+ (cond
+ ((org-element-property :use-labels el) ref)
+ ((eq (org-element-property :number-lines el) 'continued)
+ (+ (org-export-get-loc el info) (line-number-at-pos)))
+ (t (line-number-at-pos)))))))
+ info 'first-match))
+
+(defun org-export-resolve-fuzzy-link (link info)
+ "Return LINK destination.
+
+INFO is a plist holding contextual information.
+
+Return value can be an object, an element, or nil:
+
+- If LINK path matches a target object (i.e. <<path>>) return it.
+
+- If LINK path exactly matches the name affiliated keyword
+ (i.e. #+NAME: path) of an element, return that element.
+
+- If LINK path exactly matches any headline name, return that
+ element. If more than one headline share that name, priority
+ will be given to the one with the closest common ancestor, if
+ any, or the first one in the parse tree otherwise.
+
+- Otherwise, return nil.
+
+Assume LINK type is \"fuzzy\". White spaces are not
+significant."
+ (let* ((raw-path (org-element-property :path link))
+ (match-title-p (eq (aref raw-path 0) ?*))
+ ;; Split PATH at white spaces so matches are space
+ ;; insensitive.
+ (path (org-split-string
+ (if match-title-p (substring raw-path 1) raw-path)))
+ ;; Cache for destinations that are not position dependent.
+ (link-cache
+ (or (plist-get info :resolve-fuzzy-link-cache)
+ (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
+ (make-hash-table :test 'equal)))
+ :resolve-fuzzy-link-cache)))
+ (cached (gethash path link-cache 'not-found)))
+ (cond
+ ;; Destination is not position dependent: use cached value.
+ ((and (not match-title-p) (not (eq cached 'not-found))) cached)
+ ;; First try to find a matching "<<path>>" unless user specified
+ ;; he was looking for a headline (path starts with a "*"
+ ;; character).
+ ((and (not match-title-p)
+ (let ((match (org-element-map (plist-get info :parse-tree) 'target
+ (lambda (blob)
+ (and (equal (org-split-string
+ (org-element-property :value blob))
+ path)
+ blob))
+ info 'first-match)))
+ (and match (puthash path match link-cache)))))
+ ;; Then try to find an element with a matching "#+NAME: path"
+ ;; affiliated keyword.
+ ((and (not match-title-p)
+ (let ((match (org-element-map (plist-get info :parse-tree)
+ org-element-all-elements
+ (lambda (el)
+ (let ((name (org-element-property :name el)))
+ (when (and name
+ (equal (org-split-string name) path))
+ el)))
+ info 'first-match)))
+ (and match (puthash path match link-cache)))))
+ ;; Last case: link either points to a headline or to nothingness.
+ ;; Try to find the source, with priority given to headlines with
+ ;; the closest common ancestor. If such candidate is found,
+ ;; return it, otherwise return nil.
+ (t
+ (let ((find-headline
+ (function
+ ;; Return first headline whose `:raw-value' property is
+ ;; NAME in parse tree DATA, or nil. Statistics cookies
+ ;; are ignored.
+ (lambda (name data)
+ (org-element-map data 'headline
+ (lambda (headline)
+ (when (equal (org-split-string
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ (org-element-property :raw-value headline)))
+ name)
+ headline))
+ info 'first-match)))))
+ ;; Search among headlines sharing an ancestor with link, from
+ ;; closest to farthest.
+ (catch 'exit
+ (mapc
+ (lambda (parent)
+ (let ((foundp (funcall find-headline path parent)))
+ (when foundp (throw 'exit foundp))))
+ (let ((parent-hl (org-export-get-parent-headline link)))
+ (if (not parent-hl) (list (plist-get info :parse-tree))
+ (cons parent-hl (org-export-get-genealogy parent-hl)))))
+ ;; No destination found: return nil.
+ (and (not match-title-p) (puthash path nil link-cache))))))))
+
+(defun org-export-resolve-id-link (link info)
+ "Return headline referenced as LINK destination.
+
+INFO is a plist used as a communication channel.
+
+Return value can be the headline element matched in current parse
+tree, a file name or nil. Assume LINK type is either \"id\" or
+\"custom-id\"."
+ (let ((id (org-element-property :path link)))
+ ;; First check if id is within the current parse tree.
+ (or (org-element-map (plist-get info :parse-tree) 'headline
+ (lambda (headline)
+ (when (or (string= (org-element-property :ID headline) id)
+ (string= (org-element-property :CUSTOM_ID headline) id))
+ headline))
+ info 'first-match)
+ ;; Otherwise, look for external files.
+ (cdr (assoc id (plist-get info :id-alist))))))
+
+(defun org-export-resolve-radio-link (link info)
+ "Return radio-target object referenced as LINK destination.
+
+INFO is a plist used as a communication channel.
+
+Return value can be a radio-target object or nil. Assume LINK
+has type \"radio\"."
+ (let ((path (replace-regexp-in-string
+ "[ \r\t\n]+" " " (org-element-property :path link))))
+ (org-element-map (plist-get info :parse-tree) 'radio-target
+ (lambda (radio)
+ (and (eq (compare-strings
+ (replace-regexp-in-string
+ "[ \r\t\n]+" " " (org-element-property :value radio))
+ nil nil path nil nil t)
+ t)
+ radio))
+ info 'first-match)))
+
+
+;;;; For References
+;;
+;; `org-export-get-ordinal' associates a sequence number to any object
+;; or element.
+
+(defun org-export-get-ordinal (element info &optional types predicate)
+ "Return ordinal number of an element or object.
+
+ELEMENT is the element or object considered. INFO is the plist
+used as a communication channel.
+
+Optional argument TYPES, when non-nil, is a list of element or
+object types, as symbols, that should also be counted in.
+Otherwise, only provided element's type is considered.
+
+Optional argument PREDICATE is a function returning a non-nil
+value if the current element or object should be counted in. It
+accepts two arguments: the element or object being considered and
+the plist used as a communication channel. This allows to count
+only a certain type of objects (i.e. inline images).
+
+Return value is a list of numbers if ELEMENT is a headline or an
+item. It is nil for keywords. It represents the footnote number
+for footnote definitions and footnote references. If ELEMENT is
+a target, return the same value as if ELEMENT was the closest
+table, item or headline containing the target. In any other
+case, return the sequence number of ELEMENT among elements or
+objects of the same type."
+ ;; Ordinal of a target object refer to the ordinal of the closest
+ ;; table, item, or headline containing the object.
+ (when (eq (org-element-type element) 'target)
+ (setq element
+ (loop for parent in (org-export-get-genealogy element)
+ when
+ (memq
+ (org-element-type parent)
+ '(footnote-definition footnote-reference headline item
+ table))
+ return parent)))
+ (case (org-element-type element)
+ ;; Special case 1: A headline returns its number as a list.
+ (headline (org-export-get-headline-number element info))
+ ;; Special case 2: An item returns its number as a list.
+ (item (let ((struct (org-element-property :structure element)))
+ (org-list-get-item-number
+ (org-element-property :begin element)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct))))
+ ((footnote-definition footnote-reference)
+ (org-export-get-footnote-number element info))
+ (otherwise
+ (let ((counter 0))
+ ;; Increment counter until ELEMENT is found again.
+ (org-element-map (plist-get info :parse-tree)
+ (or types (org-element-type element))
+ (lambda (el)
+ (cond
+ ((eq element el) (1+ counter))
+ ((not predicate) (incf counter) nil)
+ ((funcall predicate el info) (incf counter) nil)))
+ info 'first-match)))))
+
+
+;;;; For Src-Blocks
+;;
+;; `org-export-get-loc' counts number of code lines accumulated in
+;; src-block or example-block elements with a "+n" switch until
+;; a given element, excluded. Note: "-n" switches reset that count.
+;;
+;; `org-export-unravel-code' extracts source code (along with a code
+;; references alist) from an `element-block' or `src-block' type
+;; element.
+;;
+;; `org-export-format-code' applies a formatting function to each line
+;; of code, providing relative line number and code reference when
+;; appropriate. Since it doesn't access the original element from
+;; which the source code is coming, it expects from the code calling
+;; it to know if lines should be numbered and if code references
+;; should appear.
+;;
+;; Eventually, `org-export-format-code-default' is a higher-level
+;; function (it makes use of the two previous functions) which handles
+;; line numbering and code references inclusion, and returns source
+;; code in a format suitable for plain text or verbatim output.
+
+(defun org-export-get-loc (element info)
+ "Return accumulated lines of code up to ELEMENT.
+
+INFO is the plist used as a communication channel.
+
+ELEMENT is excluded from count."
+ (let ((loc 0))
+ (org-element-map (plist-get info :parse-tree)
+ `(src-block example-block ,(org-element-type element))
+ (lambda (el)
+ (cond
+ ;; ELEMENT is reached: Quit the loop.
+ ((eq el element))
+ ;; Only count lines from src-block and example-block elements
+ ;; with a "+n" or "-n" switch. A "-n" switch resets counter.
+ ((not (memq (org-element-type el) '(src-block example-block))) nil)
+ ((let ((linums (org-element-property :number-lines el)))
+ (when linums
+ ;; Accumulate locs or reset them.
+ (let ((lines (org-count-lines
+ (org-trim (org-element-property :value el)))))
+ (setq loc (if (eq linums 'new) lines (+ loc lines))))))
+ ;; Return nil to stay in the loop.
+ nil)))
+ info 'first-match)
+ ;; Return value.
+ loc))
+
+(defun org-export-unravel-code (element)
+ "Clean source code and extract references out of it.
+
+ELEMENT has either a `src-block' an `example-block' type.
+
+Return a cons cell whose CAR is the source code, cleaned from any
+reference and protective comma and CDR is an alist between
+relative line number (integer) and name of code reference on that
+line (string)."
+ (let* ((line 0) refs
+ ;; Get code and clean it. Remove blank lines at its
+ ;; beginning and end.
+ (code (replace-regexp-in-string
+ "\\`\\([ \t]*\n\\)+" ""
+ (replace-regexp-in-string
+ "\\([ \t]*\n\\)*[ \t]*\\'" "\n"
+ (org-element-property :value element))))
+ ;; Get format used for references.
+ (label-fmt (regexp-quote
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format)))
+ ;; Build a regexp matching a loc with a reference.
+ (with-ref-re
+ (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$"
+ (replace-regexp-in-string
+ "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))))
+ ;; Return value.
+ (cons
+ ;; Code with references removed.
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (loc)
+ (incf line)
+ (if (not (string-match with-ref-re loc)) loc
+ ;; Ref line: remove ref, and signal its position in REFS.
+ (push (cons line (match-string 3 loc)) refs)
+ (replace-match "" nil nil loc 1)))
+ (org-split-string code "\n") "\n"))
+ ;; Reference alist.
+ refs)))
+
+(defun org-export-format-code (code fun &optional num-lines ref-alist)
+ "Format CODE by applying FUN line-wise and return it.
+
+CODE is a string representing the code to format. FUN is
+a function. It must accept three arguments: a line of
+code (string), the current line number (integer) or nil and the
+reference associated to the current line (string) or nil.
+
+Optional argument NUM-LINES can be an integer representing the
+number of code lines accumulated until the current code. Line
+numbers passed to FUN will take it into account. If it is nil,
+FUN's second argument will always be nil. This number can be
+obtained with `org-export-get-loc' function.
+
+Optional argument REF-ALIST can be an alist between relative line
+number (i.e. ignoring NUM-LINES) and the name of the code
+reference on it. If it is nil, FUN's third argument will always
+be nil. It can be obtained through the use of
+`org-export-unravel-code' function."
+ (let ((--locs (org-split-string code "\n"))
+ (--line 0))
+ (org-element-normalize-string
+ (mapconcat
+ (lambda (--loc)
+ (incf --line)
+ (let ((--ref (cdr (assq --line ref-alist))))
+ (funcall fun --loc (and num-lines (+ num-lines --line)) --ref)))
+ --locs "\n"))))
+
+(defun org-export-format-code-default (element info)
+ "Return source code from ELEMENT, formatted in a standard way.
+
+ELEMENT is either a `src-block' or `example-block' element. INFO
+is a plist used as a communication channel.
+
+This function takes care of line numbering and code references
+inclusion. Line numbers, when applicable, appear at the
+beginning of the line, separated from the code by two white
+spaces. Code references, on the other hand, appear flushed to
+the right, separated by six white spaces from the widest line of
+code."
+ ;; Extract code and references.
+ (let* ((code-info (org-export-unravel-code element))
+ (code (car code-info))
+ (code-lines (org-split-string code "\n")))
+ (if (null code-lines) ""
+ (let* ((refs (and (org-element-property :retain-labels element)
+ (cdr code-info)))
+ ;; Handle line numbering.
+ (num-start (case (org-element-property :number-lines element)
+ (continued (org-export-get-loc element info))
+ (new 0)))
+ (num-fmt
+ (and num-start
+ (format "%%%ds "
+ (length (number-to-string
+ (+ (length code-lines) num-start))))))
+ ;; Prepare references display, if required. Any reference
+ ;; should start six columns after the widest line of code,
+ ;; wrapped with parenthesis.
+ (max-width
+ (+ (apply 'max (mapcar 'length code-lines))
+ (if (not num-start) 0 (length (format num-fmt num-start))))))
+ (org-export-format-code
+ code
+ (lambda (loc line-num ref)
+ (let ((number-str (and num-fmt (format num-fmt line-num))))
+ (concat
+ number-str
+ loc
+ (and ref
+ (concat (make-string
+ (- (+ 6 max-width)
+ (+ (length loc) (length number-str))) ? )
+ (format "(%s)" ref))))))
+ num-start refs)))))
+
+
+;;;; For Tables
+;;
+;; `org-export-table-has-special-column-p' and and
+;; `org-export-table-row-is-special-p' are predicates used to look for
+;; meta-information about the table structure.
+;;
+;; `org-table-has-header-p' tells when the rows before the first rule
+;; should be considered as table's header.
+;;
+;; `org-export-table-cell-width', `org-export-table-cell-alignment'
+;; and `org-export-table-cell-borders' extract information from
+;; a table-cell element.
+;;
+;; `org-export-table-dimensions' gives the number on rows and columns
+;; in the table, ignoring horizontal rules and special columns.
+;; `org-export-table-cell-address', given a table-cell object, returns
+;; the absolute address of a cell. On the other hand,
+;; `org-export-get-table-cell-at' does the contrary.
+;;
+;; `org-export-table-cell-starts-colgroup-p',
+;; `org-export-table-cell-ends-colgroup-p',
+;; `org-export-table-row-starts-rowgroup-p',
+;; `org-export-table-row-ends-rowgroup-p',
+;; `org-export-table-row-starts-header-p' and
+;; `org-export-table-row-ends-header-p' indicate position of current
+;; row or cell within the table.
+
+(defun org-export-table-has-special-column-p (table)
+ "Non-nil when TABLE has a special column.
+All special columns will be ignored during export."
+ ;; The table has a special column when every first cell of every row
+ ;; has an empty value or contains a symbol among "/", "#", "!", "$",
+ ;; "*" "_" and "^". Though, do not consider a first row containing
+ ;; only empty cells as special.
+ (let ((special-column-p 'empty))
+ (catch 'exit
+ (mapc
+ (lambda (row)
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((value (org-element-contents
+ (car (org-element-contents row)))))
+ (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+ (setq special-column-p 'special))
+ ((not value))
+ (t (throw 'exit nil))))))
+ (org-element-contents table))
+ (eq special-column-p 'special))))
+
+(defun org-export-table-has-header-p (table info)
+ "Non-nil when TABLE has a header.
+
+INFO is a plist used as a communication channel.
+
+A table has a header when it contains at least two row groups."
+ (let ((cache (or (plist-get info :table-header-cache)
+ (plist-get (setq info
+ (plist-put info :table-header-cache
+ (make-hash-table :test 'eq)))
+ :table-header-cache))))
+ (or (gethash table cache)
+ (let ((rowgroup 1) row-flag)
+ (puthash
+ table
+ (org-element-map table 'table-row
+ (lambda (row)
+ (cond
+ ((> rowgroup 1) t)
+ ((and row-flag (eq (org-element-property :type row) 'rule))
+ (incf rowgroup) (setq row-flag nil))
+ ((and (not row-flag) (eq (org-element-property :type row)
+ 'standard))
+ (setq row-flag t) nil)))
+ info 'first-match)
+ cache)))))
+
+(defun org-export-table-row-is-special-p (table-row info)
+ "Non-nil if TABLE-ROW is considered special.
+
+INFO is a plist used as the communication channel.
+
+All special rows will be ignored during export."
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let ((first-cell (org-element-contents
+ (car (org-element-contents table-row)))))
+ ;; A row is special either when...
+ (or
+ ;; ... it starts with a field only containing "/",
+ (equal first-cell '("/"))
+ ;; ... the table contains a special column and the row start
+ ;; with a marking character among, "^", "_", "$" or "!",
+ (and (org-export-table-has-special-column-p
+ (org-export-get-parent table-row))
+ (member first-cell '(("^") ("_") ("$") ("!"))))
+ ;; ... it contains only alignment cookies and empty cells.
+ (let ((special-row-p 'empty))
+ (catch 'exit
+ (mapc
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ ;; Since VALUE is a secondary string, the following
+ ;; checks avoid expanding it with `org-export-data'.
+ (cond ((not value))
+ ((and (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
+ (car value)))
+ (setq special-row-p 'cookie))
+ (t (throw 'exit nil)))))
+ (org-element-contents table-row))
+ (eq special-row-p 'cookie)))))))
+
+(defun org-export-table-row-group (table-row info)
+ "Return TABLE-ROW's group number, as an integer.
+
+INFO is a plist used as the communication channel.
+
+Return value is the group number, as an integer, or nil for
+special rows and rows separators. First group is also table's
+header."
+ (let ((cache (or (plist-get info :table-row-group-cache)
+ (plist-get (setq info
+ (plist-put info :table-row-group-cache
+ (make-hash-table :test 'eq)))
+ :table-row-group-cache))))
+ (cond ((gethash table-row cache))
+ ((eq (org-element-property :type table-row) 'rule) nil)
+ (t (let ((group 0) row-flag)
+ (org-element-map (org-export-get-parent table-row) 'table-row
+ (lambda (row)
+ (if (eq (org-element-property :type row) 'rule)
+ (setq row-flag nil)
+ (unless row-flag (incf group) (setq row-flag t)))
+ (when (eq table-row row) (puthash table-row group cache)))
+ info 'first-match))))))
+
+(defun org-export-table-cell-width (table-cell info)
+ "Return TABLE-CELL contents width.
+
+INFO is a plist used as the communication channel.
+
+Return value is the width given by the last width cookie in the
+same column as TABLE-CELL, or nil."
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent row))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
+ (cache (or (plist-get info :table-cell-width-cache)
+ (plist-get (setq info
+ (plist-put info :table-cell-width-cache
+ (make-hash-table :test 'eq)))
+ :table-cell-width-cache)))
+ (width-vector (or (gethash table cache)
+ (puthash table (make-vector columns 'empty) cache)))
+ (value (aref width-vector column)))
+ (if (not (eq value 'empty)) value
+ (let (cookie-width)
+ (dolist (row (org-element-contents table)
+ (aset width-vector column cookie-width))
+ (when (org-export-table-row-is-special-p row info)
+ ;; In a special row, try to find a width cookie at COLUMN.
+ (let* ((value (org-element-contents
+ (elt (org-element-contents row) column)))
+ (cookie (car value)))
+ ;; The following checks avoid expanding unnecessarily
+ ;; the cell with `org-export-data'.
+ (when (and value
+ (not (cdr value))
+ (stringp cookie)
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie)
+ (match-string 1 cookie))
+ (setq cookie-width
+ (string-to-number (match-string 1 cookie)))))))))))
+
+(defun org-export-table-cell-alignment (table-cell info)
+ "Return TABLE-CELL contents alignment.
+
+INFO is a plist used as the communication channel.
+
+Return alignment as specified by the last alignment cookie in the
+same column as TABLE-CELL. If no such cookie is found, a default
+alignment value will be deduced from fraction of numbers in the
+column (see `org-table-number-fraction' for more information).
+Possible values are `left', `right' and `center'."
+ ;; Load `org-table-number-fraction' and `org-table-number-regexp'.
+ (require 'org-table)
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent row))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
+ (cache (or (plist-get info :table-cell-alignment-cache)
+ (plist-get (setq info
+ (plist-put info :table-cell-alignment-cache
+ (make-hash-table :test 'eq)))
+ :table-cell-alignment-cache)))
+ (align-vector (or (gethash table cache)
+ (puthash table (make-vector columns nil) cache))))
+ (or (aref align-vector column)
+ (let ((number-cells 0)
+ (total-cells 0)
+ cookie-align
+ previous-cell-number-p)
+ (dolist (row (org-element-contents (org-export-get-parent row)))
+ (cond
+ ;; In a special row, try to find an alignment cookie at
+ ;; COLUMN.
+ ((org-export-table-row-is-special-p row info)
+ (let ((value (org-element-contents
+ (elt (org-element-contents row) column))))
+ ;; Since VALUE is a secondary string, the following
+ ;; checks avoid useless expansion through
+ ;; `org-export-data'.
+ (when (and value
+ (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'"
+ (car value))
+ (match-string 1 (car value)))
+ (setq cookie-align (match-string 1 (car value))))))
+ ;; Ignore table rules.
+ ((eq (org-element-property :type row) 'rule))
+ ;; In a standard row, check if cell's contents are
+ ;; expressing some kind of number. Increase NUMBER-CELLS
+ ;; accordingly. Though, don't bother if an alignment
+ ;; cookie has already defined cell's alignment.
+ ((not cookie-align)
+ (let ((value (org-export-data
+ (org-element-contents
+ (elt (org-element-contents row) column))
+ info)))
+ (incf total-cells)
+ ;; Treat an empty cell as a number if it follows
+ ;; a number.
+ (if (not (or (string-match org-table-number-regexp value)
+ (and (string= value "") previous-cell-number-p)))
+ (setq previous-cell-number-p nil)
+ (setq previous-cell-number-p t)
+ (incf number-cells))))))
+ ;; Return value. Alignment specified by cookies has
+ ;; precedence over alignment deduced from cell's contents.
+ (aset align-vector
+ column
+ (cond ((equal cookie-align "l") 'left)
+ ((equal cookie-align "r") 'right)
+ ((equal cookie-align "c") 'center)
+ ((>= (/ (float number-cells) total-cells)
+ org-table-number-fraction)
+ 'right)
+ (t 'left)))))))
+
+(defun org-export-table-cell-borders (table-cell info)
+ "Return TABLE-CELL borders.
+
+INFO is a plist used as a communication channel.
+
+Return value is a list of symbols, or nil. Possible values are:
+`top', `bottom', `above', `below', `left' and `right'. Note:
+`top' (resp. `bottom') only happen for a cell in the first
+row (resp. last row) of the table, ignoring table rules, if any.
+
+Returned borders ignore special rows."
+ (let* ((row (org-export-get-parent table-cell))
+ (table (org-export-get-parent-table table-cell))
+ borders)
+ ;; Top/above border? TABLE-CELL has a border above when a rule
+ ;; used to demarcate row groups can be found above. Hence,
+ ;; finding a rule isn't sufficient to push `above' in BORDERS:
+ ;; another regular row has to be found above that rule.
+ (let (rule-flag)
+ (catch 'exit
+ (mapc (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'above borders))
+ (throw 'exit nil)))))
+ ;; Look at every row before the current one.
+ (cdr (memq row (reverse (org-element-contents table)))))
+ ;; No rule above, or rule found starts the table (ignoring any
+ ;; special row): TABLE-CELL is at the top of the table.
+ (when rule-flag (push 'above borders))
+ (push 'top borders)))
+ ;; Bottom/below border? TABLE-CELL has a border below when next
+ ;; non-regular row below is a rule.
+ (let (rule-flag)
+ (catch 'exit
+ (mapc (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'below borders))
+ (throw 'exit nil)))))
+ ;; Look at every row after the current one.
+ (cdr (memq row (org-element-contents table))))
+ ;; No rule below, or rule found ends the table (modulo some
+ ;; special row): TABLE-CELL is at the bottom of the table.
+ (when rule-flag (push 'below borders))
+ (push 'bottom borders)))
+ ;; Right/left borders? They can only be specified by column
+ ;; groups. Column groups are defined in a row starting with "/".
+ ;; Also a column groups row only contains "<", "<>", ">" or blank
+ ;; cells.
+ (catch 'exit
+ (let ((column (let ((cells (org-element-contents row)))
+ (- (length cells) (length (memq table-cell cells))))))
+ (mapc
+ (lambda (row)
+ (unless (eq (org-element-property :type row) 'rule)
+ (when (equal (org-element-contents
+ (car (org-element-contents row)))
+ '("/"))
+ (let ((column-groups
+ (mapcar
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ (when (member value '(("<") ("<>") (">") nil))
+ (car value))))
+ (org-element-contents row))))
+ ;; There's a left border when previous cell, if
+ ;; any, ends a group, or current one starts one.
+ (when (or (and (not (zerop column))
+ (member (elt column-groups (1- column))
+ '(">" "<>")))
+ (member (elt column-groups column) '("<" "<>")))
+ (push 'left borders))
+ ;; There's a right border when next cell, if any,
+ ;; starts a group, or current one ends one.
+ (when (or (and (/= (1+ column) (length column-groups))
+ (member (elt column-groups (1+ column))
+ '("<" "<>")))
+ (member (elt column-groups column) '(">" "<>")))
+ (push 'right borders))
+ (throw 'exit nil)))))
+ ;; Table rows are read in reverse order so last column groups
+ ;; row has precedence over any previous one.
+ (reverse (org-element-contents table)))))
+ ;; Return value.
+ borders))
+
+(defun org-export-table-cell-starts-colgroup-p (table-cell info)
+ "Non-nil when TABLE-CELL is at the beginning of a row group.
+INFO is a plist used as a communication channel."
+ ;; A cell starts a column group either when it is at the beginning
+ ;; of a row (or after the special column, if any) or when it has
+ ;; a left border.
+ (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell
+ 'identity info 'first-match)
+ table-cell)
+ (memq 'left (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-cell-ends-colgroup-p (table-cell info)
+ "Non-nil when TABLE-CELL is at the end of a row group.
+INFO is a plist used as a communication channel."
+ ;; A cell ends a column group either when it is at the end of a row
+ ;; or when it has a right border.
+ (or (eq (car (last (org-element-contents
+ (org-export-get-parent table-cell))))
+ table-cell)
+ (memq 'right (org-export-table-cell-borders table-cell info))))
+
+(defun org-export-table-row-starts-rowgroup-p (table-row info)
+ "Non-nil when TABLE-ROW is at the beginning of a column group.
+INFO is a plist used as a communication channel."
+ (unless (or (eq (org-element-property :type table-row) 'rule)
+ (org-export-table-row-is-special-p table-row info))
+ (let ((borders (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (or (memq 'top borders) (memq 'above borders)))))
+
+(defun org-export-table-row-ends-rowgroup-p (table-row info)
+ "Non-nil when TABLE-ROW is at the end of a column group.
+INFO is a plist used as a communication channel."
+ (unless (or (eq (org-element-property :type table-row) 'rule)
+ (org-export-table-row-is-special-p table-row info))
+ (let ((borders (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
+ (or (memq 'bottom borders) (memq 'below borders)))))
+
+(defun org-export-table-row-starts-header-p (table-row info)
+ "Non-nil when TABLE-ROW is the first table header's row.
+INFO is a plist used as a communication channel."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (org-export-table-row-starts-rowgroup-p table-row info)
+ (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-row-ends-header-p (table-row info)
+ "Non-nil when TABLE-ROW is the last table header's row.
+INFO is a plist used as a communication channel."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (org-export-table-row-ends-rowgroup-p table-row info)
+ (= (org-export-table-row-group table-row info) 1)))
+
+(defun org-export-table-row-number (table-row info)
+ "Return TABLE-ROW number.
+INFO is a plist used as a communication channel. Return value is
+zero-based and ignores separators. The function returns nil for
+special columns and separators."
+ (when (and (eq (org-element-property :type table-row) 'standard)
+ (not (org-export-table-row-is-special-p table-row info)))
+ (let ((number 0))
+ (org-element-map (org-export-get-parent-table table-row) 'table-row
+ (lambda (row)
+ (cond ((eq row table-row) number)
+ ((eq (org-element-property :type row) 'standard)
+ (incf number) nil)))
+ info 'first-match))))
+
+(defun org-export-table-dimensions (table info)
+ "Return TABLE dimensions.
+
+INFO is a plist used as a communication channel.
+
+Return value is a CONS like (ROWS . COLUMNS) where
+ROWS (resp. COLUMNS) is the number of exportable
+rows (resp. columns)."
+ (let (first-row (columns 0) (rows 0))
+ ;; Set number of rows, and extract first one.
+ (org-element-map table 'table-row
+ (lambda (row)
+ (when (eq (org-element-property :type row) 'standard)
+ (incf rows)
+ (unless first-row (setq first-row row)))) info)
+ ;; Set number of columns.
+ (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info)
+ ;; Return value.
+ (cons rows columns)))
+
+(defun org-export-table-cell-address (table-cell info)
+ "Return address of a regular TABLE-CELL object.
+
+TABLE-CELL is the cell considered. INFO is a plist used as
+a communication channel.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index. Only exportable cells are considered. The
+function returns nil for other cells."
+ (let* ((table-row (org-export-get-parent table-cell))
+ (row-number (org-export-table-row-number table-row info)))
+ (when row-number
+ (cons row-number
+ (let ((col-count 0))
+ (org-element-map table-row 'table-cell
+ (lambda (cell)
+ (if (eq cell table-cell) col-count (incf col-count) nil))
+ info 'first-match))))))
+
+(defun org-export-get-table-cell-at (address table info)
+ "Return regular table-cell object at ADDRESS in TABLE.
+
+Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are
+zero-based index. TABLE is a table type element. INFO is
+a plist used as a communication channel.
+
+If no table-cell, among exportable cells, is found at ADDRESS,
+return nil."
+ (let ((column-pos (cdr address)) (column-count 0))
+ (org-element-map
+ ;; Row at (car address) or nil.
+ (let ((row-pos (car address)) (row-count 0))
+ (org-element-map table 'table-row
+ (lambda (row)
+ (cond ((eq (org-element-property :type row) 'rule) nil)
+ ((= row-count row-pos) row)
+ (t (incf row-count) nil)))
+ info 'first-match))
+ 'table-cell
+ (lambda (cell)
+ (if (= column-count column-pos) cell
+ (incf column-count) nil))
+ info 'first-match)))
+
+
+;;;; For Tables Of Contents
+;;
+;; `org-export-collect-headlines' builds a list of all exportable
+;; headline elements, maybe limited to a certain depth. One can then
+;; easily parse it and transcode it.
+;;
+;; Building lists of tables, figures or listings is quite similar.
+;; Once the generic function `org-export-collect-elements' is defined,
+;; `org-export-collect-tables', `org-export-collect-figures' and
+;; `org-export-collect-listings' can be derived from it.
+
+(defun org-export-collect-headlines (info &optional n)
+ "Collect headlines in order to build a table of contents.
+
+INFO is a plist used as a communication channel.
+
+When optional argument N is an integer, it specifies the depth of
+the table of contents. Otherwise, it is set to the value of the
+last headline level. See `org-export-headline-levels' for more
+information.
+
+Return a list of all exportable headlines as parsed elements.
+Footnote sections, if any, will be ignored."
+ (let ((limit (plist-get info :headline-levels)))
+ (setq n (if (wholenump n) (min n limit) limit))
+ (org-element-map (plist-get info :parse-tree) 'headline
+ #'(lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= level n) headline))))
+ info)))
+
+(defun org-export-collect-elements (type info &optional predicate)
+ "Collect referenceable elements of a determined type.
+
+TYPE can be a symbol or a list of symbols specifying element
+types to search. Only elements with a caption are collected.
+
+INFO is a plist used as a communication channel.
+
+When non-nil, optional argument PREDICATE is a function accepting
+one argument, an element of type TYPE. It returns a non-nil
+value when that element should be collected.
+
+Return a list of all elements found, in order of appearance."
+ (org-element-map (plist-get info :parse-tree) type
+ (lambda (element)
+ (and (org-element-property :caption element)
+ (or (not predicate) (funcall predicate element))
+ element))
+ info))
+
+(defun org-export-collect-tables (info)
+ "Build a list of tables.
+INFO is a plist used as a communication channel.
+
+Return a list of table elements with a caption."
+ (org-export-collect-elements 'table info))
+
+(defun org-export-collect-figures (info predicate)
+ "Build a list of figures.
+
+INFO is a plist used as a communication channel. PREDICATE is
+a function which accepts one argument: a paragraph element and
+whose return value is non-nil when that element should be
+collected.
+
+A figure is a paragraph type element, with a caption, verifying
+PREDICATE. The latter has to be provided since a \"figure\" is
+a vague concept that may depend on back-end.
+
+Return a list of elements recognized as figures."
+ (org-export-collect-elements 'paragraph info predicate))
+
+(defun org-export-collect-listings (info)
+ "Build a list of src blocks.
+
+INFO is a plist used as a communication channel.
+
+Return a list of src-block elements with a caption."
+ (org-export-collect-elements 'src-block info))
+
+
+;;;; Smart Quotes
+;;
+;; The main function for the smart quotes sub-system is
+;; `org-export-activate-smart-quotes', which replaces every quote in
+;; a given string from the parse tree with its "smart" counterpart.
+;;
+;; Dictionary for smart quotes is stored in
+;; `org-export-smart-quotes-alist'.
+;;
+;; Internally, regexps matching potential smart quotes (checks at
+;; string boundaries are also necessary) are defined in
+;; `org-export-smart-quotes-regexps'.
+
+(defconst org-export-smart-quotes-alist
+ '(("da"
+ ;; one may use: »...«, "...", ›...‹, or '...'.
+ ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
+ ;; LaTeX quotes require Babel!
+ (opening-double-quote :utf-8 "»" :html "&raquo;" :latex ">>"
+ :texinfo "@guillemetright{}")
+ (closing-double-quote :utf-8 "«" :html "&laquo;" :latex "<<"
+ :texinfo "@guillemetleft{}")
+ (opening-single-quote :utf-8 "›" :html "&rsaquo;" :latex "\\frq{}"
+ :texinfo "@guilsinglright{}")
+ (closing-single-quote :utf-8 "‹" :html "&lsaquo;" :latex "\\flq{}"
+ :texinfo "@guilsingleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("de"
+ (opening-double-quote :utf-8 "„" :html "&bdquo;" :latex "\"`"
+ :texinfo "@quotedblbase{}")
+ (closing-double-quote :utf-8 "“" :html "&ldquo;" :latex "\"'"
+ :texinfo "@quotedblleft{}")
+ (opening-single-quote :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}"
+ :texinfo "@quotesinglbase{}")
+ (closing-single-quote :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}"
+ :texinfo "@quoteleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("en"
+ (opening-double-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("es"
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (closing-single-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("fr"
+ (opening-double-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (closing-double-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (opening-single-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (closing-single-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("no"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nb"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nn"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("sv"
+ ;; based on https://sv.wikipedia.org/wiki/Citattecken
+ (opening-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (opening-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ )
+ "Smart quotes translations.
+
+Alist whose CAR is a language string and CDR is an alist with
+quote type as key and a plist associating various encodings to
+their translation as value.
+
+A quote type can be any symbol among `opening-double-quote',
+`closing-double-quote', `opening-single-quote',
+`closing-single-quote' and `apostrophe'.
+
+Valid encodings include `:utf-8', `:html', `:latex' and
+`:texinfo'.
+
+If no translation is found, the quote character is left as-is.")
+
+(defconst org-export-smart-quotes-regexps
+ (list
+ ;; Possible opening quote at beginning of string.
+ "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\|\\s(\\)"
+ ;; Possible closing quote at beginning of string.
+ "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)"
+ ;; Possible apostrophe at beginning of string.
+ "\\`\\('\\)\\S-"
+ ;; Opening single and double quotes.
+ "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)"
+ ;; Closing single and double quotes.
+ "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)"
+ ;; Apostrophe.
+ "\\S-\\('\\)\\S-"
+ ;; Possible opening quote at end of string.
+ "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'"
+ ;; Possible closing quote at end of string.
+ "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'"
+ ;; Possible apostrophe at end of string.
+ "\\S-\\('\\)\\'")
+ "List of regexps matching a quote or an apostrophe.
+In every regexp, quote or apostrophe matched is put in group 1.")
+
+(defun org-export-activate-smart-quotes (s encoding info &optional original)
+ "Replace regular quotes with \"smart\" quotes in string S.
+
+ENCODING is a symbol among `:html', `:latex', `:texinfo' and
+`:utf-8'. INFO is a plist used as a communication channel.
+
+The function has to retrieve information about string
+surroundings in parse tree. It can only happen with an
+unmodified string. Thus, if S has already been through another
+process, a non-nil ORIGINAL optional argument will provide that
+original string.
+
+Return the new string."
+ (if (equal s "") ""
+ (let* ((prev (org-export-get-previous-element (or original s) info))
+ ;; Try to be flexible when computing number of blanks
+ ;; before object. The previous object may be a string
+ ;; introduced by the back-end and not completely parsed.
+ (pre-blank (and prev
+ (or (org-element-property :post-blank prev)
+ ;; A string with missing `:post-blank'
+ ;; property.
+ (and (stringp prev)
+ (string-match " *\\'" prev)
+ (length (match-string 0 prev)))
+ ;; Fallback value.
+ 0)))
+ (next (org-export-get-next-element (or original s) info))
+ (get-smart-quote
+ (lambda (q type)
+ ;; Return smart quote associated to a give quote Q, as
+ ;; a string. TYPE is a symbol among `open', `close' and
+ ;; `apostrophe'.
+ (let ((key (case type
+ (apostrophe 'apostrophe)
+ (open (if (equal "'" q) 'opening-single-quote
+ 'opening-double-quote))
+ (otherwise (if (equal "'" q) 'closing-single-quote
+ 'closing-double-quote)))))
+ (or (plist-get
+ (cdr (assq key
+ (cdr (assoc (plist-get info :language)
+ org-export-smart-quotes-alist))))
+ encoding)
+ q)))))
+ (if (or (equal "\"" s) (equal "'" s))
+ ;; Only a quote: no regexp can match. We have to check both
+ ;; sides and decide what to do.
+ (cond ((and (not prev) (not next)) s)
+ ((not prev) (funcall get-smart-quote s 'open))
+ ((and (not next) (zerop pre-blank))
+ (funcall get-smart-quote s 'close))
+ ((not next) s)
+ ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe))
+ (t (funcall get-smart-quote 'open)))
+ ;; 1. Replace quote character at the beginning of S.
+ (cond
+ ;; Apostrophe?
+ ((and prev (zerop pre-blank)
+ (string-match (nth 2 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'apostrophe)
+ nil t s 1)))
+ ;; Closing quote?
+ ((and prev (zerop pre-blank)
+ (string-match (nth 1 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'close)
+ nil t s 1)))
+ ;; Opening quote?
+ ((and (or (not prev) (> pre-blank 0))
+ (string-match (nth 0 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'open)
+ nil t s 1))))
+ ;; 2. Replace quotes in the middle of the string.
+ (setq s (replace-regexp-in-string
+ ;; Opening quotes.
+ (nth 3 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'open))
+ s nil t 1))
+ (setq s (replace-regexp-in-string
+ ;; Closing quotes.
+ (nth 4 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'close))
+ s nil t 1))
+ (setq s (replace-regexp-in-string
+ ;; Apostrophes.
+ (nth 5 org-export-smart-quotes-regexps)
+ (lambda (text)
+ (funcall get-smart-quote (match-string 1 text) 'apostrophe))
+ s nil t 1))
+ ;; 3. Replace quote character at the end of S.
+ (cond
+ ;; Apostrophe?
+ ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'apostrophe)
+ nil t s 1)))
+ ;; Closing quote?
+ ((and (not next)
+ (string-match (nth 7 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'close)
+ nil t s 1)))
+ ;; Opening quote?
+ ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s))
+ (setq s (replace-match
+ (funcall get-smart-quote (match-string 1 s) 'open)
+ nil t s 1))))
+ ;; Return string with smart quotes.
+ s))))
+
+;;;; Topology
+;;
+;; Here are various functions to retrieve information about the
+;; neighborhood of a given element or object. Neighbors of interest
+;; are direct parent (`org-export-get-parent'), parent headline
+;; (`org-export-get-parent-headline'), first element containing an
+;; object, (`org-export-get-parent-element'), parent table
+;; (`org-export-get-parent-table'), previous element or object
+;; (`org-export-get-previous-element') and next element or object
+;; (`org-export-get-next-element').
+;;
+;; `org-export-get-genealogy' returns the full genealogy of a given
+;; element or object, from closest parent to full parse tree.
+
+;; defsubst org-export-get-parent must be defined before first use
+(defun org-export-get-genealogy (blob)
+ "Return full genealogy relative to a given element or object.
+
+BLOB is the element or object being considered.
+
+Ancestors are returned from closest to farthest, the last one
+being the full parse tree."
+ (let (genealogy (parent blob))
+ (while (setq parent (org-element-property :parent parent))
+ (push parent genealogy))
+ (nreverse genealogy)))
+
+(defun org-export-get-parent-headline (blob)
+ "Return BLOB parent headline or nil.
+BLOB is the element or object being considered."
+ (let ((parent blob))
+ (while (and (setq parent (org-element-property :parent parent))
+ (not (eq (org-element-type parent) 'headline))))
+ parent))
+
+(defun org-export-get-parent-element (object)
+ "Return first element containing OBJECT or nil.
+OBJECT is the object to consider."
+ (let ((parent object))
+ (while (and (setq parent (org-element-property :parent parent))
+ (memq (org-element-type parent) org-element-all-objects)))
+ parent))
+
+(defun org-export-get-parent-table (object)
+ "Return OBJECT parent table or nil.
+OBJECT is either a `table-cell' or `table-element' type object."
+ (let ((parent object))
+ (while (and (setq parent (org-element-property :parent parent))
+ (not (eq (org-element-type parent) 'table))))
+ parent))
+
+(defun org-export-get-previous-element (blob info &optional n)
+ "Return previous element or object.
+
+BLOB is an element or object. INFO is a plist used as
+a communication channel. Return previous exportable element or
+object, a string, or nil.
+
+When optional argument N is a positive integer, return a list
+containing up to N siblings before BLOB, from farthest to
+closest. With any other non-nil value, return a list containing
+all of them."
+ (let ((siblings
+ ;; An object can belong to the contents of its parent or
+ ;; to a secondary string. We check the latter option
+ ;; first.
+ (let ((parent (org-export-get-parent blob)))
+ (or (let ((sec-value (org-element-property
+ (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))
+ parent)))
+ (and (memq blob sec-value) sec-value))
+ (org-element-contents parent))))
+ prev)
+ (catch 'exit
+ (mapc (lambda (obj)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj prev))
+ ((zerop n) (throw 'exit prev))
+ (t (decf n) (push obj prev))))
+ (cdr (memq blob (reverse siblings))))
+ prev)))
+
+(defun org-export-get-next-element (blob info &optional n)
+ "Return next element or object.
+
+BLOB is an element or object. INFO is a plist used as
+a communication channel. Return next exportable element or
+object, a string, or nil.
+
+When optional argument N is a positive integer, return a list
+containing up to N siblings after BLOB, from closest to farthest.
+With any other non-nil value, return a list containing all of
+them."
+ (let ((siblings
+ ;; An object can belong to the contents of its parent or to
+ ;; a secondary string. We check the latter option first.
+ (let ((parent (org-export-get-parent blob)))
+ (or (let ((sec-value (org-element-property
+ (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))
+ parent)))
+ (cdr (memq blob sec-value)))
+ (cdr (memq blob (org-element-contents parent))))))
+ next)
+ (catch 'exit
+ (mapc (lambda (obj)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj next))
+ ((zerop n) (throw 'exit (nreverse next)))
+ (t (decf n) (push obj next))))
+ siblings)
+ (nreverse next))))
+
+
+;;;; Translation
+;;
+;; `org-export-translate' translates a string according to the language
+;; specified by the LANGUAGE keyword. `org-export-dictionary' contains
+;; the dictionary used for the translation.
+
+(defconst org-export-dictionary
+ '(("%e %n: %c"
+ ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
+ ("Author"
+ ("ca" :default "Autor")
+ ("cs" :default "Autor")
+ ("da" :default "Forfatter")
+ ("de" :default "Autor")
+ ("eo" :html "A&#365;toro")
+ ("es" :default "Autor")
+ ("fi" :html "Tekij&auml;")
+ ("fr" :default "Auteur")
+ ("hu" :default "Szerz&otilde;")
+ ("is" :html "H&ouml;fundur")
+ ("it" :default "Autore")
+ ("ja" :html "&#33879;&#32773;" :utf-8 "著者")
+ ("nl" :default "Auteur")
+ ("no" :default "Forfatter")
+ ("nb" :default "Forfatter")
+ ("nn" :default "Forfattar")
+ ("pl" :default "Autor")
+ ("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
+ ("sv" :html "F&ouml;rfattare")
+ ("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
+ ("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
+ ("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
+ ("Date"
+ ("ca" :default "Data")
+ ("cs" :default "Datum")
+ ("da" :default "Dato")
+ ("de" :default "Datum")
+ ("eo" :default "Dato")
+ ("es" :default "Fecha")
+ ("fi" :html "P&auml;iv&auml;m&auml;&auml;r&auml;")
+ ("hu" :html "D&aacute;tum")
+ ("is" :default "Dagsetning")
+ ("it" :default "Data")
+ ("ja" :html "&#26085;&#20184;" :utf-8 "日付")
+ ("nl" :default "Datum")
+ ("no" :default "Dato")
+ ("nb" :default "Dato")
+ ("nn" :default "Dato")
+ ("pl" :default "Data")
+ ("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
+ ("sv" :default "Datum")
+ ("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
+ ("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
+ ("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
+ ("Equation"
+ ("da" :default "Ligning")
+ ("de" :default "Gleichung")
+ ("es" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("fr" :ascii "Equation" :default "Équation")
+ ("no" :default "Ligning")
+ ("nb" :default "Ligning")
+ ("nn" :default "Likning")
+ ("sv" :default "Ekvation")
+ ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
+ ("Figure"
+ ("da" :default "Figur")
+ ("de" :default "Abbildung")
+ ("es" :default "Figura")
+ ("ja" :html "&#22259;" :utf-8 "図")
+ ("no" :default "Illustrasjon")
+ ("nb" :default "Illustrasjon")
+ ("nn" :default "Illustrasjon")
+ ("sv" :default "Illustration")
+ ("zh-CN" :html "&#22270;" :utf-8 "图"))
+ ("Figure %d:"
+ ("da" :default "Figur %d")
+ ("de" :default "Abbildung %d:")
+ ("es" :default "Figura %d:")
+ ("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
+ ("ja" :html "&#22259;%d: " :utf-8 "図%d: ")
+ ("no" :default "Illustrasjon %d")
+ ("nb" :default "Illustrasjon %d")
+ ("nn" :default "Illustrasjon %d")
+ ("sv" :default "Illustration %d")
+ ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
+ ("Footnotes"
+ ("ca" :html "Peus de p&agrave;gina")
+ ("cs" :default "Pozn\xe1mky pod carou")
+ ("da" :default "Fodnoter")
+ ("de" :html "Fu&szlig;noten" :default "Fußnoten")
+ ("eo" :default "Piednotoj")
+ ("es" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("fi" :default "Alaviitteet")
+ ("fr" :default "Notes de bas de page")
+ ("hu" :html "L&aacute;bjegyzet")
+ ("is" :html "Aftanm&aacute;lsgreinar")
+ ("it" :html "Note a pi&egrave; di pagina")
+ ("ja" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("nl" :default "Voetnoten")
+ ("no" :default "Fotnoter")
+ ("nb" :default "Fotnoter")
+ ("nn" :default "Fotnotar")
+ ("pl" :default "Przypis")
+ ("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
+ ("sv" :default "Fotnoter")
+ ("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
+ :utf-8 "Примітки")
+ ("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
+ ("List of Listings"
+ ("da" :default "Programmer")
+ ("de" :default "Programmauflistungsverzeichnis")
+ ("es" :default "Indice de Listados de programas")
+ ("fr" :default "Liste des programmes")
+ ("no" :default "Dataprogrammer")
+ ("nb" :default "Dataprogrammer")
+ ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
+ ("List of Tables"
+ ("da" :default "Tabeller")
+ ("de" :default "Tabellenverzeichnis")
+ ("es" :default "Indice de tablas")
+ ("fr" :default "Liste des tableaux")
+ ("no" :default "Tabeller")
+ ("nb" :default "Tabeller")
+ ("nn" :default "Tabeller")
+ ("sv" :default "Tabeller")
+ ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
+ ("Listing %d:"
+ ("da" :default "Program %d")
+ ("de" :default "Programmlisting %d")
+ ("es" :default "Listado de programa %d")
+ ("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
+ ("no" :default "Dataprogram")
+ ("nb" :default "Dataprogram")
+ ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
+ ("See section %s"
+ ("da" :default "jævnfør afsnit %s")
+ ("de" :default "siehe Abschnitt %s")
+ ("es" :default "vea seccion %s")
+ ("fr" :default "cf. section %s")
+ ("zh-CN" :html "&#21442;&#35265;&#31532;%d&#33410;" :utf-8 "参见第%s节"))
+ ("Table"
+ ("de" :default "Tabelle")
+ ("es" :default "Tabla")
+ ("fr" :default "Tableau")
+ ("ja" :html "&#34920;" :utf-8 "表")
+ ("zh-CN" :html "&#34920;" :utf-8 "表"))
+ ("Table %d:"
+ ("da" :default "Tabel %d")
+ ("de" :default "Tabelle %d")
+ ("es" :default "Tabla %d")
+ ("fr" :default "Tableau %d :")
+ ("ja" :html "&#34920;%d:" :utf-8 "表%d:")
+ ("no" :default "Tabell %d")
+ ("nb" :default "Tabell %d")
+ ("nn" :default "Tabell %d")
+ ("sv" :default "Tabell %d")
+ ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
+ ("Table of Contents"
+ ("ca" :html "&Iacute;ndex")
+ ("cs" :default "Obsah")
+ ("da" :default "Indhold")
+ ("de" :default "Inhaltsverzeichnis")
+ ("eo" :default "Enhavo")
+ ("es" :html "&Iacute;ndice")
+ ("fi" :html "Sis&auml;llysluettelo")
+ ("fr" :ascii "Sommaire" :default "Table des matières")
+ ("hu" :html "Tartalomjegyz&eacute;k")
+ ("is" :default "Efnisyfirlit")
+ ("it" :default "Indice")
+ ("ja" :html "&#30446;&#27425;" :utf-8 "目次")
+ ("nl" :default "Inhoudsopgave")
+ ("no" :default "Innhold")
+ ("nb" :default "Innhold")
+ ("nn" :default "Innhald")
+ ("pl" :html "Spis tre&#x015b;ci")
+ ("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
+ :utf-8 "Содержание")
+ ("sv" :html "Inneh&aring;ll")
+ ("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
+ ("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
+ ("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
+ ("Unknown reference"
+ ("da" :default "ukendt reference")
+ ("de" :default "Unbekannter Verweis")
+ ("es" :default "referencia desconocida")
+ ("fr" :ascii "Destination inconnue" :default "Référence inconnue")
+ ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
+ "Dictionary for export engine.
+
+Alist whose CAR is the string to translate and CDR is an alist
+whose CAR is the language string and CDR is a plist whose
+properties are possible charsets and values translated terms.
+
+It is used as a database for `org-export-translate'. Since this
+function returns the string as-is if no translation was found,
+the variable only needs to record values different from the
+entry.")
+
+(defun org-export-translate (s encoding info)
+ "Translate string S according to language specification.
+
+ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1'
+and `:utf-8'. INFO is a plist used as a communication channel.
+
+Translation depends on `:language' property. Return the
+translated string. If no translation is found, try to fall back
+to `:default' encoding. If it fails, return S."
+ (let* ((lang (plist-get info :language))
+ (translations (cdr (assoc lang
+ (cdr (assoc s org-export-dictionary))))))
+ (or (plist-get translations encoding)
+ (plist-get translations :default)
+ s)))
+
+
+
+;;; Asynchronous Export
+;;
+;; `org-export-async-start' is the entry point for asynchronous
+;; export. It recreates current buffer (including visibility,
+;; narrowing and visited file) in an external Emacs process, and
+;; evaluates a command there. It then applies a function on the
+;; returned results in the current process.
+;;
+;; At a higher level, `org-export-to-buffer' and `org-export-to-file'
+;; allow to export to a buffer or a file, asynchronously or not.
+;;
+;; `org-export-output-file-name' is an auxiliary function meant to be
+;; used with `org-export-to-file'. With a given extension, it tries
+;; to provide a canonical file name to write export output to.
+;;
+;; Asynchronously generated results are never displayed directly.
+;; Instead, they are stored in `org-export-stack-contents'. They can
+;; then be retrieved by calling `org-export-stack'.
+;;
+;; Export Stack is viewed through a dedicated major mode
+;;`org-export-stack-mode' and tools: `org-export-stack-refresh',
+;;`org-export-stack-delete', `org-export-stack-view' and
+;;`org-export-stack-clear'.
+;;
+;; For back-ends, `org-export-add-to-stack' add a new source to stack.
+;; It should be used whenever `org-export-async-start' is called.
+
+(defmacro org-export-async-start (fun &rest body)
+ "Call function FUN on the results returned by BODY evaluation.
+
+FUN is an anonymous function of one argument. BODY evaluation
+happens in an asynchronous process, from a buffer which is an
+exact copy of the current one.
+
+Use `org-export-add-to-stack' in FUN in order to register results
+in the stack.
+
+This is a low level function. See also `org-export-to-buffer'
+and `org-export-to-file' for more specialized functions."
+ (declare (indent 1) (debug t))
+ (org-with-gensyms (process temp-file copy-fun proc-buffer coding)
+ ;; Write the full sexp evaluating BODY in a copy of the current
+ ;; buffer to a temporary file, as it may be too long for program
+ ;; args in `start-process'.
+ `(with-temp-message "Initializing asynchronous export process"
+ (let ((,copy-fun (org-export--generate-copy-script (current-buffer)))
+ (,temp-file (make-temp-file "org-export-process"))
+ (,coding buffer-file-coding-system))
+ (with-temp-file ,temp-file
+ (insert
+ ;; Null characters (from variable values) are inserted
+ ;; within the file. As a consequence, coding system for
+ ;; buffer contents will not be recognized properly. So,
+ ;; we make sure it is the same as the one used to display
+ ;; the original buffer.
+ (format ";; -*- coding: %s; -*-\n%S"
+ ,coding
+ `(with-temp-buffer
+ (when org-export-async-debug '(setq debug-on-error t))
+ ;; Ignore `kill-emacs-hook' and code evaluation
+ ;; queries from Babel as we need a truly
+ ;; non-interactive process.
+ (setq kill-emacs-hook nil
+ org-babel-confirm-evaluate-answer-no t)
+ ;; Initialize export framework.
+ (require 'ox)
+ ;; Re-create current buffer there.
+ (funcall ,,copy-fun)
+ (restore-buffer-modified-p nil)
+ ;; Sexp to evaluate in the buffer.
+ (print (progn ,,@body))))))
+ ;; Start external process.
+ (let* ((process-connection-type nil)
+ (,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
+ (,process
+ (start-process
+ "org-export-process" ,proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "-Q" "--batch"
+ "-l" org-export-async-init-file
+ "-l" ,temp-file)))
+ ;; Register running process in stack.
+ (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
+ ;; Set-up sentinel in order to catch results.
+ (let ((handler ,fun))
+ (set-process-sentinel
+ ,process
+ `(lambda (p status)
+ (let ((proc-buffer (process-buffer p)))
+ (when (eq (process-status p) 'exit)
+ (unwind-protect
+ (if (zerop (process-exit-status p))
+ (unwind-protect
+ (let ((results
+ (with-current-buffer proc-buffer
+ (goto-char (point-max))
+ (backward-sexp)
+ (read (current-buffer)))))
+ (funcall ,handler results))
+ (unless org-export-async-debug
+ (and (get-buffer proc-buffer)
+ (kill-buffer proc-buffer))))
+ (org-export-add-to-stack proc-buffer nil p)
+ (ding)
+ (message "Process `%s' exited abnormally" p))
+ (unless org-export-async-debug
+ (delete-file ,,temp-file)))))))))))))
+
+;;;###autoload
+(defun org-export-to-buffer
+ (backend buffer
+ &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified buffer.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+BUFFER is the name of the output buffer. If it already exists,
+it will be erased first, otherwise, it will be created.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should then be accessible
+through the `org-export-stack' interface. When ASYNC is nil, the
+buffer is displayed if `org-export-show-temporary-export-buffer'
+is non-nil.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is a function which should accept
+no argument. It is always called within the current process,
+from BUFFER, with point at its beginning. Export back-ends can
+use it to set a major mode there, e.g,
+
+ (defun org-latex-export-as-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ (interactive)
+ (org-export-to-buffer \\='latex \"*Org LATEX Export*\"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+This function returns BUFFER."
+ (declare (indent 2))
+ (if async
+ (org-export-async-start
+ `(lambda (output)
+ (with-current-buffer (get-buffer-create ,buffer)
+ (erase-buffer)
+ (setq buffer-file-coding-system ',buffer-file-coding-system)
+ (insert output)
+ (goto-char (point-min))
+ (org-export-add-to-stack (current-buffer) ',backend)
+ (ignore-errors (funcall ,post-process))))
+ `(org-export-as
+ ',backend ,subtreep ,visible-only ,body-only ',ext-plist))
+ (let ((output
+ (org-export-as backend subtreep visible-only body-only ext-plist))
+ (buffer (get-buffer-create buffer))
+ (encoding buffer-file-coding-system))
+ (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p))
+ (org-kill-new output))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (setq buffer-file-coding-system encoding)
+ (insert output)
+ (goto-char (point-min))
+ (and (functionp post-process) (funcall post-process)))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window buffer))
+ buffer)))
+
+;;;###autoload
+(defun org-export-to-file
+ (backend file &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified file.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. FILE is the name of the output file, as
+a string.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer will then be accessible
+through the `org-export-stack' interface.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is called with FILE as its
+argument and happens asynchronously when ASYNC is non-nil. It
+has to return a file name, or nil. Export back-ends can use this
+to send the output file through additional processing, e.g,
+
+ (defun org-latex-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ (interactive)
+ (let ((outfile (org-export-output-file-name \".tex\" subtreep)))
+ (org-export-to-file \\='latex outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))
+
+The function returns either a file name returned by POST-PROCESS,
+or FILE."
+ (declare (indent 2))
+ (if (not (file-writable-p file)) (error "Output file not writable")
+ (let ((ext-plist (org-combine-plists `(:output-file ,file) ext-plist))
+ (encoding (or org-export-coding-system buffer-file-coding-system)))
+ (if async
+ (org-export-async-start
+ `(lambda (file)
+ (org-export-add-to-stack (expand-file-name file) ',backend))
+ `(let ((output
+ (org-export-as
+ ',backend ,subtreep ,visible-only ,body-only
+ ',ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write ',encoding))
+ (write-file ,file)))
+ (or (ignore-errors (funcall ',post-process ,file)) ,file)))
+ (let ((output (org-export-as
+ backend subtreep visible-only body-only ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write encoding))
+ (write-file file)))
+ (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
+ (org-kill-new output))
+ ;; Get proper return value.
+ (or (and (functionp post-process) (funcall post-process file))
+ file))))))
+
+(defun org-export-output-file-name (extension &optional subtreep pub-dir)
+ "Return output file's name according to buffer specifications.
+
+EXTENSION is a string representing the output file extension,
+with the leading dot.
+
+With a non-nil optional argument SUBTREEP, try to determine
+output file's name by looking for \"EXPORT_FILE_NAME\" property
+of subtree at point.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return file name as a string."
+ (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
+ (base-name
+ ;; File name may come from EXPORT_FILE_NAME subtree
+ ;; property, assuming point is at beginning of said
+ ;; sub-tree.
+ (file-name-sans-extension
+ (or (and subtreep
+ (org-entry-get
+ (save-excursion
+ (ignore-errors (org-back-to-heading) (point)))
+ "EXPORT_FILE_NAME" t))
+ ;; File name may be extracted from buffer's associated
+ ;; file, if any.
+ (and visited-file (file-name-nondirectory visited-file))
+ ;; Can't determine file name on our own: Ask user.
+ (let ((read-file-name-function
+ (and org-completion-use-ido 'ido-read-file-name)))
+ (read-file-name
+ "Output file: " pub-dir nil nil nil
+ (lambda (name)
+ (string= (file-name-extension name t) extension)))))))
+ (output-file
+ ;; Build file name. Enforce EXTENSION over whatever user
+ ;; may have come up with. PUB-DIR, if defined, always has
+ ;; precedence over any provided path.
+ (cond
+ (pub-dir
+ (concat (file-name-as-directory pub-dir)
+ (file-name-nondirectory base-name)
+ extension))
+ ((file-name-absolute-p base-name) (concat base-name extension))
+ (t (concat (file-name-as-directory ".") base-name extension)))))
+ ;; If writing to OUTPUT-FILE would overwrite original file, append
+ ;; EXTENSION another time to final name.
+ (if (and visited-file (org-file-equal-p visited-file output-file))
+ (concat output-file extension)
+ output-file)))
+
+(defun org-export-add-to-stack (source backend &optional process)
+ "Add a new result to export stack if not present already.
+
+SOURCE is a buffer or a file name containing export results.
+BACKEND is a symbol representing export back-end used to generate
+it.
+
+Entries already pointing to SOURCE and unavailable entries are
+removed beforehand. Return the new stack."
+ (setq org-export-stack-contents
+ (cons (list source backend (or process (current-time)))
+ (org-export-stack-remove source))))
+
+(defun org-export-stack ()
+ "Menu for asynchronous export results and running processes."
+ (interactive)
+ (let ((buffer (get-buffer-create "*Org Export Stack*")))
+ (set-buffer buffer)
+ (when (zerop (buffer-size)) (org-export-stack-mode))
+ (org-export-stack-refresh)
+ (pop-to-buffer buffer))
+ (message "Type \"q\" to quit, \"?\" for help"))
+
+(defun org-export--stack-source-at-point ()
+ "Return source from export results at point in stack."
+ (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
+ (if (not source) (error "Source unavailable, please refresh buffer")
+ (let ((source-name (if (stringp source) source (buffer-name source))))
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at (concat ".* +" (regexp-quote source-name) "$")))
+ source
+ ;; SOURCE is not consistent with current line. The stack
+ ;; view is outdated.
+ (error "Source unavailable; type `g' to update buffer"))))))
+
+(defun org-export-stack-clear ()
+ "Remove all entries from export stack."
+ (interactive)
+ (setq org-export-stack-contents nil))
+
+(defun org-export-stack-refresh (&rest dummy)
+ "Refresh the asynchronous export stack.
+DUMMY is ignored. Unavailable sources are removed from the list.
+Return the new stack."
+ (let ((inhibit-read-only t))
+ (org-preserve-lc
+ (erase-buffer)
+ (insert (concat
+ (let ((counter 0))
+ (mapconcat
+ (lambda (entry)
+ (let ((proc-p (processp (nth 2 entry))))
+ (concat
+ ;; Back-end.
+ (format " %-12s " (or (nth 1 entry) ""))
+ ;; Age.
+ (let ((data (nth 2 entry)))
+ (if proc-p (format " %6s " (process-status data))
+ ;; Compute age of the results.
+ (org-format-seconds
+ "%4h:%.2m "
+ (float-time (time-since data)))))
+ ;; Source.
+ (format " %s"
+ (let ((source (car entry)))
+ (if (stringp source) source
+ (buffer-name source)))))))
+ ;; Clear stack from exited processes, dead buffers or
+ ;; non-existent files.
+ (setq org-export-stack-contents
+ (org-remove-if-not
+ (lambda (el)
+ (if (processp (nth 2 el))
+ (buffer-live-p (process-buffer (nth 2 el)))
+ (let ((source (car el)))
+ (if (bufferp source) (buffer-live-p source)
+ (file-exists-p source)))))
+ org-export-stack-contents)) "\n")))))))
+
+(defun org-export-stack-remove (&optional source)
+ "Remove export results at point from stack.
+If optional argument SOURCE is non-nil, remove it instead."
+ (interactive)
+ (let ((source (or source (org-export--stack-source-at-point))))
+ (setq org-export-stack-contents
+ (org-remove-if (lambda (el) (equal (car el) source))
+ org-export-stack-contents))))
+
+(defun org-export-stack-view (&optional in-emacs)
+ "View export results at point in stack.
+With an optional prefix argument IN-EMACS, force viewing files
+within Emacs."
+ (interactive "P")
+ (let ((source (org-export--stack-source-at-point)))
+ (cond ((processp source)
+ (org-switch-to-buffer-other-window (process-buffer source)))
+ ((bufferp source) (org-switch-to-buffer-other-window source))
+ (t (org-open-file source in-emacs)))))
+
+(defvar org-export-stack-mode-map
+ (let ((km (make-sparse-keymap)))
+ (define-key km " " 'next-line)
+ (define-key km "n" 'next-line)
+ (define-key km "\C-n" 'next-line)
+ (define-key km [down] 'next-line)
+ (define-key km "p" 'previous-line)
+ (define-key km "\C-p" 'previous-line)
+ (define-key km "\C-?" 'previous-line)
+ (define-key km [up] 'previous-line)
+ (define-key km "C" 'org-export-stack-clear)
+ (define-key km "v" 'org-export-stack-view)
+ (define-key km (kbd "RET") 'org-export-stack-view)
+ (define-key km "d" 'org-export-stack-remove)
+ km)
+ "Keymap for Org Export Stack.")
+
+(define-derived-mode org-export-stack-mode special-mode "Org-Stack"
+ "Mode for displaying asynchronous export stack.
+
+Type \\[org-export-stack] to visualize the asynchronous export
+stack.
+
+In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output
+on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear
+stack completely.
+
+Removing entries in an Org Export Stack buffer doesn't affect
+files or buffers, only the display.
+
+\\{org-export-stack-mode-map}"
+ (abbrev-mode 0)
+ (auto-fill-mode 0)
+ (setq buffer-read-only t
+ buffer-undo-list t
+ truncate-lines t
+ header-line-format
+ '(:eval
+ (format " %-12s | %6s | %s" "Back-End" "Age" "Source")))
+ (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t)
+ (set (make-local-variable 'revert-buffer-function)
+ 'org-export-stack-refresh))
+
+
+
+;;; The Dispatcher
+;;
+;; `org-export-dispatch' is the standard interactive way to start an
+;; export process. It uses `org-export--dispatch-ui' as a subroutine
+;; for its interface, which, in turn, delegates response to key
+;; pressed to `org-export--dispatch-action'.
+
+;;;###autoload
+(defun org-export-dispatch (&optional arg)
+ "Export dispatcher for Org mode.
+
+It provides an access to common export related tasks in a buffer.
+Its interface comes in two flavors: standard and expert.
+
+While both share the same set of bindings, only the former
+displays the valid keys associations in a dedicated buffer.
+Scrolling (resp. line-wise motion) in this buffer is done with
+SPC and DEL (resp. C-n and C-p) keys.
+
+Set variable `org-export-dispatch-use-expert-ui' to switch to one
+flavor or the other.
+
+When ARG is \\[universal-argument], repeat the last export action, with the same set
+of options used back then, on the current buffer.
+
+When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack."
+ (interactive "P")
+ (let* ((input
+ (cond ((equal arg '(16)) '(stack))
+ ((and arg org-export-dispatch-last-action))
+ (t (save-window-excursion
+ (unwind-protect
+ (progn
+ ;; Remember where we are
+ (move-marker org-export-dispatch-last-position
+ (point)
+ (org-base-buffer (current-buffer)))
+ ;; Get and store an export command
+ (setq org-export-dispatch-last-action
+ (org-export--dispatch-ui
+ (list org-export-initial-scope
+ (and org-export-in-background 'async))
+ nil
+ org-export-dispatch-use-expert-ui)))
+ (and (get-buffer "*Org Export Dispatcher*")
+ (kill-buffer "*Org Export Dispatcher*")))))))
+ (action (car input))
+ (optns (cdr input)))
+ (unless (memq 'subtree optns)
+ (move-marker org-export-dispatch-last-position nil))
+ (case action
+ ;; First handle special hard-coded actions.
+ (template (org-export-insert-default-template nil optns))
+ (stack (org-export-stack))
+ (publish-current-file
+ (org-publish-current-file (memq 'force optns) (memq 'async optns)))
+ (publish-current-project
+ (org-publish-current-project (memq 'force optns) (memq 'async optns)))
+ (publish-choose-project
+ (org-publish (assoc (org-icompleting-read
+ "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ (memq 'force optns)
+ (memq 'async optns)))
+ (publish-all (org-publish-all (memq 'force optns) (memq 'async optns)))
+ (otherwise
+ (save-excursion
+ (when arg
+ ;; Repeating command, maybe move cursor to restore subtree
+ ;; context.
+ (if (eq (marker-buffer org-export-dispatch-last-position)
+ (org-base-buffer (current-buffer)))
+ (goto-char org-export-dispatch-last-position)
+ ;; We are in a different buffer, forget position.
+ (move-marker org-export-dispatch-last-position nil)))
+ (funcall action
+ ;; Return a symbol instead of a list to ease
+ ;; asynchronous export macro use.
+ (and (memq 'async optns) t)
+ (and (memq 'subtree optns) t)
+ (and (memq 'visible optns) t)
+ (and (memq 'body optns) t)))))))
+
+(defun org-export--dispatch-ui (options first-key expertp)
+ "Handle interface for `org-export-dispatch'.
+
+OPTIONS is a list containing current interactive options set for
+export. It can contain any of the following symbols:
+`body' toggles a body-only export
+`subtree' restricts export to current subtree
+`visible' restricts export to visible part of buffer.
+`force' force publishing files.
+`async' use asynchronous export process
+
+FIRST-KEY is the key pressed to select the first level menu. It
+is nil when this menu hasn't been selected yet.
+
+EXPERTP, when non-nil, triggers expert UI. In that case, no help
+buffer is provided, but indications about currently active
+options are given in the prompt. Moreover, [?] allows to switch
+back to standard interface."
+ (let* ((fontify-key
+ (lambda (key &optional access-key)
+ ;; Fontify KEY string. Optional argument ACCESS-KEY, when
+ ;; non-nil is the required first-level key to activate
+ ;; KEY. When its value is t, activate KEY independently
+ ;; on the first key, if any. A nil value means KEY will
+ ;; only be activated at first level.
+ (if (or (eq access-key t) (eq access-key first-key))
+ (org-propertize key 'face 'org-warning)
+ key)))
+ (fontify-value
+ (lambda (value)
+ ;; Fontify VALUE string.
+ (org-propertize value 'face 'font-lock-variable-name-face)))
+ ;; Prepare menu entries by extracting them from registered
+ ;; back-ends and sorting them by access key and by ordinal,
+ ;; if any.
+ (entries
+ (sort (sort (delq nil
+ (mapcar 'org-export-backend-menu
+ org-export--registered-backends))
+ (lambda (a b)
+ (let ((key-a (nth 1 a))
+ (key-b (nth 1 b)))
+ (cond ((and (numberp key-a) (numberp key-b))
+ (< key-a key-b))
+ ((numberp key-b) t)))))
+ 'car-less-than-car))
+ ;; Compute a list of allowed keys based on the first key
+ ;; pressed, if any. Some keys
+ ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always
+ ;; available.
+ (allowed-keys
+ (nconc (list 2 22 19 6 1)
+ (if (not first-key) (org-uniquify (mapcar 'car entries))
+ (let (sub-menu)
+ (dolist (entry entries (sort (mapcar 'car sub-menu) '<))
+ (when (eq (car entry) first-key)
+ (setq sub-menu (append (nth 2 entry) sub-menu))))))
+ (cond ((eq first-key ?P) (list ?f ?p ?x ?a))
+ ((not first-key) (list ?P)))
+ (list ?& ?#)
+ (when expertp (list ??))
+ (list ?q)))
+ ;; Build the help menu for standard UI.
+ (help
+ (unless expertp
+ (concat
+ ;; Options are hard-coded.
+ (format "[%s] Body only: %s [%s] Visible only: %s
+[%s] Export scope: %s [%s] Force publishing: %s
+[%s] Async export: %s\n\n"
+ (funcall fontify-key "C-b" t)
+ (funcall fontify-value
+ (if (memq 'body options) "On " "Off"))
+ (funcall fontify-key "C-v" t)
+ (funcall fontify-value
+ (if (memq 'visible options) "On " "Off"))
+ (funcall fontify-key "C-s" t)
+ (funcall fontify-value
+ (if (memq 'subtree options) "Subtree" "Buffer "))
+ (funcall fontify-key "C-f" t)
+ (funcall fontify-value
+ (if (memq 'force options) "On " "Off"))
+ (funcall fontify-key "C-a" t)
+ (funcall fontify-value
+ (if (memq 'async options) "On " "Off")))
+ ;; Display registered back-end entries. When a key
+ ;; appears for the second time, do not create another
+ ;; entry, but append its sub-menu to existing menu.
+ (let (last-key)
+ (mapconcat
+ (lambda (entry)
+ (let ((top-key (car entry)))
+ (concat
+ (unless (eq top-key last-key)
+ (setq last-key top-key)
+ (format "\n[%s] %s\n"
+ (funcall fontify-key (char-to-string top-key))
+ (nth 1 entry)))
+ (let ((sub-menu (nth 2 entry)))
+ (unless (functionp sub-menu)
+ ;; Split sub-menu into two columns.
+ (let ((index -1))
+ (concat
+ (mapconcat
+ (lambda (sub-entry)
+ (incf index)
+ (format
+ (if (zerop (mod index 2)) " [%s] %-26s"
+ "[%s] %s\n")
+ (funcall fontify-key
+ (char-to-string (car sub-entry))
+ top-key)
+ (nth 1 sub-entry)))
+ sub-menu "")
+ (when (zerop (mod index 2)) "\n"))))))))
+ entries ""))
+ ;; Publishing menu is hard-coded.
+ (format "\n[%s] Publish
+ [%s] Current file [%s] Current project
+ [%s] Choose project [%s] All projects\n\n\n"
+ (funcall fontify-key "P")
+ (funcall fontify-key "f" ?P)
+ (funcall fontify-key "p" ?P)
+ (funcall fontify-key "x" ?P)
+ (funcall fontify-key "a" ?P))
+ (format "[%s] Export stack [%s] Insert template\n"
+ (funcall fontify-key "&" t)
+ (funcall fontify-key "#" t))
+ (format "[%s] %s"
+ (funcall fontify-key "q" t)
+ (if first-key "Main menu" "Exit")))))
+ ;; Build prompts for both standard and expert UI.
+ (standard-prompt (unless expertp "Export command: "))
+ (expert-prompt
+ (when expertp
+ (format
+ "Export command (C-%s%s%s%s%s) [%s]: "
+ (if (memq 'body options) (funcall fontify-key "b" t) "b")
+ (if (memq 'visible options) (funcall fontify-key "v" t) "v")
+ (if (memq 'subtree options) (funcall fontify-key "s" t) "s")
+ (if (memq 'force options) (funcall fontify-key "f" t) "f")
+ (if (memq 'async options) (funcall fontify-key "a" t) "a")
+ (mapconcat (lambda (k)
+ ;; Strip control characters.
+ (unless (< k 27) (char-to-string k)))
+ allowed-keys "")))))
+ ;; With expert UI, just read key with a fancy prompt. In standard
+ ;; UI, display an intrusive help buffer.
+ (if expertp
+ (org-export--dispatch-action
+ expert-prompt allowed-keys entries options first-key expertp)
+ ;; At first call, create frame layout in order to display menu.
+ (unless (get-buffer "*Org Export Dispatcher*")
+ (delete-other-windows)
+ (org-switch-to-buffer-other-window
+ (get-buffer-create "*Org Export Dispatcher*"))
+ (setq cursor-type nil
+ header-line-format "Use SPC, DEL, C-n or C-p to navigate.")
+ ;; Make sure that invisible cursor will not highlight square
+ ;; brackets.
+ (set-syntax-table (copy-syntax-table))
+ (modify-syntax-entry ?\[ "w"))
+ ;; At this point, the buffer containing the menu exists and is
+ ;; visible in the current window. So, refresh it.
+ (with-current-buffer "*Org Export Dispatcher*"
+ ;; Refresh help. Maintain display continuity by re-visiting
+ ;; previous window position.
+ (let ((pos (window-start)))
+ (erase-buffer)
+ (insert help)
+ (set-window-start nil pos)))
+ (org-fit-window-to-buffer)
+ (org-export--dispatch-action
+ standard-prompt allowed-keys entries options first-key expertp))))
+
+(defun org-export--dispatch-action
+ (prompt allowed-keys entries options first-key expertp)
+ "Read a character from command input and act accordingly.
+
+PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
+a list of characters available at a given step in the process.
+ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and
+EXPERTP are the same as defined in `org-export--dispatch-ui',
+which see.
+
+Toggle export options when required. Otherwise, return value is
+a list with action as CAR and a list of interactive export
+options as CDR."
+ (let (key)
+ ;; Scrolling: when in non-expert mode, act on motion keys (C-n,
+ ;; C-p, SPC, DEL).
+ (while (and (setq key (read-char-exclusive prompt))
+ (not expertp)
+ (memq key '(14 16 ?\s ?\d)))
+ (case key
+ (14 (if (not (pos-visible-in-window-p (point-max)))
+ (ignore-errors (scroll-up 1))
+ (message "End of buffer")
+ (sit-for 1)))
+ (16 (if (not (pos-visible-in-window-p (point-min)))
+ (ignore-errors (scroll-down 1))
+ (message "Beginning of buffer")
+ (sit-for 1)))
+ (?\s (if (not (pos-visible-in-window-p (point-max)))
+ (scroll-up nil)
+ (message "End of buffer")
+ (sit-for 1)))
+ (?\d (if (not (pos-visible-in-window-p (point-min)))
+ (scroll-down nil)
+ (message "Beginning of buffer")
+ (sit-for 1)))))
+ (cond
+ ;; Ignore undefined associations.
+ ((not (memq key allowed-keys))
+ (ding)
+ (unless expertp (message "Invalid key") (sit-for 1))
+ (org-export--dispatch-ui options first-key expertp))
+ ;; q key at first level aborts export. At second level, cancel
+ ;; first key instead.
+ ((eq key ?q) (if (not first-key) (error "Export aborted")
+ (org-export--dispatch-ui options nil expertp)))
+ ;; Help key: Switch back to standard interface if expert UI was
+ ;; active.
+ ((eq key ??) (org-export--dispatch-ui options first-key nil))
+ ;; Send request for template insertion along with export scope.
+ ((eq key ?#) (cons 'template (memq 'subtree options)))
+ ;; Switch to asynchronous export stack.
+ ((eq key ?&) '(stack))
+ ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1).
+ ((memq key '(2 22 19 6 1))
+ (org-export--dispatch-ui
+ (let ((option (case key (2 'body) (22 'visible) (19 'subtree)
+ (6 'force) (1 'async))))
+ (if (memq option options) (remq option options)
+ (cons option options)))
+ first-key expertp))
+ ;; Action selected: Send key and options back to
+ ;; `org-export-dispatch'.
+ ((or first-key (functionp (nth 2 (assq key entries))))
+ (cons (cond
+ ((not first-key) (nth 2 (assq key entries)))
+ ;; Publishing actions are hard-coded. Send a special
+ ;; signal to `org-export-dispatch'.
+ ((eq first-key ?P)
+ (case key
+ (?f 'publish-current-file)
+ (?p 'publish-current-project)
+ (?x 'publish-choose-project)
+ (?a 'publish-all)))
+ ;; Return first action associated to FIRST-KEY + KEY
+ ;; path. Indeed, derived backends can share the same
+ ;; FIRST-KEY.
+ (t (catch 'found
+ (mapc (lambda (entry)
+ (let ((match (assq key (nth 2 entry))))
+ (when match (throw 'found (nth 2 match)))))
+ (member (assq first-key entries) entries)))))
+ options))
+ ;; Otherwise, enter sub-menu.
+ (t (org-export--dispatch-ui options key expertp)))))
+
+
+
+(provide 'ox)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox.el ends here
diff --git a/lisp/outline.el b/lisp/outline.el
index 0ec5227a286..816cd9ae7c9 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1,9 +1,9 @@
;;; outline.el --- outline mode commands for Emacs
-;; Copyright (C) 1986, 1993-1995, 1997, 2000-2013 Free Software
+;; Copyright (C) 1986, 1993-1995, 1997, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: outlines
;; This file is part of GNU Emacs.
@@ -35,9 +35,6 @@
;;; Code:
-(defvar font-lock-warning-face)
-
-
(defgroup outlines nil
"Support for hierarchical outlining."
:prefix "outline-"
@@ -65,73 +62,66 @@ in the file it applies to.")
(define-key map "@" 'outline-mark-subtree)
(define-key map "\C-n" 'outline-next-visible-heading)
(define-key map "\C-p" 'outline-previous-visible-heading)
- (define-key map "\C-i" 'show-children)
- (define-key map "\C-s" 'show-subtree)
- (define-key map "\C-d" 'hide-subtree)
+ (define-key map "\C-i" 'outline-show-children)
+ (define-key map "\C-s" 'outline-show-subtree)
+ (define-key map "\C-d" 'outline-hide-subtree)
(define-key map "\C-u" 'outline-up-heading)
(define-key map "\C-f" 'outline-forward-same-level)
(define-key map "\C-b" 'outline-backward-same-level)
- (define-key map "\C-t" 'hide-body)
- (define-key map "\C-a" 'show-all)
- (define-key map "\C-c" 'hide-entry)
- (define-key map "\C-e" 'show-entry)
- (define-key map "\C-l" 'hide-leaves)
- (define-key map "\C-k" 'show-branches)
- (define-key map "\C-q" 'hide-sublevels)
- (define-key map "\C-o" 'hide-other)
+ (define-key map "\C-t" 'outline-hide-body)
+ (define-key map "\C-a" 'outline-show-all)
+ (define-key map "\C-c" 'outline-hide-entry)
+ (define-key map "\C-e" 'outline-show-entry)
+ (define-key map "\C-l" 'outline-hide-leaves)
+ (define-key map "\C-k" 'outline-show-branches)
+ (define-key map "\C-q" 'outline-hide-sublevels)
+ (define-key map "\C-o" 'outline-hide-other)
(define-key map "\C-^" 'outline-move-subtree-up)
(define-key map "\C-v" 'outline-move-subtree-down)
(define-key map [(control ?<)] 'outline-promote)
(define-key map [(control ?>)] 'outline-demote)
(define-key map "\C-m" 'outline-insert-heading)
- ;; Where to bind outline-cycle ?
map))
(defvar outline-mode-menu-bar-map
(let ((map (make-sparse-keymap)))
-
(define-key map [hide] (cons "Hide" (make-sparse-keymap "Hide")))
-
- (define-key map [hide hide-other]
- '(menu-item "Hide Other" hide-other
+ (define-key map [hide outline-hide-other]
+ '(menu-item "Hide Other" outline-hide-other
:help "Hide everything except current body and parent and top-level headings"))
- (define-key map [hide hide-sublevels]
- '(menu-item "Hide Sublevels" hide-sublevels
+ (define-key map [hide outline-hide-sublevels]
+ '(menu-item "Hide Sublevels" outline-hide-sublevels
:help "Hide everything but the top LEVELS levels of headers, in whole buffer"))
- (define-key map [hide hide-subtree]
- '(menu-item "Hide Subtree" hide-subtree
+ (define-key map [hide outline-hide-subtree]
+ '(menu-item "Hide Subtree" outline-hide-subtree
:help "Hide everything after this heading at deeper levels"))
- (define-key map [hide hide-entry]
- '(menu-item "Hide Entry" hide-entry
+ (define-key map [hide outline-hide-entry]
+ '(menu-item "Hide Entry" outline-hide-entry
:help "Hide the body directly following this heading"))
- (define-key map [hide hide-body]
- '(menu-item "Hide Body" hide-body
+ (define-key map [hide outline-hide-body]
+ '(menu-item "Hide Body" outline-hide-body
:help "Hide all body lines in buffer, leaving all headings visible"))
- (define-key map [hide hide-leaves]
- '(menu-item "Hide Leaves" hide-leaves
+ (define-key map [hide outline-hide-leaves]
+ '(menu-item "Hide Leaves" outline-hide-leaves
:help "Hide the body after this heading and at deeper levels"))
-
(define-key map [show] (cons "Show" (make-sparse-keymap "Show")))
-
- (define-key map [show show-subtree]
- '(menu-item "Show Subtree" show-subtree
+ (define-key map [show outline-show-subtree]
+ '(menu-item "Show Subtree" outline-show-subtree
:help "Show everything after this heading at deeper levels"))
- (define-key map [show show-children]
- '(menu-item "Show Children" show-children
+ (define-key map [show outline-show-children]
+ '(menu-item "Show Children" outline-show-children
:help "Show all direct subheadings of this heading"))
- (define-key map [show show-branches]
- '(menu-item "Show Branches" show-branches
+ (define-key map [show outline-show-branches]
+ '(menu-item "Show Branches" outline-show-branches
:help "Show all subheadings of this heading, but not their bodies"))
- (define-key map [show show-entry]
- '(menu-item "Show Entry" show-entry
+ (define-key map [show outline-show-entry]
+ '(menu-item "Show Entry" outline-show-entry
:help "Show the body directly following this heading"))
- (define-key map [show show-all]
- '(menu-item "Show All" show-all
+ (define-key map [show outline-show-all]
+ '(menu-item "Show All" outline-show-all
:help "Show all of the text in the buffer"))
-
(define-key map [headings]
(cons "Headings" (make-sparse-keymap "Headings")))
-
(define-key map [headings demote-subtree]
'(menu-item "Demote Subtree" outline-demote
:help "Demote headings lower down the tree"))
@@ -152,23 +142,18 @@ in the file it applies to.")
'(menu-item "New Heading" outline-insert-heading
:help "Insert a new heading at same depth at point"))
(define-key map [headings outline-backward-same-level]
-
'(menu-item "Previous Same Level" outline-backward-same-level
:help "Move backward to the arg'th subheading at same level as this one."))
(define-key map [headings outline-forward-same-level]
-
'(menu-item "Next Same Level" outline-forward-same-level
:help "Move forward to the arg'th subheading at same level as this one"))
(define-key map [headings outline-previous-visible-heading]
-
'(menu-item "Previous" outline-previous-visible-heading
:help "Move to the previous heading line"))
(define-key map [headings outline-next-visible-heading]
-
'(menu-item "Next" outline-next-visible-heading
:help "Move to the next visible heading line"))
(define-key map [headings outline-up-heading]
-
'(menu-item "Up" outline-up-heading
:help "Move to the visible heading line of which the present line is a subheading"))
map))
@@ -190,7 +175,6 @@ in the file it applies to.")
outline-mode-menu-bar-map))))))
map))
-
(defvar outline-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c" outline-mode-prefix-map)
@@ -198,7 +182,7 @@ in the file it applies to.")
map))
(defvar outline-font-lock-keywords
- '(;;
+ '(
;; Highlight headings according to the level.
(eval . (list (concat "^\\(?:" outline-regexp "\\).+")
0 '(outline-font-lock-face) nil t)))
@@ -248,33 +232,14 @@ in the file it applies to.")
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
-;; (defvar outline-font-lock-levels nil)
-;; (make-variable-buffer-local 'outline-font-lock-levels)
-
(defun outline-font-lock-face ()
- ;; (save-excursion
- ;; (outline-back-to-heading t)
- ;; (let* ((count 0)
- ;; (start-level (funcall outline-level))
- ;; (level start-level)
- ;; face-level)
- ;; (while (not (setq face-level
- ;; (if (or (bobp) (eq level 1)) 0
- ;; (cdr (assq level outline-font-lock-levels)))))
- ;; (outline-up-heading 1 t)
- ;; (setq count (1+ count))
- ;; (setq level (funcall outline-level)))
- ;; ;; Remember for later.
- ;; (unless (zerop count)
- ;; (setq face-level (+ face-level count))
- ;; (push (cons start-level face-level) outline-font-lock-levels))
- ;; (condition-case nil
- ;; (aref outline-font-lock-faces face-level)
- ;; (error font-lock-warning-face))))
+ "Return one of `outline-font-lock-faces' for current level."
(save-excursion
(goto-char (match-beginning 0))
(looking-at outline-regexp)
- (aref outline-font-lock-faces (% (1- (funcall outline-level)) (length outline-font-lock-faces)))))
+ (aref outline-font-lock-faces
+ (% (1- (funcall outline-level))
+ (length outline-font-lock-faces)))))
(defvar outline-view-change-hook nil
"Normal hook to be run after outline visibility changes.")
@@ -296,29 +261,11 @@ invisible, or visible again. Invisible lines are attached to the end
of the heading, so they move with it, if the line is killed and yanked
back. A heading with text hidden under it is marked with an ellipsis (...).
-Commands:\\<outline-mode-map>
-\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings
-\\[outline-previous-visible-heading] outline-previous-visible-heading
-\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings
-\\[outline-backward-same-level] outline-backward-same-level
-\\[outline-up-heading] outline-up-heading move from subheading to heading
-
-\\[hide-body] make all text invisible (not headings).
-\\[show-all] make everything in buffer visible.
-\\[hide-sublevels] make only the first N levels of headers visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree] hide-subtree make body and subheadings invisible.
-\\[show-subtree] show-subtree make body and subheadings visible.
-\\[show-children] show-children make direct subheadings visible.
- No effect on body, or subheadings 2 or more levels down.
- With arg N, affects subheadings N levels down.
-\\[hide-entry] make immediately following body invisible.
-\\[show-entry] make it visible.
-\\[hide-leaves] make body under heading and under its subheadings invisible.
- The subheadings remain visible.
-\\[show-branches] make all subheadings at all levels visible.
+\\{outline-mode-map}
+The commands `outline-hide-subtree', `outline-show-subtree',
+`outline-show-children', `outline-hide-entry',
+`outline-show-entry', `outline-hide-leaves', and `outline-show-branches'
+are used when point is on a heading line.
The variable `outline-regexp' can be changed to control what is a heading.
A line is a heading if `outline-regexp' matches something at the
@@ -340,7 +287,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of
'(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 'show-all nil t))
+ (add-hook 'change-major-mode-hook 'outline-show-all nil t))
(defcustom outline-minor-mode-prefix "\C-c@"
"Prefix key to use for Outline commands in Outline minor mode.
@@ -373,7 +320,7 @@ See the command `outline-mode' for more information on this mode."
;; Cause use of ellipses for invisible text.
(remove-from-invisibility-spec '(outline . t))
;; When turning off outline mode, get rid of any outline hiding.
- (show-all)))
+ (outline-show-all)))
(defvar outline-level 'outline-level
"Function of no args to compute a header's nesting level in an outline.
@@ -391,7 +338,7 @@ numbered and unnumbered sections), list them set by set and sorted by level
within each set. For example in texinfo mode:
(setq outline-heading-alist
- '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4)
+ \\='((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4)
(\"@subsubsection\" . 5)
(\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3)
(\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5)
@@ -441,7 +388,8 @@ at the end of the buffer."
nil 'move))
(defsubst outline-invisible-p (&optional pos)
- "Non-nil if the character after point is invisible."
+ "Non-nil if the character after POS is invisible.
+If POS is nil, use `point' instead."
(get-char-property (or pos (point)) 'invisible))
(defun outline-back-to-heading (&optional invisible-ok)
@@ -454,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"))
+ (error "Before first heading"))
(setq found (and (or invisible-ok (not (outline-invisible-p)))
(point)))))
(goto-char found)
@@ -489,6 +437,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
(run-hooks 'outline-insert-heading-hook)))
(defun outline-invent-heading (head up)
+ "Create a heading by using heading HEAD as a template.
+When UP is non-nil, the created heading will be one level above.
+Otherwise, it will be one level below."
(save-match-data
;; Let's try to invent one by repeating or deleting the last char.
(let ((new-head (if up (substring head 0 -1)
@@ -498,13 +449,13 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
;; Why bother checking that it is indeed higher/lower level ?
new-head
;; Didn't work, so ask what to do.
- (read-string (format "%s heading for `%s': "
- (if up "Parent" "Demoted") head)
+ (read-string (format-message "%s heading for `%s': "
+ (if up "Parent" "Demoted") head)
head nil nil t)))))
(defun outline-promote (&optional which)
"Promote headings higher up the tree.
-If transient-mark-mode is on, and mark is active, promote headings in
+If `transient-mark-mode' is on, and mark is active, promote headings in
the region (from a Lisp program, pass `region' for WHICH). Otherwise:
without prefix argument, promote current heading and all headings in the
subtree (from a Lisp program, pass `subtree' for WHICH); with prefix
@@ -543,7 +494,7 @@ nil for WHICH, or do not pass any argument)."
(defun outline-demote (&optional which)
"Demote headings lower down the tree.
-If transient-mark-mode is on, and mark is active, demote headings in
+If `transient-mark-mode' is on, and mark is active, demote headings in
the region (from a Lisp program, pass `region' for WHICH). Otherwise:
without prefix argument, demote current heading and all headings in the
subtree (from a Lisp program, pass `subtree' for WHICH); with prefix
@@ -585,7 +536,7 @@ nil for WHICH, or do not pass any argument)."
(replace-match down-head nil t)))))
(defun outline-head-from-level (level head &optional alist)
- "Get new heading with level LEVEL from ALIST.
+ "Get new heading with level LEVEL, closest to HEAD, from ALIST.
If there are no such entries, return nil.
ALIST defaults to `outline-heading-alist'.
Similar to (car (rassoc LEVEL ALIST)).
@@ -645,44 +596,49 @@ the match data is set appropriately."
(defun outline-move-subtree-down (&optional arg)
"Move the current subtree down past ARG headlines of the same level."
(interactive "p")
- (let ((movfunc (if (> arg 0) 'outline-get-next-sibling
- 'outline-get-last-sibling))
- (ins-point (make-marker))
- (cnt (abs arg))
- beg end folded)
- ;; Select the tree
- (outline-back-to-heading)
- (setq beg (point))
- (save-match-data
- (save-excursion (outline-end-of-heading)
- (setq folded (outline-invisible-p)))
- (outline-end-of-subtree))
- (if (= (char-after) ?\n) (forward-char 1))
- (setq end (point))
- ;; Find insertion point, with error handling
+ (outline-back-to-heading)
+ (let* ((movfunc (if (> arg 0) 'outline-get-next-sibling
+ 'outline-get-last-sibling))
+ ;; Find the end of the subtree to be moved as well as the point to
+ ;; move it to, adding a newline if necessary, to ensure these points
+ ;; are at bol on the line below the subtree.
+ (end-point-func (lambda ()
+ (outline-end-of-subtree)
+ (if (eq (char-after) ?\n) (forward-char 1)
+ (if (and (eobp) (not (bolp))) (insert "\n")))
+ (point)))
+ (beg (point))
+ (folded (save-match-data
+ (outline-end-of-heading)
+ (outline-invisible-p)))
+ (end (save-match-data
+ (funcall end-point-func)))
+ (ins-point (make-marker))
+ (cnt (abs arg)))
+ ;; Find insertion point, with error handling.
(goto-char beg)
(while (> cnt 0)
(or (funcall movfunc)
(progn (goto-char beg)
- (error "Cannot move past superior level")))
+ (user-error "Cannot move past superior level")))
(setq cnt (1- cnt)))
(if (> arg 0)
- ;; Moving forward - still need to move over subtree
- (progn (outline-end-of-subtree)
- (if (= (char-after) ?\n) (forward-char 1))))
+ ;; Moving forward - still need to move over subtree.
+ (funcall end-point-func))
(move-marker ins-point (point))
(insert (delete-and-extract-region beg end))
(goto-char ins-point)
- (if folded (hide-subtree))
+ (if folded (outline-hide-subtree))
(move-marker ins-point nil)))
(defun outline-end-of-heading ()
+ "Move to one char before the next `outline-heading-end-regexp'."
(if (re-search-forward outline-heading-end-regexp nil 'move)
(forward-char -1)))
(defun outline-next-visible-heading (arg)
"Move to the next visible heading line.
-With argument, repeats or can move backward if negative.
+With ARG, repeats or can move backward if negative.
A heading line is one that starts with a `*' (or that
`outline-regexp' matches)."
(interactive "p")
@@ -710,7 +666,7 @@ A heading line is one that starts with a `*' (or that
(defun outline-previous-visible-heading (arg)
"Move to the previous heading line.
-With argument, repeats or can move forward if negative.
+With ARG, repeats or can move forward if negative.
A heading line is one that starts with a `*' (or that
`outline-regexp' matches)."
(interactive "p")
@@ -735,7 +691,7 @@ This puts point at the start of the current subtree, and mark at the end."
(defvar outline-isearch-open-invisible-function nil
"Function called if `isearch' finishes in an invisible overlay.
The function is called with the overlay as its only argument.
-If nil, `show-entry' is called to reveal the invisible text.")
+If nil, `outline-show-entry' is called to reveal the invisible text.")
(put 'outline 'reveal-toggle-invisible 'outline-reveal-toggle-invisible)
(defun outline-flag-region (from to flag)
@@ -759,51 +715,51 @@ If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
(save-excursion
(goto-char (overlay-start o))
(if hidep
- ;; When hiding the area again, we could just clean it up and let
- ;; reveal do the rest, by simply doing:
- ;; (remove-overlays (overlay-start o) (overlay-end o)
- ;; 'invisible 'outline)
- ;;
- ;; That works fine as long as everything is in sync, but if the
- ;; structure of the document is changed while revealing parts of it,
- ;; the resulting behavior can be ugly. I.e. we need to make
- ;; sure that we hide exactly a subtree.
- (progn
- (let ((end (overlay-end o)))
- (delete-overlay o)
- (while (progn
- (hide-subtree)
- (outline-next-visible-heading 1)
- (and (not (eobp)) (< (point) end))))))
+ ;; When hiding the area again, we could just clean it up and let
+ ;; reveal do the rest, by simply doing:
+ ;; (remove-overlays (overlay-start o) (overlay-end o)
+ ;; 'invisible 'outline)
+ ;;
+ ;; That works fine as long as everything is in sync, but if the
+ ;; structure of the document is changed while revealing parts of it,
+ ;; the resulting behavior can be ugly. I.e. we need to make
+ ;; sure that we hide exactly a subtree.
+ (progn
+ (let ((end (overlay-end o)))
+ (delete-overlay o)
+ (while (progn
+ (outline-hide-subtree)
+ (outline-next-visible-heading 1)
+ (and (not (eobp)) (< (point) end))))))
;; When revealing, we just need to reveal sublevels. If point is
;; inside one of the sublevels, reveal will call us again.
;; But we need to preserve the original overlay.
(let ((o1 (copy-overlay o)))
- (overlay-put o 'invisible nil) ;Show (most of) the text.
- (while (progn
- (show-entry)
- (show-children)
- ;; Normally just the above is needed.
- ;; But in odd cases, the above might fail to show anything.
- ;; To avoid an infinite loop, we have to make sure that
- ;; *something* gets shown.
- (and (equal (overlay-start o) (overlay-start o1))
- (< (point) (overlay-end o))
- (= 0 (forward-line 1)))))
- ;; If still nothing was shown, just kill the damn thing.
- (when (equal (overlay-start o) (overlay-start o1))
- ;; I've seen it happen at the end of buffer.
- (delete-overlay o1))))))
+ (overlay-put o 'invisible nil) ;Show (most of) the text.
+ (while (progn
+ (outline-show-entry)
+ (outline-show-children)
+ ;; Normally just the above is needed.
+ ;; But in odd cases, the above might fail to show anything.
+ ;; To avoid an infinite loop, we have to make sure that
+ ;; *something* gets shown.
+ (and (equal (overlay-start o) (overlay-start o1))
+ (< (point) (overlay-end o))
+ (= 0 (forward-line 1)))))
+ ;; If still nothing was shown, just kill the damn thing.
+ (when (equal (overlay-start o) (overlay-start o1))
+ ;; I've seen it happen at the end of buffer.
+ (delete-overlay o1))))))
;; Function to be set as an outline-isearch-open-invisible' property
;; to the overlay that makes the outline invisible (see
;; `outline-flag-region').
(defun outline-isearch-open-invisible (_overlay)
;; We rely on the fact that isearch places point on the matched text.
- (show-entry))
+ (outline-show-entry))
-(defun hide-entry ()
+(defun outline-hide-entry ()
"Hide the body directly following this heading."
(interactive)
(save-excursion
@@ -811,22 +767,36 @@ 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)))
-(defun show-entry ()
+(define-obsolete-function-alias
+ 'hide-entry 'outline-hide-entry "25.1")
+
+(defun outline-show-entry ()
"Show the body directly following this heading.
Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
(outline-back-to-heading t)
(outline-flag-region (1- (point))
- (progn (outline-next-preface) (point)) nil)))
+ (progn
+ (outline-next-preface)
+ (if (= 1 (- (point-max) (point)))
+ (point-max)
+ (point)))
+ nil)))
-(defun hide-body ()
+(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."
(interactive)
- (hide-region-body (point-min) (point-max)))
+ (outline-hide-region-body (point-min) (point-max)))
+
+(define-obsolete-function-alias
+ 'hide-body 'outline-hide-body "25.1")
-(defun hide-region-body (start end)
- "Hide all body lines in the region, but not headings."
+(defun outline-hide-region-body (start end)
+ "Hide all body lines between START and END, but not headings."
;; Nullify the hook to avoid repeated calls to `outline-flag-region'
;; wasting lots of time running `lazy-lock-fontify-after-outline'
;; and run the hook finally.
@@ -846,30 +816,47 @@ Show the heading too, if it is currently invisible."
(outline-end-of-heading))))))
(run-hooks 'outline-view-change-hook))
-(defun show-all ()
+(define-obsolete-function-alias
+ '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))
-(defun hide-subtree ()
+(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))
-(defun hide-leaves ()
+(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."
(interactive)
(save-excursion
(outline-back-to-heading)
-;; Turned off to fix bug reported by Otto Maddox on 22 Nov 2005.
-;; (outline-end-of-heading)
- (hide-region-body (point) (progn (outline-end-of-subtree) (point)))))
+ ;; Turned off to fix bug reported by Otto Maddox on 22 Nov 2005.
+ ;; (outline-end-of-heading)
+ (outline-hide-region-body
+ (point)
+ (progn (outline-end-of-subtree) (point)))))
+
+(define-obsolete-function-alias
+ 'hide-leaves 'outline-hide-leaves "25.1")
-(defun show-subtree ()
+(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")
+
(defun outline-show-heading ()
"Show the current heading and move to its end."
(outline-flag-region (- (point)
@@ -880,7 +867,7 @@ Show the heading too, if it is currently invisible."
(progn (outline-end-of-heading) (point))
nil))
-(defun hide-sublevels (levels)
+(defun outline-hide-sublevels (levels)
"Hide everything but the top LEVELS levels of headers, in whole buffer."
(interactive (list
(cond
@@ -918,14 +905,17 @@ Show the heading too, if it is currently invisible."
(outline-flag-region (1- (point)) (point) nil))))
(run-hooks 'outline-view-change-hook))
-(defun hide-other ()
+(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."
(interactive)
- (hide-sublevels 1)
+ (outline-hide-sublevels 1)
(let (outline-view-change-hook)
(save-excursion
(outline-back-to-heading t)
- (show-entry)
+ (outline-show-entry)
(while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp)))
(error nil))
(outline-flag-region (1- (point))
@@ -933,17 +923,21 @@ Show the heading too, if it is currently invisible."
nil))))
(run-hooks 'outline-view-change-hook))
+(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."
(interactive)
(save-excursion
(outline-back-to-heading)
(if (not (outline-invisible-p (line-end-position)))
- (hide-subtree)
- (show-children)
- (show-entry))))
+ (outline-hide-subtree)
+ (outline-show-children)
+ (outline-show-entry))))
(defun outline-flag-subtree (flag)
+ "Assign FLAG to the current subtree."
(save-excursion
(outline-back-to-heading)
(outline-end-of-heading)
@@ -952,6 +946,7 @@ Show the heading too, if it is currently invisible."
flag)))
(defun outline-end-of-subtree ()
+ "Move to the end of the current subtree."
(outline-back-to-heading)
(let ((first t)
(level (funcall outline-level)))
@@ -968,12 +963,15 @@ Show the heading too, if it is currently invisible."
;; leave blank line before heading
(forward-char -1))))))
-(defun show-branches ()
+(defun outline-show-branches ()
"Show all subheadings of this heading, but not their bodies."
(interactive)
- (show-children 1000))
+ (outline-show-children 1000))
+
+(define-obsolete-function-alias
+ 'show-branches 'outline-show-branches "25.1")
-(defun show-children (&optional level)
+(defun outline-show-children (&optional level)
"Show all direct subheadings of this heading.
Prefix arg LEVEL is how many levels below the current level should be shown.
Default is enough to cause the following heading to appear."
@@ -1000,6 +998,9 @@ 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")
+
(defun outline-up-heading (arg &optional invisible-ok)
@@ -1082,7 +1083,7 @@ If there is no such heading, return nil."
(point)))))
(defun outline-headers-as-kill (beg end)
- "Save the visible outline headers in region at the start of the kill ring.
+ "Save the visible outline headers between BEG and END to the kill ring.
Text shown between the headers isn't copied. Two newlines are
inserted between saved headers. Yanking the result may be a
diff --git a/lisp/paren.el b/lisp/paren.el
index 6f386573b01..30314c2f9c8 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -1,9 +1,9 @@
;;; paren.el --- highlight matching paren
-;; Copyright (C) 1993, 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: rms@gnu.org
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, faces
;; This file is part of GNU Emacs.
@@ -43,8 +43,7 @@ Valid styles are `parenthesis' (meaning show the matching paren),
`expression' (meaning show the entire expression enclosed by the paren) and
`mixed' (meaning show the matching paren if it is visible, and the expression
otherwise)."
- :type '(choice (const parenthesis) (const expression) (const mixed))
- :group 'paren-showing)
+ :type '(choice (const parenthesis) (const expression) (const mixed)))
(defcustom show-paren-delay 0.125
"Time in seconds to delay before showing a matching paren.
@@ -57,50 +56,39 @@ active, you must toggle the mode off and on again for this to take effect."
(set sym val)
(show-paren-mode -1)
(set sym val)
- (show-paren-mode 1)))
- :group 'paren-showing)
+ (show-paren-mode 1))))
(defcustom show-paren-priority 1000
"Priority of paren highlighting overlays."
- :type 'integer
- :group 'paren-showing
+ :type 'integer
:version "21.1")
(defcustom show-paren-ring-bell-on-mismatch nil
"If non-nil, beep if mismatched paren is detected."
:type 'boolean
- :group 'paren-showing
:version "20.3")
-(defgroup paren-showing-faces nil
- "Group for faces of Show Paren mode."
- :group 'paren-showing
- :group 'faces
- :version "22.1")
-
-(defface show-paren-match
- '((((class color) (background light))
- :background "turquoise") ; looks OK on tty (becomes cyan)
- (((class color) (background dark))
- :background "steelblue3") ; looks OK on tty (becomes blue)
- (((background dark))
- :background "grey50")
- (t
- :background "gray"))
- "Show Paren mode face used for a matching paren."
- :group 'paren-showing-faces)
+(defcustom show-paren-when-point-inside-paren nil
+ "If non-nil, show parens when point is just inside one.
+This will only be done when point isn't also just outside a paren."
+ :type 'boolean
+ :version "25.1")
+
+(defcustom show-paren-when-point-in-periphery nil
+ "If non-nil, show parens when point is in the line's periphery.
+The periphery is at the beginning or end of a line or in any
+whitespace there."
+ :type 'boolean
+ :version "25.1")
+
(define-obsolete-face-alias 'show-paren-match-face 'show-paren-match "22.1")
-(defface show-paren-mismatch
- '((((class color)) (:foreground "white" :background "purple"))
- (t (:inverse-video t)))
- "Show Paren mode face used for a mismatching paren."
- :group 'paren-showing-faces)
(define-obsolete-face-alias 'show-paren-mismatch-face
'show-paren-mismatch "22.1")
-(defvar show-paren-highlight-openparen t
- "Non-nil turns on openparen highlighting when matching forward.")
+(defcustom show-paren-highlight-openparen t
+ "Non-nil turns on openparen highlighting when matching forward."
+ :type 'boolean)
(defvar show-paren--idle-timer nil)
(defvar show-paren--overlay
@@ -134,76 +122,113 @@ matching parenthesis is highlighted in `show-paren-style' after
(delete-overlay show-paren--overlay)
(delete-overlay show-paren--overlay-1)))
+(defun show-paren--unescaped-p (pos)
+ "Determine whether the paren after POS is unescaped."
+ (save-excursion
+ (goto-char pos)
+ (= (logand (skip-syntax-backward "/\\") 1) 0)))
+
+(defun show-paren--categorize-paren (pos)
+ "Determine whether the character after POS has paren syntax,
+and if so, return a cons (DIR . OUTSIDE), where DIR is 1 for an
+open paren, -1 for a close paren, and OUTSIDE is the buffer
+position of the outside of the paren. If the character isn't a
+paren, or it is an escaped paren, return nil."
+ (cond
+ ((and (eq (syntax-class (syntax-after pos)) 4)
+ (show-paren--unescaped-p pos))
+ (cons 1 pos))
+ ((and (eq (syntax-class (syntax-after pos)) 5)
+ (show-paren--unescaped-p pos))
+ (cons -1 (1+ pos)))))
+
+(defun show-paren--locate-near-paren ()
+ "Locate an unescaped paren \"near\" point to show.
+If one is found, return the cons (DIR . OUTSIDE), where DIR is 1
+for an open paren, -1 for a close paren, and OUTSIDE is the buffer
+position of the outside of the paren. Otherwise return nil."
+ (let* ((ind-pos (save-excursion (back-to-indentation) (point)))
+ (eol-pos
+ (save-excursion
+ (end-of-line) (skip-chars-backward " \t" ind-pos) (point)))
+ (before (show-paren--categorize-paren (1- (point))))
+ (after (show-paren--categorize-paren (point))))
+ (cond
+ ;; Point is immediately outside a paren.
+ ((eq (car before) -1) before)
+ ((eq (car after) 1) after)
+ ;; Point is immediately inside a paren.
+ ((and show-paren-when-point-inside-paren before))
+ ((and show-paren-when-point-inside-paren after))
+ ;; Point is in the whitespace before the code.
+ ((and show-paren-when-point-in-periphery
+ (<= (point) ind-pos))
+ (or (show-paren--categorize-paren ind-pos)
+ (show-paren--categorize-paren (1- eol-pos))))
+ ;; Point is in the whitespace after the code.
+ ((and show-paren-when-point-in-periphery
+ (>= (point) eol-pos))
+ (show-paren--categorize-paren (1- eol-pos))))))
+
(defvar show-paren-data-function #'show-paren--default
- "Function to find the opener/closer at point and its match.
+ "Function to find the opener/closer \"near\" point and its match.
The function is called with no argument and should return either nil
-if there's no opener/closer at point, or a list of the form
+if there's no opener/closer near point, or a list of the form
\(HERE-BEG HERE-END THERE-BEG THERE-END MISMATCH)
-Where HERE-BEG..HERE-END is expected to be around point.")
+Where HERE-BEG..HERE-END is expected to be near point.")
(defun show-paren--default ()
- (let* ((oldpos (point))
- (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1)
- ((eq (syntax-class (syntax-after (point))) 4) 1)))
- (unescaped
- (when dir
- ;; Verify an even number of quoting characters precede the paren.
- ;; Follow the same logic as in `blink-matching-open'.
- (= (if (= dir -1) 1 0)
- (logand 1 (- (point)
- (save-excursion
- (if (= dir -1) (forward-char -1))
- (skip-syntax-backward "/\\")
- (point)))))))
- (here-beg (if (eq dir 1) (point) (1- (point))))
- (here-end (if (eq dir 1) (1+ (point)) (point)))
- pos mismatch)
+ (let* ((temp (show-paren--locate-near-paren))
+ (dir (car temp))
+ (outside (cdr temp))
+ pos mismatch here-beg here-end)
;;
;; Find the other end of the sexp.
- (when unescaped
- (save-excursion
- (save-restriction
- ;; Determine the range within which to look for a match.
- (when blink-matching-paren-distance
- (narrow-to-region
- (max (point-min) (- (point) blink-matching-paren-distance))
- (min (point-max) (+ (point) blink-matching-paren-distance))))
- ;; Scan across one sexp within that range.
- ;; Errors or nil mean there is a mismatch.
- (condition-case ()
- (setq pos (scan-sexps (point) dir))
- (error (setq pos t mismatch t)))
- ;; Move back the other way and verify we get back to the
- ;; starting point. If not, these two parens don't really match.
- ;; Maybe the one at point is escaped and doesn't really count,
- ;; or one is inside a comment.
- (when (integerp pos)
- (unless (condition-case ()
- (eq (point) (scan-sexps pos (- dir)))
- (error nil))
- (setq pos nil)))
- ;; If found a "matching" paren, see if it is the right
- ;; kind of paren to match the one we started at.
- (if (not (integerp pos))
- (if mismatch (list here-beg here-end nil nil t))
- (let ((beg (min pos oldpos)) (end (max pos oldpos)))
- (unless (eq (syntax-class (syntax-after beg)) 8)
- (setq mismatch
- (not (or (eq (char-before end)
- ;; This can give nil.
- (cdr (syntax-after beg)))
- (eq (char-after beg)
- ;; This can give nil.
- (cdr (syntax-after (1- end))))
- ;; The cdr might hold a new paren-class
- ;; info rather than a matching-char info,
- ;; in which case the two CDRs should match.
- (eq (cdr (syntax-after (1- end)))
- (cdr (syntax-after beg)))))))
- (list here-beg here-end
- (if (= dir 1) (1- pos) pos)
- (if (= dir 1) pos (1+ pos))
- mismatch))))))))
+ (when dir
+ (setq here-beg (if (eq dir 1) outside (1- outside))
+ here-end (if (eq dir 1) (1+ outside) outside))
+ (save-restriction
+ ;; Determine the range within which to look for a match.
+ (when blink-matching-paren-distance
+ (narrow-to-region
+ (max (point-min) (- (point) blink-matching-paren-distance))
+ (min (point-max) (+ (point) blink-matching-paren-distance))))
+ ;; Scan across one sexp within that range.
+ ;; Errors or nil mean there is a mismatch.
+ (condition-case ()
+ (setq pos (scan-sexps outside dir))
+ (error (setq pos t mismatch t)))
+ ;; Move back the other way and verify we get back to the
+ ;; starting point. If not, these two parens don't really match.
+ ;; Maybe the one at point is escaped and doesn't really count,
+ ;; or one is inside a comment.
+ (when (integerp pos)
+ (unless (condition-case ()
+ (eq outside (scan-sexps pos (- dir)))
+ (error nil))
+ (setq pos nil)))
+ ;; If found a "matching" paren, see if it is the right
+ ;; kind of paren to match the one we started at.
+ (if (not (integerp pos))
+ (if mismatch (list here-beg here-end nil nil t))
+ (let ((beg (min pos outside)) (end (max pos outside)))
+ (unless (eq (syntax-class (syntax-after beg)) 8)
+ (setq mismatch
+ (not (or (eq (char-before end)
+ ;; This can give nil.
+ (cdr (syntax-after beg)))
+ (eq (char-after beg)
+ ;; This can give nil.
+ (cdr (syntax-after (1- end))))
+ ;; The cdr might hold a new paren-class
+ ;; info rather than a matching-char info,
+ ;; in which case the two CDRs should match.
+ (eq (cdr (syntax-after (1- end)))
+ (cdr (syntax-after beg)))))))
+ (list here-beg here-end
+ (if (= dir 1) (1- pos) pos)
+ (if (= dir 1) pos (1+ pos))
+ mismatch)))))))
;; Find the place to show, if there is one,
;; and show it until input arrives.
@@ -237,7 +262,8 @@ Where HERE-BEG..HERE-END is expected to be around point.")
;; Otherwise, turn off any such highlighting.
(if (or (not here-beg)
(and (not show-paren-highlight-openparen)
- (> here-end (point))
+ (> here-end (point))
+ (<= here-beg (point))
(integerp there-beg)))
(delete-overlay show-paren--overlay-1)
(move-overlay show-paren--overlay-1
@@ -256,7 +282,7 @@ Where HERE-BEG..HERE-END is expected to be around point.")
(1- there-end) (1+ there-beg))))
(not (pos-visible-in-window-p closest)))))
(move-overlay show-paren--overlay
- (point)
+ (if (< there-beg here-beg) here-end here-beg)
(if (< there-beg here-beg) there-beg there-end)
(current-buffer))
(move-overlay show-paren--overlay
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index cb7f3e863cd..59357f763e9 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -1,6 +1,6 @@
;;; password-cache.el --- Read passwords, possibly using a password cache.
-;; Copyright (C) 1999-2000, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2000, 2003-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Created: 2003-12-21
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index 9b6d2c7e073..b64fb65d3b7 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -1,6 +1,6 @@
;;; pcmpl-cvs.el --- functions for dealing with cvs completions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Package: pcomplete
@@ -38,7 +38,7 @@
;; User Variables:
(defcustom pcmpl-cvs-binary (or (executable-find "cvs") "cvs")
- "The full path of the 'cvs' binary."
+ "The full path of the `cvs' binary."
:type 'file
:group 'pcmpl-cvs)
@@ -154,7 +154,7 @@
(defun pcmpl-cvs-entries (&optional opers)
"Return the Entries for the current directory.
If OPERS is a list of characters, return entries for which that
-operation character applies, as displayed by 'cvs -n update'."
+operation character applies, as displayed by `cvs -n update'."
(let* ((arg (pcomplete-arg))
(dir (file-name-as-directory
(or (file-name-directory arg) "")))
@@ -164,27 +164,28 @@ operation character applies, as displayed by 'cvs -n update'."
(with-temp-buffer
(and dir (cd dir))
(call-process pcmpl-cvs-binary nil t nil
- "-q" "-n" "-f" "update"); "-l")
+ "-q" "-n" "-f" "update") ; "-l")
(goto-char (point-min))
(while (re-search-forward "^\\(.\\) \\(.+\\)$" nil t)
(if (memq (string-to-char (match-string 1)) opers)
(setq entries (cons (match-string 2) entries)))))
- (with-temp-buffer
- (insert-file-contents (concat dir "CVS/Entries"))
- (goto-char (point-min))
- (while (not (eobp))
- ;; Normal file: /NAME -> "" "NAME"
- ;; Directory : D/NAME -> "D" "NAME"
- (let* ((fields (split-string (buffer-substring
- (line-beginning-position)
- (line-end-position))
- "/"))
- (text (nth 1 fields)))
- (when text
- (if (string= (nth 0 fields) "D")
- (setq text (file-name-as-directory text)))
- (setq entries (cons text entries))))
- (forward-line))))
+ (when (file-exists-p (expand-file-name "CVS/Entries" dir))
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name "CVS/Entries" dir))
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; Normal file: /NAME -> "" "NAME"
+ ;; Directory : D/NAME -> "D" "NAME"
+ (let* ((fields (split-string (buffer-substring
+ (line-beginning-position)
+ (line-end-position))
+ "/"))
+ (text (nth 1 fields)))
+ (when text
+ (if (string= (nth 0 fields) "D")
+ (setq text (file-name-as-directory text)))
+ (setq entries (cons text entries))))
+ (forward-line)))))
(setq pcomplete-stub nondir)
(pcomplete-uniqify-list entries)))
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index fb31984facc..ada2a041766 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -1,6 +1,6 @@
;;; pcmpl-gnu.el --- completions for GNU project tools -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -323,8 +323,8 @@
(let ((file (pcomplete-arg 1)))
(completion-table-dynamic
(lambda (_string)
- (pcmpl-gnu-with-file-buffer file
- (mapcar #'tar-header-name tar-parse-info)))))
+ (pcmpl-gnu-with-file-buffer
+ file (mapcar #'tar-header-name tar-parse-info)))))
(pcomplete-entries))
nil 'identity))))
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index a946f0885ac..5e52309013b 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -1,6 +1,6 @@
;;; pcmpl-linux.el --- functions for dealing with GNU/Linux completions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Package: pcomplete
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index d2462b63be2..81d1f7e1c2d 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -1,6 +1,6 @@
;;; pcmpl-rpm.el --- functions for dealing with rpm completions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Package: pcomplete
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 4fc2f84c1c9..7be57e9c93a 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -1,6 +1,6 @@
;;; pcmpl-unix.el --- standard UNIX completions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Package: pcomplete
@@ -157,7 +157,7 @@ documentation), this function returns nil."
(while (re-search-forward (concat "^ *" host-re) nil t)
(add-to-list 'ssh-hosts-list (concat (match-string 1)
(match-string 2)))
- (while (and (looking-back ",")
+ (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)))))
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 86d8dc652c3..e6fb5bfdac3 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -1,6 +1,6 @@
;;; pcmpl-x.el --- completion for miscellaneous tools -*- lexical-binding: t; -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
;; Keywords: processes, tools, convenience
@@ -31,6 +31,7 @@
(defcustom pcmpl-x-tlmgr-program "tlmgr"
"Name of the tlmgr program."
+ :version "24.4"
:type 'file
:group 'pcomplete)
@@ -154,6 +155,7 @@
(executable-find "ack")
"ack"))
"Name of the ack program."
+ :version "24.4"
:type 'file
:group 'pcomplete)
@@ -221,7 +223,7 @@
;;;###autoload
(defun pcomplete/ack ()
"Completion for the `ack' command.
-Start an argument with '-' to complete short options and '--' for
+Start an argument with `-' to complete short options and `--' for
long options."
;; No space after =
(while t
@@ -247,5 +249,42 @@ long options."
;;;###autoload
(defalias 'pcomplete/ack-grep 'pcomplete/ack)
+
+;;;; the_silver_search - https://github.com/ggreer/the_silver_searcher
+
+(defvar pcmpl-x-ag-options nil)
+
+(defun pcmpl-x-ag-options ()
+ (or pcmpl-x-ag-options
+ (setq pcmpl-x-ag-options
+ (with-temp-buffer
+ (when (zerop (call-process "ag" nil t nil "--help"))
+ (let (short long)
+ (goto-char (point-min))
+ (while (re-search-forward "^ +\\(-[a-zA-Z]\\) " nil t)
+ (push (match-string 1) short))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^ +\\(?:-[a-zA-Z] \\)?\\(--\\(\\[no\\]\\)?[^ \t\n]+\\) "
+ nil t)
+ (if (match-string 2)
+ (progn
+ (replace-match "" nil nil nil 2)
+ (push (match-string 1) long)
+ (replace-match "no" nil nil nil 2)
+ (push (match-string 1) long))
+ (push (match-string 1) long)))
+ (list (cons 'short (nreverse short))
+ (cons 'long (nreverse long)))))))))
+
+;;;###autoload
+(defun pcomplete/ag ()
+ "Completion for the `ag' command."
+ (while t
+ (if (pcomplete-match "^-" 0)
+ (pcomplete-here* (cdr (assq (if (pcomplete-match "^--" 0) 'long 'short)
+ (pcmpl-x-ag-options))))
+ (pcomplete-here* (pcomplete-dirs-or-entries)))))
+
(provide 'pcmpl-x)
;;; pcmpl-x.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 957505f43b8..65dd8e7d24a 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,6 +1,6 @@
;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes abbrev
@@ -193,7 +193,7 @@ current command argument."
(defcustom pcomplete-expand-before-complete nil
"If non-nil, expand the current argument before completing it.
-This means that typing something such as '$HOME/bi' followed by
+This means that typing something such as `$HOME/bi' followed by
\\[pcomplete-argument] will cause the variable reference to be
resolved first, and the resultant value that will be completed against
to be inserted in the buffer. Note that exactly what gets expanded
@@ -755,8 +755,7 @@ this is `comint-dynamic-complete-functions'."
pcomplete-index 0
pcomplete-stub (pcomplete-arg 'last))
(let ((begin (pcomplete-begin 'last)))
- (if (and pcomplete-cycle-completions
- (listp pcomplete-stub) ;??
+ (if (and (listp pcomplete-stub) ;??
(not pcomplete-expand-only-p))
(let* ((completions pcomplete-stub) ;??
(common-stub (car completions))
@@ -1023,8 +1022,8 @@ string, use it as the completion stub instead of the default (which is
the entire text of the current argument).
For an example of when you might want to use STUB: if the current
-argument text is 'long-path-name/', you don't want the completions
-list display to be cluttered by 'long-path-name/' appearing at the
+argument text is `long-path-name/', you don't want the completions
+list display to be cluttered by `long-path-name/' appearing at the
beginning of every alternative. Not only does this make things less
intelligible, but it is also inefficient. Yet, if the completion list
does not begin with this string for every entry, the current argument
@@ -1113,7 +1112,7 @@ Typing SPC flushes the help buffer."
(scroll-up))))
(message ""))
(t
- (setq unread-command-events (list event))
+ (push event unread-command-events)
(throw 'done nil)))))
(if (and pcomplete-last-window-config
pcomplete-restore-window-delay)
diff --git a/lisp/play/.gitignore b/lisp/play/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/play/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 2e3f500766f..a07b381d057 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -1,6 +1,6 @@
-;;; 5x5.el --- simple little puzzle game -*- coding: utf-8 -*-
+;;; 5x5.el --- simple little puzzle game
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Dave Pearson <davep@davep.org>
;; Maintainer: Dave Pearson <davep@davep.org>
@@ -185,19 +185,8 @@ GRID is the grid of positions to click.")
;; Gameplay functions.
-(put '5x5-mode 'mode-class 'special)
-
-(defun 5x5-mode ()
- "A mode for playing `5x5'.
-
-The key bindings for `5x5-mode' are:
-
-\\{5x5-mode-map}"
- (kill-all-local-variables)
- (use-local-map 5x5-mode-map)
- (setq major-mode '5x5-mode
- mode-name "5x5")
- (run-mode-hooks '5x5-mode-hook)
+(define-derived-mode 5x5-mode special-mode "5x5"
+ "A mode for playing `5x5'."
(setq buffer-read-only t
truncate-lines t)
(buffer-disable-undo))
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index 83eddbf095f..e869f2c124b 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,6 +1,6 @@
;;; animate.el --- make text dance
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Maintainer: Richard Stallman <rms@gnu.org>
;; Keywords: games
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index d38f799756b..74ac70bc585 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -1,6 +1,6 @@
;;; blackbox.el --- blackbox game in Emacs Lisp
-;; Copyright (C) 1985-1987, 1992, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985-1987, 1992, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
@@ -113,9 +113,8 @@
map))
;; Blackbox mode is suitable only for specially formatted data.
-(put 'blackbox-mode 'mode-class 'special)
-(defun blackbox-mode ()
+(define-derived-mode blackbox-mode special-mode "Blackbox"
"Major mode for playing blackbox.
To learn how to play blackbox, see the documentation for function `blackbox'.
@@ -124,13 +123,7 @@ The usual mnemonic keys move the cursor around the box.
\\[bb-romp] -- send in a ray from point, or toggle a ball at point
\\[bb-done] -- end game and get score"
- (interactive)
- (kill-all-local-variables)
- (use-local-map blackbox-mode-map)
- (setq truncate-lines t)
- (setq major-mode 'blackbox-mode)
- (setq mode-name "Blackbox")
- (run-mode-hooks 'blackbox-mode-hook))
+ (setq truncate-lines t))
;;;###autoload
(defun blackbox (num)
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 665e98a69b2..4dc4c774550 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -1,6 +1,6 @@
-;;; bubbles.el --- Puzzle game for Emacs -*- coding: utf-8 -*-
+;;; bubbles.el --- Puzzle game for Emacs
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Ulf Jasper <ulf.jasper@web.de>
;; URL: http://ulf.epplejasper.de/
@@ -101,31 +101,31 @@ and a shift mode."
:group 'bubbles)
(defun bubbles-set-game-easy ()
- "Set game theme to 'easy'."
+ "Set game theme to `easy'."
(interactive)
(setq bubbles-game-theme 'easy)
(bubbles))
(defun bubbles-set-game-medium ()
- "Set game theme to 'medium'."
+ "Set game theme to `medium'."
(interactive)
(setq bubbles-game-theme 'medium)
(bubbles))
(defun bubbles-set-game-difficult ()
- "Set game theme to 'difficult'."
+ "Set game theme to `difficult'."
(interactive)
(setq bubbles-game-theme 'difficult)
(bubbles))
(defun bubbles-set-game-hard ()
- "Set game theme to 'hard'."
+ "Set game theme to `hard'."
(interactive)
(setq bubbles-game-theme 'hard)
(bubbles))
(defun bubbles-set-game-userdefined ()
- "Set game theme to 'user-defined'."
+ "Set game theme to `user-defined'."
(interactive)
(setq bubbles-game-theme 'user-defined)
(bubbles))
@@ -211,7 +211,7 @@ the number of colors, see `bubbles-colors'."
Available modes are `shift-default' and `shift-always'."
:type '(radio (const :tag "Default" default)
(const :tag "Shifter" always)
- ;;(const :tag "Mega Shifter" 'mega)
+ ;;(const :tag "Mega Shifter" mega)
)
:group 'bubbles)
@@ -231,7 +231,7 @@ Available modes are `shift-default' and `shift-always'."
(defvar bubbles--score 0
"Current Bubbles score.")
-(defvar bubbles--neighbourhood-score 0
+(defvar bubbles--neighborhood-score 0
"Score of active bubbles neighborhood.")
(defvar bubbles--faces nil
@@ -925,7 +925,7 @@ static char * dot3d_xpm[] = {
(buffer-disable-undo)
(force-mode-line-update)
(redisplay)
- (add-hook 'post-command-hook 'bubbles--mark-neighbourhood t t))
+ (add-hook 'post-command-hook 'bubbles--mark-neighborhood t t))
;;;###autoload
(defun bubbles ()
@@ -1005,20 +1005,17 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(set-buffer-modified-p nil)
(erase-buffer)
(insert " ")
- (add-text-properties
- (point-min) (point) (list 'intangible t 'display
- (cons 'space
- (list :height bubbles--row-offset))))
+ (put-text-property (point-min) (point)
+ 'display
+ (cons 'space (list :height bubbles--row-offset)))
(insert "\n")
(let ((max-char (length (bubbles--colors))))
(dotimes (i (bubbles--grid-height))
(let ((p (point)))
(insert " ")
- (add-text-properties
- p (point) (list 'intangible t
- 'display (cons 'space
- (list :width
- bubbles--col-offset)))))
+ (put-text-property p (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset))))
(dotimes (j (bubbles--grid-width))
(let* ((index (random max-char))
(char (nth index bubbles-chars)))
@@ -1026,10 +1023,9 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(add-text-properties (1- (point)) (point) (list 'index index))))
(insert "\n"))
(insert "\n ")
- (add-text-properties
- (1- (point)) (point) (list 'intangible t 'display
- (cons 'space
- (list :width bubbles--col-offset)))))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset))))
(put-text-property (point-min) (point-max) 'pointer 'arrow))
(bubbles-mode)
(bubbles--reset-score)
@@ -1087,7 +1083,7 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(char-after (point))
nil)))
-(defun bubbles--mark-direct-neighbours (row col char)
+(defun bubbles--mark-direct-neighbors (row col char)
"Mark direct neighbors of bubble at ROW COL with same CHAR."
(save-excursion
(let ((count 0))
@@ -1097,38 +1093,37 @@ Set `bubbles--col-offset' and `bubbles--row-offset'."
(add-text-properties (point) (1+ (point))
'(active t face 'bubbles--highlight-face))
(setq count (+ 1
- (bubbles--mark-direct-neighbours row (1+ col) char)
- (bubbles--mark-direct-neighbours row (1- col) char)
- (bubbles--mark-direct-neighbours (1+ row) col char)
- (bubbles--mark-direct-neighbours (1- row) col char))))
+ (bubbles--mark-direct-neighbors row (1+ col) char)
+ (bubbles--mark-direct-neighbors row (1- col) char)
+ (bubbles--mark-direct-neighbors (1+ row) col char)
+ (bubbles--mark-direct-neighbors (1- row) col char))))
count)))
-(defun bubbles--mark-neighbourhood (&optional pos)
+(defun bubbles--mark-neighborhood (&optional pos)
"Mark neighborhood of point.
Use optional parameter POS instead of point if given."
(when bubbles--playing
(unless pos (setq pos (point)))
- (condition-case err
- (let ((char (char-after pos))
- (inhibit-read-only t)
- (row (bubbles--row (point)))
- (col (bubbles--col (point))))
- (add-text-properties (point-min) (point-max)
- '(face default active nil))
- (let ((count 0))
- (when (and row col (not (eq char (bubbles--empty-char))))
- (setq count (bubbles--mark-direct-neighbours row col char))
- (unless (> count 1)
- (add-text-properties (point-min) (point-max)
- '(face default active nil))
- (setq count 0)))
- (bubbles--update-neighbourhood-score count))
- (put-text-property (point-min) (point-max) 'pointer 'arrow)
- (bubbles--update-faces-or-images)
- (sit-for 0))
- (error (message "Bubbles: Internal error %s" err)))))
+ (with-demoted-errors "Bubbles: Internal error %s"
+ (let ((char (char-after pos))
+ (inhibit-read-only t)
+ (row (bubbles--row (point)))
+ (col (bubbles--col (point))))
+ (add-text-properties (point-min) (point-max)
+ '(face default active nil))
+ (let ((count 0))
+ (when (and row col (not (eq char (bubbles--empty-char))))
+ (setq count (bubbles--mark-direct-neighbors row col char))
+ (unless (> count 1)
+ (add-text-properties (point-min) (point-max)
+ '(face default active nil))
+ (setq count 0)))
+ (bubbles--update-neighborhood-score count))
+ (put-text-property (point-min) (point-max) 'pointer 'arrow)
+ (bubbles--update-faces-or-images)
+ (sit-for 0)))))
-(defun bubbles--neighbourhood-available ()
+(defun bubbles--neighborhood-available ()
"Return t if another valid neighborhood is available."
(catch 'found
(save-excursion
@@ -1154,20 +1149,20 @@ Use optional parameter POS instead of point if given."
(defun bubbles--reset-score ()
"Reset bubbles score."
- (setq bubbles--neighbourhood-score 0
+ (setq bubbles--neighborhood-score 0
bubbles--score 0)
(bubbles--update-score))
(defun bubbles--update-score ()
"Calculate and display new bubbles score."
- (setq bubbles--score (+ bubbles--score bubbles--neighbourhood-score))
+ (setq bubbles--score (+ bubbles--score bubbles--neighborhood-score))
(bubbles--show-scores))
-(defun bubbles--update-neighbourhood-score (size)
+(defun bubbles--update-neighborhood-score (size)
"Calculate and display score of active neighborhood from its SIZE."
(if (> size 1)
- (setq bubbles--neighbourhood-score (expt (- size 1) 2))
- (setq bubbles--neighbourhood-score 0))
+ (setq bubbles--neighborhood-score (expt (- size 1) 2))
+ (setq bubbles--neighborhood-score 0))
(bubbles--show-scores))
(defun bubbles--show-scores ()
@@ -1178,12 +1173,11 @@ Use optional parameter POS instead of point if given."
(let ((inhibit-read-only t)
(pos (point)))
(delete-region (point) (point-max))
- (insert (format "Selected: %4d\n" bubbles--neighbourhood-score))
+ (insert (format "Selected: %4d\n" bubbles--neighborhood-score))
(insert " ")
- (add-text-properties (1- (point)) (point)
- (list 'intangible t 'display
- (cons 'space
- (list :width bubbles--col-offset))))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset)))
(insert (format "Score: %4d" bubbles--score))
(put-text-property pos (point) 'status t))))
@@ -1201,10 +1195,9 @@ Use optional parameter POS instead of point if given."
(goto-char (point-max))
(let* ((inhibit-read-only t))
(insert "\n ")
- (add-text-properties (1- (point)) (point)
- (list 'intangible t 'display
- (cons 'space
- (list :width bubbles--col-offset))))
+ (put-text-property (1- (point)) (point)
+ 'display
+ (cons 'space (list :width bubbles--col-offset)))
(insert "Game Over!"))
;; save score
(gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores"
@@ -1217,10 +1210,10 @@ Use optional parameter POS instead of point if given."
"Remove active bubbles region."
(interactive)
(when (and bubbles--playing
- (> bubbles--neighbourhood-score 0))
+ (> bubbles--neighborhood-score 0))
(setq bubbles--save-data (list bubbles--score (buffer-string)))
(let ((inhibit-read-only t))
- ;; blank out current neighbourhood
+ ;; blank out current neighborhood
(let ((row (bubbles--row (point)))
(col (bubbles--col (point))))
(goto-char (point-max))
@@ -1290,7 +1283,7 @@ Use optional parameter POS instead of point if given."
(bubbles--update-faces-or-images)
(sit-for 0)))
(put-text-property (point-min) (point-max) 'removed nil)
- (unless (bubbles--neighbourhood-available)
+ (unless (bubbles--neighborhood-available)
(bubbles--game-over)))
;; undo
(setq buffer-undo-list '((apply bubbles-undo . nil)))
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index d6b8e482071..d4e553bc7b3 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -1,9 +1,9 @@
;;; cookie1.el --- retrieve random phrases from fortune cookie files
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games, extensions
;; Created: Mon Mar 22 17:06:26 1993
@@ -187,6 +187,7 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie."
(defun cookie-apropos (regexp phrase-file &optional display)
"Return a list of all entries matching REGEXP from PHRASE-FILE.
+Interactively, uses `read-regexp' to read REGEXP.
Interactively, PHRASE-FILE defaults to `cookie-file', unless that
is nil or a prefix argument is used.
If called interactively, or if DISPLAY is non-nil, display a list of matches."
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index c02e36fd307..c2268a9b057 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -1,6 +1,6 @@
;;; decipher.el --- cryptanalyze monoalphabetic substitution ciphers
;;
-;; Copyright (C) 1995-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Christopher J. Madsen <chris_madsen@geocities.com>
;; Keywords: games
@@ -793,7 +793,7 @@ TOTAL is the total number of letters in the ciphertext."
(insert (caar temp-list)
(format "%4d%3d%% "
(cl-cadar temp-list)
- (/ (* 100 (cl-cadar temp-list)) total)))
+ (floor (* 100.0 (cl-cadar temp-list)) total)))
(setq temp-list (nthcdr 4 temp-list)))
(insert ?\n)
(setq freq-list (cdr freq-list)
@@ -957,7 +957,7 @@ Creates the statistics buffer if it doesn't exist."
": 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 *"
(format "%4d %4d %3d%%\n "
(cl-third entry) (cl-second entry)
- (/ (* 100 (cl-second entry)) total-chars))
+ (floor (* 100.0 (cl-second entry)) total-chars))
(decipher--digram-counts (aref decipher--after i)) ?\n))))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 376a8c357b2..c0180a2e34e 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,8 +1,8 @@
;;; dissociate.el --- scramble text amusingly for Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; This file is part of GNU Emacs.
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index 4c50461011c..3c9d87fa81e 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -1,9 +1,9 @@
;;; doctor.el --- psychological help for frustrated users
-;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2013 Free Software
+;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; This file is part of GNU Emacs.
@@ -989,7 +989,7 @@ Otherwise call the Doctor to parse preceding sentence."
Put dialogue in buffer."
(let (a
(prompt (concat (doctor-make-string x)
- " what \? "))
+ " what ? "))
retval)
(while (not retval)
(while (not a)
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 9d48d36bb30..ba137f54d8c 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -1,10 +1,10 @@
;;; dunnet.el --- text adventure for Emacs
-;; Copyright (C) 1992-1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Ron Schnell <ronnie@driver-aces.com>
;; Created: 25 Jul 1992
-;; Version: 2.01
+;; Version: 2.02
;; Keywords: games
;; This file is part of GNU Emacs.
@@ -100,7 +100,8 @@
(defun dun-describe-room (room)
(if (and (not (member (abs room) dun-light-rooms))
- (not (member obj-lamp dun-inventory)))
+ (not (member obj-lamp dun-inventory))
+ (not (member obj-lamp (nth dun-current-room dun-room-objects))))
(dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.")
(dun-mprincl (cadr (nth (abs room) dun-rooms)))
(if (and (and (or (member room dun-visited)
@@ -615,7 +616,8 @@ just try dropping it.")
(defun dun-move (dir)
(if (and (not (member dun-current-room dun-light-rooms))
- (not (member obj-lamp dun-inventory)))
+ (not (member obj-lamp dun-inventory))
+ (not (member obj-lamp (nth dun-current-room dun-room-objects))))
(progn
(dun-mprinc
"You trip over a grue and fall into a pit and break every bone in your
@@ -892,15 +894,15 @@ to swim.")
(dun-mprincl " endgame points out of a possible 110.")
(if (= (dun-endgame-score) 110)
(dun-mprincl
-"\n\nCongratulations. You have won. The wizard password is 'moby'"))))
+"\n\nCongratulations. You have won. The wizard password is ‘moby’"))))
(defun dun-help (args)
(dun-mprincl
-"Welcome to dunnet (2.01), by Ron Schnell (ronnie@driver-aces.com).
+"Welcome to dunnet (2.02), 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
- open it. You may just use 'in' or walk in the direction of the door.
+ open it. You may just use ‘in’ or walk in the direction of the door.
- If you have a lamp, it is always lit.
@@ -914,8 +916,8 @@ or more clues in here):
If this happens, your score will decrease, and in many cases you can never
get credit for it again.
-- You can save your game with the 'save' command, and use restore it
- with the 'restore' command.
+- You can save your game with the ‘save’ command, and use restore it
+ with the ‘restore’ command.
- There are no limits on lengths of object names.
@@ -1051,7 +1053,7 @@ for a moment, then straighten yourself up.
(if (not dun-endgame-questions)
(progn
(dun-mprincl "Your question is:")
- (dun-mprincl "No more questions, just do 'answer foo'.")
+ (dun-mprincl "No more questions, just do ‘answer foo’.")
(setq dun-correct-answer '("foo")))
(let (which i newques)
(setq i 0)
@@ -1385,8 +1387,8 @@ for a moment, then straighten yourself up.
(setq dungeon-mode 'dungeon)
(setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo)
(exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd)
- (rlogin . dun-rlogin) (uncompress . dun-uncompress)
- (cat . dun-cat)))
+ (rlogin . dun-rlogin) (ssh . dun-rlogin)
+ (uncompress . dun-uncompress) (cat . dun-cat)))
(setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type)
(exit . dun-dos-exit) (command . dun-dos-spawn)
@@ -1462,8 +1464,8 @@ kept. The exit is to the west."
"You are in a computer room. It seems like most of the equipment has
been removed. There is a VAX 11/780 in front of you, however, with
one of the cabinets wide open. A sign on the front of the machine
-says: This VAX is named 'pokey'. To type on the console, use the
-'type' command. The exit is to the east."
+says: This VAX is named ‘pokey’. To type on the console, use the
+‘type’ command. The exit is to the east."
"Computer room"
)
(
@@ -1473,7 +1475,7 @@ to the west, and a door leads to the south."
)
(
"You are in a round, stone room with a door to the east. There
-is a sign on the wall that reads: 'receiving room'."
+is a sign on the wall that reads: ‘receiving room’."
"Receiving room"
)
(
@@ -1550,7 +1552,7 @@ northeast through the brush you can see the bear hangout."
(
"The entrance to a cave is to the south. To the north, a road leads
towards a deep lake. On the ground nearby there is a chute, with a sign
-that says 'put treasures here for points'."
+that says ‘put treasures here for points’."
"Cave Entrance" ;28
)
(
@@ -1829,13 +1831,13 @@ starvation. Doors lead out to the south and east."
)
(
"You are in some sort of maintenance room for the museum. There is a
-switch on the wall labeled 'BL'. There are doors to the west and north."
+switch on the wall labeled ‘BL’. There are doors to the west and north."
"Maintenance room" ;87
)
(
"You are in a classroom where school children were taught about natural
-history. On the blackboard is written, 'No children allowed downstairs.'
-There is a door to the east with an 'exit' sign on it. There is another
+history. On the blackboard is written, ‘No children allowed downstairs.’
+There is a door to the east with an ‘exit’ sign on it. There is another
door to the west."
"Classroom" ;88
)
@@ -1869,7 +1871,7 @@ a room to the northeast."
(
"You are in another computer room. There is a computer in here larger
than you have ever seen. It has no manufacturers name on it, but it
-does have a sign that says: This machine's name is 'endgame'. The
+does have a sign that says: This machine's name is ‘endgame’. The
exit is to the southwest. There is no console here on which you could
type."
"Endgame computer room" ;95
@@ -1880,7 +1882,7 @@ type."
)
(
"You have reached a question room. You must answer a question correctly in
-order to get by. Use the 'answer' command to answer the question."
+order to get by. Use the ‘answer’ command to answer the question."
"Question room 1" ;97
)
(
@@ -1911,7 +1913,7 @@ a hallway leads to the south."
(
"You have reached a dead end. There is a PC on the floor here. Above
it is a sign that reads:
- Type the 'reset' command to type on the PC.
+ Type the ‘reset’ command to type on the PC.
A hole leads north."
"PC area" ;104
)
@@ -2355,8 +2357,8 @@ nil))
2 Megabytes of RAM onboard."
"It looks like some kind of meat. Smells pretty bad."
nil
-"The paper says: Don't forget to type 'help' for help. Also, remember
-this word: 'worms'"
+"The paper says: Don't forget to type ‘help’ for help. Also, remember
+this word: ‘worms’"
"The statuette is of the likeness of Richard Stallman, the author of the
famous EMACS editor. You notice that he is not wearing any shoes."
nil
@@ -2412,10 +2414,10 @@ flush handle is so clean that you can see your reflection in it."
nil
nil
"The box has a slit in the top of it, and on it, in sloppy handwriting, is
-written: 'For key upgrade, put key in here.'"
+written: ‘For key upgrade, put key in here.’"
nil
-"It says 'express mail' on it."
-"It is a 35 passenger bus with the company name 'mobytours' on it."
+"It says ‘express mail’ on it."
+"It is a 35 passenger bus with the company name ‘mobytours’ on it."
"It is a large metal gate that is too big to climb over."
"It is a HIGH cliff."
"Unfortunately you do not know enough about dinosaurs to tell very much about
@@ -2447,14 +2449,14 @@ nil
(setq dun-endgame-questions '(
(
-"What is your password on the machine called 'pokey'?" "robert")
+"What is your password on the machine called ‘pokey’?" "robert")
(
"What password did you use during anonymous ftp to gamma?" "foo")
(
"Excluding the endgame, how many places are there where you can put
treasures for points?" "4" "four")
(
-"What is your login name on the 'endgame' machine?" "toukmond"
+"What is your login name on the ‘endgame’ machine?" "toukmond"
)
(
"What is the nearest whole dollar to the price of the shovel?" "20" "twenty")
@@ -2537,25 +2539,31 @@ treasures for points?" "4" "four")
(dun-mprincl "Incorrect.")))
(let (varname epoint afterq i value)
- (setq varname (substring line 0 esign))
- (if (not (setq epoint (string-match ")" line)))
- (if (string= (substring line (1+ esign) (+ esign 2))
- "\"")
- (progn
- (setq afterq (substring line (+ esign 2)))
- (setq epoint (+
- (string-match "\"" afterq)
- (+ esign 3))))
-
- (if (not (setq epoint (string-match " " line)))
- (setq epoint (length line))))
- (setq epoint (1+ epoint))
- (while (and
- (not (= epoint (length line)))
- (setq i (string-match ")" (substring line epoint))))
- (setq epoint (+ epoint i 1))))
- (setq value (substring line (1+ esign) epoint))
- (dun-eval varname value))))
+ (setq varname (replace-regexp-in-string " " "" (substring line 0 esign)))
+
+ (if (or (= (length varname) 0) (< (- (length line) esign) 2))
+ (progn
+ (dun-mprinc line)
+ (dun-mprincl " : not found."))
+
+ (if (not (setq epoint (string-match ")" line)))
+ (if (string= (substring line (1+ esign) (+ esign 2))
+ "\"")
+ (progn
+ (setq afterq (substring line (+ esign 2)))
+ (setq epoint (+
+ (string-match "\"" afterq)
+ (+ esign 3))))
+
+ (if (not (setq epoint (string-match " " line)))
+ (setq epoint (length line))))
+ (setq epoint (1+ epoint))
+ (while (and
+ (not (= epoint (length line)))
+ (setq i (string-match ")" (substring line epoint))))
+ (setq epoint (+ epoint i 1))))
+ (setq value (substring line (1+ esign) epoint))
+ (dun-eval varname value)))))
(defun dun-eval (varname value)
(let (eval-error)
@@ -2739,16 +2747,20 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(if dun-batch-mode
(dun-mprincl "Login failed.")
(dun-mprincl "\nLogin failed."))
- (if dun-batch-mode
- (dun-mprincl
- "Guest login okay, user access restrictions apply.")
- (dun-mprincl
- "\nGuest login okay, user access restrictions apply."))
- (dun-ftp-commands)
- (setq newlist
+ (if (= (length ident) 0)
+ (if dun-batch-mode
+ (dun-mprincl "Password is required.")
+ (dun-mprincl "\nPassword is required."))
+ (if dun-batch-mode
+ (dun-mprincl
+ "Guest login okay, user access restrictions apply.")
+ (dun-mprincl
+ "\nGuest login okay, user access restrictions apply."))
+ (dun-ftp-commands)
+ (setq newlist
'("What password did you use during anonymous ftp to gamma?"))
- (setq newlist (append newlist (list ident)))
- (rplaca (nthcdr 1 dun-endgame-questions) newlist)))))))))
+ (setq newlist (append newlist (list ident)))
+ (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))))
(defun dun-ftp-commands ()
(setq dun-exitf nil)
@@ -3087,7 +3099,7 @@ File not found")))
(defun dun-dos-boot-msg ()
(sleep-for 3)
(dun-mprinc "Current time is ")
- (dun-mprincl (substring (current-time-string) 12 20))
+ (dun-mprincl (format-time-string "%H:%M:%S"))
(dun-mprinc "Enter new time: ")
(dun-read-line)
(if (not dun-batch-mode)
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index cb58c0d0af0..965f6a99b9c 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -1,6 +1,6 @@
;;; fortune.el --- use fortune to create signatures
-;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Holger Schauer <Holger.Schauer@gmx.de>
;; Keywords: games utils mail
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index b6fd064ca84..df06d5a6ab2 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -1,6 +1,6 @@
;;; gamegrid.el --- library for implementing grid-based games on Emacs
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 1.02
@@ -462,22 +462,22 @@ FILE is created there."
;; `gamegrid-add-score' was supposed to be used in the past and
;; is covered here for backward-compatibility.
;;
-;; 2. The helper program "update-game-score" is setuid and the
-;; file FILE does already exist in a system wide shared game
-;; directory. This should be the normal case on POSIX systems,
-;; if the game was installed system wide. Use
+;; 2. The helper program "update-game-score" is setgid or setuid
+;; and the file FILE does already exist in a system wide shared
+;; game directory. This should be the normal case on POSIX
+;; systems, if the game was installed system wide. Use
;; "update-game-score" to add the score to the file in the
;; shared game directory.
;;
-;; 3. "update-game-score" is setuid, but the file FILE does *not*
-;; exist in the system wide shared game directory. Use
+;; 3. "update-game-score" is setgid/setuid, but the file FILE does
+;; *not* exist in the system wide shared game directory. Use
;; `gamegrid-add-score-insecure' to create--if necessary--and
;; update FILE. This is for the case that a user has installed
;; a game on her own.
;;
-;; 4. "update-game-score" is not setuid. Use it to create/update
-;; FILE in the user's home directory. There is presumably no
-;; shared game directory.
+;; 4. "update-game-score" is not setgid/setuid. Use it to
+;; create/update FILE in the user's home directory. There is
+;; presumably no shared game directory.
(defvar gamegrid-shared-game-dir)
@@ -486,13 +486,13 @@ FILE is created there."
(not (zerop (logand (file-modes
(expand-file-name "update-game-score"
exec-directory))
- #o4000)))))
+ #o6000)))))
(cond ((file-name-absolute-p file)
(gamegrid-add-score-insecure file score))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file shared-game-score-directory)))
- ;; Use the setuid "update-game-score" program to update a
- ;; system-wide score file.
+ ;; Use the setgid (or setuid) "update-game-score" program
+ ;; to update a system-wide score file.
(gamegrid-add-score-with-update-game-score-1 file
(expand-file-name file shared-game-score-directory) score))
;; Else: Add the score to a score file in the user's home
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 3daf9d5f784..a07a24d5195 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -1,6 +1,6 @@
;;; gametree.el --- manage game analysis trees in Emacs
-;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Ian T Zimmerman <itz@rahul.net>
;; Created: Wed Dec 10 07:41:46 PST 1997
@@ -248,8 +248,8 @@ This value is simply the outline heading level of the current line."
;;;; outline layout
(defsubst gametree-show-children-and-entry ()
- (show-children)
- (show-entry))
+ (outline-show-children)
+ (outline-show-entry))
(defun gametree-entry-shown-p ()
(save-excursion
@@ -307,7 +307,7 @@ This value is simply the outline heading level of the current line."
(if (not first-time)
(outline-next-visible-heading 1))
(setq first-time nil)
- (hide-subtree)
+ (outline-hide-subtree)
(if (nth 0 layout)
(funcall (nth 0 layout)))
(if (not (and (nth 1 layout) (listp (nth 1 layout))))
@@ -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))
@@ -393,29 +393,29 @@ depth AT-DEPTH or smaller is found."
(outline-up-heading 1)))
(beginning-of-line 1)
(let ((parent-depth (gametree-current-branch-depth)))
- (show-entry)
+ (outline-show-entry)
(condition-case nil
(outline-next-visible-heading 1)
(error
(goto-char (point-max))
(if (not (bolp)) (insert "\n"))))
- (let ((starting-plys
+ (let ((starting-plies
(if (> (gametree-current-branch-depth) parent-depth)
(gametree-current-branch-ply)
(save-excursion (forward-line -1)
(gametree-current-branch-ply)))))
(goto-char (1- (point)))
(insert "\n")
- (insert (format (if (= 0 (mod starting-plys 2))
+ (insert (format (if (= 0 (mod starting-plies 2))
gametree-full-ply-format
gametree-half-ply-format)
- (/ starting-plys 2))))))
+ (/ starting-plies 2))))))
(defun gametree-break-line-here (&optional at-move)
"Split the variation node at the point position.
This command works whether the current variation node is a leaf, or is
already branching at its end. The new node is created at a level that
-reflects the number of game plys between the beginning of the current
+reflects the number of game plies between the beginning of the current
variation and the breaking point.
With a numerical argument AT-MOVE, split the variation before
@@ -436,7 +436,7 @@ only work of Black's moves are explicitly numbered, for instance
(goto-char (match-beginning 0))))
(gametree-transpose-following-leaves)
(let* ((pt (point-marker))
- (plys (gametree-current-branch-ply))
+ (plies (gametree-current-branch-ply))
(depth (gametree-current-branch-depth))
(old-depth depth))
(if (= depth 0)
@@ -451,7 +451,7 @@ only work of Black's moves are explicitly numbered, for instance
(if (zerop old-branch-ply)
(1+ (gametree-current-branch-depth))
(+ (gametree-current-branch-depth)
- (- plys old-branch-ply))))))
+ (- plies old-branch-ply))))))
(save-excursion
(beginning-of-line 1)
(funcall gametree-make-heading-function depth)
@@ -471,7 +471,7 @@ only work of Black's moves are explicitly numbered, for instance
(insert "\n")
(if (not (= 0 old-depth))
(funcall gametree-make-heading-function
- (+ depth (- (gametree-current-branch-ply) plys))))
+ (+ depth (- (gametree-current-branch-ply) plies))))
(gametree-prettify-heading))))
(defun gametree-merge-line ()
@@ -531,8 +531,10 @@ Subnodes which have been manually scored are honored."
(defun gametree-layout-to-register (register)
"Store current tree layout in register REGISTER.
Use \\[gametree-apply-register-layout] to restore that configuration.
-Argument is a character, naming the register."
- (interactive "cLayout to register: ")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Layout to register: ")))
(save-excursion
(goto-char (point-min))
(set-register register
@@ -540,8 +542,13 @@ Argument is a character, naming the register."
(defun gametree-apply-register-layout (char)
"Return to a tree layout stored in a register.
-Argument is a character, naming the register."
- (interactive "*cApply layout from register: ")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive
+ (progn
+ (barf-if-buffer-read-only)
+ (list (register-read-with-preview "Apply layout from register: "))))
(save-excursion
(goto-char (point-min))
(gametree-apply-layout (get-register char) 0 t)))
@@ -583,31 +590,30 @@ shogi, etc.) players, it is a slightly modified version of Outline mode.
(add-hook 'write-contents-hooks 'gametree-save-and-hack-layout))
;;;; Goodies for mousing users
-(and (fboundp 'track-mouse)
- (defun gametree-mouse-break-line-here (event)
- (interactive "e")
- (mouse-set-point event)
- (gametree-break-line-here))
- (defun gametree-mouse-show-children-and-entry (event)
- (interactive "e")
- (mouse-set-point event)
- (gametree-show-children-and-entry))
- (defun gametree-mouse-show-subtree (event)
- (interactive "e")
- (mouse-set-point event)
- (show-subtree))
- (defun gametree-mouse-hide-subtree (event)
- (interactive "e")
- (mouse-set-point event)
- (hide-subtree))
- (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2]
- 'gametree-mouse-break-line-here)
- (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1]
- 'gametree-mouse-show-children-and-entry)
- (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2]
- 'gametree-mouse-show-subtree)
- (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3]
- 'gametree-mouse-hide-subtree))
+(defun gametree-mouse-break-line-here (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (gametree-break-line-here))
+(defun gametree-mouse-show-children-and-entry (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (gametree-show-children-and-entry))
+(defun gametree-mouse-show-subtree (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (outline-show-subtree))
+(defun gametree-mouse-hide-subtree (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (outline-hide-subtree))
+(define-key gametree-mode-map [M-down-mouse-2 M-mouse-2]
+ 'gametree-mouse-break-line-here)
+(define-key gametree-mode-map [S-down-mouse-1 S-mouse-1]
+ 'gametree-mouse-show-children-and-entry)
+(define-key gametree-mode-map [S-down-mouse-2 S-mouse-2]
+ 'gametree-mouse-show-subtree)
+(define-key gametree-mode-map [S-down-mouse-3 S-mouse-3]
+ 'gametree-mouse-hide-subtree)
(provide 'gametree)
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 609585c9522..d2953b69895 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,10 +1,10 @@
-;;; gomoku.el --- Gomoku game between you and Emacs
+;;; gomoku.el --- Gomoku game between you and Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1994, 1996, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1996, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: games
@@ -176,14 +176,9 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
"Font lock rules for Gomoku.")
-(put 'gomoku-mode 'front-sticky
- (put 'gomoku-mode 'rear-nonsticky '(intangible)))
-(put 'gomoku-mode 'intangible 1)
;; This one is for when they set view-read-only to t: Gomoku cannot
;; allow View Mode to be activated in its buffer.
-(put 'gomoku-mode 'mode-class 'special)
-
-(define-derived-mode gomoku-mode nil "Gomoku"
+(define-derived-mode gomoku-mode special-mode "Gomoku"
"Major mode for playing Gomoku against Emacs.
You and Emacs play in turn by marking a free square. You mark it with X
and Emacs marks it with O. The winner is the first to get five contiguous
@@ -196,7 +191,8 @@ Other useful commands:\n
(gomoku-display-statistics)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(gomoku-font-lock-keywords t)
- buffer-read-only t))
+ buffer-read-only t)
+ (add-hook 'post-command-hook #'gomoku--intangible nil t))
;;;
;;; THE BOARD.
@@ -836,8 +832,7 @@ Use \\[describe-mode] for more info."
(min (max (/ (+ (- (cdr click)
gomoku-y-offset
1)
- (let ((inhibit-point-motion-hooks t))
- (count-lines 1 (window-start)))
+ (count-lines (point-min) (window-start))
gomoku-square-height
(% gomoku-square-height 2)
(/ gomoku-square-height 2))
@@ -961,16 +956,15 @@ If the game is finished, this command requests for another game."
(defun gomoku-point-y ()
"Return the board row where point is."
- (let ((inhibit-point-motion-hooks t))
- (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1))
- gomoku-square-height))))
+ (1+ (/ (- (count-lines (point-min) (point))
+ gomoku-y-offset (if (bolp) 0 1))
+ gomoku-square-height)))
(defun gomoku-point-square ()
"Return the index of the square point is on."
- (let ((inhibit-point-motion-hooks t))
- (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
- gomoku-square-width))
- (gomoku-point-y))))
+ (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
+ gomoku-square-width))
+ (gomoku-point-y)))
(defun gomoku-goto-square (index)
"Move point to square number INDEX."
@@ -978,20 +972,18 @@ If the game is finished, this command requests for another game."
(defun gomoku-goto-xy (x y)
"Move point to square at X, Y coords."
- (let ((inhibit-point-motion-hooks t))
- (goto-char (point-min))
- (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y)))))
+ (goto-char (point-min))
+ (forward-line (+ gomoku-y-offset (* gomoku-square-height (1- y))))
(move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x)))))
(defun gomoku-plot-square (square value)
- "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
+ "Draw `X', `O' or `.' on SQUARE depending on VALUE, leave point there."
(or (= value 1)
(gomoku-goto-square square))
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
- (insert-and-inherit (cond ((= value 1) ?X)
- ((= value 6) ?O)
- (?.)))
+ (let ((inhibit-read-only t))
+ (insert (cond ((= value 1) ?X)
+ ((= value 6) ?O)
+ (?.)))
(and (zerop value)
(add-text-properties
(1- (point)) (point)
@@ -1004,8 +996,7 @@ If the game is finished, this command requests for another game."
"Display an N by M Gomoku board."
(buffer-disable-undo (current-buffer))
(let ((inhibit-read-only t)
- (point 1) opoint
- (intangible t)
+ (point (point-min)) opoint
(i m) j x)
;; Try to minimize number of chars (because of text properties)
(setq tab-width
@@ -1014,17 +1005,15 @@ If the game is finished, this command requests for another game."
(max (/ (+ (% gomoku-x-offset gomoku-square-width)
gomoku-square-width 1) 2) 2)))
(erase-buffer)
- (newline gomoku-y-offset)
+ (insert-char ?\n gomoku-y-offset)
(while (progn
(setq j n
x (- gomoku-x-offset gomoku-square-width))
(while (>= (setq j (1- j)) 0)
- (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
- (current-column))
- tab-width))
- (insert-char ? (- x (current-column)))
- (if (setq intangible (not intangible))
- (put-text-property point (point) 'intangible 2))
+ (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
+ (current-column))
+ tab-width))
+ (insert-char ?\s (- x (current-column)))
(and (zerop j)
(= i (- m 2))
(progn
@@ -1042,16 +1031,9 @@ If the game is finished, this command requests for another game."
(if (= i (1- m))
(setq opoint point))
(insert-char ?\n gomoku-square-height))
- (or (eq (char-after 1) ?.)
- (put-text-property 1 2 'point-entered
- (lambda (_x _y) (if (bobp) (forward-char)))))
- (or intangible
- (put-text-property point (point) 'intangible 2))
- (put-text-property point (point) 'point-entered
- (lambda (_x _y) (if (eobp) (backward-char))))
- (put-text-property (point-min) (point) 'category 'gomoku-mode))
+ (insert-char ?\n))
(gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
- (sit-for 0)) ; Display NOW
+ (sit-for 0)) ; Display NOW
(defun gomoku-display-statistics ()
"Obnoxiously display some statistics about previous games in mode line."
@@ -1114,8 +1096,7 @@ If the game is finished, this command requests for another game."
"Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
(save-excursion ; Not moving point from last square
(let ((depl (gomoku-xy-to-index dx dy))
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (inhibit-read-only t))
;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
(while (/= square1 square2)
(gomoku-goto-square square1)
@@ -1134,36 +1115,57 @@ If the game is finished, this command requests for another game."
(setq n (1+ n))
(forward-line 1)
(indent-to column)
- (insert-and-inherit ?|))))
+ (insert ?|))))
((= dx -1) ; 1st Diagonal
(indent-to (prog1 (- (current-column) (/ gomoku-square-width 2))
(forward-line (/ gomoku-square-height 2))))
- (insert-and-inherit ?/))
+ (insert ?/))
(t ; 2nd Diagonal
(indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2))
(forward-line (/ gomoku-square-height 2))))
- (insert-and-inherit ?\\))))))
+ (insert ?\\))))))
(sit-for 0)) ; Display NOW
;;;
;;; CURSOR MOTION.
;;;
+
+(defvar-local gomoku--last-pos 0)
+
+(defconst gomoku--intangible-chars "- \t\n|/\\\\")
+
+(defun gomoku--intangible ()
+ (when (or (eobp)
+ (save-excursion
+ (not (zerop (skip-chars-forward gomoku--intangible-chars)))))
+ (if (<= gomoku--last-pos (point)) ;Moving forward.
+ (progn
+ (skip-chars-forward gomoku--intangible-chars)
+ (when (eobp)
+ (skip-chars-backward gomoku--intangible-chars)
+ (forward-char -1)))
+ (skip-chars-backward gomoku--intangible-chars)
+ (if (bobp)
+ (skip-chars-forward gomoku--intangible-chars)
+ (forward-char -1))))
+ (setq gomoku--last-pos (point)))
+
;; 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."
(interactive)
- (if (< (gomoku-point-y) gomoku-board-height)
- (let ((column (current-column)))
- (forward-line gomoku-square-height)
- (move-to-column column))))
+ (when (< (gomoku-point-y) gomoku-board-height)
+ (let ((column (current-column)))
+ (forward-line gomoku-square-height)
+ (move-to-column column))))
(defun gomoku-move-up ()
"Move point up one row on the Gomoku board."
(interactive)
- (if (> (gomoku-point-y) 1)
- (let ((column (current-column)))
- (forward-line (- 1 gomoku-square-height))
- (move-to-column column))))
+ (when (> (gomoku-point-y) 1)
+ (let ((column (current-column)))
+ (forward-line (- gomoku-square-height))
+ (move-to-column column))))
(defun gomoku-move-ne ()
"Move point North East on the Gomoku board."
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 63b09895e85..30e8357e86a 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -1,6 +1,6 @@
-;;; handwrite.el --- turns your emacs buffer into a handwritten document -*- coding: utf-8; -*-
+;;; handwrite.el --- turns your emacs buffer into a handwritten document
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Danny Roozendaal (was: <danny@tvs.kun.nl>)
;; Created: October 21 1996
@@ -244,7 +244,7 @@ Variables: `handwrite-linespace' (default 12)
(insert "showpage exec Hwsave restore\n\n")
(insert "%%Pages " (number-to-string ipage) " 0\n")
(insert "%%EOF\n")
- ;;To avoid cumbersome code we simply ignore pagefeeds
+ ;;To avoid cumbersome code we simply ignore formfeeds
(goto-char textp)
(while (search-forward "\f" nil t)
(replace-match "" nil t) )
@@ -279,7 +279,7 @@ Variables: `handwrite-linespace' (default 12)
(handwrite-set-pagenumber-on)))
(defun handwrite-10pt ()
- "Specify 10-point output for `handwrite.
+ "Specify 10-point output for `handwrite'.
This sets `handwrite-fontsize' to 10 and finds correct
values for `handwrite-linespace' and `handwrite-numlines'."
(interactive)
@@ -290,7 +290,7 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(defun handwrite-11pt ()
- "Specify 11-point output for `handwrite.
+ "Specify 11-point output for `handwrite'.
This sets `handwrite-fontsize' to 11 and finds correct
values for `handwrite-linespace' and `handwrite-numlines'."
(interactive)
@@ -300,7 +300,7 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(message "Handwrite output size set to 11 points"))
(defun handwrite-12pt ()
- "Specify 12-point output for `handwrite.
+ "Specify 12-point output for `handwrite'.
This sets `handwrite-fontsize' to 12 and finds correct
values for `handwrite-linespace' and `handwrite-numlines'."
(interactive)
@@ -310,7 +310,7 @@ values for `handwrite-linespace' and `handwrite-numlines'."
(message "Handwrite output size set to 12 points"))
(defun handwrite-13pt ()
- "Specify 13-point output for `handwrite.
+ "Specify 13-point output for `handwrite'.
This sets `handwrite-fontsize' to 13 and finds correct
values for `handwrite-linespace' and `handwrite-numlines'."
(interactive)
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
index 9e8b6ff97eb..635e4a95bc3 100644
--- a/lisp/play/hanoi.el
+++ b/lisp/play/hanoi.el
@@ -1,7 +1,7 @@
;;; hanoi.el --- towers of hanoi in Emacs
;; Author: Damon Anton Permezel
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
; Author (a) 1985, Damon Anton Permezel
@@ -277,7 +277,7 @@ BITS must be of length nrings. Start at START-TIME."
;; Disable display of line and column numbers, for speed.
(line-number-mode nil) (column-number-mode nil))
;; do it!
- (hanoi-n bits rings (car poles) (cadr poles) (cl-caddr poles)
+ (hanoi-n bits rings (nth 0 poles) (nth 1 poles) (nth 2 poles)
start-time))
(message "Done"))
(setq buffer-read-only t)
diff --git a/lisp/play/life.el b/lisp/play/life.el
index a73f3a58e66..5bf8a9b57b7 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -1,9 +1,9 @@
;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
-;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2015 Free Software Foundation, Inc.
;; Author: Kyle Jones <kyleuunet.uu.net>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; This file is part of GNU Emacs.
@@ -122,33 +122,32 @@ generations (this defaults to 1)."
(life-setup)
(catch 'life-exit
(while t
- (let ((inhibit-quit t))
+ (let ((inhibit-quit t)
+ (inhibit-read-only t))
(life-display-generation sleeptime)
(life-grim-reaper)
(life-expand-plane-if-needed)
(life-increment-generation)))))
-(defalias 'life-mode 'life)
-(put 'life-mode 'mode-class 'special)
+(define-derived-mode life-mode special-mode "Life"
+ "Major mode for the buffer of `life'."
+ (setq-local case-fold-search nil)
+ (setq-local truncate-lines t)
+ (setq-local show-trailing-whitespace nil)
+ (setq-local life-current-generation 0)
+ (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 life-window-start 1)
+ (buffer-disable-undo))
(defun life-setup ()
- (let (n)
- (switch-to-buffer (get-buffer-create "*Life*") t)
- (erase-buffer)
- (kill-all-local-variables)
- (setq case-fold-search nil
- mode-name "Life"
- major-mode 'life-mode
- truncate-lines t
- show-trailing-whitespace nil
- life-current-generation 0
- life-generation-string "0"
- mode-line-buffer-identification '("Life: generation "
- life-generation-string)
- fill-column (1- (window-width))
- life-window-start 1)
- (buffer-disable-undo (current-buffer))
- ;; stuff in the random pattern
+ (switch-to-buffer (get-buffer-create "*Life*") t)
+ (erase-buffer)
+ (life-mode)
+ ;; stuff in the random pattern
+ (let ((inhibit-read-only t))
(life-insert-random-pattern)
;; make sure (life-life-char) is used throughout
(goto-char (point-min))
@@ -156,18 +155,18 @@ generations (this defaults to 1)."
(replace-match (life-life-string) t t))
;; center the pattern horizontally
(goto-char (point-min))
- (setq n (/ (- fill-column (line-end-position)) 2))
- (while (not (eobp))
- (indent-to n)
- (forward-line))
+ (let ((n (/ (- fill-column (line-end-position)) 2)))
+ (while (not (eobp))
+ (indent-to n)
+ (forward-line)))
;; center the pattern vertically
- (setq n (/ (- (1- (window-height))
- (count-lines (point-min) (point-max)))
- 2))
- (goto-char (point-min))
- (newline n)
- (goto-char (point-max))
- (newline n)
+ (let ((n (/ (- (1- (window-height))
+ (count-lines (point-min) (point-max)))
+ 2)))
+ (goto-char (point-min))
+ (newline n)
+ (goto-char (point-max))
+ (newline n))
;; pad lines out to fill-column
(goto-char (point-min))
(while (not (eobp))
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index 54dfd1c4ea3..e35147dceb4 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -1,6 +1,6 @@
-;;; morse.el --- convert text to morse code and back -*- coding: utf-8 -*-
+;;; morse.el --- convert text to morse code and back
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
;; Keywords: games
@@ -144,9 +144,9 @@
(")" . "Close")
("@" . "At"))
"NATO phonetic alphabet.
-See ''International Code of Signals'' (INTERCO), United States
+See “International Code of Signals” (INTERCO), United States
Edition, 1969 Edition (Revised 2003) available from National
-Geospatial-Intelligence Agency at http://www.nga.mil/")
+Geospatial-Intelligence Agency at URL `http://www.nga.mil/'")
;;;###autoload
(defun morse-region (beg end)
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index e4e627a5293..9b90e2c0dac 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -1,6 +1,6 @@
;;; mpuz.el --- multiplication puzzle for GNU Emacs
-;; Copyright (C) 1990, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 2001-2015 Free Software Foundation, Inc.
;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
;; Overhauled: Daniel Pfeiffer <occitan@esperanto.org>
@@ -94,7 +94,9 @@ The value t means never ding, and `error' means only ding on wrong input."
map)
"Local keymap to use in Mult Puzzle.")
-(defun mpuz-mode ()
+
+
+(define-derived-mode mpuz-mode fundamental-mode "Mult Puzzle"
"Multiplication puzzle mode.
You have to guess which letters stand for which digits in the
@@ -106,13 +108,7 @@ then the digit. Thus, to guess that A=3, type `A 3'.
To leave the game to do other editing work, just switch buffers.
Then you may resume the game with M-x mpuz.
You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'mpuz-mode
- mode-name "Mult Puzzle"
- tab-width 30)
- (use-local-map mpuz-mode-map)
- (run-mode-hooks 'mpuz-mode-hook))
+ (setq tab-width 30))
;; Some variables for statistics
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index 65293485982..54d8d537f47 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -1,6 +1,6 @@
;;; pong.el --- classical implementation of pong
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Benjamin Drieu <bdrieu@april.org>
;; Keywords: games
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index 85acfb116d2..d42ba44b630 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -1,6 +1,6 @@
;;; snake.el --- implementation of Snake for Emacs
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Created: 1997-09-10
@@ -353,21 +353,13 @@ Argument SNAKE-BUFFER is the name of the buffer."
(put 'snake-mode 'mode-class 'special)
-(defun snake-mode ()
- "A mode for playing Snake.
-
-Snake mode keybindings:
- \\{snake-mode-map}
-"
- (kill-all-local-variables)
+(define-derived-mode snake-mode special-mode "Snake"
+ "A mode for playing Snake."
(add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)
(use-local-map snake-null-map)
- (setq major-mode 'snake-mode)
- (setq mode-name "Snake")
-
(unless (featurep 'emacs)
(setq mode-popup-menu
'("Snake Commands"
@@ -382,9 +374,7 @@ Snake mode keybindings:
(setq gamegrid-use-glyphs snake-use-glyphs-flag)
(setq gamegrid-use-color snake-use-color-flag)
- (gamegrid-init (snake-display-options))
-
- (run-mode-hooks 'snake-mode-hook))
+ (gamegrid-init (snake-display-options)))
;;;###autoload
(defun snake ()
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index 86d9408118b..4eda2ebb9a7 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -1,6 +1,6 @@
;;; solitaire.el --- game of solitaire in Emacs Lisp
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Jan Schormann <Jan.Schormann@rechen-gilde.de>
;; Created: Fri afternoon, Jun 3, 1994
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index 08c31d3878b..02976c05aa4 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -1,8 +1,8 @@
;;; spook.el --- spook phrase utility for overloading the NSA line eater
-;; Copyright (C) 1988, 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1993, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;; Created: May 1987
@@ -69,10 +69,6 @@
"Checking authorization..."
"Checking authorization...Approved"))
-;; Note: the implementation that used to take up most of this file has been
-;; cleaned up, generalized, gratuitously broken by esr, and now resides in
-;; cookie1.el.
-
(provide 'spook)
;;; spook.el ends here
diff --git a/lisp/play/studly.el b/lisp/play/studly.el
index d28304df1e5..f6aae4548b1 100644
--- a/lisp/play/studly.el
+++ b/lisp/play/studly.el
@@ -5,7 +5,7 @@
;; This file is part of GNU Emacs.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: games
;;; Commentary:
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index 19fa8f38a70..0f3b7586153 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -1,6 +1,6 @@
;;; tetris.el --- implementation of Tetris for Emacs
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 2.01
@@ -265,7 +265,7 @@ each one of its four blocks.")
(define-key map [left] 'tetris-move-left)
(define-key map [right] 'tetris-move-right)
(define-key map [up] 'tetris-rotate-prev)
- (define-key map [down] 'tetris-rotate-next)
+ (define-key map [down] 'tetris-move-down)
map))
(defvar tetris-null-map
@@ -524,6 +524,16 @@ Drops the shape one square, testing for collision."
(setq tetris-pos-x (1- tetris-pos-x)))
(tetris-draw-shape)))
+(defun tetris-move-down ()
+ "Move the shape one square to the bottom."
+ (interactive)
+ (unless tetris-paused
+ (tetris-erase-shape)
+ (setq tetris-pos-y (1+ tetris-pos-y))
+ (if (tetris-test-shape)
+ (setq tetris-pos-y (1- tetris-pos-y)))
+ (tetris-draw-shape)))
+
(defun tetris-rotate-prev ()
"Rotate the shape clockwise."
(interactive)
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 0f333392b9a..71037af01bd 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -1,6 +1,6 @@
;;; zone.el --- idle display hacks
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Victor Zandy <zandy@cs.wisc.edu>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
diff --git a/lisp/printing.el b/lisp/printing.el
index 2c807b078f5..ae0f3fdbc67 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,6 +1,6 @@
;;; printing.el --- printing utilities
-;; Copyright (C) 2000-2001, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2003-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -12,7 +12,7 @@
"printing.el, v 6.9.3 <2007/12/09 vinicius>
Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <viniciusjl@ig.com.br>
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>
")
;; This file is part of GNU Emacs.
@@ -1038,20 +1038,27 @@ Please send all bug fixes and enhancements to
;; To avoid compilation gripes
-(or (fboundp 'subst-char-in-string) ; hacked from subr.el
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+;; Emacs has this since at least 21.1.
+(when (featurep 'xemacs)
+ (or (fboundp 'subst-char-in-string) ; hacked from subr.el
+ (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 (> (setq i (1- i)) 0)
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-
-(or (fboundp 'make-temp-file) ; hacked from subr.el
- (defun make-temp-file (prefix &optional dir-flag suffix)
+ (let ((i (length string))
+ (newstr (if inplace string (copy-sequence string))))
+ (while (> (setq i (1- i)) 0)
+ (if (eq (aref newstr i) fromchar)
+ (aset newstr i tochar)))
+ newstr))))
+
+
+;; Emacs has this since at least 21.1, but the SUFFIX argument
+;; (which this file uses) only since 22.1. So the fboundp test
+;; wasn't even correct/adequate. Whatever, no-one is using
+;; this file on older Emacs version, so it's irrelevant.
+(when (featurep 'xemacs)
+ (or (fboundp 'make-temp-file) ; hacked from subr.el
+ (defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
of PREFIX, and expanding against `temporary-file-directory' if necessary),
@@ -1086,7 +1093,7 @@ If SUFFIX is non-nil, add that at the end of the file name."
nil)
file)
;; Reset the umask.
- (set-default-file-modes umask)))))
+ (set-default-file-modes umask))))))
(eval-when-compile
@@ -1739,14 +1746,14 @@ Examples:
* On GNU or Unix system:
- '((unix \".\" \"~/bin\" ghostview mpage PATH)
+ ((unix \".\" \"~/bin\" ghostview mpage PATH)
(ghostview \"$HOME/bin/gsview-dir\")
(mpage \"$HOME/bin/mpage-dir\")
)
* On Windows system:
- '((windows \"c:/applications/executables\" PATH ghostview mpage)
+ ((windows \"c:/applications/executables\" PATH ghostview mpage)
(ghostview \"c:/gs/gsview-dir\")
(mpage \"c:/mpage-dir\")
)"
@@ -1803,8 +1810,8 @@ Where:
SYMBOL It's a symbol to identify a text printer. It's for
setting option `pr-txt-name' and for menu selection.
Examples:
- 'prt_06a
- 'my_printer
+ prt_06a
+ my_printer
COMMAND Name of the program for printing a text file. On MS-DOS and
MS-Windows systems, if the value is an empty string, then Emacs
@@ -1831,7 +1838,7 @@ SWITCHES List of sexp's to pass as extra options for text printer
instead of including an explicit switch on this list.
Example:
. for lpr
- '(\"-#3\" \"-l\")
+ (\"-#3\" \"-l\")
nil
NAME A string that specifies a text printer name.
@@ -1862,13 +1869,13 @@ Examples:
* On GNU or Unix system:
- '((prt_06a \"lpr\" nil \"prt_06a\")
+ ((prt_06a \"lpr\" nil \"prt_06a\")
(prt_07c nil nil \"prt_07c\")
)
* On Windows system:
- '((prt_06a \"print\" nil \"/D:\\\\\\\\printers\\\\prt_06a\")
+ ((prt_06a \"print\" nil \"/D:\\\\\\\\printers\\\\prt_06a\")
(prt_07c nil nil \"/D:\\\\\\\\printers\\\\prt_07c\")
(PRN \"\" nil \"PRN\")
(standard \"redpr.exe\" nil \"\")
@@ -1954,8 +1961,8 @@ Where:
SYMBOL It's a symbol to identify a PostScript printer. It's for
setting option `pr-ps-name' and for menu selection.
Examples:
- 'prt_06a
- 'my_printer
+ prt_06a
+ my_printer
COMMAND Name of the program for printing a PostScript file. On MS-DOS
and MS-Windows systems, if the value is an empty string then
@@ -1984,11 +1991,11 @@ SWITCHES List of sexp's to pass as extra options for PostScript printer
instead of including an explicit switch on this list.
Example:
. for lpr
- '(\"-#3\" \"-l\")
+ (\"-#3\" \"-l\")
nil
. for gsprint.exe
- '(\"-all\" \"-twoup\")
+ (\"-all\" \"-twoup\")
PRINTER-SWITCH A string that specifies PostScript printer name switch. If
it's necessary to have a space between PRINTER-SWITCH and NAME,
@@ -2050,9 +2057,9 @@ DEFAULT It's a way to set default values when this entry is selected.
which the current setting inherits the context. Take care with
circular inheritance.
Examples:
- '(ps-landscape-mode . nil)
- '(ps-spool-duplex . t)
- '(pr-gs-device . (my-gs-device t))
+ (ps-landscape-mode . nil)
+ (ps-spool-duplex . t)
+ (pr-gs-device . (my-gs-device t))
This variable should be modified by customization engine. If this variable is
modified by other means (for example, a lisp function), use `pr-update-menus'
@@ -2062,14 +2069,14 @@ Examples:
* On GNU or Unix system:
- '((lps_06b \"lpr\" nil \"-P\" \"lps_06b\")
+ ((lps_06b \"lpr\" nil \"-P\" \"lps_06b\")
(lps_07c \"lpr\" nil nil \"lps_07c\")
(lps_08c nil nil nil \"lps_08c\")
)
* On Windows system:
- '((lps_06a \"print\" nil \"/D:\" \"\\\\\\\\printers\\\\lps_06a\")
+ ((lps_06a \"print\" nil \"/D:\" \"\\\\\\\\printers\\\\lps_06a\")
(lps_06b \"print\" nil nil \"\\\\\\\\printers\\\\lps_06b\")
(lps_07c \"print\" nil \"\" \"/D:\\\\\\\\printers\\\\lps_07c\")
(lps_08c nil nil nil \"\\\\\\\\printers\\\\lps_08c\")
@@ -2095,7 +2102,7 @@ Also the gsprint utility comes together with gsview distribution.
As an example of gsprint declaration:
(setq pr-ps-printer-alist
- '((A \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"lps_015\")
+ \\='((A \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"lps_015\")
(B \"gsprint\" (\"-all\" \"-twoup\") nil \"-printer lps_015\")
;; some other printer declaration
))
@@ -2587,9 +2594,9 @@ DEFAULT It's a way to set default values when this entry is selected.
which the current setting inherits the context. Take care with
circular inheritance.
Examples:
- '(ps-landscape-mode . nil)
- '(ps-spool-duplex . t)
- '(pr-gs-device . (my-gs-device t))"
+ (ps-landscape-mode . nil)
+ (ps-spool-duplex . t)
+ (pr-gs-device . (my-gs-device t))"
:type '(repeat
(list
:tag ""
@@ -2683,8 +2690,8 @@ Where:
SYMBOL It's a symbol to identify a PostScript utility. It's for
`pr-ps-utility' variable setting and for menu selection.
Examples:
- 'mpage
- 'psnup
+ mpage
+ psnup
UTILITY Name of utility for processing a PostScript file.
See also `pr-path-alist'.
@@ -2701,7 +2708,7 @@ MUST-SWITCHES List of sexp's to pass as options to the PostScript utility
program and must be placed before any other switches.
Example:
. for psnup:
- '(\"-q\")
+ (\"-q\")
PAPERSIZE It's a format string to specify paper size switch.
Example:
@@ -2745,7 +2752,7 @@ SWITCHES List of sexp's to pass as extra options to the PostScript utility
program.
Example:
. for psnup
- '(\"-q\")
+ (\"-q\")
nil
DEFAULT It's a way to set default values when this entry is selected.
@@ -2765,9 +2772,9 @@ DEFAULT It's a way to set default values when this entry is selected.
which the current setting inherits the context. Take care with
circular inheritance.
Examples:
- '(pr-file-landscape . nil)
- '(pr-file-duplex . t)
- '(pr-gs-device . (my-gs-device t))
+ (pr-file-landscape . nil)
+ (pr-file-duplex . t)
+ (pr-gs-device . (my-gs-device t))
This variable should be modified by customization engine. If this variable is
modified by other means (for example, a lisp function), use `pr-update-menus'
@@ -2780,14 +2787,14 @@ Examples:
* On GNU or Unix system:
- '((mpage \"mpage\" nil \"-b%s\" \"-%d\" \"-l\" \"-t\" \"-T\" \">\" nil)
+ ((mpage \"mpage\" nil \"-b%s\" \"-%d\" \"-l\" \"-t\" \"-T\" \">\" nil)
(psnup \"psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \" nil
(pr-file-duplex . nil) (pr-file-tumble . nil))
)
* On Windows system:
- '((psnup \"c:/psutils/psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \"
+ ((psnup \"c:/psutils/psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \"
nil (pr-file-duplex . nil) (pr-file-tumble . nil))
)
@@ -3164,12 +3171,9 @@ See `pr-ps-printer-alist'.")
(defmacro pr-save-file-modes (&rest body)
- "Set temporally file modes to `pr-file-modes'."
- `(let ((pr--default-file-modes (default-file-modes))) ; save default
- (set-default-file-modes pr-file-modes)
- ,@body
- (set-default-file-modes pr--default-file-modes))) ; restore default
-
+ "Execute BODY with file permissions temporarily set to `pr-file-modes'."
+ (declare (obsolete with-file-modes "25.1"))
+ `(with-file-modes pr-file-modes ,@body))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Keys & Menus
@@ -3192,9 +3196,10 @@ See `pr-ps-printer-alist'.")
(defalias 'pr-get-symbol
- (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
- 'easy-menu-intern
- (lambda (s) (if (stringp s) (intern s) s))))
+ (if (featurep 'emacs) 'easy-menu-intern ; since 22.1
+ (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el
+ 'easy-menu-intern
+ (lambda (s) (if (stringp s) (intern s) s)))))
(defconst pr-menu-spec
@@ -4364,12 +4369,12 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil,
send the image to the printer. If FILENAME is a string, save the PostScript
image in a file with that name."
(interactive (list (ps-print-preprint current-prefix-arg)))
- (pr-save-file-modes
- (let ((ps-lpr-command (pr-command pr-ps-command))
- (ps-lpr-switches pr-ps-switches)
- (ps-printer-name-option pr-ps-printer-switch)
- (ps-printer-name pr-ps-printer))
- (ps-despool filename))))
+ (with-file-modes pr-file-modes
+ (let ((ps-lpr-command (pr-command pr-ps-command))
+ (ps-lpr-switches pr-ps-switches)
+ (ps-printer-name-option pr-ps-printer-switch)
+ (ps-printer-name pr-ps-printer))
+ (ps-despool filename))))
;;;###autoload
@@ -4627,21 +4632,21 @@ bottom."
;;;###autoload
-(defun pr-customize (&rest ignore)
+(defun pr-customize (&rest _ignore)
"Customization of the `printing' group."
(interactive)
(customize-group 'printing))
;;;###autoload
-(defun lpr-customize (&rest ignore)
+(defun lpr-customize (&rest _ignore)
"Customization of the `lpr' group."
(interactive)
(customize-group 'lpr))
;;;###autoload
-(defun pr-help (&rest ignore)
+(defun pr-help (&rest _ignore)
"Help for the printing package."
(interactive)
(pr-show-setup pr-help-message "*Printing Help*"))
@@ -4675,21 +4680,21 @@ bottom."
;;;###autoload
-(defun pr-show-ps-setup (&rest ignore)
+(defun pr-show-ps-setup (&rest _ignore)
"Show current ps-print settings."
(interactive)
(pr-show-setup (ps-setup) "*PS Setup*"))
;;;###autoload
-(defun pr-show-pr-setup (&rest ignore)
+(defun pr-show-pr-setup (&rest _ignore)
"Show current printing settings."
(interactive)
(pr-show-setup (pr-setup) "*PR Setup*"))
;;;###autoload
-(defun pr-show-lpr-setup (&rest ignore)
+(defun pr-show-lpr-setup (&rest _ignore)
"Show current lpr settings."
(interactive)
(pr-show-setup (lpr-setup) "*LPR Setup*"))
@@ -5537,8 +5542,8 @@ If menu binding was not done, calls `pr-menu-bind'."
((file-exists-p res)
(ding)
(setq prompt "exists")
- (not (y-or-n-p (format "File `%s' exists; overwrite? "
- res))))
+ (not (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " res))))
(t nil))
(setq res (read-file-name
(format "File %s; PostScript file: " prompt)
@@ -5632,12 +5637,12 @@ If menu binding was not done, calls `pr-menu-bind'."
(goto-char (point-max))
(insert (format "%s %S\n" cmd args)))
;; *Printing Command Output* == show any return message from command
- (pr-save-file-modes
- (setq status
- (condition-case data
- (apply 'call-process cmd nil buffer nil args)
- ((quit error)
- (error-message-string data)))))
+ (with-file-modes pr-file-modes
+ (setq status
+ (condition-case data
+ (apply 'call-process cmd nil buffer nil args)
+ ((quit error)
+ (error-message-string data)))))
;; *Printing Command Output* == show exit status
(with-current-buffer buffer
(goto-char (point-max))
@@ -5882,42 +5887,42 @@ If menu binding was not done, calls `pr-menu-bind'."
(defun pr-text2ps (kind n-up filename &optional from to)
- (pr-save-file-modes
- (let ((ps-n-up-printing n-up)
- (ps-spool-config (and (eq ps-spool-config 'setpagedevice)
- 'setpagedevice)))
- (pr-delete-file-if-exists filename)
- (cond (pr-faces-p
- (cond (pr-spool-p
- ;; pr-faces-p and pr-spool-p
- ;; here FILENAME arg is ignored
- (cond ((eq kind 'buffer)
- (ps-spool-buffer-with-faces))
- ((eq kind 'region)
- (ps-spool-region-with-faces (or from (point))
- (or to (mark))))
- ))
- ;; pr-faces-p and not pr-spool-p
- ((eq kind 'buffer)
- (ps-print-buffer-with-faces filename))
- ((eq kind 'region)
- (ps-print-region-with-faces (or from (point))
- (or to (mark)) filename))
- ))
- (pr-spool-p
- ;; not pr-faces-p and pr-spool-p
- ;; here FILENAME arg is ignored
- (cond ((eq kind 'buffer)
- (ps-spool-buffer))
- ((eq kind 'region)
- (ps-spool-region (or from (point)) (or to (mark))))
- ))
- ;; not pr-faces-p and not pr-spool-p
- ((eq kind 'buffer)
- (ps-print-buffer filename))
- ((eq kind 'region)
- (ps-print-region (or from (point)) (or to (mark)) filename))
- ))))
+ (with-file-modes pr-file-modes
+ (let ((ps-n-up-printing n-up)
+ (ps-spool-config (and (eq ps-spool-config 'setpagedevice)
+ 'setpagedevice)))
+ (pr-delete-file-if-exists filename)
+ (cond (pr-faces-p
+ (cond (pr-spool-p
+ ;; pr-faces-p and pr-spool-p
+ ;; here FILENAME arg is ignored
+ (cond ((eq kind 'buffer)
+ (ps-spool-buffer-with-faces))
+ ((eq kind 'region)
+ (ps-spool-region-with-faces (or from (point))
+ (or to (mark))))
+ ))
+ ;; pr-faces-p and not pr-spool-p
+ ((eq kind 'buffer)
+ (ps-print-buffer-with-faces filename))
+ ((eq kind 'region)
+ (ps-print-region-with-faces (or from (point))
+ (or to (mark)) filename))
+ ))
+ (pr-spool-p
+ ;; not pr-faces-p and pr-spool-p
+ ;; here FILENAME arg is ignored
+ (cond ((eq kind 'buffer)
+ (ps-spool-buffer))
+ ((eq kind 'region)
+ (ps-spool-region (or from (point)) (or to (mark))))
+ ))
+ ;; not pr-faces-p and not pr-spool-p
+ ((eq kind 'buffer)
+ (ps-print-buffer filename))
+ ((eq kind 'region)
+ (ps-print-region (or from (point)) (or to (mark)) filename))
+ ))))
(defun pr-command (command)
@@ -6125,7 +6130,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-checkbox
"\n "
'pr-i-region
- #'(lambda (widget &rest ignore)
+ #'(lambda (widget &rest _ignore)
(let ((region-p (pr-interface-save
(ps-mark-active-p))))
(cond ((null (widget-value widget)) ; widget is nil
@@ -6146,7 +6151,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-checkbox
" "
'pr-i-mode
- #'(lambda (widget &rest ignore)
+ #'(lambda (widget &rest _ignore)
(let ((mode-p (pr-interface-save
(pr-mode-alist-p))))
(cond
@@ -6182,7 +6187,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(widget-create 'regexp
:size 58
:format "\n File Regexp : %v\n"
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(setq pr-i-regexp (widget-value widget)))
pr-i-regexp)
;; 1b. Directory: List Directory Entry
@@ -6222,7 +6227,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-checkbox
" "
'pr-i-despool
- #'(lambda (widget &rest ignore)
+ #'(lambda (widget &rest _ignore)
(if pr-spool-p
(setq pr-i-despool (not pr-i-despool))
(ding)
@@ -6259,7 +6264,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
'integer
:size 3
:format "\n N-Up : %v"
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(let ((value (if (string= (widget-apply widget :value-get) "")
0
(widget-value widget))))
@@ -6288,7 +6293,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 4. Settings:
;; 4. Settings: Landscape Auto Region Verbose
(pr-insert-checkbox "\n\n " 'ps-landscape-mode
- #'(lambda (&rest ignore)
+ #'(lambda (&rest _ignore)
(setq ps-landscape-mode (not ps-landscape-mode)
pr-file-landscape ps-landscape-mode))
" Landscape ")
@@ -6310,7 +6315,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-toggle 'ps-zebra-stripes " Zebra Stripes")
(pr-insert-checkbox " "
'pr-spool-p
- #'(lambda (&rest ignore)
+ #'(lambda (&rest _ignore)
(setq pr-spool-p (not pr-spool-p))
(unless pr-spool-p
(setq pr-i-despool nil)
@@ -6320,7 +6325,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 4. Settings: Duplex Print with faces
(pr-insert-checkbox "\n "
'ps-spool-duplex
- #'(lambda (&rest ignore)
+ #'(lambda (&rest _ignore)
(setq ps-spool-duplex (not ps-spool-duplex)
pr-file-duplex ps-spool-duplex))
" Duplex ")
@@ -6329,7 +6334,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 4. Settings: Tumble Print via Ghostscript
(pr-insert-checkbox "\n "
'ps-spool-tumble
- #'(lambda (&rest ignore)
+ #'(lambda (&rest _ignore)
(setq ps-spool-tumble (not ps-spool-tumble)
pr-file-tumble ps-spool-tumble))
" Tumble ")
@@ -6352,7 +6357,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; 5. Customize:
(pr-insert-italic "\n\nCustomize : " 2 11)
(pr-insert-button 'pr-customize "printing" " ")
- (pr-insert-button #'(lambda (&rest ignore) (ps-print-customize))
+ (pr-insert-button #'(lambda (&rest _ignore) (ps-print-customize))
"ps-print" " ")
(pr-insert-button 'lpr-customize "lpr"))
@@ -6374,7 +6379,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(pr-insert-button 'pr-kill-help "Kill All Printing Help Buffer"))
-(defun pr-kill-help (&rest ignore)
+(defun pr-kill-help (&rest _ignore)
"Kill all printing help buffer."
(interactive)
(let ((help '("*Printing Interface Help*" "*Printing Help*"
@@ -6388,20 +6393,20 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(recenter (- (window-height) 2)))
-(defun pr-interface-quit (&rest ignore)
+(defun pr-interface-quit (&rest _ignore)
"Kill the printing buffer interface and quit."
(interactive)
(kill-buffer pr-buffer-name)
(set-window-configuration pr-i-window-configuration))
-(defun pr-interface-help (&rest ignore)
+(defun pr-interface-help (&rest _ignore)
"printing buffer interface help."
(interactive)
(pr-show-setup pr-interface-help-message "*Printing Interface Help*"))
-(defun pr-interface-txt-print (&rest ignore)
+(defun pr-interface-txt-print (&rest _ignore)
"Print using lpr package."
(interactive)
(condition-case data
@@ -6433,7 +6438,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(message "%s" (error-message-string data)))))
-(defun pr-interface-printify (&rest ignore)
+(defun pr-interface-printify (&rest _ignore)
"Printify a buffer."
(interactive)
(condition-case data
@@ -6458,7 +6463,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(message "%s" (error-message-string data)))))
-(defun pr-interface-ps-print (&rest ignore)
+(defun pr-interface-ps-print (&rest _ignore)
"Print using ps-print package."
(interactive)
(pr-interface-ps 'pr-despool-ps-print 'pr-ps-directory-ps-print
@@ -6467,7 +6472,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
'pr-ps-buffer-ps-print))
-(defun pr-interface-preview (&rest ignore)
+(defun pr-interface-preview (&rest _ignore)
"Preview a PostScript file."
(interactive)
(pr-interface-ps 'pr-despool-preview 'pr-ps-directory-preview
@@ -6535,29 +6540,27 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
((or (not (file-exists-p pr-i-out-file))
pr-i-answer-yes
(setq pr-i-answer-yes
- (y-or-n-p (format "File `%s' exists; overwrite? "
- pr-i-out-file))))
+ (y-or-n-p (format-message "File `%s' exists; overwrite? "
+ pr-i-out-file))))
pr-i-out-file)
(t
(error "File already exists"))))
(defun pr-i-directory ()
- (or (and (file-directory-p pr-i-directory)
- (file-readable-p pr-i-directory))
+ (or (file-accessible-directory-p pr-i-directory)
(error "Please specify be a readable directory")))
-(defun pr-interface-directory (widget &rest ignore)
+(defun pr-interface-directory (widget &rest _ignore)
(and pr-buffer-verbose
(message "You can use M-TAB or ESC TAB for file completion"))
(let ((dir (widget-value widget)))
- (and (file-directory-p dir)
- (file-readable-p dir)
+ (and (file-accessible-directory-p dir)
(setq pr-i-directory dir))))
-(defun pr-interface-infile (widget &rest ignore)
+(defun pr-interface-infile (widget &rest _ignore)
(and pr-buffer-verbose
(message "You can use M-TAB or ESC TAB for file completion"))
(let ((file (widget-value widget)))
@@ -6566,7 +6569,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(setq pr-i-ps-file file))))
-(defun pr-interface-outfile (widget &rest ignore)
+(defun pr-interface-outfile (widget &rest _ignore)
(setq pr-i-answer-yes nil)
(and pr-buffer-verbose
(message "You can use M-TAB or ESC TAB for file completion"))
@@ -6602,7 +6605,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(defun pr-insert-toggle (var-sym label)
(widget-create 'checkbox
- :notify `(lambda (&rest ignore)
+ :notify `(lambda (&rest _ignore)
(setq ,var-sym (not ,var-sym)))
(symbol-value var-sym))
(widget-insert label))
@@ -6623,7 +6626,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
:format "%v"
:inline t
:value ,var-sym
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (widget &rest _ignore)
(setq ,var-sym (widget-value widget))
,@body)
:void '(choice-item :format "%[%t%]"
@@ -6639,7 +6642,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
'radio-button
:format " %[%v%]"
:value (eq ,var-sym (quote ,sym))
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _ignore)
(setq ,var-sym (quote ,sym))
(pr-update-radio-button (quote ,var-sym)))))))
(put var-sym 'pr-widget-list (cons (cons wid sym) wid-list))))
diff --git a/lisp/proced.el b/lisp/proced.el
index e0a61e9f84b..bf7ce24f202 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -1,6 +1,6 @@
;;; proced.el --- operate on system processes like dired
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Roland Winkler <winkler@gnu.org>
;; Keywords: Processes, Unix
@@ -49,8 +49,6 @@
;;; Code:
-(require 'time-date) ; for `with-decoded-time-value'
-
(defgroup proced nil
"Proced mode."
:group 'processes
@@ -1186,17 +1184,8 @@ Return nil otherwise."
(defun proced-time-lessp (t1 t2)
"Return t if time value T1 is less than time value T2.
Return `equal' if T1 equals T2. Return nil otherwise."
- (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1)
- (high2 low2 micro2 pico2 type2 t2))
- (cond ((< high1 high2))
- ((< high2 high1) nil)
- ((< low1 low2))
- ((< low2 low1) nil)
- ((< micro1 micro2))
- ((< micro2 micro1) nil)
- ((< pico1 pico2))
- ((< pico2 pico1) nil)
- (t 'equal))))
+ (or (time-less-p t1 t2)
+ (if (not (time-less-p t2 t1)) 'equal)))
;;; Sorting
@@ -1926,7 +1915,7 @@ and \f (formfeed) at the end."
(let (buffer-read-only)
(cond ((stringp log)
(insert (if args
- (apply 'format log args)
+ (apply #'format-message log args)
log)))
((bufferp log)
(insert-buffer-substring log))
@@ -1935,8 +1924,8 @@ and \f (formfeed) at the end."
(unless (bolp)
(insert "\n"))
(insert (current-time-string)
- "\tBuffer `" (buffer-name obuf) "', "
- (format "signal `%s'\n" (car args)))
+ (format-message "\tBuffer `%s', signal `%s'\n"
+ (buffer-name obuf) (car args)))
(goto-char (point-max))
(insert "\f\n")))))))
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 609a0308cf0..f28bbfe2768 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -1,6 +1,6 @@
;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Tomohiro Matsuyama <tomo@cx4a.org>
;; Keywords: lisp
@@ -27,6 +27,7 @@
;;; Code:
(require 'cl-lib)
+(require 'pcase)
(defgroup profiler nil
"Emacs profiler."
@@ -55,7 +56,7 @@
(format "%s" object))))
(defun profiler-format-percent (number divisor)
- (concat (number-to-string (/ (* number 100) divisor)) "%"))
+ (format "%d%%" (floor (* 100.0 number) divisor)))
(defun profiler-format-number (number)
"Format NUMBER in human readable string."
@@ -86,10 +87,12 @@
(profiler-ensure-string arg)))
for len = (length str)
if (< width len)
- collect (substring str 0 width) into frags
+ collect (progn (put-text-property (max 0 (- width 2)) len
+ 'invisible 'profiler str)
+ str) into frags
else
collect
- (let ((padding (make-string (- width len) ?\s)))
+ (let ((padding (make-string (max 0 (- width len)) ?\s)))
(cl-ecase align
(left (concat str padding))
(right (concat padding str))))
@@ -248,18 +251,17 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(not (profiler-calltree-count< a b)))
(defun profiler-calltree-depth (tree)
- (let ((parent (profiler-calltree-parent tree)))
- (if (null parent)
- 0
- (1+ (profiler-calltree-depth parent)))))
+ (let ((d 0))
+ (while (setq tree (profiler-calltree-parent tree))
+ (cl-incf d))
+ d))
(defun profiler-calltree-find (tree entry)
"Return a child tree of ENTRY under TREE."
(let (result (children (profiler-calltree-children tree)))
- ;; FIXME: Use `assoc'.
(while (and children (null result))
(let ((child (car children)))
- (when (equal (profiler-calltree-entry child) entry)
+ (when (function-equal (profiler-calltree-entry child) entry)
(setq result child))
(setq children (cdr children))))
result))
@@ -270,10 +272,9 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(profiler-calltree-walk child function)))
(defun profiler-calltree-build-1 (tree log &optional reverse)
- ;; FIXME: Do a better job of reconstructing a complete call-tree
- ;; when the backtraces have been truncated. Ideally, we should be
- ;; able to reduce profiler-max-stack-depth to 3 or 4 and still
- ;; get a meaningful call-tree.
+ ;; This doesn't try to stitch up partial backtraces together.
+ ;; We still use it for reverse calltrees, but for forward calltrees, we use
+ ;; profiler-calltree-build-unified instead now.
(maphash
(lambda (backtrace count)
(let ((node tree)
@@ -290,6 +291,115 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(setq node child)))))))
log))
+
+(define-hash-table-test 'profiler-function-equal #'function-equal
+ (lambda (f) (cond
+ ((byte-code-function-p f) (aref f 1))
+ ((eq (car-safe f) 'closure) (cddr f))
+ (t f))))
+
+(defun profiler-calltree-build-unified (tree log)
+ ;; Let's try to unify all those partial backtraces into a single
+ ;; call tree. First, we record in fun-map all the functions that appear
+ ;; in `log' and where they appear.
+ (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)))
+ (push leftover-tree (profiler-calltree-children tree))
+ (maphash
+ (lambda (backtrace _count)
+ (let ((max (length backtrace)))
+ ;; Don't record the head elements in there, since we want to use this
+ ;; fun-map to find parents of partial backtraces, but parents only
+ ;; make sense if they have something "above".
+ (dotimes (i (1- max))
+ (let ((f (aref backtrace i)))
+ (when f
+ (push (cons i backtrace) (gethash f fun-map)))))))
+ log)
+ ;; Then, for each partial backtrace, try to find a parent backtrace
+ ;; (i.e. a backtrace that describes (part of) the truncated part of
+ ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3
+ ;; is deeper), any backtrace that includes f1 could be a parent; and indeed
+ ;; the counts of this partial backtrace could each come from a different
+ ;; parent backtrace (some of which may not even be in `log'). So we should
+ ;; consider each backtrace that includes f1 and give it some percentage of
+ ;; `count'. But we can't know for sure what percentage to give to each
+ ;; possible parent.
+ ;; The "right" way might be to give a percentage proportional to the counts
+ ;; already registered for that parent, or some such statistical principle.
+ ;; But instead, we will give all our counts to a single "best
+ ;; matching" parent. So let's look for the best matching parent, and store
+ ;; the result in parent-map.
+ ;; Using the "best matching parent" is important also to try and avoid
+ ;; stitching together backtraces that can't possibly go together.
+ ;; For example, when the head is `apply' (or `mapcar', ...), we want to
+ ;; make sure we don't just use any parent that calls `apply', since most of
+ ;; them would never, in turn, cause apply to call the subsequent function.
+ (maphash
+ (lambda (backtrace _count)
+ (let* ((max (1- (length backtrace)))
+ (head (aref backtrace max))
+ (best-parent nil)
+ (best-match (1+ max))
+ (parents (gethash head fun-map)))
+ (pcase-dolist (`(,i . ,parent) parents)
+ (when t ;; (<= (- max i) best-match) ;Else, it can't be better.
+ (let ((match max)
+ (imatch i))
+ (cl-assert (>= match imatch))
+ (cl-assert (function-equal (aref backtrace max)
+ (aref parent i)))
+ (while (progn
+ (cl-decf imatch) (cl-decf match)
+ (when (> imatch 0)
+ (function-equal (aref backtrace match)
+ (aref parent imatch)))))
+ (when (< match best-match)
+ (cl-assert (<= (- max i) best-match))
+ ;; Let's make sure this parent is not already our child: we
+ ;; don't want cycles here!
+ (let ((valid t)
+ (tmp-parent parent))
+ (while (setq tmp-parent
+ (if (eq tmp-parent backtrace)
+ (setq valid nil)
+ (cdr (gethash tmp-parent parent-map)))))
+ (when valid
+ (setq best-match match)
+ (setq best-parent (cons i parent))))))))
+ (puthash backtrace best-parent parent-map)))
+ log)
+ ;; Now we have a single parent per backtrace, so we have a unified tree.
+ ;; Let's build the actual call-tree from it.
+ (maphash
+ (lambda (backtrace count)
+ (let ((node tree)
+ (parents (list (cons -1 backtrace)))
+ (tmp backtrace)
+ (max (length backtrace)))
+ (while (setq tmp (gethash tmp parent-map))
+ (push tmp parents)
+ (setq tmp (cdr tmp)))
+ (when (aref (cdar parents) (1- max))
+ (cl-incf (profiler-calltree-count leftover-tree) count)
+ (setq node leftover-tree))
+ (pcase-dolist (`(,i . ,parent) parents)
+ (let ((j (1- max)))
+ (while (> j i)
+ (let ((f (aref parent j)))
+ (cl-decf j)
+ (when f
+ (let ((child (profiler-calltree-find node f)))
+ (unless child
+ (setq child (profiler-make-calltree
+ :entry f :parent node))
+ (push child (profiler-calltree-children node)))
+ (cl-incf (profiler-calltree-count child) count)
+ (setq node child)))))))))
+ log)))
+
(defun profiler-calltree-compute-percentages (tree)
(let ((total-count 0))
;; FIXME: the memory profiler's total wraps around all too easily!
@@ -304,7 +414,9 @@ Optional argument MODE means only check for the specified mode (cpu or mem)."
(cl-defun profiler-calltree-build (log &key reverse)
(let ((tree (profiler-make-calltree)))
- (profiler-calltree-build-1 tree log reverse)
+ (if reverse
+ (profiler-calltree-build-1 tree log reverse)
+ (profiler-calltree-build-unified tree log))
(profiler-calltree-compute-percentages tree)
tree))
@@ -372,7 +484,7 @@ RET: expand or collapse"))
(defun profiler-report-make-name-part (tree)
(let* ((entry (profiler-calltree-entry tree))
(depth (profiler-calltree-depth tree))
- (indent (make-string (* (1- depth) 2) ?\s))
+ (indent (make-string (* (1- depth) 1) ?\s))
(mark (if (profiler-calltree-leaf-p tree)
profiler-report-leaf-mark
profiler-report-closed-mark))
@@ -380,7 +492,7 @@ RET: expand or collapse"))
(format "%s%s %s" indent mark entry)))
(defun profiler-report-header-line-format (fmt &rest args)
- (let* ((header (apply 'profiler-format fmt args))
+ (let* ((header (apply #'profiler-format fmt args))
(escaped (replace-regexp-in-string "%" "%%" header)))
(concat " " escaped)))
@@ -405,7 +517,7 @@ RET: expand or collapse"))
(insert (propertize (concat line "\n") 'calltree tree))))
(defun profiler-report-insert-calltree-children (tree)
- (mapc 'profiler-report-insert-calltree
+ (mapc #'profiler-report-insert-calltree
(profiler-calltree-children tree)))
@@ -503,6 +615,7 @@ return it."
(define-derived-mode profiler-report-mode special-mode "Profiler-Report"
"Profiler Report Mode."
+ (add-to-invisibility-spec '(profiler . t))
(setq buffer-read-only t
buffer-undo-list t
truncate-lines t))
@@ -532,9 +645,10 @@ return it."
(forward-line -1)
(profiler-report-move-to-entry))
-(defun profiler-report-expand-entry ()
- "Expand entry at point."
- (interactive)
+(defun profiler-report-expand-entry (&optional full)
+ "Expand entry at point.
+With a prefix argument, expand the whole subtree."
+ (interactive "P")
(save-excursion
(beginning-of-line)
(when (search-forward (concat profiler-report-closed-mark " ")
@@ -544,7 +658,14 @@ return it."
(let ((inhibit-read-only t))
(replace-match (concat profiler-report-open-mark " "))
(forward-line)
- (profiler-report-insert-calltree-children tree)
+ (let ((first (point))
+ (last (copy-marker (point) t)))
+ (profiler-report-insert-calltree-children tree)
+ (when full
+ (goto-char first)
+ (while (< (point) last)
+ (profiler-report-expand-entry)
+ (forward-line 1))))
t))))))
(defun profiler-report-collapse-entry ()
@@ -569,11 +690,11 @@ return it."
(delete-region start (line-beginning-position)))))
t)))
-(defun profiler-report-toggle-entry ()
+(defun profiler-report-toggle-entry (&optional arg)
"Expand entry at point if the tree is collapsed,
otherwise collapse."
- (interactive)
- (or (profiler-report-expand-entry)
+ (interactive "P")
+ (or (profiler-report-expand-entry arg)
(profiler-report-collapse-entry)))
(defun profiler-report-find-entry (&optional event)
diff --git a/lisp/progmodes/.gitignore b/lisp/progmodes/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/progmodes/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 33b21d6cc07..529b691ee79 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1,6 +1,6 @@
;;; ada-mode.el --- major-mode for editing Ada sources
-;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2015 Free Software Foundation, Inc.
;; Author: Rolf Ebert <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
@@ -31,11 +31,6 @@
;; independent from the GNU Ada compiler GNAT, distributed by Ada
;; Core Technologies. All the other files rely heavily on features
;; provided only by GNAT.
-;;
-;; Note: this mode will not work with Emacs 19. If you are on a VMS
-;; system, where the latest version of Emacs is 19.28, you will need
-;; another file, called ada-vms.el, that provides some required
-;; functions.
;;; Usage:
;; Emacs should enter Ada mode automatically when you load an Ada file.
@@ -149,6 +144,8 @@ This is a good place to add Ada environment specific bindings.")
(defgroup ada nil
"Major mode for editing and compiling Ada source in Emacs."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
+ :link '(custom-manual "(ada-mode) Top")
+ :link '(emacs-commentary-link :tag "Commentary" "ada-mode.el")
:group 'languages)
(defcustom ada-auto-case t
@@ -289,11 +286,11 @@ type A is
:type 'boolean :group 'ada)
(defcustom ada-indent-is-separate t
- "Non-nil means indent 'is separate' or 'is abstract' if on a single line."
+ "Non-nil means indent `is separate' or `is abstract' if on a single line."
:type 'boolean :group 'ada)
(defcustom ada-indent-record-rel-type 3
- "Indentation for 'record' relative to 'type' or 'use'.
+ "Indentation for `record' relative to `type' or `use'.
An example is:
type A is
@@ -312,7 +309,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-indent-return 0
- "Indentation for 'return' relative to the matching 'function' statement.
+ "Indentation for `return' relative to the matching `function' statement.
If `ada-indent-return' is null or negative, the indentation is done relative to
the open parenthesis (if there is no parenthesis, `ada-broken-indent' is used).
@@ -352,7 +349,7 @@ This is also used for <<..>> labels"
:type '(choice (const ada83) (const ada95) (const ada2005)) :group 'ada)
(defcustom ada-move-to-declaration nil
- "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to 'begin'."
+ "Non-nil means `ada-move-to-start' moves to the subprogram declaration, not to `begin'."
:type 'boolean :group 'ada)
(defcustom ada-popup-key '[down-mouse-3]
@@ -400,7 +397,7 @@ Must be one of :
:group 'ada)
(defcustom ada-use-indent ada-broken-indent
- "Indentation for the lines in a 'use' statement.
+ "Indentation for the lines in a `use' statement.
An example is:
use Ada.Text_IO,
@@ -408,7 +405,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-when-indent 3
- "Indentation for 'when' relative to 'exception' or 'case'.
+ "Indentation for `when' relative to `exception' or `case'.
An example is:
case A is
@@ -416,7 +413,7 @@ An example is:
:type 'integer :group 'ada)
(defcustom ada-with-indent ada-broken-indent
- "Indentation for the lines in a 'with' statement.
+ "Indentation for the lines in a `with' statement.
An example is:
with Ada.Text_IO,
@@ -496,7 +493,7 @@ Used to define `ada-*-keywords.'"))
"Alist of substrings (entities) that have special casing.
The substrings are detected for word constituent when the word
is not itself in `ada-case-exception', and only for substrings that
-either are at the beginning or end of the word, or start after '_'.")
+either are at the beginning or end of the word, or start after `_'.")
(defvar ada-lfd-binding nil
"Variable to save key binding of LFD when casing is activated.")
@@ -1016,7 +1013,7 @@ If PARSE-RESULT is non-nil, use it instead of calling `parse-partial-sexp'."
(defsubst ada-in-numeric-literal-p ()
"Return t if point is after a prefix of a numeric literal."
- (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
+ (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)" (line-beginning-position)))
;;------------------------------------------------------------------
;; Contextual menus
@@ -1692,7 +1689,7 @@ See also `ada-auto-case' to disable auto casing altogether."
nil)
(defun ada-capitalize-word (&optional _arg)
- "Upcase first letter and letters following '_', lower case other letters.
+ "Upcase first letter and letters following `_', lower case other letters.
ARG is ignored, and is there for compatibility with `capitalize-word' only."
(interactive)
(let ((end (save-excursion (skip-syntax-forward "w") (point)))
@@ -2685,7 +2682,7 @@ if INITIAL-POS is non-nil, moves point to INITIAL-POS before calculation."
;; "then" has to be included in the case of "select...then abort"
;; statements, since (goto-stmt-start) at the beginning of
;; the current function would leave the cursor on that position
- ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\\>")
+ ((looking-at "\\(\\(els\\)?if\\>\\)\\|then abort\\>")
(ada-get-indent-if orgpoint))
;;
((looking-at "case\\>")
@@ -2837,7 +2834,7 @@ ORGPOINT is the limit position used in the calculation."
(save-excursion
(goto-char (car match-cons))
(unless (ada-search-ignore-string-comment "when" t opos)
- (error "Missing 'when' between 'case' and '=>'"))
+ (error "Missing `when' between `case' and `=>'"))
(list (save-excursion (back-to-indentation) (point)) 'ada-indent)))
;;
;; case..is..when
@@ -3006,7 +3003,7 @@ ORGPOINT is the limit position used in the calculation."
(list cur-indent 'ada-broken-indent)))))
(defun ada-get-indent-noindent (orgpoint)
- "Calculate the indentation when point is just before a 'noindent stmt'.
+ "Calculate the indentation when point is just before a `noindent stmt'.
ORGPOINT is the limit position used in the calculation."
(let ((label 0))
(save-excursion
@@ -3432,7 +3429,7 @@ Return the new position of point or nil if not found."
Moves point to the matching block start."
(ada-goto-matching-start 0)
(unless (looking-at (concat "\\<" keyword "\\>"))
- (error "Matching start is not '%s'" keyword)))
+ (error "Matching start is not `%s'" keyword)))
(defun ada-check-defun-name (defun-name)
@@ -3670,7 +3667,7 @@ otherwise throw error."
"Move point to the beginning of a block-start.
Which block depends on the value of NEST-LEVEL, which defaults to zero.
If NOERROR is non-nil, it only returns nil if no matching start was found.
-If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
+If GOTOTHEN is non-nil, point moves to the `then' following `if'."
(let ((nest-count (if nest-level nest-level 0))
(found nil)
@@ -3737,7 +3734,7 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
(if pos
(goto-char (car pos))
(error (concat
- "No matching 'is' or 'renames' for 'package' at"
+ "No matching `is' or `renames' for `package' at"
" line "
(number-to-string (count-lines 1 (1+ current)))))))
(unless (looking-at "renames")
@@ -3865,7 +3862,7 @@ If GOTOTHEN is non-nil, point moves to the 'then' following 'if'."
((looking-at "do")
(unless (ada-search-ignore-string-comment
"\\<accept\\|return\\>" t)
- (error "Missing 'accept' or 'return' in front of 'do'"))))
+ (error "Missing `accept' or `return' in front of `do'"))))
(point))
(if noerror
@@ -4076,7 +4073,7 @@ Assumes point to be at the end of a statement."
(defun ada-looking-at-semi-or ()
- "Return t if looking at an 'or' following a semicolon."
+ "Return t if looking at an `or' following a semicolon."
(save-excursion
(and (looking-at "\\<or\\>")
(progn
@@ -4149,7 +4146,7 @@ Return nil if the private is part of the package name, as in
"type\\)\\>"))))))
(defun ada-search-ignore-complex-boolean (regexp backwardp)
- "Search for REGEXP, ignoring comments, strings, 'and then', 'or else'.
+ "Search for REGEXP, ignoring comments, strings, `and then', `or else'.
If BACKWARDP is non-nil, search backward; search forward otherwise."
(let (result)
(while (and (setq result (ada-search-ignore-string-comment regexp backwardp))
@@ -4369,7 +4366,7 @@ of the region. Otherwise, operate only on the current line."
(defun ada-move-to-end ()
"Move point to the end of the block around point.
-Moves to 'begin' if in a declarative part."
+Moves to `begin' if in a declarative part."
(interactive)
(let ((pos (point))
decl-start)
@@ -5293,7 +5290,7 @@ for `ada-procedure-start-regexp'."
(setq functype (buffer-substring (point)
(progn
(skip-chars-forward
- "a-zA-Z0-9_\.")
+ "a-zA-Z0-9_.")
(point))))))
;; look for next non WS
(cond
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
index f6125545b96..3b71c5987ed 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -1,6 +1,6 @@
;;; ada-prj.el --- GUI editing of project files for the ada-mode
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
@@ -309,13 +309,13 @@ where the compilation is done.")
"If you want to remotely compile, debug and
run your application, specify the name of a
remote machine here. This capability requires
-the 'rsh' protocol on the remote machine.")
+the `rsh' protocol on the remote machine.")
(ada-prj-field 'cross_prefix "Prefix used in for the cross tool chain"
"When working on multiple cross targets, it is
most convenient to specify the prefix of the
tool chain here. For instance, on PowerPc
-vxworks, you would enter 'powerpc-wrs-vxworks-'.
-To use JGNAT, enter 'j'.")
+vxworks, you would enter `powerpc-wrs-vxworks-'.
+To use JGNAT, enter `j'.")
)
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el
index 4d7530477c1..302bbc9a690 100644
--- a/lisp/progmodes/ada-stmt.el
+++ b/lisp/progmodes/ada-stmt.el
@@ -1,6 +1,6 @@
;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates
-;; Copyright (C) 1987, 1993-1994, 1996-2013 Free Software Foundation,
+;; Copyright (C) 1987, 1993-1994, 1996-2015 Free Software Foundation,
;; Inc.
;; Authors: Daniel Pfeiffer
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index d29fa8c1d36..0ea33c16878 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1,6 +1,6 @@
;; ada-xref.el --- for lookup and completion in Ada mode
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; Rolf Ebert <ebert@inf.enst.fr>
@@ -236,7 +236,7 @@ we need to use `/d' or the drive is never changed.")
"Associative list of project files with properties.
It has the format: (project project ...)
A project has the format: (project-file . project-plist)
-\(See 'apropos plist' for operations on property lists).
+\(See `apropos plist' for operations on property lists).
See `ada-default-prj-properties' for the list of valid properties.
The current project is retrieved with `ada-xref-current-project'.
Properties are retrieved with `ada-xref-get-project-field', set with
@@ -286,7 +286,7 @@ On Windows systems, this will properly handle .exe extension as well."
(ada-find-file-in-dir (concat exec-name ".exe") exec-path))))
(if result
result
- (error "'%s' not found in path" exec-name))))
+ (error "`%s' not found in path" exec-name))))
(defun ada-initialize-runtime-library (cross-prefix)
"Initialize the variables for the runtime library location.
@@ -342,9 +342,9 @@ CROSS-PREFIX is the prefix to use for the `gnatls' command."
)
(kill-buffer nil))))
- (set 'ada-xref-runtime-library-specs-path
+ (setq ada-xref-runtime-library-specs-path
(reverse ada-xref-runtime-library-specs-path))
- (set 'ada-xref-runtime-library-ali-path
+ (setq ada-xref-runtime-library-ali-path
(reverse ada-xref-runtime-library-ali-path))
))
@@ -420,7 +420,7 @@ As a special case, ${current} is replaced with the name of the current
file, minus extension but with directory, and ${full_current} is
replaced by the name including the extension."
- (while (string-match "\\(-[^-\$IO]*[IO]\\)?\${\\([^}]+\\)}" cmd-string)
+ (while (string-match "\\(-[^-$IO]*[IO]\\)?${\\([^}]+\\)}" cmd-string)
(let (value
(name (match-string 2 cmd-string)))
(cond
@@ -582,8 +582,8 @@ as defined in the project file."
(while dirs
(if (file-directory-p (car dirs))
- (set 'list (append list (file-name-all-completions string (car dirs)))))
- (set 'dirs (cdr dirs)))
+ (setq list (append list (file-name-all-completions string (car dirs)))))
+ (setq dirs (cdr dirs)))
(cond ((equal flag 'lambda)
(assoc string list))
(flag
@@ -651,12 +651,6 @@ Call `ada-require-project-file' first to ensure a project exists."
(find-file (car (cdr pos)))
(goto-char (car pos)))))
-(defun ada-convert-file-name (name)
- "Convert from NAME to a name that can be used by the compilation commands.
-This is overridden on VMS to convert from VMS filenames to Unix filenames."
- name)
-;; FIXME: use convert-standard-filename instead
-
(defun ada-set-default-project-file (file)
"Set FILE as the current project file."
(interactive "fProject file:")
@@ -673,7 +667,7 @@ the same base name as the Ada file, but extension given by
`ada-prj-file-extension' (default .adp). If not found, search for *.adp
in the current directory; if several are found, and NO-USER-QUESTION
is non-nil, prompt the user to select one. If none are found, return
-'default.adp'."
+\"default.adp\"."
(let (selected)
@@ -702,11 +696,11 @@ is non-nil, prompt the user to select one. If none are found, return
((file-exists-p first-choice)
;; filename.adp
- (set 'selected first-choice))
+ (setq selected first-choice))
((= (length prj-files) 1)
;; Exactly one project file was found in the current directory
- (set 'selected (car prj-files)))
+ (setq selected (car prj-files)))
((and (> (length prj-files) 1) (not no-user-question))
;; multiple project files in current directory, ask the user
@@ -732,7 +726,7 @@ is non-nil, prompt the user to select one. If none are found, return
(> choice (length prj-files)))
(setq choice (string-to-number
(read-from-minibuffer "Enter No. of your choice: "))))
- (set 'selected (nth (1- choice) prj-files))))
+ (setq selected (nth (1- choice) prj-files))))
((= (length prj-files) 0)
;; No project file in the current directory; ask user
@@ -742,7 +736,7 @@ is non-nil, prompt the user to select one. If none are found, return
(concat "project file [" ada-last-prj-file "]:")
nil ada-last-prj-file))
(unless (string= ada-last-prj-file "")
- (set 'selected ada-last-prj-file))))
+ (setq selected ada-last-prj-file))))
)))
(or selected "default.adp")
@@ -792,9 +786,9 @@ is non-nil, prompt the user to select one. If none are found, return
(setq prj-file (expand-file-name prj-file))
(if (string= (file-name-extension prj-file) "gpr")
- (set 'project (ada-gnat-parse-gpr project prj-file))
+ (setq project (ada-gnat-parse-gpr project prj-file))
- (set 'project (ada-parse-prj-file-1 prj-file project))
+ (setq project (ada-parse-prj-file-1 prj-file project))
)
;; Store the project properties
@@ -842,7 +836,7 @@ Return new value of PROJECT."
(substitute-in-file-name (match-string 2)))))
((string= (match-string 1) "build_dir")
- (set 'project
+ (setq project
(plist-put project 'build_dir
(file-name-as-directory (match-string 2)))))
@@ -884,7 +878,7 @@ Return new value of PROJECT."
(t
;; any other field in the file is just copied
- (set 'project (plist-put project
+ (setq project (plist-put project
(intern (match-string 1))
(match-string 2))))))
@@ -900,21 +894,21 @@ Return new value of PROJECT."
(let ((sep (plist-get project 'ada_project_path_sep)))
(setq ada_project_path (reverse ada_project_path))
(setq ada_project_path (mapconcat 'identity ada_project_path sep))
- (set 'project (plist-put project 'ada_project_path ada_project_path))
+ (setq project (plist-put project 'ada_project_path ada_project_path))
;; env var needed now for ada-gnat-parse-gpr
(setenv "ADA_PROJECT_PATH" ada_project_path)))
- (if debug_post_cmd (set 'project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
- (if debug_pre_cmd (set 'project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
- (if casing (set 'project (plist-put project 'casing (reverse casing))))
- (if check_cmd (set 'project (plist-put project 'check_cmd (reverse check_cmd))))
- (if comp_cmd (set 'project (plist-put project 'comp_cmd (reverse comp_cmd))))
- (if make_cmd (set 'project (plist-put project 'make_cmd (reverse make_cmd))))
- (if run_cmd (set 'project (plist-put project 'run_cmd (reverse run_cmd))))
+ (if debug_post_cmd (setq project (plist-put project 'debug_post_cmd (reverse debug_post_cmd))))
+ (if debug_pre_cmd (setq project (plist-put project 'debug_pre_cmd (reverse debug_pre_cmd))))
+ (if casing (setq project (plist-put project 'casing (reverse casing))))
+ (if check_cmd (setq project (plist-put project 'check_cmd (reverse check_cmd))))
+ (if comp_cmd (setq project (plist-put project 'comp_cmd (reverse comp_cmd))))
+ (if make_cmd (setq project (plist-put project 'make_cmd (reverse make_cmd))))
+ (if run_cmd (setq project (plist-put project 'run_cmd (reverse run_cmd))))
(if gpr_file
(progn
- (set 'project (ada-gnat-parse-gpr project gpr_file))
+ (setq project (ada-gnat-parse-gpr project gpr_file))
;; append Ada source and object directories to others from Emacs project file
(setq src_dir (append (plist-get project 'src_dir) src_dir))
(setq obj_dir (append (plist-get project 'obj_dir) obj_dir))
@@ -930,8 +924,8 @@ Return new value of PROJECT."
(ada-initialize-runtime-library (or (ada-xref-get-project-field 'cross_prefix) ""))
;;)
- (if obj_dir (set 'project (plist-put project 'obj_dir (reverse obj_dir))))
- (if src_dir (set 'project (plist-put project 'src_dir (reverse src_dir))))
+ (if obj_dir (setq project (plist-put project 'obj_dir (reverse obj_dir))))
+ (if src_dir (setq project (plist-put project 'src_dir (reverse src_dir))))
project
))
@@ -960,7 +954,7 @@ Return new value of PROJECT."
(append (mapcar 'directory-file-name compilation-search-path)
ada-search-directories))
- ;; return 't', for decent display in message buffer when called interactively
+ ;; return t, for decent display in message buffer when called interactively
t)
(defun ada-find-references (&optional pos arg local-only)
@@ -1052,9 +1046,9 @@ existing buffer `*gnatfind*', if there is one."
(if old-contents
(progn
(goto-char 1)
- (set 'buffer-read-only nil)
+ (setq buffer-read-only nil)
(insert old-contents)
- (set 'buffer-read-only t)
+ (setq buffer-read-only t)
(goto-char (point-max)))))
)
)
@@ -1194,9 +1188,9 @@ project file."
(objects (getenv "ADA_OBJECTS_PATH"))
(build-dir (ada-xref-get-project-field 'build_dir)))
(if include
- (set 'include (concat path-separator include)))
+ (setq include (concat path-separator include)))
(if objects
- (set 'objects (concat path-separator objects)))
+ (setq objects (concat path-separator objects)))
(cons
(concat "ADA_INCLUDE_PATH="
(mapconcat (lambda(x) (expand-file-name x build-dir))
@@ -1303,7 +1297,7 @@ If ARG is non-nil, ask for user confirmation."
;; Guess the command if it wasn't specified
(if (not command)
- (set 'command (list (file-name-sans-extension (buffer-name)))))
+ (setq command (list (file-name-sans-extension (buffer-name)))))
;; Modify the command to run remotely
(setq command (ada-remote (mapconcat 'identity command
@@ -1316,7 +1310,7 @@ If ARG is non-nil, ask for user confirmation."
;; Run the command
(with-current-buffer (get-buffer-create "*run*")
- (set 'buffer-read-only nil)
+ (setq buffer-read-only nil)
(erase-buffer)
(start-process "run" (current-buffer) shell-file-name
@@ -1352,7 +1346,7 @@ project file."
;; If the command was not given in the project file, start a bare gdb
(if (not cmd)
- (set 'cmd (concat ada-prj-default-debugger
+ (setq cmd (concat ada-prj-default-debugger
" "
(or executable-name
(file-name-sans-extension (buffer-file-name))))))
@@ -1368,18 +1362,18 @@ project file."
;; chance to fully manage it. Then it works fine with Enlightenment
;; as well
(let ((frame (make-frame '((visibility . nil)))))
- (set 'cmd (concat
+ (setq cmd (concat
cmd " --editor-window="
(cdr (assoc 'outer-window-id (frame-parameters frame)))))
(select-frame frame)))
;; Add a -fullname switch
;; Use the remote machine
- (set 'cmd (ada-remote (concat cmd " -fullname ")))
+ (setq cmd (ada-remote (concat cmd " -fullname ")))
;; Ask for confirmation if required
(if (or arg ada-xref-confirm-compile)
- (set 'cmd (read-from-minibuffer "enter command to debug: " cmd)))
+ (setq cmd (read-from-minibuffer "enter command to debug: " cmd)))
(let ((old-comint-exec (symbol-function 'comint-exec)))
@@ -1387,13 +1381,13 @@ project file."
;; FIXME: This is evil but luckily a nop under Emacs-21.3.50 ! -stef
(fset 'gud-gdb-massage-args (lambda (_file args) args))
- (set 'pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
+ (setq pre-cmd (mapconcat 'identity pre-cmd ada-command-separator))
(if (not (equal pre-cmd ""))
(setq pre-cmd (concat pre-cmd ada-command-separator)))
- (set 'post-cmd (mapconcat 'identity post-cmd "\n"))
+ (setq post-cmd (mapconcat 'identity post-cmd "\n"))
(if post-cmd
- (set 'post-cmd (concat post-cmd "\n")))
+ (setq post-cmd (concat post-cmd "\n")))
;; Temporarily replaces the definition of `comint-exec' so that we
@@ -1403,7 +1397,7 @@ project file."
`(lambda (buffer name command startfile switches)
(let (compilation-buffer-name-function)
(save-excursion
- (set 'compilation-buffer-name-function
+ (setq compilation-buffer-name-function
(lambda(x) (buffer-name buffer)))
(compile (ada-quote-cmd
(concat ,pre-cmd
@@ -1465,7 +1459,7 @@ by replacing the file extension with `.ali'."
(get-file-buffer ali-file-name))
(kill-buffer (get-file-buffer ali-file-name)))
- (let* ((name (ada-convert-file-name file))
+ (let* ((name (convert-standard-filename file))
(body-name (or (ada-get-body-name name) name)))
;; Always recompile the body when we can. We thus temporarily switch to a
@@ -1498,12 +1492,12 @@ by replacing the file extension with `.ali'."
"Search for FILE in DIR-LIST."
(let (found)
(while (and (not found) dir-list)
- (set 'found (concat (file-name-as-directory (car dir-list))
+ (setq found (concat (file-name-as-directory (car dir-list))
(file-name-nondirectory file)))
(unless (file-exists-p found)
- (set 'found nil))
- (set 'dir-list (cdr dir-list)))
+ (setq found nil))
+ (setq dir-list (cdr dir-list)))
found))
(defun ada-find-ali-file-in-dir (file)
@@ -1558,11 +1552,11 @@ the project file."
(while specs
(if (string-match (concat (regexp-quote (car specs)) "$")
file)
- (set 'is-spec t))
- (set 'specs (cdr specs)))))
+ (setq is-spec t))
+ (setq specs (cdr specs)))))
(if is-spec
- (set 'ali-file-name
+ (setq ali-file-name
(ada-find-ali-file-in-dir
(concat (file-name-base (ada-other-file-name)) ".ali"))))
@@ -1589,8 +1583,8 @@ the project file."
(while (and (not ali-file-name)
(string-match "^\\(.*\\)[.-][^.-]*" parent-name))
- (set 'parent-name (match-string 1 parent-name))
- (set 'ali-file-name (ada-find-ali-file-in-dir
+ (setq parent-name (match-string 1 parent-name))
+ (setq ali-file-name (ada-find-ali-file-in-dir
(concat parent-name ".ali")))
)
ali-file-name)))
@@ -1686,18 +1680,18 @@ macros `ada-name-of', `ada-line-of', `ada-column-of', `ada-file-of',..."
(if (and (= (char-before) ?\")
(= (char-after (+ (length (match-string 0)) (point))) ?\"))
(forward-char -1))
- (set 'identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
+ (setq identifier (regexp-quote (concat "\"" (match-string 0) "\""))))
(if (ada-in-string-p)
(error "Inside string or character constant"))
(if (looking-at (concat ada-keywords "[^a-zA-Z_]"))
(error "No cross-reference available for reserved keyword"))
(if (looking-at "[a-zA-Z0-9_]+")
- (set 'identifier (match-string 0))
+ (setq identifier (match-string 0))
(error "No identifier around")))
;; Build the identlist
- (set 'identlist (ada-make-identlist))
+ (setq identlist (ada-make-identlist))
(ada-set-name identlist (downcase identifier))
(ada-set-line identlist
(number-to-string (count-lines 1 (point))))
@@ -1725,12 +1719,12 @@ Information is extracted from the ali file."
(concat "^X [0-9]+ " (file-name-nondirectory (ada-file-of identlist)))
nil t)
(let ((bound (save-excursion (re-search-forward "^X " nil t))))
- (set 'declaration-found
+ (setq declaration-found
(re-search-forward
(concat "^" (ada-line-of identlist)
"." (ada-column-of identlist)
"[ *]" (ada-name-of identlist)
- "[{\[\(<= ]?\\(.*\\)$") bound t))
+ "[{[(<= ]?\\(.*\\)$") bound t))
(if declaration-found
(ada-set-on-declaration identlist t))
))
@@ -1743,7 +1737,7 @@ Information is extracted from the ali file."
;; Since we already know the number of the file, search for a direct
;; reference to it
(goto-char (point-min))
- (set 'declaration-found t)
+ (setq declaration-found t)
(ada-set-ali-index
identlist
(number-to-string (ada-find-file-number-in-ali
@@ -1762,7 +1756,7 @@ Information is extracted from the ali file."
(concat
"^[0-9]+.[0-9]+[ *]"
(ada-name-of identlist)
- "[ <{=\(\[]\\(.\\|\n\\.\\)*\\<"
+ "[ <{=([]\\(.\\|\n\\.\\)*\\<"
(ada-line-of identlist)
"[^0-9]"
(ada-column-of identlist) "\\>")
@@ -1771,7 +1765,7 @@ Information is extracted from the ali file."
;; If still not found, then either the declaration is unknown
;; or the source file has been modified since the ali file was
;; created
- (set 'declaration-found nil)
+ (setq declaration-found nil)
)
)
@@ -1785,8 +1779,8 @@ Information is extracted from the ali file."
(forward-line -1)
(beginning-of-line))
(unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
- (ada-name-of identlist) "[ <{=\(\[]"))
- (set 'declaration-found nil))))
+ (ada-name-of identlist) "[ <{=([]"))
+ (setq declaration-found nil))))
;; Still no success ! The ali file must be too old, and we need to
;; use a basic algorithm based on guesses. Note that this only happens
@@ -1794,7 +1788,7 @@ Information is extracted from the ali file."
;; automatically
(unless declaration-found
(if (ada-xref-find-in-modified-ali identlist)
- (set 'declaration-found t)
+ (setq declaration-found t)
;; No more idea to find the declaration. Give up
(progn
(kill-buffer ali-buffer)
@@ -1814,7 +1808,7 @@ Information is extracted from the ali file."
(forward-line 1)
(beginning-of-line)
(while (looking-at "^\\.\\(.*\\)")
- (set 'current-line (concat current-line (match-string 1)))
+ (setq current-line (concat current-line (match-string 1)))
(forward-line 1))
)
@@ -1860,7 +1854,7 @@ This function is disabled for operators, and only works for identifiers."
(goto-char (point-max))
(while (re-search-backward my-regexp nil t)
(save-excursion
- (set 'line-ali (count-lines 1 (point)))
+ (setq line-ali (count-lines 1 (point)))
(beginning-of-line)
;; have a look at the line and column numbers
(if (looking-at "^\\([0-9]+\\).\\([0-9]+\\)[ *]")
@@ -1948,7 +1942,7 @@ opens a new window to show the declaration."
;; Get all the possible locations
(string-match "^\\([0-9]+\\)[a-zA-Z+*]\\([0-9]+\\)[ *]" ali-line)
- (set 'locations (list (list (match-string 1 ali-line) ;; line
+ (setq locations (list (list (match-string 1 ali-line) ;; line
(match-string 2 ali-line) ;; column
(ada-declare-file-of identlist))))
(while (string-match "\\([0-9]+\\)[bc]\\(<[^>]+>\\)?\\([0-9]+\\)"
@@ -1968,16 +1962,16 @@ opens a new window to show the declaration."
(goto-char (point-min))
(re-search-forward "^D \\([a-zA-Z0-9_.-]+\\)" nil t
(string-to-number file-number))
- (set 'file (match-string 1))
+ (setq file (match-string 1))
)
;; Else get the nearest file
- (set 'file (ada-declare-file-of identlist)))
+ (setq file (ada-declare-file-of identlist)))
- (set 'locations (append locations (list (list line col file)))))
+ (setq locations (append locations (list (list line col file)))))
;; Add the specs at the end again, so that from the last body we go to
;; the specs
- (set 'locations (append locations (list (car locations))))
+ (setq locations (append locations (list (car locations))))
;; Find the new location we want to go to.
;; If we are on none of the locations listed, we simply go to the specs.
@@ -1996,10 +1990,10 @@ opens a new window to show the declaration."
col (nth 1 locations)
file (nth 2 locations)
locations nil)
- (set 'locations (cdr locations))))
+ (setq locations (cdr locations))))
;; Find the file in the source path
- (set 'file (ada-get-ada-file-name file (ada-file-of identlist)))
+ (setq file (ada-get-ada-file-name file (ada-file-of identlist)))
;; Kill the .ali buffer
(kill-buffer (current-buffer))
@@ -2044,10 +2038,10 @@ the declaration and documentation of the subprograms one is using."
" "
(shell-quote-argument (file-name-as-directory (car dirs)))
"*.ali")))
- (set 'dirs (cdr dirs)))
+ (setq dirs (cdr dirs)))
;; Now parse the output
- (set 'case-fold-search t)
+ (setq case-fold-search t)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(save-excursion
@@ -2058,12 +2052,12 @@ the declaration and documentation of the subprograms one is using."
(setq line (match-string 1)
column (match-string 2))
(re-search-backward "^X [0-9]+ \\(.*\\)$")
- (set 'file (list (match-string 1) line column))
+ (setq file (list (match-string 1) line column))
;; There could be duplicate choices, because of the structure
;; of the .ali files
(unless (member file list)
- (set 'list (append list (list file))))))))
+ (setq list (append list (list file))))))))
;; Current buffer is still "*grep*"
(kill-buffer "*grep*")
@@ -2078,7 +2072,7 @@ the declaration and documentation of the subprograms one is using."
;; Only one choice => Do the cross-reference
((= (length list) 1)
- (set 'file (ada-find-src-file-in-dir (caar list)))
+ (setq file (ada-find-src-file-in-dir (caar list)))
(if file
(ada-xref-change-buffer file
(string-to-number (nth 1 (car list)))
@@ -2117,10 +2111,10 @@ the declaration and documentation of the subprograms one is using."
(string-to-number
(read-from-minibuffer "Enter No. of your choice: "))))
)
- (set 'choice (1- choice))
+ (setq choice (1- choice))
(kill-buffer "*choice list*")
- (set 'file (ada-find-src-file-in-dir (car (nth choice list))))
+ (setq file (ada-find-src-file-in-dir (car (nth choice list))))
(if file
(ada-xref-change-buffer file
(string-to-number (nth 1 (nth choice list)))
@@ -2144,7 +2138,7 @@ If OTHER-FRAME is non-nil, creates a new frame to show the file."
(if ada-xref-other-buffer
(if other-frame
(find-file-other-frame file)
- (set 'declaration-buffer (find-file-noselect file))
+ (setq declaration-buffer (find-file-noselect file))
(set-buffer declaration-buffer)
(switch-to-buffer-other-window declaration-buffer)
)
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 56680f23a8e..9cac400c27b 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,8 +1,8 @@
;;; antlr-mode.el --- major mode for ANTLR grammar files
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
-;; Author: Christoph.Wedler@sap.com
+;; Author: Christoph Wedler <Christoph.Wedler@sap.com>
;; Keywords: languages, ANTLR, code generator
;; Version: 2.2c
;; X-URL: http://antlr-mode.sourceforge.net/
@@ -171,17 +171,13 @@
(let ((buffer-undo-list t) (inhibit-read-only t)
,@(unless (featurep 'xemacs)
'((inhibit-point-motion-hooks t) deactivate-mark))
- before-change-functions after-change-functions
+ (inhibit-modification-hooks t)
buffer-file-name buffer-file-truename)
,@body)
(and (not ,modified) (buffer-modified-p)
(set-buffer-modified-p nil)))))))
(put 'save-buffer-state-x 'lisp-indent-function 0)
-;; get rid of byte-compile warnings
-(eval-when-compile
- (require 'cc-mode))
-
(defvar outline-level)
(defvar imenu-use-markers)
(defvar imenu-create-index-function)
@@ -229,7 +225,7 @@ variable list\" near the end of the file, see
(c++-mode "C++" "\"Cpp\"" "Cpp"))
"List of ANTLR's supported languages.
Each element in this list looks like
- \(MAJOR-MODE MODELINE-STRING OPTION-VALUE...)
+ (MAJOR-MODE MODELINE-STRING OPTION-VALUE...)
MAJOR-MODE, the major mode of the code in the grammar's actions, is the
value of `antlr-language' if the first group in the string matched by
@@ -247,7 +243,7 @@ also displayed in the mode line next to \"Antlr\"."
(defcustom antlr-language-limit-n-regexp
'(8192 . "language[ \t]*=[ \t]*\\(\"?[A-Z][A-Za-z_]*\"?\\)")
"Used to set a reasonable value for `antlr-language'.
-Looks like \(LIMIT \. REGEXP). Search for REGEXP from the beginning of
+Looks like \(LIMIT . REGEXP). Search for REGEXP from the beginning of
the buffer to LIMIT and use the first group in the matched string to set
the language according to `antlr-language-alist'."
:group 'antlr
@@ -452,7 +448,7 @@ The standard value is (\"file\" \"grammar\" \"rule\" \"subrule\"). See
"Generate default exception handler for each rule? "))
("codeGenMakeSwitchThreshold" nil
(20600 antlr-read-value
- "Min number of alternatives for 'switch': "))
+ "Min number of alternatives for `switch': "))
("codeGenBitsetTestThreshold" nil
(20600 antlr-read-value
"Min size of lookahead set for bitset test: "))
@@ -624,7 +620,7 @@ COUNT starts with 1. GEN-SEP is used to separate long variable values."
(c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp")))
"Language dependent formats which specify generated files.
Each element in this list looks looks like
- \(MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)).
+ (MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)).
The element whose MAJOR-MODE is equal to `antlr-language' is used to
specify the generated files which are language dependent. See variable
@@ -783,7 +779,7 @@ fontification, see `antlr-font-lock-keywords-alist'.
While calculating the decoration level for actions, `major-mode' is
bound to `antlr-language'. For example, with value
- \((java-mode \. 2) (c++-mode \. 0))
+ ((java-mode . 2) (c++-mode . 0))
Java actions are fontified with level 2 and C++ actions are not
fontified at all."
:group 'antlr
@@ -821,7 +817,7 @@ Do not change the value of this constant.")
c++-font-lock-keywords-3))
"List of font-lock keywords for actions in the grammar.
Each element in this list looks like
- \(MAJOR-MODE KEYWORD...)
+ (MAJOR-MODE KEYWORD...)
If `antlr-language' is equal to MAJOR-MODE, the KEYWORDs are the
font-lock keywords according to `font-lock-defaults' used for the code
@@ -1574,8 +1570,8 @@ Inserting an option with this command works as follows:
4. Ask user for confirmation if the given OPTION does not seem to be a
valid option to insert into the current file.
5. Find a correct position to insert the option.
- 6. Depending on the option, insert it the following way \(inserting an
- option also means inserting the option section if necessary\):
+ 6. Depending on the option, insert it the following way (inserting an
+ option also means inserting the option section if necessary):
- Insert the option and let user insert the value at point.
- Read a value (with completion) from the minibuffer, using a
previous value as initial contents, and insert option with value.
@@ -1691,9 +1687,9 @@ Return \(LEVEL OPTION LOCATION)."
(defun antlr-option-kind (requested)
"Return level and location for option to insert near point.
Call function `antlr-option-level' with argument REQUESTED. If the
-result is nil, return \(REQUESTED \. error). If the result has the
-non-nil value LEVEL, return \(LEVEL \. LOCATION) where LOCATION looks
-like \(AREA \. PLACE), see `antlr-option-location'."
+result is nil, return \(REQUESTED . error). If the result has the
+non-nil value LEVEL, return \(LEVEL . LOCATION) where LOCATION looks
+like \(AREA . PLACE), see `antlr-option-location'."
(save-excursion
(save-restriction
(let ((min0 (point-min)) ; before `widen'!
@@ -1849,7 +1845,7 @@ WARNING: this may alter `match-data'."
(defun antlr-insert-option-do (level option old area pos)
"Insert option into buffer at position POS.
Insert option of level LEVEL and name OPTION. If OLD is non-nil, an
-options area is already exists. If OLD looks like \(BEG \. END), the
+options area is already exists. If OLD looks like \(BEG . END), the
option already exists. Then, BEG is the start position of the option
value, the position of the `=' or nil, and END is the end position of
the option value or nil.
@@ -2108,7 +2104,7 @@ Called in PHASE `before-input', see `antlr-options-alists'."
(defun antlr-file-dependencies ()
"Return dependencies for grammar in current buffer.
-The result looks like \(FILE \(CLASSES \. SUPERS) VOCABS \. LANGUAGE)
+The result looks like \(FILE \(CLASSES . SUPERS) VOCABS . LANGUAGE)
where CLASSES = ((CLASS . CLASS-EVOCAB) ...),
SUPERS = ((SUPER . USE-EVOCAB-P) ...), and
VOCABS = ((EVOCAB ...) . (IVOCAB ...))
@@ -2172,8 +2168,8 @@ its export vocabulary is used as an import vocabulary."
(defun antlr-directory-dependencies (dirname)
"Return dependencies for all grammar files in directory DIRNAME.
-The result looks like \((CLASS-SPEC ...) \. \(FILE-DEP ...))
- where CLASS-SPEC = (CLASS (FILE \. EVOCAB) ...).
+The result looks like \((CLASS-SPEC ...) . \(FILE-DEP ...))
+ where CLASS-SPEC = (CLASS (FILE . EVOCAB) ...).
FILE-DEP are the dependencies for each grammar file in DIRNAME, see
`antlr-file-dependencies'. For each grammar class CLASS, FILE is a
@@ -2224,7 +2220,7 @@ The result looks like \(OPTION WITH-UNKNOWN GLIB ...). OPTION is the
complete \"-glib\" option. WITH-UNKNOWN is t if there is none or more
than one grammar file for at least one super grammar.
-Each GLIB looks like \(GRAMMAR-FILE \. EVOCAB). GRAMMAR-FILE is a file
+Each GLIB looks like \(GRAMMAR-FILE . EVOCAB). GRAMMAR-FILE is a file
in which a super-grammar is defined. EVOCAB is the value of the export
vocabulary of the super-grammar or nil if it is not needed."
;; If the superclass is defined in the same file, that file will be included
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 27114af0dc5..7df6a5d1de4 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -1,9 +1,9 @@
;;; asm-mode.el --- mode for editing assembler code
-;; Copyright (C) 1991, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 2001-2015 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tools, languages
;; This file is part of GNU Emacs.
@@ -172,7 +172,7 @@ Special commands:
;; Simple `;' comments go to the comment-column.
(and (looking-at "\\s<\\(\\S<\\|\\'\\)") comment-column)
;; The rest goes at the first tab stop.
- (or (car tab-stop-list) tab-width)))
+ (or (indent-next-tab-stop 0))))
(defun asm-colon ()
"Insert a colon; if it follows a label, delete the label's indentation."
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index e6eaea985af..0bcc315446c 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,6 +1,6 @@
;;; autoconf.el --- mode for editing Autoconf configure.ac files
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages
@@ -79,7 +79,8 @@ searching backwards at another AC_... command."
(setq-local parens-require-spaces nil) ; for M4 arg lists
(setq-local defun-prompt-regexp "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
(setq-local comment-start "dnl ")
- (setq-local comment-start-skip "\\(?:\\(\\W\\|\\`\\)dnl\\|#\\) +")
+ ;; We want to avoid matching "dnl" in other text.
+ (setq-local comment-start-skip "\\(?:\\(\\W\\|^\\)dnl\\|#\\) +")
(setq-local syntax-propertize-function
(syntax-propertize-rules ("\\<dnl\\>" (0 "<"))))
(setq-local font-lock-defaults
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 2b6f9d3434d..2c5f192bf87 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -1,6 +1,6 @@
;;; bat-mode.el --- Major mode for editing DOS/Windows scripts
-;; Copyright (C) 2003, 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003, 2008-2015 Free Software Foundation, Inc.
;; Author: Arni Magnusson <arnima@hafro.is>
;; Keywords: languages
@@ -78,11 +78,11 @@
"goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start"))
(UNIX
'("bash" "cat" "cp" "fgrep" "grep" "ls" "sed" "sh" "mv" "rm")))
- `(("\\<_\\(call\\|goto\\)\\_>[ \t]+%?\\([A-Za-z0-9-_\\:.]+\\)%?"
+ `(("\\_<\\(call\\|goto\\)\\_>[ \t]+%?\\([A-Za-z0-9-_\\:.]+\\)%?"
(2 font-lock-constant-face t))
("^:[^:].*"
. 'bat-label-face)
- ("\\<_\\(defined\\|set\\)\\_>[ \t]*\\(\\w+\\)"
+ ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\w+\\)"
(2 font-lock-variable-name-face))
("%\\(\\w+\\)%?"
(1 font-lock-variable-name-face))
@@ -120,6 +120,7 @@
(defvar bat-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\n ">" table)
+ (modify-syntax-entry ?\" "\"" table)
;; Beware: `w' should not be used for non-alphabetic chars.
(modify-syntax-entry ?~ "_" table)
(modify-syntax-entry ?% "." table)
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 7ac549cc229..a78c57c2053 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -1,6 +1,6 @@
;; bug-reference.el --- buttonize bug references
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 21 Mar 2007
@@ -58,7 +58,7 @@ It can use `match-string' to get parts matched against
There is no default setting for this, it must be set per file.
If you set it to a symbol in the file Local Variables section,
you need to add a `bug-reference-url-format' property to it:
-\(put 'my-bug-reference-url-format 'bug-reference-url-format t)
+\(put \\='my-bug-reference-url-format \\='bug-reference-url-format t)
so that it is considered safe, see `enable-local-variables'.")
;;;###autoload
diff --git a/lisp/progmodes/cap-words.el b/lisp/progmodes/cap-words.el
deleted file mode 100644
index 3411340ed6d..00000000000
--- a/lisp/progmodes/cap-words.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; cap-words.el --- minor mode for motion in CapitalizedWordIdentifiers
-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
-
-;; Author: Dave Love <fx@gnu.org>
-;; Keywords: languages
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Provides Capitalized Words minor mode for word movement in
-;; identifiers CapitalizedLikeThis.
-
-;; Note that the same effect could be obtained by frobbing the
-;; category of upper case characters to produce word boundaries, but
-;; the necessary processing isn't done for ASCII characters.
-
-;; Fixme: This doesn't work properly for mouse double clicks.
-
-;;; Code:
-
-(defun capitalized-find-word-boundary (pos limit)
- "Function for use in `find-word-boundary-function-table'.
-Looks for word boundaries before capitals."
- (save-excursion
- (goto-char pos)
- (let (case-fold-search)
- (if (<= pos limit)
- ;; Fixme: Are these regexps the best?
- (or (and (re-search-forward "\\=.\\w*[[:upper:]]"
- limit t)
- (progn (backward-char)
- t))
- (re-search-forward "\\>" limit t))
- (or (re-search-backward "[[:upper:]]\\w*\\=" limit t)
- (re-search-backward "\\<" limit t))))
- (point)))
-
-
-(defconst capitalized-find-word-boundary-function-table
- (let ((tab (make-char-table nil)))
- (set-char-table-range tab t #'capitalized-find-word-boundary)
- tab)
- "Assigned to `find-word-boundary-function-table' in Capitalized Words mode.")
-
-;;;###autoload
-(define-minor-mode capitalized-words-mode
- "Toggle Capitalized Words mode.
-With a prefix argument ARG, enable Capitalized Words mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
-
-Capitalized Words mode is a buffer-local minor mode. When
-enabled, a word boundary occurs immediately before an uppercase
-letter in a symbol. This is in addition to all the normal
-boundaries given by the syntax and category tables. There is no
-restriction to ASCII.
-
-E.g. the beginning of words in the following identifier are as marked:
-
- capitalizedWorDD
- ^ ^ ^^
-
-Note that these word boundaries only apply for word motion and
-marking commands such as \\[forward-word]. This mode does not affect word
-boundaries found by regexp matching (`\\>', `\\w' &c).
-
-This style of identifiers is common in environments like Java ones,
-where underscores aren't trendy enough. Capitalization rules are
-sometimes part of the language, e.g. Haskell, which may thus encourage
-such a style. It is appropriate to add `capitalized-words-mode' to
-the mode hook for programming language modes in which you encounter
-variables like this, e.g. `java-mode-hook'. It's unlikely to cause
-trouble if such identifiers aren't used.
-
-See also `glasses-mode' and `studlify-word'.
-Obsoletes `c-forward-into-nomenclature'."
- nil " Caps" nil :group 'programming
- (set (make-local-variable 'find-word-boundary-function-table)
- capitalized-find-word-boundary-function-table))
-
-(provide 'cap-words)
-
-;;; cap-words.el ends here
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 33836f25335..1e3cb8e16f9 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -1,6 +1,6 @@
;;; cc-align.el --- custom indentation functions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -325,10 +325,10 @@ operator you typically want to use it together with some other line-up
settings, e.g. as follows \(the arglist-close setting is just a
suggestion to get a consistent style):
-\(c-set-offset 'arglist-cont '(c-lineup-arglist-operators 0))
-\(c-set-offset 'arglist-cont-nonempty '(c-lineup-arglist-operators
+\(c-set-offset \\='arglist-cont \\='(c-lineup-arglist-operators 0))
+\(c-set-offset \\='arglist-cont-nonempty \\='(c-lineup-arglist-operators
c-lineup-arglist))
-\(c-set-offset 'arglist-close '(c-lineup-arglist-close-under-paren))
+\(c-set-offset \\='arglist-close \\='(c-lineup-arglist-close-under-paren))
Works with: arglist-cont, arglist-cont-nonempty."
(save-excursion
@@ -1075,7 +1075,7 @@ Works with: brace-list-entry, brace-entry-open, statement,
arglist-cont."
(save-excursion
(goto-char (c-langelem-pos langelem))
- (when (looking-at "\\s\(")
+ (when (looking-at "\\s(")
(if (c-go-up-list-backward)
(let ((pos (point)))
(back-to-indentation)
@@ -1093,24 +1093,24 @@ v beg of preceding constr v beg of preceding constr
const char msg[] = if (!running)
\"Some text.\"; error(\"Not running!\");
-#define X(A, B) \ #define X(A, B) \
-do { \ <-> do { \ <- c-lineup-cpp-define
- printf (A, B); \ printf (A, B); \
+#define X(A, B) \\ #define X(A, B) \\
+do { \\ <-> do { \\ <- c-lineup-cpp-define
+ printf (A, B); \\ printf (A, B); \\
} while (0) } while (0)
If `c-syntactic-indentation-in-macros' is non-nil, the function
returns the relative indentation to the macro start line to allow
accumulation with other offsets. E.g. in the following cases,
cpp-define-intro is combined with the statement-block-intro that comes
-from the \"do {\" that hangs on the \"#define\" line:
+from the `do {' that hangs on the `#define' line:
int dribble() {
const char msg[] = if (!running)
\"Some text.\"; error(\"Not running!\");
-#define X(A, B) do { \ #define X(A, B) do { \
- printf (A, B); \ <-> printf (A, B); \ <- c-lineup-cpp-define
- this->refs++; \ this->refs++; \
+#define X(A, B) do { \\ #define X(A, B) do { \\
+ printf (A, B); \\ <-> printf (A, B); \\ <- c-lineup-cpp-define
+ this->refs++; \\ this->refs++; \\
} while (0) <-> } while (0) <- c-lineup-cpp-define
The relative indentation returned by `c-lineup-cpp-define' is zero and
@@ -1229,6 +1229,18 @@ Works with: Any syntactic symbol."
(back-to-indentation)
(vector (current-column))))
+(defun c-lineup-respect-col-0 (langelem)
+ "If the current line starts at column 0, return [0]. Otherwise return nil.
+
+This can be used for comments (in conjunction with, say,
+`c-lineup-comment'), to keep comments already at column 0
+anchored there, but reindent other comments."
+ (save-excursion
+ (back-to-indentation)
+ (if (eq (current-column) 0)
+ [0]
+ nil)))
+
(defun c-snug-do-while (syntax pos)
"Dynamically calculate brace hanginess for do-while statements.
@@ -1333,4 +1345,8 @@ For other semicolon contexts, no determination is made."
(cc-provide 'cc-align)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-align.el ends here
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index b5216b43ed9..077a18cc597 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -1,10 +1,10 @@
;;; cc-awk.el --- AWK specific code within cc-mode.
-;; Copyright (C) 1988, 1994, 1996, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1994, 1996, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: AWK, cc-mode, unix, languages
;; Package: cc-mode
@@ -61,6 +61,7 @@
(cc-bytecomp-defun c-backward-token-1)
(cc-bytecomp-defun c-beginning-of-statement-1)
(cc-bytecomp-defun c-backward-sws)
+(cc-bytecomp-defun c-forward-sws)
(defvar awk-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -214,7 +215,7 @@
(defconst c-awk-neutrals*-re
(concat "\\(" c-awk-neutral-re "\\)*"))
;; A (possibly empty) string of neutral characters (or character pairs).
-(defconst c-awk-var-num-ket-re "[]\)0-9a-zA-Z_$.\x80-\xff]+")
+(defconst c-awk-var-num-ket-re "[])0-9a-zA-Z_$.\x80-\xff]+")
;; Matches a char which is a constituent of a variable or number, or a ket
;; (i.e. closing bracKET), round or square. Assume that all characters \x80 to
;; \xff are "letters".
@@ -226,7 +227,7 @@
;; will only work when there won't be a preceding " or / before the sought /
;; to foul things up.
(defconst c-awk-non-arith-op-bra-re
- "[[\({&=:!><,?;'~|]")
+ "[[({&=:!><,?;'~|]")
;; Matches an opening BRAcket (of any sort), or any operator character
;; apart from +,-,/,*,%. For the purpose at hand (detecting a / which is a
;; regexp bracket) these arith ops are unnecessary and a pain, because of "++"
@@ -265,7 +266,7 @@
;; Matches optional whitespace followed by a "/" with string syntax (a matched
;; regexp delimiter).
(defconst c-awk-space*-unclosed-regexp-/-re
- (concat c-awk-escaped-nls*-with-space* "\\s\|"))
+ (concat c-awk-escaped-nls*-with-space* "\\s|"))
;; Matches optional whitespace followed by a "/" with string fence syntax (an
;; unmatched regexp delimiter).
@@ -1146,4 +1147,8 @@ comment at the start of cc-engine.el for more info."
(cc-provide 'cc-awk) ; Changed from 'awk-mode, ACM 2002/5/21
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; awk-mode.el ends here
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 337a5292417..81b7a822b82 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -1,6 +1,6 @@
;;; cc-bytecomp.el --- compile time setup for proper compilation
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Martin Stjernholm
;; Maintainer: bug-cc-mode@gnu.org
@@ -65,8 +65,7 @@
;; elsewhere in the load path.
;;
;; To suppress byte compiler warnings, use the macros
-;; `cc-bytecomp-defun', `cc-bytecomp-defvar',
-;; `cc-bytecomp-obsolete-fun', and `cc-bytecomp-obsolete-var'.
+;; `cc-bytecomp-defun' and `cc-bytecomp-defvar'.
;;
;; This file is not used at all after the package has been byte
;; compiled. It is however necessary when running uncompiled.
@@ -78,19 +77,72 @@
(defvar cc-bytecomp-original-functions nil)
(defvar cc-bytecomp-original-properties nil)
(defvar cc-bytecomp-loaded-files nil)
+
+(setq cc-bytecomp-unbound-variables nil)
+(setq cc-bytecomp-original-functions nil)
+(setq cc-bytecomp-original-properties nil)
+(setq cc-bytecomp-loaded-files nil)
+
(defvar cc-bytecomp-environment-set nil)
(defmacro cc-bytecomp-debug-msg (&rest args)
;;`(message ,@args)
)
+(defun cc-bytecomp-compiling-or-loading ()
+ ;; Determine whether byte-compilation or loading is currently active,
+ ;; returning 'compiling, 'loading or nil.
+ ;; If both are active, the "innermost" activity counts. Note that
+ ;; compilation can trigger loading (various `require' type forms)
+ ;; and loading can trigger compilation (the package manager does
+ ;; this). We walk the lisp stack if necessary.
+ (cond
+ ((and load-in-progress
+ (boundp 'byte-compile-dest-file)
+ (stringp byte-compile-dest-file))
+ (let ((n 0) elt)
+ (while (and
+ (setq elt (backtrace-frame n))
+ (not (and (car elt)
+ (memq (cadr elt)
+ '(load require
+ byte-compile-file byte-recompile-directory
+ batch-byte-compile)))))
+ (setq n (1+ n)))
+ (cond
+ ((memq (cadr elt) '(load require))
+ 'loading)
+ ((memq (cadr elt) '(byte-compile-file
+ byte-recompile-directory
+ batch-byte-compile))
+ 'compiling)
+ (t ; Can't happen.
+ (message "cc-bytecomp-compiling-or-loading: System flags spuriously set")
+ nil))))
+ (load-in-progress
+ ;; Being loaded.
+ 'loading)
+ ((and (boundp 'byte-compile-dest-file)
+ (stringp byte-compile-dest-file))
+ ;; Being compiled.
+ 'compiling)
+ (t
+ ;; Being evaluated interactively.
+ nil)))
+
+(defsubst cc-bytecomp-is-compiling ()
+ "Return non-nil if eval'ed during compilation."
+ (eq (cc-bytecomp-compiling-or-loading) 'compiling))
+
+(defsubst cc-bytecomp-is-loading ()
+ "Return non-nil if eval'ed during loading.
+Nil will be returned if we're in a compilation triggered by the loading."
+ (eq (cc-bytecomp-compiling-or-loading) 'loading))
+
(defun cc-bytecomp-setup-environment ()
;; Eval'ed during compilation to setup variables, functions etc
;; declared with `cc-bytecomp-defvar' et al.
- (if (not load-in-progress)
- ;; Look at `load-in-progress' to tell whether we're called
- ;; directly in the file being compiled or just from some file
- ;; being loaded during compilation.
+ (if (not (cc-bytecomp-is-loading))
(let (p)
(if cc-bytecomp-environment-set
(error "Byte compilation environment already set - \
@@ -138,7 +190,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
(defun cc-bytecomp-restore-environment ()
;; Eval'ed during compilation to restore variables, functions etc
;; declared with `cc-bytecomp-defvar' et al.
- (if (not load-in-progress)
+ (if (not (cc-bytecomp-is-loading))
(let (p)
(setq p cc-bytecomp-unbound-variables)
(while p
@@ -244,7 +296,9 @@ Having cyclic cc-require's will result in infinite recursion. That's
somewhat intentional."
`(progn
(eval-when-compile
- (setq cc-bytecomp-noruntime-functions byte-compile-noruntime-functions)
+ (if (boundp 'byte-compile-noruntime-functions) ; in case load uncompiled
+ (setq cc-bytecomp-noruntime-functions
+ byte-compile-noruntime-functions))
(cc-bytecomp-load (symbol-name ,cc-part)))
;; Hack to suppress spurious "might not be defined at runtime" warnings.
;; The basic issue is that
@@ -280,8 +334,7 @@ use within `eval-when-compile'."
`(eval-when-compile
(if (and (fboundp 'cc-bytecomp-is-compiling)
(cc-bytecomp-is-compiling))
- (if (or (not load-in-progress)
- (not (featurep ,cc-part)))
+ (if (not (featurep ,cc-part))
(cc-bytecomp-load (symbol-name ,cc-part)))
(require ,cc-part))))
@@ -294,12 +347,6 @@ afterwards. Don't use within `eval-when-compile'."
(require ,feature)
(eval-when-compile (cc-bytecomp-setup-environment))))
-(defun cc-bytecomp-is-compiling ()
- "Return non-nil if eval'ed during compilation. Don't use outside
-`eval-when-compile'."
- (and (boundp 'byte-compile-dest-file)
- (stringp byte-compile-dest-file)))
-
(defmacro cc-bytecomp-defvar (var)
"Binds the symbol as a variable during compilation of the file,
to silence the byte compiler. Don't use within `eval-when-compile'."
@@ -313,8 +360,7 @@ to silence the byte compiler. Don't use within `eval-when-compile'."
"cc-bytecomp-defvar: Saving %s (as unbound)" ',var)
(setq cc-bytecomp-unbound-variables
(cons ',var cc-bytecomp-unbound-variables))))
- (if (and (cc-bytecomp-is-compiling)
- (not load-in-progress))
+ (if (cc-bytecomp-is-compiling)
(progn
(defvar ,var)
(set ',var (intern (concat "cc-bytecomp-ignore-var:"
@@ -342,8 +388,7 @@ at compile time, e.g. for macros and inline functions."
(setq cc-bytecomp-original-functions
(cons (list ',fun nil 'unbound)
cc-bytecomp-original-functions))))
- (if (and (cc-bytecomp-is-compiling)
- (not load-in-progress))
+ (if (cc-bytecomp-is-compiling)
(progn
(fset ',fun (intern (concat "cc-bytecomp-ignore-fun:"
(symbol-name ',fun))))
@@ -368,33 +413,6 @@ the file. Don't use outside `eval-when-compile'."
"cc-bytecomp-put: Bound property %s for %s to %s"
,propname ,symbol ,value)))
-(defmacro cc-bytecomp-obsolete-var (symbol)
- "Suppress warnings that the given symbol is an obsolete variable.
-Don't use within `eval-when-compile'."
- `(eval-when-compile
- (if (get ',symbol 'byte-obsolete-variable)
- (cc-bytecomp-put ',symbol 'byte-obsolete-variable nil)
- ;; This avoids a superfluous compiler warning
- ;; about calling `get' for effect.
- t)))
-
-(defun cc-bytecomp-ignore-obsolete (form)
- ;; Wraps a call to `byte-compile-obsolete' that suppresses the warning.
- (let ((byte-compile-warnings byte-compile-warnings))
- (byte-compile-disable-warning 'obsolete)
- (byte-compile-obsolete form)))
-
-(defmacro cc-bytecomp-obsolete-fun (symbol)
- "Suppress warnings that the given symbol is an obsolete function.
-Don't use within `eval-when-compile'."
- `(eval-when-compile
- (if (eq (get ',symbol 'byte-compile) 'byte-compile-obsolete)
- (cc-bytecomp-put ',symbol 'byte-compile
- 'cc-bytecomp-ignore-obsolete)
- ;; This avoids a superfluous compiler warning
- ;; about calling `get' for effect.
- t)))
-
(defmacro cc-bytecomp-boundp (symbol)
"Return non-nil if the given symbol is bound as a variable outside
the compilation. This is the same as using `boundp' but additionally
@@ -421,4 +439,8 @@ exclude any functions that have been bound during compilation with
(provide 'cc-bytecomp)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-bytecomp.el ends here
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index dc6ed1348d1..32ce8c6a249 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1,6 +1,6 @@
;;; cc-cmds.el --- user level commands for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -258,9 +258,11 @@ With universal argument, inserts the analysis as a comment on that line."
"a" "")
(if c-hungry-delete-key "h" "")
(if (and
- ;; subword might not be loaded.
- (boundp 'subword-mode)
- (symbol-value 'subword-mode))
+ ;; (cc-)subword might not be loaded.
+ (boundp 'c-subword-mode)
+ (symbol-value 'c-subword-mode))
+ ;; FIXME: subword-mode already comes with its
+ ;; own lighter!
"w"
"")))
;; FIXME: Derived modes might want to use something else
@@ -356,6 +358,8 @@ left out."
(interactive "P")
(setq c-electric-flag (c-calculate-state arg c-electric-flag))
(c-update-modeline)
+ (when (fboundp 'electric-indent-local-mode) ; Emacs 24.4 or later.
+ (electric-indent-local-mode (if c-electric-flag 1 0)))
(c-keep-region-active))
@@ -424,7 +428,7 @@ the function `delete-forward-p' is defined and returns non-nil, it
deletes forward. Otherwise it deletes backward.
Note: This is the way in XEmacs to choose the correct action for the
-\[delete] key, whichever key that means. Other flavors don't use this
+[delete] key, whichever key that means. Other flavors don't use this
function to control that."
(interactive "*P")
(if (and (fboundp 'delete-forward-p)
@@ -441,7 +445,7 @@ forward using `c-hungry-delete-forward'. Otherwise it deletes
backward using `c-hungry-backspace'.
Note: This is the way in XEmacs to choose the correct action for the
-\[delete] key, whichever key that means. Other flavors don't use this
+[delete] key, whichever key that means. Other flavors don't use this
function to control that."
(interactive)
(if (and (fboundp 'delete-forward-p)
@@ -1088,7 +1092,7 @@ numeric argument is supplied, or the point is inside a literal."
(interactive "*P")
(let ((c-echo-syntactic-information-p nil)
- final-pos close-paren-inserted found-delim case-fold-search)
+ final-pos found-delim case-fold-search)
(self-insert-command (prefix-numeric-value arg))
(setq final-pos (point))
@@ -1139,9 +1143,9 @@ numeric argument is supplied, or the point is inside a literal."
(eq (char-before) ?<))
(progn
(backward-char)
- (looking-at "\\s\("))))
+ (looking-at "\\s("))))
(and (eq (char-after) ?<)
- (not (looking-at "\\s\("))
+ (not (looking-at "\\s("))
(progn (c-backward-syntactic-ws)
(c-simple-skip-symbol-backward))
(or (looking-at c-opt-<>-sexp-key)
@@ -1153,11 +1157,12 @@ numeric argument is supplied, or the point is inside a literal."
(when (and (eq (char-before) ?>)
(not executing-kbd-macro)
blink-paren-function)
- ;; Note: Most paren blink functions, such as the standard
- ;; `blink-matching-open', currently doesn't handle paren chars
- ;; marked with text properties very well. Maybe we should avoid
- ;; this call for the time being?
- (funcall blink-paren-function)))))
+ ;; Currently (2014-10-19), the syntax-table text properties on < and >
+ ;; are only applied in code called during Emacs redisplay. We thus
+ ;; explicitly cause a redisplay so that these properties have been
+ ;; applied when `blink-paren-function' gets called.
+ (sit-for 0)
+ (funcall blink-paren-function)))))
(defun c-electric-paren (arg)
"Insert a parenthesis.
@@ -1301,20 +1306,46 @@ keyword on the line, the keyword is not inserted inside a literal, and
(declare-function subword-forward "subword" (&optional arg))
(declare-function subword-backward "subword" (&optional arg))
+(cond
+ ((and (fboundp 'subword-mode) (not (fboundp 'c-subword-mode)))
+ ;; Recent Emacsen come with their own subword support. Use that.
+ (define-obsolete-function-alias 'c-subword-mode 'subword-mode "24.3")
+ (define-obsolete-variable-alias 'c-subword-mode 'subword-mode "24.3"))
+ (t
+ ;; Autoload directive for emacsen that doesn't have an older CC Mode
+ ;; version in the dist.
+ (autoload 'c-subword-mode "cc-subword"
+ "Mode enabling subword movement and editing keys." t)))
+
+(declare-function c-forward-subword "ext:cc-subword" (&optional arg))
+(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")
- (require 'subword)
- (subword-forward arg))
-(make-obsolete 'c-forward-into-nomenclature 'subword-forward "23.2")
+ (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")
- (require 'subword)
- (subword-backward arg))
-(make-obsolete 'c-backward-into-nomenclature 'subword-backward "23.2")
+ (if (fboundp 'subword-mode)
+ (progn
+ (require 'subword)
+ (subword-backward arg))
+ (require 'cc-subword)
+ (c-backward-subword arg)))
+(make-obsolete
+ 'c-backward-into-nomenclature
+ (if (fboundp 'subword-mode) 'subword-backward 'c-backward-subword) "23.2")
(defun c-scope-operator ()
"Insert a double colon scope operator at point.
@@ -1349,13 +1380,13 @@ No indentation or other \"electric\" behavior is performed."
;; be the return type of a function, or the like. Exclude
;; this case.
(c-syntactic-re-search-forward
- (concat "[;=\(\[{]\\|\\("
+ (concat "[;=([{]\\|\\("
c-opt-block-decls-with-vars-key
"\\)")
eo-block t t t)
(match-beginning 1) ; Is there a "struct" etc., somewhere?
(not (eq (char-before) ?_))
- (c-syntactic-re-search-forward "[;=\(\[{]" eo-block t t t)
+ (c-syntactic-re-search-forward "[;=([{]" eo-block t t t)
(eq (char-before) ?\{)
bod)))))
@@ -1414,12 +1445,15 @@ No indentation or other \"electric\" behavior is performed."
(car (c-beginning-of-decl-1
;; NOTE: If we're in a K&R region, this might be the start
;; of a parameter declaration, not the actual function.
+ ;; It might also leave us at a label or "label" like
+ ;; "private:".
(and least-enclosing ; LIMIT for c-b-of-decl-1
(c-safe-position least-enclosing paren-state)))))
;; Has the declaration we've gone back to got braces?
- (setq brace-decl-p
- (save-excursion
+ (or (eq decl-result 'label)
+ (setq brace-decl-p
+ (save-excursion
(and (c-syntactic-re-search-forward "[;{]" nil t t)
(or (eq (char-before) ?\{)
(and c-recognize-knr-p
@@ -1427,10 +1461,11 @@ No indentation or other \"electric\" behavior is performed."
;; ';' in a K&R argdecl. In
;; that case the declaration
;; should contain a block.
- (c-in-knr-argdecl))))))
+ (c-in-knr-argdecl)))))))
(cond
- ((= (point) kluge-start) ; might be BOB or unbalanced parens.
+ ((or (eq decl-result 'label) ; e.g. "private:" or invalid syntax.
+ (= (point) kluge-start)) ; might be BOB or unbalanced parens.
'outwith-function)
((eq decl-result 'same)
(if brace-decl-p
@@ -1578,7 +1613,7 @@ defun."
(or (not (eq this-command 'c-beginning-of-defun))
(eq last-command 'c-beginning-of-defun)
- (and transient-mark-mode mark-active)
+ (c-region-is-active-p)
(push-mark))
(c-save-buffer-state
@@ -1702,7 +1737,7 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
(or (not (eq this-command 'c-end-of-defun))
(eq last-command 'c-end-of-defun)
- (and transient-mark-mode mark-active)
+ (c-region-is-active-p)
(push-mark))
(c-save-buffer-state
@@ -1774,7 +1809,7 @@ with a brace block."
(c-save-buffer-state
(beginning-of-defun-function end-of-defun-function
where pos name-end case-fold-search)
-
+
(save-restriction
(widen)
(save-excursion
@@ -1806,7 +1841,7 @@ with a brace block."
(looking-at c-symbol-key))
(match-string-no-properties 0))
- ((looking-at "DEFUN\\_>")
+ ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs!
;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory
;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START LENGTH) ==> POSIX::STREAM-LOCK
(down-list 1)
@@ -1999,7 +2034,7 @@ function does not require the declaration to contain a brace block."
(eq last-command 'c-mark-function)))
(push-mark-p (and (eq this-command 'c-mark-function)
(not extend-region-p)
- (not (and transient-mark-mode mark-active)))))
+ (not (c-region-is-active-p)))))
(if push-mark-p (push-mark (point)))
(if extend-region-p
(progn
@@ -2818,19 +2853,28 @@ sentence motion in or near comments and multiline strings."
;; set up electric character functions to work with pending-del,
;; (a.k.a. delsel) mode. All symbols get the t value except
-;; the functions which delete, which gets 'supersede.
+;; the functions which delete, which gets 'supersede, and (from Emacs
+;; 25) `c-electric-brace' and `c-electric-paren' get special handling
+;; so as to work gracefully with `electric-pair-mode'.
(mapc
(function
(lambda (sym)
(put sym 'delete-selection t) ; for delsel (Emacs)
(put sym 'pending-delete t))) ; for pending-del (XEmacs)
'(c-electric-pound
- c-electric-brace
c-electric-slash
c-electric-star
c-electric-semi&comma
c-electric-lt-gt
- c-electric-colon
+ c-electric-colon))
+(mapc
+ (function
+ (lambda (sym)
+ (put sym 'delete-selection (if (fboundp 'delete-selection-uses-region-p)
+ 'delete-selection-uses-region-p
+ t))
+ (put sym 'pending-delete t)))
+ '(c-electric-brace
c-electric-paren))
(put 'c-electric-delete 'delete-selection 'supersede) ; delsel
(put 'c-electric-delete 'pending-delete 'supersede) ; pending-del
@@ -3336,7 +3380,7 @@ Otherwise, with a prefix argument, rigidly reindent the expression
starting on the current line.
Otherwise reindent just the current line."
(interactive
- (list current-prefix-arg (use-region-p)))
+ (list current-prefix-arg (c-region-is-active-p)))
(if region
(c-indent-region (region-beginning) (region-end))
(c-indent-command arg)))
@@ -3377,7 +3421,7 @@ Otherwise reindent just the current line."
(if (< c-progress-interval (- now lastsecs))
(progn
(message "Indenting region... (%d%% complete)"
- (/ (* 100 (- (point) start)) (- end start)))
+ (floor (* 100.0 (- (point) start)) (- end start)))
(aset c-progress-info 2 now)))
)))
@@ -4411,7 +4455,7 @@ is in situations like the following:
char description[] = \"\\
A very long description of something that you want to fill to make
-nicely formatted output.\"\;
+nicely formatted output.\";
If point is in any other situation, i.e. in normal code, do nothing.
@@ -4725,4 +4769,8 @@ normally bound to C-o. See `c-context-line-break' for the details."
(cc-provide 'cc-cmds)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-cmds.el ends here
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index b90a01dcb3b..6bd58159fce 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1,6 +1,6 @@
;;; cc-defs.el --- compile time definitions for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -43,7 +43,23 @@
load-path)))
(load "cc-bytecomp" nil t)))
-(eval-when-compile (require 'cl)) ; was (cc-external-require 'cl). ACM 2005/11/29.
+(eval-and-compile
+ (defvar c--mapcan-status
+ (cond ((and (fboundp 'mapcan)
+ (subrp (symbol-function 'mapcan)))
+ ;; XEmacs
+ 'mapcan)
+ ((locate-file "cl-lib.elc" load-path)
+ ;; Emacs >= 24.3
+ 'cl-mapcan)
+ (t
+ ;; Emacs <= 24.2
+ nil))))
+
+(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
+; was (cc-external-require 'cl). ACM 2005/11/29.
+; Changed from (eval-when-compile (require 'cl)) back to
+; cc-external-require, 2015-08-12.
(cc-external-require 'regexp-opt)
;; Silence the compiler.
@@ -64,15 +80,14 @@
(not (fboundp 'push)))
(cc-load "cc-fix")))
-; (eval-after-load "font-lock" ; 2006-07-09. font-lock is now preloaded
-; '
-(if (and (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS
- ; to make the call to f-l-c-k throw an error.
- (not (featurep 'cc-fix)) ; only load the file once.
- (let (font-lock-keywords)
- (font-lock-compile-keywords '("\\<\\>"))
- font-lock-keywords)) ; did the previous call foul this up?
- (load "cc-fix")) ;)
+(when (featurep 'xemacs) ; There is now (2005/12) code in GNU Emacs CVS
+ ; to make the call to f-l-c-k throw an error.
+ (eval-after-load "font-lock"
+ '(if (and (not (featurep 'cc-fix)) ; only load the file once.
+ (let (font-lock-keywords)
+ (font-lock-compile-keywords '("\\<\\>"))
+ font-lock-keywords)) ; did the previous call foul this up?
+ (load "cc-fix"))))
;; The above takes care of the delayed loading, but this is necessary
;; to ensure correct byte compilation.
@@ -86,10 +101,15 @@
font-lock-keywords)))
(cc-load "cc-fix")))
+;; XEmacs 21.4 doesn't have `delete-dups'.
+(eval-and-compile
+ (if (and (not (fboundp 'delete-dups))
+ (not (featurep 'cc-fix)))
+ (cc-load "cc-fix")))
;;; Variables also used at compile time.
-(defconst c-version "5.32.5"
+(defconst c-version "5.33"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
@@ -171,6 +191,45 @@ This variant works around bugs in `eval-when-compile' in various
;;; Macros.
+(defmacro c--mapcan (fun liszt)
+ ;; CC Mode equivalent of `mapcan' which bridges the difference
+ ;; between the host [X]Emacsen."
+ ;; The motivation for this macro is to avoid the irritating message
+ ;; "function `mapcan' from cl package called at runtime" produced by Emacs.
+ (cond
+ ((eq c--mapcan-status 'mapcan)
+ `(mapcan ,fun ,liszt))
+ ((eq c--mapcan-status 'cl-mapcan)
+ `(cl-mapcan ,fun ,liszt))
+ (t
+ ;; Emacs <= 24.2. It would be nice to be able to distinguish between
+ ;; compile-time and run-time use here.
+ `(apply 'nconc (mapcar ,fun ,liszt)))))
+
+(defmacro c--set-difference (liszt1 liszt2 &rest other-args)
+ ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
+ (if (eq c--mapcan-status 'cl-mapcan)
+ `(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
+ `(set-difference ,liszt1 ,liszt2 ,@other-args)))
+
+(defmacro c--intersection (liszt1 liszt2 &rest other-args)
+ ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
+ (if (eq c--mapcan-status 'cl-mapcan)
+ `(cl-intersection ,liszt1 ,liszt2 ,@other-args)
+ `(intersection ,liszt1 ,liszt2 ,@other-args)))
+
+(eval-and-compile
+ (defmacro c--macroexpand-all (form &optional environment)
+ ;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3.
+ (if (eq c--mapcan-status 'cl-mapcan)
+ `(macroexpand-all ,form ,environment)
+ `(cl-macroexpand-all ,form ,environment)))
+
+ (defmacro c--delete-duplicates (cl-seq &rest cl-keys)
+ ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
+ (if (eq c--mapcan-status 'cl-mapcan)
+ `(cl-delete-duplicates ,cl-seq ,@cl-keys)
+ `(delete-duplicates ,cl-seq ,@cl-keys))))
(defmacro c-point (position &optional point)
"Return the value of certain commonly referenced POSITIONs relative to POINT.
@@ -327,16 +386,42 @@ to it is returned. This function does not modify the point or the mark."
(t (error "Unknown buffer position requested: %s" position))))
(point))))
+(eval-and-compile
+ ;; Constant to decide at compilation time whether to use category
+ ;; properties. Currently (2010-03) they're available only on GNU Emacs.
+ (defconst c-use-category
+ (with-temp-buffer
+ (let ((parse-sexp-lookup-properties t)
+ (lookup-syntax-properties t))
+ (set-syntax-table (make-syntax-table))
+ (insert "<()>")
+ (put-text-property (point-min) (1+ (point-min))
+ 'category 'c-<-as-paren-syntax)
+ (put-text-property (+ 3 (point-min)) (+ 4 (point-min))
+ 'category 'c->-as-paren-syntax)
+ (goto-char (point-min))
+ (forward-sexp)
+ (= (point) (+ 4 (point-min)))))))
+
+(defvar c-use-extents)
+
+(defmacro c-next-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 'next-single-char-property-change))
+ ;; XEmacs >= 2005-01-25
+ `(next-single-char-property-change ,position ,prop ,object ,limit)
+ ;; Emacs and earlier XEmacs
+ `(next-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.
- ;; FIXME? Emacs has region-active-p since 23.1, so maybe this test
- ;; should be updated.
- (if (cc-bytecomp-boundp 'mark-active)
- ;; Emacs.
- 'mark-active
- ;; XEmacs.
- '(region-active-p)))
+ (if (cc-bytecomp-fboundp 'region-active-p)
+ ;; XEmacs.
+ '(region-active-p)
+ ;; Old Emacs.
+ 'mark-active))
(defmacro c-set-region-active (activate)
;; Activate the region if ACTIVE is non-nil, deactivate it
@@ -415,10 +500,10 @@ even if the user undoes the command which set them.
This macro should ALWAYS be placed around \"temporary\" internal buffer
changes \(like adding a newline to calculate a text-property then
-deleting it again\), so that the user never sees them on his
+deleting it again), so that the user never sees them on his
`buffer-undo-list'. See also `c-tentative-buffer-changes'.
-However, any user-visible changes to the buffer \(like auto-newlines\)
+However, any user-visible changes to the buffer \(like auto-newlines)
must not be within a `c-save-buffer-state', since the user then
wouldn't be able to undo them.
@@ -823,6 +908,8 @@ be after it."
(defmacro c-with-syntax-table (table &rest code)
;; Temporarily switches to the specified syntax table in a failsafe
;; way to execute code.
+ ;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call
+ ;; any forms inside this that call `c-parse-state'. !!!!
`(let ((c-with-syntax-table-orig-table (syntax-table)))
(unwind-protect
(progn
@@ -911,6 +998,12 @@ MODE is either a mode symbol or a list of mode symbols."
(cc-bytecomp-fboundp 'delete-extent)
(cc-bytecomp-fboundp 'map-extents))))
+(defconst c-<-as-paren-syntax '(4 . ?>))
+(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
+
+(defconst c->-as-paren-syntax '(5 . ?<))
+(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax)
+
;; `c-put-char-property' is complex enough in XEmacs and Emacs < 21 to
;; make it a function.
(defalias 'c-put-char-property-fun
@@ -1044,8 +1137,8 @@ nil; point is then left undefined."
(while
(and
(< place ,(or limit '(point-max)))
- (not (equal (get-text-property place ,property) ,value)))
- (setq place (next-single-property-change
+ (not (equal (c-get-char-property place ,property) ,value)))
+ (setq place (c-next-single-property-change
place ,property nil ,(or limit '(point-max)))))
(when (< place ,(or limit '(point-max)))
(goto-char place)
@@ -1063,10 +1156,15 @@ point is then left undefined."
(while
(and
(> place ,(or limit '(point-min)))
- (not (equal (get-text-property (1- place) ,property) ,value)))
- (setq place (previous-single-property-change
+ (not (equal (c-get-char-property (1- place) ,property) ,value)))
+ (setq place (,(if (and c-use-extents
+ (fboundp 'previous-single-char-property-change))
+ ;; XEmacs > 2005-01-25.
+ 'previous-single-char-property-change
+ ;; Emacs and earlier XEmacs.
+ 'previous-single-property-change)
place ,property nil ,(or limit '(point-min)))))
- (when (> place ,(or limit '(point-max)))
+ (when (> place ,(or limit '(point-min)))
(goto-char place)
(search-backward-regexp ".") ; to set the match-data.
(point))))
@@ -1083,9 +1181,9 @@ been put there by c-put-char-property. POINT remains unchanged."
(and
(< place to)
(not (equal (get-text-property place property) value)))
- (setq place (next-single-property-change place property nil to)))
+ (setq place (c-next-single-property-change place property nil to)))
(< place to))
- (setq end-place (next-single-property-change place property nil to))
+ (setq end-place (c-next-single-property-change place property nil to))
(remove-text-properties place end-place (cons property nil))
;; Do we have to do anything with stickiness here?
(setq place end-place))))
@@ -1102,7 +1200,7 @@ been put there by c-put-char-property. POINT remains unchanged."
(if (equal (extent-property ext -property-) val)
(delete-extent ext)))
nil ,from ,to ,value nil -property-))
- ;; Gnu Emacs
+ ;; GNU Emacs
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
@@ -1137,7 +1235,7 @@ been put there by c-put-char-property. POINT remains unchanged."
;; Make edebug understand the macros.
;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
; '(progn
-(def-edebug-spec cc-eval-when-compile t)
+(def-edebug-spec cc-eval-when-compile (&rest def-form))
(def-edebug-spec c-point t)
(def-edebug-spec c-set-region-active t)
(def-edebug-spec c-safe t)
@@ -1186,42 +1284,43 @@ been put there by c-put-char-property. POINT remains unchanged."
(if (< (point) start)
(goto-char (point-max)))))
-(defconst c-<-as-paren-syntax '(4 . ?>))
-(put 'c-<-as-paren-syntax 'syntax-table c-<-as-paren-syntax)
-
-(defsubst c-mark-<-as-paren (pos)
+(defmacro c-mark-<-as-paren (pos)
;; Mark the "<" character at POS as a template opener using the
- ;; `syntax-table' property via the `category' property.
+ ;; `syntax-table' property either directly (XEmacs) or via a `category'
+ ;; property (GNU Emacs).
;;
;; This function does a hidden buffer change. Note that we use
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
- (c-put-char-property pos 'category 'c-<-as-paren-syntax))
+ (if c-use-category
+ `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax)
+ `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax)))
-(defconst c->-as-paren-syntax '(5 . ?<))
-(put 'c->-as-paren-syntax 'syntax-table c->-as-paren-syntax)
-(defsubst c-mark->-as-paren (pos)
+(defmacro c-mark->-as-paren (pos)
;; Mark the ">" character at POS as an sexp list closer using the
- ;; syntax-table property.
+ ;; `syntax-table' property either directly (XEmacs) or via a `category'
+ ;; property (GNU Emacs).
;;
;; This function does a hidden buffer change. Note that we use
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
- (c-put-char-property pos 'category 'c->-as-paren-syntax))
-
-(defsubst c-unmark-<->-as-paren (pos)
- ;; Unmark the "<" or "<" character at POS as an sexp list opener using
- ;; the syntax-table property indirectly through the `category' text
- ;; property.
+ (if c-use-category
+ `(c-put-char-property ,pos 'category 'c->-as-paren-syntax)
+ `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax)))
+
+(defmacro c-unmark-<->-as-paren (pos)
+ ;; Unmark the "<" or "<" character at POS as an sexp list opener using the
+ ;; `syntax-table' property either directly or indirectly through a
+ ;; `category' text property.
;;
- ;; This function does a hidden buffer change. Note that we use
+ ;; This function does a hidden buffer change. Note that we try to use
;; indirection through the `category' text property. This allows us to
;; toggle the property in all template brackets simultaneously and
;; cheaply. We use this, for instance, in `c-parse-state'.
- (c-clear-char-property pos 'category))
+ `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table)))
(defsubst c-suppress-<->-as-parens ()
;; Suppress the syntactic effect of all marked < and > as parens. Note
@@ -1293,10 +1392,132 @@ been put there by c-put-char-property. POINT remains unchanged."
;; suppressed.
`(unwind-protect
(c-save-buffer-state ()
- (c-clear-cpp-delimiters ,beg ,end)
+ (save-restriction
+ (widen)
+ (c-clear-cpp-delimiters ,beg ,end))
,`(c-with-cpps-commented-out ,@forms))
(c-save-buffer-state ()
- (c-set-cpp-delimiters ,beg ,end))))
+ (save-restriction
+ (widen)
+ (c-set-cpp-delimiters ,beg ,end)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following macros are to be used only in `c-parse-state' and its
+;; subroutines. Their main purpose is to simplify the handling of C++/Java
+;; template delimiters and CPP macros. In GNU Emacs, this is done slickly by
+;; the judicious use of 'category properties. These don't exist in XEmacs.
+;;
+;; Note: in the following macros, there is no special handling for parentheses
+;; inside CPP constructs. That is because CPPs are always syntactically
+;; balanced, thanks to `c-neutralize-CPP-line' in cc-mode.el.
+(defmacro c-sc-scan-lists-no-category+1+1 (from)
+ ;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is
+ ;; determined by and angle bracket; or (ii) is inside a macro whose start
+ ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ `(let ((here (point))
+ (pos (scan-lists ,from 1 1)))
+ (while (eq (char-before pos) ?>)
+ (setq pos (scan-lists pos 1 1)))
+ pos))
+
+(defmacro c-sc-scan-lists-no-category+1-1 (from)
+ ;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is
+ ;; determined by an angle bracket; or (ii) is inside a macro whose start
+ ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ `(let ((here (point))
+ (pos (scan-lists ,from 1 -1)))
+ (while (eq (char-before pos) ?<)
+ (setq pos (scan-lists pos 1 1))
+ (setq pos (scan-lists pos 1 -1)))
+ pos))
+
+(defmacro c-sc-scan-lists-no-category-1+1 (from)
+ ;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is
+ ;; determined by and angle bracket; or (ii) is inside a macro whose start
+ ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ `(let ((here (point))
+ (pos (scan-lists ,from -1 1)))
+ (while (eq (char-after pos) ?<)
+ (setq pos (scan-lists pos -1 1)))
+ pos))
+
+(defmacro c-sc-scan-lists-no-category-1-1 (from)
+ ;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is
+ ;; determined by and angle bracket; or (ii) is inside a macro whose start
+ ;; isn't POINT-MACRO-START doesn't count as a finishing position.
+ `(let ((here (point))
+ (pos (scan-lists ,from -1 -1)))
+ (while (eq (char-after pos) ?>)
+ (setq pos (scan-lists pos -1 1))
+ (setq pos (scan-lists pos -1 -1)))
+ pos))
+
+(defmacro c-sc-scan-lists (from count depth)
+ (if c-use-category
+ `(scan-lists ,from ,count ,depth)
+ (cond
+ ((and (eq count 1) (eq depth 1))
+ `(c-sc-scan-lists-no-category+1+1 ,from))
+ ((and (eq count 1) (eq depth -1))
+ `(c-sc-scan-lists-no-category+1-1 ,from))
+ ((and (eq count -1) (eq depth 1))
+ `(c-sc-scan-lists-no-category-1+1 ,from))
+ ((and (eq count -1) (eq depth -1))
+ `(c-sc-scan-lists-no-category-1-1 ,from))
+ (t (error "Invalid parameter(s) to c-sc-scan-lists")))))
+
+
+(defun c-sc-parse-partial-sexp-no-category (from to targetdepth stopbefore
+ oldstate)
+ ;; Do a parse-partial-sexp using the supplied arguments, disregarding
+ ;; template/generic delimiters < > and disregarding macros other than the
+ ;; one at POINT-MACRO-START.
+ ;;
+ ;; NOTE that STOPBEFORE must be nil. TARGETDEPTH should be one less than
+ ;; the depth in OLDSTATE. This function is thus a SPECIAL PURPOSE variation
+ ;; on parse-partial-sexp, designed for calling from
+ ;; `c-remove-stale-state-cache'.
+ ;;
+ ;; Any finishing position which is determined by an angle bracket delimiter
+ ;; doesn't count as a finishing position.
+ ;;
+ ;; Note there is no special handling of CPP constructs here, since these are
+ ;; always syntactically balanced (thanks to `c-neutralize-CPP-line').
+ (let ((state
+ (parse-partial-sexp from to targetdepth stopbefore oldstate)))
+ (while
+ (and (< (point) to)
+ ;; We must have hit targetdepth.
+ (or (eq (char-before) ?<)
+ (eq (char-before) ?>)))
+ (setcar state
+ (if (memq (char-before) '(?> ?\) ?\} ?\]))
+ (1+ (car state))
+ (1- (car state))))
+ (setq state
+ (parse-partial-sexp (point) to targetdepth stopbefore oldstate)))
+ state))
+
+(defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore
+ oldstate)
+ (if c-use-category
+ `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate)
+ `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore
+ ,oldstate)))
+
+
+(defvar c-emacs-features)
+
+(defmacro c-looking-at-non-alphnumspace ()
+ "Are we looking at a character which isn't alphanumeric or space?"
+ (if (memq 'gen-comment-delim c-emacs-features)
+ `(looking-at
+"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\|\\s!\\)")
+ `(or (looking-at
+"\\([;#]\\|\\'\\|\\s(\\|\\s)\\|\\s\"\\|\\s\\\\|\\s$\\|\\s<\\|\\s>\\)"
+ (let ((prop (c-get-char-property (point) 'syntax-table)))
+ (eq prop '(14))))))) ; '(14) is generic comment delimiter.
+
(defsubst c-intersect-lists (list alist)
;; return the element of ALIST that matches the first element found
@@ -1413,30 +1634,26 @@ Notably, null elements in LIST are ignored."
(defun c-make-keywords-re (adorn list &optional mode)
"Make a regexp that matches all the strings the list.
-Duplicates and nil elements in the list are removed. The resulting
-regexp may contain zero or more submatch expressions.
+Duplicates and nil elements in the list are removed. The
+resulting regexp may contain zero or more submatch expressions.
If ADORN is t there will be at least one submatch and the first
surrounds the matched alternative, and the regexp will also not match
a prefix of any identifier. Adorned regexps cannot be appended. The
language variable `c-nonsymbol-key' is used to make the adornment.
-A value 'appendable for ADORN is like above, but all alternatives in
+A value `appendable' for ADORN is like above, but all alternatives in
the list that end with a word constituent char will have \\> appended
instead, so that the regexp remains appendable. Note that this
variant doesn't always guarantee that an identifier prefix isn't
-matched since the symbol constituent '_' is normally considered a
+matched since the symbol constituent `_' is normally considered a
nonword token by \\>.
The optional MODE specifies the language to get `c-nonsymbol-key' from
when it's needed. The default is the current language taken from
`c-buffer-is-cc-mode'."
- (let (unique)
- (dolist (elt list)
- (unless (member elt unique)
- (push elt unique)))
- (setq list (delete nil unique)))
+ (setq list (delete nil (delete-dups list)))
(if list
(let (re)
@@ -1550,6 +1767,8 @@ non-nil, a caret is prepended to invert the set."
(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
+(defvar lookup-syntax-properties) ;XEmacs.
+
(defconst c-emacs-features
(let (list)
@@ -1601,6 +1820,9 @@ non-nil, a caret is prepended to invert the set."
(not (end-of-defun))))
(setq list (cons 'argumentative-bod-function list))))
+ ;; Record whether the `category' text property works.
+ (if c-use-category (setq list (cons 'category-properties list)))
+
(let ((buf (generate-new-buffer " test"))
parse-sexp-lookup-properties
parse-sexp-ignore-comments
@@ -1630,13 +1852,13 @@ non-nil, a caret is prepended to invert the set."
"support for the `syntax-table' text property "
"is required.")))
- ;; Find out if generic comment delimiters work.
+ ;; Find out if "\\s!" (generic comment delimiters) work.
(c-safe
(modify-syntax-entry ?x "!")
(if (string-match "\\s!" "x")
(setq list (cons 'gen-comment-delim list))))
- ;; Find out if generic string delimiters work.
+ ;; Find out if "\\s|" (generic string delimiters) work.
(c-safe
(modify-syntax-entry ?x "|")
(if (string-match "\\s|" "x")
@@ -1683,7 +1905,8 @@ non-nil, a caret is prepended to invert the set."
(kill-buffer buf))
;; See if `parse-partial-sexp' returns the eighth element.
- (if (c-safe (>= (length (save-excursion (parse-partial-sexp (point) (point))))
+ (if (c-safe (>= (length (save-excursion
+ (parse-partial-sexp (point) (point))))
10))
(setq list (cons 'pps-extended-state list))
(error (concat
@@ -1697,29 +1920,30 @@ There are many flavors of Emacs out there, each with different
features supporting those needed by CC Mode. The following values
might be present:
-'8-bit 8 bit syntax entry flags (XEmacs style).
-'1-bit 1 bit syntax entry flags (Emacs style).
-'argumentative-bod-function beginning-of-defun passes ARG through
- to a non-null beginning-of-defun-function. It is assumed
- the end-of-defun does the same thing.
-'syntax-properties It works to override the syntax for specific characters
- in the buffer with the 'syntax-table property. It's
+`8-bit' 8 bit syntax entry flags (XEmacs style).
+`1-bit' 1 bit syntax entry flags (Emacs style).
+`argumentative-bod-function' beginning-of-defun and end-of-defun pass
+ ARG through to beginning/end-of-defun-function.
+`syntax-properties' It works to override the syntax for specific characters
+ in the buffer with the `syntax-table' property. It's
always set - CC Mode no longer works in emacsen without
this feature.
-'gen-comment-delim Generic comment delimiters work
+`category-properties' Syntax routines can add a level of indirection to text
+ properties using the `category' property.
+`gen-comment-delim' Generic comment delimiters work
(i.e. the syntax class `!').
-'gen-string-delim Generic string delimiters work
+`gen-string-delim' Generic string delimiters work
(i.e. the syntax class `|').
-'pps-extended-state `parse-partial-sexp' returns a list with at least 10
+`pps-extended-state' `parse-partial-sexp' returns a list with at least 10
elements, i.e. it contains the position of the start of
the last comment or string. It's always set - CC Mode
no longer works in emacsen without this feature.
-'posix-char-classes The regexp engine understands POSIX character classes.
-'col-0-paren It's possible to turn off the ad-hoc rule that a paren
+`posix-char-classes' The regexp engine understands POSIX character classes.
+`col-0-paren' It's possible to turn off the ad-hoc rule that a paren
in column zero is the start of a defun.
-'infodock This is Infodock (based on XEmacs).
+`infodock' This is Infodock (based on XEmacs).
-'8-bit and '1-bit are mutually exclusive.")
+`8-bit' and `1-bit' are mutually exclusive.")
;;; Some helper constants.
@@ -1796,11 +2020,11 @@ system."
(put mode 'c-fallback-mode base-mode))
(defvar c-lang-constants (make-vector 151 0))
-;; This obarray is a cache to keep track of the language constants
-;; defined by `c-lang-defconst' and the evaluated values returned by
-;; `c-lang-const'. It's mostly used at compile time but it's not
+;; Obarray used as a cache to keep track of the language constants.
+;; The constants stored are those defined by `c-lang-defconst' and the values
+;; computed by `c-lang-const'. It's mostly used at compile time but it's not
;; stored in compiled files.
-;;
+
;; The obarray contains all the language constants as symbols. The
;; value cells hold the evaluated values as alists where each car is
;; the mode name symbol and the corresponding cdr is the evaluated
@@ -1810,42 +2034,44 @@ system."
(defvar c-lang-const-expansion nil)
+;; Ugly hack to pull in the definition of `cc-bytecomp-compiling-or-loading'
+;; from cc-bytecomp to make it available at loadtime. This is the same
+;; mechanism used in cc-mode.el for `c-populate-syntax-table'.
+(defalias 'cc-bytecomp-compiling-or-loading
+ (cc-eval-when-compile
+ (let ((f (symbol-function 'cc-bytecomp-compiling-or-loading)))
+ (if (byte-code-function-p f) f (byte-compile f)))))
+
(defsubst c-get-current-file ()
;; Return the base name of the current file.
- (let ((file (cond
- (load-in-progress
- ;; Being loaded.
- load-file-name)
- ((and (boundp 'byte-compile-dest-file)
- (stringp byte-compile-dest-file))
- ;; Being compiled.
- byte-compile-dest-file)
- (t
- ;; Being evaluated interactively.
- (buffer-file-name)))))
- (and file (file-name-base file))))
+ (let* ((c-or-l (cc-bytecomp-compiling-or-loading))
+ (file
+ (cond
+ ((eq c-or-l 'loading) load-file-name)
+ ((eq c-or-l 'compiling) byte-compile-dest-file)
+ ((null c-or-l) (buffer-file-name)))))
+ (and file
+ (file-name-sans-extension
+ (file-name-nondirectory file)))))
(defmacro c-lang-defconst-eval-immediately (form)
"Can be used inside a VAL in `c-lang-defconst' to evaluate FORM
immediately, i.e. at the same time as the `c-lang-defconst' form
itself is evaluated."
;; Evaluate at macro expansion time, i.e. in the
- ;; `cl-macroexpand-all' inside `c-lang-defconst'.
+ ;; `c--macroexpand-all' inside `c-lang-defconst'.
(eval form))
-;; Only used at compile time - suppress "might not be defined at runtime".
-(declare-function cl-macroexpand-all "cl" (form &optional env))
-
(defmacro c-lang-defconst (name &rest args)
"Set the language specific values of the language constant NAME.
The second argument can optionally be a docstring. The rest of the
arguments are one or more repetitions of LANG VAL where LANG specifies
the language(s) that VAL applies to. LANG is the name of the
language, i.e. the mode name without the \"-mode\" suffix, or a list
-of such language names, or `t' for all languages. VAL is a form to
+of such language names, or t for all languages. VAL is a form to
evaluate to get the value.
-If LANG isn't `t' or one of the core languages in CC Mode, it must
+If LANG isn't t or one of the core languages in CC Mode, it must
have been declared with `c-add-language'.
Neither NAME, LANG nor VAL are evaluated directly - they should not be
@@ -1855,7 +2081,7 @@ VAL to evaluate parts of it directly.
When VAL is evaluated for some language, that language is temporarily
made current so that `c-lang-const' without an explicit language can
be used inside VAL to refer to the value of a language constant in the
-same language. That is particularly useful if LANG is `t'.
+same language. That is particularly useful if LANG is t.
VAL is not evaluated right away but rather when the value is requested
with `c-lang-const'. Thus it's possible to use `c-lang-const' inside
@@ -1877,7 +2103,7 @@ constant. A file is identified by its base name."
(let* ((sym (intern (symbol-name name) c-lang-constants))
;; Make `c-lang-const' expand to a straightforward call to
- ;; `c-get-lang-constant' in `cl-macroexpand-all' below.
+ ;; `c-get-lang-constant' in `c--macroexpand-all' below.
;;
;; (The default behavior, i.e. to expand to a call inside
;; `eval-when-compile' should be equivalent, since that macro
@@ -1890,11 +2116,14 @@ constant. A file is identified by its base name."
;; language constant source definitions.)
(c-lang-const-expansion 'call)
(c-langs-are-parametric t)
+ (file (intern
+ (or (c-get-current-file)
+ (error "`c-lang-defconst' can only be used in a file"))))
bindings
pre-files)
(or (symbolp name)
- (error "Not a symbol: %s" name))
+ (error "Not a symbol: %S" name))
(when (stringp (car-safe args))
;; The docstring is hardly used anywhere since there's no normal
@@ -1904,7 +2133,7 @@ constant. A file is identified by its base name."
(setq args (cdr args)))
(or args
- (error "No assignments in `c-lang-defconst' for %s" name))
+ (error "No assignments in `c-lang-defconst' for %S" name))
;; Rework ARGS to an association list to make it easier to handle.
;; It's reversed at the same time to make it easier to implement
@@ -1918,17 +2147,17 @@ constant. A file is identified by its base name."
((listp (car args))
(mapcar (lambda (lang)
(or (symbolp lang)
- (error "Not a list of symbols: %s"
+ (error "Not a list of symbols: %S"
(car args)))
(intern (concat (symbol-name lang)
"-mode")))
(car args)))
- (t (error "Not a symbol or a list of symbols: %s"
+ (t (error "Not a symbol or a list of symbols: %S"
(car args)))))
val)
(or (cdr args)
- (error "No value for %s" (car args)))
+ (error "No value for %S" (car args)))
(setq args (cdr args)
val (car args))
@@ -1940,21 +2169,26 @@ constant. A file is identified by its base name."
;; reason, but we also use this expansion handle
;; `c-lang-defconst-eval-immediately' and to register
;; dependencies on the `c-lang-const's in VAL.)
- (setq val (cl-macroexpand-all val))
+ (setq val (c--macroexpand-all val))
- (setq bindings (cons (cons assigned-mode val) bindings)
+ (setq bindings `(cons (cons ',assigned-mode (lambda () ,val)) ,bindings)
args (cdr args))))
;; Compile in the other files that have provided source
;; definitions for this symbol, to make sure the order in the
;; `source' property is correct even when files are loaded out of
;; order.
- (setq pre-files (nreverse
- ;; Reverse to get the right load order.
- (mapcar 'car (get sym 'source))))
+ (setq pre-files (mapcar 'car (get sym 'source)))
+ (if (memq file pre-files)
+ ;; This can happen when the source file (e.g. cc-langs.el) is first
+ ;; loaded as source, setting a 'source property entry, and then itself
+ ;; being compiled.
+ (setq pre-files (cdr (memq file pre-files))))
+ ;; Reverse to get the right load order.
+ (setq pre-files (nreverse pre-files))
`(eval-and-compile
- (c-define-lang-constant ',name ',bindings
+ (c-define-lang-constant ',name ,bindings
,@(and pre-files `(',pre-files))))))
(put 'c-lang-defconst 'lisp-indent-function 1)
@@ -2019,19 +2253,16 @@ language. NAME and LANG are not evaluated so they should not be
quoted."
(or (symbolp name)
- (error "Not a symbol: %s" name))
+ (error "Not a symbol: %S" name))
(or (symbolp lang)
- (error "Not a symbol: %s" lang))
+ (error "Not a symbol: %S" lang))
(let ((sym (intern (symbol-name name) c-lang-constants))
- mode source-files args)
+ (mode (when lang (intern (concat (symbol-name lang) "-mode")))))
- (when lang
- (setq mode (intern (concat (symbol-name lang) "-mode")))
- (unless (get mode 'c-mode-prefix)
- (error
- "Unknown language %S since it got no `c-mode-prefix' property"
- (symbol-name lang))))
+ (or (get mode 'c-mode-prefix) (null mode)
+ (error "Unknown language %S: no `c-mode-prefix' property"
+ lang))
(if (eq c-lang-const-expansion 'immediate)
;; No need to find out the source file(s) when we evaluate
@@ -2039,49 +2270,54 @@ quoted."
;; `source' property.
`',(c-get-lang-constant name nil mode)
- (let ((file (c-get-current-file)))
- (if file (setq file (intern file)))
- ;; Get the source file(s) that must be loaded to get the value
- ;; of the constant. If the symbol isn't defined yet we assume
- ;; that its definition will come later in this file, and thus
- ;; are no file dependencies needed.
- (setq source-files (nreverse
- ;; Reverse to get the right load order.
- (apply 'nconc
- (mapcar (lambda (elem)
- (if (eq file (car elem))
- nil ; Exclude our own file.
- (list (car elem))))
- (get sym 'source))))))
-
- ;; Make some effort to do a compact call to
- ;; `c-get-lang-constant' since it will be compiled in.
- (setq args (and mode `(',mode)))
- (if (or source-files args)
- (setq args (cons (and source-files `',source-files)
- args)))
-
- (if (or (eq c-lang-const-expansion 'call)
- (and (not c-lang-const-expansion)
- (not mode))
- load-in-progress
- (not (boundp 'byte-compile-dest-file))
- (not (stringp byte-compile-dest-file)))
- ;; Either a straight call is requested in the context, or
- ;; we're in an "uncontrolled" context and got no language,
- ;; or we're not being byte compiled so the compile time
- ;; stuff below is unnecessary.
- `(c-get-lang-constant ',name ,@args)
-
- ;; Being compiled. If the loading and compiling version is
- ;; the same we use a value that is evaluated at compile time,
- ;; otherwise it's evaluated at runtime.
- `(if (eq c-version-sym ',c-version-sym)
- (cc-eval-when-compile
- (c-get-lang-constant ',name ,@args))
- (c-get-lang-constant ',name ,@args))))))
-
-(defvar c-lang-constants-under-evaluation nil)
+ (let ((source-files
+ (let ((file (c-get-current-file)))
+ (if file (setq file (intern file)))
+ ;; Get the source file(s) that must be loaded to get the value
+ ;; of the constant. If the symbol isn't defined yet we assume
+ ;; that its definition will come later in this file, and thus
+ ;; are no file dependencies needed.
+ (nreverse
+ ;; Reverse to get the right load order.
+ (c--mapcan (lambda (elem)
+ (if (eq file (car elem))
+ nil ; Exclude our own file.
+ (list (car elem))))
+ (get sym 'source)))))
+
+ ;; Make some effort to do a compact call to
+ ;; `c-get-lang-constant' since it will be compiled in.
+ (args (and mode `(',mode))))
+
+ (if (or source-files args)
+ (push (and source-files `',source-files) args))
+
+ (if (or (eq c-lang-const-expansion 'call)
+ (and (not c-lang-const-expansion)
+ (not mode))
+ (not (cc-bytecomp-is-compiling)))
+ ;; Either a straight call is requested in the context, or
+ ;; we're in an "uncontrolled" context and got no language,
+ ;; or we're not being byte compiled so the compile time
+ ;; stuff below is unnecessary.
+ `(c-get-lang-constant ',name ,@args)
+
+ ;; Being compiled. If the loading and compiling version is
+ ;; the same we use a value that is evaluated at compile time,
+ ;; otherwise it's evaluated at runtime.
+ `(if (eq c-version-sym ',c-version-sym)
+ (cc-eval-when-compile
+ (c-get-lang-constant ',name ,@args))
+ (c-get-lang-constant ',name ,@args)))))))
+
+(defvar c-lang-constants-under-evaluation nil
+ "Alist of constants in the process of being evaluated.
+The `cdr' of each entry indicates how far we've looked in the list
+of definitions, so that the def for var FOO in c-mode can be defined in
+terms of the def for that same var FOO (which will then rely on the
+fallback definition for all modes, to break the cycle).")
+
+(defconst c-lang--novalue "novalue")
(defun c-get-lang-constant (name &optional source-files mode)
;; Used by `c-lang-const'.
@@ -2147,7 +2383,7 @@ quoted."
;; mode might have an explicit entry before that.
(eq (setq value (c-find-assignment-for-mode
(cdr source-pos) mode nil name))
- c-lang-constants)
+ c-lang--novalue)
;; Try again with the fallback mode from the
;; original position. Note that
;; `c-buffer-is-cc-mode' still is the real mode if
@@ -2155,22 +2391,22 @@ quoted."
(eq (setq value (c-find-assignment-for-mode
(setcdr source-pos backup-source-pos)
fallback t name))
- c-lang-constants)))
+ c-lang--novalue)))
;; A simple lookup with no fallback mode.
(eq (setq value (c-find-assignment-for-mode
(cdr source-pos) mode t name))
- c-lang-constants))
+ c-lang--novalue))
(error
- "`%s' got no (prior) value in %s (might be a cyclic reference)"
+ "`%s' got no (prior) value in %S (might be a cyclic reference)"
name mode))
(condition-case err
- (setq value (eval value))
+ (setq value (funcall value))
(error
;; Print a message to aid in locating the error. We don't
;; print the error itself since that will be done later by
;; some caller higher up.
- (message "Eval error in the `c-lang-defconst' for `%s' in %s:"
+ (message "Eval error in the `c-lang-defconst' for `%S' in %s:"
sym mode)
(makunbound sym)
(signal (car err) (cdr err))))
@@ -2178,13 +2414,13 @@ quoted."
(set sym (cons (cons mode value) (symbol-value sym)))
value))))
-(defun c-find-assignment-for-mode (source-pos mode match-any-lang name)
+(defun c-find-assignment-for-mode (source-pos mode match-any-lang _name)
;; Find the first assignment entry that applies to MODE at or after
- ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with `t' as
+ ;; SOURCE-POS. If MATCH-ANY-LANG is non-nil, entries with t as
;; the language list are considered to match, otherwise they don't.
;; On return SOURCE-POS is updated to point to the next assignment
;; after the returned one. If no assignment is found,
- ;; `c-lang-constants' is returned as a magic value.
+ ;; `c-lang--novalue' is returned as a magic value.
;;
;; SOURCE-POS is a vector that points out a specific assignment in
;; the double alist that's used in the `source' property. The first
@@ -2215,7 +2451,7 @@ quoted."
;;(message (concat "Loading %s to get the source "
;; "value for language constant %s")
;; file name)
- (load file))
+ (load file nil t))
(unless (setq assignment-entry (cdar file-entry))
;; The load didn't fill in the source for the
@@ -2240,7 +2476,7 @@ quoted."
match-any-lang)
(throw 'found (cdr assignment))))
- c-lang-constants)))
+ c-lang--novalue)))
(defun c-lang-major-mode-is (mode)
;; `c-major-mode-is' expands to a call to this function inside
@@ -2261,4 +2497,8 @@ quoted."
(cc-provide 'cc-defs)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-defs.el ends here
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 3d6398014db..6382b145211 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,6 +1,6 @@
;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*-
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2001- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -147,18 +147,19 @@
(cc-require-when-compile 'cc-langs)
(cc-require 'cc-vars)
+(eval-when-compile (require 'cl))
+
;; Make declarations for all the `c-lang-defvar' variables in cc-langs.
(defmacro c-declare-lang-variables ()
`(progn
- ,@(apply 'nconc
- (mapcar (lambda (init)
- `(,(if (elt init 2)
- `(defvar ,(car init) nil ,(elt init 2))
- `(defvar ,(car init) nil))
- (make-variable-buffer-local ',(car init))))
- (cdr c-lang-variable-inits)))))
+ ,@(c--mapcan (lambda (init)
+ `(,(if (elt init 2)
+ `(defvar ,(car init) nil ,(elt init 2))
+ `(defvar ,(car init) nil))
+ (make-variable-buffer-local ',(car init))))
+ (cdr c-lang-variable-inits))))
(c-declare-lang-variables)
@@ -248,6 +249,24 @@
(setq c-macro-cache-start-pos beg
c-macro-cache-syntactic nil))))
+(defun c-macro-is-genuine-p ()
+ ;; Check that the ostensible CPP construct at point is a real one. In
+ ;; particular, if point is on the first line of a narrowed buffer, make sure
+ ;; that the "#" isn't, say, the second character of a "##" operator. Return
+ ;; t when the macro is real, nil otherwise.
+ (let ((here (point)))
+ (beginning-of-line)
+ (prog1
+ (if (and (eq (point) (point-min))
+ (/= (point) 1))
+ (save-restriction
+ (widen)
+ (beginning-of-line)
+ (and (looking-at c-anchored-cpp-prefix)
+ (eq (match-beginning 1) here)))
+ t)
+ (goto-char here))))
+
(defun c-beginning-of-macro (&optional lim)
"Go to the beginning of a preprocessor directive.
Leave point at the beginning of the directive and return t if in one,
@@ -278,7 +297,8 @@ comment at the start of cc-engine.el for more info."
(forward-line -1))
(back-to-indentation)
(if (and (<= (point) here)
- (looking-at c-opt-cpp-start))
+ (looking-at c-opt-cpp-start)
+ (c-macro-is-genuine-p))
(progn
(setq c-macro-cache (cons (point) nil)
c-macro-cache-start-pos here)
@@ -514,7 +534,7 @@ comment at the start of cc-engine.el for more info."
(while (progn
(when (eq (get-text-property (point) 'c-type) value)
(c-clear-char-property (point) 'c-type))
- (goto-char (next-single-property-change (point) 'c-type nil to))
+ (goto-char (c-next-single-property-change (point) 'c-type nil to))
(< (point) to)))))
@@ -598,11 +618,12 @@ comment at the start of cc-engine.el for more info."
(defmacro c-bos-report-error ()
'(unless noerror
(setq c-parsing-error
- (format "No matching `%s' found for `%s' on line %d"
- (elt saved-pos 1)
- (elt saved-pos 2)
- (1+ (count-lines (point-min)
- (c-point 'bol (elt saved-pos 0))))))))
+ (format-message
+ "No matching `%s' found for `%s' on line %d"
+ (elt saved-pos 1)
+ (elt saved-pos 2)
+ (1+ (count-lines (point-min)
+ (c-point 'bol (elt saved-pos 0))))))))
(defun c-beginning-of-statement-1 (&optional lim ignore-labels
noerror comma-delim)
@@ -613,7 +634,7 @@ move into or out of sexps (not even normal expression parentheses).
If point is already at the earliest statement within braces or parens,
this function doesn't move back into any whitespace preceding it; it
-returns 'same in this case.
+returns `same' in this case.
Stop at statement continuation tokens like \"else\", \"catch\",
\"finally\" and the \"while\" in \"do ... while\" if the start point
@@ -635,24 +656,24 @@ start of the definition in a \"#define\". Also stop at start of
macros before leaving them.
Return:
-'label if stopped at a label or \"case...:\" or \"default:\";
-'same if stopped at the beginning of the current statement;
-'up if stepped to a containing statement;
-'previous if stepped to a preceding statement;
-'beginning if stepped from a statement continuation clause to
+`label' if stopped at a label or \"case...:\" or \"default:\";
+`same' if stopped at the beginning of the current statement;
+`up' if stepped to a containing statement;
+`previous' if stepped to a preceding statement;
+`beginning' if stepped from a statement continuation clause to
its start clause; or
-'macro if stepped to a macro start.
-Note that 'same and not 'label is returned if stopped at the same
+`macro' if stepped to a macro start.
+Note that `same' and not `label' is returned if stopped at the same
label without crossing the colon character.
LIM may be given to limit the search. If the search hits the limit,
point will be left at the closest following token, or at the start
-position if that is less ('same is returned in this case).
+position if that is less (`same' is returned in this case).
NOERROR turns off error logging to `c-parsing-error'.
-Normally only ';' and virtual semicolons are considered to delimit
-statements, but if COMMA-DELIM is non-nil then ',' is treated
+Normally only `;' and virtual semicolons are considered to delimit
+statements, but if COMMA-DELIM is non-nil then `,' is treated
as a delimiter too.
Note that this function might do hidden buffer changes. See the
@@ -826,7 +847,6 @@ comment at the start of cc-engine.el for more info."
;; Record this as the first token if not starting inside it.
(setq tok start))
-
;; The following while loop goes back one sexp (balanced parens,
;; etc. with contents, or symbol or suchlike) each iteration. This
;; movement is accomplished with a call to c-backward-sexp approx 170
@@ -1033,11 +1053,14 @@ comment at the start of cc-engine.el for more info."
;; Just gone back over a brace block?
((and
(eq (char-after) ?{)
- (not (c-looking-at-inexpr-block lim nil t)))
+ (not (c-looking-at-inexpr-block lim nil t))
+ (save-excursion
+ (c-backward-token-2 1 t nil)
+ (not (looking-at "=\\([^=]\\|$\\)"))))
(save-excursion
(c-forward-sexp) (point)))
;; Just gone back over some paren block?
- ((looking-at "\\s\(")
+ ((looking-at "\\s(")
(save-excursion
(goto-char (1+ (c-down-list-backward
before-sws-pos)))
@@ -1210,7 +1233,7 @@ The variable `c-maybe-labelp' is set to the position of the first `:' that
might start a label (i.e. not part of `::' and not preceded by `?'). If a
single `?' is found, then `c-maybe-labelp' is cleared.
-For AWK, a statement which is terminated by an EOL (not a \; or a }) is
+For AWK, a statement which is terminated by an EOL (not a ; or a }) is
regarded as having a \"virtual semicolon\" immediately after the last token on
the line. If this virtual semicolon is _at_ from, the function recognizes it.
@@ -1261,12 +1284,15 @@ comment at the start of cc-engine.el for more info."
;; looking for more : and ?.
(setq c-maybe-labelp nil
skip-chars (substring c-stmt-delim-chars 0 -2)))
- ;; At a CPP construct?
- ((and c-opt-cpp-symbol (looking-at c-opt-cpp-symbol)
- (save-excursion
- (forward-line 0)
- (looking-at c-opt-cpp-prefix)))
- (c-end-of-macro))
+ ;; At a CPP construct or a "#" or "##" operator?
+ ((and c-opt-cpp-symbol (looking-at c-opt-cpp-symbol))
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (and (bolp)
+ (or (bobp)
+ (not (eq (char-before (1- (point))) ?\\)))))
+ (c-end-of-macro)
+ (skip-chars-forward c-opt-cpp-symbol)))
((memq (char-after) non-skip-list)
(throw 'done (point)))))
;; In trailing space after an as yet undetected virtual semicolon?
@@ -1698,7 +1724,7 @@ comment at the start of cc-engine.el for more info."
;; the cases when the marked rung is complete.
;; (`next-single-property-change' is certain to move at least one
;; step forward.)
- (setq rung-pos (1- (next-single-property-change
+ (setq rung-pos (1- (c-next-single-property-change
rung-is-marked 'c-is-sws nil rung-end-pos)))
;; Got no marked rung here. Since the simple ws might have started
;; inside a line comment or cpp directive we must set `rung-pos' as
@@ -1714,7 +1740,7 @@ comment at the start of cc-engine.el for more info."
;; The following search is the main reason that `c-in-sws'
;; and `c-is-sws' aren't combined to one property.
- (goto-char (next-single-property-change
+ (goto-char (c-next-single-property-change
(point) 'c-in-sws nil (point-max)))
(unless (get-text-property (point) 'c-is-sws)
;; If the `c-in-sws' region extended past the last
@@ -1836,7 +1862,7 @@ comment at the start of cc-engine.el for more info."
;; possible since we can't be in the ending ws of a line comment or
;; cpp directive now.
(if (setq rung-is-marked next-rung-is-marked)
- (setq rung-pos (1- (next-single-property-change
+ (setq rung-pos (1- (c-next-single-property-change
rung-is-marked 'c-is-sws nil rung-end-pos)))
(setq rung-pos next-rung-pos))
(setq safe-start t)))
@@ -1914,7 +1940,7 @@ comment at the start of cc-engine.el for more info."
(unless (get-text-property (point) 'c-is-sws)
;; If the `c-in-sws' region extended past the first
;; `c-is-sws' char we have to go forward a bit.
- (goto-char (next-single-property-change
+ (goto-char (c-next-single-property-change
(point) 'c-is-sws)))
(c-debug-sws-msg
@@ -2153,7 +2179,6 @@ comment at the start of cc-engine.el for more info."
;; the middle of the desert, as long as it is not within a brace pair
;; recorded in `c-state-cache' or a paren/bracket pair.
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We maintain a simple cache of positions which aren't in a literal, so as to
;; speed up testing for non-literality.
@@ -2216,7 +2241,8 @@ comment at the start of cc-engine.el for more info."
((and (not not-in-delimiter) ; inside a comment starter
(not (bobp))
(progn (backward-char)
- (looking-at c-comment-start-regexp)))
+ (and (not (looking-at "\\s!"))
+ (looking-at c-comment-start-regexp))))
(setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++)
co-st (point))
(forward-comment 1)
@@ -2252,7 +2278,9 @@ comment at the start of cc-engine.el for more info."
(while
;; Add an element to `c-state-nonlit-pos-cache' each iteration.
(and
- (<= (setq npos (+ pos c-state-nonlit-pos-interval)) here)
+ (setq npos
+ (when (<= (+ pos c-state-nonlit-pos-interval) here)
+ (+ pos c-state-nonlit-pos-interval)))
;; Test for being in a literal. If so, go to after it.
(progn
@@ -2279,7 +2307,9 @@ comment at the start of cc-engine.el for more info."
;; Add one extra element above HERE so as to to avoid the previous
;; expensive calculation when the next call is close to the current
;; one. This is especially useful when inside a large macro.
- (setq c-state-nonlit-pos-cache (cons npos c-state-nonlit-pos-cache)))
+ (when npos
+ (setq c-state-nonlit-pos-cache
+ (cons npos c-state-nonlit-pos-cache))))
(if (> pos c-state-nonlit-pos-cache-limit)
(setq c-state-nonlit-pos-cache-limit pos))
@@ -2522,7 +2552,7 @@ comment at the start of cc-engine.el for more info."
(setq pos here+)
(c-safe
(while
- (setq ren+1 (scan-lists pos 1 1)) ; might signal
+ (setq ren+1 (c-sc-scan-lists pos 1 1)) ; might signal
(setq lonely-rens (cons ren+1 lonely-rens)
pos ren+1)))))
@@ -2534,7 +2564,7 @@ comment at the start of cc-engine.el for more info."
(c-safe
(while
(and lonely-rens ; actual values aren't used.
- (setq pa (scan-lists pos -1 1)))
+ (setq pa (c-sc-scan-lists pos -1 1)))
(setq pos pa)
(setq lonely-rens (cdr lonely-rens)))))
pos))
@@ -2549,8 +2579,11 @@ comment at the start of cc-engine.el for more info."
;; The return value is a list, one of the following:
;;
;; o - ('forward START-POINT) - scan forward from START-POINT,
- ;; which is not less than the highest position in `c-state-cache' below here.
+ ;; which is not less than the highest position in `c-state-cache' below HERE,
+ ;; which is after GOOD-POS.
;; o - ('backward nil) - scan backwards (from HERE).
+ ;; o - ('back-and-forward START-POINT) - like 'forward, but when HERE is earlier
+ ;; than GOOD-POS.
;; o - ('IN-LIT nil) - point is inside the literal containing point-min.
(let ((cache-pos (c-get-cache-scan-pos here)) ; highest position below HERE in cache (or 1)
strategy ; 'forward, 'backward, or 'IN-LIT.
@@ -2565,9 +2598,9 @@ comment at the start of cc-engine.el for more info."
((< (- good-pos here) (- here cache-pos)) ; FIXME!!! ; apply some sort of weighting.
(setq strategy 'backward))
(t
- (setq strategy 'forward
+ (setq strategy 'back-and-forward
start-point cache-pos)))
- (list strategy (and (eq strategy 'forward) start-point))))
+ (list strategy start-point)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2687,8 +2720,8 @@ comment at the start of cc-engine.el for more info."
(progn
(c-safe
(while
- (and (setq ce (scan-lists bra -1 -1)) ; back past )/]/}; might signal
- (setq bra (scan-lists ce -1 1)) ; back past (/[/{; might signal
+ (and (setq ce (c-sc-scan-lists bra -1 -1)) ; back past )/]/}; might signal
+ (setq bra (c-sc-scan-lists ce -1 1)) ; back past (/[/{; might signal
(or (> bra here) ;(> ce here)
(and
(< ce here)
@@ -2740,7 +2773,7 @@ comment at the start of cc-engine.el for more info."
(not (c-beginning-of-macro))))
(setq c-state-cache
(cons (cons (1- bra+1)
- (scan-lists bra+1 1 1))
+ (c-sc-scan-lists bra+1 1 1))
(if (consp (car c-state-cache))
(cdr c-state-cache)
c-state-cache)))
@@ -2769,7 +2802,7 @@ comment at the start of cc-engine.el for more info."
paren+1 ; Pos after some opening or closing paren.
paren+1s ; A list of `paren+1's; used to determine a
; good-pos.
- bra+1 ce+1 ; just after L/R bra-ces.
+ bra+1 ; just after L bra-ce.
bra+1s ; list of OLD values of bra+1.
mstart) ; start of a macro.
@@ -2790,9 +2823,9 @@ comment at the start of cc-engine.el for more info."
;; are no more b/b/p's to scan.
(c-safe
(while t
- (setq pa+1 (scan-lists ren+1 1 -1) ; Into (/{/[; might signal
+ (setq pa+1 (c-sc-scan-lists ren+1 1 -1) ; Into (/{/[; might signal
paren+1s (cons pa+1 paren+1s))
- (setq ren+1 (scan-lists pa+1 1 1)) ; Out of )/}/]; might signal
+ (setq ren+1 (c-sc-scan-lists pa+1 1 1)) ; Out of )/}/]; might signal
(if (and (eq (char-before pa+1) ?{)) ; Check for a macro later.
(setq bra+1 pa+1))
(setcar paren+1s ren+1)))
@@ -2816,7 +2849,7 @@ comment at the start of cc-engine.el for more info."
;; finished - we just need to check for having found an
;; unmatched )/}/], which we ignore. Such a )/}/] can't be in a
;; macro, due the action of `c-neutralize-syntax-in-CPP'.
- (c-safe (setq ren+1 (scan-lists ren+1 1 1)))))) ; acts as loop control.
+ (c-safe (setq ren+1 (c-sc-scan-lists ren+1 1 1)))))) ; acts as loop control.
;; Record the final, innermost, brace-pair if there is one.
(c-state-push-any-brace-pair bra+1 macro-start-or-here)
@@ -2839,9 +2872,10 @@ comment at the start of cc-engine.el for more info."
(defun c-remove-stale-state-cache (start-point here pps-point)
;; Remove stale entries from the `c-cache-state', i.e. those which will
- ;; not be in it when it is amended for position HERE. Additionally, the
- ;; "outermost" open-brace entry before HERE will be converted to a cons if
- ;; the matching close-brace is scanned.
+ ;; not be in it when it is amended for position HERE. This may involve
+ ;; replacing a CONS element for a brace pair containing HERE with its car.
+ ;; Additionally, the "outermost" open-brace entry before HERE will be
+ ;; converted to a cons if the matching close-brace is below HERE.
;;
;; START-POINT is a "maximal" "safe position" - there must be no open
;; parens/braces/brackets between START-POINT and HERE.
@@ -2852,7 +2886,7 @@ comment at the start of cc-engine.el for more info."
;; adjust it to get outside a string/comment. (Sorry about this! The code
;; needs to be FAST).
;;
- ;; Return a list (GOOD-POS SCAN-BACK-POS PPS-STATE), where
+ ;; Return a list (GOOD-POS SCAN-BACK-POS CONS-SEPARATED PPS-STATE), where
;; o - GOOD-POS is a position where the new value `c-state-cache' is known
;; to be good (we aim for this to be as high as possible);
;; o - SCAN-BACK-POS, if not nil, indicates there may be a brace pair
@@ -2860,6 +2894,9 @@ comment at the start of cc-engine.el for more info."
;; position to scan backwards from. It is the position of the "{" of the
;; last element to be removed from `c-state-cache', when that elt is a
;; cons, otherwise nil.
+ ;; o - CONS-SEPARATED is t when a cons element in `c-state-cache' has been
+ ;; replaced by its car because HERE lies inside the brace pair represented
+ ;; by the cons.
;; o - PPS-STATE is the parse-partial-sexp state at PPS-POINT.
(save-excursion
(save-restriction
@@ -2887,6 +2924,7 @@ comment at the start of cc-engine.el for more info."
pos
upper-lim ; ,beyond which `c-state-cache' entries are removed
scan-back-pos
+ cons-separated
pair-beg pps-point-state target-depth)
;; Remove entries beyond HERE. Also remove any entries inside
@@ -2908,12 +2946,13 @@ comment at the start of cc-engine.el for more info."
(consp (car c-state-cache))
(> (cdar c-state-cache) upper-lim))
(setcar c-state-cache (caar c-state-cache))
- (setq scan-back-pos (car c-state-cache)))
+ (setq scan-back-pos (car c-state-cache)
+ cons-separated t))
;; The next loop jumps forward out of a nested level of parens each
;; time round; the corresponding elements in `c-state-cache' are
;; removed. `pos' is just after the brace-pair or the open paren at
- ;; (car c-state-cache). There can be no open parens/braces/brackets
+ ;; (car c-state-cache). There can be no open parens/braces/brackets
;; between `start-point'/`start-point-actual-macro-start' and HERE,
;; due to the interface spec to this function.
(setq pos (if (and start-point-actual-macro-end
@@ -2937,7 +2976,7 @@ comment at the start of cc-engine.el for more info."
;; Scan!
(setq pps-state
- (parse-partial-sexp
+ (c-sc-parse-partial-sexp
(point) (if (< (point) pps-point) pps-point here)
target-depth
nil pps-state))
@@ -2968,9 +3007,10 @@ comment at the start of cc-engine.el for more info."
)))
(if (< (point) pps-point)
- (setq pps-state (parse-partial-sexp (point) pps-point
- nil nil ; TARGETDEPTH, STOPBEFORE
- pps-state)))
+ (setq pps-state (c-sc-parse-partial-sexp
+ (point) pps-point
+ nil nil ; TARGETDEPTH, STOPBEFORE
+ pps-state)))
;; If the last paren pair we moved out of was actually a brace pair,
;; insert it into `c-state-cache'.
@@ -2980,7 +3020,7 @@ comment at the start of cc-engine.el for more info."
(setq c-state-cache (cons (cons pair-beg pos)
c-state-cache)))
- (list pos scan-back-pos pps-state)))))
+ (list pos scan-back-pos cons-separated pps-state)))))
(defun c-remove-stale-state-cache-backwards (here)
;; Strip stale elements of `c-state-cache' by moving backwards through the
@@ -3034,7 +3074,7 @@ comment at the start of cc-engine.el for more info."
(setq dropped-cons (consp (car c-state-cache)))
(setq c-state-cache (cdr c-state-cache))
(setq pos pa))
- ;; At this stage, (> pos here);
+ ;; At this stage, (>= pos here);
;; (< (c-state-cache-top-lparen) here) (or is nil).
(cond
@@ -3091,18 +3131,25 @@ comment at the start of cc-engine.el for more info."
(save-restriction
(narrow-to-region here-bol (point-max))
(setq pos here-lit-start)
- (c-safe (while (setq pa (scan-lists pos -1 1))
+ (c-safe (while (setq pa (c-sc-scan-lists pos -1 1))
(setq pos pa)))) ; might signal
nil)) ; for the cond
- ((setq ren (c-safe-scan-lists pos -1 -1 too-far-back))
- ;; CASE 3: After a }/)/] before `here''s BOL.
+ ((save-restriction
+ (narrow-to-region too-far-back (point-max))
+ (setq ren (c-safe (c-sc-scan-lists pos -1 -1))))
+ ;; CASE 3: After a }/)/] before `here''s BOL.
(list (1+ ren) (and dropped-cons pos) nil)) ; Return value
+ ((progn (setq good-pos (c-state-lit-beg (c-point 'bopl here-bol)))
+ (>= cache-pos good-pos))
+ ;; CASE 3.5: Just after an existing entry in `c-state-cache' on `here''s
+ ;; line or the previous line.
+ (list cache-pos nil nil))
+
(t
;; CASE 4; Best of a bad job: BOL before `here-bol', or beginning of
;; literal containing it.
- (setq good-pos (c-state-lit-beg (c-point 'bopl here-bol)))
(list good-pos (and dropped-cons good-pos) nil)))))
@@ -3180,7 +3227,8 @@ comment at the start of cc-engine.el for more info."
;; Truncate `c-state-cache' and set `c-state-cache-good-pos' to a value
;; below `here'. To maintain its consistency, we may need to insert a new
;; brace pair.
- (let ((here-bol (c-point 'bol here))
+ (let (open-paren-in-column-0-is-defun-start
+ (here-bol (c-point 'bol here))
too-high-pa ; recorded {/(/[ next above here, or nil.
dropped-cons ; was the last removed element a brace pair?
pa)
@@ -3251,6 +3299,7 @@ comment at the start of cc-engine.el for more info."
;; This function might do hidden buffer changes.
(let* ((here (point))
(here-bopl (c-point 'bopl))
+ open-paren-in-column-0-is-defun-start
strategy ; 'forward, 'backward etc..
;; Candidate positions to start scanning from:
cache-pos ; highest position below HERE already existing in
@@ -3260,6 +3309,7 @@ comment at the start of cc-engine.el for more info."
; are no open parens/braces between it and HERE.
bopl-state
res
+ cons-separated
scan-backward-pos scan-forward-p) ; used for 'backward.
;; If POINT-MIN has changed, adjust the cache
(unless (= (point-min) c-state-point-min)
@@ -3272,13 +3322,15 @@ comment at the start of cc-engine.el for more info."
;; SCAN!
(cond
- ((eq strategy 'forward)
+ ((memq strategy '(forward back-and-forward))
(setq res (c-remove-stale-state-cache start-point here here-bopl))
(setq cache-pos (car res)
scan-backward-pos (cadr res)
- bopl-state (car (cddr res))) ; will be nil if (< here-bopl
+ cons-separated (car (cddr res))
+ bopl-state (cadr (cddr res))) ; will be nil if (< here-bopl
; start-point)
- (if scan-backward-pos
+ (if (and scan-backward-pos
+ (or cons-separated (eq strategy 'forward))) ;scan-backward-pos
(c-append-lower-brace-pair-to-state-cache scan-backward-pos here))
(setq good-pos
(c-append-to-state-cache cache-pos here))
@@ -3313,15 +3365,19 @@ comment at the start of cc-engine.el for more info."
;; of all parens in preprocessor constructs, except for any such construct
;; containing point. We can then call `c-invalidate-state-cache-1' without
;; worrying further about macros and template delimiters.
- (c-with-<->-as-parens-suppressed
- (if (and c-state-old-cpp-beg
- (< c-state-old-cpp-beg here))
- (c-with-all-but-one-cpps-commented-out
- c-state-old-cpp-beg
- (min c-state-old-cpp-end here)
- (c-invalidate-state-cache-1 here))
- (c-with-cpps-commented-out
- (c-invalidate-state-cache-1 here)))))
+ (if (eval-when-compile (memq 'category-properties c-emacs-features))
+ ;; Emacs
+ (c-with-<->-as-parens-suppressed
+ (if (and c-state-old-cpp-beg
+ (< c-state-old-cpp-beg here))
+ (c-with-all-but-one-cpps-commented-out
+ c-state-old-cpp-beg
+ (min c-state-old-cpp-end here)
+ (c-invalidate-state-cache-1 here))
+ (c-with-cpps-commented-out
+ (c-invalidate-state-cache-1 here))))
+ ;; XEmacs
+ (c-invalidate-state-cache-1 here)))
(defmacro c-state-maybe-marker (place marker)
;; If PLACE is non-nil, return a marker marking it, otherwise nil.
@@ -3349,13 +3405,17 @@ comment at the start of cc-engine.el for more info."
;; FIXME!!! Put in a `condition-case' here to protect the integrity of the
;; subsystem.
(prog1
- (c-with-<->-as-parens-suppressed
- (if (and here-cpp-beg (> here-cpp-end here-cpp-beg))
- (c-with-all-but-one-cpps-commented-out
- here-cpp-beg here-cpp-end
- (c-parse-state-1))
- (c-with-cpps-commented-out
- (c-parse-state-1))))
+ (if (eval-when-compile (memq 'category-properties c-emacs-features))
+ ;; Emacs
+ (c-with-<->-as-parens-suppressed
+ (if (and here-cpp-beg (> here-cpp-end here-cpp-beg))
+ (c-with-all-but-one-cpps-commented-out
+ here-cpp-beg here-cpp-end
+ (c-parse-state-1))
+ (c-with-cpps-commented-out
+ (c-parse-state-1))))
+ ;; XEmacs
+ (c-parse-state-1))
(setq c-state-old-cpp-beg
(c-state-maybe-marker here-cpp-beg c-state-old-cpp-beg-marker)
c-state-old-cpp-end
@@ -3370,6 +3430,7 @@ comment at the start of cc-engine.el for more info."
(defvar c-parse-state-point nil)
(defvar c-parse-state-state nil)
+(make-variable-buffer-local 'c-parse-state-state)
(defun c-record-parse-state-state ()
(setq c-parse-state-point (point))
(setq c-parse-state-state
@@ -3377,9 +3438,9 @@ comment at the start of cc-engine.el for more info."
(lambda (arg)
(let ((val (symbol-value arg)))
(cons arg
- (if (consp val)
- (copy-tree val)
- val))))
+ (cond ((consp val) (copy-tree val))
+ ((markerp val) (copy-marker val))
+ (t val)))))
'(c-state-cache
c-state-cache-good-pos
c-state-nonlit-pos-cache
@@ -3399,7 +3460,11 @@ comment at the start of cc-engine.el for more info."
(concat "(setq "
(mapconcat
(lambda (arg)
- (format "%s %s%s" (car arg) (if (atom (cdr arg)) "" "'") (cdr arg)))
+ (format "%s %s%s" (car arg)
+ (if (atom (cdr arg)) "" "'")
+ (if (markerp (cdr arg))
+ (format "(copy-marker %s)" (marker-position (cdr arg)))
+ (cdr arg))))
c-parse-state-state " ")
")")))
@@ -3694,7 +3759,7 @@ comment at the start of cc-engine.el for more info."
(while (let ((pos (or (and (looking-at c-nonsymbol-token-regexp)
(match-end 0))
;; `c-nonsymbol-token-regexp' should always match
- ;; since we've skipped backward over punctuator
+ ;; since we've skipped backward over punctuation
;; or paren syntax, but consume one char in case
;; it doesn't so that we don't leave point before
;; some earlier incorrect token.
@@ -3718,7 +3783,7 @@ comment at the start of cc-engine.el for more info."
(if (looking-at c-nonsymbol-token-regexp)
(goto-char (match-end 0))
;; `c-nonsymbol-token-regexp' should always match since
- ;; we've skipped backward over punctuator or paren
+ ;; we've skipped backward over punctuation or paren
;; syntax, but move forward in case it doesn't so that
;; we don't leave point earlier than we started with.
(forward-char))
@@ -3727,8 +3792,8 @@ comment at the start of cc-engine.el for more info."
(defconst c-jump-syntax-balanced
(if (memq 'gen-string-delim c-emacs-features)
- "\\w\\|\\s_\\|\\s\(\\|\\s\)\\|\\s\"\\|\\s|"
- "\\w\\|\\s_\\|\\s\(\\|\\s\)\\|\\s\""))
+ "\\w\\|\\s_\\|\\s(\\|\\s)\\|\\s\"\\|\\s|"
+ "\\w\\|\\s_\\|\\s(\\|\\s)\\|\\s\""))
(defconst c-jump-syntax-unbalanced
(if (memq 'gen-string-delim c-emacs-features)
@@ -3895,7 +3960,7 @@ See `c-forward-token-2' for details."
tokens like \"==\" as single tokens, i.e. all sequences of symbol
characters are jumped over character by character. This function is
for compatibility only; it's only a wrapper over `c-forward-token-2'."
- (let ((c-nonsymbol-token-regexp "\\s.\\|\\s\(\\|\\s\)"))
+ (let ((c-nonsymbol-token-regexp "\\s."))
(c-forward-token-2 count balanced limit)))
(defun c-backward-token-1 (&optional count balanced limit)
@@ -3903,7 +3968,7 @@ for compatibility only; it's only a wrapper over `c-forward-token-2'."
tokens like \"==\" as single tokens, i.e. all sequences of symbol
characters are jumped over character by character. This function is
for compatibility only; it's only a wrapper over `c-backward-token-2'."
- (let ((c-nonsymbol-token-regexp "\\s.\\|\\s\(\\|\\s\)"))
+ (let ((c-nonsymbol-token-regexp "\\s."))
(c-backward-token-2 count balanced limit)))
@@ -4144,7 +4209,7 @@ comment at the start of cc-engine.el for more info."
;; Use `parse-partial-sexp' from a safe position down to the point to check
;; if it's outside comments and strings.
(save-excursion
- (let ((pos (point)) safe-pos state pps-end-pos)
+ (let ((pos (point)) safe-pos state)
;; Pick a safe position as close to the point as possible.
;;
;; FIXME: Consult `syntax-ppss' here if our cache doesn't give a good
@@ -4226,16 +4291,18 @@ comment at the start of cc-engine.el for more info."
;; loops when it hasn't succeeded.
(while
(and
- (< (skip-chars-backward skip-chars limit) 0)
+ (let ((pos (point)))
+ (while (and
+ (< (skip-chars-backward skip-chars limit) 0)
+ ;; Don't stop inside a literal.
+ (when (setq lit-beg (c-ssb-lit-begin))
+ (goto-char lit-beg)
+ t)))
+ (< (point) pos))
(let ((pos (point)) state-2 pps-end-pos)
(cond
- ;; Don't stop inside a literal
- ((setq lit-beg (c-ssb-lit-begin))
- (goto-char lit-beg)
- t)
-
((and paren-level
(save-excursion
(setq state-2 (parse-partial-sexp
@@ -4550,7 +4617,7 @@ comment at the start of cc-engine.el for more info."
(defun c-literal-type (range)
"Convenience function that given the result of `c-literal-limits',
returns nil or the type of literal that the range surrounds, one
-of the symbols 'c, 'c++ or 'string. It's much faster than using
+of the symbols `c', `c++' or `string'. It's much faster than using
`c-in-literal' and is intended to be used when you need both the
type of a literal and its limits.
@@ -4729,6 +4796,11 @@ comment at the start of cc-engine.el for more info."
;; inside `c-find-decl-spots'. The point is left at `cfd-match-pos'
;; if there is a match, otherwise at `cfd-limit'.
;;
+ ;; The macro moves point forward to the next putative start of a declaration
+ ;; or cfd-limit. This decl start is the next token after a "declaration
+ ;; prefix". The declaration prefix is the earlier of `cfd-prop-match' and
+ ;; `cfd-re-match'. `cfd-match-pos' is set to the decl prefix.
+ ;;
;; This macro might do hidden buffer changes.
'(progn
@@ -4736,7 +4808,7 @@ comment at the start of cc-engine.el for more info."
(unless cfd-prop-match
(save-excursion
(while (progn
- (goto-char (next-single-property-change
+ (goto-char (c-next-single-property-change
(point) 'c-type nil cfd-limit))
(and (< (point) cfd-limit)
(not (eq (c-get-char-property (1- (point)) 'c-type)
@@ -4750,34 +4822,47 @@ comment at the start of cc-engine.el for more info."
(if (> cfd-re-match-end (point))
(goto-char cfd-re-match-end))
- (while (if (setq cfd-re-match-end
- (re-search-forward c-decl-prefix-or-start-re
- cfd-limit 'move))
-
- ;; Match. Check if it's inside a comment or string literal.
- (c-got-face-at
- (if (setq cfd-re-match (match-end 1))
- ;; Matched the end of a token preceding a decl spot.
- (progn
- (goto-char cfd-re-match)
- (1- cfd-re-match))
- ;; Matched a token that start a decl spot.
- (goto-char (match-beginning 0))
- (point))
- c-literal-faces)
-
- ;; No match. Finish up and exit the loop.
- (setq cfd-re-match cfd-limit)
- nil)
-
- ;; Skip out of comments and string literals.
- (while (progn
- (goto-char (next-single-property-change
- (point) 'face nil cfd-limit))
- (and (< (point) cfd-limit)
- (c-got-face-at (point) c-literal-faces)))))
+ ;; Each time round, the next `while' moves forward over a pseudo match
+ ;; of `c-decl-prefix-or-start-re' which is either inside a literal, or
+ ;; is a ":" not preceded by "public", etc.. `cfd-re-match' and
+ ;; `cfd-re-match-end' get set.
+ (while
+ (progn
+ (setq cfd-re-match-end (re-search-forward c-decl-prefix-or-start-re
+ cfd-limit 'move))
+ (cond
+ ((null cfd-re-match-end)
+ ;; No match. Finish up and exit the loop.
+ (setq cfd-re-match cfd-limit)
+ nil)
+ ((c-got-face-at
+ (if (setq cfd-re-match (match-end 1))
+ ;; Matched the end of a token preceding a decl spot.
+ (progn
+ (goto-char cfd-re-match)
+ (1- cfd-re-match))
+ ;; Matched a token that start a decl spot.
+ (goto-char (match-beginning 0))
+ (point))
+ c-literal-faces)
+ ;; Pseudo match inside a comment or string literal. Skip out
+ ;; of comments and string literals.
+ (while (progn
+ (goto-char (c-next-single-property-change
+ (point) 'face nil cfd-limit))
+ (and (< (point) cfd-limit)
+ (c-got-face-at (point) c-literal-faces))))
+ t) ; Continue the loop over pseudo matches.
+ ((and (match-string 1)
+ (string= (match-string 1) ":")
+ (save-excursion
+ (or (/= (c-backward-token-2 2) 0) ; no search limit. :-(
+ (not (looking-at c-decl-start-colon-kwd-re)))))
+ ;; Found a ":" which isn't part of "public:", etc.
+ t)
+ (t nil)))) ;; Found a real match. Exit the pseudo-match loop.
- ;; If we matched at the decl start, we have to back up over the
+ ;; If our match was at the decl start, we have to back up over the
;; preceding syntactic ws to set `cfd-match-pos' and to catch
;; any decl spots in the syntactic ws.
(unless cfd-re-match
@@ -4818,14 +4903,17 @@ comment at the start of cc-engine.el for more info."
;; it should return non-nil to ensure that the next search will find them.
;;
;; Such a spot is:
- ;; o The first token after bob.
- ;; o The first token after the end of submatch 1 in
- ;; `c-decl-prefix-or-start-re' when that submatch matches.
- ;; o The start of each `c-decl-prefix-or-start-re' match when
- ;; submatch 1 doesn't match.
- ;; o The first token after the end of each occurrence of the
- ;; `c-type' text property with the value `c-decl-end', provided
- ;; `c-type-decl-end-used' is set.
+ ;; o The first token after bob.
+ ;; o The first token after the end of submatch 1 in
+ ;; `c-decl-prefix-or-start-re' when that submatch matches. This
+ ;; submatch is typically a (L or R) brace or paren, a ;, or a ,.
+ ;; o The start of each `c-decl-prefix-or-start-re' match when
+ ;; submatch 1 doesn't match. This is, for example, the keyword
+ ;; "class" in Pike.
+ ;; o The start of a previously recognized declaration; "recognized"
+ ;; means that the last char of the previous token has a `c-type'
+ ;; text property with the value `c-decl-end'; this only holds
+ ;; when `c-type-decl-end-used' is set.
;;
;; Only a spot that match CFD-DECL-RE and whose face is in the
;; CFD-FACE-CHECKLIST list causes CFD-FUN to be called. The face
@@ -4857,7 +4945,7 @@ comment at the start of cc-engine.el for more info."
;;
;; This function might do hidden buffer changes.
- (let ((cfd-start-pos (point))
+ (let ((cfd-start-pos (point)) ; never changed
(cfd-buffer-end (point-max))
;; The end of the token preceding the decl spot last found
;; with `c-decl-prefix-or-start-re'. `cfd-limit' if there's
@@ -4896,10 +4984,20 @@ comment at the start of cc-engine.el for more info."
;; statement or declaration, which is earlier than the first
;; returned match.
+ ;; This `cond' moves back over any literals or macros. It has special
+ ;; handling for when the region being searched is entirely within a
+ ;; macro. It sets `cfd-continue-pos' (unless we've reached
+ ;; `cfd-limit').
(cond
;; First we need to move to a syntactically relevant position.
;; Begin by backing out of comment or string literals.
+ ;;
+ ;; This arm of the cond actually triggers if we're in a literal,
+ ;; and cfd-limit is at most at BONL.
((and
+ ;; This arm of the `and' moves backwards out of a literal when
+ ;; the face at point is a literal face. In this case, its value
+ ;; is always non-nil.
(when (c-got-face-at (point) c-literal-faces)
;; Try to use the faces to back up to the start of the
;; literal. FIXME: What if the point is on a declaration
@@ -4928,7 +5026,7 @@ comment at the start of cc-engine.el for more info."
(let ((range (c-literal-limits)))
(if range (goto-char (car range)))))
- (setq start-in-literal (point)))
+ (setq start-in-literal (point))) ; end of `and' arm.
;; The start is in a literal. If the limit is in the same
;; one we don't have to find a syntactic position etc. We
@@ -4939,22 +5037,22 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char cfd-start-pos)
(while (progn
- (goto-char (next-single-property-change
+ (goto-char (c-next-single-property-change
(point) 'face nil cfd-limit))
(and (< (point) cfd-limit)
(c-got-face-at (point) c-literal-faces))))
- (= (point) cfd-limit)))
+ (= (point) cfd-limit))) ; end of `cond' arm condition
;; Completely inside a literal. Set up variables to trig the
;; (< cfd-continue-pos cfd-start-pos) case below and it'll
;; find a suitable start position.
- (setq cfd-continue-pos start-in-literal))
+ (setq cfd-continue-pos start-in-literal)) ; end of `cond' arm
;; Check if the region might be completely inside a macro, to
;; optimize that like the completely-inside-literal above.
((save-excursion
(and (= (forward-line 1) 0)
- (bolp) ; forward-line has funny behavior at eob.
+ (bolp) ; forward-line has funny behavior at eob.
(>= (point) cfd-limit)
(progn (backward-char)
(eq (char-before) ?\\))))
@@ -4964,6 +5062,8 @@ comment at the start of cc-engine.el for more info."
(setq cfd-continue-pos (1- cfd-start-pos)
start-in-macro t))
+ ;; The default arm of the `cond' moves back over any macro we're in
+ ;; and over any syntactic WS. It sets `c-find-decl-syntactic-pos'.
(t
;; Back out of any macro so we don't miss any declaration
;; that could follow after it.
@@ -5010,10 +5110,10 @@ comment at the start of cc-engine.el for more info."
(< (point) cfd-limit))
;; Do an initial search now. In the bob case above it's
;; only done to search for a `c-decl-end' spot.
- (c-find-decl-prefix-search))
+ (c-find-decl-prefix-search)) ; sets cfd-continue-pos
(setq c-find-decl-match-pos (and (< cfd-match-pos cfd-start-pos)
- cfd-match-pos)))))
+ cfd-match-pos))))) ; end of `cond'
;; Advance `cfd-continue-pos' if it's before the start position.
;; The closest continue position that might have effect at or
@@ -5072,7 +5172,7 @@ comment at the start of cc-engine.el for more info."
;; `cfd-match-pos' so we can continue at the start position.
;; (Note that we don't get here if the first match is below
;; it.)
- (goto-char cfd-start-pos)))
+ (goto-char cfd-start-pos))) ; end of `cond'
;; Delete found matches if they are before our new continue
;; position, so that `c-find-decl-prefix-search' won't back up
@@ -5081,7 +5181,7 @@ comment at the start of cc-engine.el for more info."
(when (and cfd-re-match (< cfd-re-match cfd-continue-pos))
(setq cfd-re-match nil))
(when (and cfd-prop-match (< cfd-prop-match cfd-continue-pos))
- (setq cfd-prop-match nil)))
+ (setq cfd-prop-match nil))) ; end of `when'
(if syntactic-pos
;; This is the normal case and we got a proper syntactic
@@ -5102,9 +5202,10 @@ comment at the start of cc-engine.el for more info."
;; good start position for the search, so do it.
(c-find-decl-prefix-search)))
- ;; Now loop. Round what? (ACM, 2006/7/5). We already got the first match.
-
+ ;; Now loop, one decl spot per iteration. We already have the first
+ ;; match in `cfd-match-pos'.
(while (progn
+ ;; Go forward over "false matches", one per iteration.
(while (and
(< cfd-match-pos cfd-limit)
@@ -5145,10 +5246,10 @@ comment at the start of cc-engine.el for more info."
(goto-char cfd-continue-pos)
t)))
- (< (point) cfd-limit))
- (c-find-decl-prefix-search))
+ (< (point) cfd-limit)) ; end of "false matches" condition
+ (c-find-decl-prefix-search)) ; end of "false matches" loop
- (< (point) cfd-limit))
+ (< (point) cfd-limit)) ; end of condition for "decl-spot" while
(when (and
(>= (point) cfd-start-pos)
@@ -5176,7 +5277,7 @@ comment at the start of cc-engine.el for more info."
;; The matched token was the last thing in the macro,
;; so the whole match is bogus.
(setq cfd-macro-end 0)
- nil))))
+ nil)))) ; end of when condition
(c-debug-put-decl-spot-faces cfd-match-pos (point))
(if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0))
@@ -5356,8 +5457,8 @@ comment at the start of cc-engine.el for more info."
(c-go-list-forward))
(when (equal (c-get-char-property (1- (point)) 'syntax-table)
c->-as-paren-syntax) ; should always be true.
- (c-clear-char-property (1- (point)) 'category))
- (c-clear-char-property pos 'category))))
+ (c-unmark-<->-as-paren (1- (point))))
+ (c-unmark-<->-as-paren pos))))
(defun c-clear->-pair-props (&optional pos)
;; POS (default point) is at a > character. If it is marked with
@@ -5373,8 +5474,8 @@ comment at the start of cc-engine.el for more info."
(c-go-up-list-backward))
(when (equal (c-get-char-property (point) 'syntax-table)
c-<-as-paren-syntax) ; should always be true.
- (c-clear-char-property (point) 'category))
- (c-clear-char-property pos 'category))))
+ (c-unmark-<->-as-paren (point)))
+ (c-unmark-<->-as-paren pos))))
(defun c-clear-<>-pair-props (&optional pos)
;; POS (default point) is at a < or > character. If it has an
@@ -5463,9 +5564,10 @@ comment at the start of cc-engine.el for more info."
(c-syntactic-skip-backward "^;{}" (c-determine-limit 512))
(setq new-beg (point))
- ;; Remove the syntax-table properties from each pertinent <...> pair.
- ;; Firsly, the ones with the < before beg and > after beg.
- (while (c-search-forward-char-property 'category 'c-<-as-paren-syntax beg)
+ ;; Remove the syntax-table/category properties from each pertinent <...>
+ ;; pair. Firsly, the ones with the < before beg and > after beg.
+ (while
+ (c-search-forward-char-property 'syntax-table c-<-as-paren-syntax beg)
(if (c-clear-<-pair-props-if-match-after beg (1- (point)))
(setq need-new-beg t)))
@@ -5476,7 +5578,7 @@ comment at the start of cc-engine.el for more info."
;; Remove syntax-table properties from the remaining pertinent <...>
;; pairs, those with a > after end and < before end.
- (while (c-search-backward-char-property 'category 'c->-as-paren-syntax end)
+ (while (c-search-backward-char-property 'syntax-table c->-as-paren-syntax end)
(if (c-clear->-pair-props-if-match-before end)
(setq need-new-end t)))
@@ -5489,8 +5591,6 @@ comment at the start of cc-engine.el for more info."
(when need-new-end
(and (> new-end c-new-END) (setq c-new-END new-end))))))
-
-
(defun c-after-change-check-<>-operators (beg end)
;; This is called from `after-change-functions' when
;; c-recognize-<>-arglists' is set. It ensures that no "<" or ">"
@@ -5825,7 +5925,6 @@ comment at the start of cc-engine.el for more info."
;; Recursive part of `c-forward-<>-arglist'.
;;
;; This function might do hidden buffer changes.
-
(let ((start (point)) res pos tmp
;; Cover this so that any recorded found type ranges are
;; automatically lost if it turns out to not be an angle
@@ -5861,32 +5960,31 @@ comment at the start of cc-engine.el for more info."
(while (and
(progn
(c-forward-syntactic-ws)
- (let ((orig-record-found-types c-record-found-types))
- (when (or (and c-record-type-identifiers all-types)
- (c-major-mode-is 'java-mode))
- ;; All encountered identifiers are types, so set the
- ;; promote flag and parse the type.
- (progn
- (c-forward-syntactic-ws)
- (if (looking-at "\\?")
- (forward-char)
- (when (looking-at c-identifier-start)
- (let ((c-promote-possible-types t)
- (c-record-found-types t))
- (c-forward-type))))
-
- (c-forward-syntactic-ws)
-
- (when (or (looking-at "extends")
- (looking-at "super"))
- (forward-word)
- (c-forward-syntactic-ws)
+ (when (or (and c-record-type-identifiers all-types)
+ (c-major-mode-is 'java-mode))
+ ;; All encountered identifiers are types, so set the
+ ;; promote flag and parse the type.
+ (progn
+ (c-forward-syntactic-ws)
+ (if (looking-at "\\?")
+ (forward-char)
+ (when (looking-at c-identifier-start)
(let ((c-promote-possible-types t)
(c-record-found-types t))
- (c-forward-type)
- (c-forward-syntactic-ws))))))
+ (c-forward-type))))
+
+ (c-forward-syntactic-ws)
- (setq pos (point)) ; e.g. first token inside the '<'
+ (when (or (looking-at "extends")
+ (looking-at "super"))
+ (forward-word)
+ (c-forward-syntactic-ws)
+ (let ((c-promote-possible-types t)
+ (c-record-found-types t))
+ (c-forward-type)
+ (c-forward-syntactic-ws)))))
+
+ (setq pos (point)) ; e.g. first token inside the '<'
;; Note: These regexps exploit the match order in \| so
;; that "<>" is matched by "<" rather than "[^>:-]>".
@@ -5902,7 +6000,7 @@ comment at the start of cc-engine.el for more info."
;; Either an operator starting with '>' or the end of
;; the angle bracket arglist.
- (if (looking-at c->-op-cont-regexp)
+ (if (looking-at c->-op-without->-cont-regexp)
(progn
(goto-char (match-end 0))
t) ; Continue the loop.
@@ -5951,7 +6049,6 @@ comment at the start of cc-engine.el for more info."
(c-keyword-member
(c-keyword-sym (match-string 1))
'c-<>-type-kwds)))))))
-
;; It was an angle bracket arglist.
(setq c-record-found-types subres)
@@ -5977,7 +6074,7 @@ comment at the start of cc-engine.el for more info."
(or (and (eq (char-before) ?&)
(not (eq (char-after) ?&)))
(eq (char-before) ?,)))
- ;; Just another argument. Record the position. The
+ ;; Just another argument. Record the position. The
;; type check stuff that made us stop at it is at
;; the top of the loop.
(setq arg-start-pos (cons (point) arg-start-pos)))
@@ -6244,7 +6341,8 @@ comment at the start of cc-engine.el for more info."
;; `*-font-lock-extra-types');
;; o - 'prefix if it's a known prefix of a type;
;; 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; or
+ ;; o - 'maybe if it's an identifier that might be a type;
+ ;; o - 'decltype if it's a decltype(variable) declaration; - or
;; 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.
@@ -6274,6 +6372,16 @@ comment at the start of cc-engine.el for more info."
(setq res 'prefix)))
(cond
+ ((looking-at c-typeof-key) ; e.g. C++'s "decltype".
+ (goto-char (match-end 1))
+ (c-forward-syntactic-ws)
+ (setq res (and (eq (char-after) ?\()
+ (c-safe (c-forward-sexp))
+ 'decltype))
+ (if res
+ (c-forward-syntactic-ws)
+ (goto-char start)))
+
((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT
; "typedef".
(goto-char (match-end 1))
@@ -6389,18 +6497,19 @@ comment at the start of cc-engine.el for more info."
(setq res nil)))))
(when res
- ;; Skip trailing type modifiers. If any are found we know it's
+ ;; Skip trailing type modifiers. If any are found we know it's
;; a type.
(when c-opt-type-modifier-key
(while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile"
(goto-char (match-end 1))
(c-forward-syntactic-ws)
(setq res t)))
+
;; Step over any type suffix operator. Do not let the existence
;; of these alter the classification of the found type, since
;; these operators typically are allowed in normal expressions
;; too.
- (when c-opt-type-suffix-key
+ (when c-opt-type-suffix-key ; e.g. "..."
(while (looking-at c-opt-type-suffix-key)
(goto-char (match-end 1))
(c-forward-syntactic-ws)))
@@ -6477,7 +6586,46 @@ comment at the start of cc-engine.el for more info."
(progn (c-forward-syntactic-ws) t)
(if (looking-at "(")
(c-go-list-forward)
- t)))
+ t)))
+
+(defmacro c-pull-open-brace (ps)
+ ;; Pull the next open brace from PS (which has the form of paren-state),
+ ;; skipping over any brace pairs. Returns NIL when PS is exhausted.
+ `(progn
+ (while (consp (car ,ps))
+ (setq ,ps (cdr ,ps)))
+ (prog1 (car ,ps)
+ (setq ,ps (cdr ,ps)))))
+
+(defun c-back-over-member-initializer-braces ()
+ ;; Point is just after a closing brace/parenthesis. Try to parse this as a
+ ;; C++ member initializer list, going back to just after the introducing ":"
+ ;; and returning t. Otherwise return nil, leaving point unchanged.
+ (let ((here (point)) res)
+ (setq res
+ (catch 'done
+ (when (not (c-go-list-backward))
+ (throw 'done nil))
+ (c-backward-syntactic-ws)
+ (when (not (c-simple-skip-symbol-backward))
+ (throw 'done nil))
+ (c-backward-syntactic-ws)
+
+ (while (eq (char-before) ?,)
+ (backward-char)
+ (c-backward-syntactic-ws)
+ (when (not (memq (char-before) '(?\) ?})))
+ (throw 'done nil))
+ (when (not (c-go-list-backward))
+ (throw 'done nil))
+ (c-backward-syntactic-ws)
+ (when (not (c-simple-skip-symbol-backward))
+ (throw 'done nil))
+ (c-backward-syntactic-ws))
+
+ (eq (char-before) ?:)))
+ (or res (goto-char here))
+ res))
(defun c-back-over-member-initializers ()
;; Test whether we are in a C++ member initializer list, and if so, go back
@@ -6603,6 +6751,13 @@ comment at the start of cc-engine.el for more info."
;; Foo::Foo (int b) : Base (b) {}
;; car ^ ^ point
;;
+ ;; auto foo = 5;
+ ;; car ^ ^ point
+ ;; auto cplusplus_11 (int a, char *b) -> decltype (bar):
+ ;; car ^ ^ point
+ ;;
+ ;;
+ ;;
;; The cdr of the return value is non-nil when a
;; `c-typedef-decl-kwds' specifier is found in the declaration.
;; Specifically it is a dotted pair (A . B) where B is t when a
@@ -6668,6 +6823,10 @@ comment at the start of cc-engine.el for more info."
;; If `backup-at-type' is nil then the other variables have
;; undefined values.
backup-at-type backup-type-start backup-id-start
+ ;; This stores `kwd-sym' of the symbol before the current one.
+ ;; This is needed to distinguish the C++11 version of "auto" from
+ ;; the pre C++11 meaning.
+ backup-kwd-sym
;; Set if we've found a specifier (apart from "typedef") that makes
;; the defined identifier(s) types.
at-type-decl
@@ -6676,6 +6835,10 @@ comment at the start of cc-engine.el for more info."
;; Set if we've found a specifier that can start a declaration
;; where there's no type.
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
;; 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
@@ -6693,6 +6856,8 @@ comment at the start of cc-engine.el for more info."
backup-if-not-cast
;; For casts, the return position.
cast-end
+ ;; Have we got a new-style C++11 "auto"?
+ new-style-auto
;; Save `c-record-type-identifiers' and
;; `c-record-ref-identifiers' since ranges are recorded
;; speculatively and should be thrown away if it turns out
@@ -6711,11 +6876,12 @@ comment at the start of cc-engine.el for more info."
(let* ((start (point)) kwd-sym kwd-clause-end found-type)
;; Look for a specifier keyword clause.
- (when (or (looking-at c-prefix-spec-kwds-re)
+ (when (or (looking-at c-prefix-spec-kwds-re) ;FIXME!!! includes auto
(and (c-major-mode-is 'java-mode)
(looking-at "@[A-Za-z0-9]+")))
- (if (looking-at c-typedef-key)
- (setq at-typedef t))
+ (save-match-data
+ (if (looking-at c-typedef-key)
+ (setq at-typedef t)))
(setq kwd-sym (c-keyword-sym (match-string 1)))
(save-excursion
(c-forward-keyword-clause 1)
@@ -6723,6 +6889,12 @@ comment at the start of cc-engine.el for more info."
(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 at-type
;; Got two identifiers with nothing but whitespace
@@ -6741,6 +6913,7 @@ comment at the start of cc-engine.el for more info."
(setq backup-at-type at-type
backup-type-start type-start
backup-id-start id-start
+ backup-kwd-sym kwd-sym
at-type found-type
type-start start
id-start (point)
@@ -6796,6 +6969,7 @@ comment at the start of cc-engine.el for more info."
;; specifier keyword and we know we're in a
;; declaration.
(setq at-decl-or-cast t)
+ (setq prev-kwd-sym kwd-sym)
(goto-char kwd-clause-end))))
@@ -6890,45 +7064,57 @@ comment at the start of cc-engine.el for more info."
;; can happen since we don't know if
;; `c-restricted-<>-arglists' will be correct inside the
;; arglist paren that gets entered.
- c-parse-and-markup-<>-arglists)
+ c-parse-and-markup-<>-arglists
+ ;; Start of the identifier for which `got-identifier' was set.
+ name-start)
(goto-char id-start)
;; Skip over type decl prefix operators. (Note similar code in
;; `c-font-lock-declarators'.)
- (while (and (looking-at c-type-decl-prefix-key)
- (if (and (c-major-mode-is 'c++-mode)
- (match-beginning 3))
- ;; If the third submatch matches in C++ then
- ;; we're looking at an identifier that's a
- ;; prefix only if it specifies a member pointer.
- (when (setq got-identifier (c-forward-name))
- (if (looking-at "\\(::\\)")
- ;; We only check for a trailing "::" and
- ;; let the "*" that should follow be
- ;; matched in the next round.
- (progn (setq got-identifier nil) t)
- ;; It turned out to be the real identifier,
- ;; so stop.
- nil))
- t))
-
- (if (eq (char-after) ?\()
+ (if (and c-recognize-typeless-decls
+ (equal c-type-decl-prefix-key "\\<\\>"))
+ (when (eq (char-after) ?\()
(progn
(setq paren-depth (1+ paren-depth))
- (forward-char))
- (unless got-prefix-before-parens
- (setq got-prefix-before-parens (= paren-depth 0)))
- (setq got-prefix t)
- (goto-char (match-end 1)))
- (c-forward-syntactic-ws))
+ (forward-char)))
+ (while (and (looking-at c-type-decl-prefix-key)
+ (if (and (c-major-mode-is 'c++-mode)
+ (match-beginning 3))
+ ;; If the third submatch matches in C++ then
+ ;; we're looking at an identifier that's a
+ ;; prefix only if it specifies a member pointer.
+ (when (progn (setq pos (point))
+ (setq got-identifier (c-forward-name)))
+ (setq name-start pos)
+ (if (looking-at "\\(::\\)")
+ ;; We only check for a trailing "::" and
+ ;; let the "*" that should follow be
+ ;; matched in the next round.
+ (progn (setq got-identifier nil) t)
+ ;; It turned out to be the real identifier,
+ ;; so stop.
+ nil))
+ t))
+
+ (if (eq (char-after) ?\()
+ (progn
+ (setq paren-depth (1+ paren-depth))
+ (forward-char))
+ (unless got-prefix-before-parens
+ (setq got-prefix-before-parens (= paren-depth 0)))
+ (setq got-prefix t)
+ (goto-char (match-end 1)))
+ (c-forward-syntactic-ws)))
(setq got-parens (> paren-depth 0))
;; Skip over an identifier.
(or got-identifier
(and (looking-at c-identifier-start)
- (setq got-identifier (c-forward-name))))
+ (setq pos (point))
+ (setq got-identifier (c-forward-name))
+ (setq name-start pos)))
;; Skip over type decl suffix operators.
(while (if (looking-at c-type-decl-suffix-key)
@@ -6938,7 +7124,7 @@ comment at the start of cc-engine.el for more info."
(setq paren-depth (1- paren-depth))
(forward-char)
t)
- (when (if (save-match-data (looking-at "\\s\("))
+ (when (if (save-match-data (looking-at "\\s("))
(c-safe (c-forward-sexp 1) t)
(goto-char (match-end 1))
t)
@@ -6975,70 +7161,84 @@ comment at the start of cc-engine.el for more info."
(c-forward-syntactic-ws))
- (when (and (or maybe-typeless backup-maybe-typeless)
- (not got-identifier)
- (not got-prefix)
- at-type)
+ (when (or (and new-style-auto
+ (looking-at c-auto-ops-re))
+ (and (or maybe-typeless backup-maybe-typeless)
+ (not got-identifier)
+ (not got-prefix)
+ at-type))
;; Have found no identifier but `c-typeless-decl-kwds' has
;; matched so we know we're inside a declaration. The
;; preceding type must be the identifier instead.
(c-fdoc-shift-type-backward))
+ ;; Prepare the "-> type;" for fontification later on.
+ (when (and new-style-auto
+ (looking-at c-haskell-op-re))
+ (save-excursion
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws)
+ (setq type-start (point))
+ (setq at-type (c-forward-type))))
+
(setq
at-decl-or-cast
(catch 'at-decl-or-cast
;; CASE 1
- (when (> paren-depth 0)
- ;; Encountered something inside parens that isn't matched by
- ;; the `c-type-decl-*' regexps, so it's not a type decl
- ;; expression. Try to skip out to the same paren depth to
- ;; not confuse the cast check below.
- (c-safe (goto-char (scan-lists (point) 1 paren-depth)))
- ;; If we've found a specifier keyword then it's a
- ;; declaration regardless.
- (throw 'at-decl-or-cast (eq at-decl-or-cast t)))
-
- (setq at-decl-end
- (looking-at (cond ((eq context '<>) "[,>]")
- (context "[,\)]")
- (t "[,;]"))))
-
- ;; Now we've collected info about various characteristics of
- ;; the construct we're looking at. Below follows a decision
- ;; tree based on that. It's ordered to check more certain
- ;; signs before less certain ones.
-
- (if got-identifier
- (progn
+ (when (> paren-depth 0)
+ ;; Encountered something inside parens that isn't matched by
+ ;; the `c-type-decl-*' regexps, so it's not a type decl
+ ;; expression. Try to skip out to the same paren depth to
+ ;; not confuse the cast check below.
+ (c-safe (goto-char (scan-lists (point) 1 paren-depth)))
+ ;; If we've found a specifier keyword then it's a
+ ;; declaration regardless.
+ (throw 'at-decl-or-cast (eq at-decl-or-cast t)))
+
+ (setq at-decl-end
+ (looking-at (cond ((eq context '<>) "[,>]")
+ (context "[,)]")
+ (t "[,;]"))))
+
+ ;; Now we've collected info about various characteristics of
+ ;; the construct we're looking at. Below follows a decision
+ ;; tree based on that. It's ordered to check more certain
+ ;; signs before less certain ones.
+
+ (if got-identifier
+ (progn
- ;; CASE 2
- (when (and (or at-type maybe-typeless)
- (not (or got-prefix got-parens)))
- ;; Got another identifier directly after the type, so it's a
- ;; declaration.
- (throw 'at-decl-or-cast t))
-
- (when (and got-parens
- (not got-prefix)
- (not got-suffix-after-parens)
- (or backup-at-type
- maybe-typeless
- backup-maybe-typeless))
- ;; Got a declaration of the form "foo bar (gnu);" where we've
- ;; recognized "bar" as the type and "gnu" as the declarator.
- ;; In this case it's however more likely that "bar" is the
- ;; declarator and "gnu" a function argument or initializer (if
- ;; `c-recognize-paren-inits' is set), since the parens around
- ;; "gnu" would be superfluous if it's a declarator. Shift the
- ;; type one step backward.
- (c-fdoc-shift-type-backward)))
-
- ;; Found no identifier.
-
- (if backup-at-type
- (progn
+ ;; CASE 2
+ (when (and (or at-type maybe-typeless)
+ (not (or got-prefix got-parens)))
+ ;; Got another identifier directly after the type, so it's a
+ ;; declaration.
+ (throw 'at-decl-or-cast t))
+ (when (and got-parens
+ (not got-prefix)
+ ;; (not got-suffix-after-parens)
+ (or backup-at-type
+ maybe-typeless
+ backup-maybe-typeless
+ (eq at-decl-or-cast t)
+ (save-excursion
+ (goto-char name-start)
+ (not (memq (c-forward-type) '(nil maybe))))))
+ ;; Got a declaration of the form "foo bar (gnu);" or "bar
+ ;; (gnu);" where we've recognized "bar" as the type and "gnu"
+ ;; as the declarator. In this case it's however more likely
+ ;; that "bar" is the declarator and "gnu" a function argument
+ ;; or initializer (if `c-recognize-paren-inits' is set),
+ ;; since the parens around "gnu" would be superfluous if it's
+ ;; a declarator. Shift the type one step backward.
+ (c-fdoc-shift-type-backward)))
+
+ ;; Found no identifier.
+
+ (if backup-at-type
+ (progn
;; CASE 3
(when (= (point) start)
@@ -7061,250 +7261,251 @@ comment at the start of cc-engine.el for more info."
(setq backup-if-not-cast t)
(throw 'at-decl-or-cast t)))
- ;; CASE 4
- (when (and got-suffix
- (not got-prefix)
- (not got-parens))
- ;; Got a plain list of identifiers followed by some suffix.
- ;; If this isn't a cast then the last identifier probably is
- ;; the declared one and we should back up to the previous
- ;; type.
- (setq backup-if-not-cast t)
- (throw 'at-decl-or-cast t)))
-
- ;; CASE 5
- (when (eq at-type t)
- ;; If the type is known we know that there can't be any
- ;; identifier somewhere else, and it's only in declarations in
- ;; e.g. function prototypes and in casts that the identifier may
- ;; be left out.
- (throw 'at-decl-or-cast t))
-
- (when (= (point) start)
- ;; Only got a single identifier (parsed as a type so far).
- ;; CASE 6
- (if (and
- ;; Check that the identifier isn't at the start of an
- ;; expression.
- at-decl-end
- (cond
- ((eq context 'decl)
- ;; Inside an arglist that contains declarations. If K&R
- ;; style declarations and parenthesis style initializers
- ;; aren't allowed then the single identifier must be a
- ;; type, else we require that it's known or found
- ;; (primitive types are handled above).
- (or (and (not c-recognize-knr-p)
- (not c-recognize-paren-inits))
- (memq at-type '(known found))))
- ((eq context '<>)
- ;; Inside a template arglist. Accept known and found
- ;; types; other identifiers could just as well be
- ;; constants in C++.
- (memq at-type '(known found)))))
- (throw 'at-decl-or-cast t)
- ;; CASE 7
- ;; Can't be a valid declaration or cast, but if we've found a
- ;; specifier it can't be anything else either, so treat it as
- ;; an invalid/unfinished declaration or cast.
- (throw 'at-decl-or-cast at-decl-or-cast))))
-
- (if (and got-parens
- (not got-prefix)
- (not context)
- (not (eq at-type t))
- (or backup-at-type
- maybe-typeless
- backup-maybe-typeless
- (when c-recognize-typeless-decls
- (or (not got-suffix)
- (not (looking-at
- c-after-suffixed-type-maybe-decl-key))))))
- ;; Got an empty paren pair and a preceding type that probably
- ;; really is the identifier. Shift the type backwards to make
- ;; the last one the identifier. This is analogous to the
- ;; "backtracking" done inside the `c-type-decl-suffix-key' loop
- ;; above.
- ;;
- ;; Exception: In addition to the conditions in that
- ;; "backtracking" code, do not shift backward if we're not
- ;; looking at either `c-after-suffixed-type-decl-key' or "[;,]".
- ;; Since there's no preceding type, the shift would mean that
- ;; the declaration is typeless. But if the regexp doesn't match
- ;; then we will simply fall through in the tests below and not
- ;; recognize it at all, so it's better to try it as an abstract
- ;; declarator instead.
- (c-fdoc-shift-type-backward)
-
- ;; Still no identifier.
- ;; CASE 8
- (when (and got-prefix (or got-parens got-suffix))
- ;; Require `got-prefix' together with either `got-parens' or
- ;; `got-suffix' to recognize it as an abstract declarator:
- ;; `got-parens' only is probably an empty function call.
- ;; `got-suffix' only can build an ordinary expression together
- ;; with the preceding identifier which we've taken as a type.
- ;; We could actually accept on `got-prefix' only, but that can
- ;; easily occur temporarily while writing an expression so we
- ;; avoid that case anyway. We could do a better job if we knew
- ;; the point when the fontification was invoked.
- (throw 'at-decl-or-cast t))
-
- ;; CASE 9
- (when (and at-type
- (not got-prefix)
- (not got-parens)
- got-suffix-after-parens
- (eq (char-after got-suffix-after-parens) ?\())
- ;; Got a type, no declarator but a paren suffix. I.e. it's a
- ;; normal function call after all (or perhaps a C++ style object
- ;; instantiation expression).
- (throw 'at-decl-or-cast nil))))
-
- ;; CASE 10
- (when at-decl-or-cast
- ;; By now we've located the type in the declaration that we know
- ;; we're in.
- (throw 'at-decl-or-cast t))
-
- ;; CASE 11
- (when (and got-identifier
- (not context)
- (looking-at c-after-suffixed-type-decl-key)
- (if (and got-parens
+ ;; CASE 4
+ (when (and got-suffix
(not got-prefix)
- (not got-suffix)
- (not (eq at-type t)))
- ;; Shift the type backward in the case that there's a
- ;; single identifier inside parens. That can only
- ;; occur in K&R style function declarations so it's
- ;; more likely that it really is a function call.
- ;; Therefore we only do this after
- ;; `c-after-suffixed-type-decl-key' has matched.
- (progn (c-fdoc-shift-type-backward) t)
- got-suffix-after-parens))
- ;; A declaration according to `c-after-suffixed-type-decl-key'.
- (throw 'at-decl-or-cast t))
-
- ;; CASE 12
- (when (and (or got-prefix (not got-parens))
- (memq at-type '(t known)))
- ;; It's a declaration if a known type precedes it and it can't be a
- ;; function call.
- (throw 'at-decl-or-cast t))
-
- ;; If we get here we can't tell if this is a type decl or a normal
- ;; expression by looking at it alone. (That's under the assumption
- ;; that normal expressions always can look like type decl expressions,
- ;; which isn't really true but the cases where it doesn't hold are so
- ;; uncommon (e.g. some placements of "const" in C++) it's not worth
- ;; the effort to look for them.)
+ (not got-parens))
+ ;; Got a plain list of identifiers followed by some suffix.
+ ;; If this isn't a cast then the last identifier probably is
+ ;; the declared one and we should back up to the previous
+ ;; type.
+ (setq backup-if-not-cast t)
+ (throw 'at-decl-or-cast t)))
+
+ ;; CASE 5
+ (when (eq at-type t)
+ ;; If the type is known we know that there can't be any
+ ;; identifier somewhere else, and it's only in declarations in
+ ;; e.g. function prototypes and in casts that the identifier may
+ ;; be left out.
+ (throw 'at-decl-or-cast t))
+
+ (when (= (point) start)
+ ;; Only got a single identifier (parsed as a type so far).
+ ;; CASE 6
+ (if (and
+ ;; Check that the identifier isn't at the start of an
+ ;; expression.
+ at-decl-end
+ (cond
+ ((eq context 'decl)
+ ;; Inside an arglist that contains declarations. If K&R
+ ;; style declarations and parenthesis style initializers
+ ;; aren't allowed then the single identifier must be a
+ ;; type, else we require that it's known or found
+ ;; (primitive types are handled above).
+ (or (and (not c-recognize-knr-p)
+ (not c-recognize-paren-inits))
+ (memq at-type '(known found))))
+ ((eq context '<>)
+ ;; Inside a template arglist. Accept known and found
+ ;; types; other identifiers could just as well be
+ ;; constants in C++.
+ (memq at-type '(known found)))))
+ (throw 'at-decl-or-cast t)
+ ;; CASE 7
+ ;; Can't be a valid declaration or cast, but if we've found a
+ ;; specifier it can't be anything else either, so treat it as
+ ;; an invalid/unfinished declaration or cast.
+ (throw 'at-decl-or-cast at-decl-or-cast))))
+
+ (if (and got-parens
+ (not got-prefix)
+ (not context)
+ (not (eq at-type t))
+ (or backup-at-type
+ maybe-typeless
+ backup-maybe-typeless
+ (when c-recognize-typeless-decls
+ (or (not got-suffix)
+ (not (looking-at
+ c-after-suffixed-type-maybe-decl-key))))))
+ ;; Got an empty paren pair and a preceding type that probably
+ ;; really is the identifier. Shift the type backwards to make
+ ;; the last one the identifier. This is analogous to the
+ ;; "backtracking" done inside the `c-type-decl-suffix-key' loop
+ ;; above.
+ ;;
+ ;; Exception: In addition to the conditions in that
+ ;; "backtracking" code, do not shift backward if we're not
+ ;; looking at either `c-after-suffixed-type-decl-key' or "[;,]".
+ ;; Since there's no preceding type, the shift would mean that
+ ;; the declaration is typeless. But if the regexp doesn't match
+ ;; then we will simply fall through in the tests below and not
+ ;; recognize it at all, so it's better to try it as an abstract
+ ;; declarator instead.
+ (c-fdoc-shift-type-backward)
+
+ ;; Still no identifier.
+ ;; CASE 8
+ (when (and got-prefix (or got-parens got-suffix))
+ ;; Require `got-prefix' together with either `got-parens' or
+ ;; `got-suffix' to recognize it as an abstract declarator:
+ ;; `got-parens' only is probably an empty function call.
+ ;; `got-suffix' only can build an ordinary expression together
+ ;; with the preceding identifier which we've taken as a type.
+ ;; We could actually accept on `got-prefix' only, but that can
+ ;; easily occur temporarily while writing an expression so we
+ ;; avoid that case anyway. We could do a better job if we knew
+ ;; the point when the fontification was invoked.
+ (throw 'at-decl-or-cast t))
+
+ ;; CASE 9
+ (when (and at-type
+ (not got-prefix)
+ (not got-parens)
+ got-suffix-after-parens
+ (eq (char-after got-suffix-after-parens) ?\())
+ ;; Got a type, no declarator but a paren suffix. I.e. it's a
+ ;; normal function call after all (or perhaps a C++ style object
+ ;; instantiation expression).
+ (throw 'at-decl-or-cast nil))))
+
+ ;; CASE 10
+ (when at-decl-or-cast
+ ;; By now we've located the type in the declaration that we know
+ ;; we're in.
+ (throw 'at-decl-or-cast t))
+
+ ;; CASE 11
+ (when (and got-identifier
+ (not context)
+ (looking-at c-after-suffixed-type-decl-key)
+ (if (and got-parens
+ (not got-prefix)
+ (not got-suffix)
+ (not (eq at-type t)))
+ ;; Shift the type backward in the case that there's a
+ ;; single identifier inside parens. That can only
+ ;; occur in K&R style function declarations so it's
+ ;; more likely that it really is a function call.
+ ;; Therefore we only do this after
+ ;; `c-after-suffixed-type-decl-key' has matched.
+ (progn (c-fdoc-shift-type-backward) t)
+ got-suffix-after-parens))
+ ;; A declaration according to `c-after-suffixed-type-decl-key'.
+ (throw 'at-decl-or-cast t))
+
+ ;; CASE 12
+ (when (and (or got-prefix (not got-parens))
+ (memq at-type '(t known)))
+ ;; It's a declaration if a known type precedes it and it can't be a
+ ;; function call.
+ (throw 'at-decl-or-cast t))
+
+ ;; If we get here we can't tell if this is a type decl or a normal
+ ;; expression by looking at it alone. (That's under the assumption
+ ;; that normal expressions always can look like type decl expressions,
+ ;; which isn't really true but the cases where it doesn't hold are so
+ ;; uncommon (e.g. some placements of "const" in C++) it's not worth
+ ;; the effort to look for them.)
;;; 2008-04-16: commented out the next form, to allow the function to recognize
;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon)
;;; as a(n almost complete) declaration, enabling it to be fontified.
- ;; CASE 13
- ;; (unless (or at-decl-end (looking-at "=[^=]"))
- ;; If this is a declaration it should end here or its initializer(*)
- ;; should start here, so check for allowed separation tokens. Note
- ;; that this rule doesn't work e.g. with a K&R arglist after a
- ;; function header.
- ;;
- ;; *) Don't check for C++ style initializers using parens
- ;; since those already have been matched as suffixes.
- ;;
- ;; If `at-decl-or-cast' is then we've found some other sign that
- ;; it's a declaration or cast, so then it's probably an
- ;; invalid/unfinished one.
- ;; (throw 'at-decl-or-cast at-decl-or-cast))
-
- ;; Below are tests that only should be applied when we're certain to
- ;; not have parsed halfway through an expression.
-
- ;; CASE 14
- (when (memq at-type '(t known))
- ;; The expression starts with a known type so treat it as a
- ;; declaration.
- (throw 'at-decl-or-cast t))
-
- ;; CASE 15
- (when (and (c-major-mode-is 'c++-mode)
- ;; In C++ we check if the identifier is a known type, since
- ;; (con|de)structors use the class name as identifier.
- ;; We've always shifted over the identifier as a type and
- ;; then backed up again in this case.
- identifier-type
- (or (memq identifier-type '(found known))
- (and (eq (char-after identifier-start) ?~)
- ;; `at-type' probably won't be 'found for
- ;; destructors since the "~" is then part of the
- ;; type name being checked against the list of
- ;; known types, so do a check without that
- ;; operator.
- (or (save-excursion
- (goto-char (1+ identifier-start))
- (c-forward-syntactic-ws)
- (c-with-syntax-table
- c-identifier-syntax-table
- (looking-at c-known-type-key)))
- (save-excursion
- (goto-char (1+ identifier-start))
- ;; We have already parsed the type earlier,
- ;; so it'd be possible to cache the end
- ;; position instead of redoing it here, but
- ;; then we'd need to keep track of another
- ;; position everywhere.
- (c-check-type (point)
- (progn (c-forward-type)
- (point))))))))
- (throw 'at-decl-or-cast t))
-
- (if got-identifier
- (progn
- ;; CASE 16
- (when (and got-prefix-before-parens
- at-type
- (or at-decl-end (looking-at "=[^=]"))
- (not context)
- (not got-suffix))
- ;; Got something like "foo * bar;". Since we're not inside an
- ;; arglist it would be a meaningless expression because the
- ;; result isn't used. We therefore choose to recognize it as
- ;; a declaration. Do not allow a suffix since it could then
- ;; be a function call.
- (throw 'at-decl-or-cast t))
-
- ;; CASE 17
- (when (and (or got-suffix-after-parens
- (looking-at "=[^=]"))
- (eq at-type 'found)
- (not (eq context 'arglist)))
- ;; Got something like "a (*b) (c);" or "a (b) = c;". It could
- ;; be an odd expression or it could be a declaration. Treat
- ;; it as a declaration if "a" has been used as a type
- ;; somewhere else (if it's a known type we won't get here).
- (throw 'at-decl-or-cast t)))
-
- ;; CASE 18
- (when (and context
- (or got-prefix
- (and (eq context 'decl)
- (not c-recognize-paren-inits)
- (or got-parens got-suffix))))
- ;; Got a type followed by an abstract declarator. If `got-prefix'
- ;; is set it's something like "a *" without anything after it. If
- ;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]",
- ;; or similar, which we accept only if the context rules out
- ;; expressions.
- (throw 'at-decl-or-cast t)))
-
- ;; If we had a complete symbol table here (which rules out
- ;; `c-found-types') we should return t due to the disambiguation rule
- ;; (in at least C++) that anything that can be parsed as a declaration
- ;; is a declaration. Now we're being more defensive and prefer to
- ;; highlight things like "foo (bar);" as a declaration only if we're
- ;; inside an arglist that contains declarations.
- (eq context 'decl))))
+ ;; CASE 13
+ ;; (unless (or at-decl-end (looking-at "=[^=]"))
+ ;; If this is a declaration it should end here or its initializer(*)
+ ;; should start here, so check for allowed separation tokens. Note
+ ;; that this rule doesn't work e.g. with a K&R arglist after a
+ ;; function header.
+ ;;
+ ;; *) Don't check for C++ style initializers using parens
+ ;; since those already have been matched as suffixes.
+ ;;
+ ;; If `at-decl-or-cast' is then we've found some other sign that
+ ;; it's a declaration or cast, so then it's probably an
+ ;; invalid/unfinished one.
+ ;; (throw 'at-decl-or-cast at-decl-or-cast))
+
+ ;; Below are tests that only should be applied when we're certain to
+ ;; not have parsed halfway through an expression.
+
+ ;; CASE 14
+ (when (memq at-type '(t known))
+ ;; The expression starts with a known type so treat it as a
+ ;; declaration.
+ (throw 'at-decl-or-cast t))
+
+ ;; CASE 15
+ (when (and (c-major-mode-is 'c++-mode)
+ ;; In C++ we check if the identifier is a known type, since
+ ;; (con|de)structors use the class name as identifier.
+ ;; We've always shifted over the identifier as a type and
+ ;; then backed up again in this case.
+ identifier-type
+ (or (memq identifier-type '(found known))
+ (and (eq (char-after identifier-start) ?~)
+ ;; `at-type' probably won't be 'found for
+ ;; destructors since the "~" is then part of the
+ ;; type name being checked against the list of
+ ;; known types, so do a check without that
+ ;; operator.
+ (or (save-excursion
+ (goto-char (1+ identifier-start))
+ (c-forward-syntactic-ws)
+ (c-with-syntax-table
+ c-identifier-syntax-table
+ (looking-at c-known-type-key)))
+ (save-excursion
+ (goto-char (1+ identifier-start))
+ ;; We have already parsed the type earlier,
+ ;; so it'd be possible to cache the end
+ ;; position instead of redoing it here, but
+ ;; then we'd need to keep track of another
+ ;; position everywhere.
+ (c-check-type (point)
+ (progn (c-forward-type)
+ (point))))))))
+ (throw 'at-decl-or-cast t))
+
+ (if got-identifier
+ (progn
+ ;; CASE 16
+ (when (and got-prefix-before-parens
+ at-type
+ (or at-decl-end (looking-at "=[^=]"))
+ (not context)
+ (not got-suffix))
+ ;; Got something like "foo * bar;". Since we're not inside an
+ ;; arglist it would be a meaningless expression because the
+ ;; result isn't used. We therefore choose to recognize it as
+ ;; a declaration. Do not allow a suffix since it could then
+ ;; be a function call.
+ (throw 'at-decl-or-cast t))
+
+ ;; CASE 17
+ (when (and (or got-suffix-after-parens
+ (looking-at "=[^=]"))
+ (eq at-type 'found)
+ (not (eq context 'arglist)))
+ ;; Got something like "a (*b) (c);" or "a (b) = c;". It could
+ ;; be an odd expression or it could be a declaration. Treat
+ ;; it as a declaration if "a" has been used as a type
+ ;; somewhere else (if it's a known type we won't get here).
+ (throw 'at-decl-or-cast t)))
+
+ ;; CASE 18
+ (when (and context
+ (or got-prefix
+ (and (eq context 'decl)
+ (not c-recognize-paren-inits)
+ (or got-parens got-suffix))))
+ ;; Got a type followed by an abstract declarator. If `got-prefix'
+ ;; is set it's something like "a *" without anything after it. If
+ ;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]",
+ ;; or similar, which we accept only if the context rules out
+ ;; expressions.
+ (throw 'at-decl-or-cast t)))
+
+ ;; If we had a complete symbol table here (which rules out
+ ;; `c-found-types') we should return t due to the disambiguation rule
+ ;; (in at least C++) that anything that can be parsed as a declaration
+ ;; is a declaration. Now we're being more defensive and prefer to
+ ;; highlight things like "foo (bar);" as a declaration only if we're
+ ;; inside an arglist that contains declarations.
+ ;; CASE 19
+ (eq context 'decl))))
;; The point is now after the type decl expression.
@@ -7321,7 +7522,7 @@ comment at the start of cc-engine.el for more info."
;; The closing paren should follow.
(progn
(c-forward-syntactic-ws)
- (looking-at "\\s\)"))
+ (looking-at "\\s)"))
;; There should be a primary expression after it.
(let (pos)
@@ -7393,7 +7594,13 @@ comment at the start of cc-engine.el for more info."
;; interactive refontification.
(c-put-c-type-property (point) 'c-decl-arg-start))
- (when (and c-record-type-identifiers at-type (not (eq at-type t)))
+ ;; Record the type's coordinates in `c-record-type-identifiers' for
+ ;; later fontification.
+ (when (and c-record-type-identifiers at-type ;; (not (eq at-type t))
+ ;; There seems no reason to exclude a token from
+ ;; fontification just because it's "a known type that can't
+ ;; be a name or other expression". 2013-09-18.
+ )
(let ((c-promote-possible-types t))
(save-excursion
(goto-char type-start)
@@ -7487,10 +7694,10 @@ comment at the start of cc-engine.el for more info."
(c-put-c-type-property (1- (point)) 'c-decl-end)
t)
- ;; It's an unfinished label. We consider the keyword enough
- ;; to recognize it as a label, so that it gets fontified.
- ;; Leave the point at the end of it, but don't put any
- ;; `c-decl-end' marker.
+ ;; It's an unfinished label. We consider the keyword enough
+ ;; to recognize it as a label, so that it gets fontified.
+ ;; Leave the point at the end of it, but don't put any
+ ;; `c-decl-end' marker.
(goto-char kwd-end)
t))))
@@ -7675,69 +7882,69 @@ comment at the start of cc-engine.el for more info."
;;
;; This function might do hidden buffer changes.
- (let ((start (point))
- start-char
- (c-promote-possible-types t)
- lim
- ;; Turn off recognition of angle bracket arglists while parsing
- ;; types here since the protocol reference list might then be
- ;; considered part of the preceding name or superclass-name.
- c-recognize-<>-arglists)
-
- (if (or
- (when (looking-at
- (eval-when-compile
- (c-make-keywords-re t
- (append (c-lang-const c-protection-kwds objc)
- '("@end"))
- 'objc-mode)))
- (goto-char (match-end 1))
- t)
-
- (and
- (looking-at
- (eval-when-compile
- (c-make-keywords-re t
- '("@interface" "@implementation" "@protocol")
- 'objc-mode)))
-
- ;; Handle the name of the class itself.
- (progn
-; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's
-; at EOB.
- (goto-char (match-end 0))
- (setq lim (point))
- (c-skip-ws-forward)
- (c-forward-type))
-
- (catch 'break
- ;; Look for ": superclass-name" or "( category-name )".
- (when (looking-at "[:\(]")
- (setq start-char (char-after))
+ (let ((start (point))
+ start-char
+ (c-promote-possible-types t)
+ lim
+ ;; Turn off recognition of angle bracket arglists while parsing
+ ;; types here since the protocol reference list might then be
+ ;; considered part of the preceding name or superclass-name.
+ c-recognize-<>-arglists)
+
+ (if (or
+ (when (looking-at
+ (eval-when-compile
+ (c-make-keywords-re t
+ (append (c-lang-const c-protection-kwds objc)
+ '("@end"))
+ 'objc-mode)))
+ (goto-char (match-end 1))
+ t)
+
+ (and
+ (looking-at
+ (eval-when-compile
+ (c-make-keywords-re t
+ '("@interface" "@implementation" "@protocol")
+ 'objc-mode)))
+
+ ;; Handle the name of the class itself.
+ (progn
+ ;; (c-forward-token-2) ; 2006/1/13 This doesn't move if the token's
+ ;; at EOB.
+ (goto-char (match-end 0))
+ (setq lim (point))
+ (c-skip-ws-forward)
+ (c-forward-type))
+
+ (catch 'break
+ ;; Look for ": superclass-name" or "( category-name )".
+ (when (looking-at "[:(]")
+ (setq start-char (char-after))
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (unless (c-forward-type) (throw 'break nil))
+ (when (eq start-char ?\()
+ (unless (eq (char-after) ?\)) (throw 'break nil))
(forward-char)
- (c-forward-syntactic-ws)
- (unless (c-forward-type) (throw 'break nil))
- (when (eq start-char ?\()
- (unless (eq (char-after) ?\)) (throw 'break nil))
- (forward-char)
- (c-forward-syntactic-ws)))
-
- ;; Look for a protocol reference list.
- (if (eq (char-after) ?<)
- (let ((c-recognize-<>-arglists t)
- (c-parse-and-markup-<>-arglists t)
- c-restricted-<>-arglists)
- (c-forward-<>-arglist t))
- t))))
+ (c-forward-syntactic-ws)))
- (progn
- (c-backward-syntactic-ws lim)
- (c-clear-c-type-property start (1- (point)) 'c-decl-end)
- (c-put-c-type-property (1- (point)) 'c-decl-end)
- t)
+ ;; Look for a protocol reference list.
+ (if (eq (char-after) ?<)
+ (let ((c-recognize-<>-arglists t)
+ (c-parse-and-markup-<>-arglists t)
+ c-restricted-<>-arglists)
+ (c-forward-<>-arglist t))
+ t))))
+
+ (progn
+ (c-backward-syntactic-ws lim)
+ (c-clear-c-type-property start (1- (point)) 'c-decl-end)
+ (c-put-c-type-property (1- (point)) 'c-decl-end)
+ t)
- (c-clear-c-type-property start (point) 'c-decl-end)
- nil)))
+ (c-clear-c-type-property start (point) 'c-decl-end)
+ nil)))
(defun c-beginning-of-inheritance-list (&optional lim)
;; Go to the first non-whitespace after the colon that starts a
@@ -7770,7 +7977,7 @@ comment at the start of cc-engine.el for more info."
;; This should be called with point inside an argument list.
;;
;; Only one level of enclosing parentheses is considered, so for
- ;; instance `nil' is returned when in a function call within an asm
+ ;; instance nil is returned when in a function call within an asm
;; operand.
;;
;; This function might do hidden buffer changes.
@@ -7824,7 +8031,7 @@ comment at the start of cc-engine.el for more info."
;;
;; This function might do hidden buffer changes.
- (let ((beg (point)) end id-start)
+ (let ((beg (point)) id-start)
(and
(eq (c-beginning-of-statement-1 lim) 'same)
@@ -7914,54 +8121,54 @@ comment at the start of cc-engine.el for more info."
(throw 'knr nil)))
(if after-rparen
- ;; We're inside a paren. Could it be our argument list....?
- (if
- (and
- (progn
- (goto-char after-rparen)
- (unless (c-go-list-backward) (throw 'knr nil)) ;
- ;; FIXME!!! What about macros between the parens? 2007/01/20
- (setq before-lparen (point)))
+ ;; We're inside a paren. Could it be our argument list....?
+ (if
+ (and
+ (progn
+ (goto-char after-rparen)
+ (unless (c-go-list-backward) (throw 'knr nil)) ;
+ ;; FIXME!!! What about macros between the parens? 2007/01/20
+ (setq before-lparen (point)))
- ;; It can't be the arg list if next token is ; or {
- (progn (goto-char after-rparen)
- (c-forward-syntactic-ws)
- (not (memq (char-after) '(?\; ?\{ ?\=))))
+ ;; It can't be the arg list if next token is ; or {
+ (progn (goto-char after-rparen)
+ (c-forward-syntactic-ws)
+ (not (memq (char-after) '(?\; ?\{ ?\=))))
- ;; Is the thing preceding the list an identifier (the
- ;; function name), or a macro expansion?
- (progn
- (goto-char before-lparen)
- (eq (c-backward-token-2) 0)
- (or (eq (c-on-identifier) (point))
- (and (eq (char-after) ?\))
- (c-go-up-list-backward)
- (eq (c-backward-token-2) 0)
- (eq (c-on-identifier) (point)))))
-
- ;; Have we got a non-empty list of comma-separated
- ;; identifiers?
- (progn
- (goto-char before-lparen)
- (c-forward-token-2) ; to first token inside parens
- (and
- (c-on-identifier)
- (c-forward-token-2)
- (catch 'id-list
- (while (eq (char-after) ?\,)
- (c-forward-token-2)
- (unless (c-on-identifier) (throw 'id-list nil))
- (c-forward-token-2))
- (eq (char-after) ?\))))))
-
- ;; ...Yes. We've identified the function's argument list.
- (throw 'knr
- (progn (goto-char after-rparen)
- (c-forward-syntactic-ws)
- (point)))
-
- ;; ...No. The current parens aren't the function's arg list.
- (goto-char before-lparen))
+ ;; Is the thing preceding the list an identifier (the
+ ;; function name), or a macro expansion?
+ (progn
+ (goto-char before-lparen)
+ (eq (c-backward-token-2) 0)
+ (or (eq (c-on-identifier) (point))
+ (and (eq (char-after) ?\))
+ (c-go-up-list-backward)
+ (eq (c-backward-token-2) 0)
+ (eq (c-on-identifier) (point)))))
+
+ ;; Have we got a non-empty list of comma-separated
+ ;; identifiers?
+ (progn
+ (goto-char before-lparen)
+ (c-forward-token-2) ; to first token inside parens
+ (and
+ (c-on-identifier)
+ (c-forward-token-2)
+ (catch 'id-list
+ (while (eq (char-after) ?\,)
+ (c-forward-token-2)
+ (unless (c-on-identifier) (throw 'id-list nil))
+ (c-forward-token-2))
+ (eq (char-after) ?\))))))
+
+ ;; ...Yes. We've identified the function's argument list.
+ (throw 'knr
+ (progn (goto-char after-rparen)
+ (c-forward-syntactic-ws)
+ (point)))
+
+ ;; ...No. The current parens aren't the function's arg list.
+ (goto-char before-lparen))
(or (c-go-list-backward) ; backwards over [ .... ]
(throw 'knr nil)))))))))
@@ -8167,7 +8374,7 @@ comment at the start of cc-engine.el for more info."
(and
(progn
(while ; keep going back to "[;={"s until we either find
- ; no more, or get to one which isn't an "operator ="
+ ; no more, or get to one which isn't an "operator ="
(and (c-syntactic-re-search-forward "[;={]" start t t t)
(eq (char-before) ?=)
c-overloadable-operators-regexp
@@ -8227,7 +8434,7 @@ comment at the start of cc-engine.el for more info."
;; Check for `c-opt-block-decls-with-vars-key'
;; before the first paren.
(c-syntactic-re-search-forward
- (concat "[;=\(\[{]\\|\\("
+ (concat "[;=([{]\\|\\("
c-opt-block-decls-with-vars-key
"\\)")
lim t t t)
@@ -8235,7 +8442,7 @@ comment at the start of cc-engine.el for more info."
(not (eq (char-before) ?_))
;; Check that the first following paren is
;; the block.
- (c-syntactic-re-search-forward "[;=\(\[{]"
+ (c-syntactic-re-search-forward "[;=([{]"
lim t t t)
(eq (char-before) ?{)))))))
;; The declaration doesn't have any of the
@@ -8281,10 +8488,7 @@ comment at the start of cc-engine.el for more info."
(when (and c-recognize-<>-arglists
(eq (char-before) ?>))
;; Could be at the end of a template arglist.
- (let ((c-parse-and-markup-<>-arglists t)
- (c-disallow-comma-in-<>-arglists
- (and containing-sexp
- (not (eq (char-after containing-sexp) ?{)))))
+ (let ((c-parse-and-markup-<>-arglists t))
(while (and
(c-backward-<>-arglist nil limit)
(progn
@@ -8308,31 +8512,44 @@ comment at the start of cc-engine.el for more info."
(cond
((c-syntactic-re-search-forward c-decl-block-key open-brace t t t)
(goto-char (setq kwd-start (match-beginning 0)))
- (or
-
- ;; Found a keyword that can't be a type?
- (match-beginning 1)
-
- ;; Can be a type too, in which case it's the return type of a
- ;; function (under the assumption that no declaration level
- ;; block construct starts with a type).
- (not (c-forward-type))
-
- ;; Jumped over a type, but it could be a declaration keyword
- ;; followed by the declared identifier that we've jumped over
- ;; instead (e.g. in "class Foo {"). If it indeed is a type
- ;; then we should be at the declarator now, so check for a
- ;; valid declarator start.
- ;;
- ;; Note: This doesn't cope with the case when a declared
- ;; identifier is followed by e.g. '(' in a language where '('
- ;; also might be part of a declarator expression. Currently
- ;; there's no such language.
- (not (or (looking-at c-symbol-start)
- (looking-at c-type-decl-prefix-key)))))
+ (and
+ ;; Exclude cases where we matched what would ordinarily
+ ;; be a block declaration keyword, except where it's not
+ ;; legal because it's part of a "compound keyword" like
+ ;; "enum class". Of course, if c-after-brace-list-key
+ ;; is nil, we can skip the test.
+ (or (equal c-after-brace-list-key "\\<\\>")
+ (save-match-data
+ (save-excursion
+ (not
+ (and
+ (looking-at c-after-brace-list-key)
+ (= (c-backward-token-2 1 t) 0)
+ (looking-at c-brace-list-key))))))
+ (or
+ ;; Found a keyword that can't be a type?
+ (match-beginning 1)
+
+ ;; Can be a type too, in which case it's the return type of a
+ ;; function (under the assumption that no declaration level
+ ;; block construct starts with a type).
+ (not (c-forward-type))
+
+ ;; Jumped over a type, but it could be a declaration keyword
+ ;; followed by the declared identifier that we've jumped over
+ ;; instead (e.g. in "class Foo {"). If it indeed is a type
+ ;; then we should be at the declarator now, so check for a
+ ;; valid declarator start.
+ ;;
+ ;; Note: This doesn't cope with the case when a declared
+ ;; identifier is followed by e.g. '(' in a language where '('
+ ;; also might be part of a declarator expression. Currently
+ ;; there's no such language.
+ (not (or (looking-at c-symbol-start)
+ (looking-at c-type-decl-prefix-key))))))
;; In Pike a list of modifiers may be followed by a brace
- ;; to make them apply to many identifiers. Note that the
+ ;; to make them apply to many identifiers. Note that the
;; match data will be empty on return in this case.
((and (c-major-mode-is 'pike-mode)
(progn
@@ -8403,15 +8620,6 @@ comment at the start of cc-engine.el for more info."
(back-to-indentation)
(vector (point) open-paren-pos))))))
-(defmacro c-pull-open-brace (ps)
- ;; Pull the next open brace from PS (which has the form of paren-state),
- ;; skipping over any brace pairs. Returns NIL when PS is exhausted.
- `(progn
- (while (consp (car ,ps))
- (setq ,ps (cdr ,ps)))
- (prog1 (car ,ps)
- (setq ,ps (cdr ,ps)))))
-
(defun c-most-enclosing-decl-block (paren-state)
;; Return the buffer position of the most enclosing decl-block brace (in the
;; sense of c-looking-at-decl-block) in the PAREN-STATE structure, or nil if
@@ -8443,6 +8651,68 @@ comment at the start of cc-engine.el for more info."
(not (looking-at "=")))))
b-pos)))
+(defun c-backward-colon-prefixed-type ()
+ ;; We're at the token after what might be a type prefixed with a colon. Try
+ ;; moving backward over this type and the colon. On success, return t and
+ ;; leave point before colon; on failure, leave point unchanged. Will clobber
+ ;; match data.
+ (let ((here (point))
+ (colon-pos nil))
+ (save-excursion
+ (while
+ (and (eql (c-backward-token-2) 0)
+ (or (not (looking-at "\\s)"))
+ (c-go-up-list-backward))
+ (cond
+ ((eql (char-after) ?:)
+ (setq colon-pos (point))
+ (forward-char)
+ (c-forward-syntactic-ws)
+ (or (and (c-forward-type)
+ (progn (c-forward-syntactic-ws)
+ (eq (point) here)))
+ (setq colon-pos nil))
+ nil)
+ ((eql (char-after) ?\()
+ t)
+ ((looking-at c-symbol-key)
+ t)
+ (t nil)))))
+ (when colon-pos
+ (goto-char colon-pos)
+ t)))
+
+(defun c-backward-over-enum-header ()
+ ;; We're at a "{". Move back to the enum-like keyword that starts this
+ ;; declaration and return t, otherwise don't move and return nil.
+ (let ((here (point))
+ up-sexp-pos before-identifier)
+ (when c-recognize-post-brace-list-type-p
+ (c-backward-colon-prefixed-type))
+ (while
+ (and
+ (eq (c-backward-token-2) 0)
+ (or (not (looking-at "\\s)"))
+ (c-go-up-list-backward))
+ (cond
+ ((and (looking-at c-symbol-key) (c-on-identifier)
+ (not before-identifier))
+ (setq before-identifier t))
+ ((and before-identifier
+ (or (eql (char-after) ?,)
+ (looking-at c-postfix-decl-spec-key)))
+ (setq before-identifier nil)
+ t)
+ ((looking-at c-after-brace-list-key) t)
+ ((looking-at c-brace-list-key) nil)
+ ((and c-recognize-<>-arglists
+ (eq (char-after) ?<)
+ (looking-at "\\s("))
+ t)
+ (t nil))))
+ (or (looking-at c-brace-list-key)
+ (progn (goto-char here) nil))))
+
(defun c-inside-bracelist-p (containing-sexp paren-state)
;; return the buffer position of the beginning of the brace list
;; statement if we're inside a brace list, otherwise return nil.
@@ -8457,18 +8727,9 @@ comment at the start of cc-engine.el for more info."
;; This function might do hidden buffer changes.
(or
;; This will pick up brace list declarations.
- (c-safe
- (save-excursion
- (goto-char containing-sexp)
- (c-forward-sexp -1)
- (let (bracepos)
- (if (and (or (looking-at c-brace-list-key)
- (progn (c-forward-sexp -1)
- (looking-at c-brace-list-key)))
- (setq bracepos (c-down-list-forward (point)))
- (not (c-crosses-statement-barrier-p (point)
- (- bracepos 2))))
- (point)))))
+ (save-excursion
+ (goto-char containing-sexp)
+ (c-backward-over-enum-header))
;; this will pick up array/aggregate init lists, even if they are nested.
(save-excursion
(let ((class-key
@@ -8476,106 +8737,122 @@ comment at the start of cc-engine.el for more info."
;; check for the class key here.
(and (c-major-mode-is 'pike-mode)
c-decl-block-key))
- bufpos braceassignp lim next-containing)
+ bufpos braceassignp lim next-containing macro-start)
(while (and (not bufpos)
containing-sexp)
+ (when paren-state
+ (if (consp (car paren-state))
+ (setq lim (cdr (car paren-state))
+ paren-state (cdr paren-state))
+ (setq lim (car paren-state)))
(when paren-state
- (if (consp (car paren-state))
- (setq lim (cdr (car paren-state))
- paren-state (cdr paren-state))
- (setq lim (car paren-state)))
- (when paren-state
- (setq next-containing (car paren-state)
- paren-state (cdr paren-state))))
- (goto-char containing-sexp)
- (if (c-looking-at-inexpr-block next-containing next-containing)
- ;; We're in an in-expression block of some kind. Do not
- ;; check nesting. We deliberately set the limit to the
- ;; containing sexp, so that c-looking-at-inexpr-block
- ;; doesn't check for an identifier before it.
- (setq containing-sexp nil)
- ;; see if the open brace is preceded by = or [...] in
- ;; this statement, but watch out for operator=
- (setq braceassignp 'dontknow)
- (c-backward-token-2 1 t lim)
- ;; Checks to do only on the first sexp before the brace.
- (when (and c-opt-inexpr-brace-list-key
- (eq (char-after) ?\[))
- ;; In Java, an initialization brace list may follow
- ;; directly after "new Foo[]", so check for a "new"
- ;; earlier.
- (while (eq braceassignp 'dontknow)
- (setq braceassignp
- (cond ((/= (c-backward-token-2 1 t lim) 0) nil)
- ((looking-at c-opt-inexpr-brace-list-key) t)
- ((looking-at "\\sw\\|\\s_\\|[.[]")
- ;; Carry on looking if this is an
- ;; identifier (may contain "." in Java)
- ;; or another "[]" sexp.
- 'dontknow)
- (t nil)))))
- ;; Checks to do on all sexps before the brace, up to the
- ;; beginning of the statement.
+ (setq next-containing (car paren-state)
+ paren-state (cdr paren-state))))
+ (goto-char containing-sexp)
+ (if (c-looking-at-inexpr-block next-containing next-containing)
+ ;; We're in an in-expression block of some kind. Do not
+ ;; check nesting. We deliberately set the limit to the
+ ;; containing sexp, so that c-looking-at-inexpr-block
+ ;; doesn't check for an identifier before it.
+ (setq containing-sexp nil)
+ ;; see if the open brace is preceded by = or [...] in
+ ;; this statement, but watch out for operator=
+ (setq braceassignp 'dontknow)
+ (c-backward-token-2 1 t lim)
+ ;; Checks to do only on the first sexp before the brace.
+ (when (and c-opt-inexpr-brace-list-key
+ (eq (char-after) ?\[))
+ ;; In Java, an initialization brace list may follow
+ ;; directly after "new Foo[]", so check for a "new"
+ ;; earlier.
(while (eq braceassignp 'dontknow)
- (cond ((eq (char-after) ?\;)
- (setq braceassignp nil))
- ((and class-key
- (looking-at class-key))
- (setq braceassignp nil))
- ((eq (char-after) ?=)
- ;; We've seen a =, but must check earlier tokens so
- ;; that it isn't something that should be ignored.
- (setq braceassignp 'maybe)
- (while (and (eq braceassignp 'maybe)
- (zerop (c-backward-token-2 1 t lim)))
- (setq braceassignp
- (cond
- ;; Check for operator =
- ((and c-opt-op-identifier-prefix
- (looking-at c-opt-op-identifier-prefix))
- nil)
- ;; Check for `<opchar>= in Pike.
- ((and (c-major-mode-is 'pike-mode)
- (or (eq (char-after) ?`)
- ;; Special case for Pikes
- ;; `[]=, since '[' is not in
- ;; the punctuation class.
- (and (eq (char-after) ?\[)
- (eq (char-before) ?`))))
- nil)
- ((looking-at "\\s.") 'maybe)
- ;; make sure we're not in a C++ template
- ;; argument assignment
- ((and
- (c-major-mode-is 'c++-mode)
- (save-excursion
- (let ((here (point))
- (pos< (progn
- (skip-chars-backward "^<>")
- (point))))
- (and (eq (char-before) ?<)
- (not (c-crosses-statement-barrier-p
- pos< here))
- (not (c-in-literal))
- ))))
- nil)
- (t t))))))
- (if (and (eq braceassignp 'dontknow)
- (/= (c-backward-token-2 1 t lim) 0))
- (setq braceassignp nil)))
- (if (not braceassignp)
- (if (eq (char-after) ?\;)
- ;; Brace lists can't contain a semicolon, so we're done.
- (setq containing-sexp nil)
- ;; Go up one level.
- (setq containing-sexp next-containing
- lim nil
- next-containing nil))
- ;; we've hit the beginning of the aggregate list
- (c-beginning-of-statement-1
- (c-most-enclosing-brace paren-state))
- (setq bufpos (point))))
- )
+ (setq braceassignp
+ (cond ((/= (c-backward-token-2 1 t lim) 0) nil)
+ ((looking-at c-opt-inexpr-brace-list-key) t)
+ ((looking-at "\\sw\\|\\s_\\|[.[]")
+ ;; Carry on looking if this is an
+ ;; identifier (may contain "." in Java)
+ ;; or another "[]" sexp.
+ 'dontknow)
+ (t nil)))))
+ ;; Checks to do on all sexps before the brace, up to the
+ ;; beginning of the statement.
+ (while (eq braceassignp 'dontknow)
+ (cond ((eq (char-after) ?\;)
+ (setq braceassignp nil))
+ ((and class-key
+ (looking-at class-key))
+ (setq braceassignp nil))
+ ((eq (char-after) ?=)
+ ;; We've seen a =, but must check earlier tokens so
+ ;; that it isn't something that should be ignored.
+ (setq braceassignp 'maybe)
+ (while (and (eq braceassignp 'maybe)
+ (zerop (c-backward-token-2 1 t lim)))
+ (setq braceassignp
+ (cond
+ ;; Check for operator =
+ ((and c-opt-op-identifier-prefix
+ (looking-at c-opt-op-identifier-prefix))
+ nil)
+ ;; Check for `<opchar>= in Pike.
+ ((and (c-major-mode-is 'pike-mode)
+ (or (eq (char-after) ?`)
+ ;; Special case for Pikes
+ ;; `[]=, since '[' is not in
+ ;; the punctuation class.
+ (and (eq (char-after) ?\[)
+ (eq (char-before) ?`))))
+ nil)
+ ((looking-at "\\s.") 'maybe)
+ ;; make sure we're not in a C++ template
+ ;; argument assignment
+ ((and
+ (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (let ((here (point))
+ (pos< (progn
+ (skip-chars-backward "^<>")
+ (point))))
+ (and (eq (char-before) ?<)
+ (not (c-crosses-statement-barrier-p
+ pos< here))
+ (not (c-in-literal))
+ ))))
+ nil)
+ (t t))))))
+ (if (and (eq braceassignp 'dontknow)
+ (/= (c-backward-token-2 1 t lim) 0))
+ (setq braceassignp nil)))
+ (cond
+ (braceassignp
+ ;; We've hit the beginning of the aggregate list.
+ (c-beginning-of-statement-1
+ (c-most-enclosing-brace paren-state))
+ (setq bufpos (point)))
+ ((eq (char-after) ?\;)
+ ;; Brace lists can't contain a semicolon, so we're done.
+ (setq containing-sexp nil))
+ ((and (setq macro-start (point))
+ (c-forward-to-cpp-define-body)
+ (eq (point) containing-sexp))
+ ;; We've a macro whose expansion starts with the '{'.
+ ;; Heuristically, if we have a ';' in it we've not got a
+ ;; brace list, otherwise we have.
+ (let ((macro-end (progn (c-end-of-macro) (point))))
+ (goto-char containing-sexp)
+ (forward-char)
+ (if (and (c-syntactic-re-search-forward "[;,]" macro-end t t)
+ (eq (char-before) ?\;))
+ (setq bufpos nil
+ containing-sexp nil)
+ (setq bufpos macro-start))))
+ (t
+ ;; Go up one level
+ (setq containing-sexp next-containing
+ lim nil
+ next-containing nil)))))
+
bufpos))
))
@@ -8684,7 +8961,7 @@ comment at the start of cc-engine.el for more info."
(> (point) closest-lim))
(not (bobp))
(progn (backward-char)
- (looking-at "[\]\).]\\|\\w\\|\\s_"))
+ (looking-at "[]).]\\|\\w\\|\\s_"))
(c-safe (forward-char)
(goto-char (scan-sexps (point) -1))))
@@ -9066,7 +9343,7 @@ comment at the start of cc-engine.el for more info."
(max (c-point 'boi paren-pos) (point))))
(t (c-add-syntax 'defun-block-intro nil))))
- (c-add-syntax 'statement-block-intro nil)))
+ (c-add-syntax 'statement-block-intro nil)))
(if (= paren-pos boi)
;; Always done if the open brace was at boi. The
@@ -9236,15 +9513,15 @@ comment at the start of cc-engine.el for more info."
;;annotations.
((and (c-major-mode-is 'java-mode)
(setq placeholder (point))
- (c-beginning-of-statement-1)
- (progn
- (while (and (c-forward-annotation)
- (< (point) placeholder))
- (c-forward-syntactic-ws))
- t)
- (prog1
- (>= (point) placeholder)
- (goto-char placeholder)))
+ (c-beginning-of-statement-1)
+ (progn
+ (while (and (c-forward-annotation)
+ (< (point) placeholder))
+ (c-forward-syntactic-ws))
+ t)
+ (prog1
+ (>= (point) placeholder)
+ (goto-char placeholder)))
(c-beginning-of-statement-1 containing-sexp)
(c-add-syntax 'annotation-var-cont (point)))
@@ -9263,16 +9540,16 @@ comment at the start of cc-engine.el for more info."
(not (looking-at c-<-op-cont-regexp))))))
(c-with-syntax-table c++-template-syntax-table
(goto-char placeholder)
- (c-beginning-of-statement-1 containing-sexp t)
- (if (save-excursion
- (c-backward-syntactic-ws containing-sexp)
- (eq (char-before) ?<))
- ;; In a nested template arglist.
- (progn
- (goto-char placeholder)
- (c-syntactic-skip-backward "^,;" containing-sexp t)
- (c-forward-syntactic-ws))
- (back-to-indentation)))
+ (c-beginning-of-statement-1 containing-sexp t))
+ (if (save-excursion
+ (c-backward-syntactic-ws containing-sexp)
+ (eq (char-before) ?<))
+ ;; In a nested template arglist.
+ (progn
+ (goto-char placeholder)
+ (c-syntactic-skip-backward "^,;" containing-sexp t)
+ (c-forward-syntactic-ws))
+ (back-to-indentation))
;; FIXME: Should use c-add-stmt-syntax, but it's not yet
;; template aware.
(c-add-syntax 'template-args-cont (point) placeholder))
@@ -9294,6 +9571,7 @@ comment at the start of cc-engine.el for more info."
(c-save-buffer-state
((indent-point (point))
(case-fold-search nil)
+ open-paren-in-column-0-is-defun-start
;; A whole ugly bunch of various temporary variables. Have
;; to declare them here since it's not possible to declare
;; a variable with only the scope of a cond test and the
@@ -9349,22 +9627,26 @@ comment at the start of cc-engine.el for more info."
(c-keyword-sym (match-string 1)))))
;; Init some position variables.
- (if c-state-cache
+ (if paren-state
(progn
(setq containing-sexp (car paren-state)
paren-state (cdr paren-state))
(if (consp containing-sexp)
- (progn
- (setq lim (cdr containing-sexp))
- (if (cdr c-state-cache)
- ;; Ignore balanced paren. The next entry
- ;; can't be another one.
- (setq containing-sexp (car (cdr c-state-cache))
- paren-state (cdr paren-state))
- ;; If there is no surrounding open paren then
- ;; put the last balanced pair back on paren-state.
- (setq paren-state (cons containing-sexp paren-state)
- containing-sexp nil)))
+ (save-excursion
+ (goto-char (cdr containing-sexp))
+ (if (and (c-major-mode-is 'c++-mode)
+ (c-back-over-member-initializer-braces))
+ (c-syntactic-skip-backward "^}" nil t))
+ (setq lim (point))
+ (if paren-state
+ ;; Ignore balanced paren. The next entry
+ ;; can't be another one.
+ (setq containing-sexp (car paren-state)
+ paren-state (cdr paren-state))
+ ;; If there is no surrounding open paren then
+ ;; put the last balanced pair back on paren-state.
+ (setq paren-state (cons containing-sexp paren-state)
+ containing-sexp nil)))
(setq lim (1+ containing-sexp))))
(setq lim (point-min)))
@@ -9929,16 +10211,16 @@ comment at the start of cc-engine.el for more info."
(eq (char-after placeholder) ?<))))))
(c-with-syntax-table c++-template-syntax-table
(goto-char placeholder)
- (c-beginning-of-statement-1 lim t)
- (if (save-excursion
- (c-backward-syntactic-ws lim)
- (eq (char-before) ?<))
- ;; In a nested template arglist.
- (progn
- (goto-char placeholder)
- (c-syntactic-skip-backward "^,;" lim t)
- (c-forward-syntactic-ws))
- (back-to-indentation)))
+ (c-beginning-of-statement-1 lim t))
+ (if (save-excursion
+ (c-backward-syntactic-ws lim)
+ (eq (char-before) ?<))
+ ;; In a nested template arglist.
+ (progn
+ (goto-char placeholder)
+ (c-syntactic-skip-backward "^,;" lim t)
+ (c-forward-syntactic-ws))
+ (back-to-indentation))
;; FIXME: Should use c-add-stmt-syntax, but it's not yet
;; template aware.
(c-add-syntax 'template-args-cont (point) placeholder))
@@ -10178,7 +10460,6 @@ comment at the start of cc-engine.el for more info."
(c-add-syntax 'topmost-intro-cont (c-point 'boi)))
))
-
;; (CASE 6 has been removed.)
;; CASE 7: line is an expression, not a statement. Most
@@ -10207,7 +10488,7 @@ comment at the start of cc-engine.el for more info."
paren-state))
;; CASE 7B: Looking at the opening brace of an
- ;; in-expression block or brace list. C.f. cases 4, 16A
+ ;; in-expression block or brace list. C.f. cases 4, 16A
;; and 17E.
((and (eq char-after-ip ?{)
(progn
@@ -10329,7 +10610,7 @@ comment at the start of cc-engine.el for more info."
)))
;; CASE 9: we are inside a brace-list
- ((and (not (c-major-mode-is 'awk-mode)) ; Maybe this isn't needed (ACM, 2002/3/29)
+ ((and (not (c-major-mode-is 'awk-mode)) ; Maybe this isn't needed (ACM, 2002/3/29)
(setq special-brace-list
(or (and c-special-brace-lists ;;;; ALWAYS NIL FOR AWK!!
(save-excursion
@@ -10381,7 +10662,7 @@ comment at the start of cc-engine.el for more info."
(if (eq (point) (c-point 'boi))
(c-add-syntax 'brace-list-close (point))
(setq lim (c-most-enclosing-brace c-state-cache (point)))
- (c-beginning-of-statement-1 lim)
+ (c-beginning-of-statement-1 lim nil nil t)
(c-add-stmt-syntax 'brace-list-close nil t lim paren-state)))
(t
@@ -10543,9 +10824,9 @@ comment at the start of cc-engine.el for more info."
))
;; CASE 19: line is an expression, not a statement, and is directly
- ;; contained by a template delimiter. Most likely, we are in a
+ ;; contained by a template delimiter. Most likely, we are in a
;; template arglist within a statement. This case is based on CASE
- ;; 7. At some point in the future, we may wish to create more
+ ;; 7. At some point in the future, we may wish to create more
;; syntactic symbols such as `template-intro',
;; `template-cont-nonempty', etc., and distinguish between them as we
;; do for `arglist-intro' etc. (2009-12-07).
@@ -10881,7 +11162,7 @@ Cannot combine absolute offsets %S and %S in `add' method"
;;
;; This function might do hidden buffer changes.
(let* ((symbol (c-langelem-sym langelem))
- (match (assq symbol c-offsets-alist))
+ (match (assq symbol c-offsets-alist))
(offset (cdr-safe match)))
(if match
(setq offset (c-evaluate-offset offset langelem symbol))
@@ -10952,4 +11233,8 @@ Cannot combine absolute offsets %S and %S in `add' method"
(cc-provide 'cc-engine)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-engine.el ends here
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 4e8ce6bac28..ad112d720d8 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,6 +1,6 @@
;;; cc-fonts.el --- font lock support for CC Mode
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 2002- Martin Stjernholm
@@ -266,7 +266,7 @@
;; This function might do hidden buffer changes.
(when (c-got-face-at (point) c-literal-faces)
(while (progn
- (goto-char (next-single-property-change
+ (goto-char (c-next-single-property-change
(point) 'face nil limit))
(and (< (point) limit)
(c-got-face-at (point) c-literal-faces))))
@@ -366,39 +366,7 @@
(parse-sexp-lookup-properties
(cc-eval-when-compile
(boundp 'parse-sexp-lookup-properties))))
-
- ;; (while (re-search-forward ,regexp limit t)
- ;; (unless (progn
- ;; (goto-char (match-beginning 0))
- ;; (c-skip-comments-and-strings limit))
- ;; (goto-char (match-end 0))
- ;; ,@(mapcar
- ;; (lambda (highlight)
- ;; (if (integerp (car highlight))
- ;; (progn
- ;; (unless (eq (nth 2 highlight) t)
- ;; (error
- ;; "The override flag must currently be t in %s"
- ;; highlight))
- ;; (when (nth 3 highlight)
- ;; (error
- ;; "The laxmatch flag may currently not be set in %s"
- ;; highlight))
- ;; `(save-match-data
- ;; (c-put-font-lock-face
- ;; (match-beginning ,(car highlight))
- ;; (match-end ,(car highlight))
- ;; ,(elt highlight 1))))
- ;; (when (nth 3 highlight)
- ;; (error "Match highlights currently not supported in %s"
- ;; highlight))
- ;; `(progn
- ;; ,(nth 1 highlight)
- ;; (save-match-data ,(car highlight))
- ;; ,(nth 2 highlight))))
- ;; highlights)))
,(c-make-font-lock-search-form regexp highlights))
-
nil)))
(defun c-make-font-lock-BO-decl-search-function (regexp &rest highlights)
@@ -571,29 +539,29 @@ stuff. Used on level 1 and higher."
(let* ((re (c-make-keywords-re nil
(c-lang-const c-cpp-include-directives)))
(re-depth (regexp-opt-depth re)))
- `((,(concat noncontinued-line-end
- (c-lang-const c-opt-cpp-prefix)
- re
- (c-lang-const c-syntactic-ws)
- "\\(<[^>\n\r]*>?\\)")
- (,(+ ncle-depth re-depth sws-depth 1)
- font-lock-string-face)
-
- ;; Use an anchored matcher to put paren syntax
- ;; on the brackets.
- (,(byte-compile
- `(lambda (limit)
- (let ((beg (match-beginning
- ,(+ ncle-depth re-depth sws-depth 1)))
- (end (1- (match-end ,(+ ncle-depth re-depth
- sws-depth 1)))))
- (if (eq (char-after end) ?>)
- (progn
- (c-mark-<-as-paren beg)
- (c-mark->-as-paren end))
- ;; (c-clear-char-property beg 'syntax-table)
- (c-clear-char-property beg 'category)))
- nil)))))))
+ ;; We used to use a font-lock "anchored matcher" here for
+ ;; the paren syntax. This failed when the ">" was at EOL,
+ ;; since `font-lock-fontify-anchored-keywords' terminated
+ ;; its loop at EOL without executing our lambda form at
+ ;; all.
+ `((,(c-make-font-lock-search-function
+ (concat noncontinued-line-end
+ (c-lang-const c-opt-cpp-prefix)
+ re
+ (c-lang-const c-syntactic-ws)
+ "\\(<[^>\n\r]*>?\\)")
+ `(,(+ ncle-depth re-depth sws-depth 1)
+ font-lock-string-face t)
+ `((let ((beg (match-beginning
+ ,(+ ncle-depth re-depth sws-depth 1)))
+ (end (1- (match-end ,(+ ncle-depth re-depth
+ sws-depth 1)))))
+ (if (eq (char-after end) ?>)
+ (progn
+ (c-mark-<-as-paren beg)
+ (c-mark->-as-paren end))
+ (c-unmark-<->-as-paren beg)))
+ nil))))))
;; #define.
,@(when (c-lang-const c-opt-cpp-macro-define)
@@ -607,10 +575,10 @@ stuff. Used on level 1 and higher."
c-symbol-key) "\\)"
(concat "\\(" ; 2 + ncle + nsws + c-sym-key
;; Macro with arguments - a "function".
- "\\(\(\\)" ; 3 + ncle + nsws + c-sym-key
+ "\\((\\)" ; 3 + ncle + nsws + c-sym-key
"\\|"
;; Macro without arguments - a "variable".
- "\\([^\(]\\|$\\)"
+ "\\([^(]\\|$\\)"
"\\)"))
`((if (match-beginning
,(+ 3 ncle-depth nsws-depth
@@ -716,7 +684,11 @@ stuff. Used on level 1 and higher."
(let ((start (1- (point))))
(save-excursion
(and (eq (elt (parse-partial-sexp start (c-point 'eol)) 8) start)
- (if (integerp c-multiline-string-start-char)
+ (if (if (eval-when-compile (integerp ?c))
+ ;; Emacs
+ (integerp c-multiline-string-start-char)
+ ;; XEmacs
+ (characterp c-multiline-string-start-char))
;; There's no multiline string start char before the
;; string, so newlines aren't allowed.
(not (eq (char-before start) c-multiline-string-start-char))
@@ -1037,7 +1009,8 @@ casts and declarations are fontified. Used on level 2 and higher."
paren-depth
id-face got-init
c-last-identifier-range
- (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)))
+ (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))
+ brackets-after-id)
;; The following `while' fontifies a single declarator id each time round.
;; It loops only when LIST is non-nil.
@@ -1109,18 +1082,22 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Search syntactically to the end of the declarator (";",
;; ",", a closing paren, eob etc) or to the beginning of an
- ;; initializer or function prototype ("=" or "\\s\(").
- ;; Note that the open paren will match array specs in
- ;; square brackets, and we treat them as initializers too.
- (c-syntactic-re-search-forward
- "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t))
+ ;; initializer or function prototype ("=" or "\\s(").
+ ;; Note that square brackets are now not also treated as
+ ;; initializers, since this broke when there were also
+ ;; initializing brace lists.
+ (let (found)
+ (while
+ (and (setq found (c-syntactic-re-search-forward
+ "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t))
+ (eq (char-before) ?\[)
+ (c-go-up-list-forward))
+ (setq brackets-after-id t))
+ found))
(setq next-pos (match-beginning 0)
id-face (if (and (eq (char-after next-pos) ?\()
- (let (c-last-identifier-range)
- (save-excursion
- (goto-char next-pos)
- (c-at-toplevel-p))))
+ (not brackets-after-id))
'font-lock-function-name-face
'font-lock-variable-name-face)
got-init (and (match-beginning 1)
@@ -1146,7 +1123,6 @@ casts and declarations are fontified. Used on level 2 and higher."
(when list
;; Jump past any initializer or function prototype to see if
;; there's a ',' to continue at.
-
(cond ((eq id-face 'font-lock-function-name-face)
;; Skip a parenthesized initializer (C++) or a function
;; prototype.
@@ -1164,6 +1140,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(looking-at "{"))
(c-safe (c-forward-sexp) t) ; over { .... }
t)
+ (< (point) limit)
;; FIXME: Should look for c-decl-end markers here;
;; we might go far into the following declarations
;; in e.g. ObjC mode (see e.g. methods-4.m).
@@ -1214,8 +1191,8 @@ casts and declarations are fontified. Used on level 2 and higher."
;; o - nil, if not in an arglist at all. This includes the
;; parenthesized condition which follows "if", "while", etc.
context
- ;; The position of the next token after the closing paren of
- ;; the last detected cast.
+ ;; A list of starting positions of possible type declarations, or of
+ ;; the typedef preceding one, if any.
last-cast-end
;; The result from `c-forward-decl-or-cast-1'.
decl-or-cast
@@ -1279,6 +1256,8 @@ casts and declarations are fontified. Used on level 2 and higher."
c-font-lock-maybe-decl-faces
(lambda (match-pos inside-macro)
+ ;; Note to maintainers: don't use `limit' inside this lambda form;
+ ;; c-find-decl-spots sometimes narrows to less than `limit'.
(setq start-pos (point))
(when
;; The result of the form below is true when we don't recognize a
@@ -1301,14 +1280,15 @@ casts and declarations are fontified. Used on level 2 and higher."
(cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?<)))
(setq context nil
c-restricted-<>-arglists nil))
- ;; A control flow expression
+ ;; A control flow expression or a decltype
((and (eq (char-before match-pos) ?\()
(save-excursion
(goto-char match-pos)
(backward-char)
(c-backward-token-2)
(or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key))))
+ (looking-at c-block-stmt-1-2-key)
+ (looking-at c-typeof-key))))
(setq context nil
c-restricted-<>-arglists t))
;; Near BOB.
@@ -1473,11 +1453,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(numberp (car paren-state))
(save-excursion
(goto-char (car paren-state))
- (c-backward-token-2)
- (or (looking-at c-brace-list-key)
- (progn
- (c-backward-token-2)
- (looking-at c-brace-list-key)))))))
+ (c-backward-over-enum-header)))))
(c-forward-token-2)
nil)
@@ -1490,33 +1466,38 @@ casts and declarations are fontified. Used on level 2 and higher."
c-recognize-knr-p) ; Strictly speaking, bogus, but it
; speeds up lisp.h tremendously.
(save-excursion
- (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim)))
- (if (and (eq bod-res 'same)
- (progn
- (c-backward-syntactic-ws)
- (eq (char-before) ?\})))
- (c-beginning-of-decl-1 decl-search-lim))
-
- ;; We're now putatively at the declaration.
- (setq paren-state (c-parse-state))
- ;; At top level or inside a "{"?
- (if (or (not (setq encl-pos
- (c-most-enclosing-brace paren-state)))
- (eq (char-after encl-pos) ?\{))
- (progn
- (when (looking-at c-typedef-key) ; "typedef"
- (setq is-typedef t)
- (goto-char (match-end 0))
- (c-forward-syntactic-ws))
- ;; At a real declaration?
- (if (memq (c-forward-type t) '(t known found))
- (progn
- (c-font-lock-declarators limit t is-typedef)
- nil)
- ;; False alarm. Return t to go on to the next check.
- (goto-char start-pos)
- t))
- t))))))
+ (if (c-back-over-member-initializers)
+ t ; Can't be at a declarator
+ (unless (or (eobp)
+ (looking-at "\\s(\\|\\s)"))
+ (forward-char))
+ (setq bod-res (car (c-beginning-of-decl-1 decl-search-lim)))
+ (if (and (eq bod-res 'same)
+ (save-excursion
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\})))
+ (c-beginning-of-decl-1 decl-search-lim))
+
+ ;; We're now putatively at the declaration.
+ (setq paren-state (c-parse-state))
+ ;; At top level or inside a "{"?
+ (if (or (not (setq encl-pos
+ (c-most-enclosing-brace paren-state)))
+ (eq (char-after encl-pos) ?\{))
+ (progn
+ (when (looking-at c-typedef-key) ; "typedef"
+ (setq is-typedef t)
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws))
+ ;; At a real declaration?
+ (if (memq (c-forward-type t) '(t known found decltype))
+ (progn
+ (c-font-lock-declarators (point-max) t is-typedef)
+ nil)
+ ;; False alarm. Return t to go on to the next check.
+ (goto-char start-pos)
+ t))
+ t)))))))
;; It was a false alarm. Check if we're in a label (or other
;; construct with `:' except bitfield) instead.
@@ -1559,20 +1540,13 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Note that this function won't attempt to fontify beyond the end of the
;; current enum block, if any.
(let* ((paren-state (c-parse-state))
- (encl-pos (c-most-enclosing-brace paren-state))
- (start (point))
- )
+ (encl-pos (c-most-enclosing-brace paren-state)))
(when (and
encl-pos
(eq (char-after encl-pos) ?\{)
(save-excursion
(goto-char encl-pos)
- (c-backward-syntactic-ws)
- (c-simple-skip-symbol-backward)
- (or (looking-at c-brace-list-key) ; "enum"
- (progn (c-backward-syntactic-ws)
- (c-simple-skip-symbol-backward)
- (looking-at c-brace-list-key)))))
+ (c-backward-over-enum-header)))
(c-syntactic-skip-backward "^{," nil t)
(c-put-char-property (1- (point)) 'c-type 'c-decl-id-start)
@@ -1799,8 +1773,8 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
;; "\\|"
;; (c-lang-const c-symbol-key)
;; "\\)")
-;; `((c-font-lock-declarators limit t nil) ; That `nil' says use `font-lock-variable-name-face';
-;; ; `t' would mean `font-lock-function-name-face'.
+;; `((c-font-lock-declarators limit t nil) ; That nil says use `font-lock-variable-name-face';
+;; ; t would mean `font-lock-function-name-face'.
;; (progn
;; (c-put-char-property (match-beginning 0) 'c-type
;; 'c-decl-id-start)
@@ -1893,7 +1867,7 @@ higher."
"\\)\\>"
;; Disallow various common punctuation chars that can't come
;; before the '{' of the enum list, to avoid searching too far.
- "[^\]\[{}();,/#=]*"
+ "[^][{}();/#=]*"
"{")
'((c-font-lock-declarators limit t nil)
(save-match-data
@@ -1984,19 +1958,18 @@ higher."
(cdr-safe (or (assq c-buffer-is-cc-mode c-doc-comment-style)
(assq 'other c-doc-comment-style)))
c-doc-comment-style))
- (list (nconc (apply 'nconc
- (mapcar
- (lambda (doc-style)
- (let ((sym (intern
- (concat (symbol-name doc-style)
- "-font-lock-keywords"))))
- (cond ((fboundp sym)
- (funcall sym))
- ((boundp sym)
- (append (eval sym) nil)))))
- (if (listp doc-keywords)
- doc-keywords
- (list doc-keywords))))
+ (list (nconc (c--mapcan
+ (lambda (doc-style)
+ (let ((sym (intern
+ (concat (symbol-name doc-style)
+ "-font-lock-keywords"))))
+ (cond ((fboundp sym)
+ (funcall sym))
+ ((boundp sym)
+ (append (eval sym) nil)))))
+ (if (listp doc-keywords)
+ doc-keywords
+ (list doc-keywords)))
base-list)))
;; Kludge: If `c-font-lock-complex-decl-prepare' is on the list we
@@ -2131,7 +2104,7 @@ need for `c-font-lock-extra-types'.")
;; Got two parenthesized expressions, so we have to look
;; closer at them to decide which is the type. No need to
;; handle `c-record-ref-identifiers' since all references
- ;; has already been handled by other fontification rules.
+ ;; have already been handled by other fontification rules.
(let (expr1-res expr2-res)
(goto-char expr1-pos)
@@ -2139,7 +2112,7 @@ need for `c-font-lock-extra-types'.")
(unless (looking-at
(cc-eval-when-compile
(concat (c-lang-const c-symbol-start c++)
- "\\|[*:\)\[]")))
+ "\\|[*:)[]")))
;; There's something after the would-be type that
;; can't be there, so this is a placement arglist.
(setq expr1-res nil)))
@@ -2149,7 +2122,7 @@ need for `c-font-lock-extra-types'.")
(unless (looking-at
(cc-eval-when-compile
(concat (c-lang-const c-symbol-start c++)
- "\\|[*:\)\[]")))
+ "\\|[*:)[]")))
;; There's something after the would-be type that can't
;; be there, so this is an initialization expression.
(setq expr2-res nil))
@@ -2166,6 +2139,9 @@ need for `c-font-lock-extra-types'.")
;; unusual than an initializer.
(cond ((memq expr1-res '(t known prefix)))
((memq expr2-res '(t known prefix)))
+ ;; Presumably 'decltype's will be fontified elsewhere.
+ ((eq expr1-res 'decltype))
+ ((eq expr2-res 'decltype))
((eq expr1-res 'found)
(let ((c-promote-possible-types t))
(goto-char expr1-pos)
@@ -2699,7 +2675,7 @@ need for `pike-font-lock-extra-types'.")
nil)
(defconst autodoc-font-lock-doc-comments
- `(("@\\(\\w+{\\|\\[\\([^\]@\n\r]\\|@@\\)*\\]\\|[@}]\\|$\\)"
+ `(("@\\(\\w+{\\|\\[\\([^]@\n\r]\\|@@\\)*\\]\\|[@}]\\|$\\)"
;; In-text markup.
0 ,c-doc-markup-face-name prepend nil)
(autodoc-font-lock-line-markup)
@@ -2728,4 +2704,8 @@ need for `pike-font-lock-extra-types'.")
;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el.
(cc-provide 'cc-fonts)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-fonts.el ends here
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index b6f297bd9cc..4295fc72351 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -1,13 +1,12 @@
;;; cc-guess.el --- guess indentation values by scanning existing code
-;; Copyright (C) 1985, 1987, 1992-2006, 2011-2013 Free Software
+;; Copyright (C) 1985, 1987, 1992-2006, 2011-2015 Free Software
;; Foundation, Inc.
;; Author: 1994-1995 Barry A. Warsaw
;; 2011- Masatake YAMATO
;; Maintainer: bug-cc-mode@gnu.org
;; Created: August 1994, split from cc-mode.el
-;; Version: See cc-mode.el
;; Keywords: c languages oop
;; This file is part of GNU Emacs.
@@ -92,7 +91,7 @@ The offset of a line included in the indent information returned by
(defcustom c-guess-region-max 50000
"The maximum region size for examining indent information with `c-guess'.
It takes a long time to examine indent information from a large region;
-this option helps you limit that time. `nil' means no limit."
+this option helps you limit that time. nil means no limit."
:version "24.1"
:type 'integer
:group 'c)
@@ -466,7 +465,7 @@ the absolute file name of the file if STYLE-NAME is nil."
(defun c-guess-dump-guessed-style (&optional printer)
"Show the guessed style.
`pp' is used to print the style but if PRINTER is given,
-PRINTER is used instead. If PRINTER is not `nil', it
+PRINTER is used instead. If PRINTER is not nil, it
is called with one argument, the guessed style."
(interactive)
(let ((style (c-guess-make-style c-guess-guessed-basic-offset
@@ -505,8 +504,7 @@ is called with one argument, the guessed style."
(cond
((or (and a-guessed? b-guessed?)
(not (or a-guessed? b-guessed?)))
- (string-lessp (symbol-name (car a))
- (symbol-name (car b))))
+ (string-lessp (car a) (car b)))
(a-guessed? t)
(b-guessed? nil)))))))
style)
@@ -521,7 +519,8 @@ is called with one argument, the guessed style."
(goto-char (point-min))
(when (search-forward (concat "("
(symbol-name (car needs-markers))
- " ") nil t)
+ " ")
+ nil t)
(move-end-of-line 1)
(comment-dwim nil)
(insert " Guessed value"))
@@ -573,4 +572,9 @@ WITH-NAME is asked to the user."
(cc-provide 'cc-guess)
+
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-guess.el ends here
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 0116e9ec3dd..7cda5ceaf1d 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1,6 +1,6 @@
;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*-
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -130,7 +130,7 @@
;; This file is not always loaded. See note above.
-(cc-external-require 'cl)
+(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
;;; Setup for the `c-lang-defvar' system.
@@ -209,9 +209,8 @@ the evaluated constant value at compile time."
;; Suppress "might not be defined at runtime" warning.
;; This file is only used when compiling other cc files.
;; These are defined in cl as aliases to the cl- versions.
-(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t)
-(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t)
-(declare-function cl-macroexpand-all "cl" (form &optional env))
+;(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t)
+;(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t)
(eval-and-compile
;; Some helper functions used when building the language constants.
@@ -252,19 +251,19 @@ the evaluated constant value at compile time."
(unless xlate
(setq xlate 'identity))
(c-with-syntax-table (c-lang-const c-mode-syntax-table)
- (delete-duplicates
- (mapcan (lambda (opgroup)
- (when (if (symbolp (car opgroup))
- (when (funcall opgroup-filter (car opgroup))
- (setq opgroup (cdr opgroup))
- t)
- t)
- (mapcan (lambda (op)
- (when (funcall op-filter op)
- (let ((res (funcall xlate op)))
- (if (listp res) res (list res)))))
- opgroup)))
- ops)
+ (c--delete-duplicates
+ (c--mapcan (lambda (opgroup)
+ (when (if (symbolp (car opgroup))
+ (when (funcall opgroup-filter (car opgroup))
+ (setq opgroup (cdr opgroup))
+ t)
+ t)
+ (c--mapcan (lambda (op)
+ (when (funcall op-filter op)
+ (let ((res (funcall xlate op)))
+ (if (listp res) res (list res)))))
+ opgroup)))
+ ops)
:test 'equal))))
@@ -300,7 +299,8 @@ the evaluated constant value at compile time."
["Set Style..." c-set-style t]
["Show Current Style Name" (message
"Style Name: %s"
- c-indentation-style) t]
+ c-indentation-style)
+ t]
["Guess Style from this Buffer" c-guess-buffer-no-install t]
["Install the Last Guessed Style..." c-guess-install
(and c-guess-guessed-offsets-alist
@@ -318,16 +318,16 @@ the evaluated constant value at compile time."
:style toggle :selected c-auto-newline]
["Hungry delete" c-toggle-hungry-state
:style toggle :selected c-hungry-delete-key]
- ["Subword mode" subword-mode
- :style toggle :selected (and (boundp 'subword-mode)
- subword-mode)])))
+ ["Subword mode" c-subword-mode
+ :style toggle :selected (and (boundp 'c-subword-mode)
+ c-subword-mode)])))
;;; Syntax tables.
(defun c-populate-syntax-table (table)
"Populate the given syntax table as necessary for a C-like language.
-This includes setting ' and \" as string delimiters, and setting up
+This includes setting \\=' and \" as string delimiters, and setting up
the comment syntax to handle both line style \"//\" and block style
\"/*\" \"*/\" comments."
@@ -392,7 +392,9 @@ The syntax tables aren't stored directly since they're quite large."
;; lists are parsed. Note that this encourages incorrect parsing of
;; templates since they might contain normal operators that uses the
;; '<' and '>' characters. Therefore this syntax table might go
- ;; away when CC Mode handles templates correctly everywhere.
+ ;; away when CC Mode handles templates correctly everywhere. WHILE
+ ;; THIS SYNTAX TABLE IS CURRENT, `c-parse-state' MUST _NOT_ BE
+ ;; CALLED!!!
t nil
(java c++) `(lambda ()
(let ((table (funcall ,(c-lang-const c-make-mode-syntax-table))))
@@ -403,7 +405,7 @@ The syntax tables aren't stored directly since they're quite large."
(and (c-lang-const c++-make-template-syntax-table)
(funcall (c-lang-const c++-make-template-syntax-table))))
-(c-lang-defconst c-no-parens-syntax-table
+(c-lang-defconst c-make-no-parens-syntax-table
;; A variant of the standard syntax table which is used to find matching
;; "<"s and ">"s which have been marked as parens using syntax table
;; properties. The other paren characters (e.g. "{", ")" "]") are given a
@@ -411,18 +413,20 @@ The syntax tables aren't stored directly since they're quite large."
;; even when there's unbalanced other parens inside them.
;;
;; This variable is nil for languages which don't have template stuff.
- t `(lambda ()
- (if (c-lang-const c-recognize-<>-arglists)
- (let ((table (funcall ,(c-lang-const c-make-mode-syntax-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)
- table))))
+ t (if (c-lang-const c-recognize-<>-arglists)
+ `(lambda ()
+ ;(if (c-lang-const c-recognize-<>-arglists)
+ (let ((table (funcall ,(c-lang-const c-make-mode-syntax-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)
+ table))))
(c-lang-defvar c-no-parens-syntax-table
- (funcall (c-lang-const c-no-parens-syntax-table)))
+ (and (c-lang-const c-make-no-parens-syntax-table)
+ (funcall (c-lang-const c-make-no-parens-syntax-table))))
(c-lang-defconst c-identifier-syntax-modifications
"A list that describes the modifications that should be done to the
@@ -453,7 +457,7 @@ the new syntax, as accepted by `modify-syntax-entry'."
(modify-syntax-entry (car mod) (cdr mod) table))
table)
"Syntax table built on the mode syntax table but additionally
-classifies symbol constituents like '_' and '$' as word constituents,
+classifies symbol constituents like `_' and `$' as word constituents,
so that all identifiers are recognized as words.")
(c-lang-defconst c-get-state-before-change-functions
@@ -491,9 +495,9 @@ parameters \(point-min) and \(point-max).")
(c-lang-defconst c-before-font-lock-functions
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
- t 'c-change-set-fl-decl-start
+ t 'c-change-expand-fl-region
(c c++ objc) '(c-neutralize-syntax-in-and-mark-CPP
- c-change-set-fl-decl-start)
+ c-change-expand-fl-region)
awk 'c-awk-extend-and-syntax-tablify-region)
(c-lang-defvar c-before-font-lock-functions
(let ((fs (c-lang-const c-before-font-lock-functions)))
@@ -520,7 +524,7 @@ parameters \(point-min), \(point-max) and <buffer size>.")
(c-lang-defconst c-before-context-fontification-functions
awk nil
- t 'c-context-set-fl-decl-start)
+ t 'c-context-expand-fl-region)
;; For documentation see the following c-lang-defvar of the same name.
;; The value here may be a list of functions or a single function.
(c-lang-defvar c-before-context-fontification-functions
@@ -573,9 +577,18 @@ EOL terminated statements."
(c c++ objc) t)
(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields))
+(c-lang-defconst c-modified-constant
+ "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\",
+a “long character”. In particular, this recognizes forms of constant
+which `c-backward-sexp' needs to be called twice to move backwards over."
+ t nil
+ (c c++ objc) "L'\\([^\\'\t\f\n\r]\\|\\\\.\\)'")
+;; FIXME!!! Extend this to cover strings, if needed. 2008-04-11
+(c-lang-defvar c-modified-constant (c-lang-const c-modified-constant))
+
(c-lang-defconst c-symbol-start
"Regexp that matches the start of a symbol, i.e. any identifier or
-keyword. It's unspecified how far it matches. Does not contain a \\|
+keyword. It's unspecified how far it matches. Does not contain a \\|
operator at the top level."
t (concat "[" c-alpha "_]")
java (concat "[" c-alpha "_@]")
@@ -857,7 +870,7 @@ definition, or nil if the language doesn't have any."
t (if (c-lang-const c-opt-cpp-macro-define)
(concat (c-lang-const c-opt-cpp-prefix)
(c-lang-const c-opt-cpp-macro-define)
- "[ \t]+\\(\\(\\sw\\|_\\)+\\)\\(\([^\)]*\)\\)?"
+ "[ \t]+\\(\\(\\sw\\|_\\)+\\)\\(([^)]*)\\)?"
;; ^ ^ #defined name
"\\([ \t]\\|\\\\\n\\)*")))
(c-lang-defvar c-opt-cpp-macro-define-start
@@ -913,14 +926,14 @@ following elements. The car of each element describes the type of the
operator group, and the cdr is a list of the operator tokens in it.
The operator group types are:
-'prefix Unary prefix operators.
-'postfix Unary postfix operators.
-'postfix-if-paren
+`prefix' Unary prefix operators.
+`postfix' Unary postfix operators.
+`postfix-if-paren'
Unary postfix operators if and only if the chars have
parenthesis syntax.
-'left-assoc Binary left associative operators (i.e. a+b+c means (a+b)+c).
-'right-assoc Binary right associative operators (i.e. a=b=c means a=(b=c)).
-'right-assoc-sequence
+`left-assoc' Binary left associative operators (i.e. a+b+c means (a+b)+c).
+`right-assoc' Binary right associative operators (i.e. a=b=c means a=(b=c)).
+`right-assoc-sequence'
Right associative operator that constitutes of a
sequence of tokens that separate expressions. All the
tokens in the group are in this case taken as
@@ -937,10 +950,13 @@ Note that operators like \".\" and \"->\" which in language references
often are described as postfix operators are considered binary here,
since CC Mode treats every identifier as an expression."
- ;; There's currently no code in CC Mode that exploit all the info
+ ;; There's currently no code in CC Mode that exploits all the info
;; in this variable; precedence, associativity etc are present as a
;; preparation for future work.
+ ;; FIXME!!! C++11's "auto" operators "=" and "->" need to go in here
+ ;; somewhere. 2012-03-24.
+
t `(;; Preprocessor.
,@(when (c-lang-const c-opt-cpp-prefix)
`((prefix "#"
@@ -963,7 +979,8 @@ since CC Mode treats every identifier as an expression."
,@(when (c-major-mode-is 'c++-mode)
;; The following need special treatment.
`((prefix "dynamic_cast" "static_cast"
- "reinterpret_cast" "const_cast" "typeid")))
+ "reinterpret_cast" "const_cast" "typeid"
+ "alignof")))
(left-assoc "."
,@(unless (c-major-mode-is 'java-mode)
'("->")))
@@ -1136,7 +1153,8 @@ operators."
c++ (append '("&" "<%" "%>" "<:" ":>" "%:" "%:%:")
(c-lang-const c-other-op-syntax-tokens))
objc (append '("#" "##" ; Used by cpp.
- "+" "-") (c-lang-const c-other-op-syntax-tokens))
+ "+" "-")
+ (c-lang-const c-other-op-syntax-tokens))
idl (append '("#" "##") ; Used by cpp.
(c-lang-const c-other-op-syntax-tokens))
pike (append '("..")
@@ -1147,9 +1165,9 @@ operators."
(c-lang-defconst c-all-op-syntax-tokens
;; List of all tokens in the punctuation and parenthesis syntax
;; classes.
- t (delete-duplicates (append (c-lang-const c-other-op-syntax-tokens)
- (c-lang-const c-operator-list))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-other-op-syntax-tokens)
+ (c-lang-const c-operator-list))
+ :test 'string-equal))
(c-lang-defconst c-nonsymbol-token-char-list
;; List containing all chars not in the word, symbol or
@@ -1172,7 +1190,7 @@ operators."
t (c-make-keywords-re nil
(c-filter-ops (c-lang-const c-all-op-syntax-tokens)
t
- "\\`\\(\\s.\\|\\s\(\\|\\s\)\\)+\\'")))
+ "\\`\\(\\s.\\)+\\'")))
(c-lang-defvar c-nonsymbol-token-regexp
(c-lang-const c-nonsymbol-token-regexp))
@@ -1186,9 +1204,9 @@ operators."
"=\\([^=]\\|$\\)"
"\\|"
(c-make-keywords-re nil
- (set-difference (c-lang-const c-assignment-operators)
- '("=")
- :test 'string-equal)))
+ (c--set-difference (c-lang-const c-assignment-operators)
+ '("=")
+ :test 'string-equal)))
"\\<\\>"))
(c-lang-defvar c-assignment-op-regexp
(c-lang-const c-assignment-op-regexp))
@@ -1214,22 +1232,41 @@ operators."
(c-lang-defvar c-<-op-cont-regexp (c-lang-const c-<-op-cont-regexp))
+(c-lang-defconst c->-op-cont-tokens
+ ;; A list of second and subsequent characters of all multicharacter tokens
+ ;; that begin with ">".
+ t (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
+ t
+ "\\`>."
+ (lambda (op) (substring op 1)))
+ java (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
+ t
+ "\\`>[^>]\\|\\`>>[^>]"
+ (lambda (op) (substring op 1))))
+
(c-lang-defconst c->-op-cont-regexp
;; Regexp matching the second and subsequent characters of all
;; multicharacter tokens that begin with ">".
- t (c-make-keywords-re nil
- (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
- t
- "\\`>."
- (lambda (op) (substring op 1))))
- java (c-make-keywords-re nil
- (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
- t
- "\\`>[^>]\\|\\`>>[^>]"
- (lambda (op) (substring op 1)))))
+ t (c-make-keywords-re nil (c-lang-const c->-op-cont-tokens)))
(c-lang-defvar c->-op-cont-regexp (c-lang-const c->-op-cont-regexp))
+(c-lang-defconst c->-op-without->-cont-regexp
+ ;; Regexp matching the second and subsequent characters of all
+ ;; multicharacter tokens that begin with ">" except for those beginning with
+ ;; ">>".
+ t (c-make-keywords-re nil
+ (c--set-difference
+ (c-lang-const c->-op-cont-tokens)
+ (c-filter-ops (c-lang-const c-all-op-syntax-tokens)
+ t
+ "\\`>>"
+ (lambda (op) (substring op 1)))
+ :test 'string-equal)))
+
+(c-lang-defvar c->-op-without->-cont-regexp
+ (c-lang-const c->-op-without->-cont-regexp))
+
(c-lang-defconst c-stmt-delim-chars
;; The characters that should be considered to bound statements. To
;; optimize `c-crosses-statement-barrier-p' somewhat, it's assumed to
@@ -1244,6 +1281,21 @@ operators."
(c-lang-defvar c-stmt-delim-chars-with-comma
(c-lang-const c-stmt-delim-chars-with-comma))
+(c-lang-defconst c-auto-ops
+ ;; Ops which signal C++11's new auto uses.
+ t nil
+ c++ '("=" "->"))
+(c-lang-defconst c-auto-ops-re
+ t (c-make-keywords-re nil (c-lang-const c-auto-ops)))
+(c-lang-defvar c-auto-ops-re (c-lang-const c-auto-ops-re))
+
+(c-lang-defconst c-haskell-op
+ ;; Op used in the new C++11 auto function definition, indicating type.
+ t nil
+ c++ '("->"))
+(c-lang-defconst c-haskell-op-re
+ t (c-make-keywords-re nil (c-lang-const c-haskell-op)))
+(c-lang-defvar c-haskell-op-re (c-lang-const c-haskell-op-re))
;;; Syntactic whitespace.
@@ -1545,13 +1597,14 @@ properly."
(c-lang-defvar c-syntactic-eol (c-lang-const c-syntactic-eol))
-;;; Defun functions
-
-;; The Emacs variables beginning-of-defun-function and
-;; end-of-defun-function will be set so that commands like
-;; `mark-defun' and `narrow-to-defun' work right. The key sequences
-;; C-M-a and C-M-e are, however, bound directly to the CC Mode
-;; functions, allowing optimization for large n.
+;;; Defun handling.
+
+;; The Emacs variables beginning-of-defun-function and end-of-defun-function
+;; will be set so that commands like `mark-defun' and `narrow-to-defun' work
+;; right. In older Emacsen, the key sequences C-M-a and C-M-e are, however,
+;; bound directly to the CC Mode functions, allowing optimization for large n.
+;; From Emacs 23, this isn't necessary any more, since n is passed to the two
+;; functions.
(c-lang-defconst beginning-of-defun-function
"Function to which beginning-of-defun-function will be set."
t 'c-beginning-of-defun
@@ -1606,7 +1659,7 @@ the appropriate place for that."
'("_Bool" "_Complex" "_Imaginary") ; Conditionally defined in C99.
(c-lang-const c-primitive-type-kwds))
c++ (append
- '("bool" "wchar_t")
+ '("bool" "wchar_t" "char16_t" "char32_t")
(c-lang-const c-primitive-type-kwds))
;; Objective-C extends C, but probably not the new stuff in C99.
objc (append
@@ -1641,7 +1694,7 @@ be a subset of `c-primitive-type-kwds'."
"strong"))
(c-lang-defconst c-typedef-kwds
- "Prefix keyword\(s\) like \"typedef\" which make a type declaration out
+ "Prefix keyword(s) like \"typedef\" which make a type declaration out
of a variable declaration."
t '("typedef")
(awk idl java) nil)
@@ -1651,6 +1704,18 @@ of a variable declaration."
t (c-make-keywords-re t (c-lang-const c-typedef-kwds)))
(c-lang-defvar c-typedef-key (c-lang-const c-typedef-key))
+(c-lang-defconst c-typeof-kwds
+ "Keywords followed by a parenthesized expression, which stands for
+the type of that expression."
+ t nil
+ c '("typeof") ; longstanding GNU C(++) extension.
+ c++ '("decltype" "typeof"))
+
+(c-lang-defconst c-typeof-key
+ ;; Adorned regexp matching `c-typeof-kwds'.
+ t (c-make-keywords-re t (c-lang-const c-typeof-kwds)))
+(c-lang-defvar c-typeof-key (c-lang-const c-typeof-key))
+
(c-lang-defconst c-type-prefix-kwds
"Keywords where the following name - if any - is a type name, and
where the keyword together with the symbol works as a type in
@@ -1676,7 +1741,7 @@ but they don't build a type of themselves. Unlike the keywords on
not the type face."
t nil
c '("const" "restrict" "volatile")
- c++ '("const" "volatile" "throw")
+ c++ '("const" "constexpr" "noexcept" "volatile" "throw" "final" "override")
objc '("const" "volatile"))
(c-lang-defconst c-opt-type-modifier-key
@@ -1700,10 +1765,10 @@ not the type face."
(c-lang-defconst c-type-start-kwds
;; All keywords that can start a type (i.e. are either a type prefix
;; or a complete type).
- t (delete-duplicates (append (c-lang-const c-primitive-type-kwds)
- (c-lang-const c-type-prefix-kwds)
- (c-lang-const c-type-modifier-kwds))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-primitive-type-kwds)
+ (c-lang-const c-type-prefix-kwds)
+ (c-lang-const c-type-modifier-kwds))
+ :test 'string-equal))
(c-lang-defconst c-class-decl-kwds
"Keywords introducing declarations where the following block (if any)
@@ -1753,6 +1818,26 @@ will be handled."
t (c-make-keywords-re t (c-lang-const c-brace-list-decl-kwds)))
(c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key))
+(c-lang-defconst c-after-brace-list-decl-kwds
+ "Keywords that might follow keywords in `c-brace-list-decl-kwds'
+and precede the opening brace."
+ t nil
+ c++ '("class" "struct"))
+
+(c-lang-defconst c-after-brace-list-key
+ ;; Regexp matching keywords that can fall between a brace-list
+ ;; keyword and the associated brace list.
+ t (c-make-keywords-re t (c-lang-const c-after-brace-list-decl-kwds)))
+(c-lang-defvar c-after-brace-list-key (c-lang-const c-after-brace-list-key))
+
+(c-lang-defconst c-recognize-post-brace-list-type-p
+ "Set to t when we recognize a colon and then a type after an enum,
+e.g., enum foo : int { A, B, C };"
+ t nil
+ c++ t)
+(c-lang-defvar c-recognize-post-brace-list-type-p
+ (c-lang-const c-recognize-post-brace-list-type-p))
+
(c-lang-defconst c-other-block-decl-kwds
"Keywords where the following block (if any) contains another
declaration level that should not be considered a class. For every
@@ -1834,6 +1919,7 @@ 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)
@@ -1857,7 +1943,8 @@ If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
will be handled."
t nil
(c c++) '("auto" "extern" "inline" "register" "static")
- c++ (append '("explicit" "friend" "mutable" "template" "using" "virtual")
+ c++ (append '("explicit" "friend" "mutable" "template" "thread_local"
+ "using" "virtual")
(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.
@@ -1943,16 +2030,16 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
;; something is a type or just some sort of macro in front of the
;; declaration. They might be ambiguous with types or type
;; prefixes.
- t (delete-duplicates (append (c-lang-const c-class-decl-kwds)
- (c-lang-const c-brace-list-decl-kwds)
- (c-lang-const c-other-block-decl-kwds)
- (c-lang-const c-typedef-decl-kwds)
- (c-lang-const c-typeless-decl-kwds)
- (c-lang-const c-modifier-kwds)
- (c-lang-const c-other-decl-kwds)
- (c-lang-const c-decl-start-kwds)
- (c-lang-const c-decl-hangon-kwds))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-class-decl-kwds)
+ (c-lang-const c-brace-list-decl-kwds)
+ (c-lang-const c-other-block-decl-kwds)
+ (c-lang-const c-typedef-decl-kwds)
+ (c-lang-const c-typeless-decl-kwds)
+ (c-lang-const c-modifier-kwds)
+ (c-lang-const c-other-decl-kwds)
+ (c-lang-const c-decl-start-kwds)
+ (c-lang-const c-decl-hangon-kwds))
+ :test 'string-equal))
(c-lang-defconst c-prefix-spec-kwds-re
;; Adorned regexp of `c-prefix-spec-kwds'.
@@ -1965,10 +2052,10 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
;; ambiguous with types or type prefixes. These are the keywords (like
;; extern, namespace, but NOT template) that can modify a declaration.
t (c-make-keywords-re t
- (set-difference (c-lang-const c-prefix-spec-kwds)
- (append (c-lang-const c-type-start-kwds)
- (c-lang-const c-<>-arglist-kwds))
- :test 'string-equal)))
+ (c--set-difference (c-lang-const c-prefix-spec-kwds)
+ (append (c-lang-const c-type-start-kwds)
+ (c-lang-const c-<>-arglist-kwds))
+ :test 'string-equal)))
(c-lang-defvar c-specifier-key (c-lang-const c-specifier-key))
(c-lang-defconst c-postfix-spec-kwds
@@ -1981,18 +2068,19 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
;; Adorned regexp matching all keywords that can't appear at the
;; start of a declaration.
t (c-make-keywords-re t
- (set-difference (c-lang-const c-keywords)
- (append (c-lang-const c-type-start-kwds)
- (c-lang-const c-prefix-spec-kwds))
- :test 'string-equal)))
+ (c--set-difference (c-lang-const c-keywords)
+ (append (c-lang-const c-type-start-kwds)
+ (c-lang-const c-prefix-spec-kwds)
+ (c-lang-const c-typeof-kwds))
+ :test 'string-equal)))
(c-lang-defvar c-not-decl-init-keywords
(c-lang-const c-not-decl-init-keywords))
(c-lang-defconst c-not-primitive-type-keywords
"List of all keywords apart from primitive types (like \"int\")."
- t (set-difference (c-lang-const c-keywords)
- (c-lang-const c-primitive-type-kwds)
- :test 'string-equal)
+ t (c--set-difference (c-lang-const c-keywords)
+ (c-lang-const c-primitive-type-kwds)
+ :test 'string-equal)
;; The "more" for C++ is the QT keyword (as in "more slots:").
;; This variable is intended for use in c-beginning-of-statement-1.
c++ (append (c-lang-const c-not-primitive-type-keywords) '("more")))
@@ -2013,7 +2101,7 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
"Keywords introducing declarations that can contain a block which
might be followed by variable declarations, e.g. like \"foo\" in
\"class Foo { ... } foo;\". So if there is a block in a declaration
-like that, it ends with the following ';' and not right away.
+like that, it ends with the following `;' and not right away.
The keywords on list are assumed to also be present on one of the
`*-decl-kwds' lists."
@@ -2040,6 +2128,12 @@ declarations."
;; In CORBA PSDL:
"as" "const" "implements" "of" "ref"))
+(c-lang-defconst c-postfix-decl-spec-key
+ ;; Regexp matching the keywords in `c-postfix-decl-spec-kwds'.
+ t (c-make-keywords-re t (c-lang-const c-postfix-decl-spec-kwds)))
+(c-lang-defvar c-postfix-decl-spec-key
+ (c-lang-const c-postfix-decl-spec-key))
+
(c-lang-defconst c-nonsymbol-sexp-kwds
"Keywords that may be followed by a nonsymbol sexp before whatever
construct it's part of continues."
@@ -2108,7 +2202,7 @@ regexp if `c-colon-type-list-kwds' isn't nil."
;; before the ":" that starts the inherit list after "class"
;; or "struct" in C++. (Also used as default for other
;; languages.)
- "[^\]\[{}();,/#=:]*:"))
+ "[^][{}();,/#=:]*:"))
(c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re))
(c-lang-defconst c-paren-nontype-kwds
@@ -2130,9 +2224,9 @@ type identifiers separated by arbitrary tokens."
pike '("array" "function" "int" "mapping" "multiset" "object" "program"))
(c-lang-defconst c-paren-any-kwds
- t (delete-duplicates (append (c-lang-const c-paren-nontype-kwds)
- (c-lang-const c-paren-type-kwds))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-paren-nontype-kwds)
+ (c-lang-const c-paren-type-kwds))
+ :test 'string-equal))
(c-lang-defconst c-<>-type-kwds
"Keywords that may be followed by an angle bracket expression
@@ -2156,9 +2250,9 @@ assumed to be set if this isn't nil."
(c-lang-defconst c-<>-sexp-kwds
;; All keywords that can be followed by an angle bracket sexp.
- t (delete-duplicates (append (c-lang-const c-<>-type-kwds)
- (c-lang-const c-<>-arglist-kwds))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-<>-type-kwds)
+ (c-lang-const c-<>-arglist-kwds))
+ :test 'string-equal))
(c-lang-defconst c-opt-<>-sexp-key
;; Adorned regexp matching keywords that can be followed by an angle
@@ -2216,9 +2310,9 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-defconst c-block-stmt-kwds
;; Union of `c-block-stmt-1-kwds' and `c-block-stmt-2-kwds'.
- t (delete-duplicates (append (c-lang-const c-block-stmt-1-kwds)
- (c-lang-const c-block-stmt-2-kwds))
- :test 'string-equal))
+ t (c--delete-duplicates (append (c-lang-const c-block-stmt-1-kwds)
+ (c-lang-const c-block-stmt-2-kwds))
+ :test 'string-equal))
(c-lang-defconst c-opt-block-stmt-key
;; Regexp matching the start of any statement that has a
@@ -2250,7 +2344,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-defconst c-paren-stmt-kwds
"Statement keywords followed by a parenthesis expression that
-nevertheless contains a list separated with ';' and not ','."
+nevertheless contains a list separated with `;' and not `,'."
t '("for")
idl nil)
@@ -2272,7 +2366,7 @@ nevertheless contains a list separated with ';' and not ','."
(c-lang-defvar c-opt-asm-stmt-key (c-lang-const c-opt-asm-stmt-key))
(c-lang-defconst c-case-kwds
- "The keyword\(s) which introduce a \"case\" like construct.
+ "The keyword(s) which introduce a \"case\" like construct.
This construct is \"<keyword> <expression> :\"."
t '("case")
awk nil)
@@ -2302,8 +2396,11 @@ This construct is \"<keyword> <expression> :\"."
(c-lang-defconst c-constant-kwds
"Keywords for constants."
t nil
- (c c++) '("NULL" ;; Not a keyword, but practically works as one.
+ c '("NULL" ;; Not a keyword, but practically works as one.
"false" "true") ; Defined in C99.
+ c++ (append
+ '("nullptr")
+ (c-lang-const c-constant-kwds c))
objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
idl '("TRUE" "FALSE")
java '("true" "false" "null") ; technically "literals", not keywords
@@ -2320,7 +2417,7 @@ This construct is \"<keyword> <expression> :\"."
(c-lang-defconst c-expr-kwds
;; Keywords that can occur anywhere in expressions. Built from
;; `c-primary-expr-kwds' and all keyword operators in `c-operators'.
- t (delete-duplicates
+ t (c--delete-duplicates
(append (c-lang-const c-primary-expr-kwds)
(c-filter-ops (c-lang-const c-operator-list)
t
@@ -2371,12 +2468,12 @@ Note that Java specific rules are currently applied to tell this from
t (let* ((decl-kwds (append (c-lang-const c-class-decl-kwds)
(c-lang-const c-other-block-decl-kwds)
(c-lang-const c-inexpr-class-kwds)))
- (unambiguous (set-difference decl-kwds
- (c-lang-const c-type-start-kwds)
- :test 'string-equal))
- (ambiguous (intersection decl-kwds
- (c-lang-const c-type-start-kwds)
- :test 'string-equal)))
+ (unambiguous (c--set-difference decl-kwds
+ (c-lang-const c-type-start-kwds)
+ :test 'string-equal))
+ (ambiguous (c--intersection decl-kwds
+ (c-lang-const c-type-start-kwds)
+ :test 'string-equal)))
(if ambiguous
(concat (c-make-keywords-re t unambiguous)
"\\|"
@@ -2424,7 +2521,7 @@ Note that Java specific rules are currently applied to tell this from
(c-lang-defconst c-keywords
;; All keywords as a list.
- t (delete-duplicates
+ t (c--delete-duplicates
(c-lang-defconst-eval-immediately
`(append ,@(mapcar (lambda (kwds-lang-const)
`(c-lang-const ,kwds-lang-const))
@@ -2488,6 +2585,7 @@ Note that Java specific rules are currently applied to tell this from
(setplist (intern kwd obarray)
;; Emacs has an odd bug that causes `mapcan' to fail
;; with unintelligible errors. (XEmacs works.)
+ ;; (2015-06-24): This bug has not yet been fixed.
;;(mapcan (lambda (lang-const)
;; (list lang-const t))
;; lang-const-list)
@@ -2500,10 +2598,10 @@ Note that Java specific rules are currently applied to tell this from
;; Adorned regexp matching all keywords that should be fontified
;; with the keywords face. I.e. that aren't types or constants.
t (c-make-keywords-re t
- (set-difference (c-lang-const c-keywords)
- (append (c-lang-const c-primitive-type-kwds)
- (c-lang-const c-constant-kwds))
- :test 'string-equal)))
+ (c--set-difference (c-lang-const c-keywords)
+ (append (c-lang-const c-primitive-type-kwds)
+ (c-lang-const c-constant-kwds))
+ :test 'string-equal)))
(c-lang-defvar c-regular-keywords-regexp
(c-lang-const c-regular-keywords-regexp))
@@ -2538,12 +2636,12 @@ Note that Java specific rules are currently applied to tell this from
right-assoc-sequence)
t))
- (unambiguous-prefix-ops (set-difference nonkeyword-prefix-ops
- in-or-postfix-ops
- :test 'string-equal))
- (ambiguous-prefix-ops (intersection nonkeyword-prefix-ops
- in-or-postfix-ops
- :test 'string-equal)))
+ (unambiguous-prefix-ops (c--set-difference nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal))
+ (ambiguous-prefix-ops (c--intersection nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal)))
(concat
"\\("
@@ -2551,14 +2649,14 @@ Note that Java specific rules are currently applied to tell this from
;; first submatch from them together with `c-primary-expr-kwds'.
(c-make-keywords-re t
(append (c-lang-const c-primary-expr-kwds)
- (set-difference prefix-ops nonkeyword-prefix-ops
- :test 'string-equal)))
+ (c--set-difference prefix-ops nonkeyword-prefix-ops
+ :test 'string-equal)))
"\\|"
;; Match all ambiguous operators.
(c-make-keywords-re nil
- (intersection nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
+ (c--intersection nonkeyword-prefix-ops in-or-postfix-ops
+ :test 'string-equal))
"\\)"
"\\|"
@@ -2573,8 +2671,8 @@ Note that Java specific rules are currently applied to tell this from
"\\|"
;; The unambiguous operators from `prefix-ops'.
(c-make-keywords-re nil
- (set-difference nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
+ (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops
+ :test 'string-equal))
"\\|"
;; Match string and character literals.
@@ -2587,6 +2685,15 @@ Note that Java specific rules are currently applied to tell this from
;;; Additional constants for parser-level constructs.
+(c-lang-defconst c-decl-start-colon-kwd-re
+ "Regexp matching a keyword that is followed by a colon, where
+ the whole construct can precede a declaration.
+ E.g. \"public:\" in C++."
+ t "\\<\\>"
+ c++ (c-make-keywords-re t (c-lang-const c-protection-kwds)))
+(c-lang-defvar c-decl-start-colon-kwd-re
+ (c-lang-const c-decl-start-colon-kwd-re))
+
(c-lang-defconst c-decl-prefix-re
"Regexp matching something that might precede a declaration, cast or
label, such as the last token of a preceding statement or declaration.
@@ -2622,22 +2729,25 @@ more info."
;; more quickly. We match ")" in C for K&R region declarations, and
;; in all languages except Java for when a cpp macro definition
;; begins with a declaration.
- t "\\([\{\}\(\);,]+\\)"
- java "\\([\{\}\(;,<]+\\)"
+ t "\\([{}();,]+\\)"
+ java "\\([{}(;,<]+\\)"
;; Match "<" in C++ to get the first argument in a template arglist.
;; In that case there's an additional check in `c-find-decl-spots'
- ;; that it got open paren syntax.
- c++ "\\([\{\}\(\);,<]+\\)"
+ ;; that it got open paren syntax. Match ":" to aid in picking up
+ ;; "public:", etc. This involves additional checks in
+ ;; `c-find-decl-prefix-search' to prevent a match of identifiers
+ ;; or labels.
+ c++ "\\([{}();:,<]+\\)"
;; Additionally match the protection directives in Objective-C.
;; Note that this doesn't cope with the longer directives, which we
;; would have to match from start to end since they don't end with
;; any easily recognized characters.
- objc (concat "\\([\{\}\(\);,]+\\|"
+ objc (concat "\\([{}();,]+\\|"
(c-make-keywords-re nil (c-lang-const c-protection-kwds))
"\\)")
;; Pike is like C but we also match "[" for multiple value
;; assignments and type casts.
- pike "\\([\{\}\(\)\[;,]+\\)")
+ pike "\\([{}()[;,]+\\)")
(c-lang-defvar c-decl-prefix-re (c-lang-const c-decl-prefix-re)
'dont-doc)
@@ -2682,7 +2792,7 @@ constructs."
;; languages without casts.
t (c-filter-ops (c-lang-const c-operators)
'(prefix)
- "\\`\\s\(\\'"
+ "\\`\\s(\\'"
(lambda (op) (elt op 0))))
(c-lang-defvar c-cast-parens (c-lang-const c-cast-parens))
@@ -2696,7 +2806,7 @@ the \"class Foo: public Bar\" part of:
If parens can occur, the chars inside those aren't filtered with this
list.
-'<' and '>' should be disallowed even if angle bracket arglists can
+`<' and `>' should be disallowed even if angle bracket arglists can
occur. That since the search function needs to stop at them anyway to
ensure they are given paren syntax.
@@ -2707,7 +2817,7 @@ possible for good performance."
;; Default to all chars that only occurs in nonsymbol tokens outside
;; identifiers.
- t (set-difference
+ t (c--set-difference
(c-lang-const c-nonsymbol-token-char-list)
(c-filter-ops (append (c-lang-const c-identifier-ops)
(list (cons nil
@@ -2724,26 +2834,26 @@ possible for good performance."
;; Allow cpp operations (where applicable).
t (if (c-lang-const c-opt-cpp-prefix)
- (set-difference (c-lang-const c-block-prefix-disallowed-chars)
- '(?#))
+ (c--set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?#))
(c-lang-const c-block-prefix-disallowed-chars))
;; Allow ':' for inherit list starters.
- (c++ objc idl) (set-difference (c-lang-const c-block-prefix-disallowed-chars)
- '(?:))
+ (c++ objc idl) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?:))
;; Allow ',' for multiple inherits.
- (c++ java) (set-difference (c-lang-const c-block-prefix-disallowed-chars)
- '(?,))
+ (c++ java) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?,))
;; Allow parentheses for anonymous inner classes in Java and class
;; initializer lists in Pike.
- (java pike) (set-difference (c-lang-const c-block-prefix-disallowed-chars)
- '(?\( ?\)))
+ (java pike) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?\( ?\)))
;; Allow '"' for extern clauses (e.g. extern "C" {...}).
- (c c++ objc) (set-difference (c-lang-const c-block-prefix-disallowed-chars)
- '(?\" ?')))
+ (c c++ objc) (c--set-difference (c-lang-const c-block-prefix-disallowed-chars)
+ '(?\" ?')))
(c-lang-defconst c-block-prefix-charset
;; `c-block-prefix-disallowed-chars' as an inverted charset suitable
@@ -2752,7 +2862,7 @@ possible for good performance."
(c-lang-defvar c-block-prefix-charset (c-lang-const c-block-prefix-charset))
(c-lang-defconst c-type-decl-prefix-key
- "Regexp matching the declarator operators that might precede the
+ "Regexp matching any declarator operator that might precede the
identifier in a declaration, e.g. the \"*\" in \"char *argv\". This
regexp should match \"(\" if parentheses are valid in declarators.
The end of the first submatch is taken as the end of the operator.
@@ -2765,13 +2875,13 @@ Identifier syntax is in effect when this is matched \(see
;; Check that there's no "=" afterwards to avoid matching tokens
;; like "*=".
(c objc) (concat "\\("
- "[*\(]"
+ "[*(]"
"\\|"
(c-lang-const c-type-decl-prefix-key)
"\\)"
"\\([^=]\\|$\\)")
c++ (concat "\\("
- "[*\(&]"
+ "[*(&]"
"\\|"
(c-lang-const c-type-decl-prefix-key)
"\\|"
@@ -2799,13 +2909,13 @@ is in effect when this is matched (see `c-identifier-syntax-table')."
;; Default to a regexp that matches `c-type-modifier-kwds' and a
;; function argument list parenthesis.
t (if (c-lang-const c-type-modifier-kwds)
- (concat "\\(\(\\|"
+ (concat "\\((\\|"
(regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>"
"\\)")
- "\\(\(\\)")
+ "\\((\\)")
(c c++ objc) (concat
"\\("
- "[\)\[\(]"
+ "[)[(]"
(if (c-lang-const c-type-modifier-kwds)
(concat
"\\|"
@@ -2816,7 +2926,8 @@ is in effect when this is matched (see `c-identifier-syntax-table')."
"\\>")
"")
"\\)")
- (java idl) "\\([\[\(]\\)")
+ java "\\([[()]\\)"
+ idl "\\([[(]\\)")
(c-lang-defvar c-type-decl-suffix-key (c-lang-const c-type-decl-suffix-key)
'dont-doc)
@@ -2896,17 +3007,15 @@ is in effect or not."
(when (boundp (c-mode-symbol "font-lock-extra-types"))
(c-mode-var "font-lock-extra-types")))
(regexp-strings
- (apply 'nconc
- (mapcar (lambda (re)
- (when (string-match "[][.*+?^$\\]" re)
- (list re)))
- extra-types)))
+ (delq nil (mapcar (lambda (re)
+ (when (string-match "[][.*+?^$\\]" re)
+ re))
+ extra-types)))
(plain-strings
- (apply 'nconc
- (mapcar (lambda (re)
- (unless (string-match "[][.*+?^$\\]" re)
- (list re)))
- extra-types))))
+ (delq nil (mapcar (lambda (re)
+ (unless (string-match "[][.*+?^$\\]" re)
+ re))
+ extra-types))))
(concat "\\<\\("
(c-concat-separated
(append (list (c-make-keywords-re nil
@@ -2937,7 +3046,7 @@ calls before a brace block. This setting does not affect declarations
that are preceded by a declaration starting keyword, so
e.g. `c-typeless-decl-kwds' may still be used when it's set to nil."
t nil
- (c c++ objc) t)
+ (c c++ objc java) t)
(c-lang-defvar c-recognize-typeless-decls
(c-lang-const c-recognize-typeless-decls))
@@ -2950,7 +3059,8 @@ identifier or one of the keywords on `c-<>-type-kwds' or
expression is considered to be a type."
t (or (consp (c-lang-const c-<>-type-kwds))
(consp (c-lang-const c-<>-arglist-kwds)))
- java t)
+ java t) ; 2008-10-19. This is crude. The syntax for java
+ ; generics is not yet coded in CC Mode.
(c-lang-defvar c-recognize-<>-arglists (c-lang-const c-recognize-<>-arglists))
(c-lang-defconst c-enums-contain-decls
@@ -3001,7 +3111,7 @@ i.e. compound statements surrounded by parentheses inside expressions."
t (if (c-lang-const c-opt-<>-arglist-start)
(concat "\\("
(c-lang-const c-opt-<>-arglist-start)
- "\\)\\|\\s\)")))
+ "\\)\\|\\s)")))
(c-lang-defvar c-opt-<>-arglist-start-in-paren
(c-lang-const c-opt-<>-arglist-start-in-paren))
@@ -3048,17 +3158,17 @@ i.e. before \":\". Only used if `c-recognize-colon-labels' is set."
t (concat
;; All keywords except `c-label-kwds' and `c-protection-kwds'.
(c-make-keywords-re t
- (set-difference (c-lang-const c-keywords)
- (append (c-lang-const c-label-kwds)
- (c-lang-const c-protection-kwds))
- :test 'string-equal)))
+ (c--set-difference (c-lang-const c-keywords)
+ (append (c-lang-const c-label-kwds)
+ (c-lang-const c-protection-kwds))
+ :test 'string-equal)))
;; Don't allow string literals, except in AWK. Character constants are OK.
(c objc java pike idl) (concat "\"\\|"
(c-lang-const c-nonlabel-token-key))
;; Also check for open parens in C++, to catch member init lists in
;; constructors. We normally allow it so that macros with arguments
;; work in labels.
- c++ (concat "\\s\(\\|\"\\|" (c-lang-const c-nonlabel-token-key)))
+ c++ (concat "\\s(\\|\"\\|" (c-lang-const c-nonlabel-token-key)))
(c-lang-defvar c-nonlabel-token-key (c-lang-const c-nonlabel-token-key))
(c-lang-defconst c-nonlabel-token-2-key
@@ -3106,7 +3216,7 @@ way."
"\\([+-]\\)"
(c-lang-const c-simple-ws) "*"
(concat "\\(" ; Return type.
- "([^\)]*)"
+ "([^)]*)"
(c-lang-const c-simple-ws) "*"
"\\)?")
"\\(" (c-lang-const c-symbol-key) "\\)"))
@@ -3151,10 +3261,7 @@ function it returns is byte compiled with all the evaluated results
from the language constants. Use the `c-init-language-vars' macro to
accomplish that conveniently."
- (if (and (not load-in-progress)
- (boundp 'byte-compile-dest-file)
- (stringp byte-compile-dest-file))
-
+ (if (cc-bytecomp-is-compiling)
;; No need to byte compile this lambda since the byte compiler is
;; smart enough to detect the `funcall' construct in the
;; `c-init-language-vars' macro below and compile it all straight
@@ -3162,7 +3269,7 @@ accomplish that conveniently."
`(lambda ()
;; This let sets up the context for `c-mode-var' and similar
- ;; that could be in the result from `cl-macroexpand-all'.
+ ;; that could be in the result from `c--macroexpand-all'.
(let ((c-buffer-is-cc-mode ',mode)
current-var source-eval)
(c-make-emacs-variables-local)
@@ -3172,18 +3279,18 @@ accomplish that conveniently."
(setq ,@(let ((c-buffer-is-cc-mode mode)
(c-lang-const-expansion 'immediate))
;; `c-lang-const' will expand to the evaluated
- ;; constant immediately in `cl-macroexpand-all'
+ ;; constant immediately in `c--macroexpand-all'
;; below.
- (mapcan
+ (c--mapcan
(lambda (init)
`(current-var ',(car init)
- ,(car init) ,(cl-macroexpand-all
- (elt init 1))))
+ ,(car init) ,(c--macroexpand-all
+ (elt init 1))))
;; Note: The following `append' copies the
;; first argument. That list is small, so
;; this doesn't matter too much.
- (append (cdr c-emacs-variable-inits)
- (cdr c-lang-variable-inits)))))
+ (append (cdr c-emacs-variable-inits)
+ (cdr c-lang-variable-inits)))))
;; This diagnostic message isn't useful for end
;; users, so it's disabled.
@@ -3197,10 +3304,9 @@ accomplish that conveniently."
(setq source-eval t)
(let ((init ',(append (cdr c-emacs-variable-inits)
(cdr c-lang-variable-inits))))
- (while init
- (setq current-var (caar init))
- (set (caar init) (eval (cadar init)))
- (setq init (cdr init)))))
+ (dolist (var-init init)
+ (setq current-var (car var-init))
+ (set (car var-init) (eval (cadr var-init))))))
(error
(if current-var
@@ -3226,10 +3332,9 @@ accomplish that conveniently."
(c-make-emacs-variables-local)
(condition-case err
- (while init
- (setq current-var (caar init))
- (set (caar init) (eval (cadar init)))
- (setq init (cdr init)))
+ (dolist (var-init init)
+ (setq current-var (car var-init))
+ (set (car var-init) (eval (cadr var-init))))
(error
(if current-var
@@ -3249,4 +3354,8 @@ evaluated and should not be quoted."
(cc-provide 'cc-langs)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-langs.el ends here
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 067a4df13dd..51cb9203e72 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -1,6 +1,6 @@
;;; cc-menus.el --- imenu support for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 1998- Martin Stjernholm
;; 1992-1999 Barry A. Warsaw
@@ -269,7 +269,7 @@ nested angle brackets constructs."
"\\(" ; method name which gets captured
; into index
"[" c-alpha "_]"
- "[" c-alnum "_]*"
+ "[" c-alnum "_]*"
"\\)"
"[ \t\n\r]*"
;; An argument list that contains zero or more arguments.
@@ -361,7 +361,7 @@ Example:
p (1+ p))
(cond
;; Is CHAR part of a objc token?
- ((and (not inargvar) ; Ignore if CHAR is part of an argument variable.
+ ((and (not inargvar) ; Ignore if CHAR is part of an argument variable.
(eq 0 betweenparen) ; Ignore if CHAR is in parentheses.
(or (and (<= ?a char) (<= char ?z))
(and (<= ?A char) (<= char ?Z))
@@ -521,4 +521,8 @@ Example:
(cc-provide 'cc-menus)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-menus.el ends here
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 36c9f72fa18..1b6a233067c 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,6 +1,6 @@
;;; cc-mode.el --- major mode for editing C and similar languages
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -75,7 +75,7 @@
;; For Emacs < 22.2.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
(eval-when-compile
(let ((load-path
@@ -108,11 +108,6 @@
;; with your version of Emacs, you are incompatible!
(cc-external-require 'easymenu)
-;; Autoload directive for emacsen that doesn't have an older CC Mode
-;; version in the dist.
-(autoload 'subword-mode "subword"
- "Mode enabling subword movement and editing keys." t)
-
;; Load cc-fonts first after font-lock is loaded, since it isn't
;; necessary until font locking is requested.
; (eval-after-load "font-lock" ; 2006-07-09: font-lock is now preloaded.
@@ -185,10 +180,14 @@ control). See \"cc-mode.el\" for more info."
(run-hooks 'c-initialization-hook)
;; Fix obsolete variables.
(if (boundp 'c-comment-continuation-stars)
- (setq c-block-comment-prefix
- (symbol-value 'c-comment-continuation-stars)))
+ (setq c-block-comment-prefix c-comment-continuation-stars))
(add-hook 'change-major-mode-hook 'c-leave-cc-mode-mode)
- (setq c-initialization-ok t))
+ (setq c-initialization-ok t)
+ ;; Connect up with Emacs's electric-indent-mode, for >= Emacs 24.4
+ (when (fboundp 'electric-indent-local-mode)
+ (add-hook 'electric-indent-mode-hook 'c-electric-indent-mode-hook)
+ (add-hook 'electric-indent-local-mode-hook
+ 'c-electric-indent-local-mode-hook)))
;; Will try initialization hooks again if they failed.
(put 'c-initialize-cc-mode initprop c-initialization-ok))))
@@ -217,12 +216,16 @@ control). See \"cc-mode.el\" for more info."
(t (error "CC Mode is incompatible with this version of Emacs")))
map))
-(defun c-define-abbrev-table (name defs)
+(defun c-define-abbrev-table (name defs &optional doc)
;; Compatibility wrapper for `define-abbrev' which passes a non-nil
;; sixth argument for SYSTEM-FLAG in emacsen that support it
;; (currently only Emacs >= 21.2).
- (let ((table (or (symbol-value name)
- (progn (define-abbrev-table name nil)
+ (let ((table (or (and (boundp name) (symbol-value name))
+ (progn (condition-case nil
+ (define-abbrev-table name nil doc)
+ (wrong-number-of-arguments ;E.g. Emacs<23.
+ (eval `(defvar ,name nil ,doc))
+ (define-abbrev-table name nil)))
(symbol-value name)))))
(while defs
(condition-case nil
@@ -371,7 +374,7 @@ control). See \"cc-mode.el\" for more info."
;; conflicts with OOBR
;;(define-key c-mode-base-map "\C-c\C-v" 'c-version)
;; (define-key c-mode-base-map "\C-c\C-y" 'c-toggle-hungry-state) Commented out by ACM, 2005-11-22.
- (define-key c-mode-base-map "\C-c\C-w" 'subword-mode)
+ (define-key c-mode-base-map "\C-c\C-w" 'c-subword-mode)
)
;; We don't require the outline package, but we configure it a bit anyway.
@@ -463,6 +466,14 @@ preferably use the `c-mode-menu' language constant directly."
(defvar c-maybe-stale-found-type nil)
(make-variable-buffer-local 'c-maybe-stale-found-type)
+(defvar c-just-done-before-change nil)
+(make-variable-buffer-local 'c-just-done-before-change)
+;; This variable is set to t by `c-before-change' and to nil by
+;; `c-after-change'. It is used to detect a spurious invocation of
+;; `before-change-functions' directly following on from a correct one. This
+;; happens in some Emacsen, for example when `basic-save-buffer' does (insert
+;; ?\n) when `require-final-newline' is non-nil.
+
(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
@@ -500,6 +511,14 @@ that requires a literal mode spec at compile time."
(set (make-local-variable 'comment-line-break-function)
'c-indent-new-comment-line)
+ ;; Prevent time-wasting activity on C-y.
+ (when (boundp 'yank-handled-properties)
+ (make-local-variable 'yank-handled-properties)
+ (let ((yank-cat-handler (assq 'category yank-handled-properties)))
+ (when yank-cat-handler
+ (setq yank-handled-properties (remq yank-cat-handler
+ yank-handled-properties)))))
+
;; For the benefit of adaptive file, which otherwise mis-fills.
(setq fill-paragraph-handle-comment nil)
@@ -533,10 +552,11 @@ that requires a literal mode spec at compile time."
;; Use this in Emacs 21+ to avoid meddling with the rear-nonsticky
;; property on each character.
(when (boundp 'text-property-default-nonsticky)
+ (make-local-variable 'text-property-default-nonsticky)
(mapc (lambda (tprop)
(unless (assq tprop text-property-default-nonsticky)
- (set (make-local-variable 'text-property-default-nonsticky)
- (cons `(,tprop . t) text-property-default-nonsticky))))
+ (setq text-property-default-nonsticky
+ (cons `(,tprop . t) text-property-default-nonsticky))))
'(syntax-table category c-type)))
;; In Emacs 21 and later it's possible to turn off the ad-hoc
@@ -574,6 +594,15 @@ that requires a literal mode spec at compile time."
;; setup the comment indent variable in a Emacs version portable way
(set (make-local-variable 'comment-indent-function) 'c-comment-indent)
+ ;; In Emacs 24.4 onwards, prevent Emacs's built in electric indentation from
+ ;; messing up CC Mode's, and set `c-electric-flag' if `electric-indent-mode'
+ ;; has been called by the user.
+ (when (boundp 'electric-indent-inhibit) (setq electric-indent-inhibit t))
+ ;; CC-mode should obey Emacs's generic preferences, tho only do it if
+ ;; Emacs's generic preferences can be set per-buffer (Emacs>=24.4).
+ (when (fboundp 'electric-indent-local-mode)
+ (setq c-electric-flag electric-indent-mode))
+
;; ;; Put submode indicators onto minor-mode-alist, but only once.
;; (or (assq 'c-submode-indicators minor-mode-alist)
;; (setq minor-mode-alist
@@ -587,10 +616,12 @@ that requires a literal mode spec at compile time."
(make-local-hook 'before-change-functions)
(make-local-hook 'after-change-functions))
(add-hook 'before-change-functions 'c-before-change nil t)
+ (setq c-just-done-before-change nil)
(add-hook 'after-change-functions 'c-after-change nil t)
- (set (make-local-variable 'font-lock-extend-after-change-region-function)
- 'c-extend-after-change-region)) ; Currently (2009-05) used by all
- ; languages with #define (C, C++,; ObjC), and by AWK.
+ (when (boundp 'font-lock-extend-after-change-region-function)
+ (set (make-local-variable 'font-lock-extend-after-change-region-function)
+ 'c-extend-after-change-region))) ; Currently (2009-05) used by all
+ ; languages with #define (C, C++,; ObjC), and by AWK.
(defun c-setup-doc-comment-style ()
"Initialize the variables that depend on the value of `c-doc-comment-style'."
@@ -636,13 +667,14 @@ compatible with old code; callers should always specify it."
(setq c-new-BEG (point-min))
(setq c-new-END (point-max))
(save-excursion
- (mapc (lambda (fn)
- (funcall fn (point-min) (point-max)))
- c-get-state-before-change-functions)
- (mapc (lambda (fn)
- (funcall fn (point-min) (point-max)
- (- (point-max) (point-min))))
- c-before-font-lock-functions)))
+ (let (before-change-functions after-change-functions)
+ (mapc (lambda (fn)
+ (funcall fn (point-min) (point-max)))
+ c-get-state-before-change-functions)
+ (mapc (lambda (fn)
+ (funcall fn (point-min) (point-max)
+ (- (point-max) (point-min))))
+ c-before-font-lock-functions))))
(set (make-local-variable 'outline-regexp) "[^#\n\^M]")
(set (make-local-variable 'outline-level) 'c-outline-level)
@@ -651,9 +683,11 @@ compatible with old code; callers should always specify it."
(or (c-cpp-define-name) (c-defun-name))))
(let ((rfn (assq mode c-require-final-newline)))
(when rfn
- (and (cdr rfn)
- (set (make-local-variable 'require-final-newline)
- mode-require-final-newline)))))
+ (if (boundp 'mode-require-final-newline)
+ (and (cdr rfn)
+ (set (make-local-variable 'require-final-newline)
+ mode-require-final-newline))
+ (set (make-local-variable 'require-final-newline) (cdr rfn))))))
(defun c-count-cfss (lv-alist)
;; LV-ALIST is an alist like `file-local-variables-alist'. Count how many
@@ -803,7 +837,7 @@ Note that the style variables are always made local to the buffer."
`(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks))))
-;;; Change hooks, linking with Font Lock.
+;;; Change hooks, linking with Font Lock and electric-indent-mode.
;; Buffer local variables recording Beginning/End-of-Macro position before a
;; change, when a macro straddles, respectively, the BEG or END (or both) of
@@ -813,6 +847,18 @@ Note that the style variables are always made local to the buffer."
(defvar c-old-EOM 0)
(make-variable-buffer-local 'c-old-EOM)
+(defun c-called-from-text-property-change-p ()
+ ;; Is the primitive which invoked `before-change-functions' or
+ ;; `after-change-functions' one which merely changes text properties? This
+ ;; function must be called directly from a member of one of the above hooks.
+ ;;
+ ;; In the following call, frame 0 is `backtrace-frame', frame 1 is
+ ;; `c-called-from-text-property-change-p', frame 2 is
+ ;; `c-before/after-change', frame 3 is the primitive invoking the change
+ ;; hook.
+ (memq (cadr (backtrace-frame 3))
+ '(put-text-property remove-list-of-text-properties)))
+
(defun c-extend-region-for-CPP (beg end)
;; Set c-old-BOM or c-old-EOM respectively to BEG, END, each extended to the
;; beginning/end of any preprocessor construct they may be in.
@@ -930,7 +976,11 @@ Note that the style variables are always made local to the buffer."
c-new-END (min (cdr new-bounds) (c-determine-+ve-limit 500 endd)))
;; Clear all old relevant properties.
(c-clear-char-property-with-value c-new-BEG c-new-END 'syntax-table '(1))
- (c-clear-char-property-with-value c-new-BEG c-new-END 'category 'c-cpp-delimiter)
+
+ ;; CPP "comment" markers:
+ (if (eval-when-compile (memq 'category-properties c-emacs-features));Emacs.
+ (c-clear-char-property-with-value
+ c-new-BEG c-new-END 'category 'c-cpp-delimiter))
;; FIXME!!! What about the "<" and ">" category properties? 2009-11-16
;; Add needed properties to each CPP construct in the region.
@@ -939,18 +989,27 @@ Note that the style variables are always made local to the buffer."
(let ((pps-position (point)) pps-state mbeg)
(while (and (< (point) c-new-END)
(search-forward-regexp c-anchored-cpp-prefix c-new-END t))
- ;; If we've found a "#" inside a string/comment, ignore it.
- (setq pps-state
- (parse-partial-sexp pps-position (point) nil nil pps-state)
- pps-position (point))
- (unless (or (nth 3 pps-state) ; in a string?
- (nth 4 pps-state)) ; in a comment?
+ ;; If we've found a "#" inside a macro/string/comment, ignore it.
+ (unless
+ (or (save-excursion
+ (goto-char (match-beginning 0))
+ (let ((here (point)))
+ (and (save-match-data (c-beginning-of-macro))
+ (< (point) here))))
+ (progn
+ (setq pps-state
+ (parse-partial-sexp pps-position (point) nil nil pps-state)
+ pps-position (point))
+ (or (nth 3 pps-state) ; in a string?
+ (nth 4 pps-state)))) ; in a comment?
(goto-char (match-beginning 1))
(setq mbeg (point))
(if (> (c-syntactic-end-of-macro) mbeg)
(progn
- (c-neutralize-CPP-line mbeg (point))
- (c-set-cpp-delimiters mbeg (point)))
+ (c-neutralize-CPP-line mbeg (point)) ; "punctuation" properties
+ (if (eval-when-compile
+ (memq 'category-properties c-emacs-features)) ;Emacs.
+ (c-set-cpp-delimiters mbeg (point)))) ; "comment" markers
(forward-line)) ; no infinite loop with, e.g., "#//"
)))))
@@ -970,74 +1029,83 @@ Note that the style variables are always made local to the buffer."
;; it/them from the cache. Don't worry about being inside a string
;; or a comment - "wrongly" removing a symbol from `c-found-types'
;; isn't critical.
- (setq c-maybe-stale-found-type nil)
- (save-restriction
- (save-match-data
- (widen)
- (save-excursion
- ;; Are we inserting/deleting stuff in the middle of an identifier?
- (c-unfind-enclosing-token beg)
- (c-unfind-enclosing-token end)
- ;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"?
- (when (< beg end)
- (c-unfind-coalesced-tokens beg end))
- ;; Are we (potentially) disrupting the syntactic context which
- ;; makes a type a type? E.g. by inserting stuff after "foo" in
- ;; "foo bar;", or before "foo" in "typedef foo *bar;"?
- ;;
- ;; We search for appropriate c-type properties "near" the change.
- ;; First, find an appropriate boundary for this property search.
- (let (lim
- type type-pos
- marked-id term-pos
- (end1
- (or (and (eq (get-text-property end 'face) 'font-lock-comment-face)
- (previous-single-property-change end 'face))
- end)))
- (when (>= end1 beg) ; Don't hassle about changes entirely in comments.
- ;; Find a limit for the search for a `c-type' property
- (while
- (and (/= (skip-chars-backward "^;{}") 0)
- (> (point) (point-min))
- (memq (c-get-char-property (1- (point)) 'face)
- '(font-lock-comment-face font-lock-string-face))))
- (setq lim (max (point-min) (1- (point))))
-
- ;; Look for the latest `c-type' property before end1
- (when (and (> end1 (point-min))
- (setq type-pos
- (if (get-text-property (1- end1) 'c-type)
- end1
- (previous-single-property-change end1 'c-type nil lim))))
- (setq type (get-text-property (max (1- type-pos) lim) 'c-type))
-
- (when (memq type '(c-decl-id-start c-decl-type-start))
- ;; Get the identifier, if any, that the property is on.
- (goto-char (1- type-pos))
- (setq marked-id
- (when (looking-at "\\(\\sw\\|\\s_\\)")
- (c-beginning-of-current-token)
- (buffer-substring-no-properties (point) type-pos)))
-
- (goto-char end1)
- (skip-chars-forward "^;{}") ; FIXME!!! loop for comment, maybe
- (setq lim (point))
- (setq term-pos
- (or (next-single-property-change end 'c-type nil lim) lim))
- (setq c-maybe-stale-found-type
- (list type marked-id
- type-pos term-pos
- (buffer-substring-no-properties type-pos term-pos)
- (buffer-substring-no-properties beg end)))))))
-
- (if c-get-state-before-change-functions
- (mapc (lambda (fn)
- (funcall fn beg end))
- c-get-state-before-change-functions))
- )))
- ;; The following must be done here rather than in `c-after-change' because
- ;; newly inserted parens would foul up the invalidation algorithm.
- (c-invalidate-state-cache beg))
+ (unless (or (c-called-from-text-property-change-p)
+ c-just-done-before-change) ; guard against a spurious second
+ ; invocation of before-change-functions.
+ (setq c-just-done-before-change t)
+ (setq c-maybe-stale-found-type nil)
+ (save-restriction
+ (save-match-data
+ (widen)
+ (save-excursion
+ ;; Are we inserting/deleting stuff in the middle of an identifier?
+ (c-unfind-enclosing-token beg)
+ (c-unfind-enclosing-token end)
+ ;; Are we coalescing two tokens together, e.g. "fo o" -> "foo"?
+ (when (< beg end)
+ (c-unfind-coalesced-tokens beg end))
+ ;; Are we (potentially) disrupting the syntactic context which
+ ;; makes a type a type? E.g. by inserting stuff after "foo" in
+ ;; "foo bar;", or before "foo" in "typedef foo *bar;"?
+ ;;
+ ;; We search for appropriate c-type properties "near" the change.
+ ;; First, find an appropriate boundary for this property search.
+ (let (lim
+ type type-pos
+ marked-id term-pos
+ (end1
+ (or (and (eq (get-text-property end 'face)
+ 'font-lock-comment-face)
+ (previous-single-property-change end 'face))
+ end)))
+ (when (>= end1 beg) ; Don't hassle about changes entirely in comments.
+ ;; Find a limit for the search for a `c-type' property
+ (while
+ (and (/= (skip-chars-backward "^;{}") 0)
+ (> (point) (point-min))
+ (memq (c-get-char-property (1- (point)) 'face)
+ '(font-lock-comment-face font-lock-string-face))))
+ (setq lim (max (point-min) (1- (point))))
+
+ ;; Look for the latest `c-type' property before end1
+ (when (and (> end1 (point-min))
+ (setq type-pos
+ (if (get-text-property (1- end1) 'c-type)
+ end1
+ (previous-single-property-change end1 'c-type
+ nil lim))))
+ (setq type (get-text-property (max (1- type-pos) lim) 'c-type))
+
+ (when (memq type '(c-decl-id-start c-decl-type-start))
+ ;; Get the identifier, if any, that the property is on.
+ (goto-char (1- type-pos))
+ (setq marked-id
+ (when (looking-at "\\(\\sw\\|\\s_\\)")
+ (c-beginning-of-current-token)
+ (buffer-substring-no-properties (point) type-pos)))
+
+ (goto-char end1)
+ (skip-chars-forward "^;{}") ;FIXME!!! loop for comment, maybe
+ (setq lim (point))
+ (setq term-pos
+ (or (c-next-single-property-change end 'c-type nil lim)
+ lim))
+ (setq c-maybe-stale-found-type
+ (list type marked-id
+ type-pos term-pos
+ (buffer-substring-no-properties type-pos
+ term-pos)
+ (buffer-substring-no-properties beg end)))))))
+
+ (if c-get-state-before-change-functions
+ (let (open-paren-in-column-0-is-defun-start)
+ (mapc (lambda (fn)
+ (funcall fn beg end))
+ c-get-state-before-change-functions)))
+ )))
+ ;; The following must be done here rather than in `c-after-change' because
+ ;; newly inserted parens would foul up the invalidation algorithm.
+ (c-invalidate-state-cache beg)))
(defvar c-in-after-change-fontification nil)
(make-variable-buffer-local 'c-in-after-change-fontification)
@@ -1058,55 +1126,59 @@ Note that the style variables are always made local to the buffer."
;; This calls the language variable c-before-font-lock-functions, if non nil.
;; This typically sets `syntax-table' properties.
- (c-save-buffer-state (case-fold-search)
- ;; When `combine-after-change-calls' is used we might get calls
- ;; with regions outside the current narrowing. This has been
- ;; observed in Emacs 20.7.
- (save-restriction
- (save-match-data ; c-recognize-<>-arglists changes match-data
- (widen)
+ ;; (c-new-BEG c-new-END) will be the region to fontify. It may become
+ ;; larger than (beg end).
+ (setq c-new-BEG beg c-new-END end)
- (when (> end (point-max))
- ;; Some emacsen might return positions past the end. This has been
- ;; observed in Emacs 20.7 when rereading a buffer changed on disk
- ;; (haven't been able to minimize it, but Emacs 21.3 appears to
- ;; work).
- (setq end (point-max))
- (when (> beg end)
- (setq beg end)))
-
- ;; C-y is capable of spuriously converting category properties
- ;; c-</>-as-paren-syntax and c-cpp-delimiter into hard syntax-table
- ;; properties. Remove these when it happens.
- (c-clear-char-property-with-value beg end 'syntax-table
- c-<-as-paren-syntax)
- (c-clear-char-property-with-value beg end 'syntax-table
- c->-as-paren-syntax)
- (c-clear-char-property-with-value beg end 'syntax-table nil)
-
- (c-trim-found-types beg end old-len) ; maybe we don't need all of these.
- (c-invalidate-sws-region-after beg end)
- ;; (c-invalidate-state-cache beg) ; moved to `c-before-change'.
- (c-invalidate-find-decl-cache beg)
-
- (when c-recognize-<>-arglists
- (c-after-change-check-<>-operators beg end))
-
- ;; (c-new-BEG c-new-END) will be the region to fontify. It may become
- ;; larger than (beg end).
- (setq c-new-BEG beg
- c-new-END end)
- (setq c-in-after-change-fontification t)
- (save-excursion
- (mapc (lambda (fn)
- (funcall fn beg end old-len))
- c-before-font-lock-functions))))))
+ (unless (c-called-from-text-property-change-p)
+ (setq c-just-done-before-change nil)
+ (c-save-buffer-state (case-fold-search open-paren-in-column-0-is-defun-start)
+ ;; When `combine-after-change-calls' is used we might get calls
+ ;; with regions outside the current narrowing. This has been
+ ;; observed in Emacs 20.7.
+ (save-restriction
+ (save-match-data ; c-recognize-<>-arglists changes match-data
+ (widen)
+
+ (when (> end (point-max))
+ ;; Some emacsen might return positions past the end. This has been
+ ;; observed in Emacs 20.7 when rereading a buffer changed on disk
+ ;; (haven't been able to minimize it, but Emacs 21.3 appears to
+ ;; work).
+ (setq end (point-max))
+ (when (> beg end)
+ (setq beg end)))
+
+ ;; C-y is capable of spuriously converting category properties
+ ;; c-</>-as-paren-syntax and c-cpp-delimiter into hard syntax-table
+ ;; properties. Remove these when it happens.
+ (when (eval-when-compile (memq 'category-properties c-emacs-features))
+ (c-save-buffer-state ()
+ (c-clear-char-property-with-value beg end 'syntax-table
+ c-<-as-paren-syntax)
+ (c-clear-char-property-with-value beg end 'syntax-table
+ c->-as-paren-syntax)
+ (c-clear-char-property-with-value beg end 'syntax-table nil)))
+
+ (c-trim-found-types beg end old-len) ; maybe we don't need all of these.
+ (c-invalidate-sws-region-after beg end)
+ ;; (c-invalidate-state-cache beg) ; moved to `c-before-change'.
+ (c-invalidate-find-decl-cache beg)
+
+ (when c-recognize-<>-arglists
+ (c-after-change-check-<>-operators beg end))
+
+ (setq c-in-after-change-fontification t)
+ (save-excursion
+ (mapc (lambda (fn)
+ (funcall fn beg end old-len))
+ c-before-font-lock-functions)))))))
-(defun c-set-fl-decl-start (pos)
+(defun c-fl-decl-start (pos)
;; If the beginning of the line containing POS is in the middle of a "local"
;; declaration (i.e. one which does not start outside of braces enclosing
;; POS, such as a struct), return the beginning of that declaration.
- ;; Otherwise return POS. Note that declarations, in this sense, can be
+ ;; Otherwise return nil. Note that declarations, in this sense, can be
;; nested.
;;
;; This function is called indirectly from font locking stuff - either from
@@ -1124,6 +1196,7 @@ Note that the style variables are always made local to the buffer."
;; Go to a less nested declaration each time round this loop.
(and
(eq (car (c-beginning-of-decl-1 bod-lim)) 'same)
+ (> (point) bod-lim)
(progn (setq bo-decl (point))
;; Are we looking at a keyword such as "template" or
;; "typedef" which can decorate a type, or the type itself?
@@ -1143,55 +1216,100 @@ Note that the style variables are always made local to the buffer."
(1- (point)) 'syntax-table)
c-<-as-paren-syntax)))))
(not (bobp)))
- (backward-char))
- new-pos)) ; back over (, [, <.
-
-(defun c-change-set-fl-decl-start (beg end old-len)
- ;; Set c-new-BEG to the beginning of a "local" declaration if it('s BOL) is
- ;; inside one. This is called from an after-change-function, but the
- ;; parameters BEG END and OLD-LEN are ignored. See `c-set-fl-decl-start'
- ;; for the detailed functionality.
- (if font-lock-mode
- (setq c-new-BEG (c-set-fl-decl-start c-new-BEG))))
-
-(defun c-context-set-fl-decl-start (beg end)
- ;; Return a cons (NEW-BEG . END), where NEW-BEG is the beginning of a
- ;; "local" declaration (BOL at) NEW is inside or BEG. See
- ;; `c-set-fl-decl-start' for the detailed functionality.
- (cons (c-set-fl-decl-start beg) end))
+ (backward-char)) ; back over (, [, <.
+ (and (/= new-pos pos) new-pos)))
+
+(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
+ ;; region. This will usually be the smallest sequence of whole lines
+ ;; containing `c-new-BEG' and `c-new-END', but if `c-new-BEG' is in a
+ ;; "local" declaration (see `c-fl-decl-start') the beginning of this is used
+ ;; as the lower bound.
+ ;;
+ ;; This is called from an after-change-function, but the parameters BEG END
+ ;; and OLD-LEN are not used.
+ (if font-lock-mode
+ (setq c-new-BEG
+ (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
+ c-new-END (c-point 'bonl c-new-END))))
+
+(defun c-context-expand-fl-region (beg end)
+ ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
+ ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is
+ ;; in. NEW-END is beginning of the line after the one END is in.
+ (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
+ (c-point 'bonl end)))
+
+(defun c-before-context-fl-expand-region (beg end)
+ ;; Expand the region (BEG END) as specified by
+ ;; `c-before-context-fontification-functions'. Return a cons of the bounds
+ ;; of the new region.
+ (save-restriction
+ (widen)
+ (save-excursion
+ (let ((new-beg beg) (new-end end) new-region)
+ (mapc (lambda (fn)
+ (setq new-region (funcall fn new-beg new-end))
+ (setq new-beg (car new-region) new-end (cdr new-region)))
+ c-before-context-fontification-functions)
+ new-region))))
(defun c-font-lock-fontify-region (beg end &optional verbose)
;; Effectively advice around `font-lock-fontify-region' which extends the
;; region (BEG END), for example, to avoid context fontification chopping
- ;; off the start of the context. Do not do anything if it's already been
- ;; done (i.e. from an after-change fontification. An example (C++) where
- ;; this used to happen is this:
+ ;; off the start of the context. Do not extend the region if it's already
+ ;; been done (i.e. from an after-change fontification. An example (C++)
+ ;; where the chopping off used to happen is this:
;;
;; template <typename T>
;;
;;
;; void myfunc(T* p) {}
- ;;
+ ;;
;; Type a space in the first blank line, and the fontification of the next
;; line was fouled up by context fontification.
- (let ((new-beg beg) (new-end end) new-region case-fold-search)
- (if c-in-after-change-fontification
- (setq c-in-after-change-fontification nil)
- (save-restriction
- (widen)
- (save-excursion
- (mapc (lambda (fn)
- (setq new-region (funcall fn new-beg new-end))
- (setq new-beg (car new-region) new-end (cdr new-region)))
- c-before-context-fontification-functions))))
+ (let (new-beg new-end new-region case-fold-search
+ open-paren-in-column-0-is-defun-start)
+ (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)))
(funcall (default-value 'font-lock-fontify-region-function)
new-beg new-end verbose)))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
;; function will get executed before the font-lock one.
- (remove-hook 'after-change-functions 'c-after-change t)
- (add-hook 'after-change-functions 'c-after-change nil t))
+ (when (memq #'c-after-change after-change-functions)
+ (remove-hook 'after-change-functions #'c-after-change t)
+ (add-hook 'after-change-functions #'c-after-change nil t)))
(defun c-font-lock-init ()
"Set up the font-lock variables for using the font-lock support in CC Mode.
@@ -1212,6 +1330,14 @@ This function is called from `c-common-init', once per mode initialization."
(font-lock-mark-block-function
. c-mark-function)))
+ ;; Prevent `font-lock-default-fontify-region' extending the region it will
+ ;; fontify to whole lines by removing `font-lock-extend-region-whole-lines'
+ ;; (and, coincidentally, `font-lock-extend-region-multiline' (which we do
+ ;; not need)) from `font-lock-extend-region-functions'. (Emacs only). This
+ ;; fixes Emacs bug #19669.
+ (when (boundp 'font-lock-extend-region-functions)
+ (setq font-lock-extend-region-functions nil))
+
(make-local-variable 'font-lock-fontify-region-function)
(setq font-lock-fontify-region-function 'c-font-lock-fontify-region)
@@ -1219,9 +1345,10 @@ This function is called from `c-common-init', once per mode initialization."
(make-local-hook 'font-lock-mode-hook))
(add-hook 'font-lock-mode-hook 'c-after-font-lock-init nil t))
-(defun c-extend-after-change-region (beg end old-len)
+;; Emacs 22 and later.
+(defun c-extend-after-change-region (beg end _old-len)
"Extend the region to be fontified, if necessary."
- ;; Note: the parameters are ignored here. This somewhat indirect
+ ;; Note: the parameter OLD-LEN is ignored here. This somewhat indirect
;; implementation exists because it is minimally different from the
;; stand-alone CC Mode which, lacking
;; font-lock-extend-after-change-region-function, is forced to use advice
@@ -1230,32 +1357,69 @@ This function is called from `c-common-init', once per mode initialization."
;; Of the seven CC Mode languages, currently (2009-05) only C, C++, Objc
;; (the languages with #define) and AWK Mode make non-null use of this
;; function.
+ (when (eq font-lock-support-mode 'jit-lock-mode)
+ (save-restriction
+ (widen)
+ (c-save-buffer-state () ; Protect the undo-list from put-text-property.
+ (if (< c-new-BEG beg)
+ (put-text-property c-new-BEG beg 'fontified nil))
+ (if (> c-new-END end)
+ (put-text-property end c-new-END 'fontified nil)))))
(cons c-new-BEG c-new-END))
+;; Emacs < 22 and XEmacs
+(defmacro c-advise-fl-for-region (function)
+ `(defadvice ,function (before get-awk-region activate)
+ ;; Make sure that any string/regexp is completely font-locked.
+ (when c-buffer-is-cc-mode
+ (save-excursion
+ (ad-set-arg 1 c-new-END) ; end
+ (ad-set-arg 0 c-new-BEG))))) ; beg
+
+(unless (boundp 'font-lock-extend-after-change-region-function)
+ (c-advise-fl-for-region font-lock-after-change-function)
+ (c-advise-fl-for-region jit-lock-after-change)
+ (c-advise-fl-for-region lazy-lock-defer-rest-after-change)
+ (c-advise-fl-for-region lazy-lock-defer-line-after-change))
+
+;; Connect up to `electric-indent-mode' (Emacs 24.4 and later).
+(defun c-electric-indent-mode-hook ()
+ ;; Emacs has en/disabled `electric-indent-mode'. Propagate this through to
+ ;; each CC Mode buffer.
+ (mapc (lambda (buf)
+ (with-current-buffer buf
+ (when c-buffer-is-cc-mode
+ ;; Don't use `c-toggle-electric-state' here due to recursion.
+ (setq c-electric-flag electric-indent-mode)
+ (c-update-modeline))))
+ (buffer-list)))
+
+(defun c-electric-indent-local-mode-hook ()
+ ;; Emacs has en/disabled `electric-indent-local-mode' for this buffer.
+ ;; Propagate this through to this buffer's value of `c-electric-flag'
+ (when c-buffer-is-cc-mode
+ (setq c-electric-flag electric-indent-mode)
+ (c-update-modeline)))
+
;; Support for C
-;;;###autoload
-(defvar c-mode-syntax-table nil
+(defvar c-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table c))
"Syntax table used in c-mode buffers.")
-(or c-mode-syntax-table
- (setq c-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table c))))
-(defvar c-mode-abbrev-table nil
- "Abbreviation 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)))
+ ("while" "while" c-electric-continued-statement 0))
+ "Abbreviation table used in c-mode buffers.")
-(defvar c-mode-map ()
+(defvar c-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for C.
+ (define-key map "\C-c\C-e" 'c-macro-expand)
+ map)
"Keymap used in c-mode buffers.")
-(if c-mode-map
- nil
- (setq c-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for C
- (define-key c-mode-map "\C-c\C-e" 'c-macro-expand)
- )
+
(easy-menu-define c-c-menu c-mode-map "C Mode Commands"
(cons "C" (c-lang-const c-mode-menu c)))
@@ -1288,10 +1452,12 @@ This function is called from `c-common-init', once per mode initialization."
;;;###autoload (add-to-list 'auto-mode-alist '("\\.i\\'" . c-mode))
;;;###autoload (add-to-list 'auto-mode-alist '("\\.ii\\'" . c++-mode))
+(unless (fboundp 'prog-mode) (defalias 'prog-mode 'fundamental-mode))
;;;###autoload
(define-derived-mode c-mode prog-mode "C"
- "Major mode for editing K&R and ANSI C code.
+ "Major mode for editing C code.
+
To submit a problem report, enter `\\[c-submit-bug-report]' from a
c-mode buffer. This automatically sets up a mail buffer with version
information already added. You just need to add a description of the
@@ -1320,30 +1486,25 @@ Key bindings:
;; Support for C++
-;;;###autoload
-(defvar c++-mode-syntax-table nil
+(defvar c++-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table c++))
"Syntax table used in c++-mode buffers.")
-(or c++-mode-syntax-table
- (setq c++-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table c++))))
-(defvar c++-mode-abbrev-table nil
- "Abbreviation 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)))
+ ("catch" "catch" c-electric-continued-statement 0))
+ "Abbreviation table used in c++-mode buffers.")
-(defvar c++-mode-map ()
+(defvar c++-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for C++.
+ (define-key map "\C-c\C-e" 'c-macro-expand)
+ (define-key map "\C-c:" 'c-scope-operator)
+ (define-key map "<" 'c-electric-lt-gt)
+ (define-key map ">" 'c-electric-lt-gt)
+ map)
"Keymap used in c++-mode buffers.")
-(if c++-mode-map
- nil
- (setq c++-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for C++
- (define-key c++-mode-map "\C-c\C-e" 'c-macro-expand)
- (define-key c++-mode-map "\C-c:" 'c-scope-operator)
- (define-key c++-mode-map "<" 'c-electric-lt-gt)
- (define-key c++-mode-map ">" 'c-electric-lt-gt))
(easy-menu-define c-c++-menu c++-mode-map "C++ Mode Commands"
(cons "C++" (c-lang-const c-mode-menu c++)))
@@ -1380,26 +1541,21 @@ Key bindings:
;; Support for Objective-C
-;;;###autoload
-(defvar objc-mode-syntax-table nil
+(defvar objc-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table objc))
"Syntax table used in objc-mode buffers.")
-(or objc-mode-syntax-table
- (setq objc-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table objc))))
-(defvar objc-mode-abbrev-table nil
- "Abbreviation 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)))
+ ("while" "while" c-electric-continued-statement 0))
+ "Abbreviation table used in objc-mode buffers.")
-(defvar objc-mode-map ()
+(defvar objc-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for Objective-C.
+ (define-key map "\C-c\C-e" 'c-macro-expand)
+ map)
"Keymap used in objc-mode buffers.")
-(if objc-mode-map
- nil
- (setq objc-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for Objective-C
- (define-key objc-mode-map "\C-c\C-e" 'c-macro-expand))
(easy-menu-define c-objc-menu objc-mode-map "ObjC Mode Commands"
(cons "ObjC" (c-lang-const c-mode-menu objc)))
@@ -1438,28 +1594,22 @@ Key bindings:
;; Support for Java
-;;;###autoload
-(defvar java-mode-syntax-table nil
+(defvar java-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table java))
"Syntax table used in java-mode buffers.")
-(or java-mode-syntax-table
- (setq java-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table java))))
-(defvar java-mode-abbrev-table nil
- "Abbreviation 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)))
+ ("finally" "finally" c-electric-continued-statement 0))
+ "Abbreviation table used in java-mode buffers.")
-(defvar java-mode-map ()
+(defvar java-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for Java.
+ map)
"Keymap used in java-mode buffers.")
-(if java-mode-map
- nil
- (setq java-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for Java
- )
;; Regexp trying to describe the beginning of a Java top-level
;; definition. This is not used by CC Mode, nor is it maintained
@@ -1504,24 +1654,18 @@ Key bindings:
;; Support for CORBA's IDL language
-;;;###autoload
-(defvar idl-mode-syntax-table nil
+(defvar idl-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table idl))
"Syntax table used in idl-mode buffers.")
-(or idl-mode-syntax-table
- (setq idl-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table idl))))
-(defvar idl-mode-abbrev-table nil
+(c-define-abbrev-table 'idl-mode-abbrev-table nil
"Abbreviation table used in idl-mode buffers.")
-(c-define-abbrev-table 'idl-mode-abbrev-table nil)
-(defvar idl-mode-map ()
+(defvar idl-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for IDL.
+ map)
"Keymap used in idl-mode buffers.")
-(if idl-mode-map
- nil
- (setq idl-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for IDL
- )
(easy-menu-define c-idl-menu idl-mode-map "IDL Mode Commands"
(cons "IDL" (c-lang-const c-mode-menu idl)))
@@ -1558,26 +1702,21 @@ Key bindings:
;; Support for Pike
-;;;###autoload
-(defvar pike-mode-syntax-table nil
+(defvar pike-mode-syntax-table
+ (funcall (c-lang-const c-make-mode-syntax-table pike))
"Syntax table used in pike-mode buffers.")
-(or pike-mode-syntax-table
- (setq pike-mode-syntax-table
- (funcall (c-lang-const c-make-mode-syntax-table pike))))
-(defvar pike-mode-abbrev-table nil
- "Abbreviation 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)))
+ ("while" "while" c-electric-continued-statement 0))
+ "Abbreviation table used in pike-mode buffers.")
-(defvar pike-mode-map ()
+(defvar pike-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Additional bindings.
+ (define-key map "\C-c\C-e" 'c-macro-expand)
+ map)
"Keymap used in pike-mode buffers.")
-(if pike-mode-map
- nil
- (setq pike-mode-map (c-make-inherited-keymap))
- ;; additional bindings
- (define-key pike-mode-map "\C-c\C-e" 'c-macro-expand))
(easy-menu-define c-pike-menu pike-mode-map "Pike Mode Commands"
(cons "Pike" (c-lang-const c-mode-menu pike)))
@@ -1622,32 +1761,26 @@ Key bindings:
;;;###autoload (add-to-list 'interpreter-mode-alist '("nawk" . awk-mode))
;;;###autoload (add-to-list 'interpreter-mode-alist '("gawk" . awk-mode))
-;;; Autoload directives must be on the top level, so we construct an
-;;; autoload form instead.
-;;;###autoload (autoload 'awk-mode "cc-mode" "Major mode for editing AWK code." t)
-
-(defvar awk-mode-abbrev-table nil
- "Abbreviation table used in awk-mode buffers.")
(c-define-abbrev-table 'awk-mode-abbrev-table
'(("else" "else" c-electric-continued-statement 0)
- ("while" "while" c-electric-continued-statement 0)))
+ ("while" "while" c-electric-continued-statement 0))
+ "Abbreviation table used in awk-mode buffers.")
-(defvar awk-mode-map ()
+(defvar awk-mode-map
+ (let ((map (c-make-inherited-keymap)))
+ ;; Add bindings which are only useful for awk.
+ (define-key map "#" 'self-insert-command)
+ (define-key map "/" 'self-insert-command)
+ (define-key map "*" 'self-insert-command)
+ (define-key map "\C-c\C-n" 'undefined) ; #if doesn't exist in awk.
+ (define-key map "\C-c\C-p" 'undefined)
+ (define-key map "\C-c\C-u" 'undefined)
+ (define-key map "\M-a" 'c-beginning-of-statement) ; 2003/10/7
+ (define-key map "\M-e" 'c-end-of-statement) ; 2003/10/7
+ (define-key map "\C-\M-a" 'c-awk-beginning-of-defun)
+ (define-key map "\C-\M-e" 'c-awk-end-of-defun)
+ map)
"Keymap used in awk-mode buffers.")
-(if awk-mode-map
- nil
- (setq awk-mode-map (c-make-inherited-keymap))
- ;; add bindings which are only useful for awk.
- (define-key awk-mode-map "#" 'self-insert-command)
- (define-key awk-mode-map "/" 'self-insert-command)
- (define-key awk-mode-map "*" 'self-insert-command)
- (define-key awk-mode-map "\C-c\C-n" 'undefined) ; #if doesn't exist in awk.
- (define-key awk-mode-map "\C-c\C-p" 'undefined)
- (define-key awk-mode-map "\C-c\C-u" 'undefined)
- (define-key awk-mode-map "\M-a" 'c-beginning-of-statement) ; 2003/10/7
- (define-key awk-mode-map "\M-e" 'c-end-of-statement) ; 2003/10/7
- (define-key awk-mode-map "\C-\M-a" 'c-awk-beginning-of-defun)
- (define-key awk-mode-map "\C-\M-e" 'c-awk-end-of-defun))
(easy-menu-define c-awk-menu awk-mode-map "AWK Mode Commands"
(cons "AWK" (c-lang-const c-mode-menu awk)))
@@ -1692,7 +1825,7 @@ Key bindings:
;; bug reporting
(defconst c-mode-help-address
- "bug-cc-mode@gnu.org"
+ "submit@debbugs.gnu.org"
"Address(es) for CC Mode bug reports.")
(defun c-version ()
@@ -1709,6 +1842,13 @@ Key bindings:
(defvar reporter-prompt-for-summary-p)
(defvar reporter-dont-compact-list)
+;; This could be "emacs,cc-mode" in the version included in Emacs.
+(defconst c-mode-bug-package "cc-mode"
+ "The package to use in the bug submission.")
+
+;; reporter-submit-bug-report requires sendmail.
+(declare-function mail-position-on-field "sendmail" (field &optional soft))
+
(defun c-submit-bug-report ()
"Submit via mail a bug report on CC Mode."
(interactive)
@@ -1765,16 +1905,24 @@ Key bindings:
filladapt-mode
defun-prompt-regexp
font-lock-mode
+ auto-fill-mode
font-lock-maximum-decoration
parse-sexp-lookup-properties
lookup-syntax-properties))
vars)
(lambda ()
(run-hooks 'c-prepare-bug-report-hook)
+ (save-excursion
+ (or (mail-position-on-field "X-Debbugs-Package")
+ (insert c-mode-bug-package)))
(insert (format "Buffer Style: %s\nc-emacs-features: %s\n"
style c-features)))))))
(cc-provide 'cc-mode)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-mode.el ends here
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index ff76e21a387..527d4c4bd72 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -1,6 +1,6 @@
;;; cc-styles.el --- support for styles in CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2004- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -165,8 +165,8 @@
(c-offsets-alist . ((topmost-intro . 0)
(substatement . +)
(substatement-open . 0)
- (case-label . +)
- (access-label . -)
+ (case-label . +)
+ (access-label . -)
(inclass . +)
(inline-open . 0))))
("linux"
@@ -209,15 +209,15 @@
(c-offsets-alist . ((inline-open . 0)
(topmost-intro-cont . +)
(statement-block-intro . +)
- (knr-argdecl-intro . 5)
+ (knr-argdecl-intro . 5)
(substatement-open . +)
(substatement-label . +)
- (label . +)
- (statement-case-open . +)
- (statement-cont . +)
- (arglist-intro . c-lineup-arglist-intro-after-paren)
- (arglist-close . c-lineup-arglist)
- (access-label . 0)
+ (label . +)
+ (statement-case-open . +)
+ (statement-cont . +)
+ (arglist-intro . c-lineup-arglist-intro-after-paren)
+ (arglist-close . c-lineup-arglist)
+ (access-label . 0)
(inher-cont . c-lineup-java-inher)
(func-decl-cont . c-lineup-java-throws))))
@@ -663,4 +663,8 @@ DEFAULT-STYLE has the same format as `c-default-style'."
(cc-provide 'cc-styles)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-styles.el ends here
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index c89402c63a3..9afece9e30b 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1,6 +1,6 @@
;;; cc-vars.el --- user customization variables for CC Mode
-;; Copyright (C) 1985, 1987, 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1987, 1992-2015 Free Software Foundation, Inc.
;; Authors: 2002- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -271,17 +271,23 @@ nil."
:group 'c)
;;;###autoload(put 'c-basic-offset 'safe-local-variable 'integerp)
+
(defcustom c-tab-always-indent t
"*Controls the operation of the TAB key.
If t, hitting TAB always just indents the current line. If nil, hitting
TAB indents the current line if point is at the left margin or in the
-line's indentation, otherwise it calls `c-insert-tab-function' to
-insert a `real' tab character. If some other value (neither nil nor t),
-then inserts a tab only within literals (comments and strings), but
-always reindents the line.
-
-Note: the variable `c-comment-only-line-offset' also controls the
-indentation of lines containing only comments."
+line's indentation, otherwise it inserts a `real' tab character \(see
+note). If some other value \(not nil or t), then tab is inserted only
+within literals \(comments and strings), but the line is always
+reindented.
+
+Note: The value of `indent-tabs-mode' will determine whether a real
+tab character will be inserted, or the equivalent number of spaces.
+When inserting a tab, actually the function stored in the variable
+`c-insert-tab-function' is called.
+
+Note: indentation of lines containing only comments is also controlled
+by the `c-comment-only-line-offset' variable."
:type '(radio
(const :tag "TAB key always indents, never inserts TAB" t)
(const :tag "TAB key indents in left margin, otherwise inserts TAB" nil)
@@ -535,7 +541,7 @@ variable in a mode hook."
(const :format "IDL " idl-mode) (regexp :format "%v"))
(cons :format "%v"
(const :format "Pike " pike-mode) (regexp :format "%v"))
- (cons :format "%v"
+ (cons :format "%v"
(const :format "AWK " awk-mode) (regexp :format "%v")))
(cons :format " %v"
(const :format "Other " other) (regexp :format "%v"))))
@@ -827,7 +833,7 @@ string in the mode line), and a semicolon or comma is typed (see
no arguments, and should return one of the following values:
nil -- no determination made, continue checking
- 'stop -- do not insert a newline, and stop checking
+ `stop' -- do not insert a newline, and stop checking
(anything else) -- insert a newline, and stop checking
If every function in the list is called with no determination made,
@@ -920,7 +926,7 @@ Only currently supported behavior is `alignleft'."
(defcustom c-special-indent-hook nil
"*Hook for user defined special indentation adjustments.
This hook gets called after each line is indented by the mode. It is only
-called if `c-syntactic-indentation' is non-nil."
+called when `c-syntactic-indentation' is non-nil."
:type 'hook
:group 'c)
@@ -1170,7 +1176,7 @@ can always override the use of `c-default-style' by making calls to
(objc-method-args-cont . c-lineup-ObjC-method-args)
;; Anchor pos: At the method start (always at boi).
(objc-method-call-cont . (c-lineup-ObjC-method-call-colons
- c-lineup-ObjC-method-call +))
+ c-lineup-ObjC-method-call +))
;; Anchor pos: At the open bracket.
(extern-lang-open . 0)
(namespace-open . 0)
@@ -1689,7 +1695,8 @@ as designated in the variable `c-file-style'.")
;; It isn't possible to specify a doc-string without specifying an
;; initial value with `defvar', so the following two variables have been
;; given doc-strings by setting the property `variable-documentation'
-;; directly. It's really good not to have an initial value for
+;; directly. C-h v will read this documentation only for versions of GNU
+;; Emacs from 22.1. It's really good not to have an initial value for
;; variables like these that always should be dynamically bound, so it's
;; worth the inconvenience.
@@ -1765,4 +1772,8 @@ It treats escaped EOLs as whitespace.")
(cc-provide 'cc-vars)
+;; Local Variables:
+;; indent-tabs-mode: t
+;; tab-width: 8
+;; End:
;;; cc-vars.el ends here
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 85a9074760d..78c8d94576b 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -1,11 +1,11 @@
;;; cfengine.el --- mode for editing Cfengine files
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: languages
-;; Version: 1.2
+;; Version: 1.4
;; This file is part of GNU Emacs.
@@ -24,12 +24,9 @@
;;; Commentary:
-;; Provides support for editing GNU Cfengine files, including
+;; Provides support for editing GNU CFEngine files, including
;; font-locking, Imenu and indentation, but with no special keybindings.
-;; The CFEngine 3.x support doesn't have Imenu support but patches are
-;; welcome.
-
;; By default, CFEngine 3.x syntax is used.
;; You can set it up so either `cfengine2-mode' (2.x and earlier) or
@@ -45,12 +42,27 @@
;; (add-to-list 'auto-mode-alist '("^cf\\." . cfengine2-mode))
;; (add-to-list 'auto-mode-alist '("^cfagent.conf\\'" . cfengine2-mode))
+;; It's *highly* recommended that you enable the eldoc minor mode:
+
+;; (add-hook 'cfengine3-mode-hook 'eldoc-mode)
+
+;; You may also find the command `cfengine3-reformat-json-string'
+;; useful, just bind it to a key you prefer. It will take the current
+;; string and reformat it as JSON. So if you're editing JSON inside
+;; the policy, it's a quick way to make it more legible without
+;; manually reindenting it. For instance:
+
+;; (global-set-key [(control f4)] 'cfengine3-reformat-json-string)
+
;; This is not the same as the mode written by Rolf Ebert
;; <ebert@waporo.muc.de>, distributed with cfengine-2.0.5. It does
;; better fontification and indentation, inter alia.
;;; Code:
+(autoload 'json-read "json")
+(autoload 'json-pretty-print "json")
+
(defgroup cfengine ()
"Editing CFEngine files."
:group 'languages)
@@ -60,8 +72,25 @@
:group 'cfengine
:type 'integer)
-(defcustom cfengine-parameters-indent '(promise pname 0)
- "*Indentation of CFEngine3 promise parameters (hanging indent).
+(defcustom cfengine-cf-promises
+ (or (executable-find "cf-promises")
+ (executable-find "/var/cfengine/bin/cf-promises")
+ (executable-find "/usr/bin/cf-promises")
+ (executable-find "/usr/sbin/cf-promises")
+ (executable-find "/usr/local/bin/cf-promises")
+ (executable-find "/usr/local/sbin/cf-promises")
+ (executable-find "~/bin/cf-promises")
+ (executable-find "~/sbin/cf-promises"))
+ "The location of the cf-promises executable.
+Used for syntax discovery and checking. Set to nil to disable
+the `compile-command' override. In that case, the ElDoc support
+will use a fallback syntax definition."
+ :version "24.4"
+ :group 'cfengine
+ :type '(choice file (const nil)))
+
+(defcustom cfengine-parameters-indent '(promise pname 2)
+ "Indentation of CFEngine3 promise parameters (hanging indent).
For example, say you have this code:
@@ -81,15 +110,15 @@ You can also choose to indent the start of the word
Finally, you can choose the amount of the indent.
-The default is to anchor at promise, indent parameter name, and offset 0:
+The default is to anchor at promise, indent parameter name, and offset 2:
bundle agent rcfiles
{
files:
any::
\"/tmp/netrc\"
- comment => \"my netrc\",
- perms => mog(\"600\", \"tzz\", \"tzz\");
+ comment => \"my netrc\",
+ perms => mog(\"600\", \"tzz\", \"tzz\");
}
Here we anchor at beginning of line, indent arrow, and offset 10:
@@ -115,7 +144,7 @@ bundle agent rcfiles
perms => mog(\"600\", \"tzz\", \"tzz\");
}
"
-
+ :version "24.4"
:group 'cfengine
:type '(list
(choice (const :tag "Anchor at beginning of promise" promise)
@@ -127,6 +156,647 @@ bundle agent rcfiles
(defvar cfengine-mode-debug nil
"Whether `cfengine-mode' should print debugging info.")
+(defvar cfengine-mode-syntax-cache nil
+ "Cache for `cfengine-mode' syntax trees obtained from `cf-promises -s json'.")
+
+(defconst cfengine3-fallback-syntax
+ '((functions
+ (userexists
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (usemodule
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (unique
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (translatepath
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (sum
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "real") (status . "normal"))
+ (sublist
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "head,tail") (type . "option"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (strftime
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "gmtime,localtime") (type . "option"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (strcmp
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (splitstring
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (splayclass
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "daily,hourly") (type . "option"))])
+ (returnType . "context") (status . "normal"))
+ (sort
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "lex") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (some
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (shuffle
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (selectservers
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (reverse
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (rrange
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "-9.99999E100,9.99999E100") (type . "real"))
+ ((range . "-9.99999E100,9.99999E100") (type . "real"))])
+ (returnType . "rrange") (status . "normal"))
+ (returnszero
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "useshell,noshell,powershell") (type . "option"))])
+ (returnType . "context") (status . "normal"))
+ (remoteclassesmatching
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "true,false,yes,no,on,off") (type . "option"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (remotescalar
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "true,false,yes,no,on,off") (type . "option"))])
+ (returnType . "string") (status . "normal"))
+ (regldap
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "subtree,onelevel,base") (type . "option"))
+ ((range . ".*") (type . "string"))
+ ((range . "none,ssl,sasl") (type . "option"))])
+ (returnType . "context") (status . "normal"))
+ (reglist
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (regline
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (registryvalue
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (regextract
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (regcmp
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (regarray
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (readtcp
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (readstringlist
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (readstringarrayidx
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (readstringarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (readreallist
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "rlist") (status . "normal"))
+ (readrealarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (readintlist
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "ilist") (status . "normal"))
+ (readintarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (readfile
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (randomint
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "-99999999999,9999999999") (type . "int"))
+ ((range . "-99999999999,9999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (product
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "real") (status . "normal"))
+ (peerleaders
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (peerleader
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (peers
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (parsestringarrayidx
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (parsestringarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (parserealarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (parseintarray
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (or
+ (category . "data") (variadic . t)
+ (parameters . [])
+ (returnType . "string") (status . "normal"))
+ (on
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "1970,3000") (type . "int"))
+ ((range . "1,12") (type . "int"))
+ ((range . "1,31") (type . "int"))
+ ((range . "0,23") (type . "int"))
+ ((range . "0,59") (type . "int"))
+ ((range . "0,59") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (nth
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (now
+ (category . "system") (variadic . :json-false)
+ (parameters . [])
+ (returnType . "int") (status . "normal"))
+ (not
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (none
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (maplist
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (maparray
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (lsdir
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . ".+") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "true,false,yes,no,on,off") (type . "option"))])
+ (returnType . "slist") (status . "normal"))
+ (length
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (ldapvalue
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "subtree,onelevel,base") (type . "option"))
+ ((range . "none,ssl,sasl") (type . "option"))])
+ (returnType . "string") (status . "normal"))
+ (ldaplist
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "subtree,onelevel,base") (type . "option"))
+ ((range . "none,ssl,sasl") (type . "option"))])
+ (returnType . "slist") (status . "normal"))
+ (ldaparray
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . "subtree,onelevel,base") (type . "option"))
+ ((range . "none,ssl,sasl") (type . "option"))])
+ (returnType . "context") (status . "normal"))
+ (laterthan
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,40000") (type . "int"))])
+ (returnType . "context") (status . "normal"))
+ (lastnode
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (join
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (isvariable
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (isplain
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (isnewerthan
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (islink
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (islessthan
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (isgreaterthan
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (isexecutable
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (isdir
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (irange
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "-99999999999,9999999999") (type . "int"))
+ ((range . "-99999999999,9999999999") (type . "int"))])
+ (returnType . "irange") (status . "normal"))
+ (iprange
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (intersection
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (ifelse
+ (category . "data") (variadic . t)
+ (parameters . [])
+ (returnType . "string") (status . "normal"))
+ (hubknowledge
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (hostswithclass
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_]+") (type . "string"))
+ ((range . "name,address") (type . "option"))])
+ (returnType . "slist") (status . "normal"))
+ (hostsseen
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . "0,99999999999") (type . "int"))
+ ((range . "lastseen,notseen") (type . "option"))
+ ((range . "name,address") (type . "option"))])
+ (returnType . "slist") (status . "normal"))
+ (hostrange
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (hostinnetgroup
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (ip2host
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (host2ip
+ (category . "communication") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (hashmatch
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "md5,sha1,crypt,cf_sha224,cf_sha256,cf_sha384,cf_sha512") (type . "option"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (hash
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "md5,sha1,sha256,sha512,sha384,crypt") (type . "option"))])
+ (returnType . "string") (status . "normal"))
+ (groupexists
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (grep
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (getvalues
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (getusers
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (getuid
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (getindices
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (getgid
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (getfields
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))
+ ((range . ".*") (type . "string"))
+ ((range . ".*") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (getenv
+ (category . "system") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "string") (status . "normal"))
+ (format
+ (category . "data") (variadic . t)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (filter
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "true,false,yes,no,on,off") (type . "option"))
+ ((range . "true,false,yes,no,on,off") (type . "option"))
+ ((range . "0,99999999999") (type . "int"))])
+ (returnType . "slist") (status . "normal"))
+ (filestat
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "size,gid,uid,ino,nlink,ctime,atime,mtime,mode,modeoct,permstr,permoct,type,devno,dev_minor,dev_major,basename,dirname") (type . "option"))])
+ (returnType . "string") (status . "normal"))
+ (filesize
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (filesexist
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "@[(][a-zA-Z0-9]+[)]") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (fileexists
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (execresult
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".+") (type . "string"))
+ ((range . "useshell,noshell,powershell") (type . "option"))])
+ (returnType . "string") (status . "normal"))
+ (every
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (escape
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (diskfree
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (dirname
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (difference
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+ ((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (countlinesmatching
+ (category . "io") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (countclassesmatching
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "int") (status . "normal"))
+ (classesmatching
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "slist") (status . "normal"))
+ (classmatch
+ (category . "utils") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (classify
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (changedbefore
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))
+ (concat
+ (category . "data") (variadic . t)
+ (parameters . [])
+ (returnType . "string") (status . "normal"))
+ (canonify
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . ".*") (type . "string"))])
+ (returnType . "string") (status . "normal"))
+ (and
+ (category . "data") (variadic . t)
+ (parameters . [])
+ (returnType . "string") (status . "normal"))
+ (ago
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,40000") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (accumulated
+ (category . "data") (variadic . :json-false)
+ (parameters . [((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,1000") (type . "int"))
+ ((range . "0,40000") (type . "int"))])
+ (returnType . "int") (status . "normal"))
+ (accessedbefore
+ (category . "files") (variadic . :json-false)
+ (parameters . [((range . "\"?(/.*)") (type . "string"))
+ ((range . "\"?(/.*)") (type . "string"))])
+ (returnType . "context") (status . "normal"))))
+ "Fallback CFEngine syntax, containing just function definitions.")
+
+(defvar cfengine-mode-syntax-functions-regex
+ (regexp-opt (mapcar (lambda (def)
+ (format "%s" (car def)))
+ (cdr (assq 'functions cfengine3-fallback-syntax)))
+ 'symbols))
+
(defcustom cfengine-mode-abbrevs nil
"Abbrevs for CFEngine2 mode."
:group 'cfengine
@@ -150,24 +820,26 @@ bundle agent rcfiles
"List of the action keywords supported by Cfengine.
This includes those for cfservd as well as cfagent.")
- (defconst cfengine3-defuns
- (mapcar
- 'symbol-name
- '(bundle body))
+ (defconst cfengine3-defuns '("bundle" "body")
"List of the CFEngine 3.x defun headings.")
- (defconst cfengine3-defuns-regex
- (regexp-opt cfengine3-defuns t)
+ (defconst cfengine3-defuns-regex (regexp-opt cfengine3-defuns t)
"Regex to match the CFEngine 3.x defuns.")
- (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!:]+\\)::")
+ (defconst cfengine3-defun-full-re (concat "^\\s-*" cfengine3-defuns-regex
+ "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;type
+ "\\s-+\\(\\(?:\\w\\|\\s_\\)+\\)" ;id
+ )
+ "Regexp matching full defun declaration (excluding argument list).")
+
+ (defconst cfengine3-macro-regex "\\(@[a-zA-Z].+\\)")
+
+ (defconst cfengine3-class-selector-regex "\\([\"']?[[:alnum:]_().$&|!:]+[\"']?\\)::")
(defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):")
- (defconst cfengine3-vartypes
- (mapcar
- 'symbol-name
- '(string int real slist ilist rlist irange rrange counter))
+ (defconst cfengine3-vartypes '("string" "int" "real" "slist" "ilist" "rlist"
+ "irange" "rrange" "counter" "data")
"List of the CFEngine 3.x variable types."))
(defvar cfengine2-font-lock-keywords
@@ -189,6 +861,14 @@ This includes those for cfservd as well as cfagent.")
(defvar cfengine3-font-lock-keywords
`(
+ ;; Macros
+ (,(concat "^" cfengine3-macro-regex)
+ 1 font-lock-error-face)
+
+ ;; invalid macros
+ (,(concat "^[ \t]*" cfengine3-macro-regex)
+ 1 font-lock-warning-face)
+
;; Defuns. This happens early so they don't get caught by looser
;; patterns.
(,(concat "\\_<" cfengine3-defuns-regex "\\_>"
@@ -325,12 +1005,12 @@ Intended as the value of `indent-line-function'."
(point))))
(let ((paragraph-start
;; Include start of parenthesized block.
- "\f\\|[ \t]*$\\|.*\(")
+ "\f\\|[ \t]*$\\|.*(")
(paragraph-separate
;; Include action and class lines, start and end of
;; bracketed blocks and end of parenthesized blocks to
;; avoid including these in fill. This isn't ideal.
- "[ \t\f]*$\\|.*#\\|.*[\){}]\\|\\s-*[[:alpha:]_().|!]+:")
+ "[ \t\f]*$\\|.*#\\|.*[){}]\\|\\s-*[[:alpha:]_().|!]+:")
fill-paragraph-function)
(fill-paragraph justify))
t))
@@ -355,7 +1035,7 @@ Treats body/bundle blocks as defuns."
t)
(defun cfengine3-indent-line ()
- "Indent a line in Cfengine 3 mode.
+ "Indent a line in CFEngine 3 mode.
Intended as the value of `indent-line-function'."
(let ((pos (- (point-max) (point)))
parse)
@@ -367,6 +1047,10 @@ Intended as the value of `indent-line-function'."
(message "%S" parse))
(cond
+ ;; Macros start at 0. But make sure we're not inside a string.
+ ((and (not (nth 3 parse))
+ (looking-at (concat cfengine3-macro-regex)))
+ (indent-line-to 0))
;; Body/bundle blocks start at 0.
((looking-at (concat cfengine3-defuns-regex "\\_>"))
(indent-line-to 0))
@@ -442,6 +1126,19 @@ Intended as the value of `indent-line-function'."
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))))
+(defun cfengine3-reformat-json-string ()
+ "Reformat the current string as JSON using `json-pretty-print'."
+ (interactive)
+ (let ((ppss (syntax-ppss)))
+ (when (nth 3 ppss) ;inside a string
+ (save-excursion
+ (goto-char (nth 8 ppss))
+ (forward-char 1)
+ (let ((start (point)))
+ (forward-sexp 1)
+ (json-pretty-print start
+ (point)))))))
+
;; CFEngine 3.x grammar
;; specification: blocks
@@ -501,6 +1198,121 @@ Intended as the value of `indent-line-function'."
;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+::
;; CATEGORY: [a-zA-Z_]+:
+(defun cfengine3--current-function ()
+ "Look up current CFEngine 3 function"
+ (let* ((syntax (cfengine3-make-syntax-cache))
+ (flist (assq 'functions syntax)))
+ (when flist
+ (let ((w (save-excursion
+ (skip-syntax-forward "w_")
+ (when (search-backward-regexp
+ cfengine-mode-syntax-functions-regex
+ (point-at-bol)
+ t)
+ (match-string 1)))))
+ (and w (assq (intern w) flist))))))
+
+;; format from "cf-promises -s json", e.g. "sort" function:
+;; ((category . "data")
+;; (variadic . :json-false)
+;; (parameters . [((range . "[a-zA-Z0-9_$(){}\\[\\].:]+") (type . "string"))
+;; ((range . "lex,int,real,IP,ip,MAC,mac") (type . "option"))])
+;; (returnType . "slist")
+;; (status . "normal"))
+
+(defun cfengine3-format-function-docstring (fdef)
+ (let* ((f (format "%s" (car-safe fdef)))
+ (def (cdr fdef))
+ (rtype (cdr (assq 'returnType def)))
+ (plist (cdr (assq 'parameters def)))
+ (has-some-parameters (> (length plist) 0))
+ (variadic (eq t (cdr (assq 'variadic def)))))
+
+ ;; (format "[%S]%s %s(%s%s)" def
+ (format "%s %s(%s%s)"
+ (if rtype
+ (propertize rtype 'face 'font-lock-variable-name-face)
+ "???")
+ (propertize f 'face 'font-lock-function-name-face)
+ (mapconcat (lambda (p)
+ (let* ((type (cdr (assq 'type p)))
+ (description (cdr (assq 'description p)))
+ (desc-string (if (stringp description)
+ (concat " /" description "/")
+ ""))
+ (range (cdr (assq 'range p))))
+ (cond
+ ((not (stringp type)) "???type???")
+ ((not (stringp range)) "???range???")
+ ;; options are lists of possible keywords
+ ((equal type "option")
+ (propertize (concat "[" range "]" desc-string)
+ 'face
+ 'font-lock-keyword-face))
+ ;; anything else is a type name as a variable
+ (t (propertize (concat type desc-string)
+ 'face
+ 'font-lock-variable-name-face)))))
+ plist
+ ", ")
+ (if variadic
+ (if has-some-parameters ", ..." "...")
+ ""))))
+
+(defun cfengine3-clear-syntax-cache ()
+ "Clear the internal syntax cache.
+Should not be necessary unless you reinstall CFEngine."
+ (interactive)
+ (setq cfengine-mode-syntax-functions-regex nil)
+ (setq cfengine-mode-syntax-cache nil))
+
+(defun cfengine3-make-syntax-cache ()
+ "Build the CFEngine 3 syntax cache and return the syntax.
+Calls `cfengine-cf-promises' with \"-s json\"."
+ (or (cdr (assoc cfengine-cf-promises cfengine-mode-syntax-cache))
+ (let ((syntax (or (when cfengine-cf-promises
+ (with-demoted-errors "cfengine3-make-syntax-cache: %S"
+ (with-temp-buffer
+ (or (zerop (process-file cfengine-cf-promises
+ nil ; no input
+ t ; output
+ nil ; no redisplay
+ "-s" "json"))
+ (error "%s" (buffer-substring
+ (point-min)
+ (progn (goto-char (point-min))
+ (line-end-position)))))
+ (goto-char (point-min))
+ (json-read))))
+ cfengine3-fallback-syntax)))
+ (push (cons cfengine-cf-promises syntax)
+ cfengine-mode-syntax-cache)
+ (setq cfengine-mode-syntax-functions-regex
+ (regexp-opt (mapcar (lambda (def)
+ (format "%s" (car def)))
+ (cdr (assq 'functions syntax)))
+ 'symbols))
+ syntax)))
+
+(defun cfengine3-documentation-function ()
+ "Document CFengine 3 functions around point.
+Intended as the value of `eldoc-documentation-function', which see.
+Use it by enabling `eldoc-mode'."
+ (let ((fdef (cfengine3--current-function)))
+ (when fdef
+ (cfengine3-format-function-docstring fdef))))
+
+(defun cfengine3-completion-function ()
+ "Return completions for function name around or before point."
+ (let* ((bounds (save-excursion
+ (let ((p (point)))
+ (skip-syntax-backward "w_" (point-at-bol))
+ (list (point) p))))
+ (syntax (cfengine3-make-syntax-cache))
+ (flist (assq 'functions syntax)))
+ (when bounds
+ (append bounds (list (cdr flist))))))
+
(defun cfengine-common-settings ()
(set (make-local-variable 'syntax-propertize-function)
;; In the main syntax-table, \ is marked as a punctuation, because
@@ -532,6 +1344,26 @@ Intended as the value of `indent-line-function'."
("=>" . ?⇒)
("::" . ?∷)))
+(defun cfengine3-create-imenu-index ()
+ "A function for `imenu-create-index-function'.
+Note: defun name is separated by space such as `body
+package_method opencsw' and imenu will replace spaces according
+to `imenu-space-replacement' (which see)."
+ (goto-char (point-min))
+ (let ((defuns ()))
+ (while (re-search-forward cfengine3-defun-full-re nil t)
+ (push (cons (mapconcat #'match-string '(1 2 3) " ")
+ (copy-marker (match-beginning 3)))
+ defuns))
+ (nreverse defuns)))
+
+(defun cfengine3-current-defun ()
+ "A function for `add-log-current-defun-function'."
+ (end-of-line)
+ (beginning-of-defun)
+ (and (looking-at cfengine3-defun-full-re)
+ (mapconcat #'match-string '(1 2 3) " ")))
+
;;;###autoload
(define-derived-mode cfengine3-mode prog-mode "CFE3"
"Major mode for editing CFEngine3 input.
@@ -549,11 +1381,31 @@ to the action header."
nil nil nil beginning-of-defun))
(setq-local prettify-symbols-alist cfengine3--prettify-symbols-alist)
+ ;; `compile-command' is almost never a `make' call with CFEngine so
+ ;; we override it
+ (when cfengine-cf-promises
+ (set (make-local-variable 'compile-command)
+ (concat cfengine-cf-promises
+ " -f "
+ (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 'completion-at-point-functions
+ #'cfengine3-completion-function nil t)
+
;; Use defuns as the essential syntax block.
- (set (make-local-variable 'beginning-of-defun-function)
- #'cfengine3-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- #'cfengine3-end-of-defun))
+ (setq-local beginning-of-defun-function #'cfengine3-beginning-of-defun)
+ (setq-local end-of-defun-function #'cfengine3-end-of-defun)
+
+ (setq-local imenu-create-index-function #'cfengine3-create-imenu-index)
+ (setq-local add-log-current-defun-function #'cfengine3-current-defun))
;;;###autoload
(define-derived-mode cfengine2-mode prog-mode "CFE2"
@@ -587,15 +1439,18 @@ to the action header."
;;;###autoload
(defun cfengine-auto-mode ()
- "Choose between `cfengine2-mode' and `cfengine3-mode' depending
-on the buffer contents"
- (let ((v3 nil))
- (save-restriction
- (goto-char (point-min))
- (while (not (or (eobp) v3))
- (setq v3 (looking-at (concat cfengine3-defuns-regex "\\_>")))
- (forward-line)))
- (if v3 (cfengine3-mode) (cfengine2-mode))))
+ "Choose `cfengine2-mode' or `cfengine3-mode' by buffer contents."
+ (interactive)
+ (if (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-comment (point-max))
+ (or (eobp)
+ (re-search-forward
+ (concat "^\\s-*" cfengine3-defuns-regex "\\_>") nil t))))
+ (cfengine3-mode)
+ (cfengine2-mode)))
(defalias 'cfengine-mode 'cfengine3-mode)
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 858d3298a65..9953cae2bef 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -1,9 +1,9 @@
;;; cmacexp.el --- expand C macros in a region
-;; Copyright (C) 1992, 1994, 1996, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2000-2015 Free Software Foundation,
;; Inc.
-;; Author: Francesco Potorti` <pot@gnu.org>
+;; Author: Francesco Potortì <pot@gnu.org>
;; Adapted-By: ESR
;; Keywords: c
@@ -70,7 +70,7 @@
;; BUG REPORTS =======================================================
;; Please report bugs, suggestions, complaints and so on to
-;; pot@gnu.org (Francesco Potorti`).
+;; bug-gnu-emacs@gnu.org and pot@gnu.org (Francesco Potortì).
;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ==========================
@@ -364,8 +364,8 @@ Optional arg DISPLAY non-nil means show messages in the echo area."
;; Find and delete the mark of the start of the expansion.
;; Look for `# nn "file.c"' lines and delete them.
(goto-char (point-min))
- (search-forward startmarker)
- (delete-region 1 (point)))
+ (if (search-forward startmarker nil t)
+ (delete-region 1 (point))))
(while (re-search-forward (concat "^# [0-9]+ \""
(regexp-quote filename)
"\"") nil t)
@@ -389,8 +389,9 @@ Optional arg DISPLAY non-nil means show messages in the echo area."
;; Put the messages inside a comment, so they won't get in
;; the way of font-lock, highlighting etc.
(insert
- (format "/* Preprocessor terminated with status %s\n\n Messages from `%s\':\n\n"
- exit-status cppcommand))
+ (format
+ "/* Preprocessor terminated with status %s\n\n Messages from '%s':\n\n"
+ exit-status cppcommand))
(goto-char (+ (point)
(nth 1 (insert-file-contents tempname))))
(insert "\n\n*/\n")))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 8c981b36e56..9e2d625a4d4 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1,11 +1,11 @@
-;;; compile.el --- run compiler as inferior of Emacs, parse error messages
+;;; compile.el --- run compiler as inferior of Emacs, parse error messages -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Authors: Roland McGrath <roland@gnu.org>,
;; Daniel Pfeiffer <occitan@esperanto.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tools, processes
;; This file is part of GNU Emacs.
@@ -134,7 +134,7 @@ and a string describing how the process finished.")
;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit
(defvar compilation-error-regexp-alist-alist
- '((absoft
+ `((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -145,7 +145,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
" in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
(ant
- "^[ \t]*\\[[^] \n]+\\][ \t]*\\([^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\
+ "^[ \t]*\\[[^] \n]+\\][ \t]*\\(\\(?:[A-Za-z]:\\\\\\)?[^: \n]+\\):\\([0-9]+\\):\\(?:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\)?\
\\( warning\\)?" 1 (2 . 4) (3 . 5) (6))
(bash
@@ -167,7 +167,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
(cucumber
"\\(?:^cucumber\\(?: -p [^[:space:]]+\\)?\\|#\\)\
-\\(?: \\)\\([^\(].*\\):\\([1-9][0-9]*\\)" 1 2)
+\\(?: \\)\\([^(].*\\):\\([1-9][0-9]*\\)" 1 2)
(msft
;; Must be before edg-1, so that MSVC's longer messages are
@@ -216,7 +216,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; due to matching filenames via \\(.*?\\). This might be faster.
(maven
;; Maven is a popular free software build tool for Java.
- "\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 1 2 3)
+ "\\(\\[WARNING\\] *\\)?\\([^ \n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\):\\[\\([0-9]+\\),\\([0-9]+\\)\\] " 2 3 4 (1))
(jikes-line
"^ *\\([0-9]+\\)\\.[ \t]+.*\n +\\(<-*>\n\\*\\*\\* \\(?:Error\\|Warnin\\(g\\)\\)\\)"
@@ -230,7 +230,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
1 2 3 (4 . 5))
(ruby-Test::Unit
- "^[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
+ "^[\t ]*\\[\\([^(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2)
(gnu
;; The first line matches the program name for
@@ -255,16 +255,46 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; 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.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
-\\([0-9]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\
-\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\
-\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
- *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|\\[ skipping .+ \\]\\|\
-\\(?:instantiated\\|required\\) from\\|[Nn]ote\\)\\|\
- *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
+ ,(rx
+ bol
+ (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?")
+ (regexp "[ \t]+\\(?:in \\|from\\)")))
+ (group-n 1 (: (regexp "[0-9]*[^0-9\n]")
+ (*? (| (regexp "[^\n :]")
+ (regexp " [^-/\n]")
+ (regexp ":[^ \n]")))))
+ (regexp ": ?")
+ (group-n 2 (regexp "[0-9]+"))
+ (? (| (: "-"
+ (group-n 4 (regexp "[0-9]+"))
+ (? "." (group-n 5 (regexp "[0-9]+"))))
+ (: (in ".:")
+ (group-n 3 (regexp "[0-9]+"))
+ (? "-"
+ (? (group-n 4 (regexp "[0-9]+")) ".")
+ (group-n 5 (regexp "[0-9]+"))))))
+ ":"
+ (| (: (* " ")
+ (group-n 6 (| "FutureWarning"
+ "RuntimeWarning"
+ "Warning"
+ "warning"
+ "W:")))
+ (: (* " ")
+ (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)")
+ "I:"
+ (: "[ skipping " (+ ".") " ]")
+ "instantiated from"
+ "required from"
+ (regexp "[Nn]ote"))))
+ (: (* " ")
+ (regexp "[Ee]rror"))
+ (: (regexp "[0-9]?")
+ (| (regexp "[^0-9\n]")
+ eol))
+ (regexp "[0-9][0-9][0-9]")))
1 (2 . 4) (3 . 5) (6 . 7))
(lcc
@@ -347,7 +377,7 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
3 4 5 (1 . 2))
(sun-ada
- "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
+ "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., (-]" 1 2 3)
(watcom
"^[ \t]*\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)): ?\
@@ -447,6 +477,30 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
;;
"^\\([^ \t\r\n(]+\\) (\\([0-9]+\\):\\([0-9]+\\)) "
1 2 3)
+
+ ;; Guile compilation yields file-headers in the following format:
+ ;;
+ ;; In sourcefile.scm:
+ ;;
+ ;; We need to catch those, but we also need to be aware that Emacs
+ ;; byte-compilation yields compiler headers in similar form of
+ ;; those:
+ ;;
+ ;; In toplevel form:
+ ;; In end of data:
+ ;;
+ ;; We want to catch the Guile file-headers but not the Emacs
+ ;; byte-compilation headers, because that will cause next-error
+ ;; and prev-error to break, because the files "toplevel form" and
+ ;; "end of data" does not exist.
+ ;;
+ ;; To differentiate between these two cases, we require that the
+ ;; file-match must always contain an extension.
+ ;;
+ ;; We should also only treat this as "info", not "error", because
+ ;; we do not know what lines will follow.
+ (guile-file "^In \\(.+\\..+\\):\n" 1 nil nil 0)
+ (guile-line "^ *\\([0-9]+\\): *\\([0-9]+\\)" nil 1 2)
)
"Alist of values for `compilation-error-regexp-alist'.")
@@ -513,7 +567,7 @@ listed text properties PROP# are given values VAL# as well."
"Directory to restore to when doing `recompile'.")
(defvar compilation-directory-matcher
- '("\\(?:Entering\\|Leavin\\(g\\)\\) directory `\\(.+\\)'$" (2 . 1))
+ '("\\(?:Entering\\|Leavin\\(g\\)\\) directory [`']\\(.+\\)'$" (2 . 1))
"A list for tracking when directories are entered or left.
If nil, do not track directories, e.g. if all file names are absolute. The
first element is the REGEXP matching these messages. It can match any number
@@ -526,7 +580,7 @@ directory we were in before the last entering message. If you change this,
you may also want to change `compilation-page-delimiter'.")
(defvar compilation-page-delimiter
- "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory `.+'\n\\)+"
+ "^\\(?:\f\\|.*\\(?:Entering\\|Leaving\\) directory [`'].+'\n\\)+"
"Value of `page-delimiter' in Compilation mode.")
(defvar compilation-mode-font-lock-keywords
@@ -618,11 +672,11 @@ The value nil as an element means to try the default directory."
Sometimes it is useful for files to supply local values for this variable.
You might also use mode hooks to specify it in certain modes, like this:
- (add-hook 'c-mode-hook
+ (add-hook \\='c-mode-hook
(lambda ()
(unless (or (file-exists-p \"makefile\")
(file-exists-p \"Makefile\"))
- (set (make-local-variable 'compile-command)
+ (set (make-local-variable \\='compile-command)
(concat \"make -k \"
(if buffer-file-name
(shell-quote-argument
@@ -937,19 +991,12 @@ POS and RES.")
(cons (copy-marker pos) (if prev (copy-marker prev))))
prev)
((and prev (= prev cache))
- (if cache
- (set-marker (car compilation--previous-directory-cache) pos)
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) nil)))
+ (set-marker (car compilation--previous-directory-cache) pos)
(cdr compilation--previous-directory-cache))
(t
- (if cache
- (progn
- (set-marker cache pos)
- (setcdr compilation--previous-directory-cache
- (copy-marker prev)))
- (setq compilation--previous-directory-cache
- (cons (copy-marker pos) (if prev (copy-marker prev)))))
+ (set-marker cache pos)
+ (setcdr compilation--previous-directory-cache
+ (copy-marker prev))
prev))))
(if (markerp res) (marker-position res) res))))
@@ -1004,7 +1051,7 @@ POS and RES.")
(let ((win (get-buffer-window buffer 0)))
(if win (set-window-point win pos)))
(if compilation-auto-jump-to-first-error
- (compile-goto-error nil t))))
+ (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.
@@ -1084,7 +1131,9 @@ If SCREEN is non-nil, columns are screen columns, otherwise, they are
just char-counts."
(setq col (- col compilation-first-column))
(if screen
- (move-to-column (max col 0))
+ ;; Presumably, the compilation tool doesn't know about our current
+ ;; `tab-width' setting, so it probably assumed 8-wide TABs (bug#21038).
+ (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)
@@ -1354,9 +1403,7 @@ to `compilation-error-regexp-alist' if RULES is nil."
(eq (car face) 'face)
(or (symbolp (cadr face))
(stringp (cadr face))))
- (put-text-property
- (match-beginning mn) (match-end mn)
- 'font-lock-face (cadr face))
+ (compilation--put-prop mn 'font-lock-face (cadr face))
(add-text-properties
(match-beginning mn) (match-end mn)
(nthcdr 2 face)))
@@ -1394,6 +1441,9 @@ to `compilation-error-regexp-alist' if RULES is nil."
(move-marker compilation--parsed limit)
(goto-char start)
(forward-line 0) ;Not line-beginning-position: ignore (comint) fields.
+ (while (and (not (bobp))
+ (get-text-property (1- (point)) 'compilation-multiline))
+ (forward-line -1))
(with-silent-modifications
(compilation--parse-region (point) compilation--parsed)))))
nil)
@@ -1429,15 +1479,15 @@ If optional second arg COMINT is t the buffer will be in Comint mode with
`compilation-shell-minor-mode'.
Interactively, prompts for the command if the variable
-`compilation-read-command' is non-nil; otherwise uses`compile-command'.
+`compilation-read-command' is non-nil; otherwise uses `compile-command'.
With prefix arg, always prompts.
Additionally, with universal prefix arg, compilation buffer will be in
comint mode, i.e. interactive.
To run more than one compilation at once, start one then rename
-the \`*compilation*' buffer to some other name with
+the `*compilation*' buffer to some other name with
\\[rename-buffer]. Then _switch buffers_ and start the new compilation.
-It will create a new \`*compilation*' buffer.
+It will create a new `*compilation*' buffer.
On most systems, termination of the main compilation process
kills its subprocesses.
@@ -1468,12 +1518,13 @@ If the optional argument `edit-command' is non-nil, the command can be edited."
(interactive "P")
(save-some-buffers (not compilation-ask-about-save)
compilation-save-buffers-predicate)
- (let ((default-directory (or compilation-directory default-directory)))
+ (let ((default-directory (or compilation-directory default-directory))
+ (command (eval compile-command)))
(when edit-command
- (setcar compilation-arguments
- (compilation-read-command (car compilation-arguments))))
- (apply 'compilation-start (or compilation-arguments
- `(,(eval compile-command))))))
+ (setq command (compilation-read-command (or (car compilation-arguments)
+ command)))
+ (if compilation-arguments (setcar compilation-arguments command)))
+ (apply 'compilation-start (or compilation-arguments (list command)))))
(defcustom compilation-scroll-output nil
"Non-nil to scroll the *compilation* buffer window as output appears.
@@ -1583,7 +1634,16 @@ Returns the compilation buffer created."
"\\\\\\(.\\)" "\\1"
(substring command (1+ (match-beginning 1))
(1- (match-end 1)))))
- (t (substitute-env-vars (match-string 1 command)))))
+ ;; Try globbing as well (bug#15417).
+ (t (let* ((substituted-dir
+ (substitute-env-vars (match-string 1 command)))
+ ;; FIXME: This also tries to expand `*' that were
+ ;; introduced by the envvar expansion!
+ (expanded-dir
+ (file-expand-wildcards substituted-dir)))
+ (if (= (length expanded-dir) 1)
+ (car expanded-dir)
+ substituted-dir)))))
(erase-buffer)
;; Select the desired mode.
(if (not (eq mode t))
@@ -1613,16 +1673,12 @@ Returns the compilation buffer created."
(format "%s started at %s\n\n"
mode-name
(substring (current-time-string) 0 19))
- ;; The command could be split into several lines, see
- ;; `rgrep' for example. We want to display it as one
- ;; line.
- (apply 'concat (split-string command (regexp-quote "\\\n") t))
- "\n")
+ command "\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
- (setq outwin (display-buffer outbuf))
+ (setq outwin (display-buffer outbuf '(nil (allow-no-window . t))))
(with-current-buffer outbuf
(let ((process-environment
(append
@@ -1634,17 +1690,22 @@ Returns the compilation buffer created."
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
- ;; Set the EMACS variable, but
- ;; don't override users' setting of $EMACS.
- (unless (getenv "EMACS")
- (list "EMACS=t"))
- (list "INSIDE_EMACS=t")
+ (list (format "INSIDE_EMACS=%s,compile" emacs-version))
(copy-sequence process-environment))))
(set (make-local-variable 'compilation-arguments)
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
- (set-window-start outwin (point-min))
+ (and outwin
+ ;; Forcing the window-start overrides the usual redisplay
+ ;; feature of bringing point into view, so setting the
+ ;; window-start to top of the buffer risks losing the
+ ;; effect of moving point to EOB below, per
+ ;; compilation-scroll-output, if the command is long
+ ;; enough to push point outside of the window. This
+ ;; could happen, e.g., in `rgrep'.
+ (not compilation-scroll-output)
+ (set-window-start outwin (point-min)))
;; Position point as the user will see it.
(let ((desired-visible-point
@@ -1653,15 +1714,15 @@ Returns the compilation buffer created."
(point-max)
;; Normally put it at the top.
(point-min))))
- (if (eq outwin (selected-window))
- (goto-char desired-visible-point)
+ (goto-char desired-visible-point)
+ (when (and outwin (not (eq outwin (selected-window))))
(set-window-point outwin desired-visible-point)))
;; The setup function is called before compilation-set-window-height
;; so it can set the compilation-window-height buffer locally.
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
- (compilation-set-window-height outwin)
+ (and outwin (compilation-set-window-height outwin))
;; Start the compilation.
(if (fboundp 'start-process)
(let ((proc
@@ -1943,6 +2004,12 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see).
compilation-page-delimiter)
;; (set (make-local-variable 'compilation-buffer-modtime) nil)
(compilation-setup)
+ ;; Turn off deferred fontifications in the compilation buffer, if
+ ;; the user turned them on globally. This is because idle timers
+ ;; aren't re-run after receiving input from a subprocess, so the
+ ;; buffer is left unfontified after the compilation exits, until
+ ;; some other input event happens.
+ (set (make-local-variable 'jit-lock-defer-time) nil)
(setq buffer-read-only t)
(run-mode-hooks 'compilation-mode-hook))
@@ -2032,8 +2099,7 @@ Optional argument MINOR indicates this is called from
(if minor
(progn
(font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
(setq font-lock-defaults '(compilation-mode-font-lock-keywords t))))
(defun compilation--unsetup ()
@@ -2042,8 +2108,7 @@ Optional argument MINOR indicates this is called from
(remove-hook 'before-change-functions 'compilation--flush-parse t)
(kill-local-variable 'compilation--parsed)
(compilation--remove-properties)
- (if font-lock-mode
- (font-lock-fontify-buffer)))
+ (font-lock-flush))
;;;###autoload
(define-minor-mode compilation-shell-minor-mode
@@ -2249,6 +2314,7 @@ looking for the next message."
(or (compilation-buffer-p (current-buffer))
(error "Not in a compilation buffer"))
(or pt (setq pt (point)))
+ (compilation--ensure-parse pt)
(let* ((msg (get-text-property pt 'compilation-message))
;; `loc', `msg', and `last' are used by the compilation-loop macro.
(loc (and msg (compilation--message->loc msg)))
@@ -2261,7 +2327,8 @@ looking for the next message."
(line-beginning-position)))
(unless (setq msg (get-text-property (max (1- pt) (point-min))
'compilation-message))
- (setq pt (next-single-property-change pt 'compilation-message nil
+ (setq pt (compilation-next-single-property-change
+ pt 'compilation-message nil
(line-end-position)))
(or (setq msg (get-text-property pt 'compilation-message))
(setq pt (point)))))
@@ -2272,7 +2339,6 @@ looking for the next message."
"No more %ss yet"
"Moved past last %s")
(point-max))
- (compilation--ensure-parse pt)
;; Don't move "back" to message at or before point.
;; Pass an explicit (point-min) to make sure pt is non-nil.
(setq pt (previous-single-property-change
@@ -2319,9 +2385,9 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)."
(defalias 'compile-mouse-goto-error 'compile-goto-error)
-(defun compile-goto-error (&optional event nomsg)
+(defun compile-goto-error (&optional event)
"Visit the source for the error message at point.
-Use this command in a compilation log buffer. Sets the mark at point there."
+Use this command in a compilation log buffer."
(interactive (list last-input-event))
(if event (posn-set-point (event-end event)))
(or (compilation-buffer-p (current-buffer))
@@ -2330,7 +2396,6 @@ Use this command in a compilation log buffer. Sets the mark at point there."
(if (get-text-property (point) 'compilation-directory)
(dired-other-window
(car (get-text-property (point) 'compilation-directory)))
- (push-mark nil nomsg)
(setq compilation-current-error (point))
(next-error-internal)))
@@ -2480,9 +2545,9 @@ displays at the top of the window; there is no arrow."
(- 1 compilation-context-lines))
(point)))
;; If there is no left fringe.
- (if (equal (car (window-fringes)) 0)
- (set-window-start w (save-excursion
- (goto-char mk)
+ (when (equal (car (window-fringes w)) 0)
+ (set-window-start w (save-excursion
+ (goto-char mk)
(beginning-of-line 1)
(point)))))
(set-window-point w mk))
@@ -2503,14 +2568,16 @@ and overlay is highlighted between MK and END-MK."
;; the error location if the two buffers are in two
;; different frames. So don't do it if it's not necessary.
pre-existing
- (display-buffer (marker-buffer msg))))
+ (display-buffer (marker-buffer msg) '(nil (allow-no-window . t)))))
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
- (compilation-set-window w msg)
+ (goto-char (marker-position msg))
+ (and w (compilation-set-window w msg))
compilation-highlight-regexp)))
;; Ideally, the window-size should be passed to `display-buffer'
;; so it's only used when creating a new window.
- (unless pre-existing (compilation-set-window-height w))
+ (when (and (not pre-existing) w)
+ (compilation-set-window-height w))
(if from-compilation-buffer
;; If the compilation buffer window was selected,
@@ -2621,9 +2688,12 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
(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.
- (let ((pop-up-windows t))
- (compilation-set-window (display-buffer (marker-buffer marker))
- marker)
+ (let ((w (let ((pop-up-windows t))
+ (display-buffer (marker-buffer marker)
+ '(nil (allow-no-window . t))))))
+ (with-current-buffer (marker-buffer marker)
+ (goto-char marker)
+ (and w (compilation-set-window w marker)))
(let* ((name (read-file-name
(format "Find this %s in (default %s): "
compilation-error filename)
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 770e78bb3b1..ab3aa7f993a 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1,6 +1,6 @@
;;; cperl-mode.el --- Perl code editing commands for Emacs
-;; Copyright (C) 1985-1987, 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1991-2015 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich
;; Bob Olson
@@ -282,7 +282,7 @@ This is in addition to cperl-continued-statement-offset."
(defcustom cperl-indent-wrt-brace t
"*Non-nil means indent statements in if/etc block relative brace, not if/etc.
-Versions 5.2 ... 5.20 behaved as if this were `nil'."
+Versions 5.2 ... 5.20 behaved as if this were nil."
:type 'boolean
:group 'cperl-indentation-details)
@@ -395,12 +395,12 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
:type 'boolean
:group 'cperl-indentation-details)
-(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
+(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\ %' =~ /(\\d+(\\.\\d+)+)/) ;")
"*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
:type '(repeat string)
:group 'cperl)
-(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/);")
+(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\ $ ' =~ /(\\d+(\\.\\d+)+)/);")
"*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
:type '(repeat string)
:group 'cperl)
@@ -412,15 +412,15 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
"use cperl-vc-rcs-header or cperl-vc-sccs-header instead."
"22.1")
-(defcustom cperl-clobber-mode-lists
- (not
- (and
- (boundp 'interpreter-mode-alist)
- (assoc "miniperl" interpreter-mode-alist)
- (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
- "*Whether to install us into `interpreter-' and `extension' mode lists."
- :type 'boolean
- :group 'cperl)
+;; (defcustom cperl-clobber-mode-lists
+;; (not
+;; (and
+;; (boundp 'interpreter-mode-alist)
+;; (assoc "miniperl" interpreter-mode-alist)
+;; (assoc "\\.\\([pP][Llm]\\|al\\)$" auto-mode-alist)))
+;; "*Whether to install us into `interpreter-' and `extension' mode lists."
+;; :type 'boolean
+;; :group 'cperl)
(defcustom cperl-info-on-command-no-prompt nil
"*Not-nil (and non-null) means not to prompt on C-h f.
@@ -724,7 +724,7 @@ mode-compile.el.
If your Emacs does not default to `cperl-mode' on Perl files, and you
want it to: put the following into your .emacs file:
- (defalias 'perl-mode 'cperl-mode)
+ (defalias \\='perl-mode \\='cperl-mode)
Get perl5-info from
$CPAN/doc/manual/info/perl5-old/perl5-info.tar.gz
@@ -793,7 +793,7 @@ corrected problems are: POD sections, here-documents, regexps. The
operations are: highlighting, indentation, electric keywords, electric
braces.
-This may be confusing, since the regexp s#//#/#\; may be highlighted
+This may be confusing, since the regexp s#//#/#; may be highlighted
as a comment, but it will be recognized as a regexp by the indentation
code. Or the opposite case, when a POD section is highlighted, but
may break the indentation of the following code (though indentation
@@ -1042,11 +1042,11 @@ In regular expressions (including character classes):
cperl-can-font-lock)
(defun cperl-putback-char (c) ; Emacs 19
- (set 'unread-command-events (list c))) ; Avoid undefined warning
+ (push c unread-command-events)) ; Avoid undefined warning
(if (featurep 'xemacs)
(defun cperl-putback-char (c) ; XEmacs >= 19.12
- (setq unread-command-events (list (eval '(character-to-event c))))))
+ (push (eval '(character-to-event c)) unread-command-events)))
(or (fboundp 'uncomment-region)
(defun uncomment-region (beg end)
@@ -2281,8 +2281,8 @@ to nil."
(search-backward ")")
(if (eq last-command-event ?\()
(progn ; Avoid "if (())"
- (delete-backward-char 1)
- (delete-backward-char -1))))
+ (delete-char -1)
+ (delete-char 1))))
(if delete
(cperl-putback-char cperl-del-back-ch))
(if cperl-message-electric-keyword
@@ -2588,7 +2588,7 @@ Will untabify if `cperl-electric-backspace-untabify' is non-nil."
(delete-region (point) p))
(if cperl-electric-backspace-untabify
(backward-delete-char-untabify arg)
- (delete-backward-char arg)))))
+ (call-interactively 'delete-backward-char)))))
(put 'cperl-electric-backspace 'delete-selection 'supersede)
@@ -3124,7 +3124,7 @@ and closing parentheses and brackets."
(+ (if (or (memq (elt i 2) (append "}])" nil)) ; char-after
(eq 'continuation ; do not stagger continuations
(elt (cperl-sniff-for-indent parse-data) 0)))
- 0 ; Closing parenth or continuation of a continuation
+ 0 ; Closing parenthesis or continuation of a continuation
cperl-continued-statement-offset)
(if (or (elt i 3) ; is-block
(not (elt i 4)) ; is-brace
@@ -3672,7 +3672,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
is-REx is-x-REx REx-subgr-start REx-subgr-end was-subgr i2 hairy-RE
(case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
(modified (buffer-modified-p)) overshoot is-o-REx name
- (after-change-functions nil)
+ (inhibit-modification-hooks t)
(cperl-font-locking t)
(use-syntax-state (and cperl-syntax-state
(>= min (car cperl-syntax-state))))
@@ -4585,13 +4585,13 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
((eq (char-after b) ?\: )
"\\\\*\\[\\\\:\\^?\\sw+\\\\:]")
((eq (char-after b) ?^ )
- "\\\\*\\[:\\(\\\\\\^\\)?\\sw+:\]")
+ "\\\\*\\[:\\(\\\\\\^\\)?\\sw+:]")
((eq (char-syntax (char-after b))
?w)
(concat
"\\\\*\\[:\\(\\\\\\^\\)?\\(\\\\"
(char-to-string (char-after b))
- "\\|\\sw\\)+:\]"))
+ "\\|\\sw\\)+:]"))
(t "\\\\*\\[:\\^?\\sw*:]")))
(goto-char REx-subgr-end)
(cperl-highlight-charclass
@@ -4828,9 +4828,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(and (memq (char-syntax (preceding-char)) '(?w ?_))
(progn
(backward-sexp)
- ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr'
+ ;; sub {BLK}, print {BLK} $data, but NOT `bless', `return', `tr', `constant'
(or (and (looking-at "[a-zA-Z0-9_:]+[ \t\n\f]*[{#]") ; Method call syntax
- (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\)\\>")))
+ (not (looking-at "\\(bless\\|return\\|q[wqrx]?\\|tr\\|[smy]\\|constant\\)\\>")))
;; sub bless::foo {}
(progn
(cperl-backward-to-noncomment (point-min))
@@ -5043,7 +5043,7 @@ conditional/loop constructs."
(goto-char top))
(if (looking-at ; Try Plan C: continuation block
(concat cperl-maybe-white-and-comment-rex
- "\\<\\(else\\|elsif\|continue\\)\\>"))
+ "\\<\\(else\\|elsif\\|continue\\)\\>"))
(progn
(goto-char (match-end 0))
(setq tmp-end (point-at-eol)))
@@ -5145,7 +5145,7 @@ Returns some position at the last line."
(if (eq (following-char) ?\( )
(progn
(forward-sexp 1)
- (setq pp (point))) ; past parenth-group
+ (setq pp (point))) ; past parenthesis-group
;; after `else' or nothing
(if ml ; after `else'
(skip-chars-backward " \t\n")
@@ -5706,7 +5706,7 @@ indentation and initial hashes. Behaves usually outside of comment."
"redo" "return" "local" "exec" "sub" "do" "dump" "use" "our"
"require" "package" "eval" "my" "BEGIN" "END" "CHECK" "INIT")
"\\|") ; Flow control
- "\\)\\>") 2) ; was "\\)[ \n\t;():,\|&]"
+ "\\)\\>") 2) ; was "\\)[ \n\t;():,|&]"
; In what follows we use `type' style
; for overwritable builtins
(list
@@ -5850,7 +5850,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(1 font-lock-string-face 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
+ '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
font-lock-string-face t)
'("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[ \t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
font-lock-constant-face) ; labels
@@ -5935,7 +5935,7 @@ indentation and initial hashes. Behaves usually outside of comment."
(and (string< "21.1.10" emacs-version)
(string< emacs-version "21.1.2")))
'(
- ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
+ ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
(if (eq (char-after (match-beginning 2)) ?%)
'cperl-hash-face
'cperl-array-face)
@@ -6535,7 +6535,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'."
(eval '(mode-compile)))) ; Avoid a warning
(declare-function Info-find-node "info"
- (filename nodename &optional no-going-back))
+ (filename nodename &optional no-going-back strict-case))
(defun cperl-info-buffer (type)
;; Returns buffer with documentation. Creates if missing.
@@ -7607,7 +7607,7 @@ than a line. Your contribution to update/shorten it is appreciated."
(defvar cperl-short-docs 'please-ignore-this-line
;; Perl4 version was written by Johan Vromans (jvromans@squirrel.nl)
- "# based on '@(#)@ perl-descr.el 1.9 - describe-perl-symbol' [Perl 5]
+ "# based on \\='@(#)@ perl-descr.el 1.9 - describe-perl-symbol\\=' [Perl 5]
... Range (list context); flip/flop [no flop when flip] (scalar context).
! ... Logical negation.
... != ... Numeric inequality.
@@ -7630,8 +7630,8 @@ $7 Match of the 7th set of parentheses in the last match (auto-local).
$8 Match of the 8th set of parentheses in the last match (auto-local).
$9 Match of the 9th set of parentheses in the last match (auto-local).
$& The string matched by the last pattern match (auto-local).
-$' The string after what was matched by the last match (auto-local).
-$` The string before what was matched by the last match (auto-local).
+$\\=' The string after what was matched by the last match (auto-local).
+$\\=` The string before what was matched by the last match (auto-local).
$( The real gid of this process.
$) The effective gid of this process.
@@ -7647,7 +7647,7 @@ $; Subscript separator for multi-dim array emulation. Default \"\\034\".
$< The real uid of this process.
$= The page length of the current output channel. Default is 60 lines.
$> The effective uid of this process.
-$? The status returned by the last ``, pipe close or `system'.
+$? The status returned by the last \\=`\\=`, pipe close or `system'.
$@ The perl error message from the last eval or do @var{EXPR} command.
$ARGV The name of the current file used with <> .
$[ Deprecated: The index of the first element/char in an array/string.
@@ -7886,9 +7886,9 @@ pop(ARRAY)
print [FILEHANDLE] [(LIST)]
printf [FILEHANDLE] (FORMAT,LIST)
push(ARRAY,LIST)
-q/STRING/ Synonym for 'STRING'
+q/STRING/ Synonym for \\='STRING\\='
qq/STRING/ Synonym for \"STRING\"
-qx/STRING/ Synonym for `STRING`
+qx/STRING/ Synonym for \\=`STRING\\=`
rand[(EXPR)]
read(FILEHANDLE,SCALAR,LENGTH[,OFFSET])
readdir(DIRHANDLE)
@@ -7988,7 +7988,7 @@ DESTROY Shorthand for `sub DESTROY {...}'.
abs [ EXPR ] absolute value
... and ... Low-precedence synonym for &&.
bless REFERENCE [, PACKAGE] Makes reference into an object of a package.
-chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq ''!
+chomp [LIST] Strips $/ off LIST/$_. Returns count. Special if $/ eq \\='\\='!
chr Converts a number to char with the same ordinal.
else Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
elsif Part of if/unless {BLOCK} elsif {BLOCK} else {BLOCK}.
@@ -8005,9 +8005,9 @@ not ... Low-precedence synonym for ! - negation.
... or ... Low-precedence synonym for ||.
pos STRING Set/Get end-position of the last match over this string, see \\G.
quotemeta [ EXPR ] Quote regexp metacharacters.
-qw/WORD1 .../ Synonym of split('', 'WORD1 ...')
+qw/WORD1 .../ Synonym of split(\\='\\=', \\='WORD1 ...\\=')
readline FH Synonym of <FH>.
-readpipe CMD Synonym of `CMD`.
+readpipe CMD Synonym of \\=`CMD\\=`.
ref [ EXPR ] Type of EXPR when dereferenced.
sysopen FH, FILENAME, MODE [, PERM] (MODE is numeric, see Fcntl.)
tie VAR, PACKAGE, LIST Hide an object behind a simple Perl variable.
@@ -8882,7 +8882,7 @@ Delay of auto-help controlled by `cperl-lazy-help-time'."
(defun cperl-font-lock-unfontify-region-function (beg end)
(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
- before-change-functions after-change-functions
+ (inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)
(remove-text-properties beg end '(face nil))
(if (and (not modified) (buffer-modified-p))
@@ -8900,8 +8900,9 @@ do extra unwind via `cperl-unwind-to-safe'."
(beginning-of-line)
(eq (get-text-property (setq beg (point)) 'syntax-type)
'multiline)))
- (if (setq beg (cperl-beginning-of-property beg 'syntax-type))
- (goto-char beg)))
+ (let ((new-beg (cperl-beginning-of-property beg 'syntax-type)))
+ (setq beg (if (= new-beg beg) nil new-beg))
+ (goto-char new-beg)))
(setq beg (point))
(goto-char end)
(while (and end
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index d332d8bff31..3cf17f48b5f 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,6 +1,6 @@
;;; cpp.el --- highlight or hide text according to cpp conditionals
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: c, faces, tools
@@ -57,7 +57,7 @@
:group 'cpp)
(define-widget 'cpp-face 'lazy
- "Either a face or the special symbol 'invisible'."
+ "Either a face or the special symbol `invisible'."
:type '(choice (const invisible) (face)))
(defcustom cpp-known-face 'invisible
@@ -234,7 +234,8 @@ A prefix arg suppresses display of that buffer."
(cpp-progress-message "Parsing...")
(while (re-search-forward cpp-parse-regexp nil t)
(cpp-progress-message "Parsing...%d%%"
- (/ (* 100 (- (point) (point-min))) (buffer-size)))
+ (floor (* 100.0 (- (point) (point-min)))
+ (buffer-size)))
(let ((match (buffer-substring (match-beginning 0) (match-end 0))))
(cond ((or (string-equal match "'")
(string-equal match "\""))
@@ -493,9 +494,10 @@ You can also use the keyboard accelerators indicated like this: [K]ey."
(set-buffer buffer)
(setq cpp-edit-symbols symbols)
(erase-buffer)
- (insert "CPP Display Information for `")
+ (insert (substitute-command-keys "CPP Display Information for `"))
(cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home)
- (insert "'\n\nClick mouse-2 on item you want to change or use\n"
+ (insert (substitute-command-keys
+ "'\n\nClick mouse-2 on item you want to change or use\n")
"or switch to this buffer and type the keyboard equivalents.\n"
"Keyboard equivalents are indicated with brackets like [T]his.\n\n")
(cpp-make-button "[H]ome (display the C file)" 'cpp-edit-home)
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index b8cbb67ae0b..2f501f28b65 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -1,6 +1,6 @@
;;; cwarn.el --- highlight suspicious C and C++ constructions
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Anders Lindgren <andersl@andersl.com>
;; Keywords: c, languages, faces
@@ -188,7 +188,7 @@ and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:group 'cwarn :lighter cwarn-mode-text
(cwarn-font-lock-keywords cwarn-mode)
- (if font-lock-mode (font-lock-fontify-buffer)))
+ (font-lock-flush))
;;;###autoload
(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1")
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 8a868883a11..8c8bef06ecc 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,6 +1,6 @@
;;; dcl-mode.el --- major mode for editing DCL command files
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Odd Gripenstam <gripenstamol@decus.se>
;; Maintainer: Odd Gripenstam <gripenstamol@decus.se>
@@ -173,7 +173,7 @@ It can have the following values:
first-line indentation for the first line in a buffer or SUBROUTINE.
CUR-INDENT is the indentation of the preceding command line.
EXTRA-INDENT is the default change in indentation for this line
-\(a negative number for 'outdent).
+\(a negative number for “outdent”).
LAST-POINT is the buffer position of the first significant word on the
previous line or nil if the current line is the first line.
THIS-POINT is the buffer position of the first significant word on the
@@ -259,12 +259,12 @@ never indented."
:group 'dcl)
(defcustom dcl-imenu-generic-expression
- `((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
+ `((nil "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):[ \t]+SUBROUTINE\\b" 1)
(,dcl-imenu-label-labels
- "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
- (,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
- (,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)" 1)
- (,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_\$]+\\)" 1))
+ "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):\\([ \t]\\|$\\)" 1)
+ (,dcl-imenu-label-goto "\\s-GOTO[ \t]+\\([A-Za-z0-9_$]+\\)" 1)
+ (,dcl-imenu-label-gosub "\\s-GOSUB[ \t]+\\([A-Za-z0-9_$]+\\)" 1)
+ (,dcl-imenu-label-call "\\s-CALL[ \t]+\\([A-Za-z0-9_$]+\\)" 1))
"Default imenu generic expression for DCL.
The default includes SUBROUTINE labels in the main listing and
@@ -369,7 +369,7 @@ followed by space or tab."
(defcustom dcl-label-r
- "[a-zA-Z0-9_\$]*:\\([ \t!]\\|$\\)"
+ "[a-zA-Z0-9_$]*:\\([ \t!]\\|$\\)"
"Regular expression describing a label.
A label is a name followed by a colon followed by white-space or end-of-line."
:type 'regexp
@@ -453,12 +453,12 @@ Preloaded with all known option names from dcl-option-alist")
;; above. This version won't find GOTOs in comments or text strings.
;(defvar dcl-imenu-generic-expression
; (`
-; ((nil "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):[ \t]+SUBROUTINE\\b" 1)
-; ("Labels" "^\\$[ \t]*\\([A-Za-z0-9_\$]+\\):\\([ \t]\\|$\\)" 1)
-; ("GOTO" (, (concat dcl-cmd-r "GOTO[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)
+; ((nil "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):[ \t]+SUBROUTINE\\b" 1)
+; ("Labels" "^\\$[ \t]*\\([A-Za-z0-9_$]+\\):\\([ \t]\\|$\\)" 1)
+; ("GOTO" (, (concat dcl-cmd-r "GOTO[ \t]+\\([A-Za-z0-9_$]+\\)")) 5)
; ("GOSUB" (, (concat dcl-cmd-r
-; "GOSUB[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)
-; ("CALL" (, (concat dcl-cmd-r "CALL[ \t]+\\([A-Za-z0-9_\$]+\\)")) 5)))
+; "GOSUB[ \t]+\\([A-Za-z0-9_$]+\\)")) 5)
+; ("CALL" (, (concat dcl-cmd-r "CALL[ \t]+\\([A-Za-z0-9_$]+\\)")) 5)))
; "*Default imenu generic expression for DCL.
;The default includes SUBROUTINE labels in the main listing and
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index b6b8aacc536..d409139d27f 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -1,6 +1,6 @@
;;; ebnf-abn.el --- parser for ABNF (Augmented BNF)
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index c4afd906e44..e339818cf30 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -1,6 +1,6 @@
;;; ebnf-bnf.el --- parser for EBNF
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index bf1acb3a3d9..35bd8df9c99 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -1,6 +1,6 @@
;;; ebnf-dtd.el --- parser for DTD (Data Type Description for XML)
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index d33fe55a2e8..28058e360bd 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -1,6 +1,6 @@
;;; ebnf-ebx.el --- parser for EBNF used to specify XML (EBNFX)
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index 3f58b7fef55..2cbe9010821 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -1,6 +1,6 @@
;;; ebnf-iso.el --- parser for ISO EBNF
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index ed6b5317e33..3e5cf38665c 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -1,6 +1,6 @@
;;; ebnf-otz.el --- syntactic chart OpTimiZer
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index ff43450bdec..d9e8a15fef4 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -1,6 +1,6 @@
;;; ebnf-yac.el --- parser for Yacc/Bison
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index caa33d36440..6d8e90c2d6a 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -1,6 +1,6 @@
;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -1899,7 +1899,7 @@ It's only used when `ebnf-syntax' is `iso-ebnf'."
:group 'ebnf-syntactic)
-(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
+(defcustom ebnf-file-suffix-regexp "\\.[Bb][Nn][Ff]$"
"Specify file name suffix that contains EBNF.
See `ebnf-eps-directory' command."
@@ -2731,7 +2731,7 @@ See also `ebnf-syntax-buffer'."
(ebnf-syntax . 'ebnf)
(ebnf-iso-alternative-p . nil)
(ebnf-iso-normalize-p . nil)
- (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$")
+ (ebnf-file-suffix-regexp . "\\.[Bb][Nn][Ff]$")
(ebnf-eps-prefix . "ebnf--")
(ebnf-eps-header-font . '(11 Helvetica "Black" "White" bold))
(ebnf-eps-header . nil)
@@ -3912,7 +3912,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
{/Effect EffectP def
/fP F ForegroundP SetRGB BackgroundP aload pop true BG S
/Effect 0 def
- ( :) S false BG}if
+ ( :) S false BG}{pop}ifelse
xw yw moveto
hT EL RA
xp yw moveto
@@ -6345,7 +6345,7 @@ killed after process termination."
(when ebnf-log
(with-current-buffer (get-buffer-create "*Ebnf2ps Log*")
(goto-char (point-max))
- (insert (apply 'format format-str args) "\n"))))
+ (insert (apply #'format-message format-str args) "\n"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 865211d109c..80f9e2a7719 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -1,9 +1,9 @@
;;; ebrowse.el --- Emacs C++ class browser & tags facility
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: C++ tags tools
;; This file is part of GNU Emacs.
@@ -2015,7 +2015,7 @@ COLLAPSE non-nil means collapse the branch."
(defun ebrowse-electric-list-looper (state condition)
"Prevent cursor from moving beyond the buffer end.
Don't let it move into the title lines.
-See 'Electric-command-loop' for a description of STATE and CONDITION."
+See `Electric-command-loop' for a description of STATE and CONDITION."
(cond ((and condition
(not (memq (car condition)
'(buffer-read-only end-of-buffer
@@ -3471,7 +3471,7 @@ are not performed."
(with-output-to-temp-buffer (concat "*Apropos Members*")
(set-buffer standard-output)
(erase-buffer)
- (insert "Members matching `" regexp "'\n\n")
+ (insert (format-message "Members matching `%s'\n\n" regexp))
(cl-loop for s in (ebrowse-list-of-matching-members members regexp) do
(cl-loop for info in (gethash s members) do
(ebrowse-draw-file-member-info info))))))
@@ -4223,7 +4223,8 @@ NUMBER-OF-STATIC-VARIABLES:"
(1+ (point)))))))))
(unless non-empty
(error "No tree buffers"))
- (setf unread-command-events (listify-key-sequence "p"))
+ (setf unread-command-events
+ (nconc (listify-key-sequence "p") unread-command-events))
(shrink-window-if-larger-than-buffer (selected-window))
(setq buffer-read-only t))))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
new file mode 100644
index 00000000000..bdc304e0aa5
--- /dev/null
+++ b/lisp/progmodes/elisp-mode.el
@@ -0,0 +1,1580 @@
+;;; elisp-mode.el --- Emacs Lisp mode -*- lexical-binding:t -*-
+
+;; Copyright (C) 1985-1986, 1999-2015 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: lisp, languages
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The major mode for editing Emacs Lisp code.
+;; This mode is documented in the Emacs manual.
+
+;;; Code:
+
+(require 'cl-generic)
+(require 'lisp-mode)
+(eval-when-compile (require 'cl-lib))
+
+(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
+ "Abbrev table for Emacs Lisp mode.
+It has `lisp-mode-abbrev-table' as its parent."
+ :parents (list lisp-mode-abbrev-table))
+
+(defvar emacs-lisp-mode-syntax-table
+ (let ((table (make-syntax-table lisp--mode-syntax-table)))
+ (modify-syntax-entry ?\[ "(] " table)
+ (modify-syntax-entry ?\] ")[ " table)
+ table)
+ "Syntax table used in `emacs-lisp-mode'.")
+
+(defvar emacs-lisp-mode-map
+ (let ((map (make-sparse-keymap "Emacs-Lisp"))
+ (menu-map (make-sparse-keymap "Emacs-Lisp"))
+ (lint-map (make-sparse-keymap))
+ (prof-map (make-sparse-keymap))
+ (tracing-map (make-sparse-keymap)))
+ (set-keymap-parent map lisp-mode-shared-map)
+ (define-key map "\e\t" 'completion-at-point)
+ (define-key map "\e\C-x" 'eval-defun)
+ (define-key map "\e\C-q" 'indent-pp-sexp)
+ (bindings--define-key map [menu-bar emacs-lisp]
+ (cons "Emacs-Lisp" menu-map))
+ (bindings--define-key menu-map [eldoc]
+ '(menu-item "Auto-Display Documentation Strings" eldoc-mode
+ :button (:toggle . (bound-and-true-p eldoc-mode))
+ :help "Display the documentation string for the item under cursor"))
+ (bindings--define-key menu-map [checkdoc]
+ '(menu-item "Check Documentation Strings" checkdoc
+ :help "Check documentation strings for style requirements"))
+ (bindings--define-key menu-map [re-builder]
+ '(menu-item "Construct Regexp" re-builder
+ :help "Construct a regexp interactively"))
+ (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
+ (bindings--define-key tracing-map [tr-a]
+ '(menu-item "Untrace All" untrace-all
+ :help "Untrace all currently traced functions"))
+ (bindings--define-key tracing-map [tr-uf]
+ '(menu-item "Untrace Function..." untrace-function
+ :help "Untrace function, and possibly activate all remaining advice"))
+ (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
+ (bindings--define-key tracing-map [tr-q]
+ '(menu-item "Trace Function Quietly..." trace-function-background
+ :help "Trace the function with trace output going quietly to a buffer"))
+ (bindings--define-key tracing-map [tr-f]
+ '(menu-item "Trace Function..." trace-function
+ :help "Trace the function given as an argument"))
+ (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
+ (bindings--define-key prof-map [prof-restall]
+ '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
+ :help "Restore the original definitions of all functions being profiled"))
+ (bindings--define-key prof-map [prof-restfunc]
+ '(menu-item "Remove Instrumentation for Function..." elp-restore-function
+ :help "Restore an instrumented function to its original definition"))
+
+ (bindings--define-key prof-map [sep-rem] menu-bar-separator)
+ (bindings--define-key prof-map [prof-resall]
+ '(menu-item "Reset Counters for All Functions" elp-reset-all
+ :help "Reset the profiling information for all functions being profiled"))
+ (bindings--define-key prof-map [prof-resfunc]
+ '(menu-item "Reset Counters for Function..." elp-reset-function
+ :help "Reset the profiling information for a function"))
+ (bindings--define-key prof-map [prof-res]
+ '(menu-item "Show Profiling Results" elp-results
+ :help "Display current profiling results"))
+ (bindings--define-key prof-map [prof-pack]
+ '(menu-item "Instrument Package..." elp-instrument-package
+ :help "Instrument for profiling all function that start with a prefix"))
+ (bindings--define-key prof-map [prof-func]
+ '(menu-item "Instrument Function..." elp-instrument-function
+ :help "Instrument a function for profiling"))
+ ;; Maybe this should be in a separate submenu from the ELP stuff?
+ (bindings--define-key prof-map [sep-natprof] menu-bar-separator)
+ (bindings--define-key prof-map [prof-natprof-stop]
+ '(menu-item "Stop Native Profiler" profiler-stop
+ :help "Stop recording profiling information"
+ :enable (and (featurep 'profiler)
+ (profiler-running-p))))
+ (bindings--define-key prof-map [prof-natprof-report]
+ '(menu-item "Show Profiler Report" profiler-report
+ :help "Show the current profiler report"
+ :enable (and (featurep 'profiler)
+ (profiler-running-p))))
+ (bindings--define-key prof-map [prof-natprof-start]
+ '(menu-item "Start Native Profiler..." profiler-start
+ :help "Start recording profiling information"))
+
+ (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
+ (bindings--define-key lint-map [lint-di]
+ '(menu-item "Lint Directory..." elint-directory
+ :help "Lint a directory"))
+ (bindings--define-key lint-map [lint-f]
+ '(menu-item "Lint File..." elint-file
+ :help "Lint a file"))
+ (bindings--define-key lint-map [lint-b]
+ '(menu-item "Lint Buffer" elint-current-buffer
+ :help "Lint the current buffer"))
+ (bindings--define-key lint-map [lint-d]
+ '(menu-item "Lint Defun" elint-defun
+ :help "Lint the function at point"))
+ (bindings--define-key menu-map [edebug-defun]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [separator-byte] menu-bar-separator)
+ (bindings--define-key menu-map [disas]
+ '(menu-item "Disassemble Byte Compiled Object..." disassemble
+ :help "Print disassembled code for OBJECT in a buffer"))
+ (bindings--define-key menu-map [byte-recompile]
+ '(menu-item "Byte-recompile Directory..." byte-recompile-directory
+ :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
+ (bindings--define-key menu-map [emacs-byte-compile-and-load]
+ '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
+ :help "Byte-compile the current file (if it has changed), then load compiled code"))
+ (bindings--define-key menu-map [byte-compile]
+ '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
+ :help "Byte compile the file containing the current buffer"))
+ (bindings--define-key menu-map [separator-eval] menu-bar-separator)
+ (bindings--define-key menu-map [ielm]
+ '(menu-item "Interactive Expression Evaluation" ielm
+ :help "Interactively evaluate Emacs Lisp expressions"))
+ (bindings--define-key menu-map [eval-buffer]
+ '(menu-item "Evaluate Buffer" eval-buffer
+ :help "Execute the current buffer as Lisp code"))
+ (bindings--define-key menu-map [eval-region]
+ '(menu-item "Evaluate Region" eval-region
+ :help "Execute the region as Lisp code"
+ :enable mark-active))
+ (bindings--define-key menu-map [eval-sexp]
+ '(menu-item "Evaluate Last S-expression" eval-last-sexp
+ :help "Evaluate sexp before point; print value in echo area"))
+ (bindings--define-key menu-map [separator-format] menu-bar-separator)
+ (bindings--define-key menu-map [comment-region]
+ '(menu-item "Comment Out Region" comment-region
+ :help "Comment or uncomment each line in the region"
+ :enable mark-active))
+ (bindings--define-key menu-map [indent-region]
+ '(menu-item "Indent Region" indent-region
+ :help "Indent each nonblank line in the region"
+ :enable mark-active))
+ (bindings--define-key menu-map [indent-line]
+ '(menu-item "Indent Line" lisp-indent-line))
+ map)
+ "Keymap for Emacs Lisp mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(defun emacs-lisp-byte-compile ()
+ "Byte compile the file containing the current buffer."
+ (interactive)
+ (if buffer-file-name
+ (byte-compile-file buffer-file-name)
+ (error "The buffer must be saved in a file first")))
+
+(defun emacs-lisp-byte-compile-and-load ()
+ "Byte-compile the current file (if it has changed), then load compiled code."
+ (interactive)
+ (or buffer-file-name
+ (error "The buffer must be saved in a file first"))
+ (require 'bytecomp)
+ ;; Recompile if file or buffer has changed since last compilation.
+ (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))
+
+(defun emacs-lisp-macroexpand ()
+ "Macroexpand the form after point.
+Comments in the form will be lost."
+ (interactive)
+ (let* ((start (point))
+ (exp (read (current-buffer)))
+ ;; Compute it before, since it may signal errors.
+ (new (macroexpand-1 exp)))
+ (if (equal exp new)
+ (message "Not a macro call, nothing to expand")
+ (delete-region start (point))
+ (pp new (current-buffer))
+ (if (bolp) (delete-char -1))
+ (indent-region start (point)))))
+
+(defcustom emacs-lisp-mode-hook nil
+ "Hook run when entering Emacs Lisp mode."
+ :options '(eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
+ :type 'hook
+ :group 'lisp)
+
+;;;###autoload
+(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
+ "Major mode for editing Lisp code to run in Emacs.
+Commands:
+Delete converts tabs to spaces as it moves back.
+Blank lines separate paragraphs. Semicolons start comments.
+
+\\{emacs-lisp-mode-map}"
+ :group 'lisp
+ (defvar xref-find-function)
+ (defvar xref-identifier-completion-table-function)
+ (defvar project-search-path-function)
+ (lisp-mode-variables nil nil 'elisp)
+ (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
+ (setq-local electric-pair-text-pairs
+ (append '((?\` . ?\') (?‘ . ?’)) electric-pair-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)
+ (setq-local xref-find-function #'elisp-xref-find)
+ (setq-local xref-identifier-completion-table-function
+ #'elisp--xref-identifier-completion-table)
+ (setq-local project-search-path-function #'elisp-search-path)
+ (add-hook 'completion-at-point-functions
+ #'elisp-completion-at-point nil 'local))
+
+;; Font-locking support.
+
+(defun elisp--font-lock-flush-elisp-buffers (&optional file)
+ ;; FIXME: Aren't we only ever called from after-load-functions?
+ ;; Don't flush during load unless called from after-load-functions.
+ ;; In that case, FILE is non-nil. It's somehow strange that
+ ;; load-in-progress is t when an after-load-function is called since
+ ;; that should run *after* the load...
+ (when (or (not load-in-progress) file)
+ ;; FIXME: If the loaded file did not define any macros, there shouldn't
+ ;; be any need to font-lock-flush all the Elisp buffers.
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (derived-mode-p 'emacs-lisp-mode)
+ ;; So as to take into account new macros that may have been defined
+ ;; by the just-loaded file.
+ (font-lock-flush))))))
+
+;;; Completion at point for Elisp
+
+(defun elisp--local-variables-1 (vars sexp)
+ "Return the vars locally bound around the witness, or nil if not found."
+ (let (res)
+ (while
+ (unless
+ (setq res
+ (pcase sexp
+ (`(,(or `let `let*) ,bindings)
+ (let ((vars vars))
+ (when (eq 'let* (car sexp))
+ (dolist (binding (cdr (reverse bindings)))
+ (push (or (car-safe binding) binding) vars)))
+ (elisp--local-variables-1
+ vars (car (cdr-safe (car (last bindings)))))))
+ (`(,(or `let `let*) ,bindings . ,body)
+ (let ((vars vars))
+ (dolist (binding bindings)
+ (push (or (car-safe binding) binding) vars))
+ (elisp--local-variables-1 vars (car (last body)))))
+ (`(lambda ,_args)
+ ;; FIXME: Look for the witness inside `args'.
+ (setq sexp nil))
+ (`(lambda ,args . ,body)
+ (elisp--local-variables-1
+ (append (remq '&optional (remq '&rest args)) vars)
+ (car (last body))))
+ (`(condition-case ,_ ,e) (elisp--local-variables-1 vars e))
+ (`(condition-case ,v ,_ . ,catches)
+ (elisp--local-variables-1
+ (cons v vars) (cdr (car (last catches)))))
+ (`(quote . ,_)
+ ;; FIXME: Look for the witness inside sexp.
+ (setq sexp nil))
+ ;; FIXME: Handle `cond'.
+ (`(,_ . ,_)
+ (elisp--local-variables-1 vars (car (last sexp))))
+ (`elisp--witness--lisp (or vars '(nil)))
+ (_ nil)))
+ ;; We didn't find the witness in the last element so we try to
+ ;; backtrack to the last-but-one.
+ (setq sexp (ignore-errors (butlast sexp)))))
+ res))
+
+(defun elisp--local-variables ()
+ "Return a list of locally let-bound variables at point."
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (let* ((ppss (syntax-ppss))
+ (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point))
+ (or (nth 8 ppss) (point))))
+ (closer ()))
+ (dolist (p (nth 9 ppss))
+ (push (cdr (syntax-after p)) closer))
+ (setq closer (apply #'string closer))
+ (let* ((sexp (condition-case nil
+ (car (read-from-string
+ (concat txt "elisp--witness--lisp" closer)))
+ ((invalid-read-syntax end-of-file) nil)))
+ (macroexpand-advice (lambda (expander form &rest args)
+ (condition-case nil
+ (apply expander form args)
+ (error form))))
+ (sexp
+ (unwind-protect
+ (progn
+ (advice-add 'macroexpand :around macroexpand-advice)
+ (macroexpand-all sexp))
+ (advice-remove 'macroexpand macroexpand-advice)))
+ (vars (elisp--local-variables-1 nil sexp)))
+ (delq nil
+ (mapcar (lambda (var)
+ (and (symbolp var)
+ (not (string-match (symbol-name var) "\\`[&_]"))
+ ;; Eliminate uninterned vars.
+ (intern-soft var)
+ var))
+ vars))))))
+
+(defvar elisp--local-variables-completion-table
+ ;; Use `defvar' rather than `defconst' since defconst would purecopy this
+ ;; value, which would doubly fail: it would fail because purecopy can't
+ ;; handle the recursive bytecode object, and it would fail because it would
+ ;; move `lastpos' and `lastvars' to pure space where they'd be immutable!
+ (let ((lastpos nil) (lastvars nil))
+ (letrec ((hookfun (lambda ()
+ (setq lastpos nil)
+ (remove-hook 'post-command-hook hookfun))))
+ (completion-table-dynamic
+ (lambda (_string)
+ (save-excursion
+ (skip-syntax-backward "_w")
+ (let ((newpos (cons (point) (current-buffer))))
+ (unless (equal lastpos newpos)
+ (add-hook 'post-command-hook hookfun)
+ (setq lastpos newpos)
+ (setq lastvars
+ (mapcar #'symbol-name (elisp--local-variables))))))
+ lastvars)))))
+
+(defun elisp--expect-function-p (pos)
+ "Return non-nil if the symbol at point is expected to be a function."
+ (or
+ (and (eq (char-before pos) ?')
+ (eq (char-before (1- pos)) ?#))
+ (save-excursion
+ (let ((parent (nth 1 (syntax-ppss pos))))
+ (when parent
+ (goto-char parent)
+ (and
+ (looking-at (concat "(\\(cl-\\)?"
+ (regexp-opt '("declare-function"
+ "function" "defadvice"
+ "callf" "callf2"
+ "defsetf"))
+ "[ \t\r\n]+"))
+ (eq (match-end 0) pos)))))))
+
+(defun elisp--form-quoted-p (pos)
+ "Return non-nil if the form at POS is not evaluated.
+It can be quoted, or be inside a quoted form."
+ ;; FIXME: Do some macro expansion maybe.
+ (save-excursion
+ (let ((state (syntax-ppss pos)))
+ (or (nth 8 state) ; Code inside strings usually isn't evaluated.
+ ;; FIXME: The 9th element is undocumented.
+ (let ((nesting (cons (point) (reverse (nth 9 state))))
+ res)
+ (while (and nesting (not res))
+ (goto-char (pop nesting))
+ (cond
+ ((or (eq (char-after) ?\[)
+ (progn
+ (skip-chars-backward " ")
+ (memq (char-before) '(?' ?` ?‘))))
+ (setq res t))
+ ((eq (char-before) ?,)
+ (setq nesting nil))))
+ res)))))
+
+;; FIXME: Support for Company brings in features which straddle eldoc.
+;; We should consolidate this, so that major modes can provide all that
+;; data all at once:
+;; - a function to extract "the reference at point" (may be more complex
+;; than a mere string, to distinguish various namespaces).
+;; - a function to jump to such a reference.
+;; - a function to show the signature/interface of such a reference.
+;; - a function to build a help-buffer about that reference.
+;; FIXME: Those functions should also be used by the normal completion code in
+;; the *Completions* buffer.
+
+(defun elisp--company-doc-buffer (str)
+ (let ((symbol (intern-soft str)))
+ ;; FIXME: we really don't want to "display-buffer and then undo it".
+ (save-window-excursion
+ ;; Make sure we don't display it in another frame, otherwise
+ ;; save-window-excursion won't be able to undo it.
+ (let ((display-buffer-overriding-action
+ '(nil . ((inhibit-switch-frame . t)))))
+ (ignore-errors
+ (cond
+ ((fboundp symbol) (describe-function symbol))
+ ((boundp symbol) (describe-variable symbol))
+ ((featurep symbol) (describe-package symbol))
+ ((facep symbol) (describe-face symbol))
+ (t (signal 'user-error nil)))
+ (help-buffer))))))
+
+(defun elisp--company-doc-string (str)
+ (let* ((symbol (intern-soft str))
+ (doc (if (fboundp symbol)
+ (documentation symbol t)
+ (documentation-property symbol 'variable-documentation t))))
+ (and (stringp doc)
+ (string-match ".*$" doc)
+ (match-string 0 doc))))
+
+;; can't (require 'find-func) in a preloaded file
+(declare-function find-library-name "find-func" (library))
+(declare-function find-function-library "find-func" (function &optional l-o v))
+
+(defun elisp--company-location (str)
+ (let ((sym (intern-soft str)))
+ (cond
+ ((fboundp sym) (find-definition-noselect sym nil))
+ ((boundp sym) (find-definition-noselect sym 'defvar))
+ ((featurep sym)
+ (require 'find-func)
+ (cons (find-file-noselect (find-library-name
+ (symbol-name sym)))
+ 0))
+ ((facep sym) (find-definition-noselect sym 'defface)))))
+
+(defun elisp-completion-at-point ()
+ "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ (let* ((pos (point))
+ (beg (condition-case nil
+ (save-excursion
+ (backward-sexp 1)
+ (skip-chars-forward "`',‘#")
+ (point))
+ (scan-error pos)))
+ (end
+ (unless (or (eq beg (point-max))
+ (member (char-syntax (char-after beg))
+ '(?\s ?\" ?\( ?\))))
+ (condition-case nil
+ (save-excursion
+ (goto-char beg)
+ (forward-sexp 1)
+ (skip-chars-backward "'’")
+ (when (>= (point) pos)
+ (point)))
+ (scan-error pos))))
+ ;; t if in function position.
+ (funpos (eq (char-before beg) ?\())
+ (quoted (elisp--form-quoted-p beg)))
+ (when (and end (or (not (nth 8 (syntax-ppss)))
+ (memq (char-before beg) '(?` ?‘))))
+ (let ((table-etc
+ (if (or (not funpos) quoted)
+ ;; FIXME: We could look at the first element of the list and
+ ;; use it to provide a more specific completion table in some
+ ;; cases. E.g. filter out keywords that are not understood by
+ ;; the macro/function being called.
+ (cond
+ ((elisp--expect-function-p beg)
+ (list nil obarray
+ :predicate #'fboundp
+ :company-doc-buffer #'elisp--company-doc-buffer
+ :company-docsig #'elisp--company-doc-string
+ :company-location #'elisp--company-location))
+ (quoted
+ (list nil obarray
+ ;; Don't include all symbols (bug#16646).
+ :predicate (lambda (sym)
+ (or (boundp sym)
+ (fboundp sym)
+ (featurep sym)
+ (symbol-plist sym)))
+ :annotation-function
+ (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
+ :company-doc-buffer #'elisp--company-doc-buffer
+ :company-docsig #'elisp--company-doc-string
+ :company-location #'elisp--company-location))
+ (t
+ (list nil (completion-table-merge
+ elisp--local-variables-completion-table
+ (apply-partially #'completion-table-with-predicate
+ obarray
+ #'boundp
+ 'strict))
+ :company-doc-buffer #'elisp--company-doc-buffer
+ :company-docsig #'elisp--company-doc-string
+ :company-location #'elisp--company-location)))
+ ;; Looks like a funcall position. Let's double check.
+ (save-excursion
+ (goto-char (1- beg))
+ (let ((parent
+ (condition-case nil
+ (progn (up-list -1) (forward-char 1)
+ (let ((c (char-after)))
+ (if (eq c ?\() ?\(
+ (if (memq (char-syntax c) '(?w ?_))
+ (read (current-buffer))))))
+ (error nil))))
+ (pcase parent
+ ;; FIXME: Rather than hardcode special cases here,
+ ;; we should use something like a symbol-property.
+ (`declare
+ (list t (mapcar (lambda (x) (symbol-name (car x)))
+ (delete-dups
+ ;; FIXME: We should include some
+ ;; docstring with each entry.
+ (append
+ macro-declarations-alist
+ defun-declarations-alist)))))
+ ((and (or `condition-case `condition-case-unless-debug)
+ (guard (save-excursion
+ (ignore-errors
+ (forward-sexp 2)
+ (< (point) beg)))))
+ (list t obarray
+ :predicate (lambda (sym) (get sym 'error-conditions))))
+ ((and (or ?\( `let `let*)
+ (guard (save-excursion
+ (goto-char (1- beg))
+ (when (eq parent ?\()
+ (up-list -1))
+ (forward-symbol -1)
+ (looking-at "\\_<let\\*?\\_>"))))
+ (list t obarray
+ :predicate #'boundp
+ :company-doc-buffer #'elisp--company-doc-buffer
+ :company-docsig #'elisp--company-doc-string
+ :company-location #'elisp--company-location))
+ (_ (list nil obarray
+ :predicate #'fboundp
+ :company-doc-buffer #'elisp--company-doc-buffer
+ :company-docsig #'elisp--company-doc-string
+ :company-location #'elisp--company-location
+ ))))))))
+ (nconc (list beg end)
+ (if (null (car table-etc))
+ (cdr table-etc)
+ (cons
+ (if (memq (char-syntax (or (char-after end) ?\s))
+ '(?\s ?>))
+ (cadr table-etc)
+ (apply-partially 'completion-table-with-terminator
+ " " (cadr table-etc)))
+ (cddr table-etc)))))))))
+
+(define-obsolete-function-alias
+ 'lisp-completion-at-point 'elisp-completion-at-point "25.1")
+
+;;; Xref backend
+
+(declare-function xref-make-bogus-location "xref" (message))
+(declare-function xref-make "xref" (summary location))
+(declare-function xref-collect-references "xref" (symbol dir))
+
+(defun elisp-xref-find (action id)
+ (require 'find-func)
+ ;; FIXME: use information in source near point to filter results:
+ ;; (dvc-log-edit ...) - exclude 'feature
+ ;; (require 'dvc-log-edit) - only 'feature
+ ;; Semantic may provide additional information
+ (pcase action
+ (`definitions
+ (let ((sym (intern-soft id)))
+ (when sym
+ (elisp--xref-find-definitions sym))))
+ (`references
+ (elisp--xref-find-references id))
+ (`apropos
+ (elisp--xref-find-apropos id))))
+
+;; 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))
+
+;; 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))
+
+(defvar find-feature-regexp);; in find-func.el
+
+(defun elisp--xref-make-xref (type symbol file &optional summary)
+ "Return an xref for TYPE SYMBOL in FILE.
+TYPE must be a type in `find-function-regexp-alist' (use nil for
+'defun). If SUMMARY is non-nil, use it for the summary;
+otherwise build the summary from TYPE and SYMBOL."
+ (xref-make (or summary
+ (format elisp--xref-format (or type 'defun) symbol))
+ (xref-make-elisp-location symbol type file)))
+
+(defvar elisp-xref-find-def-functions nil
+ "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
+`elisp--xref-find-definitions'.")
+
+;; FIXME: name should be singular; match xref-find-definition
+(defun elisp--xref-find-definitions (symbol)
+ ;; The file name is not known when `symbol' is defined via interactive eval.
+ (let (xrefs)
+
+ (let ((temp elisp-xref-find-def-functions))
+ (while (and (null xrefs)
+ temp)
+ (setq xrefs (append xrefs (funcall (pop temp) symbol)))))
+
+ (unless xrefs
+ ;; alphabetical by result type symbol
+
+ ;; FIXME: advised function; list of advice functions
+
+ ;; Coding system symbols do not appear in ‘load-history’,
+ ;; so we can’t get a location for them.
+
+ (when (and (symbolp symbol)
+ (symbol-function symbol)
+ (symbolp (symbol-function symbol)))
+ ;; aliased function
+ (let* ((alias-symbol symbol)
+ (alias-file (symbol-file alias-symbol))
+ (real-symbol (symbol-function symbol))
+ (real-file (find-lisp-object-file-name real-symbol 'defun)))
+
+ (when real-file
+ (push (elisp--xref-make-xref nil real-symbol real-file) xrefs))
+
+ (when alias-file
+ (push (elisp--xref-make-xref 'defalias alias-symbol alias-file) xrefs))))
+
+ (when (facep symbol)
+ (let ((file (find-lisp-object-file-name symbol 'defface)))
+ (when file
+ (push (elisp--xref-make-xref 'defface symbol file) xrefs))))
+
+ (when (fboundp symbol)
+ (let ((file (find-lisp-object-file-name symbol (symbol-function symbol)))
+ generic doc)
+ (when file
+ (cond
+ ((eq file 'C-source)
+ ;; First call to find-lisp-object-file-name for an object
+ ;; defined in C; the doc strings from the C source have
+ ;; not been loaded yet. Second call will return "src/*.c"
+ ;; in file; handled by 't' case below.
+ (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs))
+
+ ((and (setq doc (documentation symbol t))
+ ;; This doc string is defined in cl-macs.el cl-defstruct
+ (string-match "Constructor for objects of type `\\(.*\\)'" doc))
+ ;; `symbol' is a name for the default constructor created by
+ ;; cl-defstruct, so return the location of the cl-defstruct.
+ (let* ((type-name (match-string 1 doc))
+ (type-symbol (intern type-name))
+ (file (find-lisp-object-file-name type-symbol 'define-type))
+ (summary (format elisp--xref-format-extra
+ 'cl-defstruct
+ (concat "(" type-name)
+ (concat "(:constructor " (symbol-name symbol) "))"))))
+ (push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs)
+ ))
+
+ ((setq generic (cl--generic symbol))
+ ;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el
+
+ ;; A generic function. If there is a default method, it
+ ;; will appear in the method table, with no
+ ;; specializers.
+ ;;
+ ;; If the default method is declared by the cl-defgeneric
+ ;; declaration, it will have the same location as the
+ ;; cl-defgeneric, so we want to exclude it from the
+ ;; result. In this case, it will have a null doc
+ ;; string. User declarations of default methods may also
+ ;; have null doc strings, but we hope that is
+ ;; rare. Perhaps this heuristic will discourage that.
+ (dolist (method (cl--generic-method-table generic))
+ (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly
+ (specializers (cl--generic-method-specializers method))
+ (non-default nil)
+ (met-name (cons symbol specializers))
+ (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+ (dolist (item specializers)
+ ;; default method has all 't' in specializers
+ (setq non-default (or non-default (not (equal t item)))))
+
+ (when (and file
+ (or non-default
+ (nth 2 info))) ;; assuming only co-located default has null doc string
+ (if specializers
+ (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info))))
+ (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))
+
+ (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()")))
+ (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))))
+ ))
+
+ (if (and (setq doc (documentation symbol t))
+ ;; This doc string is created somewhere in
+ ;; cl--generic-make-function for an implicit
+ ;; defgeneric.
+ (string-match "\n\n(fn ARG &rest ARGS)" doc))
+ ;; This symbol is an implicitly defined defgeneric, so
+ ;; don't return it.
+ nil
+ (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs))
+ )
+
+ (t
+ (push (elisp--xref-make-xref nil symbol file) xrefs))
+ ))))
+
+ (when (boundp symbol)
+ ;; A variable
+ (let ((file (find-lisp-object-file-name symbol 'defvar)))
+ (when file
+ (cond
+ ((eq file 'C-source)
+ ;; The doc strings from the C source have not been loaded
+ ;; yet; help-C-file-name does that. Second call will
+ ;; return "src/*.c" in file; handled below.
+ (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs))
+
+ ((string= "src/" (substring file 0 4))
+ ;; The variable is defined in a C source file; don't check
+ ;; for define-minor-mode.
+ (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
+
+ ((memq symbol minor-mode-list)
+ ;; The symbol is a minor mode. These should be defined by
+ ;; "define-minor-mode", which means the variable and the
+ ;; function are declared in the same place. So we return only
+ ;; the function, arbitrarily.
+ ;;
+ ;; There is an exception, when the variable is defined in C
+ ;; code, as for abbrev-mode.
+ ;;
+ ;; IMPROVEME: If the user is searching for the identifier at
+ ;; point, we can determine whether it is a variable or
+ ;; function by looking at the source code near point.
+ ;;
+ ;; IMPROVEME: The user may actually be asking "do any
+ ;; variables by this name exist"; we need a way to specify
+ ;; that.
+ nil)
+
+ (t
+ (push (elisp--xref-make-xref 'defvar symbol file) xrefs))
+
+ ))))
+
+ (when (featurep symbol)
+ (let ((file (ignore-errors
+ (find-library-name (symbol-name symbol)))))
+ (when file
+ (push (elisp--xref-make-xref 'feature symbol file) xrefs))))
+ );; 'unless xrefs'
+
+ xrefs))
+
+(declare-function project-search-path "project")
+(declare-function project-current "project")
+
+(defun elisp--xref-find-references (symbol)
+ "Find all references to SYMBOL (a string) in the current project."
+ (cl-mapcan
+ (lambda (dir)
+ (xref-collect-references symbol dir))
+ (project-search-path (project-current))))
+
+(defun elisp--xref-find-apropos (regexp)
+ (apply #'nconc
+ (let (lst)
+ (dolist (sym (apropos-internal regexp))
+ (push (elisp--xref-find-definitions sym) lst))
+ (nreverse lst))))
+
+(defvar elisp--xref-identifier-completion-table
+ (apply-partially #'completion-table-with-predicate
+ obarray
+ (lambda (sym)
+ (or (boundp sym)
+ (fboundp sym)
+ (featurep sym)
+ (facep sym)))
+ 'strict))
+
+(defun elisp--xref-identifier-completion-table ()
+ elisp--xref-identifier-completion-table)
+
+(cl-defstruct (xref-elisp-location
+ (:constructor xref-make-elisp-location (symbol type file)))
+ "Location of an Emacs Lisp symbol definition."
+ symbol type file)
+
+(cl-defmethod xref-location-marker ((l xref-elisp-location))
+ (pcase-let (((cl-struct xref-elisp-location symbol type file) l))
+ (let ((buffer-point (find-function-search-for-symbol symbol type file)))
+ (with-current-buffer (car buffer-point)
+ (goto-char (or (cdr buffer-point) (point-min)))
+ (point-marker)))))
+
+(cl-defmethod xref-location-group ((l xref-elisp-location))
+ (xref-elisp-location-file l))
+
+(defun elisp-search-path ()
+ (defvar package-user-dir)
+ (cons package-user-dir load-path))
+
+;;; Elisp Interaction mode
+
+(defvar lisp-interaction-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap "Lisp-Interaction")))
+ (set-keymap-parent map lisp-mode-shared-map)
+ (define-key map "\e\C-x" 'eval-defun)
+ (define-key map "\e\C-q" 'indent-pp-sexp)
+ (define-key map "\e\t" 'completion-at-point)
+ (define-key map "\n" 'eval-print-last-sexp)
+ (bindings--define-key map [menu-bar lisp-interaction]
+ (cons "Lisp-Interaction" menu-map))
+ (bindings--define-key menu-map [eval-defun]
+ '(menu-item "Evaluate Defun" eval-defun
+ :help "Evaluate the top-level form containing point, or after point"))
+ (bindings--define-key menu-map [eval-print-last-sexp]
+ '(menu-item "Evaluate and Print" eval-print-last-sexp
+ :help "Evaluate sexp before point; print value into current buffer"))
+ (bindings--define-key menu-map [edebug-defun-lisp-interaction]
+ '(menu-item "Instrument Function for Debugging" edebug-defun
+ :help "Evaluate the top level form point is in, stepping through with Edebug"
+ :keys "C-u C-M-x"))
+ (bindings--define-key menu-map [indent-pp-sexp]
+ '(menu-item "Indent or Pretty-Print" indent-pp-sexp
+ :help "Indent each line of the list starting just after point, or prettyprint it"))
+ (bindings--define-key menu-map [complete-symbol]
+ '(menu-item "Complete Lisp Symbol" completion-at-point
+ :help "Perform completion on Lisp symbol preceding point"))
+ map)
+ "Keymap for Lisp Interaction mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
+ "Major mode for typing and evaluating Lisp forms.
+Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
+before point, and prints its value into the buffer, advancing point.
+Note that printing is controlled by `eval-expression-print-length'
+and `eval-expression-print-level'.
+
+Commands:
+Delete converts tabs to spaces as it moves back.
+Paragraphs are separated only by blank lines.
+Semicolons start comments.
+
+\\{lisp-interaction-mode-map}"
+ :abbrev-table nil)
+
+;;; Emacs Lisp Byte-Code mode
+
+(eval-and-compile
+ (defconst emacs-list-byte-code-comment-re
+ (concat "\\(#\\)@\\([0-9]+\\) "
+ ;; Make sure it's a docstring and not a lazy-loaded byte-code.
+ "\\(?:[^(]\\|([^\"]\\)")))
+
+(defun elisp--byte-code-comment (end &optional _point)
+ "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
+ (let ((ppss (syntax-ppss)))
+ (when (and (nth 4 ppss)
+ (eq (char-after (nth 8 ppss)) ?#))
+ (let* ((n (save-excursion
+ (goto-char (nth 8 ppss))
+ (when (looking-at emacs-list-byte-code-comment-re)
+ (string-to-number (match-string 2)))))
+ ;; `maxdiff' tries to make sure the loop below terminates.
+ (maxdiff n))
+ (when n
+ (let* ((bchar (match-end 2))
+ (b (position-bytes bchar)))
+ (goto-char (+ b n))
+ (while (let ((diff (- (position-bytes (point)) b n)))
+ (unless (zerop diff)
+ (when (> diff maxdiff) (setq diff maxdiff))
+ (forward-char (- diff))
+ (setq maxdiff (if (> diff 0) diff
+ (max (1- maxdiff) 1)))
+ t))))
+ (if (<= (point) end)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (string-to-syntax "> b"))
+ (goto-char end)))))))
+
+(defun elisp-byte-code-syntax-propertize (start end)
+ (goto-char start)
+ (elisp--byte-code-comment end (point))
+ (funcall
+ (syntax-propertize-rules
+ (emacs-list-byte-code-comment-re
+ (1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
+ start end))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.elc\\'" . elisp-byte-code-mode))
+;;;###autoload
+(define-derived-mode elisp-byte-code-mode emacs-lisp-mode
+ "Elisp-Byte-Code"
+ "Major mode for *.elc files."
+ ;; TODO: Add way to disassemble byte-code under point.
+ (setq-local open-paren-in-column-0-is-defun-start nil)
+ (setq-local syntax-propertize-function
+ #'elisp-byte-code-syntax-propertize))
+
+
+;;; Globally accessible functionality
+
+(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
+ "Evaluate sexp before point; print value into current buffer.
+
+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,
+however, there is no such truncation. Such a prefix argument
+also causes integers to be printed in several additional formats
+\(octal, hexadecimal, and character).
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger."
+ (interactive "P")
+ (let ((standard-output (current-buffer)))
+ (terpri)
+ (eval-last-sexp (or eval-last-sexp-arg-internal t))
+ (terpri)))
+
+
+(defun last-sexp-setup-props (beg end value alt1 alt2)
+ "Set up text properties for the output of `elisp--eval-last-sexp'.
+BEG and END are the start and end of the output in current-buffer.
+VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
+alternative printed representations that can be displayed."
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-m" 'elisp-last-sexp-toggle-display)
+ (define-key map [down-mouse-2] 'mouse-set-point)
+ (define-key map [mouse-2] 'elisp-last-sexp-toggle-display)
+ (add-text-properties
+ beg end
+ `(printed-value (,value ,alt1 ,alt2)
+ mouse-face highlight
+ keymap ,map
+ help-echo "RET, mouse-2: toggle abbreviated display"
+ rear-nonsticky (mouse-face keymap help-echo
+ printed-value)))))
+
+
+(defun elisp-last-sexp-toggle-display (&optional _arg)
+ "Toggle between abbreviated and unabbreviated printed representations."
+ (interactive "P")
+ (save-restriction
+ (widen)
+ (let ((value (get-text-property (point) 'printed-value)))
+ (when value
+ (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
+ 'printed-value)
+ (point)))
+ (end (or (next-single-char-property-change (point) 'printed-value) (point)))
+ (standard-output (current-buffer))
+ (point (point)))
+ (delete-region beg end)
+ (insert (nth 1 value))
+ (or (= beg point)
+ (setq point (1- (point))))
+ (last-sexp-setup-props beg (point)
+ (nth 0 value)
+ (nth 2 value)
+ (nth 1 value))
+ (goto-char (min (point-max) point)))))))
+
+(defun prin1-char (char) ;FIXME: Move it, e.g. to simple.el.
+ "Return a string representing CHAR as a character rather than as an integer.
+If CHAR is not a character, return nil."
+ (and (integerp char)
+ (eventp char)
+ (let ((c (event-basic-type char))
+ (mods (event-modifiers char))
+ string)
+ ;; Prevent ?A from turning into ?\S-a.
+ (if (and (memq 'shift mods)
+ (zerop (logand char ?\S-\^@))
+ (not (let ((case-fold-search nil))
+ (char-equal c (upcase c)))))
+ (setq c (upcase c) mods nil))
+ ;; What string are we considering using?
+ (condition-case nil
+ (setq string
+ (concat
+ "?"
+ (mapconcat
+ (lambda (modif)
+ (cond ((eq modif 'super) "\\s-")
+ (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
+ mods "")
+ (cond
+ ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
+ ((eq c 127) "\\C-?")
+ (t
+ (string c)))))
+ (error nil))
+ ;; Verify the string reads a CHAR, not to some other character.
+ ;; If it doesn't, return nil instead.
+ (and string
+ (= (car (read-from-string string)) char)
+ string))))
+
+(defun elisp--preceding-sexp ()
+ "Return sexp before the point."
+ (let ((opoint (point))
+ (left-quote ?‘)
+ expr)
+ (save-excursion
+ (with-syntax-table emacs-lisp-mode-syntax-table
+ ;; If this sexp appears to be enclosed in `...' or ‘...’
+ ;; then ignore the surrounding quotes.
+ (cond ((eq (preceding-char) ?’)
+ (progn (forward-char -1) (setq opoint (point))))
+ ((or (eq (following-char) ?\')
+ (eq (preceding-char) ?\'))
+ (setq left-quote ?\`)))
+ (forward-sexp -1)
+ ;; If we were after `?\e' (or similar case),
+ ;; use the whole thing, not just the `e'.
+ (when (eq (preceding-char) ?\\)
+ (forward-char -1)
+ (when (eq (preceding-char) ??)
+ (forward-char -1)))
+
+ ;; Skip over hash table read syntax.
+ (and (> (point) (1+ (point-min)))
+ (looking-back "#s" (- (point) 2))
+ (forward-char -2))
+
+ ;; Skip over `#N='s.
+ (when (eq (preceding-char) ?=)
+ (let (labeled-p)
+ (save-excursion
+ (skip-chars-backward "0-9#=")
+ (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
+ (when labeled-p
+ (forward-sexp -1))))
+
+ (save-restriction
+ (if (eq (following-char) left-quote)
+ ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so
+ ;; that the value is returned, not the name.
+ (forward-char))
+ (when (looking-at ",@?") (goto-char (match-end 0)))
+ (narrow-to-region (point-min) opoint)
+ (setq expr (read (current-buffer)))
+ ;; If it's an (interactive ...) form, it's more useful to show how an
+ ;; interactive call would use it.
+ ;; FIXME: Is it really the right place for this?
+ (when (eq (car-safe expr) 'interactive)
+ (setq expr
+ `(call-interactively
+ (lambda (&rest args) ,expr args))))
+ expr)))))
+(define-obsolete-function-alias 'preceding-sexp 'elisp--preceding-sexp "25.1")
+
+(defun elisp--eval-last-sexp (eval-last-sexp-arg-internal)
+ "Evaluate sexp before point; print value in the echo area.
+If EVAL-LAST-SEXP-ARG-INTERNAL is non-nil, print output into
+current buffer. If EVAL-LAST-SEXP-ARG-INTERNAL is `0', print
+output with no limit on the length and level of lists, and
+include additional formats for integers \(octal, hexadecimal, and
+character)."
+ (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
+ ;; Setup the lexical environment if lexical-binding is enabled.
+ (elisp--eval-last-sexp-print-value
+ (eval (eval-sexp-add-defvars (elisp--preceding-sexp)) lexical-binding)
+ eval-last-sexp-arg-internal)))
+
+
+(defun elisp--eval-last-sexp-print-value (value &optional eval-last-sexp-arg-internal)
+ (let ((unabbreviated (let ((print-length nil) (print-level nil))
+ (prin1-to-string value)))
+ (print-length (and (not (zerop (prefix-numeric-value
+ eval-last-sexp-arg-internal)))
+ eval-expression-print-length))
+ (print-level (and (not (zerop (prefix-numeric-value
+ eval-last-sexp-arg-internal)))
+ eval-expression-print-level))
+ (beg (point))
+ end)
+ (prog1
+ (prin1 value)
+ (let ((str (eval-expression-print-format value)))
+ (if str (princ str)))
+ (setq end (point))
+ (when (and (bufferp standard-output)
+ (or (not (null print-length))
+ (not (null print-level)))
+ (not (string= unabbreviated
+ (buffer-substring-no-properties beg end))))
+ (last-sexp-setup-props beg end value
+ unabbreviated
+ (buffer-substring-no-properties beg end))
+ ))))
+
+
+(defvar elisp--eval-last-sexp-fake-value (make-symbol "t"))
+
+(defun eval-sexp-add-defvars (exp &optional pos)
+ "Prepend EXP with all the `defvar's that precede it in the buffer.
+POS specifies the starting position where EXP was found and defaults to point."
+ (setq exp (macroexpand-all exp)) ;Eager macro-expansion.
+ (if (not lexical-binding)
+ exp
+ (save-excursion
+ (unless pos (setq pos (point)))
+ (let ((vars ()))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+ pos t)
+ (let ((var (intern (match-string 1))))
+ (and (not (special-variable-p var))
+ (save-excursion
+ (zerop (car (syntax-ppss (match-beginning 0)))))
+ (push var vars))))
+ `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
+
+(defun eval-last-sexp (eval-last-sexp-arg-internal)
+ "Evaluate sexp before point; print value in the echo area.
+Interactively, with prefix argument, print output into current buffer.
+
+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,
+however, there is no such truncation. Such a prefix argument
+also causes integers to be printed in several additional formats
+\(octal, hexadecimal, and character).
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger."
+ (interactive "P")
+ (if (null eval-expression-debug-on-error)
+ (elisp--eval-last-sexp eval-last-sexp-arg-internal)
+ (let ((value
+ (let ((debug-on-error elisp--eval-last-sexp-fake-value))
+ (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal)
+ debug-on-error))))
+ (unless (eq (cdr value) elisp--eval-last-sexp-fake-value)
+ (setq debug-on-error (cdr value)))
+ (car value))))
+
+(defun elisp--eval-defun-1 (form)
+ "Treat some expressions specially.
+Reset the `defvar' and `defcustom' variables to the initial value.
+\(For `defcustom', use the :set function if there is one.)
+Reinitialize the face according to the `defface' specification."
+ ;; The code in edebug-defun should be consistent with this, but not
+ ;; the same, since this gets a macroexpanded form.
+ (cond ((not (listp form))
+ form)
+ ((and (eq (car form) 'defvar)
+ (cdr-safe (cdr-safe form))
+ (boundp (cadr form)))
+ ;; Force variable to be re-set.
+ `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
+ (setq-default ,(nth 1 form) ,(nth 2 form))))
+ ;; `defcustom' is now macroexpanded to
+ ;; `custom-declare-variable' with a quoted value arg.
+ ((and (eq (car form) 'custom-declare-variable)
+ (default-boundp (eval (nth 1 form) lexical-binding)))
+ ;; Force variable to be bound, using :set function if specified.
+ (let ((setfunc (memq :set form)))
+ (when setfunc
+ (setq setfunc (car-safe (cdr-safe setfunc)))
+ (or (functionp setfunc) (setq setfunc nil)))
+ (funcall (or setfunc 'set-default)
+ (eval (nth 1 form) lexical-binding)
+ ;; The second arg is an expression that evaluates to
+ ;; an expression. The second evaluation is the one
+ ;; normally performed not by normal execution but by
+ ;; custom-initialize-set (for example), which does not
+ ;; use lexical-binding.
+ (eval (eval (nth 2 form) lexical-binding))))
+ form)
+ ;; `defface' is macroexpanded to `custom-declare-face'.
+ ((eq (car form) 'custom-declare-face)
+ ;; Reset the face.
+ (let ((face-symbol (eval (nth 1 form) lexical-binding)))
+ (setq face-new-frame-defaults
+ (assq-delete-all face-symbol face-new-frame-defaults))
+ (put face-symbol 'face-defface-spec nil)
+ (put face-symbol 'face-override-spec nil))
+ form)
+ ((eq (car form) 'progn)
+ (cons 'progn (mapcar #'elisp--eval-defun-1 (cdr form))))
+ (t form)))
+
+(defun elisp--eval-defun ()
+ "Evaluate defun that point is in or before.
+The value is displayed in the echo area.
+If the current defun is actually a call to `defvar',
+then reset the variable using the initial value expression
+even if the variable already has some other value.
+\(Normally `defvar' does not change the variable's value
+if it already has a value.)
+
+Return the result of evaluation."
+ ;; FIXME: the print-length/level bindings should only be applied while
+ ;; printing, not while evaluating.
+ (let ((debug-on-error eval-expression-debug-on-error)
+ (print-length eval-expression-print-length)
+ (print-level eval-expression-print-level))
+ (save-excursion
+ ;; Arrange for eval-region to "read" the (possibly) altered form.
+ ;; eval-region handles recording which file defines a function or
+ ;; variable.
+ (let ((standard-output t)
+ beg end form)
+ ;; Read the form from the buffer, and record where it ends.
+ (save-excursion
+ (end-of-defun)
+ (beginning-of-defun)
+ (setq beg (point))
+ (setq form (read (current-buffer)))
+ (setq end (point)))
+ ;; Alter the form if necessary.
+ (let ((form (eval-sexp-add-defvars
+ (elisp--eval-defun-1 (macroexpand form)))))
+ (eval-region beg end standard-output
+ (lambda (_ignore)
+ ;; Skipping to the end of the specified region
+ ;; will make eval-region return.
+ (goto-char end)
+ form))))))
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str)))
+ ;; The result of evaluation has been put onto VALUES. So return it.
+ (car values))
+
+(defun eval-defun (edebug-it)
+ "Evaluate the top-level form containing point, or after point.
+
+If the current defun is actually a call to `defvar' or `defcustom',
+evaluating it this way resets the variable using its initial value
+expression (using the defcustom's :set function if there is one), even
+if the variable already has some other value. \(Normally `defvar' and
+`defcustom' do not alter the value if there already is one.) In an
+analogous way, evaluating a `defface' overrides any customizations of
+the face, so that it becomes defined exactly as the `defface' expression
+says.
+
+If `eval-expression-debug-on-error' is non-nil, which is the default,
+this command arranges for all errors to enter the debugger.
+
+With a prefix argument, instrument the code for Edebug.
+
+If acting on a `defun' for FUNCTION, and the function was
+instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
+instrumented, just FUNCTION is printed.
+
+If not acting on a `defun', the result of evaluation is displayed in
+the echo area. This display is controlled by the variables
+`eval-expression-print-length' and `eval-expression-print-level',
+which see."
+ (interactive "P")
+ (cond (edebug-it
+ (require 'edebug)
+ (eval-defun (not edebug-all-defs)))
+ (t
+ (if (null eval-expression-debug-on-error)
+ (elisp--eval-defun)
+ (let (new-value value)
+ (let ((debug-on-error elisp--eval-last-sexp-fake-value))
+ (setq value (elisp--eval-defun))
+ (setq new-value debug-on-error))
+ (unless (eq elisp--eval-last-sexp-fake-value new-value)
+ (setq debug-on-error new-value))
+ value)))))
+
+;;; ElDoc Support
+
+(defvar elisp--eldoc-last-data (make-vector 3 nil)
+ "Bookkeeping; elements are as follows:
+ 0 - contains the last symbol read from the buffer.
+ 1 - contains the string last displayed in the echo area for variables,
+ 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)
+ "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."
+ (let ((argstring
+ (cond
+ ((not (and sym (symbolp sym) (fboundp sym))) nil)
+ ((and (eq sym (aref elisp--eldoc-last-data 0))
+ (eq 'function (aref elisp--eldoc-last-data 2)))
+ (aref elisp--eldoc-last-data 1))
+ (t
+ (let* ((advertised (gethash (indirect-function sym)
+ advertised-signature-table t))
+ doc
+ (args
+ (cond
+ ((listp advertised) advertised)
+ ((setq doc (help-split-fundoc
+ (condition-case nil (documentation sym t)
+ (invalid-function nil))
+ sym))
+ (car doc))
+ (t (help-function-arglist sym)))))
+ ;; Stringify, and store before highlighting, downcasing, etc.
+ (elisp--last-data-store sym (elisp-function-argstring args)
+ 'function))))))
+ ;; Highlight, truncate.
+ (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'."
+ ;; 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!
+ (let ((start nil)
+ (end 0)
+ (argument-face 'eldoc-highlight-function-argument)
+ (args-lst (mapcar (lambda (x)
+ (replace-regexp-in-string
+ "\\`[(]\\|[)]\\'" "" x))
+ (split-string args))))
+ ;; Find the current argument in the argument string. We need to
+ ;; handle `&rest' and informal `...' properly.
+ ;;
+ ;; FIXME: What to do with optional arguments, like in
+ ;; (defun NAME ARGLIST [DOCSTRING] BODY...) case?
+ ;; The problem is there is no robust way to determine if
+ ;; the current argument is indeed a docstring.
+
+ ;; When `&key' is used finding position based on `index'
+ ;; would be wrong, so find the arg at point and determine
+ ;; position in ARGS based on this current arg.
+ (when (string-match "&key" args)
+ (let* (case-fold-search
+ key-have-value
+ (sym-name (symbol-name sym))
+ (cur-w (current-word))
+ (args-lst-ak (cdr (member "&key" args-lst)))
+ (limit (save-excursion
+ (when (re-search-backward sym-name nil t)
+ (match-end 0))))
+ (cur-a (if (and cur-w (string-match ":\\([^ ()]*\\)" cur-w))
+ (substring cur-w 1)
+ (save-excursion
+ (let (split)
+ (when (re-search-backward ":\\([^()\n]*\\)" limit t)
+ (setq split (split-string (match-string 1) " " t))
+ (prog1 (car split)
+ (when (cdr split)
+ (setq key-have-value t))))))))
+ ;; If `cur-a' is not one of `args-lst-ak'
+ ;; assume user is entering an unknown key
+ ;; referenced in last position in signature.
+ (other-key-arg (and (stringp cur-a)
+ args-lst-ak
+ (not (member (upcase cur-a) args-lst-ak))
+ (upcase (car (last args-lst-ak))))))
+ (unless (string= cur-w sym-name)
+ ;; The last keyword have already a value
+ ;; i.e :foo a b and cursor is at b.
+ ;; If signature have also `&rest'
+ ;; (assume it is after the `&key' section)
+ ;; go to the arg after `&rest'.
+ (if (and key-have-value
+ (save-excursion
+ (not (re-search-forward ":.*" (point-at-eol) t)))
+ (string-match "&rest \\([^ ()]*\\)" args))
+ (setq index nil ; Skip next block based on positional args.
+ start (match-beginning 1)
+ end (match-end 1))
+ ;; If `cur-a' is nil probably cursor is on a positional arg
+ ;; before `&key', in this case, exit this block and determine
+ ;; position with `index'.
+ (when (and cur-a ; A keyword arg (dot removed) or nil.
+ (or (string-match
+ (concat "\\_<" (upcase cur-a) "\\_>") args)
+ (string-match
+ (concat "\\_<" other-key-arg "\\_>") args)))
+ (setq index nil ; Skip next block based on positional args.
+ start (match-beginning 0)
+ end (match-end 0)))))))
+ ;; Handle now positional arguments.
+ (while (and index (>= index 1))
+ (if (string-match "[^ ()]+" args end)
+ (progn
+ (setq start (match-beginning 0)
+ end (match-end 0))
+ (let ((argument (match-string 0 args)))
+ (cond ((string= argument "&rest")
+ ;; All the rest arguments are the same.
+ (setq index 1))
+ ((string= argument "&optional")) ; Skip.
+ ((string= argument "&allow-other-keys")) ; Skip.
+ ;; Back to index 0 in ARG1 ARG2 ARG2 ARG3 etc...
+ ;; like in `setq'.
+ ((or (and (string-match-p "\\.\\.\\.\\'" argument)
+ (string= argument (car (last args-lst))))
+ (and (string-match-p "\\.\\.\\.\\'"
+ (substring args 1 (1- (length args))))
+ (= (length (remove "..." args-lst)) 2)
+ (> index 1) (eq (logand index 1) 1)))
+ (setq index 0))
+ (t
+ (setq index (1- index))))))
+ (setq end (length args)
+ start (1- end)
+ argument-face 'font-lock-warning-face
+ index 0)))
+ (let ((doc args))
+ (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
+;; the variable.
+(defun elisp-get-var-docstring (sym)
+ (cond ((not sym) nil)
+ ((and (eq sym (aref elisp--eldoc-last-data 0))
+ (eq 'variable (aref elisp--eldoc-last-data 2)))
+ (aref elisp--eldoc-last-data 1))
+ (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)))
+ (elisp--last-data-store sym doc 'variable)))))))
+
+(defun elisp--last-data-store (symbol doc type)
+ (aset elisp--eldoc-last-data 0 symbol)
+ (aset elisp--eldoc-last-data 1 doc)
+ (aset elisp--eldoc-last-data 2 type)
+ doc)
+
+;; Note that any leading `*' in the docstring (which indicates the variable
+;; is a user option) is removed.
+(defun elisp--docstring-first-line (doc)
+ (and (stringp doc)
+ (substitute-command-keys
+ (save-match-data
+ ;; Don't use "^" in the regexp below since it may match
+ ;; anywhere in the doc-string.
+ (let ((start (if (string-match "\\`\\*" doc) (match-end 0) 0)))
+ (cond ((string-match "\n" doc)
+ (substring doc start (match-beginning 0)))
+ ((zerop start) doc)
+ (t (substring doc start))))))))
+
+;; Return a list of current function name and argument index.
+(defun elisp--fnsym-in-current-sexp ()
+ (save-excursion
+ (let ((argument-index (1- (elisp--beginning-of-sexp))))
+ ;; If we are at the beginning of function name, this will be -1.
+ (when (< argument-index 0)
+ (setq argument-index 0))
+ ;; Don't do anything if current word is inside a string.
+ (if (= (or (char-after (1- (point))) 0) ?\")
+ nil
+ (list (elisp--current-symbol) argument-index)))))
+
+;; Move to the beginning of current sexp. Return the number of nested
+;; sexp the point was over or after.
+(defun elisp--beginning-of-sexp ()
+ (let ((parse-sexp-ignore-comments t)
+ (num-skipped-sexps 0))
+ (condition-case _
+ (progn
+ ;; First account for the case the point is directly over a
+ ;; beginning of a nested sexp.
+ (condition-case _
+ (let ((p (point)))
+ (forward-sexp -1)
+ (forward-sexp 1)
+ (when (< (point) p)
+ (setq num-skipped-sexps 1)))
+ (error))
+ (while
+ (let ((p (point)))
+ (forward-sexp -1)
+ (when (< (point) p)
+ (setq num-skipped-sexps (1+ num-skipped-sexps))))))
+ (error))
+ num-skipped-sexps))
+
+;; returns nil unless current word is an interned symbol.
+(defun elisp--current-symbol ()
+ (let ((c (char-after (point))))
+ (and c
+ (memq (char-syntax c) '(?w ?_))
+ (intern-soft (current-word)))))
+
+(defun elisp-function-argstring (arglist)
+ "Return ARGLIST as a string enclosed by ().
+ARGLIST is either a string, or a list of strings or symbols."
+ (let ((str (cond ((stringp arglist) arglist)
+ ((not (listp arglist)) nil)
+ (t (help--make-usage-docstring 'toto arglist)))))
+ (if (and str (string-match "\\`([^ )]+ ?" str))
+ (replace-match "(" t t str)
+ str)))
+
+(provide 'elisp-mode)
+;;; elisp-mode.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index a7b7e630bb9..0d5fc3a3cd3 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,10 +1,10 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2013 Free
+;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2015 Free
;; Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tools
;; This file is part of GNU Emacs.
@@ -28,6 +28,7 @@
(require 'ring)
(require 'button)
+(require 'xref)
;;;###autoload
(defvar tags-file-name nil
@@ -141,11 +142,8 @@ Otherwise, `find-tag-default' is used."
:group 'etags
:type '(choice (const nil) function))
-(defcustom find-tag-marker-ring-length 16
- "Length of marker rings `find-tag-marker-ring' and `tags-location-ring'."
- :group 'etags
- :type 'integer
- :version "20.3")
+(define-obsolete-variable-alias 'find-tag-marker-ring-length
+ 'xref-marker-ring-length "25.1")
(defcustom tags-tag-face 'default
"Face for tags in the output of `tags-apropos'."
@@ -173,7 +171,7 @@ is the symbol being selected.
Example value:
- '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
+ ((\"Emacs Lisp\" Info-goto-emacs-command-node obarray)
(\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray)
(\"SCWM\" scwm-documentation scwm-obarray))"
:group 'etags
@@ -182,15 +180,18 @@ Example value:
(sexp :tag "Tags to search")))
:version "21.1")
-(defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length)
- "Ring of markers which are locations from which \\[find-tag] was invoked.")
+(defvaralias 'find-tag-marker-ring 'xref--marker-ring)
+(make-obsolete-variable
+ 'find-tag-marker-ring
+ "use `xref-push-marker-stack' or `xref-pop-marker-stack' instead."
+ "25.1")
(defvar default-tags-table-function nil
"If non-nil, a function to choose a default tags file for a buffer.
This function receives no arguments and should return the default
tags table file to use for the current buffer.")
-(defvar tags-location-ring (make-ring find-tag-marker-ring-length)
+(defvar tags-location-ring (make-ring xref-marker-ring-length)
"Ring of markers which are locations visited by \\[find-tag].
Pop back to the last location with \\[negative-argument] \\[find-tag].")
@@ -203,7 +204,7 @@ nil means it has not yet been computed;
use function `tags-table-files' to do so.")
(defvar tags-completion-table nil
- "Obarray of tag names defined in current tags table.")
+ "List of tag names defined in current tags table.")
(defvar tags-included-tables nil
"List of tags tables included by the current tags table.")
@@ -307,7 +308,7 @@ file the tag was in."
(save-excursion
(or (visit-tags-table-buffer file)
(signal 'file-error (list "Visiting tags table"
- "file does not exist"
+ "No such file or directory"
file)))
;; Set FILE to the expanded name.
(setq file tags-file-name)))
@@ -713,15 +714,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
(interactive)
;; Clear out the markers we are throwing away.
(let ((i 0))
- (while (< i find-tag-marker-ring-length)
+ (while (< i xref-marker-ring-length)
(if (aref (cddr tags-location-ring) i)
(set-marker (aref (cddr tags-location-ring) i) nil))
- (if (aref (cddr find-tag-marker-ring) i)
- (set-marker (aref (cddr find-tag-marker-ring) i) nil))
(setq i (1+ i))))
+ (xref-clear-marker-stack)
(setq tags-file-name nil
- tags-location-ring (make-ring find-tag-marker-ring-length)
- find-tag-marker-ring (make-ring find-tag-marker-ring-length)
+ tags-location-ring (make-ring xref-marker-ring-length)
tags-table-list nil
tags-table-computed-list nil
tags-table-computed-list-for nil
@@ -760,26 +759,23 @@ tags table and its (recursively) included tags tables."
(or tags-completion-table
;; No cached value for this buffer.
(condition-case ()
- (let (current-table combined-table)
+ (let (tables cont)
(message "Making tags completion table for %s..." buffer-file-name)
(save-excursion
;; Iterate over the current list of tags tables.
- (while (visit-tags-table-buffer (and combined-table t))
+ (while (visit-tags-table-buffer cont)
;; Find possible completions in this table.
- (setq current-table (funcall tags-completion-table-function))
- ;; Merge this buffer's completions into the combined table.
- (if combined-table
- (mapatoms
- (lambda (sym) (intern (symbol-name sym) combined-table))
- current-table)
- (setq combined-table current-table))))
+ (push (funcall tags-completion-table-function) tables)
+ (setq cont t)))
(message "Making tags completion table for %s...done"
buffer-file-name)
;; Cache the result in a buffer-local variable.
- (setq tags-completion-table combined-table))
+ (setq tags-completion-table
+ (nreverse (delete-dups (apply #'nconc tables)))))
(quit (message "Tags completion table construction aborted.")
(setq tags-completion-table nil)))))
+;;;###autoload
(defun tags-lazy-completion-table ()
(let ((buf (current-buffer)))
(lambda (string pred action)
@@ -805,15 +801,16 @@ If no tags table is loaded, do nothing and return nil."
case-fold-search))
(pattern (funcall (or find-tag-default-function
(get major-mode 'find-tag-default-function)
- 'find-tag-default)))
+ #'find-tag-default)))
beg)
(when pattern
(save-excursion
(forward-char (1- (length pattern)))
- (search-backward pattern)
- (setq beg (point))
- (forward-char (length pattern))
- (list beg (point) (tags-lazy-completion-table) :exclusive 'no))))))
+ ;; The find-tag function might be overly optimistic.
+ (when (search-backward pattern nil t)
+ (setq beg (point))
+ (forward-char (length pattern))
+ (list beg (point) (tags-lazy-completion-table) :exclusive 'no)))))))
(defun find-tag-tag (string)
"Read a tag name, with defaulting and completion."
@@ -898,7 +895,7 @@ See documentation of variable `tags-file-name'."
;; Run the user's hook. Do we really want to do this for pop?
(run-hooks 'local-find-tag-hook))))
;; Record whence we came.
- (ring-insert find-tag-marker-ring (point-marker))
+ (xref-push-marker-stack)
(if (and next-p last-tag)
;; Find the same table we last used.
(visit-tags-table-buffer 'same)
@@ -947,6 +944,7 @@ onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
+ (declare (obsolete xref-find-definitions "25.1"))
(interactive (find-tag-interactive "Find tag: "))
(let* ((buf (find-tag-noselect tagname next-p regexp-p))
(pos (with-current-buffer buf (point))))
@@ -954,7 +952,6 @@ See documentation of variable `tags-file-name'."
(switch-to-buffer buf)
(error (pop-to-buffer buf)))
(goto-char pos)))
-;;;###autoload (define-key esc-map "." 'find-tag)
;;;###autoload
(defun find-tag-other-window (tagname &optional next-p regexp-p)
@@ -976,6 +973,7 @@ onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
+ (declare (obsolete xref-find-definitions-other-window "25.1"))
(interactive (find-tag-interactive "Find tag other window: "))
;; This hair is to deal with the case where the tag is found in the
@@ -995,7 +993,6 @@ See documentation of variable `tags-file-name'."
;; the window's point from the buffer.
(set-window-point (selected-window) tagpoint))
window-point)))
-;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
;;;###autoload
(defun find-tag-other-frame (tagname &optional next-p)
@@ -1017,10 +1014,10 @@ onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
+ (declare (obsolete xref-find-definitions-other-frame "25.1"))
(interactive (find-tag-interactive "Find tag other frame: "))
(let ((pop-up-frames t))
(find-tag-other-window tagname next-p)))
-;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
;;;###autoload
(defun find-tag-regexp (regexp &optional next-p other-window)
@@ -1040,29 +1037,15 @@ onto a ring and may be popped back to with \\[pop-tag-mark].
Contrast this with the ring of marks gone to by the command.
See documentation of variable `tags-file-name'."
+ (declare (obsolete xref-find-apropos "25.1"))
(interactive (find-tag-interactive "Find tag regexp: " t))
;; We go through find-tag-other-window to do all the display hair there.
(funcall (if other-window 'find-tag-other-window 'find-tag)
regexp next-p t))
-;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
-
-;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
;;;###autoload
-(defun pop-tag-mark ()
- "Pop back to where \\[find-tag] was last invoked.
+(defalias 'pop-tag-mark 'xref-pop-marker-stack)
-This is distinct from invoking \\[find-tag] with a negative argument
-since that pops a stack of markers at which tags were found, not from
-where they were found."
- (interactive)
- (if (ring-empty-p find-tag-marker-ring)
- (error "No previous locations for find-tag invocation"))
- (let ((marker (ring-remove find-tag-marker-ring 0)))
- (switch-to-buffer (or (marker-buffer marker)
- (error "The marked buffer has been deleted")))
- (goto-char (marker-position marker))
- (set-marker marker nil nil)))
(defvar tag-lines-already-matched nil
"Matches remembered between calls.") ; Doc string: calls to what?
@@ -1269,7 +1252,7 @@ buffer-local values of tags table format variables."
(defun etags-tags-completion-table () ; Doc string?
- (let ((table (make-vector 511 0))
+ (let (table
(progress-reporter
(make-progress-reporter
(format "Making tags completion table for %s..." buffer-file-name)
@@ -1285,11 +1268,11 @@ buffer-local values of tags table format variables."
;; \6 is the line to start searching at;
;; \7 is the char to start searching at.
(while (re-search-forward
- "^\\(\\([^\177]+[^-a-zA-Z0-9_+*$:\177]+\\)?\
+ "^\\(\\([^\177]*[^-a-zA-Z0-9_+*$:\177]+\\)?\
\\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\
\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n"
nil t)
- (intern (prog1 (if (match-beginning 5)
+ (push (prog1 (if (match-beginning 5)
;; There is an explicit tag name.
(buffer-substring (match-beginning 5) (match-end 5))
;; No explicit tag name. Best guess.
@@ -1368,9 +1351,16 @@ hits the start of file."
pat (concat (if (eq selective-display t)
"\\(^\\|\^m\\)" "^")
(regexp-quote (car tag-info))))
- ;; The character position in the tags table is 0-origin.
+ ;; The character position in the tags table is 0-origin and counts CRs.
;; Convert it to a 1-origin Emacs character position.
- (if startpos (setq startpos (1+ startpos)))
+ (when startpos
+ (setq startpos (1+ startpos))
+ (when (and line
+ (eq 1 (coding-system-eol-type buffer-file-coding-system)))
+ ;; Act as if CRs were elided from all preceding lines.
+ ;; Although this doesn't always give exactly the correct position,
+ ;; it does typically improve the guess.
+ (setq startpos (- startpos (1- line)))))
;; If no char pos was given, try the given line number.
(or startpos
(if line
@@ -1469,7 +1459,7 @@ hits the start of file."
(when (symbolp symbs)
(if (boundp symbs)
(setq symbs (symbol-value symbs))
- (insert "symbol `" (symbol-name symbs) "' has no value\n")
+ (insert (format-message "symbol `%s' has no value\n" symbs))
(setq symbs nil)))
(if (vectorp symbs)
(mapatoms ins-symb symbs)
@@ -1479,13 +1469,13 @@ hits the start of file."
(defun etags-tags-apropos (string) ; Doc string?
(when tags-apropos-verbose
- (princ "Tags in file `")
+ (princ (substitute-command-keys "Tags in file `"))
(tags-with-face 'highlight (princ buffer-file-name))
- (princ "':\n\n"))
+ (princ (substitute-command-keys "':\n\n")))
(goto-char (point-min))
(let ((progress-reporter (make-progress-reporter
- (format "Making tags apropos buffer for `%s'..."
- string)
+ (format-message
+ "Making tags apropos buffer for `%s'..." string)
(point-min) (point-max))))
(while (re-search-forward string nil t)
(progress-reporter-update progress-reporter (point))
@@ -1638,7 +1628,8 @@ Point should be just after a string that matches TAG."
;; Look at the comment of the make_tag function in lib-src/etags.c for
;; a textual description of the four rules.
(and (string-match "^[^ \t()=,;]+$" tag) ;rule #1
- (looking-at "[ \t()=,;]?\177") ;rules #2 and #4
+ ;; Rules #2 and #4, and a check that there's no explicit name.
+ (looking-at "[ \t()=,;]?\177\\(?:[0-9]+\\)?,\\(?:[0-9]+\\)?$")
(save-excursion
(backward-char (1+ (length tag)))
(looking-at "[\n \t()=,;]")))) ;rule #3
@@ -1763,7 +1754,7 @@ if the file was newly read in, the value is the filename."
(with-current-buffer buffer
(revert-buffer t t)))
(if (not (and new novisit))
- (find-file next novisit)
+ (find-file next)
;; Like find-file, but avoids random warning messages.
(switch-to-buffer (get-buffer-create " *next-file*"))
(kill-all-local-variables)
@@ -1781,7 +1772,7 @@ if the file was newly read in, the value is the filename."
"No \\[tags-search] or \\[tags-query-replace] in progress"))
"Form for `tags-loop-continue' to eval to scan one file.
If it returns non-nil, this file needs processing by evalling
-\`tags-loop-operate'. Otherwise, move on to the next file.")
+`tags-loop-operate'. Otherwise, move on to the next file.")
(defun tags-loop-eval (form)
"Evaluate FORM and return its result.
@@ -1804,6 +1795,7 @@ Two variables control the processing we do on each file: the value of
interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
evaluate to operate on an interesting file. If the latter evaluates to
nil, we exit; otherwise we scan the next file."
+ (declare (obsolete "use `xref-find-definitions' interface instead." "25.1"))
(interactive)
(let (new
;; Non-nil means we have finished one file
@@ -1854,12 +1846,13 @@ nil, we exit; otherwise we scan the next file."
;; Now operate on the file.
;; If value is non-nil, continue to scan the next file.
- (tags-loop-eval tags-loop-operate))
+ (save-restriction
+ (widen)
+ (tags-loop-eval tags-loop-operate)))
(setq file-finished t))
(and messaged
(null tags-loop-operate)
(message "Scanning file %s...found" buffer-file-name))))
-;;;###autoload (define-key esc-map "," 'tags-loop-continue)
;;;###autoload
(defun tags-search (regexp &optional file-list-form)
@@ -1927,9 +1920,9 @@ directory specification."
'tags-complete-tags-table-file
nil t nil)))
(with-output-to-temp-buffer "*Tags List*"
- (princ "Tags in file `")
+ (princ (substitute-command-keys "Tags in file `"))
(tags-with-face 'highlight (princ file))
- (princ "':\n\n")
+ (princ (substitute-command-keys "':\n\n"))
(save-excursion
(let ((first-time t)
(gotany nil))
@@ -1948,11 +1941,13 @@ directory specification."
;;;###autoload
(defun tags-apropos (regexp)
"Display list of all tags in tags table REGEXP matches."
+ (declare (obsolete xref-find-apropos "25.1"))
(interactive "sTags apropos (regexp): ")
(with-output-to-temp-buffer "*Tags List*"
- (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `")
+ (princ (substitute-command-keys
+ "Click mouse-2 to follow tags.\n\nTags matching regexp `"))
(tags-with-face 'highlight (princ regexp))
- (princ "':\n\n")
+ (princ (substitute-command-keys "':\n\n"))
(save-excursion
(let ((first-time t))
(while (visit-tags-table-buffer (not first-time))
@@ -2077,6 +2072,91 @@ for \\[find-tag] (which see)."
(completion-in-region (car comp-data) (cadr comp-data)
(nth 2 comp-data)
(plist-get (nthcdr 3 comp-data) :predicate)))))
+
+
+;;; Xref backend
+
+;; Stop searching if we find more than xref-limit matches, as the xref
+;; infrastructure is not designed to handle very long lists.
+;; Switching to some kind of lazy list might be better, but hopefully
+;; we hit the limit rarely.
+(defconst etags--xref-limit 1000)
+
+(defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p
+ tag-implicit-name-match-p)
+ "Tag order used in `etags-xref-find' to look for definitions.")
+
+;;;###autoload
+(defun etags-xref-find (action id)
+ (pcase action
+ (`definitions (etags--xref-find-definitions id))
+ (`references (etags--xref-find-references id))
+ (`apropos (etags--xref-find-definitions id t))))
+
+(defun etags--xref-find-references (symbol)
+ ;; TODO: Merge together with the Elisp impl.
+ (cl-mapcan
+ (lambda (dir)
+ (xref-collect-references symbol dir))
+ (project-search-path (project-current))))
+
+(defun etags--xref-find-definitions (pattern &optional regexp?)
+ ;; This emulates the behaviour of `find-tag-in-order' but instead of
+ ;; returning one match at a time all matches are returned as list.
+ ;; NOTE: find-tag-tag-order is typically a buffer-local variable.
+ (let* ((xrefs '())
+ (first-time t)
+ (search-fun (if regexp? #'re-search-forward #'search-forward))
+ (marks (make-hash-table :test 'equal))
+ (case-fold-search (if (memq tags-case-fold-search '(nil t))
+ tags-case-fold-search
+ case-fold-search)))
+ (save-excursion
+ (while (visit-tags-table-buffer (not first-time))
+ (setq first-time nil)
+ (dolist (order-fun (cond (regexp? find-tag-regexp-tag-order)
+ (t etags-xref-find-definitions-tag-order)))
+ (goto-char (point-min))
+ (while (and (funcall search-fun pattern nil t)
+ (< (hash-table-count marks) etags--xref-limit))
+ (when (funcall order-fun pattern)
+ (beginning-of-line)
+ (pcase-let* ((tag-info (etags-snarf-tag))
+ (`(,hint ,line . _) tag-info))
+ (unless (eq hint t) ; hint==t if we are in a filename line
+ (let* ((file (file-of-tag))
+ (mark-key (cons file line)))
+ (unless (gethash mark-key marks)
+ (let ((loc (xref-make-etags-location
+ tag-info (expand-file-name file))))
+ (push (xref-make hint loc) xrefs)
+ (puthash mark-key t marks)))))))))))
+ (nreverse xrefs)))
+
+(defclass xref-etags-location (xref-location)
+ ((tag-info :type list :initarg :tag-info)
+ (file :type string :initarg :file
+ :reader xref-location-group))
+ :documentation "Location of an etags tag.")
+
+(defun xref-make-etags-location (tag-info file)
+ (make-instance 'xref-etags-location :tag-info tag-info
+ :file (expand-file-name file)))
+
+(cl-defmethod xref-location-marker ((l xref-etags-location))
+ (with-slots (tag-info file) l
+ (let ((buffer (find-file-noselect file)))
+ (with-current-buffer buffer
+ (etags-goto-tag-location tag-info)
+ (point-marker)))))
+
+(cl-defmethod xref-location-line ((l xref-etags-location))
+ (with-slots (tag-info) l
+ (nth 1 tag-info)))
+
+(defun etags-search-path ()
+ (mapcar #'file-name-directory tags-table-list))
+
(provide 'etags)
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index a305393c7d8..b057fa68471 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -1,6 +1,6 @@
;;; executable.el --- base functionality for executable interpreter scripts -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1994-1996, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2015 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: languages, unix
@@ -104,11 +104,13 @@ Typical values are 73 (+x) or -493 (rwxr-xr-x)."
(defvar executable-command nil)
(defcustom executable-self-display "tail"
- "Command you use with argument `+2' to make text files self-display.
+ "Command you use with argument `-n+2' to make text files self-display.
Note that the like of `more' doesn't work too well under Emacs \\[shell]."
:type 'string
:group 'executable)
+(make-obsolete-variable 'executable-self-display nil "25.1" 'set)
+
(defvar executable-font-lock-keywords
'(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t))
@@ -238,8 +240,9 @@ executable."
(save-window-excursion
;; Make buffer visible before question.
(switch-to-buffer (current-buffer))
- (y-or-n-p (concat "Replace magic number by `"
- executable-prefix argument "'? "))))
+ (y-or-n-p (format-message
+ "Replace magic number by `%s%s'? "
+ executable-prefix argument))))
(progn
(replace-match argument t t nil 1)
(message "Magic number changed to `%s'"
@@ -251,14 +254,14 @@ executable."
-;;;###autoload
(defun executable-self-display ()
"Turn a text file into a self-displaying Un*x command.
The magic number of such a command displays all lines but itself."
+ (declare (obsolete nil "25.1"))
(interactive)
(if (eq this-command 'executable-self-display)
(setq this-command 'executable-set-magic))
- (executable-set-magic executable-self-display "+2"))
+ (executable-set-magic executable-self-display "-n+2"))
;;;###autoload
(defun executable-make-buffer-file-executable-if-script-p ()
@@ -269,16 +272,15 @@ file modes."
(save-restriction
(widen)
(string= "#!" (buffer-substring (point-min) (+ 2 (point-min)))))
- (condition-case nil
- (let* ((current-mode (file-modes (buffer-file-name)))
- (add-mode (logand ?\111 (default-file-modes))))
- (or (/= (logand ?\111 current-mode) 0)
- (zerop add-mode)
- (set-file-modes (buffer-file-name)
- (logior current-mode add-mode))))
- ;; Eg file-modes can return nil (bug#9879). It should not,
- ;; in this context, but we should handle it all the same.
- (error (message "Unable to make file executable")))))
+ ;; Eg file-modes can return nil (bug#9879). It should not,
+ ;; in this context, but we should handle it all the same.
+ (with-demoted-errors "Unable to make file executable: %s"
+ (let* ((current-mode (file-modes (buffer-file-name)))
+ (add-mode (logand ?\111 (default-file-modes))))
+ (or (/= (logand ?\111 current-mode) 0)
+ (zerop add-mode)
+ (set-file-modes (buffer-file-name)
+ (logior current-mode add-mode)))))))
(provide 'executable)
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index 80f663360e4..5c938fd1a93 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -1,6 +1,6 @@
;;; f90.el --- Fortran-90 mode (free format) -*- lexical-binding: t -*-
-;; Copyright (C) 1995-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Torbjörn Einarsson <Torbjorn.Einarsson@era.ericsson.se>
;; Maintainer: Glenn Morris <rgm@gnu.org>
@@ -71,8 +71,8 @@
;; For example:
;; (add-to-list 'auto-mode-alist '("\\.f\\'" . f90-mode))
-;; Once you have entered f90-mode, you may get more info by using
-;; the command describe-mode (C-h m). For online help use
+;; Once you have entered f90-mode, you can get more info by using
+;; the command describe-mode (C-h m). For help use
;; C-h f <Name of function you want described>, or
;; C-h v <Name of variable you want described>.
@@ -240,7 +240,7 @@
:group 'f90-indent)
(defcustom f90-beginning-ampersand t
- "Non-nil gives automatic insertion of \& at start of continuation line."
+ "Non-nil gives automatic insertion of `&' at start of continuation line."
:type 'boolean
:safe 'booleanp
:group 'f90)
@@ -342,8 +342,10 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
"final" "generic" "import" "non_intrinsic" "non_overridable"
"nopass" "pass" "protected" "same_type_as" "value" "volatile"
;; F2008.
+ ;; FIXME f90-change-keywords does not work right if
+ ;; there are spaces.
"contiguous" "submodule" "concurrent" "codimension"
- "sync all" "sync memory" "critical" "image_index"
+ "sync all" "sync memory" "critical" "image_index" "error stop"
))
"\\_>")
"Regexp used by the function `f90-change-keywords'.")
@@ -417,6 +419,8 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil."
"norm2" "parity" "findloc" "is_contiguous"
"sync images" "lock" "unlock" "image_index"
"lcobound" "ucobound" "num_images" "this_image"
+ "acosh" "asinh" "atanh"
+ "atomic_define" "atomic_ref" "execute_command_line"
;; F2008 iso_fortran_env module.
"compiler_options" "compiler_version"
;; F2008 iso_c_binding module.
@@ -645,11 +649,12 @@ forall\\|block\\|critical\\)\\)\\_>"
\\|enumerator\\|procedure\\|\
logical\\|double[ \t]*precision\\|type[ \t]*(\\(?:\\sw\\|\\s_\\)+)\\|none\\)[ \t]*"
(1 font-lock-keyword-face) (2 font-lock-type-face))
- '("\\_<\\(namelist\\|common\\)[ \t]*\/\\(\\(?:\\sw\\|\\s_\\)+\\)?\/"
+ '("\\_<\\(namelist\\|common\\)[ \t]*/\\(\\(?:\\sw\\|\\s_\\)+\\)?\/"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
"\\_<else\\([ \t]*if\\|where\\)?\\_>"
'("\\(&\\)[ \t]*\\(!\\|$\\)" (1 font-lock-keyword-face))
- "\\_<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\_>"
+ "\\_<\\(then\\|continue\\|format\\|include\\|\\(?:error[ \t]+\\)?stop\\|\
+return\\)\\_>"
'("\\_<\\(exit\\|cycle\\)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?\\_>"
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
'("\\_<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
@@ -830,7 +835,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
(font-lock-mode 1)
(setq font-lock-keywords
(symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n))))
- (font-lock-fontify-buffer))
+ (font-lock-flush))
(defun f90-font-lock-1 ()
"Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
@@ -893,11 +898,13 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
(defconst f90-type-def-re
;; type word
;; type :: word
- ;; type, stuff :: word
- ;; type, bind(c) :: word
+ ;; type, attr-list :: word
+ ;; where attr-list = attr [, attr ...]
+ ;; and attr may include bind(c) or extends(thing)
;; NOT "type ("
"\\_<\\(type\\)\\_>\\(?:\\(?:[^()\n]*\\|\
-.*,[ \t]*bind[ \t]*([ \t]*c[ \t]*)[ \t]*\\)::\\)?[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)"
+.*,[ \t]*\\(?:bind\\|extends\\)[ \t]*(.*).*\\)::\\)?\
+[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)"
"Regexp matching the definition of a derived type.")
(defconst f90-typeis-re
@@ -947,8 +954,8 @@ Used in the F90 entry in `hs-special-modes-alist'.")
;; and also variables of derived type "type (foo)".
;; "type, foo" must be a block (?).
"type[ \t,]\\("
- "[^i(!\n\"\& \t]\\|" ; not-i(
- "i[^s!\n\"\& \t]\\|" ; i not-s
+ "[^i(!\n\"& \t]\\|" ; not-i(
+ "i[^s!\n\"& \t]\\|" ; i not-s
"is\\(?:\\sw\\|\\s_\\)\\)\\|"
;; "abstract interface" is F2003; "submodule" is F2008.
"program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|"
@@ -985,9 +992,9 @@ Set subexpression 1 in the match-data to the name of the type."
found))
(defvar f90-imenu-generic-expression
- (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
- (not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")
- ;; (not-ib "[^i(!\n\"\& \t]") (not-s "[^s!\n\"\& \t]")
+ (let ((good-char "[^!\"&\n \t]") (not-e "[^e!\n\"& \t]")
+ (not-n "[^n!\n\"& \t]") (not-d "[^d!\n\"& \t]")
+ ;; (not-ib "[^i(!\n\"& \t]") (not-s "[^s!\n\"& \t]")
)
`((nil "^[ \t0-9]*program[ \t]+\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)
("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\
@@ -1008,7 +1015,7 @@ Set subexpression 1 in the match-data to the name of the type."
"\\("
;; At least three non-space characters before function/subroutine.
;; Check that the last three non-space characters do not spell E N D.
- "[^!\"\&\n]*\\("
+ "[^!\"&\n]*\\("
not-e good-char good-char "\\|"
good-char not-n good-char "\\|"
good-char good-char not-d "\\)"
@@ -1108,7 +1115,7 @@ For fixed format code, use `fortran-mode'.
indented line.
\\[f90-indent-subprogram] indents the current subprogram.
-Type `? or `\\[help-command] to display a list of built-in\
+Type \\=`? or \\=`\\[help-command] to display a list of built-in\
abbrevs for F90 keywords.
Key definitions:
@@ -1147,7 +1154,7 @@ Variables controlling indentation style and extra features:
Non-nil causes `f90-do-auto-fill' to break lines before delimiters
(default t).
`f90-beginning-ampersand'
- Automatic insertion of \& at beginning of continuation lines (default t).
+ Automatic insertion of `&' at beginning of continuation lines (default t).
`f90-smart-end'
From an END statement, check and fill the end using matching block start.
Allowed values are `blink', `no-blink', and nil, which determine
@@ -1371,7 +1378,7 @@ write\\)[ \t]*([^)\n]*)")
((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>")
(list (match-string 1) (match-string 2)))
((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
- (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
+ (looking-at "[^!'\"&\n]*\\(function\\|subroutine\\)[ \t]+\
\\(\\(?:\\sw\\|\\s_\\)+\\)"))
(list (match-string 1) (match-string 2)))))
;; Following will match an un-named main program block; however
@@ -1418,7 +1425,7 @@ single - statement is not continued.
begin - current line is the first in a continued statement.
end - current line is the last in a continued statement
middle - current line is neither first nor last in a continued statement.
-Comment lines embedded amongst continued lines return 'middle."
+Comment lines embedded amongst continued lines return `middle'."
(let (pcont cont)
(save-excursion
(setq pcont (if (f90-previous-statement) (f90-line-continued))))
@@ -1445,7 +1452,7 @@ if all else fails."
(not (or (looking-at "end")
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\
-block\\|critical\\)\\_>")
+block\\|critical\\|enum\\)\\_>")
(looking-at "\\(program\\|\\(?:sub\\)?module\\|\
\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>")
(looking-at "\\(contains\\|\\(?:\\sw\\|\\s_\\)+[ \t]*:\\)")
@@ -1629,7 +1636,10 @@ Return (TYPE NAME), or nil if not found."
(re-search-backward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
- (cond ((setq matching-beg (f90-looking-at-program-block-start))
+ ;; 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)))))
@@ -1654,7 +1664,8 @@ Return (TYPE NAME), or nil if not found."
(re-search-forward f90-program-block-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
- (cond ((f90-looking-at-program-block-start)
+ (cond ((f90-in-string))
+ ((f90-looking-at-program-block-start)
(setq count (1+ count)))
((setq matching-end (f90-looking-at-program-block-end))
(setq count (1- count))))
@@ -2099,7 +2110,7 @@ Like `join-line', but handles F90 syntax."
(if arg (forward-line 1))
(when (eq (preceding-char) ?\n)
(skip-chars-forward " \t")
- (if (looking-at "\&") (delete-char 1))
+ (if (looking-at "&") (delete-char 1))
(beginning-of-line)
(delete-region (point) (1- (point)))
(skip-chars-backward " \t")
@@ -2194,8 +2205,12 @@ Leave point at the end of line."
(end-point (point))
(case-fold-search t)
matching-beg beg-name end-name beg-block end-block end-struct)
+ ;; Check if in string in case using non-standard feature where
+ ;; continued strings do not need "&" at start of continuations.
(when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
- (setq end-struct (f90-looking-at-program-block-end)))
+ (unless (f90-in-string)
+ (setq end-struct
+ (f90-looking-at-program-block-end))))
(setq end-block (car end-struct)
end-name (cadr end-struct))
(save-excursion
@@ -2254,12 +2269,12 @@ Leave point at the end of line."
;; Abbrevs and keywords.
(defun f90-abbrev-start ()
- "Typing `\\[help-command] or `? lists all the F90 abbrevs.
+ "Typing \\=`\\[help-command] or \\=`? lists all the F90 abbrevs.
Any other key combination is executed normally."
(interactive "*")
(self-insert-command 1)
(when abbrev-mode
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map [??] 'f90-abbrev-help)
(define-key map (vector help-char) 'f90-abbrev-help)
@@ -2338,6 +2353,8 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word."
(skip-chars-forward " \t0-9")
(looking-at "#"))))
(setq ref-point (point)
+ ;; FIXME this does not work for constructs with
+ ;; embedded space, eg "sync all".
back-point (save-excursion (backward-word 1) (point))
saveword (buffer-substring back-point ref-point))
(funcall change-word -1)
@@ -2357,7 +2374,7 @@ With optional argument ALL, change the default for all present
and future F90 buffers. F90 mode normally treats backslash as an
escape character."
(or (derived-mode-p 'f90-mode)
- (error "This function should only be used in F90 buffers"))
+ (user-error "This function should only be used in F90 buffers"))
(when (equal (char-syntax ?\\ ) ?\\ )
(or all (set-syntax-table (copy-syntax-table (syntax-table))))
(modify-syntax-entry ?\\ ".")))
@@ -2365,8 +2382,4 @@ escape character."
(provide 'f90)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; f90.el ends here
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 2ead734d163..3adadd1386e 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1,9 +1,9 @@
-;;; flymake.el --- a universal on-the-fly syntax checker
+;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*-
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
-;; Maintainer: Pavel Kobyakov <pk_at_work@yahoo.com>
+;; Maintainer: Leo Liu <sdl.web@gmail.com>
;; Version: 0.3
;; Keywords: c languages tools
@@ -24,9 +24,9 @@
;;; Commentary:
;;
-;; Flymake is a minor Emacs mode performing on-the-fly syntax
-;; checks using the external syntax check tool (for C/C++ this
-;; is usually the compiler)
+;; Flymake is a minor Emacs mode performing on-the-fly syntax checks
+;; using the external syntax check tool (for C/C++ this is usually the
+;; compiler).
;;; Bugs/todo:
@@ -36,188 +36,77 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(if (featurep 'xemacs) (require 'overlay))
-(defvar flymake-is-running nil
- "If t, flymake syntax check process is running for the current buffer.")
-(make-variable-buffer-local 'flymake-is-running)
+(defgroup flymake nil
+ "Universal on-the-fly syntax checker."
+ :version "23.1"
+ :link '(custom-manual "(flymake) Top")
+ :group 'tools)
-(defvar flymake-timer nil
- "Timer for starting syntax check.")
-(make-variable-buffer-local 'flymake-timer)
+(defcustom flymake-error-bitmap '(exclamation-mark error)
+ "Bitmap (a symbol) used in the fringe for indicating errors.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap. For possible bitmap
+symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
-(defvar flymake-last-change-time nil
- "Time of last buffer change.")
-(make-variable-buffer-local 'flymake-last-change-time)
+The option `flymake-fringe-indicator-position' controls how and where
+this is used."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (symbol :tag "Bitmap")
+ (list :tag "Bitmap and face"
+ (symbol :tag "Bitmap")
+ (face :tag "Face"))))
-(defvar flymake-check-start-time nil
- "Time at which syntax check was started.")
-(make-variable-buffer-local 'flymake-check-start-time)
+(defcustom flymake-warning-bitmap 'question-mark
+ "Bitmap (a symbol) used in the fringe for indicating warnings.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap. For possible bitmap
+symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
-(defvar flymake-check-was-interrupted nil
- "Non-nil if syntax check was killed by `flymake-compile'.")
-(make-variable-buffer-local 'flymake-check-was-interrupted)
+The option `flymake-fringe-indicator-position' controls how and where
+this is used."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (symbol :tag "Bitmap")
+ (list :tag "Bitmap and face"
+ (symbol :tag "Bitmap")
+ (face :tag "Face"))))
-(defvar flymake-err-info nil
- "Sorted list of line numbers and lists of err info in the form (file, err-text).")
-(make-variable-buffer-local 'flymake-err-info)
+(defcustom flymake-fringe-indicator-position 'left-fringe
+ "The position to put flymake fringe indicator.
+The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
+See `flymake-error-bitmap' and `flymake-warning-bitmap'."
+ :group 'flymake
+ :version "24.3"
+ :type '(choice (const left-fringe)
+ (const right-fringe)
+ (const :tag "No fringe indicators" nil)))
-(defvar flymake-new-err-info nil
- "Same as `flymake-err-info', effective when a syntax check is in progress.")
-(make-variable-buffer-local 'flymake-new-err-info)
-
-;;;; [[ cross-emacs compatibility routines
-(defsubst flymake-makehash (&optional test)
- "Create and return a new hash table using TEST to compare keys.
-It uses the function `make-hash-table' to make a hash-table if
-you use GNU Emacs, otherwise it uses `makehash'."
- (if (fboundp 'make-hash-table)
- (if test (make-hash-table :test test) (make-hash-table))
- (with-no-warnings
- (makehash test))))
-
-(defalias 'flymake-float-time
- (if (fboundp 'float-time)
- 'float-time
- (if (featurep 'xemacs)
- (lambda ()
- (multiple-value-bind (s0 s1 s2) (values-list (current-time))
- (+ (* (float (ash 1 16)) s0) (float s1) (* 0.0000001 s2)))))))
-
-(defalias 'flymake-replace-regexp-in-string
- (if (eval-when-compile (fboundp 'replace-regexp-in-string))
- 'replace-regexp-in-string
- (lambda (regexp rep str)
- (replace-in-string str regexp rep))))
-
-(defalias 'flymake-split-string
- (if (condition-case nil (equal (split-string " bc " " " t) '("bc"))
- (error nil))
- (lambda (str pattern) (split-string str pattern t))
- (lambda (str pattern)
- "Split STR into a list of substrings bounded by PATTERN.
-Zero-length substrings at the beginning and end of the list are omitted."
- (let ((split (split-string str pattern)))
- (while (equal (car split) "") (setq split (cdr split)))
- (setq split (nreverse split))
- (while (equal (car split) "") (setq split (cdr split)))
- (nreverse split)))))
-
-(defalias 'flymake-get-temp-dir
- (if (fboundp 'temp-directory)
- 'temp-directory
- (lambda () temporary-file-directory)))
-
-(defun flymake-posn-at-point-as-event (&optional position window dx dy)
- "Return pixel position of top left corner of glyph at POSITION.
-
-The position is relative to top left corner of WINDOW, as a
-mouse-1 click event (identical to the event that would be
-triggered by clicking mouse button 1 at the top left corner of
-the glyph).
-
-POSITION and WINDOW default to the position of point in the
-selected window.
-
-DX and DY specify optional offsets from the top left of the glyph."
- (unless window (setq window (selected-window)))
- (unless position (setq position (window-point window)))
- (unless dx (setq dx 0))
- (unless dy (setq dy 0))
-
- (let* ((pos (posn-at-point position window))
- (x-y (posn-x-y pos))
- (edges (window-inside-pixel-edges window))
- (win-x-y (window-pixel-edges window)))
- ;; adjust for window edges
- (setcar (nthcdr 2 pos)
- (cons (+ (car x-y) (car edges) (- (car win-x-y)) dx)
- (+ (cdr x-y) (cadr edges) (- (cadr win-x-y)) dy)))
- (list 'mouse-1 pos)))
-
-(defun flymake-popup-menu (menu-data)
- "Pop up the flymake menu at point, using the data MENU-DATA.
-POS is a list of the form ((X Y) WINDOW), where X and Y are
-pixels positions from the top left corner of WINDOW's frame.
-MENU-DATA is a list of error and warning messages returned by
-`flymake-make-err-menu-data'."
- (if (featurep 'xemacs)
- (let* ((pos (flymake-get-point-pixel-pos))
- (x-pos (nth 0 pos))
- (y-pos (nth 1 pos))
- (fake-event-props '(button 1 x 1 y 1)))
- (setq fake-event-props (plist-put fake-event-props 'x x-pos))
- (setq fake-event-props (plist-put fake-event-props 'y y-pos))
- (popup-menu (flymake-make-xemacs-menu menu-data)
- (make-event 'button-press fake-event-props)))
- (x-popup-menu (if (eval-when-compile (fboundp 'posn-at-point))
- (flymake-posn-at-point-as-event)
- (list (flymake-get-point-pixel-pos) (selected-window)))
- (flymake-make-emacs-menu menu-data))))
-
-(defun flymake-make-emacs-menu (menu-data)
- "Return a menu specifier using MENU-DATA.
-MENU-DATA is a list of error and warning messages returned by
-`flymake-make-err-menu-data'.
-See `x-popup-menu' for the menu specifier format."
- (let* ((menu-title (nth 0 menu-data))
- (menu-items (nth 1 menu-data))
- (menu-commands (mapcar (lambda (foo)
- (cons (nth 0 foo) (nth 1 foo)))
- menu-items)))
- (list menu-title (cons "" menu-commands))))
-
-(if (featurep 'xemacs) (progn
-
-(defun flymake-nop ()
- "Do nothing."
- nil)
-
-(defun flymake-make-xemacs-menu (menu-data)
- "Return a menu specifier using MENU-DATA."
- (let* ((menu-title (nth 0 menu-data))
- (menu-items (nth 1 menu-data))
- (menu-commands nil))
- (setq menu-commands (mapcar (lambda (foo)
- (vector (nth 0 foo) (or (nth 1 foo) '(flymake-nop)) t))
- menu-items))
- (cons menu-title menu-commands)))
-
-)) ;; xemacs
-
-(unless (eval-when-compile (fboundp 'posn-at-point))
-
-(defun flymake-current-row ()
- "Return current row number in current frame."
- (if (fboundp 'window-edges)
- (+ (car (cdr (window-edges))) (count-lines (window-start) (point)))
- (count-lines (window-start) (point))))
-
-(defun flymake-selected-frame ()
- "Return the frame that is now selected."
- (if (fboundp 'window-edges)
- (selected-frame)
- (selected-window)))
-
-(defun flymake-get-point-pixel-pos ()
- "Return point position in pixels: (x, y)."
- (let ((mouse-pos (mouse-position))
- (pixel-pos nil)
- (ret nil))
- (if (car (cdr mouse-pos))
- (progn
- (set-mouse-position (flymake-selected-frame) (current-column) (flymake-current-row))
- (setq pixel-pos (mouse-pixel-position))
- (set-mouse-position (car mouse-pos) (car (cdr mouse-pos)) (cdr (cdr mouse-pos)))
- (setq ret (list (car (cdr pixel-pos)) (cdr (cdr pixel-pos)))))
- (progn
- (setq ret '(0 0))))
- (flymake-log 3 "mouse pos is %s" ret)
- ret))
+(defcustom flymake-compilation-prevents-syntax-check t
+ "If non-nil, don't start syntax check if compilation is running."
+ :group 'flymake
+ :type 'boolean)
+
+(defcustom flymake-start-syntax-check-on-newline t
+ "Start syntax check if newline char was added/removed from the buffer."
+ :group 'flymake
+ :type 'boolean)
+
+(defcustom flymake-no-changes-timeout 0.5
+ "Time to wait after last change before starting compilation."
+ :group 'flymake
+ :type 'number)
-) ;; End of (unless (fboundp 'posn-at-point)
+(defcustom flymake-gui-warnings-enabled t
+ "Enables/disables GUI warnings."
+ :group 'flymake
+ :type 'boolean)
-;;;; ]]
+(defcustom flymake-start-syntax-check-on-find-file t
+ "Start syntax check on find file."
+ :group 'flymake
+ :type 'boolean)
(defcustom flymake-log-level -1
"Logging level, only messages with level lower or equal will be logged.
@@ -225,55 +114,6 @@ See `x-popup-menu' for the menu specifier format."
:group 'flymake
:type 'integer)
-
-;; (defcustom flymake-log-file-name "~/flymake.log"
-;; "Where to put the flymake log if logging is enabled.
-;;
-;; See `flymake-log-level' if you want to control what is logged."
-;; :group 'flymake
-;; :type 'string)
-
-(defun flymake-log (level text &rest args)
- "Log a message at level LEVEL.
-If LEVEL is higher than `flymake-log-level', the message is
-ignored. Otherwise, it is printed using `message'.
-TEXT is a format control string, and the remaining arguments ARGS
-are the string substitutions (see the function `format')."
- (if (<= level flymake-log-level)
- (let* ((msg (apply 'format text args)))
- (message "%s" msg)
- ;;(with-temp-buffer
- ;; (insert msg)
- ;; (insert "\n")
- ;; (flymake-save-buffer-in-file "~/flymake.log") ; make log file name customizable
- ;;)
- )))
-
-(defun flymake-ins-after (list pos val)
- "Insert VAL into LIST after position POS.
-POS counts from zero."
- (let ((tmp (copy-sequence list)))
- (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
- tmp))
-
-(defun flymake-set-at (list pos val)
- "Set VAL at position POS in LIST.
-POS counts from zero."
- (let ((tmp (copy-sequence list)))
- (setcar (nthcdr pos tmp) val)
- tmp))
-
-(defvar flymake-processes nil
- "List of currently active flymake processes.")
-
-(defvar flymake-output-residual nil)
-(make-variable-buffer-local 'flymake-output-residual)
-
-(defgroup flymake nil
- "Universal on-the-fly syntax checker."
- :version "23.1"
- :group 'tools)
-
(defcustom flymake-xml-program
(if (executable-find "xmlstarlet") "xmlstarlet" "xml")
"Program to use for XML validation."
@@ -281,6 +121,16 @@ POS counts from zero."
:group 'flymake
:version "24.4")
+(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest")
+ "Dirs where to look for master files."
+ :group 'flymake
+ :type '(repeat (string)))
+
+(defcustom flymake-master-file-count-limit 32
+ "Max number of master files to check."
+ :group 'flymake
+ :type 'integer)
+
(defcustom flymake-allowed-file-name-masks
'(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init)
("\\.xml\\'" flymake-xml-init)
@@ -322,6 +172,56 @@ NAME is the file name function to use, default `flymake-get-real-file-name'."
(const :tag "flymake-get-real-file-name" nil)
function))))
+(defvar-local flymake-is-running nil
+ "If t, flymake syntax check process is running for the current buffer.")
+
+(defvar-local flymake-timer nil
+ "Timer for starting syntax check.")
+
+(defvar-local flymake-last-change-time nil
+ "Time of last buffer change.")
+
+(defvar-local flymake-check-start-time nil
+ "Time at which syntax check was started.")
+
+(defvar-local flymake-check-was-interrupted nil
+ "Non-nil if syntax check was killed by `flymake-compile'.")
+
+(defvar-local flymake-err-info nil
+ "Sorted list of line numbers and lists of err info in the form (file, err-text).")
+
+(defvar-local flymake-new-err-info nil
+ "Same as `flymake-err-info', effective when a syntax check is in progress.")
+
+(defun flymake-log (level text &rest args)
+ "Log a message at level LEVEL.
+If LEVEL is higher than `flymake-log-level', the message is
+ignored. Otherwise, it is printed using `message'.
+TEXT is a format control string, and the remaining arguments ARGS
+are the string substitutions (see the function `format')."
+ (if (<= level flymake-log-level)
+ (let* ((msg (apply #'format-message text args)))
+ (message "%s" msg))))
+
+(defun flymake-ins-after (list pos val)
+ "Insert VAL into LIST after position POS.
+POS counts from zero."
+ (let ((tmp (copy-sequence list)))
+ (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
+ tmp))
+
+(defun flymake-set-at (list pos val)
+ "Set VAL at position POS in LIST.
+POS counts from zero."
+ (let ((tmp (copy-sequence list)))
+ (setcar (nthcdr pos tmp) val)
+ tmp))
+
+(defvar flymake-processes nil
+ "List of currently active flymake processes.")
+
+(defvar-local flymake-output-residual nil)
+
(defun flymake-get-file-name-mode-and-masks (file-name)
"Return the corresponding entry from `flymake-allowed-file-name-masks'."
(unless (stringp file-name)
@@ -353,10 +253,10 @@ Return nil if we cannot, non-nil if we can."
'flymake-simple-cleanup))
(defun flymake-get-real-file-name-function (file-name)
- (or (nth 4 (flymake-get-file-name-mode-and-masks file-name))
+ (or (nth 2 (flymake-get-file-name-mode-and-masks file-name))
'flymake-get-real-file-name))
-(defvar flymake-find-buildfile-cache (flymake-makehash 'equal))
+(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal))
(defun flymake-get-buildfile-from-cache (dir-name)
"Look up DIR-NAME in cache and return its associated value.
@@ -387,7 +287,7 @@ Return its file name if found, or nil if not found."
nil)))))
(defun flymake-fix-file-name (name)
- "Replace all occurrences of '\' with '/'."
+ "Replace all occurrences of `\\' with `/'."
(when name
(setq name (expand-file-name name))
(setq name (abbreviate-file-name name))
@@ -400,16 +300,6 @@ Return t if so, nil if not."
(equal (flymake-fix-file-name file-name-one)
(flymake-fix-file-name file-name-two)))
-(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest")
- "Dirs where to look for master files."
- :group 'flymake
- :type '(repeat (string)))
-
-(defcustom flymake-master-file-count-limit 32
- "Max number of master files to check."
- :group 'flymake
- :type 'integer)
-
;; This is bound dynamically to pass a parameter to a sort predicate below
(defvar flymake-included-file-name)
@@ -456,12 +346,9 @@ to the beginning of the list (File.h -> File.cpp moved to top)."
(file-name-base file-one))
(not (equal file-one file-two))))
-(defcustom flymake-check-file-limit 8192
+(defvar flymake-check-file-limit 8192
"Maximum number of chars to look at when checking possible master file.
-Nil means search the entire file."
- :group 'flymake
- :type '(choice (const :tag "No limit" nil)
- (integer :tag "Characters")))
+Nil means search the entire file.")
(defun flymake-check-patch-master-file-buffer
(master-file-temp-buffer
@@ -537,6 +424,7 @@ instead of reading master file from disk."
(flymake-log 2 "found master file %s" master-file-name))
found))
+;;; XXX: remove
(defun flymake-replace-region (beg end rep)
"Replace text in BUFFER in region (BEG END) with REP."
(save-excursion
@@ -622,16 +510,6 @@ Create parent directories as needed."
(write-region nil nil file-name nil 566)
(flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name))
-(defun flymake-save-string-to-file (file-name data)
- "Save string DATA to file FILE-NAME."
- (write-region data nil file-name nil 566))
-
-(defun flymake-read-file-to-string (file-name)
- "Read contents of file FILE-NAME and return as a string."
- (with-temp-buffer
- (insert-file-contents file-name)
- (buffer-substring (point-min) (point-max))))
-
(defun flymake-process-filter (process output)
"Parse OUTPUT and highlight error lines.
It's flymake process filter."
@@ -677,29 +555,31 @@ It's flymake process filter."
(setq flymake-is-running nil))))))))
(defun flymake-post-syntax-check (exit-status command)
- (setq flymake-err-info flymake-new-err-info)
- (setq flymake-new-err-info nil)
- (setq flymake-err-info
- (flymake-fix-line-numbers
- flymake-err-info 1 (flymake-count-lines)))
- (flymake-delete-own-overlays)
- (flymake-highlight-err-lines flymake-err-info)
- (let (err-count warn-count)
- (setq err-count (flymake-get-err-count flymake-err-info "e"))
- (setq warn-count (flymake-get-err-count flymake-err-info "w"))
- (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)"
- (buffer-name) err-count warn-count
- (- (flymake-float-time) flymake-check-start-time))
- (setq flymake-check-start-time nil)
-
- (if (and (equal 0 err-count) (equal 0 warn-count))
- (if (equal 0 exit-status)
- (flymake-report-status "" "") ; PASSED
- (if (not flymake-check-was-interrupted)
- (flymake-report-fatal-status "CFGERR"
- (format "Configuration error has occurred while running %s" command))
- (flymake-report-status nil ""))) ; "STOPPED"
- (flymake-report-status (format "%d/%d" err-count warn-count) ""))))
+ (save-restriction
+ (widen)
+ (setq flymake-err-info flymake-new-err-info)
+ (setq flymake-new-err-info nil)
+ (setq flymake-err-info
+ (flymake-fix-line-numbers
+ flymake-err-info 1 (count-lines (point-min) (point-max))))
+ (flymake-delete-own-overlays)
+ (flymake-highlight-err-lines flymake-err-info)
+ (let (err-count warn-count)
+ (setq err-count (flymake-get-err-count flymake-err-info "e"))
+ (setq warn-count (flymake-get-err-count flymake-err-info "w"))
+ (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)"
+ (buffer-name) err-count warn-count
+ (- (float-time) flymake-check-start-time))
+ (setq flymake-check-start-time nil)
+
+ (if (and (equal 0 err-count) (equal 0 warn-count))
+ (if (equal 0 exit-status)
+ (flymake-report-status "" "") ; PASSED
+ (if (not flymake-check-was-interrupted)
+ (flymake-report-fatal-status "CFGERR"
+ (format "Configuration error has occurred while running %s" command))
+ (flymake-report-status nil ""))) ; "STOPPED"
+ (flymake-report-status (format "%d/%d" err-count warn-count) "")))))
(defun flymake-parse-output-and-residual (output)
"Split OUTPUT into lines, merge in residual if necessary."
@@ -810,50 +690,10 @@ line number outside the file being compiled."
"Determine whether overlay OV was created by flymake."
(and (overlayp ov) (overlay-get ov 'flymake-overlay)))
-(defcustom flymake-error-bitmap '(exclamation-mark error)
- "Bitmap (a symbol) used in the fringe for indicating errors.
-The value may also be a list of two elements where the second
-element specifies the face for the bitmap. For possible bitmap
-symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
-
-The option `flymake-fringe-indicator-position' controls how and where
-this is used."
- :group 'flymake
- :version "24.3"
- :type '(choice (symbol :tag "Bitmap")
- (list :tag "Bitmap and face"
- (symbol :tag "Bitmap")
- (face :tag "Face"))))
-
-(defcustom flymake-warning-bitmap 'question-mark
- "Bitmap (a symbol) used in the fringe for indicating warnings.
-The value may also be a list of two elements where the second
-element specifies the face for the bitmap. For possible bitmap
-symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
-
-The option `flymake-fringe-indicator-position' controls how and where
-this is used."
- :group 'flymake
- :version "24.3"
- :type '(choice (symbol :tag "Bitmap")
- (list :tag "Bitmap and face"
- (symbol :tag "Bitmap")
- (face :tag "Face"))))
-
-(defcustom flymake-fringe-indicator-position 'left-fringe
- "The position to put flymake fringe indicator.
-The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
-See `flymake-error-bitmap' and `flymake-warning-bitmap'."
- :group 'flymake
- :version "24.3"
- :type '(choice (const left-fringe)
- (const right-fringe)
- (const :tag "No fringe indicators" nil)))
-
-(defun flymake-make-overlay (beg end tooltip-text face bitmap mouse-face)
+(defun flymake-make-overlay (beg end tooltip-text face bitmap)
"Allocate a flymake overlay in range BEG and END."
(when (not (flymake-region-has-flymake-overlays beg end))
- (let ((ov (make-overlay beg end nil t t))
+ (let ((ov (make-overlay beg end nil t))
(fringe (and flymake-fringe-indicator-position
(propertize "!" 'display
(cons flymake-fringe-indicator-position
@@ -861,7 +701,6 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'."
bitmap
(list bitmap)))))))
(overlay-put ov 'face face)
- (overlay-put ov 'mouse-face mouse-face)
(overlay-put ov 'help-echo tooltip-text)
(overlay-put ov 'flymake-overlay t)
(overlay-put ov 'priority 100)
@@ -913,42 +752,19 @@ Return t if it has at least one flymake overlay, nil if no overlay."
Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
(goto-char (point-min))
(forward-line (1- line-no))
- (let* ((line-beg (point-at-bol))
- (line-end (point-at-eol))
- (beg line-beg)
- (end line-end)
- (tooltip-text (flymake-ler-text (nth 0 line-err-info-list)))
- (face nil)
- (bitmap nil))
-
- (goto-char line-beg)
- (while (looking-at "[ \t]")
- (forward-char))
-
- (setq beg (point))
-
- (goto-char line-end)
- (while (and (looking-at "[ \t\r\n]") (> (point) 1))
- (backward-char))
-
- (setq end (1+ (point)))
-
- (when (<= end beg)
- (setq beg line-beg)
- (setq end line-end))
-
- (when (= end beg)
- (goto-char end)
- (forward-line)
- (setq end (point)))
-
- (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
- (setq face 'flymake-errline
- bitmap flymake-error-bitmap)
- (setq face 'flymake-warnline
- bitmap flymake-warning-bitmap))
-
- (flymake-make-overlay beg end tooltip-text face bitmap nil)))
+ (pcase-let* ((beg (progn (back-to-indentation) (point)))
+ (end (progn
+ (end-of-line)
+ (skip-chars-backward " \t\f\t\n" beg)
+ (if (eq (point) beg)
+ (line-beginning-position 2)
+ (point))))
+ (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n"))
+ (`(,face ,bitmap)
+ (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
+ (list 'flymake-errline flymake-error-bitmap)
+ (list 'flymake-warnline flymake-warning-bitmap))))
+ (flymake-make-overlay beg end tooltip-text face bitmap)))
(defun flymake-parse-err-lines (err-info-list lines)
"Parse err LINES, store info in ERR-INFO-LIST."
@@ -969,7 +785,7 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
(when (flymake-same-files real-file-name source-file-name)
(setq line-err-info (flymake-ler-set-file line-err-info nil))
(setq err-info-list (flymake-add-err-info err-info-list line-err-info))))
- (flymake-log 3 "parsed '%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no"))
+ (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no"))
(setq idx (1+ idx)))
err-info-list))
@@ -978,7 +794,7 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
Return last one as residual if it does not end with newline char.
Returns ((LINES) RESIDUAL)."
(when (and output (> (length output) 0))
- (let* ((lines (flymake-split-string output "[\n\r]+"))
+ (let* ((lines (split-string output "[\n\r]+" t))
(complete (equal "\n" (char-to-string (aref output (1- (length output))))))
(residual nil))
(when (not complete)
@@ -1010,16 +826,16 @@ Convert it to flymake internal format."
(append
'(
;; MS Visual C++ 6.0
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \: \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
1 3 nil 4)
;; jikes
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[0-9]+\:[0-9]+\:[0-9]+\: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
1 3 nil 4)
;; MS midl
("midl[ ]*:[ ]*\\(command line error .*\\)"
nil nil nil 1)
;; MS C#
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+)\: \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
1 3 nil 4)
;; perl
("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1)
@@ -1027,7 +843,7 @@ Convert it to flymake internal format."
("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
;; ant/javac. Note this also matches gcc warnings!
- (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\\(?:\:[0-9]+\\)?\:[ \t\n]*\\(.+\\)"
+ (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)"
2 4 nil 5))
;; compilation-error-regexp-alist)
(flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
@@ -1036,19 +852,6 @@ Convert it to flymake internal format."
Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns
from compile.el")
-;;(defcustom flymake-err-line-patterns
-;; '(
-;; ; MS Visual C++ 6.0
-;; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \: \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
-;; 1 3 4)
-;; ; jikes
-;; ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[0-9]+\:[0-9]+\:[0-9]+\: \\(\\(Error\\|Warning\\|Caution\\):[ \t\n]*\\(.+\\)\\)"
-;; 1 3 4))
-;; "patterns for matching error/warning lines, (regexp file-idx line-idx err-text-idx)"
-;; :group 'flymake
-;; :type '(repeat (string number number number))
-;;)
-
(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4")
(defvar flymake-warning-predicate "^[wW]arning"
"Predicate matching against error text to detect a warning.
@@ -1163,26 +966,24 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(shell-quote-argument basedir)
" DUMPVARS=INCLUDE_DIRS dumpvars"))
(output (shell-command-to-string command-line))
- (lines (flymake-split-string output "\n"))
+ (lines (split-string output "\n" t))
(count (length lines))
(idx 0)
(inc-dirs nil))
(while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines))))
(setq idx (1+ idx)))
(when (< idx count)
- (let* ((inc-lines (flymake-split-string (nth idx lines) " *-I"))
+ (let* ((inc-lines (split-string (nth idx lines) " *-I" t))
(inc-count (length inc-lines)))
(while (> inc-count 0)
(when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines)))
- (push (flymake-replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
+ (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
(setq inc-count (1- inc-count)))))
(flymake-add-project-include-dirs-to-cache basedir inc-dirs)
inc-dirs)))
-(defcustom flymake-get-project-include-dirs-function 'flymake-get-project-include-dirs-imp
- "Function used to get project include dirs, one parameter: basedir name."
- :group 'flymake
- :type 'function)
+(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp
+ "Function used to get project include dirs, one parameter: basedir name.")
(defun flymake-get-project-include-dirs (basedir)
(funcall flymake-get-project-include-dirs-function basedir))
@@ -1190,9 +991,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(defun flymake-get-system-include-dirs ()
"System include dirs - from the 'INCLUDE' env setting."
(let* ((includes (getenv "INCLUDE")))
- (if includes (flymake-split-string includes path-separator) nil)))
+ (if includes (split-string includes path-separator t) nil)))
-(defvar flymake-project-include-dirs-cache (flymake-makehash 'equal))
+(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal))
(defun flymake-get-project-include-dirs-from-cache (base-dir)
(gethash base-dir flymake-project-include-dirs-cache))
@@ -1232,11 +1033,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(error
(flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
-(defcustom flymake-compilation-prevents-syntax-check t
- "If non-nil, don't start syntax check if compilation is running."
- :group 'flymake
- :type 'boolean)
-
(defun flymake-start-syntax-check ()
"Start syntax checking for current buffer."
(interactive)
@@ -1280,7 +1076,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(setq flymake-is-running t)
(setq flymake-last-change-time nil)
- (setq flymake-check-start-time (flymake-float-time))
+ (setq flymake-check-start-time (float-time))
(flymake-report-status nil "*")
(flymake-log 2 "started process %d, command=%s, dir=%s"
@@ -1288,8 +1084,10 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
default-directory)
process)
(error
- (let* ((err-str (format "Failed to launch syntax check process '%s' with args %s: %s"
- cmd args (error-message-string err)))
+ (let* ((err-str
+ (format-message
+ "Failed to launch syntax check process `%s' with args %s: %s"
+ cmd args (error-message-string err)))
(source-file-name buffer-file-name)
(cleanup-f (flymake-get-cleanup-function source-file-name)))
(flymake-log 0 err-str)
@@ -1321,71 +1119,49 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(flymake-stop-all-syntax-checks)
(call-interactively 'compile))
-(defcustom flymake-no-changes-timeout 0.5
- "Time to wait after last change before starting compilation."
- :group 'flymake
- :type 'number)
-
(defun flymake-on-timer-event (buffer)
"Start a syntax check for buffer BUFFER if necessary."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(when (and (not flymake-is-running)
flymake-last-change-time
- (> (- (flymake-float-time) flymake-last-change-time)
+ (> (- (float-time) flymake-last-change-time)
flymake-no-changes-timeout))
(setq flymake-last-change-time nil)
(flymake-log 3 "starting syntax check as more than 1 second passed since last change")
(flymake-start-syntax-check)))))
-(defun flymake-current-line-no ()
- "Return number of current line in current buffer."
- (count-lines (point-min) (if (eobp) (point) (1+ (point)))))
-
-(defun flymake-count-lines ()
- "Return number of lines in buffer BUFFER."
- (count-lines (point-min) (point-max)))
-
-(defun flymake-display-err-menu-for-current-line ()
- "Display a menu with errors/warnings for current line if it has errors and/or warnings."
- (interactive)
- (let* ((line-no (flymake-current-line-no))
- (line-err-info-list (nth 0 (flymake-find-err-info flymake-err-info line-no)))
- (menu-data (flymake-make-err-menu-data line-no line-err-info-list))
- (choice nil))
- (if menu-data
- (progn
- (setq choice (flymake-popup-menu menu-data))
- (flymake-log 3 "choice=%s" choice)
- (when choice
- (eval choice)))
- (flymake-log 1 "no errors for line %d" line-no))))
-
-(defun flymake-make-err-menu-data (line-no line-err-info-list)
- "Make a (menu-title (item-title item-action)*) list with errors/warnings from LINE-ERR-INFO-LIST."
- (let* ((menu-items nil))
- (when line-err-info-list
- (let* ((count (length line-err-info-list))
- (menu-item-text nil))
- (while (> count 0)
- (setq menu-item-text (flymake-ler-text (nth (1- count) line-err-info-list)))
- (let* ((file (flymake-ler-file (nth (1- count) line-err-info-list)))
- (full-file (flymake-ler-full-file (nth (1- count) line-err-info-list)))
- (line (flymake-ler-line (nth (1- count) line-err-info-list))))
- (if file
- (setq menu-item-text (concat menu-item-text " - " file "(" (format "%d" line) ")")))
- (setq menu-items (cons (list menu-item-text
- (if file (list 'flymake-goto-file-and-line full-file line) nil))
- menu-items)))
- (setq count (1- count)))
- (flymake-log 3 "created menu-items with %d item(s)" (length menu-items))))
- (if menu-items
- (let* ((menu-title (format "Line %d: %d error(s), %d warning(s)" line-no
- (flymake-get-line-err-count line-err-info-list "e")
- (flymake-get-line-err-count line-err-info-list "w"))))
- (list menu-title menu-items))
- nil)))
+(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line
+ 'flymake-popup-current-error-menu "24.4")
+
+(defun flymake-popup-current-error-menu (&optional event)
+ "Pop up a menu with errors/warnings for current line."
+ (interactive (list last-nonmenu-event))
+ (let* ((line-no (line-number-at-pos))
+ (errors (or (car (flymake-find-err-info flymake-err-info line-no))
+ (user-error "No errors for current line")))
+ (menu (mapcar (lambda (x)
+ (if (flymake-ler-file x)
+ (cons (format "%s - %s(%d)"
+ (flymake-ler-text x)
+ (flymake-ler-file x)
+ (flymake-ler-line x))
+ x)
+ (list (flymake-ler-text x))))
+ errors))
+ (event (if (mouse-event-p event)
+ event
+ (list 'mouse-1 (posn-at-point))))
+ (title (format "Line %d: %d error(s), %d warning(s)"
+ line-no
+ (flymake-get-line-err-count errors "e")
+ (flymake-get-line-err-count errors "w")))
+ (choice (x-popup-menu event (list title (cons "" menu)))))
+ (flymake-log 3 "choice=%s" choice)
+ (when choice
+ (flymake-goto-file-and-line (flymake-ler-full-file choice)
+ (flymake-ler-line choice)))))
(defun flymake-goto-file-and-line (file line)
"Try to get buffer for FILE and goto line LINE in it."
@@ -1396,17 +1172,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(forward-line (1- line))))
;; flymake minor mode declarations
-(defvar flymake-mode-line nil)
-
-(make-variable-buffer-local 'flymake-mode-line)
-
-(defvar flymake-mode-line-e-w nil)
-
-(make-variable-buffer-local 'flymake-mode-line-e-w)
-
-(defvar flymake-mode-line-status nil)
-
-(make-variable-buffer-local 'flymake-mode-line-status)
+(defvar-local flymake-mode-line nil)
+(defvar-local flymake-mode-line-e-w nil)
+(defvar-local flymake-mode-line-status nil)
(defun flymake-report-status (e-w &optional status)
"Show status in mode line."
@@ -1425,11 +1193,6 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
"Display a warning to user."
(message-box warning))
-(defcustom flymake-gui-warnings-enabled t
- "Enables/disables GUI warnings."
- :group 'flymake
- :type 'boolean)
-
(defun flymake-report-fatal-status (status warning)
"Display a warning and switch flymake mode off."
(when flymake-gui-warnings-enabled
@@ -1439,17 +1202,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s"
(buffer-name) status warning))
-(defcustom flymake-start-syntax-check-on-find-file t
- "Start syntax check on find file."
- :group 'flymake
- :type 'boolean)
-
;;;###autoload
-(define-minor-mode flymake-mode
- "Toggle on-the-fly syntax checking.
-With a prefix argument ARG, enable the mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil."
+(define-minor-mode flymake-mode nil
:group 'flymake :lighter flymake-mode-line
(cond
@@ -1505,19 +1259,14 @@ if ARG is omitted or nil."
(flymake-mode 0)
(flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name)))
-(defcustom flymake-start-syntax-check-on-newline t
- "Start syntax check if newline char was added/removed from the buffer."
- :group 'flymake
- :type 'boolean)
-
(defun flymake-after-change-function (start stop _len)
"Start syntax check for current buffer if it isn't already running."
- ;;+(flymake-log 0 "setting change time to %s" (flymake-float-time))
+ ;;+(flymake-log 0 "setting change time to %s" (float-time))
(let((new-text (buffer-substring start stop)))
(when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
(flymake-log 3 "starting syntax check as new-line has been seen")
(flymake-start-syntax-check))
- (setq flymake-last-change-time (flymake-float-time))))
+ (setq flymake-last-change-time (float-time))))
(defun flymake-after-save-hook ()
(if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved?
@@ -1584,7 +1333,7 @@ if ARG is omitted or nil."
(defun flymake-goto-next-error ()
"Go to next error in err ring."
(interactive)
- (let ((line-no (flymake-get-next-err-line-no flymake-err-info (flymake-current-line-no))))
+ (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos))))
(when (not line-no)
(setq line-no (flymake-get-first-err-line-no flymake-err-info))
(flymake-log 1 "passed end of file"))
@@ -1595,7 +1344,7 @@ if ARG is omitted or nil."
(defun flymake-goto-prev-error ()
"Go to previous error in err ring."
(interactive)
- (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (flymake-current-line-no))))
+ (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos))))
(when (not line-no)
(setq line-no (flymake-get-last-err-line-no flymake-err-info))
(flymake-log 1 "passed beginning of file"))
@@ -1631,14 +1380,14 @@ if ARG is omitted or nil."
;; trying to remove the leading / of absolute file names.
(slash-pos (string-match "/" dir))
(temp-dir (expand-file-name (substring dir (1+ slash-pos))
- (flymake-get-temp-dir))))
+ temporary-file-directory)))
(file-truename (expand-file-name (file-name-nondirectory file-name)
temp-dir))))
(defun flymake-delete-temp-directory (dir-name)
"Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error."
- (let* ((temp-dir (flymake-get-temp-dir))
+ (let* ((temp-dir temporary-file-directory)
(suffix (substring dir-name (1+ (length temp-dir)))))
(while (> (length suffix) 0)
@@ -1648,17 +1397,10 @@ if ARG is omitted or nil."
(file-truename (expand-file-name suffix temp-dir)))
(setq suffix (file-name-directory suffix)))))
-(defvar flymake-temp-source-file-name nil)
-(make-variable-buffer-local 'flymake-temp-source-file-name)
-
-(defvar flymake-master-file-name nil)
-(make-variable-buffer-local 'flymake-master-file-name)
-
-(defvar flymake-temp-master-file-name nil)
-(make-variable-buffer-local 'flymake-temp-master-file-name)
-
-(defvar flymake-base-dir nil)
-(make-variable-buffer-local 'flymake-base-dir)
+(defvar-local flymake-temp-source-file-name nil)
+(defvar-local flymake-master-file-name nil)
+(defvar-local flymake-temp-master-file-name nil)
+(defvar-local flymake-base-dir nil)
(defun flymake-init-create-temp-buffer-copy (create-temp-f)
"Make a temporary copy of the current buffer, save its name in buffer data and return the name."
@@ -1899,5 +1641,4 @@ Use CREATE-TEMP-F for creating temp copy."
'flymake-create-temp-inplace))))
(provide 'flymake)
-
;;; flymake.el ends here
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 0fc805aae81..ef470055065 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,6 +1,6 @@
;;; fortran.el --- Fortran mode for GNU Emacs
-;; Copyright (C) 1986, 1993-1995, 1997-2013 Free Software Foundation,
+;; Copyright (C) 1986, 1993-1995, 1997-2015 Free Software Foundation,
;; Inc.
;; Author: Michael D. Prange <prange@erl.mit.edu>
@@ -244,8 +244,8 @@ line in region."
(defcustom fortran-column-ruler-fixed
"0 4 6 10 20 30 40 5\
0 60 70\n\
-\[ ]|{ | | | | | | | | \
-\| | | | |}\n"
+[ ]|{ | | | | | | | | \
+| | | | |}\n"
"String displayed above current line by \\[fortran-column-ruler].
This variable is used in fixed format mode.
See the variable `fortran-column-ruler-tab' for TAB format mode."
@@ -257,8 +257,8 @@ See the variable `fortran-column-ruler-tab' for TAB format mode."
(defcustom fortran-column-ruler-tab
"0 810 20 30 40 5\
0 60 70\n\
-\[ ]| { | | | | | | | | \
-\| | | | |}\n"
+[ ]| { | | | | | | | | \
+| | | | |}\n"
"String displayed above current line by \\[fortran-column-ruler].
This variable is used in TAB format mode.
See the variable `fortran-column-ruler-fixed' for fixed format mode."
@@ -817,15 +817,15 @@ Variables controlling indentation style and extra features:
Amount of extra indentation for text in full-line comments (default 0).
`fortran-comment-indent-style'
How to indent the text in full-line comments. Allowed values are:
- nil don't change the indentation
- fixed indent to `fortran-comment-line-extra-indent' beyond the
+ nil don't change the indentation
+ `fixed' indent to `fortran-comment-line-extra-indent' beyond the
value of either
`fortran-minimum-statement-indent-fixed' (fixed format) or
`fortran-minimum-statement-indent-tab' (TAB format),
depending on the continuation format in use.
- relative indent to `fortran-comment-line-extra-indent' beyond the
+ `relative' indent to `fortran-comment-line-extra-indent' beyond the
indentation for a line of code.
- (default 'fixed)
+ (default `fixed')
`fortran-comment-indent-char'
Single-character string to be inserted instead of space for
full-line comment indentation (default \" \").
@@ -916,12 +916,12 @@ with no args, if that value is non-nil."
(defun fortran-line-length (nchars &optional global)
"Set the length of fixed-form Fortran lines to NCHARS.
-This normally only affects the current buffer, which must be in
-Fortran mode. If the optional argument GLOBAL is non-nil, it
-affects all Fortran buffers, and also the default.
-If a numeric prefix argument is specified, it will be used as NCHARS,
-otherwise is a non-numeric prefix arg is specified, the length will be
-provided via the minibuffer, and otherwise the current column is used."
+By default this only affects the current buffer, which must be in
+Fortran mode. If the optional argument GLOBAL is non-nil, it affects
+all Fortran buffers, and also the default. The default value of NCHARS
+is the current column. A numeric prefix argument specifies a value to
+use instead of the current column. A non-numeric prefix argument prompts
+for the value to use."
(interactive
(list (cond
((numberp current-prefix-arg) current-prefix-arg)
@@ -1117,7 +1117,7 @@ See also `fortran-window-create'."
(message "Type SPC to continue editing.")
(let ((char (read-event)))
(or (equal char ?\s)
- (setq unread-command-events (list char))))))
+ (push char unread-command-events)))))
(fortran-window-create)))
(defun fortran-split-line ()
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 2017636435c..4bee7c1dfa2 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1,9 +1,9 @@
;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Nick Roberts <nickrob@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, tools
;; This file is part of GNU Emacs.
@@ -981,7 +981,8 @@ no input, and GDB is waiting for input."
(eq gud-minor-mode 'gdbmi))
(error "Not in a GDB-MI buffer"))
(let ((proc (get-buffer-process gud-comint-buffer)))
- (if (and (eobp) proc (process-live-p proc)
+ (if (and (eobp)
+ (process-live-p proc)
(not gud-running)
(= (point) (marker-position (process-mark proc))))
;; Sending an EOF does not work with GDB-MI; submit an
@@ -1016,11 +1017,15 @@ no input, and GDB is waiting for input."
(declare-function tooltip-show "tooltip" (text &optional use-echo-area))
+(defconst gdb--string-regexp "\"\\(?:[^\\\"]\\|\\\\.\\)*\"")
+
(defun gdb-tooltip-print (expr)
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(goto-char (point-min))
(cond
- ((re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ ((re-search-forward (concat ".*value=\\(" gdb--string-regexp
+ "\\)")
+ nil t)
(tooltip-show
(concat expr " = " (read (match-string 1)))
(or gud-tooltip-echo-area
@@ -1198,7 +1203,8 @@ With arg, enter name of variable to be watched in the minibuffer."
(defun gdb-var-evaluate-expression-handler (varnum changed)
(goto-char (point-min))
- (re-search-forward ".*value=\\(\".*\"\\)" nil t)
+ (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))
@@ -1579,9 +1585,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
;; read from the pty, and stops listening to it. If the gdb
;; process is still running, remove the pty, make a new one, and
;; pass it to gdb.
- (let ((gdb-proc (get-buffer-process gud-comint-buffer))
- (io-buffer (process-buffer proc)))
- (when (and gdb-proc (process-live-p gdb-proc)
+ (let ((io-buffer (process-buffer proc)))
+ (when (and (process-live-p (get-buffer-process gud-comint-buffer))
(buffer-live-p io-buffer))
;; `comint-exec' deletes the original process as a side effect.
(comint-exec io-buffer "gdb-inferior" nil nil nil)
@@ -1624,9 +1629,19 @@ this trigger is subscribed to `gdb-buf-publisher' and called with
:syntax-table nil :abbrev-table nil
(make-comint-in-buffer "gdb-inferior" (current-buffer) nil))
+(defcustom gdb-display-io-nopopup nil
+ "When non-nil, and the 'gdb-inferior-io buffer is buried, don't pop it up."
+ :type 'boolean
+ :group 'gdb
+ :version "25.1")
+
(defun gdb-inferior-filter (proc string)
(unless (string-equal string "")
- (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))
+ (let (buf)
+ (unless (and gdb-display-io-nopopup
+ (setq buf (gdb-get-buffer 'gdb-inferior-io))
+ (null (get-buffer-window buf)))
+ (gdb-display-buffer (gdb-get-buffer-create 'gdb-inferior-io)))))
(with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io)
(comint-output-filter proc string)))
@@ -1974,7 +1989,7 @@ OFFSET is the position in STR at which the comparison takes place."
(string-equal match (substring str offset (+ offset match-length))))))
(defun gdbmi-same-start (str offset match)
- "Return non-nil iff STR and MATCH are equal up to the end of either strings.
+ "Return non-nil if STR and MATCH are equal up to the end of either strings.
OFFSET is the position in STR at which the comparison takes place."
(let* ((str-length (- (length str) offset))
(match-length (length match))
@@ -1984,7 +1999,7 @@ OFFSET is the position in STR at which the comparison takes place."
(substring match 0 compare-length)))))
(defun gdbmi-is-number (character)
- "Return non-nil iff CHARACTER is a numerical character between 0 and 9."
+ "Return non-nil if CHARACTER is a numerical character between 0 and 9."
(and (>= character ?0)
(<= character ?9)))
@@ -2050,7 +2065,7 @@ a GDB/MI reply message."
(defun gdbmi-bnf-gdb-prompt ()
"Implementation of the following GDB/MI output grammar rule:
gdb-prompt ==>
- '(gdb)' nl
+ `(gdb)' nl
nl ==>
CR | CR-LF"
@@ -2070,7 +2085,7 @@ a GDB/MI reply message."
"Implementation of the following GDB/MI output grammar rule:
result-record ==>
- [ token ] '^' result-class ( ',' result )* nl
+ [ token ] `^' result-class ( `,' result )* nl
token ==>
any sequence of digits."
@@ -2095,16 +2110,16 @@ a GDB/MI reply message."
exec-async-output | status-async-output | notify-async-output
exec-async-output ==>
- [ token ] '*' async-output
+ [ token ] `*' async-output
status-async-output ==>
- [ token ] '+' async-output
+ [ token ] `+' async-output
notify-async-output ==>
- [ token ] '=' async-output
+ [ token ] `=' async-output
async-output ==>
- async-class ( ',' result )* nl"
+ async-class ( `,' result )* nl"
(gdbmi-bnf-result-and-async-record-impl))
@@ -2115,16 +2130,17 @@ a GDB/MI reply message."
console-stream-output | target-stream-output | log-stream-output
console-stream-output ==>
- '~' c-string
+ `~' c-string
target-stream-output ==>
- '@' c-string
+ `@' c-string
log-stream-output ==>
- '&' c-string"
+ `&' c-string"
(when (< gdbmi-bnf-offset (length gud-marker-acc))
(if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
- (string-match "\\([~@&]\\)\\(\".*?\"\\)\n" gud-marker-acc
+ (string-match (concat "\\([~@&]\\)\\(" gdb--string-regexp "\\)\n")
+ gud-marker-acc
gdbmi-bnf-offset))
(let ((prefix (match-string 1 gud-marker-acc))
(c-string (match-string 2 gud-marker-acc)))
@@ -2179,10 +2195,10 @@ value when the message is complete.
Implement the following GDB/MI output grammar rule:
result-class ==>
- 'done' | 'running' | 'connected' | 'error' | 'exit'
+ `done' | `running' | `connected' | `error' | `exit'
async-class ==>
- 'stopped' | others (where others will be added depending on the needs
+ `stopped' | others (where others will be added depending on the needs
--this is still in development).")
(defun gdbmi-bnf-result-and-async-record-impl ()
@@ -2299,10 +2315,67 @@ the end of the current result or async record is reached."
; list ==>
; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
+(defcustom gdb-mi-decode-strings nil
+ "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."
+ :type '(choice
+ (const :tag "Don't decode" nil)
+ (const :tag "Decode using default coding-system" t)
+ (coding-system :tag "Decode using this coding-system"))
+ :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 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)
@@ -2360,9 +2433,9 @@ Sets `gdb-thread-number' to new id."
(let* ((result (gdb-json-string output-field))
(thread-id (bindat-get-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`
- ;; as usually. Things happen to fast and second call (from
+ ;; Typing `thread N' in GUD buffer makes GDB emit `^done' followed
+ ;; by `=thread-selected' notification. `^done' causes `gdb-update'
+ ;; as usually. Things happen too fast and second call (from
;; gdb-thread-selected handler) gets cut off by our beloved
;; pending triggers.
;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
@@ -2586,9 +2659,10 @@ incompatible with GDB/MI output syntax."
(insert "]"))))))
(goto-char (point-min))
(insert "{")
- (while (re-search-forward
- "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|\".*?[^\\]\"\\)" nil t)
- (replace-match "\"\\1\":\\2" nil nil))
+ (let ((re (concat "\\([[:alnum:]-_]+\\)=\\({\\|\\[\\|\"\"\\|"
+ gdb--string-regexp "\\)")))
+ (while (re-search-forward re nil t)
+ (replace-match "\"\\1\":\\2" nil nil)))
(goto-char (point-max))
(insert "}")))
@@ -2812,8 +2886,12 @@ See `def-gdb-auto-update-handler'."
(or (bindat-get-field breakpoint 'disp) "")
(let ((flag (bindat-get-field breakpoint 'enabled)))
(if (string-equal flag "y")
- (propertize "y" 'font-lock-face font-lock-warning-face)
- (propertize "n" 'font-lock-face font-lock-comment-face)))
+ (eval-when-compile
+ (propertize "y" 'font-lock-face
+ font-lock-warning-face))
+ (eval-when-compile
+ (propertize "n" 'font-lock-face
+ font-lock-comment-face))))
(bindat-get-field breakpoint 'addr)
(or (bindat-get-field breakpoint 'times) "")
(if (and type (string-match ".*watchpoint" type))
@@ -2865,7 +2943,8 @@ See `def-gdb-auto-update-handler'."
(gdb-put-breakpoint-icon (string-equal flag "y") bptno
(string-to-number line)))))))))
-(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"")
+(defconst gdb-source-file-regexp
+ (concat "fullname=\\(" gdb--string-regexp "\\)"))
(defun gdb-get-location (bptno line flag)
"Find the directory containing the relevant source file.
@@ -2874,6 +2953,7 @@ Put in buffer and place breakpoint icon."
(catch 'file-not-found
(if (re-search-forward gdb-source-file-regexp nil t)
(delete (cons bptno "File not found") gdb-location-alist)
+ ;; FIXME: Why/how do we use (match-string 1) when the search failed?
(push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync)
(unless (assoc bptno gdb-location-alist)
@@ -3257,11 +3337,16 @@ line."
gud-stop-subjob
"Interrupt thread at current line.")
+;; Defined opaquely in M-x gdb via gud-def.
+(declare-function gud-cont "gdb-mi" (arg) t)
+
(def-gdb-thread-buffer-gud-command
gdb-continue-thread
gud-cont
"Continue thread at current line.")
+(declare-function gud-step "gdb-mi" (arg) t)
+
(def-gdb-thread-buffer-gud-command
gdb-step-thread
gud-step
@@ -4010,6 +4095,8 @@ member."
(let ((name (bindat-get-field local 'name))
(value (bindat-get-field local 'value))
(type (bindat-get-field local 'type)))
+ (when (not value)
+ (setq value "<complex data type>"))
(if (or (not value)
(string-match "\\0x" value))
(add-text-properties 0 (length name)
@@ -4209,7 +4296,7 @@ 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 (match-string 1) gdb-source-file-list))
+ (push (read (match-string 1)) gdb-source-file-list))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (member buffer-file-name gdb-source-file-list)
@@ -4248,14 +4335,15 @@ overlay arrow in source buffer."
(setq gud-overlay-arrow-position (make-marker))
(set-marker gud-overlay-arrow-position position))))))))
-(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
+(defconst gdb-prompt-name-regexp
+ (concat "value=\\(" gdb--string-regexp "\\)"))
(defun gdb-get-prompt ()
"Find prompt for GDB session."
(goto-char (point-min))
(setq gdb-prompt-name nil)
(re-search-forward gdb-prompt-name-regexp nil t)
- (setq gdb-prompt-name (match-string 1))
+ (setq gdb-prompt-name (read (match-string 1)))
;; Insert first prompt.
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
@@ -4536,7 +4624,7 @@ Kills the gdb buffers, and resets variables and the source buffers."
buffers, if required."
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp nil t)
- (setq gdb-main-file (match-string 1)))
+ (setq gdb-main-file (read (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 c3f950b5da8..6ee32b0b3ee 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,6 +1,6 @@
;;; glasses.el --- make cantReadThis readable
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
;; Maintainer: Milan Zamazal <pdm@zamazal.org>
@@ -252,7 +252,7 @@ CATEGORY is the overlay category. If it is nil, use the `glasses' category."
;; Parentheses
(when glasses-separate-parentheses-p
(goto-char beg)
- (while (re-search-forward "[a-zA-Z]_*\\(\(\\)" end t)
+ (while (re-search-forward "[a-zA-Z]_*\\((\\)" end t)
(unless (glasses-parenthesis-exception-p (point-at-bol) (match-end 1))
(glasses-make-overlay (match-beginning 1) (match-end 1)
'glasses-parenthesis))))))))
@@ -291,7 +291,7 @@ recognized according to the current value of the variable `glasses-separator'."
(goto-char (match-beginning 1)))))
(when glasses-separate-parentheses-p
(goto-char (point-min))
- (while (re-search-forward "[a-zA-Z]_*\\( \\)\(" nil t)
+ (while (re-search-forward "[a-zA-Z]_*\\( \\)(" nil t)
(unless (glasses-parenthesis-exception-p (point-at-bol) (1+ (match-end 1)))
(replace-match "" t nil nil 1)))))))
;; nil must be returned to allow use in write file hooks
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 46af51e1f97..efecd21a92a 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -1,10 +1,10 @@
-;;; grep.el --- run `grep' and display the results
+;;; grep.el --- run `grep' and display the results -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1987, 1993-1999, 2001-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tools, processes
;; This file is part of GNU Emacs.
@@ -77,11 +77,10 @@ in grep buffers, so if you have globally disabled font-lock-mode,
you will not get highlighting.
This option sets the environment variable GREP_COLORS to specify
-markers for highlighting and GREP_OPTIONS to add the --color
-option in front of any explicit grep options before starting
-the grep.
+markers for highlighting and adds the --color option in front of
+any explicit grep options before starting the grep.
-When this option is `auto', grep uses `--color=auto' to highlight
+When this option is `auto', grep uses `--color' to highlight
matches only when it outputs to a terminal (when `grep' is the last
command in the pipe), thus avoiding the use of any potentially-harmful
escape sequences when standard output goes to a file or pipe.
@@ -97,7 +96,7 @@ To change the default value, use Customize or call the function
:type '(choice (const :tag "Do not highlight matches with grep markers" nil)
(const :tag "Highlight matches with grep markers" t)
(const :tag "Use --color=always" always)
- (const :tag "Use --color=auto" auto)
+ (const :tag "Use --color" auto)
(other :tag "Not Set" auto-detect))
:set 'grep-apply-setting
:version "22.1"
@@ -131,7 +130,7 @@ Customize or call the function `grep-apply-setting'."
(defcustom grep-template nil
"The default command to run for \\[lgrep].
The following place holders should be present in the string:
- <C> - place to put -i if case insensitive grep.
+ <C> - place to put the options like -i and --color.
<F> - file names and wildcards to search.
<X> - file names and wildcards to exclude.
<R> - the regular expression searched for.
@@ -178,7 +177,7 @@ The following place holders should be present in the string:
<D> - base directory for find
<X> - find options to restrict or expand the directory list
<F> - find options to limit the files matched
- <C> - place to put -i if case insensitive grep
+ <C> - place to put the grep options like -i and --color
<R> - the regular expression searched for.
In interactive usage, the actual value of this variable is set up
by `grep-compute-defaults'; to change the default value, use
@@ -345,16 +344,11 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
;;;###autoload
(defconst grep-regexp-alist
'(
- ;; Rule to match column numbers is commented out since no known grep
- ;; produces them
- ;; ("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2\\(?:\\([1-9][0-9]*\\)\\(?:-\\([1-9][0-9]*\\)\\)?\\2\\)?"
- ;; 1 3 (4 . 5))
- ;; Note that we want to use as tight a regexp as we can to try and
- ;; handle weird file names (with colons in them) as well as possible.
- ;; E.g. we use [1-9][0-9]* rather than [0-9]+ so as to accept ":034:"
- ;; in file names.
- ("^\\(.+?\\)\\(:[ \t]*\\)\\([1-9][0-9]*\\)\\2"
- 1 3
+ ;; Use a tight regexp to handle weird file names (with colons
+ ;; in them) as well as possible. E.g., use [1-9][0-9]* rather
+ ;; than [0-9]+ so as to accept ":034:" in file names.
+ ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:"
+ 1 2
;; Calculate column positions (col . end-col) of first grep match on a line
((lambda ()
(when grep-highlight-matches
@@ -423,8 +417,9 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
;;;###autoload
(defvar find-program (purecopy "find")
- "The default find program for `grep-find-command'.
-This variable's value takes effect when `grep-compute-defaults' is called.")
+ "The default find program.
+This is used by commands like `grep-find-command', `find-dired'
+and others.")
;;;###autoload
(defvar xargs-program (purecopy "xargs")
@@ -466,10 +461,6 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
;; `setenv' modifies `process-environment' let-bound in `compilation-start'
;; Any TERM except "dumb" allows GNU grep to use `--color=auto'
(setenv "TERM" "emacs-grep")
- (setenv "GREP_OPTIONS"
- (concat (getenv "GREP_OPTIONS")
- " --color=" (if (eq grep-highlight-matches 'always)
- "always" "auto")))
;; GREP_COLOR is used in GNU grep 2.5.1, but deprecated in later versions
(setenv "GREP_COLOR" "01;31")
;; GREP_COLORS is used in GNU grep 2.5.2 and later versions
@@ -566,6 +557,18 @@ This function is called from `compilation-filter-hook'."
(looking-at
(concat (regexp-quote hello-file)
":[0-9]+:English")))))))))
+
+ (when (eq grep-highlight-matches 'auto-detect)
+ (setq grep-highlight-matches
+ (with-temp-buffer
+ (and (grep-probe grep-program '(nil t nil "--help"))
+ (progn
+ (goto-char (point-min))
+ (search-forward "--color" nil t))
+ ;; Windows and DOS pipes fail `isatty' detection in Grep.
+ (if (memq system-type '(windows-nt ms-dos))
+ 'always 'auto)))))
+
(unless (and grep-command grep-find-command
grep-template grep-find-template)
(let ((grep-options
@@ -576,7 +579,16 @@ This function is called from `compilation-filter-hook'."
" -e"))))
(unless grep-command
(setq grep-command
- (format "%s %s " grep-program grep-options)))
+ (format "%s %s %s " grep-program
+ (or
+ (and grep-highlight-matches
+ (grep-probe grep-program
+ `(nil nil nil "--color" "x" ,null-device)
+ nil 1)
+ (if (eq grep-highlight-matches 'always)
+ "--color=always" "--color"))
+ "")
+ grep-options)))
(unless grep-template
(setq grep-template
(format "%s <X> <C> %s <R> <F>" grep-program grep-options)))
@@ -624,28 +636,18 @@ This function is called from `compilation-filter-hook'."
(format "%s " null-device)
"")))
(cond ((eq grep-find-use-xargs 'gnu)
- (format "%s . <X> -type f <F> -print0 | \"%s\" -0 %s"
+ (format "%s <D> <X> -type f <F> -print0 | \"%s\" -0 %s"
find-program xargs-program gcmd))
((eq grep-find-use-xargs 'exec)
- (format "%s . <X> -type f <F> -exec %s {} %s%s"
+ (format "%s <D> <X> -type f <F> -exec %s {} %s%s"
find-program gcmd null
(shell-quote-argument ";")))
((eq grep-find-use-xargs 'exec-plus)
- (format "%s . <X> -type f <F> -exec %s %s{} +"
+ (format "%s <D> <X> -type f <F> -exec %s %s{} +"
find-program gcmd null))
(t
- (format "%s . <X> -type f <F> -print | \"%s\" %s"
+ (format "%s <D> <X> -type f <F> -print | \"%s\" %s"
find-program xargs-program gcmd))))))))
- (when (eq grep-highlight-matches 'auto-detect)
- (setq grep-highlight-matches
- (with-temp-buffer
- (and (grep-probe grep-program '(nil t nil "--help"))
- (progn
- (goto-char (point-min))
- (search-forward "--color" nil t))
- ;; Windows and DOS pipes fail `isatty' detection in Grep.
- (if (memq system-type '(windows-nt ms-dos))
- 'always 'auto)))))
;; Save defaults for this host.
(setq grep-host-defaults-alist
@@ -729,21 +731,24 @@ This function is called from `compilation-filter-hook'."
;;;###autoload
(defun grep (command-args)
- "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use \\[next-error] (M-x next-error),
+ "Run Grep with user-specified COMMAND-ARGS, collect output in a buffer.
+While Grep runs asynchronously, you can use \\[next-error] (M-x next-error),
or \\<grep-mode-map>\\[compile-goto-error] in the *grep* \
-buffer, to go to the lines where grep found
-matches. To kill the grep job before it finishes, type \\[kill-compilation].
+buffer, to go to the lines where Grep found
+matches. To kill the Grep job before it finishes, type \\[kill-compilation].
+
+Noninteractively, COMMAND-ARGS should specify the Grep command-line
+arguments.
For doing a recursive `grep', see the `rgrep' command. For running
-`grep' in a specific directory, see `lgrep'.
+Grep in a specific directory, see `lgrep'.
This command uses a special history list for its COMMAND-ARGS, so you
can easily repeat a grep command.
-A prefix argument says to default the argument based upon the current
-tag the cursor is over, substituting it into the last grep command
-in the grep command history (or into `grep-command' if that history
+A prefix argument says to default the COMMAND-ARGS based on the current
+tag the cursor is over, substituting it into the last Grep command
+in the Grep command history (or into `grep-command' if that history
list is empty)."
(interactive
(progn
@@ -792,8 +797,8 @@ easily repeat a find command."
;; User-friendly interactive API.
(defconst grep-expand-keywords
- '(("<C>" . (and cf (isearch-no-upper-case-p regexp t) "-i"))
- ("<D>" . dir)
+ '(("<C>" . (mapconcat #'identity opts " "))
+ ("<D>" . (or dir "."))
("<F>" . files)
("<N>" . null-device)
("<X>" . excl)
@@ -804,27 +809,35 @@ substitution string. Note dynamic scoping of variables.")
(defun grep-expand-template (template &optional regexp files dir excl)
"Patch grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>."
- (let ((command template)
- (cf case-fold-search)
- (case-fold-search nil))
+ (let* ((command template)
+ (env `((opts . ,(let (opts)
+ (when (and case-fold-search
+ (isearch-no-upper-case-p regexp t))
+ (push "-i" opts))
+ (cond
+ ((eq grep-highlight-matches 'always)
+ (push "--color=always" opts))
+ ((eq grep-highlight-matches 'auto)
+ (push "--color" opts)))
+ opts))
+ (excl . ,excl)
+ (dir . ,dir)
+ (files . ,files)
+ (regexp . ,regexp)))
+ (case-fold-search nil))
(dolist (kw grep-expand-keywords command)
(if (string-match (car kw) command)
(setq command
(replace-match
(or (if (symbolp (cdr kw))
- (symbol-value (cdr kw))
- (save-match-data (eval (cdr kw))))
+ (eval (cdr kw) env)
+ (save-match-data (eval (cdr kw) env)))
"")
t t command))))))
(defun grep-read-regexp ()
- "Read regexp arg for interactive grep."
- (let ((default (grep-tag-default)))
- (read-regexp
- (concat "Search for"
- (if (and default (> (length default) 0))
- (format " (default \"%s\"): " default) ": "))
- default 'grep-regexp-history)))
+ "Read regexp arg for interactive grep using `read-regexp'."
+ (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history))
(defun grep-read-files (regexp)
"Read files arg for interactive grep."
@@ -905,7 +918,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(confirm (equal current-prefix-arg '(4))))
(list regexp files dir confirm))))))
(when (and (stringp regexp) (> (length regexp) 0))
- (unless (and dir (file-directory-p dir) (file-readable-p dir))
+ (unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
(let ((command regexp))
(if (null files)
@@ -986,7 +999,7 @@ to specify a command to run."
(confirm (equal current-prefix-arg '(4))))
(list regexp files dir confirm))))))
(when (and (stringp regexp) (> (length regexp) 0))
- (unless (and dir (file-directory-p dir) (file-readable-p dir))
+ (unless (and dir (file-accessible-directory-p dir))
(setq dir default-directory))
(if (null files)
(if (not (string= regexp (if (consp grep-find-command)
@@ -994,60 +1007,7 @@ to specify a command to run."
grep-find-command)))
(compilation-start regexp 'grep-mode))
(setq dir (file-name-as-directory (expand-file-name dir)))
- (require 'find-dired) ; for `find-name-arg'
- ;; In Tramp, there could be problems if the command line is too
- ;; long. We escape it, therefore.
- (let ((command (grep-expand-template
- grep-find-template
- regexp
- (concat (shell-quote-argument "(")
- " " find-name-arg " "
- (mapconcat
- #'shell-quote-argument
- (split-string files)
- (concat "\\\n" " -o " find-name-arg " "))
- " "
- (shell-quote-argument ")"))
- dir
- (concat
- (and grep-find-ignored-directories
- (concat "-type d "
- (shell-quote-argument "(")
- ;; we should use shell-quote-argument here
- " -path "
- (mapconcat
- #'(lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument
- (concat "*/" ignore)))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (concat "*/"
- (cdr ignore)))))))
- grep-find-ignored-directories
- "\\\n -o -path ")
- " "
- (shell-quote-argument ")")
- " -prune -o "))
- (and grep-find-ignored-files
- (concat (shell-quote-argument "!") " -type d "
- (shell-quote-argument "(")
- ;; we should use shell-quote-argument here
- " -name "
- (mapconcat
- #'(lambda (ignore)
- (cond ((stringp ignore)
- (shell-quote-argument ignore))
- ((consp ignore)
- (and (funcall (car ignore) dir)
- (shell-quote-argument
- (cdr ignore))))))
- grep-find-ignored-files
- "\\\n -o -name ")
- " "
- (shell-quote-argument ")")
- " -prune -o "))))))
+ (let ((command (rgrep-default-command regexp files nil)))
(when command
(if confirm
(setq command
@@ -1060,8 +1020,65 @@ to specify a command to run."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir)))))))
+(defun rgrep-default-command (regexp files dir)
+ "Compute the command for \\[rgrep] to use by default."
+ (require 'find-dired) ; for `find-name-arg'
+ (grep-expand-template
+ grep-find-template
+ regexp
+ (concat (shell-quote-argument "(")
+ " " find-name-arg " "
+ (mapconcat
+ #'shell-quote-argument
+ (split-string files)
+ (concat " -o " find-name-arg " "))
+ " "
+ (shell-quote-argument ")"))
+ dir
+ (concat
+ (and grep-find-ignored-directories
+ (concat "-type d "
+ (shell-quote-argument "(")
+ ;; we should use shell-quote-argument here
+ " -path "
+ (mapconcat
+ 'identity
+ (delq nil (mapcar
+ #'(lambda (ignore)
+ (cond ((stringp ignore)
+ (shell-quote-argument
+ (concat "*/" ignore)))
+ ((consp ignore)
+ (and (funcall (car ignore) dir)
+ (shell-quote-argument
+ (concat "*/"
+ (cdr ignore)))))))
+ grep-find-ignored-directories))
+ " -o -path ")
+ " "
+ (shell-quote-argument ")")
+ " -prune -o "))
+ (and grep-find-ignored-files
+ (concat (shell-quote-argument "!") " -type d "
+ (shell-quote-argument "(")
+ ;; we should use shell-quote-argument here
+ " -name "
+ (mapconcat
+ #'(lambda (ignore)
+ (cond ((stringp ignore)
+ (shell-quote-argument ignore))
+ ((consp ignore)
+ (and (funcall (car ignore) dir)
+ (shell-quote-argument
+ (cdr ignore))))))
+ grep-find-ignored-files
+ " -o -name ")
+ " "
+ (shell-quote-argument ")")
+ " -prune -o ")))))
+
;;;###autoload
-(defun zrgrep (regexp &optional files dir confirm grep-find-template)
+(defun zrgrep (regexp &optional files dir confirm template)
"Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR.
Like `rgrep' but uses `zgrep' for `grep-program', sets the default
file name to `*.gz', and sets `grep-highlight-matches' to `always'."
@@ -1094,12 +1111,10 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'."
nil default-directory t))
(confirm (equal current-prefix-arg '(4))))
(list regexp files dir confirm grep-find-template)))))))
- ;; Set `grep-highlight-matches' to `always'
- ;; since `zgrep' puts filters in the grep output.
- (let ((grep-highlight-matches 'always))
- ;; `rgrep' uses the dynamically bound value `grep-find-template'
- ;; from the argument `grep-find-template' whose value is computed
- ;; in the `interactive' spec.
+ (let ((grep-find-template template)
+ ;; Set `grep-highlight-matches' to `always'
+ ;; since `zgrep' puts filters in the grep output.
+ (grep-highlight-matches 'always))
(rgrep regexp files dir confirm)))
;;;###autoload
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index c549d9eedef..1284ef2857a 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1,10 +1,10 @@
-;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers
+;;; gud.el --- Grand Unified Debugger mode for running GDB and other debuggers -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1996, 1998, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1992-1996, 1998, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, tools
;; This file is part of GNU Emacs.
@@ -34,7 +34,8 @@
;; and added a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX
;; kluge with the gud-xdb-directories hack producing gud-dbx-directories.
;; Derek L. Davies <ddavies@world.std.com> added support for jdb (Java
-;; debugger.)
+;; debugger.) Jan Nieuwenhuizen added support for the Guile REPL (Guile
+;; debugger).
;;; Code:
@@ -67,7 +68,7 @@ pdb (Python), and jdb."
:group 'gud)
(global-set-key (vconcat gud-key-prefix "\C-l") 'gud-refresh)
-(define-key ctl-x-map " " 'gud-break) ;; backward compatibility hack
+;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack
(defvar gud-marker-filter nil)
(put 'gud-marker-filter 'permanent-local t)
@@ -140,7 +141,7 @@ Used to gray out relevant toolbar icons.")
(display-graphic-p)
(fboundp 'x-show-tip))
:visible (memq gud-minor-mode
- '(gdbmi dbx sdb xdb pdb))
+ '(gdbmi guiler dbx sdb xdb pdb))
:button (:toggle . gud-tooltip-mode))
([refresh] "Refresh" . gud-refresh)
([run] menu-item "Run" gud-run
@@ -170,11 +171,11 @@ Used to gray out relevant toolbar icons.")
([up] menu-item "Up Stack" gud-up
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdb dbx xdb jdb pdb)))
+ '(gdbmi gdb guiler dbx xdb jdb pdb)))
([down] menu-item "Down Stack" gud-down
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdb dbx xdb jdb pdb)))
+ '(gdbmi gdb guiler dbx xdb jdb pdb)))
([pp] menu-item "Print S-expression" gud-pp
:enable (and (not gud-running)
(bound-and-true-p gdb-active-process))
@@ -195,7 +196,7 @@ Used to gray out relevant toolbar icons.")
([finish] menu-item "Finish Function" gud-finish
:enable (not gud-running)
:visible (memq gud-minor-mode
- '(gdbmi gdb xdb jdb pdb)))
+ '(gdbmi gdb guiler xdb jdb pdb)))
([stepi] menu-item "Step Instruction" gud-stepi
:enable (not gud-running)
:visible (memq gud-minor-mode '(gdbmi gdb dbx)))
@@ -255,9 +256,8 @@ Used to gray out relevant toolbar icons.")
([menu-bar file] . undefined))))
"Map used in visited files.")
-(let ((m (assq 'gud-minor-mode minor-mode-map-alist)))
- (if m (setcdr m gud-minor-mode-map)
- (push (cons 'gud-minor-mode gud-minor-mode-map) minor-mode-map-alist)))
+(setf (alist-get 'gud-minor-mode minor-mode-map-alist)
+ gud-minor-mode-map)
(defvar gud-mode-map
;; Will inherit from comint-mode via define-derived-mode.
@@ -321,8 +321,9 @@ Uses `gud-<MINOR-MODE>-directories' to find the source files."
(when buf
;; Copy `gud-minor-mode' to the found buffer to turn on the menu.
(with-current-buffer buf
- (set (make-local-variable 'gud-minor-mode) minor-mode)
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (setq-local gud-minor-mode minor-mode)
+ (if (boundp 'tool-bar-map) ; not --without-x
+ (setq-local tool-bar-map gud-tool-bar-map))
(when (and gud-tooltip-mode
(eq gud-minor-mode 'gdbmi))
(make-local-variable 'gdb-define-alist)
@@ -802,24 +803,11 @@ directory and source-file directory for your debugger."
"Completion table for GDB commands.
COMMAND is the prefix for which we seek completion.
CONTEXT is the text before COMMAND on the line."
- (let* ((start (- (point) (field-beginning)))
- (complete-list
+ (let* ((complete-list
(gud-gdb-run-command-fetch-lines (concat "complete " context command)
(current-buffer)
;; From string-match above.
(length context))))
- ;; `gud-gdb-run-command-fetch-lines' has some nasty side-effects on the
- ;; buffer (via `gud-delete-prompt-marker'): it removes the prompt and then
- ;; re-adds it later, thus messing up markers and overlays along the way.
- ;; This is a problem for completion-in-region which uses an overlay to
- ;; create a field.
- ;; So we restore completion-in-region's field if needed.
- ;; FIXME: change gud-gdb-run-command-fetch-lines so it doesn't modify the
- ;; buffer at all.
- (when (/= start (- (point) (field-beginning)))
- (dolist (ol (overlays-at (1- (point))))
- (when (eq (overlay-get ol 'field) 'completion)
- (move-overlay ol (- (point) start) (overlay-end ol)))))
;; Protect against old versions of GDB.
(and complete-list
(string-match "^Undefined command: \"complete\"" (car complete-list))
@@ -858,7 +846,14 @@ CONTEXT is the text before COMMAND on the line."
(save-excursion
(skip-chars-backward "^ " (comint-line-beginning-position))
(point))))
- (list start end
+ ;; FIXME: `gud-gdb-run-command-fetch-lines' has some nasty side-effects on
+ ;; the buffer (via `gud-delete-prompt-marker'): it removes the prompt and
+ ;; then re-adds it later, thus messing up markers and overlays along the
+ ;; way (bug#18282).
+ ;; We use an "insert-before" marker for `start', since it's typically right
+ ;; after the prompt, which works around the problem, but is a hack (and
+ ;; comes with other downsides, e.g. if completion adds text at `start').
+ (list (copy-marker start t) end
(completion-table-dynamic
(apply-partially gud-gdb-completion-function
(buffer-substring (comint-line-beginning-position)
@@ -1367,7 +1362,7 @@ and source-file directory for your debugger."
)
;; ======================================================================
-;; xdb (HP PARISC debugger) functions
+;; xdb (HP PA-RISC debugger) functions
;; History of argument lists passed to xdb.
(defvar gud-xdb-history nil)
@@ -1703,6 +1698,83 @@ and source-file directory for your debugger."
(run-hooks 'pdb-mode-hook))
;; ======================================================================
+;; Guile REPL (guiler) functions
+
+;; History of argument lists passed to guiler.
+(defvar gud-guiler-history nil)
+
+(defvar gud-guiler-lastfile nil)
+
+(defun gud-guiler-marker-filter (string)
+ (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
+
+ (let ((start 0))
+ (while
+ (cond
+ ((string-match "^In \\(.*\\):" gud-marker-acc start)
+ (setq gud-guiler-lastfile (match-string 1 gud-marker-acc)))
+ ((string-match "^\\([^:\n]+\\):\\([0-9]+\\):\\([0-9]+\\):[^\n]*"
+ gud-marker-acc start)
+ (setq gud-guiler-lastfile (match-string 1 gud-marker-acc))
+ (setq gud-last-frame
+ (cons gud-guiler-lastfile
+ (string-to-number (match-string 2 gud-marker-acc)))))
+ ((string-match "^[ ]*\\([0-9]+\\):\\([0-9]+\\) [^\n]*"
+ gud-marker-acc start)
+ (if gud-guiler-lastfile
+ (setq gud-last-frame
+ (cons gud-guiler-lastfile
+ (string-to-number (match-string 1 gud-marker-acc))))))
+ ((string-match comint-prompt-regexp gud-marker-acc start) t)
+ ((string= (substring gud-marker-acc start) "") nil)
+ (t nil))
+ (setq start (match-end 0)))
+
+ ;; Search for the last incomplete line in this chunk
+ (while (string-match "\n" gud-marker-acc start)
+ (setq start (match-end 0)))
+
+ ;; If we have an incomplete line, store it in gud-marker-acc.
+ (setq gud-marker-acc (substring gud-marker-acc (or start 0))))
+ string)
+
+
+(defcustom gud-guiler-command-name "guile"
+ "File name for executing the Guile debugger.
+This should be an executable on your path, or an absolute file name."
+ :type 'string
+ :group 'gud)
+
+;;;###autoload
+(defun guiler (command-line)
+ "Run guiler on program FILE in buffer `*gud-FILE*'.
+The directory containing FILE becomes the initial working directory
+and source-file directory for your debugger."
+ (interactive
+ (list (gud-query-cmdline 'guiler)))
+
+ (gud-common-init command-line nil 'gud-guiler-marker-filter)
+ (setq-local gud-minor-mode 'guiler)
+
+;; FIXME: absolute file-names are not grokked yet by Guile's ,break-at-source
+;; and relative file names only when relative to %load-path.
+;; (gud-def gud-break ",break-at-source %d%f %l" "\C-b" "Set breakpoint at current line.")
+ (gud-def gud-break ",break-at-source %f %l" "\C-b" "Set breakpoint at current line.")
+;; FIXME: remove breakpoint with file-line not yet supported by Guile
+;; (gud-def gud-remove ",delete ---> %d%f:%l" "\C-d" "Remove breakpoint at current line")
+ (gud-def gud-step ",step" "\C-s" "Step one source line with display.")
+ (gud-def gud-next ",next" "\C-n" "Step one line (skip functions).")
+;; (gud-def gud-cont "continue" "\C-r" "Continue with display.")
+ (gud-def gud-finish ",finish" "\C-f" "Finish executing current function.")
+ (gud-def gud-up ",up" "<" "Up one stack frame.")
+ (gud-def gud-down ",down" ">" "Down one stack frame.")
+ (gud-def gud-print "%e" "\C-p" "Evaluate Guile expression at point.")
+
+ (setq comint-prompt-regexp "^scheme@([^>]+> ")
+ (setq paragraph-start comint-prompt-regexp)
+ (run-hooks 'guiler-mode-hook))
+
+;; ======================================================================
;;
;; JDB support.
;;
@@ -2159,10 +2231,8 @@ relative to a classpath directory."
(split-string
;; Eliminate any subclass references in the class
;; name string. These start with a "$"
- ((lambda (x)
- (if (string-match "$.*" x)
- (replace-match "" t t x) p))
- p)
+ (if (string-match "$.*" p)
+ (replace-match "" t t p) p)
"\\.") "/")
".java"))
(cplist (append gud-jdb-sourcepath gud-jdb-classpath))
@@ -2482,7 +2552,8 @@ comint mode, which see."
(setq mode-line-process '(":%s"))
(define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
(set (make-local-variable 'gud-last-frame) nil)
- (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
+ (if (boundp 'tool-bar-map) ; not --without-x
+ (setq-local tool-bar-map gud-tool-bar-map))
(make-local-variable 'comint-prompt-regexp)
;; Don't put repeated commands in command history many times.
(set (make-local-variable 'comint-input-ignoredups) t)
@@ -2742,7 +2813,7 @@ Obeying it means displaying in another window the specified file and line."
(gud-find-file true-file)))
(window (and buffer
(or (get-buffer-window buffer)
- (display-buffer buffer))))
+ (display-buffer buffer '(nil (inhibit-same-window . t))))))
(pos))
(when buffer
(with-current-buffer buffer
@@ -2784,6 +2855,10 @@ Obeying it means displaying in another window the specified file and line."
(defun gud-format-command (str arg)
(let ((insource (not (eq (current-buffer) gud-comint-buffer)))
(frame (or gud-last-frame gud-last-last-frame))
+ (buffer-file-name-localized
+ (and (buffer-file-name)
+ (or (file-remote-p (buffer-file-name) 'localname)
+ (buffer-file-name))))
result)
(while (and str
(let ((case-fold-search nil))
@@ -2793,15 +2868,15 @@ Obeying it means displaying in another window the specified file and line."
(cond
((eq key ?f)
(setq subst (file-name-nondirectory (if insource
- (buffer-file-name)
+ buffer-file-name-localized
(car frame)))))
((eq key ?F)
(setq subst (file-name-base (if insource
- (buffer-file-name)
+ buffer-file-name-localized
(car frame)))))
((eq key ?d)
(setq subst (file-name-directory (if insource
- (buffer-file-name)
+ buffer-file-name-localized
(car frame)))))
((eq key ?l)
(setq subst (int-to-string
@@ -3282,6 +3357,8 @@ Treats actions as defuns."
;;; Customizable settings
+(defvar tooltip-mode)
+
;;;###autoload
(define-minor-mode gud-tooltip-mode
"Toggle the display of GUD tooltips.
@@ -3448,6 +3525,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
"Return a suitable command to print the expression EXPR."
(pcase gud-minor-mode
(`gdbmi (concat "-data-evaluate-expression \"" expr "\""))
+ (`guiler expr)
(`dbx (concat "print " expr))
((or `xdb `pdb) (concat "p " expr))
(`sdb (concat expr "/"))))
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index e264682edb3..e0d25c4439d 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1,10 +1,10 @@
-;;; hideif.el --- hides selected code within ifdef
+;;; hideif.el --- hides selected code within ifdef -*- lexical-binding:t -*-
-;; Copyright (C) 1988, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Brian Marick
;; Daniel LaLiberte <liberte@holonexus.org>
-;; Maintainer: FSF
+;; Maintainer: Luke Lee <luke.yx.lee@gmail.com>
;; Keywords: c, outlines
;; This file is part of GNU Emacs.
@@ -35,9 +35,9 @@
;; M-x hide-ifdefs or C-c @ h
;;
;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
-;; pass through. The support of constant expressions in #if lines is
-;; limited to identifiers, parens, and the operators: &&, ||, !, and
-;; "defined". Please extend this.
+;; pass through. Support complete C/C++ expression and precedence.
+;; It will automatically scan for new #define symbols and macros on the way
+;; parsing.
;;
;; The hidden code is marked by ellipses (...). Be
;; cautious when editing near ellipses, since the hidden text is
@@ -97,10 +97,14 @@
;;
;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
;; Extensively modified by Daniel LaLiberte (while at Gould).
+;;
+;; Extensively modified by Luke Lee in 2013 to support complete C expression
+;; evaluation and argumented macro expansion.
;;; Code:
(require 'cc-mode)
+(require 'cl-lib)
(defgroup hide-ifdef nil
"Hide selected code within `ifdef'."
@@ -132,6 +136,40 @@
:group 'hide-ifdef
:version "23.1")
+(defcustom hide-ifdef-exclude-define-regexp nil
+ "Ignore #define names if those names match this exclusion pattern."
+ :type 'string
+ :version "25.1")
+
+(defcustom hide-ifdef-expand-reinclusion-protection t
+ "Non-nil means don't hide an entire header file enclosed by #ifndef...#endif.
+Most C/C++ headers are usually wrapped with ifdefs to prevent re-inclusion:
+
+ ----- beginning of file -----
+ #ifndef _XXX_HEADER_FILE_INCLUDED_
+ #define _XXX_HEADER_FILE_INCLUDED_
+ xxx
+ xxx
+ xxx...
+ #endif
+ ----- end of file -----
+
+The first time we visit such a file, _XXX_HEADER_FILE_INCLUDED_ is
+undefined, and so nothing is hidden. The next time we visit it, everything will
+be hidden.
+
+This behavior is generally undesirable. If this option is non-nil, the outermost
+#if is always visible."
+ :type 'boolean
+ :version "25.1")
+
+(defcustom hide-ifdef-header-regexp
+ "\\.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
+ :group 'hide-ifdef
+ :version "25.1")
(defvar hide-ifdef-mode-submap
;; Set up the submap that goes after the prefix key.
@@ -145,10 +183,15 @@
(define-key map "s" 'show-ifdefs)
(define-key map "\C-d" 'hide-ifdef-block)
(define-key map "\C-s" 'show-ifdef-block)
+ (define-key map "e" 'hif-evaluate-macro)
+ (define-key map "C" 'hif-clear-all-ifdef-defined)
(define-key map "\C-q" 'hide-ifdef-toggle-read-only)
(define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
(substitute-key-definition
+ 'read-only-mode 'hide-ifdef-toggle-outside-read-only map)
+ ;; `toggle-read-only' is obsoleted by `read-only-mode'.
+ (substitute-key-definition
'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
map)
"Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
@@ -197,7 +240,7 @@
(cons '(hide-ifdef-hiding " Hiding")
minor-mode-alist)))
-;; fix c-mode syntax table so we can recognize whole symbols.
+;; Fix c-mode syntax table so we can recognize whole symbols.
(defvar hide-ifdef-syntax-table
(let ((st (copy-syntax-table c-mode-syntax-table)))
(modify-syntax-entry ?_ "w" st)
@@ -209,6 +252,11 @@
(defvar hide-ifdef-env nil
"An alist of defined symbols and their values.")
+(defvar hide-ifdef-env-backup nil
+ "This variable is a backup of the previously cleared `hide-ifdef-env'.
+This backup prevents any accidental clearance of `hide-fidef-env' by
+`hif-clear-all-ifdef-defined'.")
+
(defvar hif-outside-read-only nil
"Internal variable. Saves the value of `buffer-read-only' while hiding.")
@@ -225,53 +273,75 @@ that the C preprocessor would eliminate may be hidden from view.
Several variables affect how the hiding is done:
`hide-ifdef-env'
- An association list of defined and undefined symbols for the
- current buffer. Initially, the global value of `hide-ifdef-env'
- is used.
+ An association list of defined and undefined symbols for the
+ current project. Initially, the global value of `hide-ifdef-env'
+ is used. This variable was a buffer-local variable, which limits
+ hideif to parse only one C/C++ file at a time. We've extended
+ hideif to support parsing a C/C++ project containing multiple C/C++
+ source files opened simultaneously in different buffers. Therefore
+ `hide-ifdef-env' can no longer be buffer local but must be global.
`hide-ifdef-define-alist'
- An association list of defined symbol lists.
+ An association list of defined symbol lists.
Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
from one of the lists in `hide-ifdef-define-alist'.
`hide-ifdef-lines'
- Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
- #endif lines when hiding.
+ Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
+ #endif lines when hiding.
`hide-ifdef-initially'
- Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
- is activated.
+ Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
+ is activated.
`hide-ifdef-read-only'
- Set to non-nil if you want to make buffers read only while hiding.
- After `show-ifdefs', read-only status is restored to previous value.
+ Set to non-nil if you want to make buffers read only while hiding.
+ After `show-ifdefs', read-only status is restored to previous value.
\\{hide-ifdef-mode-map}"
:group 'hide-ifdef :lighter " Ifdef"
(if hide-ifdef-mode
(progn
- ;; inherit global values
- (set (make-local-variable 'hide-ifdef-env)
- (default-value 'hide-ifdef-env))
- (set (make-local-variable 'hide-ifdef-hiding)
- (default-value 'hide-ifdef-hiding))
- (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
- (set (make-local-variable 'line-move-ignore-invisible) t)
- (add-hook 'change-major-mode-hook
- (lambda () (hide-ifdef-mode -1)) nil t)
-
- (add-to-invisibility-spec '(hide-ifdef . t))
-
- (if hide-ifdef-initially
- (hide-ifdefs)
- (show-ifdefs)))
+ ;; inherit global values
+
+ ;; `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.
+;; (set (make-local-variable 'hide-ifdef-env)
+;; (default-value 'hide-ifdef-env))
+ (set 'hide-ifdef-env (default-value 'hide-ifdef-env))
+ ;; Some C/C++ headers might have other ways to prevent reinclusion and
+ ;; thus would like `hide-ifdef-expand-reinclusion-protection' to be nil.
+ (set (make-local-variable 'hide-ifdef-expand-reinclusion-protection)
+ (default-value 'hide-ifdef-expand-reinclusion-protection))
+ (set (make-local-variable 'hide-ifdef-hiding)
+ (default-value 'hide-ifdef-hiding))
+ (set (make-local-variable 'hif-outside-read-only) buffer-read-only)
+ (set (make-local-variable 'line-move-ignore-invisible) t)
+ (add-hook 'change-major-mode-hook
+ (lambda () (hide-ifdef-mode -1)) nil t)
+
+ (add-to-invisibility-spec '(hide-ifdef . t))
+
+ (if hide-ifdef-initially
+ (hide-ifdefs)
+ (show-ifdefs)))
;; else end hide-ifdef-mode
(kill-local-variable 'line-move-ignore-invisible)
(remove-from-invisibility-spec '(hide-ifdef . t))
(when hide-ifdef-hiding
(show-ifdefs))))
+(defun hif-clear-all-ifdef-defined ()
+ "Clears all symbols defined in `hide-ifdef-env'.
+It will backup this variable to `hide-ifdef-env-backup' before clearing to
+prevent accidental clearance."
+ (interactive)
+ (when (y-or-n-p "Clear all #defined symbols? ")
+ (setq hide-ifdef-env-backup hide-ifdef-env)
+ (setq hide-ifdef-env nil)))
(defun hif-show-all ()
"Show all of the text in the current buffer."
@@ -291,16 +361,64 @@ Several variables affect how the hiding is done:
(while (= (logand 1 (skip-chars-backward "\\\\")) 1)
(end-of-line 2)))
+(defun hif-merge-ifdef-region (start end)
+ "This function merges nearby ifdef regions to form a bigger overlay.
+The region is defined by START and END. This will decrease the number of
+overlays created."
+ ;; Generally there is no need to call itself recursively since there should
+ ;; originally exists no un-merged regions; however, if a part of the file is
+ ;; hidden with `hide-ifdef-lines' equals to nil while another part with 't,
+ ;; this case happens.
+ ;; TODO: Should we merge? or just create a container overlay? -- this can
+ ;; prevent `hideif-show-ifdef' expanding too many hidden contents since there
+ ;; is only a big overlay exists there without any smaller overlays.
+ (save-restriction
+ (widen) ; Otherwise `point-min' and `point-max' will be restricted and thus
+ ; fail to find neighbor overlays
+ (let ((begovrs (overlays-in
+ (max (- start 2) (point-min))
+ (max (- start 1) (point-min))))
+ (endovrs (overlays-in
+ (min (+ end 1) (point-max))
+ (min (+ end 2) (point-max))))
+ (ob nil)
+ (oe nil)
+ b e)
+ ;; Merge overlays before START
+ (dolist (o begovrs)
+ (when (overlay-get o 'hide-ifdef)
+ (setq b (min start (overlay-start o))
+ e (max end (overlay-end o)))
+ (move-overlay o b e)
+ (hif-merge-ifdef-region b e)
+ (setq ob o)))
+ ;; Merge overlays after END
+ (dolist (o endovrs)
+ (when (overlay-get o 'hide-ifdef)
+ (setq b (min start (overlay-start o))
+ e (max end (overlay-end o)))
+ (move-overlay o b e)
+ (hif-merge-ifdef-region b e)
+ (setf oe o)))
+ ;; If both START and END merging happens, merge into bigger one
+ (when (and ob oe)
+ (let ((b (min (overlay-start ob) (overlay-start oe)))
+ (e (max (overlay-end ob) (overlay-end oe))))
+ (delete-overlay oe)
+ (move-overlay ob b e)
+ (hif-merge-ifdef-region b e)))
+ (or ob oe))))
+
(defun hide-ifdef-region-internal (start end)
- (remove-overlays start end 'hide-ifdef t)
+ (unless (hif-merge-ifdef-region start end)
(let ((o (make-overlay start end)))
(overlay-put o 'hide-ifdef t)
(if hide-ifdef-shadow
- (overlay-put o 'face 'hide-ifdef-shadow)
- (overlay-put o 'invisible 'hide-ifdef))))
+ (overlay-put o 'face 'hide-ifdef-shadow)
+ (overlay-put o 'invisible 'hide-ifdef)))))
(defun hide-ifdef-region (start end)
- "START is the start of a #if or #else form. END is the ending part.
+ "START is the start of a #if, #elif, or #else form. END is the ending part.
Everything including these lines is made invisible."
(save-excursion
(goto-char start) (hif-end-of-line) (setq start (point))
@@ -309,7 +427,9 @@ Everything including these lines is made invisible."
(defun hif-show-ifdef-region (start end)
"Everything between START and END is made visible."
- (remove-overlays start end 'hide-ifdef t))
+ (let ((onum (length (overlays-in start end))))
+ (remove-overlays start end 'hide-ifdef t)
+ (/= onum (length (overlays-in start end)))))
;;===%%SF%% evaluation (Start) ===
@@ -326,7 +446,7 @@ that form should be displayed.")
(defun hif-set-var (var value)
- "Prepend (var value) pair to hide-ifdef-env."
+ "Prepend (VAR VALUE) pair to `hide-ifdef-env'."
(setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
(declare-function semantic-c-hideif-lookup "semantic/bovine/c" (var))
@@ -334,11 +454,11 @@ that form should be displayed.")
(defun hif-lookup (var)
(or (when (bound-and-true-p semantic-c-takeover-hideif)
- (semantic-c-hideif-lookup var))
+ (semantic-c-hideif-lookup var))
(let ((val (assoc var hide-ifdef-env)))
- (if val
- (cdr val)
- hif-undefined-symbol))))
+ (if val
+ (cdr val)
+ hif-undefined-symbol))))
(defun hif-defined (var)
(cond
@@ -354,178 +474,548 @@ that form should be displayed.")
;;===%%SF%% parsing (Start) ===
;;; The code that understands what ifs and ifdef in files look like.
-(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
-(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
-(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
-(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
-(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
+(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
+(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
+(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
+(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
+(defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
+(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
+(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
(defconst hif-ifx-else-endif-regexp
- (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
-
-;; Used to store the current token and the whole token list during parsing.
-;; Only bound dynamically.
+ (concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|"
+ hif-endif-regexp))
+(defconst hif-macro-expr-prefix-regexp
+ (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+"))
+
+(defconst hif-white-regexp "[ \t]*")
+(defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)"))
+(defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*"))
+(defconst hif-macroref-regexp
+ (concat hif-white-regexp "\\(" hif-id-regexp "\\)" hif-white-regexp
+ "\\("
+ "(" hif-white-regexp
+ "\\(" hif-id-regexp "\\)?" hif-white-regexp
+ "\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*"
+ "\\(\\.\\.\\.\\)?" hif-white-regexp
+ ")"
+ "\\)?" ))
+
+;; Store the current token and the whole token list during parsing.
+;; Bound dynamically.
(defvar hif-token)
(defvar hif-token-list)
(defconst hif-token-alist
- '(("||" . or)
- ("&&" . and)
- ("|" . hif-logior)
- ("&" . hif-logand)
- ("==" . equal)
- ("!=" . hif-notequal)
- ("!" . not)
- ("(" . lparen)
- (")" . rparen)
- (">" . hif-greater)
- ("<" . hif-less)
- (">=" . hif-greater-equal)
- ("<=" . hif-less-equal)
- ("+" . hif-plus)
- ("-" . hif-minus)
- ("?" . hif-conditional)
- (":" . hif-colon)))
+ '(("||" . hif-or)
+ ("&&" . hif-and)
+ ("|" . hif-logior)
+ ("^" . hif-logxor)
+ ("&" . hif-logand)
+ ("<<" . hif-shiftleft)
+ (">>" . hif-shiftright)
+ ("==" . hif-equal)
+ ;; Note: we include tokens like `=' which aren't supported by CPP's
+ ;; expression syntax, because they are still relevant for the tokenizer,
+ ;; especially in conjunction with ##.
+ ("=" . hif-assign)
+ ("!=" . hif-notequal)
+ ("##" . hif-token-concat)
+ ("!" . hif-not)
+ ("~" . hif-lognot)
+ ("(" . hif-lparen)
+ (")" . hif-rparen)
+ (">" . hif-greater)
+ ("<" . hif-less)
+ (">=" . hif-greater-equal)
+ ("<=" . hif-less-equal)
+ ("+" . hif-plus)
+ ("-" . hif-minus)
+ ("*" . hif-multiply)
+ ("/" . hif-divide)
+ ("%" . hif-modulo)
+ ("?" . hif-conditional)
+ (":" . hif-colon)
+ ("," . hif-comma)
+ ("#" . hif-stringify)
+ ("..." . hif-etc)))
+
+(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist))
(defconst hif-token-regexp
- (concat (regexp-opt (mapcar 'car hif-token-alist)) "\\|\\w+"))
+ (concat (regexp-opt (mapcar 'car hif-token-alist))
+ "\\|0x[0-9a-fA-F]+\\.?[0-9a-fA-F]*"
+ "\\|[0-9]+\\.?[0-9]*" ;; decimal/octal
+ "\\|\\w+"))
+
+(defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)")
+
+(defun hif-string-to-number (string &optional base)
+ "Like `string-to-number', but it understands non-decimal floats."
+ (if (or (not base) (= base 10))
+ (string-to-number string base)
+ (let* ((parts (split-string string "\\." t "[ \t]+"))
+ (frac (cadr parts))
+ (fraclen (length frac))
+ (quot (expt (if (zerop fraclen)
+ base
+ (* base 1.0)) fraclen)))
+ (/ (string-to-number (concat (car parts) frac) base) quot))))
+
+;; The dynamic binding variable `hif-simple-token-only' is shared only by
+;; `hif-tokenize' and `hif-find-define'. The purpose is to prevent `hif-tokenize'
+;; from returning one more value to indicate a simple token is scanned. This help
+;; speeding up macro evaluation on those very simple cases like integers or
+;; literals.
+;; Check the long comments before `hif-find-define' for more details. [lukelee]
+(defvar hif-simple-token-only)
(defun hif-tokenize (start end)
"Separate string between START and END into a list of tokens."
(let ((token-list nil))
+ (setq hif-simple-token-only t)
(with-syntax-table hide-ifdef-syntax-table
(save-excursion
- (goto-char start)
- (while (progn (forward-comment (point-max)) (< (point) end))
- ;; (message "expr-start = %d" expr-start) (sit-for 1)
- (cond
- ((looking-at "\\\\\n")
- (forward-char 2))
-
- ((looking-at hif-token-regexp)
- (let ((token (buffer-substring (point) (match-end 0))))
- (goto-char (match-end 0))
- ;; (message "token: %s" token) (sit-for 1)
- (push (or (cdr (assoc token hif-token-alist))
- (if (string-equal token "defined") 'hif-defined)
- (if (string-match "\\`[0-9]*\\'" token)
- (string-to-number token))
- (intern token))
- token-list)))
- (t (error "Bad #if expression: %s" (buffer-string)))))))
+ (goto-char start)
+ (while (progn (forward-comment (point-max)) (< (point) end))
+ ;; (message "expr-start = %d" expr-start) (sit-for 1)
+ (cond
+ ((looking-at "\\\\\n")
+ (forward-char 2))
+
+ ((looking-at hif-string-literal-regexp)
+ (push (substring-no-properties (match-string 1)) token-list)
+ (goto-char (match-end 0)))
+
+ ((looking-at hif-token-regexp)
+ (let ((token (buffer-substring-no-properties
+ (point) (match-end 0))))
+ (goto-char (match-end 0))
+ ;; (message "token: %s" token) (sit-for 1)
+ (push
+ (or (cdr (assoc token hif-token-alist))
+ (if (string-equal token "defined") 'hif-defined)
+ ;; TODO:
+ ;; 1. postfix 'l', 'll', 'ul' and 'ull'
+ ;; 2. floating number formats (like 1.23e4)
+ ;; 3. 098 is interpreted as octal conversion error
+ (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)"
+ token)
+ (hif-string-to-number (match-string 1 token) 16)) ;; hex
+ (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token)
+ (hif-string-to-number token 8)) ;; octal
+ (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'"
+ token)
+ (string-to-number token)) ;; decimal
+ (prog1 (intern token)
+ (setq hif-simple-token-only nil)))
+ token-list)))
+
+ ((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
+ (forward-char 1)) ; the source code. Let's not get stuck here.
+ (t (error "Bad #if expression: %s" (buffer-string)))))))
+
(nreverse token-list)))
-;;;-----------------------------------------------------------------
-;;; Translate C preprocessor #if expressions using recursive descent.
-;;; This parser is limited to the operators &&, ||, !, and "defined".
-;;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94
+;;------------------------------------------------------------------------
+;; Translate C preprocessor #if expressions using recursive descent.
+;; This parser was limited to the operators &&, ||, !, and "defined".
+;; Added ==, !=, +, and -. Gary Oberbrunner, garyo@avs.com, 8/9/94
+;;
+;; Implement the C language operator precedence table. Add all those
+;; missing operators that could be used in macros. Luke Lee 2013-09-04
+
+;; | Operator Type | Operator | Associativity |
+;; +----------------------+-----------------------------+---------------+
+;; | Primary Expression | () [] . -> expr++ expr-- | left-to-right |
+;; | Unary Operators | * & + - ! ~ ++expr --expr | right-to-left |
+;; | | (typecast) sizeof | |
+;; | Binary Operators | * / % | left-to-right |
+;; | | + - | |
+;; | | >> << | |
+;; | | < > <= >= | |
+;; | | == != | |
+;; | | & | |
+;; | | ^ | |
+;; | | | | |
+;; | | && | |
+;; | | || | |
+;; | Ternary Operator | ?: | right-to-left |
+;; x| Assignment Operators | = += -= *= /= %= >>= <<= &= | right-to-left |
+;; | | ^= = | |
+;; | Comma | , | left-to-right |
(defsubst hif-nexttoken ()
- "Pop the next token from token-list into the let variable \"hif-token\"."
+ "Pop the next token from token-list into the let variable `hif-token'."
(setq hif-token (pop hif-token-list)))
-(defun hif-parse-if-exp (token-list)
- "Parse the TOKEN-LIST. Return translated list in prefix form."
- (let ((hif-token-list token-list))
+(defsubst hif-if-valid-identifier-p (id)
+ (not (or (numberp id)
+ (stringp id))))
+
+(defun hif-define-operator (tokens)
+ "`Upgrade' hif-define xxx to '(hif-define xxx)' so it won't be substituted."
+ (let ((result nil)
+ (tok nil))
+ (while (setq tok (pop tokens))
+ (push
+ (if (eq tok 'hif-defined)
+ (progn
+ (setq tok (cadr tokens))
+ (if (eq (car tokens) 'hif-lparen)
+ (if (and (hif-if-valid-identifier-p tok)
+ (eq (nth 2 tokens) 'hif-rparen))
+ (setq tokens (cl-cdddr tokens))
+ (error "#define followed by non-identifier: %S" tok))
+ (setq tok (car tokens)
+ tokens (cdr tokens))
+ (unless (hif-if-valid-identifier-p tok)
+ (error "#define followed by non-identifier: %S" tok)))
+ (list 'hif-defined 'hif-lparen tok 'hif-rparen))
+ tok)
+ result))
+ (nreverse result)))
+
+(defun hif-flatten (l)
+ "Flatten a tree."
+ (apply #'nconc
+ (mapcar (lambda (x) (if (listp x)
+ (hif-flatten x)
+ (list x))) l)))
+
+(defun hif-expand-token-list (tokens &optional macroname expand_list)
+ "Perform expansion on TOKENS till everything expanded.
+Self-reference (directly or indirectly) tokens are not expanded.
+EXPAND_LIST is the list of macro names currently being expanded, used for
+detecting self-reference."
+ (catch 'self-referencing
+ (let ((expanded nil)
+ (remains (hif-define-operator
+ (hif-token-concatenation
+ (hif-token-stringification tokens))))
+ tok rep)
+ (if macroname
+ (setq expand_list (cons macroname expand_list)))
+ ;; Expanding all tokens till list exhausted
+ (while (setq tok (pop remains))
+ (if (memq tok expand_list)
+ ;; For self-referencing tokens, don't expand it
+ (throw 'self-referencing tokens))
+ (push
+ (cond
+ ((or (memq tok hif-valid-token-list)
+ (numberp tok)
+ (stringp tok))
+ tok)
+
+ ((setq rep (hif-lookup tok))
+ (if (and (listp rep)
+ (eq (car rep) 'hif-define-macro)) ; A defined macro
+ ;; Recursively expand it
+ (if (cadr rep) ; Argument list is not nil
+ (if (not (eq (car remains) 'hif-lparen))
+ ;; No argument, no invocation
+ tok
+ ;; Argumented macro, get arguments and invoke it.
+ ;; Dynamically bind hif-token-list and hif-token
+ ;; for hif-macro-supply-arguments
+ (let* ((hif-token-list (cdr remains))
+ (hif-token nil)
+ (parmlist (mapcar #'hif-expand-token-list
+ (hif-get-argument-list)))
+ (result
+ (hif-expand-token-list
+ (hif-macro-supply-arguments tok parmlist)
+ tok expand_list)))
+ (setq remains (cons hif-token hif-token-list))
+ result))
+ ;; Argument list is nil, direct expansion
+ (setq rep (hif-expand-token-list
+ (nth 2 rep) ; Macro's token list
+ tok expand_list))
+ ;; Replace all remaining references immediately
+ (setq remains (cl-substitute tok rep remains))
+ rep)
+ ;; Lookup tok returns an atom
+ rep))
+
+ ;;[2013-10-22 16:06:12 +0800] Must keep the token, removing
+ ;; this token might results in an incomplete expression that
+ ;; cannot be parsed further.
+ ;;((= 1 (hif-defined tok)) ; defined (hif-defined tok)=1,
+ ;; ;;but empty (hif-lookup tok)=nil, thus remove this token
+ ;; (setq remains (delete tok remains))
+ ;; nil)
+
+ (t ; Usual IDs
+ tok))
+
+ expanded))
+
+ (hif-flatten (nreverse expanded)))))
+
+(defun hif-parse-exp (token-list &optional macroname)
+ "Parse the TOKEN-LIST.
+Return translated list in prefix form. MACRONAME is applied when invoking
+macros to prevent self-reference."
+ (let ((hif-token-list (hif-expand-token-list token-list macroname)))
(hif-nexttoken)
(prog1
- (hif-expr)
+ (and hif-token
+ (hif-exprlist))
(if hif-token ; is there still a token?
(error "Error: unexpected token: %s" hif-token)))))
+(defun hif-exprlist ()
+ "Parse an exprlist: expr { ',' expr}."
+ (let ((result (hif-expr)))
+ (if (eq hif-token 'hif-comma)
+ (let ((temp (list result)))
+ (while
+ (progn
+ (hif-nexttoken)
+ (push (hif-expr) temp)
+ (eq hif-token 'hif-comma)))
+ (cons 'hif-comma (nreverse temp)))
+ result)))
+
(defun hif-expr ()
"Parse an expression as found in #if.
- expr : or-expr | or-expr '?' expr ':' expr."
+expr : or-expr | or-expr '?' expr ':' expr."
(let ((result (hif-or-expr))
- middle)
+ middle)
(while (eq hif-token 'hif-conditional)
(hif-nexttoken)
(setq middle (hif-expr))
(if (eq hif-token 'hif-colon)
- (progn
- (hif-nexttoken)
- (setq result (list 'hif-conditional result middle (hif-expr))))
- (error "Error: unexpected token: %s" hif-token)))
+ (progn
+ (hif-nexttoken)
+ (setq result (list 'hif-conditional result middle (hif-expr))))
+ (error "Error: unexpected token: %s" hif-token)))
result))
(defun hif-or-expr ()
- "Parse n or-expr : and-expr | or-expr '||' and-expr."
+ "Parse an or-expr : and-expr | or-expr '||' and-expr."
(let ((result (hif-and-expr)))
- (while (eq hif-token 'or)
+ (while (eq hif-token 'hif-or)
(hif-nexttoken)
(setq result (list 'hif-or result (hif-and-expr))))
result))
(defun hif-and-expr ()
- "Parse an and-expr : eq-expr | and-expr '&&' eq-expr."
+ "Parse an and-expr : logior-expr | and-expr '&&' logior-expr."
+ (let ((result (hif-logior-expr)))
+ (while (eq hif-token 'hif-and)
+ (hif-nexttoken)
+ (setq result (list 'hif-and result (hif-logior-expr))))
+ result))
+
+(defun hif-logior-expr ()
+ "Parse a logor-expr : logxor-expr | logor-expr '|' logxor-expr."
+ (let ((result (hif-logxor-expr)))
+ (while (eq hif-token 'hif-logior)
+ (hif-nexttoken)
+ (setq result (list 'hif-logior result (hif-logxor-expr))))
+ result))
+
+(defun hif-logxor-expr ()
+ "Parse a logxor-expr : logand-expr | logxor-expr '^' logand-expr."
+ (let ((result (hif-logand-expr)))
+ (while (eq hif-token 'hif-logxor)
+ (hif-nexttoken)
+ (setq result (list 'hif-logxor result (hif-logand-expr))))
+ result))
+
+(defun hif-logand-expr ()
+ "Parse a logand-expr : eq-expr | logand-expr '&' eq-expr."
(let ((result (hif-eq-expr)))
- (while (eq hif-token 'and)
+ (while (eq hif-token 'hif-logand)
(hif-nexttoken)
- (setq result (list 'hif-and result (hif-eq-expr))))
+ (setq result (list 'hif-logand result (hif-eq-expr))))
result))
(defun hif-eq-expr ()
- "Parse an eq-expr : math | eq-expr `=='|`!='|`<'|`>'|`>='|`<=' math."
- (let ((result (hif-math))
+ "Parse an eq-expr : comp | eq-expr `=='|`!=' comp."
+ (let ((result (hif-comp-expr))
(eq-token nil))
- (while (memq hif-token '(equal hif-notequal hif-greater hif-less
- hif-greater-equal hif-less-equal))
+ (while (memq hif-token '(hif-equal hif-notequal))
(setq eq-token hif-token)
(hif-nexttoken)
- (setq result (list eq-token result (hif-math))))
+ (setq result (list eq-token result (hif-comp-expr))))
+ result))
+
+(defun hif-comp-expr ()
+ "Parse a comp-expr : logshift | comp-expr `<'|`>'|`>='|`<=' logshift."
+ (let ((result (hif-logshift-expr))
+ (comp-token nil))
+ (while (memq hif-token '(hif-greater hif-less hif-greater-equal
+ hif-less-equal))
+ (setq comp-token hif-token)
+ (hif-nexttoken)
+ (setq result (list comp-token result (hif-logshift-expr))))
+ result))
+
+(defun hif-logshift-expr ()
+ "Parse a logshift : math | logshift `<<'|`>>' math."
+ (let ((result (hif-math))
+ (shift-token nil))
+ (while (memq hif-token '(hif-shiftleft hif-shiftright))
+ (setq shift-token hif-token)
+ (hif-nexttoken)
+ (setq result (list shift-token result (hif-math))))
result))
(defun hif-math ()
- "Parse an expression with + or - and simpler things.
- math : factor | math '+|-' factor."
+ "Parse an expression with + or -.
+ math : muldiv | math '+|-' muldiv."
+ (let ((result (hif-muldiv-expr))
+ (math-op nil))
+ (while (memq hif-token '(hif-plus hif-minus))
+ (setq math-op hif-token)
+ (hif-nexttoken)
+ (setq result (list math-op result (hif-muldiv-expr))))
+ result))
+
+(defun hif-muldiv-expr ()
+ "Parse an expression with *,/,%.
+ muldiv : factor | muldiv '*|/|%' factor."
(let ((result (hif-factor))
- (math-op nil))
- (while (memq hif-token '(hif-plus hif-minus hif-logior hif-logand))
+ (math-op nil))
+ (while (memq hif-token '(hif-multiply hif-divide hif-modulo))
(setq math-op hif-token)
(hif-nexttoken)
(setq result (list math-op result (hif-factor))))
result))
(defun hif-factor ()
- "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id."
+ "Parse a factor.
+factor : '!' factor | '~' factor | '(' expr ')' | 'defined(' id ')' |
+ 'id(parmlist)' | strings | id."
(cond
- ((eq hif-token 'not)
+ ((eq hif-token 'hif-not)
(hif-nexttoken)
(list 'hif-not (hif-factor)))
- ((eq hif-token 'lparen)
+ ((eq hif-token 'hif-lognot)
+ (hif-nexttoken)
+ (list 'hif-lognot (hif-factor)))
+
+ ((eq hif-token 'hif-lparen)
(hif-nexttoken)
- (let ((result (hif-expr)))
- (if (not (eq hif-token 'rparen))
- (error "Bad token in parenthesized expression: %s" hif-token)
- (hif-nexttoken)
- result)))
+ (let ((result (hif-exprlist)))
+ (if (not (eq hif-token 'hif-rparen))
+ (error "Bad token in parenthesized expression: %s" hif-token)
+ (hif-nexttoken)
+ result)))
((eq hif-token 'hif-defined)
(hif-nexttoken)
- (let ((paren (when (eq hif-token 'lparen) (hif-nexttoken) t))
- (ident hif-token))
- (if (memq hif-token '(or and not hif-defined lparen rparen))
- (error "Error: unexpected token: %s" hif-token))
+ (let ((paren (when (eq hif-token 'hif-lparen) (hif-nexttoken) t))
+ (ident hif-token))
+ (if (memq hif-token '(or and not hif-defined hif-lparen hif-rparen))
+ (error "Error: unexpected token: %s" hif-token))
(when paren
- (hif-nexttoken)
- (unless (eq hif-token 'rparen)
- (error "Error: expected \")\" after identifier")))
+ (hif-nexttoken)
+ (unless (eq hif-token 'hif-rparen)
+ (error "Error: expected \")\" after identifier")))
(hif-nexttoken)
`(hif-defined (quote ,ident))))
((numberp hif-token)
(prog1 hif-token (hif-nexttoken)))
+ ((stringp hif-token)
+ (hif-string-concatenation))
;; Unary plus/minus.
((memq hif-token '(hif-minus hif-plus))
(list (prog1 hif-token (hif-nexttoken)) 0 (hif-factor)))
- (t ; identifier
+ (t ; identifier
(let ((ident hif-token))
- (if (memq ident '(or and))
- (error "Error: missing identifier"))
(hif-nexttoken)
- `(hif-lookup (quote ,ident))))))
+ (if (eq hif-token 'hif-lparen)
+ (hif-place-macro-invocation ident)
+ `(hif-lookup (quote ,ident)))))))
+
+(defun hif-get-argument-list ()
+ (let ((nest 0)
+ (parmlist nil) ; A "token" list of parameters, will later be parsed
+ (parm nil))
+
+ (while (or (not (eq (hif-nexttoken) 'hif-rparen))
+ (/= nest 0))
+ (if (eq (car (last parm)) 'hif-comma)
+ (setq parm nil))
+ (cond
+ ((eq hif-token 'hif-lparen)
+ (setq nest (1+ nest)))
+ ((eq hif-token 'hif-rparen)
+ (setq nest (1- nest)))
+ ((and (eq hif-token 'hif-comma)
+ (= nest 0))
+ (push (nreverse parm) parmlist)
+ (setq parm nil)))
+ (push hif-token parm))
+
+ (push (nreverse parm) parmlist) ; Okay even if PARM is nil
+ (hif-nexttoken) ; Drop the `hif-rparen', get next token
+ (nreverse parmlist)))
+
+(defun hif-place-macro-invocation (ident)
+ (let ((parmlist (hif-get-argument-list)))
+ `(hif-invoke (quote ,ident) (quote ,parmlist))))
+
+(defun hif-string-concatenation ()
+ "Parse concatenated strings: string | strings string."
+ (let ((result (substring-no-properties hif-token)))
+ (while (stringp (hif-nexttoken))
+ (setq result (concat
+ (substring result 0 -1) ; remove trailing '"'
+ (substring hif-token 1)))) ; remove leading '"'
+ result))
+
+(defun hif-define-macro (_parmlist _token-body)
+ "A marker for defined macro with arguments.
+This macro cannot be evaluated alone without parameters input."
+ ;;TODO: input arguments at run time, use minibuffer to query all arguments
+ (error
+ "Argumented macro cannot be evaluated without passing any parameter"))
+
+(defun hif-stringify (a)
+ "Stringify a number, string or symbol."
+ (cond
+ ((numberp a)
+ (number-to-string a))
+ ((atom a)
+ (symbol-name a))
+ ((stringp a)
+ (concat "\"" a "\""))
+ (t
+ (error "Invalid token to stringify"))))
+
+(defun intern-safe (str)
+ (if (stringp str)
+ (intern str)))
+
+(defun hif-token-concat (a b)
+ "Concatenate two tokens into a longer token.
+Currently support only simple token concatenation. Also support weird (but
+valid) token concatenation like '>' ## '>' becomes '>>'. Here we take care only
+those that can be evaluated during preprocessing time and ignore all those that
+can only be evaluated at C(++) runtime (like '++', '--' and '+='...)."
+ (if (or (memq a hif-valid-token-list)
+ (memq b hif-valid-token-list))
+ (let* ((ra (car (rassq a hif-token-alist)))
+ (rb (car (rassq b hif-token-alist)))
+ (result (and ra rb
+ (cdr (assoc (concat ra rb) hif-token-alist)))))
+ (or result
+ ;;(error "Invalid token to concatenate")
+ (error "Concatenating \"%s\" and \"%s\" does not give a valid \
+preprocessing token"
+ (or ra (symbol-name a))
+ (or rb (symbol-name b)))))
+ (intern-safe (concat (hif-stringify a)
+ (hif-stringify b)))))
(defun hif-mathify (val)
"Treat VAL as a number: if it's t or nil, use 1 or 0."
@@ -541,38 +1031,199 @@ that form should be displayed.")
(or (not (zerop (hif-mathify a))) (not (zerop (hif-mathify b)))))
(defun hif-not (a)
(zerop (hif-mathify a)))
+(defun hif-lognot (a)
+ (lognot (hif-mathify a)))
(defmacro hif-mathify-binop (fun)
`(lambda (a b)
,(format "Like `%s' but treat t and nil as 1 and 0." fun)
(,fun (hif-mathify a) (hif-mathify b))))
+(defun hif-shiftleft (a b)
+ (setq a (hif-mathify a))
+ (setq b (hif-mathify b))
+ (if (< a 0)
+ (ash a b)
+ (lsh a b)))
+
+(defun hif-shiftright (a b)
+ (setq a (hif-mathify a))
+ (setq b (hif-mathify b))
+ (if (< a 0)
+ (ash a (- b))
+ (lsh a (- b))))
+
+
+(defalias 'hif-multiply (hif-mathify-binop *))
+(defalias 'hif-divide (hif-mathify-binop /))
+(defalias 'hif-modulo (hif-mathify-binop %))
(defalias 'hif-plus (hif-mathify-binop +))
(defalias 'hif-minus (hif-mathify-binop -))
+(defalias 'hif-equal (hif-mathify-binop =))
(defalias 'hif-notequal (hif-mathify-binop /=))
(defalias 'hif-greater (hif-mathify-binop >))
(defalias 'hif-less (hif-mathify-binop <))
(defalias 'hif-greater-equal (hif-mathify-binop >=))
(defalias 'hif-less-equal (hif-mathify-binop <=))
(defalias 'hif-logior (hif-mathify-binop logior))
+(defalias 'hif-logxor (hif-mathify-binop logxor))
(defalias 'hif-logand (hif-mathify-binop logand))
+
+(defun hif-comma (&rest expr)
+ "Evaluate a list of EXPR, return the result of the last item."
+ (let ((result nil))
+ (dolist (e expr)
+ (ignore-errors
+ (setq result (funcall hide-ifdef-evaluator e))))
+ result))
+
+(defun hif-token-stringification (l)
+ "Scan token list for `hif-stringify' ('#') token and stringify the next token."
+ (let (result)
+ (while l
+ (push (if (eq (car l) 'hif-stringify)
+ (prog1
+ (if (cadr l)
+ (hif-stringify (cadr l))
+ (error "No token to stringify"))
+ (setq l (cdr l)))
+ (car l))
+ result)
+ (setq l (cdr l)))
+ (nreverse result)))
+
+(defun hif-token-concatenation (l)
+ "Scan token list for `hif-token-concat' ('##') token and concatenate two tokens."
+ (let ((prev nil)
+ result)
+ (while l
+ (while (eq (car l) 'hif-token-concat)
+ (unless prev
+ (error "No token before ## to concatenate"))
+ (unless (cdr l)
+ (error "No token after ## to concatenate"))
+ (setq prev (hif-token-concat prev (cadr l)))
+ (setq l (cddr l)))
+ (if prev
+ (setq result (append result (list prev))))
+ (setq prev (car l)
+ l (cdr l)))
+ (if prev
+ (append result (list prev))
+ result)))
+
+(defun hif-delimit (lis atom)
+ (nconc (cl-mapcan (lambda (l) (list l atom))
+ (butlast lis))
+ (last lis)))
+
+;; Perform token replacement:
+(defun hif-macro-supply-arguments (macro-name actual-parms)
+ "Expand a macro call, replace ACTUAL-PARMS in the macro body."
+ (let* ((SA (assoc macro-name hide-ifdef-env))
+ (macro (and SA
+ (cdr SA)
+ (eq (cadr SA) 'hif-define-macro)
+ (cddr SA)))
+ (formal-parms (and macro (car macro)))
+ (macro-body (and macro (cadr macro)))
+ actual-count
+ formal-count
+ formal
+ etc)
+
+ (when (and actual-parms formal-parms macro-body)
+ ;; For each actual parameter, evaluate each one and associate it
+ ;; with an actual parameter, put it into local table and finally
+ ;; evaluate the macro body.
+ (if (setq etc (eq (car formal-parms) 'hif-etc))
+ ;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed.
+ (setq formal-parms (cdr formal-parms)))
+ (setq formal-count (length formal-parms)
+ actual-count (length actual-parms))
+
+ (if (> formal-count actual-count)
+ (error "Too few parameters for macro %S" macro-name)
+ (if (< formal-count actual-count)
+ (or etc
+ (error "Too many parameters for macro %S" macro-name))))
+
+ ;; Perform token replacement on the MACRO-BODY with the parameters
+ (while (setq formal (pop formal-parms))
+ ;; Prevent repetitive substitution, thus cannot use `subst'
+ ;; for example:
+ ;; #define mac(a,b) (a+b)
+ ;; #define testmac mac(b,y)
+ ;; testmac should expand to (b+y): replace of argument a and b
+ ;; occurs simultaneously, not sequentially. If sequentially,
+ ;; according to the argument order, it will become:
+ ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b)
+ ;; becomes (b+b)
+ ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b)
+ ;; becomes (y+y).
+ (setq macro-body
+ ;; Unlike `subst', `substitute' replace only the top level
+ ;; instead of the whole tree; more importantly, it's not
+ ;; destructive.
+ (cl-substitute (if (and etc (null formal-parms))
+ (hif-delimit actual-parms 'hif-comma)
+ (car actual-parms))
+ formal macro-body))
+ (setq actual-parms (cdr actual-parms)))
+
+ ;; Replacement completed, flatten the whole token list
+ (setq macro-body (hif-flatten macro-body))
+
+ ;; Stringification and token concatenation happens here
+ (hif-token-concatenation (hif-token-stringification macro-body)))))
+
+(defun hif-invoke (macro-name actual-parms)
+ "Invoke a macro by expanding it, reparse macro-body and finally invoke it."
+ ;; Reparse the macro body and evaluate it
+ (funcall hide-ifdef-evaluator
+ (hif-parse-exp
+ (hif-macro-supply-arguments macro-name actual-parms)
+ macro-name)))
+
;;;----------- end of parser -----------------------
-(defun hif-canonicalize ()
- "When at beginning of #ifX, return a Lisp expression for its condition."
+(defun hif-canonicalize-tokens (regexp) ; For debugging
+ "Return the expanded result of the scanned tokens."
(save-excursion
- (let ((negate (looking-at hif-ifndef-regexp)))
- (re-search-forward hif-ifx-regexp)
- (let* ((tokens (hif-tokenize (point)
- (progn (hif-end-of-line) (point))))
- (expr (hif-parse-if-exp tokens)))
- ;; (message "hif-canonicalized: %s" expr)
- (if negate
- (list 'hif-not expr)
- expr)))))
-
+ (re-search-forward regexp)
+ (let* ((curr-regexp (match-string 0))
+ (defined (string-match hif-ifxdef-regexp curr-regexp))
+ (negate (and defined
+ (string= (match-string 2 curr-regexp) "n")))
+ (hif-simple-token-only nil) ;; Dynamic binding var for `hif-tokenize'
+ (tokens (hif-tokenize (point)
+ (progn (hif-end-of-line) (point)))))
+ (if defined
+ (setq tokens (list 'hif-defined tokens)))
+ (if negate
+ (setq tokens (list 'hif-not tokens)))
+ tokens)))
+
+(defun hif-canonicalize (regexp)
+ "Return a Lisp expression for its condition by scanning current buffer.
+Do this when cursor is at the beginning of `regexp' (i.e. #ifX)."
+ (let ((case-fold-search nil))
+ (save-excursion
+ (re-search-forward regexp)
+ (let* ((curr-regexp (match-string 0))
+ (defined (string-match hif-ifxdef-regexp curr-regexp))
+ (negate (and defined
+ (string= (match-string 2 curr-regexp) "n")))
+ (hif-simple-token-only nil) ; Dynamic binding for `hif-tokenize'
+ (tokens (hif-tokenize (point)
+ (progn (hif-end-of-line) (point)))))
+ (if defined
+ (setq tokens (list 'hif-defined tokens)))
+ (if negate
+ (setq tokens (list 'hif-not tokens)))
+ (hif-parse-exp tokens)))))
(defun hif-find-any-ifX ()
"Move to next #if..., or #ifndef, at point or after."
@@ -583,10 +1234,10 @@ that form should be displayed.")
(defun hif-find-next-relevant ()
- "Move to next #if..., #else, or #endif, after the current line."
+ "Move to next #if..., #elif..., #else, or #endif, after the current line."
;; (message "hif-find-next-relevant at %d" (point))
(end-of-line)
- ;; avoid infinite recursion by only going to beginning of line if match found
+ ;; Avoid infinite recursion by only going to line-beginning if match found
(if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
(beginning-of-line)))
@@ -594,33 +1245,37 @@ that form should be displayed.")
"Move to previous #if..., #else, or #endif, before the current line."
;; (message "hif-find-previous-relevant at %d" (point))
(beginning-of-line)
- ;; avoid infinite recursion by only going to beginning of line if match found
+ ;; Avoid infinite recursion by only going to line-beginning if match found
(if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
(beginning-of-line)))
-(defun hif-looking-at-ifX () ;; Should eventually see #if
- (looking-at hif-ifx-regexp))
+(defun hif-looking-at-ifX ()
+ (looking-at hif-ifx-regexp)) ; Should eventually see #if
(defun hif-looking-at-endif ()
(looking-at hif-endif-regexp))
(defun hif-looking-at-else ()
(looking-at hif-else-regexp))
+(defun hif-looking-at-elif ()
+ (looking-at hif-elif-regexp))
(defun hif-ifdef-to-endif ()
- "If positioned at #ifX or #else form, skip to corresponding #endif."
+ "If positioned at #ifX, #elif, or #else form, skip to corresponding #endif."
;; (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
(hif-find-next-relevant)
(cond ((hif-looking-at-ifX)
- (hif-ifdef-to-endif) ; find endif of nested if
- (hif-ifdef-to-endif)) ; find outer endif or else
- ((hif-looking-at-else)
- (hif-ifdef-to-endif)) ; find endif following else
- ((hif-looking-at-endif)
- 'done)
- (t
- (error "Mismatched #ifdef #endif pair"))))
+ (hif-ifdef-to-endif) ; Find endif of nested if
+ (hif-ifdef-to-endif)) ; Find outer endif or else
+ ((hif-looking-at-elif)
+ (hif-ifdef-to-endif))
+ ((hif-looking-at-else)
+ (hif-ifdef-to-endif)) ; Find endif following else
+ ((hif-looking-at-endif)
+ 'done)
+ (t
+ (error "Mismatched #ifdef #endif pair"))))
(defun hif-endif-to-ifdef ()
@@ -629,15 +1284,18 @@ that form should be displayed.")
(let ((start (point)))
(hif-find-previous-relevant)
(if (= start (point))
- (error "Mismatched #ifdef #endif pair")))
+ (error "Mismatched #ifdef #endif pair")))
(cond ((hif-looking-at-endif)
- (hif-endif-to-ifdef) ; find beginning of nested if
- (hif-endif-to-ifdef)) ; find beginning of outer if or else
- ((hif-looking-at-else)
- (hif-endif-to-ifdef))
- ((hif-looking-at-ifX)
- 'done)
- (t))) ; never gets here
+ (hif-endif-to-ifdef) ; Find beginning of nested if
+ (hif-endif-to-ifdef)) ; Find beginning of outer if or else
+ ((hif-looking-at-elif)
+ (hif-endif-to-ifdef))
+ ((hif-looking-at-else)
+ (hif-endif-to-ifdef))
+ ((hif-looking-at-ifX)
+ 'done)
+ (t
+ (error "Mismatched #endif")))) ; never gets here
(defun forward-ifdef (&optional arg)
@@ -731,26 +1389,25 @@ With argument, do this that many times."
;;===%%SF%% hide-ifdef-hiding (Start) ===
-;;; A range is a structure with four components:
-;;; ELSE-P True if there was an else clause for the ifdef.
-;;; START The start of the range. (beginning of line)
-;;; ELSE The else marker (beginning of line)
-;;; Only valid if ELSE-P is true.
-;;; END The end of the range. (beginning of line)
+;; A range is a structure with four components:
+;; START The start of the range. (beginning of line)
+;; ELSE The else marker (beginning of line)
+;; END The end of the range. (beginning of line)
+;; ELIF A sequence of #elif markers (beginning of line)
-(defsubst hif-make-range (start end &optional else)
- (list start else end))
+(defsubst hif-make-range (start end &optional else elif)
+ (list start else end elif))
(defsubst hif-range-start (range) (elt range 0))
(defsubst hif-range-else (range) (elt range 1))
(defsubst hif-range-end (range) (elt range 2))
+(defsubst hif-range-elif (range) (elt range 3))
-
-;;; Find-Range
-;;; The workhorse, it delimits the #if region. Reasonably simple:
-;;; Skip until an #else or #endif is found, remembering positions. If
-;;; an #else was found, skip some more, looking for the true #endif.
+;; Find-Range
+;; The workhorse, it delimits the #if region. Reasonably simple:
+;; Skip until an #else or #endif is found, remembering positions. If
+;; an #else was found, skip some more, looking for the true #endif.
(defun hif-find-range ()
"Return a Range structure describing the current #if region.
@@ -759,35 +1416,40 @@ Point is left unchanged."
(save-excursion
(beginning-of-line)
(let ((start (point))
- (else nil)
- (end nil))
- ;; Part one. Look for either #endif or #else.
+ (elif nil)
+ (else nil)
+ (end nil))
+ ;; Part one. Look for either #elif, #else or #endif.
;; This loop-and-a-half dedicated to E. Dijkstra.
- (while (progn
- (hif-find-next-relevant)
- (hif-looking-at-ifX)) ; Skip nested ifdef
- (hif-ifdef-to-endif))
- ;; Found either a #else or an #endif.
- (cond ((hif-looking-at-else)
- (setq else (point)))
- (t
- (setq end (point)))) ; (line-end-position)
+ (while (and (not else) (not end))
+ (while (progn
+ (hif-find-next-relevant)
+ (hif-looking-at-ifX)) ; Skip nested ifdef
+ (hif-ifdef-to-endif))
+ ;; Found either a #else, #elif, or an #endif.
+ (cond ((hif-looking-at-elif)
+ (setq elif (nconc elif (list (point)))))
+ ((hif-looking-at-else)
+ (setq else (point)))
+ (t
+ (setq end (point)))))
;; If found #else, look for #endif.
(when else
- (while (progn
- (hif-find-next-relevant)
- (hif-looking-at-ifX)) ; Skip nested ifdef
- (hif-ifdef-to-endif))
- (if (hif-looking-at-else)
- (error "Found two elses in a row? Broken!"))
- (setq end (point))) ; (line-end-position)
- (hif-make-range start end else))))
+ (while (progn
+ (hif-find-next-relevant)
+ (hif-looking-at-ifX)) ; Skip nested ifdef
+ (hif-ifdef-to-endif))
+ (if (hif-looking-at-else)
+ (error "Found two elses in a row? Broken!"))
+ (setq end (point))) ; (line-end-position)
+ (hif-make-range start end else elif))))
-;;; A bit slimy.
+;; A bit slimy.
(defun hif-hide-line (point)
- "Hide the line containing point. Does nothing if `hide-ifdef-lines' is nil."
+ "Hide the line containing point.
+Does nothing if `hide-ifdef-lines' is nil."
(when hide-ifdef-lines
(save-excursion
(goto-char point)
@@ -795,80 +1457,323 @@ Point is left unchanged."
(line-beginning-position) (progn (hif-end-of-line) (point))))))
-;;; Hif-Possibly-Hide
-;;; There are four cases. The #ifX expression is "taken" if it
-;;; the hide-ifdef-evaluator returns T. Presumably, this means the code
-;;; inside the #ifdef would be included when the program was
-;;; compiled.
-;;;
-;;; Case 1: #ifX taken, and there's an #else.
-;;; The #else part must be hidden. The #if (then) part must be
-;;; processed for nested #ifX's.
-;;; Case 2: #ifX taken, and there's no #else.
-;;; The #if part must be processed for nested #ifX's.
-;;; Case 3: #ifX not taken, and there's an #else.
-;;; The #if part must be hidden. The #else part must be processed
-;;; for nested #ifs.
-;;; Case 4: #ifX not taken, and there's no #else.
-;;; The #ifX part must be hidden.
-;;;
-;;; Further processing is done by narrowing to the relevant region
-;;; and just recursively calling hide-ifdef-guts.
-;;;
-;;; When hif-possibly-hide returns, point is at the end of the
-;;; possibly-hidden range.
-
-(defun hif-recurse-on (start end)
+;; Hif-Possibly-Hide
+;; There are four cases. The #ifX expression is "taken" if it
+;; the hide-ifdef-evaluator returns T. Presumably, this means the code
+;; inside the #ifdef would be included when the program was
+;; compiled.
+;;
+;; Case 1: #ifX taken, and there's an #else.
+;; The #else part must be hidden. The #if (then) part must be
+;; processed for nested #ifX's.
+;; Case 2: #ifX taken, and there's no #else.
+;; The #if part must be processed for nested #ifX's.
+;; Case 3: #ifX not taken, and there's an #elif
+;; The #if part must be hidden, and then evaluate
+;; the #elif condition like a new #ifX.
+;; Case 4: #ifX not taken, and there's just an #else.
+;; The #if part must be hidden. The #else part must be processed
+;; for nested #ifs.
+;; Case 5: #ifX not taken, and there's no #else.
+;; The #ifX part must be hidden.
+;;
+;; Further processing is done by narrowing to the relevant region
+;; and just recursively calling hide-ifdef-guts.
+;;
+;; When hif-possibly-hide returns, point is at the end of the
+;; possibly-hidden range.
+
+(defvar hif-recurse-level 0)
+
+(defun hif-recurse-on (start end &optional dont-go-eol)
"Call `hide-ifdef-guts' after narrowing to end of START line and END line."
(save-excursion
(save-restriction
(goto-char start)
- (end-of-line)
+ (unless dont-go-eol
+ (end-of-line))
(narrow-to-region (point) end)
- (hide-ifdef-guts))))
+ (let ((hif-recurse-level (1+ hif-recurse-level)))
+ (hide-ifdef-guts)))))
-(defun hif-possibly-hide ()
+(defun hif-possibly-hide (expand-reinclusion)
"Called at #ifX expression, this hides those parts that should be hidden.
-It uses the judgment of `hide-ifdef-evaluator'."
+It uses the judgment of `hide-ifdef-evaluator'. EXPAND-REINCLUSION is a flag
+indicating that we should expand the #ifdef even if it should be hidden.
+Refer to `hide-ifdef-expand-reinclusion-protection' for more details."
;; (message "hif-possibly-hide") (sit-for 1)
- (let ((test (hif-canonicalize))
- (range (hif-find-range)))
+ (let* ((case-fold-search nil)
+ (test (hif-canonicalize hif-ifx-regexp))
+ (range (hif-find-range))
+ (elifs (hif-range-elif range))
+ (if-part t) ; Everytime we start from if-part
+ (complete nil))
;; (message "test = %s" test) (sit-for 1)
(hif-hide-line (hif-range-end range))
- (if (not (hif-not (funcall hide-ifdef-evaluator test)))
- (cond ((hif-range-else range) ; case 1
- (hif-hide-line (hif-range-else range))
- (hide-ifdef-region (hif-range-else range)
- (1- (hif-range-end range)))
- (hif-recurse-on (hif-range-start range)
- (hif-range-else range)))
- (t ; case 2
- (hif-recurse-on (hif-range-start range)
- (hif-range-end range))))
- (cond ((hif-range-else range) ; case 3
- (hif-hide-line (hif-range-else range))
- (hide-ifdef-region (hif-range-start range)
- (1- (hif-range-else range)))
- (hif-recurse-on (hif-range-else range)
- (hif-range-end range)))
- (t ; case 4
- (hide-ifdef-region (point)
- (1- (hif-range-end range))))))
+ (while (not complete)
+ (if (and (not (and expand-reinclusion if-part))
+ (hif-not (funcall hide-ifdef-evaluator test)))
+ ;; ifX/elif is FALSE
+ (if elifs
+ ;; Case 3 - Hide the #ifX and eval #elif
+ (let ((newstart (car elifs)))
+ (hif-hide-line (hif-range-start range))
+ (hide-ifdef-region (hif-range-start range)
+ (1- newstart))
+ (setcar range newstart)
+ (goto-char newstart)
+ (setq elifs (cdr elifs))
+ (setq test (hif-canonicalize hif-elif-regexp)))
+
+ ;; Check for #else
+ (cond ((hif-range-else range)
+ ;; Case 4 - #else block visible
+ (hif-hide-line (hif-range-else range))
+ (hide-ifdef-region (hif-range-start range)
+ (1- (hif-range-else range)))
+ (hif-recurse-on (hif-range-else range)
+ (hif-range-end range)))
+ (t
+ ;; Case 5 - No #else block, hide #ifX
+ (hide-ifdef-region (point)
+ (1- (hif-range-end range)))))
+ (setq complete t))
+
+ ;; ifX/elif is TRUE
+ (cond (elifs
+ ;; Luke fix: distinguish from #elif..#elif to #elif..#else
+ (let ((elif (car elifs)))
+ ;; hide all elifs
+ (hif-hide-line elif)
+ (hide-ifdef-region elif (1- (hif-range-end range)))
+ (hif-recurse-on (hif-range-start range)
+ elif)))
+ ((hif-range-else range)
+ ;; Case 1 - Hide #elif and #else blocks, recurse #ifX
+ (hif-hide-line (hif-range-else range))
+ (hide-ifdef-region (hif-range-else range)
+ (1- (hif-range-end range)))
+ (hif-recurse-on (hif-range-start range)
+ (hif-range-else range)))
+ (t
+ ;; Case 2 - No #else, just recurse #ifX
+ (hif-recurse-on (hif-range-start range)
+ (hif-range-end range))))
+ (setq complete t))
+ (setq if-part nil))
+
+ ;; complete = t
(hif-hide-line (hif-range-start range)) ; Always hide start.
(goto-char (hif-range-end range))
(end-of-line)))
+(defun hif-evaluate-region (start end)
+ (let* ((tokens (ignore-errors ; Prevent C statement things like
+ ; 'do { ... } while (0)'
+ (hif-tokenize start end)))
+ (expr (and tokens
+ (condition-case nil
+ (hif-parse-exp tokens)
+ (error
+ tokens))))
+ (result (funcall hide-ifdef-evaluator expr)))
+ result))
+(defun hif-evaluate-macro (rstart rend)
+ "Evaluate the macro expansion result for a region.
+If no region active, find the current #ifdefs and evaluate the result.
+Currently it supports only math calculations, strings or argumented macros can
+not be expanded."
+ (interactive "r")
+ (let ((case-fold-search nil))
+ (save-excursion
+ (unless mark-active
+ (setq rstart nil rend nil)
+ (beginning-of-line)
+ (when (and (re-search-forward hif-macro-expr-prefix-regexp nil t)
+ (string= "define" (match-string 2)))
+ (re-search-forward hif-macroref-regexp nil t)))
+ (let* ((start (or rstart (point)))
+ (end (or rend (progn (hif-end-of-line) (point))))
+ (defined nil)
+ (simple 't)
+ (tokens (ignore-errors ; Prevent C statement things like
+ ; 'do { ... } while (0)'
+ (hif-tokenize start end)))
+ (expr (or (and (<= (length tokens) 1) ; Simple token
+ (setq defined (assoc (car tokens) hide-ifdef-env))
+ (setq simple (atom (hif-lookup (car tokens))))
+ (hif-lookup (car tokens)))
+ (and tokens
+ (condition-case nil
+ (hif-parse-exp tokens)
+ (error
+ nil)))))
+ (result (funcall hide-ifdef-evaluator expr))
+ (exprstring (replace-regexp-in-string
+ ;; Trim off leading/trailing whites
+ "^[ \t]*\\([^ \t]+\\)[ \t]*" "\\1"
+ (replace-regexp-in-string
+ "\\(//.*\\)" "" ; Trim off end-of-line comments
+ (buffer-substring-no-properties start end)))))
+ (cond
+ ((and (<= (length tokens) 1) simple) ; Simple token
+ (if defined
+ (message "%S <= `%s'" result exprstring)
+ (message "`%s' is not defined" exprstring)))
+ ((integerp result)
+ (if (or (= 0 result) (= 1 result))
+ (message "%S <= `%s'" result exprstring)
+ (message "%S (0x%x) <= `%s'" result result exprstring)))
+ ((null result) (message "%S <= `%s'" 'false exprstring))
+ ((eq t result) (message "%S <= `%s'" 'true exprstring))
+ (t (message "%S <= `%s'" result exprstring)))
+ result))))
+
+(defun hif-parse-macro-arglist (str)
+ "Parse argument list formatted as '( arg1 [ , argn] [...] )'.
+The '...' is also included. Return a list of the arguments, if '...' exists the
+first arg will be `hif-etc'."
+ (let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize'
+ (tokenlist
+ (cdr (hif-tokenize
+ (- (point) (length str)) (point)))) ; Remove `hif-lparen'
+ etc result token)
+ (while (not (eq (setq token (pop tokenlist)) 'hif-rparen))
+ (cond
+ ((eq token 'hif-etc)
+ (setq etc t))
+ ((eq token 'hif-comma)
+ t)
+ (t
+ (push token result))))
+ (if etc
+ (cons 'hif-etc (nreverse result))
+ (nreverse result))))
+
+;; The original version of hideif evaluates the macro early and store the
+;; final values for the defined macro into the symbol database (aka
+;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed
+;; tree -> [value]". (The square bracket refers to what's stored in in our
+;; `hide-ifdef-env'.)
+;;
+;; This forbids the evaluation of an argumented macro since the parameters
+;; are applied at run time. In order to support argumented macro I then
+;; 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
+;; temporarily code changes are obsolete and not in Emacs source repository.
+;;
+;; Furthermore, CPP did allow partial expression to be defined in several
+;; macros and later got concatenated into a complete expression and then
+;; evaluate it. In order to match this behavior I had to postpone one stage
+;; 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
+;; when that symbol is referenced.
+;;
+;; In real cases I found a lot portion of macros are "simple macros" that
+;; expand to literals like integers or other symbols. In order to enhance
+;; the performance I use this `hif-simple-token-only' to notify my code and
+;; save the final [value] into symbol database. [lukelee]
+
+(defun hif-find-define (&optional min max)
+ "Parse texts and retrieve all defines within the region MIN and MAX."
+ (interactive)
+ (and min (goto-char min))
+ (and (re-search-forward hif-define-regexp max t)
+ (or
+ (let* ((defining (string= "define" (match-string 2)))
+ (name (and (re-search-forward hif-macroref-regexp max t)
+ (match-string 1)))
+ (parmlist (and (match-string 3) ; First arg id found
+ (hif-parse-macro-arglist (match-string 2)))))
+ (if defining
+ ;; Ignore name (still need to return 't), or define the name
+ (or (and hide-ifdef-exclude-define-regexp
+ (string-match hide-ifdef-exclude-define-regexp
+ name))
+
+ (let* ((start (point))
+ (end (progn (hif-end-of-line) (point)))
+ (hif-simple-token-only nil) ; Dynamic binding
+ (tokens
+ (and name
+ ;; `hif-simple-token-only' is set/clear
+ ;; only in this block
+ (condition-case nil
+ ;; Prevent C statements like
+ ;; 'do { ... } while (0)'
+ (hif-tokenize start end)
+ (error
+ ;; We can't just return nil here since
+ ;; this will stop hideif from searching
+ ;; for more #defines.
+ (setq hif-simple-token-only t)
+ (buffer-substring-no-properties
+ start end)))))
+ ;; For simple tokens we save only the parsed result;
+ ;; otherwise we save the tokens and parse it after
+ ;; parameter replacement
+ (expr (and tokens
+ ;; `hif-simple-token-only' is checked only
+ ;; here.
+ (or (and hif-simple-token-only
+ (listp tokens)
+ (= (length tokens) 1)
+ (hif-parse-exp tokens))
+ `(hif-define-macro ,parmlist
+ ,tokens))))
+ (SA (and name
+ (assoc (intern name) hide-ifdef-env))))
+ (and name
+ (if SA
+ (or (setcdr SA expr) t)
+ ;; Lazy evaluation, eval only if hif-lookup find it.
+ ;; Define it anyway, even if nil it's still in list
+ ;; and therefore considered defined.
+ (push (cons (intern name) expr) hide-ifdef-env)))))
+ ;; #undef
+ (and name
+ (hif-undefine-symbol (intern name))))))
+ t))
+
+
+(defun hif-add-new-defines (&optional min max)
+ "Scan and add all #define macros between MIN and MAX."
+ (interactive)
+ (save-excursion
+ (save-restriction
+ ;; (mark-region min max) ;; for debugging
+ (while (hif-find-define min max)
+ (setf min (point)))
+ (if max (goto-char max)
+ (goto-char (point-max))))))
(defun hide-ifdef-guts ()
"Does most of the work of `hide-ifdefs'.
It does not do the work that's pointless to redo on a recursive entry."
;; (message "hide-ifdef-guts")
(save-excursion
- (goto-char (point-min))
- (while (hif-find-any-ifX)
- (hif-possibly-hide))))
+ (let* ((case-fold-search t) ; Ignore case for `hide-ifdef-header-regexp'
+ (expand-header (and hide-ifdef-expand-reinclusion-protection
+ (string-match hide-ifdef-header-regexp
+ (buffer-file-name))
+ (zerop hif-recurse-level)))
+ (case-fold-search nil)
+ min max)
+ (goto-char (point-min))
+ (setf min (point))
+ (cl-loop do
+ (setf max (hif-find-any-ifX))
+ (hif-add-new-defines min max)
+ (if max
+ (hif-possibly-hide expand-header))
+ (setf min (point))
+ while max))))
;;===%%SF%% hide-ifdef-hiding (End) ===
@@ -882,11 +1787,12 @@ It does not do the work that's pointless to redo on a recursive entry."
(message "Hide-Read-Only %s"
(if hide-ifdef-read-only "ON" "OFF"))
(if hide-ifdef-hiding
- (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
+ (setq buffer-read-only (or hide-ifdef-read-only
+ hif-outside-read-only)))
(force-mode-line-update))
(defun hide-ifdef-toggle-outside-read-only ()
- "Replacement for `toggle-read-only' within Hide-Ifdef mode."
+ "Replacement for `read-only-mode' within Hide-Ifdef mode."
(interactive)
(setq hif-outside-read-only (not hif-outside-read-only))
(message "Read only %s"
@@ -912,38 +1818,67 @@ It does not do the work that's pointless to redo on a recursive entry."
(overlay-put overlay 'face nil)
(overlay-put overlay 'invisible 'hide-ifdef))))))
-(defun hide-ifdef-define (var)
- "Define a VAR so that #ifdef VAR would be included."
- (interactive "SDefine what? ")
- (hif-set-var var 1)
+(defun hide-ifdef-define (var &optional val)
+ "Define a VAR to VAL (default 1) in `hide-ifdef-env'.
+This allows #ifdef VAR to be hidden."
+ (interactive
+ (let* ((default (save-excursion
+ (beginning-of-line)
+ (cond ((looking-at hif-ifx-else-endif-regexp)
+ (forward-word 2)
+ (current-word 'strict))
+ (t
+ nil))))
+ (var (read-minibuffer "Define what? " default))
+ (val (read-from-minibuffer (format "Set %s to? (default 1): " var)
+ nil nil t nil "1")))
+ (list var val)))
+ (hif-set-var var (or val 1))
+ (message "%s set to %s" var (or val 1))
+ (sleep-for 1)
(if hide-ifdef-hiding (hide-ifdefs)))
-(defun hide-ifdef-undef (var)
- "Undefine a VAR so that #ifdef VAR would not be included."
- (interactive "SUndefine what? ")
- (hif-set-var var nil)
- (if hide-ifdef-hiding (hide-ifdefs)))
+(defun hif-undefine-symbol (var)
+ (setq hide-ifdef-env
+ (delete (assoc var hide-ifdef-env) hide-ifdef-env)))
+(defun hide-ifdef-undef (start end)
+ "Undefine a VAR so that #ifdef VAR would not be included."
+ (interactive "r")
+ (let* ((symstr
+ (or (and mark-active
+ (buffer-substring-no-properties start end))
+ (read-string "Undefine what? " (current-word))))
+ (sym (and symstr
+ (intern symstr))))
+ (if (zerop (hif-defined sym))
+ (message "`%s' not defined, no need to undefine it" symstr)
+ (hif-undefine-symbol sym)
+ (if hide-ifdef-hiding (hide-ifdefs))
+ (message "`%S' undefined" sym))))
(defun hide-ifdefs (&optional nomsg)
"Hide the contents of some #ifdefs.
Assume that defined symbols have been added to `hide-ifdef-env'.
The text hidden is the text that would not be included by the C
preprocessor if it were given the file with those symbols defined.
+With prefix command presents it will also hide the #ifdefs themselves.
Turn off hiding by calling `show-ifdefs'."
(interactive)
- (message "Hiding...")
- (setq hif-outside-read-only buffer-read-only)
- (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode
- (if hide-ifdef-hiding
- (show-ifdefs)) ; Otherwise, deep confusion.
- (setq hide-ifdef-hiding t)
- (hide-ifdef-guts)
- (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
- (or nomsg
- (message "Hiding done")))
+ (let ((hide-ifdef-lines current-prefix-arg))
+ (or nomsg
+ (message "Hiding..."))
+ (setq hif-outside-read-only buffer-read-only)
+ (unless hide-ifdef-mode (hide-ifdef-mode 1)) ; Turn on hide-ifdef-mode
+ (if hide-ifdef-hiding
+ (show-ifdefs)) ; Otherwise, deep confusion.
+ (setq hide-ifdef-hiding t)
+ (hide-ifdef-guts)
+ (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
+ (or nomsg
+ (message "Hiding done"))))
(defun show-ifdefs ()
@@ -955,50 +1890,78 @@ Turn off hiding by calling `show-ifdefs'."
(defun hif-find-ifdef-block ()
- "Utility for hide and show `ifdef-block'.
+ "Utility to hide and show ifdef block.
Return as (TOP . BOTTOM) the extent of ifdef block."
(let (max-bottom)
(cons (save-excursion
- (beginning-of-line)
- (unless (or (hif-looking-at-else) (hif-looking-at-ifX))
- (up-ifdef))
- (prog1 (point)
- (hif-ifdef-to-endif)
- (setq max-bottom (1- (point)))))
- (save-excursion
- (beginning-of-line)
- (unless (hif-looking-at-endif)
- (hif-find-next-relevant))
- (while (hif-looking-at-ifX)
- (hif-ifdef-to-endif)
- (hif-find-next-relevant))
- (min max-bottom (1- (point)))))))
-
-
-(defun hide-ifdef-block ()
- "Hide the ifdef block (true or false part) enclosing or before the cursor."
- (interactive)
- (unless hide-ifdef-mode (hide-ifdef-mode 1))
- (let ((top-bottom (hif-find-ifdef-block)))
- (hide-ifdef-region (car top-bottom) (cdr top-bottom))
- (when hide-ifdef-lines
- (hif-hide-line (car top-bottom))
- (hif-hide-line (1+ (cdr top-bottom))))
- (setq hide-ifdef-hiding t))
- (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
-
-(defun show-ifdef-block ()
+ (beginning-of-line)
+ (unless (or (hif-looking-at-else) (hif-looking-at-ifX))
+ (up-ifdef))
+ (prog1 (point)
+ (hif-ifdef-to-endif)
+ (setq max-bottom (1- (point)))))
+ (save-excursion
+ (beginning-of-line)
+ (unless (hif-looking-at-endif)
+ (hif-find-next-relevant))
+ (while (hif-looking-at-ifX)
+ (hif-ifdef-to-endif)
+ (hif-find-next-relevant))
+ (min max-bottom (1- (point)))))))
+
+
+(defun hide-ifdef-block (&optional arg start end)
+ "Hide the ifdef block (true or false part) enclosing or before the cursor.
+With optional prefix argument ARG, also hide the #ifdefs themselves."
+ (interactive "P\nr")
+ (let ((hide-ifdef-lines arg))
+ (if mark-active
+ (let ((hif-recurse-level (1+ hif-recurse-level)))
+ (hif-recurse-on start end t)
+ (setq mark-active nil))
+ (unless hide-ifdef-mode (hide-ifdef-mode 1))
+ (let ((top-bottom (hif-find-ifdef-block)))
+ (hide-ifdef-region (car top-bottom) (cdr top-bottom))
+ (when hide-ifdef-lines
+ (hif-hide-line (car top-bottom))
+ (hif-hide-line (1+ (cdr top-bottom))))
+ (setq hide-ifdef-hiding t))
+ (setq buffer-read-only
+ (or hide-ifdef-read-only hif-outside-read-only)))))
+
+(defun show-ifdef-block (&optional start end)
"Show the ifdef block (true or false part) enclosing or before the cursor."
- (interactive)
- (let ((top-bottom (hif-find-ifdef-block)))
+ (interactive "r")
+ (if mark-active
+ (progn
+ (dolist (o (overlays-in start end))
+ (if (overlay-get o 'hide-ifdef)
+ (delete-overlay o)))
+ (setq mark-active nil))
+ (let ((top-bottom (condition-case nil
+ (hif-find-ifdef-block)
+ (error
+ nil)))
+ (ovrs (overlays-in (max (point-min) (1- (point)))
+ (min (point-max) (1+ (point)))))
+ (del nil))
+ (if top-bottom
(if hide-ifdef-lines
- (hif-show-ifdef-region
- (save-excursion
- (goto-char (car top-bottom)) (line-beginning-position))
- (save-excursion
- (goto-char (1+ (cdr top-bottom)))
- (hif-end-of-line) (point)))
- (hif-show-ifdef-region (1- (car top-bottom)) (cdr top-bottom)))))
+ (hif-show-ifdef-region
+ (save-excursion
+ (goto-char (car top-bottom)) (line-beginning-position))
+ (save-excursion
+ (goto-char (1+ (cdr top-bottom)))
+ (hif-end-of-line) (point)))
+ (setf del (hif-show-ifdef-region
+ (1- (car top-bottom)) (cdr top-bottom)))))
+ (if (not (and top-bottom
+ del))
+ (dolist (o ovrs)
+ ;;(dolist (o (overlays-in (1- (point)) (1+ (point))))
+ ;; (if (overlay-get o 'hide-ifdef) (message "%S" o)))
+ (if (overlay-get o 'hide-ifdef)
+ (delete-overlay o)))))))
;;; definition alist support
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index fc753bf7264..dba497b1f41 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -1,6 +1,6 @@
-;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks -*- coding: utf-8 -*-
+;;; hideshow.el --- minor mode cmds to selectively display code/comment blocks
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Dan Nicolaescu <dann@ics.uci.edu>
@@ -323,13 +323,13 @@ Hideshow puts a unique overlay on each range of text to be hidden
in the buffer. Here is a simple example of how to use this variable:
(defun display-code-line-counts (ov)
- (when (eq 'code (overlay-get ov 'hs))
- (overlay-put ov 'display
+ (when (eq \\='code (overlay-get ov \\='hs))
+ (overlay-put ov \\='display
(format \"... / %d\"
(count-lines (overlay-start ov)
(overlay-end ov))))))
- (setq hs-set-up-overlay 'display-code-line-counts)
+ (setq hs-set-up-overlay \\='display-code-line-counts)
This example shows how to get information from the overlay as well
as how to set its `display' property. See `hs-make-overlay' and
@@ -390,37 +390,31 @@ Use the command `hs-minor-mode' to toggle or set this variable.")
:help "Do not hidden code or comment blocks when isearch matches inside them"
:active t :style radio :selected (eq hs-isearch-open nil)])))
-(defvar hs-c-start-regexp nil
+(defvar-local hs-c-start-regexp nil
"Regexp for beginning of comments.
Differs from mode-specific comment regexps in that
surrounding whitespace is stripped.")
-(make-variable-buffer-local 'hs-c-start-regexp)
-(defvar hs-block-start-regexp nil
+(defvar-local hs-block-start-regexp nil
"Regexp for beginning of block.")
-(make-variable-buffer-local 'hs-block-start-regexp)
-(defvar hs-block-start-mdata-select nil
+(defvar-local hs-block-start-mdata-select nil
"Element in `hs-block-start-regexp' match data to consider as block start.
The internal function `hs-forward-sexp' moves point to the beginning of this
element (using `match-beginning') before calling `hs-forward-sexp-func'.")
-(make-variable-buffer-local 'hs-block-start-mdata-select)
-(defvar hs-block-end-regexp nil
+(defvar-local hs-block-end-regexp nil
"Regexp for end of block.")
-(make-variable-buffer-local 'hs-block-end-regexp)
-
-(defvar hs-forward-sexp-func 'forward-sexp
+(defvar-local hs-forward-sexp-func 'forward-sexp
"Function used to do a `forward-sexp'.
Should change for Algol-ish modes. For single-character block
delimiters -- ie, the syntax table regexp for the character is
either `(' or `)' -- `hs-forward-sexp-func' would just be
`forward-sexp'. For other modes such as simula, a more specialized
function is necessary.")
-(make-variable-buffer-local 'hs-forward-sexp-func)
-(defvar hs-adjust-block-beginning nil
+(defvar-local hs-adjust-block-beginning nil
"Function used to tweak the block beginning.
The block is hidden from the position returned by this function,
as opposed to hiding it from the position returned when searching
@@ -439,7 +433,6 @@ It should return the position from where we should start hiding.
It should not move the point.
See `hs-c-like-adjust-block-beginning' for an example of using this.")
-(make-variable-buffer-local 'hs-adjust-block-beginning)
(defvar hs-headline nil
"Text of the line where a hidden block begins, set during isearch.
@@ -789,6 +782,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments."
(unless hs-allow-nesting
(hs-discard-overlays (point-min) (point-max)))
(goto-char (point-min))
+ (syntax-propertize (point-max))
(let ((spew (make-progress-reporter "Hiding all blocks..."
(point-min) (point-max)))
(re (concat "\\("
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index 894a42811c7..b716e7da594 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -1,6 +1,6 @@
;;; icon.el --- mode for editing Icon code
-;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2015 Free Software Foundation, Inc.
;; Author: Chris Smith <csmith@convex.com>
;; Created: 15 Feb 89
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index 1ebc7f92023..a9ddeba9433 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -1,6 +1,6 @@
;;; idlw-complete-structtag.el --- Completion of structure tags.
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
@@ -49,14 +49,14 @@
;;
;; New versions of IDLWAVE, documentation, and more information available
;; from:
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
;; Put this file on the emacs load path and load it with the following
;; line in your init file:
;;
-;; (add-hook 'idlwave-load-hook
+;; (add-hook 'idlwave-load-hook
;; (lambda () (require 'idlw-complete-structtag)))
;;
;; DESCRIPTION
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index a108adccec7..4473409e344 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -1,6 +1,6 @@
;;; idlw-help.el --- HTML Help code for IDLWAVE
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;;
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -32,7 +32,7 @@
;; along with new versions of IDLWAVE, documentation, and more
;; information, at:
;;
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -434,7 +434,7 @@ It collects and prints the diagnostics messages."
;; A system variable -- only system help
((string-match
- "\\`!\\([a-zA-Z0-9_]+\\)\\(\.\\([A-Za-z0-9_]+\\)\\)?"
+ "\\`!\\([a-zA-Z0-9_]+\\)\\(\\.\\([A-Za-z0-9_]+\\)\\)?"
this-word)
(let* ((word (match-string-no-properties 1 this-word))
(entry (assq (idlwave-sintern-sysvar word)
@@ -1177,15 +1177,13 @@ Useful when source code is displayed as help. See the option
(if (featurep 'font-lock)
(let ((major-mode 'idlwave-mode)
(font-lock-verbose
- (if (called-interactively-p 'interactive) font-lock-verbose nil))
- (syntax-table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table idlwave-mode-syntax-table)
- (set (make-local-variable 'font-lock-defaults)
- idlwave-font-lock-defaults)
- (font-lock-fontify-buffer))
- (set-syntax-table syntax-table)))))
+ (if (called-interactively-p 'interactive) font-lock-verbose nil)))
+ (with-syntax-table idlwave-mode-syntax-table
+ (set (make-local-variable 'font-lock-defaults)
+ idlwave-font-lock-defaults)
+ (if (fboundp 'font-lock-ensure)
+ (font-lock-ensure)
+ (font-lock-fontify-buffer))))))
(defun idlwave-help-error (name type class keyword)
@@ -1314,7 +1312,7 @@ IDL assistant.")
(let ((help-loc (idlwave-html-help-location))
topic anchor file just-started exists full-link)
- (if (string-match "\.html" link)
+ (if (string-match "\\.html" link)
(setq topic (substring link 0 (match-beginning 0))
anchor (substring link (match-end 0)))
(error "Malformed help link"))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 5aad4aaa15f..5aeb4ea1a07 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1,6 +1,6 @@
;; idlw-shell.el --- run IDL as an inferior process of Emacs.
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@astro.uva.nl>
@@ -40,7 +40,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;; INSTALLATION:
;; =============
@@ -58,7 +58,7 @@
;; The newest version of this file can be found on the maintainers
;; web site.
;;
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -152,7 +152,7 @@ This variable can have 3 values:
nil Arrows just move the cursor
t Arrows force the cursor back to the current command line and
walk the history
-'cmdline When the cursor is in the current command line, arrows walk the
+`cmdline' When the cursor is in the current command line, arrows walk the
history. Everywhere else in the buffer, arrows move the cursor."
:group 'idlwave-shell-general-setup
:type '(choice
@@ -229,7 +229,7 @@ to set this option to nil."
(defcustom idlwave-shell-file-name-chars "~/A-Za-z0-9+:_.$#%={}\\- "
"The characters allowed in file names, as a string.
-Used for file name completion. Must not contain `'', `,' and `\"'
+Used for file name completion. Must not contain `\\='', `,' and `\"'
because these are used as separators by IDL."
:group 'idlwave-shell-general-setup
:type 'string)
@@ -379,15 +379,15 @@ This mechanism is useful for correct interaction with the IDL function
GET_KBRD, because in normal operation IDLWAVE only sends \\n terminated
strings. Here is some example code which makes use of the default spells.
- print,'<chars>' ; Make IDLWAVE switch to character mode
+ print,\\='<chars>\\=' ; Make IDLWAVE switch to character mode
REPEAT BEGIN
A = GET_KBRD(1)
PRINT, BYTE(A)
- ENDREP UNTIL A EQ 'q'
- print,'</chars>' ; Make IDLWAVE switch back to line mode
+ ENDREP UNTIL A EQ \\='q\\='
+ print,\\='</chars>\\=' ; Make IDLWAVE switch back to line mode
- print,'Quit the program, y or n?'
- print,'<onechar>' ; Ask IDLWAVE to send one character
+ print,\\='Quit the program, y or n?\\='
+ print,\\='<onechar>\\=' ; Ask IDLWAVE to send one character
answer = GET_KBRD(1)
Since the IDLWAVE shell defines the system variable `!IDLWAVE_VERSION',
@@ -403,11 +403,11 @@ idlwave_char_input,/off ; End the loop to send characters
pro idlwave_char_input,on=on,off=off
;; Test if we are running under Emacs
- defsysv,'!idlwave_version',exists=running_emacs
+ defsysv,\\='!idlwave_version\\=',exists=running_emacs
if running_emacs then begin
- if keyword_set(on) then print,'<chars>' $
- else if keyword_set(off) then print,'</chars>' $
- else print,'<onechar>'
+ if keyword_set(on) then print,\\='<chars>\\=' $
+ else if keyword_set(off) then print,\\='</chars>\\=' $
+ else print,\\='<onechar>\\='
endif
end"
:group 'idlwave-shell-command-setup
@@ -439,15 +439,13 @@ Value decides about the method which is used to mark the line. Valid values
are:
nil Do not mark the line
-'arrow Use the overlay arrow
-'face Use `idlwave-shell-stop-line-face' to highlight the line.
+`arrow' Use the overlay arrow
+`face' Use `idlwave-shell-stop-line-face' to highlight the line.
t Use what IDLWAVE thinks is best. Will be a face where possible,
otherwise the overlay arrow.
The overlay-arrow has the disadvantage to hide the first chars of a line.
Since many people do not have the main block of IDL programs indented,
-a face highlighting may be better.
-In Emacs 21, the overlay arrow is displayed in a special area and never
-hides any code, so setting this to 'arrow on Emacs 21 sounds like a good idea."
+a face highlighting may be better."
:group 'idlwave-shell-highlighting-and-faces
:type '(choice
(const :tag "No marking" nil)
@@ -494,10 +492,10 @@ where IDL is stopped, when in Electric Debug Mode."
"Non-nil means, mark breakpoints in the source files.
Valid values are:
nil Do not mark breakpoints.
-'face Highlight line with `idlwave-shell-breakpoint-face'.
-'glyph Red dot at the beginning of line. If the display does not
- support glyphs, will use 'face instead.
-t Glyph when possible, otherwise face (same effect as 'glyph)."
+`face' Highlight line with `idlwave-shell-breakpoint-face'.
+`glyph' Red dot at the beginning of line. If the display does not
+ support glyphs, will use `face' instead.
+t Glyph when possible, otherwise face (same effect as `glyph')."
:group 'idlwave-shell-highlighting-and-faces
:type '(choice
(const :tag "No marking" nil)
@@ -590,27 +588,28 @@ TYPE is either 'pro' or 'rinfo', and `idlwave-shell-temp-pro-file' or
(defun idlwave-shell-make-temp-file (prefix)
"Create a temporary file."
- ; Hard coded make-temp-file for Emacs<21
- (if (fboundp 'make-temp-file)
+ (if (featurep 'emacs)
(make-temp-file prefix)
- (let (file
- (temp-file-dir (if (boundp 'temporary-file-directory)
- temporary-file-directory
- "/tmp")))
- (while (condition-case ()
- (progn
- (setq file
- (make-temp-name
- (expand-file-name prefix temp-file-dir)))
- (if (featurep 'xemacs)
- (write-region "" nil file nil 'silent nil)
- (write-region "" nil file nil 'silent nil 'excl))
- nil)
- (file-already-exists t))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- file)))
+ (if (fboundp 'make-temp-file)
+ (make-temp-file prefix)
+ (let (file
+ (temp-file-dir (if (boundp 'temporary-file-directory)
+ temporary-file-directory
+ "/tmp")))
+ (while (condition-case ()
+ (progn
+ (setq file
+ (make-temp-name
+ (expand-file-name prefix temp-file-dir)))
+ (if (featurep 'xemacs)
+ (write-region "" nil file nil 'silent nil)
+ (write-region "" nil file nil 'silent nil 'excl))
+ nil)
+ (file-already-exists t))
+ ;; the file was somehow created by someone else between
+ ;; `make-temp-name' and `write-region', let's try again.
+ nil)
+ file))))
(defvar idlwave-shell-dirstack-query "cd,current=___cur & print,___cur"
@@ -733,7 +732,7 @@ it contains an error message, even if hide-output is non-nil.")
(defvar idlwave-shell-pending-commands nil
"List of commands to be sent to IDL.
-Each element of the list is list of \(CMD PCMD HIDE\), where CMD is a
+Each element of the list is list of \(CMD PCMD HIDE), where CMD is a
string to be sent to IDL and PCMD is a post-command to be placed on
`idlwave-shell-post-command-hook'. If HIDE is non-nil, hide the output
from command CMD. PCMD and HIDE are optional.")
@@ -922,7 +921,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://idlwave.org'.
+ homepage at URL `http://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
8. Keybindings
@@ -1241,7 +1240,7 @@ Return either nil or 'hide."
show-if-error)
"Send a command to IDL process.
-\(CMD PCMD HIDE\) are placed at the end of `idlwave-shell-pending-commands'.
+\(CMD PCMD HIDE) are placed at the end of `idlwave-shell-pending-commands'.
If IDL is ready the first command in `idlwave-shell-pending-commands',
CMD, is sent to the IDL process.
@@ -1257,7 +1256,7 @@ stepping through code with output.
If optional fourth argument PREEMPT is non-nil CMD is put at front of
`idlwave-shell-pending-commands'. If PREEMPT is 'wait, wait for all
output to complete and the next prompt to arrive before returning
-\(useful if you need an answer now\). IDL is considered ready if the
+\(useful if you need an answer now). IDL is considered ready if the
prompt is present and if `idlwave-shell-ready' is non-nil.
If SHOW-IF-ERROR is non-nil, show the output if it contains an error
@@ -1444,12 +1443,8 @@ Otherwise just move the line. Move down unless UP is non-nil."
(interactive "p")
(idlwave-shell-move-or-history nil arg))
-;; Newer versions of comint.el changed the name of comint-filter to
-;; comint-output-filter.
-(defun idlwave-shell-comint-filter (process string) nil)
-(if (fboundp 'comint-output-filter)
- (fset 'idlwave-shell-comint-filter (symbol-function 'comint-output-filter))
- (fset 'idlwave-shell-comint-filter (symbol-function 'comint-filter)))
+(define-obsolete-function-alias 'idlwave-shell-comint-filter
+ 'comint-output-filter "25.1")
(defun idlwave-shell-is-running ()
"Return t if the shell process is running."
@@ -1495,7 +1490,7 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(get-buffer-create idlwave-shell-hidden-output-buffer))
(goto-char (point-max))
(insert string))
- (idlwave-shell-comint-filter proc string))
+ (comint-output-filter proc string))
;; Watch for magic - need to accumulate the current line
;; since it may not be sent all at once.
(if (string-match "\n" string)
@@ -1551,7 +1546,7 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(if idlwave-shell-hide-output
(if (and idlwave-shell-show-if-error
(eq idlwave-shell-current-state 'error))
- (idlwave-shell-comint-filter proc full-output)
+ (comint-output-filter proc full-output)
;; If it's only *mostly* hidden, filter % lines,
;; and show anything that remains
(if (eq idlwave-shell-hide-output 'mostly)
@@ -1559,7 +1554,7 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(idlwave-shell-filter-hidden-output
full-output)))
(if filtered
- (idlwave-shell-comint-filter
+ (comint-output-filter
proc filtered))))))
;; Call the post-command hook
@@ -2641,7 +2636,7 @@ If ENABLE is non-nil, enable them instead."
(defun idlwave-shell-break-in ()
"Look for a module name near point and set a break point for it.
The command looks for an identifier near point and sets a breakpoint
-for the first line of the corresponding module. If MODULE is `t', set
+for the first line of the corresponding module. If MODULE is t, set
in the current routine."
(interactive)
(let* ((module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
@@ -3127,7 +3122,7 @@ versions of IDL."
(string-match "\\.\\'" pre))) ;; structure member
;; Skip over strings
- ((and (string-match "\\([\"\']\\)[^\1]*$" pre)
+ ((and (string-match "\\([\"']\\)[^\1]*$" pre)
(string-match (concat "^[^" (match-string 1 pre) "]*"
(match-string 1 pre)) post))
(setq start (+ start (match-end 0))))
@@ -3217,7 +3212,7 @@ size(___,/DIMENSIONS)"
(defvar idlwave-shell-bp-alist nil
"Alist of breakpoints.
-A breakpoint is a cons cell \(\(file line\) . \(\(index module\) data\)\)
+A breakpoint is a cons cell \((file line) . \((index module) data))
The car is the `frame' for the breakpoint:
file - full path file name.
@@ -3914,7 +3909,7 @@ Elements of the alist have the form:
(defun idlwave-shell-module-source-query (module &optional type)
"Determine the source file for a given module.
-Query as a function if TYPE set to something beside 'pro."
+Query as a function if TYPE set to something beside `pro'."
(if module
(idlwave-shell-send-command
(format "print,(routine_info('%s',/SOURCE%s)).PATH" module
@@ -3926,7 +3921,7 @@ Query as a function if TYPE set to something beside 'pro."
"Get module source, and update `idlwave-shell-sources-alist'."
(let ((old (assoc (upcase module) idlwave-shell-sources-alist))
filename)
- (when (string-match "\.PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]"
+ (when (string-match ".PATH *[\n\r]\\([^%][^\r\n]+\\)[\n\r]"
idlwave-shell-command-output)
(setq filename (substring idlwave-shell-command-output
(match-beginning 1) (match-end 1)))
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 98f9ee3b530..89284cae3eb 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -1,6 +1,6 @@
;;; idlw-toolbar.el --- a debugging toolbar for IDLWAVE
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@astro.uva.nl>
;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu>
@@ -29,7 +29,7 @@
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;; Code:
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index ce60e05d669..ac2259df6a4 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -1,6 +1,6 @@
;; idlwave.el --- IDL editing mode for GNU Emacs
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Authors: J.D. Smith <jdsmith@as.arizona.edu>
;; Carsten Dominik <dominik@science.uva.nl>
@@ -44,7 +44,7 @@
;;
;; New versions of IDLWAVE, documentation, and more information
;; available from:
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;; INSTALLATION
;; ============
@@ -64,7 +64,7 @@
;; The newest version of this file is available from the maintainer's
;; Webpage:
;;
-;; http://idlwave.org
+;; http://github.com/jdtsmith/idlwave
;;
;; DOCUMENTATION
;; =============
@@ -179,7 +179,7 @@
"Major mode for editing IDL .pro files."
:tag "IDLWAVE"
:link '(url-link :tag "Home Page"
- "http://idlwave.org")
+ "http://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")
@@ -293,7 +293,7 @@ extends to the end of the match for the regular expression."
(defcustom idlwave-auto-fill-split-string t
"If non-nil then auto fill will split strings with the IDL `+' operator.
When the line end falls within a string, string concatenation with the
-'+' operator will be used to distribute a long string over lines.
+`+' operator will be used to distribute a long string over lines.
If nil and a string is split then a terminal beep and warning are issued.
This variable is ignored when `idlwave-fill-comment-line-only' is
@@ -376,12 +376,12 @@ The following values are allowed:
nil Don't scan any buffers.
t Scan all `idlwave-mode' buffers in the current editing session.
-current Scan only the current buffer, but no other buffers."
+`current' Scan only the current buffer, but no other buffers."
:group 'idlwave-routine-info
:type '(choice
(const :tag "No buffer" nil)
(const :tag "All buffers" t)
- (const :tag "Current buffer only" 'current)))
+ (const :tag "Current buffer only" current)))
(defcustom idlwave-query-shell-for-routine-info t
"Non-nil means query the shell for info about compiled routines.
@@ -449,6 +449,7 @@ value of `!DIR'. See also `idlwave-library-path'."
(defcustom idlwave-config-directory
(locate-user-emacs-file "idlwave" ".idlwave")
"Directory for configuration files and user-library catalog."
+ :version "24.4" ; added locate-user-emacs-file
:group 'idlwave-routine-info
:type 'file)
@@ -741,8 +742,8 @@ The actions that can be performed are listed in `idlwave-indent-action-table'."
(defcustom idlwave-abbrev-start-char "\\"
"A single character string used to start abbreviations in abbrev mode.
-Possible characters to chose from: ~`\%
-or even '?'. '.' is not a good choice because it can make structure
+Possible characters to choose from: ~\\=`%
+or even `?'. `.' is not a good choice because it can make structure
field names act like abbrevs in certain circumstances.
Changes to this in `idlwave-mode-hook' will have no effect. Instead a user
@@ -767,8 +768,8 @@ Also see help for `idlwave-surround'."
:type 'boolean)
(defcustom idlwave-pad-keyword t
- "Non-nil means pad '=' in keywords (routine calls or defs) like assignment.
-Whenever `idlwave-surround' is non-nil then this affects how '=' is
+ "Non-nil means pad `=' in keywords (routine calls or defs) like assignment.
+Whenever `idlwave-surround' is non-nil then this affects how `=' is
padded for keywords and for variables. If t, pad the same as for
assignments. If nil then spaces are removed. With any other value,
spaces are left unchanged."
@@ -776,7 +777,7 @@ spaces are left unchanged."
:type '(choice
(const :tag "Pad like assignments" t)
(const :tag "Remove space near `='" nil)
- (const :tag "Keep space near `='" 'keep)))
+ (other :tag "Keep space near `='" keep)))
(defcustom idlwave-show-block t
"Non-nil means point blinks to block beginning for `idlwave-show-begin'."
@@ -1558,7 +1559,7 @@ KEY in `idlwave-mode-map' by defining an anonymous function calling
`self-insert-command' followed by CMD. If KEY contains more than one
character a binding will only be set if SELECT is 'both.
-\(KEY . CMD\) is also placed in the `idlwave-indent-expand-table',
+\(KEY . CMD) is also placed in the `idlwave-indent-expand-table',
replacing any previous value for KEY. If a binding is not set then it
will instead be placed in `idlwave-indent-action-table'.
@@ -1570,11 +1571,11 @@ Otherwise, if SELECT is non-nil then only an action is created.
Some examples:
No spaces before and 1 after a comma
- (idlwave-action-and-binding \",\" '(idlwave-surround 0 1))
+ (idlwave-action-and-binding \",\" \\='(idlwave-surround 0 1))
A minimum of 1 space before and after `=' (see `idlwave-expand-equal').
- (idlwave-action-and-binding \"=\" '(idlwave-expand-equal -1 -1))
+ (idlwave-action-and-binding \"=\" \\='(idlwave-expand-equal -1 -1))
Capitalize system variables - action only
- (idlwave-action-and-binding idlwave-sysvar '(capitalize-word 1) t)"
+ (idlwave-action-and-binding idlwave-sysvar \\='(capitalize-word 1) t)"
(if (not (equal select 'noaction))
;; Add action
(let* ((table (if select 'idlwave-indent-action-table
@@ -1836,7 +1837,7 @@ The main features of this mode are
5. Code Templates and Abbreviations
--------------------------------
Many Abbreviations are predefined to expand to code fragments and templates.
- The abbreviations start generally with a `\\`. Some examples:
+ The abbreviations start generally with a `\\'. Some examples:
\\pr PROCEDURE template
\\fu FUNCTION template
@@ -1877,7 +1878,8 @@ The main features of this mode are
Info documentation for this package is available. Use
\\[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://idlwave.org'.
+ documentation, check IDLWAVE's homepage at URL
+ `http://github.com/jdtsmith/idlwave'.
IDLWAVE has customize support - see the group `idlwave'.
10.Keybindings
@@ -2045,7 +2047,7 @@ If optional argument RESERVED is non-nil then the expansion
consists of reserved words, which will be capitalized if
`idlwave-reserved-word-upcase' is non-nil.
Otherwise, the abbrev will be capitalized if `idlwave-abbrev-change-case'
-is non-nil, unless its value is \`down in which case the abbrev will be
+is non-nil, unless its value is `down' in which case the abbrev will be
made into all lowercase.
Returns non-nil if abbrev is left expanded."
(if (idlwave-quoted)
@@ -3711,7 +3713,7 @@ expression to enter.
The lines containing S1 and S2 are reindented using `indent-region'
unless the optional second argument NOINDENT is non-nil."
(if (derived-mode-p 'idlwave-shell-mode)
- ;; This is a gross hack to avoit template abbrev expansion
+ ;; This is a gross hack to avoid template abbrev expansion
;; in the shell. FIXME: This is a dirty hack.
(if (and (eq this-command 'self-insert-command)
(equal last-abbrev-location (point)))
@@ -4879,7 +4881,7 @@ Cache to disk for quick recovery."
props (car (cdr elem)))
(if (= (mod elem-cnt msg-cnt) 0)
(message "Converting XML routine info...%2d%%"
- (/ (* elem-cnt 100) nelem)))
+ (floor (* elem-cnt 100.0) nelem)))
(cond
((eq type 'ROUTINE)
(if (setq alias (assq 'alias_to props))
@@ -5831,15 +5833,15 @@ to override IDLWAVE's idea of what should be completed at point.
Possible values are:
0 <=> query for the completion type
-1 <=> 'procedure
-2 <=> 'procedure-keyword
-3 <=> 'function
-4 <=> 'function-keyword
-5 <=> 'procedure-method
-6 <=> 'procedure-method-keyword
-7 <=> 'function-method
-8 <=> 'function-method-keyword
-9 <=> 'class
+1 <=> `procedure'
+2 <=> `procedure-keyword'
+3 <=> `function'
+4 <=> `function-keyword'
+5 <=> `procedure-method'
+6 <=> `procedure-method-keyword'
+7 <=> `function-method'
+8 <=> `function-method-keyword'
+9 <=> `class'
As a special case, the universal argument C-u forces completion of
function names in places where the default would be a keyword.
@@ -7169,7 +7171,7 @@ If these don't exist, a letter in the string is automatically selected."
(defun idlwave-choose-completion (&rest args)
"Choose the completion that point is in or next to."
- (interactive)
+ (interactive (list last-nonmenu-event))
(apply 'idlwave-choose 'choose-completion args))
(defun idlwave-mouse-choose-completion (&rest args)
@@ -8160,7 +8162,7 @@ demand _EXTRA in the keyword list."
class
(idlwave-routines)) 'do-link))))))
- ;; If the class is `t', combine all keywords of all methods NAME
+ ;; If the class is t, combine all keywords of all methods NAME
(when (eq class t)
(mapc (lambda (entry)
(and
@@ -8692,7 +8694,7 @@ can be used to detect possible name clashes during this process."
(erase-buffer)
(while (setq routine (pop routines))
(if (= (mod (setq n (1+ n)) step) 0)
- (message "Compiling list...(%2d%%)" (/ (* n 100) nroutines)))
+ (message "Compiling list...(%2d%%)" (floor (* n 100.0) nroutines)))
;; Get a list of all twins
(setq twins (idlwave-routine-twins routine (or lroutines routines)))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index d73e9489d7c..290ebeea290 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -1,6 +1,6 @@
;;; inf-lisp.el --- an inferior-lisp mode
-;; Copyright (C) 1988, 1993-1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1993-1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
@@ -91,12 +91,29 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
(define-key map "\C-c\C-v" 'lisp-show-variable-documentation)
map))
+(easy-menu-define
+ inferior-lisp-menu
+ inferior-lisp-mode-map
+ "Inferior Lisp Menu"
+ '("Inf-Lisp"
+ ["Eval Last Sexp" lisp-eval-last-sexp t]
+ "--"
+ ["Load File..." lisp-load-file t]
+ ["Compile File..." lisp-compile-file t]
+ "--"
+ ["Show Arglist..." lisp-show-arglist t]
+ ["Describe Symbol..." lisp-describe-sym t]
+ ["Show Documentation for Function..." lisp-show-function-documentation t]
+ ["Show Documentation for Variable..." lisp-show-variable-documentation t]))
+
;;; These commands augment Lisp mode, so you can process Lisp code in
;;; the source files.
(define-key lisp-mode-map "\M-\C-x" 'lisp-eval-defun) ; Gnu convention
(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
+(define-key lisp-mode-map "\C-c\C-n" 'lisp-eval-form-and-next)
+(define-key lisp-mode-map "\C-c\C-p" 'lisp-eval-paragraph)
(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
@@ -109,7 +126,7 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword
;;; This function exists for backwards compatibility.
;;; Previous versions of this package bound commands to C-c <letter>
-;;; bindings, which is not allowed by the gnumacs standard.
+;;; bindings, which is not allowed by the Emacs standard.
;;; "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
@@ -296,6 +313,14 @@ of `inferior-lisp-program'). Runs the hooks from
;;;###autoload
(defalias 'run-lisp 'inferior-lisp)
+(defun lisp-eval-paragraph (&optional and-go)
+ "Send the current paragraph to the inferior Lisp process.
+Prefix argument means switch to the Lisp buffer afterwards."
+ (interactive "P")
+ (save-excursion
+ (mark-paragraph)
+ (lisp-eval-region (point) (mark) and-go)))
+
(defun lisp-eval-region (start end &optional and-go)
"Send the current region to the inferior Lisp process.
Prefix argument means switch to the Lisp buffer afterwards."
@@ -346,6 +371,14 @@ Prefix argument means switch to the Lisp buffer afterwards."
(interactive "P")
(lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
+(defun lisp-eval-form-and-next ()
+ "Send the previous sexp to the inferior Lisp process and move to the next one."
+ (interactive "")
+ (while (not (zerop (car (syntax-ppss))))
+ (up-list))
+ (lisp-eval-last-sexp)
+ (forward-sexp))
+
(defun lisp-compile-region (start end &optional and-go)
"Compile the current region in the inferior Lisp process.
Prefix argument means switch to the Lisp buffer afterwards."
@@ -477,7 +510,7 @@ Used by these commands to determine defaults."
(file-name-nondirectory file-name)))
(comint-send-string (inferior-lisp-proc) (concat "(compile-file \""
file-name
- "\"\)\n"))
+ "\")\n"))
(switch-to-lisp t))
@@ -629,7 +662,7 @@ See variable `lisp-describe-sym-command'."
;;; Changed all keybindings of the form C-c <letter>. These are
;;; supposed to be reserved for the user to bind. This affected
;;; mainly the compile/eval-defun/region[-and-go] commands.
-;;; This was painful, but necessary to adhere to the gnumacs standard.
+;;; This was painful, but necessary to adhere to the Emacs standard.
;;; For some backwards compatibility, see the
;;; cmulisp-install-letter-bindings
;;; function.
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 49a21933133..5a4f383337e 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1,6 +1,6 @@
;;; js.el --- Major mode for editing JavaScript -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Karl Landstrom <karl.landstrom@brgeight.se>
;; Daniel Colascione <dan.colascione@gmail.com>
@@ -126,7 +126,7 @@ An example of this is \"Class.prototype = { method1: ...}\".")
(defconst js--prototype-objextend-class-decl-re-2
(concat "^\\s-*\\(?:var\\s-+\\)?"
"\\(" js--dotted-name-re "\\)"
- "\\s-*=\\s-*Object\\.extend\\s-*\("))
+ "\\s-*=\\s-*Object\\.extend\\s-*("))
;; var NewClass = Class.create({
(defconst js--prototype-class-decl-re
@@ -248,7 +248,7 @@ name as matched contains
(defconst js--function-heading-1-re
(concat
- "^\\s-*function\\s-+\\(" js--name-re "\\)")
+ "^\\s-*function\\(?:\\s-\\|\\*\\)+\\(" js--name-re "\\)")
"Regexp matching the start of a JavaScript function header.
Match group 1 is the name of the function.")
@@ -459,12 +459,13 @@ The value must be no less than minus `js-indent-level'."
:group 'js
:version "24.1")
-(defcustom js-auto-indent-flag t
- "Whether to automatically indent when typing punctuation characters.
-If non-nil, the characters {}();,: also indent the current line
-in Javascript mode."
- :type 'boolean
- :group 'js)
+(defcustom js-switch-indent-offset 0
+ "Number of additional spaces for indenting the contents of a switch block.
+The value must not be negative."
+ :type 'integer
+ :safe 'integerp
+ :group 'js
+ :version "24.4")
(defcustom js-flat-functions nil
"Treat nested functions as top-level functions in `js-mode'.
@@ -508,6 +509,48 @@ getting timeout messages."
:type 'integer
:group 'js)
+(defcustom js-indent-first-init nil
+ "Non-nil means specially indent the first variable declaration's initializer.
+Normally, the first declaration's initializer is unindented, and
+subsequent declarations have their identifiers aligned with it:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;
+
+If this option has the value t, indent the first declaration's
+initializer by an additional level:
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;
+
+If this option has the value `dynamic', if there is only one declaration,
+don't indent the first one's initializer; otherwise, indent it.
+
+ var o = {
+ foo: 3
+ };
+
+ var o = {
+ foo: 3
+ },
+ bar = 2;"
+ :version "25.1"
+ :type '(choice (const nil) (const t) (const dynamic))
+ :safe 'symbolp
+ :group 'js)
+
;;; KeyMap
(defvar js-mode-map
@@ -533,6 +576,7 @@ getting timeout messages."
(let ((table (make-syntax-table)))
(c-populate-syntax-table table)
(modify-syntax-entry ?$ "_" table)
+ (modify-syntax-entry ?` "\"" table)
table)
"Syntax table for `js-mode'.")
@@ -595,7 +639,7 @@ enabled frameworks."
(js--maybe-join
"\\(?:var[ \t]+\\)?[a-zA-Z_$0-9.]+[ \t]*=[ \t]*\\(?:"
"\\|"
- "\\)[ \t]*\("
+ "\\)[ \t]*("
(when (memq 'prototype js-enabled-frameworks)
"Class\\.create")
@@ -607,10 +651,10 @@ enabled frameworks."
"[a-zA-Z_$0-9]+\\.extend\\(?:Final\\)?"))
(when (memq 'dojo js-enabled-frameworks)
- "dojo\\.declare[ \t]*\(")
+ "dojo\\.declare[ \t]*(")
(when (memq 'mochikit js-enabled-frameworks)
- "MochiKit\\.Base\\.update[ \t]*\(")
+ "MochiKit\\.Base\\.update[ \t]*(")
;; mumble.prototypeTHING
(js--maybe-join
@@ -618,7 +662,7 @@ enabled frameworks."
(when (memq 'javascript js-enabled-frameworks)
'( ;; foo.prototype.bar = function(
- "\\.[a-zA-Z_$0-9]+[ \t]*=[ \t]*function[ \t]*\("
+ "\\.[a-zA-Z_$0-9]+[ \t]*=[ \t]*function[ \t]*("
;; mumble.prototype = {
"[ \t]*=[ \t]*{")))))
@@ -795,6 +839,9 @@ determined. Otherwise, return nil."
(let ((name t))
(forward-word)
(forward-comment most-positive-fixnum)
+ (when (eq (char-after) ?*)
+ (forward-char)
+ (forward-comment most-positive-fixnum))
(when (looking-at js--name-re)
(setq name (match-string-no-properties 0))
(goto-char (match-end 0)))
@@ -1301,7 +1348,7 @@ LIMIT defaults to point."
(up-list -1)))
(defun js--inside-param-list-p ()
- "Return non-nil iff point is in a function parameter list."
+ "Return non-nil if point is in a function parameter list."
(ignore-errors
(save-excursion
(js--up-nearby-list)
@@ -1312,7 +1359,7 @@ LIMIT defaults to point."
(looking-at "function"))))))))
(defun js--inside-dojo-class-list-p ()
- "Return non-nil iff point is in a Dojo multiple-inheritance class block."
+ "Return non-nil if point is in a Dojo multiple-inheritance class block."
(ignore-errors
(save-excursion
(js--up-nearby-list)
@@ -1323,17 +1370,6 @@ LIMIT defaults to point."
(looking-at "\"\\s-*,\\s-*\\[")
(eq (match-end 0) (1+ list-begin)))))))
-(defun js--syntax-begin-function ()
- (when (< js--cache-end (point))
- (goto-char (max (point-min) js--cache-end)))
-
- (let ((pitem))
- (while (and (setq pitem (car (js--backward-pstate)))
- (not (eq 0 (js--pitem-paren-depth pitem)))))
-
- (when pitem
- (goto-char (js--pitem-h-begin pitem )))))
-
;;; Font Lock
(defun js--make-framework-matcher (framework &rest regexps)
"Helper function for building `js--font-lock-keywords'.
@@ -1351,7 +1387,7 @@ REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'."
(defun js--forward-destructuring-spec (&optional func)
"Move forward over a JavaScript destructuring spec.
If FUNC is supplied, call it with no arguments before every
-variable name in the spec. Return true iff this was actually a
+variable name in the spec. Return true if this was actually a
spec. FUNC must preserve the match data."
(pcase (char-after)
(?\[
@@ -1636,12 +1672,29 @@ This performs fontification according to `js--class-styles'."
js--font-lock-keywords-3)
"Font lock keywords for `js-mode'. See `font-lock-keywords'.")
+(defconst js--syntax-propertize-regexp-syntax-table
+ (let ((st (make-char-table 'syntax-table (string-to-syntax "."))))
+ (modify-syntax-entry ?\[ "(]" st)
+ (modify-syntax-entry ?\] ")[" st)
+ (modify-syntax-entry ?\\ "\\" st)
+ st))
+
(defun js-syntax-propertize-regexp (end)
- (when (eq (nth 3 (syntax-ppss)) ?/)
- ;; A /.../ regexp.
- (when (re-search-forward "\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*/" end 'move)
- (put-text-property (1- (point)) (point)
- 'syntax-table (string-to-syntax "\"/")))))
+ (let ((ppss (syntax-ppss)))
+ (when (eq (nth 3 ppss) ?/)
+ ;; A /.../ regexp.
+ (while
+ (when (re-search-forward "\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*/"
+ end 'move)
+ (if (nth 1 (with-syntax-table
+ js--syntax-propertize-regexp-syntax-table
+ (let ((parse-sexp-lookup-properties nil))
+ (parse-partial-sexp (nth 8 ppss) (point)))))
+ ;; A / within a character class is not the end of a regexp.
+ t
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "\"/"))
+ nil))))))
(defun js-syntax-propertize (start end)
;; Javascript allows immediate regular expression objects, written /.../.
@@ -1655,7 +1708,7 @@ This performs fontification according to `js--class-styles'."
;; We can probably just add +, -, !, <, >, %, ^, ~, |, &, ?, : at which
;; point I think only * and / would be missing which could also be added,
;; but need care to avoid affecting the // and */ comment markers.
- ("\\(?:^\\|[=([{,:;]\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
+ ("\\(?:^\\|[=([{,:;]\\|\\_<return\\_>\\)\\(?:[ \t]\\)*\\(/\\)[^/*]"
(1 (ignore
(forward-char -1)
(when (or (not (memq (char-after (match-beginning 0)) '(?\s ?\t)))
@@ -1671,6 +1724,12 @@ This performs fontification according to `js--class-styles'."
(js-syntax-propertize-regexp end))))))
(point) end))
+(defconst js--prettify-symbols-alist
+ '(("=>" . ?⇒)
+ (">=" . ?≥)
+ ("<=" . ?≤))
+ "Alist of symbol prettifications for JavaScript.")
+
;;; Indentation
(defconst js--possibly-braceless-keyword-re
@@ -1684,7 +1743,7 @@ This performs fontification according to `js--class-styles'."
"Regular expression matching variable declaration keywords.")
(defconst js--indent-operator-re
- (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|"
+ (concat "[-+*/%<>&^|?:.]\\([^-+*/]\\|$\\)\\|!?=\\|"
(js--regexp-opt-symbol '("in" "instanceof")))
"Regexp matching operators that affect indentation of continued expressions.")
@@ -1692,11 +1751,18 @@ This performs fontification according to `js--class-styles'."
"Return non-nil if point is on a JavaScript operator, other than a comma."
(save-match-data
(and (looking-at js--indent-operator-re)
- (or (not (looking-at ":"))
+ (or (not (eq (char-after) ?:))
(save-excursion
(and (js--re-search-backward "[?:{]\\|\\_<case\\_>" nil t)
- (looking-at "?")))))))
-
+ (eq (char-after) ??))))
+ (not (and
+ (eq (char-after) ?*)
+ (looking-at (concat "\\* *" js--name-re " *("))
+ (save-excursion
+ (goto-char (1- (match-end 0)))
+ (let (forward-sexp-function) (forward-sexp))
+ (js--forward-syntactic-ws)
+ (eq (char-after) ?{)))))))
(defun js--continued-expression-p ()
"Return non-nil if the current line continues an expression."
@@ -1711,7 +1777,7 @@ This performs fontification according to `js--class-styles'."
(save-excursion (backward-char) (not (looking-at "[/*]/")))
(js--looking-at-operator-p)
(and (progn (backward-char)
- (not (looking-at "++\\|--\\|/[/*]"))))))))))
+ (not (looking-at "+\\+\\|--\\|/[/*]"))))))))))
(defun js--end-of-do-while-loop-p ()
@@ -1749,8 +1815,8 @@ nil."
(when (save-excursion
(and (not (eq (point-at-bol) (point-min)))
(not (looking-at "[{]"))
+ (js--re-search-backward "[[:graph:]]" nil t)
(progn
- (js--re-search-backward "[[:graph:]]" nil t)
(or (eobp) (forward-char))
(when (= (char-before) ?\)) (backward-list))
(skip-syntax-backward " ")
@@ -1766,6 +1832,10 @@ nil."
(list (cons 'c js-comment-lineup-func))))
(c-get-syntactic-indentation (list (cons symbol anchor)))))
+(defun js--same-line (pos)
+ (and (>= pos (point-at-bol))
+ (<= pos (point-at-eol))))
+
(defun js--multi-line-declaration-indentation ()
"Helper function for `js--proper-indentation'.
Return the proper indentation of the current line if it belongs to a declaration
@@ -1788,8 +1858,7 @@ statement spanning multiple lines; otherwise, return nil."
(looking-at js--indent-operator-re)
(js--backward-syntactic-ws))
(not (eq (char-before) ?\;)))
- (and (>= pos (point-at-bol))
- (<= pos (point-at-eol)))))))
+ (js--same-line pos)))))
(condition-case nil
(backward-sexp)
(scan-error (setq at-opening-bracket t))))
@@ -1797,23 +1866,98 @@ statement spanning multiple lines; otherwise, return nil."
(goto-char (match-end 0))
(1+ (current-column)))))))
+(defun js--indent-in-array-comp (bracket)
+ "Return non-nil if we think we're in an array comprehension.
+In particular, return the buffer position of the first `for' kwd."
+ (let ((end (point)))
+ (save-excursion
+ (goto-char bracket)
+ (when (looking-at "\\[")
+ (forward-char 1)
+ (js--forward-syntactic-ws)
+ (if (looking-at "[[{]")
+ (let (forward-sexp-function) ; Use Lisp version.
+ (forward-sexp) ; Skip destructuring form.
+ (js--forward-syntactic-ws)
+ (if (and (/= (char-after) ?,) ; Regular array.
+ (looking-at "for"))
+ (match-beginning 0)))
+ ;; To skip arbitrary expressions we need the parser,
+ ;; so we'll just guess at it.
+ (if (and (> end (point)) ; Not empty literal.
+ (re-search-forward "[^,]]* \\(for\\) " end t)
+ ;; Not inside comment or string literal.
+ (not (nth 8 (parse-partial-sexp bracket (point)))))
+ (match-beginning 1)))))))
+
+(defun js--array-comp-indentation (bracket for-kwd)
+ (if (js--same-line for-kwd)
+ ;; First continuation line.
+ (save-excursion
+ (goto-char bracket)
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (current-column))
+ (save-excursion
+ (goto-char for-kwd)
+ (current-column))))
+
+(defun js--maybe-goto-declaration-keyword-end (parse-status)
+ "Helper function for `js--proper-indentation'.
+Depending on the value of `js-indent-first-init', move
+point to the end of a variable declaration keyword so that
+indentation is aligned to that column."
+ (cond
+ ((eq js-indent-first-init t)
+ (when (looking-at js--declaration-keyword-re)
+ (goto-char (1+ (match-end 0)))))
+ ((eq js-indent-first-init 'dynamic)
+ (let ((bracket (nth 1 parse-status))
+ declaration-keyword-end
+ at-closing-bracket-p
+ comma-p)
+ (when (looking-at js--declaration-keyword-re)
+ (setq declaration-keyword-end (match-end 0))
+ (save-excursion
+ (goto-char bracket)
+ (setq at-closing-bracket-p
+ (condition-case nil
+ (progn
+ (forward-sexp)
+ t)
+ (error nil)))
+ (when at-closing-bracket-p
+ (while (forward-comment 1))
+ (setq comma-p (looking-at-p ","))))
+ (when comma-p
+ (goto-char (1+ declaration-keyword-end))))))))
+
(defun js--proper-indentation (parse-status)
"Return the proper indentation for the current line."
(save-excursion
(back-to-indentation)
- (cond ((nth 4 parse-status)
+ (cond ((nth 4 parse-status) ; inside comment
(js--get-c-offset 'c (nth 8 parse-status)))
- ((nth 8 parse-status) 0) ; inside string
- ((js--ctrl-statement-indentation))
- ((js--multi-line-declaration-indentation))
+ ((nth 3 parse-status) 0) ; inside string
((eq (char-after) ?#) 0)
((save-excursion (js--beginning-of-macro)) 4)
+ ;; Indent array comprehension continuation lines specially.
+ ((let ((bracket (nth 1 parse-status))
+ beg)
+ (and bracket
+ (not (js--same-line bracket))
+ (setq beg (js--indent-in-array-comp bracket))
+ ;; At or after the first loop?
+ (>= (point) beg)
+ (js--array-comp-indentation bracket beg))))
+ ((js--ctrl-statement-indentation))
+ ((js--multi-line-declaration-indentation))
((nth 1 parse-status)
;; A single closing paren/bracket should be indented at the
;; same level as the opening statement. Same goes for
;; "case" and "default".
- (let ((same-indent-p (looking-at
- "[]})]\\|\\_<case\\_>\\|\\_<default\\_>"))
+ (let ((same-indent-p (looking-at "[]})]"))
+ (switch-keyword-p (looking-at "default\\_>\\|case\\_>[^:]"))
(continued-expr-p (js--continued-expression-p)))
(goto-char (nth 1 parse-status)) ; go to the opening char
(if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")
@@ -1821,17 +1965,27 @@ statement spanning multiple lines; otherwise, return nil."
(skip-syntax-backward " ")
(when (eq (char-before) ?\)) (backward-list))
(back-to-indentation)
- (cond (same-indent-p
- (current-column))
- (continued-expr-p
- (+ (current-column) (* 2 js-indent-level)
- js-expr-indent-offset))
- (t
- (+ (current-column) js-indent-level
- (pcase (char-after (nth 1 parse-status))
- (?\( js-paren-indent-offset)
- (?\[ js-square-indent-offset)
- (?\{ js-curly-indent-offset))))))
+ (js--maybe-goto-declaration-keyword-end parse-status)
+ (let* ((in-switch-p (unless same-indent-p
+ (looking-at "\\_<switch\\_>")))
+ (same-indent-p (or same-indent-p
+ (and switch-keyword-p
+ in-switch-p)))
+ (indent
+ (cond (same-indent-p
+ (current-column))
+ (continued-expr-p
+ (+ (current-column) (* 2 js-indent-level)
+ js-expr-indent-offset))
+ (t
+ (+ (current-column) js-indent-level
+ (pcase (char-after (nth 1 parse-status))
+ (?\( js-paren-indent-offset)
+ (?\[ js-square-indent-offset)
+ (?\{ js-curly-indent-offset)))))))
+ (if in-switch-p
+ (+ indent js-switch-indent-offset)
+ indent)))
;; If there is something following the opening
;; paren/bracket, everything else should be indented at
;; the same level.
@@ -1847,11 +2001,10 @@ statement spanning multiple lines; otherwise, return nil."
(defun js-indent-line ()
"Indent the current line as JavaScript."
(interactive)
- (save-restriction
- (widen)
- (let* ((parse-status
- (save-excursion (syntax-ppss (point-at-bol))))
- (offset (- (current-column) (current-indentation))))
+ (let* ((parse-status
+ (save-excursion (syntax-ppss (point-at-bol))))
+ (offset (- (point) (save-excursion (back-to-indentation) (point)))))
+ (unless (nth 3 parse-status)
(indent-line-to (js--proper-indentation parse-status))
(when (> offset 0) (forward-char offset)))))
@@ -2701,10 +2854,6 @@ with `js--js-encode-value'."
(defsubst js--js-true (value)
(not (js--js-not value)))
-;; The somewhat complex code layout confuses the byte-compiler into
-;; thinking this function "might not be defined at runtime".
-(declare-function js--optimize-arglist "js" (arglist))
-
(eval-and-compile
(defun js--optimize-arglist (arglist)
"Convert immediate js< and js! references to deferred ones."
@@ -3350,7 +3499,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
;;; Main Function
;;;###autoload
-(define-derived-mode js-mode prog-mode "Javascript"
+(define-derived-mode js-mode prog-mode "JavaScript"
"Major mode for editing JavaScript."
:group 'js
(setq-local indent-line-function 'js-indent-line)
@@ -3359,6 +3508,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(setq-local open-paren-in-column-0-is-defun-start nil)
(setq-local font-lock-defaults (list js--font-lock-keywords))
(setq-local syntax-propertize-function #'js-syntax-propertize)
+ (setq-local prettify-symbols-alist js--prettify-symbols-alist)
(setq-local parse-sexp-ignore-comments t)
(setq-local parse-sexp-lookup-properties t)
@@ -3381,7 +3531,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
;; for filling, pretend we're cc-mode
(setq c-comment-prefix-regexp "//+\\|\\**"
- c-paragraph-start "$"
+ c-paragraph-start "\\(@[[:alpha:]]+\\>\\|$\\)"
c-paragraph-separate "$"
c-block-comment-prefix "* "
c-line-comment-starter "//"
@@ -3403,8 +3553,6 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(make-local-variable 'adaptive-fill-regexp)
(c-setup-paragraph-variables))
- (setq-local syntax-begin-function #'js--syntax-begin-function)
-
;; Important to fontify the whole buffer syntactically! If we don't,
;; then we might have regular expression literals that aren't marked
;; as strings, which will screw up parse-partial-sexp, scan-lists,
@@ -3413,9 +3561,10 @@ If one hasn't been set, or if it's stale, prompt for a new one."
;; the buffer containing the problem, JIT-lock will apply the
;; correct syntax to the regular expression literal and the problem
;; will mysteriously disappear.
- ;; FIXME: We should actually do this fontification lazily by adding
+ ;; FIXME: We should instead do this fontification lazily by adding
;; calls to syntax-propertize wherever it's really needed.
- (syntax-propertize (point-max)))
+ ;;(syntax-propertize (point-max))
+ )
;;;###autoload (defalias 'javascript-mode 'js-mode)
@@ -3423,6 +3572,10 @@ If one hasn't been set, or if it's stale, prompt for a new one."
'(when (fboundp 'folding-add-to-marks-list)
(folding-add-to-marks-list 'js-mode "// {{{" "// }}}" )))
+;;;###autoload
+(dolist (name (list "node" "nodejs" "gjs" "rhino"))
+ (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode)))
+
(provide 'js)
;; js.el ends here
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index ffb425ee1e9..0c180dfc147 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,6 +1,6 @@
;;; ld-script.el --- GNU linker script editing mode for Emacs
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: Masatake YAMATO<jet@gyve.org>
;; Keywords: languages, faces
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index 4ba2ae1ded9..80a93a477b4 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -1,9 +1,8 @@
;;; m4-mode.el --- m4 code editing commands for Emacs
-;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc.
-;; Author: Andrew Csillag <drew_csillag@geocities.com>
-;; Maintainer: Andrew Csillag <drew_csillag@geocities.com>
+;; Author: Andrew Csillag <drew@thecsillags.com>
;; Keywords: languages, faces
;; This file is part of GNU Emacs.
@@ -65,14 +64,12 @@ If m4 is not in your PATH, set this to an absolute file name."
(defvar m4-font-lock-keywords
`(
- ("\\(\\b\\(m4_\\)?dnl\\b\\|^\\#\\).*$" . font-lock-comment-face)
-; ("\\(\\bdnl\\b\\|\\bm4_dnl\\b\\|^\\#\\).*$" . font-lock-comment-face)
+ ("\\(\\_<\\(m4_\\)?dnl\\_>\\).*$" . font-lock-comment-face)
("\\$[*#@0-9]" . font-lock-variable-name-face)
- ("\\\$\\\@" . font-lock-variable-name-face)
- ("\\\$\\\*" . font-lock-variable-name-face)
- ("\\b\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\b" . font-lock-keyword-face)
- ("\\b\\(m4_\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(_undefine\\|exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|undivert\\)\\)\\b" . font-lock-keyword-face))
- "Default font-lock-keywords for `m4 mode'.")
+ ("\\$\\@" . font-lock-variable-name-face)
+ ("\\$\\*" . font-lock-variable-name-face)
+ ("\\_<\\(m4_\\)?\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\_>" . font-lock-keyword-face))
+ "Default `font-lock-keywords' for M4 mode.")
(defcustom m4-mode-hook nil
"Hook called by `m4-mode'."
@@ -86,19 +83,26 @@ If m4 is not in your PATH, set this to an absolute file name."
(modify-syntax-entry ?' ")`" table)
(modify-syntax-entry ?# "<\n" table)
(modify-syntax-entry ?\n ">#" table)
- (modify-syntax-entry ?{ "_" table)
- (modify-syntax-entry ?} "_" table)
- ;; FIXME: This symbol syntax for underscore looks OK on its own, but it's
- ;; odd that it should have the same syntax as { and } are these really
- ;; valid in m4 symbols?
+ (modify-syntax-entry ?{ "." table)
+ (modify-syntax-entry ?} "." table)
(modify-syntax-entry ?_ "_" table)
- ;; FIXME: These three chars with word syntax look wrong.
- (modify-syntax-entry ?* "w" table)
- (modify-syntax-entry ?\" "w" table)
- (modify-syntax-entry ?\" "w" table)
+ (modify-syntax-entry ?* "." table)
+ (modify-syntax-entry ?\" "." table)
table)
"Syntax table used while in `m4-mode'.")
+(defun m4--quoted-p (pos)
+ "Return non-nil if POS is inside a quoted string."
+ (let ((quoted nil))
+ (dolist (o (nth 9 (save-excursion (syntax-ppss pos))))
+ (if (eq (char-after o) ?\`) (setq quoted t)))
+ quoted))
+
+(defconst m4-syntax-propertize
+ (syntax-propertize-rules
+ ("#" (0 (when (m4--quoted-p (match-beginning 0))
+ (string-to-syntax "."))))))
+
(defvar m4-mode-map
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap)))
@@ -148,7 +152,8 @@ If m4 is not in your PATH, set this to an absolute file name."
(setq-local comment-start "#")
(setq-local parse-sexp-ignore-comments t)
(setq-local add-log-current-defun-function #'m4-current-defun-name)
- (setq font-lock-defaults '(m4-font-lock-keywords nil)))
+ (setq-local syntax-propertize-function m4-syntax-propertize)
+ (setq-local font-lock-defaults '(m4-font-lock-keywords nil)))
(provide 'm4-mode)
;;stuff to play with for debugging
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 3c0871e57b6..9736f0f207c 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,10 +1,10 @@
;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1994, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1999-2015 Free Software Foundation, Inc.
;; Author: Thomas Neumann <tom@smart.bo.open.de>
;; Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR
;; Keywords: unix, tools
@@ -1300,7 +1300,8 @@ Fill comments, backslashed lines, and variable definitions specially."
(point))))
(end
(save-excursion
- (while (= (preceding-char) ?\\)
+ (while (and (= (preceding-char) ?\\)
+ (not (eobp)))
(end-of-line 2))
(point))))
(save-restriction
@@ -1454,7 +1455,7 @@ Fill comments, backslashed lines, and variable definitions specially."
(defun makefile-browser-insert-continuation ()
"Insert a makefile continuation.
-In the makefile buffer, go to (end-of-line), insert a \'\\\'
+In the makefile buffer, go to (end-of-line), insert a `\\'
character, insert a new blank line, go to that line and indent by one TAB.
This is most useful in the process of creating continued lines when copying
large dependencies from the browser to the client buffer.
@@ -1501,7 +1502,7 @@ Insertion takes place at point."
(if (zerop (+ (length targets) (length macros)))
(progn
(beep)
- (message "No macros or targets to browse! Consider running 'makefile-pickup-everything\'"))
+ (message "No macros or targets to browse! Consider running `makefile-pickup-everything'"))
(let ((browser-buffer (get-buffer-create makefile-browser-buffer-name)))
(pop-to-buffer browser-buffer)
(makefile-browser-fill targets macros)
diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el
index e472b0cc530..a0f50fc0f19 100644
--- a/lisp/progmodes/mantemp.el
+++ b/lisp/progmodes/mantemp.el
@@ -1,6 +1,6 @@
;;; mantemp.el --- create manual template instantiations from g++ 2.7.2 output
-;; Copyright (C) 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Tom Houlder <thoulder@icor.fr>
;; Created: 10 Dec 1996
@@ -89,7 +89,7 @@
(save-excursion
(goto-char (point-min))
(message "Removing comments")
- (while (re-search-forward "^[A-z\.()+0-9: ]*`\\|'.*$" nil t)
+ (while (re-search-forward "^[A-z.()+0-9: ]*`\\|'.*$" nil t)
(replace-match ""))))
(defun mantemp-remove-memfuncs ()
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 6a150667f19..62ff2fac2ac 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -1,6 +1,6 @@
;;; meta-mode.el --- major mode for editing Metafont or MetaPost sources -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Ulrik Vieth <vieth@thphy.uni-duesseldorf.de>
;; Version: 1.0
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index a14654cdd7c..c95315700b3 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -1,6 +1,6 @@
;;; mixal-mode.el --- Major mode for the mix asm language.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: Pieter E.J. Pareit <pieter.pareit@gmail.com>
;; Maintainer: Pieter E.J. Pareit <pieter.pareit@gmail.com>
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index d634efebe5b..582e495a2bf 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -2,7 +2,7 @@
;; Author: Michael Schmidt <michael@pbinfo.UUCP>
;; Tom Perrine <Perrin@LOGICON.ARPA>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages
;; This file is part of GNU Emacs.
@@ -104,7 +104,7 @@
"Keymap used in Modula-2 mode.")
(defcustom m2-indent 5
- "This variable gives the indentation in Modula-2-Mode."
+ "This variable gives the indentation in Modula-2 mode."
:type 'integer
:group 'modula2)
(put 'm2-indent 'safe-local-variable
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index de1c26a7fa7..b54b88dccb5 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1,10 +1,10 @@
-;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*-
+;;; octave.el --- editing octave source files under emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
;; John Eaton <jwe@octave.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages
;; This file is part of GNU Emacs.
@@ -24,7 +24,7 @@
;;; Commentary:
-;; This package provides emacs support for Octave. It defines a major
+;; This package provides Emacs support for Octave. It defines a major
;; mode for editing Octave code and contains code for interacting with
;; an inferior Octave process using comint.
@@ -40,7 +40,19 @@
(unless (fboundp 'user-error)
(defalias 'user-error 'error))
(unless (fboundp 'delete-consecutive-dups)
- (defalias 'delete-consecutive-dups 'delete-dups)))
+ (defalias 'delete-consecutive-dups 'delete-dups))
+ (unless (fboundp 'completion-table-with-cache)
+ (defun completion-table-with-cache (fun &optional ignore-case)
+ ;; See eg bug#11906.
+ (let* (last-arg last-result
+ (new-fun
+ (lambda (arg)
+ (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+ last-result
+ (prog1
+ (setq last-result (funcall fun arg))
+ (setq last-arg arg))))))
+ (completion-table-dynamic new-fun)))))
(eval-when-compile
(unless (fboundp 'setq-local)
(defmacro setq-local (var val)
@@ -49,6 +61,8 @@
(defgroup octave nil
"Editing Octave code."
+ :link '(custom-manual "(octave-mode)Top")
+ :link '(url-link "http://www.gnu.org/s/octave")
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'languages)
@@ -68,25 +82,6 @@ Used in `octave-mode' and `inferior-octave-mode' buffers.")
(defvar octave-comment-start-skip "\\(^\\|\\S<\\)\\(?:%!\\|\\s<+\\)\\s-*"
"Octave-specific `comment-start-skip' (which see).")
-(defvar octave-begin-keywords
- '("classdef" "do" "enumeration" "events" "for" "function" "if" "methods"
- "parfor" "properties" "switch" "try" "unwind_protect" "while"))
-
-(defvar octave-else-keywords
- '("case" "catch" "else" "elseif" "otherwise" "unwind_protect_cleanup"))
-
-(defvar octave-end-keywords
- '("endclassdef" "endenumeration" "endevents" "endfor" "endfunction" "endif"
- "endmethods" "endparfor" "endproperties" "endswitch" "end_try_catch"
- "end_unwind_protect" "endwhile" "until" "end"))
-
-(defvar octave-reserved-words
- (append octave-begin-keywords
- octave-else-keywords
- octave-end-keywords
- '("break" "continue" "global" "persistent" "return"))
- "Reserved words in Octave.")
-
(defvar octave-function-header-regexp
(concat "^\\s-*\\_<\\(function\\)\\_>"
"\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
@@ -109,11 +104,14 @@ parenthetical grouping.")
(define-key map "\C-c/" 'smie-close-block)
(define-key map "\C-c;" 'octave-update-function-file-comment)
(define-key map "\C-hd" 'octave-help)
+ (define-key map "\C-ha" 'octave-lookfor)
+ (define-key map "\C-c\C-l" 'octave-source-file)
(define-key map "\C-c\C-f" 'octave-insert-defun)
(define-key map "\C-c\C-il" 'octave-send-line)
(define-key map "\C-c\C-ib" 'octave-send-block)
(define-key map "\C-c\C-if" 'octave-send-defun)
(define-key map "\C-c\C-ir" 'octave-send-region)
+ (define-key map "\C-c\C-ia" 'octave-send-buffer)
(define-key map "\C-c\C-is" 'octave-show-process-buffer)
(define-key map "\C-c\C-iq" 'octave-hide-process-buffer)
(define-key map "\C-c\C-ik" 'octave-kill-process)
@@ -121,6 +119,7 @@ parenthetical grouping.")
(define-key map "\C-c\C-i\C-b" 'octave-send-block)
(define-key map "\C-c\C-i\C-f" 'octave-send-defun)
(define-key map "\C-c\C-i\C-r" 'octave-send-region)
+ (define-key map "\C-c\C-i\C-a" 'octave-send-buffer)
(define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer)
(define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer)
(define-key map "\C-c\C-i\C-k" 'octave-kill-process)
@@ -143,15 +142,13 @@ parenthetical grouping.")
["Start Octave Process" run-octave t]
["Documentation Lookup" info-lookup-symbol t]
["Help on Function" octave-help t]
+ ["Search help" octave-lookfor t]
["Find Function Definition" octave-find-definition t]
["Insert Function" octave-insert-defun t]
["Update Function File Comment" octave-update-function-file-comment t]
"---"
- ["Function Syntax Hints" (call-interactively
- (if (fboundp 'eldoc-post-insert-mode)
- 'eldoc-post-insert-mode
- 'eldoc-mode))
- :style toggle :selected (or eldoc-post-insert-mode eldoc-mode)
+ ["Function Syntax Hints" (eldoc-mode 'toggle)
+ :style toggle :selected (bound-and-true-p eldoc-mode)
:help "Display function signatures after typing `SPC' or `('"]
["Delimiter Matching" show-paren-mode
:style toggle :selected show-paren-mode
@@ -169,10 +166,13 @@ parenthetical grouping.")
["Send Current Block" octave-send-block t]
["Send Current Function" octave-send-defun t]
["Send Region" octave-send-region t]
+ ["Send Buffer" octave-send-buffer t]
+ ["Source Current File" octave-source-file t]
["Show Process Buffer" octave-show-process-buffer t]
["Hide Process Buffer" octave-hide-process-buffer t]
["Kill Process" octave-kill-process t])
"---"
+ ["Octave Mode Manual" (info "(octave-mode)Top") t]
["Customize Octave" (customize-group 'octave) t]
["Submit Bug Report" report-emacs-bug t]))
@@ -212,20 +212,17 @@ parenthetical grouping.")
(defcustom octave-font-lock-texinfo-comment t
"Control whether to highlight the texinfo comment block."
:type 'boolean
- :group 'octave
:version "24.4")
(defcustom octave-blink-matching-block t
"Control the blinking of matching Octave block keywords.
Non-nil means show matching begin of block when inserting a space,
newline or semicolon after an else or end keyword."
- :type 'boolean
- :group 'octave)
+ :type 'boolean)
(defcustom octave-block-offset 2
"Extra indentation applied to statements in Octave block structures."
- :type 'integer
- :group 'octave)
+ :type 'integer)
(defvar octave-block-comment-start
(concat (make-string 2 octave-comment-char) " ")
@@ -233,8 +230,7 @@ newline or semicolon after an else or end keyword."
(defcustom octave-continuation-offset 4
"Extra indentation applied to Octave continuation lines."
- :type 'integer
- :group 'octave)
+ :type 'integer)
(eval-and-compile
(defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\."))
@@ -255,108 +251,135 @@ newline or semicolon after an else or end keyword."
(defcustom octave-mode-hook nil
"Hook to be run when Octave mode is started."
- :type 'hook
- :group 'octave)
+ :type 'hook)
(defcustom octave-send-show-buffer t
"Non-nil means display `inferior-octave-buffer' after sending to it."
- :type 'boolean
- :group 'octave)
+ :type 'boolean)
(defcustom octave-send-line-auto-forward t
"Control auto-forward after sending to the inferior Octave process.
Non-nil means always go to the next Octave code line after sending."
- :type 'boolean
- :group 'octave)
+ :type 'boolean)
(defcustom octave-send-echo-input t
"Non-nil means echo input sent to the inferior Octave process."
- :type 'boolean
- :group 'octave)
+ :type 'boolean)
;;; SMIE indentation
(require 'smie)
-;; Use '__operators__' in Octave REPL to get a full list.
-(defconst octave-operator-table
- '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!?
- (right "=" "+=" "-=" "*=" "/=")
- (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!?
- (assoc "&") (assoc "|") ; The doc claims they have equal precedence!?
- (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=")
- (nonassoc ":") ;No idea what this is.
- (assoc "+" "-")
- (assoc "*" "/" "\\" ".\\" ".*" "./")
- (nonassoc "'" ".'")
- (nonassoc "++" "--" "!" "~") ;And unary "+" and "-".
- (right "^" "**" ".^" ".**")
- ;; It's not really an operator, but for indentation purposes it
- ;; could be convenient to treat it as one.
- (assoc "...")))
-
-(defconst octave-smie-bnf-table
- '((atom)
- ;; We can't distinguish the first element in a sequence with
- ;; precedence grammars, so we can't distinguish the condition
- ;; if the `if' from the subsequent body, for example.
- ;; This has to be done later in the indentation rules.
- (exp (exp "\n" exp)
- ;; We need to mention at least one of the operators in this part
- ;; of the grammar: if the BNF and the operator table have
- ;; no overlap, SMIE can't know how they relate.
- (exp ";" exp)
- ("try" exp "catch" exp "end_try_catch")
- ("try" exp "catch" exp "end")
- ("unwind_protect" exp
- "unwind_protect_cleanup" exp "end_unwind_protect")
- ("unwind_protect" exp "unwind_protect_cleanup" exp "end")
- ("for" exp "endfor")
- ("for" exp "end")
- ("parfor" exp "endparfor")
- ("parfor" exp "end")
- ("do" exp "until" atom)
- ("while" exp "endwhile")
- ("while" exp "end")
- ("if" exp "endif")
- ("if" exp "else" exp "endif")
- ("if" exp "elseif" exp "else" exp "endif")
- ("if" exp "elseif" exp "elseif" exp "else" exp "endif")
- ("if" exp "elseif" exp "elseif" exp "else" exp "end")
- ("switch" exp "case" exp "endswitch")
- ("switch" exp "case" exp "otherwise" exp "endswitch")
- ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch")
- ("switch" exp "case" exp "case" exp "otherwise" exp "end")
- ("function" exp "endfunction")
- ("function" exp "end")
- ("enumeration" exp "endenumeration")
- ("enumeration" exp "end")
- ("events" exp "endevents")
- ("events" exp "end")
- ("methods" exp "endmethods")
- ("methods" exp "end")
- ("properties" exp "endproperties")
- ("properties" exp "end")
- ("classdef" exp "endclassdef")
- ("classdef" exp "end"))
- ;; (fundesc (atom "=" atom))
- ))
+(let-when-compile
+ ((operator-table
+ ;; Use '__operators__' in Octave REPL to get a full list?
+ '((assoc ";" "\n") (assoc ",") ;The doc says they have equal precedence!?
+ (right "=" "+=" "-=" "*=" "/=")
+ (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!?
+ (assoc "&") (assoc "|") ; The doc claims they have equal precedence!?
+ (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=")
+ (nonassoc ":") ;No idea what this is.
+ (assoc "+" "-")
+ (assoc "*" "/" "\\" ".\\" ".*" "./")
+ (nonassoc "'" ".'")
+ (nonassoc "++" "--" "!" "~") ;And unary "+" and "-".
+ (right "^" "**" ".^" ".**")
+ ;; It's not really an operator, but for indentation purposes it
+ ;; could be convenient to treat it as one.
+ (assoc "...")))
+
+ (matchedrules
+ ;; We can't distinguish the first element in a sequence with
+ ;; precedence grammars, so we can't distinguish the condition
+ ;; of the `if' from the subsequent body, for example.
+ ;; This has to be done later in the indentation rules.
+ '(("try" exp "catch" exp "end_try_catch")
+ ("unwind_protect" exp
+ "unwind_protect_cleanup" exp "end_unwind_protect")
+ ("for" exp "endfor")
+ ("parfor" exp "endparfor")
+ ("while" exp "endwhile")
+ ("if" exp "endif")
+ ("if" exp "else" exp "endif")
+ ("if" exp "elseif" exp "else" exp "endif")
+ ("if" exp "elseif" exp "elseif" exp "else" exp "endif")
+ ("switch" exp "case" exp "endswitch")
+ ("switch" exp "case" exp "otherwise" exp "endswitch")
+ ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch")
+ ("function" exp "endfunction")
+ ("enumeration" exp "endenumeration")
+ ("events" exp "endevents")
+ ("methods" exp "endmethods")
+ ("properties" exp "endproperties")
+ ("classdef" exp "endclassdef")
+ ))
+
+ (bnf-table
+ `((atom)
+ ;; FIXME: We don't parse these declarations correctly since
+ ;; SMIE *really* likes to parse "a b = 2 c" as "(a b) = (2 c)".
+ ;; IOW to do it right, we'd need to change octave-smie-*ward-token
+ ;; so that the spaces between vars in var-decls are lexed as
+ ;; something like ",".
+ ;; Doesn't seem worth the trouble/slowdown for now.
+ ;; We could hack smie-rules so as to work around the bad parse,
+ ;; but even that doesn't seem worth the trouble.
+ (var-decls (atom "=" atom)) ;; (var-decls "," var-decls)
+ (single-exp (atom "=" atom))
+ (exp (exp "\n" exp)
+ ;; We need to mention at least one of the operators in this part
+ ;; of the grammar: if the BNF and the operator table have
+ ;; no overlap, SMIE can't know how they relate.
+ (exp ";" exp)
+ ("do" exp "until" single-exp)
+ ,@matchedrules
+ ;; For every rule that ends in "endfoo", add a corresponding
+ ;; rule which uses "end" instead.
+ ,@(mapcar (lambda (rule) (nconc (butlast rule) '("end")))
+ matchedrules)
+ ("global" var-decls) ("persistent" var-decls)
+ ;; These aren't super-important, but having them here
+ ;; makes it easier to extract all keywords.
+ ("break") ("continue") ("return")
+ ;; The following rules do not correspond to valid code AFAIK,
+ ;; but they lead to a grammar that degrades more gracefully
+ ;; on incomplete/incorrect code. It also helps us in
+ ;; computing octave--block-offset-keywords.
+ ("try" exp "end") ("unwind_protect" exp "end")
+ )
+ ;; (fundesc (atom "=" atom))
+ )))
(defconst octave-smie-grammar
- (smie-prec2->grammar
- (smie-merge-prec2s
- (smie-bnf->prec2 octave-smie-bnf-table
- '((assoc "\n" ";")))
+ (eval-when-compile
+ (smie-prec2->grammar
+ (smie-merge-prec2s
+ (smie-bnf->prec2 bnf-table '((assoc "\n" ";")))
+ (smie-precs->prec2 operator-table)))))
- (smie-precs->prec2 octave-operator-table))))
+(defconst octave-operator-regexp
+ (eval-when-compile
+ (regexp-opt (remove "\n" (apply #'append
+ (mapcar #'cdr operator-table)))))))
;; Tokenizing needs to be refined so that ";;" is treated as two
;; tokens and also so as to recognize the \n separator (and
;; corresponding continuation lines).
-(defconst octave-operator-regexp
- (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table))))
+(defun octave-smie--funcall-p ()
+ "Return non-nil if we're in an expression context. Moves point."
+ (looking-at "[ \t]*("))
+
+(defun octave-smie--end-index-p ()
+ (let ((ppss (syntax-ppss)))
+ (and (nth 1 ppss)
+ (memq (char-after (nth 1 ppss)) '(?\( ?\[ ?\{)))))
+
+(defun octave-smie--in-parens-p ()
+ (let ((ppss (syntax-ppss)))
+ (and (nth 1 ppss)
+ (eq ?\( (char-after (nth 1 ppss))))))
(defun octave-smie-backward-token ()
(let ((pos (point)))
@@ -370,10 +393,7 @@ Non-nil means always go to the next Octave code line after sending."
(forward-comment (- (point)))
nil)
t)
- ;; Ignore it if it's within parentheses.
- (let ((ppss (syntax-ppss)))
- (not (and (nth 1 ppss)
- (eq ?\( (char-after (nth 1 ppss)))))))
+ (not (octave-smie--in-parens-p)))
(skip-chars-forward " \t")
;; Why bother distinguishing \n and ;?
";") ;;"\n"
@@ -383,7 +403,15 @@ Non-nil means always go to the next Octave code line after sending."
(goto-char (match-beginning 0))
(match-string-no-properties 0))
(t
- (smie-default-backward-token)))))
+ (let ((tok (smie-default-backward-token)))
+ (cond
+ ((equal tok "enumeration")
+ (if (save-excursion (smie-default-forward-token)
+ (octave-smie--funcall-p))
+ "enumeration (function)"
+ tok))
+ ((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
+ (t tok)))))))
(defun octave-smie-forward-token ()
(skip-chars-forward " \t")
@@ -397,10 +425,7 @@ Non-nil means always go to the next Octave code line after sending."
(not (or (save-excursion (skip-chars-backward " \t")
;; Only add implicit ; when needed.
(or (bolp) (eq (char-before) ?\;)))
- ;; Ignore it if it's within parentheses.
- (let ((ppss (syntax-ppss)))
- (and (nth 1 ppss)
- (eq ?\( (char-after (nth 1 ppss))))))))
+ (octave-smie--in-parens-p))))
(if (eolp) (forward-char 1) (forward-comment 1))
;; Why bother distinguishing \n and ;?
";") ;;"\n"
@@ -416,7 +441,25 @@ Non-nil means always go to the next Octave code line after sending."
(goto-char (match-end 0))
(match-string-no-properties 0))
(t
- (smie-default-forward-token))))
+ (let ((tok (smie-default-forward-token)))
+ (cond
+ ((equal tok "enumeration")
+ (if (octave-smie--funcall-p)
+ "enumeration (function)"
+ tok))
+ ((equal tok "end") (if (octave-smie--end-index-p) "end (index)" tok))
+ (t tok))))))
+
+(defconst octave--block-offset-keywords
+ (let* ((end-prec (nth 1 (assoc "end" octave-smie-grammar)))
+ (end-matchers
+ (delq nil
+ (mapcar (lambda (x) (if (eq end-prec (nth 2 x)) (car x)))
+ octave-smie-grammar))))
+ ;; Not sure if it would harm to keep "switch", but the previous code
+ ;; excluded it, presumably because there shouldn't be any code on
+ ;; the lines between "switch" and "case".
+ (delete "switch" end-matchers)))
(defun octave-smie-rules (kind token)
(pcase (cons kind token)
@@ -425,18 +468,15 @@ Non-nil means always go to the next Octave code line after sending."
;; - changes to octave-block-offset wouldn't take effect immediately.
;; - edebug wouldn't show the use of this variable.
(`(:elem . basic) octave-block-offset)
+ (`(:list-intro . ,(or "global" "persistent")) t)
;; Since "case" is in the same BNF rules as switch..end, SMIE by default
;; aligns it with "switch".
(`(:before . "case") (if (not (smie-rule-sibling-p)) octave-block-offset))
(`(:after . ";")
- (if (smie-rule-parent-p "classdef" "events" "enumeration" "function" "if"
- "while" "else" "elseif" "for" "parfor"
- "properties" "methods" "otherwise" "case"
- "try" "catch" "unwind_protect"
- "unwind_protect_cleanup")
+ (if (apply #'smie-rule-parent-p octave--block-offset-keywords)
(smie-rule-parent octave-block-offset)
;; For (invalid) code between switch and case.
- ;; (if (smie-parent-p "switch") 4)
+ ;; (if (smie-rule-parent-p "switch") 4)
nil))))
(defun octave-indent-comment ()
@@ -453,28 +493,33 @@ Non-nil means always go to the next Octave code line after sending."
(comment-choose-indent)))))
+(defvar octave-reserved-words
+ (delq nil
+ (mapcar (lambda (x)
+ (setq x (car x))
+ (and (stringp x) (string-match "\\`[[:alpha:]]" x) x))
+ octave-smie-grammar))
+ "Reserved words in Octave.")
+
(defvar octave-font-lock-keywords
(list
;; Fontify all builtin keywords.
- (cons (concat "\\_<\\("
- (regexp-opt octave-reserved-words)
- "\\)\\_>")
+ (cons (concat "\\_<" (regexp-opt octave-reserved-words) "\\_>")
'font-lock-keyword-face)
- ;; Note: 'end' also serves as the last index in an indexing expression.
+ ;; Note: 'end' also serves as the last index in an indexing expression,
+ ;; and 'enumerate' is also a function.
;; Ref: http://www.mathworks.com/help/matlab/ref/end.html
+ ;; Ref: http://www.mathworks.com/help/matlab/ref/enumeration.html
(list (lambda (limit)
- (while (re-search-forward "\\_<end\\_>" limit 'move)
+ (while (re-search-forward "\\_<en\\(?:d\\|umeratio\\(n\\)\\)\\_>"
+ limit 'move)
(let ((beg (match-beginning 0))
(end (match-end 0)))
(unless (octave-in-string-or-comment-p)
- (condition-case nil
- (progn
- (goto-char beg)
- (backward-up-list)
- (when (memq (char-after) '(?\( ?\[ ?\{))
- (put-text-property beg end 'face nil))
- (goto-char end))
- (error (goto-char end))))))
+ (when (if (match-end 1)
+ (octave-smie--funcall-p)
+ (octave-smie--end-index-p))
+ (put-text-property beg end 'face nil)))))
nil))
;; Fontify all operators.
(cons octave-operator-regexp 'font-lock-builtin-face)
@@ -520,8 +565,14 @@ Non-nil means always go to the next Octave code line after sending."
Octave is a high-level language, primarily intended for numerical
computations. It provides a convenient command line interface
for solving linear and nonlinear problems numerically. Function
-definitions can also be stored in files and used in batch mode."
+definitions can also be stored in files and used in batch mode.
+
+See Info node `(octave-mode) Using Octave Mode' for more details.
+
+Key bindings:
+\\{octave-mode-map}"
:abbrev-table octave-abbrev-table
+ :group 'octave
(smie-setup octave-smie-grammar #'octave-smie-rules
:forward-token #'octave-smie-forward-token
@@ -540,7 +591,7 @@ definitions can also be stored in files and used in batch mode."
;; a ";" at those places where it's correct (i.e. outside of parens).
(setq-local electric-layout-rules '((?\; . after)))
- (setq-local comment-use-global-state t)
+ (setq-local comment-use-syntax t)
(setq-local comment-start octave-comment-start)
(setq-local comment-end "")
(setq-local comment-start-skip octave-comment-start-skip)
@@ -575,42 +626,40 @@ definitions can also be stored in files and used in batch mode."
(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))
- (setq-local eldoc-documentation-function 'octave-eldoc-function)
+ (add-function :before-until (local 'eldoc-documentation-function)
+ 'octave-eldoc-function)
(easy-menu-add octave-mode-menu))
(defcustom inferior-octave-program "octave"
"Program invoked by `inferior-octave'."
- :type 'string
- :group 'octave)
+ :type 'string)
(defcustom inferior-octave-buffer "*Inferior Octave*"
"Name of buffer for running an inferior Octave process."
- :type 'string
- :group 'octave)
+ :type 'string)
(defcustom inferior-octave-prompt
- "\\(^octave\\(\\|.bin\\|.exe\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ "
+ ;; For Octave >= 3.8, default is always 'octave', see
+ ;; http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
+ "\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ "
"Regexp to match prompts for the inferior Octave process."
- :type 'regexp
- :group 'octave)
+ :type 'regexp)
(defcustom inferior-octave-prompt-read-only comint-prompt-read-only
"If non-nil, the Octave prompt is read only.
See `comint-prompt-read-only' for details."
:type 'boolean
- :group 'octave
:version "24.4")
(defcustom inferior-octave-startup-file
- (convert-standard-filename
- (concat "~/.emacs-" (file-name-nondirectory inferior-octave-program)))
+ (let ((n (file-name-nondirectory inferior-octave-program)))
+ (locate-user-emacs-file (format "init_%s.m" n) (format ".emacs-%s" n)))
"Name of the inferior Octave startup file.
The contents of this file are sent to the inferior Octave process on
startup."
:type '(choice (const :tag "None" nil) file)
- :group 'octave
:version "24.4")
(defcustom inferior-octave-startup-args '("-i" "--no-line-editing")
@@ -618,13 +667,29 @@ startup."
For example, for suppressing the startup message and using `traditional'
mode, include \"-q\" and \"--traditional\"."
:type '(repeat string)
- :group 'octave
:version "24.4")
(defcustom inferior-octave-mode-hook nil
"Hook to be run when Inferior Octave mode is started."
- :type 'hook
- :group 'octave)
+ :type 'hook)
+
+(defcustom inferior-octave-error-regexp-alist
+ '(("error:\\s-*\\(.*?\\) at line \\([0-9]+\\), column \\([0-9]+\\)"
+ 1 2 3 2 1)
+ ("warning:\\s-*\\([^:\n]+\\):.*at line \\([0-9]+\\), column \\([0-9]+\\)"
+ 1 2 3 1 1))
+ "Value for `compilation-error-regexp-alist' in inferior octave."
+ :version "24.4"
+ :type '(repeat (choice (symbol :tag "Predefined symbol")
+ (sexp :tag "Error specification"))))
+
+(defvar inferior-octave-compilation-font-lock-keywords
+ '(("\\_<PASS\\_>" . compilation-info-face)
+ ("\\_<FAIL\\_>" . compilation-error-face)
+ ("\\_<\\(warning\\):" 1 compilation-warning-face)
+ ("\\_<\\(error\\):" 1 compilation-error-face)
+ ("^\\s-*!!!!!.*\\|^.*failed$" . compilation-error-face))
+ "Value for `compilation-mode-font-lock-keywords' in inferior octave.")
(defvar inferior-octave-process nil)
@@ -634,6 +699,7 @@ mode, include \"-q\" and \"--traditional\"."
(define-key map "\M-." 'octave-find-definition)
(define-key map "\t" 'completion-at-point)
(define-key map "\C-hd" 'octave-help)
+ (define-key map "\C-ha" 'octave-lookfor)
;; Same as in `shell-mode'.
(define-key map "\M-?" 'comint-dynamic-list-filename-completions)
(define-key map "\C-c\C-l" 'inferior-octave-dynamic-list-input-ring)
@@ -645,7 +711,7 @@ mode, include \"-q\" and \"--traditional\"."
(defvar inferior-octave-mode-syntax-table
(let ((table (make-syntax-table octave-mode-syntax-table)))
table)
- "Syntax table in use in inferior-octave-mode buffers.")
+ "Syntax table in use in `inferior-octave-mode' buffers.")
(defvar inferior-octave-font-lock-keywords
(list
@@ -667,13 +733,28 @@ This variable is used to initialize `comint-dynamic-complete-functions'
in the Inferior Octave buffer.")
(defvar info-lookup-mode)
+(defvar compilation-error-regexp-alist)
+(defvar compilation-mode-font-lock-keywords)
+
+(declare-function compilation-forget-errors "compile" ())
+
+(defun inferior-octave-process-live-p ()
+ (process-live-p inferior-octave-process))
(define-derived-mode inferior-octave-mode comint-mode "Inferior Octave"
- "Major mode for interacting with an inferior Octave process."
+ "Major mode for interacting with an inferior Octave process.
+
+See Info node `(octave-mode) Running Octave from Within Emacs' for more
+details.
+
+Key bindings:
+\\{inferior-octave-mode-map}"
:abbrev-table octave-abbrev-table
+ :group 'octave
+
(setq comint-prompt-regexp inferior-octave-prompt)
- (setq-local comment-use-global-state t)
+ (setq-local comment-use-syntax t)
(setq-local comment-start octave-comment-start)
(setq-local comment-end "")
(setq comment-column 32)
@@ -684,9 +765,11 @@ in the Inferior Octave buffer.")
(setq-local info-lookup-mode 'octave-mode)
(setq-local eldoc-documentation-function 'octave-eldoc-function)
- (setq comint-input-ring-file-name
- (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist")
- comint-input-ring-size (or (getenv "OCTAVE_HISTSIZE") 1024))
+ (setq-local comint-input-ring-file-name
+ (or (getenv "OCTAVE_HISTFILE") "~/.octave_hist"))
+ (setq-local comint-input-ring-size
+ (string-to-number (or (getenv "OCTAVE_HISTSIZE") "1024")))
+ (comint-read-input-ring t)
(setq-local comint-dynamic-complete-functions
inferior-octave-dynamic-complete-functions)
(setq-local comint-prompt-read-only inferior-octave-prompt-read-only)
@@ -695,7 +778,11 @@ in the Inferior Octave buffer.")
;; http://thread.gmane.org/gmane.comp.gnu.octave.general/48572
(add-hook 'window-configuration-change-hook
'inferior-octave-track-window-width-change nil t)
- (comint-read-input-ring t))
+ (setq-local compilation-error-regexp-alist inferior-octave-error-regexp-alist)
+ (setq-local compilation-mode-font-lock-keywords
+ inferior-octave-compilation-font-lock-keywords)
+ (compilation-shell-minor-mode 1)
+ (compilation-forget-errors))
;;;###autoload
(defun inferior-octave (&optional arg)
@@ -747,8 +834,13 @@ startup file, `~/.emacs-octave'."
;; output may be mixed up). Hence, we need to digest the Octave
;; output to see when it issues a prompt.
(while inferior-octave-receive-in-progress
- (or (process-live-p inferior-octave-process)
- (error "Process `%s' died" inferior-octave-process))
+ (unless (inferior-octave-process-live-p)
+ ;; Spit out the error messages.
+ (when inferior-octave-output-list
+ (princ (concat (mapconcat 'identity inferior-octave-output-list "\n")
+ "\n")
+ (process-mark inferior-octave-process)))
+ (error "Process `%s' died" inferior-octave-process))
(accept-process-output inferior-octave-process))
(goto-char (point-max))
(set-marker (process-mark proc) (point))
@@ -777,7 +869,8 @@ startup file, `~/.emacs-octave'."
(inferior-octave-send-list-and-digest
(list "more off;\n"
(unless (equal inferior-octave-output-string ">> ")
- "PS1 ('\\s> ');\n")
+ ;; See http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
+ "PS1 ('octave> ');\n")
(when (and inferior-octave-startup-file
(file-exists-p inferior-octave-startup-file))
(format "source ('%s');\n" inferior-octave-startup-file))))
@@ -794,38 +887,26 @@ startup file, `~/.emacs-octave'."
;; `comint-history-isearch-backward-regexp'. Bug#14433.
(comint-send-string proc "\n")))
-(defvar inferior-octave-completion-table
- ;;
- ;; Use cache to avoid repetitive computation of completions due to
- ;; bug#11906 - http://debbugs.gnu.org/11906 - which may cause
- ;; noticeable delay. CACHE: (CMD TIME VALUE).
- (let ((cache))
- (completion-table-dynamic
- (lambda (command)
- (unless (and (equal (car cache) command)
- (< (float-time) (+ 5 (cadr cache))))
- (inferior-octave-send-list-and-digest
- (list (format "completion_matches ('%s');\n" command)))
- (setq cache (list command (float-time)
- (delete-consecutive-dups
- (sort inferior-octave-output-list 'string-lessp)))))
- (car (cddr cache))))))
+(defun inferior-octave-completion-table ()
+ (completion-table-with-cache
+ (lambda (command)
+ (inferior-octave-send-list-and-digest
+ (list (format "completion_matches ('%s');\n" command)))
+ (delete-consecutive-dups
+ (sort inferior-octave-output-list 'string-lessp)))))
(defun inferior-octave-completion-at-point ()
"Return the data to complete the Octave symbol at point."
;; http://debbugs.gnu.org/14300
- (let* ((filecomp (string-match-p
- "/" (or (comint--match-partial-filename) "")))
- (end (point))
- (start
- (unless filecomp
- (save-excursion
- (skip-syntax-backward "w_" (comint-line-beginning-position))
- (point)))))
- (when (and start (> end start))
- (list start end (completion-table-in-turn
- inferior-octave-completion-table
- 'comint-completion-file-name-table)))))
+ (unless (string-match-p "/" (or (comint--match-partial-filename) ""))
+ (let ((beg (save-excursion
+ (skip-syntax-backward "w_" (comint-line-beginning-position))
+ (point)))
+ (end (point)))
+ (when (and beg (> end beg))
+ (list beg end (completion-table-in-turn
+ (inferior-octave-completion-table)
+ 'comint-completion-file-name-table))))))
(define-obsolete-function-alias 'inferior-octave-complete
'completion-at-point "24.1")
@@ -855,7 +936,7 @@ startup file, `~/.emacs-octave'."
(let ((ch (read-event)))
(if (eq ch ?\ )
(set-window-configuration conf)
- (setq unread-command-events (list ch)))))))
+ (push ch unread-command-events))))))
(defun inferior-octave-output-digest (_proc string)
"Special output filter for the inferior Octave process.
@@ -872,8 +953,7 @@ the rest to `inferior-octave-output-string'."
(setq inferior-octave-output-string string))
(defun inferior-octave-check-process ()
- (or (and inferior-octave-process
- (process-live-p inferior-octave-process))
+ (or (inferior-octave-process-live-p)
(error (substitute-command-keys
"No inferior octave process running. Type \\[run-octave]"))))
@@ -932,7 +1012,6 @@ directory and makes this the current buffer's default directory."
(defcustom inferior-octave-minimal-columns 80
"The minimal column width for the inferior Octave process."
:type 'integer
- :group 'octave
:version "24.4")
(defvar inferior-octave-last-column-width nil)
@@ -942,8 +1021,7 @@ directory and makes this the current buffer's default directory."
(let ((width (max inferior-octave-minimal-columns (window-width))))
(unless (eq inferior-octave-last-column-width width)
(setq-local inferior-octave-last-column-width width)
- (when (and inferior-octave-process
- (process-live-p inferior-octave-process))
+ (when (inferior-octave-process-live-p)
(inferior-octave-send-list-and-digest
(list (format "putenv ('COLUMNS', '%s');\n" width)))))))
@@ -984,7 +1062,7 @@ directory and makes this the current buffer's default directory."
(completing-read
(format (if def "Function (default %s): "
"Function: ") def)
- inferior-octave-completion-table
+ (inferior-octave-completion-table)
nil nil nil nil def)))
(defun octave-goto-function-definition (fn)
@@ -1002,7 +1080,7 @@ directory and makes this the current buffer's default directory."
(pcase (and buffer-file-name (file-name-extension buffer-file-name))
(`"cc" (funcall search
"\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1))
- (t (funcall search octave-function-header-regexp 3)))))
+ (_ (funcall search octave-function-header-regexp 3)))))
(defun octave-function-file-p ()
"Return non-nil if the first token is \"function\".
@@ -1060,7 +1138,7 @@ See Info node `(octave)Function Files'."
(let* ((func (buffer-substring name-start name-end))
(file (file-name-sans-extension
(file-name-nondirectory buffer-file-name)))
- (help-form (format "\
+ (help-form (format-message "\
a: Use function name `%s'
b: Use file name `%s'
q: Don't fix\n" func file))
@@ -1118,8 +1196,7 @@ q: Don't fix\n" func file))
(defface octave-function-comment-block
'((t (:inherit font-lock-doc-face)))
- "Face used to highlight function comment block."
- :group 'octave)
+ "Face used to highlight function comment block.")
(eval-when-compile (require 'texinfo))
@@ -1367,9 +1444,8 @@ The block marked is the one that contains point or follows point."
(save-excursion (skip-syntax-forward "w_")
(setq end (point))))
(when (> end beg)
- (list beg end (or (and inferior-octave-process
- (process-live-p inferior-octave-process)
- inferior-octave-completion-table)
+ (list beg end (or (and (inferior-octave-process-live-p)
+ (inferior-octave-completion-table))
octave-reserved-words)))))
(define-obsolete-function-alias 'octave-complete-symbol
@@ -1413,12 +1489,15 @@ entered without parens)."
(defun octave-kill-process ()
"Kill inferior Octave process and its buffer."
(interactive)
- (if inferior-octave-process
- (progn
- (process-send-string inferior-octave-process "quit;\n")
- (accept-process-output inferior-octave-process)))
- (if inferior-octave-buffer
- (kill-buffer inferior-octave-buffer)))
+ (when (and (buffer-live-p (get-buffer inferior-octave-buffer))
+ (or (yes-or-no-p (format "Kill %S and its buffer? "
+ inferior-octave-process))
+ (user-error "Aborted")))
+ (when (inferior-octave-process-live-p)
+ (set-process-query-on-exit-flag inferior-octave-process nil)
+ (process-send-string inferior-octave-process "quit;\n")
+ (accept-process-output inferior-octave-process))
+ (kill-buffer inferior-octave-buffer)))
(defun octave-show-process-buffer ()
"Make sure that `inferior-octave-buffer' is displayed."
@@ -1434,6 +1513,19 @@ entered without parens)."
(delete-windows-on inferior-octave-buffer)
(message "No buffer named %s" inferior-octave-buffer)))
+(defun octave-source-file (file)
+ "Execute FILE in the inferior Octave process.
+This is done using Octave's source function. FILE defaults to
+current buffer file unless called with a prefix arg \\[universal-argument]."
+ (interactive (list (or (and (not current-prefix-arg) buffer-file-name)
+ (read-file-name "File: " nil nil t))))
+ (or (stringp file)
+ (signal 'wrong-type-argument (list 'stringp file)))
+ (inferior-octave t)
+ (with-current-buffer inferior-octave-buffer
+ (comint-send-string inferior-octave-process
+ (format "source '%s'\n" file))))
+
(defun octave-send-region (beg end)
"Send current region to the inferior Octave process."
(interactive "r")
@@ -1442,6 +1534,8 @@ entered without parens)."
(string (buffer-substring-no-properties beg end))
line)
(with-current-buffer inferior-octave-buffer
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00095.html
+ (compilation-forget-errors)
(setq inferior-octave-output-list nil)
(while (not (string-equal string ""))
(if (string-match "\n" string)
@@ -1462,6 +1556,11 @@ entered without parens)."
(if octave-send-show-buffer
(display-buffer inferior-octave-buffer)))
+(defun octave-send-buffer ()
+ "Send current buffer to the inferior Octave process."
+ (interactive)
+ (octave-send-region (point-min) (point-max)))
+
(defun octave-send-block ()
"Send current Octave block to the inferior Octave process."
(interactive)
@@ -1518,7 +1617,6 @@ code line."
:type '(choice (const :tag "Automatic" auto)
(const :tag "One Line" oneline)
(const :tag "Multi Line" multiline))
- :group 'octave
:version "24.4")
;; (FN SIGNATURE1 SIGNATURE2 ...)
@@ -1541,8 +1639,7 @@ code line."
(defun octave-eldoc-function ()
"A function for `eldoc-documentation-function' (which see)."
- (when (and inferior-octave-process
- (process-live-p inferior-octave-process))
+ (when (inferior-octave-process-live-p)
(let* ((ppss (syntax-ppss))
(paren-pos (cadr ppss))
(fn (save-excursion
@@ -1578,9 +1675,11 @@ code line."
(defcustom octave-help-buffer "*Octave Help*"
"Buffer name for `octave-help'."
:type 'string
- :group 'octave
:version "24.4")
+;; Used in a mode derived from help-mode.
+(declare-function help-button-action "help-mode" (button))
+
(define-button-type 'octave-help-file
'follow-link t
'action #'help-button-action
@@ -1594,8 +1693,9 @@ code line."
(defvar octave-help-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\M-." 'octave-find-definition)
+ (define-key map "\M-." 'octave-find-definition)
(define-key map "\C-hd" 'octave-help)
+ (define-key map "\C-ha" 'octave-lookfor)
map))
(define-derived-mode octave-help-mode help-mode "OctHelp"
@@ -1603,26 +1703,9 @@ code line."
:abbrev-table nil
:syntax-table octave-mode-syntax-table
(eval-and-compile (require 'help-mode))
- ;; Mostly stolen from `help-make-xrefs'.
- (let ((inhibit-read-only t))
- (setq-local info-lookup-mode 'octave-mode)
- ;; Delete extraneous newlines at the end of the docstring
- (goto-char (point-max))
- (while (and (not (bobp)) (bolp))
- (delete-char -1))
- (insert "\n")
- (when (or help-xref-stack help-xref-forward-stack)
- (insert "\n"))
- (when help-xref-stack
- (help-insert-xref-button help-back-label 'help-back
- (current-buffer)))
- (when help-xref-forward-stack
- (when help-xref-stack
- (insert "\t"))
- (help-insert-xref-button help-forward-label 'help-forward
- (current-buffer)))
- (when (or help-xref-stack help-xref-forward-stack)
- (insert "\n"))))
+ ;; Don't highlight `EXAMPLE' as elisp symbols by using a regexp that
+ ;; can never match.
+ (setq-local help-xref-symbol-regexp "x\\`"))
(defun octave-help (fn)
"Display the documentation of FN."
@@ -1658,12 +1741,12 @@ code line."
(dir (file-name-directory
(directory-file-name (file-name-directory file)))))
(replace-match "" nil nil nil 1)
- (insert "`")
+ (insert (substitute-command-keys "`"))
;; Include the parent directory which may be regarded as
;; the category for the FN.
(help-insert-xref-button (file-relative-name file dir)
'octave-help-file fn)
- (insert "'")))
+ (insert (substitute-command-keys "'"))))
;; Make 'See also' clickable.
(with-syntax-table octave-mode-syntax-table
(when (re-search-forward "^\\s-*See also:" nil t)
@@ -1674,11 +1757,48 @@ code line."
:type 'octave-help-function)))))
(octave-help-mode)))))
+(defun octave-lookfor (str &optional all)
+ "Search for the string STR in all function help strings.
+If ALL is non-nil search the entire help string else only search the first
+sentence."
+ (interactive "sSearch for: \nP")
+ (inferior-octave-send-list-and-digest
+ (list (format "lookfor (%s'%s');\n"
+ (if all "'-all', " "")
+ str)))
+ (let ((lines inferior-octave-output-list))
+ (when (and (stringp (car lines))
+ (string-match "error: \\(.*\\)$" (car lines)))
+ (error "%s" (match-string 1 (car lines))))
+ (with-help-window octave-help-buffer
+ (with-current-buffer octave-help-buffer
+ (if lines
+ (insert (mapconcat 'identity lines "\n"))
+ (insert (format "Nothing found for \"%s\".\n" str)))
+ ;; Bound to t so that `help-buffer' returns current buffer for
+ ;; `help-setup-xref'.
+ (let ((help-xref-following t))
+ (help-setup-xref (list 'octave-lookfor str all)
+ (called-interactively-p 'interactive)))
+ (goto-char (point-min))
+ (when lines
+ (while (re-search-forward "^\\([^[:blank:]]+\\) " nil 'noerror)
+ (make-text-button (match-beginning 1) (match-end 1)
+ :type 'octave-help-function)))
+ (unless all
+ (goto-char (point-max))
+ (insert "\nRetry with ")
+ (insert-text-button "'-all'"
+ 'follow-link t
+ 'action #'(lambda (_b)
+ (octave-lookfor str '-all)))
+ (insert ".\n"))
+ (octave-help-mode)))))
+
(defcustom octave-source-directories nil
"A list of directories for Octave sources.
If the environment variable OCTAVE_SRCDIR is set, it is searched first."
:type '(repeat directory)
- :group 'octave
:version "24.4")
(defun octave-source-directories ()
@@ -1708,18 +1828,18 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first."
(error "File `%s' not found" name))
file))
(`"mex"
- (if (yes-or-no-p (format "File `%s' may be binary; open? "
- (file-name-nondirectory name)))
+ (if (yes-or-no-p (format-message "File `%s' may be binary; open? "
+ (file-name-nondirectory name)))
name
(user-error "Aborted")))
- (t name)))
+ (_ name)))
(defvar find-tag-marker-ring)
(defun octave-find-definition (fn)
"Find the definition of FN.
Functions implemented in C++ can be found if
-`octave-source-directories' is set correctly."
+variable `octave-source-directories' is set correctly."
(interactive (list (octave-completing-read)))
(require 'etags)
(let ((orig (point)))
@@ -1739,7 +1859,7 @@ if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
(when (string-match "from the file \\(.*\\)$" line)
(setq file (match-string 1 line))))
(if (not file)
- (user-error "%s" (or line (format "`%s' not found" fn)))
+ (user-error "%s" (or line (format-message "`%s' not found" fn)))
(ring-insert find-tag-marker-ring (point-marker))
(setq file (funcall octave-find-definition-filename-function file))
(when file
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index e608ea8af0e..ef3433f003b 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -1,6 +1,6 @@
;;; opascal.el --- major mode for editing Object Pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2015 Free Software Foundation, Inc.
;; Authors: Ray Blaak <blaak@infomatch.com>,
;; Simon South <ssouth@member.fsf.org>
@@ -73,7 +73,7 @@ end;"
(define-obsolete-variable-alias
'delphi-compound-block-indent 'opascal-compound-block-indent "24.4")
(defcustom opascal-compound-block-indent 0
- "Extra indentation for blocks in compound statements. E.g.
+ "Extra indentation for blocks in compound statements. E.g.
// block indent = 0 vs // block indent = 2
if b then if b then
@@ -87,7 +87,7 @@ end; else
(define-obsolete-variable-alias
'delphi-case-label-indent 'opascal-case-label-indent "24.4")
(defcustom opascal-case-label-indent opascal-indent-level
- "Extra indentation for case statement labels. E.g.
+ "Extra indentation for case statement labels. E.g.
// case indent = 0 vs // case indent = 3
case value of case value of
@@ -106,10 +106,14 @@ end; end;"
(define-obsolete-variable-alias
'delphi-tab-always-indents 'opascal-tab-always-indents "24.4")
(defcustom opascal-tab-always-indents tab-always-indent
- "Non-nil means TAB in OPascal mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used."
+ "Non-nil means `opascal-tab' should always reindent the current line.
+That is, regardless of where in the line point is at the time."
:type 'boolean)
+(make-obsolete-variable 'opascal-tab-always-indents
+ "use `indent-for-tab-command' and `tab-always-indent'."
+ "24.4")
+
(defconst opascal-directives
'(absolute abstract assembler automated cdecl default dispid dynamic
export external far forward index inline message name near nodefault
@@ -364,7 +368,7 @@ routine.")
;; Report the percentage complete.
(setq opascal-progress-last-reported-point p)
(message "%s %s ... %d%%"
- desc (buffer-name) (/ (* 100 p) (point-max))))))
+ desc (buffer-name) (floor (* 100.0 p) (point-max))))))
(defun opascal-next-line-start (&optional from-point)
;; Returns the first point of the next line.
@@ -1393,7 +1397,7 @@ If before the indent, the point is moved to the indent."
(when opascal-debug
(opascal-ensure-buffer opascal-debug-buffer "*OPascal Debug Log*")
(opascal-log-msg opascal-debug-buffer
- (concat (format-time-string "%H:%M:%S " (current-time))
+ (concat (format-time-string "%H:%M:%S ")
(apply #'format (cons format-string args))
"\n"))))
@@ -1447,8 +1451,8 @@ If before the indent, the point is moved to the indent."
(defun opascal-tab ()
- "Indent the region, when Transient Mark mode is enabled and the region is
-active. Otherwise, indent the current line or insert a TAB, depending on the
+ "Indent the region, if Transient Mark mode is on and the region is active.
+Otherwise, indent the current line or insert a TAB, depending on the
value of `opascal-tab-always-indents' and the current line position."
(interactive)
(cond ((use-region-p)
@@ -1465,6 +1469,7 @@ value of `opascal-tab-always-indents' and the current line position."
;; Otherwise, insert a tab character.
(insert "\t"))))
+(make-obsolete 'opascal-tab 'indent-for-tab-command "24.4")
(defun opascal-is-directory (path)
;; True if the specified path is an existing directory.
@@ -1739,7 +1744,7 @@ comment block. If not in a // comment, just does a normal newline."
(define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4")
;;;###autoload
(define-derived-mode opascal-mode prog-mode "OPascal"
- "Major mode for editing OPascal code. \\<opascal-mode-map>
+ "Major mode for editing OPascal code.\\<opascal-mode-map>
\\[opascal-find-unit]\t- Search for a OPascal source file.
\\[opascal-fill-comment]\t- Fill the current comment.
\\[opascal-new-comment-line]\t- If in a // comment, do a new comment line.
@@ -1754,9 +1759,6 @@ Customization:
Extra indentation for blocks in compound statements.
`opascal-case-label-indent' (default 0)
Extra indentation for case statement labels.
- `opascal-tab-always-indents' (default `tab-always-indents')
- Non-nil means TAB in OPascal mode should always reindent the current line,
- regardless of where in the line point is when the TAB command is used.
`opascal-search-path' (default .)
Directories to search when finding external units.
`opascal-verbose' (default nil)
@@ -1764,11 +1766,8 @@ Customization:
Coloring:
- `opascal-keyword-face' (default font-lock-keyword-face)
- Face used to color OPascal keywords.
-
-Turning on OPascal mode calls the value of the variable `opascal-mode-hook'
-with no args, if that value is non-nil."
+ `opascal-keyword-face' (default `font-lock-keyword-face')
+ Face used to color OPascal keywords."
;; Buffer locals:
(setq-local indent-line-function #'opascal-indent-line)
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index ffc8200644a..454367c10fa 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -1,6 +1,6 @@
;;; pascal.el --- major mode for editing pascal source in Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2015 Free Software Foundation, Inc.
;; Author: Espen Skoglund <esk@gnu.org>
;; Keywords: languages
@@ -26,8 +26,8 @@
;; =====
;; Emacs should enter Pascal mode when you find a Pascal source file.
-;; When you have entered Pascal mode, you may get more info by pressing
-;; C-h m. You may also get online help describing various functions by:
+;; When you have entered Pascal mode, you can get more info by pressing
+;; C-h m. You can also get help describing various functions by:
;; C-h f <Name of function you want described>
;; If you want to customize Pascal mode to fit you better, you may add
@@ -64,7 +64,7 @@
:group 'languages)
(defvar pascal-mode-abbrev-table nil
- "Abbrev table in use in Pascal-mode buffers.")
+ "Abbrev table in use in Pascal mode buffers.")
(define-abbrev-table 'pascal-mode-abbrev-table ())
(defvar pascal-mode-map
@@ -99,7 +99,7 @@
(defvar pascal-imenu-generic-expression
'((nil "^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" 2))
- "Imenu expression for Pascal-mode. See `imenu-generic-expression'.")
+ "Imenu expression for Pascal mode. See `imenu-generic-expression'.")
(defvar pascal-keywords
'("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end"
@@ -126,8 +126,10 @@
"\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
;;; Strings used to mark beginning and end of excluded text
-(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
-(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
+(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----"
+ "String used to mark beginning of excluded text.")
+(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}"
+ "String used to mark end of excluded text.")
(defvar pascal-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -164,21 +166,19 @@
(3 font-lock-function-name-face))
;; ("type" "const" "real" "integer" "char" "boolean" "var"
;; "record" "array" "file")
- (,(concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
- "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
- font-lock-type-face)
- ("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-constant-face)
- ("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
+ (,(concat "\\_<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
+ "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\_>")
+ . font-lock-type-face)
+ ("\\_<\\(label\\|external\\|forward\\)\\_>" . font-lock-constant-face)
+ ("\\_<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face)
;; ("of" "to" "for" "if" "then" "else" "case" "while"
;; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
- ,(concat "\\<\\("
+ ,(concat "\\_<\\("
"and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
"not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
- "\\)\\>")
- ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
- 1 font-lock-keyword-face)
- ("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
- 2 font-lock-keyword-face t))
+ "\\)\\_>")
+ ("\\_<\\(goto\\)\\_>[ \t]*\\([0-9]+\\)?"
+ (1 font-lock-keyword-face) (2 font-lock-keyword-face t)))
"Additional expressions to highlight in Pascal mode.")
(defconst pascal--syntax-propertize
@@ -227,16 +227,16 @@ and follows non-whitespace text."
(defcustom pascal-auto-endcomments t
"Non-nil means automatically insert comments after certain `end's.
-Specifically, this is done after the ends of cases statements and functions.
+Specifically, this is done after the ends of case statements and functions.
The name of the function or case is included between the braces."
:type 'boolean
:group 'pascal)
(defcustom pascal-auto-lineup '(all)
"List of contexts where auto lineup of :'s or ='s should be done.
-Elements can be of type: 'paramlist', 'declaration' or 'case', which will
+Elements can be of type: `paramlist', `declaration' or `case', which will
do auto lineup in parameterlist, declarations or case-statements
-respectively. The word 'all' will do all lineups. '(case paramlist) for
+respectively. The word `all' will do all lineups. '(case paramlist) for
instance will do lineup in case-statements and parameterlist, while '(all)
will do all lineups."
:type '(set :extra-offset 8
@@ -314,7 +314,7 @@ are handled in another way, and should not be added to this list."
;;;###autoload
(define-derived-mode pascal-mode prog-mode "Pascal"
- "Major mode for editing Pascal code. \\<pascal-mode-map>
+ "Major mode for editing Pascal code.\\<pascal-mode-map>
TAB indents for Pascal code. Delete converts tabs to spaces as it moves back.
\\[completion-at-point] completes the word around current point with respect \
@@ -355,10 +355,7 @@ Variables controlling indentation/edit style:
List of contexts where auto lineup of :'s or ='s should be done.
See also the user variables `pascal-type-keywords', `pascal-start-keywords' and
-`pascal-separator-keywords'.
-
-Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil."
+`pascal-separator-keywords'."
(setq-local local-abbrev-table pascal-mode-abbrev-table)
(setq-local indent-line-function 'pascal-indent-line)
(setq-local comment-indent-function 'pascal-indent-comment)
@@ -507,7 +504,7 @@ no args, if that value is non-nil."
(insert " "))
(defun pascal-mark-defun ()
- "Mark the current pascal function (or procedure).
+ "Mark the current Pascal function (or procedure).
This puts the mark at the end, and point at the beginning."
(interactive)
(push-mark (point))
@@ -518,14 +515,14 @@ This puts the mark at the end, and point at the beginning."
(zmacs-activate-region)))
(defun pascal-comment-area (start end)
- "Put the region into a Pascal comment.
+ "Put the region into a Pascal comment.\\<pascal-mode-map>
The comments that are in this area are \"deformed\":
`*)' becomes `!(*' and `}' becomes `!{'.
These deformed comments are returned to normal if you use
\\[pascal-uncomment-area] to undo the commenting.
-The commented area starts with `pascal-exclude-str-start', and ends with
-`pascal-include-str-end'. But if you change these variables,
+The commented area starts with `pascal-exclude-str-start', and ends
+with `pascal-exclude-str-end'. But if you change these variables,
\\[pascal-uncomment-area] won't recognize the comments."
(interactive "r")
(save-excursion
@@ -553,8 +550,8 @@ The commented area starts with `pascal-exclude-str-start', and ends with
(defun pascal-uncomment-area ()
"Uncomment a commented area; change deformed comments back to normal.
-This command does nothing if the pointer is not in a commented
-area. See also `pascal-comment-area'."
+This command does nothing if the pointer is not in a commented area.
+See also `pascal-comment-area'."
(interactive)
(save-excursion
(let ((start (point))
@@ -938,7 +935,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(defun pascal-indent-level ()
"Return the indent-level the current statement has.
-Do not count labels, case-statements or records."
+Do not count labels, case statements or records."
(save-excursion
(beginning-of-line)
(if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
@@ -995,7 +992,7 @@ Do not count labels, case-statements or records."
(defun pascal-indent-paramlist (&optional arg)
"Indent current line in parameterlist.
-If optional arg is non-nil, just return the
+If optional ARG is non-nil, just return the
indent of the current line in parameterlist."
(save-excursion
(let* ((oldpos (point))
@@ -1414,7 +1411,7 @@ and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
When enabled, portions of the text being edited may be made
-invisible. \\<pascal-outline-map>
+invisible.\\<pascal-outline-map>
Pascal Outline mode provides some additional commands.
@@ -1428,7 +1425,7 @@ Pascal Outline mode provides some additional commands.
\\[pascal-show-all]\t- Show the whole buffer.
\\[pascal-hide-other-defuns]\
\t- Hide everything but the current function (function under the cursor).
-\\[pascal-outline]\t- Leave pascal-outline-mode."
+\\[pascal-outline]\t- Leave Pascal Outline mode."
:init-value nil :lighter " Outl" :keymap pascal-outline-map
(add-to-invisibility-spec '(pascal . t))
(unless pascal-outline-mode
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 8955c64aa9e..55d69bfddff 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -1,9 +1,9 @@
-;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*-
+;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: William F. Mann
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR
;; Keywords: languages
@@ -66,22 +66,7 @@
;; a rich language; writing a more suitable parser would be a big job):
;; 2) The globbing syntax <pattern> is not recognized, so special
;; characters in the pattern string must be backslashed.
-;; 3) The << quoting operators are not recognized; see below.
-;; 5) To make '$' work correctly, $' is not recognized as a variable.
-;; Use "$'" or $POSTMATCH instead.
;;
-;; If you don't use font-lock, additional problems will appear:
-;; 1) Regular expression delimiters do not act as quotes, so special
-;; characters such as `'"#:;[](){} may need to be backslashed
-;; in regular expressions and in both parts of s/// and tr///.
-;; 4) The q and qq quoting operators are not recognized; see below.
-;; 5) To make variables such a $' and $#array work, perl-mode treats
-;; $ just like backslash, so '$' is not treated correctly.
-;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an
-;; unmatched }. See below.
-;; 7) When ' (quote) is used as a package name separator, perl-mode
-;; doesn't understand, and thinks it is seeing a quoted string.
-
;; Here are some ugly tricks to bypass some of these problems: the perl
;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
;; but will trick perl-mode into starting a quoted string, which
@@ -127,7 +112,7 @@
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?# "<" st)
;; `$' is also a prefix char so I was tempted to say "/ p",
- ;; but the `p' thingy basically overrides the `/' :-( --stef
+ ;; but the `p' thingy basically overrides the `/' :-( -- Stef
(modify-syntax-entry ?$ "/" st)
(modify-syntax-entry ?% ". p" st)
(modify-syntax-entry ?@ ". p" st)
@@ -218,6 +203,16 @@
(defvar perl-quote-like-pairs
'((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>)))
+(eval-and-compile
+ (defconst perl--syntax-exp-intro-keywords
+ '("split" "if" "unless" "until" "while" "print"
+ "grep" "map" "not" "or" "and" "for" "foreach"))
+
+ (defconst perl--syntax-exp-intro-regexp
+ (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
+ (regexp-opt perl--syntax-exp-intro-keywords)
+ "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+
;; FIXME: handle here-docs and regexps.
;; <<EOF <<"EOF" <<'EOF' (no space)
;; see `man perlop'
@@ -250,7 +245,11 @@
;; Catch ${ so that ${var} doesn't screw up indentation.
;; This also catches $' to handle 'foo$', although it should really
;; check that it occurs inside a '..' string.
- ("\\(\\$\\)[{']" (1 ". p"))
+ ("\\(\\$\\)[{']" (1 (unless (and (eq ?\' (char-after (match-end 1)))
+ (save-excursion
+ (not (nth 3 (syntax-ppss
+ (match-beginning 0))))))
+ (string-to-syntax ". p"))))
;; Handle funny names like $DB'stop.
("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
@@ -258,7 +257,7 @@
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
;; Be careful not to match "sub { (...) ... }".
- ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
+ ("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([^)]+\\))"
(1 "."))
;; Turn __DATA__ trailer into a comment.
("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)"
@@ -274,10 +273,7 @@
;; *opening* slash. We can afford to mis-match the closing ones
;; here, because they will be re-treated separately later in
;; perl-font-lock-special-syntactic-constructs.
- ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
- (regexp-opt '("split" "if" "unless" "until" "while" "split"
- "grep" "map" "not" "or" "and"))
- "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
+ ((concat perl--syntax-exp-intro-regexp "\\(/\\)")
(2 (ignore
(if (and (match-end 1) ; / at BOL.
(save-excursion
@@ -285,8 +281,13 @@
(forward-comment (- (point-max)))
(put-text-property (point) (match-end 2)
'syntax-multiline t)
- (not (memq (char-before)
- '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
+ (not (or (and (eq ?w (char-syntax (preceding-char)))
+ (let ((end (point)))
+ (backward-sexp 1)
+ (member (buffer-substring (point) end)
+ perl--syntax-exp-intro-keywords)))
+ (memq (char-before)
+ '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))))
nil ;; A division sign instead of a regexp-match.
(put-text-property (match-beginning 2) (match-end 2)
'syntax-table (string-to-syntax "\""))
@@ -304,18 +305,29 @@
(looking-at-p "sub[ \t\n]"))
;; This is defining a function.
nil
- (put-text-property (match-beginning 3) (match-end 3)
- 'syntax-table
- (if (assoc (char-after (match-beginning 3))
- perl-quote-like-pairs)
- (string-to-syntax "|")
- (string-to-syntax "\"")))
- (perl-syntax-propertize-special-constructs end)))))
+ (unless (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))
+ ;; Don't add this syntax-table property if
+ ;; within a string, which would misbehave in cases such as
+ ;; $a = "foo y \"toto\" bar" where we'd end up changing the
+ ;; syntax of the backslash and hence de-escaping the embedded
+ ;; double quote.
+ (put-text-property (match-beginning 3) (match-end 3)
+ 'syntax-table
+ (if (assoc (char-after (match-beginning 3))
+ perl-quote-like-pairs)
+ (string-to-syntax "|")
+ (string-to-syntax "\"")))
+ (perl-syntax-propertize-special-constructs end))))))
;; Here documents.
- ;; TODO: Handle <<WORD. These are trickier because you need to
- ;; disambiguate with the shift operator.
- ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)"
- (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table))
+ ((concat
+ "\\(?:"
+ ;; << "EOF", << 'EOF', or << \EOF
+ "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
+ ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
+ ;; disambiguate with the left-bitshift operator.
+ "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)"
+ ".*\\(\n\\)")
+ (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table))
(name (match-string 1)))
(goto-char (match-end 1))
(if (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
@@ -325,7 +337,8 @@
;; Remember the names of heredocs found on this line.
(cons (pcase (aref name 0)
(`?\\ (substring name 1))
- (_ (substring name 1 -1)))
+ ((or `?\" `?\' `?\`) (substring name 1 -1))
+ (_ name))
(cdr st)))))))
;; We don't call perl-syntax-propertize-special-constructs directly
;; from the << rule, because there might be other elements (between
@@ -494,8 +507,7 @@
(defcustom perl-indent-level 4
"Indentation of Perl statements with respect to containing block."
- :type 'integer
- :group 'perl)
+ :type 'integer)
;; Is is not unusual to put both things like perl-indent-level and
;; cperl-indent-level in the local variable section of a file. If only
@@ -511,45 +523,37 @@
(defcustom perl-continued-statement-offset 4
"Extra indent for lines not starting new statements."
- :type 'integer
- :group 'perl)
+ :type 'integer)
(defcustom perl-continued-brace-offset -4
"Extra indent for substatements that start with open-braces.
This is in addition to `perl-continued-statement-offset'."
- :type 'integer
- :group 'perl)
+ :type 'integer)
(defcustom perl-brace-offset 0
"Extra indentation for braces, compared with other text in same context."
- :type 'integer
- :group 'perl)
+ :type 'integer)
(defcustom perl-brace-imaginary-offset 0
"Imagined indentation of an open brace that actually follows a statement."
- :type 'integer
- :group 'perl)
+ :type 'integer)
(defcustom perl-label-offset -2
"Offset of Perl label lines relative to usual indentation."
- :type 'integer
- :group 'perl)
+ :type 'integer)
(defcustom perl-indent-continued-arguments nil
"If non-nil offset of argument lines relative to usual indentation.
If nil, continued arguments are aligned with the first argument."
- :type '(choice integer (const nil))
- :group 'perl)
+ :type '(choice integer (const nil)))
(defcustom perl-indent-parens-as-block nil
"Non-nil means that non-block ()-, {}- and []-groups are indented as blocks.
The closing bracket is aligned with the line of the opening bracket,
not the contents of the brackets."
:version "24.3"
- :type 'boolean
- :group 'perl)
+ :type 'boolean)
(defcustom perl-tab-always-indent tab-always-indent
"Non-nil means TAB in Perl mode always indents the current line.
Otherwise it inserts a tab character if you type it past the first
nonwhite character on the line."
- :type 'boolean
- :group 'perl)
+ :type 'boolean)
;; I changed the default to nil for consistency with general Emacs
;; conventions -- rms.
@@ -558,13 +562,12 @@ nonwhite character on the line."
For lines which don't need indenting, TAB either indents an
existing comment, moves to end-of-line, or if at end-of-line already,
create a new comment."
- :type 'boolean
- :group 'perl)
+ :type 'boolean)
-(defcustom perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"
+(defcustom perl-nochange "\f"
"Lines starting with this regular expression are not auto-indented."
:type 'regexp
- :group 'perl)
+ :options '(";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:[^:]"))
;; Outline support
@@ -685,7 +688,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
(define-obsolete-function-alias 'electric-perl-terminator
'perl-electric-terminator "22.1")
-(defun perl-electric-noindent-p (char)
+(defun perl-electric-noindent-p (_char)
(unless (eolp) 'no-indent))
(defun perl-electric-terminator (arg)
@@ -759,7 +762,7 @@ following list:
(bof (perl-beginning-of-function))
(delta (progn
(goto-char oldpnt)
- (perl-indent-line "\f\\|;?#" bof))))
+ (perl-indent-line "\f\\|;?#"))))
(and perl-tab-to-comment
(= oldpnt (point)) ; done if point moved
(if (listp delta) ; if line starts in a quoted string
@@ -797,24 +800,23 @@ following list:
(ding t)))))))))
(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4")
-(defun perl-indent-line (&optional nochange parse-start)
+(defun perl-indent-line (&optional nochange)
"Indent current line as Perl code.
Return the amount the indentation
changed by, or (parse-state) if line starts in a quoted string."
(let ((case-fold-search nil)
(pos (- (point-max) (point)))
- (bof (or parse-start (save-excursion (perl-beginning-of-function))))
beg indent shift-amt)
(beginning-of-line)
(setq beg (point))
(setq shift-amt
- (cond ((eq (char-after bof) ?=) 0)
- ((listp (setq indent (perl-calculate-indent bof))) indent)
+ (cond ((eq 1 (nth 7 (syntax-ppss))) 0) ;For doc sections!
+ ((listp (setq indent (perl-calculate-indent))) indent)
((eq 'noindent indent) indent)
((looking-at (or nochange perl-nochange)) 0)
(t
(skip-chars-forward " \t\f")
- (setq indent (perl-indent-new-calculate nil indent bof))
+ (setq indent (perl-indent-new-calculate nil indent))
(- indent (current-column)))))
(skip-chars-forward " \t\f")
(if (and (numberp shift-amt) (/= 0 shift-amt))
@@ -826,23 +828,21 @@ changed by, or (parse-state) if line starts in a quoted string."
(goto-char (- (point-max) pos)))
shift-amt))
-(defun perl-continuation-line-p (limit)
+(defun perl-continuation-line-p ()
"Move to end of previous line and return non-nil if continued."
;; Statement level. Is it a continuation or a new statement?
;; Find previous non-comment character.
(perl-backward-to-noncomment)
;; Back up over label lines, since they don't
;; affect whether our line is a continuation.
- (while (or (eq (preceding-char) ?\,)
- (and (eq (preceding-char) ?:)
- (memq (char-syntax (char-after (- (point) 2)))
- '(?w ?_))))
- (if (eq (preceding-char) ?\,)
- (perl-backward-to-start-of-continued-exp limit)
- (beginning-of-line))
+ (while (and (eq (preceding-char) ?:)
+ (memq (char-syntax (char-after (- (point) 2)))
+ '(?w ?_)))
+ (beginning-of-line)
(perl-backward-to-noncomment))
;; Now we get the answer.
- (not (memq (preceding-char) '(?\; ?\} ?\{))))
+ (unless (memq (preceding-char) '(?\; ?\} ?\{))
+ (preceding-char)))
(defun perl-hanging-paren-p ()
"Non-nil if we are right after a hanging parenthesis-like char."
@@ -850,170 +850,151 @@ changed by, or (parse-state) if line starts in a quoted string."
(save-excursion
(skip-syntax-backward " (") (not (bolp)))))
-(defun perl-indent-new-calculate (&optional virtual default parse-start)
+(defun perl-indent-new-calculate (&optional virtual default)
(or
(and virtual (save-excursion (skip-chars-backward " \t") (bolp))
(current-column))
(and (looking-at "\\(\\w\\|\\s_\\)+:[^:]")
- (max 1 (+ (or default (perl-calculate-indent parse-start))
+ (max 1 (+ (or default (perl-calculate-indent))
perl-label-offset)))
(and (= (char-syntax (following-char)) ?\))
(save-excursion
(forward-char 1)
- (forward-sexp -1)
- (perl-indent-new-calculate
- ;; Recalculate the parsing-start, since we may have jumped
- ;; dangerously close (typically in the case of nested functions).
- 'virtual nil (save-excursion (perl-beginning-of-function)))))
+ (when (condition-case nil (progn (forward-sexp -1) t)
+ (scan-error nil))
+ (perl-indent-new-calculate 'virtual))))
(and (and (= (following-char) ?{)
(save-excursion (forward-char) (perl-hanging-paren-p)))
- (+ (or default (perl-calculate-indent parse-start))
+ (+ (or default (perl-calculate-indent))
perl-brace-offset))
- (or default (perl-calculate-indent parse-start))))
+ (or default (perl-calculate-indent))))
-(defun perl-calculate-indent (&optional parse-start)
+(defun perl-calculate-indent ()
"Return appropriate indentation for current line as Perl code.
In usual case returns an integer: the column to indent to.
-Returns (parse-state) if line starts inside a string.
-Optional argument PARSE-START should be the position of `beginning-of-defun'."
+Returns (parse-state) if line starts inside a string."
(save-excursion
(let ((indent-point (point))
(case-fold-search nil)
(colon-line-end 0)
+ prev-char
state containing-sexp)
- (if parse-start ;used to avoid searching
- (goto-char parse-start)
- (perl-beginning-of-function))
- ;; We might be now looking at a local function that has nothing to
- ;; do with us because `indent-point' is past it. In this case
- ;; look further back up for another `perl-beginning-of-function'.
- (while (and (looking-at "{")
- (save-excursion
- (beginning-of-line)
- (looking-at "\\s-+sub\\>"))
- (> indent-point (save-excursion
- (condition-case nil
- (forward-sexp 1)
- (scan-error nil))
- (point))))
- (perl-beginning-of-function))
- (while (< (point) indent-point) ;repeat until right sexp
- (setq state (parse-partial-sexp (point) indent-point 0))
- ;; state = (depth_in_parens innermost_containing_list
- ;; last_complete_sexp string_terminator_or_nil inside_commentp
- ;; following_quotep minimum_paren-depth_this_scan)
- ;; Parsing stops if depth in parentheses becomes equal to third arg.
- (setq containing-sexp (nth 1 state)))
- (cond ((nth 3 state) 'noindent) ; In a quoted string?
- ((null containing-sexp) ; Line is at top level.
- (skip-chars-forward " \t\f")
- (if (memq (following-char)
- (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{)))
- 0 ; move to beginning of line if it starts a function body
- ;; indent a little if this is a continuation line
- (perl-backward-to-noncomment)
- (if (or (bobp)
- (memq (preceding-char) '(?\; ?\})))
- 0 perl-continued-statement-offset)))
- ((/= (char-after containing-sexp) ?{)
- ;; line is expression, not statement:
- ;; indent to just after the surrounding open.
- (goto-char (1+ containing-sexp))
- (if (perl-hanging-paren-p)
- ;; We're indenting an arg of a call like:
- ;; $a = foobarlongnamefun (
- ;; arg1
- ;; arg2
- ;; );
- (progn
- (skip-syntax-backward "(")
- (condition-case nil
- (while (save-excursion
- (skip-syntax-backward " ") (not (bolp)))
- (forward-sexp -1))
- (scan-error nil))
- (+ (current-column) perl-indent-level))
- (if perl-indent-continued-arguments
- (+ perl-indent-continued-arguments (current-indentation))
- (skip-chars-forward " \t")
- (current-column))))
- (t
- ;; Statement level. Is it a continuation or a new statement?
- (if (perl-continuation-line-p containing-sexp)
- ;; This line is continuation of preceding line's statement;
- ;; indent perl-continued-statement-offset more than the
- ;; previous line of the statement.
- (progn
- (perl-backward-to-start-of-continued-exp containing-sexp)
- (+ (if (save-excursion
- (perl-continuation-line-p containing-sexp))
- ;; If the continued line is itself a continuation
- ;; line, then align, otherwise add an offset.
- 0 perl-continued-statement-offset)
- (current-column)
- (if (save-excursion (goto-char indent-point)
- (looking-at
- (if perl-indent-parens-as-block
- "[ \t]*[{(\[]" "[ \t]*{")))
- perl-continued-brace-offset 0)))
- ;; This line starts a new statement.
- ;; Position at last unclosed open.
- (goto-char containing-sexp)
- (or
- ;; Is line first statement after an open-brace?
- ;; If no, find that first statement and indent like it.
- (save-excursion
- (forward-char 1)
- ;; Skip over comments and labels following openbrace.
- (while (progn
- (skip-chars-forward " \t\f\n")
- (cond ((looking-at ";?#")
- (forward-line 1) t)
- ((looking-at "\\(\\w\\|\\s_\\)+:[^:]")
- (setq colon-line-end (line-end-position))
- (search-forward ":")))))
- ;; The first following code counts
- ;; if it is before the line we want to indent.
- (and (< (point) indent-point)
- (if (> colon-line-end (point))
- (- (current-indentation) perl-label-offset)
- (current-column))))
- ;; If no previous statement,
- ;; indent it relative to line brace is on.
- ;; For open paren in column zero, don't let statement
- ;; start there too. If perl-indent-level is zero,
- ;; use perl-brace-offset + perl-continued-statement-offset
- ;; For open-braces not the first thing in a line,
- ;; add in perl-brace-imaginary-offset.
- (+ (if (and (bolp) (zerop perl-indent-level))
- (+ perl-brace-offset perl-continued-statement-offset)
- perl-indent-level)
- ;; Move back over whitespace before the openbrace.
- ;; If openbrace is not first nonwhite thing on the line,
- ;; add the perl-brace-imaginary-offset.
- (progn (skip-chars-backward " \t")
- (if (bolp) 0 perl-brace-imaginary-offset))
- ;; If the openbrace is preceded by a parenthesized exp,
- ;; move to the beginning of that;
- ;; possibly a different line
- (progn
- (if (eq (preceding-char) ?\))
- (forward-sexp -1))
- ;; Get initial indentation of the line we are on.
- (current-indentation))))))))))
+ (setq containing-sexp (nth 1 (syntax-ppss indent-point)))
+ (cond
+ ;; Don't auto-indent in a quoted string or a here-document.
+ ((or (nth 3 state) (eq 2 (nth 7 state))) 'noindent)
+ ((null containing-sexp) ; Line is at top level.
+ (skip-chars-forward " \t\f")
+ (if (memq (following-char)
+ (if perl-indent-parens-as-block '(?\{ ?\( ?\[) '(?\{)))
+ 0 ; move to beginning of line if it starts a function body
+ ;; indent a little if this is a continuation line
+ (perl-backward-to-noncomment)
+ (if (or (bobp)
+ (memq (preceding-char) '(?\; ?\})))
+ 0 perl-continued-statement-offset)))
+ ((/= (char-after containing-sexp) ?{)
+ ;; line is expression, not statement:
+ ;; indent to just after the surrounding open.
+ (goto-char (1+ containing-sexp))
+ (if (perl-hanging-paren-p)
+ ;; We're indenting an arg of a call like:
+ ;; $a = foobarlongnamefun (
+ ;; arg1
+ ;; arg2
+ ;; );
+ (progn
+ (skip-syntax-backward "(")
+ (condition-case nil
+ (while (save-excursion
+ (skip-syntax-backward " ") (not (bolp)))
+ (forward-sexp -1))
+ (scan-error nil))
+ (+ (current-column) perl-indent-level))
+ (if perl-indent-continued-arguments
+ (+ perl-indent-continued-arguments (current-indentation))
+ (skip-chars-forward " \t")
+ (current-column))))
+ ;; Statement level. Is it a continuation or a new statement?
+ ((setq prev-char (perl-continuation-line-p))
+ ;; This line is continuation of preceding line's statement;
+ ;; indent perl-continued-statement-offset more than the
+ ;; previous line of the statement.
+ (perl-backward-to-start-of-continued-exp)
+ (+ (if (or (save-excursion
+ (perl-continuation-line-p))
+ (and (eq prev-char ?\,)
+ (looking-at "[[:alnum:]_]+[ \t\n]*=>")))
+ ;; If the continued line is itself a continuation
+ ;; line, then align, otherwise add an offset.
+ 0 perl-continued-statement-offset)
+ (current-column)
+ (if (save-excursion (goto-char indent-point)
+ (looking-at
+ (if perl-indent-parens-as-block
+ "[ \t]*[{([]" "[ \t]*{")))
+ perl-continued-brace-offset 0)))
+ (t
+ ;; This line starts a new statement.
+ ;; Position at last unclosed open.
+ (goto-char containing-sexp)
+ (or
+ ;; Is line first statement after an open-brace?
+ ;; If no, find that first statement and indent like it.
+ (save-excursion
+ (forward-char 1)
+ ;; Skip over comments and labels following openbrace.
+ (while (progn
+ (skip-chars-forward " \t\f\n")
+ (cond ((looking-at ";?#")
+ (forward-line 1) t)
+ ((looking-at "\\(\\w\\|\\s_\\)+:[^:]")
+ (setq colon-line-end (line-end-position))
+ (search-forward ":")))))
+ ;; The first following code counts
+ ;; if it is before the line we want to indent.
+ (and (< (point) indent-point)
+ (if (> colon-line-end (point))
+ (- (current-indentation) perl-label-offset)
+ (current-column))))
+ ;; If no previous statement,
+ ;; indent it relative to line brace is on.
+ ;; For open paren in column zero, don't let statement
+ ;; start there too. If perl-indent-level is zero,
+ ;; use perl-brace-offset + perl-continued-statement-offset
+ ;; For open-braces not the first thing in a line,
+ ;; add in perl-brace-imaginary-offset.
+ (+ (if (and (bolp) (zerop perl-indent-level))
+ (+ perl-brace-offset perl-continued-statement-offset)
+ perl-indent-level)
+ ;; Move back over whitespace before the openbrace.
+ ;; If openbrace is not first nonwhite thing on the line,
+ ;; add the perl-brace-imaginary-offset.
+ (progn (skip-chars-backward " \t")
+ (if (bolp) 0 perl-brace-imaginary-offset))
+ ;; If the openbrace is preceded by a parenthesized exp,
+ ;; move to the beginning of that;
+ ;; possibly a different line
+ (progn
+ (if (eq (preceding-char) ?\))
+ (forward-sexp -1))
+ ;; Get initial indentation of the line we are on.
+ (current-indentation)))))))))
(defun perl-backward-to-noncomment ()
"Move point backward to after the first non-white-space, skipping comments."
- (interactive)
(forward-comment (- (point-max))))
-(defun perl-backward-to-start-of-continued-exp (lim)
- (if (= (preceding-char) ?\))
- (forward-sexp -1))
- (beginning-of-line)
- (if (<= (point) lim)
- (goto-char (1+ lim)))
- (skip-chars-forward " \t\f"))
+(defun perl-backward-to-start-of-continued-exp ()
+ (while
+ (let ((c (preceding-char)))
+ (cond
+ ((memq c '(?\; ?\{ ?\[ ?\()) (forward-comment (point-max)) nil)
+ ((memq c '(?\) ?\] ?\} ?\"))
+ (forward-sexp -1) (forward-comment (- (point))) t)
+ ((eq ?w (char-syntax c))
+ (forward-word -1) (forward-comment (- (point))) t)
+ (t (forward-char -1) (forward-comment (- (point))) t)))))
;; note: this may be slower than the c-mode version, but I can understand it.
(defalias 'indent-perl-exp 'perl-indent-exp)
@@ -1038,7 +1019,7 @@ Optional argument PARSE-START should be the position of `beginning-of-defun'."
(setq lsexp-mark bof-mark)
(beginning-of-line)
(while (< (point) (marker-position last-mark))
- (setq delta (perl-indent-line nil (marker-position bof-mark)))
+ (setq delta (perl-indent-line nil))
(if (numberp delta) ; unquoted start-of-line?
(progn
(if (eolp)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index b3ed328bd72..b459cbfd286 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -1,8 +1,8 @@
;;; prog-mode.el --- Generic major mode for programming -*- lexical-binding: t -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -29,18 +29,71 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-lib)
+ (require 'subr-x))
(defgroup prog-mode nil
"Generic programming mode, from which others derive."
:group 'languages)
+(defcustom prog-mode-hook nil
+ "Normal hook run when entering programming modes."
+ :type 'hook
+ :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode
+ prettify-symbols-mode)
+ :group 'prog-mode)
+
(defvar prog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?\C-\M-q] 'prog-indent-sexp)
map)
"Keymap used for programming modes.")
+(defvar prog-indentation-context nil
+ "Non-nil while indenting embedded code chunks.
+There are languages where part of the code is actually written in
+a sub language, e.g., a Yacc/Bison or ANTLR grammar also consists
+of plain C code. This variable enables the major mode of the
+main language to use the indentation engine of the sub mode for
+lines in code chunks written in the sub language.
+
+When a major mode of such a main language decides to delegate the
+indentation of a line/region to the indentation engine of the sub
+mode, it is supposed to bind this variable to non-nil around the call.
+
+The non-nil value looks as follows
+ (FIRST-COLUMN (START . END) PREVIOUS-CHUNKS)
+
+FIRST-COLUMN is the column the indentation engine of the sub mode
+should usually choose for top-level language constructs inside
+the code chunk (instead of 0).
+
+START to END is the region of the code chunk. See function
+`prog-widen' for additional info.
+
+PREVIOUS-CHUNKS, if non-nil, provides the indentation engine of
+the sub mode with the virtual context of the code chunk. Valid
+values are:
+
+ - A string containing code which the indentation engine can
+ consider as standing in front of the code chunk. To cache the
+ string's calculated syntactic information for repeated calls
+ with the same string, it is valid and expected for the inner
+ mode to add text-properties to the string.
+
+ A typical use case is for grammars with code chunks which are
+ to be indented like function bodies - the string would contain
+ a corresponding function header.
+
+ - A function called with the start position of the current
+ chunk. It will return either the region of the previous chunk
+ as (PREV-START . PREV-END) or nil if there is no further
+ previous chunk.
+
+ A typical use case are literate programming sources - the
+ function would successively return the code chunks of the
+ previous macro definitions for the same name.")
+
(defun prog-indent-sexp (&optional defun)
"Indent the expression after point.
When interactively called with prefix, indent the enclosing defun
@@ -54,30 +107,79 @@ instead."
(end (progn (forward-sexp 1) (point))))
(indent-region start end nil))))
+(defun prog-first-column ()
+ "Return the indentation column normally used for top-level constructs."
+ (or (car prog-indentation-context) 0))
+
+(defun prog-widen ()
+ "Remove restrictions (narrowing) from current code chunk or buffer.
+This function can be used instead of `widen' in any function used
+by the indentation engine to make it respect the value
+`prog-indentation-context'.
+
+This function (like `widen') is useful inside a
+`save-restriction' to make the indentation correctly work when
+narrowing is in effect."
+ (let ((chunk (cadr prog-indentation-context)))
+ (if chunk
+ ;; no widen necessary here, as narrow-to-region changes (not
+ ;; just narrows) existing restrictions
+ (narrow-to-region (car chunk) (or (cdr chunk) (point-max)))
+ (widen))))
+
+
(defvar-local prettify-symbols-alist nil
"Alist of symbol prettifications.
Each element looks like (SYMBOL . CHARACTER), where the symbol
matching SYMBOL (a string, not a regexp) will be shown as
-CHARACTER instead.")
+CHARACTER instead.
+
+CHARACTER can be a character or it can be a list or vector, in
+which case it will be used to compose the new symbol as per the
+third argument of `compose-region'.")
+
+(defun prettify-symbols-default-compose-p (start end _match)
+ "Return true iff the symbol MATCH should be composed.
+The symbol starts at position START and ends at position END.
+This is default `prettify-symbols-compose-predicate' which is
+suitable for most programming languages such as C or Lisp."
+ ;; Check that the chars should really be composed into a symbol.
+ (let* ((syntaxes-beg (if (memq (char-syntax (char-after start)) '(?w ?_))
+ '(?w ?_) '(?. ?\\)))
+ (syntaxes-end (if (memq (char-syntax (char-before end)) '(?w ?_))
+ '(?w ?_) '(?. ?\\))))
+ (not (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes-beg)
+ (memq (char-syntax (or (char-after end) ?\s)) syntaxes-end)
+ (nth 8 (syntax-ppss))))))
+
+(defvar-local prettify-symbols-compose-predicate
+ #'prettify-symbols-default-compose-p
+ "A predicate deciding if the currently matched symbol is to be composed.
+The matched symbol is the car of one entry in `prettify-symbols-alist'.
+The predicate receives the match's start and end position as well
+as the match-string as arguments.")
(defun prettify-symbols--compose-symbol (alist)
"Compose a sequence of characters into a symbol.
Regexp match data 0 points to the chars."
;; Check that the chars should really be composed into a symbol.
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (syntaxes (if (eq (char-syntax (char-after start)) ?w)
- '(?w) '(?. ?\\)))
- match)
- (if (or (memq (char-syntax (or (char-before start) ?\s)) syntaxes)
- (memq (char-syntax (or (char-after end) ?\s)) syntaxes)
- ;; syntax-ppss could modify the match data (bug#14595)
- (progn (setq match (match-string 0)) (nth 8 (syntax-ppss))))
- ;; No composition for you. Let's actually remove any composition
- ;; we may have added earlier and which is now incorrect.
- (remove-text-properties start end '(composition))
- ;; That's a symbol alright, so add the composition.
- (compose-region start end (cdr (assoc match alist)))))
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (match (match-string 0)))
+ (if (and (not (equal prettify-symbols--current-symbol-bounds (list start end)))
+ (funcall prettify-symbols-compose-predicate start end match))
+ ;; That's a symbol alright, so add the composition.
+ (with-silent-modifications
+ (compose-region start end (cdr (assoc match alist)))
+ (add-text-properties
+ start end
+ `(prettify-symbols-start ,start prettify-symbols-end ,end)))
+ ;; No composition for you. Let's actually remove any
+ ;; composition we may have added earlier and which is now
+ ;; incorrect.
+ (remove-text-properties start end '(composition
+ prettify-symbols-start
+ prettify-symbols-end))))
;; Return nil because we're not adding any face property.
nil)
@@ -89,6 +191,46 @@ Regexp match data 0 points to the chars."
(defvar-local prettify-symbols--keywords nil)
+(defvar-local prettify-symbols--current-symbol-bounds nil)
+
+(defcustom prettify-symbols-unprettify-at-point nil
+ "If non-nil, show the non-prettified version of a symbol when point is on it.
+If set to the symbol `right-edge', also unprettify if point
+is immediately after the symbol. The prettification will be
+reapplied as soon as point moves away from the symbol. If
+set to nil, the prettification persists even when point is
+on the symbol."
+ :type '(choice (const :tag "Never unprettify" nil)
+ (const :tag "Unprettify when point is inside" t)
+ (const :tag "Unprettify when point is inside or at right edge" right-edge))
+ :group 'prog-mode)
+
+(defun prettify-symbols--post-command-hook ()
+ (cl-labels ((get-prop-as-list
+ (prop)
+ (remove nil
+ (list (get-text-property (point) prop)
+ (when (and (eq prettify-symbols-unprettify-at-point 'right-edge)
+ (not (bobp)))
+ (get-text-property (1- (point)) prop))))))
+ ;; Re-apply prettification to the previous symbol.
+ (when (and prettify-symbols--current-symbol-bounds
+ (or (< (point) (car prettify-symbols--current-symbol-bounds))
+ (> (point) (cadr prettify-symbols--current-symbol-bounds))
+ (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
+ (= (point) (cadr prettify-symbols--current-symbol-bounds)))))
+ (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
+ (setq prettify-symbols--current-symbol-bounds nil))
+ ;; Unprettify the current symbol.
+ (when-let ((c (get-prop-as-list 'composition))
+ (s (get-prop-as-list 'prettify-symbols-start))
+ (e (get-prop-as-list 'prettify-symbols-end))
+ (s (apply #'min s))
+ (e (apply #'max e)))
+ (with-silent-modifications
+ (setq prettify-symbols--current-symbol-bounds (list s e))
+ (remove-text-properties s e '(composition))))))
+
;;;###autoload
(define-minor-mode prettify-symbols-mode
"Toggle Prettify Symbols mode.
@@ -102,9 +244,9 @@ in `prettify-symbols-alist' (which see), which are locally defined
by major modes supporting prettifying. To add further customizations
for a given major mode, you can modify `prettify-symbols-alist' thus:
- (add-hook 'emacs-lisp-mode-hook
+ (add-hook \\='emacs-lisp-mode-hook
(lambda ()
- (push '(\"<=\" . ?≤) prettify-symbols-alist)))
+ (push \\='(\"<=\" . ?≤) prettify-symbols-alist)))
You can enable this mode locally in desired buffers, or use
`global-prettify-symbols-mode' to enable it for all modes that
@@ -115,9 +257,16 @@ support it."
(when (setq prettify-symbols--keywords (prettify-symbols--make-keywords))
(font-lock-add-keywords nil prettify-symbols--keywords)
(setq-local font-lock-extra-managed-props
- (cons 'composition font-lock-extra-managed-props))
- (font-lock-fontify-buffer))
+ (append font-lock-extra-managed-props
+ '(composition
+ prettify-symbols-start
+ prettify-symbols-end)))
+ (when prettify-symbols-unprettify-at-point
+ (add-hook 'post-command-hook
+ #'prettify-symbols--post-command-hook nil t))
+ (font-lock-flush))
;; Turn off
+ (remove-hook 'post-command-hook #'prettify-symbols--post-command-hook t)
(when prettify-symbols--keywords
(font-lock-remove-keywords nil prettify-symbols--keywords)
(setq prettify-symbols--keywords nil))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
new file mode 100644
index 00000000000..186840ae29b
--- /dev/null
+++ b/lisp/progmodes/project.el
@@ -0,0 +1,176 @@
+;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains generic infrastructure for dealing with
+;; projects, and a number of public functions: finding the current
+;; root, related project directories, search path, etc.
+;;
+;; The goal is to make it easy for Lisp programs to operate on the
+;; current project, without having to know which package handles
+;; detection of that project type, parsing its config files, etc.
+
+;;; Code:
+
+(require 'cl-generic)
+
+(defvar project-find-functions (list #'project-try-vc
+ #'project-ask-user)
+ "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.")
+
+(declare-function etags-search-path "etags" ())
+
+(defvar project-search-path-function #'etags-search-path
+ "Function that returns a list of source root directories.
+
+The directories in which we can recursively look for the
+declarations or other references to the symbols used in the
+current buffer. Depending on the language, it should include the
+headers search path, load path, class path, or so on.
+
+The directory names should be absolute. This variable is
+normally set by the major mode. Used in the default
+implementation of `project-search-path'.")
+
+;;;###autoload
+(defun project-current (&optional dir)
+ "Return the project instance in DIR or `default-directory'."
+ (unless dir (setq dir default-directory))
+ (run-hook-with-args-until-success 'project-find-functions dir))
+
+;; FIXME: Add MODE argument, like in `ede-source-paths'?
+(cl-defgeneric project-search-path (project)
+ "Return the list of source root directories.
+Any directory roots where source (or header, etc) files used by
+the current project may be found, inside or outside of the
+current project tree(s). The directory names should be absolute.
+
+Unless it really knows better, a specialized implementation
+should take into account the value returned by
+`project-search-path-function' and call
+`project-prune-directories' on the result."
+ (project-prune-directories
+ (append
+ ;; We don't know the project layout, like where the sources are,
+ ;; so we simply include the roots.
+ (project-roots project)
+ (funcall project-search-path-function))))
+
+(cl-defgeneric project-roots (project)
+ "Return the list of directory roots related to the current project.
+It should include the current project root, as well as the roots
+of any other currently open projects, if they're meant to be
+edited together. The directory names should be absolute.")
+
+(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 either one of `project-roots', or
+an element of `project-search-path'."
+ (require 'grep)
+ (defvar grep-find-ignored-files)
+ (nconc
+ (mapcar
+ (lambda (dir)
+ (concat dir "/"))
+ vc-directory-exclusion-list)
+ grep-find-ignored-files))
+
+(defgroup project-vc nil
+ "Project implementation using the VC package."
+ :group 'tools)
+
+(defcustom project-vc-search-path nil
+ "List ot directories to include in `project-search-path'.
+The file names can be absolute, or relative to the project root."
+ :type '(repeat file)
+ :safe 'listp)
+
+(defcustom project-vc-ignores nil
+ "List ot patterns to include in `project-ignores'."
+ :type '(repeat string)
+ :safe 'listp)
+
+(defun project-try-vc (dir)
+ (let* ((backend (ignore-errors (vc-responsible-backend dir)))
+ (root (and backend (ignore-errors
+ (vc-call-backend backend 'root dir)))))
+ (and root (cons 'vc root))))
+
+(cl-defmethod project-roots ((project (head vc)))
+ (list (cdr project)))
+
+(cl-defmethod project-search-path ((project (head vc)))
+ (append
+ (let ((root (cdr project)))
+ (mapcar
+ (lambda (dir) (expand-file-name dir root))
+ (project--value-in-dir 'project-vc-search-path root)))
+ (cl-call-next-method)))
+
+(cl-defmethod project-ignores ((project (head vc)) dir)
+ (let* ((root (cdr project))
+ backend)
+ (append
+ (when (file-equal-p dir root)
+ (setq backend (vc-responsible-backend root))
+ (mapcar
+ (lambda (entry)
+ (if (string-match "\\`/" entry)
+ (replace-match "./" t t entry)
+ entry))
+ (vc-call-backend backend 'ignore-completion-table root)))
+ (project--value-in-dir 'project-vc-ignores root)
+ (cl-call-next-method))))
+
+(defun project-ask-user (dir)
+ (cons 'user (read-directory-name "Project root: " dir nil t)))
+
+(cl-defmethod project-roots ((project (head user)))
+ (list (cdr project)))
+
+(defun project-prune-directories (dirs)
+ "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
+ (let* ((dirs (sort
+ (mapcar
+ (lambda (dir)
+ (file-name-as-directory (expand-file-name dir)))
+ dirs)
+ #'string<))
+ (ref dirs))
+ ;; Delete subdirectories from the list.
+ (while (cdr ref)
+ (if (string-prefix-p (car ref) (cadr ref))
+ (setcdr ref (cddr ref))
+ (setq ref (cdr ref))))
+ (cl-delete-if-not #'file-exists-p dirs)))
+
+(defun project--value-in-dir (var dir)
+ (with-temp-buffer
+ (setq default-directory dir)
+ (hack-dir-local-variables-non-file-buffer)
+ (symbol-value var)))
+
+(provide 'project)
+;;; project.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 0f3c1504ee9..61d3a3c638b 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1,6 +1,6 @@
-;;; prolog.el --- major mode for Prolog (and Mercury) -*- coding: utf-8 -*-
+;;; prolog.el --- major mode for Prolog (and Mercury) -*- lexical-binding:t -*-
-;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2013 Free
+;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2015 Free
;; Software Foundation, Inc.
;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com>
@@ -376,29 +376,8 @@ The version numbers are of the format (Major . Minor)."
:group 'prolog-indentation
:type 'integer)
-(defcustom prolog-align-comments-flag t
- "Non-nil means automatically align comments when indenting."
- :version "24.1"
- :group 'prolog-indentation
- :type 'boolean)
-
-(defcustom prolog-indent-mline-comments-flag t
- "Non-nil means indent contents of /* */ comments.
-Otherwise leave such lines as they are."
- :version "24.1"
- :group 'prolog-indentation
- :type 'boolean)
-
-(defcustom prolog-object-end-to-0-flag t
- "Non-nil means indent closing '}' in SICStus object definitions to level 0.
-Otherwise indent to `prolog-indent-width'."
- :version "24.1"
- :group 'prolog-indentation
- :type 'boolean)
-
(defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)"
- "Regexp for character sequences after which next line is indented.
-Next line after such a regexp is indented to the opening parenthesis level."
+ "Regexp for `prolog-electric-if-then-else-flag'."
:version "24.1"
:group 'prolog-indentation
:type 'regexp)
@@ -423,11 +402,11 @@ Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
(defcustom prolog-parse-mode 'beg-of-clause
"The parse mode used (decides from which point parsing is done).
Legal values:
-'beg-of-line - starts parsing at the beginning of a line, unless the
- previous line ends with a backslash. Fast, but has
- problems detecting multiline /* */ comments.
-'beg-of-clause - starts parsing at the beginning of the current clause.
- Slow, but copes better with /* */ comments."
+`beg-of-line' - starts parsing at the beginning of a line, unless the
+ previous line ends with a backslash. Fast, but has
+ problems detecting multiline /* */ comments.
+`beg-of-clause' - starts parsing at the beginning of the current clause.
+ Slow, but copes better with /* */ comments."
:version "24.1"
:group 'prolog-indentation
:type '(choice (const :value beg-of-line)
@@ -503,12 +482,6 @@ Legal values:
;; Keyboard
-(defcustom prolog-electric-newline-flag (not (fboundp 'electric-indent-mode))
- "Non-nil means automatically indent the next line when the user types RET."
- :version "24.1"
- :group 'prolog-keyboard
- :type 'boolean)
-
(defcustom prolog-hungry-delete-key-flag nil
"Non-nil means delete key consumes all preceding spaces."
:version "24.1"
@@ -545,14 +518,6 @@ If underscore is pressed not on a variable then it behaves as usual."
:group 'prolog-keyboard
:type 'boolean)
-(defcustom prolog-electric-tab-flag nil
- "Non-nil means make TAB key electric.
-Electric TAB inserts spaces after parentheses, ->, and ;
-in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
- :version "24.1"
- :group 'prolog-keyboard
- :type 'boolean)
-
(defcustom prolog-electric-if-then-else-flag nil
"Non-nil makes `(', `>' and `;' electric
to automatically indent if-then-else constructs."
@@ -739,14 +704,6 @@ is non-nil for this variable."
;; Miscellaneous
-(defcustom prolog-use-prolog-tokenizer-flag
- (not (fboundp 'syntax-propertize-rules))
- "Non-nil means use the internal prolog tokenizer for indentation etc.
-Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect."
- :version "24.1"
- :group 'prolog-other
- :type 'boolean)
-
(defcustom prolog-imenu-flag t
"Non-nil means add a clause index menu for all prolog files."
:version "24.1"
@@ -831,117 +788,12 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(modify-syntax-entry ?/ ". 14" table)
)
table))
-(defvar prolog-mode-abbrev-table nil)
-
-(if (eval-when-compile
- (and (string-match "[[:upper:]]" "A")
- (with-temp-buffer
- (insert "A") (skip-chars-backward "[:upper:]") (bolp))))
- (progn
- (defconst prolog-upper-case-string "[:upper:]"
- "A string containing a char-range matching all upper case characters.")
- (defconst prolog-lower-case-string "[:lower:]"
- "A string containing a char-range matching all lower case characters."))
-
- ;; GNU Emacs compatibility: GNU Emacs does not differentiate between
- ;; ints and chars, or at least these two are interchangeable.
- (defalias 'prolog-int-to-char
- (if (fboundp 'int-to-char) #'int-to-char #'identity))
-
- (defalias 'prolog-char-to-int
- (if (fboundp 'char-to-int) #'char-to-int #'identity))
-
- (defun prolog-ints-intervals (ints)
- "Return a list of intervals (from . to) covering INTS."
- (when ints
- (setq ints (sort ints '<))
- (let ((prev (car ints))
- (interval-start (car ints))
- intervals)
- (while ints
- (let ((next (car ints)))
- (when (> next (1+ prev)) ; start of new interval
- (setq intervals (cons (cons interval-start prev) intervals))
- (setq interval-start next))
- (setq prev next)
- (setq ints (cdr ints))))
- (setq intervals (cons (cons interval-start prev) intervals))
- (reverse intervals))))
-
- (defun prolog-dash-letters (string)
- "Return a condensed regexp covering all letters in STRING."
- (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
- (string-to-list string))))
- codes)
- (while intervals
- (let* ((i (car intervals))
- (from (car i))
- (to (cdr i))
- (c (cond ((= from to) `(,from))
- ((= (1+ from) to) `(,from ,to))
- (t `(,from ?- ,to)))))
- (setq codes (cons c codes)))
- (setq intervals (cdr intervals)))
- (apply 'concat (reverse codes))))
-
- (let ((up_string "")
- (low_string ""))
- ;; Use `map-char-table' if it is defined. Otherwise enumerate all
- ;; numbers between 0 and 255. `map-char-table' is probably safer.
- ;;
- ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
- ;; while loop seems to do its job well (Ryszard Szopa)
- ;;
- ;;(if (and (not (featurep 'xemacs))
- ;; (fboundp 'map-char-table))
- ;; (map-char-table
- ;; (lambda (key value)
- ;; (cond
- ;; ((and
- ;; (eq (prolog-int-to-char key) (downcase key))
- ;; (eq (prolog-int-to-char key) (upcase key)))
- ;; ;; Do nothing if upper and lower case are the same
- ;; )
- ;; ((eq (prolog-int-to-char key) (downcase key))
- ;; ;; The char is lower case
- ;; (setq low_string (format "%s%c" low_string key)))
- ;; ((eq (prolog-int-to-char key) (upcase key))
- ;; ;; The char is upper case
- ;; (setq up_string (format "%s%c" up_string key)))
- ;; ))
- ;; (current-case-table))
- ;; `map-char-table' was undefined.
- (let ((key 0))
- (while (< key 256)
- (cond
- ((and
- (eq (prolog-int-to-char key) (downcase key))
- (eq (prolog-int-to-char key) (upcase key)))
- ;; Do nothing if upper and lower case are the same
- )
- ((eq (prolog-int-to-char key) (downcase key))
- ;; The char is lower case
- (setq low_string (format "%s%c" low_string key)))
- ((eq (prolog-int-to-char key) (upcase key))
- ;; The char is upper case
- (setq up_string (format "%s%c" up_string key)))
- )
- (setq key (1+ key))))
- ;; )
- ;; The strings are single-byte strings.
- (defconst prolog-upper-case-string (prolog-dash-letters up_string)
- "A string containing a char-range matching all upper case characters.")
- (defconst prolog-lower-case-string (prolog-dash-letters low_string)
- "A string containing a char-range matching all lower case characters.")
- ))
(defconst prolog-atom-char-regexp
- (if (string-match "[[:alnum:]]" "0")
- "[[:alnum:]_$]"
- (format "[%s%s0-9_$]" prolog-lower-case-string prolog-upper-case-string))
+ "[[:alnum:]_$]"
"Regexp specifying characters which constitute atoms without quoting.")
(defconst prolog-atom-regexp
- (format "[%s$]%s*" prolog-lower-case-string prolog-atom-char-regexp))
+ (format "[[:lower:]$]%s*" prolog-atom-char-regexp))
(defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(?
"The characters used as left parentheses for the indentation code.")
@@ -988,7 +840,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(require 'smie)
-(defvar prolog-use-smie t)
+(defconst prolog-operator-chars "-\\\\#&*+./:<=>?@\\^`~")
(defun prolog-smie-forward-token ()
;; FIXME: Add support for 0'<char>, if needed after adding it to
@@ -998,7 +850,7 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(point)
(progn (cond
((looking-at "[!;]") (forward-char 1))
- ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-chars-forward prolog-operator-chars))))
((not (zerop (skip-syntax-forward "w_'"))))
;; In case of non-ASCII punctuation.
((not (zerop (skip-syntax-forward ".")))))
@@ -1011,8 +863,8 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(buffer-substring-no-properties
(point)
(progn (cond
- ((memq (char-before) '(?! ?\;)) (forward-char -1))
- ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
+ ((memq (char-before) '(?! ?\; ?\,)) (forward-char -1))
+ ((not (zerop (skip-chars-backward prolog-operator-chars))))
((not (zerop (skip-syntax-backward "w_'"))))
;; In case of non-ASCII punctuation.
((not (zerop (skip-syntax-backward ".")))))
@@ -1025,12 +877,21 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
;; manual uses precedence levels in the opposite sense (higher
;; numbers bind less tightly) than SMIE, so we use negative numbers.
'(("." -10000 -10000)
+ ("?-" nil -1200)
(":-" -1200 -1200)
("-->" -1200 -1200)
+ ("discontiguous" nil -1150)
+ ("dynamic" nil -1150)
+ ("meta_predicate" nil -1150)
+ ("module_transparent" nil -1150)
+ ("multifile" nil -1150)
+ ("public" nil -1150)
+ ("|" -1105 -1105)
(";" -1100 -1100)
+ ("*->" -1050 -1050)
("->" -1050 -1050)
("," -1000 -1000)
- ("\\+" -900 -900)
+ ("\\+" nil -900)
("=" -700 -700)
("\\=" -700 -700)
("=.." -700 -700)
@@ -1072,8 +933,71 @@ This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
(defun prolog-smie-rules (kind token)
(pcase (cons kind token)
(`(:elem . basic) prolog-indent-width)
+ ;; The list of arguments can never be on a separate line!
+ (`(:list-intro . ,_) t)
+ ;; When we don't know how to indent an empty line, assume the most
+ ;; likely token will be ";".
+ (`(:elem . empty-line-token) ";")
(`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist.
- (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width)))
+ ;; Allow indentation of if-then-else as:
+ ;; ( test
+ ;; -> thenrule
+ ;; ; elserule
+ ;; )
+ (`(:before . ,(or `"->" `";"))
+ (and (smie-rule-bolp) (smie-rule-parent-p "(") (smie-rule-parent 0)))
+ (`(:after . ,(or `"->" `"*->"))
+ ;; We distinguish
+ ;;
+ ;; (a ->
+ ;; b;
+ ;; c)
+ ;; and
+ ;; ( a ->
+ ;; b
+ ;; ; c)
+ ;;
+ ;; based on the space between the open paren and the "a".
+ (unless (and (smie-rule-parent-p "(" ";")
+ (save-excursion
+ (smie-indent-forward-token)
+ (smie-backward-sexp 'halfsexp)
+ (if (smie-rule-parent-p "(")
+ (not (eq (char-before) ?\())
+ (smie-indent-backward-token)
+ (smie-rule-bolp))))
+ prolog-indent-width))
+ (`(:after . ";")
+ ;; Align with same-line comment as in:
+ ;; ; %% Toto
+ ;; foo
+ (and (smie-rule-bolp)
+ (looking-at ";[ \t]*\\(%\\)")
+ (let ((offset (- (save-excursion (goto-char (match-beginning 1))
+ (current-column))
+ (current-column))))
+ ;; Only do it for small offsets, since the comment may actually be
+ ;; an "end-of-line" comment at comment-column!
+ (if (<= offset prolog-indent-width) offset))))
+ (`(:after . ",")
+ ;; Special indent for:
+ ;; foopredicate(x) :- !,
+ ;; toto.
+ (and (eq (char-before) ?!)
+ (save-excursion
+ (smie-indent-backward-token) ;Skip !
+ (equal ":-" (car (smie-indent-backward-token))))
+ (smie-rule-parent prolog-indent-width)))
+ (`(:after . ":-")
+ (if (bolp)
+ (save-excursion
+ (smie-indent-forward-token)
+ (skip-chars-forward " \t")
+ (if (eolp)
+ prolog-indent-width
+ (min prolog-indent-width (current-column))))
+ prolog-indent-width))
+ (`(:after . "-->") prolog-indent-width)))
;;-------------------------------------------------------------------
@@ -1140,17 +1064,16 @@ VERSION is of the format (Major . Minor)"
(defun prolog-mode-variables ()
"Set some common variables to Prolog code specific values."
- (setq local-abbrev-table prolog-mode-abbrev-table)
- (set (make-local-variable 'paragraph-start)
- (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill)
- (set (make-local-variable 'comment-start) "%")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-add) 1)
- (set (make-local-variable 'comment-start-skip) "\\(?:/\\*+ *\\|%%+ *\\)")
- (set (make-local-variable 'parens-require-spaces) nil)
+ (setq-local local-abbrev-table prolog-mode-abbrev-table)
+ (setq-local paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t)
+ (setq-local normal-auto-fill-function 'prolog-do-auto-fill)
+ (setq-local comment-start "%")
+ (setq-local comment-end "")
+ (setq-local comment-add 1)
+ (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
+ (setq-local parens-require-spaces nil)
;; Initialize Prolog system specific variables
(dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
prolog-determinism-specificators prolog-directives
@@ -1160,19 +1083,14 @@ VERSION is of the format (Major . Minor)"
(set (intern (concat (symbol-name var) "-i"))
(prolog-find-value-by-system (symbol-value var))))
(when (null (prolog-program-name))
- (set (make-local-variable 'compile-command) (prolog-compile-string)))
- (set (make-local-variable 'font-lock-defaults)
- '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
- (set (make-local-variable 'syntax-propertize-function)
- prolog-syntax-propertize-function)
-
- (if prolog-use-smie
- ;; Setup SMIE.
- (smie-setup prolog-smie-grammar #'prolog-smie-rules
- :forward-token #'prolog-smie-forward-token
- :backward-token #'prolog-smie-backward-token)
- (set (make-local-variable 'indent-line-function) 'prolog-indent-line))
- )
+ (setq-local compile-command (prolog-compile-string)))
+ (setq-local font-lock-defaults
+ '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local syntax-propertize-function prolog-syntax-propertize-function)
+
+ (smie-setup prolog-smie-grammar #'prolog-smie-rules
+ :forward-token #'prolog-smie-forward-token
+ :backward-token #'prolog-smie-backward-token))
(defun prolog-mode-keybindings-common (map)
"Define keybindings common to both Prolog modes in MAP."
@@ -1193,25 +1111,12 @@ VERSION is of the format (Major . Minor)"
(define-key map "\C-\M-e" 'prolog-end-of-predicate)
(define-key map "\M-\C-c" 'prolog-mark-clause)
(define-key map "\M-\C-h" 'prolog-mark-predicate)
- (define-key map "\M-\C-n" 'prolog-forward-list)
- (define-key map "\M-\C-p" 'prolog-backward-list)
(define-key map "\C-c\C-n" 'prolog-insert-predicate-template)
(define-key map "\C-c\C-s" 'prolog-insert-predspec)
(define-key map "\M-\r" 'prolog-insert-next-clause)
(define-key map "\C-c\C-va" 'prolog-variables-to-anonymous)
(define-key map "\C-c\C-v\C-s" 'prolog-view-predspec)
- (define-key map [Backspace] 'prolog-electric-delete)
- (define-key map "." 'prolog-electric-dot)
- (define-key map "_" 'prolog-electric-underscore)
- (define-key map "(" 'prolog-electric-if-then-else)
- (define-key map ";" 'prolog-electric-if-then-else)
- (define-key map ">" 'prolog-electric-if-then-else)
- (define-key map ":" 'prolog-electric-colon)
- (define-key map "-" 'prolog-electric-dash)
- (if prolog-electric-newline-flag
- (define-key map "\r" 'newline-and-indent))
-
;; If we're running SICStus, then map C-c C-c e/d to enabling
;; and disabling of the source-level debugging facilities.
;(if (and (eq prolog-system 'sicstus)
@@ -1241,7 +1146,7 @@ VERSION is of the format (Major . Minor)"
;; Inherited from the old prolog.el.
(define-key map "\e\C-x" 'prolog-consult-region)
(define-key map "\C-c\C-l" 'prolog-consult-file)
- (define-key map "\C-c\C-z" 'switch-to-prolog))
+ (define-key map "\C-c\C-z" 'run-prolog))
(defun prolog-mode-keybindings-inferior (_map)
"Define keybindings for inferior Prolog mode in MAP."
@@ -1258,8 +1163,6 @@ VERSION is of the format (Major . Minor)"
(defvar prolog-mode-hook nil
"List of functions to call after the prolog mode has initialized.")
-(unless (fboundp 'prog-mode)
- (defalias 'prog-mode 'fundamental-mode))
;;;###autoload
(define-derived-mode prolog-mode prog-mode "Prolog"
"Major mode for editing Prolog code.
@@ -1273,9 +1176,7 @@ To find out what version of Prolog mode you are running, enter
`\\[prolog-mode-version]'.
Commands:
-\\{prolog-mode-map}
-Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil."
+\\{prolog-mode-map}"
(setq mode-name (concat "Prolog"
(cond
((eq prolog-system 'eclipse) "[ECLiPSe]")
@@ -1285,8 +1186,11 @@ if that value is non-nil."
(t ""))))
(prolog-mode-variables)
(dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
-
+ (add-hook 'post-self-insert-hook #'prolog-post-self-insert nil t)
;; `imenu' entry moved to the appropriate hook for consistency.
+ (when prolog-electric-dot-flag
+ (setq-local electric-indent-chars
+ (cons ?\. electric-indent-chars)))
;; Load SICStus debugger if suitable
(if (and (eq prolog-system 'sicstus)
@@ -1305,7 +1209,7 @@ if that value is non-nil."
(define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
"Major mode for editing Mercury programs.
Actually this is just customized `prolog-mode'."
- (set (make-local-variable 'prolog-system) 'mercury))
+ (setq-local prolog-system 'mercury))
;;-------------------------------------------------------------------
@@ -1375,7 +1279,7 @@ using the commands `send-region', `send-string' and \\[prolog-consult-region].
Commands:
Tab indents for Prolog; with argument, shifts rest
of expression rigidly with the current line.
-Paragraphs are separated only by blank lines and '%%'. '%'s start comments.
+Paragraphs are separated only by blank lines and `%%'. `%'s start comments.
Return at end of buffer sends line as input.
Return not at end copies rest of line to end and sends it.
@@ -1393,9 +1297,9 @@ To find out what version of Prolog mode you are running, enter
(setq mode-line-process '(": %s"))
(prolog-mode-variables)
(setq comint-prompt-regexp (prolog-prompt-regexp))
- (set (make-local-variable 'shell-dirstack-query) "pwd.")
- (set (make-local-variable 'compilation-error-regexp-alist)
- prolog-inferior-error-regexp-alist)
+ (setq-local shell-dirstack-query "pwd.")
+ (setq-local compilation-error-regexp-alist
+ prolog-inferior-error-regexp-alist)
(compilation-shell-minor-mode)
(prolog-inferior-menu))
@@ -1406,6 +1310,8 @@ To find out what version of Prolog mode you are running, enter
((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
(t t)))
+;; This statement was missing in Emacs 24.1, 24.2, 24.3.
+(define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1")
;;;###autoload
(defun run-prolog (arg)
"Run an inferior Prolog process, input and output via buffer *prolog*.
@@ -1430,22 +1336,22 @@ With prefix argument ARG, restart the Prolog process if running before."
))
(defun prolog-inferior-guess-flavor (&optional ignored)
- (setq prolog-system
- (when (or (numberp prolog-system) (markerp prolog-system))
- (save-excursion
- (goto-char (1+ prolog-system))
- (cond
- ((looking-at "GNU Prolog") 'gnu)
- ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
- ((looking-at ".*\n") nil) ;There's at least one line.
- (t prolog-system)))))
+ (setq-local prolog-system
+ (when (or (numberp prolog-system) (markerp prolog-system))
+ (save-excursion
+ (goto-char (1+ prolog-system))
+ (cond
+ ((looking-at "GNU Prolog") 'gnu)
+ ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
+ ((looking-at ".*\n") nil) ;There's at least one line.
+ (t prolog-system)))))
(when (symbolp prolog-system)
(remove-hook 'comint-output-filter-functions
'prolog-inferior-guess-flavor t)
(when prolog-system
(setq comint-prompt-regexp (prolog-prompt-regexp))
(if (eq prolog-system 'gnu)
- (set (make-local-variable 'comint-process-echoes) t)))))
+ (setq-local comint-process-echoes t)))))
(defun prolog-ensure-process (&optional wait)
"If Prolog process is not running, run it.
@@ -1461,21 +1367,22 @@ the variable `prolog-prompt-regexp'."
(prolog-program-name) nil (prolog-program-switches))
(unless prolog-system
;; Setup auto-detection.
- (set (make-local-variable 'prolog-system)
- ;; Force re-detection.
- (let* ((proc (get-buffer-process (current-buffer)))
- (pmark (and proc (marker-position (process-mark proc)))))
- (cond
- ((null pmark) (1- (point-min)))
- ;; The use of insert-before-markers in comint.el together with
- ;; the potential use of comint-truncate-buffer in the output
- ;; filter, means that it's difficult to reliably keep track of
- ;; the buffer position where the process's output started.
- ;; If possible we use a marker at "start - 1", so that
- ;; insert-before-marker at `start' won't shift it. And if not,
- ;; we fall back on using a plain integer.
- ((> pmark (point-min)) (copy-marker (1- pmark)))
- (t (1- pmark)))))
+ (setq-local
+ prolog-system
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
(add-hook 'comint-output-filter-functions
'prolog-inferior-guess-flavor nil t))
(if wait
@@ -1742,16 +1649,16 @@ This function must be called from the source code buffer."
(compilation-mode)
;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el.
;; Setting up font-locking for this buffer
- (set (make-local-variable 'font-lock-defaults)
- '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
+ (setq-local font-lock-defaults
+ '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(if (eq prolog-system 'sicstus)
;; FIXME: This looks really problematic: not only is this using
;; the old compilation-parse-errors-function, but
;; prolog-parse-sicstus-compilation-errors only accepts one argument
;; whereas compile.el calls it with 2 (and did so at least since
;; Emacs-20).
- (set (make-local-variable 'compilation-parse-errors-function)
- 'prolog-parse-sicstus-compilation-errors))
+ (setq-local compilation-parse-errors-function
+ 'prolog-parse-sicstus-compilation-errors))
(setq buffer-read-only nil)
(insert command-string "\n"))
(display-buffer buffer)
@@ -1978,669 +1885,282 @@ Argument BOUND is a buffer position limiting searching."
;; Set everything up
(defun prolog-font-lock-keywords ()
"Set up font lock keywords for the current Prolog system."
- ;(when window-system
- (require 'font-lock)
-
- ;; Define Prolog faces
- (defface prolog-redo-face
- '((((class grayscale)) (:italic t))
- (((class color)) (:foreground "darkorchid"))
- (t (:italic t)))
- "Prolog mode face for highlighting redo trace lines."
- :group 'prolog-faces)
- (defface prolog-exit-face
- '((((class grayscale)) (:underline t))
- (((class color) (background dark)) (:foreground "green"))
- (((class color) (background light)) (:foreground "ForestGreen"))
- (t (:underline t)))
- "Prolog mode face for highlighting exit trace lines."
- :group 'prolog-faces)
- (defface prolog-exception-face
- '((((class grayscale)) (:bold t :italic t :underline t))
- (((class color)) (:bold t :foreground "black" :background "Khaki"))
- (t (:bold t :italic t :underline t)))
- "Prolog mode face for highlighting exception trace lines."
- :group 'prolog-faces)
- (defface prolog-warning-face
- '((((class grayscale)) (:underline t))
- (((class color) (background dark)) (:foreground "blue"))
- (((class color) (background light)) (:foreground "MidnightBlue"))
- (t (:underline t)))
- "Face name to use for compiler warnings."
- :group 'prolog-faces)
- (defface prolog-builtin-face
- '((((class color) (background light)) (:foreground "Purple"))
- (((class color) (background dark)) (:foreground "Cyan"))
- (((class grayscale) (background light))
- :foreground "LightGray" :bold t)
- (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
- (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)
- "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)
- "Face name to use for built in predicates.")
- (defvar prolog-redo-face 'prolog-redo-face
- "Face name to use for redo trace lines.")
- (defvar prolog-exit-face 'prolog-exit-face
- "Face name to use for exit trace lines.")
- (defvar prolog-exception-face 'prolog-exception-face
- "Face name to use for exception trace lines.")
-
- ;; Font Lock Patterns
- (let (
- ;; "Native" Prolog patterns
- (head-predicates
- (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp)
- 1 font-lock-function-name-face))
- ;(list (format "^%s" prolog-atom-regexp)
- ; 0 font-lock-function-name-face))
- (head-predicates-1
- (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp)
- 1 font-lock-function-name-face) )
- (variables
- '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)"
- 1 font-lock-variable-name-face))
- (important-elements
- (list (if (eq prolog-system 'mercury)
- "[][}{;|]\\|\\\\[+=]\\|<?=>?"
- "[][}{!;|]\\|\\*->")
- 0 'font-lock-keyword-face))
- (important-elements-1
- '("[^-*]\\(->\\)" 1 font-lock-keyword-face))
- (predspecs ; module:predicate/cardinality
- (list (format "\\<\\(%s:\\|\\)%s/[0-9]+"
- prolog-atom-regexp prolog-atom-regexp)
- 0 font-lock-function-name-face 'prepend))
- (keywords ; directives (queries)
- (list
- (if (eq prolog-system 'mercury)
- (concat
- "\\<\\("
- (regexp-opt prolog-keywords-i)
- "\\|"
- (regexp-opt
- prolog-determinism-specificators-i)
- "\\)\\>")
- (concat
- "^[?:]- *\\("
- (regexp-opt prolog-keywords-i)
- "\\)\\>"))
- 1 prolog-builtin-face))
- ;; SICStus specific patterns
- (sicstus-object-methods
- (if (eq prolog-system 'sicstus)
- '(prolog-font-lock-object-matcher
- 1 font-lock-function-name-face)))
- ;; Mercury specific patterns
- (types
- (if (eq prolog-system 'mercury)
- (list
- (regexp-opt prolog-types-i 'words)
- 0 'font-lock-type-face)))
- (modes
- (if (eq prolog-system 'mercury)
- (list
- (regexp-opt prolog-mode-specificators-i 'words)
- 0 'font-lock-constant-face)))
- (directives
- (if (eq prolog-system 'mercury)
- (list
- (regexp-opt prolog-directives-i 'words)
- 0 'prolog-warning-face)))
- ;; Inferior mode specific patterns
- (prompt
- ;; FIXME: Should be handled by comint already.
- (list (prolog-prompt-regexp) 0 'font-lock-keyword-face))
- (trace-exit
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
- 1 prolog-exit-face))
- ((eq prolog-system 'swi)
- '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
- (t nil)))
- (trace-fail
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
- 1 prolog-warning-face))
- ((eq prolog-system 'swi)
- '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
- (t nil)))
- (trace-redo
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
- 1 prolog-redo-face))
- ((eq prolog-system 'swi)
- '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
- (t nil)))
- (trace-call
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
- 1 font-lock-function-name-face))
- ((eq prolog-system 'swi)
- '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)"
+ ;;(when window-system
+ (require 'font-lock)
+
+ ;; Define Prolog faces
+ (defface prolog-redo-face
+ '((((class grayscale)) (:italic t))
+ (((class color)) (:foreground "darkorchid"))
+ (t (:italic t)))
+ "Prolog mode face for highlighting redo trace lines."
+ :group 'prolog-faces)
+ (defface prolog-exit-face
+ '((((class grayscale)) (:underline t))
+ (((class color) (background dark)) (:foreground "green"))
+ (((class color) (background light)) (:foreground "ForestGreen"))
+ (t (:underline t)))
+ "Prolog mode face for highlighting exit trace lines."
+ :group 'prolog-faces)
+ (defface prolog-exception-face
+ '((((class grayscale)) (:bold t :italic t :underline t))
+ (((class color)) (:bold t :foreground "black" :background "Khaki"))
+ (t (:bold t :italic t :underline t)))
+ "Prolog mode face for highlighting exception trace lines."
+ :group 'prolog-faces)
+ (defface prolog-warning-face
+ '((((class grayscale)) (:underline t))
+ (((class color) (background dark)) (:foreground "blue"))
+ (((class color) (background light)) (:foreground "MidnightBlue"))
+ (t (:underline t)))
+ "Face name to use for compiler warnings."
+ :group 'prolog-faces)
+ (defface prolog-builtin-face
+ '((((class color) (background light)) (:foreground "Purple"))
+ (((class color) (background dark)) (:foreground "Cyan"))
+ (((class grayscale) (background light))
+ :foreground "LightGray" :bold t)
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (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)
+ "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)
+ "Face name to use for built in predicates.")
+ (defvar prolog-redo-face 'prolog-redo-face
+ "Face name to use for redo trace lines.")
+ (defvar prolog-exit-face 'prolog-exit-face
+ "Face name to use for exit trace lines.")
+ (defvar prolog-exception-face 'prolog-exception-face
+ "Face name to use for exception trace lines.")
+
+ ;; Font Lock Patterns
+ (let (
+ ;; "Native" Prolog patterns
+ (head-predicates
+ (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp)
1 font-lock-function-name-face))
- (t nil)))
- (trace-exception
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
- 1 prolog-exception-face))
- ((eq prolog-system 'swi)
- '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)"
- 1 prolog-exception-face))
- (t nil)))
- (error-message-identifier
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
- ((eq prolog-system 'swi)
- '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
- (t nil)))
- (error-whole-messages
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
- 1 font-lock-comment-face append))
- ((eq prolog-system 'swi)
- '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
- (t nil)))
- (error-warning-messages
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- ;; Mostly errors that SICStus asks the user about how to solve,
- ;; such as "NAME CLASH:" for example.
- (cond
- ((eq prolog-system 'sicstus)
- '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
- (t nil)))
- (warning-messages
- ;; FIXME: Add to compilation-error-regexp-alist instead.
- (cond
- ((eq prolog-system 'sicstus)
- '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
- 2 prolog-warning-face prepend))
- (t nil))))
-
- ;; Make font lock list
- (delq
- nil
- (cond
- ((eq major-mode 'prolog-mode)
+ ;(list (format "^%s" prolog-atom-regexp)
+ ; 0 font-lock-function-name-face))
+ (head-predicates-1
+ (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp)
+ 1 font-lock-function-name-face) )
+ (variables
+ '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)"
+ 1 font-lock-variable-name-face))
+ (important-elements
+ (list (if (eq prolog-system 'mercury)
+ "[][}{;|]\\|\\\\[+=]\\|<?=>?"
+ "[][}{!;|]\\|\\*->")
+ 0 'font-lock-keyword-face))
+ (important-elements-1
+ '("[^-*]\\(->\\)" 1 font-lock-keyword-face))
+ (predspecs ; module:predicate/cardinality
+ (list (format "\\<\\(%s:\\|\\)%s/[0-9]+"
+ prolog-atom-regexp prolog-atom-regexp)
+ 0 font-lock-function-name-face 'prepend))
+ (keywords ; directives (queries)
(list
- head-predicates
- head-predicates-1
- variables
- important-elements
- important-elements-1
- predspecs
- keywords
- sicstus-object-methods
- types
- modes
- directives))
- ((eq major-mode 'prolog-inferior-mode)
- (list
- prompt
- error-message-identifier
- error-whole-messages
- error-warning-messages
- warning-messages
- predspecs
- trace-exit
- trace-fail
- trace-redo
- trace-call
- trace-exception))
- ((eq major-mode 'compilation-mode)
- (list
- error-message-identifier
- error-whole-messages
- error-warning-messages
- warning-messages
- predspecs))))
- ))
-
-
-;;-------------------------------------------------------------------
-;; Indentation stuff
-;;-------------------------------------------------------------------
-
-;; NB: This function *MUST* have this optional argument since XEmacs
-;; assumes it. This does not mean we have to use it...
-(defun prolog-indent-line (&optional _whole-exp)
- "Indent current line as Prolog code.
-With argument, indent any additional lines of the same clause
-rigidly along with this one (not yet)."
- (interactive "p")
- (let ((indent (prolog-indent-level))
- (pos (- (point-max) (point))))
- (beginning-of-line)
- (skip-chars-forward " \t")
- (indent-line-to indent)
- (if (> (- (point-max) pos) (point))
- (goto-char (- (point-max) pos)))
-
- ;; Align comments
- (if (and prolog-align-comments-flag
- (save-excursion
- (line-beginning-position)
- ;; (let ((start (comment-search-forward (line-end-position) t)))
- ;; (and start ;There's a comment to indent.
- ;; ;; If it's first on the line, we've indented it already
- ;; ;; and prolog-goto-comment-column would inf-loop.
- ;; (progn (goto-char start) (skip-chars-backward " \t")
- ;; (not (bolp)))))))
- (and (looking-at comment-start-skip)
- ;; The definition of comment-start-skip used in this
- ;; mode is unusual in that it only matches at BOL.
- (progn (skip-chars-forward " \t")
- (not (eq (point) (match-end 1)))))))
- (save-excursion
- (prolog-goto-comment-column t)))
-
- ;; Insert spaces if needed
- (if (or prolog-electric-tab-flag prolog-electric-if-then-else-flag)
- (prolog-insert-spaces-after-paren))
+ (if (eq prolog-system 'mercury)
+ (concat
+ "\\<\\("
+ (regexp-opt prolog-keywords-i)
+ "\\|"
+ (regexp-opt
+ prolog-determinism-specificators-i)
+ "\\)\\>")
+ (concat
+ "^[?:]- *\\("
+ (regexp-opt prolog-keywords-i)
+ "\\)\\>"))
+ 1 prolog-builtin-face))
+ ;; SICStus specific patterns
+ (sicstus-object-methods
+ (if (eq prolog-system 'sicstus)
+ '(prolog-font-lock-object-matcher
+ 1 font-lock-function-name-face)))
+ ;; Mercury specific patterns
+ (types
+ (if (eq prolog-system 'mercury)
+ (list
+ (regexp-opt prolog-types-i 'words)
+ 0 'font-lock-type-face)))
+ (modes
+ (if (eq prolog-system 'mercury)
+ (list
+ (regexp-opt prolog-mode-specificators-i 'words)
+ 0 'font-lock-constant-face)))
+ (directives
+ (if (eq prolog-system 'mercury)
+ (list
+ (regexp-opt prolog-directives-i 'words)
+ 0 'prolog-warning-face)))
+ ;; Inferior mode specific patterns
+ (prompt
+ ;; FIXME: Should be handled by comint already.
+ (list (prolog-prompt-regexp) 0 'font-lock-keyword-face))
+ (trace-exit
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
+ 1 prolog-exit-face))
+ ((eq prolog-system 'swi)
+ '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
+ (t nil)))
+ (trace-fail
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
+ 1 prolog-warning-face))
+ ((eq prolog-system 'swi)
+ '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
+ (t nil)))
+ (trace-redo
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
+ 1 prolog-redo-face))
+ ((eq prolog-system 'swi)
+ '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
+ (t nil)))
+ (trace-call
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
+ 1 font-lock-function-name-face))
+ ((eq prolog-system 'swi)
+ '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)"
+ 1 font-lock-function-name-face))
+ (t nil)))
+ (trace-exception
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
+ 1 prolog-exception-face))
+ ((eq prolog-system 'swi)
+ '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)"
+ 1 prolog-exception-face))
+ (t nil)))
+ (error-message-identifier
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
+ ((eq prolog-system 'swi)
+ '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
+ (t nil)))
+ (error-whole-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
+ 1 font-lock-comment-face append))
+ ((eq prolog-system 'swi)
+ '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
+ (t nil)))
+ (error-warning-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ ;; Mostly errors that SICStus asks the user about how to solve,
+ ;; such as "NAME CLASH:" for example.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
+ (t nil)))
+ (warning-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
+ (cond
+ ((eq prolog-system 'sicstus)
+ '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
+ 2 prolog-warning-face prepend))
+ (t nil))))
+
+ ;; Make font lock list
+ (delq
+ nil
+ (cond
+ ((eq major-mode 'prolog-mode)
+ (list
+ head-predicates
+ head-predicates-1
+ variables
+ important-elements
+ important-elements-1
+ predspecs
+ keywords
+ sicstus-object-methods
+ types
+ modes
+ directives))
+ ((eq major-mode 'prolog-inferior-mode)
+ (list
+ prompt
+ error-message-identifier
+ error-whole-messages
+ error-warning-messages
+ warning-messages
+ predspecs
+ trace-exit
+ trace-fail
+ trace-redo
+ trace-call
+ trace-exception))
+ ((eq major-mode 'compilation-mode)
+ (list
+ error-message-identifier
+ error-whole-messages
+ error-warning-messages
+ warning-messages
+ predspecs))))
))
-(defun prolog-indent-level ()
- "Compute prolog indentation level."
- (save-excursion
- (beginning-of-line)
- (let ((totbal (prolog-region-paren-balance
- (prolog-clause-start t) (point)))
- (oldpoint (point)))
- (skip-chars-forward " \t")
- (cond
- ((looking-at "%%%") (prolog-indentation-level-of-line))
- ;Large comment starts
- ((looking-at "%[^%]") comment-column) ;Small comment starts
- ((bobp) 0) ;Beginning of buffer
-
- ;; If we found '}' then we must check if it's the
- ;; end of an object declaration or something else.
- ((and (looking-at "}")
- (save-excursion
- (forward-char 1)
- ;; Goto to matching {
- (if prolog-use-prolog-tokenizer-flag
- (prolog-backward-list)
- (backward-list))
- (skip-chars-backward " \t")
- (backward-char 2)
- (looking-at "::")))
- ;; It was an object
- (if prolog-object-end-to-0-flag
- 0
- prolog-indent-width))
-
- ;;End of /* */ comment
- ((looking-at "\\*/")
- (save-excursion
- (prolog-find-start-of-mline-comment)
- (skip-chars-backward " \t")
- (- (current-column) 2)))
-
- ;; Here we check if the current line is within a /* */ pair
- ((and (looking-at "[^%/]")
- (eq (prolog-in-string-or-comment) 'cmt))
- (if prolog-indent-mline-comments-flag
- (prolog-find-start-of-mline-comment)
- ;; Same as before
- (prolog-indentation-level-of-line)))
-
- (t
- (let ((empty t) ind linebal)
- ;; See previous indentation
- (while empty
- (forward-line -1)
- (beginning-of-line)
- (if (bobp)
- (setq empty nil)
- (skip-chars-forward " \t")
- (if (not (or (not (member (prolog-in-string-or-comment)
- '(nil txt)))
- (looking-at "%")
- (looking-at "\n")))
- (setq empty nil))))
-
- ;; Store this line's indentation
- (setq ind (if (bobp)
- 0 ;Beginning of buffer.
- (current-column))) ;Beginning of clause.
-
- ;; Compute the balance of the line
- (setq linebal (prolog-paren-balance))
- ;;(message "bal of previous line %d totbal %d" linebal totbal)
- (if (< linebal 0)
- (progn
- ;; Add 'indent-level' mode to find-unmatched-paren instead?
- (end-of-line)
- (setq ind (prolog-find-indent-of-matching-paren))))
-
- ;;(message "ind %d" ind)
- (beginning-of-line)
-
- ;; Check if the line ends with ":-", ".", ":: {", "}" (might be
- ;; unnecessary), "&" or ")" (The last four concerns SICStus objects)
- (cond
- ;; If the last char of the line is a '&' then set the indent level
- ;; to prolog-indent-width (used in SICStus objects)
- ((and (eq prolog-system 'sicstus)
- (looking-at ".+&[ \t]*\\(%.*\\|\\)$"))
- (setq ind prolog-indent-width))
-
- ;; Increase indentation if the previous line was the head of a rule
- ;; and does not contain a '.'
- ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$"
- prolog-head-delimiter))
- ;; We must check that the match is at a paren balance of 0.
- (save-excursion
- (let ((p (point)))
- (re-search-forward prolog-head-delimiter)
- (>= 0 (prolog-region-paren-balance p (point))))))
- (let ((headindent
- (if (< (prolog-paren-balance) 0)
- (save-excursion
- (end-of-line)
- (prolog-find-indent-of-matching-paren))
- (prolog-indentation-level-of-line))))
- (setq ind (+ headindent prolog-indent-width))))
-
- ;; The previous line was the head of an object
- ((looking-at ".+ *::.*{[ \t]*$")
- (setq ind prolog-indent-width))
-
- ;; If a '.' is found at the end of the previous line, then
- ;; decrease the indentation. (The \\(%.*\\|\\) part of the
- ;; regexp is for comments at the end of the line)
- ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$")
- ;; Make sure that the '.' found is not in a comment or string
- (save-excursion
- (end-of-line)
- (re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min))
- ;; Guard against the real '.' being followed by a
- ;; commented '.'.
- (if (eq (prolog-in-string-or-comment) 'cmt)
- ;; commented out '.'
- (let ((here (line-beginning-position)))
- (end-of-line)
- (re-search-backward "\\.[ \t]*%.*$" here t))
- (not (prolog-in-string-or-comment))
- )
- ))
- (setq ind 0))
-
- ;; If a '.' is found at the end of the previous line, then
- ;; decrease the indentation. (The /\\*.*\\*/ part of the
- ;; regexp is for C-like comments at the end of the
- ;; line--can we merge with the case above?).
- ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$")
- ;; Make sure that the '.' found is not in a comment or string
- (save-excursion
- (end-of-line)
- (re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min))
- ;; Guard against the real '.' being followed by a
- ;; commented '.'.
- (if (eq (prolog-in-string-or-comment) 'cmt)
- ;; commented out '.'
- (let ((here (line-beginning-position)))
- (end-of-line)
- (re-search-backward "\\.[ \t]*/\\*.*$" here t))
- (not (prolog-in-string-or-comment))
- )
- ))
- (setq ind 0))
-
- )
-
- ;; If the last non comment char is a ',' or left paren or a left-
- ;; indent-regexp then indent to open parenthesis level
- (if (and
- (> totbal 0)
- ;; SICStus objects have special syntax rules if point is
- ;; not inside additional parens (objects are defined
- ;; within {...})
- (not (and (eq prolog-system 'sicstus)
- (= totbal 1)
- (prolog-in-object))))
- (if (looking-at
- (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$"
- prolog-quoted-atom-regexp prolog-string-regexp
- prolog-left-paren prolog-left-indent-regexp))
- (progn
- (goto-char oldpoint)
- (setq ind (prolog-find-unmatched-paren
- (if prolog-paren-indent-p
- 'termdependent
- 'skipwhite)))
- ;;(setq ind (prolog-find-unmatched-paren 'termdependent))
- )
- (goto-char oldpoint)
- (setq ind (prolog-find-unmatched-paren nil))
- ))
-
-
- ;; Return the indentation level
- ind
- ))))))
-
-(defun prolog-find-indent-of-matching-paren ()
- "Find the indentation level based on the matching parenthesis.
-Indentation level is set to the one the point is after when the function is
-called."
- (save-excursion
- ;; Go to the matching paren
- (if prolog-use-prolog-tokenizer-flag
- (prolog-backward-list)
- (backward-list))
-
- ;; If this was the first paren on the line then return this line's
- ;; indentation level
- (if (prolog-paren-is-the-first-on-line-p)
- (prolog-indentation-level-of-line)
- ;; It was not the first one
- (progn
- ;; Find the next paren
- (prolog-goto-next-paren 0)
-
- ;; If this paren is a left one then use its column as indent level,
- ;; if not then recurse this function
- (if (looking-at prolog-left-paren)
- (+ (current-column) 1)
- (progn
- (forward-char 1)
- (prolog-find-indent-of-matching-paren)))
- ))
- ))
+
-(defun prolog-indentation-level-of-line ()
- "Return the indentation level of the current line."
+(defun prolog-find-unmatched-paren ()
+ "Return the column of the last unmatched left parenthesis."
(save-excursion
- (beginning-of-line)
- (skip-chars-forward " \t")
+ (goto-char (or (nth 1 (syntax-ppss)) (point-min)))
(current-column)))
-(defun prolog-paren-is-the-first-on-line-p ()
- "Return t if the parenthesis under the point is the first one on the line.
-Return nil otherwise.
-Note: does not check if the point is actually at a parenthesis!"
- (save-excursion
- (let ((begofline (line-beginning-position)))
- (if (= begofline (point))
- t
- (if (prolog-goto-next-paren begofline)
- nil
- t)))))
-
-(defun prolog-find-unmatched-paren (&optional mode)
- "Return the column of the last unmatched left parenthesis.
-If MODE is `skipwhite' then any white space after the parenthesis is added to
-the answer.
-If MODE is `plusone' then the parenthesis' column +1 is returned.
-If MODE is `termdependent' then if the unmatched parenthesis is part of
-a compound term the function will work as `skipwhite', otherwise
-it will return the column paren plus the value of `prolog-paren-indent'.
-If MODE is nil or not set then the parenthesis' exact column is returned."
- (save-excursion
- ;; If the next paren we find is a left one we're finished, if it's
- ;; a right one then we go back one step and recurse
- (prolog-goto-next-paren 0)
-
- (let ((roundparen (looking-at "(")))
- (if (looking-at prolog-left-paren)
- (let ((not-part-of-term
- (save-excursion
- (backward-char 1)
- (looking-at "[ \t]"))))
- (if (eq mode nil)
- (current-column)
- (if (and roundparen
- (eq mode 'termdependent)
- not-part-of-term)
- (+ (current-column)
- (if prolog-electric-tab-flag
- ;; Electric TAB
- prolog-paren-indent
- ;; Not electric TAB
- (if (looking-at ".[ \t]*$")
- 2
- prolog-paren-indent))
- )
-
- (forward-char 1)
- (if (or (eq mode 'skipwhite) (eq mode 'termdependent) )
- (skip-chars-forward " \t"))
- (current-column))))
- ;; Not looking at left paren
- (progn
- (forward-char 1)
- ;; Go to the matching paren. When we get there we have a total
- ;; balance of 0.
- (if prolog-use-prolog-tokenizer-flag
- (prolog-backward-list)
- (backward-list))
- (prolog-find-unmatched-paren mode)))
- )))
-
(defun prolog-paren-balance ()
"Return the parenthesis balance of the current line.
-A return value of n means n more left parentheses than right ones."
+A return value of N means N more left parentheses than right ones."
(save-excursion
- (end-of-line)
- (prolog-region-paren-balance (line-beginning-position) (point))))
-
-(defun prolog-region-paren-balance (beg end)
- "Return the summed parenthesis balance in the region.
-The region is limited by BEG and END positions."
- (save-excursion
- (let ((state (if prolog-use-prolog-tokenizer-flag
- (prolog-tokenize beg end)
- (parse-partial-sexp beg end))))
- (nth 0 state))))
-
-(defun prolog-goto-next-paren (limit-pos)
- "Move the point to the next parenthesis earlier in the buffer.
-Return t if a match was found before LIMIT-POS. Return nil otherwise."
- (let ((retval (re-search-backward
- (concat prolog-left-paren "\\|" prolog-right-paren)
- limit-pos t)))
-
- ;; If a match was found but it was in a string or comment, then recurse
- (if (and retval (prolog-in-string-or-comment))
- (prolog-goto-next-paren limit-pos)
- retval)
- ))
+ (car (parse-partial-sexp (line-beginning-position)
+ (line-end-position)))))
-(defun prolog-in-string-or-comment ()
- "Check whether string, atom, or comment is under current point.
-Return:
- `txt' if the point is in a string, atom, or character code expression
- `cmt' if the point is in a comment
- nil otherwise."
- (save-excursion
- (let* ((start
- (if (eq prolog-parse-mode 'beg-of-line)
- ;; 'beg-of-line
- (save-excursion
- (let (safepoint)
- (beginning-of-line)
- (setq safepoint (point))
- (while (and (> (point) (point-min))
- (progn
- (forward-line -1)
- (end-of-line)
- (if (not (bobp))
- (backward-char 1))
- (looking-at "\\\\"))
- )
- (beginning-of-line)
- (setq safepoint (point)))
- safepoint))
- ;; 'beg-of-clause
- (prolog-clause-start)))
- (end (point))
- (state (if prolog-use-prolog-tokenizer-flag
- (prolog-tokenize start end)
- (if (fboundp 'syntax-ppss)
- (syntax-ppss)
- (parse-partial-sexp start end)))))
- (cond
- ((nth 3 state) 'txt) ; String
- ((nth 4 state) 'cmt) ; Comment
- (t
- (cond
- ((looking-at "%") 'cmt) ; Start of a comment
- ((looking-at "/\\*") 'cmt) ; Start of a comment
- ((looking-at "\'") 'txt) ; Start of an atom
- ((looking-at "\"") 'txt) ; Start of a string
- (t nil)
- ))))
- ))
-
-(defun prolog-find-start-of-mline-comment ()
- "Return the start column of a /* */ comment.
-This assumes that the point is inside a comment."
- (re-search-backward "/\\*" (point-min) t)
- (forward-char 2)
- (skip-chars-forward " \t")
- (current-column))
-
-(defun prolog-insert-spaces-after-paren ()
+(defun prolog-electric--if-then-else ()
"Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches.
Spaces are inserted if all preceding objects on the line are
whitespace characters, parentheses, or then/else branches."
- (save-excursion
- (let ((regexp (concat "(\\|" prolog-left-indent-regexp))
- level)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (when (looking-at regexp)
+ (when prolog-electric-if-then-else-flag
+ (save-excursion
+ (let ((regexp (concat "(\\|" prolog-left-indent-regexp))
+ (pos (point))
+ level)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
;; Treat "( If -> " lines specially.
;;(setq incr (if (looking-at "(.*->")
;; 2
;; prolog-paren-indent))
;; work on all subsequent "->", "(", ";"
+ (and (looking-at regexp)
+ (= pos (match-end 0))
+ (indent-according-to-mode))
(while (looking-at regexp)
(goto-char (match-end 0))
(setq level (+ (prolog-find-unmatched-paren) prolog-paren-indent))
@@ -2651,12 +2171,12 @@ whitespace characters, parentheses, or then/else branches."
(delete-region start (point)))
(indent-to level)
(skip-chars-forward " \t"))
- )))
- (when (save-excursion
- (backward-char 2)
- (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)"))
- (skip-chars-forward " \t"))
- )
+ ))
+ (when (save-excursion
+ (backward-char 2)
+ (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)"))
+ (skip-chars-forward " \t"))
+ ))
;;;; Comment filling
@@ -2741,7 +2261,7 @@ between them)."
;; fill 'txt entities?
(when (save-excursion
(end-of-line)
- (equal (prolog-in-string-or-comment) 'cmt))
+ (nth 4 (syntax-ppss)))
(let* ((bounds (prolog-comment-limits))
(cbeg (car bounds))
(type (nth 2 bounds))
@@ -2810,162 +2330,6 @@ In effect it sets the `fill-prefix' when inside comments and then calls
(replace-regexp-in-string regexp newtext str nil literal))))
;;-------------------------------------------------------------------
-;; The tokenizer
-;;-------------------------------------------------------------------
-
-(defconst prolog-tokenize-searchkey
- (concat "[0-9]+'"
- "\\|"
- "['\"]"
- "\\|"
- prolog-left-paren
- "\\|"
- prolog-right-paren
- "\\|"
- "%"
- "\\|"
- "/\\*"
- ))
-
-(defun prolog-tokenize (beg end &optional stopcond)
- "Tokenize a region of prolog code between BEG and END.
-STOPCOND decides the stop condition of the parsing. Valid values
-are 'zerodepth which stops the parsing at the first right parenthesis
-where the parenthesis depth is zero, 'skipover which skips over
-the current entity (e.g. a list, a string, etc.) and nil.
-
-The function returns a list with the following information:
- 0. parenthesis depth
- 3. 'atm if END is inside an atom
- 'str if END is inside a string
- 'chr if END is in a character code expression (0'x)
- nil otherwise
- 4. non-nil if END is inside a comment
- 5. end position (always equal to END if STOPCOND is nil)
-The rest of the elements are undefined."
- (save-excursion
- (let* ((end2 (1+ end))
- oldp
- (depth 0)
- (quoted nil)
- inside_cmt
- (endpos end2)
- skiptype ; The type of entity we'll skip over
- )
- (goto-char beg)
-
- (if (and (eq stopcond 'skipover)
- (looking-at "[^[({'\"]"))
- (setq endpos (point)) ; Stay where we are
- (while (and
- (re-search-forward prolog-tokenize-searchkey end2 t)
- (< (point) end2))
- (progn
- (setq oldp (point))
- (goto-char (match-beginning 0))
- (cond
- ;; Atoms and strings
- ((looking-at "'")
- ;; Find end of atom
- (if (re-search-forward "[^\\]'" end2 'limit)
- ;; Found end of atom
- (progn
- (setq oldp end2)
- (if (and (eq stopcond 'skipover)
- (not skiptype))
- (setq endpos (point))
- (setq oldp (point)))) ; Continue tokenizing
- (setq quoted 'atm)))
-
- ((looking-at "\"")
- ;; Find end of string
- (if (re-search-forward "[^\\]\"" end2 'limit)
- ;; Found end of string
- (progn
- (setq oldp end2)
- (if (and (eq stopcond 'skipover)
- (not skiptype))
- (setq endpos (point))
- (setq oldp (point)))) ; Continue tokenizing
- (setq quoted 'str)))
-
- ;; Paren stuff
- ((looking-at prolog-left-paren)
- (setq depth (1+ depth))
- (setq skiptype 'paren))
-
- ((looking-at prolog-right-paren)
- (setq depth (1- depth))
- (if (and
- (or (eq stopcond 'zerodepth)
- (and (eq stopcond 'skipover)
- (eq skiptype 'paren)))
- (= depth 0))
- (progn
- (setq endpos (1+ (point)))
- (setq oldp end2))))
-
- ;; Comment stuff
- ((looking-at comment-start)
- (end-of-line)
- ;; (if (>= (point) end2)
- (if (>= (point) end)
- (progn
- (setq inside_cmt t)
- (setq oldp end2))
- (setq oldp (point))))
-
- ((looking-at "/\\*")
- (if (re-search-forward "\\*/" end2 'limit)
- (setq oldp (point))
- (setq inside_cmt t)
- (setq oldp end2)))
-
- ;; 0'char
- ((looking-at "0'")
- (setq oldp (1+ (match-end 0)))
- (if (> oldp end)
- (setq quoted 'chr)))
-
- ;; base'number
- ((looking-at "[0-9]+'")
- (goto-char (match-end 0))
- (skip-chars-forward "0-9a-zA-Z")
- (setq oldp (point)))
-
-
- )
- (goto-char oldp)
- )) ; End of while
- )
-
- ;; Deal with multi-line comments
- (and (prolog-inside-mline-comment end)
- (setq inside_cmt t))
-
- ;; Create return list
- (list depth nil nil quoted inside_cmt endpos)
- )))
-
-(defun prolog-inside-mline-comment (here)
- (save-excursion
- (goto-char here)
- (let* ((next-close (save-excursion (search-forward "*/" nil t)))
- (next-open (save-excursion (search-forward "/*" nil t)))
- (prev-open (save-excursion (search-backward "/*" nil t)))
- (prev-close (save-excursion (search-backward "*/" nil t)))
- (unmatched-next-close (and next-close
- (or (not next-open)
- (> next-open next-close))))
- (unmatched-prev-open (and prev-open
- (or (not prev-close)
- (> prev-open prev-close))))
- )
- (or unmatched-next-close unmatched-prev-open)
- )))
-
-
-;;-------------------------------------------------------------------
;; Online help
;;-------------------------------------------------------------------
@@ -3015,7 +2379,7 @@ The rest of the elements are undefined."
(pop-to-buffer nil)
(Info-goto-node prolog-info-predicate-index)
(if (not (re-search-forward str nil t))
- (error (format "Help on predicate `%s' not found." predicate)))
+ (error "Help on predicate `%s' not found." predicate))
(setq oldp (point))
(if (re-search-forward str nil t)
@@ -3067,7 +2431,7 @@ This function is only available when `prolog-system' is set to `swi'."
(defun prolog-atom-under-point ()
"Return the atom under or left to the point."
(save-excursion
- (let ((nonatom_chars "[](){},\. \t\n")
+ (let ((nonatom_chars "[](){},. \t\n")
start)
(skip-chars-forward (concat "^" nonatom_chars))
(skip-chars-backward nonatom_chars)
@@ -3357,7 +2721,7 @@ When called with prefix argument ARG, disable zipping instead."
(let ((state (prolog-clause-info))
(object (prolog-in-object)))
(if (or (equal (nth 0 state) "")
- (equal (prolog-in-string-or-comment) 'cmt))
+ (nth 4 (syntax-ppss)))
nil
(if (and (eq prolog-system 'sicstus)
object)
@@ -3465,7 +2829,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(defun prolog-clause-start (&optional not-allow-methods)
"Return the position at the start of the head of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevant only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if `prolog-system' is set to `sicstus')."
(save-excursion
(let ((notdone t)
(retval (point-min)))
@@ -3501,11 +2865,8 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
;; ######
;; (re-search-backward "^[a-z$']" nil t))
(let ((case-fold-search nil))
- (re-search-backward
- ;; (format "^[%s$']" prolog-lower-case-string)
- ;; FIXME: Use [:lower:]
- (format "^\\([%s$']\\|[:?]-\\)" prolog-lower-case-string)
- nil t)))
+ (re-search-backward "^\\([[:lower:]$']\\|[:?]-\\)"
+ nil t)))
(let ((bal (prolog-paren-balance)))
(cond
((> bal 0)
@@ -3531,7 +2892,7 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
(defun prolog-clause-end (&optional not-allow-methods)
"Return the position at the end of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevant only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if `prolog-system' is set to `sicstus')."
(save-excursion
(beginning-of-line) ; Necessary since we use "^...." for the search.
(if (re-search-forward
@@ -3539,13 +2900,13 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
(eq prolog-system 'sicstus)
(prolog-in-object))
(format
- "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}"
+ "^\\(%s\\|%s\\|[^\n'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}"
prolog-quoted-atom-regexp prolog-string-regexp)
(format
- "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$"
+ "^\\(%s\\|%s\\|[^\n'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$"
prolog-quoted-atom-regexp prolog-string-regexp))
nil t)
- (if (and (prolog-in-string-or-comment)
+ (if (and (nth 8 (syntax-ppss))
(not (eobp)))
(progn
(forward-char)
@@ -3568,7 +2929,7 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
;; Retrieve the arity.
(if (looking-at prolog-left-paren)
(let ((endp (save-excursion
- (prolog-forward-list) (point))))
+ (forward-list) (point))))
(setq arity 1)
(forward-char 1) ; Skip the opening paren.
(while (progn
@@ -3580,9 +2941,8 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
(forward-char 1) ; Skip the comma.
)
;; We found a string, list or something else we want
- ;; to skip over. Always use prolog-tokenize,
- ;; parse-partial-sexp does not have a 'skipover mode.
- (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover))))
+ ;; to skip over.
+ (forward-sexp 1))
)))
(list predname arity))))
@@ -3602,36 +2962,6 @@ objects (relevant only if 'prolog-system' is set to 'sicstus)."
(match-string 1)
nil))))
-(defun prolog-forward-list ()
- "Move the point to the matching right parenthesis."
- (interactive)
- (if prolog-use-prolog-tokenizer-flag
- (let ((state (prolog-tokenize (point) (point-max) 'zerodepth)))
- (goto-char (nth 5 state)))
- (forward-list)))
-
-;; NB: This could be done more efficiently!
-(defun prolog-backward-list ()
- "Move the point to the matching left parenthesis."
- (interactive)
- (if prolog-use-prolog-tokenizer-flag
- (let ((bal 0)
- (paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren))
- (notdone t))
- ;; FIXME: Doesn't this incorrectly count 0'( and 0') ?
- (while (and notdone (re-search-backward paren-regexp nil t))
- (cond
- ((looking-at prolog-left-paren)
- (if (not (prolog-in-string-or-comment))
- (setq bal (1+ bal)))
- (if (= bal 0)
- (setq notdone nil)))
- ((looking-at prolog-right-paren)
- (if (not (prolog-in-string-or-comment))
- (setq bal (1- bal))))
- )))
- (backward-list)))
-
(defun prolog-beginning-of-clause ()
"Move to the beginning of current clause.
If already at the beginning of clause, move to previous clause."
@@ -3719,7 +3049,7 @@ Return the final point or nil if no such a beginning was found."
(let* ((pinfo (prolog-clause-info))
(predname (nth 0 pinfo))
(arity (nth 1 pinfo)))
- (message (format "%s/%d" predname arity))))
+ (message "%s/%d" predname arity)))
(defun prolog-insert-predicate-template ()
"Insert the template for the current clause."
@@ -3764,23 +3094,6 @@ The module name should be written manually just before the semi-colon."
(interactive "r")
(comment-region beg end -1))))
-(defun prolog-goto-comment-column (&optional nocreate)
- "Move comments on the current line to the correct position.
-If NOCREATE is nil (or omitted) and there is no comment on the line, then
-a new comment is created."
- (interactive)
- (beginning-of-line)
- (if (or (not nocreate)
- (and
- (re-search-forward
- (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *"
- prolog-quoted-atom-regexp prolog-string-regexp)
- (line-end-position) 'limit)
- (progn
- (goto-char (match-beginning 0))
- (not (eq (prolog-in-string-or-comment) 'txt)))))
- (indent-for-comment)))
-
(defun prolog-indent-predicate ()
"Indent the current predicate."
(interactive)
@@ -3813,130 +3126,72 @@ a new comment is created."
(goto-char pos)
(goto-char (prolog-pred-start))))
-;; Stolen from `cc-mode.el':
-(defun prolog-electric-delete (arg)
- "Delete preceding character or whitespace.
-If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
-consumed. If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
-nil, or point is inside a literal then the function
-`backward-delete-char' is called."
- (interactive "P")
- (if (or (not prolog-hungry-delete-key-flag)
- arg
- (prolog-in-string-or-comment))
- (funcall 'backward-delete-char (prefix-numeric-value arg))
- (let ((here (point)))
- (skip-chars-backward " \t\n")
- (if (/= (point) here)
- (delete-region (point) here)
- (funcall 'backward-delete-char 1)
- ))))
-
-;; For XEmacs compatibility (suggested by Per Mildner)
-(put 'prolog-electric-delete 'pending-delete 'supersede)
-
-(defun prolog-electric-if-then-else (arg)
- "If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
-Bound to the >, ; and ( keys."
- ;; FIXME: Use post-self-insert-hook or electric-indent-mode.
- (interactive "P")
- (self-insert-command (prefix-numeric-value arg))
- (if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
-
-(defun prolog-electric-colon (arg)
+(defun prolog-electric--colon ()
"If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct.
That is, insert space (if appropriate), `:-' and newline if colon is pressed
-at the end of a line that starts in the first column (i.e., clause
-heads)."
- ;; FIXME: Use post-self-insert-hook.
- (interactive "P")
- (if (and prolog-electric-colon-flag
- (null arg)
- (eolp)
- ;(not (string-match "^\\s " (thing-at-point 'line))))
- (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
- (progn
- (unless (save-excursion (backward-char 1) (looking-at "\\s "))
- (insert " "))
- (insert ":-\n")
- (indent-according-to-mode))
- (self-insert-command (prefix-numeric-value arg))))
-
-(defun prolog-electric-dash (arg)
+at the end of a line that starts in the first column (i.e., clause heads)."
+ (when (and prolog-electric-colon-flag
+ (eq (char-before) ?:)
+ (not current-prefix-arg)
+ (eolp)
+ (not (memq (char-after (line-beginning-position))
+ '(?\s ?\t ?\%))))
+ (unless (memq (char-before (1- (point))) '(?\s ?\t))
+ (save-excursion (forward-char -1) (insert " ")))
+ (insert "-\n")
+ (indent-according-to-mode)))
+
+(defun prolog-electric--dash ()
"If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct.
that is, insert space (if appropriate), `-->' and newline if dash is pressed
-at the end of a line that starts in the first column (i.e., DCG
-heads)."
- ;; FIXME: Use post-self-insert-hook.
- (interactive "P")
- (if (and prolog-electric-dash-flag
- (null arg)
- (eolp)
- ;(not (string-match "^\\s " (thing-at-point 'line))))
- (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
- (progn
- (unless (save-excursion (backward-char 1) (looking-at "\\s "))
- (insert " "))
- (insert "-->\n")
- (indent-according-to-mode))
- (self-insert-command (prefix-numeric-value arg))))
-
-(defun prolog-electric-dot (arg)
- "Insert dot and newline or a head of a new clause.
-
-If `prolog-electric-dot-flag' is nil, then simply insert dot.
-Otherwise::
+at the end of a line that starts in the first column (i.e., DCG heads)."
+ (when (and prolog-electric-dash-flag
+ (eq (char-before) ?-)
+ (not current-prefix-arg)
+ (eolp)
+ (not (memq (char-after (line-beginning-position))
+ '(?\s ?\t ?\%))))
+ (unless (memq (char-before (1- (point))) '(?\s ?\t))
+ (save-excursion (forward-char -1) (insert " ")))
+ (insert "->\n")
+ (indent-according-to-mode)))
+
+(defun prolog-electric--dot ()
+ "Make dot electric, if `prolog-electric-dot-flag' is non-nil.
When invoked at the end of nonempty line, insert dot and newline.
When invoked at the end of an empty line, insert a recursive call to
the current predicate.
When invoked at the beginning of line, insert a head of a new clause
-of the current predicate.
-
-When called with prefix argument ARG, insert just dot."
- ;; FIXME: Use post-self-insert-hook.
- (interactive "P")
+of the current predicate."
;; Check for situations when the electricity should not be active
(if (or (not prolog-electric-dot-flag)
- arg
- (prolog-in-string-or-comment)
+ (not (eq (char-before) ?\.))
+ current-prefix-arg
+ (nth 8 (syntax-ppss))
;; Do not be electric in a floating point number or an operator
(not
- (or
- ;; (re-search-backward
- ;; ######
- ;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t)))
- (save-excursion
- (re-search-backward
- ;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t)))
- "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\="
- nil t))
- (save-excursion
- (re-search-backward
- ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
- (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
- prolog-lower-case-string) ;FIXME: [:lower:]
- nil t))
- (save-excursion
- (re-search-backward
- ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
- (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
- prolog-upper-case-string) ;FIXME: [:upper:]
- nil t))
- )
- )
+ (save-excursion
+ (forward-char -1)
+ (skip-chars-backward " \t")
+ (let ((num (> (skip-chars-backward "0-9") 0)))
+ (or (bolp)
+ (memq (char-syntax (char-before))
+ (if num '(?w ?_) '(?\) ?w ?_)))))))
;; Do not be electric if inside a parenthesis pair.
- (not (= (prolog-region-paren-balance (prolog-clause-start) (point))
+ (not (= (car (syntax-ppss))
0))
)
- (funcall 'self-insert-command (prefix-numeric-value arg))
+ nil ;;Not electric.
(cond
;; Beginning of line
- ((bolp)
+ ((save-excursion (forward-char -1) (bolp))
+ (delete-region (1- (point)) (point)) ;Delete the dot that called us.
(prolog-insert-predicate-template))
;; At an empty line with at least one whitespace
((save-excursion
(beginning-of-line)
- (looking-at "[ \t]+$"))
+ (looking-at "[ \t]+\\.$"))
+ (delete-region (1- (point)) (point)) ;Delete the dot that called us.
(prolog-insert-predicate-template)
(when prolog-electric-dot-full-predicate-template
(save-excursion
@@ -3944,47 +3199,31 @@ When called with prefix argument ARG, insert just dot."
(insert ".\n"))))
;; Default
(t
- (insert ".\n"))
+ (insert "\n"))
)))
-(defun prolog-electric-underscore ()
+(defun prolog-electric--underscore ()
"Replace variable with an underscore.
If `prolog-electric-underscore-flag' is non-nil and the point is
on a variable then replace the variable with underscore and skip
-the following comma and whitespace, if any.
-If the point is not on a variable then insert underscore."
- ;; FIXME: Use post-self-insert-hook.
- (interactive)
- (if prolog-electric-underscore-flag
- (let (;start
- (case-fold-search nil)
- (oldp (point)))
- ;; ######
- ;;(skip-chars-backward "a-zA-Z_")
- (skip-chars-backward
- (format "%s%s_"
- ;; FIXME: Why not "a-zA-Z"?
- prolog-lower-case-string
- prolog-upper-case-string))
-
- ;(setq start (point))
- (if (and (not (prolog-in-string-or-comment))
- ;; ######
- ;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>"))
- (looking-at (format "\\<[_%s][%s%s_0-9]*\\>"
- ;; FIXME: Use [:upper:] and friends.
- prolog-upper-case-string
- prolog-lower-case-string
- prolog-upper-case-string)))
- (progn
- (replace-match "_")
- (skip-chars-forward ", \t\n"))
- (goto-char oldp)
- (self-insert-command 1))
- )
- (self-insert-command 1))
- )
-
+the following comma and whitespace, if any."
+ (when prolog-electric-underscore-flag
+ (let ((case-fold-search nil))
+ (when (and (not (nth 8 (syntax-ppss)))
+ (eq (char-before) ?_)
+ (save-excursion
+ (skip-chars-backward "[:alpha:]_")
+ (looking-at "\\_<[_[:upper:]][[:alnum:]_]*\\_>")))
+ (replace-match "_")
+ (skip-chars-forward ", \t\n")))))
+
+(defun prolog-post-self-insert ()
+ (pcase last-command-event
+ (`?_ (prolog-electric--underscore))
+ (`?- (prolog-electric--dash))
+ (`?: (prolog-electric--colon))
+ ((or `?\( `?\; `?>) (prolog-electric--if-then-else))
+ (`?. (prolog-electric--dot))))
(defun prolog-find-term (functor arity &optional prefix)
"Go to the position at the start of the next occurrence of a term.
@@ -4065,7 +3304,7 @@ PREFIX is the prefix of the search regexp."
(unless (fboundp 'region-exists-p)
(defun region-exists-p ()
- "Non-nil iff the mark is set. Lobotomized version for Emacsen that do not provide their own."
+ "Non-nil if the mark is set. Lobotomized version for Emacsen that do not provide their own."
(mark)))
@@ -4177,8 +3416,6 @@ PREFIX is the prefix of the search regexp."
["Mark clause" prolog-mark-clause t]
["Mark predicate" prolog-mark-predicate t]
["Mark paragraph" mark-paragraph t]
- ;;"---"
- ;;["Fontify buffer" font-lock-fontify-buffer t]
))
(defun prolog-menu ()
@@ -4188,11 +3425,12 @@ PREFIX is the prefix of the search regexp."
(easy-menu-add prolog-edit-menu-runtime)
;; Add predicate index menu
- (set (make-local-variable 'imenu-create-index-function)
- 'imenu-default-create-index-function)
+ (setq-local imenu-create-index-function
+ 'imenu-default-create-index-function)
;;Milan (this has problems with object methods...) ###### Does it? (Stefan)
- (setq imenu-prev-index-position-function 'prolog-beginning-of-predicate)
- (setq imenu-extract-index-name-function 'prolog-get-predspec)
+ (setq-local imenu-prev-index-position-function
+ #'prolog-beginning-of-predicate)
+ (setq-local imenu-extract-index-name-function #'prolog-get-predspec)
(if (and prolog-imenu-flag
(< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 0f994a8422b..077be53e2fb 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -1,6 +1,6 @@
;;; ps-mode.el --- PostScript mode for GNU Emacs
-;; Copyright (C) 1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
;; Maintainer: Peter Kleiweg <p.c.j.kleiweg@rug.nl>
@@ -41,6 +41,7 @@
(require 'comint)
(require 'easymenu)
+(require 'smie)
;; Define core `PostScript' group.
(defgroup PostScript nil
@@ -60,10 +61,7 @@
;; User variables.
-(defcustom ps-mode-auto-indent t
- "Should we use autoindent?"
- :group 'PostScript-edit
- :type 'boolean)
+(make-obsolete-variable 'ps-mode-auto-indent 'electric-indent-mode "25.1")
(defcustom ps-mode-tab 4
"Number of spaces to use when indenting."
@@ -204,7 +202,7 @@ If nil, use `temporary-file-directory'."
"bind" "null"
"gsave" "grestore" "grestoreall"
"showpage")))
- (concat "\\<" (regexp-opt ops t) "\\>"))
+ (concat "\\_<" (regexp-opt ops t) "\\_>"))
"Regexp of PostScript operators that will be fontified.")
;; Level 1 font-lock:
@@ -214,13 +212,9 @@ If nil, use `temporary-file-directory'."
;; - 8bit characters (warning face)
;; Multiline strings are not supported. Strings with nested brackets are.
(defconst ps-mode-font-lock-keywords-1
- '(("\\`%!PS.*" . font-lock-constant-face)
+ '(("\\`%!PS.*" (0 font-lock-constant-face t))
("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$"
- . font-lock-constant-face)
- (ps-mode-match-string-or-comment
- (1 font-lock-comment-face nil t)
- (2 font-lock-string-face nil t))
- ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face)
+ (0 font-lock-constant-face t))
("[\200-\377]+" (0 font-lock-warning-face prepend nil)))
"Subdued level highlighting for PostScript mode.")
@@ -255,19 +249,17 @@ If nil, use `temporary-file-directory'."
;; Names are fontified before PostScript operators, allowing the use of
;; a more simple (efficient) regexp than the one used in level 2.
(defconst ps-mode-font-lock-keywords-3
- (append
- ps-mode-font-lock-keywords-1
- (list
- '("//\\w+" . font-lock-type-face)
- `(,(concat
- "^\\(/\\w+\\)\\>"
- "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name.
- "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name.
- "\\|[ \t]+[0-9]+[ \t]+dict\\>" ; `[0-9]+ dict' following the name.
- "\\|.*\\<def\\>\\)") ; `def' somewhere on the same line.
- . (1 font-lock-function-name-face))
- '("/\\w+" . font-lock-variable-name-face)
- (cons ps-mode-operators 'font-lock-keyword-face)))
+ `(,@ps-mode-font-lock-keywords-1
+ ("//\\(?:\\sw\\|\\s_\\)+" . font-lock-type-face)
+ (,(concat
+ "^\\(/\\(?:\\sw\\|\\s_\\)+\\)\\_>"
+ "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name.
+ "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name.
+ "\\|[ \t]+[0-9]+[ \t]+dict\\_>" ; `[0-9]+ dict' following the name.
+ "\\|.*\\_<def\\_>\\)") ; `def' somewhere on the same line.
+ . (1 font-lock-function-name-face))
+ ("/\\(?:\\sw\\|\\s_\\)+" . font-lock-variable-name-face)
+ (,ps-mode-operators . font-lock-keyword-face))
"High level highlighting for PostScript mode.")
(defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1
@@ -289,13 +281,68 @@ If nil, use `temporary-file-directory'."
;; Variables.
-(defvar ps-mode-map nil
+(defvar ps-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-v" 'ps-run-boundingbox)
+ (define-key map "\C-c\C-u" 'ps-mode-uncomment-region)
+ (define-key map "\C-c\C-t" 'ps-mode-epsf-rich)
+ (define-key map "\C-c\C-s" 'ps-run-start)
+ (define-key map "\C-c\C-r" 'ps-run-region)
+ (define-key map "\C-c\C-q" 'ps-run-quit)
+ (define-key map "\C-c\C-p" 'ps-mode-print-buffer)
+ (define-key map "\C-c\C-o" 'ps-mode-comment-out-region)
+ (define-key map "\C-c\C-k" 'ps-run-kill)
+ (define-key map "\C-c\C-j" 'ps-mode-other-newline)
+ (define-key map "\C-c\C-l" 'ps-run-clear)
+ (define-key map "\C-c\C-b" 'ps-run-buffer)
+ ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
+ (define-key map "\177" 'ps-mode-backward-delete-char)
+ map)
"Local keymap to use in PostScript mode.")
-(defvar ps-mode-syntax-table nil
+(defvar ps-mode-syntax-table
+ (let ((st (make-syntax-table)))
+
+ (modify-syntax-entry ?\% "< " st)
+ (modify-syntax-entry ?\n "> " st)
+ (modify-syntax-entry ?\r "> " st)
+ (modify-syntax-entry ?\f "> " st)
+ (modify-syntax-entry ?\< "(>" st)
+ (modify-syntax-entry ?\> ")<" st)
+
+ (modify-syntax-entry ?\! "_ " st)
+ (modify-syntax-entry ?\" "_ " st)
+ (modify-syntax-entry ?\# "_ " st)
+ (modify-syntax-entry ?\$ "_ " st)
+ (modify-syntax-entry ?\& "_ " st)
+ (modify-syntax-entry ?\' "_ " st)
+ (modify-syntax-entry ?\* "_ " st)
+ (modify-syntax-entry ?\+ "_ " st)
+ (modify-syntax-entry ?\, "_ " st)
+ (modify-syntax-entry ?\- "_ " st)
+ (modify-syntax-entry ?\. "_ " st)
+ (modify-syntax-entry ?\: "_ " st)
+ (modify-syntax-entry ?\; "_ " st)
+ (modify-syntax-entry ?\= "_ " st)
+ (modify-syntax-entry ?\? "_ " st)
+ (modify-syntax-entry ?\@ "_ " st)
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?^ "_ " st) ; NOT: ?\^
+ (modify-syntax-entry ?\_ "_ " st)
+ (modify-syntax-entry ?\` "_ " st)
+ (modify-syntax-entry ?\| "_ " st)
+ (modify-syntax-entry ?\~ "_ " st)
+ st)
"Syntax table used while in PostScript mode.")
-(defvar ps-run-mode-map nil
+(defvar ps-run-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map comint-mode-map)
+ (define-key map "\C-c\C-q" 'ps-run-quit)
+ (define-key map "\C-c\C-k" 'ps-run-kill)
+ (define-key map "\C-c\C-e" 'ps-run-goto-error)
+ (define-key map [mouse-2] 'ps-run-mouse-goto-error)
+ map)
"Local keymap to use in PostScript run mode.")
(defvar ps-mode-tmp-file nil
@@ -365,9 +412,6 @@ If nil, use `temporary-file-directory'."
["8-bit to Octal Buffer" ps-mode-octal-buffer t]
["8-bit to Octal Region" ps-mode-octal-region (mark t)]
"---"
- ["Auto Indent" (setq ps-mode-auto-indent (not ps-mode-auto-indent))
- :style toggle :selected ps-mode-auto-indent]
- "---"
["Start PostScript"
ps-run-start
t]
@@ -404,80 +448,7 @@ If nil, use `temporary-file-directory'."
ps-mode-submit-bug-report
t]))
-
-;; Mode maps for PostScript edit mode and PostScript interaction mode.
-
-(unless ps-mode-map
- (setq ps-mode-map (make-sparse-keymap))
- (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox)
- (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region)
- (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich)
- (define-key ps-mode-map "\C-c\C-s" 'ps-run-start)
- (define-key ps-mode-map "\C-c\C-r" 'ps-run-region)
- (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit)
- (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer)
- (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region)
- (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill)
- (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline)
- (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear)
- (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer)
- (define-key ps-mode-map ">" 'ps-mode-r-gt)
- (define-key ps-mode-map "]" 'ps-mode-r-angle)
- (define-key ps-mode-map "}" 'ps-mode-r-brace)
- (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char)
- (define-key ps-mode-map "\t" 'ps-mode-tabkey)
- (define-key ps-mode-map "\r" 'ps-mode-newline)
- (define-key ps-mode-map [return] 'ps-mode-newline)
- (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main))
-
-(unless ps-run-mode-map
- (setq ps-run-mode-map (make-sparse-keymap))
- (set-keymap-parent ps-run-mode-map comint-mode-map)
- (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit)
- (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill)
- (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error)
- (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error))
-
-
-;; Syntax table.
-
-(unless ps-mode-syntax-table
- (setq ps-mode-syntax-table (make-syntax-table))
-
- (modify-syntax-entry ?\% "< " ps-mode-syntax-table)
- (modify-syntax-entry ?\n "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\r "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\f "> " ps-mode-syntax-table)
- (modify-syntax-entry ?\< "(>" ps-mode-syntax-table)
- (modify-syntax-entry ?\> ")<" ps-mode-syntax-table)
-
- (modify-syntax-entry ?\! "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\" "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\# "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\$ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\& "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\' "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\* "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\+ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\, "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\- "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\. "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\: "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\; "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\= "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\? "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\@ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\\ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^
- (modify-syntax-entry ?\_ "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\` "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\| "w " ps-mode-syntax-table)
- (modify-syntax-entry ?\~ "w " ps-mode-syntax-table)
-
- (let ((i 128))
- (while (< i 256)
- (modify-syntax-entry i "w " ps-mode-syntax-table)
- (setq i (1+ i)))))
+(easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)
@@ -485,6 +456,13 @@ If nil, use `temporary-file-directory'."
;; PostScript mode.
+(defun ps-mode-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:after . "<") (when (smie-rule-next-p "<") 0))
+ (`(:elem . basic) ps-mode-tab)
+ (`(:close-all . ">") t)
+ (`(:list-intro . ,_) t)))
+
;;;###autoload
(define-derived-mode ps-mode prog-mode "PostScript"
"Major mode for editing PostScript with GNU Emacs.
@@ -494,7 +472,6 @@ Entry to this mode calls `ps-mode-hook'.
The following variables hold user options, and can
be set through the `customize' command:
- `ps-mode-auto-indent'
`ps-mode-tab'
`ps-mode-paper-size'
`ps-mode-print-function'
@@ -524,12 +501,16 @@ with a file position. Clicking mouse-2 on this number will bring
point to the corresponding spot in the PostScript window, if input
to the interpreter was sent from that window.
Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect."
+ (setq-local syntax-propertize-function #'ps-mode-syntax-propertize)
(set (make-local-variable 'font-lock-defaults)
'((ps-mode-font-lock-keywords
ps-mode-font-lock-keywords-1
ps-mode-font-lock-keywords-2
ps-mode-font-lock-keywords-3)
- t))
+ nil))
+ (smie-setup nil #'ps-mode-smie-rules)
+ (setq-local electric-indent-chars
+ (append '(?> ?\] ?\}) electric-indent-chars))
(set (make-local-variable 'comment-start) "%")
;; NOTE: `\' has a special meaning in strings only
(set (make-local-variable 'comment-start-skip) "%+[ \t]*")
@@ -556,8 +537,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
(reporter-submit-bug-report
ps-mode-maintainer-address
(format "ps-mode.el %s [%s]" ps-mode-version system-type)
- '(ps-mode-auto-indent
- ps-mode-tab
+ '(ps-mode-tab
ps-mode-paper-size
ps-mode-print-function
ps-run-prompt
@@ -571,53 +551,54 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number
;; Helper functions for font-lock.
-;; When this function is called, point is at an opening bracket.
-;; This function should test if point is at the start of a string
-;; with nested brackets.
-;; If true: move point to end of string
-;; set string to match data nr 2
-;; return new point
-;; If false: return nil
-(defun ps-mode-looking-at-nested (limit)
- (let ((first (point))
- (level 1)
- pos)
- ;; Move past opening bracket.
- (forward-char 1)
- (setq pos (point))
- (while (and (> level 0) (< pos limit))
- ;; Search next bracket, stepping over escaped brackets.
- (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)"))
- (setq level -1)
- (setq level (+ level (if (string= "(" (match-string 2)) 1 -1)))
- (goto-char (setq pos (match-end 0)))))
- (if (not (= level 0))
- nil
- ;; Found string with nested brackets, now set match data nr 2.
- (set-match-data (list first pos nil nil first pos))
- pos)))
-
-;; This function should search for a string or comment
-;; If comment, return as match data nr 1
-;; If string, return as match data nr 2
-(defun ps-mode-match-string-or-comment (limit)
- ;; Find the first potential match.
- (if (not (re-search-forward "[%(]" limit t))
- ;; Nothing found: return failure.
- nil
- (let ((end (match-end 0)))
- (goto-char (match-beginning 0))
- (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)")
- ;; It's a comment or string without nested, unescaped brackets.
- (goto-char (match-end 0))
- (point))
- ((ps-mode-looking-at-nested limit)
- ;; It's a string with nested brackets.
- (point))
- (t
- ;; Try next match.
- (goto-char end)
- (ps-mode-match-string-or-comment limit))))))
+(defconst ps-mode--string-syntax-table
+ (let ((st (make-syntax-table ps-mode-syntax-table)))
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?\{ "." st)
+ (modify-syntax-entry ?\} "." st)
+ (modify-syntax-entry ?\[ "." st)
+ (modify-syntax-entry ?\] "." st)
+ st))
+
+(defun ps-mode--syntax-propertize-special (end)
+ (let ((ppss (syntax-ppss))
+ char)
+ (cond
+ ((not (nth 3 ppss))) ;Not in (...), <~..base85..~>, or <..hex..>.
+ ((eq ?\( (setq char (char-after (nth 8 ppss))))
+ (save-restriction
+ (narrow-to-region (point-min) end)
+ (goto-char (nth 8 ppss))
+ (condition-case nil
+ (with-syntax-table ps-mode--string-syntax-table
+ (let ((parse-sexp-lookup-properties nil))
+ (forward-sexp 1))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "|")))
+ (scan-error (goto-char end)))))
+ ((eq char ?<)
+ (when (re-search-forward (if (eq ?~ (char-after (1+ (nth 8 ppss))))
+ "~>" ">")
+ end 'move)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "|")))))))
+
+(defun ps-mode-syntax-propertize (start end)
+ (goto-char start)
+ (ps-mode--syntax-propertize-special end)
+ (funcall
+ (syntax-propertize-rules
+ ("\\(<\\)\\(?:~\\|[ \n\t]*[[:xdigit:]]\\)\\|\\(?1:(\\)"
+ (1 (unless (or (eq (char-after (match-beginning 0))
+ (char-before (match-beginning 0))) ;Avoid "<<".
+ (nth 8 (save-excursion (syntax-ppss (match-beginning 1)))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "|"))
+ (ps-mode--syntax-propertize-special end)
+ nil))))
+ (point) end))
;; Key-handlers.
@@ -655,34 +636,12 @@ defines the beginning of a group. These tokens are: { [ <<"
(setq target (+ target ps-mode-tab)))
target)))))
-(defun ps-mode-newline ()
- "Insert newline with proper indentation."
- (interactive)
- (delete-horizontal-space)
- (insert "\n")
- (if ps-mode-auto-indent
- (indent-to (ps-mode-target-column))))
-
-(defun ps-mode-tabkey ()
- "Indent/reindent current line, or insert tab."
- (interactive)
- (let ((column (current-column))
- target)
- (if (or (not ps-mode-auto-indent)
- (< ps-mode-tab 1)
- (not (re-search-backward "^[ \t]*\\=" nil t)))
- (insert "\t")
- (setq target (ps-mode-target-column))
- (while (<= target column)
- (setq target (+ target ps-mode-tab)))
- (indent-line-to target))))
-
(defun ps-mode-backward-delete-char ()
"Delete backward indentation, or delete backward character."
(interactive)
(let ((column (current-column))
target)
- (if (or (not ps-mode-auto-indent)
+ (if (or (not electric-indent-mode)
(< ps-mode-tab 1)
(not (re-search-backward "^[ \t]+\\=" nil t)))
(call-interactively 'delete-backward-char)
@@ -695,32 +654,6 @@ defines the beginning of a group. These tokens are: { [ <<"
(setq target 0))
(indent-line-to target))))
-(defun ps-mode-r-brace ()
- "Insert `}' and perform balance."
- (interactive)
- (insert "}")
- (ps-mode-r-balance "}"))
-
-(defun ps-mode-r-angle ()
- "Insert `]' and perform balance."
- (interactive)
- (insert "]")
- (ps-mode-r-balance "]"))
-
-(defun ps-mode-r-gt ()
- "Insert `>' and perform balance."
- (interactive)
- (insert ">")
- (ps-mode-r-balance ">>"))
-
-(defun ps-mode-r-balance (right)
- "Adjust indenting if point after RIGHT."
- (if ps-mode-auto-indent
- (save-excursion
- (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t)
- (indent-line-to (ps-mode-target-column)))))
- (blink-matching-open))
-
(defun ps-mode-other-newline ()
"Perform newline in `*ps-run*' buffer."
(interactive)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 01833ffd70b..6ff12b54976 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1,11 +1,12 @@
-;;; python.el --- Python's flying circus support for Emacs
+;;; python.el --- Python's flying circus support for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
-;; Author: Fabián E. Gallina <fabian@anue.biz>
+;; Author: Fabián E. Gallina <fgallina@gnu.org>
;; URL: https://github.com/fgallina/python.el
-;; Version: 0.24.2
-;; Maintainer: FSF
+;; Version: 0.25.1
+;; Package-Requires: ((emacs "24.1") (cl-lib "1.0"))
+;; Maintainer: emacs-devel@gnu.org
;; Created: Jul 2010
;; Keywords: languages
@@ -31,18 +32,18 @@
;; found in GNU/Emacs.
;; Implements Syntax highlighting, Indentation, Movement, Shell
-;; interaction, Shell completion, Shell virtualenv support, Pdb
-;; tracking, Symbol completion, Skeletons, FFAP, Code Check, Eldoc,
-;; Imenu.
+;; interaction, Shell completion, Shell virtualenv support, Shell
+;; package support, Shell syntax highlighting, Pdb tracking, Symbol
+;; completion, Skeletons, FFAP, Code Check, Eldoc, Imenu.
;; Syntax highlighting: Fontification of code is provided and supports
;; python's triple quoted strings properly.
;; Indentation: Automatic indentation with indentation cycling is
;; provided, it allows you to navigate different available levels of
-;; indentation by hitting <tab> several times. Also when inserting a
-;; colon the `python-indent-electric-colon' command is invoked and
-;; causes the current line to be dedented automatically if needed.
+;; indentation by hitting <tab> several times. Also electric-indent-mode
+;; is supported such that when inserting a colon the current line is
+;; dedented automatically if needed.
;; Movement: `beginning-of-defun' and `end-of-defun' functions are
;; properly implemented. There are also specialized
@@ -52,67 +53,96 @@
;; Extra functions `python-nav-forward-statement',
;; `python-nav-backward-statement',
;; `python-nav-beginning-of-statement', `python-nav-end-of-statement',
-;; `python-nav-beginning-of-block' and `python-nav-end-of-block' are
-;; included but no bound to any key. At last but not least the
-;; specialized `python-nav-forward-sexp' allows easy navigation
-;; between code blocks. If you prefer `cc-mode'-like `forward-sexp'
-;; movement, setting `forward-sexp-function' to nil is enough, You can
-;; do that using the `python-mode-hook':
+;; `python-nav-beginning-of-block', `python-nav-end-of-block' and
+;; `python-nav-if-name-main' are included but no bound to any key. At
+;; last but not least the specialized `python-nav-forward-sexp' allows
+;; easy navigation between code blocks. If you prefer `cc-mode'-like
+;; `forward-sexp' movement, setting `forward-sexp-function' to nil is
+;; enough, You can do that using the `python-mode-hook':
;; (add-hook 'python-mode-hook
;; (lambda () (setq forward-sexp-function nil)))
-;; Shell interaction: is provided and allows you to execute easily any
-;; block of code of your current buffer in an inferior Python process.
+;; Shell interaction: is provided and allows opening Python shells
+;; inside Emacs and executing any block of code of your current buffer
+;; in that inferior Python process.
+
+;; Besides that only the standard CPython (2.x and 3.x) shell and
+;; IPython are officially supported out of the box, the interaction
+;; should support any other readline based Python shells as well
+;; (e.g. Jython and PyPy have been reported to work). You can change
+;; your default interpreter and commandline arguments by setting the
+;; `python-shell-interpreter' and `python-shell-interpreter-args'
+;; variables. This example enables IPython globally:
+
+;; (setq python-shell-interpreter "ipython"
+;; python-shell-interpreter-args "-i")
+
+;; Using the "console" subcommand to start IPython in server-client
+;; mode is known to fail intermittently due a bug on IPython itself
+;; (see URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27').
+;; There seems to be a race condition in the IPython server (A.K.A
+;; kernel) when code is sent while it is still initializing, sometimes
+;; causing the shell to get stalled. With that said, if an IPython
+;; kernel is already running, "console --existing" seems to work fine.
+
+;; Running IPython on Windows needs more tweaking. The way you should
+;; set `python-shell-interpreter' and `python-shell-interpreter-args'
+;; is as follows (of course you need to modify the paths according to
+;; your system):
+
+;; (setq python-shell-interpreter "C:\\Python27\\python.exe"
+;; python-shell-interpreter-args
+;; "-i C:\\Python27\\Scripts\\ipython-script.py")
+
+;; Missing or delayed output used to happen due to differences between
+;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7.
+;; See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To
+;; avoid this, the `python-shell-unbuffered' defaults to non-nil and
+;; controls whether `python-shell-calculate-process-environment'
+;; should set the "PYTHONUNBUFFERED" environment variable on startup:
+;; See URL `https://docs.python.org/3/using/cmdline.html#cmdoption-u'.
+
+;; The interaction relies upon having prompts for input (e.g. ">>> "
+;; and "... " in standard Python shell) and output (e.g. "Out[1]: " in
+;; IPython) detected properly. Failing that Emacs may hang but, in
+;; the case that happens, you can recover with \\[keyboard-quit]. To
+;; avoid this issue, a two-step prompt autodetection mechanism is
+;; provided: the first step is manual and consists of a collection of
+;; regular expressions matching common prompts for Python shells
+;; stored in `python-shell-prompt-input-regexps' and
+;; `python-shell-prompt-output-regexps', and dir-local friendly vars
+;; `python-shell-prompt-regexp', `python-shell-prompt-block-regexp',
+;; `python-shell-prompt-output-regexp' which are appended to the
+;; former automatically when a shell spawns; the second step is
+;; automatic and depends on the `python-shell-prompt-detect' helper
+;; function. See its docstring for details on global variables that
+;; modify its behavior.
;; Shell completion: hitting tab will try to complete the current
-;; word. Shell completion is implemented in a manner that if you
-;; change the `python-shell-interpreter' to any other (for example
-;; IPython) it should be easy to integrate another way to calculate
-;; completions. You just need to specify your custom
-;; `python-shell-completion-setup-code' and
-;; `python-shell-completion-string-code'.
-
-;; Here is a complete example of the settings you would use for
-;; iPython 0.11:
-
-;; (setq
-;; python-shell-interpreter "ipython"
-;; python-shell-interpreter-args ""
-;; python-shell-prompt-regexp "In \\[[0-9]+\\]: "
-;; python-shell-prompt-output-regexp "Out\\[[0-9]+\\]: "
-;; python-shell-completion-setup-code
-;; "from IPython.core.completerlib import module_completion"
-;; python-shell-completion-module-string-code
-;; "';'.join(module_completion('''%s'''))\n"
-;; python-shell-completion-string-code
-;; "';'.join(get_ipython().Completer.all_completions('''%s'''))\n")
-
-;; For iPython 0.10 everything would be the same except for
-;; `python-shell-completion-string-code' and
-;; `python-shell-completion-module-string-code':
-
-;; (setq python-shell-completion-string-code
-;; "';'.join(__IP.complete('''%s'''))\n"
-;; python-shell-completion-module-string-code "")
-
-;; Unfortunately running iPython on Windows needs some more tweaking.
-;; The way you must set `python-shell-interpreter' and
-;; `python-shell-interpreter-args' is as follows:
-
-;; (setq
-;; python-shell-interpreter "C:\\Python27\\python.exe"
-;; python-shell-interpreter-args
-;; "-i C:\\Python27\\Scripts\\ipython-script.py")
-
-;; That will spawn the iPython process correctly (Of course you need
-;; to modify the paths according to your system).
-
-;; Please note that the default completion system depends on the
-;; readline module, so if you are using some Operating System that
-;; bundles Python without it (like Windows) just install the
-;; pyreadline from http://ipython.scipy.org/moin/PyReadline/Intro and
-;; you should be good to go.
+;; word. The two built-in mechanisms depend on Python's readline
+;; module: the "native" completion is tried first and is activated
+;; when `python-shell-completion-native-enable' is non-nil, the
+;; current `python-shell-interpreter' is not a member of the
+;; `python-shell-completion-native-disabled-interpreters' variable and
+;; `python-shell-completion-native-setup' succeeds; the "fallback" or
+;; "legacy" mechanism works by executing Python code in the background
+;; and enables auto-completion for shells that do not support
+;; receiving escape sequences (with some limitations, i.e. completion
+;; in blocks does not work). The code executed for the "fallback"
+;; completion can be found in `python-shell-completion-setup-code' and
+;; `python-shell-completion-string-code' variables. Their default
+;; 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')
+;; should suffice. To troubleshoot why you are not getting any
+;; completions, you can try the following in your Python shell:
+
+;; >>> import readline, rlcompleter
+
+;; If you see an error, then you need to either install pyreadline or
+;; setup custom code that avoids that dependency.
;; Shell virtualenv support: The shell also contains support for
;; virtualenvs and other special environment modifications thanks to
@@ -135,18 +165,34 @@
;; (python-shell-exec-path . ("/path/to/env/bin/"))
;; Since the above is cumbersome and can be programmatically
-;; calculated, the variable `python-shell-virtualenv-path' is
+;; calculated, the variable `python-shell-virtualenv-root' is
;; provided. When this variable is set with the path of the
;; virtualenv to use, `process-environment' and `exec-path' get proper
;; values in order to run shells inside the specified virtualenv. So
;; the following will achieve the same as the previous example:
-;; (setq python-shell-virtualenv-path "/path/to/env/")
+;; (setq python-shell-virtualenv-root "/path/to/env/")
;; Also the `python-shell-extra-pythonpaths' variable have been
;; introduced as simple way of adding paths to the PYTHONPATH without
;; affecting existing values.
+;; Shell package support: you can enable a package in the current
+;; shell so that relative imports work properly using the
+;; `python-shell-package-enable' command.
+
+;; Shell remote support: remote Python shells are started with the
+;; correct environment for files opened remotely through tramp, also
+;; respecting dir-local variables provided `enable-remote-dir-locals'
+;; is non-nil. The logic for this is transparently handled by the
+;; `python-shell-with-environment' macro.
+
+;; Shell syntax highlighting: when enabled current input in shell is
+;; highlighted. The variable `python-shell-font-lock-enable' controls
+;; activation of this feature globally when shells are started.
+;; Activation/deactivation can be also controlled on the fly via the
+;; `python-shell-font-lock-toggle' command.
+
;; Pdb tracking: when you execute a block of code that contains some
;; call to pdb (or ipdb) it will prompt the block of code and will
;; follow the execution of pdb marking the current line with an arrow.
@@ -155,15 +201,13 @@
;; the shell completion in background so you should run
;; `python-shell-send-buffer' from time to time to get better results.
-;; Skeletons: 6 skeletons are provided for simple inserting of class,
-;; def, for, if, try and while. These skeletons are integrated with
-;; abbrev. If you have `abbrev-mode' activated and
+;; Skeletons: skeletons are provided for simple inserting of things like class,
+;; def, for, import, if, try, and while. These skeletons are
+;; integrated with abbrev. If you have `abbrev-mode' activated and
;; `python-skeleton-autoinsert' is set to t, then whenever you type
;; the name of any of those defined and hit SPC, they will be
;; automatically expanded. As an alternative you can use the defined
-;; skeleton commands: `python-skeleton-class', `python-skeleton-def'
-;; `python-skeleton-for', `python-skeleton-if', `python-skeleton-try'
-;; and `python-skeleton-while'.
+;; skeleton commands: `python-skeleton-<foo>'.
;; FFAP: You can find the filename for a given module when using ffap
;; out of the box. This feature needs an inferior python shell
@@ -180,17 +224,19 @@
;; Imenu: There are two index building functions to be used as
;; `imenu-create-index-function': `python-imenu-create-index' (the
;; default one, builds the alist in form of a tree) and
-;; `python-imenu-create-flat-index'. See also
+;; `python-imenu-create-flat-index'. See also
;; `python-imenu-format-item-label-function',
;; `python-imenu-format-parent-item-label-function',
;; `python-imenu-format-parent-item-jump-label-function' variables for
;; changing the way labels are formatted in the tree version.
-;; If you used python-mode.el you probably will miss auto-indentation
-;; when inserting newlines. To achieve the same behavior you have
-;; two options:
+;; If you used python-mode.el you may miss auto-indentation when
+;; inserting newlines. To achieve the same behavior you have two
+;; options:
-;; 1) Use GNU/Emacs' standard binding for `newline-and-indent': C-j.
+;; 1) Enable the minor-mode `electric-indent-mode' (enabled by
+;; default) and use RET. If this mode is disabled use
+;; `newline-and-indent', bound to C-j.
;; 2) Add the following hook in your .emacs:
@@ -213,7 +259,10 @@
;;; Code:
(require 'ansi-color)
+(require 'cl-lib)
(require 'comint)
+(require 'json)
+(require 'tramp-sh)
;; Avoid compiler warnings
(defvar view-return-to-alist)
@@ -221,11 +270,12 @@
(defvar outline-heading-end-regexp)
(autoload 'comint-mode "comint")
+(autoload 'help-function-arglist "help-fns")
;;;###autoload
(add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode))
;;;###autoload
-(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode))
+(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
(defgroup python nil
"Python Language's flying circus support for Emacs."
@@ -233,6 +283,18 @@
:version "24.3"
:link '(emacs-commentary-link "python"))
+
+;;; 24.x Compat
+
+
+(unless (fboundp 'prog-widen)
+ (defun prog-widen ()
+ (widen)))
+
+(unless (fboundp 'prog-first-column)
+ (defun prog-first-column ()
+ 0))
+
;;; Bindings
@@ -242,18 +304,19 @@
(define-key map [remap backward-sentence] 'python-nav-backward-block)
(define-key map [remap forward-sentence] 'python-nav-forward-block)
(define-key map [remap backward-up-list] 'python-nav-backward-up-list)
+ (define-key map [remap mark-defun] 'python-mark-defun)
(define-key map "\C-c\C-j" 'imenu)
;; Indent specific
(define-key map "\177" 'python-indent-dedent-line-backspace)
(define-key map (kbd "<backtab>") 'python-indent-dedent-line)
(define-key map "\C-c<" 'python-indent-shift-left)
(define-key map "\C-c>" 'python-indent-shift-right)
- (define-key map ":" 'python-indent-electric-colon)
;; Skeletons
(define-key map "\C-c\C-tc" 'python-skeleton-class)
(define-key map "\C-c\C-td" 'python-skeleton-def)
(define-key map "\C-c\C-tf" 'python-skeleton-for)
(define-key map "\C-c\C-ti" 'python-skeleton-if)
+ (define-key map "\C-c\C-tm" 'python-skeleton-import)
(define-key map "\C-c\C-tt" 'python-skeleton-try)
(define-key map "\C-c\C-tw" 'python-skeleton-while)
;; Shell interaction
@@ -317,12 +380,19 @@
;;; Python specialized rx
-(eval-when-compile
+(eval-and-compile
(defconst python-rx-constituents
`((block-start . ,(rx symbol-start
(or "def" "class" "if" "elif" "else" "try"
"except" "finally" "for" "while" "with")
symbol-end))
+ (dedenter . ,(rx symbol-start
+ (or "elif" "else" "except" "finally")
+ symbol-end))
+ (block-ender . ,(rx symbol-start
+ (or
+ "break" "continue" "pass" "raise" "return")
+ symbol-end))
(decorator . ,(rx line-start (* space) ?@ (any letter ?_)
(* (any word ?_))))
(defun . ,(rx symbol-start (or "def" "class") symbol-end))
@@ -353,12 +423,23 @@
(* ?\\ ?\\) (any ?\' ?\")))
(* ?\\ ?\\)
;; Match single or triple quotes of any kind.
- (group (or "\"" "\"\"\"" "'" "'''"))))))
+ (group (or "\"" "\"\"\"" "'" "'''")))))
+ (coding-cookie . ,(rx line-start ?# (* space)
+ (or
+ ;; # coding=<encoding name>
+ (: "coding" (or ?: ?=) (* space) (group-n 1 (+ (or word ?-))))
+ ;; # -*- coding: <encoding name> -*-
+ (: "-*-" (* space) "coding:" (* space)
+ (group-n 1 (+ (or word ?-))) (* space) "-*-")
+ ;; # vim: set fileencoding=<encoding name> :
+ (: "vim:" (* space) "set" (+ space)
+ "fileencoding" (* space) ?= (* space)
+ (group-n 1 (+ (or word ?-))) (* space) ":")))))
"Additional Python specific sexps for `python-rx'")
(defmacro python-rx (&rest regexps)
"Python mode specialized rx macro.
-This variant of `rx' supports common python named REGEXPS."
+This variant of `rx' supports common Python named REGEXPS."
(let ((rx-constituents (append python-rx-constituents rx-constituents)))
(cond ((null regexps)
(error "No regexp"))
@@ -370,7 +451,7 @@ This variant of `rx' supports common python named REGEXPS."
;;; Font-lock and syntax
-(eval-when-compile
+(eval-and-compile
(defun python-syntax--context-compiler-macro (form type &optional syntax-ppss)
(pcase type
(`'comment
@@ -403,9 +484,14 @@ The type returned can be `comment', `string' or `paren'."
((nth 8 ppss) (if (nth 4 ppss) 'comment 'string))
((nth 1 ppss) 'paren))))
-(defsubst python-syntax-comment-or-string-p ()
- "Return non-nil if point is inside 'comment or 'string."
- (nth 8 (syntax-ppss)))
+(defsubst python-syntax-comment-or-string-p (&optional ppss)
+ "Return non-nil if PPSS is inside 'comment or 'string."
+ (nth 8 (or ppss (syntax-ppss))))
+
+(defsubst python-syntax-closing-paren-p ()
+ "Return non-nil if char after point is a closing paren."
+ (= (syntax-class (syntax-after (point)))
+ (syntax-class (string-to-syntax ")"))))
(define-obsolete-function-alias
'python-info-ppss-context #'python-syntax-context "24.3")
@@ -417,6 +503,14 @@ The type returned can be `comment', `string' or `paren'."
'python-info-ppss-comment-or-string-p
#'python-syntax-comment-or-string-p "24.3")
+(defun python-font-lock-syntactic-face-function (state)
+ "Return syntactic face given STATE."
+ (if (nth 3 state)
+ (if (python-info-docstring-p state)
+ font-lock-doc-face
+ font-lock-string-face)
+ font-lock-comment-face))
+
(defvar python-font-lock-keywords
;; Keywords
`(,(rx symbol-start
@@ -501,29 +595,24 @@ The type returned can be `comment', `string' or `paren'."
(,(lambda (limit)
(let ((re (python-rx (group (+ (any word ?. ?_)))
(? ?\[ (+ (not (any ?\]))) ?\]) (* space)
- assignment-operator)))
- (when (re-search-forward re limit t)
- (while (and (python-syntax-context 'paren)
- (re-search-forward re limit t)))
- (if (not (or (python-syntax-context 'paren)
- (equal (char-after (point-marker)) ?=)))
- t
- (set-match-data nil)))))
+ assignment-operator))
+ (res nil))
+ (while (and (setq res (re-search-forward re limit t))
+ (or (python-syntax-context 'paren)
+ (equal (char-after (point)) ?=))))
+ res))
(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)
- assignment-operator)))
- (when (and (re-search-forward re limit t)
- (goto-char (nth 3 (match-data))))
- (while (and (python-syntax-context 'paren)
- (re-search-forward re limit t))
- (goto-char (nth 3 (match-data))))
- (if (not (python-syntax-context 'paren))
- t
- (set-match-data nil)))))
+ assignment-operator))
+ (res nil))
+ (while (and (setq res (re-search-forward re limit t))
+ (goto-char (match-end 1))
+ (python-syntax-context 'paren)))
+ res))
(1 font-lock-variable-name-face nil nil))))
(defconst python-syntax-propertize-function
@@ -531,10 +620,15 @@ The type returned can be `comment', `string' or `paren'."
((python-rx string-delimiter)
(0 (ignore (python-syntax-stringify))))))
+(defconst python--prettify-symbols-alist
+ '(("lambda" . ?λ)
+ ("and" . ?∧)
+ ("or" . ?∨)))
+
(defsubst python-syntax-count-quotes (quote-char &optional point limit)
"Count number of quotes around point (max is 3).
QUOTE-CHAR is the quote char to count. Optional argument POINT is
-the point where scan starts (defaults to current point) and LIMIT
+the point where scan starts (defaults to current point), and LIMIT
is used to limit the scan."
(let ((i 0))
(while (and (< i 3)
@@ -619,6 +713,12 @@ It makes underscores and dots word constituent chars.")
:group 'python
:safe 'booleanp)
+(defcustom python-indent-guess-indent-offset-verbose t
+ "Non-nil means to emit a warning when indentation guessing fails."
+ :type 'boolean
+ :group 'python
+ :safe' booleanp)
+
(defcustom python-indent-trigger-commands
'(indent-for-tab-command yas-expand yas/expand)
"Commands that might trigger a `python-indent-line' call."
@@ -632,29 +732,35 @@ It makes underscores and dots word constituent chars.")
'python-guess-indent 'python-indent-guess-indent-offset "24.3")
(defvar python-indent-current-level 0
- "Current indentation level `python-indent-line-function' is using.")
+ "Deprecated var available for compatibility.")
(defvar python-indent-levels '(0)
- "Levels of indentation available for `python-indent-line-function'.")
-
-(defvar python-indent-dedenters '("else" "elif" "except" "finally")
- "List of words that should be dedented.
-These make `python-indent-calculate-indentation' subtract the value of
-`python-indent-offset'.")
-
-(defvar python-indent-block-enders
- '("break" "continue" "pass" "raise" "return")
- "List of words that mark the end of a block.
-These make `python-indent-calculate-indentation' subtract the
-value of `python-indent-offset' when `python-indent-context' is
-AFTER-LINE.")
+ "Deprecated var available for compatibility.")
+
+(make-obsolete-variable
+ 'python-indent-current-level
+ "The indentation API changed to avoid global state.
+The function `python-indent-calculate-levels' does not use it
+anymore. If you were defadvising it and or depended on this
+variable for indentation customizations, refactor your code to
+work on `python-indent-calculate-indentation' instead."
+ "24.5")
+
+(make-obsolete-variable
+ 'python-indent-levels
+ "The indentation API changed to avoid global state.
+The function `python-indent-calculate-levels' does not use it
+anymore. If you were defadvising it and or depended on this
+variable for indentation customizations, refactor your code to
+work on `python-indent-calculate-indentation' instead."
+ "24.5")
(defun python-indent-guess-indent-offset ()
"Guess and set `python-indent-offset' for the current buffer."
(interactive)
(save-excursion
(save-restriction
- (widen)
+ (prog-widen)
(goto-char (point-min))
(let ((block-end))
(while (and (not block-end)
@@ -681,321 +787,365 @@ AFTER-LINE.")
(goto-char block-end)
(python-util-forward-comment)
(current-indentation))))
- (if indentation
+ (if (and indentation (not (zerop indentation)))
(set (make-local-variable 'python-indent-offset) indentation)
- (message "Can't guess python-indent-offset, using defaults: %s"
- python-indent-offset)))))))
+ (when python-indent-guess-indent-offset-verbose
+ (message "Can't guess python-indent-offset, using defaults: %s"
+ python-indent-offset))))))))
(defun python-indent-context ()
- "Get information on indentation context.
-Context information is returned with a cons with the form:
- \(STATUS . START)
-
-Where status can be any of the following symbols:
- * inside-paren: If point in between (), {} or []
- * inside-string: If point is inside a string
- * after-backslash: Previous line ends in a backslash
- * after-beginning-of-block: Point is after beginning of block
- * after-line: Point is after normal line
- * no-indent: Point is at beginning of buffer or other special case
-START is the buffer position where the sexp starts."
+ "Get information about the current indentation context.
+Context is returned in a cons with the form (STATUS . START).
+
+STATUS can be one of the following:
+
+keyword
+-------
+
+:after-comment
+ - Point is after a comment line.
+ - START is the position of the \"#\" character.
+:inside-string
+ - Point is inside string.
+ - START is the position of the first quote that starts it.
+:no-indent
+ - No possible indentation case matches.
+ - START is always zero.
+
+:inside-paren
+ - Fallback case when point is inside paren.
+ - START is the first non space char position *after* the open paren.
+:inside-paren-at-closing-nested-paren
+ - Point is on a line that contains a nested paren closer.
+ - START is the position of the open paren it closes.
+:inside-paren-at-closing-paren
+ - Point is on a line that contains a paren closer.
+ - START is the position of the open paren.
+:inside-paren-newline-start
+ - Point is inside a paren with items starting in their own line.
+ - START is the position of the open paren.
+:inside-paren-newline-start-from-block
+ - Point is inside a paren with items starting in their own line
+ from a block start.
+ - START is the position of the open paren.
+
+:after-backslash
+ - Fallback case when point is after backslash.
+ - START is the char after the position of the backslash.
+:after-backslash-assignment-continuation
+ - Point is after a backslashed assignment.
+ - START is the char after the position of the backslash.
+:after-backslash-block-continuation
+ - Point is after a backslashed block continuation.
+ - START is the char after the position of the backslash.
+:after-backslash-dotted-continuation
+ - Point is after a backslashed dotted continuation. Previous
+ line must contain a dot to align with.
+ - START is the char after the position of the backslash.
+:after-backslash-first-line
+ - First line following a backslashed continuation.
+ - START is the char after the position of the backslash.
+
+:after-block-end
+ - Point is after a line containing a block ender.
+ - START is the position where the ender starts.
+:after-block-start
+ - Point is after a line starting a block.
+ - START is the position where the block starts.
+:after-line
+ - Point is after a simple line.
+ - START is the position where the previous line starts.
+:at-dedenter-block-start
+ - Point is on a line starting a dedenter block.
+ - START is the position where the dedenter block starts."
(save-restriction
- (widen)
- (let ((ppss (save-excursion (beginning-of-line) (syntax-ppss)))
- (start))
- (cons
- (cond
- ;; Beginning of buffer
- ((save-excursion
- (goto-char (line-beginning-position))
- (bobp))
- 'no-indent)
- ;; Inside string
- ((setq start (python-syntax-context 'string ppss))
- 'inside-string)
- ;; Inside a paren
- ((setq start (python-syntax-context 'paren ppss))
- 'inside-paren)
- ;; After backslash
- ((setq start (when (not (or (python-syntax-context 'string ppss)
- (python-syntax-context 'comment ppss)))
- (let ((line-beg-pos (line-number-at-pos)))
- (python-info-line-ends-backslash-p
- (1- line-beg-pos)))))
- 'after-backslash)
- ;; After beginning of block
- ((setq start (save-excursion
- (when (progn
- (back-to-indentation)
- (python-util-forward-comment -1)
- (equal (char-before) ?:))
- ;; Move to the first block start that's not in within
- ;; a string, comment or paren and that's not a
- ;; continuation line.
- (while (and (re-search-backward
- (python-rx block-start) nil t)
- (or
- (python-syntax-context-type)
- (python-info-continuation-line-p))))
- (when (looking-at (python-rx block-start))
- (point-marker)))))
- 'after-beginning-of-block)
- ;; After normal line
- ((setq start (save-excursion
+ (prog-widen)
+ (let ((ppss (save-excursion
+ (beginning-of-line)
+ (syntax-ppss))))
+ (cond
+ ;; Beginning of buffer.
+ ((= (line-number-at-pos) 1)
+ (cons :no-indent 0))
+ ;; Inside a string.
+ ((let ((start (python-syntax-context 'string ppss)))
+ (when start
+ (cons (if (python-info-docstring-p)
+ :inside-docstring
+ :inside-string) start))))
+ ;; Inside a paren.
+ ((let* ((start (python-syntax-context 'paren ppss))
+ (starts-in-newline
+ (when start
+ (save-excursion
+ (goto-char start)
+ (forward-char)
+ (not
+ (= (line-number-at-pos)
+ (progn
+ (python-util-forward-comment)
+ (line-number-at-pos))))))))
+ (when start
+ (cond
+ ;; Current line only holds the closing paren.
+ ((save-excursion
+ (skip-syntax-forward " ")
+ (when (and (python-syntax-closing-paren-p)
+ (progn
+ (forward-char 1)
+ (not (python-syntax-context 'paren))))
+ (cons :inside-paren-at-closing-paren start))))
+ ;; Current line only holds a closing paren for nested.
+ ((save-excursion
+ (back-to-indentation)
+ (python-syntax-closing-paren-p))
+ (cons :inside-paren-at-closing-nested-paren start))
+ ;; This line starts from a opening block in its own line.
+ ((save-excursion
+ (goto-char start)
+ (when (and
+ starts-in-newline
+ (save-excursion
+ (back-to-indentation)
+ (looking-at (python-rx block-start))))
+ (cons
+ :inside-paren-newline-start-from-block start))))
+ (starts-in-newline
+ (cons :inside-paren-newline-start start))
+ ;; General case.
+ (t (cons :inside-paren
+ (save-excursion
+ (goto-char (1+ start))
+ (skip-syntax-forward "(" 1)
+ (skip-syntax-forward " ")
+ (point))))))))
+ ;; After backslash.
+ ((let ((start (when (not (python-syntax-comment-or-string-p ppss))
+ (python-info-line-ends-backslash-p
+ (1- (line-number-at-pos))))))
+ (when start
+ (cond
+ ;; Continuation of dotted expression.
+ ((save-excursion
+ (back-to-indentation)
+ (when (eq (char-after) ?\.)
+ ;; Move point back until it's not inside a paren.
+ (while (prog2
+ (forward-line -1)
+ (and (not (bobp))
+ (python-syntax-context 'paren))))
+ (goto-char (line-end-position))
+ (while (and (search-backward
+ "." (line-beginning-position) t)
+ (python-syntax-context-type)))
+ ;; Ensure previous statement has dot to align with.
+ (when (and (eq (char-after) ?\.)
+ (not (python-syntax-context-type)))
+ (cons :after-backslash-dotted-continuation (point))))))
+ ;; Continuation of block definition.
+ ((let ((block-continuation-start
+ (python-info-block-continuation-line-p)))
+ (when block-continuation-start
+ (save-excursion
+ (goto-char block-continuation-start)
+ (re-search-forward
+ (python-rx block-start (* space))
+ (line-end-position) t)
+ (cons :after-backslash-block-continuation (point))))))
+ ;; Continuation of assignment.
+ ((let ((assignment-continuation-start
+ (python-info-assignment-continuation-line-p)))
+ (when assignment-continuation-start
+ (save-excursion
+ (goto-char assignment-continuation-start)
+ (cons :after-backslash-assignment-continuation (point))))))
+ ;; First line after backslash continuation start.
+ ((save-excursion
+ (goto-char start)
+ (when (or (= (line-number-at-pos) 1)
+ (not (python-info-beginning-of-backslash
+ (1- (line-number-at-pos)))))
+ (cons :after-backslash-first-line start))))
+ ;; General case.
+ (t (cons :after-backslash start))))))
+ ;; After beginning of block.
+ ((let ((start (save-excursion
(back-to-indentation)
- (skip-chars-backward (rx (or whitespace ?\n)))
- (python-nav-beginning-of-statement)
- (point-marker)))
- 'after-line)
- ;; Do not indent
- (t 'no-indent))
- start))))
-
-(defun python-indent-calculate-indentation ()
- "Calculate correct indentation offset for the current line."
- (let* ((indentation-context (python-indent-context))
- (context-status (car indentation-context))
- (context-start (cdr indentation-context)))
- (save-restriction
- (widen)
- (save-excursion
- (pcase context-status
- (`no-indent 0)
- ;; When point is after beginning of block just add one level
- ;; of indentation relative to the context-start
- (`after-beginning-of-block
- (goto-char context-start)
- (+ (current-indentation) python-indent-offset))
- ;; When after a simple line just use previous line
- ;; indentation, in the case current line starts with a
- ;; `python-indent-dedenters' de-indent one level.
- (`after-line
- (-
- (save-excursion
- (goto-char context-start)
- (current-indentation))
- (if (or (save-excursion
- (back-to-indentation)
- (looking-at (regexp-opt python-indent-dedenters)))
- (save-excursion
+ (python-util-forward-comment -1)
+ (when (equal (char-before) ?:)
+ (python-nav-beginning-of-block)))))
+ (when start
+ (cons :after-block-start start))))
+ ;; At dedenter statement.
+ ((let ((start (python-info-dedenter-statement-p)))
+ (when start
+ (cons :at-dedenter-block-start start))))
+ ;; After normal line, comment or ender (default case).
+ ((save-excursion
+ (back-to-indentation)
+ (skip-chars-backward " \t\n")
+ (if (bobp)
+ (cons :no-indent 0)
+ (python-nav-beginning-of-statement)
+ (cons
+ (cond ((python-info-current-line-comment-p)
+ :after-comment)
+ ((save-excursion
+ (goto-char (line-end-position))
(python-util-forward-comment -1)
(python-nav-beginning-of-statement)
- (member (current-word) python-indent-block-enders)))
- python-indent-offset
- 0)))
- ;; When inside of a string, do nothing. just use the current
- ;; indentation. XXX: perhaps it would be a good idea to
- ;; invoke standard text indentation here
- (`inside-string
- (goto-char context-start)
- (current-indentation))
- ;; After backslash we have several possibilities.
- (`after-backslash
- (cond
- ;; Check if current line is a dot continuation. For this
- ;; the current line must start with a dot and previous
- ;; line must contain a dot too.
- ((save-excursion
- (back-to-indentation)
- (when (looking-at "\\.")
- ;; If after moving one line back point is inside a paren it
- ;; needs to move back until it's not anymore
- (while (prog2
- (forward-line -1)
- (and (not (bobp))
- (python-syntax-context 'paren))))
- (goto-char (line-end-position))
- (while (and (re-search-backward
- "\\." (line-beginning-position) t)
- (python-syntax-context-type)))
- (if (and (looking-at "\\.")
- (not (python-syntax-context-type)))
- ;; The indentation is the same column of the
- ;; first matching dot that's not inside a
- ;; comment, a string or a paren
- (current-column)
- ;; No dot found on previous line, just add another
- ;; indentation level.
- (+ (current-indentation) python-indent-offset)))))
- ;; Check if prev line is a block continuation
- ((let ((block-continuation-start
- (python-info-block-continuation-line-p)))
- (when block-continuation-start
- ;; If block-continuation-start is set jump to that
- ;; marker and use first column after the block start
- ;; as indentation value.
- (goto-char block-continuation-start)
- (re-search-forward
- (python-rx block-start (* space))
- (line-end-position) t)
- (current-column))))
- ;; Check if current line is an assignment continuation
- ((let ((assignment-continuation-start
- (python-info-assignment-continuation-line-p)))
- (when assignment-continuation-start
- ;; If assignment-continuation is set jump to that
- ;; marker and use first column after the assignment
- ;; operator as indentation value.
- (goto-char assignment-continuation-start)
- (current-column))))
- (t
- (forward-line -1)
- (goto-char (python-info-beginning-of-backslash))
- (if (save-excursion
- (and
- (forward-line -1)
- (goto-char
- (or (python-info-beginning-of-backslash) (point)))
- (python-info-line-ends-backslash-p)))
- ;; The two previous lines ended in a backslash so we must
- ;; respect previous line indentation.
- (current-indentation)
- ;; What happens here is that we are dealing with the second
- ;; line of a backslash continuation, in that case we just going
- ;; to add one indentation level.
- (+ (current-indentation) python-indent-offset)))))
- ;; When inside a paren there's a need to handle nesting
- ;; correctly
- (`inside-paren
- (cond
- ;; If current line closes the outermost open paren use the
- ;; current indentation of the context-start line.
- ((save-excursion
- (skip-syntax-forward "\s" (line-end-position))
- (when (and (looking-at (regexp-opt '(")" "]" "}")))
- (progn
- (forward-char 1)
- (not (python-syntax-context 'paren))))
- (goto-char context-start)
- (current-indentation))))
- ;; If open paren is contained on a line by itself add another
- ;; indentation level, else look for the first word after the
- ;; opening paren and use it's column position as indentation
- ;; level.
- ((let* ((content-starts-in-newline)
- (indent
- (save-excursion
- (if (setq content-starts-in-newline
- (progn
- (goto-char context-start)
- (forward-char)
- (save-restriction
- (narrow-to-region
- (line-beginning-position)
- (line-end-position))
- (python-util-forward-comment))
- (looking-at "$")))
- (+ (current-indentation) python-indent-offset)
- (current-column)))))
- ;; Adjustments
- (cond
- ;; If current line closes a nested open paren de-indent one
- ;; level.
- ((progn
- (back-to-indentation)
- (looking-at (regexp-opt '(")" "]" "}"))))
- (- indent python-indent-offset))
- ;; If the line of the opening paren that wraps the current
- ;; line starts a block add another level of indentation to
- ;; follow new pep8 recommendation. See: http://ur1.ca/5rojx
- ((save-excursion
- (when (and content-starts-in-newline
- (progn
- (goto-char context-start)
- (back-to-indentation)
- (looking-at (python-rx block-start))))
- (+ indent python-indent-offset))))
- (t indent)))))))))))
-
-(defun python-indent-calculate-levels ()
- "Calculate `python-indent-levels' and reset `python-indent-current-level'."
- (let* ((indentation (python-indent-calculate-indentation))
- (remainder (% indentation python-indent-offset))
- (steps (/ (- indentation remainder) python-indent-offset)))
- (setq python-indent-levels (list 0))
- (dotimes (step steps)
- (push (* python-indent-offset (1+ step)) python-indent-levels))
- (when (not (eq 0 remainder))
- (push (+ (* python-indent-offset steps) remainder) python-indent-levels))
- (setq python-indent-levels (nreverse python-indent-levels))
- (setq python-indent-current-level (1- (length python-indent-levels)))))
-
-(defun python-indent-toggle-levels ()
- "Toggle `python-indent-current-level' over `python-indent-levels'."
- (setq python-indent-current-level (1- python-indent-current-level))
- (when (< python-indent-current-level 0)
- (setq python-indent-current-level (1- (length python-indent-levels)))))
-
-(defun python-indent-line (&optional force-toggle)
+ (looking-at (python-rx block-ender)))
+ :after-block-end)
+ (t :after-line))
+ (point)))))))))
+
+(defun python-indent--calculate-indentation ()
+ "Internal implementation of `python-indent-calculate-indentation'.
+May return an integer for the maximum possible indentation at
+current context or a list of integers. The latter case is only
+happening for :at-dedenter-block-start context since the
+possibilities can be narrowed to specific indentation points."
+ (save-restriction
+ (prog-widen)
+ (save-excursion
+ (pcase (python-indent-context)
+ (`(:no-indent . ,_) (prog-first-column)) ; usually 0
+ (`(,(or :after-line
+ :after-comment
+ :inside-string
+ :after-backslash
+ :inside-paren-at-closing-paren
+ :inside-paren-at-closing-nested-paren) . ,start)
+ ;; Copy previous indentation.
+ (goto-char start)
+ (current-indentation))
+ (`(:inside-docstring . ,start)
+ (let* ((line-indentation (current-indentation))
+ (base-indent (progn
+ (goto-char start)
+ (current-indentation))))
+ (max line-indentation base-indent)))
+ (`(,(or :after-block-start
+ :after-backslash-first-line
+ :inside-paren-newline-start) . ,start)
+ ;; Add one indentation level.
+ (goto-char start)
+ (+ (current-indentation) python-indent-offset))
+ (`(,(or :inside-paren
+ :after-backslash-block-continuation
+ :after-backslash-assignment-continuation
+ :after-backslash-dotted-continuation) . ,start)
+ ;; Use the column given by the context.
+ (goto-char start)
+ (current-column))
+ (`(:after-block-end . ,start)
+ ;; Subtract one indentation level.
+ (goto-char start)
+ (- (current-indentation) python-indent-offset))
+ (`(:at-dedenter-block-start . ,_)
+ ;; List all possible indentation levels from opening blocks.
+ (let ((opening-block-start-points
+ (python-info-dedenter-opening-block-positions)))
+ (if (not opening-block-start-points)
+ (prog-first-column) ; if not found default to first column
+ (mapcar (lambda (pos)
+ (save-excursion
+ (goto-char pos)
+ (current-indentation)))
+ opening-block-start-points))))
+ (`(,(or :inside-paren-newline-start-from-block) . ,start)
+ ;; Add two indentation levels to make the suite stand out.
+ (goto-char start)
+ (+ (current-indentation) (* python-indent-offset 2)))))))
+
+(defun python-indent--calculate-levels (indentation)
+ "Calculate levels list given INDENTATION.
+Argument INDENTATION can either be an integer or a list of
+integers. Levels are returned in ascending order, and in the
+case INDENTATION is a list, this order is enforced."
+ (if (listp indentation)
+ (sort (copy-sequence indentation) #'<)
+ (nconc (number-sequence (prog-first-column) (1- indentation)
+ python-indent-offset)
+ (list indentation))))
+
+(defun python-indent--previous-level (levels indentation)
+ "Return previous level from LEVELS relative to INDENTATION."
+ (let* ((levels (sort (copy-sequence levels) #'>))
+ (default (car levels)))
+ (catch 'return
+ (dolist (level levels)
+ (when (funcall #'< level indentation)
+ (throw 'return level)))
+ default)))
+
+(defun python-indent-calculate-indentation (&optional previous)
+ "Calculate indentation.
+Get indentation of PREVIOUS level when argument is non-nil.
+Return the max level of the cycle when indentation reaches the
+minimum."
+ (let* ((indentation (python-indent--calculate-indentation))
+ (levels (python-indent--calculate-levels indentation)))
+ (if previous
+ (python-indent--previous-level levels (current-indentation))
+ (if levels
+ (apply #'max levels)
+ (prog-first-column)))))
+
+(defun python-indent-line (&optional previous)
"Internal implementation of `python-indent-line-function'.
-Uses the offset calculated in
-`python-indent-calculate-indentation' and available levels
-indicated by the variable `python-indent-levels' to set the
-current indentation.
+Use the PREVIOUS level when argument is non-nil, otherwise indent
+to the maximum available level. When indentation is the minimum
+possible and PREVIOUS is non-nil, cycle back to the maximum
+level."
+ (let ((follow-indentation-p
+ ;; Check if point is within indentation.
+ (and (<= (line-beginning-position) (point))
+ (>= (+ (line-beginning-position)
+ (current-indentation))
+ (point)))))
+ (save-excursion
+ (indent-line-to
+ (python-indent-calculate-indentation previous))
+ (python-info-dedenter-opening-block-message))
+ (when follow-indentation-p
+ (back-to-indentation))))
-When the variable `last-command' is equal to one of the symbols
-inside `python-indent-trigger-commands' or FORCE-TOGGLE is
-non-nil it cycles levels indicated in the variable
-`python-indent-levels' by setting the current level in the
-variable `python-indent-current-level'.
-
-When the variable `last-command' is not equal to one of the
-symbols inside `python-indent-trigger-commands' and FORCE-TOGGLE
-is nil it calculates possible indentation levels and saves it in
-the variable `python-indent-levels'. Afterwards it sets the
-variable `python-indent-current-level' correctly so offset is
-equal to (`nth' `python-indent-current-level'
-`python-indent-levels')"
- (or
- (and (or (and (memq this-command python-indent-trigger-commands)
- (eq last-command this-command))
- force-toggle)
- (not (equal python-indent-levels '(0)))
- (or (python-indent-toggle-levels) t))
- (python-indent-calculate-levels))
- (let* ((starting-pos (point-marker))
- (indent-ending-position
- (+ (line-beginning-position) (current-indentation)))
- (follow-indentation-p
- (or (bolp)
- (and (<= (line-beginning-position) starting-pos)
- (>= indent-ending-position starting-pos))))
- (next-indent (nth python-indent-current-level python-indent-levels)))
- (unless (= next-indent (current-indentation))
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to next-indent)
- (goto-char starting-pos))
- (and follow-indentation-p (back-to-indentation)))
- (python-info-closing-block-message))
+(defun python-indent-calculate-levels ()
+ "Return possible indentation levels."
+ (python-indent--calculate-levels
+ (python-indent--calculate-indentation)))
(defun python-indent-line-function ()
"`indent-line-function' for Python mode.
-See `python-indent-line' for details."
- (python-indent-line))
+When the variable `last-command' is equal to one of the symbols
+inside `python-indent-trigger-commands' it cycles possible
+indentation levels from right to left."
+ (python-indent-line
+ (and (memq this-command python-indent-trigger-commands)
+ (eq last-command this-command))))
(defun python-indent-dedent-line ()
"De-indent current line."
(interactive "*")
- (when (and (not (python-syntax-comment-or-string-p))
- (<= (point-marker) (save-excursion
- (back-to-indentation)
- (point-marker)))
- (> (current-column) 0))
- (python-indent-line t)
- t))
+ (when (and (not (bolp))
+ (not (python-syntax-comment-or-string-p))
+ (= (current-indentation) (current-column)))
+ (python-indent-line t)
+ t))
(defun python-indent-dedent-line-backspace (arg)
"De-indent current line.
Argument ARG is passed to `backward-delete-char-untabify' when
-point is not in between the indentation."
+point is not in between the indentation."
(interactive "*p")
- (when (not (python-indent-dedent-line))
+ (unless (python-indent-dedent-line)
(backward-delete-char-untabify arg)))
+
(put 'python-indent-dedent-line-backspace 'delete-selection 'supersede)
(defun python-indent-region (start end)
- "Indent a python region automagically.
+ "Indent a Python region automagically.
Called from a program, START and END specify the region to indent."
(let ((deactivate-mark nil))
@@ -1006,24 +1156,35 @@ Called from a program, START and END specify the region to indent."
(or (bolp) (forward-line 1))
(while (< (point) end)
(or (and (bolp) (eolp))
- (let (word)
- (forward-line -1)
- (back-to-indentation)
- (setq word (current-word))
- (forward-line 1)
- (when (and word
- ;; Don't mess with strings, unless it's the
- ;; enclosing set of quotes.
- (or (not (python-syntax-context 'string))
- (eq
- (syntax-after
- (+ (1- (point))
- (current-indentation)
- (python-syntax-count-quotes (char-after) (point))))
- (string-to-syntax "|"))))
- (beginning-of-line)
- (delete-horizontal-space)
- (indent-to (python-indent-calculate-indentation)))))
+ (when (and
+ ;; Skip if previous line is empty or a comment.
+ (save-excursion
+ (let ((line-is-comment-p
+ (python-info-current-line-comment-p)))
+ (forward-line -1)
+ (not
+ (or (and (python-info-current-line-comment-p)
+ ;; Unless this line is a comment too.
+ (not line-is-comment-p))
+ (python-info-current-line-empty-p)))))
+ ;; Don't mess with strings, unless it's the
+ ;; enclosing set of quotes or a docstring.
+ (or (not (python-syntax-context 'string))
+ (eq
+ (syntax-after
+ (+ (1- (point))
+ (current-indentation)
+ (python-syntax-count-quotes (char-after) (point))))
+ (string-to-syntax "|"))
+ (python-info-docstring-p))
+ ;; Skip if current line is a block start, a
+ ;; dedenter or block ender.
+ (save-excursion
+ (back-to-indentation)
+ (not (looking-at
+ (python-rx
+ (or block-start dedenter block-ender))))))
+ (python-indent-line)))
(forward-line 1))
(move-marker end nil))))
@@ -1047,14 +1208,12 @@ any lines in the region are indented less than COUNT columns."
(while (< (point) end)
(if (and (< (current-indentation) count)
(not (looking-at "[ \t]*$")))
- (error "Can't shift all lines enough"))
+ (user-error "Can't shift all lines enough"))
(forward-line))
(indent-rigidly start end (- count))))))
-(add-to-list 'debug-ignored-errors "^Can't shift all lines enough")
-
(defun python-indent-shift-right (start end &optional count)
- "Shift lines contained in region START END by COUNT columns to the left.
+ "Shift lines contained in region START END by COUNT columns to the right.
COUNT defaults to `python-indent-offset'. If region isn't
active, the current line is shifted. The shifted region includes
the lines in which START and END lie."
@@ -1063,48 +1222,74 @@ the lines in which START and END lie."
(list (region-beginning) (region-end) current-prefix-arg)
(list (line-beginning-position) (line-end-position) current-prefix-arg)))
(let ((deactivate-mark nil))
- (if count
- (setq count (prefix-numeric-value count))
- (setq count python-indent-offset))
+ (setq count (if count (prefix-numeric-value count)
+ python-indent-offset))
(indent-rigidly start end count)))
-(defun python-indent-electric-colon (arg)
- "Insert a colon and maybe de-indent the current line.
-With numeric ARG, just insert that many colons. With
-\\[universal-argument], just insert a single colon."
- (interactive "*P")
- (self-insert-command (if (not (integerp arg)) 1 arg))
- (when (and (not arg)
- (eolp)
- (not (equal ?: (char-after (- (point-marker) 2))))
- (not (python-syntax-comment-or-string-p)))
- (let ((indentation (current-indentation))
- (calculated-indentation (python-indent-calculate-indentation)))
- (python-info-closing-block-message)
- (when (> indentation calculated-indentation)
- (save-excursion
- (indent-line-to calculated-indentation)
- (when (not (python-info-closing-block-message))
- (indent-line-to indentation)))))))
-(put 'python-indent-electric-colon 'delete-selection t)
-
(defun python-indent-post-self-insert-function ()
- "Adjust closing paren line indentation after a char is added.
-This function is intended to be added to the
-`post-self-insert-hook.' If a line renders a paren alone, after
-adding a char before it, the line will be re-indented
-automatically if needed."
- (when (and (eq (char-before) last-command-event)
- (not (bolp))
- (memq (char-after) '(?\) ?\] ?\})))
- (save-excursion
- (goto-char (line-beginning-position))
- ;; If after going to the beginning of line the point
- ;; is still inside a paren it's ok to do the trick
- (when (python-syntax-context 'paren)
+ "Adjust indentation after insertion of some characters.
+This function is intended to be added to `post-self-insert-hook.'
+If a line renders a paren alone, after adding a char before it,
+the line will be re-indented automatically if needed."
+ (when (and electric-indent-mode
+ (eq (char-before) last-command-event))
+ (cond
+ ;; Electric indent inside parens
+ ((and
+ (not (bolp))
+ (let ((paren-start (python-syntax-context 'paren)))
+ ;; Check that point is inside parens.
+ (when paren-start
+ (not
+ ;; Filter the case where input is happening in the same
+ ;; line where the open paren is.
+ (= (line-number-at-pos)
+ (line-number-at-pos paren-start)))))
+ ;; When content has been added before the closing paren or a
+ ;; comma has been inserted, it's ok to do the trick.
+ (or
+ (memq (char-after) '(?\) ?\] ?\}))
+ (eq (char-before) ?,)))
+ (save-excursion
+ (goto-char (line-beginning-position))
(let ((indentation (python-indent-calculate-indentation)))
- (when (< (current-indentation) indentation)
- (indent-line-to indentation)))))))
+ (when (and (numberp indentation) (< (current-indentation) indentation))
+ (indent-line-to indentation)))))
+ ;; Electric colon
+ ((and (eq ?: last-command-event)
+ (memq ?: electric-indent-chars)
+ (not current-prefix-arg)
+ ;; Trigger electric colon only at end of line
+ (eolp)
+ ;; Avoid re-indenting on extra colon
+ (not (equal ?: (char-before (1- (point)))))
+ (not (python-syntax-comment-or-string-p)))
+ ;; Just re-indent dedenters
+ (let ((dedenter-pos (python-info-dedenter-statement-p))
+ (current-pos (point)))
+ (when dedenter-pos
+ (save-excursion
+ (goto-char dedenter-pos)
+ (python-indent-line)
+ (unless (= (line-number-at-pos dedenter-pos)
+ (line-number-at-pos current-pos))
+ ;; Reindent region if this is a multiline statement
+ (python-indent-region dedenter-pos current-pos)))))))))
+
+
+;;; Mark
+
+(defun python-mark-defun (&optional allow-extend)
+ "Put mark at end of this defun, point at beginning.
+The defun marked is the one that contains point or follows point.
+
+Interactively (or with ALLOW-EXTEND non-nil), if this command is
+repeated or (in Transient Mark mode) if the mark is active, it
+marks the next defun after the ones already marked."
+ (interactive "p")
+ (when (python-info-looking-at-beginning-of-defun)
+ (end-of-line 1))
+ (mark-defun allow-extend))
;;; Navigation
@@ -1159,20 +1344,20 @@ With positive ARG search backwards, else search forwards."
(defun python-nav-beginning-of-defun (&optional arg)
"Move point to `beginning-of-defun'.
-With positive ARG search backwards else search forward. When ARG
-is nil or 0 defaults to 1. When searching backwards nested
-defuns are handled with care depending on current point
-position. Return non-nil if point is moved to
+With positive ARG search backwards else search forward.
+ARG nil or 0 defaults to 1. When searching backwards,
+nested defuns are handled with care depending on current
+point position. Return non-nil if point is moved to
`beginning-of-defun'."
(when (or (null arg) (= arg 0)) (setq arg 1))
(let ((found))
- (cond ((and (eq this-command 'mark-defun)
- (python-info-looking-at-beginning-of-defun)))
- (t
- (dotimes (i (if (> arg 0) arg (- arg)))
- (when (and (python-nav--beginning-of-defun arg)
- (not found))
- (setq found t)))))
+ (while (and (not (= arg 0))
+ (let ((keep-searching-p
+ (python-nav--beginning-of-defun arg)))
+ (when (and keep-searching-p (null found))
+ (setq found t))
+ keep-searching-p))
+ (setq arg (if (> arg 0) (1- arg) (1+ arg))))
found))
(defun python-nav-end-of-defun ()
@@ -1262,15 +1447,21 @@ nested definitions."
(defun python-nav-beginning-of-statement ()
"Move to start of current statement."
(interactive "^")
- (while (and (or (back-to-indentation) t)
- (not (bobp))
- (when (or
- (save-excursion
- (forward-line -1)
- (python-info-line-ends-backslash-p))
- (python-syntax-context 'string)
- (python-syntax-context 'paren))
- (forward-line -1))))
+ (back-to-indentation)
+ (let* ((ppss (syntax-ppss))
+ (context-point
+ (or
+ (python-syntax-context 'paren ppss)
+ (python-syntax-context 'string ppss))))
+ (cond ((bobp))
+ (context-point
+ (goto-char context-point)
+ (python-nav-beginning-of-statement))
+ ((save-excursion
+ (forward-line -1)
+ (python-info-line-ends-backslash-p))
+ (forward-line -1)
+ (python-nav-beginning-of-statement))))
(point-marker))
(defun python-nav-end-of-statement (&optional noend)
@@ -1332,9 +1523,7 @@ backward to previous statement."
(defun python-nav-beginning-of-block ()
"Move to start of current block."
(interactive "^")
- (let ((starting-pos (point))
- (block-regexp (python-rx
- line-start (* whitespace) block-start)))
+ (let ((starting-pos (point)))
(if (progn
(python-nav-beginning-of-statement)
(looking-at (python-rx block-start)))
@@ -1403,46 +1592,60 @@ backward to previous block."
(and (goto-char starting-pos) nil)
(and (not (= (point) starting-pos)) (point-marker)))))
-(defun python-nav-lisp-forward-sexp-safe (&optional arg)
- "Safe version of standard `forward-sexp'.
-When ARG > 0 move forward, else if ARG is < 0."
- (or arg (setq arg 1))
+(defun python-nav--lisp-forward-sexp (&optional arg)
+ "Standard version `forward-sexp'.
+It ignores completely the value of `forward-sexp-function' by
+setting it to nil before calling `forward-sexp'. With positive
+ARG move forward only one sexp, else move backwards."
(let ((forward-sexp-function)
- (paren-regexp
- (if (> arg 0) (python-rx close-paren) (python-rx open-paren)))
- (search-fn
- (if (> arg 0) #'re-search-forward #'re-search-backward)))
+ (arg (if (or (not arg) (> arg 0)) 1 -1)))
+ (forward-sexp arg)))
+
+(defun python-nav--lisp-forward-sexp-safe (&optional arg)
+ "Safe version of standard `forward-sexp'.
+When at end of sexp (i.e. looking at a opening/closing paren)
+skips it instead of throwing an error. With positive ARG move
+forward only one sexp, else move backwards."
+ (let* ((arg (if (or (not arg) (> arg 0)) 1 -1))
+ (paren-regexp
+ (if (> arg 0) (python-rx close-paren) (python-rx open-paren)))
+ (search-fn
+ (if (> arg 0) #'re-search-forward #'re-search-backward)))
(condition-case nil
- (forward-sexp arg)
+ (python-nav--lisp-forward-sexp arg)
(error
(while (and (funcall search-fn paren-regexp nil t)
(python-syntax-context 'paren)))))))
-(defun python-nav--forward-sexp (&optional dir)
+(defun python-nav--forward-sexp (&optional dir safe skip-parens-p)
"Move to forward sexp.
-With positive Optional argument DIR direction move forward, else
-backwards."
+With positive optional argument DIR direction move forward, else
+backwards. When optional argument SAFE is non-nil do not throw
+errors when at end of sexp, skip it instead. With optional
+argument SKIP-PARENS-P force sexp motion to ignore parenthesized
+expressions when looking at them in either direction."
(setq dir (or dir 1))
(unless (= dir 0)
(let* ((forward-p (if (> dir 0)
(and (setq dir 1) t)
(and (setq dir -1) nil)))
- (re-search-fn (if forward-p
- 're-search-forward
- 're-search-backward))
(context-type (python-syntax-context-type)))
(cond
((memq context-type '(string comment))
;; Inside of a string, get out of it.
(let ((forward-sexp-function))
(forward-sexp dir)))
- ((or (eq context-type 'paren)
- (and forward-p (looking-at (python-rx open-paren)))
- (and (not forward-p)
- (eq (syntax-class (syntax-after (1- (point))))
- (car (string-to-syntax ")")))))
+ ((and (not skip-parens-p)
+ (or (eq context-type 'paren)
+ (if forward-p
+ (eq (syntax-class (syntax-after (point)))
+ (car (string-to-syntax "(")))
+ (eq (syntax-class (syntax-after (1- (point))))
+ (car (string-to-syntax ")"))))))
;; Inside a paren or looking at it, lisp knows what to do.
- (python-nav-lisp-forward-sexp-safe dir))
+ (if safe
+ (python-nav--lisp-forward-sexp-safe dir)
+ (python-nav--lisp-forward-sexp dir)))
(t
;; This part handles the lispy feel of
;; `python-nav-forward-sexp'. Knowing everything about the
@@ -1456,7 +1659,9 @@ backwards."
((python-info-end-of-statement-p) 'statement-end)))
(next-sexp-pos
(save-excursion
- (python-nav-lisp-forward-sexp-safe dir)
+ (if safe
+ (python-nav--lisp-forward-sexp-safe dir)
+ (python-nav--lisp-forward-sexp dir))
(point)))
(next-sexp-context
(save-excursion
@@ -1472,7 +1677,7 @@ backwards."
(cond ((and (not (eobp))
(python-info-current-line-empty-p))
(python-util-forward-comment dir)
- (python-nav--forward-sexp dir))
+ (python-nav--forward-sexp dir safe skip-parens-p))
((eq context 'block-start)
(python-nav-end-of-block))
((eq context 'statement-start)
@@ -1492,7 +1697,7 @@ backwards."
(cond ((and (not (bobp))
(python-info-current-line-empty-p))
(python-util-forward-comment dir)
- (python-nav--forward-sexp dir))
+ (python-nav--forward-sexp dir safe skip-parens-p))
((eq context 'block-end)
(python-nav-beginning-of-block))
((eq context 'statement-end)
@@ -1510,23 +1715,70 @@ backwards."
(python-nav-beginning-of-statement))
(t (goto-char next-sexp-pos))))))))))
-(defun python-nav--backward-sexp ()
- "Move to backward sexp."
- (python-nav--forward-sexp -1))
-
-(defun python-nav-forward-sexp (&optional arg)
- "Move forward across one block of code.
-With ARG, do it that many times. Negative arg -N means
-move backward N times."
+(defun python-nav-forward-sexp (&optional arg safe skip-parens-p)
+ "Move forward across expressions.
+With ARG, do it that many times. Negative arg -N means move
+backward N times. When optional argument SAFE is non-nil do not
+throw errors when at end of sexp, skip it instead. With optional
+argument SKIP-PARENS-P force sexp motion to ignore parenthesized
+expressions when looking at them in either direction (forced to t
+in interactive calls)."
(interactive "^p")
(or arg (setq arg 1))
+ ;; Do not follow parens on interactive calls. This hack to detect
+ ;; if the function was called interactively copes with the way
+ ;; `forward-sexp' works by calling `forward-sexp-function', losing
+ ;; interactive detection by checking `current-prefix-arg'. The
+ ;; reason to make this distinction is that lisp functions like
+ ;; `blink-matching-open' get confused causing issues like the one in
+ ;; Bug#16191. With this approach the user gets a symmetric behavior
+ ;; when working interactively while called functions expecting
+ ;; paren-based sexp motion work just fine.
+ (or
+ skip-parens-p
+ (setq skip-parens-p
+ (memq real-this-command
+ (list
+ #'forward-sexp #'backward-sexp
+ #'python-nav-forward-sexp #'python-nav-backward-sexp
+ #'python-nav-forward-sexp-safe #'python-nav-backward-sexp))))
(while (> arg 0)
- (python-nav--forward-sexp)
+ (python-nav--forward-sexp 1 safe skip-parens-p)
(setq arg (1- arg)))
(while (< arg 0)
- (python-nav--backward-sexp)
+ (python-nav--forward-sexp -1 safe skip-parens-p)
(setq arg (1+ arg))))
+(defun python-nav-backward-sexp (&optional arg safe skip-parens-p)
+ "Move backward across expressions.
+With ARG, do it that many times. Negative arg -N means move
+forward N times. When optional argument SAFE is non-nil do not
+throw errors when at end of sexp, skip it instead. With optional
+argument SKIP-PARENS-P force sexp motion to ignore parenthesized
+expressions when looking at them in either direction (forced to t
+in interactive calls)."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (python-nav-forward-sexp (- arg) safe skip-parens-p))
+
+(defun python-nav-forward-sexp-safe (&optional arg skip-parens-p)
+ "Move forward safely across expressions.
+With ARG, do it that many times. Negative arg -N means move
+backward N times. With optional argument SKIP-PARENS-P force
+sexp motion to ignore parenthesized expressions when looking at
+them in either direction (forced to t in interactive calls)."
+ (interactive "^p")
+ (python-nav-forward-sexp arg t skip-parens-p))
+
+(defun python-nav-backward-sexp-safe (&optional arg skip-parens-p)
+ "Move backward safely across expressions.
+With ARG, do it that many times. Negative arg -N means move
+forward N times. With optional argument SKIP-PARENS-P force sexp
+motion to ignore parenthesized expressions when looking at them in
+either direction (forced to t in interactive calls)."
+ (interactive "^p")
+ (python-nav-backward-sexp arg t skip-parens-p))
+
(defun python-nav--up-list (&optional dir)
"Internal implementation of `python-nav-up-list'.
DIR is always 1 or -1 and comes sanitized from
@@ -1582,12 +1834,35 @@ This command assumes point is not in a string or comment."
(defun python-nav-backward-up-list (&optional arg)
"Move backward out of one level of parentheses (or blocks).
With ARG, do this that many times.
-A negative argument means move backward but still to a less deep spot.
+A negative argument means move forward but still to a less deep spot.
This command assumes point is not in a string or comment."
(interactive "^p")
(or arg (setq arg 1))
(python-nav-up-list (- arg)))
+(defun python-nav-if-name-main ()
+ "Move point at the beginning the __main__ block.
+When \"if __name__ == '__main__':\" is found returns its
+position, else returns nil."
+ (interactive)
+ (let ((point (point))
+ (found (catch 'found
+ (goto-char (point-min))
+ (while (re-search-forward
+ (python-rx line-start
+ "if" (+ space)
+ "__name__" (+ space)
+ "==" (+ space)
+ (group-n 1 (or ?\" ?\'))
+ "__main__" (backref 1) (* space) ":")
+ nil t)
+ (when (not (python-syntax-context-type))
+ (beginning-of-line)
+ (throw 'found t))))))
+ (if found
+ (point)
+ (ignore (goto-char point)))))
+
;;; Shell integration
@@ -1613,86 +1888,135 @@ This command assumes point is not in a string or comment."
:type 'string
:group 'python)
+(defcustom python-shell-interpreter-interactive-arg "-i"
+ "Interpreter argument to force it to run interactively."
+ :type 'string
+ :version "24.4")
+
+(defcustom python-shell-prompt-detect-enabled t
+ "Non-nil enables autodetection of interpreter prompts."
+ :type 'boolean
+ :safe 'booleanp
+ :version "24.4")
+
+(defcustom python-shell-prompt-detect-failure-warning t
+ "Non-nil enables warnings when detection of prompts fail."
+ :type 'boolean
+ :safe 'booleanp
+ :version "24.4")
+
+(defcustom python-shell-prompt-input-regexps
+ '(">>> " "\\.\\.\\. " ; Python
+ "In \\[[0-9]+\\]: " ; IPython
+ " \\.\\.\\.: " ; IPython
+ ;; Using ipdb outside IPython may fail to cleanup and leave static
+ ;; IPython prompts activated, this adds some safeguard for that.
+ "In : " "\\.\\.\\.: ")
+ "List of regular expressions matching input prompts."
+ :type '(repeat string)
+ :version "24.4")
+
+(defcustom python-shell-prompt-output-regexps
+ '("" ; Python
+ "Out\\[[0-9]+\\]: " ; IPython
+ "Out :") ; ipdb safeguard
+ "List of regular expressions matching output prompts."
+ :type '(repeat string)
+ :version "24.4")
+
(defcustom python-shell-prompt-regexp ">>> "
- "Regular Expression matching top\-level input prompt of python shell.
+ "Regular expression matching top level input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string
- :group 'python
- :safe 'stringp)
+ :type 'string)
-(defcustom python-shell-prompt-block-regexp "[.][.][.] "
- "Regular Expression matching block input prompt of python shell.
+(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
- :group 'python
- :safe 'stringp)
+ :type 'string)
(defcustom python-shell-prompt-output-regexp ""
- "Regular Expression matching output prompt of python shell.
+ "Regular expression matching output prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string
- :group 'python
- :safe 'stringp)
+ :type 'string)
(defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ "
- "Regular Expression matching pdb input prompt of python shell.
+ "Regular expression matching pdb input prompt of Python shell.
It should not contain a caret (^) at the beginning."
- :type 'string
+ :type 'string)
+
+(define-obsolete-variable-alias
+ 'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1")
+
+(defcustom python-shell-font-lock-enable t
+ "Should syntax highlighting be enabled in the Python shell buffer?
+Restart the Python shell after changing this variable for it to take effect."
+ :type 'boolean
:group 'python
- :safe 'stringp)
+ :safe 'booleanp)
-(defcustom python-shell-enable-font-lock t
- "Should syntax highlighting be enabled in the python shell buffer?
-Restart the python shell after changing this variable for it to take effect."
+(defcustom python-shell-unbuffered t
+ "Should shell output be unbuffered?.
+When non-nil, this may prevent delayed and missing output in the
+Python shell. See commentary for details."
:type 'boolean
:group 'python
:safe 'booleanp)
(defcustom python-shell-process-environment nil
- "List of environment variables for Python shell.
-This variable follows the same rules as `process-environment'
-since it merges with it before the process creation routines are
-called. When this variable is nil, the Python shell is run with
-the default `process-environment'."
+ "List of overridden environment variables for subprocesses to inherit.
+Each element should be a string of the form ENVVARNAME=VALUE.
+When this variable is non-nil, values are exported into the
+process environment before starting it. Any variables already
+present in the current environment are superseded by variables
+set here."
:type '(repeat string)
- :group 'python
- :safe 'listp)
+ :group 'python)
(defcustom python-shell-extra-pythonpaths nil
"List of extra pythonpaths for Python shell.
-The values of this variable are added to the existing value of
-PYTHONPATH in the `process-environment' variable."
+When this variable is non-nil, values added at the beginning of
+the PYTHONPATH before starting processes. Any values present
+here that already exists in PYTHONPATH are moved to the beginning
+of the list so that they are prioritized when looking for
+modules."
:type '(repeat string)
- :group 'python
- :safe 'listp)
+ :group 'python)
(defcustom python-shell-exec-path nil
- "List of path to search for binaries.
-This variable follows the same rules as `exec-path' since it
-merges with it before the process creation routines are called.
-When this variable is nil, the Python shell is run with the
-default `exec-path'."
+ "List of paths for searching executables.
+When this variable is non-nil, values added at the beginning of
+the PATH before starting processes. Any values present here that
+already exists in PATH are moved to the beginning of the list so
+that they are prioritized when looking for executables."
:type '(repeat string)
- :group 'python
- :safe 'listp)
+ :group 'python)
+
+(defcustom python-shell-remote-exec-path nil
+ "List of paths to be ensured remotely for searching 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
+plan to ensure a particular set of paths to all Python shell
+executed through tramp connections."
+ :type '(repeat string)
+ :group 'python)
-(defcustom python-shell-virtualenv-path nil
+(defcustom python-shell-virtualenv-root nil
"Path to virtualenv root.
-This variable, when set to a string, makes the values stored in
-`python-shell-process-environment' and `python-shell-exec-path'
-to be modified properly so shells are started with the specified
+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)
- :group 'python
- :safe 'stringp)
+ :group 'python)
-(defcustom python-shell-setup-codes '(python-shell-completion-setup-code
- python-ffap-setup-code
- python-eldoc-setup-code)
+(define-obsolete-variable-alias
+ 'python-shell-virtualenv-path 'python-shell-virtualenv-root "25.1")
+
+(defcustom python-shell-setup-codes nil
"List of code run by `python-shell-send-setup-codes'."
:type '(repeat symbol)
- :group 'python
- :safe 'listp)
+ :group 'python)
(defcustom python-shell-compilation-regexp-alist
`((,(rx line-start (1+ (any " \t")) "File \""
@@ -1709,229 +2033,748 @@ virtualenv."
:type '(alist string)
:group 'python)
-(defun python-shell-get-process-name (dedicated)
- "Calculate the appropriate process name for inferior Python process.
-If DEDICATED is t and the variable `buffer-file-name' is non-nil
-returns a string with the form
-`python-shell-buffer-name'[variable `buffer-file-name'] else
-returns the value of `python-shell-buffer-name'."
- (let ((process-name
- (if (and dedicated
- buffer-file-name)
- (format "%s[%s]" python-shell-buffer-name buffer-file-name)
- (format "%s" python-shell-buffer-name))))
- process-name))
-
-(defun python-shell-internal-get-process-name ()
- "Calculate the appropriate process name for Internal Python process.
-The name is calculated from `python-shell-global-buffer-name' and
-a hash of all relevant global shell settings in order to ensure
-uniqueness for different types of configurations."
- (format "%s [%s]"
- python-shell-internal-buffer-name
- (md5
- (concat
- (python-shell-parse-command)
- python-shell-prompt-regexp
- python-shell-prompt-block-regexp
- python-shell-prompt-output-regexp
- (mapconcat #'symbol-value python-shell-setup-codes "")
- (mapconcat #'identity python-shell-process-environment "")
- (mapconcat #'identity python-shell-extra-pythonpaths "")
- (mapconcat #'identity python-shell-exec-path "")
- (or python-shell-virtualenv-path "")
- (mapconcat #'identity python-shell-exec-path "")))))
-
-(defun python-shell-parse-command ()
- "Calculate the string used to execute the inferior Python process."
- (let ((process-environment (python-shell-calculate-process-environment))
- (exec-path (python-shell-calculate-exec-path)))
- (format "%s %s"
- (executable-find python-shell-interpreter)
- python-shell-interpreter-args)))
+(defmacro python-shell--add-to-path-with-priority (pathvar paths)
+ "Modify PATHVAR and ensure PATHS are added only once at beginning."
+ `(dolist (path (reverse ,paths))
+ (cl-delete path ,pathvar :test #'string=)
+ (cl-pushnew path ,pathvar :test #'string=)))
+
+(defun python-shell-calculate-pythonpath ()
+ "Calculate the PYTHONPATH using `python-shell-extra-pythonpaths'."
+ (let ((pythonpath
+ (tramp-compat-split-string
+ (or (getenv "PYTHONPATH") "") path-separator)))
+ (python-shell--add-to-path-with-priority
+ pythonpath python-shell-extra-pythonpaths)
+ (mapconcat 'identity pythonpath path-separator)))
(defun python-shell-calculate-process-environment ()
- "Calculate process environment given `python-shell-virtualenv-path'."
- (let ((process-environment (append
- python-shell-process-environment
- process-environment nil))
- (virtualenv (if python-shell-virtualenv-path
- (directory-file-name python-shell-virtualenv-path)
- nil)))
+ "Calculate `process-environment' or `tramp-remote-process-environment'.
+Prepends `python-shell-process-environment', sets extra
+pythonpaths from `python-shell-extra-pythonpaths' and sets a few
+virtualenv related vars. If `default-directory' points to a
+remote host, the returned value is intended for
+`tramp-remote-process-environment'."
+ (let* ((remote-p (file-remote-p default-directory))
+ (process-environment (if remote-p
+ tramp-remote-process-environment
+ process-environment))
+ (virtualenv (when python-shell-virtualenv-root
+ (directory-file-name python-shell-virtualenv-root))))
+ (dolist (env python-shell-process-environment)
+ (pcase-let ((`(,key ,value) (split-string env "=")))
+ (setenv key value)))
+ (when python-shell-unbuffered
+ (setenv "PYTHONUNBUFFERED" "1"))
(when python-shell-extra-pythonpaths
- (setenv "PYTHONPATH"
- (format "%s%s%s"
- (mapconcat 'identity
- python-shell-extra-pythonpaths
- path-separator)
- path-separator
- (or (getenv "PYTHONPATH") ""))))
+ (setenv "PYTHONPATH" (python-shell-calculate-pythonpath)))
(if (not virtualenv)
process-environment
(setenv "PYTHONHOME" nil)
- (setenv "PATH" (format "%s/bin%s%s"
- virtualenv path-separator
- (or (getenv "PATH") "")))
(setenv "VIRTUAL_ENV" virtualenv))
process-environment))
(defun python-shell-calculate-exec-path ()
- "Calculate exec path given `python-shell-virtualenv-path'."
- (let ((path (append python-shell-exec-path
- exec-path nil)))
- (if (not python-shell-virtualenv-path)
- path
- (cons (format "%s/bin"
- (directory-file-name python-shell-virtualenv-path))
- path))))
-
-(defun python-comint-output-filter-function (output)
- "Hook run after content is put into comint buffer.
-OUTPUT is a string with the contents of the buffer."
- (ansi-color-filter-apply output))
+ "Calculate `exec-path'.
+Prepends `python-shell-exec-path' and adds the binary directory
+for virtualenv if `python-shell-virtualenv-root' is set. If
+`default-directory' points to a remote host, the returned value
+appends `python-shell-remote-exec-path' instead of `exec-path'."
+ (let ((new-path (copy-sequence
+ (if (file-remote-p default-directory)
+ python-shell-remote-exec-path
+ exec-path))))
+ (python-shell--add-to-path-with-priority
+ new-path python-shell-exec-path)
+ (if (not python-shell-virtualenv-root)
+ new-path
+ (python-shell--add-to-path-with-priority
+ new-path
+ (list (expand-file-name "bin" python-shell-virtualenv-root)))
+ new-path)))
+
+(defun python-shell-tramp-refresh-remote-path (vec paths)
+ "Update VEC's remote-path giving PATHS priority."
+ (let ((remote-path (tramp-get-connection-property vec "remote-path" nil)))
+ (when remote-path
+ (python-shell--add-to-path-with-priority remote-path paths)
+ (tramp-set-connection-property vec "remote-path" remote-path)
+ (tramp-set-remote-path vec))))
+
+(defun python-shell-tramp-refresh-process-environment (vec env)
+ "Update VEC's process environment with ENV."
+ ;; Stolen from `tramp-open-connection-setup-interactive-shell'.
+ (let ((env (append (when (fboundp #'tramp-get-remote-locale)
+ ;; Emacs<24.4 compat.
+ (list (tramp-get-remote-locale vec)))
+ (copy-sequence env)))
+ (tramp-end-of-heredoc
+ (if (boundp 'tramp-end-of-heredoc)
+ tramp-end-of-heredoc
+ (md5 tramp-end-of-output)))
+ unset vars item)
+ (while env
+ (setq item (tramp-compat-split-string (car env) "="))
+ (setcdr item (mapconcat 'identity (cdr item) "="))
+ (if (and (stringp (cdr item)) (not (string-equal (cdr item) "")))
+ (push (format "%s %s" (car item) (cdr item)) vars)
+ (push (car item) unset))
+ (setq env (cdr env)))
+ (when vars
+ (tramp-send-command
+ vec
+ (format "while read var val; do export $var=$val; done <<'%s'\n%s\n%s"
+ tramp-end-of-heredoc
+ (mapconcat 'identity vars "\n")
+ tramp-end-of-heredoc)
+ t))
+ (when unset
+ (tramp-send-command
+ vec (format "unset %s" (mapconcat 'identity unset " ")) t))))
+
+(defmacro python-shell-with-environment (&rest body)
+ "Modify shell environment during execution of BODY.
+Temporarily sets `process-environment' and `exec-path' during
+execution of body. If `default-directory' points to a remote
+machine then modifies `tramp-remote-process-environment' and
+`python-shell-remote-exec-path' instead."
+ (declare (indent 0) (debug (body)))
+ (let ((vec (make-symbol "vec")))
+ `(progn
+ (let* ((,vec
+ (when (file-remote-p default-directory)
+ (ignore-errors
+ (tramp-dissect-file-name default-directory 'noexpand))))
+ (process-environment
+ (if ,vec
+ process-environment
+ (python-shell-calculate-process-environment)))
+ (exec-path
+ (if ,vec
+ exec-path
+ (python-shell-calculate-exec-path)))
+ (tramp-remote-process-environment
+ (if ,vec
+ (python-shell-calculate-process-environment)
+ tramp-remote-process-environment)))
+ (when (tramp-get-connection-process ,vec)
+ ;; For already existing connections, the new exec path must
+ ;; be re-set, otherwise it won't take effect. One example
+ ;; of such case is when remote dir-locals are read and
+ ;; *then* subprocesses are triggered within the same
+ ;; connection.
+ (python-shell-tramp-refresh-remote-path
+ ,vec (python-shell-calculate-exec-path))
+ ;; The `tramp-remote-process-environment' variable is only
+ ;; effective when the started process is an interactive
+ ;; shell, otherwise (like in the case of processes started
+ ;; with `process-file') the environment is not changed.
+ ;; This makes environment modifications effective
+ ;; unconditionally.
+ (python-shell-tramp-refresh-process-environment
+ ,vec tramp-remote-process-environment))
+ ,(macroexp-progn body)))))
+
+(defvar python-shell--prompt-calculated-input-regexp nil
+ "Calculated input prompt regexp for inferior python shell.
+Do not set this variable directly, instead use
+`python-shell-prompt-set-calculated-regexps'.")
+
+(defvar python-shell--prompt-calculated-output-regexp nil
+ "Calculated output prompt regexp for inferior python shell.
+Do not set this variable directly, instead use
+`python-shell-set-prompt-regexp'.")
+
+(defun python-shell-prompt-detect ()
+ "Detect prompts for the current `python-shell-interpreter'.
+When prompts can be retrieved successfully from the
+`python-shell-interpreter' run with
+`python-shell-interpreter-interactive-arg', returns a list of
+three elements, where the first two are input prompts and the
+last one is an output prompt. When no prompts can be detected
+and `python-shell-prompt-detect-failure-warning' is non-nil,
+shows a warning with instructions to avoid hangs and returns nil.
+When `python-shell-prompt-detect-enabled' is nil avoids any
+detection and just returns nil."
+ (when python-shell-prompt-detect-enabled
+ (python-shell-with-environment
+ (let* ((code (concat
+ "import sys\n"
+ "ps = [getattr(sys, 'ps%s' % i, '') for i in range(1,4)]\n"
+ ;; JSON is built manually for compatibility
+ "ps_json = '\\n[\"%s\", \"%s\", \"%s\"]\\n' % tuple(ps)\n"
+ "print (ps_json)\n"
+ "sys.exit(0)\n"))
+ (interpreter python-shell-interpreter)
+ (interpreter-arg python-shell-interpreter-interactive-arg)
+ (output
+ (with-temp-buffer
+ ;; TODO: improve error handling by using
+ ;; `condition-case' and displaying the error message to
+ ;; the user in the no-prompts warning.
+ (ignore-errors
+ (let ((code-file (python-shell--save-temp-file code)))
+ ;; Use `process-file' as it is remote-host friendly.
+ (process-file
+ interpreter
+ code-file
+ '(t nil)
+ nil
+ interpreter-arg)
+ ;; Try to cleanup
+ (delete-file code-file)))
+ (buffer-string)))
+ (prompts
+ (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) "[\"")
+ (ignore-errors
+ ;; Return prompts as a list, not vector
+ (append (json-read-from-string line) nil)))))
+ ;; 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
+ ;; input prompt is the only one that can't be empty.
+ (when (and (= (length res) 3)
+ (cl-every #'stringp res)
+ (not (string= (car res) "")))
+ (throw 'prompts res))))
+ nil)))
+ (when (and (not prompts)
+ python-shell-prompt-detect-failure-warning)
+ (lwarn
+ '(python python-shell-prompt-regexp)
+ :warning
+ (concat
+ "Python shell prompts cannot be detected.\n"
+ "If your emacs session hangs when starting python shells\n"
+ "recover with `keyboard-quit' and then try fixing the\n"
+ "interactive flag for your interpreter by adjusting the\n"
+ "`python-shell-interpreter-interactive-arg' or add regexps\n"
+ "matching shell prompts in the directory-local friendly vars:\n"
+ " + `python-shell-prompt-regexp'\n"
+ " + `python-shell-prompt-block-regexp'\n"
+ " + `python-shell-prompt-output-regexp'\n"
+ "Or alternatively in:\n"
+ " + `python-shell-prompt-input-regexps'\n"
+ " + `python-shell-prompt-output-regexps'")))
+ prompts))))
+
+(defun python-shell-prompt-validate-regexps ()
+ "Validate all user provided regexps for prompts.
+Signals `user-error' if any of these vars contain invalid
+regexps: `python-shell-prompt-regexp',
+`python-shell-prompt-block-regexp',
+`python-shell-prompt-pdb-regexp',
+`python-shell-prompt-output-regexp',
+`python-shell-prompt-input-regexps',
+`python-shell-prompt-output-regexps'."
+ (dolist (symbol (list 'python-shell-prompt-input-regexps
+ 'python-shell-prompt-output-regexps
+ 'python-shell-prompt-regexp
+ 'python-shell-prompt-block-regexp
+ 'python-shell-prompt-pdb-regexp
+ 'python-shell-prompt-output-regexp))
+ (dolist (regexp (let ((regexps (symbol-value symbol)))
+ (if (listp regexps)
+ regexps
+ (list regexps))))
+ (when (not (python-util-valid-regexp-p regexp))
+ (user-error "Invalid regexp %s in `%s'"
+ regexp symbol)))))
+
+(defun python-shell-prompt-set-calculated-regexps ()
+ "Detect and set input and output prompt regexps.
+Build and set the values for `python-shell-input-prompt-regexp'
+and `python-shell-output-prompt-regexp' using the values from
+`python-shell-prompt-regexp', `python-shell-prompt-block-regexp',
+`python-shell-prompt-pdb-regexp',
+`python-shell-prompt-output-regexp',
+`python-shell-prompt-input-regexps',
+`python-shell-prompt-output-regexps' and detected prompts from
+`python-shell-prompt-detect'."
+ (when (not (and python-shell--prompt-calculated-input-regexp
+ python-shell--prompt-calculated-output-regexp))
+ (let* ((detected-prompts (python-shell-prompt-detect))
+ (input-prompts nil)
+ (output-prompts nil)
+ (build-regexp
+ (lambda (prompts)
+ (concat "^\\("
+ (mapconcat #'identity
+ (sort prompts
+ (lambda (a b)
+ (let ((length-a (length a))
+ (length-b (length b)))
+ (if (= length-a length-b)
+ (string< a b)
+ (> (length a) (length b))))))
+ "\\|")
+ "\\)"))))
+ ;; Validate ALL regexps
+ (python-shell-prompt-validate-regexps)
+ ;; Collect all user defined input prompts
+ (dolist (prompt (append python-shell-prompt-input-regexps
+ (list python-shell-prompt-regexp
+ python-shell-prompt-block-regexp
+ python-shell-prompt-pdb-regexp)))
+ (cl-pushnew prompt input-prompts :test #'string=))
+ ;; Collect all user defined output prompts
+ (dolist (prompt (cons python-shell-prompt-output-regexp
+ python-shell-prompt-output-regexps))
+ (cl-pushnew prompt output-prompts :test #'string=))
+ ;; Collect detected prompts if any
+ (when detected-prompts
+ (dolist (prompt (butlast detected-prompts))
+ (setq prompt (regexp-quote prompt))
+ (cl-pushnew prompt input-prompts :test #'string=))
+ (cl-pushnew (regexp-quote
+ (car (last detected-prompts)))
+ output-prompts :test #'string=))
+ ;; Set input and output prompt regexps from collected prompts
+ (setq python-shell--prompt-calculated-input-regexp
+ (funcall build-regexp input-prompts)
+ python-shell--prompt-calculated-output-regexp
+ (funcall build-regexp output-prompts)))))
+
+(defun python-shell-get-process-name (dedicated)
+ "Calculate the appropriate process name for inferior Python process.
+If DEDICATED is t returns a string with the form
+`python-shell-buffer-name'[`buffer-name'] else returns the value
+of `python-shell-buffer-name'."
+ (if dedicated
+ (format "%s[%s]" python-shell-buffer-name (buffer-name))
+ python-shell-buffer-name))
+
+(defun python-shell-internal-get-process-name ()
+ "Calculate the appropriate process name for Internal Python process.
+The name is calculated from `python-shell-global-buffer-name' and
+the `buffer-name'."
+ (format "%s[%s]" python-shell-internal-buffer-name (buffer-name)))
+
+(defun python-shell-calculate-command ()
+ "Calculate the string used to execute the inferior Python process."
+ (format "%s %s"
+ (shell-quote-argument python-shell-interpreter)
+ python-shell-interpreter-args))
+
+(define-obsolete-function-alias
+ 'python-shell-parse-command
+ #'python-shell-calculate-command "25.1")
+
+(defvar python-shell--package-depth 10)
+
+(defun python-shell-package-enable (directory package)
+ "Add DIRECTORY parent to $PYTHONPATH and enable PACKAGE."
+ (interactive
+ (let* ((dir (expand-file-name
+ (read-directory-name
+ "Package root: "
+ (file-name-directory
+ (or (buffer-file-name) default-directory)))))
+ (name (completing-read
+ "Package: "
+ (python-util-list-packages
+ dir python-shell--package-depth))))
+ (list dir name)))
+ (python-shell-send-string
+ (format
+ (concat
+ "import os.path;import sys;"
+ "sys.path.append(os.path.dirname(os.path.dirname('''%s''')));"
+ "__package__ = '''%s''';"
+ "import %s")
+ directory package package)
+ (python-shell-get-process)))
+
+(defun python-shell-accept-process-output (process &optional timeout regexp)
+ "Accept PROCESS output with TIMEOUT until REGEXP is found.
+Optional argument TIMEOUT is the timeout argument to
+`accept-process-output' calls. Optional argument REGEXP
+overrides the regexp to match the end of output, defaults to
+`comint-prompt-regexp.'. Returns non-nil when output was
+properly captured.
+
+This utility is useful in situations where the output may be
+received in chunks, since `accept-process-output' gives no
+guarantees they will be grabbed in a single call. An example use
+case for this would be the CPython shell start-up, where the
+banner and the initial prompt are received separately."
+ (let ((regexp (or regexp comint-prompt-regexp)))
+ (catch 'found
+ (while t
+ (when (not (accept-process-output process timeout))
+ (throw 'found nil))
+ (when (looking-back
+ regexp (car (python-util-comint-last-prompt)))
+ (throw 'found t))))))
+
+(defun python-shell-comint-end-of-output-p (output)
+ "Return non-nil if OUTPUT is ends with input prompt."
+ (string-match
+ ;; XXX: It seems on OSX an extra carriage return is attached
+ ;; at the end of output, this handles that too.
+ (concat
+ "\r?\n?"
+ ;; Remove initial caret from calculated regexp
+ (replace-regexp-in-string
+ (rx string-start ?^) ""
+ python-shell--prompt-calculated-input-regexp)
+ (rx eos))
+ output))
+
+(define-obsolete-function-alias
+ 'python-comint-output-filter-function
+ 'ansi-color-filter-apply
+ "25.1")
+
+(defun python-comint-postoutput-scroll-to-bottom (output)
+ "Faster version of `comint-postoutput-scroll-to-bottom'.
+Avoids `recenter' calls until OUTPUT is completely sent."
+ (when (and (not (string= "" output))
+ (python-shell-comint-end-of-output-p
+ (ansi-color-filter-apply output)))
+ (comint-postoutput-scroll-to-bottom output))
+ output)
(defvar python-shell--parent-buffer nil)
-(defvar python-shell-output-syntax-table
- (let ((table (make-syntax-table python-dotty-syntax-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)
- (modify-syntax-entry ?\} "." table)
- table)
- "Syntax table for shell output.
-It makes parens and quotes be treated as punctuation chars.")
+(defmacro python-shell-with-shell-buffer (&rest body)
+ "Execute the forms in BODY with the shell buffer temporarily current.
+Signals an error if no shell buffer is available for current buffer."
+ (declare (indent 0) (debug t))
+ (let ((shell-process (make-symbol "shell-process")))
+ `(let ((,shell-process (python-shell-get-process-or-error)))
+ (with-current-buffer (process-buffer ,shell-process)
+ ,@body))))
+
+(defvar python-shell--font-lock-buffer nil)
+
+(defun python-shell-font-lock-get-or-create-buffer ()
+ "Get or create a font-lock buffer for current inferior process."
+ (python-shell-with-shell-buffer
+ (if python-shell--font-lock-buffer
+ python-shell--font-lock-buffer
+ (let ((process-name
+ (process-name (get-buffer-process (current-buffer)))))
+ (generate-new-buffer
+ (format " *%s-font-lock*" process-name))))))
+
+(defun python-shell-font-lock-kill-buffer ()
+ "Kill the font-lock buffer safely."
+ (when (and python-shell--font-lock-buffer
+ (buffer-live-p python-shell--font-lock-buffer))
+ (kill-buffer python-shell--font-lock-buffer)
+ (when (derived-mode-p 'inferior-python-mode)
+ (setq python-shell--font-lock-buffer nil))))
+
+(defmacro python-shell-font-lock-with-font-lock-buffer (&rest body)
+ "Execute the forms in BODY in the font-lock buffer.
+The value returned is the value of the last form in BODY. See
+also `with-current-buffer'."
+ (declare (indent 0) (debug t))
+ `(python-shell-with-shell-buffer
+ (save-current-buffer
+ (when (not (and python-shell--font-lock-buffer
+ (get-buffer python-shell--font-lock-buffer)))
+ (setq python-shell--font-lock-buffer
+ (python-shell-font-lock-get-or-create-buffer)))
+ (set-buffer python-shell--font-lock-buffer)
+ (when (not font-lock-mode)
+ (font-lock-mode 1))
+ (set (make-local-variable 'delay-mode-hooks) t)
+ (let ((python-indent-guess-indent-offset nil))
+ (when (not (derived-mode-p 'python-mode))
+ (python-mode))
+ ,@body))))
+
+(defun python-shell-font-lock-cleanup-buffer ()
+ "Cleanup the font-lock buffer.
+Provided as a command because this might be handy if something
+goes wrong and syntax highlighting in the shell gets messed up."
+ (interactive)
+ (python-shell-with-shell-buffer
+ (python-shell-font-lock-with-font-lock-buffer
+ (erase-buffer))))
+
+(defun python-shell-font-lock-comint-output-filter-function (output)
+ "Clean up the font-lock buffer after any OUTPUT."
+ (if (and (not (string= "" output))
+ ;; Is end of output and is not just a prompt.
+ (not (member
+ (python-shell-comint-end-of-output-p
+ (ansi-color-filter-apply output))
+ '(nil 0))))
+ ;; If output is other than an input prompt then "real" output has
+ ;; been received and the font-lock buffer must be cleaned up.
+ (python-shell-font-lock-cleanup-buffer)
+ ;; Otherwise just add a newline.
+ (python-shell-font-lock-with-font-lock-buffer
+ (goto-char (point-max))
+ (newline)))
+ output)
+
+(defun python-shell-font-lock-post-command-hook ()
+ "Fontifies current line in shell buffer."
+ (let ((prompt-end (cdr (python-util-comint-last-prompt))))
+ (when (and prompt-end (> (point) prompt-end)
+ (process-live-p (get-buffer-process (current-buffer))))
+ (let* ((input (buffer-substring-no-properties
+ prompt-end (point-max)))
+ (deactivate-mark nil)
+ (start-pos prompt-end)
+ (buffer-undo-list t)
+ (font-lock-buffer-pos nil)
+ (replacement
+ (python-shell-font-lock-with-font-lock-buffer
+ (delete-region (line-beginning-position)
+ (point-max))
+ (setq font-lock-buffer-pos (point))
+ (insert input)
+ ;; Ensure buffer is fontified, keeping it
+ ;; compatible with Emacs < 24.4.
+ (if (fboundp 'font-lock-ensure)
+ (funcall 'font-lock-ensure)
+ (font-lock-default-fontify-buffer))
+ (buffer-substring font-lock-buffer-pos
+ (point-max))))
+ (replacement-length (length replacement))
+ (i 0))
+ ;; Inject text properties to get input fontified.
+ (while (not (= i replacement-length))
+ (let* ((plist (text-properties-at i replacement))
+ (next-change (or (next-property-change i replacement)
+ replacement-length))
+ (plist (let ((face (plist-get plist 'face)))
+ (if (not face)
+ plist
+ ;; Replace FACE text properties with
+ ;; FONT-LOCK-FACE so input is fontified.
+ (plist-put plist 'face nil)
+ (plist-put plist 'font-lock-face face)))))
+ (set-text-properties
+ (+ start-pos i) (+ start-pos next-change) plist)
+ (setq i next-change)))))))
+
+(defun python-shell-font-lock-turn-on (&optional msg)
+ "Turn on shell font-lock.
+With argument MSG show activation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (python-shell-font-lock-kill-buffer)
+ (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (add-hook 'post-command-hook
+ #'python-shell-font-lock-post-command-hook nil 'local)
+ (add-hook 'kill-buffer-hook
+ #'python-shell-font-lock-kill-buffer nil 'local)
+ (add-hook 'comint-output-filter-functions
+ #'python-shell-font-lock-comint-output-filter-function
+ 'append 'local)
+ (when msg
+ (message "Shell font-lock is enabled"))))
+
+(defun python-shell-font-lock-turn-off (&optional msg)
+ "Turn off shell font-lock.
+With argument MSG show deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (python-shell-font-lock-kill-buffer)
+ (when (python-util-comint-last-prompt)
+ ;; Cleanup current fontification
+ (remove-text-properties
+ (cdr (python-util-comint-last-prompt))
+ (line-end-position)
+ '(face nil font-lock-face nil)))
+ (set (make-local-variable 'python-shell--font-lock-buffer) nil)
+ (remove-hook 'post-command-hook
+ #'python-shell-font-lock-post-command-hook 'local)
+ (remove-hook 'kill-buffer-hook
+ #'python-shell-font-lock-kill-buffer 'local)
+ (remove-hook 'comint-output-filter-functions
+ #'python-shell-font-lock-comint-output-filter-function
+ 'local)
+ (when msg
+ (message "Shell font-lock is disabled"))))
+
+(defun python-shell-font-lock-toggle (&optional msg)
+ "Toggle font-lock for shell.
+With argument MSG show activation/deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (set (make-local-variable 'python-shell-font-lock-enable)
+ (not python-shell-font-lock-enable))
+ (if python-shell-font-lock-enable
+ (python-shell-font-lock-turn-on msg)
+ (python-shell-font-lock-turn-off msg))
+ python-shell-font-lock-enable))
+
+(defvar python-shell--first-prompt-received-output-buffer nil)
+(defvar python-shell--first-prompt-received nil)
+
+(defcustom python-shell-first-prompt-hook nil
+ "Hook run upon first (non-pdb) shell prompt detection.
+This is the place for shell setup functions that need to wait for
+output. Since the first prompt is ensured, this helps the
+current process to not hang waiting for output by safeguarding
+interactive actions can be performed. This is useful to safely
+attach setup code for long-running processes that eventually
+provide a shell."
+ :type 'hook
+ :group 'python)
+
+(defun python-shell-comint-watch-for-first-prompt-output-filter (output)
+ "Run `python-shell-first-prompt-hook' when first prompt is found in OUTPUT."
+ (when (not python-shell--first-prompt-received)
+ (set (make-local-variable 'python-shell--first-prompt-received-output-buffer)
+ (concat python-shell--first-prompt-received-output-buffer
+ (ansi-color-filter-apply output)))
+ (when (python-shell-comint-end-of-output-p
+ python-shell--first-prompt-received-output-buffer)
+ (if (string-match-p
+ (concat python-shell-prompt-pdb-regexp (rx eos))
+ (or python-shell--first-prompt-received-output-buffer ""))
+ ;; Skip pdb prompts and reset the buffer.
+ (setq python-shell--first-prompt-received-output-buffer nil)
+ (set (make-local-variable 'python-shell--first-prompt-received) t)
+ (setq python-shell--first-prompt-received-output-buffer nil)
+ (with-current-buffer (current-buffer)
+ (let ((inhibit-quit nil))
+ (run-hooks 'python-shell-first-prompt-hook))))))
+ output)
+
+;; Used to hold user interactive overrides to
+;; `python-shell-interpreter' and `python-shell-interpreter-args' that
+;; will be made buffer-local by `inferior-python-mode':
+(defvar python-shell--interpreter)
+(defvar python-shell--interpreter-args)
(define-derived-mode inferior-python-mode comint-mode "Inferior Python"
"Major mode for Python inferior process.
Runs a Python interpreter as a subprocess of Emacs, with Python
-I/O through an Emacs buffer. Variables
-`python-shell-interpreter' and `python-shell-interpreter-args'
-controls which Python interpreter is run. Variables
+I/O through an Emacs buffer. Variables `python-shell-interpreter'
+and `python-shell-interpreter-args' control which Python
+interpreter is run. Variables
`python-shell-prompt-regexp',
`python-shell-prompt-output-regexp',
`python-shell-prompt-block-regexp',
-`python-shell-enable-font-lock',
+`python-shell-font-lock-enable',
`python-shell-completion-setup-code',
`python-shell-completion-string-code',
-`python-shell-completion-module-string-code',
`python-eldoc-setup-code', `python-eldoc-string-code',
`python-ffap-setup-code' and `python-ffap-string-code' can
customize this mode for different Python interpreters.
+This mode resets `comint-output-filter-functions' locally, so you
+may want to re-add custom functions to it using the
+`inferior-python-mode-hook'.
+
You can also add additional setup code to be run at
initialization of the interpreter via `python-shell-setup-codes'
variable.
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
- (and python-shell--parent-buffer
- (python-util-clone-local-variables python-shell--parent-buffer))
- (setq comint-prompt-regexp (format "^\\(?:%s\\|%s\\|%s\\)"
- python-shell-prompt-regexp
- python-shell-prompt-block-regexp
- python-shell-prompt-pdb-regexp))
+ (when python-shell--parent-buffer
+ (python-util-clone-local-variables python-shell--parent-buffer))
+ ;; Users can interactively override default values for
+ ;; `python-shell-interpreter' and `python-shell-interpreter-args'
+ ;; when calling `run-python'. This ensures values let-bound in
+ ;; `python-shell-make-comint' are locally set if needed.
+ (set (make-local-variable 'python-shell-interpreter)
+ (or python-shell--interpreter python-shell-interpreter))
+ (set (make-local-variable 'python-shell-interpreter-args)
+ (or python-shell--interpreter-args python-shell-interpreter-args))
+ (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil)
+ (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil)
+ (python-shell-prompt-set-calculated-regexps)
+ (setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp)
+ (set (make-local-variable 'comint-prompt-read-only) t)
(setq mode-line-process '(":%s"))
- (make-local-variable 'comint-output-filter-functions)
- (add-hook 'comint-output-filter-functions
- 'python-comint-output-filter-function)
- (add-hook 'comint-output-filter-functions
- 'python-pdbtrack-comint-output-filter-function)
+ (set (make-local-variable 'comint-output-filter-functions)
+ '(ansi-color-process-output
+ python-shell-comint-watch-for-first-prompt-output-filter
+ python-pdbtrack-comint-output-filter-function
+ python-comint-postoutput-scroll-to-bottom))
(set (make-local-variable 'compilation-error-regexp-alist)
python-shell-compilation-regexp-alist)
- (define-key inferior-python-mode-map [remap complete-symbol]
- 'completion-at-point)
(add-hook 'completion-at-point-functions
- 'python-shell-completion-complete-at-point nil 'local)
- (add-to-list (make-local-variable 'comint-dynamic-complete-functions)
- 'python-shell-completion-complete-at-point)
+ #'python-shell-completion-at-point nil 'local)
(define-key inferior-python-mode-map "\t"
'python-shell-completion-complete-or-indent)
(make-local-variable 'python-pdbtrack-buffers-to-kill)
(make-local-variable 'python-pdbtrack-tracked-buffer)
(make-local-variable 'python-shell-internal-last-output)
- (when python-shell-enable-font-lock
- (set-syntax-table python-mode-syntax-table)
- (set (make-local-variable 'font-lock-defaults)
- '(python-font-lock-keywords nil nil nil nil))
- (set (make-local-variable 'syntax-propertize-function)
- (eval
- ;; XXX: Unfortunately eval is needed here to make use of the
- ;; dynamic value of `comint-prompt-regexp'.
- `(syntax-propertize-rules
- (,comint-prompt-regexp
- (0 (ignore
- (put-text-property
- comint-last-input-start end 'syntax-table
- python-shell-output-syntax-table)
- ;; XXX: This might look weird, but it is the easiest
- ;; way to ensure font lock gets cleaned up before the
- ;; current prompt, which is needed for unclosed
- ;; strings to not mess up with current input.
- (font-lock-unfontify-region comint-last-input-start end))))
- (,(python-rx string-delimiter)
- (0 (ignore
- (and (not (eq (get-text-property start 'field) 'output))
- (python-syntax-stringify)))))))))
+ (when python-shell-font-lock-enable
+ (python-shell-font-lock-turn-on))
(compilation-shell-minor-mode 1))
-(defun python-shell-make-comint (cmd proc-name &optional pop internal)
- "Create a python shell comint buffer.
-CMD is the python command to be executed and PROC-NAME is the
+(defun python-shell-make-comint (cmd proc-name &optional show internal)
+ "Create a Python shell comint buffer.
+CMD is the Python command to be executed and PROC-NAME is the
process name the comint buffer will get. After the comint buffer
is created the `inferior-python-mode' is activated. When
-optional argument POP is non-nil the buffer is shown. When
+optional argument SHOW is non-nil the buffer is shown. When
optional argument INTERNAL is non-nil this process is run on a
buffer with a name that starts with a space, following the Emacs
convention for temporary/internal buffers, and also makes sure
the user is not queried for confirmation when the process is
killed."
(save-excursion
- (let* ((proc-buffer-name
- (format (if (not internal) "*%s*" " *%s*") proc-name))
- (process-environment (python-shell-calculate-process-environment))
- (exec-path (python-shell-calculate-exec-path)))
- (when (not (comint-check-proc proc-buffer-name))
- (let* ((cmdlist (split-string-and-unquote cmd))
- (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name
- (car cmdlist) nil (cdr cmdlist)))
- (python-shell--parent-buffer (current-buffer))
- (process (get-buffer-process buffer)))
- (with-current-buffer buffer
- (inferior-python-mode))
- (accept-process-output process)
- (and pop (pop-to-buffer buffer t))
- (and internal (set-process-query-on-exit-flag process nil))))
- proc-buffer-name)))
+ (python-shell-with-environment
+ (let* ((proc-buffer-name
+ (format (if (not internal) "*%s*" " *%s*") proc-name)))
+ (when (not (comint-check-proc proc-buffer-name))
+ (let* ((cmdlist (split-string-and-unquote cmd))
+ (interpreter (car cmdlist))
+ (args (cdr cmdlist))
+ (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name
+ interpreter nil args))
+ (python-shell--parent-buffer (current-buffer))
+ (process (get-buffer-process buffer))
+ ;; Users can override the interpreter and args
+ ;; interactively when calling `run-python', let-binding
+ ;; these allows to have the new right values in all
+ ;; setup code that is done in `inferior-python-mode',
+ ;; which is important, especially for prompt detection.
+ (python-shell--interpreter interpreter)
+ (python-shell--interpreter-args
+ (mapconcat #'identity args " ")))
+ (with-current-buffer buffer
+ (inferior-python-mode))
+ (when show (display-buffer buffer))
+ (and internal (set-process-query-on-exit-flag process nil))))
+ proc-buffer-name))))
;;;###autoload
-(defun run-python (cmd &optional dedicated show)
+(defun run-python (&optional cmd dedicated show)
"Run an inferior Python process.
-Input and output via buffer named after
-`python-shell-buffer-name'. If there is a process already
-running in that buffer, just switch to it.
-With argument, allows you to define CMD so you can edit the
-command used to call the interpreter and define DEDICATED, so a
-dedicated process for the current buffer is open. When numeric
-prefix arg is other than 0 or 4 do not SHOW.
+Argument CMD defaults to `python-shell-calculate-command' return
+value. When called interactively with `prefix-arg', it allows
+the user to edit such value and choose whether the interpreter
+should be DEDICATED for the current buffer. When numeric prefix
+arg is other than 0 or 4 do not SHOW.
-Runs the hook `inferior-python-mode-hook' (after the
-`comint-mode-hook' is run). \(Type \\[describe-mode] in the
+For a given buffer and same values of DEDICATED, if a process is
+already running for it, it will do nothing. This means that if
+the current buffer is using a global process, the user is still
+able to switch it to use a dedicated one.
+
+Runs the hook `inferior-python-mode-hook' after
+`comint-mode-hook' is run. (Type \\[describe-mode] in the
process buffer for a list of commands.)"
(interactive
(if current-prefix-arg
(list
- (read-string "Run Python: " (python-shell-parse-command))
+ (read-shell-command "Run Python: " (python-shell-calculate-command))
(y-or-n-p "Make dedicated process? ")
(= (prefix-numeric-value current-prefix-arg) 4))
- (list (python-shell-parse-command) nil t)))
- (python-shell-make-comint
- cmd (python-shell-get-process-name dedicated) show)
- dedicated)
+ (list (python-shell-calculate-command) nil t)))
+ (get-buffer-process
+ (python-shell-make-comint
+ (or cmd (python-shell-calculate-command))
+ (python-shell-get-process-name dedicated) show)))
(defun run-python-internal ()
"Run an inferior Internal Python process.
@@ -1940,50 +2783,75 @@ Input and output via buffer named after
`python-shell-internal-get-process-name' returns.
This new kind of shell is intended to be used for generic
-communication related to defined configurations, the main
+communication related to defined configurations; the main
difference with global or dedicated shells is that these ones are
attached to a configuration, not a buffer. This means that can
be used for example to retrieve the sys.path and other stuff,
without messing with user shells. Note that
-`python-shell-enable-font-lock' and `inferior-python-mode-hook'
+`python-shell-font-lock-enable' and `inferior-python-mode-hook'
are set to nil for these shells, so setup codes are not sent at
startup."
- (let ((python-shell-enable-font-lock nil)
+ (let ((python-shell-font-lock-enable nil)
(inferior-python-mode-hook nil))
(get-buffer-process
(python-shell-make-comint
- (python-shell-parse-command)
+ (python-shell-calculate-command)
(python-shell-internal-get-process-name) nil t))))
+(defun python-shell-get-buffer ()
+ "Return inferior Python buffer for current buffer.
+If current buffer is in `inferior-python-mode', return it."
+ (if (derived-mode-p 'inferior-python-mode)
+ (current-buffer)
+ (let* ((dedicated-proc-name (python-shell-get-process-name t))
+ (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
+ (global-proc-name (python-shell-get-process-name nil))
+ (global-proc-buffer-name (format "*%s*" global-proc-name))
+ (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
+ (global-running (comint-check-proc global-proc-buffer-name)))
+ ;; Always prefer dedicated
+ (or (and dedicated-running dedicated-proc-buffer-name)
+ (and global-running global-proc-buffer-name)))))
+
(defun python-shell-get-process ()
- "Get inferior Python process for current buffer and return it."
- (let* ((dedicated-proc-name (python-shell-get-process-name t))
- (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
- (global-proc-name (python-shell-get-process-name nil))
- (global-proc-buffer-name (format "*%s*" global-proc-name))
- (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
- (global-running (comint-check-proc global-proc-buffer-name)))
- ;; Always prefer dedicated
- (get-buffer-process (or (and dedicated-running dedicated-proc-buffer-name)
- (and global-running global-proc-buffer-name)))))
-
-(defun python-shell-get-or-create-process ()
- "Get or create an inferior Python process for current buffer and return it."
- (let* ((dedicated-proc-name (python-shell-get-process-name t))
- (dedicated-proc-buffer-name (format "*%s*" dedicated-proc-name))
- (global-proc-name (python-shell-get-process-name nil))
- (global-proc-buffer-name (format "*%s*" global-proc-name))
- (dedicated-running (comint-check-proc dedicated-proc-buffer-name))
- (global-running (comint-check-proc global-proc-buffer-name))
- (current-prefix-arg 16))
- (when (and (not dedicated-running) (not global-running))
- (if (call-interactively 'run-python)
- (setq dedicated-running t)
- (setq global-running t)))
- ;; Always prefer dedicated
- (get-buffer-process (if dedicated-running
- dedicated-proc-buffer-name
- global-proc-buffer-name))))
+ "Return inferior Python process for current buffer."
+ (get-buffer-process (python-shell-get-buffer)))
+
+(defun python-shell-get-process-or-error (&optional interactivep)
+ "Return inferior Python process for current buffer or signal error.
+When argument INTERACTIVEP is non-nil, use `user-error' instead
+of `error' with a user-friendly message."
+ (or (python-shell-get-process)
+ (if interactivep
+ (user-error
+ "Start a Python process first with `%s' or `%s'."
+ (substitute-command-keys "\\[run-python]")
+ ;; Get the binding.
+ (key-description
+ (where-is-internal
+ #'run-python overriding-local-map t)))
+ (error
+ "No inferior Python process running."))))
+
+(defun python-shell-get-or-create-process (&optional cmd dedicated show)
+ "Get or create an inferior Python process for current buffer and return it.
+Arguments CMD, DEDICATED and SHOW are those of `run-python' and
+are used to start the shell. If those arguments are not
+provided, `run-python' is called interactively and the user will
+be asked for their values."
+ (let ((shell-process (python-shell-get-process)))
+ (when (not shell-process)
+ (if (not cmd)
+ ;; XXX: Refactor code such that calling `run-python'
+ ;; interactively is not needed anymore.
+ (call-interactively 'run-python)
+ (run-python cmd dedicated show)))
+ (or shell-process (python-shell-get-process))))
+
+(make-obsolete
+ #'python-shell-get-or-create-process
+ "Instead call `python-shell-get-process' and create one if returns nil."
+ "25.1")
(defvar python-shell-internal-buffer nil
"Current internal shell buffer for the current buffer.
@@ -1997,18 +2865,10 @@ there for compatibility with CEDET.")
(defun python-shell-internal-get-or-create-process ()
"Get or create an inferior Internal Python process."
- (let* ((proc-name (python-shell-internal-get-process-name))
- (proc-buffer-name (format " *%s*" proc-name)))
- (when (not (process-live-p proc-name))
- (run-python-internal)
- (setq python-shell-internal-buffer proc-buffer-name)
- ;; XXX: Why is this `sit-for' needed?
- ;; `python-shell-make-comint' calls `accept-process-output'
- ;; already but it is not helping to get proper output on
- ;; 'gnu/linux when the internal shell process is not running and
- ;; a call to `python-shell-internal-send-string' is issued.
- (sit-for 0.1 t))
- (get-buffer-process proc-buffer-name)))
+ (let ((proc-name (python-shell-internal-get-process-name)))
+ (if (process-live-p proc-name)
+ (get-process proc-name)
+ (run-python-internal))))
(define-obsolete-function-alias
'python-proc 'python-shell-internal-get-or-create-process "24.3")
@@ -2019,27 +2879,33 @@ there for compatibility with CEDET.")
(define-obsolete-variable-alias
'python-preoutput-result 'python-shell-internal-last-output "24.3")
+(defun python-shell--save-temp-file (string)
+ (let* ((temporary-file-directory
+ (if (file-remote-p default-directory)
+ (concat (file-remote-p default-directory) "/tmp")
+ temporary-file-directory))
+ (temp-file-name (make-temp-file "py"))
+ (coding-system-for-write (python-info-encoding)))
+ (with-temp-file temp-file-name
+ (insert string)
+ (delete-trailing-whitespace))
+ temp-file-name))
+
(defun python-shell-send-string (string &optional process msg)
"Send STRING to inferior Python PROCESS.
-When MSG is non-nil messages the first line of STRING."
- (interactive "sPython command: ")
- (let ((process (or process (python-shell-get-or-create-process)))
- (lines (split-string string "\n" t)))
- (and msg (message "Sent: %s..." (nth 0 lines)))
- (if (> (length lines) 1)
- (let* ((temporary-file-directory
- (if (file-remote-p default-directory)
- (concat (file-remote-p default-directory) "/tmp")
- temporary-file-directory))
- (temp-file-name (make-temp-file "py"))
+When 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 (read-string "Python command: ") nil t))
+ (let ((process (or process (python-shell-get-process-or-error msg))))
+ (if (string-match ".\n+." string) ;Multiline.
+ (let* ((temp-file-name (python-shell--save-temp-file string))
(file-name (or (buffer-file-name) temp-file-name)))
- (with-temp-file temp-file-name
- (insert string)
- (delete-trailing-whitespace))
- (python-shell-send-file file-name process temp-file-name))
+ (python-shell-send-file file-name process temp-file-name t))
(comint-send-string process string)
- (when (or (not (string-match "\n$" string))
- (string-match "\n[ \t].*\n?$" string))
+ (when (or (not (string-match "\n\\'" string))
+ (string-match "\n[ \t].*\n?\\'" string))
(comint-send-string process "\n")))))
(defvar python-shell-output-filter-in-progress nil)
@@ -2055,13 +2921,7 @@ detecting a prompt at the end of the buffer."
string (ansi-color-filter-apply string)
python-shell-output-filter-buffer
(concat python-shell-output-filter-buffer string))
- (when (string-match
- ;; XXX: It seems on OSX an extra carriage return is attached
- ;; at the end of output, this handles that too.
- (format "\r?\n\\(?:%s\\|%s\\|%s\\)$"
- python-shell-prompt-regexp
- python-shell-prompt-block-regexp
- python-shell-prompt-pdb-regexp)
+ (when (python-shell-comint-end-of-output-p
python-shell-output-filter-buffer)
;; Output ends when `python-shell-output-filter-buffer' contains
;; the prompt attached at the end of it.
@@ -2069,27 +2929,26 @@ detecting a prompt at the end of the buffer."
python-shell-output-filter-buffer
(substring python-shell-output-filter-buffer
0 (match-beginning 0)))
- (when (and (> (length python-shell-prompt-output-regexp) 0)
- (string-match (concat "^" python-shell-prompt-output-regexp)
- python-shell-output-filter-buffer))
- ;; Some shells, like iPython might append a prompt before the
+ (when (string-match
+ python-shell--prompt-calculated-output-regexp
+ python-shell-output-filter-buffer)
+ ;; Some shells, like IPython might append a prompt before the
;; output, clean that.
(setq python-shell-output-filter-buffer
(substring python-shell-output-filter-buffer (match-end 0)))))
"")
-(defun python-shell-send-string-no-output (string &optional process msg)
+(defun python-shell-send-string-no-output (string &optional process)
"Send STRING to PROCESS and inhibit output.
-When MSG is non-nil messages the first line of STRING. Return
-the output."
- (let ((process (or process (python-shell-get-or-create-process)))
+Return the output."
+ (let ((process (or process (python-shell-get-process-or-error)))
(comint-preoutput-filter-functions
'(python-shell-output-filter))
(python-shell-output-filter-in-progress t)
(inhibit-quit t))
(or
(with-local-quit
- (python-shell-send-string string process msg)
+ (python-shell-send-string string process)
(while python-shell-output-filter-in-progress
;; `python-shell-output-filter' takes care of setting
;; `python-shell-output-filter-in-progress' to NIL after it
@@ -2111,7 +2970,7 @@ Returns the output. See `python-shell-send-string-no-output'."
;; Makes this function compatible with the old
;; python-send-receive. (At least for CEDET).
(replace-regexp-in-string "_emacs_out +" "" string)
- (python-shell-internal-get-or-create-process) nil)))
+ (python-shell-internal-get-or-create-process))))
(define-obsolete-function-alias
'python-send-receive 'python-shell-internal-send-string "24.3")
@@ -2119,37 +2978,113 @@ 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-send-region (start end)
- "Send the region delimited by START and END to inferior Python process."
- (interactive "r")
- (python-shell-send-string
- (concat
- (let ((line-num (line-number-at-pos start)))
- ;; When sending a region, add blank lines for non sent code so
- ;; backtraces remain correct.
- (make-string (1- line-num) ?\n))
- (buffer-substring start end))
- nil t))
-
-(defun python-shell-send-buffer (&optional arg)
+(defun python-shell-buffer-substring (start end &optional nomain)
+ "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
+the python shell:
+ 1. When optional argument NOMAIN is non-nil everything under an
+ \"if __name__ == \\='__main__\\='\" block will be removed.
+ 2. When a subregion of the buffer is sent, it takes care of
+ appending extra empty lines so tracebacks are correct.
+ 3. When the region sent is a substring of the current buffer, a
+ coding cookie is added.
+ 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.
+ (goto-char start)
+ (line-beginning-position)))
+ (substring (buffer-substring-no-properties start end))
+ (starts-at-point-min-p (save-restriction
+ (widen)
+ (= (point-min) start)))
+ (encoding (python-info-encoding))
+ (toplevel-p (zerop (save-excursion
+ (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)))))
+ (with-temp-buffer
+ (python-mode)
+ (when fillstr
+ (insert fillstr))
+ (insert substring)
+ (goto-char (point-min))
+ (when (not toplevel-p)
+ (insert "if True:")
+ (delete-region (point) (line-end-position)))
+ (when nomain
+ (let* ((if-name-main-start-end
+ (and nomain
+ (save-excursion
+ (when (python-nav-if-name-main)
+ (cons (point)
+ (progn (python-nav-forward-sexp-safe)
+ ;; Include ending newline
+ (forward-line 1)
+ (point)))))))
+ ;; Oh destructuring bind, how I miss you.
+ (if-name-main-start (car if-name-main-start-end))
+ (if-name-main-end (cdr if-name-main-start-end))
+ (fillstr (make-string
+ (- (line-number-at-pos if-name-main-end)
+ (line-number-at-pos if-name-main-start)) ?\n)))
+ (when if-name-main-start-end
+ (goto-char if-name-main-start)
+ (delete-region if-name-main-start if-name-main-end)
+ (insert fillstr))))
+ ;; Ensure there's only one coding cookie in the generated string.
+ (goto-char (point-min))
+ (when (looking-at-p (python-rx coding-cookie))
+ (forward-line 1)
+ (when (looking-at-p (python-rx coding-cookie))
+ (delete-region
+ (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)
+ "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__':\".
+When called interactively SEND-MAIN defaults to nil, unless it's
+called with prefix argument. When 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 (region-beginning) (region-end) current-prefix-arg t))
+ (let* ((string (python-shell-buffer-substring start end (not send-main)))
+ (process (python-shell-get-process-or-error msg))
+ (original-string (buffer-substring-no-properties start end))
+ (_ (string-match "\\`\n*\\(.*\\)" original-string)))
+ (message "Sent: %s..." (match-string 1 original-string))
+ (python-shell-send-string string process)))
+
+(defun python-shell-send-buffer (&optional send-main msg)
"Send the entire buffer to inferior Python process.
-With prefix ARG allow execution of code inside blocks delimited
-by \"if __name__== '__main__':\""
- (interactive "P")
+When optional argument SEND-MAIN is non-nil, allow execution of
+code inside blocks delimited by \"if __name__== '__main__':\".
+When called interactively SEND-MAIN defaults to nil, unless it's
+called with prefix argument. When 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-restriction
(widen)
- (let ((str (buffer-substring (point-min) (point-max))))
- (and
- (not arg)
- (setq str (replace-regexp-in-string
- (python-rx if-name-main)
- "if __name__ == '__main__ ':" str)))
- (python-shell-send-string str))))
-
-(defun python-shell-send-defun (arg)
+ (python-shell-send-region (point-min) (point-max) send-main msg)))
+
+(defun python-shell-send-defun (&optional arg msg)
"Send the current defun to inferior Python process.
-When argument ARG is non-nil do not include decorators."
- (interactive "P")
+When argument ARG is non-nil do not include decorators. When
+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
@@ -2165,198 +3100,514 @@ When argument ARG is non-nil do not include decorators."
(progn
(or (python-nav-end-of-defun)
(end-of-line 1))
- (point-marker)))))
+ (point-marker))
+ nil ;; noop
+ msg)))
-(defun python-shell-send-file (file-name &optional process temp-file-name)
+(defun python-shell-send-file (file-name &optional process temp-file-name
+ delete msg)
"Send FILE-NAME to inferior Python PROCESS.
If TEMP-FILE-NAME is passed then that file is used for processing
instead, while internally the shell will continue to use
-FILE-NAME."
- (interactive "fFile to send: ")
- (let* ((process (or process (python-shell-get-or-create-process)))
+FILE-NAME. If TEMP-FILE-NAME and DELETE are non-nil, then
+TEMP-FILE-NAME is deleted after evaluation is performed. When
+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
+ (read-file-name "File to send: ") ; file-name
+ nil ; process
+ nil ; temp-file-name
+ nil ; delete
+ t)) ; msg
+ (let* ((process (or process (python-shell-get-process-or-error msg)))
+ (encoding (with-temp-buffer
+ (insert-file-contents
+ (or temp-file-name file-name))
+ (python-info-encoding)))
+ (file-name (expand-file-name
+ (or (file-remote-p file-name 'localname)
+ file-name)))
(temp-file-name (when temp-file-name
(expand-file-name
(or (file-remote-p temp-file-name 'localname)
- temp-file-name))))
- (file-name (or (when file-name
- (expand-file-name
- (or (file-remote-p file-name 'localname)
- file-name)))
- temp-file-name)))
- (when (not file-name)
- (error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil"))
+ temp-file-name)))))
(python-shell-send-string
(format
- (concat "__pyfile = open('''%s''');"
- "exec(compile(__pyfile.read(), '''%s''', 'exec'));"
- "__pyfile.close()")
- (or temp-file-name file-name) file-name)
+ (concat
+ "import codecs, os;"
+ "__pyfile = codecs.open('''%s''', encoding='''%s''');"
+ "__code = __pyfile.read().encode('''%s''');"
+ "__pyfile.close();"
+ (when (and delete temp-file-name)
+ (format "os.remove('''%s''');" temp-file-name))
+ "exec(compile(__code, '''%s''', 'exec'));")
+ (or temp-file-name file-name) encoding encoding file-name)
process)))
-(defun python-shell-switch-to-shell ()
- "Switch to inferior Python process buffer."
- (interactive)
- (pop-to-buffer (process-buffer (python-shell-get-or-create-process)) t))
+(defun python-shell-switch-to-shell (&optional msg)
+ "Switch to inferior Python process buffer.
+When 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 "p")
+ (pop-to-buffer
+ (process-buffer (python-shell-get-process-or-error msg)) nil t))
(defun python-shell-send-setup-code ()
"Send all setup code for shell.
This function takes the list of setup code to send from the
`python-shell-setup-codes' list."
- (let ((process (get-buffer-process (current-buffer))))
- (dolist (code python-shell-setup-codes)
- (when code
- (message "Sent %s" code)
- (python-shell-send-string
- (symbol-value code) process)))))
-
-(add-hook 'inferior-python-mode-hook
+ (when python-shell-setup-codes
+ (let ((process (python-shell-get-process))
+ (code (concat
+ (mapconcat
+ (lambda (elt)
+ (cond ((stringp elt) elt)
+ ((symbolp elt) (symbol-value elt))
+ (t "")))
+ python-shell-setup-codes
+ "\n\nprint ('python.el: sent setup code')"))))
+ (python-shell-send-string code process)
+ (python-shell-accept-process-output process))))
+
+(add-hook 'python-shell-first-prompt-hook
#'python-shell-send-setup-code)
;;; Shell completion
(defcustom python-shell-completion-setup-code
- "try:
- import readline
-except ImportError:
- def __COMPLETER_all_completions(text): []
-else:
- import rlcompleter
- readline.set_completer(rlcompleter.Completer().complete)
- def __COMPLETER_all_completions(text):
- import sys
- completions = []
+ "
+def __PYTHON_EL_get_completions(text):
+ completions = []
+ completer = None
+
+ try:
+ import readline
+
try:
+ import __builtin__
+ except ImportError:
+ # Python 3
+ import builtins as __builtin__
+ builtins = dir(__builtin__)
+
+ is_ipython = ('__IPYTHON__' in builtins or
+ '__IPYTHON__active' in builtins)
+ splits = text.split()
+ is_module = splits and splits[0] in ('from', 'import')
+
+ if is_ipython and is_module:
+ from IPython.core.completerlib import module_completion
+ completions = module_completion(text.strip())
+ elif is_ipython and '__IP' in builtins:
+ completions = __IP.complete(text)
+ elif is_ipython and 'get_ipython' in builtins:
+ completions = get_ipython().Completer.all_completions(text)
+ else:
+ # Try to reuse current completer.
+ completer = readline.get_completer()
+ if not completer:
+ # importing rlcompleter sets the completer, use it as a
+ # last resort to avoid breaking customizations.
+ import rlcompleter
+ completer = readline.get_completer()
+ if getattr(completer, 'PYTHON_EL_WRAPPED', False):
+ completer.print_mode = False
i = 0
while True:
- res = readline.get_completer()(text, i)
- if not res: break
+ completion = completer(text, i)
+ if not completion:
+ break
i += 1
- completions.append(res)
- except NameError:
- pass
- return completions"
+ completions.append(completion)
+ except:
+ pass
+ finally:
+ if getattr(completer, 'PYTHON_EL_WRAPPED', False):
+ completer.print_mode = True
+ return completions"
"Code used to setup completion in inferior Python processes."
:type 'string
:group 'python)
(defcustom python-shell-completion-string-code
- "';'.join(__COMPLETER_all_completions('''%s'''))\n"
- "Python code used to get a string of completions separated by semicolons."
+ "';'.join(__PYTHON_EL_get_completions('''%s'''))"
+ "Python code used to get a string of completions separated by semicolons.
+The string passed to the function is the current python name or
+the full statement in the case of imports."
:type 'string
:group 'python)
-(defcustom python-shell-completion-module-string-code ""
- "Python code used to get completions separated by semicolons for imports.
-
-For IPython v0.11, add the following line to
-`python-shell-completion-setup-code':
-
-from IPython.core.completerlib import module_completion
+(define-obsolete-variable-alias
+ 'python-shell-completion-module-string-code
+ 'python-shell-completion-string-code
+ "24.4"
+ "Completion string code must also autocomplete modules.")
-and use the following as the value of this variable:
+(define-obsolete-variable-alias
+ 'python-shell-completion-pdb-string-code
+ 'python-shell-completion-string-code
+ "25.1"
+ "Completion string code must work for (i)pdb.")
+
+(defcustom python-shell-completion-native-disabled-interpreters
+ ;; PyPy's readline cannot handle some escape sequences yet.
+ (list "pypy")
+ "List of disabled interpreters.
+When a match is found, native completion is disabled."
+ :type '(repeat string))
+
+(defcustom python-shell-completion-native-enable t
+ "Enable readline based native completion."
+ :type 'boolean)
+
+(defcustom python-shell-completion-native-output-timeout 5.0
+ "Time in seconds to wait for completion output before giving up."
+ :type 'float)
+
+(defcustom python-shell-completion-native-try-output-timeout 1.0
+ "Time in seconds to wait for *trying* native completion output."
+ :type 'float)
+
+(defvar python-shell-completion-native-redirect-buffer
+ " *Python completions redirect*"
+ "Buffer to be used to redirect output of readline commands.")
+
+(defun python-shell-completion-native-interpreter-disabled-p ()
+ "Return non-nil if interpreter has native completion disabled."
+ (when python-shell-completion-native-disabled-interpreters
+ (string-match
+ (regexp-opt python-shell-completion-native-disabled-interpreters)
+ (file-name-nondirectory python-shell-interpreter))))
+
+(defun python-shell-completion-native-try ()
+ "Return non-nil if can trigger native completion."
+ (let ((python-shell-completion-native-enable t)
+ (python-shell-completion-native-output-timeout
+ python-shell-completion-native-try-output-timeout))
+ (python-shell-completion-native-get-completions
+ (get-buffer-process (current-buffer))
+ nil "")))
+
+(defun python-shell-completion-native-setup ()
+ "Try to setup native completion, return non-nil on success."
+ (let ((process (python-shell-get-process)))
+ (with-current-buffer (process-buffer process)
+ (python-shell-send-string "
+def __PYTHON_EL_native_completion_setup():
+ try:
+ import readline
-';'.join(module_completion('''%s'''))\n"
- :type 'string
- :group 'python)
+ try:
+ import __builtin__
+ except ImportError:
+ # Python 3
+ import builtins as __builtin__
+
+ builtins = dir(__builtin__)
+ is_ipython = ('__IPYTHON__' in builtins or
+ '__IPYTHON__active' in builtins)
+
+ class __PYTHON_EL_Completer:
+ '''Completer wrapper that prints candidates to stdout.
+
+ It wraps an existing completer function and changes its behavior so
+ that the user input is unchanged and real candidates are printed to
+ stdout.
+
+ Returned candidates are '0__dummy_completion__' and
+ '1__dummy_completion__' in that order ('0__dummy_completion__' is
+ returned repeatedly until all possible candidates are consumed).
+
+ The real candidates are printed to stdout so that they can be
+ easily retrieved through comint output redirect trickery.
+ '''
+
+ PYTHON_EL_WRAPPED = True
+
+ def __init__(self, completer):
+ self.completer = completer
+ self.last_completion = None
+ self.print_mode = True
+
+ def __call__(self, text, state):
+ if state == 0:
+ # Set the first dummy completion.
+ self.last_completion = None
+ completion = '0__dummy_completion__'
+ else:
+ completion = self.completer(text, state - 1)
+
+ if not completion:
+ if self.last_completion != '1__dummy_completion__':
+ # When no more completions are available, returning a
+ # dummy with non-sharing prefix allow to ensure output
+ # while preventing changes to current input.
+ # Coincidentally it's also the end of output.
+ completion = '1__dummy_completion__'
+ elif completion.endswith('('):
+ # Remove parens on callables as it breaks completion on
+ # arguments (e.g. str(Ari<tab>)).
+ completion = completion[:-1]
+ self.last_completion = completion
+
+ if completion in (
+ '0__dummy_completion__', '1__dummy_completion__'):
+ return completion
+ elif completion:
+ # For every non-dummy completion, return a repeated dummy
+ # one and print the real candidate so it can be retrieved
+ # by comint output filters.
+ if self.print_mode:
+ print (completion)
+ return '0__dummy_completion__'
+ else:
+ return completion
+ else:
+ return completion
+
+ completer = readline.get_completer()
+
+ if not completer:
+ # Used as last resort to avoid breaking customizations.
+ import rlcompleter
+ completer = readline.get_completer()
+
+ if completer and not getattr(completer, 'PYTHON_EL_WRAPPED', False):
+ # Wrap the existing completer function only once.
+ new_completer = __PYTHON_EL_Completer(completer)
+ if not is_ipython:
+ readline.set_completer(new_completer)
+ else:
+ # Try both initializations to cope with all IPython versions.
+ # This works fine for IPython 3.x but not for earlier:
+ readline.set_completer(new_completer)
+ # IPython<3 hacks readline such that `readline.set_completer`
+ # won't work. This workaround injects the new completer
+ # function into the existing instance directly:
+ instance = getattr(completer, 'im_self', completer.__self__)
+ instance.rlcomplete = new_completer
+
+ if readline.__doc__ and 'libedit' in readline.__doc__:
+ readline.parse_and_bind('bind ^I rl_complete')
+ else:
+ readline.parse_and_bind('tab: complete')
+ # Require just one tab to send output.
+ readline.parse_and_bind('set show-all-if-ambiguous on')
-(defcustom python-shell-completion-pdb-string-code
- "';'.join(globals().keys() + locals().keys())"
- "Python code used to get completions separated by semicolons for [i]pdb."
- :type 'string
- :group 'python)
+ print ('python.el: native completion setup loaded')
+ except:
+ print ('python.el: native completion setup failed')
-(defun python-shell-completion-get-completions (process line input)
- "Do completion at point for PROCESS.
-LINE is used to detect the context on how to complete given
-INPUT."
- (let* ((prompt
- ;; Get the last prompt for the inferior process
- ;; buffer. This is used for the completion code selection
- ;; heuristic.
- (with-current-buffer (process-buffer process)
- (buffer-substring-no-properties
- (overlay-start comint-last-prompt-overlay)
- (overlay-end comint-last-prompt-overlay))))
- (completion-context
- ;; Check whether a prompt matches a pdb string, an import
- ;; statement or just the standard prompt and use the
- ;; correct python-shell-completion-*-code string
- (cond ((and (> (length python-shell-completion-pdb-string-code) 0)
- (string-match
- (concat "^" python-shell-prompt-pdb-regexp) prompt))
- 'pdb)
- ((and (>
- (length python-shell-completion-module-string-code) 0)
- (string-match
- (concat "^" python-shell-prompt-regexp) prompt)
- (string-match "^[ \t]*\\(from\\|import\\)[ \t]" line))
- 'import)
- ((string-match
- (concat "^" python-shell-prompt-regexp) prompt)
- 'default)
- (t nil)))
- (completion-code
- (pcase completion-context
- (`pdb python-shell-completion-pdb-string-code)
- (`import python-shell-completion-module-string-code)
- (`default python-shell-completion-string-code)
- (_ nil)))
- (input
- (if (eq completion-context 'import)
- (replace-regexp-in-string "^[ \t]+" "" line)
- input)))
- (and completion-code
- (> (length input) 0)
- (with-current-buffer (process-buffer process)
- (let ((completions (python-shell-send-string-no-output
- (format completion-code input) process)))
- (and (> (length completions) 2)
- (split-string completions
- "^'\\|^\"\\|;\\|'$\\|\"$" t)))))))
-
-(defun python-shell-completion-complete-at-point (&optional process)
- "Perform completion at point in inferior Python.
+__PYTHON_EL_native_completion_setup()" process)
+ (when (and
+ (python-shell-accept-process-output
+ process python-shell-completion-native-try-output-timeout)
+ (save-excursion
+ (re-search-backward
+ (regexp-quote "python.el: native completion setup loaded") nil t 1)))
+ (python-shell-completion-native-try)))))
+
+(defun python-shell-completion-native-turn-off (&optional msg)
+ "Turn off shell native completions.
+With argument MSG show deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (set (make-local-variable 'python-shell-completion-native-enable) nil)
+ (when msg
+ (message "Shell native completion is disabled, using fallback"))))
+
+(defun python-shell-completion-native-turn-on (&optional msg)
+ "Turn on shell native completions.
+With argument MSG show deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (set (make-local-variable 'python-shell-completion-native-enable) t)
+ (python-shell-completion-native-turn-on-maybe msg)))
+
+(defun python-shell-completion-native-turn-on-maybe (&optional msg)
+ "Turn on native completions if enabled and available.
+With argument MSG show activation/deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (when python-shell-completion-native-enable
+ (cond
+ ((python-shell-completion-native-interpreter-disabled-p)
+ (python-shell-completion-native-turn-off msg))
+ ((python-shell-completion-native-setup)
+ (when msg
+ (message "Shell native completion is enabled.")))
+ (t (lwarn
+ '(python python-shell-completion-native-turn-on-maybe)
+ :warning
+ (concat
+ "Your `python-shell-interpreter' doesn't seem to "
+ "support readline, yet `python-shell-completion-native' "
+ (format "was t and %S is not part of the "
+ (file-name-nondirectory python-shell-interpreter))
+ "`python-shell-completion-native-disabled-interpreters' "
+ "list. Native completions have been disabled locally. "))
+ (python-shell-completion-native-turn-off msg))))))
+
+(defun python-shell-completion-native-turn-on-maybe-with-msg ()
+ "Like `python-shell-completion-native-turn-on-maybe' but force messages."
+ (python-shell-completion-native-turn-on-maybe t))
+
+(add-hook 'python-shell-first-prompt-hook
+ #'python-shell-completion-native-turn-on-maybe-with-msg)
+
+(defun python-shell-completion-native-toggle (&optional msg)
+ "Toggle shell native completion.
+With argument MSG show activation/deactivation message."
+ (interactive "p")
+ (python-shell-with-shell-buffer
+ (if python-shell-completion-native-enable
+ (python-shell-completion-native-turn-off msg)
+ (python-shell-completion-native-turn-on msg))
+ python-shell-completion-native-enable))
+
+(defun python-shell-completion-native-get-completions (process import input)
+ "Get completions using native readline for PROCESS.
+When IMPORT is non-nil takes precedence over INPUT for
+completion."
+ (with-current-buffer (process-buffer process)
+ (let* ((input (or import input))
+ (original-filter-fn (process-filter process))
+ (redirect-buffer (get-buffer-create
+ python-shell-completion-native-redirect-buffer))
+ (trigger "\t")
+ (new-input (concat input trigger))
+ (input-length
+ (save-excursion
+ (+ (- (point-max) (comint-bol)) (length new-input))))
+ (delete-line-command (make-string input-length ?\b))
+ (input-to-send (concat new-input delete-line-command)))
+ ;; Ensure restoring the process filter, even if the user quits
+ ;; or there's some other error.
+ (unwind-protect
+ (with-current-buffer redirect-buffer
+ ;; Cleanup the redirect buffer
+ (erase-buffer)
+ ;; Mimic `comint-redirect-send-command', unfortunately it
+ ;; can't be used here because it expects a newline in the
+ ;; command and that's exactly what we are trying to avoid.
+ (let ((comint-redirect-echo-input nil)
+ (comint-redirect-completed nil)
+ (comint-redirect-perform-sanity-check nil)
+ (comint-redirect-insert-matching-regexp t)
+ (comint-redirect-finished-regexp
+ "1__dummy_completion__[[:space:]]*\n")
+ (comint-redirect-output-buffer redirect-buffer))
+ ;; Compatibility with Emacs 24.x. Comint changed and
+ ;; now `comint-redirect-filter' gets 3 args. This
+ ;; checks which version of `comint-redirect-filter' is
+ ;; in use based on its args and uses `apply-partially'
+ ;; to make it up for the 3 args case.
+ (if (= (length
+ (help-function-arglist 'comint-redirect-filter)) 3)
+ (set-process-filter
+ process (apply-partially
+ #'comint-redirect-filter original-filter-fn))
+ (set-process-filter process #'comint-redirect-filter))
+ (process-send-string process input-to-send)
+ ;; Grab output until our dummy completion used as
+ ;; output end marker is found.
+ (when (python-shell-accept-process-output
+ process python-shell-completion-native-output-timeout
+ comint-redirect-finished-regexp)
+ (re-search-backward "0__dummy_completion__" nil t)
+ (cl-remove-duplicates
+ (split-string
+ (buffer-substring-no-properties
+ (line-beginning-position) (point-min))
+ "[ \f\t\n\r\v()]+" t)
+ :test #'string=))))
+ (set-process-filter process original-filter-fn)))))
+
+(defun python-shell-completion-get-completions (process import input)
+ "Do completion at point using PROCESS for IMPORT or INPUT.
+When IMPORT is non-nil takes precedence over INPUT for
+completion."
+ (setq input (or import input))
+ (with-current-buffer (process-buffer process)
+ (let ((completions
+ (python-util-strip-string
+ (python-shell-send-string-no-output
+ (format
+ (concat python-shell-completion-setup-code
+ "\nprint (" python-shell-completion-string-code ")")
+ input) process))))
+ (when (> (length completions) 2)
+ (split-string completions
+ "^'\\|^\"\\|;\\|'$\\|\"$" t)))))
+
+(defun python-shell-completion-at-point (&optional process)
+ "Function for `completion-at-point-functions' in `inferior-python-mode'.
Optional argument PROCESS forces completions to be retrieved
using that one instead of current buffer's process."
(setq process (or process (get-buffer-process (current-buffer))))
- (let* ((start
+ (let* ((line-start (if (derived-mode-p 'inferior-python-mode)
+ ;; Working on a shell buffer: use prompt end.
+ (cdr (python-util-comint-last-prompt))
+ (line-beginning-position)))
+ (import-statement
+ (when (string-match-p
+ (rx (* space) word-start (or "from" "import") word-end space)
+ (buffer-substring-no-properties line-start (point)))
+ (buffer-substring-no-properties line-start (point))))
+ (start
(save-excursion
- (with-syntax-table python-dotty-syntax-table
- (let* ((paren-depth (car (syntax-ppss)))
- (syntax-string "w_")
- (syntax-list (string-to-syntax syntax-string)))
- ;; Stop scanning for the beginning of the completion
- ;; subject after the char before point matches a
- ;; delimiter
- (while (member
- (car (syntax-after (1- (point)))) syntax-list)
- (skip-syntax-backward syntax-string)
- (when (or (equal (char-before) ?\))
- (equal (char-before) ?\"))
- (forward-char -1))
- (while (or
- ;; honor initial paren depth
- (> (car (syntax-ppss)) paren-depth)
- (python-syntax-context 'string))
- (forward-char -1)))
- (point)))))
- (end (point)))
+ (if (not (re-search-backward
+ (python-rx
+ (or whitespace open-paren close-paren string-delimiter))
+ line-start
+ t 1))
+ line-start
+ (forward-char (length (match-string-no-properties 0)))
+ (point))))
+ (end (point))
+ (prompt-boundaries (python-util-comint-last-prompt))
+ (prompt
+ (with-current-buffer (process-buffer process)
+ (when prompt-boundaries
+ (buffer-substring-no-properties
+ (car prompt-boundaries) (cdr prompt-boundaries)))))
+ (completion-fn
+ (with-current-buffer (process-buffer process)
+ (cond ((or (null prompt)
+ (< (point) (cdr prompt-boundaries)))
+ #'ignore)
+ ((or (not python-shell-completion-native-enable)
+ ;; Even if native completion is enabled, for
+ ;; pdb interaction always use the fallback
+ ;; mechanism since the completer is changed.
+ ;; Also, since pdb interaction is single-line
+ ;; based, this is enough.
+ (string-match-p python-shell-prompt-pdb-regexp prompt))
+ #'python-shell-completion-get-completions)
+ (t #'python-shell-completion-native-get-completions)))))
(list start end
(completion-table-dynamic
(apply-partially
- #'python-shell-completion-get-completions
- process (buffer-substring-no-properties
- (line-beginning-position) end))))))
+ completion-fn
+ process import-statement)))))
+
+(define-obsolete-function-alias
+ 'python-shell-completion-complete-at-point
+ 'python-shell-completion-at-point
+ "25.1")
(defun python-shell-completion-complete-or-indent ()
"Complete or indent depending on the context.
-If content before pointer is all whitespace indent. If not try
-to complete."
+If content before pointer is all whitespace, indent.
+If not try to complete."
(interactive)
(if (string-match "^[[:space:]]*$"
(buffer-substring (comint-line-beginning-position)
- (point-marker)))
+ (point)))
(indent-for-tab-command)
(completion-at-point)))
@@ -2364,14 +3615,14 @@ to complete."
;;; PDB Track integration
(defcustom python-pdbtrack-activate t
- "Non-nil makes python shell enable pdbtracking."
+ "Non-nil makes Python shell enable pdbtracking."
:type 'boolean
:group 'python
:safe 'booleanp)
(defcustom python-pdbtrack-stacktrace-info-regexp
- "^> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
- "Regular Expression matching stacktrace information.
+ "> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()"
+ "Regular expression matching stacktrace information.
Used to extract the current line and module being inspected."
:type 'string
:group 'python
@@ -2389,10 +3640,18 @@ Never set this variable directly, use
"Set the buffer for FILE-NAME as the tracked buffer.
Internally it uses the `python-pdbtrack-tracked-buffer' variable.
Returns the tracked buffer."
- (let ((file-buffer (get-file-buffer file-name)))
+ (let* ((file-name-prospect (concat (file-remote-p default-directory)
+ file-name))
+ (file-buffer (get-file-buffer file-name-prospect)))
(if file-buffer
(setq python-pdbtrack-tracked-buffer file-buffer)
- (setq file-buffer (find-file-noselect file-name))
+ (cond
+ ((file-exists-p file-name-prospect)
+ (setq file-buffer (find-file-noselect file-name-prospect)))
+ ((and (not (equal file-name file-name-prospect))
+ (file-exists-p file-name))
+ ;; Fallback to a locally available copy of the file.
+ (setq file-buffer (find-file-noselect file-name-prospect))))
(when (not (member file-buffer python-pdbtrack-buffers-to-kill))
(add-to-list 'python-pdbtrack-buffers-to-kill file-buffer)))
file-buffer))
@@ -2453,18 +3712,19 @@ Argument OUTPUT is a string with the output from the comint process."
;;; Symbol completion
-(defun python-completion-complete-at-point ()
- "Complete current symbol at point.
-For this to work the best as possible you should call
+(defun python-completion-at-point ()
+ "Function for `completion-at-point-functions' in `python-mode'.
+For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
-inferior python process is updated properly."
+inferior Python process is updated properly."
(let ((process (python-shell-get-process)))
- (if (not process)
- (error "Completion needs an inferior Python process running")
- (python-shell-completion-complete-at-point process))))
+ (when process
+ (python-shell-completion-at-point process))))
-(add-to-list 'debug-ignored-errors
- "^Completion needs an inferior Python process running.")
+(define-obsolete-function-alias
+ 'python-completion-complete-at-point
+ 'python-completion-at-point
+ "25.1")
;;; Fill paragraph
@@ -2502,12 +3762,12 @@ fill parens."
This affects `python-fill-string' behavior with regards to
triple quotes positioning.
-Possible values are DJANGO, ONETWO, PEP-257, PEP-257-NN,
-SYMMETRIC, and NIL. A value of NIL won't care about quotes
+Possible values are `django', `onetwo', `pep-257', `pep-257-nn',
+`symmetric', and nil. A value of nil won't care about quotes
position and will treat docstrings a normal string, any other
value may result in one of the following docstring styles:
-DJANGO:
+`django':
\"\"\"
Process foo, return bar.
@@ -2519,7 +3779,7 @@ DJANGO:
If processing fails throw ProcessingError.
\"\"\"
-ONETWO:
+`onetwo':
\"\"\"Process foo, return bar.\"\"\"
@@ -2530,7 +3790,7 @@ ONETWO:
\"\"\"
-PEP-257:
+`pep-257':
\"\"\"Process foo, return bar.\"\"\"
@@ -2540,7 +3800,7 @@ PEP-257:
\"\"\"
-PEP-257-NN:
+`pep-257-nn':
\"\"\"Process foo, return bar.\"\"\"
@@ -2549,7 +3809,7 @@ PEP-257-NN:
If processing fails throw ProcessingError.
\"\"\"
-SYMMETRIC:
+`symmetric':
\"\"\"Process foo, return bar.\"\"\"
@@ -2607,8 +3867,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(defun python-fill-string (&optional justify)
"String fill function for `python-fill-paragraph'.
JUSTIFY should be used (if applicable) as in `fill-paragraph'."
- (let* ((marker (point-marker))
- (str-start-pos
+ (let* ((str-start-pos
(set-marker
(make-marker)
(or (python-syntax-context 'string)
@@ -2638,17 +3897,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(`pep-257 (and multi-line-p (cons nil 2)))
(`pep-257-nn (and multi-line-p (cons nil 1)))
(`symmetric (and multi-line-p (cons 1 1)))))
- (docstring-p (save-excursion
- ;; Consider docstrings those strings which
- ;; start on a line by themselves.
- (python-nav-beginning-of-statement)
- (and (= (point) str-start-pos))))
(fill-paragraph-function))
(save-restriction
(narrow-to-region str-start-pos str-end-pos)
(fill-paragraph justify))
(save-excursion
- (when (and docstring-p python-fill-docstring-style)
+ (when (and (python-info-docstring-p) python-fill-docstring-style)
;; Add the number of newlines indicated by the selected style
;; at the start of the docstring.
(goto-char (+ str-start-pos num-quotes))
@@ -2674,7 +3928,7 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
;; Again indent only if a newline is added.
(indent-according-to-mode))))) t)
-(defun python-fill-decorator (&optional justify)
+(defun python-fill-decorator (&optional _justify)
"Decorator fill function for `python-fill-paragraph'.
JUSTIFY should be used (if applicable) as in `fill-paragraph'."
t)
@@ -2685,17 +3939,17 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(save-restriction
(narrow-to-region (progn
(while (python-syntax-context 'paren)
- (goto-char (1- (point-marker))))
- (point-marker)
+ (goto-char (1- (point))))
(line-beginning-position))
(progn
(when (not (python-syntax-context 'paren))
(end-of-line)
(when (not (python-syntax-context 'paren))
(skip-syntax-backward "^)")))
- (while (python-syntax-context 'paren)
- (goto-char (1+ (point-marker))))
- (point-marker)))
+ (while (and (python-syntax-context 'paren)
+ (not (eobp)))
+ (goto-char (1+ (point))))
+ (point)))
(let ((paragraph-start "\f\\|[ \t]*$")
(paragraph-separate ",")
(fill-paragraph-function))
@@ -2704,7 +3958,8 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'."
(while (not (eobp))
(forward-line 1)
(python-indent-line)
- (goto-char (line-end-position)))) t)
+ (goto-char (line-end-position))))
+ t)
;;; Skeletons
@@ -2761,8 +4016,8 @@ The skeleton will be bound to python-skeleton-NAME."
(declare (indent 2))
(let* ((name (symbol-name name))
(function-name (intern (concat "python-skeleton--" name)))
- (msg (format
- "Add '%s' clause? " name)))
+ (msg (format-message
+ "Add `%s' clause? " name)))
(when (not skel)
(setq skel
`(< ,(format "%s:" name) \n \n
@@ -2803,6 +4058,12 @@ The skeleton will be bound to python-skeleton-NAME."
> _ \n
'(python-skeleton--else) | ^)
+(python-skeleton-define import nil
+ "Import from module: "
+ "from " str & " " | -5
+ "import "
+ ("Identifier: " str ", ") -2 \n _)
+
(python-skeleton-define try nil
nil
"try:" \n
@@ -2829,15 +4090,14 @@ The skeleton will be bound to python-skeleton-NAME."
"class " str "(" ("Inheritance, %s: "
(unless (equal ?\( (char-before)) ", ")
str)
- & ")" | -2
+ & ")" | -1
":" \n
"\"\"\"" - "\"\"\"" \n
> _ \n)
(defun python-skeleton-add-menu-items ()
"Add menu items to Python->Skeletons menu."
- (let ((skeletons (sort python-skeleton-available 'string<))
- (items))
+ (let ((skeletons (sort python-skeleton-available 'string<)))
(dolist (skeleton skeletons)
(easy-menu-add-item
nil '("Python" "Skeletons")
@@ -2848,13 +4108,22 @@ The skeleton will be bound to python-skeleton-NAME."
;;; FFAP
(defcustom python-ffap-setup-code
- "def __FFAP_get_module_path(module):
+ "
+def __FFAP_get_module_path(objstr):
try:
- import os
- path = __import__(module).__file__
- if path[-4:] == '.pyc' and os.path.exists(path[0:-1]):
- path = path[:-1]
- return path
+ import inspect
+ import os.path
+ # NameError exceptions are delayed until this point.
+ obj = eval(objstr)
+ module = inspect.getmodule(obj)
+ filename = module.__file__
+ ext = os.path.splitext(filename)[1]
+ if ext in ('.pyc', '.pyo'):
+ # Point to the source file.
+ filename = filename[:-1]
+ if os.path.exists(filename):
+ return filename
+ return ''
except:
return ''"
"Python code to get a module path."
@@ -2862,7 +4131,7 @@ The skeleton will be bound to python-skeleton-NAME."
:group 'python)
(defcustom python-ffap-string-code
- "__FFAP_get_module_path('''%s''')\n"
+ "__FFAP_get_module_path('''%s''')"
"Python code used to get a string with the path of a module."
:type 'string
:group 'python)
@@ -2870,16 +4139,19 @@ The skeleton will be bound to python-skeleton-NAME."
(defun python-ffap-module-path (module)
"Function for `ffap-alist' to return path for MODULE."
(let ((process (or
- (and (eq major-mode 'inferior-python-mode)
+ (and (derived-mode-p 'inferior-python-mode)
(get-buffer-process (current-buffer)))
(python-shell-get-process))))
(if (not process)
nil
(let ((module-file
(python-shell-send-string-no-output
- (format python-ffap-string-code module) process)))
- (when module-file
- (substring-no-properties module-file 1 -1))))))
+ (concat
+ python-ffap-setup-code
+ "\nprint (" (format python-ffap-string-code module) ")")
+ process)))
+ (unless (zerop (length module-file))
+ (python-util-strip-string module-file))))))
(defvar ffap-alist)
@@ -2892,7 +4164,9 @@ The skeleton will be bound to python-skeleton-NAME."
;;; Code check
(defcustom python-check-command
- "pyflakes"
+ (or (executable-find "pyflakes")
+ (executable-find "epylint")
+ "install pyflakes, pylint or something else")
"Command used to check a Python file."
:type 'string
:group 'python)
@@ -2905,11 +4179,13 @@ The skeleton will be bound to python-skeleton-NAME."
(defvar python-check-custom-command nil
"Internal use.")
+;; XXX: Avoid `defvar-local' for compat with Emacs<24.3
+(make-variable-buffer-local 'python-check-custom-command)
(defun python-check (command)
"Check a Python file (default current buffer's file).
-Runs COMMAND, a shell command, as if by `compile'. See
-`python-check-command' for the default."
+Runs COMMAND, a shell command, as if by `compile'.
+See `python-check-command' for the default."
(interactive
(list (read-string "Check command: "
(or python-check-custom-command
@@ -2922,10 +4198,9 @@ Runs COMMAND, a shell command, as if by `compile'. See
"")))))))
(setq python-check-custom-command command)
(save-some-buffers (not compilation-ask-about-save) nil)
- (let ((process-environment (python-shell-calculate-process-environment))
- (exec-path (python-shell-calculate-exec-path)))
+ (python-shell-with-environment
(compilation-start command nil
- (lambda (mode-name)
+ (lambda (_modename)
(format python-check-buffer-name command)))))
@@ -2935,7 +4210,11 @@ Runs COMMAND, a shell command, as if by `compile'. See
"def __PYDOC_get_help(obj):
try:
import inspect
- if hasattr(obj, 'startswith'):
+ try:
+ str_type = basestring
+ except NameError:
+ str_type = str
+ if isinstance(obj, str_type):
obj = eval(obj, globals())
doc = inspect.getdoc(obj)
if not doc and callable(obj):
@@ -2958,48 +4237,65 @@ Runs COMMAND, a shell command, as if by `compile'. See
doc = doc.splitlines()[0]
except:
doc = ''
- try:
- exec('print doc')
- except SyntaxError:
- print(doc)"
+ return doc"
"Python code to setup documentation retrieval."
:type 'string
:group 'python)
(defcustom python-eldoc-string-code
- "__PYDOC_get_help('''%s''')\n"
+ "__PYDOC_get_help('''%s''')"
"Python code used to get a string with the documentation of an object."
:type 'string
:group 'python)
+(defun python-eldoc--get-symbol-at-point ()
+ "Get the current symbol for eldoc.
+Returns the current symbol handling point within arguments."
+ (save-excursion
+ (let ((start (python-syntax-context 'paren)))
+ (when start
+ (goto-char start))
+ (when (or start
+ (eobp)
+ (memq (char-syntax (char-after)) '(?\ ?-)))
+ ;; Try to adjust to closest symbol if not in one.
+ (python-util-forward-comment -1)))
+ (python-info-current-symbol t)))
+
(defun python-eldoc--get-doc-at-point (&optional force-input force-process)
"Internal implementation to get documentation at point.
-If not FORCE-INPUT is passed then what
-`python-info-current-symbol' returns will be used. If not
-FORCE-PROCESS is passed what `python-shell-get-process' returns
-is used."
+If not FORCE-INPUT is passed then what `python-eldoc--get-symbol-at-point'
+returns will be used. If not FORCE-PROCESS is passed what
+`python-shell-get-process' returns is used."
(let ((process (or force-process (python-shell-get-process))))
- (if (not process)
- (error "Eldoc needs an inferior Python process running")
- (let ((input (or force-input
- (python-info-current-symbol t))))
- (and input
- (python-shell-send-string-no-output
- (format python-eldoc-string-code input)
- process))))))
+ (when process
+ (let* ((input (or force-input
+ (python-eldoc--get-symbol-at-point)))
+ (docstring
+ (when input
+ ;; Prevent resizing the echo area when iPython is
+ ;; enabled. Bug#18794.
+ (python-util-strip-string
+ (python-shell-send-string-no-output
+ (concat
+ python-eldoc-setup-code
+ "\nprint(" (format python-eldoc-string-code input) ")")
+ process)))))
+ (unless (zerop (length docstring))
+ docstring)))))
(defun python-eldoc-function ()
"`eldoc-documentation-function' for Python.
-For this to work the best as possible you should call
+For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
-inferior python process is updated properly."
+inferior Python process is updated properly."
(python-eldoc--get-doc-at-point))
(defun python-eldoc-at-point (symbol)
"Get help on SYMBOL using `help'.
Interactively, prompt for symbol."
(interactive
- (let ((symbol (python-info-current-symbol t))
+ (let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
(list (read-string (if symbol
(format "Describe symbol (default %s): " symbol)
@@ -3007,8 +4303,16 @@ Interactively, prompt for symbol."
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
-(add-to-list 'debug-ignored-errors
- "^Eldoc needs an inferior Python process running.")
+
+;;; Hideshow
+
+(defun python-hideshow-forward-sexp-function (arg)
+ "Python specific `forward-sexp' function for `hs-minor-mode'.
+Argument ARG is ignored."
+ arg ; Shut up, byte compiler.
+ (python-nav-end-of-defun)
+ (unless (python-info-current-line-empty-p)
+ (backward-char)))
;;; Imenu
@@ -3029,15 +4333,15 @@ It must be a function with two arguments: TYPE and NAME.")
It must be a function with two arguments: TYPE and NAME.")
(defun python-imenu-format-item-label (type name)
- "Return imenu label for single node using TYPE and NAME."
+ "Return Imenu label for single node using TYPE and NAME."
(format "%s (%s)" name type))
(defun python-imenu-format-parent-item-label (type name)
- "Return imenu label for parent node using TYPE and NAME."
+ "Return Imenu label for parent node using TYPE and NAME."
(format "%s..." (python-imenu-format-item-label type name)))
-(defun python-imenu-format-parent-item-jump-label (type name)
- "Return imenu label for parent node jump using TYPE and NAME."
+(defun python-imenu-format-parent-item-jump-label (type _name)
+ "Return Imenu label for parent node jump using TYPE and NAME."
(if (string= type "class")
"*class definition*"
"*function definition*"))
@@ -3054,7 +4358,7 @@ It must be a function with two arguments: TYPE and NAME.")
(defun python-imenu--build-tree (&optional min-indent prev-indent tree)
"Recursively build the tree of nested definitions of a node.
-Arguments MIN-INDENT PREV-INDENT and TREE are internal and should
+Arguments MIN-INDENT, PREV-INDENT and TREE are internal and should
not be passed explicitly unless you know what you are doing."
(setq min-indent (or min-indent 0)
prev-indent (or prev-indent python-indent-offset))
@@ -3095,7 +4399,7 @@ not be passed explicitly unless you know what you are doing."
tree)))))))
(defun python-imenu-create-index ()
- "Return tree Imenu alist for the current python buffer.
+ "Return tree Imenu alist for the current Python buffer.
Change `python-imenu-format-item-label-function',
`python-imenu-format-parent-item-label-function',
`python-imenu-format-parent-item-jump-label-function' to
@@ -3108,18 +4412,19 @@ customize how labels are formatted."
index))
(defun python-imenu-create-flat-index (&optional alist prefix)
- "Return flat outline of the current python buffer for Imenu.
-Optional Argument ALIST is the tree to be flattened, when nil
+ "Return flat outline of the current Python buffer for Imenu.
+Optional argument ALIST is the tree to be flattened; when nil
`python-imenu-build-index' is used with
`python-imenu-format-parent-item-jump-label-function'
`python-imenu-format-parent-item-label-function'
-`python-imenu-format-item-label-function' set to (lambda (type
-name) name). Optional Argument PREFIX is used in recursive calls
-and should not be passed explicitly.
+`python-imenu-format-item-label-function' set to
+ (lambda (type name) name)
+Optional argument PREFIX is used in recursive calls and should
+not be passed explicitly.
Converts this:
- \((\"Foo\" . 103)
+ ((\"Foo\" . 103)
(\"Bar\" . 138)
(\"decorator\"
(\"decorator\" . 173)
@@ -3129,7 +4434,7 @@ Converts this:
To this:
- \((\"Foo\" . 103)
+ ((\"Foo\" . 103)
(\"Bar\" . 138)
(\"decorator\" . 173)
(\"decorator.wrap\" . 353)
@@ -3150,7 +4455,7 @@ To this:
(cons name (cdar pos))
(python-imenu-create-flat-index (cddr item) name))))))
(or alist
- (let* ((fn (lambda (type name) name))
+ (let* ((fn (lambda (_type name) name))
(python-imenu-format-item-label-function fn)
(python-imenu-format-parent-item-label-function fn)
(python-imenu-format-parent-item-jump-label-function fn))
@@ -3162,11 +4467,10 @@ To this:
(defun python-info-current-defun (&optional include-type)
"Return name of surrounding function with Python compatible dotty syntax.
Optional argument INCLUDE-TYPE indicates to include the type of the defun.
-This function is compatible to be used as
-`add-log-current-defun-function' since it returns nil if point is
-not inside a defun."
+This function can be used as the value of `add-log-current-defun-function'
+since it returns nil if point is not inside a defun."
(save-restriction
- (widen)
+ (prog-widen)
(save-excursion
(end-of-line 1)
(let ((names)
@@ -3283,55 +4587,94 @@ parent defun name."
(and (python-info-end-of-statement-p)
(python-info-statement-ends-block-p)))
-(defun python-info-closing-block ()
- "Return the point of the block the current line closes."
- (let ((closing-word (save-excursion
- (back-to-indentation)
- (current-word)))
- (indentation (current-indentation)))
- (when (member closing-word python-indent-dedenters)
+(define-obsolete-function-alias
+ 'python-info-closing-block
+ 'python-info-dedenter-opening-block-position "24.4")
+
+(defun python-info-dedenter-opening-block-position ()
+ "Return the point of the closest block the current line closes.
+Returns nil if point is not on a dedenter statement or no opening
+block can be detected. The latter case meaning current file is
+likely an invalid python file."
+ (let ((positions (python-info-dedenter-opening-block-positions))
+ (indentation (current-indentation))
+ (position))
+ (while (and (not position)
+ positions)
(save-excursion
- (forward-line -1)
- (while (and (> (current-indentation) indentation)
- (not (bobp))
- (not (back-to-indentation))
- (forward-line -1)))
- (back-to-indentation)
- (cond
- ((not (equal indentation (current-indentation))) nil)
- ((string= closing-word "elif")
- (when (member (current-word) '("if" "elif"))
- (point-marker)))
- ((string= closing-word "else")
- (when (member (current-word) '("if" "elif" "except" "for" "while"))
- (point-marker)))
- ((string= closing-word "except")
- (when (member (current-word) '("try"))
- (point-marker)))
- ((string= closing-word "finally")
- (when (member (current-word) '("except" "else"))
- (point-marker))))))))
-
-(defun python-info-closing-block-message (&optional closing-block-point)
- "Message the contents of the block the current line closes.
-With optional argument CLOSING-BLOCK-POINT use that instead of
-recalculating it calling `python-info-closing-block'."
- (let ((point (or closing-block-point (python-info-closing-block))))
+ (goto-char (car positions))
+ (if (<= (current-indentation) indentation)
+ (setq position (car positions))
+ (setq positions (cdr positions)))))
+ position))
+
+(defun python-info-dedenter-opening-block-positions ()
+ "Return points of blocks the current line may close sorted by closer.
+Returns nil if point is not on a dedenter statement or no opening
+block can be detected. The latter case meaning current file is
+likely an invalid python file."
+ (save-excursion
+ (let ((dedenter-pos (python-info-dedenter-statement-p)))
+ (when dedenter-pos
+ (goto-char dedenter-pos)
+ (let* ((pairs '(("elif" "elif" "if")
+ ("else" "if" "elif" "except" "for" "while")
+ ("except" "except" "try")
+ ("finally" "else" "except" "try")))
+ (dedenter (match-string-no-properties 0))
+ (possible-opening-blocks (cdr (assoc-string dedenter pairs)))
+ (collected-indentations)
+ (opening-blocks))
+ (catch 'exit
+ (while (python-nav--syntactically
+ (lambda ()
+ (re-search-backward (python-rx block-start) nil t))
+ #'<)
+ (let ((indentation (current-indentation)))
+ (when (and (not (memq indentation collected-indentations))
+ (or (not collected-indentations)
+ (< indentation (apply #'min collected-indentations))))
+ (setq collected-indentations
+ (cons indentation collected-indentations))
+ (when (member (match-string-no-properties 0)
+ possible-opening-blocks)
+ (setq opening-blocks (cons (point) opening-blocks))))
+ (when (zerop indentation)
+ (throw 'exit nil)))))
+ ;; sort by closer
+ (nreverse opening-blocks))))))
+
+(define-obsolete-function-alias
+ 'python-info-closing-block-message
+ 'python-info-dedenter-opening-block-message "24.4")
+
+(defun python-info-dedenter-opening-block-message ()
+ "Message the first line of the block the current statement closes."
+ (let ((point (python-info-dedenter-opening-block-position)))
(when point
(save-restriction
- (widen)
+ (prog-widen)
(message "Closes %s" (save-excursion
(goto-char point)
- (back-to-indentation)
(buffer-substring
(point) (line-end-position))))))))
+(defun python-info-dedenter-statement-p ()
+ "Return point if current statement is a dedenter.
+Sets `match-data' to the keyword that starts the dedenter
+statement."
+ (save-excursion
+ (python-nav-beginning-of-statement)
+ (when (and (not (python-syntax-context-type))
+ (looking-at (python-rx dedenter)))
+ (point))))
+
(defun python-info-line-ends-backslash-p (&optional line-number)
"Return non-nil if current line ends with backslash.
With optional argument LINE-NUMBER, check that line instead."
(save-excursion
(save-restriction
- (widen)
+ (prog-widen)
(when line-number
(python-util-goto-line line-number))
(while (and (not (eobp))
@@ -3347,7 +4690,7 @@ With optional argument LINE-NUMBER, check that line instead."
Optional argument LINE-NUMBER forces the line number to check against."
(save-excursion
(save-restriction
- (widen)
+ (prog-widen)
(when line-number
(python-util-goto-line line-number))
(when (python-info-line-ends-backslash-p)
@@ -3364,7 +4707,7 @@ When current line is continuation of another return the point
where the continued line ends."
(save-excursion
(save-restriction
- (widen)
+ (prog-widen)
(let* ((context-type (progn
(back-to-indentation)
(python-syntax-context-type)))
@@ -3401,23 +4744,40 @@ where the continued line ends."
(when (looking-at (python-rx block-start))
(point-marker)))))
+(defun python-info-assignment-statement-p (&optional current-line-only)
+ "Check if current line is an assignment.
+With argument CURRENT-LINE-ONLY is non-nil, don't follow any
+continuations, just check the if current line is an assignment."
+ (save-excursion
+ (let ((found nil))
+ (if current-line-only
+ (back-to-indentation)
+ (python-nav-beginning-of-statement))
+ (while (and
+ (re-search-forward (python-rx not-simple-operator
+ assignment-operator
+ (group not-simple-operator))
+ (line-end-position) t)
+ (not found))
+ (save-excursion
+ ;; The assignment operator should not be inside a string.
+ (backward-char (length (match-string-no-properties 1)))
+ (setq found (not (python-syntax-context-type)))))
+ (when found
+ (skip-syntax-forward " ")
+ (point-marker)))))
+
+;; TODO: rename to clarify this is only for the first continuation
+;; line or remove it and move its body to `python-indent-context'.
(defun python-info-assignment-continuation-line-p ()
- "Check if current line is a continuation of an assignment.
+ "Check if current line is the first continuation of an assignment.
When current line is continuation of another with an assignment
return the point of the first non-blank character after the
operator."
(save-excursion
(when (python-info-continuation-line-p)
(forward-line -1)
- (back-to-indentation)
- (when (and (not (looking-at (python-rx block-start)))
- (and (re-search-forward (python-rx not-simple-operator
- assignment-operator
- not-simple-operator)
- (line-end-position) t)
- (not (python-syntax-context-type))))
- (skip-syntax-forward "\s")
- (point-marker)))))
+ (python-info-assignment-statement-p t))))
(defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss)
"Check if point is at `beginning-of-defun' using SYNTAX-PPSS."
@@ -3427,13 +4787,13 @@ operator."
(looking-at python-nav-beginning-of-defun-regexp))))
(defun python-info-current-line-comment-p ()
- "Check if current line is a comment line."
+ "Return non-nil if current line is a comment line."
(char-equal
(or (char-after (+ (line-beginning-position) (current-indentation))) ?_)
?#))
(defun python-info-current-line-empty-p ()
- "Check if current line is empty, ignoring whitespace."
+ "Return non-nil if current line is empty, ignoring whitespace."
(save-excursion
(beginning-of-line 1)
(looking-at
@@ -3442,6 +4802,72 @@ operator."
(* whitespace) line-end))
(string-equal "" (match-string-no-properties 1))))
+(defun python-info-docstring-p (&optional syntax-ppss)
+ "Return non-nil if point is in a docstring.
+When optional argument SYNTAX-PPSS is given, use that instead of
+point's current `syntax-ppss'."
+ ;;; https://www.python.org/dev/peps/pep-0257/#what-is-a-docstring
+ (save-excursion
+ (when (and syntax-ppss (python-syntax-context 'string syntax-ppss))
+ (goto-char (nth 8 syntax-ppss)))
+ (python-nav-beginning-of-statement)
+ (let ((counter 1)
+ (indentation (current-indentation))
+ (backward-sexp-point)
+ (re (concat "[uU]?[rR]?"
+ (python-rx string-delimiter))))
+ (when (and
+ (not (python-info-assignment-statement-p))
+ (looking-at-p re)
+ ;; Allow up to two consecutive docstrings only.
+ (>=
+ 2
+ (progn
+ (while (save-excursion
+ (python-nav-backward-sexp)
+ (setq backward-sexp-point (point))
+ (and (= indentation (current-indentation))
+ (not (bobp)) ; Prevent infloop.
+ (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))
+ counter)))
+ (python-util-forward-comment -1)
+ (python-nav-beginning-of-statement)
+ (cond ((bobp))
+ ((python-info-assignment-statement-p) t)
+ ((python-info-looking-at-beginning-of-defun))
+ (t nil))))))
+
+(defun python-info-encoding-from-cookie ()
+ "Detect current buffer's encoding from its coding cookie.
+Returns the encoding as a symbol."
+ (let ((first-two-lines
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line 2)
+ (buffer-substring-no-properties
+ (point)
+ (point-min))))))
+ (when (string-match (python-rx coding-cookie) first-two-lines)
+ (intern (match-string-no-properties 1 first-two-lines)))))
+
+(defun python-info-encoding ()
+ "Return encoding for file.
+Try `python-info-encoding-from-cookie', if none is found then
+default to utf-8."
+ ;; If no encoding is defined, then it's safe to use UTF-8: Python 2
+ ;; uses ASCII as default while Python 3 uses UTF-8. This means that
+ ;; in the worst case scenario python.el will make things work for
+ ;; Python 2 files with unicode data and no encoding defined.
+ (or (python-info-encoding-from-cookie)
+ 'utf-8))
+
;;; Utility functions
@@ -3464,6 +4890,18 @@ to \"^python-\"."
(cdr pair))))
(buffer-local-variables from-buffer)))
+(defvar comint-last-prompt-overlay) ; Shut up, byte compiler.
+
+(defun python-util-comint-last-prompt ()
+ "Return comint last prompt overlay start and end.
+This is for compatibility with Emacs < 24.4."
+ (cond ((bound-and-true-p comint-last-prompt-overlay)
+ (cons (overlay-start comint-last-prompt-overlay)
+ (overlay-end comint-last-prompt-overlay)))
+ ((bound-and-true-p comint-last-prompt)
+ comint-last-prompt)
+ (t nil)))
+
(defun python-util-forward-comment (&optional direction)
"Python mode specific version of `forward-comment'.
Optional argument DIRECTION defines the direction to move to."
@@ -3475,11 +4913,73 @@ Optional argument DIRECTION defines the direction to move to."
(goto-char comment-start))
(forward-comment factor)))
+(defun python-util-list-directories (directory &optional predicate max-depth)
+ "List DIRECTORY subdirs, filtered by PREDICATE and limited by MAX-DEPTH.
+Argument PREDICATE defaults to `identity' and must be a function
+that takes one argument (a full path) and returns non-nil for
+allowed files. When optional argument MAX-DEPTH is non-nil, stop
+searching when depth is reached, else don't limit."
+ (let* ((dir (expand-file-name directory))
+ (dir-length (length dir))
+ (predicate (or predicate #'identity))
+ (to-scan (list dir))
+ (tally nil))
+ (while to-scan
+ (let ((current-dir (car to-scan)))
+ (when (funcall predicate current-dir)
+ (setq tally (cons current-dir tally)))
+ (setq to-scan (append (cdr to-scan)
+ (python-util-list-files
+ current-dir #'file-directory-p)
+ nil))
+ (when (and max-depth
+ (<= max-depth
+ (length (split-string
+ (substring current-dir dir-length)
+ "/\\|\\\\" t))))
+ (setq to-scan nil))))
+ (nreverse tally)))
+
+(defun python-util-list-files (dir &optional predicate)
+ "List files in DIR, filtering with PREDICATE.
+Argument PREDICATE defaults to `identity' and must be a function
+that takes one argument (a full path) and returns non-nil for
+allowed files."
+ (let ((dir-name (file-name-as-directory dir)))
+ (apply #'nconc
+ (mapcar (lambda (file-name)
+ (let ((full-file-name (expand-file-name file-name dir-name)))
+ (when (and
+ (not (member file-name '("." "..")))
+ (funcall (or predicate #'identity) full-file-name))
+ (list full-file-name))))
+ (directory-files dir-name)))))
+
+(defun python-util-list-packages (dir &optional max-depth)
+ "List packages in DIR, limited by MAX-DEPTH.
+When optional argument MAX-DEPTH is non-nil, stop searching when
+depth is reached, else don't limit."
+ (let* ((dir (expand-file-name dir))
+ (parent-dir (file-name-directory
+ (directory-file-name
+ (file-name-directory
+ (file-name-as-directory dir)))))
+ (subpath-length (length parent-dir)))
+ (mapcar
+ (lambda (file-name)
+ (replace-regexp-in-string
+ (rx (or ?\\ ?/)) "." (substring file-name subpath-length)))
+ (python-util-list-directories
+ (directory-file-name dir)
+ (lambda (dir)
+ (file-exists-p (expand-file-name "__init__.py" dir)))
+ max-depth))))
+
(defun python-util-popn (lst n)
"Return LST first N elements.
-N should be an integer, when it's a natural negative number its
-opposite is used. When N is bigger than the length of LST, the
-list is returned as is."
+N should be an integer, when negative its opposite is used.
+When N is bigger than the length of LST, the list is
+returned as is."
(let* ((n (min (abs n)))
(len (length lst))
(acc))
@@ -3491,14 +4991,36 @@ list is returned as is."
n (1- n)))
(reverse acc))))
+(defun python-util-strip-string (string)
+ "Strip STRING whitespace and newlines from end and beginning."
+ (replace-regexp-in-string
+ (rx (or (: string-start (* (any whitespace ?\r ?\n)))
+ (: (* (any whitespace ?\r ?\n)) string-end)))
+ ""
+ string))
+
+(defun python-util-valid-regexp-p (regexp)
+ "Return non-nil if REGEXP is valid."
+ (ignore-errors (string-match regexp "") t))
+
+(defun python-electric-pair-string-delimiter ()
+ (when (and electric-pair-mode
+ (memq last-command-event '(?\" ?\'))
+ (let ((count 0))
+ (while (eq (char-before (- (point) count)) last-command-event)
+ (cl-incf count))
+ (= count 3))
+ (eq (char-after) last-command-event))
+ (save-excursion (insert (make-string 2 last-command-event)))))
+
+(defvar electric-indent-inhibit)
+
;;;###autoload
(define-derived-mode python-mode prog-mode "Python"
"Major mode for editing Python files.
-\\{python-mode-map}
-Entry to this mode calls the value of `python-mode-hook'
-if that value is non-nil."
+\\{python-mode-map}"
(set (make-local-variable 'tab-width) 8)
(set (make-local-variable 'indent-tabs-mode) nil)
@@ -3512,7 +5034,10 @@ if that value is non-nil."
'python-nav-forward-sexp)
(set (make-local-variable 'font-lock-defaults)
- '(python-font-lock-keywords nil nil nil nil))
+ '(python-font-lock-keywords
+ nil nil nil nil
+ (font-lock-syntactic-face-function
+ . python-font-lock-syntactic-face-function)))
(set (make-local-variable 'syntax-propertize-function)
python-syntax-propertize-function)
@@ -3520,10 +5045,18 @@ if that value is non-nil."
(set (make-local-variable 'indent-line-function)
#'python-indent-line-function)
(set (make-local-variable 'indent-region-function) #'python-indent-region)
+ ;; Because indentation is not redundant, we cannot safely reindent code.
+ (set (make-local-variable 'electric-indent-inhibit) t)
+ (set (make-local-variable 'electric-indent-chars)
+ (cons ?: electric-indent-chars))
+
+ ;; Add """ ... """ pairing to electric-pair-mode.
+ (add-hook 'post-self-insert-hook
+ #'python-electric-pair-string-delimiter 'append t)
(set (make-local-variable 'paragraph-start) "\\s-*$")
(set (make-local-variable 'fill-paragraph-function)
- 'python-fill-paragraph)
+ #'python-fill-paragraph)
(set (make-local-variable 'beginning-of-defun-function)
#'python-nav-beginning-of-defun)
@@ -3531,10 +5064,10 @@ if that value is non-nil."
#'python-nav-end-of-defun)
(add-hook 'completion-at-point-functions
- 'python-completion-complete-at-point nil 'local)
+ #'python-completion-at-point nil 'local)
(add-hook 'post-self-insert-hook
- 'python-indent-post-self-insert-function nil 'local)
+ #'python-indent-post-self-insert-function 'append 'local)
(set (make-local-variable 'imenu-create-index-function)
#'python-imenu-create-index)
@@ -3550,24 +5083,35 @@ if that value is non-nil."
(current-column))))
(^ '(- (1+ (current-indentation))))))
- (set (make-local-variable 'eldoc-documentation-function)
- #'python-eldoc-function)
-
- (add-to-list 'hs-special-modes-alist
- `(python-mode "^\\s-*\\(?:def\\|class\\)\\>" nil "#"
- ,(lambda (arg)
- (python-nav-end-of-defun)) nil))
-
- (set (make-local-variable 'mode-require-final-newline) t)
+ (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))
+
+ (add-to-list
+ 'hs-special-modes-alist
+ `(python-mode
+ "\\s-*\\(?:def\\|class\\)\\>"
+ ;; Use the empty string as end regexp so it doesn't default to
+ ;; "\\s)". This way parens at end of defun are properly hidden.
+ ""
+ "#"
+ python-hideshow-forward-sexp-function
+ nil))
(set (make-local-variable 'outline-regexp)
(python-rx (* space) block-start))
- (set (make-local-variable 'outline-heading-end-regexp) ":\\s-*\n")
+ (set (make-local-variable 'outline-heading-end-regexp) ":[^\n]*\n")
(set (make-local-variable 'outline-level)
#'(lambda ()
"`outline-level' function for Python mode."
(1+ (/ (current-indentation) python-indent-offset))))
+ (set (make-local-variable 'prettify-symbols-alist)
+ python--prettify-symbols-alist)
+
(python-skeleton-add-menu-items)
(make-local-variable 'python-shell-internal-buffer)
@@ -3579,7 +5123,6 @@ if that value is non-nil."
(provide 'python)
;; Local Variables:
-;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index c8fae7ba1e6..09338860c75 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -1,6 +1,6 @@
;;; ruby-mode.el --- Major mode for editing Ruby files
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Authors: Yukihiro Matsumoto
;; Nobuyoshi Nakada
@@ -39,8 +39,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(defgroup ruby nil
"Major mode for editing Ruby code."
:prefix "ruby-"
@@ -108,7 +106,7 @@
"Regexp to match the beginning of a heredoc.")
(defconst ruby-expression-expansion-re
- "\\(?:[^\\]\\|\\=\\)\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)"))
+ "\\(?:[^\\]\\|\\=\\)\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\|\\$[^a-zA-Z \n]\\)\\)"))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
@@ -132,18 +130,16 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
ruby-block-end-re "\\|}\\|\\]\\)")
"Regexp to match where the indentation gets shallower.")
-(defconst ruby-operator-re "[-,.+*/%&|^~=<>:]"
+(defconst ruby-operator-re "[-,.+*/%&|^~=<>:]\\|\\\\$"
"Regexp to match operators.")
(defconst ruby-symbol-chars "a-zA-Z0-9_"
"List of characters that symbol names may contain.")
+
(defconst ruby-symbol-re (concat "[" ruby-symbol-chars "]")
"Regexp to match symbols.")
-(define-abbrev-table 'ruby-mode-abbrev-table ()
- "Abbrev table in use in Ruby mode buffers.")
-
-(defvar ruby-use-smie nil)
+(defvar ruby-use-smie t)
(defvar ruby-mode-map
(let ((map (make-sparse-keymap)))
@@ -151,12 +147,39 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(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))
(define-key map (kbd "M-C-p") 'ruby-beginning-of-block)
(define-key map (kbd "M-C-n") 'ruby-end-of-block)
(define-key map (kbd "C-c {") 'ruby-toggle-block)
+ (define-key map (kbd "C-c '") 'ruby-toggle-string-quotes)
map)
"Keymap used in Ruby mode.")
+(easy-menu-define
+ ruby-mode-menu
+ ruby-mode-map
+ "Ruby Mode Menu"
+ '("Ruby"
+ ["Beginning of Block" ruby-beginning-of-block t]
+ ["End of Block" ruby-end-of-block t]
+ ["Toggle Block" ruby-toggle-block t]
+ "--"
+ ["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]
+ ["Indent Sexp" ruby-indent-exp
+ :visible (not ruby-use-smie)]
+ ["Indent Sexp" prog-indent-sexp
+ :visible ruby-use-smie]))
+
(defvar ruby-mode-syntax-table
(let ((table (make-syntax-table)))
(modify-syntax-entry ?\' "\"" table)
@@ -166,7 +189,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(modify-syntax-entry ?\n ">" 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)
@@ -191,160 +213,489 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(defcustom ruby-indent-tabs-mode nil
"Indentation can insert tabs in Ruby mode if this is non-nil."
- :type 'boolean :group 'ruby)
+ :type 'boolean
+ :group 'ruby
+ :safe 'booleanp)
(defcustom ruby-indent-level 2
"Indentation of Ruby statements."
- :type 'integer :group 'ruby)
+ :type 'integer
+ :group 'ruby
+ :safe 'integerp)
-(defcustom ruby-comment-column 32
+(defcustom ruby-comment-column (default-value 'comment-column)
"Indentation column of comments."
- :type 'integer :group 'ruby)
+ :type 'integer
+ :group 'ruby
+ :safe 'integerp)
+
+(defconst ruby-alignable-keywords '(if while unless until begin case for def)
+ "Keywords that can be used in `ruby-align-to-stmt-keywords'.")
+
+(defcustom ruby-align-to-stmt-keywords '(def)
+ "Keywords after which we align the expression body to statement.
+
+When nil, an expression that begins with one these keywords is
+indented to the column of the keyword. Example:
+
+ tee = if foo
+ bar
+ else
+ qux
+ end
+
+If this value is t or contains a symbol with the name of given
+keyword, the expression is indented to align to the beginning of
+the statement:
+
+ tee = if foo
+ bar
+ else
+ qux
+ end
+
+Only has effect when `ruby-use-smie' is t.
+"
+ :type `(choice
+ (const :tag "None" nil)
+ (const :tag "All" t)
+ (repeat :tag "User defined"
+ (choice ,@(mapcar
+ (lambda (kw) (list 'const kw))
+ ruby-alignable-keywords))))
+ :group 'ruby
+ :safe 'listp
+ :version "24.4")
+
+(defcustom ruby-align-chained-calls nil
+ "If non-nil, align chained method calls.
+
+Each method call on a separate line will be aligned to the column
+of its parent.
+
+Only has effect when `ruby-use-smie' is t."
+ :type 'boolean
+ :group 'ruby
+ :safe 'booleanp
+ :version "24.4")
(defcustom ruby-deep-arglist t
"Deep indent lists in parenthesis when non-nil.
-Also ignores spaces after parenthesis when 'space."
- :group 'ruby)
+Also ignores spaces after parenthesis when `space'.
+Only has effect when `ruby-use-smie' is nil."
+ :type 'boolean
+ :group 'ruby
+ :safe 'booleanp)
+;; FIXME Woefully under documented. What is the point of the last t?.
(defcustom ruby-deep-indent-paren '(?\( ?\[ ?\] t)
"Deep indent lists in parenthesis when non-nil.
The value t means continuous line.
-Also ignores spaces after parenthesis when 'space."
+Also ignores spaces after parenthesis when `space'.
+Only has effect when `ruby-use-smie' is nil."
+ :type '(choice (const nil)
+ character
+ (repeat (choice character
+ (cons character (choice (const nil)
+ (const t)))
+ (const t) ; why?
+ )))
:group 'ruby)
(defcustom ruby-deep-indent-paren-style 'space
- "Default deep indent style."
- :options '(t nil space) :group 'ruby)
+ "Default deep indent style.
+Only has effect when `ruby-use-smie' is nil."
+ :type '(choice (const t) (const nil) (const space))
+ :group 'ruby)
-(defcustom ruby-encoding-map '((shift_jis . cp932) (shift-jis . cp932))
- "Alist to map encoding name from Emacs to Ruby."
+(defcustom ruby-encoding-map
+ '((us-ascii . nil) ;; Do not put coding: us-ascii
+ (shift-jis . cp932) ;; Emacs charset name of Shift_JIS
+ (shift_jis . cp932) ;; MIME charset name of Shift_JIS
+ (japanese-cp932 . cp932)) ;; Emacs charset name of CP932
+ "Alist to map encoding name from Emacs to Ruby.
+Associating an encoding name with nil means it needs not be
+explicitly declared in magic comment."
+ :type '(repeat (cons (symbol :tag "From") (symbol :tag "To")))
:group 'ruby)
(defcustom ruby-insert-encoding-magic-comment t
- "Insert a magic Emacs 'coding' comment upon save if this is non-nil."
+ "Insert a magic Ruby encoding comment upon save if this is non-nil.
+The encoding will be auto-detected. The format of the encoding comment
+is customizable via `ruby-encoding-magic-comment-style'.
+
+When set to `always-utf8' an utf-8 comment will always be added,
+even if it's not required."
:type 'boolean :group 'ruby)
+(defcustom ruby-encoding-magic-comment-style 'ruby
+ "The style of the magic encoding comment to use."
+ :type '(choice
+ (const :tag "Emacs Style" emacs)
+ (const :tag "Ruby Style" ruby)
+ (const :tag "Custom Style" custom))
+ :group 'ruby
+ :version "24.4")
+
+(defcustom ruby-custom-encoding-magic-comment-template "# encoding: %s"
+ "A custom encoding comment template.
+It is used when `ruby-encoding-magic-comment-style' is set to `custom'."
+ :type 'string
+ :group 'ruby
+ :version "24.4")
+
(defcustom ruby-use-encoding-map t
"Use `ruby-encoding-map' to set encoding magic comment if this is non-nil."
:type 'boolean :group 'ruby)
-;; Safe file variables
-(put 'ruby-indent-tabs-mode 'safe-local-variable 'booleanp)
-(put 'ruby-indent-level 'safe-local-variable 'integerp)
-(put 'ruby-comment-column 'safe-local-variable 'integerp)
-(put 'ruby-deep-arglist 'safe-local-variable 'booleanp)
-
;;; SMIE support
(require 'smie)
+;; Here's a simplified BNF grammar, for reference:
+;; http://www.cse.buffalo.edu/~regan/cse305/RubyBNF.pdf
(defconst ruby-smie-grammar
- ;; FIXME: Add support for Cucumber.
(smie-prec2->grammar
- (smie-bnf->prec2
- '((id)
- (insts (inst) (insts ";" insts))
- (inst (exp) (inst "iuwu-mod" exp))
- (exp (exp1) (exp "," exp))
- (exp1 (exp2) (exp2 "?" exp1 ":" exp1))
- (exp2 ("def" insts "end")
- ("begin" insts-rescue-insts "end")
- ("do" insts "end")
- ("class" insts "end") ("module" insts "end")
- ("for" for-body "end")
- ("[" expseq "]")
- ("{" hashvals "}")
- ("while" insts "end")
- ("until" insts "end")
- ("unless" insts "end")
- ("if" if-body "end")
- ("case" cases "end"))
- (for-body (for-head ";" insts))
- (for-head (id "in" exp))
- (cases (exp "then" insts) ;; FIXME: Ruby also allows (exp ":" insts).
- (cases "when" cases) (insts "else" insts))
- (expseq (exp) );;(expseq "," expseq)
- (hashvals (id "=>" exp1) (hashvals "," hashvals))
- (insts-rescue-insts (insts)
- (insts-rescue-insts "rescue" insts-rescue-insts)
- (insts-rescue-insts "ensure" insts-rescue-insts))
- (itheni (insts) (exp "then" insts))
- (ielsei (itheni) (itheni "else" insts))
- (if-body (ielsei) (if-body "elsif" if-body)))
- '((nonassoc "in") (assoc ";") (assoc ","))
- '((assoc "when"))
- '((assoc "elsif"))
- '((assoc "rescue" "ensure"))
- '((assoc ",")))))
+ (smie-merge-prec2s
+ (smie-bnf->prec2
+ '((id)
+ (insts (inst) (insts ";" insts))
+ (inst (exp) (inst "iuwu-mod" exp)
+ ;; Somewhat incorrect (both can be used multiple times),
+ ;; but avoids lots of conflicts:
+ (exp "and" exp) (exp "or" exp))
+ (exp (exp1) (exp "," exp) (exp "=" exp)
+ (id " @ " exp))
+ (exp1 (exp2) (exp2 "?" exp1 ":" exp1))
+ (exp2 (exp3) (exp3 "." exp2))
+ (exp3 ("def" insts "end")
+ ("begin" insts-rescue-insts "end")
+ ("do" insts "end")
+ ("class" insts "end") ("module" insts "end")
+ ("for" for-body "end")
+ ("[" expseq "]")
+ ("{" hashvals "}")
+ ("{" insts "}")
+ ("while" insts "end")
+ ("until" insts "end")
+ ("unless" insts "end")
+ ("if" if-body "end")
+ ("case" cases "end"))
+ (formal-params ("opening-|" exp "closing-|"))
+ (for-body (for-head ";" insts))
+ (for-head (id "in" exp))
+ (cases (exp "then" insts)
+ (cases "when" cases) (insts "else" insts))
+ (expseq (exp) );;(expseq "," expseq)
+ (hashvals (id "=>" exp1) (hashvals "," hashvals))
+ (insts-rescue-insts (insts)
+ (insts-rescue-insts "rescue" insts-rescue-insts)
+ (insts-rescue-insts "ensure" insts-rescue-insts))
+ (itheni (insts) (exp "then" insts))
+ (ielsei (itheni) (itheni "else" insts))
+ (if-body (ielsei) (if-body "elsif" if-body)))
+ '((nonassoc "in") (assoc ";") (right " @ ")
+ (assoc ",") (right "="))
+ '((assoc "when"))
+ '((assoc "elsif"))
+ '((assoc "rescue" "ensure"))
+ '((assoc ",")))
+
+ (smie-precs->prec2
+ '((right "=")
+ (right "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^="
+ "<<=" ">>=" "&&=" "||=")
+ (left ".." "...")
+ (left "+" "-")
+ (left "*" "/" "%" "**")
+ (left "&&" "||")
+ (left "^" "&" "|")
+ (nonassoc "<=>")
+ (nonassoc ">" ">=" "<" "<=")
+ (nonassoc "==" "===" "!=")
+ (nonassoc "=~" "!~")
+ (left "<<" ">>")
+ (right "."))))))
(defun ruby-smie--bosp ()
(save-excursion (skip-chars-backward " \t")
- (or (bolp) (eq (char-before) ?\;))))
+ (or (bolp) (memq (char-before) '(?\; ?=)))))
(defun ruby-smie--implicit-semi-p ()
(save-excursion
(skip-chars-backward " \t")
(not (or (bolp)
- (memq (char-before) '(?\; ?- ?+ ?* ?/ ?:))
- (and (memq (char-before) '(?\? ?=))
- (not (memq (char-syntax (char-before (1- (point))))
- '(?w ?_))))))))
+ (memq (char-before) '(?\[ ?\())
+ (and (memq (char-before)
+ '(?\; ?- ?+ ?* ?/ ?: ?. ?, ?\\ ?& ?> ?< ?% ?~ ?^))
+ ;; Not a binary operator symbol.
+ (not (eq (char-before (1- (point))) ?:))
+ ;; Not the end of a regexp or a percent literal.
+ (not (memq (car (syntax-after (1- (point)))) '(7 15))))
+ (and (eq (char-before) ?\?)
+ (equal (save-excursion (ruby-smie--backward-token)) "?"))
+ (and (eq (char-before) ?=)
+ ;; Not a symbol :==, :!=, or a foo= method.
+ (string-match "\\`\\s." (save-excursion
+ (ruby-smie--backward-token))))
+ (and (eq (char-before) ?|)
+ (member (save-excursion (ruby-smie--backward-token))
+ '("|" "||")))
+ (and (eq (car (syntax-after (1- (point)))) 2)
+ (member (save-excursion (ruby-smie--backward-token))
+ '("iuwu-mod" "and" "or")))
+ (save-excursion
+ (forward-comment 1)
+ (eq (char-after) ?.))))))
+
+(defun ruby-smie--redundant-do-p (&optional skip)
+ (save-excursion
+ (if skip (backward-word 1))
+ (member (nth 2 (smie-backward-sexp ";")) '("while" "until" "for"))))
+
+(defun ruby-smie--opening-pipe-p ()
+ (save-excursion
+ (if (eq ?| (char-before)) (forward-char -1))
+ (skip-chars-backward " \t\n")
+ (or (eq ?\{ (char-before))
+ (looking-back "\\_<do" (- (point) 2)))))
+
+(defun ruby-smie--closing-pipe-p ()
+ (save-excursion
+ (if (eq ?| (char-before)) (forward-char -1))
+ (and (re-search-backward "|" (line-beginning-position) t)
+ (ruby-smie--opening-pipe-p))))
+
+(defun ruby-smie--args-separator-p (pos)
+ (and
+ (< pos (line-end-position))
+ (or (eq (char-syntax (preceding-char)) '?w)
+ ;; FIXME: Check that the preceding token is not a keyword.
+ ;; This isn't very important most of the time, though.
+ (and (memq (preceding-char) '(?! ??))
+ (eq (char-syntax (char-before (1- (point)))) '?w)))
+ (save-excursion
+ (goto-char pos)
+ (or (and (eq (char-syntax (char-after)) ?w)
+ (not (looking-at (regexp-opt '("unless" "if" "while" "until" "or"
+ "else" "elsif" "do" "end" "and")
+ 'symbols))))
+ (memq (car (syntax-after pos)) '(7 15))
+ (looking-at "[([]\\|[-+!~]\\sw\\|:\\(?:\\sw\\|\\s.\\)")))))
+
+(defun ruby-smie--at-dot-call ()
+ (and (eq ?w (char-syntax (following-char)))
+ (eq (char-before) ?.)
+ (not (eq (char-before (1- (point))) ?.))))
(defun ruby-smie--forward-token ()
- (skip-chars-forward " \t")
- (if (and (looking-at "[\n#]")
- ;; Only add implicit ; when needed.
- (ruby-smie--implicit-semi-p))
- (progn
- (if (eolp) (forward-char 1) (forward-comment 1))
- ";")
- (forward-comment (point-max))
- (let ((tok (smie-default-forward-token)))
+ (let ((pos (point)))
+ (skip-chars-forward " \t")
+ (cond
+ ((and (looking-at "\n") (looking-at "\\s\"")) ;A heredoc.
+ ;; Tokenize the whole heredoc as semicolon.
+ (goto-char (scan-sexps (point) 1))
+ ";")
+ ((and (looking-at "[\n#]")
+ (ruby-smie--implicit-semi-p)) ;Only add implicit ; when needed.
+ (if (eolp) (forward-char 1) (forward-comment 1))
+ ";")
+ (t
+ (forward-comment (point-max))
(cond
- ((member tok '("unless" "if" "while" "until"))
- (if (save-excursion (forward-word -1) (ruby-smie--bosp))
- tok "iuwu-mod"))
- (t tok)))))
+ ((and (< pos (point))
+ (save-excursion
+ (ruby-smie--args-separator-p (prog1 (point) (goto-char pos)))))
+ " @ ")
+ ((looking-at ":\\s.+")
+ (goto-char (match-end 0)) (match-string 0)) ;bug#15208.
+ ((looking-at "\\s\"") "") ;A string.
+ (t
+ (let ((dot (ruby-smie--at-dot-call))
+ (tok (smie-default-forward-token)))
+ (when dot
+ (setq tok (concat "." tok)))
+ (cond
+ ((member tok '("unless" "if" "while" "until"))
+ (if (save-excursion (forward-word -1) (ruby-smie--bosp))
+ tok "iuwu-mod"))
+ ((string-match-p "\\`|[*&]?\\'" tok)
+ (forward-char (- 1 (length tok)))
+ (setq tok "|")
+ (cond
+ ((ruby-smie--opening-pipe-p) "opening-|")
+ ((ruby-smie--closing-pipe-p) "closing-|")
+ (t tok)))
+ ((and (equal tok "") (looking-at "\\\\\n"))
+ (goto-char (match-end 0)) (ruby-smie--forward-token))
+ ((equal tok "do")
+ (cond
+ ((not (ruby-smie--redundant-do-p 'skip)) tok)
+ ((> (save-excursion (forward-comment (point-max)) (point))
+ (line-end-position))
+ (ruby-smie--forward-token)) ;Fully redundant.
+ (t ";")))
+ (t tok)))))))))
(defun ruby-smie--backward-token ()
(let ((pos (point)))
(forward-comment (- (point)))
- (if (and (> pos (line-end-position))
- (ruby-smie--implicit-semi-p))
- (progn (skip-chars-forward " \t")
- ";")
- (let ((tok (smie-default-backward-token)))
+ (cond
+ ((and (> pos (line-end-position)) (ruby-smie--implicit-semi-p))
+ (skip-chars-forward " \t") ";")
+ ((and (bolp) (not (bobp))) ;Presumably a heredoc.
+ ;; Tokenize the whole heredoc as semicolon.
+ (goto-char (scan-sexps (point) -1))
+ ";")
+ ((and (> pos (point)) (not (bolp))
+ (ruby-smie--args-separator-p pos))
+ ;; We have "ID SPC ID", which is a method call, but it binds less tightly
+ ;; than commas, since a method call can also be "ID ARG1, ARG2, ARG3".
+ ;; In some textbooks, "e1 @ e2" is used to mean "call e1 with arg e2".
+ " @ ")
+ (t
+ (let ((tok (smie-default-backward-token))
+ (dot (ruby-smie--at-dot-call)))
+ (when dot
+ (setq tok (concat "." tok)))
+ (when (and (eq ?: (char-before)) (string-match "\\`\\s." tok))
+ (forward-char -1) (setq tok (concat ":" tok))) ;; bug#15208.
(cond
((member tok '("unless" "if" "while" "until"))
(if (ruby-smie--bosp)
tok "iuwu-mod"))
- (t tok))))))
+ ((equal tok "|")
+ (cond
+ ((ruby-smie--opening-pipe-p) "opening-|")
+ ((ruby-smie--closing-pipe-p) "closing-|")
+ (t tok)))
+ ((string-match-p "\\`|[*&]\\'" tok)
+ (forward-char 1)
+ (substring tok 1))
+ ((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n"))
+ (forward-char -1) (ruby-smie--backward-token))
+ ((equal tok "do")
+ (cond
+ ((not (ruby-smie--redundant-do-p)) tok)
+ ((> (save-excursion (forward-word 1)
+ (forward-comment (point-max)) (point))
+ (line-end-position))
+ (ruby-smie--backward-token)) ;Fully redundant.
+ (t ";")))
+ (t tok)))))))
+
+(defun ruby-smie--indent-to-stmt ()
+ (save-excursion
+ (smie-backward-sexp ";")
+ (cons 'column (smie-indent-virtual))))
+
+(defun ruby-smie--indent-to-stmt-p (keyword)
+ (or (eq t ruby-align-to-stmt-keywords)
+ (memq (intern keyword) ruby-align-to-stmt-keywords)))
(defun ruby-smie-rules (kind token)
(pcase (cons kind token)
(`(:elem . basic) ruby-indent-level)
- (`(:after . ";")
- (if (smie-rule-parent-p "def" "begin" "do" "class" "module" "for"
- "[" "{" "while" "until" "unless"
- "if" "then" "elsif" "else" "when"
- "rescue" "ensure")
- (smie-rule-parent ruby-indent-level)
- ;; For (invalid) code between switch and case.
- ;; (if (smie-parent-p "switch") 4)
- 0))
- (`(:before . ,(or `"else" `"then" `"elsif")) 0)
- (`(:before . ,(or `"when"))
- (if (not (smie-rule-sibling-p)) 0)) ;; ruby-indent-level
- ;; Hack attack: Since newlines are separators, don't try to align args that
- ;; appear on a separate line.
- (`(:list-intro . ";") t)))
+ ;; "foo" "bar" is the concatenation of the two strings, so the second
+ ;; should be aligned with the first.
+ (`(:elem . args) (if (looking-at "\\s\"") 0))
+ ;; (`(:after . ",") (smie-rule-separator kind))
+ (`(:before . ";")
+ (cond
+ ((smie-rule-parent-p "def" "begin" "do" "class" "module" "for"
+ "while" "until" "unless"
+ "if" "then" "elsif" "else" "when"
+ "rescue" "ensure" "{")
+ (smie-rule-parent ruby-indent-level))
+ ;; For (invalid) code between switch and case.
+ ;; (if (smie-parent-p "switch") 4)
+ ))
+ (`(:before . ,(or `"(" `"[" `"{"))
+ (cond
+ ((and (equal token "{")
+ (not (smie-rule-prev-p "(" "{" "[" "," "=>" "=" "return" ";"))
+ (save-excursion
+ (forward-comment -1)
+ (not (eq (preceding-char) ?:))))
+ ;; Curly block opener.
+ (ruby-smie--indent-to-stmt))
+ ((smie-rule-hanging-p)
+ ;; Treat purely syntactic block-constructs as being part of their parent,
+ ;; when the opening token is hanging and the parent is not an
+ ;; open-paren.
+ (cond
+ ((eq (car (smie-indent--parent)) t) nil)
+ ;; When after `.', let's always de-indent,
+ ;; because when `.' is inside the line, the
+ ;; additional indentation from it looks out of place.
+ ((smie-rule-parent-p ".")
+ (let (smie--parent)
+ (save-excursion
+ ;; Traverse up the parents until the parent is "." at
+ ;; indentation, or any other token.
+ (while (and (let ((parent (smie-indent--parent)))
+ (goto-char (cadr parent))
+ (save-excursion
+ (unless (integerp (car parent)) (forward-char -1))
+ (not (ruby-smie--bosp))))
+ (progn
+ (setq smie--parent nil)
+ (smie-rule-parent-p "."))))
+ (smie-rule-parent))))
+ (t (smie-rule-parent))))))
+ (`(:after . ,(or `"(" "[" "{"))
+ ;; FIXME: Shouldn't this be the default behavior of
+ ;; `smie-indent-after-keyword'?
+ (save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ ;; `smie-rule-hanging-p' is not good enough here,
+ ;; because we want to reject hanging tokens at bol, too.
+ (unless (or (eolp) (forward-comment 1))
+ (cons 'column (current-column)))))
+ (`(:before . " @ ")
+ (save-excursion
+ (skip-chars-forward " \t")
+ (cons 'column (current-column))))
+ (`(:before . "do") (ruby-smie--indent-to-stmt))
+ (`(:before . ".")
+ (if (smie-rule-sibling-p)
+ (and ruby-align-chained-calls 0)
+ ruby-indent-level))
+ (`(:before . ,(or `"else" `"then" `"elsif" `"rescue" `"ensure"))
+ (smie-rule-parent))
+ (`(:before . "when")
+ ;; Align to the previous `when', but look up the virtual
+ ;; indentation of `case'.
+ (if (smie-rule-sibling-p) 0 (smie-rule-parent)))
+ (`(:after . ,(or "=" "iuwu-mod" "+" "-" "*" "/" "&&" "||" "%" "**" "^" "&"
+ "<=>" ">" "<" ">=" "<=" "==" "===" "!=" "<<" ">>"
+ "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" "|"
+ "<<=" ">>=" "&&=" "||=" "and" "or"))
+ (and (smie-rule-parent-p ";" nil)
+ (smie-indent--hanging-p)
+ ruby-indent-level))
+ (`(:after . ,(or "?" ":")) ruby-indent-level)
+ (`(:before . ,(guard (memq (intern-soft token) ruby-alignable-keywords)))
+ (when (not (ruby--at-indentation-p))
+ (if (ruby-smie--indent-to-stmt-p token)
+ (ruby-smie--indent-to-stmt)
+ (cons 'column (current-column)))))
+ ))
+
+(defun ruby--at-indentation-p (&optional point)
+ (save-excursion
+ (unless point (setq point (point)))
+ (forward-line 0)
+ (skip-chars-forward " \t")
+ (eq (point) point)))
(defun ruby-imenu-create-index-in-block (prefix beg end)
"Create an imenu index of methods inside a block."
(let ((index-alist '()) (case-fold-search nil)
name next pos decl sing)
(goto-char beg)
- (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s *\\)\\|module\\s +\\)\\([^\(<\n ]+\\)\\|\\(def\\|alias\\)\\s +\\([^\(\n ]+\\)\\)" end t)
+ (while (re-search-forward "^\\s *\\(\\(class\\s +\\|\\(class\\s *<<\\s *\\)\\|module\\s +\\)\\([^(<\n ]+\\)\\|\\(def\\|alias\\)\\s +\\([^(\n ]+\\)\\)" end t)
(setq sing (match-beginning 3))
(setq decl (match-string 5))
(setq next (match-end 0))
@@ -358,7 +709,7 @@ Also ignores spaces after parenthesis when 'space."
(if prefix
(setq name
(cond
- ((string-match "^self\." name)
+ ((string-match "^self\\." name)
(concat (substring prefix 0 -1) (substring name 4)))
(t (concat prefix name)))))
(push (cons name pos) index-alist)
@@ -382,69 +733,115 @@ Also ignores spaces after parenthesis when 'space."
(nreverse (ruby-imenu-create-index-in-block nil (point-min) nil)))
(defun ruby-accurate-end-of-block (&optional end)
- "TODO: document."
+ "Jump to the end of the current block or END, whichever is closer."
(let (state
(end (or end (point-max))))
- (while (and (setq state (apply 'ruby-parse-partial end state))
- (>= (nth 2 state) 0) (< (point) end)))))
+ (if ruby-use-smie
+ (save-restriction
+ (back-to-indentation)
+ (narrow-to-region (point) end)
+ (smie-forward-sexp))
+ (while (and (setq state (apply 'ruby-parse-partial end state))
+ (>= (nth 2 state) 0) (< (point) end))))))
(defun ruby-mode-variables ()
"Set up initial buffer-local variables for Ruby mode."
- (set-syntax-table ruby-mode-syntax-table)
- (setq local-abbrev-table ruby-mode-abbrev-table)
(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)
- (set (make-local-variable 'indent-line-function) 'ruby-indent-line))
- (set (make-local-variable 'require-final-newline) t)
- (set (make-local-variable 'comment-start) "# ")
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-column) ruby-comment-column)
- (set (make-local-variable 'comment-start-skip) "#+ *")
- (set (make-local-variable 'parse-sexp-ignore-comments) t)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
- (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
- (set (make-local-variable 'paragraph-separate) paragraph-start)
- (set (make-local-variable 'paragraph-ignore-fill-prefix) t))
+ (setq-local indent-line-function 'ruby-indent-line))
+ (setq-local comment-start "# ")
+ (setq-local comment-end "")
+ (setq-local comment-column ruby-comment-column)
+ (setq-local comment-start-skip "#+ *")
+ (setq-local parse-sexp-ignore-comments t)
+ (setq-local parse-sexp-lookup-properties t)
+ (setq-local paragraph-start (concat "$\\|" page-delimiter))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-ignore-fill-prefix t))
+
+(defun ruby--insert-coding-comment (encoding)
+ "Insert a magic coding comment for ENCODING.
+The style of the comment is controlled by `ruby-encoding-magic-comment-style'."
+ (let ((encoding-magic-comment-template
+ (pcase ruby-encoding-magic-comment-style
+ (`ruby "# coding: %s")
+ (`emacs "# -*- coding: %s -*-")
+ (`custom
+ ruby-custom-encoding-magic-comment-template))))
+ (insert
+ (format encoding-magic-comment-template encoding)
+ "\n")))
+
+(defun ruby--detect-encoding ()
+ (if (eq ruby-insert-encoding-magic-comment 'always-utf8)
+ "utf-8"
+ (let ((coding-system
+ (or save-buffer-coding-system
+ buffer-file-coding-system)))
+ (if coding-system
+ (setq coding-system
+ (or (coding-system-get coding-system 'mime-charset)
+ (coding-system-change-eol-conversion coding-system nil))))
+ (if coding-system
+ (symbol-name
+ (if ruby-use-encoding-map
+ (let ((elt (assq coding-system ruby-encoding-map)))
+ (if elt (cdr elt) coding-system))
+ coding-system))
+ "ascii-8bit"))))
+
+(defun ruby--encoding-comment-required-p ()
+ (or (eq ruby-insert-encoding-magic-comment 'always-utf8)
+ (re-search-forward "[^\0-\177]" nil t)))
(defun ruby-mode-set-encoding ()
"Insert a magic comment header with the proper encoding if necessary."
(save-excursion
(widen)
(goto-char (point-min))
- (when (re-search-forward "[^\0-\177]" nil t)
+ (when (ruby--encoding-comment-required-p)
(goto-char (point-min))
- (let ((coding-system
- (or coding-system-for-write
- buffer-file-coding-system)))
- (if coding-system
- (setq coding-system
- (or (coding-system-get coding-system 'mime-charset)
- (coding-system-change-eol-conversion coding-system nil))))
- (setq coding-system
- (if coding-system
- (symbol-name
- (or (and ruby-use-encoding-map
- (cdr (assq coding-system ruby-encoding-map)))
- coding-system))
- "ascii-8bit"))
- (if (looking-at "^#!") (beginning-of-line 2))
- (cond ((looking-at "\\s *#.*-\*-\\s *\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)\\s *\\(;\\|-\*-\\)")
- (unless (string= (match-string 2) coding-system)
- (goto-char (match-beginning 2))
- (delete-region (point) (match-end 2))
- (and (looking-at "-\*-")
- (let ((n (skip-chars-backward " ")))
- (cond ((= n 0) (insert " ") (backward-char))
- ((= n -1) (insert " "))
- ((forward-char)))))
- (insert coding-system)))
- ((looking-at "\\s *#.*coding\\s *[:=]"))
- (t (when ruby-insert-encoding-magic-comment
- (insert "# -*- coding: " coding-system " -*-\n"))))))))
-
+ (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_]*\\)")
+ ;; update existing encoding comment if necessary
+ (unless (string= (match-string 2) coding-system)
+ (goto-char (match-beginning 2))
+ (delete-region (point) (match-end 2))
+ (insert coding-system)))
+ ((looking-at "\\s *#.*coding\\s *[:=]"))
+ (t (when ruby-insert-encoding-magic-comment
+ (ruby--insert-coding-comment coding-system))))
+ (when (buffer-modified-p)
+ (basic-save-buffer-1)))))))
+
+(defvar ruby--electric-indent-chars '(?. ?\) ?} ?\]))
+
+(defun ruby--electric-indent-p (char)
+ (cond
+ ((memq char ruby--electric-indent-chars)
+ ;; Reindent after typing a char affecting indentation.
+ (ruby--at-indentation-p (1- (point))))
+ ((memq (char-after) ruby--electric-indent-chars)
+ ;; Reindent after inserting something in front of the above.
+ (ruby--at-indentation-p (1- (point))))
+ ((or (and (>= char ?a) (<= char ?z)) (memq char '(?_ ?? ?! ?:)))
+ (let ((pt (point)))
+ (save-excursion
+ (skip-chars-backward "[:alpha:]:_?!")
+ (and (ruby--at-indentation-p)
+ (looking-at (regexp-opt (cons "end" ruby-block-mid-keywords)))
+ ;; Outdent after typing a keyword.
+ (or (eq (match-end 0) pt)
+ ;; Reindent if it wasn't a keyword after all.
+ (eq (match-end 0) (1- pt)))))))))
+
+;; FIXME: Remove this? It's unused here, but some redefinitions of
+;; `ruby-calculate-indent' in user init files still call it.
(defun ruby-current-indentation ()
"Return the indentation level of current line."
(save-excursion
@@ -461,7 +858,7 @@ Also ignores spaces after parenthesis when 'space."
"Indent the current line to COLUMN."
(when column
(let (shift top beg)
- (and (< column 0) (error "invalid nest"))
+ (and (< column 0) (error "Invalid nesting"))
(setq shift (current-column))
(beginning-of-line)
(setq beg (point))
@@ -531,7 +928,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
ruby-block-mid-keywords)
'words))
(goto-char (match-end 0))
- (not (looking-at "\\s_\\|!")))
+ (not (looking-at "\\s_")))
((eq option 'expr-qstr)
(looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]"))
((eq option 'expr-re)
@@ -539,11 +936,28 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(t nil)))))))))
(defun ruby-forward-string (term &optional end no-error expand)
- "TODO: document."
+ "Move forward across one balanced pair of string delimiters.
+Skips escaped delimiters. If EXPAND is non-nil, also ignores
+delimiters in interpolated strings.
+
+TERM should be a string containing either a single, self-matching
+delimiter (e.g. \"/\"), or a pair of matching delimiters with the
+close delimiter first (e.g. \"][\").
+
+When non-nil, search is bounded by position END.
+
+Throws an error if a balanced match is not found, unless NO-ERROR
+is non-nil, in which case nil will be returned.
+
+This command assumes the character after point is an opening
+delimiter."
(let ((n 1) (c (string-to-char term))
- (re (if expand
- (concat "[^\\]\\(\\\\\\\\\\)*\\([" term "]\\|\\(#{\\)\\)")
- (concat "[^\\]\\(\\\\\\\\\\)*[" term "]"))))
+ (re (concat "[^\\]\\(\\\\\\\\\\)*\\("
+ (if (string= term "^") ;[^] is not a valid regexp
+ "\\^"
+ (concat "[" term "]"))
+ (when expand "\\|\\(#{\\)")
+ "\\)")))
(while (and (re-search-forward re end no-error)
(if (match-beginning 3)
(ruby-forward-string "}{" end no-error nil)
@@ -552,7 +966,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(forward-char -1))
(cond ((zerop n))
(no-error nil)
- ((error "unterminated string")))))
+ ((error "Unterminated string")))))
(defun ruby-deep-indent-paren-p (c)
"TODO: document."
@@ -578,7 +992,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
((looking-at "[\"`]") ;skip string
(cond
((and (not (eobp))
- (ruby-forward-string (buffer-substring (point) (1+ (point))) end t t))
+ (ruby-forward-string (buffer-substring (point) (1+ (point)))
+ end t t))
nil)
(t
(setq in-string (point))
@@ -763,9 +1178,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(setq in-string (match-end 0))
(goto-char ruby-indent-point)))
(t
- (error (format "bad string %s"
- (buffer-substring (point) pnt)
- ))))))
+ (error "Bad string %s" (buffer-substring (point) pnt))))))
(list in-string nest depth pcol))
(defun ruby-parse-region (start end)
@@ -838,7 +1251,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(setq indent (current-column)))))
((and (nth 2 state) (> (nth 2 state) 0)) ; in nest
(if (null (cdr (nth 1 state)))
- (error "invalid nest"))
+ (error "Invalid nesting"))
(goto-char (cdr (nth 1 state)))
(forward-word -1) ; skip back a keyword
(setq begin (point))
@@ -885,7 +1298,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(while (and (re-search-forward "#" pos t)
(setq end (1- (point)))
(or (ruby-special-char-p end)
- (and (setq state (ruby-parse-region parse-start end))
+ (and (setq state (ruby-parse-region
+ parse-start end))
(nth 0 state))))
(setq end nil))
(goto-char (or end pos))
@@ -896,13 +1310,18 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(and
(or (and (looking-at ruby-symbol-re)
(skip-chars-backward ruby-symbol-chars)
- (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>"))
+ (looking-at (concat "\\<\\(" ruby-block-hanging-re
+ "\\)\\>"))
(not (eq (point) (nth 3 state)))
(save-excursion
(goto-char (match-end 0))
(not (looking-at "[a-z_]"))))
(and (looking-at ruby-operator-re)
(not (ruby-special-char-p))
+ (save-excursion
+ (forward-char -1)
+ (or (not (looking-at ruby-operator-re))
+ (not (eq (char-before) ?:))))
;; Operator at the end of line.
(let ((c (char-after (point))))
(and
@@ -936,7 +1355,8 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'."
(cond
((and
(null op-end)
- (not (looking-at (concat "\\<\\(" ruby-block-hanging-re "\\)\\>")))
+ (not (looking-at (concat "\\<\\(" ruby-block-hanging-re
+ "\\)\\>")))
(eq (ruby-deep-indent-paren-p t) 'space)
(not (bobp)))
(widen)
@@ -970,7 +1390,8 @@ by `end-of-defun'."
(interactive "p")
(ruby-forward-sexp)
(let (case-fold-search)
- (when (looking-back (concat "^\\s *" ruby-block-end-re))
+ (when (looking-back (concat "^\\s *" ruby-block-end-re)
+ (line-beginning-position))
(forward-line 1))))
(defun ruby-beginning-of-indent ()
@@ -1058,8 +1479,10 @@ With ARG, move out of multiple blocks."
With ARG, do it many times. Negative ARG means move backward."
;; TODO: Document body
(interactive "p")
- (if (and (numberp arg) (< arg 0))
- (ruby-backward-sexp (- arg))
+ (cond
+ (ruby-use-smie (forward-sexp arg))
+ ((and (numberp arg) (< arg 0)) (ruby-backward-sexp (- arg)))
+ (t
(let ((i (or arg 1)))
(condition-case nil
(while (> i 0)
@@ -1071,7 +1494,8 @@ With ARG, do it many times. Negative ARG means move backward."
(skip-chars-forward ",.:;|&^~=!?\\+\\-\\*")
(looking-at "\\s("))
(goto-char (scan-sexps (point) 1)))
- ((and (looking-at (concat "\\<\\(" ruby-block-beg-re "\\)\\>"))
+ ((and (looking-at (concat "\\<\\(" ruby-block-beg-re
+ "\\)\\>"))
(not (eq (char-before (point)) ?.))
(not (eq (char-before (point)) ?:)))
(ruby-end-of-block)
@@ -1088,21 +1512,24 @@ With ARG, do it many times. Negative ARG means move backward."
(progn
(setq expr (or expr (ruby-expr-beg)
(looking-at "%\\sw?\\Sw\\|[\"'`/]")))
- (nth 1 (setq state (apply 'ruby-parse-partial nil state))))
+ (nth 1 (setq state (apply #'ruby-parse-partial
+ nil state))))
(setq expr t)
(skip-chars-forward "<"))
(not expr))))
(setq i (1- i)))
((error) (forward-word 1)))
- i)))
+ i))))
(defun ruby-backward-sexp (&optional arg)
"Move backward across one balanced expression (sexp).
With ARG, do it many times. Negative ARG means move forward."
;; TODO: Document body
(interactive "p")
- (if (and (numberp arg) (< arg 0))
- (ruby-forward-sexp (- arg))
+ (cond
+ (ruby-use-smie (backward-sexp arg))
+ ((and (numberp arg) (< arg 0)) (ruby-forward-sexp (- arg)))
+ (t
(let ((i (or arg 1)))
(condition-case nil
(while (> i 0)
@@ -1110,10 +1537,11 @@ With ARG, do it many times. Negative ARG means move forward."
(forward-char -1)
(cond ((looking-at "\\s)")
(goto-char (scan-sexps (1+ (point)) -1))
- (case (char-before)
- (?% (forward-char -1))
- ((?q ?Q ?w ?W ?r ?x)
- (if (eq (char-before (1- (point))) ?%) (forward-char -2))))
+ (pcase (char-before)
+ (`?% (forward-char -1))
+ ((or `?q `?Q `?w `?W `?r `?x)
+ (if (eq (char-before (1- (point))) ?%)
+ (forward-char -2))))
nil)
((looking-at "\\s\"\\|\\\\\\S_")
(let ((c (char-to-string (char-before (match-end 0)))))
@@ -1127,13 +1555,14 @@ With ARG, do it many times. Negative ARG means move forward."
(t
(forward-char 1)
(while (progn (forward-word -1)
- (case (char-before)
- (?_ t)
- (?. (forward-char -1) t)
- ((?$ ?@)
+ (pcase (char-before)
+ (`?_ t)
+ (`?. (forward-char -1) t)
+ ((or `?$ `?@)
(forward-char -1)
- (and (eq (char-before) (char-after)) (forward-char -1)))
- (?:
+ (and (eq (char-before) (char-after))
+ (forward-char -1)))
+ (`?:
(forward-char -1)
(eq (char-before) :)))))
(if (looking-at ruby-block-end-re)
@@ -1141,7 +1570,7 @@ With ARG, do it many times. Negative ARG means move forward."
nil))
(setq i (1- i)))
((error)))
- i)))
+ i))))
(defun ruby-indent-exp (&optional ignored)
"Indent each line in the balanced expression following the point."
@@ -1293,7 +1722,8 @@ See `add-log-current-defun-function'."
(insert "}")
(goto-char orig)
(delete-char 2)
- (insert "{")
+ ;; Maybe this should be customizable, let's see if anyone asks.
+ (insert "{ ")
(setq beg-marker (point-marker))
(when (looking-at "\\s +|")
(delete-char (- (match-end 0) (match-beginning 0) 1))
@@ -1323,8 +1753,9 @@ If the result is do-end block, it will always be multiline."
(let ((start (point)) beg end)
(end-of-line)
(unless
- (if (and (re-search-backward "\\({\\)\\|\\_<do\\(\\s \\|$\\||\\)")
+ (if (and (re-search-backward "\\(?:[^#]\\)\\({\\)\\|\\(\\_<do\\_>\\)")
(progn
+ (goto-char (or (match-beginning 1) (match-beginning 2)))
(setq beg (point))
(save-match-data (ruby-forward-sexp))
(setq end (point))
@@ -1334,348 +1765,229 @@ If the result is do-end block, it will always be multiline."
(ruby-do-end-to-brace beg end)))
(goto-char start))))
-(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
-(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit))
-(declare-function ruby-syntax-propertize-percent-literal "ruby-mode" (limit))
-;; Unusual code layout confuses the byte-compiler.
-(declare-function ruby-syntax-propertize-expansion "ruby-mode" ())
-(declare-function ruby-syntax-expansion-allowed-p "ruby-mode" (parse-state))
-
-(if (eval-when-compile (fboundp #'syntax-propertize-rules))
- ;; New code that works independently from font-lock.
- (progn
- (eval-and-compile
- (defconst ruby-percent-literal-beg-re
- "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)"
- "Regexp to match the beginning of percent literal.")
-
- (defconst ruby-syntax-methods-before-regexp
- '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match"
- "assert_match" "Given" "Then" "When")
- "Methods that can take regexp as the first argument.
+(defun ruby--string-region ()
+ "Return region for string at point."
+ (let ((state (syntax-ppss)))
+ (when (memq (nth 3 state) '(?' ?\"))
+ (save-excursion
+ (goto-char (nth 8 state))
+ (forward-sexp)
+ (list (nth 8 state) (point))))))
+
+(defun ruby-string-at-point-p ()
+ "Check if cursor is at a string or not."
+ (ruby--string-region))
+
+(defun ruby--inverse-string-quote (string-quote)
+ "Get the inverse string quoting for STRING-QUOTE."
+ (if (equal string-quote "\"") "'" "\""))
+
+(defun ruby-toggle-string-quotes ()
+ "Toggle string literal quoting between single and double."
+ (interactive)
+ (when (ruby-string-at-point-p)
+ (let* ((region (ruby--string-region))
+ (min (nth 0 region))
+ (max (nth 1 region))
+ (string-quote (ruby--inverse-string-quote (buffer-substring-no-properties min (1+ min))))
+ (content
+ (buffer-substring-no-properties (1+ min) (1- max))))
+ (setq content
+ (if (equal string-quote "\"")
+ (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\([^\\\\]\\)'" "\\1\\\\'" content))
+ (replace-regexp-in-string "\\\\'" "'" (replace-regexp-in-string "\\([^\\\\]\\)\"" "\\1\\\\\"" content))))
+ (let ((orig-point (point)))
+ (delete-region min max)
+ (insert
+ (format "%s%s%s" string-quote content string-quote))
+ (goto-char orig-point)))))
+
+(eval-and-compile
+ (defconst ruby-percent-literal-beg-re
+ "\\(%\\)[qQrswWxIi]?\\([[:punct:]]\\)"
+ "Regexp to match the beginning of percent literal.")
+
+ (defconst ruby-syntax-methods-before-regexp
+ '("gsub" "gsub!" "sub" "sub!" "scan" "split" "split!" "index" "match"
+ "assert_match" "Given" "Then" "When")
+ "Methods that can take regexp as the first argument.
It will be properly highlighted even when the call omits parens.")
- (defvar ruby-syntax-before-regexp-re
- (concat
- ;; Special tokens that can't be followed by a division operator.
- "\\(^\\|[[=(,~;<>]"
- ;; Distinguish ternary operator tokens.
- ;; FIXME: They don't really have to be separated with spaces.
- "\\|[?:] "
- ;; Control flow keywords and operators following bol or whitespace.
- "\\|\\(?:^\\|\\s \\)"
- (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and"
- "or" "not" "&&" "||"))
- ;; Method name from the list.
- "\\|\\_<"
- (regexp-opt ruby-syntax-methods-before-regexp)
- "\\)\\s *")
- "Regexp to match text that can be followed by a regular expression."))
-
- (defun ruby-syntax-propertize-function (start end)
- "Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
- (let (case-fold-search)
- (goto-char start)
- (remove-text-properties start end '(ruby-expansion-match-data))
- (ruby-syntax-propertize-heredoc end)
- (ruby-syntax-enclosing-percent-literal end)
- (funcall
- (syntax-propertize-rules
- ;; $' $" $` .... are variables.
- ;; ?' ?" ?` are character literals (one-char strings in 1.9+).
- ("\\([?$]\\)[#\"'`]"
- (1 (unless (save-excursion
- ;; Not within a string.
- (nth 3 (syntax-ppss (match-beginning 0))))
- (string-to-syntax "\\"))))
- ;; Regular expressions. Start with matching unescaped slash.
- ("\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(/\\)"
- (1 (let ((state (save-excursion (syntax-ppss (match-beginning 1)))))
- (when (or
- ;; Beginning of a regexp.
- (and (null (nth 8 state))
- (save-excursion
- (forward-char -1)
- (looking-back ruby-syntax-before-regexp-re
- (point-at-bol))))
- ;; End of regexp. We don't match the whole
- ;; regexp at once because it can have
- ;; string interpolation inside, or span
- ;; several lines.
- (eq ?/ (nth 3 state)))
- (string-to-syntax "\"/")))))
- ;; Expression expansions in strings. We're handling them
- ;; here, so that the regexp rule never matches inside them.
- (ruby-expression-expansion-re
- (0 (ignore (ruby-syntax-propertize-expansion))))
- ("^=en\\(d\\)\\_>" (1 "!"))
- ("^\\(=\\)begin\\_>" (1 "!"))
- ;; Handle here documents.
- ((concat ruby-here-doc-beg-re ".*\\(\n\\)")
- (7 (unless (or (nth 8 (save-excursion
- (syntax-ppss (match-beginning 0))))
- (ruby-singleton-class-p (match-beginning 0)))
- (put-text-property (match-beginning 7) (match-end 7)
- 'syntax-table (string-to-syntax "\""))
- (ruby-syntax-propertize-heredoc end))))
- ;; Handle percent literals: %w(), %q{}, etc.
- ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
- (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
- (point) end)))
-
- (defun ruby-syntax-propertize-heredoc (limit)
- (let ((ppss (syntax-ppss))
- (res '()))
- (when (eq ?\n (nth 3 ppss))
- (save-excursion
- (goto-char (nth 8 ppss))
- (beginning-of-line)
- (while (re-search-forward ruby-here-doc-beg-re
- (line-end-position) t)
- (unless (ruby-singleton-class-p (match-beginning 0))
- (push (concat (ruby-here-doc-end-match) "\n") res))))
- (save-excursion
- ;; With multiple openers on the same line, we don't know in which
- ;; part `start' is, so we have to go back to the beginning.
- (when (cdr res)
- (goto-char (nth 8 ppss))
- (setq res (nreverse res)))
- (while (and res (re-search-forward (pop res) limit 'move))
- (if (null res)
- (put-text-property (1- (point)) (point)
- 'syntax-table (string-to-syntax "\""))))
- ;; End up at bol following the heredoc openers.
- ;; Propertize expression expansions from this point forward.
- ))))
-
- (defun ruby-syntax-enclosing-percent-literal (limit)
- (let ((state (syntax-ppss))
- (start (point)))
- ;; When already inside percent literal, re-propertize it.
- (when (eq t (nth 3 state))
- (goto-char (nth 8 state))
- (when (looking-at ruby-percent-literal-beg-re)
- (ruby-syntax-propertize-percent-literal limit))
- (when (< (point) start) (goto-char start)))))
-
- (defun ruby-syntax-propertize-percent-literal (limit)
- (goto-char (match-beginning 2))
- ;; Not inside a simple string or comment.
- (when (eq t (nth 3 (syntax-ppss)))
- (let* ((op (char-after))
- (ops (char-to-string op))
- (cl (or (cdr (aref (syntax-table) op))
- (cdr (assoc op '((?< . ?>))))))
- parse-sexp-lookup-properties)
- (save-excursion
- (condition-case nil
- (progn
- (if cl ; Paired delimiters.
- ;; Delimiter pairs of the same kind can be nested
- ;; inside the literal, as long as they are balanced.
- ;; Create syntax table that ignores other characters.
- (with-syntax-table (make-char-table 'syntax-table nil)
- (modify-syntax-entry op (concat "(" (char-to-string cl)))
- (modify-syntax-entry cl (concat ")" ops))
- (modify-syntax-entry ?\\ "\\")
- (save-restriction
- (narrow-to-region (point) limit)
- (forward-list))) ; skip to the paired character
- ;; Single character delimiter.
- (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*"
- (regexp-quote ops)) limit nil))
- ;; Found the closing delimiter.
- (put-text-property (1- (point)) (point) 'syntax-table
- (string-to-syntax "|")))
- ;; Unclosed literal, do nothing.
- ((scan-error search-failed)))))))
-
- (defun ruby-syntax-propertize-expansion ()
- ;; Save the match data to a text property, for font-locking later.
- ;; Set the syntax of all double quotes and backticks to punctuation.
- (let* ((beg (match-beginning 2))
- (end (match-end 2))
- (state (and beg (save-excursion (syntax-ppss beg)))))
- (when (ruby-syntax-expansion-allowed-p state)
- (put-text-property beg (1+ beg) 'ruby-expansion-match-data
- (match-data))
- (goto-char beg)
- (while (re-search-forward "[\"`]" end 'move)
- (put-text-property (match-beginning 0) (match-end 0)
- 'syntax-table (string-to-syntax "."))))))
-
- (defun ruby-syntax-expansion-allowed-p (parse-state)
- "Return non-nil if expression expansion is allowed."
- (let ((term (nth 3 parse-state)))
- (cond
- ((memq term '(?\" ?` ?\n ?/)))
- ((eq term t)
- (save-match-data
- (save-excursion
- (goto-char (nth 8 parse-state))
- (looking-at "%\\(?:[QWrxI]\\|\\W\\)")))))))
-
- (defun ruby-syntax-propertize-expansions (start end)
- (save-excursion
- (goto-char start)
- (while (re-search-forward ruby-expression-expansion-re end 'move)
- (ruby-syntax-propertize-expansion))))
- )
-
- ;; For Emacsen where syntax-propertize-rules is not (yet) available,
- ;; fallback on the old font-lock-syntactic-keywords stuff.
-
- (defconst ruby-here-doc-end-re
- "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)"
- "Regexp to match the end of heredocs.
-
-This will actually match any line with one or more characters.
-It's useful in that it divides up the match string so that
-`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
-
- (defun ruby-here-doc-beg-match ()
- "Return a regexp to find the beginning of a heredoc.
-
-This should only be called after matching against `ruby-here-doc-end-re'."
- (let ((contents (concat
- (regexp-quote (concat (match-string 2) (match-string 3)))
- (if (string= (match-string 3) "_") "\\B" "\\b"))))
- (concat "<<"
- (let ((match (match-string 1)))
- (if (and match (> (length match) 0))
- (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)"
- (match-string 1) "\\)"
- contents "\\(\\1\\|\\2\\)")
- (concat "-?\\([\"']\\|\\)" contents "\\1"))))))
-
- (defconst ruby-font-lock-syntactic-keywords
- `(
- ;; the last $', $", $` in the respective string is not variable
- ;; the last ?', ?", ?` in the respective string is not ascii code
- ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
- (2 (7 . nil))
- (4 (7 . nil)))
- ;; $' $" $` .... are variables
- ;; ?' ?" ?` are ascii codes
- ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
- ;; regexps
- ("\\(^\\|[[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
- (4 (7 . ?/))
- (6 (7 . ?/)))
- ("^=en\\(d\\)\\_>" 1 "!")
- ;; Percent literal.
- ("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)"
- (3 "\"")
- (5 "\""))
- ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
- ;; Currently, the following case is highlighted incorrectly:
- ;;
- ;; <<FOO
- ;; FOO
- ;; <<BAR
- ;; <<BAZ
- ;; BAZ
- ;; BAR
- ;;
- ;; This is because all here-doc beginnings are highlighted before any endings,
- ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
- ;; it thinks <<BAR is part of a string so it's marked as well.
- ;;
- ;; This may be fixable by modifying ruby-in-here-doc-p to use
- ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
- ;; but I don't want to try that until we've got unit tests set up
- ;; to make sure I don't break anything else.
- (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
- ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
- (ruby-here-doc-beg-syntax))
- (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
- "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
-
- (defun ruby-comment-beg-syntax ()
- "Return the syntax cell for a the first character of a =begin.
-See the definition of `ruby-font-lock-syntactic-keywords'.
-
-This returns a comment-delimiter cell as long as the =begin
-isn't in a string or another comment."
- (when (not (nth 3 (syntax-ppss)))
- (string-to-syntax "!")))
-
- (defun ruby-in-here-doc-p ()
- "Return whether or not the point is in a heredoc."
- (save-excursion
- (let ((old-point (point)) (case-fold-search nil))
+ (defvar ruby-syntax-before-regexp-re
+ (concat
+ ;; Special tokens that can't be followed by a division operator.
+ "\\(^\\|[[{|=(,~;<>!]"
+ ;; Distinguish ternary operator tokens.
+ ;; FIXME: They don't really have to be separated with spaces.
+ "\\|[?:] "
+ ;; Control flow keywords and operators following bol or whitespace.
+ "\\|\\(?:^\\|\\s \\)"
+ (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and"
+ "or" "not" "&&" "||"))
+ ;; Method name from the list.
+ "\\|\\_<"
+ (regexp-opt ruby-syntax-methods-before-regexp)
+ "\\)\\s *")
+ "Regexp to match text that can be followed by a regular expression."))
+
+(defun ruby-syntax-propertize-function (start end)
+ "Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
+ (let (case-fold-search)
+ (goto-char start)
+ (remove-text-properties start end '(ruby-expansion-match-data))
+ (ruby-syntax-propertize-heredoc end)
+ (ruby-syntax-enclosing-percent-literal end)
+ (funcall
+ (syntax-propertize-rules
+ ;; $' $" $` .... are variables.
+ ;; ?' ?" ?` are character literals (one-char strings in 1.9+).
+ ("\\([?$]\\)[#\"'`]"
+ (1 (if (save-excursion
+ (nth 3 (syntax-ppss (match-beginning 0))))
+ ;; Within a string, skip.
+ (goto-char (match-end 1))
+ (string-to-syntax "\\"))))
+ ;; Part of symbol when at the end of a method name.
+ ("[!?]"
+ (0 (unless (save-excursion
+ (or (nth 8 (syntax-ppss (match-beginning 0)))
+ (eq (char-before) ?:)
+ (let (parse-sexp-lookup-properties)
+ (zerop (skip-syntax-backward "w_")))
+ (memq (preceding-char) '(?@ ?$))))
+ (string-to-syntax "_"))))
+ ;; Regular expressions. Start with matching unescaped slash.
+ ("\\(?:\\=\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(/\\)"
+ (1 (let ((state (save-excursion (syntax-ppss (match-beginning 1)))))
+ (when (or
+ ;; Beginning of a regexp.
+ (and (null (nth 8 state))
+ (save-excursion
+ (forward-char -1)
+ (looking-back ruby-syntax-before-regexp-re
+ (point-at-bol))))
+ ;; End of regexp. We don't match the whole
+ ;; regexp at once because it can have
+ ;; string interpolation inside, or span
+ ;; several lines.
+ (eq ?/ (nth 3 state)))
+ (string-to-syntax "\"/")))))
+ ;; Expression expansions in strings. We're handling them
+ ;; here, so that the regexp rule never matches inside them.
+ (ruby-expression-expansion-re
+ (0 (ignore (ruby-syntax-propertize-expansion))))
+ ("^=en\\(d\\)\\_>" (1 "!"))
+ ("^\\(=\\)begin\\_>" (1 "!"))
+ ;; Handle here documents.
+ ((concat ruby-here-doc-beg-re ".*\\(\n\\)")
+ (7 (unless (or (nth 8 (save-excursion
+ (syntax-ppss (match-beginning 0))))
+ (ruby-singleton-class-p (match-beginning 0)))
+ (put-text-property (match-beginning 7) (match-end 7)
+ 'syntax-table (string-to-syntax "\""))
+ (ruby-syntax-propertize-heredoc end))))
+ ;; Handle percent literals: %w(), %q{}, etc.
+ ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re)
+ (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end)))))
+ (point) end)))
+
+(defun ruby-syntax-propertize-heredoc (limit)
+ (let ((ppss (syntax-ppss))
+ (res '()))
+ (when (eq ?\n (nth 3 ppss))
+ (save-excursion
+ (goto-char (nth 8 ppss))
(beginning-of-line)
- (catch 'found-beg
- (while (and (re-search-backward ruby-here-doc-beg-re nil t)
- (not (ruby-singleton-class-p)))
- (if (not (or (ruby-in-ppss-context-p 'anything)
- (ruby-here-doc-find-end old-point)))
- (throw 'found-beg t)))))))
-
- (defun ruby-here-doc-find-end (&optional limit)
- "Expects the point to be on a line with one or more heredoc openers.
-Returns the buffer position at which all heredocs on the line
-are terminated, or nil if they aren't terminated before the
-buffer position `limit' or the end of the buffer."
- (save-excursion
- (beginning-of-line)
- (catch 'done
- (let ((eol (point-at-eol))
- (case-fold-search nil)
- ;; Fake match data such that (match-end 0) is at eol
- (end-match-data (progn (looking-at ".*$") (match-data)))
- beg-match-data end-re)
- (while (re-search-forward ruby-here-doc-beg-re eol t)
- (setq beg-match-data (match-data))
- (setq end-re (ruby-here-doc-end-match))
-
- (set-match-data end-match-data)
- (goto-char (match-end 0))
- (unless (re-search-forward end-re limit t) (throw 'done nil))
- (setq end-match-data (match-data))
-
- (set-match-data beg-match-data)
- (goto-char (match-end 0)))
- (set-match-data end-match-data)
- (goto-char (match-end 0))
- (point)))))
-
- (defun ruby-here-doc-beg-syntax ()
- "Return the syntax cell for a line that may begin a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'.
-
-This sets the syntax cell for the newline ending the line
-containing the heredoc beginning so that cases where multiple
-heredocs are started on one line are handled correctly."
- (save-excursion
- (goto-char (match-beginning 0))
- (unless (or (ruby-in-ppss-context-p 'non-heredoc)
- (ruby-in-here-doc-p))
- (string-to-syntax "\""))))
-
- (defun ruby-here-doc-end-syntax ()
- "Return the syntax cell for a line that may end a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'."
- (let ((pss (syntax-ppss)) (case-fold-search nil))
- ;; If we aren't in a string, we definitely aren't ending a heredoc,
- ;; so we can just give up.
- ;; This means we aren't doing a full-document search
- ;; every time we enter a character.
- (when (ruby-in-ppss-context-p 'heredoc pss)
+ (while (re-search-forward ruby-here-doc-beg-re
+ (line-end-position) t)
+ (unless (ruby-singleton-class-p (match-beginning 0))
+ (push (concat (ruby-here-doc-end-match) "\n") res))))
+ (save-excursion
+ ;; With multiple openers on the same line, we don't know in which
+ ;; part `start' is, so we have to go back to the beginning.
+ (when (cdr res)
+ (goto-char (nth 8 ppss))
+ (setq res (nreverse res)))
+ (while (and res (re-search-forward (pop res) limit 'move))
+ (if (null res)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "\""))))
+ ;; End up at bol following the heredoc openers.
+ ;; Propertize expression expansions from this point forward.
+ ))))
+
+(defun ruby-syntax-enclosing-percent-literal (limit)
+ (let ((state (syntax-ppss))
+ (start (point)))
+ ;; When already inside percent literal, re-propertize it.
+ (when (eq t (nth 3 state))
+ (goto-char (nth 8 state))
+ (when (looking-at ruby-percent-literal-beg-re)
+ (ruby-syntax-propertize-percent-literal limit))
+ (when (< (point) start) (goto-char start)))))
+
+(defun ruby-syntax-propertize-percent-literal (limit)
+ (goto-char (match-beginning 2))
+ ;; Not inside a simple string or comment.
+ (when (eq t (nth 3 (syntax-ppss)))
+ (let* ((op (char-after))
+ (ops (char-to-string op))
+ (cl (or (cdr (aref (syntax-table) op))
+ (cdr (assoc op '((?< . ?>))))))
+ parse-sexp-lookup-properties)
+ (save-excursion
+ (condition-case nil
+ (progn
+ (if cl ; Paired delimiters.
+ ;; Delimiter pairs of the same kind can be nested
+ ;; inside the literal, as long as they are balanced.
+ ;; Create syntax table that ignores other characters.
+ (with-syntax-table (make-char-table 'syntax-table nil)
+ (modify-syntax-entry op (concat "(" (char-to-string cl)))
+ (modify-syntax-entry cl (concat ")" ops))
+ (modify-syntax-entry ?\\ "\\")
+ (save-restriction
+ (narrow-to-region (point) limit)
+ (forward-list))) ; skip to the paired character
+ ;; Single character delimiter.
+ (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*"
+ (regexp-quote ops)) limit nil))
+ ;; Found the closing delimiter.
+ (put-text-property (1- (point)) (point) 'syntax-table
+ (string-to-syntax "|")))
+ ;; Unclosed literal, do nothing.
+ ((scan-error search-failed)))))))
+
+(defun ruby-syntax-propertize-expansion ()
+ ;; Save the match data to a text property, for font-locking later.
+ ;; Set the syntax of all double quotes and backticks to punctuation.
+ (let* ((beg (match-beginning 2))
+ (end (match-end 2))
+ (state (and beg (save-excursion (syntax-ppss beg)))))
+ (when (ruby-syntax-expansion-allowed-p state)
+ (put-text-property beg (1+ beg) 'ruby-expansion-match-data
+ (match-data))
+ (goto-char beg)
+ (while (re-search-forward "[\"`]" end 'move)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'syntax-table (string-to-syntax "."))))))
+
+(defun ruby-syntax-expansion-allowed-p (parse-state)
+ "Return non-nil if expression expansion is allowed."
+ (let ((term (nth 3 parse-state)))
+ (cond
+ ((memq term '(?\" ?` ?\n ?/)))
+ ((eq term t)
+ (save-match-data
(save-excursion
- (goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
- (let ((eol (point)))
- (beginning-of-line)
- (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
- (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
- (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
- (not (re-search-forward ruby-here-doc-beg-re eol t))))
- (string-to-syntax "\"")))))))
+ (goto-char (nth 8 parse-state))
+ (looking-at "%\\(?:[QWrxI]\\|\\W\\)")))))))
- (unless (functionp 'syntax-ppss)
- (defun syntax-ppss (&optional pos)
- (parse-partial-sexp (point-min) (or pos (point)))))
- )
+(defun ruby-syntax-propertize-expansions (start end)
+ (save-excursion
+ (goto-char start)
+ (while (re-search-forward ruby-expression-expansion-re end 'move)
+ (ruby-syntax-propertize-expansion))))
(defun ruby-in-ppss-context-p (context &optional ppss)
(let ((ppss (or ppss (syntax-ppss (point)))))
@@ -1695,17 +2007,10 @@ See the definition of `ruby-font-lock-syntactic-keywords'."
(t
(error (concat
"Internal error on `ruby-in-ppss-context-p': "
- "context name `" (symbol-name context) "' is unknown"))))
+ "context name `%s' is unknown")
+ context)))
t)))
-(if (featurep 'xemacs)
- (put 'ruby-mode 'font-lock-defaults
- '((ruby-font-lock-keywords)
- nil nil nil
- beginning-of-line
- (font-lock-syntactic-keywords
- . ruby-font-lock-syntactic-keywords))))
-
(defvar ruby-font-lock-syntax-table
(let ((tbl (copy-syntax-table ruby-mode-syntax-table)))
(modify-syntax-entry ?_ "w" tbl)
@@ -1716,153 +2021,205 @@ See `font-lock-syntax-table'.")
(defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$]\\|\\.\\.\\)")
(defconst ruby-font-lock-keywords
- (list
- ;; functions
- '("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)"
+ `(;; Functions.
+ ("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)"
1 font-lock-function-name-face)
- ;; keywords
- (list (concat
- ruby-font-lock-keyword-beg-re
- (regexp-opt
- '("alias"
- "and"
- "begin"
- "break"
- "case"
- "class"
- "def"
- "defined?"
- "do"
- "elsif"
- "else"
- "fail"
- "ensure"
- "for"
- "end"
- "if"
- "in"
- "module"
- "next"
- "not"
- "or"
- "redo"
- "rescue"
- "retry"
- "return"
- "then"
- "super"
- "unless"
- "undef"
- "until"
- "when"
- "while"
- "yield")
- 'symbols))
- 1 'font-lock-keyword-face)
- ;; some core methods
- (list (concat
- ruby-font-lock-keyword-beg-re
- (regexp-opt
- '(;; built-in methods on Kernel
- "__callee__"
- "__dir__"
- "__method__"
- "abort"
- "at_exit"
- "autoload"
- "autoload?"
- "binding"
- "block_given?"
- "caller"
- "catch"
- "eval"
- "exec"
- "exit"
- "exit!"
- "fail"
- "fork"
- "format"
- "lambda"
- "load"
- "loop"
- "open"
- "p"
- "print"
- "printf"
- "proc"
- "putc"
- "puts"
- "raise"
- "rand"
- "readline"
- "readlines"
- "require"
- "require_relative"
- "sleep"
- "spawn"
- "sprintf"
- "srand"
- "syscall"
- "system"
- "throw"
- "trap"
- "warn"
- ;; keyword-like private methods on Module
- "alias_method"
- "attr"
- "attr_accessor"
- "attr_reader"
- "attr_writer"
- "define_method"
- "extend"
- "include"
- "module_function"
- "prepend"
- "private"
- "protected"
- "public"
- "refine"
- "using")
- 'symbols))
- 1 'font-lock-builtin-face)
- ;; Perl-ish keywords
- "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
- ;; here-doc beginnings
- `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0))
- 'font-lock-string-face))
- ;; variables
- `(,(concat ruby-font-lock-keyword-beg-re
- "\\_<\\(nil\\|self\\|true\\|false\\)\\>")
- 1 font-lock-variable-name-face)
- ;; keywords that evaluate to certain values
- '("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" 0 font-lock-variable-name-face)
- ;; symbols
- '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
+ ;; Keywords.
+ (,(concat
+ ruby-font-lock-keyword-beg-re
+ (regexp-opt
+ '("alias"
+ "and"
+ "begin"
+ "break"
+ "case"
+ "class"
+ "def"
+ "defined?"
+ "do"
+ "elsif"
+ "else"
+ "fail"
+ "ensure"
+ "for"
+ "end"
+ "if"
+ "in"
+ "module"
+ "next"
+ "not"
+ "or"
+ "redo"
+ "rescue"
+ "retry"
+ "return"
+ "self"
+ "super"
+ "then"
+ "unless"
+ "undef"
+ "until"
+ "when"
+ "while"
+ "yield")
+ 'symbols))
+ (1 font-lock-keyword-face))
+ ;; Core methods that have required arguments.
+ (,(concat
+ ruby-font-lock-keyword-beg-re
+ (regexp-opt
+ '( ;; built-in methods on Kernel
+ "at_exit"
+ "autoload"
+ "autoload?"
+ "callcc"
+ "catch"
+ "eval"
+ "exec"
+ "format"
+ "lambda"
+ "load"
+ "loop"
+ "open"
+ "p"
+ "print"
+ "printf"
+ "proc"
+ "putc"
+ "puts"
+ "require"
+ "require_relative"
+ "spawn"
+ "sprintf"
+ "syscall"
+ "system"
+ "throw"
+ "trace_var"
+ "trap"
+ "untrace_var"
+ "warn"
+ ;; keyword-like private methods on Module
+ "alias_method"
+ "attr"
+ "attr_accessor"
+ "attr_reader"
+ "attr_writer"
+ "define_method"
+ "extend"
+ "include"
+ "module_function"
+ "prepend"
+ "private_class_method"
+ "private_constant"
+ "public_class_method"
+ "public_constant"
+ "refine"
+ "using")
+ 'symbols))
+ (1 (unless (looking-at " *\\(?:[]|,.)}=]\\|$\\)")
+ font-lock-builtin-face)))
+ ;; Kernel methods that have no required arguments.
+ (,(concat
+ ruby-font-lock-keyword-beg-re
+ (regexp-opt
+ '("__callee__"
+ "__dir__"
+ "__method__"
+ "abort"
+ "binding"
+ "block_given?"
+ "caller"
+ "exit"
+ "exit!"
+ "fail"
+ "fork"
+ "global_variables"
+ "local_variables"
+ "private"
+ "protected"
+ "public"
+ "raise"
+ "rand"
+ "readline"
+ "readlines"
+ "sleep"
+ "srand")
+ 'symbols))
+ (1 font-lock-builtin-face))
+ ;; Here-doc beginnings.
+ (,ruby-here-doc-beg-re
+ (0 (unless (ruby-singleton-class-p (match-beginning 0))
+ 'font-lock-string-face)))
+ ;; Perl-ish keywords.
+ "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$"
+ ;; Variables.
+ (,(concat ruby-font-lock-keyword-beg-re
+ "\\_<\\(nil\\|true\\|false\\)\\_>")
+ 1 font-lock-constant-face)
+ ;; Keywords that evaluate to certain values.
+ ("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>"
+ (0 font-lock-builtin-face))
+ ;; Symbols with symbol characters.
+ ("\\(^\\|[^:]\\)\\(:@?\\(?:\\w\\|_\\)+\\)\\([!?=]\\)?"
+ (2 font-lock-constant-face)
+ (3 (unless (and (eq (char-before (match-end 3)) ?=)
+ (eq (char-after (match-end 3)) ?>))
+ ;; bug#18466
+ font-lock-constant-face)
+ nil t))
+ ;; Symbols with special characters.
+ ("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
2 font-lock-constant-face)
- ;; variables
- '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
- 1 font-lock-variable-name-face)
- '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+"
+ ;; Special globals.
+ (,(concat "\\$\\(?:[:\"!@;,/\\._><\\$?~=*&`'+0-9]\\|-[0adFiIlpvw]\\|"
+ (regexp-opt '("LOAD_PATH" "LOADED_FEATURES" "PROGRAM_NAME"
+ "ERROR_INFO" "ERROR_POSITION"
+ "FS" "FIELD_SEPARATOR"
+ "OFS" "OUTPUT_FIELD_SEPARATOR"
+ "RS" "INPUT_RECORD_SEPARATOR"
+ "ORS" "OUTPUT_RECORD_SEPARATOR"
+ "NR" "INPUT_LINE_NUMBER"
+ "LAST_READ_LINE" "DEFAULT_OUTPUT" "DEFAULT_INPUT"
+ "PID" "PROCESS_ID" "CHILD_STATUS"
+ "LAST_MATCH_INFO" "IGNORECASE"
+ "ARGV" "MATCH" "PREMATCH" "POSTMATCH"
+ "LAST_PAREN_MATCH" "stdin" "stdout" "stderr"
+ "DEBUG" "FILENAME" "VERBOSE" "SAFE" "CLASSPATH"
+ "JRUBY_VERSION" "JRUBY_REVISION" "ENV_JAVA"))
+ "\\_>\\)")
+ 0 font-lock-builtin-face)
+ ("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+"
0 font-lock-variable-name-face)
- ;; constants
- '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)"
+ ;; Constants.
+ ("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)"
1 (unless (eq ?\( (char-after)) font-lock-type-face))
- '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face)
- ;; conversion methods on Kernel
- (list (concat ruby-font-lock-keyword-beg-re
- (regexp-opt '("Array" "Complex" "Float" "Hash"
- "Integer" "Rational" "String") 'symbols))
- 1 font-lock-builtin-face)
- ;; expression expansion
- '(ruby-match-expression-expansion
+ ("\\(^\\s *\\|[[{(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]"
+ (2 font-lock-constant-face))
+ ;; Conversion methods on Kernel.
+ (,(concat ruby-font-lock-keyword-beg-re
+ (regexp-opt '("Array" "Complex" "Float" "Hash"
+ "Integer" "Rational" "String") 'symbols))
+ (1 font-lock-builtin-face))
+ ;; Expression expansion.
+ (ruby-match-expression-expansion
2 font-lock-variable-name-face t)
- ;; negation char
- '("[^[:alnum:]_]\\(!\\)[^=]"
+ ;; Negation char.
+ ("\\(?:^\\|[^[:alnum:]_]\\)\\(!+\\)[^=~]"
1 font-lock-negation-char-face)
- ;; character literals
- ;; FIXME: Support longer escape sequences.
- '("\\_<\\?\\\\?\\S " 0 font-lock-string-face)
- )
+ ;; Character literals.
+ ;; FIXME: Support longer escape sequences.
+ ("\\_<\\?\\\\?\\S " 0 font-lock-string-face)
+ ;; Regexp options.
+ ("\\(?:\\s|\\|/\\)\\([imxo]+\\)"
+ 1 (when (save-excursion
+ (let ((state (syntax-ppss (match-beginning 0))))
+ (and (nth 3 state)
+ (or (eq (char-after) ?/)
+ (progn
+ (goto-char (nth 8 state))
+ (looking-at "%r"))))))
+ font-lock-preprocessor-face))
+ )
"Additional expressions to highlight in Ruby mode.")
(defun ruby-match-expression-expansion (limit)
@@ -1877,46 +2234,24 @@ See `font-lock-syntax-table'.")
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
- "Major mode for editing Ruby scripts.
-\\[ruby-indent-line] properly indents subexpressions of multi-line
-class, module, def, if, while, for, do, and case statements, taking
-nesting into account.
-
-The variable `ruby-indent-level' controls the amount of indentation.
+ "Major mode for editing Ruby code.
\\{ruby-mode-map}"
(ruby-mode-variables)
- (set (make-local-variable 'imenu-create-index-function)
- 'ruby-imenu-create-index)
- (set (make-local-variable 'add-log-current-defun-function)
- 'ruby-add-log-current-method)
- (set (make-local-variable 'beginning-of-defun-function)
- 'ruby-beginning-of-defun)
- (set (make-local-variable 'end-of-defun-function)
- 'ruby-end-of-defun)
-
- (add-hook
- (cond ((boundp 'before-save-hook) 'before-save-hook)
- ((boundp 'write-contents-functions) 'write-contents-functions)
- ((boundp 'write-contents-hooks) 'write-contents-hooks))
- 'ruby-mode-set-encoding nil 'local)
-
- (set (make-local-variable 'electric-indent-chars)
- (append '(?\{ ?\}) electric-indent-chars))
-
- (set (make-local-variable 'font-lock-defaults)
- '((ruby-font-lock-keywords) nil nil))
- (set (make-local-variable 'font-lock-keywords)
- ruby-font-lock-keywords)
- (set (make-local-variable 'font-lock-syntax-table)
- ruby-font-lock-syntax-table)
-
- (if (eval-when-compile (fboundp 'syntax-propertize-rules))
- (set (make-local-variable 'syntax-propertize-function)
- #'ruby-syntax-propertize-function)
- (set (make-local-variable 'font-lock-syntactic-keywords)
- ruby-font-lock-syntactic-keywords)))
+ (setq-local imenu-create-index-function 'ruby-imenu-create-index)
+ (setq-local add-log-current-defun-function 'ruby-add-log-current-method)
+ (setq-local beginning-of-defun-function 'ruby-beginning-of-defun)
+ (setq-local end-of-defun-function 'ruby-end-of-defun)
+
+ (add-hook 'after-save-hook 'ruby-mode-set-encoding nil 'local)
+ (add-hook 'electric-indent-functions 'ruby--electric-indent-p nil 'local)
+
+ (setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil))
+ (setq-local font-lock-keywords ruby-font-lock-keywords)
+ (setq-local font-lock-syntax-table ruby-font-lock-syntax-table)
+
+ (setq-local syntax-propertize-function #'ruby-syntax-propertize-function))
;;; Invoke ruby-mode when appropriate
@@ -1924,10 +2259,11 @@ The variable `ruby-indent-level' controls the amount of indentation.
(add-to-list 'auto-mode-alist
(cons (purecopy (concat "\\(?:\\."
"rb\\|ru\\|rake\\|thor"
- "\\|jbuilder\\|gemspec"
+ "\\|jbuilder\\|rabl\\|gemspec\\|podspec"
"\\|/"
"\\(?:Gem\\|Rake\\|Cap\\|Thor"
- "Vagrant\\|Guard\\)file"
+ "\\|Puppet\\|Berks"
+ "\\|Vagrant\\|Guard\\|Pod\\)file"
"\\)\\'")) 'ruby-mode))
;;;###autoload
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index fda7d6b6852..e921e84a33e 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -1,6 +1,6 @@
-;;; scheme.el --- Scheme (and DSSSL) editing mode
+;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*-
-;; Copyright (C) 1986-1988, 1997-1998, 2001-2013 Free Software
+;; Copyright (C) 1986-1988, 1997-1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
@@ -99,7 +99,7 @@
(modify-syntax-entry ?\( "() " st)
(modify-syntax-entry ?\) ")( " st)
;; It's used for single-line comments as well as for #;(...) sexp-comments.
- (modify-syntax-entry ?\; "< 2 " st)
+ (modify-syntax-entry ?\; "<" st)
(modify-syntax-entry ?\" "\" " st)
(modify-syntax-entry ?' "' " st)
(modify-syntax-entry ?` "' " st)
@@ -140,29 +140,22 @@
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
(setq-local comment-start ";")
(setq-local comment-add 1)
- ;; Look within the line for a ; following an even number of backslashes
- ;; after either a non-backslash or the line beginning.
- (setq-local comment-start-skip
- "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
- (setq-local font-lock-comment-start-skip ";+ *")
+ (setq-local comment-start-skip ";+[ \t]*")
+ (setq-local comment-use-syntax t)
(setq-local comment-column 40)
(setq-local parse-sexp-ignore-comments t)
(setq-local lisp-indent-function 'scheme-indent-function)
(setq mode-line-process '("" scheme-mode-line-process))
(setq-local imenu-case-fold-search t)
- (setq imenu-generic-expression scheme-imenu-generic-expression)
- (setq-local imenu-syntax-alist
- '(("+-*/.<>=?!$%_&~^:" . "w")))
+ (setq-local imenu-generic-expression scheme-imenu-generic-expression)
+ (setq-local imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w")))
+ (setq-local syntax-propertize-function #'scheme-syntax-propertize)
(setq font-lock-defaults
'((scheme-font-lock-keywords
scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14"))
beginning-of-defun
- (font-lock-mark-block-function . mark-defun)
- (font-lock-syntactic-face-function
- . scheme-font-lock-syntactic-face-function)
- (parse-sexp-lookup-properties . t)
- (font-lock-extra-managed-props syntax-table)))
+ (font-lock-mark-block-function . mark-defun)))
(setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt))
(defvar scheme-mode-line-process "")
@@ -210,9 +203,7 @@ start an inferior Scheme using the more general `cmuscheme' package.
Commands:
Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
-\\{scheme-mode-map}
-Entry to this mode calls the value of `scheme-mode-hook'
-if that value is non-nil."
+\\{scheme-mode-map}"
(scheme-mode-variables))
(defgroup scheme nil
@@ -289,7 +280,9 @@ See `run-hooks'."
"\\|-module"
"\\)\\)\\>"
;; Any whitespace and declared object.
- "[ \t]*(?"
+ ;; The "(*" is for curried definitions, e.g.,
+ ;; (define ((sum a) b) (+ a b))
+ "[ \t]*(*"
"\\(\\sw+\\)?")
'(1 font-lock-keyword-face)
'(6 (cond ((match-beginning 3) font-lock-function-name-face)
@@ -357,28 +350,28 @@ See `run-hooks'."
(forward-comment (point-max))
(if (eq (char-after) ?\() 2 0)))
-(defun scheme-font-lock-syntactic-face-function (state)
- (when (and (null (nth 3 state))
- (eq (char-after (nth 8 state)) ?#)
- (eq (char-after (1+ (nth 8 state))) ?\;))
- ;; It's a sexp-comment. Tell parse-partial-sexp where it ends.
- (save-excursion
- (let ((pos (point))
- (end
- (condition-case err
- (let ((parse-sexp-lookup-properties nil))
- (goto-char (+ 2 (nth 8 state)))
- ;; FIXME: this doesn't handle the case where the sexp
- ;; itself contains a #; comment.
- (forward-sexp 1)
- (point))
- (scan-error (nth 2 err)))))
- (when (< pos (- end 2))
- (put-text-property pos (- end 2)
- 'syntax-table scheme-sexp-comment-syntax-table))
- (put-text-property (- end 1) end 'syntax-table '(12)))))
- ;; Choose the face to use.
- (lisp-font-lock-syntactic-face-function state))
+(defun scheme-syntax-propertize (beg end)
+ (goto-char beg)
+ (scheme-syntax-propertize-sexp-comment (point) end)
+ (funcall
+ (syntax-propertize-rules
+ ("\\(#\\);" (1 (prog1 "< cn"
+ (scheme-syntax-propertize-sexp-comment (point) end)))))
+ (point) end))
+
+(defun scheme-syntax-propertize-sexp-comment (_ end)
+ (let ((state (syntax-ppss)))
+ (when (eq 2 (nth 7 state))
+ ;; It's a sexp-comment. Tell parse-partial-sexp where it ends.
+ (condition-case nil
+ (progn
+ (goto-char (+ 2 (nth 8 state)))
+ ;; FIXME: this doesn't handle the case where the sexp
+ ;; itself contains a #; comment.
+ (forward-sexp 1)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "> cn")))
+ (scan-error (goto-char end))))))
;;;###autoload
(define-derived-mode dsssl-mode scheme-mode "DSSSL"
@@ -422,7 +415,7 @@ that variable's value is a string."
(eval-when-compile
(list
;; Similar to Scheme
- (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\\((?\\)\\(\\sw+\\)\\>"
+ (list "(\\(define\\(-\\w+\\)?\\)\\>[ ]*\\((?\\)\\(\\sw+\\)\\>"
'(1 font-lock-keyword-face)
'(4 font-lock-function-name-face))
(cons
@@ -500,20 +493,20 @@ indentation."
;;; Let is different in Scheme
-(defun would-be-symbol (string)
- (not (string-equal (substring string 0 1) "(")))
+;; (defun scheme-would-be-symbol (string)
+;; (not (string-equal (substring string 0 1) "(")))
-(defun next-sexp-as-string ()
- ;; Assumes that it is protected by a save-excursion
- (forward-sexp 1)
- (let ((the-end (point)))
- (backward-sexp 1)
- (buffer-substring (point) the-end)))
+;; (defun scheme-next-sexp-as-string ()
+;; ;; Assumes that it is protected by a save-excursion
+;; (forward-sexp 1)
+;; (let ((the-end (point)))
+;; (backward-sexp 1)
+;; (buffer-substring (point) the-end)))
;; This is correct but too slow.
;; The one below works almost always.
;;(defun scheme-let-indent (state indent-point)
-;; (if (would-be-symbol (next-sexp-as-string))
+;; (if (scheme-would-be-symbol (scheme-next-sexp-as-string))
;; (scheme-indent-specform 2 state indent-point)
;; (scheme-indent-specform 1 state indent-point)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index c8b65e0a029..baed27bb138 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1,11 +1,10 @@
-;;; sh-script.el --- shell-script editing commands for Emacs
+;;; sh-script.el --- shell-script editing commands for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1997, 1999, 2001-2013 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1993-1997, 1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Version: 2.0f
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, unix
;; This file is part of GNU Emacs.
@@ -228,6 +227,7 @@
'((ash . sh)
(bash . jsh)
(bash2 . jsh)
+ (dash . ash)
(dtksh . ksh)
(es . rc)
(itcsh . tcsh)
@@ -237,6 +237,7 @@
(ksh88 . jsh)
(oash . sh)
(pdksh . ksh88)
+ (mksh . pdksh)
(posix . sh)
(tcsh . csh)
(wksh . ksh88)
@@ -255,21 +256,23 @@ rc Plan 9 Shell
es Extensible Shell
sh Bourne Shell
ash Almquist Shell
+ dash Debian Almquist Shell
jsh Bourne Shell with Job Control
bash GNU Bourne Again Shell
ksh88 Korn Shell '88
ksh Korn Shell '93
dtksh CDE Desktop Korn Shell
pdksh Public Domain Korn Shell
+ mksh MirOS BSD Korn Shell
wksh Window Korn Shell
zsh Z Shell
oash SCO OA (curses) Shell
posix IEEE 1003.2 Shell Standard
wsh ? Shell"
:type '(repeat (cons symbol symbol))
+ :version "24.4" ; added dash
:group 'sh-script)
-
(defcustom sh-alias-alist
(append (if (eq system-type 'gnu/linux)
'((csh . tcsh)
@@ -277,11 +280,20 @@ sh Bourne Shell
;; for the time being
'((ksh . ksh88)
(bash2 . bash)
- (sh5 . sh)))
+ (sh5 . sh)
+ ;; Android's system shell
+ ("^/system/bin/sh$" . mksh)))
"Alist for transforming shell names to what they really are.
-Use this where the name of the executable doesn't correspond to the type of
-shell it really is."
- :type '(repeat (cons symbol symbol))
+Use this where the name of the executable doesn't correspond to
+the type of shell it really is. Keys are regular expressions
+matched against the full path of the interpreter. (For backward
+compatibility, keys may also be symbols, which are matched
+against the interpreter's basename. The values are symbols
+naming the shell."
+ :type '(repeat (cons (radio
+ (regexp :tag "Regular expression")
+ (symbol :tag "Basename"))
+ (symbol :tag "Shell")))
:group 'sh-script)
@@ -335,7 +347,7 @@ shell it really is."
. ((nil
;; function FOO
;; function FOO()
- "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?"
+ "^\\s-*function\\s-+\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?"
1)
;; FOO()
(nil
@@ -362,7 +374,7 @@ For use in `add-log-current-defun-function'."
(concat "\\(?:"
;; function FOO
;; function FOO()
- "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?"
+ "^\\s-*function\\s-+\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*\\(?:()\\)?"
"\\)\\|\\(?:"
;; FOO()
"^\\s-*\\([[:alpha:]_][[:alnum:]_]*\\)\\s-*()"
@@ -385,15 +397,20 @@ the car and cdr are the same symbol.")
"Non-nil if `sh-shell-variables' is initialized.")
(defun sh-canonicalize-shell (shell)
- "Convert a shell name SHELL to the one we should handle it as."
- (if (string-match "\\.exe\\'" shell)
- (setq shell (substring shell 0 (match-beginning 0))))
- (or (symbolp shell)
- (setq shell (intern shell)))
- (or (cdr (assq shell sh-alias-alist))
- shell))
-
-(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
+ "Convert a shell name SHELL to the one we should handle it as.
+SHELL is a full path to the shell interpreter; return a shell
+name symbol."
+ (cl-loop
+ with shell = (cond ((string-match "\\.exe\\'" shell)
+ (substring shell 0 (match-beginning 0)))
+ (t shell))
+ with shell-base = (intern (file-name-nondirectory shell))
+ for (key . value) in sh-alias-alist
+ if (and (stringp key) (string-match key shell)) return value
+ if (eq key shell-base) return value
+ finally return shell-base))
+
+(defvar sh-shell (sh-canonicalize-shell sh-shell-file)
"The shell being programmed. This is set by \\[sh-set-shell].")
;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp)
@@ -464,6 +481,9 @@ the car and cdr are the same symbol.")
?~ "_"
?, "_"
?= "."
+ ?\; "."
+ ?| "."
+ ?& "."
?< "."
?> ".")
"The syntax table to use for Shell-Script mode.
@@ -673,7 +693,9 @@ removed when closing the here document."
"." "alias" "bg" "bind" "builtin" "caller" "compgen" "complete"
"declare" "dirs" "disown" "enable" "fc" "fg" "help" "history"
"jobs" "kill" "let" "local" "popd" "printf" "pushd" "shopt"
- "source" "suspend" "typeset" "unalias")
+ "source" "suspend" "typeset" "unalias"
+ ;; bash4
+ "mapfile" "readarray" "coproc")
;; The next entry is only used for defining the others
(bourne sh-append shell
@@ -737,6 +759,7 @@ implemented as aliases. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
(choice (repeat string)
(sexp :format "Evaluate: %v"))))
+ :version "24.4" ; bash4 additions
:group 'sh-script)
@@ -887,7 +910,7 @@ See `sh-feature'.")
(:foreground "tan1" ))
(t
(:weight bold)))
- "Face to show a here-document"
+ "Face to show a here-document."
:group 'sh-indentation)
;; These colors are probably icky. It's just a placeholder though.
@@ -898,7 +921,7 @@ See `sh-feature'.")
(:foreground "magenta"))
(t
(:weight bold)))
- "Face to show quoted execs like ``"
+ "Face to show quoted execs like \\=`blabla\\=`."
:group 'sh-indentation)
(define-obsolete-face-alias 'sh-heredoc-face 'sh-heredoc "22.1")
(defvar sh-heredoc-face 'sh-heredoc)
@@ -940,6 +963,7 @@ See `sh-feature'.")
(rpm sh-append rpm2
("%{?\\(\\sw+\\)" 1 font-lock-keyword-face))
(rpm2 sh-append shell
+ ("^Summary:\\(.*\\)$" (1 font-lock-doc-face t))
("^\\(\\sw+\\):" 1 font-lock-variable-name-face)))
"Default expressions to highlight in Shell Script modes. See `sh-feature'.")
@@ -963,7 +987,7 @@ See `sh-feature'.")
"\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*")
(defconst sh-here-doc-open-re
- (concat "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)"
+ (concat "[^<]<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)"
sh-escaped-line-re "\\(\n\\)")))
(defun sh--inside-noncommand-expression (pos)
@@ -971,11 +995,14 @@ See `sh-feature'.")
(let ((ppss (syntax-ppss pos)))
(when (nth 1 ppss)
(goto-char (nth 1 ppss))
- (pcase (char-after)
- ;; $((...)) or $[...] or ${...}.
- (`?\( (and (eq ?\( (char-before))
- (eq ?\$ (char-before (1- (point))))))
- ((or `?\{ `?\[) (eq ?\$ (char-before))))))))
+ (or
+ (pcase (char-after)
+ ;; ((...)) or $((...)) or $[...] or ${...}. Nested
+ ;; parenthesis can occur inside the first of these forms, so
+ ;; parse backward recursively.
+ (`?\( (eq ?\( (char-before)))
+ ((or `?\{ `?\[) (eq ?\$ (char-before))))
+ (sh--inside-noncommand-expression (1- (point))))))))
(defun sh-font-lock-open-heredoc (start string eol)
"Determine the syntax of the \\n after a <<EOF.
@@ -1024,13 +1051,11 @@ Point is at the beginning of the next line."
"Search for a subshell embedded in a string.
Find all the unescaped \" characters within said subshell, remembering that
subshells can nest."
- ;; FIXME: This can (and often does) match multiple lines, yet it makes no
- ;; effort to handle multiline cases correctly, so it ends up being
- ;; rather flaky.
(when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote.
;; bingo we have a $( or a ` inside a ""
(let (;; `state' can be: double-quote, backquote, code.
(state (if (eq (char-before) ?`) 'backquote 'code))
+ (startpos (point))
;; Stacked states in the context.
(states '(double-quote)))
(while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit)
@@ -1039,7 +1064,16 @@ subshells can nest."
(pcase (char-after)
(?\' (pcase state
(`double-quote nil)
- (_ (forward-char 1) (skip-chars-forward "^'" limit))))
+ (_ (forward-char 1)
+ ;; FIXME: mark skipped double quotes as punctuation syntax.
+ (let ((spos (point)))
+ (skip-chars-forward "^'" limit)
+ (save-excursion
+ (let ((epos (point)))
+ (goto-char spos)
+ (while (search-forward "\"" epos t)
+ (put-text-property (point) (1- (point))
+ 'syntax-table '(1)))))))))
(?\\ (forward-char 1))
(?\" (pcase state
(`double-quote (setq state (pop states)))
@@ -1061,7 +1095,12 @@ subshells can nest."
(`double-quote nil)
(_ (setq state (pop states)))))
(_ (error "Internal error in sh-font-lock-quoted-subshell")))
- (forward-char 1)))))
+ (forward-char 1))
+ (when (< startpos (line-beginning-position))
+ (put-text-property startpos (point) 'syntax-multiline t)
+ (add-hook 'syntax-propertize-extend-region-functions
+ 'syntax-propertize-multiline nil t))
+ )))
(defun sh-is-quoted-p (pos)
@@ -1467,13 +1506,15 @@ frequently editing existing scripts with different styles.")
;; inferior shell interaction
;; TODO: support multiple interactive shells
-(defvar sh-shell-process nil
+(defvar-local sh-shell-process nil
"The inferior shell process for interaction.")
-(make-variable-buffer-local 'sh-shell-process)
+
+(defvar explicit-shell-file-name)
+
(defun sh-shell-process (force)
"Get a shell process for interaction.
If FORCE is non-nil and no process found, create one."
- (if (and sh-shell-process (process-live-p sh-shell-process))
+ (if (process-live-p sh-shell-process)
sh-shell-process
(setq sh-shell-process
(let ((found nil) proc
@@ -1522,6 +1563,12 @@ When the region is active, send the region instead."
;; mode-command and utility functions
+(defun sh-after-hack-local-variables ()
+ (when (assq 'sh-shell file-local-variables-alist)
+ (sh-set-shell (if (symbolp sh-shell)
+ (symbol-name sh-shell)
+ sh-shell))))
+
;;;###autoload
(define-derived-mode sh-mode prog-mode "Shell-script"
"Major mode for editing shell scripts.
@@ -1560,7 +1607,6 @@ buffer indents as it currently is indented.
\\[backward-delete-char-untabify] Delete backward one position, even if it was a tab.
-\\[newline-and-indent] Delete unquoted space and indent new line same as this one.
\\[sh-end-of-command] Go to end of successive commands.
\\[sh-beginning-of-command] Go to beginning of successive commands.
\\[sh-set-shell] Set this buffer's shell, and maybe its magic number.
@@ -1584,7 +1630,7 @@ with your script for an edit-interpret-debug cycle."
(lambda () (or (eolp) (newline) (indent-relative))))
(setq-local paragraph-start (concat page-delimiter "\\|$"))
- (setq-local paragraph-separate paragraph-start)
+ (setq-local paragraph-separate (concat paragraph-start "\\|#!/"))
(setq-local comment-start "# ")
(setq-local comment-start-skip "#+[\t ]*")
(setq-local local-abbrev-table sh-mode-abbrev-table)
@@ -1614,6 +1660,8 @@ with your script for an edit-interpret-debug cycle."
(setq-local defun-prompt-regexp
(concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)"))
(setq-local add-log-current-defun-function #'sh-current-defun-name)
+ (add-hook 'completion-at-point-functions
+ #'sh-completion-at-point-function nil t)
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell
@@ -1627,10 +1675,12 @@ with your script for an edit-interpret-debug cycle."
((string-match "[.]sh\\>" buffer-file-name) "sh")
((string-match "[.]bash\\>" buffer-file-name) "bash")
((string-match "[.]ksh\\>" buffer-file-name) "ksh")
- ((string-match "[.]csh\\>" buffer-file-name) "csh")
+ ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh")
((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
(t sh-shell-file))
- nil nil))
+ nil nil)
+ (add-hook 'hack-local-variables-hook
+ #'sh-after-hack-local-variables nil t))
;;;###autoload
(defalias 'shell-script-mode 'sh-mode)
@@ -1672,6 +1722,41 @@ This adds rules for comments and assignments."
"Function to get better fontification including keywords and builtins."
(sh-font-lock-keywords-1 t))
+;;; Completion
+
+(defun sh--vars-before-point ()
+ (save-excursion
+ (let ((vars ()))
+ (while (re-search-backward "^[ \t]*\\([[:alnum:]_]+\\)=" nil t)
+ (push (match-string 1) vars))
+ vars)))
+
+;; (defun sh--var-completion-table (string pred action)
+;; (complete-with-action action (sh--vars-before-point) string pred))
+
+(defun sh--cmd-completion-table (string pred action)
+ (let ((cmds
+ (append (when (fboundp 'imenu--make-index-alist)
+ (mapcar #'car (imenu--make-index-alist)))
+ (mapcar (lambda (v) (concat v "="))
+ (sh--vars-before-point))
+ (locate-file-completion-table
+ exec-path exec-suffixes string pred t)
+ '("if" "while" "until" "for"))))
+ (complete-with-action action cmds string pred)))
+
+(defun sh-completion-at-point-function ()
+ (save-excursion
+ (skip-chars-forward "[:alnum:]_")
+ (let ((end (point))
+ (_ (skip-chars-backward "[:alnum:]_"))
+ (start (point)))
+ (cond
+ ((eq (char-before) ?$)
+ (list start end (sh--vars-before-point)))
+ ((sh-smie--keyword-p)
+ (list start end #'sh--cmd-completion-table))))))
+
;;; Indentation and navigation with SMIE.
(require 'smie)
@@ -1680,14 +1765,16 @@ This adds rules for comments and assignments."
;; 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 nil
+(defvar sh-use-smie t
"Whether to use the SMIE code for navigation and indentation.")
-(defun sh-smie--keyword-p (tok)
- "Non-nil if TOK (at which we're looking) really is a keyword."
+(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
+like a keyword, then it is a keyword."
(let ((prev (funcall smie-backward-token-function)))
(if (zerop (length prev))
- (looking-back "\\s(" (1- (point)))
+ (looking-back "\\`\\|\\s(" (1- (point)))
(assoc prev smie-grammar))))
(defun sh-smie--newline-semi-p (&optional tok)
@@ -1761,12 +1848,14 @@ Does not preserve point."
(setq prev (funcall smie-backward-token-function))
(cond
((zerop (length prev))
- (if newline
- (progn (cl-assert words) (setq res 'word))
+ (cond
+ (newline (cl-assert words) (setq res 'word))
+ ((bobp) (setq res 'word))
+ (t
(setq words t)
(condition-case nil
(forward-sexp -1)
- (scan-error (setq res 'unknown)))))
+ (scan-error (setq res 'unknown))))))
((equal prev ";")
(if words (setq newline t)
(setq res 'keyword)))
@@ -1780,9 +1869,44 @@ Does not preserve point."
(defun sh-smie--sh-keyword-p (tok)
"Non-nil if TOK (at which we're looking) really is a keyword."
- (if (equal tok "in")
- (sh-smie--sh-keyword-in-p)
- (sh-smie--keyword-p tok)))
+ (cond
+ ((looking-at "[[:alnum:]_]+=") nil)
+ ((equal tok "in") (sh-smie--sh-keyword-in-p))
+ (t (sh-smie--keyword-p))))
+
+(defun sh-smie--default-forward-token ()
+ (forward-comment (point-max))
+ (buffer-substring-no-properties
+ (point)
+ (progn (if (zerop (skip-syntax-forward "."))
+ (while (progn (skip-syntax-forward "w_'")
+ (looking-at "\\\\"))
+ (forward-char 2)))
+ (point))))
+
+(defun sh-smie--default-backward-token ()
+ (forward-comment (- (point)))
+ (let ((pos (point))
+ (n (skip-syntax-backward ".")))
+ (if (or (zerop n)
+ (and (eq n -1)
+ (let ((p (point)))
+ (if (eq -1 (% (skip-syntax-backward "\\") 2))
+ t
+ (goto-char p)
+ nil))))
+ (while
+ (progn (skip-syntax-backward "w_'")
+ (or (not (zerop (skip-syntax-backward "\\")))
+ (when (eq ?\\ (char-before (1- (point))))
+ (let ((p (point)))
+ (forward-char -1)
+ (if (eq -1 (% (skip-syntax-backward "\\") 2))
+ t
+ (goto-char p)
+ nil))))))
+ (goto-char (- (point) (% (skip-syntax-backward "\\") 2))))
+ (buffer-substring-no-properties (point) pos)))
(defun sh-smie-sh-forward-token ()
(if (and (looking-at "[ \t]*\\(?:#\\|\\(\\s|\\)\\|$\\)")
@@ -1796,10 +1920,11 @@ Does not preserve point."
;; Pretend the here-document is a "newline representing a
;; semi-colon", since the here-doc otherwise covers the newline(s).
";")
- (let ((semi (sh-smie--newline-semi-p)))
- (forward-line 1)
- (if semi ";"
- (sh-smie-sh-forward-token))))
+ (unless (eobp)
+ (let ((semi (sh-smie--newline-semi-p)))
+ (forward-line 1)
+ (if (or semi (eobp)) ";"
+ (sh-smie-sh-forward-token)))))
(forward-comment (point-max))
(cond
((looking-at "\\\\\n") (forward-line 1) (sh-smie-sh-forward-token))
@@ -1812,7 +1937,7 @@ Does not preserve point."
tok))
(t
(let* ((pos (point))
- (tok (smie-default-forward-token)))
+ (tok (sh-smie--default-forward-token)))
(cond
((equal tok ")") "case-)")
((equal tok "(") "case-(")
@@ -1832,8 +1957,7 @@ Does not preserve point."
(line-beginning-position)))))
(defun sh-smie-sh-backward-token ()
- (let ((bol (line-beginning-position))
- pos tok)
+ (let ((bol (line-beginning-position)))
(forward-comment (- (point)))
(cond
((and (bolp) (not (bobp))
@@ -1857,7 +1981,7 @@ Does not preserve point."
(goto-char (match-beginning 1))
(match-string-no-properties 1))
(t
- (let ((tok (smie-default-backward-token)))
+ (let ((tok (sh-smie--default-backward-token)))
(cond
((equal tok ")") "case-)")
((equal tok "(") "case-(")
@@ -1868,9 +1992,30 @@ Does not preserve point."
(t tok)))))))
(defcustom sh-indent-after-continuation t
- "If non-nil, try to make sure text is indented after a line continuation."
- :version "24.3"
- :type 'boolean
+ "If non-nil, indent relative to the continued line's beginning.
+Continued lines can either be indented as \"one long wrapped line\" without
+paying attention to the actual syntactic structure, as in:
+
+ for f \
+ in a; do \
+ toto; \
+ done
+
+or as lines that just don't have implicit semi-colons between them, as in:
+
+ for f \
+ in a; do \
+ toto; \
+ done
+
+With `always' you get the former behavior whereas with nil you get the latter.
+With t, you get the latter as long as that would indent the continuation line
+deeper than the initial line."
+ :version "25.1"
+ :type '(choice
+ (const nil :tag "Never")
+ (const t :tag "Only if needed to make it deeper")
+ (const always :tag "Always"))
:group 'sh-indentation)
(defun sh-smie--continuation-start-indent ()
@@ -1881,25 +2026,56 @@ May return nil if the line should not be treated as continued."
(unless (sh-smie--looking-back-at-continuation-p)
(current-indentation))))
+(defun sh-smie--indent-continuation ()
+ (cond
+ ((not (and sh-indent-after-continuation
+ (save-excursion
+ (ignore-errors
+ (skip-chars-backward " \t")
+ (sh-smie--looking-back-at-continuation-p)))))
+ nil)
+ ((eq sh-indent-after-continuation 'always)
+ (save-excursion
+ (forward-line -1)
+ (if (sh-smie--looking-back-at-continuation-p)
+ (current-indentation)
+ (+ (current-indentation) sh-indentation))))
+ (t
+ ;; Just make sure a line-continuation is indented deeper.
+ (save-excursion
+ (let ((indent (let ((sh-indent-after-continuation nil))
+ (smie-indent-calculate)))
+ (max most-positive-fixnum))
+ (if (not (numberp indent)) indent
+ (while (progn
+ (forward-line -1)
+ (let ((ci (current-indentation)))
+ (cond
+ ;; Previous line is less indented, we're good.
+ ((< ci indent) nil)
+ ((sh-smie--looking-back-at-continuation-p)
+ (setq max (min max ci))
+ ;; Previous line is itself a continuation.
+ ;; If it's indented like us, we're good, otherwise
+ ;; check the line before that one.
+ (> ci indent))
+ (t ;Previous line is the beginning of the continued line.
+ (setq indent (min (+ ci sh-indentation) max))
+ nil)))))
+ indent))))))
+
(defun sh-smie-sh-rules (kind token)
(pcase (cons kind token)
(`(:elem . basic) sh-indentation)
- (`(:after . "case-)") (or sh-indentation smie-indent-basic))
- ((and `(:before . ,_)
- (guard (when sh-indent-after-continuation
- (save-excursion
- (ignore-errors
- (skip-chars-backward " \t")
- (sh-smie--looking-back-at-continuation-p))))))
- ;; After a line-continuation, make sure the rest is indented.
- (let* ((sh-indent-after-continuation nil)
- (indent (smie-indent-calculate))
- (initial (sh-smie--continuation-start-indent)))
- (when (and (numberp indent) (numberp initial)
- (<= indent initial))
- `(column . ,(+ initial sh-indentation)))))
- (`(:before . ,(or `"(" `"{" `"["))
- (if (smie-rule-hanging-p) (smie-rule-parent)))
+ (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
+ (sh-var-value 'sh-indent-for-case-label)))
+ (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case"))
+ (if (not (smie-rule-prev-p "&&" "||" "|"))
+ (when (smie-rule-hanging-p)
+ (smie-rule-parent))
+ (unless (smie-rule-bolp)
+ (while (equal "|" (nth 2 (smie-backward-sexp 'halfexp))))
+ `(column . ,(smie-indent-virtual)))))
;; FIXME: Maybe this handling of ;; should be made into
;; a smie-rule-terminator function that takes the substitute ";" as arg.
(`(:before . ,(or `";;" `";&" `";;&"))
@@ -1917,7 +2093,27 @@ May return nil if the line should not be treated as continued."
(smie-rule-bolp))))
(current-column)
(smie-indent-calculate)))))
- (`(:after . "|") (if (smie-rule-parent-p "|") nil 4))
+ (`(:before . ,(or `"|" `"&&" `"||"))
+ (unless (smie-rule-parent-p token)
+ (smie-backward-sexp token)
+ `(column . ,(+ (funcall smie-rules-function :elem 'basic)
+ (smie-indent-virtual)))))
+
+ ;; Attempt at backward compatibility with the old config variables.
+ (`(:before . "fi") (sh-var-value 'sh-indent-for-fi))
+ (`(:before . "done") (sh-var-value 'sh-indent-for-done))
+ (`(:after . "else") (sh-var-value 'sh-indent-after-else))
+ (`(:after . "if") (sh-var-value 'sh-indent-after-if))
+ (`(:before . "then") (sh-var-value 'sh-indent-for-then))
+ (`(:before . "do") (sh-var-value 'sh-indent-for-do))
+ (`(:after . "do")
+ (sh-var-value (if (smie-rule-hanging-p)
+ 'sh-indent-after-loop-construct 'sh-indent-after-do)))
+ ;; sh-indent-after-done: aligned completely differently.
+ (`(:after . "in") (sh-var-value 'sh-indent-for-case-label))
+ ;; sh-indent-for-continuation: Line continuations are handled differently.
+ (`(:after . ,(or `"(" `"{" `"[")) (sh-var-value 'sh-indent-after-open))
+ ;; sh-indent-after-function: we don't handle it differently.
))
;; (defconst sh-smie-csh-grammar
@@ -2009,7 +2205,7 @@ Point should be before the newline."
";")
(let ((semi (sh-smie--rc-newline-semi-p)))
(forward-line 1)
- (if semi ";"
+ (if (or semi (eobp)) ";"
(sh-smie-rc-forward-token))))
(forward-comment (point-max))
(cond
@@ -2023,7 +2219,7 @@ Point should be before the newline."
;; tok))
(t
(let* ((pos (point))
- (tok (smie-default-forward-token)))
+ (tok (sh-smie--default-forward-token)))
(cond
;; ((equal tok ")") "case-)")
((and tok (string-match "\\`[a-z]" tok)
@@ -2031,14 +2227,13 @@ Point should be before the newline."
(not
(save-excursion
(goto-char pos)
- (sh-smie--keyword-p tok))))
+ (sh-smie--keyword-p))))
" word ")
(t tok)))))))
(defun sh-smie-rc-backward-token ()
;; FIXME: Code duplication with sh-smie-sh-backward-token.
- (let ((bol (line-beginning-position))
- pos tok)
+ (let ((bol (line-beginning-position)))
(forward-comment (- (point)))
(cond
((and (bolp) (not (bobp))
@@ -2065,12 +2260,12 @@ Point should be before the newline."
;; (goto-char (match-beginning 1))
;; (match-string-no-properties 1))
(t
- (let ((tok (smie-default-backward-token)))
+ (let ((tok (sh-smie--default-backward-token)))
(cond
;; ((equal tok ")") "case-)")
((and tok (string-match "\\`[a-z]" tok)
(assoc tok smie-grammar)
- (not (save-excursion (sh-smie--keyword-p tok))))
+ (not (save-excursion (sh-smie--keyword-p))))
" word ")
(t tok)))))))
@@ -2078,8 +2273,9 @@ Point should be before the newline."
(pcase (cons kind token)
(`(:elem . basic) sh-indentation)
;; (`(:after . "case") (or sh-indentation smie-indent-basic))
- (`(:after . ";") (if (smie-rule-parent-p "case")
- (smie-rule-parent sh-indentation)))
+ (`(:after . ";")
+ (if (smie-rule-parent-p "case")
+ (smie-rule-parent (sh-var-value 'sh-indent-after-case))))
(`(:before . "{")
(save-excursion
(when (sh-smie--rc-after-special-arg-p)
@@ -2094,6 +2290,7 @@ Point should be before the newline."
;; with "(exp)", which is rarely the right thing to do, but is better
;; than nothing.
(`(:list-intro . ,(or `"for" `"if" `"while")) t)
+ ;; sh-indent-after-switch: handled implicitly by the default { rule.
))
;;; End of SMIE code.
@@ -2168,18 +2365,23 @@ the visited file executable, and NO-QUERY-FLAG (the second argument)
controls whether to query about making the visited file executable.
Calls the value of `sh-set-shell-hook' if set."
- (interactive (list (completing-read (format "Shell \(default %s\): "
- sh-shell-file)
- interpreter-mode-alist
- (lambda (x) (eq (cdr x) 'sh-mode))
- nil nil nil sh-shell-file)
+ (interactive (list (completing-read
+ (format "Shell (default %s): "
+ 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
+ ;; the shells, used here and to construct i-mode-alist.
+ ;; But the following is probably good enough:
+ (append (mapcar (lambda (e) (symbol-name (car e)))
+ sh-ancestor-alist)
+ '("csh" "rc" "sh"))
+ nil nil nil nil sh-shell-file)
(eq executable-query 'function)
t))
(if (string-match "\\.exe\\'" shell)
(setq shell (substring shell 0 (match-beginning 0))))
- (setq sh-shell (intern (file-name-nondirectory shell))
- sh-shell (or (cdr (assq sh-shell sh-alias-alist))
- sh-shell))
+ (setq sh-shell (sh-canonicalize-shell shell))
(if insert-flag
(setq sh-shell-file
(executable-set-magic shell (sh-feature sh-shell-arg)
@@ -2200,14 +2402,20 @@ Calls the value of `sh-set-shell-hook' if set."
(sh-feature sh-indent-supported))
(progn
(message "Setting up indent for shell type %s" sh-shell)
- (if sh-use-smie
- (let ((mksym (lambda (name)
- (intern (format "sh-smie-%s-%s"
- sh-indent-supported-here name)))))
- (smie-setup (symbol-value (funcall mksym "grammar"))
- (funcall mksym "rules")
- :forward-token (funcall mksym "forward-token")
- :backward-token (funcall mksym "backward-token")))
+ (let ((mksym (lambda (name)
+ (intern (format "sh-smie-%s-%s"
+ sh-indent-supported-here name)))))
+ (add-function :around (local 'smie--hanging-eolp-function)
+ (lambda (orig)
+ (if (looking-at "[ \t]*\\\\\n")
+ (goto-char (match-end 0))
+ (funcall orig))))
+ (add-hook 'smie-indent-functions #'sh-smie--indent-continuation nil t)
+ (smie-setup (symbol-value (funcall mksym "grammar"))
+ (funcall mksym "rules")
+ :forward-token (funcall mksym "forward-token")
+ :backward-token (funcall mksym "backward-token")))
+ (unless sh-use-smie
(setq-local parse-sexp-lookup-properties t)
(setq-local sh-kw-alist (sh-feature sh-kw))
(let ((regexp (sh-feature sh-kws-for-done)))
@@ -2222,11 +2430,11 @@ Calls the value of `sh-set-shell-hook' if set."
(sh-make-vars-local))
(message "Indentation setup for shell type %s" sh-shell))
(message "No indentation for this shell type.")
- (setq indent-line-function 'sh-basic-indent-line))
+ (setq-local indent-line-function 'sh-basic-indent-line))
(when font-lock-mode
(setq font-lock-set-defaults nil)
(font-lock-set-defaults)
- (font-lock-fontify-buffer))
+ (font-lock-flush))
(setq sh-shell-process nil)
(run-hooks 'sh-set-shell-hook))
@@ -2285,7 +2493,7 @@ the value thus obtained, and the result is used instead."
;; I commented this out because nobody calls it -- rms.
;;(defun sh-abbrevs (ancestor &rest list)
-;; "Iff it isn't, define the current shell as abbrev table and fill that.
+;; "If it isn't, define the current shell as abbrev table and fill that.
;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev
;;table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs
;;according to the remaining arguments NAMEi EXPANSIONi ...
@@ -2348,7 +2556,8 @@ Lines containing only comments are considered empty."
(current-column)))
current)
(save-excursion
- (indent-to (if (eq this-command 'newline-and-indent)
+ (indent-to (if (or (eq this-command 'newline-and-indent)
+ (and electric-indent-mode (eq this-command 'newline)))
previous
(if (< (current-column)
(setq current (progn (back-to-indentation)
@@ -2649,15 +2858,15 @@ Return new point if successful, nil if an error occurred."
"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
+\(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
+\(+ 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
+\(= 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
@@ -2925,7 +3134,7 @@ we go to the end of the previous line and do not check for continuations."
(setq prev (point))
))
;; backward-sexp failed
- (if (zerop (skip-chars-backward " \t()[\]{};`'"))
+ (if (zerop (skip-chars-backward " \t()[]{};`'"))
(forward-char -1))
(if (bolp)
(let ((back (sh-prev-line nil)))
@@ -3049,6 +3258,7 @@ 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
@@ -3105,12 +3315,9 @@ IGNORE-ERROR is non-nil."
((eq val '/)
(/ (- sh-basic-offset) 2))
(t
- (if ignore-error
- (progn
- (message "Don't know how to handle %s's value of %s" var val)
- 0)
- (error "Don't know how to handle %s's value of %s" var val))
- ))))
+ (funcall (if ignore-error #'message #'error)
+ "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.
@@ -3235,33 +3442,35 @@ 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)
- (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))
- ))
+ (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))
+ )))
(defun sh-set-indent ()
"Set the indentation for the current line.
@@ -3269,34 +3478,36 @@ If the current line is controlled by an indentation variable, prompt
for a new value for it."
(interactive)
(sh-must-support-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))
- )))
+ (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)
@@ -3310,55 +3521,57 @@ 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)
- ;; 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))))))
+ (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)))))))
@@ -3390,26 +3603,23 @@ so that `occur-next' and `occur-prev' will work."
)
(goto-char (point-max))
(setq start (point))
- (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")
- (if point
- (progn
- (put-text-property start (point) 'occur-target m1)
- (if occur-point
- (put-text-property start occur-point
- 'occur-match t))
- ))
- )))
-
-
+ (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
@@ -3433,7 +3643,7 @@ so that `occur-next' and `occur-prev' will work."
;; 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 needbe.
+;; 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.
@@ -3459,202 +3669,204 @@ removed in the future.
This command can often take a long time to run."
(interactive "P")
(sh-must-support-indent)
- (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))
- (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)
- "." ":"))
- )))
- ;; Are abnormal hooks considered bad form?
- (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)))))
+ (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)
+ "." ":"))))))
+ ;; Are abnormal hooks considered bad form?
+ (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'.
@@ -3670,11 +3882,11 @@ Return values:
(i 1)
(totals (make-vector max 0)))
(while (< i max)
- (aset totals i (+ (aref totals i) (* 4 (aref vec i))))
+ (cl-incf (aref totals i) (* 4 (aref vec i)))
(if (zerop (% i 2))
- (aset totals i (+ (aref totals i) (aref vec (/ i 2)))))
+ (cl-incf (aref totals i) (aref vec (/ i 2))))
(if (< (* i 2) max)
- (aset totals i (+ (aref totals i) (aref vec (* i 2)))))
+ (cl-incf (aref totals i) (aref vec (* i 2))))
(setq i (1+ i)))
(let ((x nil)
@@ -3683,10 +3895,10 @@ Return values:
(setq i 1)
(while (< i max)
(if (/= (aref totals i) 0)
- (setq x (append x (list (cons i (aref totals i))))))
+ (push (cons i (aref totals i)) x))
(setq i (1+ i)))
- (setq x (sort x (lambda (a b) (> (cdr a) (cdr b)))))
+ (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))
@@ -4189,10 +4401,11 @@ The document is bounded by `sh-here-document-word'."
(or arg (sh--maybe-here-document)))
(defun sh--maybe-here-document ()
- (or (not (looking-back "[^<]<<"))
+ (or (not (looking-back "[^<]<<" (line-beginning-position)))
(save-excursion
(backward-char 2)
- (sh-quoted-p))
+ (or (sh-quoted-p)
+ (sh--inside-noncommand-expression (point))))
(nth 8 (syntax-ppss))
(let ((tabs (if (string-match "\\`-" sh-here-document-word)
(make-string (/ (current-indentation) tab-width) ?\t)
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 77732ed3241..bc0133805ee 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,6 +1,6 @@
;;; simula.el --- SIMULA 87 code editing commands for Emacs
-;; Copyright (C) 1992, 1994, 1996, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 56a6f155f31..abc99eec909 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1,10 +1,10 @@
;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.3
+;; Version: 3.5
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/projects/emacs/
@@ -212,11 +212,11 @@
;; Michael Mauger <michael@mauger.com> -- improved product support
;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
;; Harald Maier <maierh@myself.com> -- sql-send-string
-;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
+;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
;; code polish
;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
-;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
+;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
;; incorrectly enabled by default
;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
@@ -282,6 +282,13 @@ file. Since that is a plaintext file, this could be dangerous."
: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
(define-widget 'sql-login-params 'lazy
@@ -353,7 +360,7 @@ file. Since that is a plaintext file, this could be dangerous."
:sqli-comint-func sql-comint-db2
:prompt-regexp "^db2 => "
:prompt-length 7
- :prompt-cont-regexp "^db2 (cont\.) => "
+ :prompt-cont-regexp "^db2 (cont\\.) => "
:input-filter sql-escape-newlines-filter)
(informix
@@ -374,9 +381,9 @@ file. Since that is a plaintext file, this could be dangerous."
:sqli-options sql-ingres-options
:sqli-login sql-ingres-login-params
:sqli-comint-func sql-comint-ingres
- :prompt-regexp "^\* "
+ :prompt-regexp "^\\* "
:prompt-length 2
- :prompt-cont-regexp "^\* ")
+ :prompt-cont-regexp "^\\* ")
(interbase
:name "Interbase"
@@ -484,7 +491,7 @@ file. Since that is a plaintext file, this could be dangerous."
:completion-object sql-sqlite-completion-object
:prompt-regexp "^sqlite> "
:prompt-length 8
- :prompt-cont-regexp "^ \.\.\.> "
+ :prompt-cont-regexp "^ \\.\\.\\.> "
:terminator ";")
(sybase
@@ -498,6 +505,18 @@ file. Since that is a plaintext file, this could be dangerous."
:prompt-length 5
:syntax-alist ((?@ . "_"))
:terminator ("^go" . "go"))
+
+ (vertica
+ :name "Vertica"
+ :sqli-program sql-vertica-program
+ :sqli-options sql-vertica-options
+ :sqli-login sql-vertica-login-params
+ :sqli-comint-func sql-comint-vertica
+ :list-all ("\\d" . "\\dS")
+ :list-table "\\d %s"
+ :prompt-regexp "^\\w*=[#>] "
+ :prompt-length 5
+ :prompt-cont-regexp "^\\w*[-(][#>] ")
)
"An alist of product specific configuration settings.
@@ -506,7 +525,7 @@ highlighted and will not support `sql-interactive-mode'.
Each element in the list is in the following format:
- \(PRODUCT FEATURE VALUE ...)
+ (PRODUCT FEATURE VALUE ...)
where PRODUCT is the appropriate value of `sql-product'. The
product name is then followed by FEATURE-VALUE pairs. If a
@@ -620,7 +639,7 @@ settings.")
"An alist of connection parameters for interacting with a SQL product.
Each element of the alist is as follows:
- \(CONNECTION \(SQL-VARIABLE VALUE) ...)
+ (CONNECTION \(SQL-VARIABLE VALUE) ...)
Where CONNECTION is a case-insensitive string identifying the
connection, SQL-VARIABLE is the symbol name of a SQL mode
@@ -724,6 +743,8 @@ it automatically."
Globally should be set to nil; it will be non-nil in `sql-mode',
`sql-interactive-mode' and list all buffers.")
+(defvar sql-login-delay 7.5 ;; Secs
+ "Maximum number of seconds you are willing to wait for a login connection.")
(defcustom sql-pop-to-buffer-after-send-region nil
"When non-nil, pop to the buffer SQL statements are sent to.
@@ -849,10 +870,10 @@ You will find the file in your Orant\\bin directory."
:type 'file
:group 'SQL)
-(defcustom sql-oracle-options nil
+(defcustom sql-oracle-options '("-L")
"List of additional options for `sql-oracle-program'."
:type '(repeat string)
- :version "20.8"
+ :version "24.4"
:group 'SQL)
(defcustom sql-oracle-login-params '(user password database)
@@ -1219,7 +1240,9 @@ Based on `comint-mode-map'.")
(define-key map (kbd "C-c C-r") 'sql-send-region)
(define-key map (kbd "C-c C-s") 'sql-send-string)
(define-key map (kbd "C-c C-b") 'sql-send-buffer)
+ (define-key map (kbd "C-c C-n") 'sql-send-line-and-next)
(define-key map (kbd "C-c C-i") 'sql-product-interactive)
+ (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer)
(define-key map (kbd "C-c C-l a") 'sql-list-all)
(define-key map (kbd "C-c C-l t") 'sql-list-table)
(define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
@@ -1554,8 +1577,6 @@ to add functions and PL/SQL keywords.")
;; Oracle SQL*Plus Commands
;; Only recognized in they start in column 1 and the
;; abbreviation is followed by a space or the end of line.
-
- "\\|"
(list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$")
0 'font-lock-comment-face t)
@@ -1601,7 +1622,13 @@ to add functions and PL/SQL keywords.")
"\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$")
0 'font-lock-doc-face t)
+ '("&?&\\(?:\\sw\\|\\s_\\)+[.]?" 0 font-lock-preprocessor-face t)
+ ;; Oracle PL/SQL Attributes (Declare these first to match %TYPE correctly)
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
+"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
+"rowcount" "rowtype" "type"
+)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin"
@@ -1631,7 +1658,7 @@ to add functions and PL/SQL keywords.")
"prediction" "prediction_bounds" "prediction_cost"
"prediction_details" "prediction_probability" "prediction_set"
"presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex"
-"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr"
+"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" "regexp_like"
"regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count"
"regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy"
"regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar"
@@ -1716,7 +1743,7 @@ to add functions and PL/SQL keywords.")
"password_life_time" "password_lock_time" "password_reuse_max"
"password_reuse_time" "password_verify_function" "pctfree"
"pctincrease" "pctthreshold" "pctused" "pctversion" "percent"
-"performance" "permanent" "pfile" "physical" "pipelined" "plan"
+"performance" "permanent" "pfile" "physical" "pipelined" "pivot" "plan"
"post_transaction" "pragma" "prebuilt" "preserve" "primary" "private"
"private_sga" "privileges" "procedure" "profile" "protection" "public"
"purge" "query" "quiesce" "quota" "range" "read" "reads" "rebuild"
@@ -1739,7 +1766,7 @@ to add functions and PL/SQL keywords.")
"temporary" "test" "than" "then" "thread" "through" "time_zone"
"timeout" "to" "trace" "transaction" "trigger" "triggers" "truncate"
"trust" "type" "types" "unarchived" "under" "under_path" "undo"
-"uniform" "union" "unique" "unlimited" "unlock" "unquiesce"
+"uniform" "union" "unique" "unlimited" "unlock" "unpivot" "unquiesce"
"unrecoverable" "until" "unusable" "unused" "update" "upgrade" "usage"
"use" "using" "validate" "validation" "value" "values" "variable"
"varray" "version" "view" "wait" "when" "whenever" "where" "with"
@@ -1754,12 +1781,6 @@ to add functions and PL/SQL keywords.")
"time" "timestamp" "urowid" "varchar2" "with" "year" "zone"
)
- ;; Oracle PL/SQL Attributes
- (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b")
-"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound"
-"rowcount" "rowtype" "type"
-)
-
;; Oracle PL/SQL Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
"delete" "trim" "extend" "exists" "first" "last" "count" "limit"
@@ -2439,7 +2460,7 @@ configuration."
(user-error "Product `%s' is already defined" product)
;; Add product to the alist
- (add-to-list 'sql-product-alist `((,product :name ,display . ,plist)))
+ (add-to-list 'sql-product-alist `(,product :name ,display . ,plist))
;; Add a menu item to the SQL->Product menu
(easy-menu-add-item sql-mode-menu '("Product")
;; Each product is represented by a radio
@@ -2588,8 +2609,8 @@ of the current highlighting list.
For example:
- (sql-add-product-keywords 'ms
- '((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
+ (sql-add-product-keywords \\='ms
+ \\='((\"\\\\b\\\\w+_t\\\\b\" . font-lock-type-face)))
adds a fontification pattern to fontify identifiers ending in
`_t' as data types."
@@ -2826,14 +2847,14 @@ each line with INDENT."
"]\n"))))
doc))
-;;;###autoload
-(eval
- ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
- ;; functions, because of the lazy-loading of docstrings, which strips away
- ;; text properties.
- '(defun sql-help ()
- #("Show short help for the SQL modes.
+(defun sql-help ()
+ "Show short help for the SQL modes."
+ (interactive)
+ (describe-function 'sql-help))
+(put 'sql-help 'function-documentation '(sql--make-help-docstring))
+(defvar sql--help-docstring
+ "Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
@@ -2862,24 +2883,20 @@ anything. The name of the major mode is SQL.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer."
- 0 1 (dynamic-docstring-function sql--make-help-docstring))
- (interactive)
- (describe-function 'sql-help)))
-
-(defun sql--make-help-docstring (doc _fun)
- "Insert references to loaded products into the help buffer string."
-
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
-
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc)
+appended to the SQLi buffer without disturbing your SQL buffer.")
+
+(defun sql--make-help-docstring ()
+ "Return a docstring for `sql-help' listing loaded SQL products."
+ (let ((doc sql--help-docstring))
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc))
(defun sql-default-value (var)
"Fetch the value of a variable.
@@ -3051,7 +3068,7 @@ If you call it from anywhere else, it sets the global copy of
(interactive)
(let ((default-buffer (sql-find-sqli-buffer)))
(if (null default-buffer)
- (user-error "There is no suitable SQLi buffer")
+ (sql-product-interactive)
(let ((new-buffer (read-buffer "New SQLi buffer: " default-buffer t)))
(if (null (sql-buffer-live-p new-buffer))
(user-error "Buffer %s is not a working SQLi buffer" new-buffer)
@@ -3060,21 +3077,20 @@ If you call it from anywhere else, it sets the global copy of
(run-hooks 'sql-set-sqli-hook)))))))
(defun sql-show-sqli-buffer ()
- "Show the name of current SQLi buffer.
+ "Display the current SQLi buffer.
-This is the buffer SQL strings are sent to. It is stored in the
-variable `sql-buffer'. See `sql-help' on how to create such a buffer."
+This is the buffer SQL strings are sent to.
+It is stored in the variable `sql-buffer'.
+I
+See also `sql-help' on how to create such a buffer."
(interactive)
- (if (or (null sql-buffer)
- (null (buffer-live-p (get-buffer sql-buffer))))
- (user-error "%s has no SQLi buffer set" (buffer-name (current-buffer)))
- (if (null (get-buffer-process sql-buffer))
- (user-error "Buffer %s has no process" sql-buffer)
- (user-error "Current SQLi buffer is %s" sql-buffer))))
+ (unless (and sql-buffer (buffer-live-p (get-buffer sql-buffer))
+ (get-buffer-process sql-buffer))
+ (sql-set-sqli-buffer))
+ (display-buffer sql-buffer))
(defun sql-make-alternate-buffer-name ()
"Return a string that can be used to rename a SQLi buffer.
-
This is used to set `sql-alternate-buffer-name' within
`sql-interactive-mode'.
@@ -3212,7 +3228,7 @@ Inserts SELECT or commas if appropriate."
Placeholders are words starting with an ampersand like &this."
(when sql-oracle-scan-on
- (while (string-match "&\\(\\sw+\\)" string)
+ (while (string-match "&?&\\(\\(?:\\sw\\|\\s_\\)+\\)[.]?" string)
(setq string (replace-match
(read-from-minibuffer
(format "Enter value for %s: " (match-string 1 string))
@@ -3280,13 +3296,13 @@ Allows the suppression of continuation prompts.")
(defun sql-starts-with-prompt-re ()
"Anchor the prompt expression at the beginning of the output line.
Remove the start of line regexp."
- (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp))
+ (concat "\\`" comint-prompt-regexp))
(defun sql-ends-with-prompt-re ()
"Anchor the prompt expression at the end of the output line.
-Remove the start of line regexp from the prompt expression since
-it may not follow newline characters in the output line."
- (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'"))
+Match a SQL prompt or a password prompt."
+ (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|"
+ "\\(?:" comint-password-prompt-regexp "\\)\\)\\'"))
(defun sql-interactive-remove-continuation-prompt (oline)
"Strip out continuation prompts out of the OLINE.
@@ -3305,7 +3321,17 @@ to the next chunk to properly match the broken-up prompt.
If the filter gets confused, it should reset and stop filtering
to avoid deleting non-prompt output."
- (when comint-prompt-regexp
+ ;; continue gathering lines of text iff
+ ;; + we know what a prompt looks like, and
+ ;; + there is held text, or
+ ;; + there are continuation prompt yet to come, or
+ ;; + not just a prompt string
+ (when (and comint-prompt-regexp
+ (or (> (length (or sql-preoutput-hold "")) 0)
+ (> (or sql-output-newline-count 0) 0)
+ (not (or (string-match sql-prompt-regexp oline)
+ (string-match sql-prompt-cont-regexp oline)))))
+
(save-match-data
(let (prompt-found last-nl)
@@ -3324,7 +3350,7 @@ to avoid deleting non-prompt output."
(setq oline (replace-match "" nil nil oline)
sql-output-newline-count (1- sql-output-newline-count)
prompt-found t)))
-
+
;; If we've found all the expected prompts, stop looking
(if (= sql-output-newline-count 0)
(setq sql-output-newline-count nil
@@ -3341,16 +3367,19 @@ to avoid deleting non-prompt output."
sql-preoutput-hold ""))
;; Break up output by physical lines if we haven't hit the final prompt
- (unless (and (not (string= oline ""))
- (string-match (sql-ends-with-prompt-re) oline)
- (>= (match-end 0) (length oline)))
- (setq last-nl 0)
- (while (string-match "\n" oline last-nl)
- (setq last-nl (match-end 0)))
- (setq sql-preoutput-hold (concat (substring oline last-nl)
- sql-preoutput-hold)
- oline (substring oline 0 last-nl))))))
- oline)
+ (let ((end-re (sql-ends-with-prompt-re)))
+ (unless (and (not (string= oline ""))
+ (string-match end-re oline)
+ (>= (match-end 0) (length oline)))
+ ;; Find everything upto the last nl
+ (setq last-nl 0)
+ (while (string-match "\n" oline last-nl)
+ (setq last-nl (match-end 0)))
+ ;; Hold after the last nl, return upto last nl
+ (setq sql-preoutput-hold (concat (substring oline last-nl)
+ sql-preoutput-hold)
+ oline (substring oline 0 last-nl)))))))
+ oline)
;;; Sending the region to the SQLi buffer.
@@ -3404,6 +3433,13 @@ to avoid deleting non-prompt output."
(interactive)
(sql-send-region (point-min) (point-max)))
+(defun sql-send-line-and-next ()
+ "Send the current line to the SQL process and go to the next line."
+ (interactive)
+ (sql-send-region (line-beginning-position 1) (line-beginning-position 2))
+ (beginning-of-line 2)
+ (while (forward-comment 1))) ; skip all comments and whitespace
+
(defun sql-send-magic-terminator (buf str terminator)
"Send TERMINATOR to buffer BUF if its not present in STR."
(let (comint-input-sender-no-newline pat term)
@@ -3481,45 +3517,51 @@ list of SQLi command strings."
(message "Executing SQL command...done"))))
(defun sql-redirect-one (sqlbuf command outbuf save-prior)
- (with-current-buffer sqlbuf
- (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*")))
- (proc (get-buffer-process (current-buffer)))
- (comint-prompt-regexp (sql-get-product-feature sql-product
- :prompt-regexp))
- (start nil))
- (with-current-buffer buf
- (setq-local view-no-disable-on-exit t)
- (read-only-mode -1)
- (unless save-prior
- (erase-buffer))
- (goto-char (point-max))
- (unless (zerop (buffer-size))
- (insert "\n"))
- (setq start (point)))
-
- (when sql-debug-redirect
- (message ">>SQL> %S" command))
-
- ;; Run the command
- (comint-redirect-send-command-to-process command buf proc nil t)
- (while (null comint-redirect-completed)
- (accept-process-output nil 1))
-
- ;; Clean up the output results
- (with-current-buffer buf
- ;; Remove trailing whitespace
- (goto-char (point-max))
- (when (looking-back "[ \t\f\n\r]*" start)
- (delete-region (match-beginning 0) (match-end 0)))
- ;; Remove echo if there was one
- (goto-char start)
- (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
- (delete-region (match-beginning 0) (match-end 0)))
- ;; Remove Ctrl-Ms
- (goto-char start)
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (goto-char start)))))
+ (when command
+ (with-current-buffer sqlbuf
+ (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*")))
+ (proc (get-buffer-process (current-buffer)))
+ (comint-prompt-regexp (sql-get-product-feature sql-product
+ :prompt-regexp))
+ (start nil))
+ (with-current-buffer buf
+ (setq-local view-no-disable-on-exit t)
+ (read-only-mode -1)
+ (unless save-prior
+ (erase-buffer))
+ (goto-char (point-max))
+ (unless (zerop (buffer-size))
+ (insert "\n"))
+ (setq start (point)))
+
+ (when sql-debug-redirect
+ (message ">>SQL> %S" command))
+
+ ;; Run the command
+ (let ((inhibit-quit t)
+ comint-preoutput-filter-functions)
+ (with-local-quit
+ (comint-redirect-send-command-to-process command buf proc nil t)
+ (while (or quit-flag (null comint-redirect-completed))
+ (accept-process-output nil 1)))
+
+ (if quit-flag
+ (comint-redirect-cleanup)
+ ;; Clean up the output results
+ (with-current-buffer buf
+ ;; Remove trailing whitespace
+ (goto-char (point-max))
+ (when (looking-back "[ \t\f\n\r]*" start)
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Remove echo if there was one
+ (goto-char start)
+ (when (looking-at (concat "^" (regexp-quote command) "[\\n]"))
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Remove Ctrl-Ms
+ (goto-char start)
+ (while (re-search-forward "\r+$" nil t)
+ (replace-match "" t t))
+ (goto-char start))))))))
(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups)
"Execute the SQL command and return part of result.
@@ -3590,7 +3632,7 @@ buffer is popped into a view window."
(apply c sqlbuf outbuf enhanced arg nil))
(t (error "Unknown sql-execute item %s" c))))
(if (consp command) command (cons command nil)))
-
+
(setq outbuf (get-buffer outbuf))
(if (zerop (buffer-size outbuf))
(kill-buffer outbuf)
@@ -3598,7 +3640,11 @@ buffer is popped into a view window."
(get-lru-window))))
(with-current-buffer outbuf
(set-buffer-modified-p nil)
- (read-only-mode +1))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (sql-execute sqlbuf (buffer-name outbuf)
+ command enhanced arg)))
+ (special-mode))
(pop-to-buffer outbuf)
(when one-win
(shrink-window-if-larger-than-buffer)))))
@@ -3685,13 +3731,16 @@ The list is maintained in SQL interactive buffers.")
(buffer-substring-no-properties (match-beginning 0)
(match-end 0))))
(sql-completion-sqlbuf (sql-find-sqli-buffer))
- (product (with-current-buffer sql-completion-sqlbuf sql-product))
+ (product (when sql-completion-sqlbuf
+ (with-current-buffer sql-completion-sqlbuf sql-product)))
(completion-ignore-case t))
- (if (sql-get-product-feature product :completion-object)
- (completing-read prompt #'sql--completion-table
- nil nil tname)
- (read-from-minibuffer prompt tname))))
+ (if product
+ (if (sql-get-product-feature product :completion-object)
+ (completing-read prompt #'sql--completion-table
+ nil nil tname)
+ (read-from-minibuffer prompt tname))
+ (user-error "There is no active SQLi buffer"))))
(defun sql-list-all (&optional enhanced)
"List all database objects.
@@ -3750,10 +3799,12 @@ Note that SQL doesn't have an escape character unless you specify
one. If you specify backslash as escape character in SQL, you
must tell Emacs. Here's how to do that in your init file:
-\(add-hook 'sql-mode-hook
+\(add-hook \\='sql-mode-hook
(lambda ()
(modify-syntax-entry ?\\\\ \".\" sql-mode-syntax-table)))"
+ :group 'SQL
:abbrev-table sql-mode-abbrev-table
+
(if sql-mode-menu
(easy-menu-add sql-mode-menu)); XEmacs
@@ -3784,6 +3835,7 @@ must tell Emacs. Here's how to do that in your init file:
;;; SQL interactive mode
(put 'sql-interactive-mode 'mode-class 'special)
+(put 'sql-interactive-mode 'custom-mode-group 'SQL)
(defun sql-interactive-mode ()
"Major mode to use a SQL interpreter interactively.
@@ -3844,15 +3896,15 @@ If you want to make SQL buffers limited in length, add the function
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))))
+\(add-hook \\='sql-interactive-mode-hook
+ (function (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))))"
+ (function (lambda (STR) (comint-show-output))))"
(delay-mode-hooks (comint-mode))
;; Get the `sql-product' for this interactive session.
@@ -3926,11 +3978,10 @@ you entered, right above the output it created.
;; People wanting a different history file for each
;; buffer/process/client/whatever can change separator and file-name
;; on the sql-interactive-mode-hook.
- (setq comint-input-ring-separator sql-input-ring-separator
- comint-input-ring-file-name sql-input-ring-file-name)
- ;; Calling the hook before calling comint-read-input-ring allows users
- ;; to set comint-input-ring-file-name in sql-interactive-mode-hook.
- (comint-read-input-ring t))
+ (let
+ ((comint-input-ring-separator sql-input-ring-separator)
+ (comint-input-ring-file-name sql-input-ring-file-name))
+ (comint-read-input-ring t)))
(defun sql-stop (process event)
"Called when the SQL process is stopped.
@@ -3940,11 +3991,15 @@ Writes the input history to a history file using
This function is a sentinel watching the SQL interpreter process.
Sentinels will always get the two parameters PROCESS and EVENT."
- (comint-write-input-ring)
- (if (and (eq (current-buffer) sql-buffer)
- (not buffer-read-only))
- (insert (format "\nProcess %s %s\n" process event))
- (message "Process %s %s" process event)))
+ (with-current-buffer (process-buffer process)
+ (let
+ ((comint-input-ring-separator sql-input-ring-separator)
+ (comint-input-ring-file-name sql-input-ring-file-name))
+ (comint-write-input-ring))
+
+ (if (not buffer-read-only)
+ (insert (format "\nProcess %s %s\n" process event))
+ (message "Process %s %s" process event))))
@@ -4149,19 +4204,22 @@ the call to \\[sql-product-interactive] with
;; We have a new name or sql-buffer doesn't exist or match
;; Start by remembering where we start
(let ((start-buffer (current-buffer))
- new-sqli-buffer)
+ new-sqli-buffer rpt)
;; Get credentials.
(apply #'sql-get-login
(sql-get-product-feature product :sqli-login))
;; Connect to database.
- (message "Login...")
+ (setq rpt (make-progress-reporter "Login"))
+
(let ((sql-user (default-value 'sql-user))
(sql-password (default-value 'sql-password))
(sql-server (default-value 'sql-server))
(sql-database (default-value 'sql-database))
- (sql-port (default-value 'sql-port)))
+ (sql-port (default-value 'sql-port))
+ (default-directory (or sql-default-directory
+ default-directory)))
(funcall (sql-get-product-feature product :sqli-comint-func)
product
(sql-get-product-feature product :sqli-options)))
@@ -4186,15 +4244,25 @@ the call to \\[sql-product-interactive] with
;; Make sure the connection is complete
;; (Sometimes start up can be slow)
;; and call the login hook
- (let ((proc (get-buffer-process new-sqli-buffer)))
+ (let ((proc (get-buffer-process new-sqli-buffer))
+ (secs sql-login-delay)
+ (step 0.3))
(while (and (memq (process-status proc) '(open run))
- (accept-process-output proc 2.5)
+ (or (accept-process-output proc step)
+ (<= 0.0 (setq secs (- secs step))))
(progn (goto-char (point-max))
- (not (looking-back sql-prompt-regexp))))))
- (run-hooks 'sql-login-hook)
+ (not (re-search-backward sql-prompt-regexp 0 t))))
+ (progress-reporter-update rpt)))
+
+ (goto-char (point-max))
+ (when (re-search-backward sql-prompt-regexp nil t)
+ (run-hooks 'sql-login-hook))
+
;; All done.
- (message "Login...done")
- (pop-to-buffer new-sqli-buffer)))))
+ (progress-reporter-done rpt)
+ (pop-to-buffer new-sqli-buffer)
+ (goto-char (point-max))
+ (current-buffer)))))
(user-error "No default SQL product defined. Set `sql-product'.")))
(defun sql-comint (product params)
@@ -4208,7 +4276,7 @@ passed as command line arguments."
;; work for remote hosts; we suppress the check there.
(unless (or (file-remote-p default-directory)
(executable-find program))
- (error "Unable to locate SQL program \'%s\'" program))
+ (error "Unable to locate SQL program `%s'" program))
;; Make sure buffer name is unique.
(when (sql-buffer-live-p (format "*%s*" buf-name))
(setq buf-name (format "SQL-%s" product))
@@ -4266,8 +4334,9 @@ The default comes from `process-coding-system-alist' and
(setq parameter sql-user)))
(if (and parameter (not (string= "" sql-database)))
(setq parameter (concat parameter "@" sql-database)))
+ ;; options must appear before the logon parameters
(if parameter
- (setq parameter (nconc (list parameter) options))
+ (setq parameter (append options (list parameter)))
(setq parameter options))
(sql-comint product parameter)
;; Set process coding system to agree with the interpreter
@@ -5025,6 +5094,46 @@ buffer.
+(defcustom sql-vertica-program "vsql"
+ "Command to start the Vertica client."
+ :version "25.1"
+ :type 'file
+ :group 'SQL)
+
+(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)
+
+(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)
+
+(defun sql-comint-vertica (product options)
+ "Create comint buffer and connect to Vertica."
+ (sql-comint product
+ (nconc
+ (and (not (string= "" sql-server))
+ (list "-h" sql-server))
+ (and (not (string= "" sql-database))
+ (list "-d" sql-database))
+ (and (not (string= "" sql-password))
+ (list "-w" sql-password))
+ (and (not (string= "" sql-user))
+ (list "-U" sql-user))
+ options)))
+
+;;;###autoload
+(defun sql-vertica (&optional buffer)
+ "Run vsql as an inferior process."
+ (interactive "P")
+ (sql-product-interactive 'vertica buffer))
+
+
(provide 'sql)
;;; sql.el ends here
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index 8cf4feb62cb..a279e294fec 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -1,6 +1,6 @@
-;;; subword.el --- Handling capitalized subwords in a nomenclature
+;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*-
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Masatake YAMATO
@@ -21,13 +21,10 @@
;;; Commentary:
-;; This package was cc-submode.el before it was recognized being
-;; useful in general and not tied to C and c-mode at all.
-
-;; This package provides `subword' oriented commands and a minor mode
-;; (`subword-mode') that substitutes the common word handling
-;; functions with them. It also provides the `superword-mode' minor
-;; mode that treats symbols as words, the opposite of `subword-mode'.
+;; This package provides the `subword' minor mode, which merges the
+;; old remap-based subword.el (derived from cc-mode code) and
+;; cap-words.el, which takes advantage of core Emacs
+;; word-motion-customization functionality.
;; In spite of GNU Coding Standards, it is popular to name a symbol by
;; mixing uppercase and lowercase letters, e.g. "GtkWidget",
@@ -47,25 +44,6 @@
;; words. You also get a mode to treat symbols as words instead,
;; called `superword-mode' (the opposite of `subword-mode').
-;; In the minor mode, all common key bindings for word oriented
-;; commands are overridden by the subword oriented commands:
-
-;; Key Word oriented command Subword oriented command (also superword)
-;; ============================================================
-;; M-f `forward-word' `subword-forward'
-;; M-b `backward-word' `subword-backward'
-;; M-@ `mark-word' `subword-mark'
-;; M-d `kill-word' `subword-kill'
-;; M-DEL `backward-kill-word' `subword-backward-kill'
-;; M-t `transpose-words' `subword-transpose'
-;; M-c `capitalize-word' `subword-capitalize'
-;; M-u `upcase-word' `subword-upcase'
-;; M-l `downcase-word' `subword-downcase'
-;;
-;; Note: If you have changed the key bindings for the word oriented
-;; commands in your .emacs or a similar place, the keys you've changed
-;; to are also used for the corresponding subword oriented commands.
-
;; To make the mode turn on automatically, put the following code in
;; your .emacs:
;;
@@ -93,36 +71,34 @@
(defvar subword-backward-function 'subword-backward-internal
"Function to call for backward subword movement.")
-(defconst subword-forward-regexp
+(defvar subword-forward-regexp
"\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)"
"Regexp used by `subword-forward-internal'.")
-(defconst subword-backward-regexp
+(defvar subword-backward-regexp
"\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)"
"Regexp used by `subword-backward-internal'.")
(defvar subword-mode-map
- (let ((map (make-sparse-keymap)))
- (dolist (cmd '(forward-word backward-word mark-word kill-word
- backward-kill-word transpose-words
- capitalize-word upcase-word downcase-word
- left-word right-word))
- (let ((othercmd (let ((name (symbol-name cmd)))
- (string-match "\\([[:alpha:]-]+\\)-word[s]?" name)
- (intern (concat "subword-" (match-string 1 name))))))
- (define-key map (vector 'remap cmd) othercmd)))
- map)
+ ;; We originally remapped motion keys here, but now use Emacs core
+ ;; hooks. Leave this keymap around so that user additions to it
+ ;; keep working.
+ (make-sparse-keymap)
"Keymap used in `subword-mode' minor mode.")
;;;###autoload
+(define-obsolete-function-alias
+ 'capitalized-words-mode 'subword-mode "25.1")
+
+;;;###autoload
(define-minor-mode subword-mode
"Toggle subword movement and editing (Subword mode).
With a prefix argument ARG, enable Subword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Subword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to subword-based commands that handle
+Subword mode is a buffer-local minor mode. Enabling it changes
+the definition of a word so that word-based commands stop inside
symbols with mixed uppercase and lowercase letters,
e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\".
@@ -136,13 +112,13 @@ called a `subword'. Here are some examples:
EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\"
NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\"
-The subword oriented commands activated in this minor mode recognize
-subwords in a nomenclature to move between subwords and to edit them
-as words.
+This mode changes the definition of a word so that word commands
+treat nomenclature boundaries as word boundaries.
\\{subword-mode-map}"
:lighter " ,"
- (when subword-mode (superword-mode -1)))
+ (when subword-mode (superword-mode -1))
+ (subword-setup-buffer))
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
@@ -151,6 +127,13 @@ as words.
(lambda () (subword-mode 1))
:group 'convenience)
+;; N.B. These commands aren't used unless explicitly invoked; they're
+;; here for compatibility. Today, subword-mode leaves motion commands
+;; alone and uses `find-word-boundary-function-table' to change how
+;; `forward-word' and other low-level commands detect word boundaries.
+;; This way, all word-related activities, not just the images we
+;; imagine here, get subword treatment.
+
(defun subword-forward (&optional arg)
"Do the same as `forward-word' but on subwords.
See the command `subword-mode' for a description of subwords.
@@ -159,10 +142,10 @@ Optional argument ARG is the same as for `forward-word'."
(unless arg (setq arg 1))
(cond
((< 0 arg)
- (dotimes (i arg (point))
+ (dotimes (_i arg (point))
(funcall subword-forward-function)))
((> 0 arg)
- (dotimes (i (- arg) (point))
+ (dotimes (_i (- arg) (point))
(funcall subword-backward-function)))
(t
(point))))
@@ -257,24 +240,26 @@ Optional argument ARG is the same as for `upcase-word'."
See the command `subword-mode' for a description of subwords.
Optional argument ARG is the same as for `capitalize-word'."
(interactive "p")
- (let ((count (abs arg))
- (start (point))
- (advance (if (< arg 0) nil t)))
- (dotimes (i count)
- (if advance
- (progn (re-search-forward
- (concat "[[:alpha:]]")
- nil t)
- (goto-char (match-beginning 0)))
- (subword-backward))
- (let* ((p (point))
- (pp (1+ p))
- (np (subword-forward)))
- (upcase-region p pp)
- (downcase-region pp np)
- (goto-char (if advance np p))))
- (unless advance
- (goto-char start))))
+ (condition-case nil
+ (let ((count (abs arg))
+ (start (point))
+ (advance (>= arg 0)))
+
+ (dotimes (_i count)
+ (if advance
+ (progn
+ (re-search-forward "[[:alpha:]]")
+ (goto-char (match-beginning 0)))
+ (subword-backward))
+ (let* ((p (point))
+ (pp (1+ p))
+ (np (subword-forward)))
+ (upcase-region p pp)
+ (downcase-region pp np)
+ (goto-char (if advance np p))))
+ (unless advance
+ (goto-char start)))
+ (search-failed nil)))
@@ -288,17 +273,15 @@ With a prefix argument ARG, enable Superword mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
-Superword mode is a buffer-local minor mode. Enabling it remaps
-word-based editing commands to superword-based commands that
-treat symbols as words, e.g. \"this_is_a_symbol\".
-
-The superword oriented commands activated in this minor mode
-recognize symbols as superwords to move between superwords and to
-edit them as words.
+Superword mode is a buffer-local minor mode. Enabling it changes
+the definition of words such that symbols characters are treated
+as parts of words: e.g., in `superword-mode',
+\"this_is_a_symbol\" counts as one word.
\\{superword-mode-map}"
:lighter " ²"
- (when superword-mode (subword-mode -1)))
+ (when superword-mode (subword-mode -1))
+ (subword-setup-buffer))
;;;###autoload
(define-global-minor-mode global-superword-mode superword-mode
@@ -345,9 +328,45 @@ edit them as words.
(1+ (match-beginning 0)))))
(backward-word 1))))
+(defconst subword-find-word-boundary-function-table
+ (let ((tab (make-char-table nil)))
+ (set-char-table-range tab t #'subword-find-word-boundary)
+ tab)
+ "Assigned to `find-word-boundary-function-table' in
+`subword-mode' and `superword-mode'; defers to
+`subword-find-word-boundary'.")
+
+(defconst subword-empty-char-table
+ (make-char-table nil)
+ "Assigned to `find-word-boundary-function-table' while we're
+searching subwords in order to avoid unwanted reentrancy.")
+
+(defun subword-setup-buffer ()
+ (set (make-local-variable 'find-word-boundary-function-table)
+ (if (or subword-mode superword-mode)
+ subword-find-word-boundary-function-table
+ subword-empty-char-table)))
+
+(defun subword-find-word-boundary (pos limit)
+ "Catch-all handler in `subword-find-word-boundary-function-table'."
+ (let ((find-word-boundary-function-table subword-empty-char-table))
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (if (< pos limit)
+ (progn
+ (goto-char pos)
+ (narrow-to-region (point-min) limit)
+ (funcall subword-forward-function))
+ (goto-char (1+ pos))
+ (narrow-to-region limit (point-max))
+ (funcall subword-backward-function))
+ (point))))))
+
(provide 'subword)
(provide 'superword)
+(provide 'cap-words) ; Obsolete alias
;;; subword.el ends here
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 3e91aeba9a1..e4e96554c95 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1,8 +1,8 @@
;;; tcl.el --- Tcl code editing commands for Emacs
-;; Copyright (C) 1994, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1998-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Author: Tom Tromey <tromey@redhat.com>
;; Chris Lindblad <cjl@lcs.mit.edu>
;; Keywords: languages tcl modes
@@ -151,7 +151,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)
- (const :tag "Maybe move or make or delete comment" 'tcl))
+ (other :tag "Maybe move or make or delete comment" tcl))
:group 'tcl)
@@ -1028,7 +1028,8 @@ Returns nil if line starts inside a string, t if in a comment."
(with-current-buffer (process-buffer proc)
;; Delete prompt if requested.
(when (marker-buffer inferior-tcl-delete-prompt-marker)
- (delete-region (process-mark proc) inferior-tcl-delete-prompt-marker)
+ (let ((inhibit-read-only t))
+ (delete-region (process-mark proc) inferior-tcl-delete-prompt-marker))
(set-marker inferior-tcl-delete-prompt-marker nil))))
(comint-output-filter proc string))
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 443472192be..bce56a447f0 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -1,6 +1,6 @@
;;; vera-mode.el --- major mode for editing Vera files
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Reto Zimmermann <reto@gnu.org>
;; Maintainer: Reto Zimmermann <reto@gnu.org>
@@ -138,7 +138,6 @@ If nil, TAB always indents current line."
(define-key map "\C-c\t" 'indent-according-to-mode)
(define-key map "\M-\C-\\" 'vera-indent-region)
(define-key map "\C-c\C-c" 'vera-comment-uncomment-region)
- (define-key map "\C-c\C-f" 'vera-fontify-buffer)
(define-key map "\C-c\C-v" 'vera-version)
(define-key map "\M-\t" 'tab-to-tab-stop)
;; Electric key bindings.
@@ -172,8 +171,6 @@ If nil, TAB always indents current line."
["Indent Region" vera-indent-region (mark)]
["Indent Buffer" vera-indent-buffer t]
"--"
- ["Fontify Buffer" vera-fontify-buffer t]
- "--"
["Documentation" describe-mode]
["Version" vera-version t]
["Bug Report..." vera-submit-bug-report t]
@@ -262,7 +259,7 @@ Usage:
INDENTATION: Typing `TAB' at the beginning of a line indents the line.
The amount of indentation is specified by option `vera-basic-offset'.
- Indentation can be done for an entire region \(`M-C-\\') or buffer (menu).
+ Indentation can be done for an entire region (`M-C-\\') or buffer (menu).
`TAB' always indents the line if option `vera-intelligent-tab' is nil.
WORD/COMMAND COMPLETION: Typing `TAB' after a (not completed) word looks
@@ -686,7 +683,8 @@ Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'."
"Font lock mode face used to highlight interface names."
:group 'font-lock-highlighting-faces)
-(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer)
+(define-obsolete-function-alias 'vera-fontify-buffer
+ 'font-lock-fontify-buffer "25.1")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indentation
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 03364bddd9f..489094b2e4f 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -1,13 +1,12 @@
-;; verilog-mode.el --- major mode for editing verilog source in Emacs
+;;; verilog-mode.el --- major mode for editing verilog source in Emacs
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
-;; Author: Michael McNamara (mac@verilog.com),
-;; Wilson Snyder (wsnyder@wsnyder.org)
-;; Please see our web sites:
+;; Author: Michael McNamara <mac@verilog.com>
+;; Wilson Snyder <wsnyder@wsnyder.org>
;; http://www.verilog.com
;; http://www.veripool.org
-;;
+;; Created: 3 Jan 1996
;; Keywords: languages
;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
@@ -38,25 +37,26 @@
;;; Commentary:
-;; This mode borrows heavily from the Pascal-mode and the cc-mode of Emacs
-
;; USAGE
;; =====
-;; A major mode for editing Verilog HDL source code. When you have
-;; entered Verilog mode, you may get more info by pressing C-h m. You
-;; may also get online help describing various functions by: C-h f
-;; <Name of function you want described>
+;; A major mode for editing Verilog and SystemVerilog HDL source code (IEEE
+;; 1364-2005 and IEEE 1800-2012 standards). When you have entered Verilog
+;; mode, you may get more info by pressing C-h m. You may also get online
+;; help describing various functions by: C-h f <Name of function you want
+;; described>
;; KNOWN BUGS / BUG REPORTS
;; =======================
-;; Verilog is a rapidly evolving language, and hence this mode is
-;; under continuous development. Hence this is beta code, and likely
-;; has bugs. Please report any issues to the issue tracker at
-;; http://www.veripool.org/verilog-mode
+;; SystemVerilog is a rapidly evolving language, and hence this mode is
+;; under continuous development. Please report any issues to the issue
+;; tracker at
+;;
+;; http://www.veripool.org/verilog-mode
+;;
;; Please use verilog-submit-bug-report to submit a report; type C-c
-;; C-b to invoke this and as a result I will have a much easier time
+;; C-b to invoke this and as a result we will have a much easier time
;; of reproducing the bug you find, and hence fixing it.
;; INSTALLING THE MODE
@@ -77,8 +77,8 @@
;; the following in code (please un comment it first!) in your
;; .emacs, or in your site's site-load.el
-; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t )
-; (add-to-list 'auto-mode-alist '("\\.[ds]?vh?\\'" . verilog-mode))
+;; (autoload 'verilog-mode "verilog-mode" "Verilog mode" t )
+;; (add-to-list 'auto-mode-alist '("\\.[ds]?vh?\\'" . verilog-mode))
;; Be sure to examine at the help for verilog-auto, and the other
;; verilog-auto-* functions for some major coding time savers.
@@ -92,41 +92,39 @@
;; in Local Variables in every file. Otherwise, different people's
;; AUTO expansion may result different whitespace changes.
;;
-; ;; Enable syntax highlighting of **all** languages
-; (global-font-lock-mode t)
-;
-; ;; User customization for Verilog mode
-; (setq verilog-indent-level 3
-; verilog-indent-level-module 3
-; verilog-indent-level-declaration 3
-; verilog-indent-level-behavioral 3
-; verilog-indent-level-directive 1
-; verilog-case-indent 2
-; verilog-auto-newline t
-; verilog-auto-indent-on-newline t
-; verilog-tab-always-indent t
-; verilog-auto-endcomments t
-; verilog-minimum-comment-distance 40
-; verilog-indent-begin-after-if t
-; verilog-auto-lineup 'declarations
-; verilog-highlight-p1800-keywords nil
-; verilog-linter "my_lint_shell_command"
-; )
-
-;;
+;; ;; Enable syntax highlighting of **all** languages
+;; (global-font-lock-mode t)
+;;
+;; ;; User customization for Verilog mode
+;; (setq verilog-indent-level 3
+;; verilog-indent-level-module 3
+;; verilog-indent-level-declaration 3
+;; verilog-indent-level-behavioral 3
+;; verilog-indent-level-directive 1
+;; verilog-case-indent 2
+;; verilog-auto-newline t
+;; verilog-auto-indent-on-newline t
+;; verilog-tab-always-indent t
+;; verilog-auto-endcomments t
+;; verilog-minimum-comment-distance 40
+;; verilog-indent-begin-after-if t
+;; verilog-auto-lineup 'declarations
+;; verilog-highlight-p1800-keywords nil
+;; verilog-linter "my_lint_shell_command"
+;; )
+
;;; History:
;;
;; See commit history at http://www.veripool.org/verilog-mode.html
;; (This section is required to appease checkdoc.)
;;; Code:
+;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version (substring "$$Revision: 840 $$" 12 -3)
+(defconst verilog-mode-version "2015-09-18-314cf1d-vpo-GNU"
"Version of this Verilog mode.")
-(defconst verilog-mode-release-date (substring "$$Date: 2013-01-03 05:29:05 -0800 (Thu, 03 Jan 2013) $$" 8 -3)
- "Release date of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -152,36 +150,36 @@
(error nil))
(condition-case nil
(if (fboundp 'when)
- nil ;; fab
+ nil ; fab
(defmacro when (cond &rest body)
(list 'if cond (cons 'progn body))))
(error nil))
(condition-case nil
(if (fboundp 'unless)
- nil ;; fab
+ nil ; fab
(defmacro unless (cond &rest body)
(cons 'if (cons cond (cons nil body)))))
(error nil))
(condition-case nil
(if (fboundp 'store-match-data)
- nil ;; fab
- (defmacro store-match-data (&rest args) nil))
+ nil ; fab
+ (defmacro store-match-data (&rest _args) nil))
(error nil))
(condition-case nil
(if (fboundp 'char-before)
- nil ;; great
- (defmacro char-before (&rest body)
+ nil ; great
+ (defmacro char-before (&rest _body)
(char-after (1- (point)))))
(error nil))
(condition-case nil
(if (fboundp 'when)
- nil ;; fab
+ nil ; fab
(defsubst point-at-bol (&optional N)
(save-excursion (beginning-of-line N) (point))))
(error nil))
(condition-case nil
(if (fboundp 'when)
- nil ;; fab
+ nil ; fab
(defsubst point-at-eol (&optional N)
(save-excursion (end-of-line N) (point))))
(error nil))
@@ -190,7 +188,7 @@
(error nil))
(condition-case nil
(if (fboundp 'match-string-no-properties)
- nil ;; great
+ nil ; great
(defsubst match-string-no-properties (num &optional string)
"Return string of text matched by last search, without text properties.
NUM specifies which parenthesized expression in the last regexp.
@@ -210,25 +208,25 @@ STRING should be given if the last search was by `string-match' on STRING."
)
(error nil))
(if (and (featurep 'custom) (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
+ nil ; We've got what we needed
;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args) nil)
- (defmacro customize (&rest args)
+ (defmacro defgroup (&rest _args) nil)
+ (defmacro customize (&rest _args)
(message
"Sorry, Customize is not available with this version of Emacs"))
- (defmacro defcustom (var value doc &rest args)
+ (defmacro defcustom (var value doc &rest _args)
`(defvar ,var ,value ,doc))
)
(if (fboundp 'defface)
nil ; great!
- (defmacro defface (var values doc &rest args)
+ (defmacro defface (var values doc &rest _args)
`(make-face ,var))
)
(if (and (featurep 'custom) (fboundp 'customize-group))
- nil ;; We've got what we needed
+ nil ; We've got what we needed
;; We have an intermediate custom-library, hack around it!
- (defmacro customize-group (var &rest args)
+ (defmacro customize-group (var &rest _args)
`(customize ,var))
)
@@ -256,44 +254,88 @@ STRING should be given if the last search was by `string-match' on STRING."
(if (fboundp 'function-max-args)
(let ((args (function-max-args `regexp-opt)))
(cond
- ((eq args 3) ;; It takes 3
+ ((eq args 3) ; It takes 3
(condition-case nil ; Hide this defun from emacses
- ;with just a two input regexp
+ ; with just a two input regexp
(defun verilog-regexp-opt (a b)
"Deal with differing number of required arguments for `regexp-opt'.
- Call 'regexp-opt' on A and B."
- (regexp-opt a b 't))
+ Call `regexp-opt' on A and B."
+ (regexp-opt a b t))
(error nil))
)
- ((eq args 2) ;; It takes 2
+ ((eq args 2) ; It takes 2
(defun verilog-regexp-opt (a b)
- "Call 'regexp-opt' on A and B."
+ "Call `regexp-opt' on A and B."
(regexp-opt a b))
)
(t nil)))
;; We can't tell; assume it takes 2
(defun verilog-regexp-opt (a b)
- "Call 'regexp-opt' on A and B."
+ "Call `regexp-opt' on A and B."
(regexp-opt a b))
)
;; There is no regexp-opt, provide our own
- (defun verilog-regexp-opt (strings &optional paren shy)
+ (defun verilog-regexp-opt (strings &optional paren _shy)
(let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
(concat open (mapconcat 'regexp-quote strings "\\|") close)))
)
;; Emacs.
(defalias 'verilog-regexp-opt 'regexp-opt)))
+;; emacs >=22 has looking-back, but older emacs and xemacs don't.
+;; This function is lifted directly from emacs's subr.el
+;; so that it can be used by xemacs.
+;; The idea for this was borrowed from org-mode via this link:
+;; https://lists.gnu.org/archive/html/emacs-orgmode/2009-12/msg00032.html
+(eval-and-compile
+ (cond
+ ((fboundp 'looking-back)
+ (defalias 'verilog-looking-back 'looking-back))
+ (t
+ (defun verilog-looking-back (regexp limit &optional greedy)
+ "Return non-nil if text before point matches regular expression REGEXP.
+Like `looking-at' except matches before point, and is slower.
+LIMIT if non-nil speeds up the search by specifying a minimum
+starting position, to avoid checking matches that would start
+before LIMIT.
+
+If GREEDY is non-nil, extend the match backwards as far as
+possible, stopping when a single additional previous character
+cannot be part of a match for REGEXP. When the match is
+extended, its starting position is allowed to occur before
+LIMIT.
+
+As a general recommendation, try to avoid using `looking-back'
+wherever possible, since it is slow."
+ (let ((start (point))
+ (pos
+ (save-excursion
+ (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
+ (point)))))
+ (if (and greedy pos)
+ (save-restriction
+ (narrow-to-region (point-min) start)
+ (while (and (> pos (point-min))
+ (save-excursion
+ (goto-char pos)
+ (backward-char 1)
+ (looking-at (concat "\\(?:" regexp "\\)\\'"))))
+ (setq pos (1- pos)))
+ (save-excursion
+ (goto-char pos)
+ (looking-at (concat "\\(?:" regexp "\\)\\'")))))
+ (not (null pos)))))))
+
(eval-and-compile
;; Both xemacs and emacs
(condition-case nil
- (require 'diff) ;; diff-command and diff-switches
+ (require 'diff) ; diff-command and diff-switches
(error nil))
(condition-case nil
- (require 'compile) ;; compilation-error-regexp-alist-alist
+ (require 'compile) ; compilation-error-regexp-alist-alist
(error nil))
(condition-case nil
- (unless (fboundp 'buffer-chars-modified-tick) ;; Emacs 22 added
+ (unless (fboundp 'buffer-chars-modified-tick) ; Emacs 22 added
(defmacro buffer-chars-modified-tick () (buffer-modified-tick)))
(error nil))
;; Added in Emacs 24.1
@@ -304,17 +346,17 @@ STRING should be given if the last search was by `string-match' on STRING."
(eval-when-compile
(defun verilog-regexp-words (a)
- "Call 'regexp-opt' with word delimiters for the words A."
+ "Call `regexp-opt' with word delimiters for the words A."
(concat "\\<" (verilog-regexp-opt a t) "\\>")))
(defun verilog-regexp-words (a)
- "Call 'regexp-opt' with word delimiters for the words A."
+ "Call `regexp-opt' with word delimiters for the words A."
;; The FAQ references this function, so user LISP sometimes calls it
(concat "\\<" (verilog-regexp-opt a t) "\\>"))
(defun verilog-easy-menu-filter (menu)
"Filter `easy-menu-define' MENU to support new features."
(cond ((not (featurep 'xemacs))
- menu) ;; GNU Emacs - passthru
+ menu) ; GNU Emacs - passthru
;; XEmacs doesn't support :help. Strip it.
;; Recursively filter the a submenu
((listp menu)
@@ -328,7 +370,7 @@ STRING should be given if the last search was by `string-match' on STRING."
(setq out (vconcat out (vector (aref menu i)))
i (1+ i))))
out))
- (t menu))) ;; Default - ok
+ (t menu))) ; Default - ok
;;(verilog-easy-menu-filter
;; `("Verilog" ("MA" ["SAA" nil :help "Help SAA"] ["SAB" nil :help "Help SAA"])
;; "----" ["MB" nil :help "Help MB"]))
@@ -397,10 +439,10 @@ Set `verilog-in-hooks' during this time, to assist AUTO caches."
:version "22.2"
:group 'languages)
-; (defgroup verilog-mode-fonts nil
-; "Facilitates easy customization fonts used in Verilog source text"
-; :link '(customize-apropos "font-lock-*" 'faces)
-; :group 'verilog-mode)
+;; (defgroup verilog-mode-fonts nil
+;; "Facilitates easy customization fonts used in Verilog source text"
+;; :link '(customize-apropos "font-lock-*" 'faces)
+;; :group 'verilog-mode)
(defgroup verilog-mode-indent nil
"Customize indentation and highlighting of Verilog source text."
@@ -477,8 +519,8 @@ take you to the next lint error."
(defvar verilog-tool 'verilog-linter
"Which tool to use for building compiler-command.
-Either nil, `verilog-linter, `verilog-compiler,
-`verilog-coverage, `verilog-preprocessor, or `verilog-simulator.
+Either nil, `verilog-linter', `verilog-compiler',
+`verilog-coverage', `verilog-preprocessor', or `verilog-simulator'.
Alternatively use the \"Choose Compilation Action\" menu. See
`verilog-set-compile-command' for more information.")
@@ -499,18 +541,18 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font locking."
(defcustom verilog-auto-lineup 'declarations
"Type of statements to lineup across multiple lines.
-If 'all' is selected, then all line ups described below are done.
+If `all' is selected, then all line ups described below are done.
-If 'declarations', then just declarations are lined up with any
+If `declarations', then just declarations are lined up with any
preceding declarations, taking into account widths and the like,
so or example the code:
- reg [31:0] a;
- reg b;
+ reg [31:0] a;
+ reg b;
would become
- reg [31:0] a;
- reg b;
+ reg [31:0] a;
+ reg b;
-If 'assignment', then assignments are lined up with any preceding
+If `assignment', then assignments are lined up with any preceding
assignments, so for example the code
a_long_variable <= b + c;
d = e + f;
@@ -555,11 +597,11 @@ Set to 0 to get them list right under containing block."
"How to treat macro expansions in a declaration.
If nil, indent as:
input [31:0] a;
- input `CP;
+ input \\=`CP;
output c;
If non nil, treat as:
input [31:0] a;
- input `CP ;
+ input \\=`CP ;
output c;"
:group 'verilog-mode-indent
:type 'boolean)
@@ -586,7 +628,7 @@ Set to 0 to get such code to start at the left side of the screen."
(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp)
(defcustom verilog-indent-level-directive 1
- "Indentation to add to each level of `ifdef declarations.
+ "Indentation to add to each level of \\=`ifdef declarations.
Set to 0 to have all directives start at the left side of the screen."
:group 'verilog-mode-indent
:type 'integer)
@@ -663,10 +705,11 @@ to see the effect as font color choices are cached by Emacs."
(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-highlight-grouping-keywords nil
- "Non-nil means highlight grouping keywords 'begin' and 'end' more dramatically.
-If false, these words are in the `font-lock-type-face'; if True then they are in
-`verilog-font-lock-ams-face'. Some find that special highlighting on these
-grouping constructs allow the structure of the code to be understood at a glance."
+ "Non-nil means highlight grouping keywords more dramatically.
+If false, these words are in the `font-lock-type-face'; if True
+then they are in `verilog-font-lock-grouping-keywords-face'.
+Some find that special highlighting on these grouping constructs
+allow the structure of the code to be understood at a glance."
:group 'verilog-mode-indent
:type 'boolean)
(put 'verilog-highlight-grouping-keywords 'safe-local-variable 'verilog-booleanp)
@@ -690,10 +733,10 @@ file referenced. If false, this is not supported."
(defcustom verilog-auto-declare-nettype nil
"Non-nil specifies the data type to use with `verilog-auto-input' etc.
-Set this to \"wire\" if the Verilog code uses \"`default_nettype
-none\". Note using `default_nettype none isn't recommended practice; this
+Set this to \"wire\" if the Verilog code uses \"\\=`default_nettype
+none\". Note using \\=`default_nettype none isn't recommended practice; this
mode is experimental."
- :version "24.1" ;; rev670
+ :version "24.1" ; rev670
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-declare-nettype 'safe-local-variable `stringp)
@@ -701,7 +744,7 @@ mode is experimental."
(defcustom verilog-auto-wire-type nil
"Non-nil specifies the data type to use with `verilog-auto-wire' etc.
Set this to \"logic\" for SystemVerilog code, or use `verilog-auto-logic'."
- :version "24.1" ;; rev673
+ :version "24.1" ; rev673
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-wire-type 'safe-local-variable `stringp)
@@ -715,7 +758,7 @@ The name of the function or case will be set between the braces."
(defcustom verilog-auto-delete-trailing-whitespace nil
"Non-nil means to `delete-trailing-whitespace' in `verilog-auto'."
- :version "24.1" ;; rev703
+ :version "24.1" ; rev703
:group 'verilog-mode-actions
:type 'boolean)
(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable 'verilog-booleanp)
@@ -784,8 +827,11 @@ Function takes three arguments, the original buffer, the
difference buffer, and the point in original buffer with the
first difference.")
-;;; Compile support
+;;; Compile support:
+;;
+
(require 'compile)
+
(defvar verilog-error-regexp-added nil)
(defvar verilog-error-regexp-emacs-alist
@@ -795,7 +841,7 @@ first difference.")
(verilog-xl-2
"([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 1 3)
(verilog-IES
- ".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)" 2 3)
+ ".*\\*[WE],[0-9A-Z]+\\(\\[[0-9A-Z_,]+\\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)" 2 3)
(verilog-surefire-1
"[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 2)
(verilog-surefire-2
@@ -839,8 +885,8 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.")
("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 1 bold t)
("([WE][0-9A-Z]+)[ \t]+\\([^ \t\n,]+\\)[, \t]+\\(line[ \t]+\\)?\\([0-9]+\\):.*$" 3 bold t)
;; verilog-IES (nc-verilog)
- (".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 2 bold t)
- (".*\\*[WE],[0-9A-Z]+\\(\[[0-9A-Z_,]+\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 3 bold t)
+ (".*\\*[WE],[0-9A-Z]+\\(\\[[0-9A-Z_,]+\\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 2 bold t)
+ (".*\\*[WE],[0-9A-Z]+\\(\\[[0-9A-Z_,]+\\]\\)? (\\([^ \t,]+\\),\\([0-9]+\\)|" 3 bold t)
;; verilog-surefire-1
("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 1 bold t)
("[^\n]*\\[\\([^:]+\\):\\([0-9]+\\)\\]" 2 bold t)
@@ -960,7 +1006,7 @@ See also `verilog-library-flags', `verilog-library-directories'."
(put 'verilog-library-extensions 'safe-local-variable 'listp)
(defcustom verilog-active-low-regexp nil
- "If set, treat signals matching this regexp as active low.
+ "If true, treat signals matching this regexp as active low.
This is used for AUTORESET and AUTOTIEOFF. For proper behavior,
you will probably also need `verilog-auto-reset-widths' set."
:group 'verilog-mode-auto
@@ -994,7 +1040,7 @@ If nil, all blocking assigned signals are ignored when any
non-blocking assignment is in the AUTORESET block. This allows
blocking assignments to be used for temporary values and not have
those temporaries reset. See example in `verilog-auto-reset'."
- :version "24.1" ;; rev718
+ :version "24.1" ; rev718
:type 'boolean
:group 'verilog-mode-auto)
(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable 'verilog-booleanp)
@@ -1003,12 +1049,12 @@ those temporaries reset. See example in `verilog-auto-reset'."
"True means AUTORESET should determine the width of signals.
This is then used to set the width of the zero (32'h0 for example). This
is required by some lint tools that aren't smart enough to ignore widths of
-the constant zero. This may result in ugly code when parameters determine
+the constant zero. This may result in ugly code when parameters determine
the MSB or LSB of a signal inside an AUTORESET.
If nil, AUTORESET uses \"0\" as the constant.
-If 'unbased', AUTORESET used the unbased unsized literal \"'0\"
+If `unbased', AUTORESET used the unbased unsized literal \"\\='0\"
as the constant. This setting is strongly recommended for
SystemVerilog designs."
:type 'boolean
@@ -1022,6 +1068,20 @@ SystemVerilog designs."
:type 'string)
(put 'verilog-assignment-delay 'safe-local-variable 'stringp)
+(defcustom verilog-auto-arg-format 'packed
+ "Formatting to use for AUTOARG signal names.
+If `packed', then as many inputs and outputs that fit within
+`fill-column' will be put onto one line.
+
+If `single', then a single input or output will be put onto each
+line."
+ :version "25.1"
+ :type '(radio (const :tag "Line up Assignments and Declarations" packed)
+ (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))))
+
(defcustom verilog-auto-arg-sort nil
"Non-nil means AUTOARG signal names will be sorted, not in declaration order.
Declaration order is advantageous with order based instantiations
@@ -1062,7 +1122,7 @@ inputs. This is then used by an upper module:
module ExampInst;
InstModule
- #(PARAM(10))
+ #(.PARAM(10))
instName
(/*AUTOINST*/
.i (i[PARAM-1:0]));
@@ -1073,7 +1133,7 @@ instead expand to:
module ExampInst;
InstModule
- #(PARAM(10))
+ #(.PARAM(10))
instName
(/*AUTOINST*/
.i (i[9:0]));"
@@ -1089,7 +1149,7 @@ declared together to remain together. Sorted order reduces
changes when declarations are moved around in a file.
See also `verilog-auto-arg-sort'."
- :version "24.1" ;; rev688
+ :version "24.1" ; rev688
:group 'verilog-mode-auto
:type 'boolean)
(put 'verilog-auto-inst-sort 'safe-local-variable 'verilog-booleanp)
@@ -1112,7 +1172,7 @@ was used for that port declaration. This setting is suggested
only for debugging use, as regular use may cause a large numbers
of merge conflicts.
-If 'lhs', the comment will show the left hand side of the
+If `lhs', the comment will show the left hand side of the
AUTO_TEMPLATE rule that is matched. This is less precise than
numbering (t) when multiple rules have the same pin name, but
won't merge conflict."
@@ -1129,27 +1189,27 @@ won't merge conflict."
(defcustom verilog-auto-inst-interfaced-ports nil
"Non-nil means include interfaced ports in AUTOINST expansions."
- :version "24.3" ;; rev773, default change rev815
+ :version "24.3" ; rev773, default change rev815
:group 'verilog-mode-auto
:type 'boolean)
(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp)
(defcustom verilog-auto-input-ignore-regexp nil
- "If set, when creating AUTOINPUT list, ignore signals matching this regexp.
+ "If non-nil, when creating AUTOINPUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-inout-ignore-regexp nil
- "If set, when creating AUTOINOUT list, ignore signals matching this regexp.
+ "If non-nil, when creating AUTOINOUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-output-ignore-regexp nil
- "If set, when creating AUTOOUTPUT list, ignore signals matching this regexp.
+ "If non-nil, when creating AUTOOUTPUT, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
@@ -1158,7 +1218,7 @@ See the \\[verilog-faq] for examples on using this."
(defcustom verilog-auto-template-warn-unused nil
"Non-nil means report warning if an AUTO_TEMPLATE line is not used.
This feature is not supported before Emacs 21.1 or XEmacs 21.4."
- :version "24.3" ;;rev787
+ :version "24.3" ; rev787
:group 'verilog-mode-auto
:type 'boolean)
(put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp)
@@ -1167,28 +1227,37 @@ This feature is not supported before Emacs 21.1 or XEmacs 21.4."
"Data type used for the declaration for AUTOTIEOFF.
If \"wire\" then create a wire, if \"assign\" create an
assignment, else the data type for variable creation."
- :version "24.1" ;; rev713
+ :version "24.1" ; rev713
:group 'verilog-mode-auto
:type 'string)
(put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp)
(defcustom verilog-auto-tieoff-ignore-regexp nil
- "If set, when creating AUTOTIEOFF list, ignore signals matching this regexp.
+ "If non-nil, when creating AUTOTIEOFF, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp)
(defcustom verilog-auto-unused-ignore-regexp nil
- "If set, when creating AUTOUNUSED list, ignore signals matching this regexp.
+ "If non-nil, when creating AUTOUNUSED, ignore signals matching this regexp.
See the \\[verilog-faq] for examples on using this."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp)
+(defcustom verilog-case-fold t
+ "Non-nil means `verilog-mode' regexps should ignore case.
+This variable is t for backward compatibility; nil is suggested."
+ :version "24.4"
+ :group 'verilog-mode
+ :type 'boolean)
+(put 'verilog-case-fold 'safe-local-variable 'verilog-booleanp)
+
(defcustom verilog-typedef-regexp nil
"If non-nil, regular expression that matches Verilog-2001 typedef names.
-For example, \"_t$\" matches typedefs named with _t, as in the C language."
+For example, \"_t$\" matches typedefs named with _t, as in the C language.
+See also `verilog-case-fold'."
:group 'verilog-mode-auto
:type '(choice (const nil) regexp))
(put 'verilog-typedef-regexp 'safe-local-variable 'stringp)
@@ -1230,13 +1299,13 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language."
(defcustom verilog-before-save-font-hook nil
"Hook run before `verilog-save-font-mods' removes highlighting."
- :version "24.3" ;;rev735
+ :version "24.3" ; rev735
:group 'verilog-mode-auto
:type 'hook)
(defcustom verilog-after-save-font-hook nil
"Hook run after `verilog-save-font-mods' restores highlighting."
- :version "24.3" ;;rev735
+ :version "24.3" ; rev735
:group 'verilog-mode-auto
:type 'hook)
@@ -1264,13 +1333,16 @@ If set will become buffer local.")
If set will become buffer local.")
(make-variable-buffer-local 'verilog-project)
+;;; Keymap and Menu:
+;;
+
(defvar verilog-mode-map
(let ((map (make-sparse-keymap)))
(define-key map ";" 'electric-verilog-semi)
(define-key map [(control 59)] 'electric-verilog-semi-with-comment)
(define-key map ":" 'electric-verilog-colon)
;;(define-key map "=" 'electric-verilog-equal)
- (define-key map "\`" 'electric-verilog-tick)
+ (define-key map "`" 'electric-verilog-tick)
(define-key map "\t" 'electric-verilog-tab)
(define-key map "\r" 'electric-verilog-terminate-line)
;; backspace/delete key bindings
@@ -1284,9 +1356,9 @@ If set will become buffer local.")
(define-key map "\M-\t" 'verilog-complete-word)
(define-key map "\M-?" 'verilog-show-completions)
;; Note \C-c and letter are reserved for users
- (define-key map "\C-c\`" 'verilog-lint-off)
- (define-key map "\C-c\*" 'verilog-delete-auto-star-implicit)
- (define-key map "\C-c\?" 'verilog-diff-auto)
+ (define-key map "\C-c`" 'verilog-lint-off)
+ (define-key map "\C-c*" 'verilog-delete-auto-star-implicit)
+ (define-key map "\C-c?" 'verilog-diff-auto)
(define-key map "\C-c\C-r" 'verilog-label-be)
(define-key map "\C-c\C-i" 'verilog-pretty-declarations)
(define-key map "\C-c=" 'verilog-pretty-expr)
@@ -1437,6 +1509,8 @@ If set will become buffer local.")
:help "Help on AUTOASCIIENUM - creating ASCII for enumerations"]
["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport)
:help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"]
+ ["AUTOINOUT" (describe-function 'verilog-auto-inout)
+ :help "Help on AUTOINOUT - adding inouts from cells"]
["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp)
:help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"]
["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in)
@@ -1447,12 +1521,12 @@ If set will become buffer local.")
:help "Help on AUTOINOUTMODULE - copying i/o from another file"]
["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param)
:help "Help on AUTOINOUTPARAM - copying parameters from another file"]
- ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp)
- :help "Help on AUTOINSERTLISP - insert text from a lisp function"]
- ["AUTOINOUT" (describe-function 'verilog-auto-inout)
- :help "Help on AUTOINOUT - adding inouts from cells"]
["AUTOINPUT" (describe-function 'verilog-auto-input)
:help "Help on AUTOINPUT - adding inputs from cells"]
+ ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp)
+ :help "Help on AUTOINSERTLISP - insert text from a lisp function"]
+ ["AUTOINSERTLAST" (describe-function 'verilog-auto-insert-last)
+ :help "Help on AUTOINSERTLISPLAST - insert text from a lisp function"]
["AUTOINST" (describe-function 'verilog-auto-inst)
:help "Help on AUTOINST - adding pins for cells"]
["AUTOINST (.*)" (describe-function 'verilog-auto-star)
@@ -1471,7 +1545,7 @@ If set will become buffer local.")
:help "Help on AUTOREGINPUT - declaring inputs for non-wires"]
["AUTORESET" (describe-function 'verilog-auto-reset)
:help "Help on AUTORESET - resetting always blocks"]
- ["AUTOSENSE" (describe-function 'verilog-auto-sense)
+ ["AUTOSENSE or AS" (describe-function 'verilog-auto-sense)
:help "Help on AUTOSENSE - sensitivity lists for always blocks"]
["AUTOTIEOFF" (describe-function 'verilog-auto-tieoff)
:help "Help on AUTOTIEOFF - tying off unused outputs"]
@@ -1505,8 +1579,10 @@ If set will become buffer local.")
:help "Insert a module .. (/*AUTOARG*/);.. endmodule block"]
["OVM Class" verilog-sk-ovm-class
:help "Insert an OVM class block"]
- ["UVM Class" verilog-sk-uvm-class
- :help "Insert an UVM class block"]
+ ["UVM Object" verilog-sk-uvm-object
+ :help "Insert an UVM object block"]
+ ["UVM Component" verilog-sk-uvm-component
+ :help "Insert an UVM component block"]
["Primitive" verilog-sk-primitive
:help "Insert a primitive .. (.. );.. endprimitive block"]
"----"
@@ -1594,9 +1670,17 @@ If set will become buffer local.")
(defsubst verilog-within-string ()
(nth 3 (parse-partial-sexp (point-at-bol) (point))))
+(defsubst verilog-string-match-fold (regexp string &optional start)
+ "Like `string-match', but use `verilog-case-fold'.
+Return index of start of first match for REGEXP in STRING, or nil.
+Matching ignores case if `verilog-case-fold' is non-nil.
+If third arg START is non-nil, start search at that index in STRING."
+ (let ((case-fold-search verilog-case-fold))
+ (string-match regexp string start)))
+
(defsubst verilog-string-replace-matches (from-string to-string fixedcase literal string)
"Replace occurrences of FROM-STRING with TO-STRING.
-FIXEDCASE and LITERAL as in `replace-match`. STRING is what to replace.
+FIXEDCASE and LITERAL as in `replace-match'. STRING is what to replace.
The case (verilog-string-replace-matches \"o\" \"oo\" nil nil \"foobar\")
will break, as the o's continuously replace. xa -> x works ok though."
;; Hopefully soon to an Emacs built-in
@@ -1617,9 +1701,9 @@ will break, as the o's continuously replace. xa -> x works ok though."
string))
(defsubst verilog-re-search-forward (REGEXP BOUND NOERROR)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `re-search-forward', but skips over match in comments or strings."
- (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found
+ (let ((mdata '(nil nil))) ; So match-end will return nil if no matches found
(while (and
(re-search-forward REGEXP BOUND NOERROR)
(setq mdata (match-data))
@@ -1633,9 +1717,9 @@ will break, as the o's continuously replace. xa -> x works ok though."
(match-end 0)))
(defsubst verilog-re-search-backward (REGEXP BOUND NOERROR)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `re-search-backward', but skips over match in comments or strings."
- (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found
+ (let ((mdata '(nil nil))) ; So match-end will return nil if no matches found
(while (and
(re-search-backward REGEXP BOUND NOERROR)
(setq mdata (match-data))
@@ -1657,12 +1741,12 @@ so there may be a large up front penalty for the first search."
(while (and (not pt)
(re-search-forward regexp bound noerror))
(if (verilog-inside-comment-or-string-p)
- (re-search-forward "[/\"\n]" nil t) ;; Only way a comment or quote can end
+ (re-search-forward "[/\"\n]" nil t) ; Only way a comment or quote can end
(setq pt (match-end 0))))
pt))
(defsubst verilog-re-search-backward-quick (regexp bound noerror)
- ; checkdoc-params: (REGEXP BOUND NOERROR)
+ ;; checkdoc-params: (REGEXP BOUND NOERROR)
"Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR,
but trashes match data and is faster for REGEXP that doesn't match often.
This uses `verilog-scan' and text properties to ignore comments,
@@ -1671,7 +1755,7 @@ so there may be a large up front penalty for the first search."
(while (and (not pt)
(re-search-backward regexp bound noerror))
(if (verilog-inside-comment-or-string-p)
- (re-search-backward "[/\"]" nil t) ;; Only way a comment or quote can begin
+ (re-search-backward "[/\"]" nil t) ; Only way a comment or quote can begin
(setq pt (match-beginning 0))))
pt))
@@ -1693,7 +1777,7 @@ This speeds up complicated regexp matches."
(setq done nil)))
(when done (goto-char done))
done))
-;;(verilog-re-search-forward-substr "-end" "get-end-of" nil t) ;;-end (test bait)
+;;(verilog-re-search-forward-substr "-end" "get-end-of" nil t) ; -end (test bait)
(defsubst verilog-re-search-backward-substr (substr regexp bound noerror)
"Like `re-search-backward', but first search for SUBSTR constant.
@@ -1713,7 +1797,7 @@ This speeds up complicated regexp matches."
(setq done nil)))
(when done (goto-char done))
done))
-;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait)
+;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ; -end (test bait)
(defun verilog-delete-trailing-whitespace ()
"Delete trailing spaces or tabs, but not newlines nor linefeeds.
@@ -1725,12 +1809,13 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'."
;; Similar to `delete-trailing-whitespace' but that's not present in XEmacs
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed
+ (while (re-search-forward "[ \t]+$" nil t) ; Not syntactic WS as no formfeed
(replace-match "" nil nil))
(goto-char (point-max))
(unless (bolp) (insert "\n"))))
(defvar compile-command)
+(defvar create-lockfiles) ; Emacs 24
;; compilation program
(defun verilog-set-compile-command ()
@@ -1788,7 +1873,7 @@ be substituted."
t t command))
(setq command (verilog-string-replace-matches
"\\b__FILE__\\b" (file-name-nondirectory
- (or (buffer-file-name) ""))
+ (or (buffer-file-name) ""))
t t command))
command)
@@ -1829,31 +1914,38 @@ find the errors."
;; Following code only gets called from compilation-mode-hook on Emacs to add error handling.
(defun verilog-error-regexp-add-emacs ()
- "Tell Emacs compile that we are Verilog.
+ "Tell Emacs compile that we are Verilog.
Called by `compilation-mode-hook'. This allows \\[next-error] to
find the errors."
- (interactive)
- (if (boundp 'compilation-error-regexp-alist-alist)
- (progn
- (if (not (assoc 'verilog-xl-1 compilation-error-regexp-alist-alist))
- (mapcar
- (lambda (item)
- (push (car item) compilation-error-regexp-alist)
- (push item compilation-error-regexp-alist-alist)
- )
- verilog-error-regexp-emacs-alist)))))
+ (interactive)
+ (when (boundp 'compilation-error-regexp-alist-alist)
+ (when (not (assoc 'verilog-xl-1 compilation-error-regexp-alist-alist))
+ (mapcar
+ (lambda (item)
+ (push (car item) compilation-error-regexp-alist)
+ (push item compilation-error-regexp-alist-alist))
+ verilog-error-regexp-emacs-alist))))
(if (featurep 'xemacs) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add-xemacs))
(if (featurep 'emacs) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add-emacs))
-(defconst verilog-directive-re
+(defconst verilog-compiler-directives
(eval-when-compile
- (verilog-regexp-words
- '(
- "`case" "`default" "`define" "`else" "`elsif" "`endfor" "`endif"
- "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
- "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
- "`time_scale" "`undef" "`while" ))))
+ '(
+ ;; compiler directives, from IEEE 1800-2012 section 22.1
+ "`__FILE__" "`__LINE" "`begin_keywords" "`celldefine" "`default_nettype"
+ "`define" "`else" "`elsif" "`end_keywords" "`endcelldefine" "`endif"
+ "`ifdef" "`ifndef" "`include" "`line" "`nounconnected_drive" "`pragma"
+ "`resetall" "`timescale" "`unconnected_drive" "`undef" "`undefineall"
+ ;; compiler directives not covered by IEEE 1800
+ "`case" "`default" "`endfor" "`endprotect" "`endswitch" "`endwhile" "`for"
+ "`format" "`if" "`let" "`protect" "`switch" "`timescale" "`time_scale"
+ "`while"
+ ))
+ "List of Verilog compiler directives.")
+
+(defconst verilog-directive-re
+ (verilog-regexp-words verilog-compiler-directives))
(defconst verilog-directive-re-1
(concat "[ \t]*" verilog-directive-re))
@@ -1941,10 +2033,10 @@ find the errors."
(eval-when-compile
(verilog-regexp-opt
'(
-;; "`vmm_xactor_member_enum_array"
"`vmm_\\(data\\|env\\|scenario\\|subenv\\|xactor\\)_member_\\(scalar\\|string\\|enum\\|vmm_data\\|channel\\|xactor\\|subenv\\|user_defined\\)\\(_array\\)?"
-;; "`vmm_xactor_member_scalar_array"
-;; "`vmm_xactor_member_scalar"
+ ;; "`vmm_xactor_member_enum_array"
+ ;; "`vmm_xactor_member_scalar_array"
+ ;; "`vmm_xactor_member_scalar"
) nil )))
(defconst verilog-ovm-statement-re
@@ -2071,9 +2163,9 @@ find the errors."
"`uvm_component_utils"
"`uvm_create"
"`uvm_create_on"
- "`uvm_create_seq" ;; Undocumented in 1.1
+ "`uvm_create_seq" ; Undocumented in 1.1
"`uvm_declare_p_sequencer"
- "`uvm_declare_sequence_lib" ;; Deprecated in 1.1
+ "`uvm_declare_sequence_lib" ; Deprecated in 1.1
"`uvm_do"
"`uvm_do_callbacks"
"`uvm_do_callbacks_exit_on"
@@ -2085,8 +2177,8 @@ find the errors."
"`uvm_do_on_with"
"`uvm_do_pri"
"`uvm_do_pri_with"
- "`uvm_do_seq" ;; Undocumented in 1.1
- "`uvm_do_seq_with" ;; Undocumented in 1.1
+ "`uvm_do_seq" ; Undocumented in 1.1
+ "`uvm_do_seq_with" ; Undocumented in 1.1
"`uvm_do_with"
"`uvm_error"
"`uvm_error_context"
@@ -2128,14 +2220,14 @@ find the errors."
"`uvm_field_sarray_string"
"`uvm_field_string"
"`uvm_field_utils"
- "`uvm_file" ;; Undocumented in 1.1, use `__FILE__
+ "`uvm_file" ; Undocumented in 1.1, use `__FILE__
"`uvm_get_imp_decl"
"`uvm_get_peek_imp_decl"
"`uvm_info"
"`uvm_info_context"
- "`uvm_line" ;; Undocumented in 1.1, use `__LINE__
+ "`uvm_line" ; Undocumented in 1.1, use `__LINE__
"`uvm_master_imp_decl"
- "`uvm_non_blocking_transport_imp_decl" ;; Deprecated in 1.1
+ "`uvm_non_blocking_transport_imp_decl" ; Deprecated in 1.1
"`uvm_nonblocking_get_imp_decl"
"`uvm_nonblocking_get_peek_imp_decl"
"`uvm_nonblocking_master_imp_decl"
@@ -2145,7 +2237,7 @@ find the errors."
"`uvm_nonblocking_transport_imp_decl"
"`uvm_object_param_utils"
"`uvm_object_registry"
- "`uvm_object_registry_param" ;; Undocumented in 1.1
+ "`uvm_object_registry_param" ; Undocumented in 1.1
"`uvm_object_utils"
"`uvm_pack_array"
"`uvm_pack_arrayN"
@@ -2170,7 +2262,7 @@ find the errors."
"`uvm_register_cb"
"`uvm_send"
"`uvm_send_pri"
- "`uvm_sequence_utils" ;; Deprecated in 1.1
+ "`uvm_sequence_utils" ; Deprecated in 1.1
"`uvm_set_super_type"
"`uvm_slave_imp_decl"
"`uvm_transport_imp_decl"
@@ -2186,8 +2278,8 @@ find the errors."
"`uvm_unpack_sarray"
"`uvm_unpack_sarrayN"
"`uvm_unpack_string"
- "`uvm_update_sequence_lib" ;; Deprecated in 1.1
- "`uvm_update_sequence_lib_and_item" ;; Deprecated in 1.1
+ "`uvm_update_sequence_lib" ; Deprecated in 1.1
+ "`uvm_update_sequence_lib_and_item" ; Deprecated in 1.1
"`uvm_warning"
"`uvm_warning_context") nil )))
@@ -2204,36 +2296,40 @@ find the errors."
;; b :
(defconst verilog-assignment-operator-re
(eval-when-compile
- (verilog-regexp-opt
- `(
- ;; blocking assignment_operator
- "=" "+=" "-=" "*=" "/=" "%=" "&=" "|=" "^=" "<<=" ">>=" "<<<=" ">>>="
- ;; non blocking assignment operator
- "<="
- ;; comparison
- "==" "!=" "===" "!===" "<=" ">=" "==\?" "!=\?"
- ;; event_trigger
- "->" "->>"
- ;; property_expr
- "|->" "|=>"
- ;; Is this a legal verilog operator?
- ":="
- ) 't
- )))
+ (verilog-regexp-opt
+ `(
+ ;; blocking assignment_operator
+ "=" "+=" "-=" "*=" "/=" "%=" "&=" "|=" "^=" "<<=" ">>=" "<<<=" ">>>="
+ ;; non blocking assignment operator
+ "<="
+ ;; comparison
+ "==" "!=" "===" "!==" "<=" ">=" "==?" "!=?" "<->"
+ ;; event_trigger
+ "->" "->>"
+ ;; property_expr
+ "|->" "|=>" "#-#" "#=#"
+ ;; distribution weighting
+ ":=" ":/"
+ ) 't
+ )))
(defconst verilog-assignment-operation-re
(concat
-; "\\(^\\s-*[A-Za-z0-9_]+\\(\\[\\([A-Za-z0-9_]+\\)\\]\\)*\\s-*\\)"
-; "\\(^\\s-*[^=<>+-*/%&|^:\\s-]+[^=<>+-*/%&|^\n]*?\\)"
- "\\(^.*?\\)" "\\B" verilog-assignment-operator-re "\\B" ))
+ ;; "\\(^\\s-*[A-Za-z0-9_]+\\(\\[\\([A-Za-z0-9_]+\\)\\]\\)*\\s-*\\)"
+ ;; "\\(^\\s-*[^=<>+-*/%&|^:\\s-]+[^=<>+-*/%&|^\n]*?\\)"
+ "\\(^.*?\\)" "\\B" verilog-assignment-operator-re "\\B" ))
(defconst verilog-label-re (concat verilog-symbol-re "\\s-*:\\s-*"))
(defconst verilog-property-re
(concat "\\(" verilog-label-re "\\)?"
+ ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>"
"\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(assert\\)"))
- ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>"
(defconst verilog-no-indent-begin-re
- "\\<\\(if\\|else\\|while\\|for\\|repeat\\|always\\|always_comb\\|always_ff\\|always_latch\\)\\>")
+ (eval-when-compile
+ (verilog-regexp-words
+ '("always" "always_comb" "always_ff" "always_latch" "initial" "final" ; procedural blocks
+ "if" "else" ; conditional statements
+ "while" "for" "foreach" "repeat" "do" "forever" )))) ; loop statements
(defconst verilog-ends-re
;; Parenthesis indicate type of keyword found
@@ -2291,6 +2387,7 @@ find the errors."
"endinterface"
"endpackage"
"endsequence"
+ "endproperty"
"endspecify"
"endtable"
"endtask"
@@ -2304,8 +2401,8 @@ find the errors."
"package")))
"\\)"))
-;;; NOTE: verilog-leap-to-head expects that verilog-end-block-re and
-;;; verilog-end-block-ordered-re matches exactly the same strings.
+;; NOTE: verilog-leap-to-head expects that verilog-end-block-re and
+;; verilog-end-block-ordered-re matches exactly the same strings.
(defconst verilog-end-block-ordered-re
;; Parenthesis indicate type of keyword found
(concat "\\(\\<endcase\\>\\)\\|" ; 1
@@ -2323,14 +2420,15 @@ find the errors."
"\\(program\\)\\|" ; 13
"\\(sequence\\)\\|" ; 14
"\\(clocking\\)\\|" ; 15
+ "\\(property\\)\\|" ; 16
"\\)\\>\\)"))
(defconst verilog-end-block-re
(eval-when-compile
(verilog-regexp-words
- `("end" ;; closes begin
- "endcase" ;; closes any of case, casex casez or randcase
- "join" "join_any" "join_none" ;; closes fork
+ `("end" ; closes begin
+ "endcase" ; closes any of case, casex casez or randcase
+ "join" "join_any" "join_none" ; closes fork
"endclass"
"endtable"
"endspecify"
@@ -2371,11 +2469,9 @@ find the errors."
"\\(\\<begin\\>\\)\\|" ; 1
"\\(\\<else\\>\\)\\|" ; 2
"\\(\\<end\\>\\s-+\\<else\\>\\)\\|" ; 3
- "\\(\\<always_comb\\>\\(\[ \t\]*@\\)?\\)\\|" ; 4
- "\\(\\<always_ff\\>\\(\[ \t\]*@\\)?\\)\\|" ; 5
- "\\(\\<always_latch\\>\\(\[ \t\]*@\\)?\\)\\|" ; 6
+ "\\(\\<always\\(?:_ff\\)?\\>\\(?:[ \t]*@\\)\\)\\|" ; 4 (matches always or always_ff w/ @...)
+ "\\(\\<always\\(?:_comb\\|_latch\\)?\\>\\)\\|" ; 5 (matches always, always_comb, always_latch w/o @...)
"\\(\\<fork\\>\\)\\|" ; 7
- "\\(\\<always\\>\\(\[ \t\]*@\\)?\\)\\|"
"\\(\\<if\\>\\)\\|"
verilog-property-re "\\|"
"\\(\\(" verilog-label-re "\\)?\\<assert\\>\\)\\|"
@@ -2387,7 +2483,7 @@ find the errors."
"\\(\\<package\\>\\)\\|"
"\\(\\<final\\>\\)\\|"
"\\(@\\)\\|"
- "\\(\\<while\\>\\)\\|"
+ "\\(\\<while\\>\\)\\|\\(\\<do\\>\\)\\|"
"\\(\\<for\\(ever\\|each\\)?\\>\\)\\|"
"\\(\\<repeat\\>\\)\\|\\(\\<wait\\>\\)\\|"
"#"))
@@ -2438,7 +2534,7 @@ find the errors."
;; verilog-forward-sexp and verilog-calc-indent
(defconst verilog-beg-block-re-ordered
( concat "\\(\\<begin\\>\\)" ;1
- "\\|\\(\\<randcase\\>\\|\\(\\<unique\\s-+\\|priority\\s-+\\)?case[xz]?\\>\\)" ; 2,3
+ "\\|\\(\\<randcase\\>\\|\\(\\<unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\>\\)" ; 2,3
"\\|\\(\\(\\<disable\\>\\s-+\\|\\<wait\\>\\s-+\\)?fork\\>\\)" ;4,5
"\\|\\(\\<class\\>\\)" ;6
"\\|\\(\\<table\\>\\)" ;7
@@ -2481,15 +2577,20 @@ find the errors."
"join" "join_any" "join_none"
"end"
"endcase"
- "endconfig"
+ "endchecker"
"endclass"
"endclocking"
+ "endconfig"
"endfunction"
"endgenerate"
+ "endgroup"
"endmodule"
"endprimitive"
"endinterface"
"endpackage"
+ "endprogram"
+ "endproperty"
+ "endsequence"
"endspecify"
"endtable"
"endtask" )
@@ -2536,10 +2637,10 @@ find the errors."
(defconst verilog-declaration-re
(concat "\\(" verilog-declaration-prefix-re "\\s-*\\)?" verilog-declaration-core-re))
(defconst verilog-range-re "\\(\\[[^]]*\\]\\s-*\\)+")
-(defconst verilog-optional-signed-re "\\s-*\\(signed\\)?")
+(defconst verilog-optional-signed-re "\\s-*\\(\\(un\\)?signed\\)?")
(defconst verilog-optional-signed-range-re
(concat
- "\\s-*\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?\\(\\<signed\\>\\s-*\\)?\\(" verilog-range-re "\\)?"))
+ "\\s-*\\(\\<\\(reg\\|wire\\)\\>\\s-*\\)?\\(\\<\\(un\\)?signed\\>\\s-*\\)?\\(" verilog-range-re "\\)?"))
(defconst verilog-macroexp-re "`\\sw+")
(defconst verilog-delay-re "#\\s-*\\(\\([0-9_]+\\('s?[hdxbo][0-9a-fA-F_xz]+\\)?\\)\\|\\(([^()]*)\\)\\|\\(\\sw+\\)\\)")
@@ -2570,6 +2671,9 @@ find the errors."
(eval-when-compile (verilog-regexp-words `("initial" "final" "always" "always_comb" "always_latch" "always_ff"
"function" "task"))))
(defconst verilog-coverpoint-re "\\w+\\s*:\\s*\\(coverpoint\\|cross\\constraint\\)" )
+(defconst verilog-in-constraint-re ; keywords legal in constraint blocks starting a statement/block
+ (eval-when-compile (verilog-regexp-words `("if" "else" "solve" "foreach"))))
+
(defconst verilog-indent-re
(eval-when-compile
(verilog-regexp-words
@@ -2577,7 +2681,7 @@ find the errors."
"{"
"always" "always_latch" "always_ff" "always_comb"
"begin" "end"
-; "unique" "priority"
+ ;; "unique" "priority"
"case" "casex" "casez" "randcase" "endcase"
"class" "endclass"
"clocking" "endclocking"
@@ -2635,7 +2739,7 @@ find the errors."
"`uvm_sequence_utils_begin"
"`uvm_sequencer_utils_begin"
;; UVM End tokens
- "`uvm_component_utils_end" ;; Typo in spec, it's not uvm_component_end
+ "`uvm_component_utils_end" ; Typo in spec, it's not uvm_component_end
"`uvm_field_utils_end"
"`uvm_object_utils_end"
"`uvm_sequence_utils_end"
@@ -2681,12 +2785,18 @@ find the errors."
`(
"endmodule" "endprimitive" "endinterface" "endpackage" "endprogram" "endclass"
))))
+
+(defconst verilog-dpi-import-export-re
+ (eval-when-compile
+ "\\(\\<\\(import\\|export\\)\\>\\s-+\"DPI\\(-C\\)?\"\\s-+\\(\\<\\(context\\|pure\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-*=\\s-*\\)?\\<\\(function\\|task\\)\\>\\)"
+ ))
+
(defconst verilog-disable-fork-re "\\(disable\\|wait\\)\\s-+fork\\>")
-(defconst verilog-extended-case-re "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
+(defconst verilog-extended-case-re "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
(defconst verilog-extended-complete-re
- (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<pure\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)"
+ (concat "\\(\\(\\<extern\\s-+\\|\\<\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?virtual\\s-+\\|\\<protected\\s-+\\)*\\(\\<function\\>\\|\\<task\\>\\)\\)"
"\\|\\(\\(\\<typedef\\>\\s-+\\)*\\(\\<struct\\>\\|\\<union\\>\\|\\<class\\>\\)\\)"
- "\\|\\(\\(\\<import\\>\\s-+\\)?\\(\"DPI-C\"\\s-+\\)?\\(\\<pure\\>\\s-+\\)?\\(function\\>\\|task\\>\\)\\)"
+ "\\|\\(\\(\\<\\(import\\|export\\)\\>\\s-+\\)?\\(\"DPI\\(-C\\)?\"\\s-+\\)?\\(\\<\\(pure\\|context\\)\\>\\s-+\\)?\\([A-Za-z_][A-Za-z0-9_]*\\s-*=\\s-*\\)?\\(function\\>\\|task\\>\\)\\)"
"\\|" verilog-extended-case-re ))
(defconst verilog-basic-complete-re
(eval-when-compile
@@ -2716,58 +2826,101 @@ find the errors."
"String used to mark end of excluded text.")
(defconst verilog-preprocessor-re
(eval-when-compile
- (verilog-regexp-words
- `(
- "`define" "`include" "`ifdef" "`ifndef" "`if" "`endif" "`else"
- ))))
+ (concat
+ ;; single words
+ "\\(?:"
+ (verilog-regexp-words
+ `("`__FILE__"
+ "`__LINE__"
+ "`celldefine"
+ "`else"
+ "`end_keywords"
+ "`endcelldefine"
+ "`endif"
+ "`nounconnected_drive"
+ "`resetall"
+ "`unconnected_drive"
+ "`undefineall"))
+ "\\)\\|\\(?:"
+ ;; two words: i.e. `ifdef DEFINE
+ "\\<\\(`elsif\\|`ifn?def\\|`undef\\|`default_nettype\\|`begin_keywords\\)\\>\\s-"
+ "\\)\\|\\(?:"
+ ;; `line number "filename" level
+ "\\<\\(`line\\)\\>\\s-+[0-9]+\\s-+\"[^\"]+\"\\s-+[012]"
+ "\\)\\|\\(?:"
+ ;;`include "file" or `include <file>
+ "\\<\\(`include\\)\\>\\s-+\\(?:\"[^\"]+\"\\|<[^>]+>\\)"
+ "\\)\\|\\(?:"
+ ;; `pragma <stuff> (no mention in IEEE 1800-2012 that pragma can span multiple lines
+ "\\<\\(`pragma\\)\\>\\s-+.+$"
+ "\\)\\|\\(?:"
+ ;; `timescale time_unit / time_precision
+ "\\<\\(`timescale\\)\\>\\s-+10\\{0,2\\}\\s-*[munpf]?s\\s-*\\/\\s-*10\\{0,2\\}\\s-*[munpf]?s"
+ "\\)\\|\\(?:"
+ ;; `define and `if can span multiple lines if line ends in '\'. NOTE: `if is not IEEE 1800-2012
+ ;; from http://www.emacswiki.org/emacs/MultilineRegexp
+ (concat "\\<\\(`define\\|`if\\)\\>" ; directive
+ "\\s-+" ; separator
+ "\\(?:.*?\\(?:\n.*\\)*?\\)" ; definition: to end of line, then maybe more lines (excludes any trailing \n)
+ "\\(?:\n\\s-*\n\\|\\'\\)") ; blank line or EOF
+ "\\)\\|\\(?:"
+ ;; `<macro>() : i.e. `uvm_info(a,b,c) or any other pre-defined macro
+ ;; Since parameters inside the macro can have parentheses, and
+ ;; the macro can span multiple lines, just look for the opening
+ ;; parentheses and then continue to the end of the first
+ ;; non-escaped EOL
+ (concat "\\<`\\w+\\>\\s-*("
+ "\\(?:.*?\\(?:\n.*\\)*?\\)" ; definition: to end of line, then maybe more lines (excludes any trailing \n)
+ "\\(?:\n\\s-*\n\\|\\'\\)") ; blank line or EOF
+ "\\)"
+ )))
(defconst verilog-keywords
- '( "`case" "`default" "`define" "`else" "`endfor" "`endif"
- "`endprotect" "`endswitch" "`endwhile" "`for" "`format" "`if" "`ifdef"
- "`ifndef" "`include" "`let" "`protect" "`switch" "`timescale"
- "`time_scale" "`undef" "`while"
-
- "after" "alias" "always" "always_comb" "always_ff" "always_latch" "and"
- "assert" "assign" "assume" "automatic" "before" "begin" "bind"
- "bins" "binsof" "bit" "break" "buf" "bufif0" "bufif1" "byte"
- "case" "casex" "casez" "cell" "chandle" "class" "clocking" "cmos"
- "config" "const" "constraint" "context" "continue" "cover"
- "covergroup" "coverpoint" "cross" "deassign" "default" "defparam"
- "design" "disable" "dist" "do" "edge" "else" "end" "endcase"
- "endclass" "endclocking" "endconfig" "endfunction" "endgenerate"
- "endgroup" "endinterface" "endmodule" "endpackage" "endprimitive"
- "endprogram" "endproperty" "endspecify" "endsequence" "endtable"
- "endtask" "enum" "event" "expect" "export" "extends" "extern"
- "final" "first_match" "for" "force" "foreach" "forever" "fork"
- "forkjoin" "function" "generate" "genvar" "highz0" "highz1" "if"
- "iff" "ifnone" "ignore_bins" "illegal_bins" "import" "incdir"
- "include" "initial" "inout" "input" "inside" "instance" "int"
- "integer" "interface" "intersect" "join" "join_any" "join_none"
- "large" "liblist" "library" "local" "localparam" "logic"
- "longint" "macromodule" "mailbox" "matches" "medium" "modport" "module"
- "nand" "negedge" "new" "nmos" "nor" "noshowcancelled" "not"
- "notif0" "notif1" "null" "or" "output" "package" "packed"
- "parameter" "pmos" "posedge" "primitive" "priority" "program"
- "property" "protected" "pull0" "pull1" "pulldown" "pullup"
- "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
- "randcase" "randsequence" "rcmos" "real" "realtime" "ref" "reg"
- "release" "repeat" "return" "rnmos" "rpmos" "rtran" "rtranif0"
- "rtranif1" "scalared" "semaphore" "sequence" "shortint" "shortreal"
- "showcancelled" "signed" "small" "solve" "specify" "specparam"
- "static" "string" "strong0" "strong1" "struct" "super" "supply0"
- "supply1" "table" "tagged" "task" "this" "throughout" "time"
- "timeprecision" "timeunit" "tran" "tranif0" "tranif1" "tri"
- "tri0" "tri1" "triand" "trior" "trireg" "type" "typedef" "union"
- "unique" "unsigned" "use" "uwire" "var" "vectored" "virtual" "void"
- "wait" "wait_order" "wand" "weak0" "weak1" "while" "wildcard"
- "wire" "with" "within" "wor" "xnor" "xor"
- ;; 1800-2009
- "accept_on" "checker" "endchecker" "eventually" "global" "implies"
- "let" "nexttime" "reject_on" "restrict" "s_always" "s_eventually"
- "s_nexttime" "s_until" "s_until_with" "strong" "sync_accept_on"
- "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak"
- )
- "List of Verilog keywords.")
+ (append verilog-compiler-directives
+ '(
+ "after" "alias" "always" "always_comb" "always_ff" "always_latch" "and"
+ "assert" "assign" "assume" "automatic" "before" "begin" "bind"
+ "bins" "binsof" "bit" "break" "buf" "bufif0" "bufif1" "byte"
+ "case" "casex" "casez" "cell" "chandle" "class" "clocking" "cmos"
+ "config" "const" "constraint" "context" "continue" "cover"
+ "covergroup" "coverpoint" "cross" "deassign" "default" "defparam"
+ "design" "disable" "dist" "do" "edge" "else" "end" "endcase"
+ "endclass" "endclocking" "endconfig" "endfunction" "endgenerate"
+ "endgroup" "endinterface" "endmodule" "endpackage" "endprimitive"
+ "endprogram" "endproperty" "endspecify" "endsequence" "endtable"
+ "endtask" "enum" "event" "expect" "export" "extends" "extern"
+ "final" "first_match" "for" "force" "foreach" "forever" "fork"
+ "forkjoin" "function" "generate" "genvar" "highz0" "highz1" "if"
+ "iff" "ifnone" "ignore_bins" "illegal_bins" "import" "incdir"
+ "include" "initial" "inout" "input" "inside" "instance" "int"
+ "integer" "interface" "intersect" "join" "join_any" "join_none"
+ "large" "liblist" "library" "local" "localparam" "logic"
+ "longint" "macromodule" "mailbox" "matches" "medium" "modport" "module"
+ "nand" "negedge" "new" "nmos" "nor" "noshowcancelled" "not"
+ "notif0" "notif1" "null" "or" "output" "package" "packed"
+ "parameter" "pmos" "posedge" "primitive" "priority" "program"
+ "property" "protected" "pull0" "pull1" "pulldown" "pullup"
+ "pulsestyle_onevent" "pulsestyle_ondetect" "pure" "rand" "randc"
+ "randcase" "randsequence" "rcmos" "real" "realtime" "ref" "reg"
+ "release" "repeat" "return" "rnmos" "rpmos" "rtran" "rtranif0"
+ "rtranif1" "scalared" "semaphore" "sequence" "shortint" "shortreal"
+ "showcancelled" "signed" "small" "solve" "specify" "specparam"
+ "static" "string" "strong0" "strong1" "struct" "super" "supply0"
+ "supply1" "table" "tagged" "task" "this" "throughout" "time"
+ "timeprecision" "timeunit" "tran" "tranif0" "tranif1" "tri"
+ "tri0" "tri1" "triand" "trior" "trireg" "type" "typedef" "union"
+ "unique" "unsigned" "use" "uwire" "var" "vectored" "virtual" "void"
+ "wait" "wait_order" "wand" "weak0" "weak1" "while" "wildcard"
+ "wire" "with" "within" "wor" "xnor" "xor"
+ ;; 1800-2009
+ "accept_on" "checker" "endchecker" "eventually" "global" "implies"
+ "let" "nexttime" "reject_on" "restrict" "s_always" "s_eventually"
+ "s_nexttime" "s_until" "s_until_with" "strong" "sync_accept_on"
+ "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak"
+ ;; 1800-2012
+ "implements" "interconnect" "nettype" "soft"
+ ))
+ "List of Verilog keywords.")
(defconst verilog-comment-start-regexp "//\\|/\\*"
"Dual comment value for `comment-start-regexp'.")
@@ -2786,7 +2939,7 @@ find the errors."
(modify-syntax-entry ?| "." table)
;; FIXME: This goes against Emacs conventions. Use "_" syntax instead and
;; then use regexps with things like "\\_<...\\_>".
- (modify-syntax-entry ?` "w" table)
+ (modify-syntax-entry ?` "w" table) ; ` is part of definition symbols in Verilog
(modify-syntax-entry ?_ "w" table)
(modify-syntax-entry ?\' "." table)
@@ -2870,10 +3023,10 @@ See also `verilog-font-lock-extra-types'.")
(defface verilog-font-lock-grouping-keywords-face
'((((class color)
(background light))
- (:foreground "red4" :bold t ))
+ (:foreground "Purple" :bold t ))
(((class color)
(background dark))
- (:foreground "red4" :bold t ))
+ (:foreground "orange1" :bold t ))
(t (:italic t)))
"Font lock mode face used to highlight verilog grouping keywords."
:group 'font-lock-highlighting-faces)
@@ -2884,7 +3037,7 @@ See also `verilog-font-lock-extra-types'.")
'(
"and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam"
"event" "genvar" "inout" "input" "integer" "localparam"
- "logic" "mailbox" "nand" "nmos" "not" "notif0" "notif1" "or"
+ "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" "notif1" "or"
"output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup"
"rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran"
"rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply"
@@ -2932,6 +3085,11 @@ See also `verilog-font-lock-extra-types'.")
"sync_accept_on" "sync_reject_on" "unique0" "until"
"until_with" "untyped" "weak" ) nil )))
+ (verilog-1800-2012-keywords
+ (eval-when-compile
+ (verilog-regexp-opt
+ '("implements" "interconnect" "nettype" "soft" ) nil )))
+
(verilog-ams-keywords
(eval-when-compile
(verilog-regexp-opt
@@ -2972,17 +3130,17 @@ See also `verilog-font-lock-extra-types'.")
(list
;; Fontify all builtin keywords
(concat "\\<\\(" verilog-font-keywords "\\|"
- ;; And user/system tasks and functions
- "\\$[a-zA-Z][a-zA-Z0-9_\\$]*"
- "\\)\\>")
+ ;; And user/system tasks and functions
+ "\\$[a-zA-Z][a-zA-Z0-9_\\$]*"
+ "\\)\\>")
;; Fontify all types
(if verilog-highlight-grouping-keywords
(cons (concat "\\<\\(" verilog-font-grouping-keywords "\\)\\>")
- 'verilog-font-lock-ams-face)
+ 'verilog-font-lock-grouping-keywords-face)
(cons (concat "\\<\\(" verilog-font-grouping-keywords "\\)\\>")
'font-lock-type-face))
(cons (concat "\\<\\(" verilog-type-font-keywords "\\)\\>")
- 'font-lock-type-face)
+ 'font-lock-type-face)
;; Fontify IEEE-1800-2005 keywords appropriately
(if verilog-highlight-p1800-keywords
(cons (concat "\\<\\(" verilog-1800-2005-keywords "\\)\\>")
@@ -2995,6 +3153,12 @@ See also `verilog-font-lock-extra-types'.")
'verilog-font-lock-p1800-face)
(cons (concat "\\<\\(" verilog-1800-2009-keywords "\\)\\>")
'font-lock-type-face))
+ ;; Fontify IEEE-1800-2012 keywords appropriately
+ (if verilog-highlight-p1800-keywords
+ (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>")
+ 'verilog-font-lock-p1800-face)
+ (cons (concat "\\<\\(" verilog-1800-2012-keywords "\\)\\>")
+ 'font-lock-type-face))
;; Fontify Verilog-AMS keywords
(cons (concat "\\<\\(" verilog-ams-keywords "\\)\\>")
'verilog-font-lock-ams-face)))
@@ -3010,8 +3174,8 @@ See also `verilog-font-lock-extra-types'.")
;; Fontify function definitions
(list
(concat "\\<function\\>\\s-+\\(integer\\|real\\(time\\)?\\|time\\)\\s-+\\(\\sw+\\)" )
- '(1 font-lock-keyword-face)
- '(3 font-lock-constant-face prepend))
+ '(1 font-lock-keyword-face)
+ '(3 font-lock-constant-face prepend))
'("\\<function\\>\\s-+\\(\\[[^]]+\\]\\)\\s-+\\(\\sw+\\)"
(1 font-lock-keyword-face)
(2 font-lock-constant-face append))
@@ -3027,11 +3191,14 @@ See also `verilog-font-lock-extra-types'.")
'("\\(\\\\\\S-*\\s-\\)" 0 font-lock-function-name-face)
;; Fontify macro definitions/ uses
'("`\\s-*[A-Za-z][A-Za-z0-9_]*" 0 (if (boundp 'font-lock-preprocessor-face)
- 'font-lock-preprocessor-face
- 'font-lock-type-face))
+ 'font-lock-preprocessor-face
+ 'font-lock-type-face))
;; Fontify delays/numbers
- '("\\(@\\)\\|\\(#\\s-*\\(\\(\[0-9_.\]+\\('s?[hdxbo][0-9a-fA-F_xz]*\\)?\\)\\|\\(([^()]+)\\|\\sw+\\)\\)\\)"
+ '("\\(@\\)\\|\\([ \t\n\f\r]#\\s-*\\(\\([0-9_.]+\\('s?[hdxbo][0-9a-fA-F_xz]*\\)?\\)\\|\\(([^()]+)\\|\\sw+\\)\\)\\)"
0 font-lock-type-face append)
+ ;; Fontify property/sequence cycle delays - these start with '##'
+ '("\\(##\\(\\sw+\\|\\[[^]]+\\]\\)\\)"
+ 0 font-lock-type-face append)
;; Fontify instantiation names
'("\\([A-Za-z][A-Za-z0-9_]*\\)\\s-*(" 1 font-lock-function-name-face)
)))
@@ -3104,16 +3271,16 @@ to full text form for parsing. Additional actions may be specified with
(font-lock-mode 0)
t)))
(unwind-protect
- (progn ,@body)
- ;; Unwind forms
- (when fontlocked (font-lock-mode t))
- (when hooked (verilog-run-hooks 'verilog-after-save-font-hook)))))
+ (progn ,@body)
+ ;; Unwind forms
+ (when fontlocked (font-lock-mode t))
+ (when hooked (verilog-run-hooks 'verilog-after-save-font-hook)))))
;;
;; Comment detection and caching
(defvar verilog-scan-cache-preserving nil
- "If set, the specified buffer's comment properties are static.
+ "If true, the specified buffer's comment properties are static.
Buffer changes will be ignored. See `verilog-inside-comment-or-string-p'
and `verilog-scan'.")
@@ -3126,7 +3293,7 @@ and `verilog-scan'.")
(setq verilog-scan-cache-tick nil))
(defun verilog-scan-cache-ok-p ()
- "Return t iff the scan cache is up to date."
+ "Return t if the scan cache is up to date."
(or (and verilog-scan-cache-preserving
(eq verilog-scan-cache-preserving (current-buffer))
verilog-scan-cache-tick)
@@ -3139,7 +3306,7 @@ This requires that insertions must use `verilog-insert'."
;; Note this must work properly if there's multiple layers of calls
;; to verilog-save-scan-cache even with differing ticks.
`(progn
- (unless (verilog-scan-cache-ok-p) ;; Must be before let
+ (unless (verilog-scan-cache-ok-p) ; Must be before let
(setq verilog-scan-cache-tick nil))
(let* ((verilog-scan-cache-preserving (current-buffer)))
(progn ,@body))))
@@ -3177,7 +3344,7 @@ This creates v-cmts properties where comments are in force."
(put-text-property (1+ pt) (point) 'v-cmts t))
((looking-at "\"")
(setq pt (point))
- (or (re-search-forward "[^\\]\"" end t) ;; don't forward-char first, since we look for a non backslash first
+ (or (re-search-forward "[^\\]\"" end t) ; don't forward-char first, since we look for a non backslash first
;; No error - let later code indicate it so we can
(goto-char end))
(put-text-property (1+ pt) (point) 'v-cmts t))
@@ -3195,14 +3362,14 @@ either is ok to parse as a non-comment, or `verilog-insert' was used."
(unless (verilog-scan-cache-ok-p)
(save-excursion
(verilog-save-buffer-state
- (when verilog-debug
- (message "Scanning %s cache=%s cachetick=%S tick=%S" (current-buffer)
- verilog-scan-cache-preserving verilog-scan-cache-tick
- (buffer-chars-modified-tick)))
- (remove-text-properties (point-min) (point-max) '(v-cmts nil))
- (verilog-scan-region (point-min) (point-max))
- (setq verilog-scan-cache-tick (buffer-chars-modified-tick))
- (when verilog-debug (message "Scanning... done"))))))
+ (when verilog-debug
+ (message "Scanning %s cache=%s cachetick=%S tick=%S" (current-buffer)
+ verilog-scan-cache-preserving verilog-scan-cache-tick
+ (buffer-chars-modified-tick)))
+ (remove-text-properties (point-min) (point-max) '(v-cmts nil))
+ (verilog-scan-region (point-min) (point-max))
+ (setq verilog-scan-cache-tick (buffer-chars-modified-tick))
+ (when verilog-debug (message "Scanning... done"))))))
(defun verilog-scan-debug ()
"For debugging, show with display face results of `verilog-scan'."
@@ -3274,13 +3441,13 @@ Use filename, if current buffer being edited shorten to just buffer name."
;; before that see if we are in a comment
(verilog-forward-sexp))
-;;;used by hs-minor-mode
(defun verilog-forward-sexp-function (arg)
+ "Move forward ARG sexps."
+ ;; Used by hs-minor-mode
(if (< arg 0)
(verilog-backward-sexp)
(verilog-forward-sexp)))
-
(defun verilog-backward-sexp ()
(let ((reg)
(elsec 1)
@@ -3299,9 +3466,9 @@ Use filename, if current buffer being edited shorten to just buffer name."
(verilog-re-search-backward reg nil 'move))
(cond
((match-end 1) ; matched verilog-end-block-re
- ; try to leap back to matching outward block by striding across
- ; indent level changing tokens then immediately
- ; previous line governs indentation.
+ ;; try to leap back to matching outward block by striding across
+ ;; indent level changing tokens then immediately
+ ;; previous line governs indentation.
(verilog-leap-to-head))
((match-end 2) ; else, we're in deep
(setq elsec (1+ elsec)))
@@ -3350,8 +3517,8 @@ Use filename, if current buffer being edited shorten to just buffer name."
(setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
((match-end 2)
;; Search forward for matching endcase
- (setq reg "\\(\\<randcase\\>\\|\\(\\<unique\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" )
- (setq md 3) ;; ender is third item in regexp
+ (setq reg "\\(\\<randcase\\>\\|\\(\\<unique0?\\>\\s-+\\|\\<priority\\>\\s-+\\)?\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" )
+ (setq md 3) ; ender is third item in regexp
)
((match-end 4)
;; might be "disable fork" or "wait fork"
@@ -3361,15 +3528,15 @@ Use filename, if current buffer being edited shorten to just buffer name."
(looking-at verilog-disable-fork-re)
(and (looking-at "fork")
(progn
- (setq here (point)) ;; sometimes a fork is just a fork
+ (setq here (point)) ; sometimes a fork is just a fork
(forward-word -1)
(looking-at verilog-disable-fork-re))))
- (progn ;; it is a disable fork; ignore it
+ (progn ; it is a disable fork; ignore it
(goto-char (match-end 0))
(forward-word 1)
(setq reg nil))
- (progn ;; it is a nice simple fork
- (goto-char here) ;; return from looking for "disable fork"
+ (progn ; it is a nice simple fork
+ (goto-char here) ; return from looking for "disable fork"
;; Search forward for matching join
(setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )))))
((match-end 6)
@@ -3380,41 +3547,41 @@ Use filename, if current buffer being edited shorten to just buffer name."
;; Search forward for matching endtable
(setq reg "\\<endtable\\>" )
(setq nest 'no))
- ((match-end 8)
- ;; Search forward for matching endspecify
- (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
- ((match-end 9)
- ;; Search forward for matching endfunction
- (setq reg "\\<endfunction\\>" )
- (setq nest 'no))
- ((match-end 10)
- ;; Search forward for matching endfunction
- (setq reg "\\<endfunction\\>" )
- (setq nest 'no))
- ((match-end 14)
- ;; Search forward for matching endtask
- (setq reg "\\<endtask\\>" )
- (setq nest 'no))
- ((match-end 15)
- ;; Search forward for matching endtask
- (setq reg "\\<endtask\\>" )
- (setq nest 'no))
- ((match-end 19)
- ;; Search forward for matching endgenerate
- (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
- ((match-end 20)
- ;; Search forward for matching endgroup
- (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))
- ((match-end 21)
- ;; Search forward for matching endproperty
- (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" ))
- ((match-end 25)
- ;; Search forward for matching endsequence
- (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )
- (setq md 3)) ; 3 to get to endsequence in the reg above
- ((match-end 27)
- ;; Search forward for matching endclocking
- (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )))
+ ((match-end 8)
+ ;; Search forward for matching endspecify
+ (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
+ ((match-end 9)
+ ;; Search forward for matching endfunction
+ (setq reg "\\<endfunction\\>" )
+ (setq nest 'no))
+ ((match-end 10)
+ ;; Search forward for matching endfunction
+ (setq reg "\\<endfunction\\>" )
+ (setq nest 'no))
+ ((match-end 14)
+ ;; Search forward for matching endtask
+ (setq reg "\\<endtask\\>" )
+ (setq nest 'no))
+ ((match-end 15)
+ ;; Search forward for matching endtask
+ (setq reg "\\<endtask\\>" )
+ (setq nest 'no))
+ ((match-end 19)
+ ;; Search forward for matching endgenerate
+ (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
+ ((match-end 20)
+ ;; Search forward for matching endgroup
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" ))
+ ((match-end 21)
+ ;; Search forward for matching endproperty
+ (setq reg "\\(\\<property\\>\\)\\|\\(\\<endproperty\\>\\)" ))
+ ((match-end 25)
+ ;; Search forward for matching endsequence
+ (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<endsequence\\>\\)" )
+ (setq md 3)) ; 3 to get to endsequence in the reg above
+ ((match-end 27)
+ ;; Search forward for matching endclocking
+ (setq reg "\\(\\<clocking\\>\\)\\|\\(\\<endclocking\\>\\)" )))
(if (and reg
(forward-word 1))
(catch 'skip
@@ -3437,9 +3604,9 @@ Use filename, if current buffer being edited shorten to just buffer name."
(progn
(forward-word -1)
(looking-at verilog-disable-fork-re))))
- (progn ;; it is a disable fork; another false alarm
+ (progn ; it is a disable fork; another false alarm
(goto-char (match-end 0)))
- (progn ;; it is a simple fork (or has nothing to do with fork)
+ (progn ; it is a simple fork (or has nothing to do with fork)
(goto-char here)
(setq depth (1+ depth))))))))))
(if (verilog-re-search-forward reg nil 'move)
@@ -3517,7 +3684,7 @@ Variables controlling indentation/edit style:
Set to 0 to get such code to lined up underneath the task or
function keyword.
`verilog-indent-level-directive' (default 1)
- Indentation of `ifdef/`endif blocks.
+ Indentation of \\=`ifdef/\\=`endif blocks.
`verilog-cexp-indent' (default 1)
Indentation of Verilog statements broken across lines i.e.:
if (a)
@@ -3590,7 +3757,8 @@ Some other functions are:
\\[verilog-sk-fork] Insert a fork begin .. end .. join block.
\\[verilog-sk-module] Insert a module .. (/*AUTOARG*/);.. endmodule block.
\\[verilog-sk-ovm-class] Insert an OVM Class block.
- \\[verilog-sk-uvm-class] Insert an UVM Class block.
+ \\[verilog-sk-uvm-object] Insert an UVM Object block.
+ \\[verilog-sk-uvm-component] Insert an UVM Component block.
\\[verilog-sk-primitive] Insert a primitive .. (.. );.. endprimitive block.
\\[verilog-sk-repeat] Insert a repeat (..) begin .. end block.
\\[verilog-sk-specify] Insert a specify .. endspecify block.
@@ -3623,7 +3791,7 @@ Key bindings specific to `verilog-mode-map' are:
(set-syntax-table verilog-mode-syntax-table)
(set (make-local-variable 'indent-line-function)
#'verilog-indent-line-relative)
- (setq comment-indent-function 'verilog-comment-indent)
+ (set (make-local-variable 'comment-indent-function) 'verilog-comment-indent)
(set (make-local-variable 'parse-sexp-ignore-comments) nil)
(set (make-local-variable 'comment-start) "// ")
(set (make-local-variable 'comment-end) "")
@@ -3633,7 +3801,7 @@ Key bindings specific to `verilog-mode-map' are:
(setq verilog-which-tool 1)
(setq verilog-tool 'verilog-linter)
(verilog-set-compile-command)
- (when (boundp 'hack-local-variables-hook) ;; Also modify any file-local-variables
+ (when (boundp 'hack-local-variables-hook) ; Also modify any file-local-variables
(add-hook 'hack-local-variables-hook 'verilog-modify-compile-command t))
;; Setting up menus
@@ -3659,7 +3827,7 @@ Key bindings specific to `verilog-mode-map' are:
;;------------------------------------------------------------
;; now hook in 'verilog-highlight-include-files (eldo-mode.el&spice-mode.el)
;; all buffer local:
- (unless noninteractive ;; Else can't see the result, and change hooks are slow
+ (unless noninteractive ; Else can't see the result, and change hooks are slow
(when (featurep 'xemacs)
(make-local-hook 'font-lock-mode-hook)
(make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in Emacs
@@ -3687,10 +3855,9 @@ Key bindings specific to `verilog-mode-map' are:
;; verilog-mode-hook call added by define-derived-mode
)
-
-;;
-;; Electric functions
+;;; Electric functions:
;;
+
(defun electric-verilog-terminate-line (&optional arg)
"Terminate line and indent next line.
With optional ARG, remove existing end of line comments."
@@ -3712,36 +3879,36 @@ With optional ARG, remove existing end of line comments."
(newline)
(verilog-more-comment))
((eolp)
- ;; First, check if current line should be indented
- (if (save-excursion
- (delete-horizontal-space)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (if (looking-at verilog-auto-end-comment-lines-re)
- (let ((indent-str (verilog-indent-line)))
- ;; Maybe we should set some endcomments
- (if verilog-auto-endcomments
- (verilog-set-auto-endcomments indent-str arg))
- (end-of-line)
- (delete-horizontal-space)
- (if arg
- ()
- (newline))
- nil)
- (progn
- (end-of-line)
- (delete-horizontal-space)
- 't)))
- ;; see if we should line up assignments
- (progn
- (if (or (eq 'all verilog-auto-lineup)
- (eq 'assignments verilog-auto-lineup))
- (verilog-pretty-expr t "\\(<\\|:\\)?=" ))
- (newline))
- (forward-line 1))
- ;; Indent next line
- (if verilog-auto-indent-on-newline
- (verilog-indent-line)))
+ ;; First, check if current line should be indented
+ (if (save-excursion
+ (delete-horizontal-space)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (if (looking-at verilog-auto-end-comment-lines-re)
+ (let ((indent-str (verilog-indent-line)))
+ ;; Maybe we should set some endcomments
+ (if verilog-auto-endcomments
+ (verilog-set-auto-endcomments indent-str arg))
+ (end-of-line)
+ (delete-horizontal-space)
+ (if arg
+ ()
+ (newline))
+ nil)
+ (progn
+ (end-of-line)
+ (delete-horizontal-space)
+ 't)))
+ ;; see if we should line up assignments
+ (progn
+ (if (or (eq 'all verilog-auto-lineup)
+ (eq 'assignments verilog-auto-lineup))
+ (verilog-pretty-expr t "\\(<\\|:\\)?=" ))
+ (newline))
+ (forward-line 1))
+ ;; Indent next line
+ (if verilog-auto-indent-on-newline
+ (verilog-indent-line)))
(t
(newline)))))
@@ -3769,7 +3936,7 @@ With optional ARG, remove existing end of line comments."
(defun electric-verilog-semi-with-comment ()
"Insert `;' character, reindent the line and indent for comment."
(interactive)
- (insert "\;")
+ (insert ";")
(save-excursion
(beginning-of-line)
(verilog-indent-line))
@@ -3790,8 +3957,8 @@ With optional ARG, remove existing end of line comments."
(goto-char p)
(verilog-backward-case-item lim)
(verilog-indent-line)))
-;; (let ((verilog-tab-always-indent nil))
-;; (verilog-indent-line))
+ ;; (let ((verilog-tab-always-indent nil))
+ ;; (verilog-indent-line))
))
;;(defun electric-verilog-equal ()
@@ -3841,7 +4008,7 @@ With optional ARG, remove existing end of line comments."
(t
(indent-for-comment)
(when (and (eolp) (= oldpnt (point)))
- ; kill existing comment
+ ;; kill existing comment
(beginning-of-line)
(re-search-forward comment-start-skip oldpnt 'move)
(goto-char (match-beginning 0))
@@ -3850,9 +4017,7 @@ With optional ARG, remove existing end of line comments."
(t (progn (insert "\t")))))
-
-;;
-;; Interactive functions
+;;; Interactive functions:
;;
(defun verilog-indent-buffer ()
@@ -3907,7 +4072,7 @@ if it reaches the end of the buffer."
The upper left corner is defined by point. Indices begin with 0
and extend to the MAX - 1. If no prefix arg is given, the user
is prompted for a value. The indices are surrounded by square
-brackets \[]. For example, the following code with the point
+brackets []. For example, the following code with the point
located after the first 'a' gives:
a = b a[ 0] = b
@@ -3958,7 +4123,7 @@ This puts the mark at the end, and point at the beginning."
(mark-defun)))
(defun verilog-comment-region (start end)
- ; checkdoc-params: (start end)
+ ;; checkdoc-params: (start end)
"Put the region into a Verilog comment.
The comments that are in this area are \"deformed\":
`*)' becomes `!(*' and `}' becomes `!{'.
@@ -4047,14 +4212,7 @@ Uses `verilog-scan' cache."
(interactive)
(verilog-re-search-forward verilog-end-defun-re nil 'move))
-(defun verilog-get-beg-of-defun (&optional warn)
- (save-excursion
- (cond ((verilog-re-search-forward-quick verilog-defun-re nil t)
- (point))
- (t
- (error "%s: Can't find module beginning" (verilog-point-text))
- (point-max)))))
-(defun verilog-get-end-of-defun (&optional warn)
+(defun verilog-get-end-of-defun ()
(save-excursion
(cond ((verilog-re-search-forward-quick verilog-end-defun-re nil t)
(point))
@@ -4062,11 +4220,11 @@ Uses `verilog-scan' cache."
(error "%s: Can't find endmodule" (verilog-point-text))
(point-max)))))
-(defun verilog-label-be (&optional arg)
- "Label matching begin ... end, fork ... join and case ... endcase statements.
-With ARG, first kill any existing labels."
+(defun verilog-label-be ()
+ "Label matching begin ... end, fork ... join and case ... endcase statements."
(interactive)
(let ((cnt 0)
+ (case-fold-search nil)
(oldpos (point))
(b (progn
(verilog-beg-of-defun)
@@ -4076,13 +4234,11 @@ With ARG, first kill any existing labels."
(point-marker))))
(goto-char (marker-position b))
(if (> (- e b) 200)
- (message "Relabeling module..."))
+ (message "Relabeling module..."))
(while (and
(> (marker-position e) (point))
(verilog-re-search-forward
- (concat
- "\\<end\\(\\(function\\)\\|\\(task\\)\\|\\(module\\)\\|\\(primitive\\)\\|\\(interface\\)\\|\\(package\\)\\|\\(case\\)\\)?\\>"
- "\\|\\(`endif\\)\\|\\(`else\\)")
+ verilog-auto-end-comment-lines-re
nil 'move))
(goto-char (match-beginning 0))
(let ((indent-str (verilog-indent-line)))
@@ -4096,7 +4252,7 @@ With ARG, first kill any existing labels."
(if (or
(> (- e b) 200)
(> cnt 20))
- (message "%d lines auto commented" cnt))))
+ (message "%d lines auto commented" cnt))))
(defun verilog-beg-of-statement ()
"Move backward to beginning of statement."
@@ -4111,45 +4267,50 @@ With ARG, first kill any existing labels."
;; or the token before us unambiguously ends a statement,
;; then move back a token and test again.
(not (or
- ;; stop if beginning of buffer
- (bolp)
- ;; stop if we find a ;
+ ;; stop if beginning of buffer
+ (bobp)
+ ;; stop if looking at a pre-processor directive
+ (looking-at "`\\w+")
+ ;; stop if we find a ;
(= (preceding-char) ?\;)
- ;; stop if we see a named coverpoint
+ ;; stop if we see a named coverpoint
(looking-at "\\w+\\W*:\\W*\\(coverpoint\\|cross\\|constraint\\)")
- ;; keep going if we are in the middle of a word
+ ;; keep going if we are in the middle of a word
(not (or (looking-at "\\<") (forward-word -1)))
- ;; stop if we see an assertion (perhaps labeled)
+ ;; stop if we see an assertion (perhaps labeled)
(and
- (looking-at "\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)")
+ (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)")
(progn
- (setq h (point))
- (save-excursion
- (verilog-backward-token)
- (if (looking-at verilog-label-re)
- (setq h (point))))
- (goto-char h)))
- ;; stop if we see an extended complete reg, perhaps a complete one
+ (setq h (point))
+ (save-excursion
+ (verilog-backward-token)
+ (if (and (looking-at verilog-label-re)
+ (not (looking-at verilog-end-block-re)))
+ (setq h (point))))
+ (goto-char h)))
+ ;; stop if we see an extended complete reg, perhaps a complete one
(and
- (looking-at verilog-complete-reg)
- (let* ((p (point)))
- (while (and (looking-at verilog-extended-complete-re)
- (progn (setq p (point))
- (verilog-backward-token)
- (/= p (point)))))
- (goto-char p)))
- ;; stop if we see a complete reg (previous found extended ones)
+ (looking-at verilog-complete-reg)
+ (let* ((p (point)))
+ (while (and (looking-at verilog-extended-complete-re)
+ (progn (setq p (point))
+ (verilog-backward-token)
+ (/= p (point)))))
+ (goto-char p)))
+ ;; stop if we see a complete reg (previous found extended ones)
(looking-at verilog-basic-complete-re)
- ;; stop if previous token is an ender
+ ;; stop if previous token is an ender
(save-excursion
- (verilog-backward-token)
- (or
- (looking-at verilog-end-block-re)
- (looking-at verilog-preprocessor-re))))) ;; end of test
- (verilog-backward-syntactic-ws)
- (verilog-backward-token))
+ (verilog-backward-token)
+ (looking-at verilog-end-block-re))))
+ (verilog-backward-syntactic-ws)
+ (verilog-backward-token))
;; Now point is where the previous line ended.
- (verilog-forward-syntactic-ws)))
+ (verilog-forward-syntactic-ws)
+ ;; Skip forward over any preprocessor directives, as they have wacky indentation
+ (if (looking-at verilog-preprocessor-re)
+ (progn (goto-char (match-end 0))
+ (verilog-forward-syntactic-ws)))))
(defun verilog-beg-of-statement-1 ()
"Move backward to beginning of statement."
@@ -4163,24 +4324,23 @@ With ARG, first kill any existing labels."
(verilog-backward-syntactic-ws)
(if (or (bolp)
(= (preceding-char) ?\;)
- (save-excursion
+ (progn
(verilog-backward-token)
(looking-at verilog-ends-re)))
(progn
(goto-char pt)
- (throw 'done t))
- (verilog-backward-token))))
+ (throw 'done t)))))
(verilog-forward-syntactic-ws)))
-;
-; (while (and
-; (not (looking-at verilog-complete-reg))
-; (not (bolp))
-; (not (= (preceding-char) ?\;)))
-; (verilog-backward-token)
-; (verilog-backward-syntactic-ws)
-; (setq pt (point)))
-; (goto-char pt)
-; ;(verilog-forward-syntactic-ws)
+;;
+;; (while (and
+;; (not (looking-at verilog-complete-reg))
+;; (not (bolp))
+;; (not (= (preceding-char) ?\;)))
+;; (verilog-backward-token)
+;; (verilog-backward-syntactic-ws)
+;; (setq pt (point)))
+;; (goto-char pt)
+;; ;(verilog-forward-syntactic-ws)
(defun verilog-end-of-statement ()
"Move forward to end of current statement."
@@ -4197,32 +4357,32 @@ With ARG, first kill any existing labels."
((equal (char-after) ?\})
(forward-char))
- ;; Skip to end of statement
+ ;; Skip to end of statement
((condition-case nil
- (setq pos
- (catch 'found
- (while t
- (forward-sexp 1)
- (verilog-skip-forward-comment-or-string)
- (if (eolp)
- (forward-line 1))
- (cond ((looking-at "[ \t]*;")
- (skip-chars-forward "^;")
- (forward-char 1)
- (throw 'found (point)))
- ((save-excursion
- (forward-sexp -1)
- (looking-at verilog-beg-block-re))
- (goto-char (match-beginning 0))
- (throw 'found nil))
- ((looking-at "[ \t]*)")
- (throw 'found (point)))
- ((eobp)
- (throw 'found (point)))
- )))
-
- )
- (error nil))
+ (setq pos
+ (catch 'found
+ (while t
+ (forward-sexp 1)
+ (verilog-skip-forward-comment-or-string)
+ (if (eolp)
+ (forward-line 1))
+ (cond ((looking-at "[ \t]*;")
+ (skip-chars-forward "^;")
+ (forward-char 1)
+ (throw 'found (point)))
+ ((save-excursion
+ (forward-sexp -1)
+ (looking-at verilog-beg-block-re))
+ (goto-char (match-beginning 0))
+ (throw 'found nil))
+ ((looking-at "[ \t]*)")
+ (throw 'found (point)))
+ ((eobp)
+ (throw 'found (point)))
+ )))
+
+ )
+ (error nil))
(if (not pos)
;; Skip a whole block
(catch 'found
@@ -4259,7 +4419,7 @@ More specifically, point @ in the line foo : @ begin"
(setq nest (1+ nest)))
((match-end 2)
(if (= nest 1)
- (throw 'found 1))
+ (throw 'found 1))
(setq nest (1- nest)))
(t
(throw 'found (= nest 0)))))))
@@ -4316,6 +4476,13 @@ More specifically, after a generate and before an endgenerate."
(setq nest (1+ nest)))))))
(= nest 0) )) ; return nest
+(defun verilog-in-deferred-immediate-final-p ()
+ "Return true if inside an `assert/assume/cover final' statement."
+ (interactive)
+ (and (looking-at "final")
+ (verilog-looking-back "\\<\\(?:assert\\|assume\\|cover\\)\\>\\s-+" nil))
+ )
+
(defun verilog-backward-case-item (lim)
"Skip backward to nearest enclosing case item.
Limit search to point LIM."
@@ -4337,14 +4504,14 @@ Limit search to point LIM."
(verilog-re-search-backward "\\(\\[\\)\\|\\(\\]\\)\\|\\(:\\)"
lim1 'move))
(cond
- ((match-end 1) ;; [
+ ((match-end 1) ; [
(setq colon (1+ colon))
(if (>= colon 0)
(error "%s: unbalanced [" (verilog-point-text))))
- ((match-end 2) ;; ]
+ ((match-end 2) ; ]
(setq colon (1- colon)))
- ((match-end 3) ;; :
+ ((match-end 3) ; :
(setq colon (1+ colon)))))
;; Skip back to beginning of case item
(skip-chars-backward "\t ")
@@ -4379,9 +4546,7 @@ Limit search to point LIM."
str)
'nil)))
-
-;;
-;; Other functions
+;;; Other functions:
;;
(defun verilog-kill-existing-comment ()
@@ -4404,6 +4569,7 @@ Limit search to point LIM."
"\\(`ifdef\\>\\)\\|"
"\\(`ifndef\\>\\)\\|"
"\\(`elsif\\>\\)"))
+
(defun verilog-set-auto-endcomments (indent-str kill-existing-comment)
"Add ending comment with given INDENT-STR.
With KILL-EXISTING-COMMENT, remove what was there before.
@@ -4476,307 +4642,312 @@ primitive or interface named NAME."
(search-backward "//" (point-at-bol) t)))))
(let ((type (car indent-str)))
(unless (eq type 'declaration)
- (unless (looking-at (concat "\\(" verilog-end-block-ordered-re "\\)[ \t]*:")) ;; ignore named ends
+ (unless (looking-at (concat "\\(" verilog-end-block-ordered-re "\\)[ \t]*:")) ; ignore named ends
(if (looking-at verilog-end-block-ordered-re)
- (cond
- (;- This is a case block; search back for the start of this case
- (match-end 1) ;; of verilog-end-block-ordered-re
-
- (let ((err 't)
- (str "UNMATCHED!!"))
- (save-excursion
- (verilog-leap-to-head)
- (cond
- ((looking-at "\\<randcase\\>")
- (setq str "randcase")
- (setq err nil))
- ((looking-at "\\(\\(unique\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
- (goto-char (match-end 0))
- (setq str (concat (match-string 0) " " (verilog-get-expr)))
- (setq err nil))
- ))
- (end-of-line)
- (if kill-existing-comment
- (verilog-kill-existing-comment))
- (delete-horizontal-space)
- (insert (concat " // " str ))
- (if err (ding 't))))
-
- (;- This is a begin..end block
- (match-end 2) ;; of verilog-end-block-ordered-re
- (let ((str " // UNMATCHED !!")
- (err 't)
- (here (point))
- there
- cntx)
- (save-excursion
- (verilog-leap-to-head)
- (setq there (point))
- (if (not (match-end 0))
- (progn
- (goto-char here)
- (end-of-line)
- (if kill-existing-comment
- (verilog-kill-existing-comment))
- (delete-horizontal-space)
- (insert str)
- (ding 't))
- (let ((lim
- (save-excursion (verilog-beg-of-defun) (point)))
- (here (point)))
- (cond
- (;-- handle named block differently
- (looking-at verilog-named-block-re)
- (search-forward ":")
- (setq there (point))
- (setq str (verilog-get-expr))
- (setq err nil)
- (setq str (concat " // block: " str )))
-
- ((verilog-in-case-region-p) ;-- handle case item differently
- (goto-char here)
- (setq str (verilog-backward-case-item lim))
- (setq there (point))
- (setq err nil)
- (setq str (concat " // case: " str )))
-
- (;- try to find "reason" for this begin
- (cond
- (;
- (eq here (progn
- ;; (verilog-backward-token)
- (verilog-beg-of-statement)
- (point)))
- (setq err nil)
- (setq str ""))
- ((looking-at verilog-endcomment-reason-re)
- (setq there (match-end 0))
- (setq cntx (concat (match-string 0) " "))
- (cond
- (;- begin
- (match-end 1)
- (setq err nil)
- (save-excursion
- (if (and (verilog-continued-line)
- (looking-at "\\<repeat\\>\\|\\<wait\\>\\|\\<always\\>"))
- (progn
- (goto-char (match-end 0))
- (setq there (point))
- (setq str
- (concat " // " (match-string 0) " " (verilog-get-expr))))
- (setq str ""))))
-
- (;- else
- (match-end 2)
- (let ((nest 0)
- ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
- (catch 'skip
- (while (verilog-re-search-backward reg nil 'move)
- (cond
- ((match-end 1) ; begin
- (setq nest (1- nest)))
- ((match-end 2) ; end
- (setq nest (1+ nest)))
- ((match-end 3)
- (if (= 0 nest)
- (progn
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (verilog-get-expr))
- (setq str (concat " // else: !if" str ))
- (throw 'skip 1))))
- ((match-end 4)
- (if (= 0 nest)
- (progn
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (verilog-get-expr))
- (setq str (concat " // else: !assert " str ))
- (throw 'skip 1)))))))))
- (;- end else
- (match-end 3)
- (goto-char there)
- (let ((nest 0)
- (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
- (catch 'skip
- (while (verilog-re-search-backward reg nil 'move)
- (cond
- ((match-end 1) ; begin
- (setq nest (1- nest)))
- ((match-end 2) ; end
- (setq nest (1+ nest)))
- ((match-end 3)
- (if (= 0 nest)
- (progn
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (verilog-get-expr))
- (setq str (concat " // else: !if" str ))
- (throw 'skip 1))))
- ((match-end 4)
- (if (= 0 nest)
- (progn
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (verilog-get-expr))
- (setq str (concat " // else: !assert " str ))
- (throw 'skip 1)))))))))
-
- (; always_comb, always_ff, always_latch
- (or (match-end 4) (match-end 5) (match-end 6))
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (concat " // " cntx )))
-
- (;- task/function/initial et cetera
- t
- (match-end 0)
- (goto-char (match-end 0))
- (setq there (point))
- (setq err nil)
- (setq str (concat " // " cntx (verilog-get-expr))))
-
- (;-- otherwise...
- (setq str " // auto-endcomment confused "))))
-
- ((and
- (verilog-in-case-region-p) ;-- handle case item differently
- (progn
- (setq there (point))
- (goto-char here)
- (setq str (verilog-backward-case-item lim))))
- (setq err nil)
- (setq str (concat " // case: " str )))
-
- ((verilog-in-fork-region-p)
- (setq err nil)
- (setq str " // fork branch" ))
-
- ((looking-at "\\<end\\>")
- ;; HERE
- (forward-word 1)
- (verilog-forward-syntactic-ws)
- (setq err nil)
- (setq str (verilog-get-expr))
- (setq str (concat " // " cntx str )))
-
- ))))
- (goto-char here)
- (end-of-line)
- (if kill-existing-comment
- (verilog-kill-existing-comment))
- (delete-horizontal-space)
- (if (or err
- (> (count-lines here there) verilog-minimum-comment-distance))
- (insert str))
- (if err (ding 't))
- ))))
- (;- this is endclass, which can be nested
- (match-end 11) ;; of verilog-end-block-ordered-re
- ;;(goto-char there)
- (let ((nest 0)
- (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>")
- string)
- (save-excursion
- (catch 'skip
- (while (verilog-re-search-backward reg nil 'move)
- (cond
- ((match-end 3) ; endclass
- (ding 't)
- (setq string "unmatched endclass")
- (throw 'skip 1))
-
- ((match-end 2) ; endclass
- (setq nest (1+ nest)))
-
- ((match-end 1) ; class
- (setq nest (1- nest))
- (if (< nest 0)
- (progn
- (goto-char (match-end 0))
- (let (b e)
- (setq b (progn
- (skip-chars-forward "^ \t")
- (verilog-forward-ws&directives)
- (point))
- e (progn
- (skip-chars-forward "a-zA-Z0-9_")
- (point)))
- (setq string (buffer-substring b e)))
- (throw 'skip 1))))
- ))))
- (end-of-line)
- (insert (concat " // " string ))))
-
- (;- this is end{function,generate,task,module,primitive,table,generate}
- ;- which can not be nested.
- t
- (let (string reg (name-re nil))
- (end-of-line)
- (if kill-existing-comment
- (save-match-data
- (verilog-kill-existing-comment)))
- (delete-horizontal-space)
- (backward-sexp)
- (cond
- ((match-end 5) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
- (setq name-re "\\w+\\s-*("))
- ((match-end 6) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
- (setq name-re "\\w+\\s-*("))
- ((match-end 7) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>"))
- ((match-end 8) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<primitive\\>\\)\\|\\(\\<\\(endprimitive\\|package\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 9) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<interface\\>\\)\\|\\(\\<\\(endinterface\\|package\\|primitive\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 10) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<package\\>\\)\\|\\(\\<\\(endpackage\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 11) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<class\\>\\)\\|\\(\\<\\(endclass\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 12) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<\\(endcovergroup\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 13) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<program\\>\\)\\|\\(\\<\\(endprogram\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 14) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<\\(endsequence\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
- ((match-end 15) ;; of verilog-end-block-ordered-re
- (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>"))
-
- (t (error "Problem in verilog-set-auto-endcomments")))
- (let (b e)
- (save-excursion
- (verilog-re-search-backward reg nil 'move)
- (cond
- ((match-end 1)
- (setq b (progn
- (skip-chars-forward "^ \t")
- (verilog-forward-ws&directives)
- (if (looking-at "static\\|automatic")
- (progn
- (goto-char (match-end 0))
- (verilog-forward-ws&directives)))
- (if (and name-re (verilog-re-search-forward name-re nil 'move))
- (progn
- (goto-char (match-beginning 0))
- (verilog-forward-ws&directives)))
- (point))
- e (progn
- (skip-chars-forward "a-zA-Z0-9_")
- (point)))
- (setq string (buffer-substring b e)))
- (t
- (ding 't)
- (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)")))))
- (end-of-line)
- (insert (concat " // " string )))
- ))))))))))
+ (cond
+ (;- This is a case block; search back for the start of this case
+ (match-end 1) ; of verilog-end-block-ordered-re
+
+ (let ((err 't)
+ (str "UNMATCHED!!"))
+ (save-excursion
+ (verilog-leap-to-head)
+ (cond
+ ((looking-at "\\<randcase\\>")
+ (setq str "randcase")
+ (setq err nil))
+ ((looking-at "\\(\\(unique0?\\s-+\\|priority\\s-+\\)?case[xz]?\\)")
+ (goto-char (match-end 0))
+ (setq str (concat (match-string 0) " " (verilog-get-expr)))
+ (setq err nil))
+ ))
+ (end-of-line)
+ (if kill-existing-comment
+ (verilog-kill-existing-comment))
+ (delete-horizontal-space)
+ (insert (concat " // " str ))
+ (if err (ding 't))))
+
+ (;- This is a begin..end block
+ (match-end 2) ; of verilog-end-block-ordered-re
+ (let ((str " // UNMATCHED !!")
+ (err 't)
+ (here (point))
+ there
+ cntx)
+ (save-excursion
+ (verilog-leap-to-head)
+ (setq there (point))
+ (if (not (match-end 0))
+ (progn
+ (goto-char here)
+ (end-of-line)
+ (if kill-existing-comment
+ (verilog-kill-existing-comment))
+ (delete-horizontal-space)
+ (insert str)
+ (ding 't))
+ (let ((lim
+ (save-excursion (verilog-beg-of-defun) (point)))
+ (here (point)))
+ (cond
+ (;-- handle named block differently
+ (looking-at verilog-named-block-re)
+ (search-forward ":")
+ (setq there (point))
+ (setq str (verilog-get-expr))
+ (setq err nil)
+ (setq str (concat " // block: " str )))
+
+ ((verilog-in-case-region-p) ;-- handle case item differently
+ (goto-char here)
+ (setq str (verilog-backward-case-item lim))
+ (setq there (point))
+ (setq err nil)
+ (setq str (concat " // case: " str )))
+
+ (;- try to find "reason" for this begin
+ (cond
+ (;
+ (eq here (progn
+ ;; (verilog-backward-token)
+ (verilog-beg-of-statement)
+ (point)))
+ (setq err nil)
+ (setq str ""))
+ ((looking-at verilog-endcomment-reason-re)
+ (setq there (match-end 0))
+ (setq cntx (concat (match-string 0) " "))
+ (cond
+ (;- begin
+ (match-end 1)
+ (setq err nil)
+ (save-excursion
+ (if (and (verilog-continued-line)
+ (looking-at "\\<repeat\\>\\|\\<wait\\>\\|\\<always\\>"))
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq str
+ (concat " // " (match-string 0) " " (verilog-get-expr))))
+ (setq str ""))))
+
+ (;- else
+ (match-end 2)
+ (let ((nest 0)
+ ( reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))
+ ((match-end 3)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !if" str ))
+ (throw 'skip 1))))
+ ((match-end 4)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !assert " str ))
+ (throw 'skip 1)))))))))
+ (;- end else
+ (match-end 3)
+ (goto-char there)
+ (let ((nest 0)
+ (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)"))
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))
+ ((match-end 3)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !if" str ))
+ (throw 'skip 1))))
+ ((match-end 4)
+ (if (= 0 nest)
+ (progn
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // else: !assert " str ))
+ (throw 'skip 1)))))))))
+
+ (; always, always_comb, always_latch w/o @...
+ (match-end 5)
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (concat " // " cntx )))
+
+ (;- task/function/initial et cetera
+ t
+ (match-end 0)
+ (goto-char (match-end 0))
+ (setq there (point))
+ (setq err nil)
+ (setq str (concat " // " cntx (verilog-get-expr))))
+
+ (;-- otherwise...
+ (setq str " // auto-endcomment confused "))))
+
+ ((and
+ (verilog-in-case-region-p) ;-- handle case item differently
+ (progn
+ (setq there (point))
+ (goto-char here)
+ (setq str (verilog-backward-case-item lim))))
+ (setq err nil)
+ (setq str (concat " // case: " str )))
+
+ ((verilog-in-fork-region-p)
+ (setq err nil)
+ (setq str " // fork branch" ))
+
+ ((looking-at "\\<end\\>")
+ ;; HERE
+ (forward-word 1)
+ (verilog-forward-syntactic-ws)
+ (setq err nil)
+ (setq str (verilog-get-expr))
+ (setq str (concat " // " cntx str )))
+
+ ))))
+ (goto-char here)
+ (end-of-line)
+ (if kill-existing-comment
+ (verilog-kill-existing-comment))
+ (delete-horizontal-space)
+ (if (or err
+ (> (count-lines here there) verilog-minimum-comment-distance))
+ (insert str))
+ (if err (ding 't))
+ ))))
+ (;- this is endclass, which can be nested
+ (match-end 11) ; of verilog-end-block-ordered-re
+ ;;(goto-char there)
+ (let ((nest 0)
+ (reg "\\<\\(class\\)\\|\\(endclass\\)\\|\\(package\\|primitive\\|\\(macro\\)?module\\)\\>")
+ string)
+ (save-excursion
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 3) ; endclass
+ (ding 't)
+ (setq string "unmatched endclass")
+ (throw 'skip 1))
+
+ ((match-end 2) ; endclass
+ (setq nest (1+ nest)))
+
+ ((match-end 1) ; class
+ (setq nest (1- nest))
+ (if (< nest 0)
+ (progn
+ (goto-char (match-end 0))
+ (let (b e)
+ (setq b (progn
+ (skip-chars-forward "^ \t")
+ (verilog-forward-ws&directives)
+ (point))
+ e (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))
+ (setq string (buffer-substring b e)))
+ (throw 'skip 1))))
+ ))))
+ (end-of-line)
+ (if kill-existing-comment
+ (verilog-kill-existing-comment))
+ (delete-horizontal-space)
+ (insert (concat " // " string ))))
+
+ (; - this is end{function,generate,task,module,primitive,table,generate}
+ ;; - which can not be nested.
+ t
+ (let (string reg (name-re nil))
+ (end-of-line)
+ (if kill-existing-comment
+ (save-match-data
+ (verilog-kill-existing-comment)))
+ (delete-horizontal-space)
+ (backward-sexp)
+ (cond
+ ((match-end 5) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<\\(endfunction\\|task\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
+ (setq name-re "\\w+\\(?:\n\\|\\s-\\)*[(;]"))
+ ((match-end 6) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<\\(endtask\\|function\\|\\(macro\\)?module\\|primitive\\)\\>\\)")
+ (setq name-re "\\w+\\(?:\n\\|\\s-\\)*[(;]"))
+ ((match-end 7) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<\\(macro\\)?module\\>\\)\\|\\<endmodule\\>"))
+ ((match-end 8) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<primitive\\>\\)\\|\\(\\<\\(endprimitive\\|package\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 9) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<interface\\>\\)\\|\\(\\<\\(endinterface\\|package\\|primitive\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 10) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<package\\>\\)\\|\\(\\<\\(endpackage\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 11) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<\\(endclass\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 12) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<\\(endcovergroup\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 13) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<program\\>\\)\\|\\(\\<\\(endprogram\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 14) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<\\(rand\\)?sequence\\>\\)\\|\\(\\<\\(endsequence\\|primitive\\|interface\\|\\(macro\\)?module\\)\\>\\)"))
+ ((match-end 15) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<clocking\\>\\)\\|\\<endclocking\\>"))
+ ((match-end 16) ; of verilog-end-block-ordered-re
+ (setq reg "\\(\\<property\\>\\)\\|\\<endproperty\\>"))
+
+ (t (error "Problem in verilog-set-auto-endcomments")))
+ (let (b e)
+ (save-excursion
+ (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1)
+ (setq b (progn
+ (skip-chars-forward "^ \t")
+ (verilog-forward-ws&directives)
+ (if (looking-at "static\\|automatic")
+ (progn
+ (goto-char (match-end 0))
+ (verilog-forward-ws&directives)))
+ (if (and name-re (verilog-re-search-forward name-re nil 'move))
+ (progn
+ (goto-char (match-beginning 0))
+ (verilog-forward-ws&directives)))
+ (point))
+ e (progn
+ (skip-chars-forward "a-zA-Z0-9_")
+ (point)))
+ (setq string (buffer-substring b e)))
+ (t
+ (ding 't)
+ (setq string "unmatched end(function|task|module|primitive|interface|package|class|clocking)")))))
+ (end-of-line)
+ (insert (concat " // " string )))
+ ))))))))))
(defun verilog-get-expr()
"Grab expression at point, e.g., case ( a | b & (c ^d))."
@@ -4901,11 +5072,11 @@ Useful for creating tri's and other expanded fields."
(if (verilog-within-string)
(re-search-forward "\"" nil t)
(if (verilog-in-star-comment-p)
- (re-search-forward "\*/" nil t)
+ (re-search-forward "\\*/" nil t)
(let ((bpt (- (point) 2)))
(end-of-line)
(delete-region bpt (point))))))
- ;;
+ ;;
(goto-char (point-min))
(while (re-search-forward "/\\*" nil t)
(if (verilog-within-string)
@@ -4919,7 +5090,7 @@ Useful for creating tri's and other expanded fields."
(interactive)
(goto-char (point-min))
(while (re-search-forward "\\([^;]\\)[ \t]*\n[ \t]*" nil t)
- (replace-match "\\1 " nil nil)))
+ (replace-match "\\1 " nil nil)))
(defun verilog-linter-name ()
"Return name of linter, either surelint or verilint."
@@ -4931,7 +5102,7 @@ Useful for creating tri's and other expanded fields."
((equal compile-word1 "verilint") `verilint)
((equal lint-word1 "surelint") `surelint)
((equal lint-word1 "verilint") `verilint)
- (t `surelint)))) ;; back compatibility
+ (t `surelint)))) ; back compatibility
(defun verilog-lint-off ()
"Convert a Verilog linter warning line into a disable statement.
@@ -5013,7 +5184,7 @@ becomes:
(t
)))
((verilog-in-star-comment-p)
- (re-search-backward "/\*")
+ (re-search-backward "/\\*")
(insert (format " // surefire lint_off_line %6s" code )))
(t
(insert (format " // surefire lint_off_line %6s" code ))
@@ -5047,18 +5218,18 @@ becomes:
(defun verilog-preprocess (&optional command filename)
"Preprocess the buffer, similar to `compile', but put output in Verilog-Mode.
Takes optional COMMAND or defaults to `verilog-preprocessor', and
-FILENAME to find directory to run in, or defaults to `buffer-file-name`."
+FILENAME to find directory to run in, or defaults to `buffer-file-name'."
(interactive
(list
(let ((default (verilog-expand-command verilog-preprocessor)))
(set (make-local-variable `verilog-preprocessor)
- (read-from-minibuffer "Run Preprocessor (like this): "
- default nil nil
- 'verilog-preprocess-history default)))))
+ (read-from-minibuffer "Run Preprocessor (like this): "
+ default nil nil
+ 'verilog-preprocess-history default)))))
(unless command (setq command (verilog-expand-command verilog-preprocessor)))
(let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode))
- (dir (file-name-directory (or filename buffer-file-name)))
- (cmd (concat "cd " dir "; " command)))
+ (dir (file-name-directory (or filename buffer-file-name)))
+ (cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
(with-current-buffer (get-buffer "*Verilog-Preprocessed*")
(insert (concat "// " cmd "\n"))
@@ -5066,11 +5237,14 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`."
(verilog-mode)
;; Without this force, it takes a few idle seconds
;; to get the color, which is very jarring
- (when fontlocked (font-lock-fontify-buffer))))))
+ (unless (fboundp 'font-lock-ensure)
+ ;; We should use font-lock-ensure in preference to
+ ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to
+ ;; solve only appears in Emacsen older than font-lock-ensure anyway.
+ ;; So avoid bytecomp's interactive-only by going through intern.
+ (when fontlocked (funcall (intern "font-lock-fontify-buffer"))))))))
-
-;;
-;; Batch
+;;; Batch:
;;
(defun verilog-warn (string &rest args)
@@ -5092,7 +5266,7 @@ This lets programs calling batch mode to easily extract error messages."
(progn ,@body)
(error
(error "%%Error: %s%s" (error-message-string err)
- (if (featurep 'xemacs) "\n" "")))))) ;; XEmacs forgets to add a newline
+ (if (featurep 'xemacs) "\n" "")))))) ; XEmacs forgets to add a newline
(defun verilog-batch-execute-func (funref &optional no-save)
"Internal processing of a batch command.
@@ -5108,26 +5282,33 @@ Save the result unless optional NO-SAVE is t."
(setq-default make-backup-files nil)
(setq enable-local-variables t)
(setq enable-local-eval t)
+ (setq create-lockfiles nil)
;; Make sure any sub-files we read get proper mode
(setq-default major-mode 'verilog-mode)
;; Ditto files already read in
- (mapc (lambda (buf)
- (when (buffer-file-name buf)
- (with-current-buffer buf
- (verilog-mode))))
- (buffer-list))
- ;; Process the files
- (mapcar (lambda (buf)
+ ;; Remember buffer list, so don't later pickup any verilog-getopt files
+ (let ((orig-buffer-list (buffer-list)))
+ (mapc (lambda (buf)
(when (buffer-file-name buf)
- (save-excursion
- (if (not (file-exists-p (buffer-file-name buf)))
- (error
- (concat "File not found: " (buffer-file-name buf))))
- (message (concat "Processing " (buffer-file-name buf)))
- (set-buffer buf)
- (funcall funref)
- (unless no-save (save-buffer)))))
- (buffer-list))))
+ (with-current-buffer buf
+ (verilog-mode)
+ (verilog-auto-reeval-locals)
+ (verilog-getopt-flags))))
+ orig-buffer-list)
+ ;; Process the files
+ (mapcar (lambda (buf)
+ (when (buffer-file-name buf)
+ (save-excursion
+ (if (not (file-exists-p (buffer-file-name buf)))
+ (error
+ "File not found: %s" (buffer-file-name buf)))
+ (message "Processing %s" (buffer-file-name buf))
+ (set-buffer buf)
+ (funcall funref)
+ (when (and (not no-save)
+ (buffer-modified-p)) ; Avoid "no changes to be saved"
+ (save-buffer)))))
+ orig-buffer-list))))
(defun verilog-batch-auto ()
"For use with --batch, perform automatic expansions as a stand-alone tool.
@@ -5136,7 +5317,7 @@ with \\[verilog-auto] on all command-line files, and saves the buffers.
For proper results, multiple filenames need to be passed on the command
line in bottom-up order."
(unless noninteractive
- (error "Use verilog-batch-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-auto only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-auto))
(defun verilog-batch-delete-auto ()
@@ -5144,7 +5325,7 @@ line in bottom-up order."
This sets up the appropriate Verilog mode environment, deletes automatics
with \\[verilog-delete-auto] on all command-line files, and saves the buffers."
(unless noninteractive
- (error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-delete-auto only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-delete-auto))
(defun verilog-batch-delete-trailing-whitespace ()
@@ -5153,7 +5334,7 @@ This sets up the appropriate Verilog mode environment, removes
whitespace with \\[verilog-delete-trailing-whitespace] on all
command-line files, and saves the buffers."
(unless noninteractive
- (error "Use verilog-batch-delete-trailing-whitespace only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-delete-trailing-whitespace only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-delete-trailing-whitespace))
(defun verilog-batch-diff-auto ()
@@ -5163,7 +5344,7 @@ with \\[verilog-diff-auto] on all command-line files, and reports an error
if any differences are observed. This is appropriate for adding to regressions
to insure automatics are always properly maintained."
(unless noninteractive
- (error "Use verilog-batch-diff-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-diff-auto only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-diff-auto t))
(defun verilog-batch-inject-auto ()
@@ -5173,7 +5354,7 @@ with \\[verilog-inject-auto] on all command-line files, and saves the buffers.
For proper results, multiple filenames need to be passed on the command
line in bottom-up order."
(unless noninteractive
- (error "Use verilog-batch-inject-auto only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-inject-auto only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-inject-auto))
(defun verilog-batch-indent ()
@@ -5181,12 +5362,10 @@ line in bottom-up order."
This sets up the appropriate Verilog mode environment, calls
\\[verilog-indent-buffer] on all command-line files, and saves the buffers."
(unless noninteractive
- (error "Use verilog-batch-indent only with --batch")) ;; Otherwise we'd mess up buffer modes
+ (error "Use verilog-batch-indent only with --batch")) ; Otherwise we'd mess up buffer modes
(verilog-batch-execute-func `verilog-indent-buffer))
-
-;;
-;; Indentation
+;;; Indentation:
;;
(defconst verilog-indent-alist
'((block . (+ ind verilog-indent-level))
@@ -5225,9 +5404,11 @@ type of the current line, return that lines' indent level and its type.
Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(save-excursion
(let* ((starting_position (point))
+ (case-fold-search nil)
(par 0)
(begin (looking-at "[ \t]*begin\\>"))
(lim (save-excursion (verilog-re-search-backward "\\(\\<begin\\>\\)\\|\\(\\<module\\>\\)" nil t)))
+ (structres nil)
(type (catch 'nesting
;; Keep working backwards until we can figure out
;; what type of statement this is.
@@ -5243,123 +5424,134 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(if (save-excursion (beginning-of-line)
(and (looking-at verilog-directive-re-1)
(not (or (looking-at "[ \t]*`[ou]vm_")
- (looking-at "[ \t]*`vmm_")))))
+ (looking-at "[ \t]*`vmm_")))))
(throw 'nesting 'directive))
- ;; indent structs as if there were module level
- (if (verilog-in-struct-p)
- (throw 'nesting 'block))
-
- ;; if we are in a parenthesized list, and the user likes to indent these, return.
- ;; unless we are in the newfangled coverpoint or constraint blocks
- (if (and
- verilog-indent-lists
- (verilog-in-paren)
- (not (verilog-in-coverage-p))
- )
- (progn (setq par 1)
- (throw 'nesting 'block)))
-
- ;; See if we are continuing a previous line
- (while t
- ;; trap out if we crawl off the top of the buffer
- (if (bobp) (throw 'nesting 'cpp))
-
- (if (verilog-continued-line-1 lim)
- (let ((sp (point)))
- (if (and
- (not (looking-at verilog-complete-reg))
- (verilog-continued-line-1 lim))
- (progn (goto-char sp)
- (throw 'nesting 'cexp))
-
- (goto-char sp))
-
- (if (and begin
- (not verilog-indent-begin-after-if)
- (looking-at verilog-no-indent-begin-re))
- (progn
- (beginning-of-line)
- (skip-chars-forward " \t")
- (throw 'nesting 'statement))
- (progn
- (throw 'nesting 'cexp))))
- ;; not a continued line
- (goto-char starting_position))
-
- (if (looking-at "\\<else\\>")
- ;; search back for governing if, striding across begin..end pairs
- ;; appropriately
- (let ((elsec 1))
- (while (verilog-re-search-backward verilog-ends-re nil 'move)
- (cond
- ((match-end 1) ; else, we're in deep
- (setq elsec (1+ elsec)))
- ((match-end 2) ; if
- (setq elsec (1- elsec))
- (if (= 0 elsec)
- (if verilog-align-ifelse
- (throw 'nesting 'statement)
- (progn ;; back up to first word on this line
- (beginning-of-line)
- (verilog-forward-syntactic-ws)
- (throw 'nesting 'statement)))))
- ((match-end 3) ; assert block
- (setq elsec (1- elsec))
- (verilog-beg-of-statement) ;; doesn't get to beginning
- (if (looking-at verilog-property-re)
- (throw 'nesting 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need an endproperty
- ))
- (t ; endblock
- ; try to leap back to matching outward block by striding across
- ; indent level changing tokens then immediately
- ; previous line governs indentation.
- (let (( reg) (nest 1))
- ;; verilog-ends => else|if|end|join(_any|_none|)|endcase|endclass|endtable|endspecify|endfunction|endtask|endgenerate|endgroup
- (cond
- ((match-end 4) ; end
- ;; Search back for matching begin
- (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
- ((match-end 5) ; endcase
- ;; Search back for matching case
- (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ))
- ((match-end 6) ; endfunction
- ;; Search back for matching function
- (setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
- ((match-end 7) ; endtask
- ;; Search back for matching task
- (setq reg "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)" ))
- ((match-end 8) ; endspecify
- ;; Search back for matching specify
- (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
- ((match-end 9) ; endtable
- ;; Search back for matching table
- (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" ))
- ((match-end 10) ; endgenerate
- ;; Search back for matching generate
- (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
- ((match-end 11) ; joins
- ;; Search back for matching fork
- (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|none\\)?\\>\\)" ))
- ((match-end 12) ; class
- ;; Search back for matching class
- (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
- ((match-end 13) ; covergroup
- ;; Search back for matching covergroup
- (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )))
- (catch 'skip
- (while (verilog-re-search-backward reg nil 'move)
- (cond
- ((match-end 1) ; begin
- (setq nest (1- nest))
- (if (= 0 nest)
- (throw 'skip 1)))
- ((match-end 2) ; end
- (setq nest (1+ nest)))))
- )))))))
- (throw 'nesting (verilog-calc-1)))
- );; catch nesting
- );; type
+ ;; indent structs as if there were module level
+ (setq structres (verilog-in-struct-nested-p))
+ (cond ((not structres) nil)
+ ;;((and structres (equal (char-after) ?\})) (throw 'nesting 'struct-close))
+ ((> structres 0) (throw 'nesting 'nested-struct))
+ ((= structres 0) (throw 'nesting 'block))
+ (t nil))
+
+ ;; if we are in a parenthesized list, and the user likes to indent these, return.
+ ;; unless we are in the newfangled coverpoint or constraint blocks
+ (if (and
+ verilog-indent-lists
+ (verilog-in-paren)
+ (not (verilog-in-coverage-p))
+ )
+ (progn (setq par 1)
+ (throw 'nesting 'block)))
+
+ ;; See if we are continuing a previous line
+ (while t
+ ;; trap out if we crawl off the top of the buffer
+ (if (bobp) (throw 'nesting 'cpp))
+
+ (if (and (verilog-continued-line-1 lim)
+ (or (not (verilog-in-coverage-p))
+ (looking-at verilog-in-constraint-re) )) ; may still get hosed if concat in constraint
+ (let ((sp (point)))
+ (if (and
+ (not (looking-at verilog-complete-reg))
+ (verilog-continued-line-1 lim))
+ (progn (goto-char sp)
+ (throw 'nesting 'cexp))
+
+ (goto-char sp))
+ (if (and (verilog-in-coverage-p)
+ (looking-at verilog-in-constraint-re))
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (throw 'nesting 'constraint)))
+ (if (and begin
+ (not verilog-indent-begin-after-if)
+ (looking-at verilog-no-indent-begin-re))
+ (progn
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (throw 'nesting 'statement))
+ (progn
+ (throw 'nesting 'cexp))))
+ ;; not a continued line
+ (goto-char starting_position))
+
+ (if (looking-at "\\<else\\>")
+ ;; search back for governing if, striding across begin..end pairs
+ ;; appropriately
+ (let ((elsec 1))
+ (while (verilog-re-search-backward verilog-ends-re nil 'move)
+ (cond
+ ((match-end 1) ; else, we're in deep
+ (setq elsec (1+ elsec)))
+ ((match-end 2) ; if
+ (setq elsec (1- elsec))
+ (if (= 0 elsec)
+ (if verilog-align-ifelse
+ (throw 'nesting 'statement)
+ (progn ; back up to first word on this line
+ (beginning-of-line)
+ (verilog-forward-syntactic-ws)
+ (throw 'nesting 'statement)))))
+ ((match-end 3) ; assert block
+ (setq elsec (1- elsec))
+ (verilog-beg-of-statement) ; doesn't get to beginning
+ (if (looking-at verilog-property-re)
+ (throw 'nesting 'statement) ; We don't need an endproperty for these
+ (throw 'nesting 'block) ; We still need an endproperty
+ ))
+ (t ; endblock
+ ;; try to leap back to matching outward block by striding across
+ ;; indent level changing tokens then immediately
+ ;; previous line governs indentation.
+ (let (( reg) (nest 1))
+ ;; verilog-ends => else|if|end|join(_any|_none|)|endcase|endclass|endtable|endspecify|endfunction|endtask|endgenerate|endgroup
+ (cond
+ ((match-end 4) ; end
+ ;; Search back for matching begin
+ (setq reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)" ))
+ ((match-end 5) ; endcase
+ ;; Search back for matching case
+ (setq reg "\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|\\(\\<endcase\\>\\)" ))
+ ((match-end 6) ; endfunction
+ ;; Search back for matching function
+ (setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
+ ((match-end 7) ; endtask
+ ;; Search back for matching task
+ (setq reg "\\(\\<task\\>\\)\\|\\(\\<endtask\\>\\)" ))
+ ((match-end 8) ; endspecify
+ ;; Search back for matching specify
+ (setq reg "\\(\\<specify\\>\\)\\|\\(\\<endspecify\\>\\)" ))
+ ((match-end 9) ; endtable
+ ;; Search back for matching table
+ (setq reg "\\(\\<table\\>\\)\\|\\(\\<endtable\\>\\)" ))
+ ((match-end 10) ; endgenerate
+ ;; Search back for matching generate
+ (setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
+ ((match-end 11) ; joins
+ ;; Search back for matching fork
+ (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|none\\)?\\>\\)" ))
+ ((match-end 12) ; class
+ ;; Search back for matching class
+ (setq reg "\\(\\<class\\>\\)\\|\\(\\<endclass\\>\\)" ))
+ ((match-end 13) ; covergroup
+ ;; Search back for matching covergroup
+ (setq reg "\\(\\<covergroup\\>\\)\\|\\(\\<endgroup\\>\\)" )))
+ (catch 'skip
+ (while (verilog-re-search-backward reg nil 'move)
+ (cond
+ ((match-end 1) ; begin
+ (setq nest (1- nest))
+ (if (= 0 nest)
+ (throw 'skip 1)))
+ ((match-end 2) ; end
+ (setq nest (1+ nest)))))
+ )))))))
+ (throw 'nesting (verilog-calc-1)))
+ ) ; catch nesting
+ ) ; type
)
;; Return type of block and indent level.
(if (not type)
@@ -5367,14 +5559,18 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(if (> par 0) ; Unclosed Parenthesis
(list 'cparenexp par)
(cond
- ((eq type 'case)
- (list type (verilog-case-indent-level)))
- ((eq type 'statement)
- (list type (current-column)))
- ((eq type 'defun)
- (list type 0))
- (t
- (list type (verilog-current-indent-level))))))))
+ ((eq type 'case)
+ (list type (verilog-case-indent-level)))
+ ((eq type 'statement)
+ (list type (current-column)))
+ ((eq type 'defun)
+ (list type 0))
+ ((eq type 'constraint)
+ (list 'block (current-column)))
+ ((eq type 'nested-struct)
+ (list 'block structres))
+ (t
+ (list type (verilog-current-indent-level))))))))
(defun verilog-wai ()
"Show matching nesting block for debugging."
@@ -5388,114 +5584,134 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(if (and
verilog-indent-lists
(not(or (verilog-in-coverage-p)
- (verilog-in-struct-p)))
+ (verilog-in-struct-p)))
(verilog-in-paren))
(setq depth 1)
(cond
- ((eq type 'case)
- (setq depth (verilog-case-indent-level)))
- ((eq type 'statement)
- (setq depth (current-column)))
- ((eq type 'defun)
- (setq depth 0))
- (t
- (setq depth (verilog-current-indent-level)))))
+ ((eq type 'case)
+ (setq depth (verilog-case-indent-level)))
+ ((eq type 'statement)
+ (setq depth (current-column)))
+ ((eq type 'defun)
+ (setq depth 0))
+ (t
+ (setq depth (verilog-current-indent-level)))))
(message "You are at nesting %s depth %d" type depth))))
+
(defun verilog-calc-1 ()
(catch 'nesting
- (let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)")))
+ (let ((re (concat "\\({\\|}\\|" verilog-indent-re "\\)"))
+ (inconstraint (verilog-in-coverage-p)))
(while (verilog-re-search-backward re nil 'move)
- (catch 'continue
- (cond
- ((equal (char-after) ?\{)
- (if (verilog-at-constraint-p)
- (throw 'nesting 'block)))
-
- ((equal (char-after) ?\})
- (let ((there (verilog-at-close-constraint-p)))
- (if there ;; we are at the } that closes a constraint. Find the { that opens it
- (progn
- (forward-char 1)
- (backward-list 1)
- (verilog-beg-of-statement)))))
-
- ((looking-at verilog-beg-block-re-ordered)
- (cond
- ((match-end 2) ; *sigh* could be "unique case" or "priority casex"
- (let ((here (point)))
- (verilog-beg-of-statement)
- (if (looking-at verilog-extended-case-re)
- (throw 'nesting 'case)
- (goto-char here)))
- (throw 'nesting 'case))
-
- ((match-end 4) ; *sigh* could be "disable fork"
- (let ((here (point)))
- (verilog-beg-of-statement)
- (if (looking-at verilog-disable-fork-re)
- t ; this is a normal statement
- (progn ; or is fork, starts a new block
- (goto-char here)
- (throw 'nesting 'block)))))
-
- ((match-end 27) ; *sigh* might be a clocking declaration
- (let ((here (point)))
- (if (verilog-in-paren)
- t ; this is a normal statement
- (progn ; or is fork, starts a new block
- (goto-char here)
- (throw 'nesting 'block)))))
-
- ;; need to consider typedef struct here...
- ((looking-at "\\<class\\|struct\\|function\\|task\\>")
- ; *sigh* These words have an optional prefix:
- ; extern {virtual|protected}? function a();
- ; typedef class foo;
- ; and we don't want to confuse this with
- ; function a();
- ; property
- ; ...
- ; endfunction
- (verilog-beg-of-statement)
- (if (looking-at verilog-beg-block-re-ordered)
- (throw 'nesting 'block)
- (throw 'nesting 'defun)))
-
- ;;
- ((looking-at "\\<property\\>")
- ; *sigh*
- ; {assert|assume|cover} property (); are complete
- ; and could also be labeled: - foo: assert property
- ; but
- ; property ID () ... needs end_property
- (verilog-beg-of-statement)
- (if (looking-at verilog-property-re)
- (throw 'continue 'statement) ; We don't need an endproperty for these
- (throw 'nesting 'block) ;We still need an endproperty
- ))
-
- (t (throw 'nesting 'block))))
-
- ((looking-at verilog-end-block-re)
- (verilog-leap-to-head)
- (if (verilog-in-case-region-p)
- (progn
- (verilog-leap-to-case-head)
- (if (looking-at verilog-extended-case-re)
- (throw 'nesting 'case)))))
-
- ((looking-at verilog-defun-level-re)
- (if (looking-at verilog-defun-level-generate-only-re)
- (if (verilog-in-generate-region-p)
- (throw 'continue 'foo) ; always block in a generate - keep looking
- (throw 'nesting 'defun))
- (throw 'nesting 'defun)))
-
- ((looking-at verilog-cpp-level-re)
- (throw 'nesting 'cpp))
-
- ((bobp)
- (throw 'nesting 'cpp)))))
+ (catch 'continue
+ (cond
+ ((equal (char-after) ?\{)
+ ;; block type returned based on outer constraint { or inner
+ (if (verilog-at-constraint-p)
+ (cond (inconstraint
+ (beginning-of-line nil)
+ (skip-chars-forward " \t")
+ (throw 'nesting 'constraint))
+ (t
+ (throw 'nesting 'statement)))))
+ ((equal (char-after) ?\})
+ (let (par-pos
+ (there (verilog-at-close-constraint-p)))
+ (if there ; we are at the } that closes a constraint. Find the { that opens it
+ (progn
+ (if (> (verilog-in-paren-count) 0)
+ (forward-char 1))
+ (setq par-pos (verilog-parenthesis-depth))
+ (cond (par-pos
+ (goto-char par-pos)
+ (forward-char 1))
+ (t
+ (backward-char 1)))))))
+
+ ((looking-at verilog-beg-block-re-ordered)
+ (cond
+ ((match-end 2) ; *sigh* could be "unique case" or "priority casex"
+ (let ((here (point)))
+ (verilog-beg-of-statement)
+ (if (looking-at verilog-extended-case-re)
+ (throw 'nesting 'case)
+ (goto-char here)))
+ (throw 'nesting 'case))
+
+ ((match-end 4) ; *sigh* could be "disable fork"
+ (let ((here (point)))
+ (verilog-beg-of-statement)
+ (if (looking-at verilog-disable-fork-re)
+ t ; this is a normal statement
+ (progn ; or is fork, starts a new block
+ (goto-char here)
+ (throw 'nesting 'block)))))
+
+ ((match-end 27) ; *sigh* might be a clocking declaration
+ (let ((here (point)))
+ (if (verilog-in-paren)
+ t ; this is a normal statement
+ (progn ; or is fork, starts a new block
+ (goto-char here)
+ (throw 'nesting 'block)))))
+
+ ;; need to consider typedef struct here...
+ ((looking-at "\\<class\\|struct\\|function\\|task\\>")
+ ;; *sigh* These words have an optional prefix:
+ ;; extern {virtual|protected}? function a();
+ ;; typedef class foo;
+ ;; and we don't want to confuse this with
+ ;; function a();
+ ;; property
+ ;; ...
+ ;; endfunction
+ (verilog-beg-of-statement)
+ (cond
+ ((looking-at verilog-dpi-import-export-re)
+ (throw 'continue 'foo))
+ ((looking-at "\\<pure\\>\\s-+\\<virtual\\>\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+")
+ (throw 'nesting 'statement))
+ ((looking-at verilog-beg-block-re-ordered)
+ (throw 'nesting 'block))
+ (t
+ (throw 'nesting 'defun))))
+
+ ;;
+ ((looking-at "\\<property\\>")
+ ;; *sigh*
+ ;; {assert|assume|cover} property (); are complete
+ ;; and could also be labeled: - foo: assert property
+ ;; but
+ ;; property ID () ... needs end_property
+ (verilog-beg-of-statement)
+ (if (looking-at verilog-property-re)
+ (throw 'continue 'statement) ; We don't need an endproperty for these
+ (throw 'nesting 'block) ;We still need an endproperty
+ ))
+
+ (t (throw 'nesting 'block))))
+
+ ((looking-at verilog-end-block-re)
+ (verilog-leap-to-head)
+ (if (verilog-in-case-region-p)
+ (progn
+ (verilog-leap-to-case-head)
+ (if (looking-at verilog-extended-case-re)
+ (throw 'nesting 'case)))))
+
+ ((looking-at verilog-defun-level-re)
+ (if (looking-at verilog-defun-level-generate-only-re)
+ (if (or (verilog-in-generate-region-p)
+ (verilog-in-deferred-immediate-final-p))
+ (throw 'continue 'foo) ; always block in a generate - keep looking
+ (throw 'nesting 'defun))
+ (throw 'nesting 'defun)))
+
+ ((looking-at verilog-cpp-level-re)
+ (throw 'nesting 'cpp))
+
+ ((bobp)
+ (throw 'nesting 'cpp)))))
(throw 'nesting 'cpp))))
@@ -5503,8 +5719,8 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
"Return indentation level for directive.
For speed, the searcher looks at the last directive, not the indent
of the appropriate enclosing block."
- (let ((base -1) ;; Indent of the line that determines our indentation
- (ind 0)) ;; Relative offset caused by other directives (like `endif on same line as `else)
+ (let ((base -1) ; Indent of the line that determines our indentation
+ (ind 0)) ; Relative offset caused by other directives (like `endif on same line as `else)
;; Start at current location, scan back for another directive
(save-excursion
@@ -5513,9 +5729,9 @@ of the appropriate enclosing block."
(verilog-re-search-backward verilog-directive-re nil t))
(cond ((save-excursion (skip-chars-backward " \t") (bolp))
(setq base (current-indentation))))
- (cond ((and (looking-at verilog-directive-end) (< base 0)) ;; Only matters when not at BOL
+ (cond ((and (looking-at verilog-directive-end) (< base 0)) ; Only matters when not at BOL
(setq ind (- ind verilog-indent-level-directive)))
- ((and (looking-at verilog-directive-middle) (>= base 0)) ;; Only matters when at BOL
+ ((and (looking-at verilog-directive-middle) (>= base 0)) ; Only matters when at BOL
(setq ind (+ ind verilog-indent-level-directive)))
((looking-at verilog-directive-begin)
(setq ind (+ ind verilog-indent-level-directive)))))
@@ -5528,14 +5744,14 @@ of the appropriate enclosing block."
(cond ((or (looking-at verilog-directive-middle)
(looking-at verilog-directive-end))
(setq ind (max 0 (- ind verilog-indent-level-directive))))))
- ind))
+ ind))
(defun verilog-leap-to-case-head ()
(let ((nest 1))
(while (/= 0 nest)
(verilog-re-search-backward
(concat
- "\\(\\<randcase\\>\\|\\(\\<unique\\s-+\\|priority\\s-+\\)?\\<case[xz]?\\>\\)"
+ "\\(\\<randcase\\>\\|\\(\\<unique0?\\s-+\\|priority\\s-+\\)?\\<case[xz]?\\>\\)"
"\\|\\(\\<endcase\\>\\)" )
nil 'move)
(cond
@@ -5589,7 +5805,7 @@ Jump from end to matching begin, from endcase to matching case, and so on."
;; 8: Search back for matching function
(setq reg "\\(\\<function\\>\\)\\|\\(\\(\\(\\<virtual\\>\\s-+\\)\\|\\(\\<protected\\>\\s-+\\)\\)+\\<function\\>\\)")
(setq nesting 'no))
- ;;(setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
+ ;;(setq reg "\\(\\<function\\>\\)\\|\\(\\<endfunction\\>\\)" ))
((looking-at "\\<endgenerate\\>")
;; 8: Search back for matching generate
(setq reg "\\(\\<generate\\>\\)\\|\\(\\<endgenerate\\>\\)" ))
@@ -5652,7 +5868,7 @@ Jump from end to matching begin, from endcase to matching case, and so on."
(setq sreg reg)
(setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" ))
)))
- ;no nesting
+ ;; no nesting
(if (and
(verilog-re-search-backward reg nil 'move)
(match-end 1)) ; task -> could be virtual and/or protected
@@ -5675,7 +5891,7 @@ Set point to where line starts."
(save-excursion
(skip-chars-backward " \t")
(not (bolp))))
- (setq continued (verilog-backward-token)))))
+ (setq continued (verilog-backward-token)))))
(setq continued nil))
continued))
@@ -5689,14 +5905,14 @@ Set point to where line starts."
(;-- Anything ending in a ; is complete
(= (preceding-char) ?\;)
nil)
- (; If a "}" is prefixed by a ";", then this is a complete statement
- ; i.e.: constraint foo { a = b; }
+ (; If a "}" is prefixed by a ";", then this is a complete statement
+ ;; i.e.: constraint foo { a = b; }
(= (preceding-char) ?\})
(progn
(backward-char)
(not(verilog-at-close-constraint-p))))
(;-- constraint foo { a = b }
- ; is a complete statement. *sigh*
+ ;; is a complete statement. *sigh*
(= (preceding-char) ?\{)
(progn
(backward-char)
@@ -5714,10 +5930,10 @@ Set point to where line starts."
t)
(;-- Could be 'case (foo)' or 'always @(bar)' which is complete
- ; also could be simply '@(foo)'
- ; or foo u1 #(a=8)
- ; (b, ... which ISN'T complete
- ;;;; Do we need this???
+ ;; also could be simply '@(foo)'
+ ;; or foo u1 #(a=8)
+ ;; (b, ... which ISN'T complete
+ ;; Do we need this???
(= (preceding-char) ?\))
(progn
(backward-char)
@@ -5741,16 +5957,16 @@ Set point to where line starts."
t)
((looking-at verilog-ovm-end-re)
t)
- ;; JBA find VMM macros
- ((looking-at verilog-vmm-statement-re)
- nil )
- ((looking-at verilog-vmm-begin-re)
- t)
- ((looking-at verilog-vmm-end-re)
- nil)
- ;; JBA trying to catch macro lines with no ; at end
- ((looking-at "\\<`")
- nil)
+ ;; JBA find VMM macros
+ ((looking-at verilog-vmm-statement-re)
+ nil )
+ ((looking-at verilog-vmm-begin-re)
+ t)
+ ((looking-at verilog-vmm-end-re)
+ nil)
+ ;; JBA trying to catch macro lines with no ; at end
+ ((looking-at "\\<`")
+ nil)
(t
(goto-char back)
(cond
@@ -5766,7 +5982,9 @@ Set point to where line starts."
(;-- any of begin|initial|while are complete statements; 'begin : foo' is also complete
t
(forward-word -1)
- (while (= (preceding-char) ?\_)
+ (while (or (= (preceding-char) ?\_)
+ (= (preceding-char) ?\@)
+ (= (preceding-char) ?\.))
(forward-word -1))
(cond
((looking-at "\\<else\\>")
@@ -5806,16 +6024,16 @@ Set point to where line starts."
(defun verilog-backward-syntactic-ws-quick ()
"As with `verilog-backward-syntactic-ws' but use `verilog-scan' cache."
(while (cond ((bobp)
- nil) ; Done
- ((> (skip-syntax-backward " ") 0)
- t)
- ((eq (preceding-char) ?\n) ;; \n's terminate // so aren't space syntax
- (forward-char -1)
- t)
- ((or (verilog-inside-comment-or-string-p (1- (point)))
- (verilog-inside-comment-or-string-p (point)))
- (re-search-backward "[/\"]" nil t) ;; Only way a comment or quote can begin
- t))))
+ nil) ; Done
+ ((< (skip-syntax-backward " ") 0)
+ t)
+ ((eq (preceding-char) ?\n) ; \n's terminate // so aren't space syntax
+ (forward-char -1)
+ t)
+ ((or (verilog-inside-comment-or-string-p (1- (point)))
+ (verilog-inside-comment-or-string-p (point)))
+ (re-search-backward "[/\"]" nil t) ; Only way a comment or quote can begin
+ t))))
(defun verilog-forward-syntactic-ws ()
(verilog-skip-forward-comment-p)
@@ -5832,11 +6050,11 @@ Optional BOUND limits search."
(progn
(let ((state (save-excursion (verilog-syntax-ppss))))
(cond
- ((nth 7 state) ;; in // comment
+ ((nth 7 state) ; in // comment
(verilog-re-search-backward "//" nil 'move)
(skip-chars-backward "/"))
- ((nth 4 state) ;; in /* */ comment
- (verilog-re-search-backward "/\*" nil 'move))))
+ ((nth 4 state) ; in /* */ comment
+ (verilog-re-search-backward "/\\*" nil 'move))))
(narrow-to-region bound (point))
(while (/= here (point))
(setq here (point))
@@ -5844,6 +6062,9 @@ Optional BOUND limits search."
(setq p
(save-excursion
(beginning-of-line)
+ ;; for as long as we're right after a continued line, keep moving up
+ (while (and (verilog-looking-back "\\\\[\n\r\f]" nil)
+ (forward-line -1)))
(cond
((and verilog-highlight-translate-off
(verilog-within-translate-off))
@@ -5865,19 +6086,19 @@ Optional BOUND limits search."
(progn
(let ((state (save-excursion (verilog-syntax-ppss))))
(cond
- ((nth 7 state) ;; in // comment
+ ((nth 7 state) ; in // comment
(end-of-line)
(forward-char 1)
(skip-chars-forward " \t\n\f")
)
- ((nth 4 state) ;; in /* */ comment
- (verilog-re-search-forward "\*\/\\s-*" nil 'move))))
+ ((nth 4 state) ; in /* */ comment
+ (verilog-re-search-forward "\\*/\\s-*" nil 'move))))
(narrow-to-region (point) bound)
(while (/= here (point))
(setq here (point)
jump nil)
(forward-comment (buffer-size))
- (and (looking-at "\\s-*(\\*.*\\*)\\s-*") ;; Attribute
+ (and (looking-at "\\s-*(\\*.*\\*)\\s-*") ; Attribute
(goto-char (match-end 0)))
(save-excursion
(beginning-of-line)
@@ -5887,204 +6108,290 @@ Optional BOUND limits search."
(beginning-of-line 2))))))))
(defun verilog-in-comment-p ()
- "Return true if in a star or // comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (or (nth 4 state) (nth 7 state))))
+ "Return true if in a star or // comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (or (nth 4 state) (nth 7 state))))
(defun verilog-in-star-comment-p ()
- "Return true if in a star comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (and
- (nth 4 state) ; t if in a comment of style a // or b /**/
- (not
- (nth 7 state) ; t if in a comment of style b /**/
- ))))
+ "Return true if in a star comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (and
+ (nth 4 state) ; t if in a comment of style a // or b /**/
+ (not
+ (nth 7 state) ; t if in a comment of style b /**/
+ ))))
(defun verilog-in-slash-comment-p ()
- "Return true if in a slash comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (nth 7 state)))
+ "Return true if in a slash comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (nth 7 state)))
(defun verilog-in-comment-or-string-p ()
- "Return true if in a string or comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment)
+ "Return true if in a string or comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (or (nth 3 state) (nth 4 state) (nth 7 state)))) ; Inside string or comment)
(defun verilog-in-attribute-p ()
- "Return true if point is in an attribute (* [] attribute *)."
- (save-match-data
- (save-excursion
- (verilog-re-search-backward "\\((\\*\\)\\|\\(\\*)\\)" nil 'move)
- (numberp (match-beginning 1)))))
+ "Return true if point is in an attribute (* [] attribute *)."
+ (save-match-data
+ (save-excursion
+ (verilog-re-search-backward "\\((\\*\\)\\|\\(\\*)\\)" nil 'move)
+ (cond
+ ((match-end 1)
+ (progn (goto-char (match-end 1))
+ (not (looking-at "\\s-*)")))
+ nil)
+ ((match-end 2)
+ (progn (goto-char (match-beginning 2))
+ (not (looking-at "(\\s-*")))
+ nil)
+ (t nil)))))
(defun verilog-in-parameter-p ()
- "Return true if point is in a parameter assignment #( p1=1, p2=5)."
- (save-match-data
- (save-excursion
- (verilog-re-search-backward "\\(#(\\)\\|\\()\\)" nil 'move)
- (numberp (match-beginning 1)))))
+ "Return true if point is in a parameter assignment #( p1=1, p2=5)."
+ (save-match-data
+ (save-excursion
+ (verilog-re-search-backward "\\(#(\\)\\|\\()\\)" nil 'move)
+ (numberp (match-beginning 1)))))
(defun verilog-in-escaped-name-p ()
- "Return true if in an escaped name."
- (save-excursion
- (backward-char)
- (skip-chars-backward "^ \t\n\f")
- (if (equal (char-after (point) ) ?\\ )
- t
- nil)))
+ "Return true if in an escaped name."
+ (save-excursion
+ (backward-char)
+ (skip-chars-backward "^ \t\n\f")
+ (if (equal (char-after (point) ) ?\\ )
+ t
+ nil)))
+
(defun verilog-in-directive-p ()
- "Return true if in a directive."
- (save-excursion
- (beginning-of-line)
- (looking-at verilog-directive-re-1)))
+ "Return true if in a directive."
+ (save-excursion
+ (beginning-of-line)
+ (looking-at verilog-directive-re-1)))
(defun verilog-in-parenthesis-p ()
- "Return true if in a ( ) expression (but not { } or [ ])."
- (save-match-data
- (save-excursion
- (verilog-re-search-backward "\\((\\)\\|\\()\\)" nil 'move)
- (numberp (match-beginning 1)))))
+ "Return true if in a ( ) expression (but not { } or [ ])."
+ (save-match-data
+ (save-excursion
+ (verilog-re-search-backward "\\((\\)\\|\\()\\)" nil 'move)
+ (numberp (match-beginning 1)))))
(defun verilog-in-paren ()
- "Return true if in a parenthetical expression.
+ "Return true if in a parenthetical expression.
May cache result using `verilog-syntax-ppss'."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (> (nth 0 state) 0 )))
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (> (nth 0 state) 0 )))
+
+(defun verilog-in-paren-count ()
+ "Return paren depth, floor to 0.
+May cache result using `verilog-syntax-ppss'."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (if (> (nth 0 state) 0)
+ (nth 0 state)
+ 0 )))
(defun verilog-in-paren-quick ()
- "Return true if in a parenthetical expression.
+ "Return true if in a parenthetical expression.
Always starts from `point-min', to allow inserts with hooks disabled."
- ;; The -quick refers to its use alongside the other -quick functions,
- ;; not that it's likely to be faster than verilog-in-paren.
- (let ((state (save-excursion (parse-partial-sexp (point-min) (point)))))
- (> (nth 0 state) 0 )))
+ ;; The -quick refers to its use alongside the other -quick functions,
+ ;; not that it's likely to be faster than verilog-in-paren.
+ (let ((state (save-excursion (parse-partial-sexp (point-min) (point)))))
+ (> (nth 0 state) 0 )))
(defun verilog-in-struct-p ()
- "Return true if in a struct declaration."
- (interactive)
- (save-excursion
- (if (verilog-in-paren)
- (progn
- (verilog-backward-up-list 1)
- (verilog-at-struct-p)
- )
- nil)))
+ "Return true if in a struct declaration."
+ (interactive)
+ (save-excursion
+ (if (verilog-in-paren)
+ (progn
+ (verilog-backward-up-list 1)
+ (verilog-at-struct-p)
+ )
+ nil)))
+
+(defun verilog-in-struct-nested-p ()
+ "Return nil for not in struct.
+Return 0 for in non-nested struct.
+Return >0 for nested struct."
+ (interactive)
+ (let (col)
+ (save-excursion
+ (if (verilog-in-paren)
+ (progn
+ (verilog-backward-up-list 1)
+ (setq col (verilog-at-struct-mv-p))
+ (if col
+ (if (verilog-in-struct-p) (current-column) 0)))
+ nil))))
(defun verilog-in-coverage-p ()
- "Return true if in a constraint or coverpoint expression."
- (interactive)
- (save-excursion
- (if (verilog-in-paren)
- (progn
- (verilog-backward-up-list 1)
- (verilog-at-constraint-p)
- )
- nil)))
+ "Return true if in a constraint or coverpoint expression."
+ (interactive)
+ (save-excursion
+ (if (verilog-in-paren)
+ (progn
+ (verilog-backward-up-list 1)
+ (verilog-at-constraint-p)
+ )
+ nil)))
+
(defun verilog-at-close-constraint-p ()
"If at the } that closes a constraint or covergroup, return true."
(if (and
(equal (char-after) ?\})
- (verilog-in-paren))
+ (verilog-in-coverage-p))
(save-excursion
(verilog-backward-ws&directives)
- (if (equal (char-before) ?\;)
+ (if (or (equal (char-before) ?\;)
+ (equal (char-before) ?\}) ; can end with inner constraint { } block or ;
+ (equal (char-before) ?\{)) ; empty constraint block
(point)
nil))))
(defun verilog-at-constraint-p ()
"If at the { of a constraint or coverpoint definition, return true, moving point to constraint."
(if (save-excursion
- (and
- (equal (char-after) ?\{)
- (forward-list)
- (progn (backward-char 1)
- (verilog-backward-ws&directives)
- (equal (char-before) ?\;))))
- ;; maybe
- (verilog-re-search-backward "\\<constraint\\|coverpoint\\|cross\\>" nil 'move)
+ (let ((p (point)))
+ (and
+ (equal (char-after) ?\{)
+ (forward-list)
+ (progn (backward-char 1)
+ (verilog-backward-ws&directives)
+ (and
+ (or (equal (char-before) ?\{) ; empty case
+ (equal (char-before) ?\;)
+ (equal (char-before) ?\}))
+ ;; skip what looks like bus repetition operator {#{
+ (not (string-match "^{\\s-*[0-9]+\\s-*{" (buffer-substring p (point)))))))))
+ (progn
+ (let ( (pt (point)) (pass 0))
+ (verilog-backward-ws&directives)
+ (verilog-backward-token)
+ (if (looking-at (concat "\\<constraint\\|coverpoint\\|cross\\|with\\>\\|" verilog-in-constraint-re))
+ (progn (setq pass 1)
+ (if (looking-at "\\<with\\>")
+ (progn (verilog-backward-ws&directives)
+ (beginning-of-line) ; 1
+ (verilog-forward-ws&directives)
+ 1 )
+ (verilog-beg-of-statement)
+ ))
+ ;; if first word token not keyword, it maybe the instance name
+ ;; check next word token
+ (if (looking-at "\\<\\w+\\>\\|\\s-*(\\s-*\\S-+")
+ (progn (verilog-beg-of-statement)
+ (if (looking-at (concat "\\<\\(constraint\\|"
+ "\\(?:\\w+\\s-*:\\s-*\\)?\\(coverpoint\\|cross\\)"
+ "\\|with\\)\\>\\|" verilog-in-constraint-re))
+ (setq pass 1)))))
+ (if (eq pass 0)
+ (progn (goto-char pt) nil) 1)))
;; not
nil))
(defun verilog-at-struct-p ()
- "If at the { of a struct, return true, moving point to struct."
+ "If at the { of a struct, return true, not moving point."
(save-excursion
(if (and (equal (char-after) ?\{)
(verilog-backward-token))
(looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
nil)))
+(defun verilog-at-struct-mv-p ()
+ "If at the { of a struct, return true, moving point to struct."
+ (let ((pt (point)))
+ (if (and (equal (char-after) ?\{)
+ (verilog-backward-token))
+ (if (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>")
+ (progn (verilog-beg-of-statement) (point))
+ (progn (goto-char pt) nil))
+ (progn (goto-char pt) nil))))
+
+(defun verilog-at-close-struct-p ()
+ "If at the } that closes a struct, return true."
+ (if (and
+ (equal (char-after) ?\})
+ (verilog-in-struct-p))
+ ;; true
+ (save-excursion
+ (if (looking-at "}\\(?:\\s-*\\w+\\s-*\\)?;") 1))
+ ;; false
+ nil))
+
(defun verilog-parenthesis-depth ()
- "Return non zero if in parenthetical-expression."
- (save-excursion (nth 1 (verilog-syntax-ppss))))
+ "Return non zero if in parenthetical-expression."
+ (save-excursion (nth 1 (verilog-syntax-ppss))))
(defun verilog-skip-forward-comment-or-string ()
- "Return true if in a string or comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (cond
- ((nth 3 state) ;Inside string
- (search-forward "\"")
- t)
- ((nth 7 state) ;Inside // comment
- (forward-line 1)
- t)
- ((nth 4 state) ;Inside any comment (hence /**/)
- (search-forward "*/"))
- (t
- nil))))
+ "Return true if in a string or comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (cond
+ ((nth 3 state) ;Inside string
+ (search-forward "\"")
+ t)
+ ((nth 7 state) ;Inside // comment
+ (forward-line 1)
+ t)
+ ((nth 4 state) ;Inside any comment (hence /**/)
+ (search-forward "*/"))
+ (t
+ nil))))
(defun verilog-skip-backward-comment-or-string ()
- "Return true if in a string or comment."
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (cond
- ((nth 3 state) ;Inside string
- (search-backward "\"")
- t)
- ((nth 7 state) ;Inside // comment
- (search-backward "//")
- (skip-chars-backward "/")
- t)
- ((nth 4 state) ;Inside /* */ comment
- (search-backward "/*")
- t)
- (t
- nil))))
+ "Return true if in a string or comment."
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (cond
+ ((nth 3 state) ;Inside string
+ (search-backward "\"")
+ t)
+ ((nth 7 state) ;Inside // comment
+ (search-backward "//")
+ (skip-chars-backward "/")
+ t)
+ ((nth 4 state) ;Inside /* */ comment
+ (search-backward "/*")
+ t)
+ (t
+ nil))))
(defun verilog-skip-backward-comments ()
- "Return true if a comment was skipped."
- (let ((more t))
- (while more
- (setq more
- (let ((state (save-excursion (verilog-syntax-ppss))))
- (cond
- ((nth 7 state) ;Inside // comment
- (search-backward "//")
- (skip-chars-backward "/")
- (skip-chars-backward " \t\n\f")
- t)
- ((nth 4 state) ;Inside /* */ comment
- (search-backward "/*")
- (skip-chars-backward " \t\n\f")
- t)
- ((and (not (bobp))
- (= (char-before) ?\/)
- (= (char-before (1- (point))) ?\*))
- (goto-char (- (point) 2))
- t) ;; Let nth 4 state handle the rest
- ((and (not (bobp))
- (= (char-before) ?\))
- (= (char-before (1- (point))) ?\*))
- (goto-char (- (point) 2))
- (if (search-backward "(*" nil t)
- (progn
- (skip-chars-backward " \t\n\f")
- t)
- (progn
- (goto-char (+ (point) 2))
- nil)))
- (t
- (/= (skip-chars-backward " \t\n\f") 0))))))))
+ "Return true if a comment was skipped."
+ (let ((more t))
+ (while more
+ (setq more
+ (let ((state (save-excursion (verilog-syntax-ppss))))
+ (cond
+ ((nth 7 state) ;Inside // comment
+ (search-backward "//")
+ (skip-chars-backward "/")
+ (skip-chars-backward " \t\n\f")
+ t)
+ ((nth 4 state) ;Inside /* */ comment
+ (search-backward "/*")
+ (skip-chars-backward " \t\n\f")
+ t)
+ ((and (not (bobp))
+ (= (char-before) ?\/)
+ (= (char-before (1- (point))) ?\*))
+ (goto-char (- (point) 2))
+ t) ; Let nth 4 state handle the rest
+ ((and (not (bobp))
+ ;;(verilog-looking-back "\\*)" nil) ;; super slow, use two char-before instead
+ (= (char-before) ?\))
+ (= (char-before (1- (point))) ?\*)
+ (not (verilog-looking-back "(\\s-*\\*)" nil))) ;; slow but unlikely to be called
+ (goto-char (- (point) 2))
+ (if (search-backward "(*" nil t)
+ (progn
+ (skip-chars-backward " \t\n\f")
+ t)
+ (progn
+ (goto-char (+ (point) 2))
+ nil)))
+ (t
+ (/= (skip-chars-backward " \t\n\f") 0))))))))
(defun verilog-skip-forward-comment-p ()
"If in comment, move to end and return true."
@@ -6118,7 +6425,8 @@ Always starts from `point-min', to allow inserts with hooks disabled."
(progn
(goto-char h)
nil))))
- ((looking-at "(\\*")
+ ((and (looking-at "(\\*") ; attribute start, but not an event (*) or (* )
+ (not (looking-at "(\\*\\s-*)")))
(progn
(setq h (point))
(goto-char (match-end 0))
@@ -6173,7 +6481,6 @@ Only look at a few lines to determine indent level."
(cond
((or
(= (preceding-char) ?\,)
- (= (preceding-char) ?\])
(save-excursion
(verilog-beg-of-statement-1)
(looking-at verilog-declaration-re)))
@@ -6184,7 +6491,7 @@ Only look at a few lines to determine indent level."
(verilog-beg-of-statement-1)
(setq fst (point))
(if (looking-at verilog-declaration-re)
- (progn ;; we have multiple words
+ (progn ; we have multiple words
(goto-char (match-end 0))
(skip-chars-forward " \t")
(cond
@@ -6218,7 +6525,11 @@ Only look at a few lines to determine indent level."
(let ((val))
(verilog-beg-of-statement-1)
(if (and (< (point) here)
- (verilog-re-search-forward "=[ \\t]*" here 'move))
+ (verilog-re-search-forward "=[ \\t]*" here 'move)
+ ;; not at a |=>, #=#, or [=n] operator
+ (not (string-match "\\[=.\\|#=#\\||=>"
+ (or (buffer-substring (- (point) 2) (1+ (point)))
+ "")))) ; don't let buffer over/under-run spoil the party
(setq val (current-column))
(setq val (eval (cdr (assoc type verilog-indent-alist)))))
(goto-char here)
@@ -6230,11 +6541,11 @@ Only look at a few lines to determine indent level."
(val (save-excursion
(verilog-backward-up-list 1)
(forward-char 1)
- (if verilog-indent-lists
- (skip-chars-forward " \t")
- (verilog-forward-syntactic-ws))
- (setq here (point))
- (current-column)))
+ (if verilog-indent-lists
+ (skip-chars-forward " \t")
+ (verilog-forward-syntactic-ws))
+ (setq here (point))
+ (current-column)))
(decl (save-excursion
(goto-char here)
@@ -6247,8 +6558,9 @@ Only look at a few lines to determine indent level."
(;-- Handle the ends
(or
- (looking-at verilog-end-block-re )
- (verilog-at-close-constraint-p))
+ (looking-at verilog-end-block-re)
+ (verilog-at-close-constraint-p)
+ (verilog-at-close-struct-p))
(let ((val (if (eq type 'statement)
(- ind verilog-indent-level)
ind)))
@@ -6273,9 +6585,16 @@ Only look at a few lines to determine indent level."
(and (or
(eq type 'defun)
(eq type 'block))
- (looking-at verilog-declaration-re))
+ (looking-at verilog-declaration-re)
+ ;; Do not consider "virtual function", "virtual task", "virtual class"
+ ;; as declarations
+ (not (looking-at (concat verilog-declaration-re
+ "\\s-+\\(function\\|task\\|class\\)\\b"))))
(verilog-indent-declaration ind))
+ (;-- form feeds - ignored as bug in indent-line-to in < 24.5
+ (looking-at "\f"))
+
(;-- Everything else
t
(let ((val (eval (cdr (assoc type verilog-indent-alist)))))
@@ -6324,7 +6643,7 @@ Do not count named blocks or case-statements."
(re-search-backward "/\\*" nil t)
(1+(current-column))))
(comment-column
- comment-column )
+ comment-column )
(t
(save-excursion
(re-search-backward "//" nil t)
@@ -6354,12 +6673,12 @@ Do not count named blocks or case-statements."
(save-excursion
(forward-line -1)
(skip-chars-forward " \t")
- (looking-at "\*")))
+ (looking-at "\\*")))
(insert "* ")))))
-(defun verilog-comment-indent (&optional arg)
+(defun verilog-comment-indent (&optional _arg)
"Return the column number the line should be indented to.
-ARG is ignored, for `comment-indent-function' compatibility."
+_ARG is ignored, for `comment-indent-function' compatibility."
(cond
((verilog-in-star-comment-p)
(save-excursion
@@ -6398,11 +6717,11 @@ Be verbose about progress unless optional QUIET set."
)
(save-excursion
(if (progn
-; (verilog-beg-of-statement-1)
- (beginning-of-line)
- (verilog-forward-syntactic-ws)
- (and (not (verilog-in-directive-p)) ;; could have `define input foo
- (looking-at verilog-declaration-re)))
+ ;; (verilog-beg-of-statement-1)
+ (beginning-of-line)
+ (verilog-forward-syntactic-ws)
+ (and (not (verilog-in-directive-p)) ; could have `define input foo
+ (looking-at verilog-declaration-re)))
(progn
(if (verilog-parenthesis-depth)
;; in an argument list or parameter block
@@ -6410,7 +6729,7 @@ Be verbose about progress unless optional QUIET set."
start (progn
(goto-char e)
(verilog-backward-up-list 1)
- (forward-line) ;; ignore ( input foo,
+ (forward-line) ; ignore ( input foo,
(verilog-re-search-forward verilog-declaration-re el 'move)
(goto-char (match-beginning 0))
(skip-chars-backward " \t")
@@ -6425,10 +6744,9 @@ Be verbose about progress unless optional QUIET set."
endpos (set-marker (make-marker) end)
base-ind (progn
(goto-char start)
- (forward-char 1)
- (skip-chars-forward " \t")
- (current-column))
- )
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (current-column)))
;; in a declaration block (not in argument list)
(setq
start (progn
@@ -6470,11 +6788,11 @@ Be verbose about progress unless optional QUIET set."
(cond
((save-excursion (skip-chars-backward " \t")
(bolp))
- (verilog-forward-ws&directives)
- (indent-line-to base-ind)
- (verilog-forward-ws&directives)
- (if (< (point) e)
- (verilog-re-search-forward "[ \t\n\f]" e 'move)))
+ (verilog-forward-ws&directives)
+ (indent-line-to base-ind)
+ (verilog-forward-ws&directives)
+ (if (< (point) e)
+ (verilog-re-search-forward "[ \t\n\f]" e 'move)))
(t
(just-one-space)
(verilog-re-search-forward "[ \t\n\f]" e 'move)))
@@ -6489,7 +6807,7 @@ Be verbose about progress unless optional QUIET set."
(> r 0))
(setq e (point))
(unless quiet (message "%d" r))
- ;;(verilog-do-indent (verilog-calculate-indent)))
+ ;; (verilog-do-indent (verilog-calculate-indent)))
(verilog-forward-ws&directives)
(cond
((or (and verilog-indent-declaration-macros
@@ -6521,8 +6839,8 @@ Be verbose about progress unless optional QUIET set."
(forward-line 1))
(unless quiet (message "")))))))
-(defun verilog-pretty-expr (&optional quiet myre)
- "Line up expressions around point, optionally QUIET with regexp MYRE ignored."
+(defun verilog-pretty-expr (&optional quiet _myre)
+ "Line up expressions around point, optionally QUIET with regexp _MYRE ignored."
(interactive)
(if (not (verilog-in-comment-or-string-p))
(save-excursion
@@ -6603,7 +6921,7 @@ Be verbose about progress unless optional QUIET set."
(cond
((looking-at verilog-assignment-operation-re)
(goto-char (match-beginning 2))
- (if (not (or (verilog-in-parenthesis-p) ;; leave attributes and comparisons alone
+ (if (not (or (verilog-in-parenthesis-p) ; leave attributes and comparisons alone
(verilog-in-coverage-p)))
(if (eq (char-after) ?=)
(indent-to (1+ ind)) ; line up the = of the <= with surrounding =
@@ -6736,7 +7054,7 @@ Region is defined by B and EDPOS."
(while (progn (setq e (marker-position edpos))
(< (point) e))
(if (and (verilog-re-search-forward myre e 'move)
- (not (verilog-in-attribute-p))) ;; skip attribute exprs
+ (not (verilog-in-attribute-p))) ; skip attribute exprs
(progn
(goto-char (match-beginning 2))
(verilog-backward-syntactic-ws)
@@ -6759,9 +7077,8 @@ Region is defined by B and EDPOS."
((b (prog2
(beginning-of-line)
(point-marker)
- (end-of-line)))
- (e (point-marker)))
- (if (re-search-backward " /\\* \[#-\]# \[a-zA-Z\]+ \[0-9\]+ ## \\*/" b t)
+ (end-of-line))))
+ (if (re-search-backward " /\\* [#-]# [a-zA-Z]+ [0-9]+ ## \\*/" b t)
(progn
(replace-match " /* -# ## */")
(end-of-line))
@@ -6772,9 +7089,8 @@ Region is defined by B and EDPOS."
(insert
(format "%s %d" type val))))
-;;
-;;
-;; Completion
+
+;;; Completion:
;;
(defvar verilog-str nil)
(defvar verilog-all nil)
@@ -6905,14 +7221,14 @@ will be completed at runtime and should not be added to this list.")
(defun verilog-func-completion (type)
"Build regular expression for module/task/function names.
-TYPE is 'module, 'tf for task or function, or t if unknown."
+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 'tf) "\\<\\(task\\|function\\)\\s +")
- (t "\\<\\(task\\|function\\|module\\)\\s +"))
- "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
+ ((eq type 'module) "\\<\\(module\\)\\s +")
+ ((eq type 'tf) "\\<\\(task\\|function\\)\\s +")
+ (t "\\<\\(task\\|function\\|module\\)\\s +"))
+ "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>"))
match)
(if (not (looking-at verilog-defun-re))
@@ -6952,24 +7268,6 @@ for matches of `str' and adding the occurrence tp `all' through point END."
(forward-line 1)))
verilog-all)
-(defun verilog-type-completion ()
- "Calculate all possible completions for types."
- (let ((start (point))
- goon)
- ;; Search for all reachable type declarations
- (while (or (verilog-beg-of-defun)
- (setq goon (not goon)))
- (save-excursion
- (if (and (< start (prog1 (save-excursion (verilog-end-of-defun)
- (point))
- (forward-char 1)))
- (verilog-re-search-forward
- "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
- start t)
- (not (match-end 1)))
- ;; Check current type declaration
- (verilog-get-completion-decl start))))))
-
(defun verilog-var-completion ()
"Calculate all possible completions for variables (or constants)."
(let ((start (point)))
@@ -6996,7 +7294,7 @@ must be a function to be called for every match to check if this should
really be a match. If VERILOG-FLAG is t, the function returns a list of
all possible completions. If VERILOG-FLAG is nil it returns a string,
the longest possible completion, or t if VERILOG-STR is an exact match.
-If VERILOG-FLAG is 'lambda, the function returns t if VERILOG-STR is an
+If VERILOG-FLAG is `lambda', the function returns t if VERILOG-STR is an
exact match, nil otherwise."
(save-excursion
(let ((verilog-all nil))
@@ -7053,6 +7351,7 @@ exact match, nil otherwise."
;; Return nil if there was no matching label
nil
;; Get longest string common in the labels
+ ;; FIXME: Why not use `try-completion'?
(let* ((elm (cdr verilog-all))
(match (car verilog-all))
(min (length match))
@@ -7089,6 +7388,7 @@ exact match, nil otherwise."
"Complete word at current point.
\(See also `verilog-toggle-completions', `verilog-type-keywords',
and `verilog-separator-keywords'.)"
+ ;; FIXME: Provide completion-at-point-function.
(interactive)
(let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
(e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
@@ -7189,7 +7489,7 @@ VERILOG-PRED is non-nil, it must be a function to be called for every match
to check if this should really be a match. If VERILOG-FLAG is t, the
function returns a list of all possible completions. If it is nil it
returns a string, the longest possible completion, or t if VERILOG-STR is
-an exact match. If VERILOG-FLAG is 'lambda, the function returns t if
+an exact match. If VERILOG-FLAG is `lambda', the function returns t if
VERILOG-STR is an exact match, nil otherwise."
(save-excursion
(let ((verilog-all nil)
@@ -7268,7 +7568,7 @@ If search fails, other files are checked based on
(regexp "\\(module\\s-+\\w+\\s-*(\\)\\|\\(\\w+\\s-+\\w+\\s-*(\\)"))
(with-output-to-temp-buffer "*Occur*"
(save-excursion
- (message (format "Searching for %s ..." regexp))
+ (message "Searching for %s ..." regexp)
;; Find next match, but give up if prev match was at end of buffer.
(while (and (not (= prevpos (point-max)))
(verilog-re-search-forward regexp nil t))
@@ -7286,7 +7586,7 @@ If search fails, other files are checked based on
(goto-char (match-end 0))
(if (> nlines 0)
(forward-line (1+ nlines))
- (forward-line 1))
+ (forward-line 1))
(point)))
(tag (format "%3d" linenum))
(empty (make-string (length tag) ?\ ))
@@ -7318,6 +7618,7 @@ If search fails, other files are checked based on
;; Highlight helper functions
(defconst verilog-directive-regexp "\\(translate\\|coverage\\|lint\\)_")
+
(defun verilog-within-translate-off ()
"Return point if within translate-off region, else nil."
(and (save-excursion
@@ -7330,15 +7631,15 @@ 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\\>")
- limit t)
+ (concat "//\\s-*.*\\s-*" 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\\>")
- limit t)
+ (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>")
+ limit t)
(match-beginning 0)))
(defun verilog-end-translate-off (limit)
@@ -7384,7 +7685,7 @@ Bound search by LIMIT. Adapted from
See also `verilog-sk-header' for an alternative format."
(interactive)
(let ((start (point)))
- (insert "\
+ (insert "\
//-----------------------------------------------------------------------------
// Title : <title>
// Project : <project>
@@ -7456,8 +7757,7 @@ See also `verilog-sk-header' for an alternative format."
(insert (format-time-string "%Y")))
-;;
-;; Signal list parsing
+;;; Signal list parsing:
;;
;; Elements of a signal list
@@ -7466,11 +7766,11 @@ See also `verilog-sk-header' for an alternative format."
(list name bits comment mem enum signed type multidim modport))
(defsubst verilog-sig-name (sig)
(car sig))
-(defsubst verilog-sig-bits (sig)
+(defsubst verilog-sig-bits (sig) ; First element of packed array (pre signal-name)
(nth 1 sig))
(defsubst verilog-sig-comment (sig)
(nth 2 sig))
-(defsubst verilog-sig-memory (sig)
+(defsubst verilog-sig-memory (sig) ; Unpacked array (post signal-name)
(nth 3 sig))
(defsubst verilog-sig-enum (sig)
(nth 4 sig))
@@ -7480,7 +7780,7 @@ See also `verilog-sk-header' for an alternative format."
(nth 6 sig))
(defsubst verilog-sig-type-set (sig type)
(setcar (nthcdr 6 sig) type))
-(defsubst verilog-sig-multidim (sig)
+(defsubst verilog-sig-multidim (sig) ; Second and additional elements of packed array
(nth 7 sig))
(defsubst verilog-sig-multidim-string (sig)
(if (verilog-sig-multidim sig)
@@ -7512,11 +7812,11 @@ See also `verilog-sk-header' for an alternative format."
(defsubst verilog-modport-name (sig)
(car sig))
(defsubst verilog-modport-clockings (sig)
- (nth 1 sig)) ;; Returns list of names
+ (nth 1 sig)) ; Returns list of names
(defsubst verilog-modport-clockings-add (sig val)
(setcar (nthcdr 1 sig) (cons val (nth 1 sig))))
(defsubst verilog-modport-decls (sig)
- (nth 2 sig)) ;; Returns verilog-decls-* structure
+ (nth 2 sig)) ; Returns verilog-decls-* structure
(defsubst verilog-modport-decls-set (sig val)
(setcar (nthcdr 2 sig) val))
@@ -7528,7 +7828,7 @@ See also `verilog-sk-header' for an alternative format."
(aref modi 1))
(defsubst verilog-modi-get-point (modi)
(aref modi 2))
-(defsubst verilog-modi-get-type (modi) ;; "module" or "interface"
+(defsubst verilog-modi-get-type (modi) ; "module" or "interface"
(aref modi 3))
(defsubst verilog-modi-get-decls (modi)
(verilog-modi-cache-results modi 'verilog-read-decls))
@@ -7554,8 +7854,8 @@ See also `verilog-sk-header' for an alternative format."
(aref decls 2))
(defsubst verilog-decls-get-vars (decls)
(aref decls 3))
-(defsubst verilog-decls-get-modports (decls) ;; Also for clocking blocks; contains another verilog-decls struct
- (aref decls 4)) ;; Returns verilog-modport* structure
+(defsubst verilog-decls-get-modports (decls) ; Also for clocking blocks; contains another verilog-decls struct
+ (aref decls 4)) ; Returns verilog-modport* structure
(defsubst verilog-decls-get-assigns (decls)
(aref decls 5))
(defsubst verilog-decls-get-consts (decls)
@@ -7642,6 +7942,48 @@ Signals must be in standard (base vector) form."
(nreverse out-list)))))
;;(verilog-signals-not-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("EXT" "")))
+(defun verilog-signals-not-in-struct (in-list not-list)
+ "Return list of signals in IN-LIST that aren't also in NOT-LIST.
+Also remove any duplicates in IN-LIST.
+Any structure in not-list will remove all members in in-list.
+Signals must be in standard (base vector) form."
+ (cond ((eval-when-compile (fboundp 'make-hash-table))
+ (let ((ht (make-hash-table :test 'equal :rehash-size 4.0))
+ out-list addit nm)
+ (while not-list
+ (puthash (car (car not-list)) t ht)
+ (setq not-list (cdr not-list)))
+ (while in-list
+ (setq nm (verilog-sig-name (car in-list)))
+ (when (not (gethash nm ht))
+ (setq addit t)
+ (while (string-match "^\\([^\\].*\\)\\.[^.]+$" nm)
+ (setq nm (match-string 1 nm))
+ (setq addit (and addit
+ (not (gethash nm ht)))))
+ (when addit
+ (setq out-list (cons (car in-list) out-list))
+ (puthash (verilog-sig-name (car in-list)) t ht)))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))
+ ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4)
+ (t
+ (let (out-list addit nm)
+ (while in-list
+ (setq nm (verilog-sig-name (car in-list)))
+ (when (and (not (assoc nm not-list))
+ (not (assoc nm out-list)))
+ (setq addit t)
+ (while (string-match "^\\([^\\].*\\)\\.[^.]+$" nm)
+ (setq nm (match-string 1 nm))
+ (setq addit (and addit
+ (not (assoc nm not-list)))))
+ (when addit
+ (setq out-list (cons (car in-list) out-list))))
+ (setq in-list (cdr in-list)))
+ (nreverse out-list)))))
+;;(verilog-signals-not-in-struct '(("A" "") ("B" "") ("DEL.SUB.A" "[2:3]")) '(("DEL.SUB" "") ("EXT" "")))
+
(defun verilog-signals-memory (in-list)
"Return list of signals in IN-LIST that are memorized (multidimensional)."
(let (out-list)
@@ -7660,13 +8002,14 @@ Signals must be in standard (base vector) form."
"Return list of signals in IN-LIST that aren't parameters or numeric constants."
(let (out-list)
(while in-list
+ ;; Namespace intentionally short for AUTOs and compatibility
(unless (boundp (intern (concat "vh-" (verilog-sig-name (car in-list)))))
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
(nreverse out-list)))
(defun verilog-signals-with (func in-list)
- "Return IN-LIST with only signals where FUNC passed each signal is true."
+ "Return list of signals where FUNC is true executed on each signal in IN-LIST."
(let (out-list)
(while in-list
(when (funcall func (car in-list))
@@ -7677,7 +8020,8 @@ Signals must be in standard (base vector) form."
(defun verilog-signals-combine-bus (in-list)
"Return a list of signals in IN-LIST, with buses combined.
Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
- (let (combo buswarn
+ (let (combo
+ buswarn
out-list
sig highbit lowbit ; Temp information about current signal
sv-name sv-highbit sv-lowbit ; Details about signal we are forming
@@ -7729,10 +8073,10 @@ Duplicate signals are also removed. For example A[2] and A[1] become A[2:1]."
;; Combine with this signal
(when (and sv-busstring
(not (equal sv-busstring (verilog-sig-bits sig))))
- (when nil ;; Debugging
- (message (concat "Warning, can't merge into single bus "
- sv-name bus
- ", the AUTOs may be wrong")))
+ (when nil ; Debugging
+ (message (concat "Warning, can't merge into single bus %s%s"
+ ", the AUTOs may be wrong")
+ sv-name bus))
(setq buswarn ", Couldn't Merge"))
(if (verilog-sig-comment sig) (setq combo ", ..."))
(setq sv-memory (or sv-memory (verilog-sig-memory sig))
@@ -7764,7 +8108,7 @@ Tieoff value uses `verilog-active-low-regexp' and
`verilog-auto-reset-widths'."
(concat
(if (and verilog-active-low-regexp
- (string-match verilog-active-low-regexp (verilog-sig-name sig)))
+ (verilog-string-match-fold verilog-active-low-regexp (verilog-sig-name sig)))
"~" "")
(cond ((not verilog-auto-reset-widths)
"0")
@@ -7785,7 +8129,8 @@ Tieoff value uses `verilog-active-low-regexp' and
;;
(defun verilog-decls-princ (decls &optional header prefix)
- "For debug, dump the `verilog-read-decls' structure DECLS."
+ "For debug, dump the `verilog-read-decls' structure DECLS.
+Use optional HEADER and PREFIX."
(when decls
(if header (princ header))
(setq prefix (or prefix ""))
@@ -7829,7 +8174,7 @@ Tieoff value uses `verilog-active-low-regexp' and
(princ "\n")))))
(defun verilog-modport-princ (modports &optional header prefix)
- "For debug, dump internal MODPORT structures, with HEADER and PREFIX."
+ "For debug, dump internal MODPORTS structures, with HEADER and PREFIX."
(when modports
(if header (princ header))
(while modports
@@ -7849,29 +8194,35 @@ Tieoff value uses `verilog-active-low-regexp' and
(defun verilog-read-inst-backward-name ()
"Internal. Move point back to beginning of inst-name."
- (verilog-backward-open-paren)
- (let (done)
- (while (not done)
- (verilog-re-search-backward-quick "\\()\\|\\b[a-zA-Z0-9`_\$]\\|\\]\\)" nil nil) ; ] isn't word boundary
- (cond ((looking-at ")")
- (verilog-backward-open-paren))
- (t (setq done t)))))
- (while (looking-at "\\]")
- (verilog-backward-open-bracket)
- (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|\\]\\)" nil nil))
- (skip-chars-backward "a-zA-Z0-9`_$"))
+ (verilog-backward-open-paren)
+ (let (done)
+ (while (not done)
+ (verilog-re-search-backward-quick "\\()\\|\\b[a-zA-Z0-9`_$]\\|\\]\\)" nil nil) ; ] isn't word boundary
+ (cond ((looking-at ")")
+ (verilog-backward-open-paren))
+ (t (setq done t)))))
+ (while (looking-at "\\]")
+ (verilog-backward-open-bracket)
+ (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_$]\\|\\]\\)" nil nil))
+ (skip-chars-backward "a-zA-Z0-9`_$"))
(defun verilog-read-inst-module-matcher ()
"Set match data 0 with module_name when point is inside instantiation."
(verilog-read-inst-backward-name)
;; Skip over instantiation name
- (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil) ; ) isn't word boundary
+ (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_$]\\|)\\)" nil nil) ; ) isn't word boundary
;; Check for parameterized instantiations
(when (looking-at ")")
(verilog-backward-open-paren)
- (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_\$]" nil nil))
+ (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_$]" nil nil))
(skip-chars-backward "a-zA-Z0-9'_$")
- (looking-at "[a-zA-Z0-9`_\$]+")
+ ;; #1 is legal syntax for gate primitives
+ (when (save-excursion
+ (verilog-backward-syntactic-ws-quick)
+ (eq ?# (char-before)))
+ (verilog-re-search-backward-quick "\\b[a-zA-Z0-9`_$]" nil nil)
+ (skip-chars-backward "a-zA-Z0-9'_$"))
+ (looking-at "[a-zA-Z0-9`_$]+")
;; Important: don't use match string, this must work with Emacs 19 font-lock on
(buffer-substring-no-properties (match-beginning 0) (match-end 0))
;; Caller assumes match-beginning/match-end is still set
@@ -7886,7 +8237,7 @@ Tieoff value uses `verilog-active-low-regexp' and
"Return instance_name when point is inside instantiation."
(save-excursion
(verilog-read-inst-backward-name)
- (looking-at "[a-zA-Z0-9`_\$]+")
+ (looking-at "[a-zA-Z0-9`_$]+")
;; Important: don't use match string, this must work with Emacs 19 font-lock on
(buffer-substring-no-properties (match-beginning 0) (match-end 0))))
@@ -7897,7 +8248,7 @@ Tieoff value uses `verilog-active-low-regexp' and
;; Due to "module x import y (" we must search for declaration begin
(verilog-re-search-backward-quick verilog-defun-re nil nil)
(goto-char (match-end 0))
- (verilog-re-search-forward-quick "\\b[a-zA-Z0-9`_\$]+" nil nil)
+ (verilog-re-search-forward-quick "\\b[a-zA-Z0-9`_$]+" nil nil)
;; Important: don't use match string, this must work with Emacs 19 font-lock on
(verilog-symbol-detick
(buffer-substring-no-properties (match-beginning 0) (match-end 0)) t)))
@@ -7907,7 +8258,7 @@ Tieoff value uses `verilog-active-low-regexp' and
(save-excursion
(verilog-read-inst-backward-name)
;; Skip over instantiation name
- (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_\$]\\|)\\)" nil nil) ; ) isn't word boundary
+ (verilog-re-search-backward-quick "\\(\\b[a-zA-Z0-9`_$]\\|)\\)" nil nil) ; ) isn't word boundary
;; If there are parameterized instantiations
(when (looking-at ")")
(let ((end-pt (point))
@@ -7915,9 +8266,9 @@ Tieoff value uses `verilog-active-low-regexp' and
param-name paren-beg-pt param-value)
(verilog-backward-open-paren)
(while (verilog-re-search-forward-quick "\\." end-pt t)
- (verilog-re-search-forward-quick "\\([a-zA-Z0-9`_\$]\\)" nil nil)
+ (verilog-re-search-forward-quick "\\([a-zA-Z0-9`_$]\\)" nil nil)
(skip-chars-backward "a-zA-Z0-9'_$")
- (looking-at "[a-zA-Z0-9`_\$]+")
+ (looking-at "[a-zA-Z0-9`_$]+")
(setq param-name (buffer-substring-no-properties
(match-beginning 0) (match-end 0)))
(verilog-re-search-forward-quick "(" nil nil)
@@ -7951,9 +8302,9 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters."
(defun verilog-read-decls ()
"Compute signal declaration information for the current module at point.
Return an array of [outputs inouts inputs wire reg assign const]."
- (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max)))
+ (let ((end-mod-point (or (verilog-get-end-of-defun) (point-max)))
(functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t)
- in-modport in-clocking ptype ign-prop
+ in-modport in-clocking in-ign-to-semi ptype ign-prop
sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const
sigs-gparam sigs-intf sigs-modports
vec expect-signal keywd newsig rvalue enum io signed typedefed multidim
@@ -7982,22 +8333,27 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(or (search-forward "*)")
(error "%s: Unmatched (* *), at char %d" (verilog-point-text) (point))))
((eq ?\" (following-char))
- (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first
+ (or (re-search-forward "[^\\]\"" nil t) ; don't forward-char first, since we look for a non backslash first
(error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point))))
((eq ?\; (following-char))
- (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration
- (verilog-modport-decls-set
- in-modport
- (verilog-decls-new sigs-out sigs-inout sigs-in
- nil nil nil nil nil nil))
- ;; Pop from varstack to restore state to pre-clocking
- (setq tmp (car varstack)
- varstack (cdr varstack)
- sigs-out (aref tmp 0)
- sigs-inout (aref tmp 1)
- sigs-in (aref tmp 2)))
- (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
- v2kargs-ok nil in-modport nil ign-prop nil)
+ (cond (in-ign-to-semi ; Such as inside a "import ...;" in a module header
+ (setq in-ign-to-semi nil))
+ ((and in-modport (not (eq in-modport t))) ; end of a modport declaration
+ (verilog-modport-decls-set
+ in-modport
+ (verilog-decls-new sigs-out sigs-inout sigs-in
+ nil nil nil nil nil nil))
+ ;; Pop from varstack to restore state to pre-clocking
+ (setq tmp (car varstack)
+ varstack (cdr varstack)
+ sigs-out (aref tmp 0)
+ sigs-inout (aref tmp 1)
+ sigs-in (aref tmp 2))
+ (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
+ v2kargs-ok nil in-modport nil ign-prop nil))
+ (t
+ (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil
+ v2kargs-ok nil in-modport nil ign-prop nil)))
(forward-char 1))
((eq ?= (following-char))
(setq rvalue t newsig nil)
@@ -8022,11 +8378,11 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(if (verilog-sig-memory newsig)
(concat (verilog-sig-memory newsig) (match-string 1))
(match-string 1))))
- (vec ;; Multidimensional
+ (vec ; Multidimensional
(setq multidim (cons vec multidim))
(setq vec (verilog-string-replace-matches
"\\s-+" "" nil nil (match-string 1))))
- (t ;; Bit width
+ (t ; Bit width
(setq vec (verilog-string-replace-matches
"\\s-+" "" nil nil (match-string 1))))))
;; Normal or escaped identifier -- note we remember the \ if escaped
@@ -8034,13 +8390,13 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(goto-char (match-end 0))
(setq keywd (match-string 1))
(when (string-match "^\\\\" (match-string 1))
- (setq keywd (concat keywd " "))) ;; Escaped ID needs space at end
+ (setq keywd (concat keywd " "))) ; Escaped ID needs space at end
;; Add any :: package names to same identifier
(while (looking-at "\\s-*::\\s-*\\([a-zA-Z0-9`_$]+\\|\\\\[^ \t\n\f]+\\)")
(goto-char (match-end 0))
(setq keywd (concat keywd "::" (match-string 1)))
(when (string-match "^\\\\" (match-string 1))
- (setq keywd (concat keywd " ")))) ;; Escaped ID needs space at end
+ (setq keywd (concat keywd " ")))) ; Escaped ID needs space at end
(cond ((equal keywd "input")
(setq vec nil enum nil rvalue nil newsig nil signed nil
typedefed nil multidim nil ptype nil modport nil
@@ -8081,10 +8437,9 @@ Return an array of [outputs inouts inputs wire reg assign const]."
typedefed nil multidim nil ptype nil modport nil
expect-signal 'sigs-assign sig-paren paren))
((member keywd '("localparam" "genvar"))
- (unless io
- (setq vec nil enum nil rvalue nil signed nil
- typedefed nil multidim nil ptype nil modport nil
- expect-signal 'sigs-const sig-paren paren)))
+ (setq vec nil enum nil rvalue nil signed nil
+ typedefed nil multidim nil ptype nil modport nil
+ expect-signal 'sigs-const sig-paren paren))
((member keywd '("signed" "unsigned"))
(setq signed keywd))
((member keywd '("assert" "assume" "cover" "expect" "restrict"))
@@ -8100,15 +8455,25 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(setq in-modport t))
((equal keywd "clocking")
(setq in-clocking t))
+ ((equal keywd "import")
+ (if v2kargs-ok ; import in module header, not a modport import
+ (setq in-ign-to-semi t rvalue t)))
((equal keywd "type")
(setq ptype t))
+ ((equal keywd "var"))
;; Ifdef? Ignore name of define
((member keywd '("`ifdef" "`ifndef" "`elsif"))
(setq rvalue t))
;; Type?
((unless ptype
(verilog-typedef-name-p keywd))
- (setq typedefed keywd))
+ (cond (io
+ (setq typedefed
+ (if typedefed (concat typedefed " " keywd) keywd)))
+ (t (setq vec nil enum nil rvalue nil signed nil
+ typedefed keywd ; Have a type
+ multidim nil sig-paren paren
+ expect-signal 'sigs-var modport nil))))
;; Interface with optional modport in v2k arglist?
;; Skip over parsing modport, and take the interface name as the type
((and v2kargs-ok
@@ -8168,6 +8533,7 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(eq functask 0)
(not (member keywd verilog-keywords)))
;; Add new signal to expect-signal's variable
+ ;;(if dbg (setq dbg (concat dbg (format "Pt %s New sig %s'\n" (point) keywd))))
(setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport))
(set expect-signal (cons newsig
(symbol-value expect-signal))))))
@@ -8199,9 +8565,17 @@ Return an array of [outputs inouts inputs wire reg assign const]."
;; - we want an error when we are debugging this code if they are refed.
(defvar sigs-in)
(defvar sigs-inout)
- (defvar sigs-out)
(defvar sigs-intf)
- (defvar sigs-intfd))
+ (defvar sigs-intfd)
+ (defvar sigs-out)
+ (defvar sigs-out-d)
+ (defvar sigs-out-i)
+ (defvar sigs-out-unk)
+ (defvar sigs-temp)
+ ;; These are known to be from other packages and may not be defined
+ (defvar diff-command nil)
+ ;; There are known to be from newer versions of Emacs
+ (defvar create-lockfiles))
(defun verilog-read-sub-decls-sig (submoddecls comment port sig vec multidim)
"For `verilog-read-sub-decls-line', add a signal."
@@ -8215,7 +8589,7 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(if vec (setq vec (verilog-symbol-detick-denumber vec)))
(if multidim (setq multidim (mapcar `verilog-symbol-detick-denumber multidim)))
(unless (or (not sig)
- (equal sig "")) ;; Ignore .foo(1'b1) assignments
+ (equal sig "")) ; Ignore .foo(1'b1) assignments
(cond ((or (setq portdata (assoc port (verilog-decls-get-inouts submoddecls)))
(equal "inout" verilog-read-sub-decls-gate-ios))
(setq sigs-inout
@@ -8293,7 +8667,7 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(defun verilog-read-sub-decls-expr (submoddecls comment port expr)
"For `verilog-read-sub-decls-line', parse a subexpression and add signals."
- ;;(message "vrsde: '%s'" expr)
+ ;;(message "vrsde: `%s'" expr)
;; Replace special /*[....]*/ comments inserted by verilog-auto-inst-port
(setq expr (verilog-string-replace-matches "/\\*\\(\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr))
;; Remove front operators
@@ -8312,25 +8686,25 @@ Return an array of [outputs inouts inputs wire reg assign const]."
(let (sig vec multidim)
;; Remove leading reduction operators, etc
(setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr))
- ;;(message "vrsde-ptop: '%s'" expr)
- (cond ;; Find \signal. Final space is part of escaped signal name
+ ;;(message "vrsde-ptop: `%s'" expr)
+ (cond ; Find \signal. Final space is part of escaped signal name
((string-match "^\\s-*\\(\\\\[^ \t\n\f]+\\s-\\)" expr)
- ;;(message "vrsde-s: '%s'" (match-string 1 expr))
+ ;;(message "vrsde-s: `%s'" (match-string 1 expr))
(setq sig (match-string 1 expr)
expr (substring expr (match-end 0))))
;; Find signal
((string-match "^\\s-*\\([a-zA-Z_][a-zA-Z_0-9]*\\)" expr)
- ;;(message "vrsde-s: '%s'" (match-string 1 expr))
+ ;;(message "vrsde-s: `%s'" (match-string 1 expr))
(setq sig (verilog-string-remove-spaces (match-string 1 expr))
expr (substring expr (match-end 0)))))
;; Find [vector] or [multi][multi][multi][vector]
(while (string-match "^\\s-*\\(\\[[^]]+\\]\\)" expr)
- ;;(message "vrsde-v: '%s'" (match-string 1 expr))
+ ;;(message "vrsde-v: `%s'" (match-string 1 expr))
(when vec (setq multidim (cons vec multidim)))
(setq vec (match-string 1 expr)
expr (substring expr (match-end 0))))
;; If found signal, and nothing unrecognized, add the signal
- ;;(message "vrsde-rem: '%s'" expr)
+ ;;(message "vrsde-rem: `%s'" expr)
(when (and sig (string-match "^\\s-*$" expr))
(verilog-read-sub-decls-sig submoddecls comment port sig vec multidim))))))
@@ -8347,7 +8721,7 @@ Inserts the list of signals found, using submodi to look up each port."
(goto-char (match-end 0)))
;; .\escaped (
((looking-at "\\s-*\\.\\s-*\\(\\\\[^ \t\n\f]*\\)\\s-*(\\s-*")
- (setq port (concat (match-string 1) " ")) ;; escaped id's need trailing space
+ (setq port (concat (match-string 1) " ")) ; escaped id's need trailing space
(goto-char (match-end 0)))
;; .name
((looking-at "\\s-*\\.\\s-*\\([a-zA-Z0-9`_$]*\\)\\s-*[,)/]")
@@ -8363,10 +8737,10 @@ Inserts the list of signals found, using submodi to look up each port."
(setq port nil))
;; random
((looking-at "\\s-*\\.[^(]*(")
- (setq port nil) ;; skip this line
+ (setq port nil) ; skip this line
(goto-char (match-end 0)))
(t
- (setq port nil done t))) ;; Unknown, ignore rest of line
+ (setq port nil done t))) ; Unknown, ignore rest of line
;; Get signal name. Point is at the first-non-space after (
;; We intentionally ignore (non-escaped) signals with .s in them
;; this prevents AUTOWIRE etc from noticing hierarchical sigs.
@@ -8443,7 +8817,7 @@ Outputs comments above subcell signals, for example:
// Inputs
.in (in));"
(save-excursion
- (let ((end-mod-point (verilog-get-end-of-defun t))
+ (let ((end-mod-point (verilog-get-end-of-defun))
st-point end-inst-point
;; below 3 modified by verilog-read-sub-decls-line
sigs-out sigs-inout sigs-in sigs-intf sigs-intfd)
@@ -8458,7 +8832,7 @@ Outputs comments above subcell signals, for example:
(subprim (member submod verilog-gate-keywords))
(comment (concat inst " of " submod ".v"))
submodi submoddecls)
- (cond
+ (cond
(subprim
(setq submodi `primitive
submoddecls (verilog-decls-new nil nil nil nil nil nil nil nil nil)
@@ -8482,19 +8856,19 @@ Outputs comments above subcell signals, for example:
;; However I want it to be runnable even on user's manually added signals
(let ((verilog-read-sub-decls-in-interfaced t))
(while (re-search-forward "\\s *(?\\s *// Interfaced" end-inst-point t)
- (verilog-read-sub-decls-line submoddecls comment))) ;; Modifies sigs-ifd
+ (verilog-read-sub-decls-line submoddecls comment))) ; Modifies sigs-ifd
(goto-char st-point)
(while (re-search-forward "\\s *(?\\s *// Interfaces" end-inst-point t)
- (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out
+ (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-out
(goto-char st-point)
(while (re-search-forward "\\s *(?\\s *// Outputs" end-inst-point t)
- (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-out
+ (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-out
(goto-char st-point)
(while (re-search-forward "\\s *(?\\s *// Inouts" end-inst-point t)
- (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-inout
+ (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-inout
(goto-char st-point)
(while (re-search-forward "\\s *(?\\s *// Inputs" end-inst-point t)
- (verilog-read-sub-decls-line submoddecls comment)) ;; Modifies sigs-in
+ (verilog-read-sub-decls-line submoddecls comment)) ; Modifies sigs-in
)))))))
;; Combine duplicate bits
;;(setq rr (vector sigs-out sigs-inout sigs-in))
@@ -8509,7 +8883,7 @@ Outputs comments above subcell signals, for example:
"Return an array of [ pins ] for the current instantiation at point.
For example if declare A A (.B(SIG)) then B will be included in the list."
(save-excursion
- (let ((end-mod-point (point)) ;; presume at /*AUTOINST*/ point
+ (let ((end-mod-point (point)) ; presume at /*AUTOINST*/ point
pins pin)
(verilog-backward-open-paren)
(while (re-search-forward "\\.\\([^(,) \t\n\f]*\\)\\s-*" end-mod-point t)
@@ -8523,7 +8897,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list."
(defun verilog-read-arg-pins ()
"Return an array of [ pins ] for the current argument declaration at point."
(save-excursion
- (let ((end-mod-point (point)) ;; presume at /*AUTOARG*/ point
+ (let ((end-mod-point (point)) ; presume at /*AUTOARG*/ point
pins pin)
(verilog-backward-open-paren)
(while (re-search-forward "\\([a-zA-Z0-9$_.%`]+\\)" end-mod-point t)
@@ -8544,7 +8918,7 @@ For example if declare A A (.B(SIG)) then B will be included in the list."
(search-forward "(" end-mod-point)
(setq tpl-end-pt (save-excursion
(backward-char 1)
- (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
+ (verilog-forward-sexp-cmt 1) ; Moves to paren that closes argdecl's
(backward-char 1)
(point)))
(while (re-search-forward "\\s-*\\([\"a-zA-Z0-9$_.%`]+\\)\\s-*,*" tpl-end-pt t)
@@ -8570,29 +8944,18 @@ Must call `verilog-read-auto-lisp-present' before this function."
(while (re-search-forward "\\<AUTO_LISP(" end t)
(backward-char)
(let* ((beg-pt (prog1 (point)
- (verilog-forward-sexp-cmt 1))) ;; Closing paren
+ (verilog-forward-sexp-cmt 1))) ; Closing paren
(end-pt (point))
(verilog-in-hooks t))
(eval-region beg-pt end-pt nil))))))
-(eval-when-compile
- ;; Prevent compile warnings; these are let's, not globals
- ;; Do not remove the eval-when-compile
- ;; - we want an error when we are debugging this code if they are refed.
- (defvar sigs-in)
- (defvar sigs-out-d)
- (defvar sigs-out-i)
- (defvar sigs-out-unk)
- (defvar sigs-temp)
- (defvar vector-skip-list))
-
(defun verilog-read-always-signals-recurse
- (exit-keywd rvalue temp-next)
+ (exit-keywd rvalue temp-next)
"Recursive routine for parentheses/bracket matching.
EXIT-KEYWD is expression to stop at, nil if top level.
RVALUE is true if at right hand side of equal.
IGNORE-NEXT is true to ignore next token, fake from inside case statement."
- (let* ((semi-rvalue (equal "endcase" exit-keywd)) ;; true if after a ; we are looking for rvalue
+ (let* ((semi-rvalue (equal "endcase" exit-keywd)) ; true if after a ; we are looking for rvalue
keywd last-keywd sig-tolk sig-last-tolk gotend got-sig got-list end-else-check
ignore-next)
;;(if dbg (setq dbg (concat dbg (format "Recursion %S %S %S\n" exit-keywd rvalue temp-next))))
@@ -8645,16 +9008,16 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
(if (looking-at "'[sS]?[hdxboHDXBO]?[ \t]*[0-9a-fA-F_xzXZ?]+")
(goto-char (match-end 0))
(forward-char 1)))
- ((equal keywd ":") ;; Case statement, begin/end label, x?y:z
- (cond ((equal "endcase" exit-keywd) ;; case x: y=z; statement next
+ ((equal keywd ":") ; Case statement, begin/end label, x?y:z
+ (cond ((equal "endcase" exit-keywd) ; case x: y=z; statement next
(setq ignore-next nil rvalue nil))
- ((equal "?" exit-keywd) ;; x?y:z rvalue
- ) ;; NOP
- ((equal "]" exit-keywd) ;; [x:y] rvalue
- ) ;; NOP
- (got-sig ;; label: statement
+ ((equal "?" exit-keywd) ; x?y:z rvalue
+ ) ; NOP
+ ((equal "]" exit-keywd) ; [x:y] rvalue
+ ) ; NOP
+ (got-sig ; label: statement
(setq ignore-next nil rvalue semi-rvalue got-sig nil))
- ((not rvalue) ;; begin label
+ ((not rvalue) ; begin label
(setq ignore-next t rvalue nil)))
(forward-char 1))
((equal keywd "=")
@@ -8678,7 +9041,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
(verilog-read-always-signals-recurse "]" t nil))
((equal keywd "(")
(forward-char 1)
- (cond (sig-last-tolk ;; Function call; zap last signal
+ (cond (sig-last-tolk ; Function call; zap last signal
(setq got-sig nil)))
(cond ((equal last-keywd "for")
;; temp-next: Variables on LHS are lvalues, but generally we want
@@ -8697,13 +9060,13 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
(skip-syntax-forward "w_")
(verilog-read-always-signals-recurse "endcase" t nil)
(setq ignore-next nil rvalue semi-rvalue)
- (if (not exit-keywd) (setq gotend t))) ;; top level begin/end
- ((string-match "^[$`a-zA-Z_]" keywd) ;; not exactly word constituent
+ (if (not exit-keywd) (setq gotend t))) ; top level begin/end
+ ((string-match "^[$`a-zA-Z_]" keywd) ; not exactly word constituent
(cond ((member keywd '("`ifdef" "`ifndef" "`elsif"))
(setq ignore-next t))
((or ignore-next
(member keywd verilog-keywords)
- (string-match "^\\$" keywd)) ;; PLI task
+ (string-match "^\\$" keywd)) ; PLI task
(setq ignore-next nil))
(t
(setq keywd (verilog-symbol-detick-denumber keywd))
@@ -8736,9 +9099,8 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
(defun verilog-read-always-signals ()
"Parse always block at point and return list of (outputs inout inputs)."
(save-excursion
- (let* (;;(dbg "")
+ (let* (;(dbg "")
sigs-out-d sigs-out-i sigs-out-unk sigs-temp sigs-in)
- (search-forward ")")
(verilog-read-always-signals-recurse nil nil nil)
(setq sigs-out-i (append sigs-out-i sigs-out-unk)
sigs-out-unk nil)
@@ -8749,7 +9111,7 @@ IGNORE-NEXT is true to ignore next token, fake from inside case statement."
(defun verilog-read-instants ()
"Parse module at point and return list of ( ( file instance ) ... )."
(verilog-beg-of-defun-quick)
- (let* ((end-mod-point (verilog-get-end-of-defun t))
+ (let* ((end-mod-point (verilog-get-end-of-defun))
(state nil)
(instants-list nil))
(save-excursion
@@ -8801,7 +9163,7 @@ Returns REGEXP and list of ( (signal_name connection_name)... )."
(setq lineno (1+ lineno))))))
(setq tpl-end-pt (save-excursion
(backward-char 1)
- (verilog-forward-sexp-cmt 1) ;; Moves to paren that closes argdecl's
+ (verilog-forward-sexp-cmt 1) ; Moves to paren that closes argdecl's
(backward-char 1)
(point)))
;;
@@ -8882,13 +9244,19 @@ If found returns `verilog-read-auto-template-inside' structure."
(defvar verilog-auto-template-hits nil "Successful lookups with `verilog-read-auto-template-hit'.")
(make-variable-buffer-local 'verilog-auto-template-hits)
+(defun verilog-read-auto-template-init ()
+ "Initialize `verilog-read-auto-template'."
+ (when (eval-when-compile (fboundp 'make-hash-table)) ; else feature not allowed
+ (when verilog-auto-template-warn-unused
+ (setq verilog-auto-template-hits
+ (make-hash-table :test 'equal :rehash-size 4.0)))))
+
(defun verilog-read-auto-template-hit (tpl-ass)
"Record that TPL-ASS template from `verilog-read-auto-template' was used."
- (when (eval-when-compile (fboundp 'make-hash-table)) ;; else feature not allowed
+ (when (eval-when-compile (fboundp 'make-hash-table)) ; else feature not allowed
(when verilog-auto-template-warn-unused
(unless verilog-auto-template-hits
- (setq verilog-auto-template-hits
- (make-hash-table :test 'equal :rehash-size 4.0)))
+ (verilog-read-auto-template-init))
(puthash (vector (nth 2 tpl-ass) (nth 3 tpl-ass)) t
verilog-auto-template-hits))))
@@ -8896,28 +9264,30 @@ If found returns `verilog-read-auto-template-inside' structure."
"Set the definition DEFNAME to the DEFVALUE in the given BUFFER.
Optionally associate it with the specified enumeration ENUMNAME."
(with-current-buffer (or buffer (current-buffer))
+ ;; Namespace intentionally short for AUTOs and compatibility
(let ((mac (intern (concat "vh-" defname))))
;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
;; Need to define to a constant if no value given
(set (make-local-variable mac)
(if (equal defvalue "") "1" defvalue)))
(if enumname
+ ;; Namespace intentionally short for AUTOs and compatibility
(let ((enumvar (intern (concat "venum-" enumname))))
;;(message "Define %s=%s" defname defvalue) (sleep-for 1)
(unless (boundp enumvar) (set enumvar nil))
(add-to-list (make-local-variable enumvar) defname)))))
(defun verilog-read-defines (&optional filename recurse subcall)
- "Read `defines and parameters for the current file, or optional FILENAME.
+ "Read \\=`defines and parameters for the current file, or optional FILENAME.
If the filename is provided, `verilog-library-flags' will be used to
-resolve it. If optional RECURSE is non-nil, recurse through `includes.
+resolve it. If optional RECURSE is non-nil, recurse through \\=`includes.
Parameters must be simple assignments to constants, or have their own
\"parameter\" label rather than a list of parameters. Thus:
parameter X = 5, Y = 10; // Ok
- parameter X = {1'b1, 2'h2}; // Ok
- parameter X = {1'b1, 2'h2}, Y = 10; // Bad, make into 2 parameter lines
+ parameter X = {1\\='b1, 2\\='h2}; // Ok
+ parameter X = {1\\='b1, 2\\='h2}, Y = 10; // Bad, make into 2 parameter lines
Defines must be simple text substitutions, one on a line, starting
at the beginning of the line. Any ifdefs or multiline comments around the
@@ -8955,8 +9325,8 @@ warning message, you need to add to your init file:
(let ((fns (verilog-library-filenames filename (buffer-file-name))))
(if fns
(set-buffer (find-file-noselect (car fns)))
- (error (concat (verilog-point-text)
- ": Can't find verilog-read-defines file: " filename)))))
+ (error "%s: Can't find verilog-read-defines file: %s"
+ (verilog-point-text) filename))))
(when recurse
(goto-char (point-min))
(while (re-search-forward "^\\s-*`include\\s-+\\([^ \t\n\f]+\\)" nil t)
@@ -8971,8 +9341,9 @@ warning message, you need to add to your init file:
(while (re-search-forward "^\\s-*`define\\s-+\\([a-zA-Z0-9_$]+\\)\\s-+\\(.*\\)$" nil t)
(let ((defname (match-string-no-properties 1))
(defvalue (match-string-no-properties 2)))
- (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue))
- (verilog-set-define defname defvalue origbuf)))
+ (unless (verilog-inside-comment-or-string-p (match-beginning 0))
+ (setq defvalue (verilog-string-replace-matches "\\s-*/[/*].*$" "" nil nil defvalue))
+ (verilog-set-define defname defvalue origbuf))))
;; Hack: Read parameters
(goto-char (point-min))
(while (re-search-forward
@@ -8985,14 +9356,15 @@ warning message, you need to add to your init file:
(forward-comment 99999)
(while (looking-at (concat "\\s-*,?\\s-*\\(?:/[/*].*?$\\)?\\s-*\\([a-zA-Z0-9_$]+\\)"
"\\s-*=\\s-*\\([^;,]*\\),?\\s-*\\(/[/*].*?$\\)?\\s-*"))
- (verilog-set-define (match-string-no-properties 1)
- (match-string-no-properties 2) origbuf enumname)
+ (unless (verilog-inside-comment-or-string-p (match-beginning 0))
+ (verilog-set-define (match-string-no-properties 1)
+ (match-string-no-properties 2) origbuf enumname))
(goto-char (match-end 0))
(forward-comment 99999)))))))
(defun verilog-read-includes ()
- "Read `includes for the current file.
-This will find all of the `includes which are at the beginning of lines,
+ "Read \\=`includes for the current file.
+This will find all of the \\=`includes which are at the beginning of lines,
ignoring any ifdefs or multiline comments around them.
`verilog-read-defines' is then performed on the current and each included
file.
@@ -9014,12 +9386,12 @@ variable over and over when many modules are compiled together, put a test
around the inside each include file:
foo.v (an include file):
- `ifdef _FOO_V // include if not already included
- `else
- `define _FOO_V
+ \\=`ifdef _FOO_V // include if not already included
+ \\=`else
+ \\=`define _FOO_V
... contents of file
- `endif // _FOO_V"
-;;slow: (verilog-read-defines nil t))
+ \\=`endif // _FOO_V"
+ ;;slow: (verilog-read-defines nil t)
(save-excursion
(verilog-getopt-flags)
(goto-char (point-min))
@@ -9043,10 +9415,10 @@ Some macros and such are also found and included. For dinotrace.el."
((looking-at "/\\*")
(search-forward "*/"))
((looking-at "(\\*")
- (or (looking-at "(\\*\\s-*)") ; It's a "always @ (*)"
+ (or (looking-at "(\\*\\s-*)") ; It's an "always @ (*)"
(search-forward "*)")))
((eq ?\" (following-char))
- (re-search-forward "[^\\]\"")) ;; don't forward-char first, since we look for a non backslash first
+ (re-search-forward "[^\\]\"")) ; don't forward-char first, since we look for a non backslash first
((looking-at "\\s-*\\([a-zA-Z0-9$_.%`]+\\)")
(goto-char (match-end 0))
(setq keywd (match-string-no-properties 1))
@@ -9094,19 +9466,19 @@ Some macros and such are also found and included. For dinotrace.el."
(match-string 1 arg))
(setq arg (match-string 2 arg))))
;;
- ((or (string-match "^-D\\([^+=]*\\)[+=]\\(.*\\)" arg) ;; -Ddefine=val
- (string-match "^-D\\([^+=]*\\)\\(\\)" arg) ;; -Ddefine
- (string-match "^\\+define\\([^+=]*\\)[+=]\\(.*\\)" arg) ;; +define+val
- (string-match "^\\+define\\([^+=]*\\)\\(\\)" arg)) ;; +define+define
+ ((or (string-match "^-D\\([^+=]*\\)[+=]\\(.*\\)" arg) ; -Ddefine=val
+ (string-match "^-D\\([^+=]*\\)\\(\\)" arg) ; -Ddefine
+ (string-match "^\\+define\\([^+=]*\\)[+=]\\(.*\\)" arg) ; +define+val
+ (string-match "^\\+define\\([^+=]*\\)\\(\\)" arg)) ; +define+define
(verilog-set-define (match-string 1 arg) (match-string 2 arg)))
;;
- ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ;; +incdir+dir
- (string-match "^-I\\(.*\\)" arg)) ;; -Idir
+ ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ; +incdir+dir
+ (string-match "^-I\\(.*\\)" arg)) ; -Idir
(verilog-add-list-unique `verilog-library-directories
(match-string 1 (substitute-in-file-name arg))))
;; Ignore
((equal "+librescan" arg))
- ((string-match "^-U\\(.*\\)" arg)) ;; -Udefine
+ ((string-match "^-U\\(.*\\)" arg)) ; -Udefine
;; Second parameters
((equal next-param "-f")
(setq next-param nil)
@@ -9135,8 +9507,8 @@ Some macros and such are also found and included. For dinotrace.el."
line)
(if fns
(set-buffer (find-file-noselect (car fns)))
- (error (concat (verilog-point-text)
- ": Can't find verilog-getopt-file -f file: " filename)))
+ (error "%s: Can't find verilog-getopt-file -f file: %s"
+ (verilog-point-text) filename))
(goto-char (point-min))
(while (not (eobp))
(setq line (buffer-substring (point) (point-at-eol)))
@@ -9184,12 +9556,11 @@ Used for __FLAGS__ in `verilog-expand-command'."
;;(verilog-current-flags)
-;;
-;; Cached directory support
+;;; Cached directory support:
;;
(defvar verilog-dir-cache-preserving nil
- "If set, the directory cache is enabled, and file system changes are ignored.
+ "If true, the directory cache is enabled, and file system changes are ignored.
See `verilog-dir-exists-p' and `verilog-dir-files'.")
;; If adding new cached variable, add also to verilog-preserve-dir-cache
@@ -9212,12 +9583,12 @@ seen by the `verilog-dir-files' and related functions."
Relative paths depend on the `default-directory'.
Results are cached if inside `verilog-preserve-dir-cache'."
(unless verilog-dir-cache-preserving
- (setq verilog-dir-cache-list nil)) ;; Cache disabled
+ (setq verilog-dir-cache-list nil)) ; Cache disabled
;; We don't use expand-file-name on the dirname to make key, as it's slow
(let* ((cache-key (list dirname default-directory))
(fass (assoc cache-key verilog-dir-cache-list))
exp-dirname data)
- (cond (fass ;; Return data from cache hit
+ (cond (fass ; Return data from cache hit
(nth 1 fass))
(t
(setq exp-dirname (expand-file-name dirname)
@@ -9247,8 +9618,7 @@ Like `file-exists-p' but results are cached if inside
;;(verilog-dir-file-exists-p "../verilog-mode/verilog-mode.el")
-;;
-;; Module name lookup
+;;; Module name lookup:
;;
(defun verilog-module-inside-filename-p (module filename)
@@ -9284,10 +9654,12 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
(while (and symbol (string-match "^`" symbol))
(setq symbol (substring symbol 1))
(setq symbol
+ ;; Namespace intentionally short for AUTOs and compatibility
(if (boundp (intern (concat "vh-" symbol)))
;; Emacs has a bug where boundp on a buffer-local
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
+ ;; Namespace intentionally short for AUTOs and compatibility
(let ((val (eval (intern (concat "vh-" symbol)))))
(if (eq val nil)
(if wing-it symbol nil)
@@ -9303,7 +9675,7 @@ If undefined, and WING-IT, return just SYMBOL without the tick, else nil."
;; something like a[b]. Sorry, it should be substituted into the parser
(setq symbol
(verilog-string-replace-matches
- "\[[^0-9: \t]+\]" "" nil nil
+ "\\[[^0-9: \t]+\\]" "" nil nil
(or (verilog-symbol-detick symbol nil)
(if verilog-auto-sense-defines-constant
"0"
@@ -9320,10 +9692,12 @@ If the variable vh-{symbol} is defined, substitute that value."
(setq symbol (match-string 1 text))
;;(message symbol)
(cond ((and
+ ;; Namespace intentionally short for AUTOs and compatibility
(boundp (intern (concat "vh-" symbol)))
;; Emacs has a bug where boundp on a buffer-local
;; variable in only one buffer returns t in another.
;; This can confuse, so check for nil.
+ ;; Namespace intentionally short for AUTOs and compatibility
(setq val (eval (intern (concat "vh-" symbol)))))
(setq text (replace-match val nil nil text)))
(t (setq ok nil)))))
@@ -9336,16 +9710,17 @@ Or, just the existing dirnames themselves if there are no wildcards."
;; Note this function is performance critical.
;; Do not call anything that requires disk access that cannot be cached.
(interactive)
- (unless dirnames (error "`verilog-library-directories' should include at least '.'"))
+ (unless dirnames
+ (error "`verilog-library-directories' should include at least `.'"))
(setq dirnames (reverse dirnames)) ; not nreverse
(let ((dirlist nil)
pattern dirfile dirfiles dirname root filename rest basefile)
(while dirnames
(setq dirname (substitute-in-file-name (car dirnames))
dirnames (cdr dirnames))
- (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ;; root
- "\\([^/\\]*[*?][^/\\]*\\)" ;; filename with *?
- "\\(.*\\)") ;; rest
+ (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root
+ "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *?
+ "\\(.*\\)") ; rest
dirname)
(setq root (match-string 1 dirname)
filename (match-string 2 dirname)
@@ -9386,7 +9761,7 @@ variables to build the path. With optional CHECK-EXT also check
(let* ((cache-key (list filename current check-ext))
(fass (assoc cache-key verilog-dir-cache-lib-filenames))
chkdirs chkdir chkexts fn outlist)
- (cond (fass ;; Return data from cache hit
+ (cond (fass ; Return data from cache hit
(nth 1 fass))
(t
;; Note this expand can't be easily cached, as we need to
@@ -9404,7 +9779,7 @@ variables to build the path. With optional CHECK-EXT also check
(setq outlist (cons (expand-file-name
fn (file-name-directory current))
outlist)))
- (setq chkexts (cdr chkexts)))
+ (setq chkexts (cdr chkexts)))
(setq chkdirs (cdr chkdirs)))
(setq outlist (nreverse outlist))
(setq verilog-dir-cache-lib-filenames
@@ -9501,7 +9876,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
allow-cache
(setq modi (gethash module verilog-modi-lookup-cache))
(equal verilog-modi-lookup-last-current current)
- ;; Iff hit is in current buffer, then tick must match
+ ;; If hit is in current buffer, then tick must match
(or (equal verilog-modi-lookup-last-tick (buffer-chars-modified-tick))
(not (equal current (verilog-modi-file-or-buffer modi)))))
;;(message "verilog-modi-lookup: HIT %S" modi)
@@ -9515,17 +9890,18 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
(if (not (setq mif (verilog-module-inside-filename-p realname (car filenames))))
(setq filenames (cdr filenames))))
;; mif has correct form to become later elements of modi
- (cond (mif (setq modi mif))
- (t (setq modi nil)
- (or ignore-error
- (error (concat (verilog-point-text)
- ": Can't locate " module " module definition"
- (if (not (equal module realname))
- (concat " (Expanded macro to " realname ")")
- "")
- "\n Check the verilog-library-directories variable."
- "\n I looked in (if not listed, doesn't exist):\n\t"
- (mapconcat 'concat orig-filenames "\n\t"))))))
+ (setq modi mif)
+ (or mif ignore-error
+ (error
+ (concat
+ "%s: Can't locate %s module definition%s"
+ "\n Check the verilog-library-directories variable."
+ "\n I looked in (if not listed, doesn't exist):\n\t%s")
+ (verilog-point-text) module
+ (if (not (equal module realname))
+ (concat " (Expanded macro to " realname ")")
+ "")
+ (mapconcat 'concat orig-filenames "\n\t")))
(when (eval-when-compile (fboundp 'make-hash-table))
(unless verilog-modi-lookup-cache
(setq verilog-modi-lookup-cache
@@ -9548,7 +9924,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
(set-buffer (if (bufferp (verilog-modi-file-or-buffer modi))
(verilog-modi-file-or-buffer modi)
(find-file-noselect (verilog-modi-file-or-buffer modi))))
- (or (equal major-mode `verilog-mode) ;; Put into Verilog mode to get syntax
+ (or (equal major-mode `verilog-mode) ; Put into Verilog mode to get syntax
(verilog-mode))
(goto-char (verilog-modi-get-point modi)))
@@ -9564,7 +9940,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true."
"Run on MODI the given FUNCTION. Locate the module in a file.
Cache the output of function so next call may have faster access."
(let (fass)
- (save-excursion ;; Cache is buffer-local so can't avoid this.
+ (save-excursion ; Cache is buffer-local so can't avoid this.
(verilog-modi-goto modi)
(if (and (setq fass (assoc (list modi function)
verilog-modi-cache-list))
@@ -9621,16 +9997,17 @@ and invalidating the cache."
(defun verilog-modi-modport-lookup-one (modi name &optional ignore-error)
- "Given a MODI, return the declarations related to the given modport NAME."
+ "Given a MODI, return the declarations related to the given modport NAME.
+Report errors unless optional IGNORE-ERROR."
;; Recursive routine - see below
(let* ((realname (verilog-symbol-detick name t))
(modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi)))))
(or modport ignore-error
- (error (concat (verilog-point-text)
- ": Can't locate " name " modport definition"
- (if (not (equal name realname))
- (concat " (Expanded macro to " realname ")")
- ""))))
+ (error "%s: Can't locate %s modport definition%s"
+ (verilog-point-text) name
+ (if (not (equal name realname))
+ (concat " (Expanded macro to " realname ")")
+ "")))
(let* ((decls (verilog-modport-decls modport))
(clks (verilog-modport-clockings modport)))
;; Now expand any clocking's
@@ -9667,6 +10044,7 @@ those clocking block's signals."
(setq out-list (cons (car in-list) out-list)))
(setq in-list (cdr in-list)))
;; New scheme
+ ;; Namespace intentionally short for AUTOs and compatibility
(let* ((enumvar (intern (concat "venum-" enum)))
(enumlist (and (boundp enumvar) (eval enumvar))))
(while enumlist
@@ -9678,7 +10056,8 @@ those clocking block's signals."
"Return all signals in IN-LIST matching the given REGEXP, if non-nil."
(if (or (not regexp) (equal regexp ""))
in-list
- (let (out-list)
+ (let ((case-fold-search verilog-case-fold)
+ out-list)
(while in-list
(if (string-match regexp (verilog-sig-name (car in-list)))
(setq out-list (cons (car in-list) out-list)))
@@ -9689,7 +10068,8 @@ those clocking block's signals."
"Return all signals in IN-LIST not matching the given REGEXP, if non-nil."
(if (or (not regexp) (equal regexp ""))
in-list
- (let (out-list)
+ (let ((case-fold-search verilog-case-fold)
+ out-list)
(while in-list
(if (not (string-match regexp (verilog-sig-name (car in-list))))
(setq out-list (cons (car in-list) out-list)))
@@ -9723,7 +10103,7 @@ if non-nil."
;; Combined
(defun verilog-decls-get-signals (decls)
- "Return all declared signals in DECLS, excluding 'assign' statements."
+ "Return all declared signals in DECLS, excluding `assign' statements."
(append
(verilog-decls-get-outputs decls)
(verilog-decls-get-inouts decls)
@@ -9757,8 +10137,7 @@ if non-nil."
(verilog-modi-cache-add modi 'verilog-read-decls 7 sig-list))
-;;
-;; Auto creation utilities
+;;; Auto creation utilities:
;;
(defun verilog-auto-re-search-do (search-for func)
@@ -9828,7 +10207,7 @@ When MODI is non-null, also add to modi-cache, for tracking."
(when (member direction '("input" "output" "inout"))
(concat direction " "))
(or (verilog-sig-type sig)
- verilog-auto-wire-type)))
+ verilog-auto-wire-type)))
((and verilog-auto-declare-nettype
(member direction '("input" "output" "inout")))
(concat direction " " verilog-auto-declare-nettype))
@@ -9870,10 +10249,10 @@ Presumes that any newlines end a list element."
;; Also want "`ifdef X input foo `endif" to just leave things to the human to deal with
(save-excursion
(verilog-backward-syntactic-ws-quick)
- (when (and (not (save-excursion ;; Not beginning (, or existing ,
+ (when (and (not (save-excursion ; Not beginning (, or existing ,
(backward-char 1)
(looking-at "[(,]")))
- (not (save-excursion ;; Not `endif, or user define
+ (not (save-excursion ; Not `endif, or user define
(backward-char 1)
(skip-chars-backward "[a-zA-Z0-9_`]")
(looking-at "`"))))
@@ -9891,19 +10270,6 @@ This repairs those mis-inserted by an AUTOARG."
(when (looking-at ",")
(delete-char 1))))
-(defun verilog-get-list (start end)
- "Return the elements of a comma separated list between START and END."
- (interactive)
- (let ((my-list (list))
- my-string)
- (save-excursion
- (while (< (point) end)
- (when (re-search-forward "\\([^,{]+\\)" end t)
- (setq my-string (verilog-string-remove-spaces (match-string 1)))
- (setq my-list (nconc my-list (list my-string) ))
- (goto-char (match-end 0))))
- my-list)))
-
(defun verilog-make-width-expression (range-exp)
"Return an expression calculating the length of a range [x:y] in RANGE-EXP."
;; strip off the []
@@ -9927,7 +10293,7 @@ This repairs those mis-inserted by an AUTOARG."
((string-match "^\\(.*\\)\\s *:\\s *\\(.*\\)\\s *$" range-exp)
(concat "(1+(" (match-string 1 range-exp) ")"
(if (equal "0" (match-string 2 range-exp))
- "" ;; Don't bother with -(0)
+ "" ; Don't bother with -(0)
(concat "-(" (match-string 2 range-exp) ")"))
")"))
(t nil)))))
@@ -9937,7 +10303,7 @@ This repairs those mis-inserted by an AUTOARG."
"Return a simplified range expression with constants eliminated from EXPR."
;; Note this is always called with brackets; ie [z] or [z:z]
(if (not (string-match "[---+*()]" expr))
- expr ;; short-circuit
+ expr ; short-circuit
(let ((out expr)
(last-pass ""))
(while (not (equal last-pass out))
@@ -9992,23 +10358,23 @@ This repairs those mis-inserted by an AUTOARG."
out (replace-match
(concat (if (and (equal pre "-")
(< val 0))
- "" ;; Not "--20" but just "-20"
+ "" ; Not "--20" but just "-20"
pre)
(int-to-string val)
post)
nil nil out)) )))
out)))
-;;(verilog-simplify-range-expression "[1:3]") ;; 1
-;;(verilog-simplify-range-expression "[(1):3]") ;; 1
-;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ;;20
-;;(verilog-simplify-range-expression "[(2*3+6*7)]") ;; 48
-;;(verilog-simplify-range-expression "[(FOO*4-1*2)]") ;; FOO*4-2
-;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ;; FOO*4+0
-;;(verilog-simplify-range-expression "[(func(BAR))]") ;; func(BAR)
-;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ;; FOO-0
-;;(verilog-simplify-range-expression "[$clog2(2)]") ;; 1
-;;(verilog-simplify-range-expression "[$clog2(7)]") ;; 3
+;;(verilog-simplify-range-expression "[1:3]") ; 1
+;;(verilog-simplify-range-expression "[(1):3]") ; 1
+;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ; 20
+;;(verilog-simplify-range-expression "[(2*3+6*7)]") ; 48
+;;(verilog-simplify-range-expression "[(FOO*4-1*2)]") ; FOO*4-2
+;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ; FOO*4+0
+;;(verilog-simplify-range-expression "[(func(BAR))]") ; func(BAR)
+;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ; FOO-0
+;;(verilog-simplify-range-expression "[$clog2(2)]") ; 1
+;;(verilog-simplify-range-expression "[$clog2(7)]") ; 3
(defun verilog-clog2 (value)
"Compute $clog2 - ceiling log2 of VALUE."
@@ -10019,10 +10385,9 @@ This repairs those mis-inserted by an AUTOARG."
(defun verilog-typedef-name-p (variable-name)
"Return true if the VARIABLE-NAME is a type definition."
(when verilog-typedef-regexp
- (string-match verilog-typedef-regexp variable-name)))
+ (verilog-string-match-fold verilog-typedef-regexp variable-name)))
-;;
-;; Auto deletion
+;;; Auto deletion:
;;
(defun verilog-delete-autos-lined ()
@@ -10088,7 +10453,7 @@ Deletion stops at the matching end parenthesis, outside comments."
(delete-region (point)
(save-excursion
(verilog-backward-open-paren)
- (verilog-forward-sexp-ign-cmt 1) ;; Moves to paren that closes argdecl's
+ (verilog-forward-sexp-ign-cmt 1) ; Moves to paren that closes argdecl's
(backward-char 1)
(point))))
@@ -10154,7 +10519,7 @@ called before and after this function, respectively."
(interactive)
(save-excursion
(if (buffer-file-name)
- (find-file-noselect (buffer-file-name))) ;; To check we have latest version
+ (find-file-noselect (buffer-file-name))) ; To check we have latest version
(verilog-save-no-change-functions
(verilog-save-scan-cache
;; Allow user to customize
@@ -10189,8 +10554,7 @@ called before and after this function, respectively."
;; Final customize
(verilog-run-hooks 'verilog-delete-auto-hook)))))
-;;
-;; Auto inject
+;;; Auto inject:
;;
(defun verilog-inject-auto ()
@@ -10266,7 +10630,7 @@ Typing \\[verilog-inject-auto] will make this into:
got-sigs)
(backward-char 1)
(verilog-forward-sexp-ign-cmt 1)
- (backward-char 1) ;; End )
+ (backward-char 1) ; End )
(when (not (verilog-re-search-backward-quick "/\\*\\(AUTOSENSE\\|AS\\)\\*/" start-pt t))
(setq pre-sigs (verilog-signals-from-signame
(verilog-read-signals start-pt (point)))
@@ -10281,24 +10645,24 @@ Typing \\[verilog-inject-auto] will make this into:
(save-excursion
(goto-char (point-min))
;; It's hard to distinguish modules; we'll instead search for pins.
- (while (verilog-re-search-forward-quick "\\.\\s *[a-zA-Z0-9`_\$]+\\s *(\\s *[a-zA-Z0-9`_\$]+\\s *)" nil t)
- (verilog-backward-open-paren) ;; Inst start
+ (while (verilog-re-search-forward-quick "\\.\\s *[a-zA-Z0-9`_$]+\\s *(\\s *[a-zA-Z0-9`_$]+\\s *)" nil t)
+ (verilog-backward-open-paren) ; Inst start
(cond
- ((= (preceding-char) ?\#) ;; #(...) parameter section, not pin. Skip.
+ ((= (preceding-char) ?\#) ; #(...) parameter section, not pin. Skip.
(forward-char 1)
- (verilog-forward-close-paren)) ;; Parameters done
+ (verilog-forward-close-paren)) ; Parameters done
(t
(forward-char 1)
(let ((indent-pt (+ (current-column)))
(end-pt (save-excursion (verilog-forward-close-paren) (point))))
(cond ((verilog-re-search-forward-quick "\\(/\\*AUTOINST\\*/\\|\\.\\*\\)" end-pt t)
- (goto-char end-pt)) ;; Already there, continue search with next instance
+ (goto-char end-pt)) ; Already there, continue search with next instance
(t
;; Delete identical interconnect
- (let ((case-fold-search nil)) ;; So we don't convert upper-to-lower, etc
- (while (verilog-re-search-forward-quick "\\.\\s *\\([a-zA-Z0-9`_\$]+\\)*\\s *(\\s *\\1\\s *)\\s *" end-pt t)
+ (let ((case-fold-search nil)) ; So we don't convert upper-to-lower, etc
+ (while (verilog-re-search-forward-quick "\\.\\s *\\([a-zA-Z0-9`_$]+\\)*\\s *(\\s *\\1\\s *)\\s *" end-pt t)
(delete-region (match-beginning 0) (match-end 0))
- (setq end-pt (- end-pt (- (match-end 0) (match-beginning 0)))) ;; Keep it correct
+ (setq end-pt (- end-pt (- (match-end 0) (match-beginning 0)))) ; Keep it correct
(while (or (looking-at "[ \t\n\f,]+")
(looking-at "//[^\n]*"))
(delete-region (match-beginning 0) (match-end 0))
@@ -10310,9 +10674,9 @@ Typing \\[verilog-inject-auto] will make this into:
(delete-region (match-beginning 0) (match-end 0)))
(verilog-insert "\n")
(verilog-insert-indent "/*AUTOINST*/")))))))))
-
+
;;
-;; Auto diff
+;; Auto diff:
;;
(defun verilog-diff-buffers-p (b1 b2 &optional whitespace)
@@ -10320,7 +10684,7 @@ Typing \\[verilog-inject-auto] will make this into:
Else, return point in B1 that first mismatches.
If optional WHITESPACE true, ignore whitespace."
(save-excursion
- (let* ((case-fold-search nil) ;; compare-buffer-substrings cares
+ (let* ((case-fold-search nil) ; compare-buffer-substrings cares
(p1 (with-current-buffer b1 (goto-char (point-min))))
(p2 (with-current-buffer b2 (goto-char (point-min))))
(maxp1 (with-current-buffer b1 (point-max)))
@@ -10361,25 +10725,25 @@ Ignores WHITESPACE if t, and writes output to stdout if SHOW."
(if (not (file-exists-p f1))
(message "Buffer %s has no associated file on disc" (buffer-name b2))
(with-temp-buffer "*Verilog-Diff*"
- (let ((outbuf (current-buffer))
- (f2 (make-temp-file "vm-diff-auto-")))
- (unwind-protect
- (progn
- (with-current-buffer b2
- (save-restriction
- (widen)
- (write-region (point-min) (point-max) f2 nil 'nomessage)))
- (call-process diff-command nil outbuf t
- diff-switches ;; User may want -u in diff-switches
- (if whitespace "-b" "")
- f1 f2)
- ;; Print out results. Alternatively we could have call-processed
- ;; ourself, but this way we can reuse diff switches
- (when show
- (with-current-buffer outbuf (message "%s" (buffer-string))))))
- (sit-for 0)
- (when (file-exists-p f2)
- (delete-file f2))))))
+ (let ((outbuf (current-buffer))
+ (f2 (make-temp-file "vm-diff-auto-")))
+ (unwind-protect
+ (progn
+ (with-current-buffer b2
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) f2 nil 'nomessage)))
+ (call-process diff-command nil outbuf t
+ diff-switches ; User may want -u in diff-switches
+ (if whitespace "-b" "")
+ f1 f2)
+ ;; Print out results. Alternatively we could have call-processed
+ ;; ourself, but this way we can reuse diff switches
+ (when show
+ (with-current-buffer outbuf (message "%s" (buffer-string))))))
+ (sit-for 0)
+ (when (file-exists-p f2)
+ (delete-file f2))))))
(defun verilog-diff-report (b1 b2 diffpt)
"Report differences detected with `verilog-diff-auto'.
@@ -10388,7 +10752,7 @@ DIFFPT. This function is called via `verilog-diff-function'."
(let ((name1 (with-current-buffer b1 (buffer-file-name))))
(verilog-warn "%s:%d: Difference in AUTO expansion found"
name1 (with-current-buffer b1
- (1+ (count-lines (point-min) (point)))))
+ (count-lines (point-min) diffpt)))
(cond (noninteractive
(verilog-diff-file-with-buffer name1 b2 t t))
(t
@@ -10396,8 +10760,8 @@ DIFFPT. This function is called via `verilog-diff-function'."
(defun verilog-diff-auto ()
"Expand AUTOs in a temporary buffer and indicate any change.
-Whitespace differences are ignored to determine identicalness, but
-once a difference is detected, whitespace differences may be shown.
+Whitespace is ignored when detecting differences, but once a
+difference is detected, whitespace differences may be shown.
To call this from the command line, see \\[verilog-batch-diff-auto].
@@ -10412,7 +10776,7 @@ or `diff' in batch mode."
(save-excursion
(when (get-buffer newname)
(kill-buffer newname))
- (setq b2 (let (buffer-file-name) ;; Else clone is upset
+ (setq b2 (let (buffer-file-name) ; Else clone is upset
(clone-buffer newname)))
(with-current-buffer b2
;; auto requires the filename, but can't have same filename in two
@@ -10430,13 +10794,12 @@ or `diff' in batch mode."
(setq diffpt (verilog-diff-buffers-p b1 b2 t))
(cond ((not diffpt)
(unless noninteractive (message "AUTO expansion identical"))
- (kill-buffer newname)) ;; Nice to cleanup after oneself
+ (kill-buffer newname)) ; Nice to cleanup after oneself
(t
(funcall verilog-diff-function b1 b2 diffpt)))
;; Return result of compare
diffpt)))
-
;;
;; Auto save
;;
@@ -10462,7 +10825,7 @@ or `diff' in batch mode."
(set (make-local-variable 'verilog-auto-update-tick) (buffer-chars-modified-tick))))
(when (not verilog-auto-star-save)
(verilog-delete-auto-star-implicit))
- nil) ;; Always return nil -- we don't write the file ourselves
+ nil) ; Always return nil -- we don't write the file ourselves
(defun verilog-auto-read-locals ()
"Return file local variable segment at bottom of file."
@@ -10484,12 +10847,11 @@ If FORCE, always reread it."
(hack-local-variables)
t)))
-;;
-;; Auto creation
+;;; Auto creation:
;;
(defun verilog-auto-arg-ports (sigs message indent-pt)
- "Print a list of ports for an AUTOINST.
+ "Print a list of ports for AUTOARG.
Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(when sigs
(when verilog-auto-arg-sort
@@ -10501,13 +10863,20 @@ Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT."
(let ((space ""))
(indent-to indent-pt)
(while sigs
- (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
+ (cond ((equal verilog-auto-arg-format 'single)
+ (insert space)
+ (indent-to indent-pt)
+ (setq space "\n"))
+ ;; verilog-auto-arg-format 'packed
+ ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column)
(insert "\n")
- (indent-to indent-pt))
- (t (insert space)))
+ (indent-to indent-pt)
+ (setq space " "))
+ (t
+ (insert space)
+ (setq space " ")))
(insert (verilog-sig-name (car sigs)) ",")
- (setq sigs (cdr sigs)
- space " ")))))
+ (setq sigs (cdr sigs))))))
(defun verilog-auto-arg ()
"Expand AUTOARG statements.
@@ -10542,9 +10911,11 @@ Typing \\[verilog-auto] will make this into:
output o;
endmodule
-The argument declarations may be printed in declaration order to best suit
-order based instantiations, or alphabetically, based on the
-`verilog-auto-arg-sort' variable.
+The argument declarations may be printed in declaration order to
+best suit order based instantiations, or alphabetically, based on
+the `verilog-auto-arg-sort' variable.
+
+Formatting is controlled with `verilog-auto-arg-format' variable.
Any ports declared between the ( and /*AUTOARG*/ are presumed to be
predeclared and are not redeclared by AUTOARG. AUTOARG will make a
@@ -10612,20 +10983,19 @@ See the example in `verilog-auto-inout-modport'."
(modport-re (nth 1 params))
(inst-name (nth 2 params))
(regexp (nth 3 params))
- direction-re submodi) ;; direction argument not supported until requested
+ direction-re submodi) ; direction argument not supported until requested
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
(let* ((indent-pt (current-indentation))
- (modi (verilog-modi-current))
(submoddecls (verilog-modi-get-decls submodi))
(submodportdecls (verilog-modi-modport-lookup submodi modport-re))
- (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (sig-list-i (verilog-signals-in ; Decls doesn't have data types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-inputs submodportdecls)
(verilog-decls-get-ports submoddecls))))
- (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (sig-list-o (verilog-signals-in ; Decls doesn't have data types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-outputs submodportdecls)
@@ -10658,7 +11028,7 @@ See the example in `verilog-auto-inout-modport'."
(setq sigs (cdr sigs))))
(verilog-insert-indent "// End of automatics\n")))))))
-(defun verilog-auto-inst-port-map (port-st)
+(defun verilog-auto-inst-port-map (_port-st)
nil)
(defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning
@@ -10670,7 +11040,7 @@ 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 tpl-list tpl-num for-star par-values)
+(defun verilog-auto-inst-port (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.
@ are instantiation numbers, replaced with TPL-NUM.
@@ -10687,14 +11057,15 @@ If PAR-VALUES replace final strings with these parameter values."
(vl-mbits (if (verilog-sig-multidim port-st)
(verilog-sig-multidim-string port-st) ""))
(vl-bits (if (or verilog-auto-inst-vector
- (not (assoc port vector-skip-list))
+ (not (assoc port (verilog-decls-get-signals moddecls)))
(not (equal (verilog-sig-bits port-st)
- (verilog-sig-bits (assoc port vector-skip-list)))))
+ (verilog-sig-bits
+ (assoc port (verilog-decls-get-signals moddecls))))))
(or (verilog-sig-bits port-st) "")
""))
(case-fold-search nil)
(check-values par-values)
- tpl-net)
+ tpl-net dflt-bits)
;; Replace parameters in bit-width
(when (and check-values
(not (equal vl-bits "")))
@@ -10712,11 +11083,19 @@ If PAR-VALUES replace final strings with these parameter values."
vl-mbits (verilog-simplify-range-expression vl-mbits)
vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed
;; Default net value if not found
- (setq tpl-net (concat port
- (if vl-modport (concat "." vl-modport) "")
- (if (verilog-sig-multidim port-st)
- (concat "/*" vl-mbits vl-bits "*/")
- (concat vl-bits))))
+ (setq dflt-bits (if (and (verilog-sig-bits port-st)
+ (or (verilog-sig-multidim port-st)
+ (verilog-sig-memory port-st)))
+ (concat "/*" vl-mbits vl-bits "*/")
+ (concat vl-bits))
+ tpl-net (concat port
+ (if (and vl-modport
+ ;; .modport cannot be added if attachment is
+ ;; already declared as modport, VCS croaks
+ (let ((sig (assoc port (verilog-decls-get-interfaces moddecls))))
+ (not (and sig (verilog-sig-modport sig)))))
+ (concat "." vl-modport) "")
+ dflt-bits))
;; Find template
(cond (tpl-ass ; Template of exact port name
(setq tpl-net (nth 1 tpl-ass)))
@@ -10743,12 +11122,13 @@ If PAR-VALUES replace final strings with these parameter values."
(setq expr (verilog-string-replace-matches "\\\\\"" "\"" nil nil expr))
(setq expr (verilog-string-replace-matches "@" tpl-num nil nil expr))
(prin1 (eval (car (read-from-string expr)))
- (lambda (ch) ())))))
+ (lambda (_ch) ())))))
(if (numberp value) (setq value (number-to-string value)))
value))
(substring tpl-net (match-end 0))))))
;; Replace @ and [] magic variables in final output
(setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net))
+ (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)
@@ -10784,12 +11164,12 @@ If PAR-VALUES replace final strings with these parameter values."
;;(x "incom[@\"(+ (* 8 @) 7)\":@\"(* 8 @)\"]")
;;(x ".out (outgo[@\"(concat (+ (* 8 @) 7) \\\":\\\" ( * 8 @))\"]));")
-(defun verilog-auto-inst-port-list (sig-list indent-pt tpl-list tpl-num for-star par-values)
+(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
+ (verilog-auto-inst-port port indent-pt moddecls
tpl-list tpl-num for-star par-values))
sig-list))
@@ -10799,10 +11179,10 @@ If PAR-VALUES replace final strings with these parameter values."
;; 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
+ (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
+ (when (looking-at ")\\|\\*") ; Generally don't insert, unless we are fairly sure
(forward-char 1)
(insert ","))))
@@ -10843,7 +11223,7 @@ Limitations:
`verilog-library-extensions', and being found in the same directory, or
by changing the variable `verilog-library-flags' or
`verilog-library-directories'. Macros `modname are translated through the
- vh-{name} Emacs variable, if that is not found, it just ignores the `.
+ vh-{name} Emacs variable, if that is not found, it just ignores the \\=`.
In templates you must have one signal per line, ending in a ), or ));,
and have proper () nesting, including a final ); to end the template.
@@ -10861,6 +11241,10 @@ Limitations:
AUTOWIRE declarations, etc. Gates are the only case when
position based connections are passed.
+ The array part of arrayed instances are ignored; this may
+ result in undesirable default AUTOINST connections; use a
+ template instead.
+
For example, first take the submodule InstModule.v:
module InstModule (o,i);
@@ -10940,6 +11324,19 @@ Templates:
words and capitalized. Only signals that must be different for each
instantiation need to be listed.
+ Inside a template, a [] in a connection name (with nothing else
+ inside the brackets) will be replaced by the same bus subscript
+ as it is being connected to, or the [] will be removed if it is
+ a single bit signal.
+
+ Inside a template, a [][] in a connection name will behave
+ similarly to a [] for scalar or single-dimensional connection;
+ for a multidimensional connection it will print a comment
+ similar to that printed when a template is not used. Generally
+ it is a good idea to do this for all connections in a template,
+ as then they will work for any width signal, and with AUTOWIRE.
+ See PTL_BUS becoming PTL_BUSNEW below.
+
Inside a template, a [] in a connection name (with nothing else inside
the brackets) will be replaced by the same bus subscript as it is being
connected to, or the [] will be removed if it is a single bit signal.
@@ -11004,12 +11401,12 @@ Multiple Module Templates:
instantiation name.
If a regular expression is provided, the @ character will be replaced
- with the first \(\) grouping that matches against the cell name. Using a
- regexp of \"\\([0-9]+\\)\" provides identical values for @ as when no
+ with the first () grouping that matches against the cell name. Using a
+ regexp of `\\([0-9]+\\)' provides identical values for @ as when no
regexp is provided. If you use multiple layers of parenthesis,
- \"test\\([^0-9]+\\)_\\([0-9]+\\)\" would replace @ with non-number
+ `test\\([^0-9]+\\)_\\([0-9]+\\)' would replace @ with non-number
characters after test and before _, whereas
- \"\\(test\\([a-z]+\\)_\\([0-9]+\\)\\)\" would replace @ with the entire
+ `\\(test\\([a-z]+\\)_\\([0-9]+\\)\\)' would replace @ with the entire
match.
For example:
@@ -11091,14 +11488,14 @@ Lisp Templates:
Lisp functions:
vl-name Name portion of the input/output port.
- vl-bits Bus bits portion of the input/output port ('[2:0]').
- vl-mbits Multidimensional array bits for port ('[2:0][3:0]').
- vl-width Width of the input/output port ('3' for [2:0]).
+ vl-bits Bus bits portion of the input/output port (`[2:0]').
+ vl-mbits Multidimensional array bits for port (`[2:0][3:0]').
+ vl-width Width of the input/output port (`3' for [2:0]).
May be a (...) expression if bits isn't a constant.
vl-dir Direction of the pin input/output/inout/interface.
vl-modport The modport, if an interface with a modport.
- vl-cell-type Module name/type of the cell ('InstModule').
- vl-cell-name Instance name of the cell ('instName').
+ vl-cell-type Module name/type of the cell (`InstModule').
+ vl-cell-name Instance name of the cell (`instName').
Normal Lisp variables may be used in expressions. See
`verilog-read-defines' which can set vh-{definename} variables for use
@@ -11131,8 +11528,6 @@ For more information see the \\[verilog-faq] and forums at URL
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
- (vector-skip-list (unless verilog-auto-inst-vector
- (verilog-decls-get-signals moddecls)))
submod submodi submoddecls
inst skip-pins tpl-list tpl-num did-first par-values)
@@ -11159,7 +11554,7 @@ For more information see the \\[verilog-faq] and forums at URL
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
- (setq tpl-num (if (string-match tpl-regexp inst)
+ (setq tpl-num (if (verilog-string-match-fold tpl-regexp inst)
(match-string 1 inst)
"")
tpl-list (aref tpl-info 1)))
@@ -11174,7 +11569,7 @@ For more information see the \\[verilog-faq] and forums at URL
(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
+ (verilog-auto-inst-port-list 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)
@@ -11184,7 +11579,7 @@ For more information see the \\[verilog-faq] and forums at URL
(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
+ (verilog-auto-inst-port-list 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)
@@ -11193,7 +11588,7 @@ For more information see the \\[verilog-faq] and forums at URL
(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
+ (verilog-auto-inst-port-list 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)
@@ -11202,7 +11597,7 @@ For more information see the \\[verilog-faq] and forums at URL
(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
+ (verilog-auto-inst-port-list 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)
@@ -11211,7 +11606,7 @@ For more information see the \\[verilog-faq] and forums at URL
(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
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num for-star par-values)))
;; Kill extra semi
(save-excursion
@@ -11219,11 +11614,11 @@ For more information see the \\[verilog-faq] and forums at URL
(re-search-backward "," pt t)
(delete-char 1)
(insert ");")
- (search-forward "\n") ;; Added by inst-port
+ (search-forward "\n") ; Added by inst-port
(delete-char -1)
- (if (search-forward ")" nil t) ;; From user, moved up a line
+ (if (search-forward ")" nil t) ; From user, moved up a line
(delete-char -1))
- (if (search-forward ";" nil t) ;; Don't error if user had syntax error and forgot it
+ (if (search-forward ";" nil t) ; Don't error if user had syntax error and forgot it
(delete-char -1)))))))))
(defun verilog-auto-inst-param ()
@@ -11274,8 +11669,6 @@ Templates:
(+ 16 (* 8 (/ (+ indent-pt 7) 8)))))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
- (vector-skip-list (unless verilog-auto-inst-vector
- (verilog-decls-get-signals moddecls)))
submod submodi submoddecls
inst skip-pins tpl-list tpl-num did-first)
;; Find module name that is instantiated
@@ -11302,7 +11695,7 @@ Templates:
;; automatic variable instantiation program.
(let* ((tpl-info (verilog-read-auto-template submod))
(tpl-regexp (aref tpl-info 0)))
- (setq tpl-num (if (string-match tpl-regexp inst)
+ (setq tpl-num (if (verilog-string-match-fold tpl-regexp inst)
(match-string 1 inst)
"")
tpl-list (aref tpl-info 1)))
@@ -11315,7 +11708,7 @@ Templates:
(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
+ (verilog-auto-inst-port-list sig-list indent-pt moddecls
tpl-list tpl-num nil nil)))
;; Kill extra semi
(save-excursion
@@ -11323,9 +11716,9 @@ Templates:
(re-search-backward "," pt t)
(delete-char 1)
(insert ")")
- (search-forward "\n") ;; Added by inst-port
+ (search-forward "\n") ; Added by inst-port
(delete-char -1)
- (if (search-forward ")" nil t) ;; From user, moved up a line
+ (if (search-forward ")" nil t) ; From user, moved up a line
(delete-char -1)))))))))
(defun verilog-auto-reg ()
@@ -11367,7 +11760,7 @@ Typing \\[verilog-auto] will make this into:
(modsubdecls (verilog-modi-get-sub-decls modi))
(sig-list (verilog-signals-not-in
(verilog-decls-get-outputs moddecls)
- (append (verilog-signals-with ;; ignore typed signals
+ (append (verilog-signals-with ; ignore typed signals
'verilog-sig-type
(verilog-decls-get-outputs moddecls))
(verilog-decls-get-vars moddecls)
@@ -11548,6 +11941,9 @@ Limitations:
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+ Types are added to declarations if an AUTOLOGIC or
+ `verilog-auto-wire-type' is set to logic.
+
Signals matching `verilog-auto-output-ignore-regexp' are not included.
An example (see `verilog-auto-inst' for what else is going on here):
@@ -11593,6 +11989,7 @@ same expansion will result from only extracting outputs starting with ov:
(verilog-subdecls-get-outputs modsubdecls)
(append (verilog-decls-get-outputs moddecls)
(verilog-decls-get-inouts moddecls)
+ (verilog-decls-get-inputs moddecls)
(verilog-subdecls-get-inputs modsubdecls)
(verilog-subdecls-get-inouts modsubdecls)))))
(when regexp
@@ -11639,10 +12036,18 @@ Typing \\[verilog-auto] will make this into:
wire tempa = i;
wire tempb = tempa;
wire o = tempb;
- endmodule"
+ endmodule
+
+You may also provide an optional regular expression, in which case only
+signals matching the regular expression will be included. For example the
+same expansion will result from only extracting outputs starting with ov:
+
+ /*AUTOOUTPUTEVERY(\"^ov\")*/"
(save-excursion
;;Point must be at insertion point
(let* ((indent-pt (current-indentation))
+ (params (verilog-read-auto-params 0 1))
+ (regexp (nth 0 params))
(v2k (verilog-in-paren-quick))
(modi (verilog-modi-current))
(moddecls (verilog-modi-get-decls modi))
@@ -11650,6 +12055,11 @@ Typing \\[verilog-auto] will make this into:
(verilog-signals-not-in
(verilog-decls-get-signals moddecls)
(verilog-decls-get-ports moddecls)))))
+ (when regexp
+ (setq sig-list (verilog-signals-matching-regexp
+ sig-list regexp)))
+ (setq sig-list (verilog-signals-not-matching-regexp
+ sig-list verilog-auto-output-ignore-regexp))
(verilog-forward-or-insert-line)
(when v2k (verilog-repair-open-comma))
(when sig-list
@@ -11675,6 +12085,9 @@ Limitations:
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+ Types are added to declarations if an AUTOLOGIC or
+ `verilog-auto-wire-type' is set to logic.
+
Signals matching `verilog-auto-input-ignore-regexp' are not included.
An example (see `verilog-auto-inst' for what else is going on here):
@@ -11719,6 +12132,7 @@ same expansion will result from only extracting inputs starting with i:
(verilog-subdecls-get-inputs modsubdecls)
(append (verilog-decls-get-inputs moddecls)
(verilog-decls-get-inouts moddecls)
+ (verilog-decls-get-outputs moddecls)
(verilog-decls-get-vars moddecls)
(verilog-decls-get-consts moddecls)
(verilog-decls-get-gparams moddecls)
@@ -11754,6 +12168,9 @@ Limitations:
Typedefs must match `verilog-typedef-regexp', which is disabled by default.
+ Types are added to declarations if an AUTOLOGIC or
+ `verilog-auto-wire-type' is set to logic.
+
Signals matching `verilog-auto-inout-ignore-regexp' are not included.
An example (see `verilog-auto-inst' for what else is going on here):
@@ -11870,23 +12287,30 @@ same expansion will result from only extracting signals starting with i:
/*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/
-You may also provide an optional second regular expression, in
-which case only signals which have that pin direction and data
-type will be included. This matches against everything before
-the signal name in the declaration, for example against
-\"input\" (single bit), \"output logic\" (direction and type) or
+You may also provide an optional third argument regular
+expression, in which case only signals which have that pin
+direction and data type matching that regular expression will be
+included. This matches against everything before the signal name
+in the declaration, for example against \"input\" (single
+bit), \"output logic\" (direction and type) or
\"output [1:0]\" (direction and implicit type). You also
probably want to skip spaces in your regexp.
For example, the below will result in matching the output \"o\"
against the previous example's module:
- /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/"
+ /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/
+
+You may also provide an optional fourth argument regular
+expression, which if not \"\" only signals which do NOT match
+that expression are included."
+ ;; Beware spacing of quotes in above as can mess up Emacs indenter
(save-excursion
- (let* ((params (verilog-read-auto-params 1 3))
+ (let* ((params (verilog-read-auto-params 1 4))
(submod (nth 0 params))
(regexp (nth 1 params))
(direction-re (nth 2 params))
+ (not-re (nth 3 params))
submodi)
;; Lookup position, etc of co-module
;; Note this may raise an error
@@ -11921,22 +12345,26 @@ against the previous example's module:
(append (verilog-decls-get-interfaces moddecls)))))
(forward-line 1)
(setq sig-list-i (verilog-signals-edit-wire-reg
- (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-i regexp)
- "input" direction-re))
+ (verilog-signals-not-matching-regexp
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-i regexp)
+ "input" direction-re) not-re))
sig-list-o (verilog-signals-edit-wire-reg
- (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-o regexp)
- "output" direction-re))
+ (verilog-signals-not-matching-regexp
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-o regexp)
+ "output" direction-re) not-re))
sig-list-io (verilog-signals-edit-wire-reg
+ (verilog-signals-not-matching-regexp
+ (verilog-signals-matching-dir-re
+ (verilog-signals-matching-regexp sig-list-io regexp)
+ "inout" direction-re) not-re))
+ sig-list-if (verilog-signals-not-matching-regexp
(verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-io regexp)
- "inout" direction-re))
- sig-list-if (verilog-signals-matching-dir-re
- (verilog-signals-matching-regexp sig-list-if regexp)
- "interface" direction-re))
+ (verilog-signals-matching-regexp sig-list-if regexp)
+ "interface" direction-re) not-re))
(when v2k (verilog-repair-open-comma))
- (when (or sig-list-i sig-list-o sig-list-io)
+ (when (or sig-list-i sig-list-o sig-list-io sig-list-if)
(verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n")
;; Don't sort them so an upper AUTOINST will match the main module
(verilog-insert-definition modi sig-list-o "output" indent-pt v2k t)
@@ -11995,7 +12423,26 @@ You may also provide an optional regular expression, in which case only
signals matching the regular expression will be included. For example the
same expansion will result from only extracting signals starting with i:
- /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/"
+ /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/
+
+You may also provide an optional third argument regular
+expression, in which case only signals which have that pin
+direction and data type matching that regular expression will be
+included. This matches against everything before the signal name
+in the declaration, for example against \"input\" (single
+bit), \"output logic\" (direction and type)
+or \"output [1:0]\" (direction and implicit type). You also
+probably want to skip spaces in your regexp.
+
+For example, the below will result in matching the output \"o\"
+against the previous example's module:
+
+ /*AUTOINOUTCOMP(\"ExampMain\",\"\",\"^output.*\")*/
+
+You may also provide an optional fourth argument regular
+expression, which if not \"\" only signals which do NOT match
+that expression are included."
+ ;; Beware spacing of quotes in above as can mess up Emacs indenter
(verilog-auto-inout-module t nil))
(defun verilog-auto-inout-in ()
@@ -12046,7 +12493,7 @@ You may also provide an optional regular expression, in which case only
signals matching the regular expression will be included. For example the
same expansion will result from only extracting signals starting with i:
- /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/"
+ /*AUTOINOUTIN(\"ExampMain\",\"^i\")*/"
(verilog-auto-inout-module nil t))
(defun verilog-auto-inout-param ()
@@ -12062,67 +12509,36 @@ Limitations:
If placed inside the parenthesis of a module declaration, it creates
Verilog 2001 style, else uses Verilog 1995 style.
- Concatenation and outputting partial buses is not supported.
-
Module names must be resolvable to filenames. See `verilog-auto-inst'.
- Signals are not inserted in the same order as in the original module,
- though they will appear to be in the same order to an AUTOINST
- instantiating either module.
+ Parameters are inserted in the same order as in the original module.
- Signals declared as \"output reg\" or \"output wire\" etc will
- lose the wire/reg declaration so that shell modules may
- generate those outputs differently. However, \"output logic\"
- is propagated.
+ Parameters do not have values, which is SystemVerilog 2009 syntax.
An example:
- module ExampShell (/*AUTOARG*/);
- /*AUTOINOUTMODULE(\"ExampMain\")*/
+ module ExampShell ();
+ /*AUTOINOUTPARAM(\"ExampMain\")*/
endmodule
- module ExampMain (i,o,io);
- input i;
- output o;
- inout io;
+ module ExampMain ();
+ parameter PARAM = 22;
endmodule
Typing \\[verilog-auto] will make this into:
module ExampShell (/*AUTOARG*/i,o,io);
- /*AUTOINOUTMODULE(\"ExampMain\")*/
- // Beginning of automatic in/out/inouts (from specific module)
- output o;
- inout io;
- input i;
+ /*AUTOINOUTPARAM(\"ExampMain\")*/
+ // Beginning of automatic parameters (from specific module)
+ parameter PARAM;
// End of automatics
endmodule
You may also provide an optional regular expression, in which case only
-signals matching the regular expression will be included. For example the
-same expansion will result from only extracting signals starting with i:
-
- /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/
-
-You may also provide an optional second regular expression, in
-which case only signals which have that pin direction and data
-type will be included. This matches against everything before
-the signal name in the declaration, for example against
-\"input\" (single bit), \"output logic\" (direction and type) or
-\"output [1:0]\" (direction and implicit type). You also
-probably want to skip spaces in your regexp.
-
-For example, the below will result in matching the output \"o\"
-against the previous example's module:
-
- /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/
+parameters matching the regular expression will be included. For example the
+same expansion will result from only extracting parameters starting with i:
-You may also provide an optional third regular expression, in
-which case any parameter names that match the given regexp will
-be included. Including parameters is off by default. To include
-all signals and parameters, use:
-
- /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/"
+ /*AUTOINOUTPARAM(\"ExampMain\",\"^i\")*/"
(save-excursion
(let* ((params (verilog-read-auto-params 1 2))
(submod (nth 0 params))
@@ -12170,7 +12586,7 @@ Limitations:
Interface names must be resolvable to filenames. See `verilog-auto-inst'.
As with other autos, any inputs/outputs declared in the module
-will suppress the AUTO from redeclaring an input/output by
+will suppress the AUTO from redeclaring an inputs/outputs by
the same name.
An example:
@@ -12217,7 +12633,7 @@ driver/monitor using AUTOINST in the testbench."
(submod (nth 0 params))
(modport-re (nth 1 params))
(regexp (nth 2 params))
- direction-re submodi) ;; direction argument not supported until requested
+ direction-re submodi) ; direction argument not supported until requested
;; Lookup position, etc of co-module
;; Note this may raise an error
(when (setq submodi (verilog-modi-lookup submod t))
@@ -12227,19 +12643,19 @@ driver/monitor using AUTOINST in the testbench."
(moddecls (verilog-modi-get-decls modi))
(submoddecls (verilog-modi-get-decls submodi))
(submodportdecls (verilog-modi-modport-lookup submodi modport-re))
- (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (sig-list-i (verilog-signals-in ; Decls doesn't have data types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-inputs submodportdecls)
(append (verilog-decls-get-ports submoddecls)
(verilog-decls-get-ports moddecls)))))
- (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (sig-list-o (verilog-signals-in ; Decls doesn't have data types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-outputs submodportdecls)
(append (verilog-decls-get-ports submoddecls)
(verilog-decls-get-ports moddecls)))))
- (sig-list-io (verilog-signals-in ;; Decls doesn't have data types, must resolve
+ (sig-list-io (verilog-signals-in ; Decls doesn't have data types, must resolve
(verilog-decls-get-vars submoddecls)
(verilog-signals-not-in
(verilog-decls-get-inouts submodportdecls)
@@ -12270,9 +12686,13 @@ driver/monitor using AUTOINST in the testbench."
(defun verilog-auto-insert-lisp ()
"Expand AUTOINSERTLISP statements, as part of \\[verilog-auto].
-The Lisp code provided is called, and the Lisp code calls
-`insert` to insert text into the current file beginning on the
-line after the AUTOINSERTLISP.
+The Lisp code provided is called before other AUTOS are expanded,
+and the Lisp code generally will call `insert' to insert text
+into the current file beginning on the line after the
+AUTOINSERTLISP.
+
+See also AUTOINSERTLAST and `verilog-auto-insert-last' which
+executes after (as opposed to before) other AUTOs.
See also AUTO_LISP, which takes a Lisp expression and evaluates
it during `verilog-auto-inst' but does not insert any text.
@@ -12313,10 +12733,10 @@ text:
(let* ((indent-pt (current-indentation))
(cmd-end-pt (save-excursion (search-backward ")")
(forward-char)
- (point))) ;; Closing paren
+ (point))) ; Closing paren
(cmd-beg-pt (save-excursion (goto-char cmd-end-pt)
- (backward-sexp 1) ;; Inside comment
- (point))) ;; Beginning paren
+ (backward-sexp 1) ; Inside comment
+ (point))) ; Beginning paren
(cmd (buffer-substring-no-properties cmd-beg-pt cmd-end-pt)))
(verilog-forward-or-insert-line)
;; Some commands don't move point (like insert-file) so we always
@@ -12326,12 +12746,28 @@ text:
(forward-line -1)
(eval (read cmd))
(forward-line -1)
- (setq verilog-scan-cache-tick nil) ;; Clear cache; inserted unknown text
+ (setq verilog-scan-cache-tick nil) ; Clear cache; inserted unknown text
(verilog-delete-empty-auto-pair))))
+(defun verilog-auto-insert-last ()
+ "Expand AUTOINSERTLAST statements, as part of \\[verilog-auto].
+The Lisp code provided is called after all other AUTOS have been
+expanded, and the Lisp code generally will call `insert' to
+insert text into the current file beginning on the line after the
+AUTOINSERTLAST.
+
+Other than when called (after AUTOs are expanded), the functionality
+is otherwise identical to AUTOINSERTLISP and `verilog-auto-insert-lisp' which
+executes before (as opposed to after) other AUTOs.
+
+See `verilog-auto-insert-lisp' for examples."
+ (verilog-auto-insert-lisp))
+
(defun verilog-auto-sense-sigs (moddecls presense-sigs)
"Return list of signals for current AUTOSENSE block."
- (let* ((sigss (verilog-read-always-signals))
+ (let* ((sigss (save-excursion
+ (search-forward ")")
+ (verilog-read-always-signals)))
(sig-list (verilog-signals-not-params
(verilog-signals-not-in (verilog-alw-get-inputs sigss)
(append (and (not verilog-auto-sense-include-inputs)
@@ -12357,12 +12793,12 @@ Limitations:
lists. AUTOSENSE will thus exclude them, and add a /*memory or*/ comment.
Constant signals:
- AUTOSENSE cannot always determine if a `define is a constant or a signal
- (it could be in an include file for example). If a `define or other signal
+ AUTOSENSE cannot always determine if a \\=`define is a constant or a signal
+ (it could be in an include file for example). If a \\=`define or other signal
is put into the AUTOSENSE list and is not desired, use the AUTO_CONSTANT
declaration anywhere in the module (parenthesis are required):
- /* AUTO_CONSTANT ( `this_is_really_constant_dont_autosense_it ) */
+ /* AUTO_CONSTANT ( \\=`this_is_really_constant_dont_autosense_it ) */
Better yet, use a parameter, which will be understood to be constant
automatically.
@@ -12378,16 +12814,16 @@ OOps!
An example:
always @ (/*AS*/) begin
- /* AUTO_CONSTANT (`constant) */
- outin = ina | inb | `constant;
+ /* AUTO_CONSTANT (\\=`constant) */
+ outin = ina | inb | \\=`constant;
out = outin;
end
Typing \\[verilog-auto] will make this into:
always @ (/*AS*/ina or inb) begin
- /* AUTO_CONSTANT (`constant) */
- outin = ina | inb | `constant;
+ /* AUTO_CONSTANT (\\=`constant) */
+ outin = ina | inb | \\=`constant;
out = outin;
end
@@ -12395,7 +12831,7 @@ Note in Verilog 2001, you can often get the same result from the new @*
operator. (This was added to the language in part due to AUTOSENSE!)
always @* begin
- outin = ina | inb | `constant;
+ outin = ina | inb | \\=`constant;
out = outin;
end"
(save-excursion
@@ -12420,7 +12856,7 @@ operator. (This was added to the language in part due to AUTOSENSE!)
(let ((tlen (length sig-list)))
(setq sig-list (verilog-signals-not-in sig-list sig-memories))
(if (not (eq tlen (length sig-list))) (verilog-insert " /*memory or*/ "))))
- (if (and presense-sigs ;; Add a "or" if not "(.... or /*AUTOSENSE*/"
+ (if (and presense-sigs ; Add a "or" if not "(.... or /*AUTOSENSE*/"
(save-excursion (goto-char (point))
(verilog-re-search-backward-quick "[a-zA-Z0-9$_.%`]+" start-pt t)
(verilog-re-search-backward-quick "\\s-" start-pt t)
@@ -12473,8 +12909,8 @@ them to a one.
AUTORESET may try to reset arrays or structures that cannot be
reset by a simple assignment, resulting in compile errors. This
is a feature to be taken as a hint that you need to reset these
-signals manually (or put them into a \"`ifdef NEVER signal<=`0;
-`endif\" so Verilog-Mode ignores them.)
+signals manually (or put them into a \"\\=`ifdef NEVER signal<=\\=`0;
+\\=`endif\" so Verilog-Mode ignores them.)
An example:
@@ -12521,27 +12957,29 @@ Typing \\[verilog-auto] will make this into:
(save-excursion
(verilog-read-signals
(save-excursion
- (verilog-re-search-backward-quick "\\(@\\|\\<begin\\>\\|\\<if\\>\\|\\<case\\>\\)" nil t)
+ (verilog-re-search-backward-quick
+ "\\(@\\|\\<\\(begin\\|if\\|case\\|always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t)
(point))
(point)))))
(save-excursion
- (verilog-re-search-backward-quick "@" nil t)
+ (verilog-re-search-backward-quick "\\(@\\|\\<\\(always\\(_latch\\|_ff\\|_comb\\)?\\)\\>\\)" nil t)
(setq sigss (verilog-read-always-signals)))
(setq dly-list (verilog-alw-get-outputs-delayed sigss))
- (setq sig-list (verilog-signals-not-in (append
- (verilog-alw-get-outputs-delayed sigss)
- (when (or (not (verilog-alw-get-uses-delayed sigss))
- verilog-auto-reset-blocking-in-non)
- (verilog-alw-get-outputs-immediate sigss)))
- (append
- (verilog-alw-get-temps sigss)
- prereset-sigs)))
+ (setq sig-list (verilog-signals-not-in-struct
+ (append
+ (verilog-alw-get-outputs-delayed sigss)
+ (when (or (not (verilog-alw-get-uses-delayed sigss))
+ verilog-auto-reset-blocking-in-non)
+ (verilog-alw-get-outputs-immediate sigss)))
+ (append
+ (verilog-alw-get-temps sigss)
+ prereset-sigs)))
(setq sig-list (sort sig-list `verilog-signals-sort-compare))
(when sig-list
(insert "\n");
(verilog-insert-indent "// Beginning of autoreset for uninitialized flops\n");
(while sig-list
- (let ((sig (or (assoc (verilog-sig-name (car sig-list)) all-list) ;; As sig-list has no widths
+ (let ((sig (or (assoc (verilog-sig-name (car sig-list)) all-list) ; As sig-list has no widths
(car sig-list))))
(indent-to indent-pt)
(insert (verilog-sig-name sig)
@@ -12583,9 +13021,9 @@ An example of making a stub for another module:
/*AUTOINOUTMODULE(\"Foo\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
- wire _unused_ok = &{1'b0,
+ wire _unused_ok = &{1\\='b0,
/*AUTOUNUSED*/
- 1'b0};
+ 1\\='b0};
// verilator lint_on UNUSED
endmodule
@@ -12600,7 +13038,7 @@ Typing \\[verilog-auto] will make this into:
/*AUTOTIEOFF*/
// Beginning of autotieoff
- wire [2:0] foo = 3'b0;
+ wire [2:0] foo = 3\\='b0;
// End of automatics
...
endmodule"
@@ -12642,27 +13080,27 @@ Typing \\[verilog-auto] will make this into:
(defun verilog-auto-undef ()
"Expand AUTOUNDEF statements, as part of \\[verilog-auto].
-Take any `defines since the last AUTOUNDEF in the current file
-and create `undefs for them. This is used to insure that
-file-local defines do not pollute the global `define name space.
+Take any \\=`defines since the last AUTOUNDEF in the current file
+and create \\=`undefs for them. This is used to insure that
+file-local defines do not pollute the global \\=`define name space.
Limitations:
- AUTOUNDEF presumes any identifier following `define is the
- name of a define. Any `ifdefs are ignored.
+ AUTOUNDEF presumes any identifier following \\=`define is the
+ name of a define. Any \\=`ifdefs are ignored.
- AUTOUNDEF suppresses creating an `undef for any define that was
- `undefed before the AUTOUNDEF. This may be used to work around
- the ignoring of `ifdefs as shown below.
+ AUTOUNDEF suppresses creating an \\=`undef for any define that was
+ \\=`undefed before the AUTOUNDEF. This may be used to work around
+ the ignoring of \\=`ifdefs as shown below.
An example:
- `define XX_FOO
- `define M_BAR(x)
- `define M_BAZ
+ \\=`define XX_FOO
+ \\=`define M_BAR(x)
+ \\=`define M_BAZ
...
- `ifdef NEVER
- `undef M_BAZ // Emacs will see this and not `undef M_BAZ
- `endif
+ \\=`ifdef NEVER
+ \\=`undef M_BAZ // Emacs will see this and not \\=`undef M_BAZ
+ \\=`endif
...
/*AUTOUNDEF*/
@@ -12671,8 +13109,8 @@ Typing \\[verilog-auto] will make this into:
...
/*AUTOUNDEF*/
// Beginning of automatic undefs
- `undef XX_FOO
- `undef M_BAR
+ \\=`undef XX_FOO
+ \\=`undef M_BAR
// End of automatics
You may also provide an optional regular expression, in which case only
@@ -12693,7 +13131,7 @@ defines the regular expression will be undefed."
(setq def (match-string-no-properties 2))
(when (and (or (not regexp)
(string-match regexp def))
- (not (member def defs))) ;; delete-dups not in 21.1
+ (not (member def defs))) ; delete-dups not in 21.1
(setq defs (cons def defs))))
(t
(setq defs (delete (match-string-no-properties 2) defs))))))
@@ -12725,7 +13163,7 @@ with \"unused\" in the signal name.
To reduce simulation time, the _unused_ok signal should be forced to a
constant to prevent wiggling. The easiest thing to do is use a
-reduction-and with 1'b0 as shown.
+reduction-and with 1\\='b0 as shown.
This way all unused signals are in one place, making it convenient to add
your tool's specific pragmas around the assignment to disable any unused
@@ -12741,9 +13179,9 @@ An example of making a stub for another module:
/*AUTOINOUTMODULE(\"Examp\")*/
/*AUTOTIEOFF*/
// verilator lint_off UNUSED
- wire _unused_ok = &{1'b0,
+ wire _unused_ok = &{1\\='b0,
/*AUTOUNUSED*/
- 1'b0};
+ 1\\='b0};
// verilator lint_on UNUSED
endmodule
@@ -12751,14 +13189,14 @@ Typing \\[verilog-auto] will make this into:
...
// verilator lint_off UNUSED
- wire _unused_ok = &{1'b0,
+ wire _unused_ok = &{1\\='b0,
/*AUTOUNUSED*/
// Beginning of automatics
unused_input_a,
unused_input_b,
unused_input_c,
// End of automatics
- 1'b0};
+ 1\\='b0};
// verilator lint_on UNUSED
endmodule"
(interactive)
@@ -12833,9 +13271,9 @@ An example:
//== State enumeration
parameter [2:0] // synopsys enum state_info
- SM_IDLE = 3'b000,
- SM_SEND = 3'b001,
- SM_WAIT1 = 3'b010;
+ SM_IDLE = 3\\='b000,
+ SM_SEND = 3\\='b001,
+ SM_WAIT1 = 3\\='b010;
//== State variables
reg [2:0] /* synopsys enum state_info */
state_r; /* synopsys state_vector state_r */
@@ -12889,14 +13327,14 @@ Typing \\[verilog-auto] will make this into:
;;
(one-hot (or
(string-match "onehot" (or one-hot-flag ""))
- (and ;; width(enum) != width(sig)
+ (and ; width(enum) != width(sig)
(or (not (verilog-sig-bits (car enum-sigs)))
(not (equal (verilog-sig-width (car enum-sigs))
(verilog-sig-width undecode-sig))))
;; count(enums) == width(sig)
(equal (number-to-string (length enum-sigs))
(verilog-sig-width undecode-sig)))))
- (enum-chars 0)
+ (enum-chars 0)
(ascii-chars 0))
;;
;; Find number of ascii chars needed
@@ -12988,21 +13426,20 @@ Enable with `verilog-auto-template-warn-unused'."
(while tlines
(setq tpl-ass (car tlines)
tlines (cdr tlines))
- ;;;
- (unless (or (not (eval-when-compile (fboundp 'make-hash-table))) ;; Not supported, no warning
+ ;;
+ (unless (or (not (eval-when-compile (fboundp 'make-hash-table))) ; Not supported, no warning
(not verilog-auto-template-hits)
(gethash (vector (nth 2 tpl-ass) (nth 3 tpl-ass))
verilog-auto-template-hits))
(verilog-warn-error "%s:%d: AUTO_TEMPLATE line unused: \".%s (%s)\""
name1
- (+ (elt tpl-ass 3) ;; Template line number
+ (+ (elt tpl-ass 3) ; Template line number
(count-lines (point-min) (point)))
(elt tpl-ass 0) (elt tpl-ass 1))
)))))))
-;;
-;; Auto top level
+;;; Auto top level:
;;
(defun verilog-auto (&optional inject) ; Use verilog-inject-auto instead of passing an arg
@@ -13019,6 +13456,9 @@ Use \\[verilog-inject-auto] to insert AUTOs for the first time.
Use \\[verilog-faq] for a pointer to frequently asked questions.
+For new users, we recommend setting `verilog-case-fold' to nil
+and `verilog-auto-arg-sort' to t.
+
The hooks `verilog-before-auto-hook' and `verilog-auto-hook' are
called before and after this function, respectively.
@@ -13044,14 +13484,15 @@ Using \\[describe-function], see also:
`verilog-auto-arg' for AUTOARG module instantiations
`verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding
`verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport
+ `verilog-auto-inout' for AUTOINOUT making hierarchy inouts
`verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o
`verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o
`verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport
`verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere
`verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere
- `verilog-auto-inout' for AUTOINOUT making hierarchy inouts
`verilog-auto-input' for AUTOINPUT making hierarchy inputs
`verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function
+ `verilog-auto-insert-last' for AUTOINSERTLAST insert code from lisp function
`verilog-auto-inst' for AUTOINST instantiation pins
`verilog-auto-star' for AUTOINST .* SystemVerilog pins
`verilog-auto-inst-param' for AUTOINSTPARAM instantiation params
@@ -13061,14 +13502,14 @@ Using \\[describe-function], see also:
`verilog-auto-reg' for AUTOREG registers
`verilog-auto-reg-input' for AUTOREGINPUT instantiation registers
`verilog-auto-reset' for AUTORESET flop resets
- `verilog-auto-sense' for AUTOSENSE always sensitivity lists
+ `verilog-auto-sense' for AUTOSENSE or AS always sensitivity lists
`verilog-auto-tieoff' for AUTOTIEOFF output tieoffs
- `verilog-auto-undef' for AUTOUNDEF `undef of local `defines
+ `verilog-auto-undef' for AUTOUNDEF \\=`undef of local \\=`defines
`verilog-auto-unused' for AUTOUNUSED unused inputs/inouts
`verilog-auto-wire' for AUTOWIRE instantiation wires
- `verilog-read-defines' for reading `define values
- `verilog-read-includes' for reading `includes
+ `verilog-read-defines' for reading \\=`define values
+ `verilog-read-includes' for reading \\=`includes
If you have bugs with these autos, please file an issue at
URL `http://www.veripool.org/verilog-mode' or contact the AUTOAUTHOR
@@ -13080,6 +13521,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-save-font-mods
(let ((oldbuf (if (not (buffer-modified-p))
(buffer-string)))
+ (case-fold-search verilog-case-fold)
;; Cache directories; we don't write new files, so can't change
(verilog-dir-cache-preserving t)
;; Cache current module
@@ -13097,7 +13539,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;; we'll misremember we have generated IOs, confusing AUTOOUTPUT
(setq verilog-modi-cache-list nil)
;; Local state
- (setq verilog-auto-template-hits nil)
+ (verilog-read-auto-template-init)
;; If we're not in verilog-mode, change syntax table so parsing works right
(unless (eq major-mode `verilog-mode) (verilog-mode))
;; Allow user to customize
@@ -13127,7 +13569,6 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-inject-arg))
;;
;; Do user inserts first, so their code can insert AUTOs
- ;; We may provide an AUTOINSERTLISPLAST if another cleanup pass is needed
(verilog-auto-re-search-do "/\\*AUTOINSERTLISP(.*?)\\*/"
'verilog-auto-insert-lisp)
;; Expand instances before need the signals the instances input/output
@@ -13161,11 +13602,13 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg)
(verilog-auto-re-search-do "/\\*AUTOREGINPUT\\*/" 'verilog-auto-reg-input)
;; outputevery needs AUTOOUTPUTs done first
- (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\*/" 'verilog-auto-output-every)
+ (verilog-auto-re-search-do "/\\*AUTOOUTPUTEVERY\\((.*?)\\)?\\*/" 'verilog-auto-output-every)
;; After we've created all new variables
(verilog-auto-re-search-do "/\\*AUTOUNUSED\\*/" 'verilog-auto-unused)
;; Must be after all inputs outputs are generated
(verilog-auto-re-search-do "/\\*AUTOARG\\*/" 'verilog-auto-arg)
+ ;; User inserts
+ (verilog-auto-re-search-do "/\\*AUTOINSERTLAST(.*?)\\*/" 'verilog-auto-insert-last)
;; Fix line numbers (comments only)
(when verilog-auto-inst-template-numbers
(verilog-auto-templated-rel))
@@ -13190,10 +13633,9 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;; Currently handled in verilog-save-font-mods
))))
-
-;;
-;; Skeleton based code insertion
+;;; Skeletons:
;;
+
(defvar verilog-template-map
(let ((map (make-sparse-keymap)))
(define-key map "a" 'verilog-sk-always)
@@ -13210,7 +13652,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(define-key map "r" 'verilog-sk-repeat)
(define-key map "s" 'verilog-sk-specify)
(define-key map "t" 'verilog-sk-task)
- (define-key map "u" 'verilog-sk-uvm-class)
+ (define-key map "u" 'verilog-sk-uvm-object)
(define-key map "w" 'verilog-sk-while)
(define-key map "x" 'verilog-sk-casex)
(define-key map "z" 'verilog-sk-casez)
@@ -13223,6 +13665,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
(define-key map "O" 'verilog-sk-output)
(define-key map "S" 'verilog-sk-state-machine)
(define-key map "=" 'verilog-sk-inout)
+ (define-key map "U" 'verilog-sk-uvm-component)
(define-key map "W" 'verilog-sk-wire)
(define-key map "R" 'verilog-sk-reg)
(define-key map "D" 'verilog-sk-define-signal)
@@ -13239,7 +13682,7 @@ Wilson Snyder (wsnyder@wsnyder.org)."
;; Note \C-c and letter are reserved for users
(define-key verilog-mode-map "\C-c\C-t" verilog-template-map)
-;;; ---- statement skeletons ------------------------------------------
+;; ---- statement skeletons ------------------------------------------
(define-skeleton verilog-sk-prompt-condition
"Prompt for the loop condition."
@@ -13321,9 +13764,9 @@ See also `verilog-header' for an alternative format."
> _ \n
> (- verilog-indent-level-behavioral) "endmodule" (progn (electric-verilog-terminate-line) nil))
-;;; ------------------------------------------------------------------------
-;;; Define a default OVM class, with macros and new()
-;;; ------------------------------------------------------------------------
+;; ------------------------------------------------------------------------
+;; Define a default OVM class, with macros and new()
+;; ------------------------------------------------------------------------
(define-skeleton verilog-sk-ovm-class
"Insert a class definition"
@@ -13333,26 +13776,40 @@ See also `verilog-header' for an alternative format."
> "`ovm_object_utils_begin(" name ")" \n
> (- verilog-indent-level) " `ovm_object_utils_end" \n
> _ \n
- > "function new(name=\"" name "\");" \n
+ > "function new(string name=\"" name "\");" \n
> "super.new(name);" \n
> (- verilog-indent-level) "endfunction" \n
> _ \n
> "endclass" (progn (electric-verilog-terminate-line) nil))
-(define-skeleton verilog-sk-uvm-class
+(define-skeleton verilog-sk-uvm-object
"Insert a class definition"
()
> "class " (setq name (skeleton-read "Name: ")) " extends " (skeleton-read "Extends: ") ";" \n
> _ \n
> "`uvm_object_utils_begin(" name ")" \n
- > (- verilog-indent-level) " `uvm_object_utils_end" \n
+ > (- verilog-indent-level) "`uvm_object_utils_end" \n
> _ \n
- > "function new(name=\"" name "\");" \n
+ > "function new(string name=\"" name "\");" \n
> "super.new(name);" \n
> (- verilog-indent-level) "endfunction" \n
> _ \n
> "endclass" (progn (electric-verilog-terminate-line) nil))
+(define-skeleton verilog-sk-uvm-component
+ "Insert a class definition"
+ ()
+ > "class " (setq name (skeleton-read "Name: ")) " extends " (skeleton-read "Extends: ") ";" \n
+ > _ \n
+ > "`uvm_component_utils_begin(" name ")" \n
+ > (- verilog-indent-level) "`uvm_component_utils_end" \n
+ > _ \n
+ > "function new(string name=\"\", uvm_component parent);" \n
+ > "super.new(name, parent);" \n
+ > (- verilog-indent-level) "endfunction" \n
+ > _ \n
+ > "endclass" (progn (electric-verilog-terminate-line) nil))
+
(define-skeleton verilog-sk-primitive
"Insert a task definition."
()
@@ -13415,8 +13872,7 @@ for sensitivity list."
()
> "begin" '(verilog-sk-prompt-name) \n
> _ \n
- > (- verilog-indent-level-behavioral) "end"
-)
+ > (- verilog-indent-level-behavioral) "end" )
(define-skeleton verilog-sk-fork
"Insert a fork join block."
@@ -13500,12 +13956,12 @@ and the case items."
(interactive "*")
(let* ((sig-re "[a-zA-Z0-9_]*")
(v1 (buffer-substring
- (save-excursion
- (skip-chars-backward sig-re)
- (point))
- (save-excursion
- (skip-chars-forward sig-re)
- (point)))))
+ (save-excursion
+ (skip-chars-backward sig-re)
+ (point))
+ (save-excursion
+ (skip-chars-forward sig-re)
+ (point)))))
(if (not (member v1 verilog-keywords))
(save-excursion
(setq verilog-sk-signal v1)
@@ -13585,7 +14041,7 @@ and the case items."
resume: > (- verilog-case-indent) "endcase" (progn (electric-verilog-terminate-line) nil)
> (- verilog-indent-level-behavioral) "end" (progn (electric-verilog-terminate-line) nil))
-
+;;; Mouse Events:
;;
;; Include file loading with mouse/return event
;;
@@ -13614,13 +14070,13 @@ and the case items."
"Map containing mouse bindings for `verilog-mode'.")
-(defun verilog-highlight-region (beg end old-len)
+(defun verilog-highlight-region (beg end _old-len)
"Colorize included files and modules in the (changed?) region.
Clicking on the middle-mouse button loads them in a buffer (as in dired)."
(when (or verilog-highlight-includes
verilog-highlight-modules)
(save-excursion
- (save-match-data ;; A query-replace may call this function - do not disturb
+ (save-match-data ; A query-replace may call this function - do not disturb
(verilog-save-buffer-state
(verilog-save-scan-cache
(let (end-point)
@@ -13659,7 +14115,7 @@ Clicking on the middle-mouse button loads them in a buffer (as in dired)."
(save-excursion
(goto-char (match-beginning 0))
(unless (verilog-inside-comment-or-string-p)
- (verilog-read-inst-module-matcher) ;; sets match 0
+ (verilog-read-inst-module-matcher) ; sets match 0
(let* ((ov (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put ov 'start-closed 't)
(overlay-put ov 'end-closed 't)
@@ -13691,7 +14147,7 @@ Clicking on the middle-mouse button loads them in a buffer (as in dired)."
"Load file under button 2 click's EVENT.
Files are checked based on `verilog-library-flags'."
(interactive "@e")
- (save-excursion ;; implement a Verilog specific ffap-at-mouse
+ (save-excursion ; implement a Verilog specific ffap-at-mouse
(mouse-set-point event)
(verilog-load-file-at-point t)))
@@ -13703,7 +14159,7 @@ Files are checked based on `verilog-library-flags'."
If WARN, throw warning if not found.
Files are checked based on `verilog-library-flags'."
(interactive)
- (save-excursion ;; implement a Verilog specific ffap
+ (save-excursion ; implement a Verilog specific ffap
(let ((overlays (overlays-in (point) (point)))
hit)
(while (and overlays (not hit))
@@ -13725,11 +14181,11 @@ Files are checked based on `verilog-library-flags'."
(match-string 1) (buffer-file-name))))
(when warn
(message
- "File '%s' isn't readable, use shift-mouse2 to paste in this field"
+ "File `%s' isn't readable, use shift-mouse2 to paste in this field"
(match-string 1))))))))
-;;
-;; Bug reporting
+
+;;; Bug reporting:
;;
(defun verilog-faq ()
@@ -13797,6 +14253,7 @@ Files are checked based on `verilog-library-flags'."
verilog-before-getopt-flags-hook
verilog-before-save-font-hook
verilog-cache-enabled
+ verilog-case-fold
verilog-case-indent
verilog-cexp-indent
verilog-compiler
@@ -13823,7 +14280,6 @@ Files are checked based on `verilog-library-flags'."
verilog-linter
verilog-minimum-comment-distance
verilog-mode-hook
- verilog-mode-release-date
verilog-mode-release-emacs
verilog-mode-version
verilog-preprocessor
@@ -13865,6 +14321,7 @@ but instead, [[Fill in here]] happens!.
;; Local Variables:
;; checkdoc-permit-comma-termination-flag:t
;; checkdoc-force-docstrings-flag:nil
+;; indent-tabs-mode:nil
;; End:
;;; verilog-mode.el ends here
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 0050a94513a..9ee4ab520e1 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1,6 +1,6 @@
;;; vhdl-mode.el --- major mode for editing VHDL code
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
@@ -13,10 +13,10 @@
;; filed in the Emacs bug reporting system against this file, a copy
;; of the bug report be sent to the maintainer's email address.
-(defconst vhdl-version "3.34.2"
+(defconst vhdl-version "3.37.1"
"VHDL Mode version number.")
-(defconst vhdl-time-stamp "2012-11-21"
+(defconst vhdl-time-stamp "2015-01-15"
"VHDL Mode time stamp for last update.")
;; This file is part of GNU Emacs.
@@ -59,7 +59,7 @@
;; - Block commenting
;; - Code fixing/alignment/beautification
;; - PostScript printing
-;; - VHDL'87/'93 and VHDL-AMS supported
+;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported
;; - Comprehensive menu
;; - Fully customizable
;; - Works under GNU Emacs (recommended) and XEmacs
@@ -72,12 +72,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Emacs Versions
-;; this updated version was only tested on: GNU Emacs 20.4
+;; this updated version was only tested on: GNU Emacs 24.1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Installation
-;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X.
+;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21.
;; Put `vhdl-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
@@ -164,7 +164,7 @@
'/' or is empty)."
(let ((val (widget-value widget)))
(unless (string-match "^\\(\\|.*/\\)$" val)
- (widget-put widget :error "Invalid directory entry: must end with '/'")
+ (widget-put widget :error "Invalid directory entry: must end with `/'")
widget)))
;; help string for user options
@@ -215,20 +215,20 @@ Overrides local variable `indent-tabs-mode'."
;; [Error] Assignment error: variable is illegal target of signal assignment
("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
- ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1)
+ ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1)
("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
"PACK/\\1.vif" "BODY/\\1.vif" upcase))
;; Aldec
;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3
("Aldec" "vcom" "-work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
- (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
+ ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
nil)
;; Cadence Leapfrog: cv -file test.vhd
;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
- ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1/entity" "\\2/\\1" "\\1/configuration"
"\\1/package" "\\1/body" downcase))
;; Cadence Affirma NC vhdl: ncvhdl test.vhd
@@ -236,27 +236,29 @@ Overrides local variable `indent-tabs-mode'."
;; (PLL_400X_TOP) is not declared [10.3].
("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
- ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
"\\1/package/pc.db" "\\1/body/pc.db" downcase))
- ;; ghdl vhdl: ghdl test.vhd
+ ;; ghdl vhdl
+ ;; ghdl -a bad_counter.vhdl
+ ;; bad_counter.vhdl:13:14: operator "=" is overloaded
("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
- ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
+ ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
("\\1/entity" "\\2/\\1" "\\1/configuration"
"\\1/package" "\\1/body" downcase))
;; IBM Compiler
;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6
("IBM Compiler" "g2tvc" "-src" "precomp" "\\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ibm"
- ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
+ ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
nil)
;; Ikos Voyager: analyze test.vhd
;; analyze test.vhd
;; E L4/C5: this library unit is inaccessible
("Ikos" "analyze" "-l \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
- ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
+ ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
nil)
;; ModelSim, Model Technology: vcom test.vhd
@@ -266,14 +268,14 @@ Overrides local variable `indent-tabs-mode'."
;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
- ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0)
+ ("^\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\\[[0-9]+]\\)? \\([^ \t\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
;; test.vhd:34: error message
("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
- ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
+ ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
"PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
;; Quartus compiler
@@ -284,21 +286,21 @@ Overrides local variable `indent-tabs-mode'."
;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ...
("Quartus" "make" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "quartus"
- ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
+ ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
nil)
;; QuickHDL, Mentor Graphics: qvhcom test.vhd
;; ERROR: test.vhd(24): near "dnd": expecting: END
;; WARNING[4]: test.vhd(30): A space is required between ...
("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
- ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
+ ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
"\\1/_primary.dat" "\\1/body.dat" downcase))
;; Savant: scram -publish-cc test.vhd
;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
- ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
+ ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
"\\1_config.vhdl" "\\1_package.vhdl"
"\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
@@ -306,39 +308,39 @@ Overrides local variable `indent-tabs-mode'."
;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "simili"
- ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
+ ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
"\\1/prim.var" "\\1/_body.var" downcase))
;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
- ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
+ ("^ *ERROR\\[[0-9]+]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
nil)
;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
- ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
- ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
+ ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
;; Synplify:
;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
("Synplify" "n/a" "n/a" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
- ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
+ ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
nil)
;; Vantage: analyze -libfile vsslib.ini -src test.vhd
;; Compiling "test.vhd" line 1...
;; **Error: LINE 49 *** No aggregate value is valid in this context.
("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
- ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
+ ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
;; VeriBest: vc vhdl test.vhd
@@ -355,14 +357,14 @@ Overrides local variable `indent-tabs-mode'."
;; **Error: LINE 49 *** No aggregate value is valid in this context.
("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
- ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
+ ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
("^ *Compiling \"\\(.+\\)\" " 1)
nil)
;; Xilinx XST:
;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
("Xilinx XST" "xflow" "" "make" "-f \\1"
nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
- ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0)
+ ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil) ("" 0)
nil)
)
"List of available VHDL compilers and their properties.
@@ -374,8 +376,8 @@ Compiler:
Make command : command used for compilation using a Makefile
Make options : make options (\"\\1\" inserts Makefile name)
Generate Makefile: use built-in function or command to generate a Makefile
- \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
- Library command : command to create library directory \(\"\\1\" inserts
+ (\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
+ Library command : command to create library directory (\"\\1\" inserts
library directory, \"\\2\" inserts library name)
Compile directory: where compilation is run and the Makefile is placed
Library directory: directory of default library
@@ -392,7 +394,8 @@ File message:
Unit-to-file name mapping: mapping of library unit names to names of files
generated by the compiler (used for Makefile generation)
To string : string a name is mapped to (\"\\1\" inserts the unit name,
- \"\\2\" inserts the entity name for architectures)
+ \"\\2\" inserts the entity name for architectures,
+ \"\\3\" inserts the library name)
Case adjustment : adjust case of inserted unit names
\(*) The regular expression must match the error message starting from the
@@ -486,7 +489,7 @@ Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
(append '(choice) (nreverse list)))
:group 'vhdl-compile)
-(defcustom vhdl-compile-use-local-error-regexp t
+(defcustom vhdl-compile-use-local-error-regexp nil
"Non-nil means use buffer-local `compilation-error-regexp-alist'.
In this case, only error message regexps for VHDL compilers are active if
compilation is started from a VHDL buffer. Otherwise, the error message
@@ -495,6 +498,7 @@ active all the time. Note that by doing that, the predefined global regexps
might result in erroneous parsing of error messages for some VHDL compilers.
NOTE: Activate the new setting by restarting Emacs."
+ :version "25.1" ; t -> nil
:type 'boolean
:group 'vhdl-compile)
@@ -502,7 +506,7 @@ NOTE: Activate the new setting by restarting Emacs."
"List of default target names in Makefiles.
Automatically generated Makefiles include three default targets to compile
the entire design, clean the entire design and to create the design library.
-This option allows to change the names of these targets to avoid conflicts
+This option allows you to change the names of these targets to avoid conflicts
with other user Makefiles."
:type '(list (string :tag "Compile entire design")
(string :tag "Clean entire design ")
@@ -512,12 +516,12 @@ with other user Makefiles."
(defcustom vhdl-makefile-generation-hook nil
"Functions to run at the end of Makefile generation.
-Allows to insert user specific parts into a Makefile.
+Allows you to insert user specific parts into a Makefile.
Example:
- \(lambda nil
- \(re-search-backward \"^# Rule for compiling entire design\")
- \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
+ (lambda nil
+ (re-search-backward \"^# Rule for compiling entire design\")
+ (insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
:type 'hook
:group 'vhdl-compile)
@@ -569,7 +573,7 @@ Is overwritten by project settings if a project is active."
\"\\3\" project-specific options)
- Do not compile: do not compile this file (in Makefile)
Compile directory: where compilation is run and the Makefile is placed
- \(\"\\1\" inserts compiler ID string)
+ (\"\\1\" inserts compiler ID string)
Library name : name of library (default is \"work\")
Library directory: path to library (\"\\1\" inserts compiler ID string)
Makefile name : name of Makefile
@@ -589,8 +593,8 @@ well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute.
Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are
specified, the default directory is taken as source directory. Otherwise,
the default directory is only taken as source directory if there is a sources
-entry with the empty string or \"./\". Exclude regexp allows to filter out
-specific file and directory names from the list of sources (e.g. CVS
+entry with the empty string or \"./\". Exclude regexp allows you to filter
+out specific file and directory names from the list of sources (e.g. CVS
directories).
Files are compiled in the compile directory. Makefiles are also placed into
@@ -605,7 +609,7 @@ overwrite the settings of the current compiler.
File-specific compiler options (highest priority) overwrite project-specific
options which overwrite default options (lowest priority). Lower priority
-options can be inserted in higher priority options. This allows to reuse
+options can be inserted in higher priority options. This allows you to reuse
default options (e.g. \"-file\") in project- or file-specific options (e.g.
\"-93 -file\").
@@ -670,7 +674,7 @@ browser. The current project can also be changed temporarily in the menu."
(defcustom vhdl-project-file-name '("\\1.prj")
"List of file names/paths for importing/exporting project setups.
\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
-replaced by the user name (allows to have user-specific project setups).
+replaced by the user name (allows you to have user-specific project setups).
The first entry is used as file name to import/export individual project
setups. All entries are used to automatically import project setups at
startup (see option `vhdl-project-auto-load'). Projects loaded from the
@@ -712,6 +716,7 @@ A project setup file can be obtained by exporting a project (see menu).
Basic standard:
VHDL'87 : IEEE Std 1076-1987
VHDL'93/02 : IEEE Std 1076-1993/2002
+ VHDL'08 : IEEE Std 1076-2008
Additional standards:
VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
@@ -720,7 +725,8 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
\"Activate Options\"."
:type '(list (choice :tag "Basic standard"
(const :tag "VHDL'87" 87)
- (const :tag "VHDL'93/02" 93))
+ (const :tag "VHDL'93/02" 93)
+ (const :tag "VHDL'08" 08))
(set :tag "Additional standards" :indent 2
(const :tag "VHDL-AMS" ams)
(const :tag "Math packages" math)))
@@ -938,6 +944,12 @@ If nil, only a list of actual parameters is entered."
:type 'boolean
:group 'vhdl-template)
+(defcustom vhdl-sensitivity-list-all t
+ "Non-nil means use 'all' keyword in sensitivity list."
+ :version "25.1"
+ :type 'boolean
+ :group 'vhdl-template)
+
(defcustom vhdl-zero-string "'0'"
"String to use for a logic zero."
:type 'string
@@ -985,7 +997,7 @@ if the header needs to be version controlled.
The following keywords for template generation are supported:
<filename> : replaced by the name of the buffer
<author> : replaced by the user name and email address
- \(`user-full-name',`mail-host-address', `user-mail-address')
+ (`user-full-name',`mail-host-address', `user-mail-address')
<authorfull> : replaced by the user full name (`user-full-name')
<login> : replaced by user login name (`user-login-name')
<company> : replaced by contents of option `vhdl-company-name'
@@ -1069,7 +1081,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry
"Customizations for sequential processes."
:group 'vhdl-template)
-(defcustom vhdl-reset-kind 'async
+(defcustom vhdl-reset-kind 'async
"Specifies which kind of reset to use in sequential processes."
:type '(choice (const :tag "None" none)
(const :tag "Synchronous" sync)
@@ -1539,8 +1551,8 @@ Option `vhdl-align-groups' still applies within these blocks."
:group 'vhdl-beautify)
(defcustom vhdl-beautify-options '(t t t t t)
- "List of options for beautifying code. Allows to disable individual
-features of code beautification."
+ "List of options for beautifying code.
+Allows you to disable individual features of code beautification."
:type '(list (boolean :tag "Whitespace cleanup ")
(boolean :tag "Single statement per line")
(boolean :tag "Indentation ")
@@ -1666,8 +1678,8 @@ syntax (as regular expression) are highlighted in the corresponding color.
Name : string of words and spaces
Regexp : regular expression describing word syntax
- (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
- expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
+ (e.g., `\\=\\<\\w+_c\\>' matches word with suffix `_c')
+ expression must start with `\\=\\<' and end with `\\>'
if only whole words should be matched (no substrings)
Color (light): foreground color for light background
(matching color examples: Gold3, Grey50, LimeGreen, Tomato,
@@ -1678,14 +1690,14 @@ syntax (as regular expression) are highlighted in the corresponding color.
In comments : If non-nil, words are also highlighted inside comments
Can be used for visual support of naming conventions, such as highlighting
-different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
-\"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
+different kinds of signals (e.g. `Clk50', `Rst_n') or objects (e.g.
+`Signal_s', `Variable_v', `Constant_c') by distinguishing them using
common substrings or name suffices.
For each entry, a new face is generated with the specified colors and name
-\"vhdl-font-lock-\" + name + \"-face\".
+`vhdl-font-lock-' + name + `-face'.
NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
- entry \"Fontify Buffer\"). All other changes require restarting Emacs."
+ entry `Fontify Buffer'). All other changes require restarting Emacs."
:type '(repeat (list :tag "Face" :indent 2
(string :tag "Name ")
(regexp :tag "Regexp " "\\w+_")
@@ -1724,7 +1736,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
'vhdl-words-init 'vhdl-font-lock-init))
:group 'vhdl-highlight)
-(defcustom vhdl-directive-keywords '("pragma" "synopsys")
+(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
"List of compiler directive keywords recognized for highlighting.
NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
@@ -1997,6 +2009,8 @@ reported and the syntactic symbol is ignored.")
(package . 0)
(architecture . 0)
(package-body . 0)
+ (context . 0)
+ (directive . 0)
)
"Default settings for offsets of syntactic elements.
Do not change this constant! See the variable `vhdl-offsets-alist' for
@@ -2061,7 +2075,8 @@ Here is the current list of valid syntactic element symbols:
configuration -- inside a configuration declaration
package -- inside a package declaration
architecture -- inside an architecture body
- package-body -- inside a package body")
+ package-body -- inside a package body
+ context -- inside a context declaration")
(defvar vhdl-comment-only-line-offset 0
"Extra offset for line which contains only the start of a comment.
@@ -2125,7 +2140,6 @@ your style, only those that are different from the default.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mandatory
-(require 'assoc)
(require 'compile) ; XEmacs
(require 'easymenu)
(require 'hippie-exp)
@@ -2137,6 +2151,36 @@ your style, only those that are different from the default.")
(require 'ps-print)
(require 'speedbar))) ; for speedbar-with-writable
+(defun vhdl-aput (alist-symbol key &optional value)
+ "Insert a key-value pair into an alist.
+The alist is referenced by ALIST-SYMBOL. The key-value pair is made
+from KEY and VALUE. If the key-value pair referenced by KEY can be
+found in the alist, the value of KEY will be set to VALUE. If the
+key-value pair cannot be found in the alist, it will be inserted into
+the head of the alist."
+ (let* ((alist (symbol-value alist-symbol))
+ (elem (assoc key alist)))
+ (if elem
+ (setcdr elem value)
+ (set alist-symbol (cons (cons key value) alist)))))
+
+(defun vhdl-adelete (alist-symbol key)
+ "Delete a key-value pair from the alist.
+Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
+is pair matching KEY."
+ (let ((alist (symbol-value alist-symbol)) alist-cdr)
+ (while (equal key (caar alist))
+ (setq alist (cdr alist))
+ (set alist-symbol alist))
+ (while (setq alist-cdr (cdr alist))
+ (if (equal key (caar alist-cdr))
+ (setcdr alist (cdr alist-cdr))
+ (setq alist alist-cdr)))))
+
+(defun vhdl-aget (alist key)
+ "Return the value in ALIST that is associated with KEY. If KEY is
+not found, then nil is returned."
+ (cdr (assoc key alist)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Compatibility
@@ -2256,17 +2300,17 @@ Ignore byte-compiler warnings you might see."
"Wait until idle, then run FUNCTION."
(if (fboundp 'start-itimer)
(start-itimer "vhdl-mode" function secs repeat t)
-; (run-with-idle-timer secs repeat function)))
;; explicitly activate timer (necessary when Emacs is already idle)
(aset (run-with-idle-timer secs repeat function) 0 nil)))
(defun vhdl-warning-when-idle (&rest args)
"Wait until idle, then print out warning STRING and beep."
- (if noninteractive
- (vhdl-warning (apply 'format args) t)
- (unless vhdl-warnings
- (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
- (push (apply 'format args) vhdl-warnings)))
+ (let ((message (apply #'format-message args)))
+ (if noninteractive
+ (vhdl-warning message t)
+ (unless vhdl-warnings
+ (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
+ (push message vhdl-warnings))))
(defun vhdl-warning (string &optional nobeep)
"Print out warning STRING and beep."
@@ -2429,7 +2473,7 @@ specified."
current buffer if no project is defined."
(if (vhdl-project-p)
(expand-file-name (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist vhdl-project))))
+ (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
default-directory))
(defmacro vhdl-prepare-search-1 (&rest body)
@@ -2443,37 +2487,18 @@ consistent searching."
(defmacro vhdl-prepare-search-2 (&rest body)
"Enable case insensitive search, switch to syntax table that includes '_',
-and remove `intangible' overlays, then execute BODY, and finally restore the
-old environment. Used for consistent searching."
- ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef
+arrange to ignore `intangible' overlays, then execute BODY, and finally restore
+the old environment. Used for consistent searching."
`(let ((case-fold-search t) ; case insensitive search
(current-syntax-table (syntax-table))
- overlay-all-list overlay-intangible-list overlay)
+ (inhibit-point-motion-hooks t))
;; use extended syntax table
(set-syntax-table vhdl-mode-ext-syntax-table)
- ;; remove `intangible' overlays
- (when (fboundp 'overlay-lists)
- (setq overlay-all-list (overlay-lists))
- (setq overlay-all-list
- (append (car overlay-all-list) (cdr overlay-all-list)))
- (while overlay-all-list
- (setq overlay (car overlay-all-list))
- (when (memq 'intangible (overlay-properties overlay))
- (setq overlay-intangible-list
- (cons overlay overlay-intangible-list))
- (overlay-put overlay 'intangible nil))
- (setq overlay-all-list (cdr overlay-all-list))))
;; execute BODY safely
(unwind-protect
(progn ,@body)
;; restore syntax table
- (set-syntax-table current-syntax-table)
- ;; restore `intangible' overlays
- (when (fboundp 'overlay-lists)
- (while overlay-intangible-list
- (overlay-put (car overlay-intangible-list) 'intangible t)
- (setq overlay-intangible-list
- (cdr overlay-intangible-list)))))))
+ (set-syntax-table current-syntax-table))))
(defmacro vhdl-visit-file (file-name issue-error &rest body)
"Visit file FILE-NAME and execute BODY."
@@ -2537,11 +2562,11 @@ conversion."
(setq file-list (cdr file-list)))
dir-list))
-(defun vhdl-aput (alist-symbol key &optional value)
+(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
"As `aput', but delete key-value pair if VALUE is nil."
(if value
- (aput alist-symbol key value)
- (adelete alist-symbol key)))
+ (vhdl-aput alist-symbol key value)
+ (vhdl-adelete alist-symbol key)))
(defun vhdl-delete (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
@@ -2596,11 +2621,6 @@ conversion."
(set-buffer (marker-buffer marker)))
(goto-char marker))
-(defun vhdl-goto-line (line)
- "Use this instead of calling user level function `goto-line'."
- (goto-char (point-min))
- (forward-line (1- line)))
-
(defun vhdl-menu-split (list title)
"Split menu LIST into several submenus, if number of
elements > `vhdl-menu-max-size'."
@@ -2657,6 +2677,7 @@ elements > `vhdl-menu-max-size'."
(define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
(define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
(define-key vhdl-template-map "co" 'vhdl-template-constant)
+ (define-key vhdl-template-map "ct" 'vhdl-template-context)
(define-key vhdl-template-map "di" 'vhdl-template-disconnect)
(define-key vhdl-template-map "el" 'vhdl-template-else)
(define-key vhdl-template-map "ei" 'vhdl-template-elsif)
@@ -2936,7 +2957,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(modify-syntax-entry ?\* "." st)
(modify-syntax-entry ?\+ "." st)
(modify-syntax-entry ?\. "." st)
- (modify-syntax-entry ?\/ "." st)
+;;; (modify-syntax-entry ?\/ "." st)
(modify-syntax-entry ?\: "." st)
(modify-syntax-entry ?\; "." st)
(modify-syntax-entry ?\< "." st)
@@ -2948,11 +2969,13 @@ STRING are replaced by `-' and substrings are converted to lower case."
(modify-syntax-entry ?\" "\"" st)
;; define underscore
(modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
- ;; a single hyphen is punctuation, but a double hyphen starts a comment
- (modify-syntax-entry ?\- ". 12" st)
- ;; and \n and \^M end a comment
- (modify-syntax-entry ?\n ">" st)
- (modify-syntax-entry ?\^M ">" st)
+ ;; single-line comments
+ (modify-syntax-entry ?\- ". 12b" st)
+ ;; multi-line comments
+ (modify-syntax-entry ?\/ ". 14b" st)
+ (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?\n "> b" st)
+ (modify-syntax-entry ?\^M "> b" st)
;; define parentheses to match
(modify-syntax-entry ?\( "()" st)
(modify-syntax-entry ?\) ")(" st)
@@ -2975,7 +2998,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
(make-variable-buffer-local 'vhdl-syntactic-context)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Abbrev ook bindings
+;; Abbrev hook bindings
(defvar vhdl-mode-abbrev-table nil
"Abbrev table to use in `vhdl-mode' buffers.")
@@ -2985,8 +3008,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
(define-abbrev-table 'vhdl-mode-abbrev-table
(append
(when (memq 'vhdl vhdl-electric-keywords)
- ;; VHDL'93 keywords
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ ;; VHDL'02 keywords
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("--" . vhdl-template-display-comment-hook)
("abs" . vhdl-template-default-hook)
@@ -3015,6 +3040,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
("configuration" . vhdl-template-configuration-hook)
("cons" . vhdl-template-constant-hook)
("constant" . vhdl-template-constant-hook)
+ ("context" . vhdl-template-context-hook)
("disconnect" . vhdl-template-disconnect-hook)
("downto" . vhdl-template-default-hook)
("else" . vhdl-template-else-hook)
@@ -3102,7 +3128,9 @@ STRING are replaced by `-' and substrings are converted to lower case."
)))
;; VHDL-AMS keywords
(when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
- (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ (mapcar (if (featurep 'xemacs)
+ (lambda (x) (list (car x) "" (cdr x) 0))
+ (lambda (x) (list (car x) "" (cdr x) 0 'system)))
'(
("across" . vhdl-template-default-hook)
("break" . vhdl-template-break-hook)
@@ -3160,6 +3188,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
("configuration declaration" vhdl-template-configuration-decl)
("configuration specification" vhdl-template-configuration-spec)
("constant declaration" vhdl-template-constant)
+ ("context declaration" vhdl-template-context)
("disconnection specification" vhdl-template-disconnect)
("entity declaration" vhdl-template-entity)
("exit statement" vhdl-template-exit)
@@ -3336,6 +3365,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
["Configuration (Decl)" vhdl-template-configuration-decl t]
["Configuration (Spec)" vhdl-template-configuration-spec t]
["Constant" vhdl-template-constant t]
+ ["Context" vhdl-template-context t]
["Disconnect" vhdl-template-disconnect t]
["Else" vhdl-template-else t]
["Elsif" vhdl-template-elsif t]
@@ -3677,6 +3707,11 @@ STRING are replaced by `-' and substrings are converted to lower case."
(list '93 (cadr vhdl-standard)))
(vhdl-activate-customizations))
:style radio :selected (eq '93 (car vhdl-standard))]
+ ["VHDL'08"
+ (progn (customize-set-variable 'vhdl-standard
+ (list '08 (cadr vhdl-standard)))
+ (vhdl-activate-customizations))
+ :style radio :selected (eq '08 (car vhdl-standard))]
"--"
["VHDL-AMS"
(progn (customize-set-variable
@@ -3799,6 +3834,10 @@ STRING are replaced by `-' and substrings are converted to lower case."
(customize-set-variable 'vhdl-conditions-in-parenthesis
(not vhdl-conditions-in-parenthesis))
:style toggle :selected vhdl-conditions-in-parenthesis]
+ ["Sensitivity List uses 'all'"
+ (customize-set-variable 'vhdl-sensitivity-list-all
+ (not vhdl-sensitivity-list-all))
+ :style toggle :selected vhdl-sensitivity-list-all]
["Zero String..." (customize-option 'vhdl-zero-string) t]
["One String..." (customize-option 'vhdl-one-string) t]
("File Header"
@@ -4193,6 +4232,9 @@ STRING are replaced by `-' and substrings are converted to lower case."
("Entity"
"^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
2)
+ ("Context"
+ "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
+ 2)
)
"Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
@@ -4281,7 +4323,7 @@ Usage:
TEMPLATE INSERTION (electrification):
After typing a VHDL keyword and entering `SPC', you are prompted for
arguments while a template is generated for that VHDL construct. Typing
- `RET' or `C-g' at the first \(mandatory) prompt aborts the current
+ `RET' or `C-g' at the first (mandatory) prompt aborts the current
template generation. Optional arguments are indicated by square
brackets and removed if the queried string is left empty. Prompts for
mandatory arguments remain in the code if the queried string is left
@@ -4300,7 +4342,7 @@ Usage:
conf, comp, cons, func, inst, pack, sig, var.
Template styles can be customized in customization group
- `vhdl-template' \(see OPTIONS).
+ `vhdl-template' (see OPTIONS).
HEADER INSERTION:
@@ -4319,7 +4361,7 @@ Usage:
;;; --> \" := \" [[ --> [ --CR --> comment-out code
.. --> \" => \" ] --> ) --- --> horizontal line
,, --> \" <= \" ]] --> ] ---- --> display comment
- == --> \" == \" '' --> \\\"
+ == --> \" == \" \\='\\=' --> \\\"
WORD COMPLETION:
@@ -4331,7 +4373,7 @@ Usage:
Typing `TAB' after `(' looks for and inserts complete parenthesized
expressions (e.g. for array index ranges). All keywords as well as
standard types and subprograms of VHDL have predefined abbreviations
- \(e.g. type \"std\" and `TAB' will toggle through all standard types
+ (e.g., type \"std\" and `TAB' will toggle through all standard types
beginning with \"std\").
Typing `TAB' after a non-word character indents the line if at the
@@ -4375,16 +4417,16 @@ Usage:
the entire region.
Indentation can be done for a group of lines (`C-c C-i C-g'), a region
- \(`M-C-\\') or the entire buffer (menu). Argument and port lists are
+ (`M-C-\\') or the entire buffer (menu). Argument and port lists are
indented normally (nil) or relative to the opening parenthesis (non-nil)
according to option `vhdl-argument-list-indent'.
If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
- tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
+ tabs. `\\[tabify]' and `\\[untabify]' allow to convert spaces to tabs
and vice versa.
Syntax-based indentation can be very slow in large files. Option
- `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
+ `vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
Option `vhdl-indent-comment-like-next-code-line' controls whether
comment lines are indented like the preceding or like the following code
@@ -4417,7 +4459,7 @@ Usage:
CODE FILLING:
- Code filling allows to condense code (e.g. sensitivity lists or port
+ Code filling allows you to condense code (e.g. sensitivity lists or port
maps) by removing comments and newlines and re-wrapping so that all
lines are maximally filled (block filling). `C-c C-f C-f' fills a list
enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
@@ -4521,7 +4563,7 @@ Usage:
Enables simple structural composition. `C-c C-m C-n' creates a skeleton
for a new component. Subcomponents (i.e. component declaration and
instantiation) can be automatically placed from a previously read port
- \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
+ (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally,
all subcomponents can be automatically connected using internal signals
and ports (`C-c C-m C-w') following these rules:
- subcomponent actual ports with same name are considered to be
@@ -4646,7 +4688,7 @@ Usage:
VHDL STANDARDS:
The VHDL standards to be used are specified in option `vhdl-standard'.
- Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
+ Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
KEYWORD CASE:
@@ -4677,7 +4719,7 @@ Usage:
Words with special syntax can be highlighted by specifying their
syntax and color in option `vhdl-special-syntax-alist' and by setting
- option `vhdl-highlight-special-words' to non-nil. This allows to
+ option `vhdl-highlight-special-words' to non-nil. This allows you to
establish some naming conventions (e.g. to distinguish different kinds
of signals or other objects by using name suffices) and to support them
visually.
@@ -4691,7 +4733,7 @@ Usage:
`vhdl-highlight-translate-off' is non-nil.
For documentation and customization of the used colors see
- customization group `vhdl-highlight-faces' (`M-x customize-group'). For
+ customization group `vhdl-highlight-faces' (`\\[customize-group]'). For
highlighting of matching parenthesis, see customization group
`paren-showing'. Automatic buffer highlighting is turned on/off by
option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
@@ -4721,7 +4763,7 @@ Usage:
Insert them once manually (will be kept afterwards).
- Out parameters of procedures are considered to be read.
Use option `vhdl-entity-file-name' to specify the entity file name
- \(used to obtain the port names).
+ (used to obtain the port names).
Use option `vhdl-array-index-record-field-in-sensitivity-list' to
specify whether to include array indices and record fields in
sensitivity lists.
@@ -4729,12 +4771,12 @@ Usage:
CODE FIXING:
`C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
- \(e.g. if the closing parenthesis is on the wrong line or is missing).
+ (e.g., if the closing parenthesis is on the wrong line or is missing).
PRINTING:
PostScript printing with different faces (an optimized set of faces is
- used if `vhdl-print-customize-faces' is non-nil) or colors \(if
+ used if `vhdl-print-customize-faces' is non-nil) or colors (if
`ps-print-color-p' is non-nil) is possible using the standard Emacs
PostScript printing commands. Option `vhdl-print-two-column' defines
appropriate default settings for nice landscape two-column printing.
@@ -4751,14 +4793,14 @@ Usage:
sessions using the \"Save Options\" menu entry.
Options and their detailed descriptions can also be accessed by using
- the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
- customize-group' for groups). Some customizations only take effect
+ the \"Customize\" menu entry or the command `\\[customize-option]'
+ (`\\[customize-group]' for groups). Some customizations only take effect
after some action (read the NOTE in the option documentation).
Customization can also be done globally (i.e. site-wide, read the
INSTALL file).
Not all options are described in this documentation, so go and see
- what other useful user options there are (`M-x vhdl-customize' or menu)!
+ what other useful user options there are (`\\[vhdl-customize]' or menu)!
FILE EXTENSIONS:
@@ -4766,7 +4808,7 @@ Usage:
automatically recognized as VHDL source files. To add an extension
\".xxx\", add the following line to your Emacs start-up file (`.emacs'):
- \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
+ (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist)
HINTS:
@@ -4787,7 +4829,7 @@ Usage:
Maintenance:
------------
-To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
+To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
Add a description of the problem and include a reproducible test case.
Questions and enhancement requests can be sent to <reto@gnu.org>.
@@ -4822,7 +4864,7 @@ Key bindings:
;; set local variables
(set (make-local-variable 'paragraph-start)
- "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
+ "\\s-*\\(--+\\s-*$\\|$\\)")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
@@ -4853,16 +4895,14 @@ Key bindings:
(syntax-propertize-rules
;; Mark single quotes as having string quote syntax in
;; 'c' instances.
- ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
+ ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
(set (make-local-variable 'font-lock-syntactic-keywords)
vhdl-font-lock-syntactic-keywords))
(unless vhdl-emacs-21
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
(set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
-; (set (make-local-variable 'lazy-lock-defer-time) 0.1)
(set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
-; (turn-on-font-lock)
;; variables for source file compilation
(when vhdl-compile-use-local-error-regexp
@@ -4958,6 +4998,12 @@ Key bindings:
)
"List of VHDL'02 keywords.")
+(defconst vhdl-08-keywords
+ '(
+ "context" "force" "property" "release" "sequence"
+ )
+ "List of VHDL'08 keywords.")
+
(defconst vhdl-ams-keywords
'(
"across" "break" "limit" "nature" "noise" "procedural" "quantity"
@@ -4999,6 +5045,12 @@ Key bindings:
)
"List of VHDL'02 standardized types.")
+(defconst vhdl-08-types
+ '(
+ "boolean_vector" "integer_vector" "real_vector" "time_vector"
+ )
+ "List of VHDL'08 standardized types.")
+
(defconst vhdl-ams-types
;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
'(
@@ -5074,6 +5126,12 @@ Key bindings:
)
"List of VHDL'02 standardized attributes.")
+(defconst vhdl-08-attributes
+ '(
+ "instance_name" "path_name"
+ )
+ "List of VHDL'08 standardized attributes.")
+
(defconst vhdl-ams-attributes
'(
"across" "through"
@@ -5145,6 +5203,15 @@ Key bindings:
)
"List of VHDL'02 standardized functions.")
+(defconst vhdl-08-functions
+ '(
+ "finish" "flush" "justify" "maximum" "minimum"
+ "resolution_limit" "rising_edge" "stop" "swrite"
+ "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
+ "to_octalstring" "to_ostring" "to_string"
+ )
+ "List of VHDL'08 standardized functions.")
+
(defconst vhdl-ams-functions
'(
;; package `standard'
@@ -5173,6 +5240,13 @@ Key bindings:
)
"List of VHDL'02 standardized packages and libraries.")
+(defconst vhdl-08-packages
+ '(
+ "env" "numeric_std_signed" "numeric_std_unsigned"
+ "ieee_bit_context" "ieee_std_context" ;; contexts
+ )
+ "List of VHDL'08 standardized packages and libraries.")
+
(defconst vhdl-ams-packages
'(
"fundamental_constants" "material_constants" "energy_systems"
@@ -5187,6 +5261,18 @@ Key bindings:
)
"List of Math Packages standardized packages and libraries.")
+(defconst vhdl-08-directives
+ '(
+ "author" "author_info" "begin" "begin_protected" "comment"
+ "data_block" "data_keyname" "data_keyowner" "data_method"
+ "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
+ "digest_keyowner" "digest_method"
+ "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
+ "key_block" "key_keyname" "key_keyowner" "key_method"
+ "runtime_license" "viewport"
+ )
+ "List of VHDL'08 standardized tool directives.")
+
(defvar vhdl-keywords nil
"List of VHDL keywords.")
@@ -5208,6 +5294,9 @@ Key bindings:
(defvar vhdl-packages nil
"List of VHDL standardized packages and libraries.")
+(defvar vhdl-directives nil
+ "List of VHDL standardized packages and libraries.")
+
(defvar vhdl-reserved-words nil
"List of additional reserved words.")
@@ -5253,17 +5342,20 @@ Key bindings:
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
(append vhdl-02-keywords
+ (when (vhdl-standard-p '08) vhdl-08-keywords)
(when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
(setq vhdl-types
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-types)
(append vhdl-02-types
+ (when (vhdl-standard-p '08) vhdl-08-types)
(when (vhdl-standard-p 'ams) vhdl-ams-types)
(when (vhdl-standard-p 'math) vhdl-math-types))))
(setq vhdl-attributes
(vhdl-upcase-list
(and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
(append vhdl-02-attributes
+ (when (vhdl-standard-p '08) vhdl-08-attributes)
(when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
(setq vhdl-enum-values
(vhdl-upcase-list
@@ -5278,12 +5370,16 @@ Key bindings:
'(""))))
(setq vhdl-functions
(append vhdl-02-functions
+ (when (vhdl-standard-p '08) vhdl-08-functions)
(when (vhdl-standard-p 'ams) vhdl-ams-functions)
(when (vhdl-standard-p 'math) vhdl-math-functions)))
(setq vhdl-packages
(append vhdl-02-packages
+ (when (vhdl-standard-p '08) vhdl-08-packages)
(when (vhdl-standard-p 'ams) vhdl-ams-packages)
(when (vhdl-standard-p 'math) vhdl-math-packages)))
+ (setq vhdl-directives
+ (append (when (vhdl-standard-p '08) vhdl-08-directives)))
(setq vhdl-reserved-words
(append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
(when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
@@ -5328,7 +5424,8 @@ Key bindings:
(list vhdl-upper-case-enum-values) vhdl-enum-values
(list vhdl-upper-case-constants) vhdl-constants
(list nil) vhdl-functions
- (list nil) vhdl-packages)))
+ (list nil) vhdl-packages
+ (list nil) vhdl-directives)))
;; initialize reserved words for VHDL Mode
(vhdl-words-init)
@@ -5569,9 +5666,24 @@ the offset is simply returned."
;; Syntactic support functions:
-(defun vhdl-in-comment-p ()
- "Check if point is in a comment."
- (eq (vhdl-in-literal) 'comment))
+(defun vhdl-in-comment-p (&optional pos)
+ "Check if point is in a comment (include multi-line comments)."
+ (let ((parse (lambda (p)
+ (let ((c (char-after p)))
+ (or (and c (eq (char-syntax c) ?<))
+ (nth 4 (parse-partial-sexp
+ (save-excursion
+ (beginning-of-defun)
+ (point)) p)))))))
+ (save-excursion
+ (goto-char (or pos (point)))
+ (or (funcall parse (point))
+ ;; `parse-partial-sexp's notion of comments doesn't span lines
+ (progn
+ (back-to-indentation)
+ (unless (eolp)
+ (forward-char)
+ (funcall parse (point))))))))
(defun vhdl-in-string-p ()
"Check if point is in a string."
@@ -5596,10 +5708,13 @@ the offset is simply returned."
((nth 3 state) 'string)
((nth 4 state) 'comment)
((vhdl-beginning-of-macro) 'pound)
+ ((vhdl-beginning-of-directive) 'directive)
+ ;; for multi-line comments
+ ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
(t nil)))))
(defun vhdl-in-extended-identifier-p ()
- "Determine if point is inside extended identifier (delimited by '\')."
+ "Determine if point is inside extended identifier (delimited by `\\')."
(save-match-data
(and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
(save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
@@ -5646,7 +5761,7 @@ negative, skip forward otherwise."
(goto-char lim )
(while (< (point) here)
(setq match
- (and (re-search-forward "--\\|[\"']"
+ (and (re-search-forward "--\\|[\"']\\|`"
here 'move)
(buffer-substring (match-beginning 0) (match-end 0))))
(setq state
@@ -5656,6 +5771,9 @@ negative, skip forward otherwise."
;; looking at the opening of a VHDL style comment
((string= "--" match)
(if (<= here (progn (end-of-line) (point))) 'comment))
+ ;; looking at a directive
+ ((string= "`" match)
+ (if (<= here (progn (end-of-line) (point))) 'directive))
;; looking at the opening of a double quote string
((string= "\"" match)
(if (not (save-restriction
@@ -5700,7 +5818,7 @@ negative, skip forward otherwise."
(setq here (point))
(vhdl-forward-comment hugenum)
;; skip preprocessor directives
- (when (and (eq (char-after) ?#)
+ (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
(= (vhdl-point 'boi) (point)))
(while (and (eq (char-before (vhdl-point 'eol)) ?\\)
(= (forward-line 1) 0)))
@@ -5737,6 +5855,19 @@ negative, skip forward otherwise."
(goto-char here)
nil)))
+(defun vhdl-beginning-of-directive (&optional lim)
+ "Go to the beginning of a directive (nicked from `cc-engine')."
+ (let ((here (point)))
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (forward-line -1))
+ (back-to-indentation)
+ (if (and (<= (point) here)
+ (eq (char-after) ?`))
+ t
+ (goto-char here)
+ nil)))
+
(defun vhdl-backward-syntactic-ws (&optional lim)
"Backward skip over syntactic whitespace."
(let* ((here (point-min))
@@ -5793,7 +5924,7 @@ that point, else nil."
;; Core syntactic evaluation functions:
(defconst vhdl-libunit-re
- "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
+ "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
(defun vhdl-libunit-p ()
(and
@@ -5811,7 +5942,7 @@ that point, else nil."
))
(defconst vhdl-defun-re
- "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
+ "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
(defun vhdl-defun-p ()
(save-excursion
@@ -5820,7 +5951,7 @@ that point, else nil."
(save-excursion
(backward-sexp)
(not (looking-at "end\\s-+\\w")))
- ;; "architecture", "configuration", "entity",
+ ;; "architecture", "configuration", "context", "entity",
;; "package", "procedure", "function":
t)))
@@ -5834,7 +5965,7 @@ corresponding \"begin\" keyword, else return nil."
(if (looking-at "block\\|process\\|procedural")
;; "block", "process". "procedural:
(buffer-substring (match-beginning 0) (match-end 0))
- ;; "architecture", "configuration", "entity", "package",
+ ;; "architecture", "configuration", "context", "entity", "package",
;; "procedure", "function":
"is"))))
@@ -5855,7 +5986,7 @@ vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
the middle of an identifier that just happens to contain a \"begin\"
keyword."
(cond
- ;; "[architecture|case|configuration|entity|package|
+ ;; "[architecture|case|configuration|context|entity|package|
;; procedure|function] ... is":
((and (looking-at "i")
(save-excursion
@@ -5868,7 +5999,7 @@ keyword."
(let (foundp)
(while (and (not foundp)
(re-search-backward
- ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
+ ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
lim 'move))
(if (or (= (preceding-char) ?_)
(vhdl-in-literal))
@@ -6063,7 +6194,7 @@ of an identifier that just happens to contain an \"end\" keyword."
(vector "for" (vhdl-first-word pos) nil nil))
;; "end [id]":
(t
- (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
+ (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
(vhdl-first-word pos)
;; return an alist of (statement . keyword) mappings
'(
@@ -6073,6 +6204,8 @@ of an identifier that just happens to contain an \"end\" keyword."
("architecture" . "is")
;; "configuration ... is ... end [id]":
("configuration" . "is")
+ ;; "context ... is ... end [id]":
+ ("context" . "is")
;; "entity ... is ... end [id]":
("entity" . "is")
;; "package ... is ... end [id]":
@@ -6574,7 +6707,7 @@ search, and an argument indicating an interactive call."
(re-search-forward vhdl-e-o-s-re))
(defconst vhdl-b-o-s-re
- (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
+ (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|"
vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
(defun vhdl-beginning-of-statement-1 (&optional lim)
@@ -6687,7 +6820,8 @@ keyword at PLACEHOLDER, then return the library unit type."
(cond
((looking-at "e") 'entity)
((looking-at "a") 'architecture)
- ((looking-at "c") 'configuration)
+ ((looking-at "conf") 'configuration)
+ ((looking-at "cont") 'context)
((looking-at "p")
(save-excursion
(goto-char bod)
@@ -6963,7 +7097,7 @@ is not moved."
(goto-char (1+ containing-sexp))
(skip-chars-forward " \t")
(not (eolp))
- (not (looking-at "--")))
+ (not (looking-at "--\\|`")))
(save-excursion
(vhdl-beginning-of-statement-1 containing-sexp)
(skip-chars-backward " \t(")
@@ -7112,8 +7246,10 @@ is not moved."
;; now we need to look at any modifiers
(goto-char indent-point)
(skip-chars-forward " \t")
- (if (looking-at "--")
+ (if (or (looking-at "--") (looking-at "/\\*"))
(vhdl-add-syntax 'comment))
+ (if (looking-at "`")
+ (vhdl-add-syntax 'directive))
(if (eq literal 'pound)
(vhdl-add-syntax 'cpp-macro))
;; return the syntax
@@ -7187,8 +7323,12 @@ only-lines."
(vhdl-comment-indent)
;; otherwise, indent as specified by vhdl-comment-only-line-offset
(if (not (bolp))
+ ;; inside multi-line comment
+ (if (looking-at "\\*")
+ 1
+ ;; otherwise
(or (car-safe vhdl-comment-only-line-offset)
- vhdl-comment-only-line-offset)
+ vhdl-comment-only-line-offset))
(or (cdr-safe vhdl-comment-only-line-offset)
(car-safe vhdl-comment-only-line-offset)
-1000 ;jam it against the left side
@@ -7244,11 +7384,11 @@ only-lines."
(- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
(let ((delta (- (aref vhdl-progress-info 1)
(aref vhdl-progress-info 0))))
- (if (= 0 delta)
- (message (concat string "... (100%s)") "%")
- (message (concat string "... (%2d%s)")
- (/ (* 100 (- pos (aref vhdl-progress-info 0)))
- delta) "%")))
+ (message "%s... (%2d%%)" string
+ (if (= 0 delta)
+ 100
+ (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
+ delta))))
(aset vhdl-progress-info 2 (nth 1 (current-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -7428,7 +7568,7 @@ ENDPOS is encountered."
(mapc
(function
(lambda (elt)
- (if (memq (car elt) '(entity configuration package
+ (if (memq (car elt) '(entity configuration context package
package-body architecture))
nil
(setq expurgated (append expurgated (list elt))))))
@@ -7566,7 +7706,6 @@ indentation is done before aligning."
(setq end (point-marker))
(goto-char begin)
(setq bol (setq begin (progn (beginning-of-line) (point))))
-; (untabify bol end)
(when indent
(indent-region bol end nil))))
(let ((copy (copy-alist alignment-list)))
@@ -7759,7 +7898,7 @@ the token in MATCH."
(vhdl-prepare-search-2
(save-excursion
;; search for declarative part
- (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
+ (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
(not (member (upcase (match-string 1)) '("BEGIN" "END"))))
(setq beg (point))
(re-search-forward "^\\(begin\\|end\\)\\>" nil t)
@@ -7922,25 +8061,25 @@ end of line, do nothing in comments and strings."
(setq end (point-marker))
;; have no space before and one space after `,' and ';'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\3 " nil nil nil 2)))
;; have no space after `('
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; have no space before `)'
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
(if (match-string 1)
(goto-char (match-end 1))
(replace-match "\\2")))
;; surround operator symbols by one space
(goto-char beg)
- (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
+ (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
(if (or (match-string 1)
(<= (match-beginning 0) ; not if at boi
(save-excursion (back-to-indentation) (point))))
@@ -7962,7 +8101,6 @@ end of line, do nothing in comments and strings."
(and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
(progn (replace-match " " nil nil) t))
(and (looking-at "-") (re-search-forward "-" end t))
-; (re-search-forward "[^ \t-]+" end t))))
(re-search-forward "[^ \t\"-]+" end t))))
(unless no-message (message "Fixing up whitespace...done")))
@@ -8080,7 +8218,7 @@ Currently supported keywords: 'begin', 'if'."
(while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
(goto-char (match-end 1))
(setq point (point-marker))
- ;; exception: in literal or preceded by `end' or label
+ ;; exception: in literal or preceded by `end', `wait' or label
(when (and (not (save-excursion (goto-char (match-beginning 1))
(vhdl-in-literal)))
(save-excursion
@@ -8089,7 +8227,7 @@ Currently supported keywords: 'begin', 'if'."
(and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
(match-beginning 1) t)
(not (string-match
- "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$"
+ "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
(match-string 1)))))))
(goto-char (match-beginning 1))
(insert "\n")
@@ -8133,15 +8271,17 @@ case fixing to a region. Calls functions `vhdl-indent-buffer',
(setq end (save-excursion (goto-char end) (point-marker)))
(save-excursion ; remove DOS EOL characters in UNIX file
(goto-char beg)
- (while (search-forward " " nil t)
+ (while (search-forward "\r" nil t)
(replace-match "" nil t)))
(when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
(when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
(when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
- (let ((vhdl-align-groups t))
- (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end)))
+ (when (nth 3 vhdl-beautify-options)
+ (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
(when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
- (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end)))
+ (when (nth 0 vhdl-beautify-options)
+ (vhdl-remove-trailing-spaces-region beg end)
+ (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
(defun vhdl-beautify-buffer ()
"Beautify buffer by applying indentation, whitespace fixup, alignment, and
@@ -8447,11 +8587,11 @@ buffer."
(setq beg (point))))))
;; search for signals declared in surrounding block declarative parts
(save-excursion
- (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
- (match-string 2))
- (goto-char (match-end 2))
+ (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
+ (match-string 4))
+ (goto-char (match-end 4))
(vhdl-backward-sexp)
- (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
+ (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
beg)
(setq end (re-search-forward "^\\s-*begin\\>" nil t)))
;; scan for all declared signal names
@@ -8548,7 +8688,8 @@ Used for undoing after template abortion.")
"Return the working library name of the current project or \"work\" if no
project is defined."
(vhdl-resolve-env-variable
- (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
+ (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
+ vhdl-default-library)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Enabling/disabling
@@ -8594,14 +8735,15 @@ is omitted or nil."
(let ((next-input (read-char)))
(if (= next-input ?-) ; four dashes
(vhdl-comment-display t)
- (setq unread-command-events ; pushback the char
- (list (vhdl-character-to-event next-input))))))
- (setq unread-command-events ; pushback the char
- (list (vhdl-character-to-event next-input)))
+ (push (vhdl-character-to-event next-input)
+ ; pushback the char
+ unread-command-events))))
+ (push (vhdl-character-to-event next-input) ; pushback the char
+ unread-command-events)
(vhdl-comment-insert)))))
(self-insert-command count)))
-(defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
+(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(if (= (preceding-char) ?\()
@@ -8609,7 +8751,7 @@ is omitted or nil."
(insert-char ?\( 1))
(self-insert-command count)))
-(defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
+(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(progn
@@ -8619,7 +8761,7 @@ is omitted or nil."
(blink-matching-open))
(self-insert-command count)))
-(defun vhdl-electric-quote (count) "'' --> \""
+(defun vhdl-electric-quote (count) "\\='\\=' --> \""
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(if (= (preceding-char) vhdl-last-input-event)
@@ -8627,7 +8769,7 @@ is omitted or nil."
(insert-char ?\' 1))
(self-insert-command count)))
-(defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
+(defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
@@ -8641,7 +8783,7 @@ is omitted or nil."
(t (insert-char ?\; 1)))
(self-insert-command count)))
-(defun vhdl-electric-comma (count) "',,' --> ' <= '"
+(defun vhdl-electric-comma (count) "`,,' --> ` <= '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
@@ -8651,7 +8793,7 @@ is omitted or nil."
(t (insert-char ?\, 1)))
(self-insert-command count)))
-(defun vhdl-electric-period (count) "'..' --> ' => '"
+(defun vhdl-electric-period (count) "`..' --> ` => '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
@@ -8661,7 +8803,7 @@ is omitted or nil."
(t (insert-char ?\. 1)))
(self-insert-command count)))
-(defun vhdl-electric-equal (count) "'==' --> ' == '"
+(defun vhdl-electric-equal (count) "`==' --> ` == '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
(cond ((= (preceding-char) vhdl-last-input-event)
@@ -8966,8 +9108,6 @@ since these are almost equivalent)."
(interactive)
(when (vhdl-template-field "target signal")
(insert " <= ")
-; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
-; (insert " "))
(let ((margin (current-column))
(start (point))
position)
@@ -9109,6 +9249,27 @@ a configuration declaration if not within a design unit."
(insert ";")
(vhdl-comment-insert-inline))))))
+(defun vhdl-template-context ()
+ "Insert a context declaration."
+ (interactive)
+ (let ((margin (current-indentation))
+ (start (point))
+ entity-exists string name position)
+ (vhdl-insert-keyword "CONTEXT ")
+ (when (setq name (vhdl-template-field "name" nil t start (point)))
+ (vhdl-insert-keyword " IS\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to (+ margin vhdl-basic-offset))
+ (setq position (point))
+ (insert "\n")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (indent-to margin)
+ (vhdl-insert-keyword "END ")
+ (unless (vhdl-standard-p '87)
+ (vhdl-insert-keyword "CONTEXT "))
+ (insert name ";")
+ (goto-char position))))
+
(defun vhdl-template-default ()
"Insert nothing."
(interactive)
@@ -9770,8 +9931,10 @@ otherwise."
(forward-char 1))
(insert "(")
(if (not seq)
- (unless (setq input-signals
- (vhdl-template-field "[sensitivity list]" ")" t))
+ (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
+ (progn (insert "all)") (setq input-signals "all")))
+ (setq input-signals
+ (vhdl-template-field "[sensitivity list]" ")" t)))
(setq input-signals "")
(delete-char -2))
(setq clock (or (and (not (equal "" vhdl-clock-name))
@@ -9903,7 +10066,7 @@ otherwise."
(defun vhdl-template-record (kind &optional name secondary)
"Insert a record type declaration."
(interactive)
- (let ((margin (current-column))
+ (let ((margin (current-indentation))
(start (point))
(first t))
(vhdl-insert-keyword "RECORD\n")
@@ -9965,7 +10128,6 @@ otherwise."
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "target signal" " <= ")
-; (vhdl-template-field "[GUARDED] [TRANSPORT]")
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(vhdl-template-field "waveform")
@@ -10466,8 +10628,10 @@ specification, if not already there."
(defun vhdl-template-replace-header-keywords (beg end &optional file-title
is-model)
"Replace keywords in header and footer."
- (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
- (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
+ (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
+ (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
+ ""))
pos)
(vhdl-prepare-search-2
(save-excursion
@@ -10504,7 +10668,8 @@ specification, if not already there."
(while (search-forward "<standard>" end t)
(replace-match
(concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
- ((vhdl-standard-p '93) "'93/02"))
+ ((vhdl-standard-p '93) "'93/02")
+ ((vhdl-standard-p '08) "'08"))
(when (vhdl-standard-p 'ams) ", VHDL-AMS")
(when (vhdl-standard-p 'math) ", Math Packages")) t t))
(goto-char beg)
@@ -10525,9 +10690,9 @@ specification, if not already there."
(replace-match file-title t t))
(goto-char beg))
(let (string)
- (while
- (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
- (setq string (read-string (concat (match-string 1) ": ")))
+ (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
+ (save-match-data
+ (setq string (read-string (concat (match-string 1) ": "))))
(replace-match string t t)))
(goto-char beg)
(when (and (not is-model) (search-forward "<cursor>" end t))
@@ -10592,8 +10757,8 @@ If starting after end-comment-column, start a new line."
(setq code t))
(unless code
(insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
- (setq unread-command-events
- (list (vhdl-character-to-event next-input)))))) ; pushback the char
+ (push (vhdl-character-to-event next-input) ; pushback the char
+ unread-command-events))))
(defun vhdl-comment-display (&optional line-exists)
"Add 2 comment lines at the current indent, making a display comment."
@@ -10635,14 +10800,7 @@ If starting after end-comment-column, start a new line."
(if (not (or (and string (progn (insert string) t))
(vhdl-template-field "[comment]" nil t)))
(delete-region position (point))
- (while (= (preceding-char) ?\ ) (delete-char -1))
- ;; (when (> (current-column) end-comment-column)
- ;; (setq position (point-marker))
- ;; (re-search-backward "-- ")
- ;; (insert "\n")
- ;; (indent-to comment-column)
- ;; (goto-char position))
- ))))
+ (while (= (preceding-char) ?\ ) (delete-char -1))))))
(defun vhdl-comment-block ()
"Insert comment for code block."
@@ -10882,8 +11040,6 @@ Point is left between them."
(defun vhdl-template-generate-body (margin label)
"Insert body for generate template."
(vhdl-insert-keyword " GENERATE")
-; (if (not (vhdl-standard-p '87))
-; (vhdl-template-begin-end "GENERATE" label margin)
(insert "\n\n")
(indent-to margin)
(vhdl-insert-keyword "END GENERATE ")
@@ -11051,7 +11207,7 @@ else insert tab (used for word completion in VHDL minibuffer)."
(save-excursion
(beginning-of-line)
;; search backward for block beginning or end
- (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
;; not consider subprogram declarations
(or (and (match-string 5)
(save-match-data
@@ -11082,7 +11238,7 @@ else insert tab (used for word completion in VHDL minibuffer)."
(save-excursion
(end-of-line)
;; search forward for block beginning or end
- (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
;; not consider subprogram declarations
(or (and (match-string 5)
(save-match-data
@@ -11156,8 +11312,8 @@ but not if inside a comment or quote."
;; delete CR which is still in event queue
(if (fboundp 'enqueue-eval-event)
(enqueue-eval-event 'delete-char -1)
- (setq unread-command-events ; push back a delete char
- (list (vhdl-character-to-event ?\177))))))))
+ (push (vhdl-character-to-event ?\177) ; push back a delete char
+ unread-command-events))))))
(defun vhdl-template-alias-hook ()
(vhdl-hooked-abbrev 'vhdl-template-alias))
@@ -11183,6 +11339,8 @@ but not if inside a comment or quote."
(vhdl-hooked-abbrev 'vhdl-template-configuration))
(defun vhdl-template-constant-hook ()
(vhdl-hooked-abbrev 'vhdl-template-constant))
+(defun vhdl-template-context-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-context))
(defun vhdl-template-disconnect-hook ()
(vhdl-hooked-abbrev 'vhdl-template-disconnect))
(defun vhdl-template-display-comment-hook ()
@@ -11670,7 +11828,6 @@ reflected in a subsequent paste operation."
comment group-comment))))
;; parse group comment and spacing
(setq group-comment (vhdl-parse-group-comment))))
-; (vhdl-parse-string "end\\>")
;; parse context clause
(setq context-clause (vhdl-scan-context-clause))
; ;; add surrounding package to context clause
@@ -11701,7 +11858,7 @@ reflected in a subsequent paste operation."
(save-excursion
(re-search-backward
(concat "^\\s-*use\\s-+" (car clause)
- "\." (cdr clause) "\\>") nil t)))
+ "." (cdr clause) "\\>") nil t)))
(vhdl-template-standard-package (car clause) (cdr clause))
(insert "\n"))
(setq clause-list (cdr clause-list)))))
@@ -11956,7 +12113,7 @@ reflected in a subsequent paste operation."
(insert name))
((equal (cdr vhdl-instance-name) "")
(setq name (vhdl-template-field "instance name")))
- ((string-match "\%d" (cdr vhdl-instance-name))
+ ((string-match "%d" (cdr vhdl-instance-name))
(let ((n 1))
(while (save-excursion
(setq name (format (vhdl-replace-string
@@ -12622,7 +12779,6 @@ reflected in a subsequent paste operation."
(while (and he-expand-list
(or (not (stringp (car he-expand-list)))
(he-string-member (car he-expand-list) he-tried-table t)))
-; (equal (car he-expand-list) he-search-string)))
(unless (stringp (car he-expand-list))
(setq vhdl-expand-upper-case (car he-expand-list)))
(setq he-expand-list (cdr he-expand-list)))
@@ -12822,7 +12978,7 @@ File statistics: \"%s\"\n\
# empty lines : %5d\n\
# comment lines : %5d\n\
# comments : %5d\n\
-# total lines : %5d\n\ "
+# total lines : %5d\n"
(buffer-file-name) no-stats no-code-lines no-empty-lines
no-comm-lines no-comments no-lines)
(unless vhdl-emacs-21 (vhdl-show-messages))))
@@ -12908,8 +13064,8 @@ File statistics: \"%s\"\n\
";; project name\n"
"(setq vhdl-project \"" vhdl-project "\")\n\n"
";; project setup\n"
- "(aput 'vhdl-project-alist vhdl-project\n'")
- (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
+ "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
+ (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
(insert ")\n")
(save-buffer)
(kill-buffer (current-buffer))
@@ -12929,16 +13085,18 @@ File statistics: \"%s\"\n\
(condition-case ()
(let ((current-project vhdl-project))
(load-file file-name)
- (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
- (adelete 'vhdl-project-alist vhdl-project)
+ (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10)
+ (vhdl-adelete 'vhdl-project-alist vhdl-project)
(error ""))
- (when not-make-current
- (setq vhdl-project current-project))
+ (if not-make-current
+ (setq vhdl-project current-project)
+ (setq vhdl-compiler
+ (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project)))))
(vhdl-update-mode-menu)
(vhdl-speedbar-refresh)
(unless not-make-current
- (message "Current VHDL project: \"%s\"%s"
- vhdl-project (if auto " (auto-loaded)" ""))))
+ (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s"
+ vhdl-project vhdl-compiler (if auto " (auto-loaded)" ""))))
(error (vhdl-warning
(format "ERROR: Invalid project setup file: \"%s\"" file-name))))))
@@ -12946,7 +13104,7 @@ File statistics: \"%s\"\n\
"Duplicate setup of current project."
(interactive)
(let ((new-name (read-from-minibuffer "New project name: "))
- (project-entry (aget vhdl-project-alist vhdl-project t)))
+ (project-entry (vhdl-aget vhdl-project-alist vhdl-project)))
(setq vhdl-project-alist
(append vhdl-project-alist
(list (cons new-name project-entry))))
@@ -12963,7 +13121,7 @@ File statistics: \"%s\"\n\
(vhdl-resolve-env-variable
(vhdl-replace-string
(cons "\\(.*\\) \\(.*\\)" (car file-name-list))
- (concat "\*" " " (user-login-name)))))))
+ (concat "* " (user-login-name)))))))
(setq list-length (or list-length (length file-list)))
(setq file-name-list (cdr file-name-list)))
(while file-list
@@ -13148,7 +13306,7 @@ File statistics: \"%s\"\n\
;; Syntax definitions
(defconst vhdl-font-lock-syntactic-keywords
- '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
+ '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
"Mark single quotes as having string quote syntax in 'c' instances.")
(defvar vhdl-font-lock-keywords nil
@@ -13170,7 +13328,8 @@ This does highlighting of keywords and standard identifiers.")
(list
(concat
"^\\s-*\\("
- "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
+ "architecture\\|configuration\\|context\\|entity\\|package"
+ "\\(\\s-+body\\)?\\|"
"\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
"\\)\\s-+\\(\\w+\\)")
5 'font-lock-function-name-face)
@@ -13212,9 +13371,9 @@ This does highlighting of keywords and standard identifiers.")
(list
(concat
"^\\s-*end\\s-+\\(\\("
- "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
- "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
- "procedure\\|\\(postponed\\s-+\\)?process\\|"
+ "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
+ "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
+ "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
(when (vhdl-standard-p 'ams) "procedural\\|")
"units"
"\\)\\s-+\\)?\\(\\w*\\)")
@@ -13246,10 +13405,10 @@ This does highlighting of keywords and standard identifiers.")
;; highlight names in use clauses
(list
(concat
- "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
+ "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
"\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
- '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
- '(7 font-lock-function-name-face nil t))
+ '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
+ '(8 font-lock-function-name-face nil t))
;; highlight attribute name in attribute declarations/specifications
(list
@@ -13275,7 +13434,6 @@ This does highlighting of keywords and standard identifiers.")
(skip-syntax-backward " ")
(skip-syntax-backward "w_")
(skip-syntax-backward " ")))
-; (skip-chars-backward "^-(\n\";")
(goto-char (match-end 1)) (1 font-lock-variable-name-face)))
;; highlight formal parameters in component instantiations and subprogram
@@ -13297,6 +13455,12 @@ This does highlighting of keywords and standard identifiers.")
'(vhdl-font-lock-match-item
(progn (goto-char (match-end 1)) (match-beginning 2))
nil (1 font-lock-variable-name-face)))
+
+ ;; highlight tool directives
+ (list
+ (concat
+ "^\\s-*\\(`\\w+\\)")
+ 1 'font-lock-preprocessor-face)
)
"For consideration as a value of `vhdl-font-lock-keywords'.
This does context sensitive highlighting of names and labels.")
@@ -13642,7 +13806,7 @@ hierarchy otherwise.")
"Return position of end of current unit."
(let ((pos (point)))
(save-excursion
- (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
+ (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
(save-excursion
(goto-char (match-beginning 0))
(vhdl-backward-syntactic-ws)
@@ -13663,7 +13827,7 @@ hierarchy otherwise.")
"Scan the context clause that precedes a design unit."
(let (lib-alist)
(save-excursion
- (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
+ (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t)
(while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
(equal "USE" (upcase (match-string 1))))
(when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
@@ -13676,8 +13840,6 @@ hierarchy otherwise.")
non-final)
"Scan contents of VHDL files in directory or file pattern NAME."
(string-match "\\(.*[/\\]\\)\\(.*\\)" name)
-; (unless (file-directory-p (match-string 1 name))
-; (message "No such directory: \"%s\"" (match-string 1 name)))
(let* ((dir-name (match-string 1 name))
(file-pattern (match-string 2 name))
(is-directory (= 0 (length file-pattern)))
@@ -13690,18 +13852,18 @@ hierarchy otherwise.")
dir-name t (wildcard-to-regexp file-pattern)))))
(key (or project dir-name))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
(limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
(limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
(limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
ent-alist conf-alist pack-alist ent-inst-list file-alist
tmp-list tmp-entry no-files files-exist big-files)
(when (or project update)
- (setq ent-alist (aget vhdl-entity-alist key t)
- conf-alist (aget vhdl-config-alist key t)
- pack-alist (aget vhdl-package-alist key t)
- ent-inst-list (car (aget vhdl-ent-inst-alist key t))
- file-alist (aget vhdl-file-alist key t)))
+ (setq ent-alist (vhdl-aget vhdl-entity-alist key)
+ conf-alist (vhdl-aget vhdl-config-alist key)
+ pack-alist (vhdl-aget vhdl-package-alist key)
+ ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key))
+ file-alist (vhdl-aget vhdl-file-alist key)))
(when (and (not is-directory) (null file-list))
(message "No such file: \"%s\"" name))
(setq files-exist file-list)
@@ -13721,10 +13883,10 @@ hierarchy otherwise.")
;; do for all files
(while file-list
(unless noninteractive
- (message "Scanning %s %s\"%s\"... (%2d%s)"
+ (message "Scanning %s %s\"%s\"... (%2d%%)"
(if is-directory "directory" "files")
(or num-string "") name
- (/ (* 100 (- no-files (length file-list))) no-files) "%"))
+ (floor (* 100.0 (- no-files (length file-list))) no-files)))
(let ((file-name (abbreviate-file-name (car file-list)))
ent-list arch-list arch-ent-list conf-list
pack-list pack-body-list inst-list inst-ent-list)
@@ -13743,7 +13905,7 @@ hierarchy otherwise.")
(while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((ent-name (match-string-no-properties 1))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(lib-alist (vhdl-scan-context-clause)))
(if (nth 1 ent-entry)
(vhdl-warning-when-idle
@@ -13751,10 +13913,10 @@ hierarchy otherwise.")
ent-name (nth 1 ent-entry) (nth 2 ent-entry)
file-name (vhdl-current-line))
(push ent-key ent-list)
- (aput 'ent-alist ent-key
- (list ent-name file-name (vhdl-current-line)
- (nth 3 ent-entry) (nth 4 ent-entry)
- lib-alist)))))
+ (vhdl-aput 'ent-alist ent-key
+ (list ent-name file-name (vhdl-current-line)
+ (nth 3 ent-entry) (nth 4 ent-entry)
+ lib-alist)))))
;; scan for architectures
(goto-char (point-min))
(while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
@@ -13762,9 +13924,9 @@ hierarchy otherwise.")
(arch-key (downcase arch-name))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key))
(lib-arch-alist (vhdl-scan-context-clause)))
(if arch-entry
(vhdl-warning-when-idle
@@ -13773,20 +13935,20 @@ hierarchy otherwise.")
(nth 2 arch-entry) file-name (vhdl-current-line))
(setq arch-list (cons arch-key arch-list)
arch-ent-list (cons ent-key arch-ent-list))
- (aput 'arch-alist arch-key
- (list arch-name file-name (vhdl-current-line) nil
- lib-arch-alist))
- (aput 'ent-alist ent-key
- (list (or (nth 0 ent-entry) ent-name)
- (nth 1 ent-entry) (nth 2 ent-entry)
- (vhdl-sort-alist arch-alist)
- arch-key (nth 5 ent-entry))))))
+ (vhdl-aput 'arch-alist arch-key
+ (list arch-name file-name (vhdl-current-line)
+ nil lib-arch-alist))
+ (vhdl-aput 'ent-alist ent-key
+ (list (or (nth 0 ent-entry) ent-name)
+ (nth 1 ent-entry) (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ arch-key (nth 5 ent-entry))))))
;; scan for configurations
(goto-char (point-min))
(while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((conf-name (match-string-no-properties 1))
(conf-key (downcase conf-name))
- (conf-entry (aget conf-alist conf-key t))
+ (conf-entry (vhdl-aget conf-alist conf-key))
(ent-name (match-string-no-properties 2))
(ent-key (downcase ent-name))
(lib-alist (vhdl-scan-context-clause))
@@ -13827,16 +13989,16 @@ hierarchy otherwise.")
inst-lib-key)
comp-conf-list))
(setq inst-key-list (cdr inst-key-list)))))
- (aput 'conf-alist conf-key
- (list conf-name file-name conf-line ent-key
- arch-key comp-conf-list lib-alist)))))
+ (vhdl-aput 'conf-alist conf-key
+ (list conf-name file-name conf-line ent-key
+ arch-key comp-conf-list lib-alist)))))
;; scan for packages
(goto-char (point-min))
(while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(let* ((pack-name (match-string-no-properties 2))
(pack-key (downcase pack-name))
(is-body (match-string-no-properties 1))
- (pack-entry (aget pack-alist pack-key t))
+ (pack-entry (vhdl-aget pack-alist pack-key))
(pack-line (vhdl-current-line))
(end-of-unit (vhdl-get-end-of-unit))
comp-name func-name comp-alist func-alist lib-alist)
@@ -13867,7 +14029,7 @@ hierarchy otherwise.")
(if is-body
(push pack-key pack-body-list)
(push pack-key pack-list))
- (aput
+ (vhdl-aput
'pack-alist pack-key
(if is-body
(list (or (nth 0 pack-entry) pack-name)
@@ -13891,9 +14053,9 @@ hierarchy otherwise.")
(ent-key (downcase ent-name))
(arch-name (match-string-no-properties 1))
(arch-key (downcase arch-name))
- (ent-entry (aget ent-alist ent-key t))
+ (ent-entry (vhdl-aget ent-alist ent-key))
(arch-alist (nth 3 ent-entry))
- (arch-entry (aget arch-alist arch-key t))
+ (arch-entry (vhdl-aget arch-alist arch-key))
(beg-of-unit (point))
(end-of-unit (vhdl-get-end-of-unit))
(inst-no 0)
@@ -13907,7 +14069,10 @@ hierarchy otherwise.")
"\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
"\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
(or (not limit-hier-inst-no)
- (<= (setq inst-no (1+ inst-no))
+ (<= (if (or (match-string 14)
+ (match-string 16))
+ inst-no
+ (setq inst-no (1+ inst-no)))
limit-hier-inst-no)))
(cond
;; block/generate beginning found
@@ -13988,23 +14153,25 @@ hierarchy otherwise.")
(setcar tmp-inst-alist inst-entry))
(setq tmp-inst-alist (cdr tmp-inst-alist)))))
;; save in cache
- (aput 'arch-alist arch-key
- (list (nth 0 arch-entry) (nth 1 arch-entry)
- (nth 2 arch-entry) inst-alist
- (nth 4 arch-entry)))
- (aput 'ent-alist ent-key
- (list (nth 0 ent-entry) (nth 1 ent-entry)
- (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
- (nth 4 ent-entry) (nth 5 ent-entry)))
+ (vhdl-aput 'arch-alist arch-key
+ (list (nth 0 arch-entry) (nth 1 arch-entry)
+ (nth 2 arch-entry) inst-alist
+ (nth 4 arch-entry)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 ent-entry) (nth 1 ent-entry)
+ (nth 2 ent-entry)
+ (vhdl-sort-alist arch-alist)
+ (nth 4 ent-entry) (nth 5 ent-entry)))
(when (and limit-hier-inst-no
(> inst-no limit-hier-inst-no))
(message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name)
(setq big-files t))
(goto-char end-of-unit))))
;; remember design units for this file
- (aput 'file-alist file-name
- (list ent-list arch-list arch-ent-list conf-list
- pack-list pack-body-list inst-list inst-ent-list))
+ (vhdl-aput 'file-alist file-name
+ (list ent-list arch-list arch-ent-list conf-list
+ pack-list pack-body-list
+ inst-list inst-ent-list))
(setq ent-inst-list (append inst-ent-list ent-inst-list))))))
(setq file-list (cdr file-list))))
(when (or (and (not project) files-exist)
@@ -14023,8 +14190,8 @@ hierarchy otherwise.")
;; check whether configuration has a corresponding entity/architecture
(setq tmp-list conf-alist)
(while tmp-list
- (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
- (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
+ (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list))))
+ (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)))
(setq tmp-entry (car tmp-list))
(vhdl-warning-when-idle
"Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
@@ -14053,17 +14220,17 @@ hierarchy otherwise.")
(add-to-list 'vhdl-updated-project-list (or project dir-name)))
;; clear directory alists
(unless project
- (adelete 'vhdl-entity-alist key)
- (adelete 'vhdl-config-alist key)
- (adelete 'vhdl-package-alist key)
- (adelete 'vhdl-ent-inst-alist key)
- (adelete 'vhdl-file-alist key))
+ (vhdl-adelete 'vhdl-entity-alist key)
+ (vhdl-adelete 'vhdl-config-alist key)
+ (vhdl-adelete 'vhdl-package-alist key)
+ (vhdl-adelete 'vhdl-ent-inst-alist key)
+ (vhdl-adelete 'vhdl-file-alist key))
;; put directory contents into cache
- (aput 'vhdl-entity-alist key ent-alist)
- (aput 'vhdl-config-alist key conf-alist)
- (aput 'vhdl-package-alist key pack-alist)
- (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
- (aput 'vhdl-file-alist key file-alist)
+ (vhdl-aput 'vhdl-entity-alist key ent-alist)
+ (vhdl-aput 'vhdl-config-alist key conf-alist)
+ (vhdl-aput 'vhdl-package-alist key pack-alist)
+ (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
+ (vhdl-aput 'vhdl-file-alist key file-alist)
;; final messages
(message "Scanning %s %s\"%s\"...done"
(if is-directory "directory" "files") (or num-string "") name)
@@ -14079,18 +14246,18 @@ hierarchy otherwise.")
(defun vhdl-scan-project-contents (project)
"Scan the contents of all VHDL files found in the directories and files
of PROJECT."
- (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
+ (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
(default-dir (vhdl-resolve-env-variable
- (nth 1 (aget vhdl-project-alist project))))
+ (nth 1 (vhdl-aget vhdl-project-alist project))))
(file-exclude-regexp
- (or (nth 3 (aget vhdl-project-alist project)) ""))
+ (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
dir-list-tmp dir dir-name num-dir act-dir recursive)
;; clear project alists
- (adelete 'vhdl-entity-alist project)
- (adelete 'vhdl-config-alist project)
- (adelete 'vhdl-package-alist project)
- (adelete 'vhdl-ent-inst-alist project)
- (adelete 'vhdl-file-alist project)
+ (vhdl-adelete 'vhdl-entity-alist project)
+ (vhdl-adelete 'vhdl-config-alist project)
+ (vhdl-adelete 'vhdl-package-alist project)
+ (vhdl-adelete 'vhdl-ent-inst-alist project)
+ (vhdl-adelete 'vhdl-file-alist project)
;; expand directory names by default-directory
(message "Collecting source files...")
(while dir-list
@@ -14137,7 +14304,7 @@ of PROJECT."
(add-to-list 'dir-list-tmp (file-name-directory dir-name))
(setq dir-list (cdr dir-list)
act-dir (1+ act-dir)))
- (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
+ (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
(message "Scanning project \"%s\"...done" project)))
(defun vhdl-update-file-contents (file-name)
@@ -14150,13 +14317,16 @@ of PROJECT."
(when (member dir-name (nth 1 (car directory-alist)))
(let* ((vhdl-project (nth 0 (car directory-alist)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
- (conf-alist (aget vhdl-config-alist (or project dir-name) t))
- (pack-alist (aget vhdl-package-alist (or project dir-name) t))
- (ent-inst-list (car (aget vhdl-ent-inst-alist
- (or project dir-name) t)))
- (file-alist (aget vhdl-file-alist (or project dir-name) t))
- (file-entry (aget file-alist file-name t))
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project dir-name)))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or project dir-name)))
+ (pack-alist (vhdl-aget vhdl-package-alist
+ (or project dir-name)))
+ (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
+ (or project dir-name))))
+ (file-alist (vhdl-aget vhdl-file-alist (or project dir-name)))
+ (file-entry (vhdl-aget file-alist file-name))
(ent-list (nth 0 file-entry))
(arch-list (nth 1 file-entry))
(arch-ent-list (nth 2 file-entry))
@@ -14170,57 +14340,57 @@ of PROJECT."
;; entities
(while ent-list
(setq key (car ent-list)
- entry (aget ent-alist key t))
+ entry (vhdl-aget ent-alist key))
(when (equal file-name (nth 1 entry))
(if (nth 3 entry)
- (aput 'ent-alist key
- (list (nth 0 entry) nil nil (nth 3 entry) nil))
- (adelete 'ent-alist key)))
+ (vhdl-aput 'ent-alist key
+ (list (nth 0 entry) nil nil (nth 3 entry) nil))
+ (vhdl-adelete 'ent-alist key)))
(setq ent-list (cdr ent-list)))
;; architectures
(while arch-list
(setq key (car arch-list)
ent-key (car arch-ent-list)
- entry (aget ent-alist ent-key t)
+ entry (vhdl-aget ent-alist ent-key)
arch-alist (nth 3 entry))
- (when (equal file-name (nth 1 (aget arch-alist key t)))
- (adelete 'arch-alist key)
+ (when (equal file-name (nth 1 (vhdl-aget arch-alist key)))
+ (vhdl-adelete 'arch-alist key)
(if (or (nth 1 entry) arch-alist)
- (aput 'ent-alist ent-key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- arch-alist (nth 4 entry) (nth 5 entry)))
- (adelete 'ent-alist ent-key)))
+ (vhdl-aput 'ent-alist ent-key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ arch-alist (nth 4 entry) (nth 5 entry)))
+ (vhdl-adelete 'ent-alist ent-key)))
(setq arch-list (cdr arch-list)
arch-ent-list (cdr arch-ent-list)))
;; configurations
(while conf-list
(setq key (car conf-list))
- (when (equal file-name (nth 1 (aget conf-alist key t)))
- (adelete 'conf-alist key))
+ (when (equal file-name (nth 1 (vhdl-aget conf-alist key)))
+ (vhdl-adelete 'conf-alist key))
(setq conf-list (cdr conf-list)))
;; package declarations
(while pack-list
(setq key (car pack-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key))
(when (equal file-name (nth 1 entry))
(if (nth 6 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) nil nil nil nil nil
- (nth 6 entry) (nth 7 entry) (nth 8 entry)
- (nth 9 entry)))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) nil nil nil nil nil
+ (nth 6 entry) (nth 7 entry) (nth 8 entry)
+ (nth 9 entry)))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-list (cdr pack-list)))
;; package bodies
(while pack-body-list
(setq key (car pack-body-list)
- entry (aget pack-alist key t))
+ entry (vhdl-aget pack-alist key))
(when (equal file-name (nth 6 entry))
(if (nth 1 entry)
- (aput 'pack-alist key
- (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
- (nth 3 entry) (nth 4 entry) (nth 5 entry)
- nil nil nil nil))
- (adelete 'pack-alist key)))
+ (vhdl-aput 'pack-alist key
+ (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
+ (nth 3 entry) (nth 4 entry) (nth 5 entry)
+ nil nil nil nil))
+ (vhdl-adelete 'pack-alist key)))
(setq pack-body-list (cdr pack-body-list)))
;; instantiated entities
(while inst-ent-list
@@ -14228,10 +14398,10 @@ of PROJECT."
(vhdl-delete (car inst-ent-list) ent-inst-list))
(setq inst-ent-list (cdr inst-ent-list)))
;; update caches
- (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
- (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
- (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
- (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
+ (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
+ (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
;; scan file
(vhdl-scan-directory-contents file-name project t)
(when (or (and vhdl-speedbar-show-projects project)
@@ -14264,8 +14434,8 @@ of PROJECT."
&optional include-top ent-hier)
"Get instantiation hierarchy beginning in architecture ARCH-KEY of
entity ENT-KEY."
- (let* ((ent-entry (aget ent-alist ent-key t))
- (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
+ (let* ((ent-entry (vhdl-aget ent-alist ent-key))
+ (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
(cdar (last (nth 3 ent-entry)))))
(inst-alist (nth 3 arch-entry))
inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
@@ -14276,9 +14446,6 @@ entity ENT-KEY."
(setq level (1+ level)))
(when (member ent-key ent-hier)
(error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
- ;; check configured architecture (already checked during scanning)
-; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
-; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
;; process all instances
(while inst-alist
(setq inst-entry (car inst-alist)
@@ -14294,27 +14461,27 @@ entity ENT-KEY."
(downcase (or inst-comp-name ""))))))
(setq tmp-list (cdr tmp-list)))
(setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
- (setq inst-conf-entry (aget conf-alist inst-conf-key t))
+ (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key))
(when (and inst-conf-key (not inst-conf-entry))
(vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
;; determine entity
(setq inst-ent-key
(or (nth 2 (car tmp-list)) ; from configuration
(nth 3 inst-conf-entry) ; from subconfiguration
- (nth 3 (aget conf-alist (nth 7 inst-entry) t))
+ (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry)))
; from configuration spec.
(nth 5 inst-entry))) ; from direct instantiation
- (setq inst-ent-entry (aget ent-alist inst-ent-key t))
+ (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key))
;; determine architecture
(setq inst-arch-key
(or (nth 3 (car tmp-list)) ; from configuration
(nth 4 inst-conf-entry) ; from subconfiguration
(nth 6 inst-entry) ; from direct instantiation
- (nth 4 (aget conf-alist (nth 7 inst-entry)))
+ (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
; from configuration spec.
(nth 4 inst-ent-entry) ; MRA
(caar (nth 3 inst-ent-entry)))) ; first alphabetically
- (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
+ (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key))
;; set library
(setq inst-lib-key
(or (nth 5 (car tmp-list)) ; from configuration
@@ -14353,7 +14520,8 @@ entity ENT-KEY."
(defun vhdl-get-instantiations (ent-key indent)
"Get all instantiations of entity ENT-KEY."
- (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (vhdl-speedbar-line-key indent)))
arch-alist inst-alist ent-inst-list
ent-entry arch-entry inst-entry)
(while ent-alist
@@ -14439,29 +14607,29 @@ entity ENT-KEY."
(insert ")\n")
(when (member 'hierarchy vhdl-speedbar-save-cache)
(insert "\n;; entity and architecture cache\n"
- "(aput 'vhdl-entity-alist " key " '")
- (print (aget vhdl-entity-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-entity-alist " key " '")
+ (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
(insert ")\n\n;; configuration cache\n"
- "(aput 'vhdl-config-alist " key " '")
- (print (aget vhdl-config-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-config-alist " key " '")
+ (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
(insert ")\n\n;; package cache\n"
- "(aput 'vhdl-package-alist " key " '")
- (print (aget vhdl-package-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-package-alist " key " '")
+ (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
(insert ")\n\n;; instantiated entities cache\n"
- "(aput 'vhdl-ent-inst-alist " key " '")
- (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-ent-inst-alist " key " '")
+ (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
(insert ")\n\n;; design units per file cache\n"
- "(aput 'vhdl-file-alist " key " '")
- (print (aget vhdl-file-alist cache-key t) (current-buffer))
+ "(vhdl-aput 'vhdl-file-alist " key " '")
+ (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
(when project
(insert ")\n\n;; source directories in project cache\n"
- "(aput 'vhdl-directory-alist " key " '")
- (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
+ "(vhdl-aput 'vhdl-directory-alist " key " '")
+ (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
(insert ")\n"))
(when (member 'display vhdl-speedbar-save-cache)
(insert "\n;; shown design units cache\n"
- "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
- (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
+ "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
+ (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
(current-buffer))
(insert ")\n"))
(setq vhdl-updated-project-list
@@ -14528,7 +14696,6 @@ if required."
(defun vhdl-speedbar-initialize ()
"Initialize speedbar."
;; general settings
-; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil)
;; VHDL file extensions (extracted from `auto-mode-alist')
(let ((mode-alist auto-mode-alist))
(while mode-alist
@@ -14626,11 +14793,7 @@ if required."
(append
'(("vhdl directory" vhdl-speedbar-update-current-unit)
("vhdl project" vhdl-speedbar-update-current-project
- vhdl-speedbar-update-current-unit)
-; ("files" (lambda () (setq speedbar-ignored-path-regexp
-; (speedbar-extension-list-to-regex
-; speedbar-ignored-path-expressions))))
- )
+ vhdl-speedbar-update-current-unit))
speedbar-stealthy-function-list))
(when (eq vhdl-speedbar-display-mode 'directory)
(setq speedbar-initial-expansion-list-name "vhdl directory"))
@@ -14724,10 +14887,7 @@ if required."
(concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
(goto-char (match-end 1))
(speedbar-do-function-pointer)))
- (setq project-alist (cdr project-alist))))
-; (vhdl-speedbar-update-current-project)
-; (vhdl-speedbar-update-current-unit nil t)
- )
+ (setq project-alist (cdr project-alist)))))
(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
"Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil,
@@ -14737,10 +14897,10 @@ otherwise use cached data."
(vhdl-scan-project-contents project))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist project t)
- (aget vhdl-config-alist project t)
- (aget vhdl-package-alist project t)
- (car (aget vhdl-ent-inst-alist project t)) indent)
+ (vhdl-aget vhdl-entity-alist project)
+ (vhdl-aget vhdl-config-alist project)
+ (vhdl-aget vhdl-package-alist project)
+ (car (vhdl-aget vhdl-ent-inst-alist project)) indent)
(insert (int-to-string indent) ":\n")
(put-text-property (- (point) 3) (1- (point)) 'invisible t)
(put-text-property (1- (point)) (point) 'invisible nil)
@@ -14755,13 +14915,13 @@ otherwise use cached data."
(vhdl-scan-directory-contents directory))
;; insert design hierarchy
(vhdl-speedbar-insert-hierarchy
- (aget vhdl-entity-alist directory t)
- (aget vhdl-config-alist directory t)
- (aget vhdl-package-alist directory t)
- (car (aget vhdl-ent-inst-alist directory t)) depth)
+ (vhdl-aget vhdl-entity-alist directory)
+ (vhdl-aget vhdl-config-alist directory)
+ (vhdl-aget vhdl-package-alist directory)
+ (car (vhdl-aget vhdl-ent-inst-alist directory)) depth)
;; expand design units
(vhdl-speedbar-expand-units directory)
- (aput 'vhdl-directory-alist directory (list (list directory))))
+ (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
ent-inst-list depth)
@@ -14849,10 +15009,10 @@ otherwise use cached data."
(defun vhdl-speedbar-expand-units (key)
"Expand design units in directory/project KEY according to
`vhdl-speedbar-shown-unit-alist'."
- (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
+ (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
(vhdl-speedbar-update-current-unit nil)
vhdl-updated-project-list)
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-prepare-search-1
(while unit-alist ; expand units
(vhdl-speedbar-goto-this-unit key (caar unit-alist))
@@ -14902,7 +15062,7 @@ otherwise use cached data."
(progn (setq vhdl-speedbar-shown-project-list nil)
(vhdl-speedbar-refresh))
(let ((key (vhdl-speedbar-line-key)))
- (adelete 'vhdl-speedbar-shown-unit-alist key)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
(vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key)))))
@@ -14911,9 +15071,9 @@ otherwise use cached data."
"Expand all design units in current directory/project."
(interactive)
(let* ((key (vhdl-speedbar-line-key))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
- (pack-alist (aget vhdl-package-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
+ (pack-alist (vhdl-aget vhdl-package-alist key))
arch-alist unit-alist subunit-alist)
(add-to-list 'vhdl-speedbar-shown-project-list key)
(while ent-alist
@@ -14930,7 +15090,7 @@ otherwise use cached data."
(while pack-alist
(push (list (caar pack-alist)) unit-alist)
(setq pack-alist (cdr pack-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(vhdl-speedbar-refresh)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -14965,8 +15125,8 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand entity
(let* ((key (vhdl-speedbar-line-key indent))
- (ent-alist (aget vhdl-entity-alist key t))
- (ent-entry (aget ent-alist token t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (ent-entry (vhdl-aget ent-alist token))
(arch-alist (nth 3 ent-entry))
(inst-alist (vhdl-get-instantiations token indent))
(subpack-alist (nth 5 ent-entry))
@@ -14976,9 +15136,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add entity to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15017,11 +15177,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove entity from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15034,23 +15194,24 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand architecture
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (ent-alist (aget vhdl-entity-alist key t))
- (conf-alist (aget vhdl-config-alist key t))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (car token) (cdr token) nil nil
0 (1- indent)))
- (ent-entry (aget ent-alist (car token) t))
- (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
+ (ent-entry (vhdl-aget ent-alist (car token)))
+ (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token)))
(subpack-alist (nth 4 arch-entry))
entry)
(if (not (or hier-alist subpack-alist))
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add architecture to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
+ (vhdl-aput 'unit-alist (car token)
+ (list (cons (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15077,10 +15238,10 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove architecture from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key (1- indent)))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
- (arch-alist (nth 0 (aget unit-alist (car token) t))))
- (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
+ (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
+ (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15093,9 +15254,9 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand configuration
(let* ((key (vhdl-speedbar-line-key indent))
- (conf-alist (aget vhdl-config-alist key t))
- (conf-entry (aget conf-alist token))
- (ent-alist (aget vhdl-entity-alist key t))
+ (conf-alist (vhdl-aget vhdl-config-alist key))
+ (conf-entry (vhdl-aget conf-alist token))
+ (ent-alist (vhdl-aget vhdl-entity-alist key))
(hier-alist (vhdl-get-hierarchy
ent-alist conf-alist (nth 3 conf-entry)
(nth 4 conf-entry) token (nth 5 conf-entry)
@@ -15106,9 +15267,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add configuration to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15134,11 +15295,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove configuration from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15151,8 +15312,8 @@ otherwise use cached data."
(cond
((string-match "+" text) ; expand package
(let* ((key (vhdl-speedbar-line-key indent))
- (pack-alist (aget vhdl-package-alist key t))
- (pack-entry (aget pack-alist token t))
+ (pack-alist (vhdl-aget vhdl-package-alist key))
+ (pack-entry (vhdl-aget pack-alist token))
(comp-alist (nth 3 pack-entry))
(func-alist (nth 4 pack-entry))
(func-body-alist (nth 8 pack-entry))
@@ -15162,9 +15323,9 @@ otherwise use cached data."
(speedbar-change-expand-button-char ??)
(speedbar-change-expand-button-char ?-)
;; add package to `vhdl-speedbar-shown-unit-alist'
- (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (aput 'unit-alist token nil)
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
+ (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-aput 'unit-alist token nil)
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
@@ -15185,7 +15346,8 @@ otherwise use cached data."
(vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
(while func-alist
(setq func-entry (car func-alist)
- func-body-entry (aget func-body-alist (car func-entry) t))
+ func-body-entry (vhdl-aget func-body-alist
+ (car func-entry)))
(when (nth 2 func-entry)
(vhdl-speedbar-make-subprogram-line
(nth 1 func-entry)
@@ -15203,11 +15365,11 @@ otherwise use cached data."
(speedbar-change-expand-button-char ?+)
;; remove package from `vhdl-speedbar-shown-unit-alist'
(let* ((key (vhdl-speedbar-line-key indent))
- (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
- (adelete 'unit-alist token)
+ (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
+ (vhdl-adelete 'unit-alist token)
(if unit-alist
- (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
- (adelete 'vhdl-speedbar-shown-unit-alist key))
+ (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
+ (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
(speedbar-delete-subblock indent)
(when (memq 'display vhdl-speedbar-save-cache)
(add-to-list 'vhdl-updated-project-list key))))
@@ -15217,15 +15379,15 @@ otherwise use cached data."
(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
"Insert required packages."
- (let* ((pack-alist (aget vhdl-package-alist
- (vhdl-speedbar-line-key dir-indent) t))
+ (let* ((pack-alist (vhdl-aget vhdl-package-alist
+ (vhdl-speedbar-line-key dir-indent)))
pack-key lib-name pack-entry)
(when subpack-alist
(vhdl-speedbar-make-title-line "Packages Used:" indent))
(while subpack-alist
(setq pack-key (cdar subpack-alist)
lib-name (caar subpack-alist))
- (setq pack-entry (aget pack-alist pack-key t))
+ (setq pack-entry (vhdl-aget pack-alist pack-key))
(vhdl-speedbar-make-subpack-line
(or (nth 0 pack-entry) pack-key) lib-name
(cons (nth 1 pack-entry) (nth 2 pack-entry))
@@ -15283,53 +15445,56 @@ NO-POSITION non-nil means do not re-position cursor."
(or always (not (equal file-name speedbar-last-selected-file))))
(if vhdl-speedbar-show-projects
(while project-list
- (setq file-alist (append file-alist (aget vhdl-file-alist
- (car project-list) t)))
+ (setq file-alist (append file-alist
+ (vhdl-aget vhdl-file-alist
+ (car project-list))))
(setq project-list (cdr project-list)))
- (setq file-alist (aget vhdl-file-alist
- (abbreviate-file-name default-directory) t)))
+ (setq file-alist
+ (vhdl-aget vhdl-file-alist
+ (abbreviate-file-name default-directory))))
(select-frame speedbar-frame)
(set-buffer speedbar-buffer)
(speedbar-with-writable
(vhdl-prepare-search-1
(save-excursion
;; unhighlight last units
- (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
+ (let* ((file-entry (vhdl-aget file-alist
+ speedbar-last-selected-file)))
(vhdl-speedbar-update-units
- "\\[.\\] " (nth 0 file-entry)
+ "\\[.] " (nth 0 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-entity-face)
(vhdl-speedbar-update-units
"{.} " (nth 1 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
(vhdl-speedbar-update-units
- "\\[.\\] " (nth 3 file-entry)
+ "\\[.] " (nth 3 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
(vhdl-speedbar-update-units
"[]>] " (nth 4 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-package-face)
(vhdl-speedbar-update-units
- "\\[.\\].+(" '("body")
+ "\\[.].+(" '("body")
speedbar-last-selected-file 'vhdl-speedbar-package-face)
(vhdl-speedbar-update-units
"> " (nth 6 file-entry)
speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
;; highlight current units
- (let* ((file-entry (aget file-alist file-name t)))
+ (let* ((file-entry (vhdl-aget file-alist file-name)))
(setq
pos (vhdl-speedbar-update-units
- "\\[.\\] " (nth 0 file-entry)
+ "\\[.] " (nth 0 file-entry)
file-name 'vhdl-speedbar-entity-selected-face pos)
pos (vhdl-speedbar-update-units
"{.} " (nth 1 file-entry)
file-name 'vhdl-speedbar-architecture-selected-face pos)
pos (vhdl-speedbar-update-units
- "\\[.\\] " (nth 3 file-entry)
+ "\\[.] " (nth 3 file-entry)
file-name 'vhdl-speedbar-configuration-selected-face pos)
pos (vhdl-speedbar-update-units
"[]>] " (nth 4 file-entry)
file-name 'vhdl-speedbar-package-selected-face pos)
pos (vhdl-speedbar-update-units
- "\\[.\\].+(" '("body")
+ "\\[.].+(" '("body")
file-name 'vhdl-speedbar-package-selected-face pos)
pos (vhdl-speedbar-update-units
"> " (nth 6 file-entry)
@@ -15747,7 +15912,8 @@ is already shown in a buffer."
(let ((buffer (get-file-buffer (car token))))
(speedbar-find-file-in-frame (car token))
(when (or vhdl-speedbar-jump-to-unit buffer)
- (vhdl-goto-line (cdr token))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(recenter))
(vhdl-speedbar-update-current-unit t t)
(speedbar-set-timer dframe-update-speed)
@@ -15760,12 +15926,13 @@ is already shown in a buffer."
(if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
(error "ERROR: No entity/component or subprogram under cursor")
(beginning-of-line)
- (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
+ (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
(condition-case info
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (vhdl-goto-line (cdr token))
+ (progn (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(end-of-line)
(if is-entity
(vhdl-port-copy)
@@ -15805,9 +15972,11 @@ is already shown in a buffer."
(error "ERROR: No architecture under cursor")
(let* ((arch-key (downcase (vhdl-speedbar-line-text)))
(ent-key (downcase (vhdl-speedbar-higher-text)))
- (ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (ent-entry (aget ent-alist ent-key t)))
+ (ent-alist (vhdl-aget
+ vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
+ (ent-entry (vhdl-aget ent-alist ent-key)))
(setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
(speedbar-refresh))))
@@ -15946,15 +16115,14 @@ expansion function)."
;; add speedbar
(when (fboundp 'speedbar)
- (condition-case ()
- (when (and vhdl-speedbar-auto-open
- (not (and (boundp 'speedbar-frame)
- (frame-live-p speedbar-frame))))
- (speedbar-frame-mode 1)
- (if (fboundp 'speedbar-select-attached-frame)
- (speedbar-select-attached-frame)
- (select-frame speedbar-attached-frame)))
- (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))))
+ (let ((current-frame (selected-frame)))
+ (condition-case ()
+ (when (and vhdl-speedbar-auto-open
+ (not (and (boundp 'speedbar-frame)
+ (frame-live-p speedbar-frame))))
+ (speedbar-frame-mode 1))
+ (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))
+ (select-frame current-frame)))
;; initialize speedbar
(if (not (boundp 'speedbar-frame))
@@ -16217,7 +16385,7 @@ component instantiation."
(setq constant-entry
(cons constant-name
(if (match-string 1)
- (or (aget generic-alist (match-string 2) t)
+ (or (vhdl-aget generic-alist (match-string 2))
(error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
(push constant-entry constant-alist)
@@ -16235,11 +16403,12 @@ component instantiation."
(vhdl-forward-syntactic-ws)
(while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
- (setq signal-entry (cons signal-name
- (if (match-string 1)
- (or (aget port-alist (match-string 2) t)
- (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
- (cdar port-alist))))
+ (setq signal-entry
+ (cons signal-name
+ (if (match-string 1)
+ (or (vhdl-aget port-alist (match-string 2))
+ (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
+ (cdar port-alist))))
(push signal-entry signal-alist)
(setq signal-name (downcase signal-name))
(if (equal (upcase (nth 2 signal-entry)) "IN")
@@ -16478,8 +16647,9 @@ current project/directory."
(pack-file-name
(concat (vhdl-replace-string vhdl-package-file-name pack-name t)
"." (file-name-extension (buffer-file-name))))
- (ent-alist (aget vhdl-entity-alist
- (or project default-directory) t))
+ (ent-alist (vhdl-aget vhdl-entity-alist
+ (or project
+ (abbreviate-file-name default-directory))))
(lazy-lock-minimum-size 0)
clause-pos component-pos)
(message "Generating components package \"%s\"..." pack-name)
@@ -16519,7 +16689,8 @@ current project/directory."
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (vhdl-goto-line (nth 3 (car ent-alist)))
+ (progn (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
(end-of-line)
(vhdl-port-copy)))
(goto-char component-pos)
@@ -16581,7 +16752,7 @@ current project/directory."
(when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
(setq conf-key (nth 0 (car tmp-alist))))
(setq tmp-alist (cdr tmp-alist)))
- (setq conf-entry (aget conf-alist conf-key t))
+ (setq conf-entry (vhdl-aget conf-alist conf-key))
;; insert binding indication ...
;; ... with subconfiguration (if exists)
(if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
@@ -16591,7 +16762,7 @@ current project/directory."
(insert (vhdl-work-library) "." (nth 0 conf-entry))
(insert ";\n"))
;; ... with entity (if exists)
- (setq ent-entry (aget ent-alist (nth 5 inst-entry) t))
+ (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry)))
(when ent-entry
(indent-to (+ margin vhdl-basic-offset))
(vhdl-insert-keyword "USE ENTITY ")
@@ -16601,9 +16772,9 @@ current project/directory."
(setq arch-name
;; choose architecture name a) from configuration,
;; b) from mra, or c) from first architecture
- (or (nth 0 (aget (nth 3 ent-entry)
- (or (nth 6 inst-entry)
- (nth 4 ent-entry)) t))
+ (or (nth 0 (vhdl-aget (nth 3 ent-entry)
+ (or (nth 6 inst-entry)
+ (nth 4 ent-entry))))
(nth 1 (car (nth 3 ent-entry)))))
(insert "(" arch-name ")"))
(insert ";\n")
@@ -16613,7 +16784,7 @@ current project/directory."
(indent-to (+ margin vhdl-basic-offset))
(vhdl-compose-configuration-architecture
(nth 0 ent-entry) arch-name ent-alist conf-alist
- (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
+ (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name)))))))
;; insert component configuration end
(indent-to margin)
(vhdl-insert-keyword "END FOR;\n")
@@ -16635,10 +16806,12 @@ current project/directory."
"Generate configuration declaration."
(interactive)
(vhdl-require-hierarchy-info)
- (let ((ent-alist (aget vhdl-entity-alist
- (or (vhdl-project-p) default-directory) t))
- (conf-alist (aget vhdl-config-alist
- (or (vhdl-project-p) default-directory) t))
+ (let ((ent-alist (vhdl-aget vhdl-entity-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
+ (conf-alist (vhdl-aget vhdl-config-alist
+ (or (vhdl-project-p)
+ (abbreviate-file-name default-directory))))
(from-speedbar ent-name)
inst-alist conf-name conf-file-name pos)
(vhdl-prepare-search-2
@@ -16654,8 +16827,8 @@ current project/directory."
vhdl-compose-configuration-name
(concat ent-name " " arch-name)))
(setq inst-alist
- (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t))
- (downcase arch-name) t))))
+ (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name)))
+ (downcase arch-name)))))
(message "Generating configuration \"%s\"..." conf-name)
(if vhdl-compose-configuration-create-file
;; open configuration file
@@ -16721,8 +16894,8 @@ current project/directory."
(defun vhdl-makefile-name ()
"Return the Makefile name of the current project or the current compiler if
no project is defined."
- (let ((project-alist (aget vhdl-project-alist vhdl-project))
- (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
+ (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)"
(or (nth 8 project-alist) (nth 8 compiler-alist)))
@@ -16730,8 +16903,8 @@ no project is defined."
(defun vhdl-compile-directory ()
"Return the directory where compilation/make should be run."
- (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(directory (vhdl-resolve-env-variable
(if project
(vhdl-replace-string
@@ -16765,9 +16938,10 @@ no project is defined."
(defun vhdl-compile-init ()
"Initialize for compilation."
- (when (or (null compilation-error-regexp-alist)
- (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
- compilation-error-regexp-alist)))
+ (when (and (not vhdl-emacs-22)
+ (or (null compilation-error-regexp-alist)
+ (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
+ compilation-error-regexp-alist))))
;; `compilation-error-regexp-alist'
(let ((commands-alist vhdl-compiler-alist)
regexp-alist sublist)
@@ -16810,7 +16984,7 @@ do not print any file names."
&optional file-options-only)
"Get compiler options. Returning nil means do not compile this file."
(let* ((compiler-options (nth 1 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 0 project-entry))
(exception-list (and file-name (nth 2 project-entry)))
(work-library (vhdl-work-library))
@@ -16847,7 +17021,7 @@ do not print any file names."
(defun vhdl-get-make-options (project compiler)
"Get make options."
(let* ((compiler-options (nth 3 compiler))
- (project-entry (aget (nth 4 project) vhdl-compiler))
+ (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
(project-options (nth 1 project-entry))
(makefile-name (vhdl-makefile-name)))
;; insert Makefile name in compiler-specific options
@@ -16868,8 +17042,8 @@ do not print any file names."
`vhdl-compiler'."
(interactive)
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 0 compiler))
(default-directory (vhdl-compile-directory))
@@ -16903,15 +17077,15 @@ do not print any file names."
(defun vhdl-make (&optional target)
"Call make command for compilation of all updated source files (requires
-`Makefile'). Optional argument TARGET allows to compile the design
+`Makefile'). Optional argument TARGET allows you to compile the design
specified by a target."
(interactive)
(setq vhdl-make-target
(or target (read-from-minibuffer "Target: " vhdl-make-target
vhdl-minibuffer-local-map)))
(vhdl-compile-init)
- (let* ((project (aget vhdl-project-alist vhdl-project))
- (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
+ (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 2 compiler))
(options (vhdl-get-make-options project compiler))
@@ -16928,17 +17102,20 @@ specified by a target."
(let ((compiler-alist vhdl-compiler-alist)
(error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
(while compiler-alist
- ;; add error message regexps
- (setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
- (nth 11 (car compiler-alist)))
- error-regexp-alist))
- ;; add filename regexps
- (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ ;; only add regexps for currently selected compiler
+ (when (or (not vhdl-compile-use-local-error-regexp)
+ (equal vhdl-compiler (nth 0 (car compiler-alist))))
+ ;; add error message regexps
(setq error-regexp-alist
- (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
- (nth 12 (car compiler-alist)))
- error-regexp-alist)))
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))))))
+ (nth 11 (car compiler-alist)))
+ error-regexp-alist))
+ ;; add filename regexps
+ (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
+ (setq error-regexp-alist
+ (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
+ (nth 12 (car compiler-alist)))
+ error-regexp-alist))))
(setq compiler-alist (cdr compiler-alist)))
error-regexp-alist)
"List of regexps for VHDL compilers. For Emacs 22+.")
@@ -16949,6 +17126,10 @@ specified by a target."
(interactive)
(when (and (boundp 'compilation-error-regexp-alist-alist)
(not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
+ ;; remove all other compilers
+ (when vhdl-compile-use-local-error-regexp
+ (setq compilation-error-regexp-alist nil))
+ ;; add VHDL compilers
(mapcar
(lambda (item)
(push (car item) compilation-error-regexp-alist)
@@ -16964,7 +17145,7 @@ specified by a target."
(defun vhdl-generate-makefile ()
"Generate `Makefile'."
(interactive)
- (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
+ (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
(error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
(command (nth 4 compiler)))
;; generate makefile
@@ -16997,15 +17178,19 @@ specified by a target."
(vhdl-scan-directory-contents directory))))
(let* ((directory (abbreviate-file-name (vhdl-default-directory)))
(project (vhdl-project-p))
- (ent-alist (aget vhdl-entity-alist (or project directory) t))
- (conf-alist (aget vhdl-config-alist (or project directory) t))
- (pack-alist (aget vhdl-package-alist (or project directory) t))
- (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
- (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
- (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
- (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
- (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
- (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
+ (ent-alist (vhdl-aget vhdl-entity-alist (or project directory)))
+ (conf-alist (vhdl-aget vhdl-config-alist (or project directory)))
+ (pack-alist (vhdl-aget vhdl-package-alist (or project directory)))
+ (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
+ '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
+ "\\1.vhd" "\\1_body.vhd" identity)))
+ (mapping-exist
+ (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
+ (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
+ (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
+ (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
+ (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
+ (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
(adjust-case (nth 5 regexp-list))
(work-library (downcase (vhdl-work-library)))
(compile-directory (expand-file-name (vhdl-compile-directory)
@@ -17022,9 +17207,10 @@ specified by a target."
;; check prerequisites
(unless (file-exists-p compile-directory)
(make-directory compile-directory t))
- (unless regexp-list
- (error "Please contact the VHDL Mode maintainer for support of \"%s\""
- vhdl-compiler))
+ (unless mapping-exist
+ (vhdl-warning
+ (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\""
+ vhdl-compiler vhdl-compiler) t))
(message "Generating makefile \"%s\"..." makefile-name)
;; rules for all entities
(setq tmp-list ent-alist)
@@ -17038,13 +17224,15 @@ specified by a target."
compile-directory))
arch-alist (nth 4 ent-entry)
lib-alist (nth 6 ent-entry)
- rule (aget rule-alist ent-file-name)
+ rule (vhdl-aget rule-alist ent-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
second-list nil
subcomp-list nil)
(setq tmp-key (vhdl-replace-string
- ent-regexp (funcall adjust-case ent-key)))
+ ent-regexp
+ (funcall adjust-case
+ (concat ent-key " " work-library))))
(push (cons ent-key tmp-key) unit-list)
;; rule target for this entity
(push ent-key target-list)
@@ -17053,7 +17241,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist ent-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
;; rules for all corresponding architectures
(while arch-alist
(setq arch-entry (car arch-alist)
@@ -17065,12 +17253,14 @@ specified by a target."
compile-directory))
inst-alist (nth 4 arch-entry)
lib-alist (nth 5 arch-entry)
- rule (aget rule-alist arch-file-name)
+ rule (vhdl-aget rule-alist arch-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
arch-regexp
- (funcall adjust-case (concat arch-key " " ent-key))))
+ (funcall adjust-case
+ (concat arch-key " " ent-key " "
+ work-library))))
(setq unit-list
(cons (cons ent-arch-key tmp-key) unit-list))
(push ent-arch-key second-list)
@@ -17093,7 +17283,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist arch-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
(setq arch-alist (cdr arch-alist)))
(push (list ent-key second-list (append subcomp-list all-pack-list))
prim-list))
@@ -17112,12 +17302,14 @@ specified by a target."
arch-key (nth 5 conf-entry)
inst-alist (nth 6 conf-entry)
lib-alist (nth 7 conf-entry)
- rule (aget rule-alist conf-file-name)
+ rule (vhdl-aget rule-alist conf-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule)
subcomp-list (list ent-key))
(setq tmp-key (vhdl-replace-string
- conf-regexp (funcall adjust-case conf-key)))
+ conf-regexp
+ (funcall adjust-case
+ (concat conf-key " " work-library))))
(push (cons conf-key tmp-key) unit-list)
;; rule target for this configuration
(push conf-key target-list)
@@ -17131,20 +17323,17 @@ specified by a target."
(while inst-alist
(setq inst-entry (car inst-alist))
(setq inst-ent-key (nth 2 inst-entry)
-; comp-arch-key (nth 2 inst-entry))
inst-conf-key (nth 4 inst-entry))
(when (equal (downcase (nth 5 inst-entry)) work-library)
(when inst-ent-key
(setq depend-list (cons inst-ent-key depend-list)
subcomp-list (cons inst-ent-key subcomp-list)))
-; (when comp-arch-key
-; (push (concat comp-ent-key "-" comp-arch-key) depend-list))
(when inst-conf-key
(setq depend-list (cons inst-conf-key depend-list)
subcomp-list (cons inst-conf-key subcomp-list))))
(setq inst-alist (cdr inst-alist)))
;; add rule
- (aput 'rule-alist conf-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
(push (list conf-key nil (append subcomp-list pack-list)) prim-list)
(setq conf-alist (cdr conf-alist)))
(setq conf-alist tmp-list)
@@ -17160,10 +17349,12 @@ specified by a target."
(file-relative-name (nth 2 pack-entry)
compile-directory))
lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
- rule (aget rule-alist pack-file-name)
+ rule (vhdl-aget rule-alist pack-file-name)
target-list (nth 0 rule) depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-regexp (funcall adjust-case pack-key)))
+ pack-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(push (cons pack-key tmp-key) unit-list)
;; rule target for this package
(push pack-key target-list)
@@ -17172,7 +17363,7 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list pack-list)
;; add rule
- (aput 'rule-alist pack-file-name (list target-list depend-list))
+ (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
;; rules for this package's body
(when (nth 7 pack-entry)
(setq pack-body-key (concat pack-key "-body")
@@ -17180,11 +17371,13 @@ specified by a target."
(nth 7 pack-entry)
(file-relative-name (nth 7 pack-entry)
compile-directory))
- rule (aget rule-alist pack-body-file-name)
+ rule (vhdl-aget rule-alist pack-body-file-name)
target-list (nth 0 rule)
depend-list (nth 1 rule))
(setq tmp-key (vhdl-replace-string
- pack-body-regexp (funcall adjust-case pack-key)))
+ pack-body-regexp
+ (funcall adjust-case
+ (concat pack-key " " work-library))))
(setq unit-list
(cons (cons pack-body-key tmp-key) unit-list))
;; rule target for this package's body
@@ -17196,8 +17389,8 @@ specified by a target."
(setq depend-list (append depend-list pack-list))
(setq all-pack-list (append all-pack-list pack-list))
;; add rule
- (aput 'rule-alist pack-body-file-name
- (list target-list depend-list)))
+ (vhdl-aput 'rule-alist pack-body-file-name
+ (list target-list depend-list)))
(setq prim-list
(cons (list pack-key (when pack-body-key (list pack-body-key))
all-pack-list)
@@ -17205,8 +17398,8 @@ specified by a target."
(setq pack-alist (cdr pack-alist)))
(setq pack-alist tmp-list)
;; generate Makefile
- (let* ((project (aget vhdl-project-alist project))
- (compiler (aget vhdl-compiler-alist vhdl-compiler))
+ (let* ((project (vhdl-aget vhdl-project-alist project))
+ (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
(compiler-id (nth 9 compiler))
(library-directory
(vhdl-resolve-env-variable
@@ -17259,12 +17452,16 @@ specified by a target."
compile-directory))))
(insert "\n\n# Define library paths\n"
"\nLIBRARY-" work-library " = " library-directory "\n")
+ (unless mapping-exist
+ (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
+ ")/make" "\n"))
;; insert variable definitions for all library unit files
(insert "\n\n# Define library unit files\n")
(setq tmp-list unit-list)
(while unit-list
(insert "\nUNIT-" work-library "-" (caar unit-list)
- " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
+ " = \\\n\t$(LIBRARY-" work-library
+ (if mapping-exist "" "-make") ")/" (cdar unit-list))
(setq unit-list (cdr unit-list)))
;; insert variable definition for list of all library unit files
(insert "\n\n\n# Define list of all library unit files\n"
@@ -17287,13 +17484,20 @@ specified by a target."
;; insert `make library' rule
(insert "\n\n# Rule for creating library directory\n"
"\n" (nth 2 vhdl-makefile-default-targets) " :"
- " \\\n\t\t$(LIBRARY-" work-library ")\n"
+ " \\\n\t\t$(LIBRARY-" work-library ")"
+ (if mapping-exist ""
+ (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
+ "\n"
"\n$(LIBRARY-" work-library ") :"
"\n\t"
(vhdl-replace-string
(cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
(concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
"\n")
+ (unless mapping-exist
+ (insert "\n$(LIBRARY-" work-library "-make) :"
+ "\n\t"
+ "mkdir -p $(LIBRARY-" work-library "-make)\n"))
;; insert '.PHONY' declaration
(insert "\n\n.PHONY : "
(nth 0 vhdl-makefile-default-targets) " "
@@ -17306,9 +17510,9 @@ specified by a target."
(setq subcomp-list
(sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
(setq unit-key (caar prim-list)
- unit-name (or (nth 0 (aget ent-alist unit-key t))
- (nth 0 (aget conf-alist unit-key t))
- (nth 0 (aget pack-alist unit-key t))))
+ unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
+ (nth 0 (vhdl-aget conf-alist unit-key))
+ (nth 0 (vhdl-aget pack-alist unit-key))))
(insert "\n" unit-key)
(unless (equal unit-key unit-name)
(insert " \\\n" unit-name))
@@ -17358,13 +17562,15 @@ specified by a target."
(nth 0 rule)
(if (equal vhdl-compile-post-command "") ""
" $(POST-COMPILE)") "\n")
+ (insert "\n"))
+ (unless (and options mapping-exist)
(setq tmp-list target-list)
(while target-list
- (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
- (if (cdr target-list) " \\" "\n"))
+ (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
(setq target-list (cdr target-list)))
(setq target-list tmp-list))
(setq rule-alist (cdr rule-alist)))
+
(insert "\n\n### " makefile-name " ends here\n")
;; run Makefile generation hook
(run-hooks 'vhdl-makefile-generation-hook)
@@ -17374,7 +17580,8 @@ specified by a target."
(progn (save-buffer)
(kill-buffer (current-buffer))
(set-buffer orig-buffer)
- (add-to-history 'file-name-history makefile-path-name))
+ (when (fboundp 'add-to-history)
+ (add-to-history 'file-name-history makefile-path-name)))
(vhdl-warning-when-idle
(format "File not writable: \"%s\""
(abbreviate-file-name makefile-path-name)))
@@ -17440,6 +17647,7 @@ specified by a target."
'vhdl-argument-list-indent
'vhdl-association-list-with-formals
'vhdl-conditions-in-parenthesis
+ 'vhdl-sensitivity-list-all
'vhdl-zero-string
'vhdl-one-string
'vhdl-file-header
@@ -17544,6 +17752,17 @@ specified by a target."
(defconst vhdl-doc-release-notes nil
"\
+Release Notes for VHDL Mode 3.37
+================================
+
+- Added support for VHDL'08:
+ - New keywords, types, functions, attributes, operators, packages
+ - Context declaration
+ - Block comments
+ - Directives
+ - 'all' keyword in sensitivity list
+
+
Release Notes for VHDL Mode 3.34
================================
@@ -17605,6 +17824,13 @@ User Options
Reserved words in VHDL
----------------------
+VHDL'08 (IEEE Std 1076-2008):
+ `vhdl-08-keywords' : keywords
+ `vhdl-08-types' : standardized types
+ `vhdl-08-attributes' : standardized attributes
+ `vhdl-08-functions' : standardized functions
+ `vhdl-08-packages' : standardized packages and libraries
+
VHDL'93/02 (IEEE Std 1076-1993/2002):
`vhdl-02-keywords' : keywords
`vhdl-02-types' : standardized types
@@ -17638,17 +17864,17 @@ NOTE: click `mouse-2' on variable names above (not in XEmacs).")
For VHDL coding style and naming convention guidelines, see the following
references:
-\[1] Ben Cohen.
+[1] Ben Cohen.
\"VHDL Coding Styles and Methodologies\".
Kluwer Academic Publishers, 1999.
http://members.aol.com/vhdlcohen/vhdl/
-\[2] Michael Keating and Pierre Bricaud.
+[2] Michael Keating and Pierre Bricaud.
\"Reuse Methodology Manual, Second Edition\".
Kluwer Academic Publishers, 1999.
http://www.openmore.com/openmore/rmm2.html
-\[3] European Space Agency.
+[3] European Space Agency.
\"VHDL Modelling Guidelines\".
ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index c8044f407fc..a8c28130660 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -1,6 +1,6 @@
;;; which-func.el --- print current function in mode line
-;; Copyright (C) 1994, 1997-1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1994, 1997-1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Alex Rezinsky <alexr@msil.sps.mot.com>
@@ -187,21 +187,20 @@ and you want to simplify them for the mode line
which-func-unknown))))
;;;###autoload (put 'which-func-current 'risky-local-variable t)
-(defvar which-func-mode nil
+(defvar-local which-func-mode nil
"Non-nil means display current function name in mode line.
This makes a difference only if `which-function-mode' is non-nil.")
-(make-variable-buffer-local 'which-func-mode)
-;;(put 'which-func-mode 'permanent-local t)
(add-hook 'find-file-hook 'which-func-ff-hook t)
(defun which-func-ff-hook ()
"File find hook for Which Function mode.
It creates the Imenu index for the buffer, if necessary."
- (setq which-func-mode
- (and which-function-mode
- (or (eq which-func-modes t)
- (member major-mode which-func-modes))))
+ (unless (local-variable-p 'which-func-mode)
+ (setq which-func-mode
+ (and which-function-mode
+ (or (eq which-func-modes t)
+ (member major-mode which-func-modes)))))
(condition-case err
(if (and which-func-mode
@@ -210,11 +209,11 @@ It creates the Imenu index for the buffer, if necessary."
(< buffer-saved-size which-func-maxout)
(= which-func-maxout 0)))
(setq imenu--index-alist
- (save-excursion (funcall imenu-create-index-function))))
+ (save-excursion (funcall imenu-create-index-function))))
+ (imenu-unavailable
+ (setq which-func-mode nil))
(error
- (unless (equal err
- '(user-error "This buffer cannot use `imenu-default-create-index-function'"))
- (message "which-func-ff-hook error: %S" err))
+ (message "which-func-ff-hook error: %S" err)
(setq which-func-mode nil))))
(defun which-func-update ()
@@ -259,15 +258,13 @@ in certain major modes."
;;Turn it on
(progn
(setq which-func-update-timer
- (run-with-idle-timer idle-update-delay t 'which-func-update))
+ (run-with-idle-timer idle-update-delay t #'which-func-update))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (setq which-func-mode
- (or (eq which-func-modes t)
- (member major-mode which-func-modes))))))
- ;; Turn it off
- (dolist (buf (buffer-list))
- (with-current-buffer buf (setq which-func-mode nil)))))
+ (unless (local-variable-p 'which-func-mode)
+ (setq which-func-mode
+ (or (eq which-func-modes t)
+ (member major-mode which-func-modes)))))))))
(defvar which-function-imenu-failed nil
"Locally t in a buffer if `imenu--make-index-alist' found nothing there.")
@@ -347,10 +344,11 @@ If no function name is found, return nil."
(defvar ediff-window-B)
(defvar ediff-window-C)
+;; FIXME: Why does ediff require special support?
(defun which-func-update-ediff-windows ()
"Update Which-Function mode display for Ediff windows.
This function is meant to be called from `ediff-select-hook'."
- (when (eq major-mode 'ediff-mode)
+ (when (and (derived-mode-p 'ediff-mode) which-function-mode)
(when ediff-window-A
(which-func-update-1 ediff-window-A))
(when ediff-window-B
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
new file mode 100644
index 00000000000..7eff1f123b5
--- /dev/null
+++ b/lisp/progmodes/xref.el
@@ -0,0 +1,1001 @@
+;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a somewhat generic infrastructure for cross
+;; referencing commands, in particular "find-definition".
+;;
+;; Some part of the functionality must be implemented in a language
+;; dependent way and that's done by defining `xref-find-function',
+;; `xref-identifier-at-point-function' and
+;; `xref-identifier-completion-table-function', which see.
+;;
+;; A major mode should make these variables buffer-local first.
+;;
+;; `xref-find-function' can be called in several ways, see its
+;; description. It has to operate with "xref" and "location" values.
+;;
+;; One would usually call `make-xref' and `xref-make-file-location',
+;; `xref-make-buffer-location' or `xref-make-bogus-location' to create
+;; them. More generally, a location must be an instance of an EIEIO
+;; class inheriting from `xref-location' and implementing
+;; `xref-location-group' and `xref-location-marker'.
+;;
+;; Each identifier must be represented as a string. Implementers can
+;; use string properties to store additional information about the
+;; identifier, but they should keep in mind that values returned from
+;; `xref-identifier-completion-table-function' should still be
+;; distinct, because the user can't see the properties when making the
+;; choice.
+;;
+;; See the functions `etags-xref-find' and `elisp-xref-find' for full
+;; examples.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'ring)
+(require 'pcase)
+(require 'project)
+
+(defgroup xref nil "Cross-referencing commands"
+ :group 'tools)
+
+
+;;; Locations
+
+(defclass xref-location () ()
+ :documentation "A location represents a position in a file or buffer.")
+
+(cl-defgeneric xref-location-marker (location)
+ "Return the marker for LOCATION.")
+
+(cl-defgeneric xref-location-group (location)
+ "Return a string used to group a set of locations.
+This is typically the filename.")
+
+(cl-defgeneric xref-location-line (_location)
+ "Return the line number corresponding to the location."
+ nil)
+
+(cl-defgeneric xref-match-bounds (_item)
+ "Return a cons with columns of the beginning and end of the match."
+ nil)
+
+;;;; Commonly needed location classes are defined here:
+
+;; FIXME: might be useful to have an optional "hint" i.e. a string to
+;; search for in case the line number is sightly out of date.
+(defclass xref-file-location (xref-location)
+ ((file :type string :initarg :file)
+ (line :type fixnum :initarg :line :reader xref-location-line)
+ (column :type fixnum :initarg :column :reader xref-file-location-column))
+ :documentation "A file location is a file/line/column triple.
+Line numbers start from 1 and columns from 0.")
+
+(defun xref-make-file-location (file line column)
+ "Create and return a new xref-file-location."
+ (make-instance 'xref-file-location :file file :line line :column column))
+
+(cl-defmethod xref-location-marker ((l xref-file-location))
+ (with-slots (file line column) l
+ (with-current-buffer
+ (or (get-file-buffer file)
+ (let ((find-file-suppress-same-file-warnings t))
+ (find-file-noselect file)))
+ (save-restriction
+ (widen)
+ (save-excursion
+ (goto-char (point-min))
+ (beginning-of-line line)
+ (move-to-column column)
+ (point-marker))))))
+
+(cl-defmethod xref-location-group ((l xref-file-location))
+ (oref l file))
+
+(defclass xref-buffer-location (xref-location)
+ ((buffer :type buffer :initarg :buffer)
+ (position :type fixnum :initarg :position)))
+
+(defun xref-make-buffer-location (buffer position)
+ "Create and return a new xref-buffer-location."
+ (make-instance 'xref-buffer-location :buffer buffer :position position))
+
+(cl-defmethod xref-location-marker ((l xref-buffer-location))
+ (with-slots (buffer position) l
+ (let ((m (make-marker)))
+ (move-marker m position buffer))))
+
+(cl-defmethod xref-location-group ((l xref-buffer-location))
+ (with-slots (buffer) l
+ (or (buffer-file-name buffer)
+ (format "(buffer %s)" (buffer-name buffer)))))
+
+(defclass xref-bogus-location (xref-location)
+ ((message :type string :initarg :message
+ :reader xref-bogus-location-message))
+ :documentation "Bogus locations are sometimes useful to
+indicate errors, e.g. when we know that a function exists but the
+actual location is not known.")
+
+(defun xref-make-bogus-location (message)
+ "Create and return a new xref-bogus-location."
+ (make-instance 'xref-bogus-location :message message))
+
+(cl-defmethod xref-location-marker ((l xref-bogus-location))
+ (user-error "%s" (oref l message)))
+
+(cl-defmethod xref-location-group ((_ xref-bogus-location)) "(No location)")
+
+
+;;; Cross-reference
+
+(defclass xref-item ()
+ ((summary :type string :initarg :summary
+ :reader xref-item-summary
+ :documentation "One line which will be displayed for
+this item in the output buffer.")
+ (location :initarg :location
+ :reader xref-item-location
+ :documentation "An object describing how to navigate
+to the reference's target."))
+ :comment "An xref item describes a reference to a location
+somewhere.")
+
+(defun xref-make (summary location)
+ "Create and return a new xref item.
+SUMMARY is a short string to describe the xref.
+LOCATION is an `xref-location'."
+ (make-instance 'xref-item :summary summary :location location))
+
+(defclass xref-match-item ()
+ ((summary :type string :initarg :summary
+ :reader xref-item-summary)
+ (location :initarg :location
+ :type xref-file-location
+ :reader xref-item-location)
+ (end-column :initarg :end-column))
+ :comment "An xref item describes a reference to a location
+somewhere.")
+
+(cl-defmethod xref-match-bounds ((i xref-match-item))
+ (with-slots (end-column location) i
+ (cons (xref-file-location-column location)
+ end-column)))
+
+(defun xref-make-match (summary end-column location)
+ "Create and return a new xref match item.
+SUMMARY is a short string to describe the xref.
+END-COLUMN is the match end column number inside SUMMARY.
+LOCATION is an `xref-location'."
+ (make-instance 'xref-match-item :summary summary :location location
+ :end-column end-column))
+
+
+;;; API
+
+(declare-function etags-xref-find "etags" (action id))
+(declare-function tags-lazy-completion-table "etags" ())
+
+;; For now, make the etags backend the default.
+(defvar xref-find-function #'etags-xref-find
+ "Function to look for cross-references.
+It can be called in several ways:
+
+ (definitions IDENTIFIER): Find definitions of IDENTIFIER. The
+result must be a list of xref objects. If IDENTIFIER contains
+sufficient information to determine a unique definition, returns
+only that definition. If there are multiple possible definitions,
+return all of them. If no definitions can be found, return nil.
+
+ (references IDENTIFIER): Find references of IDENTIFIER. The
+result must be a list of xref objects. If no references can be
+found, return nil.
+
+ (apropos PATTERN): Find all symbols that match PATTERN. PATTERN
+is a regexp.
+
+IDENTIFIER can be any string returned by
+`xref-identifier-at-point-function', or from the table returned
+by `xref-identifier-completion-table-function'.
+
+To create an xref object, call `xref-make'.")
+
+(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point
+ "Function to get the relevant identifier at point.
+
+The return value must be a string or nil. nil means no
+identifier at point found.
+
+If it's hard to determine the identifier precisely (e.g., because
+it's a method call on unknown type), the implementation can
+return a simple string (such as symbol at point) marked with a
+special text property which `xref-find-function' would recognize
+and then delegate the work to an external process.")
+
+(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table
+ "Function that returns the completion table for identifiers.")
+
+(defun xref-default-identifier-at-point ()
+ (let ((thing (thing-at-point 'symbol)))
+ (and thing (substring-no-properties thing))))
+
+
+;;; misc utilities
+(defun xref--alistify (list key test)
+ "Partition the elements of LIST into an alist.
+KEY extracts the key from an element and TEST is used to compare
+keys."
+ (let ((alist '()))
+ (dolist (e list)
+ (let* ((k (funcall key e))
+ (probe (cl-assoc k alist :test test)))
+ (if probe
+ (setcdr probe (cons e (cdr probe)))
+ (push (cons k (list e)) alist))))
+ ;; Put them back in order.
+ (cl-loop for (key . value) in (reverse alist)
+ collect (cons key (reverse value)))))
+
+(defun xref--insert-propertized (props &rest strings)
+ "Insert STRINGS with text properties PROPS."
+ (let ((start (point)))
+ (apply #'insert strings)
+ (add-text-properties start (point) props)))
+
+(defun xref--search-property (property &optional backward)
+ "Search the next text range where text property PROPERTY is non-nil.
+Return the value of PROPERTY. If BACKWARD is non-nil, search
+backward."
+ (let ((next (if backward
+ #'previous-single-char-property-change
+ #'next-single-char-property-change))
+ (start (point))
+ (value nil))
+ (while (progn
+ (goto-char (funcall next (point) property))
+ (not (or (setq value (get-text-property (point) property))
+ (eobp)
+ (bobp)))))
+ (cond (value)
+ (t (goto-char start) nil))))
+
+
+;;; Marker stack (M-. pushes, M-, pops)
+
+(defcustom xref-marker-ring-length 16
+ "Length of the xref marker ring."
+ :type 'integer)
+
+(defcustom xref-prompt-for-identifier '(not xref-find-definitions
+ xref-find-definitions-other-window
+ xref-find-definitions-other-frame)
+ "When t, always prompt for the identifier name.
+
+When nil, prompt only when there's no value at point we can use,
+or when the command has been called with the prefix argument.
+
+Otherwise, it's a list of xref commands which will prompt
+anyway (the value at point, if any, will be used as the default).
+
+If the list starts with `not', the meaning of the rest of the
+elements is negated."
+ :type '(choice (const :tag "always" t)
+ (const :tag "auto" nil)
+ (set :menu-tag "command specific" :tag "commands"
+ :value (not)
+ (const :tag "Except" not)
+ (repeat :inline t (symbol :tag "command")))))
+
+(defcustom xref-after-jump-hook '(recenter
+ xref-pulse-momentarily)
+ "Functions called after jumping to an xref."
+ :type 'hook)
+
+(defcustom xref-after-return-hook '(xref-pulse-momentarily)
+ "Functions called after returning to a pre-jump location."
+ :type 'hook)
+
+(defvar xref--marker-ring (make-ring xref-marker-ring-length)
+ "Ring of markers to implement the marker stack.")
+
+(defun xref-push-marker-stack (&optional m)
+ "Add point M (defaults to `point-marker') to the marker stack."
+ (ring-insert xref--marker-ring (or m (point-marker))))
+
+;;;###autoload
+(defun xref-pop-marker-stack ()
+ "Pop back to where \\[xref-find-definitions] was last invoked."
+ (interactive)
+ (let ((ring xref--marker-ring))
+ (when (ring-empty-p ring)
+ (error "Marker stack is empty"))
+ (let ((marker (ring-remove ring 0)))
+ (switch-to-buffer (or (marker-buffer marker)
+ (error "The marked buffer has been deleted")))
+ (goto-char (marker-position marker))
+ (set-marker marker nil nil)
+ (run-hooks 'xref-after-return-hook))))
+
+(defvar xref--current-item nil)
+
+(defun xref-pulse-momentarily ()
+ (pcase-let ((`(,beg . ,end)
+ (save-excursion
+ (or
+ (xref--match-buffer-bounds xref--current-item)
+ (back-to-indentation)
+ (if (eolp)
+ (cons (line-beginning-position) (1+ (point)))
+ (cons (point) (line-end-position)))))))
+ (pulse-momentary-highlight-region beg end 'next-error)))
+
+(defun xref--match-buffer-bounds (item)
+ (save-excursion
+ (let ((bounds (xref-match-bounds item)))
+ (when bounds
+ (cons (progn (move-to-column (car bounds))
+ (point))
+ (progn (move-to-column (cdr bounds))
+ (point)))))))
+
+;; etags.el needs this
+(defun xref-clear-marker-stack ()
+ "Discard all markers from the marker stack."
+ (let ((ring xref--marker-ring))
+ (while (not (ring-empty-p ring))
+ (let ((marker (ring-remove ring)))
+ (set-marker marker nil nil)))))
+
+;;;###autoload
+(defun xref-marker-stack-empty-p ()
+ "Return t if the marker stack is empty; nil otherwise."
+ (ring-empty-p xref--marker-ring))
+
+
+
+(defun xref--goto-char (pos)
+ (cond
+ ((and (<= (point-min) pos) (<= pos (point-max))))
+ (widen-automatically (widen))
+ (t (user-error "Position is outside accessible part of buffer")))
+ (goto-char pos))
+
+(defun xref--goto-location (location)
+ "Set buffer and point according to xref-location LOCATION."
+ (let ((marker (xref-location-marker location)))
+ (set-buffer (marker-buffer marker))
+ (xref--goto-char marker)))
+
+(defun xref--pop-to-location (item &optional window)
+ "Go to the location of ITEM and display the buffer.
+WINDOW controls how the buffer is displayed:
+ nil -- switch-to-buffer
+ `window' -- pop-to-buffer (other window)
+ `frame' -- pop-to-buffer (other frame)"
+ (let* ((marker (save-excursion
+ (xref-location-marker (xref-item-location item))))
+ (buf (marker-buffer marker)))
+ (cl-ecase window
+ ((nil) (switch-to-buffer buf))
+ (window (pop-to-buffer buf t))
+ (frame (let ((pop-up-frames t)) (pop-to-buffer buf t))))
+ (xref--goto-char marker))
+ (let ((xref--current-item item))
+ (run-hooks 'xref-after-jump-hook)))
+
+
+;;; XREF buffer (part of the UI)
+
+;; The xref buffer is used to display a set of xrefs.
+
+(defvar-local xref--display-history nil
+ "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
+
+(defvar-local xref--temporary-buffers nil
+ "List of buffers created by xref code.")
+
+(defvar-local xref--current nil
+ "Non-nil if this buffer was once current, except while displaying xrefs.
+Used for temporary buffers.")
+
+(defvar xref--inhibit-mark-current nil)
+
+(defun xref--mark-selected ()
+ (unless xref--inhibit-mark-current
+ (setq xref--current t))
+ (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
+
+(defun xref--save-to-history (buf win)
+ (let ((restore (window-parameter win 'quit-restore)))
+ ;; Save the new entry if the window displayed another buffer
+ ;; previously.
+ (when (and restore (not (eq (car restore) 'same)))
+ (push (cons buf win) xref--display-history))))
+
+(defun xref--display-position (pos other-window buf)
+ ;; Show the location, but don't hijack focus.
+ (let ((xref-buf (current-buffer)))
+ (with-selected-window (display-buffer buf other-window)
+ (xref--goto-char pos)
+ (run-hooks 'xref-after-jump-hook)
+ (let ((buf (current-buffer))
+ (win (selected-window)))
+ (with-current-buffer xref-buf
+ (setq-local other-window-scroll-buffer buf)
+ (xref--save-to-history buf win))))))
+
+(defun xref--show-location (location)
+ (condition-case err
+ (let ((bl (buffer-list))
+ (xref--inhibit-mark-current t)
+ (marker (xref-location-marker location)))
+ (let ((buf (marker-buffer marker)))
+ (unless (memq buf bl)
+ ;; Newly created.
+ (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
+ (push buf xref--temporary-buffers))
+ (xref--display-position marker t buf)))
+ (user-error (message (error-message-string err)))))
+
+(defun xref-show-location-at-point ()
+ "Display the source of xref at point in the other window, if any."
+ (interactive)
+ (let* ((xref (xref--item-at-point))
+ (xref--current-item xref))
+ (when xref
+ (xref--show-location (xref-item-location xref)))))
+
+(defun xref-next-line ()
+ "Move to the next xref and display its source in the other window."
+ (interactive)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
+(defun xref-prev-line ()
+ "Move to the previous xref and display its source in the other window."
+ (interactive)
+ (xref--search-property 'xref-item t)
+ (xref-show-location-at-point))
+
+(defun xref--item-at-point ()
+ (save-excursion
+ (back-to-indentation)
+ (get-text-property (point) 'xref-item)))
+
+(defvar-local xref--window nil
+ "ACTION argument to call `display-buffer' with.")
+
+(defun xref-goto-xref ()
+ "Jump to the xref on the current line and bury the xref buffer."
+ (interactive)
+ (let ((xref (or (xref--item-at-point)
+ (user-error "No reference at point")))
+ (window xref--window))
+ (xref-quit)
+ (xref--pop-to-location xref window)))
+
+(defun xref-query-replace (from to)
+ "Perform interactive replacement in all current matches."
+ (interactive
+ (list (read-regexp "Query replace regexp in matches" ".*")
+ (read-regexp "Replace with: ")))
+ (let (pairs item)
+ (unwind-protect
+ (progn
+ (save-excursion
+ (goto-char (point-min))
+ ;; TODO: Check that none of the matches are out of date;
+ ;; offer to re-scan otherwise. Note that saving the last
+ ;; modification tick won't work, as long as not all of the
+ ;; buffers are kept open.
+ (while (setq item (xref--search-property 'xref-item))
+ (when (xref-match-bounds item)
+ (save-excursion
+ ;; FIXME: Get rid of xref--goto-location, by making
+ ;; xref-match-bounds return markers already.
+ (xref--goto-location (xref-item-location item))
+ (let ((bounds (xref--match-buffer-bounds item))
+ (beg (make-marker))
+ (end (make-marker)))
+ (move-marker beg (car bounds))
+ (move-marker end (cdr bounds))
+ (push (cons beg end) pairs)))))
+ (setq pairs (nreverse pairs)))
+ (unless pairs (user-error "No suitable matches here"))
+ (xref--query-replace-1 from to pairs))
+ (dolist (pair pairs)
+ (move-marker (car pair) nil)
+ (move-marker (cdr pair) nil)))))
+
+(defun xref--query-replace-1 (from to pairs)
+ (let* ((query-replace-lazy-highlight nil)
+ current-pair current-buf
+ ;; Counteract the "do the next match now" hack in
+ ;; `perform-replace'. And still, it'll report that those
+ ;; matches were "filtered out" at the end.
+ (isearch-filter-predicate
+ (lambda (beg end)
+ (and current-pair
+ (eq (current-buffer) current-buf)
+ (>= beg (car current-pair))
+ (<= end (cdr current-pair)))))
+ (replace-re-search-function
+ (lambda (from &optional _bound noerror)
+ (let (found)
+ (while (and (not found) pairs)
+ (setq current-pair (pop pairs)
+ current-buf (marker-buffer (car current-pair)))
+ (pop-to-buffer current-buf)
+ (goto-char (car current-pair))
+ (when (re-search-forward from (cdr current-pair) noerror)
+ (setq found t)))
+ found))))
+ ;; FIXME: Despite this being a multi-buffer replacement, `N'
+ ;; doesn't work, because we're not using
+ ;; `multi-query-replace-map', and it would expect the below
+ ;; function to be called once per buffer.
+ (perform-replace from to t t nil)))
+
+(defvar xref--xref-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap quit-window] #'xref-quit)
+ (define-key map (kbd "n") #'xref-next-line)
+ (define-key map (kbd "p") #'xref-prev-line)
+ (define-key map (kbd "r") #'xref-query-replace)
+ (define-key map (kbd "RET") #'xref-goto-xref)
+ (define-key map (kbd "C-o") #'xref-show-location-at-point)
+ ;; suggested by Johan Claesson "to further reduce finger movement":
+ (define-key map (kbd ".") #'xref-next-line)
+ (define-key map (kbd ",") #'xref-prev-line)
+ map))
+
+(define-derived-mode xref--xref-buffer-mode special-mode "XREF"
+ "Mode for displaying cross-references."
+ (setq buffer-read-only t)
+ (setq next-error-function #'xref--next-error-function)
+ (setq next-error-last-buffer (current-buffer)))
+
+(defun xref--next-error-function (n reset?)
+ (when reset?
+ (goto-char (point-min)))
+ (let ((backward (< n 0))
+ (n (abs n))
+ (xref nil))
+ (dotimes (_ n)
+ (setq xref (xref--search-property 'xref-item backward)))
+ (cond (xref
+ (xref--pop-to-location xref))
+ (t
+ (error "No %s xref" (if backward "previous" "next"))))))
+
+(defun xref-quit (&optional kill)
+ "Bury temporarily displayed buffers, then quit the current window.
+
+If KILL is non-nil, kill all buffers that were created in the
+process of showing xrefs, and also kill the current buffer.
+
+The buffers that the user has otherwise interacted with in the
+meantime are preserved."
+ (interactive "P")
+ (let ((window (selected-window))
+ (history xref--display-history))
+ (setq xref--display-history nil)
+ (pcase-dolist (`(,buf . ,win) history)
+ (when (and (window-live-p win)
+ (eq buf (window-buffer win)))
+ (quit-window nil win)))
+ (when kill
+ (let ((xref--inhibit-mark-current t)
+ kill-buffer-query-functions)
+ (dolist (buf xref--temporary-buffers)
+ (unless (buffer-local-value 'xref--current buf)
+ (kill-buffer buf)))
+ (setq xref--temporary-buffers nil)))
+ (quit-window kill window)))
+
+(defconst xref-buffer-name "*xref*"
+ "The name of the buffer to show xrefs.")
+
+(defvar xref--button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?m)] #'xref-goto-xref)
+ (define-key map [mouse-1] #'xref-goto-xref)
+ (define-key map [mouse-2] #'xref--mouse-2)
+ map))
+
+(defun xref--mouse-2 (event)
+ "Move point to the button and show the xref definition."
+ (interactive "e")
+ (mouse-set-point event)
+ (forward-line 0)
+ (xref--search-property 'xref-item)
+ (xref-show-location-at-point))
+
+(defun xref--insert-xrefs (xref-alist)
+ "Insert XREF-ALIST in the current-buffer.
+XREF-ALIST is of the form ((GROUP . (XREF ...)) ...). Where
+GROUP is a string for decoration purposes and XREF is an
+`xref-item' object."
+ (require 'compile) ; For the compilation faces.
+ (cl-loop for ((group . xrefs) . more1) on xref-alist
+ for max-line-width =
+ (cl-loop for xref in xrefs
+ maximize (let ((line (xref-location-line
+ (oref xref location))))
+ (length (and line (format "%d" line)))))
+ for line-format = (and max-line-width
+ (format "%%%dd: " max-line-width))
+ do
+ (xref--insert-propertized '(face compilation-info) group "\n")
+ (cl-loop for (xref . more2) on xrefs do
+ (with-slots (summary location) xref
+ (let* ((line (xref-location-line location))
+ (prefix
+ (if line
+ (propertize (format line-format line)
+ 'face 'compilation-line-number)
+ " ")))
+ (xref--insert-propertized
+ (list 'xref-item xref
+ ;; 'face 'font-lock-keyword-face
+ 'mouse-face 'highlight
+ 'keymap xref--button-map
+ 'help-echo
+ (concat "mouse-2: display in another window, "
+ "RET or mouse-1: follow reference"))
+ prefix summary)))
+ (insert "\n"))))
+
+(defun xref--analyze (xrefs)
+ "Find common filenames in XREFS.
+Return an alist of the form ((FILENAME . (XREF ...)) ...)."
+ (xref--alistify xrefs
+ (lambda (x)
+ (xref-location-group (xref-item-location x)))
+ #'equal))
+
+(defun xref--show-xref-buffer (xrefs alist)
+ (let ((xref-alist (xref--analyze xrefs)))
+ (with-current-buffer (get-buffer-create xref-buffer-name)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (xref--insert-xrefs xref-alist)
+ (xref--xref-buffer-mode)
+ (pop-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (setq xref--window (assoc-default 'window alist))
+ (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
+ (dolist (buf xref--temporary-buffers)
+ (with-current-buffer buf
+ (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
+ (current-buffer)))))
+
+
+;; This part of the UI seems fairly uncontroversial: it reads the
+;; identifier and deals with the single definition case.
+;;
+;; The controversial multiple definitions case is handed off to
+;; xref-show-xrefs-function.
+
+(defvar xref-show-xrefs-function 'xref--show-xref-buffer
+ "Function to display a list of xrefs.")
+
+(defvar xref--read-identifier-history nil)
+
+(defvar xref--read-pattern-history nil)
+
+(defun xref--show-xrefs (input kind arg window)
+ (let* ((bl (buffer-list))
+ (xrefs (funcall xref-find-function kind arg))
+ (tb (cl-set-difference (buffer-list) bl)))
+ (cond
+ ((null xrefs)
+ (user-error "No %s found for: %s" (symbol-name kind) input))
+ ((not (cdr xrefs))
+ (xref-push-marker-stack)
+ (xref--pop-to-location (car xrefs) window))
+ (t
+ (xref-push-marker-stack)
+ (funcall xref-show-xrefs-function xrefs
+ `((window . ,window)
+ (temporary-buffers . ,tb)))))))
+
+(defun xref--prompt-p (command)
+ (or (eq xref-prompt-for-identifier t)
+ (if (eq (car xref-prompt-for-identifier) 'not)
+ (not (memq command (cdr xref-prompt-for-identifier)))
+ (memq command xref-prompt-for-identifier))))
+
+(defun xref--read-identifier (prompt)
+ "Return the identifier at point or read it from the minibuffer."
+ (let ((id (funcall xref-identifier-at-point-function)))
+ (cond ((or current-prefix-arg
+ (not id)
+ (xref--prompt-p this-command))
+ (completing-read (if id
+ (format "%s (default %s): "
+ (substring prompt 0 (string-match
+ "[ :]+\\'" prompt))
+ id)
+ prompt)
+ (funcall xref-identifier-completion-table-function)
+ nil nil nil
+ 'xref--read-identifier-history id))
+ (t id))))
+
+
+;;; Commands
+
+(defun xref--find-definitions (id window)
+ (xref--show-xrefs id 'definitions id window))
+
+;;;###autoload
+(defun xref-find-definitions (identifier)
+ "Find the definition of the identifier at point.
+With prefix argument or when there's no identifier at point,
+prompt for it.
+
+If the backend has sufficient information to determine a unique
+definition for IDENTIFIER, it returns only that definition. If
+there are multiple possible definitions, it returns all of them.
+
+If the backend returns one definition, jump to it; otherwise,
+display the list in a buffer."
+ (interactive (list (xref--read-identifier "Find definitions of: ")))
+ (xref--find-definitions identifier nil))
+
+;;;###autoload
+(defun xref-find-definitions-other-window (identifier)
+ "Like `xref-find-definitions' but switch to the other window."
+ (interactive (list (xref--read-identifier "Find definitions of: ")))
+ (xref--find-definitions identifier 'window))
+
+;;;###autoload
+(defun xref-find-definitions-other-frame (identifier)
+ "Like `xref-find-definitions' but switch to the other frame."
+ (interactive (list (xref--read-identifier "Find definitions of: ")))
+ (xref--find-definitions identifier 'frame))
+
+;;;###autoload
+(defun xref-find-references (identifier)
+ "Find references to the identifier at point.
+With prefix argument, prompt for the identifier."
+ (interactive (list (xref--read-identifier "Find references of: ")))
+ (xref--show-xrefs identifier 'references identifier nil))
+
+;; TODO: Rename and move to project-find-regexp, as soon as idiomatic
+;; usage of xref from other packages has stabilized.
+;;;###autoload
+(defun xref-find-regexp (regexp)
+ "Find all matches for REGEXP.
+With \\[universal-argument] prefix, you can specify the directory
+to search in, and the file name pattern to search for."
+ (interactive (list (xref--read-identifier "Find regexp: ")))
+ (require 'grep)
+ (let* ((proj (project-current))
+ (files (if current-prefix-arg
+ (grep-read-files regexp)
+ "*"))
+ (dirs (if current-prefix-arg
+ (list (read-directory-name "Base directory: "
+ nil default-directory t))
+ (project-prune-directories
+ (append
+ (project-roots proj)
+ (project-search-path proj)))))
+ (xref-find-function
+ (lambda (_kind regexp)
+ (cl-mapcan
+ (lambda (dir)
+ (xref-collect-matches regexp files dir
+ (project-ignores proj dir)))
+ dirs))))
+ (xref--show-xrefs regexp 'matches regexp nil)))
+
+(declare-function apropos-parse-pattern "apropos" (pattern))
+
+;;;###autoload
+(defun xref-find-apropos (pattern)
+ "Find all meaningful symbols that match PATTERN.
+The argument has the same meaning as in `apropos'."
+ (interactive (list (read-string
+ "Search for pattern (word list or regexp): "
+ nil 'xref--read-pattern-history)))
+ (require 'apropos)
+ (xref--show-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))
+
+
+;;; Key bindings
+
+;;;###autoload (define-key esc-map "." #'xref-find-definitions)
+;;;###autoload (define-key esc-map "," #'xref-pop-marker-stack)
+;;;###autoload (define-key esc-map "?" #'xref-find-references)
+;;;###autoload (define-key esc-map [?\C-.] #'xref-find-apropos)
+;;;###autoload (define-key ctl-x-4-map "." #'xref-find-definitions-other-window)
+;;;###autoload (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame)
+
+
+;;; Helper functions
+
+(defvar xref-etags-mode--saved nil)
+
+(define-minor-mode xref-etags-mode
+ "Minor mode to make xref use etags again.
+
+Certain major modes install their own mechanisms for listing
+identifiers and navigation. Turn this on to undo those settings
+and just use etags."
+ :lighter ""
+ (if xref-etags-mode
+ (progn
+ (setq xref-etags-mode--saved
+ (cons xref-find-function
+ xref-identifier-completion-table-function))
+ (kill-local-variable 'xref-find-function)
+ (kill-local-variable 'xref-identifier-completion-table-function))
+ (setq-local xref-find-function (car xref-etags-mode--saved))
+ (setq-local xref-identifier-completion-table-function
+ (cdr xref-etags-mode--saved))))
+
+(declare-function semantic-symref-find-references-by-name "semantic/symref")
+(declare-function semantic-find-file-noselect "semantic/fw")
+(declare-function grep-read-files "grep")
+(declare-function grep-expand-template "grep")
+
+(defun xref-collect-references (symbol dir)
+ "Collect references to SYMBOL inside DIR.
+This function uses the Semantic Symbol Reference API, see
+`semantic-symref-find-references-by-name' for details on which
+tools are used, and when."
+ (cl-assert (directory-name-p dir))
+ (require 'semantic/symref)
+ (defvar semantic-symref-tool)
+ (let* ((default-directory dir)
+ (semantic-symref-tool 'detect)
+ (res (semantic-symref-find-references-by-name symbol 'subdirs))
+ (hits (and res (oref res hit-lines)))
+ (orig-buffers (buffer-list)))
+ (unwind-protect
+ (delq nil
+ (mapcar (lambda (hit) (xref--collect-match
+ hit (format "\\_<%s\\_>" (regexp-quote symbol))))
+ hits))
+ (mapc #'kill-buffer
+ (cl-set-difference (buffer-list) orig-buffers)))))
+
+(defun xref-collect-matches (regexp files dir ignores)
+ "Collect matches for REGEXP inside FILES in DIR.
+FILES is a string with glob patterns separated by spaces.
+IGNORES is a list of glob patterns."
+ (cl-assert (directory-name-p dir))
+ (require 'semantic/fw)
+ (grep-compute-defaults)
+ (defvar grep-find-template)
+ (defvar grep-highlight-matches)
+ (let* ((grep-find-template (replace-regexp-in-string "-e " "-E "
+ grep-find-template t t))
+ (grep-highlight-matches nil)
+ (command (xref--rgrep-command (xref--regexp-to-extended regexp)
+ files dir ignores))
+ (orig-buffers (buffer-list))
+ (buf (get-buffer-create " *xref-grep*"))
+ (grep-re (caar grep-regexp-alist))
+ hits)
+ (with-current-buffer buf
+ (erase-buffer)
+ (call-process-shell-command command nil t)
+ (goto-char (point-min))
+ (while (re-search-forward grep-re nil t)
+ (push (cons (string-to-number (match-string 2))
+ (match-string 1))
+ hits)))
+ (unwind-protect
+ (delq nil
+ (mapcar (lambda (hit) (xref--collect-match hit regexp))
+ (nreverse hits)))
+ (mapc #'kill-buffer
+ (cl-set-difference (buffer-list) orig-buffers)))))
+
+(defun xref--rgrep-command (regexp files dir ignores)
+ (require 'find-dired) ; for `find-name-arg'
+ (defvar grep-find-template)
+ (defvar find-name-arg)
+ (grep-expand-template
+ grep-find-template
+ regexp
+ (concat (shell-quote-argument "(")
+ " " find-name-arg " "
+ (mapconcat
+ #'shell-quote-argument
+ (split-string files)
+ (concat " -o " find-name-arg " "))
+ " "
+ (shell-quote-argument ")"))
+ dir
+ (concat
+ (shell-quote-argument "(")
+ " -path "
+ (mapconcat
+ (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))
+ ignores
+ " -o -path ")
+ " "
+ (shell-quote-argument ")")
+ " -prune -o ")))
+
+(defun xref--regexp-to-extended (str)
+ (replace-regexp-in-string
+ ;; FIXME: Add tests. Move to subr.el, make a public function.
+ ;; Maybe error on Emacs-only constructs.
+ "\\(?:\\\\\\\\\\)*\\(?:\\\\[][]\\)?\\(?:\\[.+?\\]\\|\\(\\\\?[(){}|]\\)\\)"
+ (lambda (str)
+ (cond
+ ((not (match-beginning 1))
+ str)
+ ((eq (length (match-string 1 str)) 2)
+ (concat (substring str 0 (match-beginning 1))
+ (substring (match-string 1 str) 1 2)))
+ (t
+ (concat (substring str 0 (match-beginning 1))
+ "\\"
+ (match-string 1 str)))))
+ str t t))
+
+(defun xref--collect-match (hit regexp)
+ (pcase-let* ((`(,line . ,file) hit)
+ (buf (or (find-buffer-visiting file)
+ (semantic-find-file-noselect file))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (syntax-propertize (line-end-position))
+ ;; TODO: Handle multiple matches per line.
+ (when (re-search-forward regexp (line-end-position) t)
+ (goto-char (match-beginning 0))
+ (let ((loc (xref-make-file-location file line
+ (current-column))))
+ (goto-char (match-end 0))
+ (xref-make-match (buffer-substring
+ (line-beginning-position)
+ (line-end-position))
+ (current-column)
+ loc)))))))
+
+(provide 'xref)
+
+;;; xref.el ends here
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 37c3cd37a6c..cf61073b442 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -1,9 +1,9 @@
-;;; xscheme.el --- run MIT Scheme under Emacs
+;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1986-1987, 1989-1990, 2001-2013 Free Software
+;; Copyright (C) 1986-1987, 1989-1990, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: languages, lisp
;; This file is part of GNU Emacs.
@@ -49,13 +49,13 @@
(defvar xscheme-expressions-ring-max 30
"Maximum length of Scheme expressions ring.")
-(defvar xscheme-expressions-ring nil
+(defvar-local xscheme-expressions-ring nil
"List of expressions recently transmitted to the Scheme process.")
-(defvar xscheme-expressions-ring-yank-pointer nil
+(defvar-local xscheme-expressions-ring-yank-pointer nil
"The tail of the Scheme expressions ring whose car is the last thing yanked.")
-(defvar xscheme-running-p nil
+(defvar-local xscheme-running-p nil
"This variable, if nil, indicates that the scheme process is
waiting for input. Otherwise, it is busy evaluating something.")
@@ -64,7 +64,7 @@ waiting for input. Otherwise, it is busy evaluating something.")
control-g interrupts were signaled. Do not allow more control-g's to be
signaled until the scheme process acknowledges receipt.")
-(defvar xscheme-control-g-disabled-p nil
+(defvar-local xscheme-control-g-disabled-p nil
"This variable, if non-nil, indicates that a control-g is being processed
by the scheme process, so additional control-g's are to be ignored.")
@@ -78,37 +78,26 @@ by the scheme process, so additional control-g's are to be ignored.")
(defvar xscheme-runlight "")
(defvar xscheme-runlight-string nil)
-(defvar xscheme-process-filter-state 'idle
+(defvar-local xscheme-process-filter-state 'idle
"State of scheme process escape reader state machine:
idle waiting for an escape sequence
reading-type received an altmode but nothing else
reading-string reading prompt string")
-(defvar xscheme-allow-output-p t
+(defvar-local xscheme-allow-output-p t
"This variable, if nil, prevents output from the scheme process
from being inserted into the process-buffer.")
-(defvar xscheme-prompt ""
+(defvar-local xscheme-prompt ""
"The current scheme prompt string.")
-(defvar xscheme-string-accumulator ""
+(defvar-local xscheme-string-accumulator ""
"Accumulator for the string being received from the scheme process.")
-(defvar xscheme-mode-string nil)
-(setq-default scheme-mode-line-process
- '("" xscheme-runlight))
-
-(mapc 'make-variable-buffer-local
- '(xscheme-expressions-ring
- xscheme-expressions-ring-yank-pointer
- xscheme-process-filter-state
- xscheme-running-p
- xscheme-control-g-disabled-p
- xscheme-allow-output-p
- xscheme-prompt
- xscheme-string-accumulator
- xscheme-mode-string
- scheme-mode-line-process))
+(defvar-local xscheme-mode-string nil)
+(setq-default scheme-mode-line-process '("" xscheme-runlight))
+(make-variable-buffer-local 'scheme-mode-line-process)
+
(defgroup xscheme nil
"Major mode for editing Scheme and interacting with MIT's C-Scheme."
@@ -358,9 +347,9 @@ the command interpreter stack:
Some possible command interpreter types and their meanings are:
-\[Evaluator] read-eval-print loop for evaluating expressions
-\[Debugger] single character commands for debugging errors
-\[Where] single character commands for examining environments
+[Evaluator] read-eval-print loop for evaluating expressions
+[Debugger] single character commands for debugging errors
+[Where] single character commands for examining environments
Starting with release 6.2 of Scheme, the latter two types of command
interpreters will change the major mode of the Scheme process buffer
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 98dd2800b77..8fd0dbb3291 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -1,6 +1,6 @@
;;; ps-bdf.el --- BDF font file handler for ps-print
-;; Copyright (C) 1998-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2001-2015 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 468af28240f..5107329f595 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -1,6 +1,6 @@
;;; ps-def.el --- XEmacs and Emacs definitions for ps-print
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
@@ -325,8 +325,6 @@
;; Emacs
(property-change from)
(overlay-change from)
- (save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil)
before-string after-string)
(while (< from to)
(and (< property-change to) ; Don't search for property change
@@ -339,53 +337,11 @@
(setq position (min property-change overlay-change)
before-string nil
after-string nil)
- ;; The code below is not quite correct,
- ;; because a non-nil overlay invisible property
- ;; which is inactive according to the current value
- ;; of buffer-invisibility-spec nonetheless overrides
- ;; a face text property.
(setq face
- (cond ((let ((prop (get-text-property from 'invisible)))
- ;; Decide whether this invisible property
- ;; really makes the text invisible.
- (if (eq save-buffer-invisibility-spec t)
- (not (null prop))
- (or (memq prop save-buffer-invisibility-spec)
- (assq prop save-buffer-invisibility-spec))))
+ (cond ((invisible-p from)
'emacs--invisible--face)
- ((get-text-property from 'face))
+ ((get-char-property from 'face))
(t 'default)))
- (let ((overlays (overlays-at from))
- (face-priority -1)) ; text-property
- (while (and overlays
- (not (eq face 'emacs--invisible--face)))
- (let* ((overlay (car overlays))
- (overlay-invisible
- (overlay-get overlay 'invisible))
- (overlay-priority
- (or (overlay-get overlay 'priority) 0)))
- (and (> overlay-priority face-priority)
- (setq before-string
- (or (overlay-get overlay 'before-string)
- before-string)
- after-string
- (or (and (<= (overlay-end overlay) position)
- (overlay-get overlay 'after-string))
- after-string)
- face-priority overlay-priority
- face
- (cond
- ((if (eq save-buffer-invisibility-spec t)
- (not (null overlay-invisible))
- (or (memq overlay-invisible
- save-buffer-invisibility-spec)
- (assq overlay-invisible
- save-buffer-invisibility-spec)))
- 'emacs--invisible--face)
- ((overlay-get overlay 'face))
- (t face)
- ))))
- (setq overlays (cdr overlays))))
;; Plot up to this record.
(and before-string
(ps-plot-string before-string))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 7f30700bee8..3afb72aab16 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,6 +1,6 @@
;;; ps-mule.el --- provide multi-byte character facility to ps-print
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 8369afcbbc7..e9294279c23 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1,6 +1,6 @@
;;; ps-print.el --- print text from the buffer as PostScript
-;; Copyright (C) 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2015 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -20,7 +20,7 @@ Emacs without changes to the version number. When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.
Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
;; This file is part of GNU Emacs.
@@ -809,7 +809,7 @@ Please send all bug fixes and enhancements to
;; on next page. Visually, valid values are (the character `+' at right of
;; each column indicates that a line is printed):
;;
-;; `nil' `follow' `full' `full-follow'
+;; nil `follow' `full' `full-follow'
;; Current Page -------- ----------- --------- ----------------
;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
@@ -1684,7 +1684,7 @@ non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
for a shared network printer. You can also set it to a name of a file, in
which case the output gets appended to that file. \(Note that `ps-print'
package already has facilities for printing to a file, so you might as well use
-them instead of changing the setting of this variable.\) If you want to
+them instead of changing the setting of this variable.) If you want to
silently discard the printed output, set this to \"NUL\".
Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
@@ -1771,7 +1771,7 @@ See `ps-lpr-command'."
(defcustom ps-print-region-function
(if (memq system-type '(ms-dos windows-nt))
- #'direct-ps-print-region-function
+ #'w32-direct-ps-print-region-function
#'call-process-region)
"Specify a function to print the region on a PostScript printer.
See definition of `call-process-region' for calling conventions. The fourth
@@ -1953,7 +1953,7 @@ If you set option `ps-selected-pages', first the pages are
filtered by option `ps-selected-pages' and then by `ps-even-or-odd-pages'.
For example, if we have:
- (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
+ (setq ps-selected-pages \\='(1 4 (6 . 10) (12 . 16) 20))
Combining with `ps-even-or-odd-pages' and option `ps-n-up-printing', we have:
@@ -2117,7 +2117,7 @@ See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
Visually, valid values are (the character `+' at right of each column indicates
that a line is printed):
- `nil' `follow' `full' `full-follow'
+ nil `follow' `full' `full-follow'
Current Page -------- ----------- --------- ----------------
1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
@@ -2249,9 +2249,9 @@ X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
number or a string. If it is a string, the string should contain PostScript
programming that returns a float or integer value.
-For example, if you wish to print an EPS image on all pages do:
+For example, if you wish to print an EPS image on all pages use:
- '((\"~/images/EPS-image.ps\"))"
+ ((\"~/images/EPS-image.ps\"))"
:type '(repeat
(list
(file :tag "EPS File")
@@ -2300,9 +2300,9 @@ X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
number or a string. If it is a string, the string should contain PostScript
programming that returns a float or integer value.
-For example, if you wish to print text \"Preliminary\" on all pages do:
+For example, if you wish to print text \"Preliminary\" on all pages use:
- '((\"Preliminary\"))"
+ ((\"Preliminary\"))"
:type '(repeat
(list
(string :tag "Text")
@@ -3172,7 +3172,7 @@ This variable is used only when `ps-print-color-p' is set to `black-white'."
font-lock-variable-name-face
font-lock-keyword-face
font-lock-warning-face))
- "A list of the \(non-bold\) faces that should be printed in bold font.
+ "A list of the (non-bold) faces that should be printed in bold font.
This applies to generating PostScript."
:type '(repeat face)
:version "20"
@@ -3185,7 +3185,7 @@ This applies to generating PostScript."
font-lock-string-face
font-lock-comment-face
font-lock-warning-face))
- "A list of the \(non-italic\) faces that should be printed in italic font.
+ "A list of the (non-italic) faces that should be printed in italic font.
This applies to generating PostScript."
:type '(repeat face)
:version "20"
@@ -3196,7 +3196,7 @@ This applies to generating PostScript."
'(font-lock-function-name-face
font-lock-constant-face
font-lock-warning-face))
- "A list of the \(non-underlined\) faces that should be printed underlined.
+ "A list of the (non-underlined) faces that should be printed underlined.
This applies to generating PostScript."
:type '(repeat face)
:version "20"
@@ -3822,6 +3822,7 @@ If `ps-prefix-quote' is nil, it's set to t after generating string."
(defun ps-get (alist-sym key)
"Return element from association list ALIST-SYM which car is `eq' to KEY."
+ (declare (obsolete alist-get "25.1"))
(assq key (symbol-value alist-sym)))
@@ -3829,6 +3830,7 @@ If `ps-prefix-quote' is nil, it's set to t after generating string."
"Store element (KEY . VALUE) into association list ALIST-SYM.
If KEY already exists in ALIST-SYM, modify cdr to VALUE.
It can be retrieved with `(ps-get ALIST-SYM KEY)'."
+ (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
(let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
(if elt:
(setcdr elt: value)
@@ -3839,6 +3841,7 @@ It can be retrieved with `(ps-get ALIST-SYM KEY)'."
(defun ps-del (alist-sym key)
"Delete by side effect element KEY from association list ALIST-SYM."
+ (declare (obsolete "use (setf (alist-get k alist nil t) nil) instead" "25.1"))
(let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
old)
(while a:list:
@@ -4601,8 +4604,8 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
(setq prompt "File is unwritable"))
((file-exists-p res)
(setq prompt "File exists")
- (not (y-or-n-p (format "File `%s' exists; overwrite? "
- res))))
+ (not (y-or-n-p (format-message
+ "File `%s' exists; overwrite? " res))))
(t nil))
(setq res (read-file-name
(format "%s; save PostScript to file: " prompt)
@@ -5708,7 +5711,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(error "Invalid %s `%S'%s"
mess size
(if arg
- (format " for `%S'" arg)
+ (format-message " for `%S'" arg)
"")))
siz))
@@ -6040,10 +6043,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
(progn
(setq ps-razchunk q-done)
(message "Formatting...%3d%%"
- (if (< q-todo 100)
- (/ (* 100 q-done) q-todo)
- (/ q-done (/ q-todo 100)))
- ))))))
+ (floor (* 100.0 q-done) q-todo)))))))
(defvar ps-last-font nil)
@@ -6121,7 +6121,7 @@ to the equivalent Latin-1 characters.")
(goto-char from)
;; ...break the region up into chunks separated by tabs, linefeeds,
- ;; pagefeeds, control characters, and plot each chunk.
+ ;; formfeeds, control characters, and plot each chunk.
(while (< from to)
;; skip lines between cut markers
(and ps-begin-cut-regexp ps-end-cut-regexp
@@ -6293,6 +6293,10 @@ If FACE is not a valid face name, use default face."
;; only background color, not a `real' face
((ps-face-background-color-p (car face-or-list))
(vector 0 nil (ps-face-extract-color face-or-list)))
+ ;; Anonymous face.
+ ((keywordp (car face-or-list))
+ (vector 0 (plist-get face-or-list :foreground)
+ (plist-get face-or-list :background)))
;; list of faces
(t
(let ((effects 0)
@@ -6425,6 +6429,7 @@ If FACE is not a valid face name, use default face."
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
+ (deactivate-mark) ;bug#16866.
(ps-generate-postscript-with-faces1 from to)))
(defun ps-generate-postscript (from to)
@@ -6584,7 +6589,7 @@ If FACE is not a valid face name, use default face."
;; To make this file smaller, some commands go in a separate file.
;; But autoload them here to make the separation invisible.
-;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
+;;;### (autoloads nil "ps-mule" "ps-mule.el" "231b07356e5a37ebf517c613a3a12bba")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index 3b228293716..581ca366aa7 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -1,6 +1,6 @@
;;; ps-samp.el --- ps-print sample setup code
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
@@ -29,18 +29,7 @@
;;; Commentary:
-;; See ps-print.el for documentation.
-
-;;; Code:
-
-
-(require 'ps-print)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Sample Setup Code:
-
-
+;; Some example hacks for ps-print.el.
;; This stuff is for anybody that's brave enough to look this far,
;; and able to figure out how to use it. It isn't really part of
;; ps-print, but I'll leave it here in hopes it might be useful:
@@ -48,20 +37,23 @@
;; WARNING!!! The following code is *sample* code only.
;; Don't use it unless you understand what it does!
-;; The key `f22' should probably be replaced by `print'. --Stef
+;;; Code:
-;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-rmail-mode-hook ()
- (local-set-key [(f22)] 'ps-rmail-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
- '(ps-article-subject ps-article-author buffer-name)))
+(require 'ps-print)
+
+
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for rmail.
+;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set
+;; `ps-left-header' specially for mail messages.
+(defun ps-rmail-mode-hook ()
+ (local-set-key [print] 'ps-rmail-print-message-from-summary)
+ (setq-local ps-header-lines 3)
+ ;; The left header will display the message's subject, its
+ ;; author, and the name of the folder it was in.
+ (setq-local ps-left-header
+ '(ps-article-subject ps-article-author buffer-name)))
+
+;; Like `ps-gnus-print-article-from-summary', but for rmail.
(defun ps-rmail-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
@@ -76,61 +68,57 @@
(with-current-buffer ps-buf
(ps-spool-buffer-with-faces)))))
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
+;; Look in an article or mail message for the Subject: line.
(defun ps-article-subject ()
(save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "Subject ???")))
+ (save-restriction
+ (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point)))
+ (concat "Subject: " (or (mail-fetch-field "Subject") "???")))))
;; Look in an article or mail message for the From: line. Sorta-kinda
;; understands RFC-822 addresses and can pull the real name out where
-;; it's provided. To be placed in `ps-left-headers'.
+;; it's provided.
(defun ps-article-author ()
(save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
- (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
- (cond
-
- ;; Try first to match addresses that look like
- ;; thompson@wg2.waii.com (Jim Thompson)
- ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
- (substring fromstring (match-beginning 1) (match-end 1)))
-
- ;; Next try to match addresses that look like
- ;; Jim Thompson <thompson@wg2.waii.com> or
- ;; "Jim Thompson" <thompson@wg2.waii.com>
- ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
- (substring fromstring (match-beginning 2) (match-end 2)))
-
- ;; Couldn't find a real name -- show the address instead.
- (t fromstring)))
- "From ???")))
-
-;; A hook to bind to `gnus-article-prepare-hook'. This will set the
-;; `ps-left-headers' specially for gnus articles. Unfortunately,
+ (save-restriction
+ (narrow-to-region (point-min) (progn (rfc822-goto-eoh) (point)))
+ (let ((fromstring (mail-fetch-field "From")))
+ (cond
+ ;; Try first to match addresses that look like
+ ;; thompson@wg2.waii.com (Jim Thompson)
+ ((and fromstring (string-match ".*[ \t]+(\\(.*\\))" fromstring))
+ (match-string 1 fromstring))
+ ;; Next try to match addresses that look like
+ ;; Jim Thompson <thompson@wg2.waii.com> or
+ ;; "Jim Thompson" <thompson@wg2.waii.com>
+ ((and fromstring
+ (string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring))
+ (match-string 2 fromstring))
+ ;; Couldn't find a real name -- show the address instead.
+ (fromstring)
+ (t "From ???"))))))
+
+;; A hook to bind to `gnus-article-prepare-hook'. This will set
+;; `ps-left-header' specially for gnus articles. Unfortunately,
;; `gnus-article-mode-hook' is called only once, the first time the *Article*
;; buffer enters that mode, so it would only work for the first time
;; we ran gnus. The second time, this hook wouldn't get set up. The
;; only alternative is `gnus-article-prepare-hook'.
(defun ps-gnus-article-prepare-hook ()
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the article's subject, its
- ;; author, and the newsgroup it was in.
- '(ps-article-subject ps-article-author gnus-newsgroup-name)))
-
-;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
+ (setq-local ps-header-lines 3)
+ ;; The left headers will display the article's subject, its
+ ;; author, and the newsgroup it was in.
+ (setq-local ps-left-header
+ '(ps-article-subject ps-article-author gnus-newsgroup-name)))
+
+;; A hook to bind to `vm-mode-hook' to locally bind prsc and set
+;; `ps-left-header' specially for mail messages.
(defun ps-vm-mode-hook ()
- (local-set-key [(f22)] 'ps-vm-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
+ (local-set-key [print] 'ps-vm-print-message-from-summary)
+ (setq-local ps-header-lines 3)
+ ;; The left headers will display the message's subject, its
+ ;; author, and the name of the folder it was in.
+ (setq-local ps-left-header
'(ps-article-subject ps-article-author buffer-name)))
;; Every now and then I forget to switch from the *Summary* buffer to
@@ -138,55 +126,43 @@
;; article subjects shows up at the printer. This function, bound to
;; prsc for the gnus *Summary* buffer means I don't have to switch
;; buffers first.
-;; sb: Updated for Gnus 5.
(defun ps-gnus-print-article-from-summary ()
(interactive)
(ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for vm.
+;; Like `ps-gnus-print-article-from-summary', but for vm.
(defun ps-vm-print-message-from-summary ()
(interactive)
(ps-print-message-from-summary 'vm-mail-buffer ""))
-;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
-;; prsc.
+;; A hook to bind to `gnus-summary-setup-buffer' to locally bind prsc.
(defun ps-gnus-summary-setup ()
- (local-set-key [(f22)] 'ps-gnus-print-article-from-summary))
+ (local-set-key [print] 'ps-gnus-print-article-from-summary))
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
(defun ps-info-file ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
+ (match-string 1)
"File ???")))
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
(defun ps-info-node ()
(save-excursion
(goto-char (point-min))
(if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
+ (match-string 1)
"Node ???")))
(defun ps-info-mode-hook ()
- (setq ps-left-header
- ;; The left headers will display the node name and file name.
- '(ps-info-node ps-info-file)))
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless you understand what the effects
-;; will be! (In fact, this is a copy of Jim's setup for ps-print --
-;; I'd be very surprised if it was useful to *anybody*, without
-;; modification.)
-
-(defun ps-jts-ps-setup ()
- (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc
- (global-set-key [(shift f22)] 'ps-spool-region-with-faces)
- (global-set-key [(control f22)] 'ps-despool)
+ ;; The left headers will display the node name and file name.
+ (setq-local ps-left-header '(ps-info-node ps-info-file)))
+
+;; WARNING! The following function is a *sample* only, and is *not* meant
+;; to be used as a whole unless you understand what the effects will be!
+(defun ps-samp-ps-setup ()
+ (global-set-key [print] 'ps-spool-buffer-with-faces)
+ (global-set-key [S-print] 'ps-spool-region-with-faces)
+ (global-set-key [C-print] 'ps-despool)
(add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
(add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
(add-hook 'vm-mode-hook 'ps-vm-mode-hook)
@@ -195,24 +171,10 @@
(setq ps-spool-duplex t
ps-print-color-p nil
ps-lpr-command "lpr"
- ps-lpr-switches '("-Jjct,duplex_long"))
- 'ps-jts-ps-setup)
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless it corresponds to your needs.
-;; (In fact, this is a copy of Jack's setup for ps-print --
-;; I would not be that surprised if it was useful to *anybody*,
-;; without modification.)
-
-(defun ps-jack-setup ()
- (setq ps-print-color-p nil
- ps-lpr-command "lpr"
- ps-lpr-switches nil
-
+ ps-lpr-switches '("-Jjct,duplex_long")
ps-paper-type 'a4
ps-landscape-mode t
ps-number-of-columns 2
-
ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
@@ -225,13 +187,11 @@
ps-header-lines 2
ps-show-n-of-n t
ps-spool-duplex nil
-
ps-font-family 'Courier
ps-font-size 5.5
ps-header-font-family 'Helvetica
ps-header-font-size 6
- ps-header-title-font-size 8)
- 'ps-jack-setup)
+ ps-header-title-font-size 8))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 01a68d9dddd..8f420af6211 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1,6 +1,6 @@
;;; recentf.el --- setup a menu of recently opened files
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Created: July 19 1999
@@ -294,7 +294,7 @@ They are successively passed a file name to transform it."
(function :tag "Other function")))))
(defcustom recentf-show-file-shortcuts-flag t
- "Whether to show ``[N]'' for the Nth item up to 10.
+ "Whether to show \"[N]\" for the Nth item up to 10.
If non-nil, `recentf-open-files' will show labels for keys that can be
used as shortcuts to open the Nth file."
:group 'recentf
@@ -781,7 +781,7 @@ Filenames are relative to the `default-directory'."
)
"List of rules used by `recentf-arrange-by-rule' to build sub-menus.
A rule is a pair (SUB-MENU-TITLE . MATCHER). SUB-MENU-TITLE is the
-displayed title of the sub-menu where a '%d' `format' pattern is
+displayed title of the sub-menu where a `%d' `format' pattern is
replaced by the number of items in the sub-menu. MATCHER is a regexp
or a list of regexps. Items matching one of the regular expressions in
MATCHER are added to the corresponding sub-menu.
@@ -798,7 +798,7 @@ may have been modified to match another rule."
"Title of the `recentf-arrange-by-rule' sub-menu.
This is for the menu where items that don't match any
`recentf-arrange-rules' are displayed. If nil these items are
-displayed in the main recent files menu. A '%d' `format' pattern in
+displayed in the main recent files menu. A `%d' `format' pattern in
the title is replaced by the number of items in the sub-menu."
:group 'recentf-filters
:type '(choice (const :tag "Main menu" nil)
@@ -1224,7 +1224,7 @@ use for the dialog. It defaults to \"*`recentf-menu-title'*\"."
", or type the corresponding digit key,"
"")
" to open it.\n"
- "Click on Cancel or type `q' to cancel.\n")
+ (format-message "Click on Cancel or type `q' to cancel.\n"))
;; Use a L&F that looks like the recentf menu.
(tree-widget-set-theme "folder")
(apply 'widget-create
@@ -1281,7 +1281,8 @@ Write data into the file specified by `recentf-save-file'."
(with-temp-buffer
(erase-buffer)
(set-buffer-file-coding-system recentf-save-file-coding-system)
- (insert (format recentf-save-file-header (current-time-string)))
+ (insert (format-message recentf-save-file-header
+ (current-time-string)))
(recentf-dump-variable 'recentf-list recentf-max-saved-items)
(recentf-dump-variable 'recentf-filter-changer-current)
(insert "\n \n;; Local Variables:\n"
diff --git a/lisp/rect.el b/lisp/rect.el
index ec234b6514f..acd3a48f2da 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -1,6 +1,6 @@
-;;; rect.el --- rectangle functions for GNU Emacs
+;;; rect.el --- rectangle functions for GNU Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1999-2015 Free Software Foundation, Inc.
;; Maintainer: Didier Verna <didier@xemacs.org>
;; Keywords: internal
@@ -31,6 +31,13 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
+(defgroup rectangle nil
+ "Operations on rectangles."
+ :version "25.1"
+ :group 'editing)
+
;; FIXME: this function should be replaced by `apply-on-rectangle'
(defun operate-on-rectangle (function start end coerce-tabs)
"Call FUNCTION for each line of rectangle with corners at START, END.
@@ -42,42 +49,95 @@ FUNCTION is called with three arguments:
number of columns that belong to rectangle but are before that position,
number of columns that belong to rectangle but are after point.
Point is at the end of the segment of this line within the rectangle."
- (let (startcol startlinepos endcol endlinepos)
- (save-excursion
- (goto-char start)
- (setq startcol (current-column))
- (beginning-of-line)
- (setq startlinepos (point)))
- (save-excursion
- (goto-char end)
- (setq endcol (current-column))
- (forward-line 1)
- (setq endlinepos (point-marker)))
- (if (< endcol startcol)
- (setq startcol (prog1 endcol (setq endcol startcol))))
- (save-excursion
- (goto-char startlinepos)
- (while (< (point) endlinepos)
- (let (startpos begextra endextra)
- (if coerce-tabs
- (move-to-column startcol t)
- (move-to-column startcol))
- (setq begextra (- (current-column) startcol))
- (setq startpos (point))
- (if coerce-tabs
- (move-to-column endcol t)
- (move-to-column endcol))
- ;; If we overshot, move back one character
- ;; so that endextra will be positive.
- (if (and (not coerce-tabs) (> (current-column) endcol))
- (backward-char 1))
- (setq endextra (- endcol (current-column)))
- (if (< begextra 0)
- (setq endextra (+ endextra begextra)
- begextra 0))
- (funcall function startpos begextra endextra))
- (forward-line 1)))
- (- endcol startcol)))
+ (apply-on-rectangle
+ (lambda (startcol endcol)
+ (let (startpos begextra endextra)
+ (move-to-column startcol coerce-tabs)
+ (setq begextra (- (current-column) startcol))
+ (setq startpos (point))
+ (move-to-column endcol coerce-tabs)
+ ;; If we overshot, move back one character
+ ;; so that endextra will be positive.
+ (if (and (not coerce-tabs) (> (current-column) endcol))
+ (backward-char 1))
+ (setq endextra (- endcol (current-column)))
+ (if (< begextra 0)
+ (setq endextra (+ endextra begextra)
+ begextra 0))
+ (funcall function startpos begextra endextra)))
+ start end))
+
+;;; Crutches to let rectangle's corners be where point can't be
+;; (e.g. in the middle of a TAB, or past the EOL).
+
+(defvar-local rectangle--mark-crutches nil
+ "(POS . COL) to override the column to use for the mark.")
+
+(defun rectangle--pos-cols (start end &optional window)
+ ;; At this stage, we don't know which of start/end is point/mark :-(
+ ;; And in case start=end, it might still be that point and mark have
+ ;; different crutches!
+ (let ((cw (window-parameter window 'rectangle--point-crutches)))
+ (cond
+ ((eq start (car cw))
+ (let ((sc (cdr cw))
+ (ec (if (eq end (car rectangle--mark-crutches))
+ (cdr rectangle--mark-crutches)
+ (if rectangle--mark-crutches
+ (setq rectangle--mark-crutches nil))
+ (goto-char end) (current-column))))
+ (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec))))
+ ((eq end (car cw))
+ (if (eq start (car rectangle--mark-crutches))
+ (cons (cdr rectangle--mark-crutches) (cdr cw))
+ (if rectangle--mark-crutches (setq rectangle--mark-crutches nil))
+ (cons (progn (goto-char start) (current-column)) (cdr cw))))
+ ((progn
+ (if cw (setf (window-parameter nil 'rectangle--point-crutches) nil))
+ (eq start (car rectangle--mark-crutches)))
+ (let ((sc (cdr rectangle--mark-crutches))
+ (ec (progn (goto-char end) (current-column))))
+ (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec))))
+ ((eq end (car rectangle--mark-crutches))
+ (cons (progn (goto-char start) (current-column))
+ (cdr rectangle--mark-crutches)))
+ (t
+ (if rectangle--mark-crutches (setq rectangle--mark-crutches nil))
+ (cons (progn (goto-char start) (current-column))
+ (progn (goto-char end) (current-column)))))))
+
+(defun rectangle--col-pos (col kind)
+ (let ((c (move-to-column col)))
+ (if (= c col)
+ (if (eq kind 'point)
+ (if (window-parameter nil 'rectangle--point-crutches)
+ (setf (window-parameter nil 'rectangle--point-crutches) nil))
+ (if rectangle--mark-crutches (setq rectangle--mark-crutches nil)))
+ ;; If move-to-column overshot, move back one char so we're
+ ;; at the position where rectangle--highlight-for-redisplay
+ ;; will add the overlay (so that the cursor can be drawn at the
+ ;; right place).
+ (when (> c col) (forward-char -1))
+ (setf (if (eq kind 'point)
+ (window-parameter nil 'rectangle--point-crutches)
+ rectangle--mark-crutches)
+ (cons (point) col)))))
+
+(defun rectangle--point-col (pos)
+ (let ((pc (window-parameter nil 'rectangle--point-crutches)))
+ (if (eq pos (car pc)) (cdr pc)
+ (goto-char pos)
+ (current-column))))
+
+(defun rectangle--crutches ()
+ (cons rectangle--mark-crutches
+ (window-parameter nil 'rectangle--point-crutches)))
+(defun rectangle--reset-crutches ()
+ (kill-local-variable 'rectangle--mark-crutches)
+ (if (window-parameter nil 'rectangle--point-crutches)
+ (setf (window-parameter nil 'rectangle--point-crutches) nil)))
+
+;;; Rectangle operations.
(defun apply-on-rectangle (function start end &rest args)
"Call FUNCTION for each line of rectangle with corners at START, END.
@@ -85,27 +145,27 @@ FUNCTION is called with two arguments: the start and end columns of the
rectangle, plus ARGS extra arguments. Point is at the beginning of line when
the function is called.
The final point after the last operation will be returned."
- (let (startcol startpt endcol endpt final-point)
- (save-excursion
- (goto-char start)
- (setq startcol (current-column))
- (beginning-of-line)
- (setq startpt (point))
- (goto-char end)
- (setq endcol (current-column))
- (forward-line 1)
- (setq endpt (point-marker))
- ;; ensure the start column is the left one.
+ (save-excursion
+ (let* ((cols (rectangle--pos-cols start end))
+ (startcol (car cols))
+ (endcol (cdr cols))
+ (startpt (progn (goto-char start) (line-beginning-position)))
+ (endpt (progn (goto-char end)
+ (copy-marker (line-end-position))))
+ final-point)
+ ;; Ensure the start column is the left one.
(if (< endcol startcol)
(let ((col startcol))
(setq startcol endcol endcol col)))
- ;; start looping over lines
+ ;; Start looping over lines.
(goto-char startpt)
- (while (< (point) endpt)
- (apply function startcol endcol args)
- (setq final-point (point))
- (forward-line 1)))
- final-point))
+ (while
+ (progn
+ (apply function startcol endcol args)
+ (setq final-point (point))
+ (and (zerop (forward-line 1)) (bolp)
+ (<= (point) endpt))))
+ final-point)))
(defun delete-rectangle-line (startcol endcol fill)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
@@ -286,7 +346,8 @@ no text on the right side of the rectangle."
(defun delete-whitespace-rectangle-line (startcol _endcol fill)
(when (= (move-to-column startcol (if fill t 'coerce)) startcol)
(unless (= (point) (point-at-eol))
- (delete-region (point) (progn (skip-syntax-forward " ") (point))))))
+ (delete-region (point) (progn (skip-syntax-forward " " (point-at-eol))
+ (point))))))
;;;###autoload
(defalias 'close-rectangle 'delete-whitespace-rectangle) ;; Old name
@@ -310,6 +371,67 @@ With a prefix (or a FILL) argument, also fill too short lines."
(delete-rectangle-line startcol endcol nil))
(insert string))
+(defvar-local rectangle--string-preview-state nil)
+(defvar-local rectangle--string-preview-window nil)
+
+(defun rectangle--string-flush-preview ()
+ (mapc #'delete-overlay (nthcdr 3 rectangle--string-preview-state))
+ (setf (nthcdr 3 rectangle--string-preview-state) nil))
+
+(defun rectangle--string-erase-preview ()
+ (with-selected-window rectangle--string-preview-window
+ (rectangle--string-flush-preview)))
+
+(defun rectangle--space-to (col)
+ (propertize " " 'display `(space :align-to ,col)))
+
+(defface rectangle-preview-face '((t :inherit region))
+ "The face to use for the `string-rectangle' preview.")
+
+(defcustom rectangle-preview t
+ "If non-nil, `string-rectangle' will show an-the-fly preview."
+ :type 'boolean)
+
+(defun rectangle--string-preview ()
+ (let ((str (minibuffer-contents)))
+ (when (equal str "")
+ (setq str (or (car-safe minibuffer-default)
+ (if (stringp minibuffer-default) minibuffer-default))))
+ (when str (setq str (propertize str 'face 'region)))
+ (with-selected-window rectangle--string-preview-window
+ (unless (or (null rectangle--string-preview-state)
+ (equal str (car rectangle--string-preview-state)))
+ (rectangle--string-flush-preview)
+ (apply-on-rectangle
+ (lambda (startcol endcol)
+ (let* ((sc (move-to-column startcol))
+ (start (if (<= sc startcol) (point)
+ (forward-char -1)
+ (setq sc (current-column))
+ (point)))
+ (ec (move-to-column endcol))
+ (end (point))
+ (ol (make-overlay start end)))
+ (push ol (nthcdr 3 rectangle--string-preview-state))
+ ;; FIXME: The extra spacing doesn't interact correctly with
+ ;; the extra spacing added by the rectangular-region-highlight.
+ (when (< sc startcol)
+ (overlay-put ol 'before-string (rectangle--space-to startcol)))
+ (let ((as (when (< endcol ec)
+ ;; (rectangle--space-to ec)
+ (spaces-string (- ec endcol))
+ )))
+ (if (= start end)
+ (overlay-put ol 'after-string (if as (concat str as) str))
+ (overlay-put ol 'display str)
+ (if as (overlay-put ol 'after-string as))))))
+ (nth 1 rectangle--string-preview-state)
+ (nth 2 rectangle--string-preview-state))))))
+
+;; FIXME: Should this be turned into inhibit-region-highlight and made to apply
+;; to non-rectangular regions as well?
+(defvar rectangle--inhibit-region-highlight nil)
+
;;;###autoload
(defun string-rectangle (start end string)
"Replace rectangle contents with STRING on each line.
@@ -317,14 +439,31 @@ The length of STRING need not be the same as the rectangle width.
Called from a program, takes three args; START, END and STRING."
(interactive
- (progn (barf-if-buffer-read-only)
- (list
- (region-beginning)
- (region-end)
+ (progn
+ (make-local-variable 'rectangle--string-preview-state)
+ (make-local-variable 'rectangle--inhibit-region-highlight)
+ (let* ((buf (current-buffer))
+ (win (if (eq (window-buffer) buf) (selected-window)))
+ (start (region-beginning))
+ (end (region-end))
+ (rectangle--string-preview-state `(nil ,start ,end))
+ ;; Rectangle-region-highlighting doesn't work well in the presence
+ ;; of the preview overlays. We could work harder to try and make
+ ;; it work better, but it's easier to just disable it temporarily.
+ (rectangle--inhibit-region-highlight t))
+ (barf-if-buffer-read-only)
+ (list start end
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq rectangle--string-preview-window win)
+ (add-hook 'minibuffer-exit-hook
+ #'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) ""))
nil 'string-rectangle-history
- (car string-rectangle-history)))))
+ (car string-rectangle-history)))))))
(goto-char
(apply-on-rectangle 'string-rectangle-line start end string t)))
@@ -382,7 +521,7 @@ rectangle which were empty."
(setq rectangle-number-line-counter
(1+ rectangle-number-line-counter)))
-(defun rectange--default-line-number-format (start end start-at)
+(defun rectangle--default-line-number-format (start end start-at)
(concat "%"
(int-to-string (length (int-to-string (+ (count-lines start end)
start-at))))
@@ -403,15 +542,287 @@ with a prefix argument, prompt for START-AT and FORMAT."
(start-at (read-number "Number to count from: " 1)))
(list start end start-at
(read-string "Format string: "
- (rectange--default-line-number-format
+ (rectangle--default-line-number-format
start end start-at))))
(list (region-beginning) (region-end) 1 nil)))
(unless format
- (setq format (rectange--default-line-number-format start end start-at)))
+ (setq format (rectangle--default-line-number-format start end start-at)))
(let ((rectangle-number-line-counter start-at))
(apply-on-rectangle 'rectangle-number-line-callback
start end format)))
+;;; New rectangle integration with kill-ring.
+
+;; FIXME: known problems with the new rectangle support:
+;; - lots of commands handle the region without paying attention to its
+;; rectangular shape.
+
+(add-function :around redisplay-highlight-region-function
+ #'rectangle--highlight-for-redisplay)
+(add-function :around redisplay-unhighlight-region-function
+ #'rectangle--unhighlight-for-redisplay)
+(add-function :around region-extract-function
+ #'rectangle--extract-region)
+
+(defvar rectangle-mark-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-o] 'open-rectangle)
+ (define-key map [?\C-t] 'string-rectangle)
+ (define-key map [remap exchange-point-and-mark]
+ 'rectangle-exchange-point-and-mark)
+ (dolist (cmd '(right-char left-char forward-char backward-char
+ next-line previous-line))
+ (define-key map (vector 'remap cmd)
+ (intern (format "rectangle-%s" cmd))))
+ map)
+ "Keymap used while marking a rectangular region.")
+
+;;;###autoload
+(define-minor-mode rectangle-mark-mode
+ "Toggle the region as rectangular.
+Activates the region if needed. Only lasts until the region is deactivated."
+ nil nil nil
+ (rectangle--reset-crutches)
+ (when rectangle-mark-mode
+ (add-hook 'deactivate-mark-hook
+ (lambda () (rectangle-mark-mode -1)))
+ (unless (region-active-p)
+ (push-mark (point) t t)
+ (message "Mark set (rectangle mode)"))))
+
+(defun rectangle-exchange-point-and-mark (&optional arg)
+ "Like `exchange-point-and-mark' but cycles through the rectangle's corners."
+ (interactive "P")
+ (if arg
+ (progn
+ (setq this-command 'exchange-point-and-mark)
+ (exchange-point-and-mark arg))
+ (let* ((p (point))
+ (repeat (eq this-command last-command))
+ (m (mark))
+ (p<m (< p m))
+ (cols (if p<m (rectangle--pos-cols p m) (rectangle--pos-cols m p)))
+ (cp (if p<m (car cols) (cdr cols)))
+ (cm (if p<m (cdr cols) (car cols))))
+ (if repeat (setq this-command 'exchange-point-and-mark))
+ (rectangle--reset-crutches)
+ (goto-char p)
+ (rectangle--col-pos (if repeat cm cp) 'mark)
+ (set-mark (point))
+ (goto-char m)
+ (rectangle--col-pos (if repeat cp cm) 'point))))
+
+(defun rectangle--*-char (cmd n &optional other-cmd)
+ ;; Part of the complexity here is that I'm trying to avoid making assumptions
+ ;; about the L2R/R2L direction of text around point, but this is largely
+ ;; useless since the rectangles implemented in this file are "logical
+ ;; rectangles" and not "visual rectangles", so in the presence of
+ ;; bidirectional text things won't work well anyway.
+ (if (< n 0) (rectangle--*-char other-cmd (- n))
+ (let ((col (rectangle--point-col (point))))
+ (while (> n 0)
+ (let* ((bol (line-beginning-position))
+ (eol (line-end-position))
+ (curcol (current-column))
+ (nextcol
+ (condition-case nil
+ (save-excursion
+ (funcall cmd 1)
+ (cond
+ ((> bol (point)) (- curcol 1))
+ ((< eol (point)) (+ col (1+ n)))
+ (t (current-column))))
+ (end-of-buffer (+ col (1+ n)))
+ (beginning-of-buffer (- curcol 1))))
+ (diff (abs (- nextcol col))))
+ (cond
+ ((and (< nextcol curcol) (< curcol col))
+ (let ((curdiff (- col curcol)))
+ (if (<= curdiff n)
+ (progn (cl-decf n curdiff) (setq col curcol))
+ (setq col (- col n) n 0))))
+ ((< nextcol 0) (ding) (setq n 0 col 0)) ;Bumping into BOL!
+ ((= nextcol curcol) (funcall cmd 1))
+ (t ;; (> nextcol curcol)
+ (if (<= diff n)
+ (progn (cl-decf n diff) (setq col nextcol))
+ (setq col (if (< col nextcol) (+ col n) (- col n)) n 0))))))
+ ;; FIXME: This rectangle--col-pos's move-to-column is wasted!
+ (rectangle--col-pos col 'point))))
+
+(defun rectangle-right-char (&optional n)
+ "Like `right-char' but steps into wide chars and moves past EOL."
+ (interactive "p") (rectangle--*-char #'right-char n #'left-char))
+(defun rectangle-left-char (&optional n)
+ "Like `left-char' but steps into wide chars and moves past EOL."
+ (interactive "p") (rectangle--*-char #'left-char n #'right-char))
+
+(defun rectangle-forward-char (&optional n)
+ "Like `forward-char' but steps into wide chars and moves past EOL."
+ (interactive "p") (rectangle--*-char #'forward-char n #'backward-char))
+(defun rectangle-backward-char (&optional n)
+ "Like `backward-char' but steps into wide chars and moves past EOL."
+ (interactive "p") (rectangle--*-char #'backward-char n #'forward-char))
+
+(defun rectangle-next-line (&optional n)
+ "Like `next-line' but steps into wide chars and moves past EOL.
+Ignores `line-move-visual'."
+ (interactive "p")
+ (let ((col (rectangle--point-col (point))))
+ (forward-line n)
+ (rectangle--col-pos col 'point)))
+(defun rectangle-previous-line (&optional n)
+ "Like `previous-line' but steps into wide chars and moves past EOL.
+Ignores `line-move-visual'."
+ (interactive "p")
+ (let ((col (rectangle--point-col (point))))
+ (forward-line (- n))
+ (rectangle--col-pos col 'point)))
+
+
+(defun rectangle--extract-region (orig &optional delete)
+ (if (not rectangle-mark-mode)
+ (funcall orig delete)
+ (let* ((strs (funcall (if delete
+ #'delete-extract-rectangle
+ #'extract-rectangle)
+ (region-beginning) (region-end)))
+ (str (mapconcat #'identity strs "\n")))
+ (when (eq last-command 'kill-region)
+ ;; Try to prevent kill-region from appending this to some
+ ;; earlier element.
+ (setq last-command 'kill-region-dont-append))
+ (when strs
+ (put-text-property 0 (length str) 'yank-handler
+ `(rectangle--insert-for-yank ,strs t)
+ str)
+ str))))
+
+(defun rectangle--insert-for-yank (strs)
+ (push (point) buffer-undo-list)
+ (let ((undo-at-start buffer-undo-list))
+ (insert-rectangle strs)
+ (setq yank-undo-function
+ (lambda (_start _end)
+ (undo-start)
+ (setcar undo-at-start nil) ;Turn it into a boundary.
+ (while (not (eq pending-undo-list (cdr undo-at-start)))
+ (undo-more 1))))))
+
+(defun rectangle--place-cursor (leftcol left str)
+ (let ((pc (window-parameter nil 'rectangle--point-crutches)))
+ (if (and (eq left (car pc)) (eq leftcol (cdr pc)))
+ (put-text-property 0 1 'cursor 1 str))))
+
+(defun rectangle--highlight-for-redisplay (orig start end window rol)
+ (cond
+ ((not rectangle-mark-mode)
+ (funcall orig start end window rol))
+ (rectangle--inhibit-region-highlight
+ (funcall redisplay-unhighlight-region-function rol)
+ nil)
+ ((and (eq 'rectangle (car-safe rol))
+ (eq (nth 1 rol) (buffer-chars-modified-tick))
+ (eq start (nth 2 rol))
+ (eq end (nth 3 rol))
+ (equal (rectangle--crutches) (nth 4 rol)))
+ rol)
+ (t
+ (save-excursion
+ (let* ((nrol nil)
+ (old (if (eq 'rectangle (car-safe rol))
+ (nthcdr 5 rol)
+ (funcall redisplay-unhighlight-region-function rol)
+ nil)))
+ (cl-assert (eq (window-buffer window) (current-buffer)))
+ ;; `rectangle--pos-cols' looks up the `selected-window's parameter!
+ (with-selected-window window
+ (apply-on-rectangle
+ (lambda (leftcol rightcol)
+ (let* ((mleft (move-to-column leftcol))
+ (left (point))
+ ;; BEWARE: In the presence of other overlays with
+ ;; before/after/display-strings, this happens to move to
+ ;; the column "as if the overlays were not applied", which
+ ;; is sometimes what we want, tho it can be
+ ;; considered a bug in move-to-column (it should arguably
+ ;; pay attention to the before/after-string/display
+ ;; properties when computing the column).
+ (mright (move-to-column rightcol))
+ (right (point))
+ (ol
+ (if (not old)
+ (let ((ol (make-overlay left right)))
+ (overlay-put ol 'window window)
+ (overlay-put ol 'face 'region)
+ ol)
+ (let ((ol (pop old)))
+ (move-overlay ol left right (current-buffer))
+ ol))))
+ ;; `move-to-column' may stop before the column (if bumping into
+ ;; EOL) or overshoot it a little, when column is in the middle
+ ;; of a char.
+ (cond
+ ((< mleft leftcol) ;`leftcol' is past EOL.
+ (overlay-put ol 'before-string (rectangle--space-to leftcol))
+ (setq mright (max mright leftcol)))
+ ((and (> mleft leftcol) ;`leftcol' is in the middle of a char.
+ (eq (char-before left) ?\t))
+ (setq left (1- left))
+ (move-overlay ol left right)
+ (goto-char left)
+ (overlay-put ol 'before-string (rectangle--space-to leftcol)))
+ ((overlay-get ol 'before-string)
+ (overlay-put ol 'before-string nil)))
+ (cond
+ ;; While doing rectangle--string-preview, the two sets of
+ ;; overlays steps on the other's toes. I fixed some of the
+ ;; problems, but others remain. The main one is the two
+ ;; (rectangle--space-to rightcol) below which try to virtually
+ ;; insert missing text, but during "preview", the text is not
+ ;; missing (it's provided by preview's own overlay).
+ (rectangle--string-preview-state
+ (if (overlay-get ol 'after-string)
+ (overlay-put ol 'after-string nil)))
+ ((< mright rightcol) ;`rightcol' is past EOL.
+ (let ((str (rectangle--space-to rightcol)))
+ (put-text-property 0 (length str) 'face 'region str)
+ ;; If cursor happens to be here, draw it at the right place.
+ (rectangle--place-cursor leftcol left str)
+ (overlay-put ol 'after-string str)))
+ ((and (> mright rightcol) ;`rightcol's in the middle of a char.
+ (eq (char-before right) ?\t))
+ (setq right (1- right))
+ (move-overlay ol left right)
+ (if (= rightcol leftcol)
+ (overlay-put ol 'after-string nil)
+ (goto-char right)
+ (let ((str (rectangle--space-to rightcol)))
+ (put-text-property 0 (length str) 'face 'region str)
+ (when (= left right)
+ (rectangle--place-cursor leftcol left str))
+ (overlay-put ol 'after-string str))))
+ ((overlay-get ol 'after-string)
+ (overlay-put ol 'after-string nil)))
+ (when (and (= leftcol rightcol) (display-graphic-p))
+ ;; Make zero-width rectangles visible!
+ (overlay-put ol 'after-string
+ (concat (propertize " "
+ 'face '(region (:height 0.2)))
+ (overlay-get ol 'after-string))))
+ (push ol nrol)))
+ start end))
+ (mapc #'delete-overlay old)
+ `(rectangle ,(buffer-chars-modified-tick)
+ ,start ,end ,(rectangle--crutches)
+ ,@nrol))))))
+
+(defun rectangle--unhighlight-for-redisplay (orig rol)
+ (if (not (eq 'rectangle (car-safe rol)))
+ (funcall orig rol)
+ (mapc #'delete-overlay (nthcdr 5 rol))
+ (setcar (cdr rol) nil)))
+
(provide 'rect)
;;; rect.el ends here
diff --git a/lisp/register.el b/lisp/register.el
index 78f18dbc7c1..110c36f04c7 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -1,9 +1,9 @@
-;;; register.el --- register commands for Emacs
+;;; register.el --- register commands for Emacs -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 1993-1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985, 1993-1994, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -27,12 +27,14 @@
;; This package of functions emulates and somewhat extends the venerable
;; TECO's `register' feature, which permits you to save various useful
;; pieces of buffer state to named variables. The entry points are
-;; documented in the Emacs user's manual.
+;; documented in the Emacs user's manual: (info "(emacs) Registers").
(eval-when-compile (require 'cl-lib))
;;; Code:
+;; FIXME: Clean up namespace usage!
+
(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
@@ -81,33 +83,103 @@ A list of the form (FRAME-CONFIGURATION POSITION)
(defcustom register-separator nil
"Register containing the text to put between collected texts, or nil if none.
-When collecting text with
-`append-to-register' (resp. `prepend-to-register') contents of
-this register is added to the beginning (resp. end) of the marked
-text."
+When collecting text with \\[append-to-register] (or \\[prepend-to-register]),
+contents of this register is added to the beginning (or end, respectively)
+of the marked text."
:group 'register
:type '(choice (const :tag "None" nil)
(character :tag "Use register" :value ?+)))
+(defcustom register-preview-delay 1
+ "If non-nil, time to wait in seconds before popping up a preview window.
+If nil, do not show register previews, unless `help-char' (or a member of
+`help-event-list') is pressed."
+ :version "24.4"
+ :type '(choice number (const :tag "No preview unless requested" nil))
+ :group 'register)
+
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
- (cdr (assq register register-alist)))
+ (alist-get register register-alist))
(defun set-register (register value)
"Set contents of Emacs register named REGISTER to VALUE. Returns VALUE.
See the documentation of the variable `register-alist' for possible VALUEs."
- (let ((aelt (assq register register-alist)))
- (if aelt
- (setcdr aelt value)
- (push (cons register value) register-alist))
- value))
+ (setf (alist-get register register-alist) value))
+
+(defun register-describe-oneline (c)
+ "One-line description of register C."
+ (let ((d (replace-regexp-in-string
+ "\n[ \t]*" " "
+ (with-output-to-string (describe-register-1 c)))))
+ (if (string-match "Register.+? contains \\(?:an? \\|the \\)?" d)
+ (substring d (match-end 0))
+ d)))
+
+(defun register-preview-default (r)
+ "Default function for the variable `register-preview-function'."
+ (format "%s: %s\n"
+ (single-key-description (car r))
+ (register-describe-oneline (car r))))
+
+(defvar register-preview-function #'register-preview-default
+ "Function to format a register for previewing.
+Takes one argument, a cons (NAME . CONTENTS) as found in `register-alist'.
+Returns a string.")
+
+(defun register-preview (buffer &optional show-empty)
+ "Pop up a window to show register preview in BUFFER.
+If SHOW-EMPTY is non-nil show the window even if no registers.
+Format of each entry is controlled by the variable `register-preview-function'."
+ (when (or show-empty (consp register-alist))
+ (with-current-buffer-window
+ buffer
+ (cons 'display-buffer-below-selected
+ '((window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))))
+ nil
+ (with-current-buffer standard-output
+ (setq cursor-in-non-selected-windows nil)
+ (insert (mapconcat register-preview-function register-alist ""))))))
+
+(defun register-read-with-preview (prompt)
+ "Read and return a register name, possibly showing existing registers.
+Prompt with the string PROMPT. If `register-alist' and
+`register-preview-delay' are both non-nil, display a window
+listing existing registers after `register-preview-delay' seconds.
+If `help-char' (or a member of `help-event-list') is pressed,
+display such a window regardless."
+ (let* ((buffer "*Register Preview*")
+ (timer (when (numberp register-preview-delay)
+ (run-with-timer register-preview-delay nil
+ (lambda ()
+ (unless (get-buffer-window buffer)
+ (register-preview buffer))))))
+ (help-chars (cl-loop for c in (cons help-char help-event-list)
+ when (not (get-register c))
+ collect c)))
+ (unwind-protect
+ (progn
+ (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt))
+ help-chars)
+ (unless (get-buffer-window buffer)
+ (register-preview buffer 'show-empty)))
+ (if (characterp last-input-event) last-input-event
+ (error "Non-character input-event")))
+ (and (timerp timer) (cancel-timer timer))
+ (let ((w (get-buffer-window buffer)))
+ (and (window-live-p w) (delete-window w)))
+ (and (get-buffer buffer) (kill-buffer buffer)))))
(defun point-to-register (register &optional arg)
"Store current location of point in register REGISTER.
With prefix argument, store current frame configuration.
Use \\[jump-to-register] to go to that location or restore that configuration.
-Argument is a character, naming the register."
- (interactive "cPoint to register: \nP")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Point to register: ")
+ current-prefix-arg))
;; Turn the marker into a file-ref if the buffer is killed.
(add-hook 'kill-buffer-hook 'register-swap-out nil t)
(set-register register
@@ -117,21 +189,39 @@ Argument is a character, naming the register."
(defun window-configuration-to-register (register &optional _arg)
"Store the window configuration of the selected frame in register REGISTER.
Use \\[jump-to-register] to restore the configuration.
-Argument is a character, naming the register."
- (interactive "cWindow configuration to register: \nP")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview
+ "Window configuration to register: ")
+ current-prefix-arg))
;; current-window-configuration does not include the value
;; of point in the current buffer, so record that separately.
(set-register register (list (current-window-configuration) (point-marker))))
+;; It has had the optional arg for ages, but never used it.
+(set-advertised-calling-convention 'window-configuration-to-register
+ '(register) "24.4")
+
(defun frame-configuration-to-register (register &optional _arg)
"Store the window configuration of all frames in register REGISTER.
Use \\[jump-to-register] to restore the configuration.
-Argument is a character, naming the register."
- (interactive "cFrame configuration to register: \nP")
+Argument is a character, naming the register.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview
+ "Frame configuration to register: ")
+ current-prefix-arg))
;; current-frame-configuration does not include the value
;; of point in the current buffer, so record that separately.
(set-register register (list (current-frame-configuration) (point-marker))))
+;; It has had the optional arg for ages, but never used it.
+(set-advertised-calling-convention 'frame-configuration-to-register
+ '(register) "24.4")
+
+(make-obsolete 'frame-configuration-to-register 'frameset-to-register "24.4")
+
(defalias 'register-to-point 'jump-to-register)
(defun jump-to-register (register &optional delete)
"Move point to location stored in a register.
@@ -142,8 +232,11 @@ If the register contains a window configuration (one frame) or a frameset
First argument is a character, naming the register.
Optional second arg non-nil (interactively, prefix argument) says to
delete any existing frames that the frameset doesn't mention.
-\(Otherwise, these frames are iconified.)"
- (interactive "cJump to register: \nP")
+\(Otherwise, these frames are iconified.)
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Jump to register: ")
+ current-prefix-arg))
(let ((val (get-register register)))
(cond
((registerv-p val)
@@ -159,19 +252,22 @@ delete any existing frames that the frameset doesn't mention.
(goto-char (cadr val)))
((markerp val)
(or (marker-buffer val)
- (error "That register's buffer no longer exists"))
+ (user-error "That register's buffer no longer exists"))
(switch-to-buffer (marker-buffer val))
+ (unless (or (= (point) (marker-position val))
+ (eq last-command 'jump-to-register))
+ (push-mark))
(goto-char val))
((and (consp val) (eq (car val) 'file))
(find-file (cdr val)))
((and (consp val) (eq (car val) 'file-query))
(or (find-buffer-visiting (nth 1 val))
(y-or-n-p (format "Visit file %s again? " (nth 1 val)))
- (error "Register access aborted"))
+ (user-error "Register access aborted"))
(find-file (nth 1 val))
(goto-char (nth 2 val)))
(t
- (error "Register doesn't contain a buffer position or configuration")))))
+ (user-error "Register doesn't contain a buffer position or configuration")))))
(defun register-swap-out ()
"Turn markers into file-query references when a buffer is killed."
@@ -189,8 +285,11 @@ delete any existing frames that the frameset doesn't mention.
Two args, NUMBER and REGISTER (a character, naming the register).
If NUMBER is nil, a decimal number is read from the buffer starting
at point, and point moves to the end of that number.
-Interactively, NUMBER is the prefix arg (none means nil)."
- (interactive "P\ncNumber to register: ")
+Interactively, NUMBER is the prefix arg (none means nil).
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list current-prefix-arg
+ (register-read-with-preview "Number to register: ")))
(set-register register
(if number
(prefix-numeric-value number)
@@ -208,8 +307,11 @@ If REGISTER contains a number, add `prefix-numeric-value' of
PREFIX to it.
If REGISTER is empty or if it contains text, call
-`append-to-register' with `delete-flag' set to PREFIX."
- (interactive "P\ncIncrement register: ")
+`append-to-register' with `delete-flag' set to PREFIX.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list current-prefix-arg
+ (register-read-with-preview "Increment register: ")))
(let ((register-val (get-register register)))
(cond
((numberp register-val)
@@ -217,12 +319,14 @@ If REGISTER is empty or if it contains text, call
(set-register register (+ number register-val))))
((or (not register-val) (stringp register-val))
(append-to-register register (region-beginning) (region-end) prefix))
- (t (error "Register does not contain a number or text")))))
+ (t (user-error "Register does not contain a number or text")))))
(defun view-register (register)
"Display what is contained in register named REGISTER.
-The Lisp value REGISTER is a character."
- (interactive "cView register: ")
+The Lisp value REGISTER is a character.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "View register: ")))
(let ((val (get-register register)))
(if (null val)
(message "Register %s is empty" (single-key-description register))
@@ -294,6 +398,7 @@ The Lisp value REGISTER is a character."
(princ (car val))))
((stringp val)
+ (setq val (copy-sequence val))
(if (eq yank-excluded-properties t)
(set-text-properties 0 (length val) nil val)
(remove-list-of-text-properties 0 (length val)
@@ -322,8 +427,14 @@ The Lisp value REGISTER is a character."
"Insert contents of register REGISTER. (REGISTER is a character.)
Normally puts point before and mark after the inserted text.
If optional second arg is non-nil, puts mark before and point after.
-Interactively, second arg is non-nil if prefix arg is supplied."
- (interactive "*cInsert register: \nP")
+Interactively, second arg is nil if prefix arg is supplied and t
+otherwise.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (register-read-with-preview "Insert register: ")
+ (not current-prefix-arg))))
(push-mark)
(let ((val (get-register register)))
(cond
@@ -341,19 +452,29 @@ Interactively, second arg is non-nil if prefix arg is supplied."
((and (markerp val) (marker-position val))
(princ (marker-position val) (current-buffer)))
(t
- (error "Register does not contain text"))))
+ (user-error "Register does not contain text"))))
(if (not arg) (exchange-point-and-mark)))
-(defun copy-to-register (register start end &optional delete-flag)
+(defun copy-to-register (register start end &optional delete-flag region)
"Copy region into register REGISTER.
With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to copy."
- (interactive "cCopy to register: \nr\nP")
- (set-register register (filter-buffer-substring start end))
+Called from program, takes five args: REGISTER, START, END, DELETE-FLAG,
+and REGION. START and END are buffer positions indicating what to copy.
+The optional argument REGION if non-nil, indicates that we're not just
+copying some text between START and END, but we're copying the region.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Copy to register: ")
+ (region-beginning)
+ (region-end)
+ current-prefix-arg
+ t))
+ (set-register register (if region
+ (funcall region-extract-function delete-flag)
+ (prog1 (filter-buffer-substring start end)
+ (if delete-flag (delete-region start end)))))
(setq deactivate-mark t)
- (cond (delete-flag
- (delete-region start end))
+ (cond (delete-flag)
((called-interactively-p 'interactive)
(indicate-copied-region))))
@@ -361,15 +482,20 @@ START and END are buffer positions indicating what to copy."
"Append region to text in register REGISTER.
With prefix arg, delete as well.
Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to append."
- (interactive "cAppend to register: \nr\nP")
+START and END are buffer positions indicating what to append.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Append to register: ")
+ (region-beginning)
+ (region-end)
+ current-prefix-arg))
(let ((reg (get-register register))
(text (filter-buffer-substring start end))
(separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
((stringp reg) (concat reg separator text))
- (t (error "Register does not contain text")))))
+ (t (user-error "Register does not contain text")))))
(setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
@@ -380,15 +506,20 @@ START and END are buffer positions indicating what to append."
"Prepend region to text in register REGISTER.
With prefix arg, delete as well.
Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to prepend."
- (interactive "cPrepend to register: \nr\nP")
+START and END are buffer positions indicating what to prepend.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Prepend to register: ")
+ (region-beginning)
+ (region-end)
+ current-prefix-arg))
(let ((reg (get-register register))
(text (filter-buffer-substring start end))
(separator (and register-separator (get-register register-separator))))
(set-register
register (cond ((not reg) text)
((stringp reg) (concat text separator reg))
- (t (error "Register does not contain text")))))
+ (t (user-error "Register does not contain text")))))
(setq deactivate-mark t)
(cond (delete-flag
(delete-region start end))
@@ -401,8 +532,14 @@ With prefix arg, delete as well.
To insert this register in the buffer, use \\[insert-register].
Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions giving two corners of rectangle."
- (interactive "cCopy rectangle to register: \nr\nP")
+START and END are buffer positions giving two corners of rectangle.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview
+ "Copy rectangle to register: ")
+ (region-beginning)
+ (region-end)
+ current-prefix-arg))
(let ((rectangle (if delete-flag
(delete-extract-rectangle start end)
(extract-rectangle start end))))
@@ -412,6 +549,5 @@ START and END are buffer positions giving two corners of rectangle."
(setq deactivate-mark t)
(indicate-copied-region (length (car rectangle))))))
-
(provide 'register)
;;; register.el ends here
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 01defa66695..80692dfa18b 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -1,6 +1,6 @@
;;; repeat.el --- convenient way to repeat the previous command -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Will Mengarini <seldon@eskimo.com>
;; Created: Mo 02 Mar 98
@@ -109,9 +109,11 @@
(defvar repeat-message-function nil
"If non-nil, function used by `repeat' command to say what it's doing.
Message is something like \"Repeating command glorp\".
-To disable such messages, set this variable to `ignore'. To customize
-display, assign a function that takes one string as an arg and displays
-it however you want.")
+A value of `ignore' will disable such messages. To customize
+display, assign a function that takes one string as an arg and
+displays it however you want.
+If this variable is nil, the normal `message' function will be
+used to display the messages.")
(defcustom repeat-on-final-keystroke t
"Allow `repeat' to re-execute for repeating lastchar of a key sequence.
@@ -278,7 +280,7 @@ recently executed command not bound to an input event\"."
(execute-kbd-macro last-repeatable-command))
(call-interactively last-repeatable-command))))
(when repeat-repeat-char
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map (vector repeat-repeat-char)
(if (null repeat-message-function) 'repeat
diff --git a/lisp/replace.el b/lisp/replace.el
index 5e44677b0f8..d6590c5516a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1,9 +1,9 @@
;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2013 Free
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2015 Free
;; Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
@@ -33,6 +33,14 @@
:type 'boolean
:group 'matching)
+(defcustom replace-character-fold nil
+ "Non-nil means `query-replace' should do character folding in matches.
+This means, for instance, that \\=' will match a large variety of
+unicode quotes."
+ :type 'boolean
+ :group 'matching
+ :version "25.1")
+
(defcustom replace-lax-whitespace nil
"Non-nil means `query-replace' matches a sequence of whitespace chars.
When you enter a space or spaces in the strings to be replaced,
@@ -56,8 +64,8 @@ See `query-replace-from-history-variable' and
(defvar query-replace-defaults nil
"Default values of FROM-STRING and TO-STRING for `query-replace'.
-This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
-no default value.")
+This is a list of cons cells (FROM-STRING . TO-STRING), or nil
+if there are no default values.")
(defvar query-replace-interactive nil
"Non-nil means `query-replace' uses the last search string.
@@ -67,6 +75,17 @@ That becomes the \"string to replace\".")
to the minibuffer that reads the string to replace, or invoke replacements
from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
+(defcustom query-replace-from-to-separator
+ (propertize (if (char-displayable-p ?→) " → " " -> ")
+ 'face 'minibuffer-prompt)
+ "String that separates FROM and TO in the history of replacement pairs."
+ ;; Avoids error when attempt to autoload char-displayable-p fails
+ ;; while preparing to dump, also stops customize-rogue listing this.
+ :initialize 'custom-initialize-delay
+ :group 'matching
+ :type 'sexp
+ :version "25.1")
+
(defcustom query-replace-from-history-variable 'query-replace-history
"History list to use for the FROM argument of `query-replace' commands.
The value of this variable should be a symbol; that symbol
@@ -125,18 +144,46 @@ See `replace-regexp' and `query-replace-regexp-eval'.")
(defun query-replace-descr (string)
(mapconcat 'isearch-text-char-description string ""))
+(defun query-replace--split-string (string)
+ "Split string STRING at a character with property `separator'"
+ (let* ((length (length string))
+ (split-pos (text-property-any 0 length 'separator t string)))
+ (if (not split-pos)
+ (substring-no-properties string)
+ (cl-assert (not (text-property-any (1+ split-pos) length 'separator t string)))
+ (cons (substring-no-properties string 0 split-pos)
+ (substring-no-properties string (1+ split-pos) length)))))
+
(defun query-replace-read-from (prompt regexp-flag)
"Query and return the `from' argument of a query-replace operation.
The return value can also be a pair (FROM . TO) indicating that the user
wants to replace FROM with TO."
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
+ ;; Reevaluating will check char-displayable-p that is
+ ;; unavailable while preparing to dump.
+ (custom-reevaluate-setting 'query-replace-from-to-separator)
(let* ((history-add-new-input nil)
+ (text-property-default-nonsticky
+ (cons '(separator . t) text-property-default-nonsticky))
+ (separator
+ (when query-replace-from-to-separator
+ (propertize "\0"
+ 'display query-replace-from-to-separator
+ 'separator t)))
+ (query-replace-from-to-history
+ (append
+ (when separator
+ (mapcar (lambda (from-to)
+ (concat (query-replace-descr (car from-to))
+ separator
+ (query-replace-descr (cdr from-to))))
+ query-replace-defaults))
+ (symbol-value query-replace-from-history-variable)))
+ (minibuffer-allow-text-properties t) ; separator uses text-properties
(prompt
- (if query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (car query-replace-defaults))
- (query-replace-descr (cdr query-replace-defaults)))
+ (if (and query-replace-defaults separator)
+ (format "%s (default %s): " prompt (car query-replace-from-to-history))
(format "%s: " prompt)))
(from
;; The save-excursion here is in case the user marks and copies
@@ -144,26 +191,33 @@ wants to replace FROM with TO."
;; That should not clobber the region for the query-replace itself.
(save-excursion
(if regexp-flag
- (read-regexp prompt nil query-replace-from-history-variable)
+ (read-regexp prompt nil 'query-replace-from-to-history)
(read-from-minibuffer
- prompt nil nil nil query-replace-from-history-variable
- (car (if regexp-flag regexp-search-ring search-ring)) t)))))
+ prompt nil nil nil 'query-replace-from-to-history
+ (car (if regexp-flag regexp-search-ring search-ring)) t))))
+ (to))
(if (and (zerop (length from)) query-replace-defaults)
- (cons (car query-replace-defaults)
+ (cons (caar query-replace-defaults)
(query-replace-compile-replacement
- (cdr query-replace-defaults) regexp-flag))
- (add-to-history query-replace-from-history-variable from nil t)
- ;; Warn if user types \n or \t, but don't reject the input.
- (and regexp-flag
- (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
- (let ((match (match-string 3 from)))
- (cond
- ((string= match "\\n")
- (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
- ((string= match "\\t")
- (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
- (sit-for 2)))
- from))))
+ (cdar query-replace-defaults) regexp-flag))
+ (setq from (query-replace--split-string from))
+ (when (consp from) (setq to (cdr from) from (car from)))
+ (add-to-history query-replace-from-history-variable from nil t)
+ ;; Warn if user types \n or \t, but don't reject the input.
+ (and regexp-flag
+ (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
+ (let ((match (match-string 3 from)))
+ (cond
+ ((string= match "\\n")
+ (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
+ ((string= match "\\t")
+ (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
+ (sit-for 2)))
+ (if (not to)
+ from
+ (add-to-history query-replace-to-history-variable to nil t)
+ (add-to-history 'query-replace-defaults (cons from to) nil t)
+ (cons from (query-replace-compile-replacement to regexp-flag)))))))
(defun query-replace-compile-replacement (to regexp-flag)
"Maybe convert a regexp replacement TO to Lisp.
@@ -216,7 +270,7 @@ the original string if not."
nil nil nil
query-replace-to-history-variable from t)))
(add-to-history query-replace-to-history-variable to nil t)
- (setq query-replace-defaults (cons from to))
+ (add-to-history 'query-replace-defaults (cons from to) nil t)
to))
regexp-flag))
@@ -226,9 +280,11 @@ the original string if not."
(let* ((from (query-replace-read-from prompt regexp-flag))
(to (if (consp from) (prog1 (cdr from) (setq from (car from)))
(query-replace-read-to from prompt regexp-flag))))
- (list from to current-prefix-arg)))
+ (list from to
+ (and current-prefix-arg (not (eq current-prefix-arg '-)))
+ (and current-prefix-arg (eq current-prefix-arg '-)))))
-(defun query-replace (from-string to-string &optional delimited start end)
+(defun query-replace (from-string to-string &optional delimited start end backward)
"Replace some occurrences of FROM-STRING with TO-STRING.
As each match is found, the user must type a character saying
what to do with it. For directions, type \\[help-command] at that time.
@@ -259,15 +315,19 @@ to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
+only matches surrounded by word boundaries. A negative prefix arg means
+replace backward.
+
Fourth and fifth arg START and END specify the region to operate on.
-To customize possible responses, change the \"bindings\" in `query-replace-map'."
+To customize possible responses, change the bindings in `query-replace-map'."
(interactive
(let ((common
(query-replace-read-args
(concat "Query replace"
- (if current-prefix-arg " word" "")
+ (if current-prefix-arg
+ (if (eq current-prefix-arg '-) " backward" " word")
+ "")
(if (and transient-mark-mode mark-active) " in region" ""))
nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
@@ -277,12 +337,13 @@ To customize possible responses, change the \"bindings\" in `query-replace-map'.
(if (and transient-mark-mode mark-active)
(region-beginning))
(if (and transient-mark-mode mark-active)
- (region-end)))))
- (perform-replace from-string to-string t nil delimited nil nil start end))
+ (region-end))
+ (nth 3 common))))
+ (perform-replace from-string to-string t nil delimited nil nil start end backward))
(define-key esc-map "%" 'query-replace)
-(defun query-replace-regexp (regexp to-string &optional delimited start end)
+(defun query-replace-regexp (regexp to-string &optional delimited start end backward)
"Replace some things after point matching REGEXP with TO-STRING.
As each match is found, the user must type a character saying
what to do with it. For directions, type \\[help-command] at that time.
@@ -313,7 +374,9 @@ to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
+only matches surrounded by word boundaries. A negative prefix arg means
+replace backward.
+
Fourth and fifth arg START and END specify the region to operate on.
In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
@@ -341,7 +404,9 @@ Use \\[repeat-complex-command] after this command for details."
(let ((common
(query-replace-read-args
(concat "Query replace"
- (if current-prefix-arg " word" "")
+ (if current-prefix-arg
+ (if (eq current-prefix-arg '-) " backward" " word")
+ "")
" regexp"
(if (and transient-mark-mode mark-active) " in region" ""))
t)))
@@ -352,8 +417,9 @@ Use \\[repeat-complex-command] after this command for details."
(if (and transient-mark-mode mark-active)
(region-beginning))
(if (and transient-mark-mode mark-active)
- (region-end)))))
- (perform-replace regexp to-string t t delimited nil nil start end))
+ (region-end))
+ (nth 3 common))))
+ (perform-replace regexp to-string t t delimited nil nil start end backward))
(define-key esc-map [?\C-%] 'query-replace-regexp)
@@ -409,7 +475,7 @@ for Lisp calls." "22.1"))
;; Let-bind the history var to disable the "foo -> bar"
;; default. Maybe we shouldn't disable this default, but
;; for now I'll leave it off. --Stef
- (let ((query-replace-to-history-variable nil))
+ (let ((query-replace-defaults nil))
(query-replace-read-from "Query replace regexp" t)))
(to (list (read-from-minibuffer
(format "Query replace regexp %s with eval: "
@@ -438,6 +504,7 @@ of the region. Otherwise, operate from point to the end of the buffer.
Non-interactively, TO-STRINGS may be a list of replacement strings.
+Interactively, reads the regexp using `read-regexp'.
Use \\<minibuffer-local-map>\\[next-history-element] \
to pull the last incremental search regexp to the minibuffer
that reads REGEXP.
@@ -475,7 +542,7 @@ Fourth and fifth arg START and END specify the region to operate on."
to-strings ""))))
(perform-replace regexp replacements t t nil n nil start end)))
-(defun replace-string (from-string to-string &optional delimited start end)
+(defun replace-string (from-string to-string &optional delimited start end backward)
"Replace occurrences of FROM-STRING with TO-STRING.
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and FROM-STRING has no uppercase letters.
@@ -490,12 +557,14 @@ If `replace-lax-whitespace' is non-nil, a space or spaces in the string
to be replaced will match a sequence of whitespace chars defined by the
regexp in `search-whitespace-regexp'.
-In Transient Mark mode, if the mark is active, operate on the contents
-of the region. Otherwise, operate from point to the end of the buffer.
-
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
-Fourth and fifth arg START and END specify the region to operate on.
+only matches surrounded by word boundaries. A negative prefix arg means
+replace backward.
+
+Operates on the region between START and END (if both are nil, from point
+to the end of the buffer). Interactively, if Transient Mark mode is
+enabled and the mark is active, operates on the contents of the region;
+otherwise from point to the end of the buffer.
Use \\<minibuffer-local-map>\\[next-history-element] \
to pull the last incremental search string to the minibuffer
@@ -508,11 +577,15 @@ What you probably want is a loop like this:
which will run faster and will not set the mark or print anything.
\(You may need a more complex loop if FROM-STRING can match the null string
and TO-STRING is also null.)"
+ (declare (interactive-only
+ "use `search-forward' and `replace-match' instead."))
(interactive
(let ((common
(query-replace-read-args
(concat "Replace"
- (if current-prefix-arg " word" "")
+ (if current-prefix-arg
+ (if (eq current-prefix-arg '-) " backward" " word")
+ "")
" string"
(if (and transient-mark-mode mark-active) " in region" ""))
nil)))
@@ -520,10 +593,11 @@ and TO-STRING is also null.)"
(if (and transient-mark-mode mark-active)
(region-beginning))
(if (and transient-mark-mode mark-active)
- (region-end)))))
- (perform-replace from-string to-string nil nil delimited nil nil start end))
+ (region-end))
+ (nth 3 common))))
+ (perform-replace from-string to-string nil nil delimited nil nil start end backward))
-(defun replace-regexp (regexp to-string &optional delimited start end)
+(defun replace-regexp (regexp to-string &optional delimited start end backward)
"Replace things after point matching REGEXP with TO-STRING.
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
@@ -540,7 +614,9 @@ In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
+only matches surrounded by word boundaries. A negative prefix arg means
+replace backward.
+
Fourth and fifth arg START and END specify the region to operate on.
In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
@@ -575,11 +651,15 @@ What you probably want is a loop like this:
(while (re-search-forward REGEXP nil t)
(replace-match TO-STRING nil nil))
which will run faster and will not set the mark or print anything."
+ (declare (interactive-only
+ "use `re-search-forward' and `replace-match' instead."))
(interactive
(let ((common
(query-replace-read-args
(concat "Replace"
- (if current-prefix-arg " word" "")
+ (if current-prefix-arg
+ (if (eq current-prefix-arg '-) " backward" " word")
+ "")
" regexp"
(if (and transient-mark-mode mark-active) " in region" ""))
t)))
@@ -587,8 +667,9 @@ which will run faster and will not set the mark or print anything."
(if (and transient-mark-mode mark-active)
(region-beginning))
(if (and transient-mark-mode mark-active)
- (region-end)))))
- (perform-replace regexp to-string nil t delimited nil nil start end))
+ (region-end))
+ (nth 3 common))))
+ (perform-replace regexp to-string nil t delimited nil nil start end backward))
(defvar regexp-history nil
@@ -600,40 +681,93 @@ of `history-length', which see.")
(defvar occur-collect-regexp-history '("\\1")
"History of regexp for occur's collect operation")
+(defcustom read-regexp-defaults-function nil
+ "Function that provides default regexp(s) for `read-regexp'.
+This function should take no arguments and return one of: nil, a
+regexp, or a list of regexps. Interactively, `read-regexp' uses
+the return value of this function for its DEFAULT argument.
+
+As an example, set this variable to `find-tag-default-as-regexp'
+to default to the symbol at point.
+
+To provide different default regexps for different commands,
+the function that you set this to can check `this-command'."
+ :type '(choice
+ (const :tag "No default regexp reading function" nil)
+ (const :tag "Latest regexp history" regexp-history-last)
+ (function-item :tag "Tag at point"
+ find-tag-default)
+ (function-item :tag "Tag at point as regexp"
+ find-tag-default-as-regexp)
+ (function-item :tag "Tag at point as symbol regexp"
+ find-tag-default-as-symbol-regexp)
+ (function :tag "Your choice of function"))
+ :group 'matching
+ :version "24.4")
+
+(defun read-regexp-suggestions ()
+ "Return a list of standard suggestions for `read-regexp'.
+By default, the list includes the tag at point, the last isearch regexp,
+the last isearch string, and the last replacement regexp. `read-regexp'
+appends the list returned by this function to the end of values available
+via \\<minibuffer-local-map>\\[next-history-element]."
+ (list
+ (find-tag-default-as-regexp)
+ (find-tag-default-as-symbol-regexp)
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value query-replace-from-history-variable))))
+
(defun read-regexp (prompt &optional defaults history)
"Read and return a regular expression as a string.
-When PROMPT doesn't end with a colon and space, it adds a final \": \".
-If the first element of DEFAULTS is non-nil, it's added to the prompt.
-
-Optional arg DEFAULTS has the form (DEFAULT . SUGGESTIONS)
-or simply DEFAULT where DEFAULT, if non-nil, should be a string that
-is returned as the default value when the user enters empty input.
-SUGGESTIONS is a list of strings that can be inserted into
-the minibuffer using \\<minibuffer-local-map>\\[next-history-element]. \
-The values supplied in SUGGESTIONS
-are prepended to the list of standard suggestions that include
-the tag at point, the last isearch regexp, the last isearch string,
-and the last replacement regexp.
-
-Optional arg HISTORY is a symbol to use for the history list.
-If HISTORY is nil, `regexp-history' is used."
- (let* ((default (if (consp defaults) (car defaults) defaults))
+Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by
+optional whitespace), use it as-is. Otherwise, add \": \" to the end,
+possibly preceded by the default result (see below).
+
+The optional argument DEFAULTS can be either: nil, a string, a list
+of strings, or a symbol. We use DEFAULTS to construct the default
+return value in case of empty input.
+
+If DEFAULTS is a string, we use it as-is.
+
+If DEFAULTS is a list of strings, the first element is the
+default return value, but all the elements are accessible
+using the history command \\<minibuffer-local-map>\\[next-history-element].
+
+If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function'
+is non-nil, we use that in place of DEFAULTS in the following:
+ If DEFAULTS is the symbol `regexp-history-last', we use the first
+ element of HISTORY (if specified) or `regexp-history'.
+ If DEFAULTS is a function, we call it with no arguments and use
+ what it returns, which should be either nil, a string, or a list of strings.
+
+We append the standard values from `read-regexp-suggestions' to DEFAULTS
+before using it.
+
+If the first element of DEFAULTS is non-nil (and if PROMPT does not end
+in \":\", followed by optional whitespace), we add it to the prompt.
+
+The optional argument HISTORY is a symbol to use for the history list.
+If nil, uses `regexp-history'."
+ (let* ((defaults
+ (if (and defaults (symbolp defaults))
+ (cond
+ ((eq (or read-regexp-defaults-function defaults)
+ 'regexp-history-last)
+ (car (symbol-value (or history 'regexp-history))))
+ ((functionp (or read-regexp-defaults-function defaults))
+ (funcall (or read-regexp-defaults-function defaults))))
+ defaults))
+ (default (if (consp defaults) (car defaults) defaults))
(suggestions (if (listp defaults) defaults (list defaults)))
- (suggestions
- (append
- suggestions
- (list
- (find-tag-default-as-regexp)
- (car regexp-search-ring)
- (regexp-quote (or (car search-ring) ""))
- (car (symbol-value query-replace-from-history-variable)))))
+ (suggestions (append suggestions (read-regexp-suggestions)))
(suggestions (delete-dups (delq nil (delete "" suggestions))))
;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
(input (read-from-minibuffer
(cond ((string-match-p ":[ \t]*\\'" prompt)
prompt)
- (default
+ ((and default (> (length default) 0))
(format "%s (default %s): " prompt
(query-replace-descr default)))
(t
@@ -641,7 +775,9 @@ If HISTORY is nil, `regexp-history' is used."
nil nil nil (or history 'regexp-history) suggestions t)))
(if (equal input "")
;; Return the default value when the user enters empty input.
- (or default input)
+ (prog1 (or default input)
+ (when default
+ (add-to-history (or history 'regexp-history) default)))
;; Otherwise, add non-empty input to the history and return input.
(prog1 input
(add-to-history (or history 'regexp-history) input)))))
@@ -809,9 +945,12 @@ a previously found match."
(keep-lines-read-args "How many matches for regexp"))
(save-excursion
(if rstart
- (progn
- (goto-char (min rstart rend))
- (setq rend (max rstart rend)))
+ (if rend
+ (progn
+ (goto-char (min rstart rend))
+ (setq rend (max rstart rend)))
+ (goto-char rstart)
+ (setq rend (point-max)))
(if (and interactive transient-mark-mode mark-active)
(setq rstart (region-beginning)
rend (region-end))
@@ -1163,32 +1302,12 @@ which means to discard all text properties."
:group 'matching
:version "22.1")
-(defvar occur-read-regexp-defaults-function
- 'occur-read-regexp-defaults
- "Function that provides default regexp(s) for occur commands.
-This function should take no arguments and return one of nil, a
-regexp or a list of regexps for use with occur commands -
-`occur', `multi-occur' and `multi-occur-in-matching-buffers'.
-The return value of this function is used as DEFAULTS param of
-`read-regexp' while executing the occur command. This function
-is called only during interactive use.
-
-For example, to check for occurrence of symbol at point use
-
- (setq occur-read-regexp-defaults-function
- 'find-tag-default-as-regexp).")
-
-(defun occur-read-regexp-defaults ()
- "Return the latest regexp from `regexp-history'.
-See `occur-read-regexp-defaults-function' for details."
- (car regexp-history))
-
(defun occur-read-primary-args ()
(let* ((perform-collect (consp current-prefix-arg))
(regexp (read-regexp (if perform-collect
"Collect strings matching regexp"
"List lines matching regexp")
- (funcall occur-read-regexp-defaults-function))))
+ 'regexp-history-last)))
(list regexp
(if perform-collect
;; Perform collect operation
@@ -1266,7 +1385,7 @@ See also `multi-occur-in-matching-buffers'."
(ido-ignore-item-temp-list bufs))
(while (not (string-equal
(setq buf (read-buffer
- (if (eq read-buffer-function 'ido-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))
@@ -1376,7 +1495,8 @@ See also `multi-occur'."
;; Don't display regexp if with remaining text
;; it is longer than window-width.
(if (> (+ (length regexp) 42) (window-width))
- "" (format " for `%s'" (query-replace-descr regexp)))))
+ "" (format-message
+ " for `%s'" (query-replace-descr regexp)))))
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)
@@ -1442,14 +1562,15 @@ See also `multi-occur'."
(setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
- (append
- `(occur-match t)
- (when match-face
- ;; Use `face' rather than `font-lock-face' here
- ;; so as to override faces copied from the buffer.
- `(face ,match-face)))
- curstring)
- (setq start (match-end 0))))
+ '(occur-match t) curstring)
+ (when match-face
+ ;; Add `match-face' to faces copied from the buffer.
+ (add-face-text-property
+ (match-beginning 0) (match-end 0)
+ match-face nil curstring))
+ ;; Avoid infloop (Bug#7593).
+ (let ((end (match-end 0)))
+ (setq start (if (= start end) (1+ start) end)))))
;; Generate the string to insert for this match
(let* ((match-prefix
;; Using 7 digits aligns tabs properly.
@@ -1541,11 +1662,9 @@ See also `multi-occur'."
(buffer-name buf))
'read-only t))
(setq end (point))
- (add-text-properties beg end
- (append
- (when title-face
- `(font-lock-face ,title-face))
- `(occur-title ,buf))))
+ (add-text-properties beg end `(occur-title ,buf))
+ (when title-face
+ (add-face-text-property beg end title-face)))
(goto-char (point-min)))))))
;; Display total match count and regexp for multi-buffer.
(when (and (not (zerop global-lines)) (> (length buffers) 1))
@@ -1561,8 +1680,8 @@ See also `multi-occur'."
global-lines (if (= global-lines 1) "" "s")))
(query-replace-descr regexp)))
(setq end (point))
- (add-text-properties beg end (when title-face
- `(font-lock-face ,title-face))))
+ (when title-face
+ (add-face-text-property beg end title-face)))
(goto-char (point-min)))
(if coding
;; CODING is buffer-file-coding-system of the first buffer
@@ -1789,7 +1908,12 @@ type them using Lisp syntax."
(defun replace-eval-replacement (expression count)
(let* ((replace-count count)
- (replacement (eval expression)))
+ err
+ (replacement
+ (condition-case err
+ (eval expression)
+ (error
+ (error "Error evaluating replacement expression: %S" err)))))
(if (stringp replacement)
replacement
(prin1-to-string replacement t))))
@@ -1834,11 +1958,13 @@ but coerced to the correct value of INTEGERS."
new)))
(match-data integers reuse t)))
-(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
+(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data backward)
"Make a replacement with `replace-match', editing `\\?'.
-NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no
-check for `\\?' is made to save time. MATCH-DATA is used for the
-replacement. In case editing is done, it is changed to use markers.
+FIXEDCASE, LITERAL are passed to `replace-match' (which see).
+After possibly editing it (if `\\?' is present), NEWTEXT is also
+passed to `replace-match'. If NOEDIT is true, no check for `\\?'
+is made (to save time). MATCH-DATA is used for the replacement.
+In case editing is done, it is changed to use markers.
The return value is non-nil if there has been no `\\?' or NOEDIT was
passed in. If LITERAL is set, no checking is done, anyway."
@@ -1858,6 +1984,9 @@ passed in. If LITERAL is set, no checking is done, anyway."
noedit nil)))
(set-match-data match-data)
(replace-match newtext fixedcase literal)
+ ;; `replace-match' leaves point at the end of the replacement text,
+ ;; so move point to the beginning when replacing backward.
+ (when backward (goto-char (nth 0 match-data)))
noedit)
(defvar replace-search-function nil
@@ -1873,7 +2002,7 @@ It is called with three arguments, as if it were
`re-search-forward'.")
(defun replace-search (search-string limit regexp-flag delimited-flag
- case-fold-search)
+ case-fold-search backward)
"Search for the next occurrence of SEARCH-STRING to replace."
;; Let-bind global isearch-* variables to values used
;; to search the next replacement. These let-bindings
@@ -1884,7 +2013,10 @@ It is called with three arguments, as if it were
;; outside of this function because then another I-search
;; used after `recursive-edit' might override them.
(let* ((isearch-regexp regexp-flag)
- (isearch-word delimited-flag)
+ (isearch-regexp-function (or delimited-flag
+ (and replace-character-fold
+ (not regexp-flag)
+ #'character-fold-to-regexp)))
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
@@ -1892,7 +2024,7 @@ It is called with three arguments, as if it were
(isearch-case-fold-search case-fold-search)
(isearch-adjusted nil)
(isearch-nonincremental t) ; don't use lax word mode
- (isearch-forward t)
+ (isearch-forward (not backward))
(search-function
(or (if regexp-flag
replace-re-search-function
@@ -1904,7 +2036,7 @@ It is called with three arguments, as if it were
(defun replace-highlight (match-beg match-end range-beg range-end
search-string regexp-flag delimited-flag
- case-fold-search)
+ case-fold-search backward)
(if query-replace-highlight
(if replace-overlay
(move-overlay replace-overlay match-beg match-end (current-buffer))
@@ -1914,13 +2046,13 @@ It is called with three arguments, as if it were
(if query-replace-lazy-highlight
(let ((isearch-string search-string)
(isearch-regexp regexp-flag)
- (isearch-word delimited-flag)
+ (isearch-regexp-function delimited-flag)
(isearch-lax-whitespace
replace-lax-whitespace)
(isearch-regexp-lax-whitespace
replace-regexp-lax-whitespace)
(isearch-case-fold-search case-fold-search)
- (isearch-forward t)
+ (isearch-forward (not backward))
(isearch-other-end match-beg)
(isearch-error nil))
(isearch-lazy-highlight-new-loop range-beg range-end))))
@@ -1936,7 +2068,7 @@ It is called with three arguments, as if it were
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
- &optional repeat-count map start end)
+ &optional repeat-count map start end backward)
"Subroutine of `query-replace'. Its complexity handles interactive queries.
Don't use this in your own program unless you want to query and set the mark
just as `query-replace' does. Instead, write a simple loop like this:
@@ -1949,7 +2081,13 @@ see the documentation of `replace-match' to find out how to simulate
`case-replace'.
This function returns nil if and only if there were no matches to
-make, or the user didn't cancel the call."
+make, or the user didn't cancel the call.
+
+REPLACEMENTS is either a string, a list of strings, or a cons cell
+containing a function and its first argument. The function is
+called to generate each replacement like this:
+ (funcall (car replacements) (cdr replacements) replace-count)
+It must return a string."
(or map (setq map query-replace-map))
(and query-flag minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
@@ -1990,21 +2128,21 @@ make, or the user didn't cancel the call."
minibuffer-prompt-properties))))
;; If region is active, in Transient Mark mode, operate on region.
- (when start
- (setq limit (copy-marker (max start end)))
- (goto-char (min start end))
- (deactivate-mark))
+ (if backward
+ (when end
+ (setq limit (copy-marker (min start end)))
+ (goto-char (max start end))
+ (deactivate-mark))
+ (when start
+ (setq limit (copy-marker (max start end)))
+ (goto-char (min start end))
+ (deactivate-mark)))
;; If last typed key in previous call of multi-buffer perform-replace
;; was `automatic-all', don't ask more questions in next files
(when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
(setq query-flag nil multi-buffer t))
- ;; REPLACEMENTS is either a string, a list of strings, or a cons cell
- ;; containing a function and its first argument. The function is
- ;; called to generate each replacement like this:
- ;; (funcall (car replacements) (cdr replacements) replace-count)
- ;; It must return a string.
(cond
((stringp replacements)
(setq next-replacement replacements
@@ -2023,13 +2161,17 @@ make, or the user didn't cancel the call."
(unwind-protect
;; Loop finding occurrences that perhaps should be replaced.
(while (and keep-going
- (not (or (eobp) (and limit (>= (point) limit))))
+ (if backward
+ (not (or (bobp) (and limit (<= (point) limit))))
+ (not (or (eobp) (and limit (>= (point) limit)))))
;; Use the next match if it is already known;
;; otherwise, search for a match after moving forward
;; one char if progress is required.
(setq real-match-data
(cond ((consp match-again)
- (goto-char (nth 1 match-again))
+ (goto-char (if backward
+ (nth 0 match-again)
+ (nth 1 match-again)))
(replace-match-data
t real-match-data match-again))
;; MATCH-AGAIN non-nil means accept an
@@ -2038,22 +2180,26 @@ make, or the user didn't cancel the call."
(and
(replace-search search-string limit
regexp-flag delimited-flag
- case-fold-search)
+ case-fold-search backward)
;; For speed, use only integers and
;; reuse the list used last time.
(replace-match-data t real-match-data)))
- ((and (< (1+ (point)) (point-max))
+ ((and (if backward
+ (> (1- (point)) (point-min))
+ (< (1+ (point)) (point-max)))
(or (null limit)
- (< (1+ (point)) limit)))
+ (if backward
+ (> (1- (point)) limit)
+ (< (1+ (point)) limit))))
;; If not accepting adjacent matches,
;; move one char to the right before
;; searching again. Undo the motion
;; if the search fails.
(let ((opoint (point)))
- (forward-char 1)
+ (forward-char (if backward -1 1))
(if (replace-search search-string limit
regexp-flag delimited-flag
- case-fold-search)
+ case-fold-search backward)
(replace-match-data
t real-match-data)
(goto-char opoint)
@@ -2074,7 +2220,9 @@ make, or the user didn't cancel the call."
(setq match-again
(and nonempty-match
(or (not regexp-flag)
- (and (looking-at search-string)
+ (and (if backward
+ (looking-back search-string)
+ (looking-at search-string))
(let ((match (match-data)))
(and (/= (nth 0 match) (nth 1 match))
match))))))
@@ -2111,11 +2259,11 @@ make, or the user didn't cancel the call."
(replace-highlight
(nth 0 real-match-data) (nth 1 real-match-data)
start end search-string
- regexp-flag delimited-flag case-fold-search))
+ regexp-flag delimited-flag case-fold-search backward))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
- noedit real-match-data)
+ noedit real-match-data backward)
replace-count (1+ replace-count)))
(undo-boundary)
(let (done replaced key def)
@@ -2130,7 +2278,7 @@ make, or the user didn't cancel the call."
(replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
- regexp-flag delimited-flag case-fold-search)
+ regexp-flag delimited-flag case-fold-search backward)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
(let ((message-log-max nil)
@@ -2160,6 +2308,7 @@ make, or the user didn't cancel the call."
(get delimited-flag 'isearch-message-prefix))
"word ") "")
(if regexp-flag "regexp " "")
+ (if backward "backward " "")
from-string " with "
next-replacement ".\n\n"
(substitute-command-keys
@@ -2188,7 +2337,7 @@ make, or the user didn't cancel the call."
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
- noedit real-match-data)
+ noedit real-match-data backward)
replace-count (1+ replace-count)))
(setq done t replaced t))
((eq def 'act-and-exit)
@@ -2196,7 +2345,7 @@ make, or the user didn't cancel the call."
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
- noedit real-match-data)
+ noedit real-match-data backward)
replace-count (1+ replace-count)))
(setq keep-going nil)
(setq done t replaced t))
@@ -2205,7 +2354,7 @@ make, or the user didn't cancel the call."
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
- noedit real-match-data)
+ noedit real-match-data backward)
replace-count (1+ replace-count)
real-match-data (replace-match-data
t real-match-data)
@@ -2215,7 +2364,7 @@ make, or the user didn't cancel the call."
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
- noedit real-match-data)
+ noedit real-match-data backward)
replace-count (1+ replace-count)))
(setq done t query-flag nil replaced t)
(if (eq def 'automatic-all) (setq multi-buffer t)))
@@ -2259,7 +2408,7 @@ make, or the user didn't cancel the call."
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal noedit
- real-match-data)
+ real-match-data backward)
replaced t))
(setq done t))
diff --git a/lisp/reposition.el b/lisp/reposition.el
index c67200f9550..feb207b08c0 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -1,10 +1,10 @@
;;; reposition.el --- center a Lisp function or comment on the screen
-;; Copyright (C) 1991, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Michael D. Ernst <mernst@theory.lcs.mit.edu>
;; Created: Jan 1991
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 92c1178041c..b71df964aec 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -1,6 +1,6 @@
;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: outlines
@@ -72,27 +72,27 @@ Each element has the form (WINDOW . OVERLAY).")
;; - we only refresh spots in the current window.
;; FIXME: do we actually know that (current-buffer) = (window-buffer) ?
(with-local-quit
- (condition-case err
- (let ((old-ols
- (delq nil
- (mapcar
- (lambda (x)
- ;; We refresh any spot in the current window as well
- ;; as any spots associated with a dead window or
- ;; a window which does not show this buffer any more.
- (cond
- ((eq (car x) (selected-window)) (cdr x))
- ((not (and (window-live-p (car x))
- (eq (window-buffer (car x)) (current-buffer))))
- ;; Adopt this since it's owned by a window that's
- ;; either not live or at least not showing this
- ;; buffer any more.
- (setcar x (selected-window))
- (cdr x))))
- reveal-open-spots))))
- (setq old-ols (reveal-open-new-overlays old-ols))
- (reveal-close-old-overlays old-ols))
- (error (message "Reveal: %s" err)))))
+ (with-demoted-errors "Reveal: %s"
+ (let ((old-ols
+ (delq nil
+ (mapcar
+ (lambda (x)
+ ;; We refresh any spot in the current window as well
+ ;; as any spots associated with a dead window or
+ ;; a window which does not show this buffer any more.
+ (cond
+ ((eq (car x) (selected-window)) (cdr x))
+ ((not (and (window-live-p (car x))
+ (eq (window-buffer (car x))
+ (current-buffer))))
+ ;; Adopt this since it's owned by a window that's
+ ;; either not live or at least not showing this
+ ;; buffer any more.
+ (setcar x (selected-window))
+ (cdr x))))
+ reveal-open-spots))))
+ (setq old-ols (reveal-open-new-overlays old-ols))
+ (reveal-close-old-overlays old-ols)))))
(defun reveal-open-new-overlays (old-ols)
(let ((repeat t))
@@ -136,8 +136,9 @@ Each element has the form (WINDOW . OVERLAY).")
old-ols)
(defun reveal-close-old-overlays (old-ols)
- (if (not (eq reveal-last-tick
- (setq reveal-last-tick (buffer-modified-tick))))
+ (if (or track-mouse ;Don't close in the middle of a click.
+ (not (eq reveal-last-tick
+ (setq reveal-last-tick (buffer-modified-tick)))))
;; The buffer was modified since last command: let's refrain from
;; closing any overlay because it tends to behave poorly when
;; inserting text at the end of an overlay (basically the overlay
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index 8d29c43980c..53aac55fad8 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -1,6 +1,6 @@
;;; rfn-eshadow.el --- Highlight `shadowed' part of read-file-name input text
;;
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience minibuffer
diff --git a/lisp/rot13.el b/lisp/rot13.el
index 1b61855f2dc..a53fd74a338 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -1,9 +1,9 @@
;;; rot13.el --- display a buffer in ROT13
-;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 009bb11fc10..f1b5da497c9 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,6 +1,6 @@
;;; ruler-mode.el --- display a ruler in the header line
-;; Copyright (C) 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -306,7 +306,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
"Return a column number relative to the selected window.
N is a column number relative to selected frame."
(- n
- (car (window-edges))
(or (car (window-margins)) 0)
(fringe-columns 'left)
(scroll-bar-columns 'left)))
@@ -321,7 +320,7 @@ START-EVENT is the mouse click event."
(when (eq start end) ;; mouse click
(save-selected-window
(select-window (posn-window start))
- (setq col (- (car (posn-col-row start)) (car (window-edges))
+ (setq col (- (car (posn-col-row start))
(scroll-bar-columns 'left))
w (- (ruler-mode-full-window-width)
(scroll-bar-columns 'left)
@@ -343,7 +342,7 @@ START-EVENT is the mouse click event."
(when (eq start end) ;; mouse click
(save-selected-window
(select-window (posn-window start))
- (setq col (- (car (posn-col-row start)) (car (window-edges))
+ (setq col (- (car (posn-col-row start))
(scroll-bar-columns 'left))
w (- (ruler-mode-full-window-width)
(scroll-bar-columns 'left)
@@ -438,6 +437,8 @@ the mouse has been clicked."
(let ((drags 0)
event)
(track-mouse
+ ;; Signal the display engine to freeze the mouse pointer shape.
+ (setq track-mouse 'dragging)
(while (mouse-movement-p (setq event (read-event)))
(setq drags (1+ drags))
(when (eq window (posn-window (event-end event)))
@@ -477,8 +478,9 @@ START-EVENT is the mouse click event."
(not (member ts tab-stop-list))
(progn
(message "Tab stop set to %d" ts)
- (setq tab-stop-list (sort (cons ts tab-stop-list)
- #'<)))))))))
+ (when (null tab-stop-list)
+ (setq tab-stop-list (indent-accumulate-tab-stops (1- ts))))
+ (setq tab-stop-list (sort (cons ts tab-stop-list) #'<)))))))))
(defun ruler-mode-mouse-del-tab-stop (start-event)
"Delete tab stop at the graduation where the mouse pointer is on.
@@ -754,7 +756,7 @@ Optional argument PROPS specifies other text properties to apply."
i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
ruler))
;; Show the `tab-stop-list' markers.
- ((and ruler-mode-show-tab-stops (member j tab-stop-list))
+ ((and ruler-mode-show-tab-stops (= j (indent-next-tab-stop (1- j))))
(aset ruler i ruler-mode-tab-stop-char)
(put-text-property
i (1+ i) 'face 'ruler-mode-tab-stop
@@ -773,8 +775,4 @@ Optional argument PROPS specifies other text properties to apply."
(provide 'ruler-mode)
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; ruler-mode.el ends here
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 374e57feb1f..607138ca31a 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -1,9 +1,9 @@
;;; savehist.el --- Save minibuffer history
-;; Copyright (C) 1997, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2005-2015 Free Software Foundation, Inc.
;; Author: Hrvoje Niksic <hniksic@xemacs.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: minibuffer
;; Version: 24
@@ -49,7 +49,7 @@
(require 'custom)
(eval-when-compile
- (require 'cl))
+ (if (featurep 'xemacs) (require 'cl)))
;; User variables
@@ -60,21 +60,21 @@
(defcustom savehist-save-minibuffer-history t
"If non-nil, save all recorded minibuffer histories.
-If you want to save only specific histories, use `savehist-save-hook' to
-modify the value of `savehist-minibuffer-history-variables'."
+If you want to save only specific histories, use `savehist-save-hook'
+to modify the value of `savehist-minibuffer-history-variables'."
:type 'boolean
:group 'savehist)
(defcustom savehist-additional-variables ()
"List of additional variables to save.
Each element is a symbol whose value will be persisted across Emacs
-sessions that use savehist. The contents of variables should be
+sessions that use Savehist. The contents of variables should be
printable with the Lisp printer. You don't need to add minibuffer
history variables to this list, all minibuffer histories will be
saved automatically as long as `savehist-save-minibuffer-history' is
non-nil.
-User options should be saved with the customize interface. This
+User options should be saved with the Customize interface. This
list is useful for saving automatically updated variables that are not
minibuffer histories, such as `compile-command' or `kill-ring'."
:type '(repeat variable)
@@ -89,7 +89,7 @@ minibuffer histories, such as `compile-command' or `kill-ring'."
(locate-user-emacs-file "history" ".emacs-history")
"File name where minibuffer history is saved to and loaded from.
The minibuffer history is a series of Lisp expressions loaded
-automatically when `savehist-mode' is turned on. See `savehist-mode'
+automatically when Savehist mode is turned on. See `savehist-mode'
for more details.
If you want your minibuffer history shared between Emacs and XEmacs,
@@ -115,14 +115,14 @@ If set to nil, disables timer-based autosaving."
:group 'savehist)
(defcustom savehist-mode-hook nil
- "Hook called when `savehist-mode' is turned on."
+ "Hook called when Savehist mode is turned on."
:type 'hook
:group 'savehist)
(defcustom savehist-save-hook nil
"Hook called by `savehist-save' before saving the variables.
-You can use this hook to influence choice and content of variables to
-save."
+You can use this hook to influence choice and content of variables
+to save."
:type 'hook
:group 'savehist)
@@ -134,7 +134,7 @@ save."
(<= emacs-major-version 21)
(< emacs-minor-version 5))
'iso-2022-8 'utf-8-unix)
- "The coding system savehist uses for saving the minibuffer history.
+ "The coding system Savehist uses for saving the minibuffer history.
Changing this value while Emacs is running is supported, but considered
unwise, unless you know what you are doing.")
@@ -158,7 +158,7 @@ buffer text.")
(defvar savehist-loaded nil
"Whether the history has already been loaded.
-This prevents toggling `savehist-mode' from destroying existing
+This prevents toggling Savehist mode from destroying existing
minibuffer history.")
(when (featurep 'xemacs)
@@ -205,7 +205,7 @@ histories, which is probably undesirable."
(savehist-install)))
(defun savehist-load ()
- "Load the variables stored in `savehist-file' and turn on `savehist-mode'.
+ "Load the variables stored in `savehist-file' and turn on Savehist mode.
If `savehist-file' is in the old format that doesn't record
the value of `savehist-minibuffer-history-variables', that
value is deducted from the contents of the file."
@@ -228,7 +228,7 @@ value is deducted from the contents of the file."
vars)))))
(defun savehist-install ()
- "Hook savehist into Emacs.
+ "Hook Savehist into Emacs.
Normally invoked by calling `savehist-mode' to set the minor mode.
Installs `savehist-autosave' in `kill-emacs-hook' and on a timer.
To undo this, call `savehist-uninstall'."
@@ -270,21 +270,18 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
(interactive)
(with-temp-buffer
(insert
- (format ";; -*- mode: emacs-lisp; coding: %s -*-\n" savehist-coding-system)
- ";; Minibuffer history file, automatically generated by `savehist'.\n\n")
+ (format-message
+ (concat
+ ";; -*- mode: emacs-lisp; coding: %s -*-\n"
+ ";; Minibuffer history file, automatically generated by `savehist'.\n"
+ "\n")
+ savehist-coding-system))
(run-hooks 'savehist-save-hook)
(let ((print-length nil)
(print-string-length nil)
(print-level nil)
(print-readably t)
(print-quoted t))
- ;; During the 24.3 development, read-passwd had a bug which resulted in
- ;; the passwords being saved by savehist. Trim them, retroactively.
- ;; This code can be removed after the 24.3 release.
- (dolist (sym savehist-minibuffer-history-variables)
- (if (and (symbolp sym) (equal (symbol-name sym) "forget-history"))
- (setq savehist-minibuffer-history-variables
- (delq sym savehist-minibuffer-history-variables))))
;; Save the minibuffer histories, along with the value of
;; savehist-minibuffer-history-variables itself.
(when savehist-save-minibuffer-history
@@ -356,7 +353,7 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved,
(defun savehist-autosave ()
"Save the minibuffer history if it has been modified since the last save.
-Does nothing if `savehist-mode' is off."
+Does nothing if Savehist mode is off."
(when savehist-mode
(savehist-save t)))
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 2ddac6d6c43..fe54743e393 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -1,9 +1,9 @@
;;; saveplace.el --- automatically save place in files
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: July, 1993
;; Keywords: bookmarks, placeholders
@@ -50,28 +50,10 @@ visiting file FILENAME goes automatically to position POSITION
rather than the beginning of the buffer.
This alist is saved between Emacs sessions.")
-(defcustom save-place nil
- "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.
-This variable is automatically buffer-local.
-
-If you wish your place in any file to always be automatically
-saved, set this to t using the Customize facility, or put the
-following code in your init file:
-
-\(setq-default save-place t)
-\(require 'saveplace)"
- :type 'boolean
- :require 'saveplace
- :group 'save-place)
-
-(make-variable-buffer-local 'save-place)
-
(defcustom save-place-file (locate-user-emacs-file "places" ".emacs-places")
"Name of the file that records `save-place-alist' value."
- :type 'file
- :group 'save-place)
+ :version "24.4" ; added locate-user-emacs-file
+ :type 'file)
(defcustom save-place-version-control nil
"Controls whether to make numbered backups of master save-place file.
@@ -82,8 +64,7 @@ value of `version-control'."
:type '(radio (const :tag "Unconditionally" t)
(const :tag "For VC Files" nil)
(const never)
- (const :tag "Use value of `version-control'" nospecial))
- :group 'save-place)
+ (const :tag "Use value of `version-control'" nospecial)))
(defvar save-place-loaded nil
"Non-nil means that the `save-place-file' has been loaded.")
@@ -92,21 +73,20 @@ value of `version-control'."
"Maximum number of entries to retain in the list; nil means no limit."
:version "24.1" ; nil -> 400
:type '(choice (integer :tag "Entries" :value 1)
- (const :tag "No Limit" nil))
- :group 'save-place)
+ (const :tag "No Limit" nil)))
(defcustom save-place-forget-unreadable-files t
"Non-nil means forget place in unreadable files.
The filenames in `save-place-alist' that do not match
`save-place-skip-check-regexp' are filtered through
-`file-readable-p'. if nil, their alist entries are removed.
+`file-readable-p'. If nil, their alist entries are removed.
You may do this anytime by calling the complementary function,
`save-place-forget-unreadable-files'. When this option is turned on,
this happens automatically before saving `save-place-alist' to
`save-place-file'."
- :type 'boolean :group 'save-place)
+ :type 'boolean)
(defcustom save-place-save-skipped t
"If non-nil, remember files matching `save-place-skip-check-regexp'.
@@ -114,7 +94,7 @@ this happens automatically before saving `save-place-alist' to
When filtering `save-place-alist' for unreadable files, some will not
be checked, based on said regexp, and instead saved or forgotten based
on this flag."
- :type 'boolean :group 'save-place)
+ :type 'boolean)
(defcustom save-place-skip-check-regexp
;; thanks to ange-ftp-name-format
@@ -127,7 +107,7 @@ subject to `save-place-save-skipped'.
Files for which such a check may be inconvenient include those on
removable and network volumes."
- :type 'regexp :group 'save-place)
+ :type 'regexp)
(defcustom save-place-ignore-files-regexp
"\\(?:COMMIT_EDITMSG\\|hg-editor-[[:alnum:]]+\\.txt\\|svn-commit\\.tmp\\|bzr_log\\.[[:alnum:]]+\\)$"
@@ -136,9 +116,34 @@ Useful for temporary file such as commit message files that are
automatically created by the VCS. If set to nil, this feature is
disabled, i.e., the position is recorded for all files."
:version "24.1"
- :type 'regexp :group 'save-place)
+ :type 'regexp)
-(defun toggle-save-place (&optional parg)
+(declare-function dired-current-directory "dired" (&optional localp))
+
+(define-obsolete-variable-alias 'save-place 'save-place-mode "25.1")
+;;;###autoload
+(define-minor-mode save-place-mode
+ "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."
+ :global t
+ :group 'save-place
+ (cond
+ (save-place-mode
+ (add-hook 'find-file-hook 'save-place-find-file-hook t)
+ (add-hook 'dired-initial-position-hook 'save-place-dired-hook)
+ (unless noninteractive
+ (add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
+ (add-hook 'kill-buffer-hook 'save-place-to-alist))
+ (t
+ (remove-hook 'find-file-hook 'save-place-find-file-hook t)
+ (remove-hook 'dired-initial-position-hook 'save-place-dired-hook)
+ (remove-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)
+ (remove-hook 'kill-buffer-hook 'save-place-to-alist))))
+
+(make-variable-buffer-local 'save-place-mode) ; Hysterical raisins.
+
+(defun toggle-save-place (&optional parg) ;FIXME: save-place-local-mode!
"Toggle whether to save your place in this file between sessions.
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,
@@ -150,16 +155,19 @@ the argument is positive.
To save places automatically in all files, put this in your init
file:
-\(setq-default save-place t\)"
+\(setq-default save-place t)"
(interactive "P")
- (if (not buffer-file-name)
- (message "Buffer `%s' not visiting a file" (buffer-name))
- (if (and save-place (or (not parg) (<= parg 0)))
- (progn
- (message "No place will be saved in this file")
- (setq save-place nil))
- (message "Place will be saved")
- (setq save-place t))))
+ (if (not (or buffer-file-name (and (derived-mode-p 'dired-mode)
+ (dired-current-directory))))
+ (message "Buffer `%s' not visiting a file or directory" (buffer-name))
+ (setq save-place (if parg
+ (> (prefix-numeric-value parg) 0)
+ (not save-place)))
+ (message (if save-place
+ "Place will be saved"
+ "No place will be saved in this 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
@@ -169,21 +177,32 @@ file:
;; 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))
- (let ((item (or buffer-file-name
- (and dired-directory (expand-file-name dired-directory)))))
+ (let* ((directory (and (derived-mode-p 'dired-mode)
+ (dired-current-directory)))
+ (item (or buffer-file-name
+ (and directory
+ (expand-file-name (if (consp directory)
+ (car directory)
+ directory))))))
(when (and item
(or (not save-place-ignore-files-regexp)
(not (string-match save-place-ignore-files-regexp
item))))
(let ((cell (assoc item save-place-alist))
- (position (if (not (eq major-mode 'hexl-mode))
- (point)
- (with-no-warnings
- (1+ (hexl-current-address))))))
+ (position (cond ((eq major-mode 'hexl-mode)
+ (with-no-warnings
+ (1+ (hexl-current-address))))
+ ((and (derived-mode-p 'dired-mode) directory)
+ (let ((filename (dired-get-filename nil t)))
+ (if filename
+ `((dired-filename . ,filename))
+ (point))))
+ (t (point)))))
(if cell
(setq save-place-alist (delq cell save-place-alist)))
(if (and save-place
- (not (= position 1))) ;; Optimize out the degenerate case.
+ (not (and (integerp position)
+ (= position 1)))) ;; Optimize out the degenerate case.
(setq save-place-alist
(cons (cons item position)
save-place-alist)))))))
@@ -191,8 +210,8 @@ file:
(defun save-place-forget-unreadable-files ()
"Remove unreadable files from `save-place-alist'.
For each entry in the alist, if `file-readable-p' returns nil for the
-filename, remove the entry. Save the new alist \(as the first pair
-may have changed\) back to `save-place-alist'."
+filename, remove the entry. Save the new alist (as the first pair
+may have changed) back to `save-place-alist'."
(interactive)
;; the following was adapted from an in-place filtering function,
;; `filter-mod', used in the original.
@@ -255,8 +274,9 @@ may have changed\) back to `save-place-alist'."
(insert-file-contents file)
(goto-char (point-min))
(setq save-place-alist
- (car (read-from-string
- (buffer-substring (point-min) (point-max)))))
+ (with-demoted-errors "Error reading save-place-file: %S"
+ (car (read-from-string
+ (buffer-substring (point-min) (point-max))))))
;; If there is a limit, and we're over it, then we'll
;; have to truncate the end of the list:
@@ -289,7 +309,9 @@ may have changed\) back to `save-place-alist'."
(with-current-buffer (car buf-list)
;; save-place checks buffer-file-name too, but we can avoid
;; overhead of function call by checking here too.
- (and buffer-file-name (save-place-to-alist))
+ (and (or buffer-file-name (and (derived-mode-p 'dired-mode)
+ (dired-current-directory)))
+ (save-place-to-alist))
(setq buf-list (cdr buf-list))))))
(defun save-place-find-file-hook ()
@@ -298,18 +320,31 @@ may have changed\) back to `save-place-alist'."
(if cell
(progn
(or revert-buffer-in-progress-p
- (goto-char (cdr cell)))
+ (and (integerp (cdr cell))
+ (goto-char (cdr cell))))
;; and make sure it will be saved again for later
(setq save-place t)))))
+(declare-function dired-goto-file "dired" (file))
+
(defun save-place-dired-hook ()
- "Position the point in a dired buffer."
+ "Position the point in a Dired buffer."
(or save-place-loaded (load-save-place-alist-from-file))
- (let ((cell (assoc (expand-file-name dired-directory) save-place-alist)))
+ (let* ((directory (and (derived-mode-p 'dired-mode)
+ (dired-current-directory)))
+ (cell (assoc (and directory
+ (expand-file-name (if (consp directory)
+ (car directory)
+ directory)))
+ save-place-alist)))
(if cell
(progn
(or revert-buffer-in-progress-p
- (goto-char (cdr cell)))
+ (cond
+ ((integerp (cdr cell))
+ (goto-char (cdr cell)))
+ ((and (listp (cdr cell)) (assq 'dired-filename (cdr cell)))
+ (dired-goto-file (cdr (assq 'dired-filename (cdr cell)))))))
;; and make sure it will be saved again for later
(setq save-place t)))))
@@ -321,14 +356,5 @@ may have changed\) back to `save-place-alist'."
(if save-place-loaded
(save-place-alist-to-file)))
-(add-hook 'find-file-hook 'save-place-find-file-hook t)
-
-(add-hook 'dired-initial-point-hook 'save-place-dired-hook)
-(unless noninteractive
- (add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook))
-
-(add-hook 'kill-buffer-hook 'save-place-to-alist)
-
-(provide 'saveplace) ; why not...
-
+(provide 'saveplace)
;;; saveplace.el ends here
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
index 856bea3de5c..66f8d7720a6 100644
--- a/lisp/sb-image.el
+++ b/lisp/sb-image.el
@@ -1,6 +1,6 @@
;;; sb-image --- Image management for speedbar
-;; Copyright (C) 1999-2003, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2003, 2005-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index f4f160e77db..9c2d1fb44ba 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -1,9 +1,9 @@
;;; scroll-all.el --- scroll all buffers together minor mode
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@corp.sun.com>
-;; Keywords: scroll crisp brief lock
+;; Keywords: convenience scroll lock
;; This file is part of GNU Emacs.
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 7fb17916ad3..635990a7825 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -1,8 +1,8 @@
;;; scroll-bar.el --- window system-independent scroll bar support
-;; Copyright (C) 1993-1995, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1995, 1999-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
;; Package: emacs
@@ -70,10 +70,25 @@ SIDE must be the symbol `left' or `right'."
(frame-char-width)))
(0))))
+(defun scroll-bar-lines ()
+ "Return the height, measured in lines, of the horizontal scrollbar."
+ (let* ((wsb (window-scroll-bars))
+ (htype (nth 5 wsb))
+ (lines (nth 4 wsb)))
+ (cond
+ (htype lines)
+ ((frame-parameter nil 'horizontal-scroll-bars)
+ ;; nil means it's a non-toolkit scroll bar (which is currently
+ ;; impossible), and its height in lines is 14 pixels rounded up.
+ (ceiling (or (frame-parameter nil 'scroll-bar-height) 14)
+ (frame-char-width)))
+ (0))))
+
;;;; Helpful functions for enabling and disabling scroll bars.
(defvar scroll-bar-mode)
+(defvar horizontal-scroll-bar-mode)
(defvar previous-scroll-bar-mode nil)
(defvar scroll-bar-mode-explicit nil
@@ -126,12 +141,44 @@ This command applies to all frames that exist and frames to be
created in the future."
:variable ((get-scroll-bar-mode)
. (lambda (v) (set-scroll-bar-mode
- (if v (or previous-scroll-bar-mode
- default-frame-scroll-bars))))))
+ (if v (or previous-scroll-bar-mode
+ default-frame-scroll-bars))))))
+
+(defun horizontal-scroll-bars-available-p ()
+ "Return non-nil when horizontal scroll bars are available on this system."
+ (and (display-graphic-p)
+ (boundp 'x-toolkit-scroll-bars)
+ x-toolkit-scroll-bars
+ (not (eq (window-system) 'ns))))
+
+(define-minor-mode horizontal-scroll-bar-mode
+ "Toggle horizontal scroll bars on all frames (Horizontal Scroll Bar mode).
+With a prefix argument ARG, enable Horizontal Scroll Bar mode if
+ARG is positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
+
+This command applies to all frames that exist and frames to be
+created in the future."
+ :init-value nil
+ :global t
+ :group 'frames
+ (if (and horizontal-scroll-bar-mode
+ (not (horizontal-scroll-bars-available-p)))
+ (progn
+ (setq horizontal-scroll-bar-mode nil)
+ (message "Horizontal scroll bars are not implemented on this system"))
+ (dolist (frame (frame-list))
+ (set-frame-parameter
+ frame 'horizontal-scroll-bars horizontal-scroll-bar-mode))
+ ;; Handle `default-frame-alist' entry.
+ (setq default-frame-alist
+ (cons (cons 'horizontal-scroll-bars horizontal-scroll-bar-mode)
+ (assq-delete-all 'horizontal-scroll-bars
+ default-frame-alist)))))
(defun toggle-scroll-bar (arg)
"Toggle whether or not the selected frame has vertical scroll bars.
-With arg, turn vertical scroll bars on if and only if arg is positive.
+With ARG, turn vertical scroll bars on if and only if ARG is positive.
The variable `scroll-bar-mode' controls which side the scroll bars are on
when they are turned on; if it is nil, they go on the left."
(interactive "P")
@@ -147,12 +194,20 @@ when they are turned on; if it is nil, they go on the left."
(if (> arg 0)
(or scroll-bar-mode default-frame-scroll-bars))))))
-(defun toggle-horizontal-scroll-bar (_arg)
+(defun toggle-horizontal-scroll-bar (arg)
"Toggle whether or not the selected frame has horizontal scroll bars.
-With arg, turn horizontal scroll bars on if and only if arg is positive.
-Horizontal scroll bars aren't implemented yet."
+With ARG, turn vertical scroll bars on if and only if ARG is positive."
(interactive "P")
- (error "Horizontal scroll bars aren't implemented yet"))
+ (if (null arg)
+ (setq arg
+ (if (cdr (assq 'horizontal-scroll-bars
+ (frame-parameters (selected-frame))))
+ -1 1))
+ (setq arg (prefix-numeric-value arg)))
+ (modify-frame-parameters
+ (selected-frame)
+ (list (cons 'horizontal-scroll-bars
+ (when (> arg 0) 'bottom)))))
;;;; Buffer navigation using the scroll bar.
@@ -249,6 +304,51 @@ If you click outside the slider, the window scrolls to bring the slider there."
(with-current-buffer (window-buffer window)
(setq point-before-scroll before-scroll))))
+;; Scroll the window to the proper position for EVENT.
+(defun scroll-bar-horizontal-drag-1 (event)
+ (let* ((start-position (event-start event))
+ (window (nth 0 start-position))
+ (portion-whole (nth 2 start-position))
+ (unit (frame-char-width (window-frame window))))
+ (if (eq (current-bidi-paragraph-direction (window-buffer window))
+ 'left-to-right)
+ (set-window-hscroll
+ window (/ (+ (car portion-whole) (1- unit)) unit))
+ (set-window-hscroll
+ window (/ (+ (- (cdr portion-whole) (car portion-whole))
+ (1- unit))
+ unit)))))
+
+(defun scroll-bar-horizontal-drag (event)
+ "Scroll the window horizontally by dragging the scroll bar slider.
+If you click outside the slider, the window scrolls to bring the slider there."
+ (interactive "e")
+ (let* (done
+ (echo-keystrokes 0)
+ (end-position (event-end event))
+ (window (nth 0 end-position))
+ (before-scroll))
+ (with-current-buffer (window-buffer window)
+ (setq before-scroll point-before-scroll))
+ (save-selected-window
+ (select-window window)
+ (setq before-scroll
+ (or before-scroll (point))))
+ (scroll-bar-horizontal-drag-1 event)
+ (track-mouse
+ (while (not done)
+ (setq event (read-event))
+ (if (eq (car-safe event) 'mouse-movement)
+ (setq event (read-event)))
+ (cond ((eq (car-safe event) 'scroll-bar-movement)
+ (scroll-bar-horizontal-drag-1 event))
+ (t
+ ;; Exit when we get the drag event; ignore that event.
+ (setq done t)))))
+ (sit-for 0)
+ (with-current-buffer (window-buffer window)
+ (setq point-before-scroll before-scroll))))
+
(defun scroll-bar-scroll-down (event)
"Scroll the window's top line down to the location of the scroll bar click.
EVENT should be a scroll bar click."
@@ -295,52 +395,109 @@ EVENT should be a scroll bar click."
;;; Tookit scroll bars.
(defun scroll-bar-toolkit-scroll (event)
+ "Handle event EVENT on vertical scroll bar."
(interactive "e")
(let* ((end-position (event-end event))
(window (nth 0 end-position))
(part (nth 4 end-position))
before-scroll)
- (cond ((eq part 'end-scroll))
- (t
- (with-current-buffer (window-buffer window)
- (setq before-scroll point-before-scroll))
- (save-selected-window
- (select-window window)
- (setq before-scroll (or before-scroll (point)))
- (cond ((eq part 'above-handle)
- (scroll-up '-))
- ((eq part 'below-handle)
- (scroll-up nil))
- ((eq part 'ratio)
- (let* ((portion-whole (nth 2 end-position))
- (lines (scroll-bar-scale portion-whole
- (1- (window-height)))))
- (scroll-up (cond ((not (zerop lines)) lines)
- ((< (car portion-whole) 0) -1)
- (t 1)))))
- ((eq part 'up)
- (scroll-up -1))
- ((eq part 'down)
- (scroll-up 1))
- ((eq part 'top)
- (set-window-start window (point-min)))
- ((eq part 'bottom)
- (goto-char (point-max))
- (recenter))
- ((eq part 'handle)
- (scroll-bar-drag-1 event))))
- (sit-for 0)
- (with-current-buffer (window-buffer window)
- (setq point-before-scroll before-scroll))))))
-
+ (cond
+ ((eq part 'end-scroll))
+ (t
+ (with-current-buffer (window-buffer window)
+ (setq before-scroll point-before-scroll))
+ (save-selected-window
+ (select-window window)
+ (setq before-scroll (or before-scroll (point)))
+ (cond
+ ((eq part 'above-handle)
+ (scroll-up '-))
+ ((eq part 'below-handle)
+ (scroll-up nil))
+ ((eq part 'ratio)
+ (let* ((portion-whole (nth 2 end-position))
+ (lines (scroll-bar-scale portion-whole
+ (1- (window-height)))))
+ (scroll-up (cond ((not (zerop lines)) lines)
+ ((< (car portion-whole) 0) -1)
+ (t 1)))))
+ ((eq part 'up)
+ (scroll-up -1))
+ ((eq part 'down)
+ (scroll-up 1))
+ ((eq part 'top)
+ (set-window-start window (point-min)))
+ ((eq part 'bottom)
+ (goto-char (point-max))
+ (recenter))
+ ((eq part 'handle)
+ (scroll-bar-drag-1 event))))
+ (sit-for 0)
+ (with-current-buffer (window-buffer window)
+ (setq point-before-scroll before-scroll))))))
+(defun scroll-bar-toolkit-horizontal-scroll (event)
+ "Handle event EVENT on horizontal scroll bar."
+ (interactive "e")
+ (let* ((end-position (event-end event))
+ (window (nth 0 end-position))
+ (part (nth 4 end-position))
+ (bidi-factor
+ (if (eq (current-bidi-paragraph-direction (window-buffer window))
+ 'left-to-right)
+ 1
+ -1))
+ before-scroll)
+ (cond
+ ((eq part 'end-scroll))
+ (t
+ (with-current-buffer (window-buffer window)
+ (setq before-scroll point-before-scroll))
+ (save-selected-window
+ (select-window window)
+ (setq before-scroll (or before-scroll (point)))
+ (cond
+ ((eq part 'before-handle)
+ (scroll-right (* bidi-factor 4)))
+ ((eq part 'after-handle)
+ (scroll-left (* bidi-factor 4)))
+ ((eq part 'ratio)
+ (let* ((portion-whole (nth 2 end-position))
+ (columns (scroll-bar-scale portion-whole
+ (1- (window-width)))))
+ (scroll-right
+ (* (cond
+ ((not (zerop columns))
+ columns)
+ ((< (car portion-whole) 0) -1)
+ (t 1))
+ bidi-factor))))
+ ((eq part 'left)
+ (scroll-right (* bidi-factor 1)))
+ ((eq part 'right)
+ (scroll-left (* bidi-factor 1)))
+ ((eq part 'leftmost)
+ (goto-char (if (eq bidi-factor 1)
+ (line-beginning-position)
+ (line-end-position))))
+ ((eq part 'rightmost)
+ (goto-char (if (eq bidi-factor 1)
+ (line-end-position)
+ (line-beginning-position))))
+ ((eq part 'horizontal-handle)
+ (scroll-bar-horizontal-drag-1 event))))
+ (sit-for 0)
+ (with-current-buffer (window-buffer window)
+ (setq point-before-scroll before-scroll))))))
;;;; Bindings.
;; For now, we'll set things up to work like xterm.
(cond ((and (boundp 'x-toolkit-scroll-bars) x-toolkit-scroll-bars)
(global-set-key [vertical-scroll-bar mouse-1]
- 'scroll-bar-toolkit-scroll))
+ 'scroll-bar-toolkit-scroll)
+ (global-set-key [horizontal-scroll-bar mouse-1]
+ 'scroll-bar-toolkit-horizontal-scroll))
(t
(global-set-key [vertical-scroll-bar mouse-1]
'scroll-bar-scroll-up)
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index 590fade311b..254d4e2e85f 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -1,9 +1,9 @@
;;; scroll-lock.el --- Scroll lock scrolling.
-;; Copyright (C) 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2015 Free Software Foundation, Inc.
;; Author: Ralf Angeli <angeli@iwi.uni-sb.de>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 2005-06-18
;; This file is part of GNU Emacs.
diff --git a/lisp/select.el b/lisp/select.el
index 58fbe5f0f51..2d2ac5fa422 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -1,8 +1,8 @@
-;;; select.el --- lisp portion of standard selection support
+;;; select.el --- lisp portion of standard selection support -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; This file is part of GNU Emacs.
@@ -24,6 +24,18 @@
;; Based partially on earlier release by Lucid.
+;; The functionality here is divided in two parts:
+;; - Low-level: gui-get-selection, gui-set-selection, gui-selection-owner-p,
+;; gui-selection-exists-p are the backend-dependent functions meant to access
+;; various kinds of selections (CLIPBOARD, PRIMARY, SECONDARY).
+;; - Higher-level: gui-select-text and gui-selection-value go together to
+;; access the general notion of "GUI selection" for interoperation with other
+;; applications. This can use either the clipboard or the primary selection,
+;; or both or none according to select-enable-clipboard/primary. These are
+;; the default values of interprogram-cut/paste-function.
+;; Additionally, there's gui-get-primary-selection which is used to get the
+;; PRIMARY selection, specifically for mouse-yank-primary.
+
;;; Code:
(defcustom selection-coding-system nil
@@ -71,13 +83,203 @@ other programs (X Windows clients or MS Windows programs). But, if this
variable is set, it is used for the next communication only.
After the communication, this variable is set to nil.")
-(declare-function x-get-selection-internal "xselect.c"
- (selection-symbol target-type &optional time-stamp terminal))
-
;; Only declared obsolete in 23.3.
(define-obsolete-function-alias 'x-selection 'x-get-selection "at least 19.34")
-(defun x-get-selection (&optional type data-type)
+(defcustom select-enable-clipboard t
+ "Non-nil means cutting and pasting uses the clipboard.
+This can be in addition to, but in preference to, the primary selection,
+if applicable (i.e. under X11)."
+ :type 'boolean
+ :group 'killing
+ ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
+ :version "24.1")
+(define-obsolete-variable-alias 'x-select-enable-clipboard
+ 'select-enable-clipboard "25.1")
+
+(defcustom select-enable-primary nil
+ "Non-nil means cutting and pasting uses the primary selection
+The existence of a primary selection depends on the underlying GUI you use.
+E.g. it doesn't exist under MS-Windows."
+ :type 'boolean
+ :group 'killing
+ :version "24.1")
+(define-obsolete-variable-alias 'x-select-enable-primary
+ 'select-enable-primary "25.1")
+
+;; We keep track of the last text selected here, so we can check the
+;; current selection against it, and avoid passing back our own text
+;; from gui-selection-value. We track both
+;; separately in case another X application only sets one of them
+;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
+
+(defvar gui--last-selected-text-clipboard nil
+ "The value of the CLIPBOARD selection last seen.")
+(defvar gui--last-selected-text-primary nil
+ "The value of the PRIMARY selection last seen.")
+
+(defun gui-select-text (text)
+ "Select TEXT, a string, according to the window system.
+if `select-enable-clipboard' is non-nil, copy TEXT to the system's clipboard.
+If `select-enable-primary' is non-nil, put TEXT in the primary selection.
+
+MS-Windows does not have a \"primary\" selection."
+ (when select-enable-primary
+ (gui-set-selection 'PRIMARY text)
+ (setq gui--last-selected-text-primary text))
+ (when select-enable-clipboard
+ ;; When cutting, the selection is cleared and PRIMARY
+ ;; set to the empty string. Prevent that, PRIMARY
+ ;; should not be reset by cut (Bug#16382).
+ (setq saved-region-selection text)
+ (gui-set-selection 'CLIPBOARD text)
+ (setq gui--last-selected-text-clipboard text)))
+(define-obsolete-function-alias 'x-select-text 'gui-select-text "25.1")
+
+(defcustom x-select-request-type nil
+ "Data type request for X selection.
+The value is one of the following data types, a list of them, or nil:
+ `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
+
+If the value is one of the above symbols, try only the specified type.
+
+If the value is a list of them, try each of them in the specified
+order until succeed.
+
+The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
+ :type '(choice (const :tag "Default" nil)
+ (const COMPOUND_TEXT)
+ (const UTF8_STRING)
+ (const STRING)
+ (const TEXT)
+ (set :tag "List of values"
+ (const COMPOUND_TEXT)
+ (const UTF8_STRING)
+ (const STRING)
+ (const TEXT)))
+ :group 'killing)
+
+;; Get a selection value of type TYPE by calling gui-get-selection with
+;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
+;; The return value is already decoded. If gui-get-selection causes an
+;; error, this function return nil.
+
+(defun gui--selection-value-internal (type)
+ (let ((request-type (if (eq window-system 'x)
+ (or x-select-request-type
+ '(UTF8_STRING COMPOUND_TEXT STRING))
+ 'STRING))
+ text)
+ (with-demoted-errors "gui-get-selection: %S"
+ (if (consp request-type)
+ (while (and request-type (not text))
+ (setq text (gui-get-selection type (car request-type)))
+ (setq request-type (cdr request-type)))
+ (setq text (gui-get-selection type request-type))))
+ (if text
+ (remove-text-properties 0 (length text) '(foreign-selection nil) text))
+ text))
+
+(defun gui-selection-value ()
+ (let ((clip-text
+ (when select-enable-clipboard
+ (let ((text (gui--selection-value-internal 'CLIPBOARD)))
+ (if (string= text "") (setq text nil))
+
+ ;; Check the CLIPBOARD selection for 'newness', is it different
+ ;; from what we remembered them to be last time we did a
+ ;; cut/paste operation.
+ (prog1
+ (unless (equal text gui--last-selected-text-clipboard)
+ text)
+ (setq gui--last-selected-text-clipboard text)))))
+ (primary-text
+ (when select-enable-primary
+ (let ((text (gui--selection-value-internal 'PRIMARY)))
+ (if (string= text "") (setq text nil))
+ ;; Check the PRIMARY selection for 'newness', is it different
+ ;; from what we remembered them to be last time we did a
+ ;; cut/paste operation.
+ (prog1
+ (unless (equal text gui--last-selected-text-primary)
+ text)
+ (setq gui--last-selected-text-primary text))))))
+
+ ;; As we have done one selection, clear this now.
+ (setq next-selection-coding-system nil)
+
+ ;; At this point we have recorded the current values for the
+ ;; selection from clipboard (if we are supposed to) and primary.
+ ;; So return the first one that has changed
+ ;; (which is the first non-null one).
+ ;;
+ ;; NOTE: There will be cases where more than one of these has
+ ;; changed and the new values differ. This indicates that
+ ;; something like the following has happened since the last time
+ ;; we looked at the selections: Application X set all the
+ ;; selections, then Application Y set only one of them.
+ ;; In this case since we don't have
+ ;; timestamps there is no way to know what the 'correct' value to
+ ;; return is. The nice thing to do would be to tell the user we
+ ;; saw multiple possible selections and ask the user which was the
+ ;; one they wanted.
+ (or clip-text primary-text)
+ ))
+
+(define-obsolete-function-alias 'x-selection-value 'gui-selection-value "25.1")
+
+(defun x-get-clipboard ()
+ "Return text pasted to the clipboard."
+ (declare (obsolete gui-get-selection "25.1"))
+ (gui-backend-get-selection 'CLIPBOARD 'STRING))
+
+(defun gui-get-primary-selection ()
+ "Return the PRIMARY selection, or the best emulation thereof."
+ (or (gui--selection-value-internal 'PRIMARY)
+ (and (fboundp 'w32-get-selection-value)
+ (eq (framep (selected-frame)) 'w32)
+ ;; MS-Windows emulates PRIMARY in x-get-selection, but only
+ ;; within the Emacs session, so consult the clipboard if
+ ;; primary is not found.
+ (w32-get-selection-value))
+ (error "No selection is available")))
+(define-obsolete-function-alias 'x-get-selection-value
+ 'gui-get-primary-selection "25.1")
+
+;;; Lower-level, backend dependent selection handling.
+
+(cl-defgeneric gui-backend-get-selection (_selection-symbol _target-type)
+ "Return selected text.
+SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+TARGET-TYPE is the type of data desired, typically `STRING'."
+ nil)
+
+(cl-defgeneric gui-backend-set-selection (_selection _value)
+ "Method to assert a selection of type SELECTION and value VALUE.
+SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+If VALUE is nil and we own the selection SELECTION, disown it instead.
+Disowning it means there is no such selection.
+\(Those are literal upper-case symbol names, since that's what X expects.)
+VALUE is typically a string, or a cons of two markers, but may be
+anything that the functions on `selection-converter-alist' know about."
+ nil)
+
+(cl-defgeneric gui-backend-selection-owner-p (_selection)
+ "Whether the current Emacs process owns the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)"
+ nil)
+
+(cl-defgeneric gui-backend-selection-exists-p (_selection)
+ "Whether there is an owner for the given X Selection.
+The arg should be the name of the selection in question, typically one of
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
+\(Those are literal upper-case symbol names, since that's what X expects.)"
+ nil)
+
+(defun gui-get-selection (&optional type data-type)
"Return the value of an X Windows selection.
The argument TYPE (default `PRIMARY') says which selection,
and the argument DATA-TYPE (default `STRING') says
@@ -89,40 +291,29 @@ all upper-case names. The most often used ones, in addition to
`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
DATA-TYPE is usually `STRING', but can also be one of the symbols
-in `selection-converter-alist', which see."
- (let ((data (x-get-selection-internal (or type 'PRIMARY)
- (or data-type 'STRING)))
- coding)
+in `selection-converter-alist', which see. This argument is
+ignored on NS, MS-Windows and MS-DOS."
+ (let ((data (gui-backend-get-selection (or type 'PRIMARY)
+ (or data-type 'STRING))))
(when (and (stringp data)
(setq data-type (get-text-property 0 'foreign-selection data)))
- (setq coding (or next-selection-coding-system
- selection-coding-system
- (cond ((eq data-type 'UTF8_STRING)
- 'utf-8)
- ((eq data-type 'COMPOUND_TEXT)
- 'compound-text-with-extensions)
- ((eq data-type 'C_STRING)
- nil)
- ((eq data-type 'STRING)
- 'iso-8859-1)
- (t
- (error "Unknown selection data type: %S" type))))
- data (if coding (decode-coding-string data coding)
- (string-to-multibyte data)))
+ (let ((coding (or next-selection-coding-system
+ selection-coding-system
+ (pcase data-type
+ ('UTF8_STRING 'utf-8)
+ ('COMPOUND_TEXT 'compound-text-with-extensions)
+ ('C_STRING nil)
+ ('STRING 'iso-8859-1)
+ (_ (error "Unknown selection data type: %S"
+ type))))))
+ (setq data (if coding (decode-coding-string data coding)
+ (string-to-multibyte data))))
(setq next-selection-coding-system nil)
(put-text-property 0 (length data) 'foreign-selection data-type data))
data))
+(define-obsolete-function-alias 'x-get-selection 'gui-get-selection "25.1")
-(defun x-get-clipboard ()
- "Return text pasted to the clipboard."
- (x-get-selection-internal 'CLIPBOARD 'STRING))
-
-(declare-function x-own-selection-internal "xselect.c"
- (selection-name selection-value &optional frame))
-(declare-function x-disown-selection-internal "xselect.c"
- (selection &optional time terminal))
-
-(defun x-set-selection (type data)
+(defun gui-set-selection (type data)
"Make an X selection of type TYPE and value DATA.
The argument TYPE (nil means `PRIMARY') says which selection, and
DATA specifies the contents. TYPE must be a symbol. \(It can also
@@ -150,35 +341,32 @@ are not available to other programs."
(list 'PRIMARY (read-string "Set text for pasting: "))
(list 'PRIMARY (buffer-substring (region-beginning) (region-end)))))
(if (stringp type) (setq type (intern type)))
- (or (x-valid-simple-selection-p data)
+ (or (gui--valid-simple-selection-p data)
(and (vectorp data)
- (let ((valid t)
- (i (1- (length data))))
- (while (>= i 0)
- (or (x-valid-simple-selection-p (aref data i))
- (setq valid nil))
- (setq i (1- i)))
+ (let ((valid t))
+ (dotimes (i (length data))
+ (or (gui--valid-simple-selection-p (aref data i))
+ (setq valid nil)))
valid))
(signal 'error (list "invalid selection" data)))
(or type (setq type 'PRIMARY))
- (if data
- (x-own-selection-internal type data)
- (x-disown-selection-internal type))
+ (gui-backend-set-selection type data)
data)
+(define-obsolete-function-alias 'x-set-selection 'gui-set-selection "25.1")
-(defun x-valid-simple-selection-p (data)
+(defun gui--valid-simple-selection-p (data)
(or (bufferp data)
(and (consp data)
(markerp (car data))
(markerp (cdr data))
(marker-buffer (car data))
- (buffer-name (marker-buffer (car data)))
+ (buffer-live-p (marker-buffer (car data)))
(eq (marker-buffer (car data))
(marker-buffer (cdr data))))
(stringp data)
(and (overlayp data)
(overlay-buffer data)
- (buffer-name (overlay-buffer data)))
+ (buffer-live-p (overlay-buffer data)))
(symbolp data)
(integerp data)))
@@ -322,7 +510,7 @@ two markers or an overlay. Otherwise, it is nil."
(apply 'vector all)))
(defun xselect-convert-to-delete (selection _type _value)
- (x-disown-selection-internal selection)
+ (gui-backend-set-selection selection nil)
;; A return value of nil means that we do not know how to do this conversion,
;; and replies with an "error". A return value of NULL means that we have
;; done the conversion (and any side-effects) but have no value to return.
diff --git a/lisp/server.el b/lisp/server.el
index a76b2d4ce5f..59fd973115b 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1,10 +1,10 @@
;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*-
-;; Copyright (C) 1986-1987, 1992, 1994-2013 Free Software Foundation,
+;; Copyright (C) 1986-1987, 1992, 1994-2015 Free Software Foundation,
;; Inc.
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes
;; Changes by peck@sun.com and by rms.
@@ -104,10 +104,10 @@
"The name or IP address to use as host address of the server process.
If set, the server accepts remote connections; otherwise it is local.
-DO NOT give this a non-nil value unless you know what you are
-doing! On unsecured networks, accepting remote connections is
-very dangerous, because server-client communication (including
-session authentication) is not encrypted."
+DO NOT give this a non-nil value unless you know what you are doing!
+On unsecured networks, accepting remote connections is very dangerous,
+because server-client communication (including session authentication)
+is not encrypted."
:group 'server
:type '(choice
(string :tag "Name or IP address")
@@ -245,6 +245,7 @@ in this way."
:type 'boolean
:version "21.1")
+;; FIXME? This is not a minor mode; what's the point of this? (See bug#20201)
(or (assq 'server-buffer-clients minor-mode-alist)
(push '(server-buffer-clients " Server") minor-mode-alist))
@@ -532,7 +533,8 @@ Creates the directory if necessary and makes sure:
((and w32 (zerop uid)) ; on FAT32?
(display-warning
'server
- (format "Using `%s' to store Emacs-server authentication files.
+ (format-message "\
+Using `%s' to store Emacs-server authentication files.
Directories on FAT32 filesystems are NOT secure against tampering.
See variable `server-auth-dir' for details."
(file-name-as-directory dir))
@@ -573,7 +575,7 @@ If the key is not valid, signal an error."
(if server-auth-key
(if (string-match-p "^[!-~]\\{64\\}$" server-auth-key)
server-auth-key
- (error "The key '%s' is invalid" server-auth-key))
+ (error "The key `%s' is invalid" server-auth-key))
(server-generate-key)))
;;;###autoload
@@ -623,8 +625,9 @@ To force-start a server, do \\[server-force-delete] and then
(concat "Unable to start the Emacs server.\n"
(format "There is an existing Emacs server, named %S.\n"
server-name)
- "To start the server in this Emacs process, stop the existing
-server or call `M-x server-force-delete' to forcibly disconnect it.")
+ (substitute-command-keys
+ "To start the server in this Emacs process, stop the existing
+server or call `\\[server-force-delete]' to forcibly disconnect it."))
:warning)
(setq leave-dead t))
;; If this Emacs already had a server, clear out associated status.
@@ -642,8 +645,6 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
(cl-letf (((default-file-modes) ?\700))
(add-hook 'suspend-tty-functions 'server-handle-suspend-tty)
(add-hook 'delete-frame-functions 'server-handle-delete-frame)
- (add-hook 'kill-buffer-query-functions
- 'server-kill-buffer-query-function)
(add-hook 'kill-emacs-query-functions
'server-kill-emacs-query-function)
(add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit.
@@ -652,8 +653,8 @@ server or call `M-x server-force-delete' to forcibly disconnect it.")
:name server-name
:server t
:noquery t
- :sentinel 'server-sentinel
- :filter 'server-process-filter
+ :sentinel #'server-sentinel
+ :filter #'server-process-filter
;; We must receive file names without being decoded.
;; Those are decoded by server-process-filter according
;; to file-name-coding-system. Also don't get
@@ -796,32 +797,33 @@ This handles splitting the command if it would be bigger than
(error "Invalid terminal type"))
(add-to-list 'frame-inherited-parameters 'client)
(let ((frame
- (server-with-environment (process-get proc 'env)
- '("LANG" "LC_CTYPE" "LC_ALL"
- ;; For tgetent(3); list according to ncurses(3).
- "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
- "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
- "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
- "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)))))))
+ (server-with-environment
+ (process-get proc 'env)
+ '("LANG" "LC_CTYPE" "LC_ALL"
+ ;; For tgetent(3); list according to ncurses(3).
+ "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES"
+ "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING"
+ "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO"
+ "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)))))))
;; ttys don't use the `display' parameter, but callproc.c does to set
;; the DISPLAY environment on subprocesses.
@@ -840,9 +842,6 @@ This handles splitting the command if it would be bigger than
(w (or (cdr (assq 'window-system parameters))
(window-system-for-display display))))
- (unless (assq w window-system-initialization-alist)
- (setq w nil))
-
;; Special case for ns. This is because DISPLAY may not be set at all
;; which in the ns case isn't an error. The variable display then becomes
;; the fully qualified hostname, which make-frame-on-display below
@@ -850,7 +849,12 @@ This handles splitting the command if it would be bigger than
;; It may also be a valid X display, but if Emacs is compiled for ns, it
;; can not make X frames.
(if (featurep 'ns-win)
- (setq w 'ns display "ns"))
+ (setq w 'ns display "ns")
+ ;; FIXME! Not sure what this was for, and not sure how it should work
+ ;; in the cl-defmethod new world!
+ ;;(unless (assq w window-system-initialization-alist)
+ ;; (setq w nil))
+ )
(cond (w
;; Flag frame as client-created, but use a dummy client.
@@ -1140,9 +1144,12 @@ The following commands are accepted by the client:
;; frame. If running a GUI server, force the frame
;; type to GUI. (Cygwin is perfectly happy with
;; multi-tty support, so don't override the user's
- ;; choice there.)
+ ;; choice there.) In daemon mode on Windows, we can't
+ ;; make tty frames, so force the frame type to GUI
+ ;; there too.
(when (and (eq system-type 'windows-nt)
- (eq window-system 'w32))
+ (or (daemonp)
+ (eq window-system 'w32)))
(push "-window-system" args-left)))
;; -position LINE[:COLUMN]: Set point to the given
@@ -1162,10 +1169,17 @@ The following commands are accepted by the client:
(let ((file (pop args-left)))
(if coding-system
(setq file (decode-coding-string file coding-system)))
+ ;; Allow Cygwin's emacsclient to be used as a file
+ ;; handler on MS-Windows, in which case FILENAME
+ ;; might start with a drive letter.
+ (when (and (eq system-type 'cygwin)
+ (string-match "\\`[A-Za-z]:" file))
+ (setq file (cygwin-convert-file-name-from-windows file)))
(setq file (expand-file-name file dir))
(push (cons file filepos) files)
(server-log (format "New file: %s %s"
- file (or filepos "")) proc))
+ file (or filepos ""))
+ proc))
(setq filepos nil))
;; -eval EXPR: Evaluate a Lisp expression.
@@ -1216,7 +1230,10 @@ The following commands are accepted by the client:
terminal-frame)))))
(setq tty-name nil tty-type nil)
(if display (server-select-display display)))
- ((eq tty-name 'window-system)
+ ((or (and (eq system-type 'windows-nt)
+ (daemonp)
+ (setq display "w32"))
+ (eq tty-name 'window-system))
(server-create-window-system-frame display nowait proc
parent-id
frame-parameters))
@@ -1472,31 +1489,14 @@ specifically for the clients and did not exist before their request for it."
(save-buffer)))
(server-buffer-done (current-buffer))))
-;; Ask before killing a server buffer.
-;; It was suggested to release its client instead,
-;; but I think that is dangerous--the client would proceed
-;; using whatever is on disk in that file. -- rms.
-(defun server-kill-buffer-query-function ()
- "Ask before killing a server buffer."
- (or (not server-buffer-clients)
- (let ((res t))
- (dolist (proc server-buffer-clients)
- (when (and (memq proc server-clients)
- (eq (process-status proc) 'open))
- (setq res nil)))
- res)
- (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
- (buffer-name (current-buffer))))))
-
(defun server-kill-emacs-query-function ()
"Ask before exiting Emacs if it has live clients."
- (or (not server-clients)
- (let (live-client)
- (dolist (proc server-clients)
- (when (memq t (mapcar 'buffer-live-p (process-get
- proc 'buffers)))
- (setq live-client t)))
- live-client)
+ (or (not (let (live-client)
+ (dolist (proc server-clients)
+ (when (memq t (mapcar 'buffer-live-p (process-get
+ proc 'buffers)))
+ (setq live-client t)))
+ live-client))
(yes-or-no-p "This Emacs session has clients; exit anyway? ")))
(defun server-kill-buffer ()
@@ -1634,7 +1634,7 @@ only these files will be asked to be saved."
(define-key ctl-x-map "#" 'server-edit)
(defun server-unload-function ()
- "Unload the server library."
+ "Unload the Server library."
(server-mode -1)
(substitute-key-definition 'server-edit nil ctl-x-map)
(save-current-buffer
@@ -1648,7 +1648,7 @@ only these files will be asked to be saved."
"Contact the Emacs server named SERVER and evaluate FORM there.
Returns the result of the evaluation, or signals an error if it
cannot contact the specified server. For example:
- \(server-eval-at \"server\" '(emacs-pid))
+ (server-eval-at \"server\" \\='(emacs-pid))
returns the process ID of the Emacs instance running \"server\"."
(let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
(server-file (expand-file-name server server-dir))
diff --git a/lisp/ses.el b/lisp/ses.el
index 5f48dd2f27e..ec1359bbbcb 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1,6 +1,6 @@
-;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*-
+;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*-
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jonathan Yavner <jyavner@member.fsf.org>
;; Maintainer: Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -25,8 +25,18 @@
;;; To-do list:
+;; * M-w should deactivate the mark.
+;; * offer some way to use absolute cell addressing.
+;; * Maybe some way to copy a reference to a cell's formula rather than the
+;; formula itself.
;; * split (catch 'cycle ...) call back into one or more functions
;; * Use $ or … for truncated fields
+;; * M-t to transpose 2 columns.
+;; * M-d should kill the cell under point.
+;; * C-t to transpose 2 rows.
+;; * C-k and M-k should be ses-kill-row and ses-kill-column.
+;; * C-o should insert the row below point rather than above?
+;; * rows inserted with C-o should inherit formulas from surrounding rows.
;; * Add command to make a range of columns be temporarily invisible.
;; * Allow paste of one cell to a range of cells -- copy formula to each.
;; * Do something about control characters & octal codes in cell print
@@ -56,6 +66,7 @@
;;; Code:
(require 'unsafep)
+(require 'macroexp)
(eval-when-compile (require 'cl-lib))
@@ -67,6 +78,7 @@
"Simple Emacs Spreadsheet."
:tag "SES"
:group 'applications
+ :link '(custom-manual "(ses) Top")
:prefix "ses-"
:version "21.1")
@@ -160,7 +172,7 @@ Each function is called with ARG=1."
"\C-c\C-s" ses-insert-ses-range
[S-mouse-3] ses-insert-range-click
[C-S-mouse-3] ses-insert-ses-range-click
- "\M-\C-i" lisp-complete-symbol))
+ "\M-\C-i" lisp-complete-symbol)) ; FIXME obsolete
(newmap (make-sparse-keymap)))
(set-keymap-parent newmap minibuffer-local-map)
(while keys
@@ -238,6 +250,10 @@ Each function is called with ARG=1."
"\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n"
"Initial contents for the three-element list at the bottom of the data area.")
+(defconst ses-initial-global-parameters-re
+ "\n( ;Global parameters (these are read first)\n [23] ;SES file-format\n [0-9]+ ;numrows\n [0-9]+ ;numcols\n\\( [0-9]+ ;numlocprn\n\\)?)\n\n"
+ "Match Global parameters for .")
+
(defconst ses-initial-file-trailer
";; Local Variables:\n;; mode: ses\n;; End:\n"
"Initial contents for the file-trailer area at the bottom of the file.")
@@ -276,6 +292,8 @@ default printer and then modify its output.")
'(ses--blank-line ses--cells ses--col-printers
ses--col-widths ses--curcell ses--curcell-overlay
ses--default-printer
+ (ses--local-printer-hashmap . :hashmap)
+ (ses--numlocprn . 0); count of local printers
ses--deferred-narrow ses--deferred-recalc
ses--deferred-write ses--file-format
ses--named-cell-hashmap
@@ -288,8 +306,12 @@ default printer and then modify its output.")
;; an area containing renamed cell is deleted.
ses--renamed-cell-symb-list
;; Global variables that we override
- mode-line-process next-line-add-newlines transient-mark-mode)
- "Buffer-local variables used by SES.")
+ next-line-add-newlines transient-mark-mode)
+ "Buffer-local variables used by SES."))
+
+(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t))
+(ses--metaprogramming
+ `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars)))
(defun ses-set-localvars ()
"Set buffer-local and initialize some SES variables."
@@ -298,11 +320,14 @@ default printer and then modify its output.")
((symbolp x)
(set (make-local-variable x) nil))
((consp x)
- (set (make-local-variable (car x)) (cdr x)))
- (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))))
-
-(eval-when-compile ; silence compiler
- (ses-set-localvars))
+ (cond
+ ((integerp (cdr x))
+ (set (make-local-variable (car x)) (cdr x)))
+ ((eq (cdr x) :hashmap)
+ (set (make-local-variable (car x)) (make-hash-table :test 'eq)))
+ (t (error "Unexpected initializer `%S' in list `ses-localvars' for entry %S"
+ (cdr x) (car x)) ) ))
+ (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))
;;; This variable is documented as being permitted in file-locals:
(put 'ses--symbolic-formulas 'safe-local-variable 'consp)
@@ -310,10 +335,21 @@ default printer and then modify its output.")
(defconst ses-paramlines-plist
'(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3
ses--header-row -2 ses--file-format 1 ses--numrows 2
- ses--numcols 3)
+ ses--numcols 3 ses--numlocprn 4)
"Offsets from 'Global parameters' line to various parameter lines in the
data area of a spreadsheet.")
+(defconst ses-paramfmt-plist
+ '(ses--col-widths "(ses-column-widths %S)"
+ ses--col-printers "(ses-column-printers %S)"
+ ses--default-printer "(ses-default-printer %S)"
+ ses--header-row "(ses-header-row %S)"
+ ses--file-format " %S ;SES file-format"
+ ses--numrows " %S ;numrows"
+ ses--numcols " %S ;numcols"
+ ses--numlocprn " %S ;numlocprn")
+ "Formats of 'Global parameters' various parameters in the data
+area of a spreadsheet.")
;;
;; "Side-effect variables". They are set in one function, altered in
@@ -346,179 +382,113 @@ when to emit a progress message.")
(defmacro ses-get-cell (row col)
"Return the cell structure that stores information about cell (ROW,COL)."
+ (declare (debug t))
`(aref (aref ses--cells ,row) ,col))
-;; We might want to use defstruct here, but cells are explicitly used as
-;; arrays in ses-set-cell, so we'd need to fix this first. --Stef
-(defsubst ses-make-cell (&optional symbol formula printer references
- property-list)
- (vector symbol formula printer references property-list))
+(cl-defstruct (ses-cell
+ (:constructor nil)
+ (:constructor ses-make-cell
+ (&optional symbol formula printer references))
+ (:copier nil)
+ ;; This is treated as an 4-elem array in various places.
+ ;; Mostly in ses-set-cell.
+ (:type vector) ;Not named.
+ (:conc-name ses-cell--))
+ symbol formula printer references properties)
+
+(cl-defstruct (ses--locprn
+ (:constructor)
+ (:constructor ses-make-local-printer-info
+ (def &optional (compiled (ses-local-printer-compile def))
+ (number ses--numlocprn))))
+ def
+ compiled
+ number
+ local-printer-list)
(defmacro ses-cell-symbol (row &optional col)
"From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1."
- `(aref ,(if col `(ses-get-cell ,row ,col) row) 0))
+ (declare (debug t))
+ `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row)))
(put 'ses-cell-symbol 'safe-function t)
(defmacro ses-cell-formula (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that computes its value."
- `(aref ,(if col `(ses-get-cell ,row ,col) row) 1))
-
-(defmacro ses-cell-formula-aset (cell formula)
- "From a CELL set the function that computes its value."
- `(aset ,cell 1 ,formula))
+ (declare (debug t))
+ `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row)))
(defmacro ses-cell-printer (row &optional col)
"From a CELL or a pair (ROW,COL), get the function that prints its value."
- `(aref ,(if col `(ses-get-cell ,row ,col) row) 2))
+ (declare (debug t))
+ `(ses-cell--printer ,(if col `(ses-get-cell ,row ,col) row)))
(defmacro ses-cell-references (row &optional col)
"From a CELL or a pair (ROW,COL), get the list of symbols for cells whose
functions refer to its value."
- `(aref ,(if col `(ses-get-cell ,row ,col) row) 3))
+ (declare (debug t))
+ `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row)))
-(defmacro ses-cell-references-aset (cell references)
- "From a CELL set the list REFERENCES of symbols for cells the
-function of which refer to its value."
- `(aset ,cell 3 ,references))
+(defmacro ses-sym-rowcol (sym)
+ "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result
+is nil if SYM is not a symbol that names a cell."
+ (declare (debug t))
+ `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
+ (if (eq rc :ses-named)
+ (gethash ,sym ses--named-cell-hashmap)
+ rc)))
(defun ses-cell-p (cell)
- "Return non `nil' is CELL is a cell of current buffer."
+ "Return non-nil if CELL is a cell of current buffer."
(and (vectorp cell)
(= (length cell) 5)
(eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell))))
(and (consp rowcol)
(ses-get-cell (car rowcol) (cdr rowcol)))))))
-(defun ses-cell-property-get-fun (property-name cell)
- ;; To speed up property fetching, each time a property is found it is placed
- ;; in the first position. This way, after the first get, the full property
- ;; list needs to be scanned only when the property does not exist for that
- ;; cell.
- (let* ((plist (aref cell 4))
- (ret (plist-member plist property-name)))
- (if ret
- ;; Property was found.
- (let ((val (cadr ret)))
- (if (eq ret plist)
- ;; Property found is already in the first position, so just return
- ;; its value.
- val
- ;; Property is not in the first position, the following will move it
- ;; there before returning its value.
- (let ((next (cddr ret)))
- (if next
- (progn
- (setcdr ret (cdr next))
- (setcar ret (car next)))
- (setcdr (last plist 1) nil)))
- (aset cell 4
- `(,property-name ,val ,@plist))
- val)))))
-
-(defmacro ses-cell-property-get (property-name row &optional col)
- "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL).
+
+(defmacro ses--letref (vars place &rest body)
+ (declare (indent 2) (debug (sexp form &rest body)))
+ (gv-letplace (getter setter) place
+ `(cl-macrolet ((,(nth 0 vars) () ',getter)
+ (,(nth 1 vars) (v) (funcall ',setter v)))
+ ,@body)))
+
+(defmacro ses-cell-property (property-name row &optional col)
+ "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL).
When COL is omitted, CELL=ROW is a cell object. When COL is
present ROW and COL are the integer coordinates of the cell of
interest."
- (declare (debug t))
- `(ses-cell-property-get-fun
- ,property-name
- ,(if col `(ses-get-cell ,row ,col) row)))
-
-(defun ses-cell-property-delq-fun (property-name cell)
- (let ((ret (plist-get (aref cell 4) property-name)))
- (if ret
- (setcdr ret (cddr ret)))))
-
-(defun ses-cell-property-set-fun (property-name property-val cell)
- (let* ((plist (aref cell 4))
- (ret (plist-member plist property-name)))
- (if ret
- (setcar (cdr ret) property-val)
- (aset cell 4 `(,property-name ,property-val ,@plist)))))
-
-(defmacro ses-cell-property-set (property-name property-value row &optional col)
- "From a CELL or a pair (ROW,COL), set the property value of
-the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE."
- (if property-value
- `(ses-cell-property-set-fun ,property-name ,property-value
- ,(if col `(ses-get-cell ,row ,col) row))
- `(ses-cell-property-delq-fun ,property-name
- ,(if col `(ses-get-cell ,row ,col) row))))
-
-(defun ses-cell-property-pop-fun (property-name cell)
- (let* ((plist (aref cell 4))
- (ret (plist-member plist property-name)))
- (if ret
- (prog1 (cadr ret)
- (let ((next (cddr ret)))
- (if next
- (progn
- (setcdr ret (cdr next))
- (setcar ret (car next)))
- (if (eq plist ret)
- (aset cell 4 nil)
- (setcdr (last plist 2) nil))))))))
-
+ (declare (debug t))
+ `(alist-get ,property-name
+ (ses-cell--properties
+ ,(if col `(ses-get-cell ,row ,col) row))))
(defmacro ses-cell-property-pop (property-name row &optional col)
- "From a CELL or a pair (ROW,COL), get and remove the property value of
+ "From a CELL or a pair (ROW,COL), get and remove the property value of
the corresponding cell with name PROPERTY-NAME."
- `(ses-cell-property-pop-fun ,property-name
- ,(if col `(ses-get-cell ,row ,col) row)))
-
-(defun ses-cell-property-get-handle-fun (property-name cell)
- (let* ((plist (aref cell 4))
- (ret (plist-member plist property-name)))
- (if ret
- (if (eq ret plist)
- (cdr ret)
- (let ((val (cadr ret))
- (next (cddr ret)))
- (if next
- (progn
- (setcdr ret (cdr next))
- (setcar ret (car next)))
- (setcdr (last plist 2) nil))
- (setq ret (cons val plist))
- (aset cell 4 (cons property-name ret))
- ret))
- (setq ret (cons nil plist))
- (aset cell 4 (cons property-name ret))
- ret)))
-
-(defmacro ses-cell-property-get-handle (property-name row &optional col)
- "From a CELL or a pair (ROW,COL), get a cons cell whose car is
-the property value of the corresponding cell property with name
-PROPERTY-NAME."
- `(ses-cell-property-get-handle-fun ,property-name
- ,(if col `(ses-get-cell ,row ,col) row)))
-
-
-(defalias 'ses-cell-property-handle-car 'car)
-(defalias 'ses-cell-property-handle-setcar 'setcar)
+ `(ses--letref (pget pset)
+ (alist-get ,property-name
+ (ses-cell--properties
+ ,(if col `(ses-get-cell ,row ,col) row))
+ nil t)
+ (prog1 (pget) (pset nil))))
(defmacro ses-cell-value (row &optional col)
"From a CELL or a pair (ROW,COL), get the current value for that cell."
+ (declare (debug t))
`(symbol-value (ses-cell-symbol ,row ,col)))
(defmacro ses-col-width (col)
"Return the width for column COL."
+ (declare (debug t))
`(aref ses--col-widths ,col))
(defmacro ses-col-printer (col)
"Return the default printer for column COL."
+ (declare (debug t))
`(aref ses--col-printers ,col))
-(defmacro ses-sym-rowcol (sym)
- "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result
-is nil if SYM is not a symbol that names a cell."
- `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
- (if (eq rc :ses-named)
- (gethash ,sym ses--named-cell-hashmap)
- rc)))
-
(defun ses-is-cell-sym-p (sym)
"Check whether SYM point at a cell of this spread sheet."
(let ((rowcol (get sym 'ses-cell)))
@@ -529,14 +499,15 @@ is nil if SYM is not a symbol that names a cell."
(< (cdr rowcol) ses--numcols)
(eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym))))))
-(defmacro ses-cell (sym value formula printer references)
+(defun ses--cell (sym value formula printer references)
"Load a cell SYM from the spreadsheet file. Does not recompute VALUE from
-FORMULA, does not reprint using PRINTER, does not check REFERENCES. This is a
-macro to prevent propagate-on-load viruses. Safety-checking for FORMULA and
-PRINTER are deferred until first use."
+FORMULA, does not reprint using PRINTER, does not check REFERENCES.
+Safety-checking for FORMULA and PRINTER are deferred until first use."
(let ((rowcol (ses-sym-rowcol sym)))
(ses-formula-record formula)
(ses-printer-record printer)
+ (unless (or formula (eq value '*skip*))
+ (setq formula (macroexp-quote value)))
(or (atom formula)
(eq safe-functions t)
(setq formula `(ses-safe-formula ,formula)))
@@ -544,11 +515,32 @@ PRINTER are deferred until first use."
(stringp printer)
(eq safe-functions t)
(setq printer `(ses-safe-printer ,printer)))
- (aset (aref ses--cells (car rowcol))
- (cdr rowcol)
+ (setf (ses-get-cell (car rowcol) (cdr rowcol))
(ses-make-cell sym formula printer references)))
- (set sym value)
- sym)
+ (set sym value))
+
+(defun ses-local-printer-compile (printer)
+ "Convert local printer function into faster printer
+definition."
+ (cond
+ ((functionp printer) printer)
+ ((stringp printer)
+ `(lambda (x) (format ,printer x)))
+ (t (error "Invalid printer %S" printer))))
+
+(defun ses--local-printer (name def)
+ "Define a local printer with name NAME and definition DEF.
+Return the printer info."
+ (or
+ (and (symbolp name)
+ (ses-printer-validate def))
+ (error "Invalid local printer definition"))
+ (and (gethash name ses--local-printer-hashmap)
+ (error "Duplicate printer definition %S" name))
+ (add-to-list 'ses-read-printer-history (symbol-name name))
+ (puthash name
+ (ses-make-local-printer-info (ses-safe-printer def))
+ ses--local-printer-hashmap))
(defmacro ses-column-widths (widths)
"Load the vector of column widths from the spreadsheet file. This is a
@@ -558,7 +550,7 @@ macro to prevent propagate-on-load viruses."
;;To save time later, we also calculate the total width of each line in the
;;print area (excluding the terminating newline)
(setq ses--col-widths widths
- ses--linewidth (apply '+ -1 (mapcar '1+ widths))
+ ses--linewidth (apply #'+ -1 (mapcar #'1+ widths))
ses--blank-line (concat (make-string ses--linewidth ?\s) "\n"))
t)
@@ -570,7 +562,7 @@ them for safety. This is a macro to prevent propagate-on-load viruses."
(dotimes (x ses--numcols)
(aset printers x (ses-safe-printer (aref printers x))))
(setq ses--col-printers printers)
- (mapc 'ses-printer-record printers)
+ (mapc #'ses-printer-record printers)
t)
(defmacro ses-default-printer (def)
@@ -604,23 +596,24 @@ variables `minrow', `maxrow', `mincol', and `maxcol'."
(let ((minrow (car ,min))
(maxrow (car ,max))
(mincol (cdr ,min))
- (maxcol (cdr ,max))
- row col)
+ (maxcol (cdr ,max)))
(if (or (> minrow maxrow) (> mincol maxcol))
(error "Empty range"))
(dotimes (,r (- maxrow minrow -1))
- (setq row (+ ,r minrow))
- (dotimes (,c (- maxcol mincol -1))
- (setq col (+ ,c mincol))
- ,@body))))))
+ (let ((row (+ ,r minrow)))
+ (dotimes (,c (- maxcol mincol -1))
+ (let ((col (+ ,c mincol)))
+ ,@body))))))))
;;Support for coverage testing.
(defmacro 1value (form)
"For code-coverage testing, indicate that FORM is expected to always have
the same value."
+ (declare (debug t))
form)
(defmacro noreturn (form)
"For code-coverage testing, indicate that FORM will always signal an error."
+ (declare (debug t))
form)
@@ -663,9 +656,11 @@ is a vector--if a symbol, the new vector is assigned as the symbol's value."
"Signal an error if PRINTER is not a valid SES cell printer."
(or (not printer)
(stringp printer)
+ ;; printer is a local printer
+ (and (symbolp printer) (gethash printer ses--local-printer-hashmap))
(functionp printer)
(and (stringp (car-safe printer)) (not (cdr printer)))
- (error "Invalid printer function"))
+ (error "Invalid printer function %S" printer))
printer)
(defun ses-printer-record (printer)
@@ -697,20 +692,22 @@ for this spreadsheet."
(intern (concat (ses-column-letter col) (number-to-string (1+ row)))))
(defun ses-decode-cell-symbol (str)
- "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a
- canonical cell name. Does not save match data."
+ "Decode a symbol \"A1\" => (0,0). Return nil if STR is not a
+canonical cell name."
(let (case-fold-search)
(and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str)
(let* ((col-str (match-string-no-properties 1 str))
- (col 0)
- (col-base 1)
- (col-idx (1- (length col-str)))
- (row (1- (string-to-number (match-string-no-properties 2 str)))))
+ (col 0)
+ (col-base 1)
+ (col-idx (1- (length col-str)))
+ (row (1- (string-to-number
+ (match-string-no-properties 2 str)))))
(and (>= row 0)
(progn
(while
(progn
- (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base))
+ (setq col (+ col (* (- (aref col-str col-idx) ?A)
+ col-base))
col-base (* col-base 26)
col-idx (1- col-idx))
(and (>= col-idx 0)
@@ -771,34 +768,47 @@ updated again."
(setq ses--header-hscroll -1))
;;Split this code off into a function to avoid coverage-testing difficulties
-(defun ses-time-check (format arg)
+(defmacro ses--time-check (format &rest args)
"If `ses-start-time' is more than a second ago, call `message' with FORMAT
-and (eval ARG) and reset `ses-start-time' to the current time."
- (when (> (- (float-time) ses-start-time) 1.0)
- (message format (eval arg))
- (setq ses-start-time (float-time)))
- nil)
+and ARGS and reset `ses-start-time' to the current time."
+ `(when (> (- (float-time) ses-start-time) 1.0)
+ (message ,format ,@args)
+ (setq ses-start-time (float-time))))
;;----------------------------------------------------------------------------
;; The cells
;;----------------------------------------------------------------------------
-(defun ses-set-cell (row col field val)
+(defmacro ses-set-cell (row col field val)
"Install VAL as the contents for field FIELD (named by a quoted symbol) of
cell (ROW,COL). This is undoable. The cell's data will be updated through
`post-command-hook'."
- (let ((cell (ses-get-cell row col))
- (elt (plist-get '(value t symbol 0 formula 1 printer 2 references 3)
- field))
- change)
- (or elt (signal 'args-out-of-range nil))
- (setq change (if (eq elt t)
- (ses-set-with-undo (ses-cell-symbol cell) val)
- (ses-aset-with-undo cell elt val)))
- (if change
- (add-to-list 'ses--deferred-write (cons row col))))
- nil) ; Make coverage-tester happy.
+ `(let ((row ,row)
+ (col ,col)
+ (val ,val))
+ (let* ((cell (ses-get-cell row col))
+ (change
+ ,(let ((field (progn (cl-assert (eq (car field) 'quote))
+ (cadr field))))
+ (if (eq field 'value)
+ `(ses-set-with-undo (ses-cell-symbol cell) val)
+ ;; (let* ((slots (get 'ses-cell 'cl-struct-slots))
+ ;; (slot (or (assq field slots)
+ ;; (error "Unknown field %S" field)))
+ ;; (idx (- (length slots)
+ ;; (length (memq slot slots)))))
+ ;; `(ses-aset-with-undo cell ,idx val))
+ (let ((getter (intern-soft (format "ses-cell--%s" field))))
+ `(ses-setter-with-undo
+ (eval-when-compile
+ (cons #',getter
+ (lambda (newval cell)
+ (setf (,getter cell) newval))))
+ val cell))))))
+ (if change
+ (add-to-list 'ses--deferred-write (cons row col))))
+ nil)) ; Make coverage-tester happy.
(defun ses-cell-set-formula (row col formula)
"Store a new formula for (ROW . COL) and enqueue the cell for
@@ -813,7 +823,7 @@ means Emacs will crash if FORMULA contains a circular list."
(newref (ses-formula-references formula))
(inhibit-quit t)
x xrow xcol)
- (add-to-list 'ses--deferred-recalc sym)
+ (cl-pushnew sym ses--deferred-recalc)
;;Delete old references from this cell. Skip the ones that are also
;;in the new list.
(dolist (ref oldref)
@@ -844,11 +854,11 @@ means Emacs will crash if FORMULA contains a circular list."
(dotimes (col ses--numcols)
(let ((references (ses-cell-property-pop :ses-repair-reference
row col)))
- (when references
- (push (list
- (ses-cell-symbol row col)
- :corrupt-property
- references) errors)))))
+ (when references
+ (push (list (ses-cell-symbol row col)
+ :corrupt-property
+ references)
+ errors)))))
;; Step 2, build new.
(dotimes (row ses--numrows)
@@ -858,21 +868,17 @@ means Emacs will crash if FORMULA contains a circular list."
(formula (ses-cell-formula cell))
(new-ref (ses-formula-references formula)))
(dolist (ref new-ref)
- (let* ((rowcol (ses-sym-rowcol ref))
- (h (ses-cell-property-get-handle :ses-repair-reference
- (car rowcol) (cdr rowcol))))
- (unless (memq ref (ses-cell-property-handle-car h))
- (ses-cell-property-handle-setcar
- h
- (cons sym
- (ses-cell-property-handle-car h)))))))))
+ (let ((rowcol (ses-sym-rowcol ref)))
+ (cl-pushnew sym (ses-cell-property :ses-repair-reference
+ (car rowcol)
+ (cdr rowcol))))))))
;; Step 3, overwrite with check.
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
(let* ((cell (ses-get-cell row col))
(irrelevant (ses-cell-references cell))
- (new-ref (ses-cell-property-pop :ses-repair-reference cell))
+ (new-ref (ses-cell-property-pop :ses-repair-reference cell))
missing)
(dolist (ref new-ref)
(if (memq ref irrelevant)
@@ -885,7 +891,7 @@ means Emacs will crash if FORMULA contains a circular list."
,@(and irrelevant (list :irrelevant irrelevant)))
errors)))))
(if errors
- (warn "----------------------------------------------------------------
+ (warn "----------------------------------------------------------------
Some references were corrupted.
The following is a list where each element ELT is such
@@ -916,17 +922,12 @@ the old and FORCE is nil."
(let ((oldval (ses-cell-value cell))
(formula (ses-cell-formula cell))
newval
- this-cell-Dijkstra-attempt-h
- this-cell-Dijkstra-attempt
- this-cell-Dijkstra-attempt+1
- ref-cell-Dijkstra-attempt-h
- ref-cell-Dijkstra-attempt
- ref-rowcol)
+ this-cell-Dijkstra-attempt+1)
(when (eq (car-safe formula) 'ses-safe-formula)
(setq formula (ses-safe-formula (cadr formula)))
(ses-set-cell row col 'formula formula))
(condition-case sig
- (setq newval (eval formula))
+ (setq newval (eval formula t))
(error
;; Variable `sig' can't be nil.
(nconc sig (list (ses-cell-symbol cell)))
@@ -937,46 +938,42 @@ the old and FORCE is nil."
(setq newval '*skip*))
(catch 'cycle
(when (or force (not (eq newval oldval)))
- (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t.
- (setq this-cell-Dijkstra-attempt-h
- (ses-cell-property-get-handle :ses-Dijkstra-attempt cell);
- this-cell-Dijkstra-attempt
- (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h))
- (if (null this-cell-Dijkstra-attempt)
- (ses-cell-property-handle-setcar
- this-cell-Dijkstra-attempt-h
- (setq this-cell-Dijkstra-attempt
- (cons ses--Dijkstra-attempt-nb 0)))
- (unless (= ses--Dijkstra-attempt-nb
- (car this-cell-Dijkstra-attempt))
- (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
- (setcdr this-cell-Dijkstra-attempt 0)))
- (setq this-cell-Dijkstra-attempt+1
- (1+ (cdr this-cell-Dijkstra-attempt)))
+ (cl-pushnew (cons row col) ses--deferred-write :test #'equal) ; In case force=t.
+ (ses--letref (pget pset)
+ (ses-cell-property :ses-Dijkstra-attempt cell)
+ (let ((this-cell-Dijkstra-attempt (pget)))
+ (if (null this-cell-Dijkstra-attempt)
+ (pset
+ (setq this-cell-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb 0)))
+ (unless (= ses--Dijkstra-attempt-nb
+ (car this-cell-Dijkstra-attempt))
+ (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
+ (setcdr this-cell-Dijkstra-attempt 0)))
+ (setq this-cell-Dijkstra-attempt+1
+ (1+ (cdr this-cell-Dijkstra-attempt)))))
(ses-set-cell row col 'value newval)
(dolist (ref (ses-cell-references cell))
- (add-to-list 'ses--deferred-recalc ref)
- (setq ref-rowcol (ses-sym-rowcol ref)
- ref-cell-Dijkstra-attempt-h
- (ses-cell-property-get-handle
- :ses-Dijkstra-attempt
- (car ref-rowcol) (cdr ref-rowcol))
- ref-cell-Dijkstra-attempt
- (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h))
-
- (if (null ref-cell-Dijkstra-attempt)
- (ses-cell-property-handle-setcar
- ref-cell-Dijkstra-attempt-h
- (setq ref-cell-Dijkstra-attempt
- (cons ses--Dijkstra-attempt-nb
- this-cell-Dijkstra-attempt+1)))
- (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb)
- (setcdr ref-cell-Dijkstra-attempt
- (max (cdr ref-cell-Dijkstra-attempt)
- this-cell-Dijkstra-attempt+1))
- (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
- (setcdr ref-cell-Dijkstra-attempt
- this-cell-Dijkstra-attempt+1)))
+ (cl-pushnew ref ses--deferred-recalc)
+ (ses--letref (pget pset)
+ (let ((ref-rowcol (ses-sym-rowcol ref)))
+ (ses-cell-property
+ :ses-Dijkstra-attempt
+ (car ref-rowcol) (cdr ref-rowcol)))
+ (let ((ref-cell-Dijkstra-attempt (pget)))
+
+ (if (null ref-cell-Dijkstra-attempt)
+ (pset
+ (setq ref-cell-Dijkstra-attempt
+ (cons ses--Dijkstra-attempt-nb
+ this-cell-Dijkstra-attempt+1)))
+ (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb)
+ (setcdr ref-cell-Dijkstra-attempt
+ (max (cdr ref-cell-Dijkstra-attempt)
+ this-cell-Dijkstra-attempt+1))
+ (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb)
+ (setcdr ref-cell-Dijkstra-attempt
+ this-cell-Dijkstra-attempt+1)))))
(when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound)
;; Update print of this cell.
@@ -1035,7 +1032,7 @@ if the cell's value is unchanged and FORCE is nil."
(when (or (memq ref curlist)
(memq ref ses--deferred-recalc))
;; This cell refers to another that isn't done yet
- (add-to-list 'ses--deferred-recalc this-sym)
+ (cl-pushnew this-sym ses--deferred-recalc :test #'equal)
(throw 'ref t)))))
;; ses-update-cells is called from post-command-hook, so
;; inhibit-quit is implicitly bound to t.
@@ -1044,7 +1041,7 @@ if the cell's value is unchanged and FORCE is nil."
(error "Quit"))
(ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force)))
(dolist (ref ses--deferred-recalc)
- (add-to-list 'nextlist ref)))
+ (cl-pushnew ref nextlist :test #'equal)))
(when ses--deferred-recalc
;; Just couldn't finish these.
(dolist (x ses--deferred-recalc)
@@ -1071,8 +1068,7 @@ if the cell's value is unchanged and FORCE is nil."
;; is called during a recursive ses-print-cell).
(defun ses-goto-print (row col)
"Move point to print area for cell (ROW,COL)."
- (let ((inhibit-point-motion-hooks t)
- (n 0))
+ (let ((n 0))
(goto-char (point-min))
(forward-line row)
;; Calculate column position.
@@ -1084,23 +1080,36 @@ if the cell's value is unchanged and FORCE is nil."
;; Move point to the bol of next line (for TAB at the last cell).
(forward-char))))
-(defun ses-set-curcell ()
- "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a
+(defun ses--cell-at-pos (pos &optional object)
+ (or (get-text-property pos 'cursor-intangible object)
+ ;; (when (> pos (if object 0 (point-min)))
+ ;; (get-text-property (1- pos) 'cursor-intangible object))
+ ))
+
+(defun ses--curcell (&optional pos)
+ "Return the current cell symbol, or a cons (BEG,END) for a
region, or nil if cursor is not at a cell."
+ (unless pos (setq pos (point)))
(if (or (not mark-active)
deactivate-mark
- (= (region-beginning) (region-end)))
+ (= pos (mark t)))
;; Single cell.
- (setq ses--curcell (get-text-property (point) 'intangible))
+ (ses--cell-at-pos pos)
;; Range.
- (let ((bcell (get-text-property (region-beginning) 'intangible))
- (ecell (get-text-property (1- (region-end)) 'intangible)))
- (when (= (region-end) ses--data-marker)
+ (let* ((re (max pos (mark t)))
+ (bcell (ses--cell-at-pos (min pos (mark t))))
+ (ecell (ses--cell-at-pos (1- re))))
+ (when (= re ses--data-marker)
;; Correct for overflow.
- (setq ecell (get-text-property (- (region-end) 2) 'intangible)))
- (setq ses--curcell (if (and bcell ecell)
- (cons bcell ecell)
- nil))))
+ (setq ecell (ses--cell-at-pos (- (region-end) 2))))
+ (if (and bcell ecell)
+ (cons bcell ecell)
+ nil))))
+
+(defun ses-set-curcell ()
+ "Set `ses--curcell' to the current cell symbol, or a cons (BEG,END) for a
+region, or nil if cursor is not at a cell."
+ (setq ses--curcell (ses--curcell))
nil)
(defun ses-check-curcell (&rest args)
@@ -1122,6 +1131,9 @@ A single cell is appropriate unless some argument is 'needrange."
((memq 'needrange args)
(error "Need a range"))))
+(defvar ses--row)
+(defvar ses--col)
+
(defun ses-print-cell (row col)
"Format and print the value of cell (ROW,COL) to the print area.
Use the cell's printer function. If the cell's new print form is too wide,
@@ -1149,10 +1161,13 @@ preceding cell has spilled over."
(ses-set-cell row col 'printer
(setq printer (ses-safe-printer (cadr printer)))))
;; Print the value.
- (setq text (ses-call-printer (or printer
- (ses-col-printer col)
- ses--default-printer)
- value))
+ (setq text
+ (let ((ses--row row)
+ (ses--col col))
+ (ses-call-printer (or printer
+ (ses-col-printer col)
+ ses--default-printer)
+ value)))
(if (consp ses-call-printer-return)
;; Printer returned an error.
(setq sig ses-call-printer-return))))
@@ -1163,7 +1178,8 @@ preceding cell has spilled over."
((< len width)
;; Fill field to length with spaces.
(setq len (make-string (- width len) ?\s)
- text (if (eq ses-call-printer-return t)
+ text (if (or (stringp value)
+ (eq ses-call-printer-return t))
(concat text len)
(concat len text))))
((> len width)
@@ -1207,11 +1223,10 @@ preceding cell has spilled over."
;; Install the printed result. This is not interruptible.
(let ((inhibit-read-only t)
(inhibit-quit t))
- (let ((inhibit-point-motion-hooks t))
- (delete-region (point) (progn
- (move-to-column (+ (current-column)
- (string-width text)))
- (1+ (point)))))
+ (delete-region (point) (progn
+ (move-to-column (+ (current-column)
+ (string-width text)))
+ (1+ (point))))
;; We use concat instead of inserting separate strings in order to
;; reduce the number of cells in the undo list.
(setq x (concat text (if (< maxcol ses--numcols) " " "\n")))
@@ -1221,13 +1236,15 @@ preceding cell has spilled over."
;; inherit from surrounding text?)
(set-text-properties 0 (length x) nil x)
(insert-and-inherit x)
- (put-text-property startpos (point) 'intangible
+ (put-text-property startpos (point) 'cursor-intangible
(ses-cell-symbol cell))
(when (and (zerop row) (zerop col))
;; Reconstruct special beginning-of-buffer attributes.
(put-text-property (point-min) (point) 'keymap 'ses-mode-print-map)
(put-text-property (point-min) (point) 'read-only 'ses)
- (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)))
+ (put-text-property (point-min) (1+ (point-min))
+ ;; `cursor-intangible' shouldn't be sticky at BOB.
+ 'front-sticky '(read-only keymap))))
(if (= row (1- ses--header-row))
;; This line is part of the header --- force recalc.
(ses-reset-header-string))
@@ -1260,7 +1277,15 @@ printer signaled one (and \"%s\" is used as the default printer), else nil."
(format (car printer) value)
""))
(t
- (setq value (funcall printer (or value "")))
+ (setq value
+ (funcall
+ (or (and (symbolp printer)
+ (let ((locprn (gethash printer
+ ses--local-printer-hashmap)))
+ (and locprn
+ (ses--locprn-compiled locprn))))
+ printer)
+ (or value "")))
(if (stringp value)
value
(or (stringp (car-safe value))
@@ -1286,8 +1311,7 @@ COL=NUMCOLS. Deletes characters if CHANGE < 0. Caller should bind
(ses-goto-print row col)
(when at-end
;; Insert new columns before newline.
- (let ((inhibit-point-motion-hooks t))
- (backward-char 1)))
+ (backward-char 1))
(if blank
(insert blank)
(delete-char (- change))))))
@@ -1301,7 +1325,7 @@ when the width of cell (ROW,COL) has changed."
;;Cell was skipped over - reprint previous
(ses-goto-print row col)
(backward-char 1)
- (let ((rowcol (ses-sym-rowcol (get-text-property (point) 'intangible))))
+ (let ((rowcol (ses-sym-rowcol (ses--cell-at-pos (point)))))
(ses-print-cell (car rowcol) (cdr rowcol)))))
@@ -1321,17 +1345,34 @@ number, COL is the column number for a data cell -- otherwise DEF
is one of the symbols ses--col-widths, ses--col-printers,
ses--default-printer, ses--numrows, or ses--numcols."
(ses-widen)
- (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong.
- (if col
- ;; It's a cell.
- (progn
- (goto-char ses--data-marker)
- (forward-line (+ 1 (* def (1+ ses--numcols)) col)))
- ;; Convert def-symbol to offset.
- (setq def (plist-get ses-paramlines-plist def))
- (or def (signal 'args-out-of-range nil))
+ (if col
+ ;; It's a cell.
+ (progn
+ (goto-char ses--data-marker)
+ (forward-line (+ 1 (* def (1+ ses--numcols)) col)))
+ ;; Convert def-symbol to offset.
+ (setq def (plist-get ses-paramlines-plist def))
+ (or def (signal 'args-out-of-range nil))
+ (goto-char ses--params-marker)
+ (forward-line def)))
+
+(defun ses-file-format-extend-parameter-list (new-file-format)
+ "Extend the global parameters list when file format is updated
+from 2 to 3. This happens when local printer function are added
+to a sheet that was created with SES version 2. This is not
+undoable. Return nil when there was no change, and non nil otherwise."
+ (save-excursion
+ (cond
+ ((and (= ses--file-format 2) (= 3 new-file-format))
+ (ses-set-parameter 'ses--file-format 3)
+ (message "Upgrading from SES-2 to SES-3 file format")
+ (ses-widen)
(goto-char ses--params-marker)
- (forward-line def))))
+ (forward-line (plist-get ses-paramlines-plist 'ses--numlocprn ))
+ (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn)
+ ses--numlocprn)
+ ?\n)
+ t) )))
(defun ses-set-parameter (def value &optional elem)
"Set parameter DEF to VALUE (with undo) and write the value to the data area.
@@ -1342,13 +1383,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE."
;; in case one of them is being changed.
(ses-goto-data def)
(let ((inhibit-read-only t)
- (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
- ses--col-printers "(ses-column-printers %S)"
- ses--default-printer "(ses-default-printer %S)"
- ses--header-row "(ses-header-row %S)"
- ses--file-format " %S ;SES file-format"
- ses--numrows " %S ;numrows"
- ses--numcols " %S ;numcols")
+ (fmt (plist-get ses-paramfmt-plist
def))
oldval)
(if elem
@@ -1374,8 +1409,8 @@ Newlines in the data are escaped."
(with-temp-message " "
(save-excursion
(while ses--deferred-write
- (ses-time-check "Writing... (%d cells left)"
- '(length ses--deferred-write))
+ (ses--time-check "Writing... (%d cells left)"
+ (length ses--deferred-write))
(setq rowcol (pop ses--deferred-write)
row (car rowcol)
col (cdr rowcol)
@@ -1387,24 +1422,17 @@ Newlines in the data are escaped."
(setq formula (cadr formula)))
(if (eq (car-safe printer) 'ses-safe-printer)
(setq printer (cadr printer)))
- ;; This is noticeably faster than (format "%S %S %S %S %S")
- (setq text (concat "(ses-cell "
- (symbol-name sym)
- " "
- (prin1-to-string (symbol-value sym))
- " "
- (prin1-to-string formula)
- " "
- (prin1-to-string printer)
- " "
- (if (atom (ses-cell-references cell))
- "nil"
- (concat "("
- (mapconcat 'symbol-name
- (ses-cell-references cell)
- " ")
- ")"))
- ")"))
+ (setq text (prin1-to-string
+ ;; We could shorten it to (ses-cell SYM VAL) when
+ ;; the other parameters are nil, but in practice most
+ ;; cells have non-nil `references', so it's
+ ;; rather pointless.
+ `(ses-cell ,sym
+ ,(symbol-value sym)
+ ,(unless (equal formula (symbol-value sym))
+ formula)
+ ,printer
+ ,(ses-cell-references cell))))
(ses-goto-data row col)
(delete-region (point) (line-end-position))
(insert text)))
@@ -1421,8 +1449,8 @@ refers to. For recursive calls, RESULT-SO-FAR is the list being
constructed, or t to get a wrong-type-argument error when the
first reference is found."
(if (ses-sym-rowcol formula)
- ;;Entire formula is one symbol
- (add-to-list 'result-so-far formula)
+ ;; Entire formula is one symbol.
+ (cl-pushnew formula result-so-far :test #'equal)
(if (consp formula)
(cond
((eq (car formula) 'ses-range)
@@ -1430,7 +1458,7 @@ first reference is found."
(cdr (funcall 'macroexpand
(list 'ses-range (nth 1 formula)
(nth 2 formula)))))
- (add-to-list 'result-so-far cur)))
+ (cl-pushnew cur result-so-far :test #'equal)))
((null (eq (car formula) 'quote))
;;Recursive call for subformulas
(dolist (cur formula)
@@ -1463,11 +1491,11 @@ by (ROWINCR,COLINCR)."
"Produce a copy of FORMULA where all symbols that refer to cells in row
STARTROW or above, and col STARTCOL or above, are altered by adding ROWINCR
and COLINCR. STARTROW and STARTCOL are 0-based. Example:
- (ses-relocate-formula '(+ A1 B2 D3) 1 2 1 -1)
+ (ses-relocate-formula \\='(+ A1 B2 D3) 1 2 1 -1)
=> (+ A1 B2 C4)
If ROWINCR or COLINCR is negative, references to cells being deleted are
removed. Example:
- (ses-relocate-formula '(+ A1 B2 D3) 0 1 0 -1)
+ (ses-relocate-formula \\='(+ A1 B2 D3) 0 1 0 -1)
=> (+ A1 C3)
Sets `ses-relocate-return' to 'delete if cell-references were removed."
(let (rowcol result)
@@ -1599,8 +1627,8 @@ to each symbol."
;; This cell referred to a cell that's been deleted or is no
;; longer part of the range. We can't fix that now because
;; reference lists cells have been partially updated.
- (add-to-list 'ses--deferred-recalc
- (ses-create-cell-symbol row col)))
+ (cl-pushnew (ses-create-cell-symbol row col)
+ ses--deferred-recalc :test #'equal))
(setq newval (ses-relocate-formula (ses-cell-references mycell)
minrow mincol rowincr colincr))
(ses-set-cell row col 'references newval)
@@ -1672,7 +1700,7 @@ to each symbol."
(let (row col)
(setq ses-start-time (float-time))
(while reform
- (ses-time-check "Fixing ses-ranges... (%d left)" '(length reform))
+ (ses--time-check "Fixing ses-ranges... (%d left)" (length reform))
(setq row (caar reform)
col (cdar reform)
reform (cdr reform))
@@ -1690,36 +1718,30 @@ to each symbol."
(insert-and-inherit "X")
(delete-region (1- (point)) (point))))
-(defun ses-set-with-undo (sym newval)
- "Like set, but undoable. Result is t if value has changed."
- ;; We try to avoid adding redundant entries to the undo list, but this is
- ;; unavoidable for strings because equal ignores text properties and there's
- ;; no easy way to get the whole property list to see if it's different!
- (unless (and (boundp sym)
- (equal (symbol-value sym) newval)
- (not (stringp newval)))
- (push (if (boundp sym)
- `(apply ses-set-with-undo ,sym ,(symbol-value sym))
- `(apply ses-unset-with-undo ,sym))
- buffer-undo-list)
- (set sym newval)
- t))
-
-(defun ses-unset-with-undo (sym)
- "Set SYM to be unbound. This is undoable."
- (when (1value (boundp sym)) ; Always bound, except after a programming error.
- (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list)
- (makunbound sym)))
+(defun ses-setter-with-undo (accessors newval &rest args)
+ "Set a field/variable and record it so it can be undone.
+Result is non-nil if field/variable has changed."
+ (let ((oldval (apply (car accessors) args)))
+ (unless (equal-including-properties oldval newval)
+ (push `(apply ses-setter-with-undo ,accessors ,oldval ,@args)
+ buffer-undo-list)
+ (apply (cdr accessors) newval args)
+ t)))
(defun ses-aset-with-undo (array idx newval)
- "Like `aset', but undoable.
-Result is t if element has changed."
- (unless (equal (aref array idx) newval)
- (push `(apply ses-aset-with-undo ,array ,idx
- ,(aref array idx)) buffer-undo-list)
- (aset array idx newval)
- t))
+ (ses-setter-with-undo (eval-when-compile
+ (cons #'aref
+ (lambda (newval array idx) (aset array idx newval))))
+ newval array idx))
+(defun ses-set-with-undo (sym newval)
+ (ses-setter-with-undo
+ (eval-when-compile
+ (cons (lambda (sym) (if (boundp sym) (symbol-value sym) :ses--unbound))
+ (lambda (newval sym) (if (eq newval :ses--unbound)
+ (makunbound sym)
+ (set sym newval)))))
+ newval sym))
;;----------------------------------------------------------------------------
;; Startup for major mode
@@ -1734,29 +1756,38 @@ Does not execute cell formulas or print functions."
(search-backward ";; Local Variables:\n" nil t)
(backward-list 1)
(setq ses--params-marker (point-marker))
- (let ((params (ignore-errors (read (current-buffer)))))
- (or (and (= (safe-length params) 3)
+ (let* ((params (ignore-errors (read (current-buffer))))
+ (params-len (safe-length params)))
+ (or (and (>= params-len 3)
+ (<= params-len 4)
(numberp (car params))
(numberp (cadr params))
(>= (cadr params) 0)
(numberp (nth 2 params))
- (> (nth 2 params) 0))
+ (> (nth 2 params) 0)
+ (or (<= params-len 3)
+ (let ((numlocprn (nth 3 params)))
+ (and (integerp numlocprn) (>= numlocprn 0)))))
(error "Invalid SES file"))
(setq ses--file-format (car params)
ses--numrows (cadr params)
- ses--numcols (nth 2 params))
+ ses--numcols (nth 2 params)
+ ses--numlocprn (or (nth 3 params) 0))
(when (= ses--file-format 1)
(let (buffer-undo-list) ; This is not undoable.
(ses-goto-data 'ses--header-row)
(insert "(ses-header-row 0)\n")
- (ses-set-parameter 'ses--file-format 2)
- (message "Upgrading from SES-1 file format")))
- (or (= ses--file-format 2)
+ (ses-set-parameter 'ses--file-format 3)
+ (message "Upgrading from SES-1 to SES-2 file format")))
+ (or (<= ses--file-format 3)
(error "This file needs a newer version of the SES library code"))
;; Initialize cell array.
(setq ses--cells (make-vector ses--numrows nil))
(dotimes (row ses--numrows)
- (aset ses--cells row (make-vector ses--numcols nil))))
+ (aset ses--cells row (make-vector ses--numcols nil)))
+ ;; initialize local printer map.
+ (clrhash ses--local-printer-hashmap))
+
;; Skip over print area, which we assume is correct.
(goto-char (point-min))
(forward-line ses--numrows)
@@ -1766,8 +1797,23 @@ Does not execute cell formulas or print functions."
(setq ses--data-marker (point-marker))
(forward-char (1- (length ses-print-data-boundary)))
;; Initialize printer and symbol lists.
- (mapc 'ses-printer-record ses-standard-printer-functions)
- (setq ses--symbolic-formulas nil)
+ (mapc #'ses-printer-record ses-standard-printer-functions)
+ (setq ses--symbolic-formulas nil)
+
+ ;; Load local printer definitions.
+ ;; This must be loaded *BEFORE* cells and column printers because the latter
+ ;; may call them.
+ (save-excursion
+ (forward-line (* ses--numrows (1+ ses--numcols)))
+ (let ((numlocprn ses--numlocprn))
+ (setq ses--numlocprn 0)
+ (dotimes (_ numlocprn)
+ (let ((x (read (current-buffer))))
+ (or (and (looking-at-p "\n")
+ (eq (car-safe x) 'ses-local-printer)
+ (apply #'ses--local-printer (cdr x)))
+ (error "local printer-def error"))
+ (setq ses--numlocprn (1+ ses--numlocprn))))))
;; Load cell definitions.
(dotimes (row ses--numrows)
(dotimes (col ses--numcols)
@@ -1777,9 +1823,11 @@ Does not execute cell formulas or print functions."
(eq (car-safe x) 'ses-cell)
(ses-create-cell-variable sym row col))
(error "Cell-def error"))
- (eval x)))
+ (apply #'ses--cell (cdr x))))
(or (looking-at-p "\n\n")
(error "Missing blank line between rows")))
+ ;; Skip local printer function declaration --- that were already loaded.
+ (forward-line (+ 2 ses--numlocprn))
;; Load global parameters.
(let ((widths (read (current-buffer)))
(n1 (char-after (point)))
@@ -1798,14 +1846,13 @@ Does not execute cell formulas or print functions."
(eq (car-safe head-row) 'ses-header-row)
(= n4 ?\n))
(error "Invalid SES global parameters"))
- (1value (eval widths))
- (1value (eval def-printer))
- (1value (eval printers))
- (1value (eval head-row)))
+ (1value (eval widths t))
+ (1value (eval def-printer t))
+ (1value (eval printers t))
+ (1value (eval head-row t)))
;; Should be back at global-params.
(forward-char 1)
- (or (looking-at-p (replace-regexp-in-string "1" "[0-9]+"
- ses-initial-global-parameters))
+ (or (looking-at-p ses-initial-global-parameters-re)
(error "Problem with column-defs or global-params"))
;; Check for overall newline count in definitions area.
(forward-line 3)
@@ -1821,45 +1868,43 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
`intangible' properties. Sets up highlighting for current cell."
(interactive)
(let ((end (point-min))
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (was-modified (buffer-modified-p))
pos sym)
- (ses-goto-data 0 0) ; Include marker between print-area and data-area.
- (set-text-properties (point) (point-max) nil) ; Delete garbage props.
- (mapc 'delete-overlay (overlays-in (point-min) (point-max)))
- ;; The print area is read-only (except for our special commands) and uses a
- ;; special keymap.
- (put-text-property (point-min) (1- (point)) 'read-only 'ses)
- (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map)
- ;; For the beginning of the buffer, we want the read-only and keymap
- ;; attributes to be inherited from the first character.
- (put-text-property (point-min) (1+ (point-min)) 'front-sticky t)
- ;; Create intangible properties, which also indicate which cell the text
- ;; came from.
- (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
- (dotimes (col ses--numcols)
- (setq pos end
- sym (ses-cell-symbol row col))
- ;; Include skipped cells following this one.
- (while (and (< col (1- ses--numcols))
- (eq (ses-cell-value row (1+ col)) '*skip*))
- (setq end (+ end (ses-col-width col) 1)
- col (1+ col)))
- (setq end (save-excursion
- (goto-char pos)
- (move-to-column (+ (current-column) (- end pos)
- (ses-col-width col)))
- (if (eolp)
- (+ end (ses-col-width col) 1)
- (forward-char)
- (point))))
- (put-text-property pos end 'intangible sym)))
- ;; Adding these properties did not actually alter the text.
- (unless was-modified
- (restore-buffer-modified-p nil)
- (buffer-disable-undo)
- (buffer-enable-undo)))
+ (with-silent-modifications
+ (ses-goto-data 0 0) ; Include marker between print-area and data-area.
+ (set-text-properties (point) (point-max) nil) ; Delete garbage props.
+ (mapc #'delete-overlay (overlays-in (point-min) (point-max)))
+ ;; The print area is read-only (except for our special commands) and
+ ;; uses a special keymap.
+ (put-text-property (point-min) (1- (point)) 'read-only 'ses)
+ (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map)
+ ;; For the beginning of the buffer, we want the read-only and keymap
+ ;; attributes to be inherited from the first character.
+ (put-text-property (point-min) (1+ (point-min))
+ ;; `cursor-intangible' shouldn't be sticky at BOB.
+ 'front-sticky '(read-only keymap))
+ ;; Create intangible properties, which also indicate which cell the text
+ ;; came from.
+ (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..."
+ (dotimes (col ses--numcols)
+ (setq pos end
+ sym (ses-cell-symbol row col))
+ (unless (eq (symbol-value sym) '*skip*)
+ ;; Include skipped cells following this one.
+ (while (and (< col (1- ses--numcols))
+ (eq (ses-cell-value row (1+ col)) '*skip*))
+ (setq end (+ end (ses-col-width col) 1)
+ ;; Beware: Modifying the iteration variable of `dotimes'
+ ;; may or may not affect the iteration!
+ col (1+ col)))
+ (setq end (save-excursion
+ (goto-char pos)
+ (move-to-column (+ (current-column) (- end pos)
+ (ses-col-width col)))
+ (if (eolp)
+ (+ end (ses-col-width col) 1)
+ (forward-char)
+ (point))))
+ (put-text-property pos end 'cursor-intangible sym))))))
;; Create the underlining overlay. It's impossible for (point) to be 2,
;; because column A must be at least 1 column wide.
(setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min))))
@@ -1879,20 +1924,46 @@ Delete overlays, remove special text properties."
;; Delete read-only, keymap, and intangible properties.
(set-text-properties (point-min) (point-max) nil)
;; Delete overlay.
- (mapc 'delete-overlay (overlays-in (point-min) (point-max)))
+ (mapc #'delete-overlay (overlays-in (point-min) (point-max)))
(unless was-modified
(restore-buffer-modified-p nil))))
;;;###autoload
(defun ses-mode ()
"Major mode for Simple Emacs Spreadsheet.
-See \"ses-example.ses\" (in `data-directory') for more info.
-Key definitions:
+When you invoke SES in a new buffer, it is divided into cells
+that you can enter data into. You can navigate the cells with
+the arrow keys and add more cells with the tab key. The contents
+of these cells can be numbers, text, or Lisp expressions. (To
+enter text, enclose it in double quotes.)
+
+In an expression, you can use cell coordinates to refer to the
+contents of another cell. For example, you can sum a range of
+cells with `(+ A1 A2 A3)'. There are specialized functions like
+`ses+' (addition for ranges with empty cells), `ses-average' (for
+performing calculations on cells), and `ses-range' and `ses-select'
+\(for extracting ranges of cells).
+
+Each cell also has a print function that controls how it is
+displayed.
+
+Each SES buffer is divided into a print area and a data area.
+Normally, you can simply use SES to look at and manipulate the print
+area, and let SES manage the data area outside the visible region.
+
+See \"ses-example.ses\" (in `data-directory') for an example
+spreadsheet, and the Info node `(ses)Top.'
+
+In the following, note the separate keymaps for cell editing mode
+and print mode specifications. Key definitions:
+
\\{ses-mode-map}
-These key definitions are active only in the print area (the visible part):
+These key definitions are active only in the print area (the visible
+part):
\\{ses-mode-print-map}
-These are active only in the minibuffer, when entering or editing a formula:
+These are active only in the minibuffer, when entering or editing a
+formula:
\\{ses-mode-edit-map}"
(interactive)
(unless (and (boundp 'ses--deferred-narrow)
@@ -1911,7 +1982,8 @@ These are active only in the minibuffer, when entering or editing a formula:
;; calculation).
indent-tabs-mode nil)
(1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t))
- (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
+ ;; This makes revert impossible if the buffer is read-only.
+ ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t))
(setq header-line-format '(:eval (progn
(when (/= (window-hscroll)
ses--header-hscroll)
@@ -1922,6 +1994,11 @@ These are active only in the minibuffer, when entering or editing a formula:
(window-hscroll))
(ses-create-header-string))
ses--header-string)))
+ (setq-local mode-line-process '(:eval (ses--mode-line-process)))
+ (add-hook 'pre-redisplay-functions #'ses--cursor-sensor-highlight
+ ;; Highlight the cell after moving cursor out of intangible.
+ 'append t)
+ (cursor-intangible-mode 1)
(let ((was-empty (zerop (buffer-size)))
(was-modified (buffer-modified-p)))
(save-excursion
@@ -1986,32 +2063,7 @@ narrows the buffer now."
;; read the local variables at the end of the file. Now it's safe to
;; do the narrowing.
(narrow-to-region (point-min) ses--data-marker)
- (setq ses--deferred-narrow nil))
- ;; Update the mode line.
- (let ((oldcell ses--curcell))
- (ses-set-curcell)
- (unless (eq ses--curcell oldcell)
- (cond
- ((not ses--curcell)
- (setq mode-line-process nil))
- ((atom ses--curcell)
- (setq mode-line-process (list " cell "
- (symbol-name ses--curcell))))
- (t
- (setq mode-line-process (list " range "
- (symbol-name (car ses--curcell))
- "-"
- (symbol-name (cdr ses--curcell))))))
- (force-mode-line-update)))
- ;; Use underline overlay for single-cells only, turn off otherwise.
- (if (listp ses--curcell)
- (move-overlay ses--curcell-overlay 2 2)
- (let ((next (next-single-property-change (point) 'intangible)))
- (move-overlay ses--curcell-overlay (point) (1- next))))
- (when (not (pos-visible-in-window-p))
- ;; Scrolling will happen later.
- (run-with-idle-timer 0.01 nil 'ses-command-hook)
- (setq ses--curcell t)))
+ (setq ses--deferred-narrow nil)))
;; Prevent errors in this post-command-hook from silently erasing the hook!
(error
(unless executing-kbd-macro
@@ -2019,6 +2071,38 @@ narrows the buffer now."
(message "%s" (error-message-string err))))
nil) ; Make coverage-tester happy.
+(defun ses--mode-line-process ()
+ (let ((cmlp (window-parameter nil 'ses--mode-line-process))
+ (curcell (ses--curcell (window-point))))
+ (if (equal curcell (car cmlp))
+ (cdr cmlp)
+ (let ((mlp
+ (cond
+ ((not curcell) nil)
+ ((atom curcell) (list " cell " (symbol-name curcell)))
+ (t
+ (list " range "
+ (symbol-name (car curcell))
+ "-"
+ (symbol-name (cdr curcell)))))))
+ (set-window-parameter nil 'ses--mode-line-process (cons curcell mlp))
+ mlp))))
+
+(defun ses--cursor-sensor-highlight (window)
+ (let ((curcell (ses--curcell))
+ (ol (window-parameter window 'ses--curcell-overlay)))
+ (unless ol
+ (setq ol (make-overlay (point) (point)))
+ (overlay-put ol 'window window)
+ (overlay-put ol 'face 'underline)
+ (set-window-parameter window 'ses--curcell-overlay ol))
+ ;; Use underline overlay for single-cells only, turn off otherwise.
+ (if (listp curcell)
+ (delete-overlay ol)
+ (let* ((pos (window-point window))
+ (next (next-single-property-change pos 'cursor-intangible)))
+ (move-overlay ol pos (1- next))))))
+
(defun ses-create-header-string ()
"Set up `ses--header-string' as the buffer's header line.
Based on the current set of columns and `window-hscroll' position."
@@ -2058,7 +2142,7 @@ Based on the current set of columns and `window-hscroll' position."
(push (propertize (format " [row %d]" ses--header-row)
'display '((height (- 1))))
result))
- (setq ses--header-string (apply 'concat (nreverse result)))))
+ (setq ses--header-string (apply #'concat (nreverse result)))))
;;----------------------------------------------------------------------------
@@ -2086,7 +2170,7 @@ print area if NONARROW is nil."
(widen)
(unless nonarrow
(setq ses--deferred-narrow t))
- (let ((startcell (get-text-property (point) 'intangible))
+ (let ((startcell (ses--cell-at-pos (point)))
(inhibit-read-only t))
(ses-begin-change)
(goto-char (point-min))
@@ -2095,7 +2179,7 @@ print area if NONARROW is nil."
(delete-region (point-min) (point))
;; Insert all blank lines before printing anything, so ses-print-cell can
;; find the data area when inserting or deleting *skip* values for cells.
- (dotimes (row ses--numrows)
+ (dotimes (_ ses--numrows)
(insert-and-inherit ses--blank-line))
(dotimes-with-progress-reporter (row ses--numrows) "Reprinting..."
(if (eq (ses-cell-value row 0) '*skip*)
@@ -2110,6 +2194,14 @@ print area if NONARROW is nil."
(setq ses--Dijkstra-attempt-nb (1+ ses--Dijkstra-attempt-nb)
ses--Dijkstra-weight-bound (* ses--numrows ses--numcols)))
+;; These functions use the variables 'row' and 'col' that are dynamically bound
+;; by ses-print-cell. We define these variables at compile-time to make the
+;; compiler happy.
+;; (defvar row)
+;; (defvar col)
+;; (defvar maxrow)
+;; (defvar maxcol)
+
(defun ses-recalculate-cell ()
"Recalculate and reprint the current cell or range.
@@ -2127,29 +2219,30 @@ to are recalculated first."
(when
(setq cur-rowcol (ses-sym-rowcol ses--curcell)
sig (progn
- (ses-cell-property-set :ses-Dijkstra-attempt
- (cons ses--Dijkstra-attempt-nb 0)
- (car cur-rowcol) (cdr cur-rowcol) )
+ (setf (ses-cell-property :ses-Dijkstra-attempt
+ (car cur-rowcol)
+ (cdr cur-rowcol))
+ (cons ses--Dijkstra-attempt-nb 0))
(ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t)))
(nconc sig (list (ses-cell-symbol (car cur-rowcol)
(cdr cur-rowcol)))))
;; First, recalculate all cells that don't refer to other cells and
;; produce a list of cells with references.
(ses-dorange ses--curcell
- (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col))
+ (ses--time-check "Recalculating... %s" (ses-cell-symbol row col))
(condition-case nil
(progn
;; The t causes an error if the cell has references. If no
;; references, the t will be the result value.
(1value (ses-formula-references (ses-cell-formula row col) t))
- (ses-cell-property-set :ses-Dijkstra-attempt
- (cons ses--Dijkstra-attempt-nb 0)
- row col)
+ (setf (ses-cell-property :ses-Dijkstra-attempt row col)
+ (cons ses--Dijkstra-attempt-nb 0))
(when (setq sig (ses-calculate-cell row col t))
(nconc sig (list (ses-cell-symbol row col)))))
(wrong-type-argument
;; The formula contains a reference.
- (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col))))))
+ (cl-pushnew (ses-cell-symbol row col) ses--deferred-recalc
+ :test #'equal)))))
;; Do the update now, so we can force recalculation.
(let ((x ses--deferred-recalc))
(setq ses--deferred-recalc nil)
@@ -2167,7 +2260,7 @@ to are recalculated first."
(defun ses-recalculate-all ()
"Recalculate and reprint all cells."
(interactive "*")
- (let ((startcell (get-text-property (point) 'intangible))
+ (let ((startcell (ses--cell-at-pos (point)))
(ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows)
(1- ses--numcols)))))
(ses-recalculate-cell)
@@ -2183,9 +2276,11 @@ to are recalculated first."
(when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway
(eq (ses-cell-value row (1+ col)) '*skip*))
;; This cell has spill-over. We'll momentarily pretend the following cell
- ;; has a `t' in it.
- (eval `(let ((,(ses-cell-symbol row (1+ col)) t))
- (ses-print-cell row col)))
+ ;; has a t in it.
+ (cl-progv
+ (list (ses-cell-symbol row (1+ col)))
+ '(t)
+ (ses-print-cell row col))
;; Now remove the *skip*. ses-print-cell is always nil here.
(ses-set-cell row (1+ col) 'value nil)
(1value (ses-print-cell row (1+ col))))))
@@ -2224,7 +2319,7 @@ to are recalculated first."
(insert ses-initial-file-trailer)
(goto-char (point-min)))
;; Create a blank display area.
- (dotimes (row ses--numrows)
+ (dotimes (_ ses--numrows)
(insert ses--blank-line))
(insert ses-print-data-boundary)
(backward-char (1- (length ses-print-data-boundary)))
@@ -2294,16 +2389,23 @@ cell formula was unsafe and user declined confirmation."
(barf-if-buffer-read-only)
(list (car rowcol)
(cdr rowcol)
- (read-from-minibuffer
- (format "Cell %s: " ses--curcell)
- (cons (if (equal initial "\"") "\"\""
- (if (equal initial "(") "()" initial)) 2)
- ses-mode-edit-map
- t ; Convert to Lisp object.
- 'ses-read-cell-history
- (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
- (cadr curval)
- curval))))))
+ (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))
+ nil 'ses-read-string-history curval))
+ (read-from-minibuffer
+ (format "Cell %s: " ses--curcell)
+ (cons (if (equal initial "(") "()" initial) 2)
+ ses-mode-edit-map
+ t ; Convert to Lisp object.
+ 'ses-read-cell-history
+ (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula)
+ (cadr curval)
+ curval)))))))
(when (ses-edit-cell row col newval)
(ses-command-hook) ; Update cell widths before movement.
(dolist (x ses-after-entry-functions)
@@ -2336,7 +2438,7 @@ With prefix, deletes several cells."
(1value (ses-clear-cell-backward (- count)))
(ses-check-curcell)
(ses-begin-change)
- (dotimes (x count)
+ (dotimes (_ count)
(ses-set-curcell)
(let ((rowcol (ses-sym-rowcol ses--curcell)))
(or rowcol (signal 'end-of-buffer nil))
@@ -2351,7 +2453,7 @@ cells."
(1value (ses-clear-cell-forward (- count)))
(ses-check-curcell 'end)
(ses-begin-change)
- (dotimes (x count)
+ (dotimes (_ count)
(backward-char 1) ; Will signal 'beginning-of-buffer if appropriate.
(ses-set-curcell)
(let ((rowcol (ses-sym-rowcol ses--curcell)))
@@ -2363,12 +2465,14 @@ cells."
;;----------------------------------------------------------------------------
(defun ses-read-printer (prompt default)
- "Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'.
-PROMPT should end with \": \". Result is t if operation was canceled."
+ "Common code for functions `ses-read-cell-printer', `ses-read-column-printer',
+`ses-read-default-printer' and `ses-define-local-printer'.
+PROMPT should end with \": \". Result is t if operation was
+canceled."
(barf-if-buffer-read-only)
(if (eq default t)
(setq default "")
- (setq prompt (format "%s [currently %S]: "
+ (setq prompt (format "%s (default %S): "
(substring prompt 0 -2)
default)))
(let ((new (read-from-minibuffer prompt
@@ -2384,6 +2488,7 @@ PROMPT should end with \": \". Result is t if operation was canceled."
(or (not new)
(stringp new)
(stringp (car-safe new))
+ (and (symbolp new) (gethash new ses--local-printer-hashmap))
(ses-warn-unsafe new 'unsafep-function)
(setq new t)))
new))
@@ -2398,21 +2503,20 @@ one argument, or a symbol that names a function of one argument. In the
latter two cases, the function's result should be either a string (will be
right-justified) or a list of one string (will be left-justified)."
(interactive
- (let ((default t)
- x)
+ (let ((default t))
(ses-check-curcell 'range)
;;Default is none if not all cells in range have same printer
(catch 'ses-read-cell-printer
(ses-dorange ses--curcell
- (setq x (ses-cell-printer row col))
- (if (eq (car-safe x) 'ses-safe-printer)
- (setq x (cadr x)))
- (if (eq default t)
- (setq default x)
- (unless (equal default x)
- ;;Range contains differing printer functions
- (setq default t)
- (throw 'ses-read-cell-printer t)))))
+ (let ((x (ses-cell-printer row col)))
+ (if (eq (car-safe x) 'ses-safe-printer)
+ (setq x (cadr x)))
+ (if (eq default t)
+ (setq default x)
+ (unless (equal default x)
+ ;;Range contains differing printer functions
+ (setq default t)
+ (throw 'ses-read-cell-printer t))))))
(list (ses-read-printer (format "Cell %S printer: " ses--curcell)
default))))
(unless (eq newval t)
@@ -2664,7 +2768,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times."
(let ((col (cdr (ses-sym-rowcol ses--curcell))))
(when (/= 32
(char-before (next-single-property-change (point)
- 'intangible)))
+ 'cursor-intangible)))
;; We're already in last nonskipped cell on line. Need to create a
;; new column.
(barf-if-buffer-read-only)
@@ -2691,7 +2795,7 @@ 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 [currently %d]: "
+ (read-from-minibuffer (format "Column %s width (default %d): "
(ses-column-letter col)
(ses-col-width col))
nil ; No initial contents.
@@ -2745,12 +2849,11 @@ SES attributes recording the contents of the cell as of the time of copying."
(when (= end ses--data-marker)
;;Avoid overflow situation
(setq end (1- ses--data-marker)))
- (let* ((inhibit-point-motion-hooks t)
- (x (mapconcat 'ses-copy-region-helper
+ (let* ((x (mapconcat #'ses-copy-region-helper
(extract-rectangle beg (1- end)) "\n")))
(remove-text-properties 0 (length x)
'(read-only t
- intangible t
+ cursor-intangible t
keymap t
front-sticky t)
x)
@@ -2766,8 +2869,8 @@ the corresponding data cell."
(pos 0)
mycell next sym rowcol)
(while pos
- (setq sym (get-text-property pos 'intangible line)
- next (next-single-property-change pos 'intangible line)
+ (setq sym (ses--cell-at-pos pos line)
+ next (next-single-property-change pos 'cursor-intangible line)
rowcol (ses-sym-rowcol sym)
mycell (ses-get-cell (car rowcol) (cdr rowcol)))
(put-text-property pos (or next (length line))
@@ -2930,9 +3033,9 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list."
;; Invalid sexp --- leave it as a string.
(setq val (substring text from to)))
((and (car val) (symbolp (car val)))
- (if (consp arg)
- (setq val (list 'quote (car val))) ; Keep symbol.
- (setq val (substring text from to)))) ; Treat symbol as text.
+ (setq val (if (consp arg)
+ (list 'quote (car val)) ; Keep symbol.
+ (substring text from to)))) ; Treat symbol as text.
(t
(setq val (car val))))
(let ((row (car rowcol))
@@ -2999,7 +3102,7 @@ spot, or error signal if user requests cancel."
(if rowbool (format "%d rows" needrows) "")
(if (and rowbool colbool) " and " "")
(if colbool (format "%d columns" needcols) "")))
- (error "Cancelled"))
+ (error "Canceled"))
(when rowbool
(let (ses--curcell)
(save-excursion
@@ -3051,7 +3154,7 @@ is non-nil. Newlines and tabs in the export text are escaped."
(push "\t" result))
((< row maxrow)
(push "\n" result))))
- (setq result (apply 'concat (nreverse result)))
+ (setq result (apply #'concat (nreverse result)))
(kill-new result)))
@@ -3163,7 +3266,7 @@ With prefix, sorts in REVERSE order."
;;Get key columns and sort them
(dotimes (x (- maxrow minrow -1))
(ses-goto-print (+ minrow x) sorter)
- (setq end (next-single-property-change (point) 'intangible))
+ (setq end (next-single-property-change (point) 'cursor-intangible))
(push (cons (buffer-substring-no-properties (point) end)
(+ minrow x))
keys))
@@ -3257,8 +3360,10 @@ highlighted range in the spreadsheet."
(ses-is-cell-sym-p new-name)
(error "Already a cell name"))
(and (boundp new-name)
- (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? "
- new-name)))
+ (null (yes-or-no-p
+ (format-message
+ "`%S' is already bound outside this buffer, continue? "
+ new-name)))
(error "Already a bound cell name")))
(let* (curcell
(sym (if (ses-cell-p cell)
@@ -3278,29 +3383,31 @@ highlighted range in the spreadsheet."
(if (equal new-rowcol rowcol)
(put new-name 'ses-cell rowcol)
(error "Not a valid name for this cell location"))
- (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
+ (setq ses--named-cell-hashmap
+ (or ses--named-cell-hashmap (make-hash-table :test 'eq)))
(put new-name 'ses-cell :ses-named)
(puthash new-name rowcol ses--named-cell-hashmap))
(push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
- ;; replace name by new name in formula of cells refering to renamed cell
+ ;; Replace name by new name in formula of cells refering to renamed cell.
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
- (ses-cell-formula-aset xcell
- (ses-replace-name-in-formula
- (ses-cell-formula xcell)
- sym
- new-name))))
- ;; replace name by new name in reference list of cells to which renamed cell refers to
+ (setf (ses-cell-formula xcell)
+ (ses-replace-name-in-formula
+ (ses-cell-formula xcell)
+ sym
+ new-name))))
+ ;; Replace name by new name in reference list of cells to which renamed
+ ;; cell refers to.
(dolist (ref (ses-formula-references (ses-cell-formula cell)))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
- (ses-cell-references-aset xcell
- (cons new-name (delq sym
- (ses-cell-references xcell))))))
+ (setf (ses-cell-references xcell)
+ (cons new-name (delq sym
+ (ses-cell-references xcell))))))
(push new-name ses--renamed-cell-symb-list)
(set new-name (symbol-value sym))
- (aset cell 0 new-name)
+ (setf (ses-cell--symbol cell) new-name)
(makunbound sym)
(and curcell (setq ses--curcell new-name))
(let* ((pos (point))
@@ -3311,12 +3418,79 @@ highlighted range in the spreadsheet."
(if (eolp)
(+ pos (ses-col-width col) 1)
(point)))))
- (put-text-property pos end 'intangible new-name))
- ;; update mode line
- (setq mode-line-process (list " cell "
- (symbol-name new-name)))
+ (put-text-property pos end 'cursor-intangible new-name))
+ ;; Update the cell name in the mode-line.
(force-mode-line-update)))
+(defun ses-refresh-local-printer (name _compiled-value) ;FIXME: unused arg?
+ "Refresh printout for all cells which use printer NAME.
+NAME should be the name of a locally defined printer.
+Uses the value COMPILED-VALUE for this printer."
+ (message "Refreshing cells using printer %S" name)
+ (let (new-print)
+ (dotimes (row ses--numrows)
+ (dotimes (col ses--numcols)
+ (let ((cell-printer (ses-cell-printer row col)))
+ (when (eq cell-printer name)
+ (unless new-print
+ (setq new-print t)
+ (ses-begin-change))
+ (ses-print-cell row col)))))))
+
+(defun ses-define-local-printer (name)
+ "Define a local printer with name NAME."
+ (interactive "*SEnter printer name: ")
+ (let* ((cur-printer (gethash name ses--local-printer-hashmap))
+ (default (and (vectorp cur-printer) (ses--locprn-def cur-printer)))
+ create-printer
+ (new-def
+ (ses-read-printer (format "Enter definition of printer %S: " name)
+ default)))
+ (cond
+ ;; cancelled operation => do nothing
+ ((eq new-def t))
+ ;; no change => do nothing
+ ((and (vectorp cur-printer) (equal new-def default)))
+ ;; re-defined printer
+ ((vectorp cur-printer)
+ (setq create-printer 0)
+ (setf (ses--locprn-def cur-printer) new-def)
+ (ses-refresh-local-printer
+ name
+ (setf (ses--locprn-compiled cur-printer)
+ (ses-local-printer-compile new-def))))
+ ;; new definition
+ (t
+ (setq create-printer 1)
+ (puthash name
+ (setq cur-printer
+ (ses-make-local-printer-info new-def))
+ ses--local-printer-hashmap)))
+ (when create-printer
+ (let ((printer-def-text
+ (concat
+ "(ses-local-printer "
+ (symbol-name name)
+ " "
+ (prin1-to-string (ses--locprn-def cur-printer))
+ ")")))
+ (save-excursion
+ (ses-goto-data ses--numrows
+ (ses--locprn-number cur-printer))
+ (let ((inhibit-read-only t))
+ ;; Special undo since it's outside the narrowed buffer.
+ (let (buffer-undo-list)
+ (if (= create-printer 0)
+ (delete-region (point) (line-end-position))
+ (insert ?\n)
+ (backward-char))
+ (insert printer-def-text)
+ (when (= create-printer 1)
+ (ses-file-format-extend-parameter-list 3)
+ (ses-set-parameter 'ses--numlocprn
+ (+ ses--numlocprn create-printer))))))))))
+
+
;;----------------------------------------------------------------------------
;; Checking formulas for safety
;;----------------------------------------------------------------------------
@@ -3326,6 +3500,7 @@ highlighted range in the spreadsheet."
(if (or (stringp printer)
(stringp (car-safe printer))
(not printer)
+ (and (symbolp printer) (gethash printer ses--local-printer-hashmap))
(ses-warn-unsafe printer 'unsafep-function))
printer
'ses-unsafe))
@@ -3355,11 +3530,11 @@ execution anyway. Always returns t if `safe-functions' is t."
;;----------------------------------------------------------------------------
(defun ses--clean-! (&rest x)
- "Clean by `delq' list X from any occurrence of `nil' or `*skip*'."
+ "Clean by `delq' list X from any occurrence of nil or `*skip*'."
(delq nil (delq '*skip* x)))
(defun ses--clean-_ (x y)
- "Clean list X by replacing by Y any occurrence of `nil' or `*skip*'.
+ "Clean list X by replacing by Y any occurrence of nil or `*skip*'.
This will change X by making `setcar' on its cons cells."
(let ((ret x) ret-elt)
@@ -3452,7 +3627,7 @@ Use `math-format-value' as a printer for Calc objects."
(setcdr (last result 2) nil)
(setq result (cdr (nreverse result))))
(unless reorient-x
- (setq result (mapcar 'nreverse result)))
+ (setq result (mapcar #'nreverse result)))
(when transpose
(let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter)
(while result
@@ -3464,7 +3639,7 @@ Use `math-format-value' as a printer for Calc objects."
(cl-flet ((vectorize-*1
(clean result)
- (cons clean (cons (quote 'vec) (apply 'append result))))
+ (cons clean (cons (quote 'vec) (apply #'append result))))
(vectorize-*2
(clean result)
(cons clean (cons (quote 'vec)
@@ -3472,7 +3647,7 @@ Use `math-format-value' as a printer for Calc objects."
(cons clean (cons (quote 'vec) x)))
result)))))
(pcase vectorize
- (`nil (cons clean (apply 'append result)))
+ (`nil (cons clean (apply #'append result)))
(`*1 (vectorize-*1 clean result))
(`*2 (vectorize-*2 clean result))
(`* (funcall (if (cdr result)
@@ -3484,19 +3659,19 @@ Use `math-format-value' as a printer for Calc objects."
"Return ARGS reversed, with the blank elements (nil and *skip*) removed."
(let (result)
(dolist (cur args)
- (unless (memq cur '(nil *skip*))
+ (unless (memq cur '(nil *skip* *error*))
(push cur result)))
result))
(defun ses+ (&rest args)
"Compute the sum of the arguments, ignoring blanks."
- (apply '+ (apply 'ses-delete-blanks args)))
+ (apply #'+ (apply #'ses-delete-blanks args)))
(defun ses-average (list)
"Computes the sum of the numbers in LIST, divided by their length. Blanks
are ignored. Result is always floating-point, even if all args are integers."
- (setq list (apply 'ses-delete-blanks list))
- (/ (float (apply '+ list)) (length list)))
+ (setq list (apply #'ses-delete-blanks list))
+ (/ (float (apply #'+ list)) (length list)))
(defmacro ses-select (fromrange test torange)
"Select cells in FROMRANGE that are `equal' to TEST.
@@ -3505,7 +3680,7 @@ The ranges are macroexpanded but not evaluated so they should be
either (ses-range BEG END) or (list ...). The TEST is evaluated."
(setq fromrange (cdr (macroexpand fromrange))
torange (cdr (macroexpand torange))
- test (eval test))
+ test (eval test t))
(or (= (length fromrange) (length torange))
(error "ses-select: Ranges not same length"))
(let (result)
@@ -3525,25 +3700,19 @@ either (ses-range BEG END) or (list ...). The TEST is evaluated."
;; Standard print functions
;;----------------------------------------------------------------------------
-;; These functions use the variables 'row' and 'col' that are dynamically bound
-;; by ses-print-cell. We define these variables at compile-time to make the
-;; compiler happy.
-(defvar row)
-(defvar col)
-
(defun ses-center (value &optional span fill)
"Print VALUE, centered within column.
FILL is the fill character for centering (default = space).
SPAN indicates how many additional rightward columns to include
in width (default = 0)."
- (let ((printer (or (ses-col-printer col) ses--default-printer))
- (width (ses-col-width col))
+ (let ((printer (or (ses-col-printer ses--col) ses--default-printer))
+ (width (ses-col-width ses--col))
half)
(or fill (setq fill ?\s))
(or span (setq span 0))
(setq value (ses-call-printer printer value))
(dotimes (x span)
- (setq width (+ width 1 (ses-col-width (+ col span (- x))))))
+ (setq width (+ width 1 (ses-col-width (+ ses--col span (- x))))))
;; Set column width.
(setq width (- width (string-width value)))
(if (<= width 0)
@@ -3556,11 +3725,11 @@ in width (default = 0)."
"Print VALUE, centered within the span that starts in the current column
and continues until the next nonblank column.
FILL specifies the fill character (default = space)."
- (let ((end (1+ col)))
+ (let ((end (1+ ses--col)))
(while (and (< end ses--numcols)
- (memq (ses-cell-value row end) '(nil *skip*)))
+ (memq (ses-cell-value ses--row end) '(nil *skip*)))
(setq end (1+ end)))
- (ses-center value (- end col 1) fill)))
+ (ses-center value (- end ses--col 1) fill)))
(defun ses-dashfill (value &optional span)
"Print VALUE centered using dashes.
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 3e7789069f9..4a73690c556 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -1,6 +1,6 @@
;;; shadowfile.el --- automatic file copying
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: comm files
@@ -34,21 +34,22 @@
;; documentation for these functions for information on how and when to use
;; them). After doing this once, everything should be automatic.
-;; The lists of clusters and shadows are saved in a file called .shadows,
-;; so that they can be remembered from one Emacs session to another, even
-;; (as much as possible) if the Emacs session terminates abnormally. The
-;; files needing to be copied are stored in .shadow_todo; if a file cannot
-;; be copied for any reason, it will stay on the list to be tried again
-;; next time. The .shadows file should itself have shadows on all your
-;; accounts so that the information in it is consistent everywhere, but
-;; .shadow_todo is local information and should have no shadows.
+;; The lists of clusters and shadows are saved in a ~/.emacs.d/shadows
+;; (`shadow-info-file') file, so that they can be remembered from one
+;; Emacs session to another, even (as much as possible) if the Emacs
+;; session terminates abnormally. The files needing to be copied are
+;; stored in `shadow-todo-file'; if a file cannot be copied for any
+;; reason, it will stay on the list to be tried again next time. The
+;; `shadow-info-file' file should itself have shadows on all your accounts
+;; so that the information in it is consistent everywhere, but
+;; `shadow-todo-file' is local information and should have no shadows.
;; If you do not want to copy a particular file, you can answer "no" and
;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not
;; want to be asked again, use shadow-cancel, and you will not be asked
;; until you change the file and save it again. If you do not want to
-;; shadow that file ever again, you can edit it out of the .shadows
-;; buffer. Anytime you edit the .shadows buffer, you must type M-x
+;; shadow that file ever again, you can edit it out of the shadows
+;; buffer. Anytime you edit the shadows buffer, you must type M-x
;; shadow-read-files to load in the new information, or your changes will
;; be overwritten!
@@ -106,10 +107,13 @@ files that have been changed and need to be copied to other systems."
:type 'boolean
:group 'shadow)
+;; FIXME in a sense, this changed in 24.4 (addition of locate-user-emacs-file),
+;; but due to the weird way this variable is initialized to nil, it didn't
+;; literally change. Same for shadow-todo-file.
(defcustom shadow-info-file nil
"File to keep shadow information in.
The `shadow-info-file' should be shadowed to all your accounts to
-ensure consistency. Default: ~/.shadows"
+ensure consistency. Default: ~/.emacs.d/shadows"
:type '(choice (const nil) file)
:group 'shadow)
@@ -119,7 +123,7 @@ This means that if a remote system is down, or for any reason you cannot or
decide not to copy your shadow files at the end of one Emacs session, it will
remember and ask you again in your next Emacs session.
This file must NOT be shadowed to any other system, it is host-specific.
-Default: ~/.shadow_todo"
+Default: ~/.emacs.d/shadow_todo"
:type '(choice (const nil) file)
:group 'shadow)
diff --git a/lisp/shell.el b/lisp/shell.el
index 3ca2564b65c..f5cb3215a0a 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1,11 +1,11 @@
;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*-
-;; Copyright (C) 1988, 1993-1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1988, 1993-1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
-;; Maintainer: FSF <emacs-devel@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: processes
;; This file is part of GNU Emacs.
@@ -83,8 +83,8 @@
;; tab completion-at-point Complete filename/command/history
;; m-? comint-dynamic-list-filename-completions
;; List completions in help buffer
-;; m-c-f shell-forward-command Forward a shell command
-;; m-c-b shell-backward-command Backward a shell command
+;; c-c c-f shell-forward-command Forward a shell command
+;; c-c c-b shell-backward-command Backward a shell command
;; dirs Resync the buffer's dir stack
;; shell-dirtrack-mode Turn dir tracking on/off
;; comint-strip-ctrl-m Remove trailing ^Ms from output
@@ -584,6 +584,8 @@ buffer."
(setq shell-dirstack-query
(cond ((string-equal shell "sh") "pwd")
((string-equal shell "ksh") "echo $PWD ~-")
+ ;; Bypass any aliases. TODO all shells could use this.
+ ((string-equal shell "bash") "command dirs")
(t "dirs")))
;; Bypass a bug in certain versions of bash.
(when (string-equal shell "bash")
@@ -717,7 +719,7 @@ Otherwise, one argument `-i' is passed to the shell.
;; The buffer's window must be correctly set when we call comint (so
;; that comint sets the COLUMNS env var properly).
- (pop-to-buffer-same-window buffer)
+ (pop-to-buffer buffer)
(unless (comint-check-proc buffer)
(let* ((prog (or explicit-shell-file-name
(getenv "ESHELL") shell-file-name))
@@ -792,8 +794,11 @@ and `shell-pushd-dunique' control the behavior of the relevant command.
Environment variables are expanded, see function `substitute-in-file-name'."
(if shell-dirtrackp
;; We fail gracefully if we think the command will fail in the shell.
- (condition-case nil
- (let ((start (progn (string-match
+;;; (with-demoted-errors "Directory tracker failure: %s"
+ ;; This fails so often that it seems better to just ignore errors (?).
+ ;; Eg even: foo=/tmp; cd $foo is beyond us (bug#17159).
+ (ignore-errors
+ (let ((start (progn (string-match
(concat "^" shell-command-separator-regexp)
str) ; skip whitespace
(match-end 0)))
@@ -825,8 +830,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
(setq start (progn (string-match shell-command-separator-regexp
str end)
;; skip again
- (match-end 0)))))
- (error "Couldn't cd"))))
+ (match-end 0))))))))
(defun shell-unquote-argument (string)
"Remove all kinds of shell quoting from STRING."
@@ -908,7 +912,7 @@ Environment variables are expanded, see function `substitute-in-file-name'."
(cond ((> num (length shell-dirstack))
(message "Directory stack not that deep."))
((= num 0)
- (error (message "Couldn't cd")))
+ (error "Couldn't cd"))
(shell-pushd-dextract
(let ((dir (nth (1- num) shell-dirstack)))
(shell-process-popd arg)
@@ -1015,12 +1019,11 @@ command again."
ds))
(setq i (match-end 0)))
(let ((ds (nreverse ds)))
- (condition-case nil
- (progn (shell-cd (car ds))
- (setq shell-dirstack (cdr ds)
- shell-last-dir (car shell-dirstack))
- (shell-dirstack-message))
- (error (message "Couldn't cd"))))))
+ (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:
@@ -1089,10 +1092,12 @@ Copy Shell environment variable to Emacs: ")))
"Move forward across ARG shell command(s). Does not cross lines.
See `shell-command-regexp'."
(interactive "p")
- (let ((limit (line-end-position)))
- (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
- limit 'move arg)
- (skip-syntax-backward " "))))
+ (let ((limit (line-end-position))
+ (pt (point)))
+ (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
+ limit 'move arg)
+ (and (/= pt (point))
+ (skip-syntax-backward " " pt))))
(defun shell-backward-command (&optional arg)
@@ -1103,20 +1108,24 @@ See `shell-command-regexp'."
(when (> limit (point))
(setq limit (line-beginning-position)))
(skip-syntax-backward " " limit)
- (if (re-search-backward
- (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
- (progn (goto-char (match-beginning 1))
- (skip-chars-forward ";&|")))))
+ (let ((pt (point)))
+ (if (re-search-backward
+ (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
+ (progn (goto-char (match-beginning 1))
+ (skip-chars-forward ";&|")))
+ (and (/= pt (point))
+ (skip-syntax-forward " " pt)))))
(defun shell-dynamic-complete-command ()
"Dynamically complete the command at point.
This function is similar to `comint-dynamic-complete-filename', except that it
-searches `exec-path' (minus the trailing Emacs library path) for completion
+searches `exec-path' (minus trailing `exec-directory') for completion
candidates. Note that this may not be the same as the shell's idea of the
path.
-Completion is dependent on the value of `shell-completion-execonly', plus
-those that effect file completion.
+Completion is dependent on the value of `shell-completion-execonly',
+`shell-completion-fignore', plus those that affect file completion. See Info
+node `Shell Options'.
Returns t if successful."
(interactive)
@@ -1141,7 +1150,9 @@ Returns t if successful."
(start (if (zerop (length filename)) (point) (match-beginning 0)))
(end (if (zerop (length filename)) (point) (match-end 0)))
(filenondir (file-name-nondirectory filename))
- (path-dirs (cdr (reverse exec-path))) ;FIXME: Why `cdr'?
+ ; why cdr? see `shell-dynamic-complete-command'
+ (path-dirs (append (cdr (reverse exec-path))
+ (if (memq system-type '(windows-nt ms-dos)) '("."))))
(cwd (file-name-as-directory (expand-file-name default-directory)))
(ignored-extensions
(and comint-completion-fignore
diff --git a/lisp/simple.el b/lisp/simple.el
index 6825c41becc..1f2f4fe0444 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1,8 +1,8 @@
;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1993-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -28,6 +28,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
@@ -374,17 +376,30 @@ Other major modes are defined by comparison with this one."
;; Making and deleting lines.
+(defvar self-insert-uses-region-functions nil
+ "Special hook to tell if `self-insert-command' will use the region.
+It must be called via `run-hook-with-args-until-success' with no arguments.
+Any `post-self-insert-command' which consumes the region should
+register a function on this hook so that things like `delete-selection-mode'
+can refrain from consuming the region.")
+
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
-(defun newline (&optional arg)
+(defun newline (&optional arg interactive)
"Insert a newline, and move to left margin of the new line if it's blank.
If option `use-hard-newlines' is non-nil, the newline is marked with the
text-property `hard'.
With ARG, insert that many newlines.
-Call `auto-fill-function' if the current column number is greater
-than the value of `fill-column' and ARG is nil."
- (interactive "*P")
+
+If `electric-indent-mode' is enabled, this indents the final new line
+that it adds, and reindents the preceding line. To just insert
+a newline, use \\[electric-indent-just-newline].
+
+Calls `auto-fill-function' if the current column number is greater
+than the value of `fill-column' and ARG is nil.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*P\np")
(barf-if-buffer-read-only)
;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
;; Set last-command-event to tell self-insert what to insert.
@@ -397,6 +412,7 @@ than the value of `fill-column' and ARG is nil."
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
+ (cl-assert (eq ?\n (char-before)))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
@@ -416,13 +432,22 @@ than the value of `fill-column' and ARG is nil."
(or was-page-start
(move-to-left-margin nil t)))))
(unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc)
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually just want
+ ;; (insert "\n"), so maybe we should do just that, so as to avoid
+ ;; the risk of filling or running abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
(self-insert-command (prefix-numeric-value arg)))
- ;; We first used let-binding to protect the hook, but that was naive
- ;; since add-hook affects the symbol-default value of the variable,
- ;; whereas the let-binding might only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc)))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc nil t)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc t)))
+ (cl-assert (not (member postproc post-self-insert-hook)))
+ (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
nil)
(defun set-hard-newline-properties (from to)
@@ -433,18 +458,27 @@ than the value of `fill-column' and ARG is nil."
(put-text-property from (point) 'rear-nonsticky
(cons 'hard sticky)))))
-(defun open-line (n)
+(declare-function electric-indent-just-newline "electric")
+(defun open-line (n &optional interactive)
"Insert a newline and leave point before it.
-If there is a fill prefix and/or a `left-margin', insert them
-on the new line if the line would have been blank.
-With arg N, insert N newlines."
- (interactive "*p")
+If `electric-indent-mode' is enabled, indent the new line if it's
+not empty.
+If there is a fill prefix and/or a `left-margin', insert them on
+the new line. If the old line would have been blank, insert them
+on the old line as well.
+
+With arg N, insert N newlines.
+A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
+ (interactive "*p\np")
(let* ((do-fill-prefix (and fill-prefix (bolp)))
(do-left-margin (and (bolp) (> (current-left-margin) 0)))
(loc (point-marker))
- ;; Don't expand an abbrev before point.
+ ;; Don't expand an abbrev before point.
(abbrev-mode nil))
- (newline n)
+ (if (and interactive
+ (looking-at-p "[[:space:]]*$"))
+ (electric-indent-just-newline n)
+ (newline n interactive))
(goto-char loc)
(while (> n 0)
(cond ((bolp)
@@ -453,6 +487,7 @@ With arg N, insert N newlines."
(forward-line 1)
(setq n (1- n)))
(goto-char loc)
+ ;; Necessary in case a margin or prefix was inserted.
(end-of-line)))
(defun split-line (&optional arg)
@@ -599,7 +634,7 @@ In some text modes, where TAB inserts a tab, this command indents to the
column specified by the function `current-left-margin'."
(interactive "*")
(delete-horizontal-space t)
- (newline)
+ (newline nil t)
(indent-according-to-mode))
(defun reindent-then-newline-and-indent ()
@@ -629,6 +664,74 @@ column specified by the function `current-left-margin'."
(delete-horizontal-space t))
(indent-according-to-mode)))
+(defcustom read-quoted-char-radix 8
+ "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16."
+ :type '(choice (const 8) (const 10) (const 16))
+ :group 'editing-basics)
+
+(defun read-quoted-char (&optional prompt)
+ "Like `read-char', but do not allow quitting.
+Also, if the first character read is an octal digit,
+we read any number of octal digits and return the
+specified character code. Any nondigit terminates the sequence.
+If the terminator is RET, it is discarded;
+any other terminator is used itself as input.
+
+The optional argument PROMPT specifies a string to use to prompt the user.
+The variable `read-quoted-char-radix' controls which radix to use
+for numeric input."
+ (let ((message-log-max nil)
+ (help-events (delq nil (mapcar (lambda (c) (unless (characterp c) c))
+ help-event-list)))
+ done (first t) (code 0) translated)
+ (while (not done)
+ (let ((inhibit-quit first)
+ ;; Don't let C-h or other help chars get the help
+ ;; message--only help function keys. See bug#16617.
+ (help-char nil)
+ (help-event-list help-events)
+ (help-form
+ "Type the special character you want to use,
+or the octal character code.
+RET terminates the character code and is discarded;
+any other non-digit terminates the character code and is then used as input."))
+ (setq translated (read-key (and prompt (format "%s-" prompt))))
+ (if inhibit-quit (setq quit-flag nil)))
+ (if (integerp translated)
+ (setq translated (char-resolve-modifiers translated)))
+ (cond ((null translated))
+ ((not (integerp translated))
+ (setq unread-command-events
+ (nconc (listify-key-sequence (this-single-command-raw-keys))
+ unread-command-events)
+ done t))
+ ((/= (logand translated ?\M-\^@) 0)
+ ;; Turn a meta-character into a character with the 0200 bit set.
+ (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
+ done t))
+ ((and (<= ?0 translated)
+ (< translated (+ ?0 (min 10 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (<= ?a (downcase translated))
+ (< (downcase translated)
+ (+ ?a -10 (min 36 read-quoted-char-radix))))
+ (setq code (+ (* code read-quoted-char-radix)
+ (+ 10 (- (downcase translated) ?a))))
+ (and prompt (setq prompt (message "%s %c" prompt translated))))
+ ((and (not first) (eq translated ?\C-m))
+ (setq done t))
+ ((not first)
+ (setq unread-command-events
+ (nconc (listify-key-sequence (this-single-command-raw-keys))
+ unread-command-events)
+ done t))
+ (t (setq code translated
+ done t)))
+ (setq first nil))
+ code))
+
(defun quoted-insert (arg)
"Read next input character and insert it.
This is useful for inserting control characters.
@@ -666,6 +769,9 @@ useful for editing binary files."
;; (>= char ?\240)
;; (<= char ?\377))
;; (setq char (unibyte-char-to-multibyte char)))
+ (unless (characterp char)
+ (user-error "%s is not a valid character"
+ (key-description (vector char))))
(if (> arg 0)
(if (eq overwrite-mode 'overwrite-mode-binary)
(delete-char arg)))
@@ -722,55 +828,53 @@ If BACKWARD-ONLY is non-nil, only delete them before point."
(defun just-one-space (&optional n)
"Delete all spaces and tabs around point, leaving one space (or N spaces).
-If N is negative, delete newlines as well, leaving -N spaces."
+If N is negative, delete newlines as well, leaving -N spaces.
+See also `cycle-spacing'."
(interactive "*p")
- (cycle-spacing n nil t))
+ (cycle-spacing n nil 'single-shot))
(defvar cycle-spacing--context nil
"Store context used in consecutive calls to `cycle-spacing' command.
-The first time this function is run, it saves the original point
-position and original spacing around the point in this
-variable.")
-
-(defun cycle-spacing (&optional n preserve-nl-back single-shot)
- "Manipulate spaces around the point in a smart way.
+The first time `cycle-spacing' runs, it saves in this variable:
+its N argument, the original point position, and the original spacing
+around point.")
-When run as an interactive command, the first time it's called
-in a sequence, deletes all spaces and tabs around point leaving
-one (or N spaces). If this does not change content of the
-buffer, skips to the second step:
+(defun cycle-spacing (&optional n preserve-nl-back mode)
+ "Manipulate whitespace around point in a smart way.
+In interactive use, this function behaves differently in successive
+consecutive calls.
-When run for the second time in a sequence, deletes all the
-spaces it has previously inserted.
+The first call in a sequence acts like `just-one-space'.
+It deletes all spaces and tabs around point, leaving one space
+\(or N spaces). N is the prefix argument. If N is negative,
+it deletes newlines as well, leaving -N spaces.
+\(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.)
-When run for the third time, returns the whitespace and point in
-a state encountered when it had been run for the first time.
+The second call in a sequence deletes all spaces.
-For example, if buffer contains \"foo ^ bar\" with \"^\" denoting the
-point, calling `cycle-spacing' command will replace two spaces with
-a single space, calling it again immediately after, will remove all
-spaces, and calling it for the third time will bring two spaces back
-together.
+The third call in a sequence restores the original whitespace (and point).
-If N is negative, delete newlines as well. However, if
-PRESERVE-NL-BACK is t new line characters prior to the point
-won't be removed.
+If MODE is `single-shot', it only performs the first step in the sequence.
+If MODE is `fast' and the first step would not result in any change
+\(i.e., there are exactly (abs N) spaces around point),
+the function goes straight to the second step.
-If SINGLE-SHOT is non-nil, will only perform the first step. In
-other words, it will work just like `just-one-space' command."
+Repeatedly calling the function with different values of N starts a
+new sequence each time."
(interactive "*p")
(let ((orig-pos (point))
(skip-characters (if (and n (< n 0)) " \t\n\r" " \t"))
- (n (abs (or n 1))))
+ (num (abs (or n 1))))
(skip-chars-backward (if preserve-nl-back " \t" skip-characters))
(constrain-to-field nil orig-pos)
(cond
- ;; Command run for the first time or single-shot is non-nil.
- ((or single-shot
+ ;; Command run for the first time, single-shot mode or different argument
+ ((or (eq 'single-shot mode)
(not (equal last-command this-command))
- (not cycle-spacing--context))
+ (not cycle-spacing--context)
+ (not (eq (car cycle-spacing--context) n)))
(let* ((start (point))
- (n (- n (skip-chars-forward " " (+ n (point)))))
+ (num (- num (skip-chars-forward " " (+ num (point)))))
(mid (point))
(end (progn
(skip-chars-forward skip-characters)
@@ -778,12 +882,12 @@ other words, it will work just like `just-one-space' command."
(setq cycle-spacing--context ;; Save for later.
;; Special handling for case where there was no space at all.
(unless (= start end)
- (cons orig-pos (buffer-substring start (point)))))
+ (cons n (cons orig-pos (buffer-substring start (point))))))
;; If this run causes no change in buffer content, delete all spaces,
;; otherwise delete all excess spaces.
- (delete-region (if (and (not single-shot) (zerop n) (= mid end))
+ (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end))
start mid) end)
- (insert (make-string n ?\s))))
+ (insert (make-string num ?\s))))
;; Command run for the second time.
((not (equal orig-pos (point)))
@@ -791,8 +895,8 @@ other words, it will work just like `just-one-space' command."
;; Command run for the third time.
(t
- (insert (cdr cycle-spacing--context))
- (goto-char (car cycle-spacing--context))
+ (insert (cddr cycle-spacing--context))
+ (goto-char (cadr cycle-spacing--context))
(setq cycle-spacing--context nil)))))
(defun beginning-of-buffer (&optional arg)
@@ -801,11 +905,9 @@ With numeric arg N, put point N/10 of the way from the beginning.
If the buffer is narrowed, this command uses the beginning of the
accessible part of the buffer.
-If Transient Mark mode is disabled, leave mark at previous
-position, unless a \\[universal-argument] prefix is supplied.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-min)) is faster."
+Push mark at previous position, unless either a \\[universal-argument] prefix
+is supplied, or Transient Mark mode is enabled and the mark is active."
+ (declare (interactive-only "use `(goto-char (point-min))' instead."))
(interactive "^P")
(or (consp arg)
(region-active-p)
@@ -827,11 +929,9 @@ With numeric arg N, put point N/10 of the way from the end.
If the buffer is narrowed, this command uses the end of the
accessible part of the buffer.
-If Transient Mark mode is disabled, leave mark at previous
-position, unless a \\[universal-argument] prefix is supplied.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster."
+Push mark at previous position, unless either a \\[universal-argument] prefix
+is supplied, or Transient Mark mode is enabled and the mark is active."
+ (declare (interactive-only "use `(goto-char (point-max))' instead."))
(interactive "^P")
(or (consp arg) (region-active-p) (push-mark))
(let ((size (- (point-max) (point-min))))
@@ -867,6 +967,18 @@ instead of deleted."
:group 'killing
:version "24.1")
+(defvar region-extract-function
+ (lambda (delete)
+ (when (region-beginning)
+ (if (eq delete 'delete-only)
+ (delete-region (region-beginning) (region-end))
+ (filter-buffer-substring (region-beginning) (region-end) delete))))
+ "Function to get the region's content.
+Called with one argument DELETE.
+If DELETE is `delete-only', then only delete the region and the return value
+is undefined. If DELETE is nil, just return the content as a string.
+If anything else, delete the region and return its content as a string.")
+
(defun delete-backward-char (n &optional killflag)
"Delete the previous N characters (following if N is negative).
If Transient Mark mode is enabled, the mark is active, and N is 1,
@@ -880,6 +992,7 @@ arg, and KILLFLAG is set if N is explicitly specified.
In Overwrite mode, single character backward deletion may replace
tabs with spaces so as to back over columns, unless point is at
the end of the line."
+ (declare (interactive-only delete-char))
(interactive "p\nP")
(unless (integerp n)
(signal 'wrong-type-argument (list 'integerp n)))
@@ -888,8 +1001,8 @@ the end of the line."
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
;; In Overwrite mode, maybe untabify while deleting
((null (or (null overwrite-mode)
(<= n 0)
@@ -912,6 +1025,7 @@ To disable this, set variable `delete-active-region' to nil.
Optional second arg KILLFLAG non-nil means to kill (save in kill
ring) instead of delete. Interactively, N is the prefix arg, and
KILLFLAG is set if N was explicitly specified."
+ (declare (interactive-only delete-char))
(interactive "p\nP")
(unless (integerp n)
(signal 'wrong-type-argument (list 'integerp n)))
@@ -920,8 +1034,9 @@ KILLFLAG is set if N was explicitly specified."
(= n 1))
;; If a region is active, kill or delete it.
(if (eq delete-active-region 'kill)
- (kill-region (region-beginning) (region-end))
- (delete-region (region-beginning) (region-end))))
+ (kill-region (region-beginning) (region-end) 'region)
+ (funcall region-extract-function 'delete-only)))
+
;; Otherwise, do simple deletion.
(t (delete-char n killflag))))
@@ -931,6 +1046,7 @@ If narrowing is in effect, only uses the accessible part of the buffer.
You probably should not use this function in Lisp programs;
it is usually a mistake for a Lisp function to use any subroutine
that uses or sets the mark."
+ (declare (interactive-only t))
(interactive)
(push-mark (point))
(push-mark (point-max) nil t)
@@ -959,6 +1075,7 @@ What you probably want instead is something like:
(forward-line (1- N))
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))
@@ -1124,15 +1241,21 @@ in *Help* buffer. See also the command `describe-char'."
(interactive "P")
(let* ((char (following-char))
(bidi-fixer
- (cond ((memq char '(?\x202a ?\x202b ?\x202d ?\x202e))
- ;; If the character is one of LRE, LRO, RLE, RLO, it
- ;; will start a directional embedding, which could
- ;; completely disrupt the rest of the line (e.g., RLO
- ;; will display the rest of the line right-to-left).
- ;; So we put an invisible PDF character after these
- ;; characters, to end the embedding, which eliminates
- ;; any effects on the rest of the line.
+ ;; If the character is one of LRE, LRO, RLE, RLO, it will
+ ;; start a directional embedding, which could completely
+ ;; disrupt the rest of the line (e.g., RLO will display the
+ ;; rest of the line right-to-left). So we put an invisible
+ ;; PDF character after these characters, to end the
+ ;; embedding, which eliminates any effects on the rest of
+ ;; the line. For RLE and RLO we also append an invisible
+ ;; LRM, to avoid reordering the following numerical
+ ;; characters. For LRI/RLI/FSI we append a PDI.
+ (cond ((memq char '(?\x202a ?\x202d))
(propertize (string ?\x202c) 'invisible t))
+ ((memq char '(?\x202b ?\x202e))
+ (propertize (string ?\x202c ?\x200e) 'invisible t))
+ ((memq char '(?\x2066 ?\x2067 ?\x2068))
+ (propertize (string ?\x2069) 'invisible t))
;; Strong right-to-left characters cause reordering of
;; the following numerical characters which show the
;; codepoint, so append LRM to countermand that.
@@ -1144,10 +1267,7 @@ in *Help* buffer. See also the command `describe-char'."
(end (point-max))
(pos (point))
(total (buffer-size))
- (percent (if (> total 50000)
- ;; Avoid overflow from multiplying by 100!
- (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
- (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
+ (percent (round (* 100.0 (1- pos)) (max 1 total)))
(hscroll (if (= (window-hscroll) 0)
""
(format " Hscroll=%d" (window-hscroll))))
@@ -1231,7 +1351,7 @@ is a string to insert in the minibuffer before reading.
Such arguments are used as in `read-from-minibuffer'.)"
;; Used for interactive spec `x'.
(read-from-minibuffer prompt initial-contents minibuffer-local-map
- t minibuffer-history))
+ t 'minibuffer-history))
(defun eval-minibuffer (prompt &optional initial-contents)
"Return value of Lisp expression read using the minibuffer.
@@ -1278,13 +1398,12 @@ Return a formatted string which is displayed in the echo area
in addition to the value printed by prin1 in functions which
display the result of expression evaluation."
(if (and (integerp value)
- (or (not (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (eq this-command last-command)
- (if (boundp 'edebug-active) edebug-active)))
+ (or (eq standard-output t)
+ (zerop (prefix-numeric-value current-prefix-arg))))
(let ((char-string
- (if (or (if (boundp 'edebug-active) edebug-active)
- (memq this-command '(eval-last-sexp eval-print-last-sexp)))
- (prin1-char value))))
+ (if (and (characterp value)
+ (char-displayable-p value))
+ (prin1-char value))))
(if char-string
(format " (#o%o, #x%x, %s)" value value char-string)
(format " (#o%o, #x%x)" value value)))))
@@ -1296,8 +1415,11 @@ display the result of expression evaluation."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
+ ;; FIXME: call emacs-lisp-mode?
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)
(add-hook 'completion-at-point-functions
- #'lisp-completion-at-point nil t)
+ #'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
(read-from-minibuffer prompt initial-contents
read-expression-map t
@@ -1307,14 +1429,21 @@ display the result of expression evaluation."
;; for the sake of completion of names like eval-region, eval-buffer.
(defun eval-expression (exp &optional insert-value)
"Evaluate EXP and print value in the echo area.
-When called interactively, read an Emacs Lisp expression and
-evaluate it.
+When called interactively, read an Emacs Lisp expression and evaluate it.
Value is also consed on to front of the variable `values'.
-Optional argument INSERT-VALUE non-nil (interactively,
-with prefix argument) means insert the result into the current buffer
-instead of printing it in the echo area. Truncates long output
-according to the value of the variables `eval-expression-print-length'
-and `eval-expression-print-level'.
+Optional argument INSERT-VALUE non-nil (interactively, with prefix
+argument) means insert the result into the current buffer instead of
+printing it in the echo area.
+
+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,
+however, there is no such truncation. Such a prefix argument
+also causes integers to be printed in several additional formats
+\(octal, hexadecimal, and character).
+
+Runs the hook `eval-expression-minibuffer-setup-hook' on entering the
+minibuffer.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
@@ -1328,20 +1457,26 @@ this command arranges for all errors to enter the debugger."
;; Bind debug-on-error to something unique so that we can
;; detect when evalled code changes it.
(let ((debug-on-error old-value))
- (push (eval exp lexical-binding) values)
+ (push (eval (macroexpand-all exp) lexical-binding) values)
(setq new-value debug-on-error))
;; If evalled code has changed the value of debug-on-error,
;; propagate that change to the global binding.
(unless (eq old-value new-value)
(setq debug-on-error new-value))))
- (let ((print-length eval-expression-print-length)
- (print-level eval-expression-print-level)
+ (let ((print-length (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-length))
+ (print-level (and (not (zerop (prefix-numeric-value insert-value)))
+ eval-expression-print-level))
(deactivate-mark))
(if insert-value
(with-no-warnings
(let ((standard-output (current-buffer)))
- (prin1 (car values))))
+ (prog1
+ (prin1 (car values))
+ (when (zerop (prefix-numeric-value insert-value))
+ (let ((str (eval-expression-print-format (car values))))
+ (if str (princ str)))))))
(prog1
(prin1 (car values) t)
(let ((str (eval-expression-print-format (car values))))
@@ -1404,17 +1539,26 @@ to get different commands to edit and resubmit."
;; add it to the history.
(or (equal newcmd (car command-history))
(setq command-history (cons newcmd command-history)))
- (eval newcmd))
+ (apply #'funcall-interactively
+ (car newcmd)
+ (mapcar (lambda (e) (eval e t)) (cdr newcmd))))
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+
(defvar extended-command-history nil)
+(defvar execute-extended-command--last-typed nil)
(defun read-extended-command ()
"Read command name to invoke in `execute-extended-command'."
(minibuffer-with-setup-hook
(lambda ()
+ (add-hook 'post-self-insert-hook
+ (lambda ()
+ (setq execute-extended-command--last-typed
+ (minibuffer-contents)))
+ nil 'local)
(set (make-local-variable 'minibuffer-default-add-function)
(lambda ()
;; Get a command name at point in the original buffer
@@ -1442,7 +1586,17 @@ to get different commands to edit and resubmit."
;; because "M-x" is a well-known prompt to read a command
;; and it serves as a shorthand for "Extended command: ".
"M-x ")
- obarray 'commandp t nil 'extended-command-history)))
+ (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)))
+ (complete-with-action action obarray string pred)))
+ #'commandp t nil 'extended-command-history)))
(defcustom suggest-key-bindings t
"Non-nil means show the equivalent key-binding when M-x command has one.
@@ -1453,21 +1607,59 @@ If the value is non-nil and not a number, we wait 2 seconds."
(integer :tag "time" 2)
(other :tag "on")))
-(defun execute-extended-command (prefixarg &optional command-name)
+(defun execute-extended-command--shorter-1 (name length)
+ (cond
+ ((zerop length) (list ""))
+ ((equal name "") nil)
+ (t
+ (nconc (mapcar (lambda (s) (concat (substring name 0 1) s))
+ (execute-extended-command--shorter-1
+ (substring name 1) (1- length)))
+ (when (string-match "\\`\\(-\\)?[^-]*" name)
+ (execute-extended-command--shorter-1
+ (substring name (match-end 0)) length))))))
+
+(defun execute-extended-command--shorter (name typed)
+ (let ((candidates '())
+ (max (length typed))
+ (len 1)
+ binding)
+ (while (and (not binding)
+ (progn
+ (unless candidates
+ (setq len (1+ len))
+ (setq candidates (execute-extended-command--shorter-1
+ name len)))
+ ;; Don't show the help message if the binding isn't
+ ;; significantly shorter than the M-x command the user typed.
+ (< len (- max 5))))
+ (let ((candidate (pop candidates)))
+ (when (equal name
+ (car-safe (completion-try-completion
+ candidate obarray 'commandp len)))
+ (setq binding candidate))))
+ binding))
+
+(defun execute-extended-command (prefixarg &optional command-name typed)
;; Based on Fexecute_extended_command in keyboard.c of Emacs.
;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
- "Read function name, then read its arguments and call it.
-
-To pass a numeric argument to the command you are invoking, specify
-the numeric argument to this command.
-
-Noninteractively, the argument PREFIXARG is the prefix argument to
-give to the command you invoke, if it asks for an argument."
- (interactive (list current-prefix-arg (read-extended-command)))
+ "Read a command name, then read the arguments and call the command.
+To pass a prefix argument to the command you are
+invoking, give a prefix argument to `execute-extended-command'."
+ (declare (interactive-only command-execute))
+ ;; FIXME: Remember the actual text typed by the user before completion,
+ ;; so that we don't later on suggest the same shortening.
+ (interactive
+ (let ((execute-extended-command--last-typed nil))
+ (list current-prefix-arg
+ (read-extended-command)
+ execute-extended-command--last-typed)))
;; Emacs<24 calling-convention was with a single `prefixarg' argument.
- (if (null command-name)
- (setq command-name (let ((current-prefix-arg prefixarg)) ; for prompt
- (read-extended-command))))
+ (unless command-name
+ (let ((current-prefix-arg prefixarg) ; for prompt
+ (execute-extended-command--last-typed nil))
+ (setq command-name (read-extended-command))
+ (setq typed execute-extended-command--last-typed)))
(let* ((function (and (stringp command-name) (intern-soft command-name)))
(binding (and suggest-key-bindings
(not executing-kbd-macro)
@@ -1484,19 +1676,34 @@ give to the command you invoke, if it asks for an argument."
(let ((prefix-arg prefixarg))
(command-execute function 'record))
;; If enabled, show which key runs this command.
- (when binding
- ;; But first wait, and skip the message if there is input.
- (let* ((waited
- ;; If this command displayed something in the echo area;
- ;; wait a few seconds, then display our suggestion message.
+ ;; But first wait, and skip the message if there is input.
+ (let* ((waited
+ ;; If this command displayed something in the echo area;
+ ;; wait a few seconds, then display our suggestion message.
+ ;; FIXME: Wait *after* running post-command-hook!
+ ;; FIXME: Don't wait if execute-extended-command--shorter won't
+ ;; find a better answer anyway!
+ (when suggest-key-bindings
(sit-for (cond
((zerop (length (current-message))) 0)
((numberp suggest-key-bindings) suggest-key-bindings)
- (t 2)))))
- (when (and waited (not (consp unread-command-events)))
+ (t 2))))))
+ (when (and waited (not (consp unread-command-events)))
+ (unless (or binding executing-kbd-macro (not (symbolp function))
+ (<= (length (symbol-name function)) 2))
+ ;; There's no binding for CMD. Let's try and find the shortest
+ ;; string to use in M-x.
+ ;; FIXME: Can be slow. Cache it maybe?
+ (while-no-input
+ (setq binding (execute-extended-command--shorter
+ (symbol-name function) typed))))
+ (when binding
(with-temp-message
- (format "You can run the command `%s' with %s"
- function (key-description binding))
+ (format-message "You can run the command `%s' with %s"
+ function
+ (if (stringp binding)
+ (concat "M-x " binding " RET")
+ (key-description binding)))
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))
@@ -1514,39 +1721,44 @@ 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
+ ;; pre-command-hook rather than here!
(prog1 prefix-arg
(setq current-prefix-arg prefix-arg)
- (setq prefix-arg nil)))))
- (and (symbolp cmd)
- (get cmd 'disabled)
- ;; FIXME: Weird calling convention!
- (run-hooks 'disabled-command-function))
- (let ((final cmd))
- (while
- (progn
- (setq final (indirect-function final))
- (if (autoloadp final)
- (setq final (autoload-do-load final cmd)))))
- (cond
- ((arrayp final)
- ;; If requested, place the macro in the command history. For
- ;; other sorts of commands, call-interactively takes care of this.
- (when record-flag
- (push `(execute-kbd-macro ,final ,prefixarg) command-history)
- ;; Don't keep command history around forever.
- (when (and (numberp history-length) (> history-length 0))
- (let ((cell (nthcdr history-length command-history)))
- (if (consp cell) (setcdr cell nil)))))
- (execute-kbd-macro final prefixarg))
- (t
- ;; Pass `cmd' rather than `final', for the backtrace's sake.
- (prog1 (call-interactively cmd record-flag keys)
- (when (and (symbolp cmd)
- (get cmd 'byte-obsolete-info)
- (not (get cmd 'command-execute-obsolete-warned)))
- (put cmd 'command-execute-obsolete-warned t)
- (message "%s" (macroexp--obsolete-warning
- cmd (get cmd 'byte-obsolete-info) "command")))))))))
+ (setq prefix-arg nil)
+ (when current-prefix-arg
+ (prefix-command-update))))))
+ (if (and (symbolp cmd)
+ (get cmd 'disabled)
+ disabled-command-function)
+ ;; FIXME: Weird calling convention!
+ (run-hooks 'disabled-command-function)
+ (let ((final cmd))
+ (while
+ (progn
+ (setq final (indirect-function final))
+ (if (autoloadp final)
+ (setq final (autoload-do-load final cmd)))))
+ (cond
+ ((arrayp final)
+ ;; If requested, place the macro in the command history. For
+ ;; other sorts of commands, call-interactively takes care of this.
+ (when record-flag
+ (push `(execute-kbd-macro ,final ,prefixarg) command-history)
+ ;; Don't keep command history around forever.
+ (when (and (numberp history-length) (> history-length 0))
+ (let ((cell (nthcdr history-length command-history)))
+ (if (consp cell) (setcdr cell nil)))))
+ (execute-kbd-macro final prefixarg))
+ (t
+ ;; Pass `cmd' rather than `final', for the backtrace's sake.
+ (prog1 (call-interactively cmd record-flag keys)
+ (when (and (symbolp cmd)
+ (get cmd 'byte-obsolete-info)
+ (not (get cmd 'command-execute-obsolete-warned)))
+ (put cmd 'command-execute-obsolete-warned t)
+ (message "%s" (macroexp--obsolete-warning
+ cmd (get cmd 'byte-obsolete-info) "command"))))))))))
(defvar minibuffer-history nil
"Default minibuffer history list.
@@ -1577,6 +1789,7 @@ in this use of the minibuffer.")
(defun minibuffer-avoid-prompt (_new _old)
"A point-motion hook for the minibuffer, that moves point out of the prompt."
+ (declare (obsolete cursor-intangible-mode "25.1"))
(constrain-to-field nil (point-max)))
(defcustom minibuffer-history-case-insensitive-variables nil
@@ -1741,7 +1954,9 @@ The argument NABS specifies the absolute history position."
(user-error (if minibuffer-default
"End of defaults; no next item"
"End of history; no default available")))
- (if (> nabs (length (symbol-value minibuffer-history-variable)))
+ (if (> nabs (if (listp (symbol-value minibuffer-history-variable))
+ (length (symbol-value minibuffer-history-variable))
+ 0))
(user-error "Beginning of history; no preceding item"))
(unless (memq last-command '(next-history-element
previous-history-element))
@@ -1785,6 +2000,67 @@ With argument N, it uses the Nth previous element."
(or (zerop n)
(goto-history-element (+ minibuffer-history-position n))))
+(defun next-line-or-history-element (&optional arg)
+ "Move cursor vertically down ARG lines, or to the next history element.
+When point moves over the bottom line of multi-line minibuffer, puts ARGth
+next element of the minibuffer history in the minibuffer."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let* ((old-point (point))
+ ;; Remember the original goal column of possibly multi-line input
+ ;; excluding the length of the prompt on the first line.
+ (prompt-end (minibuffer-prompt-end))
+ (old-column (unless (and (eolp) (> (point) prompt-end))
+ (if (= (line-number-at-pos) 1)
+ (max (- (current-column) (1- prompt-end)) 0)
+ (current-column)))))
+ (condition-case nil
+ (with-no-warnings
+ (next-line arg))
+ (end-of-buffer
+ ;; Restore old position since `line-move-visual' moves point to
+ ;; the end of the line when it fails to go to the next line.
+ (goto-char old-point)
+ (next-history-element arg)
+ ;; Restore the original goal column on the last line
+ ;; of possibly multi-line input.
+ (goto-char (point-max))
+ (when old-column
+ (if (= (line-number-at-pos) 1)
+ (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+ (move-to-column old-column)))))))
+
+(defun previous-line-or-history-element (&optional arg)
+ "Move cursor vertically up ARG lines, or to the previous history element.
+When point moves over the top line of multi-line minibuffer, puts ARGth
+previous element of the minibuffer history in the minibuffer."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (let* ((old-point (point))
+ ;; Remember the original goal column of possibly multi-line input
+ ;; excluding the length of the prompt on the first line.
+ (prompt-end (minibuffer-prompt-end))
+ (old-column (unless (and (eolp) (> (point) prompt-end))
+ (if (= (line-number-at-pos) 1)
+ (max (- (current-column) (1- prompt-end)) 0)
+ (current-column)))))
+ (condition-case nil
+ (with-no-warnings
+ (previous-line arg))
+ (beginning-of-buffer
+ ;; Restore old position since `line-move-visual' moves point to
+ ;; the beginning of the line when it fails to go to the previous line.
+ (goto-char old-point)
+ (previous-history-element arg)
+ ;; Restore the original goal column on the first line
+ ;; of possibly multi-line input.
+ (goto-char (minibuffer-prompt-end))
+ (if old-column
+ (if (= (line-number-at-pos) 1)
+ (move-to-column (+ old-column (1- (minibuffer-prompt-end))))
+ (move-to-column old-column))
+ (goto-char (line-end-position)))))))
+
(defun next-complete-history-element (n)
"Get next history element which completes the minibuffer before the point.
The contents of the minibuffer after the point are deleted, and replaced
@@ -2031,7 +2307,12 @@ as an argument limits undo to changes within the current region."
;; above when checking.
(while (eq (car list) nil)
(setq list (cdr list)))
- (puthash list (if undo-in-region t pending-undo-list)
+ (puthash list
+ ;; Prevent identity mapping. This can happen if
+ ;; consecutive nils are erroneously in undo list.
+ (if (or undo-in-region (eq list pending-undo-list))
+ t
+ pending-undo-list)
undo-equiv-table))
;; Don't specify a position in the undo record for the undo command.
;; Instead, undoing this should move point to where the change is.
@@ -2178,20 +2459,38 @@ Return what remains of the list."
(when (let ((apos (abs pos)))
(or (< apos (point-min)) (> apos (point-max))))
(error "Changes to be undone are outside visible portion of buffer"))
- (if (< pos 0)
- (progn
- (goto-char (- pos))
- (insert string))
- (goto-char pos)
- ;; Now that we record marker adjustments
- ;; (caused by deletion) for undo,
- ;; we should always insert after markers,
- ;; so that undoing the marker adjustments
- ;; put the markers back in the right place.
- (insert string)
- (goto-char pos)))
+ (let (valid-marker-adjustments)
+ ;; Check that marker adjustments which were recorded
+ ;; with the (STRING . POS) record are still valid, ie
+ ;; the markers haven't moved. We check their validity
+ ;; before reinserting the string so as we don't need to
+ ;; mind marker insertion-type.
+ (while (and (markerp (car-safe (car list)))
+ (integerp (cdr-safe (car list))))
+ (let* ((marker-adj (pop list))
+ (m (car marker-adj)))
+ (and (eq (marker-buffer m) (current-buffer))
+ (= pos m)
+ (push marker-adj valid-marker-adjustments))))
+ ;; Insert string and adjust point
+ (if (< pos 0)
+ (progn
+ (goto-char (- pos))
+ (insert string))
+ (goto-char pos)
+ (insert string)
+ (goto-char pos))
+ ;; Adjust the valid marker adjustments
+ (dolist (adj valid-marker-adjustments)
+ (set-marker (car adj)
+ (- (car adj) (cdr adj))))))
;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
(`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
+ (warn "Encountered %S entry in undo list with no matching (TEXT . POS) entry"
+ next)
+ ;; Even though these elements are not expected in the undo
+ ;; list, adjust them to be conservative for the 24.4
+ ;; release. (Bug#16818)
(when (marker-buffer marker)
(set-marker marker
(- marker offset)
@@ -2230,83 +2529,124 @@ are ignored. If BEG and END are nil, all undo elements are used."
(undo-make-selective-list (min beg end) (max beg end))
buffer-undo-list)))
-(defvar undo-adjusted-markers)
+;; The positions given in elements of the undo list are the positions
+;; as of the time that element was recorded to undo history. In
+;; general, subsequent buffer edits render those positions invalid in
+;; the current buffer, unless adjusted according to the intervening
+;; undo elements.
+;;
+;; Undo in region is a use case that requires adjustments to undo
+;; elements. It must adjust positions of elements in the region based
+;; on newer elements not in the region so as they may be correctly
+;; applied in the current buffer. undo-make-selective-list
+;; accomplishes this with its undo-deltas list of adjustments. An
+;; example undo history from oldest to newest:
+;;
+;; buf pos:
+;; 123456789 buffer-undo-list undo-deltas
+;; --------- ---------------- -----------
+;; aaa (1 . 4) (1 . -3)
+;; aaba (3 . 4) N/A (in region)
+;; ccaaba (1 . 3) (1 . -2)
+;; ccaabaddd (7 . 10) (7 . -3)
+;; ccaabdd ("ad" . 6) (6 . 2)
+;; ccaabaddd (6 . 8) (6 . -2)
+;; | |<-- region: "caab", from 2 to 6
+;;
+;; When the user starts a run of undos in region,
+;; undo-make-selective-list is called to create the full list of in
+;; region elements. Each element is adjusted forward chronologically
+;; through undo-deltas to determine if it is in the region.
+;;
+;; In the above example, the insertion of "b" is (3 . 4) in the
+;; buffer-undo-list. The undo-delta (1 . -2) causes (3 . 4) to become
+;; (5 . 6). The next three undo-deltas cause no adjustment, so (5
+;; . 6) is assessed as in the region and placed in the selective list.
+;; Notably, the end of region itself adjusts from "2 to 6" to "2 to 5"
+;; due to the selected element. The "b" insertion is the only element
+;; fully in the region, so in this example undo-make-selective-list
+;; returns (nil (5 . 6)).
+;;
+;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge
+;; case. It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)).
+;; Normally an undo-delta of (6 . 2) would cause positions after 6 to
+;; adjust by 2. However, they shouldn't adjust to less than 6, so (7
+;; . 10) adjusts to (6 . 8) due to the first undo delta.
+;;
+;; More interesting is how to adjust the "ddd" insertion due to the
+;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad".
+;; If the reinsertion was a manual retyping of "ad", then the total
+;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10). However, if
+;; the reinsertion was due to undo, one might expect the first "d"
+;; character would again be a part of the "ddd" text, meaning its
+;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10).
+;;
+;; undo-make-selective-list assumes in this situation that "ad" was a
+;; new edit, even if it was inserted because of an undo.
+;; Consequently, if the user undos in region "8 to 10" of the
+;; "ccaabaddd" buffer, they could be surprised that it becomes
+;; "ccaabad", as though the first "d" became detached from the
+;; original "ddd" insertion. This quirk is a FIXME.
(defun undo-make-selective-list (start end)
"Return a list of undo elements for the region START to END.
-The elements come from `buffer-undo-list', but we keep only
-the elements inside this region, and discard those outside this region.
-If we find an element that crosses an edge of this region,
-we stop and ignore all further elements."
- (let ((undo-list-copy (undo-copy-list buffer-undo-list))
- (undo-list (list nil))
- undo-adjusted-markers
- some-rejected
- undo-elt temp-undo-list delta)
- (while undo-list-copy
- (setq undo-elt (car undo-list-copy))
- (let ((keep-this
- (cond ((and (consp undo-elt) (eq (car undo-elt) t))
- ;; This is a "was unmodified" element.
- ;; Keep it if we have kept everything thus far.
- (not some-rejected))
- (t
- (undo-elt-in-region undo-elt start end)))))
- (if keep-this
- (progn
- (setq end (+ end (cdr (undo-delta undo-elt))))
- ;; Don't put two nils together in the list
- (if (not (and (eq (car undo-list) nil)
- (eq undo-elt nil)))
- (setq undo-list (cons undo-elt undo-list))))
- (if (undo-elt-crosses-region undo-elt start end)
- (setq undo-list-copy nil)
- (setq some-rejected t)
- (setq temp-undo-list (cdr undo-list-copy))
- (setq delta (undo-delta undo-elt))
-
- (when (/= (cdr delta) 0)
- (let ((position (car delta))
- (offset (cdr delta)))
-
- ;; Loop down the earlier events adjusting their buffer
- ;; positions to reflect the fact that a change to the buffer
- ;; isn't being undone. We only need to process those element
- ;; types which undo-elt-in-region will return as being in
- ;; the region since only those types can ever get into the
- ;; output
-
- (while temp-undo-list
- (setq undo-elt (car temp-undo-list))
- (cond ((integerp undo-elt)
- (if (>= undo-elt position)
- (setcar temp-undo-list (- undo-elt offset))))
- ((atom undo-elt) nil)
- ((stringp (car undo-elt))
- ;; (TEXT . POSITION)
- (let ((text-pos (abs (cdr undo-elt)))
- (point-at-end (< (cdr undo-elt) 0 )))
- (if (>= text-pos position)
- (setcdr undo-elt (* (if point-at-end -1 1)
- (- text-pos offset))))))
- ((integerp (car undo-elt))
- ;; (BEGIN . END)
- (when (>= (car undo-elt) position)
- (setcar undo-elt (- (car undo-elt) offset))
- (setcdr undo-elt (- (cdr undo-elt) offset))))
- ((null (car undo-elt))
- ;; (nil PROPERTY VALUE BEG . END)
- (let ((tail (nthcdr 3 undo-elt)))
- (when (>= (car tail) position)
- (setcar tail (- (car tail) offset))
- (setcdr tail (- (cdr tail) offset))))))
- (setq temp-undo-list (cdr temp-undo-list))))))))
- (setq undo-list-copy (cdr undo-list-copy)))
- (nreverse undo-list)))
+The elements come from `buffer-undo-list', but we keep only the
+elements inside this region, and discard those outside this
+region. The elements' positions are adjusted so as the returned
+list can be applied to the current buffer."
+ (let ((ulist buffer-undo-list)
+ ;; A list of position adjusted undo elements in the region.
+ (selective-list (list nil))
+ ;; A list of undo-deltas for out of region undo elements.
+ undo-deltas
+ undo-elt)
+ (while ulist
+ (when undo-no-redo
+ (while (gethash ulist undo-equiv-table)
+ (setq ulist (gethash ulist undo-equiv-table))))
+ (setq undo-elt (car ulist))
+ (cond
+ ((null undo-elt)
+ ;; Don't put two nils together in the list
+ (when (car selective-list)
+ (push nil selective-list)))
+ ((and (consp undo-elt) (eq (car undo-elt) t))
+ ;; This is a "was unmodified" element. Keep it
+ ;; if we have kept everything thus far.
+ (when (not undo-deltas)
+ (push undo-elt selective-list)))
+ ;; Skip over marker adjustments, instead relying
+ ;; on finding them after (TEXT . POS) elements
+ ((markerp (car-safe undo-elt))
+ nil)
+ (t
+ (let ((adjusted-undo-elt (undo-adjust-elt undo-elt
+ undo-deltas)))
+ (if (undo-elt-in-region adjusted-undo-elt start end)
+ (progn
+ (setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
+ (push adjusted-undo-elt selective-list)
+ ;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was
+ ;; kept. primitive-undo may discard them later.
+ (when (and (stringp (car-safe adjusted-undo-elt))
+ (integerp (cdr-safe adjusted-undo-elt)))
+ (let ((list-i (cdr ulist)))
+ (while (markerp (car-safe (car list-i)))
+ (push (pop list-i) selective-list)))))
+ (let ((delta (undo-delta undo-elt)))
+ (when (/= 0 (cdr delta))
+ (push delta undo-deltas)))))))
+ (pop ulist))
+ (nreverse selective-list)))
(defun undo-elt-in-region (undo-elt start end)
"Determine whether UNDO-ELT falls inside the region START ... END.
-If it crosses the edge, we return nil."
+If it crosses the edge, we return nil.
+
+Generally this function is not useful for determining
+whether (MARKER . ADJUSTMENT) undo elements are in the region,
+because markers can be arbitrarily relocated. Instead, pass the
+marker adjustment's corresponding (TEXT . POS) element."
(cond ((integerp undo-elt)
(and (>= undo-elt start)
(<= undo-elt end)))
@@ -2317,19 +2657,10 @@ If it crosses the edge, we return nil."
((stringp (car undo-elt))
;; (TEXT . POSITION)
(and (>= (abs (cdr undo-elt)) start)
- (< (abs (cdr undo-elt)) end)))
+ (<= (abs (cdr undo-elt)) end)))
((and (consp undo-elt) (markerp (car undo-elt)))
- ;; This is a marker-adjustment element (MARKER . ADJUSTMENT).
- ;; See if MARKER is inside the region.
- (let ((alist-elt (assq (car undo-elt) undo-adjusted-markers)))
- (unless alist-elt
- (setq alist-elt (cons (car undo-elt)
- (marker-position (car undo-elt))))
- (setq undo-adjusted-markers
- (cons alist-elt undo-adjusted-markers)))
- (and (cdr alist-elt)
- (>= (cdr alist-elt) start)
- (<= (cdr alist-elt) end))))
+ ;; (MARKER . ADJUSTMENT)
+ (<= start (car undo-elt) end))
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
(let ((tail (nthcdr 3 undo-elt)))
@@ -2344,6 +2675,7 @@ If it crosses the edge, we return nil."
"Test whether UNDO-ELT crosses one edge of that region START ... END.
This assumes we have already decided that UNDO-ELT
is not *inside* the region START...END."
+ (declare (obsolete nil "25.1"))
(cond ((atom undo-elt) nil)
((null (car undo-elt))
;; (nil PROPERTY VALUE BEG . END)
@@ -2355,6 +2687,72 @@ is not *inside* the region START...END."
(and (< (car undo-elt) end)
(> (cdr undo-elt) start)))))
+(defun undo-adjust-elt (elt deltas)
+ "Return adjustment of undo element ELT by the undo DELTAS
+list."
+ (pcase elt
+ ;; POSITION
+ ((pred integerp)
+ (undo-adjust-pos elt deltas))
+ ;; (BEG . END)
+ (`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
+ (undo-adjust-beg-end beg end deltas))
+ ;; (TEXT . POSITION)
+ (`(,(and text (pred stringp)) . ,(and pos (pred integerp)))
+ (cons text (* (if (< pos 0) -1 1)
+ (undo-adjust-pos (abs pos) deltas))))
+ ;; (nil PROPERTY VALUE BEG . END)
+ (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
+ `(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas)))
+ ;; (apply DELTA START END FUN . ARGS)
+ ;; FIXME
+ ;; All others return same elt
+ (_ elt)))
+
+;; (BEG . END) can adjust to the same positions, commonly when an
+;; insertion was undone and they are out of region, for example:
+;;
+;; buf pos:
+;; 123456789 buffer-undo-list undo-deltas
+;; --------- ---------------- -----------
+;; [...]
+;; abbaa (2 . 4) (2 . -2)
+;; aaa ("bb" . 2) (2 . 2)
+;; [...]
+;;
+;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent
+;; undo. Further adjustments to such an element should be the same as
+;; for (TEXT . POSITION) elements. The options are:
+;;
+;; 1: POSITION adjusts using <= (use-< nil), resulting in behavior
+;; analogous to marker insertion-type t.
+;;
+;; 2: POSITION adjusts using <, resulting in behavior analogous to
+;; marker insertion-type nil.
+;;
+;; There was no strong reason to prefer one or the other, except that
+;; the first is more consistent with prior undo in region behavior.
+(defun undo-adjust-beg-end (beg end deltas)
+ "Return cons of adjustments to BEG and END by the undo DELTAS
+list."
+ (let ((adj-beg (undo-adjust-pos beg deltas)))
+ ;; Note: option 2 above would be like (cons (min ...) adj-end)
+ (cons adj-beg
+ (max adj-beg (undo-adjust-pos end deltas t)))))
+
+(defun undo-adjust-pos (pos deltas &optional use-<)
+ "Return adjustment of POS by the undo DELTAS list, comparing
+with < or <= based on USE-<."
+ (dolist (d deltas pos)
+ (when (if use-<
+ (< (car d) pos)
+ (<= (car d) pos))
+ (setq pos
+ ;; Don't allow pos to become less than the undo-delta
+ ;; position. This edge case is described in the overview
+ ;; comments.
+ (max (car d) (- pos (cdr d)))))))
+
;; Return the first affected buffer position and the delta for an undo element
;; delta is defined as the change in subsequent buffer positions if we *did*
;; the undo.
@@ -2412,16 +2810,18 @@ This variable only matters if `undo-ask-before-discard' is non-nil.")
;; but we don't want to ask the question again.
(setq undo-extra-outer-limit (+ size 50000))
(if (let (use-dialog-box track-mouse executing-kbd-macro )
- (yes-or-no-p (format "Buffer `%s' undo info is %d bytes long; discard it? "
- (buffer-name) size)))
+ (yes-or-no-p (format-message
+ "Buffer `%s' undo info is %d bytes long; discard it? "
+ (buffer-name) size)))
(progn (setq buffer-undo-list nil)
(setq undo-extra-outer-limit nil)
t)
nil))
(display-warning '(undo discard-info)
(concat
- (format "Buffer `%s' undo info was %d bytes long.\n"
- (buffer-name) size)
+ (format-message
+ "Buffer `%s' undo info was %d bytes long.\n"
+ (buffer-name) size)
"The undo info was discarded because it exceeded \
`undo-outer-limit'.
@@ -2442,6 +2842,61 @@ which is defined in the `warnings' library.\n")
(setq buffer-undo-list nil)
t))
+(defcustom password-word-equivalents
+ '("password" "passcode" "passphrase" "pass phrase"
+ ; These are sorted according to the GNU en_US locale.
+ "암호" ; ko
+ "パスワード" ; ja
+ "ପ୍ରବେଶ ସଙ୍କେତ" ; or
+ "ពាក្យសម្ងាត់" ; km
+ "adgangskode" ; da
+ "contraseña" ; es
+ "contrasenya" ; ca
+ "geslo" ; sl
+ "hasło" ; pl
+ "heslo" ; cs, sk
+ "iphasiwedi" ; zu
+ "jelszó" ; hu
+ "lösenord" ; sv
+ "lozinka" ; hr, sr
+ "mật khẩu" ; vi
+ "mot de passe" ; fr
+ "parola" ; tr
+ "pasahitza" ; eu
+ "passord" ; nb
+ "passwort" ; de
+ "pasvorto" ; eo
+ "salasana" ; fi
+ "senha" ; pt
+ "slaptažodis" ; lt
+ "wachtwoord" ; nl
+ "كلمة السر" ; ar
+ "ססמה" ; he
+ "лозинка" ; sr
+ "пароль" ; kk, ru, uk
+ "गुप्तशब्द" ; mr
+ "शब्दकूट" ; hi
+ "પાસવર્ડ" ; gu
+ "సంకేతపదము" ; te
+ "ਪਾਸਵਰਡ" ; pa
+ "ಗುಪ್ತಪದ" ; kn
+ "கடவுச்சொல்" ; ta
+ "അടയാളവാക്ക്" ; ml
+ "গুপ্তশব্দ" ; as
+ "পাসওয়ার্ড" ; bn_IN
+ "රහස්පදය" ; si
+ "密码" ; zh_CN
+ "密碼" ; zh_TW
+ )
+ "List of words equivalent to \"password\".
+This is used by Shell mode and other parts of Emacs to recognize
+password prompts, including prompts in languages other than
+English. Different case choices should not be assumed to be
+included; callers should bind `case-fold-search' to t."
+ :type '(repeat string)
+ :version "24.4"
+ :group 'processes)
+
(defvar shell-command-history nil
"History list for some commands that read shell commands.
@@ -2539,6 +2994,12 @@ to execute it asynchronously.
The output appears in the buffer `*Async Shell Command*'.
That buffer is in shell mode.
+You can configure `async-shell-command-buffer' to specify what to do in
+case when `*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*'.
+
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 a
shell (with its need to quote arguments)."
@@ -2697,12 +3158,14 @@ the use of a shell (with its need to quote arguments)."
;; If will create a new buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*")))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*")))
(error "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq buffer (generate-new-buffer
- (or output-buffer "*Async Shell Command*"))))
+ (or (and (bufferp output-buffer) (buffer-name output-buffer))
+ output-buffer "*Async Shell Command*"))))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
@@ -2725,7 +3188,7 @@ the use of a shell (with its need to quote arguments)."
;; which comint sometimes adds for prompts.
(let ((inhibit-read-only t))
(erase-buffer))
- (display-buffer buffer)
+ (display-buffer buffer '(nil (allow-no-window . t)))
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
shell-command-switch command))
@@ -2870,7 +3333,7 @@ display the error buffer if there were any errors. When called
interactively, this is t."
(interactive (let (string)
(unless (mark)
- (error "The mark is not set now, so there is no region"))
+ (user-error "The mark is not set now, so there is no region"))
;; Do this before calling region-beginning
;; and region-end, in case subprocess output
;; relocates them while we are in the minibuffer.
@@ -3014,9 +3477,9 @@ subprocess is `default-directory'.
File names in INFILE and BUFFER are handled normally, but file
names in ARGS should be relative to `default-directory', as they
-are passed to the process verbatim. \(This is a difference to
+are passed to the process verbatim. (This is a difference to
`call-process' which does not support file handlers for INFILE
-and BUFFER.\)
+and BUFFER.)
Some file handlers might not support all variants, for example
they might behave as if DISPLAY was nil, regardless of the actual
@@ -3040,9 +3503,9 @@ value passed."
(defvar process-file-side-effects t
"Whether a call of `process-file' changes remote files.
-By default, this variable is always set to `t', meaning that a
+By default, this variable is always set to t, meaning that a
call of `process-file' could potentially change any file on a
-remote host. When set to `nil', a file handler could optimize
+remote host. When set to nil, a file handler could optimize
its behavior with respect to remote file attribute caching.
You should only ever change this variable with a let-binding;
@@ -3073,10 +3536,15 @@ support pty association, if PROGRAM is nil."
(defvar tabulated-list-sort-key)
(declare-function tabulated-list-init-header "tabulated-list" ())
(declare-function tabulated-list-print "tabulated-list"
- (&optional remember-pos))
+ (&optional remember-pos update))
(defvar process-menu-query-only nil)
+(defvar process-menu-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?d] 'process-menu-delete-process)
+ map))
+
(define-derived-mode process-menu-mode tabulated-list-mode "Process Menu"
"Major mode for listing the processes called by Emacs."
(setq tabulated-list-format [("Process" 15 t)
@@ -3089,6 +3557,12 @@ support pty association, if PROGRAM is nil."
(add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)
(tabulated-list-init-header))
+(defun process-menu-delete-process ()
+ "Kill process at point in a `list-processes' buffer."
+ (interactive)
+ (delete-process (tabulated-list-get-id))
+ (revert-buffer))
+
(defun list-processes--refresh ()
"Recompute the list of processes for the Process List buffer.
Also, delete any process that is exited or signaled."
@@ -3105,8 +3579,9 @@ Also, delete any process that is exited or signaled."
(buf-label (if (buffer-live-p buf)
`(,(buffer-name buf)
face link
- help-echo ,(concat "Visit buffer `"
- (buffer-name buf) "'")
+ help-echo ,(format-message
+ "Visit buffer `%s'"
+ (buffer-name buf))
follow-link t
process-buffer ,buf
action process-menu-visit-buffer)
@@ -3165,13 +3640,86 @@ see other processes running on the system, use `list-system-processes'."
(display-buffer buffer)
nil)
+;;;; Prefix commands
+
+(setq prefix-command--needs-update nil)
+(setq prefix-command--last-echo nil)
+
+(defun internal-echo-keystrokes-prefix ()
+ ;; BEWARE: Called directly from the C code.
+ (if (not prefix-command--needs-update)
+ prefix-command--last-echo
+ (setq prefix-command--last-echo
+ (let ((strs nil))
+ (run-hook-wrapped 'prefix-command-echo-keystrokes-functions
+ (lambda (fun) (push (funcall fun) strs)))
+ (setq strs (delq nil strs))
+ (when strs (mapconcat #'identity strs " "))))))
+
+(defvar prefix-command-echo-keystrokes-functions nil
+ "Abnormal hook which constructs the description of the current prefix state.
+Each function is called with no argument, should return a string or nil.")
+
+(defun prefix-command-update ()
+ "Update state of prefix commands.
+Call it whenever you change the \"prefix command state\"."
+ (setq prefix-command--needs-update t))
+
+(defvar prefix-command-preserve-state-hook nil
+ "Normal hook run when a command needs to preserve the prefix.")
+
+(defun prefix-command-preserve-state ()
+ "Pass the current prefix command state to the next command.
+Should be called by all prefix commands.
+Runs `prefix-command-preserve-state-hook'."
+ (run-hooks 'prefix-command-preserve-state-hook)
+ ;; If the current command is a prefix command, we don't want the next (real)
+ ;; command to have `last-command' set to, say, `universal-argument'.
+ (setq this-command last-command)
+ (setq real-this-command real-last-command)
+ (prefix-command-update))
+
+(defun reset-this-command-lengths ()
+ (declare (obsolete prefix-command-preserve-state "25.1"))
+ nil)
+
+;;;;; The main prefix command.
+
+;; FIXME: Declaration of `prefix-arg' should be moved here!?
+
+(add-hook 'prefix-command-echo-keystrokes-functions
+ #'universal-argument--description)
+(defun universal-argument--description ()
+ (when prefix-arg
+ (concat "C-u"
+ (pcase prefix-arg
+ (`(-) " -")
+ (`(,(and (pred integerp) n))
+ (let ((str ""))
+ (while (and (> n 4) (= (mod n 4) 0))
+ (setq str (concat str " C-u"))
+ (setq n (/ n 4)))
+ (if (= n 4) str (format " %s" prefix-arg))))
+ (_ (format " %s" prefix-arg))))))
+
+(add-hook 'prefix-command-preserve-state-hook
+ #'universal-argument--preserve)
+(defun universal-argument--preserve ()
+ (setq prefix-arg current-prefix-arg))
+
(defvar universal-argument-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'universal-argument-other-key)
- (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
- (define-key map [switch-frame] nil)
+ (let ((map (make-sparse-keymap))
+ (universal-argument-minus
+ ;; For backward compatibility, minus with no modifiers is an ordinary
+ ;; command if digits have already been entered.
+ `(menu-item "" negative-argument
+ :filter ,(lambda (cmd)
+ (if (integerp prefix-arg) nil cmd)))))
+ (define-key map [switch-frame]
+ (lambda (e) (interactive "e")
+ (handle-switch-frame e) (universal-argument--mode)))
(define-key map [?\C-u] 'universal-argument-more)
- (define-key map [?-] 'universal-argument-minus)
+ (define-key map [?-] universal-argument-minus)
(define-key map [?0] 'digit-argument)
(define-key map [?1] 'digit-argument)
(define-key map [?2] 'digit-argument)
@@ -3192,30 +3740,13 @@ see other processes running on the system, use `list-system-processes'."
(define-key map [kp-7] 'digit-argument)
(define-key map [kp-8] 'digit-argument)
(define-key map [kp-9] 'digit-argument)
- (define-key map [kp-subtract] 'universal-argument-minus)
+ (define-key map [kp-subtract] universal-argument-minus)
map)
"Keymap used while processing \\[universal-argument].")
-(defvar universal-argument-num-events nil
- "Number of argument-specifying events read by `universal-argument'.
-`universal-argument-other-key' uses this to discard those events
-from (this-command-keys), and reread only the final command.")
-
-(defvar saved-overriding-map t
- "The saved value of `overriding-terminal-local-map'.
-That variable gets restored to this value on exiting \"universal
-argument mode\".")
-
-(defun save&set-overriding-map (map)
- "Set `overriding-terminal-local-map' to MAP."
- (when (eq saved-overriding-map t)
- (setq saved-overriding-map overriding-terminal-local-map)
- (setq overriding-terminal-local-map map)))
-
-(defun restore-overriding-map ()
- "Restore `overriding-terminal-local-map' to its saved value."
- (setq overriding-terminal-local-map saved-overriding-map)
- (setq saved-overriding-map t))
+(defun universal-argument--mode ()
+ (prefix-command-update)
+ (set-transient-map universal-argument-map nil))
(defun universal-argument ()
"Begin a numeric argument for the following command.
@@ -3228,118 +3759,97 @@ For some commands, just \\[universal-argument] by itself serves as a flag
which is different in effect from any particular numeric argument.
These commands include \\[set-mark-command] and \\[start-kbd-macro]."
(interactive)
+ (prefix-command-preserve-state)
(setq prefix-arg (list 4))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (universal-argument--mode))
-;; A subsequent C-u means to multiply the factor by 4 if we've typed
-;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(defun universal-argument-more (arg)
+ ;; A subsequent C-u means to multiply the factor by 4 if we've typed
+ ;; nothing but C-u's; otherwise it means to terminate the prefix arg.
(interactive "P")
- (if (consp arg)
- (setq prefix-arg (list (* 4 (car arg))))
- (if (eq arg '-)
- (setq prefix-arg (list -4))
- (setq prefix-arg arg)
- (restore-overriding-map)))
- (setq universal-argument-num-events (length (this-command-keys))))
+ (prefix-command-preserve-state)
+ (setq prefix-arg (if (consp arg)
+ (list (* 4 (car arg)))
+ (if (eq arg '-)
+ (list -4)
+ arg)))
+ (when (consp prefix-arg) (universal-argument--mode)))
(defun negative-argument (arg)
"Begin a negative numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
- (cond ((integerp arg)
- (setq prefix-arg (- arg)))
- ((eq arg '-)
- (setq prefix-arg nil))
- (t
- (setq prefix-arg '-)))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
+ (prefix-command-preserve-state)
+ (setq prefix-arg (cond ((integerp arg) (- arg))
+ ((eq arg '-) nil)
+ (t '-)))
+ (universal-argument--mode))
(defun digit-argument (arg)
"Part of the numeric argument for the next command.
\\[universal-argument] following digits or minus sign ends the argument."
(interactive "P")
+ (prefix-command-preserve-state)
(let* ((char (if (integerp last-command-event)
last-command-event
(get last-command-event 'ascii-character)))
(digit (- (logand char ?\177) ?0)))
- (cond ((integerp arg)
- (setq prefix-arg (+ (* arg 10)
- (if (< arg 0) (- digit) digit))))
- ((eq arg '-)
- ;; Treat -0 as just -, so that -01 will work.
- (setq prefix-arg (if (zerop digit) '- (- digit))))
- (t
- (setq prefix-arg digit))))
- (setq universal-argument-num-events (length (this-command-keys)))
- (save&set-overriding-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
- (interactive "P")
- (if (integerp arg)
- (universal-argument-other-key arg)
- (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
- (interactive "P")
- (setq prefix-arg arg)
- (let* ((key (this-command-keys))
- (keylist (listify-key-sequence key)))
- (setq unread-command-events
- (append (nthcdr universal-argument-num-events keylist)
- unread-command-events)))
- (reset-this-command-lengths)
- (restore-overriding-map))
+ (setq prefix-arg (cond ((integerp arg)
+ (+ (* arg 10)
+ (if (< arg 0) (- digit) digit)))
+ ((eq arg '-)
+ ;; Treat -0 as just -, so that -01 will work.
+ (if (zerop digit) '- (- digit)))
+ (t
+ digit))))
+ (universal-argument--mode))
(defvar filter-buffer-substring-functions nil
- "This variable is a wrapper hook around `filter-buffer-substring'.")
+ "This variable is a wrapper hook around `buffer-substring--filter'.")
(make-obsolete-variable 'filter-buffer-substring-functions
'filter-buffer-substring-function "24.4")
(defvar filter-buffer-substring-function #'buffer-substring--filter
"Function to perform the filtering in `filter-buffer-substring'.
-The function is called with 3 arguments:
-\(BEG END DELETE). The arguments BEG, END, and DELETE are the same
-as those of `filter-buffer-substring' in each case.
-It should return the buffer substring between BEG and END, after filtering.")
+The function is called with the same 3 arguments (BEG END DELETE)
+that `filter-buffer-substring' received. It should return the
+buffer substring between BEG and END, after filtering. If DELETE is
+non-nil, it should delete the text between BEG and END from the buffer.")
(defvar buffer-substring-filters nil
- "List of filter functions for `filter-buffer-substring'.
-Each function must accept a single argument, a string, and return
-a string. The buffer substring is passed to the first function
-in the list, and the return value of each function is passed to
-the next.
+ "List of filter functions for `buffer-substring--filter'.
+Each function must accept a single argument, a string, and return a string.
+The buffer substring is passed to the first function in the list,
+and the return value of each function is passed to the next.
As a special convention, point is set to the start of the buffer text
-being operated on (i.e., the first argument of `filter-buffer-substring')
+being operated on (i.e., the first argument of `buffer-substring--filter')
before these functions are called.")
(make-obsolete-variable 'buffer-substring-filters
'filter-buffer-substring-function "24.1")
(defun filter-buffer-substring (beg end &optional delete)
"Return the buffer substring between BEG and END, after filtering.
-The hook `filter-buffer-substring-function' performs the actual filtering.
-By default, no filtering is done.
-
-If DELETE is non-nil, the text between BEG and END is deleted
-from the buffer.
-
-This function should be used instead of `buffer-substring',
-`buffer-substring-no-properties', or `delete-and-extract-region'
-when you want to allow filtering to take place. For example,
-major or minor modes can use `filter-buffer-substring-function' to
-extract characters that are special to a buffer, and should not
-be copied into other buffers."
+If DELETE is non-nil, delete the text between BEG and END from the buffer.
+
+This calls the function that `filter-buffer-substring-function' specifies
+\(passing the same three arguments that it received) to do the work,
+and returns whatever it does. The default function does no filtering,
+unless a hook has been set.
+
+Use `filter-buffer-substring' instead of `buffer-substring',
+`buffer-substring-no-properties', or `delete-and-extract-region' when
+you want to allow filtering to take place. For example, major or minor
+modes can use `filter-buffer-substring-function' to extract characters
+that are special to a buffer, and should not be copied into other buffers."
(funcall filter-buffer-substring-function beg end delete))
-;; FIXME: `with-wrapper-hook' is obsolete
(defun buffer-substring--filter (beg end &optional delete)
+ "Default function to use for `filter-buffer-substring-function'.
+Its arguments and return value are as specified for `filter-buffer-substring'.
+This respects the wrapper hook `filter-buffer-substring-functions',
+and the abnormal hook `buffer-substring-filters'.
+No filtering is done unless a hook says to."
(with-wrapper-hook filter-buffer-substring-functions (beg end delete)
(cond
((or delete buffer-substring-filters)
@@ -3356,7 +3866,7 @@ be copied into other buffers."
;;;; Window system cut and paste hooks.
-(defvar interprogram-cut-function nil
+(defvar interprogram-cut-function #'gui-select-text
"Function to call to make a killed region available to other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
@@ -3367,7 +3877,7 @@ put in the kill ring, to make the new kill available to other
programs. The function takes one argument, TEXT, which is a
string containing the text which should be made available.")
-(defvar interprogram-paste-function nil
+(defvar interprogram-paste-function #'gui-selection-value
"Function to call to get text cut from other programs.
Most window systems provide a facility for cutting and pasting
text between different programs, such as the clipboard on X and
@@ -3436,7 +3946,7 @@ The comparison is done using `equal-including-properties'."
:group 'killing
:version "23.2")
-(defun kill-new (string &optional replace yank-handler)
+(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set `kill-ring-yank-pointer' to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
@@ -3451,13 +3961,6 @@ When the yank handler has a non-nil PARAM element, the original STRING
argument is not used by `insert-for-yank'. However, since Lisp code
may access and use elements from the kill ring directly, the STRING
argument should still be a \"useful\" string for such uses."
- (if (> (length string) 0)
- (if yank-handler
- (put-text-property 0 (length string)
- 'yank-handler yank-handler string))
- (if yank-handler
- (signal 'args-out-of-range
- (list string "yank-handler specified for empty string"))))
(unless (and kill-do-not-save-duplicates
;; Due to text properties such as 'yank-handler that
;; can alter the contents to yank, comparison using
@@ -3485,19 +3988,35 @@ argument should still be a \"useful\" string for such uses."
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
(funcall interprogram-cut-function string)))
-(set-advertised-calling-convention
- 'kill-new '(string &optional replace) "23.3")
-(defun kill-append (string before-p &optional yank-handler)
+;; It has been argued that this should work similar to `self-insert-command'
+;; which merges insertions in undo-list in groups of 20 (hard-coded in cmds.c).
+(defcustom kill-append-merge-undo nil
+ "Whether appending to kill ring also makes \\[undo] restore both pieces of text simultaneously."
+ :type 'boolean
+ :group 'killing
+ :version "25.1")
+
+(defun kill-append (string before-p)
"Append STRING to the end of the latest kill in the kill ring.
If BEFORE-P is non-nil, prepend STRING to the kill.
+Also removes the last undo boundary in the current buffer,
+ depending on `kill-append-merge-undo'.
If `interprogram-cut-function' is set, pass the resulting kill to it."
(let* ((cur (car kill-ring)))
(kill-new (if before-p (concat string cur) (concat cur string))
(or (= (length cur) 0)
- (equal yank-handler (get-text-property 0 'yank-handler cur)))
- yank-handler)))
-(set-advertised-calling-convention 'kill-append '(string before-p) "23.3")
+ (equal nil (get-text-property 0 'yank-handler cur))))
+ (when (and kill-append-merge-undo (not buffer-read-only))
+ (let ((prev buffer-undo-list)
+ (next (cdr buffer-undo-list)))
+ ;; find the next undo boundary
+ (while (car next)
+ (pop next)
+ (pop prev))
+ ;; remove this undo boundary
+ (when prev
+ (setcdr prev (cdr next)))))))
(defcustom yank-pop-change-selection nil
"Whether rotating the kill ring changes the window system selection.
@@ -3558,7 +4077,7 @@ move the yanking point; just return the Nth kill forward."
:type 'boolean
:group 'killing)
-(defun kill-region (beg end &optional yank-handler)
+(defun kill-region (beg end &optional region)
"Kill (\"cut\") text between point and mark.
This deletes the text from the buffer and saves it in the kill ring.
The command \\[yank] can retrieve it from there.
@@ -3578,19 +4097,24 @@ Supply two arguments, character positions indicating the stretch of text
Any command that calls this function is a \"kill command\".
If the previous command was also a kill command,
the text killed this time appends to the text killed last time
-to make one entry in the kill ring."
- ;; Pass point first, then mark, because the order matters
- ;; when calling kill-append.
- (interactive (list (point) (mark)))
+to make one entry in the kill ring.
+
+The optional argument REGION if non-nil, indicates that we're not just killing
+some text between BEG and END, but we're killing the region."
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point) 'region))
(unless (and beg end)
- (error "The mark is not set now, so there is no region"))
+ (user-error "The mark is not set now, so there is no region"))
(condition-case nil
- (let ((string (filter-buffer-substring beg end t)))
+ (let ((string (if region
+ (funcall region-extract-function 'delete)
+ (filter-buffer-substring beg end 'delete))))
(when string ;STRING is nil if BEG = END
;; Add that string to the kill ring, one way or another.
(if (eq last-command 'kill-region)
- (kill-append string (< end beg) yank-handler)
- (kill-new string nil yank-handler)))
+ (kill-append string (< end beg))
+ (kill-new string)))
(when (or string (eq last-command 'kill-region))
(setq this-command 'kill-region))
(setq deactivate-mark t)
@@ -3601,7 +4125,7 @@ to make one entry in the kill ring."
;; We should beep, in case the user just isn't aware of this.
;; However, there's no harm in putting
;; the region's text in the kill ring, anyway.
- (copy-region-as-kill beg end)
+ (copy-region-as-kill beg end region)
;; Set this-command now, so it will be set even if we get an error.
(setq this-command 'kill-region)
;; This should barf, if appropriate, and give us the correct error.
@@ -3611,26 +4135,34 @@ to make one entry in the kill ring."
(barf-if-buffer-read-only)
;; If the buffer isn't read-only, the text is.
(signal 'text-read-only (list (current-buffer)))))))
-(set-advertised-calling-convention 'kill-region '(beg end) "23.3")
;; copy-region-as-kill no longer sets this-command, because it's confusing
;; to get two copies of the text when the user accidentally types M-w and
;; then corrects it with the intended C-w.
-(defun copy-region-as-kill (beg end)
+(defun copy-region-as-kill (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
system cut and paste.
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
This command's old key binding has been given to `kill-ring-save'."
- (interactive "r")
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (let ((str (if region
+ (funcall region-extract-function nil)
+ (filter-buffer-substring beg end))))
(if (eq last-command 'kill-region)
- (kill-append (filter-buffer-substring beg end) (< end beg))
- (kill-new (filter-buffer-substring beg end)))
+ (kill-append str (< end beg))
+ (kill-new str)))
(setq deactivate-mark t)
nil)
-(defun kill-ring-save (beg end)
+(defun kill-ring-save (beg end &optional region)
"Save the region as if killed, but don't kill it.
In Transient Mark mode, deactivate the mark.
If `interprogram-cut-function' is non-nil, also save the text for a window
@@ -3639,10 +4171,16 @@ system cut and paste.
If you want to append the killed line to the last killed text,
use \\[append-next-kill] before \\[kill-ring-save].
+The optional argument REGION if non-nil, indicates that we're not just copying
+some text between BEG and END, but we're copying the region.
+
This command is similar to `copy-region-as-kill', except that it gives
visual feedback indicating the extent of the region being copied."
- (interactive "r")
- (copy-region-as-kill beg end)
+ ;; Pass mark first, then point, because the order matters when
+ ;; calling `kill-append'.
+ (interactive (list (mark) (point)
+ (prefix-numeric-value current-prefix-arg)))
+ (copy-region-as-kill beg end region)
;; This use of called-interactively-p is correct because the code it
;; controls just gives the user visual feedback.
(if (called-interactively-p 'interactive)
@@ -3677,7 +4215,7 @@ of this sample text; it defaults to 40."
(goto-char point)
;; If user quit, deactivate the mark
;; as C-g would as a command.
- (and quit-flag mark-active
+ (and quit-flag (region-active-p)
(deactivate-mark)))
(let ((len (min (abs (- mark point))
(or message-len 40))))
@@ -3689,7 +4227,17 @@ of this sample text; it defaults to 40."
(buffer-substring-no-properties mark (+ mark len))))))))
(defun append-next-kill (&optional interactive)
- "Cause following command, if it kills, to append to previous kill.
+ "Cause following command, if it kills, to add to previous kill.
+If the next command kills forward from point, the kill is
+appended to the previous killed text. If the command kills
+backward, the kill is prepended. Kill commands that act on the
+region, such as `kill-region', are regarded as killing forward if
+point is after mark, and killing backward if point is before
+mark.
+
+If the next command is not a kill command, `append-next-kill' has
+no effect.
+
The argument is used for internal purposes; do not supply one."
(interactive "p")
;; We don't use (interactive-p), since that breaks kbd macros.
@@ -3698,6 +4246,144 @@ The argument is used for internal purposes; do not supply one."
(setq this-command 'kill-region)
(message "If the next command is a kill, it will append"))
(setq last-command 'kill-region)))
+
+(defvar bidi-directional-controls-chars "\x202a-\x202e\x2066-\x2069"
+ "Character set that matches bidirectional formatting control characters.")
+
+(defvar bidi-directional-non-controls-chars "^\x202a-\x202e\x2066-\x2069"
+ "Character set that matches any character except bidirectional controls.")
+
+(defun squeeze-bidi-context-1 (from to category replacement)
+ "A subroutine of `squeeze-bidi-context'.
+FROM and TO should be markers, CATEGORY and REPLACEMENT should be strings."
+ (let ((pt (copy-marker from))
+ (limit (copy-marker to))
+ (old-pt 0)
+ lim1)
+ (setq lim1 limit)
+ (goto-char pt)
+ (while (< pt limit)
+ (if (> pt old-pt)
+ (move-marker lim1
+ (save-excursion
+ ;; L and R categories include embedding and
+ ;; override controls, but we don't want to
+ ;; replace them, because that might change
+ ;; the visual order. Likewise with PDF and
+ ;; isolate controls.
+ (+ pt (skip-chars-forward
+ bidi-directional-non-controls-chars
+ limit)))))
+ ;; Replace any run of non-RTL characters by a single LRM.
+ (if (null (re-search-forward category lim1 t))
+ ;; No more characters of CATEGORY, we are done.
+ (setq pt limit)
+ (replace-match replacement nil t)
+ (move-marker pt (point)))
+ (setq old-pt pt)
+ ;; Skip directional controls, if any.
+ (move-marker
+ pt (+ pt (skip-chars-forward bidi-directional-controls-chars limit))))))
+
+(defun squeeze-bidi-context (from to)
+ "Replace characters between FROM and TO while keeping bidi context.
+
+This function replaces the region of text with as few characters
+as possible, while preserving the effect that region will have on
+bidirectional display before and after the region."
+ (let ((start (set-marker (make-marker)
+ (if (> from 0) from (+ (point-max) from))))
+ (end (set-marker (make-marker) to))
+ ;; This is for when they copy text with read-only text
+ ;; properties.
+ (inhibit-read-only t))
+ (if (null (marker-position end))
+ (setq end (point-max-marker)))
+ ;; Replace each run of non-RTL characters with a single LRM.
+ (squeeze-bidi-context-1 start end "\\CR+" "\x200e")
+ ;; Replace each run of non-LTR characters with a single RLM. Note
+ ;; that the \cR category includes both the Arabic Letter (AL) and
+ ;; R characters; here we ignore the distinction between them,
+ ;; because that distinction only affects Arabic Number (AN)
+ ;; characters, which are weak and don't affect the reordering.
+ (squeeze-bidi-context-1 start end "\\CL+" "\x200f")))
+
+(defun line-substring-with-bidi-context (start end &optional no-properties)
+ "Return buffer text between START and END with its bidi context.
+
+START and END are assumed to belong to the same physical line
+of buffer text. This function prepends and appends to the text
+between START and END bidi control characters that preserve the
+visual order of that text when it is inserted at some other place."
+ (if (or (< start (point-min))
+ (> end (point-max)))
+ (signal 'args-out-of-range (list (current-buffer) start end)))
+ (let ((buf (current-buffer))
+ substr para-dir from to)
+ (save-excursion
+ (goto-char start)
+ (setq para-dir (current-bidi-paragraph-direction))
+ (setq from (line-beginning-position)
+ to (line-end-position))
+ (goto-char from)
+ ;; If we don't have any mixed directional characters in the
+ ;; entire line, we can just copy the substring without adding
+ ;; any context.
+ (if (or (looking-at-p "\\CR*$")
+ (looking-at-p "\\CL*$"))
+ (setq substr (if no-properties
+ (buffer-substring-no-properties start end)
+ (buffer-substring start end)))
+ (setq substr
+ (with-temp-buffer
+ (if no-properties
+ (insert-buffer-substring-no-properties buf from to)
+ (insert-buffer-substring buf from to))
+ (squeeze-bidi-context 1 (1+ (- start from)))
+ (squeeze-bidi-context (- end to) nil)
+ (buffer-substring 1 (point-max)))))
+
+ ;; Wrap the string in LRI/RLI..PDI pair to achieve 2 effects:
+ ;; (1) force the string to have the same base embedding
+ ;; direction as the paragraph direction at the source, no matter
+ ;; what is the paragraph direction at destination; and (2) avoid
+ ;; affecting the visual order of the surrounding text at
+ ;; destination if there are characters of different
+ ;; directionality there.
+ (concat (if (eq para-dir 'left-to-right) "\x2066" "\x2067")
+ substr "\x2069"))))
+
+(defun buffer-substring-with-bidi-context (start end &optional no-properties)
+ "Return portion of current buffer between START and END with bidi context.
+
+This function works similar to `buffer-substring', but it prepends and
+appends to the text bidi directional control characters necessary to
+preserve the visual appearance of the text if it is inserted at another
+place. This is useful when the buffer substring includes bidirectional
+text and control characters that cause non-trivial reordering on display.
+If copied verbatim, such text can have a very different visual appearance,
+and can also change the visual appearance of the surrounding text at the
+destination of the copy.
+
+Optional argument NO-PROPERTIES, if non-nil, means copy the text without
+the text properties."
+ (let (line-end substr)
+ (if (or (< start (point-min))
+ (> end (point-max)))
+ (signal 'args-out-of-range (list (current-buffer) start end)))
+ (save-excursion
+ (goto-char start)
+ (setq line-end (min end (line-end-position)))
+ (while (< start end)
+ (setq substr
+ (concat substr
+ (if substr "\n" "")
+ (line-substring-with-bidi-context start line-end
+ no-properties)))
+ (forward-line 1)
+ (setq start (point))
+ (setq line-end (min end (line-end-position))))
+ substr)))
;; Yanking.
@@ -3716,6 +4402,8 @@ end positions of the text.
This is done prior to removing the properties specified by
`yank-excluded-properties'."
:group 'killing
+ :type '(repeat (cons (symbol :tag "property symbol")
+ function))
:version "24.3")
;; This is actually used in subr.el but defcustom does not work there.
@@ -3758,7 +4446,7 @@ When this command inserts killed text into the buffer, it honors
doc string for `insert-for-yank-1', which see."
(interactive "*p")
(if (not (eq last-command 'yank))
- (error "Previous command was not a yank"))
+ (user-error "Previous command was not a yank"))
(setq this-command 'yank)
(unless arg (setq arg 1))
(let ((inhibit-read-only t)
@@ -3957,7 +4645,7 @@ even beep.)"
"Kill current line.
With prefix ARG, kill that many lines starting from the current line.
If ARG is negative, kill backward. Also kill the preceding newline.
-\(This is meant to make \\[repeat] work well with negative arguments.\)
+\(This is meant to make \\[repeat] work well with negative arguments.)
If ARG is zero, kill current line but exclude the trailing newline."
(interactive "p")
(or arg (setq arg 1))
@@ -4090,10 +4778,8 @@ If ARG is zero, move to the beginning of the current line."
(defun insert-buffer (buffer)
"Insert after point the contents of BUFFER.
Puts mark after the inserted text.
-BUFFER may be a buffer or a buffer name.
-
-This function is meant for the user to run interactively.
-Don't call it from programs: use `insert-buffer-substring' instead!"
+BUFFER may be a buffer or a buffer name."
+ (declare (interactive-only insert-buffer-substring))
(interactive
(list
(progn
@@ -4185,6 +4871,8 @@ a mistake; see the documentation of `set-mark'."
(marker-position (mark-marker))
(signal 'mark-inactive nil)))
+;; Behind display-selections-p.
+
(defun deactivate-mark (&optional force)
"Deactivate the mark.
If Transient Mark mode is disabled, this function normally does
@@ -4198,7 +4886,7 @@ If Transient Mark mode was temporarily enabled, reset the value
of the variable `transient-mark-mode'; if this causes Transient
Mark mode to be disabled, don't change `mark-active' to nil or
run `deactivate-mark-hook'."
- (when (or transient-mark-mode force)
+ (when (or (region-active-p) force)
(when (and (if (eq select-active-regions 'only)
(eq (car-safe transient-mark-mode) 'only)
select-active-regions)
@@ -4208,35 +4896,38 @@ run `deactivate-mark-hook'."
;; the region prior to the last command modifying the buffer.
;; Set the selection to that, or to the current region.
(cond (saved-region-selection
- (x-set-selection 'PRIMARY saved-region-selection)
+ (if (gui-backend-selection-owner-p 'PRIMARY)
+ (gui-set-selection 'PRIMARY saved-region-selection))
(setq saved-region-selection nil))
;; If another program has acquired the selection, region
;; deactivation should not clobber it (Bug#11772).
((and (/= (region-beginning) (region-end))
- (or (x-selection-owner-p 'PRIMARY)
- (null (x-selection-exists-p 'PRIMARY))))
- (x-set-selection 'PRIMARY
- (buffer-substring (region-beginning)
- (region-end))))))
- (if (and (null force)
- (or (eq transient-mark-mode 'lambda)
- (and (eq (car-safe transient-mark-mode) 'only)
- (null (cdr transient-mark-mode)))))
- ;; When deactivating a temporary region, don't change
- ;; `mark-active' or run `deactivate-mark-hook'.
- (setq transient-mark-mode nil)
- (if (eq (car-safe transient-mark-mode) 'only)
- (setq transient-mark-mode (cdr transient-mark-mode)))
- (setq mark-active nil)
- (run-hooks 'deactivate-mark-hook))))
-
-(defun activate-mark ()
- "Activate the mark."
+ (or (gui-backend-selection-owner-p 'PRIMARY)
+ (null (gui-backend-selection-exists-p 'PRIMARY))))
+ (gui-set-selection 'PRIMARY
+ (funcall region-extract-function nil)))))
+ (when mark-active (force-mode-line-update)) ;Refresh toolbar (bug#16382).
+ (cond
+ ((eq (car-safe transient-mark-mode) 'only)
+ (setq transient-mark-mode (cdr transient-mark-mode))
+ (if (eq transient-mark-mode (default-value 'transient-mark-mode))
+ (kill-local-variable 'transient-mark-mode)))
+ ((eq transient-mark-mode 'lambda)
+ (kill-local-variable 'transient-mark-mode)))
+ (setq mark-active nil)
+ (run-hooks 'deactivate-mark-hook)
+ (redisplay--update-region-highlight (selected-window))))
+
+(defun activate-mark (&optional no-tmm)
+ "Activate the mark.
+If NO-TMM is non-nil, leave `transient-mark-mode' alone."
(when (mark t)
- (setq mark-active t)
- (unless transient-mark-mode
- (setq transient-mark-mode 'lambda))
- (run-hooks 'activate-mark-hook)))
+ (unless (region-active-p)
+ (force-mode-line-update) ;Refresh toolbar (bug#16382).
+ (setq mark-active t)
+ (unless (or transient-mark-mode no-tmm)
+ (setq-local transient-mark-mode 'lambda))
+ (run-hooks 'activate-mark-hook))))
(defun set-mark (pos)
"Set this buffer's mark to POS. Don't use this function!
@@ -4254,18 +4945,58 @@ To remember a location for internal use in the Lisp program,
store it in a Lisp variable. Example:
(let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
-
(if pos
(progn
- (setq mark-active t)
- (run-hooks 'activate-mark-hook)
- (set-marker (mark-marker) pos (current-buffer)))
+ (set-marker (mark-marker) pos (current-buffer))
+ (activate-mark 'no-tmm))
;; Normally we never clear mark-active except in Transient Mark mode.
;; But when we actually clear out the mark value too, we must
;; clear mark-active in any mode.
(deactivate-mark t)
+ ;; `deactivate-mark' sometimes leaves mark-active non-nil, but
+ ;; it should never be nil if the mark is nil.
+ (setq mark-active nil)
(set-marker (mark-marker) nil)))
+(defun save-mark-and-excursion--save ()
+ (cons
+ (let ((mark (mark-marker)))
+ (and (marker-position mark) (copy-marker mark)))
+ mark-active))
+
+(defun save-mark-and-excursion--restore (saved-mark-info)
+ (let ((saved-mark (car saved-mark-info))
+ (omark (marker-position (mark-marker)))
+ (nmark nil)
+ (saved-mark-active (cdr saved-mark-info)))
+ ;; Mark marker
+ (if (null saved-mark)
+ (set-marker (mark-marker) nil)
+ (setf nmark (marker-position saved-mark))
+ (set-marker (mark-marker) nmark)
+ (set-marker saved-mark nil))
+ ;; Mark active
+ (let ((cur-mark-active mark-active))
+ (setq mark-active saved-mark-active)
+ ;; If mark is active now, and either was not active or was at a
+ ;; different place, run the activate hook.
+ (if saved-mark-active
+ (when (or (not cur-mark-active)
+ (not (eq omark nmark)))
+ (run-hooks 'activate-mark-hook))
+ ;; If mark has ceased to be active, run deactivate hook.
+ (when cur-mark-active
+ (run-hooks 'deactivate-mark-hook))))))
+
+(defmacro save-mark-and-excursion (&rest body)
+ "Like `save-excursion', but also save and restore the mark state.
+This macro does what `save-excursion' did before Emacs 25.1."
+ (let ((saved-marker-sym (make-symbol "saved-marker")))
+ `(let ((,saved-marker-sym (save-mark-and-excursion--save)))
+ (unwind-protect
+ (save-excursion ,@body)
+ (save-mark-and-excursion--restore ,saved-marker-sym)))))
+
(defcustom use-empty-active-region nil
"Whether \"region-aware\" commands should act on empty regions.
If nil, region-aware commands treat empty regions as inactive.
@@ -4294,17 +5025,82 @@ For some commands, it may be appropriate to ignore the value of
(or use-empty-active-region (> (region-end) (region-beginning)))))
(defun region-active-p ()
- "Return t if Transient Mark mode is enabled and the mark is active.
+ "Return non-nil if Transient Mark mode is enabled and the mark is active.
Some commands act specially on the region when Transient Mark
mode is enabled. Usually, such commands should use
`use-region-p' instead of this function, because `use-region-p'
also checks the value of `use-empty-active-region'."
- (and transient-mark-mode mark-active))
-
-(defvar mark-ring nil
+ (and transient-mark-mode mark-active
+ ;; FIXME: Somehow we sometimes end up with mark-active non-nil but
+ ;; without the mark being set (e.g. bug#17324). We really should fix
+ ;; that problem, but in the mean time, let's make sure we don't say the
+ ;; region is active when there's no mark.
+ (progn (cl-assert (mark)) t)))
+
+
+(defvar redisplay-unhighlight-region-function
+ (lambda (rol) (when (overlayp rol) (delete-overlay rol))))
+
+(defvar redisplay-highlight-region-function
+ (lambda (start end window rol)
+ (if (not (overlayp rol))
+ (let ((nrol (make-overlay start end)))
+ (funcall redisplay-unhighlight-region-function rol)
+ (overlay-put nrol 'window window)
+ (overlay-put nrol 'face 'region)
+ ;; Normal priority so that a large region doesn't hide all the
+ ;; overlays within it, but high secondary priority so that if it
+ ;; ends/starts in the middle of a small overlay, that small overlay
+ ;; won't hide the region's boundaries.
+ (overlay-put nrol 'priority '(nil . 100))
+ nrol)
+ (unless (and (eq (overlay-buffer rol) (current-buffer))
+ (eq (overlay-start rol) start)
+ (eq (overlay-end rol) end))
+ (move-overlay rol start end (current-buffer)))
+ rol)))
+
+(defun redisplay--update-region-highlight (window)
+ (let ((rol (window-parameter window 'internal-region-overlay)))
+ (if (not (and (region-active-p)
+ (or highlight-nonselected-windows
+ (eq window (selected-window))
+ (and (window-minibuffer-p)
+ (eq window (minibuffer-selected-window))))))
+ (funcall redisplay-unhighlight-region-function rol)
+ (let* ((pt (window-point window))
+ (mark (mark))
+ (start (min pt mark))
+ (end (max pt mark))
+ (new
+ (funcall redisplay-highlight-region-function
+ start end window rol)))
+ (unless (equal new rol)
+ (set-window-parameter window 'internal-region-overlay
+ new))))))
+
+(defvar pre-redisplay-functions (list #'redisplay--update-region-highlight)
+ "Hook run just before redisplay.
+It is called in each window that is to be redisplayed. It takes one argument,
+which is the window that will be redisplayed. When run, the `current-buffer'
+is set to the buffer displayed in that window.")
+
+(defun redisplay--pre-redisplay-functions (windows)
+ (with-demoted-errors "redisplay--pre-redisplay-functions: %S"
+ (if (null windows)
+ (with-current-buffer (window-buffer (selected-window))
+ (run-hook-with-args 'pre-redisplay-functions (selected-window)))
+ (dolist (win (if (listp windows) windows (window-list-1 nil nil t)))
+ (with-current-buffer (window-buffer win)
+ (run-hook-with-args 'pre-redisplay-functions win))))))
+
+(add-function :before pre-redisplay-function
+ #'redisplay--pre-redisplay-functions)
+
+
+(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
-(make-variable-buffer-local 'mark-ring)
(put 'mark-ring 'permanent-local t)
(defcustom mark-ring-max 16
@@ -4323,10 +5119,10 @@ Start discarding off end if gets this big."
(defun pop-to-mark-command ()
"Jump to mark, and pop a new position for mark off the ring.
-\(Does not affect global mark ring\)."
+\(Does not affect global mark ring)."
(interactive)
(if (null (mark t))
- (error "No mark set in this buffer")
+ (user-error "No mark set in this buffer")
(if (= (point) (mark t))
(message "Mark popped"))
(goto-char (mark t))
@@ -4337,11 +5133,10 @@ Start discarding off end if gets this big."
If no prefix ARG and mark is already set there, just activate it.
Display `Mark set' unless the optional second arg NOMSG is non-nil."
(interactive "P")
- (let ((mark (marker-position (mark-marker))))
+ (let ((mark (mark t)))
(if (or arg (null mark) (/= mark (point)))
(push-mark nil nomsg t)
- (setq mark-active t)
- (run-hooks 'activate-mark-hook)
+ (activate-mark 'no-tmm)
(unless nomsg
(message "Mark activated")))))
@@ -4370,11 +5165,11 @@ global mark ring, if the previous mark was set in another buffer.
When Transient Mark Mode is off, immediately repeating this
command activates `transient-mark-mode' temporarily.
-With prefix argument \(e.g., \\[universal-argument] \\[set-mark-command]\), \
+With prefix argument (e.g., \\[universal-argument] \\[set-mark-command]), \
jump to the mark, and set the mark from
-position popped off the local mark ring \(this does not affect the global
-mark ring\). Use \\[pop-global-mark] to jump to a mark popped off the global
-mark ring \(see `pop-global-mark'\).
+position popped off the local mark ring (this does not affect the global
+mark ring). Use \\[pop-global-mark] to jump to a mark popped off the global
+mark ring (see `pop-global-mark').
If `set-mark-command-repeat-pop' is non-nil, repeating
the \\[set-mark-command] command with no prefix argument pops the next position
@@ -4388,7 +5183,7 @@ Novice Emacs Lisp programmers often try to use the mark for the wrong
purposes. See the documentation of `set-mark' for more information."
(interactive "P")
(cond ((eq transient-mark-mode 'lambda)
- (setq transient-mark-mode nil))
+ (kill-local-variable 'transient-mark-mode))
((eq (car-safe transient-mark-mode) 'only)
(deactivate-mark)))
(cond
@@ -4399,15 +5194,13 @@ purposes. See the documentation of `set-mark' for more information."
(pop-to-mark-command)
(push-mark-command t)))
((and set-mark-command-repeat-pop
- (eq last-command 'pop-to-mark-command))
- (setq this-command 'pop-to-mark-command)
- (pop-to-mark-command))
- ((and set-mark-command-repeat-pop
(eq last-command 'pop-global-mark)
(not arg))
(setq this-command 'pop-global-mark)
(pop-global-mark))
- (arg
+ ((or (and set-mark-command-repeat-pop
+ (eq last-command 'pop-to-mark-command))
+ arg)
(setq this-command 'pop-to-mark-command)
(pop-to-mark-command))
((eq last-command 'set-mark-command)
@@ -4478,12 +5271,11 @@ mode temporarily."
(let ((omark (mark t))
(temp-highlight (eq (car-safe transient-mark-mode) 'only)))
(if (null omark)
- (error "No mark set in this buffer"))
- (deactivate-mark)
+ (user-error "No mark set in this buffer"))
(set-mark (point))
(goto-char omark)
(cond (temp-highlight
- (setq transient-mark-mode (cons 'only transient-mark-mode)))
+ (setq-local transient-mark-mode (cons 'only transient-mark-mode)))
((or (and arg (region-active-p)) ; (xor arg (not (region-active-p)))
(not (or arg (region-active-p))))
(deactivate-mark))
@@ -4522,13 +5314,15 @@ its earlier value."
(cond ((and shift-select-mode this-command-keys-shift-translated)
(unless (and mark-active
(eq (car-safe transient-mark-mode) 'only))
- (setq transient-mark-mode
- (cons 'only
- (unless (eq transient-mark-mode 'lambda)
- transient-mark-mode)))
+ (setq-local transient-mark-mode
+ (cons 'only
+ (unless (eq transient-mark-mode 'lambda)
+ transient-mark-mode)))
(push-mark nil nil t)))
((eq (car-safe transient-mark-mode) 'only)
(setq transient-mark-mode (cdr transient-mark-mode))
+ (if (eq transient-mark-mode (default-value 'transient-mark-mode))
+ (kill-local-variable 'transient-mark-mode))
(deactivate-mark))))
(define-minor-mode transient-mark-mode
@@ -4538,10 +5332,11 @@ positive, and disable it otherwise. If called from Lisp, enable
Transient Mark mode if ARG is omitted or nil.
Transient Mark mode is a global minor mode. When enabled, the
-region is highlighted whenever the mark is active. The mark is
-\"deactivated\" by changing the buffer, and after certain other
-operations that set the mark but whose main purpose is something
-else--for example, incremental search, \\[beginning-of-buffer], and \\[end-of-buffer].
+region is highlighted with the `region' face whenever the mark
+is active. The mark is \"deactivated\" by changing the buffer,
+and after certain other operations that set the mark but whose
+main purpose is something else--for example, incremental search,
+\\[beginning-of-buffer], and \\[end-of-buffer].
You can also deactivate the mark by typing \\[keyboard-quit] or
\\[keyboard-escape-quit].
@@ -4556,7 +5351,7 @@ Transient Mark mode, invoke \\[apropos-documentation] and type \"transient\"
or \"mark.*active\" at the prompt."
:global t
;; It's defined in C/cus-start, this stops the d-m-m macro defining it again.
- :variable transient-mark-mode)
+ :variable (default-value 'transient-mark-mode))
(defvar widen-automatically t
"Non-nil means it is ok for commands to call `widen' when they want to.
@@ -4630,11 +5425,8 @@ this command moves to the specified goal column (or as close as possible).
The goal column is stored in the variable `goal-column', which is nil
when there is no goal column. Note that setting `goal-column'
overrides `line-move-visual' and causes this command to move by buffer
-lines rather than by display lines.
-
-If you are thinking of using this in a Lisp program, consider
-using `forward-line' instead. It is usually easier to use
-and more reliable (no dependence on goal column, etc.)."
+lines rather than by display lines."
+ (declare (interactive-only forward-line))
(interactive "^p\np")
(or arg (setq arg 1))
(if (and next-line-add-newlines (= arg 1))
@@ -4676,11 +5468,9 @@ this command moves to the specified goal column (or as close as possible).
The goal column is stored in the variable `goal-column', which is nil
when there is no goal column. Note that setting `goal-column'
overrides `line-move-visual' and causes this command to move by buffer
-lines rather than by display lines.
-
-If you are thinking of using this in a Lisp program, consider using
-`forward-line' with a negative argument instead. It is usually easier
-to use and more reliable (no dependence on goal column, etc.)."
+lines rather than by display lines."
+ (declare (interactive-only
+ "use `forward-line' with negative argument instead."))
(interactive "^p\np")
(or arg (setq arg 1))
(if (called-interactively-p 'interactive)
@@ -4721,7 +5511,15 @@ When the `track-eol' feature is doing its job, the value is
`most-positive-fixnum'.")
(defcustom line-move-ignore-invisible t
- "Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
+ "Non-nil means commands that move by lines ignore invisible newlines.
+When this option is non-nil, \\[next-line], \\[previous-line], \\[move-end-of-line], and \\[move-beginning-of-line] behave
+as if newlines that are invisible didn't exist, and count
+only visible newlines. Thus, moving across across 2 newlines
+one of which is invisible will be counted as a one-line move.
+Also, a non-nil value causes invisible text to be ignored when
+counting columns for the purposes of keeping point in the same
+column by \\[next-line] and \\[previous-line].
+
Outline mode sets this."
:type 'boolean
:group 'editing-basics)
@@ -4740,8 +5538,14 @@ lines."
:group 'editing-basics
:version "23.1")
+;; Only used if display-graphic-p.
+(declare-function font-info "font.c" (name &optional frame))
+
(defun default-font-height ()
- "Return the height in pixels of the current buffer's default face font."
+ "Return the height in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the height of the remapped face."
(let ((default-font (face-font 'default)))
(cond
((and (display-multi-font-p)
@@ -4752,6 +5556,25 @@ lines."
(aref (font-info default-font) 3))
(t (frame-char-height)))))
+(defun default-font-width ()
+ "Return the width in pixels of the current buffer's default face font.
+
+If the default font is remapped (see `face-remapping-alist'), the
+function returns the width of the remapped face."
+ (let ((default-font (face-font 'default)))
+ (cond
+ ((and (display-multi-font-p)
+ ;; Avoid calling font-info if the frame's default font was
+ ;; not changed since the frame was created. That's because
+ ;; font-info is expensive for some fonts, see bug #14838.
+ (not (string= (frame-parameter nil 'font) default-font)))
+ (let* ((info (font-info (face-font 'default)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10))))
+ (t (frame-char-width)))))
+
(defun default-line-height ()
"Return the pixel height of current buffer's default-face text line.
@@ -4765,7 +5588,7 @@ or the frame."
0)
0)))
(if (floatp lsp)
- (setq lsp (* dfh lsp)))
+ (setq lsp (truncate (* (frame-char-height) lsp))))
(+ dfh lsp)))
(defun window-screen-lines ()
@@ -4777,10 +5600,9 @@ in the window, not in units of the frame's default font, and also accounts
for `line-spacing', if any, defined for the window's buffer or frame.
The value is a floating-point number."
- (let ((canonical (window-text-height))
- (fch (frame-char-height))
+ (let ((edges (window-inside-pixel-edges))
(dlh (default-line-height)))
- (/ (* (float canonical) fch) dlh)))
+ (/ (float (- (nth 3 edges) (nth 1 edges))) dlh)))
;; Returns non-nil if partial move was done.
(defun line-move-partial (arg noerror to-end)
@@ -4899,8 +5721,14 @@ The value is a floating-point number."
;; a cleaner solution to the problem of making C-n do something
;; useful given a tall image.
(defun line-move (arg &optional noerror to-end try-vscroll)
+ "Move forward ARG lines.
+If NOERROR, don't signal an error if we can't move ARG lines.
+TO-END is unused.
+TRY-VSCROLL controls whether to vscroll tall lines: if either
+`auto-window-vscroll' or TRY-VSCROLL is nil, this function will
+not vscroll."
(if noninteractive
- (forward-line arg)
+ (line-move-1 arg noerror to-end)
(unless (and auto-window-vscroll try-vscroll
;; Only vscroll for single line moves
(= (abs arg) 1)
@@ -4918,7 +5746,16 @@ The value is a floating-point number."
;; When the text in the window is scrolled to the left,
;; display-based motion doesn't make sense (because each
;; logical line occupies exactly one screen line).
- (not (> (window-hscroll) 0)))
+ (not (> (window-hscroll) 0))
+ ;; Likewise when the text _was_ scrolled to the left
+ ;; when the current run of vertical motion commands
+ ;; started.
+ (not (and (memq last-command
+ `(next-line previous-line ,this-command))
+ auto-hscroll-mode
+ (numberp temporary-goal-column)
+ (>= temporary-goal-column
+ (- (window-width) hscroll-margin)))))
(prog1 (line-move-visual arg noerror)
;; If we moved into a tall line, set vscroll to make
;; scrolling through tall images more smooth.
@@ -4939,6 +5776,8 @@ The value is a floating-point number."
;; Arg says how many lines to move. The value is t if we can move the
;; specified number of lines.
(defun line-move-visual (arg &optional noerror)
+ "Move ARG lines forward.
+If NOERROR, don't signal an error if we can't move that many lines."
(let ((opoint (point))
(hscroll (window-hscroll))
target-hscroll)
@@ -4952,15 +5791,24 @@ The value is a floating-point number."
(> (cdr temporary-goal-column) 0))
(setq target-hscroll (cdr temporary-goal-column)))
;; Otherwise, we should reset `temporary-goal-column'.
- (let ((posn (posn-at-point)))
+ (let ((posn (posn-at-point))
+ x-pos)
(cond
;; Handle the `overflow-newline-into-fringe' case:
((eq (nth 1 posn) 'right-fringe)
(setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
((car (posn-x-y posn))
+ (setq x-pos (car (posn-x-y posn)))
+ ;; In R2L lines, the X pixel coordinate is measured from the
+ ;; left edge of the window, but columns are still counted
+ ;; from the logical-order beginning of the line, i.e. from
+ ;; the right edge in this case. We need to adjust for that.
+ (if (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq x-pos (- (window-body-width nil t) 1 x-pos)))
(setq temporary-goal-column
- (cons (/ (float (car (posn-x-y posn)))
- (frame-char-width)) hscroll))))))
+ (cons (/ (float x-pos)
+ (frame-char-width))
+ hscroll))))))
(if target-hscroll
(set-window-hscroll (selected-window) target-hscroll))
;; vertical-motion can move more than it was asked to if it moves
@@ -5151,7 +5999,7 @@ The value is a floating-point number."
;; the middle of a continued line. When we get to
;; line-move-finish, point is at the start of a new *screen*
;; line but the same text line; then line-move-to-column would
- ;; move us backwards. Test using C-n with point on the "x" in
+ ;; move us backwards. Test using C-n with point on the "x" in
;; (insert "a" (propertize "x" 'field t) (make-string 89 ?y))
(and forward
(< (point) old)
@@ -5240,7 +6088,11 @@ and `current-column' to be able to ignore invisible text."
;; that will get us to the same place on the screen
;; but with a more reasonable buffer position.
(goto-char normal-location)
- (let ((line-beg (line-beginning-position)))
+ (let ((line-beg
+ ;; We want the real line beginning, so it's consistent
+ ;; with bolp below, otherwise we might infloop.
+ (let ((inhibit-field-text-motion t))
+ (line-beginning-position))))
(while (and (not (bolp)) (invisible-p (1- (point))))
(goto-char (previous-char-property-change (point) line-beg))))))))
@@ -5309,9 +6161,9 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(goto-char (previous-char-property-change (point)))
(skip-chars-backward "^\n"))
- ;; Now find first visible char in the line
- (while (and (not (eobp)) (invisible-p (point)))
- (goto-char (next-char-property-change (point))))
+ ;; Now find first visible char in the line.
+ (while (and (< (point) orig) (invisible-p (point)))
+ (goto-char (next-char-property-change (point) orig)))
(setq first-vis (point))
;; See if fields would stop us from reaching FIRST-VIS.
@@ -5542,7 +6394,9 @@ With prefix arg ARG, effect is to take character before point
and drag it forward past ARG other characters (backward if ARG negative).
If no argument and at end of line, the previous two chars are exchanged."
(interactive "*P")
- (and (null arg) (eolp) (forward-char -1))
+ (when (and (null arg) (eolp) (not (bobp))
+ (not (get-text-property (1- (point)) 'read-only)))
+ (forward-char -1))
(transpose-subr 'forward-char (prefix-numeric-value arg)))
(defun transpose-words (arg)
@@ -5909,7 +6763,7 @@ beyond `current-fill-column' automatically breaks the line at a
previous space.
When `auto-fill-mode' is on, the `auto-fill-function' variable is
-non-`nil'.
+non-nil.
The value of `normal-auto-fill-function' specifies the function to use
for `auto-fill-function' when turning Auto Fill mode on."
@@ -6107,14 +6961,23 @@ If called from Lisp, enable the mode if ARG is omitted or nil."
:group 'paren-matching)
(defcustom blink-matching-paren t
- "Non-nil means show matching open-paren when close-paren is inserted."
- :type 'boolean
+ "Non-nil means show matching open-paren when close-paren is inserted.
+If t, highlight the paren. If `jump', briefly move cursor to its
+position. If `jump-offscreen', move cursor there even if the
+position is off screen. With any other non-nil value, the
+off-screen position of the opening paren will be shown in the
+echo area."
+ :type '(choice
+ (const :tag "Disable" nil)
+ (const :tag "Highlight" t)
+ (const :tag "Move cursor" jump)
+ (const :tag "Move cursor, even if off screen" jump-offscreen))
:group 'paren-blinking)
(defcustom blink-matching-paren-on-screen t
"Non-nil means show matching open-paren when it is on screen.
If nil, don't show it (but the open-paren can still be shown
-when it is off screen).
+in the echo area when it is off screen).
This variable has no effect if `blink-matching-paren' is nil.
\(In that case, the open-paren is never shown.)
@@ -6168,8 +7031,15 @@ position just before the opening token and END is the position right after.
START can be nil, if it was not found.
The function should return non-nil if the two tokens do not match.")
+(defvar blink-matching--overlay
+ (let ((ol (make-overlay (point) (point) nil t)))
+ (overlay-put ol 'face 'show-paren-match)
+ (delete-overlay ol)
+ ol)
+ "Overlay used to highlight the matching paren.")
+
(defun blink-matching-open ()
- "Move cursor momentarily to the beginning of the sexp before point."
+ "Momentarily highlight the beginning of the sexp before point."
(interactive)
(when (and (not (bobp))
blink-matching-paren)
@@ -6188,6 +7058,7 @@ 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.
@@ -6210,18 +7081,28 @@ The function should return non-nil if the two tokens do not match.")
(minibuffer-message "No matching parenthesis found")
(message "No matching parenthesis found"))))
((not blinkpos) nil)
- ((pos-visible-in-window-p blinkpos)
- ;; Matching open within window, temporarily move to blinkpos but only
- ;; if `blink-matching-paren-on-screen' is non-nil.
+ ((or
+ (eq blink-matching-paren 'jump-offscreen)
+ (pos-visible-in-window-p blinkpos))
+ ;; Matching open within window, temporarily move to or highlight
+ ;; char after blinkpos but only if `blink-matching-paren-on-screen'
+ ;; is non-nil.
(and blink-matching-paren-on-screen
(not show-paren-mode)
- (save-excursion
- (goto-char blinkpos)
- (sit-for blink-matching-delay))))
+ (if (memq blink-matching-paren '(jump jump-offscreen))
+ (save-excursion
+ (goto-char blinkpos)
+ (sit-for blink-matching-delay))
+ (unwind-protect
+ (progn
+ (move-overlay blink-matching--overlay blinkpos (1+ blinkpos)
+ (current-buffer))
+ (sit-for blink-matching-delay))
+ (delete-overlay blink-matching--overlay)))))
(t
- (save-excursion
- (goto-char blinkpos)
- (let ((open-paren-line-string
+ (let ((open-paren-line-string
+ (save-excursion
+ (goto-char blinkpos)
;; Show what precedes the open in its line, if anything.
(cond
((save-excursion (skip-chars-backward " \t") (not (bolp)))
@@ -6248,9 +7129,10 @@ The function should return non-nil if the two tokens do not match.")
"..."
(buffer-substring blinkpos (1+ blinkpos))))
;; There is nothing to show except the char itself.
- (t (buffer-substring blinkpos (1+ blinkpos))))))
- (message "Matches %s"
- (substring-no-properties open-paren-line-string)))))))))
+ (t (buffer-substring blinkpos (1+ blinkpos)))))))
+ (minibuffer-message
+ "Matches %s"
+ (substring-no-properties open-paren-line-string))))))))
(defvar blink-paren-function 'blink-matching-open
"Function called, if non-nil, whenever a close parenthesis is inserted.
@@ -6263,6 +7145,8 @@ More precisely, a char with closeparen syntax is self-inserted.")
(not executing-kbd-macro)
(not noninteractive)
;; Verify an even number of quoting characters precede the close.
+ ;; FIXME: Also check if this parenthesis closes a comment as
+ ;; can happen in Pascal and SML.
(= 1 (logand 1 (- (point)
(save-excursion
(forward-char -1)
@@ -6270,10 +7154,14 @@ More precisely, a char with closeparen syntax is self-inserted.")
(point))))))
(funcall blink-paren-function)))
+(put 'blink-paren-post-self-insert-function 'priority 100)
+
(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
;; Most likely, this hook is nil, so this arg doesn't matter,
;; but I use it as a reminder that this function usually
- ;; likes to be run after others since it does `sit-for'.
+ ;; likes to be run after others since it does
+ ;; `sit-for'. That's also the reason it get a `priority' prop
+ ;; of 100.
'append)
;; This executes C-g typed while Emacs is waiting for a command.
@@ -6290,6 +7178,12 @@ At top-level, as an editor command, this simply beeps."
(deactivate-mark))
(if (fboundp 'kmacro-keyboard-quit)
(kmacro-keyboard-quit))
+ (when completion-in-region-mode
+ (completion-in-region-mode -1))
+ ;; Force the next redisplay cycle to remove the "Def" indicator from
+ ;; all the mode lines.
+ (if defining-kbd-macro
+ (force-mode-line-update t))
(setq defining-kbd-macro nil)
(let ((debug-on-quit nil))
(signal 'quit nil)))
@@ -6464,7 +7358,7 @@ buffer buried."
(push var warn-vars)))
(when warn-vars
(display-warning 'mail
- (format "\
+ (format-message "\
The default mail mode is now Message mode.
You have the following Mail mode variable%s customized:
\n %s\n\nTo use Mail mode, set `mail-user-agent' to sendmail-user-agent.
@@ -6515,6 +7409,11 @@ it were the arg to `interactive' (which see) to interactively read VALUE.
If VARIABLE has been defined with `defcustom', then the type information
in the definition is used to check that VALUE is valid.
+Note that this function is at heart equivalent to the basic `set' function.
+For a variable defined with `defcustom', it does not pay attention to
+any :set property that the variable might have (if you want that, use
+\\[customize-set-variable] instead).
+
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive
(let* ((default-var (variable-at-point))
@@ -6559,8 +7458,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
(require 'cus-edit)
(setq type (widget-convert type))
(unless (widget-apply type :match value)
- (error "Value `%S' does not match type %S of %S"
- value (car type) variable))))
+ (user-error "Value `%S' does not match type %S of %S"
+ value (car type) variable))))
(if make-local
(make-local-variable variable))
@@ -6575,13 +7474,15 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
(defvar completion-list-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [mouse-2] 'choose-completion)
(define-key map [follow-link] 'mouse-face)
(define-key map [down-mouse-2] nil)
(define-key map "\C-m" 'choose-completion)
(define-key map "\e\e\e" 'delete-completion-window)
(define-key map [left] 'previous-completion)
(define-key map [right] 'next-completion)
+ (define-key map [?\t] 'next-completion)
+ (define-key map [backtab] 'previous-completion)
(define-key map "q" 'quit-window)
(define-key map "z" 'kill-this-buffer)
map)
@@ -6669,7 +7570,8 @@ With prefix argument N, move N items (negative N means move backward)."
(setq n (1+ n))))))
(defun choose-completion (&optional event)
- "Choose the completion at point."
+ "Choose the completion at point.
+If EVENT, use EVENT's position to determine the starting position."
(interactive (list last-nonmenu-event))
;; In case this is run via the mouse, give temporary modes such as
;; isearch a chance to turn off.
@@ -6740,12 +7642,10 @@ With prefix argument N, move N items (negative N means move backward)."
(defvar choose-completion-string-functions nil
"Functions that may override the normal insertion of a completion choice.
-These functions are called in order with four arguments:
+These functions are called in order with three arguments:
CHOICE - the string to insert in the buffer,
BUFFER - the buffer in which the choice should be inserted,
-MINI-P - non-nil if BUFFER is a minibuffer, and
-BASE-SIZE - the number of characters in BUFFER before
-the string being completed.
+BASE-POSITION - where to insert the completion.
If a function in the list returns non-nil, that function is supposed
to have inserted the CHOICE in the BUFFER, and possibly exited
@@ -6825,8 +7725,7 @@ back on `completion-list-insert-choice-function' when nil."
"Major mode for buffers showing lists of possible completions.
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
-Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
- with the mouse.
+Or click to select one with the mouse.
\\{completion-list-mode-map}"
(set (make-local-variable 'completion-base-size) nil))
@@ -6883,8 +7782,7 @@ Called from `temp-buffer-show-hook'."
(when completion-show-help
(goto-char (point-min))
(if (display-mouse-p)
- (insert (substitute-command-keys
- "Click \\[mouse-choose-completion] on a completion to select it.\n")))
+ (insert "Click on a completion to select it.\n"))
(insert (substitute-command-keys
"In this buffer, type \\[choose-completion] to \
select the completion near point.\n\n"))))))
@@ -6988,17 +7886,11 @@ PREFIX is the string that represents this modifier in an event type symbol."
(normal (nth 1 keypad-normal)))
(put keypad 'ascii-character normal)
(define-key function-key-map (vector keypad) (vector normal))))
- '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
- (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
- (kp-space ?\s)
+ ;; See also kp-keys bound in bindings.el.
+ '((kp-space ?\s)
(kp-tab ?\t)
(kp-enter ?\r)
- (kp-multiply ?*)
- (kp-add ?+)
(kp-separator ?,)
- (kp-subtract ?-)
- (kp-decimal ?.)
- (kp-divide ?/)
(kp-equal ?=)
;; Do the same for various keys that are represented as symbols under
;; GUIs but naturally correspond to characters.
@@ -7153,7 +8045,9 @@ DISPLAY-FLAG non-nil means show the new buffer with `pop-to-buffer'.
This is always done when called interactively.
Optional third arg NORECORD non-nil means do not put this buffer at the
-front of the list of recently selected ones."
+front of the list of recently selected ones.
+
+Returns the newly created indirect buffer."
(interactive
(progn
(if (get major-mode 'no-clone-indirect)
@@ -7295,7 +8189,7 @@ See also `normal-erase-is-backspace'."
(if enabled
(progn
(define-key local-function-key-map [delete] [deletechar])
- (define-key local-function-key-map [kp-delete] [?\C-d])
+ (define-key local-function-key-map [kp-delete] [deletechar])
(define-key local-function-key-map [backspace] [?\C-?])
(dolist (b bindings)
;; Not sure if input-decode-map is really right, but
@@ -7370,6 +8264,24 @@ and setting it to nil."
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
+(defvar messages-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map special-mode-map)
+ (define-key map "g" nil) ; nothing to revert
+ map))
+
+(define-derived-mode messages-buffer-mode special-mode "Messages"
+ "Major mode used in the \"*Messages*\" buffer.")
+
+(defun messages-buffer ()
+ "Return the \"*Messages*\" buffer.
+If it does not exist, create and it switch it to `messages-buffer-mode'."
+ (or (get-buffer "*Messages*")
+ (with-current-buffer (get-buffer-create "*Messages*")
+ (messages-buffer-mode)
+ (current-buffer))))
+
+
;; Minibuffer prompt stuff.
;;(defun minibuffer-prompt-modification (start end)
@@ -7419,7 +8331,7 @@ version and use the one distributed with Emacs."))
Each element has the form (PACKAGE SYMBOL REGEXP STRING).
PACKAGE is either a regular expression to match file names, or a
symbol (a feature name), like for `with-eval-after-load'.
-SYMBOL is either the name of a string variable, or `t'. Upon
+SYMBOL is either the name of a string variable, or t. Upon
loading PACKAGE, if SYMBOL is t or matches REGEXP, display a
warning using STRING as the message.")
@@ -7457,10 +8369,21 @@ warning using STRING as the message.")
;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives
(defmacro define-alternatives (command &rest customizations)
- "Define new command `COMMAND'.
-The variable `COMMAND-alternatives' will contain alternative
-implementations of COMMAND, so that running `C-u M-x COMMAND'
-will allow the user to chose among them.
+ "Define the new command `COMMAND'.
+
+The argument `COMMAND' should be a symbol.
+
+Running `M-x COMMAND RET' for the first time prompts for which
+alternative to use and records the selected command as a custom
+variable.
+
+Running `C-u M-x COMMAND RET' prompts again for an alternative
+and overwrites the previous choice.
+
+The variable `COMMAND-alternatives' contains an alist with
+alternative implementations of COMMAND. `define-alternatives'
+does not have any effect until this variable is set.
+
CUSTOMIZATIONS, if non-nil, should be composed of alternating
`defcustom' keywords and values to add to the declaration of
`COMMAND-alternatives' (typically :group and :version)."
@@ -7480,6 +8403,7 @@ ALTFUN - The function called to implement this alternative."
:type '(alist :key-type string :value-type function)
,@customizations)
+ (put ',varalt-sym 'definition-name ',command)
(defvar ,varimp-sym nil "Internal use only.")
(defun ,command (&optional arg)
@@ -7491,15 +8415,57 @@ contains the list of implementations currently supported for this command."
(interactive "P")
(when (or arg (null ,varimp-sym))
(let ((val (completing-read
- ,(format "Select implementation for command `%s': " command-name)
- ,varalt-sym nil t)))
+ ,(format-message
+ "Select implementation for command `%s': "
+ command-name)
+ ,varalt-sym nil t)))
(unless (string-equal val "")
- (customize-save-variable ',varimp-sym
- (cdr (assoc-string val ,varalt-sym))))))
+ (when (null ,varimp-sym)
+ (message
+ "Use C-u M-x %s RET`to select another implementation"
+ ,command-name)
+ (sit-for 3))
+ (customize-save-variable ',varimp-sym
+ (cdr (assoc-string val ,varalt-sym))))))
(if ,varimp-sym
- (funcall ,varimp-sym)
- (message ,(format "No implementation selected for command `%s'"
- command-name)))))))
+ (call-interactively ,varimp-sym)
+ (message "%s" ,(format-message
+ "No implementation selected for command `%s'"
+ command-name)))))))
+
+
+;;; Functions for changing capitalization that Do What I Mean
+(defun upcase-dwim (arg)
+ "Upcase words in the region, if active; if not, upcase word at point.
+If the region is active, this function calls `upcase-region'.
+Otherwise, it calls `upcase-word', with prefix argument passed to it
+to upcase ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (upcase-region (region-beginning) (region-end))
+ (upcase-word arg)))
+
+(defun downcase-dwim (arg)
+ "Downcase words in the region, if active; if not, downcase word at point.
+If the region is active, this function calls `downcase-region'.
+Otherwise, it calls `downcase-word', with prefix argument passed to it
+to downcase ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (downcase-region (region-beginning) (region-end))
+ (downcase-word arg)))
+
+(defun capitalize-dwim (arg)
+ "Capitalize words in the region, if active; if not, capitalize word at point.
+If the region is active, this function calls `capitalize-region'.
+Otherwise, it calls `capitalize-word', with prefix argument passed to it
+to capitalize ARG words."
+ (interactive "*p")
+ (if (use-region-p)
+ (capitalize-region (region-beginning) (region-end))
+ (capitalize-word arg)))
+
+
(provide 'simple)
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index a7eae7464e2..67d9faca3e4 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -1,9 +1,9 @@
-;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*-
+;;; skeleton.el --- Lisp language extension for writing statement skeletons
-;; Copyright (C) 1993-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, abbrev, languages, tools
;; This file is part of GNU Emacs.
@@ -55,22 +55,15 @@ Typical examples might be `upcase' or `capitalize'.")
When the region is visible (due to `transient-mark-mode' or marking a region
with the mouse) and this is non-nil and the function was called without an
explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
-region.
-
-We will probably delete this variable in a future Emacs version
-unless we get a substantial number of complaints about the auto-wrap
-feature.")
+region.")
+(make-obsolete-variable 'skeleton-autowrap nil "24.5")
(defvar skeleton-end-newline t
"If non-nil, make sure that the skeleton inserted ends with a newline.
This just influences the way the default `skeleton-end-hook' behaves.")
-(defvar skeleton-end-hook
- (lambda ()
- (or (eolp) (not skeleton-end-newline) (newline-and-indent)))
+(defvar skeleton-end-hook nil
"Hook called at end of skeleton but before going to point of interest.
-By default this moves out anything following to next line,
- unless `skeleton-end-newline' is set to nil.
The variables `v1' and `v2' are still set when calling this.")
@@ -183,7 +176,7 @@ of `str' whereas the skeleton's interactor is then ignored."
With optional second argument REGIONS, wrap first interesting point
\(`_') in skeleton around next REGIONS words, if REGIONS is positive.
If REGIONS is negative, wrap REGIONS preceding interregions into first
-REGIONS interesting positions \(successive `_'s) in skeleton.
+REGIONS interesting positions (successive `_'s) in skeleton.
An interregion is the stretch of text between two contiguous marked
points. If you marked A B C [] (where [] is the cursor) in
@@ -200,7 +193,9 @@ not needed, a prompt-string or an expression for complex read functions.
If ELEMENT is a string or a character it gets inserted (see also
`skeleton-transformation-function'). Other possibilities are:
- \\n go to next line and indent according to mode
+ \\n go to next line and indent according to mode, unless
+ this is the first/last element of a skeleton and point
+ is at bol/eol
_ interesting point, interregion here
- interesting point, no interregion interaction, overrides
interesting point set by _
@@ -208,21 +203,26 @@ If ELEMENT is a string or a character it gets inserted (see also
@ add position to `skeleton-positions'
& do next ELEMENT if previous moved point
| do next ELEMENT if previous didn't move point
- -num delete num preceding characters (see `skeleton-untabify')
+ -NUM delete NUM preceding characters (see `skeleton-untabify')
resume: skipped, continue here if quit is signaled
nil skipped
After termination, point will be positioned at the last occurrence of -
or at the first occurrence of _ or at the end of the inserted text.
-Further elements can be defined via `skeleton-further-elements'. ELEMENT may
-itself be a SKELETON with an INTERACTOR. The user is prompted repeatedly for
-different inputs. The SKELETON is processed as often as the user enters a
-non-empty string. \\[keyboard-quit] terminates skeleton insertion, but
-continues after `resume:' and positions at `_' if any. If INTERACTOR in such
-a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list of
-strings with the subskeleton being repeated once for each string.
+Note that \\n as the last element of the skeleton only inserts a
+newline if not at eol. If you want to unconditionally insert a newline
+at the end of the skeleton, use \"\\n\" instead. Likewise with \\n
+as the first element when at bol.
+
+Further elements can be defined via `skeleton-further-elements'.
+ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted
+repeatedly for different inputs. The SKELETON is processed as often as
+the user enters a non-empty string. \\[keyboard-quit] terminates skeleton insertion, but
+continues after `resume:' and positions at `_' if any. If INTERACTOR in
+such a subskeleton is a prompt-string which contains a \".. %s ..\" it is
+formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list
+of strings with the subskeleton being repeated once for each string.
Quoted Lisp expressions are evaluated for their side-effects.
Other Lisp expressions are evaluated and the value treated as above.
@@ -264,6 +264,7 @@ When done with skeleton, but before going back to `_'-point call
(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 (pos-visible-in-window-p beg)
@@ -276,7 +277,8 @@ When done with skeleton, but before going back to `_'-point call
(defun skeleton-read (prompt &optional initial-input recursive)
"Function for reading a string from the minibuffer within skeletons.
-PROMPT must be a string or a form that evaluates to a string.
+PROMPT must be a string or a function that evaluates to a string.
+It may also be a form that evaluates to a string (deprecated).
It may contain a `%s' which will be replaced by `skeleton-subprompt'.
If non-nil second arg INITIAL-INPUT or variable `input' is a string or
cons with index to insert before reading. If third arg RECURSIVE is non-nil
@@ -305,12 +307,14 @@ automatically, and you are prompted to fill in the variable parts.")))
;; before point.
(save-excursion (insert "\n")))
(unwind-protect
- (setq prompt (if (stringp prompt)
- (read-string (format prompt skeleton-subprompt)
- (setq initial-input
- (or initial-input
- (symbol-value 'input))))
- (eval prompt)))
+ (setq prompt (cond ((stringp prompt)
+ (read-string (format prompt skeleton-subprompt)
+ (setq initial-input
+ (or initial-input
+ (symbol-value 'input)))))
+ ((functionp prompt)
+ (funcall prompt))
+ (t (eval prompt))))
(or eolp
(delete-char 1))))
(if (and recursive
@@ -356,15 +360,6 @@ automatically, and you are prompted to fill in the variable parts.")))
(signal 'quit 'recursive)
recursive))
-(defun skeleton-newline ()
- (if (or (eq (point) skeleton-point)
- (eq (point) (car skeleton-positions)))
- ;; If point is recorded, avoid `newline' since it may do things like
- ;; strip trailing spaces, and since recorded points are commonly placed
- ;; right after a trailing space, calling `newline' can destroy the
- ;; position and renders the recorded position incorrect.
- (insert "\n")
- (newline)))
(defun skeleton-internal-1 (element &optional literal recursive)
(cond
@@ -384,7 +379,7 @@ automatically, and you are prompted to fill in the variable parts.")))
(let ((pos (if (eq element '>) (point))))
(cond
((and skeleton-regions (eq (nth 1 skeleton-il) '_))
- (or (eolp) (newline))
+ (or (eolp) (insert "\n"))
(if pos (save-excursion (goto-char pos) (indent-according-to-mode)))
(indent-region (line-beginning-position)
(car skeleton-regions) nil))
@@ -393,13 +388,13 @@ automatically, and you are prompted to fill in the variable parts.")))
(if pos (indent-according-to-mode)))
(skeleton-newline-indent-rigidly
(let ((pt (point)))
- (skeleton-newline)
+ (insert "\n")
(indent-to (save-excursion
(goto-char pt)
(if pos (indent-according-to-mode))
(current-indentation)))))
(t (if pos (reindent-then-newline-and-indent)
- (skeleton-newline)
+ (insert "\n")
(indent-according-to-mode))))))
((eq element '>)
(if (and skeleton-regions (eq (nth 1 skeleton-il) '_))
@@ -489,7 +484,7 @@ This allows for context-sensitive checking whether pairing is appropriate.")
Each alist element, which looks like (ELEMENT ...), is passed to
`skeleton-insert' with no interactor. Variable `str' does nothing.
-Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).")
+Elements might be (?\\=` ?\\=` _ \"\\='\\='\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).")
(defvar skeleton-pair-default-alist '((?( _ ?)) (?\))
(?[ _ ?]) (?\])
@@ -510,15 +505,15 @@ Pairing is also prohibited if we are right after a quoting character
such as backslash.
If a match is found in `skeleton-pair-alist', that is inserted, else
-the defaults are used. These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others."
+the defaults are used. These are (), [], {}, <> and (grave
+accent, apostrophe) for the paired ones, and the same character
+twice for the others."
(interactive "*P")
(if (or arg (not skeleton-pair))
(self-insert-command (prefix-numeric-value arg))
(let* ((mark (and skeleton-autowrap
(or (eq last-command 'mouse-drag-region)
(and transient-mark-mode mark-active))))
- (skeleton-end-hook)
(char last-command-event)
(skeleton (or (assq char skeleton-pair-alist)
(assq char skeleton-pair-default-alist)
@@ -529,7 +524,9 @@ symmetrical ones, and the same character twice for the others."
(if (not skeleton-pair-on-word) (looking-at "\\w"))
(funcall skeleton-pair-filter-function))))
(self-insert-command (prefix-numeric-value arg))
- (skeleton-insert (cons nil skeleton) (if mark -1))))))
+ ;; Newlines not desirable for inserting pairs. See bug#16138.
+ (let ((skeleton-end-newline nil))
+ (skeleton-insert (cons nil skeleton) (if mark -1)))))))
;; A more serious example can be found in sh-script.el
diff --git a/lisp/sort.el b/lisp/sort.el
index 9493768f6a0..9843749f0c8 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -1,10 +1,10 @@
;;; sort.el --- commands to sort text in an Emacs buffer
-;; Copyright (C) 1986-1987, 1994-1995, 2001-2013 Free Software
+;; Copyright (C) 1986-1987, 1994-1995, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Howie Kaye
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix
;; This file is part of GNU Emacs.
@@ -316,7 +316,7 @@ FIELD, BEG and END. BEG and END specify region to sort."
;; (point)
;; (save-excursion
;; (re-search-forward
-;; "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
+;; "[+-]?[0-9]*\\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
;; (point))))))
;; nil))
@@ -570,25 +570,23 @@ From a program takes two point or marker arguments, BEG and END."
;;;###autoload
(defun delete-duplicate-lines (beg end &optional reverse adjacent keep-blanks
interactive)
- "Delete duplicate lines in the region between BEG and END.
-
-If REVERSE is nil, search and delete duplicates forward keeping the first
-occurrence of duplicate lines. If REVERSE is non-nil (when called
-interactively with C-u prefix), search and delete duplicates backward
-keeping the last occurrence of duplicate lines.
-
-If ADJACENT is non-nil (when called interactively with two C-u prefixes),
-delete repeated lines only if they are adjacent. It works like the utility
-`uniq' and is useful when lines are already sorted in a large file since
-this is more efficient in performance and memory usage than when ADJACENT
-is nil that uses additional memory to remember previous lines.
-
-If KEEP-BLANKS is non-nil (when called interactively with three C-u prefixes),
-duplicate blank lines are preserved.
-
-When called from Lisp and INTERACTIVE is omitted or nil, return the number
-of deleted duplicate lines, do not print it; if INTERACTIVE is t, the
-function behaves in all respects as if it had been called interactively."
+ "Delete all but one copy of any identical lines in the region.
+Non-interactively, arguments BEG and END delimit the region.
+Normally it searches forwards, keeping the first instance of
+each identical line. If REVERSE is non-nil (interactively, with
+a C-u prefix), it searches backwards and keeps the last instance of
+each repeated line.
+
+Identical lines need not be adjacent, unless the argument
+ADJACENT is non-nil (interactively, with a C-u C-u prefix).
+This is a more efficient mode of operation, and may be useful
+on large regions that have already been sorted.
+
+If the argument KEEP-BLANKS is non-nil (interactively, with a
+C-u C-u C-u prefix), it retains repeated blank lines.
+
+Returns the number of deleted lines. Interactively, or if INTERACTIVE
+is non-nil, it also prints a message describing the number of deletions."
(interactive
(progn
(barf-if-buffer-read-only)
@@ -597,7 +595,7 @@ function behaves in all respects as if it had been called interactively."
(equal current-prefix-arg '(16))
(equal current-prefix-arg '(64))
t)))
- (let ((lines (unless adjacent (make-hash-table :weakness 'key :test 'equal)))
+ (let ((lines (unless adjacent (make-hash-table :test 'equal)))
line prev-line
(count 0)
(beg (copy-marker beg))
diff --git a/lisp/soundex.el b/lisp/soundex.el
index 0dc26e28d2e..f2d08e16855 100644
--- a/lisp/soundex.el
+++ b/lisp/soundex.el
@@ -1,9 +1,9 @@
;;; soundex.el --- implement Soundex algorithm
-;; Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Christian Plaunt <chris@bliss.berkeley.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: matching
;; Created: Sat May 15 14:48:18 1993
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index d9f59b3a665..17430587818 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -1,6 +1,6 @@
;;; speedbar --- quick access to files and tags in a frame
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Keywords: file, tags, tools
@@ -39,21 +39,9 @@ this version is not backward compatible to 0.14 or earlier.")
;;
;;; Notes:
;;
-;; Users of really old emacsen without the need timer functions
-;; will not have speedbar updating automatically. Use "g" to refresh
-;; the display after changing directories. Remember, do not interrupt
-;; the stealthy updates or your display may not be completely
-;; refreshed.
-;;
;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very
;; well. Use the imenu keywords from tex-mode.el for better results.
;;
-;; This file requires the library package assoc (association lists)
-;; assoc should be available in all modern versions of Emacs.
-;; The custom package is optional (for easy configuration of speedbar)
-;; http://www.dina.kvl.dk/~abraham/custom/
-;; custom is available in all versions of Emacs version 20 or better.
-;;
;;; Developing for speedbar
;;
;; Adding a speedbar specialized display mode:
@@ -135,17 +123,21 @@ this version is not backward compatible to 0.14 or earlier.")
:group 'etags
:group 'tools
:group 'convenience
+ :link '(custom-manual "(speedbar) Top")
+ :link '(info-link "(speedbar) Customizing")
; :version "20.3"
)
(defgroup speedbar-faces nil
"Faces used in speedbar."
:prefix "speedbar-"
+ :link '(info-link "(speedbar) Frames and Faces")
:group 'speedbar
:group 'faces)
(defgroup speedbar-vc nil
"Version control display in speedbar."
+ :link '(info-link "(speedbar) Version Control")
:prefix "speedbar-"
:group 'speedbar)
@@ -211,7 +203,7 @@ the user is done with the current expansion list.")
)
"List of functions to periodically call stealthily.
This list is of the form:
- '( (\"NAME\" FUNCTION ...)
+ ( (\"NAME\" FUNCTION ...)
...)
where NAME is the name of the major display mode these functions are
for, and the remaining elements FUNCTION are functions to call in order.
@@ -466,9 +458,9 @@ items is reached."
(defcustom speedbar-directory-button-trim-method 'span
"Indicates how the directory button will be displayed.
Possible values are:
- 'span - span large directories over multiple lines.
- 'trim - trim large directories to only show the last few.
- nil - no trimming."
+ `span' - span large directories over multiple lines.
+ `trim' - trim large directories to only show the last few.
+ nil - no trimming."
:group 'speedbar
:type '(radio (const :tag "Span large directories over multiple lines."
span)
@@ -1007,9 +999,9 @@ supported at a time.
;; with the selected frame.
(list 'parent (selected-frame)))
speedbar-frame-parameters)
- speedbar-before-delete-hook
- speedbar-before-popup-hook
- speedbar-after-create-hook)
+ 'speedbar-before-delete-hook
+ 'speedbar-before-popup-hook
+ 'speedbar-after-create-hook)
;; Start up the timer
(if (not speedbar-frame)
(speedbar-set-timer nil)
@@ -1072,9 +1064,9 @@ If the selected frame is not speedbar, then speedbar frame is
selected. If the speedbar frame is active, then select the attached frame."
(interactive)
(speedbar-reset-scanners)
- (dframe-get-focus 'speedbar-frame 'speedbar-frame-mode
- (lambda () (let ((speedbar-update-flag t))
- (speedbar-timer-fn)))))
+ (dframe-get-focus 'speedbar-frame 'speedbar-frame-mode)
+ (let ((speedbar-update-flag t))
+ (speedbar-timer-fn)))
(defsubst speedbar-frame-width ()
"Return the width of the speedbar frame in characters.
@@ -2119,9 +2111,10 @@ cell of the form ( 'DIRLIST . 'FILELIST )."
;; in order to make it look nice.
;;
;; A generic list is of the form:
-;; ( ("name" . marker-or-number) <-- one tag at this level
-;; ("name" ("name" . mon) ("name" . mon) ) <-- one group of tags
-;; ("name" mon ("name" . mon) ) <-- group w/ a position and tags
+;; ( ("name" . marker-or-number) <-- one tag at this level
+;; ("name" marker-or-number goto-fun . args) <-- one tag at this level
+;; ("name" ("name" . mon) ("name" . mon) ) <-- one group of tags
+;; ("name" mon ("name" . mon) ) <-- group w/ a position and tags
(defun speedbar-generic-list-group-p (sublst)
"Non-nil if SUBLST is a group.
Groups may optionally contain a position."
@@ -2152,6 +2145,8 @@ Groups may optionally contain a position."
(and (stringp (car-safe sublst))
(or (and (number-or-marker-p (cdr-safe sublst))
(not (cdr-safe (cdr-safe sublst))))
+ (ignore-errors (and (number-or-marker-p (nth 1 sublst))
+ (functionp (nth 2 sublst))))
;; For semantic/bovine items, this is needed
(symbolp (car-safe (cdr-safe sublst))))
))
@@ -2862,7 +2857,7 @@ indicator, then do not add a space."
(progn
(goto-char speedbar-ro-to-do-point)
(while (and (not (input-pending-p))
- (re-search-forward "^\\([0-9]+\\):\\s-*[[<][+-\?][]>] "
+ (re-search-forward "^\\([0-9]+\\):\\s-*[[<][+-?][]>] "
nil t))
(setq speedbar-ro-to-do-point (point))
(let ((f (speedbar-line-file)))
@@ -2969,7 +2964,7 @@ that will occur on your system."
(run-hook-with-args 'speedbar-vc-in-control-hook directory name)
))
-;; Objet File scanning
+;; Object File scanning
(defun speedbar-check-objects ()
"Scan all files in a directory, and for each see if there is an object.
See `speedbar-check-obj-this-line' and `speedbar-obj-alist' for how
diff --git a/lisp/startup.el b/lisp/startup.el
index ec7d73306a2..13463107d2e 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,9 +1,9 @@
;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation,
+;; Copyright (C) 1985-1986, 1992, 1994-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -43,20 +43,24 @@
"Buffer to show after starting Emacs.
If the value is nil and `inhibit-startup-screen' is nil, show the
startup screen. If the value is a string, switch to a buffer
-visiting the file or directory specified by that string. If the
-value is a function, switch to the buffer returned by that
-function. If t, open the `*scratch*' buffer.
+visiting the file or directory that the string specifies. If the
+value is a function, call it with no arguments and switch to the buffer
+that it returns. If t, open the `*scratch*' buffer.
-A string value also causes emacsclient to open the specified file
-or directory when no target file is specified."
+When `initial-buffer-choice' is non-nil, the startup screen is
+inhibited.
+
+If you use `emacsclient' with no target file, then it obeys any
+string or function value that this variable has."
:type '(choice
(const :tag "Startup screen" nil)
(directory :tag "Directory" :value "~/")
(file :tag "File" :value "~/.emacs")
- (const :tag "Notes buffer" remember-notes)
+ ;; Note sure about hard-coding this as an option...
+ (const :tag "Remember Mode notes buffer" remember-notes)
(function :tag "Function")
(const :tag "Lisp scratch buffer" t))
- :version "24.4"
+ :version "23.1"
:group 'initialization)
(defcustom inhibit-startup-screen nil
@@ -82,7 +86,7 @@ or if your init file contains a line of this form:
(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
If your init file is byte-compiled, use the following form
instead:
- (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
+ (eval \\='(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
Thus, someone else using a copy of your init file will see the
startup message unless he personally acts to inhibit it."
:type '(choice (const :tag "Don't inhibit")
@@ -110,7 +114,7 @@ the remaining command-line args are in the variable `command-line-args-left'.")
(defvaralias 'argv 'command-line-args-left
"List of command-line args not yet processed.
-This is a convenience alias, so that one can write \(pop argv\)
+This is a convenience alias, so that one can write \(pop argv)
inside of --eval command line arguments in order to access
following arguments.")
(internal-make-var-non-special 'argv)
@@ -282,14 +286,20 @@ these functions will invoke the debugger.")
"Normal hook run after loading init files and handling the command line.")
(defvar term-setup-hook nil
- "Normal hook run after loading terminal-specific Lisp code.
-It also follows `emacs-startup-hook'. This hook exists for users to set,
-so as to override the definitions made by the terminal-specific file.
-Emacs never sets this variable itself.")
+ "Normal hook run immediately after `emacs-startup-hook'.
+In new code, there is no reason to use this instead of `emacs-startup-hook'.
+If you want to execute terminal-specific Lisp code, for example
+to override the definitions made by the terminal-specific file,
+see `tty-setup-hook'.")
+
+(make-obsolete-variable 'term-setup-hook
+ "use either `emacs-startup-hook' or \
+`tty-setup-hook' instead." "24.4")
(defvar inhibit-startup-hooks nil
- "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'.
-This is because we already did so.")
+ "Non-nil means don't run some startup hooks, because we already did.
+Currently this applies to: `emacs-startup-hook', `term-setup-hook',
+and `window-setup-hook'.")
(defvar keyboard-type nil
"The brand of keyboard you are using.
@@ -298,9 +308,12 @@ keys for use under X. It is used in a fashion analogous to the
environment variable TERM.")
(defvar window-setup-hook nil
- "Normal hook run to initialize window system display.
-Emacs runs this hook after processing the command line arguments and loading
-the user's init file.")
+ "Normal hook run after loading init files and handling the command line.
+This is very similar to `emacs-startup-hook'. The only difference
+is that this hook runs after frame parameters have been set up in
+response to any settings from your init file. Unless this matters
+to you, use `emacs-startup-hook' instead. (The name of this hook
+is due to historical reasons, and does not reflect its purpose very well.)")
(defcustom initial-major-mode 'lisp-interaction-mode
"Major mode command symbol to use for the initial `*scratch*' buffer."
@@ -345,10 +358,12 @@ is not allowed, since it would not work anyway. The only way to set
this variable usefully is to set it while building and dumping Emacs."
:type '(choice (const :tag "none" nil) string)
:group 'initialization
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (_variable _value)
(error "Customizing `site-run-file' does not work")))
+(make-obsolete-variable 'system-name "use (system-name) instead" "25.1")
+
(defcustom mail-host-address nil
"Name of this machine, for purposes of naming users.
If non-nil, Emacs uses this instead of `system-name' when constructing
@@ -398,8 +413,6 @@ from being initialized."
(defvar no-blinking-cursor nil)
-(defvar default-frame-background-mode)
-
(defvar pure-space-overflow nil
"Non-nil if building Emacs overflowed pure space.")
@@ -412,22 +425,7 @@ Warning Warning!!! Pure space overflow !!!Warning Warning
"Directory containing the Emacs TUTORIAL files."
:group 'installation
:type 'directory
- :initialize 'custom-initialize-delay)
-
-(defvar package--builtin-versions
- ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
- (purecopy `((emacs . ,(version-to-list emacs-version))))
- "Alist giving the version of each versioned builtin package.
-I.e. each element of the list is of the form (NAME . VERSION) where
-NAME is the package name as a symbol, and VERSION is its version
-as a list.")
-
-(defun package--description-file (dir)
- (concat (let ((subdir (file-name-nondirectory
- (directory-file-name dir))))
- (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
- (match-string 1 subdir) subdir))
- "-pkg.el"))
+ :initialize #'custom-initialize-delay)
(defun normal-top-level-add-subdirs-to-load-path ()
"Add all subdirectories of `default-directory' to `load-path'.
@@ -444,8 +442,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(let* ((this-dir (car dirs))
(contents (directory-files this-dir))
(default-directory this-dir)
- (canonicalized (if (fboundp 'untranslated-canonical-name)
- (untranslated-canonical-name this-dir))))
+ (canonicalized (if (fboundp 'w32-untranslated-canonical-name)
+ (w32-untranslated-canonical-name this-dir))))
;; The Windows version doesn't report meaningful inode numbers, so
;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
@@ -490,60 +488,137 @@ It sets `command-line-processed', processes the command-line,
reads the initialization files, etc.
It is the default value of the variable `top-level'."
(if command-line-processed
- (message "Back to top level.")
+ (message internal--top-level-message)
(setq command-line-processed t)
- (let ((dir default-directory))
- (with-current-buffer "*Messages*"
- ;; Make it easy to do like "tail -f".
- (set (make-local-variable 'window-point-insertion-type) t)
- ;; Give *Messages* the same default-directory as *scratch*,
- ;; just to keep things predictable.
- (setq default-directory dir)))
- ;; `user-full-name' is now known; reset its standard-value here.
- (put 'user-full-name 'standard-value
- (list (default-value 'user-full-name)))
- ;; Look in each dir in load-path for a subdirs.el file.
- ;; If we find one, load it, which will add the appropriate subdirs
- ;; of that dir into load-path,
+
+ ;; Look in each dir in load-path for a subdirs.el file. If we
+ ;; find one, load it, which will add the appropriate subdirs of
+ ;; that dir into load-path. This needs to be done before setting
+ ;; the locale environment, because the latter might need to load
+ ;; some support files.
;; Look for a leim-list.el file too. Loading it will register
;; available input methods.
(let ((tail load-path)
(lispdir (expand-file-name "../lisp" data-directory))
- ;; For out-of-tree builds, leim-list is generated in the build dir.
-;;; (leimdir (expand-file-name "../leim" doc-directory))
dir)
(while tail
(setq dir (car tail))
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
- ;; Do not scan standard directories that won't contain a leim-list.el.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
- (or (string-match (concat "\\`" lispdir) dir)
- (let ((default-directory dir))
- (load (expand-file-name "leim-list.el") t t t)))
+ ;; Do not scan standard directories that won't contain a leim-list.el.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
+ ;; (Except the preloaded one in lisp/leim.)
+ (or (string-prefix-p lispdir dir)
+ (let ((default-directory dir))
+ (load (expand-file-name "leim-list.el") t t t)))
;; We don't use a dolist loop and we put this "setq-cdr" command at
;; the end, because the subdirs.el files may add elements to the end
;; of load-path and we want to take it into account.
(setq tail (cdr tail))))
+
+ ;; Set the default strings to display in mode line for end-of-line
+ ;; formats that aren't native to this platform. This should be
+ ;; done before calling set-locale-environment, as the latter might
+ ;; use these mnemonics.
+ (cond
+ ((memq system-type '(ms-dos windows-nt))
+ (setq eol-mnemonic-unix "(Unix)"
+ eol-mnemonic-mac "(Mac)"))
+ (t ; this is for Unix/GNU/Linux systems
+ (setq eol-mnemonic-dos "(DOS)"
+ eol-mnemonic-mac "(Mac)")))
+
+ (set-locale-environment nil)
+ ;; Decode all default-directory's (probably, only *scratch* exists
+ ;; at this point). default-directory of *scratch* is the basis
+ ;; for many other file-name variables and directory lists, so it
+ ;; is important to decode it ASAP.
+ (when locale-coding-system
+ (let ((coding (if (eq system-type 'windows-nt)
+ ;; MS-Windows build converts all file names to
+ ;; UTF-8 during startup.
+ 'utf-8
+ locale-coding-system)))
+ (save-excursion
+ (dolist (elt (buffer-list))
+ (set-buffer elt)
+ (if default-directory
+ (setq default-directory
+ (decode-coding-string default-directory coding t)))))
+
+ ;; Decode all the important variables and directory lists, now
+ ;; that we know the locale's encoding. This is because the
+ ;; values of these variables are until here unibyte undecoded
+ ;; strings created by build_unibyte_string. data-directory in
+ ;; particular is used to construct many other standard
+ ;; directory names, so it must be decoded ASAP. Note that
+ ;; charset-map-path cannot be decoded here, since we could
+ ;; then be trapped in infinite recursion below, when we load
+ ;; subdirs.el, because encoding a directory name might need to
+ ;; load a charset map, which will want to encode
+ ;; charset-map-path, which will want to load the same charset
+ ;; map... So decoding of charset-map-path is delayed until
+ ;; further down below.
+ (dolist (pathsym '(load-path exec-path))
+ (let ((path (symbol-value pathsym)))
+ (if (listp path)
+ (set pathsym (mapcar (lambda (dir)
+ (decode-coding-string dir coding t))
+ path)))))
+ (dolist (filesym '(data-directory doc-directory exec-directory
+ installation-directory
+ invocation-directory invocation-name
+ source-directory
+ shared-game-score-directory))
+ (let ((file (symbol-value filesym)))
+ (if (stringp file)
+ (set filesym (decode-coding-string file coding t)))))))
+
+ (let ((dir default-directory))
+ (with-current-buffer "*Messages*"
+ (messages-buffer-mode)
+ ;; Make it easy to do like "tail -f".
+ (set (make-local-variable 'window-point-insertion-type) t)
+ ;; Give *Messages* the same default-directory as *scratch*,
+ ;; just to keep things predictable.
+ (setq default-directory (or dir (expand-file-name "~/")))))
+ ;; `user-full-name' is now known; reset its standard-value here.
+ (put 'user-full-name 'standard-value
+ (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.
- (or (equal (file-attributes
+ (or (and default-directory
+ (equal (file-attributes
(concat (file-name-as-directory pwd) "."))
(file-attributes
(concat (file-name-as-directory default-directory)
- ".")))
+ "."))))
(setq process-environment
(delete (concat "PWD=" pwd)
process-environment)))))
- (setq default-directory (abbreviate-file-name default-directory))
+ ;; Now, that other directories were searched, and any charsets we
+ ;; need for encoding them are already loaded, we are ready to
+ ;; decode charset-map-path.
+ (if (listp charset-map-path)
+ (let ((coding (if (eq system-type 'windows-nt)
+ 'utf-8
+ locale-coding-system)))
+ (setq charset-map-path
+ (mapcar (lambda (dir)
+ (decode-coding-string dir coding t))
+ charset-map-path))))
+ (if default-directory
+ (setq default-directory (abbreviate-file-name default-directory))
+ (display-warning 'initialization "Error setting default-directory"))
(let ((old-face-font-rescale-alist face-font-rescale-alist))
(unwind-protect
(command-line)
;; Do this again, in case .emacs defined more abbreviations.
- (setq default-directory (abbreviate-file-name default-directory))
+ (if default-directory
+ (setq default-directory (abbreviate-file-name default-directory)))
;; Specify the file for recording all the auto save files of this session.
;; This is used by recover-session.
(or auto-save-list-file-name
@@ -569,9 +644,7 @@ It is the default value of the variable `top-level'."
(emacs-pid)
(system-name))))))))
(unless inhibit-startup-hooks
- (run-hooks 'emacs-startup-hook)
- (and term-setup-hook
- (run-hooks 'term-setup-hook)))
+ (run-hooks 'emacs-startup-hook 'term-setup-hook))
;; Don't do this if we failed to create the initial frame,
;; for instance due to a dense colormap.
@@ -607,8 +680,8 @@ It is the default value of the variable `top-level'."
;; Now we know the user's default font, so add it to the menu.
(if (fboundp 'font-menu-add-default)
(font-menu-add-default))
- (and window-setup-hook
- (run-hooks 'window-setup-hook))))
+ (unless inhibit-startup-hooks
+ (run-hooks 'window-setup-hook))))
;; Subprocesses of Emacs do not have direct access to the terminal, so
;; unless told otherwise they should only assume a dumb terminal.
;; We are careful to do it late (after term-setup-hook), although the
@@ -641,27 +714,25 @@ It is the default value of the variable `top-level'."
(defconst tool-bar-images-pixel-height 24
"Height in pixels of images in the tool-bar.")
-(defvar tool-bar-originally-present nil
- "Non-nil if tool-bars are present before user and site init files are read.")
-
-(defvar handle-args-function-alist '((nil . tty-handle-args))
- "Functions for processing window-system dependent command-line arguments.
+(cl-defgeneric handle-args-function (args)
+ "Method for processing window-system dependent command-line arguments.
Window system startup files should add their own function to this
-alist, which should parse the command line arguments. Those
+method, which should parse the command line arguments. Those
pertaining to the window system should be processed and removed
from the returned command line.")
+(cl-defmethod handle-args-function (args &context (window-system nil))
+ (tty-handle-args args))
-(defvar window-system-initialization-alist '((nil . ignore))
- "Alist of window-system initialization functions.
-Window-system startup files should add their own initialization
-function to this list. The function should take no arguments,
-and initialize the window system environment to prepare for
-opening the first frame (e.g. open a connection to an X server).")
+(cl-defgeneric window-system-initialization (&optional _display)
+ "Method for window-system initialization.
+Window-system startup files should add their own implementation
+to this method. The function should initialize the window system environment
+to prepare for opening the first frame (e.g. open a connection to an X server)."
+ nil)
(defun tty-handle-args (args)
"Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc."
(let (rest)
- (message "%S" args)
(while (and args
(not (equal (car args) "--")))
(let* ((argi (pop args))
@@ -732,6 +803,62 @@ opening the first frame (e.g. open a connection to an X server).")
(defvar server-name)
(defvar server-process)
+(defun startup--setup-quote-display (&optional style)
+ "If needed, display ASCII approximations to curved quotes.
+Do this by modifying `standard-display-table'. Optional STYLE
+specifies the desired quoting style, as in `text-quoting-style'.
+If STYLE is nil, display appropriately for the terminal."
+ (let ((repls (let ((style-repls (assq style '((grave . "`'\"\"")
+ (straight . "''\"\"")))))
+ (if style-repls (cdr style-repls) (make-vector 4 nil))))
+ glyph-count)
+ ;; REPLS is a sequence of the four replacements for "‘’“”", respectively.
+ ;; If STYLE is nil, infer REPLS from terminal characteristics.
+ (unless style
+ ;; On a terminal that supports glyph codes,
+ ;; GLYPH-COUNT[i] is the number of times that glyph code I
+ ;; represents either an ASCII character or one of the 4
+ ;; quote characters. This assumes glyph codes are valid
+ ;; Elisp characters, which is a safe assumption in practice.
+ (when (integerp (internal-char-font nil (max-char)))
+ (setq glyph-count (make-char-table nil 0))
+ (dotimes (i 132)
+ (let ((glyph (internal-char-font
+ nil (if (< i 128) i (aref "‘’“”" (- i 128))))))
+ (when (<= 0 glyph)
+ (aset glyph-count glyph (1+ (aref glyph-count glyph)))))))
+ (dotimes (i 2)
+ (let ((lq (aref "‘“" i)) (rq (aref "’”" i))
+ (lr (aref "`\"" i)) (rr (aref "'\"" i))
+ (i2 (* i 2)))
+ (unless (if glyph-count
+ ;; On a terminal that supports glyph codes, use
+ ;; ASCII replacements unless both quotes are displayable.
+ ;; If not using ASCII replacements, highlight
+ ;; quotes unless they are both unique among the
+ ;; 128 + 4 characters of concern.
+ (let ((lglyph (internal-char-font nil lq))
+ (rglyph (internal-char-font nil rq)))
+ (when (and (<= 0 lglyph) (<= 0 rglyph))
+ (setq lr lq rr rq)
+ (and (= 1 (aref glyph-count lglyph))
+ (= 1 (aref glyph-count rglyph)))))
+ ;; On a terminal that does not support glyph codes, use
+ ;; ASCII replacements unless both quotes are displayable.
+ (and (char-displayable-p lq)
+ (char-displayable-p rq)))
+ (aset repls i2 lr)
+ (aset repls (1+ i2) rr)))))
+ (dotimes (i 4)
+ (let ((char (aref "‘’“”" i))
+ (repl (aref repls i)))
+ (if repl
+ (aset (or standard-display-table
+ (setq standard-display-table (make-display-table)))
+ char (vector (make-glyph-code repl 'escape-glyph)))
+ (when standard-display-table
+ (aset standard-display-table char nil)))))))
+
(defun command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
@@ -758,18 +885,6 @@ Amongst another things, it parses the command-line arguments."
;;! ;; Choose a good default value for split-window-keep-point.
;;! (setq split-window-keep-point (> baud-rate 2400))
- ;; Set the default strings to display in mode line for
- ;; end-of-line formats that aren't native to this platform.
- (cond
- ((memq system-type '(ms-dos windows-nt))
- (setq eol-mnemonic-unix "(Unix)"
- eol-mnemonic-mac "(Mac)"))
- (t ; this is for Unix/GNU/Linux systems
- (setq eol-mnemonic-dos "(DOS)"
- eol-mnemonic-mac "(Mac)")))
-
- (set-locale-environment nil)
-
;; Convert preloaded file names in load-history to absolute.
(let ((simple-file-name
;; Look for simple.el or simple.elc and use their directory
@@ -803,7 +918,7 @@ please check its value")
load-history))))
;; Convert the arguments to Emacs internal representation.
- (let ((args (cdr command-line-args)))
+ (let ((args command-line-args))
(while args
(setcar args
(decode-coding-string (car args) locale-coding-system t))
@@ -825,7 +940,8 @@ please check its value")
;; processed. This is consistent with the way main in emacs.c
;; does things.
(while (and (not done) args)
- (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init")
+ (let* ((longopts '(("--no-init-file") ("--no-site-file")
+ ("--no-x-resources") ("--debug-init")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")))
(argi (pop args))
@@ -856,7 +972,11 @@ please check its value")
((member argi '("-Q" "-quick"))
(setq init-file-user nil
site-run-file nil
- inhibit-x-resources t))
+ inhibit-x-resources t)
+ ;; Stop it showing up in emacs -Q's customize-rogue.
+ (put 'site-run-file 'standard-value '(nil)))
+ ((member argi '("-no-x-resources"))
+ (setq inhibit-x-resources t))
((member argi '("-D" "-basic-display"))
(setq no-blinking-cursor t
emacs-basic-display t)
@@ -867,7 +987,8 @@ please check its value")
(setq init-file-user (or argval (pop args))
argval nil))
((equal argi "-no-site-file")
- (setq site-run-file nil))
+ (setq site-run-file nil)
+ (put 'site-run-file 'standard-value '(nil)))
((equal argi "-debug-init")
(setq init-file-debug t))
((equal argi "-iconic")
@@ -902,14 +1023,11 @@ please check its value")
(error "Unsupported window system `%s'" initial-window-system))
;; Process window-system specific command line parameters.
(setq command-line-args
- (funcall
- (or (cdr (assq initial-window-system handle-args-function-alist))
- (error "Unsupported window system `%s'" initial-window-system))
- command-line-args))
+ (let ((window-system initial-window-system)) ;Hack attack!
+ (handle-args-function command-line-args)))
;; Initialize the window system. (Open connection, etc.)
- (funcall
- (or (cdr (assq initial-window-system window-system-initialization-alist))
- (error "Unsupported window system `%s'" initial-window-system)))
+ (let ((window-system initial-window-system)) ;Hack attack!
+ (window-system-initialization))
(put initial-window-system 'window-system-initialized t))
;; If there was an error, print the error message and exit.
(error
@@ -955,6 +1073,10 @@ please check its value")
'("no" "off" "false" "0")))))
(setq no-blinking-cursor t))
+ (unless noninteractive
+ (startup--setup-quote-display)
+ (setq internal--text-quoting-flag t))
+
;; Re-evaluate predefined variables whose initial value depends on
;; the runtime context.
(mapc 'custom-reevaluate-setting
@@ -972,23 +1094,11 @@ please check its value")
;; switch color support on or off in mid-session by setting the
;; tty-color-mode frame parameter.
;; Exception: the `pc' ``window system'' has only 16 fixed colors,
- ;; and they are already set at this point by a suitable function in
- ;; window-system-initialization-alist.
+ ;; and they are already set at this point by a suitable method of
+ ;; window-system-initialization.
(or (eq initial-window-system 'pc)
(tty-register-default-colors))
- ;; Record whether the tool-bar is present before the user and site
- ;; init files are processed. frame-notice-user-settings uses this
- ;; to determine if the tool-bar has been disabled by the init files,
- ;; and the frame needs to be resized.
- (when (fboundp 'frame-notice-user-settings)
- (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
- (assq 'tool-bar-lines default-frame-alist))))
- (setq tool-bar-originally-present
- (and tool-bar-lines
- (cdr tool-bar-lines)
- (not (eq 0 (cdr tool-bar-lines)))))))
-
(let ((old-scalable-fonts-allowed scalable-fonts-allowed)
(old-face-ignored-fonts face-ignored-fonts))
@@ -1057,8 +1167,9 @@ please check its value")
"~/.emacs")
((directory-files "~" nil "^_emacs\\(\\.elc?\\)?$")
;; Also support _emacs for compatibility, but warn about it.
- (push '(initialization
- "`_emacs' init file is deprecated, please use `.emacs'")
+ (push `(initialization
+ ,(format-message
+ "`_emacs' init file is deprecated, please use `.emacs'"))
delayed-warnings-list)
"~/_emacs")
(t ;; But default to .emacs if _emacs does not exist.
@@ -1119,7 +1230,8 @@ please check its value")
(error
(display-warning
'initialization
- (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\
+ (format-message "\
+An error occurred while loading `%s':\n\n%s%s%s\n\n\
To ensure normal operation, you should investigate and remove the
cause of the error in your initialization file. Start Emacs with
the `--debug-init' option to view a complete error backtrace."
@@ -1127,7 +1239,7 @@ the `--debug-init' option to view a complete error backtrace."
(get (car error) 'error-message)
(if (cdr error) ": " "")
(mapconcat (lambda (s) (prin1-to-string s t))
- (cdr error) ", "))
+ (cdr error) ", "))
:warning)
(setq init-file-had-error t))))
@@ -1211,20 +1323,10 @@ the `--debug-init' option to view a complete error backtrace."
(package-initialize))
(setq after-init-time (current-time))
- (run-hooks 'after-init-hook)
-
- ;; Decode all default-directory.
- (if (and (default-value 'enable-multibyte-characters) locale-coding-system)
- (save-excursion
- (dolist (elt (buffer-list))
- (set-buffer elt)
- (if default-directory
- (setq default-directory
- (decode-coding-string default-directory
- locale-coding-system t))))
- (setq command-line-default-directory
- (decode-coding-string command-line-default-directory
- locale-coding-system t))))
+ ;; Display any accumulated warnings after all functions in
+ ;; `after-init-hook' like `desktop-read' have finalized possible
+ ;; changes in the window configuration.
+ (run-hooks 'after-init-hook 'delayed-warnings-hook)
;; If *scratch* exists and init file didn't change its mode, initialize it.
(if (get-buffer "*scratch*")
@@ -1235,8 +1337,9 @@ the `--debug-init' option to view a complete error backtrace."
;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this.
(unless (or noninteractive
- initial-window-system)
- (tty-run-terminal-initialization (selected-frame)))
+ initial-window-system
+ (daemonp))
+ (tty-run-terminal-initialization (selected-frame) nil t))
;; Update the out-of-memory error message based on user's key bindings
;; for save-some-buffers.
@@ -1247,6 +1350,31 @@ the `--debug-init' option to view a complete error backtrace."
;; Process the remaining args.
(command-line-1 (cdr command-line-args))
+ ;; This is a problem because, e.g. if emacs.d/gnus.el exists,
+ ;; trying to load gnus could load the wrong file.
+ ;; OK, it would not matter if .emacs.d were at the end of load-path.
+ ;; but for the sake of simplicity, we discourage it full-stop.
+ ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html
+ ;;
+ ;; A bad element could come from user-emacs-file, the command line,
+ ;; or EMACSLOADPATH, so we basically always have to check.
+ (let (warned)
+ (dolist (dir load-path)
+ (and (not warned)
+ (stringp dir)
+ (string-equal (file-name-as-directory (expand-file-name dir))
+ (expand-file-name user-emacs-directory))
+ (setq warned t)
+ (display-warning 'initialization
+ (format-message "\
+Your `load-path' seems to contain\n\
+your `.emacs.d' directory: %s\n\
+This is likely to cause problems...\n\
+Consider using a subdirectory instead, e.g.: %s"
+ dir (expand-file-name
+ "lisp" user-emacs-directory))
+ :warning))))
+
;; If -batch, terminate after processing the command options.
(if noninteractive (kill-emacs t))
@@ -1299,11 +1427,11 @@ settings will be marked as \"CHANGED outside of Customize\"."
(defcustom initial-scratch-message (purecopy "\
;; This buffer is for notes you don't want to save, and for Lisp evaluation.
-;; If you want to create a file, visit that file with C-x C-f,
+;; If you want to create a file, visit that file with \\[find-file],
;; then enter the text in that file's own buffer.
")
- "Initial message displayed in *scratch* buffer at startup.
+ "Initial documentation displayed in *scratch* buffer at startup.
If this is nil, no message will be displayed."
:type '(choice (text :tag "Message")
(const :tag "none" nil))
@@ -1327,8 +1455,9 @@ If this is nil, no message will be displayed."
`("GNU/Linux"
,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
"Browse http://www.gnu.org/gnu/linux-and-gnu.html")
- `("GNU" ,(lambda (_button) (describe-gnu-project))
- "Display info on the GNU project")))
+ `("GNU" ,(lambda (_button)
+ (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
+ "Browse http://www.gnu.org/gnu/thegnuproject.html")))
" operating system.\n\n"
:face variable-pitch
:link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
@@ -1410,9 +1539,7 @@ Each element in the list should be a list of strings or pairs
(goto-char (point-min))))
"\tMany people have contributed code included in GNU Emacs\n"
:link ("Contributing"
- ,(lambda (_button)
- (view-file (expand-file-name "CONTRIBUTE" data-directory))
- (goto-char (point-min))))
+ ,(lambda (_button) (info "(emacs)Contributing")))
"\tHow to contribute improvements to Emacs\n"
"\n"
:link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
@@ -1439,7 +1566,10 @@ Each element in the list should be a list of strings or pairs
(title (with-temp-buffer
(insert-file-contents
(expand-file-name tut tutorial-directory)
- nil 0 256)
+ ;; Read the entire file, to make sure any
+ ;; coding cookies and other local variables
+ ;; get acted upon.
+ nil)
(search-forward ".")
(buffer-substring (point-min) (1- (point))))))
;; If there is a specific tutorial for the current language
@@ -1521,24 +1651,26 @@ a face or button specification."
(declare-function image-size "image.c" (spec &optional pixels frame))
+(defun fancy-splash-image-file ()
+ (cond ((stringp fancy-splash-image) fancy-splash-image)
+ ((display-color-p)
+ (cond ((<= (display-planes) 8)
+ (if (image-type-available-p 'xpm)
+ "splash.xpm"
+ "splash.pbm"))
+ ((or (image-type-available-p 'svg)
+ (image-type-available-p 'imagemagick))
+ "splash.svg")
+ ((image-type-available-p 'png)
+ "splash.png")
+ ((image-type-available-p 'xpm)
+ "splash.xpm")
+ (t "splash.pbm")))
+ (t "splash.pbm")))
+
(defun fancy-splash-head ()
"Insert the head part of the splash screen into the current buffer."
- (let* ((image-file (cond ((stringp fancy-splash-image)
- fancy-splash-image)
- ((display-color-p)
- (cond ((<= (display-planes) 8)
- (if (image-type-available-p 'xpm)
- "splash.xpm"
- "splash.pbm"))
- ((or (image-type-available-p 'svg)
- (image-type-available-p 'imagemagick))
- "splash.svg")
- ((image-type-available-p 'png)
- "splash.png")
- ((image-type-available-p 'xpm)
- "splash.xpm")
- (t "splash.pbm")))
- (t "splash.pbm")))
+ (let* ((image-file (fancy-splash-image-file))
(img (create-image image-file))
(image-width (and img (car (image-size img))))
(window-width (window-width)))
@@ -1674,6 +1806,7 @@ splash screen in another window."
(insert "\n")
(fancy-startup-tail concise))
(use-local-map splash-screen-keymap)
+ (setq-local browse-url-browser-function 'eww-browse-url)
(setq tab-width 22
buffer-read-only t)
(set-buffer-modified-p nil)
@@ -1711,6 +1844,7 @@ splash screen in another window."
(goto-char (point-min))
(force-mode-line-update))
(use-local-map splash-screen-keymap)
+ (setq-local browse-url-browser-function 'eww-browse-url)
(setq tab-width 22)
(setq buffer-read-only t)
(goto-char (point-min))
@@ -1722,6 +1856,10 @@ Returning non-nil does not mean we should necessarily
use the fancy splash screen, but if we do use it,
we put it on this frame."
(let (chosen-frame)
+ ;; MS-Windows needs this to have a chance to make the initial
+ ;; frame visible.
+ (if (eq (window-system) 'w32)
+ (sit-for 0 t))
(dolist (frame (append (frame-list) (list (selected-frame))))
(if (and (frame-visible-p frame)
(not (window-minibuffer-p (frame-selected-window frame))))
@@ -1732,14 +1870,11 @@ we put it on this frame."
"Return t if fancy splash screens should be used."
(when (and (display-graphic-p)
(or (and (display-color-p)
- (image-type-available-p 'xpm))
+ (image-type-available-p 'xpm))
(image-type-available-p 'pbm)))
(let ((frame (fancy-splash-frame)))
(when frame
- (let* ((img (create-image (or fancy-splash-image
- (if (and (display-color-p)
- (image-type-available-p 'xpm))
- "splash.xpm" "splash.pbm"))))
+ (let* ((img (create-image (fancy-splash-image-file)))
(image-height (and img (cdr (image-size img nil frame))))
;; We test frame-height so that, if the frame is split
;; by displaying a warning, that doesn't cause the normal
@@ -1803,7 +1938,7 @@ splash screen in another window."
auto-save-list-file-prefix)))
t)
(insert "\n\nIf an Emacs session crashed recently, "
- "type Meta-x recover-session RET\nto recover"
+ "type M-x recover-session RET\nto recover"
" the files you were editing.\n"))
(use-local-map splash-screen-keymap)
@@ -1835,7 +1970,7 @@ To quit a partially entered command, type Control-g.\n")
'action (lambda (_button) (info-emacs-manual))
'follow-link t)
(insert "\tView the Emacs manual using Info\n")
- (insert-button "\(Non)Warranty"
+ (insert-button "(Non)Warranty"
'action (lambda (_button) (describe-no-warranty))
'follow-link t)
(insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
@@ -1852,7 +1987,8 @@ To quit a partially entered command, type Control-g.\n")
(insert-button "Visit New File"
'action (lambda (_button) (call-interactively 'find-file))
'follow-link t)
- (insert "\t\tSpecify a new file's name, to edit the file\n")
+ (insert (substitute-command-keys
+ "\t\tSpecify a new file's name, to edit the file\n"))
(insert-button "Open Home Directory"
'action (lambda (_button) (dired "~"))
'follow-link t)
@@ -1918,9 +2054,9 @@ To quit a partially entered command, type Control-g.\n")
(insert (substitute-command-keys " \\[tmm-menubar]")))
;; Many users seem to have problems with these.
- (insert "
+ (insert (substitute-command-keys "
\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
-If you have no Meta key, you may instead type ESC followed by the character.)")
+If you have no Meta key, you may instead type ESC followed by the character.)"))
;; Insert links to useful tasks
(insert "\nUseful tasks:\n")
@@ -1978,9 +2114,7 @@ Type \\[describe-distribution] for information on "))
(insert-button "Contributing"
'action
- (lambda (_button)
- (view-file (expand-file-name "CONTRIBUTE" data-directory))
- (goto-char (point-min)))
+ (lambda (_button) (info "(emacs)Contributing"))
'follow-link t)
(insert "\tHow to contribute improvements to Emacs\n\n")
@@ -2079,230 +2213,251 @@ A fancy display is used on graphic displays, normal otherwise."
(See the node Pure Storage in the Lisp manual for details.)"
:warning))
- (let ((file-count 0)
- (command-line-args-left args-left)
- first-file-buffer)
- (when command-line-args-left
- ;; We have command args; process them.
- (let ((dir command-line-default-directory)
- tem
- ;; This approach loses for "-batch -L DIR --eval "(require foo)",
- ;; if foo is intended to be found in DIR.
- ;;
- ;; ;; The directories listed in --directory/-L options will *appear*
- ;; ;; at the front of `load-path' in the order they appear on the
- ;; ;; command-line. We cannot do this by *placing* them at the front
- ;; ;; in the order they appear, so we need this variable to hold them,
- ;; ;; temporarily.
- ;; extra-load-path
- ;;
- ;; To DTRT we keep track of the splice point and modify `load-path'
- ;; straight away upon any --directory/-L option.
- splice
- just-files ;; t if this follows the magic -- option.
- ;; This includes our standard options' long versions
- ;; and long versions of what's on command-switch-alist.
- (longopts
- (append '("--funcall" "--load" "--insert" "--kill"
- "--directory" "--eval" "--execute" "--no-splash"
- "--find-file" "--visit" "--file" "--no-desktop")
- (mapcar (lambda (elt) (concat "-" (car elt)))
- command-switch-alist)))
- (line 0)
- (column 0))
-
- ;; Add the long X options to longopts.
- (dolist (tem command-line-x-option-alist)
- (if (string-match "^--" (car tem))
- (push (car tem) longopts)))
-
- ;; Add the long NS options to longopts.
- (dolist (tem command-line-ns-option-alist)
- (if (string-match "^--" (car tem))
- (push (list (car tem)) longopts)))
-
- ;; Loop, processing options.
- (while command-line-args-left
- (let* ((argi (car command-line-args-left))
- (orig-argi argi)
- argval completion)
- (setq command-line-args-left (cdr command-line-args-left))
-
- ;; Do preliminary decoding of the option.
- (if just-files
- ;; After --, don't look for options; treat all args as files.
- (setq argi "")
- ;; Convert long options to ordinary options
- ;; and separate out an attached option argument into argval.
- (when (string-match "\\`\\(--[^=]*\\)=" argi)
- (setq argval (substring argi (match-end 0))
- argi (match-string 1 argi)))
- (when (string-match "\\`--?[^-]" orig-argi)
- (setq completion (try-completion argi longopts))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (member completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil
- argi orig-argi)))))
-
- ;; Execute the option.
- (cond ((setq tem (assoc argi command-switch-alist))
- (if argval
- (let ((command-line-args-left
- (cons argval command-line-args-left)))
- (funcall (cdr tem) argi))
- (funcall (cdr tem) argi)))
-
- ((equal argi "-no-splash")
- (setq inhibit-startup-screen t))
-
- ((member argi '("-f" ; what the manual claims
- "-funcall"
- "-e")) ; what the source used to say
- (setq inhibit-startup-screen t)
- (setq tem (intern (or argval (pop command-line-args-left))))
- (if (commandp tem)
- (command-execute tem)
- (funcall tem)))
-
- ((member argi '("-eval" "-execute"))
- (setq inhibit-startup-screen t)
- (eval (read (or argval (pop command-line-args-left)))))
-
- ((member argi '("-L" "-directory"))
- (setq tem (expand-file-name
- (command-line-normalize-file-name
- (or argval (pop command-line-args-left)))))
- (cond (splice (setcdr splice (cons tem (cdr splice)))
- (setq splice (cdr splice)))
- (t (setq load-path (cons tem load-path)
- splice load-path))))
-
- ((member argi '("-l" "-load"))
- (let* ((file (command-line-normalize-file-name
- (or argval (pop command-line-args-left))))
- ;; Take file from default dir if it exists there;
- ;; otherwise let `load' search for it.
- (file-ex (expand-file-name file)))
- (when (file-exists-p file-ex)
- (setq file file-ex))
- (load file nil t)))
-
- ;; This is used to handle -script. It's not clear
- ;; we need to document it (it is totally internal).
- ((member argi '("-scriptload"))
- (let* ((file (command-line-normalize-file-name
- (or argval (pop command-line-args-left))))
- ;; Take file from default dir.
- (file-ex (expand-file-name file)))
- (load file-ex nil t t)))
-
- ((equal argi "-insert")
- (setq inhibit-startup-screen t)
- (setq tem (or argval (pop command-line-args-left)))
- (or (stringp tem)
- (error "File name omitted from `-insert' option"))
- (insert-file-contents (command-line-normalize-file-name tem)))
-
- ((equal argi "-kill")
- (kill-emacs t))
-
- ;; This is for when they use --no-desktop with -q, or
- ;; don't load Desktop in their .emacs. If desktop.el
- ;; _is_ loaded, it will handle this switch, and we
- ;; won't see it by the time we get here.
- ((equal argi "-no-desktop")
- (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
-
- ((string-match "^\\+[0-9]+\\'" argi)
- (setq line (string-to-number argi)))
-
- ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
- (setq line (string-to-number (match-string 1 argi))
- column (string-to-number (match-string 2 argi))))
-
- ((setq tem (assoc orig-argi command-line-x-option-alist))
- ;; Ignore X-windows options and their args if not using X.
- (setq command-line-args-left
- (nthcdr (nth 1 tem) command-line-args-left)))
-
- ((setq tem (assoc orig-argi command-line-ns-option-alist))
- ;; Ignore NS-windows options and their args if not using NS.
- (setq command-line-args-left
- (nthcdr (nth 1 tem) command-line-args-left)))
-
- ((member argi '("-find-file" "-file" "-visit"))
- (setq inhibit-startup-screen t)
- ;; An explicit option to specify visiting a file.
- (setq tem (or argval (pop command-line-args-left)))
- (unless (stringp tem)
- (error "File name omitted from `%s' option" argi))
- (setq file-count (1+ file-count))
- (let ((file (expand-file-name
- (command-line-normalize-file-name tem)
- dir)))
- (if (= file-count 1)
- (setq first-file-buffer (find-file file))
- (find-file-other-window file)))
- (unless (zerop line)
- (goto-char (point-min))
- (forward-line (1- line)))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))
-
- ;; These command lines now have no effect.
- ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
- (display-warning 'initialization
- (format "Ignoring obsolete arg %s" argi)))
-
- ((equal argi "--")
- (setq just-files t))
- (t
- ;; We have almost exhausted our options. See if the
- ;; user has made any other command-line options available
- (let ((hooks command-line-functions)
- (did-hook nil))
- (while (and hooks
- (not (setq did-hook (funcall (car hooks)))))
- (setq hooks (cdr hooks)))
- (if (not did-hook)
- ;; Presume that the argument is a file name.
- (progn
- (if (string-match "\\`-" argi)
- (error "Unknown option `%s'" argi))
- (unless initial-window-system
- (setq inhibit-startup-screen t))
- (setq file-count (1+ file-count))
- (let ((file
- (expand-file-name
- (command-line-normalize-file-name orig-argi)
- dir)))
- (cond ((= file-count 1)
- (setq first-file-buffer (find-file file)))
- (inhibit-startup-screen
- (find-file-other-window file))
- (t (find-file file))))
- (unless (zerop line)
- (goto-char (point-min))
- (forward-line (1- line)))
- (setq line 0)
- (unless (< column 1)
- (move-to-column (1- column)))
- (setq column 0))))))
- ;; In unusual circumstances, the execution of Lisp code due
- ;; to command-line options can cause the last visible frame
- ;; to be deleted. In this case, kill emacs to avoid an
- ;; abort later.
- (unless (frame-live-p (selected-frame)) (kill-emacs nil))))))
+ ;; `displayable-buffers' is a list of buffers that may be displayed,
+ ;; which includes files parsed from the command line arguments and
+ ;; `initial-buffer-choice'. All of the display logic happens at the
+ ;; end of this `let'. As files as processed from the command line
+ ;; arguments, their buffers are prepended to `displayable-buffers'.
+ ;; In order for options like "--eval" to work with the "--file" arg,
+ ;; the file buffers are set as the current buffer as they are seen
+ ;; on the command line (so "emacs --batch --file a --file b
+ ;; --eval='(message "%s" (buffer-name))'" will print "b"), but this
+ ;; does not affect the final displayed state of the buffers.
+ (let ((displayable-buffers nil))
+ ;; This `let' processes the command line arguments.
+ (let ((command-line-args-left args-left))
+ (when command-line-args-left
+ ;; We have command args; process them.
+ (let* ((dir command-line-default-directory)
+ tem
+ ;; This approach loses for "-batch -L DIR --eval "(require foo)",
+ ;; if foo is intended to be found in DIR.
+ ;;
+ ;; The directories listed in --directory/-L options will *appear*
+ ;; at the front of `load-path' in the order they appear on the
+ ;; command-line. We cannot do this by *placing* them at the front
+ ;; in the order they appear, so we need this variable to hold them,
+ ;; temporarily.
+ ;;
+ ;; To DTRT we keep track of the splice point and modify `load-path'
+ ;; straight away upon any --directory/-L option.
+ splice
+ just-files ;; t if this follows the magic -- option.
+ ;; This includes our standard options' long versions
+ ;; and long versions of what's on command-switch-alist.
+ (longopts
+ (append '("--funcall" "--load" "--insert" "--kill"
+ "--directory" "--eval" "--execute" "--no-splash"
+ "--find-file" "--visit" "--file" "--no-desktop")
+ (mapcar (lambda (elt) (concat "-" (car elt)))
+ command-switch-alist)))
+ (line 0)
+ (column 0)
+ ;; `process-file-arg' opens a file buffer for `name',
+ ;; sets that buffer as the current buffer without
+ ;; displaying it, adds the buffer to
+ ;; `displayable-buffers', and puts the point at
+ ;; `line':`column'. `line' and `column' are both reset
+ ;; to zero when `process-file-arg' returns.
+ (process-file-arg
+ (lambda (name)
+ ;; This can only happen if PWD is deleted.
+ (if (not (or dir (file-name-absolute-p name)))
+ (message "Ignoring relative file name (%s) due to \
+nil default-directory" name)
+ (let* ((file (expand-file-name
+ (command-line-normalize-file-name name)
+ dir))
+ (buf (find-file-noselect file)))
+ (setq displayable-buffers (cons buf displayable-buffers))
+ ;; Set the file buffer to the current buffer so
+ ;; that it will be used with "--eval" and
+ ;; similar options.
+ (set-buffer buf)
+ ;; Put the point at `line':`column' in the file
+ ;; buffer, and reset `line' and `column' to 0.
+ (unless (zerop line)
+ (goto-char (point-min))
+ (forward-line (1- line)))
+ (setq line 0)
+ (unless (< column 1)
+ (move-to-column (1- column)))
+ (setq column 0))))))
+
+ ;; Add the long X options to longopts.
+ (dolist (tem command-line-x-option-alist)
+ (if (string-match "^--" (car tem))
+ (push (car tem) longopts)))
+
+ ;; Add the long NS options to longopts.
+ (dolist (tem command-line-ns-option-alist)
+ (if (string-match "^--" (car tem))
+ (push (list (car tem)) longopts)))
+
+ ;; Loop, processing options.
+ (while command-line-args-left
+ (let* ((argi (car command-line-args-left))
+ (orig-argi argi)
+ argval completion)
+ (setq command-line-args-left (cdr command-line-args-left))
+
+ ;; Do preliminary decoding of the option.
+ (if just-files
+ ;; After --, don't look for options; treat all args as files.
+ (setq argi "")
+ ;; Convert long options to ordinary options
+ ;; and separate out an attached option argument into argval.
+ (when (string-match "\\`\\(--[^=]*\\)=" argi)
+ (setq argval (substring argi (match-end 0))
+ argi (match-string 1 argi)))
+ (when (string-match "\\`--?[^-]" orig-argi)
+ (setq completion (try-completion argi longopts))
+ (if (eq completion t)
+ (setq argi (substring argi 1))
+ (if (stringp completion)
+ (let ((elt (member completion longopts)))
+ (or elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1)))
+ (setq argval nil
+ argi orig-argi)))))
+
+ ;; Execute the option.
+ (cond ((setq tem (assoc argi command-switch-alist))
+ (if argval
+ (let ((command-line-args-left
+ (cons argval command-line-args-left)))
+ (funcall (cdr tem) argi))
+ (funcall (cdr tem) argi)))
+
+ ((equal argi "-no-splash")
+ (setq inhibit-startup-screen t))
+
+ ((member argi '("-f" ; what the manual claims
+ "-funcall"
+ "-e")) ; what the source used to say
+ (setq inhibit-startup-screen t)
+ (setq tem (intern (or argval (pop command-line-args-left))))
+ (if (commandp tem)
+ (command-execute tem)
+ (funcall tem)))
+
+ ((member argi '("-eval" "-execute"))
+ (setq inhibit-startup-screen t)
+ (eval (read (or argval (pop command-line-args-left)))))
+
+ ((member argi '("-L" "-directory"))
+ ;; -L :/foo adds /foo to the _end_ of load-path.
+ (let (append)
+ (if (string-match-p
+ (format "\\`%s" path-separator)
+ (setq tem (or argval (pop command-line-args-left))))
+ (setq tem (substring tem 1)
+ append t))
+ (setq tem (expand-file-name
+ (command-line-normalize-file-name tem)))
+ (cond (append (setq load-path
+ (append load-path (list tem)))
+ (if splice (setq splice load-path)))
+ (splice (setcdr splice (cons tem (cdr splice)))
+ (setq splice (cdr splice)))
+ (t (setq load-path (cons tem load-path)
+ splice load-path)))))
+
+ ((member argi '("-l" "-load"))
+ (let* ((file (command-line-normalize-file-name
+ (or argval (pop command-line-args-left))))
+ ;; Take file from default dir if it exists there;
+ ;; otherwise let `load' search for it.
+ (file-ex (expand-file-name file)))
+ (when (file-exists-p file-ex)
+ (setq file file-ex))
+ (load file nil t)))
+
+ ;; This is used to handle -script. It's not clear
+ ;; we need to document it (it is totally internal).
+ ((member argi '("-scriptload"))
+ (let* ((file (command-line-normalize-file-name
+ (or argval (pop command-line-args-left))))
+ ;; Take file from default dir.
+ (file-ex (expand-file-name file)))
+ (load file-ex nil t t)))
+
+ ((equal argi "-insert")
+ (setq inhibit-startup-screen t)
+ (setq tem (or argval (pop command-line-args-left)))
+ (or (stringp tem)
+ (error "File name omitted from `-insert' option"))
+ (insert-file-contents (command-line-normalize-file-name tem)))
+
+ ((equal argi "-kill")
+ (kill-emacs t))
+
+ ;; This is for when they use --no-desktop with -q, or
+ ;; don't load Desktop in their .emacs. If desktop.el
+ ;; _is_ loaded, it will handle this switch, and we
+ ;; won't see it by the time we get here.
+ ((equal argi "-no-desktop")
+ (message "\"--no-desktop\" ignored because the Desktop package is not loaded"))
+
+ ((string-match "^\\+[0-9]+\\'" argi)
+ (setq line (string-to-number argi)))
+
+ ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
+ (setq line (string-to-number (match-string 1 argi))
+ column (string-to-number (match-string 2 argi))))
+
+ ((setq tem (assoc orig-argi command-line-x-option-alist))
+ ;; Ignore X-windows options and their args if not using X.
+ (setq command-line-args-left
+ (nthcdr (nth 1 tem) command-line-args-left)))
+
+ ((setq tem (assoc orig-argi command-line-ns-option-alist))
+ ;; Ignore NS-windows options and their args if not using NS.
+ (setq command-line-args-left
+ (nthcdr (nth 1 tem) command-line-args-left)))
+
+ ((member argi '("-find-file" "-file" "-visit"))
+ (setq inhibit-startup-screen t)
+ ;; An explicit option to specify visiting a file.
+ (setq tem (or argval (pop command-line-args-left)))
+ (unless (stringp tem)
+ (error "File name omitted from `%s' option" argi))
+ (funcall process-file-arg tem))
+
+ ;; These command lines now have no effect.
+ ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
+ (display-warning 'initialization
+ (format "Ignoring obsolete arg %s" argi)))
+
+ ((equal argi "--")
+ (setq just-files t))
+ (t
+ ;; We have almost exhausted our options. See if the
+ ;; user has made any other command-line options available
+ (let ((hooks command-line-functions)
+ (did-hook nil))
+ (while (and hooks
+ (not (setq did-hook (funcall (car hooks)))))
+ (setq hooks (cdr hooks)))
+ (unless did-hook
+ ;; Presume that the argument is a file name.
+ (if (string-match "\\`-" argi)
+ (error "Unknown option `%s'" argi))
+ ;; FIXME: Why do we only inhibit the startup
+ ;; screen for -nw?
+ (unless initial-window-system
+ (setq inhibit-startup-screen t))
+ (funcall process-file-arg orig-argi)))))
+
+ ;; In unusual circumstances, the execution of Lisp code due
+ ;; to command-line options can cause the last visible frame
+ ;; to be deleted. In this case, kill emacs to avoid an
+ ;; abort later.
+ (unless (frame-live-p (selected-frame)) (kill-emacs nil)))))))
(when (eq initial-buffer-choice t)
- ;; When initial-buffer-choice equals t make sure that *scratch*
+ ;; When `initial-buffer-choice' equals t make sure that *scratch*
;; exists.
(get-buffer-create "*scratch*"))
@@ -2312,66 +2467,84 @@ A fancy display is used on graphic displays, normal otherwise."
(get-buffer "*scratch*")
(with-current-buffer "*scratch*"
(when (zerop (buffer-size))
- (insert initial-scratch-message)
+ (insert (substitute-command-keys initial-scratch-message))
(set-buffer-modified-p nil))))
+ ;; Prepend `initial-buffer-choice' to `displayable-buffers'.
(when initial-buffer-choice
(let ((buf
(cond ((stringp initial-buffer-choice)
(find-file-noselect initial-buffer-choice))
((functionp initial-buffer-choice)
- (funcall initial-buffer-choice)))))
- (switch-to-buffer
- (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
- 'norecord)))
-
- (if (or inhibit-startup-screen
- initial-buffer-choice
- noninteractive
- (daemonp)
- inhibit-x-resources)
-
- ;; Not displaying a startup screen. If 3 or more files
- ;; visited, and not all visible, show user what they all are.
- (and (> file-count 2)
- (not noninteractive)
- (not inhibit-startup-buffer-menu)
- (or (get-buffer-window first-file-buffer)
- (list-buffers)))
-
- ;; Display a startup screen, after some preparations.
-
- ;; If there are no switches to process, we might as well
- ;; run this hook now, and there may be some need to do it
- ;; before doing any output.
- (run-hooks 'emacs-startup-hook)
- (and term-setup-hook
- (run-hooks 'term-setup-hook))
- (setq inhibit-startup-hooks t)
-
- ;; It's important to notice the user settings before we
- ;; display the startup message; otherwise, the settings
- ;; won't take effect until the user gives the first
- ;; keystroke, and that's distracting.
- (when (fboundp 'frame-notice-user-settings)
- (frame-notice-user-settings))
-
- ;; If there are no switches to process, we might as well
- ;; run this hook now, and there may be some need to do it
- ;; before doing any output.
- (when window-setup-hook
- (run-hooks 'window-setup-hook)
- ;; Don't let the hook be run twice.
- (setq window-setup-hook nil))
-
- ;; ;; Do this now to avoid an annoying delay if the user
- ;; ;; clicks the menu bar during the sit-for.
- ;; (when (display-popup-menus-p)
- ;; (precompute-menubar-bindings))
- ;; (with-no-warnings
- ;; (setq menubar-bindings-done t))
-
- (display-startup-screen (> file-count 0)))))
+ (funcall initial-buffer-choice))
+ ((eq initial-buffer-choice t)
+ (get-buffer-create "*scratch*"))
+ (t
+ (error "initial-buffer-choice must be a string, a function, or t.")))))
+ (unless (buffer-live-p buf)
+ (error "initial-buffer-choice is not a live buffer."))
+ (setq displayable-buffers (cons buf displayable-buffers))))
+
+ ;; Display the first two buffers in `displayable-buffers'. If
+ ;; `initial-buffer-choice' is non-nil, its buffer will be the
+ ;; first buffer in `displayable-buffers'. The first buffer will
+ ;; be focused.
+ (let ((displayable-buffers-len (length displayable-buffers))
+ ;; `nondisplayed-buffers-p' is true if there exist buffers
+ ;; in `displayable-buffers' that were not displayed to the
+ ;; user.
+ (nondisplayed-buffers-p nil))
+ (when (> displayable-buffers-len 0)
+ (switch-to-buffer (car displayable-buffers)))
+ (when (> displayable-buffers-len 1)
+ (switch-to-buffer-other-window (car (cdr displayable-buffers)))
+ ;; Focus on the first buffer.
+ (other-window -1))
+ (when (> displayable-buffers-len 2)
+ (setq nondisplayed-buffers-p t))
+
+ (if (or inhibit-startup-screen
+ initial-buffer-choice
+ noninteractive
+ (daemonp)
+ inhibit-x-resources)
+
+ ;; Not displaying a startup screen. Display *Buffer List* if
+ ;; there exist buffers that were not displayed.
+ (when (and nondisplayed-buffers-p
+ (not noninteractive)
+ (not inhibit-startup-buffer-menu))
+ (list-buffers))
+
+ ;; Display a startup screen, after some preparations.
+
+ ;; If there are no switches to process, we might as well
+ ;; run this hook now, and there may be some need to do it
+ ;; before doing any output.
+ (run-hooks 'emacs-startup-hook 'term-setup-hook)
+
+ ;; It's important to notice the user settings before we
+ ;; display the startup message; otherwise, the settings
+ ;; won't take effect until the user gives the first
+ ;; keystroke, and that's distracting.
+ (when (fboundp 'frame-notice-user-settings)
+ (frame-notice-user-settings))
+
+ ;; If there are no switches to process, we might as well
+ ;; run this hook now, and there may be some need to do it
+ ;; before doing any output.
+ (run-hooks 'window-setup-hook)
+
+ (setq inhibit-startup-hooks t)
+
+ ;; ;; Do this now to avoid an annoying delay if the user
+ ;; ;; clicks the menu bar during the sit-for.
+ ;; (when (display-popup-menus-p)
+ ;; (precompute-menubar-bindings))
+ ;; (with-no-warnings
+ ;; (setq menubar-bindings-done t))
+
+ (display-startup-screen (> displayable-buffers-len 0))))))
(defun command-line-normalize-file-name (file)
"Collapse multiple slashes to one, to handle non-Emacs file names."
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 2c3c3bc6dd4..a4f4a14af32 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1,9 +1,9 @@
;;; strokes.el --- control Emacs through mouse strokes
-;; Copyright (C) 1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2015 Free Software Foundation, Inc.
;; Author: David Bakhash <cadet@alum.mit.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: lisp, mouse, extensions
;; This file is part of GNU Emacs.
@@ -118,8 +118,7 @@
;; > M-x strokes-prompt-user-save-strokes
-;; and it will save your strokes in ~/.strokes, or you may wish to change
-;; this by setting the variable `strokes-file'.
+;; and it will save your strokes in your `strokes-file'.
;; Note that internally, all of the routines that are part of this
;; package are able to deal with complex strokes, as they are a superset
@@ -203,7 +202,7 @@ static char * stroke_xpm[] = {
\"P c #FFFF0000FFFF\",
\". c #45458B8B0000\",
/* pixels */\n"
- "The header to all xpm buffers created by strokes.")
+ "The header to all XPM buffers created by strokes.")
;;; user variables...
@@ -222,7 +221,7 @@ static char * stroke_xpm[] = {
(defcustom strokes-character ?@
"Character used when drawing strokes in the strokes buffer.
-\(The default is `@', which works well.\)"
+\(The default is `@', which works well.)"
:type 'character
:group 'strokes)
@@ -261,7 +260,8 @@ WARNING: Changing the value of this variable will gravely affect the
:group 'strokes)
(defcustom strokes-file (locate-user-emacs-file "strokes" ".strokes")
- "File containing saved strokes for Strokes mode (default is ~/.strokes)."
+ "File containing saved strokes for Strokes mode."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:group 'strokes)
@@ -284,16 +284,15 @@ This is set properly in the function `strokes-update-window-configuration'.")
(defvar strokes-last-stroke nil
"Last stroke entered by the user.
-Its value gets set every time the function
-`strokes-fill-stroke' gets called,
-since that is the best time to set the variable.")
+Its value gets set every time the function `strokes-fill-stroke'
+gets called, since that is the best time to set the variable.")
(defvar strokes-global-map '()
"Association list of strokes and their definitions.
Each entry is (STROKE . COMMAND) where STROKE is itself a list of
coordinates (X . Y) where X and Y are lists of positions on the
-normalized stroke grid, with the top left at (0 . 0). COMMAND is the
-corresponding interactive function.")
+normalized stroke grid, with the top left at (0 . 0). COMMAND is
+the corresponding interactive function.")
(defvar strokes-load-hook nil
"Functions to be called when Strokes is loaded.")
@@ -349,7 +348,7 @@ corresponding interactive function.")
(* x x))
(defsubst strokes-distance-squared (p1 p2)
- "Gets the distance (squared) between to points P1 and P2.
+ "Compute the distance (squared) between to points P1 and P2.
P1 and P2 are cons cells in the form (X . Y)."
(let ((x1 (car p1))
(y1 (cdr p1))
@@ -424,8 +423,9 @@ or for window START-WINDOW if that is specified."
(interactive)
(let ((command (cdar strokes-global-map)))
(if (y-or-n-p
- (format "Really delete last stroke definition, defined to `%s'? "
- command))
+ (format-message
+ "Really delete last stroke definition, defined to `%s'? "
+ command))
(progn
(setq strokes-global-map (cdr strokes-global-map))
(message "That stroke has been deleted"))
@@ -434,9 +434,9 @@ or for window START-WINDOW if that is specified."
;;;###autoload
(defun strokes-global-set-stroke (stroke command)
"Interactively give STROKE the global binding as COMMAND.
-Operated just like `global-set-key', except for strokes.
-COMMAND is a symbol naming an interactively-callable function. STROKE
-is a list of sampled positions on the stroke grid as described in the
+Works just like `global-set-key', except for strokes. COMMAND is
+a symbol naming an interactively-callable function. STROKE is a
+list of sampled positions on the stroke grid as described in the
documentation for the `strokes-define-stroke' function.
See also `strokes-global-set-stroke-string'."
@@ -450,7 +450,7 @@ See also `strokes-global-set-stroke-string'."
(defun strokes-global-set-stroke-string (stroke string)
"Interactively give STROKE the global binding as STRING.
-Operated just like `global-set-key', except for strokes. STRING
+Works just like `global-set-key', except for strokes. STRING
is a string to be inserted by the stroke. STROKE is a list of
sampled positions on the stroke grid as described in the
documentation for the `strokes-define-stroke' function.
@@ -476,7 +476,7 @@ Compare `strokes-global-set-stroke'."
(defun strokes-get-grid-position (stroke-extent position &optional grid-resolution)
"Map POSITION to a new grid position.
Do so based on its STROKE-EXTENT and GRID-RESOLUTION.
-STROKE-EXTENT as a list \(\(XMIN . YMIN\) \(XMAX . YMAX\)\).
+STROKE-EXTENT is a list ((XMIN . YMIN) (XMAX . YMAX)).
If POSITION is a `strokes-lift', then it is itself returned.
Optional GRID-RESOLUTION may be used in place of `strokes-grid-resolution'.
The grid is a square whose dimension is [0,GRID-RESOLUTION)."
@@ -651,7 +651,7 @@ NOTE: This is where the global variable `strokes-last-stroke' is set."
y))))))))))
(defun strokes-rate-stroke (stroke1 stroke2)
- "Rates STROKE1 with STROKE2 and return a score based on a distance metric.
+ "Rate STROKE1 with STROKE2 and return a score based on a distance metric.
Note: the rating is an error rating, and therefore, a return of 0
represents a perfect match. Also note that the order of stroke
arguments is order-independent for the algorithm used here."
@@ -857,6 +857,9 @@ Optional EVENT is acceptable as the starting event of the stroke."
The command will be executed provided one exists for that stroke,
based on the variable `strokes-minimum-match-score'.
If no stroke matches, nothing is done and return value is nil."
+ ;; FIXME: Undocument return value. It is not documented for all cases,
+ ;; and doesn't allow to difference between no stroke matches and
+ ;; command-execute returning nil, anyway.
(let* ((match (strokes-match-stroke stroke strokes-global-map))
(command (car match))
(score (cdr match)))
@@ -866,8 +869,8 @@ If no stroke matches, nothing is done and return value is nil."
((null strokes-global-map)
(if (file-exists-p strokes-file)
(and (y-or-n-p
- (format "No strokes loaded. Load `%s'? "
- strokes-file))
+ (format-message "No strokes loaded. Load `%s'? "
+ strokes-file))
(strokes-load-user-strokes))
(error "No strokes defined; use `strokes-global-set-stroke'")))
(t
@@ -969,8 +972,8 @@ and you can enter in any arbitrary stroke. Remember: The strokes
package lets you program in simple and complex (multi-lift) strokes.
The only difference is how you *invoke* the two. You will most likely
use simple strokes, as complex strokes were developed for
-Chinese/Japanese/Korean. So the shifted middle mouse button (S-mouse-2) will
-invoke the command `strokes-do-stroke'.
+Chinese/Japanese/Korean. So the shifted middle mouse button (S-mouse-2)
+will invoke the command `strokes-do-stroke'.
If ever you define a stroke which you don't like, then you can unset
it with the command
@@ -991,11 +994,10 @@ down, then use a prefix argument:
> C-u M-x strokes-list-strokes
-Your strokes are stored as you enter them. They get saved in a file
-called ~/.strokes, along with other strokes configuration variables.
-You can change this location by setting the variable `strokes-file'.
-You will be prompted to save them when you exit Emacs, or you can save
-them with
+Your strokes are stored as you enter them. They get saved into the
+file specified by the `strokes-file' variable, along with other strokes
+configuration variables. You will be prompted to save them when you
+exit Emacs, or you can save them with
> M-x strokes-prompt-user-save-strokes
@@ -1010,7 +1012,7 @@ If you'd like to create graphical files with strokes, you'll have to
be running a version of Emacs with XPM support. You use the binding
to `strokes-compose-complex-stroke' to start drawing your strokes.
These are just complex strokes, and thus continue drawing with mouse-1
-or mouse-2 and end with mouse-3. Then the stroke image gets inserted
+or mouse-2 and end with mouse-3. Then the stroke image gets inserted
into the buffer. You treat it somewhat like any other character,
which you can copy, paste, delete, move, etc. When all is done, you
may want to send the file, or save it. This is done with
@@ -1148,7 +1150,7 @@ Returns value of `strokes-use-strokes-buffer'."
(not strokes-use-strokes-buffer))))
(defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only)
- "Create an XPM pixmap for the given STROKE in buffer ` *strokes-xpm*'.
+ "Create an XPM pixmap for the given STROKE in buffer \" *strokes-xpm*\".
If STROKE is not supplied, then `strokes-last-stroke' will be used.
Optional BUFNAME to name something else.
The pixmap will contain time information via rainbow dot colors
@@ -1319,8 +1321,8 @@ the stroke as a character in some language."
;;;###autoload
(defun strokes-list-strokes (&optional chronological strokes-map)
"Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP.
-With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes
-chronologically by command name.
+With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes chronologically
+by command name.
If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(interactive "P")
(setq strokes-map (or strokes-map
@@ -1387,8 +1389,8 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
(define-minor-mode strokes-mode
"Toggle Strokes mode, a global minor mode.
With a prefix argument ARG, enable Strokes mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+positive, and disable it otherwise. If called from Lisp,
+enable the mode if ARG is omitted or nil.
\\<strokes-mode-map>
Strokes are pictographic mouse gestures which invoke commands.
@@ -1541,7 +1543,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
(defun strokes-xpm-to-compressed-string (&optional xpm-buffer)
"Convert XPM in XPM-BUFFER to compressed string representing the stroke.
-XPM-BUFFER defaults to ` *strokes-xpm*'."
+XPM-BUFFER defaults to \" *strokes-xpm*\"."
(with-current-buffer (setq xpm-buffer (or xpm-buffer " *strokes-xpm*"))
(goto-char (point-min))
(search-forward "/* pixels */") ; skip past header junk
@@ -1708,7 +1710,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status."
(defun strokes-xpm-for-compressed-string (compressed-string &optional bufname)
"Convert the stroke represented by COMPRESSED-STRING into an XPM.
-Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
+Store XPM in buffer BUFNAME if supplied (default is \" *strokes-xpm*\")"
(or bufname (setq bufname " *strokes-xpm*"))
(with-current-buffer (get-buffer-create bufname)
(erase-buffer)
diff --git a/lisp/subr.el b/lisp/subr.el
index 17289ef3ce9..b2bc58212a6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,9 +1,9 @@
-;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*-
+;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -29,16 +29,6 @@
;; Beware: while this file has tag `utf-8', before it's compiled, it gets
;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
-(defvar custom-declare-variable-list nil
- "Record `defcustom' calls made before `custom.el' is loaded to handle them.
-Each element of this list holds the arguments to one call to `defcustom'.")
-
-;; Use this, rather than defcustom, in subr.el and other files loaded
-;; before custom.el.
-(defun custom-declare-variable-early (&rest arguments)
- (setq custom-declare-variable-list
- (cons arguments custom-declare-variable-list)))
-
(defmacro declare-function (_fn _file &optional _arglist _fileonly)
"Tell the byte-compiler that function FN is defined, in FILE.
Optional ARGLIST is the argument list used by the function.
@@ -146,8 +136,8 @@ ARGS is a list of the first N arguments to pass to FUN.
The result is a new function which does the same as FUN, except that
the first N arguments are fixed at the values with which this function
was called."
- `(closure (t) (&rest args)
- (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args)))
+ (lambda (&rest args2)
+ (apply fun (append args args2))))
(defmacro push (newelt place)
"Add NEWELT to the list stored in the generalized variable PLACE.
@@ -170,12 +160,17 @@ PLACE must be a generalized variable whose value is a list.
If the value is nil, `pop' returns nil but does not actually
change the list."
(declare (debug (gv-place)))
- (list 'car
- (if (symbolp place)
- ;; So we can use `pop' in the bootstrap before `gv' can be used.
- (list 'prog1 place (list 'setq place (list 'cdr place)))
- (gv-letplace (getter setter) place
- `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+ ;; We use `car-safe' here instead of `car' because the behavior is the same
+ ;; (if it's not a cons cell, the `cdr' would have signaled an error already),
+ ;; but `car-safe' is total, so the byte-compiler can safely remove it if the
+ ;; result is not used.
+ `(car-safe
+ ,(if (symbolp place)
+ ;; So we can use `pop' in the bootstrap before `gv' can be used.
+ (list 'prog1 place (list 'setq place (list 'cdr place)))
+ (gv-letplace (getter setter) place
+ (macroexp-let2 macroexp-copyable-p x getter
+ `(prog1 ,x ,(funcall setter `(cdr ,x))))))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
@@ -271,7 +266,9 @@ information about the function or macro; these go into effect
during the evaluation of the `defun' or `defmacro' form.
The possible values of SPECS are specified by
-`defun-declarations-alist' and `macro-declarations-alist'."
+`defun-declarations-alist' and `macro-declarations-alist'.
+
+For more information, see info node `(elisp)Declare Form'."
;; FIXME: edebug spec should pay attention to defun-declarations-alist.
nil)
@@ -297,9 +294,8 @@ This function accepts any number of arguments, but ignores them."
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
- (while t
- (signal 'error (list (apply 'format args)))))
-(set-advertised-calling-convention 'error '(string &rest args) "23.1")
+ (declare (advertised-calling-convention (string &rest args) "23.1"))
+ (signal 'error (list (apply #'format-message args))))
(defun user-error (format &rest args)
"Signal a pilot error, making error message by passing all args to `format'.
@@ -309,8 +305,7 @@ for the sake of consistency.
This is just like `error' except that `user-error's are expected to be the
result of an incorrect manipulation on the part of the user, rather than the
result of an actual problem."
- (while t
- (signal 'user-error (list (apply #'format format args)))))
+ (signal 'user-error (list (apply #'format-message format args))))
(defun define-error (name message &optional parent)
"Define NAME as a new error signal.
@@ -321,7 +316,7 @@ Defaults to `error'."
(unless parent (setq parent 'error))
(let ((conditions
(if (consp parent)
- (apply #'nconc
+ (apply #'append
(mapcar (lambda (parent)
(cons parent
(or (get parent 'error-conditions)
@@ -340,23 +335,45 @@ Any list whose car is `frame-configuration' is assumed to be a frame
configuration."
(and (consp object)
(eq (car object) 'frame-configuration)))
+
;;;; List functions.
-(defsubst caar (x)
+;; Note: `internal--compiler-macro-cXXr' was copied from
+;; `cl--compiler-macro-cXXr' in cl-macs.el. If you amend either one,
+;; you may want to amend the other, too.
+(defun internal--compiler-macro-cXXr (form x)
+ (let* ((head (car form))
+ (n (symbol-name (car form)))
+ (i (- (length n) 2)))
+ (if (not (string-match "c[ad]+r\\'" n))
+ (if (and (fboundp head) (symbolp (symbol-function head)))
+ (internal--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
+ x)
+ (error "Compiler macro for cXXr applied to non-cXXr form"))
+ (while (> i (match-beginning 0))
+ (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
+ (setq i (1- i)))
+ x)))
+
+(defun caar (x)
"Return the car of the car of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (car x)))
-(defsubst cadr (x)
+(defun cadr (x)
"Return the car of the cdr of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(car (cdr x)))
-(defsubst cdar (x)
+(defun cdar (x)
"Return the cdr of the car of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (car x)))
-(defsubst cddr (x)
+(defun cddr (x)
"Return the cdr of the cdr of X."
+ (declare (compiler-macro internal--compiler-macro-cXXr))
(cdr (cdr x)))
(defun last (list &optional n)
@@ -372,12 +389,15 @@ If N is bigger than the length of LIST, return LIST."
(nthcdr (1- (safe-length list)) list))))
(defun butlast (list &optional n)
- "Return a copy of LIST with the last N elements removed."
+ "Return a copy of LIST with the last N elements removed.
+If N is omitted or nil, the last element is removed from the
+copy."
(if (and n (<= n 0)) list
(nbutlast (copy-sequence list) n)))
(defun nbutlast (list &optional n)
- "Modifies LIST to remove the last N elements."
+ "Modifies LIST to remove the last N elements.
+If N is omitted or nil, remove the last element."
(let ((m (length list)))
(or n (setq n 1))
(and (< n m)
@@ -385,15 +405,33 @@ If N is bigger than the length of LIST, return LIST."
(if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
list))))
+(defun zerop (number)
+ "Return t if NUMBER is zero."
+ ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because
+ ;; = has a byte-code.
+ (declare (compiler-macro (lambda (_) `(= 0 ,number))))
+ (= 0 number))
+
(defun delete-dups (list)
"Destructively remove `equal' duplicates from LIST.
Store the result in LIST and return it. LIST must be a proper list.
Of several `equal' occurrences of an element in LIST, the first
one is kept."
- (let ((tail list))
- (while tail
- (setcdr tail (delete (car tail) (cdr tail)))
- (setq tail (cdr tail))))
+ (let ((l (length list)))
+ (if (> l 100)
+ (let ((hash (make-hash-table :test #'equal :size l))
+ (tail list) retail)
+ (puthash (car list) t hash)
+ (while (setq retail (cdr tail))
+ (let ((elt (car retail)))
+ (if (gethash elt hash)
+ (setcdr tail (cdr retail))
+ (puthash elt t hash)
+ (setq tail retail)))))
+ (let ((tail list))
+ (while tail
+ (setcdr tail (delete (car tail) (cdr tail)))
+ (setq tail (cdr tail))))))
list)
;; See http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00204.html
@@ -402,16 +440,16 @@ one is kept."
First and last elements are considered consecutive if CIRCULAR is
non-nil."
(let ((tail list) last)
- (while (consp tail)
+ (while (cdr tail)
(if (equal (car tail) (cadr tail))
(setcdr tail (cddr tail))
- (setq last (car tail)
+ (setq last tail
tail (cdr tail))))
(if (and circular
- (cdr list)
- (equal last (car list)))
- (nbutlast list)
- list)))
+ last
+ (equal (car tail) (car list)))
+ (setcdr last nil)))
+ list)
(defun number-sequence (from &optional to inc)
"Return a sequence of numbers from FROM to TO (both inclusive) as a list.
@@ -550,6 +588,15 @@ Elements of ALIST that are not conses are ignored."
(setq tail tail-cdr))))
alist)
+(defun alist-get (key alist &optional default remove)
+ "Get the value associated to KEY in ALIST.
+DEFAULT is the value to return if KEY is not found in ALIST.
+REMOVE, if non-nil, means that when setting this element, we should
+remove the entry if the new value is `eql' to DEFAULT."
+ (ignore remove) ;;Silence byte-compiler.
+ (let ((x (assq key alist)))
+ (if x (cdr x) default)))
+
(defun remove (elt seq)
"Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string. The comparison is done with `equal'."
@@ -582,7 +629,15 @@ saving keyboard macros (see `edmacro-mode')."
(defun undefined ()
"Beep to tell the user this binding is undefined."
(interactive)
- (ding))
+ (ding)
+ (message "%s is undefined" (key-description (this-single-command-keys)))
+ (setq defining-kbd-macro nil)
+ (force-mode-line-update)
+ ;; If this is a down-mouse event, don't reset prefix-arg;
+ ;; pass it to the command run by the up event.
+ (setq prefix-arg
+ (when (memq 'down (event-modifiers last-command-event))
+ current-prefix-arg)))
;; Prevent the \{...} documentation construct
;; from mentioning keys that run this command.
@@ -887,7 +942,7 @@ in a cleaner way with command remapping, like this:
(nconc (nreverse skipped) newdef)))
;; Look past a symbol that names a keymap.
(setq inner-def
- (or (indirect-function defn t) defn))
+ (or (indirect-function defn) defn))
;; For nested keymaps, we use `inner-def' rather than `defn' so as to
;; avoid autoloading a keymap. This is mostly done to preserve the
;; original non-autoloading behavior of pre-map-keymap times.
@@ -1016,38 +1071,37 @@ in the current Emacs session, then this function may return nil."
(defun event-start (event)
"Return the starting position of EVENT.
-EVENT should be a click, drag, or key press event.
-If it is a key press event, the return value has the form
- (WINDOW POS (0 . 0) 0)
-If it is a click or drag event, it has the form
- (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
- IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event. If EVENT is a drag, this is the starting
-position of the drag."
+EVENT should be a mouse click, drag, or key press event. If
+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-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.
+`posn-x-y': The pixel-based coordinates of the event.
+`posn-col-row': The estimated column and row corresponding to the
+position of the event.
+`posn-actual-col-row': The actual column and row corresponding to the
+position of the event.
+`posn-string': The string object of the event, which is either
+nil or (STRING . POSITION)'.
+`posn-image': The image object of the event, if any.
+`posn-object': The image or string object of the event, if any.
+`posn-timestamp': The time the event occurred, in milliseconds.
+
+For more information, see Info node `(elisp)Click Events'."
(if (consp event) (nth 1 event)
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
(defun event-end (event)
- "Return the ending location of EVENT.
+ "Return the ending position of EVENT.
EVENT should be a click, drag, or key press event.
-If EVENT is a key press event, the return value has the form
- (WINDOW POS (0 . 0) 0)
-If EVENT is a click event, this function is the same as
-`event-start'. For click and drag events, the return value has
-the form
- (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
- IMAGE (DX . DY) (WIDTH . HEIGHT))
-The `posn-' functions access elements of such lists.
-For more information, see Info node `(elisp)Click Events'.
-
-If EVENT is a mouse or key press or a mouse click, this is the
-position of the event. If EVENT is a drag, this is the starting
-position of the drag."
+
+See `event-start' for a description of the value returned."
(if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
(or (posn-at-point)
(list (selected-window) (point) '(0 . 0) 0))))
@@ -1060,7 +1114,12 @@ The return value is a positive integer."
;;;; Extracting fields of the positions in an event.
(defun posnp (obj)
- "Return non-nil if OBJ appears to be a valid `posn' object."
+ "Return non-nil if OBJ appears to be a valid `posn' object specifying a window.
+If OBJ is a valid `posn' object, but specifies a frame rather
+than a window, return nil."
+ ;; FIXME: Correct the behavior of this function so that all valid
+ ;; `posn' objects are recognized, after updating other code that
+ ;; depends on its present behavior.
(and (windowp (car-safe obj))
(atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS.
(integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET.
@@ -1115,47 +1174,53 @@ pixels. POSITION should be a list of the form returned by
"Return the nominal column and row in POSITION, measured in characters.
The column and row values are approximations calculated from the x
and y coordinates in POSITION and the frame's default character width
-and height.
+and default line height, including spacing.
For a scroll-bar event, the result column is 0, and the row
corresponds to the vertical position of the click in the scroll bar.
POSITION should be a list of the form returned by the `event-start'
and `event-end' functions."
- (let* ((pair (posn-x-y position))
- (window (posn-window position))
- (area (posn-area position)))
+ (let* ((pair (posn-x-y position))
+ (frame-or-window (posn-window position))
+ (frame (if (framep frame-or-window)
+ frame-or-window
+ (window-frame frame-or-window)))
+ (window (when (windowp frame-or-window) frame-or-window))
+ (area (posn-area position)))
(cond
- ((null window)
+ ((null frame-or-window)
'(0 . 0))
((eq area 'vertical-scroll-bar)
(cons 0 (scroll-bar-scale pair (1- (window-height window)))))
((eq area 'horizontal-scroll-bar)
(cons (scroll-bar-scale pair (window-width window)) 0))
(t
- (let* ((frame (if (framep window) window (window-frame window)))
- ;; FIXME: This should take line-spacing properties on
- ;; newlines into account.
- (spacing (when (display-graphic-p frame)
- (or (with-current-buffer (window-buffer window)
- line-spacing)
- (frame-parameter frame 'line-spacing)))))
+ ;; FIXME: This should take line-spacing properties on
+ ;; newlines into account.
+ (let* ((spacing (when (display-graphic-p frame)
+ (or (with-current-buffer
+ (window-buffer (frame-selected-window frame))
+ line-spacing)
+ (frame-parameter frame 'line-spacing)))))
(cond ((floatp spacing)
(setq spacing (truncate (* spacing
(frame-char-height frame)))))
((null spacing)
(setq spacing 0)))
(cons (/ (car pair) (frame-char-width frame))
- (- (/ (cdr pair) (+ (frame-char-height frame) spacing))
- (if (null (with-current-buffer (window-buffer window)
- header-line-format))
- 0 1))))))))
+ (/ (cdr pair) (+ (frame-char-height frame) spacing))))))))
(defun posn-actual-col-row (position)
- "Return the actual column and row in POSITION, measured in characters.
-These are the actual row number in the window and character number in that row.
+ "Return the window row number in POSITION and character number in that row.
+
Return nil if POSITION does not contain the actual position; in that case
`posn-col-row' can be used to get approximate values.
POSITION should be a list of the form returned by the `event-start'
-and `event-end' functions."
+and `event-end' functions.
+
+This function does not account for the width on display, like the
+number of visual columns taken by a TAB or image. If you need
+the coordinates of POSITION in character units, you should use
+`posn-col-row', not this function."
(nth 6 position))
(defsubst posn-timestamp (position)
@@ -1241,7 +1306,10 @@ is converted into a string by expressing it in decimal."
(set-advertised-calling-convention
'all-completions '(string collection &optional predicate) "23.1")
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
+(set-advertised-calling-convention 'indirect-function '(object) "25.1")
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
+(set-advertised-calling-convention 'decode-char '(ch charset) "21.4")
+(set-advertised-calling-convention 'encode-char '(ch charset) "21.4")
;;;; Obsolescence declarations for variables, and aliases.
@@ -1286,6 +1354,7 @@ is converted into a string by expressing it in decimal."
(make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1")
(make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1")
(make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1")
+(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
(make-obsolete 'window-redisplay-end-trigger nil "23.1")
(make-obsolete 'set-window-redisplay-end-trigger nil "23.1")
@@ -1315,6 +1384,7 @@ is converted into a string by expressing it in decimal."
(defalias 'send-region 'process-send-region)
(defalias 'string= 'string-equal)
(defalias 'string< 'string-lessp)
+(defalias 'string> 'string-greaterp)
(defalias 'move-marker 'set-marker)
(defalias 'rplaca 'setcar)
(defalias 'rplacd 'setcdr)
@@ -1362,7 +1432,7 @@ function, it is changed to a list of functions."
(setq local t)))
(let ((hook-value (if local (symbol-value hook) (default-value hook))))
;; If the hook value is a single function, turn it into a list.
- (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (when (or (not (listp hook-value)) (functionp hook-value))
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
@@ -1457,7 +1527,7 @@ Each hook function definition is used to construct the FUN passed
to the next hook function, if any. The last (or \"outermost\")
FUN is then called once."
(declare (indent 2) (debug (form sexp body))
- (obsolete "use a <foo>-function variable modified by add-function."
+ (obsolete "use a <foo>-function variable modified by `add-function'."
"24.4"))
;; We need those two gensyms because CL's lexical scoping is not available
;; for function arguments :-(
@@ -1495,8 +1565,8 @@ FUN is then called once."
(defun add-to-list (list-var element &optional append compare-fn)
"Add ELEMENT to the value of LIST-VAR if it isn't there yet.
-The test for presence of ELEMENT is done with `equal',
-or with COMPARE-FN if that's non-nil.
+The test for presence of ELEMENT is done with `equal', or with
+COMPARE-FN if that's non-nil.
If ELEMENT is added, it is added at the beginning of the list,
unless the optional argument APPEND is non-nil, in which case
ELEMENT is added at the end.
@@ -1504,14 +1574,15 @@ ELEMENT is added at the end.
The return value is the new value of LIST-VAR.
This is handy to add some elements to configuration variables,
-but please do not abuse it in Elisp code, where you are usually better off
-using `push' or `cl-pushnew'.
-
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this. In some cases
-other hooks, such as major mode hooks, can do the job."
+but please do not abuse it in Elisp code, where you are usually
+better off using `push' or `cl-pushnew'.
+
+If you want to use `add-to-list' on a variable that is not
+defined until a certain package is loaded, you should put the
+call to `add-to-list' into a hook function that will be run only
+after loading the package. `eval-after-load' provides one way to
+do this. In some cases other hooks, such as major mode hooks,
+can do the job."
(declare
(compiler-macro
(lambda (exp)
@@ -1522,8 +1593,9 @@ other hooks, such as major mode hooks, can do the job."
exp
(let* ((sym (cadr list-var))
(append (eval append))
- (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
- sym))
+ (msg (format-message
+ "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
+ sym))
;; Big ugly hack so we only output a warning during
;; byte-compilation, and so we can use
;; byte-compile-not-lexical-var-p to silence the warning
@@ -1535,13 +1607,14 @@ other hooks, such as major mode hooks, can do the job."
(byte-compile-log-warning msg t :error))))
(code
(macroexp-let2 macroexp-copyable-p x element
- `(unless ,(if compare-fn
- (progn
- (require 'cl-lib)
- `(cl-member ,x ,sym :test ,compare-fn))
- ;; For bootstrapping reasons, don't rely on
- ;; cl--compiler-macro-member for the base case.
- `(member ,x ,sym))
+ `(if ,(if compare-fn
+ (progn
+ (require 'cl-lib)
+ `(cl-member ,x ,sym :test ,compare-fn))
+ ;; For bootstrapping reasons, don't rely on
+ ;; cl--compiler-macro-member for the base case.
+ `(member ,x ,sym))
+ ,sym
,(if append
`(setq ,sym (append ,sym (list ,x)))
`(push ,x ,sym))))))
@@ -1673,7 +1746,7 @@ this instead of `run-hooks' when running their FOO-mode-hook."
(defmacro delay-mode-hooks (&rest body)
"Execute BODY, but delay any `run-mode-hooks'.
These hooks will be executed by the first following call to
-`run-mode-hooks' that occurs outside any `delayed-mode-hooks' form.
+`run-mode-hooks' that occurs outside any `delay-mode-hooks' form.
Only affects hooks run in the current buffer."
(declare (debug t) (indent 0))
`(progn
@@ -1807,7 +1880,7 @@ If TYPE is nil, then any kind of definition is acceptable. If
TYPE is `defun', `defvar', or `defface', that specifies function
definition, variable definition, or face definition only."
(if (and (or (null type) (eq type 'defun))
- (symbolp symbol) (fboundp symbol)
+ (symbolp symbol)
(autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
(let ((files load-history)
@@ -1862,6 +1935,30 @@ and the file name is displayed in the echo area."
;;;; Process stuff.
+(defun start-process (name buffer program &rest program-args)
+ "Start a program in a subprocess. Return the process object for it.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer name) to associate with the process.
+
+Process output (both standard output and standard error streams) goes
+at end of BUFFER, unless you specify an output stream or filter
+function to handle the output. BUFFER may also be nil, meaning that
+this process is not associated with any buffer.
+
+PROGRAM is the program file name. It is searched for in `exec-path'
+\(which see). If nil, just associate a pty with the buffer. Remaining
+arguments are strings to give program as arguments.
+
+If you want to separate standard output from standard error, use
+`make-process' or invoke the command through a shell and redirect
+one of them using the shell syntax."
+ (unless (fboundp 'make-process)
+ (error "Emacs was compiled without subprocess support"))
+ (apply #'make-process
+ (append (list :name name :buffer buffer)
+ (if program
+ (list :command (cons program program-args))))))
+
(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."
@@ -1882,20 +1979,21 @@ Signal an error if the program returns with a non-zero exit status."
(defun process-live-p (process)
"Returns non-nil if PROCESS is alive.
A process is considered alive if its status is `run', `open',
-`listen', `connect' or `stop'."
- (memq (process-status process)
- '(run open listen connect stop)))
+`listen', `connect' or `stop'. Value is nil if PROCESS is not a
+process."
+ (and (processp process)
+ (memq (process-status process)
+ '(run open listen connect stop))))
;; compatibility
-(make-obsolete
- 'process-kill-without-query
- "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
- "22.1")
(defun process-kill-without-query (process &optional _flag)
"Say no query needed if PROCESS is running when Emacs is exited.
Optional second argument if non-nil says to require a query.
Value is t if a query was formerly required."
+ (declare (obsolete
+ "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
+ "22.1"))
(let ((old (process-query-on-exit-flag process)))
(set-process-query-on-exit-flag process nil)
old))
@@ -1928,17 +2026,6 @@ It can be retrieved with `(process-get PROCESS PROPNAME)'."
;;;; Input and display facilities.
-(defvar read-quoted-char-radix 8
- "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16.")
-
-(custom-declare-variable-early
- 'read-quoted-char-radix 8
- "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16."
- :type '(choice (const 8) (const 10) (const 16))
- :group 'editing-basics)
-
(defconst read-key-empty-map (make-sparse-keymap))
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
@@ -1990,65 +2077,17 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(or (cdr (assq 'tool-bar global-map))
(lookup-key global-map [tool-bar])))
map))
- (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
+ (let* ((keys
+ (catch 'read-key (read-key-sequence-vector prompt nil t)))
+ (key (aref keys 0)))
+ (if (and (> (length keys) 1)
+ (memq key '(mode-line header-line
+ left-fringe right-fringe)))
+ (aref keys 1)
+ key)))
(cancel-timer timer)
(use-global-map old-global-map))))
-(defun read-quoted-char (&optional prompt)
- "Like `read-char', but do not allow quitting.
-Also, if the first character read is an octal digit,
-we read any number of octal digits and return the
-specified character code. Any nondigit terminates the sequence.
-If the terminator is RET, it is discarded;
-any other terminator is used itself as input.
-
-The optional argument PROMPT specifies a string to use to prompt the user.
-The variable `read-quoted-char-radix' controls which radix to use
-for numeric input."
- (let ((message-log-max nil) done (first t) (code 0) translated)
- (while (not done)
- (let ((inhibit-quit first)
- ;; Don't let C-h get the help message--only help function keys.
- (help-char nil)
- (help-form
- "Type the special character you want to use,
-or the octal character code.
-RET terminates the character code and is discarded;
-any other non-digit terminates the character code and is then used as input."))
- (setq translated (read-key (and prompt (format "%s-" prompt))))
- (if inhibit-quit (setq quit-flag nil)))
- (if (integerp translated)
- (setq translated (char-resolve-modifiers translated)))
- (cond ((null translated))
- ((not (integerp translated))
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- ((/= (logand translated ?\M-\^@) 0)
- ;; Turn a meta-character into a character with the 0200 bit set.
- (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
- done t))
- ((and (<= ?0 translated)
- (< translated (+ ?0 (min 10 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (<= ?a (downcase translated))
- (< (downcase translated)
- (+ ?a -10 (min 36 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix)
- (+ 10 (- (downcase translated) ?a))))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (not first) (eq translated ?\C-m))
- (setq done t))
- ((not first)
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- (t (setq code translated
- done t)))
- (setq first nil))
- code))
-
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
;; minibuffer-local-map along the way!
@@ -2064,6 +2103,7 @@ If optional CONFIRM is non-nil, read the password twice to make sure.
Optional DEFAULT is a default password to use instead of empty input.
This function echoes `.' for each character that the user types.
+You could let-bind `read-hide-char' to another hiding character, though.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
@@ -2088,7 +2128,7 @@ by doing (clear-string STRING)."
beg)))
(dotimes (i (- end beg))
(put-text-property (+ i beg) (+ 1 i beg)
- 'display (string ?.)))))
+ 'display (string (or read-hide-char ?.))))))
minibuf)
(minibuffer-with-setup-hook
(lambda ()
@@ -2098,9 +2138,12 @@ by doing (clear-string STRING)."
(setq-local buffer-undo-list t)
(setq-local select-active-regions nil)
(use-local-map read-passwd-map)
+ (setq-local inhibit-modification-hooks nil) ;bug#15501.
+ (setq-local show-paren-mode nil) ;bug#16091.
(add-hook 'after-change-functions hide-chars-fun nil 'local))
(unwind-protect
- (let ((enable-recursive-minibuffers t))
+ (let ((enable-recursive-minibuffers t)
+ (read-hide-char (or read-hide-char ?.)))
(read-string prompt nil t default)) ; t = "no history"
(when (buffer-live-p minibuf)
(with-current-buffer minibuf
@@ -2191,7 +2234,7 @@ keyboard-quit events while waiting for a valid input."
char))
(defun sit-for (seconds &optional nodisp obsolete)
- "Perform redisplay, then wait for SECONDS seconds or until input is available.
+ "Redisplay, then wait for SECONDS seconds. Stop when input is available.
SECONDS may be a floating-point value.
\(On operating systems that do not support waiting for fractions of a
second, floating-point values are rounded down to the nearest integer.)
@@ -2207,6 +2250,10 @@ where the optional arg MILLISECONDS specifies an additional wait period,
in milliseconds; this was useful when Emacs was built without
floating point support."
(declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
+ ;; This used to be implemented in C until the following discussion:
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
+ ;; Then it was moved here using an implementation based on an idle timer,
+ ;; which was then replaced by the use of read-event.
(if (numberp nodisp)
(setq seconds (+ seconds (* 1e-3 nodisp))
nodisp obsolete)
@@ -2215,26 +2262,49 @@ floating point support."
(noninteractive
(sleep-for seconds)
t)
- ((input-pending-p)
+ ((input-pending-p t)
nil)
- ((<= seconds 0)
+ ((or (<= seconds 0)
+ ;; We are going to call read-event below, which will record
+ ;; the the next key as part of the macro, even if that key
+ ;; invokes kmacro-end-macro, so if we are recording a macro,
+ ;; the macro will recursively call itself. In addition, when
+ ;; that key is removed from unread-command-events, it will be
+ ;; recorded the second time, so the macro will have each key
+ ;; doubled. This used to happen if a macro was defined with
+ ;; Flyspell mode active (because Flyspell calls sit-for in its
+ ;; post-command-hook, see bug #21329.) To avoid all that, we
+ ;; simply disable the wait when we are recording a macro.
+ defining-kbd-macro)
(or nodisp (redisplay)))
(t
(or nodisp (redisplay))
;; FIXME: we should not read-event here at all, because it's much too
;; difficult to reliably "undo" a read-event by pushing it onto
;; unread-command-events.
- (let ((read (read-event nil t seconds)))
+ ;; For bug#14782, we need read-event to do the keyboard-coding-system
+ ;; decoding (hence non-nil as second arg under POSIX ttys).
+ ;; For bug#15614, we need read-event not to inherit-input-method.
+ ;; So we temporarily suspend input-method-function.
+ (let ((read (let ((input-method-function nil))
+ (read-event nil t seconds))))
(or (null read)
(progn
- ;; If last command was a prefix arg, e.g. C-u, push this event onto
- ;; unread-command-events as (t . EVENT) so it will be added to
- ;; this-command-keys by read-key-sequence.
- (if (eq overriding-terminal-local-map universal-argument-map)
- (setq read (cons t read)))
- (push read unread-command-events)
+ ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html
+ ;; We want `read' appear in the next command's this-command-event
+ ;; but not in the current one.
+ ;; By pushing (cons t read), we indicate that `read' has not
+ ;; yet been recorded in this-command-keys, so it will be recorded
+ ;; next time it's read.
+ ;; And indeed the `seconds' argument to read-event correctly
+ ;; prevented recording this event in the current command's
+ ;; this-command-keys.
+ (push (cons t read) unread-command-events)
nil))))))
+;; Behind display-popup-menus-p test.
+(declare-function x-popup-dialog "menu.c" (position contents &optional header))
+
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
PROMPT is the string to display to ask the question. It should
@@ -2259,14 +2329,16 @@ is nil and `use-dialog-box' is non-nil."
;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
;; where all the keys were unbound (i.e. it somehow got triggered
;; within read-key, apparently). I had to kill it.
- (let ((answer 'recenter))
+ (let ((answer 'recenter)
+ (padded (lambda (prompt &optional dialog)
+ (let ((l (length prompt)))
+ (concat prompt
+ (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+ "" " ")
+ (if dialog "" "(y or n) "))))))
(cond
(noninteractive
- (setq prompt (concat prompt
- (if (or (zerop (length prompt))
- (eq ?\s (aref prompt (1- (length prompt)))))
- "" " ")
- "(y or n) "))
+ (setq prompt (funcall padded prompt))
(let ((temp-prompt prompt))
(while (not (memq answer '(act skip)))
(let ((str (read-string temp-prompt)))
@@ -2275,16 +2347,13 @@ is nil and `use-dialog-box' is non-nil."
(t (setq temp-prompt (concat "Please answer y or n. "
prompt))))))))
((and (display-popup-menus-p)
+ last-input-event ; not during startup
(listp last-nonmenu-event)
use-dialog-box)
- (setq answer
- (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
+ (setq prompt (funcall padded prompt t)
+ answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
(t
- (setq prompt (concat prompt
- (if (or (zerop (length prompt))
- (eq ?\s (aref prompt (1- (length prompt)))))
- "" " ")
- "(y or n) "))
+ (setq prompt (funcall padded prompt))
(while
(let* ((scroll-actions '(recenter scroll-up scroll-down
scroll-other-window scroll-other-window-down))
@@ -2317,9 +2386,7 @@ is nil and `use-dialog-box' is non-nil."
(discard-input))))
(let ((ret (eq answer 'act)))
(unless noninteractive
- ;; FIXME this prints one too many spaces, since prompt
- ;; already ends in a space. Eg "... (y or n) y".
- (message "%s %s" prompt (if ret "y" "n")))
+ (message "%s%c" prompt (if ret ?y ?n)))
ret)))
@@ -2441,14 +2508,6 @@ This finishes the change group by reverting all of its changes."
(define-obsolete-function-alias 'redraw-modeline
'force-mode-line-update "24.3")
-(defun force-mode-line-update (&optional all)
- "Force redisplay of the current buffer's mode line and header line.
-With optional non-nil ALL, force redisplay of all mode lines and
-header lines. This function also forces recomputation of the
-menu bar menus and the frame title."
- (if all (with-current-buffer (other-buffer)))
- (set-buffer-modified-p (buffer-modified-p)))
-
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
Display remains until next event is input.
@@ -2479,7 +2538,8 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
(or (eq event exit-char)
(eq event (event-convert-list exit-char))
(setq unread-command-events
- (append (this-single-command-raw-keys))))))
+ (append (this-single-command-raw-keys)
+ unread-command-events)))))
(delete-overlay ol))))
@@ -2555,57 +2615,6 @@ mode.")
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.
See also `locate-user-emacs-file'.")
-
-(custom-declare-variable-early 'user-emacs-directory-warning t
- "Non-nil means warn if cannot access `user-emacs-directory'.
-Set this to nil at your own risk..."
- :type 'boolean
- :group 'initialization
- :version "24.4")
-
-(defun locate-user-emacs-file (new-name &optional old-name)
- "Return an absolute per-user Emacs-specific file name.
-If NEW-NAME exists in `user-emacs-directory', return it.
-Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
-Else return NEW-NAME in `user-emacs-directory', creating the
-directory if it does not exist."
- (convert-standard-filename
- (let* ((home (concat "~" (or init-file-user "")))
- (at-home (and old-name (expand-file-name old-name home)))
- (bestname (abbreviate-file-name
- (expand-file-name new-name user-emacs-directory))))
- (if (and at-home (not (file-readable-p bestname))
- (file-readable-p at-home))
- at-home
- ;; Make sure `user-emacs-directory' exists,
- ;; unless we're in batch mode or dumping Emacs.
- (or noninteractive
- purify-flag
- (let (errtype)
- (if (file-directory-p user-emacs-directory)
- (or (file-accessible-directory-p user-emacs-directory)
- (setq errtype "access"))
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes ?\700)
- (condition-case nil
- (make-directory user-emacs-directory)
- (error (setq errtype "create"))))
- (set-default-file-modes umask))))
- (when (and errtype
- user-emacs-directory-warning
- (not (get 'user-emacs-directory-warning 'this-session)))
- ;; Only warn once per Emacs session.
- (put 'user-emacs-directory-warning 'this-session t)
- (display-warning 'initialization
- (format "\
-Unable to %s `user-emacs-directory' (%s).
-Any data that would normally be written there may be lost!
-If you never want to see this message again,
-customize the variable `user-emacs-directory-warning'."
- errtype user-emacs-directory)))))
- bestname))))
;;;; Misc. useful functions.
@@ -2655,14 +2664,26 @@ If there is no tag at point, return nil.
When in a major mode that does not provide its own
`find-tag-default-function', return a regexp that matches the
symbol at point exactly."
- (let* ((tagf (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default))
- (tag (funcall tagf)))
- (cond ((null tag) nil)
- ((eq tagf 'find-tag-default)
- (format "\\_<%s\\_>" (regexp-quote tag)))
- (t (regexp-quote tag)))))
+ (let ((tag (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))))
+ (if tag (regexp-quote tag))))
+
+(defun find-tag-default-as-symbol-regexp ()
+ "Return regexp that matches the default tag at point as symbol.
+If there is no tag at point, return nil.
+
+When in a major mode that does not provide its own
+`find-tag-default-function', return a regexp that matches the
+symbol at point exactly."
+ (let ((tag-regexp (find-tag-default-as-regexp)))
+ (if (and tag-regexp
+ (eq (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default)
+ 'find-tag-default))
+ (format "\\_<%s\\_>" tag-regexp)
+ tag-regexp)))
(defun play-sound (sound)
"SOUND is a list of the form `(sound KEYWORD VALUE...)'.
@@ -2690,7 +2711,11 @@ Note: :data and :device are currently not supported on Windows."
(declare-function w32-shell-dos-semantics "w32-fns" nil)
(defun shell-quote-argument (argument)
- "Quote ARGUMENT for passing as argument to an inferior shell."
+ "Quote ARGUMENT for passing as argument to an inferior shell.
+
+This function is designed to work with the syntax of your system's
+standard shell, and might produce incorrect results with unusual shells.
+See Info node `(elisp)Security Considerations'."
(cond
((eq system-type 'ms-dos)
;; Quote using double quotes, but escape any existing quotes in
@@ -2762,12 +2787,12 @@ Otherwise, return nil."
(defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
(if (and (symbolp object) (fboundp object))
- (setq object (indirect-function object t)))
+ (setq object (indirect-function object)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(defun macrop (object)
"Non-nil if and only if OBJECT is a macro."
- (let ((def (indirect-function object t)))
+ (let ((def (indirect-function object)))
(when (consp def)
(or (eq 'macro (car def))
(and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
@@ -2807,6 +2832,7 @@ if it's an autoloaded macro."
val))
;;;; Support for yanking and text properties.
+;; Why here in subr.el rather than in simple.el? --Stef
(defvar yank-handled-properties)
(defvar yank-excluded-properties)
@@ -2818,17 +2844,18 @@ remove properties specified by `yank-excluded-properties'."
(let ((inhibit-read-only t))
(dolist (handler yank-handled-properties)
(let ((prop (car handler))
- (fun (cdr handler))
- (run-start start))
- (while (< run-start end)
- (let ((value (get-text-property run-start prop))
- (run-end (next-single-property-change
- run-start prop nil end)))
- (funcall fun value run-start run-end)
- (setq run-start run-end)))))
- (if (eq yank-excluded-properties t)
- (set-text-properties start end nil)
- (remove-list-of-text-properties start end yank-excluded-properties))))
+ (fun (cdr handler))
+ (run-start start))
+ (while (< run-start end)
+ (let ((value (get-text-property run-start prop))
+ (run-end (next-single-property-change
+ run-start prop nil end)))
+ (funcall fun value run-start run-end)
+ (setq run-start run-end)))))
+ (with-silent-modifications
+ (if (eq yank-excluded-properties t)
+ (set-text-properties start end nil)
+ (remove-list-of-text-properties start end yank-excluded-properties)))))
(defvar yank-undo-function)
@@ -2958,23 +2985,21 @@ COMMAND is the shell command to run.
An old calling convention accepted any number of arguments after COMMAND,
which were just concatenated to COMMAND. This is still supported but strongly
discouraged."
- ;; We used to use `exec' to replace the shell with the command,
- ;; but that failed to handle (...) and semicolon, etc.
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
+ ;; We used to use `exec' to replace the shell with the command,
+ ;; but that failed to handle (...) and semicolon, etc.
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-process-shell-command
- '(name buffer command) "23.1")
(defun start-file-process-shell-command (name buffer &rest args)
"Start a program in a subprocess. Return the process object for it.
Similar to `start-process-shell-command', but calls `start-file-process'."
+ (declare (advertised-calling-convention (name buffer command) "23.1"))
(start-file-process
name buffer
(if (file-remote-p default-directory) "/bin/sh" shell-file-name)
(if (file-remote-p default-directory) "-c" shell-command-switch)
(mapconcat 'identity args " ")))
-(set-advertised-calling-convention 'start-file-process-shell-command
- '(name buffer command) "23.1")
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
@@ -2990,13 +3015,18 @@ STDERR-FILE may be nil (discard standard error output),
t (mix it with ordinary output), or a file name string.
Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
-Remaining arguments are strings passed as additional arguments for COMMAND.
Wildcards and redirection are handled as usual in the shell.
If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
Otherwise it waits for COMMAND to terminate and returns a numeric exit
status or a signal description string.
-If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
+If you quit, the process is killed with SIGINT, or SIGKILL if you quit again.
+
+An old calling convention accepted any number of arguments after DISPLAY,
+which were just concatenated to COMMAND. This is still supported but strongly
+discouraged."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
;; We used to use `exec' to replace the shell with the command,
;; but that failed to handle (...) and semicolon, etc.
(call-process shell-file-name
@@ -3008,6 +3038,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
&rest args)
"Process files synchronously in a separate process.
Similar to `call-process-shell-command', but calls `process-file'."
+ (declare (advertised-calling-convention
+ (command &optional infile buffer display) "24.5"))
(process-file
(if (file-remote-p default-directory) "/bin/sh" shell-file-name)
infile buffer display
@@ -3016,6 +3048,14 @@ Similar to `call-process-shell-command', but calls `process-file'."
;;;; Lisp macros to do various things temporarily.
+(defmacro track-mouse (&rest body)
+ "Evaluate BODY with mouse movement events enabled.
+Within a `track-mouse' form, mouse motion generates input events that
+ you can read with `read-event'.
+Normally, mouse motion is ignored."
+ (declare (debug t) (indent 0))
+ `(internal--track-mouse (lambda () ,@body)))
+
(defmacro with-current-buffer (buffer-or-name &rest body)
"Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
@@ -3180,6 +3220,11 @@ buffer temporarily current, and the window that was used to display it
temporarily selected. But it doesn't run `temp-buffer-show-hook'
if it uses `temp-buffer-show-function'.
+By default, the setup hook puts the buffer into Help mode before running BODY.
+If BODY does not change the major mode, the show hook makes the buffer
+read-only, and scans it for function and variable names to make them into
+clickable cross-references.
+
See the related form `with-temp-buffer-window'."
(declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
@@ -3275,12 +3320,7 @@ not really affect the buffer's content."
`(let* ((,modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
- (inhibit-modification-hooks t)
- deactivate-mark
- ;; Avoid setting and removing file locks and checking
- ;; buffer's uptodate-ness w.r.t the underlying file.
- buffer-file-name
- buffer-file-truename)
+ (inhibit-modification-hooks t))
(unwind-protect
(progn
,@body)
@@ -3346,16 +3386,26 @@ even if this catches the signal."
(define-obsolete-function-alias 'condition-case-no-debug
'condition-case-unless-debug "24.1")
-(defmacro with-demoted-errors (&rest body)
+(defmacro with-demoted-errors (format &rest body)
"Run BODY and demote any errors to simple messages.
+FORMAT is a string passed to `message' to format any error message.
+It should contain a single %-sequence; e.g., \"Error: %S\".
+
If `debug-on-error' is non-nil, run BODY without catching its errors.
This is to be used around code which is not expected to signal an error
-but which should be robust in the unexpected case that an error is signaled."
- (declare (debug t) (indent 0))
- (let ((err (make-symbol "err")))
+but which should be robust in the unexpected case that an error is signaled.
+
+For backward compatibility, if FORMAT is not a constant string, it
+is assumed to be part of BODY, in which case the message format
+used is \"Error: %S\"."
+ (declare (debug t) (indent 1))
+ (let ((err (make-symbol "err"))
+ (format (if (and (stringp format) body) format
+ (prog1 "Error: %S"
+ (if format (push format body))))))
`(condition-case-unless-debug ,err
- (progn ,@body)
- (error (message "Error: %S" ,err) nil))))
+ ,(macroexp-progn body)
+ (error (message ,format ,err) nil))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
@@ -3388,6 +3438,19 @@ The value returned is the value of the last form in BODY."
,@body)
(with-current-buffer ,old-buffer
(set-case-table ,old-case-table))))))
+
+(defmacro with-file-modes (modes &rest body)
+ "Execute BODY with default file permissions temporarily set to MODES.
+MODES is as for `set-default-file-modes'."
+ (declare (indent 1) (debug t))
+ (let ((umask (make-symbol "umask")))
+ `(let ((,umask (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes ,modes)
+ ,@body)
+ (set-default-file-modes ,umask)))))
+
;;; Matching and match data.
@@ -3469,7 +3532,12 @@ If GREEDY is non-nil, extend the match backwards as far as
possible, stopping when a single additional previous character
cannot be part of a match for REGEXP. When the match is
extended, its starting position is allowed to occur before
-LIMIT."
+LIMIT.
+
+As a general recommendation, try to avoid using `looking-back'
+wherever possible, since it is slow."
+ (declare
+ (advertised-calling-convention (regexp limit &optional greedy) "25.1"))
(let ((start (point))
(pos
(save-excursion
@@ -3693,7 +3761,8 @@ REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function, it is called with the actual text of each
match, and its value is used as the replacement text. When REP is called,
the match data are the result of matching REGEXP against a substring
-of STRING.
+of STRING, the same substring that is the actual text of the match which
+is passed to REP as its argument.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
@@ -3736,12 +3805,23 @@ and replace a sub-expression, e.g.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
-(defun string-prefix-p (str1 str2 &optional ignore-case)
- "Return non-nil if STR1 is a prefix of STR2.
+(defun string-prefix-p (prefix string &optional ignore-case)
+ "Return non-nil if PREFIX is a prefix of STRING.
If IGNORE-CASE is non-nil, the comparison is done without paying attention
to case differences."
- (eq t (compare-strings str1 nil nil
- str2 0 (length str1) ignore-case)))
+ (let ((prefix-length (length prefix)))
+ (if (> prefix-length (length string)) nil
+ (eq t (compare-strings prefix 0 prefix-length string
+ 0 prefix-length ignore-case)))))
+
+(defun string-suffix-p (suffix string &optional ignore-case)
+ "Return non-nil if SUFFIX is a suffix of STRING.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case)))))
(defun bidi-string-mark-left-to-right (str)
"Return a string that can be safely inserted in left-to-right text.
@@ -3760,6 +3840,13 @@ consisting of STR followed by an invisible left-to-right mark
(if (string-match "\\cR" str)
(concat str (propertize (string ?\x200e) 'invisible t))
str))
+
+(defun string-greaterp (string1 string2)
+ "Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
+Case is significant.
+Symbols are also allowed; their print names are used instead."
+ (string-lessp string2 string1))
+
;;;; Specifying things to do later.
@@ -3868,7 +3955,7 @@ This function makes or adds to an entry on `after-load-alist'."
(when (equal file lfn)
(remove-hook 'after-load-functions fun)
(funcall func))))
- (add-hook 'after-load-functions fun)))))))
+ (add-hook 'after-load-functions fun 'append)))))))
;; Add FORM to the element unless it's already there.
(unless (member delayed-func (cdr elt))
(nconc elt (list delayed-func)))))))
@@ -3896,13 +3983,29 @@ This function is called directly from the C code."
;; discard the file name regexp
(mapc #'funcall (cdr a-l-element))))
;; Complain when the user uses obsolete files.
- (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
- (run-with-timer 0 nil
- (lambda (file)
- (message "Package %s is obsolete!"
- (substring file 0
- (string-match "\\.elc?\\>" file))))
- (file-name-nondirectory abs-file)))
+ (when (string-match-p "/obsolete/\\([^/]*\\)\\'" abs-file)
+ ;; Maybe we should just use display-warning? This seems yucky...
+ (let* ((file (file-name-nondirectory abs-file))
+ (msg (format "Package %s is obsolete!"
+ (substring file 0
+ (string-match "\\.elc?\\>" file)))))
+ ;; Cribbed from cl--compiling-file.
+ (if (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+ " *Compiler Output*"))
+ ;; Don't warn about obsolete files using other obsolete files.
+ (unless (and (stringp byte-compile-current-file)
+ (string-match-p "/obsolete/[^/]*\\'"
+ (expand-file-name
+ byte-compile-current-file
+ byte-compile-root-dir)))
+ (byte-compile-log-warning msg))
+ (run-with-timer 0 nil
+ (lambda (msg)
+ (message "%s" msg))
+ msg))))
+
;; Finally, run any other hook.
(run-hook-with-args 'after-load-functions abs-file))
@@ -3967,9 +4070,10 @@ that can be added."
(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))))
+ (setq buffer-invisibility-spec
+ (if (consp buffer-invisibility-spec)
+ (delete element buffer-invisibility-spec)
+ (list t))))
;;;; Syntax tables.
@@ -4218,6 +4322,9 @@ I is the index of the frame after FRAME2. It should return nil
if those frames don't seem special and otherwise, it should return
the number of frames to skip (minus 1).")
+(defconst internal--funcall-interactively
+ (symbol-function 'funcall-interactively))
+
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
If KIND is `interactive', then only return t if the call was made
@@ -4290,10 +4397,13 @@ command is called from a keyboard macro?"
(pcase (cons frame nextframe)
;; No subr calls `interactive-p', so we can rule that out.
(`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil)
- ;; Somehow, I sometimes got `command-execute' rather than
- ;; `call-interactively' on my stacktrace !?
- ;;(`(,_ . (t command-execute . ,_)) t)
- (`(,_ . (t call-interactively . ,_)) t)))))
+ ;; In case #<subr funcall-interactively> without going through the
+ ;; `funcall-interactively' symbol (bug#3984).
+ (`(,_ . (t ,(pred (lambda (f)
+ (eq internal--funcall-interactively
+ (indirect-function f))))
+ . ,_))
+ t)))))
(defun interactive-p ()
"Return t if the containing function was run directly by user input.
@@ -4333,42 +4443,59 @@ use `called-interactively-p'."
(eq 'add-keymap-witness (nth 1 map))
(set symbol tail)))))
-(defun set-temporary-overlay-map (map &optional keep-pred on-exit)
- "Set MAP as a temporary keymap taking precedence over most other keymaps.
-Note that this does NOT take precedence over the \"overriding\" maps
-`overriding-terminal-local-map' and `overriding-local-map' (or the
-`keymap' text property). Unlike those maps, if no match for a key is
-found in MAP, the normal key lookup sequence then continues.
-
-Normally, MAP is used only once. If the optional argument
-KEEP-PRED is t, MAP stays active if a key from MAP is used.
-KEEP-PRED can also be a function of no arguments: if it returns
-non-nil then MAP stays active.
-
-Optional ON-EXIT argument is a function that is called after the
-deactivation of MAP."
- (let ((clearfun (make-symbol "clear-temporary-overlay-map")))
+(define-obsolete-function-alias
+ 'set-temporary-overlay-map 'set-transient-map "24.4")
+
+(defun set-transient-map (map &optional keep-pred on-exit)
+ "Set MAP as a temporary keymap taking precedence over other keymaps.
+Normally, MAP is used only once, to look up the very next key.
+However, if the optional argument KEEP-PRED is t, MAP stays
+active if a key from MAP is used. KEEP-PRED can also be a
+function of no arguments: it is called from `pre-command-hook' and
+if it returns non-nil, then MAP stays active.
+
+Optional arg ON-EXIT, if non-nil, specifies a function that is
+called, with no arguments, after MAP is deactivated.
+
+This uses `overriding-terminal-local-map' which takes precedence over all other
+keymaps. As usual, if no match for a key is found in MAP, the normal key
+lookup sequence then continues.
+
+This returns an \"exit function\", which can be called with no argument
+to deactivate this transient map, regardless of KEEP-PRED."
+ (let* ((clearfun (make-symbol "clear-transient-map"))
+ (exitfun
+ (lambda ()
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when on-exit (funcall on-exit)))))
;; Don't use letrec, because equal (in add/remove-hook) would get trapped
;; in a cycle.
(fset clearfun
(lambda ()
- ;; FIXME: Handle the case of multiple temporary-overlay-maps
- ;; E.g. if isearch and C-u both use temporary-overlay-maps, Then
- ;; the lifetime of the C-u should be nested within the isearch
- ;; overlay, so the pre-command-hook of isearch should be
- ;; suspended during the C-u one so we don't exit isearch just
- ;; because we hit 1 after C-u and that 1 exits isearch whereas it
- ;; doesn't exit C-u.
- (unless (cond ((null keep-pred) nil)
- ((eq t keep-pred)
- (eq this-command
- (lookup-key map (this-command-keys-vector))))
- (t (funcall keep-pred)))
- (remove-hook 'pre-command-hook clearfun)
- (internal-pop-keymap map 'overriding-terminal-local-map)
- (when on-exit (funcall on-exit)))))
+ (with-demoted-errors "set-transient-map PCH: %S"
+ (unless (cond
+ ((null keep-pred) nil)
+ ((not (eq map (cadr overriding-terminal-local-map)))
+ ;; There's presumably some other transient-map in
+ ;; effect. Wait for that one to terminate before we
+ ;; remove ourselves.
+ ;; For example, if isearch and C-u both use transient
+ ;; maps, then the lifetime of the C-u should be nested
+ ;; within isearch's, so the pre-command-hook of
+ ;; isearch should be suspended during the C-u one so
+ ;; we don't exit isearch just because we hit 1 after
+ ;; C-u and that 1 exits isearch whereas it doesn't
+ ;; exit C-u.
+ t)
+ ((eq t keep-pred)
+ (eq this-command
+ (lookup-key map (this-command-keys-vector))))
+ (t (funcall keep-pred)))
+ (funcall exitfun)))))
(add-hook 'pre-command-hook clearfun)
- (internal-push-keymap map 'overriding-terminal-local-map)))
+ (internal-push-keymap map 'overriding-terminal-local-map)
+ exitfun))
;;;; Progress reporters.
@@ -4476,11 +4603,10 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter."
(min-value (aref parameters 1))
(max-value (aref parameters 2))
(text (aref parameters 3))
- (current-time (float-time))
(enough-time-passed
;; See if enough time has passed since the last update.
(or (not update-time)
- (when (>= current-time update-time)
+ (when (>= (float-time) update-time)
;; Calculate time for the next update
(aset parameters 0 (+ update-time (aref parameters 5)))))))
(cond ((and min-value max-value)
@@ -4560,11 +4686,14 @@ Usually the separator is \".\", but it can be any other string.")
(defconst version-regexp-alist
- '(("^[-_+ ]?alpha$" . -3)
- ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
- ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
- ("^[-_+ ]?beta$" . -2)
- ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
+ '(("^[-_+ ]?snapshot$" . -4)
+ ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
+ ("^[-_+]$" . -4)
+ ;; treat "1.2.3-CVS" as snapshot release
+ ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4)
+ ("^[-_+ ]?alpha$" . -3)
+ ("^[-_+ ]?beta$" . -2)
+ ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
"Specify association between non-numeric version and its priority.
This association is used to handle version string like \"1.0pre2\",
@@ -4572,6 +4701,8 @@ This association is used to handle version string like \"1.0pre2\",
non-numeric part of a version string to an integer. For example:
String Version Integer List Version
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
\"1.0pre2\" (1 0 -1 2)
\"1.0PRE2\" (1 0 -1 2)
\"22.8beta3\" (22 8 -2 3)
@@ -4628,10 +4759,12 @@ Examples of version conversion:
\"0.9alpha1\" (0 9 -3 1)
\"0.9AlphA1\" (0 9 -3 1)
\"0.9alpha\" (0 9 -3)
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
See documentation for `version-separator' and `version-regexp-alist'."
(or (and (stringp ver) (> (length ver) 0))
- (error "Invalid version string: '%s'" ver))
+ (error "Invalid version string: `%s'" ver))
;; Change .x.y to 0.x.y
(if (and (>= (length ver) (length version-separator))
(string-equal (substring ver 0 (length version-separator))
@@ -4663,9 +4796,9 @@ See documentation for `version-separator' and `version-regexp-alist'."
((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
(push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
lst))
- (t (error "Invalid version syntax: '%s'" ver))))))
+ (t (error "Invalid version syntax: `%s'" ver))))))
(if (null lst)
- (error "Invalid version syntax: '%s'" ver)
+ (error "Invalid version syntax: `%s'" ver)
(nreverse lst)))))
@@ -4749,19 +4882,18 @@ If all LST elements are zeros or LST is nil, return zero."
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-< (version-to-list v1) (version-to-list v2)))
-
(defun version<= (v1 v2)
"Return t if version V1 is lower (older) than or equal to V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-<= (version-to-list v1) (version-to-list v2)))
(defun version= (v1 v2)
@@ -4770,10 +4902,25 @@ as alpha versions."
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
+(defvar package--builtin-versions
+ ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions.
+ (purecopy `((emacs . ,(version-to-list emacs-version))))
+ "Alist giving the version of each versioned builtin package.
+I.e. each element of the list is of the form (NAME . VERSION) where
+NAME is the package name as a symbol, and VERSION is its version
+as a list.")
+
+(defun package--description-file (dir)
+ (concat (let ((subdir (file-name-nondirectory
+ (directory-file-name dir))))
+ (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir)
+ (match-string 1 subdir) subdir))
+ "-pkg.el"))
+
;;; Thread support.
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index a9238ba60cb..4ca9440cdbe 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -1,10 +1,10 @@
;;; t-mouse.el --- mouse support within the text terminal
;; Author: Nick Roberts <nickrob@gnu.org>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: mouse gpm linux
-;; Copyright (C) 1994-1995, 1998, 2006-2013 Free Software Foundation,
+;; Copyright (C) 1994-1995, 1998, 2006-2015 Free Software Foundation,
;; Inc.
;; This file is part of GNU Emacs.
diff --git a/lisp/tabify.el b/lisp/tabify.el
index 44a233717dd..c2f4e0c8854 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -1,8 +1,8 @@
;;; tabify.el --- tab conversion commands for Emacs
-;; Copyright (C) 1985, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/talk.el b/lisp/talk.el
index 8c991c8d995..058613177e1 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -1,8 +1,8 @@
;;; talk.el --- allow several users to talk to each other through Emacs
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, frames
;; This file is part of GNU Emacs.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index be7bdb25d26..6c7f7553f82 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -1,9 +1,9 @@
;;; tar-mode.el --- simple editing of tar files from GNU Emacs
-;; Copyright (C) 1990-1991, 1993-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1990-1991, 1993-2015 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Created: 04 Apr 1990
;; Keywords: unix
@@ -50,9 +50,6 @@
;;
;; o chmod should understand "a+x,og-w".
;;
-;; o It's not possible to add a NEW file to a tar archive; not that
-;; important, but still...
-;;
;; o The code is less efficient that it could be - in a lot of places, I
;; pull a 512-character string out of the buffer and parse it, when I could
;; be parsing it in place, not garbaging a string. Should redo that.
@@ -369,6 +366,80 @@ write-date, checksum, link-type, and link-name."
string)
(tar-parse-octal-integer string))
+(defun tar-new-regular-file-header (filename &optional size time)
+ "Return a Tar header for a regular file.
+The header will lack a proper checksum; use `tar-header-block-checksum'
+to compute one, or request `tar-header-serialize' to do that.
+
+Other tar-mode facilities may also require the data-start header
+field to be set to a valid value.
+
+If SIZE is not given or nil, it defaults to 0.
+If TIME is not given or nil, assume now."
+ (make-tar-header
+ nil
+ filename
+ #o644 0 0 (or size 0)
+ (or time (current-time))
+ nil ; checksum
+ nil nil
+ nil nil nil nil nil))
+
+(defun tar--pad-to (pos)
+ (make-string (+ pos (- (point)) (point-min)) 0))
+
+(defun tar--put-at (pos val &optional fmt mask)
+ (when val
+ (insert (tar--pad-to pos)
+ (if fmt
+ (format fmt (if mask (logand mask val) val))
+ val))))
+
+(defun tar-header-serialize (header &optional update-checksum)
+ "Return the serialization of a Tar HEADER as a string.
+This function calls `tar-header-block-check-checksum' to ensure the
+checksum is correct.
+
+If UPDATE-CHECKSUM is non-nil, update HEADER with the newly-computed
+checksum before doing the check."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (let ((encoded-name
+ (encode-coding-string (tar-header-name header)
+ tar-file-name-coding-system)))
+ (unless (< (length encoded-name) 99)
+ ;; FIXME: Implement it.
+ (error "Long file name support is not implemented"))
+ (insert encoded-name))
+ (tar--put-at tar-mode-offset (tar-header-mode header) "%6o\0 " #o777777)
+ (tar--put-at tar-uid-offset (tar-header-uid header) "%6o\0 " #o777777)
+ (tar--put-at tar-gid-offset (tar-header-gid header) "%6o\0 " #o777777)
+ (tar--put-at tar-size-offset (tar-header-size header) "%11o ")
+ (insert (tar--pad-to tar-time-offset)
+ (tar-octal-time (tar-header-date header))
+ " ")
+ ;; Omit tar-header-checksum (tar-chk-offset) for now.
+ (tar--put-at tar-linkp-offset (tar-header-link-type header))
+ (tar--put-at tar-link-offset (tar-header-link-name header))
+ (when (tar-header-magic header)
+ (tar--put-at tar-magic-offset (tar-header-magic header))
+ (tar--put-at tar-uname-offset (tar-header-uname header))
+ (tar--put-at tar-gname-offset (tar-header-gname header))
+ (tar--put-at tar-dmaj-offset (tar-header-dmaj header) "%7o\0" #o7777777)
+ (tar--put-at tar-dmin-offset (tar-header-dmin header) "%7o\0" #o7777777))
+ (tar--put-at 512 "")
+ (let ((ck (tar-header-block-checksum (buffer-string))))
+ (goto-char (+ (point-min) tar-chk-offset))
+ (delete-char 8)
+ (insert (format "%6o\0 " ck))
+ (when update-checksum
+ (setf (tar-header-checksum header) ck))
+ (tar-header-block-check-checksum (buffer-string)
+ (tar-header-checksum header)
+ (tar-header-name header)))
+ ;; .
+ (buffer-string)))
+
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
@@ -547,6 +618,7 @@ MODE should be an integer which is a file mode value."
(define-key map "p" 'tar-previous-line)
(define-key map "\^P" 'tar-previous-line)
(define-key map [up] 'tar-previous-line)
+ (define-key map "I" 'tar-new-entry)
(define-key map "R" 'tar-rename-entry)
(define-key map "u" 'tar-unflag)
(define-key map "v" 'tar-view)
@@ -731,10 +803,14 @@ tar-file's buffer."
(interactive "p")
(tar-next-line (- arg)))
+(defun tar-current-position ()
+ "Return the `tar-parse-info' index for the current line."
+ (count-lines (point-min) (line-beginning-position)))
+
(defun tar-current-descriptor (&optional noerror)
"Return the tar-descriptor of the current line, or signals an error."
;; I wish lines had plists, like in ZMACS...
- (or (nth (count-lines (point-min) (line-beginning-position))
+ (or (nth (tar-current-position)
tar-parse-info)
(if noerror
nil
@@ -800,8 +876,6 @@ tar-file's buffer."
tarname
")"))
(buffer (generate-new-buffer bufname)))
- (with-current-buffer buffer
- (setq buffer-undo-list t))
(with-current-buffer tar-data-buffer
(let (coding)
(narrow-to-region start end)
@@ -829,7 +903,11 @@ tar-file's buffer."
(with-current-buffer buffer
(set-buffer-multibyte nil)))
(widen)
- (decode-coding-region start end coding buffer)))
+ (with-current-buffer buffer
+ (setq buffer-undo-list t))
+ (decode-coding-region start end coding buffer)
+ (with-current-buffer buffer
+ (setq buffer-undo-list nil))))
buffer))
(defun tar-extract (&optional other-window-p)
@@ -869,7 +947,6 @@ tar-file's buffer."
(with-current-buffer tar-buffer
default-directory))
(set-buffer-modified-p nil)
- (setq buffer-undo-list t)
(normal-mode) ; pick a mode.
(set (make-local-variable 'tar-superior-buffer) tar-buffer)
(set (make-local-variable 'tar-superior-descriptor) descriptor)
@@ -947,6 +1024,37 @@ the current tar-entry."
(write-region start end to-file nil nil nil t)))
(message "Copied tar entry %s to %s" name to-file)))
+(defun tar-new-entry (filename &optional index)
+ "Insert a new empty regular file before point."
+ (interactive "*sFile name: ")
+ (let* ((buffer (current-buffer))
+ (index (or index (tar-current-position)))
+ (d-list (and (not (zerop index))
+ (nthcdr (+ -1 index) tar-parse-info)))
+ (pos (if d-list
+ (tar-header-data-end (car d-list))
+ (point-min)))
+ (new-descriptor
+ (tar-new-regular-file-header filename)))
+ ;; Update the data buffer; fill the missing descriptor fields.
+ (with-current-buffer tar-data-buffer
+ (goto-char pos)
+ (insert (tar-header-serialize new-descriptor t))
+ (setf (tar-header-data-start new-descriptor)
+ (copy-marker (point) nil)))
+ ;; Update tar-parse-info.
+ (if d-list
+ (setcdr d-list (cons new-descriptor (cdr d-list)))
+ (setq tar-parse-info (cons new-descriptor tar-parse-info)))
+ ;; Update the listing buffer.
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line index)
+ (let ((inhibit-read-only t))
+ (insert (tar-header-block-summarize new-descriptor) ?\n)))
+ ;; .
+ index))
+
(defun tar-flag-deleted (p &optional unflag)
"In Tar mode, mark this sub-file to be deleted from the tar file.
With a prefix argument, mark that many files."
diff --git a/lisp/tempo.el b/lisp/tempo.el
index 5ad62180a0a..93df15a8934 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -1,10 +1,10 @@
;;; tempo.el --- Flexible template insertion
-;; Copyright (C) 1994-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 2001-2015 Free Software Foundation, Inc.
-;; Author: David K}gedal <davidk@lysator.liu.se>
+;; Author: David Kågedal <davidk@lysator.liu.se>
;; Created: 16 Feb 1994
-;; K}gedal's last version number: 1.2.4
+;; Kågedal's last version number: 1.2.4
;; Keywords: extensions, languages, tools
;; This file is part of GNU Emacs.
@@ -270,7 +270,7 @@ The elements in ELEMENTS can be of several types:
- nil: It is ignored.
- Anything else: It is evaluated and the result is treated as an
element to be inserted. One additional tag is useful for these
- cases. If an expression returns a list '(l foo bar), the elements
+ cases. If an expression returns a list (l foo bar), the elements
after `l' will be inserted according to the usual rules. This makes
it possible to return several elements from one expression."
(let* ((template-name (intern (concat "tempo-template-"
@@ -611,11 +611,7 @@ function or string that is used by `\\[tempo-complete-tag]' to find a
string to match the tag against. It has the same definition as the
variable `tempo-match-finder'. In this version, supplying a
COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
- (let ((old (assq tag-list tempo-local-tags)))
- (if old
- (setcdr old completion-function)
- (setq tempo-local-tags (cons (cons tag-list completion-function)
- tempo-local-tags))))
+ (setf (alist-get tag-list tempo-local-tags) completion-function)
(if completion-function
(setq tempo-match-finder completion-function))
(tempo-invalidate-collection))
@@ -723,13 +719,13 @@ non-nil, a buffer containing possible completions is displayed."
(if tempo-leave-completion-buffer
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
- (all-completions string tag-list)
- string))
+ (completion-hilit-commonality (all-completions string tag-list)
+ (length string))))
(save-window-excursion
(with-output-to-temp-buffer "*Completions*"
(display-completion-list
- (all-completions string tag-list)
- string))
+ (completion-hilit-commonality (all-completions string tag-list)
+ (length string))))
(sit-for 32767))))
;;;
diff --git a/lisp/term.el b/lisp/term.el
index 31889a78273..41577c90301 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1,6 +1,6 @@
;;; term.el --- general command interpreter in a window stuff
-;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2013 Free Software
+;; Copyright (C) 1988, 1990, 1992, 1994-1995, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
@@ -165,15 +165,13 @@
;; full advantage of this package
;;
;; (add-hook 'term-mode-hook
-;; (function
-;; (lambda ()
-;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
-;; (make-local-variable 'mouse-yank-at-point)
-;; (make-local-variable 'transient-mark-mode)
-;; (setq mouse-yank-at-point t)
-;; (setq transient-mark-mode nil)
-;; (auto-fill-mode -1)
-;; (setq tab-width 8 ))))
+;; (function
+;; (lambda ()
+;; (setq term-prompt-regexp "^[^#$%>\n]*[#$%>] *")
+;; (setq-local mouse-yank-at-point t)
+;; (setq-local transient-mark-mode nil)
+;; (auto-fill-mode -1)
+;; (setq tab-width 8 ))))
;;
;;
;; ----------------------------------------
@@ -247,86 +245,48 @@
;; ----------------------------------------
;;
;; Notice: for directory/host/user tracking you need to have something
-;; like this in your shell startup script ( this is for tcsh but should
-;; be quite easy to port to other shells )
+;; like this in your shell startup script (this is for a POSIXish shell
+;; like Bash but should be quite easy to port to other shells)
;;
;; ----------------------------------------
;;
-;;
-;; set os = `uname`
-;; set host = `hostname`
-;; set date = `date`
+;; # Set HOSTNAME if not already set.
+;; : ${HOSTNAME=$(uname -n)}
;;
;; # su does not change this but I'd like it to
;;
-;; set user = `whoami`
+;; USER=$(whoami)
;;
;; # ...
;;
-;; if ( eterm =~ $TERM ) then
-;;
-;; echo --------------------------------------------------------------
-;; echo Hello $user
-;; echo Today is $date
-;; echo We are on $host running $os under Emacs term mode
-;; echo --------------------------------------------------------------
-;;
-;; setenv EDITOR emacsclient
-;;
-;; # Notice: $host and $user have been set before to 'hostname' and 'whoami'
-;; # this is necessary because, f.e., certain versions of 'su' do not change
-;; # $user, YMMV: if you don't want to fiddle with them define a couple
-;; # of new variables and use these instead.
-;; # NOTICE that there is a space between "AnSiT?" and $whatever NOTICE
-;;
-;; # These are because we want the real cwd in the messages, not the login
-;; # time one !
-;;
-;; set cwd_hack='$cwd'
-;; set host_hack='$host'
-;; set user_hack='$user'
-;;
-;; # Notice that the ^[ character is an ESC, not two chars. You can
-;; # get it in various ways, for example by typing
-;; # echo -e '\033' > escape.file
-;; # or by using your favorite editor
-;;
-;; foreach temp (cd pushd)
-;; alias $temp "$temp \!* ; echo 'AnSiTc' $cwd_hack"
-;; end
-;; alias popd 'popd ;echo "AnSiTc" $cwd'
+;; case $TERM in
+;; eterm*)
;;
-;; # Every command that can modify the user/host/directory should be aliased
-;; # as follows for the tracking mechanism to work.
+;; printf '%s\n' \
+;; -------------------------------------------------------------- \
+;; "Hello $user" \
+;; "Today is $(date)" \
+;; "We are on $HOSTNAME running $(uname) under Emacs term mode" \
+;; --------------------------------------------------------------
;;
-;; foreach temp ( rlogin telnet rsh sh ksh csh tcsh zsh bash tcl su )
-;; alias $temp "$temp \!* ; echo 'AnSiTh' $host_hack ; \
-;; echo 'AnSiTu' $user_hack ;echo 'AnSiTc' $cwd_hack"
-;; end
+;; export EDITOR=emacsclient
;;
-;; # Start up & use color ls
+;; # The \033 stands for ESC.
+;; # There is a space between "AnSiT?" and $whatever.
;;
-;; echo "AnSiTh" $host
-;; echo "AnSiTu" $user
-;; echo "AnSiTc" $cwd
+;; cd() { command cd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
+;; pushd() { command pushd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
+;; popd() { command popd "$@"; printf '\033AnSiTc %s\n' "$PWD"; }
;;
-;; # some housekeeping
+;; printf '\033AnSiTc %s\n' "$PWD"
+;; printf '\033AnSiTh %s\n' "$HOSTNAME"
+;; printf '\033AnSiTu %s\n' "$USER"
;;
-;; unset cwd_hack
-;; unset host_hack
-;; unset user_hack
-;; unset temp
-;;
-;; eval `/bin/dircolors /home/marco/.emacs_dircolors`
-;; endif
+;; eval $(dircolors $HOME/.emacs_dircolors)
+;; esac
;;
;; # ...
;;
-;; # Let's not clutter user space
-;;
-;; unset os
-;; unset date
-;;
;;
;;; Original Commentary:
@@ -974,9 +934,12 @@ is buffer-local."
(if (and (not (featurep 'xemacs))
(display-graphic-p)
overflow-newline-into-fringe
+ ;; Subtract 1 from the width when any fringe has zero width,
+ ;; not just the right fringe. Bug#18601.
+ (/= (frame-parameter nil 'left-fringe) 0)
(/= (frame-parameter nil 'right-fringe) 0))
- (window-width)
- (1- (window-width))))
+ (window-body-width)
+ (1- (window-body-width))))
(put 'term-mode 'mode-class 'special)
@@ -1144,7 +1107,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(make-local-variable 'term-scroll-show-maximum-output)
(make-local-variable 'term-ptyp)
(make-local-variable 'term-exec-hook)
- (make-local-variable 'term-vertical-motion)
+ (set (make-local-variable 'term-vertical-motion) 'vertical-motion)
(set (make-local-variable 'term-pending-delete-marker) (make-marker))
(make-local-variable 'term-current-face)
(term-ansi-reset)
@@ -1154,6 +1117,13 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(set (make-local-variable 'font-lock-defaults) '(nil t))
+ (add-function :filter-return
+ (local 'window-adjust-process-window-size-function)
+ (lambda (size)
+ (when size
+ (term-reset-size (cdr size) (car size)))
+ size))
+
(easy-menu-add term-terminal-menu)
(easy-menu-add term-signals-menu)
(or term-input-ring
@@ -1196,12 +1166,6 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(goto-char save-point)))
found))
-(defun term-check-size (process)
- (when (or (/= term-height (window-text-height))
- (/= term-width (term-window-width)))
- (term-reset-size (window-text-height) (term-window-width))
- (set-process-window-size process term-height term-width)))
-
(defun term-send-raw-string (chars)
(deactivate-mark)
(let ((proc (get-buffer-process (current-buffer))))
@@ -1251,17 +1215,7 @@ without any interpretation."
(run-hooks 'mouse-leave-buffer-hook)
(setq this-command 'yank)
(mouse-set-point click)
- (term-send-raw-string
- (or (cond ; From `mouse-yank-primary':
- ((eq system-type 'windows-nt)
- (or (x-get-selection 'PRIMARY)
- (x-get-selection-value)))
- ((fboundp 'x-get-selection-value)
- (or (x-get-selection-value)
- (x-get-selection 'PRIMARY)))
- (t
- (x-get-selection 'PRIMARY)))
- (error "No selection is available")))))
+ (term-send-raw-string (gui-get-primary-selection))))
(defun term-paste ()
"Insert the last stretch of killed text at point."
@@ -1513,11 +1467,6 @@ Using \"emacs\" loses, because bash disables editing if $TERM == emacs.")
(format "TERMINFO=%s" data-directory)
(format term-termcap-format "TERMCAP="
term-term-name term-height term-width)
- ;; We are going to get rid of the binding for EMACS,
- ;; probably in Emacs 23, because it breaks
- ;; `./configure' of some packages that expect it to
- ;; say where to find EMACS.
- (format "EMACS=%s (term:%s)" emacs-version term-protocol-version)
(format "INSIDE_EMACS=%s,term:%s" emacs-version term-protocol-version)
(format "LINES=%d" term-height)
(format "COLUMNS=%d" term-width))
@@ -1662,7 +1611,7 @@ See also `term-read-input-ring'."
(let ((ch (read-event)))
(if (eq ch ?\s)
(set-window-configuration conf)
- (setq unread-command-events (list ch)))))))
+ (push ch unread-command-events))))))
(defun term-regexp-arg (prompt)
@@ -1932,7 +1881,7 @@ A useful command to bind to SPC. See `term-replace-by-expanded-history'."
(defun term-within-quotes (beg end)
"Return t if the number of quotes between BEG and END is odd.
Quotes are single and double."
- (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
+ (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)'" beg end))
(countdq (term-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
(or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
@@ -2781,15 +2730,11 @@ See `term-prompt-regexp'."
(when (/= (point) (process-mark proc))
(setq save-point (point-marker)))
- ;; Note if the window size has changed. We used to reset
- ;; point too, but that gives incorrect results (Bug#4635).
- (if (eq (window-buffer) (current-buffer))
- (progn
- (setq term-vertical-motion (symbol-function 'vertical-motion))
- (term-check-size proc))
- (setq term-vertical-motion
- (symbol-function 'term-buffer-vertical-motion)))
- (setq save-marker (copy-marker (process-mark proc)))
+ (setf term-vertical-motion
+ (if (eq (window-buffer) (current-buffer))
+ 'vertical-motion
+ 'term-buffer-vertical-motion))
+ (setq save-marker (copy-marker (process-mark proc)))
(goto-char (process-mark proc))
(save-restriction
@@ -2937,8 +2882,10 @@ See `term-prompt-regexp'."
(let ((end (string-match "\r?$" str i)))
(if end
(funcall term-command-hook
- (prog1 (substring str (1+ i) end)
- (setq i (match-end 0))))
+ (decode-coding-string
+ (prog1 (substring str (1+ i) end)
+ (setq i (match-end 0)))
+ locale-coding-system))
(setq term-terminal-parameter (substring str i))
(setq term-terminal-state 4)
(setq i str-length))))
@@ -3089,9 +3036,7 @@ See `term-prompt-regexp'."
(eq (window-buffer selected) (current-buffer)))
(term-display-line (car term-pending-frame)
(cdr term-pending-frame))
- (setq term-pending-frame nil)
- ;; We have created a new window, so check the window size.
- (term-check-size proc))
+ (setq term-pending-frame nil))
;; Scroll each window displaying the buffer but (by default)
;; only if the point matches the process-mark we started with.
@@ -3631,7 +3576,7 @@ all pending output has been dealt with."))
(if (< down 0) term-scroll-start term-scroll-end))))
(when (or (and (< down 0) (< scroll-needed 0))
(and (> down 0) (> scroll-needed 0)))
- (let ((save-point (copy-marker (point))) (save-top))
+ (let ((save-point (point-marker)) (save-top))
(goto-char term-home-marker)
(cond (term-scroll-with-delete
(if (< down 0)
@@ -4136,15 +4081,18 @@ Typing SPC flushes the help buffer."
(and (consp first)
(eq (window-buffer (posn-window (event-start first)))
(get-buffer "*Completions*"))
- (eq (key-binding key) 'mouse-choose-completion)))
- ;; If the user does mouse-choose-completion with the mouse,
+ (memq (key-binding key)
+ '(mouse-choose-completion choose-completion))))
+ ;; If the user does choose-completion with the mouse,
;; execute the command, then delete the completion window.
(progn
(choose-completion first)
(set-window-configuration conf))
(if (eq first ?\s)
(set-window-configuration conf)
- (setq unread-command-events (listify-key-sequence key)))))))
+ (setq unread-command-events
+ (nconc (listify-key-sequence key)
+ unread-command-events)))))))
;; I need a make-term that doesn't surround with *s -mm
(defun term-ansi-make-term (name program &optional startfile &rest switches)
diff --git a/lisp/term/.gitignore b/lisp/term/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/term/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el
index 1a152fc8a48..84420a5da22 100644
--- a/lisp/term/AT386.el
+++ b/lisp/term/AT386.el
@@ -1,6 +1,6 @@
;;; AT386.el --- terminal support package for IBM AT keyboards
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Keywords: terminals
@@ -22,8 +22,6 @@
;;; Commentary:
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
;;; Code:
(defun terminal-init-AT386 ()
diff --git a/lisp/term/README b/lisp/term/README
index 91306a89753..d01f133e5fb 100644
--- a/lisp/term/README
+++ b/lisp/term/README
@@ -1,26 +1,28 @@
-Copyright (C) 1993, 2001-2013 Free Software Foundation, Inc.
+Copyright (C) 1993, 2001-2015 Free Software Foundation, Inc.
See the end of the file for license conditions.
This directory contains files of elisp that customize Emacs for certain
terminal types.
- When Emacs opens a new terminal, it checks the TERM environment variable to
-see what type of terminal the user is running on, searches for an elisp file
-named "term/${TERM}.el", and if one exists, loads it. If Emacs finds no
+ When Emacs opens a new terminal, it checks the TERM environment variable
+to see what type of terminal the user is running on. (If there is an entry
+for TERM in the 'term-file-aliases' variable, Emacs uses the associated value
+in place of TERM in the following.) Emacs searches for an elisp file named
+"term/${TERM}.el", and if one exists, loads it. If Emacs finds no
suitable file, then it strips the last hyphen and what follows it from TERM,
and tries again. If that still doesn't yield a file, then the previous hyphen
is stripped, and so on until all hyphens are gone. For example, if the
-terminal type is `aaa-48-foo', Emacs will try first `term/aaa-48-foo.el', then
-`term/aaa-48.el' and finally `term/aaa.el'. Emacs stops searching at the
+terminal type is 'aaa-48-foo', Emacs will try first 'term/aaa-48-foo.el', then
+'term/aaa-48.el' and finally 'term/aaa.el'. Emacs stops searching at the
first file found, and will not load more than one file for any terminal. Note
that it is not an error if Emacs is unable to find a terminal initialization
file; in that case, it will simply proceed with the next step without loading
any files.
Once the file has been loaded (or the search failed), Emacs tries to call a
-function named `terminal-init-TERMINALNAME' (eg `terminal-init-aaa-48' for the
-`aaa-48' terminal) in order to initialize the terminal. Once again, if the
+function named 'terminal-init-TERMINALNAME' (eg 'terminal-init-aaa-48' for the
+'aaa-48' terminal) in order to initialize the terminal. Once again, if the
function is not found, Emacs strips the last component of the name and tries
again using the shorter name. This search is independent of the previous file
search, so that you can have terminal initialization functions for a family of
@@ -38,7 +40,7 @@ declaration. Simply loading the file should not have any side effect.
given terminal, when the first frame is created on it. The function is not
called for subsequent frames on the same terminal. Therefore, terminal-init-*
functions should only modify terminal-local variables (such as
-`local-function-key-map') and terminal parameters. For example, it is not
+'local-function-key-map') and terminal parameters. For example, it is not
correct to modify frame parameters, since the modifications will only be
applied for the first frame opened on the terminal.
@@ -49,17 +51,17 @@ mind.
First, about keycap names. Your terminal package can create any keycap
cookies it likes, but there are good reasons to stick to the set recognized by
the X-windows code whenever possible. The key symbols recognized by Emacs
-are listed in src/term.c; look for the string `keys' in that file.
+are listed in src/term.c; look for the string 'keys' in that file.
For one thing, it means that you'll have the same Emacs key bindings on in
terminal mode as on an X console. If there are differences, you can bet
they'll frustrate you after you've forgotten about them.
- For another, the X keysms provide a standard set of names that Emacs knows
+ For another, the X keysyms provide a standard set of names that Emacs knows
about. It tries to bind many of them to useful things at startup, before your
.emacs is read (so you can override them). In some ways, the X keysym standard
is a admittedly poor one; it's incomplete, and not well matched to the set of
-`virtual keys' that UNIX terminfo(3) provides. But, trust us, the alternatives
+'virtual keys' that UNIX terminfo(3) provides. But, trust us, the alternatives
were worse.
This doesn't mean that if your terminal has a "Cokebottle" key you shouldn't
@@ -68,7 +70,7 @@ that set, try to pattern them on the standard terminfo variable names for
clarity; also, for a fighting chance that your binding may be useful to someone
else someday.
- For example, if your terminal has a `find' key, observe that terminfo
+ For example, if your terminal has a 'find' key, observe that terminfo
supports a key_find capability and call your cookie [find].
Here is a complete list, with corresponding X keysyms.
@@ -182,14 +184,14 @@ key_f36 FQ function key 36
key_f64 k1 function key 64
(1) The terminfo documentation says this may be the 'insert character' or
- `enter insert mode' key. Accordingly, key_ic is mapped to the `insertchar'
- keysym if there is also a key_dc key; otherwise it's mapped to `insert'.
- The presumption is that keyboards with `insert character' keys usually
- have `delete character' keys paired with them.
+ 'enter insert mode' key. Accordingly, key_ic is mapped to the 'insertchar'
+ keysym if there is also a key_dc key; otherwise it's mapped to 'insert'.
+ The presumption is that keyboards with 'insert character' keys usually
+ have 'delete character' keys paired with them.
(2) If there is no key_next key but there is a key_npage key, key_npage
- will be bound to the `next' keysym. If there is no key_previous key but
- there is a key_ppage key, key_ppage will be bound to the `previous' keysym.
+ will be bound to the 'next' keysym. If there is no key_previous key but
+ there is a key_ppage key, key_ppage will be bound to the 'previous' keysym.
(3) Sorry, these are not exact but they're the best we can do.
@@ -240,7 +242,7 @@ the setup code to bind anything else.
If your terminal's arrow key sequences are so funky that they conflict with
normal Emacs key bindings, the package should set up a function called
-(enable-foo-arrow-keys), where `foo' becomes the terminal name, and leave
+(enable-foo-arrow-keys), where 'foo' becomes the terminal name, and leave
it up to the user's .emacs file whether to call it.
Before writing a terminal-support package, it's a good idea to read the
diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el
deleted file mode 100644
index e4cabac3bf1..00000000000
--- a/lisp/term/apollo.el
+++ /dev/null
@@ -1,5 +0,0 @@
-(defun terminal-init-apollo ()
- "Terminal initialization function for apollo."
- (tty-run-terminal-initialization (selected-frame) "vt100"))
-
-;;; apollo.el ends here
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index aadab96f75a..98ad5acf268 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -1,8 +1,8 @@
;;; common-win.el --- common part of handling window systems
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: terminals
;; This file is part of GNU Emacs.
@@ -24,58 +24,6 @@
;;; Code:
-(defcustom x-select-enable-clipboard t
- "Non-nil means cutting and pasting uses the clipboard.
-This is in addition to, but in preference to, the primary selection.
-
-Note that MS-Windows does not support selection types other than the
-clipboard. (The primary selection that is set by Emacs is not
-accessible to other programs on MS-Windows.)
-
-This variable is not used by the Nextstep port."
- :type 'boolean
- :group 'killing
- ;; The GNU/Linux version changed in 24.1, the MS-Windows version did not.
- :version "24.1")
-
-(defvar x-last-selected-text) ; w32-fns.el
-(declare-function w32-set-clipboard-data "w32select.c"
- (string &optional ignored))
-(defvar ns-last-selected-text) ; ns-win.el
-(declare-function ns-set-pasteboard "ns-win" (string))
-
-(defun x-select-text (text)
- "Select TEXT, a string, according to the window system.
-
-On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
-clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
-the primary selection.
-
-On MS-Windows, make TEXT the current selection. If
-`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well.
-
-On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
-is not used)."
- (cond ((eq (framep (selected-frame)) 'w32)
- (if x-select-enable-clipboard
- (w32-set-clipboard-data text))
- (setq x-last-selected-text text))
- ((featurep 'ns)
- ;; Don't send the pasteboard too much text.
- ;; It becomes slow, and if really big it causes errors.
- (ns-set-pasteboard text)
- (setq ns-last-selected-text text))
- (t
- ;; With multi-tty, this function may be called from a tty frame.
- (when (eq (framep (selected-frame)) 'x)
- (when x-select-enable-primary
- (x-set-selection 'PRIMARY text)
- (setq x-last-selected-text-primary text))
- (when x-select-enable-clipboard
- (x-set-selection 'CLIPBOARD text)
- (setq x-last-selected-text-clipboard text))))))
-
;;;; Function keys
(defvar x-alternatives-map
@@ -108,9 +56,7 @@ is not used)."
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map))
(when (featurep 'ns)
- (setq interprogram-cut-function 'x-select-text
- interprogram-paste-function 'x-selection-value
- system-key-alist
+ (setq system-key-alist
(list
;; These are special "keys" used to pass events from C to lisp.
(cons (logior (lsh 0 16) 1) 'ns-power-off)
@@ -473,4 +419,6 @@ the operating system.")
(setq defined-colors (cons this-color defined-colors))))
defined-colors)))
+(provide 'term/common-win)
+
;;; common-win.el ends here
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index 43973604afc..71ce8d634be 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -1,6 +1,6 @@
;;; internal.el --- support for PC internal terminal
-;; Copyright (C) 1993-1994, 1998-1999, 2001-2013 Free Software
+;; Copyright (C) 1993-1994, 1998-1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index 46bcbf0a52f..986959c7fce 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -1,6 +1,6 @@
;;; iris-ansi.el --- configure Emacs for SGI xwsh and winterm apps
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
diff --git a/lisp/term/news.el b/lisp/term/news.el
index 09c8eef6f8a..4caac2a06c7 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -1,6 +1,6 @@
;;; news.el --- keypad and function key bindings for the Sony NEWS keyboard
-;; Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -22,8 +22,6 @@
;;; Commentary:
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
;;; Code:
(defun terminal-init-news ()
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index b92ca1244fb..0b3e3bd9d9c 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -1,6 +1,6 @@
;;; ns-win.el --- lisp side of interface with NeXT/Open/GNUstep/MacOS X window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2005-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2005-2015 Free Software Foundation, Inc.
;; Authors: Carl Edman
;; Christian Limpach
@@ -50,6 +50,7 @@
(require 'faces)
(require 'menu-bar)
(require 'fontset)
+(require 'dnd)
(defgroup ns nil
"GNUstep/Mac OS X specific features."
@@ -58,7 +59,8 @@
;;;; Command line argument handling.
(defvar x-invocation-args)
-(defvar ns-command-line-resources nil) ; FIXME unused?
+;; Set in term/common-win.el; currently unused by Nextstep's x-open-connection.
+(defvar x-command-line-resources)
;; nsterm.m.
(defvar ns-input-file)
@@ -104,7 +106,6 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-~] 'ns-prev-frame)
(define-key global-map [?\s--] 'center-line)
(define-key global-map [?\s-:] 'ispell)
-(define-key global-map [?\s-\;] 'ispell-next)
(define-key global-map [?\s-?] 'info)
(define-key global-map [?\s-^] 'kill-some-buffers)
(define-key global-map [?\s-&] 'kill-this-buffer)
@@ -161,10 +162,6 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [ns-power-off] 'save-buffers-kill-emacs)
(define-key global-map [ns-open-file] 'ns-find-file)
(define-key global-map [ns-open-temp-file] [ns-open-file])
-(define-key global-map [ns-drag-file] 'ns-find-file)
-(define-key global-map [ns-drag-color] 'ns-set-foreground-at-mouse)
-(define-key global-map [S-ns-drag-color] 'ns-set-background-at-mouse)
-(define-key global-map [ns-drag-text] 'ns-insert-text)
(define-key global-map [ns-change-font] 'ns-respond-to-change-font)
(define-key global-map [ns-open-file-line] 'ns-open-file-select-line)
(define-key global-map [ns-spi-service-call] 'ns-spi-service-call)
@@ -246,7 +243,7 @@ The properties returned may include `top', `left', `height', and `width'."
(insert ns-input-spi-arg))
((string-equal ns-input-spi-name "mail-to")
(compose-mail ns-input-spi-arg))
- (t (error (concat "Service " ns-input-spi-name " not recognized")))))
+ (t (error "Service %s not recognized" ns-input-spi-name))))
;; Composed key sequence handling for Nextstep system input methods.
@@ -366,14 +363,6 @@ See `ns-insert-working-text'."
;;;; Inter-app communications support.
-(defvar ns-input-text) ; nsterm.m
-
-(defun ns-insert-text ()
- "Insert contents of `ns-input-text' at point."
- (interactive)
- (insert ns-input-text)
- (setq ns-input-text nil))
-
(defun ns-insert-file ()
"Insert contents of file `ns-input-file' like insert-file but with less
prompting. If file is a directory perform a `find-file' on it."
@@ -519,6 +508,50 @@ unless the current buffer is a scratch buffer."
(ns-hide-emacs 'activate)
(find-file f)))))
+
+(defun ns-drag-n-drop (event &optional new-frame force-text)
+ "Edit the files listed in the drag-n-drop EVENT.
+Switch to a buffer editing the last file dropped."
+ (interactive "e")
+ (let* ((window (posn-window (event-start event)))
+ (arg (car (cdr (cdr event))))
+ (type (car arg))
+ (data (car (cdr arg)))
+ (url-or-string (cond ((eq type 'file)
+ (concat "file:" data))
+ (t data))))
+ (set-frame-selected-window nil window)
+ (when new-frame
+ (select-frame (make-frame)))
+ (raise-frame)
+ (setq window (selected-window))
+ (if force-text
+ (dnd-insert-text window 'private data)
+ (dnd-handle-one-url window 'private url-or-string))))
+
+
+(defun ns-drag-n-drop-other-frame (event)
+ "Edit the files listed in the drag-n-drop EVENT, in other frames.
+May create new frames, or reuse existing ones. The frame editing
+the last file dropped is selected."
+ (interactive "e")
+ (ns-drag-n-drop event t))
+
+(defun ns-drag-n-drop-as-text (event)
+ "Drop the data in EVENT as text."
+ (interactive "e")
+ (ns-drag-n-drop event nil t))
+
+(defun ns-drag-n-drop-as-text-other-frame (event)
+ "Drop the data in EVENT as text in a new frame."
+ (interactive "e")
+ (ns-drag-n-drop event t t))
+
+(global-set-key [drag-n-drop] 'ns-drag-n-drop)
+(global-set-key [C-drag-n-drop] 'ns-drag-n-drop-other-frame)
+(global-set-key [M-drag-n-drop] 'ns-drag-n-drop-as-text)
+(global-set-key [C-M-drag-n-drop] 'ns-drag-n-drop-as-text-other-frame)
+
;;;; Frame-related functions.
;; nsterm.m
@@ -557,29 +590,9 @@ unless the current buffer is a scratch buffer."
(interactive)
(other-frame -1))
-;; If no position specified, make new frame offset by 25 from current.
-;; You'd think this was a window manager's job, but apparently without
-;; this, new frames open exactly on top of old ones (?).
-;; http://lists.gnu.org/archive/html/emacs-devel/2010-10/msg00988.html
-;; Note that AFAICS it is not documented that functions on
-;; before-make-frame-hook can access PARAMETERS.
-(defvar parameters) ; dynamically bound in make-frame
-(add-hook 'before-make-frame-hook
- (lambda ()
- (let ((left (cdr (assq 'left (frame-parameters))))
- (top (cdr (assq 'top (frame-parameters)))))
- (if (consp left) (setq left (cadr left)))
- (if (consp top) (setq top (cadr top)))
- (cond
- ((or (assq 'top parameters) (assq 'left parameters)))
- ((or (not left) (not top)))
- (t
- (setq parameters (cons (cons 'left (+ left 25))
- (cons (cons 'top (+ top 25))
- parameters))))))))
-
-;; frame will be focused anyway, so select it
+;; Frame will be focused anyway, so select it
;; (if this is not done, mode line is dimmed until first interaction)
+;; FIXME: Sounds like we're working around a bug in the underlying code.
(add-hook 'after-make-frame-functions 'select-frame)
(defvar tool-bar-mode)
@@ -614,7 +627,7 @@ unless the current buffer is a scratch buffer."
`(mouse-1 POSITION 1))))
(if (y-or-n-p (format "Print buffer %s? " (buffer-name)))
(print-buffer)
- (error "Cancelled")))
+ (error "Canceled")))
(print-buffer)))
;;;; Font support.
@@ -704,56 +717,18 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;;;; Pasteboard support.
-(declare-function ns-get-selection-internal "nsselect.m" (buffer))
-(declare-function ns-store-selection-internal "nsselect.m" (buffer string))
-
-(define-obsolete-function-alias 'ns-get-cut-buffer-internal
- 'ns-get-selection-internal "24.1")
(define-obsolete-function-alias 'ns-store-cut-buffer-internal
- 'ns-store-selection-internal "24.1")
-
-
-(defun ns-get-pasteboard ()
- "Returns the value of the pasteboard."
- (ns-get-selection-internal 'CLIPBOARD))
-
-(defun ns-set-pasteboard (string)
- "Store STRING into the pasteboard of the Nextstep display server."
- ;; Check the data type of STRING.
- (if (not (stringp string)) (error "Nonstring given to pasteboard"))
- (ns-store-selection-internal 'CLIPBOARD string))
-
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from x-selection-value.
-(defvar ns-last-selected-text nil)
-
-;; Return the value of the current Nextstep selection. For
-;; compatibility with older Nextstep applications, this checks cut
-;; buffer 0 before retrieving the value of the primary selection.
-(defun x-selection-value ()
- (let (text)
- ;; Consult the selection. Treat empty strings as if they were unset.
- (or text (setq text (ns-get-pasteboard)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text ns-last-selected-text) nil)
- ((string= text ns-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the `eq' test.
- (setq ns-last-selected-text text)
- nil)
- (t
- (setq ns-last-selected-text text)))))
+ 'gui-set-selection "24.1")
+
(defun ns-copy-including-secondary ()
(interactive)
(call-interactively 'kill-ring-save)
- (ns-store-selection-internal 'SECONDARY
- (buffer-substring (point) (mark t))))
+ (gui-set-selection 'SECONDARY (buffer-substring (point) (mark t))))
+
(defun ns-paste-secondary ()
(interactive)
- (insert (ns-get-selection-internal 'SECONDARY)))
+ (insert (gui-get-selection 'SECONDARY)))
;;;; Scrollbar handling.
@@ -851,39 +826,11 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(t
nil))))
-(defvar ns-input-color) ; nsterm.m
-
-(defun ns-set-foreground-at-mouse ()
- "Set the foreground color at the mouse location to `ns-input-color'."
- (interactive)
- (let* ((pos (mouse-position))
- (frame (car pos))
- (face (ns-face-at-pos pos)))
- (cond
- ((eq face 'cursor)
- (modify-frame-parameters frame (list (cons 'cursor-color
- ns-input-color))))
- ((not face)
- (modify-frame-parameters frame (list (cons 'foreground-color
- ns-input-color))))
- (t
- (set-face-foreground face ns-input-color frame)))))
+(defun ns-suspend-error ()
+ ;; Don't allow suspending if any of the frames are NS frames.
+ (if (memq 'ns (mapcar 'window-system (frame-list)))
+ (error "Cannot suspend Emacs while running under NS")))
-(defun ns-set-background-at-mouse ()
- "Set the background color at the mouse location to `ns-input-color'."
- (interactive)
- (let* ((pos (mouse-position))
- (frame (car pos))
- (face (ns-face-at-pos pos)))
- (cond
- ((eq face 'cursor)
- (modify-frame-parameters frame (list (cons 'cursor-color
- ns-input-color))))
- ((not face)
- (modify-frame-parameters frame (list (cons 'background-color
- ns-input-color))))
- (t
- (set-face-background face ns-input-color frame)))))
;; Set some options to be as Nextstep-like as possible.
(setq frame-title-format t
@@ -893,6 +840,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defvar ns-initialized nil
"Non-nil if Nextstep windowing has been initialized.")
+(declare-function x-handle-args "common-win" (args))
(declare-function ns-list-services "nsfns.m" ())
(declare-function x-open-connection "nsfns.m"
(display &optional xrm-string must-succeed))
@@ -900,7 +848,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Do the actual Nextstep Windows setup here; the above code just
;; defines functions and variables that we use now.
-(defun ns-initialize-window-system (&optional _display)
+(cl-defmethod window-system-initialization (&context (window-system ns)
+ &optional _display)
"Initialize Emacs for Nextstep (Cocoa / GNUstep) windowing."
(cl-assert (not ns-initialized))
@@ -917,7 +866,26 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(format "Creation of the standard fontset failed: %s" err)
:error)))
- (x-open-connection (system-name) nil t)
+ (x-open-connection (system-name) x-command-line-resources t)
+
+ ;; Add GNUstep menu items Services, Hide and Quit. Rename Help to Info
+ ;; and put it first (i.e. omit from menu-bar-final-items.
+ (if (featurep 'gnustep)
+ (progn
+ (setq menu-bar-final-items '(buffer services hide-app quit))
+
+ ;; If running under GNUstep, "Help" is moved and renamed "Info".
+ (bindings--define-key global-map [menu-bar help-menu]
+ (cons "Info" menu-bar-help-menu))
+ (bindings--define-key global-map [menu-bar quit]
+ '(menu-item "Quit" save-buffers-kill-emacs
+ :help "Save unsaved buffers, then exit"))
+ (bindings--define-key global-map [menu-bar hide-app]
+ '(menu-item "Hide" ns-do-hide-emacs
+ :help "Hide Emacs"))
+ (bindings--define-key global-map [menu-bar services]
+ (cons "Services" (make-sparse-keymap "Services")))))
+
(dolist (service (ns-list-services))
(if (eq (car service) 'undefined)
@@ -932,20 +900,56 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; FIXME: This will surely lead to "MODIFIED OUTSIDE CUSTOM" warnings.
(menu-bar-mode (if (get-lisp-resource nil "Menus") 1 -1))
+ ;; For Darwin nothing except UTF-8 makes sense.
+ (when (eq system-type 'darwin)
+ (add-hook 'before-init-hook
+ #'(lambda ()
+ (setq locale-coding-system 'utf-8-unix)
+ (setq default-process-coding-system
+ '(utf-8-unix . utf-8-unix)))))
+
;; OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
(x-apply-session-resources)
+
+ ;; Don't let Emacs suspend under NS.
+ (add-hook 'suspend-hook 'ns-suspend-error)
+
(setq ns-initialized t))
;; Any display name is OK.
(add-to-list 'display-format-alist '(".*" . ns))
-(add-to-list 'handle-args-function-alist '(ns . x-handle-args))
-(add-to-list 'frame-creation-function-alist '(ns . x-create-frame-with-faces))
-(add-to-list 'window-system-initialization-alist '(ns . ns-initialize-window-system))
-
+(cl-defmethod handle-args-function (args &context (window-system ns))
+ (x-handle-args args))
+
+(cl-defmethod frame-creation-function (params &context (window-system ns))
+ (x-create-frame-with-faces params))
+
+(declare-function ns-own-selection-internal "nsselect.m" (selection value))
+(declare-function ns-disown-selection-internal "nsselect.m" (selection))
+(declare-function ns-selection-owner-p "nsselect.m" (&optional selection))
+(declare-function ns-selection-exists-p "nsselect.m" (&optional selection))
+(declare-function ns-get-selection "nsselect.m" (selection-symbol target-type))
+
+(cl-defmethod gui-backend-set-selection (selection value
+ &context (window-system ns))
+ (if value (ns-own-selection-internal selection value)
+ (ns-disown-selection-internal selection)))
+
+(cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system ns))
+ (ns-selection-owner-p selection))
+
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system ns))
+ (ns-selection-exists-p selection))
+
+(cl-defmethod gui-backend-get-selection (selection-symbol target-type
+ &context (window-system ns))
+ (ns-get-selection selection-symbol target-type))
(provide 'ns-win)
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index 96831cea9a6..d2afaba9b96 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -1,10 +1,10 @@
-;;; pc-win.el --- setup support for `PC windows' (whatever that is)
+;;; pc-win.el --- setup support for `PC windows' (whatever that is) -*- lexical-binding:t -*-
-;; Copyright (C) 1994, 1996-1997, 1999, 2001-2013 Free Software
+;; Copyright (C) 1994, 1996-1997, 1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -45,20 +45,20 @@
(declare-function w16-get-clipboard-data "w16select.c")
(declare-function msdos-setup-keyboard "internal" (frame))
-;;; This was copied from etc/rgb.txt, except that some values were changed
-;;; a bit to make them consistent with DOS console colors, and the RGB
-;;; values were scaled up to 16 bits, as `tty-define-color' requires.
+;; This was copied from etc/rgb.txt, except that some values were changed
+;; a bit to make them consistent with DOS console colors, and the RGB
+;; values were scaled up to 16 bits, as `tty-define-color' requires.
;;;
-;;; The mapping between the 16 standard EGA/VGA colors and X color names
-;;; was done by running a Unix version of Emacs inside an X client and a
-;;; DJGPP-compiled Emacs on the same PC. The names of X colors used to
-;;; define the pixel values are shown as comments to each color below.
+;; The mapping between the 16 standard EGA/VGA colors and X color names
+;; was done by running a Unix version of Emacs inside an X client and a
+;; DJGPP-compiled Emacs on the same PC. The names of X colors used to
+;; define the pixel values are shown as comments to each color below.
;;;
-;;; If you want to change the RGB values, keep in mind that various pieces
-;;; of Emacs think that a color whose RGB values add up to less than 0.6 of
-;;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the
-;;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for
-;;; an example.
+;; If you want to change the RGB values, keep in mind that various pieces
+;; of Emacs think that a color whose RGB values add up to less than 0.6 of
+;; the values for WHITE (i.e. less than 117963) are ``dark'', otherwise the
+;; color is ``light''; see `frame-set-background-mode' in lisp/faces.el for
+;; an example.
(defvar msdos-color-values
'(("black" 0 0 0 0)
("blue" 1 0 0 52480) ; MediumBlue
@@ -165,6 +165,27 @@ created."
;; From src/xfns.c
(defun x-list-fonts (_pattern &optional _face _frame _maximum width)
+ "Return a list of the names of available fonts matching PATTERN.
+If optional arguments FACE and FRAME are specified, return only fonts
+the same size as FACE on FRAME.
+
+PATTERN should be a string containing a font name in the XLFD,
+Fontconfig, or GTK format. A font name given in the XLFD format may
+contain wildcard characters:
+ the * character matches any substring, and
+ the ? character matches any single character.
+ PATTERN is case-insensitive.
+
+The return value is a list of strings, suitable as arguments to
+`set-face-font'.
+
+Fonts Emacs can't use may or may not be excluded
+even if they match PATTERN and FACE.
+The optional fourth argument MAXIMUM sets a limit on how many
+fonts to match. The first MAXIMUM fonts are reported.
+The optional fifth argument WIDTH, if specified, is a number of columns
+occupied by a character of a font. In that case, return only fonts
+the WIDTH times as wide as FACE on FRAME."
(if (or (null width) (and (numberp width) (= width 1)))
(list "ms-dos")
(list "no-such-font")))
@@ -197,148 +218,55 @@ the operating system.")
;; From lisp/term/w32-win.el
;
;;;; Selections
-;
-;;; We keep track of the last text selected here, so we can check the
-;;; current selection against it, and avoid passing back our own text
-;;; from x-selection-value.
-(defvar x-last-selected-text nil)
-
-(defcustom x-select-enable-clipboard t
- "Non-nil means cutting and pasting uses the clipboard.
-This is in addition to, but in preference to, the primary selection.
-
-Note that MS-Windows does not support selection types other than the
-clipboard. (The primary selection that is set by Emacs is not
-accessible to other programs on MS-Windows.)
-
-This variable is not used by the Nextstep port."
- :type 'boolean
- :group 'killing)
-
-(defun x-select-text (text)
- "Select TEXT, a string, according to the window system.
-
-On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
-clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
-the primary selection.
-
-On MS-Windows, make TEXT the current selection. If
-`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well.
-
-On Nextstep, put TEXT in the pasteboard (`x-select-enable-clipboard'
-is not used)."
- (if x-select-enable-clipboard
- (w16-set-clipboard-data text))
- (setq x-last-selected-text text))
-
-;;; Return the value of the current selection.
-;;; Consult the selection. Treat empty strings as if they were unset.
-(defun x-get-selection-value ()
- (if x-select-enable-clipboard
- (let (text)
- ;; Don't die if x-get-selection signals an error.
- (condition-case c
- (setq text (w16-get-clipboard-data))
- (error (message "w16-get-clipboard-data:%s" c)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text x-last-selected-text) nil)
- ((string= text x-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the 'eq' test.
- (setq x-last-selected-text text)
- nil)
- (t
- (setq x-last-selected-text text))))))
-
-;; x-selection-owner-p is used in simple.el.
-(defun x-selection-owner-p (&optional _selection _terminal)
- "Whether the current Emacs process owns the given X Selection.
-The arg should be the name of the selection in question, typically one of
-the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-For convenience, the symbol nil is the same as `PRIMARY',
-and t is the same as `SECONDARY'.
-
-TERMINAL should be a terminal object or a frame specifying the X
-server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display.
-
-On Nextstep, TERMINAL is unused.
-
-\(fn &optional SELECTION TERMINAL)"
- (if x-select-enable-clipboard
- (let (text)
- ;; Don't die if w16-get-clipboard-data signals an error.
- (ignore-errors
- (setq text (w16-get-clipboard-data)))
- ;; We consider ourselves the owner of the selection if it does
- ;; not exist, or exists and compares equal with the last text
- ;; we've put into the Windows clipboard.
- (cond
- ((not text) t)
- ((or (eq text x-last-selected-text)
- (string= text x-last-selected-text))
- text)
- (t nil)))))
-
-;; x-own-selection-internal and x-disown-selection-internal are used
-;; in select.el:x-set-selection.
-(defun x-own-selection-internal (_selection value &optional _frame)
- "Assert an X selection of the type SELECTION with and value VALUE.
-SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-VALUE is typically a string, or a cons of two markers, but may be
-anything that the functions on `selection-converter-alist' know about.
-
-FRAME should be a frame that should own the selection. If omitted or
-nil, it defaults to the selected frame.
-
-On Nextstep, FRAME is unused.
-
-\(fn SELECTION VALUE &optional FRAME)"
- (ignore-errors
- (x-select-text value))
- value)
-
-(defun x-disown-selection-internal (selection &optional _time-object _terminal)
- "If we own the selection SELECTION, disown it.
-Disowning it means there is no such selection.
-
-Sets the last-change time for the selection to TIME-OBJECT (by default
-the time of the last event).
-
-TERMINAL should be a terminal object or a frame specifying the X
-server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display.
-
-On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
-On MS-DOS, all this does is return non-nil if we own the selection.
-
-\(fn SELECTION &optional TIME-OBJECT TERMINAL)"
- (if (x-selection-owner-p selection)
- t))
-
-;; x-get-selection-internal is used in select.el
-(defun x-get-selection-internal (_selection-symbol _target-type
- &optional _time-stamp _terminal)
- "Return text selected from some X window.
-SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
-\(Those are literal upper-case symbol names, since that's what X expects.)
-TARGET-TYPE is the type of data desired, typically `STRING'.
-
-TIME-STAMP is the time to use in the XConvertSelection call for foreign
-selections. If omitted, defaults to the time for the last event.
-
-TERMINAL should be a terminal object or a frame specifying the X
-server to query. If omitted or nil, that stands for the selected
-frame's display, or the first available X display.
-
-On Nextstep, TIME-STAMP and TERMINAL are unused.
-
-\(fn SELECTION-SYMBOL TARGET-TYPE &optional TIME-STAMP TERMINAL)"
- (x-get-selection-value))
+
+;; gui-get-selection is used in select.el
+(cl-defmethod gui-backend-get-selection (_selection-symbol _target-type
+ &context (window-system pc))
+ "Return the value of the current selection.
+Consult the selection. Treat empty strings as if they were unset."
+ ;; Don't die if x-get-selection signals an error.
+ (with-demoted-errors "w16-get-clipboard-data:%s"
+ (w16-get-clipboard-data)))
+
+(declare-function w16-selection-exists-p "w16select.c")
+;; gui-selection-owner-p is used in simple.el.
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system pc))
+ (w16-selection-exists-p selection))
+
+(cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system pc))
+ (w16-selection-owner-p selection))
+
+(defun w16-selection-owner-p (_selection)
+ ;; FIXME: Other systems don't obey select-enable-clipboard here.
+ (if select-enable-clipboard
+ (let ((text
+ ;; Don't die if w16-get-clipboard-data signals an error.
+ (with-demoted-errors "w16-get-clipboard-data: %S"
+ (w16-get-clipboard-data))))
+ ;; We consider ourselves the owner of the selection
+ ;; if it does not exist, or exists and compares
+ ;; equal with the last text we've put into the
+ ;; Windows clipboard.
+ (cond
+ ((not text) t)
+ ((equal text gui--last-selected-text-clipboard) text)
+ (t nil)))))
+
+;; gui-set-selection is used in gui-set-selection.
+(declare-function w16-set-clipboard-data "w16select.c"
+ (string &optional ignored))
+(cl-defmethod gui-backend-set-selection (selection value
+ &context (window-system pc))
+ (if (not value)
+ (if (w16-selection-owner-p selection)
+ t)
+ ;; FIXME: Other systems don't obey
+ ;; gui-select-enable-clipboard here.
+ (with-demoted-errors "w16-set-clipboard-data: %S"
+ (w16-set-clipboard-data value))
+ value))
;; From src/fontset.c:
(fset 'query-fontset 'ignore)
@@ -386,15 +314,15 @@ This is used by `msdos-show-help'.")
;; Initialization.
;; ---------------------------------------------------------------------------
-;; This function is run, by faces.el:tty-create-frame-with-faces, only
-;; for the initial frame (on each terminal, but we have only one).
+;; This function is run, by the tty method of `frame-creation-function'
+;; (in faces.el), only for the initial frame (on each terminal, but we have
+;; only one).
;; This works by setting the `terminal-initted' terminal parameter to
-;; this function, the first time `tty-create-frame-with-faces' is
-;; called on that terminal. `tty-create-frame-with-faces' is called
-;; directly from startup.el and also by `make-frame' through
-;; `frame-creation-function-alist'. `make-frame' will call this
-;; function if `msdos-create-frame-with-faces' (see below) is not
-;; found in `frame-creation-function-alist', which means something is
+;; this function, the first time `frame-creation-function' is
+;; called on that terminal. `frame-creation-function' is called
+;; directly from startup.el and also by `make-frame'.
+;; `make-frame' should call our own `frame-creation-function' method instead
+;; (see below) so if terminal-init-internal is called it means something is
;; _very_ wrong, because "internal" terminal emulator should not be
;; turned on if our window-system is not `pc'. Therefore, the only
;; Right Thing for us to do here is scream bloody murder.
@@ -404,7 +332,9 @@ Errors out because it is not supposed to be called, ever."
(error "terminal-init-internal called for window-system `%s'"
(window-system)))
-(defun msdos-initialize-window-system (&optional _display)
+;; window-system-initialization is called by startup.el:command-line.
+(cl-defmethod window-system-initialization (&context (window-system pc)
+ &optional _display)
"Initialization function for the `pc' \"window system\"."
(or (eq (window-system) 'pc)
(error
@@ -443,20 +373,17 @@ Errors out because it is not supposed to be called, ever."
(setq split-window-keep-point t)
;; Arrange for the kill and yank functions to set and check the
;; clipboard.
- (setq interprogram-cut-function 'x-select-text)
- (setq interprogram-paste-function 'x-get-selection-value)
(menu-bar-enable-clipboard)
(run-hooks 'terminal-init-msdos-hook))
-;; frame-creation-function-alist is examined by frame.el:make-frame.
-(add-to-list 'frame-creation-function-alist
- '(pc . msdos-create-frame-with-faces))
-;; window-system-initialization-alist is examined by startup.el:command-line.
-(add-to-list 'window-system-initialization-alist
- '(pc . msdos-initialize-window-system))
+;; frame-creation-function is called by frame.el:make-frame.
+(cl-defmethod frame-creation-function (params &context (window-system pc))
+ (msdos-create-frame-with-faces params))
+
;; We don't need anything beyond tty-handle-args for handling
;; command-line argument; see startup.el.
-(add-to-list 'handle-args-function-alist '(pc . tty-handle-args))
+(cl-defmethod handle-args-function (args &context (window-system pc))
+ (tty-handle-args args))
;; ---------------------------------------------------------------------------
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index 0e026a8e4be..c2055088fb5 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -1,6 +1,6 @@
;;; rxvt.el --- define function key sequences and standard colors for rxvt
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
;; Keywords: terminals
@@ -24,36 +24,21 @@
;;; Code:
+(require 'term/xterm)
+
(defvar rxvt-function-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map xterm-rxvt-function-map)
;; Set up input-decode-map entries that termcap and terminfo don't know.
- (define-key map "\e[A" [up])
- (define-key map "\e[B" [down])
- (define-key map "\e[C" [right])
- (define-key map "\e[D" [left])
- (define-key map "\e[2~" [insert])
- (define-key map "\e[3~" [delete])
- (define-key map "\e[4~" [select])
- (define-key map "\e[5~" [prior])
- (define-key map "\e[6~" [next])
(define-key map "\e[7~" [home])
(define-key map "\e[8~" [end])
- (define-key map "\e[11~" [f1])
- (define-key map "\e[12~" [f2])
- (define-key map "\e[13~" [f3])
- (define-key map "\e[14~" [f4])
- (define-key map "\e[15~" [f5])
- (define-key map "\e[17~" [f6])
- (define-key map "\e[18~" [f7])
- (define-key map "\e[19~" [f8])
- (define-key map "\e[20~" [f9])
- (define-key map "\e[21~" [f10])
;; The strings emitted by f11 and f12 are the same as the strings
;; emitted by S-f1 and S-f2, so don't define f11 and f12.
;; (define-key rxvt-function-map "\e[23~" [f11])
;; (define-key rxvt-function-map "\e[24~" [f12])
- (define-key map "\e[29~" [print])
+ (define-key map "\e[23~" [S-f1])
+ (define-key map "\e[24~" [S-f2])
(define-key map "\e[11^" [C-f1])
(define-key map "\e[12^" [C-f2])
@@ -66,8 +51,6 @@
(define-key map "\e[20^" [C-f9])
(define-key map "\e[21^" [C-f10])
- (define-key map "\e[23~" [S-f1])
- (define-key map "\e[24~" [S-f2])
(define-key map "\e[25~" [S-f3])
(define-key map "\e[26~" [S-f4])
(define-key map "\e[28~" [S-f5])
@@ -99,7 +82,6 @@
(define-key map "\eOa" [C-up])
(define-key map "\eOb" [C-down])
- (define-key map "\e[2;2~" [S-insert])
(define-key map "\e[3$" [S-delete])
(define-key map "\e[5$" [S-prior])
(define-key map "\e[6$" [S-next])
@@ -157,26 +139,6 @@
map)
"Keymap of possible alternative meanings for some keys.")
-(defun terminal-init-rxvt ()
- "Terminal initialization function for rxvt."
-
- (let ((map (copy-keymap rxvt-alternatives-map)))
- (set-keymap-parent map (keymap-parent local-function-key-map))
- (set-keymap-parent local-function-key-map map))
-
- ;; Use inheritance to let the main keymap override those defaults.
- ;; This way we don't override terminfo-derived settings or settings
- ;; made in the init file.
- (let ((m (copy-keymap rxvt-function-map)))
- (set-keymap-parent m (keymap-parent input-decode-map))
- (set-keymap-parent input-decode-map m))
-
- ;; Initialize colors and background mode.
- (rxvt-register-default-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))
-
;; Set up colors, for those versions of rxvt that support it.
(defvar rxvt-standard-colors
;; The names of the colors in the comments taken from the rxvt.1 man
@@ -199,93 +161,17 @@
("brightwhite" 15 (255 255 255))) ; white
"Names of 16 standard rxvt colors, their numbers, and RGB values.")
-(defun rxvt-rgb-convert-to-16bit (prim)
- "Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
- (min 65535 (round (* (/ prim 255.0) 65535.0))))
-
-(defun rxvt-register-default-colors ()
- "Register the default set of colors for rxvt or compatible emulator.
+(defun terminal-init-rxvt ()
+ "Terminal initialization function for rxvt."
-This function registers the number of colors returned by `display-color-cells'
-for the currently selected frame."
- (let* ((ncolors (display-color-cells))
- (colors rxvt-standard-colors)
- (color (car colors)))
- (if (> ncolors 0)
- ;; Clear the 8 default tty colors registered by startup.el
- (tty-color-clear))
- ;; Only register as many colors as are supported by the display.
- (while (and (> ncolors 0) colors)
- (tty-color-define (car color) (cadr color)
- (mapcar 'rxvt-rgb-convert-to-16bit
- (car (cddr color))))
- (setq colors (cdr colors)
- color (car colors)
- ncolors (1- ncolors)))
- (when (> ncolors 0)
- (cond
- ((= ncolors 240) ; 256-color rxvt
- ;; 216 non-gray colors first
- (let ((r 0) (g 0) (b 0))
- (while (> ncolors 24)
- ;; This and other formulas taken from 256colres.pl and
- ;; 88colres.pl in the xterm distribution.
- (tty-color-define (format "color-%d" (- 256 ncolors))
- (- 256 ncolors)
- (mapcar 'rxvt-rgb-convert-to-16bit
- (list (round (* r 42.5))
- (round (* g 42.5))
- (round (* b 42.5)))))
- (setq b (1+ b))
- (if (> b 5)
- (setq g (1+ g)
- b 0))
- (if (> g 5)
- (setq r (1+ r)
- g 0))
- (setq ncolors (1- ncolors))))
- ;; Now the 24 gray colors
- (while (> ncolors 0)
- (setq color (rxvt-rgb-convert-to-16bit (+ 8 (* (- 24 ncolors) 10))))
- (tty-color-define (format "color-%d" (- 256 ncolors))
- (- 256 ncolors)
- (list color color color))
- (setq ncolors (1- ncolors))))
+ (xterm--push-map rxvt-alternatives-map local-function-key-map)
+ (xterm--push-map rxvt-function-map input-decode-map)
- ((= ncolors 72) ; rxvt-unicode
- ;; 64 non-gray colors
- (let ((levels '(0 139 205 255))
- (r 0) (g 0) (b 0))
- (while (> ncolors 8)
- (tty-color-define (format "color-%d" (- 88 ncolors))
- (- 88 ncolors)
- (mapcar 'rxvt-rgb-convert-to-16bit
- (list (nth r levels)
- (nth g levels)
- (nth b levels))))
- (setq b (1+ b))
- (if (> b 3)
- (setq g (1+ g)
- b 0))
- (if (> g 3)
- (setq r (1+ r)
- g 0))
- (setq ncolors (1- ncolors))))
- ;; Now the 8 gray colors
- (while (> ncolors 0)
- (setq color (rxvt-rgb-convert-to-16bit
- (floor
- (if (= ncolors 8)
- 46.36363636
- (+ (* (- 8 ncolors) 23.18181818) 69.54545454)))))
- (tty-color-define (format "color-%d" (- 88 ncolors))
- (- 88 ncolors)
- (list color color color))
- (setq ncolors (1- ncolors))))
- (t (error "Unsupported number of rxvt colors (%d)" (+ 16 ncolors)))))
- ;; Modifying color mappings means realized faces don't use the
- ;; right colors, so clear them.
- (clear-face-cache)))
+ ;; Initialize colors and background mode.
+ (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))
;; 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/screen.el b/lisp/term/screen.el
index d37a695086a..41fd916a785 100644
--- a/lisp/term/screen.el
+++ b/lisp/term/screen.el
@@ -1,12 +1,22 @@
-;; Treat a screen terminal similar to an xterm.
-(load "term/xterm")
+;;; screen.el --- terminal initialization for screen and tmux -*- lexical-binding: t -*-
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
-(declare-function xterm-register-default-colors "xterm" ())
+(require 'term/xterm)
+
+(defcustom xterm-screen-extra-capabilities '(modifyOtherKeys)
+ "Extra capabilities supported under \"screen\".
+Some features of screen depend on the terminal emulator in which
+it runs, which can change when the screen session is moved to another tty."
+ :type xterm--extra-capabilities-type
+ :group 'xterm)
(defun terminal-init-screen ()
"Terminal initialization function for screen."
- ;; Use the xterm color initialization code.
- (xterm-register-default-colors)
- (tty-set-up-initial-frame-faces))
+ ;; Treat a screen terminal similar to an xterm, but don't use
+ ;; xterm-extra-capabilities's `check' setting since that doesn't seem
+ ;; to work so well (it depends too much on the surrounding terminal
+ ;; emulator, which can change during the session, bug#20356).
+ (let ((xterm-extra-capabilities xterm-screen-extra-capabilities))
+ (tty-run-terminal-initialization (selected-frame) "xterm")))
;; screen.el ends here
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index 4fc035191c7..2475837a641 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -1,6 +1,6 @@
;;; sun.el --- keybinding for standard default sunterm keys
-;; Copyright (C) 1987, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2001-2015 Free Software Foundation, Inc.
;; Author: Jeff Peck <peck@sun.com>
;; Keywords: terminals
@@ -38,7 +38,7 @@
(scroll-up n))
(defun kill-region-and-unmark (beg end)
- "Like kill-region, but pops the mark [which equals point, anyway.]"
+ "Like `kill-region', but pops the mark [which equals point, anyway.]"
(interactive "r")
(kill-region beg end)
(setq this-command 'kill-region-and-unmark)
@@ -122,8 +122,9 @@
;; for you to put your own bindings in.
(defvar sun-raw-prefix-hooks nil
- "List of forms to evaluate after setting sun-raw-prefix.")
-(make-obsolete-variable 'sun-raw-prefix-hooks 'term-setup-hook "21.1")
+ "List of forms to evaluate after setting `sun-raw-prefix'.")
+;; Obsolete since 21.1, but tty-setup-hook only exists since 24.4.
+(make-obsolete-variable 'sun-raw-prefix-hooks 'tty-setup-hook "21.1")
@@ -149,7 +150,9 @@
(global-set-key [f7] 'enlarge-window)
(when sun-raw-prefix-hooks
- (message "sun-raw-prefix-hooks is obsolete! Use term-setup-hook instead!")
+ (message "sun-raw-prefix-hooks is obsolete! Use %s instead!"
+ (or (car-safe (get 'sun-raw-prefix-hooks 'byte-obsolete-variable))
+ "emacs-startup-hook"))
(let ((hooks sun-raw-prefix-hooks))
(while hooks
(eval (car hooks))
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 5ba352a5c3a..3bc1aa0ee48 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -1,9 +1,9 @@
;;; tty-colors.el --- color support for character terminals
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eli Zaretskii
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: terminals, faces
;; This file is part of GNU Emacs.
@@ -771,7 +771,7 @@
"Return an alist of colors supported by FRAME's terminal.
FRAME defaults to the selected frame.
Each element of the returned alist is of the form:
- \(NAME INDEX R G B\)
+ (NAME INDEX R G B)
where NAME is the name of the color, a string;
INDEX is the index of this color to be sent to the terminal driver
when the color should be displayed; it is typically a small integer;
@@ -785,10 +785,10 @@ color."
(defun tty-modify-color-alist (elt &optional frame)
"Put the association ELT into the alist of terminal colors for FRAME.
-ELT should be of the form \(NAME INDEX R G B\) (see `tty-color-alist'
+ELT should be of the form (NAME INDEX R G B) (see `tty-color-alist'
for details).
If the association for NAME already exists in the color alist, it is
-modified to specify \(INDEX R G B\) as its cdr. Otherwise, ELT is
+modified to specify (INDEX R G B) as its cdr. Otherwise, ELT is
appended to the end of the color alist.
If FRAME is unspecified or nil, it defaults to the selected frame.
Value is the modified color alist for FRAME."
@@ -810,9 +810,11 @@ Value is the modified color alist for FRAME."
(while colors
(tty-color-define (car color) (cadr color) (cddr color))
(setq colors (cdr colors) color (car colors)))
- ;; Modifying color mappings means realized faces don't
- ;; use the right colors, so clear them.
- (clear-face-cache)))
+ ;; Modifying color mappings means realized faces don't use the
+ ;; right colors, so clear them, if we modified colors on a TTY
+ ;; frame.
+ (or (display-graphic-p)
+ (clear-face-cache))))
(defun tty-color-canonicalize (color)
"Return COLOR in canonical form.
@@ -856,7 +858,7 @@ of gray, thus the name."
(defun tty-color-approximate (rgb &optional frame)
"Find the color in `tty-color-alist' that best approximates RGB.
-Value is a list of the form \(NAME INDEX R G B\).
+Value is a list of the form (NAME INDEX R G B).
The argument RGB should be an rgb value, that is, a list of three
integers in the 0..65535 range.
FRAME defaults to the selected frame."
@@ -981,7 +983,7 @@ If FRAME is unspecified or nil, it defaults to the selected frame."
"Given a numeric index of a tty color, return its description.
FRAME, if unspecified or nil, defaults to the selected frame.
-Value is a list of the form \(NAME INDEX R G B\)."
+Value is a list of the form (NAME INDEX R G B)."
(and idx
(let ((colors (tty-color-alist frame))
desc found)
@@ -997,14 +999,14 @@ Value is a list of the form \(NAME INDEX R G B\)."
If COLOR is not directly supported by the display, return the RGB
values for a supported color that is its best approximation.
-The value is a list of integer RGB values--\(RED GREEN BLUE\).
+The value is a list of integer RGB values--(RED GREEN BLUE).
These values range from 0 to 65535; white is (65535 65535 65535).
If FRAME is omitted or nil, use the selected frame."
(cddr (tty-color-desc color frame)))
(defun tty-color-desc (color &optional frame)
"Return the description of the color COLOR for a character terminal.
-Value is a list of the form \(NAME INDEX R G B\). The returned NAME or
+Value is a list of the form (NAME INDEX R G B). The returned NAME or
RGB value may not be the same as the argument COLOR, because the latter
might need to be approximated if it is not supported directly."
(and (stringp color)
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index 2f9eb2614f6..c1f5928bebe 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -1,6 +1,6 @@
;;; tvi970.el --- terminal support for the Televideo 970
-;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Jim Blandy <jimb@occs.cs.oberlin.edu>
;; Keywords: terminals
@@ -23,8 +23,6 @@
;;; Commentary:
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
;;; Code:
(defvar tvi970-terminal-map
@@ -107,11 +105,11 @@ With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil.
-In ``alternate keypad mode'', the keys send distinct escape
+In alternate keypad mode, the keys send distinct escape
sequences, meaning that they can have their own bindings,
independent of the normal number keys.
-When disabled, the terminal enters ``numeric keypad mode'', in
+When disabled, the terminal enters numeric keypad mode, in
which the keypad's keys act as ordinary digits."
:variable (terminal-parameter nil 'tvi970-keypad-numeric)
(send-string-to-terminal
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index 2453f479eda..8136f2e5d53 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,6 +1,6 @@
;;; vt100.el --- define VT100 function key sequences in function-key-map
-;; Copyright (C) 1989, 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -22,8 +22,6 @@
;;; Commentary:
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
;; Handles all VT100 clones, including the Apollo terminal. Also handles
;; the VT200 --- its PF- and arrow- keys are different, but all those
;; are really set up by the terminal initialization code, which mines them
diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el
deleted file mode 100644
index 261b0bb5fd6..00000000000
--- a/lisp/term/vt102.el
+++ /dev/null
@@ -1,6 +0,0 @@
-
-(defun terminal-init-vt102 ()
- "Terminal initialization function for vt102."
- (tty-run-terminal-initialization (selected-frame) "vt100"))
-
-;;; vt102.el ends here
diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el
deleted file mode 100644
index 2b2098d483d..00000000000
--- a/lisp/term/vt125.el
+++ /dev/null
@@ -1,6 +0,0 @@
-
-(defun terminal-init-vt125 ()
- "Terminal initialization function for vt125."
- (tty-run-terminal-initialization (selected-frame) "vt100"))
-
-;;; vt125.el ends here
diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el
deleted file mode 100644
index a65b4737731..00000000000
--- a/lisp/term/vt201.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(defun terminal-init-vt201 ()
- "Terminal initialization function for vt201."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt201.el ends here
diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el
deleted file mode 100644
index 0dd43353c55..00000000000
--- a/lisp/term/vt220.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(defun terminal-init-vt220 ()
- "Terminal initialization function for vt220."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt220.el ends here
diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el
deleted file mode 100644
index b58d4211ce7..00000000000
--- a/lisp/term/vt240.el
+++ /dev/null
@@ -1,10 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(defun terminal-init-vt240 ()
- "Terminal initialization function for vt240."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt240.el ends here
diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el
deleted file mode 100644
index a2664552a64..00000000000
--- a/lisp/term/vt300.el
+++ /dev/null
@@ -1,8 +0,0 @@
-(defun terminal-init-vt300 ()
- "Terminal initialization function for vt300."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt300.el ends here
diff --git a/lisp/term/vt320.el b/lisp/term/vt320.el
deleted file mode 100644
index 08ed9a8ffb9..00000000000
--- a/lisp/term/vt320.el
+++ /dev/null
@@ -1,8 +0,0 @@
-(defun terminal-init-vt320 ()
- "Terminal initialization function for vt320."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt320.el ends here
diff --git a/lisp/term/vt400.el b/lisp/term/vt400.el
deleted file mode 100644
index ad4a5fdbb4f..00000000000
--- a/lisp/term/vt400.el
+++ /dev/null
@@ -1,8 +0,0 @@
-(defun terminal-init-vt400 ()
- "Terminal initialization function for vt400."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt400.el ends here
diff --git a/lisp/term/vt420.el b/lisp/term/vt420.el
deleted file mode 100644
index f6745a3953a..00000000000
--- a/lisp/term/vt420.el
+++ /dev/null
@@ -1,8 +0,0 @@
-(defun terminal-init-vt420 ()
- "Terminal initialization function for vt420."
- (tty-run-terminal-initialization (selected-frame) "vt100")
- ;; Make F11 an escape key.
- (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant.
- (define-key local-function-key-map [f11] [?\e]))
-
-;;; vt420.el ends here
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 55181ab7d6d..181fd494eab 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -1,6 +1,6 @@
;;; w32-win.el --- parse switches controlling interface with W32 window system -*- lexical-binding: t -*-
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Kevin Gallo
;; Keywords: terminals
@@ -110,8 +110,13 @@
(let ((f (if (eq system-type 'cygwin)
(cygwin-convert-file-name-from-windows file-name t)
(subst-char-in-string ?\\ ?/ file-name)))
- (coding (or file-name-coding-system
- default-file-name-coding-system)))
+ (coding (if (eq system-type 'windows-nt)
+ ;; Native w32 build pretends that its file names
+ ;; are encoded in UTF-8, and converts to the
+ ;; appropriate encoding internally.
+ 'utf-8
+ (or file-name-coding-system
+ default-file-name-coding-system))))
(setq file-name
(mapconcat 'url-hexify-string
@@ -200,12 +205,16 @@ European languages which are distributed with Windows as
See the documentation of `create-fontset-from-fontset-spec' for the format.")
-(defun x-win-suspend-error ()
+(defun w32-win-suspend-error ()
"Report an error when a suspend is attempted."
(error "Suspending an Emacs running under W32 makes no sense"))
(defvar dynamic-library-alist)
(defvar libpng-version) ; image.c #ifdef HAVE_NTGUI
+(defvar libgif-version)
+(defvar libjpeg-version)
+
+(defvar libgnutls-version) ; gnutls.c
;;; Set default known names for external libraries
(setq dynamic-library-alist
@@ -216,19 +225,52 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; the version we were compiled against. (If we were compiled
;; without PNG support, libpng-version's value is -1.)
(if (>= libpng-version 10400)
- ;; libpng14-14.dll is libpng 1.4.3 from GTK+
- '(png "libpng14-14.dll" "libpng14.dll")
+ (let ((major (/ libpng-version 10000))
+ (minor (mod (/ libpng-version 100) 10)))
+ (list 'png
+ ;; libpngXY.dll is the default name when building
+ ;; with CMake or from a lpngXYY tarball on w32,
+ ;; libpngXY-XY.dll is the DLL name when building
+ ;; with libtool / autotools
+ (format "libpng%d%d.dll" major minor)
+ (format "libpng%d%d-%d%d.dll" major minor major minor)))
'(png "libpng12d.dll" "libpng12.dll" "libpng3.dll" "libpng.dll"
;; these are libpng 1.2.8 from GTK+
"libpng13d.dll" "libpng13.dll"))
- '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll")
- '(tiff "libtiff3.dll" "libtiff.dll")
- '(gif "giflib4.dll" "libungif4.dll" "libungif.dll")
+ '(tiff "libtiff-5.dll" "libtiff3.dll" "libtiff.dll")
+ (if (> libjpeg-version 62)
+ ;; Versions of libjpeg after 6b are incompatible with
+ ;; earlier versions, and each of versions 7, 8, and 9 is
+ ;; also incompatible with the preceding ones (the core data
+ ;; structures used for communications with the library
+ ;; gained additional members with each new version). So we
+ ;; must use only the version of the library which Emacs was
+ ;; compiled against.
+ (list 'jpeg (format "libjpeg-%d.dll" (/ libjpeg-version 10)))
+ '(jpeg "jpeg62.dll" "libjpeg.dll" "jpeg-62.dll" "jpeg.dll"))
+ ;; Versions of giflib 5.0.0 and later changed signatures of
+ ;; several functions used by Emacs, which makes those versions
+ ;; incompatible with previous ones. We select the correct
+ ;; libraries according to the version of giflib we were
+ ;; compiled against. (If we were compiled without GIF support,
+ ;; libgif-version's value is -1.)
+ (if (>= libgif-version 50100)
+ ;; Yes, giflib 5.0 uses 6 as the major version of the API,
+ ;; and giflib 5.1 uses 7, thus "libgif-7.dll" and
+ ;; "libgif-6.dll" below (giflib 4.x used 5 as the major API
+ ;; version). giflib5.dll is from the lua-files project,
+ ;; and gif.dll is from luapower.
+ '(gif "libgif-7.dll")
+ (if (>= libgif-version 50000)
+ '(gif "libgif-6.dll" "giflib5.dll" "gif.dll")
+ '(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")))
'(svg "librsvg-2-2.dll")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gobject "libgobject-2.0-0.dll")
- '(gnutls "libgnutls-28.dll" "libgnutls-26.dll")
+ (if (>= libgnutls-version 30400)
+ '(gnutls "libgnutls-30.dll")
+ '(gnutls "libgnutls-28.dll" "libgnutls-26.dll"))
'(libxml2 "libxml2-2.dll" "libxml2.dll")
'(zlib "zlib1.dll" "libz-1.dll")))
@@ -238,6 +280,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function x-open-connection "w32fns.c"
(display &optional xrm-string must-succeed))
+(declare-function create-default-fontset "fontset" ())
(declare-function create-fontset-from-fontset-spec "fontset"
(fontset-spec &optional style-variant noerror))
(declare-function create-fontset-from-x-resource "fontset" ())
@@ -247,7 +290,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(declare-function x-parse-geometry "frame.c" (string))
(defvar x-command-line-resources)
-(defun w32-initialize-window-system (&optional _display)
+(cl-defmethod window-system-initialization (&context (window-system w32)
+ &optional _display)
"Initialize Emacs for W32 GUI frames."
(cl-assert (not w32-initialized))
@@ -315,7 +359,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(cons '(reverse . t) default-frame-alist)))))
;; Don't let Emacs suspend under Windows.
- (add-hook 'suspend-hook 'x-win-suspend-error)
+ (add-hook 'suspend-hook #'w32-win-suspend-error)
;; Turn off window-splitting optimization; w32 is usually fast enough
;; that this is only annoying.
@@ -333,9 +377,90 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(setq w32-initialized t))
(add-to-list 'display-format-alist '("\\`w32\\'" . w32))
-(add-to-list 'handle-args-function-alist '(w32 . x-handle-args))
-(add-to-list 'frame-creation-function-alist '(w32 . x-create-frame-with-faces))
-(add-to-list 'window-system-initialization-alist '(w32 . w32-initialize-window-system))
+(cl-defmethod handle-args-function (args &context (window-system w32))
+ (x-handle-args args))
+
+(cl-defmethod frame-creation-function (params &context (window-system w32))
+ (x-create-frame-with-faces params))
+
+;;;; Selections
+
+(declare-function w32-set-clipboard-data "w32select.c"
+ (string &optional ignored))
+(declare-function w32-get-clipboard-data "w32select.c")
+(declare-function w32-selection-exists-p "w32select.c")
+
+;;; Fix interface to (X-specific) mouse.el
+(defun w32--set-selection (type value)
+ (if (eq type 'CLIPBOARD)
+ (w32-set-clipboard-data value)
+ (put 'x-selections (or type 'PRIMARY) value)))
+
+(defun w32--get-selection (&optional type data-type)
+ (if (and (eq type 'CLIPBOARD)
+ (eq data-type 'STRING))
+ (with-demoted-errors "w32-get-clipboard-data:%S"
+ (w32-get-clipboard-data))
+ (get 'x-selections (or type 'PRIMARY))))
+
+(defun w32--selection-owner-p (selection)
+ (and (memq selection '(nil PRIMARY SECONDARY))
+ (get 'x-selections (or selection 'PRIMARY))))
+
+(cl-defmethod gui-backend-set-selection (type value
+ &context (window-system w32))
+ (w32--set-selection type value))
+
+(cl-defmethod gui-backend-get-selection (type data-type
+ &context (window-system w32))
+ (w32--get-selection type data-type))
+
+(cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system w32))
+ (w32--selection-owner-p selection))
+
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system w32))
+ (w32-selection-exists-p selection))
+
+(when (eq system-type 'windows-nt)
+ ;; Make copy&pasting in w32's console interact with the system's clipboard!
+ ;; We could move those cl-defmethods outside of the `when' and use
+ ;; "&context (system-type (eql windows-nt))" instead!
+ (cl-defmethod gui-backend-set-selection (type value
+ &context (window-system nil))
+ (w32--set-selection type value))
+
+ (cl-defmethod gui-backend-get-selection (type data-type
+ &context (window-system nil))
+ (w32--get-selection type data-type))
+
+ (cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system nil))
+ (w32--selection-owner-p selection))
+
+ (cl-defmethod gui-selection-exists-p (selection
+ &context (window-system nil))
+ (w32-selection-exists-p selection)))
+
+;; The "Windows" keys on newer keyboards bring up the Start menu
+;; whether you want it or not - make Emacs ignore these keystrokes
+;; rather than beep.
+(global-set-key [lwindow] 'ignore)
+(global-set-key [rwindow] 'ignore)
+
+(declare-function x-server-version "w32fns.c" (&optional terminal))
+
+(defun w32-version ()
+ "Return the MS-Windows version numbers.
+The value is a list of three integers: the major and minor version
+numbers, and the build number."
+ (x-server-version))
+
+(defun w32-using-nt ()
+ "Return non-nil if running on a Windows NT descendant.
+That includes all Windows systems except for 9X/Me."
+ (getenv "SystemRoot"))
(provide 'w32-win)
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index 95964840c10..58856858502 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -1,6 +1,6 @@
;;; w32console.el -- Setup w32 console keys and colors.
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -65,7 +65,10 @@
(when oem-cs-p
(set-keyboard-coding-system oem-code-page-coding)
(set-terminal-coding-system
- (if oem-o-cs-p oem-code-page-output-coding oem-code-page-coding))))
+ (if oem-o-cs-p oem-code-page-output-coding oem-code-page-coding))
+ ;; Since we changed the terminal encoding, we need to repeat
+ ;; the test for Unicode quotes being displayable.
+ (startup--setup-quote-display)))
(let* ((colors w32-tty-standard-colors)
(color (car colors)))
(tty-color-clear)
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index b7f044ad0c5..47c0ba34ea4 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -1,6 +1,6 @@
;;; wyse50.el --- terminal support code for Wyse 50
-;; Copyright (C) 1989, 1993-1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1993-1994, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>,
@@ -24,7 +24,6 @@
;;; Commentary:
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
;; Rewritten for Emacs 19 by jimb, January 1992
;; Cleaned up for new terminal package conventions by esr, March 1993
;; Should work well for Televideo TVI 925 although it's overkill.
@@ -132,7 +131,7 @@
(concat "\ea23R" (1+ (frame-width)) "C\eG0"))))))
(defun enable-arrow-keys ()
- "To be called by `term-setup-hook'. Overrides 6 Emacs standard keys
+ "To be called by `tty-setup-hook'. Overrides 6 Emacs standard keys
whose functions are then typed as follows:
C-a Funct Left-arrow
C-h M-?
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 28fd3d7090c..690401e1970 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1,6 +1,6 @@
-;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
+;;; x-win.el --- parse relevant switches and set up for X -*- lexical-binding:t -*-
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
@@ -29,8 +29,7 @@
;; Beginning in Emacs 23, the act of loading this file should not have
;; the side effect of initializing the window system or processing
;; command line arguments (this file is now loaded in loadup.el). See
-;; the variables `handle-args-function-alist' and
-;; `window-system-initialization-alist' for more details.
+;; `handle-args-function' and `window-system-initialization' for more details.
;; startup.el will then examine startup files, and eventually call the hooks
;; which create the first window(s).
@@ -72,6 +71,7 @@
(if (not (fboundp 'x-create-frame))
(error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
+(require 'term/common-win)
(require 'frame)
(require 'mouse)
(require 'scroll-bar)
@@ -307,830 +307,822 @@ as returned by `x-server-vendor'."
(pair
'(
;; Latin-2
- (#x1a1 . ?,B!(B)
- (#x1a2 . ?,B"(B)
- (#x1a3 . ?,B#(B)
- (#x1a5 . ?,B%(B)
- (#x1a6 . ?,B&(B)
- (#x1a9 . ?,B)(B)
- (#x1aa . ?,B*(B)
- (#x1ab . ?,B+(B)
- (#x1ac . ?,B,(B)
- (#x1ae . ?,B.(B)
- (#x1af . ?,B/(B)
- (#x1b1 . ?,B1(B)
- (#x1b2 . ?,B2(B)
- (#x1b3 . ?,B3(B)
- (#x1b5 . ?,B5(B)
- (#x1b6 . ?,B6(B)
- (#x1b7 . ?,B7(B)
- (#x1b9 . ?,B9(B)
- (#x1ba . ?,B:(B)
- (#x1bb . ?,B;(B)
- (#x1bc . ?,B<(B)
- (#x1bd . ?,B=(B)
- (#x1be . ?,B>(B)
- (#x1bf . ?,B?(B)
- (#x1c0 . ?,B@(B)
- (#x1c3 . ?,BC(B)
- (#x1c5 . ?,BE(B)
- (#x1c6 . ?,BF(B)
- (#x1c8 . ?,BH(B)
- (#x1ca . ?,BJ(B)
- (#x1cc . ?,BL(B)
- (#x1cf . ?,BO(B)
- (#x1d0 . ?,BP(B)
- (#x1d1 . ?,BQ(B)
- (#x1d2 . ?,BR(B)
- (#x1d5 . ?,BU(B)
- (#x1d8 . ?,BX(B)
- (#x1d9 . ?,BY(B)
- (#x1db . ?,B[(B)
- (#x1de . ?,B^(B)
- (#x1e0 . ?,B`(B)
- (#x1e3 . ?,Bc(B)
- (#x1e5 . ?,Be(B)
- (#x1e6 . ?,Bf(B)
- (#x1e8 . ?,Bh(B)
- (#x1ea . ?,Bj(B)
- (#x1ec . ?,Bl(B)
- (#x1ef . ?,Bo(B)
- (#x1f0 . ?,Bp(B)
- (#x1f1 . ?,Bq(B)
- (#x1f2 . ?,Br(B)
- (#x1f5 . ?,Bu(B)
- (#x1f8 . ?,Bx(B)
- (#x1f9 . ?,By(B)
- (#x1fb . ?,B{(B)
- (#x1fe . ?,B~(B)
- (#x1ff . ?,B(B)
+ (#x1a1 . ?Ą)
+ (#x1a2 . ?˘)
+ (#x1a3 . ?Ł)
+ (#x1a5 . ?Ľ)
+ (#x1a6 . ?Ś)
+ (#x1a9 . ?Š)
+ (#x1aa . ?Ş)
+ (#x1ab . ?Ť)
+ (#x1ac . ?Ź)
+ (#x1ae . ?Ž)
+ (#x1af . ?Ż)
+ (#x1b1 . ?ą)
+ (#x1b2 . ?˛)
+ (#x1b3 . ?ł)
+ (#x1b5 . ?ľ)
+ (#x1b6 . ?ś)
+ (#x1b7 . ?ˇ)
+ (#x1b9 . ?š)
+ (#x1ba . ?ş)
+ (#x1bb . ?ť)
+ (#x1bc . ?ź)
+ (#x1bd . ?˝)
+ (#x1be . ?ž)
+ (#x1bf . ?ż)
+ (#x1c0 . ?Ŕ)
+ (#x1c3 . ?Ă)
+ (#x1c5 . ?Ĺ)
+ (#x1c6 . ?Ć)
+ (#x1c8 . ?Č)
+ (#x1ca . ?Ę)
+ (#x1cc . ?Ě)
+ (#x1cf . ?Ď)
+ (#x1d0 . ?Đ)
+ (#x1d1 . ?Ń)
+ (#x1d2 . ?Ň)
+ (#x1d5 . ?Ő)
+ (#x1d8 . ?Ř)
+ (#x1d9 . ?Ů)
+ (#x1db . ?Ű)
+ (#x1de . ?Ţ)
+ (#x1e0 . ?ŕ)
+ (#x1e3 . ?ă)
+ (#x1e5 . ?ĺ)
+ (#x1e6 . ?ć)
+ (#x1e8 . ?č)
+ (#x1ea . ?ę)
+ (#x1ec . ?ě)
+ (#x1ef . ?ď)
+ (#x1f0 . ?đ)
+ (#x1f1 . ?ń)
+ (#x1f2 . ?ň)
+ (#x1f5 . ?ő)
+ (#x1f8 . ?ř)
+ (#x1f9 . ?ů)
+ (#x1fb . ?ű)
+ (#x1fe . ?ţ)
+ (#x1ff . ?˙)
;; Latin-3
- (#x2a1 . ?,C!(B)
- (#x2a6 . ?,C&(B)
- (#x2a9 . ?,C)(B)
- (#x2ab . ?,C+(B)
- (#x2ac . ?,C,(B)
- (#x2b1 . ?,C1(B)
- (#x2b6 . ?,C6(B)
- (#x2b9 . ?,C9(B)
- (#x2bb . ?,C;(B)
- (#x2bc . ?,C<(B)
- (#x2c5 . ?,CE(B)
- (#x2c6 . ?,CF(B)
- (#x2d5 . ?,CU(B)
- (#x2d8 . ?,CX(B)
- (#x2dd . ?,C](B)
- (#x2de . ?,C^(B)
- (#x2e5 . ?,Ce(B)
- (#x2e6 . ?,Cf(B)
- (#x2f5 . ?,Cu(B)
- (#x2f8 . ?,Cx(B)
- (#x2fd . ?,C}(B)
- (#x2fe . ?,C~(B)
+ (#x2a1 . ?Ħ)
+ (#x2a6 . ?Ĥ)
+ (#x2a9 . ?İ)
+ (#x2ab . ?Ğ)
+ (#x2ac . ?Ĵ)
+ (#x2b1 . ?ħ)
+ (#x2b6 . ?ĥ)
+ (#x2b9 . ?ı)
+ (#x2bb . ?ğ)
+ (#x2bc . ?ĵ)
+ (#x2c5 . ?Ċ)
+ (#x2c6 . ?Ĉ)
+ (#x2d5 . ?Ġ)
+ (#x2d8 . ?Ĝ)
+ (#x2dd . ?Ŭ)
+ (#x2de . ?Ŝ)
+ (#x2e5 . ?ċ)
+ (#x2e6 . ?ĉ)
+ (#x2f5 . ?ġ)
+ (#x2f8 . ?ĝ)
+ (#x2fd . ?ŭ)
+ (#x2fe . ?ŝ)
;; Latin-4
- (#x3a2 . ?,D"(B)
- (#x3a3 . ?,D#(B)
- (#x3a5 . ?,D%(B)
- (#x3a6 . ?,D&(B)
- (#x3aa . ?,D*(B)
- (#x3ab . ?,D+(B)
- (#x3ac . ?,D,(B)
- (#x3b3 . ?,D3(B)
- (#x3b5 . ?,D5(B)
- (#x3b6 . ?,D6(B)
- (#x3ba . ?,D:(B)
- (#x3bb . ?,D;(B)
- (#x3bc . ?,D<(B)
- (#x3bd . ?,D=(B)
- (#x3bf . ?,D?(B)
- (#x3c0 . ?,D@(B)
- (#x3c7 . ?,DG(B)
- (#x3cc . ?,DL(B)
- (#x3cf . ?,DO(B)
- (#x3d1 . ?,DQ(B)
- (#x3d2 . ?,DR(B)
- (#x3d3 . ?,DS(B)
- (#x3d9 . ?,DY(B)
- (#x3dd . ?,D](B)
- (#x3de . ?,D^(B)
- (#x3e0 . ?,D`(B)
- (#x3e7 . ?,Dg(B)
- (#x3ec . ?,Dl(B)
- (#x3ef . ?,Do(B)
- (#x3f1 . ?,Dq(B)
- (#x3f2 . ?,Dr(B)
- (#x3f3 . ?,Ds(B)
- (#x3f9 . ?,Dy(B)
- (#x3fd . ?,D}(B)
- (#x3fe . ?,D~(B)
- ;; Kana: Fixme: needs conversion to Japanese charset -- seems
- ;; to require jisx0213, for which the Unicode translation
- ;; isn't clear. Using Emacs to convert this to Unicode and back changes
- ;; this from "(J~(B" (i.e., bytes "ESC ( J ~ ESC ( B") to "$(G"#(B" (i.e., bytes
- ;; "ESC $ ( G " # ESC ( B").
- (#x47e . ?(J~(B)
- (#x4a1 . ?$A!#(B)
- (#x4a2 . ?\$A!8(B)
- (#x4a3 . ?\$A!9(B)
- (#x4a4 . ?$A!"(B)
- (#x4a5 . ?$A!$(B)
- (#x4a6 . ?$A%r(B)
- (#x4a7 . ?$A%!(B)
- (#x4a8 . ?$A%#(B)
- (#x4a9 . ?$A%%(B)
- (#x4aa . ?$A%'(B)
- (#x4ab . ?$A%)(B)
- (#x4ac . ?$A%c(B)
- (#x4ad . ?$A%e(B)
- (#x4ae . ?$A%g(B)
- (#x4af . ?$A%C(B)
- (#x4b0 . ?$B!<(B)
- (#x4b1 . ?$A%"(B)
- (#x4b2 . ?$A%$(B)
- (#x4b3 . ?$A%&(B)
- (#x4b4 . ?$A%((B)
- (#x4b5 . ?$A%*(B)
- (#x4b6 . ?$A%+(B)
- (#x4b7 . ?$A%-(B)
- (#x4b8 . ?$A%/(B)
- (#x4b9 . ?$A%1(B)
- (#x4ba . ?$A%3(B)
- (#x4bb . ?$A%5(B)
- (#x4bc . ?$A%7(B)
- (#x4bd . ?$A%9(B)
- (#x4be . ?$A%;(B)
- (#x4bf . ?$A%=(B)
- (#x4c0 . ?$A%?(B)
- (#x4c1 . ?$A%A(B)
- (#x4c2 . ?$A%D(B)
- (#x4c3 . ?$A%F(B)
- (#x4c4 . ?$A%H(B)
- (#x4c5 . ?$A%J(B)
- (#x4c6 . ?$A%K(B)
- (#x4c7 . ?$A%L(B)
- (#x4c8 . ?$A%M(B)
- (#x4c9 . ?$A%N(B)
- (#x4ca . ?$A%O(B)
- (#x4cb . ?$A%R(B)
- (#x4cc . ?$A%U(B)
- (#x4cd . ?$A%X(B)
- (#x4ce . ?$A%[(B)
- (#x4cf . ?$A%^(B)
- (#x4d0 . ?$A%_(B)
- (#x4d1 . ?$A%`(B)
- (#x4d2 . ?$A%a(B)
- (#x4d3 . ?$A%b(B)
- (#x4d4 . ?$A%d(B)
- (#x4d5 . ?$A%f(B)
- (#x4d6 . ?$A%h(B)
- (#x4d7 . ?$A%i(B)
- (#x4d8 . ?$A%j(B)
- (#x4d9 . ?$A%k(B)
- (#x4da . ?$A%l(B)
- (#x4db . ?$A%m(B)
- (#x4dc . ?$A%o(B)
- (#x4dd . ?$A%s(B)
- (#x4de . ?$B!+(B)
- (#x4df . ?$B!,(B)
+ (#x3a2 . ?ĸ)
+ (#x3a3 . ?Ŗ)
+ (#x3a5 . ?Ĩ)
+ (#x3a6 . ?Ļ)
+ (#x3aa . ?Ē)
+ (#x3ab . ?Ģ)
+ (#x3ac . ?Ŧ)
+ (#x3b3 . ?ŗ)
+ (#x3b5 . ?ĩ)
+ (#x3b6 . ?ļ)
+ (#x3ba . ?ē)
+ (#x3bb . ?ģ)
+ (#x3bc . ?ŧ)
+ (#x3bd . ?Ŋ)
+ (#x3bf . ?ŋ)
+ (#x3c0 . ?Ā)
+ (#x3c7 . ?Į)
+ (#x3cc . ?Ė)
+ (#x3cf . ?Ī)
+ (#x3d1 . ?Ņ)
+ (#x3d2 . ?Ō)
+ (#x3d3 . ?Ķ)
+ (#x3d9 . ?Ų)
+ (#x3dd . ?Ũ)
+ (#x3de . ?Ū)
+ (#x3e0 . ?ā)
+ (#x3e7 . ?į)
+ (#x3ec . ?ė)
+ (#x3ef . ?ī)
+ (#x3f1 . ?ņ)
+ (#x3f2 . ?ō)
+ (#x3f3 . ?ķ)
+ (#x3f9 . ?ų)
+ (#x3fd . ?ũ)
+ (#x3fe . ?ū)
+ (#x47e . ?‾)
+ (#x4a1 . ?。)
+ (#x4a2 . ?\「)
+ (#x4a3 . ?\」)
+ (#x4a4 . ?、)
+ (#x4a5 . ?・)
+ (#x4a6 . ?ヲ)
+ (#x4a7 . ?ァ)
+ (#x4a8 . ?ィ)
+ (#x4a9 . ?ゥ)
+ (#x4aa . ?ェ)
+ (#x4ab . ?ォ)
+ (#x4ac . ?ャ)
+ (#x4ad . ?ュ)
+ (#x4ae . ?ョ)
+ (#x4af . ?ッ)
+ (#x4b0 . ?ー)
+ (#x4b1 . ?ア)
+ (#x4b2 . ?イ)
+ (#x4b3 . ?ウ)
+ (#x4b4 . ?エ)
+ (#x4b5 . ?オ)
+ (#x4b6 . ?カ)
+ (#x4b7 . ?キ)
+ (#x4b8 . ?ク)
+ (#x4b9 . ?ケ)
+ (#x4ba . ?コ)
+ (#x4bb . ?サ)
+ (#x4bc . ?シ)
+ (#x4bd . ?ス)
+ (#x4be . ?セ)
+ (#x4bf . ?ソ)
+ (#x4c0 . ?タ)
+ (#x4c1 . ?チ)
+ (#x4c2 . ?ツ)
+ (#x4c3 . ?テ)
+ (#x4c4 . ?ト)
+ (#x4c5 . ?ナ)
+ (#x4c6 . ?ニ)
+ (#x4c7 . ?ヌ)
+ (#x4c8 . ?ネ)
+ (#x4c9 . ?ノ)
+ (#x4ca . ?ハ)
+ (#x4cb . ?ヒ)
+ (#x4cc . ?フ)
+ (#x4cd . ?ヘ)
+ (#x4ce . ?ホ)
+ (#x4cf . ?マ)
+ (#x4d0 . ?ミ)
+ (#x4d1 . ?ム)
+ (#x4d2 . ?メ)
+ (#x4d3 . ?モ)
+ (#x4d4 . ?ヤ)
+ (#x4d5 . ?ユ)
+ (#x4d6 . ?ヨ)
+ (#x4d7 . ?ラ)
+ (#x4d8 . ?リ)
+ (#x4d9 . ?ル)
+ (#x4da . ?レ)
+ (#x4db . ?ロ)
+ (#x4dc . ?ワ)
+ (#x4dd . ?ン)
+ (#x4de . ?゛)
+ (#x4df . ?゜)
;; Arabic
- (#x5ac . ?,G,(B)
- (#x5bb . ?,G;(B)
- (#x5bf . ?,G?(B)
- (#x5c1 . ?,GA(B)
- (#x5c2 . ?,GB(B)
- (#x5c3 . ?,GC(B)
- (#x5c4 . ?,GD(B)
- (#x5c5 . ?,GE(B)
- (#x5c6 . ?,GF(B)
- (#x5c7 . ?,GG(B)
- (#x5c8 . ?,GH(B)
- (#x5c9 . ?,GI(B)
- (#x5ca . ?,GJ(B)
- (#x5cb . ?,GK(B)
- (#x5cc . ?,GL(B)
- (#x5cd . ?,GM(B)
- (#x5ce . ?,GN(B)
- (#x5cf . ?,GO(B)
- (#x5d0 . ?,GP(B)
- (#x5d1 . ?,GQ(B)
- (#x5d2 . ?,GR(B)
- (#x5d3 . ?,GS(B)
- (#x5d4 . ?,GT(B)
- (#x5d5 . ?,GU(B)
- (#x5d6 . ?,GV(B)
- (#x5d7 . ?,GW(B)
- (#x5d8 . ?,GX(B)
- (#x5d9 . ?,GY(B)
- (#x5da . ?,GZ(B)
- (#x5e0 . ?,G`(B)
- (#x5e1 . ?,Ga(B)
- (#x5e2 . ?,Gb(B)
- (#x5e3 . ?,Gc(B)
- (#x5e4 . ?,Gd(B)
- (#x5e5 . ?,Ge(B)
- (#x5e6 . ?,Gf(B)
- (#x5e7 . ?,Gg(B)
- (#x5e8 . ?,Gh(B)
- (#x5e9 . ?,Gi(B)
- (#x5ea . ?,Gj(B)
- (#x5eb . ?,Gk(B)
- (#x5ec . ?,Gl(B)
- (#x5ed . ?,Gm(B)
- (#x5ee . ?,Gn(B)
- (#x5ef . ?,Go(B)
- (#x5f0 . ?,Gp(B)
- (#x5f1 . ?,Gq(B)
- (#x5f2 . ?,Gr(B)
+ (#x5ac . ?،)
+ (#x5bb . ?؛)
+ (#x5bf . ?؟)
+ (#x5c1 . ?ء)
+ (#x5c2 . ?آ)
+ (#x5c3 . ?أ)
+ (#x5c4 . ?ؤ)
+ (#x5c5 . ?إ)
+ (#x5c6 . ?ئ)
+ (#x5c7 . ?ا)
+ (#x5c8 . ?ب)
+ (#x5c9 . ?ة)
+ (#x5ca . ?ت)
+ (#x5cb . ?ث)
+ (#x5cc . ?ج)
+ (#x5cd . ?ح)
+ (#x5ce . ?خ)
+ (#x5cf . ?د)
+ (#x5d0 . ?ذ)
+ (#x5d1 . ?ر)
+ (#x5d2 . ?ز)
+ (#x5d3 . ?س)
+ (#x5d4 . ?ش)
+ (#x5d5 . ?ص)
+ (#x5d6 . ?ض)
+ (#x5d7 . ?ط)
+ (#x5d8 . ?ظ)
+ (#x5d9 . ?ع)
+ (#x5da . ?غ)
+ (#x5e0 . ?ـ)
+ (#x5e1 . ?ف)
+ (#x5e2 . ?ق)
+ (#x5e3 . ?ك)
+ (#x5e4 . ?ل)
+ (#x5e5 . ?م)
+ (#x5e6 . ?ن)
+ (#x5e7 . ?ه)
+ (#x5e8 . ?و)
+ (#x5e9 . ?ى)
+ (#x5ea . ?ي)
+ (#x5eb . ?ً)
+ (#x5ec . ?ٌ)
+ (#x5ed . ?ٍ)
+ (#x5ee . ?َ)
+ (#x5ef . ?ُ)
+ (#x5f0 . ?ِ)
+ (#x5f1 . ?ّ)
+ (#x5f2 . ?ْ)
;; Cyrillic
- (#x680 . ?$,1)R(B)
- (#x681 . ?$,1)V(B)
- (#x682 . ?$,1)Z(B)
- (#x683 . ?$,1)\(B)
- (#x684 . ?$,1)b(B)
- (#x685 . ?$,1)n(B)
- (#x686 . ?$,1)p(B)
- (#x687 . ?$,1)r(B)
- (#x688 . ?$,1)v(B)
- (#x689 . ?$,1)x(B)
- (#x68a . ?$,1)z(B)
- (#x68c . ?$,1*8(B)
- (#x68d . ?$,1*B(B)
- (#x68e . ?$,1*H(B)
- (#x68f . ?$,1*N(B)
- (#x690 . ?$,1)S(B)
- (#x691 . ?$,1)W(B)
- (#x692 . ?$,1)[(B)
- (#x693 . ?$,1)](B)
- (#x694 . ?$,1)c(B)
- (#x695 . ?$,1)o(B)
- (#x696 . ?$,1)q(B)
- (#x697 . ?$,1)s(B)
- (#x698 . ?$,1)w(B)
- (#x699 . ?$,1)y(B)
- (#x69a . ?$,1){(B)
- (#x69c . ?$,1*9(B)
- (#x69d . ?$,1*C(B)
- (#x69e . ?$,1*I(B)
- (#x69f . ?$,1*O(B)
- (#x6a1 . ?,Lr(B)
- (#x6a2 . ?,Ls(B)
- (#x6a3 . ?,Lq(B)
- (#x6a4 . ?,Lt(B)
- (#x6a5 . ?,Lu(B)
- (#x6a6 . ?,Lv(B)
- (#x6a7 . ?,Lw(B)
- (#x6a8 . ?,Lx(B)
- (#x6a9 . ?,Ly(B)
- (#x6aa . ?,Lz(B)
- (#x6ab . ?,L{(B)
- (#x6ac . ?,L|(B)
- (#x6ae . ?,L~(B)
- (#x6af . ?,L(B)
- (#x6b0 . ?,Lp(B)
- (#x6b1 . ?,L"(B)
- (#x6b2 . ?,L#(B)
- (#x6b3 . ?,L!(B)
- (#x6b4 . ?,L$(B)
- (#x6b5 . ?,L%(B)
- (#x6b6 . ?,L&(B)
- (#x6b7 . ?,L'(B)
- (#x6b8 . ?,L((B)
- (#x6b9 . ?,L)(B)
- (#x6ba . ?,L*(B)
- (#x6bb . ?,L+(B)
- (#x6bc . ?,L,(B)
- (#x6be . ?,L.(B)
- (#x6bf . ?,L/(B)
- (#x6c0 . ?,Ln(B)
- (#x6c1 . ?,LP(B)
- (#x6c2 . ?,LQ(B)
- (#x6c3 . ?,Lf(B)
- (#x6c4 . ?,LT(B)
- (#x6c5 . ?,LU(B)
- (#x6c6 . ?,Ld(B)
- (#x6c7 . ?,LS(B)
- (#x6c8 . ?,Le(B)
- (#x6c9 . ?,LX(B)
- (#x6ca . ?,LY(B)
- (#x6cb . ?,LZ(B)
- (#x6cc . ?,L[(B)
- (#x6cd . ?,L\(B)
- (#x6ce . ?,L](B)
- (#x6cf . ?,L^(B)
- (#x6d0 . ?,L_(B)
- (#x6d1 . ?,Lo(B)
- (#x6d2 . ?,L`(B)
- (#x6d3 . ?,La(B)
- (#x6d4 . ?,Lb(B)
- (#x6d5 . ?,Lc(B)
- (#x6d6 . ?,LV(B)
- (#x6d7 . ?,LR(B)
- (#x6d8 . ?,Ll(B)
- (#x6d9 . ?,Lk(B)
- (#x6da . ?,LW(B)
- (#x6db . ?,Lh(B)
- (#x6dc . ?,Lm(B)
- (#x6dd . ?,Li(B)
- (#x6de . ?,Lg(B)
- (#x6df . ?,Lj(B)
- (#x6e0 . ?,LN(B)
- (#x6e1 . ?,L0(B)
- (#x6e2 . ?,L1(B)
- (#x6e3 . ?,LF(B)
- (#x6e4 . ?,L4(B)
- (#x6e5 . ?,L5(B)
- (#x6e6 . ?,LD(B)
- (#x6e7 . ?,L3(B)
- (#x6e8 . ?,LE(B)
- (#x6e9 . ?,L8(B)
- (#x6ea . ?,L9(B)
- (#x6eb . ?,L:(B)
- (#x6ec . ?,L;(B)
- (#x6ed . ?,L<(B)
- (#x6ee . ?,L=(B)
- (#x6ef . ?,L>(B)
- (#x6f0 . ?,L?(B)
- (#x6f1 . ?,LO(B)
- (#x6f2 . ?,L@(B)
- (#x6f3 . ?,LA(B)
- (#x6f4 . ?,LB(B)
- (#x6f5 . ?,LC(B)
- (#x6f6 . ?,L6(B)
- (#x6f7 . ?,L2(B)
- (#x6f8 . ?,LL(B)
- (#x6f9 . ?,LK(B)
- (#x6fa . ?,L7(B)
- (#x6fb . ?,LH(B)
- (#x6fc . ?,LM(B)
- (#x6fd . ?,LI(B)
- (#x6fe . ?,LG(B)
- (#x6ff . ?,LJ(B)
+ (#x680 . ?Ғ)
+ (#x681 . ?Җ)
+ (#x682 . ?Қ)
+ (#x683 . ?Ҝ)
+ (#x684 . ?Ң)
+ (#x685 . ?Ү)
+ (#x686 . ?Ұ)
+ (#x687 . ?Ҳ)
+ (#x688 . ?Ҷ)
+ (#x689 . ?Ҹ)
+ (#x68a . ?Һ)
+ (#x68c . ?Ә)
+ (#x68d . ?Ӣ)
+ (#x68e . ?Ө)
+ (#x68f . ?Ӯ)
+ (#x690 . ?ғ)
+ (#x691 . ?җ)
+ (#x692 . ?қ)
+ (#x693 . ?ҝ)
+ (#x694 . ?ң)
+ (#x695 . ?ү)
+ (#x696 . ?ұ)
+ (#x697 . ?ҳ)
+ (#x698 . ?ҷ)
+ (#x699 . ?ҹ)
+ (#x69a . ?һ)
+ (#x69c . ?ә)
+ (#x69d . ?ӣ)
+ (#x69e . ?ө)
+ (#x69f . ?ӯ)
+ (#x6a1 . ?ђ)
+ (#x6a2 . ?ѓ)
+ (#x6a3 . ?ё)
+ (#x6a4 . ?є)
+ (#x6a5 . ?ѕ)
+ (#x6a6 . ?і)
+ (#x6a7 . ?ї)
+ (#x6a8 . ?ј)
+ (#x6a9 . ?љ)
+ (#x6aa . ?њ)
+ (#x6ab . ?ћ)
+ (#x6ac . ?ќ)
+ (#x6ae . ?ў)
+ (#x6af . ?џ)
+ (#x6b0 . ?№)
+ (#x6b1 . ?Ђ)
+ (#x6b2 . ?Ѓ)
+ (#x6b3 . ?Ё)
+ (#x6b4 . ?Є)
+ (#x6b5 . ?Ѕ)
+ (#x6b6 . ?І)
+ (#x6b7 . ?Ї)
+ (#x6b8 . ?Ј)
+ (#x6b9 . ?Љ)
+ (#x6ba . ?Њ)
+ (#x6bb . ?Ћ)
+ (#x6bc . ?Ќ)
+ (#x6be . ?Ў)
+ (#x6bf . ?Џ)
+ (#x6c0 . ?ю)
+ (#x6c1 . ?а)
+ (#x6c2 . ?б)
+ (#x6c3 . ?ц)
+ (#x6c4 . ?д)
+ (#x6c5 . ?е)
+ (#x6c6 . ?ф)
+ (#x6c7 . ?г)
+ (#x6c8 . ?х)
+ (#x6c9 . ?и)
+ (#x6ca . ?й)
+ (#x6cb . ?к)
+ (#x6cc . ?л)
+ (#x6cd . ?м)
+ (#x6ce . ?н)
+ (#x6cf . ?о)
+ (#x6d0 . ?п)
+ (#x6d1 . ?я)
+ (#x6d2 . ?р)
+ (#x6d3 . ?с)
+ (#x6d4 . ?т)
+ (#x6d5 . ?у)
+ (#x6d6 . ?ж)
+ (#x6d7 . ?в)
+ (#x6d8 . ?ь)
+ (#x6d9 . ?ы)
+ (#x6da . ?з)
+ (#x6db . ?ш)
+ (#x6dc . ?э)
+ (#x6dd . ?щ)
+ (#x6de . ?ч)
+ (#x6df . ?ъ)
+ (#x6e0 . ?Ю)
+ (#x6e1 . ?А)
+ (#x6e2 . ?Б)
+ (#x6e3 . ?Ц)
+ (#x6e4 . ?Д)
+ (#x6e5 . ?Е)
+ (#x6e6 . ?Ф)
+ (#x6e7 . ?Г)
+ (#x6e8 . ?Х)
+ (#x6e9 . ?И)
+ (#x6ea . ?Й)
+ (#x6eb . ?К)
+ (#x6ec . ?Л)
+ (#x6ed . ?М)
+ (#x6ee . ?Н)
+ (#x6ef . ?О)
+ (#x6f0 . ?П)
+ (#x6f1 . ?Я)
+ (#x6f2 . ?Р)
+ (#x6f3 . ?С)
+ (#x6f4 . ?Т)
+ (#x6f5 . ?У)
+ (#x6f6 . ?Ж)
+ (#x6f7 . ?В)
+ (#x6f8 . ?Ь)
+ (#x6f9 . ?Ы)
+ (#x6fa . ?З)
+ (#x6fb . ?Ш)
+ (#x6fc . ?Э)
+ (#x6fd . ?Щ)
+ (#x6fe . ?Ч)
+ (#x6ff . ?Ъ)
;; Greek
- (#x7a1 . ?,F6(B)
- (#x7a2 . ?,F8(B)
- (#x7a3 . ?,F9(B)
- (#x7a4 . ?,F:(B)
- (#x7a5 . ?,FZ(B)
- (#x7a7 . ?,F<(B)
- (#x7a8 . ?,F>(B)
- (#x7a9 . ?,F[(B)
- (#x7ab . ?,F?(B)
- (#x7ae . ?,F5(B)
- (#x7af . ?,F/(B)
- (#x7b1 . ?,F\(B)
- (#x7b2 . ?,F](B)
- (#x7b3 . ?,F^(B)
- (#x7b4 . ?,F_(B)
- (#x7b5 . ?,Fz(B)
- (#x7b6 . ?,F@(B)
- (#x7b7 . ?,F|(B)
- (#x7b8 . ?,F}(B)
- (#x7b9 . ?,F{(B)
- (#x7ba . ?,F`(B)
- (#x7bb . ?,F~(B)
- (#x7c1 . ?,FA(B)
- (#x7c2 . ?,FB(B)
- (#x7c3 . ?,FC(B)
- (#x7c4 . ?,FD(B)
- (#x7c5 . ?,FE(B)
- (#x7c6 . ?,FF(B)
- (#x7c7 . ?,FG(B)
- (#x7c8 . ?,FH(B)
- (#x7c9 . ?,FI(B)
- (#x7ca . ?,FJ(B)
- (#x7cb . ?,FK(B)
- (#x7cc . ?,FL(B)
- (#x7cd . ?,FM(B)
- (#x7ce . ?,FN(B)
- (#x7cf . ?,FO(B)
- (#x7d0 . ?,FP(B)
- (#x7d1 . ?,FQ(B)
- (#x7d2 . ?,FS(B)
- (#x7d4 . ?,FT(B)
- (#x7d5 . ?,FU(B)
- (#x7d6 . ?,FV(B)
- (#x7d7 . ?,FW(B)
- (#x7d8 . ?,FX(B)
- (#x7d9 . ?,FY(B)
- (#x7e1 . ?,Fa(B)
- (#x7e2 . ?,Fb(B)
- (#x7e3 . ?,Fc(B)
- (#x7e4 . ?,Fd(B)
- (#x7e5 . ?,Fe(B)
- (#x7e6 . ?,Ff(B)
- (#x7e7 . ?,Fg(B)
- (#x7e8 . ?,Fh(B)
- (#x7e9 . ?,Fi(B)
- (#x7ea . ?,Fj(B)
- (#x7eb . ?,Fk(B)
- (#x7ec . ?,Fl(B)
- (#x7ed . ?,Fm(B)
- (#x7ee . ?,Fn(B)
- (#x7ef . ?,Fo(B)
- (#x7f0 . ?,Fp(B)
- (#x7f1 . ?,Fq(B)
- (#x7f2 . ?,Fs(B)
- (#x7f3 . ?,Fr(B)
- (#x7f4 . ?,Ft(B)
- (#x7f5 . ?,Fu(B)
- (#x7f6 . ?,Fv(B)
- (#x7f7 . ?,Fw(B)
- (#x7f8 . ?,Fx(B)
- (#x7f9 . ?,Fy(B)
+ (#x7a1 . ?Ά)
+ (#x7a2 . ?Έ)
+ (#x7a3 . ?Ή)
+ (#x7a4 . ?Ί)
+ (#x7a5 . ?Ϊ)
+ (#x7a7 . ?Ό)
+ (#x7a8 . ?Ύ)
+ (#x7a9 . ?Ϋ)
+ (#x7ab . ?Ώ)
+ (#x7ae . ?΅)
+ (#x7af . ?―)
+ (#x7b1 . ?ά)
+ (#x7b2 . ?έ)
+ (#x7b3 . ?ή)
+ (#x7b4 . ?ί)
+ (#x7b5 . ?ϊ)
+ (#x7b6 . ?ΐ)
+ (#x7b7 . ?ό)
+ (#x7b8 . ?ύ)
+ (#x7b9 . ?ϋ)
+ (#x7ba . ?ΰ)
+ (#x7bb . ?ώ)
+ (#x7c1 . ?Α)
+ (#x7c2 . ?Β)
+ (#x7c3 . ?Γ)
+ (#x7c4 . ?Δ)
+ (#x7c5 . ?Ε)
+ (#x7c6 . ?Ζ)
+ (#x7c7 . ?Η)
+ (#x7c8 . ?Θ)
+ (#x7c9 . ?Ι)
+ (#x7ca . ?Κ)
+ (#x7cb . ?Λ)
+ (#x7cc . ?Μ)
+ (#x7cd . ?Ν)
+ (#x7ce . ?Ξ)
+ (#x7cf . ?Ο)
+ (#x7d0 . ?Π)
+ (#x7d1 . ?Ρ)
+ (#x7d2 . ?Σ)
+ (#x7d4 . ?Τ)
+ (#x7d5 . ?Υ)
+ (#x7d6 . ?Φ)
+ (#x7d7 . ?Χ)
+ (#x7d8 . ?Ψ)
+ (#x7d9 . ?Ω)
+ (#x7e1 . ?α)
+ (#x7e2 . ?β)
+ (#x7e3 . ?γ)
+ (#x7e4 . ?δ)
+ (#x7e5 . ?ε)
+ (#x7e6 . ?ζ)
+ (#x7e7 . ?η)
+ (#x7e8 . ?θ)
+ (#x7e9 . ?ι)
+ (#x7ea . ?κ)
+ (#x7eb . ?λ)
+ (#x7ec . ?μ)
+ (#x7ed . ?ν)
+ (#x7ee . ?ξ)
+ (#x7ef . ?ο)
+ (#x7f0 . ?π)
+ (#x7f1 . ?ρ)
+ (#x7f2 . ?σ)
+ (#x7f3 . ?ς)
+ (#x7f4 . ?τ)
+ (#x7f5 . ?υ)
+ (#x7f6 . ?φ)
+ (#x7f7 . ?χ)
+ (#x7f8 . ?ψ)
+ (#x7f9 . ?ω)
;; Technical
- (#x8a1 . ?$,1|W(B)
- (#x8a2 . ?$A)0(B)
- (#x8a3 . ?$A)$(B)
- (#x8a4 . ?$,1{ (B)
- (#x8a5 . ?$,1{!(B)
- (#x8a6 . ?$A)&(B)
- (#x8a7 . ?$,1|A(B)
- (#x8a8 . ?$,1|C(B)
- (#x8a9 . ?$,1|D(B)
- (#x8aa . ?$,1|F(B)
- (#x8ab . ?$,1|;(B)
- (#x8ac . ?$,1|=(B)
- (#x8ad . ?$,1|>(B)
- (#x8ae . ?$,1|@(B)
- (#x8af . ?$,1|H(B)
- (#x8b0 . ?$,1|L(B)
- (#x8bc . ?$A!\(B)
- (#x8bd . ?$A!Y(B)
- (#x8be . ?$A!](B)
- (#x8bf . ?$A!R(B)
- (#x8c0 . ?$A!`(B)
- (#x8c1 . ?$A!X(B)
- (#x8c2 . ?$A!^(B)
- (#x8c5 . ?$B"`(B)
- (#x8c8 . ?$(G"D(B)
- (#x8c9 . ?$(O"l(B)
- (#x8cd . ?$B"N(B)
- (#x8ce . ?$B"M(B)
- (#x8cf . ?$A!T(B)
- (#x8d6 . ?$A!L(B)
- (#x8da . ?$B">(B)
- (#x8db . ?$B"?(B)
- (#x8dc . ?$A!I(B)
- (#x8dd . ?$A!H(B)
- (#x8de . ?$A!D(B)
- (#x8df . ?$A!E(B)
- (#x8ef . ?$B"_(B)
- (#x8f6 . ?$,1!R(B)
- (#x8fb . ?$A!{(B)
- (#x8fc . ?$A!|(B)
- (#x8fd . ?$A!z(B)
- (#x8fe . ?$A!}(B)
+ (#x8a1 . ?⎷)
+ (#x8a2 . ?┌)
+ (#x8a3 . ?─)
+ (#x8a4 . ?⌠)
+ (#x8a5 . ?⌡)
+ (#x8a6 . ?│)
+ (#x8a7 . ?⎡)
+ (#x8a8 . ?⎣)
+ (#x8a9 . ?⎤)
+ (#x8aa . ?⎦)
+ (#x8ab . ?⎛)
+ (#x8ac . ?⎝)
+ (#x8ad . ?⎞)
+ (#x8ae . ?⎠)
+ (#x8af . ?⎨)
+ (#x8b0 . ?⎬)
+ (#x8bc . ?≤)
+ (#x8bd . ?≠)
+ (#x8be . ?≥)
+ (#x8bf . ?∫)
+ (#x8c0 . ?∴)
+ (#x8c1 . ?∝)
+ (#x8c2 . ?∞)
+ (#x8c5 . ?∇)
+ (#x8c8 . ?∼)
+ (#x8c9 . ?≃)
+ (#x8cd . ?⇔)
+ (#x8ce . ?⇒)
+ (#x8cf . ?≡)
+ (#x8d6 . ?√)
+ (#x8da . ?⊂)
+ (#x8db . ?⊃)
+ (#x8dc . ?∩)
+ (#x8dd . ?∪)
+ (#x8de . ?∧)
+ (#x8df . ?∨)
+ (#x8ef . ?∂)
+ (#x8f6 . ?ƒ)
+ (#x8fb . ?←)
+ (#x8fc . ?↑)
+ (#x8fd . ?→)
+ (#x8fe . ?↓)
;; Special
- (#x9e0 . ?$A!t(B)
- (#x9e1 . ?$(C"F(B)
- (#x9e2 . ?$(GB*(B)
- (#x9e3 . ?$(GB-(B)
- (#x9e4 . ?$(GB.(B)
- (#x9e5 . ?$(GB+(B)
- (#x9e8 . ?$,1}d(B)
- (#x9e9 . ?$(GB,(B)
- (#x9ea . ?$A)<(B)
- (#x9eb . ?$A)4(B)
- (#x9ec . ?$A)0(B)
- (#x9ed . ?$A)8(B)
- (#x9ee . ?$A)`(B)
- (#x9ef . ?$,1|Z(B)
- (#x9f0 . ?$,1|[(B)
- (#x9f1 . ?$A)$(B)
- (#x9f2 . ?$,1|\(B)
- (#x9f3 . ?$,1|](B)
- (#x9f4 . ?$A)@(B)
- (#x9f5 . ?$A)H(B)
- (#x9f6 . ?$A)X(B)
- (#x9f7 . ?$A)P(B)
- (#x9f8 . ?$A)&(B)
+ (#x9e0 . ?◆)
+ (#x9e1 . ?▒)
+ (#x9e2 . ?␉)
+ (#x9e3 . ?␌)
+ (#x9e4 . ?␍)
+ (#x9e5 . ?␊)
+ (#x9e8 . ?␤)
+ (#x9e9 . ?␋)
+ (#x9ea . ?┘)
+ (#x9eb . ?┐)
+ (#x9ec . ?┌)
+ (#x9ed . ?└)
+ (#x9ee . ?┼)
+ (#x9ef . ?⎺)
+ (#x9f0 . ?⎻)
+ (#x9f1 . ?─)
+ (#x9f2 . ?⎼)
+ (#x9f3 . ?⎽)
+ (#x9f4 . ?├)
+ (#x9f5 . ?┤)
+ (#x9f6 . ?┴)
+ (#x9f7 . ?┬)
+ (#x9f8 . ?│)
;; Publishing
- (#xaa1 . ?$,1rc(B)
- (#xaa2 . ?$,1rb(B)
- (#xaa3 . ?$,1rd(B)
- (#xaa4 . ?$,1re(B)
- (#xaa5 . ?$,1rg(B)
- (#xaa6 . ?$,1rh(B)
- (#xaa7 . ?$,1ri(B)
- (#xaa8 . ?$,1rj(B)
- (#xaa9 . ?$(G!7(B)
- (#xaaa . ?$(G!9(B)
- (#xaae . ?$A!-(B)
- (#xaaf . ?$(G!-(B)
- (#xab0 . ?$(O'x(B)
- (#xab1 . ?$(O'y(B)
- (#xab2 . ?$(O'z(B)
- (#xab3 . ?$,1v6(B)
- (#xab4 . ?$,1v7(B)
- (#xab5 . ?$,1v8(B)
- (#xab6 . ?$,1v9(B)
- (#xab7 . ?$,1v:(B)
- (#xab8 . ?$(G""(B)
- (#xabb . ?$,1rr(B)
- (#xabc . ?$,1{)(B)
- (#xabe . ?$,1{*(B)
- (#xac3 . ?$(C({(B)
- (#xac4 . ?$(C(|(B)
- (#xac5 . ?$(C(}(B)
- (#xac6 . ?$(C(~(B)
- (#xac9 . ?$(D"o(B)
- (#xaca . ?$,2"s(B)
- (#xacc . ?$(O##(B)
- (#xacd . ?$(O#!(B)
- (#xace . ?$A!p(B)
- (#xacf . ?$,2!o(B)
- (#xad0 . ?,F!(B)
- (#xad1 . ?,F"(B)
- (#xad2 . ?,Y4(B)
- (#xad3 . ?,Y!(B)
- (#xad4 . ?$,1u^(B)
- (#xad6 . ?$A!d(B)
- (#xad7 . ?$A!e(B)
- (#xad9 . ?$,2%](B)
- (#xadb . ?$,2!l(B)
- (#xadc . ?$(O#$(B)
- (#xadd . ?$(O#"(B)
- (#xade . ?$A!q(B)
- (#xadf . ?$,2!n(B)
- (#xae0 . ?$(O#?(B)
- (#xae1 . ?$,2!k(B)
- (#xae2 . ?$,2!m(B)
- (#xae3 . ?$A!w(B)
- (#xae4 . ?$(G!}(B)
- (#xae5 . ?$A!n(B)
- (#xae6 . ?$(O#@(B)
- (#xae7 . ?$,2!j(B)
- (#xae8 . ?$A!x(B)
- (#xae9 . ?$(G!~(B)
- (#xaea . ?$(C"P(B)
- (#xaeb . ?$(O-~(B)
- (#xaec . ?$(O&@(B)
- (#xaed . ?$(O&<(B)
- (#xaee . ?$(O&>(B)
- (#xaf0 . ?$,2%`(B)
- (#xaf1 . ?$B"w(B)
- (#xaf2 . ?$B"x(B)
- (#xaf3 . ?$(O'{(B)
- (#xaf4 . ?$,2%W(B)
- (#xaf5 . ?$B"t(B)
- (#xaf6 . ?$B"u(B)
- (#xaf7 . ?$A!a(B)
- (#xaf8 . ?$A!b(B)
- (#xaf9 . ?$(O&g(B)
- (#xafa . ?$,1zu(B)
- (#xafb . ?$,1uW(B)
- (#xafc . ?$,1s8(B)
- (#xafd . ?$,1rz(B)
- (#xafe . ?,Y%(B)
+ (#xaa1 . ? )
+ (#xaa2 . ? )
+ (#xaa3 . ? )
+ (#xaa4 . ? )
+ (#xaa5 . ? )
+ (#xaa6 . ? )
+ (#xaa7 . ? )
+ (#xaa8 . ? )
+ (#xaa9 . ?—)
+ (#xaaa . ?–)
+ (#xaae . ?…)
+ (#xaaf . ?‥)
+ (#xab0 . ?⅓)
+ (#xab1 . ?⅔)
+ (#xab2 . ?⅕)
+ (#xab3 . ?⅖)
+ (#xab4 . ?⅗)
+ (#xab5 . ?⅘)
+ (#xab6 . ?⅙)
+ (#xab7 . ?⅚)
+ (#xab8 . ?℅)
+ (#xabb . ?‒)
+ (#xabc . ?〈)
+ (#xabe . ?〉)
+ (#xac3 . ?⅛)
+ (#xac4 . ?⅜)
+ (#xac5 . ?⅝)
+ (#xac6 . ?⅞)
+ (#xac9 . ?™)
+ (#xaca . ?☓)
+ (#xacc . ?◁)
+ (#xacd . ?▷)
+ (#xace . ?○)
+ (#xacf . ?▯)
+ (#xad0 . ?‘)
+ (#xad1 . ?’)
+ (#xad2 . ?“)
+ (#xad3 . ?”)
+ (#xad4 . ?℞)
+ (#xad6 . ?′)
+ (#xad7 . ?″)
+ (#xad9 . ?✝)
+ (#xadb . ?▬)
+ (#xadc . ?◀)
+ (#xadd . ?▶)
+ (#xade . ?●)
+ (#xadf . ?▮)
+ (#xae0 . ?◦)
+ (#xae1 . ?▫)
+ (#xae2 . ?▭)
+ (#xae3 . ?△)
+ (#xae4 . ?▽)
+ (#xae5 . ?☆)
+ (#xae6 . ?•)
+ (#xae7 . ?▪)
+ (#xae8 . ?▲)
+ (#xae9 . ?▼)
+ (#xaea . ?☜)
+ (#xaeb . ?☞)
+ (#xaec . ?♣)
+ (#xaed . ?♦)
+ (#xaee . ?♥)
+ (#xaf0 . ?✠)
+ (#xaf1 . ?†)
+ (#xaf2 . ?‡)
+ (#xaf3 . ?✓)
+ (#xaf4 . ?✗)
+ (#xaf5 . ?♯)
+ (#xaf6 . ?♭)
+ (#xaf7 . ?♂)
+ (#xaf8 . ?♀)
+ (#xaf9 . ?☎)
+ (#xafa . ?⌕)
+ (#xafb . ?℗)
+ (#xafc . ?‸)
+ (#xafd . ?‚)
+ (#xafe . ?„)
;; APL
(#xba3 . ?<)
(#xba6 . ?>)
- (#xba8 . ?$A!E(B)
- (#xba9 . ?$A!D(B)
- (#xbc0 . ?,A/(B)
- (#xbc2 . ?$A!M(B)
- (#xbc3 . ?$A!I(B)
- (#xbc4 . ?$,1zj(B)
+ (#xba8 . ?∨)
+ (#xba9 . ?∧)
+ (#xbc0 . ?¯)
+ (#xbc2 . ?⊥)
+ (#xbc3 . ?∩)
+ (#xbc4 . ?⌊)
(#xbc6 . ?_)
- (#xbca . ?$,1x8(B)
- (#xbcc . ?$,1|5(B)
- (#xbce . ?$,1yd(B)
- (#xbcf . ?$A!p(B)
- (#xbd3 . ?$,1zh(B)
- (#xbd6 . ?$A!H(B)
- (#xbd8 . ?$B"?(B)
- (#xbda . ?$B">(B)
- (#xbdc . ?$,1yb(B)
- (#xbfc . ?$,1yc(B)
+ (#xbca . ?∘)
+ (#xbcc . ?⎕)
+ (#xbce . ?⊤)
+ (#xbcf . ?○)
+ (#xbd3 . ?⌈)
+ (#xbd6 . ?∪)
+ (#xbd8 . ?⊃)
+ (#xbda . ?⊂)
+ (#xbdc . ?⊢)
+ (#xbfc . ?⊣)
;; Hebrew
- (#xcdf . ?,H_(B)
- (#xce0 . ?,H`(B)
- (#xce1 . ?,Ha(B)
- (#xce2 . ?,Hb(B)
- (#xce3 . ?,Hc(B)
- (#xce4 . ?,Hd(B)
- (#xce5 . ?,He(B)
- (#xce6 . ?,Hf(B)
- (#xce7 . ?,Hg(B)
- (#xce8 . ?,Hh(B)
- (#xce9 . ?,Hi(B)
- (#xcea . ?,Hj(B)
- (#xceb . ?,Hk(B)
- (#xcec . ?,Hl(B)
- (#xced . ?,Hm(B)
- (#xcee . ?,Hn(B)
- (#xcef . ?,Ho(B)
- (#xcf0 . ?,Hp(B)
- (#xcf1 . ?,Hq(B)
- (#xcf2 . ?,Hr(B)
- (#xcf3 . ?,Hs(B)
- (#xcf4 . ?,Ht(B)
- (#xcf5 . ?,Hu(B)
- (#xcf6 . ?,Hv(B)
- (#xcf7 . ?,Hw(B)
- (#xcf8 . ?,Hx(B)
- (#xcf9 . ?,Hy(B)
- (#xcfa . ?,Hz(B)
+ (#xcdf . ?‗)
+ (#xce0 . ?א)
+ (#xce1 . ?ב)
+ (#xce2 . ?ג)
+ (#xce3 . ?ד)
+ (#xce4 . ?ה)
+ (#xce5 . ?ו)
+ (#xce6 . ?ז)
+ (#xce7 . ?ח)
+ (#xce8 . ?ט)
+ (#xce9 . ?י)
+ (#xcea . ?ך)
+ (#xceb . ?כ)
+ (#xcec . ?ל)
+ (#xced . ?ם)
+ (#xcee . ?מ)
+ (#xcef . ?ן)
+ (#xcf0 . ?נ)
+ (#xcf1 . ?ס)
+ (#xcf2 . ?ע)
+ (#xcf3 . ?ף)
+ (#xcf4 . ?פ)
+ (#xcf5 . ?ץ)
+ (#xcf6 . ?צ)
+ (#xcf7 . ?ק)
+ (#xcf8 . ?ר)
+ (#xcf9 . ?ש)
+ (#xcfa . ?ת)
;; Thai
- (#xda1 . ?,T!(B)
- (#xda2 . ?,T"(B)
- (#xda3 . ?,T#(B)
- (#xda4 . ?,T$(B)
- (#xda5 . ?,T%(B)
- (#xda6 . ?,T&(B)
- (#xda7 . ?,T'(B)
- (#xda8 . ?,T((B)
- (#xda9 . ?,T)(B)
- (#xdaa . ?,T*(B)
- (#xdab . ?,T+(B)
- (#xdac . ?,T,(B)
- (#xdad . ?,T-(B)
- (#xdae . ?,T.(B)
- (#xdaf . ?,T/(B)
- (#xdb0 . ?,T0(B)
- (#xdb1 . ?,T1(B)
- (#xdb2 . ?,T2(B)
- (#xdb3 . ?,T3(B)
- (#xdb4 . ?,T4(B)
- (#xdb5 . ?,T5(B)
- (#xdb6 . ?,T6(B)
- (#xdb7 . ?,T7(B)
- (#xdb8 . ?,T8(B)
- (#xdb9 . ?,T9(B)
- (#xdba . ?,T:(B)
- (#xdbb . ?,T;(B)
- (#xdbc . ?,T<(B)
- (#xdbd . ?,T=(B)
- (#xdbe . ?,T>(B)
- (#xdbf . ?,T?(B)
- (#xdc0 . ?,T@(B)
- (#xdc1 . ?,TA(B)
- (#xdc2 . ?,TB(B)
- (#xdc3 . ?,TC(B)
- (#xdc4 . ?,TD(B)
- (#xdc5 . ?,TE(B)
- (#xdc6 . ?,TF(B)
- (#xdc7 . ?,TG(B)
- (#xdc8 . ?,TH(B)
- (#xdc9 . ?,TI(B)
- (#xdca . ?,TJ(B)
- (#xdcb . ?,TK(B)
- (#xdcc . ?,TL(B)
- (#xdcd . ?,TM(B)
- (#xdce . ?,TN(B)
- (#xdcf . ?,TO(B)
- (#xdd0 . ?,TP(B)
- (#xdd1 . ?,TQ(B)
- (#xdd2 . ?,TR(B)
- (#xdd3 . ?,TS(B)
- (#xdd4 . ?,TT(B)
- (#xdd5 . ?,TU(B)
- (#xdd6 . ?,TV(B)
- (#xdd7 . ?,TW(B)
- (#xdd8 . ?,TX(B)
- (#xdd9 . ?,TY(B)
- (#xdda . ?,TZ(B)
- (#xddf . ?,T_(B)
- (#xde0 . ?,T`(B)
- (#xde1 . ?,Ta(B)
- (#xde2 . ?,Tb(B)
- (#xde3 . ?,Tc(B)
- (#xde4 . ?,Td(B)
- (#xde5 . ?,Te(B)
- (#xde6 . ?,Tf(B)
- (#xde7 . ?,Tg(B)
- (#xde8 . ?,Th(B)
- (#xde9 . ?,Ti(B)
- (#xdea . ?,Tj(B)
- (#xdeb . ?,Tk(B)
- (#xdec . ?,Tl(B)
- (#xded . ?,Tm(B)
- (#xdf0 . ?,Tp(B)
- (#xdf1 . ?,Tq(B)
- (#xdf2 . ?,Tr(B)
- (#xdf3 . ?,Ts(B)
- (#xdf4 . ?,Tt(B)
- (#xdf5 . ?,Tu(B)
- (#xdf6 . ?,Tv(B)
- (#xdf7 . ?,Tw(B)
- (#xdf8 . ?,Tx(B)
- (#xdf9 . ?,Ty(B)
+ (#xda1 . ?ก)
+ (#xda2 . ?ข)
+ (#xda3 . ?ฃ)
+ (#xda4 . ?ค)
+ (#xda5 . ?ฅ)
+ (#xda6 . ?ฆ)
+ (#xda7 . ?ง)
+ (#xda8 . ?จ)
+ (#xda9 . ?ฉ)
+ (#xdaa . ?ช)
+ (#xdab . ?ซ)
+ (#xdac . ?ฌ)
+ (#xdad . ?ญ)
+ (#xdae . ?ฎ)
+ (#xdaf . ?ฏ)
+ (#xdb0 . ?ฐ)
+ (#xdb1 . ?ฑ)
+ (#xdb2 . ?ฒ)
+ (#xdb3 . ?ณ)
+ (#xdb4 . ?ด)
+ (#xdb5 . ?ต)
+ (#xdb6 . ?ถ)
+ (#xdb7 . ?ท)
+ (#xdb8 . ?ธ)
+ (#xdb9 . ?น)
+ (#xdba . ?บ)
+ (#xdbb . ?ป)
+ (#xdbc . ?ผ)
+ (#xdbd . ?ฝ)
+ (#xdbe . ?พ)
+ (#xdbf . ?ฟ)
+ (#xdc0 . ?ภ)
+ (#xdc1 . ?ม)
+ (#xdc2 . ?ย)
+ (#xdc3 . ?ร)
+ (#xdc4 . ?ฤ)
+ (#xdc5 . ?ล)
+ (#xdc6 . ?ฦ)
+ (#xdc7 . ?ว)
+ (#xdc8 . ?ศ)
+ (#xdc9 . ?ษ)
+ (#xdca . ?ส)
+ (#xdcb . ?ห)
+ (#xdcc . ?ฬ)
+ (#xdcd . ?อ)
+ (#xdce . ?ฮ)
+ (#xdcf . ?ฯ)
+ (#xdd0 . ?ะ)
+ (#xdd1 . ?ั)
+ (#xdd2 . ?า)
+ (#xdd3 . ?ำ)
+ (#xdd4 . ?ิ)
+ (#xdd5 . ?ี)
+ (#xdd6 . ?ึ)
+ (#xdd7 . ?ื)
+ (#xdd8 . ?ุ)
+ (#xdd9 . ?ู)
+ (#xdda . ?ฺ)
+ (#xddf . ?฿)
+ (#xde0 . ?เ)
+ (#xde1 . ?แ)
+ (#xde2 . ?โ)
+ (#xde3 . ?ใ)
+ (#xde4 . ?ไ)
+ (#xde5 . ?ๅ)
+ (#xde6 . ?ๆ)
+ (#xde7 . ?็)
+ (#xde8 . ?่)
+ (#xde9 . ?้)
+ (#xdea . ?๊)
+ (#xdeb . ?๋)
+ (#xdec . ?์)
+ (#xded . ?ํ)
+ (#xdf0 . ?๐)
+ (#xdf1 . ?๑)
+ (#xdf2 . ?๒)
+ (#xdf3 . ?๓)
+ (#xdf4 . ?๔)
+ (#xdf5 . ?๕)
+ (#xdf6 . ?๖)
+ (#xdf7 . ?๗)
+ (#xdf8 . ?๘)
+ (#xdf9 . ?๙)
;; Korean
- (#xea1 . ?$(C$!(B)
- (#xea2 . ?$(C$"(B)
- (#xea3 . ?$(C$#(B)
- (#xea4 . ?$(C$$(B)
- (#xea5 . ?$(C$%(B)
- (#xea6 . ?$(C$&(B)
- (#xea7 . ?$(C$'(B)
- (#xea8 . ?$(C$((B)
- (#xea9 . ?$(C$)(B)
- (#xeaa . ?$(C$*(B)
- (#xeab . ?$(C$+(B)
- (#xeac . ?$(C$,(B)
- (#xead . ?$(C$-(B)
- (#xeae . ?$(C$.(B)
- (#xeaf . ?$(C$/(B)
- (#xeb0 . ?$(C$0(B)
- (#xeb1 . ?$(C$1(B)
- (#xeb2 . ?$(C$2(B)
- (#xeb3 . ?$(C$3(B)
- (#xeb4 . ?$(C$4(B)
- (#xeb5 . ?$(C$5(B)
- (#xeb6 . ?$(C$6(B)
- (#xeb7 . ?$(C$7(B)
- (#xeb8 . ?$(C$8(B)
- (#xeb9 . ?$(C$9(B)
- (#xeba . ?$(C$:(B)
- (#xebb . ?$(C$;(B)
- (#xebc . ?$(C$<(B)
- (#xebd . ?$(C$=(B)
- (#xebe . ?$(C$>(B)
- (#xebf . ?$(C$?(B)
- (#xec0 . ?$(C$@(B)
- (#xec1 . ?$(C$A(B)
- (#xec2 . ?$(C$B(B)
- (#xec3 . ?$(C$C(B)
- (#xec4 . ?$(C$D(B)
- (#xec5 . ?$(C$E(B)
- (#xec6 . ?$(C$F(B)
- (#xec7 . ?$(C$G(B)
- (#xec8 . ?$(C$H(B)
- (#xec9 . ?$(C$I(B)
- (#xeca . ?$(C$J(B)
- (#xecb . ?$(C$K(B)
- (#xecc . ?$(C$L(B)
- (#xecd . ?$(C$M(B)
- (#xece . ?$(C$N(B)
- (#xecf . ?$(C$O(B)
- (#xed0 . ?$(C$P(B)
- (#xed1 . ?$(C$Q(B)
- (#xed2 . ?$(C$R(B)
- (#xed3 . ?$(C$S(B)
- (#xed4 . ?$,1LH(B)
- (#xed5 . ?$,1LI(B)
- (#xed6 . ?$,1LJ(B)
- (#xed7 . ?$,1LK(B)
- (#xed8 . ?$,1LL(B)
- (#xed9 . ?$,1LM(B)
- (#xeda . ?$,1LN(B)
- (#xedb . ?$,1LO(B)
- (#xedc . ?$,1LP(B)
- (#xedd . ?$,1LQ(B)
- (#xede . ?$,1LR(B)
- (#xedf . ?$,1LS(B)
- (#xee0 . ?$,1LT(B)
- (#xee1 . ?$,1LU(B)
- (#xee2 . ?$,1LV(B)
- (#xee3 . ?$,1LW(B)
- (#xee4 . ?$,1LX(B)
- (#xee5 . ?$,1LY(B)
- (#xee6 . ?$,1LZ(B)
- (#xee7 . ?$,1L[(B)
- (#xee8 . ?$,1L\(B)
- (#xee9 . ?$,1L](B)
- (#xeea . ?$,1L^(B)
- (#xeeb . ?$,1L_(B)
- (#xeec . ?$,1L`(B)
- (#xeed . ?$,1La(B)
- (#xeee . ?$,1Lb(B)
- (#xeef . ?$(C$](B)
- (#xef0 . ?$(C$a(B)
- (#xef1 . ?$(C$h(B)
- (#xef2 . ?$(C$o(B)
- (#xef3 . ?$(C$q(B)
- (#xef4 . ?$(C$t(B)
- (#xef5 . ?$(C$v(B)
- (#xef6 . ?$(C$}(B)
- (#xef7 . ?$(C$~(B)
- (#xef8 . ?$,1M+(B)
- (#xef9 . ?$,1M0(B)
- (#xefa . ?$,1M9(B)
- (#xeff . ?$,1tI(B)
+ (#xea1 . ?ㄱ)
+ (#xea2 . ?ㄲ)
+ (#xea3 . ?ㄳ)
+ (#xea4 . ?ㄴ)
+ (#xea5 . ?ㄵ)
+ (#xea6 . ?ㄶ)
+ (#xea7 . ?ㄷ)
+ (#xea8 . ?ㄸ)
+ (#xea9 . ?ㄹ)
+ (#xeaa . ?ㄺ)
+ (#xeab . ?ㄻ)
+ (#xeac . ?ㄼ)
+ (#xead . ?ㄽ)
+ (#xeae . ?ㄾ)
+ (#xeaf . ?ㄿ)
+ (#xeb0 . ?ㅀ)
+ (#xeb1 . ?ㅁ)
+ (#xeb2 . ?ㅂ)
+ (#xeb3 . ?ㅃ)
+ (#xeb4 . ?ㅄ)
+ (#xeb5 . ?ㅅ)
+ (#xeb6 . ?ㅆ)
+ (#xeb7 . ?ㅇ)
+ (#xeb8 . ?ㅈ)
+ (#xeb9 . ?ㅉ)
+ (#xeba . ?ㅊ)
+ (#xebb . ?ㅋ)
+ (#xebc . ?ㅌ)
+ (#xebd . ?ㅍ)
+ (#xebe . ?ㅎ)
+ (#xebf . ?ㅏ)
+ (#xec0 . ?ㅐ)
+ (#xec1 . ?ㅑ)
+ (#xec2 . ?ㅒ)
+ (#xec3 . ?ㅓ)
+ (#xec4 . ?ㅔ)
+ (#xec5 . ?ㅕ)
+ (#xec6 . ?ㅖ)
+ (#xec7 . ?ㅗ)
+ (#xec8 . ?ㅘ)
+ (#xec9 . ?ㅙ)
+ (#xeca . ?ㅚ)
+ (#xecb . ?ㅛ)
+ (#xecc . ?ㅜ)
+ (#xecd . ?ㅝ)
+ (#xece . ?ㅞ)
+ (#xecf . ?ㅟ)
+ (#xed0 . ?ㅠ)
+ (#xed1 . ?ㅡ)
+ (#xed2 . ?ㅢ)
+ (#xed3 . ?ㅣ)
+ (#xed4 . ?ᆨ)
+ (#xed5 . ?ᆩ)
+ (#xed6 . ?ᆪ)
+ (#xed7 . ?ᆫ)
+ (#xed8 . ?ᆬ)
+ (#xed9 . ?ᆭ)
+ (#xeda . ?ᆮ)
+ (#xedb . ?ᆯ)
+ (#xedc . ?ᆰ)
+ (#xedd . ?ᆱ)
+ (#xede . ?ᆲ)
+ (#xedf . ?ᆳ)
+ (#xee0 . ?ᆴ)
+ (#xee1 . ?ᆵ)
+ (#xee2 . ?ᆶ)
+ (#xee3 . ?ᆷ)
+ (#xee4 . ?ᆸ)
+ (#xee5 . ?ᆹ)
+ (#xee6 . ?ᆺ)
+ (#xee7 . ?ᆻ)
+ (#xee8 . ?ᆼ)
+ (#xee9 . ?ᆽ)
+ (#xeea . ?ᆾ)
+ (#xeeb . ?ᆿ)
+ (#xeec . ?ᇀ)
+ (#xeed . ?ᇁ)
+ (#xeee . ?ᇂ)
+ (#xeef . ?ㅭ)
+ (#xef0 . ?ㅱ)
+ (#xef1 . ?ㅸ)
+ (#xef2 . ?ㅿ)
+ (#xef3 . ?ㆁ)
+ (#xef4 . ?ㆄ)
+ (#xef5 . ?ㆆ)
+ (#xef6 . ?ㆍ)
+ (#xef7 . ?ㆎ)
+ (#xef8 . ?ᇫ)
+ (#xef9 . ?ᇰ)
+ (#xefa . ?ᇹ)
+ (#xeff . ?₩)
;; Latin-5
;; Latin-6
;; Latin-7
;; Latin-8
;; Latin-9
- (#x13bc . ?,b<(B)
- (#x13bd . ?,b=(B)
- (#x13be . ?,_/(B)
+ (#x13bc . ?Œ)
+ (#x13bd . ?œ)
+ (#x13be . ?Ÿ)
;; Currency
- (#x20a0 . ?$,1t@(B)
- (#x20a1 . ?$,1tA(B)
- (#x20a2 . ?$,1tB(B)
- (#x20a3 . ?$,1tC(B)
- (#x20a4 . ?$,1tD(B)
- (#x20a5 . ?$,1tE(B)
- (#x20a6 . ?$,1tF(B)
- (#x20a7 . ?$,1tG(B)
- (#x20a8 . ?$,1tH(B)
- (#x20aa . ?$,1tJ(B)
- (#x20ab . ?$,1tK(B)
- ;; Kana: Fixme: needs checking. Using Emacs to convert this to Unicode
- ;; and back changes this from ",b$(B" (i.e., bytes "ESC , b $ ESC ( B") to
- ;; ",F$(B" (i.e., bytes "ESC , F $ ESC ( B").
- (#x20ac . ?,b$(B)))
+ (#x20a0 . ?₠)
+ (#x20a1 . ?₡)
+ (#x20a2 . ?₢)
+ (#x20a3 . ?₣)
+ (#x20a4 . ?₤)
+ (#x20a5 . ?₥)
+ (#x20a6 . ?₦)
+ (#x20a7 . ?₧)
+ (#x20a8 . ?₨)
+ (#x20aa . ?₪)
+ (#x20ab . ?₫)
+ (#x20ac . ?€)))
(puthash (car pair) (cdr pair) x-keysym-table))
;; The following keysym codes for graphics are listed in the document
@@ -1154,155 +1146,17 @@ as returned by `x-server-vendor'."
;;;; Selections
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from x-selection-value. We track both
-;; separately in case another X application only sets one of them
-;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
-(defvar x-last-selected-text-clipboard nil
- "The value of the CLIPBOARD X selection last time we selected or
-pasted text.")
-(defvar x-last-selected-text-primary nil
- "The value of the PRIMARY X selection last time we selected or
-pasted text.")
-
-(defcustom x-select-enable-primary nil
- "Non-nil means cutting and pasting uses the primary selection."
- :type 'boolean
- :group 'killing
- :version "24.1")
-
-(defcustom x-select-request-type nil
- "Data type request for X selection.
-The value is one of the following data types, a list of them, or nil:
- `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
-
-If the value is one of the above symbols, try only the specified type.
-
-If the value is a list of them, try each of them in the specified
-order until succeed.
-
-The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)."
- :type '(choice (const :tag "Default" nil)
- (const COMPOUND_TEXT)
- (const UTF8_STRING)
- (const STRING)
- (const TEXT)
- (set :tag "List of values"
- (const COMPOUND_TEXT)
- (const UTF8_STRING)
- (const STRING)
- (const TEXT)))
- :group 'killing)
-
-;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropriate DATA-TYPE argument decided by `x-select-request-type'.
-;; The return value is already decoded. If x-get-selection causes an
-;; error, this function return nil.
-
-(defun x-selection-value-internal (type)
- (let ((request-type (or x-select-request-type
- '(UTF8_STRING COMPOUND_TEXT STRING)))
- text)
- (if (consp request-type)
- (while (and request-type (not text))
- (condition-case nil
- (setq text (x-get-selection type (car request-type)))
- (error nil))
- (setq request-type (cdr request-type)))
- (condition-case nil
- (setq text (x-get-selection type request-type))
- (error nil)))
- (if text
- (remove-text-properties 0 (length text) '(foreign-selection nil) text))
- text))
-
-;; Return the value of the current X selection.
-;; Consult the selection. Treat empty strings as if they were unset.
-;; If this function is called twice and finds the same text,
-;; it returns nil the second time. This is so that a single
-;; selection won't be added to the kill ring over and over.
-(defun x-selection-value ()
- ;; With multi-tty, this function may be called from a tty frame.
- (when (eq (framep (selected-frame)) 'x)
- (let (clip-text primary-text)
- (when x-select-enable-clipboard
- (setq clip-text (x-selection-value-internal 'CLIPBOARD))
- (if (string= clip-text "") (setq clip-text nil))
-
- ;; Check the CLIPBOARD selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
- (setq clip-text
- (cond ;; check clipboard
- ((or (not clip-text) (string= clip-text ""))
- (setq x-last-selected-text-clipboard nil))
- ((eq clip-text x-last-selected-text-clipboard) nil)
- ((string= clip-text x-last-selected-text-clipboard)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-clipboard clip-text)
- nil)
- (t (setq x-last-selected-text-clipboard clip-text)))))
-
- (when x-select-enable-primary
- (setq primary-text (x-selection-value-internal 'PRIMARY))
- ;; Check the PRIMARY selection for 'newness', is it different
- ;; from what we remembered them to be last time we did a
- ;; cut/paste operation.
- (setq primary-text
- (cond ;; check primary selection
- ((or (not primary-text) (string= primary-text ""))
- (setq x-last-selected-text-primary nil))
- ((eq primary-text x-last-selected-text-primary) nil)
- ((string= primary-text x-last-selected-text-primary)
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- (setq x-last-selected-text-primary primary-text)
- nil)
- (t
- (setq x-last-selected-text-primary primary-text)))))
-
- ;; As we have done one selection, clear this now.
- (setq next-selection-coding-system nil)
-
- ;; At this point we have recorded the current values for the
- ;; selection from clipboard (if we are supposed to) and primary.
- ;; So return the first one that has changed
- ;; (which is the first non-null one).
- ;;
- ;; NOTE: There will be cases where more than one of these has
- ;; changed and the new values differ. This indicates that
- ;; something like the following has happened since the last time
- ;; we looked at the selections: Application X set all the
- ;; selections, then Application Y set only one of them.
- ;; In this case since we don't have
- ;; timestamps there is no way to know what the 'correct' value to
- ;; return is. The nice thing to do would be to tell the user we
- ;; saw multiple possible selections and ask the user which was the
- ;; one they wanted.
- (or clip-text primary-text)
- )))
-
(define-obsolete-function-alias 'x-cut-buffer-or-selection-value
'x-selection-value "24.1")
;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-selection-value)
-
-;; Make paste from other applications use the decoding in x-select-request-type
-;; and not just STRING.
-(defun x-get-selection-value ()
- "Get the current value of the PRIMARY selection.
-Request data types in the order specified by `x-select-request-type'."
- (x-selection-value-internal 'PRIMARY))
(defun x-clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
+ (declare (obsolete clipboard-yank "25.1"))
(interactive "*")
- (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD))
- (x-select-enable-clipboard t))
+ (let ((clipboard-text (gui--selection-value-internal 'CLIPBOARD))
+ (select-enable-clipboard t))
(if (and clipboard-text (> (length clipboard-text) 0))
(kill-new clipboard-text))
(yank)))
@@ -1324,8 +1178,10 @@ Request data types in the order specified by `x-select-request-type'."
;;; Window system initialization.
(defun x-win-suspend-error ()
+ "Report an error when a suspend is attempted.
+This returns an error if any Emacs frames are X frames."
;; Don't allow suspending if any of the frames are X frames.
- (if (memq 'x (mapcar 'window-system (frame-list)))
+ (if (memq 'x (mapcar #'window-system (frame-list)))
(error "Cannot suspend Emacs while running under X")))
(defvar x-initialized nil
@@ -1341,7 +1197,8 @@ Request data types in the order specified by `x-select-request-type'."
(defvar x-display-name)
(defvar x-command-line-resources)
-(defun x-initialize-window-system (&optional display)
+(cl-defmethod window-system-initialization (&context (window-system x)
+ &optional display)
"Initialize Emacs for X frames and open the first connection to an X server."
(cl-assert (not x-initialized))
@@ -1458,10 +1315,41 @@ Request data types in the order specified by `x-select-request-type'."
(x-apply-session-resources)
(setq x-initialized t))
+(declare-function x-own-selection-internal "xselect.c"
+ (selection value &optional frame))
+(declare-function x-disown-selection-internal "xselect.c"
+ (selection &optional time-object terminal))
+(declare-function x-selection-owner-p "xselect.c"
+ (&optional selection terminal))
+(declare-function x-selection-exists-p "xselect.c"
+ (&optional selection terminal))
+(declare-function x-get-selection-internal "xselect.c"
+ (selection-symbol target-type &optional time-stamp terminal))
+
(add-to-list 'display-format-alist '("\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" . x))
-(add-to-list 'handle-args-function-alist '(x . x-handle-args))
-(add-to-list 'frame-creation-function-alist '(x . x-create-frame-with-faces))
-(add-to-list 'window-system-initialization-alist '(x . x-initialize-window-system))
+(cl-defmethod handle-args-function (args &context (window-system x))
+ (x-handle-args args))
+
+(cl-defmethod frame-creation-function (params &context (window-system x))
+ (x-create-frame-with-faces params))
+
+(cl-defmethod gui-backend-set-selection (selection value
+ &context (window-system x))
+ (if value (x-own-selection-internal selection value)
+ (x-disown-selection-internal selection)))
+
+(cl-defmethod gui-backend-selection-owner-p (selection
+ &context (window-system x))
+ (x-selection-owner-p selection))
+
+(cl-defmethod gui-backend-selection-exists-p (selection
+ &context (window-system x))
+ (x-selection-exists-p selection))
+
+(cl-defmethod gui-backend-get-selection (selection-symbol target-type
+ &context (window-system x)
+ &optional time-stamp terminal)
+ (x-get-selection-internal selection-symbol target-type time-stamp terminal))
;; Initiate drag and drop
(add-hook 'after-make-frame-functions 'x-dnd-init-frame)
@@ -1471,47 +1359,47 @@ Request data types in the order specified by `x-select-request-type'."
(mapcar (lambda (arg)
(cons (purecopy (car arg)) (purecopy (cdr arg))))
'(
- ("etc/images/new" . "gtk-new")
- ("etc/images/open" . "gtk-open")
+ ("etc/images/new" . ("document-new" "gtk-new"))
+ ("etc/images/open" . ("document-open" "gtk-open"))
("etc/images/diropen" . "n:system-file-manager")
- ("etc/images/close" . "gtk-close")
- ("etc/images/save" . "gtk-save")
- ("etc/images/saveas" . "gtk-save-as")
- ("etc/images/undo" . "gtk-undo")
- ("etc/images/cut" . "gtk-cut")
- ("etc/images/copy" . "gtk-copy")
- ("etc/images/paste" . "gtk-paste")
- ("etc/images/search" . "gtk-find")
- ("etc/images/print" . "gtk-print")
- ("etc/images/preferences" . "gtk-preferences")
- ("etc/images/help" . "gtk-help")
- ("etc/images/left-arrow" . "gtk-go-back")
- ("etc/images/right-arrow" . "gtk-go-forward")
- ("etc/images/home" . "gtk-home")
- ("etc/images/jump-to" . "gtk-jump-to")
+ ("etc/images/close" . ("window-close" "gtk-close"))
+ ("etc/images/save" . ("document-save" "gtk-save"))
+ ("etc/images/saveas" . ("document-save-as" "gtk-save-as"))
+ ("etc/images/undo" . ("edit-undo" "gtk-undo"))
+ ("etc/images/cut" . ("edit-cut" "gtk-cut"))
+ ("etc/images/copy" . ("edit-copy" "gtk-copy"))
+ ("etc/images/paste" . ("edit-paste" "gtk-paste"))
+ ("etc/images/search" . ("edit-find" "gtk-find"))
+ ("etc/images/print" . ("document-print" "gtk-print"))
+ ("etc/images/preferences" . ("preferences-system" "gtk-preferences"))
+ ("etc/images/help" . ("help-browser" "gtk-help"))
+ ("etc/images/left-arrow" . ("go-previous" "gtk-go-back"))
+ ("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/search" . "gtk-find")
- ("etc/images/exit" . "gtk-quit")
+ ("etc/images/exit" . ("application-exit" "gtk-quit"))
("etc/images/cancel" . "gtk-cancel")
- ("etc/images/info" . "gtk-info")
+ ("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/connect" . "gtk-connect")
("etc/images/contact" . "gtk-contact")
- ("etc/images/delete" . "gtk-delete")
- ("etc/images/describe" . "gtk-properties")
+ ("etc/images/delete" . ("edit-delete" "gtk-delete"))
+ ("etc/images/describe" . ("ocument-properties" "gtk-properties"))
("etc/images/disconnect" . "gtk-disconnect")
;; ("etc/images/exit" . "gtk-exit")
("etc/images/lock-broken" . "gtk-lock_broken")
("etc/images/lock-ok" . "gtk-lock_ok")
("etc/images/lock" . "gtk-lock")
("etc/images/next-page" . "gtk-next-page")
- ("etc/images/refresh" . "gtk-refresh")
- ("etc/images/sort-ascending" . "gtk-sort-ascending")
+ ("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
+ ("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" . "gtk-sort-descending")
+ ("etc/images/sort-descending" . ("view-sort-descending"
+ "gtk-sort-descending"))
("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
("images/gnus/toggle-subscription" . "gtk-task-recurring")
("images/mail/compose" . "gtk-mail-compose")
@@ -1528,8 +1416,8 @@ Request data types in the order specified by `x-select-request-type'."
("images/mail/spam" . "gtk-spam")
;; Used for GDB Graphical Interface
("images/gud/break" . "gtk-no")
- ("images/gud/recstart" . "gtk-media-record")
- ("images/gud/recstop" . "gtk-media-stop")
+ ("images/gud/recstart" . ("media-record" "gtk-media-record"))
+ ("images/gud/recstop" . ("media-playback-stop" "gtk-media-stop"))
;; No themed versions available:
;; mail/preview (combining stock_mail and stock_zoom)
;; mail/save (combining stock_mail, stock_save and stock_convert)
@@ -1538,9 +1426,12 @@ Request data types in the order specified by `x-select-request-type'."
Emacs must be compiled with the Gtk+ toolkit for this to have any effect.
A value that begins with n: denotes a named icon instead of a stock icon."
:version "22.2"
- :type '(choice (repeat (choice symbol
- (cons (string :tag "Emacs icon")
- (string :tag "Stock/named")))))
+ :type '(choice (repeat
+ (choice symbol
+ (cons (string :tag "Emacs icon")
+ (choice (group (string :tag "Named")
+ (string :tag "Stock"))
+ (string :tag "Stock/named"))))))
:group 'x)
(defcustom icon-map-list '(x-gtk-stock-map)
@@ -1593,6 +1484,8 @@ This uses `icon-map-list' to map icon file names to stock icon names."
(and value (cdr value))))
x-gtk-stock-cache))))
+(global-set-key [XF86WakeUp] 'ignore)
+
(provide 'x-win)
;;; x-win.el ends here
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index af0b0b606e5..00ed027613c 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1,6 +1,6 @@
;;; xterm.el --- define function key sequences and standard colors for xterm -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2015 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals
@@ -29,6 +29,14 @@
:version "24.1"
:group 'terminals)
+(defconst xterm--extra-capabilities-type
+ ;; NOTE: If you add entries here, make sure to update
+ ;; `terminal-init-xterm' as well.
+ '(set (const :tag "modifyOtherKeys support" modifyOtherKeys)
+ (const :tag "report background" reportBackground)
+ (const :tag "get X selection" getSelection)
+ (const :tag "set X selection" setSelection)))
+
(defcustom xterm-extra-capabilities 'check
"Whether Xterm supports some additional, more modern, features.
If nil, just assume that it does not.
@@ -37,30 +45,102 @@ If a list, assume that the listed features are supported, without checking.
The relevant features are:
modifyOtherKeys -- if supported, more key bindings work (e.g., \"\\C-,\")
- reportBackground -- if supported, Xterm reports its background color"
+ reportBackground -- if supported, Xterm reports its background color
+ getSelection -- if supported, Xterm yanks text from the X selection
+ setSelection -- if supported, Xterm saves killed text to the X selection"
:version "24.1"
- :group 'xterm
- :type '(choice (const :tag "No" nil)
- (const :tag "Check" check)
- ;; NOTE: If you add entries here, make sure to update
- ;; `tocheck-capabilities' in `terminal-init-xterm' as well.
- (set (const :tag "modifyOtherKeys support" modifyOtherKeys)
- (const :tag "report background" reportBackground))))
+ :type `(choice (const :tag "Check" check)
+ ,xterm--extra-capabilities-type))
+
+(defcustom xterm-max-cut-length 100000
+ "Maximum number of bytes to cut into xterm using the OSC 52 sequence.
+
+The OSC 52 sequence requires a terminator byte. Some terminals will ignore or
+mistreat a terminated sequence that is longer than a certain size, usually to
+protect users from runaway sequences.
+
+This variable allows you to tweak the maximum number of bytes that will be sent
+using the OSC 52 sequence.
+
+If you select a region larger than this size, it won't be copied to your system
+clipboard. Since clipboard data is base 64 encoded, the actual number of
+string bytes that can be copied is 3/4 of this value."
+ :type 'integer)
+
+(defconst xterm-paste-ending-sequence "\e[201~"
+ "Characters send by the terminal to end a bracketed paste.")
+
+(defun xterm-paste ()
+ "Handle the start of a terminal paste operation."
+ (interactive)
+ (let* ((end-marker-length (length xterm-paste-ending-sequence))
+ (pasted-text (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (while (not (search-backward
+ xterm-paste-ending-sequence
+ (- (point) end-marker-length) t))
+ (let ((event (read-event
+ nil nil
+ ;; Use finite timeout to avoid
+ ;; glomming the event onto
+ ;; this-command-keys.
+ most-positive-fixnum)))
+ (when (eql event ?\r)
+ (setf event ?\n))
+ (insert event)))
+ (let ((last-coding-system-used))
+ (decode-coding-region
+ (point-min) (point)
+ (keyboard-coding-system) t))))
+ (interprogram-paste-function (lambda () pasted-text)))
+ (yank)))
+
+(define-key global-map [xterm-paste] #'xterm-paste)
+
+(defvar xterm-rxvt-function-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\e[2~" [insert])
+ (define-key map "\e[3~" [delete])
+ (define-key map "\e[4~" [select])
+ (define-key map "\e[5~" [prior])
+ (define-key map "\e[6~" [next])
+
+ (define-key map "\e[15~" [f5])
+ (define-key map "\e[17~" [f6])
+ (define-key map "\e[18~" [f7])
+ (define-key map "\e[19~" [f8])
+ (define-key map "\e[20~" [f9])
+ (define-key map "\e[21~" [f10])
+
+ (define-key map "\e[2;2~" [S-insert])
+
+ ;; Other versions of xterm might emit these.
+ (define-key map "\e[A" [up])
+ (define-key map "\e[B" [down])
+ (define-key map "\e[C" [right])
+ (define-key map "\e[D" [left])
+
+ (define-key map "\e[11~" [f1])
+ (define-key map "\e[12~" [f2])
+ (define-key map "\e[13~" [f3])
+ (define-key map "\e[14~" [f4])
+
+ ;; Recognize the start of a bracketed paste sequence. The handler
+ ;; internally recognizes the end.
+ (define-key map "\e[200~" [xterm-paste])
+
+ map)
+ "Keymap of escape sequences, shared between xterm and rxvt support.")
(defvar xterm-function-map
(let ((map (make-sparse-keymap)))
+ (set-keymap-parent map xterm-rxvt-function-map)
;; xterm from X.org 6.8.2 uses these key definitions.
(define-key map "\eOP" [f1])
(define-key map "\eOQ" [f2])
(define-key map "\eOR" [f3])
(define-key map "\eOS" [f4])
- (define-key map "\e[15~" [f5])
- (define-key map "\e[17~" [f6])
- (define-key map "\e[18~" [f7])
- (define-key map "\e[19~" [f8])
- (define-key map "\e[20~" [f9])
- (define-key map "\e[21~" [f10])
(define-key map "\e[23~" [f11])
(define-key map "\e[24~" [f12])
@@ -189,12 +269,6 @@ The relevant features are:
(define-key map "\e[1;3F" [M-end])
(define-key map "\e[1;3H" [M-home])
- (define-key map "\e[2~" [insert])
- (define-key map "\e[3~" [delete])
- (define-key map "\e[5~" [prior])
- (define-key map "\e[6~" [next])
-
- (define-key map "\e[2;2~" [S-insert])
(define-key map "\e[3;2~" [S-delete])
(define-key map "\e[5;2~" [S-prior])
(define-key map "\e[6;2~" [S-next])
@@ -229,7 +303,6 @@ The relevant features are:
(define-key map "\e[5;3~" [M-prior])
(define-key map "\e[6;3~" [M-next])
- (define-key map "\e[4~" [select])
(define-key map "\e[29~" [print])
(define-key map "\eOj" [kp-multiply])
@@ -248,6 +321,70 @@ The relevant features are:
(define-key map "\eOx" [kp-8])
(define-key map "\eOy" [kp-9])
+ (define-key map "\eO2j" [S-kp-multiply])
+ (define-key map "\eO2k" [S-kp-add])
+ (define-key map "\eO2l" [S-kp-separator])
+ (define-key map "\eO2m" [S-kp-subtract])
+ (define-key map "\eO2o" [S-kp-divide])
+ (define-key map "\eO2p" [S-kp-0])
+ (define-key map "\eO2q" [S-kp-1])
+ (define-key map "\eO2r" [S-kp-2])
+ (define-key map "\eO2s" [S-kp-3])
+ (define-key map "\eO2t" [S-kp-4])
+ (define-key map "\eO2u" [S-kp-5])
+ (define-key map "\eO2v" [S-kp-6])
+ (define-key map "\eO2w" [S-kp-7])
+ (define-key map "\eO2x" [S-kp-8])
+ (define-key map "\eO2y" [S-kp-9])
+
+ (define-key map "\eO4j" [M-S-kp-multiply])
+ (define-key map "\eO4k" [M-S-kp-add])
+ (define-key map "\eO4l" [M-S-kp-separator])
+ (define-key map "\eO4m" [M-S-kp-subtract])
+ (define-key map "\eO4o" [M-S-kp-divide])
+ (define-key map "\eO4p" [M-S-kp-0])
+ (define-key map "\eO4q" [M-S-kp-1])
+ (define-key map "\eO4r" [M-S-kp-2])
+ (define-key map "\eO4s" [M-S-kp-3])
+ (define-key map "\eO4t" [M-S-kp-4])
+ (define-key map "\eO4u" [M-S-kp-5])
+ (define-key map "\eO4v" [M-S-kp-6])
+ (define-key map "\eO4w" [M-S-kp-7])
+ (define-key map "\eO4x" [M-S-kp-8])
+ (define-key map "\eO4y" [M-S-kp-9])
+
+ (define-key map "\eO6j" [C-S-kp-multiply])
+ (define-key map "\eO6k" [C-S-kp-add])
+ (define-key map "\eO6l" [C-S-kp-separator])
+ (define-key map "\eO6m" [C-S-kp-subtract])
+ (define-key map "\eO6o" [C-S-kp-divide])
+ (define-key map "\eO6p" [C-S-kp-0])
+ (define-key map "\eO6q" [C-S-kp-1])
+ (define-key map "\eO6r" [C-S-kp-2])
+ (define-key map "\eO6s" [C-S-kp-3])
+ (define-key map "\eO6t" [C-S-kp-4])
+ (define-key map "\eO6u" [C-S-kp-5])
+ (define-key map "\eO6v" [C-S-kp-6])
+ (define-key map "\eO6w" [C-S-kp-7])
+ (define-key map "\eO6x" [C-S-kp-8])
+ (define-key map "\eO6y" [C-S-kp-9])
+
+ (define-key map "\eO8j" [C-M-S-kp-multiply])
+ (define-key map "\eO8k" [C-M-S-kp-add])
+ (define-key map "\eO8l" [C-M-S-kp-separator])
+ (define-key map "\eO8m" [C-M-S-kp-subtract])
+ (define-key map "\eO8o" [C-M-S-kp-divide])
+ (define-key map "\eO8p" [C-M-S-kp-0])
+ (define-key map "\eO8q" [C-M-S-kp-1])
+ (define-key map "\eO8r" [C-M-S-kp-2])
+ (define-key map "\eO8s" [C-M-S-kp-3])
+ (define-key map "\eO8t" [C-M-S-kp-4])
+ (define-key map "\eO8u" [C-M-S-kp-5])
+ (define-key map "\eO8v" [C-M-S-kp-6])
+ (define-key map "\eO8w" [C-M-S-kp-7])
+ (define-key map "\eO8x" [C-M-S-kp-8])
+ (define-key map "\eO8y" [C-M-S-kp-9])
+
;; These keys are available in xterm starting from version 216
;; if the modifyOtherKeys resource is set to 1.
(dolist (bind '((5 9 [C-tab])
@@ -370,10 +507,6 @@ The relevant features are:
(format "\e[%d;%du" (nth 1 bind) (nth 0 bind)) (nth 2 bind)))
;; Other versions of xterm might emit these.
- (define-key map "\e[A" [up])
- (define-key map "\e[B" [down])
- (define-key map "\e[C" [right])
- (define-key map "\e[D" [left])
(define-key map "\e[1~" [home])
(define-key map "\eO2A" [S-up])
@@ -390,10 +523,6 @@ The relevant features are:
(define-key map "\eO5F" [C-end])
(define-key map "\eO5H" [C-home])
- (define-key map "\e[11~" [f1])
- (define-key map "\e[12~" [f2])
- (define-key map "\e[13~" [f3])
- (define-key map "\e[14~" [f4])
map)
"Function key map overrides for xterm.")
@@ -463,8 +592,28 @@ The relevant features are:
map)
"Keymap of possible alternative meanings for some keys.")
-;; List of terminals for which modify-other-keys has been turned on.
-(defvar xterm-modify-other-keys-terminal-list nil)
+;; Set up colors, for those versions of xterm that support it.
+(defvar xterm-standard-colors
+ ;; The names in the comments taken from XTerm-col.ad in the xterm
+ ;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
+ ;; from rgb.txt.
+ '(("black" 0 ( 0 0 0)) ; black
+ ("red" 1 (205 0 0)) ; red3
+ ("green" 2 ( 0 205 0)) ; green3
+ ("yellow" 3 (205 205 0)) ; yellow3
+ ("blue" 4 ( 0 0 238)) ; blue2
+ ("magenta" 5 (205 0 205)) ; magenta3
+ ("cyan" 6 ( 0 205 205)) ; cyan3
+ ("white" 7 (229 229 229)) ; gray90
+ ("brightblack" 8 (127 127 127)) ; gray50
+ ("brightred" 9 (255 0 0)) ; red
+ ("brightgreen" 10 ( 0 255 0)) ; green
+ ("brightyellow" 11 (255 255 0)) ; yellow
+ ("brightblue" 12 (92 92 255)) ; rgb:5c/5c/ff
+ ("brightmagenta" 13 (255 0 255)) ; magenta
+ ("brightcyan" 14 ( 0 255 255)) ; cyan
+ ("brightwhite" 15 (255 255 255))) ; white
+ "Names of 16 standard xterm/aixterm colors, their numbers, and RGB values.")
(defun xterm--report-background-handler ()
(let ((str "")
@@ -500,8 +649,22 @@ The relevant features are:
;; see if by using a longer timeout we get rid of most issues.
(while (and (setq chr (read-event nil nil 2)) (not (equal chr ?c)))
(setq str (concat str (string chr))))
- (when (string-match "0;\\([0-9]+\\);0" str)
- (let ((version (string-to-number (match-string 1 str))))
+ ;; Since xterm-280, the terminal type (NUMBER1) is now 41 instead of 0.
+ (when (string-match "\\([0-9]+\\);\\([0-9]+\\);0" str)
+ (let ((version (string-to-number (match-string 2 str))))
+ (when (and (> version 2000) (equal (match-string 1 str) "1"))
+ ;; Hack attack! bug#16988: gnome-terminal reports "1;NNNN;0"
+ ;; with a large NNNN but is based on a rather old xterm code.
+ ;; Gnome terminal 3.6.1 reports 1;3406;0
+ ;; Gnome terminal 2.32.1 reports 1;2802;0
+ (setq version 200))
+ (when (equal (match-string 1 str) "83")
+ ;; `screen' (which returns 83;40003;0) seems to also lack support for
+ ;; some of these (bug#17607, bug#20356).
+ ;; Note: this code path should normally not be used any more
+ ;; since term/screen.el now binds xterm-extra-capabilities
+ ;; to a fixed value, rather than using the dynamic checking.
+ (setq version 200))
;; If version is 242 or higher, assume the xterm supports
;; reporting the background color (TODO: maybe earlier
;; versions do too...)
@@ -513,9 +676,23 @@ The relevant features are:
;; introduced) or higher, initialize the
;; modifyOtherKeys support.
(when (>= version 216)
- (terminal-init-xterm-modify-other-keys))))))
-
-(defun xterm--query (query handlers)
+ (xterm--init-modify-other-keys))
+ ;; In version 203 support for accessing the X selection was
+ ;; added. Hterm reports itself as version 256 and supports it
+ ;; as well. gnome-terminal doesn't and is excluded by this
+ ;; test.
+ (when (>= version 203)
+ ;; Most xterms seem to have it disabled by default, and if it's
+ ;; disabled, C-y will incur a timeout, so we only use it if the user
+ ;; explicitly requests it.
+ ;;(xterm--init-activate-get-selection)
+ (xterm--init-activate-set-selection))))))
+
+(defvar xterm-query-timeout 2
+ "Seconds to wait for an answer from the terminal.
+Can be nil to mean \"no timeout\".")
+
+(defun xterm--query (query handlers &optional no-async)
"Send QUERY string to the terminal and watch for a response.
HANDLERS is an alist with elements of the form (STRING . FUNCTION).
We run the first FUNCTION whose STRING matches the input events."
@@ -523,35 +700,55 @@ We run the first FUNCTION whose STRING matches the input events."
;; rather annoying (bug#6758). Maybe we could always use the asynchronous
;; approach, but it's less tested.
;; FIXME: Merge the two branches.
- (if (input-pending-p)
- (progn
- (dolist (handler handlers)
- (define-key input-decode-map (car handler)
- (lambda (&optional _prompt)
- ;; Unregister the handler, since we don't expect further answers.
- (dolist (handler handlers)
- (define-key input-decode-map (car handler) nil))
- (funcall (cdr handler))
- [])))
- (send-string-to-terminal query))
- ;; Pending input can be mistakenly returned by the calls to
- ;; read-event below. Discard it.
- (send-string-to-terminal query)
- (while handlers
- (let ((handler (pop handlers))
- (i 0))
- (while (and (< i (length (car handler)))
- (let ((evt (read-event nil nil 2)))
- (or (eq evt (aref (car handler) i))
- (progn (if evt (push evt unread-command-events))
- nil))))
- (setq i (1+ i)))
- (if (= i (length (car handler)))
- (progn (setq handlers nil)
- (funcall (cdr handler)))
- (while (> i 0)
- (push (aref (car handler) (setq i (1- i)))
- unread-command-events)))))))
+ (let ((register
+ (lambda (handlers)
+ (dolist (handler handlers)
+ (define-key input-decode-map (car handler)
+ (lambda (&optional _prompt)
+ ;; Unregister the handler, since we don't expect
+ ;; further answers.
+ (dolist (handler handlers)
+ (define-key input-decode-map (car handler) nil))
+ (funcall (cdr handler))
+ []))))))
+ (if (and (or (null xterm-query-timeout) (input-pending-p))
+ (not no-async))
+ (progn
+ (funcall register handlers)
+ (send-string-to-terminal query))
+ ;; Pending input can be mistakenly returned by the calls to
+ ;; read-event below: discard it.
+ (discard-input)
+ (send-string-to-terminal query)
+ (while handlers
+ (let ((handler (pop handlers))
+ (i 0))
+ (while (and (< i (length (car handler)))
+ (let ((evt (read-event nil nil xterm-query-timeout)))
+ (if (and (null evt) (= i 0) (not no-async))
+ ;; Timeout on the first event: fallback on async.
+ (progn
+ (funcall register (cons handler handlers))
+ (setq handlers nil)
+ nil)
+ (or (eq evt (aref (car handler) i))
+ (progn (if evt (push evt unread-command-events))
+ nil)))))
+ (setq i (1+ i)))
+ (if (= i (length (car handler)))
+ (progn (setq handlers nil)
+ (funcall (cdr handler)))
+ (while (> i 0)
+ (push (aref (car handler) (setq i (1- i)))
+ unread-command-events))))))))
+
+(defun xterm--push-map (map basemap)
+ ;; Use inheritance to let the main keymaps override those defaults.
+ ;; This way we don't override terminfo-derived settings or settings
+ ;; made in the init file.
+ (set-keymap-parent
+ basemap
+ (make-composed-keymap map (keymap-parent basemap))))
(defun terminal-init-xterm ()
"Terminal initialization function for xterm."
@@ -562,19 +759,10 @@ We run the first FUNCTION whose STRING matches the input events."
(string-match "\\`rxvt" (getenv "COLORTERM" (selected-frame))))
(tty-run-terminal-initialization (selected-frame) "rxvt")
- (let ((map (copy-keymap xterm-alternatives-map)))
- (set-keymap-parent map (keymap-parent local-function-key-map))
- (set-keymap-parent local-function-key-map map))
+ (xterm--push-map xterm-alternatives-map local-function-key-map)
+ (xterm--push-map xterm-function-map input-decode-map))
- (let ((map (copy-keymap xterm-function-map)))
-
- ;; Use inheritance to let the main keymap override those defaults.
- ;; This way we don't override terminfo-derived settings or settings
- ;; made in the init file.
- (set-keymap-parent map (keymap-parent input-decode-map))
- (set-keymap-parent input-decode-map map)))
-
- (xterm-register-default-colors)
+ (xterm-register-default-colors xterm-standard-colors)
(tty-set-up-initial-frame-faces)
(if (eq xterm-extra-capabilities 'check)
@@ -592,61 +780,125 @@ We run the first FUNCTION whose STRING matches the input events."
'(("\e]11;" . xterm--report-background-handler))))
(when (memq 'modifyOtherKeys xterm-extra-capabilities)
- (terminal-init-xterm-modify-other-keys)))
+ (xterm--init-modify-other-keys))
+
+ (when (memq 'getSelection xterm-extra-capabilities)
+ (xterm--init-activate-get-selection))
+ (when (memq 'setSelection xterm-extra-capabilities)
+ (xterm--init-activate-set-selection)))
+
+ ;; Unconditionally enable bracketed paste mode: terminals that don't
+ ;; support it just ignore the sequence.
+ (xterm--init-bracketed-paste-mode)
(run-hooks 'terminal-init-xterm-hook))
-(defun terminal-init-xterm-modify-other-keys ()
+(defun xterm--init-modify-other-keys ()
"Terminal initialization for xterm's modifyOtherKeys support."
- ;; Make sure that the modifyOtherKeys state is restored when
- ;; suspending, resuming and exiting.
- (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys)
- (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys)
- (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys)
- (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys)
- ;; Add the selected frame to the list of frames that
- ;; need to deal with modify-other-keys.
- (push (frame-terminal)
- xterm-modify-other-keys-terminal-list)
- (xterm-turn-on-modify-other-keys))
-
-;; Set up colors, for those versions of xterm that support it.
-(defvar xterm-standard-colors
- ;; The names in the comments taken from XTerm-col.ad in the xterm
- ;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
- ;; from rgb.txt.
- '(("black" 0 ( 0 0 0)) ; black
- ("red" 1 (205 0 0)) ; red3
- ("green" 2 ( 0 205 0)) ; green3
- ("yellow" 3 (205 205 0)) ; yellow3
- ("blue" 4 ( 0 0 238)) ; blue2
- ("magenta" 5 (205 0 205)) ; magenta3
- ("cyan" 6 ( 0 205 205)) ; cyan3
- ("white" 7 (229 229 229)) ; gray90
- ("brightblack" 8 (127 127 127)) ; gray50
- ("brightred" 9 (255 0 0)) ; red
- ("brightgreen" 10 ( 0 255 0)) ; green
- ("brightyellow" 11 (255 255 0)) ; yellow
- ("brightblue" 12 (92 92 255)) ; rgb:5c/5c/ff
- ("brightmagenta" 13 (255 0 255)) ; magenta
- ("brightcyan" 14 ( 0 255 255)) ; cyan
- ("brightwhite" 15 (255 255 255))) ; white
- "Names of 16 standard xterm/aixterm colors, their numbers, and RGB values.")
+ (send-string-to-terminal "\e[>4;1m")
+ (push "\e[>4m" (terminal-parameter nil 'tty-mode-reset-strings))
+ (push "\e[>4;1m" (terminal-parameter nil 'tty-mode-set-strings)))
+
+(defun xterm--init-bracketed-paste-mode ()
+ "Terminal initialization for bracketed paste mode."
+ (send-string-to-terminal "\e[?2004h")
+ (push "\e[?2004l" (terminal-parameter nil 'tty-mode-reset-strings))
+ (push "\e[?2004h" (terminal-parameter nil 'tty-mode-set-strings)))
+
+(defun xterm--init-activate-get-selection ()
+ "Terminal initialization for `gui-get-selection'."
+ (set-terminal-parameter nil 'xterm--get-selection t))
+
+(defun xterm--init-activate-set-selection ()
+ "Terminal initialization for `gui-set-selection'."
+ (set-terminal-parameter nil 'xterm--set-selection t))
+
+(defun xterm--selection-char (type)
+ (pcase type
+ ('PRIMARY "p")
+ ('CLIPBOARD "c")
+ (_ (error "Invalid selection type: %S" type))))
+
+(cl-defmethod gui-backend-get-selection
+ (type data-type
+ &context (window-system nil)
+ ;; Only applies to terminals which have it enabled.
+ ((terminal-parameter nil 'xterm--get-selection) (eql t)))
+ (unless (eq data-type 'STRING)
+ (error "Unsupported data type %S" data-type))
+ (let* ((screen (eq (terminal-parameter nil 'terminal-initted)
+ 'terminal-init-screen))
+ (query (concat "\e]52;" (xterm--selection-char type) ";")))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (xterm--query
+ (concat (when screen "\eP") query "?\a" (when screen "\e\\"))
+ (list (cons query (lambda ()
+ (while (let ((char (read-char)))
+ (unless (eq char ?\a)
+ (insert char)
+ t))))))
+ 'no-async)
+ (base64-decode-region (point-min) (point-max))
+ (decode-coding-region (point-min) (point-max) 'utf-8-unix t))))
+
+(cl-defmethod gui-backend-set-selection
+ (type data
+ &context (window-system nil)
+ ;; Only applies to terminals which have it enabled.
+ ((terminal-parameter nil 'xterm--set-selection) (eql t)))
+ "Copy DATA to the X selection using the OSC 52 escape sequence.
+
+TYPE specifies which selection to set; it must be either
+`PRIMARY' or `CLIPBOARD'. DATA must be a string.
+
+This can be used as a `gui-set-selection' method for
+xterm-compatible terminal emulators. Then your system clipboard
+will be updated whenever you copy a region of text in Emacs.
+
+If the resulting OSC 52 sequence would be longer than
+`xterm-max-cut-length', then the TEXT is not sent to the system
+clipboard.
+
+This function either sends a raw OSC 52 sequence or wraps the OSC
+52 in a Device Control String sequence. This way, it will work
+on a bare terminal emulators as well as inside the screen
+program. When inside the screen program, this function also
+chops long DCS sequences into multiple smaller ones to avoid
+hitting screen's max DCS length."
+ (let* ((screen (eq (terminal-parameter nil 'terminal-initted)
+ 'terminal-init-screen))
+ (bytes (encode-coding-string data 'utf-8-unix))
+ (base-64 (if screen
+ (replace-regexp-in-string
+ "\n" "\e\\\eP"
+ (base64-encode-string bytes)
+ :fixedcase :literal)
+ (base64-encode-string bytes :no-line-break)))
+ (length (length base-64)))
+ (if (> length xterm-max-cut-length)
+ (progn
+ (warn "Selection too long to send to terminal: %d bytes" length)
+ (sit-for 2))
+ (send-string-to-terminal
+ (concat
+ (when screen "\eP")
+ "\e]52;" (xterm--selection-char type) ";" base-64 "\a"
+ (when screen "\e\\"))))))
(defun xterm-rgb-convert-to-16bit (prim)
"Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
(logior prim (lsh prim 8)))
-(defun xterm-register-default-colors ()
+(defun xterm-register-default-colors (colors)
"Register the default set of colors for xterm or compatible emulator.
This function registers the number of colors returned by `display-color-cells'
-for the currently selected frame. The first 16 colors are taken from
-`xterm-standard-colors', which see, while the rest are computed assuming
+for the currently selected frame. The first (16) colors are taken from
+COLORS, which see, while the rest are computed assuming
either the 88- or 256-color standard color scheme supported by latest
versions of xterm."
- (let* ((ncolors (display-color-cells (selected-frame)))
- (colors xterm-standard-colors)
+ (let* ((ncolors (display-color-cells))
(color (car colors)))
(if (> ncolors 0)
;; Clear the 8 default tty colors registered by startup.el
@@ -654,12 +906,12 @@ versions of xterm."
;; Only register as many colors as are supported by the display.
(while (and (> ncolors 0) colors)
(tty-color-define (car color) (cadr color)
- (mapcar 'xterm-rgb-convert-to-16bit
+ (mapcar #'xterm-rgb-convert-to-16bit
(car (cddr color))))
(setq colors (cdr colors)
color (car colors)
ncolors (1- ncolors)))
- ;; We've exhausted the colors from `xterm-standard-colors'. If there
+ ;; We've exhausted the colors from `colors'. If there
;; are more colors to support, compute them now.
(when (> ncolors 0)
(cond
@@ -671,7 +923,7 @@ versions of xterm."
;; 88colres.pl in the xterm distribution.
(tty-color-define (format "color-%d" (- 256 ncolors))
(- 256 ncolors)
- (mapcar 'xterm-rgb-convert-to-16bit
+ (mapcar #'xterm-rgb-convert-to-16bit
(list (if (zerop r) 0 (+ (* r 40) 55))
(if (zerop g) 0 (+ (* g 40) 55))
(if (zerop b) 0 (+ (* b 40) 55)))))
@@ -698,7 +950,7 @@ versions of xterm."
(while (> ncolors 8)
(tty-color-define (format "color-%d" (- 88 ncolors))
(- 88 ncolors)
- (mapcar 'xterm-rgb-convert-to-16bit
+ (mapcar #'xterm-rgb-convert-to-16bit
(list (nth r levels)
(nth g levels)
(nth b levels))))
@@ -726,29 +978,6 @@ versions of xterm."
;; right colors, so clear them.
(clear-face-cache)))
-(defun xterm-turn-on-modify-other-keys ()
- "Turn the modifyOtherKeys feature of xterm back on."
- (let ((terminal (frame-terminal)))
- (when (and (terminal-live-p terminal)
- (memq terminal xterm-modify-other-keys-terminal-list))
- (send-string-to-terminal "\e[>4;1m" terminal))))
-
-(defun xterm-turn-off-modify-other-keys (&optional frame)
- "Temporarily turn off the modifyOtherKeys feature of xterm."
- (let ((terminal (when frame (frame-terminal frame))))
- (when (and (terminal-live-p terminal)
- (memq terminal xterm-modify-other-keys-terminal-list))
- (send-string-to-terminal "\e[>4m" terminal))))
-
-(defun xterm-remove-modify-other-keys (&optional terminal)
- "Turn off the modifyOtherKeys feature of xterm for good."
- (setq terminal (or terminal (frame-terminal)))
- (when (and (terminal-live-p terminal)
- (memq terminal xterm-modify-other-keys-terminal-list))
- (setq xterm-modify-other-keys-terminal-list
- (delq terminal xterm-modify-other-keys-terminal-list))
- (send-string-to-terminal "\e[>4m" terminal)))
-
(defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
;; Use the heuristic in `frame-set-background-mode' to decide if a
;; frame is dark.
@@ -756,6 +985,6 @@ versions of xterm."
(set-terminal-parameter nil 'background-mode 'dark)
t))
-(provide 'xterm)
-
+(provide 'xterm) ;Backward compatibility.
+(provide 'term/xterm)
;;; xterm.el ends here
diff --git a/lisp/textmodes/.gitignore b/lisp/textmodes/.gitignore
deleted file mode 100644
index c531d9867f6..00000000000
--- a/lisp/textmodes/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*.elc
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 0d9c8eb7c64..a29418e6f84 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1,6 +1,6 @@
;;; artist.el --- draw ascii graphics with your mouse
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
@@ -298,7 +298,7 @@ during the flood-fill."
(defcustom artist-ellipse-right-char ?\)
"Character to use at the rightmost position when drawing narrow ellipses.
-In this figure, it is the right parenthesis (the ``)'' character):
+In this figure, it is the right parenthesis (the \")\" character):
-----
( )
-----"
@@ -309,7 +309,7 @@ In this figure, it is the right parenthesis (the ``)'' character):
(defcustom artist-ellipse-left-char ?\(
"Character to use at the leftmost position when drawing narrow ellipses.
-In this figure, it is the left parenthesis (the ``('' character):
+In this figure, it is the left parenthesis (the \"(\" character):
-----
( )
-----"
@@ -331,7 +331,7 @@ Accept this many characters cutting off a line and still treat
it as one line.
Example:
If `artist-vaporize-fuzziness' is 2, then those will be recognized as
- lines from A to B (provided you start vaporizing them at the ``*''):
+ lines from A to B (provided you start vaporizing them at the \"*\"):
/
A----*------/-----------B
\\/
@@ -342,7 +342,7 @@ Example:
\\/ /
A----*----/\\/----------B
/ /\\
- (in fact, only the left part [between the A and the leftmost ``/''
+ (in fact, only the left part [between the A and the leftmost \"/\"
crossing the line] will be vaporized)."
:group 'artist
:type 'integer)
@@ -397,8 +397,8 @@ Example:
;; This is a defvar, not a defcustom, since the custom
;; package shows lists of characters as a lists of integers,
;; which is confusing
- "Characters (``color'') to use when spraying.
-They should be ordered from the ``lightest'' to the ``heaviest''
+ "Characters (\"color\") to use when spraying.
+They should be ordered from the \"lightest\" to the \"heaviest\"
since spraying replaces a light character with the next heavier one.")
@@ -1275,7 +1275,7 @@ Drawing with the mouse:
* Cut copies, then clears the rectangle/square.
* When drawing lines or poly-lines, you can set arrows.
- See below under ``Arrows'' for more info.
+ See below under \"Arrows\" for more info.
* The mode line shows the currently selected drawing operation.
In addition, if it has an asterisk (*) at the end, you
@@ -1383,8 +1383,8 @@ Variables
artist-vaporize-fuzziness Tolerance when recognizing lines
artist-spray-interval Seconds between repeated sprayings
artist-spray-radius Size of the spray-area
- artist-spray-chars The spray-``color''
- artist-spray-new-chars Initial spray-``color''
+ artist-spray-chars The spray-\"color\"
+ artist-spray-new-chars Initial spray-\"color\"
Hooks
@@ -2020,7 +2020,7 @@ The replacement is used to convert tabs and new-lines to spaces."
(defsubst artist-replace-string (string &optional see-thru)
"Replace contents at point with STRING.
With optional argument SEE-THRU set to non-nil, text in the buffer
-``shines thru'' blanks in the STRING."
+\"shines thru\" blanks in the STRING."
(let ((char-list (append string nil)) ; convert the string to a list
(overwrite-mode 'overwrite-mode-textual)
(fill-column 32765) ; Large :-)
@@ -2385,7 +2385,7 @@ in the coord."
;; Pretend we are plotting a pixel. Instead we just list it
;;
(defmacro artist-put-pixel (point-list x y)
- "In POINT-LIST, store a ``pixel'' at coord X,Y."
+ "In POINT-LIST, store a \"pixel\" at coord X,Y."
`(setq ,point-list
(append ,point-list (list (artist-new-coord ,x ,y)))))
@@ -2928,7 +2928,7 @@ This is done by calling the function specified by
`artist-text-renderer-function', which must return a list of strings,
to be inserted in the buffer.
-Text already in the buffer ``shines thru'' blanks in the rendered text."
+Text already in the buffer \"shines thru\" blanks in the rendered text."
(let* ((input-text (read-string "Type text to render: "))
(rendered-text (artist-funcall artist-text-renderer-function input-text)))
(artist-text-insert-see-thru x y rendered-text)))
@@ -2958,7 +2958,7 @@ Blanks in the rendered text overwrite any text in the buffer."
Returns a list of points. Each point is on the form (X1 . Y1)."
(let ((points))
(while (> n 0)
- (let* ((angle (* (random 359) (/ float-pi 180)))
+ (let* ((angle (degrees-to-radians (random 359)))
(dist (random radius))
(point (cons (round (* dist (cos angle)))
(round (* dist (sin angle))))))
@@ -3372,7 +3372,7 @@ The POINT-LIST is expected to cover the first quadrant."
;; Create the other half by mirroring the first half.
(setq both-halves
(append first-half
- (mapc
+ (mapcar
(lambda (i)
(artist-new-fill-item (artist-fill-item-get-x i)
(- (artist-fill-item-get-y i))
@@ -4963,52 +4963,58 @@ The event, EV, is the mouse event."
(artist-funcall init-fn x1 y1)
(if (not artist-rubber-banding)
(artist-no-rb-set-point1 x1 y1))
- (track-mouse
- (while (or (mouse-movement-p ev)
- (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 y1 (cdr ev-start-pos))
-
- ;; Cancel previous timer
- (if timer
- (cancel-timer timer))
-
- (if (not (eq initial-win (posn-window (event-start ev))))
- ;; If we moved outside the window, do nothing
- nil
-
- ;; Still in same window:
- ;;
- ;; Check if user presses or releases shift key
- (if (artist-shift-has-changed shift-state ev)
-
- ;; First check that the draw-how is the same as we
- ;; already have. Otherwise, ignore the changed shift-state.
- (if (not (eq draw-how
- (artist-go-get-draw-how-from-symbol
- (if (not shift-state) shifted unshifted))))
- (message "Cannot switch to shifted operation")
-
- ;; progn is "implicit" since this is the else-part
- (setq shift-state (not shift-state))
- (setq op (if shift-state shifted unshifted))
- (setq draw-how (artist-go-get-draw-how-from-symbol op))
- (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
-
- ;; Draw the new shape
- (setq shape (artist-funcall draw-fn x1 y1))
- (artist-move-to-xy x1 y1)
-
- ;; Start the timer to call `draw-fn' repeatedly every
- ;; `interval' second
- (if (and interval draw-fn)
- (setq timer (run-at-time interval interval draw-fn x1 y1))))
-
- ;; Read next event
- (setq ev (read-event))))
-
+ (unwind-protect
+ (track-mouse
+ ;; We don't want flickering of mouse pointer shape while we
+ ;; drag the mouse.
+ (setq track-mouse 'dragging)
+ (while (or (mouse-movement-p ev)
+ (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 y1 (cdr ev-start-pos))
+
+ ;; Cancel previous timer
+ (if timer
+ (cancel-timer timer))
+
+ (if (not (eq initial-win (posn-window (event-start ev))))
+ ;; If we moved outside the window, do nothing
+ nil
+
+ ;; Still in same window:
+ ;;
+ ;; Check if user presses or releases shift key
+ (if (artist-shift-has-changed shift-state ev)
+
+ ;; First check that the draw-how is the same as we
+ ;; already have. Otherwise, ignore the changed shift-state.
+ (if (not (eq draw-how
+ (artist-go-get-draw-how-from-symbol
+ (if (not shift-state) shifted unshifted))))
+ (message "Cannot switch to shifted operation")
+
+ ;; progn is "implicit" since this is the else-part
+ (setq shift-state (not shift-state))
+ (setq op (if shift-state shifted unshifted))
+ (setq draw-how (artist-go-get-draw-how-from-symbol op))
+ (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
+
+ ;; Draw the new shape
+ (setq shape (artist-funcall draw-fn x1 y1))
+ (artist-move-to-xy x1 y1)
+
+ ;; Start the timer to call `draw-fn' repeatedly every
+ ;; `interval' second
+ (if (and interval draw-fn)
+ (setq timer (run-at-time interval interval draw-fn x1 y1))))
+
+ ;; Read next event
+ (setq ev (read-event))))
+ ;; Cleanup: get rid of any active timer.
+ (if timer
+ (cancel-timer timer)))
;; Cancel any timers
(if timer
(cancel-timer timer))
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 5ef263542fe..2ed5ad89eab 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,10 +1,10 @@
;;; bib-mode.el --- major mode for editing bib files
-;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2015 Free Software Foundation, Inc.
;; Author: Henry Kautz
;; (according to authors.el)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: bib
;; This file is part of GNU Emacs.
@@ -82,8 +82,8 @@ A uthor T itle D ate J ournal
V olume N umber P age K eywords
B in book or proceedings E ditor C ity & state
I nstitution, school, or publisher
-R eport number or 'phd thesis' or 'masters thesis' or 'draft' or
- 'unnumbered' or 'unpublished'
+R eport number or `phd thesis' or `masters thesis' or `draft' or
+ `unnumbered' or `unpublished'
W here can be found locally (login name, or ailib, etc.)
X comments (not used in indexing)
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 77b135de009..8ee011744df 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -1,6 +1,6 @@
;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*-
-;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: tex
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 171f373317a..df8066ee2fc 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,6 @@
;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994-1999, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
@@ -433,7 +433,7 @@ is present; but these fields are required otherwise.
OPTIONAL is a list of optional fields.
Each element of these lists is a list of the form
- \(FIELD COMMENT INIT ALTERNATIVE).
+ (FIELD COMMENT INIT ALTERNATIVE).
COMMENT, INIT, and ALTERNATIVE are optional.
FIELD is the name of the field.
@@ -468,7 +468,7 @@ alternatives, starting from zero."
nil
(("editor") ("editora") ("editorb") ("editorc")
("translator") ("annotator") ("commentator")
- ("introduction") ("foreword") ("afterword") ("titleaddon")
+ ("introduction") ("foreword") ("afterword") ("subtitle") ("titleaddon")
("maintitle") ("mainsubtitle") ("maintitleaddon")
("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes")
("series") ("number") ("note") ("publisher") ("location") ("isbn")
@@ -546,9 +546,9 @@ alternatives, starting from zero."
("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi")
("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("InCollection" "Article in a Collection"
- (("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")
+ (("editor") ("editora") ("editorb") ("editorc") ("translator") ("annotator")
("commentator") ("introduction") ("foreword") ("afterword")
("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
@@ -616,10 +616,11 @@ alternatives, starting from zero."
("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass")
("eprinttype") ("url") ("urldate")))
("Proceedings" "Single-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") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("eventtitle") ("eventdate") ("venue") ("language")
+ ("editor")
("volume") ("part") ("volumes") ("series") ("number") ("note")
("organization") ("publisher") ("location") ("month")
("isbn") ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate")
@@ -633,9 +634,9 @@ alternatives, starting from zero."
("isbn") ("pagetotal") ("addendum") ("pubstate")
("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate")))
("InProceedings" "Article in Conference Proceedings"
- (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0))
+ (("author") ("title") ("year" nil nil 0) ("date" nil nil 0))
(("booktitle"))
- (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
+ (("editor") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle")
("maintitleaddon") ("booksubtitle") ("booktitleaddon")
("eventtitle") ("eventdate") ("venue") ("language")
("volume") ("part") ("volumes") ("series") ("number") ("note")
@@ -2098,7 +2099,7 @@ If FLAG is nil, a message is echoed if point was incremented at least
(let* ((size (- (point-max) (point-min)))
(perc (if (= size 0)
100
- (/ (* 100 (- (point) (point-min))) size))))
+ (floor (* 100.0 (- (point) (point-min))) size))))
(when (>= perc (+ bibtex-progress-lastperc
bibtex-progress-interval))
(setq bibtex-progress-lastperc perc)
@@ -2228,7 +2229,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
bibtex-entry-kill-ring))
;; If we copied an entry from a buffer containing only this one entry,
;; it can be missing the second "\n".
- (unless (looking-back "\n\n") (insert "\n"))
+ (unless (looking-back "\n\n" (- (point) 2)) (insert "\n"))
(unless (functionp bibtex-reference-keys)
;; update `bibtex-reference-keys'
(save-excursion
@@ -2619,7 +2620,7 @@ is returned unchanged."
"Get content of BibTeX field FIELD. Return empty string if not found.
Optional arg CHANGE-LIST is a list of substitution patterns that is
applied to the content of FIELD. It is an alist with pairs
-\(OLD-REGEXP . NEW-STRING\)."
+\(OLD-REGEXP . NEW-STRING)."
(let* ((bibtex-expand-strings bibtex-autokey-expand-strings)
(content (bibtex-text-in-field field bibtex-autokey-use-crossref))
case-fold-search)
@@ -3646,7 +3647,7 @@ If optional arg CONTENT is non-nil extract content of text fields."
(defun bibtex-autofill-entry ()
"Try to fill fields of current BibTeX entry based on neighboring entries.
The current entry must have a key. Determine the neighboring entry
-\(previous or next\) whose key is more similar to the key of the current
+\(previous or next) whose key is more similar to the key of the current
entry. For all empty fields of the current entry insert the corresponding
field contents of the neighboring entry. Finally try to update the text
based on the difference between the keys of the neighboring and the current
@@ -4231,7 +4232,7 @@ Return t if test was successful, nil otherwise."
(cond ((not previous))
((member key key-list)
(push (cons (bibtex-current-line)
- (format "Duplicate key `%s'" key))
+ (format-message "Duplicate key `%s'" key))
error-list))
((and bibtex-maintain-sorted-entries
(not (bibtex-lessp previous current)))
@@ -4254,8 +4255,9 @@ Return t if test was successful, nil otherwise."
(cdr (assoc-string (car key) bibtex-reference-keys)))
(bibtex-search-entry (car key))
(push (cons (bibtex-current-line)
- (format "Duplicate key `%s' in %s" (car key)
- (abbreviate-file-name (buffer-file-name buffer))))
+ (format-message
+ "Duplicate key `%s' in %s" (car key)
+ (abbreviate-file-name (buffer-file-name buffer))))
error-list))))
(when test-thoroughly
@@ -4305,14 +4307,16 @@ Return t if test was successful, nil otherwise."
(if (setq idx (nth 3 field))
(bibtex-vec-push alt-expect idx (car field))
(push (cons beg-line
- (format "Required field `%s' missing"
- (car field)))
+ (format-message
+ "Required field `%s' missing"
+ (car field)))
error-list)))
(dotimes (idx num-alt)
(unless (aref alt-fields idx)
(push (cons beg-line
- (format "Alternative fields `%s' missing"
- (aref alt-expect idx)))
+ (format-message
+ "Alternative fields `%s' missing"
+ (aref alt-expect idx)))
error-list))))))))
(bibtex-progress-message 'done)))))
@@ -4326,7 +4330,8 @@ Return t if test was successful, nil otherwise."
(unless (eq major-mode 'compilation-mode) (compilation-mode))
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
- (insert "BibTeX mode command `bibtex-validate'\n"
+ (insert (substitute-command-keys
+ "BibTeX mode command `bibtex-validate'\n")
(if syntax-error
"Maybe undetected errors due to syntax errors. \
Correct and validate again.\n"
@@ -4337,10 +4342,10 @@ Correct and validate again.\n"
(goto-char (point-min))
(forward-line 2)) ; first error message
(display-buffer err-buf)
- nil) ; return `nil' (i.e., buffer is invalid)
+ nil) ; return nil (i.e., buffer is invalid)
(message "%s is syntactically correct"
(if mark-active "Region" "Buffer"))
- t))) ; return `t' (i.e., buffer is valid)
+ t))) ; return t (i.e., buffer is valid)
(defun bibtex-validate-globally (&optional strings)
"Check for duplicate keys in `bibtex-files'.
@@ -4361,9 +4366,10 @@ Return t if test was successful, nil otherwise."
(if (or (and strings (bibtex-string= entry-type "string"))
(assoc-string entry-type bibtex-entry-alist t))
(if (member key key-list)
- (push (format "%s:%d: Duplicate key `%s'\n"
- (buffer-file-name)
- (bibtex-current-line) key)
+ (push (format-message
+ "%s:%d: Duplicate key `%s'\n"
+ (buffer-file-name)
+ (bibtex-current-line) key)
error-list)
(push key key-list))))
(push (cons buffer key-list) buffer-key-list)))))
@@ -4376,9 +4382,10 @@ Return t if test was successful, nil otherwise."
(dolist (key (cdr (assq buffer buffer-key-list)))
(when (assoc-string key current-keys)
(bibtex-search-entry key)
- (push (format "%s:%d: Duplicate key `%s' in %s\n"
- (buffer-file-name) (bibtex-current-line) key
- (abbreviate-file-name (buffer-file-name buffer)))
+ (push (format-message
+ "%s:%d: Duplicate key `%s' in %s\n"
+ (buffer-file-name) (bibtex-current-line) key
+ (abbreviate-file-name (buffer-file-name buffer)))
error-list))))))
;; Process error list
@@ -4388,15 +4395,16 @@ Return t if test was successful, nil otherwise."
(unless (eq major-mode 'compilation-mode) (compilation-mode))
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
- (insert "BibTeX mode command `bibtex-validate-globally'\n\n")
+ (insert (substitute-command-keys
+ "BibTeX mode command `bibtex-validate-globally'\n\n"))
(dolist (err (sort error-list 'string-lessp)) (insert err))
(set-buffer-modified-p nil))
(goto-char (point-min))
(forward-line 2)) ; first error message
(display-buffer err-buf)
- nil) ; return `nil' (i.e., buffer is invalid)
+ nil) ; return nil (i.e., buffer is invalid)
(message "No duplicate keys.")
- t))) ; return `t' (i.e., buffer is valid)
+ t))) ; return t (i.e., buffer is valid)
(defun bibtex-next-field (begin &optional comma)
"Move point to end of text of next BibTeX field or entry head.
@@ -4839,7 +4847,7 @@ If optional arg MOVE is non-nil move point to end of field."
If optional prefix JUSTIFY is non-nil justify as well.
In BibTeX mode this function is bound to `fill-paragraph-function'."
(interactive "*P")
- (let ((pnt (copy-marker (point)))
+ (let ((pnt (point-marker))
(bounds (bibtex-enclosing-field t)))
(bibtex-fill-field-bounds bounds justify)
(goto-char pnt)))
@@ -4851,7 +4859,7 @@ names appear in column `bibtex-field-indentation', field text starts in
column `bibtex-text-indentation' and continuation lines start here, too.
If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too."
(interactive "*")
- (let ((pnt (copy-marker (point)))
+ (let ((pnt (point-marker))
(beg (bibtex-beginning-of-entry)) ; move point
bounds)
(bibtex-delete-whitespace)
@@ -5103,7 +5111,7 @@ entries from minibuffer."
"Browse a URL for the BibTeX entry at point.
Optional POS is the location of the BibTeX entry.
The URL is generated using the schemes defined in `bibtex-generate-url-list'
-\(see there\). If multiple schemes match for this entry, or the same scheme
+\(see there). If multiple schemes match for this entry, or the same scheme
matches more than once, use the one for which the first step's match is the
closest to POS. The URL is passed to `browse-url' unless NO-BROWSE is t.
Return the URL or nil if none can be generated."
@@ -5279,7 +5287,7 @@ where FILE is the BibTeX file of ENTRY."
(bibtex-display-entries entries)
(message "No BibTeX entries %smatching `%s'"
(if (string= "" field) ""
- (format "with field `%s' " field))
+ (format-message "with field `%s' " field))
regexp)))
entries))
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 67f2d96d003..7d81bbca7d5 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -1,6 +1,6 @@
-;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files -*- coding: utf-8 -*-
+;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: conf ini windows java
@@ -122,7 +122,7 @@ not align (only setting space according to `conf-assignment-space')."
(define-key menu-map [c-s0] '("--"))
(define-key menu-map [conf-quote-normal]
'(menu-item "Set quote syntax normal" conf-quote-normal
- :help "Set the syntax of \' and \" to punctuation"))
+ :help "Set the syntax of \\=' and \" to punctuation"))
(define-key menu-map [conf-align-assignments]
'(menu-item "Align assignments" conf-align-assignments
:help "Align assignments"))
@@ -296,8 +296,8 @@ contents of the region. Otherwise, operate on the whole buffer."
(defun conf-quote-normal (arg)
- "Set the syntax of ' and \" to punctuation.
-With prefix arg, only do it for ' if 1, or only for \" if 2.
+ "Set the syntax of \\=' and \" to punctuation.
+With prefix arg, only do it for \\=' if 1, or only for \" if 2.
This only affects the current buffer. Some conf files use quotes
to delimit strings, while others allow quotes as simple parts of
the assigned value. In those files font locking will be wrong,
@@ -311,8 +311,7 @@ unbalanced, but hey...)"
(when (or (not arg) (= (prefix-numeric-value arg) 2))
(modify-syntax-entry ?\" "." table))
(set-syntax-table table)
- (when font-lock-mode
- (font-lock-fontify-buffer))))
+ (font-lock-flush)))
(defun conf-outline-level ()
@@ -435,7 +434,7 @@ For details see `conf-mode'. Example:
# Conf mode font-locks this right on Unix and with \\[conf-unix-mode]
-\[Desktop Entry]
+[Desktop Entry]
Encoding=UTF-8
Name=The GIMP
Name[ca]=El GIMP
@@ -450,11 +449,11 @@ For details see `conf-mode'. Example:
; Conf mode font-locks this right on Windows and with \\[conf-windows-mode]
-\[ExtShellFolderViews]
+[ExtShellFolderViews]
Default={5984FFE0-28D4-11CF-AE66-08002B2E1262}
{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}
-\[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]
+[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]
PersistMoniker=file://Folder.htt"
(conf-mode-initialize ";"))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index cb19c018839..3e84b43bcb4 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1,8 +1,9 @@
-;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
+;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
;; Keywords: hypermedia
;; This file is part of GNU Emacs.
@@ -28,7 +29,7 @@
;; - electric ; and }
;; - filling code with auto-fill-mode
-;; - completion
+;; - attribute value completion
;; - fix font-lock errors with multi-line selectors
;;; Code:
@@ -37,96 +38,20 @@
"Cascading Style Sheets (CSS) editing mode."
:group 'languages)
+(defconst css-pseudo-class-ids
+ '("active" "checked" "disabled" "empty" "enabled" "first"
+ "first-child" "first-of-type" "focus" "hover" "indeterminate" "lang"
+ "last-child" "last-of-type" "left" "link" "not" "nth-child"
+ "nth-last-child" "nth-last-of-type" "nth-of-type" "only-child"
+ "only-of-type" "right" "root" "target" "visited")
+ "Identifiers for pseudo-classes.")
-(defun css-extract-keyword-list (res)
- (with-temp-buffer
- (url-insert-file-contents "http://www.w3.org/TR/REC-CSS2/css2.txt")
- (goto-char (point-max))
- (search-backward "Appendix H. Index")
- (forward-line)
- (delete-region (point-min) (point))
- (let ((result nil)
- keys)
- (dolist (re res)
- (goto-char (point-min))
- (setq keys nil)
- (while (re-search-forward (cdr re) nil t)
- (push (match-string 1) keys))
- (push (cons (car re) (sort keys 'string-lessp)) result))
- (nreverse result))))
-
-(defun css-extract-parse-val-grammar (string env)
- (let ((start 0)
- (elems ())
- name)
- (while (string-match
- (concat "\\(?:"
- (concat "<a [^>]+><span [^>]+>\\(?:"
- "&lt;\\([^&]+\\)&gt;\\|'\\([^']+\\)'"
- "\\)</span></a>")
- "\\|" "\\(\\[\\)"
- "\\|" "\\(]\\)"
- "\\|" "\\(||\\)"
- "\\|" "\\(|\\)"
- "\\|" "\\([*+?]\\)"
- "\\|" "\\({[^}]+}\\)"
- "\\|" "\\(\\w+\\(?:-\\w+\\)*\\)"
- "\\)[ \t\n]*")
- string start)
- ;; (assert (eq start (match-beginning 0)))
- (setq start (match-end 0))
- (cond
- ;; Reference to a type of value.
- ((setq name (match-string-no-properties 1 string))
- (push (intern name) elems))
- ;; Reference to another property's values.
- ((setq name (match-string-no-properties 2 string))
- (setq elems (delete-dups (append (cdr (assoc name env)) elems))))
- ;; A literal
- ((setq name (match-string-no-properties 9 string))
- (push name elems))
- ;; We just ignore the rest. I.e. we ignore the structure because
- ;; it's too difficult to exploit anyway (it would allow us to only
- ;; complete top/center/bottom after one of left/center/right and
- ;; vice-versa).
- (t nil)))
- elems))
-
-
-(defun css-extract-props-and-vals ()
- (with-temp-buffer
- (url-insert-file-contents "http://www.w3.org/TR/CSS21/propidx.html")
- (goto-char (point-min))
- (let ((props ()))
- (while (re-search-forward "#propdef-\\([^\"]+\\)\"><span class=\"propinst-\\1 xref\">'\\1'</span></a>" nil t)
- (let ((prop (match-string-no-properties 1)))
- (save-excursion
- (goto-char (match-end 0))
- (search-forward "<td>")
- (let ((vals-string (buffer-substring (point)
- (progn
- (re-search-forward "[ \t\n]+|[ \t\n]+<a href=\"cascade.html#value-def-inherit\" class=\"noxref\"><span class=\"value-inst-inherit\">inherit</span></a>")
- (match-beginning 0)))))
- ;;
- (push (cons prop (css-extract-parse-val-grammar vals-string props))
- props)))))
- props)))
-
-;; Extraction was done with:
-;; (css-extract-keyword-list
-;; '((pseudo . "^ +\\* :\\([^ \n,]+\\)")
-;; (at . "^ +\\* @\\([^ \n,]+\\)")
-;; (descriptor . "^ +\\* '\\([^ '\n]+\\)' (descriptor)")
-;; (media . "^ +\\* '\\([^ '\n]+\\)' media group")
-;; (property . "^ +\\* '\\([^ '\n]+\\)',")))
-
-(defconst css-pseudo-ids
- '("active" "after" "before" "first" "first-child" "first-letter" "first-line"
- "focus" "hover" "lang" "left" "link" "right" "visited")
- "Identifiers for pseudo-elements and pseudo-classes.")
+(defconst css-pseudo-element-ids
+ '("after" "before" "first-letter" "first-line")
+ "Identifiers for pseudo-elements.")
(defconst css-at-ids
- '("charset" "font-face" "import" "media" "page")
+ '("charset" "font-face" "import" "media" "namespace" "page")
"Identifiers that appear in the form @foo.")
(defconst css-descriptor-ids
@@ -142,36 +67,107 @@
"Identifiers for types of media.")
(defconst css-property-ids
- '("azimuth" "background" "background-attachment" "background-color"
- "background-image" "background-position" "background-repeat" "block"
- "border" "border-bottom" "border-bottom-color" "border-bottom-style"
- "border-bottom-width" "border-collapse" "border-color" "border-left"
- "border-left-color" "border-left-style" "border-left-width" "border-right"
+ '(;; CSS 2.1 properties (http://www.w3.org/TR/CSS21/propidx.html).
+ ;;
+ ;; Properties duplicated by any of the CSS3 modules below have
+ ;; been removed.
+ "azimuth" "border-collapse" "border-spacing" "bottom"
+ "caption-side" "clear" "clip" "content" "counter-increment"
+ "counter-reset" "cue" "cue-after" "cue-before" "direction" "display"
+ "elevation" "empty-cells" "float" "height" "left" "line-height"
+ "list-style" "list-style-image" "list-style-position"
+ "list-style-type" "margin" "margin-bottom" "margin-left"
+ "margin-right" "margin-top" "max-height" "max-width" "min-height"
+ "min-width" "orphans" "padding" "padding-bottom" "padding-left"
+ "padding-right" "padding-top" "page-break-after"
+ "page-break-before" "page-break-inside" "pause" "pause-after"
+ "pause-before" "pitch" "pitch-range" "play-during" "position"
+ "quotes" "richness" "right" "speak" "speak-header" "speak-numeral"
+ "speak-punctuation" "speech-rate" "stress" "table-layout" "top"
+ "unicode-bidi" "vertical-align" "visibility" "voice-family" "volume"
+ "widows" "width" "z-index"
+
+ ;; CSS Animations
+ ;; (http://www.w3.org/TR/css3-animations/#property-index)
+ "animation" "animation-delay" "animation-direction"
+ "animation-duration" "animation-fill-mode"
+ "animation-iteration-count" "animation-name"
+ "animation-play-state" "animation-timing-function"
+
+ ;; CSS Backgrounds and Borders Module Level 3
+ ;; (http://www.w3.org/TR/css3-background/#property-index)
+ "background" "background-attachment" "background-clip"
+ "background-color" "background-image" "background-origin"
+ "background-position" "background-repeat" "background-size"
+ "border" "border-bottom" "border-bottom-color"
+ "border-bottom-left-radius" "border-bottom-right-radius"
+ "border-bottom-style" "border-bottom-width" "border-color"
+ "border-image" "border-image-outset" "border-image-repeat"
+ "border-image-slice" "border-image-source" "border-image-width"
+ "border-left" "border-left-color" "border-left-style"
+ "border-left-width" "border-radius" "border-right"
"border-right-color" "border-right-style" "border-right-width"
- "border-spacing" "border-style" "border-top" "border-top-color"
- "border-top-style" "border-top-width" "border-width" "bottom"
- "caption-side" "clear" "clip" "color" "compact" "content"
- "counter-increment" "counter-reset" "cue" "cue-after" "cue-before"
- "cursor" "dashed" "direction" "display" "dotted" "double" "elevation"
- "empty-cells" "float" "font" "font-family" "font-size" "font-size-adjust"
- "font-stretch" "font-style" "font-variant" "font-weight" "groove" "height"
- "hidden" "inline" "inline-table" "inset" "left" "letter-spacing"
- "line-height" "list-item" "list-style" "list-style-image"
- "list-style-position" "list-style-type" "margin" "margin-bottom"
- "margin-left" "margin-right" "margin-top" "marker-offset" "marks"
- "max-height" "max-width" "min-height" "min-width" "orphans" "outline"
- "outline-color" "outline-style" "outline-width" "outset" "overflow"
- "padding" "padding-bottom" "padding-left" "padding-right" "padding-top"
- "page" "page-break-after" "page-break-before" "page-break-inside" "pause"
- "pause-after" "pause-before" "pitch" "pitch-range" "play-during" "position"
- "quotes" "richness" "ridge" "right" "run-in" "size" "solid" "speak"
- "speak-header" "speak-numeral" "speak-punctuation" "speech-rate" "stress"
- "table" "table-caption" "table-cell" "table-column" "table-column-group"
- "table-footer-group" "table-header-group" "table-layout" "table-row"
- "table-row-group" "text-align" "text-decoration" "text-indent"
- "text-shadow" "text-transform" "top" "unicode-bidi" "vertical-align"
- "visibility" "voice-family" "volume" "white-space" "widows" "width"
- "word-spacing" "z-index")
+ "border-style" "border-top" "border-top-color"
+ "border-top-left-radius" "border-top-right-radius"
+ "border-top-style" "border-top-width" "border-width" "box-shadow"
+
+ ;; CSS Basic User Interface Module Level 3 (CSS3 UI)
+ ;; (http://www.w3.org/TR/css3-ui/#property-index)
+ "box-sizing" "caret-color" "cursor" "nav-down" "nav-left"
+ "nav-right" "nav-up" "outline" "outline-color" "outline-offset"
+ "outline-style" "outline-width" "resize" "text-overflow"
+
+ ;; CSS Color Module Level 3
+ ;; (http://www.w3.org/TR/css3-color/#property)
+ "color" "opacity"
+
+ ;; CSS Flexible Box Layout Module Level 1
+ ;; (http://www.w3.org/TR/css-flexbox-1/#property-index)
+ "align-content" "align-items" "align-self" "flex" "flex-basis"
+ "flex-direction" "flex-flow" "flex-grow" "flex-shrink" "flex-wrap"
+ "justify-content" "order"
+
+ ;; CSS Fonts Module Level 3
+ ;; (http://www.w3.org/TR/css3-fonts/#property-index)
+ "font" "font-family" "font-feature-settings" "font-kerning"
+ "font-language-override" "font-size" "font-size-adjust"
+ "font-stretch" "font-style" "font-synthesis" "font-variant"
+ "font-variant-alternates" "font-variant-caps"
+ "font-variant-east-asian" "font-variant-ligatures"
+ "font-variant-numeric" "font-variant-position" "font-weight"
+
+ ;; CSS Overflow Module Level 3
+ ;; (http://www.w3.org/TR/css-overflow-3/#property-index)
+ "max-lines" "overflow" "overflow-x" "overflow-y"
+
+ ;; CSS Text Decoration Module Level 3
+ ;; (http://dev.w3.org/csswg/css-text-decor-3/#property-index)
+ "text-decoration" "text-decoration-color" "text-decoration-line"
+ "text-decoration-skip" "text-decoration-style" "text-emphasis"
+ "text-emphasis-color" "text-emphasis-position" "text-emphasis-style"
+ "text-shadow" "text-underline-position"
+
+ ;; CSS Text Module Level 3
+ ;; (http://www.w3.org/TR/css3-text/#property-index)
+ "hanging-punctuation" "hyphens" "letter-spacing" "line-break"
+ "overflow-wrap" "tab-size" "text-align" "text-align-last"
+ "text-indent" "text-justify" "text-transform" "white-space"
+ "word-break" "word-spacing" "word-wrap"
+
+ ;; CSS Transforms Module Level 1
+ ;; (http://www.w3.org/TR/css3-2d-transforms/#property-index)
+ "backface-visibility" "perspective" "perspective-origin"
+ "transform" "transform-origin" "transform-style"
+
+ ;; CSS Transitions
+ ;; (http://www.w3.org/TR/css3-transitions/#property-index)
+ "transition" "transition-delay" "transition-duration"
+ "transition-property" "transition-timing-function"
+
+ ;; Filter Effects Module Level 1
+ ;; (http://www.w3.org/TR/filter-effects/#property-index)
+ "color-interpolation-filters" "filter" "flood-color"
+ "flood-opacity" "lighting-color")
"Identifiers for properties.")
(defcustom css-electric-keys '(?\} ?\;) ;; '()
@@ -185,7 +181,7 @@
(let ((st (make-syntax-table)))
;; C-style comments.
(modify-syntax-entry ?/ ". 14" st)
- (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?* ". 23b" st)
;; Strings.
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?\' "\"" st)
@@ -206,15 +202,29 @@
(modify-syntax-entry ?- "_" st)
st))
+(eval-and-compile
+ (defconst css--uri-re
+ (concat
+ "url\\((\\)[[:space:]]*\\(?:\\\\.\\|[^()[:space:]\n'\"]\\)+"
+ "[[:space:]]*\\()\\)")))
+
+(defconst css-syntax-propertize-function
+ (syntax-propertize-rules
+ (css--uri-re (1 "|") (2 "|"))))
+
(defconst css-escapes-re
"\\\\\\(?:[^\000-\037\177]\\|[0-9a-fA-F]+[ \n\t\r\f]?\\)")
(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 "*"))
+(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.
+ (concat css-nmchar-re "+"))
(defconst css-proprietary-nmstart-re ;; Vendor-specific properties.
(concat "[-_]" (regexp-opt '("ms" "moz" "o" "khtml" "webkit")) "-"))
(defconst css-name-re (concat css-nmchar-re "+"))
+(defconst scss--hash-re "#\\(?:{[$-_[:alnum:]]+}\\|[[:alnum:]]+\\)")
+
(defface css-selector '((t :inherit font-lock-function-name-face))
"Face to use for selectors."
:group 'css)
@@ -224,24 +234,48 @@
(defface css-proprietary-property '((t :inherit (css-property italic)))
"Face to use for vendor-specific properties.")
-(defvar css-font-lock-keywords
- `(("!\\s-*important" . font-lock-builtin-face)
+(defun css--font-lock-keywords (&optional sassy)
+ `((,(concat "!\\s-*"
+ (regexp-opt (append (if sassy '("global"))
+ '("important"))))
+ (0 font-lock-builtin-face))
;; Atrules keywords. IDs not in css-at-ids are valid (ignored).
;; In fact the regexp should probably be
;; (,(concat "\\(@" css-ident-re "\\)\\([ \t\n][^;{]*\\)[;{]")
;; (1 font-lock-builtin-face))
;; Since "An at-rule consists of everything up to and including the next
;; semicolon (;) or the next block, whichever comes first."
- (,(concat "@" css-ident-re) . font-lock-builtin-face)
+ (,(concat "@" css-ident-re) (0 font-lock-builtin-face))
;; Selectors.
;; FIXME: attribute selectors don't work well because they may contain
;; strings which have already been highlighted as f-l-string-face and
;; thus prevent this highlighting from being applied (actually now that
- ;; I use `append' this should work better). But really the part of hte
+ ;; I use `keep' this should work better). But really the part of the
;; selector between [...] should simply not be highlighted.
- (,(concat "^\\([ \t]*[^@:{}\n][^:{}]+\\(?::" (regexp-opt css-pseudo-ids t)
- "\\(?:([^)]+)\\)?[^:{\n]*\\)*\\)\\(?:\n[ \t]*\\)*{")
- (1 'css-selector append))
+ (,(concat
+ "^[ \t]*\\("
+ (if (not sassy)
+ ;; We don't allow / as first char, so as not to
+ ;; take a comment as the beginning of a selector.
+ "[^@/:{} \t\n][^:{}]+"
+ ;; Same as for non-sassy except we do want to allow { and }
+ ;; chars in selectors in the case of #{$foo}
+ ;; variable interpolation!
+ (concat "\\(?:" scss--hash-re
+ "\\|[^@/:{} \t\n#]\\)"
+ "[^:{}#]*\\(?:" scss--hash-re "[^:{}#]*\\)*"))
+ ;; Even though pseudo-elements should be prefixed by ::, a
+ ;; single colon is accepted for backward compatibility.
+ "\\(?:\\(:" (regexp-opt (append css-pseudo-class-ids
+ css-pseudo-element-ids) t)
+ "\\|\\::" (regexp-opt css-pseudo-element-ids t) "\\)"
+ "\\(?:([^)]+)\\)?"
+ (if (not sassy)
+ "[^:{}\n]*"
+ (concat "[^:{}\n#]*\\(?:" scss--hash-re "[^:{}\n#]*\\)*"))
+ "\\)*"
+ "\\)\\(?:\n[ \t]*\\)*{")
+ (1 'css-selector keep))
;; In the above rule, we allow the open-brace to be on some subsequent
;; line. This will only work if we properly mark the intervening text
;; as being part of a multiline element (and even then, this only
@@ -258,35 +292,138 @@
"\\(?:\\(" css-proprietary-nmstart-re "\\)\\|"
css-nmstart-re "\\)" css-nmchar-re "*"
"\\)\\s-*:")
- (1 (if (match-end 2) 'css-proprietary-property 'css-property)))))
+ (1 (if (match-end 2) 'css-proprietary-property 'css-property)))
+ ;; Make sure the parens in a url(...) expression receive the
+ ;; default face. This is done because the parens may sometimes
+ ;; receive generic string delimiter syntax (see
+ ;; `css-syntax-propertize-function').
+ (,css--uri-re
+ (1 'default t) (2 'default t))))
+
+(defvar css-font-lock-keywords (css--font-lock-keywords))
(defvar css-font-lock-defaults
'(css-font-lock-keywords nil t))
+(defcustom css-indent-offset 4
+ "Basic size of one indentation step."
+ :version "22.2"
+ :type 'integer)
+
+(require 'smie)
+
+(defconst css-smie-grammar
+ (smie-prec2->grammar
+ (smie-precs->prec2 '((assoc ";") (assoc ",") (left ":")))))
+
+(defun css-smie--forward-token ()
+ (cond
+ ((and (eq (char-before) ?\})
+ (scss-smie--not-interpolation-p)
+ ;; FIXME: If the next char is not whitespace, what should we do?
+ (or (memq (char-after) '(?\s ?\t ?\n))
+ (looking-at comment-start-skip)))
+ (if (memq (char-after) '(?\s ?\t ?\n))
+ (forward-char 1) (forward-comment 1))
+ ";")
+ ((progn (forward-comment (point-max))
+ (looking-at "[;,:]"))
+ (forward-char 1) (match-string 0))
+ (t (smie-default-forward-token))))
+
+(defun css-smie--backward-token ()
+ (let ((pos (point)))
+ (forward-comment (- (point)))
+ (cond
+ ;; FIXME: If the next char is not whitespace, what should we do?
+ ((and (eq (char-before) ?\}) (scss-smie--not-interpolation-p)
+ (> pos (point))) ";")
+ ((memq (char-before) '(?\; ?\, ?\:))
+ (forward-char -1) (string (char-after)))
+ (t (smie-default-backward-token)))))
+
+(defun css-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) css-indent-offset)
+ (`(:elem . arg) 0)
+ (`(:list-intro . ,(or `";" `"")) t) ;"" stands for BOB (bug#15467).
+ (`(:before . "{")
+ (when (or (smie-rule-hanging-p) (smie-rule-bolp))
+ (smie-backward-sexp ";")
+ (smie-indent-virtual)))
+ (`(:before . ,(or "{" "("))
+ (if (smie-rule-hanging-p) (smie-rule-parent 0)))))
+
+;;; Completion
+
+(defun css--complete-property ()
+ "Complete property at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (let ((start (point)))
+ (skip-chars-backward " \t\r\n")
+ (when (memq (char-before) '(?\{ ?\;))
+ (list start pos css-property-ids))))))
+
+(defun css--complete-pseudo-element-or-class ()
+ "Complete pseudo-element or pseudo-class at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (when (eq (char-before) ?\:)
+ (list (point) pos
+ (if (eq (char-before (- (point) 1)) ?\:)
+ css-pseudo-element-ids
+ css-pseudo-class-ids))))))
+
+(defun css--complete-at-rule ()
+ "Complete at-rule (statement beginning with `@') at point."
+ (save-excursion
+ (let ((pos (point)))
+ (skip-chars-backward "-[:alnum:]")
+ (when (eq (char-before) ?\@)
+ (list (point) pos css-at-ids)))))
+
+(defun css-completion-at-point ()
+ "Complete current symbol at point.
+Currently supports completion of CSS properties, pseudo-elements,
+pseudo-classes, and at-rules."
+ (or (css--complete-property)
+ (css--complete-pseudo-element-or-class)
+ (css--complete-at-rule)))
+
;;;###autoload
-(define-derived-mode css-mode fundamental-mode "CSS"
+(define-derived-mode css-mode prog-mode "CSS"
"Major mode to edit Cascading Style Sheets."
(setq-local font-lock-defaults css-font-lock-defaults)
(setq-local comment-start "/*")
(setq-local comment-start-skip "/\\*+[ \t]*")
(setq-local comment-end "*/")
(setq-local comment-end-skip "[ \t]*\\*+/")
- (setq-local forward-sexp-function 'css-forward-sexp)
- (setq-local parse-sexp-ignore-comments t)
- (setq-local indent-line-function 'css-indent-line)
- (setq-local fill-paragraph-function 'css-fill-paragraph)
+ (setq-local syntax-propertize-function
+ css-syntax-propertize-function)
+ (setq-local fill-paragraph-function #'css-fill-paragraph)
+ (setq-local adaptive-fill-function #'css-adaptive-fill)
(setq-local add-log-current-defun-function #'css-current-defun-name)
- (when css-electric-keys
- (let ((fc (make-char-table 'auto-fill-chars)))
- (set-char-table-parent fc auto-fill-chars)
- (dolist (c css-electric-keys)
- (aset fc c 'indent-according-to-mode))
- (setq-local auto-fill-chars fc))))
+ (smie-setup css-smie-grammar #'css-smie-rules
+ :forward-token #'css-smie--forward-token
+ :backward-token #'css-smie--backward-token)
+ (setq-local electric-indent-chars
+ (append css-electric-keys electric-indent-chars))
+ (add-hook 'completion-at-point-functions
+ #'css-completion-at-point nil 'local))
(defvar comment-continue)
(defun css-fill-paragraph (&optional justify)
(save-excursion
+ ;; Fill succeeding comment when invoked right before a multi-line
+ ;; comment.
+ (when (save-excursion
+ (beginning-of-line)
+ (comment-search-forward (point-at-eol) t))
+ (goto-char (match-end 0)))
(let ((ppss (syntax-ppss))
(eol (line-end-position)))
(cond
@@ -306,8 +443,11 @@
(paragraph-separate
(if (and comment-continue
(string-match "[^ \t]" comment-continue))
- (concat "\\(?:[ \t]*" (regexp-quote comment-continue)
- "\\)?\\(?:" paragraph-separate "\\)")
+ (concat "\\(?:[ \t]*\\(?:"
+ (regexp-quote comment-continue) "\\|"
+ comment-start-skip "\\|"
+ comment-end-skip "\\)\\)?"
+ "\\(?:" paragraph-separate "\\)")
paragraph-separate))
(paragraph-start
(if (and comment-continue
@@ -333,11 +473,16 @@
(cond
;; This is a false positive inside a string or comment.
((nth 8 (syntax-ppss)) nil)
+ ;; This is a false positive when encountering an
+ ;; interpolated variable (bug#19751).
+ ((eq (char-before (- (point) 1)) ?#) nil)
((eq (char-before) ?\})
(save-excursion
(forward-char -1)
(skip-chars-backward " \t")
- (unless (bolp) (newline))))
+ (when (and (not (bolp))
+ (scss-smie--not-interpolation-p))
+ (newline))))
(t
(while
(progn
@@ -355,131 +500,11 @@
;; Don't use the default filling code.
t)))))))
-;;; Navigation and indentation.
-
-(defconst css-navigation-syntax-table
- (let ((st (make-syntax-table css-mode-syntax-table)))
- (map-char-table (lambda (c v)
- ;; Turn punctuation (code = 1) into symbol (code = 1).
- (if (eq (car-safe v) 1)
- (set-char-table-range st c (cons 3 (cdr v)))))
- st)
- st))
-
-(defun css-backward-sexp (n)
- (let ((forward-sexp-function nil))
- (if (< n 0) (css-forward-sexp (- n))
- (while (> n 0)
- (setq n (1- n))
- (forward-comment (- (point-max)))
- (if (not (eq (char-before) ?\;))
- (backward-sexp 1)
- (while (progn (backward-sexp 1)
- (save-excursion
- (forward-comment (- (point-max)))
- ;; FIXME: We should also skip punctuation.
- (not (or (bobp) (memq (char-before) '(?\; ?\{))))))))))))
-
-(defun css-forward-sexp (n)
- (let ((forward-sexp-function nil))
- (if (< n 0) (css-backward-sexp (- n))
- (while (> n 0)
- (setq n (1- n))
- (forward-comment (point-max))
- (if (not (eq (char-after) ?\;))
- (forward-sexp 1)
- (while (progn (forward-sexp 1)
- (save-excursion
- (forward-comment (point-max))
- ;; FIXME: We should also skip punctuation.
- (not (memq (char-after) '(?\; ?\})))))))))))
-
-(defun css-indent-calculate-virtual ()
- (if (or (save-excursion (skip-chars-backward " \t") (bolp))
- (if (looking-at "\\s(")
- (save-excursion
- (forward-char 1) (skip-chars-forward " \t")
- (not (or (eolp) (looking-at comment-start-skip))))))
- (current-column)
- (css-indent-calculate)))
-
-(defcustom css-indent-offset 4
- "Basic size of one indentation step."
- :version "22.2"
- :type 'integer
- :group 'css)
-
-(defun css-indent-calculate ()
- (let ((ppss (syntax-ppss))
- pos)
- (with-syntax-table css-navigation-syntax-table
- (save-excursion
- (cond
- ;; Inside a string.
- ((nth 3 ppss) 'noindent)
- ;; Inside a comment.
- ((nth 4 ppss)
- (setq pos (point))
- (forward-line -1)
- (skip-chars-forward " \t")
- (if (>= (nth 8 ppss) (point))
- (progn
- (goto-char (nth 8 ppss))
- (if (eq (char-after pos) ?*)
- (forward-char 1)
- (if (not (looking-at comment-start-skip))
- (error "Internal css-mode error")
- (goto-char (match-end 0))))
- (current-column))
- (if (and (eq (char-after pos) ?*) (eq (char-after) ?*))
- (current-column)
- ;; 'noindent
- (current-column)
- )))
- ;; In normal code.
- (t
- (or
- (when (looking-at "\\s)")
- (forward-char 1)
- (backward-sexp 1)
- (css-indent-calculate-virtual))
- (when (looking-at comment-start-skip)
- (forward-comment (point-max))
- (css-indent-calculate))
- (when (save-excursion (forward-comment (- (point-max)))
- (setq pos (point))
- (eq (char-syntax (preceding-char)) ?\())
- (goto-char (1- pos))
- (if (not (looking-at "\\s([ \t]*"))
- (error "Internal css-mode error")
- (if (or (memq (char-after (match-end 0)) '(?\n nil))
- (save-excursion (goto-char (match-end 0))
- (looking-at comment-start-skip)))
- (+ (css-indent-calculate-virtual) css-indent-offset)
- (progn (goto-char (match-end 0)) (current-column)))))
- (progn
- (css-backward-sexp 1)
- (if (looking-at "\\s(")
- (css-indent-calculate)
- (css-indent-calculate-virtual))))))))))
-
-
-(defun css-indent-line ()
- "Indent current line according to CSS indentation rules."
- (interactive)
- (let* ((savep (point))
- (forward-sexp-function nil)
- (indent (condition-case nil
- (save-excursion
- (forward-line 0)
- (skip-chars-forward " \t")
- (if (>= (point) savep) (setq savep nil))
- (css-indent-calculate))
- (error nil))))
- (if (not (numberp indent)) 'noindent
- (if savep
- (save-excursion (indent-line-to indent))
- (indent-line-to indent)))))
+(defun css-adaptive-fill ()
+ (when (looking-at "[ \t]*/\\*[ \t]*")
+ (let ((str (match-string 0)))
+ (and (string-match "/\\*" str)
+ (replace-match " *" t t str)))))
(defun css-current-defun-name ()
"Return the name of the CSS section at point, or nil."
@@ -491,5 +516,36 @@
(if (looking-at "^[ \t]*\\([^{\r\n]*[^ {\t\r\n]\\)")
(match-string-no-properties 1))))))
+;;; SCSS mode
+
+(defvar scss-mode-syntax-table
+ (let ((st (make-syntax-table css-mode-syntax-table)))
+ (modify-syntax-entry ?/ ". 124" st)
+ (modify-syntax-entry ?\n ">" st)
+ st))
+
+(defvar scss-font-lock-keywords
+ (append `((,(concat "$" css-ident-re) (0 font-lock-variable-name-face)))
+ (css--font-lock-keywords 'sassy)
+ `((,(concat "@mixin[ \t]+\\(" css-ident-re "\\)[ \t]*(")
+ (1 font-lock-function-name-face)))))
+
+(defun scss-smie--not-interpolation-p ()
+ (save-excursion
+ (forward-char -1)
+ (or (zerop (skip-chars-backward "-[:alnum:]"))
+ (not (looking-back "#{\\$" (- (point) 3))))))
+
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.scss\\'" . scss-mode))
+;;;###autoload
+(define-derived-mode scss-mode css-mode "SCSS"
+ "Major mode to edit \"Sassy CSS\" files."
+ (setq-local comment-start "// ")
+ (setq-local comment-end "")
+ (setq-local comment-continue " *")
+ (setq-local comment-start-skip "/[*/]+[ \t]*")
+ (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)")
+ (setq-local font-lock-defaults '(scss-font-lock-keywords nil t)))
+
(provide 'css-mode)
;;; css-mode.el ends here
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index fe7ae17373c..4862d453d97 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,6 +1,6 @@
;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
-;; Copyright (C) 2000-2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2001, 2004-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: DNS master zone file SOA comm
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index e22ad24ccae..040a50e3099 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,6 +1,6 @@
;;; enriched.el --- read and save files in text/enriched format
-;; Copyright (C) 1994-1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Keywords: wp, faces
@@ -31,7 +31,7 @@
;; are supported except for <smaller> and <bigger>, which are currently not
;; possible to display.
-;; A separate file, enriched.doc, contains further documentation and other
+;; A separate file, enriched.txt, contains further documentation and other
;; important information about this code. It also serves as an example
;; file in text/enriched format. It should be in the etc directory of your
;; emacs distribution.
@@ -199,7 +199,7 @@ if ARG is omitted or nil.
Turning the mode on or off runs `enriched-mode-hook'.
More information about Enriched mode is available in the file
-etc/enriched.doc in the Emacs distribution directory.
+\"enriched.txt\" in `data-directory'.
Commands:
@@ -314,7 +314,8 @@ the region, and the START and END of each region."
;;;###autoload
(defun enriched-encode (from to orig-buf)
(if enriched-verbose (message "Enriched: encoding document..."))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
(save-restriction
(narrow-to-region from to)
(delete-to-left-margin)
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 119b4b04593..a97facf5427 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,9 +1,9 @@
-;;; fill.el --- fill commands for Emacs -*- coding: utf-8 -*-
+;;; fill.el --- fill commands for Emacs
-;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2013 Free
+;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2015 Free
;; Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; Package: emacs
@@ -329,13 +329,24 @@ places."
(and (memq (preceding-char) '(?\t ?\s))
(eq (char-syntax (following-char)) ?w)))))))
+(defun fill-single-char-nobreak-p ()
+ "Return non-nil if a one-letter word is before point.
+This function is suitable for adding to the hook `fill-nobreak-predicate',
+to prevent the breaking of a line just after a one-letter word,
+which is an error according to some typographical conventions."
+ (save-excursion
+ (skip-chars-backward " \t")
+ (backward-char 2)
+ (looking-at "[[:space:]][[:alpha:]]")))
+
(defcustom fill-nobreak-predicate nil
"List of predicates for recognizing places not to break a line.
The predicates are called with no arguments, with point at the place to
be tested. If it returns t, fill commands do not break the line there."
:group 'fill
:type 'hook
- :options '(fill-french-nobreak-p fill-single-word-nobreak-p))
+ :options '(fill-french-nobreak-p fill-single-word-nobreak-p
+ fill-single-char-nobreak-p))
(defcustom fill-nobreak-invisible nil
"Non-nil means that fill commands do not break lines in invisible text."
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 81f17c897eb..6c4a731629c 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1,9 +1,9 @@
-;;; flyspell.el --- on-the-fly spell checker
+;;; flyspell.el --- On-the-fly spell checker -*- lexical-binding:t -*-
-;; Copyright (C) 1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -39,6 +39,7 @@
;;; Code:
(require 'ispell)
+(eval-when-compile (require 'cl-lib))
;;*---------------------------------------------------------------------*/
;;* Group ... */
@@ -92,7 +93,7 @@ downcased before comparing with these exceptions."
:version "21.1"
:type 'boolean)
-(defcustom flyspell-duplicate-distance -1
+(defcustom flyspell-duplicate-distance 400000
"The maximum distance for finding duplicates of unrecognized words.
This applies to the feature that when a word is not found in the dictionary,
if the same spelling occurs elsewhere in the buffer,
@@ -101,7 +102,7 @@ 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 "21.1"
+ :version "24.5" ; -1 -> 400000
:type '(choice (const :tag "no limit" -1)
number))
@@ -283,6 +284,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)
;;*---------------------------------------------------------------------*/
@@ -302,8 +304,8 @@ Returns t to continue checking, nil otherwise.
Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate'
property of the major mode name.")
(make-variable-buffer-local 'flyspell-generic-check-word-predicate)
-(defvaralias 'flyspell-generic-check-word-p
- 'flyspell-generic-check-word-predicate)
+(define-obsolete-variable-alias 'flyspell-generic-check-word-p
+ 'flyspell-generic-check-word-predicate "25.1")
;;*--- mail mode -------------------------------------------------------*/
(put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
@@ -311,21 +313,22 @@ property of the major mode name.")
(defvar message-signature-separator)
(defun mail-mode-flyspell-verify ()
"Function used for `flyspell-generic-check-word-predicate' in Mail mode."
- (let ((header-end (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^"
- (regexp-quote mail-header-separator)
- "$")
- nil t)
- (point)))
- (signature-begin
- (if (not (boundp 'message-signature-separator))
- (point-max)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward message-signature-separator nil t)
- (point)))))
+ (let* ((header-end (save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\(?:"
+ (regexp-quote mail-header-separator)
+ "\\)?$")
+ nil t)
+ (point)))
+ (signature-begin
+ (if (not (boundp 'message-signature-separator))
+ (point-max)
+ (save-excursion
+ (goto-char (point-max))
+ (re-search-backward message-signature-separator
+ (max header-end (- (point) 4000)) t)
+ (point)))))
(cond ((< (point) header-end)
(and (save-excursion (beginning-of-line)
(looking-at "^Subject:"))
@@ -395,7 +398,7 @@ like <img alt=\"Some thing.\">."
"Turn on `flyspell-mode' for comments and strings."
(interactive)
(setq flyspell-generic-check-word-predicate
- 'flyspell-generic-progmode-verify)
+ #'flyspell-generic-progmode-verify)
(flyspell-mode 1)
(run-hooks 'flyspell-prog-mode-hook))
@@ -498,7 +501,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 (function (lambda () (setq ispell-parser \\='tex))))
in your init file.
\\[flyspell-region] checks all words inside a region.
@@ -790,7 +793,7 @@ before the current command."
;;*---------------------------------------------------------------------*/
;;* flyspell-after-change-function ... */
;;*---------------------------------------------------------------------*/
-(defun flyspell-after-change-function (start stop len)
+(defun flyspell-after-change-function (start stop _len)
"Save the current buffer and point for Flyspell's post-command hook."
(push (cons start stop) flyspell-changes))
@@ -1009,17 +1012,33 @@ Mostly we check word delimiters."
;;*---------------------------------------------------------------------*/
(defun flyspell-word-search-backward (word bound &optional ignore-case)
(save-excursion
- (let ((r '())
- (inhibit-point-motion-hooks t)
- p)
- (while (and (not r) (setq p (search-backward word bound t)))
- (let ((lw (flyspell-get-word)))
- (if (and (consp lw)
- (if ignore-case
- (string-equal (downcase (car lw)) (downcase word))
- (string-equal (car lw) word)))
- (setq r p)
- (goto-char p))))
+ (let* ((r '())
+ (inhibit-point-motion-hooks t)
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (bound (if (and bound
+ (> bound (point-min)))
+ (- bound 1)))
+ (word-re (concat
+ "\\(?:" flyspell-not-casechars "\\|\\`\\)"
+ (regexp-quote word)
+ flyspell-not-casechars))
+ p)
+ (while
+ (and (not r)
+ (setq p
+ (and
+ (re-search-backward word-re bound t)
+ (if (bobp)
+ (point)
+ (forward-char)
+ (point)))))
+ (let ((lw (flyspell-get-word)))
+ (if (and (consp lw)
+ (if ignore-case
+ (string-equal (downcase (car lw)) (downcase word))
+ (string-equal (car lw) word)))
+ (setq r p)
+ (goto-char p))))
r)))
;;*---------------------------------------------------------------------*/
@@ -1027,16 +1046,32 @@ Mostly we check word delimiters."
;;*---------------------------------------------------------------------*/
(defun flyspell-word-search-forward (word bound)
(save-excursion
- (let ((r '())
- (inhibit-point-motion-hooks t)
- p)
- (while (and (not r) (setq p (search-forward word bound t)))
- (let ((lw (flyspell-get-word)))
- (if (and (consp lw) (string-equal (car lw) word))
- (setq r p)
- (goto-char (1+ p)))))
+ (let* ((r '())
+ (inhibit-point-motion-hooks t)
+ (flyspell-not-casechars (flyspell-get-not-casechars))
+ (bound (if (and bound
+ (< bound (point-max)))
+ (+ bound 1)))
+ (word-re (concat flyspell-not-casechars
+ (regexp-quote word)
+ "\\(?:" flyspell-not-casechars "\\|\\'\\)"))
+ p)
+ (while
+ (and (not r)
+ (setq p (and
+ (re-search-forward word-re bound t)
+ (if (eobp)
+ (point)
+ (backward-char)
+ (point)))))
+ (let ((lw (flyspell-get-word)))
+ (if (and (consp lw) (string-equal (car lw) word))
+ (setq r p)
+ (goto-char (1+ p)))))
r)))
+(defvar flyspell-word) ;Backward compatibility; some predicates made use of it!
+
;;*---------------------------------------------------------------------*/
;;* flyspell-word ... */
;;*---------------------------------------------------------------------*/
@@ -1084,7 +1119,8 @@ misspelling and skips redundant spell-checking step."
(let* ((bound
(- start
(- end start)
- (- (skip-chars-backward " \t\n\f"))))
+ (- (save-excursion
+ (skip-chars-backward " \t\n\f")))))
(p (when (>= bound (point-min))
(flyspell-word-search-backward word bound t))))
(and p (/= p start)))))
@@ -1314,7 +1350,7 @@ that may be included as part of a word (see `ispell-dictionary-alist')."
(if (and flyspell-issue-message-flag (= count 100))
(progn
(message "Spell Checking...%d%%"
- (* 100 (/ (float (- (point) beg)) (- end beg))))
+ (floor (* 100.0 (- (point) beg)) (- end beg)))
(setq count 0))
(setq count (+ 1 count)))
(flyspell-word)
@@ -1367,7 +1403,7 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;; be unnecessary too. -- rms.
(if flyspell-issue-message-flag
(message "Spell Checking...%d%% [%s]"
- (* 100 (/ (float (point)) (point-max)))
+ (floor (* 100.0 (point)) (point-max))
word))
(with-current-buffer flyspell-large-region-buffer
(goto-char buffer-scan-pos)
@@ -1419,9 +1455,9 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;; end of last validated match.
(setq buffer-scan-pos (point))))
;; Record if misspelling is not found and try new one
- (add-to-list 'words-not-found
- (concat " -> " word " - "
- (int-to-string wordpos)))
+ (cl-pushnew (concat " -> " word " - "
+ (int-to-string wordpos))
+ words-not-found :test #'equal)
(setq keep nil)))))))
;; we are done
(if flyspell-issue-message-flag (message "Spell Checking completed.")))
@@ -1527,7 +1563,8 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
(let ((extended-char-mode (ispell-get-extended-character-mode)))
(and extended-char-mode ; ~ extended character mode
(string-match "[^~]+$" extended-char-mode)
- (add-to-list 'args (concat "-T" (match-string 0 extended-char-mode)))))
+ (cl-pushnew (concat "-T" (match-string 0 extended-char-mode))
+ args :test #'equal)))
;; Add ispell-extra-args
(setq args (append args ispell-extra-args))
@@ -1791,11 +1828,12 @@ as returned by `ispell-parse-output'."
;;* flyspell-check-previous-highlighted-word ... */
;;*---------------------------------------------------------------------*/
(defun flyspell-check-previous-highlighted-word (&optional arg)
- "Correct the closer misspelled word.
-This function scans a mis-spelled word before the cursor. If it finds one
-it proposes replacement for that word. With prefix arg, count that many
-misspelled words backwards."
- (interactive)
+ "Correct the closest previous word that is highlighted as misspelled.
+This function scans for a word which starts before point that has been
+highlighted by Flyspell as misspelled. If it finds one, it proposes
+a replacement for that word. With prefix arg N, check the Nth word
+before point that's highlighted as misspelled."
+ (interactive "P")
(let ((pos1 (point))
(pos (point))
(arg (if (or (not (numberp arg)) (< arg 1)) 1 arg))
@@ -1806,7 +1844,7 @@ misspelled words backwards."
(setq pos1 pos)
(if (> pos (point-min))
(progn
- (setq ovs (overlays-at (1- pos)))
+ (setq ovs (overlays-at pos))
(while (consp ovs)
(setq ov (car ovs))
(setq ovs (cdr ovs))
@@ -2051,8 +2089,6 @@ If EVENT is non-nil, it is the mouse event that invoked this operation;
that controls where to put the menu.
If OPOINT is non-nil, restore point there after adjusting it for replacement."
(interactive)
- (unless (mouse-position)
- (error "Pop-up menus do not work on this terminal"))
;; use the correct dictionary
(flyspell-accept-buffer-local-defs)
(or opoint (setq opoint (point)))
@@ -2167,9 +2203,8 @@ If OPOINT is non-nil, restore point there after adjusting it for replacement."
;;*---------------------------------------------------------------------*/
(defun flyspell-emacs-popup (event poss word)
"The Emacs popup menu."
- (unless window-system
- (error "This command requires pop-up dialogs"))
- (if (not event)
+ (if (and (not event)
+ (display-mouse-p))
(let* ((mouse-pos (mouse-position))
(mouse-pos (if (nth 1 mouse-pos)
mouse-pos
@@ -2291,7 +2326,7 @@ If the text between BEG and END is equal to a correction suggested by
Ispell, after transposing two adjacent characters, correct the text,
and return t.
-The third arg POSS is either the symbol 'doublon' or a list of
+The third arg POSS is either the symbol `doublon' or a list of
possible corrections as returned by `ispell-parse-output'.
This function is meant to be added to `flyspell-incorrect-hook'."
@@ -2321,7 +2356,7 @@ If the text between BEG and END is equal to a correction suggested by
Ispell, after removing a pair of doubled characters, correct the text,
and return t.
-The third arg POSS is either the symbol 'doublon' or a list of
+The third arg POSS is either the symbol `doublon' or a list of
possible corrections as returned by `ispell-parse-output'.
This function is meant to be added to `flyspell-incorrect-hook'."
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 3998fafa5cc..fe27f0f158c 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,6 +1,6 @@
;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
-;; Copyright (C) 1994-1995, 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1995, 1997-2015 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
@@ -388,7 +388,7 @@ It consists of pairs (REGEXP . DICTIONARY). If REGEXP is found
in the message headers, `ispell-local-dictionary' will be set to
DICTIONARY if `ispell-local-dictionary' is not buffer-local.
E.g. you may use the following value:
- '((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\")
+ ((\"^Newsgroups:[ \\t]*de\\\\.\" . \"deutsch8\")
(\"^To:[^\\n,]+\\\\.de[ \\t\\n,>]\" . \"deutsch8\"))"
:type '(repeat (cons regexp string))
:group 'ispell)
@@ -484,7 +484,7 @@ The function must take one string argument and return a string."
"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
window system by evaluating the following on startup to set this variable:
- (and window-system (condition-case () (require 'framepop) (error nil)))"
+ (and window-system (condition-case () (require \\='framepop) (error nil)))"
:type 'boolean
:group 'ispell)
@@ -492,7 +492,7 @@ window system by evaluating the following on startup to set this variable:
(defcustom ispell-personal-dictionary nil
"File name of your personal spelling dictionary, or nil.
If nil, the default personal dictionary, (\"~/.ispell_DICTNAME\" for ispell or
-\"~/.aspell.LANG.pws\" for aspell) is used, where DICTNAME is the name of your
+\"~/.aspell.LANG.pws\" for Aspell) is used, where DICTNAME is the name of your
default dictionary and LANG the two letter language code."
:type '(choice file
(const :tag "default" nil))
@@ -699,8 +699,8 @@ re-start Emacs."
Each element of this list is also a list:
-\(DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
- ISPELL-ARGS EXTENDED-CHARACTER-MODE CHARACTER-SET\)
+ (DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
+ ISPELL-ARGS EXTENDED-CHARACTER-MODE CHARACTER-SET)
DICTIONARY-NAME is a possible string value of variable `ispell-dictionary',
nil means the default dictionary.
@@ -747,35 +747,35 @@ when the language uses non-ASCII characters.
Note that with \"ispell\" as the speller, the CASECHARS and
OTHERCHARS slots of the alist should contain the same character
set as casechars and otherchars in the LANGUAGE.aff file \(e.g.,
-english.aff\). aspell and hunspell don't have this limitation.")
+english.aff). Aspell and Hunspell don't have this limitation.")
(defvar ispell-really-aspell nil
- "Non-nil if we can use aspell extensions.")
+ "Non-nil if we can use Aspell extensions.")
(defvar ispell-really-hunspell nil
- "Non-nil if we can use hunspell extensions.")
+ "Non-nil if we can use Hunspell extensions.")
(defvar ispell-encoding8-command nil
"Command line option prefix to select encoding if supported, nil otherwise.
If setting the encoding is supported by spellchecker and is selectable from
-the command line, this variable will contain \"--encoding=\" for aspell
-and \"-i \" for hunspell, so the appropriate mime charset can be selected.
-That will be set in `ispell-check-version' for hunspell >= 1.1.6 and
-aspell >= 0.60.
+the command line, this variable will contain \"--encoding=\" for Aspell
+and \"-i \" for Hunspell, so the appropriate mime charset can be selected.
+That will be set in `ispell-check-version' for Hunspell >= 1.1.6 and
+Aspell >= 0.60.
-For aspell, non-nil also means to try to automatically find its dictionaries.
+For Aspell, non-nil also means to try to automatically find its dictionaries.
-Earlier aspell versions do not consistently support charset encoding. Handling
+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.
+ "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
+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-hunspell-dictionary-equivs-alist
+(defvar ispell-dicts-name2locale-equivs-alist
'(("american" "en_US")
("brasileiro" "pt_BR")
("british" "en_GB")
@@ -807,7 +807,7 @@ here just for backwards compatibility.")
("slovenian" "sl_SI")
("svenska" "sv_SE")
("hebrew" "he_IL"))
- "Alist with matching hunspell dict names for standard dict names in
+ "Alist with known matching locales for standard dict names in
`ispell-dictionary-base-alist'.")
(defvar ispell-emacs-alpha-regexp
@@ -931,22 +931,20 @@ Otherwise returns the library directory name, if that is defined."
(defun ispell-call-process (&rest args)
"Like `call-process' but defend against bad `default-directory'."
(let ((default-directory default-directory))
- (unless (and (file-directory-p default-directory)
- (file-readable-p default-directory))
+ (unless (file-accessible-directory-p default-directory)
(setq default-directory (expand-file-name "~/")))
(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 (and (file-directory-p default-directory)
- (file-readable-p default-directory))
+ (unless (file-accessible-directory-p default-directory)
(setq default-directory (expand-file-name "~/")))
(apply 'call-process-region args)))
(defun ispell-create-debug-buffer (&optional append)
"Create an ispell debug buffer for debugging output.
-Use APPEND to append the info to previous buffer if exists,
+If APPEND is non-nil, append the info to previous buffer if exists,
otherwise is reset. Returns name of ispell debug buffer.
See `ispell-buffer-with-debug' for an example of use."
(let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
@@ -958,7 +956,7 @@ See `ispell-buffer-with-debug' for an example of use."
ispell-debug-buffer))
(defsubst ispell-print-if-debug (format &rest args)
- "Print message to `ispell-debug-buffer' buffer if enabled."
+ "Print message using FORMAT and ARGS to `ispell-debug-buffer' buffer if enabled."
(if (boundp 'ispell-debug-buffer)
(with-current-buffer ispell-debug-buffer
(goto-char (point-max))
@@ -1011,13 +1009,13 @@ and added as a submenu of the \"Edit\" menu.")
;; Make ispell.el work better with aspell.
(defvar ispell-aspell-dictionary-alist nil
- "An alist of parsed aspell dicts and associated parameters.
+ "An alist of parsed Aspell dicts and associated parameters.
Internal use.")
(defun ispell-find-aspell-dictionaries ()
"Find Aspell's dictionaries, and record in `ispell-dictionary-alist'."
(unless (and ispell-really-aspell ispell-encoding8-command)
- (error "This function only works with aspell >= 0.60"))
+ (error "This function only works with Aspell >= 0.60"))
(let* ((dictionaries
(split-string
(with-temp-buffer
@@ -1055,30 +1053,40 @@ Assumes that value contains no whitespace."
(car (split-string (buffer-string)))))
(defun ispell-aspell-find-dictionary (dict-name)
- "For aspell dictionary DICT-NAME, return a list of parameters if an
+ "For Aspell dictionary DICT-NAME, return a list of parameters if an
associated data file is found or nil otherwise. List format is that
of `ispell-dictionary-base-alist' elements."
+
+ ;; Make sure `ispell-aspell-dict-dir' is defined
+ (or ispell-aspell-dict-dir
+ (setq ispell-aspell-dict-dir
+ (ispell-get-aspell-config-value "dict-dir")))
+
;; Make sure `ispell-aspell-data-dir' is defined
(or ispell-aspell-data-dir
(setq ispell-aspell-data-dir
(ispell-get-aspell-config-value "data-dir")))
- ;; Try finding associated datafile
- (let* ((datafile1
- (concat ispell-aspell-data-dir "/"
- ;; Strip out variant, country code, etc.
- (and (string-match "^[[:alpha:]]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (datafile2
- (concat ispell-aspell-data-dir "/"
- ;; Strip out anything but xx_YY.
- (and (string-match "^[[:alpha:]_]+" dict-name)
- (match-string 0 dict-name)) ".dat"))
- (data-file
- (if (file-readable-p datafile1)
- datafile1
- (if (file-readable-p datafile2)
- datafile2)))
- otherchars)
+
+ ;; Try finding associated datafile. aspell will look for master .dat
+ ;; file in `dict-dir' and `data-dir'. Associated .dat files must be
+ ;; in the same directory as master file.
+ (let ((data-file
+ (catch 'datafile
+ (dolist ( tmp-path (list ispell-aspell-dict-dir
+ ispell-aspell-data-dir ))
+ ;; Try xx.dat first, strip out variant, country code, etc,
+ ;; then try xx_YY.dat (without stripping country code),
+ ;; then try xx-alt.dat, for de-alt etc.
+ (dolist (tmp-regexp (list "^[[:alpha:]]+"
+ "^[[:alpha:]_]+"
+ "^[[:alpha:]]+-\\(alt\\|old\\)"))
+ (let ((fullpath
+ (concat tmp-path "/"
+ (and (string-match tmp-regexp dict-name)
+ (match-string 0 dict-name)) ".dat")))
+ (if (file-readable-p fullpath)
+ (throw 'datafile fullpath)))))))
+ otherchars)
(if data-file
(with-temp-buffer
@@ -1111,7 +1119,7 @@ of `ispell-dictionary-base-alist' elements."
'utf-8)))))
(defun ispell-aspell-add-aliases (alist)
- "Find aspell's dictionary aliases and add them to dictionary ALIST.
+ "Find Aspell's dictionary aliases and add them to dictionary ALIST.
Return the new dictionary alist."
(let ((aliases
(file-expand-wildcards
@@ -1130,46 +1138,53 @@ Return the new dictionary alist."
(realdict (assoc realname alist)))
(when (and realdict (not already-exists-p))
(push (cons aliasname (cdr realdict)) alist))))))
+ ;; Add entries for standard dict-names with found locale-matching entry
+ (dolist (dict-map-entry ispell-dicts-name2locale-equivs-alist)
+ (let ((name (car dict-map-entry))
+ (locale (cadr dict-map-entry)))
+ (unless (assoc name alist) ;; skip if already present
+ (if (assoc locale alist)
+ (push (cons name (cdr (assoc locale alist))) alist)))))
alist))
;; Make ispell.el work better with hunspell.
(defvar ispell-hunspell-dict-paths-alist nil
- "Alist of parsed hunspell dicts and associated affix files.
+ "Alist of parsed Hunspell dicts and associated affix files.
Will be used to parse corresponding .aff file and create associated
parameters to be inserted into `ispell-hunspell-dictionary-alist'.
Internal use.")
(defvar ispell-hunspell-dictionary-alist nil
- "Alist of parsed hunspell dicts and associated parameters.
+ "Alist of parsed Hunspell dicts and associated parameters.
This alist will initially contain names of found dicts. Associated
parameters will be added when dict is used for the first time.
Internal use.")
(defun ispell-hunspell-fill-dictionary-entry (dict)
- "Fill `ispell-dictionary-alist' uninitialized entries for `DICT' and aliases.
-Value will be extracted from hunspell affix file and used for
+ "Fill uninitialized entries in `ispell-dictionary-alist' for DICT and aliases.
+Value of those entries will be extracted from Hunspell affix file and used for
all uninitialized dicts using that affix file."
(if (cadr (assoc dict ispell-dictionary-alist))
(message "ispell-hfde: Non void entry for %s. Skipping.\n" dict)
(let ((dict-alias
- (cadr (assoc dict ispell-hunspell-dictionary-equivs-alist)))
+ (cadr (assoc dict ispell-dicts-name2locale-equivs-alist)))
(use-for-dicts (list dict))
(dict-args-cdr (cdr (ispell-parse-hunspell-affix-file dict)))
newlist)
;; Get a list of uninitialized dicts using the same affix file.
- (dolist (dict-equiv-alist-entry ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv-alist-entry ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv-alist-entry))
(dict-equiv-value (cadr dict-equiv-alist-entry)))
(if (or (member dict dict-equiv-alist-entry)
(member dict-alias dict-equiv-alist-entry))
- (dolist ( tmp-dict (list dict-equiv-key dict-equiv-value))
+ (dolist (tmp-dict (list dict-equiv-key dict-equiv-value))
(if (cadr (assoc tmp-dict ispell-dictionary-alist))
(ispell-print-if-debug
- "ispell-hfde: %s already expanded. Skipping.\n" tmp-dict)
+ "ispell-hfde: %s already expanded; skipping.\n" tmp-dict)
(add-to-list 'use-for-dicts tmp-dict))))))
(ispell-print-if-debug
- "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts)
+ "ispell-hfde: Filling %s entry. Use for %s.\n" dict use-for-dicts)
;; The final loop.
(dolist (entry ispell-dictionary-alist)
(if (member (car entry) use-for-dicts)
@@ -1179,52 +1194,89 @@ all uninitialized dicts using that affix file."
(setq ispell-dictionary-alist newlist))))
(defun ispell-parse-hunspell-affix-file (dict-key)
- "Parse hunspell affix file to extract parameters for `DICT-KEY'.
-Return a list in `ispell-dictionary-alist' format."
- (let ((affix-file (cadr (assoc dict-key ispell-hunspell-dict-paths-alist))))
- (unless affix-file
- (error "ispell-phaf: No matching entry for %s.\n" dict-key))
- (if (not (file-exists-p affix-file))
- (error "ispell-phaf: File \"%s\" not found.\n" affix-file))
- (let ((dict-name (file-name-sans-extension
- (file-name-nondirectory affix-file)))
- otherchars-string otherchars-list)
- (with-temp-buffer
- (insert-file-contents affix-file)
- (setq otherchars-string
- (save-excursion
- (goto-char (point-min))
- (if (search-forward-regexp "^WORDCHARS +" nil t )
- (buffer-substring (point)
- (progn (end-of-line) (point))))))
- ;; Remove trailing whitespace and extra stuff. Make list if
- ;; non-nil.
- (setq otherchars-list
- (if otherchars-string
- (split-string
- (if (string-match " +.*$" otherchars-string)
- (replace-match "" nil nil otherchars-string)
- otherchars-string)
- "" t)))
-
- ;; Fill dict entry
- (list dict-key
- "[[:alpha:]]"
- "[^[:alpha:]]"
- (if otherchars-list
- (regexp-opt otherchars-list)
- "")
- t ; many-otherchars-p: We can't tell, set to t.
- (list "-d" dict-name)
- nil ; extended-char-mode: not supported by hunspell!
- 'utf-8)))))
+ "Parse Hunspell affix file to extract parameters for DICT-KEY.
+Return a list in `ispell-dictionary-alist' format.
+
+DICT_KEY can be in the \"DICT1,DICT2,DICT3\" format, to invoke Hunspell
+with a list of dictionaries. The first dictionary in the list must have
+a corresponding .aff affix file; the rest are allowed to have no affix
+files, and will then use the affix file of the preceding dictionary that
+did."
+ (let ((dict-list (split-string dict-key "," t))
+ (first-p t)
+ (dict-arg "")
+ otherchars-list)
+ (dolist (dict-key dict-list)
+ (let ((affix-file
+ (cadr (assoc dict-key ispell-hunspell-dict-paths-alist))))
+ (unless affix-file
+ (error "ispell-phaf: No matching entry for %s in `ispell-hunspell-dict-paths-alist'.\n" dict-key))
+ (if (and first-p (not (file-exists-p affix-file)))
+ (error "ispell-phaf: File \"%s\" not found.\n" affix-file))
+ (and first-p (setq first-p nil))
+ (let ((dict-name (file-name-sans-extension
+ (file-name-nondirectory affix-file)))
+ otherchars-string)
+ (with-temp-buffer
+ (insert-file-contents affix-file)
+ (setq otherchars-string
+ (save-excursion
+ (goto-char (point-min))
+ (if (search-forward-regexp "^WORDCHARS +" nil t )
+ (buffer-substring (point)
+ (progn (end-of-line) (point))))))
+ ;; Remove trailing whitespace and extra stuff. Make list
+ ;; if non-nil.
+ (if otherchars-string
+ (let* ((otherchars-string
+ ;; Remove trailing junk.
+ (substring otherchars-string
+ 0 (string-match " +" otherchars-string)))
+ (chars-list (append otherchars-string nil)))
+ (setq chars-list (delq ?\ chars-list))
+ (dolist (ch chars-list)
+ (add-to-list 'otherchars-list ch)))))
+ ;; Cons the argument for the -d switch.
+ (setq dict-arg (concat dict-arg
+ (if (> (length dict-arg) 0) ",")
+ dict-name)))))
+
+ ;; Fill dict entry
+ (list dict-key
+ "[[:alpha:]]"
+ "[^[:alpha:]]"
+ (if otherchars-list
+ (regexp-opt (mapcar 'char-to-string otherchars-list))
+ "")
+ t ; many-otherchars-p: We can't tell, set to t.
+ (list "-d" dict-arg)
+ nil ; extended-char-mode: not supported by hunspell!
+ 'utf-8)))
+
+(defun ispell-hunspell-add-multi-dic (dict)
+ "Add DICT of the form \"DICT1,DICT2,...\" to `ispell-dictionary-alist'.
+
+Invoke this command before you want to start Hunspell for the first time
+with a particular combination of dictionaries. The first dictionary
+in the list must have an affix file where Hunspell affix files are kept."
+ (interactive "sMulti-dictionary combination: ")
+ ;; Make sure the first dictionary in the list is known to us.
+ (let ((first-dict (car (split-string dict "," t))))
+ (unless ispell-hunspell-dictionary-alist
+ (ispell-find-hunspell-dictionaries)
+ (setq ispell-dictionary-alist ispell-hunspell-dictionary-alist))
+ (or (assoc first-dict ispell-local-dictionary-alist)
+ (assoc first-dict ispell-dictionary-alist)
+ (error "Unknown dictionary: %s" first-dict)))
+ (add-to-list 'ispell-dictionary-alist (list dict '()))
+ (ispell-hunspell-fill-dictionary-entry dict))
(defun ispell-find-hunspell-dictionaries ()
- "Look for installed hunspell dictionaries.
+ "Look for installed Hunspell dictionaries.
Will initialize `ispell-hunspell-dictionary-alist' and
`ispell-hunspell-dictionary-alist' after values found
-and remove `ispell-hunspell-dictionary-equivs-alist'
-entries if a specific dict was found."
+and remove `ispell-dicts-name2locale-equivs-alist'
+entries if a specific dictionary was found."
(let ((hunspell-found-dicts
(split-string
(with-temp-buffer
@@ -1245,7 +1297,7 @@ entries if a specific dict was found."
(if (string-match "\\.aff$" dict)
;; Found default dictionary
(if hunspell-default-dict
- (error "ispell-fhd: Default dict already defined as %s. Not using %s.\n"
+ (error "ispell-fhd: Default dict already defined as %s. Not using %s.\n"
hunspell-default-dict dict)
(setq affix-file dict)
(setq hunspell-default-dict (list basename affix-file)))
@@ -1262,15 +1314,15 @@ entries if a specific dict was found."
"-- ispell-fhd: Skipping entry: %s\n" dict)))))
;; Remove entry from aliases alist if explicit dict was found.
(let (newlist)
- (dolist (dict ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict ispell-dicts-name2locale-equivs-alist)
(if (assoc (car dict) ispell-hunspell-dict-paths-alist)
(ispell-print-if-debug
- "-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
+ "-- ispell-fhd: Excluding %s alias. Standalone dict found.\n"
(car dict))
(add-to-list 'newlist dict)))
- (setq ispell-hunspell-dictionary-equivs-alist newlist))
+ (setq ispell-dicts-name2locale-equivs-alist newlist))
;; Add known hunspell aliases
- (dolist (dict-equiv ispell-hunspell-dictionary-equivs-alist)
+ (dolist (dict-equiv ispell-dicts-name2locale-equivs-alist)
(let ((dict-equiv-key (car dict-equiv))
(dict-equiv-value (cadr dict-equiv))
(exclude-aliases (list ;; Exclude TeX aliases
@@ -1367,7 +1419,7 @@ aspell is used along with Emacs).")
(let* ((dict-name (nth 0 adict))
(dict-equiv
(cadr (assoc dict-name
- ispell-hunspell-dictionary-equivs-alist)))
+ ispell-dicts-name2locale-equivs-alist)))
(ispell-args (nth 5 adict))
(ispell-args-has-d (member "-d" ispell-args))
skip-dict)
@@ -1386,7 +1438,7 @@ aspell is used along with Emacs).")
(setq ispell-args
(nconc ispell-args (list "-d" dict-equiv)))
(message
- "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping."
+ "ispell-set-spellchecker-params: Missing Hunspell equiv for \"%s\". Skipping."
dict-name)
(setq skip-dict t)))
@@ -1604,12 +1656,12 @@ The variable `ispell-library-directory' defines their location."
(defvar ispell-current-dictionary nil
"The name of the current dictionary, or nil for the default.
-This is passed to the ispell process using the `-d' switch and is
+This is passed to the Ispell process using the `-d' switch and is
used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.")
(defvar ispell-current-personal-dictionary nil
"The name of the current personal dictionary, or nil for the default.
-This is passed to the ispell process using the `-p' switch.")
+This is passed to the Ispell process using the `-p' switch.")
(defun ispell-decode-string (str)
"Decodes multibyte character strings.
@@ -1844,7 +1896,7 @@ Currently the only other valid parser is `tex'.
You can set this variable in hooks in your init file -- eg:
-\(add-hook 'tex-mode-hook (lambda () (setq ispell-parser 'tex)))")
+\(add-hook \\='tex-mode-hook (lambda () (setq ispell-parser \\='tex)))")
(defvar ispell-region-end (make-marker)
"Marker that allows spelling continuations.")
@@ -1862,9 +1914,9 @@ You can set this variable in hooks in your init file -- eg:
(defun ispell-accept-output (&optional timeout-secs timeout-msecs)
- "Wait for output from ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS.
+ "Wait for output from Ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS.
If asynchronous subprocesses are not supported, call function `ispell-filter'
-and pass it the output of the last ispell invocation."
+and pass it the output of the last Ispell invocation."
(if ispell-async-processp
(accept-process-output ispell-process timeout-secs timeout-msecs)
(if (null ispell-process)
@@ -1881,8 +1933,8 @@ and pass it the output of the last ispell invocation."
(erase-buffer)))))))
(defun ispell-send-replacement (misspelled replacement)
- "Notify aspell that MISSPELLED should be spelled REPLACEMENT.
-This allows it to improve the suggestion list based on actual misspellings."
+ "Notify Aspell that MISSPELLED should be spelled REPLACEMENT.
+This allows to improve the suggestion list based on actual misspellings."
(and ispell-really-aspell
(ispell-send-string (concat "$$ra " misspelled "," replacement "\n"))))
@@ -1972,7 +2024,7 @@ in a window allowing you to choose one.
If optional argument FOLLOWING is non-nil or if `ispell-following-word'
is non-nil when called interactively, then the following word
-\(rather than preceding\) is checked when the cursor is not over a word.
+\(rather than preceding) is checked when the cursor is not over a word.
When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil
when called interactively, non-corrective messages are suppressed.
@@ -1992,7 +2044,7 @@ Return values:
nil word is correct or spelling is accepted.
0 word is inserted into buffer-local definitions.
\"word\" word corrected from word list.
-\(\"word\" arg\) word is hand entered.
+\(\"word\" arg) word is hand entered.
quit spell session exited."
(interactive (list ispell-following-word ispell-quietly current-prefix-arg t))
(cond
@@ -2110,7 +2162,7 @@ quit spell session exited."
"Return the word for spell-checking according to ispell syntax.
If optional argument FOLLOWING is non-nil or if `ispell-following-word'
is non-nil when called interactively, then the following word
-\(rather than preceding\) is checked when the cursor is not over a word.
+\(rather than preceding) is checked when the cursor is not over a word.
Optional second argument contains otherchars that can be included in word
many times (see the doc string of `ispell-dictionary-alist' for details
about otherchars).
@@ -2211,16 +2263,12 @@ indicates whether the dictionary has been modified when option `a'
or `i' is used.
Global `ispell-quit' set to start location to continue spell session."
(let ((count ?0)
- (line ispell-choices-win-default-height)
- ;; ensure 4 context lines.
- (max-lines (- (ispell-adjusted-window-height) 4))
(choices miss)
(window-min-height (min window-min-height
ispell-choices-win-default-height))
(command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ))
- (dedicated (window-dedicated-p))
(skipped 0)
- char num result textwin dedicated-win)
+ char num result textwin)
;; setup the *Choices* buffer with valid data.
(with-current-buffer (get-buffer-create ispell-choices-buffer)
@@ -2235,30 +2283,28 @@ Global `ispell-quit' set to start location to continue spell session."
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil))))
+ (ispell-with-no-warnings
+ (and (boundp 'horizontal-scroll-bar)
+ (setq horizontal-scroll-bar nil)))
(erase-buffer)
(if guess
(progn
(insert "Affix rules generate and capitalize "
"this word as shown below:\n\t")
(while guess
- (if (> (+ 4 (current-column) (length (car guess)))
- (window-width))
- (progn
- (insert "\n\t")
- (setq line (1+ line))))
+ (when (> (+ 4 (current-column) (length (car guess)))
+ (window-width))
+ (insert "\n\t"))
(insert (car guess) " ")
(setq guess (cdr guess)))
- (insert "\nUse option `i' to accept this spelling and put it in your private dictionary.\n")
- (setq line (+ line (if choices 3 2)))))
- (while (and choices
- (< (if (> (+ 7 (current-column) (length (car choices))
- (if (> count ?~) 3 0))
- (window-width))
- (progn
- (insert "\n")
- (setq line (1+ line)))
- line)
- max-lines))
+ (insert (substitute-command-keys
+ "\nUse option `i' to accept this spelling and put it in your private dictionary.\n"))))
+ (while choices
+ (when (> (+ 7 (current-column)
+ (length (car choices))
+ (if (> count ?~) 3 0))
+ (window-width))
+ (insert "\n"))
;; not so good if there are over 20 or 30 options, but then, if
;; there are that many you don't want to scan them all anyway...
(while (memq count command-characters) ; skip command characters.
@@ -2273,15 +2319,10 @@ Global `ispell-quit' set to start location to continue spell session."
(if (not (pos-visible-in-window-p end))
(sit-for 0))
- ;; allow temporary split of dedicated windows...
- (if dedicated
- (progn
- (setq dedicated-win (selected-window))
- (set-window-dedicated-p dedicated-win nil)))
-
;; Display choices for misspelled word.
- (ispell-show-choices line end)
- (select-window (setq textwin (next-window)))
+ (setq textwin (selected-window))
+ (ispell-show-choices)
+ (select-window textwin)
;; highlight word, protecting current buffer status
(unwind-protect
@@ -2407,19 +2448,14 @@ Global `ispell-quit' set to start location to continue spell session."
" -- word-list: "
(or ispell-complete-word-dict
ispell-alternate-dictionary))
- miss (lookup-words new-word)
- choices miss
- line ispell-choices-win-default-height)
- (while (and choices ; adjust choices window.
- (< (if (> (+ 7 (current-column)
- (length (car choices))
- (if (> count ?~) 3 0))
- (window-width))
- (progn
- (insert "\n")
- (setq line (1+ line)))
- line)
- max-lines))
+ miss (ispell-lookup-words new-word)
+ choices miss)
+ (while choices
+ (when (> (+ 7 (current-column)
+ (length (car choices))
+ (if (> count ?~) 3 0))
+ (window-width))
+ (insert "\n"))
(while (memq count command-characters)
(setq count (ispell-int-char (1+ count))
skipped (1+ skipped)))
@@ -2428,8 +2464,9 @@ Global `ispell-quit' set to start location to continue spell session."
count (ispell-int-char (1+ count))))
(setq count (ispell-int-char
(- count ?0 skipped))))
- (ispell-show-choices line end)
- (select-window (next-window)))))
+ (setq textwin (selected-window))
+ (ispell-show-choices)
+ (select-window textwin))))
(and (eq 'block ispell-highlight-p)
(ispell-highlight-spelling-error start end nil
'block))
@@ -2489,44 +2526,19 @@ Global `ispell-quit' set to start location to continue spell session."
(and ispell-highlight-p ; unhighlight
(save-window-excursion
(select-window textwin)
- (ispell-highlight-spelling-error start end)))
- (if dedicated
- (set-window-dedicated-p dedicated-win t)))))
+ (ispell-highlight-spelling-error start end))))))
-(defun ispell-show-choices (line end)
+(defun ispell-show-choices ()
"Show the choices in another buffer or frame."
(if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer))
(progn
(framepop-display-buffer (get-buffer ispell-choices-buffer))
;; (get-buffer-window ispell-choices-buffer t)
(select-window (previous-window))) ; *Choices* window
- ;; standard selection by splitting a small buffer out of this window.
- (let ((choices-window (get-buffer-window ispell-choices-buffer)))
- (if choices-window
- (if (= line (ispell-adjusted-window-height choices-window))
- (select-window choices-window)
- ;; *Choices* window changed size. Adjust the choices window
- ;; without scrolling the spelled window when possible
- (let ((window-line
- (- line (ispell-adjusted-window-height choices-window)))
- (visible (progn (vertical-motion -1) (point))))
- (if (< line ispell-choices-win-default-height)
- (setq window-line (+ window-line
- (- ispell-choices-win-default-height
- line))))
- (move-to-window-line 0)
- (vertical-motion window-line)
- (set-window-start (selected-window)
- (if (> (point) visible) visible (point)))
- (goto-char end)
- (select-window choices-window)
- (enlarge-window window-line)))
- ;; Overlay *Choices* window when it isn't showing
- (ispell-overlay-window (max line ispell-choices-win-default-height)))
- (switch-to-buffer ispell-choices-buffer)
- (goto-char (point-min)))))
+ ;; Display choices above selected window.
+ (ispell-display-buffer (get-buffer-create ispell-choices-buffer))))
;;;###autoload
@@ -2596,10 +2608,10 @@ SPC: Accept word this time.
"Type 'x C-h f ispell-help' for more help")))
(save-window-excursion
(if ispell-help-in-bufferp
- (progn
- (ispell-overlay-window 4)
- (switch-to-buffer (get-buffer-create "*Ispell Help*"))
- (insert (concat help-1 "\n" help-2 "\n" help-3))
+ (let ((buffer (get-buffer-create "*Ispell Help*")))
+ (with-current-buffer buffer
+ (insert (concat help-1 "\n" help-2 "\n" help-3)))
+ (ispell-display-buffer buffer)
(sit-for 5)
(kill-buffer "*Ispell Help*"))
(unwind-protect
@@ -2613,8 +2625,9 @@ SPC: Accept word this time.
(sit-for 5))
(erase-buffer)))))))
+(define-obsolete-function-alias 'lookup-words 'ispell-lookup-words "24.4")
-(defun lookup-words (word &optional lookup-dict)
+(defun ispell-lookup-words (word &optional lookup-dict)
"Look up WORD in optional word-list dictionary LOOKUP-DICT.
A `*' serves as a wild card. If no wild cards, `look' is used if it exists.
Otherwise the variable `ispell-grep-command' contains the command used to
@@ -2648,8 +2661,12 @@ if defined."
(message "Starting \"%s\" process..." (file-name-nondirectory prog))
(if look-p
nil
+ (insert "^" word)
+ ;; When there are no wildcards, append one, for consistency
+ ;; with `look' behavior.
+ (unless wild-p (insert "*"))
+ (insert "$")
;; Convert * to .*
- (insert "^" word "$")
(while (search-backward "*" nil t) (insert "."))
(setq word (buffer-string))
(erase-buffer))
@@ -2813,49 +2830,35 @@ The variable `ispell-highlight-face' selects the face to use for highlighting."
(ispell-highlight-spelling-error-overlay start end highlight))
(t (ispell-highlight-spelling-error-generic start end highlight refresh))))
-(defun ispell-adjusted-window-height (&optional window)
- "Like `window-height', adjusted to correct for the effect of tall mode-lines.
-The value returned is actually the nominal number of text-lines in the
-window plus 1. On a terminal, this is the same value returned by
-`window-height', but if the window has a mode-line is taller than a normal
-text line, the returned value may be smaller than that from
-`window-height'."
- (cond ((fboundp 'window-text-height)
- (1+ (window-text-height window)))
- ((or (and (fboundp 'display-graphic-p) (display-graphic-p))
- (and (featurep 'xemacs) window-system))
- (1- (window-height window)))
- (t
- (window-height window))))
-
-(defun ispell-overlay-window (height)
- "Create a window covering the top HEIGHT lines of the current window.
-Ensure that the line above point is still visible but otherwise avoid
-scrolling the current window. Leave the new window selected."
- (save-excursion
- (let ((oldot (save-excursion (vertical-motion -1) (point)))
- (top (save-excursion (move-to-window-line height) (point))))
- ;; If line above old point (line starting at oldot) would be
- ;; hidden by new window, scroll it to just below new win
- ;; otherwise set top line of other win so it doesn't scroll.
- (if (< oldot top) (setq top oldot))
- ;; if frame is unsplittable, temporarily disable that...
- (if (cdr (assq 'unsplittable (frame-parameters (selected-frame))))
- (let ((frame (selected-frame)))
- (modify-frame-parameters frame '((unsplittable . nil)))
- (split-window nil height)
- (modify-frame-parameters frame '((unsplittable . t))))
- (split-window nil height))
- (let ((deficit (- height (ispell-adjusted-window-height))))
- (when (> deficit 0)
- ;; Number of lines the window is still too short. We ensure that
- ;; there are at least (1- HEIGHT) lines visible in the window.
- (enlarge-window deficit)
- (goto-char top)
- (vertical-motion deficit)
- (setq top (min (point) oldot))))
- (set-window-start (next-window) top))))
-
+(defun ispell-display-buffer (buffer)
+ "Show BUFFER in new window above selected one.
+Also position fit window to BUFFER and select it."
+ (let* ((unsplittable
+ (cdr (assq 'unsplittable (frame-parameters (selected-frame)))))
+ (window
+ (or (get-buffer-window buffer)
+ (and unsplittable
+ ;; If frame is unsplittable, temporarily disable that...
+ (let ((frame (selected-frame)))
+ (modify-frame-parameters frame '((unsplittable . nil)))
+ (prog1
+ (condition-case nil
+ (split-window
+ nil (- ispell-choices-win-default-height) 'above)
+ (error nil))
+ (modify-frame-parameters frame '((unsplittable . t))))))
+ (and (not unsplittable)
+ (condition-case nil
+ (split-window
+ nil (- ispell-choices-win-default-height) 'above)
+ (error nil)))
+ (display-buffer buffer))))
+ (if (not window)
+ (error "Couldn't make window for *Choices*")
+ (select-window window)
+ (set-window-buffer window buffer)
+ (set-window-point window (point-min))
+ (fit-window-to-buffer window nil nil nil nil t))))
;; Should we add a compound word match return value?
(defun ispell-parse-output (output &optional accept-list shift)
@@ -2934,8 +2937,7 @@ Keeps argument list for future Ispell invocations for no async support."
(ispell-hunspell-fill-dictionary-entry ispell-current-dictionary)))
(let* ((default-directory
- (if (and (file-directory-p default-directory)
- (file-readable-p default-directory))
+ (if (file-accessible-directory-p default-directory)
default-directory
;; Defend against bad `default-directory'.
(expand-file-name "~/")))
@@ -2993,8 +2995,7 @@ Keeps argument list for future Ispell invocations for no async support."
(if (or ispell-really-aspell
ispell-really-hunspell
;; Protect against bad default-directory
- (not (and (file-directory-p default-directory)
- (file-readable-p default-directory)))
+ (not (file-accessible-directory-p default-directory))
;; Ispell and per-dir personal dicts available
(not (or (file-readable-p (concat default-directory
".ispell_words"))
@@ -3020,15 +3021,19 @@ Keeps argument list for future Ispell invocations for no async support."
(setq ispell-filter nil ispell-filter-continue nil)
;; may need to restart to select new personal dictionary.
(ispell-kill-ispell t)
- (message "Starting new Ispell process [%s::%s] ..."
+ (message "Starting new Ispell process %s with %s dictionary..."
ispell-program-name
(or ispell-local-dictionary ispell-dictionary "default"))
(sit-for 0)
(setq ispell-library-directory (ispell-check-version)
+ ;; Assign a non-nil value to ispell-process-directory
+ ;; before calling ispell-start-process, since that
+ ;; function needs it to set default-directory when
+ ;; ispell-async-processp is nil.
+ ispell-process-directory default-directory
ispell-process (ispell-start-process)
ispell-filter nil
- ispell-filter-continue nil
- ispell-process-directory default-directory)
+ ispell-filter-continue nil)
(unless (equal ispell-process-directory (expand-file-name "~/"))
;; At this point, `ispell-process-directory' will be "~/" unless using
@@ -3054,7 +3059,12 @@ Keeps argument list for future Ispell invocations for no async support."
(if (and (or (featurep 'xemacs)
(and (boundp 'enable-multibyte-characters)
enable-multibyte-characters))
- (fboundp 'set-process-coding-system))
+ (fboundp 'set-process-coding-system)
+ ;; Evidently, some people use the synchronous mode even
+ ;; when async subprocesses are supported, in which case
+ ;; set-process-coding-system is bound, but
+ ;; ispell-process is not a process object.
+ ispell-async-processp)
(set-process-coding-system ispell-process (ispell-get-coding-system)
(ispell-get-coding-system)))
;; Get version ID line
@@ -3300,7 +3310,8 @@ ispell-region: Search for first region to skip after (ispell-begin-skip-region-r
ispell-start ispell-end (point-at-eol) in-comment add-comment string)
(if add-comment ; account for comment chars added
(setq ispell-start (- ispell-start (length add-comment))
- add-comment nil))
+ ;; Reset `in-comment' (and indirectly `add-comment') for new line
+ in-comment nil))
(setq ispell-end (point)) ; "end" tracks region retrieved.
(if string ; there is something to spell check!
;; (special start end)
@@ -3429,7 +3440,7 @@ Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
(defun ispell-ignore-fcc (start end)
"Delete the Fcc: message header when large attachments are included.
-Return value `nil' if file with large attachments is saved.
+Return value nil if file with large attachments is saved.
This can be used to avoid multiple questions for multiple large attachments.
Returns point to starting location afterwards."
(let ((result t))
@@ -3729,7 +3740,7 @@ Returns the sum SHIFT due to changes in word replacements."
;;;###autoload
(defun ispell-buffer-with-debug (&optional append)
"`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
-Use APPEND to append the info to previous buffer if exists."
+If APPEND is non-n il, append the info to previous buffer if exists."
(interactive)
(let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
(ispell-buffer)))
@@ -3766,8 +3777,8 @@ Use APPEND to append the info to previous buffer if exists."
;;;###autoload
(defun ispell-complete-word (&optional interior-frag)
- "Try to complete the word before or under point (see `lookup-words').
-If optional INTERIOR-FRAG is non-nil then the word may be a character
+ "Try to complete the word before or at point.
+If optional INTERIOR-FRAG is non-nil, then the word may be a character
sequence inside of a word.
Standard ispell choices are then available."
@@ -3782,11 +3793,11 @@ Standard ispell choices are then available."
word (car word)
possibilities
(or (string= word "") ; Will give you every word
- (lookup-words (concat (and interior-frag "*") word
- (if (or interior-frag (null ispell-look-p))
- "*"))
- (or ispell-complete-word-dict
- ispell-alternate-dictionary))))
+ (ispell-lookup-words
+ (concat (and interior-frag "*") word
+ (and interior-frag "*"))
+ (or ispell-complete-word-dict
+ ispell-alternate-dictionary))))
(cond ((eq possibilities t)
(message "No word to complete"))
((null possibilities)
@@ -3873,7 +3884,7 @@ typing SPC or RET warns you if the previous word is incorrectly
spelled.
All the buffer-local variables and dictionaries are ignored. To
-read them into the running ispell process, type \\[ispell-word]
+read them into the running Ispell process, type \\[ispell-word]
SPC.
For spell-checking \"on the fly\", not just after typing SPC or
@@ -3927,7 +3938,7 @@ Otherwise, it must be a function which is called to get the limit.")
(defun ispell-mime-multipartp (&optional limit)
"Return multipart message start boundary or nil if none."
- ;; caller must ensure `case-fold-search' is set to `t'
+ ;; caller must ensure `case-fold-search' is set to t
(and
(re-search-forward
"Content-Type: *multipart/\\([^ \t\n]*;[ \t]*[\n]?[ \t]*\\)+boundary="
@@ -4029,14 +4040,14 @@ The `X' command aborts sending the message so that you can edit the buffer.
To spell-check whenever a message is sent, include the appropriate lines
in your init file:
- (add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
- (add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
- (add-hook 'mail-send-hook 'ispell-message)
- (add-hook 'mh-before-send-letter-hook 'ispell-message)
+ (add-hook \\='message-send-hook \\='ispell-message) ;; GNUS 5
+ (add-hook \\='news-inews-hook \\='ispell-message) ;; GNUS 4
+ (add-hook \\='mail-send-hook \\='ispell-message)
+ (add-hook \\='mh-before-send-letter-hook \\='ispell-message)
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)))"
+ (function (lambda () (local-set-key \"\\C-ci\" \\='ispell-message)))"
(interactive)
(save-excursion
(goto-char (point-min))
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index 4b57e0b9746..0ca4cbefe93 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -1,9 +1,9 @@
;;; makeinfo.el --- run makeinfo conveniently
-;; Copyright (C) 1991, 1993, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1993, 2001-2015 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: docs convenience
;; This file is part of GNU Emacs.
@@ -66,7 +66,7 @@ The name of the file is appended to this string, separated by a space."
"String containing options for running `makeinfo'.
Do not include `--footnote-style' or `--paragraph-indent';
the proper way to specify those is with the Texinfo commands
-`@footnotestyle` and `@paragraphindent'."
+`@footnotestyle' and `@paragraphindent'."
:type 'string
:group 'makeinfo)
@@ -228,7 +228,7 @@ nonsensical results."
"Make Info file from current buffer.
Use the \\[next-error] command to move to the next error
-\(if there are errors\)."
+\(if there are errors)."
(interactive)
(cond ((null buffer-file-name)
@@ -253,11 +253,12 @@ Use the \\[next-error] command to move to the next error
(setq makeinfo-output-node-name (makeinfo-current-node))
(save-excursion
- (makeinfo-compile
- (concat makeinfo-run-command " " makeinfo-options
- " " buffer-file-name)
- nil
- 'makeinfo-compilation-sentinel-buffer)))
+ (let ((default-directory (file-name-directory buffer-file-name)))
+ (makeinfo-compile
+ (concat makeinfo-run-command " " makeinfo-options
+ " " (file-name-nondirectory buffer-file-name))
+ nil
+ 'makeinfo-compilation-sentinel-buffer))))
(defun makeinfo-compilation-sentinel-buffer (proc msg)
"Sentinel for `makeinfo-compile' run from `makeinfo-buffer'."
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 1ca5e8b1a63..bf88551e6bf 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,9 +1,9 @@
;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
-;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2013 Free Software
+;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 2c3271911fb..99962c75897 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,6 +1,6 @@
;;; page-ext.el --- extended page handling commands
-;; Copyright (C) 1990-1991, 1993-1994, 2001-2013 Free Software
+;; Copyright (C) 1990-1991, 1993-1994, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Robert J. Chassell <bob@gnu.org>
@@ -345,14 +345,13 @@ If point is in the pages directory buffer, insert the new page in the
buffer associated with the directory.
Insert the new page just before current page if
- pages-directory-for-adding-new-page-before-current-page-p variable
-is non-nil. Else insert at exact location of point.
+`pages-directory-for-adding-new-page-before-current-page-p' is non-nil.
+Else insert at exact location of point.
-Narrow to new page if
- pages-directory-for-adding-page-narrowing-p variable
-is non-nil.
+Narrow to new page if `pages-directory-for-adding-page-narrowing-p' is
+non-nil.
-Page begins with a `^L' as the default page-delimiter.
+Page begins with a '^L' as the default `page-delimiter'.
Use \\[set-page-delimiter] to change the page-delimiter.
Point is left in the body of page."
(interactive "sHeader line: ")
@@ -396,8 +395,8 @@ Point is left in the body of page."
"Search for REGEXP, starting from point, and narrow to page it is in."
(interactive (list
(read-string
- (format "Search for `%s' (end with RET): "
- (or pages-last-search "regexp")))))
+ (format-message "Search for `%s' (end with RET): "
+ (or pages-last-search "regexp")))))
(if (equal regexp "")
(setq regexp pages-last-search)
(setq pages-last-search regexp))
@@ -447,7 +446,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
(defun sort-pages-buffer (&optional reverse)
"Sort pages alphabetically in buffer. Prefix arg means reverse order.
-\(Non-nil arg if not interactive.\)"
+\(Non-nil arg if not interactive.)"
(interactive "P")
(or reverse (setq reverse nil))
@@ -462,7 +461,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
(defvar pages-directory-previous-regexp nil
"Value of previous regexp used by `pages-directory'.
\(This regular expression may be used to select only those pages that
-contain matches to the regexp.\)")
+contain matches to the regexp.)")
(defvar pages-buffer nil
"The buffer for which the pages-directory function creates the directory.")
@@ -516,7 +515,7 @@ resets the page-delimiter to the original value."
(defun pages-directory
(pages-list-all-headers-p count-lines-p &optional regexp)
"Display a directory of the page headers in a temporary buffer.
-A header is the first non-blank line after the page-delimiter.
+A header is the first non-blank line after the `page-delimiter'.
\\[pages-directory-mode]
You may move point to one of the lines in the temporary buffer,
then use \\<pages-directory-goto> to go to the same line in the pages buffer.
@@ -550,16 +549,18 @@ directory for only the accessible portion of the buffer."
(list nil
nil
(read-string
- (format "Select according to `%s' (end with RET): "
- (or pages-directory-previous-regexp "regexp")))))
+ (format-message
+ "Select according to `%s' (end with RET): "
+ (or pages-directory-previous-regexp "regexp")))))
((> (prefix-numeric-value current-prefix-arg) 0)
(list t t nil))
((< (prefix-numeric-value current-prefix-arg) 0)
(list nil
t
(read-string
- (format "Select according to `%s' (end with RET): "
- (or pages-directory-previous-regexp "regexp")))))))
+ (format-message
+ "Select according to `%s' (end with RET): "
+ (or pages-directory-previous-regexp "regexp")))))))
(if (equal regexp "")
(setq regexp pages-directory-previous-regexp)
@@ -752,10 +753,10 @@ Move point to one of the lines in the displayed directory,
then use \\[pages-directory-goto] to go to the same line
in the addresses buffer.
-If pages-directory-for-addresses-goto-narrowing-p is non-nil,
+If `pages-directory-for-addresses-goto-narrowing-p' is non-nil,
`pages-directory-goto' narrows addresses buffer to entry.
-If pages-directory-for-addresses-buffer-keep-windows-p is nil,
+If `pages-directory-for-addresses-buffer-keep-windows-p' is nil,
this command deletes other windows when it displays the addresses
directory."
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 60e49063c43..39db5bbcfad 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -1,8 +1,8 @@
;;; page.el --- page motion commands for Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp convenience
;; Package: emacs
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index e773b53a73f..58c65678802 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -1,9 +1,9 @@
;;; paragraphs.el --- paragraph and sentence parsing
-;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2013 Free Software
+;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; Package: emacs
@@ -168,11 +168,11 @@ to obtain the value of this variable."
:type '(choice regexp (const :tag "Use default value" nil)))
(put 'sentence-end 'safe-local-variable 'string-or-null-p)
-(defcustom sentence-end-base "[.?!][]\"'”)}]*"
+(defcustom sentence-end-base "[.?!…‽][]\"'”’)}]*"
"Regexp matching the basic end of a sentence, not including following space."
:group 'paragraphs
:type 'string
- :version "22.1")
+ :version "25.1")
(put 'sentence-end-base 'safe-local-variable 'stringp)
(defun sentence-end ()
@@ -468,7 +468,7 @@ sentences. Also, every paragraph boundary terminates sentences as well."
(setq par-text-beg (point))
;; Start of the first line of the paragraph.
;; We use this as the search limit
- ;; to allow s1entence-end to match if it is anchored at
+ ;; to allow sentence-end to match if it is anchored at
;; BOL and the paragraph starts indented.
(beginning-of-line)
(setq par-beg (point)))
@@ -536,8 +536,4 @@ the current sentence with the one containing the mark."
(interactive "*p")
(transpose-subr 'forward-sentence arg))
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; paragraphs.el ends here
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 21c86dd38f3..201b85b2528 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,9 +1,9 @@
;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
-;; Copyright (C) 1985, 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience wp
;; This file is part of GNU Emacs.
@@ -418,7 +418,8 @@ stops computed are displayed in the minibuffer with `:' at each stop."
(save-excursion
(let (tabs)
(if arg
- (setq tabs (default-value 'tab-stop-list))
+ (setq tabs (or (default-value 'tab-stop-list)
+ (indent-accumulate-tab-stops (window-width))))
(let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
(beginning-of-line)
(let ((bol (point)))
@@ -494,8 +495,12 @@ prefix argument, the rectangle is actually killed, shifting remaining text."
(defun picture-clear-rectangle-to-register (start end register &optional killp)
"Clear rectangle delineated by point and mark into REGISTER.
The rectangle is saved in REGISTER and replaced with whitespace. With
-prefix argument, the rectangle is actually killed, shifting remaining text."
- (interactive "r\ncRectangle to register: \nP")
+prefix argument, the rectangle is actually killed, shifting remaining text.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (region-beginning) (region-end)
+ (register-read-with-preview "Rectangle to register: ")
+ current-prefix-arg))
(set-register register (picture-snarf-rectangle start end killp)))
(defun picture-snarf-rectangle (start end &optional killp)
@@ -534,8 +539,11 @@ regardless of where you click."
The rectangle is positioned with upper left corner at point, overwriting
existing text. With prefix argument, the rectangle is
inserted instead, shifting existing text. Leaves mark at one corner
-of rectangle and point at the other (diagonally opposed) corner."
- (interactive "cRectangle from register: \nP")
+of rectangle and point at the other (diagonally opposed) corner.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list (register-read-with-preview "Rectangle from register: ")
+ current-prefix-arg))
(let ((rectangle (get-register register)))
(if (not (consp rectangle))
(error "Register %c does not contain a rectangle" register)
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 610227af794..a5f39461498 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,6 +1,6 @@
-;;; po.el --- basic support of PO translation files -*- coding: utf-8; -*-
+;;; po.el --- basic support of PO translation files
-;; Copyright (C) 1995-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1998, 2000-2015 Free Software Foundation, Inc.
;; Authors: François Pinard <pinard@iro.umontreal.ca>,
;; Greg McGary <gkm@magilla.cichlid.com>,
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index 975c9396d49..424b6d0f6a1 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -1,9 +1,9 @@
;;; refbib.el --- convert refer-style references to ones usable by Latex bib
-;; Copyright (C) 1989, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 2001-2015 Free Software Foundation, Inc.
;; Author: Henry Kautz <kautz@research.att.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: bib, tex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 1e4d453e905..22dc7dc9165 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -1,6 +1,6 @@
;;; refer.el --- look up references in bibliography files
-;; Copyright (C) 1992, 1996, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1996, 2001-2015 Free Software Foundation, Inc.
;; Author: Ashwin Ram <ashwin@cc.gatech.edu>
;; Maintainer: Gernot Heiser <gernot@acm.org>
@@ -229,7 +229,7 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(sit-for 1)
(setq files (cdr files))))))
(ding)
- (message "Keywords \"%s\" not found in any \.bib file" keywords))
+ (message "Keywords \"%s\" not found in any .bib file" keywords))
(select-window old-window)))
(defun refer-find-entry-in-file (keywords-list file &optional old-pos)
@@ -351,21 +351,21 @@ found on the last `refer-find-entry' or `refer-find-next-entry'."
(if (progn
(goto-char (point-min))
(re-search-forward (concat refer-bib-files-regexp
- "\\s-*\{") nil t))
+ "\\s-*{") nil t))
(let ((files (list (buffer-substring
(point)
(progn
- (re-search-forward "[,\}]"
+ (re-search-forward "[,}]"
nil t)
(backward-char 1)
(point))))))
- (while (not (looking-at "\}"))
+ (while (not (looking-at "}"))
(setq files (append files
(list (buffer-substring
(progn (forward-char 1)
(point))
(progn (re-search-forward
- "[,\}]" nil t)
+ "[,}]" nil t)
(backward-char 1)
(point)))))))
files)
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index ebbc6ee0afb..97db70d2de3 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -1,6 +1,6 @@
;;; refill.el --- `auto-fill' by refilling paragraphs on changes
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Maintainer: Miles Bader <miles@gnu.org>
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 315b9d7fc30..bbad065c4ba 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,6 +1,6 @@
;;; reftex-auc.el --- RefTeX's interface to AUCTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -47,6 +47,7 @@
(and (listp reftex-plug-into-AUCTeX)
(nth which reftex-plug-into-AUCTeX))))
+;;;###autoload
(defun reftex-arg-label (optional &optional prompt definition)
"Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg.
What is being used depends upon `reftex-plug-into-AUCTeX'."
@@ -68,6 +69,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
(LaTeX-add-labels label))
(TeX-argument-insert label optional)))
+;;;###autoload
(defun reftex-arg-cite (optional &optional prompt definition)
"Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument.
What is being used depends upon `reftex-plug-into-AUCTeX'."
@@ -85,6 +87,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'."
optional)))
+;;;###autoload
(defun reftex-arg-index-tag (optional &optional prompt &rest args)
"Prompt for an index tag with completion.
This is the name of an index, not the entry."
@@ -104,6 +107,7 @@ This is the name of an index, not the entry."
(setq tag (read-string prompt)))
(TeX-argument-insert tag optional)))
+;;;###autoload
(defun reftex-arg-index (optional &optional prompt &rest args)
"Prompt for an index entry completing with known entries.
Completion is specific for just one index, if the macro or a tag
@@ -138,6 +142,7 @@ argument identify one of multiple indices."
(t "idx")))))
(defvar LaTeX-label-function)
+;;;###autoload
(defun reftex-plug-into-AUCTeX ()
;; Replace AUCTeX functions with RefTeX functions.
;; Which functions are replaced is controlled by the variable
@@ -162,6 +167,7 @@ argument identify one of multiple indices."
(fboundp 'TeX-arg-index)
(fset 'TeX-arg-index 'reftex-arg-index)))
+;;;###autoload
(defun reftex-toggle-plug-into-AUCTeX ()
"Toggle Interface between AUCTeX and RefTeX on and off."
(interactive)
@@ -173,6 +179,7 @@ argument identify one of multiple indices."
(message "RefTeX has been plugged into AUCTeX.")
(message "RefTeX no longer interacts with AUCTeX.")))
+;;;###autoload
(defun reftex-add-label-environments (entry-list)
"Add label environment descriptions to `reftex-label-alist-style'.
The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there
@@ -197,8 +204,10 @@ the label information is recompiled on next use."
(push entry list)))
(when changed
(put reftex-docstruct-symbol 'reftex-label-alist-style list)))))
+;;;###autoload
(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments)
+;;;###autoload
(defun reftex-add-section-levels (entry-list)
"Add entries to the value of `reftex-section-levels'.
The added values are kept local to the current document. The format
@@ -219,9 +228,14 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See
(when changed
(put reftex-docstruct-symbol 'reftex-section-levels list)))))
+;;;###autoload
(defun reftex-notice-new-section ()
(reftex-notice-new 1 'force))
(provide 'reftex-auc)
;;; reftex-auc.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 6c103294a06..a35d41109e6 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1,6 +1,6 @@
;;; reftex-cite.el --- creating citations with RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -58,6 +58,7 @@
,@body)
(set-syntax-table saved-syntax))))
+;;;###autoload
(defun reftex-default-bibliography ()
"Return the expanded value of variable `reftex-default-bibliography'.
The expanded value is cached."
@@ -70,6 +71,7 @@ The expanded value is cached."
reftex-default-bibliography))
(get 'reftex-default-bibliography :reftex-expanded))
+;;;###autoload
(defun reftex-bib-or-thebib ()
"Test if BibTeX or \begin{thebibliography} should be used for the citation.
Find the bof of the current file"
@@ -89,6 +91,7 @@ Find the bof of the current file"
(if bib 'bib nil)
(if thebib 'thebib nil))))
+;;;###autoload
(defun reftex-get-bibfile-list ()
"Return list of bibfiles for current document.
When using the chapterbib or bibunits package you should either
@@ -112,6 +115,7 @@ Then this function will return the applicable database files."
(error "\\bibliography statement missing or .bib files not found")))
;;; Find a certain reference in any of the BibTeX files.
+;;;###autoload
(defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill
highlight item return)
"Find BibTeX KEY in any file in FILE-LIST in another window.
@@ -161,6 +165,7 @@ If RETURN is non-nil, just return the entry and restore point."
(error "No \\bibitem with citation key %s" key)
(error "No BibTeX entry with citation key %s" key)))))
+;;;###autoload
(defun reftex-end-of-bib-entry (item)
(save-excursion
(condition-case nil
@@ -172,6 +177,28 @@ If RETURN is non-nil, just return the entry and restore point."
(progn (forward-list 1) (point)))
(error (min (point-max) (+ 300 (point)))))))
+(defun reftex--query-search-regexps (default)
+ "Query for regexps for searching entries using DEFAULT as default.
+Return a list of regular expressions."
+ (split-string
+ (completing-read
+ (concat
+ "Regex { && Regex...}: "
+ "[" default "]: ")
+ ;; Ensure default is always in the completion list.
+ (let ((def (when default (list default)))
+ (coll (if reftex-mode
+ (if (fboundp 'LaTeX-bibitem-list)
+ (LaTeX-bibitem-list)
+ (cdr (assoc 'bibview-cache
+ (symbol-value reftex-docstruct-symbol))))
+ nil)))
+ (if (and def (member def coll))
+ coll
+ (cons def coll)))
+ nil nil nil 'reftex-cite-regexp-hist)
+ "[ \t]*&&[ \t]*"))
+
;;; Parse bibtex buffers
(defun reftex-extract-bib-entries (buffers)
"Extract bib entries which match regexps from BUFFERS.
@@ -184,20 +211,7 @@ Return list with entries."
;; Read a regexp, completing on known citation keys.
(setq default (regexp-quote (reftex-get-bibkey-default)))
- (setq re-list
- (split-string
- (completing-read
- (concat
- "Regex { && Regex...}: "
- "[" default "]: ")
- (if reftex-mode
- (if (fboundp 'LaTeX-bibitem-list)
- (LaTeX-bibitem-list)
- (cdr (assoc 'bibview-cache
- (symbol-value reftex-docstruct-symbol))))
- nil)
- nil nil nil 'reftex-cite-regexp-hist)
- "[ \t]*&&[ \t]*"))
+ (setq re-list (reftex--query-search-regexps default))
(if (or (null re-list ) (equal re-list '("")))
(setq re-list (list default)))
@@ -205,7 +219,9 @@ Return list with entries."
(setq first-re (car re-list) ; We'll use the first re to find things,
rest-re (cdr re-list)) ; the others to narrow down.
(if (string-match "\\`[ \t]*\\'" (or first-re ""))
- (error "Empty regular expression"))
+ (user-error "Empty regular expression"))
+ (if (string-match first-re "")
+ (user-error "Regular expression matches the empty string."))
(save-excursion
(save-window-excursion
@@ -223,11 +239,11 @@ Return list with entries."
(message "No such BibTeX file %s (ignored)" buffer)
(message "Scanning bibliography database %s" buffer1)
(unless (verify-visited-file-modtime buffer1)
- (when (y-or-n-p
- (format "File %s changed on disk. Reread from disk? "
- (file-name-nondirectory
- (buffer-file-name buffer1))))
- (with-current-buffer buffer1 (revert-buffer t t)))))
+ (when (y-or-n-p
+ (format "File %s changed on disk. Reread from disk? "
+ (file-name-nondirectory
+ (buffer-file-name buffer1))))
+ (with-current-buffer buffer1 (revert-buffer t t)))))
(set-buffer buffer1)
(reftex-with-special-syntax-for-bib
@@ -380,27 +396,14 @@ The environment should be located in FILES."
(buffer-substring-no-properties
start end)
"[ \t\n\r]*\\\\bibitem[ \t]*\
-\\(\\[[^]]*]\\)*\[ \t]*"))))))
+\\(\\[[^]]*]\\)*[ \t]*"))))))
(goto-char end))))))
(unless entries
(error "No bibitems found"))
;; Read a regexp, completing on known citation keys.
(setq default (regexp-quote (reftex-get-bibkey-default)))
- (setq re-list
- (split-string
- (completing-read
- (concat
- "Regex { && Regex...}: "
- "[" default "]: ")
- (if reftex-mode
- (if (fboundp 'LaTeX-bibitem-list)
- (LaTeX-bibitem-list)
- (cdr (assoc 'bibview-cache
- (symbol-value reftex-docstruct-symbol))))
- nil)
- nil nil nil 'reftex-cite-regexp-hist)
- "[ \t]*&&[ \t]*"))
+ (setq re-list (reftex--query-search-regexps default))
(if (or (null re-list ) (equal re-list '("")))
(setq re-list (list default)))
@@ -452,6 +455,7 @@ If FIELD is empty try \"editor\" field."
(setq names (replace-match " " nil t names)))
(split-string names "\n")))
+;;;###autoload
(defun reftex-parse-bibtex-entry (entry &optional from to raw)
"Parse BibTeX ENTRY.
If ENTRY is nil then parse the entry in current buffer between FROM and TO.
@@ -471,7 +475,7 @@ If RAW is non-nil, keep double quotes/curly braces delimiting fields."
(goto-char (point-min))
(if (re-search-forward "@\\(\\(?:\\w\\|\\s_\\)+\\)[ \t\n\r]*\
-\[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
+[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
(setq alist
(list
(cons "&type" (downcase (reftex-match-string 1)))
@@ -537,7 +541,14 @@ If FORMAT is non-nil `format' entry accordingly."
(extra
(cond
((equal type "article")
- (concat (reftex-get-bib-field "journal" entry) " "
+ (concat (let ((jt (reftex-get-bib-field "journal" entry)))
+ ;; biblatex prefers the alternative journaltitle
+ ;; field, so check if that exists in case journal
+ ;; is empty.
+ (if (zerop (length jt))
+ (reftex-get-bib-field "journaltitle" entry)
+ jt))
+ " "
(reftex-get-bib-field "volume" entry) ", "
(reftex-get-bib-field "pages" entry)))
((equal type "book")
@@ -604,6 +615,7 @@ If FORMAT is non-nil `format' entry accordingly."
;;; Make a citation
+;; NB this is a global autoload - see reftex.el.
;;;###autoload
(defun reftex-citation (&optional no-insert format-key)
"Make a citation using BibTeX database files.
@@ -787,11 +799,13 @@ in order to only add another reference in the same cite command."
(error "No citation format associated with key `%c'" key)))))
format))
+;;;###autoload
(defun reftex-citep ()
"Call `reftex-citation' with a format selector `?p'."
(interactive)
(reftex-citation nil ?p))
+;;;###autoload
(defun reftex-citet ()
"Call `reftex-citation' with a format selector `?t'."
(interactive)
@@ -1058,6 +1072,7 @@ in order to only add another reference in the same cite command."
(setq format (replace-match "" t t format)))
format)
+;;;###autoload
(defun reftex-make-cite-echo-string (entry docstruct-symbol)
"Format a bibtex ENTRY for the echo area and cache the result."
(let* ((key (reftex-get-bib-field "&key" entry))
@@ -1130,7 +1145,7 @@ recommended for follow mode. It works OK for individual lookups."
(save-restriction
(widen)
(goto-char (point-min))
- (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^\\]]*\\]\\)?{\\([^}]+\\)}" nil t)
+ (while (re-search-forward "\\(?:^\\|\\=\\)[^%\n\r]*?\\\\\\(bibentry\\|[a-zA-Z]*cite[a-zA-Z]*\\)\\(\\[[^]]*\\]\\)?{\\([^}]+\\)}" nil t)
(setq kk (match-string-no-properties 3))
(while (string-match "%.*\n?" kk)
(setq kk (replace-match "" t t kk)))
@@ -1151,6 +1166,7 @@ recommended for follow mode. It works OK for individual lookups."
(string-match "^&" (car pair)))
alist))))
+;;;###autoload
(defun reftex-create-bibtex-file (bibfile)
"Create a new BibTeX database BIBFILE with all entries referenced in document.
The command prompts for a filename and writes the collected
@@ -1177,7 +1193,7 @@ created files in the variables `reftex-create-bibtex-header' or
(widen)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*@\\(?:\\w\\|\\s_\\)+[ \t\n\r]*\
-\[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
+[{(][ \t\n\r]*\\([^ \t\n\r,]+\\)" nil t)
(setq key (match-string 1)
beg (match-beginning 0)
end (progn
@@ -1244,3 +1260,7 @@ created files in the variables `reftex-create-bibtex-header' or
(provide 'reftex-cite)
;;; reftex-cite.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index 12781f358eb..60cb1f65257 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -1,6 +1,6 @@
;;; reftex-dcr.el --- viewing cross references and citations with RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -30,6 +30,7 @@
(require 'reftex)
+;;;###autoload
(defun reftex-view-crossref (&optional arg auto-how fail-quietly)
"View cross reference of macro at point. Point must be on the KEY
argument. When at a `\\ref' macro, show corresponding `\\label'
@@ -220,6 +221,7 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'."
(when (equal arg 2)
(select-window pop-win)))))
+;;;###autoload
(defun reftex-mouse-view-crossref (ev)
"View cross reference of \\ref or \\cite macro where you click.
If the macro at point is a \\ref, show the corresponding label definition.
@@ -318,6 +320,7 @@ With argument, actually select the window showing the cross reference."
"Non-nil means use the idle timers in XEmacs for crossref display.
Currently, idle timer restart is broken and we use the post-command-hook.")
+;;;###autoload
(defun reftex-toggle-auto-view-crossref ()
"Toggle the automatic display of crossref information in the echo area.
When active, leaving point idle in the argument of a \\ref or \\cite macro
@@ -355,6 +358,7 @@ will display info in the echo area."
'reftex-view-crossref-when-idle
reftex-idle-time nil t))))
+;;;###autoload
(defun reftex-view-crossref-from-bibtex (&optional arg)
"View location in a LaTeX document which cites the BibTeX entry at point.
Since BibTeX files can be used by many LaTeX documents, this function
@@ -482,3 +486,7 @@ Calling this function several times find successive citation locations."
(provide 'reftex-dcr)
;;; reftex-dcr.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index 83a98891216..15d42fe7b02 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -1,6 +1,6 @@
;;; reftex-global.el --- operations on entire documents with RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -29,6 +29,7 @@
(require 'reftex)
;;;
+;;;###autoload
(defun reftex-create-tags-file ()
"Create TAGS file by running `etags' on the current document.
The TAGS file is also immediately visited with `visit-tags-table'."
@@ -48,6 +49,7 @@ The TAGS file is also immediately visited with `visit-tags-table'."
(defvar reftex-grep-command "grep -n "
"Last grep command used in \\[reftex-grep-document]; default for next grep.")
+;;;###autoload
(defun reftex-grep-document (grep-cmd)
"Run grep query through all files related to this document.
With prefix arg, force to rescan document.
@@ -64,6 +66,7 @@ No active TAGS table is required."
(mapconcat 'identity files " "))))
(grep cmd)))
+;;;###autoload
(defun reftex-search-document (&optional regexp)
"Regexp search through all files of the current document.
Starts always in the master file. Stops when a match is found.
@@ -79,6 +82,7 @@ No active TAGS table is required."
(reftex-access-scan-info current-prefix-arg)
(tags-search regexp (list 'reftex-all-document-files))))
+;;;###autoload
(defun reftex-query-replace-document (&optional from to delimited)
"Do `query-replace-regexp' of FROM with TO over the entire document.
Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
@@ -100,6 +104,7 @@ No active TAGS table is required."
(defvar TeX-master)
(defvar isearch-next-buffer-function)
+;;;###autoload
(defun reftex-find-duplicate-labels ()
"Produce a list of all duplicate labels in the document."
@@ -158,6 +163,7 @@ No active TAGS table is required."
(delete-window)
(message "Document does not contain duplicate labels."))))
+;;;###autoload
(defun reftex-change-label (&optional from to)
"Run `query-replace-regexp' of FROM with TO in all macro arguments.
Works on the entire multifile document.
@@ -177,6 +183,7 @@ No active TAGS table is required."
(concat "{" (regexp-quote from) "}")
(format "{%s}" to))))
+;;;###autoload
(defun reftex-renumber-simple-labels ()
"Renumber all simple labels in the document to make them sequentially.
Simple labels are the ones created by RefTeX, consisting only of the
@@ -304,6 +311,7 @@ one with the `xr' package."
(t nil))))))))
n))
+;;;###autoload
(defun reftex-save-all-document-buffers ()
"Save all documents associated with the current document.
The function is useful after a global action like replacing or renumbering
@@ -414,6 +422,7 @@ Also checks if buffers visiting the files are in read-only mode."
(when flist
(find-file-noselect (car flist))))))
+;; NB this is a global autoload - see reftex.el.
;;;###autoload
(defun reftex-isearch-minor-mode (&optional arg)
"When on, isearch searches the whole document, not only the current file.
@@ -466,3 +475,7 @@ With no argument, this command toggles
'reftex-isearch-minor-mode)
;;; reftex-global.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index a8e712f4f49..7e961e83406 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1,6 +1,6 @@
;;; reftex-index.el --- index support with RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -35,6 +35,7 @@
(defvar TeX-master)
;; END remove for XEmacs release
+;;;###autoload
(defun reftex-index-selection-or-word (&optional arg phrase)
"Put selection or the word near point into the default index macro.
This uses the information in `reftex-index-default-macro' to make an index
@@ -87,6 +88,7 @@ which is part of AUCTeX, the string is first processed with the
(delete-region beg end)
(reftex-index def-char full-entry def-tag sel)))))
+;;;###autoload
(defun reftex-index (&optional char key tag sel no-insert)
"Query for an index macro and insert it along with its arguments.
The index macros available are those defined in `reftex-index-macro' or
@@ -156,6 +158,7 @@ will prompt for other arguments."
(member tag tag-list)))
(put reftex-docstruct-symbol 'default-index-tag tag)))
+;;;###autoload
(defun reftex-index-complete-tag (&optional itag opt-args)
;; Ask the user for a tag, completing on known tags.
;; ITAG is the argument number which contains the tag.
@@ -180,6 +183,7 @@ will prompt for other arguments."
(reftex-update-default-index tag)
tag))
+;;;###autoload
(defun reftex-index-select-tag ()
;; Have the user select an index tag.
;; FIXME: should we cache tag-alist, prompt and help?
@@ -249,6 +253,7 @@ will prompt for other arguments."
(error "No index tag associated with %c" rpl)))))
(t (error "This should not happen (reftex-index-select-tag)")))))
+;;;###autoload
(defun reftex-index-complete-key (&optional tag optional initial)
;; Read an index key, with completion.
;; Restrict completion table on index tag TAG.
@@ -434,6 +439,7 @@ _ ^ Add/Remove parent key (to make this item a subitem).
} / { Restrict Index to a single document section / Widen.
< / > When restricted, move restriction to previous/next section.")
+;;;###autoload
(defun reftex-index-show-entry (data &optional no-revisit)
;; Find an index entry associated with DATA and display it highlighted
;; in another window. NO-REVISIT means we are not allowed to visit
@@ -462,6 +468,7 @@ _ ^ Add/Remove parent key (to make this item a subitem).
(reftex-highlight 0 (match-beginning 0) (match-end 0) (current-buffer)))
match))
+;;;###autoload
(defun reftex-display-index (&optional tag overriding-restriction redo
&rest locations)
"Display a buffer with an index compiled from the current document.
@@ -537,18 +544,28 @@ With prefix 3, restrict index to region."
(setq buffer-read-only nil)
(insert (format
-"INDEX <%s> on %s
+ "INDEX <%s> on %s
Restriction: <%s>
SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
------------------------------------------------------------------------------
-" index-tag (abbreviate-file-name master)
-(if (eq (car (car reftex-index-restriction-data)) 'toc)
- (nth 2 (car reftex-index-restriction-data))
- reftex-index-restriction-indicator)))
+"
+ index-tag (abbreviate-file-name master)
+ (if (eq (car (car reftex-index-restriction-data)) 'toc)
+ (nth 2 (car reftex-index-restriction-data))
+ reftex-index-restriction-indicator)))
(if (reftex-use-fonts)
- (put-text-property 1 (point) 'face reftex-index-header-face))
- (put-text-property 1 (point) 'intangible t)
+ (put-text-property (point-min) (point)
+ 'face reftex-index-header-face))
+ (if (fboundp 'cursor-intangible-mode)
+ (cursor-intangible-mode 1)
+ ;; If `cursor-intangible' is not available, fallback on the old
+ ;; intrusive `intangible' property.
+ (put-text-property (point-min) (point) 'intangible t))
+ (add-text-properties (point-min) (point)
+ '(cursor-intangible t
+ front-sticky (cursor-intangible)
+ rear-nonsticky (cursor-intangible)))
(reftex-insert-index docstruct index-tag)
(goto-char (point-min))
@@ -690,9 +707,10 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help
(defun reftex-index-post-command-hook ()
;; Used in the post-command-hook for the *Index* buffer
+ ;; FIXME: Lots of redundancy with reftex-toc-post-command-hook!
(when (get-text-property (point) :data)
- (and (> (point) 1)
- (not (get-text-property (point) 'intangible))
+ (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing?
+ (not (get-text-property (point) 'cursor-intangible))
(memq reftex-highlight-selection '(cursor both))
(reftex-highlight 1
(or (previous-single-property-change (1+ (point)) :data)
@@ -896,7 +914,7 @@ When index is restricted, select the previous section as restriction criterion."
;; If FINAL is t, stay there
;; If FINAL is 'hide, hide the *Index* window.
;; Otherwise, move cursor back into *Index* window.
- ;; NO-REVISIT means don't visit files, just use live biffers.
+ ;; NO-REVISIT means don't visit files, just use live buffers.
(let* ((data (get-text-property (point) :data))
(index-window (selected-window))
@@ -1244,6 +1262,7 @@ This gets refreshed in every phrases command.")
table)
"Syntax table for RefTeX Index Phrases mode.")
+;;;###autoload
(defun reftex-index-phrase-selection-or-word (arg)
"Add current selection or word at point to the phrases buffer.
When you are in transient-mark-mode and the region is active, the
@@ -1258,6 +1277,7 @@ You get a chance to edit the entry in the phrases buffer - finish with
(substitute-command-keys
"Return to LaTeX with \\[reftex-index-phrases-save-and-return]"))))
+;;;###autoload
(defun reftex-index-visit-phrases-buffer ()
"Switch to the phrases buffer, initialize if empty."
(interactive)
@@ -1345,6 +1365,7 @@ If the buffer is non-empty, delete the old header first."
(defvar reftex-index-phrases-menu)
(defvar reftex-index-phrases-marker)
(defvar reftex-index-phrases-restrict-file nil)
+;; NB this is a global autoload - see reftex.el.
;;;###autoload
(define-derived-mode reftex-index-phrases-mode fundamental-mode "Phrases"
"Major mode for managing the Index phrases of a LaTeX document.
@@ -2096,3 +2117,7 @@ Does not do a save-excursion."
(provide 'reftex-index)
;;; reftex-index.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index a99791e5427..f57113177c5 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -1,6 +1,6 @@
;;; reftex-parse.el --- parser functions for RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -37,17 +37,22 @@
,@body))
(set-syntax-table saved-syntax))))
+;;;###autoload
(defun reftex-parse-one ()
"Re-parse this file."
(interactive)
(let ((reftex-enable-partial-scans t))
(reftex-access-scan-info '(4))))
+;;;###autoload
(defun reftex-parse-all ()
"Re-parse entire document."
(interactive)
(reftex-access-scan-info '(16)))
+(defvar reftex--index-tags)
+
+;;;###autoload
(defun reftex-do-parse (rescan &optional file)
"Do a document rescan.
When allowed, do only a partial scan from FILE."
@@ -72,7 +77,7 @@ When allowed, do only a partial scan from FILE."
(file (or file (buffer-file-name)))
(true-file (file-truename file))
(bibview-cache (assq 'bibview-cache old-list))
- (index-tags (cdr (assq 'index-tags old-list)))
+ (reftex--index-tags (cdr (assq 'index-tags old-list)))
from-file appendix docstruct tmp)
;; Make sure replacement is really an option here
@@ -92,7 +97,7 @@ When allowed, do only a partial scan from FILE."
(t (error "This should not happen (reftex-do-parse)"))))
;; Reset index-tags if we scan everything
- (if (equal rescan 1) (setq index-tags nil))
+ (if (equal rescan 1) (setq reftex--index-tags nil))
;; Find active toc entry and initialize section-numbers
(setq reftex-active-toc (reftex-last-assoc-before-elt
@@ -137,11 +142,12 @@ When allowed, do only a partial scan from FILE."
(entry (or (assq 'is-multi docstruct)
(car (push (list 'is-multi is-multi) docstruct)))))
(setcdr entry (cons is-multi nil)))
- (and index-tags (setq index-tags (sort index-tags 'string<)))
+ (and reftex--index-tags
+ (setq reftex--index-tags (sort reftex--index-tags 'string<)))
(let ((index-tag-cell (assq 'index-tags docstruct)))
(if index-tag-cell
- (setcdr index-tag-cell index-tags)
- (push (cons 'index-tags index-tags) docstruct)))
+ (setcdr index-tag-cell reftex--index-tags)
+ (push (cons 'index-tags reftex--index-tags) docstruct)))
(unless (assq 'xr docstruct)
(let* ((allxr (reftex-all-assq 'xr-doc docstruct))
(alist (mapcar
@@ -165,11 +171,13 @@ When allowed, do only a partial scan from FILE."
(set reftex-docstruct-symbol docstruct)
(put reftex-docstruct-symbol 'modified t)))
+;;;###autoload
(defun reftex-everything-regexp ()
(if reftex-support-index
reftex-everything-regexp
reftex-everything-regexp-no-index))
+;; NB this is a global autoload - see reftex.el.
;;;###autoload
(defun reftex-all-document-files (&optional relative)
"Return a list of all files belonging to the current document.
@@ -189,8 +197,6 @@ of master file."
(nreverse file-list)))
;; Bound in the caller, reftex-do-parse.
-(defvar index-tags)
-
(defun reftex-parse-from-file (file docstruct master-dir)
"Scan the buffer for labels and save them in a list."
(let ((regexp (reftex-everything-regexp))
@@ -238,7 +244,7 @@ of master file."
(when (or (null reftex-label-ignored-macros-and-environments)
;; \label{} defs should always be honored,
;; just no keyval style [label=foo] defs.
- (string-equal "\label{" (substring (reftex-match-string 0) 0 7))
+ (string-equal "\\label{" (substring (reftex-match-string 0) 0 7))
(if (and (fboundp 'TeX-current-macro)
(fboundp 'LaTeX-current-environment))
(not (or (member (save-match-data (TeX-current-macro))
@@ -300,7 +306,7 @@ of master file."
(when reftex-support-index
(setq index-entry (reftex-index-info file))
(when index-entry
- (add-to-list 'index-tags (nth 1 index-entry))
+ (add-to-list 'reftex--index-tags (nth 1 index-entry))
(push index-entry docstruct))))
((match-end 11)
@@ -350,20 +356,39 @@ of master file."
;; Return the list
docstruct))
+(defun reftex-using-biblatex-p ()
+ "Return non-nil if we are using biblatex rather than bibtex."
+ (if (boundp 'TeX-active-styles)
+ ;; the sophisticated AUCTeX way
+ (member "biblatex" TeX-active-styles)
+ ;; poor-man's check...
+ (save-excursion
+ (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t))))
+
+;;;###autoload
(defun reftex-locate-bibliography-files (master-dir &optional files)
- "Scan buffer for bibliography macro and return file list."
+ "Scan buffer for bibliography macros and return file list."
(unless files
(save-excursion
(goto-char (point-min))
- (if (re-search-forward
- (concat
-; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
- "\\(^\\)[^%\n\r]*\\\\\\("
- (mapconcat 'identity reftex-bibliography-commands "\\|")
- "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") nil t)
- (setq files
- (split-string (reftex-match-string 4)
- "[ \t\n\r]*,[ \t\n\r]*")))))
+ ;; when biblatex is used, multiple \bibliography or
+ ;; \addbibresource macros are allowed. With plain bibtex, only
+ ;; the first is used.
+ (let ((using-biblatex (reftex-using-biblatex-p))
+ (again t))
+ (while (and again
+ (re-search-forward
+ (concat
+ ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\("
+ "\\(^\\)[^%\n\r]*\\\\\\("
+ (mapconcat 'identity reftex-bibliography-commands "\\|")
+ "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") nil t))
+ (setq files
+ (append files
+ (split-string (reftex-match-string 4)
+ "[ \t\n\r]*,[ \t\n\r]*")))
+ (unless using-biblatex
+ (setq again nil))))))
(when files
(setq files
(mapcar
@@ -403,6 +428,7 @@ This function also makes sure the old toc markers do not point anywhere."
(setcdr (nthcdr (1- (length new)) new) (cdr eof-list)))
new))))
+;;;###autoload
(defun reftex-section-info (file)
"Return a section entry for the current match.
Careful: This function expects the match-data to be still in place!"
@@ -439,6 +465,7 @@ Careful: This function expects the match-data to be still in place!"
(list 'toc "toc" text file marker level section-number
literal (marker-position marker))))
+;;;###autoload
(defun reftex-ensure-index-support (&optional abort)
"When index support is turned off, ask to turn it on and
set the current prefix argument so that `reftex-access-scan-info'
@@ -454,11 +481,13 @@ will rescan the entire document."
(ding)
(sit-for 1)))))
+;;;###autoload
(defun reftex-index-info-safe (file)
(reftex-with-special-syntax
(reftex-index-info file)))
(defvar test-dummy)
+;;;###autoload
(defun reftex-index-info (file)
"Return an index entry for the current match.
Careful: This function expects the match-data to be still in place!"
@@ -507,6 +536,7 @@ Careful: This function expects the match-data to be still in place!"
;; 0 1 2 3 4 5 6 7 8 9
(list 'index index-tag context file bom arg key showkey sortkey key-end))))
+;;;###autoload
(defun reftex-short-context (env parse &optional bound derive)
"Get about one line of useful context for the label definition at point."
@@ -567,6 +597,7 @@ Careful: This function expects the match-data to be still in place!"
(t
"INVALID VALUE OF PARSE"))))
+;;;###autoload
(defun reftex-where-am-I ()
"Return the docstruct entry above point.
Actually returns a cons cell in which the cdr is a flag indicating
@@ -665,6 +696,7 @@ if the information is exact (t) or approximate (nil)."
cnt 2))
(cons rtn (eq cnt 1))))
+;;;###autoload
(defun reftex-notice-new (&optional n force)
"Hook to handshake with RefTeX after something new has been inserted."
;; Add a new entry to the docstruct list. If it is a section, renumber
@@ -741,7 +773,7 @@ if the information is exact (t) or approximate (nil)."
;; Index entry
(and reftex-support-index
(setq entry (reftex-index-info-safe buffer-file-name))
- ;; FIXME: (add-to-list 'index-tags (nth 1 index-entry))
+ ;; FIXME: (add-to-list 'reftex--index-tags (nth 1 index-entry))
(push entry (cdr tail))))))))))
(error nil))
@@ -763,11 +795,13 @@ in TeX."
t)
(t nil)))
+;;;###autoload
(defun reftex-what-macro-safe (which &optional bound)
"Call `reftex-what-macro' with special syntax table."
(reftex-with-special-syntax
(reftex-what-macro which bound)))
+;;;###autoload
(defun reftex-what-macro (which &optional bound)
"Find out if point is within the arguments of any TeX-macro.
The return value is either (\"\\macro\" . (point)) or a list of them.
@@ -830,6 +864,7 @@ considered an argument of macro \\macro."
(goto-char pos)))
(nreverse cmd-list)))))
+;;;###autoload
(defun reftex-what-environment (which &optional bound)
"Find out if point is inside a LaTeX environment.
The return value is (e.g.) either (\"equation\" . (point)) or a list of
@@ -867,6 +902,7 @@ this point. If it is nil, limit to nearest \\section - like statement."
(throw 'exit (cons env (point))))))
(nreverse env-list)))))
+;;;###autoload
(defun reftex-what-special-env (which &optional bound)
"Run the special environment parsers and return the matches.
@@ -907,7 +943,7 @@ If WHICH is a list of environments, look only for those environments and
specials
(car specials))))))
-(defsubst reftex-move-to-next-arg (&optional ignore)
+(defsubst reftex-move-to-next-arg (&optional _ignore)
"Assuming that we are at the end of a macro name or a macro argument,
move forward to the opening parenthesis of the next argument.
This function understands the splitting of macros over several lines
@@ -926,6 +962,7 @@ in TeX."
(let ((entry (assoc key reftex-env-or-mac-alist)))
(reftex-nth-arg (nth 5 entry) (nth 6 entry))))
+;;;###autoload
(defun reftex-nth-arg (n &optional opt-args)
"Return the Nth following {} or [] parentheses content.
OPT-ARGS is a list of argument numbers which are optional."
@@ -964,6 +1001,7 @@ OPT-ARGS is a list of argument numbers which are optional."
(reftex-context-substring)
nil))))
+;;;###autoload
(defun reftex-move-over-touching-args ()
(condition-case nil
(while (memq (following-char) '(?\[ ?\{))
@@ -1003,6 +1041,7 @@ When point is just after a { or [, limit string to matching parenthesis"
;; Variable holding the vector with section numbers
(defvar reftex-section-numbers (make-vector reftex-max-section-depth 0))
+;;;###autoload
(defun reftex-init-section-numbers (&optional toc-entry appendix)
"Initialize the section numbers with zeros or with what is found in the TOC-ENTRY."
(let* ((level (or (nth 5 toc-entry) -1))
@@ -1021,6 +1060,7 @@ When point is just after a { or [, limit string to matching parenthesis"
(decf i)))
(put 'reftex-section-numbers 'appendix appendix))
+;;;###autoload
(defun reftex-section-number (&optional level star)
"Return a string with the current section number.
When LEVEL is non-nil, increase section numbers on that level."
@@ -1089,3 +1129,7 @@ When LEVEL is non-nil, increase section numbers on that level."
(provide 'reftex-parse)
;;; reftex-parse.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 575d885a322..df78447defb 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -1,6 +1,6 @@
;;; reftex-ref.el --- code to create labels and references with RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -29,6 +29,7 @@
(require 'reftex)
(require 'reftex-parse)
+;;;###autoload
(defun reftex-label-location (&optional bound)
"Return the environment or macro which determines the label type at point.
If optional BOUND is an integer, limit backward searches to that point."
@@ -62,6 +63,7 @@ If optional BOUND is an integer, limit backward searches to that point."
(t ;; This should not happen, I think?
"section"))))
+;;;###autoload
(defun reftex-label-info-update (cell)
;; Update information about just one label in a different file.
;; CELL contains the old info list
@@ -92,6 +94,7 @@ If optional BOUND is an integer, limit backward searches to that point."
(append (reftex-label-info label file) (list note)))
(list label typekey "" file "LOST LABEL. RESCAN TO FIX.")))))))
+;;;###autoload
(defun reftex-label-info (label &optional file bound derive env-or-mac)
;; Return info list on LABEL at point.
(let* ((prefix (if (string-match "^[a-zA-Z0-9]+:" label)
@@ -118,6 +121,7 @@ If optional BOUND is an integer, limit backward searches to that point."
;;; Creating labels ---------------------------------------------------------
+;;;###autoload
(defun reftex-label (&optional environment no-insert)
"Insert a unique label. Return the label.
If ENVIRONMENT is given, don't bother to find out yourself.
@@ -224,7 +228,7 @@ This function is controlled by the settings of reftex-insert-label-flags."
(symbol-value reftex-docstruct-symbol)))
(ding)
(if (y-or-n-p
- (format "Label '%s' exists. Use anyway? " label))
+` (format-message "Label `%s' exists. Use anyway? " label))
(setq valid t)))
;; Label is ok
@@ -398,6 +402,7 @@ also applies `reftex-translate-to-ascii-function' to the string."
a / A Put all marked entries into one/many \\ref commands.
q / RET Quit without referencing / Accept current label (also on mouse-2).")
+;;;###autoload
(defun reftex-reference (&optional type no-insert cut)
"Make a LaTeX reference. Look only for labels of a certain TYPE.
With prefix arg, force to rescan buffer for labels. This should only be
@@ -705,6 +710,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
(file (nth 3 data)))
(reftex-access-scan-info arg file)))))
+;;;###autoload
(defun reftex-query-label-type ()
;; Ask for label type
(let ((key (reftex-select-with-char
@@ -713,6 +719,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
(error "No such label type: %s" (char-to-string key)))
(char-to-string key)))
+;;;###autoload
(defun reftex-show-label-location (data forward no-revisit
&optional stay error)
;; View the definition site of a label in another window.
@@ -833,10 +840,14 @@ package.\n\nThis is a generated function."
Replace any occurrences of \"\\ref\" with REFSTYLE."
;; Replace instances of \ref in `fmt' with the special reference
;; style selected by the user.
- (while (string-match "\\(\\\\ref\\)[ \t]*{" fmt)
- (setq fmt (replace-match refstyle t t fmt 1)))
+ (cond
+ ((while (string-match "\\(\\\\ref\\)[ \t]*{" fmt)
+ (setq fmt (replace-match refstyle t t fmt 1))))
+ ((string-match "\\(\\\\[[:alpha:]]+\\)[ \t]*{" fmt)
+ (setq fmt (replace-match refstyle t t fmt 1))))
(format fmt label))
+;;;###autoload
(defun reftex-goto-label (&optional other-window)
"Prompt for a label (with completion) and jump to the location of this label.
Optional prefix argument OTHER-WINDOW goes to the label in another window."
@@ -846,7 +857,8 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window."
(docstruct (symbol-value reftex-docstruct-symbol))
;; If point is inside a \ref{} or \pageref{}, use that as
;; default value.
- (default (when (looking-back "\\\\\\(?:page\\)?ref{[-a-zA-Z0-9_*.:]*")
+ (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)
@@ -867,3 +879,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window."
(provide 'reftex-ref)
;;; reftex-ref.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index af1d1945f39..643dbfb5a35 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -1,6 +1,6 @@
;;; reftex-sel.el --- the selection modes for RefTeX
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -102,7 +102,8 @@
This keymap can be used to configure the label selection process which is
started with the command \\[reftex-reference].")
-(define-derived-mode reftex-select-label-mode fundamental-mode "LSelect"
+;;;###autoload
+(define-derived-mode reftex-select-label-mode special-mode "LSelect"
"Major mode for selecting a label in a LaTeX document.
This buffer was created with RefTeX.
It only has a meaningful keymap when you are in the middle of a
@@ -147,7 +148,8 @@ During a selection process, these are the local bindings.
This keymap can be used to configure the BibTeX selection process which is
started with the command \\[reftex-citation].")
-(define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect"
+;;;###autoload
+(define-derived-mode reftex-select-bib-mode special-mode "BSelect"
"Major mode for selecting a citation key in a LaTeX document.
This buffer was created with RefTeX.
It only has a meaningful keymap when you are in the middle of a
@@ -188,6 +190,7 @@ During a selection process, these are the local bindings.
;; (throw 'exit entry)))
;; nil))))
+;;;###autoload
(defun reftex-get-offset (buf here-am-I &optional typekey toc index file)
;; Find the correct offset data, like insert-docstruct would, but faster.
;; Buffer BUF knows the correct docstruct to use.
@@ -212,6 +215,7 @@ During a selection process, these are the local bindings.
(throw 'exit (or lastentry entry))))
nil))))
+;;;###autoload
(defun reftex-insert-docstruct
(buf toc labels index-entries files context counter show-commented
here-I-am xr-prefix toc-buffer)
@@ -292,7 +296,7 @@ During a selection process, these are the local bindings.
(setq to (point))
(when font
(put-text-property from to
- 'face reftex-file-boundary-face))
+ 'font-lock-face reftex-file-boundary-face))
(when toc-buffer
(if mouse-face
(put-text-property from (1- to)
@@ -310,7 +314,7 @@ During a selection process, these are the local bindings.
(setq to (point))
(when font
(put-text-property from to
- 'face reftex-section-heading-face))
+ 'font-lock-face reftex-section-heading-face))
(when toc-buffer
(if mouse-face
(put-text-property from (1- to)
@@ -349,7 +353,7 @@ During a selection process, these are the local bindings.
(setq to (point))
(put-text-property
(- (point) (length label)) to
- 'face (if comment
+ 'font-lock-face (if comment
'font-lock-comment-face
label-face))
(goto-char to))
@@ -379,14 +383,14 @@ During a selection process, these are the local bindings.
(setq index-tag (format "<%s>" (nth 1 cell)))
(and font
(put-text-property 0 (length index-tag)
- 'face reftex-index-tag-face index-tag))
+ 'font-lock-face reftex-index-tag-face index-tag))
(insert label-indent index-tag " " (nth 7 cell))
(when font
(setq to (point))
(put-text-property
(- (point) (length (nth 7 cell))) to
- 'face index-face)
+ 'font-lock-face index-face)
(goto-char to))
(insert "\n")
(setq to (point))
@@ -412,6 +416,7 @@ During a selection process, these are the local bindings.
(run-hooks 'reftex-display-copied-context-hook)
offset))
+;;;###autoload
(defun reftex-find-start-point (fallback &rest locations)
;; Set point to the first available LOCATION. When a LOCATION is a list,
;; search for such a :data text property. When it is an integer,
@@ -440,6 +445,7 @@ During a selection process, these are the local bindings.
(defvar reftex-last-line nil)
(defvar reftex-select-marked nil)
+;;;###autoload
(defun reftex-select-item (reftex-select-prompt help-string keymap
&optional offset
call-back cb-flag)
@@ -684,7 +690,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
eoe (or (next-single-property-change (point) :data) (point-max)))
(setq ovl (reftex-make-overlay boe eoe))
(push (list data ovl separator) reftex-select-marked)
- (reftex-overlay-put ovl 'face reftex-select-mark-face)
+ (reftex-overlay-put ovl 'font-lock-face reftex-select-mark-face)
(reftex-overlay-put ovl 'before-string
(if separator
(format "*%c%d* " separator
@@ -737,3 +743,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil."
(provide 'reftex-sel)
;;; reftex-sel.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index b7d57733467..bdae6e54ef3 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -1,6 +1,6 @@
;;; reftex-toc.el --- RefTeX's table of contents mode
-;; Copyright (C) 1997-2000, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -129,7 +129,7 @@
(defvar reftex-toc-include-index-indicator nil)
(defvar reftex-toc-max-level-indicator nil)
-(define-derived-mode reftex-toc-mode fundamental-mode "TOC"
+(define-derived-mode reftex-toc-mode special-mode "TOC"
"Major mode for managing Table of Contents for LaTeX files.
This buffer was created with RefTeX.
Press `?' for a summary of important key bindings.
@@ -190,7 +190,11 @@ M-% Global search and replace to rename label at point.
x Switch to TOC of external document (with LaTeX package `xr').
z Jump to a specific section (e.g. '3 z' goes to section 3).")
-(defun reftex-toc (&optional rebuild reuse)
+(defvar reftex--rebuilding-toc nil)
+
+;;;###autoload
+(defun reftex-toc (&optional _rebuild reuse)
+ ;; FIXME: Get rid of the `rebuild' argument.
"Show the table of contents for the current document.
When called with a raw C-u prefix, rescan the document first."
@@ -200,6 +204,9 @@ When called with a raw C-u prefix, rescan the document first."
(interactive)
(if (or (not (string= reftex-last-toc-master (reftex-TeX-master-file)))
+ ;; FIXME: use (interactive "P") to receive current-prefix-arg as
+ ;; an argument instead of using the var here, which forces us to set
+ ;; current-prefix-arg in the callers.
current-prefix-arg)
(reftex-erase-buffer "*toc*"))
@@ -224,7 +231,7 @@ When called with a raw C-u prefix, rescan the document first."
(docstruct-symbol reftex-docstruct-symbol)
(xr-data (assq 'xr (symbol-value reftex-docstruct-symbol)))
(xr-alist (cons (cons "" (buffer-file-name)) (nth 1 xr-data)))
- (here-I-am (if (boundp 'reftex-rebuilding-toc)
+ (here-I-am (if reftex--rebuilding-toc
(get 'reftex-toc :reftex-data)
(car (reftex-where-am-I))))
(unsplittable (if (fboundp 'frame-property)
@@ -240,13 +247,13 @@ When called with a raw C-u prefix, rescan the document first."
(< (window-height) (* 2 window-min-height)))
(delete-other-windows))
- (setq reftex-last-window-width (window-width)
+ (setq reftex-last-window-width (window-total-width)
reftex-last-window-height (window-height)) ; remember
(unless unsplittable
(if reftex-toc-split-windows-horizontally
(split-window-right
- (floor (* (window-width)
+ (floor (* (window-total-width)
reftex-toc-split-windows-fraction)))
(split-window-below
(floor (* (window-height)
@@ -278,8 +285,16 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
" (abbreviate-file-name reftex-last-toc-master)))
(if (reftex-use-fonts)
- (put-text-property (point-min) (point) 'face reftex-toc-header-face))
- (put-text-property (point-min) (point) 'intangible t)
+ (put-text-property (point-min) (point) 'font-lock-face reftex-toc-header-face))
+ (if (fboundp 'cursor-intangible-mode)
+ (cursor-intangible-mode 1)
+ ;; If `cursor-intangible' is not available, fallback on the old
+ ;; intrusive `intangible' property.
+ (put-text-property (point-min) (point) 'intangible t))
+ (add-text-properties (point-min) (point)
+ '(cursor-intangible t
+ front-sticky (cursor-intangible)
+ rear-nonsticky (cursor-intangible)))
(put-text-property (point-min) (1+ (point-min)) 'xr-alist xr-alist)
(setq offset
@@ -319,6 +334,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(reftex-find-start-point (point) offset (get 'reftex-toc :reftex-line))
(setq reftex-last-follow-point (point))))
+;;;###autoload
(defun reftex-toc-recenter (&optional arg)
"Display the TOC window and highlight line corresponding to current position."
(interactive "P")
@@ -329,8 +345,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(let ((current-prefix-arg nil))
(select-window (get-buffer-window buf frame))
(reftex-toc nil t)))
- (and (> (point) 1)
- (not (get-text-property (point) 'intangible))
+ (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing?
+ (not (get-text-property (point) 'cursor-intangible))
(memq reftex-highlight-selection '(cursor both))
(reftex-highlight 2
(or (previous-single-property-change
@@ -347,10 +363,11 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(defun reftex-toc-post-command-hook ()
;; used in the post-command-hook for the *toc* buffer
+ ;; FIXME: Lots of redundancy with reftex-index-post-command-hook!
(when (get-text-property (point) :data)
(put 'reftex-toc :reftex-data (get-text-property (point) :data))
- (and (> (point) 1)
- (not (get-text-property (point) 'intangible))
+ (and (> (point) 1) ;FIXME: Is this point-min or do we care about narrowing?
+ (not (get-text-property (point) 'cursor-intangible))
(memq reftex-highlight-selection '(cursor both))
(reftex-highlight 2
(or (previous-single-property-change (1+ (point)) :data)
@@ -372,8 +389,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(defun reftex-re-enlarge ()
"Enlarge window to a remembered size."
(let ((count (if reftex-toc-split-windows-horizontally
- (- (or reftex-last-window-width (window-width))
- (window-width))
+ (- (or reftex-last-window-width (window-total-width))
+ (window-total-width))
(- (or reftex-last-window-height (window-height))
(window-height)))))
(when (> count 0)
@@ -403,17 +420,17 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
(if reftex-toc-follow-mode
(setq reftex-toc-follow-mode 1)))
-(defun reftex-toc-next (&optional arg)
+(defun reftex-toc-next (&optional _arg)
"Move to next selectable item."
- (interactive "p")
+ (interactive)
(when (featurep 'xemacs) (setq zmacs-region-stays t))
(setq reftex-callback-fwd t)
(or (eobp) (forward-char 1))
(goto-char (or (next-single-property-change (point) :data)
(point))))
-(defun reftex-toc-previous (&optional arg)
+(defun reftex-toc-previous (&optional _arg)
"Move to previous selectable item."
- (interactive "p")
+ (interactive)
(when (featurep 'xemacs) (setq zmacs-region-stays t))
(setq reftex-callback-fwd nil)
(goto-char (or (previous-single-property-change (point) :data)
@@ -547,7 +564,7 @@ With prefix arg 1, restrict index to the section at point."
(reftex-display-index (if restr nil arg) restr)))
;; Rescanning the document and rebuilding the TOC buffer.
-(defun reftex-toc-rescan (&rest ignore)
+(defun reftex-toc-rescan (&rest _)
"Regenerate the *toc* buffer by reparsing file of section at point."
(interactive)
(if (and reftex-enable-partial-scans
@@ -565,12 +582,12 @@ With prefix arg 1, restrict index to the section at point."
(switch-to-buffer-other-window
(reftex-get-file-buffer-force file))
(setq current-prefix-arg '(4))
- (let ((reftex-rebuilding-toc t))
+ (let ((reftex--rebuilding-toc t))
(reftex-toc))))
(reftex-toc-Rescan))
(reftex-kill-temporary-buffers))
-(defun reftex-toc-Rescan (&rest ignore)
+(defun reftex-toc-Rescan (&rest _)
"Regenerate the *toc* buffer by reparsing the entire document."
(interactive)
(let* ((line (+ (count-lines (point-min) (point)) (if (bolp) 1 0))))
@@ -578,17 +595,17 @@ With prefix arg 1, restrict index to the section at point."
(switch-to-buffer-other-window
(reftex-get-file-buffer-force reftex-last-toc-file))
(setq current-prefix-arg '(16))
- (let ((reftex-rebuilding-toc t))
+ (let ((reftex--rebuilding-toc t))
(reftex-toc)))
-(defun reftex-toc-revert (&rest ignore)
+(defun reftex-toc-revert (&rest _)
"Regenerate the TOC from the internal lists."
(interactive)
(let ((unsplittable
(if (fboundp 'frame-property)
(frame-property (selected-frame) 'unsplittable)
(frame-parameter nil 'unsplittable)))
- (reftex-rebuilding-toc t))
+ (reftex--rebuilding-toc t))
(if unsplittable
(switch-to-buffer
(reftex-get-file-buffer-force reftex-last-toc-file))
@@ -596,9 +613,9 @@ With prefix arg 1, restrict index to the section at point."
(reftex-get-file-buffer-force reftex-last-toc-file))))
(reftex-erase-buffer "*toc*")
(setq current-prefix-arg nil)
- (reftex-toc t))
+ (reftex-toc t t))
-(defun reftex-toc-external (&rest ignore)
+(defun reftex-toc-external (&rest _)
"Switch to table of contents of an external document."
(interactive)
(reftex-toc-dframe-p nil 'error)
@@ -626,18 +643,17 @@ Useful for large TOCs."
;; Promotion/Demotion stuff
-(defvar pro-or-de)
-(defvar start-pos)
-(defvar start-line)
-(defvar mark-line)
+(defvar reftex--pro-or-de)
+(defvar reftex--start-line)
+(defvar reftex--mark-line)
-(defun reftex-toc-demote (&optional arg)
+(defun reftex-toc-demote (&optional _arg)
"Demote section at point. If region is active, apply to all in region."
- (interactive "p")
+ (interactive)
(reftex-toc-do-promote 1))
-(defun reftex-toc-promote (&optional arg)
+(defun reftex-toc-promote (&optional _arg)
"Promote section at point. If region is active, apply to all in region."
- (interactive "p")
+ (interactive)
(reftex-toc-do-promote -1))
(defun reftex-toc-do-promote (delta)
"Workhorse for `reftex-toc-promote' and `reftex-toc-demote'.
@@ -646,14 +662,15 @@ point."
;; We should not do anything unless we are sure this is going to work for
;; each section in the region. Therefore we first collect information and
;; test.
- (let* ((start-line (+ (count-lines (point-min) (point))
- (if (bolp) 1 0)))
- (mark-line (if (reftex-region-active-p)
- (save-excursion (goto-char (mark))
- (+ (count-lines (point-min) (point))
- (if (bolp) 1 0)))))
+ (let* ((reftex--start-line (+ (count-lines (point-min) (point))
+ (if (bolp) 1 0)))
+ (reftex--mark-line
+ (if (reftex-region-active-p)
+ (save-excursion (goto-char (mark))
+ (+ (count-lines (point-min) (point))
+ (if (bolp) 1 0)))))
(start-pos (point))
- (pro-or-de (if (> delta 0) "de" "pro"))
+ (reftex--pro-or-de (if (> delta 0) "de" "pro"))
beg end entries data sections nsec msg)
(setq msg
(catch 'exit
@@ -702,23 +719,23 @@ point."
;; Rescan the document and rebuilt the toc buffer
(save-window-excursion
(reftex-toc-Rescan))
- (reftex-toc-restore-region start-line mark-line)
+ (reftex-toc-restore-region reftex--start-line reftex--mark-line)
(message "%d section%s %smoted"
- nsec (if (= 1 nsec) "" "s") pro-or-de)
+ nsec (if (= 1 nsec) "" "s") reftex--pro-or-de)
nil))
(if msg (progn (ding) (message "%s" msg)))))
(defun reftex-toc-restore-region (point-line &optional mark-line)
- (let (mpos)
- (when mark-line
- (goto-char (point-min))
- (forward-line (1- mark-line))
- (setq mpos (point)))
+ (let ((mpos
+ (when mark-line
+ (goto-char (point-min))
+ (forward-line (1- mark-line))
+ (point))))
(when point-line
(goto-char (point-min))
(forward-line (1- point-line)))
- (when mark-line
+ (when mpos
(set-mark mpos)
(if (featurep 'xemacs)
(zmacs-activate-region)
@@ -738,7 +755,7 @@ promotion/demotion later. DELTA is the level change."
(name nil)
;; Here follows some paranoid code to make very sure we are not
;; going to break anything
- (name1 ; dummy
+ (_
(if (and (markerp marker) (marker-buffer marker))
;; Buffer is still live and we have the marker.
(progn
@@ -761,24 +778,24 @@ promotion/demotion later. DELTA is the level change."
;; We don't have a live marker: scan and load files.
(reftex-toc-load-all-files-for-promotion)))
(level (cdr (assoc name reftex-section-levels-all)))
- (dummy (if (not (integerp level))
- (progn
- (goto-char toc-point)
- (error "Cannot %smote special sections" pro-or-de))))
+ (_ (if (not (integerp level))
+ (progn
+ (goto-char toc-point)
+ (error "Cannot %smote special sections" reftex--pro-or-de))))
(newlevel (if (>= level 0) (+ delta level) (- level delta)))
- (dummy2 (if (or (and (>= level 0) (= newlevel -1))
- (and (< level 0) (= newlevel 0)))
- (error "Cannot %smote \\%s" pro-or-de name)))
+ (_ (if (or (and (>= level 0) (= newlevel -1))
+ (and (< level 0) (= newlevel 0)))
+ (error "Cannot %smote \\%s" reftex--pro-or-de name)))
(newname (reftex-toc-newhead-from-alist newlevel name
reftex-section-levels-all)))
(if (and name newname)
(list data name newname toc-point)
(goto-char toc-point)
- (error "Cannot %smote \\%s" pro-or-de name))))
+ (error "Cannot %smote \\%s" reftex--pro-or-de name))))
(defun reftex-toc-promote-action (x)
"Change the level of a TOC entry.
-PRO-OR-DE is assumed to be dynamically scoped into this function."
+`reftex--pro-or-de' is assumed to be dynamically scoped into this function."
(let* ((data (car x))
(name (nth 1 x))
(newname (nth 2 x))
@@ -787,7 +804,7 @@ PRO-OR-DE is assumed to be dynamically scoped into this function."
(goto-char (marker-position marker))
(if (looking-at (concat "\\([ \t]*" reftex-section-pre-regexp "\\)" (regexp-quote name)))
(replace-match (concat "\\1" newname))
- (error "Fatal error during %smotion" pro-or-de)))))
+ (error "Fatal error during %smotion" reftex--pro-or-de)))))
(defun reftex-toc-extract-section-number (entry)
"Get the numbering of a TOC entry, for message purposes."
@@ -837,11 +854,11 @@ if these sets are sorted blocks in the alist."
"Make sure all files of the document are being visited by buffers,
and that the scanning info is absolutely up to date.
We do this by rescanning with `reftex-keep-temporary-buffers' bound to t.
-The variable PRO-OR-DE is assumed to be dynamically scoped into this function.
+The variable `reftex--pro-or-de' is assumed to be dynamically scoped into this function.
When finished, we exit with an error message."
(let ((reftex-keep-temporary-buffers t))
(reftex-toc-Rescan)
- (reftex-toc-restore-region start-line mark-line)
+ (reftex-toc-restore-region reftex--start-line reftex--mark-line)
(throw 'exit
"TOC had to be updated first. Please check selection and repeat the command.")))
@@ -859,7 +876,7 @@ label prefix determines the wording of a reference."
(setq newlabel (read-string (format "Rename label \"%s\" to:" label)))
(if (assoc newlabel (symbol-value reftex-docstruct-symbol))
(if (not (y-or-n-p
- (format "Label '%s' exists. Use anyway? " label)))
+ (format-message "Label `%s' exists. Use anyway? " label)))
(error "Abort")))
(save-excursion
(save-window-excursion
@@ -884,7 +901,7 @@ label prefix determines the wording of a reference."
(let* ((toc (get-text-property (point) :data))
(toc-window (selected-window))
- show-window show-buffer match)
+ match)
(unless toc (error "Don't know which TOC line to visit"))
@@ -915,30 +932,33 @@ label prefix determines the wording of a reference."
(setq match (reftex-show-label-location toc reftex-callback-fwd
no-revisit t))))
- (setq show-window (selected-window)
- show-buffer (current-buffer))
-
(unless match
(select-window toc-window)
(error "Cannot find location"))
- (select-window toc-window)
-
- ;; use the `final' parameter to decide what to do next
+ ;; Use the `final' parameter to decide what to do next.
(cond
((eq final t)
- (reftex-unhighlight 0)
- (select-window show-window))
+ (with-selected-window toc-window
+ (reftex-unhighlight 0)))
((eq final 'hide)
- (reftex-unhighlight 0)
- (or (one-window-p) (delete-window))
- ;; If `show-window' is still live, show-buffer is already visible
- ;; so let's not make it visible in yet-another-window.
- (if (window-live-p show-window)
- (set-buffer show-buffer)
- (switch-to-buffer show-buffer))
- (reftex-re-enlarge))
- (t nil))))
+ (let ((show-window (selected-window))
+ (show-buffer (window-buffer)))
+ (unless (eq show-window toc-window) ;FIXME: Can this happen?
+ (with-selected-window toc-window
+ (reftex-unhighlight 0)
+ (or (one-window-p) (delete-window))))
+ ;; If `show-window' is still live, show-buffer is already visible
+ ;; so let's not make it visible in yet-another-window.
+ (unless (window-live-p show-window)
+ ;; FIXME: How could show-window not be live?
+ (switch-to-buffer show-buffer))
+ (reftex-re-enlarge)))
+ (t
+ (unless (eq (selected-frame) (window-frame toc-window))
+ ;; Make sure `toc-window' is not just selected but has focus.
+ (select-frame-set-input-focus (window-frame toc-window)))
+ (select-window toc-window)))))
(defun reftex-toc-find-section (toc &optional no-revisit)
(let* ((file (nth 3 toc))
@@ -1009,6 +1029,7 @@ label prefix determines the wording of a reference."
(let (current-prefix-arg)
(reftex-toc-recenter))))
+;;;###autoload
(defun reftex-toggle-auto-toc-recenter ()
"Toggle the automatic recentering of the TOC window.
When active, leaving point idle will make the TOC window jump to the correct
@@ -1088,3 +1109,7 @@ always show the current section in connection with the option
(reftex-toggle-auto-toc-recenter))))
;;; reftex-toc.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "reftex.el"
+;; End:
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index ce23a48dec6..97c8af365e8 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1,6 +1,6 @@
;;; reftex-vars.el --- configuration variables for RefTeX
-;; Copyright (C) 1997-1999, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2001-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -85,11 +85,12 @@
(supertab "Supertabular environment"
(("supertabular" ?t nil nil "\\tablecaption{")))
- (wrapfig "The wrapfigure environment"
- (("wrapfigure" ?f nil nil caption)))
+ (wrapfig "The wrapfig package"
+ (("wrapfigure" ?f nil nil caption)
+ ("wraptable" ?t nil nil caption)))
(ctable "The ctable package"
- (("\\ctable[]{}{}{}" ?t "tab:" "\\ref{%s}" 1 ("table" "Tabelle"))))
+ (("\\ctable[]{}{}{}" ?t "tab:" "~\\ref{%s}" 1 ("table" "Tabelle"))))
(listings "The listings package"
(("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting"))))
@@ -127,7 +128,10 @@
;; The label macro is hard coded, but it *could* be defined like this:
;;("\\label{*}" nil nil nil nil)
- )))
+ ))
+
+ ;; Texinfo
+ (Texinfo "Texinfo default environments" nil))
"The default label environment descriptions.
Lower-case symbols correspond to a style file of the same name in the LaTeX
distribution. Mixed-case symbols are convenience aliases.")
@@ -260,6 +264,7 @@ distribution. Mixed-case symbols are convenience aliases.")
The file name is expected after the command, either in braces or separated
by whitespace."
:group 'reftex-table-of-contents-browser
+ :set 'reftex-set-dirty
:type '(repeat string))
(defcustom reftex-max-section-depth 12
@@ -649,7 +654,7 @@ Possible keys are sectioning macro names like `chapter', section levels
(string :tag "Prefix"))))
(defcustom reftex-default-context-regexps
- '((caption . "\\\\\\(rot\\)?caption\\*?[[{]")
+ '((caption . "\\\\\\(rot\\|bi\\)?\\(sub\\)?caption\\(box\\)?\\*?[[{]")
(item . "\\\\item\\(\\[[^]]*\\]\\)?")
(eqnarray-like . "\\\\begin{%s}\\|\\\\\\\\")
(alignat-like . "\\\\begin{%s}{[0-9]*}\\|\\\\\\\\"))
@@ -863,13 +868,17 @@ DOWNCASE t: Downcase words before using them."
(string :tag ""))
(option (boolean :tag "Downcase words "))))
-(defcustom reftex-label-regexps
- '(;; Normal \\label{foo} labels
- "\\\\label{\\(?1:[^}]*\\)}"
- ;; keyvals [..., label = {foo}, ...] forms used by ctable,
- ;; listings, minted, ...
- "\\[[^]]*\\<label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?")
- "List of regexps matching \\label definitions.
+(if (featurep 'xemacs)
+ ;; XEmacs 21.5 doesn't have explicitly numbered matching groups,
+ ;; so this list mustn't get any more items.
+ (defconst reftex-label-regexps '("\\\\label{\\([^}]*\\)}"))
+ (defcustom reftex-label-regexps
+ '(;; Normal \\label{foo} labels
+ "\\\\label{\\(?1:[^}]*\\)}"
+ ;; keyvals [..., label = {foo}, ...] forms used by ctable,
+ ;; listings, minted, ...
+ "\\[[^[]]*\\<label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?")
+ "List of regexps matching \\label definitions.
The default value matches usual \\label{...} definitions and
keyval style [..., label = {...}, ...] label definitions. It is
assumed that the regexp group 1 matches the label text, so you
@@ -878,12 +887,13 @@ have to define it using \\(?1:...\\) when adding new regexps.
When changed from Lisp, make sure to call
`reftex-compile-variables' afterwards to make the change
effective."
- :set (lambda (symbol value)
- (set symbol value)
- (when (fboundp 'reftex-compile-variables)
- (reftex-compile-variables)))
- :group 'reftex-defining-label-environments
- :type '(repeat (regexp :tag "Regular Expression")))
+ :version "25.1"
+ :set (lambda (symbol value)
+ (set symbol value)
+ (when (fboundp 'reftex-compile-variables)
+ (reftex-compile-variables)))
+ :group 'reftex-defining-label-environments
+ :type '(repeat (regexp :tag "Regular Expression"))))
(defcustom reftex-label-ignored-macros-and-environments nil
"List of macros and environments to be ignored when searching for labels.
@@ -1144,9 +1154,9 @@ path."
"Sorting of the entries found in BibTeX databases by reftex-citation.
Possible values:
nil Do not sort entries.
-'author Sort entries by author name.
-'year Sort entries by increasing year.
-'reverse-year Sort entries by decreasing year."
+`author' Sort entries by author name.
+`year' Sort entries by increasing year.
+`reverse-year' Sort entries by decreasing year."
:group 'reftex-citation-support
:type '(choice (const :tag "not" nil)
(const :tag "by author" author)
@@ -1442,7 +1452,7 @@ last The last used index tag will be offered as default."
:group 'reftex-index-support
:type '(choice
(const :tag "no default" nil)
- (const :tag "last used " 'last)
+ (const :tag "last used " last)
(string :tag "index tag " "idx")))
(defcustom reftex-index-math-format "$%s$"
@@ -1982,7 +1992,8 @@ symbol indicating in what context the hook is called."
(defcustom reftex-extra-bindings nil
"Non-nil means, make additional key bindings on startup.
-These extra bindings are located in the users `C-c letter' map."
+These extra bindings are located in the users `C-c letter' map.
+Note that this variable needs to be set before reftex is loaded."
:group 'reftex-miscellaneous-configurations
:type 'boolean)
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index ae8f94fd063..84efa7a5b21 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1,5 +1,5 @@
;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX
-;; Copyright (C) 1997-2000, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2000, 2003-2015 Free Software Foundation, Inc.
;; Author: Carsten Dominik <dominik@science.uva.nl>
;; Maintainer: auctex-devel@gnu.org
@@ -70,139 +70,26 @@
(require 'reftex-vars)
-;;; Autoloads
-
-;; Parser functions
-(autoload 'reftex-parse-one "reftex-parse"
- "Re-parse this file." t)
-(autoload 'reftex-parse-all "reftex-parse"
- "Re-parse entire document." t)
-(autoload 'reftex-do-parse "reftex-parse")
-(autoload 'reftex-where-am-I "reftex-parse")
-(autoload 'reftex-init-section-numbers "reftex-parse")
-(autoload 'reftex-section-info "reftex-parse")
-(autoload 'reftex-section-number "reftex-parse")
-(autoload 'reftex-what-macro "reftex-parse")
-(autoload 'reftex-what-macro-safe "reftex-parse")
-(autoload 'reftex-index-info "reftex-parse")
-(autoload 'reftex-index-info-safe "reftex-parse")
-(autoload 'reftex-short-context "reftex-parse")
-(autoload 'reftex-what-environment "reftex-parse")
-(autoload 'reftex-what-special-env "reftex-parse")
-(autoload 'reftex-move-over-touching-args "reftex-parse")
-(autoload 'reftex-notice-new "reftex-parse")
-(autoload 'reftex-nth-arg "reftex-parse")
-(autoload 'reftex-locate-bibliography-files "reftex-parse")
-(autoload 'reftex-ensure-index-support "reftex-parse")
-(autoload 'reftex-everything-regexp "reftex-parse")
-
-;; Labels and References
-(autoload 'reftex-label-location "reftex-ref")
-(autoload 'reftex-label-info-update "reftex-ref")
-(autoload 'reftex-label-info "reftex-ref")
-(autoload 'reftex-label "reftex-ref"
- "Insert a unique label." t)
-(autoload 'reftex-reference "reftex-ref"
- "Make a LaTeX reference." t)
+;;; Autoloads - see end for automatic autoloads
+
+;; We autoload tons of functions from these files, but some have
+;; a single function that needs to be globally autoloaded.
+;; The alternative is to use a Makefile rule + distinct autoload
+;; cookie (eg ;;;###reftex-autoload) for internal autoloads,
+;; as eg calendar/ does. But that seemed like overkill for 4 functions.
+
+;;;###autoload(autoload 'reftex-citation "reftex-cite" nil t)
+;;;###autoload(autoload 'reftex-all-document-files "reftex-parse")
+;;;###autoload(autoload 'reftex-isearch-minor-mode "reftex-global" nil t)
+;;;###autoload(autoload 'reftex-index-phrases-mode "reftex-index" nil t)
+
+;; Generated functions.
(autoload 'reftex-varioref-vref "reftex-ref"
"Make a varioref reference." t)
(autoload 'reftex-fancyref-fref "reftex-ref"
"Make a fancyref \\fref reference." t)
(autoload 'reftex-fancyref-Fref "reftex-ref"
"Make a fancyref \\Fref reference." t)
-(autoload 'reftex-show-label-location "reftex-ref")
-(autoload 'reftex-query-label-type "reftex-ref")
-(autoload 'reftex-goto-label "reftex-ref"
- "Prompt for label name and go to that location." t)
-
-;; Table of contents
-(autoload 'reftex-toc "reftex-toc"
- "Show the table of contents for the current document." t)
-(autoload 'reftex-toc-recenter "reftex-toc"
- "Display the TOC window and highlight line corresponding to current position." t)
-(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc"
- "Toggle automatic recentering of TOC window." t)
-
-;; BibTeX citations.
-(autoload 'reftex-citep "reftex-cite")
-(autoload 'reftex-citet "reftex-cite")
-(autoload 'reftex-make-cite-echo-string "reftex-cite")
-(autoload 'reftex-get-bibfile-list "reftex-cite")
-(autoload 'reftex-pop-to-bibtex-entry "reftex-cite")
-(autoload 'reftex-end-of-bib-entry "reftex-cite")
-(autoload 'reftex-parse-bibtex-entry "reftex-cite")
-(autoload 'reftex-citation "reftex-cite"
- "Make a citation using BibTeX database files." t)
-(autoload 'reftex-default-bibliography "reftex-cite")
-(autoload 'reftex-bib-or-thebib "reftex-cite")
-(autoload 'reftex-create-bibtex-file "reftex-cite")
-
-;; Selection
-(autoload 'reftex-select-label-mode "reftex-sel")
-(autoload 'reftex-select-bib-mode "reftex-sel")
-(autoload 'reftex-find-start-point "reftex-sel")
-(autoload 'reftex-insert-docstruct "reftex-sel")
-(autoload 'reftex-get-offset "reftex-sel")
-(autoload 'reftex-select-item "reftex-sel")
-
-;; Index support
-(autoload 'reftex-index "reftex-index"
- "Query for an index macro and insert it along with its arguments." t)
-(autoload 'reftex-index-selection-or-word "reftex-index"
- "Put selection or the word near point into the default index macro." t)
-(autoload 'reftex-index-phrase-selection-or-word "reftex-index"
- "Put selection or the word near point into Index Phrases File." t)
-(autoload 'reftex-display-index "reftex-index"
- "Display a buffer with an index compiled from the current document." t)
-(autoload 'reftex-index-visit-phrases-buffer "reftex-index"
- "Visit the Index Phrases File." t)
-(autoload 'reftex-index-phrases-mode "reftex-index"
- "Major mode for managing the Index phrases of a LaTeX document." t)
-(autoload 'reftex-index-complete-tag "reftex-index")
-(autoload 'reftex-index-complete-key "reftex-index")
-(autoload 'reftex-index-show-entry "reftex-index")
-(autoload 'reftex-index-select-tag "reftex-index")
-
-;; View cross references
-(autoload 'reftex-view-crossref "reftex-dcr"
- "View cross reference of \\ref or \\cite macro at point." t)
-(autoload 'reftex-mouse-view-crossref "reftex-dcr"
- "View cross reference of \\ref or \\cite macro where you click." t)
-(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr")
-(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr"
- "View location in a LaTeX document which cites the BibTeX entry at point." t)
-
-;; Operations on entire Multifile documents
-(autoload 'reftex-create-tags-file "reftex-global"
- "Create TAGS file by running `etags' on the current document." t)
-(autoload 'reftex-grep-document "reftex-global"
- "Run grep query through all files related to this document." t)
-(autoload 'reftex-search-document "reftex-global"
- "Regexp search through all files of the current TeX document." t)
-(autoload 'reftex-query-replace-document "reftex-global"
- "Run a query-replace-regexp of FROM with TO over the entire TeX document." t)
-(autoload 'reftex-find-duplicate-labels "reftex-global"
- "Produce a list of all duplicate labels in the document." t)
-(autoload 'reftex-change-label "reftex-global"
- "Query replace FROM with TO in all \\label and \\ref commands." t)
-(autoload 'reftex-renumber-simple-labels "reftex-global"
- "Renumber all simple labels in the document to make them sequentially." t)
-(autoload 'reftex-save-all-document-buffers "reftex-global"
- "Save all documents associated with the current document." t)
-
-;; AUCTeX Interface
-(autoload 'reftex-arg-label "reftex-auc")
-(autoload 'reftex-arg-cite "reftex-auc")
-(autoload 'reftex-arg-index-tag "reftex-auc")
-(autoload 'reftex-arg-index "reftex-auc")
-(autoload 'reftex-plug-into-AUCTeX "reftex-auc")
-(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc"
- "Toggle Interface between AUCTeX and RefTeX on and off." t)
-(autoload 'reftex-add-label-environments "reftex-auc")
-(autoload 'reftex-add-to-label-alist "reftex-auc")
-(autoload 'reftex-add-section-levels "reftex-auc")
-(autoload 'reftex-notice-new-section "reftex-auc")
-
;;; =========================================================================
;;;
@@ -219,17 +106,21 @@
(defvar reftex-syntax-table nil)
(defvar reftex-syntax-table-for-bib nil)
-(unless reftex-syntax-table
+(defun reftex--prepare-syntax-tables ()
(setq reftex-syntax-table (copy-syntax-table))
(modify-syntax-entry ?\( "." reftex-syntax-table)
- (modify-syntax-entry ?\) "." reftex-syntax-table))
+ (modify-syntax-entry ?\) "." reftex-syntax-table)
-(unless reftex-syntax-table-for-bib
(setq reftex-syntax-table-for-bib (copy-syntax-table))
(modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
(modify-syntax-entry ?\" "." reftex-syntax-table-for-bib)
(modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib))
+ (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib)
+ (modify-syntax-entry ?\( "." reftex-syntax-table-for-bib)
+ (modify-syntax-entry ?\) "." reftex-syntax-table-for-bib))
+
+(unless (and reftex-syntax-table reftex-syntax-table-for-bib)
+ (reftex--prepare-syntax-tables))
;; The following definitions are out of place, but I need them here
;; to make the compilation of reftex-mode not complain.
@@ -293,15 +184,7 @@ on the menu bar.
(put 'reftex-auto-recenter-toc 'initialized t))
;; Prepare the special syntax tables.
- (setq reftex-syntax-table (copy-syntax-table (syntax-table)))
- (modify-syntax-entry ?\( "." reftex-syntax-table)
- (modify-syntax-entry ?\) "." reftex-syntax-table)
-
- (setq reftex-syntax-table-for-bib (copy-syntax-table))
- (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib)
- (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib)
+ (reftex--prepare-syntax-tables)
(run-hooks 'reftex-mode-hook))
;; Mode was turned off
@@ -423,12 +306,28 @@ If the symbols for the current master file do not exist, they are created."
(let
((master
(cond
- ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism.
+ ;; Test if we're in a subfile using the subfiles document
+ ;; class, e.g., \documentclass[main.tex]{subfiles}. It's
+ ;; argument is the main file, however it's not really the
+ ;; master file in `TeX-master-file' or `tex-main-file's
+ ;; sense. It should be used for references but not for
+ ;; compilation, thus subfiles use a setting of
+ ;; `TeX-master'/`tex-main-file' being themselves.
+ ((save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ "^[[:space:]]*\\\\documentclass\\[\\([[:word:].]+\\)\\]{subfiles}"
+ nil t))
+ (match-string-no-properties 1))
+ ;; AUCTeX is loaded. Use its mechanism.
+ ((fboundp 'TeX-master-file)
(condition-case nil
(TeX-master-file t)
(error (buffer-file-name))))
- ((fboundp 'tex-main-file) (tex-main-file)) ; Emacs LaTeX mode
- ((boundp 'TeX-master) ; The variable is defined - let's use it.
+ ;; Emacs LaTeX mode
+ ((fboundp 'tex-main-file) (tex-main-file))
+ ;; Check the `TeX-master' variable.
+ ((boundp 'TeX-master)
(cond
((eq TeX-master t)
(buffer-file-name))
@@ -439,6 +338,7 @@ If the symbols for the current master file do not exist, they are created."
(t
(setq TeX-master (read-file-name "Master file: "
nil nil t nil)))))
+ ;; Check the `tex-main-file' variable.
((boundp 'tex-main-file)
;; This is the variable from the default TeX modes.
(cond
@@ -448,8 +348,9 @@ If the symbols for the current master file do not exist, they are created."
(t
;; In this case, the buffer is its own master.
(buffer-file-name))))
+ ;; We know nothing about master file. Assume this is a
+ ;; master file.
(t
- ;; Know nothing about master file. Assume this is a master file.
(buffer-file-name)))))
(cond
((null master)
@@ -1822,7 +1723,7 @@ When DIE is non-nil, throw an error if file not found."
(defvar message-stack)
(if (and (featurep 'xemacs)
(not (fboundp 'current-message)))
- (defun current-message (&optional frame)
+ (defun current-message (&optional _frame)
(cdr (car message-stack))))
(defun reftex-visited-files (list)
@@ -2164,7 +2065,7 @@ IGNORE-WORDS List of words which should be removed from the string."
(message "Sorry: cannot refontify RefTeX Select buffer."))))
(rename-buffer oldname))))
-(defun reftex-select-font-lock-fontify-region (beg end &optional loudly)
+(defun reftex-select-font-lock-fontify-region (beg end &optional _loudly)
;; Fontify a region, but only lines starting with a dot.
(let ((func (if (fboundp 'font-lock-default-fontify-region)
'font-lock-default-fontify-region
@@ -2176,7 +2077,7 @@ IGNORE-WORDS List of words which should be removed from the string."
(funcall func beg1 end1 nil)
(goto-char end1))))
-(defun reftex-select-font-lock-unfontify (&rest ignore) t)
+(defun reftex-select-font-lock-unfontify (&rest _ignore) t)
(defun reftex-verified-face (&rest faces)
;; Return the first valid face in FACES, or nil if none is valid.
@@ -2458,6 +2359,7 @@ output buffer into your mail program, as it gives us important
information about your RefTeX version and configuration."
(interactive)
(require 'reporter)
+ (defvar reporter-prompt-for-summary-p)
(let ((reporter-prompt-for-summary-p "Bug report subject: "))
(reporter-submit-bug-report
"bug-auctex@gnu.org, bug-gnu-emacs@gnu.org"
@@ -2471,7 +2373,7 @@ what in fact did happen.
Check if the bug is reproducible with an up-to-date version of
RefTeX available from http://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.
@@ -2491,6 +2393,703 @@ Your bug report will be posted to the AUCTeX bug reporting list.
;;; That's it! ----------------------------------------------------------------
(setq reftex-tables-dirty t) ; in case this file is evaluated by hand
+
+
+;;; Start of automatically extracted autoloads.
+
+;;;### (autoloads nil "reftex-auc" "reftex-auc.el" "cf606f7918831321cb46f254436dc66e")
+;;; Generated autoloads from reftex-auc.el
+
+(autoload 'reftex-arg-label "reftex-auc" "\
+Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg.
+What is being used depends upon `reftex-plug-into-AUCTeX'.
+
+\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil)
+
+(autoload 'reftex-arg-cite "reftex-auc" "\
+Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument.
+What is being used depends upon `reftex-plug-into-AUCTeX'.
+
+\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil)
+
+(autoload 'reftex-arg-index-tag "reftex-auc" "\
+Prompt for an index tag with completion.
+This is the name of an index, not the entry.
+
+\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil)
+
+(autoload 'reftex-arg-index "reftex-auc" "\
+Prompt for an index entry completing with known entries.
+Completion is specific for just one index, if the macro or a tag
+argument identify one of multiple indices.
+
+\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil)
+
+(autoload 'reftex-plug-into-AUCTeX "reftex-auc" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" "\
+Toggle Interface between AUCTeX and RefTeX on and off.
+
+\(fn)" t nil)
+
+(autoload 'reftex-add-label-environments "reftex-auc" "\
+Add label environment descriptions to `reftex-label-alist-style'.
+The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there
+for details.
+This function makes it possible to support RefTeX from AUCTeX style files.
+The entries in ENTRY-LIST will be processed after the user settings in
+`reftex-label-alist', and before the defaults (specified in
+`reftex-default-label-alist-entries'). Any changes made to
+`reftex-label-alist-style' will raise a flag to the effect that
+the label information is recompiled on next use.
+
+\(fn ENTRY-LIST)" nil nil)
+
+(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments)
+
+(autoload 'reftex-add-section-levels "reftex-auc" "\
+Add entries to the value of `reftex-section-levels'.
+The added values are kept local to the current document. The format
+of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See
+`reftex-section-levels' for an example.
+
+\(fn ENTRY-LIST)" nil nil)
+
+(autoload 'reftex-notice-new-section "reftex-auc" "\
+
+
+\(fn)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-cite" "reftex-cite.el" "7eaa61c05a6578999ea68f1be0fbcf49")
+;;; Generated autoloads from reftex-cite.el
+
+(autoload 'reftex-default-bibliography "reftex-cite" "\
+Return the expanded value of variable `reftex-default-bibliography'.
+The expanded value is cached.
+
+\(fn)" nil nil)
+
+(autoload 'reftex-bib-or-thebib "reftex-cite" "\
+Test if BibTeX or egin{thebibliography} should be used for the citation.
+Find the bof of the current file
+
+\(fn)" nil nil)
+
+(autoload 'reftex-get-bibfile-list "reftex-cite" "\
+Return list of bibfiles for current document.
+When using the chapterbib or bibunits package you should either
+use the same database files everywhere, or separate parts using
+different databases into different files (included into the mater file).
+Then this function will return the applicable database files.
+
+\(fn)" nil nil)
+
+(autoload 'reftex-pop-to-bibtex-entry "reftex-cite" "\
+Find BibTeX KEY in any file in FILE-LIST in another window.
+If MARK-TO-KILL is non-nil, mark new buffer to kill.
+If HIGHLIGHT is non-nil, highlight the match.
+If ITEM in non-nil, search for bibitem instead of database entry.
+If RETURN is non-nil, just return the entry and restore point.
+
+\(fn KEY FILE-LIST &optional MARK-TO-KILL HIGHLIGHT ITEM RETURN)" nil nil)
+
+(autoload 'reftex-end-of-bib-entry "reftex-cite" "\
+
+
+\(fn ITEM)" nil nil)
+
+(autoload 'reftex-parse-bibtex-entry "reftex-cite" "\
+Parse BibTeX ENTRY.
+If ENTRY is nil then parse the entry in current buffer between FROM and TO.
+If RAW is non-nil, keep double quotes/curly braces delimiting fields.
+
+\(fn ENTRY &optional FROM TO RAW)" nil nil)
+
+(autoload 'reftex-citation "reftex-cite" "\
+Make a citation using BibTeX database files.
+After prompting for a regular expression, scans the buffers with
+bibtex entries (taken from the \\bibliography command) and offers the
+matching entries for selection. The selected entry is formatted according
+to `reftex-cite-format' and inserted into the buffer.
+
+If NO-INSERT is non-nil, nothing is inserted, only the selected key returned.
+
+FORMAT-KEY can be used to pre-select a citation format.
+
+When called with a `C-u' prefix, prompt for optional arguments in
+cite macros. When called with a numeric prefix, make that many
+citations. When called with point inside the braces of a `\\cite'
+command, it will add another key, ignoring the value of
+`reftex-cite-format'.
+
+The regular expression uses an expanded syntax: && is interpreted as `and'.
+Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
+While entering the regexp, completion on knows citation keys is possible.
+`=' is a good regular expression to match all entries in all files.
+
+\(fn &optional NO-INSERT FORMAT-KEY)" t nil)
+
+(autoload 'reftex-citep "reftex-cite" "\
+Call `reftex-citation' with a format selector `?p'.
+
+\(fn)" t nil)
+
+(autoload 'reftex-citet "reftex-cite" "\
+Call `reftex-citation' with a format selector `?t'.
+
+\(fn)" t nil)
+
+(autoload 'reftex-make-cite-echo-string "reftex-cite" "\
+Format a bibtex ENTRY for the echo area and cache the result.
+
+\(fn ENTRY DOCSTRUCT-SYMBOL)" nil nil)
+
+(autoload 'reftex-create-bibtex-file "reftex-cite" "\
+Create a new BibTeX database BIBFILE with all entries referenced in document.
+The command prompts for a filename and writes the collected
+entries to that file. Only entries referenced in the current
+document with any \\cite-like macros are used. The sequence in
+the new file is the same as it was in the old database.
+
+Entries referenced from other entries must appear after all
+referencing entries.
+
+You can define strings to be used as header or footer for the
+created files in the variables `reftex-create-bibtex-header' or
+`reftex-create-bibtex-footer' respectively.
+
+\(fn BIBFILE)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-dcr" "reftex-dcr.el" "08fc5bd6c35f9d6ab4a6ad336d3769c0")
+;;; Generated autoloads from reftex-dcr.el
+
+(autoload 'reftex-view-crossref "reftex-dcr" "\
+View cross reference of macro at point. Point must be on the KEY
+argument. When at a `\\ref' macro, show corresponding `\\label'
+definition, also in external documents (`xr'). When on a label, show
+a locations where KEY is referenced. Subsequent calls find additional
+locations. When on a `\\cite', show the associated `\\bibitem' macro or
+the BibTeX database entry. When on a `\\bibitem', show a `\\cite' macro
+which uses this KEY. When on an `\\index', show other locations marked
+by the same index entry.
+To define additional cross referencing items, use the option
+`reftex-view-crossref-extra'. See also `reftex-view-crossref-from-bibtex'.
+With one or two C-u prefixes, enforce rescanning of the document.
+With argument 2, select the window showing the cross reference.
+AUTO-HOW is only for the automatic crossref display and is handed through
+to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'.
+
+\(fn &optional ARG AUTO-HOW FAIL-QUIETLY)" t nil)
+
+(autoload 'reftex-mouse-view-crossref "reftex-dcr" "\
+View cross reference of \\ref or \\cite macro where you click.
+If the macro at point is a \\ref, show the corresponding label definition.
+If it is a \\cite, show the BibTeX database entry.
+If there is no such macro at point, search forward to find one.
+With argument, actually select the window showing the cross reference.
+
+\(fn EV)" t nil)
+
+(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr" "\
+Toggle the automatic display of crossref information in the echo area.
+When active, leaving point idle in the argument of a \\ref or \\cite macro
+will display info in the echo area.
+
+\(fn)" t nil)
+
+(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "\
+View location in a LaTeX document which cites the BibTeX entry at point.
+Since BibTeX files can be used by many LaTeX documents, this function
+prompts upon first use for a buffer in RefTeX mode. To reset this
+link to a document, call the function with a prefix arg.
+Calling this function several times find successive citation locations.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-global" "reftex-global.el" "5fdd9c2edced0882471f86baf4b4b234")
+;;; Generated autoloads from reftex-global.el
+
+(autoload 'reftex-create-tags-file "reftex-global" "\
+Create TAGS file by running `etags' on the current document.
+The TAGS file is also immediately visited with `visit-tags-table'.
+
+\(fn)" t nil)
+
+(autoload 'reftex-grep-document "reftex-global" "\
+Run grep query through all files related to this document.
+With prefix arg, force to rescan document.
+No active TAGS table is required.
+
+\(fn GREP-CMD)" t nil)
+
+(autoload 'reftex-search-document "reftex-global" "\
+Regexp search through all files of the current document.
+Starts always in the master file. Stops when a match is found.
+To continue searching for next match, use command \\[tags-loop-continue].
+No active TAGS table is required.
+
+\(fn &optional REGEXP)" t nil)
+
+(autoload 'reftex-query-replace-document "reftex-global" "\
+Do `query-replace-regexp' of FROM with TO over the entire document.
+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].
+No active TAGS table is required.
+
+\(fn &optional FROM TO DELIMITED)" t nil)
+
+(autoload 'reftex-find-duplicate-labels "reftex-global" "\
+Produce a list of all duplicate labels in the document.
+
+\(fn)" t nil)
+
+(autoload 'reftex-change-label "reftex-global" "\
+Run `query-replace-regexp' of FROM with TO in all macro arguments.
+Works on the entire multifile document.
+If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
+with the command \\[tags-loop-continue].
+No active TAGS table is required.
+
+\(fn &optional FROM TO)" t nil)
+
+(autoload 'reftex-renumber-simple-labels "reftex-global" "\
+Renumber all simple labels in the document to make them sequentially.
+Simple labels are the ones created by RefTeX, consisting only of the
+prefix and a number. After the command completes, all these labels will
+have sequential numbers throughout the document. Any references to
+the labels will be changed as well. For this, RefTeX looks at the
+arguments of any macros which either start or end in the string `ref'.
+This command should be used with care, in particular in multifile
+documents. You should not use it if another document refers to this
+one with the `xr' package.
+
+\(fn)" t nil)
+
+(autoload 'reftex-save-all-document-buffers "reftex-global" "\
+Save all documents associated with the current document.
+The function is useful after a global action like replacing or renumbering
+labels.
+
+\(fn)" t nil)
+
+(autoload 'reftex-isearch-minor-mode "reftex-global" "\
+When on, isearch searches the whole document, not only the current file.
+This minor mode allows isearch to search through all the files of
+the current TeX document.
+
+With no argument, this command toggles
+`reftex-isearch-minor-mode'. With a prefix argument ARG, turn
+`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-index" "reftex-index.el" "29cb6e91c2e06592053e9d543f30f0ea")
+;;; Generated autoloads from reftex-index.el
+
+(autoload 'reftex-index-selection-or-word "reftex-index" "\
+Put selection or the word near point into the default index macro.
+This uses the information in `reftex-index-default-macro' to make an index
+entry. The phrase indexed is the current selection or the word near point.
+When called with one `C-u' prefix, let the user have a chance to edit the
+index entry. When called with 2 `C-u' as prefix, also ask for the index
+macro and other stuff.
+When called inside TeX math mode as determined by the `texmathp.el' library
+which is part of AUCTeX, the string is first processed with the
+`reftex-index-math-format', which see.
+
+\(fn &optional ARG PHRASE)" t nil)
+
+(autoload 'reftex-index "reftex-index" "\
+Query for an index macro and insert it along with its arguments.
+The index macros available are those defined in `reftex-index-macro' or
+by a call to `reftex-add-index-macros', typically from an AUCTeX style file.
+RefteX provides completion for the index tag and the index key, and
+will prompt for other arguments.
+
+\(fn &optional CHAR KEY TAG SEL NO-INSERT)" t nil)
+
+(autoload 'reftex-index-complete-tag "reftex-index" "\
+
+
+\(fn &optional ITAG OPT-ARGS)" nil nil)
+
+(autoload 'reftex-index-select-tag "reftex-index" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'reftex-index-complete-key "reftex-index" "\
+
+
+\(fn &optional TAG OPTIONAL INITIAL)" nil nil)
+
+(autoload 'reftex-index-show-entry "reftex-index" "\
+
+
+\(fn DATA &optional NO-REVISIT)" nil nil)
+
+(autoload 'reftex-display-index "reftex-index" "\
+Display a buffer with an index compiled from the current document.
+When the document has multiple indices, first prompts for the correct one.
+When index support is turned off, offer to turn it on.
+With one or two `C-u' prefixes, rescan document first.
+With prefix 2, restrict index to current document section.
+With prefix 3, restrict index to region.
+
+\(fn &optional TAG OVERRIDING-RESTRICTION REDO &rest LOCATIONS)" t nil)
+
+(autoload 'reftex-index-phrase-selection-or-word "reftex-index" "\
+Add current selection or word at point to the phrases buffer.
+When you are in transient-mark-mode and the region is active, the
+selection will be used - otherwise the word at point.
+You get a chance to edit the entry in the phrases buffer - finish with
+`C-c C-c'.
+
+\(fn ARG)" t nil)
+
+(autoload 'reftex-index-visit-phrases-buffer "reftex-index" "\
+Switch to the phrases buffer, initialize if empty.
+
+\(fn)" t nil)
+
+(autoload 'reftex-index-phrases-mode "reftex-index" "\
+Major mode for managing the Index phrases of a LaTeX document.
+This buffer was created with RefTeX.
+
+To insert new phrases, use
+ - `C-c \\' in the LaTeX document to copy selection or word
+ - `\\[reftex-index-new-phrase]' in the phrases buffer.
+
+To index phrases use one of:
+
+\\[reftex-index-this-phrase] index current phrase
+\\[reftex-index-next-phrase] index next phrase (or N with prefix arg)
+\\[reftex-index-all-phrases] index all phrases
+\\[reftex-index-remaining-phrases] index current and following phrases
+\\[reftex-index-region-phrases] index the phrases in the region
+
+You can sort the phrases in this buffer with \\[reftex-index-sort-phrases].
+To display information about the phrase at point, use \\[reftex-index-phrases-info].
+
+For more information see the RefTeX User Manual.
+
+Here are all local bindings.
+
+\\{reftex-index-phrases-mode-map}
+
+\(fn)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "7bfdcb2f040dbe9a08d2c38c005c8f21")
+;;; Generated autoloads from reftex-parse.el
+
+(autoload 'reftex-parse-one "reftex-parse" "\
+Re-parse this file.
+
+\(fn)" t nil)
+
+(autoload 'reftex-parse-all "reftex-parse" "\
+Re-parse entire document.
+
+\(fn)" t nil)
+
+(autoload 'reftex-do-parse "reftex-parse" "\
+Do a document rescan.
+When allowed, do only a partial scan from FILE.
+
+\(fn RESCAN &optional FILE)" nil nil)
+
+(autoload 'reftex-everything-regexp "reftex-parse" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'reftex-all-document-files "reftex-parse" "\
+Return a list of all files belonging to the current document.
+When RELATIVE is non-nil, give file names relative to directory
+of master file.
+
+\(fn &optional RELATIVE)" nil nil)
+
+(autoload 'reftex-locate-bibliography-files "reftex-parse" "\
+Scan buffer for bibliography macros and return file list.
+
+\(fn MASTER-DIR &optional FILES)" nil nil)
+
+(autoload 'reftex-section-info "reftex-parse" "\
+Return a section entry for the current match.
+Careful: This function expects the match-data to be still in place!
+
+\(fn FILE)" nil nil)
+
+(autoload 'reftex-ensure-index-support "reftex-parse" "\
+When index support is turned off, ask to turn it on and
+set the current prefix argument so that `reftex-access-scan-info'
+will rescan the entire document.
+
+\(fn &optional ABORT)" nil nil)
+
+(autoload 'reftex-index-info-safe "reftex-parse" "\
+
+
+\(fn FILE)" nil nil)
+
+(autoload 'reftex-index-info "reftex-parse" "\
+Return an index entry for the current match.
+Careful: This function expects the match-data to be still in place!
+
+\(fn FILE)" nil nil)
+
+(autoload 'reftex-short-context "reftex-parse" "\
+Get about one line of useful context for the label definition at point.
+
+\(fn ENV PARSE &optional BOUND DERIVE)" nil nil)
+
+(autoload 'reftex-where-am-I "reftex-parse" "\
+Return the docstruct entry above point.
+Actually returns a cons cell in which the cdr is a flag indicating
+if the information is exact (t) or approximate (nil).
+
+\(fn)" nil nil)
+
+(autoload 'reftex-notice-new "reftex-parse" "\
+Hook to handshake with RefTeX after something new has been inserted.
+
+\(fn &optional N FORCE)" nil nil)
+
+(autoload 'reftex-what-macro-safe "reftex-parse" "\
+Call `reftex-what-macro' with special syntax table.
+
+\(fn WHICH &optional BOUND)" nil nil)
+
+(autoload 'reftex-what-macro "reftex-parse" "\
+Find out if point is within the arguments of any TeX-macro.
+The return value is either (\"\\macro\" . (point)) or a list of them.
+
+If WHICH is nil, immediately return nil.
+If WHICH is 1, return innermost enclosing macro.
+If WHICH is t, return list of all macros enclosing point.
+If WHICH is a list of macros, look only for those macros and return the
+ name of the first macro in this list found to enclose point.
+If the optional BOUND is an integer, bound backwards directed
+ searches to this point. If it is nil, limit to nearest \\section -
+ like statement.
+
+This function is pretty stable, but can be fooled if the text contains
+things like \\macro{aa}{bb} where \\macro is defined to take only one
+argument. As RefTeX cannot know this, the string \"bb\" would still be
+considered an argument of macro \\macro.
+
+\(fn WHICH &optional BOUND)" nil nil)
+
+(autoload 'reftex-what-environment "reftex-parse" "\
+Find out if point is inside a LaTeX environment.
+The return value is (e.g.) either (\"equation\" . (point)) or a list of
+them.
+
+If WHICH is nil, immediately return nil.
+If WHICH is 1, return innermost enclosing environment.
+If WHICH is t, return list of all environments enclosing point.
+If WHICH is a list of environments, look only for those environments and
+ return the name of the first environment in this list found to enclose
+ point.
+
+If the optional BOUND is an integer, bound backwards directed searches to
+this point. If it is nil, limit to nearest \\section - like statement.
+
+\(fn WHICH &optional BOUND)" nil nil)
+
+(autoload 'reftex-what-special-env "reftex-parse" "\
+Run the special environment parsers and return the matches.
+
+The return value is (e.g.) either (\"my-parser-function\" . (point))
+or a list of them.
+
+If WHICH is nil, immediately return nil.
+If WHICH is 1, return innermost enclosing environment.
+If WHICH is t, return list of all environments enclosing point.
+If WHICH is a list of environments, look only for those environments and
+ return the name of the first environment in this list found to enclose
+ point.
+
+\(fn WHICH &optional BOUND)" nil nil)
+
+(autoload 'reftex-nth-arg "reftex-parse" "\
+Return the Nth following {} or [] parentheses content.
+OPT-ARGS is a list of argument numbers which are optional.
+
+\(fn N &optional OPT-ARGS)" nil nil)
+
+(autoload 'reftex-move-over-touching-args "reftex-parse" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'reftex-init-section-numbers "reftex-parse" "\
+Initialize the section numbers with zeros or with what is found in the TOC-ENTRY.
+
+\(fn &optional TOC-ENTRY APPENDIX)" nil nil)
+
+(autoload 'reftex-section-number "reftex-parse" "\
+Return a string with the current section number.
+When LEVEL is non-nil, increase section numbers on that level.
+
+\(fn &optional LEVEL STAR)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-ref" "reftex-ref.el" "86c0a243e49d55bb33a32ddac613e189")
+;;; Generated autoloads from reftex-ref.el
+
+(autoload 'reftex-label-location "reftex-ref" "\
+Return the environment or macro which determines the label type at point.
+If optional BOUND is an integer, limit backward searches to that point.
+
+\(fn &optional BOUND)" nil nil)
+
+(autoload 'reftex-label-info-update "reftex-ref" "\
+
+
+\(fn CELL)" nil nil)
+
+(autoload 'reftex-label-info "reftex-ref" "\
+
+
+\(fn LABEL &optional FILE BOUND DERIVE ENV-OR-MAC)" nil nil)
+
+(autoload 'reftex-label "reftex-ref" "\
+Insert a unique label. Return the label.
+If ENVIRONMENT is given, don't bother to find out yourself.
+If NO-INSERT is non-nil, do not insert label into buffer.
+With prefix arg, force to rescan document first.
+When you are prompted to enter or confirm a label, and you reply with
+just the prefix or an empty string, no label at all will be inserted.
+A new label is also recorded into the label list.
+This function is controlled by the settings of reftex-insert-label-flags.
+
+\(fn &optional ENVIRONMENT NO-INSERT)" t nil)
+
+(autoload 'reftex-reference "reftex-ref" "\
+Make a LaTeX reference. Look only for labels of a certain TYPE.
+With prefix arg, force to rescan buffer for labels. This should only be
+necessary if you have recently entered labels yourself without using
+reftex-label. Rescanning of the buffer can also be requested from the
+label selection menu.
+The function returns the selected label or nil.
+If NO-INSERT is non-nil, do not insert \\ref command, just return label.
+When called with 2 C-u prefix args, disable magic word recognition.
+
+\(fn &optional TYPE NO-INSERT CUT)" t nil)
+
+(autoload 'reftex-query-label-type "reftex-ref" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'reftex-show-label-location "reftex-ref" "\
+
+
+\(fn DATA FORWARD NO-REVISIT &optional STAY ERROR)" nil nil)
+
+(autoload 'reftex-goto-label "reftex-ref" "\
+Prompt for a label (with completion) and jump to the location of this label.
+Optional prefix argument OTHER-WINDOW goes to the label in another window.
+
+\(fn &optional OTHER-WINDOW)" t nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-sel" "reftex-sel.el" "faea36cbe37033efd3f9063187eef7ee")
+;;; Generated autoloads from reftex-sel.el
+
+(autoload 'reftex-select-label-mode "reftex-sel" "\
+Major mode for selecting a label in a LaTeX document.
+This buffer was created with RefTeX.
+It only has a meaningful keymap when you are in the middle of a
+selection process.
+To select a label, move the cursor to it and press RET.
+Press `?' for a summary of important key bindings.
+
+During a selection process, these are the local bindings.
+
+\\{reftex-select-label-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'reftex-select-bib-mode "reftex-sel" "\
+Major mode for selecting a citation key in a LaTeX document.
+This buffer was created with RefTeX.
+It only has a meaningful keymap when you are in the middle of a
+selection process.
+In order to select a citation, move the cursor to it and press RET.
+Press `?' for a summary of important key bindings.
+
+During a selection process, these are the local bindings.
+
+\\{reftex-select-label-mode-map}
+
+\(fn)" t nil)
+
+(autoload 'reftex-get-offset "reftex-sel" "\
+
+
+\(fn BUF HERE-AM-I &optional TYPEKEY TOC INDEX FILE)" nil nil)
+
+(autoload 'reftex-insert-docstruct "reftex-sel" "\
+
+
+\(fn BUF TOC LABELS INDEX-ENTRIES FILES CONTEXT COUNTER SHOW-COMMENTED HERE-I-AM XR-PREFIX TOC-BUFFER)" nil nil)
+
+(autoload 'reftex-find-start-point "reftex-sel" "\
+
+
+\(fn FALLBACK &rest LOCATIONS)" nil nil)
+
+(autoload 'reftex-select-item "reftex-sel" "\
+
+
+\(fn REFTEX-SELECT-PROMPT HELP-STRING KEYMAP &optional OFFSET CALL-BACK CB-FLAG)" nil nil)
+
+;;;***
+
+;;;### (autoloads nil "reftex-toc" "reftex-toc.el" "db9b727d89e2a6ff01986e7c6aff1058")
+;;; Generated autoloads from reftex-toc.el
+
+(autoload 'reftex-toc "reftex-toc" "\
+Show the table of contents for the current document.
+When called with a raw C-u prefix, rescan the document first.
+
+\(fn &optional REBUILD REUSE)" t nil)
+
+(autoload 'reftex-toc-recenter "reftex-toc" "\
+Display the TOC window and highlight line corresponding to current position.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "\
+Toggle the automatic recentering of the TOC window.
+When active, leaving point idle will make the TOC window jump to the correct
+section.
+
+\(fn)" t nil)
+
+;;;***
+
+;;; End of automatically extracted autoloads.
+
(provide 'reftex)
;;; reftex.el ends here
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 39f3acd2c4c..35eaffa9284 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,8 +1,9 @@
;;; remember --- a mode for quickly jotting down things to remember
-;; Copyright (C) 1999-2001, 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2001, 2003-2015 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1999
;; Version: 2.0
;; Keywords: data memory todo pim
@@ -118,7 +119,7 @@
;;
;; * Using "remember"
;;
-;; As a rough beginning, what I do is to keep my .notes file in
+;; As a rough beginning, what I do is to keep my `remember-data-file' in
;; outline-mode format, with a final entry called "* Raw data". Then,
;; at intervals, I can move the data that gets appended there into
;; other places. But certainly this should evolve into an intuitive
@@ -178,8 +179,6 @@
;;; Code:
-(provide 'remember)
-
(defconst remember-version "2.0"
"This version of remember.")
@@ -230,6 +229,8 @@ recorded somewhere by that function."
:type 'boolean
:group 'remember)
+;; See below for more user variables.
+
;;; Internal Variables:
(defvar remember-buffer "*Remember*"
@@ -276,7 +277,7 @@ With a prefix or a visible region, use the region as INITIAL."
transient-mark-mode))
(buffer-substring (region-beginning) (region-end)))))
(funcall (if remember-in-new-frame
- #'frame-configuration-to-register
+ #'frameset-to-register
#'window-configuration-to-register) remember-register)
(let* ((annotation
(if remember-run-all-annotation-functions-flag
@@ -294,6 +295,7 @@ With a prefix or a visible region, use the region as INITIAL."
(if remember-in-new-frame
(set-window-dedicated-p
(get-buffer-window (current-buffer) (selected-frame)) t))
+ (setq buffer-offer-save t)
(remember-mode)
(when (= (point-max) (point-min))
(when initial (insert initial))
@@ -317,9 +319,7 @@ With a prefix or a visible region, use the region as INITIAL."
(defsubst remember-mail-date (&optional rfc822-p)
"Return a simple date. Nothing fancy."
- (if rfc822-p
- (format-time-string "%a, %e %b %Y %T %z" (current-time))
- (format-time-string "%a %b %e %T %Y" (current-time))))
+ (format-time-string (if rfc822-p "%a, %e %b %Y %T %z" "%a %b %e %T %Y")))
(defun remember-buffer-desc ()
"Using the first line of the current buffer, create a short description."
@@ -385,6 +385,7 @@ Subject: %s\n\n"
"The file in which to store unprocessed data.
When set via customize, visited file of the notes buffer (if it
exists) might be changed."
+ :version "24.4" ; added locate-user-emacs-file
:type 'file
:set (lambda (symbol value)
(let ((buf (find-buffer-visiting (default-value symbol))))
@@ -440,23 +441,25 @@ If you want to remember a region, supply a universal prefix to
(remember-destroy))))
(defcustom remember-data-directory "~/remember"
- "The directory in which to store remember data as files."
+ "The directory in which to store remember data as files.
+Used by `remember-store-in-files'."
:type 'directory
:version "24.4"
:group 'remember)
(defcustom remember-directory-file-name-format "%Y-%m-%d_%T-%z"
- "Format string for the file name in which to store unprocessed data."
+ "Format string for the file name in which to store unprocessed data.
+This is passed to `format-time-string'.
+Used by `remember-store-in-files'."
:type 'string
:version "24.4"
:group 'remember)
(defun remember-store-in-files ()
"Store remember data in a file in `remember-data-directory'.
-The file is named after `remember-directory-file-name-format' fed through
-`format-time-string'."
- (let ((name (format-time-string
- remember-directory-file-name-format (current-time)))
+The file is named by calling `format-time-string' using
+`remember-directory-file-name-format' as the format string."
+ (let ((name (format-time-string remember-directory-file-name-format))
(text (buffer-string)))
(with-temp-buffer
(insert text)
@@ -493,6 +496,8 @@ If this is nil, then `diary-file' will be used instead."
:type '(choice (const :tag "diary-file" nil) file)
:group 'remember)
+(defvar calendar-date-style) ; calendar.el
+
(defun remember-diary-convert-entry (entry)
"Translate MSG to an entry readable by diary."
(save-match-data
@@ -505,23 +510,17 @@ If this is nil, then `diary-file' will be used instead."
;; which requires calendar.
(require 'calendar)
(replace-match
- (let ((style (if (boundp 'calendar-date-style)
- calendar-date-style
- ;; Don't complain about obsolescence.
- (if (with-no-warnings european-calendar-style)
- 'european
- 'american))))
- (cond ((eq style 'european)
- (concat (match-string 3 entry) "/"
- (match-string 2 entry) "/"
- (match-string 1 entry)))
- ((eq style 'iso)
- (concat (match-string 1 entry) "-"
+ (cond ((eq calendar-date-style 'european)
+ (concat (match-string 3 entry) "/"
+ (match-string 2 entry) "/"
+ (match-string 1 entry)))
+ ((eq calendar-date-style 'iso)
+ (concat (match-string 1 entry) "-"
(match-string 2 entry) "-"
(match-string 3 entry)))
- (t (concat (match-string 2 entry) "/"
- (match-string 3 entry) "/"
- (match-string 1 entry)))))
+ (t (concat (match-string 2 entry) "/"
+ (match-string 3 entry) "/"
+ (match-string 1 entry))))
t t entry))
entry)))
@@ -534,7 +533,7 @@ If this is nil, then `diary-file' will be used instead."
(goto-char (point-min))
(let (list)
(while (re-search-forward "^DIARY:\\s-*\\(.+\\)" nil t)
- (add-to-list 'list (remember-diary-convert-entry (match-string 1))))
+ (push (remember-diary-convert-entry (match-string 1)) list))
(when list
(diary-make-entry (mapconcat 'identity list "\n")
nil remember-diary-file))
@@ -548,7 +547,7 @@ If this is nil, then `diary-file' will be used instead."
(define-key map "\C-c\C-c" 'remember-finalize)
(define-key map "\C-c\C-k" 'remember-destroy)
map)
- "Keymap used in Remember mode.")
+ "Keymap used in `remember-mode'.")
(define-derived-mode remember-mode indented-text-mode "Remember"
"Major mode for output from \\[remember].
@@ -570,20 +569,19 @@ purpose of storing notes."
:version "24.4")
(defcustom remember-notes-initial-major-mode nil
- "Major mode to set to notes buffer when it's created.
-If set to nil will use the same mode as `initial-major-mode'."
- :type '(choice (const :tag "Same as `initial-major-mode'" nil)
+ "Major mode to use in the notes buffer when it's created.
+If this is nil, use `initial-major-mode'."
+ :type '(choice (const :tag "Use `initial-major-mode'" nil)
(function :tag "Major mode" text-mode))
:version "24.4")
(defcustom remember-notes-bury-on-kill t
- "Whether to bury notes buffer instead of killing."
+ "Non-nil means `kill-buffer' will bury the notes buffer instead of killing."
:type 'boolean
:version "24.4")
(defun remember-notes-save-and-bury-buffer ()
- "Saves and buries current buffer.
-Buffer is saved only if `buffer-modified-p' returns non-nil."
+ "Save (if it is modified) and bury the current buffer."
(interactive)
(when (buffer-modified-p)
(save-buffer))
@@ -595,10 +593,14 @@ Buffer is saved only if `buffer-modified-p' returns non-nil."
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'remember-notes-save-and-bury-buffer)
map)
- "Keymap used in remember-notes mode.")
+ "Keymap used in `remember-notes-mode'.")
(define-minor-mode remember-notes-mode
- "Minor mode for the `remember-notes' buffer."
+ "Minor mode for the `remember-notes' buffer.
+This sets `buffer-save-without-query' so that `save-some-buffers' will
+save the notes buffer without asking.
+
+\\{remember-notes-mode-map}"
nil nil nil
(cond
(remember-notes-mode
@@ -608,29 +610,25 @@ Buffer is saved only if `buffer-modified-p' returns non-nil."
;;;###autoload
(defun remember-notes (&optional switch-to)
- "Creates notes buffer and switches to it if called interactively.
-
-If a notes buffer created by a previous invocation of this
-function already exist, it will be returned. Otherwise a new
-buffer will be created whose content will be read from file
-pointed by `remember-data-file'. If a buffer visiting this file
-already exist, that buffer will be used instead of creating a new
-one (see `find-file-noselect' function for more details).
-
-Name of the created buffer is taken from `remember-notes-buffer-name'
-variable and if a buffer with that name already exist (but was not
-created by this function), it will be first killed.
-\\<remember-notes-mode-map>
-`remember-notes-mode' is active in the notes buffer which by default
-contains only one \\[save-and-bury-buffer] binding which saves and
-buries the buffer.
-
-Function returns notes buffer. When called interactively,
-switches to it as well.
-
-Notes buffer is meant for keeping random notes which you'd like to
-preserve across Emacs restarts. The notes will be stored in the
-`remember-data-file'."
+ "Return the notes buffer, creating it if needed, and maybe switch to it.
+This buffer is for notes that you want to preserve across Emacs sessions.
+The notes are saved in `remember-data-file'.
+
+If a buffer is already visiting that file, just return it.
+
+Otherwise, create the buffer, and rename it to `remember-notes-buffer-name',
+unless a buffer of that name already exists. Set the major mode according
+to `remember-notes-initial-major-mode', and enable `remember-notes-mode'
+minor mode.
+
+Use \\<remember-notes-mode-map>\\[remember-notes-save-and-bury-buffer] to save and bury the notes buffer.
+
+Interactively, or if SWITCH-TO is non-nil, switch to the buffer.
+Return the buffer.
+
+Set `initial-buffer-choice' to `remember-notes' to visit your notes buffer
+when Emacs starts. Set `remember-notes-buffer-name' to \"*scratch*\"
+to turn the *scratch* buffer into your notes buffer."
(interactive "p")
(let ((buf (or (find-buffer-visiting remember-data-file)
(with-current-buffer (find-file-noselect remember-data-file)
@@ -646,10 +644,18 @@ preserve across Emacs restarts. The notes will be stored in the
buf))
(defun remember-notes--kill-buffer-query ()
+ "Function that `remember-notes-mode' adds to `kill-buffer-query-functions'.
+Save the current buffer if modified. If `remember-notes-bury-on-kill'
+is non-nil, bury it and return nil; otherwise return t."
(when (buffer-modified-p)
(save-buffer))
(if remember-notes-bury-on-kill
- (bury-buffer)
+ (progn
+ ;; bury-buffer always returns nil, but let's be explicit.
+ (bury-buffer)
+ nil)
t))
+(provide 'remember)
+
;;; remember.el ends here
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index a841ec39314..7b2aabd7ea5 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1,6 +1,6 @@
;;; rst.el --- Mode for viewing and editing reStructuredText-documents.
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Maintainer: Stefan Merten <smerten@oekonux.de>
;; Author: Stefan Merten <smerten@oekonux.de>,
@@ -218,7 +218,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use CVSHeader to really get information from CVS and not other version
;; control systems.
(defconst rst-cvs-header
- "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.6 2012-10-07 13:05:50 stefan Exp $")
+ "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.26 2015/10/04 09:26:04 stefan Exp $")
(defconst rst-cvs-rev
(rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
" .*" rst-cvs-header "0.0")
@@ -232,22 +232,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use LastChanged... to really get information from SVN.
(defconst rst-svn-rev
(rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
- "$LastChangedRevision: 7515 $")
+ "$LastChangedRevision: 7925 $")
"The SVN revision of this file.
SVN revision is the upstream (docutils) revision.")
(defconst rst-svn-timestamp
(rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
- "$LastChangedDate: 2012-09-20 23:28:53 +0200 (Thu, 20 Sep 2012) $")
+ "$LastChangedDate: 2015-10-04 11:21:35 +0200 (Sun, 04 Oct 2015) $")
"The SVN time stamp of this file.")
;; Maintained by the release process.
(defconst rst-official-version
(rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%OfficialVersion: 1.4.0 %")
+ "%OfficialVersion: 1.4.1 %")
"Official version of the package.")
(defconst rst-official-cvs-rev
(rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%Revision: 1.327 %")
+ "%Revision: 1.327.2.25 %")
"CVS revision of this file in the official version.")
(defconst rst-version
@@ -267,6 +267,7 @@ in parentheses follows the development revision and the time stamp.")
("1.3.0" . "24.3")
("1.3.1" . "24.3")
("1.4.0" . "24.3")
+ ("1.4.1" . "24.5")
))
(unless (assoc rst-official-version rst-package-emacs-version-alist)
@@ -296,7 +297,7 @@ in parentheses follows the development revision and the time stamp.")
;; syntax.
(defconst rst-bullets
;; Sorted so they can form a character class when concatenated.
- '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043)
+ '(?- ?* ?+ ?• ?‣ ?⁃)
"List of all possible bullet characters for bulleted lists.")
(defconst rst-uri-schemes
@@ -392,8 +393,8 @@ in parentheses follows the development revision and the time stamp.")
; item tag.
;; Inline markup (`ilm')
- (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]"))
- (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]"))
+ (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]"))
+ (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]"))
;; Inline markup content (`ilc')
(ilcsgl-tag "\\S ") ; A single non-white character.
@@ -442,7 +443,7 @@ in parentheses follows the development revision and the time stamp.")
(opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option.
;; Footnotes and citations (`fnc')
- (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name.
+ (fncnam-prt "[^]\n]") ; Part of a footnote or citation name.
(fncnam-tag fncnam-prt "+") ; A footnote or citation name.
(fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag.
(fncdef-tag-2 (:grp exm-sta)
@@ -512,7 +513,7 @@ in parentheses follows the development revision and the time stamp.")
; colon tag.
;; Comments (`cmt')
- (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]"
+ (cmt-sta-1 (:grp exm-sta) "[^[|_\n]"
(:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
"*$") ; Start of a comment block; first group is explicit markup
; start.
@@ -528,7 +529,7 @@ argument list for `rst-re'.")
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
-;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel.
+;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel.
(rst-testcover-add-compose 'rst-re)
;; testcover: ok.
(defun rst-re (&rest args)
@@ -608,20 +609,31 @@ After interpretation of ARGS the results are concatenated as for
(defun rst-define-key (keymap key def &rest deprecated)
"Bind like `define-key' but add deprecated key definitions.
KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key
-definitions should be in vector notation. These are defined as
-well but give an additional message."
+definitions should be in vector notation. These are defined
+as well but give an additional message."
(define-key keymap key def)
- (dolist (dep-key deprecated)
- (define-key keymap dep-key
- `(lambda ()
- ,(format "Deprecated binding for %s, use \\[%s] instead." def def)
- (interactive)
- (call-interactively ',def)
- (message "[Deprecated use of key %s; use key %s instead]"
- (key-description (this-command-keys))
- (key-description ,key))))))
-
-;; Key bindings.
+ (when deprecated
+ (let* ((command-name (symbol-name def))
+ (forwarder-function-name
+ (if (string-match "^rst-\\(.*\\)$" command-name)
+ (concat "rst-deprecated-"
+ (match-string 1 command-name))
+ (error "not an RST command: %s" command-name)))
+ (forwarder-function (intern forwarder-function-name)))
+ (unless (fboundp forwarder-function)
+ (defalias forwarder-function
+ (lexical-let ((key key) (def def))
+ (lambda ()
+ (interactive)
+ (call-interactively def)
+ (message "[Deprecated use of key %s; use key %s instead]"
+ (key-description (this-command-keys))
+ (key-description key))))
+ (format "Deprecated binding for %s, use \\[%s] instead."
+ def def)))
+ (dolist (dep-key deprecated)
+ (define-key keymap dep-key forwarder-function)))))
+ ;; Key bindings.
(defvar rst-mode-map
(let ((map (make-sparse-keymap)))
@@ -767,17 +779,15 @@ This inherits from Text mode.")
(modify-syntax-entry ?\\ "\\" st)
(modify-syntax-entry ?_ "." st)
(modify-syntax-entry ?| "." st)
- (modify-syntax-entry ?\u00ab "." st)
- (modify-syntax-entry ?\u00bb "." st)
- (modify-syntax-entry ?\u2018 "." st)
- (modify-syntax-entry ?\u2019 "." st)
- (modify-syntax-entry ?\u201c "." st)
- (modify-syntax-entry ?\u201d "." st)
-
+ (modify-syntax-entry ?« "." st)
+ (modify-syntax-entry ?» "." st)
+ (modify-syntax-entry ?‘ "." st)
+ (modify-syntax-entry ?’ "." st)
+ (modify-syntax-entry ?“ "." st)
+ (modify-syntax-entry ?” "." st)
st)
"Syntax table used while in `rst-mode'.")
-
(defcustom rst-mode-hook nil
"Hook run when `rst-mode' is turned on.
The hook for `text-mode' is run before this one."
@@ -788,6 +798,8 @@ The hook for `text-mode' is run before this one."
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
+(defvar electric-pair-pairs)
+
;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
;; use *.txt, but this is too generic to be set as a default.
;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -849,6 +861,9 @@ highlighting.
(set (make-local-variable 'uncomment-region-function)
'rst-uncomment-region)
+ (set (make-local-variable 'electric-pair-pairs)
+ '((?\" . ?\") (?\* . ?\*) (?\` . ?\`)))
+
;; Imenu and which function.
;; FIXME: Check documentation of `which-function' for alternative ways to
;; determine the current function name.
@@ -864,7 +879,10 @@ highlighting.
(add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t)
;; Text after a changed line may need new fontification.
- (set (make-local-variable 'jit-lock-contextually) t))
+ (set (make-local-variable 'jit-lock-contextually) t)
+
+ ;; Indentation is not deterministic.
+ (setq electric-indent-inhibit t))
;;;###autoload
(define-minor-mode rst-minor-mode
@@ -980,10 +998,10 @@ for modes derived from Text mode, like Mail mode."
A list consisting of lists of the form (CHARACTER STYLE INDENT).
CHARACTER is the character used. STYLE is one of the symbols
-OVER-AND-UNDER or SIMPLE. INDENT is an integer giving the wanted
-indentation for STYLE OVER-AND-UNDER. CHARACTER and STYLE are
-always used when a section adornment is described. In other
-places t instead of a list stands for a transition.
+`over-and-under' or `simple'. INDENT is an integer giving the
+wanted indentation for STYLE `over-and-under'. CHARACTER and
+STYLE are always used when a section adornment is described.
+In other places, t instead of a list stands for a transition.
This sequence is consulted to offer a new adornment suggestion
when we rotate the underlines at the end of the existing
@@ -1020,8 +1038,8 @@ style."
(defun rst-compare-adornments (ado1 ado2)
"Compare adornments.
Return true if both ADO1 and ADO2 adornments are equal,
-according to restructured text semantics (only the character and
-the style are compared, the indentation does not matter)."
+according to restructured text semantics (only the character
+and the style are compared, the indentation does not matter)."
(and (eq (car ado1) (car ado2))
(eq (cadr ado1) (cadr ado2))))
@@ -1077,9 +1095,9 @@ better match."
(defun rst-update-section (char style &optional indent)
"Unconditionally update the style of a section adornment.
-Do this using the given character CHAR, with STYLE 'simple
-or 'over-and-under, and with indent INDENT. If the STYLE
-is 'simple, whitespace before the title is removed (indent
+Do this using the given character CHAR, with STYLE `simple'
+or `over-and-under', and with indent INDENT. If the STYLE
+is `simple', whitespace before the title is removed (indent
is always assumed to be 0).
If there are existing overline and/or underline from the
@@ -1256,8 +1274,8 @@ point is on a suitable title line use it.
If no title line is found return nil.
Otherwise return as `rst-classify-adornment' does. However, if
-the title line has no syntactically valid adornment STYLE is nil
-in the first element. If there is no adornment around the title
+the title line has no syntactically valid adornment, STYLE is nil
+in the first element. If there is no adornment around the title,
CHARACTER is also nil and match groups for overline and underline
are nil."
(save-excursion
@@ -1311,15 +1329,15 @@ are nil."
(defvar rst-all-sections nil
"All section adornments in the buffer as found by `rst-find-all-adornments'.
-t when no section adornments were found.")
+Set to t when no section adornments were found.")
(make-variable-buffer-local 'rst-all-sections)
;; FIXME: If this variable is set to a different value font-locking of section
;; headers is wrong.
(defvar rst-section-hierarchy nil
"Section hierarchy in the buffer as determined by `rst-get-hierarchy'.
-t when no section adornments were found. Value depends on
-`rst-all-sections'.")
+Set to t when no section adornments were found.
+Value depends on `rst-all-sections'.")
(make-variable-buffer-local 'rst-section-hierarchy)
(rst-testcover-add-1value 'rst-reset-section-caches)
@@ -1488,15 +1506,15 @@ REVERSE-DIRECTION is used to reverse the cycling order."
Adjust/rotate the section adornment for the section title around
point or promote/demote the adornments inside the region,
-depending on if the region is active. This function is meant to
-be invoked possibly multiple times, and can vary its behavior
+depending on whether the region is active. This function is meant
+to be invoked possibly multiple times, and can vary its behavior
with a positive PFXARG (toggle style), or with a negative
PFXARG (alternate behavior).
This function is a bit of a swiss knife. It is meant to adjust
the adornments of a section title in reStructuredText. It tries
-to deal with all the possible cases gracefully and to do `the
-right thing' in all cases.
+to deal with all the possible cases gracefully and to do \"the
+right thing\" in all cases.
See the documentations of `rst-adjust-adornment-work' and
`rst-promote-region' for full details.
@@ -1595,7 +1613,7 @@ The adornments consist in
1. a CHARACTER
-2. a STYLE which can be either of 'simple' or 'over-and-under'.
+2. a STYLE which can be either `simple' or `over-and-under'.
3. an INDENT (meaningful for the over-and-under style only)
which determines how many characters and over-and-under
@@ -1638,8 +1656,8 @@ Case 2: Incomplete Adornment
If the current line does have an existing adornment, but the
adornment is incomplete, that is, the underline/overline does
-not extend to exactly the end of the title line (it is either too
-short or too long), we simply extend the length of the
+not extend to exactly the end of the title line (it is either
+too short or too long), we simply extend the length of the
underlines/overlines to fit exactly the section title.
If TOGGLE-STYLE we toggle the style of the adornment as well.
@@ -1908,7 +1926,7 @@ in order to adapt it to our preferred style."
Obviously, NUM must be greater than zero. Don't blame me, blame the
Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
apologies to Monty Python).
-If optional prefix ARG is non-nil, insert in current buffer."
+If optional ARG is non-nil, insert in current buffer."
(let ((map rst-arabic-to-roman)
res)
(while (and map (> num 0))
@@ -1917,13 +1935,13 @@ If optional prefix ARG is non-nil, insert in current buffer."
(setq res (concat res (cdar map))
num (- num (caar map)))
(setq map (cdr map))))
- res))
+ (if arg (insert (or res "")) res)))
(defun rst-roman-to-arabic (string &optional arg)
"Convert STRING of Roman numerals to an Arabic number.
-If STRING contains a letter which isn't a valid Roman numeral, the rest
-of the string from that point onwards is ignored.
+If STRING contains a letter which isn't a valid Roman numeral,
+the rest of the string from that point onwards is ignored.
Hence:
MMD == 2500
@@ -1937,7 +1955,7 @@ If optional ARG is non-nil, insert in current buffer."
(setq res (+ res (caar map))
string (replace-match "" nil t string))
(setq map (cdr map))))
- res))
+ (if arg (insert res) res)))
;=================================================
(defun rst-find-pfx-in-region (beg end pfx-re)
@@ -2006,20 +2024,20 @@ Other situations are just ignored and left to users themselves."
;; FIXME: Isn't this a `defconst'?
(defvar rst-initial-items
(append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
- "List of initial items. It's collection of bullets and enumerations.")
+ "List of initial items. It's a collection of bullets and enumerations.")
(defun rst-insert-list-new-item ()
"Insert a new list item.
-User is asked to select the item style first, for example (a), i), +. Use TAB
-for completion and choices.
+User is asked to select the item style first, for example (a), i), +.
+Use TAB for completion and choices.
If user selects bullets or #, it's just added with position arranged by
`rst-insert-list-pos'.
-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-pos'."
+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-pos'."
(interactive)
;; FIXME: Make this comply to `interactive' standards.
(let* ((itemstyle (completing-read
@@ -2121,15 +2139,15 @@ for completion and choices.
(a) If user selects bullets or #, it's just added.
(b) If user selects enumerations, a further prompt is given. User needs to
- input a starting item, for example 'e' for 'A)' style.
+ input a starting item, for example `e' for `A)' style.
The position of the new list is arranged according to whether or not the
current line and the previous line are blank lines.
-2. When continuing a list, one thing need to be noticed:
+2. When continuing a list, one thing needs to be noticed:
-List style alphabetical list, such as 'a.', and roman numerical list, such as
-'i.', have some overlapping items, for example 'v.' The function can deal with
+List style alphabetical list, such as `a.', and roman numerical list, such as
+`i.', have some overlapping items, for example `v.' The function can deal with
the problem elegantly in most situations. But when those overlapped list are
preceded by a blank line, it is hard to determine which type to use
automatically. The function uses alphabetical list by default. If you want
@@ -2257,13 +2275,11 @@ without UNPROCESSED."
"Return section containing POINT by returning the closest node in TREE.
TREE is a section tree as returned by `rst-section-tree'
consisting of (NODE CHILD...) entries. POINT defaults to the
-current point. A NODE must have the structure (IGNORED MARKER
-...).
+current point. A NODE must have the structure (IGNORED MARKER...).
Return (PATH NODE CHILD...). NODE is the node where POINT is in
if any. PATH is a list of nodes from the top of the tree down to
-and including NODE. List of CHILD are the children of NODE if
-any."
+and including NODE. List of CHILD are the children of NODE if any."
(setq point (or point (point)))
(let ((cur (car tree))
(children (cdr tree)))
@@ -2296,6 +2312,7 @@ any."
(defcustom rst-toc-indent 2
"Indentation for table-of-contents display.
Also used for formatting insertion, when numbering is disabled."
+ :type 'integer
:group 'rst-toc)
(rst-testcover-defcustom)
@@ -2303,15 +2320,20 @@ Also used for formatting insertion, when numbering is disabled."
"Insertion style for table-of-contents.
Set this to one of the following values to determine numbering and
indentation style:
-- plain: no numbering (fixed indentation)
-- fixed: numbering, but fixed indentation
-- aligned: numbering, titles aligned under each other
-- listed: numbering, with dashes like list items (EXPERIMENTAL)"
+- `plain': no numbering (fixed indentation)
+- `fixed': numbering, but fixed indentation
+- `aligned': numbering, titles aligned under each other
+- `listed': numbering, with dashes like list items (EXPERIMENTAL)"
+ :type '(choice (const plain)
+ (const fixed)
+ (const aligned)
+ (const listed))
:group 'rst-toc)
(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
+ :type 'string
:group 'rst-toc)
(rst-testcover-defcustom)
@@ -2324,6 +2346,7 @@ indentation style:
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
+ :type '(choice (const nil) integer)
:group 'rst-toc)
(rst-testcover-defcustom)
@@ -2363,7 +2386,7 @@ The TOC is inserted indented at the current column."
(defun rst-toc-insert-node (node level indent pfx)
"Insert tree node NODE in table-of-contents.
-Recursive function that does printing of the inserted toc.
+Recursive function that does printing of the inserted TOC.
LEVEL is the depth level of the sections in the tree.
INDENT is the indentation string. PFX is the prefix numbering,
that includes the alignment necessary for all the children of
@@ -2590,7 +2613,7 @@ brings the cursor in that section."
;; paragraph.
(defun rst-goto-section (&optional kill)
"Go to the section the current line describes.
-If KILL a toc buffer is destroyed."
+If KILL a TOC buffer is destroyed."
(interactive)
(let ((pos (rst-toc-mode-find-section)))
(when kill
@@ -2661,8 +2684,8 @@ EVENT is the input event."
(defun rst-forward-section (&optional offset)
"Skip to the next reStructuredText section title.
-OFFSET specifies how many titles to skip. Use a negative OFFSET to move
-backwards in the file (default is to use 1)."
+OFFSET specifies how many titles to skip. Use a negative OFFSET
+to move backwards in the file (default is to use 1)."
(interactive)
(rst-reset-section-caches)
(let* (;; Default value for offset.
@@ -2827,10 +2850,9 @@ first of a paragraph."
(defgroup rst-indent nil "Settings for indentation in reStructuredText.
In reStructuredText indentation points are usually determined by
-preceding lines. Sometimes the syntax allows arbitrary
-indentation points such as where to start the first line
-following a directive. These indentation widths can be customized
-here."
+preceding lines. Sometimes the syntax allows arbitrary indentation
+points such as where to start the first line following a directive.
+These indentation widths can be customized here."
:group 'rst
:package-version '(rst . "1.1.0"))
@@ -2936,11 +2958,11 @@ and not from inner alignment points."
(defun rst-compute-tabs (pt)
"Build the list of possible tabs for all lines above.
-Search backwards from point PT to build the list of possible
-tabs. Return a list of tabs sorted by likeliness to continue
-writing like `rst-line-tabs'. Nearer lines have generally a
-higher likeliness than farther lines. Return nil if no tab is found
-in the text above."
+Search backwards from point PT to build the list of possible tabs.
+Return a list of tabs sorted by likeliness to continue writing
+like `rst-line-tabs'. Nearer lines have generally a higher
+likeliness than farther lines. Return nil if no tab is found in
+the text above."
(save-excursion
(goto-char pt)
(let (leftmost ; Leftmost column found so far.
@@ -3100,7 +3122,7 @@ newlines as mandated by `comment-line-break-function'."
(defun rst-comment-region (beg end &optional arg)
"Comment or uncomment the current region.
-Region is from from BEG to END. Uncomment if ARG."
+Region is from BEG to END. Uncomment if ARG."
(save-excursion
(if (consp arg)
(rst-uncomment-region beg end arg)
@@ -3115,7 +3137,7 @@ Region is from from BEG to END. Uncomment if ARG."
(indent-line-to ind)
(insert (comment-string-strip comment-start t t))))))
-(defun rst-uncomment-region (beg end &optional arg)
+(defun rst-uncomment-region (beg end &optional _arg)
"Uncomment the current region.
Region is from BEG to END. ARG is ignored"
(save-excursion
@@ -3550,8 +3572,8 @@ of your own."
;; properties on comments and literal blocks so they are *not*
;; inline fontified. See (elisp)Search-based Fontification.
- ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el`
- ;; and other V24 modes. May make `font-lock-extend-region`
+ ;; FIXME: And / or use `syntax-propertize' functions as in `octave-mod.el'
+ ;; and other V24 modes. May make `font-lock-extend-region'
;; superfluous.
;; `Comments`_
@@ -3753,8 +3775,7 @@ point is not moved."
(defvar rst-font-lock-find-unindented-line-end nil
"End of the match as determined by `rst-font-lock-find-unindented-line-limit'.
-Also used as a trigger for
-`rst-font-lock-find-unindented-line-match'.")
+Also used as a trigger for `rst-font-lock-find-unindented-line-match'.")
(defun rst-font-lock-find-unindented-line-limit (ind-pnt)
"Find the next unindented line relative to indentation at IND-PNT.
@@ -3762,8 +3783,7 @@ Return this point, the end of the buffer or nil if nothing found.
If IND-PNT is `next' take the indentation from the next line if
this is not empty and indented more than the current one. If
IND-PNT is non-nil but not a number take the indentation from the
-next non-empty line if this is indented more than the current
-one."
+next non-empty line if this is indented more than the current one."
(setq rst-font-lock-find-unindented-line-begin ind-pnt)
(setq rst-font-lock-find-unindented-line-end
(save-excursion
@@ -3803,12 +3823,11 @@ one."
(or (rst-forward-indented-block nil (point-max))
(point-max))))))
-(defun rst-font-lock-find-unindented-line-match (limit)
+(defun rst-font-lock-find-unindented-line-match (_limit)
"Set the match found earlier if match were found.
-Match has been found by
-`rst-font-lock-find-unindented-line-limit' the first time called
-or no match is found. Return non-nil if match was found. LIMIT
-is not used but mandated by the caller."
+Match has been found by `rst-font-lock-find-unindented-line-limit'
+the first time called or no match is found. Return non-nil if
+match was found. LIMIT is not used but mandated by the caller."
(when rst-font-lock-find-unindented-line-end
(set-match-data
(list rst-font-lock-find-unindented-line-begin
@@ -3829,10 +3848,9 @@ Either section level of the current adornment or t for a transition.")
(defun rst-adornment-level (key)
"Return section level for adornment KEY.
-KEY is the first element of the return list of
-`rst-classify-adornment'. If KEY is not a cons return it. If KEY is found
-in the hierarchy return its level. Otherwise return a level one
-beyond the existing hierarchy."
+KEY is the first element of the return list of `rst-classify-adornment'.
+If KEY is not a cons return it. If KEY is found in the hierarchy return
+its level. Otherwise return a level one beyond the existing hierarchy."
(if (not (consp key))
key
(let* ((hier (rst-get-hierarchy))
@@ -3854,9 +3872,8 @@ as a trigger for `rst-font-lock-handle-adornment-matcher'.")
(defun rst-font-lock-handle-adornment-pre-match-form (ado ado-end)
"Determine limit for adornments.
Determine all things necessary for font-locking section titles
-and transitions and put the result to
-`rst-font-lock-adornment-match' and
-`rst-font-lock-adornment-level'. ADO is the complete adornment
+and transitions and put the result to `rst-font-lock-adornment-match'
+and `rst-font-lock-adornment-level'. ADO is the complete adornment
matched. ADO-END is the point where ADO ends. Return the point
where the whole adorned construct ends.
@@ -3871,7 +3888,7 @@ Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'."
(goto-char (nth 1 ado-data)) ; Beginning of construct.
(nth 2 ado-data)))) ; End of construct.
-(defun rst-font-lock-handle-adornment-matcher (limit)
+(defun rst-font-lock-handle-adornment-matcher (_limit)
"Set the match found earlier if match were found.
Match has been found by
`rst-font-lock-handle-adornment-pre-match-form' the first time
@@ -3936,11 +3953,11 @@ string)) to be used for converting the document."
:package-version "1.2.0")
(rst-testcover-defcustom)
-;; FIXME: Must be `defcustom`.
+;; FIXME: Must be defcustom.
(defvar rst-compile-primary-toolset 'html
"The default tool-set for `rst-compile'.")
-;; FIXME: Must be `defcustom`.
+;; FIXME: Must be defcustom.
(defvar rst-compile-secondary-toolset 'latex
"The default tool-set for `rst-compile' with a prefix argument.")
@@ -3968,7 +3985,7 @@ string)) to be used for converting the document."
(defun rst-compile (&optional use-alt)
"Compile command to convert reST document into some output file.
Attempts to find configuration file, if it can, overrides the
-options. There are two commands to choose from, with USE-ALT,
+options. There are two commands to choose from; with USE-ALT,
select the alternative tool-set."
(interactive "P")
;; Note: maybe we want to check if there is a Makefile too and not do anything
@@ -4019,7 +4036,7 @@ buffer, if the region is not selected."
(cadr (assq 'pseudoxml rst-compile-toolsets))
standard-output)))
-;; FIXME: Should be `defcustom`.
+;; FIXME: Should be defcustom.
(defvar rst-pdf-program "xpdf"
"Program used to preview PDF files.")
@@ -4036,7 +4053,7 @@ buffer, if the region is not selected."
;; output.
))
-;; FIXME: Should be `defcustom` or use something like `browse-url`.
+;; FIXME: Should be defcustom or use something like `browse-url'.
(defvar rst-slides-program "firefox"
"Program used to preview S5 slides.")
@@ -4073,7 +4090,7 @@ buffer, if the region is not selected."
a))
(defun rst-imenu-convert-cell (elt adornments)
- "Convert a cell ELT in a tree returned from `rst-section-tree' to imenu index.
+ "Convert a cell ELT in a tree returned from `rst-section-tree' to Imenu index.
ADORNMENTS is used as hint information for conversion."
(let* ((kar (car elt))
(kdr (cdr elt))
@@ -4107,7 +4124,7 @@ ADORNMENTS is used as hint information for conversion."
;; FIXME: Document title and subtitle need to be handled properly. They should
;; get an own "Document" top level entry.
(defun rst-imenu-create-index ()
- "Create index for imenu.
+ "Create index for Imenu.
Return as described for `imenu--index-alist'."
(rst-reset-section-caches)
(let ((tree (rst-section-tree))
@@ -4145,7 +4162,7 @@ cand replace with char: ")
(let ((width (current-column)))
(rst-delete-entire-line)
(insert-char tochar width)))
- (message (format "%d lines replaced." found)))))
+ (message "%d lines replaced." found))))
;; FIXME: Unbound command - should be bound or removed.
(defun rst-join-paragraph ()
@@ -4169,8 +4186,8 @@ This is useful for filling list item paragraphs."
;; be useful for creating separators.
(defun rst-repeat-last-character (use-next)
"Fill the current line using the last character on the current line.
-Fill up to the length of the preceding line or up to
-`fill-column' if preceding line is empty.
+Fill up to the length of the preceding line or up to `fill-column' if preceding
+line is empty.
If USE-NEXT, use the next line rather than the preceding line.
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 33dfa277330..55a1e6d26db 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,10 +1,10 @@
-;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: utf-8 -*-
+;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*-
-;; Copyright (C) 1992, 1995-1996, 1998, 2001-2013 Free Software
+;; Copyright (C) 1992, 1995-1996, 1998, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Adapted-By: ESR, Daniel Pfeiffer <occitan@esperanto.org>,
;; F.Potorti@cnuce.cnr.it
;; Keywords: wp, hypermedia, comm, languages
@@ -46,6 +46,25 @@
:type 'integer
:group 'sgml)
+(defcustom sgml-attribute-offset 0
+ "Specifies a delta for attribute indentation in `sgml-indent-line'.
+
+When 0, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>
+
+When 2, attribute indentation looks like this:
+
+ <element
+ attribute=\"value\">
+ </element>"
+ :version "25.1"
+ :type 'integer
+ :safe 'integerp
+ :group 'sgml)
+
(defcustom sgml-xml-mode nil
"When non-nil, tag insertion functions will be XML-compliant.
It is set to be buffer-local when the file has
@@ -87,10 +106,10 @@ This list is used when first loading the `sgml-mode' library.
The supported characters and potential disadvantages are:
?\\\" Makes \" in text start a string.
- ?' Makes ' in text start a string.
+ ?\\=' Makes \\=' in text start a string.
?- Makes -- in text start a comment.
-When only one of ?\\\" or ?' are included, \"'\" or '\"', as can be found in
+When only one of ?\\\" or ?\\=' are included, \"\\='\" or \\='\"\\=', as can be found in
DTDs, start a string. To partially avoid this problem this also makes these
self insert as named entities depending on `sgml-quick-keys'.
@@ -240,12 +259,21 @@ This takes effect when first loading the `sgml-mode' library.")
"A table for mapping non-ASCII characters into SGML entity names.
Currently, only Latin-1 characters are supported.")
-;; nsgmls is a free SGML parser in the SP suite available from
-;; ftp.jclark.com and otherwise packaged for GNU systems.
-;; Its error messages can be parsed by next-error.
-;; The -s option suppresses output.
-
-(defcustom sgml-validate-command "nsgmls -s" ; replaced old `sgmls'
+(defcustom sgml-validate-command
+ ;; prefer tidy because (o)nsgmls is often built without --enable-http
+ ;; which makes it next to useless
+ (cond ((executable-find "tidy")
+ ;; tidy is available from http://tidy.sourceforge.net/
+ "tidy --gnu-emacs yes -utf8 -e -q")
+ ((executable-find "nsgmls")
+ ;; nsgmls is a free SGML parser in the SP suite available from
+ ;; ftp.jclark.com, replaced old `sgmls'.
+ "nsgmls -s")
+ ((executable-find "onsgmls")
+ ;; onsgmls is the community version of `nsgmls'
+ ;; hosted on http://openjade.sourceforge.net/
+ "onsgmls -s")
+ (t "Install (o)nsgmls, tidy, or some other SGML validator, and set `sgml-validate-command'"))
"The command to validate an SGML document.
The file name of current buffer file name will be appended to this,
separated by a space."
@@ -414,7 +442,7 @@ an optional alist of possible values."
(comment-style 'plain))
(comment-indent-new-line soft)))
-(defun sgml-mode-facemenu-add-face-function (face end)
+(defun sgml-mode-facemenu-add-face-function (face _end)
(let ((tag-face (cdr (assq face sgml-face-tag-alist))))
(cond (tag-face
(setq tag-face (funcall skeleton-transformation-function tag-face))
@@ -447,18 +475,21 @@ This function is designed for use in `fill-nobreak-predicate'.
(skip-chars-backward "/?!")
(eq (char-before) ?<))))
+(defvar tildify-space-string)
+(defvar tildify-foreach-region-function)
+
;;;###autoload
(define-derived-mode sgml-mode text-mode '(sgml-xml-mode "XML" "SGML")
"Major mode for editing SGML documents.
Makes > match <.
-Keys <, &, SPC within <>, \", / and ' can be electric depending on
+Keys <, &, SPC within <>, \", / and \\=' can be electric depending on
`sgml-quick-keys'.
An argument of N to a tag-inserting command means to wrap it around
the next N words. In Transient Mark mode, when the mark is active,
N defaults to -1, which means to wrap it around the current region.
-If you like upcased tags, put (setq sgml-transformation-function 'upcase)
+If you like upcased tags, put (setq sgml-transformation-function \\='upcase)
in your init file.
Use \\[sgml-validate] to validate your document with an SGML parser.
@@ -468,12 +499,33 @@ Do \\[describe-key] on the following bindings to discover what they do.
\\{sgml-mode-map}"
(make-local-variable 'sgml-saved-validate-command)
(make-local-variable 'facemenu-end-add-face)
+ ;; If encoding does not allow non-break space character, use reference.
+ ;; FIXME: Perhaps use &nbsp; if possible (e.g. when we know its HTML)?
+ (setq-local tildify-space-string
+ (if (equal (decode-coding-string
+ (encode-coding-string " " buffer-file-coding-system)
+ buffer-file-coding-system) " ")
+ " " "&#160;"))
+ ;; FIXME: Use the fact that we're parsing the document already
+ ;; rather than using regex-based filtering.
+ (setq-local tildify-foreach-region-function
+ (apply-partially
+ 'tildify-foreach-ignore-environments
+ `((,(eval-when-compile
+ (concat
+ "<\\("
+ (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var"
+ "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR"))
+ "\\)\\>[^>]*>"))
+ . ("</" 1 ">"))
+ ("<! *--" . "-- *>")
+ ("<" . ">"))))
;;(make-local-variable 'facemenu-remove-face-function)
;; A start or end tag by itself on a line separates a paragraph.
;; This is desirable because SGML discards a newline that appears
;; immediately after a start tag or immediately before an end tag.
(setq-local paragraph-start (concat "[ \t]*$\\|\
-\[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
+[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>"))
(setq-local paragraph-separate (concat paragraph-start "$"))
(setq-local adaptive-fill-regexp "[ \t]*")
(add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t)
@@ -707,9 +759,10 @@ If QUIET, do not print a message when there are no attributes for TAG."
(insert ?\s)
(insert (funcall skeleton-transformation-function
(setq attribute
- (skeleton-read '(completing-read
- "Attribute: "
- alist)))))
+ (skeleton-read (lambda ()
+ (completing-read
+ "Attribute: "
+ alist))))))
(if (string= "" attribute)
(setq i 0)
(sgml-value (assoc (downcase attribute) alist))
@@ -792,7 +845,7 @@ Return non-nil if we skipped over matched tags."
(defvar sgml-electric-tag-pair-overlays nil)
(defvar sgml-electric-tag-pair-timer nil)
-(defun sgml-electric-tag-pair-before-change-function (beg end)
+(defun sgml-electric-tag-pair-before-change-function (_beg end)
(condition-case err
(save-excursion
(goto-char end)
@@ -960,7 +1013,7 @@ With prefix argument ARG, repeat this ARG times."
(or (get 'sgml-tag 'invisible)
(setplist 'sgml-tag
(append '(invisible t
- point-entered sgml-point-entered
+ cursor-sensor-functions (sgml-cursor-sensor)
rear-nonsticky t
read-only t)
(symbol-plist 'sgml-tag))))
@@ -968,63 +1021,59 @@ With prefix argument ARG, repeat this ARG times."
(defun sgml-tags-invisible (arg)
"Toggle visibility of existing tags."
(interactive "P")
- (let ((modified (buffer-modified-p))
- (inhibit-read-only t)
- (inhibit-modification-hooks t)
- ;; Avoid spurious the `file-locked' checks.
- (buffer-file-name nil)
- ;; This is needed in case font lock gets called,
- ;; since it moves point and might call sgml-point-entered.
- ;; How could it get called? -stef
- (inhibit-point-motion-hooks t)
+ (let ((inhibit-read-only t)
string)
- (unwind-protect
- (save-excursion
- (goto-char (point-min))
- (if (setq-local sgml-tags-invisible
- (if arg
- (>= (prefix-numeric-value arg) 0)
- (not sgml-tags-invisible)))
- (while (re-search-forward sgml-tag-name-re nil t)
- (setq string
- (cdr (assq (intern-soft (downcase (match-string 1)))
- sgml-display-text)))
- (goto-char (match-beginning 0))
- (and (stringp string)
- (not (overlays-at (point)))
- (let ((ol (make-overlay (point) (match-beginning 1))))
- (overlay-put ol 'before-string string)
- (overlay-put ol 'sgml-tag t)))
- (put-text-property (point)
- (progn (forward-list) (point))
- 'category 'sgml-tag))
- (let ((pos (point-min)))
- (while (< (setq pos (next-overlay-change pos)) (point-max))
- (dolist (ol (overlays-at pos))
- (if (overlay-get ol 'sgml-tag)
- (delete-overlay ol)))))
- (remove-text-properties (point-min) (point-max) '(category nil))))
- (restore-buffer-modified-p modified))
+ (with-silent-modifications
+ (save-excursion
+ (goto-char (point-min))
+ (if (setq-local sgml-tags-invisible
+ (if arg
+ (>= (prefix-numeric-value arg) 0)
+ (not sgml-tags-invisible)))
+ (while (re-search-forward sgml-tag-name-re nil t)
+ (setq string
+ (cdr (assq (intern-soft (downcase (match-string 1)))
+ sgml-display-text)))
+ (goto-char (match-beginning 0))
+ (and (stringp string)
+ (not (overlays-at (point)))
+ (let ((ol (make-overlay (point) (match-beginning 1))))
+ (overlay-put ol 'before-string string)
+ (overlay-put ol 'sgml-tag t)))
+ (put-text-property (point)
+ (progn (forward-list) (point))
+ 'category 'sgml-tag))
+ (let ((pos (point-min)))
+ (while (< (setq pos (next-overlay-change pos)) (point-max))
+ (dolist (ol (overlays-at pos))
+ (if (overlay-get ol 'sgml-tag)
+ (delete-overlay ol)))))
+ (remove-text-properties (point-min) (point-max) '(category nil)))))
+ (cursor-sensor-mode (if sgml-tags-invisible 1 -1))
(run-hooks 'sgml-tags-invisible-hook)
(message "")))
-(defun sgml-point-entered (x y)
- ;; Show preceding or following hidden tag, depending of cursor direction.
- (let ((inhibit-point-motion-hooks t))
- (save-excursion
- (condition-case nil
- (message "Invisible tag: %s"
- ;; Strip properties, otherwise, the text is invisible.
- (buffer-substring-no-properties
- (point)
- (if (or (and (> x y)
- (not (eq (following-char) ?<)))
- (and (< x y)
- (eq (preceding-char) ?>)))
- (backward-list)
- (forward-list))))
- (error nil)))))
-
+(defun sgml-cursor-sensor (window x dir)
+ ;; Show preceding or following hidden tag, depending of cursor direction (and
+ ;; `dir' is not the direction in this sense).
+ (when (eq dir 'entered)
+ (ignore-errors
+ (let* ((y (window-point window))
+ (otherend
+ (save-excursion
+ (goto-char y)
+ (cond
+ ((and (eq (char-before) ?>)
+ (or (not (eq (char-after) ?<))
+ (> x y)))
+ (backward-sexp))
+ ((eq (char-after y) ?<)
+ (forward-sexp)))
+ (point))))
+ (message "Invisible tag: %s"
+ ;; Strip properties, otherwise, the text is invisible.
+ (buffer-substring-no-properties
+ y otherend))))))
(defun sgml-validate (command)
@@ -1106,7 +1155,7 @@ If nil, start from a preceding tag at indentation."
((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
(t (cons 'text text-start))))))
-(defun sgml-beginning-of-tag (&optional top-level)
+(defun sgml-beginning-of-tag (&optional only-immediate)
"Skip to beginning of tag and return its name.
If this can't be done, return nil."
(let ((context (sgml-lexical-context)))
@@ -1115,7 +1164,7 @@ If this can't be done, return nil."
(goto-char (cdr context))
(when (looking-at sgml-tag-name-re)
(match-string-no-properties 1)))
- (if top-level nil
+ (if only-immediate nil
(when (not (eq (car context) 'text))
(goto-char (cdr context))
(sgml-beginning-of-tag t))))))
@@ -1129,13 +1178,16 @@ See `sgml-tag-alist' for info about attribute rules."
(if (and (eq (car alist) t) (not sgml-xml-mode))
(when (cdr alist)
(insert "=\"")
- (setq alist (skeleton-read '(completing-read "Value: " (cdr alist))))
+ (setq alist (skeleton-read (lambda ()
+ (completing-read
+ "Value: " (cdr alist)))))
(if (string< "" alist)
(insert alist ?\")
(delete-char -2)))
(insert "=\"")
(if (cdr alist)
- (insert (skeleton-read '(completing-read "Value: " alist)))
+ (insert (skeleton-read (lambda ()
+ (completing-read "Value: " alist))))
(when (null alist)
(insert (skeleton-read '(read-string "Value: ")))))
(insert ?\"))))
@@ -1477,13 +1529,13 @@ LCON is the lexical context, if any."
(`pi nil)
(`tag
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
(if (not (eolp))
(current-column)
;; This is the first attribute: indent.
- (goto-char (1+ (cdr lcon)))
+ (goto-char (+ (cdr lcon) sgml-attribute-offset))
(+ (current-column) sgml-basic-offset)))
(`text
@@ -1529,6 +1581,19 @@ LCON is the lexical context, if any."
(skip-chars-forward " \t\n")
(< (point) here) (sgml-at-indentation-p))
(current-column))
+ ;; ;; If the parsing failed, try to recover.
+ ;; ((and (null context) (bobp)
+ ;; (not (eq (char-after here) ?<)))
+ ;; (goto-char here)
+ ;; (if (and (looking-at "--[ \t\n]*>")
+ ;; (re-search-backward "<!--" nil t))
+ ;; ;; No wonder parsing failed: we're in a comment.
+ ;; (sgml-calculate-indent (prog2 (goto-char (match-end 0))
+ ;; (sgml-lexical-context)
+ ;; (goto-char here)))
+ ;; ;; We have no clue what's going on, let's be honest about it.
+ ;; nil))
+ ;; Otherwise, just follow the rules.
(t
(goto-char there)
(+ (current-column)
@@ -1767,6 +1832,8 @@ This takes effect when first loading the library.")
("array" (nil \n
("Item: " "<item>" str (if sgml-xml-mode "</item>") \n))
"align")
+ ("article" \n)
+ ("aside" \n)
("au")
("b")
("big")
@@ -1792,7 +1859,10 @@ This takes effect when first loading the library.")
"<dd>" (if sgml-xml-mode "</dd>") \n))
("em")
("fn" "id" "fn") ;; Footnotes were deprecated in HTML 3.2
+ ("footer" \n)
("head" \n)
+ ("header" \n)
+ ("hgroup" \n)
("html" (\n
"<head>\n"
"<title>" (setq str (read-input "Title: ")) "</title>\n"
@@ -1810,6 +1880,7 @@ This takes effect when first loading the library.")
("lang")
("li" ,(not sgml-xml-mode))
("math" \n)
+ ("nav" \n)
("nobr")
("option" t ("value") ("label") ("selected" t))
("over" t)
@@ -1819,6 +1890,7 @@ This takes effect when first loading the library.")
("rev")
("s")
("samp")
+ ("section" \n)
("small")
("span" nil
("class"
@@ -1849,6 +1921,8 @@ This takes effect when first loading the library.")
("acronym" . "Acronym")
("address" . "Formatted mail address")
("array" . "Math array")
+ ("article" . "An independent part of document or site")
+ ("aside" . "Secondary content related to surrounding content (e.g. page or article)")
("au" . "Author")
("b" . "Bold face")
("base" . "Base address for URLs")
@@ -1878,6 +1952,7 @@ This takes effect when first loading the library.")
("figt" . "Figure text")
("fn" . "Footnote") ;; No one supports special footnote rendering.
("font" . "Font size")
+ ("footer" . "Footer of a section")
("form" . "Form with input fields")
("group" . "Document grouping")
("h1" . "Most important section headline")
@@ -1887,6 +1962,8 @@ This takes effect when first loading the library.")
("h5" . "Unimportant section headline")
("h6" . "Least important section headline")
("head" . "Document header")
+ ("header" . "Header of a section")
+ ("hgroup" . "Group of headings - h1-h6 elements")
("hr" . "Horizontal rule")
("html" . "HTML Document")
("i" . "Italic face")
@@ -1899,8 +1976,9 @@ This takes effect when first loading the library.")
("li" . "List item")
("link" . "Link relationship")
("math" . "Math formula")
- ("menu" . "Menu list (obsolete)")
+ ("menu" . "List of commands")
("mh" . "Form mail header")
+ ("nav" . "Group of navigational links")
("nextid" . "Allocate new id")
("nobr" . "Text without line break")
("ol" . "Ordered list")
@@ -1914,6 +1992,7 @@ This takes effect when first loading the library.")
("rev" . "Reverse video")
("s" . "Strikeout")
("samp" . "Sample text")
+ ("section" . "Section of a document")
("select" . "Selection list")
("small" . "Font size")
("sp" . "Nobreak space")
@@ -1987,7 +2066,7 @@ Images in many formats can be inlined with <img src=\"URL\">.
If you mainly create your own documents, `sgml-specials' might be
interesting. But note that some HTML 2 browsers can't handle `&apos;'.
To work around that, do:
- (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
+ (eval-after-load \"sgml-mode\" \\='(aset sgml-char-names ?\\=' nil))
\\{html-mode-map}"
(setq-local sgml-display-text html-display-text)
@@ -2181,6 +2260,33 @@ HTML Autoview mode is a buffer-local minor mode for use with
"")))
\n))
+(define-skeleton html-navigational-links
+ "Group of navigational links."
+ nil
+ "<nav>" \n
+ "<ul>" \n
+ "<li><a href=\"" (skeleton-read "URL: " "#") "\">"
+ (skeleton-read "Title: ") "</a>"
+ (if sgml-xml-mode (if sgml-xml-mode "</li>")) \n
+ "</ul>" \n
+ "</nav>")
+
+(define-skeleton html-html5-template
+ "Initial HTML5 template"
+ nil
+ "<!DOCTYPE html>" \n
+ "<html lang=\"en\">" \n
+ "<head>" \n
+ "<meta charset=\"utf-8\">" \n
+ "<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge\">" \n
+ "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">" \n
+ "<title>" (skeleton-read "Page Title: ") "</title>" \n
+ "</head>" \n
+ "<body>" \n
+ "<div id=\"app\"></div>" \n
+ "</body>" \n
+ "</html>")
+
(provide 'sgml-mode)
;;; sgml-mode.el ends here
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 4d8a74323c7..151d64808af 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,6 +1,6 @@
;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*-
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Keywords: wp, convenience
;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
@@ -559,7 +559,7 @@
;; Todo: (in the order of priority, some are just possibility)
;; -----
;;
-;; Fix compatibilities with other input method than quail
+;; Fix incompatibilities with input methods other than quail
;; Resolve conflict with flyspell
;; Use mouse for resizing cells
;; A mechanism to link cells internally
@@ -770,7 +770,6 @@ the cell contents dynamically."
:type 'integer
:group 'table)
-;;;###autoload
(defcustom table-cell-map-hook nil
"Normal hooks run when finishing construction of `table-cell-map'.
User can modify `table-cell-map' by adding custom functions here."
@@ -794,19 +793,16 @@ simply by any key input."
:type 'boolean
:group 'table)
-;;;###autoload
(defcustom table-load-hook nil
"List of functions to be called after the table is first loaded."
:type 'hook
:group 'table-hooks)
-;;;###autoload
(defcustom table-point-entered-cell-hook nil
"List of functions to be called after point entered a table cell."
:type 'hook
:group 'table-hooks)
-;;;###autoload
(defcustom table-point-left-cell-hook nil
"List of functions to be called after point left a table cell."
:type 'hook
@@ -865,8 +861,6 @@ time.")
"Cache point coordinate based from the cell origin.")
(defvar table-cell-cache-mark-coordinate nil
"Cache mark coordinate based from the cell origin.")
-(defvar table-cell-entered-state nil
- "Records the state whether currently in a cell or nor.")
(defvar table-update-timer nil
"Timer id for deferred cell update.")
(defvar table-widen-timer nil
@@ -1216,14 +1210,14 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
;; does not cause a problem in the old implementation. Sigh...
(when (featurep 'xemacs)
(defun table--tweak-menu-for-xemacs (menu)
- (cond
- ((listp menu)
- (mapcar #'table--tweak-menu-for-xemacs menu))
- ((vectorp menu)
- (let ((len (length menu)))
- (dotimes (i len)
- ;; replace :help with something harmless.
- (if (eq (aref menu i) :help) (aset menu i :included)))))))
+ (cond
+ ((listp menu)
+ (mapcar #'table--tweak-menu-for-xemacs menu))
+ ((vectorp menu)
+ (let ((len (length menu)))
+ (dotimes (i len)
+ ;; replace :help with something harmless.
+ (if (eq (aref menu i) :help) (aset menu i :included)))))))
(mapcar #'table--tweak-menu-for-xemacs
(list table-global-menu table-cell-menu))
(defvar mark-active t))
@@ -1899,7 +1893,9 @@ all the table specific features."
(while (and (re-search-forward border3 (point-max) t)
(not (and (input-pending-p)
table-abort-recognition-when-input-pending)))
- (message "Recognizing tables...(%d%%)" (/ (* 100 (match-beginning 0)) (- (point-max) (point-min))))
+ (message "Recognizing tables...(%d%%)"
+ (floor (* 100.0 (match-beginning 0))
+ (- (point-max) (point-min))))
(let ((beg (match-beginning 0))
end)
(if (re-search-forward non-border (point-max) t)
@@ -2810,8 +2806,8 @@ ORIENTATION is a symbol either horizontally or vertically."
;;;###autoload
(defun table-justify (what justify)
"Justify contents of a cell, a row of cells or a column of cells.
-WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
-'center, 'right, 'top, 'middle, 'bottom or 'none."
+WHAT is a symbol `cell', `row' or `column'. JUSTIFY is a symbol
+`left', `center', `right', `top', `middle', `bottom' or `none'."
(interactive
(list (let* ((_ (barf-if-buffer-read-only))
(completion-ignore-case t)
@@ -2826,8 +2822,8 @@ WHAT is a symbol 'cell, 'row or 'column. JUSTIFY is a symbol 'left,
;;;###autoload
(defun table-justify-cell (justify &optional paragraph)
"Justify cell contents.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
-'middle, 'bottom or 'none for vertical. When optional PARAGRAPH is
+JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
+`middle', `bottom' or `none' for vertical. When optional PARAGRAPH is
non-nil the justify operation is limited to the current paragraph,
otherwise the entire cell contents is justified."
(interactive
@@ -2839,8 +2835,8 @@ otherwise the entire cell contents is justified."
;;;###autoload
(defun table-justify-row (justify)
"Justify cells of a row.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical."
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical."
(interactive
(list (table--query-justification)))
(let((cell-list (table--horizontal-cell-list nil nil 'top)))
@@ -2856,8 +2852,8 @@ JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
;;;###autoload
(defun table-justify-column (justify)
"Justify cells of a column.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or top,
-'middle, 'bottom or 'none for vertical."
+JUSTIFY is a symbol `left', `center' or `right' for horizontal,
+or `top', `middle', `bottom' or `none' for vertical."
(interactive
(list (table--query-justification)))
(let((cell-list (table--vertical-cell-list nil nil 'left)))
@@ -3345,25 +3341,25 @@ INTERVAL is the number of cells to travel between sequence element
insertion which is normally 1. When zero or less is given for
INTERVAL it is interpreted as number of cells per row so that sequence
is placed straight down vertically as long as the table's cell
-structure is uniform. JUSTIFY is one of the symbol 'left, 'center or
-'right, that specifies justification of the inserted string.
+structure is uniform. JUSTIFY is a symbol `left', `center' or
+`right' that specifies justification of the inserted string.
Example:
(progn
(table-insert 16 3 5 1)
(table-forward-cell 15)
- (table-insert-sequence \"D0\" -16 1 1 'center)
+ (table-insert-sequence \"D0\" -16 1 1 \\='center)
(table-forward-cell 16)
- (table-insert-sequence \"A[0]\" -16 1 1 'center)
+ (table-insert-sequence \"A[0]\" -16 1 1 \\='center)
(table-forward-cell 1)
- (table-insert-sequence \"-\" 16 0 1 'center))
+ (table-insert-sequence \"-\" 16 0 1 \\='center))
(progn
(table-insert 16 8 5 1)
- (table-insert-sequence \"@\" 0 1 2 'right)
+ (table-insert-sequence \"@\" 0 1 2 \\='right)
(table-forward-cell 1)
- (table-insert-sequence \"64\" 0 1 2 'left))"
+ (table-insert-sequence \"64\" 0 1 2 \\='left))"
(interactive
(progn
(barf-if-buffer-read-only)
@@ -4465,8 +4461,8 @@ looking at the appearance of the CELL contents."
(defun table--justify-cell-contents (justify &optional paragraph)
"Justify the current cell contents.
-JUSTIFY is a symbol 'left, 'center or 'right for horizontal, or 'top,
-'middle, 'bottom or 'none for vertical. When PARAGRAPH is non-nil the
+JUSTIFY is a symbol `left', `center' or `right' for horizontal, or `top',
+`middle', `bottom' or `none' for vertical. When PARAGRAPH is non-nil the
justify operation is limited to the current paragraph."
(table-with-cache-buffer
(let ((beg (point-min))
@@ -5187,8 +5183,8 @@ and the right cell border character."
(defun table--put-cell-point-entered/left-property (beg end &optional object)
"Put point-entered/left property."
- (put-text-property beg end 'point-entered 'table--point-entered-cell-function object)
- (put-text-property beg end 'point-left 'table--point-left-cell-function object))
+ (put-text-property beg end 'cursor-sensor-functions
+ '(table--point-entered/left-cell-function) object))
(defun table--remove-cell-properties (beg end &optional object)
"Remove all cell properties.
@@ -5204,8 +5200,7 @@ instead of the current buffer and returns the OBJECT."
'table-valign nil
'face nil
'rear-nonsticky nil
- 'point-entered nil
- 'point-left nil
+ 'cursor-sensor-functions nil
'keymap nil)
object))
(setq beg next)))
@@ -5247,28 +5242,20 @@ instead of the current buffer and returns the OBJECT."
"Put cell's vertical alignment property."
(table--put-property cell 'table-valign valign))
-(defun table--point-entered-cell-function (&optional _old-point _new-point)
+(defun table--point-entered/left-cell-function (_window _oldpos dir)
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
(let ((inhibit-point-motion-hooks t))
- (unless table-cell-entered-state
- (setq table-cell-entered-state t)
+ (force-mode-line-update)
+ (pcase dir
+ ('left
+ (setq table-mode-indicator nil)
+ (run-hooks 'table-point-left-cell-hook))
+ ('entered
(setq table-mode-indicator t)
- (force-mode-line-update)
(table--warn-incompatibility)
- (run-hooks 'table-point-entered-cell-hook))))
-
-(defun table--point-left-cell-function (&optional _old-point _new-point)
- "Point has left a cell.
-Refresh the menu bar."
- ;; Avoid calling point-motion-hooks recursively.
- (let ((inhibit-point-motion-hooks t))
- (when table-cell-entered-state
- (setq table-cell-entered-state nil)
- (setq table-mode-indicator nil)
- (force-mode-line-update)
- (run-hooks 'table-point-left-cell-hook))))
+ (run-hooks 'table-point-entered-cell-hook)))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 7b16262233d..0b13759b9bc 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1,9 +1,9 @@
-;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- coding: utf-8 -*-
+;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- lexical-binding:t -*-
-;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2013 Free
+;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2015 Free
;; Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: tex
;; Contributions over the years by William F. Schelter, Dick King,
@@ -135,8 +135,8 @@ If nil, TeX runs with no options. See the documentation of `tex-command'."
"TeX commands to use when starting TeX.
They are shell-quoted and precede the input file name, with a separating space.
If nil, no commands are used. See the documentation of `tex-command'."
- :type '(radio (const :tag "Interactive \(nil\)" nil)
- (const :tag "Nonstop \(\"\\nonstopmode\\input\"\)"
+ :type '(radio (const :tag "Interactive (nil)" nil)
+ (const :tag "Nonstop (\"\\nonstopmode\\input\")"
"\\nonstopmode\\input")
(string :tag "String at your choice"))
:group 'tex-run
@@ -266,8 +266,8 @@ tex shell terminates.")
(defvar tex-command "tex"
"Command to run TeX.
-If this string contains an asterisk \(`*'\), that is replaced by the file name;
-otherwise the value of `tex-start-options', the \(shell-quoted\)
+If this string contains an asterisk \(`*'), that is replaced by the file name;
+otherwise the value of `tex-start-options', the \(shell-quoted)
value of `tex-start-commands', and the file name are added at the end
with blanks as separators.
@@ -368,7 +368,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(match-end 1))
latex-section-alist))))
(backward-char 1)
- (condition-case err
+ (condition-case nil
(progn
;; Using sexps allows some use of matching {...} inside
;; titles.
@@ -387,7 +387,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
(goto-char (point-min))
(while (search-forward-regexp
"\\\\\\(include\\|input\\|verbatiminput\\|bibliography\\)\
-\[ \t]*{\\([^}\n]+\\)}"
+[ \t]*{\\([^}\n]+\\)}"
nil t)
(push (cons (concat "<<" (buffer-substring-no-properties
(match-beginning 2)
@@ -808,7 +808,7 @@ Not smaller than the value set by `tex-suscript-height-minimum'."
(defvar tex-verbatim-face 'tex-verbatim)
(defun tex-font-lock-verb (start delim)
- "Place syntax table properties on the \verb construct.
+ "Place syntax table properties on the \\verb construct.
START is the position of the \\ and DELIM is the delimiter char."
;; Do nothing if the \verb construct is itself inside a comment or
;; verbatim env.
@@ -937,7 +937,7 @@ Inherits `shell-mode-map' with a few additions.")
,@tex-face-alist)
"Alist of face and LaTeX font name for facemenu.")
-(defun tex-facemenu-add-face-function (face end)
+(defun tex-facemenu-add-face-function (face _end)
(or (cdr (assq face tex-face-alist))
(or (and (consp face)
(consp (car face))
@@ -1034,8 +1034,8 @@ says which mode to use."
(define-derived-mode plain-tex-mode tex-mode "TeX"
"Major mode for editing files of input for plain TeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run TeX on the current region, plus a \"header\"
copied from the top of the file (containing macro definitions, etc.),
@@ -1080,8 +1080,8 @@ special subshell is initiated, the hook `tex-shell-hook' is run."
(define-derived-mode latex-mode tex-mode "LaTeX"
"Major mode for editing files of input for LaTeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run LaTeX on the current region, plus the preamble
copied from the top of the file (containing \\documentstyle, etc.),
@@ -1162,8 +1162,8 @@ subshell is initiated, `tex-shell-hook' is run."
(define-derived-mode slitex-mode latex-mode "SliTeX"
"Major mode for editing files of input for SliTeX.
Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
+Makes \" insert \\=`\\=` when it seems to be the beginning of a quotation,
+and \\='\\=' when it appears to be the end; it inserts \" only after a \\.
Use \\[tex-region] to run SliTeX on the current region, plus the preamble
copied from the top of the file (containing \\documentstyle, etc.),
@@ -1203,9 +1203,33 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(setq tex-command slitex-run-command)
(setq tex-start-of-header "\\\\documentstyle{slides}\\|\\\\documentclass{slides}"))
+(defvar tildify-space-string)
+(defvar tildify-foreach-region-function)
+(defvar tex--prettify-symbols-alist)
+
(defun tex-common-initialization ()
;; Regexp isearch should accept newline and formfeed as whitespace.
(setq-local search-whitespace-regexp "[ \t\r\n\f]+")
+ ;; Use tilde as hard-space character in tildify package.
+ (setq-local tildify-space-string "~")
+ ;; FIXME: Use the fact that we're parsing the document already
+ ;; rather than using regex-based filtering.
+ (setq-local tildify-foreach-region-function
+ (apply-partially
+ 'tildify-foreach-ignore-environments
+ `(("\\\\\\\\" . "") ; do not remove this
+ (,(eval-when-compile
+ (concat "\\\\begin{\\("
+ (regexp-opt '("verbatim" "math" "displaymath"
+ "equation" "eqnarray" "eqnarray*"))
+ "\\)}"))
+ . ("\\\\end{" 1 "}"))
+ ("\\\\verb\\*?\\(.\\)" . (1))
+ ("\\$\\$?" . (0))
+ ("\\\\(" . "\\\\)")
+ ("\\\\[[]" . "\\\\[]]")
+ ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "")
+ ("%" . "$"))))
;; A line containing just $$ is treated as a paragraph separator.
(setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$")
;; A line starting with $$ starts a paragraph,
@@ -1223,7 +1247,7 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(setq-local facemenu-remove-face-function t)
(setq-local font-lock-defaults
'((tex-font-lock-keywords tex-font-lock-keywords-1
- tex-font-lock-keywords-2 tex-font-lock-keywords-3)
+ tex-font-lock-keywords-2 tex-font-lock-keywords-3)
nil nil nil nil
;; Who ever uses that anyway ???
(font-lock-mark-block-function . mark-paragraph)
@@ -1231,6 +1255,9 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
. tex-font-lock-syntactic-face-function)
(font-lock-unfontify-region-function
. tex-font-lock-unfontify-region)))
+ (setq-local prettify-symbols-alist tex--prettify-symbols-alist)
+ (add-function :override (local 'prettify-symbols-compose-predicate)
+ #'tex--prettify-symbols-compose-p)
(setq-local syntax-propertize-function
(syntax-propertize-rules latex-syntax-propertize-rules))
;; TABs in verbatim environments don't do what you think.
@@ -1273,22 +1300,56 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(defun tex-insert-quote (arg)
"Insert the appropriate quote marks for TeX.
-Inserts the value of `tex-open-quote' (normally ``) or `tex-close-quote'
-\(normally '') depending on the context. With prefix argument, always
+Inserts the value of `tex-open-quote' (normally \\=`\\=`) or `tex-close-quote'
+\(normally \\='\\=') depending on the context. With prefix argument, always
inserts \" characters."
(interactive "*P")
+ ;; Discover if we'll be inserting normal double quotes.
+ ;;
(if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\))
- (eq (get-text-property (point) 'face) 'tex-verbatim)
- (save-excursion
- (backward-char (length tex-open-quote))
- (when (or (looking-at (regexp-quote tex-open-quote))
- (looking-at (regexp-quote tex-close-quote)))
- (delete-char (length tex-open-quote))
- t)))
+ (eq (get-text-property (point) 'face) 'tex-verbatim)
+ ;; Discover if a preceding occurrence of `tex-open-quote'
+ ;; should be morphed to a normal double quote.
+ ;;
+ (and (>= (point) (+ (point-min) (length tex-open-quote)))
+ (save-excursion
+ (backward-char (length tex-open-quote))
+ (when (or (looking-at (regexp-quote tex-open-quote))
+ (looking-at (regexp-quote tex-close-quote)))
+ (delete-char (length tex-open-quote))
+ (when (looking-at (regexp-quote tex-close-quote))
+ (delete-char (length tex-close-quote)))
+ t))))
+ ;; Insert the normal quote (eventually letting
+ ;; `electric-pair-mode' do its thing).
+ ;;
(self-insert-command (prefix-numeric-value arg))
- (insert (if (or (memq (char-syntax (preceding-char)) '(?\( ?> ?\s))
- (memq (preceding-char) '(?~)))
- tex-open-quote tex-close-quote))))
+ ;; We'll be inserting fancy TeX quotes, but consider and imitate
+ ;; `electric-pair-mode''s two behaviors: pair-insertion and
+ ;; region wrapping.
+ ;;
+ (if (and electric-pair-mode (use-region-p))
+ (let* ((saved (point-marker)))
+ (goto-char (mark))
+ (insert (if (> saved (mark)) tex-open-quote tex-close-quote))
+ (goto-char saved)
+ (insert (if (> saved (mark)) tex-close-quote tex-open-quote)))
+ (if (or (memq (char-syntax (preceding-char)) '(?\( ?> ?\s))
+ (memq (preceding-char) '(?~ ?')))
+ ;; We're in an "opening" context
+ ;;
+ (if electric-pair-mode
+ (if (looking-at (regexp-quote tex-close-quote))
+ (forward-char (length tex-close-quote))
+ (insert tex-open-quote)
+ (insert tex-close-quote)
+ (backward-char (length tex-close-quote)))
+ (insert tex-open-quote))
+ ;; We're in a "closing" context.
+ ;;
+ (if (looking-at (regexp-quote tex-close-quote))
+ (forward-char (length tex-close-quote))
+ (insert tex-close-quote))))))
(defun tex-validate-buffer ()
"Check current buffer for paragraphs containing mismatched braces or $s.
@@ -1489,7 +1550,7 @@ Puts point on a blank line between them."
"\\end{" str "}" > \n)
(define-skeleton latex-insert-item
- "Insert a \item macro."
+ "Insert an \\item macro."
nil
\n "\\item " >)
@@ -1708,13 +1769,13 @@ Mark is left at original location."
;; A better way to handle this, \( .. \) etc, is probably to
;; temporarily change the syntax of the \ in \( to punctuation.
((and latex-handle-escaped-parens
- (looking-back "\\\\[])}]"))
+ (looking-back "\\\\[])}]" (- (point) 2)))
(signal 'scan-error
(list "Containing expression ends prematurely"
(- (point) 2) (prog1 (point)
(goto-char pos)))))
((and latex-handle-escaped-parens
- (looking-back "\\\\\\([({[]\\)"))
+ (looking-back "\\\\\\([({[]\\)" (- (point) 2)))
(tex-next-unmatched-eparen (match-string 1)))
(t (goto-char newpos))))))
@@ -1921,7 +1982,7 @@ In the tex shell buffer this command behaves like `comint-send-input'."
(display-buffer (tex-shell-buf))
(tex-recenter-output-buffer nil))
-(defun tex-shell-sentinel (proc msg)
+(defun tex-shell-sentinel (proc _msg)
(cond ((null (buffer-name (process-buffer proc)))
;; buffer killed
(set-process-buffer proc nil)
@@ -2573,18 +2634,28 @@ line LINE of the window, or centered if LINE is nil."
(prefix-numeric-value linenum)
(/ (window-height) 2)))))))
+(defcustom tex-print-file-extension ".dvi"
+ "The TeX-compiled file extension for viewing and printing.
+If you use pdflatex instead of latex, set this to \".pdf\" and modify
+ `tex-dvi-view-command' and `tex-dvi-print-command' appropriately."
+ :type 'string
+ :group 'tex-view
+ :version "25.1")
+
(defun tex-print (&optional alt)
"Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file].
Runs the shell command defined by `tex-dvi-print-command'. If prefix argument
is provided, use the alternative command, `tex-alt-dvi-print-command'."
(interactive "P")
- (let ((print-file-name-dvi (tex-append tex-print-file ".dvi"))
+ (let ((print-file-name-dvi (tex-append tex-print-file
+ tex-print-file-extension))
test-name)
(if (and (not (equal (current-buffer) tex-last-buffer-texed))
(buffer-file-name)
;; Check that this buffer's printed file is up to date.
(file-newer-than-file-p
- (setq test-name (tex-append (buffer-file-name) ".dvi"))
+ (setq test-name (tex-append (buffer-file-name)
+ tex-print-file-extension))
(buffer-file-name)))
(setq print-file-name-dvi test-name))
(if (not (file-exists-p print-file-name-dvi))
@@ -2680,6 +2751,8 @@ Runs the shell command defined by `tex-show-queue-command'."
(defvar tex-indent-item tex-indent-basic)
(defvar tex-indent-item-re "\\\\\\(bib\\)?item\\>")
(defvar latex-noindent-environments '("document"))
+(put 'latex-noindent-environments 'safe-local-variable
+ (lambda (x) (null (delq t (mapcar 'stringp x)))))
(defvar tex-latex-indent-syntax-table
(let ((st (make-syntax-table tex-mode-syntax-table)))
@@ -2689,10 +2762,11 @@ Runs the shell command defined by `tex-show-queue-command'."
st)
"Syntax table used while computing indentation.")
-(defun latex-indent (&optional arg)
+(defun latex-indent (&optional _arg)
(if (and (eq (get-text-property (if (and (eobp) (bolp))
(max (point-min) (1- (point)))
- (line-beginning-position)) 'face)
+ (line-beginning-position))
+ 'face)
'tex-verbatim))
'noindent
(with-syntax-table tex-latex-indent-syntax-table
@@ -2801,7 +2875,7 @@ There might be text before point."
(t
(let ((col (current-column)))
(if (or (not (eq (char-syntax (or (char-after pos) ?\s)) ?\())
- ;; Can't be an arg if there's an empty line inbetween.
+ ;; Can't be an arg if there's an empty line in between.
(save-excursion (re-search-forward "^[ \t]*$" pos t)))
;; If the first char was not an open-paren, there's
;; a risk that this is really not an argument to the
@@ -2874,6 +2948,487 @@ There might be text before point."
(setq-local syntax-propertize-function
(syntax-propertize-rules doctex-syntax-propertize-rules)))
+;;; Prettify Symbols Support
+
+(defvar tex--prettify-symbols-alist
+ '( ;; Lowercase Greek letters.
+ ("\\alpha" . ?α)
+ ("\\beta" . ?β)
+ ("\\gamma" . ?γ)
+ ("\\delta" . ?δ)
+ ("\\epsilon" . ?ϵ)
+ ("\\zeta" . ?ζ)
+ ("\\eta" . ?η)
+ ("\\theta" . ?θ)
+ ("\\iota" . ?ι)
+ ("\\kappa" . ?κ)
+ ("\\lambda" . ?λ)
+ ("\\mu" . ?μ)
+ ("\\nu" . ?ν)
+ ("\\xi" . ?ξ)
+ ;; There is no \omicron because it looks like a latin o.
+ ("\\pi" . ?π)
+ ("\\rho" . ?ρ)
+ ("\\sigma" . ?σ)
+ ("\\tau" . ?τ)
+ ("\\upsilon" . ?υ)
+ ("\\phi" . ?φ)
+ ("\\chi" . ?χ)
+ ("\\psi" . ?ψ)
+ ("\\omega" . ?ω)
+ ;; Uppercase Greek letters.
+ ("\\Gamma" . ?Γ)
+ ("\\Delta" . ?Δ)
+ ("\\Lambda" . ?Λ)
+ ("\\Phi" . ?Φ)
+ ("\\Pi" . ?Π)
+ ("\\Psi" . ?Ψ)
+ ("\\Sigma" . ?Σ)
+ ("\\Theta" . ?Θ)
+ ("\\Upsilon" . ?Υ)
+ ("\\Xi" . ?Ξ)
+ ("\\Omega" . ?Ω)
+
+ ;; Other math symbols (taken from leim/quail/latin-ltx.el).
+ ("\\Box" . ?□)
+ ("\\Bumpeq" . ?≎)
+ ("\\Cap" . ?⋒)
+ ("\\Cup" . ?⋓)
+ ("\\Diamond" . ?◇)
+ ("\\Downarrow" . ?⇓)
+ ("\\H{o}" . ?ő)
+ ("\\Im" . ?ℑ)
+ ("\\Join" . ?⋈)
+ ("\\Leftarrow" . ?⇐)
+ ("\\Leftrightarrow" . ?⇔)
+ ("\\Ll" . ?⋘)
+ ("\\Lleftarrow" . ?⇚)
+ ("\\Longleftarrow" . ?⇐)
+ ("\\Longleftrightarrow" . ?⇔)
+ ("\\Longrightarrow" . ?⇒)
+ ("\\Lsh" . ?↰)
+ ("\\Re" . ?ℜ)
+ ("\\Rightarrow" . ?⇒)
+ ("\\Rrightarrow" . ?⇛)
+ ("\\Rsh" . ?↱)
+ ("\\Subset" . ?⋐)
+ ("\\Supset" . ?⋑)
+ ("\\Uparrow" . ?⇑)
+ ("\\Updownarrow" . ?⇕)
+ ("\\Vdash" . ?⊩)
+ ("\\Vert" . ?‖)
+ ("\\Vvdash" . ?⊪)
+ ("\\aleph" . ?ℵ)
+ ("\\amalg" . ?∐)
+ ("\\angle" . ?∠)
+ ("\\approx" . ?≈)
+ ("\\approxeq" . ?≊)
+ ("\\ast" . ?∗)
+ ("\\asymp" . ?≍)
+ ("\\backcong" . ?≌)
+ ("\\backepsilon" . ?∍)
+ ("\\backprime" . ?‵)
+ ("\\backsim" . ?∽)
+ ("\\backsimeq" . ?⋍)
+ ("\\backslash" . ?\\)
+ ("\\barwedge" . ?⊼)
+ ("\\because" . ?∵)
+ ("\\beth" . ?ℶ)
+ ("\\between" . ?≬)
+ ("\\bigcap" . ?⋂)
+ ("\\bigcirc" . ?◯)
+ ("\\bigcup" . ?⋃)
+ ("\\bigstar" . ?★)
+ ("\\bigtriangledown" . ?▽)
+ ("\\bigtriangleup" . ?△)
+ ("\\bigvee" . ?⋁)
+ ("\\bigwedge" . ?⋀)
+ ("\\blacklozenge" . ?✦)
+ ("\\blacksquare" . ?▪)
+ ("\\blacktriangle" . ?▴)
+ ("\\blacktriangledown" . ?▾)
+ ("\\blacktriangleleft" . ?◂)
+ ("\\blacktriangleright" . ?▸)
+ ("\\bot" . ?⊥)
+ ("\\bowtie" . ?⋈)
+ ("\\boxminus" . ?⊟)
+ ("\\boxplus" . ?⊞)
+ ("\\boxtimes" . ?⊠)
+ ("\\bullet" . ?•)
+ ("\\bumpeq" . ?≏)
+ ("\\cap" . ?∩)
+ ("\\cdots" . ?⋯)
+ ("\\centerdot" . ?·)
+ ("\\checkmark" . ?✓)
+ ("\\chi" . ?χ)
+ ("\\cdot" . ?⋅)
+ ("\\cdots" . ?⋯)
+ ("\\circ" . ?∘)
+ ("\\circeq" . ?≗)
+ ("\\circlearrowleft" . ?↺)
+ ("\\circlearrowright" . ?↻)
+ ("\\circledR" . ?®)
+ ("\\circledS" . ?Ⓢ)
+ ("\\circledast" . ?⊛)
+ ("\\circledcirc" . ?⊚)
+ ("\\circleddash" . ?⊝)
+ ("\\clubsuit" . ?♣)
+ ("\\coloneq" . ?≔)
+ ("\\complement" . ?∁)
+ ("\\cong" . ?≅)
+ ("\\coprod" . ?∐)
+ ("\\cup" . ?∪)
+ ("\\curlyeqprec" . ?⋞)
+ ("\\curlyeqsucc" . ?⋟)
+ ("\\curlypreceq" . ?≼)
+ ("\\curlyvee" . ?⋎)
+ ("\\curlywedge" . ?⋏)
+ ("\\curvearrowleft" . ?↶)
+ ("\\curvearrowright" . ?↷)
+ ("\\dag" . ?†)
+ ("\\dagger" . ?†)
+ ("\\daleth" . ?ℸ)
+ ("\\dashv" . ?⊣)
+ ("\\ddag" . ?‡)
+ ("\\ddagger" . ?‡)
+ ("\\ddots" . ?⋱)
+ ("\\diamond" . ?⋄)
+ ("\\diamondsuit" . ?♢)
+ ("\\divideontimes" . ?⋇)
+ ("\\doteq" . ?≐)
+ ("\\doteqdot" . ?≑)
+ ("\\dotplus" . ?∔)
+ ("\\dotsquare" . ?⊡)
+ ("\\downarrow" . ?↓)
+ ("\\downdownarrows" . ?⇊)
+ ("\\downleftharpoon" . ?⇃)
+ ("\\downrightharpoon" . ?⇂)
+ ("\\ell" . ?ℓ)
+ ("\\emptyset" . ?∅)
+ ("\\eqcirc" . ?≖)
+ ("\\eqcolon" . ?≕)
+ ("\\eqslantgtr" . ?⋝)
+ ("\\eqslantless" . ?⋜)
+ ("\\equiv" . ?≡)
+ ("\\exists" . ?∃)
+ ("\\fallingdotseq" . ?≒)
+ ("\\flat" . ?♭)
+ ("\\forall" . ?∀)
+ ("\\frown" . ?⌢)
+ ("\\ge" . ?≥)
+ ("\\geq" . ?≥)
+ ("\\geqq" . ?≧)
+ ("\\geqslant" . ?≥)
+ ("\\gets" . ?←)
+ ("\\gg" . ?≫)
+ ("\\ggg" . ?⋙)
+ ("\\gimel" . ?ℷ)
+ ("\\gnapprox" . ?⋧)
+ ("\\gneq" . ?≩)
+ ("\\gneqq" . ?≩)
+ ("\\gnsim" . ?⋧)
+ ("\\gtrapprox" . ?≳)
+ ("\\gtrdot" . ?⋗)
+ ("\\gtreqless" . ?⋛)
+ ("\\gtreqqless" . ?⋛)
+ ("\\gtrless" . ?≷)
+ ("\\gtrsim" . ?≳)
+ ("\\gvertneqq" . ?≩)
+ ("\\hbar" . ?ℏ)
+ ("\\heartsuit" . ?♥)
+ ("\\hookleftarrow" . ?↩)
+ ("\\hookrightarrow" . ?↪)
+ ("\\iff" . ?⇔)
+ ("\\imath" . ?ı)
+ ("\\in" . ?∈)
+ ("\\infty" . ?∞)
+ ("\\int" . ?∫)
+ ("\\intercal" . ?⊺)
+ ("\\langle" . 10216) ; Literal ?⟨ breaks indentation.
+ ("\\lbrace" . ?{)
+ ("\\lbrack" . ?\[)
+ ("\\lceil" . ?⌈)
+ ("\\ldots" . ?…)
+ ("\\le" . ?≤)
+ ("\\leadsto" . ?↝)
+ ("\\leftarrow" . ?←)
+ ("\\leftarrowtail" . ?↢)
+ ("\\leftharpoondown" . ?↽)
+ ("\\leftharpoonup" . ?↼)
+ ("\\leftleftarrows" . ?⇇)
+ ;; ("\\leftparengtr" ?〈), see bug#12948.
+ ("\\leftrightarrow" . ?↔)
+ ("\\leftrightarrows" . ?⇆)
+ ("\\leftrightharpoons" . ?⇋)
+ ("\\leftrightsquigarrow" . ?↭)
+ ("\\leftthreetimes" . ?⋋)
+ ("\\leq" . ?≤)
+ ("\\leqq" . ?≦)
+ ("\\leqslant" . ?≤)
+ ("\\lessapprox" . ?≲)
+ ("\\lessdot" . ?⋖)
+ ("\\lesseqgtr" . ?⋚)
+ ("\\lesseqqgtr" . ?⋚)
+ ("\\lessgtr" . ?≶)
+ ("\\lesssim" . ?≲)
+ ("\\lfloor" . ?⌊)
+ ("\\lhd" . ?◁)
+ ("\\rhd" . ?▷)
+ ("\\ll" . ?≪)
+ ("\\llcorner" . ?⌞)
+ ("\\lnapprox" . ?⋦)
+ ("\\lneq" . ?≨)
+ ("\\lneqq" . ?≨)
+ ("\\lnsim" . ?⋦)
+ ("\\longleftarrow" . ?←)
+ ("\\longleftrightarrow" . ?↔)
+ ("\\longmapsto" . ?↦)
+ ("\\longrightarrow" . ?→)
+ ("\\looparrowleft" . ?↫)
+ ("\\looparrowright" . ?↬)
+ ("\\lozenge" . ?✧)
+ ("\\lq" . ?‘)
+ ("\\lrcorner" . ?⌟)
+ ("\\ltimes" . ?⋉)
+ ("\\lvertneqq" . ?≨)
+ ("\\maltese" . ?✠)
+ ("\\mapsto" . ?↦)
+ ("\\measuredangle" . ?∡)
+ ("\\mho" . ?℧)
+ ("\\mid" . ?∣)
+ ("\\models" . ?⊧)
+ ("\\mp" . ?∓)
+ ("\\multimap" . ?⊸)
+ ("\\nLeftarrow" . ?⇍)
+ ("\\nLeftrightarrow" . ?⇎)
+ ("\\nRightarrow" . ?⇏)
+ ("\\nVDash" . ?⊯)
+ ("\\nVdash" . ?⊮)
+ ("\\nabla" . ?∇)
+ ("\\napprox" . ?≉)
+ ("\\natural" . ?♮)
+ ("\\ncong" . ?≇)
+ ("\\ne" . ?≠)
+ ("\\nearrow" . ?↗)
+ ("\\neg" . ?¬)
+ ("\\neq" . ?≠)
+ ("\\nequiv" . ?≢)
+ ("\\newline" . ?
)
+ ("\\nexists" . ?∄)
+ ("\\ngeq" . ?≱)
+ ("\\ngeqq" . ?≱)
+ ("\\ngeqslant" . ?≱)
+ ("\\ngtr" . ?≯)
+ ("\\ni" . ?∋)
+ ("\\nleftarrow" . ?↚)
+ ("\\nleftrightarrow" . ?↮)
+ ("\\nleq" . ?≰)
+ ("\\nleqq" . ?≰)
+ ("\\nleqslant" . ?≰)
+ ("\\nless" . ?≮)
+ ("\\nmid" . ?∤)
+ ;; ("\\not" ?̸) ;FIXME: conflict with "NOT SIGN" ¬.
+ ("\\notin" . ?∉)
+ ("\\nparallel" . ?∦)
+ ("\\nprec" . ?⊀)
+ ("\\npreceq" . ?⋠)
+ ("\\nrightarrow" . ?↛)
+ ("\\nshortmid" . ?∤)
+ ("\\nshortparallel" . ?∦)
+ ("\\nsim" . ?≁)
+ ("\\nsimeq" . ?≄)
+ ("\\nsubset" . ?⊄)
+ ("\\nsubseteq" . ?⊈)
+ ("\\nsubseteqq" . ?⊈)
+ ("\\nsucc" . ?⊁)
+ ("\\nsucceq" . ?⋡)
+ ("\\nsupset" . ?⊅)
+ ("\\nsupseteq" . ?⊉)
+ ("\\nsupseteqq" . ?⊉)
+ ("\\ntriangleleft" . ?⋪)
+ ("\\ntrianglelefteq" . ?⋬)
+ ("\\ntriangleright" . ?⋫)
+ ("\\ntrianglerighteq" . ?⋭)
+ ("\\nvDash" . ?⊭)
+ ("\\nvdash" . ?⊬)
+ ("\\nwarrow" . ?↖)
+ ("\\odot" . ?⊙)
+ ("\\oint" . ?∮)
+ ("\\ominus" . ?⊖)
+ ("\\oplus" . ?⊕)
+ ("\\oslash" . ?⊘)
+ ("\\otimes" . ?⊗)
+ ("\\par" . ?
)
+ ("\\parallel" . ?∥)
+ ("\\partial" . ?∂)
+ ("\\perp" . ?⊥)
+ ("\\pitchfork" . ?⋔)
+ ("\\prec" . ?≺)
+ ("\\precapprox" . ?≾)
+ ("\\preceq" . ?≼)
+ ("\\precnapprox" . ?⋨)
+ ("\\precnsim" . ?⋨)
+ ("\\precsim" . ?≾)
+ ("\\prime" . ?′)
+ ("\\prod" . ?∏)
+ ("\\propto" . ?∝)
+ ("\\qed" . ?∎)
+ ("\\qquad" . ?⧢)
+ ("\\quad" . ?␣)
+ ("\\rangle" . 10217) ; Literal ?⟩ breaks indentation.
+ ("\\rbrace" . ?})
+ ("\\rbrack" . ?\])
+ ("\\rceil" . ?⌉)
+ ("\\rfloor" . ?⌋)
+ ("\\rightarrow" . ?→)
+ ("\\rightarrowtail" . ?↣)
+ ("\\rightharpoondown" . ?⇁)
+ ("\\rightharpoonup" . ?⇀)
+ ("\\rightleftarrows" . ?⇄)
+ ("\\rightleftharpoons" . ?⇌)
+ ;; ("\\rightparengtr" ?⦔) ;; Was ?〉, see bug#12948.
+ ("\\rightrightarrows" . ?⇉)
+ ("\\rightthreetimes" . ?⋌)
+ ("\\risingdotseq" . ?≓)
+ ("\\rtimes" . ?⋊)
+ ("\\sbs" . ?﹨)
+ ("\\searrow" . ?↘)
+ ("\\setminus" . ?∖)
+ ("\\sharp" . ?♯)
+ ("\\shortmid" . ?∣)
+ ("\\shortparallel" . ?∥)
+ ("\\sim" . ?∼)
+ ("\\simeq" . ?≃)
+ ("\\smallamalg" . ?∐)
+ ("\\smallsetminus" . ?∖)
+ ("\\smallsmile" . ?⌣)
+ ("\\smile" . ?⌣)
+ ("\\spadesuit" . ?♠)
+ ("\\sphericalangle" . ?∢)
+ ("\\sqcap" . ?⊓)
+ ("\\sqcup" . ?⊔)
+ ("\\sqsubset" . ?⊏)
+ ("\\sqsubseteq" . ?⊑)
+ ("\\sqsupset" . ?⊐)
+ ("\\sqsupseteq" . ?⊒)
+ ("\\square" . ?□)
+ ("\\squigarrowright" . ?⇝)
+ ("\\star" . ?⋆)
+ ("\\straightphi" . ?φ)
+ ("\\subset" . ?⊂)
+ ("\\subseteq" . ?⊆)
+ ("\\subseteqq" . ?⊆)
+ ("\\subsetneq" . ?⊊)
+ ("\\subsetneqq" . ?⊊)
+ ("\\succ" . ?≻)
+ ("\\succapprox" . ?≿)
+ ("\\succcurlyeq" . ?≽)
+ ("\\succeq" . ?≽)
+ ("\\succnapprox" . ?⋩)
+ ("\\succnsim" . ?⋩)
+ ("\\succsim" . ?≿)
+ ("\\sum" . ?∑)
+ ("\\supset" . ?⊃)
+ ("\\supseteq" . ?⊇)
+ ("\\supseteqq" . ?⊇)
+ ("\\supsetneq" . ?⊋)
+ ("\\supsetneqq" . ?⊋)
+ ("\\surd" . ?√)
+ ("\\swarrow" . ?↙)
+ ("\\therefore" . ?∴)
+ ("\\thickapprox" . ?≈)
+ ("\\thicksim" . ?∼)
+ ("\\to" . ?→)
+ ("\\top" . ?⊤)
+ ("\\triangle" . ?▵)
+ ("\\triangledown" . ?▿)
+ ("\\triangleleft" . ?◃)
+ ("\\trianglelefteq" . ?⊴)
+ ("\\triangleq" . ?≜)
+ ("\\triangleright" . ?▹)
+ ("\\trianglerighteq" . ?⊵)
+ ("\\twoheadleftarrow" . ?↞)
+ ("\\twoheadrightarrow" . ?↠)
+ ("\\ulcorner" . ?⌜)
+ ("\\uparrow" . ?↑)
+ ("\\updownarrow" . ?↕)
+ ("\\upleftharpoon" . ?↿)
+ ("\\uplus" . ?⊎)
+ ("\\uprightharpoon" . ?↾)
+ ("\\upuparrows" . ?⇈)
+ ("\\urcorner" . ?⌝)
+ ("\\u{i}" . ?ĭ)
+ ("\\vDash" . ?⊨)
+ ("\\varepsilon" . ?ε)
+ ("\\varprime" . ?′)
+ ("\\varpropto" . ?∝)
+ ("\\varrho" . ?ϱ)
+ ;; ("\\varsigma" ?ς) ;FIXME: Looks reversed with the non\var.
+ ("\\vartriangleleft" . ?⊲)
+ ("\\vartriangleright" . ?⊳)
+ ("\\vdash" . ?⊢)
+ ("\\vdots" . ?⋮)
+ ("\\vee" . ?∨)
+ ("\\veebar" . ?⊻)
+ ("\\vert" . ?|)
+ ("\\wedge" . ?∧)
+ ("\\wp" . ?℘)
+ ("\\wr" . ?≀)
+ ("\\Bbb{N}" . ?ℕ) ; AMS commands for blackboard bold
+ ("\\Bbb{P}" . ?ℙ) ; Also sometimes \mathbb.
+ ("\\Bbb{Q}" . ?ℚ)
+ ("\\Bbb{R}" . ?ℝ)
+ ("\\Bbb{Z}" . ?ℤ)
+ ("--" . ?–)
+ ("---" . ?—)
+ ("\\ordfeminine" . ?ª)
+ ("\\ordmasculine" . ?º)
+ ("\\lambdabar" . ?ƛ)
+ ("\\celsius" . ?℃)
+ ("\\textmu" . ?µ)
+ ("\\textfractionsolidus" . ?⁄)
+ ("\\textbigcircle" . ?⃝)
+ ("\\textmusicalnote" . ?♪)
+ ("\\textdied" . ?✝)
+ ("\\textcolonmonetary" . ?₡)
+ ("\\textwon" . ?₩)
+ ("\\textnaira" . ?₦)
+ ("\\textpeso" . ?₱)
+ ("\\textlira" . ?₤)
+ ("\\textrecipe" . ?℞)
+ ("\\textinterrobang" . ?‽)
+ ("\\textpertenthousand" . ?‱)
+ ("\\textbaht" . ?฿)
+ ("\\textnumero" . ?№)
+ ("\\textdiscount" . ?⁒)
+ ("\\textestimated" . ?℮)
+ ("\\textopenbullet" . ?◦)
+ ("\\textlquill" . 8261) ; Literal ?⁅ breaks indentation.
+ ("\\textrquill" . 8262) ; Literal ?⁆ breaks indentation.
+ ("\\textcircledP" . ?℗)
+ ("\\textreferencemark" . ?※))
+ "A `prettify-symbols-alist' usable for (La)TeX modes.")
+
+(defun tex--prettify-symbols-compose-p (_start end _match)
+ (or
+ ;; If the matched symbol doesn't end in a word character, then we
+ ;; simply allow composition. The symbol is probably something like
+ ;; \|, \(, etc.
+ (not (eq ?w (char-syntax (char-before end))))
+ ;; Else we look at what follows the match in order to decide.
+ (let* ((after-char (char-after end))
+ (after-syntax (char-syntax after-char)))
+ (not (or
+ ;; Don't compose \alpha@foo.
+ (eq after-char ?@)
+ ;; The \alpha in \alpha2 or \alpha-\beta may be composed but
+ ;; of course \alphax may not.
+ (and (eq after-syntax ?w)
+ (not (memq after-char
+ '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?+ ?- ?' ?\"))))
+ ;; Don't compose inside verbatim blocks.
+ (eq 2 (nth 7 (syntax-ppss))))))))
+
(run-hooks 'tex-mode-load-hook)
(provide 'tex-mode)
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index ed6ed4932e9..500c1e38394 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -1,6 +1,6 @@
;;; texinfmt.el --- format Texinfo files into Info files
-;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2013 Free Software
+;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org>
@@ -34,7 +34,7 @@
If optional argument HERE is non-nil, insert info at point."
(interactive "P")
(let ((version-string
- (format "Version of \`texinfmt.el\': %s" texinfmt-version)))
+ (format-message "Version of `texinfmt.el': %s" texinfmt-version)))
(if here
(insert version-string)
(if (called-interactively-p 'interactive)
@@ -330,25 +330,24 @@ converted to Info is stored in a temporary buffer."
(let ((arg (texinfo-parse-arg-discard)))
(insert " "
texinfo-region-buffer-name
- " buffer for: `")
+ (format-message " buffer for: `"))
(insert (file-name-nondirectory (expand-file-name arg)))
- (insert "', -*-Text-*-\n")))
+ (insert (format-message "', -*-Text-*-\n"))))
;; Else no `@setfilename' line
(insert " "
texinfo-region-buffer-name
" buffer -*-Text-*-\n"))
- (insert "produced by `texinfo-format-region'\n"
+ (insert (format-message "produced by `texinfo-format-region'\n")
"from a region in: "
(if (buffer-file-name input-buffer)
- (concat "`"
- (file-name-sans-versions
- (file-name-nondirectory
- (buffer-file-name input-buffer)))
- "'")
- (concat "buffer `" (buffer-name input-buffer) "'"))
- "\nusing `texinfmt.el' version "
- texinfmt-version
- ".\n\n")
+ (format-message "`%s'"
+ (file-name-sans-versions
+ (file-name-nondirectory
+ (buffer-file-name input-buffer))))
+ (format-message "buffer `%s'" (buffer-name input-buffer)))
+ (format-message "\nusing `texinfmt.el' version ")
+ texinfmt-version
+ ".\n\n")
;; Now convert for real.
(goto-char (point-min))
@@ -479,19 +478,18 @@ if large. You can use `Info-split' to do this manually."
;; Insert info about how this file was made.
(insert "Info file: "
texinfo-format-filename ", -*-Text-*-\n"
- "produced by `texinfo-format-buffer'\n"
+ (format-message "produced by `texinfo-format-buffer'\n")
;; Date string removed so that regression testing is easier.
;; "on "
;; (insert (format-time-string "%e %b %Y")) " "
"from file"
(if (buffer-file-name input-buffer)
- (concat " `"
+ (format-message " `%s'"
(file-name-sans-versions
(file-name-nondirectory
- (buffer-file-name input-buffer)))
- "'")
- (concat "buffer `" (buffer-name input-buffer) "'"))
- "\nusing `texinfmt.el' version "
+ (buffer-file-name input-buffer))))
+ (format-message "buffer `%s'" (buffer-name input-buffer)))
+ (format-message "\nusing `texinfmt.el' version ")
texinfmt-version
".\n\n")
;; Return data for indices.
@@ -1045,7 +1043,7 @@ Leave point after argument."
(setq texinfo-command-end (point)))
(t
(error
- "Invalid `texinfo-optional-braces-discard' format \(need braces?\)")))
+ "Invalid `texinfo-optional-braces-discard' format (need braces?)")))
(delete-region texinfo-command-start texinfo-command-end)))
(defun texinfo-format-parse-line-args ()
@@ -1287,7 +1285,7 @@ Leave point after argument."
(put 'uref 'texinfo-format 'texinfo-format-uref)
(defun texinfo-format-uref ()
"Format URL and optional URL-TITLE.
-Insert ` ... ' around URL if no URL-TITLE argument;
+Insert \\=` ... \\=' around URL if no URL-TITLE argument;
otherwise, insert URL-TITLE followed by URL in parentheses."
(let ((args (texinfo-format-parse-args)))
(texinfo-discard-command)
@@ -2338,7 +2336,7 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image."
;; Write a `@definfoenclose' command on a line and follow it with three
;; arguments separated by commas (commas are used as separators in an
;; `@node' line in the same way). The first argument to
-;; `@definfoenclose' is the @-command name \(without the `@'\); the
+;; `@definfoenclose' is the @-command name (without the `@'); the
;; second argument is the Info start delimiter string; and the third
;; argument is the Info end delimiter string. The latter two arguments
;; enclose the highlighted text in the Info file. A delimiter string
@@ -2447,7 +2445,7 @@ Use only the FILENAME arg; for Info, ignore the other arguments to @image."
;; not lead to inserted ` ... ' in a table, but does elsewhere.
(put 'option 'texinfo-format 'texinfo-format-option)
(defun texinfo-format-option ()
- "Insert ` ... ' around arg unless inside a table; in that case, no quotes."
+ "Insert \\=` ... \\=' around arg unless inside a table; in that case, no quotes."
;; `looking-at-backward' not available in v. 18.57, 20.2
(if (not (search-backward "" ; searched-for character is a control-H
(line-beginning-position)
@@ -2493,8 +2491,8 @@ surrounded by in angle brackets."
Enclose the verbatim text, including the delimiters, in braces. Print
text exactly as written (but not the delimiters) in a fixed-width.
-For example, @verb\{|@|\} results in @ and
-@verb\{+@'e?`!`+} results in @'e?`!`."
+For example, @verb{|@|} results in @ and
+@verb{+@\\='e?\\=`!\\=`+} results in @\\='e?\\=`!\\=`."
(let ((delimiter (buffer-substring-no-properties
(1+ texinfo-command-end) (+ 2 texinfo-command-end))))
@@ -3127,7 +3125,7 @@ Default is to leave paragraph indentation as is."
;; (put '\` 'texinfo-format 'texinfo-format-grave-accent)
;; (defun texinfo-format-grave-accent ()
;; (texinfo-discard-command)
-;; (insert "\`"))
+;; (insert "`"))
;;
;; @' ==> ' acute accent
;; (put '\' 'texinfo-format 'texinfo-format-acute-accent)
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 44e839d2474..2b606ed002e 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,11 +1,11 @@
-;;; texinfo.el --- major mode for editing Texinfo files -*- coding: utf-8 -*-
+;;; texinfo.el --- major mode for editing Texinfo files
-;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2013 Free Software
+;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Robert J. Chassell
;; Date: [See date below for texinfo-version]
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: maint, tex, docs
;; This file is part of GNU Emacs.
@@ -44,6 +44,8 @@
(defvar outline-heading-alist)
+(defvar skeleton-end-newline)
+
(defgroup texinfo nil
"Texinfo Mode."
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
@@ -84,7 +86,7 @@ command to gain use of `next-error'."
"Make Info file from current buffer.
Use the \\[next-error] command to move to the next error
-\(if there are errors\)."
+\(if there are errors)."
t nil)
(autoload 'kill-compilation
@@ -626,6 +628,11 @@ value of `texinfo-mode-hook'."
(setq-local tex-first-line-header-regexp "^\\\\input")
(setq-local tex-trailer "@bye\n")
+ ;; Prevent skeleton.el from adding a newline to each inserted
+ ;; skeleton. Those which do want a newline do that explicitly in
+ ;; their define-skeleton form.
+ (setq-local skeleton-end-newline nil)
+
;; Prevent filling certain lines, in addition to ones specified by
;; the user.
(setq-local auto-fill-inhibit-regexp
@@ -653,7 +660,7 @@ Puts point on a blank line between them."
(if (or (string-match "\\`def" str)
(member str '("table" "ftable" "vtable")))
'(nil " " -))
- \n _ \n "@end " str \n)
+ \n _ \n "@end " str \n \n)
(defun texinfo-inside-macro-p (macro &optional bound)
"Non-nil if inside a macro matching the regexp MACRO."
@@ -682,8 +689,8 @@ Puts point on a blank line between them."
'("example\\>" "smallexample\\>" "lisp\\>"))
(defun texinfo-insert-quote (&optional arg)
"Insert the appropriate quote mark for Texinfo.
-Usually inserts the value of `texinfo-open-quote' (normally ``) or
-`texinfo-close-quote' (normally ''), depending on the context.
+Usually inserts the value of `texinfo-open-quote' (normally \\=`\\=`) or
+`texinfo-close-quote' (normally \\='\\='), depending on the context.
With prefix argument or inside @code or @example, inserts a plain \"."
(interactive "*P")
(let ((top (or (save-excursion (re-search-backward "@node\\>" nil t))
@@ -732,7 +739,7 @@ With prefix argument or inside @code or @example, inserts a plain \"."
(backward-word 1)
(texinfo-last-unended-begin)
(or (match-string 1) '-)))
- \n "@end " str \n)
+ \n "@end " str \n \n)
(define-skeleton texinfo-insert-braces
"Make a pair of braces and be poised to type inside of them.
@@ -771,7 +778,7 @@ The default is not to surround any existing words with the braces."
(define-skeleton texinfo-insert-@example
"Insert the string `@example' in a Texinfo buffer."
nil
- \n "@example" \n)
+ \n "@example" \n \n)
(define-skeleton texinfo-insert-@file
"Insert a `@file{...}' command in a Texinfo buffer.
@@ -816,7 +823,7 @@ Leave point after `@node'."
(define-skeleton texinfo-insert-@quotation
"Insert the string `@quotation' in a Texinfo buffer."
- \n "@quotation" \n)
+ \n "@quotation" \n _ \n)
(define-skeleton texinfo-insert-@samp
"Insert a `@samp{...}' command in a Texinfo buffer.
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index 40c96ad5fb5..321967a3721 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1,6 +1,6 @@
;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
-;; Copyright (C) 1989-1992, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1992, 2001-2015 Free Software Foundation, Inc.
;; Author: Robert J. Chassell
;; Maintainer: bug-texinfo@gnu.org
@@ -694,8 +694,8 @@ section titles are often too short to explain a node well.
MENU-LIST has form:
- \(\(\"node-name1\" . \"description\"\)
- \(\"node-name2\" . \"description\"\) ... \)
+ ((\"node-name1\" . \"description\")
+ (\"node-name2\" . \"description\") ... )
However, the description field might be nil.
@@ -893,7 +893,7 @@ first update all existing menus in the buffer (incorporating
descriptions from pre-existing menus) before it constructs the
master menu. If the argument is numeric (e.g., \"C-u 2\"),
update all existing nodes as well, by calling
-\`texinfo-update-node' on the entire file. Warning: do NOT
+`texinfo-update-node' on the entire file. Warning: do NOT
invoke with a numeric argument if your Texinfo file uses @node
lines without the `Next', `Previous', `Up' pointers, as the
result could be an invalid Texinfo file!
@@ -1002,9 +1002,9 @@ following menu and the title of the node preceding that menu.
The master menu list has this form:
- \(\(\(... \"entry-1-2\" \"entry-1\"\) \"title-1\"\)
- \(\(... \"entry-2-2\" \"entry-2-1\"\) \"title-2\"\)
- ...\)
+ (((... \"entry-1-2\" \"entry-1\") \"title-1\")
+ ((... \"entry-2-2\" \"entry-2-1\") \"title-2\")
+ ...)
However, there does not need to be a title field."
@@ -1018,7 +1018,7 @@ However, there does not need to be a title field."
"Format and insert the master menu in the current buffer."
(goto-char (point-min))
;; Insert a master menu only after `Top' node and before next node
- ;; \(or include file if there is no next node\).
+ ;; (or include file if there is no next node).
(unless (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)
(error "This buffer needs a Top node"))
(let ((first-chapter
@@ -1145,24 +1145,40 @@ For example, \"unnumberedsubsec\". Return \"top\" for top node.
Searches forward for a section. Hence, point must be before the
section whose type will be found. Does not move point. Signal an
error if the node is not the top node and a section is not found."
- (let ((case-fold-search t))
- (save-excursion
- (cond
- ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
- ;; Following search limit by cph but causes a bug
- ;;(line-end-position)
- nil
- t)
- "top")
- ((re-search-forward texinfo-section-types-regexp nil t)
- (buffer-substring-no-properties
- (progn (beginning-of-line) ; copy its name
- (1+ (point)))
- (progn (forward-word 1)
- (point))))
- (t
- (error
- "texinfo-specific-section-type: Chapter or section not found"))))))
+ (let* ((case-fold-search t)
+ ;; The Texinfo manual has a second Top node inside @verbatim
+ ;; near the end, which dupes us into thinking we are at top
+ ;; level, no matter where we are when invoked. We don't
+ ;; really grok @verbatim, so we cheat: only consider us to be
+ ;; at top level if the position of the Top node we found is
+ ;; before any other sectioning command.
+ (top-pos (save-excursion
+ (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
+ ;; Following search limit causes a bug
+ ;;(line-end-position)
+ nil
+ t)))
+ (sec-pos (save-excursion
+ (re-search-forward texinfo-section-types-regexp nil t)))
+ sec-name)
+ (if sec-pos
+ (save-excursion
+ (goto-char sec-pos)
+ (setq sec-name (buffer-substring-no-properties
+ (progn (beginning-of-line) ; copy its name
+ (1+ (point)))
+ (progn (forward-word 1)
+ (point))))))
+ (cond
+ ((or sec-pos top-pos)
+ (if (and top-pos sec-pos)
+ (if (< top-pos sec-pos)
+ "top"
+ sec-name)
+ (or sec-name "top")))
+ (t
+ (error
+ "texinfo-specific-section-type: Chapter or section not found")))))
(defun texinfo-hierarchic-level ()
"Return the general hierarchical level of the next node in a texinfo file.
@@ -1391,7 +1407,7 @@ level in the Texinfo file; when looking for the `Previous' pointer,
the section found will be at the same or higher hierarchical level in
the Texinfo file; when looking for the `Up' pointer, the section found
will be at some level higher in the Texinfo file. The fourth argument
-\(one of 'next, 'previous, or 'up\) specifies whether to find the
+\(one of `next', `previous', or `up') specifies whether to find the
`Next', `Previous', or `Up' pointer."
(let ((case-fold-search t))
(cond ((eq direction 'next)
@@ -1834,8 +1850,8 @@ chapters."
;; The menu-list has the form:
;;
-;; \(\(\"node-name1\" . \"title1\"\)
-;; \(\"node-name2\" . \"title2\"\) ... \)
+;; ((\"node-name1\" . \"title1\")
+;; (\"node-name2\" . \"title2\") ... )
;;
;; However, there does not need to be a title field and this function
;; does not fill it; however a comment tells you how to do so.
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index d9ff04c9b2f..1466556ab59 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -1,9 +1,9 @@
;;; text-mode.el --- text mode, and its idiosyncratic commands
-;; Copyright (C) 1985, 1992, 1994, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1985, 1992, 1994, 2001-2015 Free Software Foundation,
;; Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; Package: emacs
@@ -29,7 +29,9 @@
;;; Code:
-(defcustom text-mode-hook nil
+;; Normally non-nil defaults for hooks are bad, but since this file is
+;; preloaded it's ok/better, and avoids this showing up in customize-rogue.
+(defcustom text-mode-hook '(text-mode-hook-identify)
"Normal hook run when entering Text mode and many related modes."
:type 'hook
:options '(turn-on-auto-fill turn-on-flyspell)
@@ -45,12 +47,50 @@ Use (derived-mode-p 'text-mode) instead.")
(modify-syntax-entry ?\\ ". " st)
;; We add `p' so that M-c on 'hello' leads to 'Hello' rather than 'hello'.
(modify-syntax-entry ?' "w p" st)
+ ;; UAX #29 says HEBREW PUNCTUATION GERESH behaves like a letter
+ ;; for the purposes of finding word boundaries.
+ (modify-syntax-entry #x5f3 "w ") ; GERESH
+ ;; UAX #29 says HEBREW PUNCTUATION GERSHAYIM should not be a word
+ ;; boundary when surrounded by letters. Our infrastructure for
+ ;; finding a word boundary doesn't support 3-character
+ ;; definitions, so for now simply make this a word-constituent
+ ;; character. This leaves a problem of having GERSHAYIM at the
+ ;; beginning or end of a word, where it should be a boundary;
+ ;; FIXME.
+ (modify-syntax-entry #x5f4 "w ") ; GERSHAYIM
+ ;; These all should not be a word boundary when between letters,
+ ;; according to UAX #29, so they again are prone to the same
+ ;; problem as GERSHAYIM; FIXME.
+ (modify-syntax-entry #xb7 "w ") ; MIDDLE DOT
+ (modify-syntax-entry #x2027 "w ") ; HYPHENATION POINT
+ (modify-syntax-entry #xff1a "w ") ; FULLWIDTH COLON
st)
"Syntax table used while in `text-mode'.")
(defvar text-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\e\t" 'ispell-complete-word)
+ (define-key map [menu-bar text]
+ (cons "Text" (make-sparse-keymap "Text")))
+ (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill]
+ '(menu-item "Auto Fill" toggle-text-mode-auto-fill
+ :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook))
+ :help "Automatically fill text while typing in text modes (Auto Fill mode)"))
+ (bindings--define-key map [menu-bar text paragraph-indent-minor-mode]
+ '(menu-item "Paragraph Indent" paragraph-indent-minor-mode
+ :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode))
+ :help "Toggle paragraph indent minor mode"))
+ (bindings--define-key map [menu-bar text sep] menu-bar-separator)
+ (bindings--define-key map [menu-bar text center-region]
+ '(menu-item "Center Region" center-region
+ :help "Center the marked region"
+ :enable (region-active-p)))
+ (bindings--define-key map [menu-bar text center-paragraph]
+ '(menu-item "Center Paragraph" center-paragraph
+ :help "Center the current paragraph"))
+ (bindings--define-key map [menu-bar text center-line]
+ '(menu-item "Center Line" center-line
+ :help "Center the current line"))
map)
"Keymap for `text-mode'.
Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode',
@@ -101,21 +141,21 @@ Turning on Paragraph-Indent minor mode runs the normal hook
(concat ps-re paragraph-start)))))
;; Change the indentation function.
(if paragraph-indent-minor-mode
- (set (make-local-variable 'indent-line-function) 'indent-to-left-margin)
- (if (eq indent-line-function 'indent-to-left-margin)
- (set (make-local-variable 'indent-line-function) 'indent-region))))
+ (add-function :override (local 'indent-line-function)
+ #'indent-to-left-margin)
+ (remove-function (local 'indent-line-function)
+ #'indent-to-left-margin)))
(defalias 'indented-text-mode 'text-mode)
;; This can be made a no-op once all modes that use text-mode-hook
-;; are "derived" from text-mode.
+;; are "derived" from text-mode. (As of 2015/04, and probably well before,
+;; the only one I can find that doesn't so derive is rmail-edit-mode.)
(defun text-mode-hook-identify ()
"Mark that this mode has run `text-mode-hook'.
This is how `toggle-text-mode-auto-fill' knows which buffers to operate on."
(set (make-local-variable 'text-mode-variant) t))
-(add-hook 'text-mode-hook 'text-mode-hook-identify)
-
(defun toggle-text-mode-auto-fill ()
"Toggle whether to use Auto Fill in Text mode and related modes.
This command affects all buffers that use modes related to Text mode,
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index f25fa87d0ec..f1a42f2b688 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -1,9 +1,10 @@
-;;; tildify.el --- adding hard spaces into texts
+;;; tildify.el --- adding hard spaces into texts -*- lexical-binding: t -*-
-;; Copyright (C) 1997-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2015 Free Software Foundation, Inc.
;; Author: Milan Zamazal <pdm@zamazal.org>
-;; Version: 4.5
+;; Michal Nazarewicz <mina86@mina86.com>
+;; Version: 4.6.1
;; Keywords: text, TeX, SGML, wp
;; This file is part of GNU Emacs.
@@ -55,8 +56,21 @@
:version "21.1"
:group 'wp)
-(defcustom tildify-pattern-alist
- '((t "\\([,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(\\w\\|[([{\\]\\|<[a-zA-Z]\\)" 2))
+(defcustom tildify-pattern
+ "\\(?:[,:;(][ \t]*[a]\\|\\<[AIKOSUVZikosuvz]\\)\\([ \t]+\\|[ \t]*\n[ \t]*\\)\\(?:\\w\\|[([{\\]\\|<[a-zA-Z]\\)"
+ "A pattern specifying where to insert hard spaces.
+
+`tildify-buffer' function will replace first capturing group of the regexp with
+a hard space (as defined by `tildify-space-string' variable). (Hint: \\(…\\)
+non-capturing groups can be used for grouping prior to the part of the regexp
+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
+ :safe t)
+
+(defcustom tildify-pattern-alist ()
"Alist specifying where to insert hard spaces.
Each alist item is of the form (MAJOR-MODE REGEXP NUMBER) or
@@ -77,16 +91,33 @@ by the hard space character.
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
:group 'tildify
- :type '(repeat (choice (list symbol regexp integer) (cons symbol symbol))))
-
-(defcustom tildify-string-alist
- '((latex-mode . "~")
- (tex-mode . latex-mode)
- (plain-tex-mode . latex-mode)
- (sgml-mode . "&nbsp;")
- (xml-mode . sgml-mode)
- (html-mode . sgml-mode)
- (t . " "))
+ :type '(repeat (cons :tag "Entry for major mode"
+ (choice (const :tag "Default" t)
+ (symbol :tag "Major mode"))
+ (choice (list :tag "Regexp"
+ regexp
+ (integer :tag "Group "))
+ (symbol :tag "Like other")))))
+(make-obsolete-variable 'tildify-pattern-alist 'tildify-pattern "25.1")
+
+(defcustom tildify-space-string "\u00A0"
+ "Representation of a hard (a.k.a. no-break) space in current major mode.
+
+Used by `tildify-buffer' in places where space is required but line
+cannot be broken. For example \"~\" for TeX or \"&#160;\" for SGML,
+HTML and XML modes. A no-break space Unicode character (\"\\u00A0\")
+might be used for other modes if compatible encoding is used.
+
+If nil, current major mode has no way to represent a hard space."
+ :version "25.1"
+ :group 'tildify
+ :type '(choice (const :tag "Space character (no hard-space representation)"
+ " ")
+ (const :tag "No-break space (U+00A0)" "\u00A0")
+ (string :tag "Custom string"))
+ :safe t)
+
+(defcustom tildify-string-alist ()
"Alist specifying what is a hard space in the current major mode.
Each alist item is of the form (MAJOR-MODE . STRING) or
@@ -98,47 +129,45 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either:
alist item
STRING defines the hard space, which is inserted at places defined by
-`tildify-pattern-alist'. For example it can be \"~\" for TeX or \"&nbsp;\"
-for SGML.
+`tildify-pattern'. For example it can be \"~\" for TeX or \"&nbsp;\" for SGML.
The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this
mode, the item for the mode SYMBOL is looked up in the alist instead."
:group 'tildify
- :type '(repeat (cons symbol (choice string symbol))))
-
-(defcustom tildify-ignored-environments-alist
- '((latex-mode
- ("\\\\\\\\" . "") ; do not remove this
- ("\\\\begin{verbatim}" . "\\\\end{verbatim}")
- ("\\\\verb\\*?\\(.\\)" . (1))
- ("\\$\\$" . "\\$\\$")
- ("\\$" . "\\$")
- ("\\\\(" . "\\\\)")
- ("\\\\[[]" . "\\\\[]]")
- ("\\\\begin{math}" . "\\\\end{math}")
- ("\\\\begin{displaymath}" . "\\\\end{displaymath}")
- ("\\\\begin{equation}" . "\\\\end{equation}")
- ("\\\\begin{eqnarray\\*?}" . "\\\\end{eqnarray\\*?}")
- ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "")
- ("%" . "$"))
- (plain-tex-mode . latex-mode)
- (html-mode
- ("<pre[^>]*>" . "</pre>")
- ("<dfn>" . "</dfn>")
- ("<code>" . "</code>")
- ("<samp>" . "</samp>")
- ("<kbd>" . "</kbd>")
- ("<var>" . "</var>")
- ("<PRE[^>]*>" . "</PRE>")
- ("<DFN>" . "</DFN>")
- ("<CODE>" . "</CODE>")
- ("<SAMP>" . "</SAMP>")
- ("<KBD>" . "</KBD>")
- ("<VAR>" . "</VAR>")
- ("<! *--" . "-- *>")
- ("<" . ">"))
- (sgml-mode . html-mode)
- (t nil))
+ :type '(repeat (cons :tag "Entry for major mode"
+ (choice (const :tag "Default" t)
+ (symbol :tag "Major mode"))
+ (choice (const :tag "No-break space (U+00A0)" "\u00A0")
+ (string :tag "String ")
+ (symbol :tag "Like other")))))
+(make-obsolete-variable 'tildify-string-alist
+ 'tildify-space-string "25.1")
+
+(defcustom tildify-foreach-region-function
+ 'tildify--deprecated-ignore-evironments
+ "A function calling a callback on portions of the buffer to tildify.
+
+The function is called from `tildify-buffer' function with three arguments: FUNC
+BEG END. FUNC is a callback accepting two arguments -- REG-BEG REG-END --
+specifying a portion of buffer to operate on.
+
+The BEG and END arguments may be used to limit portion of the buffer being
+scanned, but the `tildify-foreach-region-function' is not required to make use
+of them. IT must, however, terminate as soon as FUNC returns nil.
+
+For example, if `tildify-buffer' function should operate on the whole buffer,
+a simple pass through function could be used:
+ (setq-local tildify-foreach-region-function
+ (lambda (cb beg end) (funcall cb beg end)))
+or better still:
+ (setq-local tildify-foreach-region-function \\='funcall)
+See `tildify-foreach-ignore-environments' function for other ways to use the
+variable."
+ :version "25.1"
+ :group 'tildify
+ :type 'function)
+
+(defcustom tildify-ignored-environments-alist ()
"Alist specifying ignored structured text environments.
Parts of text defined in this alist are skipped without performing hard space
insertion on them. These setting allow skipping text parts like verbatim or
@@ -152,141 +181,165 @@ MAJOR-MODE defines major mode, for which the item applies. It can be either:
- t for default item, this applies to all major modes not defined in another
alist item
-BEG-REGEX is a regexp matching beginning of a text part to be skipped.
-END-REGEX defines end of the corresponding text part and can be either:
-- a regexp matching the end of the skipped text part
-- a list of regexps and numbers, which will compose the ending regexp by
- concatenating themselves, while replacing the numbers with corresponding
- subexpressions of BEG-REGEX (this is used to solve cases like
- \\\\verb<character> in TeX)."
+See `tildify-foreach-ignore-environments' function for description of BEG-REGEX
+and END-REGEX."
:group 'tildify
- :type '(repeat (cons symbol (choice symbol (repeat sexp)))))
-
-
-;;; *** Internal variables ***
-
-(defvar tildify-count nil
- "Counter for replacements.")
+ :type '(repeat
+ (cons :tag "Entry for major mode"
+ (choice (const :tag "Default" t)
+ (symbol :tag "Major mode"))
+ (choice
+ (const :tag "None")
+ (repeat
+ :tag "Environments"
+ (cons :tag "Regexp pair"
+ (regexp :tag "Open ")
+ (choice :tag "Close"
+ (regexp :tag "Regexp")
+ (list :tag "Regexp and groups (concatenated)"
+ (choice (regexp :tag "Regexp")
+ (integer :tag "Group "))))))
+ (symbol :tag "Like other")))))
+(make-obsolete-variable 'tildify-ignored-environments-alist
+ 'tildify-foreach-region-function "25.1")
;;; *** Interactive functions ***
;;;###autoload
-(defun tildify-region (beg end)
+(defun tildify-region (beg end &optional dont-ask)
"Add hard spaces in the region between BEG and END.
-See variables `tildify-pattern-alist', `tildify-string-alist', and
+See variables `tildify-pattern', `tildify-space-string', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
-This function performs no refilling of the changed text."
- (interactive "*r")
- (setq tildify-count 0)
- (let (a
- z
- (marker-end (copy-marker end))
- end-env
- finish
- (ask t)
- (case-fold-search nil)
- (regexp (tildify-build-regexp)) ; beginnings of environments
- aux)
- (if regexp
- ;; Yes, ignored environments exist for the current major mode,
- ;; tildify just texts outside them
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (not finish)
- (setq a (point))
- (setq end-env (tildify-find-env regexp))
- (setq z (copy-marker (if end-env (1- (point)) (point-max))))
- (if (>= (marker-position z) beg)
- (progn
- (or (>= a beg) (setq a beg))
- (or (<= (marker-position z) (marker-position marker-end))
- (setq z marker-end))
- (setq aux (tildify-tildify a (marker-position z) ask))
- (if (eq aux 'force)
- (setq ask nil)
- (if (eq aux nil)
- (setq finish t)))))
- (if (>= (marker-position z) (marker-position marker-end))
- (setq finish t))
- (or (>= (point) (marker-position z))
- (goto-char (marker-position z)))
- (if (not finish)
- (if (re-search-forward end-env nil t)
- (if (> (point) (marker-position marker-end))
- (setq finish t))
- (message
- "End of environment not found: %s" end-env)
- (setq finish t))))))
- ;; No ignored environments, tildify directly
- (tildify-tildify beg end ask)))
- (message "%d spaces replaced." tildify-count))
+This function performs no refilling of the changed text.
+If DONT-ASK is set, or called interactively with prefix argument, user
+won't be prompted for confirmation of each substitution."
+ (interactive "*rP")
+ (let (case-fold-search (count 0) (ask (not dont-ask)))
+ (tildify--foreach-region
+ (lambda (beg end)
+ (let ((aux (tildify-tildify beg end ask)))
+ (setq count (+ count (car aux)))
+ (if (not (eq (cdr aux) 'force))
+ (cdr aux)
+ (setq ask nil)
+ t)))
+ beg end)
+ (message "%d spaces replaced." count)))
;;;###autoload
-(defun tildify-buffer ()
+(defun tildify-buffer (&optional dont-ask)
"Add hard spaces in the current buffer.
-See variables `tildify-pattern-alist', `tildify-string-alist', and
+See variables `tildify-pattern', `tildify-space-string', and
`tildify-ignored-environments-alist' for information about configuration
parameters.
-This function performs no refilling of the changed text."
- (interactive "*")
- (tildify-region (point-min) (point-max)))
+This function performs no refilling of the changed text.
+If DONT-ASK is set, or called interactively with prefix argument, user
+won't be prompted for confirmation of each substitution."
+ (interactive "*P")
+ (tildify-region (point-min) (point-max) dont-ask))
;;; *** Auxiliary functions ***
-(defun tildify-build-regexp ()
- "Build start of environment regexp."
- (let ((alist (tildify-mode-alist tildify-ignored-environments-alist))
- regexp)
- (when alist
- (setq regexp (caar alist))
- (setq alist (cdr alist))
- (while alist
- (setq regexp (concat regexp "\\|" (caar alist)))
- (setq alist (cdr alist)))
- regexp)))
-
-(defun tildify-mode-alist (mode-alist &optional mode)
+(defun tildify--pick-alist-entry (mode-alist &optional mode)
"Return alist item for the MODE-ALIST in the current major MODE."
- (if (null mode)
- (setq mode major-mode))
- (let ((alist (cdr (or (assoc mode mode-alist)
+ (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist)
(assoc t mode-alist)))))
(if (and alist
(symbolp alist))
- (tildify-mode-alist mode-alist alist)
+ (tildify--pick-alist-entry mode-alist alist)
alist)))
-
-(defun tildify-find-env (regexp)
+(make-obsolete 'tildify--pick-alist-entry
+ "it should not be used in new code." "25.1")
+
+(defun tildify--deprecated-ignore-evironments (callback beg end)
+ "Call CALLBACK on regions between BEG and END.
+
+Call CALLBACK on each region outside of environment to ignore. Stop scanning
+the region as soon as CALLBACK returns nil. Environments to ignore are
+defined by deprecated `tildify-ignored-environments-alist'. CALLBACK may be
+called on portions of the buffer outside of [BEG END)."
+ (let ((pairs (tildify--pick-alist-entry tildify-ignored-environments-alist)))
+ (if pairs
+ (tildify-foreach-ignore-environments pairs callback beg end)
+ (funcall callback beg end))))
+(make-obsolete 'tildify--deprecated-ignore-evironments
+ "it should not be used in new code." "25.1")
+
+(defun tildify-foreach-ignore-environments (pairs callback _beg end)
+ "Outside of environments defined by PAIRS call CALLBACK.
+
+PAIRS is a list of (BEG-REGEX . END-REGEX) cons. BEG-REGEX is a regexp matching
+beginning of a text part to be skipped. END-REGEX defines end of the
+corresponding text part and can be either:
+- a regexp matching the end of the skipped text part
+- a list of regexps and numbers, which will compose the ending regexp by
+ concatenating themselves, while replacing the numbers with corresponding
+ subexpressions of BEG-REGEX (this is used to solve cases like
+ \\\\verb<character> in TeX).
+
+CALLBACK is a function accepting two arguments -- REG-BEG and REG-END -- that
+will be called for portions of the buffer outside of the environments defined by
+PAIRS regexes.
+
+The function will return as soon as CALLBACK returns nil or point goes past END.
+CALLBACK may be called on portions of the buffer outside of [BEG END); in fact
+BEG argument is ignored.
+
+This function is meant to be used to set `tildify-foreach-region-function'
+variable. For example, for an XML file one might use:
+ (setq-local tildify-foreach-region-function
+ (apply-partially \\='tildify-foreach-ignore-environments
+ \\='((\"<! *--\" . \"-- *>\") (\"<\" . \">\"))))"
+ (let ((beg-re (concat "\\(?:" (mapconcat 'car pairs "\\)\\|\\(?:") "\\)"))
+ p end-re)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (while (and (< (setq p (point)) end)
+ (if (setq end-re (tildify--find-env beg-re pairs))
+ (and (funcall callback p (match-beginning 0))
+ (< (point) end)
+ (re-search-forward end-re nil t))
+ (funcall callback p end)
+ nil)))))))
+
+(defun tildify--foreach-region (callback beg end)
+ "Call CALLBACK on portions of the buffer between BEG and END.
+
+Which portions to call CALLBACK on is determined by
+`tildify-foreach-region-function' variable. This function merely makes sure
+CALLBACK is not called with portions of the buffer outside of [BEG END)."
+ (let ((func (lambda (reg-beg reg-end)
+ (setq reg-beg (max reg-beg beg) reg-end (min reg-end end))
+ (and (or (>= reg-beg reg-end)
+ (funcall callback reg-beg reg-end))
+ (< reg-end end)))))
+ (funcall tildify-foreach-region-function func beg end)))
+
+(defun tildify--find-env (regexp pairs)
"Find environment using REGEXP.
-Return regexp for the end of the environment or nil if no environment was
-found."
+Return regexp for the end of the environment found in PAIRS or nil if
+no environment was found."
;; Find environment
- (if (re-search-forward regexp nil t)
- ;; Build end-env regexp
- (let ((match (match-string 0))
- (alist (tildify-mode-alist tildify-ignored-environments-alist))
- expression)
- (save-match-data
- (while (not (eq (string-match (caar alist) match) 0))
- (setq alist (cdr alist))))
- (if (stringp (setq expression (cdar alist)))
- expression
- (let ((result "")
- aux)
- (while expression
- (setq result (concat result
- (if (stringp (setq aux (car expression)))
- expression
- (regexp-quote (match-string aux)))))
- (setq expression (cdr expression)))
- result)))
- ;; Return nil if not found
- nil))
+ (when (re-search-forward regexp nil t)
+ (save-match-data
+ (let ((match (match-string 0)))
+ (while (not (eq (string-match (caar pairs) match) 0))
+ (setq pairs (cdr pairs)))
+ (let ((expression (cdar pairs)))
+ (if (stringp expression)
+ expression
+ (mapconcat
+ (lambda (expr)
+ (if (stringp expr)
+ expr
+ (regexp-quote (match-string expr match))))
+ expression
+ "")))))))
(defun tildify-tildify (beg end ask)
"Add tilde characters in the region between BEG and END.
@@ -295,20 +348,26 @@ macros.
If ASK is nil, perform replace without asking user for confirmation.
-Returns one of symbols: t (all right), nil (quit), force (replace without
-further questions)."
+Returns (count . response) cons where count is number of string
+replacements done and response is one of symbols: t (all right), nil
+(quit), force (replace without further questions)."
(save-excursion
(goto-char beg)
- (let* ((alist (tildify-mode-alist tildify-pattern-alist))
- (regexp (car alist))
- (match-number (cadr alist))
- (tilde (tildify-mode-alist tildify-string-alist))
- (end-marker (copy-marker end))
- answer
- bad-answer
- replace
- quit
- (message-log-max nil))
+ (let ((regexp tildify-pattern)
+ (match-number 1)
+ (tilde (or (tildify--pick-alist-entry tildify-string-alist)
+ tildify-space-string))
+ (end-marker (copy-marker end))
+ answer
+ bad-answer
+ replace
+ quit
+ (message-log-max nil)
+ (count 0))
+ ;; For the time being, tildify-pattern-alist overwrites tildify-pattern
+ (let ((alist (tildify--pick-alist-entry tildify-pattern-alist)))
+ (when alist
+ (setq regexp (car alist) match-number (cadr alist))))
(while (and (not quit)
(re-search-forward regexp (marker-position end-marker) t))
(when (or (not ask)
@@ -335,21 +394,118 @@ further questions)."
(setq bad-answer t)))
replace))
(replace-match tilde t t nil match-number)
- (setq tildify-count (1+ tildify-count))))
+ (setq count (1+ count))))
;; Return value
+ (cons count (cond (quit nil)
+ ((not ask) 'force)
+ (t t))))))
+
+
+;;; *** Tildify Mode ***
+
+(defcustom tildify-space-pattern "[,:;(][ \t]*[a]\\|\\<[AIKOSUVWZikosuvwz]"
+ "Pattern specifying whether to insert a hard space at point.
+
+If the pattern matches `looking-back', a hard space needs to be inserted instead
+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)
+
+(defcustom tildify-space-predicates '(tildify-space-region-predicate)
+ "A list of predicate functions for `tildify-space' function."
+ :version "25.1"
+ :group 'tildify
+ :type '(repeat 'function))
+
+(defcustom tildify-double-space-undos t
+ "Weather `tildify-space' should undo hard space when space is typed again."
+ :version "25.1"
+ :group 'tildify
+ :type 'boolean)
+
+;;;###autoload
+(defun tildify-space ()
+ "Convert space before point into a hard space if the context is right.
+
+If
+ * character before point is a space character,
+ * character before that has \"w\" character syntax (i.e. it's a word
+ constituent),
+ * `tildify-space-pattern' matches when `looking-back' (no more than 10
+ characters) from before the space character, and
+ * all predicates in `tildify-space-predicates' return non-nil,
+replace the space character with value of `tildify-space-string' and
+return t.
+
+Otherwise, if
+ * `tildify-double-space-undos' variable is non-nil,
+ * character before point is a space character, and
+ * text before that is a hard space as defined by
+ `tildify-space-string' variable,
+remove the hard space and leave only the space character.
+
+This function is meant to be used as a `post-self-insert-hook'."
+ (interactive)
+ (let* ((p (point)) (p-1 (1- p)) (n (- p (point-min)))
+ (l (length tildify-space-string)) (l+1 (1+ l))
+ case-fold-search)
+ (when (and (> n 2) (eq (preceding-char) ?\s))
(cond
- (quit nil)
- ((not ask) 'force)
- (t t)))))
+ ((and (eq (char-syntax (char-before p-1)) ?w)
+ (save-excursion
+ (goto-char p-1)
+ (looking-back tildify-space-pattern (max (point-min) (- p 10))))
+ (run-hook-with-args-until-failure 'tildify-space-predicates))
+ (delete-char -1)
+ (insert tildify-space-string)
+ t)
+ ((and tildify-double-space-undos
+ (> n l+1)
+ (string-equal tildify-space-string
+ (buffer-substring (- p l+1) p-1)))
+ (goto-char p-1)
+ (delete-char (- l))
+ (goto-char (1+ (point)))
+ nil)))))
+
+(defun tildify-space-region-predicate ()
+ "Check whether character before point should be tildified.
+Based on `tildify-foreach-region-function', check whether character before,
+which is assumed to be a space character, should be replaced with a hard space."
+ (catch 'found
+ (tildify--foreach-region (lambda (_b _e) (throw 'found t)) (1- (point)) (point))))
+
+;;;###autoload
+(define-minor-mode tildify-mode
+ "Adds electric behaviour to space character.
+
+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'),
+that space character is replaced by a hard space specified by
+`tildify-space-string'. Converting of the space is done by `tildify-space'.
+
+When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space
+representation for current major mode, the `tildify-space-string' buffer-local
+variable will be set to the representation."
+ nil " ~" nil
+ (when tildify-mode
+ (let ((space (tildify--pick-alist-entry tildify-string-alist)))
+ (if (not (string-equal " " (or space tildify-space-string)))
+ (when space
+ (setq tildify-space-string space))
+ (message (eval-when-compile
+ (concat "Hard space is a single space character, tildify-"
+ "mode won't have any effect, disabling.")))
+ (setq tildify-mode nil))))
+ (if tildify-mode
+ (add-hook 'post-self-insert-hook 'tildify-space nil t)
+ (remove-hook 'post-self-insert-hook 'tildify-space t)))
;;; *** Announce ***
(provide 'tildify)
-
-;; Local variables:
-;; coding: utf-8
-;; End:
-
;;; tildify.el ends here
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index 23e90552096..4133e0fa126 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -1,6 +1,6 @@
;;; two-column.el --- minor mode for editing of two-column text
-;; Copyright (C) 1992-1995, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1995, 2001-2015 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Adapted-By: ESR, Daniel Pfeiffer
@@ -349,6 +349,9 @@ accepting the proposed default buffer.
(if b1 (setq 2C-window-width (- (frame-width) b1)))
(2C-two-columns b2)))
+(autoload 'scroll-bar-columns "scroll-bar")
+(eval-when-compile
+ (require 'fringe)) ; fringe-columns defsubst
;;;###autoload
(defun 2C-split (arg)
@@ -370,9 +373,8 @@ First column's text sSs Second column's text
\(See \\[describe-mode] .)"
(interactive "*p")
(and (2C-other)
- (if (y-or-n-p (concat "Overwrite associated buffer `"
- (buffer-name (2C-other))
- "'? "))
+ (if (y-or-n-p (format-message "Overwrite associated buffer `%s'? "
+ (buffer-name (2C-other))))
(with-current-buffer (2C-other)
(erase-buffer))
(signal 'quit nil)))
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
index 485ccd80ac8..b97fdfded14 100644
--- a/lisp/textmodes/underline.el
+++ b/lisp/textmodes/underline.el
@@ -1,8 +1,8 @@
;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs
-;; Copyright (C) 1985, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: wp
;; This file is part of GNU Emacs.
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index b67a32a24f7..654bccd0988 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -1,9 +1,9 @@
-;;; thingatpt.el --- get the `thing' at point
+;;; thingatpt.el --- get the `thing' at point -*- lexical-binding:t -*-
-;; Copyright (C) 1991-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, matching, mouse
;; Created: Thu Mar 28 13:48:23 1991
@@ -145,7 +145,7 @@ a symbol as a valid THING."
(let ((bounds (bounds-of-thing-at-point thing)))
(when bounds
(buffer-substring (car bounds) (cdr bounds)))))))
- (when (and text no-properties)
+ (when (and text no-properties (sequencep text))
(set-text-properties 0 (length text) nil text))
text))
@@ -178,34 +178,40 @@ The bounds of THING are determined by `bounds-of-thing-at-point'."
;; Sexps
(defun in-string-p ()
- "Return non-nil if point is in a string.
-\[This is an internal function.]"
+ "Return non-nil if point is in a string."
+ (declare (obsolete "use (nth 3 (syntax-ppss)) instead." "25.1"))
(let ((orig (point)))
(save-excursion
(beginning-of-defun)
(nth 3 (parse-partial-sexp (point) orig)))))
-(defun end-of-sexp ()
- "Move point to the end of the current sexp.
-\[This is an internal function.]"
+(defun thing-at-point--end-of-sexp ()
+ "Move point to the end of the current sexp."
(let ((char-syntax (syntax-after (point))))
(if (or (eq char-syntax ?\))
- (and (eq char-syntax ?\") (in-string-p)))
+ (and (eq char-syntax ?\") (nth 3 (syntax-ppss))))
(forward-char 1)
(forward-sexp 1))))
-(put 'sexp 'end-op 'end-of-sexp)
+(define-obsolete-function-alias 'end-of-sexp
+ 'thing-at-point--end-of-sexp "25.1"
+ "This is an internal thingatpt function and should not be used.")
-(defun beginning-of-sexp ()
- "Move point to the beginning of the current sexp.
-\[This is an internal function.]"
+(put 'sexp 'end-op 'thing-at-point--end-of-sexp)
+
+(defun thing-at-point--beginning-of-sexp ()
+ "Move point to the beginning of the current sexp."
(let ((char-syntax (char-syntax (char-before))))
(if (or (eq char-syntax ?\()
- (and (eq char-syntax ?\") (in-string-p)))
+ (and (eq char-syntax ?\") (nth 3 (syntax-ppss))))
(forward-char -1)
(forward-sexp -1))))
-(put 'sexp 'beginning-op 'beginning-of-sexp)
+(define-obsolete-function-alias 'beginning-of-sexp
+ 'thing-at-point--beginning-of-sexp "25.1"
+ "This is an internal thingatpt function and should not be used.")
+
+(put 'sexp 'beginning-op 'thing-at-point--beginning-of-sexp)
;; Lists
@@ -213,7 +219,7 @@ The bounds of THING are determined by `bounds-of-thing-at-point'."
(defun thing-at-point-bounds-of-list-at-point ()
"Return the bounds of the list at point.
-\[Internal function used by `bounds-of-thing-at-point'.]"
+[Internal function used by `bounds-of-thing-at-point'.]"
(save-excursion
(let ((opoint (point))
(beg (ignore-errors
@@ -283,7 +289,7 @@ If nil, construct the regexp from `thing-at-point-uri-schemes'.")
"uuid:" "vemmi://" "webcal://" "xri://" "xmlrpc.beep://"
"xmlrpc.beeps://" "z39.50r://" "z39.50s://" "xmpp:"
;; Compatibility
- "fax:" "mms://" "mmsh://" "modem:" "prospero:" "snews:"
+ "fax:" "man:" "mms://" "mmsh://" "modem:" "prospero:" "snews:"
"wais://")
"List of URI schemes recognized by `thing-at-point-url-at-point'.
Each string in this list should correspond to the start of a
@@ -355,7 +361,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)."
(if found
(cons (match-beginning 1) (match-end 1))))))
-(defun thing-at-point--bounds-of-well-formed-url (beg end _pt)
+(defun thing-at-point--bounds-of-well-formed-url (beg end pt)
(save-excursion
(goto-char beg)
(let (url-beg paren-end regexp)
@@ -382,7 +388,11 @@ the bounds of a possible ill-formed URI (one lacking a scheme)."
(scan-lists (1- url-beg) 1 0))))
(not (blink-matching-check-mismatch (1- url-beg) paren-end))
(setq end (1- paren-end)))
- (cons url-beg end)))))
+ ;; Ensure PT is actually within BOUNDARY. Check the following
+ ;; example with point on the beginning of the line:
+ ;;
+ ;; 3,1406710489,http://gnu.org,0,"0"
+ (and (<= url-beg pt end) (cons url-beg end))))))
(put 'url 'thing-at-point 'thing-at-point-url-at-point)
@@ -476,19 +486,22 @@ looks like an email address, \"ftp://\" if it starts with
;; matches that straddle the start position so we search forwards once
;; and then back repeatedly and then back up a char at a time.
-(defun thing-at-point-looking-at (regexp)
+(defun thing-at-point-looking-at (regexp &optional distance)
"Return non-nil if point is in or just after a match for REGEXP.
Set the match data from the earliest such match ending at or after
point."
(save-excursion
- (let ((old-point (point)) match)
+ (let ((old-point (point))
+ (forward-bound (and distance (+ (point) distance)))
+ (backward-bound (and distance (- (point) distance)))
+ match)
(and (looking-at regexp)
(>= (match-end 0) old-point)
(setq match (point)))
;; Search back repeatedly from end of next match.
;; This may fail if next match ends before this match does.
- (re-search-forward regexp nil 'limit)
- (while (and (re-search-backward regexp nil t)
+ (re-search-forward regexp forward-bound 'limit)
+ (while (and (re-search-backward regexp backward-bound t)
(or (> (match-beginning 0) old-point)
(and (looking-at regexp) ; Extend match-end past search start
(>= (match-end 0) old-point)
@@ -518,7 +531,8 @@ with angle brackets.")
(put 'email 'bounds-of-thing-at-point
(lambda ()
- (let ((thing (thing-at-point-looking-at thing-at-point-email-regexp)))
+ (let ((thing (thing-at-point-looking-at
+ thing-at-point-email-regexp 500)))
(if thing
(let ((beginning (match-beginning 0))
(end (match-end 0)))
@@ -546,7 +560,7 @@ with angle brackets.")
"Return the sentence at point. See `thing-at-point'."
(thing-at-point 'sentence))
-(defun read-from-whole-string (str)
+(defun thing-at-point--read-from-whole-string (str)
"Read a Lisp expression from STR.
Signal an error if the entire string was not used."
(let* ((read-data (read-from-string str))
@@ -560,9 +574,14 @@ Signal an error if the entire string was not used."
(error "Can't read whole string")
(car read-data))))
+(define-obsolete-function-alias 'read-from-whole-string
+ 'thing-at-point--read-from-whole-string "25.1"
+ "This is an internal thingatpt function and should not be used.")
+
(defun form-at-point (&optional thing pred)
(let ((sexp (ignore-errors
- (read-from-whole-string (thing-at-point (or thing 'sexp))))))
+ (thing-at-point--read-from-whole-string
+ (thing-at-point (or thing 'sexp))))))
(if (or (not pred) (funcall pred sexp)) sexp)))
;;;###autoload
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 8032de85b01..da83f3a1a63 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -1,9 +1,9 @@
;;; thumbs.el --- Thumbnails previewer for images files
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: Multimedia
;; This file is part of GNU Emacs.
@@ -102,7 +102,7 @@ When it reaches that size (in bytes), a warning is sent."
(or (executable-find "convert")
"/usr/X11R6/bin/convert"))
"Name of conversion program for thumbnails generation.
-It must be 'convert'."
+It must be \"convert\"."
:type 'string
:group 'thumbs)
@@ -235,7 +235,7 @@ Optional arguments are:
ARG any arguments to the ACTION command,
OUTPUT-FORMAT is the file format to output (default is jpeg),
ACTION-PREFIX is the symbol to place before the ACTION command
- (defaults to '-' but can sometimes be '+')."
+ (defaults to `-' but can sometimes be `+')."
(call-process thumbs-conversion-program nil nil nil
(or action-prefix "-")
action
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 8fa5d997945..b6a73409f87 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -1,6 +1,6 @@
;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
-;; Copyright (C) 1989, 1993-1995, 1997, 2000-2013 Free Software
+;; Copyright (C) 1989, 1993-1995, 1997, 2000-2015 Free Software
;; Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -255,7 +255,7 @@ time-stamped file itself.")
"Update the time stamp string(s) in the buffer.
A template in a file can be automatically updated with a new time stamp
every time you save the file. Add this line to your init file:
- (add-hook 'before-save-hook 'time-stamp)
+ (add-hook \\='before-save-hook \\='time-stamp)
or customize `before-save-hook' through Custom.
Normally the template must appear in the first 8 lines of a file and
look like one of the following:
@@ -420,16 +420,8 @@ format the string."
(or ts-format
(setq ts-format time-stamp-format))
(if (stringp ts-format)
- (if (stringp time-stamp-time-zone)
- (let ((ts-real-time-zone (getenv "TZ")))
- (unwind-protect
- (progn
- (setenv "TZ" time-stamp-time-zone)
- (format-time-string
- (time-stamp-string-preprocess ts-format)))
- (setenv "TZ" ts-real-time-zone)))
- (format-time-string
- (time-stamp-string-preprocess ts-format)))
+ (format-time-string (time-stamp-string-preprocess ts-format)
+ nil time-stamp-time-zone)
;; handle version 1 compatibility
(cond ((or (eq time-stamp-old-format-warn 'error)
(and (eq time-stamp-old-format-warn 'ask)
diff --git a/lisp/time.el b/lisp/time.el
index 7e558746c6a..dec594061a4 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -1,9 +1,9 @@
-;;; time.el --- display time, load and mail indicator in mode line of Emacs -*-coding: utf-8 -*-
+;;; time.el --- display time, load and mail indicator in mode line of Emacs
-;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2013 Free Software
+;; Copyright (C) 1985-1987, 1993-1994, 1996, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; This file is part of GNU Emacs.
@@ -160,15 +160,8 @@ LABEL is a string to display as the label of that TIMEZONE's time."
(defcustom display-time-world-list
;; Determine if zoneinfo style timezones are supported by testing that
;; America/New York and Europe/London return different timezones.
- (let ((old-tz (getenv "TZ"))
- gmt nyt)
- (unwind-protect
- (progn
- (setenv "TZ" "America/New_York")
- (setq nyt (format-time-string "%z"))
- (setenv "TZ" "Europe/London")
- (setq gmt (format-time-string "%z")))
- (setenv "TZ" old-tz))
+ (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))
@@ -176,7 +169,7 @@ LABEL is a string to display as the label of that TIMEZONE's time."
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
+`legacy-style-world-list' for two widely used formats. LABEL is
a string to display as the label of that TIMEZONE's time."
:group 'display-time
:type '(repeat (list string string))
@@ -471,7 +464,7 @@ update which can wait for the next redisplay."
;; This is inside the let binding, but we are not going to document
;; what variables are available.
(run-hooks 'display-time-hook))
- (force-mode-line-update))
+ (force-mode-line-update 'all))
(defun display-time-file-nonempty-p (file)
(let ((remote-file-name-inhibit-cache (- display-time-interval 5)))
@@ -523,21 +516,19 @@ See `display-time-world'."
"Replace current buffer text with times in various zones, based on ALIST."
(let ((inhibit-read-only t)
(buffer-undo-list t)
- (old-tz (getenv "TZ"))
+ (now (current-time))
(max-width 0)
result fmt)
(erase-buffer)
- (unwind-protect
- (dolist (zone alist)
- (let* ((label (cadr zone))
- (width (string-width label)))
- (setenv "TZ" (car zone))
- (push (cons label
- (format-time-string display-time-world-time-format))
- result)
- (when (> width max-width)
- (setq max-width width))))
- (setenv "TZ" old-tz))
+ (dolist (zone alist)
+ (let* ((label (cadr zone))
+ (width (string-width label)))
+ (push (cons label
+ (format-time-string display-time-world-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))))
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 4b501624b1c..284da2139da 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -1,6 +1,6 @@
;;; timezone.el --- time zone package for GNU Emacs
-;; Copyright (C) 1990-1993, 1996, 1999, 2001-2013 Free Software
+;; Copyright (C) 1990-1993, 1996, 1999, 2001-2015 Free Software
;; Foundation, Inc.
;; Author: Masanobu Umeda
@@ -295,13 +295,9 @@ Gregorian date Sunday, December 31, 1 BC."
;; (timezone-absolute-from-gregorian 1 1 1970)
(days (- date current-time-origin))
(seconds-per-day (float 86400))
- (seconds (+ seconds (* days seconds-per-day)))
- (current-time-arithmetic-base (float 65536))
- (hi (floor (/ seconds current-time-arithmetic-base)))
- (hibase (* hi current-time-arithmetic-base))
- (lo (floor (- seconds hibase))))
- (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow.
- (cons hi lo))))
+ (day-seconds (* days seconds-per-day)))
+ (condition-case nil (time-add day-seconds seconds)
+ (range-error))))
(defun timezone-time-zone-from-absolute (date seconds)
"Compute the local time zone for DATE at time SECONDS after midnight.
diff --git a/lisp/tmm.el b/lisp/tmm.el
index cd91742649d..5d56cffa930 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -1,9 +1,9 @@
;;; tmm.el --- text mode access to menu-bar -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1996, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1996, 2000-2015 Free Software Foundation, Inc.
;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -50,7 +50,11 @@
"Text-mode emulation of looking and choosing from a menubar.
See the documentation for `tmm-prompt'.
X-POSITION, if non-nil, specifies a horizontal position within the menu bar;
-we make that menu bar item (the one at that position) the default choice."
+we make that menu bar item (the one at that position) the default choice.
+
+Note that \\[menu-bar-open] by default drops down TTY menus; if you want it
+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.
@@ -145,6 +149,8 @@ specify nil for this variable."
'(metadata (display-sort-function . identity))
(complete-with-action action items string pred))))
+(defvar tmm--history nil)
+
;;;###autoload
(defun tmm-prompt (menu &optional in-popup default-item)
"Text-mode emulation of calling the bindings in keymap.
@@ -163,7 +169,7 @@ Its value should be an event that has a binding in MENU."
;; That is used for recursive calls only.
(let ((gl-str "Menu bar") ;; The menu bar itself is not a menu keymap
; so it doesn't have a name.
- tmm-km-list out history history-len tmm-table-undef tmm-c-prompt
+ tmm-km-list out history-len tmm-table-undef tmm-c-prompt
tmm-old-mb-map tmm-short-cuts
chosen-string choice
(not-menu (not (keymapp menu))))
@@ -217,16 +223,18 @@ Its value should be an event that has a binding in MENU."
(setq index-of-default (1+ index-of-default)))
(setq tail (cdr tail)))))
(let ((prompt (concat "^." (regexp-quote tmm-mid-prompt))))
- (setq history
+ (setq tmm--history
(reverse (delq nil
(mapcar
(lambda (elt)
(if (string-match prompt (car elt))
(car elt)))
tmm-km-list)))))
- (setq history-len (length history))
- (setq history (append history history history history))
- (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
+ (setq history-len (length tmm--history))
+ (setq tmm--history (append tmm--history tmm--history
+ tmm--history tmm--history))
+ (setq tmm-c-prompt (nth (- history-len 1 index-of-default)
+ tmm--history))
(setq out
(if default-item
(car (nth index-of-default tmm-km-list))
@@ -235,7 +243,7 @@ Its value should be an event that has a binding in MENU."
(concat gl-str
" (up/down to change, PgUp to menu): ")
(tmm--completion-table tmm-km-list) nil t nil
- (cons 'history
+ (cons 'tmm--history
(- (* 2 history-len) index-of-default))))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
@@ -363,7 +371,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(unless tmm-c-prompt
(error "No active menu entries"))
(setq tmm-old-mb-map (tmm-define-keys t))
- ;; Get window and hide it for electric mode to get correct size
(or tmm-completion-prompt
(add-hook 'completion-setup-hook
'tmm-completion-delete-prompt 'append))
@@ -373,9 +380,15 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(with-current-buffer "*Completions*"
(tmm-remove-inactive-mouse-face)
(when tmm-completion-prompt
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (window (get-buffer-window "*Completions*")))
(goto-char (point-min))
- (insert tmm-completion-prompt))))
+ (insert tmm-completion-prompt)
+ (when window
+ ;; Try to show everything just inserted and preserve height of
+ ;; *Completions* window. This should fix a behavior described
+ ;; in Bug#1291.
+ (fit-window-to-buffer window nil nil nil nil t)))))
(insert tmm-c-prompt))
(defun tmm-shortcut ()
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 506e11399ba..3fbdfbebb15 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -1,6 +1,6 @@
;;; tool-bar.el --- setting up the tool bar
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: mouse frames
@@ -174,7 +174,8 @@ is less or equal to 256, then ICON.xpm, then ICON.pbm, and finally
ICON.xbm, using `find-image'."
(let* ((image-exp (tool-bar--image-expression icon)))
(define-key-after map (vector key)
- `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props))))
+ `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props))
+ (force-mode-line-update)))
;;;###autoload
(defun tool-bar-add-item-from-menu (command icon &optional map &rest props)
@@ -239,7 +240,8 @@ holds a keymap."
(if (and (consp rest) (consp (car rest)))
(setq rest (cdr rest)))
(append `(menu-item ,(car defn) ,rest)
- (list :image image-exp) props)))))))
+ (list :image image-exp) props))))
+ (force-mode-line-update))))
;;; Set up some global items. Additions/deletions up for grabs.
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 657951d7b75..e6382288379 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -1,6 +1,6 @@
;;; tooltip.el --- show tooltip windows
-;; Copyright (C) 1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999-2015 Free Software Foundation, Inc.
;; Author: Gerd Moellmann <gerd@acm.org>
;; Keywords: help c mouse tools
@@ -58,9 +58,7 @@ echo area, instead of making a pop-up window."
:init-value t
:initialize 'custom-initialize-delay
:group 'tooltip
- (unless (or (null tooltip-mode) (fboundp 'x-show-tip))
- (error "Sorry, tooltips are not yet available on this system"))
- (if tooltip-mode
+ (if (and tooltip-mode (fboundp 'x-show-tip))
(progn
(add-hook 'pre-command-hook 'tooltip-hide)
(add-hook 'tooltip-functions 'tooltip-help-tips))
@@ -217,11 +215,9 @@ This might return nil if the event did not occur over a buffer."
"Change the value of KEY in alist ALIST to VALUE.
If there's no association for KEY in ALIST, add one, otherwise
change the existing association. Value is the resulting alist."
- (let ((param (assq key alist)))
- (if (consp param)
- (setcdr param value)
- (push (cons key value) alist))
- alist))
+ (declare (obsolete "use (setf (alist-get ..) ..) instead" "25.1"))
+ (setf (alist-get key alist) value)
+ alist)
(declare-function x-show-tip "xfns.c"
(string &optional frame parms timeout dx dy))
@@ -246,10 +242,10 @@ in echo area."
(fg (face-attribute 'tooltip :foreground))
(bg (face-attribute 'tooltip :background)))
(when (stringp fg)
- (setq params (tooltip-set-param params 'foreground-color fg))
- (setq params (tooltip-set-param params 'border-color fg)))
+ (setf (alist-get 'foreground-color params) fg)
+ (setf (alist-get 'border-color params) fg))
(when (stringp bg)
- (setq params (tooltip-set-param params 'background-color bg)))
+ (setf (alist-get 'background-color params) bg))
(x-show-tip (propertize text 'face 'tooltip)
(selected-frame)
params
@@ -288,10 +284,6 @@ is based on the current syntax table."
(when (> (point) start)
(buffer-substring start (point)))))))
-(defmacro tooltip-region-active-p ()
- "Value is non-nil if the region should override command actions."
- `(use-region-p))
-
(defun tooltip-expr-to-print (event)
"Return an expression that should be printed for EVENT.
If a region is active and the mouse is inside the region, print
@@ -299,7 +291,7 @@ the region. Otherwise, figure out the identifier around the point
where the mouse is."
(with-current-buffer (tooltip-event-buffer event)
(let ((point (posn-point (event-end event))))
- (if (tooltip-region-active-p)
+ (if (use-region-p)
(when (and (<= (region-beginning) point) (<= point (region-end)))
(buffer-substring (region-beginning) (region-end)))
(tooltip-identifier-from-point point)))))
@@ -345,10 +337,10 @@ It is also called if Tooltip mode is on, for text-only displays."
((stringp help)
(setq help (replace-regexp-in-string "\n" ", " help))
(unless (or tooltip-previous-message
- (string-equal help (current-message))
+ (equal-including-properties help (current-message))
(and (stringp tooltip-help-message)
- (string-equal tooltip-help-message
- (current-message))))
+ (equal-including-properties tooltip-help-message
+ (current-message))))
(setq tooltip-previous-message (current-message)))
(setq tooltip-help-message help)
(let ((message-truncate-lines t)
@@ -371,7 +363,7 @@ MSG is either a help string to display, or nil to cancel the display."
;; Cancel display. This also cancels a delayed tip, if
;; there is one.
(tooltip-hide))
- ((equal previous-help msg)
+ ((equal-including-properties previous-help msg)
;; Same help as before (but possibly the mouse has moved).
;; Keep what we have.
)
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index 2f73aee3ed4..0f1e4de852b 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -1,6 +1,6 @@
;;; tree-widget.el --- Tree widget
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
@@ -294,9 +294,9 @@ Typically it should contain something like this:
(tree-widget-set-parent-theme \"my-parent-theme\")
(tree-widget-set-image-properties
- (if (featurep 'xemacs)
- '(:ascent center)
- '(:ascent center :mask (heuristic t))
+ (if (featurep \\='xemacs)
+ \\='(:ascent center)
+ \\='(:ascent center :mask (heuristic t))
))"
(or name (setq name (or tree-widget-theme "default")))
(unless (string-equal name (tree-widget-theme-name))
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index d581cb13e28..a4a422fbc4f 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -1,8 +1,8 @@
;;; tutorial.el --- tutorial for Emacs
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, internal
;; Package: emacs
@@ -63,8 +63,8 @@ with default Emacs bindings information about this is shown.
VALUE should have either of these formats:
- \(cua-mode)
- \(current-binding KEY-FUN DEF-FUN KEY WHERE)
+ (cua-mode)
+ (current-binding KEY-FUN DEF-FUN KEY WHERE)
Where
KEY is a key sequence whose standard binding has been changed
@@ -134,21 +134,20 @@ options:
(eq map (symbol-value s))
;; then save this value in mapsym
(setq mapsym s)))))
- (insert "The default Emacs binding for the key "
- (key-description key)
- " is the command `")
- (insert (format "%s" db))
- (insert "'. "
- "However, your customizations have "
+ (insert
+ (format-message
+ "The default Emacs binding for the key %s is the command `%s'. "
+ (key-description key)
+ db))
+ (insert "However, your customizations have "
(if cb
- (format "rebound it to the command `%s'" cb)
+ (format-message "rebound it to the command `%s'" cb)
"unbound it"))
(insert ".")
(when mapsym
(insert " (For the more advanced user:"
- " This binding is in the keymap `"
- (format "%s" mapsym)
- "'.)"))
+ (format-message
+ " This binding is in the keymap `%s'.)" mapsym)))
(if (string= where "")
(unless (keymapp db)
(insert "\n\nYou can use M-x "
@@ -160,9 +159,7 @@ options:
""
"the key")
where
- " to get the function `"
- (format "%s" db)
- "'.")))
+ (format-message " to get the function `%s'." db))))
(fill-region (point-min) (point)))))
(help-print-return-message))))
@@ -209,10 +206,10 @@ LEFT and RIGHT are the elements to compare."
(symbol-name cx)))))))
(defconst tutorial--default-keys
- ;; On window system, `suspend-emacs' is replaced in the default
- ;; keymap
+ ;; On window system, `suspend-emacs' is replaced in the default keymap.
(let* ((suspend-emacs 'suspend-frame)
(default-keys
+ ;; The first few are not mentioned but are basic:
`((ESC-prefix [27])
(Control-X-prefix [?\C-x])
(mode-specific-command-prefix [?\C-c])
@@ -405,8 +402,8 @@ where
REMARK is a list with info about rebinding. It has either of
these formats:
- \(TEXT cua-mode)
- \(TEXT current-binding KEY-FUN DEF-FUN KEY WHERE)
+ (TEXT cua-mode)
+ (TEXT current-binding KEY-FUN DEF-FUN KEY WHERE)
Here TEXT is a link text to show to the user. The
rest of the list is used to show information when
@@ -454,7 +451,7 @@ where
(lookup-key global-map
[menu-bar]))))
(stringp cwhere))
- (format "the `%s' menu" cwhere)
+ (format-message "the `%s' menu" cwhere)
"the menus"))))
(setq where ""))
(setq remark nil)
@@ -548,7 +545,11 @@ with some explanatory links."
(start (point))
(case-fold-search nil)
(keybindings-regexp
- (concat "[[:space:]]\\("
+ ;; Accept either [:space:] or [:punct:] before the key
+ ;; binding because the Hebrew tutorial uses directional
+ ;; controls and Hebrew character maqaf, the Hebrew hyphen,
+ ;; immediately before the binding string.
+ (concat "\\(?:[[:space:]]\\|[[:punct:]]\\)\\("
(mapconcat (lambda (kdf) (regexp-quote
(tutorial--key-description
(nth 1 kdf))))
diff --git a/lisp/type-break.el b/lisp/type-break.el
index b4e4be31955..5f56956c52b 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -1,6 +1,6 @@
;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 1997, 2000-2013 Free Software Foundation,
+;; Copyright (C) 1994-1995, 1997, 2000-2015 Free Software Foundation,
;; Inc.
;; Author: Noah Friedman
@@ -45,7 +45,7 @@
;; If you find echo area messages annoying and would prefer to see messages
;; in the mode line instead, do M-x type-break-mode-line-message-mode
-;; or set the variable of the same name to `t'.
+;; or set the variable of the same name to t.
;; This program can truly cons up a storm because of all the calls to
;; `current-time' (which always returns fresh conses). I'm dismayed by
@@ -208,6 +208,7 @@ key is pressed."
(locate-user-emacs-file "type-break" ".type-break")
"Name of file used to save state across sessions.
If this is nil, no data will be saved across sessions."
+ :version "24.4" ; added locate-user
:type 'file)
(defvar type-break-post-command-hook '(type-break-check)
@@ -604,8 +605,7 @@ INTERVAL is the full length of an interval (defaults to TIME)."
(type-break-time-warning-schedule time 'reset)
(type-break-run-at-time (max 1 time) nil 'type-break-alarm)
(setq type-break-time-next-break
- (type-break-time-sum (or start (current-time))
- (or interval time))))
+ (type-break-time-sum start (or interval time))))
(defun type-break-cancel-schedule ()
(type-break-cancel-time-warning-schedule)
@@ -677,7 +677,7 @@ INTERVAL is the full length of an interval (defaults to TIME)."
(defun type-break-check ()
"Ask to take a typing break if appropriate.
This may be the case either because the scheduled time has come \(and the
-minimum keystroke threshold has been reached\) or because the maximum
+minimum keystroke threshold has been reached) or because the maximum
keystroke threshold has been exceeded."
(type-break-file-keystroke-count)
(let* ((min-threshold (car type-break-keystroke-threshold))
@@ -803,8 +803,9 @@ this or ask the user to start one right now."
(type-break-mode-line-message-mode)
(t
(beep t)
- (message "%sYou should take a typing break now. Do `M-x type-break'."
- (type-break-time-stamp))
+ (message "%sYou should take a typing break now. Do `%s'."
+ (type-break-time-stamp)
+ (substitute-command-keys "\\[type-break]"))
(sit-for 1)
(beep t)
;; return nil so query caller knows to reset reminder, as if user
@@ -961,19 +962,11 @@ FRAC should be the inverse of the fractional value; for example, a value of
(defun type-break-time-difference (a b)
(round (float-time (time-subtract b a))))
-;; Return (in a new list the same in structure to that returned by
-;; `current-time') the sum of the arguments. Each argument may be a time
-;; list or a single integer, a number of seconds.
-;; This function keeps the high and low 16 bits of the seconds properly
-;; balanced so that the lower value never exceeds 16 bits. Otherwise, when
-;; the result is passed to `current-time-string' it will toss some of the
-;; "low" bits and format the time incorrectly.
+;; Return a time value that is the sum of the time-value arguments.
(defun type-break-time-sum (&rest tmlist)
- (let ((sum '(0 0 0)))
+ (let ((sum '(0 0)))
(dolist (tem tmlist)
- (setq sum (time-add sum (if (integerp tem)
- (list (floor tem 65536) (mod tem 65536))
- tem))))
+ (setq sum (time-add sum tem)))
sum))
(defun type-break-time-stamp (&optional when)
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 546796b619a..c5692ffde34 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -1,10 +1,10 @@
;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*-
-;; Copyright (C) 1989, 1995-1997, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1989, 1995-1997, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Dick King <king@reasoning.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Created: 15 May 86
;; Package: emacs
@@ -26,7 +26,7 @@
;;; Commentary:
-;; Emacs's standard method for making buffer names unique adds <2>, <3>,
+;; Emacs's traditional method for making buffer names unique adds <2>, <3>,
;; etc. to the end of (all but one of) the buffers. This file replaces
;; that behavior, for buffers visiting files and dired buffers, with a
;; uniquification that adds parts of the file name until the buffer names
@@ -93,38 +93,34 @@
:group 'files)
-(defcustom uniquify-buffer-name-style nil
- "If non-nil, buffer names are uniquified with parts of directory name.
-The value determines the buffer name style and is one of `forward',
-`reverse', `post-forward', or `post-forward-angle-brackets'.
-For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
+(defcustom uniquify-buffer-name-style 'post-forward-angle-brackets
+ "How to construct unique buffer names for files with the same base name.
+The value can be one of: `forward', `reverse', `post-forward',
+`post-forward-angle-brackets', or nil.
+
+For example, the files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
would have the following buffer names in the various styles:
- forward bar/mumble/name quux/mumble/name
- reverse name\\mumble\\bar name\\mumble\\quux
- post-forward name|bar/mumble name|quux/mumble
- post-forward-angle-brackets name<bar/mumble> name<quux/mumble>
- nil name name<2>
-Of course, the \"mumble\" part may be stripped as well, depending on the setting
-of `uniquify-strip-common-suffix'."
+
+ forward bar/mumble/name quux/mumble/name
+ reverse name\\mumble\\bar name\\mumble\\quux
+ post-forward name|bar/mumble name|quux/mumble
+ post-forward-angle-brackets name<bar/mumble> name<quux/mumble>
+ nil name name<2>
+
+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."
:type '(radio (const forward)
(const reverse)
(const post-forward)
(const post-forward-angle-brackets)
- (const :tag "standard Emacs behavior (nil)" nil))
- :require 'uniquify
- :group 'uniquify)
+ (const :tag "numeric suffixes" nil))
+ :version "24.4"
+ :require 'uniquify)
(defcustom uniquify-after-kill-buffer-p t
"If non-nil, rerationalize buffer names after a buffer has been killed."
- :type 'boolean
- :group 'uniquify)
-
-(defcustom uniquify-ask-about-buffer-names-p nil
- "If non-nil, permit user to choose names for buffers with same base file.
-If the user chooses to name a buffer, uniquification is preempted and no
-other buffer names are changed."
- :type 'boolean
- :group 'uniquify)
+ :type 'boolean)
;; The default value matches certain Gnus buffers.
(defcustom uniquify-ignore-buffers-re nil
@@ -132,13 +128,11 @@ other buffer names are changed."
For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename
draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the
visited file name isn't the same as that of the buffer."
- :type '(choice (const :tag "Uniquify all buffers" nil) regexp)
- :group 'uniquify)
+ :type '(choice (const :tag "Uniquify all buffers" nil) regexp))
(defcustom uniquify-min-dir-content 0
"Minimum number of directory name components included in buffer name."
- :type 'integer
- :group 'uniquify)
+ :type 'integer)
(defcustom uniquify-separator nil
"String separator for buffer name components.
@@ -146,16 +140,14 @@ When `uniquify-buffer-name-style' is `post-forward', separates
base file name from directory part in buffer names (default \"|\").
When `uniquify-buffer-name-style' is `reverse', separates all
file name components (default \"\\\")."
- :type '(choice (const nil) string)
- :group 'uniquify)
+ :type '(choice (const nil) string))
(defcustom uniquify-trailing-separator-p nil
"If non-nil, add a file name separator to dired buffer names.
If `uniquify-buffer-name-style' is `forward', add the separator at the end;
if it is `reverse', add the separator at the beginning; otherwise, this
variable is ignored."
- :type 'boolean
- :group 'uniquify)
+ :type 'boolean)
(defcustom uniquify-strip-common-suffix
;; Using it when uniquify-min-dir-content>0 doesn't make much sense.
@@ -164,8 +156,7 @@ variable is ignored."
E.g. if you open /a1/b/c/d and /a2/b/c/d, the buffer names will say
\"d|a1\" and \"d|a2\" instead of \"d|a1/b/c\" and \"d|a2/b/c\".
This can be handy when you have deep parallel hierarchies."
- :type 'boolean
- :group 'uniquify)
+ :type 'boolean)
(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode vc-dir-mode)
"List of modes for which uniquify should obey `list-buffers-directory'.
diff --git a/lisp/url/.gitignore b/lisp/url/.gitignore
deleted file mode 100644
index 362a9c89b75..00000000000
--- a/lisp/url/.gitignore
+++ /dev/null
@@ -1,4 +0,0 @@
-Makefile
-auto-autoloads.el
-custom-load.el
-url-auto.el
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog.1
index 52a69690534..8733614387a 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog.1
@@ -1,3 +1,200 @@
+2015-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-handlers.el (url-insert-file-contents): Call
+ after-insert-file-set-coding like insert-file-contents, to set
+ buffer-file-coding-system (bug#20010).
+
+2015-01-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't downcase system diagnostics' first letters
+ * url-dav.el (url-dav-delete-directory, url-dav-delete-file)
+ (url-dav-directory-files): Keep diagnostics consistent with system's.
+
+2015-01-17 Ivan Shmakov <ivan@siamics.net>
+
+ * url-cookie.el (url-cookie-write-file): Let-bind print-length
+ and print-level to nil to avoid writing a garbled list. (Bug#16805)
+
+2014-12-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-parse-headers): `gnutls-available-p' is
+ now always available.
+
+2014-12-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-parse-headers): Check that
+ `gnutls-available-p' is defined (bug#19346).
+
+2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http-parse-headers): Pass the GnuTLS status of
+ the connection to the caller.
+ (url-http-parse-headers): When being redirected, make sure we
+ flush the previous certificate.
+
+2014-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-http.el (url-http-activate-callback): Make debug more verbose.
+
+2014-12-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * url-future.el (url-future-done-p, url-future-completed-p)
+ (url-future-errored-p, url-future-cancelled-p):
+ * url-dav.el (url-dav-http-success-p): Use define-inline.
+
+2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * url-http.el (url-http): Respect `url-request-noninteractive'.
+
+ * url-queue.el (url-queue-start-retrieve): Fetching through
+ url-queue should always be noninteractive.
+
+ * url-vars.el (url-request-noninteractive): New variable.
+
+2014-11-14 David Reitter <david.reitter@gmail.com>
+
+ * url-domsuf.el (url-domsuf-parse-file): Read compressed
+ publicsuffix file if available.
+
+2014-11-05 Teodor Zlatanov <tzz@lifelogs.com>
+
+ * url-http.el (url-user-agent): New variable, can be function or
+ string. Suggested by Vibhav Pant <vibhavp@ubuntu.com>.
+ Add :version. (Bug#16498)
+
+ (url-http-user-agent-string): Use it.
+
+2014-10-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of current-time and friends.
+ * url-cache.el (url-cache-prune-cache):
+ Rename local var to avoid confusion.
+ * url-util.el (url-get-normalized-date):
+ Omit unnecessary call to current-time.
+
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * Merge in all changes up to 24.4 release.
+
+2014-10-07 Eli Zaretskii <eliz@gnu.org>
+
+ * url-http.el (url-http-create-request): Recheck zlib availability
+ on windows-nt each time it might be required. (Bug#18650)
+
+2014-09-28 Ulf Jasper <ulf.jasper@web.de>
+
+ * url-gw.el (url-open-stream): New optional parameter
+ `gateway-method'. If non-nil use it instead of global variable
+ `url-gateway-method'.
+
+ * url/url-http.el (url-http): New optional parameter
+ `gateway-method', pass it to `url-http-find-free-connection'.
+ (url-http-find-free-connection): New optional parameter
+ gateway-method, pass it to `url-open-stream'.
+ (url-https-create-secure-wrapper): Do not modify
+ `url-gateway-method' but explicitly provide 'tls as gateway-method
+ parameter to `url-https'.
+
+2014-09-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ * url.el (url-retrieve-internal): Clarify the docstring.
+
+ * url-http.el (url-http): Same. (Bug#18116)
+
+2014-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ * url-handlers.el: Remove a comment about VMS, which we no longer
+ support.
+
+2014-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't mishandle dates in the year 9999 (Bug#18176).
+ * url-cookie.el (url-cookie-expired-p): Treat out-of-range
+ expiration dates as if they were far in the future.
+
+2014-06-26 Leo Liu <sdl.web@gmail.com>
+
+ * url-http.el (url-http-end-of-headers): Remove duplicate defvar.
+
+ * url-handlers.el (url-http-parse-response): Remove unused autoload.
+ (url-insert-file-contents): Condition on url-http-response-status
+ for the HTTP/S specific part. (Bug#17549)
+
+2014-05-14 Glenn Morris <rgm@gnu.org>
+
+ * url-util.el (url-make-private-file): Use with-file-modes.
+
+2014-05-12 Michael Albinus <michael.albinus@gmx.de>
+
+ * url-handlers.el (url-file-handler-load-in-progress): New defvar.
+ (url-file-handler): Use it, in order to avoid recursive load.
+
+2014-05-04 Glenn Morris <rgm@gnu.org>
+
+ * url-parse.el (url-generic-parse-url): Doc fix (replace `iff').
+
+2014-04-01 Michael Albinus <michael.albinus@gmx.de>
+
+ * url-tramp.el: New file.
+
+ * url-handlers.el (url-handler-regexp): Add ssh, scp, rsync and telnet.
+ Add :version.
+ (url-file-handler): Call `url-tramp-file-handler' if appropriate.
+
+2014-03-28 Glenn Morris <rgm@gnu.org>
+
+ * url-vars.el (url-bug-address): Make into an obsolete alias.
+ * url-http.el (url-http-handle-authentication):
+ * url-news.el (url-news-fetch-message-id):
+ Use M-x report-emacs-bug in help messages.
+
+2014-03-26 Juanma Barranquero <lekktu@gmail.com>
+
+ * url-handlers.el (url-http-parse-response): Add autoload.
+ (url-insert-file-contents): Signal file-error in case of HTTP error.
+
+2014-02-05 Glenn Morris <rgm@gnu.org>
+
+ * url-cookie.el (url-cookie-list): Doc fix.
+
+2014-01-25 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
+
+ * url-vars.el (url): Link to info manual.
+
+2014-01-08 Jarosław Rzeszótko <sztywny@gmail.com> (tiny change)
+
+ * url-http.el (url-http-create-request): Don't add extra \r\n after
+ http data (bug#16220).
+
+2013-12-28 Glenn Morris <rgm@gnu.org>
+
+ * url-history.el (url-history-track):
+ * url-vars.el (url-honor-refresh-requests): Fix custom types.
+
+2013-12-20 Leo Liu <sdl.web@gmail.com>
+
+ * url.el (url-retrieve-synchronously): Add optional arg SILENT and
+ INHIBIT-COOKIES.
+
+2013-09-29 Leo Liu <sdl.web@gmail.com>
+
+ * url-util.el (url-pretty-length): Make obsolete and all uses
+ changed to file-size-human-readable.
+
+2013-09-18 Glenn Morris <rgm@gnu.org>
+
+ * url-http.el (zlib-decompress-region): Declare.
+
+2013-09-16 Glenn Morris <rgm@gnu.org>
+
+ * url-misc.el (url-data): Avoid match-data mix-up with base64 case.
+ Use Content-Transfer-Encoding rather than Content-Encoding. (Bug#15285)
+
+2013-09-13 Glenn Morris <rgm@gnu.org>
+
+ * url-http.el (url-handle-content-transfer-encoding):
+ * url-vars.el (url-mime-encoding-string): Silence compiler.
+
2013-08-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-http.el (url-http-parse-headers): Always place point at the
@@ -5,19 +202,19 @@
2013-08-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-http.el (url-handle-content-transfer-encoding): Renamed
+ * url-http.el (url-handle-content-transfer-encoding): Rename
`zlib-decompress-gzipped-region' and check whether it's available,
too.
- (url-handle-content-transfer-encoding): Renamed
- `zlib-decompress-region' again.
+ (url-handle-content-transfer-encoding):
+ Rename `zlib-decompress-region' again.
2013-08-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
* url-vars.el (url-mime-encoding-string): If we have built-in gzip
support, say that we accept gzipped content.
- * url-http.el (url-handle-content-transfer-encoding): Support
- decompressing gzipped content.
+ * url-http.el (url-handle-content-transfer-encoding):
+ Support decompressing gzipped content.
2013-07-31 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -262,7 +459,7 @@
2012-04-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
- * url-domsurf.el: New file (bug#1401).
+ * url-domsuf.el: New file (bug#1401).
* url-cookie.el (url-cookie-two-dot-domains): Remove.
(url-cookie-host-can-set-p): Use `url-domsuf-cookie-allowed-p'
@@ -1575,6 +1772,16 @@
* url-cookie.el (url-cookie-multiple-line): Fix spelling in docstring.
+2005-06-04 David Reitter <david.reitter@gmail.com> (tiny change)
+
+ * url-http.el (url-http-chunked-encoding-after-change-function):
+ Use `url-http-debug' instead of `message'.
+
+2005-06-04 Thierry Emery <thierry.emery@free.fr> (tiny change)
+
+ * url-http.el (url-http-parse-headers): Pass redirected URL
+ as a callback argument.
+
2005-05-19 Juanma Barranquero <lekktu@gmail.com>
* url-cookie.el (url-cookie-multiple-line):
@@ -1598,6 +1805,11 @@
* url.el (url-retrieve-synchronously): Work around the fact that
url-http sometimes doesn't call the callback.
+2005-04-10 Chong Yidong <cyd@stupidchicken.com>
+
+ * url-ldap.el (url-ldap): Add docstring. Fix call to
+ `ldap-search-internal'.
+
2005-04-04 Lute Kamstra <lute@gnu.org>
* url-handlers.el (url-handler-mode): Specify :group.
@@ -1856,27 +2068,27 @@
2003-07-16 Dave Love <fx@gnu.org>
- * lisp/url.el (url-retrieve-synchronously): Revert last change.
+ * url.el (url-retrieve-synchronously): Revert last change.
Should be revisited.
2003-06-26 Sam Steingold <sds@gnu.org>
- * lisp/url-handlers.el (url-handlers-create-wrapper): Do not call
+ * url-handlers.el (url-handlers-create-wrapper): Do not call
method on invalid urls.
2003-05-29 Dave Love <fx@gnu.org>
- * lisp/url.el (url-retrieve-synchronously): Use sleep-for, not
+ * url.el (url-retrieve-synchronously): Use sleep-for, not
sit-for. From monnier@gnu.org.
2002-11-04 Walter C. Pelissero <walter@pelissero.org>
- * lisp/url-methods.el (url-scheme-register-proxy): Make sure to convert
+ * url-methods.el (url-scheme-register-proxy): Make sure to convert
port numbers to integers when creating the URL objects for proxies.
2002-10-29 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-parse-headers): When doing a
+ * url-http.el (url-http-parse-headers): When doing a
redirect, some broken software (sourceforge) sends a redirect to
'/', which is blatantly illegal (see section 14.30 of the HTTP/1.1
specification). I wish we could deal with such lame software
@@ -1885,13 +2097,13 @@
2002-10-27 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-create-request): If we are talking to
+ * url-http.el (url-http-create-request): If we are talking to
the default port for a the selected protocol, do NOT send the port
in the HOST header. This fixes the login page at sourceforge.
2002-09-17 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-handle-cookies): New function to deal
+ * url-http.el (url-http-handle-cookies): New function to deal
with cookie headers.
(url-http-parse-headers): Call `url-http-handle-cookies' here so
that cookie additions and deletions get handled immediately.
@@ -1903,67 +2115,56 @@
methods to GET in redirects. Too many web sites do this now, and
it is just likely to confuse users.
-2002-05-17 Dave Love <fx@gnu.org>
-
- * texi/url.txi: Start making it vaguely useful.
-
- * texi/Makefile.in (install): Cope with Debian install-info.
- From Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Grossjohann).
-
2002-04-22 Dave Love <fx@gnu.org>
- * lisp/url-misc.el (man): Autoload to avoid warning.
+ * url-misc.el (man): Autoload to avoid warning.
(url-man): Don't require man here.
(url-data): Generalize in line with the RFC.
- * lisp/url-gw.el (url-open-stream): Remove obsolete `tcp' case.
+ * url-gw.el (url-open-stream): Remove obsolete `tcp' case.
- * lisp/url-vars.el: Doc fixes.
+ * url-vars.el: Doc fixes.
(url-mime-charset-string): New function.
(url-mime-charset-string): Use it to set the variable.
(url-set-mime-charset-string): New function.
(set-language-environment-hook): Use it.
(url-vars-unload-hook): New function.
- * lisp/url-cookie.el (url-header-comparison): Delete.
+ * url-cookie.el (url-header-comparison): Delete.
(url-cookie-handle-set-cookie): Use assoc-ignore-case to avoid assoc*.
(url-cookie-save-interval): Make value agree with doc.
- * lisp/url.el: Doc fixes.
+ * url.el: Doc fixes.
(url-mm-callback): Don't call mm-destroy-parts immediately for
external viewing -- set up a process sentinel.
-2002-02-02 William M. Perry <wmperry@gnu.org>
-
- * lisp/Makefile.in (SOURCES): Remove mule-sysdp.el from the build rules.
-
2001-12-12 William M. Perry <wmperry@gnu.org>
- * lisp/url-vars.el (url-nonrelative-link): Patch from Stefan
+ * url-vars.el (url-nonrelative-link): Patch from Stefan
Monnier to use ` instead of ^ to match the relative link.
2001-12-10 William M. Perry <wmperry@gnu.org>
- * lisp/url-dav.el (url-dav-file-attributes): Fix bad call to
+ * url-dav.el (url-dav-file-attributes): Fix bad call to
plist-get (reversed args).
- * lisp/url-file.el (url-file-build-filename): Make sure that we
+ * url-file.el (url-file-build-filename): Make sure that we
have a parsed URL in this function.
2002-01-22 Dave Love <fx@gnu.org>
- * lisp/url-cache.el (url-cache-file-writable-p): Doc fix.
+ * url-cache.el (url-cache-file-writable-p): Doc fix.
- * lisp/url-imap.el (url-imap): Maybe disable multibyte.
+ * url-imap.el (url-imap): Maybe disable multibyte.
Bind coding-system-for-read. Require mm-util.
- * lisp/url.el (url-do-setup): Use (featurep 'xemacs).
+ * url.el (url-do-setup): Use (featurep 'xemacs).
- * lisp/mule-sysdp.el: Removed (obsolete).
+ * mule-sysdp.el: Removed (obsolete).
2001-12-09 William M. Perry <wmperry@gnu.org>
- * lisp/url-dav.el (url-dav-delete-something): Utility macro to
+ * url-dav.el (url-dav-delete-something): Utility macro to
remove an arbitrary resource.
(url-dav-delete-directory): Use it.
(url-dav-delete-file): Ditto.
@@ -1976,14 +2177,14 @@
2001-12-08 William M. Perry <wmperry@gnu.org>
- * lisp/url-dav.el (url-dav-directory-files): New function to
+ * url-dav.el (url-dav-directory-files): New function to
mimic `directory-files' for WebDAV.
(url-dav-delete-directory): New function to mimic
`delete-directory' for WebDAV.
2001-12-06 William M. Perry <wmperry@gnu.org>
- * lisp/url-dav.el (url-dav-process-DAV:locktoken): Parse the
+ * url-dav.el (url-dav-process-DAV:locktoken): Parse the
DAV:locktoken hrefs into a usable format.
(url-dav-process-response): Use an unwind-protect to make sure
that we clean up the buffer, even if there is a parsing error.
@@ -2006,23 +2207,23 @@
using the PUT method. I can now successfully save files to an
HTTP server with some manual steps from a lisp-interaction buffer.
- * lisp/url-http.el (url-http-wait-for-headers-change-function):
+ * url-http.el (url-http-wait-for-headers-change-function):
Special case the 204/205 response codes. Some servers do not
send back a 0 content-length for these, and we would hang.
(url-http-parse-headers): Mark 204/205 response codes as
'successful' so that the callbacks get activated.
(url-http-options): Fix unbound variable usage.
- * lisp/url-dav.el: Added full copyright information.
+ * url-dav.el: Added full copyright information.
(url-dav-process-response): Make sure that we create a DAV:status
property when parsing a singleton response.
(url-dav-file-attributes): If the properties returned did not have
a successful HTTP response code, then ignore them and use the
HEAD-based attributes.
- * lisp/vc-dav.el: Added full copyright information.
+ * vc-dav.el: Added full copyright information.
- * lisp/url-dav.el (url-dav-process-supportedlock-property):
+ * url-dav.el (url-dav-process-supportedlock-property):
Deal with text nodes in DAV:supportedlock nodes.
(url-dav-file-attributes-mode-string): This now gets the entire
property list instead of just the DAV:supportedlock node.
@@ -2077,18 +2278,18 @@
2001-12-05 William M. Perry <wmperry@gnu.org>
- * lisp/url-dav.el (url-dav-get-properties): New argument
+ * url-dav.el (url-dav-get-properties): New argument
ATTRIBUTES that allows you to ask for specific properties instead
of getting all properties via DAV:allprop.
- * lisp/url-http.el (url-http-real-basic-auth-storage):
+ * url-http.el (url-http-real-basic-auth-storage):
New variable for normal HTTP basic authentication.
(url-http-proxy-basic-auth-storage): New variable for HTTP proxy
basic authentication.
(url-http-handle-authentication): Follow new semantics for
url-basic-auth-storage.
- * lisp/url-auth.el (url-basic-auth-storage): Change meaning of
+ * url-auth.el (url-basic-auth-storage): Change meaning of
this variable. It is now a symbol pointing to where we really
want to store the authorization information. This fixes proxy
auth and normal basic auth because of some local bindings that were
@@ -2096,13 +2297,13 @@
(url-basic-auth): Make sure we dereference url-basic-auth-storage
everywhere.
- * lisp/url-util.el (url-debug): Add new types 'dav and
+ * url-util.el (url-debug): Add new types 'dav and
'retrieval to the customization list.
- * lisp/url.el (url-retrieve-synchronously): Put in some debugging
+ * url.el (url-retrieve-synchronously): Put in some debugging
statements.
- * lisp/url-http.el (url-http-head-file-attributes): Rename old
+ * url-http.el (url-http-head-file-attributes): Rename old
url-http-file-attributes so that we can have a smarter one that
tries WebDAV first, then HEAD.
(url-http-file-attributes): New smart version that tries WebDAV first.
@@ -2119,7 +2320,7 @@
data. Otherwise we can deadlock if the headers and the entire
body exist arrive in one chunk.
- * lisp/url-dav.el: New file to contain the WebDAV
+ * url-dav.el: New file to contain the WebDAV
(http://www.webdav.org/) implementation.
(url-dav-supported-p): Cheap way to figure out whether we will be
able to do DAV at all. We rely on the XML parser expanding
@@ -2142,7 +2343,7 @@
2001-12-04 William M. Perry <wmperry@gnu.org>
- * lisp/url-handlers.el (file-name-absolute-p): New hooked
+ * url-handlers.el (file-name-absolute-p): New hooked
version. If the filename matches our regexp, then it is always
absolute, so just return `t'.
(expand-file-name): New hooked version. If the fragment is an
@@ -2151,30 +2352,30 @@
want the file-name-handlers to work off of.
(url-setup-file-name-handlers): Use it when installing the handlers.
- * lisp/url-http.el (url-http-find-free-connection): Better logging
+ * url-http.el (url-http-find-free-connection): Better logging
about whether we are reusing an existing connection or not.
- * lisp/url-methods.el (url-scheme-register-proxy): Fix bad call
+ * url-methods.el (url-scheme-register-proxy): Fix bad call
to string-match instead of match-string (and with reversed
arguments even).
- * lisp/url-http.el (url-http-debug): Change to now use the
+ * url-http.el (url-http-debug): Change to now use the
generic url-debug function to do the actual logging. Still a
separate function so that we can do our magic on the network
connection if the user quits while we are downloading.
- * lisp/url-handlers.el (url-file-handler): Now logs the result of
+ * url-handlers.el (url-file-handler): Now logs the result of
the hooked or real call.
- * lisp/url-util.el (url-debug): New function for generic debug logging.
+ * url-util.el (url-debug): New function for generic debug logging.
2001-11-28 William M. Perry <wmperry@gnu.org>
- * lisp/url-imap.el (url-imap-open-host): Use backquote.
+ * url-imap.el (url-imap-open-host): Use backquote.
(url-imap): Now switches to 'login as the imap authenticator if
the URL provides a username and password.
- * lisp/url-handlers.el (url-setup-file-name-handlers): Use cl &
+ * url-handlers.el (url-setup-file-name-handlers): Use cl &
push to replace some strange logic in here.
(url-run-real-handler): New function to run the real hooks in
case we get a false positive or an operation that we do not
@@ -2197,7 +2398,7 @@
2001-11-26 William M. Perry <wmperry@gnu.org>
- * lisp/url-handlers.el (file-writable-p): Add NULL handler for
+ * url-handlers.el (file-writable-p): Add NULL handler for
this so that visiting a URL directly will work.
(file-symlink-p): Ditto.
(url-insert-file-contents): If `visit' is non-nil then make sure
@@ -2208,16 +2409,16 @@
2001-11-25 William M. Perry <wmperry@gnu.org>
- * lisp/url-util.el (url-hexify-string): Fix bad use of mapconcat.
+ * url-util.el (url-hexify-string): Fix bad use of mapconcat.
2001-11-24 William M. Perry <wmperry@gnu.org>
- * lisp/url-about.el (url-about): New loader scheme to handle
+ * url-about.el (url-about): New loader scheme to handle
about:foo URLs. Automatically tries to find a `url-about-foo'
function to display the actual data.
(url-about-protocols): Implement about:protocols.
- * lisp/url-http.el (url-http): Make sure that we signal an error
+ * url-http.el (url-http): Make sure that we signal an error
when we cannot open a network connection for whatever reason.
Before, it would just silently clean up after itself and the user
got absolutely no indication that an error had occurred. If the
@@ -2228,13 +2429,13 @@
2001-11-22 William M. Perry <wmperry@gnu.org>
- * lisp/url-https.el: Fixed definition of url-https - was using the
+ * url-https.el: Fixed definition of url-https - was using the
wrong signature. Too much cut & paste.
(url-https-create-secure-wrapper): Fix so that url-https works
at all. Was not taking a null `method' into account when calling
the wrapped function so url-https tried to call url-http-nil. *sigh*
- * lisp/url-http.el
+ * url-http.el
(url-http-chunked-encoding-after-change-function): Add some
feedback when not debugging about what content-type and chunk # we
are reading.
@@ -2249,7 +2450,7 @@
2001-11-21 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-debug): Document this variable.
+ * url-http.el (url-http-debug): Document this variable.
People other than I might want to use it.
(url-http-debug): Put some code in here to check quit-flag
directly. When the chunked encoding went into a tight spin, your
@@ -2274,10 +2475,10 @@
url-http-chunked-encoding-after-change-function. It is no longer
needed. I should use my brain sometime.
- * lisp/url-vars.el (and): Fix feature test for xemacs and
+ * url-vars.el (and): Fix feature test for xemacs and
coding-system-list behavior.
- * lisp/url-http.el
+ * url-http.el
(url-http-chunked-encoding-after-change-function): Add optional
no-initial-crlf flag that modifies the regular expression.
This is only set from url-http-wait-for-headers-change-function so that
@@ -2300,78 +2501,78 @@
2001-10-11 Dave Love <fx@gnu.org>
- * lisp/url-handlers.el: Doc fixes.
+ * url-handlers.el: Doc fixes.
(string-match): Use (featurep 'xemacs).
- * lisp/url-methods.el (url-scheme-get-property): Avoid `mapc'.
+ * url-methods.el (url-scheme-get-property): Avoid `mapc'.
- * lisp/url-proxy.el (url-find-proxy-for-url): Avoid `pop'.
+ * url-proxy.el (url-find-proxy-for-url): Avoid `pop'.
- * lisp/url-vars.el (url-running-xemacs): Delete.
+ * url-vars.el (url-running-xemacs): Delete.
(url-gateway-unplugged): New variable.
- * lisp/url-gw.el (url-open-stream): Use url-gateway-unplugged.
+ * url-gw.el (url-open-stream): Use url-gateway-unplugged.
Comment out OS/2 stuff.
2001-10-05 Dave Love <fx@gnu.org>
- * lisp/url-mailto.el (url-mailto): Don't send auto-generated mail
+ * url-mailto.el (url-mailto): Don't send auto-generated mail
without confirmation.
2001-10-02 Dave Love <fx@gnu.org>
- * lisp/url-http.el (url-http-create-request): Check cache for
+ * url-http.el (url-http-create-request): Check cache for
proxy-obj, if defined, rather than url.
(url-http): Use dolist, not mapc (runtime cl dependency).
- * lisp/url-methods.el: Maybe require cl at runtime.
+ * url-methods.el: Maybe require cl at runtime.
(url-scheme-register-proxy): Fix fetching from environment.
Don't concat a number.
2001-10-01 Dave Love <fx@gnu.org>
- * lisp/url-parse.el: Use modern backquote syntax.
+ * url-parse.el: Use modern backquote syntax.
- * lisp/url-vars.el (url-uncompressor-alist): Add bzip2.
+ * url-vars.el (url-uncompressor-alist): Add bzip2.
(url-mail-command): Prefer compose-mail.
(tcp-binary-process-input-services): Comment out.
(url-working-buffer): New constant.
- * lisp/url-util.el (url-extract-mime-headers): New function.
+ * url-util.el (url-extract-mime-headers): New function.
- * lisp/url-mailto.el (url-mailto): Set source-url. Don't add
+ * url-mailto.el (url-mailto): Set source-url. Don't add
User-Agent.
2001-09-20 Dave Love <fx@gnu.org>
- * lisp/url-http.el (url-http-create-request): Don't concat a number.
+ * url-http.el (url-http-create-request): Don't concat a number.
2001-06-05 Dave Love <fx@gnu.org>
- * lisp/url.el (url-do-setup): Doc fix. Don't try to frob
+ * url.el (url-do-setup): Doc fix. Don't try to frob
tcp-binary-process-input-services. Remove function wrapper for lambda.
(url-retrieve): Barf with sensible message if url-type is null.
- * lisp/url-http.el (url-http): Don't try to set process
+ * url-http.el (url-http): Don't try to set process
coding-system here -- done in url-gw.
- * lisp/url-gw.el (url-gw-inhibit-code-conversion): Remove.
+ * url-gw.el (url-gw-inhibit-code-conversion): Remove.
(url-open-stream): Bind coding-system-for{read,write} when setting
up the connection. Don't call url-gw-inhibit-code-conversion.
2001-05-24 William M. Perry <wmperry@gnu.org>
- * lisp/url.el (url-retrieve-synchronously): Avoid accept-process-output
+ * url.el (url-retrieve-synchronously): Avoid accept-process-output
in url-retrieve-synchronously.
2001-05-23 William M. Perry <wmperry@gnu.org>
- * lisp/url.el (url-retrieve-synchronously): Don't put a timeout on
+ * url.el (url-retrieve-synchronously): Don't put a timeout on
accept-process-output. This is evidently causing hangs in Emacs
21 when viewing complex pages with images or stylesheets.
www.yahoo.com is now viewable.
- * lisp/url-gw.el (url-open-stream): Avoid using mule-sysdp
+ * url-gw.el (url-open-stream): Avoid using mule-sysdp
(mule-inhibit-code-conversion) and just have a local function that
does this minimal cruft.
(url-gw-inhibit-code-conversion): New function to turn off code
@@ -2379,7 +2580,7 @@
2001-05-22 William M. Perry <wmperry@gnu.org>
- * lisp/url.el (url-retrieve-synchronously): Use lexical-let so
+ * url.el (url-retrieve-synchronously): Use lexical-let so
that we can allow multiple asynch retrievals to happen at once.
(url-retrieve-synchronously): Use a much smaller timeout when
doing the accept-process-output. This gets rid of the long delays
@@ -2390,39 +2591,39 @@
(url-retrieve): Ditto.
(url-mm-url): Ditto.
- * lisp/url-vars.el: Replaced `HTTP/1.0' with just `HTTP' in some
+ * url-vars.el: Replaced `HTTP/1.0' with just `HTTP' in some
documentation strings. Ok, so I'm anal.
- * lisp/url-methods.el (url-scheme-methods): Add default methods
+ * url-methods.el (url-scheme-methods): Add default methods
for file-directory-p and file-truename.
2001-05-22 Dave Love <fx@gnu.org>
- * lisp/url-auth.el (url-warn): Autoload.
+ * url-auth.el (url-warn): Autoload.
- * lisp/url-proxy.el (url-warn): Autoload.
+ * url-proxy.el (url-warn): Autoload.
- * lisp/url-nfs.el: Fix `file-truname' typo.
+ * url-nfs.el: Fix `file-truname' typo.
- * lisp/url-news.el: Require cl when compiling.
+ * url-news.el: Require cl when compiling.
(url-warn, gnus-group-read-ephemeral-group): Autoload.
(url-nntp-default-port, url-news-default-port, url-nntp): Delete.
(url-news-fetch-newsgroup): Declare gnus-group-buffer special.
- * lisp/url-util.el (mule-decode-string): Don't autoload.
+ * url-util.el (mule-decode-string): Don't autoload.
(url-hexify-string): Just barf on multibyte characters.
(url-generate-unique-filename): New function.
- * lisp/url-file.el (url-file): Use url-generate-unique-filename,
+ * url-file.el (url-file): Use url-generate-unique-filename,
not mm-generate-unique-filename.
- * lisp/url-http.el: Declare things special in various places.
+ * url-http.el: Declare things special in various places.
(url-http-activate-callback): Don't set
url-http-real-after-change-function.
2001-05-22 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-attempt-keepalives): New variable to
+ * url-http.el (url-http-attempt-keepalives): New variable to
control whether we try to do keep-alives for our connections.
(url-http-version): New variable to control whether we advertise
ourselves as an HTTP/1.1 client or not. This can be useful for
@@ -2432,13 +2633,13 @@
2001-05-21 Dave Love <fx@gnu.org>
- * lisp/url-vars.el (mm-mime-mule-charset-alist): Don't readjust it
+ * url-vars.el (mm-mime-mule-charset-alist): Don't readjust it
in XEmacs.
(url-mime-charset-string): Don't reverse the list before sorting.
2001-05-17 William M. Perry <wmperry@gnu.org>
- * lisp/url-http.el (url-http-generic-filter): Avoid using
+ * url-http.el (url-http-generic-filter): Avoid using
after-change-functions natively. There are just too many ways
that this screws up in Emacs 21. Use a filter function on the
process instead, and call the hook on
@@ -2446,111 +2647,111 @@
in Emacs 21, but one problem that has been fixed in Emacs 21
exists in Emacs 20. -- fx]
- * lisp/url-vars.el (url-mime-charset-string): sort-coding-systems
+ * url-vars.el (url-mime-charset-string): sort-coding-systems
does not exist on older versions of Emacs, or any version of
XEmacs. Do not call it unless it is bound.
2001-05-17 Dave Love <fx@gnu.org>
- * lisp/url-http.el (url-http-create-request): Fix non-GET requests.
+ * url-http.el (url-http-create-request): Fix non-GET requests.
2001-05-16 Dave Love <fx@gnu.org>
- * lisp/url-vars.el: Doc fixes. Require mm-util.
+ * url-vars.el: Doc fixes. Require mm-util.
(url-mime-charset-string): New variable.
- * lisp/url-http.el: Doc fixes.
+ * url-http.el: Doc fixes.
(url-http-create-request): Rearrange how we assemble the request.
Avoid generating bogus requests with an empty real-fname.
(url-http-handle-authentication): Declare status and success special.
(url-http): Call mm-disable-multibyte. Set process buffer's
coding systems to binary.
- * lisp/url-misc.el (url-data): Call mm-disable-multibyte.
+ * url-misc.el (url-data): Call mm-disable-multibyte.
- * lisp/url-file.el: Don't require mule-sysdp. Fix `file-truname' typo.
+ * url-file.el: Don't require mule-sysdp. Fix `file-truname' typo.
(url-file-find-possibly-compressed-file): Doc fix.
(url-file): Bind coding-system-for-read. Call mm-disable-multibyte.
- * lisp/url-cache.el: Don't require mule-sysdp.
+ * url-cache.el: Don't require mule-sysdp.
(url-store-in-cache): Avoid mule-write-region-no-coding-system.
- * lisp/url.el: Don't require mule-sysdp.
+ * url.el: Don't require mule-sysdp.
(url-retrieve): Only set text properties if url is a string.
2001-05-14 Dave Love <fx@gnu.org>
- * lisp/url-http.el (url-http-create-request):
+ * url-http.el (url-http-create-request):
Declare proxy-object, proxy-info special.
(url-http-handle-authentication): Declare success special.
2001-05-12 Dave Love <fx@gnu.org>
- * lisp/url-http.el: Revert last change.
+ * url-http.el: Revert last change.
2001-05-10 Dave Love <fx@gnu.org>
- * lisp/url-http.el (url-http-generic-after-change-function):
+ * url-http.el (url-http-generic-after-change-function):
Make it permanent-local.
2001-05-05 Dave Love <fx@gnu.org>
- * lisp/url-http.el: Autoload some functions.
+ * url-http.el: Autoload some functions.
(cl): Require when compiling.
(url-http-extra-headers): Defvar when compiling.
(url-http): Treat after-change-functions as a local hook.
- * lisp/url-history.el (url-parse): Require.
+ * url-history.el (url-parse): Require.
(url-do-setup): Autoload.
- * lisp/url-gw.el: Require url-vars. Autoload some functions.
+ * url-gw.el: Require url-vars. Autoload some functions.
- * lisp/url-file.el: Require mailcap. Require cl when compiling.
+ * url-file.el: Require mailcap. Require cl when compiling.
Use (featurep 'xemacs).
(url-file-build-filename): Bind pos-index.
(url-file): Call url-find-file-dired, not url-dired-find-file.
- * lisp/url-dired.el: Add copyright notice. Autoload some functions.
+ * url-dired.el: Add copyright notice. Autoload some functions.
(url-dired-minor-mode-map): Use (featurep 'xemacs).
(url-dired-find-file-mouse): Use mouse-set-point, not event-point.
(url-find-file-dired): Rename from one version of url-dired-find-file.
- * lisp/url-cid.el: Don't require widget. Require mm-decode
+ * url-cid.el: Don't require widget. Require mm-decode
unconditionally.
- * lisp/url-util.el: Autoload mule-decode-string,
+ * url-util.el: Autoload mule-decode-string,
timezone-parse-date, timezone-make-date-arpa-standard.
(url-unreserved-chars): Fix list per RFC 2396.
(url-hexify-string): Maybe string-make-unibyte.
- * lisp/url-news.el: Require nntp.
+ * url-news.el: Require nntp.
- * lisp/url-imap.el: Require cl when compiling. Require nnimap
+ * url-imap.el: Require cl when compiling. Require nnimap
unconditionally.
2001-05-04 Dave Love <fx@gnu.org>
- * lisp/url-handlers.el (url-file-local-copy): Use make-temp-file,
+ * url-handlers.el (url-file-local-copy): Use make-temp-file,
not non-existent mailcap-generate-unique-filename.
- * lisp/url-privacy.el: Require url-vars. Require cl when compiling.
+ * url-privacy.el: Require url-vars. Require cl when compiling.
- * lisp/url-parse.el: Require url-vars.
+ * url-parse.el: Require url-vars.
Autoload url-scheme-get-property.
- * lisp/url-nfs.el: Require cl when compiling. Test for XEmacs
+ * url-nfs.el: Require cl when compiling. Test for XEmacs
with featurep.
- * lisp/url-mailto.el: Require cl when compiling.
+ * url-mailto.el: Require cl when compiling.
- * lisp/url-cookie.el (url-cookie-handle-set-cookie):
+ * url-cookie.el (url-cookie-handle-set-cookie):
Call url-parse-args, not url-util-parse-args.
- * lisp/url-cache.el (url-cache-expired): Remove bogus `return'.
+ * url-cache.el (url-cache-expired): Remove bogus `return'.
2001-04-09 Dave Love <fx@gnu.org>
- * lisp/mule-sysdp.el (mule-detect-coding-version)
+ * mule-sysdp.el (mule-detect-coding-version)
(mule-code-convert-region, mule-inhibit-code-conversion)
(mule-write-region-no-coding-system, mule-encode-string)
(mule-decode-string, mule-truncate-string)
@@ -2561,109 +2762,106 @@
2001-01-03 Sam Steingold <sds@gnu.org>
- * lisp/url-http.el (url-http-wait-for-headers-change-function):
+ * url-http.el (url-http-wait-for-headers-change-function):
set `url-http-end-of-headers' to 0 for HTTP 0.9.
2001-01-02 Sam Steingold <sds@gnu.org>
- * lisp/url-auth.el (provide): `url-auth', not `urlauth'.
+ * url-auth.el (provide): `url-auth', not `urlauth'.
2000-12-22 Dave Love <fx@gnu.org>
- * lisp/url-history.el (url): Don't require (to avoid recursion).
+ * url-history.el (url): Don't require (to avoid recursion).
(cl): Require when compiling.
- * lisp/url-http.el (url-auth): Require.
+ * url-http.el (url-auth): Require.
(url-http-handle-authentication): Fix typo.
- * lisp/url-cookie.el (url-cookie-setup-save-timer): Fix typo.
+ * url-cookie.el (url-cookie-setup-save-timer): Fix typo.
2000-12-20 Dave Love <fx@gnu.org>
- * lisp/url.el: Require mm-decode, mm-view when compiling.
+ * url.el: Require mm-decode, mm-view when compiling.
<not (fboundp 'puthash)>: Define puthash and
autoload other has functions rather than using cl-...hash.
(url-warn): Define.
- * lisp/url-ns.el, lisp/url-methods.el, lisp/url-http.el:
+ * url-ns.el, url-methods.el, url-http.el:
Avoid cl-...hash functions.
- * lisp/url-history.el: Avoid cl-...hash functions.
+ * url-history.el: Avoid cl-...hash functions.
(url): Require.
- * lisp/url-gw.el, lisp/url-cookie.el: Require cl only when compiling.
+ * url-gw.el, url-cookie.el: Require cl only when compiling.
2000-10-03 William M. Perry <wmperry@aventail.com>
- * lisp/url-util.el (url-get-url-at-point): Guard against 'url'
+ * url-util.el (url-get-url-at-point): Guard against 'url'
getting set to nil due to bad string matching. Subsequent matches
would then choke because we passed string-match a nil.
- * lisp/url-http.el (url-http-parse-headers): Need to make the
+ * url-http.el (url-http-parse-headers): Need to make the
connection as 'free' when we get a 304 response (found in cache),
or when a keep-alive connection timed out, it would re-parse the
headers and dispatch to the callback again. Eek.
2000-10-02 William M. Perry <wmperry@aventail.com>
- * lisp/url-http.el (url-http-chunked-encoding-after-change-function):
+ * url-http.el (url-http-chunked-encoding-after-change-function):
implement chunked transfer-coding.
(url-http-create-request): We can now advertise ourselves as a 1.1
compliant browser!
2000-07-28 Sam Steingold <sds@gnu.org>
- * lisp/url-methods.el (url-scheme-default-loader): `callback' and
+ * url-methods.el (url-scheme-default-loader): `callback' and
`cbargs' are optional args (for calling from w3).
(url-scheme-register-proxy): Typos fixes: `url-match' replaced
with `string-match' and `protocol' with `scheme'.
2000-07-18 Sam Steingold <sds@gnu.org>
- * lisp/url-handlers.el (require 'url): For url-retrieve-synchronously.
- * lisp/url-history.el (url-history-save-interval): Avoid circularity.
+ * url-handlers.el (require 'url): For url-retrieve-synchronously.
+ * url-history.el (url-history-save-interval): Avoid circularity.
2000-07-10 William M. Perry <wmperry@aventail.com>
- * lisp/mule-sysdp.el (mule-make-iso-character): If we are not in
+ * mule-sysdp.el (mule-make-iso-character): If we are not in
mule, and the character requested is > 255, then return "~"
instead of letting whoever call us signal an error when they try
to insert the character.
(mule-make-iso-character): Also wrap the whole thing in a
condition case and return "~" on error, in case make-char bombs on us.
- * lisp/url-cid.el (url-cid): Fix stupid mistake in the loader
+ * url-cid.el (url-cid): Fix stupid mistake in the loader
for cid parts.
- * lisp/url-util.el (url-display-percentage): New routine that uses
+ * url-util.el (url-display-percentage): New routine that uses
the progress bar under XEmacs if available. Looks very sexy under
XEmacs/GTK hacked to use the GNOME statusbar.
- * lisp/url-http.el
+ * url-http.el
(url-http-content-length-after-change-function): Use new function
url-display-percentage instead of url-lazy-message.
2000-01-27 William M. Perry <wmperry@aventail.com>
- * lisp/url-file.el (url-file-build-filename): Work around for
+ * url-file.el (url-file-build-filename): Work around for
differences in ange-ftp / efs handling of port numbers other than 21.
1999-12-24 William M. Perry <wmperry@aventail.com>
- * lisp/url-irc.el: Added pointer to draft specification for the
+ * url-irc.el: Added pointer to draft specification for the
IRC URL so people don't think I'm crazy.
- * configure.in: Checks to make sure that Gnus was found, since we
- HAVE to have it now. Removed conditional compilation of url-cid.el.
-
1999-12-16 Eric Marsden <emarsden@mail.dotcom.fr>
- * lisp/url-util.el (url-get-url-at-point): Allow URLs wrapped in
+ * url-util.el (url-get-url-at-point): Allow URLs wrapped in
() to have periods at the end of the chunk.
1999-12-14 William M. Perry <wmperry@aventail.com>
- * lisp/url-misc.el (url-man): Implement `man' URL types.
+ * url-misc.el (url-man): Implement `man' URL types.
(url-info): Autoload.
(url-man): Ditto.
(url-rlogin): Ditto.
@@ -2671,14 +2869,14 @@
(url-tn3270): Ditto.
(url-generic-emulator-loader): Ditto.
- * lisp/url-https.el (url-https-create-secure-wrapper): New macro
+ * url-https.el (url-https-create-secure-wrapper): New macro
to wrap arbitrary `http' methods with the appropriate magic to
turn SSL on.
(file-exists-p): Use it.
(file-readable-p): Use it.
(file-attributes): Use it.
- * lisp/url-news.el (url-news-fetch-newsgroup): When building the
+ * url-news.el (url-news-fetch-newsgroup): When building the
server spec for Gnus, make sure we set
nntp-open-connection-function directly, so that other news-related
functions above us can set it.
@@ -2689,7 +2887,7 @@
1999-12-12 William M. Perry <wmperry@aventail.com>
- * lisp/url-http.el (url-http-parse-response): New function to
+ * url-http.el (url-http-parse-response): New function to
parse just the HTTP response code out of the buffer, without
taking any other actions.
(url-http-wait-for-headers-change-function): Use it here when we
@@ -2701,161 +2899,151 @@
1999-12-11 William M. Perry <wmperry@aventail.com>
- * aclocal.m4 (AC_CHECK_CUSTOMLOADS): Don't use $(EMACS) in here -
- the Makefile does that for us. We just need to provide what files
- to load/functions to run.
-
- * lisp/url-imap.el (url-imap-open-host): Need to bind
+ * url-imap.el (url-imap-open-host): Need to bind
nnimap-server-buffer or `nnimap-open-server' chokes trying to use
the current buffer as the IMAP server buffer, which fails miserably.
1999-12-11 Simon Josefsson <jas@pdc.kth.se>
- * lisp/url-imap.el: Initial (rough) implementation for IMAP urls.
+ * url-imap.el: Initial (rough) implementation for IMAP urls.
1999-12-11 William M. Perry <wmperry@aventail.com>
- * lisp/url-file.el (url-file-asynch-callback): Make the checks for
+ * url-file.el (url-file-asynch-callback): Make the checks for
ange-ftp vs. efs calling semantics consistent, so that if someone
has NEITHER of them loaded, everything should still work.
- * lisp/url-handlers.el (url-copy-file): Autoload.
+ * url-handlers.el (url-copy-file): Autoload.
(url-file-local-copy): Ditto.
(url-insert-file-contents): Ditto.
(url-setup-file-name-handlers): Ditto.
1999-12-10 William M. Perry <wmperry@aventail.com>
- * lisp/url-http.el (mail-parse): Since we use functions from here,
+ * url-http.el (mail-parse): Since we use functions from here,
we should require it, eh?
1999-12-10 Shenghuo ZHU <zsh@cs.rochester.edu>
- * lisp/url-cookie.el (url-cookie-multiple-line): One line cookie
+ * url-cookie.el (url-cookie-multiple-line): One line cookie
if nil.
(url-cookie-generate-header-lines): Use it.
1999-12-06 William M. Perry <wmperry@aventail.com>
- * lisp/mule-sysdp.el (mule-code-convert-region): Deal with Mule
+ * mule-sysdp.el (mule-code-convert-region): Deal with Mule
4.1 gracefully.
- * lisp/url-news.el: Reimplemented news and nntp URL support.
+ * url-news.el: Reimplemented news and nntp URL support.
No longer bothers to check for outdated Gnus versions, since this
will not work without them anyway.
1999-12-05 Dave Love <fx@gnu.org>
- * lisp/url-methods.el, lisp/url-proxy.el, lisp/url-util.el,
- lisp/url.el:
+ * url-methods.el, url-proxy.el, url-util.el,
+ url.el:
Require url-parse.
1999-12-05 William M. Perry <wmperry@aventail.com>
- * lisp/url-http.el (url-http-find-free-connection): Spit out a
+ * url-http.el (url-http-find-free-connection): Spit out a
message when we have to contact a host so the user always gets
at least some feedback.
- * lisp/url-expand.el (url-expander-remove-relative-links): Move and
+ * url-expand.el (url-expander-remove-relative-links): Move and
renamed function.
(url-default-expander): Use it.
- * lisp/url-file.el (url-file-asynch-callback): Deal with just efs-auto
+ * url-file.el (url-file-asynch-callback): Deal with just efs-auto
as well as efs.
(url-file): Add default content-type of application/octet-stream if
none known.
(url-file): Correct bad call to url-host-is-local-p.
- * lisp/url-handlers.el (url-insert-file-contents): Emacs doesn't
+ * url-handlers.el (url-insert-file-contents): Emacs doesn't
like buffer-substring with nil arguments.
(url-copy-file): Use mm-destroy-parts instead of just killing
the buffer. Use defined interfaces when available!
(url-insert-file-contents): Ditto.
- * lisp/url-http.el (url-http-create-request): Lots of changes to
+ * url-http.el (url-http-create-request): Lots of changes to
get proxying working.
- * lisp/url-methods.el (url-scheme-register-proxy): New function to
+ * url-methods.el (url-scheme-register-proxy): New function to
find and register a proxy for a specific scheme.
(url-scheme-get-property): Use it when we load a URL scheme for
the first time.
- * lisp/url-util.el (url-get-url-at-point): Re-integrated.
+ * url-util.el (url-get-url-at-point): Re-integrated.
1999-12-04 William M. Perry <wmperry@aventail.com>
- * lisp/url-file.el (url-file): Signal an error if
+ * url-file.el (url-file): Signal an error if
url-file-build-filename could not find the filename.
1999-12-01 William M. Perry <wmperry@aventail.com>
- * lisp/url.el (url-retrieve): Use url-history-update-url instead
+ * url.el (url-retrieve): Use url-history-update-url instead
of manipulating the hash table directly.
- * lisp/url-history.el (url-completion-function): New function to
+ * url-history.el (url-completion-function): New function to
use for reading a URL with completion.
(url-history-update-url): New function to hide the hashtable
implementation from people inserting things into the history.
1999-11-30 William M. Perry <wmperry@aventail.com>
- * lisp/url-proxy.el (url-proxy): Minor tweaks to get proxy support
+ * url-proxy.el (url-proxy): Minor tweaks to get proxy support
working.
- * lisp/url-parse.el (url-generic-parse-url): Fix bad call to
+ * url-parse.el (url-generic-parse-url): Fix bad call to
url-parse-args, which had changed the type of arguments it expects.
- * lisp/url-handlers.el (url-insert-file-contents): Ditto.
+ * url-handlers.el (url-insert-file-contents): Ditto.
(url-copy-file): Ditto.
- * lisp/url.el (url-mm-callback): Use mm-destroy-parts instead of
+ * url.el (url-mm-callback): Use mm-destroy-parts instead of
just killing the buffer. Use defined interfaces when available!
- * aclocal.m4 (AC_EMACS_LISP): Correctly redirect things out to
- AC_FD_CC so they show up in config.log
- (AC_EMACS_CHECK_LIB): Duh, fixed stupid mistake that would make
- this always return 't' instead of 'yes' on successfully finding
- the library.
-
- * lisp/url-http.el (url-http-parse-headers): Add some
+ * url-http.el (url-http-parse-headers): Add some
DAV-specific error codes.
- * lisp/url.el (url-retrieve): Allow pre-parsed URLs to be passed in.
+ * url.el (url-retrieve): Allow pre-parsed URLs to be passed in.
(url-retrieve-synchronously): Duh, make this function actually
work again. Numerous problems with it, including variable name
collisions - I love dynamically scoped lisps!
- * lisp/url-nfs.el (url-nfs-create-wrapper): New function to create
+ * url-nfs.el (url-nfs-create-wrapper): New function to create
wrappers onto the appropriate file-based URLs for file-name-handlers.
- * lisp/url-ftp.el: Moved the FTP stuff into its own file - it
+ * url-ftp.el: Moved the FTP stuff into its own file - it
might get messy with file-name-handlers and things.
- * lisp/url-http.el (url-http-clean-headers): Fix problem when
+ * url-http.el (url-http-clean-headers): Fix problem when
using 'HEAD' requests. Thou shalt not change the length of the
region during an after-change-function.
- * lisp/url-methods.el (url-scheme-methods): New variable that
+ * url-methods.el (url-scheme-methods): New variable that
holds a list of the methods/variables we look for in a URL scheme.
(url-scheme-get-property): Use it.
1999-11-29 William M. Perry <wmperry@aventail.com>
- * lisp/url-http.el (url-http-file-attributes): Reimplement.
+ * url-http.el (url-http-file-attributes): Reimplement.
(url-http-file-exists-p): Ditto.
- * lisp/url-nfs.el: Reimplemented the `nfs' URL scheme.
+ * url-nfs.el: Reimplemented the `nfs' URL scheme.
- * lisp/url-file.el (url-file-create-wrapper): New macro to create
+ * url-file.el (url-file-create-wrapper): New macro to create
file-name-handler stubs for all the FTP/FILE stuff.
- * lisp/url-handlers.el: New file to handle file-name-handler-alist
+ * url-handlers.el: New file to handle file-name-handler-alist
cruft. Generic interface on top of functions that each URL
loader provides, if capable.
1999-11-27 William M. Perry <wmperry@aventail.com>
- * lisp/url-https.el: Implemented HTTPS support.
+ * url-https.el: Implemented HTTPS support.
1999-11-26 William M. Perry <wmperry@aventail.com>
@@ -2880,8 +3068,8 @@
;; coding: utf-8
;; End:
- Copyright (C) 1999, 2001-2002, 2004-2013 Free Software
- Foundation, Inc.
+ Copyright (C) 1999, 2001-2002, 2004-2015 Free Software Foundation,
+ Inc.
This file is part of GNU Emacs.
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index e01172894ab..c9dfe17c30a 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -1,6 +1,6 @@
;;; url-about.el --- Show internal URLs
-;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index c339a2dc2ed..87f67183b55 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -1,6 +1,6 @@
;;; url-auth.el --- Uniform Resource Locator authorization modules
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -262,12 +262,12 @@ URL is the url you are requesting authorization to. This can be either a
string representing the URL, or the parsed representation returned by
`url-generic-parse-url'
REALM is the realm at a specific site we are looking for. This should be a
- string specifying the exact realm, or nil or the symbol 'any' to
+ string specifying the exact realm, or nil or the symbol `any' to
specify that the filename portion of the URL should be used as the
realm
TYPE is the type of authentication to be returned. This is either a string
- representing the type (basic, digest, etc), or nil or the symbol 'any'
- to specify that any authentication is acceptable. If requesting 'any'
+ representing the type (basic, digest, etc), or nil or the symbol `any'
+ to specify that any authentication is acceptable. If requesting `any'
the strongest matching authentication will be returned. If this is
wrong, it's no big deal, the error from the server will specify exactly
what type of auth to use
@@ -336,11 +336,11 @@ RATING a rating between 1 and 10 of the strength of the authentication.
(t rating)))
(node (assoc type url-registered-auth-schemes)))
(if (not (fboundp function))
- (url-warn 'security
- (format (concat
- "Tried to register `%s' as an auth scheme"
- ", but it is not a function!") function)))
-
+ (url-warn
+ 'security
+ (format-message
+ "Tried to register `%s' as an auth scheme, but it is not a function!"
+ function)))
(if node
(setcdr node (cons function rating))
(setq url-registered-auth-schemes
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index cb0281b87f2..8e9d128b56c 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,6 +1,6 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -212,7 +212,7 @@ If `url-standalone-mode' is non-nil, cached items never expire."
"Remove all expired files from the cache.
`url-cache-expire-time' says how old a file has to be to be
considered \"expired\"."
- (let ((current-time (current-time))
+ (let ((now (current-time))
(total-files 0)
(deleted-files 0))
(setq directory (or directory url-cache-directory))
@@ -228,7 +228,7 @@ considered \"expired\"."
(time-add
(nth 5 (file-attributes file))
(seconds-to-time url-cache-expire-time))
- current-time)
+ now)
(delete-file file)
(setq deleted-files (1+ deleted-files))))))
(if (< deleted-files total-files)
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index 5f78d0e95a0..55713c7d14b 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -1,6 +1,6 @@
;;; url-cid.el --- Content-ID URL loader
-;; Copyright (C) 1998-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 008203c90df..df9cf621037 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,6 +1,6 @@
;;; url-cookie.el --- URL cookie support
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -104,9 +104,10 @@ telling Microsoft that."
(insert ";; Emacs-W3 HTTP cookies file\n"
";; Automatically generated file!!! DO NOT EDIT!!!\n\n"
"(setq url-cookie-storage\n '")
- (pp url-cookie-storage (current-buffer))
- (insert ")\n(setq url-cookie-secure-storage\n '")
- (pp url-cookie-secure-storage (current-buffer))
+ (let ((print-length nil) (print-level nil))
+ (pp url-cookie-storage (current-buffer))
+ (insert ")\n(setq url-cookie-secure-storage\n '")
+ (pp url-cookie-secure-storage (current-buffer)))
(insert ")\n")
(insert " \n;; Local Variables:\n"
";; version-control: never\n"
@@ -158,7 +159,9 @@ telling Microsoft that."
"Return non-nil if COOKIE is expired."
(let ((exp (url-cookie-expires cookie)))
(and (> (length exp) 0)
- (> (float-time) (float-time (date-to-time exp))))))
+ (condition-case ()
+ (> (float-time) (float-time (date-to-time exp)))
+ (error nil)))))
(defun url-cookie-retrieve (host &optional localpart secure)
"Retrieve all cookies for a specified HOST and LOCALPART."
@@ -261,7 +264,7 @@ telling Microsoft that."
(and expires
(string-match
(concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
- "\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
+ "\\(..:..:..\\) +\\[*\\([^]]+\\)\\]*$")
expires)
(setq expires (concat (match-string 1 expires) " "
(match-string 2 expires) " "
@@ -352,9 +355,9 @@ to run the `url-cookie-setup-save-timer' function manually."
;;; Mode for listing and editing cookies.
(defun url-cookie-list ()
- "List the URL cookies."
+ "Display a buffer listing the current URL cookies, if there are any.
+Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies."
(interactive)
-
(when (and (null url-cookie-secure-storage)
(null url-cookie-storage))
(error "No cookies are defined"))
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index a31206a2f6f..1cf6b8209f9 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -1,9 +1,9 @@
;;; url-dav.el --- WebDAV support
-;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2015 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
-;; Maintainer: Bill Perry <wmperry@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: url, vc
;; This file is part of GNU Emacs.
@@ -479,9 +479,9 @@ names (ie: DAV:resourcetype)."
" <DAV:allprop/>")
depth nil namespaces))
-(defmacro url-dav-http-success-p (status)
+(define-inline url-dav-http-success-p (status)
"Return whether STATUS was the result of a successful DAV request."
- `(= (/ (or ,status 500) 100) 2))
+ (inline-quote (= (/ (or ,status 500) 100) 2)))
;;; Locking support
@@ -495,7 +495,7 @@ make sure you are comfortable with it leaking to the outside world.")
(defun url-dav-lock-resource (url exclusive &optional depth)
"Request a lock on URL. If EXCLUSIVE is non-nil, get an exclusive lock.
Optional 3rd argument DEPTH says how deep the lock should go, default is 0
-\(lock only the resource and none of its children\).
+\(lock only the resource and none of its children).
Returns a cons-cell of (SUCCESSFUL-RESULTS . FAILURE-RESULTS).
SUCCESSFUL-RESULTS is a list of (URL STATUS locktoken).
@@ -741,7 +741,7 @@ files in the collection as well."
(if (and (not recursive)
(/= (length props) 1))
(signal 'file-error (list "Removing directory"
- "directory not empty" url)))))
+ "Directory not empty" url)))))
(mapc (lambda (result)
(setq status (plist-get (cdr result) 'DAV:status))
@@ -760,7 +760,7 @@ files in the collection as well."
url lock-token
(setq props (url-dav-get-properties url))
(if (eq (plist-get (cdar props) 'DAV:resourcetype) 'DAV:collection)
- (signal 'file-error (list "Removing old name" "is a collection" url)))))
+ (signal 'file-error (list "Removing old name" "Is a collection" url)))))
(mapc (lambda (result)
(setq status (plist-get (cdr result) 'DAV:status))
@@ -787,7 +787,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
(when (and (= (length properties) 1)
(not (url-dav-file-directory-p url)))
- (signal 'file-error (list "Opening directory" "not a directory" url)))
+ (signal 'file-error (list "Opening directory" "Not a directory" url)))
(while properties
(setq child-props (pop properties)
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index 0ac0dfbcf71..fe621cea1aa 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -1,6 +1,6 @@
;;; url-dired.el --- URL Dired minor mode
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, files
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
index 0db33b8151f..97c07590edb 100644
--- a/lisp/url/url-domsuf.el
+++ b/lisp/url/url-domsuf.el
@@ -1,6 +1,6 @@
;;; url-domsuf.el --- Say what domain names can have cookies set.
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -32,8 +32,12 @@
(defun url-domsuf-parse-file ()
(with-temp-buffer
- (insert-file-contents
- (expand-file-name "publicsuffix.txt" data-directory))
+ (with-auto-compression-mode
+ (insert-file-contents
+ (let* ((suffixfile (expand-file-name "publicsuffix.txt" data-directory))
+ (compressed-file (concat suffixfile ".gz")))
+ (or (and (file-readable-p compressed-file) compressed-file)
+ suffixfile))))
(let ((domains nil)
domain exception)
(while (not (eobp))
@@ -72,11 +76,11 @@
((and (null modifier)
(string= domain entry))
(setq allowedp nil))
- ;; "!pref.hokkaido.jp"
+ ;; "!city.yokohama.jp"
((and (eq modifier t)
(string= domain entry))
(setq allowedp t))
- ;; "*.ar"
+ ;; "*.bd"
((and (numberp modifier)
(= length modifier)
(string= entry upper-domain))
@@ -85,13 +89,14 @@
;; Tests:
+;; TODO convert to a proper test/automated test.
;; (url-domsuf-cookie-allowed-p "com") => nil
-;; (url-domsuf-cookie-allowed-p "foo.bar.ar") => t
-;; (url-domsuf-cookie-allowed-p "bar.ar") => 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.hokkaido.jp") => nil
-;; (url-domsuf-cookie-allowed-p "pref.hokkaido.jp") => t
+;; (url-domsuf-cookie-allowed-p "bar.yokohama.jp") => nil
+;; (url-domsuf-cookie-allowed-p "city.yokohama.jp") => t
(provide 'url-domsuf)
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 51a3e64064a..c468a7952ec 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -1,6 +1,6 @@
;;; url-expand.el --- expand-file-name for URLs
-;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index e4d6b649a5b..e28af956f81 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -1,6 +1,6 @@
;;; url-file.el --- File retrieval code
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index 16e82cbe115..f558c6a97a8 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -1,6 +1,6 @@
;;; url-ftp.el --- FTP wrapper
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
index cb3276d0745..f611c817231 100644
--- a/lisp/url/url-future.el
+++ b/lisp/url/url-future.el
@@ -1,6 +1,6 @@
;;; url-future.el --- general futures facility for url.el
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Teodor Zlatanov <tzz@lifelogs.com>
;; Keywords: data
@@ -44,17 +44,17 @@
(cl-defstruct url-future callback errorback status value)
-(defmacro url-future-done-p (url-future)
- `(url-future-status ,url-future))
+(define-inline url-future-done-p (url-future)
+ (inline-quote (url-future-status ,url-future)))
-(defmacro url-future-completed-p (url-future)
- `(eq (url-future-status ,url-future) t))
+(define-inline url-future-completed-p (url-future)
+ (inline-quote (eq (url-future-status ,url-future) t)))
-(defmacro url-future-errored-p (url-future)
- `(eq (url-future-status ,url-future) 'error))
+(define-inline url-future-errored-p (url-future)
+ (inline-quote (eq (url-future-status ,url-future) 'error)))
-(defmacro url-future-cancelled-p (url-future)
- `(eq (url-future-status ,url-future) 'cancel))
+(define-inline url-future-cancelled-p (url-future)
+ (inline-quote (eq (url-future-status ,url-future) 'cancel)))
(defun url-future-finish (url-future &optional status)
(if (url-future-done-p url-future)
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 7910460910d..ab61802a6bb 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -1,8 +1,9 @@
;;; url-gw.el --- Gateway munging for URL loading
-;; Copyright (C) 1997-1998, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2004-2015 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
@@ -38,7 +39,7 @@
:group 'url-gateway)
(defcustom url-gateway-prompt-pattern
- "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
+ "^[^#$%>;]*[#$%>;] *" ;; "bash\\|[$>] *\r?$"
"A regular expression matching a shell prompt."
:type 'regexp
:group 'url-gateway)
@@ -202,20 +203,24 @@ linked Emacs under SunOS 4.x."
proc)))
;;;###autoload
-(defun url-open-stream (name buffer host service)
+(defun url-open-stream (name buffer host service &optional gateway-method)
"Open a stream to HOST, possibly via a gateway.
Args per `open-network-stream'.
Will not make a connection if `url-gateway-unplugged' is non-nil.
-Might do a non-blocking connection; use `process-status' to check."
+Might do a non-blocking connection; use `process-status' to check.
+
+Optional arg GATEWAY-METHOD specifies the gateway to be used,
+overriding the value of `url-gateway-method'."
(unless url-gateway-unplugged
- (let ((gw-method (if (and url-gateway-local-host-regexp
- (not (eq 'tls url-gateway-method))
- (not (eq 'ssl url-gateway-method))
- (string-match
- url-gateway-local-host-regexp
- host))
- 'native
- url-gateway-method))
+ (let* ((gwm (or gateway-method url-gateway-method))
+ (gw-method (if (and url-gateway-local-host-regexp
+ (not (eq 'tls gwm))
+ (not (eq 'ssl gwm))
+ (string-match
+ url-gateway-local-host-regexp
+ host))
+ 'native
+ gwm))
;; An attempt to deal with denied connections, and attempt
;; to reconnect
(cur-retries 0)
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index e9bd1628c99..a5d9f37b5ee 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -1,6 +1,6 @@
-;;; url-handlers.el --- file-name-handler stuff for URL loading
+;;; url-handlers.el --- file-name-handler stuff for URL loading -*- lexical-binding:t -*-
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -51,7 +51,7 @@
;; delete-directory Finished (DAV)
;; delete-file Finished (DAV)
;; diff-latest-backup-file
-;; directory-file-name unnecessary (what about VMS)?
+;; directory-file-name unnecessary
;; directory-files Finished (DAV)
;; dired-call-process
;; dired-compress-file
@@ -111,17 +111,18 @@ the mode if ARG is omitted or nil."
(push (cons url-handler-regexp 'url-file-handler)
file-name-handler-alist)))
-(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://"
+(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://"
"Regular expression for URLs handled by `url-handler-mode'.
When URL Handler mode is enabled, this regular expression is
added to `file-name-handler-alist'.
Some valid URL protocols just do not make sense to visit
-interactively \(about, data, info, irc, mailto, etc\). This
+interactively \(about, data, info, irc, mailto, etc.). This
regular expression avoids conflicts with local files that look
-like URLs \(Gnus is particularly bad at this\)."
+like URLs \(Gnus is particularly bad at this)."
:group 'url
:type 'regexp
+ :version "25.1"
:set (lambda (symbol value)
(let ((enable url-handler-mode))
(url-handler-mode 0)
@@ -136,25 +137,41 @@ like URLs \(Gnus is particularly bad at this\)."
(inhibit-file-name-operation operation))
(apply operation args)))
+(defvar url-file-handler-load-in-progress nil
+ "Check for recursive load.")
+
;;;###autoload
(defun url-file-handler (operation &rest args)
"Function called from the `file-name-handler-alist' routines.
OPERATION is what needs to be done (`file-exists-p', etc). ARGS are
the arguments that would have been passed to OPERATION."
- (let ((fn (get operation 'url-file-handlers))
- (val nil)
- (hooked nil))
- (if (and (not fn) (intern-soft (format "url-%s" operation))
- (fboundp (intern-soft (format "url-%s" operation))))
- (error "Missing URL handler mapping for %s" operation))
- (if fn
- (setq hooked t
- val (save-match-data (apply fn args)))
- (setq hooked nil
- val (url-run-real-handler operation args)))
- (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
- operation args val)
- val))
+ ;; Avoid recursive load.
+ (if (and load-in-progress url-file-handler-load-in-progress)
+ (url-run-real-handler operation args)
+ (let ((url-file-handler-load-in-progress load-in-progress))
+ ;; Check, whether there are arguments we want pass to Tramp.
+ (if (catch :do
+ (dolist (url (cons default-directory args))
+ (and (member
+ (url-type (url-generic-parse-url (and (stringp url) url)))
+ url-tramp-protocols)
+ (throw :do t))))
+ (apply 'url-tramp-file-handler operation args)
+ ;; Otherwise, let's do the job.
+ (let ((fn (get operation 'url-file-handlers))
+ (val nil)
+ (hooked nil))
+ (if (and (not fn) (intern-soft (format "url-%s" operation))
+ (fboundp (intern-soft (format "url-%s" operation))))
+ (error "Missing URL handler mapping for %s" operation))
+ (if fn
+ (setq hooked t
+ val (save-match-data (apply fn args)))
+ (setq hooked nil
+ val (url-run-real-handler operation args)))
+ (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real")
+ operation args val)
+ val)))))
(defun url-file-handler-identity (&rest args)
;; Identity function
@@ -206,12 +223,12 @@ the arguments that would have been passed to OPERATION."
;; which really stands for "/".
;; FIXME: maybe we should check that the host part is "" or "localhost"
;; or some name that represents the local host?
- (or (file-name-directory (url-filename url)) "/")
+ (or (file-name-as-directory (url-filename url)) "/")
;; All other URLs are not expected to be directly accessible from
;; a local process.
nil)))
-(defun url-handler-file-remote-p (filename &optional identification connected)
+(defun url-handler-file-remote-p (filename &optional identification _connected)
(let ((url (url-generic-parse-url filename)))
(if (and (url-type url) (not (equal (url-type url) "file")))
;; Maybe we can find a suitable check for CONNECTED. For now,
@@ -233,7 +250,7 @@ the arguments that would have been passed to OPERATION."
;; The actual implementation
;;;###autoload
(defun url-copy-file (url newname &optional ok-if-already-exists
- keep-time preserve-uid-gid)
+ _keep-time _preserve-uid-gid)
"Copy URL to NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if file NEWNAME already exists,
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
@@ -290,11 +307,22 @@ They count bytes from the beginning of the body."
(insert data))
(list (length data) charset)))
+(defvar url-http-codes)
+
;;;###autoload
(defun url-insert-file-contents (url &optional visit beg end replace)
(let ((buffer (url-retrieve-synchronously url)))
- (if (not buffer)
- (error "Opening input file: No such file or directory, %s" url))
+ (unless buffer (signal 'file-error (list url "No Data")))
+ (with-current-buffer buffer
+ ;; XXX: This is HTTP/S specific and should be moved to url-http
+ ;; instead. See http://debbugs.gnu.org/17549.
+ (when (bound-and-true-p url-http-response-status)
+ (unless (and (>= url-http-response-status 200)
+ (< url-http-response-status 300))
+ (let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
+ (kill-buffer buffer)
+ ;; Signal file-error per http://debbugs.gnu.org/16733.
+ (signal 'file-error (list url desc))))))
(if visit (setq buffer-file-name url))
(save-excursion
(let* ((start (point))
@@ -306,18 +334,24 @@ They count bytes from the beginning of the body."
(unless (cadr size-and-charset)
;; If the headers don't specify any particular charset, use the
;; usual heuristic/rules that we apply to files.
- (decode-coding-inserted-region start (point) url visit beg end replace))
- (list url (car size-and-charset))))))
+ (decode-coding-inserted-region start (point) url
+ visit beg end replace))
+ (let ((inserted (car size-and-charset)))
+ (when (fboundp 'after-insert-file-set-coding)
+ (let ((insval (after-insert-file-set-coding inserted visit)))
+ (if insval (setq inserted insval))))
+ (list url inserted))))))
+
(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents)
-(defun url-file-name-completion (url directory &optional predicate)
+(defun url-file-name-completion (url _directory &optional _predicate)
;; Even if it's not implemented, it's not an error to ask for completion,
;; in case it's available (bug#14806).
;; (error "Unimplemented")
url)
(put 'file-name-completion 'url-file-handlers 'url-file-name-completion)
-(defun url-file-name-all-completions (file directory)
+(defun url-file-name-all-completions (_file _directory)
;; Even if it's not implemented, it's not an error to ask for completion,
;; in case it's available (bug#14806).
;; (error "Unimplemented")
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index d0635d3f6bb..ee0a13bd989 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,6 +1,6 @@
;;; url-history.el --- Global history tracking for URL package
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -44,7 +44,7 @@ session."
(url-history-setup-save-timer)))
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
- (const :tag "within session" 'session))
+ (other :tag "within session" session))
:group 'url-history)
(defcustom url-history-file nil
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 7047e6b5f13..7367a1eb3e9 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1,8 +1,9 @@
;;; url-http.el --- HTTP retrieval routines
-;; Copyright (C) 1999, 2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2001, 2004-2015 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
@@ -24,7 +25,9 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(eval-when-compile
+ (require 'subr-x))
(defvar url-callback-arguments)
(defvar url-callback-function)
@@ -39,6 +42,7 @@
(defvar url-http-data)
(defvar url-http-end-of-headers)
(defvar url-http-extra-headers)
+(defvar url-http-noninteractive)
(defvar url-http-method)
(defvar url-http-no-retry)
(defvar url-http-process)
@@ -47,11 +51,9 @@
(defvar url-http-response-version)
(defvar url-http-target-url)
(defvar url-http-transfer-encoding)
-(defvar url-http-end-of-headers)
(defvar url-show-status)
(require 'url-gw)
-(require 'url-util)
(require 'url-parse)
(require 'url-cookie)
(require 'mail-parse)
@@ -133,6 +135,17 @@ request.")
(507 insufficient-storage "Insufficient storage"))
"The HTTP return codes and their text.")
+(defcustom url-user-agent (format "User-Agent: %sURL/%s\r\n"
+ (if url-package-name
+ (concat url-package-name "/"
+ url-package-version " ")
+ "") url-version)
+ "User Agent used by the URL package."
+ :type '(choice (string :tag "A static User-Agent string")
+ (function :tag "Call a function to get the User-Agent string"))
+ :version "25.1"
+ :group 'url)
+
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
;; when the file is byte-compiled.
@@ -172,7 +185,7 @@ request.")
url-http-open-connections))
nil)
-(defun url-http-find-free-connection (host port)
+(defun url-http-find-free-connection (host port &optional gateway-method)
(let ((conns (gethash (cons host port) url-http-open-connections))
(connection nil))
(while (and conns (not connection))
@@ -194,7 +207,7 @@ request.")
;; `url-open-stream' needs a buffer in which to do things
;; like authentication. But we use another buffer afterwards.
(unwind-protect
- (let ((proc (url-open-stream host buf host port)))
+ (let ((proc (url-open-stream host buf host port gateway-method)))
;; url-open-stream might return nil.
(when (processp proc)
;; Drop the temp buffer link before killing the buffer.
@@ -215,11 +228,9 @@ request.")
(and (listp url-privacy-level)
(memq 'agent url-privacy-level)))
""
- (format "User-Agent: %sURL/%s\r\n"
- (if url-package-name
- (concat url-package-name "/" url-package-version " ")
- "")
- url-version)))
+ (if (functionp url-user-agent)
+ (funcall url-user-agent)
+ url-user-agent)))
(defun url-http-create-request (&optional ref-url)
"Create an HTTP request for `url-http-target-url', referred to by REF-URL."
@@ -314,7 +325,14 @@ request.")
(concat
"From: " url-personal-mail-address "\r\n"))
;; Encodings we understand
- (if url-mime-encoding-string
+ (if (or url-mime-encoding-string
+ ;; MS-Windows loads zlib dynamically, so recheck
+ ;; in case they made it available since
+ ;; initialization in url-vars.el.
+ (and (eq 'system-type 'windows-nt)
+ (fboundp 'zlib-available-p)
+ (zlib-available-p)
+ (setq url-mime-encoding-string "gzip")))
(concat
"Accept-encoding: " url-mime-encoding-string "\r\n"))
(if url-mime-charset-string
@@ -357,9 +375,7 @@ request.")
;; End request
"\r\n"
;; Any data
- url-http-data
- ;; If `url-http-data' is nil, avoid two CRLFs (Bug#8931).
- (if url-http-data "\r\n")))
+ url-http-data))
""))
(url-http-debug "Request is: \n%s" request)
request))
@@ -417,7 +433,7 @@ Return the number of characters removed."
(goto-char (point-max))
(insert "<hr>Sorry, but I do not know how to handle " type
" authentication. If you'd like to write it,"
- " send it to " url-bug-address ".<hr>")
+ " please use M-x report-emacs-bug RET.<hr>")
;; We used to set a `status' var (declared "special") but I can't
;; find the corresponding let-binding, so it's probably an error.
;; FIXME: Maybe it was supposed to set `success', i.e. to return t?
@@ -469,6 +485,8 @@ work correctly."
)
)
+(declare-function gnutls-peer-status "gnutls.c" (proc))
+
(defun url-http-parse-headers ()
"Parse and handle HTTP specific headers.
Return t if and only if the current buffer is still active and
@@ -478,7 +496,14 @@ should be shown to the user."
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
-
+ ;; Pass the https certificate on to the caller.
+ (when (gnutls-available-p)
+ (let ((status (gnutls-peer-status url-http-process)))
+ (when (or status
+ (plist-get (car url-callback-arguments) :peer))
+ (setcar url-callback-arguments
+ (plist-put (car url-callback-arguments)
+ :peer status)))))
(if (or (not (boundp 'url-http-end-of-headers))
(not url-http-end-of-headers))
(error "Trying to parse headers in odd buffer: %s" (buffer-name)))
@@ -621,6 +646,12 @@ should be shown to the user."
;; compute the redirection relative to the URL of the proxy.
(setq redirect-uri
(url-expand-file-name redirect-uri url-http-target-url)))
+ ;; Do not automatically include an authorization header in the
+ ;; redirect. If needed it will be regenerated by the relevant
+ ;; auth scheme when the new request happens.
+ (setq url-http-extra-headers
+ (cl-remove "Authorization"
+ url-http-extra-headers :key 'car :test 'equal))
(let ((url-request-method url-http-method)
(url-request-data url-http-data)
(url-request-extra-headers url-http-extra-headers))
@@ -858,10 +889,12 @@ should be shown to the user."
(goto-char (point-min))
success))
+(declare-function zlib-decompress-region "decompress.c" (start end))
+
(defun url-handle-content-transfer-encoding ()
(let ((encoding (mail-fetch-field "content-encoding")))
(when (and encoding
- (fboundp 'zlib-decompress-region)
+ (fboundp 'zlib-available-p)
(zlib-available-p)
(equal (downcase encoding) "gzip"))
(save-restriction
@@ -876,7 +909,8 @@ should be shown to the user."
(url-http-mark-connection-as-free (url-host url-current-object)
(url-port url-current-object)
url-http-process)
- (url-http-debug "Activating callback in buffer (%s)" (buffer-name))
+ (url-http-debug "Activating callback in buffer (%s): %S %S"
+ (buffer-name) url-callback-function url-callback-arguments)
(apply url-callback-function url-callback-arguments))
;; )
@@ -917,7 +951,7 @@ should be shown to the user."
(defun url-http-simple-after-change-function (st nd length)
;; Function used when we do NOT know how long the document is going to be
;; Just _very_ simple 'downloaded %d' type of info.
- (url-lazy-message "Reading %s..." (url-pretty-length nd)))
+ (url-lazy-message "Reading %s..." (file-size-human-readable nd)))
(defun url-http-content-length-after-change-function (st nd length)
"Function used when we DO know how long the document is going to be.
@@ -930,16 +964,16 @@ the callback to be triggered."
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length)
url-http-content-type
- (url-pretty-length (- nd url-http-end-of-headers))
- (url-pretty-length url-http-content-length)
+ (file-size-human-readable (- nd url-http-end-of-headers))
+ (file-size-human-readable url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length))
(url-display-percentage
"Reading... %s of %s (%d%%)"
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length)
- (url-pretty-length (- nd url-http-end-of-headers))
- (url-pretty-length url-http-content-length)
+ (file-size-human-readable (- nd url-http-end-of-headers))
+ (file-size-human-readable url-http-content-length)
(url-percentage (- nd url-http-end-of-headers)
url-http-content-length)))
@@ -1168,22 +1202,28 @@ the end of the document."
(when (eq process-buffer (current-buffer))
(goto-char (point-max)))))
-(defun url-http (url callback cbargs &optional retry-buffer)
+(defun url-http (url callback cbargs &optional retry-buffer gateway-method)
"Retrieve URL via HTTP asynchronously.
URL must be a parsed URL. See `url-generic-parse-url' for details.
-When retrieval is completed, execute the function CALLBACK, using
-the arguments listed in CBARGS. The first element in CBARGS
+When retrieval is completed, execute the function CALLBACK, passing it
+an updated value of CBARGS as arguments. The first element in CBARGS
should be a plist describing what has happened so far during the
request, as described in the docstring of `url-retrieve' (if in
doubt, specify nil).
Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a
-previous `url-http' call, which is being re-attempted."
+previous `url-http' call, which is being re-attempted.
+
+Optional arg GATEWAY-METHOD specifies the gateway to be used,
+overriding the value of `url-gateway-method'."
(cl-check-type url vector "Need a pre-parsed URL.")
(let* ((host (url-host (or url-using-proxy url)))
(port (url-port (or url-using-proxy url)))
- (connection (url-http-find-free-connection host port))
+ (nsm-noninteractive (or url-request-noninteractive
+ (and (boundp 'url-http-noninteractive)
+ url-http-noninteractive)))
+ (connection (url-http-find-free-connection host port gateway-method))
(buffer (or retry-buffer
(generate-new-buffer
(format " *http %s:%d*" host port)))))
@@ -1214,6 +1254,7 @@ previous `url-http' call, which is being re-attempted."
url-http-process
url-http-method
url-http-extra-headers
+ url-http-noninteractive
url-http-data
url-http-target-url
url-http-no-retry
@@ -1223,6 +1264,7 @@ previous `url-http' call, which is being re-attempted."
(setq url-http-method (or url-request-method "GET")
url-http-extra-headers url-request-extra-headers
+ url-http-noninteractive url-request-noninteractive
url-http-data url-request-data
url-http-process connection
url-http-chunked-length nil
@@ -1441,9 +1483,8 @@ p3p
(defmacro url-https-create-secure-wrapper (method args)
`(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
- (let ((url-gateway-method 'tls))
- (,(intern (format (if method "url-http-%s" "url-http") method))
- ,@(remove '&rest (remove '&optional args))))))
+ (,(intern (format (if method "url-http-%s" "url-http") method))
+ ,@(remove '&rest (remove '&optional (append args (if method nil '(nil 'tls))))))))
;;;###autoload (autoload 'url-https "url-http")
(url-https-create-secure-wrapper nil (url callback cbargs))
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index b8dcaecd668..4095aea9e5f 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -1,6 +1,6 @@
;;; url-imap.el --- IMAP retrieval routines
-;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2015 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index b0622ebebe9..bdccd8f178d 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,6 +1,6 @@
;;; url-irc.el --- IRC URL interface
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index bfb5458bc03..5c5ee760738 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,6 +1,6 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
-;; Copyright (C) 1998-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 55f477c2522..3dd89d5419f 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -1,6 +1,6 @@
;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index d4fa59e9720..a4f711b7004 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -1,6 +1,6 @@
;;; url-methods.el --- Load URL schemes as needed
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index c8e9b591790..b21b15d5e8a 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -1,6 +1,6 @@
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2002, 2004-2013 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2002, 2004-2015 Free Software Foundation,
;; Inc.
;; Keywords: comm, data, processes
@@ -89,19 +89,19 @@
(save-excursion
(if (not (string-match "\\([^,]*\\)?," desc))
(error "Malformed data URL: %s" desc)
- (setq mediatype (match-string 1 desc))
+ (setq mediatype (match-string 1 desc)
+ data (url-unhex-string (substring desc (match-end 0))))
(if (and mediatype (string-match ";base64\\'" mediatype))
(setq mediatype (substring mediatype 0 (match-beginning 0))
encoding "base64"))
(if (or (null mediatype)
(eq ?\; (aref mediatype 0)))
- (setq mediatype (concat "text/plain" mediatype)))
- (setq data (url-unhex-string (substring desc (match-end 0)))))
+ (setq mediatype (concat "text/plain" mediatype))))
(set-buffer (generate-new-buffer " *url-data*"))
(mm-disable-multibyte)
(insert (format "Content-Length: %d\n" (length data))
"Content-Type: " mediatype "\n"
- "Content-Encoding: " encoding "\n"
+ "Content-Transfer-Encoding: " encoding "\n"
"\n")
(if data (insert data))
(current-buffer))))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index d4532626183..38a75528e31 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -1,6 +1,6 @@
;;; url-news.el --- News Uniform Resource Locator retrieval code
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -70,8 +70,7 @@
" </xmp>\n"
" </p>\n"
" <p>\n"
- " If you If you feel this is an error, <a href=\""
- "mailto:" url-bug-address "\">send mail</a>\n"
+ " If you feel this is an error, M-x report-emacs-bug RET.\n"
" </p>\n"
" </div>\n"
" </body>\n"
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 2870a9a5af9..1f8a4096460 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -1,6 +1,6 @@
;;; url-nfs.el --- NFS URL interface
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el
index 3fe074f1e0c..88a40547f49 100644
--- a/lisp/url/url-ns.el
+++ b/lisp/url/url-ns.el
@@ -1,6 +1,6 @@
;;; url-ns.el --- Various netscape-ish functions for proxy definitions
-;; Copyright (C) 1997-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 1628290a358..dbf0c386871 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -1,6 +1,6 @@
;;; url-parse.el --- Uniform Resource Locator parser
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -125,7 +125,7 @@ TARGET is the fragment identifier component (used to refer to a
ATTRIBUTES is nil; this slot originally stored the attribute and
value alists for IMAP URIs, but this feature was removed
since it conflicts with RFC 3986.
-FULLNESS is non-nil iff the hierarchical sequence component of
+FULLNESS is non-nil if the hierarchical sequence component of
the URL starts with two slashes, \"//\".
The parser follows RFC 3986, except that it also tries to handle
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index 0c091680507..77c3f642719 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -1,6 +1,6 @@
;;; url-privacy.el --- Global history tracking for URL package
-;; Copyright (C) 1996-1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 44587e93bc6..b292e31def2 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -1,6 +1,6 @@
;;; url-proxy.el --- Proxy server support
-;; Copyright (C) 1999, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2004-2015 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index f4b9093f086..c667cb932d5 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -1,6 +1,6 @@
;;; url-queue.el --- Fetching web pages in parallel
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: comm
@@ -69,7 +69,7 @@ The variable `url-queue-timeout' sets a timeout."
:inhibit-cookiesp inhibit-cookies))))
(url-queue-setup-runners))
-;; To ensure asynch behaviour, we start the required number of queue
+;; To ensure asynch behavior, we start the required number of queue
;; runners from `run-with-idle-timer'. So we're basically going
;; through the queue in two ways: 1) synchronously when a program
;; calls `url-queue-retrieve' (which will then start the required
@@ -133,10 +133,11 @@ The variable `url-queue-timeout' sets a timeout."
(defun url-queue-start-retrieve (job)
(setf (url-queue-buffer job)
(ignore-errors
- (url-retrieve (url-queue-url job)
- #'url-queue-callback-function (list job)
- (url-queue-silentp job)
- (url-queue-inhibit-cookiesp job)))))
+ (let ((url-request-noninteractive t))
+ (url-retrieve (url-queue-url job)
+ #'url-queue-callback-function (list job)
+ (url-queue-silentp job)
+ (url-queue-inhibit-cookiesp job))))))
(defun url-queue-prune-old-entries ()
(let (dead-jobs)
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
new file mode 100644
index 00000000000..d0b1a5c3420
--- /dev/null
+++ b/lisp/url/url-tramp.el
@@ -0,0 +1,79 @@
+;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols
+
+;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+;; Keywords: comm, data, processes, hypermedia
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'url-parse)
+(require 'tramp)
+(require 'password-cache)
+
+;;;###autoload
+(defcustom url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet")
+ "List of URL protocols the work is handled by Tramp.
+They must also be covered by `url-handler-regexp'."
+ :group 'url
+ :version "25.1"
+ :type '(list string))
+
+(defun url-tramp-convert-url-to-tramp (url)
+ "Convert URL to a Tramp file name."
+ (let ((obj (url-generic-parse-url (and (stringp url) url))))
+ (if (member (url-type obj) url-tramp-protocols)
+ (progn
+ (if (url-password obj)
+ (password-cache-add
+ (tramp-make-tramp-file-name
+ (url-type obj) (url-user obj) (url-host obj) "")
+ (url-password obj))
+ (tramp-make-tramp-file-name
+ (url-type obj) (url-user obj) (url-host obj) (url-filename obj))))
+ url)))
+
+(defun url-tramp-convert-tramp-to-url (file)
+ "Convert FILE, a Tramp file name, to a URL."
+ (let ((obj (ignore-errors (tramp-dissect-file-name file))))
+ (if (member (tramp-file-name-method obj) url-tramp-protocols)
+ (url-recreate-url
+ (url-parse-make-urlobj
+ (tramp-file-name-method obj)
+ (tramp-file-name-user obj)
+ nil ; password.
+ (tramp-file-name-host obj)
+ nil ; port.
+ (tramp-file-name-localname obj)
+ nil nil t)) ; target attributes fullness.
+ file)))
+
+;;;###autoload
+(defun url-tramp-file-handler (operation &rest args)
+ "Function called from the `file-name-handler-alist' routines.
+OPERATION is what needs to be done. ARGS are the arguments that
+would have been passed to OPERATION."
+ (let ((default-directory (url-tramp-convert-url-to-tramp default-directory))
+ (args (mapcar 'url-tramp-convert-url-to-tramp args)))
+ (url-tramp-convert-tramp-to-url (apply operation args))))
+
+(provide 'url-tramp)
+
+;;; url-tramp.el ends here
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index c40768ba42a..e011b96ada2 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -1,9 +1,10 @@
;;; url-util.el --- Miscellaneous helper routines for URL library
-;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Perry <wmperry@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
@@ -189,8 +190,7 @@ Will not do anything if `url-show-status' is nil."
(defun url-get-normalized-date (&optional specified-time)
"Return a 'real' date string that most HTTP servers can understand."
(let ((system-time-locale "C"))
- (format-time-string "%a, %d %b %Y %T GMT"
- (or specified-time (current-time)) t)))
+ (format-time-string "%a, %d %b %Y %T GMT" specified-time t)))
;;;###autoload
(defun url-eat-trailing-space (x)
@@ -211,15 +211,9 @@ Will not do anything if `url-show-status' is nil."
(setq z (1+ z)))
(substring x z nil)))
-;;;###autoload
-(defun url-pretty-length (n)
- (cond
- ((< n 1024)
- (format "%d bytes" n))
- ((< n (* 1024 1024))
- (format "%dk" (/ n 1024.0)))
- (t
- (format "%2.2fM" (/ n (* 1024 1024.0))))))
+
+(define-obsolete-function-alias 'url-pretty-length
+ 'file-size-human-readable "24.4")
;;;###autoload
(defun url-display-percentage (fmt perc &rest args)
@@ -291,7 +285,7 @@ Will not do anything if `url-show-status' is nil."
"Build a query-string.
Given a QUERY in the form:
-'((key1 val1)
+ ((key1 val1)
(key2 val2)
(key3 val1 val2)
(key4)
@@ -634,14 +628,9 @@ Creates FILE and its parent directories if they do not exist."
(make-directory dir t)))
;; Based on doc-view-make-safe-dir.
(condition-case nil
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes #o0600)
- (with-temp-buffer
- (write-region (point-min) (point-max)
- file nil 'silent nil 'excl)))
- (set-default-file-modes umask)))
+ (with-file-modes #o0600
+ (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))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 0361e01dfb4..46c2ec3c69f 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,6 +1,6 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool
-;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2015 Free Software Foundation,
;; Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -28,6 +28,8 @@
(defgroup url nil
"Uniform Resource Locator tool."
:version "22.1"
+ :link '(custom-manual "(url) Top")
+ :link '(info-link "(url) Customization")
:group 'comm)
(defgroup url-file nil
@@ -72,7 +74,7 @@ requests will be honored. If t, all refresh requests will be honored.
If non-nil and not t, the user will be asked for each refresh request."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
- (const :tag "ask" 'ask))
+ (other :tag "ask" ask))
:group 'url-hairy)
(defcustom url-automatic-caching nil
@@ -80,8 +82,8 @@ If non-nil and not t, the user will be asked for each refresh request."
:type 'boolean
:group 'url-cache)
-(defconst url-bug-address "bug-gnu-emacs@gnu.org"
- "Where to send bug reports.")
+(define-obsolete-variable-alias 'url-bug-address
+ 'report-emacs-bug-address "24.5")
(defcustom url-personal-mail-address nil
"Your full email address.
@@ -120,9 +122,9 @@ cookies -- never accept HTTP cookies
Samples:
- (setq url-privacy-level 'high)
- (setq url-privacy-level '(email lastloc)) ;; equivalent to 'high
- (setq url-privacy-level '(os))
+ (setq url-privacy-level \\='high)
+ (setq url-privacy-level \\='(email lastloc)) ;; equivalent to \\='high
+ (setq url-privacy-level \\='(os))
::NOTE::
This variable controls several other variables and is _NOT_ automatically
@@ -208,9 +210,12 @@ document."
"A list of extra headers to send with the next request.
Should be an assoc list of headers/contents.")
+(defvar url-request-noninteractive nil
+ "If non-nil, the request is done in a noninteractive context.")
+
(defvar url-request-method nil "The method to use for the next request.")
-(defvar url-mime-encoding-string (and (fboundp 'zlib-decompress-region)
+(defvar url-mime-encoding-string (and (fboundp 'zlib-available-p)
(zlib-available-p)
"gzip")
"String to send in the Accept-encoding: field in HTTP requests.")
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 43e52ef25cf..095637765a3 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -1,9 +1,10 @@
;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*-
-;; Copyright (C) 1996-1999, 2001, 2004-2013 Free Software Foundation,
+;; Copyright (C) 1996-1999, 2001, 2004-2015 Free Software Foundation,
;; Inc.
;; Author: Bill Perry <wmperry@gnu.org>
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
@@ -170,8 +171,8 @@ URL-encoded before it's used."
(defun url-retrieve-internal (url callback cbargs &optional silent
inhibit-cookies)
"Internal function; external interface is `url-retrieve'.
-CBARGS is the list of arguments that the callback function will
-receive; its first element should be a plist specifying what has
+The callback function will receive an updated value of CBARGS as
+arguments; its first element should be a plist specifying what has
happened so far during the request, as described in the docstring
of `url-retrieve' (if in doubt, specify nil).
@@ -220,7 +221,7 @@ URL-encoded before it's used."
buffer))
;;;###autoload
-(defun url-retrieve-synchronously (url)
+(defun url-retrieve-synchronously (url &optional silent inhibit-cookies)
"Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
associated with it (the case for dired, info, or mailto URLs that need
@@ -233,7 +234,8 @@ no further processing). URL is either a string or a parsed URL."
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
(setq retrieval-done t
- asynch-buffer (current-buffer)))))
+ asynch-buffer (current-buffer)))
+ nil silent inhibit-cookies))
(if (null asynch-buffer)
;; We do not need to do anything, it was a mailto or something
;; similar that takes processing completely outside of the URL
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 9409409a608..781023c7449 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -1,8 +1,10 @@
;;; userlock.el --- handle file access contention between multiple users
-;; Copyright (C) 1985-1986, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 2001-2015 Free Software Foundation, Inc.
-;; Maintainer: FSF
+;; Author: Richard King
+;; (according to authors.el)
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -140,7 +142,7 @@ If you say `r' to revert, the contents of the buffer are refreshed
from the file on disk.
If you say `n', the change you started to make will be aborted.
-Usually, you should type `n' and then `M-x revert-buffer',
+Usually, you should type `n' and then `\\[revert-buffer]',
to get the latest version of the file, then make the change again.")
(with-current-buffer standard-output
(help-mode))))
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index f926a164797..9ab8d75fbb5 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1,9 +1,9 @@
;;; add-log.el --- change log maintenance commands for Emacs
-;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2013 Free
+;; Copyright (C) 1985-1986, 1988, 1993-1994, 1997-1998, 2000-2015 Free
;; Software Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; This file is part of GNU Emacs.
@@ -158,7 +158,7 @@ use the file's name relative to the directory of the change log file."
:group 'change-log)
(defcustom change-log-version-number-regexp-list
- (let ((re "\\([0-9]+\.[0-9.]+\\)"))
+ (let ((re "\\([0-9]+\\.[0-9.]+\\)"))
(list
;; (defconst ad-version "2.15"
(concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re)
@@ -481,9 +481,9 @@ try to visit the file for the change under `point' instead."
(apply 'change-log-goto-source-1
(append change-log-find-head change-log-find-tail))
(error
- (format "Cannot find more matches for tag `%s' in file `%s'"
- (car change-log-find-head)
- (nth 2 change-log-find-head)))))
+ "Cannot find more matches for tag `%s' in file `%s'"
+ (car change-log-find-head)
+ (nth 2 change-log-find-head))))
(save-excursion
(let* ((at (point))
(tag-at (change-log-search-tag-name))
@@ -515,9 +515,8 @@ try to visit the file for the change under `point' instead."
(condition-case nil
(setq change-log-find-tail
(apply 'change-log-goto-source-1 change-log-find-head))
- (error
- (format "Cannot find matches for tag `%s' in file `%s'"
- tag file)))))))))
+ (error "Cannot find matches for tag `%s' in file `%s'"
+ tag file))))))))
(defun change-log-next-error (&optional argp reset)
"Move to the Nth (default 1) next match in a ChangeLog buffer.
@@ -581,8 +580,8 @@ If t, use universal time.")
(put 'add-log-time-zone-rule 'safe-local-variable
(lambda (x) (or (booleanp x) (stringp x))))
-(defun add-log-iso8601-time-zone (&optional time)
- (let* ((utc-offset (or (car (current-time-zone time)) 0))
+(defun add-log-iso8601-time-zone (&optional time zone)
+ (let* ((utc-offset (or (car (current-time-zone time zone)) 0))
(sign (if (< utc-offset 0) ?- ?+))
(sec (abs utc-offset))
(ss (% sec 60))
@@ -596,12 +595,11 @@ If t, use universal time.")
(defvar add-log-iso8601-with-time-zone nil)
-(defun add-log-iso8601-time-string ()
- (let ((time (format-time-string "%Y-%m-%d"
- nil (eq t add-log-time-zone-rule))))
+(defun add-log-iso8601-time-string (&optional time zone)
+ (let ((date (format-time-string "%Y-%m-%d" time zone)))
(if add-log-iso8601-with-time-zone
- (concat time " " (add-log-iso8601-time-zone))
- time)))
+ (concat date " " (add-log-iso8601-time-zone time zone))
+ date)))
(defun change-log-name ()
"Return (system-dependent) default name for a change log file."
@@ -686,7 +684,7 @@ nil, by matching `change-log-version-number-regexp-list'."
Optional arg FILE-NAME specifies the file to use.
If FILE-NAME is nil, use the value of `change-log-default-name'.
-If `change-log-default-name' is nil, behave as though it were 'ChangeLog'
+If `change-log-default-name' is nil, behave as though it were \"ChangeLog\"
\(or whatever we use on this operating system).
If `change-log-default-name' contains a leading directory component, then
@@ -848,14 +846,8 @@ non-nil, otherwise in local time."
(let ((new-entries
(mapcar (lambda (addr)
(concat
- (if (stringp add-log-time-zone-rule)
- (let ((tz (getenv "TZ")))
- (unwind-protect
- (progn
- (setenv "TZ" add-log-time-zone-rule)
- (funcall add-log-time-format))
- (setenv "TZ" tz)))
- (funcall add-log-time-format))
+ (funcall add-log-time-format
+ nil add-log-time-zone-rule)
" " full-name
" <" addr ">"))
(if (consp mailing-address)
@@ -1097,12 +1089,17 @@ file were isearch was started."
(ignore-errors
(version< (substring b (length name))
(substring a (length name))))))))
- (files (if isearch-forward files (reverse files))))
- (find-file-noselect
- (if wrap
- (car files)
- (cadr (member (file-name-nondirectory (buffer-file-name buffer))
- files))))))
+ (files (if isearch-forward files (reverse files)))
+ (file (if wrap
+ (car files)
+ (cadr (member (file-name-nondirectory (buffer-file-name buffer))
+ files)))))
+ ;; If there are no files that match the default pattern ChangeLog.[0-9],
+ ;; return the current buffer to force isearch wrapping to its beginning.
+ ;; If file is nil, multi-isearch-search-fun will signal "end of multi".
+ (if (file-exists-p file)
+ (find-file-noselect file)
+ (current-buffer))))
(defun change-log-fill-forward-paragraph (n)
"Cut paragraphs so filling preserves open parentheses at beginning of lines."
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index 235ebe5a072..cec16446984 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -1,9 +1,9 @@
;;; compare-w.el --- compare text between windows for Emacs
-;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2013 Free Software
+;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience files vc
;; This file is part of GNU Emacs.
@@ -30,6 +30,8 @@
;;; Code:
+(require 'diff-mode) ; For diff faces.
+
(defgroup compare-windows nil
"Compare text between windows."
:prefix "compare-"
@@ -86,7 +88,7 @@ regexp containing some field separator or a newline, depending on
the nature of the difference units separator. The variable can
be made buffer-local.
-If the value of this variable is `nil' (option \"No sync\"), then
+If the value of this variable is nil (option \"No sync\"), then
no synchronization is performed, and the function `ding' is called
to beep or flash the screen when points are mismatched."
:type '(choice function regexp (const :tag "No sync" nil))
@@ -128,11 +130,19 @@ out all highlighting later with the command `compare-windows-dehighlight'."
:group 'compare-windows
:version "22.1")
-(defface compare-windows
- '((t :inherit lazy-highlight))
- "Face for highlighting of compare-windows difference regions."
+(defface compare-windows-removed
+ '((t :inherit diff-removed))
+ "Face for highlighting of compare-windows removed regions."
:group 'compare-windows
- :version "22.1")
+ :version "25.1")
+
+(defface compare-windows-added
+ '((t :inherit diff-added))
+ "Face for highlighting of compare-windows added regions."
+ :group 'compare-windows
+ :version "25.1")
+
+(define-obsolete-face-alias 'compare-windows 'compare-windows-added "25.1")
(defvar compare-windows-overlay1 nil)
(defvar compare-windows-overlay2 nil)
@@ -140,9 +150,45 @@ out all highlighting later with the command `compare-windows-dehighlight'."
(defvar compare-windows-overlays2 nil)
(defvar compare-windows-sync-point nil)
+(defcustom compare-windows-get-window-function
+ 'compare-windows-get-recent-window
+ "Function that provides the window to compare with."
+ :type '(choice
+ (function-item :tag "Most recently used window"
+ compare-windows-get-recent-window)
+ (function-item :tag "Next window"
+ compare-windows-get-next-window)
+ (function :tag "Your function"))
+ :group 'compare-windows
+ :version "25.1")
+
+(defun compare-windows-get-recent-window ()
+ "Return the most recently used window.
+First try to get the most recently used window on a visible frame,
+then try to get a window on an iconified frame, and finally
+consider all existing frames."
+ (or (get-mru-window 'visible t t)
+ (get-mru-window 0 t t)
+ (get-mru-window t t t)
+ (error "No other window")))
+
+(defun compare-windows-get-next-window ()
+ "Return the window next in the cyclic ordering of windows.
+In the selected frame contains only one window, consider windows
+on all visible frames."
+ (let ((w2 (next-window)))
+ (if (eq w2 (selected-window))
+ (setq w2 (next-window (selected-window) nil 'visible)))
+ (if (eq w2 (selected-window))
+ (error "No other window"))
+ w2))
+
;;;###autoload
(defun compare-windows (ignore-whitespace)
- "Compare text in current window with text in next window.
+ "Compare text in current window with text in another window.
+The option `compare-windows-get-window-function' defines how
+to get another window.
+
Compares the text starting at point in each window,
moving over text in each one as far as they match.
@@ -179,11 +225,7 @@ on third call it again advances points to the next difference and so on."
'compare-windows-sync-regexp
compare-windows-sync)))
(setq p1 (point) b1 (current-buffer))
- (setq w2 (next-window))
- (if (eq w2 (selected-window))
- (setq w2 (next-window (selected-window) nil 'visible)))
- (if (eq w2 (selected-window))
- (error "No other window"))
+ (setq w2 (funcall compare-windows-get-window-function))
(setq p2 (window-point w2)
b2 (window-buffer w2))
(setq opoint2 p2)
@@ -212,7 +254,7 @@ on third call it again advances points to the next difference and so on."
;; optionally skip over it.
(and skip-func-1
(save-excursion
- (let (p1a p2a w1 w2 result1 result2)
+ (let (p1a p2a result1 result2)
(setq result1 (funcall skip-func-1 opoint1))
(setq p1a (point))
(set-buffer b2)
@@ -255,12 +297,15 @@ on third call it again advances points to the next difference and so on."
(recenter (car compare-windows-recenter))
(with-selected-window w2 (recenter (cadr compare-windows-recenter))))
;; If points are still not synchronized, then ding
- (when (and (= p1 opoint1) (= p2 opoint2))
- ;; Display error message when current points in two windows
- ;; are unmatched and next matching points can't be found.
- (compare-windows-dehighlight)
- (ding)
- (message "No more matching points"))))))
+ (if (and (= p1 opoint1) (= p2 opoint2))
+ (progn
+ ;; Display error message when current points in two windows
+ ;; are unmatched and next matching points can't be found.
+ (compare-windows-dehighlight)
+ (ding)
+ (message "No more matches with %s" b2))
+ (message "Diff -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2)))
+ (message "Match -%s,%s +%s,%s with %s" opoint2 p2 opoint1 p1 b2))))
;; Move forward over whatever might be called whitespace.
;; compare-windows-whitespace is a regexp that matches whitespace.
@@ -303,7 +348,7 @@ on third call it again advances points to the next difference and so on."
(defun compare-windows-sync-default-function ()
(if (not compare-windows-sync-point)
(let* ((w1 (selected-window))
- (w2 (next-window w1))
+ (w2 (funcall compare-windows-get-window-function))
(b2 (window-buffer w2))
(point-max2 (with-current-buffer b2 (point-max)))
(op2 (window-point w2))
@@ -360,13 +405,13 @@ on third call it again advances points to the next difference and so on."
(if compare-windows-overlay1
(move-overlay compare-windows-overlay1 beg1 end1 b1)
(setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
- (overlay-put compare-windows-overlay1 'face 'compare-windows)
+ (overlay-put compare-windows-overlay1 'face 'compare-windows-added)
(overlay-put compare-windows-overlay1 'priority 1000))
(overlay-put compare-windows-overlay1 'window w1)
(if compare-windows-overlay2
(move-overlay compare-windows-overlay2 beg2 end2 b2)
(setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
- (overlay-put compare-windows-overlay2 'face 'compare-windows)
+ (overlay-put compare-windows-overlay2 'face 'compare-windows-removed)
(overlay-put compare-windows-overlay2 'priority 1000))
(overlay-put compare-windows-overlay2 'window w2)
(if (not (eq compare-windows-highlight 'persistent))
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index 4f87d1ac44d..cf1f49cbeee 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -1,6 +1,6 @@
-;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*-
+;;; cvs-status.el --- major mode for browsing `cvs status' output -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs status tree vc tools
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index e945d6ef160..464e3754eb9 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1,6 +1,6 @@
;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: convenience patch diff vc
@@ -302,14 +302,9 @@ well."
(defvar diff-added-face 'diff-added)
(defface diff-changed
- ;; We normally apply a `shadow'-based face on the `diff-context'
- ;; face, and keep `diff-changed' the default.
- '((((class color grayscale) (min-colors 88)))
- ;; If the terminal lacks sufficient colors for shadowing,
- ;; highlight changed lines explicitly.
- (((class color))
- :foreground "yellow"))
+ '((t nil))
"`diff-mode' face used to highlight changed lines."
+ :version "25.1"
:group 'diff-mode)
(define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1")
(defvar diff-changed-face 'diff-changed)
@@ -343,8 +338,12 @@ well."
(defvar diff-function-face 'diff-function)
(defface diff-context
- '((((class color grayscale) (min-colors 88)) :inherit shadow))
+ '((((class color grayscale) (min-colors 88) (background light))
+ :foreground "#333333")
+ (((class color grayscale) (min-colors 88) (background dark))
+ :foreground "#dddddd"))
"`diff-mode' face used to highlight context and other side-information."
+ :version "25.1"
:group 'diff-mode)
(define-obsolete-face-alias 'diff-context-face 'diff-context "22.1")
(defvar diff-context-face 'diff-context)
@@ -822,7 +821,7 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(header-files
;; handle filenames with spaces;
;; cf. diff-font-lock-keywords / diff-file-header-face
- (if (looking-at "[-*][-*][-*] \\([^\t]+\\)\t.*\n[-+][-+][-+] \\([^\t]+\\)")
+ (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)))
(forward-line 1) nil)))
@@ -1221,6 +1220,9 @@ else cover the whole buffer."
(?- (cl-incf minus))
(?! (cl-incf bang))
((or ?\\ ?#) nil)
+ (?\n (if diff-valid-unified-empty-line
+ (cl-incf space)
+ (setq space 0 plus 0 minus 0 bang 0)))
(_ (setq space 0 plus 0 minus 0 bang 0)))
(cond
((looking-at diff-hunk-header-re-unified)
@@ -1366,7 +1368,8 @@ a diff with \\[diff-reverse-direction].
(diff-setup-whitespace)
- (setq buffer-read-only diff-default-read-only)
+ (if diff-default-read-only
+ (setq buffer-read-only t))
;; setup change hooks
(if (not diff-update-on-the-fly)
(add-hook 'write-contents-functions 'diff-write-contents-hooks nil t)
@@ -1424,8 +1427,8 @@ modified lines of the diff."
(diff-hunk-style)))))
(set (make-local-variable 'whitespace-trailing-regexp)
(if (eq style 'context)
- "^[-\+!] .*?\\([\t ]+\\)$"
- "^[-\+!<>].*?\\([\t ]+\\)$"))))
+ "^[-+!] .*?\\([\t ]+\\)$"
+ "^[-+!<>].*?\\([\t ]+\\)$"))))
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
@@ -1814,6 +1817,16 @@ With a prefix argument, try to REVERSE the hunk."
(diff-hunk-status-msg line-offset (diff-xor reverse switched) t)))
+(defun diff-kill-applied-hunks ()
+ "Kill all hunks that have already been applied starting at point."
+ (interactive)
+ (while (not (eobp))
+ (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
+ (diff-find-source-location nil nil)))
+ (if (and line-offset switched)
+ (diff-hunk-kill)
+ (diff-hunk-next)))))
+
(defalias 'diff-mouse-goto-source 'diff-goto-source)
(defun diff-goto-source (&optional other-file event)
@@ -1915,7 +1928,7 @@ For use in `add-log-current-defun-function'."
;;; Fine change highlighting.
-(defface diff-refine-change
+(defface diff-refine-changed
'((((class color) (min-colors 88) (background light))
:background "#ffff55")
(((class color) (min-colors 88) (background dark))
@@ -1923,6 +1936,7 @@ For use in `add-log-current-defun-function'."
(t :inverse-video t))
"Face used for char-based changes shown by `diff-refine-hunk'."
:group 'diff-mode)
+(define-obsolete-face-alias 'diff-refine-change 'diff-refine-changed "24.5")
(defface diff-refine-removed
'((default
@@ -2114,7 +2128,8 @@ fixed, visit it in a buffer."
(goto-char hunk-end))
(if modified-buffers
(message "Deleted trailing whitespace from %s."
- (mapconcat (lambda (buf) (concat "`" (buffer-name buf) "'"))
+ (mapconcat (lambda (buf) (format-message
+ "`%s'" (buffer-name buf)))
modified-buffers ", "))
(message "No trailing whitespace to delete.")))))
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 0fc0d2e3f73..2a973cfdfb1 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -1,11 +1,11 @@
;;; diff.el --- run `diff' -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994, 1996, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1994, 1996, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Frank Bresz
;; (according to authors.el)
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: unix, vc, tools
;; This file is part of GNU Emacs.
@@ -38,7 +38,7 @@
:group 'tools)
;;;###autoload
-(defcustom diff-switches (purecopy "-c")
+(defcustom diff-switches (purecopy "-u")
"A string or list of strings specifying switches to be passed to diff."
:type '(choice string (repeat string))
:group 'diff)
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index 3e64250d1a7..7647544d65d 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -1,6 +1,6 @@
;;; ediff-diff.el --- diff-related utilities
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -168,7 +168,7 @@ This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-auto-refine-limit 14000
- "Auto-refine only the regions of this size \(in bytes\) or less.")
+ "Auto-refine only the regions of this size (in bytes) or less.")
;;; General
@@ -211,7 +211,7 @@ one optional arguments, diff-number to refine.")
;; ediff-setup-diff-regions is called via a funcall to
;; ediff-setup-diff-regions-function, which can also have the value
;; ediff-setup-diff-regions3, which takes 4 arguments.
-(defun ediff-setup-diff-regions (file-A file-B file-C)
+(defun ediff-setup-diff-regions (file-A file-B _file-C)
;; looking for '-c', '-i', '-u', or 'c', 'i', 'u' among clustered non-long options
(if (string-match "^-[ciu]\\| -[ciu]\\|\\(^\\| \\)-[^- ]+[ciu]"
ediff-diff-options)
@@ -587,7 +587,6 @@ one optional arguments, diff-number to refine.")
(setq pt-saved (ediff-with-current-buffer buff (point)))))
(setq overlay (ediff-make-bullet-proof-overlay begin end buff))
- (ediff-overlay-put overlay 'priority ediff-shadow-overlay-priority)
(ediff-overlay-put overlay 'ediff-diff-num current-diff)
(if (and (ediff-has-face-support-p)
ediff-use-faces ediff-highlight-all-diffs)
@@ -819,23 +818,12 @@ one optional arguments, diff-number to refine.")
n &optional default)
(let ((fine-diff-vector (ediff-get-fine-diff-vector n buf-type))
(face (if default
- 'default
+ nil
(ediff-get-symbol-from-alist
- buf-type ediff-fine-diff-face-alist)
- ))
- (priority (if default
- 0
- (1+ (or (ediff-overlay-get
- (symbol-value
- (ediff-get-symbol-from-alist
- buf-type
- ediff-current-diff-overlay-alist))
- 'priority)
- 0)))))
- (mapcar (lambda (overl)
- (ediff-set-overlay-face overl face)
- (ediff-overlay-put overl 'priority priority))
- fine-diff-vector)))
+ buf-type ediff-fine-diff-face-alist))))
+ (mapc (lambda (overl)
+ (ediff-set-overlay-face overl face))
+ fine-diff-vector)))
;; Set overlays over the regions that denote delimiters
(defun ediff-set-fine-overlays-for-combined-merge (diff-list reg-num)
@@ -1223,7 +1211,7 @@ delimiter regions"))
;; like shell-command-sentinel but doesn't print an exit status message
;; we do this because diff always exits with status 1, if diffs are found
;; so shell-command-sentinel displays a confusing message to the user
-(defun ediff-process-sentinel (process signal)
+(defun ediff-process-sentinel (process _signal)
(if (and (memq (process-status process) '(exit signal))
(buffer-name (process-buffer process)))
(progn
@@ -1385,7 +1373,7 @@ affects only files whose names match the expression."
;; Normalize empty filter RE to nil.
(unless (> (length filter-re) 0) (setq filter-re nil))
;; Indicate progress
- (message "Comparing '%s' and '%s' modulo '%s'" d1 d2 filter-re)
+ (message "Comparing `%s' and `%s' modulo `%s'" d1 d2 filter-re)
(cond
;; D1 & D2 directories => recurse
((and (file-directory-p d1)
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 78d1a6abfd1..3d46869b252 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -1,6 +1,6 @@
;;; ediff-help.el --- Code related to the contents of Ediff help buffers
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -195,47 +195,47 @@ the value of this variable and the variables `ediff-help-message-*' in
(ediff-documentation "Quick Help Commands")
(let (case-fold-search)
- (cond ((string= cmd "?") (re-search-forward "^`\\?'"))
- ((string= cmd "G") (re-search-forward "^`G'"))
- ((string= cmd "E") (re-search-forward "^`E'"))
- ((string= cmd "wd") (re-search-forward "^`wd'"))
- ((string= cmd "wx") (re-search-forward "^`wa'"))
- ((string= cmd "a/b") (re-search-forward "^`a'"))
- ((string= cmd "x") (re-search-forward "^`a'"))
- ((string= cmd "xy") (re-search-forward "^`ab'"))
- ((string= cmd "p,DEL") (re-search-forward "^`p'"))
- ((string= cmd "n,SPC") (re-search-forward "^`n'"))
- ((string= cmd "j") (re-search-forward "^`j'"))
- ((string= cmd "gx") (re-search-forward "^`ga'"))
- ((string= cmd "!") (re-search-forward "^`!'"))
- ((string= cmd "*") (re-search-forward "^`\\*'"))
- ((string= cmd "m") (re-search-forward "^`m'"))
- ((string= cmd "|") (re-search-forward "^`|'"))
- ((string= cmd "@") (re-search-forward "^`@'"))
- ((string= cmd "h") (re-search-forward "^`h'"))
- ((string= cmd "r") (re-search-forward "^`r'"))
- ((string= cmd "rx") (re-search-forward "^`ra'"))
- ((string= cmd "##") (re-search-forward "^`##'"))
- ((string= cmd "#c") (re-search-forward "^`#c'"))
- ((string= cmd "#f/#h") (re-search-forward "^`#f'"))
- ((string= cmd "X") (re-search-forward "^`A'"))
- ((string= cmd "v/V") (re-search-forward "^`v'"))
- ((string= cmd "</>") (re-search-forward "^`<'"))
- ((string= cmd "~") (re-search-forward "^`~'"))
- ((string= cmd "i") (re-search-forward "^`i'"))
- ((string= cmd "D") (re-search-forward "^`D'"))
- ((string= cmd "R") (re-search-forward "^`R'"))
- ((string= cmd "M") (re-search-forward "^`M'"))
- ((string= cmd "z/q") (re-search-forward "^`z'"))
- ((string= cmd "%") (re-search-forward "^`%'"))
- ((string= cmd "C-l") (re-search-forward "^`C-l'"))
- ((string= cmd "$$") (re-search-forward "^`\\$\\$'"))
- ((string= cmd "$*") (re-search-forward "^`\\$\\*'"))
- ((string= cmd "/") (re-search-forward "^`/'"))
- ((string= cmd "&") (re-search-forward "^`&'"))
- ((string= cmd "s") (re-search-forward "^`s'"))
- ((string= cmd "+") (re-search-forward "^`\\+'"))
- ((string= cmd "=") (re-search-forward "^`='"))
+ (cond ((string= cmd "?") (re-search-forward "^['`‘]\\?['’]"))
+ ((string= cmd "G") (re-search-forward "^['`‘]G['’]"))
+ ((string= cmd "E") (re-search-forward "^['`‘]E['’]"))
+ ((string= cmd "wd") (re-search-forward "^['`‘]wd['’]"))
+ ((string= cmd "wx") (re-search-forward "^['`‘]wa['’]"))
+ ((string= cmd "a/b") (re-search-forward "^['`‘]a['’]"))
+ ((string= cmd "x") (re-search-forward "^['`‘]a['’]"))
+ ((string= cmd "xy") (re-search-forward "^['`‘]ab['’]"))
+ ((string= cmd "p,DEL") (re-search-forward "^['`‘]p['’]"))
+ ((string= cmd "n,SPC") (re-search-forward "^['`‘]n['’]"))
+ ((string= cmd "j") (re-search-forward "^['`‘]j['’]"))
+ ((string= cmd "gx") (re-search-forward "^['`‘]ga['’]"))
+ ((string= cmd "!") (re-search-forward "^['`‘]!['’]"))
+ ((string= cmd "*") (re-search-forward "^['`‘]\\*['’]"))
+ ((string= cmd "m") (re-search-forward "^['`‘]m['’]"))
+ ((string= cmd "|") (re-search-forward "^['`‘]|['’]"))
+ ((string= cmd "@") (re-search-forward "^['`‘]@['’]"))
+ ((string= cmd "h") (re-search-forward "^['`‘]h['’]"))
+ ((string= cmd "r") (re-search-forward "^['`‘]r['’]"))
+ ((string= cmd "rx") (re-search-forward "^['`‘]ra['’]"))
+ ((string= cmd "##") (re-search-forward "^['`‘]##['’]"))
+ ((string= cmd "#c") (re-search-forward "^['`‘]#c['’]"))
+ ((string= cmd "#f/#h") (re-search-forward "^['`‘]#f['’]"))
+ ((string= cmd "X") (re-search-forward "^['`‘]A['’]"))
+ ((string= cmd "v/V") (re-search-forward "^['`‘]v['’]"))
+ ((string= cmd "</>") (re-search-forward "^['`‘]<['’]"))
+ ((string= cmd "~") (re-search-forward "^['`‘]~['’]"))
+ ((string= cmd "i") (re-search-forward "^['`‘]i['’]"))
+ ((string= cmd "D") (re-search-forward "^['`‘]D['’]"))
+ ((string= cmd "R") (re-search-forward "^['`‘]R['’]"))
+ ((string= cmd "M") (re-search-forward "^['`‘]M['’]"))
+ ((string= cmd "z/q") (re-search-forward "^['`‘]z['’]"))
+ ((string= cmd "%") (re-search-forward "^['`‘]%['’]"))
+ ((string= cmd "C-l") (re-search-forward "^['`‘]C-l['’]"))
+ ((string= cmd "$$") (re-search-forward "^['`‘]\\$\\$['’]"))
+ ((string= cmd "$*") (re-search-forward "^['`‘]\\$\\*['’]"))
+ ((string= cmd "/") (re-search-forward "^['`‘]/['’]"))
+ ((string= cmd "&") (re-search-forward "^['`‘]&['’]"))
+ ((string= cmd "s") (re-search-forward "^['`‘]s['’]"))
+ ((string= cmd "+") (re-search-forward "^['`‘]\\+['’]"))
+ ((string= cmd "=") (re-search-forward "^['`‘]=['’]"))
(t (error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer")))
) ; let case-fold-search
))
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index cf0f3de44c3..89796872a44 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -1,6 +1,6 @@
;;; ediff-hook.el --- setup for Ediff's menus and autoloads
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 075775923a5..bf211599b9f 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -1,6 +1,6 @@
;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -24,6 +24,8 @@
;;; Code:
+(require 'cl-lib)
+
;; Start compiler pacifier
(defvar ediff-metajob-name)
(defvar ediff-meta-buffer)
@@ -118,11 +120,8 @@ It needs to be killed when we quit the session.")
(?C . ediff-buffer-C)))
;;; Macros
-(defmacro ediff-odd-p (arg)
- `(eq (logand ,arg 1) 1))
-
-(defmacro ediff-buffer-live-p (buf)
- `(and ,buf (get-buffer ,buf) (buffer-name (get-buffer ,buf))))
+(defsubst ediff-buffer-live-p (buf)
+ (and buf (get-buffer buf) (buffer-name (get-buffer buf))))
(defmacro ediff-get-buffer (arg)
`(cond ((eq ,arg 'A) ediff-buffer-A)
@@ -567,7 +566,8 @@ and ediff-after-flag. On a non-window system, differences are always
highlighted using ASCII flags."
:type 'boolean
:group 'ediff-highlighting)
-(ediff-defvar-local ediff-use-faces t "")
+(make-variable-buffer-local 'ediff-use-faces)
+(put 'ediff-use-faces 'permanent-local t)
;; this indicates that diff regions are word-size, so fine diffs are
;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise
@@ -610,7 +610,8 @@ Otherwise, all difference regions are highlighted, but the selected region is
shown in brighter colors."
:type 'boolean
:group 'ediff-highlighting)
-(ediff-defvar-local ediff-highlight-all-diffs t "")
+(make-variable-buffer-local 'ediff-highlight-all-diffs)
+(put 'ediff-highlight-all-diffs 'permanent-local t)
;; The suffix of the control buffer name.
@@ -705,9 +706,6 @@ shown in brighter colors."
;; List of difference overlays disturbed by working with the current diff.
(defvar ediff-disturbed-overlays nil "")
-;; Priority of non-selected overlays.
-(defvar ediff-shadow-overlay-priority 100 "")
-
(defcustom ediff-version-control-package 'vc
"Version control package used.
Currently, Ediff supports vc.el, rcs.el, pcl-cvs.el, and generic-sc.el. The
@@ -778,7 +776,7 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs."
;; A var local to each control panel buffer. Indicates highlighting style
;; in effect for this buffer: `face', `ascii',
-;; `off' -- turned off \(on a dumb terminal only\).
+;; `off' -- turned off (on a dumb terminal only).
(ediff-defvar-local ediff-highlighting-style
(if (and (ediff-has-face-support-p) ediff-use-faces) 'face 'ascii)
"")
@@ -808,9 +806,9 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs."
(defun ediff-set-overlay-face (extent face)
(ediff-overlay-put extent 'face face)
- (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo))
+ (ediff-overlay-put extent 'help-echo (if face 'ediff-region-help-echo)))
-(defun ediff-region-help-echo (extent-or-window &optional overlay point)
+(defun ediff-region-help-echo (extent-or-window &optional overlay _point)
(unless overlay
(setq overlay extent-or-window))
(let ((is-current (ediff-overlay-get overlay 'ediff))
@@ -950,7 +948,9 @@ this variable represents.")
(defface ediff-current-diff-Ancestor
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88))
+ (:background "VioletRed"))
+ (((class color) (min-colors 16))
(:foreground "Black" :background "VioletRed"))
(((class color))
(:foreground "black" :background "magenta3"))
@@ -1058,7 +1058,9 @@ this variable represents.")
(defface ediff-fine-diff-Ancestor
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88))
+ (:background "Green"))
+ (((class color) (min-colors 16))
(:foreground "Black" :background "Green"))
(((class color))
(:foreground "red3" :background "green"))
@@ -1092,6 +1094,8 @@ this variable represents.")
(if (featurep 'emacs)
`((((type pc))
(:foreground "green3" :background "light grey"))
+ (((class color) (min-colors 88))
+ (:background "light grey"))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey"))
(((class color))
@@ -1116,7 +1120,9 @@ this variable represents.")
(defface ediff-even-diff-B
(if (featurep 'emacs)
- `((((class color) (min-colors 16))
+ `((((class color) (min-colors 88))
+ (:background "Grey"))
+ (((class color) (min-colors 16))
(:foreground "White" :background "Grey"))
(((class color))
(:foreground "blue3" :background "Grey" :weight bold))
@@ -1139,6 +1145,8 @@ this variable represents.")
(if (featurep 'emacs)
`((((type pc))
(:foreground "yellow3" :background "light grey"))
+ (((class color) (min-colors 88))
+ (:background "light grey"))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey"))
(((class color))
@@ -1165,6 +1173,8 @@ this variable represents.")
(if (featurep 'emacs)
`((((type pc))
(:foreground "cyan3" :background "light grey"))
+ (((class color) (min-colors 88))
+ (:background "Grey"))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey"))
(((class color))
@@ -1198,6 +1208,8 @@ this variable represents.")
(if (featurep 'emacs)
'((((type pc))
(:foreground "green3" :background "gray40"))
+ (((class color) (min-colors 88))
+ (:background "Grey"))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey"))
(((class color))
@@ -1223,6 +1235,8 @@ this variable represents.")
(if (featurep 'emacs)
'((((type pc))
(:foreground "White" :background "gray40"))
+ (((class color) (min-colors 88))
+ (:background "light grey"))
(((class color) (min-colors 16))
(:foreground "Black" :background "light grey"))
(((class color))
@@ -1247,6 +1261,8 @@ this variable represents.")
(if (featurep 'emacs)
'((((type pc))
(:foreground "yellow3" :background "gray40"))
+ (((class color) (min-colors 88))
+ (:background "Grey"))
(((class color) (min-colors 16))
(:foreground "White" :background "Grey"))
(((class color))
@@ -1269,7 +1285,9 @@ this variable represents.")
(defface ediff-odd-diff-Ancestor
(if (featurep 'emacs)
- '((((class color) (min-colors 16))
+ '((((class color) (min-colors 88))
+ (:background "gray40"))
+ (((class color) (min-colors 16))
(:foreground "cyan3" :background "gray40"))
(((class color))
(:foreground "green3" :background "black" :weight bold))
@@ -1327,35 +1345,7 @@ this variable represents.")
(ediff-defvar-local ediff-current-diff-overlay-Ancestor nil
"Overlay for the current difference region in the ancestor buffer.")
-;; Compute priority of a current ediff overlay.
-(defun ediff-highest-priority (start end buffer)
- (let ((pos (max 1 (1- start)))
- ovr-list)
- (if (featurep 'xemacs)
- (1+ ediff-shadow-overlay-priority)
- (ediff-with-current-buffer buffer
- (while (< pos (min (point-max) (1+ end)))
- (setq ovr-list (append (overlays-at pos) ovr-list))
- (setq pos (next-overlay-change pos)))
- (+ 1 ediff-shadow-overlay-priority
- (apply 'max
- (cons
- 1
- (mapcar
- (lambda (ovr)
- (if (and ovr
- ;; exclude ediff overlays from priority
- ;; calculation, or else priority will keep
- ;; increasing
- (null (ediff-overlay-get ovr 'ediff))
- (null (ediff-overlay-get ovr 'ediff-diff-num)))
- ;; use the overlay priority or 0
- (or (ediff-overlay-get ovr 'priority) 0)
- 0))
- ovr-list))))))))
-
-
-(defvar ediff-toggle-read-only-function 'toggle-read-only
+(defvar ediff-toggle-read-only-function 'read-only-mode
"Function to be used to toggle read-only status of the buffer.
If nil, Ediff tries using the command bound to C-x C-q.")
@@ -1465,7 +1455,7 @@ This default should work without changes."
;; The value of dif-num is always 1- the one that user sees.
;; This is why even face is used when dif-num is odd.
(ediff-get-symbol-from-alist
- buf-type (if (ediff-odd-p dif-num)
+ buf-type (if (cl-oddp dif-num)
ediff-even-diff-face-alist
ediff-odd-diff-face-alist)
))
@@ -1729,6 +1719,9 @@ Unless optional argument INPLACE is non-nil, return a new string."
(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")
@@ -1768,7 +1761,7 @@ Unless optional argument INPLACE is non-nil, return a new string."
(or n (setq n ediff-current-difference))
(and (>= n 0) (< n ediff-number-of-differences)))
-(defsubst ediff-show-all-diffs (n)
+(defsubst ediff-show-all-diffs (_n)
"Don't skip difference regions."
nil)
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index a1f4d4f5d78..2da3de1a10e 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -1,6 +1,6 @@
;;; ediff-merg.el --- merging utilities
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -92,6 +92,8 @@ Buffer B."
)
(make-variable-buffer-local 'ediff-skip-merge-regions-that-differ-from-default)
+(defvar state-of-merge) ; dynamic var
+
;; check if there is no clash between the ancestor and one of the variants.
;; if it is not a merge job then return true
(defun ediff-merge-region-is-non-clash (n)
@@ -266,8 +268,8 @@ Buffer B."
(setq ediff-default-variant
(intern
(completing-read
- (format "Current merge default is `%S'. New default: "
- ediff-default-variant)
+ (format-message "Current merge default is `%S'. New default: "
+ ediff-default-variant)
actual-alist nil 'must-match)))
(ediff-do-merge ediff-current-difference 'remerge)
(ediff-recenter)
@@ -351,8 +353,6 @@ Combining is done according to the specifications in variable
(reverse delim-regs-list)
)))
-(defvar state-of-merge) ; dynamic var
-
;; Check if the non-preferred merge has been modified since originally set.
;; This affects only the regions that are marked as default-A/B or combined.
;; If PREFERS-TOO is non-nil, then look at the regions marked as prefers-A/B as
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index 58e10819a30..7bfc3b60b4a 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1,6 +1,6 @@
;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -140,7 +140,7 @@ Useful commands (type ? to hide them and free up screen):
uh/um:\tunmark all sessions marked for hiding/operation
n,SPC:\tnext session
p,DEL:\tprevious session
- E:\tbrowse Ediff on-line manual
+ E:\tbrowse Ediff manual
T:\ttoggle truncation of long file names
q:\tquit this session group
")
@@ -1115,7 +1115,7 @@ behavior."
(setq overl
(if (featurep 'xemacs)
(map-extents
- (lambda (ext maparg)
+ (lambda (ext _maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
@@ -1444,7 +1444,7 @@ Useful commands:
;; argument is ignored
-(defun ediff-redraw-registry-buffer (&optional ignore)
+(defun ediff-redraw-registry-buffer (&optional _ignore)
(ediff-with-current-buffer ediff-registry-buffer
(let ((point (point))
elt bufAname bufBname bufCname cur-diff total-diffs pt
@@ -1456,7 +1456,8 @@ Useful commands:
(map-extents 'delete-extent)
(mapc 'delete-overlay (overlays-in 1 1)))
- (insert "This is a registry of all active Ediff sessions.
+ (insert (substitute-command-keys "\
+This is a registry of all active Ediff sessions.
Useful commands:
button2, `v', RET over a session record: switch to that session
@@ -1464,14 +1465,14 @@ Useful commands:
R in any Ediff session: display session registry
n,SPC: next session
p,DEL: previous session
- E: browse Ediff on-line manual
+ E: browse Ediff manual
q: bury registry
\t\tActive Ediff Sessions:
\t\t----------------------
-")
+"))
;; purge registry list from dead buffers
(mapc (lambda (elt)
(if (not (ediff-buffer-live-p elt))
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index e22b31ed048..a3b8bf0a28a 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -1,6 +1,6 @@
;;; ediff-ptch.el --- Ediff's patch support
-;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -90,14 +90,14 @@ See also `ediff-backup-specs'."
;; traditional `patch'
(format "-b %s" ediff-backup-extension))))
"Backup directives to pass to the patch program.
-Ediff requires that the old version of the file \(before applying the patch\)
+Ediff requires that the old version of the file \(before applying the patch)
be saved in a file named `the-patch-file.extension'. Usually `extension' is
`.orig', but this can be changed by the user and may depend on the system.
Therefore, Ediff needs to know the backup extension used by the patch program.
Some versions of the patch program let you specify `-b backup-extension'.
Other versions only permit `-b', which assumes the extension `.orig'
-\(in which case ediff-backup-extension MUST be also `.orig'\). The latest
+\(in which case ediff-backup-extension MUST be also `.orig'). The latest
versions of GNU patch require `-b -z backup-extension'.
Note that both `ediff-backup-extension' and `ediff-backup-specs'
@@ -333,7 +333,7 @@ program."
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ
- (format "
+ (format-message "
The patch file contains a context diff for
%s
%s
@@ -342,7 +342,7 @@ to be patched on your system. If you know the correct file name,
please enter it now.
If you don't know and still would like to apply patches to
-other files, enter /dev/null
+other files, enter `/dev/null'.
"
(substring (car proposed-file-names) 6)
(substring (cdr proposed-file-names) 6))))
@@ -406,7 +406,7 @@ other files, enter /dev/null
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
- (princ (format "
+ (princ (format-message "
Ediff has inferred that
%s
%s
@@ -723,7 +723,7 @@ optional argument, then use it."
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
- (princ (format
+ (princ (format-message
"Patch program has failed due to a bad patch file,
it couldn't apply all hunks, OR
it couldn't create the backup for the file being patched.
@@ -735,7 +735,7 @@ The second problem might be due to an incompatibility among these settings:
ediff-patch-program = %S ediff-patch-options = %S
ediff-backup-extension = %S ediff-backup-specs = %S
-See Ediff on-line manual for more details on these variables.
+See Ediff manual for more details on these variables.
In particular, check the documentation for `ediff-backup-specs'.
In any of the above cases, Ediff doesn't compare files automatically.
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 2f2c71a71e6..7ef425449c1 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1,6 +1,6 @@
;;; ediff-util.el --- the core commands and utilities of ediff
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -40,7 +40,7 @@
(defvar ediff-after-quit-hook-internal nil)
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
;; end pacifier
@@ -958,7 +958,7 @@ On a dumb terminal, switches between ASCII highlighting and no highlighting."
(message "Auto-refining is OFF")
(setq ediff-auto-refine 'off))
(t ;; nix 'em
- (ediff-set-fine-diff-properties ediff-current-difference 'default)
+ (ediff-set-fine-diff-properties ediff-current-difference t)
(message "Refinements are HIDDEN")
(setq ediff-auto-refine 'nix))
))
@@ -1027,8 +1027,8 @@ of the current buffer."
(file-writable-p file)))
(toggle-ro-cmd (cond (ediff-toggle-read-only-function)
((ediff-file-checked-out-p file)
- 'toggle-read-only)
- (file-writable 'toggle-read-only)
+ 'read-only-mode)
+ (file-writable 'read-only-mode)
(t (key-binding "\C-x\C-q")))))
;; If the file is checked in, make sure we don't make buffer modifiable
;; without warning the user. The user can fool our checks by making the
@@ -1039,7 +1039,7 @@ of the current buffer."
;; non-interactively, in which case don't ask questions
ctl-buf)
(cond ((not buffer-read-only)
- (setq toggle-ro-cmd 'toggle-read-only))
+ (setq toggle-ro-cmd 'read-only-mode))
((and (or (beep 1) t) ; always beep
(y-or-n-p
(format
@@ -1054,13 +1054,13 @@ of the current buffer."
(ediff-change-saved-variable
'buffer-read-only nil buf-type)))
(t
- (setq toggle-ro-cmd 'toggle-read-only)
+ (setq toggle-ro-cmd 'read-only-mode)
(beep 1) (beep 1)
(message
"Boy, this is risky! Don't modify this file...")
(sit-for 3)))) ; let the user see the warning
(if (and toggle-ro-cmd
- (string-match "toggle-read-only" (symbol-name toggle-ro-cmd)))
+ (string-match "read-only-mode" (symbol-name toggle-ro-cmd)))
(save-excursion
(save-window-excursion
(select-window (ediff-get-visible-buffer-window buf))
@@ -1500,7 +1500,7 @@ Used in ediff-windows/regions only."
(select-window wind)))
(defun ediff-scroll-vertically (&optional arg)
- "Vertically scroll buffers A, B \(and C if appropriate\).
+ "Vertically scroll buffers A, B (and C if appropriate).
With optional argument ARG, scroll ARG lines; otherwise scroll by nearly
the one half of the height of window-A."
(interactive "P")
@@ -1544,7 +1544,7 @@ the one half of the height of window-A."
(defun ediff-scroll-horizontally (&optional arg)
- "Horizontally scroll buffers A, B \(and C if appropriate\).
+ "Horizontally scroll buffers A, B (and C if appropriate).
If an argument is given, that is how many columns are scrolled, else nearly
the width of the A/B/C windows."
(interactive "P")
@@ -1602,7 +1602,7 @@ the width of the A/B/C windows."
;;BEG, END show the region to be positioned.
;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
;;differently.
-(defun ediff-position-region (beg end pos job-name)
+(defun ediff-position-region (beg end pos _job-name)
(if (> end (point-max))
(setq end (point-max)))
(if ediff-windows-job
@@ -1685,7 +1685,7 @@ the width of the A/B/C windows."
'ediff-get-lines-to-region-start)
((eq op 'scroll-up)
'ediff-get-lines-to-region-end)
- (t (lambda (a b c) 0))))
+ (t (lambda (_a _b _c) 0))))
(max-lines (max (funcall func 'A n ctl-buf)
(funcall func 'B n ctl-buf)
(if (ediff-buffer-live-p ediff-buffer-C)
@@ -1822,7 +1822,7 @@ If the prefix is negative, count differences from the end."
(defun ediff-jump-to-difference-at-point (arg)
"Go to difference closest to the point in buffer A, B, or C.
-The buffer depends on last command character \(a, b, or c\) that invoked this
+The buffer depends on last command character \(a, b, or c) that invoked this
command. For instance, if the command was `ga' then the point value in buffer
A is used.
With a prefix argument, synchronize all files around the current point position
@@ -1921,7 +1921,7 @@ in the specified buffer."
;;; Copying diffs.
(defun ediff-diff-to-diff (arg &optional keys)
- "Copy buffer-X'th difference region to buffer Y \(X,Y are A, B, or C\).
+ "Copy buffer-X'th difference region to buffer Y (X,Y are A, B, or C).
If numerical prefix argument, copy the difference specified in the arg.
Otherwise, copy the difference given by `ediff-current-difference'.
This command assumes it is bound to a 2-character key sequence, `ab', `ba',
@@ -1986,7 +1986,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
-;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE.
+;; Copy diff N from FROM-BUF-TYPE (given as A, B or C) to TO-BUF-TYPE.
;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the
;; target diff. This is used in merging, when constructing the merged
;; version.
@@ -2065,7 +2065,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(message "%s" messg))
))
-;; Save Nth diff of buffer BUF-TYPE \(A, B, or C\).
+;; Save Nth diff of buffer BUF-TYPE (A, B, or C).
;; That is to say, the Nth diff on the `ediff-killed-diffs-alist'. REG
;; is the region to save. It is redundant here, but is passed anyway, for
;; convenience.
@@ -2097,7 +2097,7 @@ ARG is a prefix argument. If nil, copy the current difference region."
(if this-buf-n-th-diff-saved
(if (yes-or-no-p
- (format
+ (format-message
"You've previously copied diff region %d to buffer %S. Confirm? "
(1+ n) buf-type))
t
@@ -2318,6 +2318,7 @@ the number seen by the user."
(narrow-to-region
(ediff-get-diff-posn 'B 'beg n ctl-buf)
(ediff-get-diff-posn 'B 'end n ctl-buf))
+ (goto-char (point-min))
(re-search-forward regex-B nil t))))
(reg-C-match (if ediff-3way-comparison-job
(ediff-with-current-buffer ediff-buffer-C
@@ -2325,6 +2326,7 @@ the number seen by the user."
(narrow-to-region
(ediff-get-diff-posn 'C 'beg n ctl-buf)
(ediff-get-diff-posn 'C 'end n ctl-buf))
+ (goto-char (point-min))
(re-search-forward regex-C nil t))))))
(not (eval (if ediff-3way-comparison-job
(list ediff-focus-regexp-connective
@@ -2383,10 +2385,10 @@ the number seen by the user."
"Finish an Ediff session and exit Ediff.
Unselects the selected difference, if any, restores the read-only and modified
flags of the compared file buffers, kills Ediff buffers for this session
-\(but not buffers A, B, C\).
+\(but not buffers A, B, C).
If `ediff-keep-variants' is nil, the user will be asked whether the buffers
-containing the variants should be removed \(if they haven't been modified\).
+containing the variants should be removed \(if they haven't been modified).
If it is t, they will be preserved unconditionally. A prefix argument,
temporarily reverses the meaning of this variable."
(interactive "P")
@@ -2856,13 +2858,14 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(B-line (ediff-with-current-buffer ediff-buffer-B
(1+ (count-lines (point-min) (point)))))
C-line)
- (princ (format "\Buffer A's point is on line %d\n" A-line))
- (princ (format "Buffer B's point is on line %d\n" B-line))
+ (princ (format-message "Buffer A's point is on line %d\n" A-line))
+ (princ (format-message "Buffer B's point is on line %d\n" B-line))
(if ediff-3way-job
(progn
(setq C-line (ediff-with-current-buffer ediff-buffer-C
(1+ (count-lines (point-min) (point)))))
- (princ (format "Buffer C's point is on line %d\n" C-line)))))
+ (princ (format-message
+ "Buffer C's point is on line %d\n" C-line)))))
(princ (format "\nCurrent difference number = %S\n"
(cond ((< ediff-current-difference 0) 'start)
@@ -2888,7 +2891,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(princ
"\nIgnoring regions that match")
(princ
- (format
+ (format-message
"\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n"
ediff-regexp-hide-A ediff-hide-regexp-connective
ediff-regexp-hide-B)))
@@ -2897,15 +2900,16 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(princ
"\nFocusing on regions that match")
(princ
- (format
+ (format-message
"\n\t regexp `%s' in buffer A %S\n\t regexp `%s' in buffer B\n"
ediff-regexp-focus-A ediff-focus-regexp-connective
ediff-regexp-focus-B)))
(t (princ "\nSelective browsing via a user-defined method.\n")))
(princ
- (format "\nBugs/suggestions: type `%s' while in Ediff Control Panel."
- (substitute-command-keys "\\[ediff-submit-report]")))
+ (format-message
+ "\nBugs/suggestions: type `%s' while in Ediff Control Panel."
+ (substitute-command-keys "\\[ediff-submit-report]")))
) ; with output
(if (frame-live-p ediff-control-frame)
(ediff-reset-mouse ediff-control-frame))
@@ -2973,7 +2977,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
))
;; unhighlight fine diffs
- (ediff-set-fine-diff-properties ediff-current-difference 'default)
+ (ediff-set-fine-diff-properties ediff-current-difference t)
(run-hooks 'ediff-unselect-hook))))
@@ -3023,8 +3027,6 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(if (featurep 'xemacs)
(ediff-move-overlay current-diff-overlay begin end-hilit)
(ediff-move-overlay current-diff-overlay begin end-hilit buff))
- (ediff-overlay-put current-diff-overlay 'priority
- (ediff-highest-priority begin end-hilit buff))
(ediff-overlay-put current-diff-overlay 'ediff-diff-num n)
;; unhighlight the background overlay for diff n so it won't
@@ -3310,7 +3312,7 @@ and `wd' saves the diff output.
With prefix argument, `wd' saves plain diff output.
Without an argument, it saves customized diff argument, if available
-\(and plain output, if customized output was not generated\)."
+\(and plain output, if customized output was not generated)."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(ediff-compute-custom-diffs-maybe)
@@ -3346,6 +3348,7 @@ Without an argument, it saves customized diff argument, if available
(setq wind (ediff-get-visible-buffer-window cloned-buff))
(select-window wind)
(delete-other-windows)
+ (or (mark) (push-mark))
(ediff-activate-mark)
(split-window-vertically)
(ediff-select-lowest-window)
@@ -3494,7 +3497,7 @@ Ediff Control Panel to restore highlighting."
(if (ediff-valid-difference-p ediff-current-difference)
(progn
- (ediff-set-fine-diff-properties ediff-current-difference 'default)
+ (ediff-set-fine-diff-properties ediff-current-difference t)
(ediff-unhighlight-diff)))
(ediff-paint-background-regions 'unhighlight)
@@ -3988,7 +3991,7 @@ and mail it to the address above.
Please read this first:
----------------------
-Some ``bugs'' may actually be no bugs at all. For instance, if you are
+Some \"bugs\" may actually be no bugs at all. For instance, if you are
reporting that certain difference regions are not matched as you think they
should, this is most likely due to the way Unix diff program decides what
constitutes a difference region. Ediff is an Emacs interface to diff, and
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index dc004fd1ff1..5e745875c70 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -1,6 +1,6 @@
;;; ediff-vers.el --- version control interface to Ediff
-;; Copyright (C) 1995-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-1997, 2001-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 5a14c193344..e0887f03b62 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -1,6 +1,6 @@
;;; ediff-wind.el --- window manipulation utilities
-;; Copyright (C) 1994-1997, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-1997, 2000-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Package: ediff
@@ -40,7 +40,7 @@
;; declare-function does not exist in XEmacs
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
(require 'ediff-init)
(require 'ediff-help)
@@ -211,7 +211,7 @@ responsibility."
"Function to call to determine the desired location for the control panel.
Expects three parameters: the control buffer, the desired width and height
of the control frame. It returns an association list
-of the form \(\(top . <position>\) \(left . <position>\)\)"
+of the form \((top . <position>) \(left . <position>))"
:type 'function
:group 'ediff-window)
@@ -280,7 +280,7 @@ into icons, regardless of the window manager."
;;; Functions
-(defun ediff-get-window-by-clicking (wind prev-wind wind-number)
+(defun ediff-get-window-by-clicking (_wind _prev-wind wind-number)
(let (event)
(message
"Select windows by clicking. Please click on Window %d " wind-number)
@@ -289,9 +289,9 @@ into icons, regardless of the window manager."
(beep 1))
(message "Please click on Window %d " wind-number))
(ediff-read-event) ; discard event
- (setq wind (if (featurep 'xemacs)
- (event-window event)
- (posn-window (event-start event))))))
+ (if (featurep 'xemacs)
+ (event-window event)
+ (posn-window (event-start event)))))
;; Select the lowest window on the frame.
@@ -432,7 +432,7 @@ into icons, regardless of the window manager."
three-way-comparison ediff-3way-comparison-job))
;; if in minibuffer go somewhere else
(if (save-match-data
- (string-match "\*Minibuf-" (buffer-name (window-buffer))))
+ (string-match "\\*Minibuf-" (buffer-name (window-buffer))))
(select-window (next-window nil 'ignore-minibuf)))
(delete-other-windows)
(set-window-dedicated-p (selected-window) nil)
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index d35c3e53e9a..3a2d1e48aac 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1,6 +1,6 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch
-;; Copyright (C) 1994-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2015 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Created: February 2, 1994
@@ -64,7 +64,7 @@
;; compressed files. Details are given below.
;; Finally, Ediff supports directory-level comparison, merging and patching.
-;; See the on-line manual for details.
+;; See the Ediff manual for details.
;; This package builds upon the ideas borrowed from emerge.el and several
;; Ediff's functions are adaptations from emerge.el. Much of the functionality
@@ -114,7 +114,7 @@
;; Compiler pacifier
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
(require 'ediff-util)
;; end pacifier
@@ -367,8 +367,10 @@ deleted."
This command can be used instead of `revert-buffer'. If there is
nothing to revert then this command fails."
(interactive)
- (unless (or revert-buffer-function
- revert-buffer-insert-file-contents-function
+ ;; This duplicates code from menu-bar.el.
+ (unless (or (not (eq revert-buffer-function 'revert-buffer--default))
+ (not (eq revert-buffer-insert-file-contents-function
+ 'revert-buffer-insert-file-contents--default-function))
(and buffer-file-number
(or (buffer-modified-p)
(not (verify-visited-file-modtime
@@ -961,7 +963,7 @@ If WIND-B is nil, use window next to WIND-A."
;;;###autoload
(defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in specified buffers.
-Regions \(i.e., point and mark\) can be set in advance or marked interactively.
+Regions (i.e., point and mark) can be set in advance or marked interactively.
This function is effective only for relatively small regions, up to 200
lines. For large regions, use `ediff-regions-linewise'."
(interactive
@@ -1001,7 +1003,7 @@ lines. For large regions, use `ediff-regions-linewise'."
;;;###autoload
(defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in specified buffers.
-Regions \(i.e., point and mark\) can be set in advance or marked interactively.
+Regions (i.e., point and mark) can be set in advance or marked interactively.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
lines. For small regions, use `ediff-regions-wordwise'."
@@ -1292,7 +1294,7 @@ buffer."
(let (rev1 rev2)
(setq rev1
(read-string
- (format
+ (format-message
"Version 1 to merge (default %s's working version): "
(if (stringp file)
(file-name-nondirectory file) "current buffer")))
@@ -1324,7 +1326,7 @@ buffer."
(let (rev1 rev2 ancestor-rev)
(setq rev1
(read-string
- (format
+ (format-message
"Version 1 to merge (default %s's working version): "
(if (stringp file)
(file-name-nondirectory file) "current buffer")))
@@ -1336,7 +1338,7 @@ buffer."
(file-name-nondirectory file) "current buffer")))
ancestor-rev
(read-string
- (format
+ (format-message
"Ancestor version (default %s's base revision): "
(if (stringp file)
(file-name-nondirectory file) "current buffer"))))
@@ -1481,7 +1483,7 @@ When called interactively, displays the version."
(format "Ediff %s of %s" ediff-version ediff-date)))
;; info is run first, and will autoload info.el.
-(declare-function Info-goto-node "info" (nodename &optional fork))
+(declare-function Info-goto-node "info" (nodename &optional fork strict-case))
;;;###autoload
(defun ediff-documentation (&optional node)
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index 8d0e8efc75c..de25cbafb0d 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -261,11 +261,19 @@ Do not start with `~/' or `~USERNAME/'."
:type 'string
:group 'emerge)
+(make-obsolete-variable 'emerge-temp-file-prefix
+ "customize `temporary-file-directory' instead."
+ "24.4" 'set)
+
(defcustom emerge-temp-file-mode 384 ; u=rw only
"Mode for Emerge temporary files."
:type 'integer
:group 'emerge)
+(make-obsolete-variable 'emerge-temp-file-mode
+ "it has no effect, temporary files are always private."
+ "24.4" 'set)
+
(defcustom emerge-combine-versions-template
"#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n"
"Template for `emerge-combine-versions' to combine the two versions.
@@ -849,7 +857,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
;;; Functions to start Emerge on files
;;;###autoload
-(defun emerge-files (arg file-A file-B file-out &optional startup-hooks
+(defun emerge-files (_arg file-A file-B file-out &optional startup-hooks
quit-hooks)
"Run Emerge on two files."
(interactive
@@ -869,7 +877,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
file-out))
;;;###autoload
-(defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out
+(defun emerge-files-with-ancestor (_arg file-A file-B file-ancestor file-out
&optional startup-hooks quit-hooks)
"Run Emerge on two files, giving another file as the ancestor."
(interactive
@@ -1063,7 +1071,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
quit-hooks)))
(defun emerge-revisions-internal (file revision-A revision-B &optional
- startup-hooks quit-hooks output-file)
+ startup-hooks quit-hooks _output-file)
(let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
(emerge-file-A (emerge-make-temp-file "A"))
@@ -2516,8 +2524,12 @@ for how the template is interpreted.
Refuses to function if this difference has been edited, i.e., if it is
neither the A nor the B variant.
An argument forces the variant to be selected even if the difference has
-been edited."
- (interactive "cRegister containing template: \nP")
+been edited.
+
+Interactively, reads the register using `register-read-with-preview'."
+ (interactive (list
+ (register-read-with-preview "Register containing template: ")
+ current-prefix-arg))
(let ((template (get-register char)))
(if (not (stringp template))
(error "Register does not contain text"))
@@ -2871,16 +2883,11 @@ keymap. Leaves merge in fast mode."
(setq vars (cdr vars))
(setq values (cdr values))))
-;; Make a temporary file that only we have access to.
-;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix.
+;; When the pointless option emerge-temp-file-prefix goes,
+;; make this function obsolete too, and just use make-temp-file.
(defun emerge-make-temp-file (prefix)
- (let (f (old-modes (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes emerge-temp-file-mode)
- (setq f (make-temp-file (concat emerge-temp-file-prefix prefix))))
- (set-default-file-modes old-modes))
- f))
+ "Make a private temporary file based on `emerge-temp-file-prefix'."
+ (make-temp-file (concat emerge-temp-file-prefix prefix)))
;;; Functions that query the user before he can write out the current buffer.
@@ -3082,7 +3089,7 @@ SPC, it is ignored; if it is anything else, it is processed as a command."
(let* ((echo-keystrokes 0)
(c (read-event)))
(if (not (eq c 32))
- (setq unread-command-events (list c)))))
+ (push c unread-command-events))))
(erase-buffer)))))
;; Improved auto-save file names.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index dfc7eee81a6..9857116e2d4 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -1,6 +1,6 @@
;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs cvs commit log vc
@@ -32,6 +32,7 @@
(require 'add-log) ; for all the ChangeLog goodies
(require 'pcvs-util)
(require 'ring)
+(require 'message)
;;;;
;;;; Global Variables
@@ -55,6 +56,8 @@
("\C-c\C-a" . log-edit-insert-changelog)
("\C-c\C-d" . log-edit-show-diff)
("\C-c\C-f" . log-edit-show-files)
+ ("\C-c\C-k" . log-edit-kill-buffer)
+ ("\C-a" . log-edit-beginning-of-line)
("\M-n" . log-edit-next-comment)
("\M-p" . log-edit-previous-comment)
("\M-r" . log-edit-comment-search-backward)
@@ -116,15 +119,29 @@ If SETUP is 'force, this variable has no effect."
:group 'log-edit
:type 'boolean)
-(defcustom log-edit-hook '(log-edit-insert-cvs-template
- log-edit-show-files
- log-edit-insert-changelog)
+(defcustom log-edit-setup-add-author nil
+ "Non-nil means `log-edit' may add the `Author:' header.
+This applies when its SETUP argument is non-nil."
+ :version "24.4"
+ :group 'log-edit
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom log-edit-hook '(log-edit-insert-message-template
+ log-edit-insert-cvs-template
+ log-edit-insert-changelog
+ log-edit-show-files)
"Hook run at the end of `log-edit'."
+ ;; Added log-edit-insert-message-template, moved log-edit-show-files.
+ :version "24.4"
:group 'log-edit
- :type '(hook :options (log-edit-insert-changelog
- log-edit-insert-cvs-rcstemplate
- log-edit-insert-cvs-template
- log-edit-insert-filenames)))
+ :type '(hook :options (log-edit-insert-message-template
+ log-edit-insert-cvs-rcstemplate
+ log-edit-insert-cvs-template
+ log-edit-insert-changelog
+ log-edit-insert-filenames
+ log-edit-insert-filenames-without-changelog
+ log-edit-show-files)))
(defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook)
"Hook run when entering `log-edit-mode'."
@@ -150,7 +167,7 @@ can be obtained from `log-edit-files'."
(defvar log-edit-changelog-full-paragraphs t
"If non-nil, include full ChangeLog paragraphs in the log.
-This may be set in the ``local variables'' section of a ChangeLog, to
+This may be set in the \"local variables\" section of a ChangeLog, to
indicate the policy for that ChangeLog.
A ChangeLog paragraph is a bunch of log text containing no blank lines;
@@ -256,7 +273,7 @@ WHOAMI (interactive prefix) non-nil means prompt for user name
and site. FILE-NAME is the name of the change log; if nil, use
`change-log-default-name'.
-This may be useful as a `log-edit-checkin-hook' to update change logs
+This may be useful as a `vc-checkin-hook' to update change logs
automatically."
(interactive (if current-prefix-arg
(list current-prefix-arg
@@ -340,6 +357,27 @@ The first subexpression is the actual text of the field.")
(set-match-data (list start (point)))
(point))))
+(defun log-edit-goto-eoh () ;FIXME: Almost rfc822-goto-eoh!
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-:]\\)" nil 'move)
+ (goto-char (match-beginning 0))))
+
+(defun log-edit--match-first-line (limit)
+ (let ((start (point)))
+ (log-edit-goto-eoh)
+ (skip-chars-forward "\n")
+ (and (< start (line-end-position))
+ (< (point) limit)
+ (save-excursion
+ (not (re-search-backward "^Summary:[ \t]*[^ \t\n]" nil t)))
+ (looking-at ".+")
+ (progn
+ (goto-char (match-end 0))
+ (put-text-property (point-min) (point)
+ 'jit-lock-defer-multiline t)
+ (point)))))
+
(defvar log-edit-font-lock-keywords
;; Copied/inspired by message-font-lock-keywords.
`((log-edit-match-to-eoh
@@ -355,7 +393,8 @@ The first subexpression is the actual text of the field.")
nil lax))
("^\n"
(progn (goto-char (match-end 0)) (1+ (match-end 0))) nil
- (0 '(:height 0.1 :inverse-video t))))))
+ (0 '(:height 0.1 :inverse-video t))))
+ (log-edit--match-first-line (0 'log-edit-summary))))
(defvar log-edit-font-lock-gnu-style nil
"If non-nil, highlight common failures to follow the GNU coding standards.")
@@ -427,10 +466,6 @@ done. Otherwise, it uses the current buffer."
(if buffer (pop-to-buffer buffer))
(when (and log-edit-setup-invert (not (eq setup 'force)))
(setq setup (not setup)))
- (when setup
- (erase-buffer)
- (insert "Summary: \nAuthor: ")
- (save-excursion (insert "\n\n")))
(if mode
(funcall mode)
(log-edit-mode))
@@ -444,8 +479,10 @@ done. Otherwise, it uses the current buffer."
(if buffer (set (make-local-variable 'log-edit-parent-buffer) parent))
(set (make-local-variable 'log-edit-initial-files) (log-edit-files))
- (when setup (run-hooks 'log-edit-hook))
- (goto-char (point-min)) (push-mark (point-max))
+ (when setup
+ (erase-buffer)
+ (run-hooks 'log-edit-hook))
+ (push-mark (point-max))
(message "%s" (substitute-command-keys
"Press \\[log-edit-done] when you are done editing."))))
@@ -460,14 +497,26 @@ commands (under C-x v for VC, for example).
\\{log-edit-mode-map}"
(set (make-local-variable 'font-lock-defaults)
'(log-edit-font-lock-keywords t))
+ (setq-local jit-lock-contextually t) ;For the "first line is summary".
(make-local-variable 'log-edit-comment-ring-index)
+ (add-hook 'kill-buffer-hook 'log-edit-remember-comment nil t)
(hack-dir-local-variables-non-file-buffer))
(defun log-edit-hide-buf (&optional buf where)
(when (setq buf (get-buffer (or buf log-edit-files-buf)))
- (let ((win (get-buffer-window buf where)))
- (if win (ignore-errors (delete-window win))))
- (bury-buffer buf)))
+ ;; FIXME: Should use something like `quit-windows-on' here, but
+ ;; that function never deletes this buffer's window because it
+ ;; was created using `cvs-pop-to-buffer-same-frame'.
+ (save-selected-window
+ (let ((win (get-buffer-window buf where)))
+ (if win (ignore-errors (delete-window win))))
+ (bury-buffer buf))))
+
+(defun log-edit-remember-comment (&optional comment)
+ (unless comment (setq comment (buffer-string)))
+ (when (or (ring-empty-p log-edit-comment-ring)
+ (not (equal comment (ring-ref log-edit-comment-ring 0))))
+ (ring-insert log-edit-comment-ring comment)))
(defun log-edit-done ()
"Finish editing the log message and commit the files.
@@ -500,10 +549,7 @@ If you want to abort the commit, simply delete the buffer."
(save-excursion
(goto-char (point-max))
(insert ?\n)))
- (let ((comment (buffer-string)))
- (when (or (ring-empty-p log-edit-comment-ring)
- (not (equal comment (ring-ref log-edit-comment-ring 0))))
- (ring-insert log-edit-comment-ring comment)))
+ (log-edit-remember-comment)
(let ((win (get-buffer-window log-edit-files-buf)))
(if (and log-edit-confirm
(not (and (eq log-edit-confirm 'changed)
@@ -519,6 +565,16 @@ If you want to abort the commit, simply delete the buffer."
(cvs-bury-buffer (current-buffer) log-edit-parent-buffer))
(call-interactively log-edit-callback))))
+(defun log-edit-kill-buffer ()
+ "Kill the current buffer.
+Also saves its contents in the comment history and hides
+`log-edit-files-buf'."
+ (interactive)
+ (log-edit-hide-buf)
+ (let ((buf (current-buffer)))
+ (quit-windows-on buf)
+ (kill-buffer buf)))
+
(defun log-edit-files ()
"Return the list of files that are about to be committed."
(ignore-errors (funcall log-edit-listfun)))
@@ -572,8 +628,18 @@ If you want to abort the commit, simply delete the buffer."
(save-selected-window
(cvs-pop-to-buffer-same-frame buf)
(shrink-window-if-larger-than-buffer)
+ (set-window-dedicated-p (selected-window) t)
(selected-window)))))
+(defun log-edit-beginning-of-line (&optional n)
+ "Move point to beginning of header value or to beginning of line.
+
+It works the same as `message-beginning-of-line', but it uses a
+different header separator appropriate for `log-edit-mode'."
+ (interactive "p")
+ (let ((mail-header-separator ""))
+ (message-beginning-of-line n)))
+
(defun log-edit-empty-buffer-p ()
"Return non-nil if the buffer is \"empty\"."
(or (= (point-min) (point-max))
@@ -583,6 +649,17 @@ If you want to abort the commit, simply delete the buffer."
(zerop (forward-line 1))))
(eobp))))
+(defun log-edit-insert-message-template ()
+ "Insert the default template with Summary and Author."
+ (interactive)
+ (when (or (called-interactively-p 'interactive)
+ (log-edit-empty-buffer-p))
+ (insert "Summary: ")
+ (when log-edit-setup-add-author
+ (insert "\nAuthor: "))
+ (insert "\n\n")
+ (message-position-point)))
+
(defun log-edit-insert-cvs-template ()
"Insert the template specified by the CVS administrator, if any.
This simply uses the local CVS/Template file."
@@ -614,12 +691,25 @@ can thus take some time."
(insert "Affected files: \n"
(mapconcat 'identity (log-edit-files) " \n")))
+(defun log-edit-insert-filenames-without-changelog ()
+ "Insert the list of files that have no ChangeLog message."
+ (interactive)
+ (let ((files
+ (delq nil
+ (mapcar
+ (lambda (file)
+ (unless (or (cdr-safe (log-edit-changelog-entries file))
+ (equal (file-name-nondirectory file) "ChangeLog"))
+ file))
+ (log-edit-files)))))
+ (when files
+ (goto-char (point-max))
+ (insert (mapconcat 'identity files ", ") ": "))))
+
(defun log-edit-add-to-changelog ()
"Insert this log message into the appropriate ChangeLog file."
(interactive)
- ;; Yuck!
- (unless (string= (buffer-string) (ring-ref log-edit-comment-ring 0))
- (ring-insert log-edit-comment-ring (buffer-string)))
+ (log-edit-remember-comment)
(dolist (f (log-edit-files))
(let ((buffer-file-name (expand-file-name f)))
(save-excursion
@@ -627,6 +717,9 @@ can thus take some time."
(defvar log-edit-changelog-use-first nil)
+(defvar log-edit-rewrite-tiny-change t
+ "Non-nil means rewrite (tiny change).")
+
(defvar log-edit-rewrite-fixes nil
"Rule to rewrite bug numbers into Fixes: headers.
The value should be of the form (REGEXP . REPLACEMENT)
@@ -660,39 +753,45 @@ If the optional prefix arg USE-FIRST is given (via \\[universal-argument]),
or if the command is repeated a second time in a row, use the first log entry
regardless of user name or time."
(interactive "P")
- (let ((eoh (save-excursion (rfc822-goto-eoh) (point))))
- (when (<= (point) eoh)
- (goto-char eoh)
- (if (looking-at "\n") (forward-char 1))))
- (let ((author
- (let ((log-edit-changelog-use-first
- (or use-first (eq last-command 'log-edit-insert-changelog))))
- (log-edit-insert-changelog-entries (log-edit-files)))))
- (log-edit-set-common-indentation)
- ;; Add an Author: field if appropriate.
- (when author (log-edit-add-field "Author" author))
- ;; Add a Fixes: field if applicable.
- (when (consp log-edit-rewrite-fixes)
- (rfc822-goto-eoh)
- (when (re-search-forward (car log-edit-rewrite-fixes) nil t)
- (let ((start (match-beginning 0))
- (end (match-end 0))
- (fixes (match-substitute-replacement
- (cdr log-edit-rewrite-fixes))))
- (delete-region start end)
- (log-edit-add-field "Fixes" fixes))))
- (and log-edit-strip-single-file-name
- (progn (rfc822-goto-eoh)
- (if (looking-at "\n") (forward-char 1))
- (looking-at "\\*\\s-+"))
- (let ((start (point)))
- (forward-line 1)
- (when (not (re-search-forward "^\\*\\s-+" nil t))
- (goto-char start)
- (skip-chars-forward "^():")
- (skip-chars-forward ": ")
- (delete-region start (point)))))
- (goto-char (point-min))))
+ (save-excursion
+ (let ((eoh (save-excursion (rfc822-goto-eoh) (point))))
+ (when (<= (point) eoh)
+ (goto-char eoh)
+ (if (looking-at "\n") (forward-char 1))))
+ (let ((author
+ (let ((log-edit-changelog-use-first
+ (or use-first (eq last-command 'log-edit-insert-changelog))))
+ (log-edit-insert-changelog-entries (log-edit-files)))))
+ (log-edit-set-common-indentation)
+ ;; Add an Author: field if appropriate.
+ (when author (log-edit-add-field "Author" (car author)))
+ ;; Add a Fixes: field if applicable.
+ (when (consp log-edit-rewrite-fixes)
+ (rfc822-goto-eoh)
+ (when (re-search-forward (car log-edit-rewrite-fixes) nil t)
+ (let ((start (match-beginning 0))
+ (end (match-end 0))
+ (fixes (match-substitute-replacement
+ (cdr log-edit-rewrite-fixes))))
+ (delete-region start end)
+ (log-edit-add-field "Fixes" fixes))))
+ (and log-edit-strip-single-file-name
+ (progn (rfc822-goto-eoh)
+ (if (looking-at "\n") (forward-char 1))
+ (looking-at "\\*\\s-+"))
+ (let ((start (point)))
+ (forward-line 1)
+ (when (not (re-search-forward "^\\*\\s-+" nil t))
+ (goto-char start)
+ (skip-chars-forward "^():")
+ (skip-chars-forward ": ")
+ (delete-region start (point)))))
+ ;; FIXME also add "Co-authored-by" when appropriate.
+ ;; Bzr accepts multiple --author arguments, others (?) don't.
+ (and log-edit-rewrite-tiny-change
+ (eq 'tiny (cdr author))
+ (goto-char (point-max))
+ (insert "\nCopyright-paperwork-exempt: yes\n")))))
;;;;
;;;; functions for getting commit message from ChangeLog a file...
@@ -773,24 +872,32 @@ Return non-nil if it is."
(and (boundp 'user-mail-address) user-mail-address)))
(time (or (and (boundp 'add-log-time-format)
(functionp add-log-time-format)
- (funcall add-log-time-format))
+ (funcall add-log-time-format
+ nil add-log-time-zone-rule))
(format-time-string "%Y-%m-%d"))))
(if (null log-edit-changelog-use-first)
(looking-at (regexp-quote (format "%s %s <%s>" time name mail)))
;; Check the author, to potentially add it as a "Author: " header.
+ ;; FIXME This accumulates multiple authors, but only when there
+ ;; are multiple ChangeLog files. It should also check for
+ ;; multiple authors in each individual entry.
(when (looking-at "[^ \t]")
(when (and (boundp 'log-edit-author)
(not (looking-at (format ".+ .+ <%s>"
(regexp-quote mail))))
- (looking-at ".+ \\(.+ <.+>\\)"))
+ (looking-at ".+ \\(.+ <.+>\\) *\\((tiny change)\\)?"))
(let ((author (replace-regexp-in-string " " " "
(match-string 1))))
(unless (and log-edit-author
- (string-match (regexp-quote author) log-edit-author))
- (setq log-edit-author
- (if log-edit-author
- (concat log-edit-author ", " author)
- author)))))
+ (string-match (regexp-quote author)
+ (car log-edit-author)))
+ (if (not log-edit-author)
+ (setq log-edit-author
+ (cons author (if (match-string 2) 'tiny)))
+ (setcar log-edit-author
+ (concat (car log-edit-author) ", " author))
+ (and (match-string 2) (not (cdr log-edit-author))
+ (setcdr log-edit-author 'tiny))))))
t))))
(defun log-edit-changelog-entries (file)
@@ -798,7 +905,7 @@ Return non-nil if it is."
The return value looks like this:
(LOGBUFFER (ENTRYSTART ENTRYEND) ...)
where LOGBUFFER is the name of the ChangeLog buffer, and each
-\(ENTRYSTART . ENTRYEND\) pair is a buffer region."
+\(ENTRYSTART . ENTRYEND) pair is a buffer region."
(let ((changelog-file-name
(let ((default-directory
(file-name-directory (expand-file-name file)))
@@ -815,44 +922,52 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
;; that memoizing which is undesired here.
(setq change-log-default-name nil)
(find-change-log)))))
- (with-current-buffer (find-file-noselect changelog-file-name)
- (unless (eq major-mode 'change-log-mode) (change-log-mode))
- (goto-char (point-min))
- (if (looking-at "\\s-*\n") (goto-char (match-end 0)))
- (if (not (log-edit-changelog-ours-p))
- (list (current-buffer))
- (save-restriction
- (log-edit-narrow-changelog)
- (goto-char (point-min))
-
- ;; Search for the name of FILE relative to the ChangeLog. If that
- ;; doesn't occur anywhere, they're not using full relative
- ;; filenames in the ChangeLog, so just look for FILE; we'll accept
- ;; some false positives.
- (let ((pattern (file-relative-name
- file (file-name-directory changelog-file-name))))
- (if (or (string= pattern "")
- (not (save-excursion
- (search-forward pattern nil t))))
- (setq pattern (file-name-nondirectory file)))
-
- (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)"
- (regexp-quote pattern)
- "\\($\\|[^[:alnum:]]\\)"))
-
- (let (texts
- (pos (point)))
- (while (and (not (eobp)) (re-search-forward pattern nil t))
- (let ((entry (log-edit-changelog-entry)))
- (if (< (elt entry 1) (max (1+ pos) (point)))
- ;; This is not relevant, actually.
- nil
- (push entry texts))
- ;; Make sure we make progress.
- (setq pos (max (1+ pos) (elt entry 1)))
- (goto-char pos)))
-
- (cons (current-buffer) texts))))))))
+ (when (or (find-buffer-visiting changelog-file-name)
+ (file-exists-p changelog-file-name))
+ (with-current-buffer (find-file-noselect changelog-file-name)
+ (unless (eq major-mode 'change-log-mode) (change-log-mode))
+ (goto-char (point-min))
+ (if (looking-at "\\s-*\n") (goto-char (match-end 0)))
+ (if (not (log-edit-changelog-ours-p))
+ (list (current-buffer))
+ (save-restriction
+ (log-edit-narrow-changelog)
+ (goto-char (point-min))
+
+ (let ((pattern (log-edit-changelog--pattern file
+ changelog-file-name)))
+ (let (texts
+ (pos (point)))
+ (while (and (not (eobp)) (re-search-forward pattern nil t))
+ (let ((entry (log-edit-changelog-entry)))
+ (if (< (elt entry 1) (max (1+ pos) (point)))
+ ;; This is not relevant, actually.
+ nil
+ (push entry texts))
+ ;; Make sure we make progress.
+ (setq pos (max (1+ pos) (elt entry 1)))
+ (goto-char pos)))
+
+ (cons (current-buffer) texts)))))))))
+
+(defun log-edit-changelog--pattern (file changelog-file-name)
+ (if (eq (aref file (1- (length file))) ?/)
+ ;; Match any files inside this directory.
+ (concat "^\t\\* " (unless (string= file "./") file))
+ ;; Search for the name of FILE relative to the ChangeLog. If that
+ ;; doesn't occur anywhere, they're not using full relative
+ ;; filenames in the ChangeLog, so just look for FILE; we'll accept
+ ;; some false positives.
+ (let ((pattern (file-relative-name
+ file (file-name-directory changelog-file-name))))
+ ;; FIXME: When can the above return an empty string?
+ (if (or (string= pattern "")
+ (not (save-excursion
+ (search-forward pattern nil t))))
+ (setq pattern (file-name-nondirectory file)))
+ (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)"
+ (regexp-quote pattern)
+ "\\($\\|[^[:alnum:]]\\)")))))
(defun log-edit-changelog-insert-entries (buffer beg end &rest files)
"Insert the text from BUFFER between BEG and END.
@@ -865,6 +980,8 @@ Rename relative filenames in the ChangeLog entry as FILES."
(setq bound (point-marker))
(when log-name
(dolist (f files)
+ ;; FIXME: f can be a directory, a (possibly indirect) parent
+ ;; of the ChangeLog file.
(save-excursion
(goto-char opoint)
(when (re-search-forward
@@ -900,14 +1017,21 @@ Rename relative filenames in the ChangeLog entry as FILES."
(apply 'log-edit-changelog-insert-entries
(append (car log-entry) (cdr log-entry)))
(insert "\n"))
+ ;; No newline after the last entry.
+ (when log-entries
+ (delete-char -1))
log-edit-author))
(defun log-edit-toggle-header (header value)
"Toggle a boolean-type header in the current buffer.
-If the value of HEADER is VALUE, clear it. Otherwise, add the
-header if it's not present and set it to VALUE. Then make sure
-there is an empty line after the headers. Return t if toggled
-on, otherwise nil."
+See `log-edit-set-header' for details."
+ (log-edit-set-header header value t))
+
+(defun log-edit-set-header (header value &optional toggle)
+ "Set the value of HEADER to VALUE in the current buffer.
+If TOGGLE is non-nil, and the value of HEADER already is VALUE,
+clear it. Make sure there is an empty line after the headers.
+Return t if toggled on (or TOGGLE is nil), otherwise nil."
(let ((val t)
(line (concat header ": " value "\n")))
(save-excursion
@@ -918,7 +1042,7 @@ on, otherwise nil."
(if (re-search-forward (concat "^" header ":"
log-edit-header-contents-regexp)
nil t)
- (if (setq val (not (string= (match-string 1) value)))
+ (if (setq val (not (and toggle (string= (match-string 1) value))))
(replace-match line t t)
(replace-match "" t t nil 1))
(insert line)))
@@ -966,7 +1090,7 @@ line of MSG."
(goto-char (point-min))
(when (looking-at "\\([ \t]*\n\\)+")
(delete-region (match-beginning 0) (match-end 0)))
- (if summary (insert summary "\n"))
+ (if summary (insert summary "\n\n"))
(cons (buffer-string) res))))
(provide 'log-edit)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index be985866532..f1b57109e33 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -1,6 +1,6 @@
;;; log-view.el --- Major mode for browsing revision log histories -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: tools, vc
@@ -404,7 +404,9 @@ This calls `log-view-expanded-log-entry-function' to do the work."
(unless (and pos (log-view-inside-comment-p pos))
(error "Broken markup in `log-view-toggle-entry-display'"))
(delete-region pos
- (next-single-property-change pos 'log-view-comment))
+ (or
+ (next-single-property-change pos 'log-view-comment)
+ (point-max)))
(put-text-property beg (1+ beg) 'log-view-entry-expanded nil)
(if (< opoint pos)
(goto-char opoint)))
@@ -429,18 +431,31 @@ to the beginning of the ARGth following entry.
This is Log View mode's default `beginning-of-defun-function'.
It assumes that a log entry starts with a line matching
`log-view-message-re'."
- (if (or (null arg) (zerop arg))
- (setq arg 1))
+ (when (null arg) (setf arg 1))
(if (< arg 0)
- (dotimes (_n (- arg))
- (log-view-end-of-defun))
- (catch 'beginning-of-buffer
- (dotimes (_n arg)
- (or (log-view-current-entry nil t)
- (throw 'beginning-of-buffer nil)))
- (point))))
-
-(defun log-view-end-of-defun ()
+ ;; In log view, the end of one defun is the beginning of the
+ ;; next, so punting to log-view-end-of-defun is safe in this
+ ;; context.
+ (log-view-end-of-defun (- arg))
+ (let ((found t))
+ (while (> arg 0)
+ (setf arg (1- arg))
+ (let ((cur-start (log-view-current-entry)))
+ (setf found
+ (cond ((null cur-start)
+ (goto-char (point-min))
+ nil)
+ ((>= (car cur-start) (point))
+ (unless (bobp)
+ (forward-line -1)
+ (setf arg (1+ arg)))
+ nil)
+ (t
+ (goto-char (car cur-start))
+ t)))))
+ found)))
+
+(defun log-view-end-of-defun-1 ()
"Move forward to the next Log View entry."
(let ((looping t))
(if (looking-at log-view-message-re)
@@ -453,9 +468,23 @@ It assumes that a log entry starts with a line matching
(goto-char (match-beginning 0))))
;; Don't advance past the end buttons inserted by
;; `vc-print-log-setup-buttons'.
- ((looking-back "Show 2X entries Show unlimited entries")
+ ((looking-back "Show 2X entries Show unlimited entries"
+ (line-beginning-position))
(setq looping nil)
- (forward-line -1))))))
+ (forward-line -1))
+ ;; There are no buttons if we've turned on unlimited entries.
+ ((eobp)
+ (setq looping nil))))))
+
+(defun log-view-end-of-defun (&optional arg)
+ "Move forward to the next Log View entry.
+Works like `end-of-defun'."
+ (when (null arg) (setf arg 1))
+ (if (< arg 0)
+ (log-view-beginning-of-defun (- arg))
+ (dotimes (_n arg)
+ (log-view-end-of-defun-1)
+ t)))
(defvar cvs-minor-current-files)
(defvar cvs-branch-prefix)
@@ -511,7 +540,8 @@ If called interactively, visit the version at point."
(cond ((eq backend 'SVN)
(forward-line -1)))
(setq en (point))
- (log-view-beginning-of-defun)
+ (or (log-view-current-entry nil t)
+ (throw 'beginning-of-buffer nil))
(cond ((memq backend '(SCCS RCS CVS MCVS SVN))
(forward-line 2))
((eq backend 'Hg)
@@ -577,13 +607,12 @@ considered file(s)."
(interactive
(list (if (use-region-p) (region-beginning) (point))
(if (use-region-p) (region-end) (point))))
- (log-view-diff-common beg end t))
+ (when (eq (vc-call-backend log-view-vc-backend 'revision-granularity) 'file)
+ (error "The %s backend does not support changeset diffs" log-view-vc-backend))
+ (let ((default-directory (vc-root-dir)))
+ (log-view-diff-common beg end t)))
(defun log-view-diff-common (beg end &optional whole-changeset)
- (when (and whole-changeset
- (eq (vc-call-backend log-view-vc-backend 'revision-granularity)
- 'file))
- (error "The %s backend does not support changeset diffs" log-view-vc-backend))
(let ((to (log-view-current-tag beg))
(fr (log-view-current-tag end)))
(when (string-equal fr to)
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index 9dc378e4e27..61eac52845c 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -1,6 +1,6 @@
;;; pcvs-defs.el --- variable definitions for PCL-CVS
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -92,17 +92,17 @@ There is no need to set this if $CVSROOT is set to a correct value.")
(defcustom cvs-auto-remove-handled nil
"If up-to-date files should be acknowledged automatically.
-If T, they will be removed from the *cvs* buffer after every command.
-If DELAYED, they will be removed from the *cvs* buffer before every command.
-If STATUS, they will only be removed after a `cvs-mode-status' command.
+If t, they will be removed from the *cvs* buffer after every command.
+If `delayed', they will be removed from the *cvs* buffer before every command.
+If `status', they will only be removed after a `cvs-mode-status' command.
Else, they will never be automatically removed from the *cvs* buffer."
:group 'pcl-cvs
:type '(choice (const nil) (const status) (const delayed) (const t)))
(defcustom cvs-auto-remove-directories 'handled
- "If ALL, directory entries will never be shown.
-If HANDLED, only non-handled directories will be shown.
-If EMPTY, only non-empty directories will be shown."
+ "If `all', directory entries will never be shown.
+If `handled', only non-handled directories will be shown.
+If `empty', only non-empty directories will be shown."
:group 'pcl-cvs
:type '(choice (const :tag "No" nil) (const all) (const handled) (const empty)))
@@ -129,7 +129,7 @@ useful to be able to tag a single file. The normal way to do that is to use
Normally they run on the files that are marked (with `cvs-mode-mark'),
or the file under the cursor if no files are marked. If this variable
is set to a non-nil value they will by default run on the file on the
-current line. See also `cvs-invert-ignore-marks'"
+current line. See also `cvs-invert-ignore-marks'."
:group 'pcl-cvs
:type '(boolean))
@@ -235,7 +235,7 @@ Output from cvs is placed here for asynchronous commands.")
(if (fboundp 'ediff)
'(cvs-ediff-diff . cvs-ediff-merge)
'(cvs-emerge-diff . cvs-emerge-merge))
- "Pair of functions to be used for resp. diff'ing and merg'ing interactively."
+ "Pair of functions to be used for resp. diff'ing and merg'ing interactively."
:group 'pcl-cvs
:type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge))
(const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge))))
@@ -245,23 +245,16 @@ Output from cvs is placed here for asynchronous commands.")
;;;;
-;;;; Internal variables, used in the process buffer.
-;;;;
-
-(defvar cvs-postprocess nil
- "(Buffer local) what to do once the process exits.")
-
-;;;;
;;;; Internal variables for the *cvs* buffer.
;;;;
(defcustom cvs-reuse-cvs-buffer 'subdir
"When to reuse an existing cvs buffer.
Alternatives are:
- CURRENT: just reuse the current buffer if it is a cvs buffer
- SAMEDIR: reuse any cvs buffer displaying the same directory
- SUBDIR: or reuse any cvs buffer displaying any sub- or super- directory
- ALWAYS: reuse any cvs buffer."
+ `current': just reuse the current buffer if it is a cvs buffer
+ `samedir': reuse any cvs buffer displaying the same directory
+ `subdir': or reuse any cvs buffer displaying any sub- or super- directory
+ `always': reuse any cvs buffer."
:group 'pcl-cvs
:type '(choice (const always) (const subdir) (const samedir) (const current)))
@@ -431,6 +424,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
(defcustom cvs-minor-mode-prefix "\C-xc"
"Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
+ :type 'string
:group 'pcl-cvs)
(easy-mmode-defmap cvs-minor-mode-map
@@ -494,16 +488,16 @@ It is expected to call the function.")
t)
"Whether cvs commands should be executed a directory at a time.
If a list, specifies for which commands the single-dir mode should be used.
-If T, single-dir mode should be used for all operations.
+If t, single-dir mode should be used for all operations.
CVS versions before 1.10 did not allow passing them arguments in different
-directories, so pcl-cvs checks what version you're using to determine
+directories, so PCL-CVS checks what version you're using to determine
whether to use the new feature or not.
Sadly, even with a new cvs executable, if you connect to an older cvs server
\(typically a cvs-1.9 on the server), the old restriction applies. In such
-a case the sanity check made by pcl-cvs fails and you will have to manually
+a case the sanity check made by PCL-CVS fails and you will have to manually
set this variable to t (until the cvs server is upgraded).
-When the above problem occurs, pcl-cvs should (hopefully) catch cvs' error
+When the above problem occurs, PCL-CVS should (hopefully) catch cvs' error
message and replace it with a message telling you to change this variable.")
;;
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 2719a7fb54a..4af1e73a358 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -1,6 +1,6 @@
;;; pcvs-info.el --- internal representation of a fileinfo entry
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -142,7 +142,7 @@ to confuse some users sometimes."
(easy-mmode-defmap cvs-status-map
'(([(mouse-2)] . cvs-mode-toggle-mark))
- "Local keymap for text properties of status")
+ "Local keymap for text properties of status.")
;; Constructor:
@@ -301,8 +301,8 @@ to confuse some users sometimes."
(DEAD )
(MESSAGE))
"Fileinfo state descriptions for pcl-cvs.
-This is an assoc list. Each element consists of (STATE . FUNS)
-- STATE (described in `cvs-create-fileinfo') is the key
+This is an assoc list. Each element consists of (STATE . FUNS):
+- STATE (described in `cvs-create-fileinfo') is the key.
- FUNS is the list of applicable operations.
The first one (if any) should be the \"default\" action.
Most of the actions have the obvious meaning.
@@ -332,7 +332,7 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
(defun cvs-fileinfo-pp (fileinfo)
"Pretty print FILEINFO. Insert a printed representation in current buffer.
-For use by the cookie package."
+For use by the ewoc package."
(cvs-check-fileinfo fileinfo)
(let ((type (cvs-fileinfo->type fileinfo))
(subtype (cvs-fileinfo->subtype fileinfo)))
@@ -416,7 +416,7 @@ fileinfo will appear first, followed by all files (alphabetically)."
(defun cvs-fileinfo-from-entries (dir &optional all)
"List of fileinfos for DIR, extracted from CVS/Entries.
-Unless ALL is optional, returns only the files that are not up-to-date.
+Unless ALL is non-nil, returns only the files that are not up-to-date.
DIR can also be a file."
(let* ((singlefile
(cond
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index c267f32b2d7..5dcb4c55b01 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -1,6 +1,6 @@
;;; pcvs-parse.el --- the CVS output parser
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -165,13 +165,13 @@ Match RE and if successful, execute MATCHES."
TYPE can either be a type symbol or a cons of the form (TYPE . SUBTYPE).
PATH is the filename.
DIRECTORY influences the way PATH is interpreted:
-- if it's a string, it denotes the directory in which PATH (which should then be
+- if a string, it denotes the directory in which PATH (which should then be
a plain file name with no directory component) resides.
- if it's nil, the PATH should not be trusted: if it has a directory
component, use it, else, assume it is relative to the current directory.
-- else, the PATH should be trusted to be relative to the root
- directory (i.e. if there is no directory component, it means the file
- is inside the main directory).
+- else, the PATH should be trusted to be relative to the root directory
+ (i.e. if there is no directory component, it means the file is inside
+ the main directory).
The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(let ((dir directory)
(file path))
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index 2868bb98b29..d3cc3c5da33 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -1,6 +1,6 @@
;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: pcl-cvs
@@ -253,7 +253,7 @@ arguments. If ARGS is not a list, no argument will be passed."
Optional argument DESC will be used for the prompt.
If ARG (or a prefix argument) is nil, just use the 0th default.
If it is a non-negative integer, use the corresponding default.
-If it is a negative integer query for a new value of the corresponding
+If it is a negative integer, query for a new value of the corresponding
default and return that new value.
If it is \\[universal-argument], just query and return a value without
altering the defaults.
@@ -286,7 +286,7 @@ If it is \\[universal-argument] \\[universal-argument], behave just
(nth numarg defaults))))
(defsubst cvs-flags-set (sym index value)
- "Set SYM's INDEX'th setting to VALUE."
+ "Set SYM's INDEXth setting to VALUE."
(setf (nth index (cvs-flags-defaults (symbol-value sym))) value))
;;;;
@@ -323,7 +323,7 @@ See `cvs-prefix-set' for further description of the behavior."))
"Set the cvs-prefix contained in SYM.
If ARG is between 0 and 9, it selects the corresponding default.
If ARG is negative (or \\[universal-argument] which corresponds to negative 0),
- it queries the user and sets the -ARG'th default.
+ it queries the user and sets the -ARGth default.
If ARG is greater than 9 (or \\[universal-argument] \\[universal-argument]),
the (ARG mod 10)'th prefix is made persistent.
If ARG is nil toggle the PREFIX's value between its 0th default and nil
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index fb91185662a..3fdee100d44 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -1,6 +1,6 @@
-;;; pcvs.el --- a front-end to CVS
+;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*-
-;; Copyright (C) 1991-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;; (Per Cederqvist) ceder@lysator.liu.se
@@ -341,15 +341,15 @@ the \\[cvs-mode-map] prefix."
(defun cvs-temp-buffer (&optional cmd normal nosetup)
"Create a temporary buffer to run CMD in.
If CMD is a string, use it to lookup `cvs-buffer-name-alist' to find
-the buffer name to be used and its `major-mode'.
+the buffer name to be used and its major mode.
The selected window will not be changed. The new buffer will not maintain undo
information and will be read-only unless NORMAL is non-nil. It will be emptied
-\(unless NOSETUP is non-nil\) and its `default-directory' will be inherited
+\(unless NOSETUP is non-nil) and its `default-directory' will be inherited
from the current buffer."
(let* ((cvs-buf (current-buffer))
(info (cdr (assoc cmd cvs-buffer-name-alist)))
- (name (eval (nth 0 info)))
+ (name (eval (nth 0 info) `((cmd . ,cmd))))
(mode (nth 1 info))
(dir default-directory)
(buf (cond
@@ -359,9 +359,10 @@ from the current buffer."
(t
(set (make-local-variable 'cvs-temp-buffer)
(cvs-get-buffer-create
- (eval cvs-temp-buffer-name) 'noreuse))))))
+ (eval cvs-temp-buffer-name `((dir . ,dir)))
+ 'noreuse))))))
- ;; handle the potential pre-existing process
+ ;; Handle the potential pre-existing process.
(let ((proc (get-buffer-process buf)))
(when (and (not normal) (processp proc)
(memq (process-status proc) '(run stop)))
@@ -416,7 +417,7 @@ from the current buffer."
If non-nil, NEW means to create a new buffer no matter what."
;; the real cvs-buffer creation
(setq dir (cvs-expand-dir-name dir))
- (let* ((buffer-name (eval cvs-buffer-name))
+ (let* ((buffer-name (eval cvs-buffer-name `((dir . ,dir))))
(buffer
(or (and (not new)
(eq cvs-reuse-cvs-buffer 'current)
@@ -569,9 +570,9 @@ If non-nil, NEW means to create a new buffer no matter what."
process 'cvs-postprocess
(if (null rest)
;; this is the last invocation
- postprocess
+ postprocess
;; else, we have to register ourselves to be rerun on the rest
- `(cvs-run-process ',args ',rest ',postprocess ',single-dir)))
+ (lambda () (cvs-run-process args rest postprocess single-dir))))
(set-process-sentinel process 'cvs-sentinel)
(set-process-filter process 'cvs-update-filter)
(set-marker (process-mark process) (point-max))
@@ -648,7 +649,7 @@ If non-nil, NEW means to create a new buffer no matter what."
done))))
-(defun cvs-sentinel (proc msg)
+(defun cvs-sentinel (proc _msg)
"Sentinel for the cvs update process.
This is responsible for parsing the output from the cvs update when
it is finished."
@@ -675,7 +676,8 @@ it is finished."
(error "cvs' process buffer was killed")
(with-current-buffer procbuf
;; Do the postprocessing like parsing and such.
- (save-excursion (eval cvs-postproc)))))))
+ (save-excursion
+ (funcall cvs-postproc)))))))
;; Check whether something is left.
(when (and procbuf (not (get-buffer-process procbuf)))
(with-current-buffer procbuf
@@ -748,14 +750,15 @@ FUN can be either a symbol (i.e. STYLE is nil) or a cons (FUN . STYLE).
ARGS and DOCSTRING are the normal argument list.
INTERACT is the interactive specification or nil for non-commands.
-STYLE can be either SIMPLE, NOARGS or DOUBLE. It's an error for it
+STYLE can be either `SIMPLE', `NOARGS' or `DOUBLE'. It's an error for it
to have any other value, unless other details of the function make it
clear what alternative to use.
-- SIMPLE will get all the interactive arguments from the original buffer.
-- NOARGS will get all the arguments from the *cvs* buffer and will
+- `SIMPLE' will get all the interactive arguments from the original buffer.
+- `NOARGS' will get all the arguments from the *cvs* buffer and will
always behave as if called interactively.
-- DOUBLE is the generic case."
- (declare (debug (&define sexp lambda-list stringp ("interactive" interactive) def-body))
+- `DOUBLE' is the generic case."
+ (declare (debug (&define sexp lambda-list stringp
+ ("interactive" interactive) def-body))
(doc-string 3))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
@@ -907,7 +910,7 @@ RM-MSGS if non-nil means remove messages."
(setq rerun t)))))
(defun cvs-get-cvsroot ()
- "Gets the CVSROOT for DIR."
+ "Get the CVSROOT for DIR."
(let ((cvs-cvsroot-file (expand-file-name "Root" "CVS")))
(or (cvs-file-to-string cvs-cvsroot-file t)
cvs-cvsroot
@@ -937,7 +940,7 @@ This usually doesn't really work but is a handy initval in a prompt."
;;;###autoload
(defun cvs-checkout (modules dir flags &optional root)
- "Run a 'cvs checkout MODULES' in DIR.
+ "Run a `cvs checkout MODULES' in DIR.
Feed the output to a *cvs* buffer, display it in the current window,
and run `cvs-mode' on it.
@@ -961,14 +964,14 @@ With a prefix argument, prompt for cvs FLAGS to use."
:noexist t)))
(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
- "Run cvs checkout against the current branch.
+ "Run `cvs checkout' against the current branch.
The files are stored to DIR."
(interactive
(let* ((branch (cvs-prefix-get 'cvs-branch-prefix))
- (prompt (format "CVS Checkout Directory for `%s%s': "
- (cvs-get-module)
- (if branch (format " (branch: %s)" branch)
- ""))))
+ (prompt (format-message "CVS Checkout Directory for `%s%s': "
+ (cvs-get-module)
+ (if branch (format " (branch: %s)" branch)
+ ""))))
(list (read-directory-name prompt nil default-directory nil))))
(let ((modules (split-string-and-unquote (cvs-get-module)))
(flags (cvs-add-branch-prefix
@@ -981,7 +984,7 @@ The files are stored to DIR."
;;;;
(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
- (&optional ignore-auto noconfirm)
+ (&optional _ignore-auto _noconfirm)
"Rerun `cvs-examine' on the current directory with the default flags."
(interactive)
(cvs-examine default-directory t))
@@ -995,7 +998,7 @@ If in a *cvs* buffer, don't prompt unless a prefix argument is given."
(read-directory-name prompt nil default-directory nil)))
;;;###autoload
-(defun cvs-quickdir (dir &optional flags noshow)
+(defun cvs-quickdir (dir &optional _flags noshow)
"Open a *cvs* buffer on DIR without running cvs.
With a prefix argument, prompt for a directory to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
@@ -1079,7 +1082,7 @@ Optional argument NOSHOW if non-nil means not to display the buffer."
:noshow noshow :dont-change-disc t))
(defun cvs-update-filter (proc string)
- "Filter function for pcl-cvs.
+ "Filter function for PCL-CVS.
This function gets the output that CVS sends to stdout. It inserts
the STRING into (process-buffer PROC) but it also checks if CVS is waiting
for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
@@ -1226,7 +1229,7 @@ If a prefix argument is given, move by that many lines."
(defun-cvs-mode cvs-mode-mark (&optional arg)
"Mark the fileinfo on the current line.
If the fileinfo is a directory, all the contents of that directory are
-marked instead. A directory can never be marked."
+marked instead. A directory can never be marked."
(interactive)
(let* ((tin (ewoc-locate cvs-cookies))
(fi (ewoc-data tin)))
@@ -1394,7 +1397,7 @@ an empty list if it doesn't point to a file at all."
(nreverse fis)))
(cl-defun cvs-mode-marked (filter &optional cmd
- &key read-only one file noquery)
+ &key read-only one file noquery)
"Get the list of marked FIS.
CMD is used to determine whether to use the marks or not.
Only files for which FILTER is applicable are returned.
@@ -1465,7 +1468,7 @@ The POSTPROC specified there (typically `log-edit') is then called,
(set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
(run-hooks 'cvs-mode-commit-hook)))
-(defun cvs-commit-minor-wrap (buf f)
+(defun cvs-commit-minor-wrap (_buf f)
(let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
(funcall f)))
@@ -1598,24 +1601,25 @@ With prefix argument, prompt for cvs flags."
(interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags")))
(let ((fis (cvs-mode-marked 'add))
(needdesc nil) (dirs nil))
- ;; find directories and look for fis needing a description
+ ;; Find directories and look for fis needing a description.
(dolist (fi fis)
(cond
((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs))
((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t))))
- ;; prompt for description if necessary
+ ;; Prompt for description if necessary.
(let* ((msg (if (and needdesc
(or current-prefix-arg (not cvs-add-default-message)))
(read-from-minibuffer "Enter description: ")
(or cvs-add-default-message "")))
(flags `("-m" ,msg ,@flags))
(postproc
- ;; setup postprocessing for the directory entries
+ ;; Setup postprocessing for the directory entries.
(when dirs
- `((cvs-run-process (list "-n" "update")
- ',dirs
- '(cvs-parse-process t))
- (cvs-mark-fis-dead ',dirs)))))
+ (lambda ()
+ (cvs-run-process (list "-n" "update")
+ dirs
+ (lambda () (cvs-parse-process t)))
+ (cvs-mark-fis-dead dirs)))))
(cvs-mode-run "add" flags fis :postproc postproc))))
(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
@@ -1632,25 +1636,25 @@ See also `cvs-diff-ignore-marks'."
(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
"Diff the selected files against the head of the current branch.
-See ``cvs-mode-diff'' for more info."
+See `cvs-mode-diff' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons "-rHEAD" flags)))
(defun-cvs-mode (cvs-mode-diff-repository . SIMPLE) (flags)
"Diff the files for changes in the repository since last co/update/commit.
-See ``cvs-mode-diff'' for more info."
+See `cvs-mode-diff' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons "-rBASE" (cons "-rHEAD" flags))))
(defun-cvs-mode (cvs-mode-diff-yesterday . SIMPLE) (flags)
"Diff the selected files against yesterday's head of the current branch.
-See ``cvs-mode-diff'' for more info."
+See `cvs-mode-diff' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons "-Dyesterday" flags)))
(defun-cvs-mode (cvs-mode-diff-vendor . SIMPLE) (flags)
"Diff the selected files against the head of the vendor branch.
-See ``cvs-mode-diff'' for more info."
+See `cvs-mode-diff' for more info."
(interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
(cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))
@@ -1666,10 +1670,7 @@ or \"Conflict\" in the *cvs* buffer."
(fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
(unless (consp fis)
(error "No files with a backup file selected!"))
- ;; let's extract some info into the environment for `buffer-name'
- (let* ((dir (cvs-fileinfo->dir (car fis)))
- (file (cvs-fileinfo->file (car fis))))
- (set-buffer (cvs-temp-buffer "diff")))
+ (set-buffer (cvs-temp-buffer "diff"))
(message "cvs diff backup...")
(cvs-execute-single-file-list fis 'cvs-diff-backup-extractor
cvs-diff-program flags))
@@ -1851,15 +1852,16 @@ Signal an error if there is no backup file."
ret)))
(cl-defun cvs-mode-run (cmd flags fis
- &key (buf (cvs-temp-buffer))
- dont-change-disc cvsargs postproc)
+ &key (buf (cvs-temp-buffer))
+ dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS FIS'.
BUF is the buffer to be used for cvs' output.
DONT-CHANGE-DISC non-nil indicates that the command will not change the
contents of files. This is only used by the parser.
-POSTPROC is a list of expressions to be evaluated at the very end (after
- parsing if applicable). It will be prepended with `progn' if necessary."
+POSTPROC is a function of no argument to be evaluated at the very end (after
+ parsing if applicable)."
+ (unless postproc (setq postproc #'ignore))
(let ((def-dir default-directory))
;; Save the relevant buffers
(save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))
@@ -1878,14 +1880,17 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
(cvs-cleanup-collection cvs-cookies ;cleanup remaining messages
(eq cvs-auto-remove-handled 'delayed) nil t)
(when (fboundp after-mode)
- (setq postproc (append postproc `((,after-mode)))))
+ (setq postproc (let ((pp postproc))
+ (lambda () (funcall pp) (funcall after-mode)))))
(when parse
(let ((old-fis
(when (member cmd '("status" "update")) ;FIXME: Yuck!!
;; absence of `cvs update' output has a specific meaning.
- (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))))
- (push `(cvs-parse-process ',dont-change-disc nil ',old-fis) postproc)))
- (setq postproc (if (cdr postproc) (cons 'progn postproc) (car postproc)))
+ (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))
+ (pp postproc))
+ (setq postproc (lambda ()
+ (cvs-parse-process dont-change-disc nil old-fis)
+ (funcall pp)))))
(with-current-buffer buf
(let ((inhibit-read-only t)) (erase-buffer))
(message "Running cvs %s ..." cmd)
@@ -1893,13 +1898,13 @@ POSTPROC is a list of expressions to be evaluated at the very end (after
(cl-defun cvs-mode-do (cmd flags filter
- &key show dont-change-disc cvsargs postproc)
+ &key show dont-change-disc cvsargs postproc)
"Generic cvs-mode-<foo> function.
Executes `cvs CVSARGS CMD FLAGS' on the selected files.
FILTER is passed to `cvs-applicable-p' to only apply the command to
files for which it makes sense.
SHOW indicates that CMD should be not be run in the default temp buffer and
- should be shown to the user. The buffer and mode to be used is determined
+ should be shown to the user. The buffer and mode to be used are determined
by `cvs-buffer-name-alist'.
DONT-CHANGE-DISC non-nil indicates that the command will not change the
contents of files. This is only used by the parser."
@@ -1915,8 +1920,11 @@ With prefix argument, prompt for cvs flags."
(interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags")))
(cvs-mode-do "status" flags nil :dont-change-disc t :show t
:postproc (when (eq cvs-auto-remove-handled 'status)
- `((with-current-buffer ,(current-buffer)
- (cvs-mode-remove-handled))))))
+ (let ((buf (current-buffer)))
+ (lambda () (with-current-buffer buf
+ (cvs-mode-remove-handled)))))))
+
+(autoload 'cvs-status-cvstrees "cvs-status")
(defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags)
"Call cvstree using the file under the point as a keyfile."
@@ -1924,7 +1932,7 @@ With prefix argument, prompt for cvs flags."
(cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status")
:buf (cvs-temp-buffer "tree")
:dont-change-disc t
- :postproc '((cvs-status-cvstrees))))
+ :postproc #'cvs-status-cvstrees))
;; cvs log
@@ -1958,18 +1966,19 @@ With a prefix argument, prompt for cvs flags."
(cvs-mode-do "update" flags nil :cvsargs '("-n") :dont-change-disc t))
-(defun-cvs-mode cvs-mode-ignore (&optional pattern)
+(defun-cvs-mode cvs-mode-ignore ()
"Arrange so that CVS ignores the selected files.
This command ignores files that are not flagged as `Unknown'."
(interactive)
(dolist (fi (cvs-mode-marked 'ignore))
- (cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi)
+ (vc-cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi)
(eq (cvs-fileinfo->subtype fi) 'NEW-DIR))
(setf (cvs-fileinfo->type fi) 'DEAD))
(cvs-cleanup-collection cvs-cookies nil nil nil))
-(declare-function vc-editable-p "vc" (file))
-(declare-function vc-checkout "vc" (file &optional writable rev))
+(define-obsolete-function-alias 'cvs-append-to-ignore 'vc-cvs-append-to-ignore
+ "24.4")
+
(defun cvs-mode-find-file-other-window (e)
"Select a buffer containing the file in another window."
@@ -1990,7 +1999,7 @@ This command ignores files that are not flagged as `Unknown'."
(defun cvs-mode-view-file-other-window (e)
- "View the file."
+ "View the file in another window."
(interactive (list last-input-event))
(cvs-mode-find-file e t t))
@@ -2065,8 +2074,10 @@ The file is removed and `cvs update FILE' is run."
(cvs-mode-run "update" flags fis-other
:postproc
(when fis-removed
- `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "add" nil ',fis-removed)))))))))
+ (let ((buf (current-buffer)))
+ (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "add" nil fis-removed))))))))))
(defun-cvs-mode (cvs-mode-revert-to-rev . NOARGS) (rev)
@@ -2077,11 +2088,14 @@ The file is removed and `cvs update FILE' is run."
(cvs-flags-query 'cvs-idiff-version)))))
(let* ((fis (cvs-mode-marked 'revert "revert" :file t))
(tag (concat "tmp_pcl_tag_" (make-temp-name "")))
- (untag `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "tag" (list "-d" ',tag) ',fis))))
- (update `((with-current-buffer ,(current-buffer)
- (cvs-mode-run "update" (list "-j" ',tag "-j" ',rev) ',fis
- :postproc ',untag)))))
+ (buf (current-buffer))
+ (untag (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "tag" (list "-d" tag) fis))))
+ (update (lambda ()
+ (with-current-buffer buf
+ (cvs-mode-run "update" (list "-j" tag "-j" rev) fis
+ :postproc untag)))))
(cvs-mode-run "tag" (list tag) fis :postproc update)))
@@ -2185,7 +2199,8 @@ to use it on individual files."
With prefix argument, prompt for cvs flags."
(interactive
(list (setq cvs-tag-name
- (cvs-query-read cvs-tag-name "Tag to delete: " cvs-qtypedesc-tag))
+ (cvs-query-read cvs-tag-name "Tag to delete: "
+ cvs-qtypedesc-tag))
(cvs-flags-query 'cvs-tag-flags "tag flags")))
(cvs-mode-do "tag" (append '("-d") flags (list tag))
(when cvs-force-dir-tag 'tag)))
@@ -2194,7 +2209,7 @@ With prefix argument, prompt for cvs flags."
;; Byte compile files.
(defun-cvs-mode cvs-mode-byte-compile-files ()
- "Run byte-compile-file on all selected files that end in '.el'."
+ "Run byte-compile-file on all selected files with '.el' extension."
(interactive)
(let ((marked (cvs-get-marked (cvs-ignore-marks-p "byte-compile"))))
(dolist (fi marked)
@@ -2203,6 +2218,7 @@ With prefix argument, prompt for cvs flags."
(byte-compile-file filename))))))
;; ChangeLog support.
+(defvar add-log-buffer-file-name-function)
(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
"Add a ChangeLog entry in the ChangeLog of the current directory."
@@ -2296,13 +2312,13 @@ this file, or a list of arguments to send to the program."
(revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)
;; `preserve-modes' avoids changing the (minor) modes. But we
;; do want to reset the mode for VC, so we do it explicitly.
- (vc-find-file-hook)
+ (vc-refresh-state)
(when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT)
(smerge-start-session))))))))
(defun cvs-change-cvsroot (newroot)
- "Change the cvsroot."
+ "Change the CVSROOT."
(interactive "DNew repository: ")
(if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
(y-or-n-p (concat "Warning: no CVSROOT found inside repository."
@@ -2328,7 +2344,7 @@ Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'."
(defcustom cvs-dired-use-hook '(4)
"Whether or not opening a CVS directory should run PCL-CVS.
A value of nil means never do it.
-ALWAYS means to always do it unless a prefix argument is given to the
+`always' means to always do it unless a prefix argument is given to the
command that prompted the opening of the directory.
Anything else means to do it only if the prefix arg is equal to this value."
:group 'pcl-cvs
@@ -2387,9 +2403,9 @@ The exact behavior is determined also by `cvs-dired-use-hook'."
(goto-char (point-min))
(looking-at ".*to add this file permanently\n\\'"))
(dolist (file (if (listp files) files (list files)))
- (insert "cvs add: scheduling file `"
- (file-name-nondirectory file)
- "' for addition\n")))
+ (insert (format-message
+ "cvs add: scheduling file `%s' for addition\n"
+ (file-name-nondirectory file)))))
;; VC never (?) does `cvs -n update' so dcd=nil
;; should probably always be the right choice.
(cvs-parse-process nil subdir))))))))
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index f61e97216a9..9f9224c226c 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1,6 +1,6 @@
;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*-
-;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc, tools, revision control, merge, diff3, cvs, conflict
@@ -57,7 +57,6 @@
(defcustom smerge-diff-buffer-name "*vc-diff*"
"Buffer name to use for displaying diffs."
- :group 'smerge
:type '(choice
(const "*vc-diff*")
(const "*cvs-diff*")
@@ -69,12 +68,10 @@
(if (listp diff-switches) diff-switches (list diff-switches)))
"A list of strings specifying switches to be passed to diff.
Used in `smerge-diff-base-mine' and related functions."
- :group 'smerge
:type '(repeat string))
(defcustom smerge-auto-leave t
"Non-nil means to leave `smerge-mode' when the last conflict is resolved."
- :group 'smerge
:type 'boolean)
(defface smerge-mine
@@ -84,8 +81,7 @@ Used in `smerge-diff-base-mine' and related functions."
:background "#553333")
(((class color))
:foreground "red"))
- "Face for your code."
- :group 'smerge)
+ "Face for your code.")
(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
(defvar smerge-mine-face 'smerge-mine)
@@ -96,8 +92,7 @@ Used in `smerge-diff-base-mine' and related functions."
:background "#335533")
(((class color))
:foreground "green"))
- "Face for the other code."
- :group 'smerge)
+ "Face for the other code.")
(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
(defvar smerge-other-face 'smerge-other)
@@ -108,8 +103,7 @@ Used in `smerge-diff-base-mine' and related functions."
:background "#888833")
(((class color))
:foreground "yellow"))
- "Face for the base code."
- :group 'smerge)
+ "Face for the base code.")
(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
(defvar smerge-base-face 'smerge-base)
@@ -118,15 +112,14 @@ Used in `smerge-diff-base-mine' and related functions."
(:background "grey85"))
(((background dark))
(:background "grey30")))
- "Face for the conflict markers."
- :group 'smerge)
+ "Face for the conflict markers.")
(define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1")
(defvar smerge-markers-face 'smerge-markers)
-(defface smerge-refined-change
+(defface smerge-refined-changed
'((t nil))
- "Face used for char-based changes shown by `smerge-refine'."
- :group 'smerge)
+ "Face used for char-based changes shown by `smerge-refine'.")
+(define-obsolete-face-alias 'smerge-refined-change 'smerge-refined-changed "24.5")
(defface smerge-refined-removed
'((default
@@ -137,7 +130,6 @@ Used in `smerge-diff-base-mine' and related functions."
:background "#aa2222")
(t :inverse-video t))
"Face used for removed characters shown by `smerge-refine'."
- :group 'smerge
:version "24.3")
(defface smerge-refined-added
@@ -149,7 +141,6 @@ Used in `smerge-diff-base-mine' and related functions."
:background "#22aa22")
(t :inverse-video t))
"Face used for added characters shown by `smerge-refine'."
- :group 'smerge
:version "24.3")
(easy-mmode-defmap smerge-basic-map
@@ -172,7 +163,6 @@ Used in `smerge-diff-base-mine' and related functions."
(defcustom smerge-command-prefix "\C-c^"
"Prefix for `smerge-mode' commands."
- :group 'smerge
:type '(choice (const :tag "ESC" "\e")
(const :tag "C-c ^" "\C-c^" )
(const :tag "none" "")
@@ -254,8 +244,8 @@ Used in `smerge-diff-base-mine' and related functions."
"Font lock patterns for `smerge-mode'.")
(defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
-(defconst smerge-end-re "^>>>>>>> .*\n")
-(defconst smerge-base-re "^||||||| .*\n")
+(defconst smerge-end-re "^>>>>>>> \\(.*\\)\n")
+(defconst smerge-base-re "^||||||| \\(.*\\)\n")
(defconst smerge-other-re "^=======\n")
(defvar smerge-conflict-style nil
@@ -1142,6 +1132,19 @@ repeating the command will highlight other two parts."
(unless smerge-use-changed-face
'((smerge . refine) (face . smerge-refined-added))))))
+(defun smerge-swap ()
+ "Swap the \"Mine\" and the \"Other\" chunks.
+Can be used before things like `smerge-keep-all' or `smerge-resolve' where the
+ordering can have some subtle influence on the result, such as preferring the
+spacing of the \"Other\" chunk."
+ (interactive)
+ (smerge-match-conflict)
+ (goto-char (match-beginning 3))
+ (let ((txt3 (delete-and-extract-region (point) (match-end 3))))
+ (insert (delete-and-extract-region (match-beginning 1) (match-end 1)))
+ (goto-char (match-beginning 1))
+ (insert txt3)))
+
(defun smerge-diff (n1 n2)
(smerge-match-conflict)
(smerge-ensure-match n1)
@@ -1193,6 +1196,14 @@ repeating the command will highlight other two parts."
(defvar ediff-quit-hook)
(declare-function ediff-cleanup-mess "ediff-util" nil)
+(defun smerge--get-marker (regexp default)
+ (save-excursion
+ (goto-char (point-min))
+ (if (and (search-forward-regexp regexp nil t)
+ (> (match-end 1) (match-beginning 1)))
+ (concat default "=" (match-string-no-properties 1))
+ default)))
+
;;;###autoload
(defun smerge-ediff (&optional name-mine name-other name-base)
"Invoke ediff to resolve the conflicts.
@@ -1203,11 +1214,17 @@ buffer names."
(mode major-mode)
;;(ediff-default-variant 'default-B)
(config (current-window-configuration))
- (filename (file-name-nondirectory buffer-file-name))
+ (filename (file-name-nondirectory (or buffer-file-name "-")))
(mine (generate-new-buffer
- (or name-mine (concat "*" filename " MINE*"))))
+ (or name-mine
+ (concat "*" filename " "
+ (smerge--get-marker smerge-begin-re "MINE")
+ "*"))))
(other (generate-new-buffer
- (or name-other (concat "*" filename " OTHER*"))))
+ (or name-other
+ (concat "*" filename " "
+ (smerge--get-marker smerge-end-re "OTHER")
+ "*"))))
base)
(with-current-buffer mine
(buffer-disable-undo)
@@ -1232,7 +1249,10 @@ buffer names."
(when base
(setq base (generate-new-buffer
- (or name-base (concat "*" filename " BASE*"))))
+ (or name-base
+ (concat "*" filename " "
+ (smerge--get-marker smerge-base-re "BASE")
+ "*"))))
(with-current-buffer base
(buffer-disable-undo)
(insert-buffer-substring buf)
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 8af488789de..ab3161e11e6 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -1,9 +1,9 @@
-;;; vc-annotate.el --- VC Annotate Support
+;;; vc-annotate.el --- VC Annotate Support -*- lexical-binding: t -*-
-;; Copyright (C) 1997-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: Martin Lorentzson <emwson@emw.ericsson.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; Package: vc
@@ -40,6 +40,29 @@
:value "20.5"))
:group 'vc)
+(defcustom vc-annotate-background-mode
+ (not (or (eq (or frame-background-mode
+ (frame-parameter nil 'background-mode))
+ 'dark)
+ (and (tty-display-color-p) (<= (display-color-cells) 8))))
+ "Non-nil means `vc-annotate-color-map' is applied to the background.
+
+When non-nil, the color range from `vc-annotate-color-map' is applied
+to the background, while the foreground remains default.
+
+When nil, the color range from `vc-annotate-color-map' is applied
+to the foreground, and the color from the option `vc-annotate-background'
+is applied to the background."
+ :type 'boolean
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (when (boundp 'vc-annotate-color-map)
+ (with-demoted-errors
+ ;; Update the value of the dependent variable.
+ (custom-reevaluate-setting 'vc-annotate-color-map))))
+ :version "25.1"
+ :group 'vc)
+
(defcustom vc-annotate-color-map
(if (and (tty-display-color-p) (<= (display-color-cells) 8))
;; A custom sorted TTY colormap
@@ -71,25 +94,49 @@
(prog1
(cons date x)
(setq date (+ date delta)))) colors))
- ;; Normal colormap: hue stepped from 0-240deg, value=1., saturation=0.75
- '(( 20. . "#FF3F3F")
- ( 40. . "#FF6C3F")
- ( 60. . "#FF993F")
- ( 80. . "#FFC63F")
- (100. . "#FFF33F")
- (120. . "#DDFF3F")
- (140. . "#B0FF3F")
- (160. . "#83FF3F")
- (180. . "#56FF3F")
- (200. . "#3FFF56")
- (220. . "#3FFF83")
- (240. . "#3FFFB0")
- (260. . "#3FFFDD")
- (280. . "#3FF3FF")
- (300. . "#3FC6FF")
- (320. . "#3F99FF")
- (340. . "#3F6CFF")
- (360. . "#3F3FFF")))
+ (cond
+ ;; Normal colormap for background colors with dark foreground:
+ ;; hue stepped from 0-240deg, value=1., saturation=0.20
+ (vc-annotate-background-mode
+ '(( 20. . "#FFCCCC")
+ ( 40. . "#FFD8CC")
+ ( 60. . "#FFE4CC")
+ ( 80. . "#FFF0CC")
+ (100. . "#FFFCCC")
+ (120. . "#F6FFCC")
+ (140. . "#EAFFCC")
+ (160. . "#DEFFCC")
+ (180. . "#D2FFCC")
+ (200. . "#CCFFD2")
+ (220. . "#CCFFDE")
+ (240. . "#CCFFEA")
+ (260. . "#CCFFF6")
+ (280. . "#CCFCFF")
+ (300. . "#CCF0FF")
+ (320. . "#CCE4FF")
+ (340. . "#CCD8FF")
+ (360. . "#CCCCFF")))
+ ;; Normal colormap for foreground colors on dark background:
+ ;; hue stepped from 0-240deg, value=1., saturation=0.75
+ (t
+ '(( 20. . "#FF3F3F")
+ ( 40. . "#FF6C3F")
+ ( 60. . "#FF993F")
+ ( 80. . "#FFC63F")
+ (100. . "#FFF33F")
+ (120. . "#DDFF3F")
+ (140. . "#B0FF3F")
+ (160. . "#83FF3F")
+ (180. . "#56FF3F")
+ (200. . "#3FFF56")
+ (220. . "#3FFF83")
+ (240. . "#3FFFB0")
+ (260. . "#3FFFDD")
+ (280. . "#3FF3FF")
+ (300. . "#3FC6FF")
+ (320. . "#3F99FF")
+ (340. . "#3F6CFF")
+ (360. . "#3F3FFF")))))
"Association list of age versus color, for \\[vc-annotate].
Ages are given in units of fractional days. Default is eighteen
steps using a twenty day increment, from red to blue. For TTY
@@ -98,12 +145,12 @@ all other colors between (excluding black and white)."
:type 'alist
:group 'vc)
-(defcustom vc-annotate-very-old-color "#3F3FFF"
+(defcustom vc-annotate-very-old-color (if vc-annotate-background-mode "#CCCCFF" "#3F3FFF")
"Color for lines older than the current color range in \\[vc-annotate]."
:type 'string
:group 'vc)
-(defcustom vc-annotate-background "black"
+(defcustom vc-annotate-background nil
"Background color for \\[vc-annotate].
Default color is used if nil."
:type '(choice (const :tag "Default background" nil) (color))
@@ -128,7 +175,6 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
(define-key m "p" 'vc-annotate-prev-revision)
(define-key m "w" 'vc-annotate-working-revision)
(define-key m "v" 'vc-annotate-toggle-annotation-visibility)
- (define-key m "v" 'vc-annotate-toggle-annotation-visibility)
(define-key m "\C-m" 'vc-annotate-goto-line)
m)
"Local keymap used for VC-Annotate mode.")
@@ -206,7 +252,7 @@ cover the range from the oldest annotation to the newest."
(interactive "P")
(let ((newest 0.0)
(oldest 999999.) ;Any CVS users at the founding of Rome?
- (current (vc-annotate-convert-time (current-time)))
+ (current (vc-annotate-convert-time))
date)
(message "Redisplaying annotation...")
;; Run through this file and find the oldest and newest dates annotated.
@@ -223,7 +269,7 @@ cover the range from the oldest annotation to the newest."
(/ (- (if full newest current) oldest)
(vc-annotate-oldest-in-map vc-annotate-color-map))
(if full newest))
- (message "Redisplaying annotation...done \(%s\)"
+ (message "Redisplaying annotation...done (%s)"
(if full
(format "Spanned from %.1f to %.1f days old"
(- current oldest)
@@ -306,9 +352,9 @@ use; you may override this using the second optional arg MODE."
(vc-annotate-display-default (or vc-annotate-ratio 1.0)))
;; One of the auto-scaling modes
((eq vc-annotate-display-mode 'scale)
- (vc-exec-after `(vc-annotate-display-autoscale)))
+ (vc-run-delayed (vc-annotate-display-autoscale)))
((eq vc-annotate-display-mode 'fullscale)
- (vc-exec-after `(vc-annotate-display-autoscale t)))
+ (vc-run-delayed (vc-annotate-display-autoscale t)))
((numberp vc-annotate-display-mode) ; A fixed number of days lookback
(vc-annotate-display-default
(/ vc-annotate-display-mode
@@ -316,6 +362,8 @@ use; you may override this using the second optional arg MODE."
(t (error "No such display mode: %s"
vc-annotate-display-mode))))
+(defvar vc-sentinel-movepoint)
+
;;;###autoload
(defun vc-annotate (file rev &optional display-mode buf move-point-to vc-bk)
"Display the edit history of the current FILE using colors.
@@ -345,7 +393,9 @@ Customization variables:
`vc-annotate-menu-elements' customizes the menu elements of the
mode-specific menu. `vc-annotate-color-map' and
`vc-annotate-very-old-color' define the mapping of time to colors.
-`vc-annotate-background' specifies the background color."
+`vc-annotate-background' specifies the background color.
+`vc-annotate-background-mode' specifies whether the color map
+should be applied to the background or to the foreground."
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
@@ -397,16 +447,16 @@ mode-specific menu. `vc-annotate-color-map' and
display-mode))))
(with-current-buffer temp-buffer-name
- (vc-exec-after
- `(progn
- ;; Ideally, we'd rather not move point if the user has already
- ;; moved it elsewhere, but really point here is not the position
- ;; of the user's cursor :-(
- (when ,current-line ;(and (bobp))
- (goto-line ,current-line)
- (setq vc-sentinel-movepoint (point)))
- (unless (active-minibuffer-window)
- (message "Annotating... done")))))))
+ (vc-run-delayed
+ ;; Ideally, we'd rather not move point if the user has already
+ ;; moved it elsewhere, but really point here is not the position
+ ;; of the user's cursor :-(
+ (when current-line ;(and (bobp))
+ (goto-char (point-min))
+ (forward-line (1- current-line))
+ (setq vc-sentinel-movepoint (point)))
+ (unless (active-minibuffer-window)
+ (message "Annotating... done"))))))
(defun vc-annotate-prev-revision (prefix)
"Visit the annotation of the revision previous to this one.
@@ -532,17 +582,15 @@ the file in question, search for the log entry required and move point."
(setq prev-rev
(vc-call-backend vc-annotate-backend 'previous-revision
(if filediff fname nil) rev))
- (if (not prev-rev)
- (message "Cannot diff from any revision prior to %s" rev)
- (vc-diff-internal
- t
- ;; The value passed here should follow what
- ;; `vc-deduce-fileset' returns.
- (list vc-annotate-backend
- (if filediff
- (list fname)
- nil))
- prev-rev rev))))))
+ (vc-diff-internal
+ t
+ ;; The value passed here should follow what
+ ;; `vc-deduce-fileset' returns.
+ (list vc-annotate-backend
+ (if filediff
+ (list fname)
+ nil))
+ prev-rev rev)))))
(defun vc-annotate-show-diff-revision-at-line ()
"Visit the diff of the revision at line from its previous revision."
@@ -554,7 +602,10 @@ the file in question, search for the log entry required and move point."
(interactive)
(when (eq 'file (vc-call-backend vc-annotate-backend 'revision-granularity))
(error "The %s backend does not support changeset diffs" vc-annotate-backend))
- (vc-annotate-show-diff-revision-at-line-internal nil))
+ ;; Make sure `diff-goto-source' will be able to find all files.
+ (let ((default-directory (vc-call-backend vc-annotate-backend
+ 'root default-directory)))
+ (vc-annotate-show-diff-revision-at-line-internal nil)))
(defun vc-annotate-warp-revision (revspec &optional file)
"Annotate the revision described by REVSPEC.
@@ -613,11 +664,10 @@ nil if no such cell exists."
(setq i (+ i 1)))
tmp-cons)) ; Return the appropriate value
-(defun vc-annotate-convert-time (time)
- "Convert a time value to a floating-point number of days.
-The argument TIME is a list as returned by `current-time' or
-`encode-time', only the first two elements of that list are considered."
- (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))
+(defun vc-annotate-convert-time (&optional time)
+ "Convert optional value TIME to a floating-point number of days.
+TIME defaults to the current time."
+ (/ (float-time time) 86400))
(defun vc-annotate-difference (&optional offset)
"Return the time span in days to the next annotation.
@@ -630,9 +680,9 @@ or OFFSET if present."
(vc-call-backend vc-annotate-backend 'annotate-current-time))
next-time))))
-(defun vc-default-annotate-current-time (backend)
+(defun vc-default-annotate-current-time (_backend)
"Return the current time, encoded as fractional days."
- (vc-annotate-convert-time (current-time)))
+ (vc-annotate-convert-time))
(defvar vc-annotate-offset nil)
@@ -664,10 +714,13 @@ The annotations are relative to the current time, unless overridden by OFFSET."
;; Make the face if not done.
(face (or (intern-soft face-name)
(let ((tmp-face (make-face (intern face-name))))
- (set-face-foreground tmp-face (cdr color))
- (when vc-annotate-background
- (set-face-background tmp-face
- vc-annotate-background))
+ (cond
+ (vc-annotate-background-mode
+ (set-face-background tmp-face (cdr color)))
+ (t
+ (set-face-foreground tmp-face (cdr color))
+ (when vc-annotate-background
+ (set-face-background tmp-face vc-annotate-background))))
tmp-face)))) ; Return the face
(put-text-property start end 'face face)))))
;; Pretend to font-lock there were no matches.
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e59a7dc5214..9b2711d8146 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1,10 +1,10 @@
;;; vc-bzr.el --- VC backend for the bzr revision control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Riccardo Murri <riccardo.murri@gmail.com>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; Created: Sept 2006
;; Package: vc
@@ -34,7 +34,7 @@
;; ==========
;; When editing a symlink and *both* the symlink and its target
-;; are bzr-versioned, `vc-bzr` presently runs `bzr status` on the
+;; are bzr-versioned, `vc-bzr' presently runs `bzr status' on the
;; symlink, thereby not detecting whether the actual contents
;; (that is, the target contents) are changed.
@@ -47,6 +47,7 @@
(eval-when-compile
(require 'cl-lib)
+ (require 'vc-dispatcher)
(require 'vc-dir)) ; vc-dir-at-event
;; Clear up the cache to force vc-call to check again and discover
@@ -72,6 +73,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(repeat :tag "Argument List" :value ("") string))
:group 'vc-bzr)
+(defcustom vc-bzr-annotate-switches nil
+ "String or list of strings specifying switches for bzr annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-bzr)
+
(defcustom vc-bzr-log-switches nil
"String or list of strings specifying switches for bzr log under VC."
:type '(choice (const :tag "None" nil)
@@ -319,44 +330,60 @@ in the repository root directory of FILE."
("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.")
-;; Follows vc-bzr-(async-)command, which uses vc-do-(async-)command
-;; from vc-dispatcher.
+;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
+(declare-function vc-compilation-mode "vc-dispatcher" (backend))
-(defun vc-bzr-pull (prompt)
- "Pull changes into the current Bzr branch.
-Normally, this runs \"bzr pull\". However, if the branch is a
-bound branch, run \"bzr update\" instead. If there is no default
-location from which to pull or update, or if PROMPT is non-nil,
-prompt for the Bzr command to run."
+(defun vc-bzr--pushpull (command prompt)
+ "Run COMMAND (a string; either push or pull) on the current Bzr branch.
+If PROMPT is non-nil, prompt for the Bzr command to run."
(let* ((vc-bzr-program vc-bzr-program)
(branch-conf (vc-bzr-branch-conf default-directory))
;; Check whether the branch is bound.
(bound (assoc "bound" branch-conf))
(bound (and bound (equal "true" (downcase (cdr bound)))))
- ;; If we need to do a "bzr pull", check for a parent. If it
- ;; does not exist, bzr will need a pull location.
- (has-parent (unless bound
- (assoc "parent_location" branch-conf)))
- (command (if bound "update" "pull"))
+ (has-loc (assoc (if (equal command "push")
+ "push_location"
+ "parent_location")
+ branch-conf))
args)
+ (when bound
+ (if (equal command "push")
+ (user-error "Cannot push a bound branch")
+ (setq command "update")))
;; If necessary, prompt for the exact command.
- (when (or prompt (not (or bound has-parent)))
+ (when (or prompt (if (equal command "push")
+ (not has-loc)
+ (not (or bound has-loc))))
(setq args (split-string
(read-shell-command
- "Bzr pull command: "
- (concat vc-bzr-program " " command)
+ (format "Bzr %s command: " command)
+ (format "%s %s" vc-bzr-program command)
'vc-bzr-history)
" " t))
(setq vc-bzr-program (car args)
command (cadr args)
args (cddr args)))
+ (require 'vc-dispatcher)
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
+ (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
+(defun vc-bzr-pull (prompt)
+ "Pull changes into the current Bzr branch.
+Normally, this runs \"bzr pull\". However, if the branch is a
+bound branch, run \"bzr update\" instead. If there is no default
+location from which to pull or update, or if PROMPT is non-nil,
+prompt for the Bzr command to run."
+ (vc-bzr--pushpull "pull" prompt))
+
+(defun vc-bzr-push (prompt)
+ "Push changes from the current Bzr branch.
+Normally, this runs \"bzr push\". If there is no push location,
+or if PROMPT is non-nil, prompt for the Bzr command to run."
+ (vc-bzr--pushpull "push" prompt))
+
(defun vc-bzr-merge-branch ()
"Merge another Bzr branch into the current one.
Prompt for the Bzr command to run, providing a pre-defined merge
@@ -385,7 +412,7 @@ default if it is available."
(command (cadr cmd))
(args (cddr cmd)))
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf (vc-exec-after '(vc-compilation-mode 'bzr)))
+ (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
(vc-set-async-update buf))))
(defun vc-bzr-status (file)
@@ -492,12 +519,20 @@ in the branch repository (or whose status not be determined)."
(add-hook 'after-save-hook 'vc-bzr-resolve-when-done nil t)
(message "There are unresolved conflicts in this file")))
-(defun vc-bzr-workfile-unchanged-p (file)
- (eq 'unchanged (car (vc-bzr-status file))))
+(defun vc-bzr-version-dirstate (dir)
+ "Try to return as a string the bzr revision ID of directory DIR.
+This uses the dirstate file's parent revision entry.
+Returns nil if unable to find this information."
+ (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
+ (when (file-readable-p file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (and (looking-at "#bazaar dirstate flat format 3")
+ (forward-line 3)
+ (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
+ (match-string 1))))))
(defun vc-bzr-working-revision (file)
- ;; Together with the code in vc-state-heuristic, this makes it possible
- ;; to get the initial VC state of a Bzr file even if Bzr is not installed.
(let* ((rootdir (vc-bzr-root file))
(branch-format-file (expand-file-name vc-bzr-admin-branch-format-file
rootdir))
@@ -542,8 +577,8 @@ in the branch repository (or whose status not be determined)."
;; files exist.
(and (file-exists-p branch-format-file)
(file-exists-p lastrev-file)
- (equal (emacs-bzr-version-dirstate l-c-parent-dir)
- (emacs-bzr-version-dirstate rootdir))))))
+ (equal (vc-bzr-version-dirstate l-c-parent-dir)
+ (vc-bzr-version-dirstate rootdir))))))
t)))
(with-temp-buffer
(insert-file-contents branch-format-file)
@@ -579,10 +614,6 @@ in the branch repository (or whose status not be determined)."
"Create a new Bzr repository."
(vc-bzr-command "init" nil 0 nil))
-(defun vc-bzr-init-revision (&optional _file)
- "Always return nil, as Bzr cannot register explicit versions."
- nil)
-
(defun vc-bzr-previous-revision (_file rev)
(if (string-match "\\`[0-9]+\\'" rev)
(number-to-string (1- (string-to-number rev)))
@@ -593,11 +624,8 @@ in the branch repository (or whose status not be determined)."
(number-to-string (1+ (string-to-number rev)))
(error "Don't know how to compute the next revision of %s" rev)))
-(defun vc-bzr-register (files &optional rev _comment)
- "Register FILES under bzr.
-Signal an error unless REV is nil.
-COMMENT is ignored."
- (if rev (error "Can't register explicit revision with bzr"))
+(defun vc-bzr-register (files &optional _comment)
+ "Register FILES under bzr. COMMENT is ignored."
(vc-bzr-command "add" nil 0 files))
;; Could run `bzr status' in the directory and see if it succeeds, but
@@ -607,18 +635,6 @@ COMMENT is ignored."
The criterion is that there is a `.bzr' directory in the same
or a superior directory.")
-(defun vc-bzr-could-register (file)
- "Return non-nil if FILE could be registered under bzr."
- (and (vc-bzr-responsible-p file) ; shortcut
- (condition-case ()
- (with-temp-buffer
- (vc-bzr-command "add" t 0 file "--dry-run")
- ;; The command succeeds with no output if file is
- ;; registered (in bzr 0.8).
- (goto-char (point-min))
- (looking-at "added "))
- (error))))
-
(defun vc-bzr-unregister (file)
"Unregister FILE from bzr."
(vc-bzr-command "remove" nil 0 file "--keep"))
@@ -633,10 +649,8 @@ or a superior directory.")
"" (replace-regexp-in-string
"\n[ \t]?" " " str)))))
-(defun vc-bzr-checkin (files rev comment)
- "Check FILES in to bzr with log message COMMENT.
-REV non-nil gets an error."
- (if rev (error "Can't check in a specific revision with bzr"))
+(defun vc-bzr-checkin (files comment &optional _rev)
+ "Check FILES in to bzr with log message COMMENT."
(apply 'vc-bzr-command "commit" nil 0 files
(cons "-m" (log-edit-extract-headers
`(("Author" . ,(vc-bzr--sanitize-header "--author"))
@@ -651,27 +665,12 @@ REV non-nil gets an error."
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file))))
-(defun vc-bzr-ignore (file &optional directory remove)
- "Ignore FILE under Bazaar.
-If DIRECTORY is non-nil, the repository to use will be deduced by
-DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
- (if remove
- (if directory
- (vc--remove-regexp file (vc-bzr-find-ignore-file directory))
- (vc--remove-regexp file
- (vc-bzr-find-ignore-file default-directory)))
- (vc-bzr-command "ignore" t 0 file)))
-
-(defun vc-bzr-ignore-completion-table (file)
- "Return the list of ignored files."
- (vc--read-lines (vc-bzr-find-ignore-file file)))
-
(defun vc-bzr-find-ignore-file (file)
"Return the root directory of the repository of FILE."
(expand-file-name ".bzrignore"
(vc-bzr-root file)))
-(defun vc-bzr-checkout (_file &optional _editable rev)
+(defun vc-bzr-checkout (_file &optional rev)
(if rev (error "Operation not supported")
;; Else, there's nothing to do.
nil))
@@ -736,7 +735,7 @@ If LIMIT is non-nil, show no more than this many entries."
(with-current-buffer buffer
(apply 'vc-bzr-command "log" buffer 'async files
(append
- (when shortlog '("--line"))
+ (if shortlog '("--line") '("--long"))
;; The extra complications here when start-revision and limit
;; are set are due to bzr log's --forward argument, which
;; could be enabled via an alias in bazaar.conf.
@@ -771,7 +770,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-bzr-command "log" t nil nil
- (list (format "-r%s" revision)))
+ (list "--long" (format "-r%s" revision)))
(goto-char (point-min))
(when (looking-at "^-+\n")
;; Indent the expanded log entry.
@@ -807,7 +806,7 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-bzr-diff (files &optional rev1 rev2 buffer)
+(defun vc-bzr-diff (files &optional rev1 rev2 buffer async)
"VC bzr backend for diff."
(let* ((switches (vc-switches 'bzr 'diff))
(args
@@ -823,7 +822,7 @@ If LIMIT is non-nil, show no more than this many entries."
(or rev2 "")))))))
;; `bzr diff' exits with code 1 if diff is non-empty.
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*")
- (if vc-disable-async-diff 1 'async) files
+ (if async 1 'async) files
args)))
@@ -853,7 +852,8 @@ If LIMIT is non-nil, show no more than this many entries."
Each line is tagged with the revision number, which has a `help-echo'
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 'async file "--long" "--all"
- (if revision (list "-r" revision)))
+ (append (vc-switches 'bzr 'annotate)
+ (if revision (list "-r" revision))))
(let ((table (make-hash-table :test 'equal)))
(set-process-filter
(get-buffer-process buffer)
@@ -889,7 +889,7 @@ property containing author and date information."
(move-marker (process-mark proc) (point))))
(process-put proc :vc-left-over string)))))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-bzr-annotate-time ()
(when (re-search-forward "^ *[0-9.]+ +.+? +|" nil t)
@@ -970,6 +970,12 @@ stream. Standard error output is discarded."
(translated nil)
(result nil))
(goto-char (point-min))
+ ;; Skip a warning message that can occur in some bzr installations.
+ ;; vc-bzr-dir-extra-headers already reports it.
+ ;; Perhaps we should just discard stderr?
+ (and (looking-at "bzr: WARNING: bzrlib version doesn't match")
+ (re-search-forward "^bzr is version" nil t)
+ (forward-line 1))
(while (not (eobp))
;; Bzr 2.3.0 added this if there are shelves. (Bug#8170)
(unless (looking-at "[0-9]+ shel\\(f\\|ves\\) exists?\\.")
@@ -997,7 +1003,7 @@ stream. Standard error output is discarded."
(push (list new-name 'edited
(vc-bzr-create-extra-fileinfo old-name)) result)))
;; do nothing for non existent files
- ((memq translated '(not-found ignored)))
+ ((eq translated 'not-found))
(t
(push (list (file-relative-name
(buffer-substring-no-properties
@@ -1007,26 +1013,19 @@ stream. Standard error output is discarded."
(forward-line))
(funcall update-function result)))
-(defun vc-bzr-dir-status (dir update-function)
- "Return a list of conses (file . state) for DIR."
- (vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S")
- (vc-exec-after
- `(vc-bzr-after-dir-status (quote ,update-function)
- ;; "bzr status" results are relative to
- ;; the bzr root directory, NOT to the
- ;; directory "bzr status" was invoked in.
- ;; Ugh.
- ;; We pass the relative directory here so
- ;; that `vc-bzr-after-dir-status' can
- ;; frob the results accordingly.
- (file-relative-name ,dir (vc-bzr-root ,dir)))))
-
-(defun vc-bzr-dir-status-files (dir files _default-state update-function)
+(defun vc-bzr-dir-status-files (dir files update-function)
"Return a list of conses (file . state) for DIR."
(apply 'vc-bzr-command "status" (current-buffer) 'async dir "-v" "-S" files)
- (vc-exec-after
- `(vc-bzr-after-dir-status (quote ,update-function)
- (file-relative-name ,dir (vc-bzr-root ,dir)))))
+ (vc-run-delayed
+ (vc-bzr-after-dir-status update-function
+ ;; "bzr status" results are relative to
+ ;; the bzr root directory, NOT to the
+ ;; directory "bzr status" was invoked in.
+ ;; Ugh.
+ ;; We pass the relative directory here so
+ ;; that `vc-bzr-after-dir-status' can
+ ;; frob the results accordingly.
+ (file-relative-name dir (vc-bzr-root dir)))))
(defvar vc-bzr-shelve-map
(let ((map (make-sparse-keymap)))
@@ -1146,11 +1145,12 @@ stream. Standard error output is discarded."
(file &optional keep noquery reset-vc-info))
(defun vc-bzr-shelve (name)
- "Create a shelve."
+ "Shelve the changes of the selected files."
(interactive "sShelf name: ")
- (let ((root (vc-bzr-root default-directory)))
+ (let ((root (vc-bzr-root default-directory))
+ (fileset (vc-deduce-fileset)))
(when root
- (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
+ (vc-bzr-command "shelve" nil 0 (nth 1 fileset) "--all" "-m" name)
(vc-resynch-buffer root t t))))
(defun vc-bzr-shelve-show (name)
@@ -1180,10 +1180,7 @@ stream. Standard error output is discarded."
"Create a stash with the current tree state."
(interactive)
(vc-bzr-command "shelve" nil 0 nil "--all" "-m"
- (let ((ct (current-time)))
- (concat
- (format-time-string "Snapshot on %Y-%m-%d" ct)
- (format-time-string " at %H:%M" ct))))
+ (format-time-string "Snapshot on %Y-%m-%d at %H:%M"))
(vc-bzr-command "unshelve" nil 0 nil "--apply" "--keep")
(vc-resynch-buffer (vc-bzr-root default-directory) t t))
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 48d83d4f408..5f5807fb3c6 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1,6 +1,6 @@
;;; vc-cvs.el --- non-resident support for CVS version-control -*- lexical-binding: t -*-
-;; Copyright (C) 1995, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -48,9 +48,9 @@
;; If the file is not writable (despite CVSREAD being
;; undefined), this is probably because the file is being
;; "watched" by other developers.
- ;; (If vc-mistrust-permissions was t, we actually shouldn't
- ;; trust this, but there is no other way to learn this from
- ;; CVS at the moment (version 1.9).)
+ ;; (We actually shouldn't trust this, but there is
+ ;; no other way to learn this from CVS at the
+ ;; moment (version 1.9).)
(string-match "r-..-..-." (nth 8 attrib)))
'announce
'implicit))))))
@@ -96,7 +96,18 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "21.1"
:group 'vc-cvs)
-(defcustom vc-cvs-header '("\$Id\$")
+(defcustom vc-cvs-annotate-switches nil
+ "String or list of strings specifying switches for cvs annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-cvs)
+
+(defcustom vc-cvs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:type '(repeat string)
@@ -110,7 +121,7 @@ This is only meaningful if you don't use the implicit checkout model
:version "21.1"
:group 'vc-cvs)
-(defcustom vc-cvs-stay-local 'only-file
+(defcustom vc-stay-local 'only-file
"Non-nil means use local operations when possible for remote repositories.
This avoids slow queries over the network and instead uses heuristics
and past information to determine the current status of a file.
@@ -222,7 +233,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
(defun vc-cvs-state (file)
"CVS-specific version of `vc-state'."
- (if (vc-stay-local-p file 'CVS)
+ (if (vc-cvs-stay-local-p file)
(let ((state (vc-file-getprop file 'vc-state)))
;; If we should stay local, use the heuristic but only if
;; we don't have a more precise state already available.
@@ -270,8 +281,8 @@ committed and support display of sticky tags."
(propertize
(if (zerop (length sticky-tag))
string
- (setq help-echo (format "%s on the '%s' branch"
- help-echo sticky-tag))
+ (setq help-echo (format-message "%s on the `%s' branch"
+ help-echo sticky-tag))
(concat string "[" sticky-tag "]"))
'help-echo help-echo)))
@@ -282,7 +293,7 @@ committed and support display of sticky tags."
(autoload 'vc-switches "vc")
-(defun vc-cvs-register (files &optional _rev comment)
+(defun vc-cvs-register (files &optional comment)
"Register FILES into the CVS version-control system.
COMMENT can be used to provide an initial description of FILES.
Passes either `vc-cvs-register-switches' or `vc-register-switches'
@@ -321,20 +332,20 @@ its parents."
(directory-file-name dir))))
(eq dir t)))
-(defun vc-cvs-checkin (files rev comment)
+(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)
+ (concat "-m" comment)
(vc-switches 'CVS 'checkin))))
(set-buffer "*vc*")
(goto-char (point-min))
@@ -366,7 +377,6 @@ its parents."
;; vc-cvs-checkout-model).
(mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil))
files)
-
;; 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)))
@@ -382,9 +392,8 @@ its parents."
"-p"
(vc-switches 'CVS 'checkout)))
-(defun vc-cvs-checkout (file &optional editable rev)
+(defun vc-cvs-checkout (file &optional rev)
"Checkout a revision of FILE into the working area.
-EDITABLE non-nil means that the file should be writable.
REV is the revision to check out."
(message "Checking out %s..." file)
;; Change buffers to get local value of vc-checkout-switches.
@@ -392,7 +401,7 @@ REV is the revision to check out."
(if (and (file-exists-p file) (not rev))
;; If no revision was specified, just make the file writable
;; if necessary (using `cvs-edit' if requested).
- (and editable (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
+ (and (not (eq (vc-cvs-checkout-model (list file)) 'implicit))
(if vc-cvs-use-edit
(vc-cvs-command nil 0 file "edit")
(set-file-modes file (logior (file-modes file) 128))
@@ -400,7 +409,7 @@ REV is the revision to check out."
;; Check out a particular revision (or recreate the file).
(vc-file-setprop file 'vc-working-revision nil)
(apply 'vc-cvs-command nil 0 file
- (and editable "-w")
+ "-w"
"update"
(when rev
(unless (eq rev t)
@@ -428,6 +437,35 @@ REV is the revision to check out."
;; Make the file read-only by switching off all w-bits
(set-file-modes file (logand (file-modes file) 3950)))))
+(defun vc-cvs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from branch or revision "
+ "(default news on current branch): ")
+ (list file)
+ 'CVS))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-cvs-merge-news file)))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second revision: "
+ (list file) 'CVS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-cvs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))
+ (setq status (vc-cvs-merge file first-revision second-revision))))
+ status))
+
(defun vc-cvs-merge (file first-revision &optional second-revision)
"Merge changes into current working copy of FILE.
The changes are between FIRST-REVISION and SECOND-REVISION."
@@ -515,10 +553,10 @@ Remaining arguments are ignored."
;; It's just the catenation of the individual logs.
(vc-cvs-command
buffer
- (if (vc-stay-local-p files 'CVS) 'async 0)
+ (if (vc-cvs-stay-local-p files) 'async 0)
files "log")
(with-current-buffer buffer
- (vc-exec-after (vc-rcs-print-log-cleanup)))
+ (vc-run-delayed (vc-rcs-print-log-cleanup)))
(when limit 'limit-unsupported))
(defun vc-cvs-comment-history (file)
@@ -528,11 +566,10 @@ Remaining arguments are ignored."
(autoload 'vc-version-backup-file "vc")
(declare-function vc-coding-system-for-diff "vc" (file))
-(defun vc-cvs-diff (files &optional oldvers newvers buffer)
+(defun vc-cvs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using CVS between two revisions of FILE."
(let* (process-file-side-effects
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'CVS)))
+ (async (and async (vc-cvs-stay-local-p files)))
(invoke-cvs-diff-list nil)
status)
;; Look through the file list and see if any files have backups
@@ -583,11 +620,12 @@ Remaining arguments are ignored."
(defun vc-cvs-annotate-command (file buffer &optional revision)
"Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
- (vc-cvs-command buffer
- (if (vc-stay-local-p file 'CVS)
- 'async 0)
- file "annotate"
- (if revision (concat "-r" revision)))
+ (apply #'vc-cvs-command buffer
+ (if (vc-cvs-stay-local-p file)
+ 'async 0)
+ file "annotate"
+ (append (vc-switches 'cvs 'annotate)
+ (if revision (list (concat "-r" revision)))))
;; Strip the leading few lines.
(let ((proc (get-buffer-process buffer)))
(if proc
@@ -599,13 +637,13 @@ Optional arg REVISION is a revision to annotate from."
(re-search-forward vc-cvs-annotate-first-line-re)
(delete-region (point-min) (1- (point)))))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-cvs-annotate-current-time ()
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+ (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-cvs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
@@ -721,7 +759,7 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
(defun vc-cvs-make-version-backups-p (file)
"Return non-nil if version backups should be made for FILE."
- (vc-stay-local-p file 'CVS))
+ (vc-cvs-stay-local-p file))
(defun vc-cvs-check-headers ()
"Check if the current file has any headers in it."
@@ -745,8 +783,34 @@ and that it passes `vc-cvs-global-switches' to it before FLAGS."
(append vc-cvs-global-switches
flags))))
-(defun vc-cvs-stay-local-p (file) ;Back-compatibility.
- (vc-stay-local-p file 'CVS))
+(defun vc-cvs-stay-local-p (file)
+ "Return non-nil if VC should stay local when handling FILE.
+If FILE is a list of files, return non-nil if any of them
+individually should stay local."
+ (if (listp file)
+ (delq nil (mapcar (lambda (arg) (vc-cvs-stay-local-p arg)) file))
+ (let* ((sym (vc-make-backend-sym 'CVS 'stay-local))
+ (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
+ (if (symbolp stay-local) stay-local
+ (let ((dirname (if (file-directory-p file)
+ (directory-file-name file)
+ (file-name-directory file))))
+ (eq 'yes
+ (or (vc-file-getprop dirname 'vc-cvs-stay-local-p)
+ (vc-file-setprop
+ dirname 'vc-cvs-stay-local-p
+ (let ((hostname (vc-cvs-repository-hostname dirname)))
+ (if (not hostname)
+ 'no
+ (let ((default t))
+ (if (eq (car-safe stay-local) 'except)
+ (setq default nil stay-local (cdr stay-local)))
+ (when (consp stay-local)
+ (setq stay-local
+ (mapconcat 'identity stay-local "\\|")))
+ (if (if (string-match stay-local hostname)
+ default (not default))
+ 'yes 'no))))))))))))
(defun vc-cvs-repository-hostname (dirname)
"Hostname of the CVS server associated to workarea DIRNAME."
@@ -854,7 +918,7 @@ state."
(when (and full
(re-search-forward
"\\(RCS Version\\|RCS Revision\\|Repository revision\\):\
-\[\t ]+\\([0-9.]+\\)"
+[\t ]+\\([0-9.]+\\)"
nil t))
(vc-file-setprop file 'vc-latest-revision (match-string 2)))
(vc-file-setprop
@@ -1003,26 +1067,21 @@ state."
(if basedir result
(funcall update-function result))))
-(defun vc-cvs-dir-status (dir update-function)
- "Create a list of conses (file . state) for DIR."
- ;; FIXME check all files in DIR instead?
- (let ((local (vc-stay-local-p dir 'CVS)))
- (if (and local (not (eq local 'only-file)))
+(defun vc-cvs-dir-status-files (dir files update-function)
+ "Create a list of conses (file . state) for FILES in DIR.
+Query all files in DIR if files is nil."
+ (let ((local (vc-cvs-stay-local-p dir)))
+ (if (and (not files) local (not (eq local 'only-file)))
(vc-cvs-dir-status-heuristic dir update-function)
- (vc-cvs-command (current-buffer) 'async dir "-f" "status")
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'CVS)))
+ (vc-cvs-command (current-buffer) 'async files "-f" "status")
;; Alternative implementation: use the "update" command instead of
;; the "status" command.
;; (vc-cvs-command (current-buffer) 'async
;; (file-relative-name dir)
;; "-f" "-n" "update" "-d" "-P")
- (vc-exec-after
- `(vc-cvs-after-dir-status (quote ,update-function))))))
-
-(defun vc-cvs-dir-status-files (dir files _default-state update-function)
- "Create a list of conses (file . state) for DIR."
- (apply 'vc-cvs-command (current-buffer) 'async dir "-f" "status" files)
- (vc-exec-after
- `(vc-cvs-after-dir-status (quote ,update-function))))
+ (vc-run-delayed
+ (vc-cvs-after-dir-status update-function)))))
(defun vc-cvs-file-to-string (file)
"Read the content of FILE and return it as a string."
@@ -1226,11 +1285,15 @@ is non-nil."
table (lambda () (vc-cvs-revision-table (car files))))))
table))
-(defun vc-cvs-ignore (file)
+(defun vc-cvs-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (vc-find-root file "CVS"))
+
+(defun vc-cvs-ignore (file &optional _directory _remove)
"Ignore FILE under CVS."
- (cvs-append-to-ignore (file-name-directory file) file))
+ (vc-cvs-append-to-ignore (file-name-directory file) file))
-(defun cvs-append-to-ignore (dir str &optional old-dir)
+(defun vc-cvs-append-to-ignore (dir str &optional old-dir)
"In DIR, add STR to the .cvsignore file.
If OLD-DIR is non-nil, then this is a directory that we don't want
to hear about anymore."
@@ -1245,7 +1308,9 @@ to hear about anymore."
(goto-char (point-max))
(unless (bolp) (insert "\n"))
(insert str (if old-dir "/\n" "\n"))
- (if cvs-sort-ignore-file (sort-lines nil (point-min) (point-max)))
+ ;; FIXME this is a pcvs variable.
+ (if (bound-and-true-p cvs-sort-ignore-file)
+ (sort-lines nil (point-min) (point-max)))
(save-buffer)))
(provide 'vc-cvs)
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 83fc0bceb66..880e14be63e 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -1,6 +1,6 @@
;;; vc-dav.el --- vc.el support for WebDAV
-;; Copyright (C) 2001, 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2004-2015 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Maintainer: Bill Perry <wmperry@gnu.org>
@@ -77,19 +77,17 @@ See `vc-checkout-model' for a list of possible values."
"Return the current workfile version of URL."
"Unknown")
-(defun vc-dav-register (url &optional rev comment)
+(defun vc-dav-register (url &optional _comment)
"Register URL in the DAV backend."
;; Do we need to do anything here? FIXME?
)
-(defun vc-dav-checkin (url rev comment)
- "Commit changes in URL to WebDAV.
-If REV is non-nil, that should become the new revision number.
-COMMENT is used as a check-in comment."
+(defun vc-dav-checkin (url comment &optional _rev)
+ "Commit changes in URL to WebDAV. COMMENT is used as a check-in comment."
;; This should PUT the resource and release any locks that we hold.
)
-(defun vc-dav-checkout (url &optional editable rev destfile)
+(defun vc-dav-checkout (url &optional rev destfile)
"Check out revision REV of URL into the working area.
If EDITABLE is non-nil URL should be writable by the user and if
@@ -119,7 +117,7 @@ only needs to update the status of URL within the backend.
"Insert the revision log of URL into the *vc* buffer."
)
-(defun vc-dav-diff (url &optional rev1 rev2)
+(defun vc-dav-diff (url &optional rev1 rev2 buffer async)
"Insert the diff for URL into the *vc-diff* buffer.
If REV1 and REV2 are non-nil report differences from REV1 to REV2.
If REV1 is nil, use the current workfile version as the older version.
@@ -135,10 +133,6 @@ It should return a status of either 0 (no differences found), or
;;; Optional functions
-;; Should be faster than vc-dav-state - but how?
-(defun vc-dav-state-heuristic (url)
- "Estimate the version control state of URL at visiting time."
- (vc-dav-state url))
;; This should use url-dav-get-properties with a depth of `1' to get
;; all the properties.
@@ -146,27 +140,13 @@ It should return a status of either 0 (no differences found), or
"find the version control state of all files in DIR in a fast way."
)
-(defun vc-dav-workfile-unchanged-p (url)
- "Return non-nil if URL is unchanged from its current workfile version."
- ;; Probably impossible with webdav
- )
-
(defun vc-dav-responsible-p (url)
"Return non-nil if DAV considers itself `responsible' for URL."
;; Check for DAV support on the web server.
t)
-(defun vc-dav-could-register (url)
- "Return non-nil if URL could be registered under this backend."
- ;; Check for DAV support on the web server.
- t)
-
;;; Unimplemented functions
;;
-;; vc-dav-latest-on-branch-p(URL)
-;; Return non-nil if the current workfile version of FILE is the
-;; latest on its branch. There are no branches in webdav yet.
-;;
;; vc-dav-mode-line-string(url)
;; Return a dav-specific mode line string for URL. Are there any
;; specific states that we want exposed?
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 5ddcfd57748..9b15e64fad7 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1,6 +1,6 @@
;;; vc-dir.el --- Directory status display under VC -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Dan Nicolaescu <dann@ics.uci.edu>
;; Keywords: vc tools
@@ -111,7 +111,7 @@ See `run-hooks'."
(current-buffer)))))
(defvar vc-dir-menu-map
- (let ((map (make-sparse-keymap "VC-dir")))
+ (let ((map (make-sparse-keymap "VC-Dir")))
(define-key map [quit]
'(menu-item "Quit" quit-window
:help "Quit"))
@@ -169,6 +169,9 @@ See `run-hooks'."
(define-key map [ise]
'(menu-item "Isearch Files..." vc-dir-isearch
:help "Incremental search a string in the marked files"))
+ (define-key map [display]
+ '(menu-item "Display in Other Window" vc-dir-display-file
+ :help "Display the file on the current line, in another window"))
(define-key map [open-other]
'(menu-item "Open in Other Window" vc-dir-find-file-other-window
:help "Find the file on the current line, in another window"))
@@ -201,6 +204,10 @@ See `run-hooks'."
:help "List the change log for the current tree in a window"))
;; VC commands.
(define-key map [sepvccmd] '("--"))
+ (define-key map [push]
+ '(menu-item "Push Changes" vc-push
+ :enable (vc-find-backend-function vc-dir-backend 'push)
+ :help "Push the current branch's changes"))
(define-key map [update]
'(menu-item "Update to Latest Version" vc-update
:help "Update the current fileset's files to their tip revisions"))
@@ -243,8 +250,11 @@ See `run-hooks'."
(define-key map "D" 'vc-root-diff) ;; C-x v D
(define-key map "i" 'vc-register) ;; C-x v i
(define-key map "+" 'vc-update) ;; C-x v +
+ ;; I'd prefer some kind of symmetry with vc-update:
+ (define-key map "P" 'vc-push) ;; C-x v P
(define-key map "l" 'vc-print-log) ;; C-x v l
(define-key map "L" 'vc-print-root-log) ;; C-x v L
+ (define-key map "I" 'vc-log-incoming) ;; C-x v I
;; More confusing than helpful, probably
;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
@@ -272,6 +282,7 @@ See `run-hooks'."
(define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility
(define-key map "\C-m" 'vc-dir-find-file)
(define-key map "o" 'vc-dir-find-file-other-window)
+ (define-key map "\C-o" 'vc-dir-display-file)
(define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
(define-key map [down-mouse-3] 'vc-dir-menu)
(define-key map [mouse-2] 'vc-dir-toggle-mark)
@@ -289,7 +300,7 @@ See `run-hooks'."
`(menu-item
;; VC backends can use this to add mode-specific menu items to
;; vc-dir-menu-map.
- "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
+ "VC-Dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
map)
"Keymap for directory buffer.")
@@ -432,7 +443,8 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
;; previous node was in a different directory.
(let* ((rd (file-relative-name entrydir))
(prev-node (ewoc-prev vc-ewoc node))
- (prev-dir (vc-dir-node-directory prev-node)))
+ (prev-dir (if prev-node
+ (vc-dir-node-directory prev-node))))
(unless (string-equal entrydir prev-dir)
(ewoc-enter-before
vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
@@ -753,6 +765,13 @@ that share the same state."
(if event (posn-set-point (event-end event)))
(find-file-other-window (vc-dir-current-file)))
+(defun vc-dir-display-file (&optional event)
+ "Display the file on the current line, in another window."
+ (interactive (list last-nonmenu-event))
+ (if event (posn-set-point (event-end event)))
+ (display-buffer (find-file-noselect (vc-dir-current-file))
+ t))
+
(defun vc-dir-isearch ()
"Search for a string through all marked buffers using Isearch."
(interactive)
@@ -913,7 +932,7 @@ If it is a file, return the corresponding cons for the file itself."
(defun vc-dir-resynch-file (&optional fname)
"Update the entries for FNAME in any directory buffers that list it."
- (let ((file (or fname (expand-file-name buffer-file-name)))
+ (let ((file (expand-file-name (or fname buffer-file-name)))
(drop '()))
(save-current-buffer
;; look for a vc-dir buffer that might show this file.
@@ -1012,7 +1031,7 @@ specific headers."
(vc-call-backend backend 'dir-extra-headers dir)
"\n"))
-(defun vc-dir-refresh-files (files default-state)
+(defun vc-dir-refresh-files (files)
"Refresh some files in the *VC-dir* buffer."
(let ((def-dir default-directory)
(backend vc-dir-backend))
@@ -1030,7 +1049,7 @@ specific headers."
(setq default-directory def-dir)
(erase-buffer)
(vc-call-backend
- backend 'dir-status-files def-dir files default-state
+ backend 'dir-status-files def-dir files
(lambda (entries &optional more-to-come)
;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
;; If MORE-TO-COME is true, then more updates will come from
@@ -1095,7 +1114,7 @@ Throw an error if another update process is in progress."
(setq default-directory def-dir)
(erase-buffer)
(vc-call-backend
- backend 'dir-status def-dir
+ backend 'dir-status-files def-dir nil
(lambda (entries &optional more-to-come)
;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
;; If MORE-TO-COME is true, then more updates will come from
@@ -1108,8 +1127,7 @@ Throw an error if another update process is in progress."
vc-ewoc 'vc-dir-fileinfo->needs-update)))
(if remaining
(vc-dir-refresh-files
- (mapcar 'vc-dir-fileinfo->name remaining)
- 'up-to-date)
+ (mapcar 'vc-dir-fileinfo->name remaining))
(setq mode-line-process nil))))))))))))
(defun vc-dir-show-fileentry (file)
@@ -1123,18 +1141,18 @@ outside of VC) and one wants to do some operation on it."
"Hide items that are in STATE from display.
See `vc-state' for valid values of STATE.
-If STATE is nil, default it to up-to-date.
+If STATE is nil, hide both `up-to-date' and `ignored' items.
Interactively, if `current-prefix-arg' is non-nil, set STATE to
-state of item at point. Otherwise, set STATE to up-to-date."
+state of item at point, if any."
(interactive (list
(and current-prefix-arg
;; Command is prefixed. Infer STATE from point.
(let ((node (ewoc-locate vc-ewoc)))
(and node (vc-dir-fileinfo->state (ewoc-data node)))))))
- ;; If STATE is un-specified, use up-to-date.
- (setq state (or state 'up-to-date))
- (message "Hiding items in state \"%s\"" state)
+ (if state
+ (message "Hiding items in state \"%s\"" state)
+ (message "Hiding up-to-date and ignored items"))
(let ((crt (ewoc-nth vc-ewoc -1))
(first (ewoc-nth vc-ewoc 0)))
;; Go over from the last item to the first and remove the
@@ -1155,8 +1173,10 @@ state of item at point. Otherwise, set STATE to up-to-date."
;; Next item is a directory.
(vc-dir-fileinfo->directory (ewoc-data next))))
;; Remove files in specified STATE. STATE can be a
- ;; symbol or a user-name.
- (equal (vc-dir-fileinfo->state data) state))
+ ;; symbol, a user-name, or nil.
+ (if state
+ (equal (vc-dir-fileinfo->state data) state)
+ (memq (vc-dir-fileinfo->state data) '(up-to-date ignored))))
(ewoc-delete vc-ewoc crt))
(setq crt prev)))))
@@ -1227,7 +1247,7 @@ These are the commands available for use in the file status buffer:
;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
;; you may get a new *vc-dir* buffer, different from the original
(file-truename (read-directory-name "VC status for directory: "
- default-directory default-directory t
+ (vc-root-dir) nil t
nil))
(if current-prefix-arg
(intern
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 4f4c6942ba9..ec55867fcfe 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -1,6 +1,6 @@
;;; vc-dispatcher.el -- generic command-dispatcher facility. -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
@@ -171,6 +171,12 @@ Another is that undo information is not kept."
(let ((camefrom (current-buffer))
(olddir default-directory))
(set-buffer (get-buffer-create buf))
+ (let ((oldproc (get-buffer-process (current-buffer))))
+ ;; If we wanted to wait for oldproc to finish before doing
+ ;; something, we'd have used vc-eval-after.
+ ;; Use `delete-process' rather than `kill-process' because we don't
+ ;; want any of its output to appear from now on.
+ (when oldproc (delete-process oldproc)))
(kill-all-local-variables)
(set (make-local-variable 'vc-parent-buffer) camefrom)
(set (make-local-variable 'vc-parent-buffer-name)
@@ -198,11 +204,11 @@ Another is that undo information is not kept."
;; Normally, we want async code such as sentinels to not move point.
(save-excursion
(goto-char m)
- ;; Each sentinel may move point and the next one should be run
- ;; at that new point. We could get the same result by having
- ;; each sentinel read&set process-mark, but since `cmd' needs
- ;; to work both for async and sync processes, this would be
- ;; difficult to achieve.
+ ;; Each sentinel may move point and the next one should be run
+ ;; at that new point. We could get the same result by having
+ ;; each sentinel read&set process-mark, but since `cmd' needs
+ ;; to work both for async and sync processes, this would be
+ ;; difficult to achieve.
(vc-exec-after code)
(move-marker m (point)))
;; But sometimes the sentinels really want to move point.
@@ -224,8 +230,7 @@ Another is that undo information is not kept."
"Eval CODE when the current buffer's process is done.
If the current buffer has no process, just evaluate CODE.
Else, add CODE to the process' sentinel.
-CODE can be either a function of no arguments, or an expression
-to evaluate."
+CODE should be a function of no arguments."
(let ((proc (get-buffer-process (current-buffer))))
(cond
;; If there's no background process, just execute the code.
@@ -247,6 +252,10 @@ to evaluate."
(t (error "Unexpected process state"))))
nil)
+(defmacro vc-run-delayed (&rest body)
+ (declare (indent 0) (debug t))
+ `(vc-exec-after (lambda () ,@body)))
+
(defvar vc-post-command-functions nil
"Hook run at the end of `vc-do-command'.
Each function is called inside the buffer in which the command was run
@@ -299,12 +308,6 @@ case, and the process object in the asynchronous case."
(eq buffer (current-buffer)))
(vc-setup-buffer buffer))
;; If there's some previous async process still running, just kill it.
- (let ((oldproc (get-buffer-process (current-buffer))))
- ;; If we wanted to wait for oldproc to finish before doing
- ;; something, we'd have used vc-eval-after.
- ;; Use `delete-process' rather than `kill-process' because we don't
- ;; want any of its output to appear from now on.
- (when oldproc (delete-process oldproc)))
(let ((squeezed (remq nil flags))
(inhibit-read-only t)
(status 0))
@@ -328,8 +331,8 @@ case, and the process object in the asynchronous case."
(set-process-filter proc 'vc-process-filter)
(setq status proc)
(when vc-command-messages
- (vc-exec-after
- `(message "Running %s in background... done" ',full-command))))
+ (vc-run-delayed
+ (message "Running %s in background... done" full-command))))
;; Run synchronously
(when vc-command-messages
(message "Running %s in foreground..." full-command))
@@ -346,9 +349,9 @@ case, and the process object in the asynchronous case."
(if (integerp status) (format "status %d" status) status)))
(when vc-command-messages
(message "Running %s...OK = %d" full-command status))))
- (vc-exec-after
- `(run-hook-with-args 'vc-post-command-functions
- ',command ',file-or-list ',flags))
+ (vc-run-delayed
+ (run-hook-with-args 'vc-post-command-functions
+ command file-or-list flags))
status))))
(defun vc-do-async-command (buffer root command &rest args)
@@ -395,6 +398,8 @@ Display the buffer in some window, but don't select it."
(set (make-local-variable 'compilation-error-regexp-alist)
error-regexp-alist)))
+(declare-function vc-dir-refresh "vc-dir" ())
+
(defun vc-set-async-update (process-buffer)
"Set a `vc-exec-after' action appropriate to the current buffer.
This action will update the current buffer after the current
@@ -408,23 +413,23 @@ If the current buffer is a Dired buffer, revert it."
(cond
((derived-mode-p 'vc-dir-mode)
(with-current-buffer process-buffer
- (vc-exec-after
- `(if (buffer-live-p ,buf)
- (with-current-buffer ,buf
- (vc-dir-refresh))))))
+ (vc-run-delayed
+ (if (buffer-live-p buf)
+ (with-current-buffer buf
+ (vc-dir-refresh))))))
((derived-mode-p 'dired-mode)
(with-current-buffer process-buffer
- (vc-exec-after
- `(and (buffer-live-p ,buf)
- (= (buffer-modified-tick ,buf) ,tick)
- (with-current-buffer ,buf
- (revert-buffer)))))))))
+ (vc-run-delayed
+ (and (buffer-live-p buf)
+ (= (buffer-modified-tick buf) tick)
+ (with-current-buffer buf
+ (revert-buffer)))))))))
;; These functions are used to ensure that the view the user sees is up to date
;; even if the dispatcher client mode has messed with file contents (as in,
;; for example, VCS keyword expansion).
-(declare-function view-mode-exit "view" (&optional return-to-alist exit-action all-win))
+(declare-function view-mode-exit "view" (&optional exit-only exit-action all-win))
(defun vc-position-context (posn)
"Save a bit of the text around POSN in the current buffer.
@@ -538,7 +543,7 @@ editing!"
(if (file-writable-p file)
(and view-mode
(let ((view-old-buffer-read-only nil))
- (view-mode-exit)))
+ (view-mode-exit t)))
(and (not view-mode)
(not (eq (get major-mode 'mode-class) 'special))
(view-mode-enter))))
@@ -586,17 +591,37 @@ NOT-URGENT means it is ok to continue if the user says not to save."
;; Set up key bindings for use while editing log messages
+(declare-function log-edit-empty-buffer-p "log-edit" ())
+
(defun vc-log-edit (fileset mode backend)
"Set up `log-edit' for use on FILE."
(setq default-directory
(buffer-local-value 'default-directory vc-parent-buffer))
+ (require 'log-edit)
(log-edit 'vc-finish-logentry
- nil
- `((log-edit-listfun . (lambda ()
- ;; FIXME: Should expand the list
- ;; for directories.
- (mapcar 'file-relative-name
- ',fileset)))
+ ;; Setup a new log message if the log buffer is "empty",
+ ;; or was previously used for a different set of files.
+ (or (log-edit-empty-buffer-p)
+ (and (local-variable-p 'vc-log-fileset)
+ (not (equal vc-log-fileset fileset))))
+ `((log-edit-listfun
+ . (lambda ()
+ ;; FIXME: When fileset includes directories, and
+ ;; there are relevant ChangeLog files inside their
+ ;; children, we don't find them. Either handle it
+ ;; in `log-edit-insert-changelog-entries' by
+ ;; walking down the file trees, or somehow pass
+ ;; `fileset-only-files' from `vc-next-action'
+ ;; through to this function.
+ (let ((root (vc-root-dir)))
+ ;; Returns paths relative to the root, so that
+ ;; `log-edit-changelog-insert-entries'
+ ;; substitutes them in correctly later, even when
+ ;; `vc-checkin' was called from a file buffer, or
+ ;; a non-root VC-Dir buffer.
+ (mapcar
+ (lambda (file) (file-relative-name file root))
+ ',fileset))))
(log-edit-diff-function . vc-diff)
(log-edit-vc-backend . ,backend)
(vc-log-fileset . ,fileset))
@@ -690,7 +715,7 @@ the buffer contents as a comment."
;; Now make sure we see the expanded headers
(when log-fileset
(mapc
- (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+ (lambda (file) (vc-resynch-buffer file t t))
log-fileset))
(when (vc-dispatcher-browsing)
(vc-dir-move-to-goal-column))
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
new file mode 100644
index 00000000000..254d126b98a
--- /dev/null
+++ b/lisp/vc/vc-filewise.el
@@ -0,0 +1,84 @@
+;;; vc-filewise.el --- common functions for file-oriented back ends.
+
+;; Copyright (C) 1992-1996, 1998-2015 Free Software Foundation, Inc.
+
+;; Author: FSF (see vc.el for full credits)
+;; Maintainer: Andre Spiegel <spiegel@gnu.org>
+;; Package: vc
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Common functions for file-oriented back ends - SCCS, RCS, SRC, CVS
+;;
+;; The main purpose of this file is so none of this code has to live
+;; in the always-resident vc-hooks. A secondary purpose is to remove
+;; code specific to this class of back ends from vc.el.
+
+;;; Code:
+
+(eval-when-compile (require 'vc))
+
+(defun vc-master-name (file)
+ "Return the master name of FILE.
+If the file is not registered, or the master name is not known, return nil."
+ (or (vc-file-getprop file 'vc-name)
+ ;; force computation of the property by calling
+ ;; vc-BACKEND-registered explicitly
+ (let ((backend (vc-backend file)))
+ (if (and backend
+ (vc-filewise-registered backend file))
+ (vc-file-getprop file 'vc-name)))))
+
+(defun vc-rename-master (oldmaster newfile templates)
+ "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
+ (let* ((dir (file-name-directory (expand-file-name oldmaster)))
+ (newdir (or (file-name-directory newfile) ""))
+ (newbase (file-name-nondirectory newfile))
+ (masters
+ ;; List of potential master files for `newfile'
+ (mapcar
+ (lambda (s) (vc-possible-master s newdir newbase))
+ templates)))
+ (when (or (file-symlink-p oldmaster)
+ (file-symlink-p (file-name-directory oldmaster)))
+ (error "This is unsafe in the presence of symbolic links"))
+ (rename-file
+ oldmaster
+ (catch 'found
+ ;; If possible, keep the master file in the same directory.
+ (dolist (f masters)
+ (when (and f (string= (file-name-directory (expand-file-name f)) dir))
+ (throw 'found f)))
+ ;; If not, just use the first possible place.
+ (dolist (f masters)
+ (and f (or (not (setq dir (file-name-directory f)))
+ (file-directory-p dir))
+ (throw 'found f)))
+ (error "New file lacks a version control directory")))))
+
+(defun vc-filewise-registered (backend file)
+ "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates."
+ (let ((sym (vc-make-backend-sym backend 'master-templates)))
+ (unless (get backend 'vc-templates-grabbed)
+ (put backend 'vc-templates-grabbed t))
+ (let ((result (vc-check-master-templates file (symbol-value sym))))
+ (if (stringp result)
+ (vc-file-setprop file 'vc-name result)
+ nil)))) ; Not registered
+
+(provide 'vc-filewise)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 472c42840af..27898a991a0 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1,6 +1,6 @@
;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Alexandre Julliard <julliard@winehq.org>
;; Keywords: vc tools
@@ -50,32 +50,27 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
+;; - dir-status-files (dir files uf) OK
;; * working-revision (file) OK
-;; - latest-on-branch-p (file) NOT NEEDED
;; * checkout-model (files) OK
-;; - workfile-unchanged-p (file) OK
;; - mode-line-string (file) OK
;; STATE-CHANGING FUNCTIONS
;; * create-repo () OK
;; * register (files &optional rev comment) OK
-;; - init-revision (file) NOT NEEDED
;; - responsible-p (file) OK
-;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD
;; - receive-file (file rev) NOT NEEDED
;; - unregister (file) OK
;; * checkin (files rev comment) OK
;; * find-revision (file rev buffer) OK
-;; * checkout (file &optional editable rev) OK
+;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
-;; - rollback (files) COULD BE SUPPORTED
-;; - merge (file rev1 rev2) It would be possible to merge
+;; - merge-file (file rev1 rev2) It would be possible to merge
;; changes into a single file, but
;; when committing they wouldn't
;; be identified as a merge
;; by git, so it's probably
;; not a good idea.
-;; - merge-news (file) see `merge'
+;; - merge-news (file) see `merge-file'
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -83,7 +78,7 @@
;; - show-log-entry (revision) OK
;; - comment-history (file) ??
;; - update-changelog (files) COULD BE SUPPORTED
-;; * diff (file &optional rev1 rev2 buffer) OK
+;; * diff (file &optional rev1 rev2 buffer async) OK
;; - revision-completion-table (files) OK
;; - annotate-command (file buf &optional rev) OK
;; - annotate-time () OK
@@ -94,14 +89,13 @@
;; - retrieve-tag (dir name update) OK
;; MISCELLANEOUS
;; - make-version-backups-p (file) NOT NEEDED
-;; - repository-hostname (dirname) NOT NEEDED
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () COULD BE SUPPORTED
-;; - clear-headers () NOT NEEDED
;; - delete-file (file) OK
;; - rename-file (old new) OK
-;; - find-file-hook () NOT NEEDED
+;; - find-file-hook () OK
+;; - conflicted-files OK
;;; Code:
@@ -123,14 +117,33 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :version "23.1"
- :group 'vc-git)
+ :version "23.1")
+
+(defcustom vc-git-annotate-switches nil
+ "String or list of strings specifying switches for Git blame under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1")
+
+(defcustom vc-git-resolve-conflicts t
+ "When non-nil, mark conflicted file as resolved upon saving.
+That is performed after all conflict markers in it have been
+removed. If the value is `unstage-maybe', and no merge is in
+progress, then after the last conflict is resolved, also clear
+the staging area."
+ :type '(choice (const :tag "Don't resolve" nil)
+ (const :tag "Resolve" t)
+ (const :tag "Resolve and maybe unstage all files"
+ unstage-maybe))
+ :version "25.1")
(defcustom vc-git-program "git"
"Name of the Git executable (excluding any arguments)."
:version "24.1"
- :type 'string
- :group 'vc-git)
+ :type 'string)
(defcustom vc-git-root-log-format
'("%d%h..: %an %ad %s"
@@ -150,7 +163,6 @@ format string (which is passed to \"git log\" via the argument
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))
- :group 'vc-git
:version "24.1")
(defvar vc-git-commits-coding-system 'utf-8
@@ -236,29 +248,32 @@ matching the resulting Git log output, and KEYWORDS is a list of
(vc-git--state-code diff-letter)))
(if (vc-git--empty-db-p) 'added 'up-to-date))))
-(defun vc-git-working-revision (file)
+(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
- (let* (process-file-side-effects
- (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
- (vc-file-setprop file 'vc-git-detached (null str))
- (if str
- (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
- (match-string 2 str)
- str)
- (vc-git--rev-parse "HEAD"))))
-
-(defun vc-git-workfile-unchanged-p (file)
- (eq 'up-to-date (vc-git-state file)))
+ (let (process-file-side-effects)
+ (vc-git--rev-parse "HEAD")))
+
+(defun vc-git--symbolic-ref (file)
+ (or
+ (vc-file-getprop file 'vc-git-symbolic-ref)
+ (let* (process-file-side-effects
+ (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
+ (vc-file-setprop file 'vc-git-symbolic-ref
+ (if str
+ (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
+ (match-string 2 str)
+ str))))))
(defun vc-git-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file))
- (detached (vc-file-getprop file 'vc-git-detached))
+ (disp-rev (or (vc-git--symbolic-ref file)
+ (substring rev 0 7)))
(def-ml (vc-default-mode-line-string 'Git file))
- (help-echo (get-text-property 0 'help-echo def-ml)))
- (propertize (if detached
- (substring def-ml 0 (- 7 (length rev)))
- def-ml)
+ (help-echo (get-text-property 0 'help-echo def-ml))
+ (face (get-text-property 0 'face def-ml)))
+ (propertize (replace-regexp-in-string (concat rev "\\'") disp-rev def-ml t t)
+ 'face face
'help-echo (concat help-echo "\nCurrent revision: " rev))))
(cl-defstruct (vc-git-extra-fileinfo
@@ -299,12 +314,12 @@ matching the resulting Git log output, and KEYWORDS is a list of
(pcase old-type
(?\100 " (type change file -> symlink)")
(?\160 " (type change subproject -> symlink)")
- (t " (symlink)")))
+ (_ " (symlink)")))
(?\160 ;; Subproject.
(pcase old-type
(?\100 " (type change file -> subproject)")
(?\120 " (type change symlink -> subproject)")
- (t " (subproject)")))
+ (_ " (subproject)")))
(?\110 nil) ;; Directory (internal, not a real git state).
(?\000 ;; Deleted or unknown.
(pcase old-type
@@ -380,8 +395,7 @@ or an empty string if none."
(goto-char (point-min))
(pcase stage
(`update-index
- (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
- (if files 'ls-files-up-to-date 'diff-index))))
+ (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added 'diff-index)))
(`ls-files-added
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
@@ -390,7 +404,7 @@ or an empty string if none."
(push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
result))))
(`ls-files-up-to-date
- (setq next-stage 'diff-index)
+ (setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
(name (match-string 2)))
@@ -409,7 +423,7 @@ or an empty string if none."
(vc-git-create-extra-fileinfo 0 0))
result)))
(`diff-index
- (setq next-stage 'ls-files-unknown)
+ (setq next-stage (if files 'ls-files-up-to-date 'ls-files-unknown))
(while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
nil t 1)
@@ -477,18 +491,14 @@ or an empty string if none."
(`diff-index
(vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
- (vc-exec-after
- `(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
+ (vc-run-delayed
+ (vc-git-after-dir-status-stage stage files update-function)))
-(defun vc-git-dir-status (_dir update-function)
+(defun vc-git-dir-status-files (_dir files update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
- (vc-git-dir-status-goto-stage 'update-index nil update-function))
-
-(defun vc-git-dir-status-files (_dir files _default-state update-function)
- "Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
(defvar vc-git-stash-map
@@ -521,7 +531,7 @@ or an empty string if none."
:help "Show the contents of the current stash"))
map))
-(defun vc-git-dir-extra-headers (_dir)
+(defun vc-git-dir-extra-headers (dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
@@ -559,6 +569,11 @@ or an empty string if none."
(propertize remote-url
'face 'font-lock-variable-name-face)))
"\n"
+ ;; For now just a heading, key bindings can be added later for various bisect actions
+ (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir)))
+ (propertize "Bisect : in progress\n" 'face 'font-lock-warning-face))
+ (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
+ (propertize "Rebase : in progress\n" 'face 'font-lock-warning-face))
(if stash
(concat
(propertize "Stash :\n" 'face 'font-lock-type-face
@@ -599,7 +614,7 @@ The car of the list is the current branch."
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional _rev _comment)
+(defun vc-git-register (files &optional _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
@@ -619,6 +634,7 @@ The car of the list is the current branch."
(declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-toggle-header "log-edit" (header value))
(declare-function log-edit-extract-headers "log-edit" (headers string))
+(declare-function log-edit-set-header "log-edit" (header value &optional toggle))
(defun vc-git-log-edit-toggle-signoff ()
"Toggle whether to add the \"Signed-off-by\" line at the end of
@@ -636,7 +652,17 @@ If toggling on, also insert its message into the buffer."
(insert (with-output-to-string
(vc-git-command
standard-output 1 nil
- "log" "--max-count=1" "--pretty=format:%B" "HEAD")))))
+ "log" "--max-count=1" "--pretty=format:%B" "HEAD")))
+ (save-excursion
+ (rfc822-goto-eoh)
+ (forward-line 1)
+ (let ((pt (point)))
+ (and (zerop (forward-line 1))
+ (looking-at "\n\\|\\'")
+ (let ((summary (buffer-substring-no-properties pt (1- (point)))))
+ (skip-chars-forward " \n")
+ (delete-region pt (point))
+ (log-edit-set-header "Summary" summary)))))))
(defvar vc-git-log-edit-mode-map
(let ((map (make-sparse-keymap "Git-Log-Edit")))
@@ -648,12 +674,19 @@ If toggling on, also insert its message into the buffer."
"Major mode for editing Git log messages.
It is based on `log-edit-mode', and has Git-specific extensions.")
-(defun vc-git-checkin (files _rev comment)
- (let ((coding-system-for-write vc-git-commits-coding-system))
+(defun vc-git-checkin (files comment &optional _rev)
+ (let* ((file1 (or (car files) default-directory))
+ (root (vc-git-root file1))
+ (default-directory (expand-file-name root))
+ (only (or (cdr files)
+ (not (equal root (abbreviate-file-name file1)))))
+ (coding-system-for-write vc-git-commits-coding-system))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
- (apply 'vc-git-command nil 0 files
+ ;; When operating on the whole tree, better pass "-a" than ".", since "."
+ ;; fails when we're committing a merge.
+ (apply 'vc-git-command nil 0 (if only files)
(nconc (list "commit" "-m")
(log-edit-extract-headers
`(("Author" . "--author")
@@ -661,7 +694,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
("Amend" . ,(boolean-arg-fn "--amend"))
("Sign-Off" . ,(boolean-arg-fn "--signoff")))
comment)
- (list "--only" "--"))))))
+ (if only (list "--only" "--") '("-a")))))))
(defun vc-git-find-revision (file rev buffer)
(let* (process-file-side-effects
@@ -680,28 +713,12 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
nil
"cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
-(defun vc-git-ignore (file &optional directory remove)
- "Ignore FILE under Git.
-If DIRECTORY is non-nil, the repository to use will be deduced by
-DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
- (let (gitignore)
- (if directory
- (setq gitignore (vc-git-find-ignore-file directory))
- (setq gitignore (vc-git-find-ignore-file default-directory)))
- (if remove
- (vc--remove-regexp file gitignore)
- (vc--add-line file gitignore))))
-
-(defun vc-git-ignore-completion-table (file)
- "Return the list of ignored files."
- (vc--read-lines (vc-git-find-ignore-file file)))
-
(defun vc-git-find-ignore-file (file)
"Return the root directory of the repository of FILE."
(expand-file-name ".gitignore"
(vc-git-root file)))
-(defun vc-git-checkout (file &optional _editable rev)
+(defun vc-git-checkout (file &optional rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
@@ -715,29 +732,45 @@ DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
'(("^ \\(.+\\) |" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
-(defun vc-git-pull (prompt)
- "Pull changes into the current Git branch.
-Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
-for the Git command to run."
+;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
+(declare-function vc-compilation-mode "vc-dispatcher" (backend))
+
+(defun vc-git--pushpull (command prompt)
+ "Run COMMAND (a string; either push or pull) on the current Git branch.
+If PROMPT is non-nil, prompt for the Git command to run."
(let* ((root (vc-git-root default-directory))
(buffer (format "*vc-git : %s*" (expand-file-name root)))
- (command "pull")
(git-program vc-git-program)
args)
;; If necessary, prompt for the exact command.
+ ;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt
(setq args (split-string
- (read-shell-command "Git pull command: "
- (format "%s pull" git-program)
- 'vc-git-history)
+ (read-shell-command
+ (format "Git %s command: " command)
+ (format "%s %s" git-program command)
+ 'vc-git-history)
" " t))
(setq git-program (car args)
command (cadr args)
args (cddr args)))
+ (require 'vc-dispatcher)
(apply 'vc-do-async-command buffer root git-program command args)
- (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
+ (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
+(defun vc-git-pull (prompt)
+ "Pull changes into the current Git branch.
+Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
+for the Git command to run."
+ (vc-git--pushpull "pull" prompt))
+
+(defun vc-git-push (prompt)
+ "Push changes from the current Git branch.
+Normally, this runs \"git push\". If PROMPT is non-nil, prompt
+for the Git command to run."
+ (vc-git--pushpull "push" prompt))
+
(defun vc-git-merge-branch ()
"Merge changes into the current Git branch.
This prompts for a branch to merge from."
@@ -755,9 +788,61 @@ This prompts for a branch to merge from."
nil t)))
(apply 'vc-do-async-command buffer root vc-git-program "merge"
(list merge-source))
- (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
+ (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
+(defun vc-git-conflicted-files (directory)
+ "Return the list of files with conflicts in DIRECTORY."
+ (let* ((status
+ (vc-git--run-command-string directory "status" "--porcelain" "--"))
+ (lines (when status (split-string status "\n" 'omit-nulls)))
+ files)
+ ;; TODO: Look into reimplementing `vc-git-state', as well as
+ ;; `vc-git-dir-status-files', based on this output, thus making the
+ ;; extra process call in `vc-git-find-file-hook' unnecessary.
+ (dolist (line lines files)
+ (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?"
+ line)
+ (let ((state (match-string 1 line))
+ (file (match-string 2 line)))
+ ;; See git-status(1).
+ (when (member state '("AU" "UD" "UA" ;; "DD"
+ "DU" "AA" "UU"))
+ (push (expand-file-name file directory) files)))))))
+
+(defun vc-git-resolve-when-done ()
+ "Call \"git add\" if the conflict markers have been removed."
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward "^<<<<<<< " nil t)
+ (vc-git-command nil 0 buffer-file-name "add")
+ (unless (or
+ (not (eq vc-git-resolve-conflicts 'unstage-maybe))
+ ;; Doing a merge, so bug#20292 doesn't apply.
+ (file-exists-p (expand-file-name ".git/MERGE_HEAD"
+ (vc-git-root buffer-file-name)))
+ (vc-git-conflicted-files (vc-git-root buffer-file-name)))
+ (vc-git-command nil 0 nil "reset"))
+ ;; Remove the hook so that it is not called multiple times.
+ (remove-hook 'after-save-hook 'vc-git-resolve-when-done t))))
+
+(defun vc-git-find-file-hook ()
+ "Activate `smerge-mode' if there is a conflict."
+ (when (and buffer-file-name
+ ;; FIXME
+ ;; 1) the net result is to call git twice per file.
+ ;; 2) v-g-c-f is documented to take a directory.
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html
+ (vc-git-conflicted-files buffer-file-name)
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^<<<<<<< " nil 'noerror)))
+ (vc-file-setprop buffer-file-name 'vc-state 'conflict)
+ (smerge-start-session)
+ (when vc-git-resolve-conflicts
+ (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local))
+ (message "There are unresolved conflicts in this file")))
+
;;; HISTORY FUNCTIONS
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -831,7 +916,7 @@ If LIMIT is non-nil, show no more than this many entries."
(if (not (eq vc-log-view-type 'long))
(cadr vc-git-root-log-format)
"^commit *\\([0-9a-z]+\\)"))
- ;; Allow expanding short log entries
+ ;; Allow expanding short log entries.
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
@@ -881,23 +966,113 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-expanded-log-entry (revision)
(with-temp-buffer
- (apply 'vc-git-command t nil nil (list "log" revision "-1"))
+ (apply 'vc-git-command t nil nil (list "log" revision "-1" "--"))
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
(indent-region (point-min) (point-max) 2)
(buffer-string))))
+(defun vc-git-region-history (file buffer lfrom lto)
+ ;; The "git log" command below interprets the line numbers as applying
+ ;; to the HEAD version of the file, not to the current state of the file.
+ ;; So we need to look at all the local changes and adjust lfrom/lto
+ ;; accordingly.
+ ;; FIXME: Maybe this should be done in vc.el (i.e. for all backends), but
+ ;; since Git is the only backend to support this operation so far, it's hard
+ ;; to tell.
+ (with-temp-buffer
+ (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
+ (goto-char (point-min))
+ (let ((last-offset 0)
+ (from-offset nil)
+ (to-offset nil))
+ (while (re-search-forward
+ "^@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@" nil t)
+ (let ((headno (string-to-number (match-string 1)))
+ (headcnt (string-to-number (match-string 2)))
+ (curno (string-to-number (match-string 3)))
+ (curcnt (string-to-number (match-string 4))))
+ (cl-assert (equal (- curno headno) last-offset))
+ (and (null from-offset) (> curno lfrom)
+ (setq from-offset last-offset))
+ (and (null to-offset) (> curno lto)
+ (setq to-offset last-offset))
+ (setq last-offset
+ (- (+ curno curcnt) (+ headno headcnt)))))
+ (setq lto (- lto (or to-offset last-offset)))
+ (setq lfrom (- lfrom (or to-offset last-offset)))))
+ (vc-git-command buffer 'async nil "log" "-p" ;"--follow" ;FIXME: not supported?
+ (format "-L%d,%d:%s" lfrom lto (file-relative-name file))))
+
+(require 'diff-mode)
+
+(defvar vc-git-region-history-mode-map
+ (let ((map (make-composed-keymap
+ nil (make-composed-keymap
+ (list diff-mode-map vc-git-log-view-mode-map)))))
+ map))
+
+(defvar vc-git--log-view-long-font-lock-keywords nil)
+(defvar font-lock-keywords)
+(defvar vc-git-region-history-font-lock-keywords
+ `((vc-git-region-history-font-lock)))
+
+(defun vc-git-region-history-font-lock (limit)
+ (let ((in-diff (save-excursion
+ (beginning-of-line)
+ (or (looking-at "^\\(?:diff\\|commit\\)\\>")
+ (re-search-backward "^\\(?:diff\\|commit\\)\\>" nil t))
+ (eq ?d (char-after (match-beginning 0))))))
+ (while
+ (let ((end (save-excursion
+ (if (re-search-forward "\n\\(diff\\|commit\\)\\>"
+ limit t)
+ (match-beginning 1)
+ limit))))
+ (let ((font-lock-keywords (if in-diff diff-font-lock-keywords
+ vc-git--log-view-long-font-lock-keywords)))
+ (font-lock-fontify-keywords-region (point) end))
+ (goto-char end)
+ (prog1 (< (point) limit)
+ (setq in-diff (eq ?d (char-after))))))
+ nil))
+
+(define-derived-mode vc-git-region-history-mode
+ vc-git-log-view-mode "Git-Region-History"
+ "Major mode to browse Git's \"log -p\" output."
+ (setq-local vc-git--log-view-long-font-lock-keywords
+ log-view-font-lock-keywords)
+ (setq-local font-lock-defaults
+ (cons 'vc-git-region-history-font-lock-keywords
+ (cdr font-lock-defaults))))
+
+
(autoload 'vc-switches "vc")
-(defun vc-git-diff (files &optional rev1 rev2 buffer)
+(defun vc-git-diff (files &optional rev1 rev2 buffer async)
"Get a difference report using Git between two revisions of FILES."
- (let (process-file-side-effects)
- (apply #'vc-git-command (or buffer "*vc-diff*") 1 files
- (if (and rev1 rev2) "diff-tree" "diff-index")
- "--exit-code"
- (append (vc-switches 'git 'diff)
- (list "-p" (or rev1 "HEAD") rev2 "--")))))
+ (let (process-file-side-effects
+ (command "diff-tree"))
+ (if rev2
+ ;; Diffing against the empty tree.
+ (unless rev1 (setq rev1 "4b825dc642cb6eb9a060e54bf8d69288fbee4904"))
+ (setq command "diff-index")
+ (unless rev1 (setq rev1 "HEAD")))
+ (if vc-git-diff-switches
+ (apply #'vc-git-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ files
+ command
+ "--exit-code"
+ (append (vc-switches 'git 'diff)
+ (list "-p" (or rev1 "HEAD") rev2 "--")))
+ (vc-git-command (or buffer "*vc-diff*") 1 files
+ "difftool" "--exit-code" "--no-prompt" "-x"
+ (concat "diff "
+ (mapconcat 'identity
+ (vc-switches nil 'diff) " "))
+ rev1 rev2 "--"))))
(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
@@ -918,21 +1093,25 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-annotate-command (file buf &optional rev)
(let ((name (file-relative-name file)))
- (vc-git-command buf 'async nil "blame" "--date=iso" "-C" "-C" rev "--" name)))
+ (apply #'vc-git-command buf 'async nil "blame" "--date=short"
+ (append (vc-switches 'git 'annotate)
+ (list rev "--" name)))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-git-annotate-time ()
- (and (re-search-forward "[0-9a-f]+[^()]+(.* \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\) +[0-9]+) " nil t)
+ (and (re-search-forward "^[0-9a-f^]+[^()]+(.*?\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\(:?\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\)\\)? *[0-9]+) " nil t)
(vc-annotate-convert-time
(apply #'encode-time (mapcar (lambda (match)
- (string-to-number (match-string match)))
+ (if (match-beginning match)
+ (string-to-number (match-string match))
+ 0))
'(6 5 4 3 2 1 7))))))
(defun vc-git-annotate-extract-revision-at-line ()
(save-excursion
- (move-beginning-of-line 1)
- (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
+ (beginning-of-line)
+ (when (looking-at "\\^?\\([0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
(let ((revision (match-string-no-properties 1)))
(if (match-beginning 2)
(let ((fname (match-string-no-properties 3)))
@@ -976,7 +1155,11 @@ or BRANCH^ (where \"^\" can be repeated)."
(point)
(1- (point-max)))))))
(or (vc-git-symbolic-commit prev-rev) prev-rev))
- (vc-git--rev-parse (concat rev "^"))))
+ ;; We used to use "^" here, but that fails on MS-Windows if git is
+ ;; invoked via a batch file, in which case cmd.exe strips the "^"
+ ;; because it is a special character for cmd which process-file
+ ;; does not (and cannot) quote.
+ (vc-git--rev-parse (concat rev "~1"))))
(defun vc-git--rev-parse (rev)
(with-temp-buffer
@@ -1087,7 +1270,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
(setq command
- (grep-expand-template "git grep -n -e <R> -- <F>"
+ (grep-expand-template "git --no-pager grep -n -e <R> -- <F>"
regexp files))
(when command
(if (equal current-prefix-arg '(4))
@@ -1181,11 +1364,15 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-stash-apply-at-point ()
(interactive)
- (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
+ (let (vc-dir-buffers) ; Small optimization.
+ (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
+ (vc-dir-refresh))
(defun vc-git-stash-pop-at-point ()
(interactive)
- (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
+ (let (vc-dir-buffers) ; Likewise.
+ (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
+ (vc-dir-refresh))
(defun vc-git-stash-menu (e)
(interactive "e")
@@ -1198,8 +1385,18 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
"A wrapper around `vc-do-command' for use in vc-git.el.
The difference to vc-do-command is that this function always invokes
`vc-git-program'."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
- file-or-list (cons "--no-pager" flags)))
+ (let ((coding-system-for-read vc-git-commits-coding-system)
+ (coding-system-for-write vc-git-commits-coding-system))
+ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
+ ;; http://debbugs.gnu.org/16897
+ (unless (and (not (cdr-safe file-or-list))
+ (let ((file (or (car-safe file-or-list)
+ file-or-list)))
+ (and file
+ (eq ?/ (aref file (1- (length file))))
+ (equal file (vc-git-root file)))))
+ file-or-list)
+ (cons "--no-pager" flags))))
(defun vc-git--empty-db-p ()
"Check if the git db is empty (no commit done yet)."
@@ -1212,6 +1409,8 @@ The difference to vc-do-command is that this function always invokes
;; directories. We enable `inhibit-null-byte-detection', otherwise
;; Tramp's eol conversion might be confused.
(let ((inhibit-null-byte-detection t)
+ (coding-system-for-read vc-git-commits-coding-system)
+ (coding-system-for-write vc-git-commits-coding-system)
(process-environment (cons "PAGER=" process-environment)))
(apply 'process-file vc-git-program nil buffer nil command args)))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 68d98a60f98..f9957c1afff 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1,9 +1,9 @@
;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
;; Author: Ivan Kanis
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: vc tools
;; Package: vc
@@ -43,29 +43,22 @@
;; STATE-QUERYING FUNCTIONS
;; * registered (file) OK
;; * state (file) OK
-;; - state-heuristic (file) NOT NEEDED
-;; - dir-status (dir update-function) OK
-;; - dir-status-files (dir files ds uf) OK
+;; - dir-status-files (dir files uf) OK
;; - dir-extra-headers (dir) OK
;; - dir-printer (fileinfo) OK
;; * working-revision (file) OK
-;; - latest-on-branch-p (file) ??
;; * checkout-model (files) OK
-;; - workfile-unchanged-p (file) OK
;; - mode-line-string (file) NOT NEEDED
;; STATE-CHANGING FUNCTIONS
;; * register (files &optional rev comment) OK
;; * create-repo () OK
-;; - init-revision () NOT NEEDED
;; - responsible-p (file) OK
-;; - could-register (file) OK
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
-;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT
+;; - unregister (file) OK
;; * checkin (files rev comment) OK
;; * find-revision (file rev buffer) OK
-;; * checkout (file &optional editable rev) OK
+;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
-;; - rollback (files) ?? PROBABLY NOT NEEDED
;; - merge (file rev1 rev2) NEEDED
;; - merge-news (file) NEEDED
;; - steal-lock (file &optional revision) NOT NEEDED
@@ -82,15 +75,13 @@
;; - annotate-current-time () NOT NEEDED
;; - annotate-extract-revision-at-line () OK
;; TAG SYSTEM
-;; - create-tag (dir name branchp) NEEDED
-;; - retrieve-tag (dir name update) NEEDED
+;; - create-tag (dir name branchp) OK
+;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS
;; MISCELLANEOUS
;; - make-version-backups-p (file) ??
-;; - repository-hostname (dirname) ??
;; - previous-revision (file rev) OK
;; - next-revision (file rev) OK
;; - check-headers () ??
-;; - clear-headers () ??
;; - delete-file (file) TEST IT
;; - rename-file (old new) OK
;; - find-file-hook () added for bug#10709
@@ -140,18 +131,36 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "23.1"
:group 'vc-hg)
+(defcustom vc-hg-annotate-switches nil
+ "String or list of strings specifying switches for hg annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-hg)
+
(defcustom vc-hg-program "hg"
"Name of the Mercurial executable (excluding any arguments)."
:type 'string
:group 'vc-hg)
(defcustom vc-hg-root-log-format
- '("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n"
- "^\\([0-9]+\\):\\([^:]*\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
+ `(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}"
+ ":{bookmarks}:{tags}:{author|person}"
+ " {date|shortdate} {desc|firstline}\\n")
+ ,(concat "^\\(?:[+@o x|-]*\\)" ;Graph data.
+ "\\([0-9]+\\):\\([^:]*\\)"
+ ":\\([^:]*\\):\\([^:]*\\):\\(.*?\\)"
+ "[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)")
((1 'log-view-message-face)
- (2 'change-log-list)
- (3 'change-log-name)
- (4 'change-log-date)))
+ (2 'change-log-file)
+ (3 'change-log-list)
+ (4 'change-log-conditionals)
+ (5 'change-log-name)
+ (6 'change-log-date)))
"Mercurial log template for `vc-hg-print-log' short format.
This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE
is the \"--template\" argument string to pass to Mercurial,
@@ -160,7 +169,7 @@ output, and KEYWORDS is a list of `font-lock-keywords' for
highlighting the Log View buffer."
:type '(list string string (repeat sexp))
:group 'vc-hg
- :version "24.1")
+ :version "24.5")
;;; Properties of the backend
@@ -188,6 +197,7 @@ highlighting the Log View buffer."
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
+ (setq file (expand-file-name file))
(let*
((status nil)
(default-directory (file-name-directory file))
@@ -200,9 +210,10 @@ highlighting the Log View buffer."
;; Ignore all errors.
(let ((process-environment
;; Avoid localization of messages so we
- ;; can parse the output.
- (append (list "TERM=dumb" "LANGUAGE=C")
- process-environment)))
+ ;; can parse the output. Disable pager.
+ (append
+ (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
+ process-environment)))
(process-file
vc-hg-program nil t nil
"--config" "alias.status=status"
@@ -211,30 +222,28 @@ highlighting the Log View buffer."
;; Some problem happened. E.g. We can't find an `hg'
;; executable.
(error nil)))))))
- (when (eq 0 status)
- (when (null (string-match ".*: No such file or directory$" out))
- (let ((state (aref out 0)))
- (cond
- ((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)
- ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
- (t 'up-to-date)))))))
+ (when (and (eq 0 status)
+ (> (length out) 0)
+ (null (string-match ".*: No such file or directory$" out)))
+ (let ((state (aref out 0)))
+ (cond
+ ((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)
+ ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
+ (t 'up-to-date))))))
(defun vc-hg-working-revision (file)
"Hg-specific version of `vc-working-revision'."
- (let ((default-directory (if (file-directory-p file)
- (file-name-as-directory file)
- (file-name-directory file))))
- (ignore-errors
- (with-output-to-string
- (process-file vc-hg-program nil standard-output nil
- "log" "-l" "1" "--template" "{rev}"
- (file-relative-name file))))))
+ (or (ignore-errors
+ (with-output-to-string
+ (vc-hg-command standard-output 0 file
+ "parent" "--template" "{rev}")))
+ "0"))
;;; History functions
@@ -247,6 +256,17 @@ highlighting the Log View buffer."
(autoload 'vc-setup-buffer "vc-dispatcher")
+(defvar vc-hg-log-graph nil
+ "If non-nil, use `--graph' in the short log output.")
+
+(defvar vc-hg-log-format (concat "changeset: {rev}:{node|short}\n"
+ "{tags % 'tag: {tag}\n'}"
+ "{if(parents, 'parents: {parents}\n')}"
+ "user: {author}\n"
+ "Date: {date|date}\n"
+ "summary: {desc|tabindent}\n\n")
+ "Mercurial log template for `vc-hg-print-log' long format.")
+
(defun vc-hg-print-log (files buffer &optional shortlog start-revision limit)
"Print commit log associated with FILES into specified BUFFER.
If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'.
@@ -260,11 +280,15 @@ If LIMIT is non-nil, show no more than this many entries."
(let ((inhibit-read-only t))
(with-current-buffer
buffer
- (apply 'vc-hg-command buffer 0 files "log"
+ (apply 'vc-hg-command buffer 'async files "log"
(nconc
(when start-revision (list (format "-r%s:0" start-revision)))
(when limit (list "-l" (format "%s" limit)))
- (when shortlog (list "--template" (car vc-hg-root-log-format)))
+ (if shortlog
+ `(,@(if vc-hg-log-graph '("--graph"))
+ "--template"
+ ,(car vc-hg-root-log-format))
+ `("--template" ,vc-hg-log-format))
vc-hg-log-switches)))))
(defvar log-view-message-re)
@@ -281,6 +305,7 @@ If LIMIT is non-nil, show no more than this many entries."
(if (eq vc-log-view-type 'short)
(cadr vc-hg-root-log-format)
"^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
+ (set (make-local-variable 'tab-width) 2)
;; Allow expanding short log entries
(when (eq vc-log-view-type 'short)
(setq truncate-lines t)
@@ -310,7 +335,7 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-hg-diff (files &optional oldvers newvers buffer)
+(defun vc-hg-diff (files &optional oldvers newvers buffer async)
"Get a difference report using hg between two revisions of FILES."
(let* ((firstfile (car files))
(working (and firstfile (vc-working-revision firstfile))))
@@ -318,7 +343,10 @@ If LIMIT is non-nil, show no more than this many entries."
(setq oldvers nil))
(when (and (not oldvers) newvers)
(setq oldvers working))
- (apply #'vc-hg-command (or buffer "*vc-diff*") nil files "diff"
+ (apply #'vc-hg-command
+ (or buffer "*vc-diff*")
+ (if async 'async nil)
+ files "diff"
(append
(vc-switches 'hg 'diff)
(when oldvers
@@ -328,7 +356,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-hg-expanded-log-entry (revision)
(with-temp-buffer
- (vc-hg-command t nil nil "log" "-r" revision)
+ (vc-hg-command t nil nil "log" "-r" revision "--template" vc-hg-log-format)
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
@@ -352,10 +380,11 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-hg-annotate-command (file buffer &optional revision)
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
- (vc-hg-command buffer 0 file "annotate" "-d" "-n" "--follow"
- (when revision (concat "-r" revision))))
+ (apply #'vc-hg-command buffer 0 file "annotate" "-d" "-n" "--follow"
+ (append (vc-switches 'hg 'annotate)
+ (if revision (list (concat "-r" revision))))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
;; The format for one line output by "hg annotate -d -n" looks like this:
;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS
@@ -379,8 +408,26 @@ Optional arg REVISION is a revision to annotate from."
(if (match-beginning 3)
(match-string-no-properties 1)
(cons (match-string-no-properties 1)
- (expand-file-name (match-string-no-properties 4)
- (vc-hg-root default-directory)))))))
+ (expand-file-name (match-string-no-properties 4)
+ (vc-hg-root default-directory)))))))
+
+;;; Tag system
+
+(defun vc-hg-create-tag (dir name branchp)
+ "Attach the tag NAME to the state of the working copy."
+ (let ((default-directory dir))
+ (and (vc-hg-command nil 0 nil "status")
+ (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name))))
+
+(defun vc-hg-retrieve-tag (dir name _update)
+ "Retrieve the version tagged by NAME of all registered files at or below DIR."
+ (let ((default-directory dir))
+ (vc-hg-command nil 0 nil "update" name)
+ ;; FIXME: update buffers if `update' is true
+ ;; TODO: update *vc-change-log* buffer so can see @ if --graph
+ ))
+
+;;; Miscellaneous
(defun vc-hg-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
@@ -413,10 +460,8 @@ Optional arg REVISION is a revision to annotate from."
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional _rev _comment)
- "Register FILES under hg.
-REV is ignored.
-COMMENT is ignored."
+(defun vc-hg-register (files &optional _comment)
+ "Register FILES under hg. COMMENT is ignored."
(vc-hg-command nil 0 files "add"))
(defun vc-hg-create-repo ()
@@ -425,25 +470,13 @@ COMMENT is ignored."
(defalias 'vc-hg-responsible-p 'vc-hg-root)
-;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-could-register (file)
- "Return non-nil if FILE could be registered under hg."
- (and (vc-hg-responsible-p file) ; shortcut
- (condition-case ()
- (with-temp-buffer
- (vc-hg-command t nil file "add" "--dry-run"))
- ;; The command succeeds with no output if file is
- ;; registered.
- (error))))
-
-;; FIXME: This would remove the file. Is that correct?
-;; (defun vc-hg-unregister (file)
-;; "Unregister FILE from hg."
-;; (vc-hg-command nil nil file "remove"))
+(defun vc-hg-unregister (file)
+ "Unregister FILE from hg."
+ (vc-hg-command nil 0 file "forget"))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files _rev comment)
+(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
@@ -459,29 +492,13 @@ REV is ignored."
(vc-hg-command buffer 0 file "cat" "-r" rev)
(vc-hg-command buffer 0 file "cat"))))
-(defun vc-hg-ignore (file &optional directory remove)
- "Ignore FILE under Mercurial.
-If DIRECTORY is non-nil, the repository to use will be deduced by
-DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
- (let (hgignore)
- (if directory
- (setq hgignore (vc-hg-find-ignore-file directory))
- (setq hgignore (vc-hg-find-ignore-file default-directory)))
- (if remove
- (vc--remove-regexp file hgignore)
- (vc--add-line file hgignore))))
-
-(defun vc-hg-ignore-completion-table (file)
- "Return the list of ignored files."
- (vc--read-lines (vc-hg-find-ignore-file file)))
-
(defun vc-hg-find-ignore-file (file)
"Return the root directory of the repository of FILE."
(expand-file-name ".hgignore"
(vc-hg-root file)))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional _editable rev)
+(defun vc-hg-checkout (file &optional rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
@@ -522,10 +539,6 @@ REV is the revision to check out into WORKFILE."
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-workfile-unchanged-p (file)
- (eq 'up-to-date (vc-hg-state file)))
-
-;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-revert (file &optional contents-done)
(unless contents-done
(with-temp-buffer (vc-hg-command t 0 file "revert"))))
@@ -622,15 +635,12 @@ REV is the revision to check out into WORKFILE."
;; Follows vc-exec-after.
(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
-(defun vc-hg-dir-status (dir update-function)
- (vc-hg-command (current-buffer) 'async dir "status" "-C")
- (vc-exec-after
- `(vc-hg-after-dir-status (quote ,update-function))))
-
-(defun vc-hg-dir-status-files (dir files _default-state update-function)
- (apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
- (vc-exec-after
- `(vc-hg-after-dir-status (quote ,update-function))))
+(defun vc-hg-dir-status-files (dir files update-function)
+ (apply 'vc-hg-command (current-buffer) 'async dir "status"
+ (concat "-mardu" (if files "i"))
+ "-C" files)
+ (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)
@@ -660,20 +670,6 @@ REV is the revision to check out into WORKFILE."
(vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
remote-location)))
-(declare-function log-view-get-marked "log-view" ())
-
-;; XXX maybe also add key bindings for these functions.
-(defun vc-hg-push ()
- (interactive)
- (let ((marked-list (log-view-get-marked)))
- (if marked-list
- (apply #'vc-hg-command
- nil 0 nil
- "push"
- (apply 'nconc
- (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
- (error "No log entries selected for push"))))
-
(defvar vc-hg-error-regexp-alist nil
;; 'hg pull' does not list modified files, so, for now, the only
;; benefit of `vc-compilation-mode' is that one can get rid of
@@ -683,57 +679,77 @@ REV is the revision to check out into WORKFILE."
"Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
(autoload 'vc-do-async-command "vc-dispatcher")
+(autoload 'log-view-get-marked "log-view")
-(defun vc-hg-pull (prompt)
- "Issue a Mercurial pull command.
-If called interactively with a set of marked Log View buffers,
-call \"hg pull -r REVS\" to pull in the specified revisions REVS.
-
-With a prefix argument or if PROMPT is non-nil, prompt for a
-specific Mercurial pull command. The default is \"hg pull -u\",
-which fetches changesets from the default remote repository and
-then attempts to update the working directory."
- (interactive "P")
+(defun vc-hg--pushpull (command prompt &optional obsolete)
+ "Run COMMAND (a string; either push or pull) on the current Hg branch.
+If PROMPT is non-nil, prompt for the Hg command to run.
+If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull
+commands, which only operated on marked files."
(let (marked-list)
- ;; The `vc-hg-pull' command existed before the `pull' VC action
- ;; was implemented. Keep it for backward compatibility.
- (if (and (called-interactively-p 'interactive)
- (setq marked-list (log-view-get-marked)))
+ ;; The `vc-hg-pull' and `vc-hg-push' commands existed before the
+ ;; `pull'/`push' VC actions were implemented.
+ ;; The following is for backwards compatibility.
+ (if (and obsolete (setq marked-list (log-view-get-marked)))
(apply #'vc-hg-command
nil 0 nil
- "pull"
+ command
(apply 'nconc
- (mapcar (lambda (arg) (list "-r" arg))
- marked-list)))
+ (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
- (command "pull")
(hg-program vc-hg-program)
;; Fixme: before updating the working copy to the latest
;; state, should check if it's visiting an old revision.
- (args '("-u")))
+ (args (if (equal command "pull") '("-u"))))
;; If necessary, prompt for the exact command.
+ ;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt
(setq args (split-string
- (read-shell-command "Run Hg (like this): "
- (format "%s pull -u" hg-program)
- 'vc-hg-history)
+ (read-shell-command
+ (format "Hg %s command: " command)
+ (format "%s %s%s" hg-program command
+ (if (not args) ""
+ (concat " " (mapconcat 'identity args " "))))
+ 'vc-hg-history)
" " t))
(setq hg-program (car args)
command (cadr args)
args (cddr args)))
- (apply 'vc-do-async-command buffer root hg-program
- command args)
- (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
+ (apply 'vc-do-async-command buffer root hg-program command args)
+ (with-current-buffer buffer
+ (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
+(defun vc-hg-pull (prompt)
+ "Issue a Mercurial pull command.
+If called interactively with a set of marked Log View buffers,
+call \"hg pull -r REVS\" to pull in the specified revisions REVS.
+
+With a prefix argument or if PROMPT is non-nil, prompt for a
+specific Mercurial pull command. The default is \"hg pull -u\",
+which fetches changesets from the default remote repository and
+then attempts to update the working directory."
+ (interactive "P")
+ (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive)))
+
+(defun vc-hg-push (prompt)
+ "Push changes from the current Mercurial branch.
+Normally, this runs \"hg push\". If PROMPT is non-nil, prompt
+for the Hg command to run.
+
+If called interactively with a set of marked Log View buffers,
+call \"hg push -r REVS\" to push the specified revisions REVS."
+ (interactive "P")
+ (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive)))
+
(defun vc-hg-merge-branch ()
"Merge incoming changes into the current working directory.
This runs the command \"hg merge\"."
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
- (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
+ (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
;;; Internal functions
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index c47bc4c7f97..3e6d2a95051 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -1,6 +1,6 @@
;;; vc-hooks.el --- resident support for version-control
-;; Copyright (C) 1992-1996, 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1996, 1998-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -32,6 +32,69 @@
(eval-when-compile (require 'cl-lib))
+;; Faces
+
+(defgroup vc-state-faces nil
+ "Faces used in the mode line by the VC state indicator."
+ :group 'vc-faces
+ :group 'mode-line
+ :version "25.1")
+
+(defface vc-state-base-face
+ '((default))
+ "Base face for VC state indicator."
+ :group 'vc-faces
+ :group 'mode-line
+ :version "25.1")
+
+(defface vc-up-to-date-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is up to date."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-needs-update-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file needs update."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-locked-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file locked."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-locally-added-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is locally added."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-conflict-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file contains merge conflicts."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-removed-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file was removed from the VC system."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-missing-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is missing from the file system."
+ :version "25.1"
+ :group 'vc-faces)
+
+(defface vc-edited-state
+ '((default :inherit vc-state-base-face))
+ "Face for VC modeline state when the file is up to date."
+ :version "25.1"
+ :group 'vc-faces)
+
;; Customization Variables (the rest is in vc.el)
(defcustom vc-ignore-dir-regexp
@@ -44,8 +107,8 @@ interpreted as hostnames."
:type 'regexp
:group 'vc)
-(defcustom vc-handled-backends '(RCS CVS SVN SCCS Bzr Git Hg Mtn Arch)
- ;; RCS, CVS, SVN and SCCS come first because they are per-dir
+(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn)
+ ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir
;; rather than per-tree. RCS comes first because of the multibackend
;; support intended to use RCS for local commits (with a remote CVS server).
"List of version control backends for which VC will be used.
@@ -55,13 +118,14 @@ Removing an entry from the list prevents VC from being activated
when visiting a file managed by that backend.
An empty list disables VC altogether."
:type '(repeat symbol)
- :version "23.1"
+ :version "25.1"
:group 'vc)
;; Note: we don't actually have a darcs back end yet.
-;; Also, Meta-CVS (corresponding to MCVS) is unsupported.
+;; Also, Meta-CVS (corresponding to MCVS) and Arch are unsupported.
+;; The Arch back end will be retrieved and fixed if it is ever required.
(defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS"
- ".svn" ".git" ".hg" ".bzr"
+ ".src" ".svn" ".git" ".hg" ".bzr"
"_MTN" "_darcs" "{arch}"))
"List of directory names to be ignored when walking directory trees."
:type '(repeat string)
@@ -100,87 +164,6 @@ Otherwise, not displayed."
:type 'boolean
:group 'vc)
-(defcustom vc-keep-workfiles t
- "Whether to keep work files on disk after commits, on a locking VCS.
-This variable has no effect on modern merging-based version
-control systems."
- :type 'boolean
- :group 'vc)
-
-;; If you fix bug#11490, probably you can set this back to nil.
-(defcustom vc-mistrust-permissions t
- "If non-nil, don't assume permissions/ownership track version-control status.
-If nil, do rely on the permissions.
-See also variable `vc-consult-headers'."
- :version "24.3" ; nil->t, bug#11490
- :type 'boolean
- :group 'vc)
-
-(defun vc-mistrust-permissions (file)
- "Internal access function to variable `vc-mistrust-permissions' for FILE."
- (or (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions
- (vc-backend-subdirectory-name file)))))
-
-(defcustom vc-stay-local 'only-file
- "Non-nil means use local operations when possible for remote repositories.
-This avoids slow queries over the network and instead uses heuristics
-and past information to determine the current status of a file.
-
-If value is the symbol `only-file', `vc-dir' will connect to the
-server, but heuristics will be used to determine the status for
-all other VC operations.
-
-The value can also be a regular expression or list of regular
-expressions to match against the host name of a repository; then VC
-only stays local for hosts that match it. Alternatively, the value
-can be a list of regular expressions where the first element is the
-symbol `except'; then VC always stays local except for hosts matched
-by these regular expressions."
- :type '(choice
- (const :tag "Always stay local" t)
- (const :tag "Only for file operations" only-file)
- (const :tag "Don't stay local" nil)
- (list :format "\nExamine hostname and %v" :tag "Examine hostname ..."
- (set :format "%v" :inline t (const :format "%t" :tag "don't" except))
- (regexp :format " stay local,\n%t: %v" :tag "if it matches")
- (repeat :format "%v%i\n" :inline t (regexp :tag "or"))))
- :version "23.1"
- :group 'vc)
-
-(defun vc-stay-local-p (file &optional backend)
- "Return non-nil if VC should stay local when handling FILE.
-This uses the `repository-hostname' backend operation.
-If FILE is a list of files, return non-nil if any of them
-individually should stay local."
- (if (listp file)
- (delq nil (mapcar (lambda (arg) (vc-stay-local-p arg backend)) file))
- (setq backend (or backend (vc-backend file)))
- (let* ((sym (vc-make-backend-sym backend 'stay-local))
- (stay-local (if (boundp sym) (symbol-value sym) vc-stay-local)))
- (if (symbolp stay-local) stay-local
- (let ((dirname (if (file-directory-p file)
- (directory-file-name file)
- (file-name-directory file))))
- (eq 'yes
- (or (vc-file-getprop dirname 'vc-stay-local-p)
- (vc-file-setprop
- dirname 'vc-stay-local-p
- (let ((hostname (vc-call-backend
- backend 'repository-hostname dirname)))
- (if (not hostname)
- 'no
- (let ((default t))
- (if (eq (car-safe stay-local) 'except)
- (setq default nil stay-local (cdr stay-local)))
- (when (consp stay-local)
- (setq stay-local
- (mapconcat 'identity stay-local "\\|")))
- (if (if (string-match stay-local hostname)
- default (not default))
- 'yes 'no))))))))))))
-
;;; This is handled specially now.
;; Tell Emacs about this new kind of minor mode
;; (add-to-list 'minor-mode-alist '(vc-mode vc-mode))
@@ -190,6 +173,11 @@ individually should stay local."
(make-variable-buffer-local 'vc-mode)
(put 'vc-mode 'permanent-local t)
+;;; We signal this error when we try to do something a VC backend
+;;; doesn't support. Two arguments: the method that's not supported
+;;; and the backend
+(define-error 'vc-not-supported "VC method not implemented for backend")
+
(defun vc-mode (&optional _arg)
;; Dummy function for C-h m
"Version Control minor mode.
@@ -268,10 +256,10 @@ It is usually called via the `vc-call' macro."
(setq f (vc-find-backend-function backend function-name))
(push (cons function-name f) (get backend 'vc-functions)))
(cond
- ((null f)
- (error "Sorry, %s is not implemented for %s" function-name backend))
- ((consp f) (apply (car f) (cdr f) args))
- (t (apply f args)))))
+ ((null f)
+ (signal 'vc-not-supported (list function-name backend)))
+ ((consp f) (apply (car f) (cdr f) args))
+ (t (apply f args)))))
(defmacro vc-call (fun file &rest args)
"A convenience macro for calling VC backend functions.
@@ -386,33 +374,20 @@ If the argument is a list, the files must all have the same back end."
"Return where the repository for the current directory is kept."
(symbol-name (vc-backend file)))
-(defun vc-name (file)
- "Return the master name of FILE.
-If the file is not registered, or the master name is not known, return nil."
- ;; TODO: This should ultimately become obsolete, at least up here
- ;; in vc-hooks.
- (or (vc-file-getprop file 'vc-name)
- ;; force computation of the property by calling
- ;; vc-BACKEND-registered explicitly
- (let ((backend (vc-backend file)))
- (if (and backend
- (vc-call-backend backend 'registered file))
- (vc-file-getprop file 'vc-name)))))
-
(defun vc-checkout-model (backend files)
"Indicate how FILES are checked out.
If FILES are not registered, this function always returns nil.
For registered files, the possible values are:
- 'implicit FILES are always writable, and checked out `implicitly'
+ `implicit' FILES are always writable, and checked out `implicitly'
when the user saves the first changes to the file.
- 'locking FILES are read-only if up-to-date; user must type
+ `locking' FILES are read-only if up-to-date; user must type
\\[vc-next-action] before editing. Strict locking
is assumed.
- 'announce FILES are read-only if up-to-date; user must type
+ `announce' FILES are read-only if up-to-date; user must type
\\[vc-next-action] before editing. But other users
may be editing at the same time."
(vc-call-backend backend 'checkout-model files))
@@ -441,10 +416,10 @@ For registered files, the possible values are:
A return of nil from this function means we have no information on the
status of this file. Otherwise, the value returned is one of:
- 'up-to-date The working file is unmodified with respect to the
+ `up-to-date' The working file is unmodified with respect to the
latest version on the current branch, and not locked.
- 'edited The working file has been edited by the user. If
+ `edited' The working file has been edited by the user. If
locking is used for the file, this state means that
the current version is locked by the calling user.
This status should *not* be reported for files
@@ -454,44 +429,44 @@ status of this file. Otherwise, the value returned is one of:
USER The current version of the working file is locked by
some other USER (a string).
- 'needs-update The file has not been edited by the user, but there is
+ `needs-update' The file has not been edited by the user, but there is
a more recent version on the current branch stored
in the repository.
- 'needs-merge The file has been edited by the user, and there is also
+ `needs-merge' The file has been edited by the user, and there is also
a more recent version on the current branch stored in
the repository. This state can only occur if locking
is not used for the file.
- 'unlocked-changes The working version of the file is not locked,
+ `unlocked-changes' The working version of the file is not locked,
but the working file has been changed with respect
to that version. This state can only occur for files
with locking; it represents an erroneous condition that
should be resolved by the user (vc-next-action will
prompt the user to do it).
- 'added Scheduled to go into the repository on the next commit.
+ `added' Scheduled to go into the repository on the next commit.
Often represented by vc-working-revision = \"0\" in VCSes
with monotonic IDs like Subversion and Mercurial.
- 'removed Scheduled to be deleted from the repository on next commit.
+ `removed' Scheduled to be deleted from the repository on next commit.
- 'conflict The file contains conflicts as the result of a merge.
+ `conflict' The file contains conflicts as the result of a merge.
For now the conflicts are text conflicts. In the
future this might be extended to deal with metadata
conflicts too.
- 'missing The file is not present in the file system, but the VC
+ `missing' The file is not present in the file system, but the VC
system still tracks it.
- 'ignored The file showed up in a dir-status listing with a flag
+ `ignored' The file showed up in a dir-status listing with a flag
indicating the version-control system is ignoring it,
Note: This property is not set reliably (some VCSes
don't have useful directory-status commands) so assume
that any file with vc-state nil might be ignorable
without VC knowing it.
- 'unregistered The file is not under version control."
+ `unregistered' The file is not under version control."
;; Note: in Emacs 22 and older, return of nil meant the file was
;; unregistered. This is potentially a source of
@@ -501,7 +476,7 @@ status of this file. Otherwise, the value returned is one of:
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
(when (> (length file) 0) ;Why?? --Stef
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-state-refresh file backend)))))
@@ -509,57 +484,18 @@ status of this file. Otherwise, the value returned is one of:
"Quickly recompute the `state' of FILE."
(vc-file-setprop
file 'vc-state
- (vc-call-backend backend 'state-heuristic file)))
+ (vc-call-backend backend 'state file)))
(defsubst vc-up-to-date-p (file)
"Convenience function that checks whether `vc-state' of FILE is `up-to-date'."
(eq (vc-state file) 'up-to-date))
-(defun vc-default-state-heuristic (backend file)
- "Default implementation of vc-BACKEND-state-heuristic.
-It simply calls the real state computation function `vc-BACKEND-state'
-and does not employ any heuristic at all."
- (vc-call-backend backend 'state file))
-
-(defun vc-workfile-unchanged-p (file)
- "Return non-nil if FILE has not changed since the last checkout."
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- ;; This is a shortcut for determining when the workfile is
- ;; unchanged. It can fail under some circumstances; see the
- ;; discussion in bug#694.
- (if (and checkout-time
- ;; Tramp and Ange-FTP return this when they don't know the time.
- (not (equal lastmod '(0 0))))
- (equal checkout-time lastmod)
- (let ((unchanged (vc-call workfile-unchanged-p file)))
- (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
- unchanged))))
-
-(defun vc-default-workfile-unchanged-p (backend file)
- "Check if FILE is unchanged by diffing against the repository version.
-Return non-nil if FILE is unchanged."
- (zerop (condition-case err
- ;; If the implementation supports it, let the output
- ;; go to *vc*, not *vc-diff*, since this is an internal call.
- (vc-call-backend backend 'diff (list file) nil nil "*vc*")
- (wrong-number-of-arguments
- ;; If this error came from the above call to vc-BACKEND-diff,
- ;; try again without the optional buffer argument (for
- ;; backward compatibility). Otherwise, resignal.
- (if (or (not (eq (cadr err)
- (indirect-function
- (vc-find-backend-function backend 'diff))))
- (not (eq (cl-caddr err) 4)))
- (signal (car err) (cdr err))
- (vc-call-backend backend 'diff (list file)))))))
-
(defun vc-working-revision (file &optional backend)
"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
- (setq backend (or backend (vc-backend file)))
+ (setq backend (or backend (vc-responsible-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
(vc-call-backend backend 'working-revision file))))))
@@ -579,9 +515,10 @@ If FILE is not registered, this function always returns nil."
(put backend 'vc-templates-grabbed t))
(let ((result (vc-check-master-templates file (symbol-value sym))))
(if (stringp result)
- (vc-file-setprop file 'vc-name result)
+ (vc-file-setprop file 'vc-master-name result)
nil)))) ; Not registered
+;;;###autoload
(defun vc-possible-master (s dirname basename)
(cond
((stringp s) (format s dirname basename))
@@ -628,8 +565,15 @@ this function."
(throw 'found trial))))
templates))))
-(define-obsolete-function-alias
- 'vc-toggle-read-only 'toggle-read-only "24.1")
+
+;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made
+;; obsolete earlier, it is ok for the latter to be an alias to the former,
+;; since the latter will be removed first. We can't just make it
+;; an alias for read-only-mode, since that is not 100% the same.
+(defalias 'vc-toggle-read-only 'toggle-read-only)
+(make-obsolete 'vc-toggle-read-only
+ "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)."
+ "24.1")
(defun vc-default-make-version-backups-p (_backend _file)
"Return non-nil if unmodified versions should be backed up locally.
@@ -788,33 +732,42 @@ This function assumes that the file is registered."
(let* ((backend-name (symbol-name backend))
(state (vc-state file backend))
(state-echo nil)
+ (face nil)
(rev (vc-working-revision file backend)))
(propertize
(cond ((or (eq state 'up-to-date)
(eq state 'needs-update))
(setq state-echo "Up to date file")
+ (setq face 'vc-up-to-date-state)
(concat backend-name "-" rev))
((stringp state)
(setq state-echo (concat "File locked by" state))
+ (setq face 'vc-locked-state)
(concat backend-name ":" state ":" rev))
((eq state 'added)
(setq state-echo "Locally added file")
+ (setq face 'vc-locally-added-state)
(concat backend-name "@" rev))
((eq state 'conflict)
(setq state-echo "File contains conflicts after the last merge")
+ (setq face 'vc-conflict-state)
(concat backend-name "!" rev))
((eq state 'removed)
(setq state-echo "File removed from the VC system")
+ (setq face 'vc-removed-state)
(concat backend-name "!" rev))
((eq state 'missing)
(setq state-echo "File tracked by the VC system, but missing from the file system")
+ (setq face 'vc-missing-state)
(concat backend-name "?" rev))
(t
;; Not just for the 'edited state, but also a fallback
;; for all other states. Think about different symbols
;; for 'needs-update and 'needs-merge.
(setq state-echo "Locally modified file")
+ (setq face 'vc-edited-state)
(concat backend-name ":" rev)))
+ 'face face
'help-echo (concat state-echo " under the " backend-name
" version control system"))))
@@ -837,8 +790,9 @@ current, and kill the buffer that visits the link."
(defun vc-default-find-file-hook (_backend)
nil)
-(defun vc-find-file-hook ()
- "Function for `find-file-hook' activating VC mode if appropriate."
+(defun vc-refresh-state ()
+ "Activate or deactivate VC mode as appropriate."
+ (interactive)
;; Recompute whether file is version controlled,
;; if user has killed the buffer and revisited.
(when vc-mode
@@ -885,18 +839,19 @@ current, and kill the buffer that visits the link."
(vc-follow-link)
(message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
+ (vc-refresh-state))
(t
(if (yes-or-no-p (format
"Symbolic link to %s-controlled source file; follow link? " link-type))
(progn (vc-follow-link)
(message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
+ (vc-refresh-state))
(message
"Warning: editing through the link bypasses version control")
)))))))))
-(add-hook 'find-file-hook 'vc-find-file-hook)
+(add-hook 'find-file-hook #'vc-refresh-state)
+(define-obsolete-function-alias 'vc-find-file-hook 'vc-refresh-state "25.1")
(defun vc-kill-buffer-hook ()
"Discard VC info about a file when we kill its buffer."
@@ -915,7 +870,6 @@ current, and kill the buffer that visits the link."
(let ((map (make-sparse-keymap)))
(define-key map "a" 'vc-update-change-log)
(define-key map "b" 'vc-switch-backend)
- (define-key map "c" 'vc-rollback)
(define-key map "d" 'vc-dir)
(define-key map "g" 'vc-annotate)
(define-key map "G" 'vc-ignore)
@@ -931,9 +885,12 @@ current, and kill the buffer that visits the link."
(define-key map "u" 'vc-revert)
(define-key map "v" 'vc-next-action)
(define-key map "+" 'vc-update)
+ ;; I'd prefer some kind of symmetry with vc-update:
+ (define-key map "P" 'vc-push)
(define-key map "=" 'vc-diff)
(define-key map "D" 'vc-root-diff)
(define-key map "~" 'vc-revision-other-window)
+ (define-key map "x" 'vc-delete-file)
map))
(fset 'vc-prefix-map vc-prefix-map)
(define-key ctl-x-map "v" 'vc-prefix-map)
@@ -984,16 +941,13 @@ current, and kill the buffer that visits the link."
'(menu-item "Insert Header" vc-insert-headers
:help "Insert headers into a file for use with a version control system.
"))
- (bindings--define-key map [undo]
- '(menu-item "Undo Last Check-In" vc-rollback
- :enable (let ((backend (if buffer-file-name
- (vc-backend buffer-file-name))))
- (or (not backend)
- (vc-find-backend-function backend 'rollback)))
- :help "Remove the most recent changeset committed to the repository"))
(bindings--define-key map [vc-revert]
'(menu-item "Revert to Base Version" vc-revert
:help "Revert working copies of the selected file set to their repository contents"))
+ ;; TODO Only :enable if (vc-find-backend-function backend 'push)
+ (bindings--define-key map [vc-push]
+ '(menu-item "Push Changes" vc-push
+ :help "Push the current branch's changes"))
(bindings--define-key map [vc-update]
'(menu-item "Update to Latest Version" vc-update
:help "Update the current fileset's files to their tip revisions"))
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 29996fafe92..b56a08f2a9e 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -1,6 +1,6 @@
;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*-
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: vc
@@ -49,6 +49,17 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "23.1"
:group 'vc-mtn)
+(defcustom vc-mtn-annotate-switches nil
+ "String or list of strings specifying switches for mtn annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :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."
@@ -79,13 +90,17 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-mtn-checkout-model (_files) 'implicit)
(defun vc-mtn-root (file)
- (setq file (if (file-directory-p file)
+ (setq file (expand-file-name file)
+ file (if (file-directory-p file)
(file-name-as-directory file)
(file-name-directory file)))
(or (vc-file-getprop file 'vc-mtn-root)
(vc-file-setprop file 'vc-mtn-root
(vc-find-root file vc-mtn-admin-format))))
+(defun vc-mtn-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (expand-file-name vc-mtn-admin-dir (vc-mtn-root file)))
(defun vc-mtn-registered (file)
(let ((root (vc-mtn-root file)))
@@ -123,13 +138,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
((match-end 2) (push (list (match-string 3) 'added) result))))
(funcall update-function result)))
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
+;; dir-status-files called from vc-dir, which loads vc,
+;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-mtn-dir-status (dir update-function)
+(defun vc-mtn-dir-status-files (dir _files update-function)
(vc-mtn-command (current-buffer) 'async dir "status")
- (vc-exec-after
- `(vc-mtn-after-dir-status (quote ,update-function))))
+ (vc-run-delayed
+ (vc-mtn-after-dir-status update-function)))
(defun vc-mtn-working-revision (file)
;; If `mtn' fails or returns status>0, or if the search fails, just
@@ -151,9 +167,6 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)")
(match-string 1))))
-(defun vc-mtn-workfile-unchanged-p (file)
- (not (eq (vc-mtn-state file) 'edited)))
-
;; Mode-line rewrite code copied from vc-arch.el.
(defcustom vc-mtn-mode-line-rewrite
@@ -166,25 +179,27 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
(defun vc-mtn-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let ((branch (vc-mtn-workfile-branch file)))
- (dolist (rule vc-mtn-mode-line-rewrite)
- (if (string-match (car rule) branch)
- (setq branch (replace-match (cdr rule) t nil branch))))
- (format "Mtn%c%s"
- (pcase (vc-state file)
- ((or `up-to-date `needs-update) ?-)
- (`added ?@)
- (_ ?:))
- branch)))
-
-(defun vc-mtn-register (files &optional _rev _comment)
+ (if branch
+ (progn
+ (dolist (rule vc-mtn-mode-line-rewrite)
+ (if (string-match (car rule) branch)
+ (setq branch (replace-match (cdr rule) t nil branch))))
+ (format "Mtn%c%s"
+ (pcase (vc-state file)
+ ((or `up-to-date `needs-update) ?-)
+ (`added ?@)
+ (_ ?:))
+ branch))
+ "")))
+
+(defun vc-mtn-register (files &optional _comment)
(vc-mtn-command nil 0 files "add"))
(defun vc-mtn-responsible-p (file) (vc-mtn-root file))
-(defun vc-mtn-could-register (file) (vc-mtn-root file))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-mtn-checkin (files _rev comment)
+(defun vc-mtn-checkin (files comment &optional _rev)
(apply 'vc-mtn-command nil 0 files
(nconc (list "commit" "-m")
(log-edit-extract-headers '(("Author" . "--author")
@@ -192,18 +207,18 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
comment))))
(defun vc-mtn-find-revision (file rev buffer)
- (vc-mtn-command buffer 0 file "cat" "-r" rev))
+ ;; null rev means latest revision
+ (if rev
+ (vc-mtn-command buffer 0 file "cat" "-r" rev)
+ (vc-mtn-command buffer 0 file "cat")))
-;; (defun vc-mtn-checkout (file &optional editable rev)
+;; (defun vc-mtn-checkout (file &optional rev)
;; )
(defun vc-mtn-revert (file &optional contents-done)
(unless contents-done
(vc-mtn-command nil 0 file "revert")))
-;; (defun vc-mtn-rollback (files)
-;; )
-
(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit)
"Print commit logs associated with FILES into specified BUFFER.
_SHORTLOG is ignored.
@@ -238,18 +253,21 @@ If LIMIT is non-nil, show no more than this many entries."
(autoload 'vc-switches "vc")
-(defun vc-mtn-diff (files &optional rev1 rev2 buffer)
+(defun vc-mtn-diff (files &optional rev1 rev2 buffer async)
"Get a difference report using monotone between two revisions of FILES."
- (apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff"
+ (apply 'vc-mtn-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ files "diff"
(append
(vc-switches 'mtn 'diff)
(if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2)))))
(defun vc-mtn-annotate-command (file buf &optional rev)
- (apply 'vc-mtn-command buf 'async file "annotate"
- (if rev (list "-r" rev))))
+ (apply #'vc-mtn-command buf 'async file "annotate"
+ (append (vc-switches 'mtn 'annotate)
+ (if rev (list "-r" rev)))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defconst vc-mtn-annotate-full-re
"^ *\\([0-9a-f]+\\)\\.* by [^ ]+ \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\): ")
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index e85494b2156..ba1336424ea 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1,6 +1,6 @@
-;;; vc-rcs.el --- support for RCS version-control
+;;; vc-rcs.el --- support for RCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -76,7 +76,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches."
:version "21.1"
:group 'vc-rcs)
-(defcustom vc-rcs-header '("\$Id\$")
+(defcustom vc-rcs-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:type '(repeat string)
:version "24.1" ; no longer consult the obsolete vc-header-alist
@@ -149,70 +149,18 @@ For a description of possible values, see `vc-check-master-templates'."
'vc-working-revision))))
(if (not (eq state 'up-to-date))
state
- (if (vc-workfile-unchanged-p file)
+ (if (vc-rcs-workfile-unchanged-p file)
'up-to-date
(if (eq (vc-rcs-checkout-model (list file)) 'locking)
'unlocked-changes
'edited))))))
-(defun vc-rcs-state-heuristic (file)
- "State heuristic for RCS."
- (let (vc-rcs-headers-result)
- (if (and vc-consult-headers
- (setq vc-rcs-headers-result
- (vc-rcs-consult-headers file))
- (eq vc-rcs-headers-result 'rev-and-lock))
- (let ((state (vc-file-getprop file 'vc-state)))
- ;; If the headers say that the file is not locked, the
- ;; permissions can tell us whether locking is used for
- ;; the file or not.
- (if (and (eq state 'up-to-date)
- (not (vc-mistrust-permissions file))
- (file-exists-p file))
- (cond
- ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'implicit)
- (setq state
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking))))
- state)
- (if (not (vc-mistrust-permissions file))
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (cond ((and permissions (string-match ".r-..-..-." permissions))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- 'up-to-date)
- ((and permissions (string-match ".rw..-..-." permissions))
- (if (eq (vc-rcs-checkout-model file) 'locking)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- (if (vc-rcs-workfile-is-newer file)
- 'edited
- 'up-to-date)))
- (t
- ;; Strange permissions. Fall through to
- ;; expensive state computation.
- (vc-rcs-state file))))
- (vc-rcs-state file)))))
-
(autoload 'vc-expand-dirs "vc")
-(defun vc-rcs-dir-status (dir update-function)
- ;; FIXME: this function should be rewritten or `vc-expand-dirs'
- ;; should be changed to take a backend parameter. Using
- ;; `vc-expand-dirs' is not TRTD because it returns files from
- ;; multiple backends. It should also return 'unregistered files.
-
- ;; Doing individual vc-state calls is painful but there
- ;; is no better way in RCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(defun vc-rcs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'RCS)
@@ -229,6 +177,8 @@ For a description of possible values, see `vc-check-master-templates'."
(vc-rcs-fetch-master-state file)
(vc-file-getprop file 'vc-working-revision))))
+(autoload 'vc-master-name "vc-filewise")
+
(defun vc-rcs-latest-on-branch-p (file &optional version)
"Return non-nil if workfile version of FILE is the latest on its branch.
When VERSION is given, perform check for that version."
@@ -238,15 +188,15 @@ When VERSION is given, perform check for that version."
(if (vc-rcs-trunk-p version)
(progn
;; Compare VERSION to the head version number.
- (vc-insert-file (vc-name file) "^[0-9]")
+ (vc-insert-file (vc-master-name file) "^[0-9]")
(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
;; If we are not on the trunk, we need to examine the
;; whole current branch.
- (vc-insert-file (vc-name file) "^desc")
+ (vc-insert-file (vc-master-name file) "^desc")
(vc-rcs-find-most-recent-rev (vc-branch-part version))))))
(defun vc-rcs-workfile-unchanged-p (file)
- "RCS-specific implementation of `vc-workfile-unchanged-p'."
+ "Has FILE remained unchanged since last checkout?"
;; Try to use rcsdiff --brief. If rcsdiff does not understand that,
;; do a double take and remember the fact for the future
(let* ((version (concat "-r" (vc-working-revision file)))
@@ -274,18 +224,13 @@ When VERSION is given, perform check for that version."
(autoload 'vc-switches "vc")
-(defun vc-rcs-register (files &optional rev comment)
+(defun vc-rcs-register (files &optional comment)
"Register FILES into the RCS version-control system.
-REV is the optional revision number for the files. COMMENT can be used
-to provide an initial description for each FILES.
+Automatically retrieve a read-only version of the file with keywords expanded.
+COMMENT can be used to provide an initial description for each FILES.
Passes either `vc-rcs-register-switches' or `vc-register-switches'
-to the RCS command.
-
-Automatically retrieve a read-only version of the file with keywords
-expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
+to the RCS command."
(let (subdir name)
- ;; When REV is specified, we need to force using "-t-".
- (when rev (unless comment (setq comment "")))
(dolist (file files)
(and (not (file-exists-p
(setq subdir (expand-file-name "RCS"
@@ -294,11 +239,13 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
nil ".*,v$" t))
(yes-or-no-p "Create RCS subdirectory? ")
(make-directory subdir))
- (apply 'vc-do-command "*vc*" 0 "ci" file
+ (apply #'vc-do-command "*vc*" 0 "ci" file
;; if available, use the secure registering option
(and (vc-rcs-release-p "5.6.4") "-i")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (and comment (concat "-t-" comment))
+ "-u"
+ ;; Some old MS-Windows ports of RCS crash when "ci -i" is
+ ;; invoked without -t; indulge them.
+ (concat "-t-" (or comment ""))
(vc-switches 'RCS 'register))
;; parse output to find master file name and workfile version
(with-current-buffer "*vc*"
@@ -309,9 +256,9 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(match-string 1))))
;; if we couldn't find the master name,
;; run vc-rcs-registered to get it
- ;; (will be stored into the vc-name property)
+ ;; (will be stored into the vc-master-name property)
(vc-rcs-registered file)
- (vc-file-setprop file 'vc-name
+ (vc-file-setprop file 'vc-master-name
(if (file-name-absolute-p name)
name
(expand-file-name
@@ -334,7 +281,7 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
(let ((checkout-model (vc-rcs-checkout-model (list file))))
- (vc-rcs-register file rev "")
+ (vc-rcs-register file "")
(when (eq checkout-model 'implicit)
(vc-rcs-set-non-strict-locking file))
(vc-rcs-set-default-branch file (concat rev ".1"))))
@@ -343,42 +290,43 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
"Unregister FILE from RCS.
If this leaves the RCS subdirectory empty, ask the user
whether to remove it."
- (let* ((master (vc-name file))
- (dir (file-name-directory master))
- (backup-info (find-backup-file-name master)))
- (if (not backup-info)
- (delete-file master)
- (rename-file master (car backup-info) 'ok-if-already-exists)
- (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
- (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
- "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
- (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
- (delete-directory dir))))
-
-(defun vc-rcs-checkin (files rev comment)
+ (unless (memq (vc-state file) '(nil unregistered))
+ (let* ((master (vc-master-name file))
+ (dir (file-name-directory master))
+ (backup-info (find-backup-file-name master)))
+ (if (not backup-info)
+ (delete-file master)
+ (rename-file master (car backup-info) 'ok-if-already-exists)
+ (dolist (f (cdr backup-info)) (ignore-errors (delete-file f))))
+ (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
+ "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
+ (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
+ (delete-directory dir)))))
+
+(defun vc-rcs-checkin (files comment &optional rev)
"RCS-specific version of `vc-backend-checkin'."
(let ((switches (vc-switches 'RCS 'checkin)))
;; Now operate on the files
- (dolist (file (vc-expand-dirs files))
+ (dolist (file (vc-expand-dirs files 'RCS))
(let ((old-version (vc-working-revision file)) new-version
(default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
;; Force branch creation if an appropriate
;; default branch has been set.
(and (not rev)
- default-branch
+ default-branch
(string-match (concat "^" (regexp-quote old-version) "\\.")
default-branch)
(setq rev default-branch)
(setq switches (cons "-f" switches)))
(if (and (not rev) old-version)
(setq rev (vc-branch-part old-version)))
- (apply 'vc-do-command "*vc*" 0 "ci" (vc-name file)
+ (apply #'vc-do-command "*vc*" 0 "ci" (vc-master-name file)
;; if available, use the secure check-in option
(and (vc-rcs-release-p "5.6.4") "-j")
- (concat (if vc-keep-workfiles "-u" "-r") rev)
+ (concat "-u" rev)
(concat "-m" comment)
switches)
(vc-file-setprop file 'vc-working-revision nil)
@@ -407,21 +355,21 @@ whether to remove it."
(if (not (vc-rcs-release-p "5.6.2"))
;; exit status of 1 is also accepted.
;; It means that the lock was removed before.
- (vc-do-command "*vc*" 1 "rcs" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcs" (vc-master-name file)
(concat "-u" old-version)))))))))
(defun vc-rcs-find-revision (file rev buffer)
- (apply 'vc-do-command
- (or buffer "*vc*") 0 "co" (vc-name file)
+ (apply #'vc-do-command
+ (or buffer "*vc*") 0 "co" (vc-master-name file)
"-q" ;; suppress diagnostic output
(concat "-p" rev)
(vc-switches 'RCS 'checkout)))
-(defun vc-rcs-checkout (file &optional editable rev)
+(defun vc-rcs-checkout (file &optional rev)
"Retrieve a copy of a saved version of FILE. If FILE is a directory,
attempt the checkout for all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-checkout (vc-expand-dirs (list file)))
+ (mapc 'vc-rcs-checkout (vc-expand-dirs (list file) 'RCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -443,12 +391,12 @@ attempt the checkout for all registered files beneath it."
(and rev (string= rev "")
(vc-rcs-set-default-branch file nil))
;; now do the checkout
- (apply 'vc-do-command
- "*vc*" 0 "co" (vc-name file)
+ (apply #'vc-do-command
+ "*vc*" 0 "co" (vc-master-name file)
;; If locking is not strict, force to overwrite
;; the writable workfile.
(if (eq (vc-rcs-checkout-model (list file)) 'implicit) "-f")
- (if editable "-l")
+ "-l"
(if (stringp rev)
;; a literal revision was specified
(concat "-r" rev)
@@ -483,56 +431,44 @@ attempt the checkout for all registered files beneath it."
new-version)))))
(message "Checking out %s...done" file))))))
-(defun vc-rcs-rollback (files)
- "Roll back, undoing the most recent checkins of FILES. Directories are
-expanded to all registered subfiles in them."
- (if (not files)
- (error "RCS backend doesn't support directory-level rollback"))
- (dolist (file (vc-expand-dirs files))
- (let* ((discard (vc-working-revision file))
- (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard)))
- (config (current-window-configuration))
- (done nil))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s." discard file)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-o" discard))
- ;; Check out the most recent remaining version. If it
- ;; fails, because the whole branch got deleted, do a
- ;; double-take and check out the version where the branch
- ;; started.
- (while (not done)
- (condition-case err
- (progn
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
- (concat "-u" previous))
- (setq done t))
- (error (set-buffer "*vc*")
- (goto-char (point-min))
- (if (search-forward "no side branches present for" nil t)
- (progn (setq previous (vc-branch-part previous))
- (vc-rcs-set-default-branch file previous)
- ;; vc-do-command popped up a window with
- ;; the error message. Get rid of it, by
- ;; restoring the old window configuration.
- (set-window-configuration config))
- ;; No, it was some other error: re-signal it.
- (signal (car err) (cdr err)))))))))
-
-(defun vc-rcs-revert (file &optional contents-done)
+(defun vc-rcs-revert (file &optional _contents-done)
"Revert FILE to the version it was based on. If FILE is a directory,
revert all registered files beneath it."
(if (file-directory-p file)
- (mapc 'vc-rcs-revert (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f"
+ (mapc 'vc-rcs-revert (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f"
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
+(defun vc-rcs-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file " from branch or revision: ")
+ (list file)
+ 'RCS))
+ second-revision)
+ (cond
+ ((string= first-revision "")
+ (error "A starting RCS revision is required"))
+ (t
+ (if (not (vc-branch-p first-revision))
+ (setq second-revision
+ (vc-read-revision
+ "Second RCS revision: "
+ (list file) 'RCS nil
+ (concat (vc-branch-part first-revision) ".")))
+ ;; We want to merge an entire branch. Set revisions
+ ;; accordingly, so that vc-rcs-merge understands us.
+ (setq second-revision first-revision)
+ ;; first-revision must be the starting point of the branch
+ (setq first-revision (vc-branch-part first-revision)))))
+ (vc-rcs-merge file first-revision second-revision)))
+
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
- (vc-do-command "*vc*" 1 "rcsmerge" (vc-name file)
+ (vc-do-command "*vc*" 1 "rcsmerge" (vc-master-name file)
"-kk" ; ignore keyword conflicts
(concat "-r" first-version)
(if second-version (concat "-r" second-version))))
@@ -542,17 +478,32 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
If FILE is a directory, steal the lock on all registered files beneath it.
Needs RCS 5.6.2 or later for -M."
(if (file-directory-p file)
- (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file)))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) "-M" (concat "-u" rev))
+ (mapc 'vc-rcs-steal-lock (vc-expand-dirs (list file) 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) "-M" (concat "-u" rev))
;; Do a real checkout after stealing the lock, so that we see
;; expanded headers.
- (vc-do-command "*vc*" 0 "co" (vc-name file) "-f" (concat "-l" rev))))
+ (vc-do-command "*vc*" 0 "co" (vc-master-name file) "-f" (concat "-l" rev))
+ ;; Must clear any headers here because they wouldn't
+ ;; show that the file is locked now.
+ (let* ((filename (or file buffer-file-name))
+ (visited (find-buffer-visiting filename)))
+ (if visited
+ (let ((context (vc-buffer-context)))
+ ;; save-excursion may be able to relocate point and mark
+ ;; properly. If it fails, vc-restore-buffer-context
+ ;; will give it a second try.
+ (save-excursion
+ (vc-rcs-clear-headers))
+ (vc-restore-buffer-context context))
+ (set-buffer (find-file-noselect filename))
+ (vc-rcs-clear-headers)
+ (kill-buffer filename)))))
(defun vc-rcs-modify-change-comment (files rev comment)
"Modify the change comments change on FILES on a specified REV. If FILE is a
directory the operation is applied to all registered files beneath it."
- (dolist (file (vc-expand-dirs files))
- (vc-do-command "*vc*" 0 "rcs" (vc-name file)
+ (dolist (file (vc-expand-dirs files 'RCS))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file)
(concat "-m" rev ":" comment))))
@@ -571,28 +522,32 @@ directory the operation is applied to all registered files beneath it."
(when (looking-at "[\b\t\n\v\f\r ]+")
(delete-char (- (match-end 0) (match-beginning 0))))))
-(defun vc-rcs-print-log (files buffer &optional shortlog
- start-revision-ignored limit)
+(defun vc-rcs-print-log (files buffer &optional _shortlog
+ _start-revision-ignored limit)
"Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored.
If FILE is a directory the operation is applied to all registered
files beneath it."
(vc-do-command (or buffer "*vc*") 0 "rlog"
- (mapcar 'vc-name (vc-expand-dirs files)))
+ (mapcar 'vc-master-name (vc-expand-dirs files 'RCS)))
(with-current-buffer (or buffer "*vc*")
(vc-rcs-print-log-cleanup))
(when limit 'limit-unsupported))
-(defun vc-rcs-diff (files &optional oldvers newvers buffer)
+(defun vc-rcs-diff (files &optional oldvers newvers buffer async)
"Get a difference report using RCS between two sets of files."
- (apply 'vc-do-command (or buffer "*vc-diff*")
- 1 ;; Always go synchronous, the repo is local
- "rcsdiff" (vc-expand-dirs files)
+ (apply #'vc-do-command (or buffer "*vc-diff*")
+ (if async 'async 1)
+ "rcsdiff" (vc-expand-dirs files 'RCS)
(append (list "-q"
(and oldvers (concat "-r" oldvers))
(and newvers (concat "-r" newvers)))
(vc-switches 'RCS 'diff))))
+(defun vc-rcs-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (vc-find-root file "RCS"))
+
(defun vc-rcs-comment-history (file)
"Return a string with all log entries stored in BACKEND for FILE."
(with-current-buffer "*vc*"
@@ -783,7 +738,7 @@ Optional arg REVISION is a revision to annotate from."
(cl-flet ((pad (w) (substring-no-properties padding w))
(render (rda &rest ls)
(propertize
- (apply 'concat
+ (apply #'concat
(format-time-string "%Y-%m-%d" (aref rda 1))
" "
(aref rda 0)
@@ -801,13 +756,13 @@ Optional arg REVISION is a revision to annotate from."
(insert (gethash (get-text-property (point) :vc-rcs-r/d/a) ht))
(forward-line 1))))
-(declare-function vc-annotate-convert-time "vc-annotate" (time))
+(declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
(defun vc-rcs-annotate-current-time ()
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time (current-time))))))
+ (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-rcs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
@@ -837,7 +792,7 @@ systime, or nil if there is none. Also, reposition point."
(vc-file-tree-walk
dir
(lambda (f)
- (vc-do-command "*vc*" 0 "rcs" (vc-name f) (concat "-n" name ":")))))))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name f) (concat "-n" name ":")))))))
;;;
@@ -853,7 +808,7 @@ systime, or nil if there is none. Also, reposition point."
(string-match "[0-9]+\\'" rev)
(substring rev (match-beginning 0) (match-end 0)))
-(defun vc-rcs-previous-revision (file rev)
+(defun vc-rcs-previous-revision (_file rev)
"Return the revision number immediately preceding REV for FILE,
or nil if there is no previous revision. This default
implementation works for MAJOR.MINOR-style revision numbers as
@@ -882,10 +837,9 @@ and CVS."
(minor-num (string-to-number (vc-rcs-minor-part rev))))
(concat branch "." (number-to-string (1+ minor-num))))))
-;; Note that most GNU/Linux distributions seem to supply rcs2log in a
-;; standard bin directory. Eg both Red Hat and Debian include it in
-;; their cvs packages. It's not obvious why Emacs still needs to
-;; provide it as well...
+;; You might think that this should be distributed with RCS, but
+;; apparently not. CVS sometimes provides a version of it.
+;; http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00288.html
(defvar vc-rcs-rcs2log-program
(let (exe)
(cond ((file-executable-p
@@ -931,7 +885,7 @@ Uses `rcs2log' which only works for RCS and CVS."
(unwind-protect
(progn
(setq default-directory odefault)
- (if (eq 0 (apply 'call-process vc-rcs-rcs2log-program
+ (if (eq 0 (apply #'call-process vc-rcs-rcs2log-program
nil (list t tempfile) nil
"-c" changelog
"-u" (concat login-name
@@ -958,7 +912,7 @@ Uses `rcs2log' which only works for RCS and CVS."
\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)))
(defun vc-rcs-clear-headers ()
- "Implementation of vc-clear-headers for RCS."
+ "Clear RCS header value parts."
(let ((case-fold-search nil))
(goto-char (point-min))
(while (re-search-forward
@@ -967,11 +921,11 @@ Uses `rcs2log' which only works for RCS and CVS."
nil t)
(replace-match "$\\1$"))))
-(autoload 'vc-rename-master "vc")
+(autoload 'vc-rename-master "vc-filewise")
(defun vc-rcs-rename-file (old new)
;; Just move the master file (using vc-rcs-master-templates).
- (vc-rename-master (vc-name old) new vc-rcs-master-templates))
+ (vc-rename-master (vc-master-name old) new vc-rcs-master-templates))
(defun vc-rcs-find-file-hook ()
;; If the file is locked by some other user, make
@@ -990,7 +944,7 @@ Uses `rcs2log' which only works for RCS and CVS."
This likely means that FILE has been changed with respect
to its master version."
(let ((file-time (nth 5 (file-attributes file)))
- (master-time (nth 5 (file-attributes (vc-name file)))))
+ (master-time (nth 5 (file-attributes (vc-master-name file)))))
(or (> (nth 0 file-time) (nth 0 master-time))
(and (= (nth 0 file-time) (nth 0 master-time))
(> (nth 1 file-time) (nth 1 master-time))))))
@@ -1016,74 +970,75 @@ otherwise determine the workfile version based on the master file.
This function sets the properties `vc-working-revision' and
`vc-checkout-model' to their correct values, based on the master
file."
- (with-temp-buffer
- (if (or (not (vc-insert-file (vc-name file) "^[0-9]"))
- (progn (goto-char (point-min))
- (not (looking-at "^head[ \t\n]+[^;]+;$"))))
- (error "File %s is not an RCS master file" (vc-name file)))
- (let ((workfile-is-latest nil)
- (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
- (vc-file-setprop file 'vc-rcs-default-branch default-branch)
- (unless working-revision
- ;; Workfile version not known yet. Determine that first. It
- ;; is either the head of the trunk, the head of the default
- ;; branch, or the "default branch" itself, if that is a full
- ;; revision number.
- (cond
- ;; no default branch
- ((or (not default-branch) (string= "" default-branch))
- (setq working-revision
- (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
- (setq workfile-is-latest t))
- ;; default branch is actually a revision
- ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
- default-branch)
- (setq working-revision default-branch))
- ;; else, search for the head of the default branch
- (t (vc-insert-file (vc-name file) "^desc")
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ (if (or (not (vc-insert-file (vc-master-name file) "^[0-9]"))
+ (progn (goto-char (point-min))
+ (not (looking-at "^head[ \t\n]+[^;]+;$"))))
+ (error "File %s is not an RCS master file" (vc-master-name file)))
+ (let ((workfile-is-latest nil)
+ (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
+ (vc-file-setprop file 'vc-rcs-default-branch default-branch)
+ (unless working-revision
+ ;; Workfile version not known yet. Determine that first. It
+ ;; is either the head of the trunk, the head of the default
+ ;; branch, or the "default branch" itself, if that is a full
+ ;; revision number.
+ (cond
+ ;; no default branch
+ ((or (not default-branch) (string= "" default-branch))
(setq working-revision
- (vc-rcs-find-most-recent-rev default-branch))
- (setq workfile-is-latest t)))
- (vc-file-setprop file 'vc-working-revision working-revision))
- ;; Check strict locking
- (goto-char (point-min))
- (vc-file-setprop file 'vc-checkout-model
- (if (re-search-forward ";[ \t\n]*strict;" nil t)
- 'locking 'implicit))
- ;; Compute state of workfile version
- (goto-char (point-min))
- (let ((locking-user
- (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
- (regexp-quote working-revision)
- "[^0-9.]")
- 1)))
- (cond
- ;; not locked
- ((not locking-user)
- (if (or workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- ;; workfile version is latest on branch
- 'up-to-date
- ;; workfile version is not latest on branch
- 'needs-update))
- ;; locked by the calling user
- ((and (stringp locking-user)
- (string= locking-user (vc-user-login-name file)))
- ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
- (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
- workfile-is-latest
- (vc-rcs-latest-on-branch-p file working-revision))
- 'edited
- ;; Locking is not used for the file, but the owner does
- ;; have a lock, and there is a higher version on the current
- ;; branch. Not sure if this can occur, and if it is right
- ;; to use `needs-merge' in this case.
- 'needs-merge))
- ;; locked by somebody else
- ((stringp locking-user)
- locking-user)
- (t
- (error "Error getting state of RCS file")))))))
+ (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
+ (setq workfile-is-latest t))
+ ;; default branch is actually a revision
+ ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
+ default-branch)
+ (setq working-revision default-branch))
+ ;; else, search for the head of the default branch
+ (t (vc-insert-file (vc-master-name file) "^desc")
+ (setq working-revision
+ (vc-rcs-find-most-recent-rev default-branch))
+ (setq workfile-is-latest t)))
+ (vc-file-setprop file 'vc-working-revision working-revision))
+ ;; Check strict locking
+ (goto-char (point-min))
+ (vc-file-setprop file 'vc-checkout-model
+ (if (re-search-forward ";[ \t\n]*strict;" nil t)
+ 'locking 'implicit))
+ ;; Compute state of workfile version
+ (goto-char (point-min))
+ (let ((locking-user
+ (vc-parse-buffer (concat "^locks[ \t\n]+[^;]*[ \t\n]+\\([^:]+\\):"
+ (regexp-quote working-revision)
+ "[^0-9.]")
+ 1)))
+ (cond
+ ;; not locked
+ ((not locking-user)
+ (if (or workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ ;; workfile version is latest on branch
+ 'up-to-date
+ ;; workfile version is not latest on branch
+ 'needs-update))
+ ;; locked by the calling user
+ ((and (stringp locking-user)
+ (string= locking-user (vc-user-login-name file)))
+ ;; Don't call `vc-rcs-checkout-model' to avoid inf-looping.
+ (if (or (eq (vc-file-getprop file 'vc-checkout-model) 'locking)
+ workfile-is-latest
+ (vc-rcs-latest-on-branch-p file working-revision))
+ 'edited
+ ;; Locking is not used for the file, but the owner does
+ ;; have a lock, and there is a higher version on the current
+ ;; branch. Not sure if this can occur, and if it is right
+ ;; to use `needs-merge' in this case.
+ 'needs-merge))
+ ;; locked by somebody else
+ ((stringp locking-user)
+ locking-user)
+ (t
+ (error "Error getting state of RCS file"))))))))
(defun vc-rcs-consult-headers (file)
"Search for RCS headers in FILE, and set properties accordingly.
@@ -1093,7 +1048,7 @@ Returns: nil if no headers were found
'rev-and-lock if revision and lock info was found"
(cond
((not (get-file-buffer file)) nil)
- ((let (status version locking-user)
+ ((let (status version)
(with-current-buffer (get-file-buffer file)
(save-excursion
(goto-char (point-min))
@@ -1119,11 +1074,11 @@ Returns: nil if no headers were found
(cond
;; unlocked revision
((looking-at "\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
;; revision is locked by some user
((looking-at "\\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
;; everything else: false
(nil)))
@@ -1141,50 +1096,30 @@ Returns: nil if no headers were found
(goto-char (point-min))
(if (re-search-forward (concat "\\$" "Locker:") nil t)
(cond ((looking-at " \\([^ ]+\\) \\$")
- (setq locking-user (match-string-no-properties 1))
+ ;;(setq locking-user (match-string-no-properties 1))
(setq status 'rev-and-lock))
((looking-at " *\\$")
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock))
(t
- (setq locking-user 'none)
+ ;;(setq locking-user 'none)
(setq status 'rev-and-lock)))
(setq status 'rev)))
;; else: nothing found
;; -------------------
(t nil))))
(if status (vc-file-setprop file 'vc-working-revision version))
- (and (eq status 'rev-and-lock)
- (vc-file-setprop file 'vc-state
- (cond
- ((eq locking-user 'none) 'up-to-date)
- ((string= locking-user (vc-user-login-name file))
- 'edited)
- (t locking-user)))
- ;; If the file has headers, we don't want to query the
- ;; master file, because that would eliminate all the
- ;; performance gain the headers brought us. We therefore
- ;; use a heuristic now to find out whether locking is used
- ;; for this file. If we trust the file permissions, and the
- ;; file is not locked, then if the file is read-only we
- ;; assume that locking is used for the file, otherwise
- ;; locking is not used.
- (not (vc-mistrust-permissions file))
- (vc-up-to-date-p file)
- (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'locking)
- (vc-file-setprop file 'vc-checkout-model 'implicit)))
status))))
(defun vc-release-greater-or-equal (r1 r2)
"Compare release numbers, represented as strings.
Release components are assumed cardinal numbers, not decimal fractions
-\(5.10 is a higher release than 5.9\). Omitted fields are considered
-lower \(5.6.7 is earlier than 5.6.7.1\). Comparison runs till the end
+\(5.10 is a higher release than 5.9). Omitted fields are considered
+lower \(5.6.7 is earlier than 5.6.7.1). Comparison runs till the end
of the string is found, or a non-numeric component shows up \(5.6.7 is
earlier than \"5.6.7 beta\", which is probably not what you want in
-some cases\). This code is suitable for existing RCS release numbers.
-CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)."
+some cases). This code is suitable for existing RCS release numbers.
+CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5)."
(let (v1 v2 i1 i2)
(catch 'done
(or (and (string-match "^\\.?\\([0-9]+\\)" r1)
@@ -1231,7 +1166,7 @@ variable `vc-rcs-release' is set to the returned value."
(set-file-modes file (logior (file-modes file) 128)))
(defun vc-rcs-set-default-branch (file branch)
- (vc-do-command "*vc*" 0 "rcs" (vc-name file) (concat "-b" branch))
+ (vc-do-command "*vc*" 0 "rcs" (vc-master-name file) (concat "-b" branch))
(vc-file-setprop file 'vc-rcs-default-branch branch))
(defun vc-rcs-parse (&optional buffer)
@@ -1336,11 +1271,10 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(to-one@ () (setq @-holes nil
b (progn (search-forward "@") (point))
e (progn (while (and (search-forward "@")
- (= ?@ (char-after))
- (progn
- (push (point) @-holes)
- (forward-char 1)
- (push (point) @-holes))))
+ (= ?@ (char-after)))
+ (push (point) @-holes)
+ (forward-char 1)
+ (push (point) @-holes))
(1- (point)))))
(tok+val (set-b+e name &optional proc)
(unless (eq name (setq tok (read buffer)))
@@ -1351,18 +1285,18 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(funcall proc)
(buffer-substring-no-properties b e))))
(k-semi (name &optional proc) (tok+val #'to-semi name proc))
- (gather () (let ((pairs `(,e ,@@-holes ,b))
- acc)
- (while pairs
- (push (buffer-substring-no-properties
- (cadr pairs) (car pairs))
- acc)
- (setq pairs (cddr pairs)))
- (apply 'concat acc)))
- (k-one@ (name &optional later) (tok+val #'to-one@ name
- (if later
- (lambda () t)
- #'gather))))
+ (gather (b e @-holes)
+ (let ((pairs `(,e ,@@-holes ,b))
+ acc)
+ (while pairs
+ (push (buffer-substring-no-properties
+ (cadr pairs) (car pairs))
+ acc)
+ (setq pairs (cddr pairs)))
+ (apply #'concat acc)))
+ (gather1 () (gather b e @-holes))
+ (k-one@ (name &optional later)
+ (tok+val #'to-one@ name (if later (lambda () t) #'gather1))))
(save-excursion
(goto-char (point-min))
;; headers
@@ -1409,7 +1343,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
;; same algorithm used in RCS 5.7.
(when (< (car ls) 100)
(setcar ls (+ 1900 (car ls))))
- (apply 'encode-time (nreverse ls)))))
+ (apply #'encode-time (nreverse ls)))))
,@(mapcar #'k-semi '(author state))
,(k-semi 'branches
(lambda ()
@@ -1443,6 +1377,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
(cl-flet ((incg (beg end)
(let ((b beg) (e end) @-holes)
(while (and asc (< (car asc) e))
+ (push (pop asc) @-holes)
(push (pop asc) @-holes))
;; Self-deprecate when work is done.
;; Folding many dimensions into one.
@@ -1450,7 +1385,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
;; O beauteous math! --the Unvexed Bum
(unless asc
(setq sub #'buffer-substring-no-properties))
- (gather))))
+ (gather b e @-holes))))
(while (and (sw)
(not (eobp))
(setq context (to-eol)
@@ -1466,7 +1401,7 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension."
;; other revisions, replace the `text' tag+value with `:insn'
;; plus value, always scanning in-place.
(if (string= context (cdr (assq 'head headers)))
- (setcdr (cadr rev) (gather))
+ (setcdr (cadr rev) (gather b e @-holes))
(if @-holes
(setq asc (nreverse @-holes)
sub #'incg)
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 7bce1ea3ba6..a3facc56d5d 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -1,6 +1,6 @@
-;;; vc-sccs.el --- support for SCCS version-control
+;;; vc-sccs.el --- support for SCCS version-control -*- lexical-binding:t -*-
-;; Copyright (C) 1992-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -101,7 +101,7 @@ For a description of possible values, see `vc-check-master-templates'."
;;; Properties of the backend
(defun vc-sccs-revision-granularity () 'file)
-(defun vc-sccs-checkout-model (files) 'locking)
+(defun vc-sccs-checkout-model (_files) 'locking)
;;;
;;; State-querying functions
@@ -124,7 +124,7 @@ For a description of possible values, see `vc-check-master-templates'."
(working-revision (vc-working-revision file))
(locking-user (cdr (assoc working-revision locks))))
(if (not locking-user)
- (if (vc-workfile-unchanged-p file)
+ (if (vc-sccs-workfile-unchanged-p file)
'up-to-date
'unlocked-changes)
(if (string= locking-user (vc-user-login-name file))
@@ -132,41 +132,12 @@ For a description of possible values, see `vc-check-master-templates'."
locking-user)))
'up-to-date))))
-(defun vc-sccs-state-heuristic (file)
- "SCCS-specific state heuristic."
- (if (not (vc-mistrust-permissions file))
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore the
- ;; group-read and other-read bits, since paranoid users turn them off.
- (let* ((attributes (file-attributes file 'string))
- (owner-name (nth 2 attributes))
- (permissions (nth 8 attributes)))
- (if (string-match ".r-..-..-." permissions)
- 'up-to-date
- (if (string-match ".rw..-..-." permissions)
- (if (file-ownership-preserved-p file)
- 'edited
- owner-name)
- ;; Strange permissions.
- ;; Fall through to real state computation.
- (vc-sccs-state file))))
- (vc-sccs-state file)))
-
(autoload 'vc-expand-dirs "vc")
-(defun vc-sccs-dir-status (dir update-function)
- ;; FIXME: this function should be rewritten, using `vc-expand-dirs'
- ;; is not TRTD because it returns files from multiple backends.
- ;; It should also return 'unregistered files.
-
- ;; Doing lots of individual VC-state calls is painful, but
- ;; there is no better option in SCCS-land.
- (let ((flist (vc-expand-dirs (list dir)))
- (result nil))
- (dolist (file flist)
+(defun vc-sccs-dir-status-files (dir files update-function)
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (let ((result nil))
+ (dolist (file files)
(let ((state (vc-state file))
(frel (file-relative-name file)))
(when (and (eq (vc-backend file) 'SCCS)
@@ -174,28 +145,31 @@ For a description of possible values, see `vc-check-master-templates'."
(push (list frel state) result))))
(funcall update-function result)))
+(autoload 'vc-master-name "vc-filewise")
+
(defun vc-sccs-working-revision (file)
"SCCS-specific version of `vc-working-revision'."
- (with-temp-buffer
- ;; The working revision is always the latest revision number.
- ;; To find this number, search the entire delta table,
- ;; rather than just the first entry, because the
- ;; first entry might be a deleted ("R") revision.
- (vc-insert-file (vc-name file) "^\001e\n\001[^s]")
- (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1)))
+ (when (and (file-regular-p file) (vc-master-name file))
+ (with-temp-buffer
+ ;; The working revision is always the latest revision number.
+ ;; To find this number, search the entire delta table,
+ ;; rather than just the first entry, because the
+ ;; first entry might be a deleted ("R") revision.
+ (vc-insert-file (vc-master-name file) "^\001e\n\001[^s]")
+ (vc-parse-buffer "^\001d D \\([^ ]+\\)" 1))))
;; Cf vc-sccs-find-revision.
(defun vc-sccs-write-revision (file outfile &optional rev)
"Write the SCCS version of input file FILE to output file OUTFILE.
Optional string REV is a revision."
(with-temp-buffer
- (apply 'vc-sccs-do-command t 0 "get" (vc-name file)
+ (apply 'vc-sccs-do-command t 0 "get" (vc-master-name file)
(append '("-s" "-p" "-k") ; -k: no keyword expansion
(if rev (list (concat "-r" rev)))))
(write-region nil nil outfile nil 'silent)))
(defun vc-sccs-workfile-unchanged-p (file)
- "SCCS-specific implementation of `vc-workfile-unchanged-p'."
+ "Has FILE remained unchanged since last checkout?"
(let ((tempfile (make-temp-file "vc-sccs")))
(unwind-protect
(progn
@@ -220,31 +194,26 @@ Optional string REV is a revision."
(autoload 'vc-switches "vc")
-(defun vc-sccs-register (files &optional rev comment)
+(defun vc-sccs-register (files &optional comment)
"Register FILES into the SCCS version-control system.
-REV is the optional revision number for the file. COMMENT can be used
-to provide an initial description of FILES.
+Automatically retrieve a read-only version of the files with keywords expanded.
+COMMENT can be used to provide an initial description of FILES.
Passes either `vc-sccs-register-switches' or `vc-register-switches'
-to the SCCS command.
-
-Automatically retrieve a read-only version of the files with keywords
-expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
+to the SCCS command."
(dolist (file files)
(let* ((dirname (or (file-name-directory file) ""))
(basename (file-name-nondirectory file))
(project-file (vc-sccs-search-project-dir dirname basename)))
- (let ((vc-name
+ (let ((vc-master-name
(or project-file
(format (car vc-sccs-master-templates) dirname basename))))
- (apply 'vc-sccs-do-command nil 0 "admin" vc-name
- (and rev (not (string= rev "")) (concat "-r" rev))
+ (apply 'vc-sccs-do-command nil 0 "admin" vc-master-name
"-fb"
(concat "-i" (file-relative-name file))
(and comment (concat "-y" comment))
(vc-switches 'SCCS 'register)))
(delete-file file)
- (if vc-keep-workfiles
- (vc-sccs-do-command nil 0 "get" (vc-name file))))))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file)))))
(defun vc-sccs-responsible-p (file)
"Return non-nil if SCCS thinks it would be responsible for registering FILE."
@@ -253,19 +222,18 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
(file-name-nondirectory file)))))
-(defun vc-sccs-checkin (files rev comment)
+(defun vc-sccs-checkin (files comment &optional rev)
"SCCS-specific version of `vc-backend-checkin'."
- (dolist (file (vc-expand-dirs files))
- (apply 'vc-sccs-do-command nil 0 "delta" (vc-name file)
- (if rev (concat "-r" rev))
+ (dolist (file (vc-expand-dirs files 'SCCS))
+ (apply 'vc-sccs-do-command nil 0 "delta" (vc-master-name file)
+ (if rev (concat "-r" rev))
(concat "-y" comment)
(vc-switches 'SCCS 'checkin))
- (if vc-keep-workfiles
- (vc-sccs-do-command nil 0 "get" (vc-name file)))))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file))))
(defun vc-sccs-find-revision (file rev buffer)
(apply 'vc-sccs-do-command
- buffer 0 "get" (vc-name file)
+ buffer 0 "get" (vc-master-name file)
"-s" ;; suppress diagnostic output
"-p"
(and rev
@@ -273,13 +241,13 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
(vc-sccs-lookup-triple file rev)))
(vc-switches 'SCCS 'checkout)))
-(defun vc-sccs-checkout (file &optional editable rev)
+(defun vc-sccs-checkout (file &optional rev)
"Retrieve a copy of a saved revision of SCCS controlled FILE.
If FILE is a directory, all version-controlled files beneath are checked out.
EDITABLE non-nil means that the file should be writable and
locked. REV is the revision to check out."
(if (file-directory-p file)
- (mapc 'vc-sccs-checkout (vc-expand-dirs (list file)))
+ (mapc 'vc-sccs-checkout (vc-expand-dirs (list file) 'SCCS))
(let ((file-buffer (get-file-buffer file))
switches)
(message "Checking out %s..." file)
@@ -299,35 +267,19 @@ locked. REV is the revision to check out."
(and rev (or (string= rev "")
(not (stringp rev)))
(setq rev nil))
- (apply 'vc-sccs-do-command nil 0 "get" (vc-name file)
- (if editable "-e")
+ (apply 'vc-sccs-do-command nil 0 "get" (vc-master-name file)
+ "-e"
(and rev (concat "-r" (vc-sccs-lookup-triple file rev)))
switches))))
(message "Checking out %s...done" file))))
-(defun vc-sccs-rollback (files)
- "Roll back, undoing the most recent checkins of FILES. Directories
-are expanded to all version-controlled subfiles."
- (setq files (vc-expand-dirs files))
- (if (not files)
- (error "SCCS backend doesn't support directory-level rollback"))
- (dolist (file files)
- (let ((discard (vc-working-revision file)))
- (if (null (yes-or-no-p (format "Remove version %s from %s history? "
- discard file)))
- (error "Aborted"))
- (message "Removing revision %s from %s..." discard file)
- (vc-sccs-do-command nil 0 "rmdel"
- (vc-name file) (concat "-r" discard))
- (vc-sccs-do-command nil 0 "get" (vc-name file) nil))))
-
-(defun vc-sccs-revert (file &optional contents-done)
+(defun vc-sccs-revert (file &optional _contents-done)
"Revert FILE to the version it was based on. If FILE is a directory,
revert all subfiles."
(if (file-directory-p file)
- (mapc 'vc-sccs-revert (vc-expand-dirs (list file)))
- (vc-sccs-do-command nil 0 "unget" (vc-name file))
- (vc-sccs-do-command nil 0 "get" (vc-name file))
+ (mapc 'vc-sccs-revert (vc-expand-dirs (list file) 'SCCS))
+ (vc-sccs-do-command nil 0 "unget" (vc-master-name file))
+ (vc-sccs-do-command nil 0 "get" (vc-master-name file))
;; Checking out explicit revisions is not supported under SCCS, yet.
;; We always "revert" to the latest revision; therefore
;; vc-working-revision is cleared here so that it gets recomputed.
@@ -336,16 +288,16 @@ revert all subfiles."
(defun vc-sccs-steal-lock (file &optional rev)
"Steal the lock on the current workfile for FILE and revision REV."
(if (file-directory-p file)
- (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file)))
+ (mapc 'vc-sccs-steal-lock (vc-expand-dirs (list file) 'SCCS))
(vc-sccs-do-command nil 0 "unget"
- (vc-name file) "-n" (if rev (concat "-r" rev)))
+ (vc-master-name file) "-n" (if rev (concat "-r" rev)))
(vc-sccs-do-command nil 0 "get"
- (vc-name file) "-g" (if rev (concat "-r" rev)))))
+ (vc-master-name file) "-g" (if rev (concat "-r" rev)))))
(defun vc-sccs-modify-change-comment (files rev comment)
"Modify (actually, append to) the change comments for FILES on a specified REV."
- (dolist (file (vc-expand-dirs files))
- (vc-sccs-do-command nil 0 "cdc" (vc-name file)
+ (dolist (file (vc-expand-dirs files 'SCCS))
+ (vc-sccs-do-command nil 0 "cdc" (vc-master-name file)
(concat "-y" comment) (concat "-r" rev))))
@@ -353,20 +305,22 @@ revert all subfiles."
;;; History functions
;;;
-(defun vc-sccs-print-log (files buffer &optional shortlog start-revision-ignored limit)
+(defun vc-sccs-print-log (files buffer &optional _shortlog _start-revision-ignored limit)
"Print commit log associated with FILES into specified BUFFER.
Remaining arguments are ignored."
- (setq files (vc-expand-dirs files))
- (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-name files))
+ (setq files (vc-expand-dirs files 'SCCS))
+ (vc-sccs-do-command buffer 0 "prs" (mapcar 'vc-master-name files))
(when limit 'limit-unsupported))
(autoload 'vc-setup-buffer "vc-dispatcher")
(autoload 'vc-delistify "vc-dispatcher")
+(defvar w32-quote-process-args)
+
;; FIXME use sccsdiff if present?
-(defun vc-sccs-diff (files &optional oldvers newvers buffer)
+(defun vc-sccs-diff (files &optional oldvers newvers buffer _async)
"Get a difference report using SCCS between two filesets."
- (setq files (vc-expand-dirs files))
+ (setq files (vc-expand-dirs files 'SCCS))
(setq oldvers (vc-sccs-lookup-triple (car files) oldvers))
(setq newvers (vc-sccs-lookup-triple (car files) newvers))
(or buffer (setq buffer "*vc-diff*"))
@@ -470,16 +424,16 @@ Remaining arguments are ignored."
(goto-char (point-min))
(re-search-forward "%[A-Z]%" nil t)))
-(autoload 'vc-rename-master "vc")
+(autoload 'vc-rename-master "vc-filewise")
(defun vc-sccs-rename-file (old new)
;; Move the master file (using vc-rcs-master-templates).
- (vc-rename-master (vc-name old) new vc-sccs-master-templates)
+ (vc-rename-master (vc-master-name old) new vc-sccs-master-templates)
;; Update the tag file.
(with-current-buffer
(find-file-noselect
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name old))))
+ (file-name-directory (vc-master-name old))))
(goto-char (point-min))
;; (replace-regexp (concat ":" (regexp-quote old) "$") (concat ":" new))
(while (re-search-forward (concat ":" (regexp-quote old) "$") nil t)
@@ -504,7 +458,7 @@ Remaining arguments are ignored."
;; a (autoload 'vc-sccs-search-project-dir "vc-sccs") which would not
;; help us avoid loading vc-sccs.
;;;###autoload
-(progn (defun vc-sccs-search-project-dir (dirname basename)
+(progn (defun vc-sccs-search-project-dir (_dirname basename)
"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."
@@ -523,7 +477,7 @@ find any project directory."
(defun vc-sccs-lock-file (file)
"Generate lock file name corresponding to FILE."
- (let ((master (vc-name file)))
+ (let ((master (vc-master-name file)))
(and
master
(string-match "\\(.*/\\)\\(s\\.\\)\\(.*\\)" master)
@@ -545,7 +499,7 @@ The result is a list of the form ((REVISION . USER) (REVISION . USER) ...)."
(with-current-buffer
(find-file-noselect
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name file))))
+ (file-name-directory (vc-master-name file))))
(goto-char (point-max))
(insert name "\t:\t" file "\t" rev "\n")
(basic-save-buffer)
@@ -561,7 +515,7 @@ If NAME is nil or a revision number string it's just passed through."
(with-temp-buffer
(vc-insert-file
(expand-file-name vc-sccs-name-assoc-file
- (file-name-directory (vc-name file))))
+ (file-name-directory (vc-master-name file))))
(vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1))))
(provide 'vc-sccs)
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
new file mode 100644
index 00000000000..69e403668b1
--- /dev/null
+++ b/lisp/vc/vc-src.el
@@ -0,0 +1,313 @@
+;;; vc-src.el --- support for SRC version-control -*- lexical-binding:t -*-
+
+;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
+
+;; Author: FSF (see vc.el for full credits)
+;; Maintainer: Eric S. Raymond <esr@thyrsus.com>
+;; Package: vc
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; See vc.el. SRC requires an underlying RCS version of 4.0 or greater.
+
+;; FUNCTION NAME STATUS
+;; BACKEND PROPERTIES
+;; * revision-granularity OK
+;; STATE-QUERYING FUNCTIONS
+;; * registered (file) OK
+;; * state (file) OK
+;; - dir-status-files (dir files uf) OK
+;; - dir-extra-headers (dir) NOT NEEDED
+;; - dir-printer (fileinfo) ??
+;; * working-revision (file) OK
+;; * checkout-model (files) OK
+;; - mode-line-string (file) NOT NEEDED
+;; STATE-CHANGING FUNCTIONS
+;; * register (files &optional rev comment) OK
+;; * create-repo () OK
+;; * responsible-p (file) OK
+;; - receive-file (file rev) NOT NEEDED
+;; - unregister (file) NOT NEEDED
+;; * checkin (files comment) OK
+;; * find-revision (file rev buffer) OK
+;; * checkout (file &optional rev) OK
+;; * revert (file &optional contents-done) OK
+;; - merge (file rev1 rev2) NOT NEEDED
+;; - merge-news (file) NOT NEEDED
+;; - steal-lock (file &optional revision) NOT NEEDED
+;; HISTORY FUNCTIONS
+;; * print-log (files buffer &optional shortlog start-revision limit) OK
+;; - log-view-mode () ??
+;; - show-log-entry (revision) NOT NEEDED
+;; - comment-history (file) NOT NEEDED
+;; - update-changelog (files) NOT NEEDED
+;; * diff (files &optional rev1 rev2 buffer) OK
+;; - revision-completion-table (files) ??
+;; - annotate-command (file buf &optional rev) ??
+;; - annotate-time () ??
+;; - annotate-current-time () NOT NEEDED
+;; - annotate-extract-revision-at-line () ??
+;; TAG SYSTEM
+;; - create-tag (dir name branchp) ??
+;; - retrieve-tag (dir name update) ??
+;; MISCELLANEOUS
+;; - make-version-backups-p (file) ??
+;; - previous-revision (file rev) ??
+;; - next-revision (file rev) ??
+;; - check-headers () ??
+;; - delete-file (file) ??
+;; * rename-file (old new) OK
+;; - find-file-hook () NOT NEEDED
+
+
+;;; Code:
+
+;;;
+;;; Customization options
+;;;
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'vc))
+
+(defgroup vc-src nil
+ "VC SRC backend."
+ :version "25.1"
+ :group 'vc)
+
+(defcustom vc-src-release nil
+ "The release number of your SRC installation, as a string.
+If nil, VC itself computes this value when it is first needed."
+ :type '(choice (const :tag "Auto" nil)
+ (string :tag "Specified")
+ (const :tag "Unknown" unknown))
+ :group 'vc-src)
+
+(defcustom vc-src-program "src"
+ "Name of the SRC executable (excluding any arguments)."
+ :type 'string
+ :group 'vc-src)
+
+(defcustom vc-src-diff-switches nil
+ "String or list of strings specifying switches for SRC diff under VC.
+If nil, use the value of `vc-diff-switches'. If t, use no switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-src)
+
+;; This needs to be autoloaded because vc-src-registered uses it (via
+;; vc-default-registered), and vc-hooks needs to be able to check
+;; for a registered backend without loading every backend.
+;;;###autoload
+(defcustom vc-src-master-templates
+ (purecopy '("%s.src/%s,v"))
+ "Where to look for SRC master files.
+For a description of possible values, see `vc-check-master-templates'."
+ :type '(choice (const :tag "Use standard SRC file names"
+ '("%s.src/%s,v"))
+ (repeat :tag "User-specified"
+ (choice string
+ function)))
+ :group 'vc-src)
+
+
+;;; Properties of the backend
+
+(defun vc-src-revision-granularity () 'file)
+(defun vc-src-checkout-model (_files) 'implicit)
+
+;;;
+;;; State-querying functions
+;;;
+
+;; The autoload cookie below places vc-src-registered directly into
+;; loaddefs.el, so that vc-src.el does not need to be loaded for
+;; every file that is visited.
+;;;###autoload
+(progn
+(defun vc-src-registered (f) (vc-default-registered 'src f)))
+
+(defun vc-src-state (file)
+ "SRC-specific version of `vc-state'."
+ (let*
+ ((status nil)
+ (default-directory (file-name-directory file))
+ (out
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (setq status
+ ;; Ignore all errors.
+ (condition-case nil
+ (process-file
+ vc-src-program nil t nil
+ "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)))))))
+
+(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) 'RCS)))
+ (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)))
+
+(defun vc-src-command (buffer file-or-list &rest flags)
+ "A wrapper around `vc-do-command' for use in vc-src.el.
+This function differs from vc-do-command in that it invokes `vc-src-program'."
+ (let (file-list)
+ (cond ((stringp file-or-list)
+ (setq file-list (list "--" file-or-list)))
+ (file-or-list
+ (setq file-list (cons "--" file-or-list))))
+ (apply 'vc-do-command (or buffer "*vc*") 0 vc-src-program file-list flags)))
+
+(defun vc-src-working-revision (file)
+ "SRC-specific version of `vc-working-revision'."
+ (let ((result (ignore-errors
+ (with-output-to-string
+ (vc-src-command standard-output file "list" "-f{1}" "@")))))
+ (if (zerop (length result)) "0" result)))
+
+;;;
+;;; State-changing functions
+;;;
+
+(defun vc-src-create-repo ()
+ "Create a new SRC repository."
+ ;; SRC is totally file-oriented, so all we have to do is make the directory.
+ (make-directory ".src"))
+
+(autoload 'vc-switches "vc")
+
+(defun vc-src-register (files &optional _comment)
+ "Register FILES under src. COMMENT is ignored."
+ (vc-src-command nil files "add"))
+
+(defun vc-src-responsible-p (file)
+ "Return non-nil if SRC thinks it would be responsible for registering FILE."
+ (file-directory-p (expand-file-name ".src"
+ (if (file-directory-p file)
+ file
+ (file-name-directory file)))))
+
+(defun vc-src-checkin (files comment &optional _rev)
+ "SRC-specific version of `vc-backend-checkin'.
+REV is ignored."
+ (vc-src-command nil files "commit" "-m" comment))
+
+(defun vc-src-find-revision (file rev buffer)
+ (let ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary))
+ (if rev
+ (vc-src-command buffer file "cat" rev)
+ (vc-src-command buffer file "cat"))))
+
+(defun vc-src-checkout (file &optional rev)
+ "Retrieve a revision of FILE.
+REV is the revision to check out into WORKFILE."
+ (if rev
+ (vc-src-command nil file "co" rev)
+ (vc-src-command nil file "co")))
+
+(defun vc-src-revert (file &optional _contents-done)
+ "Revert FILE to the version it was based on. If FILE is a directory,
+revert all registered files beneath it."
+ (if (file-directory-p file)
+ (mapc 'vc-src-revert (vc-expand-dirs (list file) 'SRC))
+ (vc-src-command nil file "co")))
+
+(defun vc-src-modify-change-comment (files rev comment)
+ "Modify the change comments change on FILES on a specified REV. If FILE is a
+directory the operation is applied to all registered files beneath it."
+ (dolist (file (vc-expand-dirs files 'SRC))
+ (vc-src-command nil file "amend" "-m" comment rev)))
+
+;; History functions
+
+(defcustom vc-src-log-switches nil
+ "String or list of strings specifying switches for src log under VC."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc-src)
+
+(defun vc-src-print-log (files buffer &optional shortlog _start-revision limit)
+ "Print commit log associated with FILES into specified BUFFER.
+If SHORTLOG is non-nil, use the list method.
+If START-REVISION is non-nil, it is the newest revision to show.
+If LIMIT is non-nil, show no more than this many entries."
+ ;; FIXME: Implement the range restrictions.
+ ;; `vc-do-command' creates the buffer, but we need it before running
+ ;; the command.
+ (vc-setup-buffer buffer)
+ ;; If the buffer exists from a previous invocation it might be
+ ;; read-only.
+ (let ((inhibit-read-only t))
+ (with-current-buffer
+ buffer
+ (apply 'vc-src-command buffer files (if shortlog "list" "log")
+ (nconc
+ ;;(when start-revision (list (format "%s-1" start-revision)))
+ (when limit (list "-l" (format "%s" limit)))
+ vc-src-log-switches)))))
+
+(defun vc-src-diff (files &optional oldvers newvers buffer _async)
+ "Get a difference report using src between two revisions of FILES."
+ (let* ((firstfile (car files))
+ (working (and firstfile (vc-working-revision firstfile))))
+ (when (and (equal oldvers working) (not newvers))
+ (setq oldvers nil))
+ (when (and (not oldvers) newvers)
+ (setq oldvers working))
+ (apply #'vc-src-command (or buffer "*vc-diff*") files "diff"
+ (when oldvers
+ (if newvers
+ (list (concat oldvers "-" newvers))
+ (list oldvers))))))
+
+;; Miscellaneous
+
+(defun vc-src-rename-file (old new)
+ "Rename file from OLD to NEW using `src mv'."
+ (vc-src-command nil 0 new "mv" old))
+
+(provide 'vc-src)
+
+;;; vc-src.el ends here
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 0e020614fd2..4ef63a23db5 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -1,6 +1,6 @@
-;;; vc-svn.el --- non-resident support for Subversion version-control
+;;; vc-svn.el --- non-resident support for Subversion version-control -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2015 Free Software Foundation, Inc.
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -83,7 +83,7 @@ If t, use no switches."
t ;`svn' doesn't support common args like -c or -b.
"String or list of strings specifying extra switches for svn diff under VC.
If nil, use the value of `vc-diff-switches' (or `diff-switches'),
-together with \"-x --diff-cmd=\"`diff-command' (since 'svn diff'
+together with \"-x --diff-cmd=\"`diff-command' (since `svn diff'
does not support the default \"-c\" value of `diff-switches').
If you want to force an empty list of arguments, use t."
:type '(choice (const :tag "Unspecified" nil)
@@ -95,7 +95,18 @@ If you want to force an empty list of arguments, use t."
:version "22.1"
:group 'vc-svn)
-(defcustom vc-svn-header '("\$Id\$")
+(defcustom vc-svn-annotate-switches nil
+ "String or list of strings specifying switches for svn annotate under VC.
+If nil, use the value of `vc-annotate-switches'. If t, use no
+switches."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "25.1"
+ :group 'vc-svn)
+
+(defcustom vc-svn-header '("$Id\ $")
"Header keywords to be inserted by `vc-insert-headers'."
:version "24.1" ; no longer consult the obsolete vc-header-alist
:type '(repeat string)
@@ -115,7 +126,7 @@ If you want to force an empty list of arguments, use t."
;;; Properties of the backend
(defun vc-svn-revision-granularity () 'repository)
-(defun vc-svn-checkout-model (files) 'implicit)
+(defun vc-svn-checkout-model (_files) 'implicit)
;;;
;;; State-querying functions
@@ -135,6 +146,7 @@ If you want to force an empty list of arguments, use t."
(defun vc-svn-registered (file)
"Check if FILE is SVN registered."
+ (setq file (expand-file-name file))
(when (vc-svn-root file)
(with-temp-buffer
(cd (file-name-directory file))
@@ -153,36 +165,17 @@ If you want to force an empty list of arguments, use t."
(let ((parsed (vc-svn-parse-status file)))
(and parsed (not (memq parsed '(ignored unregistered))))))))))
-(defun vc-svn-state (file &optional localp)
+(defun vc-svn-state (file)
"SVN-specific version of `vc-state'."
(let (process-file-side-effects)
- (setq localp (or localp (vc-stay-local-p file 'SVN)))
(with-temp-buffer
(cd (file-name-directory file))
- (vc-svn-command t 0 file "status" (if localp "-v" "-u"))
+ (vc-svn-command t 0 file "status" "-v")
(vc-svn-parse-status file))))
-;; NB this does not handle svn properties, which can be changed
-;; without changing the file timestamp.
-;; Note that unlike vc-cvs-state-heuristic, this is not called from
-;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via
-;; vc-after-save (bug#7850). Therefore the fact that it ignores
-;; properties is irrelevant. If you want to make vc-svn-state call
-;; this, it should be extended to handle svn properties.
-(defun vc-svn-state-heuristic (file)
- "SVN-specific state heuristic."
- ;; If the file has not changed since checkout, consider it `up-to-date'.
- ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic.
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
- (cond
- ((equal checkout-time lastmod) 'up-to-date)
- ((string= (vc-working-revision file) "0") 'added)
- ((null checkout-time) 'unregistered)
- (t 'edited))))
-
;; FIXME it would be better not to have the "remote" argument,
;; but to distinguish the two output formats based on content.
+;; FIXME: the local format isn't used by the (sole) caller anymore.
(defun vc-svn-after-dir-status (callback &optional remote)
(let ((state-map '((?A . added)
(?C . conflict)
@@ -195,7 +188,7 @@ If you want to force an empty list of arguments, use t."
(?~ . edited)))
(re (if remote "^\\(.\\)\\(.\\).....? \\([ *]\\) +\\(?:[-0-9]+\\)? \\(.*\\)$"
;; Subexp 3 is a dummy in this case, so the numbers match.
- "^\\(.\\)\\(.\\)...\\(.\\) \\(.*\\)$"))
+ "^\\(.\\)\\(.\\)...\\(.\\).? \\(.*\\)$"))
result)
(goto-char (point-min))
(while (re-search-forward re nil t)
@@ -215,31 +208,21 @@ If you want to force an empty list of arguments, use t."
(setq result (cons (list filename state) result)))))
(funcall callback result)))
-;; -dir-status called from vc-dir, which loads vc, which loads vc-dispatcher.
+;; dir-status-files called from vc-dir, which loads vc,
+;; which loads vc-dispatcher.
(declare-function vc-exec-after "vc-dispatcher" (code))
-(defun vc-svn-dir-status (dir callback)
+(autoload 'vc-expand-dirs "vc")
+
+(defun vc-svn-dir-status-files (_dir files callback)
"Run 'svn status' for DIR and update BUFFER via CALLBACK.
CALLBACK is called as (CALLBACK RESULT BUFFER), where
RESULT is a list of conses (FILE . STATE) for directory DIR."
- ;; FIXME should this rather be all the files in dir?
- ;; FIXME: the vc-stay-local-p logic below is disabled, it ends up
- ;; calling synchronously (vc-svn-registered DIR) => calling svn status -v DIR
- ;; which is VERY SLOW for big trees and it makes emacs
- ;; completely unresponsive during that time.
- (let* ((local (and nil (vc-stay-local-p dir 'SVN)))
- (remote (or t (not local) (eq local 'only-file))))
- (vc-svn-command (current-buffer) 'async nil "status"
- (if remote "-u"))
- (vc-exec-after
- `(vc-svn-after-dir-status (quote ,callback) ,remote))))
-
-(defun vc-svn-dir-status-files (dir files default-state callback)
- (apply 'vc-svn-command (current-buffer) 'async nil "status" files)
- (vc-exec-after
- `(vc-svn-after-dir-status (quote ,callback))))
-
-(defun vc-svn-dir-extra-headers (dir)
+ ;; FIXME shouldn't this rather default to all the files in dir?
+ (apply #'vc-svn-command (current-buffer) 'async nil "status" "-u" files)
+ (vc-run-delayed (vc-svn-after-dir-status callback t)))
+
+(defun vc-svn-dir-extra-headers (_dir)
"Generate extra status headers for a Subversion working copy."
(let (process-file-side-effects)
(vc-svn-command "*vc*" 0 nil "info"))
@@ -268,7 +251,7 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
;; vc-svn-mode-line-string doesn't exist because the default implementation
;; works just fine.
-(defun vc-svn-previous-revision (file rev)
+(defun vc-svn-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
(when (< 0 newrev)
(number-to-string newrev))))
@@ -293,12 +276,28 @@ RESULT is a list of conses (FILE . STATE) for directory DIR."
(defun vc-svn-create-repo ()
"Create a new SVN repository."
(vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN"))
+ ;; Expand default-directory because svn gets confused by eg
+ ;; file://~/path/to/file. (Bug#15446).
(vc-svn-command "*vc*" 0 "." "checkout"
- (concat "file://" default-directory "SVN")))
+ (let ((defdir (expand-file-name default-directory))
+ (svn-prog (executable-find "svn")))
+ (when (and (fboundp 'w32-application-type)
+ (eq (w32-application-type svn-prog) 'msys))
+ (setq defdir
+ (replace-regexp-in-string "^\\(.\\):/" "/\\1/"
+ defdir)))
+ (concat (if (and (stringp defdir)
+ (eq (aref defdir 0) ?/))
+ "file://"
+ ;; MS-Windows files d:/foo/bar need to
+ ;; begin with 3 leading slashes.
+ "file:///")
+ defdir
+ "SVN"))))
(autoload 'vc-switches "vc")
-(defun vc-svn-register (files &optional rev comment)
+(defun vc-svn-register (files &optional _comment)
"Register FILES into the SVN version-control system.
The COMMENT argument is ignored This does an add but not a commit.
Passes either `vc-svn-register-switches' or `vc-register-switches'
@@ -310,13 +309,8 @@ to the SVN command."
(defalias 'vc-svn-responsible-p 'vc-svn-root)
-(defalias 'vc-svn-could-register 'vc-svn-root
- "Return non-nil if FILE could be registered in SVN.
-This is only possible if SVN is responsible for FILE's directory.")
-
-(defun vc-svn-checkin (files rev comment &optional extra-args-ignored)
+(defun vc-svn-checkin (files comment &optional _extra-args-ignored)
"SVN-specific version of `vc-backend-checkin'."
- (if rev (error "Committing to a specific revision is unsupported in SVN"))
(let ((status (apply
'vc-svn-command nil 1 files "ci"
(nconc (list "-m" comment) (vc-switches 'SVN 'checkin)))))
@@ -354,22 +348,34 @@ This is only possible if SVN is responsible for FILE's directory.")
(defun vc-svn-ignore (file &optional directory remove)
"Ignore FILE under Subversion.
-If DIRECTORY is non-nil, the repository to use will be deduced by
-DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
- (vc-svn-command t 0 file "propedit" "svn:ignore"))
+FILE is a file wildcard, relative to the root directory of DIRECTORY."
+ (let* ((ignores (vc-svn-ignore-completion-table directory))
+ (file (file-relative-name file directory))
+ (ignores (if remove
+ (delete file ignores)
+ (push file ignores))))
+ (vc-svn-command nil 0 nil nil "propset" "svn:ignore"
+ (mapconcat #'identity ignores "\n")
+ (expand-file-name directory))))
+
+(defun vc-svn-ignore-completion-table (directory)
+ "Return the list of ignored files in DIRECTORY."
+ (with-temp-buffer
+ (vc-svn-command t t nil "propget" "svn:ignore" (expand-file-name directory))
+ (split-string (buffer-string))))
-(defun vc-svn-ignore-completion-table (file)
- "Return the list of ignored files."
- )
+(defun vc-svn-find-admin-dir (file)
+ "Return the administrative directory of FILE."
+ (expand-file-name vc-svn-admin-directory (vc-svn-root file)))
-(defun vc-svn-checkout (file &optional editable rev)
+(defun vc-svn-checkout (file &optional rev)
(message "Checking out %s..." file)
(with-current-buffer (or (get-file-buffer file) (current-buffer))
- (vc-svn-update file editable rev (vc-switches 'SVN 'checkout)))
+ (vc-svn-update file rev (vc-switches 'SVN 'checkout)))
(vc-mode-line file 'SVN)
(message "Checking out %s...done" file))
-(defun vc-svn-update (file editable rev switches)
+(defun vc-svn-update (file rev switches)
(if (and (file-exists-p file) (not rev))
;; If no revision was specified, there's nothing to do.
nil
@@ -394,6 +400,29 @@ DIRECTORY; if REMOVE is non-nil, remove FILE from ignored files."
(unless contents-done
(vc-svn-command nil 0 file "revert")))
+(defun vc-svn-merge-file (file)
+ "Accept a file merge request, prompting for revisions."
+ (let* ((first-revision
+ (vc-read-revision
+ (concat "Merge " file
+ " from SVN revision "
+ "(default news on current branch): ")
+ (list file)
+ 'SVN))
+ second-revision
+ status)
+ (cond
+ ((string= first-revision "")
+ (setq status (vc-svn-merge-news file)))
+ (t
+ (setq second-revision
+ (vc-read-revision
+ "Second SVN revision: "
+ (list file) 'SVN nil
+ first-revision))
+ (setq status (vc-svn-merge file first-revision second-revision))))
+ status))
+
(defun vc-svn-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."
@@ -458,7 +487,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(error "Couldn't analyze svn update result")))
(message "Merging changes into %s...done" file))))
-(defun vc-svn-modify-change-comment (files rev comment)
+(defun vc-svn-modify-change-comment (_files rev comment)
"Modify the change comments for a specified REV.
You must have ssh access to the repository host, and the directory Emacs
uses locally for temp files must also be writable by you on that host.
@@ -510,7 +539,7 @@ or svn+ssh://."
(autoload 'vc-setup-buffer "vc-dispatcher")
-(defun vc-svn-print-log (files buffer &optional shortlog start-revision limit)
+(defun vc-svn-print-log (files buffer &optional _shortlog start-revision limit)
"Print commit log associated with FILES into specified BUFFER.
SHORTLOG is ignored.
If START-REVISION is non-nil, it is the newest revision to show.
@@ -526,7 +555,6 @@ If LIMIT is non-nil, show no more than this many entries."
'vc-svn-command
buffer
'async
- ;; (if (and (= (length files) 1) (vc-stay-local-p file 'SVN)) 'async 0)
(list file)
"log"
(append
@@ -546,7 +574,7 @@ If LIMIT is non-nil, show no more than this many entries."
(if start-revision (format "-r%s" start-revision) "-rHEAD:0"))
(when limit (list "--limit" (format "%s" limit)))))))))
-(defun vc-svn-diff (files &optional oldvers newvers buffer)
+(defun vc-svn-diff (files &optional oldvers newvers buffer async)
"Get a difference report using SVN between two revisions of fileset FILES."
(and oldvers
(not newvers)
@@ -561,14 +589,12 @@ If LIMIT is non-nil, show no more than this many entries."
;; has a different revision, we fetch the lot, which is
;; obviously sub-optimal.
(setq oldvers nil))
+ (setq async (and async (or oldvers newvers))) ; Svn diffs those locally.
(let* ((switches
(if vc-svn-diff-switches
(vc-switches 'SVN 'diff)
(list (concat "--diff-cmd=" diff-command) "-x"
- (mapconcat 'identity (vc-switches nil 'diff) " "))))
- (async (and (not vc-disable-async-diff)
- (vc-stay-local-p files 'SVN)
- (or oldvers newvers)))) ; Svn diffs those locally.
+ (mapconcat 'identity (vc-switches nil 'diff) " ")))))
(apply 'vc-svn-command buffer
(if async 'async 0)
files "diff"
@@ -594,7 +620,7 @@ NAME is assumed to be a URL."
(vc-svn-command nil 0 dir "copy" name)
(when branchp (vc-svn-retrieve-tag dir name nil)))
-(defun vc-svn-retrieve-tag (dir name update)
+(defun vc-svn-retrieve-tag (dir name _update)
"Retrieve a tag at and below DIR.
NAME is the name of the tag; if it is empty, do a `svn update'.
If UPDATE is non-nil, then update (resynch) any affected buffers.
@@ -610,7 +636,7 @@ NAME is assumed to be a URL."
;; Subversion makes backups for us, so don't bother.
;; (defun vc-svn-make-version-backups-p (file)
;; "Return non-nil if version backups should be made for FILE."
-;; (vc-stay-local-p file 'SVN))
+;; nil)
(defun vc-svn-check-headers ()
"Check if the current file has any headers in it."
@@ -633,17 +659,6 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches flags))))
-(defun vc-svn-repository-hostname (dirname)
- (with-temp-buffer
- (let (process-file-side-effects)
- (vc-svn-command t t dirname "info" "--xml"))
- (goto-char (point-min))
- (when (re-search-forward "<url>\\(.*\\)</url>" nil t)
- ;; This is not a hostname but a URL. This may actually be considered
- ;; as a feature since it allows vc-svn-stay-local to specify different
- ;; behavior for different modules on the same server.
- (match-string 1))))
-
(defun vc-svn-resolve-when-done ()
"Call \"svn resolved\" if the conflict markers have been removed."
(save-excursion
@@ -675,19 +690,23 @@ and that it passes `vc-svn-global-switches' to it before FLAGS."
(defun vc-svn-parse-status (&optional filename)
"Parse output of \"svn status\" command in the current buffer.
-Set file properties accordingly. Unless FILENAME is non-nil, parse only
-information about FILENAME and return its status."
- (let (file status propstat)
+Set file properties accordingly. If FILENAME is non-nil, return its status."
+ (let (multifile file status propstat)
(goto-char (point-min))
(while (re-search-forward
;; Ignore the files with status X.
"^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
;; If the username contains spaces, the output format is ambiguous,
;; so don't trust the output's filename unless we have to.
- (setq file (or filename
+ (setq file (or (unless multifile filename)
(expand-file-name
- (buffer-substring (point) (line-end-position)))))
- (setq status (char-after (line-beginning-position))
+ (buffer-substring (point) (line-end-position))))
+ ;; If we are parsing the result of running status on a directory,
+ ;; there could be multiple files in the output.
+ ;; We assume that filename, if supplied, applies to the first
+ ;; listed file (ie, the directory). Bug#15322.
+ multifile t
+ status (char-after (line-beginning-position))
;; Status of the item's properties ([ MC]).
propstat (char-after (1+ (line-beginning-position))))
(if (eq status ??)
@@ -742,7 +761,9 @@ information about FILENAME and return its status."
;; Support for `svn annotate'
(defun vc-svn-annotate-command (file buf &optional rev)
- (vc-svn-command buf 'async file "annotate" (if rev (concat "-r" rev))))
+ (apply #'vc-svn-command buf 'async file "annotate"
+ (append (vc-switches 'svn 'annotate)
+ (if rev (list (concat "-r" rev))))))
(defun vc-svn-annotate-time-of-rev (rev)
;; Arbitrarily assume 10 commits per day.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 35e91e7e059..f08e562efe5 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1,6 +1,6 @@
-;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding: t -*-
+;;; vc.el --- drive a version-control system from within Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 1992-1998, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1992-1998, 2000-2015 Free Software Foundation, Inc.
;; Author: FSF (see below for full credits)
;; Maintainer: Andre Spiegel <spiegel@gnu.org>
@@ -46,15 +46,15 @@
;; If you maintain a client of the mode or customize it in your .emacs,
;; note that some backend functions which formerly took single file arguments
;; now take a list of files. These include: register, checkin, print-log,
-;; rollback, and diff.
+;; and diff.
;;; Commentary:
;; This mode is fully documented in the Emacs user's manual.
;;
-;; Supported version-control systems presently include CVS, RCS, GNU
-;; Arch, Subversion, Bzr, Git, Mercurial, Monotone and SCCS
-;; (or its free replacement, CSSC).
+;; Supported version-control systems presently include CVS, RCS, SRC,
+;; GNU Subversion, Bzr, Git, Mercurial, Monotone and SCCS (or its free
+;; replacement, CSSC).
;;
;; If your site uses the ChangeLog convention supported by Emacs, the
;; function `log-edit-comment-to-change-log' could prove a useful checkin hook,
@@ -72,7 +72,10 @@
;; When using Subversion or a later system, anything you do outside VC
;; *through the VCS tools* should safely interlock with VC
;; operations. Under these VC does little state caching, because local
-;; operations are assumed to be fast. The dividing line is
+;; operations are assumed to be fast.
+;;
+;; The 'assumed to be fast' category includes SRC, even though it's
+;; a wrapper around RCS.
;;
;; ADDING SUPPORT FOR OTHER BACKENDS
;;
@@ -125,42 +128,33 @@
;; Return the current version control state of FILE. For a list of
;; possible values, see `vc-state'. This function should do a full and
;; reliable state computation; it is usually called immediately after
-;; C-x v v. If you want to use a faster heuristic when visiting a
-;; file, put that into `state-heuristic' below. Note that under most
-;; VCSes this won't be called at all, dir-status is used instead.
+;; C-x v v.
;;
-;; - state-heuristic (file)
+;; - dir-status-files (dir files update-function)
;;
-;; If provided, this function is used to estimate the version control
-;; state of FILE at visiting time. It should be considerably faster
-;; than the implementation of `state'. For a list of possible values,
-;; see the doc string of `vc-state'.
+;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
+;; for FILES in DIR. If FILES is nil, report on all files in DIR.
+;; (It is OK, though possibly inefficient, to ignore the FILES argument
+;; and always report on all files in DIR.)
;;
-;; - dir-status (dir update-function)
+;; If FILES is non-nil, this function should report on all requested
+;; files, including up-to-date or ignored files.
;;
-;; Produce RESULT: a list of lists of the form (FILE VC-STATE EXTRA)
-;; for the files in DIR.
;; EXTRA can be used for backend specific information about FILE.
;; If a command needs to be run to compute this list, it should be
;; run asynchronously using (current-buffer) as the buffer for the
-;; command. When RESULT is computed, it should be passed back by
-;; doing: (funcall UPDATE-FUNCTION RESULT nil).
-;; If the backend uses a process filter, hence it produces partial results,
-;; they can be passed back by doing:
-;; (funcall UPDATE-FUNCTION RESULT t)
-;; and then do a (funcall UPDATE-FUNCTION RESULT nil)
-;; when all the results have been computed.
-;; To provide more backend specific functionality for `vc-dir'
-;; the following functions might be needed: `dir-extra-headers',
-;; `dir-printer', `extra-dir-menu' and `dir-status-files'.
+;; command.
;;
-;; - dir-status-files (dir files default-state update-function)
+;; When RESULT is computed, it should be passed back by doing:
+;; (funcall UPDATE-FUNCTION RESULT nil). If the backend uses a
+;; process filter, hence it produces partial results, they can be
+;; passed back by doing: (funcall UPDATE-FUNCTION RESULT t) and then
+;; do a (funcall UPDATE-FUNCTION RESULT nil) when all the results
+;; have been computed.
;;
-;; This function is identical to dir-status except that it should
-;; only report status for the specified FILES. Also it needs to
-;; report on all requested files, including up-to-date or ignored
-;; files. If not provided, the default is to consider that the files
-;; are in DEFAULT-STATE.
+;; To provide more backend specific functionality for `vc-dir'
+;; the following functions might be needed: `dir-extra-headers',
+;; `dir-printer', and `extra-dir-menu'.
;;
;; - dir-extra-headers (dir)
;;
@@ -185,29 +179,11 @@
;; head or tip revision. Should return "0" for a file added but not yet
;; committed.
;;
-;; - latest-on-branch-p (file)
-;;
-;; Return non-nil if the working revision of FILE is the latest revision
-;; on its branch (many VCSes call this the 'tip' or 'head' revision).
-;; The default implementation always returns t, which means that
-;; working with non-current revisions is not supported by default.
-;;
;; * checkout-model (files)
;;
;; Indicate whether FILES need to be "checked out" before they can be
;; edited. See `vc-checkout-model' for a list of possible values.
;;
-;; - workfile-unchanged-p (file)
-;;
-;; Return non-nil if FILE is unchanged from the working revision.
-;; This function should do a brief comparison of FILE's contents
-;; with those of the repository copy of the working revision. If
-;; the backend does not have such a brief-comparison feature, the
-;; default implementation of this function can be used, which
-;; delegates to a full vc-BACKEND-diff. (Note that vc-BACKEND-diff
-;; must not run asynchronously in this case, see variable
-;; `vc-disable-async-diff'.)
-;;
;; - mode-line-string (file)
;;
;; If provided, this function should return the VC-specific mode
@@ -225,21 +201,16 @@
;; it so VC mode can add files to it. For file-oriented systems, this
;; need do no more than create a subdirectory with the right name.
;;
-;; * register (files &optional rev comment)
-;;
-;; Register FILES in this backend. Optionally, an initial revision REV
-;; and an initial description of the file, COMMENT, may be specified,
-;; but it is not guaranteed that the backend will do anything with this.
-;; The implementation should pass the value of vc-register-switches
-;; to the backend command. (Note: in older versions of VC, this
-;; command took a single file argument and not a list.)
-;; The REV argument is a historical leftover and is never used.
+;; * register (files &optional comment)
;;
-;; - init-revision (file)
-;;
-;; The initial revision to use when registering FILE if one is not
-;; specified by the user. If not provided, the variable
-;; vc-default-init-revision is used instead.
+;; Register FILES in this backend. Optionally, an initial
+;; description of the file, COMMENT, may be specified, but it is not
+;; guaranteed that the backend will do anything with this. The
+;; implementation should pass the value of vc-register-switches to
+;; the backend command. (Note: in older versions of VC, this
+;; command had an optional revision first argument that was
+;; not used; in still older ones it took a single file argument and
+;; not a list.)
;;
;; - responsible-p (file)
;;
@@ -249,11 +220,6 @@
;; like change log generation. The default implementation always
;; returns nil.
;;
-;; - could-register (file)
-;;
-;; Return non-nil if FILE could be registered under this backend. The
-;; default implementation always returns t.
-;;
;; - receive-file (file rev)
;;
;; Let this backend "receive" a file that is already registered under
@@ -267,12 +233,13 @@
;; Unregister FILE from this backend. This is only needed if this
;; backend may be used as a "more local" backend for temporary editing.
;;
-;; * checkin (files rev comment)
+;; * checkin (files comment &optional rev)
;;
-;; Commit changes in FILES to this backend. REV is a historical artifact
-;; and should be ignored. COMMENT is used as a check-in comment.
-;; The implementation should pass the value of vc-checkin-switches to
-;; the backend command.
+;; Commit changes in FILES to this backend. COMMENT is used as a
+;; check-in comment. The implementation should pass the value of
+;; vc-checkin-switches to the backend command. The optional REV
+;; revision argument is only supported with some older VCSes, like
+;; RCS and CVS, and is otherwise silently ignored.
;;
;; * find-revision (file rev buffer)
;;
@@ -281,16 +248,17 @@
;; The implementation should pass the value of vc-checkout-switches
;; to the backend command.
;;
-;; * checkout (file &optional editable rev)
+;; * checkout (file &optional rev)
;;
-;; Check out revision REV of FILE into the working area. If EDITABLE
-;; is non-nil, FILE should be writable by the user and if locking is
-;; used for FILE, a lock should also be set. If REV is non-nil, that
-;; is the revision to check out (default is the working revision).
-;; If REV is t, that means to check out the head of the current branch;
-;; if it is the empty string, check out the head of the trunk.
-;; The implementation should pass the value of vc-checkout-switches
-;; to the backend command.
+;; Check out revision REV of FILE into the working area. FILE
+;; should be writable by the user and if locking is used for FILE, a
+;; lock should also be set. If REV is non-nil, that is the revision
+;; to check out (default is the working revision). If REV is t,
+;; that means to check out the head of the current branch; if it is
+;; the empty string, check out the head of the trunk. The
+;; implementation should pass the value of vc-checkout-switches to
+;; the backend command. The 'editable' argument of older VC versions
+;; is gone; all files are checked out editable.
;;
;; * revert (file &optional contents-done)
;;
@@ -301,19 +269,11 @@
;; If FILE is in the `added' state it should be returned to the
;; `unregistered' state.
;;
-;; - rollback (files)
-;;
-;; Remove the tip revision of each of FILES from the repository. If
-;; this function is not provided, trying to cancel a revision is
-;; caught as an error. (Most backends don't provide it.) (Also
-;; note that older versions of this backend command were called
-;; 'cancel-version' and took a single file arg, not a list of
-;; files.)
-;;
-;; - merge (file rev1 rev2)
+;; - merge-file (file rev1 rev2)
;;
-;; Merge the changes between REV1 and REV2 into the current working file
-;; (for non-distributed VCS).
+;; Merge the changes between REV1 and REV2 into the current working
+;; file (for non-distributed VCS). It is expected that with an
+;; empty first revision this will behave like the merge-news method.
;;
;; - merge-branch ()
;;
@@ -347,6 +307,10 @@
;;
;; Mark conflicts as resolved. Some VC systems need to run a
;; command to mark conflicts as resolved.
+;;
+;; - find-admin-dir (file)
+;;
+;; Return the administrative directory of FILE.
;; HISTORY FUNCTIONS
;;
@@ -398,13 +362,15 @@
;; default implementation runs rcs2log, which handles RCS- and
;; CVS-style logs.
;;
-;; * diff (files &optional rev1 rev2 buffer)
+;; * diff (files &optional rev1 rev2 buffer async)
;;
;; Insert the diff for FILE into BUFFER, or the *vc-diff* buffer if
-;; BUFFER is nil. If REV1 and REV2 are non-nil, report differences
-;; from REV1 to REV2. If REV1 is nil, use the working revision (as
-;; found in the repository) as the older revision; if REV2 is nil,
-;; use the current working-copy contents as the newer revision. This
+;; BUFFER is nil. If ASYNC is non-nil, run asynchronously. If REV1
+;; and REV2 are non-nil, report differences from REV1 to REV2. If
+;; REV1 is nil, use the working revision (as found in the
+;; repository) as the older revision if REV2 is nil as well;
+;; otherwise, diff against an empty tree. If REV2 is nil, use the
+;; current working-copy contents as the newer revision. This
;; function should pass the value of (vc-switches BACKEND 'diff) to
;; the backend command. It should return a status of either 0 (no
;; differences found), or 1 (either non-empty diff or the diff is
@@ -454,6 +420,15 @@
;; If the backend supports annotating through copies and renames,
;; and displays a file name and a revision, then return a cons
;; (REVISION . FILENAME).
+;;
+;; - region-history (FILE BUFFER LFROM LTO)
+;;
+;; Insert into BUFFER the history (log comments and diffs) of the content of
+;; FILE between lines LFROM and LTO. This is typically done asynchronously.
+;;
+;; - region-history-mode ()
+;;
+;; Major mode to use for the output of `region-history'.
;; TAG SYSTEM
;;
@@ -489,19 +464,14 @@
;;
;; Return the root of the VC controlled hierarchy for file.
;;
-;; - repository-hostname (dirname)
-;;
-;; Return the hostname that the backend will have to contact
-;; in order to operate on a file in DIRNAME. If the return value
-;; is nil, it means that the repository is local.
-;; This function is used in `vc-stay-local-p' which backends can use
-;; for their convenience.
+;; - ignore (file &optional directory)
;;
-;; - ignore (file &optional remove)
-;;
-;; Ignore FILE under the current VCS. When called interactively and
-;; with a prefix argument, remove an ignored file. When called from
-;; Lisp code, if REMOVE is non-nil, remove FILE from ignored files."
+;; Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
+;; FILE is a file wildcard.
+;; When called interactively and with a prefix argument, remove FILE
+;; from ignored files.
+;; When called from Lisp code, if DIRECTORY is non-nil, the
+;; repository to use will be deduced by DIRECTORY.
;;
;; - ignore-completion-table
;;
@@ -529,15 +499,6 @@
;;
;; Return non-nil if the current buffer contains any version headers.
;;
-;; - clear-headers ()
-;;
-;; In the current buffer, reset all version headers to their unexpanded
-;; form. This function should be provided if the state-querying code
-;; for this backend uses the version headers to determine the state of
-;; a file. This function will then be called whenever VC changes the
-;; version control state in such a way that the headers would give
-;; wrong information.
-;;
;; - delete-file (file)
;;
;; Delete FILE and mark it as deleted in the repository. If this
@@ -579,19 +540,82 @@
;; the project that contains DIR.
;; FIXME: what should it do with non-text conflicts?
-;;; Todo:
+;;; Changes from the pre-25.1 API:
+;;
+;; - INCOMPATIBLE CHANGE: The 'editable' optional argument of
+;; vc-checkout is gone. The upper level assumes that all files are
+;; checked out editable. This moves closer to emulating modern
+;; non-locking behavior even on very old VCSes.
+;;
+;; - INCOMPATIBLE CHANGE: The vc-register function and its backend
+;; implementations no longer take a first optional revision
+;; argument, since on no system since RCS has setting the initial
+;; revision been even possible, let alone sane.
+;;
+;; INCOMPATIBLE CHANGE: In older versions of the API, vc-diff did
+;; not take an async-mode flag as a fourth optional argument. (This
+;; change eliminated a particularly ugly global.)
+;;
+;; - INCOMPATIBLE CHANGE: The backend operation for non-distributed
+;; VCSes formerly called "merge" is now "merge-file" (to contrast
+;; with merge-branch), and does its own prompting for revisions.
+;; (This fixes a layer violation that produced bad behavior under
+;; SVN.)
+;;
+;; - INCOMPATIBLE CHANGE: The old fourth 'default-state' argument of
+;; vc-dir-status-files is gone; none of the back ends actually used it.
+;;
+;; - vc-dir-status is no longer a public method; it has been replaced
+;; by vc-dir-status-files.
+;;
+;; - vc-state-heuristic is no longer a public method (the CVS backend
+;; retains it as a private one).
+;;
+;; - the vc-mistrust-permissions configuration variable is gone; the
+;; code no longer relies on permissions except in one corner case where
+;; CVS leaves no alternative (which was not gated by this variable). The
+;; only affected back ends were SCCS and RCS.
+;;
+;; - vc-stay-local-p and repository-hostname are no longer part
+;; of the public API. The vc-stay-local configuration variable
+;; remains but only affects the CVS back end.
+;;
+;; - The init-revision function and the default-initial-revision
+;; variable are gone. These have't made sense on anything shipped
+;; since RCS, and using them was a dumb stunt even on RCS.
+;;
+;; - workfile-unchanged-p is no longer a public back-end method. It
+;; was redundant with vc-state and usually implemented with a trivial
+;; call to it. A few older back ends retain versions for internal use in
+;; their vc-state functions.
+;;
+;; - could-register is no longer a public method. Only vc-cvs ever used it
+;;
+;; The vc-keep-workfiles configuration variable is gone. Used only by
+;; the RCS and SCCS backends, it was an invitation to shoot self in foot
+;; when set to the (non-default) value nil. The original justification
+;; for it (saving disk space) is long obsolete.
+;;
+;; - The rollback method (implemented by RCS and SCCS only) is gone. See
+;; the to-do note on uncommit.
+;;
+;; - latest-on-branch-p is no longer a public method. It was to be used
+;; for implementing rollback. RCS keeps its implementation (the only one)
+;; for internal use.
-;; - Get rid of the "master file" terminology.
-;; - Add key-binding for vc-delete-file.
+;;; Todo:
;;;; New Primitives:
;;
-;; - deal with push/pull operations.
+;; - uncommit: undo last checkin, leave changes in place in the workfile,
+;; stash the commit comment for re-use.
+;;
+;; - deal with push operations.
;;
;;;; Primitives that need changing:
;;
-;; - vc-update/vc-merge should deal with VC systems that don't
+;; - vc-update/vc-merge should deal with VC systems that don't do
;; update/merge on a file basis, but on a whole repository basis.
;; vc-update and vc-merge assume the arguments are always files,
;; they don't deal with directories. Make sure the *vc-dir* buffer
@@ -600,27 +624,44 @@
;;
;;;; Improved branch and tag handling:
;;
+;; - Make sure the *vc-dir* buffer is updated after merge-branch operations.
+;;
;; - add a generic mechanism for remembering the current branch names,
;; display the branch name in the mode-line. Replace
;; vc-cvs-sticky-tag with that.
;;
-;;;; Internal cleanups:
+;; - Add a primitives for switching to a branch (creating it if required.
+;;
+;; - Add the ability to list tags and branches.
+;;
+;;;; Unify two different versions of the amend capability
+;;
+;; - Some back ends (SCCS/RCS/SVN/SRC), have an amend capability that can
+;; be invoked from log-view.
+;;
+;; - The git backend supports amending, but in a different
+;; way (press `C-c C-e' in log-edit buffer, when making a new commit).
;;
-;; - backends that care about vc-stay-local should try to take it into
-;; account for vc-dir. Is this likely to be useful??? YES!
+;; - Second, `log-view-modify-change-comment' doesn't seem to support
+;; modern backends at all because `log-view-extract-comment'
+;; unconditionally calls `log-view-current-file'. This should be easy to
+;; fix.
;;
-;; - vc-expand-dirs should take a backend parameter and only look for
-;; files managed by that backend.
+;; - Third, doing message editing in log-view might be a natural way to go
+;; about it, but editing any but the last commit (and even it, if it's
+;; been pushed) is a dangerous operation in Git, which we shouldn't make
+;; too easy for users to perform.
;;
-;; - Another important thing: merge all the status-like backend operations.
-;; We should remove dir-status, state, and dir-status-files, and
-;; replace them with just `status' which takes a fileset and a continuation
-;; (like dir-status) and returns a buffer in which the process(es) are run
-;; (or nil if it worked synchronously). Hopefully we can define the old
-;; 4 operations in term of this one.
+;; There should be a check that the given comment is not reachable
+;; from any of the "remote" refs?
;;
;;;; Other
;;
+;; - asynchronous checkin and commit, so you can keep working in other
+;; buffers while the repo operation happens.
+;;
+;; - Direct support for stash/shelve.
+;;
;; - when a file is in `conflict' state, turn on smerge-mode.
;;
;; - figure out what to do with conflicts that are not caused by the
@@ -666,6 +707,7 @@
(require 'vc-hooks)
(require 'vc-dispatcher)
+(require 'cl-lib)
(declare-function diff-setup-whitespace "diff-mode" ())
@@ -694,14 +736,6 @@
(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
-(defcustom vc-default-init-revision "1.1"
- "A string used as the default revision number when a new file is registered.
-This can be overridden by giving a prefix argument to \\[vc-register]. This
-can also be overridden by a particular VC backend."
- :type 'string
- :group 'vc
- :version "20.3")
-
(defcustom vc-checkin-switches nil
"A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
@@ -748,12 +782,25 @@ not specific to any particular backend."
:group 'vc
:version "21.1")
-(defcustom vc-diff-knows-L nil
- "Indicates whether diff understands the -L option.
-The value is either `yes', `no', or nil. If it is nil, VC tries
-to use -L and sets this variable to remember whether it worked."
- :type '(choice (const :tag "Work out" nil) (const yes) (const no))
- :group 'vc)
+(defcustom vc-annotate-switches nil
+ "A string or list of strings specifying switches for annotate under VC.
+When running annotate under a given BACKEND, VC uses the first
+non-nil value of `vc-BACKEND-annotate-switches', `vc-annotate-switches',
+and `annotate-switches', in that order. Since nil means to check the
+next variable in the sequence, either of the first two may use
+the value t to mean no switches at all. `vc-annotate-switches'
+should contain switches that are specific to version control, but
+not specific to any particular backend.
+
+As very few switches (if any) are used across different VC tools,
+please consider using the specific `vc-BACKEND-annotate-switches'
+for the backend you use."
+ :type '(choice (const :tag "Unspecified" nil)
+ (const :tag "None" t)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :group 'vc
+ :version "25.1")
(defcustom vc-log-show-limit 2000
"Limit the number of items shown by the VC log commands.
@@ -804,9 +851,9 @@ See `run-hooks'."
(defcustom vc-static-header-alist
'(("\\.c\\'" .
- "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
+ "\n#ifndef lint\nstatic char vcid[] = \"%s\";\n#endif /* lint */\n"))
"Associate static header string templates with file types.
-A \%s in the template is replaced with the first string associated with
+A %s in the template is replaced with the first string associated with
the file's version control type in `vc-BACKEND-header'."
:type '(repeat (cons :format "%v"
(regexp :tag "File Type")
@@ -826,13 +873,6 @@ is sensitive to blank lines."
:group 'vc)
-;; Variables users don't need to see
-
-(defvar vc-disable-async-diff nil
- "VC sets this to t locally to disable some async diff operations.
-Backends that offer asynchronous diffs should respect this variable
-in their implementation of vc-BACKEND-diff.")
-
;; File property caching
(defun vc-clear-context ()
@@ -912,6 +952,7 @@ use."
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
+;;;###autoload
(defun vc-responsible-backend (file)
"Return the name of a backend system that is responsible for FILE.
@@ -928,14 +969,14 @@ responsible for FILE is returned."
(throw 'found backend))))
(error "No VC backend is responsible for %s" file)))
-(defun vc-expand-dirs (file-or-dir-list)
+(defun vc-expand-dirs (file-or-dir-list backend)
"Expands directories in a file list specification.
Within directories, only files already under version control are noticed."
(let ((flattened '()))
(dolist (node file-or-dir-list)
(when (file-directory-p node)
(vc-file-tree-walk
- node (lambda (f) (when (vc-backend f) (push f flattened)))))
+ node (lambda (f) (when (eq (vc-backend f) backend) (push f flattened)))))
(unless (file-directory-p node) (push node flattened)))
(nreverse flattened)))
@@ -962,7 +1003,8 @@ Within directories, only files already under version control are noticed."
"Deduce a set of files and a backend to which to apply an operation.
Return (BACKEND FILESET FILESET-ONLY-FILES STATE CHECKOUT-MODEL).
-If we're in VC-dir mode, FILESET is the list of marked files.
+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.
Otherwise, if ALLOW-UNREGISTERED is non-nil and the visited file
@@ -972,8 +1014,8 @@ 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.
-BEWARE: this function may change the
-current buffer."
+
+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.
(let (backend)
@@ -984,6 +1026,9 @@ current buffer."
(if observer
(vc-dired-deduce-fileset)
(error "State changing VC operations not supported in `dired-mode'")))
+ ((and (derived-mode-p 'log-view-mode)
+ (setq backend (vc-responsible-backend default-directory)))
+ (list backend default-directory))
((setq backend (vc-backend buffer-file-name))
(if state-model-only-files
(list backend (list buffer-file-name)
@@ -1078,8 +1123,7 @@ For old-style locking-based version control systems, like RCS:
If every file is registered and unlocked, check out (lock)
the file(s) for editing.
If every file is locked by you and has changes, pop up a
- *vc-log* buffer to check in the changes. If the variable
- `vc-keep-workfiles' is non-nil (the default), leave a
+ *vc-log* buffer to check in the changes. Leave a
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
If every file is locked by someone else, offer to steal the lock."
@@ -1110,7 +1154,7 @@ For old-style locking-based version control systems, like RCS:
((eq state 'ignored)
(error "Fileset files are ignored by the version-control system"))
((or (null state) (eq state 'unregistered))
- (vc-register nil vc-fileset))
+ (vc-register vc-fileset))
;; Files are up-to-date, or need a merge and user specified a revision
((or (eq state 'up-to-date) (and verbose (eq state 'needs-update)))
(cond
@@ -1127,10 +1171,10 @@ For old-style locking-based version control systems, like RCS:
(let ((vsym (intern-soft revision-downcase)))
(dolist (file files) (vc-transfer-file file vsym)))
(dolist (file files)
- (vc-checkout file (eq model 'implicit) revision)))))
+ (vc-checkout file revision)))))
((not (eq model 'implicit))
;; check the files out
- (dolist (file files) (vc-checkout file t)))
+ (dolist (file files) (vc-checkout file)))
(t
;; do nothing
(message "Fileset is up-to-date"))))
@@ -1147,7 +1191,7 @@ For old-style locking-based version control systems, like RCS:
;; state of each individual file in the fileset, it seems
;; simplest to just check if the file exists. Bug#9781.
(when (and (file-exists-p file) (not (file-writable-p file)))
- ;; Make the file+buffer read-write.
+ ;; Make the file-buffer read-write.
(unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file))
(error "Aborted"))
;; Maybe we somehow lost permissions on the directory.
@@ -1165,7 +1209,7 @@ For old-style locking-based version control systems, like RCS:
;; For files with locking, if the file does not contain
;; any changes, just let go of the lock, i.e. revert.
(when (and (not (eq model 'implicit))
- (vc-workfile-unchanged-p file)
+ (eq state 'up-to-date)
;; If buffer is modified, that means the user just
;; said no to saving it; in that case, don't revert,
;; because the user might intend to save after
@@ -1178,10 +1222,15 @@ For old-style locking-based version control systems, like RCS:
(message "No files remain to be committed")
(if (not verbose)
(vc-checkin ready-for-commit backend)
- (let ((new-backend (vc-read-backend "New backend: ")))
- (if new-backend
- (dolist (file files)
- (vc-transfer-file file new-backend))))))))
+ (let* ((revision (read-string "New revision or backend: "))
+ (revision-downcase (downcase revision)))
+ (if (member
+ revision-downcase
+ (mapcar (lambda (arg) (downcase (symbol-name arg)))
+ vc-handled-backends))
+ (let ((vsym (intern revision-downcase)))
+ (dolist (file files) (vc-transfer-file file vsym)))
+ (vc-checkin ready-for-commit backend nil nil revision)))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
;; In the old days, we computed the revision once and used it on
@@ -1216,10 +1265,10 @@ For old-style locking-based version control systems, like RCS:
(if (yes-or-no-p (format
"%s is not up-to-date. Get latest revision? "
(file-name-nondirectory file)))
- (vc-checkout file (eq model 'implicit) t)
+ (vc-checkout file t)
(when (and (not (eq model 'implicit))
(yes-or-no-p "Lock this revision? "))
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; needs-merge
((eq state 'needs-merge)
(dolist (file files)
@@ -1247,16 +1296,13 @@ For old-style locking-based version control systems, like RCS:
"Claim lock retaining changes? ")))
(progn (vc-call-backend backend 'steal-lock file)
(clear-visited-file-modtime)
- ;; Must clear any headers here because they wouldn't
- ;; show that the file is locked now.
- (vc-clear-headers file)
(write-file buffer-file-name)
(vc-mode-line file backend))
(if (not (yes-or-no-p
"Revert to checked-in revision, instead? "))
(error "Checkout aborted")
(vc-revert-buffer-internal t t)
- (vc-checkout file t)))))
+ (vc-checkout file)))))
;; Unknown fileset state
(t
(error "Fileset is in an unknown state %s" state)))))
@@ -1276,12 +1322,11 @@ For old-style locking-based version control systems, like RCS:
(declare-function vc-dir-move-to-goal-column "vc-dir" ())
;;;###autoload
-(defun vc-register (&optional set-revision vc-fileset comment)
+(defun vc-register (&optional vc-fileset comment)
"Register into a version control system.
If VC-FILESET is given, register the files in that fileset.
Otherwise register the current file.
-With prefix argument SET-REVISION, allow user to specify initial revision
-level. If COMMENT is present, use that as an initial comment.
+If COMMENT is present, use that as an initial comment.
The version control system to use is found by cycling through the list
`vc-handled-backends'. The first backend in that list which declares
@@ -1313,11 +1358,7 @@ first backend that could register the file is used."
(vc-buffer-sync)))))
(message "Registering %s... " files)
(mapc 'vc-file-clearprops files)
- (vc-call-backend backend 'register files
- (if set-revision
- (read-string (format "Initial revision level for %s: " files))
- (vc-call-backend backend 'init-revision))
- comment)
+ (vc-call-backend backend 'register files comment)
(mapc
(lambda (file)
(vc-file-setprop file 'vc-backend backend)
@@ -1328,7 +1369,7 @@ first backend that could register the file is used."
;; (make-local-variable 'backup-inhibited)
;; (setq backup-inhibited t))
- (vc-resynch-buffer file vc-keep-workfiles t))
+ (vc-resynch-buffer file t t))
files)
(when (derived-mode-p 'vc-dir-mode)
(vc-dir-move-to-goal-column))
@@ -1343,32 +1384,57 @@ first backend that could register the file is used."
(call-interactively 'vc-register)))
(defun vc-ignore (file &optional directory remove)
- "Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
-When called interactively and with a prefix argument, remove FILE
-from ignored files.
-When called from Lisp code, if DIRECTORY is non-nil, the
-repository to use will be deduced by DIRECTORY; if REMOVE is
-non-nil, remove FILE from ignored files."
+ "Ignore FILE under the VCS of DIRECTORY.
+
+Normally, FILE is a wildcard specification that matches the files
+to be ignored. When REMOVE is non-nil, remove FILE from the list
+of ignored files.
+
+DIRECTORY defaults to `default-directory' and is used to
+determine the responsible VC backend.
+
+When called interactively, prompt for a FILE to ignore, unless a
+prefix argument is given, in which case prompt for a file FILE to
+remove from the list of ignored files."
(interactive
- (if (null current-prefix-arg)
- (list (read-file-name "The file to ignore: "))
- (list
+ (list
+ (if (not current-prefix-arg)
+ (read-file-name "File to ignore: ")
(completing-read
- "The file to remove: "
+ "File to remove: "
(vc-call-backend
- (vc-backend default-directory)
- 'ignore-completion-table default-directory)))))
- (let (backend)
- (if directory
- (progn (setq backend (vc-backend default-directory))
- (vc-call-backend backend 'ignore file directory remove))
- (setq backend (vc-backend directory))
- (vc-call-backend backend 'ignore file default-directory remove))))
-
-(defun vc-default-ignore-completion-table (_file)
- "Return the list of ignored files."
- ;; Unused lexical argument `file'
- nil)
+ (or (vc-responsible-backend default-directory)
+ (error "Unknown backend"))
+ 'ignore-completion-table default-directory)))
+ nil current-prefix-arg))
+ (let* ((directory (or directory default-directory))
+ (backend (or (vc-responsible-backend default-directory)
+ (error "Unknown backend"))))
+ (vc-call-backend backend 'ignore file directory remove)))
+
+(defun vc-default-ignore (backend file &optional directory remove)
+ "Ignore FILE under the VCS of DIRECTORY (default is `default-directory').
+FILE is a file wildcard, relative to the root directory of DIRECTORY.
+When called from Lisp code, if DIRECTORY is non-nil, the
+repository to use will be deduced by DIRECTORY; if REMOVE is
+non-nil, remove FILE from ignored files.
+Argument BACKEND is the backend you are using."
+ (let ((ignore
+ (vc-call-backend backend 'find-ignore-file (or directory default-directory)))
+ (pattern (file-relative-name
+ (expand-file-name file) (file-name-directory file))))
+ (if remove
+ (vc--remove-regexp pattern ignore)
+ (vc--add-line pattern ignore))))
+
+(defun vc-default-ignore-completion-table (backend file)
+ "Return the list of ignored files under BACKEND."
+ (cl-delete-if
+ (lambda (str)
+ ;; Commented or empty lines.
+ (string-match-p "\\`\\(?:#\\|[ \t\r\n]*\\'\\)" str))
+ (vc--read-lines
+ (vc-call-backend backend 'find-ignore-file file))))
(defun vc--read-lines (file)
"Return a list of lines of FILE."
@@ -1394,32 +1460,28 @@ non-nil, remove FILE from ignored files."
(replace-match ""))
(write-region (point-min) (point-max) file)))
-(defun vc-checkout (file &optional writable rev)
+(defun vc-checkout (file &optional rev)
"Retrieve a copy of the revision REV of FILE.
-If WRITABLE is non-nil, make sure the retrieved file is writable.
REV defaults to the latest revision.
After check-out, runs the normal hook `vc-checkout-hook'."
- (and writable
- (not rev)
+ (and (not rev)
(vc-call make-version-backups-p file)
(vc-up-to-date-p file)
(vc-make-version-backup file))
(let ((backend (vc-backend file)))
(with-vc-properties (list file)
(condition-case err
- (vc-call-backend backend 'checkout file writable rev)
+ (vc-call-backend backend 'checkout file rev)
(file-error
;; Maybe the backend is not installed ;-(
- (when writable
+ (when t
(let ((buf (get-file-buffer file)))
(when buf (with-current-buffer buf (read-only-mode -1)))))
(signal (car err) (cdr err))))
`((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit)
- (not writable))
- (if (vc-call-backend backend 'latest-on-branch-p file)
- 'up-to-date
- 'needs-update)
+ nil)
+ 'up-to-date
'edited))
(vc-checkout-time . ,(nth 5 (file-attributes file))))))
(vc-resynch-buffer file t t)
@@ -1466,16 +1528,13 @@ Type \\[vc-next-action] to check in changes.")
".\n")
(message "Please explain why you stole the lock. Type C-c C-c when done.")))
-(defun vc-checkin (files backend &optional rev comment initial-contents)
- "Check in FILES.
+(defun vc-checkin (files backend &optional comment initial-contents rev)
+ "Check in FILES. COMMENT is a comment string; if omitted, a
+buffer is popped up to accept a comment. If INITIAL-CONTENTS is
+non-nil, then COMMENT is used as the initial contents of the log
+entry buffer.
The optional argument REV may be a string specifying the new revision
-level (strongly deprecated). COMMENT is a comment
-string; if omitted, a buffer is popped up to accept a comment. If
-INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents
-of the log entry buffer.
-
-If `vc-keep-workfiles' is nil, FILE is deleted afterwards, provided
-that the version control system supports this mode of operation.
+level (only supported for some older VCSes, like RCS and CVS).
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(when vc-before-checkin-hook
@@ -1498,7 +1557,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
;; vc-checkin-switches, but 'the' local buffer is
;; not a well-defined concept for filesets.
(progn
- (vc-call-backend backend 'checkin files rev comment)
+ (vc-call-backend backend 'checkin files comment rev)
(mapc 'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
(vc-checkout-time . ,(nth 5 (file-attributes file)))
@@ -1522,11 +1581,11 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
;; (vc-file-tree-walk
;; default-directory
;; (lambda (f)
-;; (vc-exec-after
-;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
-;; (message "Looking at %s" ',f)
-;; (vc-call-backend ',(vc-backend f)
-;; 'diff (list ',f) ',rev1 ',rev2))))))
+;; (vc-run-delayed
+;; (let ((coding-system-for-read (vc-coding-system-for-diff f)))
+;; (message "Looking at %s" f)
+;; (vc-call-backend (vc-backend f)
+;; 'diff (list f) rev1 rev2))))))
(defvar vc-coding-system-inherit-eol t
"When non-nil, inherit the EOL format for reading Diff output from the file.
@@ -1629,6 +1688,13 @@ Return t if the buffer had changes, nil otherwise."
;; be to call the back end separately for each file.
(coding-system-for-read
(if files (vc-coding-system-for-diff (car files)) 'undecided)))
+ ;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style
+ ;; EOLs, which will look ugly if (car files) happens to have Unix
+ ;; EOLs.
+ (if (memq system-type '(windows-nt ms-dos))
+ (setq coding-system-for-read
+ (coding-system-change-eol-conversion coding-system-for-read
+ 'dos)))
(vc-setup-buffer buffer)
(message "%s" (car messages))
;; Many backends don't handle well the case of a file that has been
@@ -1655,17 +1721,16 @@ Return t if the buffer had changes, nil otherwise."
;; We regard this as "changed".
;; Diff it against /dev/null.
(apply 'vc-do-command buffer
- 1 "diff" file
+ (if async 'async 1) "diff" file
(append (vc-switches nil 'diff) '("/dev/null"))))))
(setq files (nreverse filtered))))
- (let ((vc-disable-async-diff (not async)))
- (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer))
+ (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
(diff-mode)
(set (make-local-variable 'diff-vc-backend) (car vc-fileset))
(set (make-local-variable 'revert-buffer-function)
- `(lambda (ignore-auto noconfirm)
- (vc-diff-internal ,async ',vc-fileset ,rev1 ,rev2 ,verbose)))
+ (lambda (_ignore-auto _noconfirm)
+ (vc-diff-internal async vc-fileset rev1 rev2 verbose)))
;; Make the *vc-diff* buffer read only, the diff-mode key
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
@@ -1681,8 +1746,8 @@ Return t if the buffer had changes, nil otherwise."
;; The diff process may finish early, so call `vc-diff-finish'
;; after `pop-to-buffer'; the former assumes the diff buffer is
;; shown in some window.
- (vc-exec-after `(vc-diff-finish ,(current-buffer)
- ',(when verbose messages)))
+ (let ((buf (current-buffer)))
+ (vc-run-delayed (vc-diff-finish buf (when verbose messages))))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
@@ -1720,13 +1785,12 @@ Return t if the buffer had changes, nil otherwise."
;; if the file is not up-to-date, use working revision as older revision
((not (vc-up-to-date-p first))
(setq rev1-default (vc-working-revision first)))
- ;; if the file is not locked, use last and previous revisions as defaults
+ ;; if the file is not locked, use last revision and current source as defaults
(t
(setq rev1-default (ignore-errors ;If `previous-revision' doesn't work.
(vc-call-backend backend 'previous-revision first
(vc-working-revision first))))
- (when (string= rev1-default "") (setq rev1-default nil))
- (setq rev2-default (vc-working-revision first))))
+ (when (string= rev1-default "") (setq rev1-default nil))))
;; construct argument list
(let* ((rev1-prompt (if rev1-default
(concat "Older revision (default "
@@ -1851,6 +1915,19 @@ saving the buffer."
(called-interactively-p 'interactive))))))
;;;###autoload
+(defun vc-root-dir ()
+ "Return the root directory for the current VC tree.
+Return nil if the root directory cannot be identified."
+ (let ((backend (vc-deduce-backend)))
+ (if backend
+ (condition-case err
+ (vc-call-backend backend 'root default-directory)
+ (vc-not-supported
+ (unless (eq (cadr err) 'root)
+ (signal (car err) (cdr err)))
+ nil)))))
+
+;;;###autoload
(defun vc-revision-other-window (rev)
"Visit revision REV of the current file in another window.
If the current file is named `F', the revision is named `F.~REV~'.
@@ -1931,25 +2008,6 @@ the variable `vc-BACKEND-header'."
(when (string-match (car f) buffer-file-name)
(insert (format (cdr f) (car hdstrings)))))))))))
-(defun vc-clear-headers (&optional file)
- "Clear all version headers in the current buffer (or FILE).
-The headers are reset to their non-expanded form."
- (let* ((filename (or file buffer-file-name))
- (visited (find-buffer-visiting filename))
- (backend (vc-backend filename)))
- (when (vc-find-backend-function backend 'clear-headers)
- (if visited
- (let ((context (vc-buffer-context)))
- ;; save-excursion may be able to relocate point and mark
- ;; properly. If it fails, vc-restore-buffer-context
- ;; will give it a second try.
- (save-excursion
- (vc-call-backend backend 'clear-headers))
- (vc-restore-buffer-context context))
- (set-buffer (find-file-noselect filename))
- (vc-call-backend backend 'clear-headers)
- (kill-buffer filename)))))
-
(defun vc-modify-change-comment (files rev oldcomment)
"Edit the comment associated with the given files and revision."
;; Less of a kluge than it looks like; log-view mode only passes
@@ -1992,42 +2050,17 @@ changes from the current branch."
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
- first-revision second-revision status)
+ status)
(cond
((stringp state) ;; Locking VCses only
(error "File %s is locked by %s" file state))
((not (vc-editable-p file))
(vc-checkout file t)))
- (setq first-revision
- (vc-read-revision
- (concat "Merge " file
- " from branch or revision "
- "(default news on current branch): ")
- (list file)
- backend))
- (cond
- ((string= first-revision "")
- (setq status (vc-call-backend backend 'merge-news file)))
- (t
- (if (not (vc-branch-p first-revision))
- (setq second-revision
- (vc-read-revision
- "Second revision: "
- (list file) backend nil
- ;; FIXME: This is CVS/RCS/SCCS specific.
- (concat (vc-branch-part first-revision) ".")))
- ;; We want to merge an entire branch. Set revisions
- ;; accordingly, so that vc-BACKEND-merge understands us.
- (setq second-revision first-revision)
- ;; first-revision must be the starting point of the branch
- (setq first-revision (vc-branch-part first-revision)))
- (setq status (vc-call-backend backend 'merge file
- first-revision second-revision))))
+ (setq status (vc-call-backend backend 'merge-file file))
(vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
(t
(error "Sorry, merging is not implemented for %s" backend)))))
-
(defun vc-maybe-resolve-conflicts (file status &optional _name-A _name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
(if (zerop status) (message "Merge successful")
@@ -2052,8 +2085,9 @@ changes from the current branch."
(let* ((backend (or (if buffer-file-name (vc-backend buffer-file-name))
(vc-responsible-backend default-directory)
(error "No VC backend")))
+ (root (vc-root-dir))
(files (vc-call-backend backend
- 'conflicted-files default-directory)))
+ 'conflicted-files (or root default-directory))))
;; Don't try and visit the current file.
(if (equal (car files) buffer-file-name) (pop files))
(if (null files)
@@ -2067,7 +2101,7 @@ changes from the current branch."
(defun vc-tag-precondition (dir)
"Scan the tree below DIR, looking for files not up-to-date.
If any file is not up-to-date, return the name of the first such file.
-\(This means, neither tag creation nor retrieval is allowed.\)
+\(This means, neither tag creation nor retrieval is allowed.)
If one or more of the files are currently visited, return `visited'.
Otherwise, return nil."
(let ((status nil))
@@ -2107,8 +2141,12 @@ checked out in that new branch."
;;;###autoload
(defun vc-retrieve-tag (dir name)
- "Descending recursively from DIR, retrieve the tag called NAME.
-If NAME is empty, it refers to the latest revisions.
+ "For each file in or below DIR, retrieve their tagged version NAME.
+NAME can name a branch, in which case this command will switch to the
+named branch in the directory DIR.
+Interactively, prompt for DIR only for VCS that works at file level;
+otherwise use the default directory of the current buffer.
+If NAME is empty, it refers to the latest revisions of the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
allowed and simply skipped)."
@@ -2186,19 +2224,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
;; buffer can be accessed by the command.
- (let ((dir-present nil)
- (vc-short-log nil)
+ (let* ((dir-present (cl-some #'file-directory-p files))
+ (shortlog (not (null (memq (if dir-present 'directory 'file)
+ vc-log-short-style))))
(buffer-name "*vc-change-log*")
- type)
- (dolist (file files)
- (when (file-directory-p file)
- (setq dir-present t)))
- (setq vc-short-log
- (not (null (if dir-present
- (memq 'directory vc-log-short-style)
- (memq 'file vc-log-short-style)))))
- (setq type (if vc-short-log 'short 'long))
- (let ((shortlog vc-short-log))
+ (type (if shortlog 'short 'long)))
(vc-log-internal-common
backend buffer-name files type
(lambda (bk buf _type-arg files-arg)
@@ -2207,15 +2237,18 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(lambda (_bk _files-arg ret)
(vc-print-log-setup-buttons working-revision
is-start-revision limit ret))
- (lambda (bk)
- (vc-call-backend bk 'show-log-entry working-revision))
+ ;; When it's nil, point really shouldn't move (bug#15322).
+ (when working-revision
+ (lambda (bk)
+ (vc-call-backend bk 'show-log-entry working-revision)))
(lambda (_ignore-auto _noconfirm)
(vc-print-log-internal backend files working-revision
- is-start-revision limit))))))
+ is-start-revision limit)))))
(defvar vc-log-view-type nil
"Set this to differentiate the different types of logs.")
(put 'vc-log-view-type 'permanent-local t)
+(defvar vc-sentinel-movepoint)
(defun vc-log-internal-common (backend
buffer-name
@@ -2229,22 +2262,26 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(with-current-buffer (get-buffer-create buffer-name)
(set (make-local-variable 'vc-log-view-type) type))
(setq retval (funcall backend-func backend buffer-name type files))
+ (with-current-buffer (get-buffer buffer-name)
+ (let ((inhibit-read-only t))
+ ;; log-view-mode used to be called with inhibit-read-only bound
+ ;; to t, so let's keep doing it, just in case.
+ (vc-call-backend backend 'log-view-mode)
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) files)
+ (set (make-local-variable 'revert-buffer-function)
+ rev-buff-func)))
+ ;; Display after setting up major-mode, so display-buffer-alist can know
+ ;; the major-mode.
(pop-to-buffer buffer-name)
- (let ((inhibit-read-only t))
- ;; log-view-mode used to be called with inhibit-read-only bound
- ;; to t, so let's keep doing it, just in case.
- (vc-call-backend backend 'log-view-mode)
- (set (make-local-variable 'log-view-vc-backend) backend)
- (set (make-local-variable 'log-view-vc-fileset) files)
- (set (make-local-variable 'revert-buffer-function)
- rev-buff-func))
- (vc-exec-after
- `(let ((inhibit-read-only t))
- (funcall ',setup-buttons-func ',backend ',files ',retval)
- (shrink-window-if-larger-than-buffer)
- (funcall ',goto-location-func ',backend)
- (setq vc-sentinel-movepoint (point))
- (set-buffer-modified-p nil)))))
+ (vc-run-delayed
+ (let ((inhibit-read-only t))
+ (funcall setup-buttons-func backend files retval)
+ (shrink-window-if-larger-than-buffer)
+ (when goto-location-func
+ (funcall goto-location-func backend)
+ (setq vc-sentinel-movepoint (point)))
+ (set-buffer-modified-p nil)))))
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
@@ -2252,7 +2289,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(lambda (bk buf type-arg _files)
(vc-call-backend bk type-arg buf remote-location))
(lambda (_bk _files-arg _ret) nil)
- (lambda (_bk) (goto-char (point-min)))
+ nil ;; Don't move point.
(lambda (_ignore-auto _noconfirm)
(vc-incoming-outgoing-internal backend remote-location buffer-name type))))
@@ -2283,7 +2320,8 @@ WORKING-REVISION and LIMIT."
(let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: Why t? --Stef
(backend (car vc-fileset))
(files (cadr vc-fileset))
- (working-revision (or working-revision (vc-working-revision (car files)))))
+;; (working-revision (or working-revision (vc-working-revision (car files))))
+ )
(vc-print-log-internal backend files working-revision nil limit)))
;;;###autoload
@@ -2306,21 +2344,20 @@ When called interactively with a prefix argument, prompt for LIMIT."
(list (when (> vc-log-show-limit 0) vc-log-show-limit)))))
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
- rootdir working-revision)
+ rootdir)
(if backend
(setq rootdir (vc-call-backend backend 'root default-directory))
(setq rootdir (read-directory-name "Directory for VC root-log: "))
(setq backend (vc-responsible-backend rootdir))
- (if backend
- (setq default-directory rootdir)
- (error "Directory is not version controlled")))
- (setq working-revision (vc-working-revision rootdir))
- (vc-print-log-internal backend (list rootdir) working-revision nil limit)))
+ (unless backend
+ (error "Directory is not version controlled")))
+ (setq default-directory rootdir)
+ (vc-print-log-internal backend (list rootdir) nil nil limit)))
;;;###autoload
(defun vc-log-incoming (&optional remote-location)
"Show a log of changes that will be received with a pull operation from REMOTE-LOCATION.
-When called interactively with a prefix argument, prompt for REMOTE-LOCATION.."
+When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
(interactive
(when current-prefix-arg
(list (read-string "Remote location (empty for default): "))))
@@ -2344,6 +2381,29 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
'log-outgoing)))
;;;###autoload
+(defun vc-region-history (from to)
+ "Show the history of the region FROM..TO."
+ (interactive "r")
+ (let* ((lfrom (line-number-at-pos from))
+ (lto (line-number-at-pos to))
+ (file buffer-file-name)
+ (backend (vc-backend file))
+ (buf (get-buffer-create "*VC-history*")))
+ (with-current-buffer buf
+ (setq-local vc-log-view-type 'long))
+ (vc-call region-history file buf lfrom lto)
+ (with-current-buffer buf
+ (vc-call-backend backend 'region-history-mode)
+ (set (make-local-variable 'log-view-vc-backend) backend)
+ (set (make-local-variable 'log-view-vc-fileset) file)
+ (set (make-local-variable 'revert-buffer-function)
+ (lambda (_ignore-auto _noconfirm)
+ (with-current-buffer buf
+ (let ((inhibit-read-only t)) (erase-buffer)))
+ (vc-call region-history file buf lfrom lto))))
+ (display-buffer buf)))
+
+;;;###autoload
(defun vc-revert ()
"Revert working copies of the selected fileset to their repository contents.
This asks for confirmation if the buffer contents are not identical
@@ -2391,58 +2451,6 @@ to the working revision (except for keyword expansion)."
(message "Reverting %s...done" (vc-delistify files)))))
;;;###autoload
-(defun vc-rollback ()
- "Roll back (remove) the most recent changeset committed to the repository.
-This may be either a file-level or a repository-level operation,
-depending on the underlying version-control system."
- (interactive)
- (let* ((vc-fileset (vc-deduce-fileset))
- (backend (car vc-fileset))
- (files (cadr vc-fileset))
- (granularity (vc-call-backend backend 'revision-granularity)))
- (unless (vc-find-backend-function backend 'rollback)
- (error "Rollback is not supported in %s" backend))
- (when (and (not (eq granularity 'repository)) (/= (length files) 1))
- (error "Rollback requires a singleton fileset or repository versioning"))
- ;; FIXME: latest-on-branch-p should take the fileset.
- (when (not (vc-call-backend backend 'latest-on-branch-p (car files)))
- (error "Rollback is only possible at the tip revision"))
- ;; If any of the files is visited by the current buffer, make
- ;; sure buffer is saved. If the user says `no', abort since
- ;; we cannot show the changes and ask for confirmation to
- ;; discard them.
- (when (or (not files) (memq (buffer-file-name) files))
- (vc-buffer-sync nil))
- (dolist (file files)
- (when (buffer-modified-p (get-file-buffer file))
- (error "Please kill or save all modified buffers before rollback"))
- (when (not (vc-up-to-date-p file))
- (error "Please revert all modified workfiles before rollback")))
- ;; Accumulate changes associated with the fileset
- (vc-setup-buffer "*vc-diff*")
- (not-modified)
- (message "Finding changes...")
- (let* ((tip (vc-working-revision (car files)))
- ;; FIXME: `previous-revision' should take the fileset.
- (previous (vc-call-backend backend 'previous-revision
- (car files) tip)))
- (vc-diff-internal nil vc-fileset previous tip))
- ;; Display changes
- (unless (yes-or-no-p "Discard these revisions? ")
- (error "Rollback canceled"))
- (quit-windows-on "*vc-diff*")
- ;; Do the actual reversions
- (message "Rolling back %s..." (vc-delistify files))
- (with-vc-properties
- files
- (vc-call-backend backend 'rollback files)
- `((vc-state . ,'up-to-date)
- (vc-checkout-time . , (nth 5 (file-attributes file)))
- (vc-working-revision . nil)))
- (dolist (f files) (vc-resynch-buffer f t t))
- (message "Rolling back %s...done" (vc-delistify files))))
-
-;;;###autoload
(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
;;;###autoload
@@ -2475,20 +2483,36 @@ tip revision are merged into the working file."
(and file (member file files))))))
(dolist (file files)
(if (vc-up-to-date-p file)
- (vc-checkout file nil t)
+ (vc-checkout file t)
(vc-maybe-resolve-conflicts
file (vc-call-backend backend 'merge-news file)))))
;; For a locking VCS, check out each file.
((eq (vc-checkout-model backend files) 'locking)
(dolist (file files)
(if (vc-up-to-date-p file)
- (vc-checkout file nil t))))
+ (vc-checkout file t))))
(t
(error "VC update is unsupported for `%s'" backend)))))
;;;###autoload
(defalias 'vc-update 'vc-pull)
+;;;###autoload
+(defun vc-push (&optional arg)
+ "Push the current branch.
+You must be visiting a version controlled file, or in a `vc-dir' buffer.
+On a distributed version control system, this runs a \"push\"
+operation on the current branch, prompting for the precise command
+if required. Optional prefix ARG non-nil forces a prompt.
+On a non-distributed version control system, this signals an error."
+ (interactive "P")
+ (let* ((vc-fileset (vc-deduce-fileset t))
+ (backend (car vc-fileset)))
+;;; (files (cadr vc-fileset)))
+ (if (vc-find-backend-function backend 'push)
+ (vc-call-backend backend 'push arg)
+ (user-error "VC push is unsupported for `%s'" backend))))
+
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
If version backups should be used for FILE, and there exists
@@ -2604,7 +2628,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(when modified-file
(vc-switch-backend file new-backend)
(unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
- (vc-checkout file t nil))
+ (vc-checkout file))
(rename-file modified-file file 'ok-if-already-exists)
(vc-file-setprop file 'vc-checkout-time nil)))))
(when move
@@ -2615,34 +2639,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file new-backend)
- (vc-checkin file new-backend nil comment (stringp comment)))))
-
-(defun vc-rename-master (oldmaster newfile templates)
- "Rename OLDMASTER to be the master file for NEWFILE based on TEMPLATES."
- (let* ((dir (file-name-directory (expand-file-name oldmaster)))
- (newdir (or (file-name-directory newfile) ""))
- (newbase (file-name-nondirectory newfile))
- (masters
- ;; List of potential master files for `newfile'
- (mapcar
- (lambda (s) (vc-possible-master s newdir newbase))
- templates)))
- (when (or (file-symlink-p oldmaster)
- (file-symlink-p (file-name-directory oldmaster)))
- (error "This is unsafe in the presence of symbolic links"))
- (rename-file
- oldmaster
- (catch 'found
- ;; If possible, keep the master file in the same directory.
- (dolist (f masters)
- (when (and f (string= (file-name-directory (expand-file-name f)) dir))
- (throw 'found f)))
- ;; If not, just use the first possible place.
- (dolist (f masters)
- (and f (or (not (setq dir (file-name-directory f)))
- (file-directory-p dir))
- (throw 'found f)))
- (error "New file lacks a version control directory")))))
+ (vc-checkin file new-backend comment (stringp comment)))))
;;;###autoload
(defun vc-delete-file (file)
@@ -2777,19 +2774,6 @@ log entries should be gathered."
The default is to return nil always."
nil)
-(defun vc-default-could-register (_backend _file)
- "Return non-nil if BACKEND could be used to register FILE.
-The default implementation returns t for all files."
- t)
-
-(defun vc-default-latest-on-branch-p (_backend _file)
- "Return non-nil if FILE is the latest on its branch.
-This default implementation always returns non-nil, which means that
-editing non-current revisions is not supported by default."
- t)
-
-(defun vc-default-init-revision (_backend) vc-default-init-revision)
-
(defun vc-default-find-revision (backend file rev buffer)
"Provide the new `find-revision' op based on the old `checkout' op.
This is only for compatibility with old backends. They should be updated
@@ -2884,9 +2868,9 @@ to provide the `find-revision' operation instead."
(defalias 'vc-default-revision-completion-table 'ignore)
(defalias 'vc-default-mark-resolved 'ignore)
-(defun vc-default-dir-status-files (_backend _dir files default-state update-function)
+(defun vc-default-dir-status-files (_backend _dir files update-function)
(funcall update-function
- (mapcar (lambda (file) (list file default-state)) files)))
+ (mapcar (lambda (file) (list file 'up-to-date)) files)))
(defun vc-check-headers ()
"Check if the current file has any headers in it."
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index b6ea3383bec..7e503269a8a 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,10 +1,10 @@
;;; vcursor.el --- manipulate an alternative ("virtual") cursor
-;; Copyright (C) 1994, 1996, 1998, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1994, 1996, 1998, 2001-2015 Free Software Foundation,
;; Inc.
;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: virtual cursor, convenience
;; This file is part of GNU Emacs.
@@ -573,11 +573,11 @@ With optional NOT-THIS non-nil never return the current window.
With NEW-WIN non-nil, display the virtual cursor buffer in another
window if the virtual cursor is not currently visible \(note, however,
-that this function never changes `window-point'\).
+that this function never changes `window-point').
With THIS-FRAME non-nil, don't search other frames for a new window
\(though if the vcursor is already off-frame then its current window is
-always considered, and the value of `pop-up-frames' is always respected\).
+always considered, and the value of `pop-up-frames' is always respected).
Returns nil if the virtual cursor is not visible anywhere suitable.
Set `vcursor-window' to the returned value as a side effect."
diff --git a/lisp/version.el b/lisp/version.el
index 96674566781..43103fde131 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,9 +1,9 @@
;;; version.el --- record version number of Emacs
-;; Copyright (C) 1985, 1992, 1994-1995, 1999-2013 Free Software
+;; Copyright (C) 1985, 1992, 1994-1995, 1999-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -41,12 +41,15 @@ This variable first existed in version 19.23.")
(defconst emacs-build-time (current-time)
"Time at which Emacs was dumped out.")
+;; I think this should be obsoleted/removed. It's just one more meaningless
+;; difference between different builds. It's usually not even an fqdn.
(defconst emacs-build-system (system-name)
"Name of the system on which Emacs was built.")
(defvar motif-version-string)
(defvar gtk-version-string)
(defvar ns-version-string)
+(defvar cairo-version-string)
(defun emacs-version (&optional here)
"Return string describing the version of Emacs that is running.
@@ -56,8 +59,8 @@ to the system configuration; look at `system-configuration' instead."
(interactive "P")
(let ((version-string
(format (if (not (called-interactively-p 'interactive))
- "GNU Emacs %s (%s%s%s)\n of %s on %s"
- "GNU Emacs %s (%s%s%s) of %s on %s")
+ "GNU Emacs %s (%s%s%s%s)\n of %s"
+ "GNU Emacs %s (%s%s%s%s) of %s")
emacs-version
system-configuration
(cond ((featurep 'motif)
@@ -68,13 +71,15 @@ to the system configuration; look at `system-configuration' instead."
((featurep 'ns)
(format ", NS %s" ns-version-string))
(t ""))
+ (if (featurep 'cairo)
+ (format ", cairo version %s" cairo-version-string)
+ "")
(if (and (boundp 'x-toolkit-scroll-bars)
(memq x-toolkit-scroll-bars '(xaw xaw3d)))
(format ", %s scroll bars"
(capitalize (symbol-name x-toolkit-scroll-bars)))
"")
- (format-time-string "%Y-%m-%d" emacs-build-time)
- emacs-build-system)))
+ (format-time-string "%Y-%m-%d" emacs-build-time))))
(if here
(insert version-string)
(if (called-interactively-p 'interactive)
@@ -85,93 +90,68 @@ to the system configuration; look at `system-configuration' instead."
(defalias 'version 'emacs-version)
;; Set during dumping, this is a defvar so that it can be setq'd.
-(defvar emacs-bzr-version nil
- "String giving the bzr revision from which this Emacs was built.
-The format is: [revno] revision_id, where revno may be absent.
-Value is nil if Emacs was not built from a bzr checkout, or if we could
-not determine the revision.")
-
-(defun emacs-bzr-version-dirstate (dir)
- "Try to return as a string the bzr revision ID of directory DIR.
-This uses the dirstate file's parent revision entry.
-Returns nil if unable to find this information."
- (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
- (when (file-readable-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (and (looking-at "#bazaar dirstate flat format 3")
- (forward-line 3)
- (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
- (match-string 1))))))
-
-(defun emacs-bzr-version-bzr (_dir)
- "Ask bzr itself for the version information for directory DIR."
- ;; Comments on `bzr version-info':
- ;; i) Unknown files also cause clean != 1.
- ;; ii) It can be slow, contacting the upstream repo to get the
- ;; branch nick if one is not set locally, even with a custom
- ;; template that is not asking for the nick (as used here). You'd
- ;; think the latter part would be trivial to fix:
- ;; https://bugs.launchpad.net/bzr/+bug/882541/comments/3
- ;; https://bugs.launchpad.net/bzr/+bug/629150
- ;; You can set the nick locally with `bzr nick ...', which speeds
- ;; things up enormously. `bzr revno' does not have this issue, but
- ;; has no way to print the revision_id AFAICS.
- (message "Waiting for bzr...")
+(defvar emacs-repository-version nil
+ "String giving the repository revision from which this Emacs was built.
+Value is nil if Emacs was not built from a repository checkout,
+or if we could not determine the revision.")
+
+(define-obsolete-variable-alias 'emacs-bzr-version
+ 'emacs-repository-version "24.4")
+
+(define-obsolete-function-alias 'emacs-bzr-get-version
+ 'emacs-repository-get-version "24.4")
+
+(defun emacs-repository-version-git (dir)
+ "Ask git itself for the version information for directory DIR."
+ (message "Waiting for git...")
(with-temp-buffer
- (if (zerop
- (call-process "bzr" nil '(t nil) nil "version-info"
- "--custom"
- "--template={revno} {revision_id} (clean = {clean})"
- "dir"))
- (buffer-string))))
-
-(defun emacs-bzr-get-version (&optional dir external)
- "Try to return as a string the bzr revision of the Emacs sources.
-The format is: [revno] revision_id, where revno may be absent.
-Value is nil if the sources do not seem to be under bzr, or if we could
-not determine the revision. Note that this reports on the current state
-of the sources, which may not correspond to the running Emacs.
+ (let ((default-directory (file-name-as-directory dir)))
+ (and (eq 0
+ (with-demoted-errors "Error running git rev-parse: %S"
+ (call-process "git" nil '(t nil) nil "rev-parse" "HEAD")))
+ (progn (goto-char (point-min))
+ (looking-at "[0-9a-fA-F]\\{40\\}"))
+ (match-string 0)))))
+
+(defun emacs-repository--version-git-1 (file)
+ "Internal subroutine of `emacs-repository-get-version'."
+ (when (file-readable-p file)
+ (erase-buffer)
+ (insert-file-contents file)
+ (cond ((looking-at "[0-9a-fA-F]\\{40\\}")
+ (match-string 0))
+ ((looking-at "ref: \\(.*\\)")
+ (emacs-repository--version-git-1
+ (expand-file-name (match-string 1)
+ (file-name-directory file)))))))
+
+(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
+control, or if we could not determine the revision. Note that
+this reports on the current state of the sources, which may not
+correspond to the running Emacs.
Optional argument DIR is a directory to use instead of `source-directory'.
-Optional argument EXTERNAL non-nil means to maybe ask `bzr' itself,
-if the sources appear to be under bzr. If `force', always ask bzr.
-Otherwise only ask bzr if we cannot find any information ourselves."
+Optional argument EXTERNAL non-nil means to just ask the VCS itself,
+if the sources appear to be under version control. Otherwise only ask
+the VCS if we cannot find any information ourselves."
(or dir (setq dir source-directory))
- (when (file-directory-p (expand-file-name ".bzr/branch" dir))
- (if (eq external 'force)
- (emacs-bzr-version-bzr dir)
- (let (file loc rev)
- (cond ((file-readable-p
- (setq file (expand-file-name ".bzr/branch/last-revision" dir)))
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-max))
- (if (looking-back "\n")
- (delete-char -1))
- (buffer-string)))
- ;; OK, no last-revision. Is it a lightweight checkout?
- ((file-readable-p
- (setq file (expand-file-name ".bzr/branch/location" dir)))
- (setq rev (emacs-bzr-version-dirstate dir))
- ;; If the parent branch is local, try looking there for the rev.
- ;; Note: there is no guarantee that the parent branch's rev
- ;; corresponds to this branch. This branch could have
- ;; been made with a specific -r revno argument, or the
- ;; parent could have been updated since this branch was created.
- ;; To try and detect this, we check the dirstate revids
- ;; to see if they match.
- (if (and (setq loc (with-temp-buffer
- (insert-file-contents file)
- (if (looking-at "file://\\(.*\\)")
- (match-string 1))))
- (equal rev (emacs-bzr-version-dirstate loc)))
- (emacs-bzr-get-version loc)
- ;; If parent does not match, the best we can do without
- ;; calling external commands is to use the dirstate rev.
- rev))
- (external
- (emacs-bzr-version-bzr dir)))))))
+ (when (file-directory-p (expand-file-name ".git" dir))
+ (if external
+ (emacs-repository-version-git dir)
+ (or (let ((files '("HEAD" "refs/heads/master"))
+ file rev)
+ (with-temp-buffer
+ (while (and (not rev)
+ (setq file (car files)))
+ (setq file (expand-file-name (format ".git/%s" file) dir)
+ files (cdr files)
+ rev (emacs-repository--version-git-1 file))))
+ rev)
+ ;; AFAICS this doesn't work during dumping (bug#20799).
+ (emacs-repository-version-git dir)))))
;; We put version info into the executable in the form that `ident' uses.
(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
diff --git a/lisp/view.el b/lisp/view.el
index 333a9883d14..3f0a6dc325d 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -1,6 +1,6 @@
;;; view.el --- peruse file or buffer without editing
-;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2013 Free Software
+;; Copyright (C) 1985, 1989, 1994-1995, 1997, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: K. Shane Hartman
@@ -491,12 +491,12 @@ Entry to view-mode runs the normal hook `view-mode-hook'."
(defun view--disable ()
(remove-hook 'change-major-mode-hook 'view--disable t)
(and view-overlay (delete-overlay view-overlay))
- ;; Calling toggle-read-only while View mode is enabled
+ ;; Calling read-only-mode while View mode is enabled
;; sets view-read-only to t as a buffer-local variable
- ;; after exiting View mode. That arranges that the next toggle-read-only
+ ;; after exiting View mode. That arranges that the next read-only-mode
;; will reenable View mode.
;; Canceling View mode in any other way should cancel that, too,
- ;; so that View mode stays off if toggle-read-only is called.
+ ;; so that View mode stays off if read-only-mode is called.
(if (local-variable-p 'view-read-only)
(kill-local-variable 'view-read-only))
(if (boundp 'Helper-return-blurb)
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index 158df4fc195..12385032f7a 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -1,6 +1,6 @@
;;; vt-control.el --- Common VTxxx control functions
-;; Copyright (C) 1993-1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index 44e691d52b0..b7c377acba0 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -1,9 +1,9 @@
;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones
-;; Copyright (C) 1988, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1988, 2001-2015 Free Software Foundation, Inc.
;; Author: Howard Gayle
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: hardware
;; This file is part of GNU Emacs.
diff --git a/lisp/w32-common-fns.el b/lisp/w32-common-fns.el
deleted file mode 100644
index 9f3501a01d7..00000000000
--- a/lisp/w32-common-fns.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;;; w32-common-fns.el --- Lisp routines for Windows and Cygwin-w32
-
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;;
-;;; This file contains functions that are used by both native NT Emacs
-;;; and Cygwin Emacs compiled to use the native Windows widget
-;;; library.
-
-(defun w32-version ()
- "Return the MS-Windows version numbers.
-The value is a list of three integers: the major and minor version
-numbers, and the build number."
- (x-server-version))
-
-(defun w32-using-nt ()
- "Return non-nil if running on a Windows NT descendant.
-That includes all Windows systems except for 9X/Me."
- (getenv "SystemRoot"))
-
-(declare-function w32-get-clipboard-data "w32select.c")
-(declare-function w32-set-clipboard-data "w32select.c")
-(declare-function x-server-version "w32fns.c" (&optional display))
-
-;;; Fix interface to (X-specific) mouse.el
-(defun x-set-selection (type data)
- "Make an X selection of type TYPE and value DATA.
-The argument TYPE (nil means `PRIMARY') says which selection, and
-DATA specifies the contents. TYPE must be a symbol. \(It can also
-be a string, which stands for the symbol with that name, but this
-is considered obsolete.) DATA may be a string, a symbol, an
-integer (or a cons of two integers or list of two integers).
-
-The selection may also be a cons of two markers pointing to the same buffer,
-or an overlay. In these cases, the selection is considered to be the text
-between the markers *at whatever time the selection is examined*.
-Thus, editing done in the buffer after you specify the selection
-can alter the effective value of the selection.
-
-The data may also be a vector of valid non-vector selection values.
-
-The return value is DATA.
-
-Interactively, this command sets the primary selection. Without
-prefix argument, it reads the selection in the minibuffer. With
-prefix argument, it uses the text of the region as the selection value.
-
-Note that on MS-Windows, primary and secondary selections set by Emacs
-are not available to other programs."
- (put 'x-selections (or type 'PRIMARY) data))
-
-(defun x-get-selection (&optional type _data-type)
- "Return the value of an X Windows selection.
-The argument TYPE (default `PRIMARY') says which selection,
-and the argument DATA-TYPE (default `STRING') says
-how to convert the data.
-
-TYPE may be any symbol \(but nil stands for `PRIMARY'). However,
-only a few symbols are commonly used. They conventionally have
-all upper-case names. The most often used ones, in addition to
-`PRIMARY', are `SECONDARY' and `CLIPBOARD'.
-
-DATA-TYPE is usually `STRING', but can also be one of the symbols
-in `selection-converter-alist', which see."
- (get 'x-selections (or type 'PRIMARY)))
-
-;; x-selection-owner-p is used in simple.el
-(defun x-selection-owner-p (&optional type)
- (and (memq type '(nil PRIMARY SECONDARY))
- (get 'x-selections (or type 'PRIMARY))))
-
-;; The "Windows" keys on newer keyboards bring up the Start menu
-;; whether you want it or not - make Emacs ignore these keystrokes
-;; rather than beep.
-(global-set-key [lwindow] 'ignore)
-(global-set-key [rwindow] 'ignore)
-
-(defvar w32-charset-info-alist) ; w32font.c
-
-
-;;;; Selections
-
-;; We keep track of the last text selected here, so we can check the
-;; current selection against it, and avoid passing back our own text
-;; from x-selection-value.
-(defvar x-last-selected-text nil)
-
-(defun x-get-selection-value ()
- "Return the value of the current selection.
-Consult the selection. Treat empty strings as if they were unset."
- (if x-select-enable-clipboard
- (let (text)
- ;; Don't die if x-get-selection signals an error.
- (condition-case c
- (setq text (w32-get-clipboard-data))
- (error (message "w32-get-clipboard-data:%s" c)))
- (if (string= text "") (setq text nil))
- (cond
- ((not text) nil)
- ((eq text x-last-selected-text) nil)
- ((string= text x-last-selected-text)
- ;; Record the newer string, so subsequent calls can use the 'eq' test.
- (setq x-last-selected-text text)
- nil)
- (t
- (setq x-last-selected-text text))))))
-
-(defalias 'x-selection-value 'x-get-selection-value)
-
-;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-get-selection-value)
-
-(provide 'w32-common-fns)
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 44b3cfd3b1d..6f8fa840bd3 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -1,6 +1,6 @@
;;; w32-fns.el --- Lisp routines for 32-bit Windows
-;; Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2001-2015 Free Software Foundation, Inc.
;; Author: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
@@ -26,7 +26,6 @@
;;; Code:
(require 'w32-vars)
-(require 'w32-common-fns)
(defvar explicit-shell-file-name)
@@ -45,7 +44,7 @@
(or (bound-and-true-p shell-file-name)
(getenv "ESHELL")
(getenv "SHELL")
- (and (w32-using-nt) "cmd.exe")
+ (and (fboundp 'w32-using-nt) (w32-using-nt) "cmd.exe")
"command.com"))
(defun w32-system-shell-p (shell-name)
@@ -307,11 +306,6 @@ bit output with no translation."
(w32-add-charset-info "tis620-0" 'w32-charset-thai 874)
(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252)
-(make-obsolete-variable 'w32-enable-italics
- 'w32-enable-synthesized-fonts "21.1")
-(make-obsolete-variable 'w32-charset-to-codepage-alist
- 'w32-charset-info-alist "21.1")
-
;;;; Support for build process
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index e51ac174a45..f9212be406c 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,6 +1,6 @@
;;; w32-vars.el --- MS-Windows specific user options
-;; Copyright (C) 2002-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
;; Author: Jason Rumney <jasonr@gnu.org>
;; Keywords: internal
@@ -34,10 +34,17 @@
;; Redefine the font selection to use the standard W32 dialog
(defcustom w32-use-w32-font-dialog t
- "Use the standard font dialog.
+ "If non-nil, use the standard Windows font dialog for font selection.
If nil, pop up a menu of a fixed set of fonts including fontsets, like
-X does. See `w32-fixed-font-alist' for the font menu definition."
+X does. See `w32-fixed-font-alist' for the fonts to appear in the menu.
+
+Setting this variable directly does not have any effect;
+use either \\[customize] or set `mouse-appearance-menu-map' to nil
+after changing the value of this variable."
:type 'boolean
+ :set (lambda (symbol value)
+ (set symbol value)
+ (setq mouse-appearance-menu-map nil))
:group 'w32)
(defvar w32-list-proportional-fonts nil
@@ -104,11 +111,11 @@ X does. See `w32-fixed-font-alist' for the font menu definition."
"-*-Lucida Sans Typewriter-semibold-r-*-*-16-*-*-*-c-*-iso8859-1"))
("Courier"
("Courier 10x8"
- "-*-Courier-*normal-r-*-*-*-97-*-*-c-80-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-97-*-*-c-80-iso8859-1")
("Courier 12x9"
- "-*-Courier-*normal-r-*-*-*-120-*-*-c-90-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-120-*-*-c-90-iso8859-1")
("Courier 15x12"
- "-*-Courier-*normal-r-*-*-*-150-*-*-c-120-iso8859-1")
+ "-*-Courier New-normal-r-*-*-*-150-*-*-c-120-iso8859-1")
;; For these, we specify the point height.
("")
("8" "-*-Courier New-normal-r-*-*-11-*-*-*-c-*-iso8859-1")
@@ -149,6 +156,8 @@ menu if the variable `w32-use-w32-font-dialog' is nil."
(string :tag "Font")))))))
:group 'w32)
+(make-obsolete-variable 'w32-enable-synthesized-fonts nil "24.4")
+
(provide 'w32-vars)
;;; w32-vars.el ends here
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 6c2c9777a47..8ee9a83d1d2 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -1,6 +1,6 @@
;;; wdired.el --- Rename files editing their names in dired buffers
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Filename: wdired.el
;; Author: Juan León Lahoz García <juanleon1@gmail.com>
@@ -73,8 +73,6 @@
;;; Code:
-(defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
-
(require 'dired)
(autoload 'dired-do-create-files-regexp "dired-aux")
@@ -185,7 +183,8 @@ renamed by `dired-do-rename' and `dired-do-rename-regexp'."
(define-key map [remap capitalize-word] 'wdired-capitalize-word)
(define-key map [remap downcase-word] 'wdired-downcase-word)
- map))
+ map)
+ "Keymap used in `wdired-mode'.")
(defvar wdired-mode-hook nil
"Hooks run when changing to WDired mode.")
@@ -495,8 +494,8 @@ non-nil means return old filename."
overwrite))
(error
(setq errors (1+ errors))
- (dired-log (concat "Rename `" file-ori "' to `"
- file-new "' failed:\n%s\n")
+ (dired-log "Rename `%s' to `%s' failed:\n%s\n"
+ file-ori file-new
err)))))))))
errors))
@@ -652,8 +651,8 @@ If OLD, return the old target. If MOVE, move point before it."
(substitute-in-file-name link-to-new) link-from))
(error
(setq errors (1+ errors))
- (dired-log (concat "Link `" link-from "' to `"
- link-to-new "' failed:\n%s\n")
+ (dired-log "Link `%s' to `%s' failed:\n%s\n"
+ link-from link-to-new
err)))))
(cons changes errors)))
@@ -838,11 +837,11 @@ Like original function but it skips read-only words."
(unless (equal 0 (process-file dired-chmod-program
nil nil nil perm-tmp filename))
(setq errors (1+ errors))
- (dired-log (concat dired-chmod-program " " perm-tmp
- " `" filename "' failed\n\n"))))
+ (dired-log "%s %s `%s' failed\n\n"
+ dired-chmod-program perm-tmp filename)))
(setq errors (1+ errors))
- (dired-log (concat "Cannot parse permission `" perms-new
- "' for file `" filename "'\n\n"))))
+ (dired-log "Cannot parse permission `%s' for file `%s'\n\n"
+ perms-new filename)))
(goto-char (next-single-property-change (1+ (point)) prop-wanted
nil (point-max))))
(cons changes errors)))
@@ -850,7 +849,6 @@ Like original function but it skips read-only words."
(provide 'wdired)
;; Local Variables:
-;; coding: utf-8
;; byte-compile-dynamic: t
;; End:
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index b462cf0b811..d45a1dcc47f 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1,6 +1,6 @@
;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -266,6 +266,8 @@
;; `whitespace-indentation' Face used to visualize 8 or more
;; SPACEs at beginning of line.
;;
+;; `whitespace-big-indent' Face used to visualize big indentation.
+;;
;; `whitespace-empty' Face used to visualize empty lines at
;; beginning and/or end of buffer.
;;
@@ -286,6 +288,9 @@
;; `whitespace-indentation-regexp' Specify regexp for 8 or more
;; SPACEs at beginning of line.
;;
+;; `whitespace-big-indent-regexp' Specify big indentation at beginning of line
+;; regexp.
+;;
;; `whitespace-empty-at-bob-regexp' Specify regexp for empty lines
;; at beginning of buffer.
;;
@@ -344,7 +349,7 @@
;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for
;; indicating defface byte-compilation warnings.
;;
-;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight
+;; Thanks to Tim O'Callaghan (EmacsWiki) for the idea about highlight
;; "long" lines. See EightyColumnRule (EmacsWiki).
;;
;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new
@@ -452,6 +457,10 @@ 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'.
+ big-indent Big indentations are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
+
space-after-tab::tab 8 or more SPACEs after a TAB are
visualized via faces.
It has effect only if `face' (see above)
@@ -529,35 +538,40 @@ cleaning up a buffer. See `whitespace-cleanup' and
`whitespace-cleanup-region' for documentation.
See also `whitespace-display-mappings' for documentation."
- :type '(repeat :tag "Kind of Blank"
- (choice :tag "Kind of Blank Face"
- (const :tag "(Face) Face visualization"
- face)
- (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
- trailing)
- (const :tag "(Face) SPACEs and HARD SPACEs"
- spaces)
- (const :tag "(Face) TABs" tabs)
- (const :tag "(Face) Lines" lines)
- (const :tag "(Face) SPACEs before TAB"
- space-before-tab)
- (const :tag "(Face) NEWLINEs" newline)
- (const :tag "(Face) Indentation SPACEs"
- indentation)
- (const :tag "(Face) Empty Lines At BOB And/Or EOB"
- empty)
- (const :tag "(Face) SPACEs after TAB"
- space-after-tab)
- (const :tag "(Mark) SPACEs and HARD SPACEs"
- space-mark)
- (const :tag "(Mark) TABs" tab-mark)
- (const :tag "(Mark) NEWLINEs" newline-mark)))
+ :type '(set :tag "Kind of Blank"
+ (const :tag "(Face) Face visualization" face)
+ (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
+ trailing)
+ (const :tag "(Face) TABs" tabs)
+ (const :tag "(Face) SPACEs and HARD SPACEs" spaces)
+ (const :tag "(Face) Lines" lines)
+ (const :tag "(Face) Lines, only overlong part" lines-tail)
+ (const :tag "(Face) NEWLINEs" newline)
+ (const :tag "(Face) Empty Lines At BOB And/Or EOB" empty)
+ (const :tag "(Face) Indentation SPACEs" indentation::tab)
+ (const :tag "(Face) Indentation TABs"
+ indentation::space)
+ (const :tag "(Face) Indentation TABs or SPACEs" indentation)
+ (const :tag "(Face) Too much line indentation" big-indent)
+ (const :tag "(Face) SPACEs after TAB: SPACEs"
+ space-after-tab::tab)
+ (const :tag "(Face) SPACEs after TAB: TABs"
+ space-after-tab::space)
+ (const :tag "(Face) SPACEs after TAB" space-after-tab)
+ (const :tag "(Face) SPACEs before TAB: SPACEs"
+ space-before-tab::tab)
+ (const :tag "(Face) SPACEs before TAB: TABs"
+ space-before-tab::space)
+ (const :tag "(Face) SPACEs before TAB" space-before-tab)
+ (const :tag "(Mark) SPACEs and HARD SPACEs" space-mark)
+ (const :tag "(Mark) TABs" tab-mark)
+ (const :tag "(Mark) NEWLINEs" newline-mark))
:group 'whitespace)
(defvar whitespace-space 'whitespace-space
"Symbol face used to visualize SPACE.
Used when `whitespace-style' includes the value `spaces'.")
-(make-obsolete-variable 'whitespace-space "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-space "use the face instead." "24.4")
(defface whitespace-space
@@ -573,7 +587,7 @@ Used when `whitespace-style' includes the value `spaces'.")
(defvar whitespace-hspace 'whitespace-hspace
"Symbol face used to visualize HARD SPACE.
Used when `whitespace-style' includes the value `spaces'.")
-(make-obsolete-variable 'whitespace-hspace "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-hspace "use the face instead." "24.4")
(defface whitespace-hspace ; 'nobreak-space
'((((class color) (background dark))
@@ -588,7 +602,7 @@ Used when `whitespace-style' includes the value `spaces'.")
(defvar whitespace-tab 'whitespace-tab
"Symbol face used to visualize TAB.
Used when `whitespace-style' includes the value `tabs'.")
-(make-obsolete-variable 'whitespace-tab "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-tab "use the face instead." "24.4")
(defface whitespace-tab
'((((class color) (background dark))
@@ -605,7 +619,7 @@ Used when `whitespace-style' includes the value `tabs'.")
See `whitespace-display-mappings'.
Used when `whitespace-style' includes the values `newline-mark'
and `newline'.")
-(make-obsolete-variable 'whitespace-newline "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-newline "use the face instead." "24.4")
(defface whitespace-newline
'((default :weight normal)
@@ -624,7 +638,7 @@ See `whitespace-display-mappings'."
(defvar whitespace-trailing 'whitespace-trailing
"Symbol face used to visualize trailing blanks.
Used when `whitespace-style' includes the value `trailing'.")
-(make-obsolete-variable 'whitespace-trailing "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-trailing "use the face instead." "24.4")
(defface whitespace-trailing ; 'trailing-whitespace
'((default :weight bold)
@@ -638,7 +652,7 @@ Used when `whitespace-style' includes the value `trailing'.")
"Symbol face used to visualize \"long\" lines.
See `whitespace-line-column'.
Used when `whitespace-style' includes the value `line'.")
-(make-obsolete-variable 'whitespace-line "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-line "use the face instead." "24.4")
(defface whitespace-line
'((((class mono)) :inverse-video t :weight bold :underline t)
@@ -653,7 +667,7 @@ See `whitespace-line-column'."
"Symbol face used to visualize SPACEs before TAB.
Used when `whitespace-style' includes the value `space-before-tab'.")
(make-obsolete-variable 'whitespace-space-before-tab
- "use the face instead" "24.4")
+ "use the face instead." "24.4")
(defface whitespace-space-before-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
@@ -665,7 +679,7 @@ Used when `whitespace-style' includes the value `space-before-tab'.")
(defvar whitespace-indentation 'whitespace-indentation
"Symbol face used to visualize 8 or more SPACEs at beginning of line.
Used when `whitespace-style' includes the value `indentation'.")
-(make-obsolete-variable 'whitespace-indentation "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-indentation "use the face instead." "24.4")
(defface whitespace-indentation
'((((class mono)) :inverse-video t :weight bold :underline t)
@@ -673,11 +687,17 @@ Used when `whitespace-style' includes the value `indentation'.")
"Face used to visualize 8 or more SPACEs at beginning of line."
:group 'whitespace)
+(defface whitespace-big-indent
+ '((((class mono)) :inverse-video t :weight bold :underline t)
+ (t :background "red" :foreground "firebrick"))
+ "Face used to visualize big indentation."
+ :group 'whitespace)
+
(defvar whitespace-empty 'whitespace-empty
"Symbol face used to visualize empty lines at beginning and/or end of buffer.
Used when `whitespace-style' includes the value `empty'.")
-(make-obsolete-variable 'whitespace-empty "use the face instead" "24.4")
+(make-obsolete-variable 'whitespace-empty "use the face instead." "24.4")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
@@ -690,7 +710,7 @@ Used when `whitespace-style' includes the value `empty'.")
"Symbol face used to visualize 8 or more SPACEs after TAB.
Used when `whitespace-style' includes the value `space-after-tab'.")
(make-obsolete-variable 'whitespace-space-after-tab
- "use the face instead" "24.4")
+ "use the face instead." "24.4")
(defface whitespace-space-after-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
@@ -838,6 +858,21 @@ Used when `whitespace-style' includes `space-after-tab',
string)
:group 'whitespace)
+(defcustom whitespace-big-indent-regexp
+ "^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)"
+ "Specify big indentation regexp.
+
+If you're using `mule' package, there may be other characters
+besides \"\\t\" that should be considered TAB.
+
+NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+ Use exactly one pair of enclosing \\\\( and \\\\).
+
+Used when `whitespace-style' includes `big-indent'."
+ :version "25.1"
+ :type '(regexp :tag "Detect too much indentation at the beginning of a line")
+ :group 'whitespace)
+
(defcustom whitespace-line-column 80
"Specify column beyond which the line is highlighted.
@@ -849,28 +884,29 @@ Used when `whitespace-style' includes `lines' or `lines-tail'."
:type '(choice :tag "Line Length Limit"
(integer :tag "Line Length")
(const :tag "Use fill-column" nil))
+ :safe 'integerp
:group 'whitespace)
;; Hacked from `visible-whitespace-mappings' in visws.el
(defcustom whitespace-display-mappings
'(
- (space-mark ?\ [?\u00B7] [?.]) ; space - centered dot
- (space-mark ?\xA0 [?\u00A4] [?_]) ; hard space - currency
+ (space-mark ?\ [?·] [?.]) ; space - middle dot
+ (space-mark ?\xA0 [?¤] [?_]) ; hard space - currency sign
;; NEWLINE is displayed using the face `whitespace-newline'
(newline-mark ?\n [?$ ?\n]) ; eol - dollar sign
- ;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow
- ;; (newline-mark ?\n [?\u00B6 ?\n] [?$ ?\n]) ; eol - pilcrow
- ;; (newline-mark ?\n [?\u00AF ?\n] [?$ ?\n]) ; eol - overscore
- ;; (newline-mark ?\n [?\u00AC ?\n] [?$ ?\n]) ; eol - negation
- ;; (newline-mark ?\n [?\u00B0 ?\n] [?$ ?\n]) ; eol - degrees
+ ;; (newline-mark ?\n [?↵ ?\n] [?$ ?\n]) ; eol - downwards arrow
+ ;; (newline-mark ?\n [?¶ ?\n] [?$ ?\n]) ; eol - pilcrow
+ ;; (newline-mark ?\n [?¯ ?\n] [?$ ?\n]) ; eol - overscore
+ ;; (newline-mark ?\n [?¬ ?\n] [?$ ?\n]) ; eol - negation
+ ;; (newline-mark ?\n [?° ?\n] [?$ ?\n]) ; eol - degrees
;;
;; WARNING: the mapping below has a problem.
;; When a TAB occupies exactly one column, it will display the
;; character ?\xBB at that column followed by a TAB which goes to
;; the next TAB column.
;; If this is a problem for you, please, comment the line below.
- (tab-mark ?\t [?\u00BB ?\t] [?\\ ?\t]) ; tab - left quote mark
+ (tab-mark ?\t [?» ?\t] [?\\ ?\t]) ; tab - right guillemet
)
"Specify an alist of mappings for displaying characters.
@@ -1084,7 +1120,7 @@ See also `whitespace-style', `whitespace-newline' and
(not (memq major-mode (cdr whitespace-global-modes)))
(memq major-mode whitespace-global-modes)))
(t nil))
- ;; ...we have a display (we're running a batch job)
+ ;; ...we have a display (not running a batch job)
(not noninteractive)
;; ...the buffer is not internal (name starts with a space)
(not (eq (aref (buffer-name) 0) ?\ ))
@@ -1141,6 +1177,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
indentation
indentation::tab
indentation::space
+ big-indent
space-after-tab
space-after-tab::tab
space-after-tab::space
@@ -1167,6 +1204,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(?\C-i . indentation)
(?I . indentation::tab)
(?i . indentation::space)
+ (?\C-t . big-indent)
(?\C-a . space-after-tab)
(?A . space-after-tab::tab)
(?a . space-after-tab::space)
@@ -1204,6 +1242,8 @@ SYMBOL is a valid symbol associated with CHAR.
(defvar whitespace-point (point)
"Used to save locally current point value.
Used by function `whitespace-trailing-regexp' (which see).")
+(defvar-local whitespace-point--used nil
+ "Region whose highlighting depends on `whitespace-point'.")
(defvar whitespace-font-lock-refontify nil
"Used to save locally the font-lock refontify state.
@@ -1248,6 +1288,7 @@ Interactively, it reads one of the following chars:
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
I toggle indentation SPACEs visualization
i toggle indentation TABs visualization
+ C-t toggle big indentation visualization
C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode')
A toggle SPACEs after TAB: SPACEs visualization
a toggle SPACEs after TAB: TABs visualization
@@ -1277,6 +1318,7 @@ The valid symbols are:
indentation toggle indentation SPACEs visualization
indentation::tab toggle indentation SPACEs visualization
indentation::space toggle indentation TABs visualization
+ big-indent toggle big indentation visualization
space-after-tab toggle SPACEs after TAB visualization
space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization
space-after-tab::space toggle SPACEs after TAB: TABs visualization
@@ -1327,6 +1369,7 @@ Interactively, it accepts one of the following chars:
C-i toggle indentation SPACEs visualization (via `indent-tabs-mode')
I toggle indentation SPACEs visualization
i toggle indentation TABs visualization
+ C-t toggle big indentation visualization
C-a toggle SPACEs after TAB visualization (via `indent-tabs-mode')
A toggle SPACEs after TAB: SPACEs visualization
a toggle SPACEs after TAB: TABs visualization
@@ -1356,6 +1399,7 @@ The valid symbols are:
indentation toggle indentation SPACEs visualization
indentation::tab toggle indentation SPACEs visualization
indentation::space toggle indentation TABs visualization
+ big-indent toggle big indentation visualization
space-after-tab toggle SPACEs after TAB visualization
space-after-tab::tab toggle SPACEs after TAB: SPACEs visualization
space-after-tab::space toggle SPACEs after TAB: TABs visualization
@@ -1717,43 +1761,7 @@ It is a cons of strings, where the car part is used when
(defun whitespace-report (&optional force report-if-bogus)
"Report some whitespace problems in buffer.
-Return nil if there is no whitespace problem; otherwise, return
-non-nil.
-
-If FORCE is non-nil or \\[universal-argument] was pressed just
-before calling `whitespace-report' interactively, it forces
-`whitespace-style' to have:
-
- empty
- trailing
- indentation
- space-before-tab
- space-after-tab
-
-If REPORT-IF-BOGUS is non-nil, it reports only when there are any
-whitespace problems in buffer.
-
-Report if some of the following whitespace problems exist:
-
-* If `indent-tabs-mode' is non-nil:
- empty 1. empty lines at beginning of buffer.
- empty 2. empty lines at end of buffer.
- trailing 3. SPACEs or TABs at end of line.
- indentation 4. 8 or more SPACEs at beginning of line.
- space-before-tab 5. SPACEs before TAB.
- space-after-tab 6. 8 or more SPACEs after TAB.
-
-* If `indent-tabs-mode' is nil:
- empty 1. empty lines at beginning of buffer.
- empty 2. empty lines at end of buffer.
- trailing 3. SPACEs or TABs at end of line.
- indentation 4. TABS at beginning of line.
- space-before-tab 5. SPACEs before TAB.
- space-after-tab 6. 8 or more SPACEs after TAB.
-
-See `whitespace-style' for documentation.
-See also `whitespace-cleanup' and `whitespace-cleanup-region' for
-cleaning up these problems."
+Perform `whitespace-report-region' on the current buffer."
(interactive (list current-prefix-arg))
(whitespace-report-region (point-min) (point-max)
force report-if-bogus))
@@ -1771,13 +1779,14 @@ before calling `whitespace-report-region' interactively, it
forces `whitespace-style' to have:
empty
+ trailing
indentation
space-before-tab
- trailing
space-after-tab
-If REPORT-IF-BOGUS is non-nil, it reports only when there are any
-whitespace problems in buffer.
+If REPORT-IF-BOGUS is t, it reports only when there are any
+whitespace problems in buffer; if it is `never', it does not
+report problems.
Report if some of the following whitespace problems exist:
@@ -1832,7 +1841,7 @@ cleaning up these problems."
(and (re-search-forward regexp rend t)
(setq has-bogus t))))
whitespace-report-list)))
- (when (if report-if-bogus has-bogus t)
+ (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus))
(whitespace-kill-buffer whitespace-report-buffer-name)
;; `whitespace-indent-tabs-mode' is local to current buffer
;; `whitespace-tab-width' is local to current buffer
@@ -1857,9 +1866,11 @@ cleaning up these problems."
(whitespace-insert-value ws-tab-width)
(when has-bogus
(goto-char (point-max))
- (insert " Type `M-x whitespace-cleanup'"
+ (insert (substitute-command-keys
+ " Type `\\[whitespace-cleanup]'")
" to cleanup the buffer.\n\n"
- " Type `M-x whitespace-cleanup-region'"
+ (substitute-command-keys
+ " Type `\\[whitespace-cleanup-region]'")
" to cleanup a region.\n\n"))
(whitespace-display-window (current-buffer)))))
has-bogus))))
@@ -1889,6 +1900,7 @@ cleaning up these problems."
[] C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode')
[] I - toggle indentation SPACEs visualization
[] i - toggle indentation TABs visualization
+ [] C-t - toggle big indentation visualization
[] C-a - toggle SPACEs after TAB visualization (via `indent-tabs-mode')
[] A - toggle SPACEs after TAB: SPACEs visualization
[] a - toggle SPACEs after TAB: TABs visualization
@@ -1919,13 +1931,13 @@ cleaning up these problems."
(defun whitespace-mark-x (nchars condition)
- "Insert the mark ('X' or ' ') after NCHARS depending on CONDITION."
+ "Insert the mark (`X' or ` ') after NCHARS depending on CONDITION."
(forward-char nchars)
(insert (if condition "X" " ")))
(defun whitespace-insert-option-mark (the-list the-value)
- "Insert the option mark ('X' or ' ') in toggle options buffer."
+ "Insert the option mark (`X' or ` ') in toggle options buffer."
(goto-char (point-min))
(forward-line 2)
(dolist (sym the-list)
@@ -2142,6 +2154,7 @@ resultant list will be returned."
(memq 'indentation whitespace-active-style)
(memq 'indentation::tab whitespace-active-style)
(memq 'indentation::space whitespace-active-style)
+ (memq 'big-indent whitespace-active-style)
(memq 'space-after-tab whitespace-active-style)
(memq 'space-after-tab::tab whitespace-active-style)
(memq 'space-after-tab::space whitespace-active-style)
@@ -2155,7 +2168,10 @@ resultant list will be returned."
(when (whitespace-style-face-p)
;; save current point and refontify when necessary
(set (make-local-variable 'whitespace-point)
- (point))
+ (point))
+ (setq whitespace-point--used
+ (let ((ol (make-overlay (point) (point) nil nil t)))
+ (delete-overlay ol) ol))
(set (make-local-variable 'whitespace-font-lock-refontify)
0)
(set (make-local-variable 'whitespace-bob-marker)
@@ -2170,6 +2186,7 @@ resultant list will be returned."
(setq
whitespace-font-lock-keywords
`(
+ (whitespace-point--flush-used)
,@(when (memq 'spaces whitespace-active-style)
;; Show SPACEs.
`((,whitespace-space-regexp 1 whitespace-space t)
@@ -2225,6 +2242,9 @@ resultant list will be returned."
;; Show indentation SPACEs (TABs).
(whitespace-indentation-regexp 'space)))
1 whitespace-indentation t)))
+ ,@(when (memq 'big-indent whitespace-active-style)
+ ;; Show big indentation.
+ `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t)))
,@(when (memq 'empty whitespace-active-style)
;; Show empty lines at beginning of buffer.
`((,#'whitespace-empty-at-bob-regexp
@@ -2247,26 +2267,47 @@ resultant list will be returned."
(whitespace-space-after-tab-regexp 'space)))
1 whitespace-space-after-tab t)))))
(font-lock-add-keywords nil whitespace-font-lock-keywords t)
- (when font-lock-mode
- (font-lock-fontify-buffer))))
+ (font-lock-flush)))
(defun whitespace-color-off ()
"Turn off color visualization."
;; turn off font lock
+ (kill-local-variable 'whitespace-point--used)
(when (whitespace-style-face-p)
(remove-hook 'post-command-hook #'whitespace-post-command-hook t)
(remove-hook 'before-change-functions #'whitespace-buffer-changed t)
(font-lock-remove-keywords nil whitespace-font-lock-keywords)
- (when font-lock-mode
- (font-lock-fontify-buffer))))
-
+ (font-lock-flush)))
+
+(defun whitespace-point--used (start end)
+ (let ((ostart (overlay-start whitespace-point--used)))
+ (if ostart
+ (move-overlay whitespace-point--used
+ (min start ostart)
+ (max end (overlay-end whitespace-point--used)))
+ (move-overlay whitespace-point--used start end))))
+
+(defun whitespace-point--flush-used (limit)
+ (let ((ostart (overlay-start whitespace-point--used)))
+ ;; Strip parts of whitespace-point--used we're about to refresh.
+ (when ostart
+ (let ((oend (overlay-end whitespace-point--used)))
+ (if (<= (point) ostart)
+ (if (<= oend limit)
+ (delete-overlay whitespace-point--used)
+ (move-overlay whitespace-point--used limit oend)))
+ (if (<= oend limit)
+ (move-overlay whitespace-point--used ostart (point))))))
+ nil)
(defun whitespace-trailing-regexp (limit)
"Match trailing spaces which do not contain the point at end of line."
(let ((status t))
(while (if (re-search-forward whitespace-trailing-regexp limit t)
- (= whitespace-point (match-end 1)) ;; loop if point at eol
+ (when (= whitespace-point (match-end 1)) ; Loop if point at eol.
+ (whitespace-point--used (match-beginning 0) (match-end 0))
+ t)
(setq status nil))) ;; end of buffer
status))
@@ -2279,8 +2320,11 @@ beginning of buffer."
(cond
;; at bob
((= b 1)
- (setq r (and (/= whitespace-point 1)
- (looking-at whitespace-empty-at-bob-regexp)))
+ (setq r (and (looking-at whitespace-empty-at-bob-regexp)
+ (or (/= whitespace-point 1)
+ (progn (whitespace-point--used (match-beginning 0)
+ (match-end 0))
+ nil))))
(set-marker whitespace-bob-marker (if r (match-end 1) b)))
;; inside bob empty region
((<= limit whitespace-bob-marker)
@@ -2318,9 +2362,11 @@ buffer."
(cond
;; at eob
((= limit e)
- (when (/= whitespace-point e)
- (goto-char limit)
- (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)))
+ (goto-char limit)
+ (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+ (when (and r (= whitespace-point e))
+ (setq r nil)
+ (whitespace-point--used (match-beginning 0) (match-end 0)))
(if r
(set-marker whitespace-eob-marker (match-beginning 1))
(set-marker whitespace-eob-marker limit)
@@ -2356,43 +2402,57 @@ buffer."
(defun whitespace-post-command-hook ()
"Save current point into `whitespace-point' variable.
Also refontify when necessary."
- (setq whitespace-point (point)) ; current point position
- (let ((refontify
- (or
- ;; it is at end of line ...
- (and (eolp)
- ;; ... with trailing SPACE or TAB
- (or (= (preceding-char) ?\ )
- (= (preceding-char) ?\t)))
- ;; it is at beginning of buffer (bob)
- (= whitespace-point 1)
- ;; the buffer was modified and ...
- (and whitespace-buffer-changed
- (or
- ;; ... or inside bob whitespace region
- (<= whitespace-point whitespace-bob-marker)
- ;; ... or at bob whitespace region border
- (and (= whitespace-point (1+ whitespace-bob-marker))
- (= (preceding-char) ?\n))))
- ;; it is at end of buffer (eob)
- (= whitespace-point (1+ (buffer-size)))
- ;; the buffer was modified and ...
- (and whitespace-buffer-changed
- (or
- ;; ... or inside eob whitespace region
- (>= whitespace-point whitespace-eob-marker)
- ;; ... or at eob whitespace region border
- (and (= whitespace-point (1- whitespace-eob-marker))
- (= (following-char) ?\n)))))))
- (when (or refontify (> whitespace-font-lock-refontify 0))
- (setq whitespace-buffer-changed nil)
- ;; adjust refontify counter
- (setq whitespace-font-lock-refontify
- (if refontify
- 1
- (1- whitespace-font-lock-refontify)))
- ;; refontify
- (jit-lock-refontify))))
+ (unless (and (eq whitespace-point (point))
+ (not whitespace-buffer-changed))
+ (setq whitespace-point (point)) ; current point position
+ (let ((refontify
+ (cond
+ ;; It is at end of buffer (eob).
+ ((= whitespace-point (1+ (buffer-size)))
+ (when (whitespace-looking-back whitespace-empty-at-eob-regexp
+ nil)
+ (match-beginning 0)))
+ ;; It is at end of line ...
+ ((and (eolp)
+ ;; ... with trailing SPACE or TAB
+ (or (memq (preceding-char) '(?\s ?\t))))
+ (line-beginning-position))
+ ;; It is at beginning of buffer (bob).
+ ((and (= whitespace-point 1)
+ (looking-at whitespace-empty-at-bob-regexp))
+ (match-end 0))))
+ (ostart (overlay-start whitespace-point--used)))
+ (cond
+ ((not refontify)
+ ;; New point does not affect highlighting: just refresh the
+ ;; highlighting of old point, if needed.
+ (when ostart
+ (font-lock-flush ostart
+ (overlay-end whitespace-point--used))
+ (delete-overlay whitespace-point--used)))
+ ((not ostart)
+ ;; Old point did not affect highlighting, but new one does: refresh the
+ ;; highlighting of new point.
+ (font-lock-flush (min refontify (point)) (max refontify (point))))
+ ((save-excursion
+ (goto-char ostart)
+ (setq ostart (line-beginning-position))
+ (and (<= ostart (max refontify (point)))
+ (progn
+ (goto-char (overlay-end whitespace-point--used))
+ (let ((oend (line-beginning-position 2)))
+ (<= (min refontify (point)) oend)))))
+ ;; The old point highlighting and the new point highlighting
+ ;; cover a contiguous region: do a single refresh.
+ (font-lock-flush (min refontify (point) ostart)
+ (max refontify (point)
+ (overlay-end whitespace-point--used)))
+ (delete-overlay whitespace-point--used))
+ (t
+ (font-lock-flush (min refontify (point))
+ (max refontify (point)))
+ (font-lock-flush ostart (overlay-end whitespace-point--used))
+ (delete-overlay whitespace-point--used))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index caf41427538..7e2bcb47f69 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -1,6 +1,6 @@
;;; wid-browse.el --- functions for browsing widgets
;;
-;; Copyright (C) 1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: extensions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index b351d896911..0d9157a5575 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,9 +1,9 @@
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; Package: emacs
@@ -232,23 +232,20 @@ minibuffer."
(t
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
- (let* ((overriding-terminal-local-map (make-sparse-keymap))
- (next-digit ?0)
- map choice some-choice-enabled value)
- ;; Define SPC as a prefix char to get to this menu.
- (define-key overriding-terminal-local-map " "
- (setq map (make-sparse-keymap title)))
+ (let* ((next-digit ?0)
+ (map (make-sparse-keymap))
+ choice some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
(while items
- (setq choice (car items) items (cdr items))
- (if (consp choice)
- (let* ((name (car choice))
- (function (cdr choice)))
- (insert (format "%c = %s\n" next-digit name))
- (define-key map (vector next-digit) function)
- (setq some-choice-enabled t)))
+ (setq choice (pop items))
+ (when (consp choice)
+ (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)
+ (setq some-choice-enabled t)))
;; Allocate digits to disabled alternatives
;; so that the digit of a given alternative never varies.
(setq next-digit (1+ next-digit)))
@@ -257,43 +254,29 @@ minibuffer."
(forward-line))
(or some-choice-enabled
(error "None of the choices is currently meaningful"))
- (define-key map [?\C-g] 'keyboard-quit)
- (define-key map [t] 'keyboard-quit)
(define-key map [?\M-\C-v] 'scroll-other-window)
(define-key map [?\M--] 'negative-argument)
- (setcdr map (nreverse (cdr map)))
- ;; Read a char with the menu, and return the result
- ;; that corresponds to it.
(save-window-excursion
(let ((buf (get-buffer " widget-choose")))
(fit-window-to-buffer (display-buffer buf))
(let ((cursor-in-echo-area t)
- keys
- (char 0)
(arg 1))
- (while (not (or (and (integerp char)
- (>= char ?0) (< char next-digit))
- (eq value 'keyboard-quit)))
- ;; Unread a SPC to lead to our new menu.
- (setq unread-command-events (cons ?\s unread-command-events))
- (setq keys (read-key-sequence title))
- (setq value
- (lookup-key overriding-terminal-local-map keys t)
- char (aref keys 1))
- (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))
- (t
- (setq arg 1)))))))
- (when (eq value 'keyboard-quit)
- (error "Canceled"))
+ (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))))
;;; Widget text specifications.
@@ -1520,7 +1503,8 @@ The value of the :type attribute should be an unconverted widget type."
(insert-char ?\s (widget-get widget :indent))))
((eq escape ?t)
(let ((image (widget-get widget :tag-glyph))
- (tag (widget-get widget :tag)))
+ (tag (substitute-command-keys
+ (widget-get widget :tag))))
(cond (image
(widget-image-insert widget (or tag "image") image))
(tag
@@ -1532,7 +1516,7 @@ The value of the :type attribute should be an unconverted widget type."
(let ((doc (widget-get widget :doc)))
(when doc
(setq doc-begin (point))
- (insert doc)
+ (insert (substitute-command-keys doc))
(while (eq (preceding-char) ?\n)
(delete-char -1))
(insert ?\n)
@@ -1692,7 +1676,7 @@ as the argument to `documentation-property'."
(cond ((functionp doc-prop)
(funcall doc-prop value))
((symbolp doc-prop)
- (documentation-property value doc-prop)))))))
+ (documentation-property value doc-prop t)))))))
(when (and (stringp doc) (> (length doc) 0))
;; Remove any redundant `*' in the beginning.
(when (eq (aref doc 0) ?*)
@@ -1776,7 +1760,7 @@ If END is omitted, it defaults to the length of LIST."
(defun widget-push-button-value-create (widget)
"Insert text representing the `on' and `off' states."
- (let* ((tag (or (widget-get widget :tag)
+ (let* ((tag (or (substitute-command-keys (widget-get widget :tag))
(widget-get widget :value)))
(tag-glyph (widget-get widget :tag-glyph))
(text (concat widget-push-button-prefix
@@ -2184,7 +2168,8 @@ when he invoked the menu."
(defun widget-toggle-value-create (widget)
"Insert text representing the `on' and `off' states."
(let* ((val (widget-value widget))
- (text (widget-get widget (if val :on :off)))
+ (text (substitute-command-keys
+ (widget-get widget (if val :on :off))))
(img (widget-image-find
(widget-get widget (if val :on-glyph :off-glyph)))))
(widget-image-insert widget (or text "")
@@ -2626,7 +2611,7 @@ Return an alist of (TYPE MATCH)."
(let* ((value (widget-get widget :value))
(type (nth 0 (widget-get widget :args)))
children)
- (widget-put widget :value-pos (copy-marker (point)))
+ (widget-put widget :value-pos (point-marker))
(set-marker-insertion-type (widget-get widget :value-pos) t)
(while value
(let ((answer (widget-match-inline type value)))
@@ -2669,8 +2654,7 @@ Return an alist of (TYPE MATCH)."
(save-excursion
(let ((children (widget-get widget :children))
(inhibit-read-only t)
- before-change-functions
- after-change-functions)
+ (inhibit-modification-hooks t))
(cond (before
(goto-char (widget-get before :entry-from)))
(t
@@ -2694,8 +2678,7 @@ Return an alist of (TYPE MATCH)."
(let ((buttons (copy-sequence (widget-get widget :buttons)))
button
(inhibit-read-only t)
- before-change-functions
- after-change-functions)
+ (inhibit-modification-hooks t))
(while buttons
(setq button (car buttons)
buttons (cdr buttons))
@@ -2706,8 +2689,7 @@ Return an alist of (TYPE MATCH)."
(let ((entry-from (widget-get child :entry-from))
(entry-to (widget-get child :entry-to))
(inhibit-read-only t)
- before-change-functions
- after-change-functions)
+ (inhibit-modification-hooks t))
(widget-delete child)
(delete-region entry-from entry-to)
(set-marker entry-from nil)
@@ -2863,16 +2845,24 @@ The following properties have special meanings for this widget:
(if (and (fboundp symbol) (boundp symbol))
;; If there are two doc strings, give the user a way to pick one.
(apropos (concat "\\`" (regexp-quote string) "\\'"))
- (if (fboundp symbol)
- (describe-function symbol)
- (describe-variable symbol)))))
+ (cond
+ ((fboundp symbol)
+ (describe-function symbol))
+ ((facep symbol)
+ (describe-face symbol))
+ ((featurep symbol)
+ (describe-package symbol))
+ ((or (boundp symbol) (get symbol 'variable-documentation))
+ (describe-variable symbol))
+ (t
+ (message "No documentation available for %s" symbol))))))
(defcustom widget-documentation-links t
"Add hyperlinks to documentation strings when non-nil."
:type 'boolean
:group 'widget-documentation)
-(defcustom widget-documentation-link-regexp "`\\([^\n`' ]+\\)'"
+(defcustom widget-documentation-link-regexp "['`‘]\\([^\n `'‘’]+\\)['’]"
"Regexp for matching potential links in documentation strings.
The first group should be the link itself."
:type 'regexp
@@ -2923,7 +2913,7 @@ link for that string."
(defun widget-documentation-string-value-create (widget)
;; Insert documentation string.
- (let ((doc (widget-value widget))
+ (let ((doc (substitute-command-keys (widget-value widget)))
(indent (widget-get widget :indent))
(shown (widget-get (widget-get widget :parent) :documentation-shown))
(start (point)))
@@ -3328,7 +3318,7 @@ It reads a directory name from an editable text field."
;; Avoid a confusing end-of-file error.
(skip-syntax-forward "\\s-")
(if (eobp)
- (setq err "Empty sexp -- use `nil'?")
+ (setq err "Empty sexp -- use nil?")
(unless (widget-apply widget :match (read (current-buffer)))
(setq err (widget-get widget :type-error))))
;; Allow whitespace after expression.
@@ -3462,14 +3452,14 @@ To use this type, you must define :match or :match-alternatives."
;; Recursive datatypes.
(define-widget 'lazy 'default
- "Base widget for recursive datastructures.
+ "Base widget for recursive data structures.
The `lazy' widget will, when instantiated, contain a single inferior
widget, of the widget type specified by the :type parameter. The
value of the `lazy' widget is the same as the value of the inferior
widget. When deriving a new widget from the 'lazy' widget, the :type
parameter is allowed to refer to the widget currently being defined,
-thus allowing recursive datastructures to be described.
+thus allowing recursive data structures to be described.
The :type parameter takes the same arguments as the defcustom
parameter with the same name.
@@ -3479,15 +3469,15 @@ not allow recursion. That is, when you define a new widget type, none
of the inferior widgets may be of the same type you are currently
defining.
-In Lisp, however, it is custom to define datastructures in terms of
+In Lisp, however, it is custom to define data structures in terms of
themselves. A list, for example, is defined as either nil, or a cons
cell whose cdr itself is a list. The obvious way to translate this
into a widget type would be
- (define-widget 'my-list 'choice
+ (define-widget \\='my-list \\='choice
\"A list of sexps.\"
:tag \"Sexp list\"
- :args '((const nil) (cons :value (nil) sexp my-list)))
+ :args \\='((const nil) (cons :value (nil) sexp my-list)))
Here we attempt to define my-list as a choice of either the constant
nil, or a cons-cell containing a sexp and my-lisp. This will not work
@@ -3496,13 +3486,13 @@ because the `choice' widget does not allow recursion.
Using the `lazy' widget you can overcome this problem, as in this
example:
- (define-widget 'sexp-list 'lazy
+ (define-widget \\='sexp-list \\='lazy
\"A list of sexps.\"
:tag \"Sexp list\"
- :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
+ :type \\='(choice (const nil) (cons :value (nil) sexp sexp-list)))"
:format "%{%t%}: %v"
;; We don't convert :type because we want to allow recursive
- ;; datastructures. This is slow, so we should not create speed
+ ;; data structures. This is slow, so we should not create speed
;; critical widgets by deriving from this.
:convert-widget 'widget-value-convert-widget
:value-create 'widget-type-value-create
@@ -3713,9 +3703,9 @@ example:
(widget-value-set ',(widget-get widget :parent) color)
(let* ((buf (get-buffer "*Colors*"))
(win (get-buffer-window buf 0)))
- (bury-buffer buf)
- (and win (> (length (window-list)) 1)
- (delete-window win)))
+ (if win
+ (quit-window nil win)
+ (bury-buffer buf)))
(pop-to-buffer ,(current-buffer))))))
(defun widget-color-sample-face-get (widget)
diff --git a/lisp/widget.el b/lisp/widget.el
index 917dde61872..aadb063161c 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -1,10 +1,9 @@
;;; widget.el --- a library of user interface components
;;
-;; Copyright (C) 1996-1997, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 2001-2015 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: help, extensions, faces, hypermedia
-;; Version: 1.9920
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
;; Package: emacs
@@ -81,9 +80,12 @@ create identical widgets:
* (widget-create NAME)
-* (apply 'widget-create CLASS ARGS)
+* (apply \\='widget-create CLASS ARGS)
The third argument DOC is a documentation string for the widget."
+ ;;
+ (unless (or (null doc) (stringp doc))
+ (error "widget documentation must be nil or a string."))
(put name 'widget-type (cons class args))
(put name 'widget-documentation (purecopy doc))
name)
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 01ae1804d01..1df74a2d271 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -1,6 +1,6 @@
;;; windmove.el --- directional window-selection routines
;;
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;;
;; Author: Hovav Shacham (hovav@cs.stanford.edu)
;; Created: 17 October 1998
@@ -459,24 +459,17 @@ movement is relative to."
windmove-window-distance-delta))) ; (x, y1+d-1)
(t (error "Invalid direction of movement: %s" dir)))))
+;; Rewritten on 2013-12-13 using `window-in-direction'. After the
+;; pixelwise change the old approach didn't work any more. martin
(defun windmove-find-other-window (dir &optional arg window)
"Return the window object in direction DIR.
DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'."
- (let* ((actual-current-window (or window (selected-window)))
- (raw-other-window-loc
- (windmove-other-window-loc dir arg actual-current-window))
- (constrained-other-window-loc
- (windmove-constrain-loc-for-movement raw-other-window-loc
- actual-current-window
- dir))
- (other-window-loc
- (if windmove-wrap-around
- (windmove-wrap-loc-for-movement constrained-other-window-loc
- actual-current-window)
- constrained-other-window-loc)))
- (window-at (car other-window-loc)
- (cdr other-window-loc))))
-
+ (window-in-direction
+ (cond
+ ((eq dir 'up) 'above)
+ ((eq dir 'down) 'below)
+ (t dir))
+ window nil arg windmove-wrap-around t))
;; Selects the window that's hopefully at the location returned by
;; `windmove-other-window-loc', or screams if there's no window there.
@@ -486,17 +479,17 @@ DIR, ARG, and WINDOW are handled as by `windmove-other-window-loc'.
If no window is at direction DIR, an error is signaled."
(let ((other-window (windmove-find-other-window dir arg window)))
(cond ((null other-window)
- (error "No window %s from selected window" dir))
+ (user-error "No window %s from selected window" dir))
((and (window-minibuffer-p other-window)
(not (minibuffer-window-active-p other-window)))
- (error "Minibuffer is inactive"))
+ (user-error "Minibuffer is inactive"))
(t
(select-window other-window)))))
;;; end-user functions
-;; these are all simple interactive wrappers to `windmove-do-
-;; window-select', meant to be bound to keys.
+;; these are all simple interactive wrappers to
+;; `windmove-do-window-select', meant to be bound to keys.
;;;###autoload
(defun windmove-left (&optional arg)
diff --git a/lisp/window.el b/lisp/window.el
index 21e40071782..6d189055c15 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1,9 +1,9 @@
;;; window.el --- GNU Emacs window commands aside from those written in C
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2013 Free Software
+;; Copyright (C) 1985, 1989, 1992-1994, 2000-2015 Free Software
;; Foundation, Inc.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
;; Package: emacs
@@ -108,7 +108,7 @@ Return the buffer."
;; Return the buffer.
buffer)))
-(defun temp-buffer-window-show (&optional buffer action)
+(defun temp-buffer-window-show (buffer &optional action)
"Show temporary buffer BUFFER in a window.
Return the window showing BUFFER. Pass ACTION as action argument
to `display-buffer'."
@@ -142,28 +142,28 @@ to `display-buffer'."
;; Return the window.
window))))
-;; Doc is very similar to with-output-to-temp-buffer.
(defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body)
"Bind `standard-output' to BUFFER-OR-NAME, eval BODY, show the buffer.
-BUFFER-OR-NAME must specify either a live buffer, or the name of a
-buffer (if it does not exist, this macro creates it).
+BUFFER-OR-NAME must specify either a live buffer, or the name of
+a buffer (if it does not exist, this macro creates it).
-This construct makes buffer BUFFER-OR-NAME empty before running BODY.
-It does not make the buffer current for BODY.
-Instead it binds `standard-output' to that buffer, so that output
+Make the buffer specified by BUFFER-OR-NAME empty before running
+BODY and bind `standard-output' to that buffer, so that output
generated with `prin1' and similar functions in BODY goes into
-the buffer.
-
-At the end of BODY, this marks the specified buffer unmodified and
-read-only, and displays it in a window (but does not select it, or make
-the buffer current). The display happens by calling `display-buffer'
-with the ACTION argument. If `temp-buffer-resize-mode' is enabled,
-the relevant window shrinks automatically.
-
-This returns the value returned by BODY, unless QUIT-FUNCTION specifies
-a function. In that case, it runs the function with two arguments -
+that buffer. Do not make that buffer current for running the
+forms in BODY. Use `with-current-buffer-window' instead if you
+need to run BODY with that buffer current.
+
+At the end of BODY, mark the specified buffer unmodified and
+read-only, and display it in a window (but do not select it).
+The display happens by calling `display-buffer' passing it the
+ACTION argument. If `temp-buffer-resize-mode' is enabled, the
+corresponding window may be resized automatically.
+
+Return the value returned by BODY, unless QUIT-FUNCTION specifies
+a function. In that case, run that function with two arguments -
the window showing the specified buffer and the value returned by
-BODY - and returns the value returned by that function.
+BODY - and return the value returned by that function.
If the buffer is displayed on a new frame, the window manager may
decide to select that frame. In that case, it's usually a good
@@ -172,30 +172,97 @@ before reading any value from the minibuffer; for example, when
asking a `yes-or-no-p' question.
This runs the hook `temp-buffer-window-setup-hook' before BODY,
-with the specified buffer temporarily current. It runs the
-hook `temp-buffer-window-show-hook' after displaying the buffer,
-with that buffer temporarily current, and the window that was used to
+with the specified buffer temporarily current. It runs the hook
+`temp-buffer-window-show-hook' after displaying the buffer, with
+that buffer temporarily current, and the window that was used to
display it temporarily selected.
-This construct is similar to `with-output-to-temp-buffer', but
-runs different hooks. In particular, it does not run
-`temp-buffer-setup-hook', which usually puts the buffer in Help mode.
-Also, it does not call `temp-buffer-show-function' (the ACTION
+This construct is similar to `with-output-to-temp-buffer' but,
+neither runs `temp-buffer-setup-hook' which usually puts the
+buffer in Help mode, nor `temp-buffer-show-function' (the ACTION
argument replaces this)."
(declare (debug t))
(let ((buffer (make-symbol "buffer"))
(window (make-symbol "window"))
(value (make-symbol "value")))
- `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
- (standard-output ,buffer)
- ,window ,value)
- (with-current-buffer ,buffer
+ (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+ (vaction action)
+ (vquit-function quit-function))
+ `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+ (standard-output ,buffer)
+ ,window ,value)
(setq ,value (progn ,@body))
- (setq ,window (temp-buffer-window-show ,buffer ,action)))
+ (with-current-buffer ,buffer
+ (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
+
+ (if (functionp ,vquit-function)
+ (funcall ,vquit-function ,window ,value)
+ ,value)))))
+
+(defmacro with-current-buffer-window (buffer-or-name action quit-function &rest body)
+ "Evaluate BODY with a buffer BUFFER-OR-NAME current and show that buffer.
+This construct is like `with-temp-buffer-window' but unlike that
+makes the buffer specified by BUFFER-OR-NAME current for running
+BODY."
+ (declare (debug t))
+ (let ((buffer (make-symbol "buffer"))
+ (window (make-symbol "window"))
+ (value (make-symbol "value")))
+ (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+ (vaction action)
+ (vquit-function quit-function))
+ `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+ (standard-output ,buffer)
+ ,window ,value)
+ (with-current-buffer ,buffer
+ (setq ,value (progn ,@body))
+ (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
+
+ (if (functionp ,vquit-function)
+ (funcall ,vquit-function ,window ,value)
+ ,value)))))
+
+(defmacro with-displayed-buffer-window (buffer-or-name action quit-function &rest 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))
+ (let ((buffer (make-symbol "buffer"))
+ (window (make-symbol "window"))
+ (value (make-symbol "value")))
+ (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
+ (vaction action)
+ (vquit-function quit-function))
+ `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
+ (standard-output ,buffer)
+ ,window ,value)
+ (with-current-buffer ,buffer
+ (setq ,window (temp-buffer-window-show
+ ,buffer
+ ;; Remove window-height when it's handled below.
+ (if (functionp (cdr (assq 'window-height (cdr ,vaction))))
+ (assq-delete-all 'window-height (copy-sequence ,vaction))
+ ,vaction))))
+
+ (let ((inhibit-read-only t)
+ (inhibit-modification-hooks t))
+ (setq ,value (progn ,@body)))
+
+ (set-window-point ,window (point-min))
+
+ (when (functionp (cdr (assq 'window-height (cdr ,vaction))))
+ (ignore-errors
+ (funcall (cdr (assq 'window-height (cdr ,vaction))) ,window)))
+
+ (when (consp (cdr (assq 'preserve-size (cdr ,vaction))))
+ (window-preserve-size
+ ,window t (cadr (assq 'preserve-size (cdr ,vaction))))
+ (window-preserve-size
+ ,window nil (cddr (assq 'preserve-size (cdr ,vaction)))))
- (if (functionp ,quit-function)
- (funcall ,quit-function ,window ,value)
- ,value))))
+ (if (functionp ,vquit-function)
+ (funcall ,vquit-function ,window ,value)
+ ,value)))))
;; The following two functions are like `window-next-sibling' and
;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
@@ -279,6 +346,28 @@ Otherwise, signal an error."
(t
(error "%s is not a valid window" window))))
+;; Maybe this should go to frame.el.
+(defun frame-char-size (&optional window-or-frame horizontal)
+ "Return the value of `frame-char-height' for WINDOW-OR-FRAME.
+If WINDOW-OR-FRAME is a live frame, return the value of
+`frame-char-height' for that frame. If WINDOW-OR-FRAME is a
+valid window, return the value of `frame-char-height' for that
+window's frame. In any other case, return the value of
+`frame-char-height' for the selected frame.
+
+Optional argument HORIZONTAL non-nil means to return the value of
+`frame-char-width' for WINDOW-OR-FRAME."
+ (let ((frame
+ (cond
+ ((window-valid-p window-or-frame)
+ (window-frame window-or-frame))
+ ((frame-live-p window-or-frame)
+ window-or-frame)
+ (t (selected-frame)))))
+ (if horizontal
+ (frame-char-width frame)
+ (frame-char-height frame))))
+
(defvar ignore-window-parameters nil
"If non-nil, standard functions ignore window parameters.
The functions currently affected by this are `split-window',
@@ -287,13 +376,20 @@ The functions currently affected by this are `split-window',
An application may bind this to a non-nil value around calls to
these functions to inhibit processing of window parameters.")
+;; This must go to C, finally (or get removed).
(defconst window-safe-min-height 1
- "The absolute minimum number of lines of a window.
+ "The absolute minimum number of lines of any window.
Anything less might crash Emacs.")
+(defun window-safe-min-pixel-height (&optional window)
+ "Return the absolute minimum pixel height of WINDOW."
+ (* window-safe-min-height
+ (frame-char-size (window-normalize-window window))))
+
(defcustom window-min-height 4
- "The minimum number of lines of any window.
-The value has to accommodate a mode- or header-line if present.
+ "The minimum total height, in lines, of any window.
+The value has to accommodate one text line, a mode and header
+line, a horizontal scroll bar and a bottom divider, if present.
A value less than `window-safe-min-height' is ignored. The value
of this variable is honored when windows are resized or split.
@@ -306,16 +402,27 @@ shorter, explicitly specify the SIZE argument of that function."
:version "24.1"
:group 'windows)
+(defun window-min-pixel-height (&optional window)
+ "Return the minimum pixel height of window WINDOW."
+ (* (max window-min-height window-safe-min-height)
+ (frame-char-size window)))
+
+;; This must go to C, finally (or get removed).
(defconst window-safe-min-width 2
"The absolute minimum number of columns of a window.
Anything less might crash Emacs.")
+(defun window-safe-min-pixel-width (&optional window)
+ "Return the absolute minimum pixel width of WINDOW."
+ (* window-safe-min-width
+ (frame-char-size (window-normalize-window window) t)))
+
(defcustom window-min-width 10
- "The minimum number of columns of any window.
-The value has to accommodate margins, fringes, or scrollbars if
-present. A value less than `window-safe-min-width' is ignored.
-The value of this variable is honored when windows are resized or
-split.
+ "The minimum total width, in columns, of any window.
+The value has to accommodate two text columns as well as margins,
+fringes, a scroll bar and a right divider, if present. A value
+less than `window-safe-min-width' is ignored. The value of this
+variable is honored when windows are resized or split.
Applications should never rebind this variable. To resize a
window to a width less than the one specified here, an
@@ -326,15 +433,35 @@ narrower, explicitly specify the SIZE argument of that function."
:version "24.1"
:group 'windows)
+(defun window-min-pixel-width (&optional window)
+ "Return the minimum pixel width of window WINDOW."
+ (* (max window-min-width window-safe-min-width)
+ (frame-char-size window t)))
+
+(defun window-safe-min-pixel-size (&optional window horizontal)
+ "Return the absolute minimum pixel height of WINDOW.
+Optional argument HORIZONTAL non-nil means return the absolute
+minimum pixel width of WINDOW."
+ (if horizontal
+ (window-safe-min-pixel-width window)
+ (window-safe-min-pixel-height window)))
+
+(defun window-min-pixel-size (&optional window horizontal)
+ "Return the minimum pixel height of WINDOW.
+Optional argument HORIZONTAL non-nil means return the minimum
+pixel width of WINDOW."
+ (if horizontal
+ (window-min-pixel-width window)
+ (window-min-pixel-height window)))
+
(defun window-combined-p (&optional window horizontal)
"Return non-nil if WINDOW has siblings in a given direction.
WINDOW must be a valid window and defaults to the selected one.
-HORIZONTAL determines a direction for the window combination.
-If HORIZONTAL is omitted or nil, return non-nil if WINDOW is part
-of a vertical window combination.
-If HORIZONTAL is non-nil, return non-nil if WINDOW is part of a
-horizontal window combination."
+HORIZONTAL determines a direction for the window combination. If
+HORIZONTAL is omitted or nil, return non-nil if WINDOW is part of
+a vertical window combination. If HORIZONTAL is non-nil, return
+non-nil if WINDOW is part of a horizontal window combination."
(setq window (window-normalize-window window))
(let ((parent (window-parent window)))
(and parent
@@ -342,6 +469,16 @@ horizontal window combination."
(window-left-child parent)
(window-top-child parent)))))
+(defun window-combination-p (&optional window horizontal)
+ "Return WINDOW's first child if WINDOW is a vertical combination.
+WINDOW can be any window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return WINDOW's first
+child if WINDOW is a horizontal combination."
+ (setq window (window-normalize-window window))
+ (if horizontal
+ (window-left-child window)
+ (window-top-child window)))
+
(defun window-combinations (window &optional horizontal)
"Return largest number of windows vertically arranged within WINDOW.
WINDOW must be a valid window and defaults to the selected one.
@@ -625,6 +762,15 @@ number of slots on that side."
(integer :tag "Number" :value 3 :size 5)))
:group 'windows)
+(defun window--side-window-p (window)
+ "Return non-nil if WINDOW is a side window or the parent of one."
+ (or (window-parameter window 'window-side)
+ (and (window-child window)
+ (or (window-parameter
+ (window-child window) 'window-side)
+ (window-parameter
+ (window-last-child window) 'window-side)))))
+
(defun window--major-non-side-window (&optional frame)
"Return the major non-side window of frame FRAME.
The optional argument FRAME must be a live frame and defaults to
@@ -732,8 +878,8 @@ SIDE. Return the new window, nil if its creation window failed."
(cons
(if left-or-right 'window-width 'window-height)
(/ (window-total-size (frame-root-window) left-or-right)
- ;; By default use a fourth of the size of the
- ;; frame's root window.
+ ;; By default use a fourth of the size of the frame's
+ ;; root window.
4))
alist)))
;; Install BUFFER in new window and return NEW.
@@ -747,13 +893,13 @@ SIDE. Return the new window, nil if its creation window failed."
(delete-window window)))
(defun display-buffer-in-side-window (buffer alist)
- "Display BUFFER in a window on side SIDE of the selected frame.
+ "Display BUFFER in a side window of the selected frame.
ALIST is an association list of symbols and values. The
-following symbols can be used:
+following special symbols can be used in ALIST.
-`side' denotes the side of the existing window where the new
- window shall be located. Valid values are `bottom', `right',
- `top' and `left'. The default is `bottom'.
+`side' denotes the side of the frame where the new window shall
+ be located. Valid values are `bottom', `right', `top' and
+ `left'. The default is `bottom'.
`slot' if non-nil, specifies the window slot where to display
BUFFER. A value of zero or nil means use the middle slot on
@@ -951,7 +1097,132 @@ FRAME defaults to the selected frame."
(window--side-check frame)
(window--atom-check frame))
+;; Dumping frame/window contents.
+(defun window--dump-window (&optional window erase)
+ "Dump WINDOW to buffer *window-frame-dump*.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument ERASE non-nil means erase *window-frame-dump*
+before writing to it."
+ (setq window (window-normalize-window window))
+ (with-current-buffer (get-buffer-create "*window-frame-dump*")
+ (when erase (erase-buffer))
+ (insert
+ (format "%s parent: %s\n" window (window-parent window))
+ (format "pixel left: %s top: %s size: %s x %s new: %s\n"
+ (window-pixel-left window) (window-pixel-top window)
+ (window-size window t t) (window-size window nil t)
+ (window-new-pixel window))
+ (format "char left: %s top: %s size: %s x %s new: %s\n"
+ (window-left-column window) (window-top-line window)
+ (window-total-size window t) (window-total-size window)
+ (window-new-total window))
+ (format "normal: %s x %s new: %s\n"
+ (window-normal-size window t) (window-normal-size window)
+ (window-new-normal window)))
+ (when (window-live-p window)
+ (let ((fringes (window-fringes window))
+ (margins (window-margins window)))
+ (insert
+ (format "body pixel: %s x %s char: %s x %s\n"
+ (window-body-width window t) (window-body-height window t)
+ (window-body-width window) (window-body-height window))
+ (format "width left fringe: %s left margin: %s right margin: %s\n"
+ (car fringes) (or (car margins) 0) (or (cdr margins) 0))
+ (format "width right fringe: %s scroll-bar: %s divider: %s\n"
+ (cadr fringes)
+ (window-scroll-bar-width window)
+ (window-right-divider-width window))
+ (format "height header-line: %s mode-line: %s divider: %s\n"
+ (window-header-line-height window)
+ (window-mode-line-height window)
+ (window-bottom-divider-width window)))))
+ (insert "\n")))
+
+(defun window--dump-frame (&optional window-or-frame)
+ "Dump WINDOW-OR-FRAME to buffer *window-frame-dump*.
+WINDOW-OR-FRAME can be a frame or a window and defaults to the
+selected frame. When WINDOW-OR-FRAME is a window, dump that
+window's frame. The buffer *window-frame-dump* is erased before
+dumping to it."
+ (let* ((window
+ (cond
+ ((or (not window-or-frame)
+ (frame-live-p window-or-frame))
+ (frame-root-window window-or-frame))
+ ((or (window-live-p window-or-frame)
+ (window-child window-or-frame))
+ window-or-frame)
+ (t
+ (frame-root-window))))
+ (frame (window-frame window)))
+ (with-current-buffer (get-buffer-create "*window-frame-dump*")
+ (erase-buffer)
+ (insert
+ (format "frame pixel: %s x %s cols/lines: %s x %s units: %s x %s\n"
+ (frame-pixel-width frame) (frame-pixel-height frame)
+ (frame-total-cols frame) (frame-total-lines frame)
+ (frame-char-width frame) (frame-char-height frame))
+ (format "frame text pixel: %s x %s cols/lines: %s x %s\n"
+ (frame-text-width frame) (frame-text-height frame)
+ (frame-text-cols frame) (frame-text-lines frame))
+ (format "tool: %s scroll: %s/%s fringe: %s border: %s right: %s bottom: %s\n\n"
+ (if (fboundp 'tool-bar-height)
+ (tool-bar-height frame t)
+ "0")
+ (frame-scroll-bar-width frame)
+ (frame-scroll-bar-height frame)
+ (frame-fringe-width frame)
+ (frame-border-width frame)
+ (frame-right-divider-width frame)
+ (frame-bottom-divider-width frame)))
+ (walk-window-tree 'window--dump-window frame t t))))
+
;;; Window sizes.
+(defun window-total-size (&optional window horizontal round)
+ "Return the total height or width of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
+
+If HORIZONTAL is omitted or nil, return the total height of
+WINDOW, in lines. If WINDOW is live, its total height includes,
+in addition to the height of WINDOW's text, the heights of
+WINDOW's mode and header line and a bottom divider, if any.
+
+If HORIZONTAL is non-nil, return the total width of WINDOW, in
+columns. If WINDOW is live, its total width includes, in
+addition to the width of WINDOW's text, the widths of WINDOW's
+fringes, margins, scroll bars and its right divider, if any.
+
+If WINDOW is internal, return the respective size of the screen
+areas spanned by its children.
+
+Optional argument ROUND is handled as for `window-total-height'
+and `window-total-width'."
+ (if horizontal
+ (window-total-width window round)
+ (window-total-height window round)))
+
+(defun window-size (&optional window horizontal pixelwise round)
+ "Return the height or width of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
+
+If HORIZONTAL is omitted or nil, return the total height of
+WINDOW, in lines, like `window-total-height'. Otherwise return
+the total width, in columns, like `window-total-width'.
+
+Optional argument PIXELWISE means return the pixel size of WINDOW
+like `window-pixel-height' and `window-pixel-width'.
+
+Optional argument ROUND is ignored if PIXELWISE is non-nil and
+handled as for `window-total-height' and `window-total-width'
+otherwise."
+ (if horizontal
+ (if pixelwise
+ (window-pixel-width window)
+ (window-total-width window round))
+ (if pixelwise
+ (window-pixel-height window)
+ (window-total-height window round))))
+
(defvar window-size-fixed nil
"Non-nil in a buffer means windows displaying the buffer are fixed-size.
If the value is `height', then only the window's height is fixed.
@@ -963,28 +1234,114 @@ unless it has no other choice (like when deleting a neighboring
window).")
(make-variable-buffer-local 'window-size-fixed)
-(defun window--size-ignore-p (window ignore)
- "Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
- (if (window-valid-p ignore) (eq window ignore) ignore))
+(defun window--preservable-size (window &optional horizontal)
+ "Return height of WINDOW as `window-preserve-size' would preserve it.
+Optional argument HORIZONTAL non-nil means to return the width of
+WINDOW as `window-preserve-size' would preserve it."
+ (if horizontal
+ (window-body-width window t)
+ (+ (window-body-height window t)
+ (window-header-line-height window)
+ (window-mode-line-height window))))
-(defun window-min-size (&optional window horizontal ignore)
+(defun window-preserve-size (&optional window horizontal preserve)
+ "Preserve height of window WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means preserve the width of
+WINDOW.
+
+PRESERVE t means to preserve the current height/width of WINDOW's
+body in frame and window resizing operations whenever possible.
+The height/width of WINDOW will change only if Emacs has no other
+choice. Resizing a window whose height/width is preserved never
+throws an error.
+
+PRESERVE nil means to stop preserving the height/width of WINDOW,
+lifting the respective restraint induced by a previous call of
+`window-preserve-size' for WINDOW. Calling `enlarge-window',
+`shrink-window', `split-window' or `fit-window-to-buffer' with
+WINDOW as argument also removes the respective restraint.
+
+Other values of PRESERVE are reserved for future use."
+ (setq window (window-normalize-window window t))
+ (let* ((parameter (window-parameter window 'window-preserved-size))
+ (width (nth 1 parameter))
+ (height (nth 2 parameter)))
+ (if horizontal
+ (set-window-parameter
+ window 'window-preserved-size
+ (list
+ (window-buffer window)
+ (and preserve (window--preservable-size window t))
+ height))
+ (set-window-parameter
+ window 'window-preserved-size
+ (list
+ (window-buffer window)
+ width
+ (and preserve (window--preservable-size window)))))))
+
+(defun window-preserved-size (&optional window horizontal)
+ "Return preserved height of window WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means to return preserved
+width of WINDOW."
+ (setq window (window-normalize-window window t))
+ (let* ((parameter (window-parameter window 'window-preserved-size))
+ (buffer (nth 0 parameter))
+ (width (nth 1 parameter))
+ (height (nth 2 parameter)))
+ (when (eq buffer (window-buffer window))
+ (if horizontal width height))))
+
+(defun window--preserve-size (window horizontal)
+ "Return non-nil when the height of WINDOW shall be preserved.
+Optional argument HORIZONTAL non-nil means to return non-nil when
+the width of WINDOW shall be preserved."
+ (let ((size (window-preserved-size window horizontal)))
+ (and (numberp size)
+ (= size (window--preservable-size window horizontal)))))
+
+(defun window-safe-min-size (&optional window horizontal pixelwise)
+ "Return safe minimum size of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
+Optional argument HORIZONTAL non-nil means return the minimum
+number of columns of WINDOW; otherwise return the minimum number
+of WINDOW's lines.
+
+Optional argument PIXELWISE non-nil means return the minimum pixel-size
+of WINDOW."
+ (setq window (window-normalize-window window))
+ (if pixelwise
+ (if horizontal
+ (* window-safe-min-width
+ (frame-char-width (window-frame window)))
+ (* window-safe-min-height
+ (frame-char-height (window-frame window))))
+ (if horizontal window-safe-min-width window-safe-min-height)))
+
+(defun window-min-size (&optional window horizontal ignore pixelwise)
"Return the minimum size of WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return the minimum
number of columns of WINDOW; otherwise return the minimum number
of WINDOW's lines.
-Optional argument IGNORE, if non-nil, means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE equals `safe', live
-windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. If IGNORE is a window, ignore
-restrictions for that window only. Any other non-nil value
-means ignore all of the above restrictions for all windows."
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument PIXELWISE non-nil means
+return the minimum pixel-size of WINDOW."
(window--min-size-1
- (window-normalize-window window) horizontal ignore))
+ (window-normalize-window window) horizontal ignore pixelwise))
+
+(defun window--min-size-ignore-p (window horizontal ignore)
+ "Return non-nil if IGNORE says to ignore height restrictions for WINDOW.
+HORIZONTAL non-nil means to return non-nil if IGNORE says to
+ignore width restrictions for WINDOW."
+ (if (window-valid-p ignore)
+ (eq window ignore)
+ (not (memq ignore '(nil preserved)))))
-(defun window--min-size-1 (window horizontal ignore)
+(defun window--min-size-1 (window horizontal ignore pixelwise)
"Internal function of `window-min-size'."
(let ((sub (window-child window)))
(if sub
@@ -995,24 +1352,27 @@ means ignore all of the above restrictions for all windows."
;; the minimum sizes of its child windows.
(while sub
(setq value (+ value
- (window--min-size-1 sub horizontal ignore)))
+ (window--min-size-1
+ sub horizontal ignore pixelwise)))
(setq sub (window-right sub)))
;; The minimum size of an ortho-combination is the maximum
;; of the minimum sizes of its child windows.
(while sub
(setq value (max value
- (window--min-size-1 sub horizontal ignore)))
+ (window--min-size-1
+ sub horizontal ignore pixelwise)))
(setq sub (window-right sub))))
value)
(with-current-buffer (window-buffer window)
(cond
- ((and (not (window--size-ignore-p window ignore))
- (window-size-fixed-p window horizontal))
+ ((window-minibuffer-p window)
+ (if pixelwise (frame-char-height (window-frame window)) 1))
+ ((window-size-fixed-p window horizontal ignore)
;; The minimum size of a fixed size window is its size.
- (window-total-size window horizontal))
- ((or (eq ignore 'safe) (eq ignore window))
- ;; If IGNORE equals `safe' or WINDOW return the safe values.
- (if horizontal window-safe-min-width window-safe-min-height))
+ (window-size window horizontal pixelwise))
+ ((eq ignore 'safe)
+ ;; If IGNORE equals `safe' return the safe value.
+ (window-safe-min-size window horizontal pixelwise))
(horizontal
;; For the minimum width of a window take fringes and
;; scroll-bars into account. This is questionable and should
@@ -1020,37 +1380,52 @@ means ignore all of the above restrictions for all windows."
;; windows such that the new (or resized) windows can get a
;; size less than the user-specified `window-min-height' and
;; `window-min-width'.
- (let ((frame (window-frame window))
- (fringes (window-fringes window))
- (scroll-bars (window-scroll-bars window)))
- (max
- (+ window-safe-min-width
- (ceiling (car fringes) (frame-char-width frame))
- (ceiling (cadr fringes) (frame-char-width frame))
- (cond
- ((memq (nth 2 scroll-bars) '(left right))
- (nth 1 scroll-bars))
- ((memq (frame-parameter frame 'vertical-scroll-bars)
- '(left right))
- (ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
- (frame-char-width)))
- (t 0)))
- (if (and (not (window--size-ignore-p window ignore))
- (numberp window-min-width))
- window-min-width
- 0))))
- (t
- ;; For the minimum height of a window take any mode- or
- ;; header-line into account.
- (max (+ window-safe-min-height
- (if header-line-format 1 0)
- (if mode-line-format 1 0))
- (if (and (not (window--size-ignore-p window ignore))
- (numberp window-min-height))
- window-min-height
- 0))))))))
-
-(defun window-sizable (window delta &optional horizontal ignore)
+ (let* ((char-size (frame-char-size window t))
+ (fringes (window-fringes window))
+ (margins (window-margins window))
+ (pixel-width
+ (+ (window-safe-min-size window t t)
+ (* (or (car margins) 0) char-size)
+ (* (or (cdr margins) 0) char-size)
+ (car fringes) (cadr fringes)
+ (window-scroll-bar-width window)
+ (window-right-divider-width window))))
+ (if pixelwise
+ (max
+ (if window-resize-pixelwise
+ pixel-width
+ ;; Round up to next integral of columns.
+ (* (ceiling pixel-width char-size) char-size))
+ (if (window--min-size-ignore-p window horizontal ignore)
+ 0
+ (window-min-pixel-width window)))
+ (max
+ (ceiling pixel-width char-size)
+ (if (window--min-size-ignore-p window horizontal ignore)
+ 0
+ window-min-width)))))
+ ((let ((char-size (frame-char-size window))
+ (pixel-height
+ (+ (window-safe-min-size window nil t)
+ (window-header-line-height window)
+ (window-scroll-bar-height window)
+ (window-mode-line-height window)
+ (window-bottom-divider-width window))))
+ (if pixelwise
+ (max
+ (if window-resize-pixelwise
+ pixel-height
+ ;; Round up to next integral of lines.
+ (* (ceiling pixel-height char-size) char-size))
+ (if (window--min-size-ignore-p window horizontal ignore)
+ 0
+ (window-min-pixel-height window)))
+ (max (ceiling pixel-height char-size)
+ (if (window--min-size-ignore-p window horizontal ignore)
+ 0
+ window-min-height))))))))))
+
+(defun window-sizable (window delta &optional horizontal ignore pixelwise)
"Return DELTA if DELTA lines can be added to WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if DELTA
@@ -1071,38 +1446,34 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 by which WINDOW
can be shrunk.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE equals `safe', live
-windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. If IGNORE is a window, ignore
-restrictions for that window only. Any other non-nil value means
-ignore all of the above restrictions for all windows."
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument PIXELWISE non-nil means
+interpret DELTA as pixels."
(setq window (window-normalize-window window))
(cond
((< delta 0)
- (max (- (window-min-size window horizontal ignore)
- (window-total-size window horizontal))
+ (max (- (window-min-size window horizontal ignore pixelwise)
+ (window-size window horizontal pixelwise))
delta))
- ((window--size-ignore-p window ignore)
- delta)
((> delta 0)
- (if (window-size-fixed-p window horizontal)
+ (if (window-size-fixed-p window horizontal ignore)
0
delta))
(t 0)))
-(defun window-sizable-p (window delta &optional horizontal ignore)
+(defun window-sizable-p (window delta &optional horizontal ignore pixelwise)
"Return t if WINDOW can be resized by DELTA lines.
WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
doc-string of `window-sizable'."
(setq window (window-normalize-window window))
(if (> delta 0)
- (>= (window-sizable window delta horizontal ignore) delta)
- (<= (window-sizable window delta horizontal ignore) delta)))
+ (>= (window-sizable window delta horizontal ignore pixelwise)
+ delta)
+ (<= (window-sizable window delta horizontal ignore pixelwise)
+ delta)))
-(defun window--size-fixed-1 (window horizontal)
+(defun window--size-fixed-1 (window horizontal ignore)
"Internal function for `window-size-fixed-p'."
(let ((sub (window-child window)))
(catch 'fixed
@@ -1113,7 +1484,7 @@ doc-string of `window-sizable'."
;; windows are fixed-size.
(progn
(while sub
- (unless (window--size-fixed-1 sub horizontal)
+ (unless (window--size-fixed-1 sub horizontal ignore)
;; We found a non-fixed-size child window, so
;; WINDOW's size is not fixed.
(throw 'fixed nil))
@@ -1124,30 +1495,35 @@ doc-string of `window-sizable'."
;; An ortho-combination is fixed-size if at least one of its
;; child windows is fixed-size.
(while sub
- (when (window--size-fixed-1 sub horizontal)
+ (when (window--size-fixed-1 sub horizontal ignore)
;; We found a fixed-size child window, so WINDOW's size
;; is fixed.
(throw 'fixed t))
(setq sub (window-right sub))))
;; WINDOW is a live window.
- (with-current-buffer (window-buffer window)
- (if horizontal
- (memq window-size-fixed '(width t))
- (memq window-size-fixed '(height t))))))))
-
-(defun window-size-fixed-p (&optional window horizontal)
+ (and (or (not (windowp ignore)) (not (eq window ignore)))
+ (or (and (not (eq ignore 'preserved))
+ (window--preserve-size window horizontal))
+ (with-current-buffer (window-buffer window)
+ (if horizontal
+ (memq window-size-fixed '(width t))
+ (memq window-size-fixed '(height t))))))))))
+
+(defun window-size-fixed-p (&optional window horizontal ignore)
"Return non-nil if WINDOW's height is fixed.
WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return non-nil if
-WINDOW's width is fixed.
+WINDOW's width is fixed. The optional argument IGNORE has the
+same meaning as for `window-resizable'.
If this function returns nil, this does not necessarily mean that
WINDOW can be resized in the desired direction. The function
`window-resizable' can tell that."
- (window--size-fixed-1
- (window-normalize-window window) horizontal))
+ (when (or (windowp ignore) (memq ignore '(nil preserved)))
+ (window--size-fixed-1
+ (window-normalize-window window) horizontal ignore)))
-(defun window--min-delta-1 (window delta &optional horizontal ignore trail noup)
+(defun window--min-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
"Internal function for `window-min-delta'."
(if (not (window-parent window))
;; If we can't go up, return zero.
@@ -1166,8 +1542,7 @@ WINDOW can be resized in the desired direction. The function
((eq sub window)
(setq skip (eq trail 'before)))
(skip)
- ((and (not (window--size-ignore-p window ignore))
- (window-size-fixed-p sub horizontal)))
+ ((window-size-fixed-p sub horizontal ignore))
(t
;; We found a non-fixed-size child window.
(throw 'done delta)))
@@ -1178,14 +1553,17 @@ WINDOW can be resized in the desired direction. The function
(unless (eq sub window)
(setq delta
(min delta
- (- (window-total-size sub horizontal)
- (window-min-size sub horizontal ignore)))))
+ (max (- (window-size sub horizontal pixelwise 'ceiling)
+ (window-min-size
+ sub horizontal ignore pixelwise))
+ 0))))
(setq sub (window-right sub))))
(if noup
delta
- (window--min-delta-1 parent delta horizontal ignore trail))))))
+ (window--min-delta-1
+ parent delta horizontal ignore trail nil pixelwise))))))
-(defun window-min-delta (&optional window horizontal ignore trail noup nodown)
+(defun window-min-delta (&optional window horizontal ignore trail noup nodown pixelwise)
"Return number of lines by which WINDOW can be shrunk.
WINDOW must be a valid window and defaults to the selected one.
Return zero if WINDOW cannot be shrunk.
@@ -1193,33 +1571,30 @@ Return zero if WINDOW cannot be shrunk.
Optional argument HORIZONTAL non-nil means return number of
columns by which WINDOW can be shrunk.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE is a window, ignore
-restrictions for that window only. If IGNORE equals `safe',
-live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns. Any other non-nil value
-means ignore all of the above restrictions for all windows.
-
-Optional argument TRAIL restricts the windows that can be enlarged.
-If its value is `before', only windows to the left of or above WINDOW
-can be enlarged. If it is `after', only windows to the right of or
-below WINDOW can be enlarged.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument TRAIL restricts the
+windows that can be enlarged. If its value is `before', only
+windows to the left of or above WINDOW can be enlarged. If it is
+`after', only windows to the right of or below WINDOW can be
+enlarged.
Optional argument NOUP non-nil means don't go up in the window
-tree, but try to enlarge windows within WINDOW's combination only.
+tree, but try to enlarge windows within WINDOW's combination
+only. Optional argument NODOWN non-nil means don't check whether
+WINDOW itself (and its child windows) can be shrunk; check only
+whether at least one other window can be enlarged appropriately.
-Optional argument NODOWN non-nil means don't check whether WINDOW
-itself (and its child windows) can be shrunk; check only whether
-at least one other window can be enlarged appropriately."
+Optional argument PIXELWISE non-nil means return number of pixels
+by which WINDOW can be shrunk."
(setq window (window-normalize-window window))
- (let ((size (window-total-size window horizontal))
- (minimum (window-min-size window horizontal ignore)))
+ (let ((size (window-size window horizontal pixelwise 'floor))
+ (minimum (window-min-size window horizontal ignore pixelwise)))
(cond
(nodown
;; If NODOWN is t, try to recover the entire size of WINDOW.
- (window--min-delta-1 window size horizontal ignore trail noup))
- ((= size minimum)
+ (window--min-delta-1
+ window size horizontal ignore trail noup pixelwise))
+ ((<= size minimum)
;; If NODOWN is nil and WINDOW's size is already at its minimum,
;; there's nothing to recover.
0)
@@ -1227,9 +1602,23 @@ at least one other window can be enlarged appropriately."
;; Otherwise, try to recover whatever WINDOW is larger than its
;; minimum size.
(window--min-delta-1
- window (- size minimum) horizontal ignore trail noup)))))
+ window (- size minimum) horizontal ignore trail noup pixelwise)))))
+
+(defun frame-windows-min-size (&optional frame horizontal ignore pixelwise)
+ "Return minimum number of lines of FRAME's windows.
+HORIZONTAL non-nil means return number of columns of FRAME's
+windows. The optional argument IGNORE has the same meaning as
+for `window-resizable'. PIXELWISE non-nil means return sizes in
+pixels."
+ (setq frame (window-normalize-frame frame))
+ (let* ((root (frame-root-window frame))
+ (mini (window-next-sibling root)))
+ (+ (window-min-size root horizontal ignore pixelwise)
+ (if (and mini (not horizontal))
+ (window-min-size mini horizontal nil pixelwise)
+ 0))))
-(defun window--max-delta-1 (window delta &optional horizontal ignore trail noup)
+(defun window--max-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
"Internal function of `window-max-delta'."
(if (not (window-parent window))
;; Can't go up. Return DELTA.
@@ -1249,15 +1638,17 @@ at least one other window can be enlarged appropriately."
(t
(setq delta
(+ delta
- (- (window-total-size sub horizontal)
- (window-min-size sub horizontal ignore))))))
+ (max
+ (- (window-size sub horizontal pixelwise 'floor)
+ (window-min-size
+ sub horizontal ignore pixelwise))
+ 0)))))
(setq sub (window-right sub))))
;; For an ortho-combination throw DELTA when at least one
;; child window is fixed-size.
(while sub
(when (and (not (eq sub window))
- (not (window--size-ignore-p sub ignore))
- (window-size-fixed-p sub horizontal))
+ (window-size-fixed-p sub horizontal ignore))
(throw 'fixed delta))
(setq sub (window-right sub))))
(if noup
@@ -1265,9 +1656,10 @@ at least one other window can be enlarged appropriately."
delta
;; Else try with parent of WINDOW, passing the DELTA we
;; recovered so far.
- (window--max-delta-1 parent delta horizontal ignore trail))))))
+ (window--max-delta-1
+ parent delta horizontal ignore trail nil pixelwise))))))
-(defun window-max-delta (&optional window horizontal ignore trail noup nodown)
+(defun window-max-delta (&optional window horizontal ignore trail noup nodown pixelwise)
"Return maximum number of lines by which WINDOW can be enlarged.
WINDOW must be a valid window and defaults to the selected one.
The return value is zero if WINDOW cannot be enlarged.
@@ -1275,37 +1667,32 @@ The return value is zero if WINDOW cannot be enlarged.
Optional argument HORIZONTAL non-nil means return maximum number
of columns by which WINDOW can be enlarged.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE is a window, ignore
-restrictions for that window only. If IGNORE equals `safe',
-live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns. Any other non-nil value means
-ignore all of the above restrictions for all windows.
-
-Optional argument TRAIL restricts the windows that can be enlarged.
-If its value is `before', only windows to the left of or above WINDOW
-can be enlarged. If it is `after', only windows to the right of or
-below WINDOW can be enlarged.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument TRAIL restricts the
+windows that can be enlarged. If its value is `before', only
+windows to the left of or above WINDOW can be enlarged. If it is
+`after', only windows to the right of or below WINDOW can be
+enlarged.
Optional argument NOUP non-nil means don't go up in the window
tree but try to obtain the entire space from windows within
-WINDOW's combination.
+WINDOW's combination. Optional argument NODOWN non-nil means do
+not check whether WINDOW itself (and its child windows) can be
+enlarged; check only whether other windows can be shrunk
+appropriately.
-Optional argument NODOWN non-nil means do not check whether
-WINDOW itself (and its child windows) can be enlarged; check
-only whether other windows can be shrunk appropriately."
+Optional argument PIXELWISE non-nil means return number of
+pixels by which WINDOW can be enlarged."
(setq window (window-normalize-window window))
- (if (and (not (window--size-ignore-p window ignore))
- (not nodown) (window-size-fixed-p window horizontal))
+ (if (and (not nodown) (window-size-fixed-p window horizontal ignore))
;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
;; size.
0
;; WINDOW has no fixed size.
- (window--max-delta-1 window 0 horizontal ignore trail noup)))
+ (window--max-delta-1 window 0 horizontal ignore trail noup pixelwise)))
;; Make NOUP also inhibit the min-size check.
-(defun window--resizable (window delta &optional horizontal ignore trail noup nodown)
+(defun window--resizable (window delta &optional horizontal ignore trail noup nodown pixelwise)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
@@ -1322,49 +1709,51 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 that can be used
for shrinking WINDOW.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE is a window, ignore
-restrictions for that window only. If IGNORE equals `safe',
-live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns. Any other non-nil value
-means ignore all of the above restrictions for all windows.
-
-Optional argument TRAIL `before' means only windows to the left
-of or below WINDOW can be shrunk. Optional argument TRAIL
-`after' means only windows to the right of or above WINDOW can be
-shrunk.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument TRAIL `before' means only
+windows to the left of or below WINDOW can be shrunk. Optional
+argument TRAIL `after' means only windows to the right of or
+above WINDOW can be shrunk.
Optional argument NOUP non-nil means don't go up in the window
tree but check only whether space can be obtained from (or given
-to) WINDOW's siblings.
+to) WINDOW's siblings. Optional argument NODOWN non-nil means
+don't go down in the window tree. This means do not check
+whether resizing would violate size restrictions of WINDOW or its
+child windows.
-Optional argument NODOWN non-nil means don't go down in the
-window tree. This means do not check whether resizing would
-violate size restrictions of WINDOW or its child windows."
+Optional argument PIXELWISE non-nil means interpret DELTA as
+number of pixels."
(setq window (window-normalize-window window))
(cond
((< delta 0)
- (max (- (window-min-delta window horizontal ignore trail noup nodown))
+ (max (- (window-min-delta
+ window horizontal ignore trail noup nodown pixelwise))
delta))
((> delta 0)
- (min (window-max-delta window horizontal ignore trail noup nodown)
+ (min (window-max-delta
+ window horizontal ignore trail noup nodown pixelwise)
delta))
(t 0)))
-(defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown)
+(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown pixelwise)
"Return t if WINDOW can be resized vertically by DELTA lines.
WINDOW must be a valid window and defaults to the selected one.
For the meaning of the arguments of this function see the
-doc-string of `window--resizable'."
+doc-string of `window--resizable'.
+
+Optional argument PIXELWISE non-nil means interpret DELTA as
+pixels."
(setq window (window-normalize-window window))
(if (> delta 0)
- (>= (window--resizable window delta horizontal ignore trail noup nodown)
+ (>= (window--resizable
+ window delta horizontal ignore trail noup nodown pixelwise)
delta)
- (<= (window--resizable window delta horizontal ignore trail noup nodown)
+ (<= (window--resizable
+ window delta horizontal ignore trail noup nodown pixelwise)
delta)))
-(defun window-resizable (window delta &optional horizontal ignore)
+(defun window-resizable (window delta &optional horizontal ignore pixelwise)
"Return DELTA if WINDOW can be resized vertically by DELTA lines.
WINDOW must be a valid window and defaults to the selected one.
Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
@@ -1381,31 +1770,38 @@ columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
return the minimum value in the range DELTA..0 that can be used
for shrinking WINDOW.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE is a window, ignore
-restrictions for that window only. If IGNORE equals `safe',
-live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns. Any other non-nil value
-means ignore all of the above restrictions for all windows."
+Optional argument IGNORE, if non-nil, means to ignore restraints
+induced by fixed size windows or the values of the variables
+`window-min-height' and `window-min-width'. The following values
+have special meanings: `safe' means that in addition live windows
+are allowed to get as small as `window-safe-min-height' lines and
+`window-safe-min-width' columns. `preserved' means to ignore
+only restrictions induced by `window-preserve-size'. If IGNORE
+is a window, then ignore restrictions for that window only.
+
+Optional argument PIXELWISE non-nil means interpret DELTA as
+pixels."
(setq window (window-normalize-window window))
- (window--resizable window delta horizontal ignore))
+ (window--resizable window delta horizontal ignore nil nil nil pixelwise))
-(defun window-total-size (&optional window horizontal)
- "Return the total height or width of WINDOW.
+(defun window-resizable-p (window delta &optional horizontal ignore pixelwise)
+ "Return t if WINDOW can be resized vertically by DELTA lines.
WINDOW must be a valid window and defaults to the selected one.
+For the meaning of the arguments of this function see the
+doc-string of `window-resizable'."
+ (setq window (window-normalize-window window))
+ (if (> delta 0)
+ (>= (window--resizable
+ window delta horizontal ignore nil nil nil pixelwise)
+ delta)
+ (<= (window--resizable
+ window delta horizontal ignore nil nil nil pixelwise)
+ delta)))
-If HORIZONTAL is omitted or nil, return the total height of
-WINDOW, in lines, like `window-total-height'. Otherwise return
-the total width, in columns, like `window-total-width'."
- (if horizontal
- (window-total-width window)
- (window-total-height window)))
-
-;; Eventually we should make `window-height' obsolete.
+;; Aliases of functions defined in window.c.
(defalias 'window-height 'window-total-height)
+(defalias 'window-width 'window-body-width)
-;; See discussion in bug#4543.
(defun window-full-height-p (&optional window)
"Return t if WINDOW is as high as its containing frame.
More precisely, return t if and only if the total height of
@@ -1413,8 +1809,10 @@ WINDOW equals the total height of the root window of WINDOW's
frame. WINDOW must be a valid window and defaults to the
selected one."
(setq window (window-normalize-window window))
- (= (window-total-size window)
- (window-total-size (frame-root-window window))))
+ (if (window-minibuffer-p window)
+ (eq window (frame-root-window (window-frame window)))
+ (= (window-pixel-height window)
+ (window-pixel-height (frame-root-window window)))))
(defun window-full-width-p (&optional window)
"Return t if WINDOW is as wide as its containing frame.
@@ -1422,46 +1820,101 @@ More precisely, return t if and only if the total width of WINDOW
equals the total width of the root window of WINDOW's frame.
WINDOW must be a valid window and defaults to the selected one."
(setq window (window-normalize-window window))
- (= (window-total-size window t)
- (window-total-size (frame-root-window window) t)))
+ (= (window-pixel-width window)
+ (window-pixel-width (frame-root-window window))))
-(defun window-body-size (&optional window horizontal)
+(defun window-body-size (&optional window horizontal pixelwise)
"Return the height or width of WINDOW's text area.
WINDOW must be a live window and defaults to the selected one.
If HORIZONTAL is omitted or nil, return the height of the text
area, like `window-body-height'. Otherwise, return the width of
-the text area, like `window-body-width'."
+the text area, like `window-body-width'. In either case, the
+optional argument PIXELWISE is passed to the functions."
(if horizontal
- (window-body-width window)
- (window-body-height window)))
+ (window-body-width window pixelwise)
+ (window-body-height window pixelwise)))
-;; Eventually we should make `window-height' obsolete.
-(defalias 'window-width 'window-body-width)
+(declare-function font-info "font.c" (name &optional frame))
+
+(defun window-font-width (&optional window face)
+ "Return average character width for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face)))
+ (width (aref info 11)))
+ (if (> width 0)
+ width
+ (aref info 10)))
+ (frame-char-width))))
+
+(defun window-font-height (&optional window face)
+ "Return character height for the font of FACE used in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+If FACE is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function returns the
+information for the remapped face."
+ (with-selected-window (window-normalize-window window t)
+ (if (display-multi-font-p)
+ (let* ((face (if face face 'default))
+ (info (font-info (face-font face))))
+ (aref info 3))
+ (frame-char-height))))
+
+(defvar overflow-newline-into-fringe)
+
+(defun window-max-chars-per-line (&optional window face)
+ "Return the number of characters that can be displayed on one line in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The character width of FACE is used for the calculation. If FACE
+is nil or omitted, the default face is used. If FACE is
+remapped (see `face-remapping-alist'), the function uses the
+remapped face.
+
+This function is different from `window-body-width' in two
+ways. First, it accounts for the portions of the line reserved
+for the continuation glyph. Second, it accounts for the size of
+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)))
+ (if (and (display-graphic-p)
+ overflow-newline-into-fringe
+ (/= (frame-parameter nil 'left-fringe) 0)
+ (/= (frame-parameter nil 'right-fringe) 0))
+ ncols
+ (1- ncols)))))
(defun window-current-scroll-bars (&optional window)
- "Return the current scroll bar settings for WINDOW.
+ "Return the current scroll bar types for WINDOW.
WINDOW must be a live window and defaults to the selected one.
The return value is a cons cell (VERTICAL . HORIZONTAL) where
VERTICAL specifies the current location of the vertical scroll
-bars (`left', `right', or nil), and HORIZONTAL specifies the
-current location of the horizontal scroll bars (`top', `bottom',
-or nil).
+bar (`left', `right' or nil), and HORIZONTAL specifies the
+current location of the horizontal scroll bar (`bottom' or nil).
Unlike `window-scroll-bars', this function reports the scroll bar
type actually used, once frame defaults and `scroll-bar-mode' are
taken into account."
(setq window (window-normalize-window window t))
- (let ((vert (nth 2 (window-scroll-bars window)))
- (hor nil))
- (when (or (eq vert t) (eq hor t))
- (let ((fcsb (frame-current-scroll-bars (window-frame window))))
- (if (eq vert t)
- (setq vert (car fcsb)))
- (if (eq hor t)
- (setq hor (cdr fcsb)))))
- (cons vert hor)))
+ (let ((vertical (nth 2 (window-scroll-bars window)))
+ (horizontal (nth 5 (window-scroll-bars window)))
+ (inherited (frame-current-scroll-bars (window-frame window))))
+ (when (eq vertical t)
+ (setq vertical (car inherited)))
+ (when (eq horizontal t)
+ (setq horizontal (cdr inherited)))
+ (cons vertical (and horizontal 'bottom))))
(defun walk-windows (fun &optional minibuf all-frames)
"Cycle through all live windows, calling FUN for each one.
@@ -1521,8 +1974,8 @@ SIDE can be any of the symbols `left', `top', `right' or
((eq side 'top) 1)
((eq side 'right) 2)
((memq side '(bottom nil)) 3))))
- (= (nth edge (window-edges window))
- (nth edge (window-edges (frame-root-window window))))))
+ (= (nth edge (window-pixel-edges window))
+ (nth edge (window-pixel-edges (frame-root-window window))))))
(defun window-at-side-list (&optional frame side)
"Return list of all windows on SIDE of FRAME.
@@ -1541,21 +1994,21 @@ SIDE can be any of the symbols `left', `top', `right' or
(defun window--in-direction-2 (window posn &optional horizontal)
"Support function for `window-in-direction'."
(if horizontal
- (let ((top (window-top-line window)))
+ (let ((top (window-pixel-top window)))
(if (> top posn)
(- top posn)
- (- posn top (window-total-height window))))
- (let ((left (window-left-column window)))
+ (- posn top (window-pixel-height window))))
+ (let ((left (window-pixel-left window)))
(if (> left posn)
(- left posn)
- (- posn left (window-total-width window))))))
+ (- posn left (window-pixel-width window))))))
;; Predecessors to the below have been devised by Julian Assange in
;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
;; Neither of these allow to selectively ignore specific windows
;; (windows whose `no-other-window' parameter is non-nil) as targets of
;; the movement.
-(defun window-in-direction (direction &optional window ignore)
+(defun window-in-direction (direction &optional window ignore sign wrap mini)
"Return window in DIRECTION as seen from WINDOW.
More precisely, return the nearest window in direction DIRECTION
as seen from the position of `window-point' in window WINDOW.
@@ -1568,6 +2021,21 @@ non-nil, try to find another window in the indicated direction.
If, however, the optional argument IGNORE is non-nil, return that
window even if its `no-other-window' parameter is non-nil.
+Optional argument SIGN a negative number means to use the right
+or bottom edge of WINDOW as reference position instead of
+`window-point'. SIGN a positive number means to use the left or
+top edge of WINDOW as reference position.
+
+Optional argument WRAP non-nil means to wrap DIRECTION around
+frame borders. This means to return for WINDOW at the top of the
+frame and DIRECTION `above' the minibuffer window if the frame
+has one, and a window at the bottom of the frame otherwise.
+
+Optional argument MINI nil means to return the minibuffer window
+if and only if it is currently active. MINI non-nil means to
+return the minibuffer window even when it's not active. However,
+if WRAP non-nil, always act as if MINI were nil.
+
Return nil if no suitable window can be found."
(setq window (window-normalize-window window t))
(unless (memq direction '(above below left right))
@@ -1575,29 +2043,37 @@ Return nil if no suitable window can be found."
(let* ((frame (window-frame window))
(hor (memq direction '(left right)))
(first (if hor
- (window-left-column window)
- (window-top-line window)))
- (last (+ first (if hor
- (window-total-width window)
- (window-total-height window))))
- (posn-cons (nth 6 (posn-at-point (window-point window) window)))
+ (window-pixel-left window)
+ (window-pixel-top window)))
+ (last (+ first (window-size window hor t)))
;; The column / row value of `posn-at-point' can be nil for the
;; mini-window, guard against that.
- (posn (if hor
- (+ (or (cdr posn-cons) 1) (window-top-line window))
- (+ (or (car posn-cons) 1) (window-left-column window))))
+ (posn
+ (cond
+ ((and (numberp sign) (< sign 0))
+ (if hor
+ (1- (+ (window-pixel-top window) (window-pixel-height window)))
+ (1- (+ (window-pixel-left window) (window-pixel-width window)))))
+ ((and (numberp sign) (> sign 0))
+ (if hor
+ (window-pixel-top window)
+ (window-pixel-left window)))
+ ((let ((posn-cons (nth 2 (posn-at-point (window-point window) window))))
+ (if hor
+ (+ (or (cdr posn-cons) 1) (window-pixel-top window))
+ (+ (or (car posn-cons) 1) (window-pixel-left window)))))))
(best-edge
(cond
- ((eq direction 'below) (frame-height frame))
- ((eq direction 'right) (frame-width frame))
+ ((eq direction 'below) (frame-pixel-height frame))
+ ((eq direction 'right) (frame-pixel-width frame))
(t -1)))
(best-edge-2 best-edge)
- (best-diff-2 (if hor (frame-height frame) (frame-width frame)))
+ (best-diff-2 (if hor (frame-pixel-height frame) (frame-pixel-width frame)))
best best-2 best-diff-2-new)
(walk-window-tree
(lambda (w)
- (let* ((w-top (window-top-line w))
- (w-left (window-left-column w)))
+ (let* ((w-top (window-pixel-top w))
+ (w-left (window-pixel-left w)))
(cond
((or (eq window w)
;; Ignore ourselves.
@@ -1607,16 +2083,22 @@ Return nil if no suitable window can be found."
(hor
(cond
((and (<= w-top posn)
- (< posn (+ w-top (window-total-height w))))
+ (< posn (+ w-top (window-pixel-height w))))
;; W is to the left or right of WINDOW and covers POSN.
(when (or (and (eq direction 'left)
- (<= w-left first) (> w-left best-edge))
+ (or (and (<= w-left first) (> w-left best-edge))
+ (and wrap
+ (window-at-side-p window 'left)
+ (window-at-side-p w 'right))))
(and (eq direction 'right)
- (>= w-left last) (< w-left best-edge)))
+ (or (and (>= w-left last) (< w-left best-edge))
+ (and wrap
+ (window-at-side-p window 'right)
+ (window-at-side-p w 'left)))))
(setq best-edge w-left)
(setq best w)))
((and (or (and (eq direction 'left)
- (<= (+ w-left (window-total-width w)) first))
+ (<= (+ w-left (window-pixel-width w)) first))
(and (eq direction 'right) (<= last w-left)))
;; W is to the left or right of WINDOW but does not
;; cover POSN.
@@ -1630,32 +2112,40 @@ Return nil if no suitable window can be found."
(setq best-edge-2 w-left)
(setq best-diff-2 best-diff-2-new)
(setq best-2 w))))
- (t
- (cond
- ((and (<= w-left posn)
- (< posn (+ w-left (window-total-width w))))
- ;; W is above or below WINDOW and covers POSN.
- (when (or (and (eq direction 'above)
- (<= w-top first) (> w-top best-edge))
- (and (eq direction 'below)
- (>= w-top first) (< w-top best-edge)))
- (setq best-edge w-top)
- (setq best w)))
- ((and (or (and (eq direction 'above)
- (<= (+ w-top (window-total-height w)) first))
- (and (eq direction 'below) (<= last w-top)))
- ;; W is above or below WINDOW but does not cover POSN.
- (setq best-diff-2-new
- (window--in-direction-2 w posn hor))
- (or (< best-diff-2-new best-diff-2)
- (and (= best-diff-2-new best-diff-2)
- (if (eq direction 'above)
- (> w-top best-edge-2)
- (< w-top best-edge-2)))))
- (setq best-edge-2 w-top)
- (setq best-diff-2 best-diff-2-new)
- (setq best-2 w)))))))
- frame)
+ ((and (<= w-left posn)
+ (< posn (+ w-left (window-pixel-width w))))
+ ;; W is above or below WINDOW and covers POSN.
+ (when (or (and (eq direction 'above)
+ (or (and (<= w-top first) (> w-top best-edge))
+ (and wrap
+ (window-at-side-p window 'top)
+ (if (active-minibuffer-window)
+ (minibuffer-window-active-p w)
+ (window-at-side-p w 'bottom)))))
+ (and (eq direction 'below)
+ (or (and (>= w-top first) (< w-top best-edge))
+ (and wrap
+ (if (active-minibuffer-window)
+ (minibuffer-window-active-p window)
+ (window-at-side-p window 'bottom))
+ (window-at-side-p w 'top)))))
+ (setq best-edge w-top)
+ (setq best w)))
+ ((and (or (and (eq direction 'above)
+ (<= (+ w-top (window-pixel-height w)) first))
+ (and (eq direction 'below) (<= last w-top)))
+ ;; W is above or below WINDOW but does not cover POSN.
+ (setq best-diff-2-new
+ (window--in-direction-2 w posn hor))
+ (or (< best-diff-2-new best-diff-2)
+ (and (= best-diff-2-new best-diff-2)
+ (if (eq direction 'above)
+ (> w-top best-edge-2)
+ (< w-top best-edge-2)))))
+ (setq best-edge-2 w-top)
+ (setq best-diff-2 best-diff-2-new)
+ (setq best-2 w)))))
+ frame nil (and mini t))
(or best best-2)))
(defun get-window-with-predicate (predicate &optional minibuf all-frames default)
@@ -1799,8 +2289,8 @@ selected frame and no others."
(dolist (window (window-list-1 nil 'nomini all-frames))
(when (and (or dedicated (not (window-dedicated-p window)))
(or (not not-selected) (not (eq window (selected-window)))))
- (setq size (* (window-total-size window)
- (window-total-size window t)))
+ (setq size (* (window-pixel-height window)
+ (window-pixel-width window)))
(when (> size best-size)
(setq best-size size)
(setq best-window window))))
@@ -1809,8 +2299,8 @@ selected frame and no others."
(defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
"Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
BUFFER-OR-NAME may be a buffer or the name of an existing buffer
-and defaults to the current buffer. Windows are scanned starting
-with the selected window.
+and defaults to the current buffer. If the selected window displays
+BUFFER-OR-NAME, it will be the first in the resulting list.
MINIBUF t means include the minibuffer window even if the
minibuffer is not active. MINIBUF nil or omitted means include
@@ -1855,11 +2345,116 @@ meaning of this argument."
(length (window-list-1 nil minibuf)))
;;; Resizing windows.
+(defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe)
+ "For WINDOW convert SIZE lines to pixels.
+SIZE is supposed to specify a height of WINDOW in terms of text
+lines. The return value is the number of pixels specifying that
+height.
+
+WINDOW must be a valid window. Optional argument HORIZONTAL
+non-nil means convert SIZE columns to pixels.
+
+Optional argument PIXELWISE non-nil means SIZE already specifies
+pixels but may have to be adjusted to a multiple of the character
+size of WINDOW's frame. Optional argument ROUND-MAYBE non-nil
+means round to the nearest multiple of the character size of
+WINDOW's frame if the option `window-resize-pixelwise' is nil."
+ (setq window (window-normalize-window window))
+ (let ((char-size (frame-char-size window horizontal)))
+ (if pixelwise
+ (if (and round-maybe (not window-resize-pixelwise))
+ (* (round size char-size) char-size)
+ size)
+ (* size char-size))))
+
+(defun window--pixel-to-total-1 (window horizontal char-size)
+ "Subroutine of `window--pixel-to-total'."
+ (let ((child (window-child window)))
+ (if (window-combination-p window horizontal)
+ ;; In an iso-combination distribute sizes proportionally.
+ (let ((remainder (window-new-total window))
+ size best-child rem best-rem)
+ ;; Initialize total sizes to each child's floor.
+ (while child
+ (setq size (max (/ (window-size child horizontal t) char-size) 1))
+ (set-window-new-total child size)
+ (setq remainder (- remainder size))
+ (setq child (window-next-sibling child)))
+ ;; Distribute remainder.
+ (while (> remainder 0)
+ (setq child (window-last-child window))
+ (setq best-child nil)
+ (setq best-rem 0)
+ (while child
+ (when (and (<= (window-new-total child)
+ (/ (window-size child horizontal t) char-size))
+ (> (setq rem (% (window-size child horizontal t)
+ char-size))
+ best-rem))
+ (setq best-child child)
+ (setq best-rem rem))
+ (setq child (window-prev-sibling child)))
+ ;; We MUST have a best-child here.
+ (set-window-new-total best-child 1 t)
+ (setq remainder (1- remainder)))
+ ;; Recurse.
+ (setq child (window-child window))
+ (while child
+ (window--pixel-to-total-1 child horizontal char-size)
+ (setq child (window-next-sibling child))))
+ ;; In an ortho-combination assign new sizes directly.
+ (let ((size (window-new-total window)))
+ (while child
+ (set-window-new-total child size)
+ (window--pixel-to-total-1 child horizontal char-size)
+ (setq child (window-next-sibling child)))))))
+
+(defun window--pixel-to-total (&optional frame horizontal)
+ "On FRAME assign new total window heights from pixel heights.
+FRAME must be a live frame and defaults to the selected frame.
+
+Optional argument HORIZONTAL non-nil means assign new total
+window widths from pixel widths."
+ (setq frame (window-normalize-frame frame))
+ (let* ((char-size (frame-char-size frame horizontal))
+ (root (frame-root-window frame))
+ (root-size (window-size root horizontal t))
+ ;; We have to care about the minibuffer window only if it
+ ;; appears together with the root window on this frame.
+ (mini (let ((mini (minibuffer-window frame)))
+ (and (eq (window-frame mini) frame)
+ (not (eq mini root)) mini)))
+ (mini-size (and mini (window-size mini horizontal t))))
+ ;; We round the line/column sizes of windows here to the nearest
+ ;; integer. In some cases this can make windows appear _larger_
+ ;; than the containing frame (line/column-wise) because the latter's
+ ;; sizes are not (yet) rounded. We might eventually fix that.
+ (if (and mini (not horizontal))
+ (let (lines)
+ (set-window-new-total root (max (/ root-size char-size) 1))
+ (set-window-new-total mini (max (/ mini-size char-size) 1))
+ (setq lines (- (round (+ root-size mini-size) char-size)
+ (+ (window-new-total root) (window-new-total mini))))
+ (while (> lines 0)
+ (if (>= (% root-size (window-new-total root))
+ (% mini-size (window-new-total mini)))
+ (set-window-new-total root 1 t)
+ (set-window-new-total mini 1 t))
+ (setq lines (1- lines))))
+ (set-window-new-total root (round root-size char-size))
+ (when mini
+ ;; This is taken in the horizontal case only.
+ (set-window-new-total mini (round mini-size char-size))))
+ (unless (window-buffer root)
+ (window--pixel-to-total-1 root horizontal char-size))
+ ;; Apply the new sizes.
+ (window-resize-apply-total frame horizontal)))
+
(defun window--resize-reset (&optional frame horizontal)
"Reset resize values for all windows on FRAME.
FRAME defaults to the selected frame.
-This function stores the current value of `window-total-size' applied
+This function stores the current value of `window-size' applied
with argument HORIZONTAL in the new total size of all windows on
FRAME. It also resets the new normal size of each of these
windows."
@@ -1869,7 +2464,8 @@ windows."
(defun window--resize-reset-1 (window horizontal)
"Internal function of `window--resize-reset'."
;; Register old size in the new total size.
- (set-window-new-total window (window-total-size window horizontal))
+ (set-window-new-pixel window (window-size window horizontal t))
+ (set-window-new-total window (window-size window horizontal))
;; Reset new normal size.
(set-window-new-normal window)
(when (window-child window)
@@ -1880,35 +2476,51 @@ windows."
;; The following routine is used to manually resize the minibuffer
;; window and is currently used, for example, by ispell.el.
(defun window--resize-mini-window (window delta)
- "Resize minibuffer window WINDOW by DELTA lines.
-If WINDOW cannot be resized by DELTA lines make it as large (or
+ "Resize minibuffer window WINDOW by DELTA pixels.
+If WINDOW cannot be resized by DELTA pixels make it as large (or
as small) as possible, but don't signal an error."
(when (window-minibuffer-p window)
(let* ((frame (window-frame window))
(root (frame-root-window frame))
- (height (window-total-size window))
+ (height (window-pixel-height window))
(min-delta
- (- (window-total-size root)
- (window-min-size root))))
+ (- (window-pixel-height root)
+ (window-min-size root nil nil t))))
;; Sanitize DELTA.
(cond
((<= (+ height delta) 0)
- (setq delta (- (- height 1))))
+ (setq delta (- (frame-char-height (window-frame window)) height)))
((> delta min-delta)
(setq delta min-delta)))
- ;; Resize now.
- (window--resize-reset frame)
- ;; Ideally we should be able to resize just the last child of root
- ;; here. See the comment in `resize-root-window-vertically' for
- ;; why we do not do that.
- (window--resize-this-window root (- delta) nil nil t)
- (set-window-new-total window (+ height delta))
- ;; The following routine catches the case where we want to resize
- ;; a minibuffer-only frame.
- (resize-mini-window-internal window))))
-
-(defun window-resize (window delta &optional horizontal ignore)
+ (unless (zerop delta)
+ ;; Resize now.
+ (window--resize-reset frame)
+ ;; Ideally we should be able to resize just the last child of root
+ ;; here. See the comment in `resize-root-window-vertically' for
+ ;; why we do not do that.
+ (window--resize-this-window root (- delta) nil nil t)
+ (set-window-new-pixel window (+ height delta))
+ ;; The following routine catches the case where we want to resize
+ ;; a minibuffer-only frame.
+ (when (resize-mini-window-internal window)
+ (window--pixel-to-total frame)
+ (run-window-configuration-change-hook frame))))))
+
+(defun window--resize-apply-p (frame &optional horizontal)
+ "Return t when a window on FRAME shall be resized vertically.
+Optional argument HORIZONTAL non-nil means return t when a window
+shall be resized horizontally."
+(catch 'apply
+ (walk-window-tree
+ (lambda (window)
+ (unless (= (window-new-pixel window)
+ (window-size window horizontal t))
+ (throw 'apply t)))
+ frame t)
+ nil))
+
+(defun window-resize (window delta &optional horizontal ignore pixelwise)
"Resize WINDOW vertically by DELTA lines.
WINDOW can be an arbitrary window and defaults to the selected
one. An attempt to resize the root window of a frame will raise
@@ -1923,13 +2535,17 @@ horizontally by DELTA columns. In this case a positive DELTA
means enlarge WINDOW by DELTA columns. DELTA negative means
WINDOW shall be shrunk by -DELTA columns.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE is a window, ignore
-restrictions for that window only. If IGNORE equals `safe',
-live windows may get as small as `window-safe-min-height' lines
-and `window-safe-min-width' columns. Any other non-nil value
-means ignore all of the above restrictions for all windows.
+Optional argument IGNORE, if non-nil, means to ignore restraints
+induced by fixed size windows or the values of the variables
+`window-min-height' and `window-min-width'. The following values
+have special meanings: `safe' means that in addition live windows
+are allowed to get as small as `window-safe-min-height' lines and
+`window-safe-min-width' columns. `preserved' means to ignore
+only restrictions induced by `window-preserve-size'. If IGNORE
+is a window, then ignore restrictions for that window only.
+
+Optional argument PIXELWISE non-nil means resize WINDOW by DELTA
+pixels.
This function resizes other windows proportionally and never
deletes any windows. If you want to move only the low (right)
@@ -1939,6 +2555,8 @@ instead."
(let* ((frame (window-frame window))
(minibuffer-window (minibuffer-window frame))
sibling)
+ (setq delta (window--size-to-pixel
+ window delta horizontal pixelwise t))
(cond
((eq window (frame-root-window frame))
(error "Cannot resize the root window of a frame"))
@@ -1955,19 +2573,25 @@ instead."
;; nil or the minibuffer window is active, resize the minibuffer
;; window.
(window--resize-mini-window minibuffer-window (- delta)))
- ((window-resizable-p window delta horizontal ignore)
+ ((or (window--resizable-p
+ window delta horizontal ignore nil nil nil t)
+ (and (not ignore)
+ (setq ignore 'preserved)
+ (window--resizable-p
+ window delta horizontal ignore nil nil nil t)))
(window--resize-reset frame horizontal)
(window--resize-this-window window delta horizontal ignore t)
(if (and (not window-combination-resize)
(window-combined-p window horizontal)
(setq sibling (or (window-right window) (window-left window)))
- (window-sizable-p sibling (- delta) horizontal ignore))
+ (window-sizable-p
+ sibling (- delta) horizontal ignore t))
;; If window-combination-resize is nil, WINDOW is part of an
;; iso-combination, and WINDOW's neighboring right or left
;; sibling can be resized as requested, resize that sibling.
(let ((normal-delta
(/ (float delta)
- (window-total-size (window-parent window) horizontal))))
+ (window-size (window-parent window) horizontal t))))
(window--resize-this-window sibling (- delta) horizontal nil t)
(set-window-new-normal
window (+ (window-normal-size window horizontal)
@@ -1977,17 +2601,26 @@ instead."
normal-delta)))
;; Otherwise, resize all other windows in the same combination.
(window--resize-siblings window delta horizontal ignore))
- (window-resize-apply frame horizontal))
+ (when (window--resize-apply-p frame horizontal)
+ (if (window-resize-apply frame horizontal)
+ (progn
+ (window--pixel-to-total frame horizontal)
+ (run-window-configuration-change-hook frame))
+ (error "Failed to apply resizing %s" window))))
(t
(error "Cannot resize window %s" window)))))
-(defun window-resize-no-error (window delta &optional horizontal ignore)
+(defun window-resize-no-error (window delta &optional horizontal ignore pixelwise)
"Resize WINDOW vertically if it is resizable by DELTA lines.
This function is like `window-resize' but does not signal an
error when WINDOW cannot be resized. For the meaning of the
-optional arguments see the documentation of `window-resize'."
- (when (window-resizable-p window delta horizontal ignore)
- (window-resize window delta horizontal ignore)))
+optional arguments see the documentation of `window-resize'.
+
+Optional argument PIXELWISE non-nil means interpret DELTA as
+pixels."
+ (when (window--resizable-p
+ window delta horizontal ignore nil nil nil pixelwise)
+ (window-resize window delta horizontal ignore pixelwise)))
(defun window--resize-child-windows-skip-p (window)
"Return non-nil if WINDOW shall be skipped by resizing routines."
@@ -2005,7 +2638,8 @@ OTHER-DELTA, a number, specifies that this many lines (columns)
have been obtained from (or returned to) an ancestor window of
PARENT in order to resize WINDOW."
(let* ((delta-normal
- (if (and (= (- this-delta) (window-total-size window horizontal))
+ (if (and (= (- this-delta)
+ (window-size window horizontal t))
(zerop other-delta))
;; When WINDOW gets deleted and we can return its entire
;; space to its siblings, use WINDOW's normal size as the
@@ -2013,7 +2647,8 @@ PARENT in order to resize WINDOW."
(- (window-normal-size window horizontal))
;; In any other case calculate the normal delta from the
;; relation of THIS-DELTA to the total size of PARENT.
- (/ (float this-delta) (window-total-size parent horizontal))))
+ (/ (float this-delta)
+ (window-size parent horizontal t))))
(sub (window-child parent))
(parent-normal 0.0)
(skip (eq trail 'after)))
@@ -2055,8 +2690,8 @@ PARENT in order to resize WINDOW."
(when (numberp other-delta)
;; Set the new normal size of windows from what they should have
;; contributed for recovering OTHER-DELTA lines (columns).
- (setq delta-normal (/ (float (window-total-size parent horizontal))
- (+ (window-total-size parent horizontal)
+ (setq delta-normal (/ (float (window-size parent horizontal t))
+ (+ (window-size parent horizontal t)
other-delta)))
(setq sub (window-child parent))
(setq skip (eq trail 'after))
@@ -2090,24 +2725,19 @@ PARENT in order to resize WINDOW."
;; Don't get larger than 1 or smaller than 0.
(min 1.0 (max (- 1.0 sum) 0.0))))))
-(defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge)
- "Resize child windows of window PARENT vertically by DELTA lines.
+(defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge char-size)
+ "Resize child windows of window PARENT vertically by DELTA pixels.
PARENT must be a vertically combined internal window.
-Optional argument HORIZONTAL non-nil means resize child windows of
-PARENT horizontally by DELTA columns. In this case PARENT must
+Optional argument HORIZONTAL non-nil means resize child windows
+of PARENT horizontally by DELTA pixels. In this case PARENT must
be a horizontally combined internal window.
WINDOW, if specified, must denote a child window of PARENT that
-is resized by DELTA lines.
+is resized by DELTA pixels.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE equals `safe', live
-windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. If IGNORE is a window, ignore
-restrictions for that window only. Any other non-nil value means
-ignore all of the above restrictions for all windows.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'.
Optional arguments TRAIL and EDGE, when non-nil, restrict the set
of windows that shall be resized. If TRAIL equals `before',
@@ -2115,12 +2745,21 @@ resize only windows on the left or above EDGE. If TRAIL equals
`after', resize only windows on the right or below EDGE. Also,
preferably only resize windows adjacent to EDGE.
+If the optional argument CHAR-SIZE is a positive integer, it specifies
+the number of pixels by which windows are incrementally resized.
+If CHAR-SIZE is nil, this means to use the value of
+`frame-char-height' or `frame-char-width' of WINDOW's frame.
+
Return the symbol `normalized' if new normal sizes have been
already set by this routine."
(let* ((first (window-child parent))
(last (window-last-child parent))
- (parent-total (+ (window-total-size parent horizontal) delta))
- sub best-window best-value)
+ (parent-total (+ (window-size parent horizontal t)
+ delta))
+ (char-size (or char-size
+ (and window-resize-pixelwise 1)
+ (frame-char-size window horizontal)))
+ sub best-window best-value best-delta)
(if (and edge (memq trail '(before after))
(progn
@@ -2135,16 +2774,14 @@ already set by this routine."
sub)
(if horizontal
(if (eq trail 'before)
- (= (+ (window-left-column sub)
- (window-total-size sub t))
+ (= (+ (window-pixel-left sub) (window-pixel-width sub))
edge)
- (= (window-left-column sub) edge))
+ (= (window-pixel-left sub) edge))
(if (eq trail 'before)
- (= (+ (window-top-line sub)
- (window-total-size sub))
+ (= (+ (window-pixel-top sub) (window-pixel-height sub))
edge)
- (= (window-top-line sub) edge)))
- (window-sizable-p sub delta horizontal ignore))
+ (= (window-pixel-top sub) edge)))
+ (window-sizable-p sub delta horizontal ignore t))
;; Resize only windows adjacent to EDGE.
(progn
(window--resize-this-window
@@ -2153,7 +2790,7 @@ already set by this routine."
(progn
;; Assign new normal sizes.
(set-window-new-normal
- sub (/ (float (window-new-total sub)) parent-total))
+ sub (/ (float (window-new-pixel sub)) parent-total))
(set-window-new-normal
window (- (window-normal-size window horizontal)
(- (window-new-normal sub)
@@ -2171,7 +2808,7 @@ already set by this routine."
;; Ignore windows to skip and fixed-size child windows -
;; in the latter case make it a window to skip.
(and (not ignore)
- (window-size-fixed-p sub horizontal)
+ (window-size-fixed-p sub horizontal ignore)
(set-window-new-normal sub 'ignore))))
((< delta 0)
;; When shrinking store the number of lines/cols we can get
@@ -2181,15 +2818,15 @@ already set by this routine."
sub
(cons
;; We used to call this with NODOWN t, "fixed" 2011-05-11.
- (window-min-delta sub horizontal ignore trail t) ; t)
- (- (/ (float (window-total-size sub horizontal))
+ (window-min-delta sub horizontal ignore trail t nil t)
+ (- (/ (float (window-size sub horizontal t))
parent-total)
(window-normal-size sub horizontal)))))
((> delta 0)
;; When enlarging store the total/normal size factor only
(set-window-new-normal
sub
- (- (/ (float (window-total-size sub horizontal))
+ (- (/ (float (window-size sub horizontal t))
parent-total)
(window-normal-size sub horizontal)))))
@@ -2205,7 +2842,7 @@ already set by this routine."
(setq best-value most-negative-fixnum)
(while sub
(when (and (consp (window-new-normal sub))
- (not (zerop (car (window-new-normal sub))))
+ (not (<= (car (window-new-normal sub)) 0))
(> (cdr (window-new-normal sub)) best-value))
(setq best-window sub)
(setq best-value (cdr (window-new-normal sub))))
@@ -2213,16 +2850,18 @@ already set by this routine."
(setq sub (window-left sub)))
(when best-window
- (setq delta (1+ delta)))
- (set-window-new-total best-window -1 t)
- (set-window-new-normal
- best-window
- (if (= (car (window-new-normal best-window)) 1)
- 'skip ; We can't shrink best-window any further.
- (cons (1- (car (window-new-normal best-window)))
- (- (/ (float (window-new-total best-window))
- parent-total)
- (window-normal-size best-window horizontal)))))))
+ (setq best-delta (min (car (window-new-normal best-window))
+ char-size (- delta)))
+ (setq delta (+ delta best-delta))
+ (set-window-new-pixel best-window (- best-delta) t)
+ (set-window-new-normal
+ best-window
+ (if (= (car (window-new-normal best-window)) best-delta)
+ 'skip ; We can't shrink best-window any further.
+ (cons (- (car (window-new-normal best-window)) best-delta)
+ (- (/ (float (window-new-pixel best-window))
+ parent-total)
+ (window-normal-size best-window horizontal))))))))
((> delta 0)
;; Enlarge windows by delta.
(setq best-window t)
@@ -2239,13 +2878,14 @@ already set by this routine."
(setq sub (window-left sub)))
(when best-window
- (setq delta (1- delta)))
- (set-window-new-total best-window 1 t)
- (set-window-new-normal
- best-window
- (- (/ (float (window-new-total best-window))
- parent-total)
- (window-normal-size best-window horizontal))))))
+ (setq best-delta (min delta char-size))
+ (setq delta (- delta best-delta))
+ (set-window-new-pixel best-window best-delta t)
+ (set-window-new-normal
+ best-window
+ (- (/ (float (window-new-pixel best-window))
+ parent-total)
+ (window-normal-size best-window horizontal)))))))
(when best-window
(setq sub last)
@@ -2259,8 +2899,8 @@ already set by this routine."
(unless (eq (window-new-normal sub) 'ignore)
;; Resize this window's child windows (back-engineering
;; delta from sub's old and new total sizes).
- (let ((delta (- (window-new-total sub)
- (window-total-size sub horizontal))))
+ (let ((delta (- (window-new-pixel sub)
+ (window-size sub horizontal t))))
(unless (and (zerop delta) (not trail))
;; For the TRAIL non-nil case we have to resize SUB
;; recursively even if it's size does not change.
@@ -2268,19 +2908,14 @@ already set by this routine."
sub delta horizontal ignore nil trail edge))))
(setq sub (window-left sub)))))))
-(defun window--resize-siblings (window delta &optional horizontal ignore trail edge)
- "Resize other windows when WINDOW is resized vertically by DELTA lines.
+(defun window--resize-siblings (window delta &optional horizontal ignore trail edge char-size)
+ "Resize other windows when WINDOW is resized vertically by DELTA pixels.
Optional argument HORIZONTAL non-nil means resize other windows
-when WINDOW is resized horizontally by DELTA columns. WINDOW
+when WINDOW is resized horizontally by DELTA pixels. WINDOW
itself is not resized by this function.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE equals `safe', live
-windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. If IGNORE is a window, ignore
-restrictions for that window only. Any other non-nil value means
-ignore all of the above restrictions for all windows.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'.
Optional arguments TRAIL and EDGE, when non-nil, refine the set
of windows that shall be resized. If TRAIL equals `before',
@@ -2307,8 +2942,7 @@ preferably only resize windows adjacent to EDGE."
;; Make sure this sibling is left alone when
;; resizing its siblings.
(set-window-new-normal sub 'ignore))
- ((or (window--size-ignore-p sub ignore)
- (not (window-size-fixed-p sub horizontal)))
+ ((not (window-size-fixed-p sub horizontal ignore))
;; Set this-delta to t to signal that we found a sibling
;; of WINDOW whose size is not fixed.
(setq this-delta t)))
@@ -2316,7 +2950,7 @@ preferably only resize windows adjacent to EDGE."
(setq sub (window-right sub)))
;; Set this-delta to what we can get from WINDOW's siblings.
- (if (= (- delta) (window-total-size window horizontal))
+ (if (= (- delta) (window-size window horizontal t))
;; A deletion, presumably. We must handle this case
;; specially since `window--resizable' can't be used.
(if this-delta
@@ -2327,7 +2961,8 @@ preferably only resize windows adjacent to EDGE."
(setq this-delta 0))
;; Any other form of resizing.
(setq this-delta
- (window--resizable window delta horizontal ignore trail t)))
+ (window--resizable
+ window delta horizontal ignore trail t nil t)))
;; Set other-delta to what we still have to get from
;; ancestor windows of parent.
@@ -2335,7 +2970,7 @@ preferably only resize windows adjacent to EDGE."
(unless (zerop other-delta)
;; Unless we got everything from WINDOW's siblings, PARENT
;; must be resized by other-delta lines or columns.
- (set-window-new-total parent other-delta 'add))
+ (set-window-new-pixel parent other-delta 'add))
(if (zerop this-delta)
;; We haven't got anything from WINDOW's siblings but we
@@ -2346,7 +2981,7 @@ preferably only resize windows adjacent to EDGE."
;; we have to resize their child windows.
(unless (eq (window--resize-child-windows
parent (- this-delta) horizontal
- window ignore trail edge)
+ window ignore trail edge char-size)
;; If `window--resize-child-windows' returns
;; 'normalized, this means it has set the
;; normal sizes already.
@@ -2360,32 +2995,26 @@ preferably only resize windows adjacent to EDGE."
;; In an ortho-combination all siblings of WINDOW must be
;; resized by DELTA.
- (set-window-new-total parent delta 'add)
+ (set-window-new-pixel parent delta 'add)
(while sub
(unless (eq sub window)
- (window--resize-this-window sub delta horizontal ignore t))
+ (window--resize-this-window
+ sub delta horizontal ignore t))
(setq sub (window-right sub))))
(unless (zerop delta)
;; "Go up."
(window--resize-siblings
- parent delta horizontal ignore trail edge)))))
+ parent delta horizontal ignore trail edge char-size)))))
-(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge)
- "Resize WINDOW vertically by DELTA lines.
+(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge char-size)
+ "Resize WINDOW vertically by DELTA pixels.
Optional argument HORIZONTAL non-nil means resize WINDOW
-horizontally by DELTA columns.
+horizontally by DELTA pixels.
-Optional argument IGNORE non-nil means ignore restrictions
-imposed by fixed size windows, `window-min-height' or
-`window-min-width' settings. If IGNORE equals `safe', live
-windows may get as small as `window-safe-min-height' lines and
-`window-safe-min-width' columns. If IGNORE is a window, ignore
-restrictions for that window only. Any other non-nil value
-means ignore all of the above restrictions for all windows.
-
-Optional argument ADD non-nil means add DELTA to the new total
-size of WINDOW.
+The optional argument IGNORE has the same meaning as for
+`window-resizable'. Optional argument ADD non-nil means add
+DELTA to the new total size of WINDOW.
Optional arguments TRAIL and EDGE, when non-nil, refine the set
of windows that shall be resized. If TRAIL equals `before',
@@ -2393,6 +3022,11 @@ resize only windows on the left or above EDGE. If TRAIL equals
`after', resize only windows on the right or below EDGE. Also,
preferably only resize windows adjacent to EDGE.
+If the optional argument CHAR-SIZE is a positive integer, it specifies
+the number of pixels by which windows are incrementally resized.
+If CHAR-SIZE is nil, this means to use the value of
+`frame-char-height' or `frame-char-width' of WINDOW's frame.
+
This function recursively resizes WINDOW's child windows to fit the
new size. Make sure that WINDOW is `window--resizable' before
calling this function. Note that this function does not resize
@@ -2401,7 +3035,7 @@ eventually call `window-resize-apply' in order to make resizing
actually take effect."
(when add
;; Add DELTA to the new total size of WINDOW.
- (set-window-new-total window delta t))
+ (set-window-new-pixel window delta t))
(let ((sub (window-child window)))
(cond
@@ -2410,15 +3044,15 @@ actually take effect."
;; In an iso-combination resize child windows according to their
;; normal sizes.
(window--resize-child-windows
- window delta horizontal nil ignore trail edge))
+ window delta horizontal nil ignore trail edge char-size))
;; In an ortho-combination resize each child window by DELTA.
(t
(while sub
(window--resize-this-window
- sub delta horizontal ignore t trail edge)
+ sub delta horizontal ignore t trail edge char-size)
(setq sub (window-right sub)))))))
-(defun window--resize-root-window (window delta horizontal ignore)
+(defun window--resize-root-window (window delta horizontal ignore pixelwise)
"Resize root window WINDOW vertically by DELTA lines.
HORIZONTAL non-nil means resize root window WINDOW horizontally
by DELTA columns.
@@ -2428,57 +3062,96 @@ size windows, `window-min-height' or `window-min-width' settings.
This function is only called by the frame resizing routines. It
resizes windows proportionally and never deletes any windows."
- (when (and (windowp window) (numberp delta)
- (window-sizable-p window delta horizontal ignore))
- (window--resize-reset (window-frame window) horizontal)
- (window--resize-this-window window delta horizontal ignore t)))
+ (when (and (windowp window) (numberp delta))
+ (let ((pixel-delta
+ (if pixelwise
+ delta
+ (window--size-to-pixel window delta horizontal))))
+ (when (window-sizable-p window pixel-delta horizontal ignore t)
+ (window--resize-reset (window-frame window) horizontal)
+ (window--resize-this-window
+ window pixel-delta horizontal ignore t)))))
-(defun window--resize-root-window-vertically (window delta)
+(defun window--resize-root-window-vertically (window delta pixelwise)
"Resize root window WINDOW vertically by DELTA lines.
If DELTA is less than zero and we can't shrink WINDOW by DELTA
lines, shrink it as much as possible. If DELTA is greater than
zero, this function can resize fixed-size windows in order to
-recover the necessary lines.
+recover the necessary lines. Return the number of lines that
+were recovered.
-Return the number of lines that were recovered.
+Third argument PIXELWISE non-nil means to interpret DELTA as
+pixels and return the number of pixels that were recovered.
-This function is only called by the minibuffer window resizing
-routines. It resizes windows proportionally and never deletes
-any windows."
- (let ((frame (window-frame window))
- ignore)
+This function is called by the minibuffer window resizing
+routines."
+ (let* ((frame (window-frame window))
+ (pixel-delta
+ (cond
+ (pixelwise
+ delta)
+ ((numberp delta)
+ (* (frame-char-height frame) delta))
+ (t 0)))
+ ignore)
(cond
- ((not (numberp delta))
- (setq delta 0))
- ((zerop delta))
- ((< delta 0)
- (setq delta (window-sizable window delta))
+ ((zerop pixel-delta))
+ ((< pixel-delta 0)
+ (setq pixel-delta (window-sizable window pixel-delta nil nil pixelwise))
(window--resize-reset frame)
;; When shrinking the root window, emulate an edge drag in order
;; to not resize other windows if we can avoid it (Bug#12419).
(window--resize-this-window
- window delta nil ignore t 'before
- (+ (window-top-line window) (window-total-size window)))
+ window pixel-delta nil ignore t 'before
+ (+ (window-pixel-top window) (window-pixel-height window)))
;; Don't record new normal sizes to make sure that shrinking back
;; proportionally works as intended.
(walk-window-tree
(lambda (window) (set-window-new-normal window 'ignore)) frame t))
- ((> delta 0)
+ ((> pixel-delta 0)
(window--resize-reset frame)
- (unless (window-sizable window delta)
+ (unless (window-sizable window pixel-delta nil nil pixelwise)
(setq ignore t))
;; When growing the root window, resize proportionally. This
;; should give windows back their original sizes (hopefully).
- (window--resize-this-window window delta nil ignore t)))
+ (window--resize-this-window
+ window pixel-delta nil ignore t)))
;; Return the possibly adjusted DELTA.
- delta))
-
-(defun adjust-window-trailing-edge (window delta &optional horizontal)
+ (if pixelwise
+ pixel-delta
+ (/ pixel-delta (frame-char-height frame)))))
+
+(defun window--sanitize-window-sizes (frame horizontal)
+ "Assert that all windows on FRAME are large enough.
+If necessary and possible, make sure that every window on frame
+FRAME has its minimum height. Optional argument HORIZONTAL
+non-nil means to make sure that every window on frame FRAME has
+its minimum width. The minimum height/width of a window is the
+respective value returned by `window-min-size' for that window.
+
+Return t if all windows were resized appropriately. Return nil
+if at least one window could not be resized as requested, which
+may happen when the FRAME is not large enough to accommodate it."
+ (let ((value t))
+ (walk-window-tree
+ (lambda (window)
+ (let ((delta (- (window-min-size window horizontal nil t)
+ (window-size window horizontal t))))
+ (when (> delta 0)
+ (if (window-resizable-p window delta horizontal nil t)
+ (window-resize window delta horizontal nil t)
+ (setq value nil))))))
+ value))
+
+(defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise)
"Move WINDOW's bottom edge by DELTA lines.
Optional argument HORIZONTAL non-nil means move WINDOW's right
edge by DELTA columns. WINDOW must be a valid window and
defaults to the selected one.
+Optional argument PIXELWISE non-nil means interpret DELTA as
+number of pixels.
+
If DELTA is greater than zero, move the edge downwards or to the
right. If DELTA is less than zero, move the edge upwards or to
the left. If the edge can't be moved by DELTA lines or columns,
@@ -2487,7 +3160,12 @@ move it as far as possible in the desired direction."
(let* ((frame (window-frame window))
(minibuffer-window (minibuffer-window frame))
(right window)
- left this-delta min-delta max-delta)
+ left first-left first-right this-delta min-delta max-delta ignore)
+
+ (unless pixelwise
+ (setq pixelwise t)
+ (setq delta (* delta (frame-char-size window horizontal))))
+
;; Find the edge we want to move.
(while (and (or (not (window-combined-p right horizontal))
(not (window-right right)))
@@ -2498,19 +3176,24 @@ move it as far as possible in the desired direction."
;; and immediately below WINDOW and it's either active or
;; `resize-mini-windows' is nil.
(eq (window-frame minibuffer-window) frame)
- (= (nth 1 (window-edges minibuffer-window))
- (nth 3 (window-edges window)))
+ (= (nth 1 (window-pixel-edges minibuffer-window))
+ (nth 3 (window-pixel-edges window)))
(or (not resize-mini-windows)
(eq minibuffer-window (active-minibuffer-window))))
(window--resize-mini-window minibuffer-window (- delta)))
((or (not (setq left right)) (not (setq right (window-right right))))
(if horizontal
- (error "No window on the right of this one")
- (error "No window below this one")))
+ (user-error "No window on the right of this one")
+ (user-error "No window below this one")))
(t
;; Set LEFT to the first resizable window on the left. This step is
;; needed to handle fixed-size windows.
- (while (and left (window-size-fixed-p left horizontal))
+ (setq first-left left)
+ (while (and left
+ (or (window-size-fixed-p left horizontal)
+ (and (< delta 0)
+ (<= (window-size left horizontal t)
+ (window-min-size left horizontal nil t)))))
(setq left
(or (window-left left)
(progn
@@ -2518,13 +3201,34 @@ move it as far as possible in the desired direction."
(not (window-combined-p left horizontal))))
(window-left left)))))
(unless left
- (if horizontal
- (error "No resizable window on the left of this one")
- (error "No resizable window above this one")))
+ ;; We have to resize a size-preserved window. Start again with
+ ;; the window initially on the left.
+ (setq ignore 'preserved)
+ (setq left first-left)
+ (while (and left
+ (or (window-size-fixed-p left horizontal 'preserved)
+ (<= (window-size left horizontal t)
+ (window-min-size left horizontal 'preserved t))))
+ (setq left
+ (or (window-left left)
+ (progn
+ (while (and (setq left (window-parent left))
+ (not (window-combined-p left horizontal))))
+ (window-left left)))))
+
+ (unless left
+ (if horizontal
+ (user-error "No resizable window on the left of this one")
+ (user-error "No resizable window above this one"))))
;; Set RIGHT to the first resizable window on the right. This step
;; is needed to handle fixed-size windows.
- (while (and right (window-size-fixed-p right horizontal))
+ (setq first-right right)
+ (while (and right
+ (or (window-size-fixed-p right horizontal)
+ (and (> delta 0)
+ (<= (window-size right horizontal t)
+ (window-min-size right horizontal 'preserved t)))))
(setq right
(or (window-right right)
(progn
@@ -2532,16 +3236,35 @@ move it as far as possible in the desired direction."
(not (window-combined-p right horizontal))))
(window-right right)))))
(unless right
- (if horizontal
- (error "No resizable window on the right of this one")
- (error "No resizable window below this one")))
+ ;; We have to resize a size-preserved window. Start again with
+ ;; the window initially on the right.
+ (setq ignore 'preserved)
+ (setq right first-right)
+ (while (and right
+ (or (window-size-fixed-p right horizontal 'preserved))
+ (<= (window-size right horizontal t)
+ (window-min-size right horizontal 'preserved t)))
+ (setq right
+ (or (window-right right)
+ (progn
+ (while (and (setq right (window-parent right))
+ (not (window-combined-p right horizontal))))
+ (window-right right)))))
+ (unless right
+ (if horizontal
+ (user-error "No resizable window on the right of this one")
+ (user-error "No resizable window below this one"))))
;; LEFT and RIGHT (which might be both internal windows) are now the
;; two windows we want to resize.
(cond
((> delta 0)
- (setq max-delta (window--max-delta-1 left 0 horizontal nil 'after))
- (setq min-delta (window--min-delta-1 right (- delta) horizontal nil 'before))
+ (setq max-delta
+ (window--max-delta-1
+ left 0 horizontal ignore 'after nil pixelwise))
+ (setq min-delta
+ (window--min-delta-1
+ right (- delta) horizontal ignore 'before nil pixelwise))
(when (or (< max-delta delta) (> min-delta (- delta)))
;; We can't get the whole DELTA - move as far as possible.
(setq delta (min max-delta (- min-delta))))
@@ -2549,22 +3272,27 @@ move it as far as possible in the desired direction."
;; Start resizing.
(window--resize-reset frame horizontal)
;; Try to enlarge LEFT first.
- (setq this-delta (window--resizable left delta horizontal))
+ (setq this-delta (window--resizable
+ left delta horizontal ignore 'after nil nil pixelwise))
(unless (zerop this-delta)
(window--resize-this-window
- left this-delta horizontal nil t 'before
+ left this-delta horizontal ignore t 'before
(if horizontal
- (+ (window-left-column left) (window-total-size left t))
- (+ (window-top-line left) (window-total-size left)))))
+ (+ (window-pixel-left left) (window-pixel-width left))
+ (+ (window-pixel-top left) (window-pixel-height left)))))
;; Shrink windows on right of LEFT.
(window--resize-siblings
- left delta horizontal nil 'after
+ left delta horizontal ignore 'after
(if horizontal
- (window-left-column right)
- (window-top-line right)))))
+ (window-pixel-left right)
+ (window-pixel-top right)))))
((< delta 0)
- (setq max-delta (window--max-delta-1 right 0 horizontal nil 'before))
- (setq min-delta (window--min-delta-1 left delta horizontal nil 'after))
+ (setq max-delta
+ (window--max-delta-1
+ right 0 horizontal ignore 'before nil pixelwise))
+ (setq min-delta
+ (window--min-delta-1
+ left delta horizontal ignore 'after nil pixelwise))
(when (or (< max-delta (- delta)) (> min-delta delta))
;; We can't get the whole DELTA - move as far as possible.
(setq delta (max (- max-delta) min-delta)))
@@ -2572,24 +3300,30 @@ move it as far as possible in the desired direction."
;; Start resizing.
(window--resize-reset frame horizontal)
;; Try to enlarge RIGHT.
- (setq this-delta (window--resizable right (- delta) horizontal))
+ (setq this-delta
+ (window--resizable
+ right (- delta) horizontal ignore 'before nil nil pixelwise))
(unless (zerop this-delta)
(window--resize-this-window
- right this-delta horizontal nil t 'after
+ right this-delta horizontal ignore t 'after
(if horizontal
- (window-left-column right)
- (window-top-line right))))
+ (window-pixel-left right)
+ (window-pixel-top right))))
;; Shrink windows on left of RIGHT.
(window--resize-siblings
- right (- delta) horizontal nil 'before
+ right (- delta) horizontal ignore 'before
(if horizontal
- (+ (window-left-column left) (window-total-size left t))
- (+ (window-top-line left) (window-total-size left)))))))
+ (+ (window-pixel-left left) (window-pixel-width left))
+ (+ (window-pixel-top left) (window-pixel-height left)))))))
(unless (zerop delta)
;; Don't report an error in the standard case.
- (unless (window-resize-apply frame horizontal)
- ;; But do report an error if applying the changes fails.
- (error "Failed adjusting window %s" window)))))))
+ (when (window--resize-apply-p frame horizontal)
+ (if (window-resize-apply frame horizontal)
+ (progn
+ (window--pixel-to-total frame horizontal)
+ (run-window-configuration-change-hook frame))
+ ;; But do report an error if applying the changes fails.
+ (error "Failed adjusting window %s" window))))))))
(defun enlarge-window (delta &optional horizontal)
"Make the selected window DELTA lines taller.
@@ -2599,6 +3333,8 @@ make selected window wider by DELTA columns. If DELTA is
negative, shrink selected window by -DELTA lines or columns."
(interactive "p")
(let ((minibuffer-window (minibuffer-window)))
+ (when (window-preserved-size nil horizontal)
+ (window-preserve-size nil horizontal))
(cond
((zerop delta))
((window-size-fixed-p nil horizontal)
@@ -2614,7 +3350,7 @@ negative, shrink selected window by -DELTA lines or columns."
;; If the selected window is full height and `resize-mini-windows'
;; is nil, resize the minibuffer window.
(window--resize-mini-window minibuffer-window (- delta)))
- ((window-resizable-p nil delta horizontal)
+ ((window--resizable-p nil delta horizontal)
(window-resize nil delta horizontal))
(t
(window-resize
@@ -2632,6 +3368,8 @@ negative, enlarge selected window by -DELTA lines or columns.
Also see the `window-min-height' variable."
(interactive "p")
(let ((minibuffer-window (minibuffer-window)))
+ (when (window-preserved-size nil horizontal)
+ (window-preserve-size nil horizontal))
(cond
((zerop delta))
((window-size-fixed-p nil horizontal)
@@ -2647,7 +3385,7 @@ Also see the `window-min-height' variable."
;; If the selected window is full height and `resize-mini-windows'
;; is nil, resize the minibuffer window.
(window--resize-mini-window minibuffer-window delta))
- ((window-resizable-p nil (- delta) horizontal)
+ ((window--resizable-p nil (- delta) horizontal)
(window-resize nil (- delta) horizontal))
(t
(window-resize
@@ -2659,20 +3397,164 @@ Also see the `window-min-height' variable."
(defun maximize-window (&optional window)
"Maximize WINDOW.
Make WINDOW as large as possible without deleting any windows.
-WINDOW must be a valid window and defaults to the selected one."
+WINDOW must be a valid window and defaults to the selected one.
+
+If the option `window-resize-pixelwise' is non-nil maximize
+WINDOW pixelwise."
(interactive)
(setq window (window-normalize-window window))
- (window-resize window (window-max-delta window))
- (window-resize window (window-max-delta window t) t))
+ (window-resize
+ window (window-max-delta window nil nil nil nil nil window-resize-pixelwise)
+ nil nil window-resize-pixelwise)
+ (window-resize
+ window (window-max-delta window t nil nil nil nil window-resize-pixelwise)
+ t nil window-resize-pixelwise))
(defun minimize-window (&optional window)
"Minimize WINDOW.
Make WINDOW as small as possible without deleting any windows.
-WINDOW must be a valid window and defaults to the selected one."
+WINDOW must be a valid window and defaults to the selected one.
+
+If the option `window-resize-pixelwise' is non-nil minimize
+WINDOW pixelwise."
(interactive)
(setq window (window-normalize-window window))
- (window-resize window (- (window-min-delta window)))
- (window-resize window (- (window-min-delta window t)) t))
+ (window-resize
+ window
+ (- (window-min-delta window nil nil nil nil nil window-resize-pixelwise))
+ nil nil window-resize-pixelwise)
+ (window-resize
+ window
+ (- (window-min-delta window t nil nil nil nil window-resize-pixelwise))
+ t nil window-resize-pixelwise))
+
+;;; Window edges
+(defun window-edges (&optional window body absolute pixelwise)
+ "Return a list of the edge distances of WINDOW.
+WINDOW must be a valid window and defaults to the selected one.
+The list returned has the form (LEFT TOP RIGHT BOTTOM).
+
+If the optional argument BODY is nil, this means to return the
+edges corresponding to the total size of WINDOW. BODY non-nil
+means to return the edges of WINDOW's body (aka text area). If
+BODY is non-nil, WINDOW must specify a live window.
+
+Optional argument ABSOLUTE nil means to return edges relative to
+the position of WINDOW's native frame. ABSOLUTE non-nil means to
+return coordinates relative to the origin - the position (0, 0) -
+of FRAME's display. On non-graphical systems this argument has
+no effect.
+
+Optional argument PIXELWISE nil means to return the coordinates
+in terms of the canonical character width and height of WINDOW's
+frame, rounded if necessary. PIXELWISE non-nil means to return
+the coordinates in pixels where the values for RIGHT and BOTTOM
+are one more than the actual value of these edges. Note that if
+ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
+ (let* ((window (window-normalize-window window body))
+ (frame (window-frame window))
+ (border-width (frame-border-width frame))
+ (char-width (frame-char-width frame))
+ (char-height (frame-char-height frame))
+ (left (if pixelwise
+ (+ (window-pixel-left window) border-width)
+ (+ (window-left-column window)
+ (/ border-width char-width))))
+ (left-body
+ (when body
+ (+ (window-pixel-left window) border-width
+ (if (eq (car (window-current-scroll-bars window)) 'left)
+ (window-scroll-bar-width window)
+ 0)
+ (nth 0 (window-fringes window))
+ (* (or (nth 0 (window-margins window)) 0) char-width))))
+ (top (if pixelwise
+ (+ (window-pixel-top window) border-width)
+ (+ (window-top-line window)
+ (/ border-width char-height))))
+ (top-body
+ (when body
+ (+ (window-pixel-top window) border-width
+ (window-header-line-height window))))
+ (right (+ left (if pixelwise
+ (window-pixel-width window)
+ (window-total-width window))))
+ (right-body (and body (+ left-body (window-body-width window t))))
+ (bottom (+ top (if pixelwise
+ (window-pixel-height window)
+ (window-total-height window))))
+ (bottom-body (and body (+ top-body (window-body-height window t))))
+ left-off right-off)
+ (if absolute
+ (let* ((native-edges (frame-edges frame 'native-edges))
+ (left-off (nth 0 native-edges))
+ (top-off (nth 1 native-edges)))
+ (if body
+ (list (+ left-body left-off) (+ top-body top-off)
+ (+ right-body left-off) (+ bottom-body top-off))
+ (list (+ left left-off) (+ top top-off)
+ (+ right left-off) (+ bottom top-off))))
+ (if body
+ (if pixelwise
+ (list left-body top-body right-body bottom-body)
+ (list (/ left-body char-width) (/ top-body char-height)
+ ;; Round up.
+ (/ (+ right-body char-width -1) char-width)
+ (/ (+ bottom-body char-height -1) char-height)))
+ (list left top right bottom)))))
+
+(defun window-body-edges (&optional window)
+ "Return a list of the edge coordinates of WINDOW's body.
+The return value is that of `window-edges' called with argument
+BODY non-nil."
+ (window-edges window t))
+(defalias 'window-inside-edges 'window-body-edges)
+
+(defun window-pixel-edges (&optional window)
+ "Return a list of the edge pixel coordinates of WINDOW.
+The return value is that of `window-edges' called with argument
+PIXELWISE non-nil."
+ (window-edges window nil nil t))
+
+(defun window-body-pixel-edges (&optional window)
+ "Return a list of the edge pixel coordinates of WINDOW's body.
+The return value is that of `window-edges' called with arguments
+BODY and PIXELWISE non-nil."
+ (window-edges window t nil t))
+(defalias 'window-inside-pixel-edges 'window-body-pixel-edges)
+
+(defun window-absolute-pixel-edges (&optional window)
+ "Return a list of the edge pixel coordinates of WINDOW.
+The return value is that of `window-edges' called with argument
+ABSOLUTE non-nil."
+ (window-edges window nil t t))
+
+(defun window-absolute-body-pixel-edges (&optional window)
+ "Return a list of the edge pixel coordinates of WINDOW's text area.
+The return value is that of `window-edges' called with arguments
+BODY and ABSOLUTE non-nil."
+ (window-edges window t t t))
+(defalias 'window-inside-absolute-pixel-edges 'window-absolute-body-pixel-edges)
+
+(defun window-absolute-pixel-position (&optional position window)
+ "Return display coordinates of POSITION in WINDOW.
+If the buffer position POSITION is visible in window WINDOW,
+return the display coordinates of the upper/left corner of the
+glyph at POSITION. The return value is a cons of the X- and
+Y-coordinates of that corner, relative to an origin at (0, 0) of
+WINDOW's display. Return nil if POSITION is not visible in
+WINDOW.
+
+WINDOW must be a live window and defaults to the selected window.
+POSITION defaults to the value of `window-point' of WINDOW."
+ (let* ((window (window-normalize-window window t))
+ (pos-in-window
+ (pos-visible-in-window-p
+ (or position (window-point window)) window t)))
+ (when pos-in-window
+ (let ((edges (window-absolute-body-pixel-edges window)))
+ (cons (+ (nth 0 edges) (nth 0 pos-in-window))
+ (+ (nth 1 edges) (nth 1 pos-in-window)))))))
(defun frame-root-window-p (window)
"Return non-nil if WINDOW is the root window of its frame."
@@ -2829,7 +3711,7 @@ Return 'frame if deleting WINDOW should also delete its frame."
(setq window (window-normalize-window window))
(unless (or ignore-window-parameters
- (eq (window-parameter window 'delete-window) t))
+ (eq (window-parameter window 'delete-window) t))
;; Handle atomicity.
(when (window-parameter window 'window-atom)
(setq window (window-atom-root window))))
@@ -2915,7 +3797,7 @@ that is its frame's root window."
(error "Attempt to delete last non-side window")))
(let* ((horizontal (window-left-child parent))
- (size (window-total-size window horizontal))
+ (size (window-size window horizontal t))
(frame-selected
(window--in-subtree-p (frame-selected-window frame) window))
;; Emacs 23 preferably gives WINDOW's space to its left
@@ -2924,13 +3806,13 @@ that is its frame's root window."
(window--resize-reset frame horizontal)
(cond
((and (not window-combination-resize)
- sibling (window-sizable-p sibling size))
+ sibling (window-sizable-p sibling size horizontal nil t))
;; Resize WINDOW's sibling.
(window--resize-this-window sibling size horizontal nil t)
(set-window-new-normal
sibling (+ (window-normal-size sibling horizontal)
(window-normal-size window horizontal))))
- ((window-resizable-p window (- size) horizontal nil nil nil t)
+ ((window--resizable-p window (- size) horizontal nil nil nil t t)
;; Can do without resizing fixed-size windows.
(window--resize-siblings window (- size) horizontal))
(t
@@ -2938,6 +3820,7 @@ that is its frame's root window."
(window--resize-siblings window (- size) horizontal t)))
;; Actually delete WINDOW.
(delete-window-internal window)
+ (window--pixel-to-total frame horizontal)
(when (and frame-selected
(window-parameter
(frame-selected-window frame) 'no-other-window))
@@ -3125,12 +4008,10 @@ before was current this also makes BUFFER the current buffer."
(defcustom switch-to-visible-buffer t
"If non-nil, allow switching to an already visible buffer.
If this variable is non-nil, `switch-to-prev-buffer' and
-`switch-to-next-buffer' may switch to an already visible buffer
-provided the buffer was shown before in the window specified as
-argument to those functions. If this variable is nil,
-`switch-to-prev-buffer' and `switch-to-next-buffer' always try to
-avoid switching to a buffer that is already visible in another
-window on the same frame."
+`switch-to-next-buffer' may switch to an already visible buffer.
+If this variable is nil, `switch-to-prev-buffer' and
+`switch-to-next-buffer' always try to avoid switching to a buffer
+that is already visible in another window on the same frame."
:type 'boolean
:version "24.1"
:group 'windows)
@@ -3201,7 +4082,8 @@ to it."
(or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(or bury-or-kill (not (memq buffer next-buffers))))
- (if (get-buffer-window buffer frame)
+ (if (and (not switch-to-visible-buffer)
+ (get-buffer-window buffer frame))
;; Try to avoid showing a buffer visible in some other window.
(unless visible
(setq visible buffer))
@@ -3303,7 +4185,8 @@ found."
(or (null pred) (funcall pred buffer))
(not (eq (aref (buffer-name buffer) 0) ?\s))
(not (assq buffer (window-prev-buffers window))))
- (if (get-buffer-window buffer frame)
+ (if (and (not switch-to-visible-buffer)
+ (get-buffer-window buffer frame))
;; Try to avoid showing a buffer visible in some other window.
(setq visible buffer)
(setq new-buffer buffer)
@@ -3562,7 +4445,7 @@ one. If non-nil, reset `quit-restore' parameter to nil.
Optional second argument BURY-OR-KILL tells how to proceed with
the buffer of WINDOW. The following values are handled:
-`nil' means to not handle the buffer in a particular way. This
+nil means to not handle the buffer in a particular way. This
means that if WINDOW is not deleted by this function, invoking
`switch-to-prev-buffer' will usually show the buffer again.
@@ -3609,11 +4492,18 @@ the buffer of WINDOW. The following values are handled:
(eq (nth 3 quit-restore) buffer))
;; Show another buffer stored in quit-restore parameter.
(when (and (integerp (nth 3 quad))
- (/= (nth 3 quad) (window-total-size window)))
+ (if (window-combined-p window)
+ (/= (nth 3 quad) (window-total-height window))
+ (/= (nth 3 quad) (window-total-width window))))
;; Try to resize WINDOW to its old height but don't signal an
;; error.
(condition-case nil
- (window-resize window (- (nth 3 quad) (window-total-size window)))
+ (window-resize
+ window
+ (- (nth 3 quad) (if (window-combined-p window)
+ (window-total-height window)
+ (window-total-width window)))
+ (window-combined-p window t))
(error nil)))
(set-window-dedicated-p window nil)
;; Restore WINDOW's previous buffer, start and point position.
@@ -3690,15 +4580,7 @@ showing BUFFER-OR-NAME."
;; If a window doesn't show BUFFER, unrecord BUFFER in it.
(unrecord-window-buffer window buffer)))))
-;;; Splitting windows.
-(defun window-split-min-size (&optional horizontal)
- "Return minimum height of any window when splitting windows.
-Optional argument HORIZONTAL non-nil means return minimum width."
- (if horizontal
- (max window-min-width window-safe-min-width)
- (max window-min-height window-safe-min-height)))
-
-(defun split-window (&optional window size side)
+(defun split-window (&optional window size side pixelwise)
"Make a new window adjacent to WINDOW.
WINDOW must be a valid window and defaults to the selected one.
Return the new window which is always a live window.
@@ -3726,6 +4608,8 @@ window provided SIZE is negative) including space reserved for
fringes and the scrollbar or a divider column. Any other non-nil
value for SIDE is currently handled like t (or `right').
+PIXELWISE, if non-nil, means to interpret SIZE pixelwise.
+
If the variable `ignore-window-parameters' is non-nil or the
`split-window' parameter of WINDOW equals t, do not process any
parameters of WINDOW. Otherwise, if the `split-window' parameter
@@ -3755,8 +4639,14 @@ frame. The selected window is not changed by this function."
;; have to override their value.
(window-combination-limit window-combination-limit)
(window-combination-resize window-combination-resize)
- atom-root)
-
+ (char-size (frame-char-size window horizontal))
+ (pixel-size
+ (when (numberp size)
+ (window--size-to-pixel window size horizontal pixelwise t)))
+ (divider-width (if horizontal
+ (frame-right-divider-width frame)
+ (frame-bottom-divider-width frame)))
+ atom-root ignore)
(window--check frame)
(catch 'done
(cond
@@ -3772,17 +4662,12 @@ frame. The selected window is not changed by this function."
((and (window-parameter window 'window-atom)
(setq atom-root (window-atom-root window))
(not (eq atom-root window)))
- (throw 'done (split-window atom-root size side)))
+ (throw 'done (split-window atom-root size side pixelwise)))
;; If WINDOW is a side window or its first or last child is a
;; side window, throw an error unless `window-combination-resize'
;; equals 'side.
((and (not (eq window-combination-resize 'side))
- (or (window-parameter window 'window-side)
- (and (window-child window)
- (or (window-parameter
- (window-child window) 'window-side)
- (window-parameter
- (window-last-child window) 'window-side)))))
+ (window--side-window-p window))
(error "Cannot split side window or parent of side window"))
;; If `window-combination-resize' is 'side and window has a side
;; window sibling, bind `window-combination-limit' to t.
@@ -3797,13 +4682,14 @@ frame. The selected window is not changed by this function."
;; If `window-combination-resize' is t and SIZE is non-negative,
;; bind `window-combination-limit' to t.
- (when (and (eq window-combination-resize t) size (> size 0))
+ (when (and (eq window-combination-resize t)
+ pixel-size (> pixel-size 0))
(setq window-combination-limit t))
- (let* ((parent-size
- ;; `parent-size' is the size of WINDOW's parent, provided
- ;; it has one.
- (when parent (window-total-size parent horizontal)))
+ (let* ((parent-pixel-size
+ ;; `parent-pixel-size' is the pixel size of WINDOW's
+ ;; parent, provided it has one.
+ (when parent (window-size parent horizontal t)))
;; `resize' non-nil means we are supposed to resize other
;; windows in WINDOW's combination.
(resize
@@ -3813,76 +4699,90 @@ frame. The selected window is not changed by this function."
(not (eq window-combination-limit t))
;; Resize makes sense in iso-combinations only.
(window-combined-p window horizontal)))
- ;; `old-size' is the current size of WINDOW.
- (old-size (window-total-size window horizontal))
+ ;; `old-pixel-size' is the current pixel size of WINDOW.
+ (old-pixel-size (window-size window horizontal t))
;; `new-size' is the specified or calculated size of the
;; new window.
- (new-size
- (cond
- ((not size)
- (max (window-split-min-size horizontal)
- (if resize
- ;; When resizing try to give the new window the
- ;; average size of a window in its combination.
- (min (- parent-size
- (window-min-size parent horizontal))
- (/ parent-size
- (1+ (window-combinations
- parent horizontal))))
- ;; Else try to give the new window half the size
- ;; of WINDOW (plus an eventual odd line).
- (+ (/ old-size 2) (% old-size 2)))))
- ((>= size 0)
- ;; SIZE non-negative specifies the new size of WINDOW.
-
- ;; Note: Specifying a non-negative SIZE is practically
- ;; always done as workaround for making the new window
- ;; appear above or on the left of the new window (the
- ;; ispell window is a typical example of that). In all
- ;; these cases the SIDE argument should be set to 'above
- ;; or 'left in order to support the 'resize option.
- ;; Here we have to nest the windows instead, see above.
- (- old-size size))
- (t
- ;; SIZE negative specifies the size of the new window.
- (- size))))
- new-parent new-normal)
+ new-pixel-size new-parent new-normal)
+ (cond
+ ((not pixel-size)
+ (setq new-pixel-size
+ (if resize
+ ;; When resizing try to give the new window the
+ ;; average size of a window in its combination.
+ (max (min (- parent-pixel-size
+ (window-min-size parent horizontal nil t))
+ (/ parent-pixel-size
+ (1+ (window-combinations parent horizontal))))
+ (window-min-pixel-size))
+ ;; Else try to give the new window half the size
+ ;; of WINDOW (plus an eventual odd pixel).
+ (/ old-pixel-size 2)))
+ (unless window-resize-pixelwise
+ ;; Round to nearest char-size multiple.
+ (setq new-pixel-size
+ (* char-size (round new-pixel-size char-size)))))
+ ((>= pixel-size 0)
+ ;; SIZE non-negative specifies the new size of WINDOW.
+
+ ;; Note: Specifying a non-negative SIZE is practically
+ ;; always done as workaround for making the new window
+ ;; appear above or on the left of the new window (the
+ ;; ispell window is a typical example of that). In all
+ ;; these cases the SIDE argument should be set to 'above
+ ;; or 'left in order to support the 'resize option.
+ ;; Here we have to nest the windows instead, see above.
+ (setq new-pixel-size (- old-pixel-size pixel-size)))
+ (t
+ ;; SIZE negative specifies the size of the new window.
+ (setq new-pixel-size (- pixel-size))))
;; Check SIZE.
(cond
- ((not size)
+ ((not pixel-size)
(cond
(resize
;; SIZE unspecified, resizing.
- (when (and (not (window-sizable-p parent (- new-size) horizontal))
- ;; Try again with minimum split size.
- (setq new-size
- (max new-size (window-split-min-size horizontal)))
- (not (window-sizable-p parent (- new-size) horizontal)))
- (error "Window %s too small for splitting" parent)))
- ((> (+ new-size (window-min-size window horizontal)) old-size)
+ (unless (or (window-sizable-p
+ parent (- (+ new-pixel-size divider-width)) horizontal
+ nil t)
+ (window-sizable-p
+ parent (- (+ new-pixel-size divider-width)) horizontal
+ (setq ignore 'preserved) t))
+ (error "Window %s too small for splitting (1)" parent)))
+ ((and (> (+ new-pixel-size divider-width
+ (window-min-size window horizontal nil t))
+ old-pixel-size)
+ (> (+ new-pixel-size divider-width
+ (window-min-size
+ window horizontal (setq ignore 'preserved) t))
+ old-pixel-size))
;; SIZE unspecified, no resizing.
- (error "Window %s too small for splitting" window))))
- ((and (>= size 0)
- (or (>= size old-size)
- (< new-size (if horizontal
- window-safe-min-width
- window-safe-min-width))))
+ (error "Window %s too small for splitting (2)" window))))
+ ((and (>= pixel-size 0)
+ (or (>= pixel-size old-pixel-size)
+ (< new-pixel-size
+ (window-safe-min-pixel-size window horizontal))))
;; SIZE specified as new size of old window. If the new size
;; is larger than the old size or the size of the new window
;; would be less than the safe minimum, signal an error.
- (error "Window %s too small for splitting" window))
+ (error "Window %s too small for splitting (3)" window))
(resize
;; SIZE specified, resizing.
- (unless (window-sizable-p parent (- new-size) horizontal)
+ (unless (or (window-sizable-p
+ parent (- (+ new-pixel-size divider-width)) horizontal
+ nil t)
+ (window-sizable-p
+ parent (- (+ new-pixel-size divider-width)) horizontal
+ (setq ignore 'preserved) t))
;; If we cannot resize the parent give up.
- (error "Window %s too small for splitting" parent)))
- ((or (< new-size
- (if horizontal window-safe-min-width window-safe-min-height))
- (< (- old-size new-size)
- (if horizontal window-safe-min-width window-safe-min-height)))
+ (error "Window %s too small for splitting (4)" parent)))
+ ((or (< new-pixel-size
+ (window-safe-min-pixel-size window horizontal))
+ (< (- old-pixel-size new-pixel-size)
+ (window-safe-min-pixel-size window horizontal)))
;; SIZE specification violates minimum size restrictions.
- (error "Window %s too small for splitting" window)))
+ (error "Window %s too small for splitting (5)" window)))
(window--resize-reset frame horizontal)
@@ -3895,7 +4795,8 @@ frame. The selected window is not changed by this function."
(setq new-normal
;; Make new-normal the normal size of the new window.
(cond
- (size (/ (float new-size) (if new-parent old-size parent-size)))
+ (pixel-size (/ (float new-pixel-size)
+ (if new-parent old-pixel-size parent-pixel-size)))
(new-parent 0.5)
(resize (/ 1.0 (1+ (window-combinations parent horizontal))))
(t (/ (window-normal-size window horizontal) 2.0))))
@@ -3906,7 +4807,8 @@ frame. The selected window is not changed by this function."
;; we won't be able to return space to those windows when we
;; delete the one we create here. Hence we do not go up.
(progn
- (window--resize-child-windows parent (- new-size) horizontal)
+ (window--resize-child-windows
+ parent (- new-pixel-size) horizontal nil ignore)
(let* ((normal (- 1.0 new-normal))
(sub (window-child parent)))
(while sub
@@ -3914,13 +4816,16 @@ frame. The selected window is not changed by this function."
sub (* (window-normal-size sub horizontal) normal))
(setq sub (window-right sub)))))
;; Get entire space from WINDOW.
- (set-window-new-total window (- old-size new-size))
- (window--resize-this-window window (- new-size) horizontal)
+ (set-window-new-pixel
+ window (- old-pixel-size new-pixel-size))
+ (window--resize-this-window
+ window (- new-pixel-size) horizontal ignore)
(set-window-new-normal
window (- (if new-parent 1.0 (window-normal-size window horizontal))
new-normal)))
- (let* ((new (split-window-internal window new-size side new-normal)))
+ (let* ((new (split-window-internal window new-pixel-size side new-normal)))
+ (window--pixel-to-total frame horizontal)
;; Assign window-side parameters, if any.
(cond
((eq window-combination-resize 'side)
@@ -3946,7 +4851,11 @@ frame. The selected window is not changed by this function."
(set-window-parameter (window-parent new) 'window-atom t))
(set-window-parameter new 'window-atom t)))
+ ;; Sanitize sizes.
+ (window--sanitize-window-sizes frame horizontal)
+
(run-window-configuration-change-hook frame)
+ (run-window-scroll-functions new)
(window--check frame)
;; Always return the new window.
new)))))
@@ -3964,7 +4873,7 @@ the original point in both windows."
(defun split-window-below (&optional size)
"Split the selected window into two windows, one above the other.
The selected window is above. The newly split-off window is
-below, and displays the same buffer. Return the new window.
+below and displays the same buffer. Return the new window.
If optional argument SIZE is omitted or nil, both windows get the
same height, or close to it. If SIZE is positive, the upper
@@ -4018,7 +4927,7 @@ amount of redisplay; this is convenient on slow terminals."
(defun split-window-right (&optional size)
"Split the selected window into two side-by-side windows.
The selected window is on the left. The newly split-off window
-is on the right, and displays the same buffer. Return the new
+is on the right and displays the same buffer. Return the new
window.
If optional argument SIZE is omitted or nil, both windows get the
@@ -4057,17 +4966,20 @@ right, if any."
"Subroutine of `balance-windows-1'.
WINDOW must be a vertical combination (horizontal if HORIZONTAL
is non-nil)."
- (let* ((first (window-child window))
+ (let* ((char-size (if window-resize-pixelwise
+ 1
+ (frame-char-size window horizontal)))
+ (first (window-child window))
(sub first)
(number-of-children 0)
- (parent-size (window-new-total window))
+ (parent-size (window-new-pixel window))
(total-sum parent-size)
failed size sub-total sub-delta sub-amount rest)
(while sub
(setq number-of-children (1+ number-of-children))
(when (window-size-fixed-p sub horizontal)
(setq total-sum
- (- total-sum (window-total-size sub horizontal)))
+ (- total-sum (window-size sub horizontal t)))
(set-window-new-normal sub 'ignore))
(setq sub (window-right sub)))
@@ -4079,12 +4991,12 @@ is non-nil)."
(while (and sub (not failed))
;; Ignore child windows that should be ignored or are stuck.
(unless (window--resize-child-windows-skip-p sub)
- (setq sub-total (window-total-size sub horizontal))
+ (setq sub-total (window-size sub horizontal t))
(setq sub-delta (- size sub-total))
(setq sub-amount
- (window-sizable sub sub-delta horizontal))
+ (window-sizable sub sub-delta horizontal nil t))
;; Register the new total size for this child window.
- (set-window-new-total sub (+ sub-total sub-amount))
+ (set-window-new-pixel sub (+ sub-total sub-amount))
(unless (= sub-amount sub-delta)
(setq total-sum (- total-sum sub-total sub-amount))
(setq number-of-children (1- number-of-children))
@@ -4093,14 +5005,15 @@ is non-nil)."
(set-window-new-normal sub 'skip)))
(setq sub (window-right sub))))
+ ;; How can we be sure that `number-of-children' is NOT zero here ?
(setq rest (% total-sum number-of-children))
;; Fix rounding by trying to enlarge non-stuck windows by one line
;; (column) until `rest' is zero.
(setq sub first)
(while (and sub (> rest 0))
(unless (window--resize-child-windows-skip-p window)
- (set-window-new-total sub 1 t)
- (setq rest (1- rest)))
+ (set-window-new-pixel sub (min rest char-size) t)
+ (setq rest (- rest char-size)))
(setq sub (window-right sub)))
;; Fix rounding by trying to enlarge stuck windows by one line
@@ -4108,8 +5021,8 @@ is non-nil)."
(setq sub first)
(while (and sub (> rest 0))
(unless (eq (window-new-normal sub) 'ignore)
- (set-window-new-total sub 1 t)
- (setq rest (1- rest)))
+ (set-window-new-pixel sub (min rest char-size) t)
+ (setq rest (- rest char-size)))
(setq sub (window-right sub)))
(setq sub first)
@@ -4117,8 +5030,8 @@ is non-nil)."
;; Record new normal sizes.
(set-window-new-normal
sub (/ (if (eq (window-new-normal sub) 'ignore)
- (window-total-size sub horizontal)
- (window-new-total sub))
+ (window-size sub horizontal t)
+ (window-new-pixel sub))
(float parent-size)))
;; Recursively balance each window's child windows.
(balance-windows-1 sub horizontal)
@@ -4130,9 +5043,9 @@ is non-nil)."
(let ((sub (window-child window)))
(if (window-combined-p sub horizontal)
(balance-windows-2 window horizontal)
- (let ((size (window-new-total window)))
+ (let ((size (window-new-pixel window)))
(while sub
- (set-window-new-total sub size)
+ (set-window-new-pixel sub size)
(balance-windows-1 sub horizontal)
(setq sub (window-right sub))))))))
@@ -4158,11 +5071,17 @@ window."
;; Balance vertically.
(window--resize-reset (window-frame window))
(balance-windows-1 window)
- (window-resize-apply frame)
+ (when (window--resize-apply-p frame)
+ (window-resize-apply frame)
+ (window--pixel-to-total frame)
+ (run-window-configuration-change-hook frame))
;; Balance horizontally.
(window--resize-reset (window-frame window) t)
(balance-windows-1 window t)
- (window-resize-apply frame t)))
+ (when (window--resize-apply-p frame t)
+ (window-resize-apply frame t)
+ (window--pixel-to-total frame t)
+ (run-window-configuration-change-hook frame))))
(defun window-fixed-size-p (&optional window direction)
"Return t if WINDOW cannot be resized in DIRECTION.
@@ -4181,14 +5100,17 @@ This is used by `balance-windows-area'.
Changing this globally has no effect.")
(make-variable-buffer-local 'window-area-factor)
-(defun balance-windows-area-adjust (window delta horizontal)
+(defun balance-windows-area-adjust (window delta horizontal pixelwise)
"Wrapper around `window-resize' with error checking.
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
;; `window-resize' may fail if delta is too large.
(while (>= (abs delta) 1)
(condition-case nil
(progn
- (window-resize window delta horizontal)
+ ;; It was wrong to use `window-resize' here. Somehow
+ ;; `balance-windows-area' depends on resizing windows
+ ;; asymmetrically.
+ (adjust-window-trailing-edge window delta horizontal pixelwise)
(setq delta 0))
(error
;;(message "adjust: %s" (error-message-string err))
@@ -4205,7 +5127,8 @@ specific buffers."
(if (not (window-fixed-size-p win)) win))
(window-list nil 'nomini))))
(changelog nil)
- next)
+ (pixelwise window-resize-pixelwise)
+ next)
;; Resizing a window changes the size of surrounding windows in complex
;; ways, so it's difficult to balance them all. The introduction of
;; `adjust-window-trailing-edge' made it a bit easier, but it is still
@@ -4229,11 +5152,13 @@ specific buffers."
(window-fixed-size-p next)))
;; (assert (eq next (or (cadr (member win wins)) (car wins))))
(let* ((horiz
- (< (car (window-edges win)) (car (window-edges next))))
- (areadiff (/ (- (* (window-height next) (window-width next)
+ (< (car (window-pixel-edges win)) (car (window-pixel-edges next))))
+ (areadiff (/ (- (* (window-size next nil pixelwise)
+ (window-size next t pixelwise)
(buffer-local-value 'window-area-factor
(window-buffer next)))
- (* (window-height win) (window-width win)
+ (* (window-size win nil pixelwise)
+ (window-size win t pixelwise)
(buffer-local-value 'window-area-factor
(window-buffer win))))
(max (buffer-local-value 'window-area-factor
@@ -4241,8 +5166,10 @@ specific buffers."
(buffer-local-value 'window-area-factor
(window-buffer next)))))
(edgesize (if horiz
- (+ (window-height win) (window-height next))
- (+ (window-width win) (window-width next))))
+ (+ (window-size win nil pixelwise)
+ (window-size next nil pixelwise))
+ (+ (window-size win t pixelwise)
+ (window-size next t pixelwise))))
(diff (/ areadiff edgesize)))
(when (zerop diff)
;; Maybe diff is actually closer to 1 than to 0.
@@ -4257,9 +5184,9 @@ specific buffers."
(setq carry (+ carry areadiff))
;; This used `adjust-window-trailing-edge' before and uses
;; `window-resize' now. Error wrapping is still needed.
- (balance-windows-area-adjust win diff horiz)
+ (balance-windows-area-adjust win diff horiz pixelwise)
;; (sit-for 0.5)
- (let ((change (cons win (window-edges win))))
+ (let ((change (cons win (window-pixel-edges win))))
;; If the same change has been seen already for this window,
;; we're most likely in an endless loop, so don't count it as
;; a change.
@@ -4286,8 +5213,10 @@ specific buffers."
(head
`(,type
,@(unless (window-next-sibling window) `((last . t)))
- (total-height . ,(window-total-size window))
- (total-width . ,(window-total-size window t))
+ (pixel-width . ,(window-pixel-width window))
+ (pixel-height . ,(window-pixel-height window))
+ (total-width . ,(window-total-width window))
+ (total-height . ,(window-total-height window))
(normal-height . ,(window-normal-size window))
(normal-width . ,(window-normal-size window t))
,@(unless (window-live-p window)
@@ -4373,7 +5302,13 @@ value can be also stored on disk and read back in a new session."
(min-height-ignore . ,(window-min-size window nil t))
(min-width-ignore . ,(window-min-size window t t))
(min-height-safe . ,(window-min-size window nil 'safe))
- (min-width-safe . ,(window-min-size window t 'safe)))
+ (min-width-safe . ,(window-min-size window t 'safe))
+ (min-pixel-height . ,(window-min-size window nil nil t))
+ (min-pixel-width . ,(window-min-size window t nil t))
+ (min-pixel-height-ignore . ,(window-min-size window nil t t))
+ (min-pixel-width-ignore . ,(window-min-size window t t t))
+ (min-pixel-height-safe . ,(window-min-size window nil 'safe t))
+ (min-pixel-width-safe . ,(window-min-size window t 'safe t)))
(window--state-get-1 window writable)))
(defvar window-state-put-list nil
@@ -4382,7 +5317,7 @@ value can be also stored on disk and read back in a new session."
(defvar window-state-put-stale-windows nil
"Helper variable for `window-state-put'.")
-(defun window--state-put-1 (state &optional window ignore totals)
+(defun window--state-put-1 (state &optional window ignore totals pixelwise)
"Helper function for `window-state-put'."
(let ((type (car state)))
(setq state (cdr state))
@@ -4393,7 +5328,7 @@ value can be also stored on disk and read back in a new session."
(push (cons window state) window-state-put-list))
((memq type '(vc hc))
(let* ((horizontal (eq type 'hc))
- (total (window-total-size window horizontal))
+ (total (window-size window horizontal pixelwise))
(first t)
size new)
(dolist (item state)
@@ -4410,25 +5345,39 @@ value can be also stored on disk and read back in a new session."
(setq size
(if totals
;; Use total size.
- (cdr (assq (if horizontal 'total-width 'total-height) item))
+ (if pixelwise
+ (cdr (assq (if horizontal
+ 'pixel-width
+ 'pixel-height)
+ item))
+ (cdr (assq (if horizontal
+ 'total-width
+ 'total-height)
+ item)))
;; Use normalized size and round.
- (round (* total
- (cdr (assq
- (if horizontal 'normal-width 'normal-height)
- item))))))
+ (round
+ (* total
+ (cdr (assq (if horizontal 'normal-width 'normal-height)
+ item))))))
;; Use safe sizes, we try to resize later.
- (setq size (max size (if horizontal
- window-safe-min-height
- window-safe-min-width)))
-
- (if (window-sizable-p window (- size) horizontal 'safe)
+ (setq size (max size
+ (if horizontal
+ (* window-safe-min-width
+ (if pixelwise
+ (frame-char-width (window-frame window))
+ 1))
+ (* window-safe-min-height
+ (if pixelwise
+ (frame-char-height (window-frame window))
+ 1)))))
+ (if (window-sizable-p window (- size) horizontal 'safe pixelwise)
(let* ((window-combination-limit
(assq 'combination-limit item)))
;; We must inherit the combination limit, otherwise
;; we might mess up handling of atomic and side
;; window.
- (setq new (split-window window size horizontal)))
+ (setq new (split-window window size horizontal pixelwise)))
;; Give up if we can't resize window down to safe sizes.
(error "Cannot resize window %s" window))
@@ -4446,7 +5395,7 @@ value can be also stored on disk and read back in a new session."
;; Continue with the last window split off.
(setq window new))))))))
-(defun window--state-put-2 (ignore)
+(defun window--state-put-2 (ignore pixelwise)
"Helper function for `window-state-put'."
(dolist (item window-state-put-list)
(let ((window (car item))
@@ -4464,107 +5413,171 @@ value can be also stored on disk and read back in a new session."
(set-window-parameter window (car parameter) (cdr parameter))))
;; Process buffer related state.
(when state
- ;; We don't want to raise an error in case the buffer does not
- ;; exist anymore, so we switch to a previous one and save the
- ;; window with the intention of deleting it later if possible.
(let ((buffer (get-buffer (car state))))
(if buffer
- (set-window-buffer window buffer)
+ (with-current-buffer buffer
+ (set-window-buffer window buffer)
+ (set-window-hscroll window (cdr (assq 'hscroll state)))
+ (apply 'set-window-fringes
+ (cons window (cdr (assq 'fringes state))))
+ (let ((margins (cdr (assq 'margins state))))
+ (set-window-margins window (car margins) (cdr margins)))
+ (let ((scroll-bars (cdr (assq 'scroll-bars state))))
+ (set-window-scroll-bars
+ window (car scroll-bars) (nth 2 scroll-bars)
+ (nth 3 scroll-bars) (nth 5 scroll-bars)))
+ (set-window-vscroll window (cdr (assq 'vscroll state)))
+ ;; Adjust vertically.
+ (if (memq window-size-fixed '(t height))
+ ;; A fixed height window, try to restore the
+ ;; original size.
+ (let ((delta
+ (- (cdr (assq
+ (if pixelwise 'pixel-height 'total-height)
+ item))
+ (window-size window nil pixelwise)))
+ window-size-fixed)
+ (when (window--resizable-p
+ window delta nil nil nil nil nil pixelwise)
+ (window-resize window delta nil nil pixelwise)))
+ ;; Else check whether the window is not high enough.
+ (let* ((min-size
+ (window-min-size window nil ignore pixelwise))
+ (delta
+ (- min-size (window-size window nil pixelwise))))
+ (when (and (> delta 0)
+ (window--resizable-p
+ window delta nil ignore nil nil nil pixelwise))
+ (window-resize window delta nil ignore pixelwise))))
+ ;; Adjust horizontally.
+ (if (memq window-size-fixed '(t width))
+ ;; A fixed width window, try to restore the original
+ ;; size.
+ (let ((delta
+ (- (cdr (assq
+ (if pixelwise 'pixel-width 'total-width)
+ item))
+ (window-size window t pixelwise)))
+ window-size-fixed)
+ (when (window--resizable-p
+ window delta nil nil nil nil nil pixelwise)
+ (window-resize window delta nil nil pixelwise)))
+ ;; Else check whether the window is not wide enough.
+ (let* ((min-size (window-min-size window t ignore pixelwise))
+ (delta (- min-size (window-size window t pixelwise))))
+ (when (and (> delta 0)
+ (window--resizable-p
+ window delta t ignore nil nil nil pixelwise))
+ (window-resize window delta t ignore pixelwise))))
+ ;; Set dedicated status.
+ (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+ ;; Install positions (maybe we should do this after all
+ ;; windows have been created and sized).
+ (ignore-errors
+ (set-window-start window (cdr (assq 'start state)))
+ (set-window-point window (cdr (assq 'point state))))
+ ;; Select window if it's the selected one.
+ (when (cdr (assq 'selected state))
+ (select-window window)))
+ ;; We don't want to raise an error in case the buffer does
+ ;; not exist anymore, so we switch to a previous one and
+ ;; save the window with the intention of deleting it later
+ ;; if possible.
(switch-to-prev-buffer window)
- (push window window-state-put-stale-windows)))
- (with-current-buffer (window-buffer window)
- (set-window-hscroll window (cdr (assq 'hscroll state)))
- (apply 'set-window-fringes
- (cons window (cdr (assq 'fringes state))))
- (let ((margins (cdr (assq 'margins state))))
- (set-window-margins window (car margins) (cdr margins)))
- (let ((scroll-bars (cdr (assq 'scroll-bars state))))
- (set-window-scroll-bars
- window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars)))
- (set-window-vscroll window (cdr (assq 'vscroll state)))
- ;; Adjust vertically.
- (if (memq window-size-fixed '(t height))
- ;; A fixed height window, try to restore the original size.
- (let ((delta (- (cdr (assq 'total-height item))
- (window-total-height window)))
- window-size-fixed)
- (when (window-resizable-p window delta)
- (window-resize window delta)))
- ;; Else check whether the window is not high enough.
- (let* ((min-size (window-min-size window nil ignore))
- (delta (- min-size (window-total-size window))))
- (when (and (> delta 0)
- (window-resizable-p window delta nil ignore))
- (window-resize window delta nil ignore))))
- ;; Adjust horizontally.
- (if (memq window-size-fixed '(t width))
- ;; A fixed width window, try to restore the original size.
- (let ((delta (- (cdr (assq 'total-width item))
- (window-total-width window)))
- window-size-fixed)
- (when (window-resizable-p window delta)
- (window-resize window delta)))
- ;; Else check whether the window is not wide enough.
- (let* ((min-size (window-min-size window t ignore))
- (delta (- min-size (window-total-size window t))))
- (when (and (> delta 0)
- (window-resizable-p window delta t ignore))
- (window-resize window delta t ignore))))
- ;; Set dedicated status.
- (set-window-dedicated-p window (cdr (assq 'dedicated state)))
- ;; Install positions (maybe we should do this after all windows
- ;; have been created and sized).
- (ignore-errors
- (set-window-start window (cdr (assq 'start state)))
- (set-window-point window (cdr (assq 'point state))))
- ;; Select window if it's the selected one.
- (when (cdr (assq 'selected state))
- (select-window window)))))))
+ (push window window-state-put-stale-windows)))))))
(defun window-state-put (state &optional window ignore)
"Put window state STATE into WINDOW.
STATE should be the state of a window returned by an earlier
invocation of `window-state-get'. Optional argument WINDOW must
-specify a live window and defaults to the selected one.
+specify a valid window and defaults to the selected one. If
+WINDOW is not live, replace WINDOW by a live one before putting
+STATE into it.
Optional argument IGNORE non-nil means ignore minimum window
sizes and fixed size restrictions. IGNORE equal `safe' means
windows can get as small as `window-safe-min-height' and
`window-safe-min-width'."
(setq window-state-put-stale-windows nil)
- (setq window (window-normalize-window window t))
+ (setq window (window-normalize-window window))
+
+ ;; When WINDOW is internal, reduce it to a live one to put STATE into,
+ ;; see Bug#16793.
+ (unless (window-live-p window)
+ (let ((root (frame-root-window window)))
+ (if (eq window root)
+ (setq window (frame-first-window root))
+ (setq root window)
+ (setq window (catch 'live
+ (walk-window-subtree
+ (lambda (window)
+ (when (window-live-p window)
+ (throw 'live window)))
+ root))))
+ (delete-other-windows-internal window root)))
+
+ (set-window-dedicated-p window nil)
+
(let* ((frame (window-frame window))
(head (car state))
;; We check here (1) whether the total sizes of root window of
;; STATE and that of WINDOW are equal so we can avoid
;; calculating new sizes, and (2) if we do have to resize
;; whether we can do so without violating size restrictions.
- (totals
- (and (= (window-total-size window)
- (cdr (assq 'total-height state)))
- (= (window-total-size window t)
- (cdr (assq 'total-width state)))))
- (min-height (cdr (assq 'min-height head)))
- (min-width (cdr (assq 'min-width head))))
+ (pixelwise (and (cdr (assq 'pixel-width state))
+ (cdr (assq 'pixel-height state))))
+ (totals (or (and pixelwise
+ (= (window-pixel-width window)
+ (cdr (assq 'pixel-width state)))
+ (= (window-pixel-height window)
+ (cdr (assq 'pixel-height state))))
+ (and (= (window-total-width window)
+ (cdr (assq 'total-width state)))
+ (= (window-total-height window)
+ (cdr (assq 'total-height state))))))
+ (min-height (cdr (assq
+ (if pixelwise 'min-pixel-height 'min-height)
+ head)))
+ (min-width (cdr (assq
+ (if pixelwise 'min-pixel-width 'min-weight)
+ head))))
(if (and (not totals)
- (or (> min-height (window-total-size window))
- (> min-width (window-total-size window t)))
+ (or (> min-height (window-size window nil pixelwise))
+ (> min-width (window-size window t pixelwise)))
(or (not ignore)
(and (setq min-height
- (cdr (assq 'min-height-ignore head)))
+ (cdr (assq
+ (if pixelwise
+ 'min-pixel-height-ignore
+ 'min-height-ignore)
+ head)))
(setq min-width
- (cdr (assq 'min-width-ignore head)))
- (or (> min-height (window-total-size window))
- (> min-width (window-total-size window t)))
+ (cdr (assq
+ (if pixelwise
+ 'min-pixel-width-ignore
+ 'min-width-ignore)
+ head)))
+ (or (> min-height
+ (window-size window nil pixelwise))
+ (> min-width
+ (window-size window t pixelwise)))
(or (not (eq ignore 'safe))
(and (setq min-height
- (cdr (assq 'min-height-safe head)))
+ (cdr (assq
+ (if pixelwise
+ 'min-pixel-height-safe
+ 'min-height-safe)
+ head)))
(setq min-width
- (cdr (assq 'min-width-safe head)))
+ (cdr (assq
+ (if pixelwise
+ 'min-pixel-width-safe
+ 'min-width-safe)
+ head)))
(or (> min-height
- (window-total-size window))
+ (window-size window nil pixelwise))
(> min-width
- (window-total-size window t))))))))
+ (window-size window t pixelwise))))))))
;; The check above might not catch all errors due to rounding
;; issues - so IGNORE equal 'safe might not always produce the
;; minimum possible state. But such configurations hardly make
@@ -4578,8 +5591,8 @@ windows can get as small as `window-safe-min-height' and
;; all live windows have been set by `window--state-put-2'.
(with-temp-buffer
(set-window-buffer window (current-buffer))
- (window--state-put-1 state window nil totals)
- (window--state-put-2 ignore))
+ (window--state-put-1 state window nil totals pixelwise)
+ (window--state-put-2 ignore pixelwise))
(while window-state-put-stale-windows
(let ((window (pop window-state-put-stale-windows)))
(when (eq (window-deletable-p window) t)
@@ -4589,18 +5602,18 @@ windows can get as small as `window-safe-min-height' and
(defun display-buffer-record-window (type window buffer)
"Record information for window used by `display-buffer'.
TYPE specifies the type of the calling operation and must be one
-of the symbols 'reuse (when WINDOW existed already and was
-reused for displaying BUFFER), 'window (when WINDOW was created
-on an already existing frame), or 'frame (when WINDOW was
+of the symbols `reuse' (when WINDOW existed already and was
+reused for displaying BUFFER), `window' (when WINDOW was created
+on an already existing frame), or `frame' (when WINDOW was
created on a new frame). WINDOW is the window used for or created
by the `display-buffer' routines. BUFFER is the buffer that
shall be displayed.
This function installs or updates the quit-restore parameter of
WINDOW. The quit-restore parameter is a list of four elements:
-The first element is one of the symbols 'window, 'frame, 'same or
-'other. The second element is either one of the symbols 'window
-or 'frame or a list whose elements are the buffer previously
+The first element is one of the symbols `window', `frame', `same' or
+`other'. The second element is either one of the symbols `window'
+or `frame' or a list whose elements are the buffer previously
shown in the window, that buffer's window start and window point,
and the window's height. The third element is the window
selected at the time the parameter was created. The fourth
@@ -4608,10 +5621,16 @@ element is BUFFER."
(cond
((eq type 'reuse)
(if (eq (window-buffer window) buffer)
- ;; WINDOW shows BUFFER already.
- (when (consp (window-parameter window 'quit-restore))
- ;; If WINDOW has a quit-restore parameter, reset its car.
- (setcar (window-parameter window 'quit-restore) 'same))
+ ;; WINDOW shows BUFFER already. Update WINDOW's quit-restore
+ ;; parameter, if any.
+ (let ((quit-restore (window-parameter window 'quit-restore)))
+ (when (consp quit-restore)
+ (setcar quit-restore 'same)
+ ;; The selected-window might have changed in
+ ;; between (Bug#20353).
+ (unless (or (eq window (selected-window))
+ (eq window (nth 2 quit-restore)))
+ (setcar (cddr quit-restore) (selected-window)))))
;; WINDOW shows another buffer.
(with-current-buffer (window-buffer window)
(set-window-parameter
@@ -4622,7 +5641,9 @@ element is BUFFER."
;; Preserve window-point-insertion-type (Bug#12588).
(copy-marker
(window-point window) window-point-insertion-type)
- (window-total-size window))
+ (if (window-combined-p window)
+ (window-total-height window)
+ (window-total-width window)))
(selected-window) buffer)))))
((eq type 'window)
;; WINDOW has been created on an existing frame.
@@ -4847,7 +5868,7 @@ one of the regular expressions in `special-display-regexps'.
This variable can be set in your init file, like this:
- (setq special-display-frame-alist '((width . 80) (height . 20)))
+ (setq special-display-frame-alist \\='((width . 80) (height . 20)))
These supersede the values given in `default-frame-alist'."
:type '(repeat (cons :format "%v"
@@ -5082,7 +6103,7 @@ hold:
wide as `split-width-threshold'.
- When WINDOW is split evenly, the emanating windows are at least
`window-min-width' or two (whichever is larger) columns wide."
- (when (window-live-p window)
+ (when (and (window-live-p window) (not (window--side-window-p window)))
(with-current-buffer (window-buffer window)
(if horizontal
;; A window can be split horizontally when its width is not
@@ -5203,33 +6224,43 @@ represents a live window, nil otherwise."
))
frame))))
-(defcustom even-window-heights t
- "If non-nil `display-buffer' will try to even window heights.
+(defcustom even-window-sizes t
+ "If non-nil `display-buffer' will try to even window sizes.
Otherwise `display-buffer' will leave the window configuration
-alone. Heights are evened only when `display-buffer' chooses a
-window that appears above or below the selected window."
- :type 'boolean
+alone. Special values are `height-only' to even heights only and
+`width-only' to even widths only. Any other value means to even
+any of them."
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "Side-by-side windows only" width-only)
+ (const :tag "Windows above or below only" height-only)
+ (const :tag "Always" t))
+ :version "25.1"
:group 'windows)
-
-(defun window--even-window-heights (window)
- "Even heights of WINDOW and selected window.
-Do this only if these windows are vertically adjacent to each
-other, `even-window-heights' is non-nil, and the selected window
-is higher than WINDOW."
- (when (and even-window-heights
- ;; Even iff WINDOW forms a vertical combination with the
- ;; selected window, and WINDOW's height exceeds that of the
- ;; selected window, see also bug#11880.
- (window-combined-p window)
- (= (window-child-count (window-parent window)) 2)
- (eq (window-parent) (window-parent window))
- (> (window-total-height) (window-total-height window)))
- ;; Don't throw an error if we can't even window heights for
- ;; whatever reason.
- (condition-case nil
- (enlarge-window
- (/ (- (window-total-height window) (window-total-height)) 2))
- (error nil))))
+(defvaralias 'even-window-heights 'even-window-sizes)
+
+(defun window--even-window-sizes (window)
+ "Even sizes of WINDOW and selected window.
+Even only if these windows are the only children of their parent,
+`even-window-sizes' has the appropriate value and the selected
+window is larger than WINDOW."
+ (when (and (= (window-child-count (window-parent window)) 2)
+ (eq (window-parent) (window-parent window)))
+ (cond
+ ((and (not (memq even-window-sizes '(nil height-only)))
+ (window-combined-p window t)
+ (> (window-total-width) (window-total-width window)))
+ (condition-case nil
+ (enlarge-window
+ (/ (- (window-total-width window) (window-total-width)) 2) t)
+ (error nil)))
+ ((and (not (memq even-window-sizes '(nil width-only)))
+ (window-combined-p window)
+ (> (window-total-height) (window-total-height window)))
+ (condition-case nil
+ (enlarge-window
+ (/ (- (window-total-height window) (window-total-height)) 2))
+ (error nil))))))
(defun window--display-buffer (buffer window type &optional alist dedicated)
"Display BUFFER in WINDOW.
@@ -5249,10 +6280,32 @@ live."
(set-window-prev-buffers window nil)))
(let ((parameter (window-parameter window 'quit-restore))
(height (cdr (assq 'window-height alist)))
- (width (cdr (assq 'window-width alist))))
- (when (or (eq type 'window)
- (and (eq (car parameter) 'same)
- (eq (nth 1 parameter) 'window)))
+ (width (cdr (assq 'window-width alist)))
+ (size (cdr (assq 'window-size alist)))
+ (preserve-size (cdr (assq 'preserve-size alist))))
+ (cond
+ ((or (eq type 'frame)
+ (and (eq (car parameter) 'same)
+ (eq (nth 1 parameter) 'frame)))
+ ;; Adjust size of frame if asked for.
+ (cond
+ ((not size))
+ ((consp size)
+ (let ((width (car size))
+ (height (cdr size))
+ (frame (window-frame window)))
+ (when (and (numberp width) (numberp height))
+ (set-frame-height
+ frame (+ (frame-height frame)
+ (- height (window-total-height window))))
+ (set-frame-width
+ frame (+ (frame-width frame)
+ (- width (window-total-width window)))))))
+ ((functionp size)
+ (ignore-errors (funcall size window)))))
+ ((or (eq type 'window)
+ (and (eq (car parameter) 'same)
+ (eq (nth 1 parameter) 'window)))
;; Adjust height of window if asked for.
(cond
((not height))
@@ -5261,10 +6314,10 @@ live."
(if (integerp height)
height
(round
- (* (window-total-size (frame-root-window window))
+ (* (window-total-height (frame-root-window window))
height))))
- (delta (- new-height (window-total-size window))))
- (when (and (window-resizable-p window delta nil 'safe)
+ (delta (- new-height (window-total-height window))))
+ (when (and (window--resizable-p window delta nil 'safe)
(window-combined-p window))
(window-resize window delta nil 'safe))))
((functionp height)
@@ -5277,14 +6330,18 @@ live."
(if (integerp width)
width
(round
- (* (window-total-size (frame-root-window window) t)
+ (* (window-total-width (frame-root-window window))
width))))
- (delta (- new-width (window-total-size window t))))
- (when (and (window-resizable-p window delta t 'safe)
+ (delta (- new-width (window-total-width window))))
+ (when (and (window--resizable-p window delta t 'safe)
(window-combined-p window t))
(window-resize window delta t 'safe))))
((functionp width)
- (ignore-errors (funcall width window))))))
+ (ignore-errors (funcall width window))))
+ ;; Preserve window size if asked for.
+ (when (consp preserve-size)
+ (window-preserve-size window t (car preserve-size))
+ (window-preserve-size window nil (cdr preserve-size))))))
window))
@@ -5303,7 +6360,7 @@ live."
;; FIXME: By the way, there could be more levels of dedication:
;; - `barely' dedicated doesn't prevent reuse of the window, only records that
;; the window hasn't been used for something else yet.
-;; - `softly' dedicated only allows reuse when asked explicitly.
+;; - `soft' (`softly') dedicated only allows reuse when asked explicitly.
;; - `strongly' never allows reuse.
(defvar display-buffer-mark-dedicated nil
"If non-nil, `display-buffer' marks the windows it creates as dedicated.
@@ -5317,7 +6374,11 @@ The actual non-nil value of this variable will be copied to the
(const display-buffer-pop-up-window)
(const display-buffer-same-window)
(const display-buffer-pop-up-frame)
+ (const display-buffer-below-selected)
+ (const display-buffer-at-bottom)
+ (const display-buffer-in-previous-window)
(const display-buffer-use-some-window)
+ (const display-buffer-use-some-frame)
(function :tag "Other function"))
"Custom type for `display-buffer' action functions.")
@@ -5382,6 +6443,7 @@ See `display-buffer' for details."
'((display-buffer--maybe-same-window ;FIXME: why isn't this redundant?
display-buffer-reuse-window
display-buffer--maybe-pop-up-frame-or-window
+ display-buffer-in-previous-window
display-buffer-use-some-window
;; If all else fails, pop up a new frame.
display-buffer-pop-up-frame))
@@ -5436,9 +6498,11 @@ where FUNCTION is either a function or a list of functions, and
ALIST is an arbitrary association list (alist).
Each such FUNCTION should accept two arguments: the buffer to
-display and an alist. Based on those arguments, it should either
-display the buffer and return the window, or return nil if unable
-to display the buffer.
+display and an alist. Based on those arguments, it should
+display the buffer and return the window. If the caller is
+prepared to handle the case of not displaying the buffer
+and returning nil from `display-buffer' it should pass
+\(allow-no-window . t) as an element of the ALIST.
The `display-buffer' function builds a function list and an alist
by combining the functions and alists specified in
@@ -5457,7 +6521,9 @@ Available action functions include:
`display-buffer-reuse-window'
`display-buffer-pop-up-frame'
`display-buffer-pop-up-window'
+ `display-buffer-in-previous-window'
`display-buffer-use-some-window'
+ `display-buffer-use-some-frame'
Recognized alist entries include:
@@ -5492,6 +6558,14 @@ Recognized alist entries include:
argument - a new window. The function is supposed to adjust
the width of the window; its return value is ignored.
+ `allow-no-window' -- A non-nil value indicates readiness for the case
+ of not displaying the buffer and FUNCTION can safely return
+ a non-window value to suppress displaying.
+
+ `preserve-size' -- Value should be either '(t . nil)' to
+ preserve the width of the window, '(nil . t)' to preserve its
+ height or '(t . t)' to preserve both.
+
The ACTION argument to `display-buffer' can also have a non-nil
and non-list value. This means to display the buffer in a window
other than the selected one, even if it is already displayed in
@@ -5539,10 +6613,10 @@ argument, ACTION is t."
(while (and functions (not window))
(setq window (funcall (car functions) buffer alist)
functions (cdr functions)))
- window))))
+ (and (windowp window) window)))))
(defun display-buffer-other-frame (buffer)
- "Display buffer BUFFER in another frame.
+ "Display buffer BUFFER preferably in another frame.
This uses the function `display-buffer' as a subroutine; see
its documentation for additional customization information."
(interactive "BDisplay buffer in other frame: ")
@@ -5550,6 +6624,41 @@ its documentation for additional customization information."
;;; `display-buffer' action functions:
+(defun display-buffer-use-some-frame (buffer alist)
+ "Display BUFFER in an existing frame that meets a predicate
+\(by default any frame other than the current frame). If
+successful, return the window used; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
+raising the frame.
+
+If ALIST has a non-nil `frame-predicate' entry, its value is a
+function taking one argument (a frame), returning non-nil if the
+frame is a candidate; this function replaces the default
+predicate.
+
+If ALIST has a non-nil `inhibit-same-window' entry, avoid using
+the currently selected window (only useful with a frame-predicate
+that allows the selected frame)."
+ (let* ((predicate (or (cdr (assq 'frame-predicate alist))
+ (lambda (frame)
+ (and
+ (not (eq frame (selected-frame)))
+ (not (window-dedicated-p
+ (or
+ (get-lru-window frame)
+ (frame-first-window frame)))))
+ )))
+ (frame (car (filtered-frame-list predicate)))
+ (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist))))))
+ (when window
+ (prog1
+ (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame))))
+ ))
+
(defun display-buffer-same-window (buffer alist)
"Display BUFFER in the selected window.
This fails if ALIST has a non-nil `inhibit-same-window' entry, or
@@ -5701,8 +6810,13 @@ again with `display-buffer-pop-up-window'."
This either splits the selected window or reuses the window below
the selected one."
(let (window)
- (or (and (not (frame-parameter nil 'unsplittable))
- (setq window (window--try-to-split-window (selected-window) alist))
+ (or (and (setq window (window-in-direction 'below))
+ (eq buffer (window-buffer window))
+ (window--display-buffer buffer window 'reuse alist))
+ (and (not (frame-parameter nil 'unsplittable))
+ (let ((split-height-threshold 0)
+ split-width-threshold)
+ (setq window (window--try-to-split-window (selected-window) alist)))
(window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated))
(and (setq window (window-in-direction 'below))
@@ -5712,14 +6826,28 @@ the selected one."
(defun display-buffer-at-bottom (buffer alist)
"Try displaying BUFFER in a window at the bottom of the selected frame.
-This either splits the window at the bottom of the frame or the
-frame's root window, or reuses an existing window at the bottom
-of the selected frame."
- (let (bottom-window window)
+This either reuses such a window provided it shows BUFFER
+already, splits a window at the bottom of the frame or the
+frame's root window, or reuses some window at the bottom of the
+selected frame."
+ (let (bottom-window bottom-window-shows-buffer window)
(walk-window-tree
- (lambda (window) (setq bottom-window window)) nil nil 'nomini)
- (or (and (not (frame-parameter nil 'unsplittable))
- (setq window (window--try-to-split-window bottom-window alist))
+ (lambda (window)
+ (cond
+ ((window-in-direction 'below window))
+ ((and (not bottom-window-shows-buffer)
+ (eq buffer (window-buffer window)))
+ (setq bottom-window-shows-buffer t)
+ (setq bottom-window window))
+ ((not bottom-window)
+ (setq bottom-window window)))
+ nil nil 'nomini))
+ (or (and bottom-window-shows-buffer
+ (window--display-buffer
+ buffer bottom-window 'reuse alist display-buffer-mark-dedicated))
+ (and (not (frame-parameter nil 'unsplittable))
+ (let (split-width-threshold)
+ (setq window (window--try-to-split-window bottom-window alist)))
(window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated))
(and (not (frame-parameter nil 'unsplittable))
@@ -5813,14 +6941,36 @@ that frame."
(unless (and not-this-window
(eq window (selected-window)))
window))
- (get-largest-window 0 not-this-window))))
+ (get-largest-window 0 nil not-this-window)))
+ (quit-restore (and (window-live-p window)
+ (window-parameter window 'quit-restore)))
+ (quad (nth 1 quit-restore)))
(when (window-live-p window)
+ ;; If the window was used by `display-buffer' before, try to
+ ;; resize it to its old height but don't signal an error.
+ (when (and (listp quad)
+ (integerp (nth 3 quad))
+ (> (nth 3 quad) (window-total-height window)))
+ (condition-case nil
+ (window-resize window (- (nth 3 quad) (window-total-height window)))
+ (error nil)))
+
(prog1
(window--display-buffer buffer window 'reuse alist)
- (window--even-window-heights window)
+ (window--even-window-sizes window)
(unless (cdr (assq 'inhibit-switch-frame alist))
(window--maybe-raise-frame (window-frame window)))))))
+(defun display-buffer-no-window (_buffer alist)
+ "Display BUFFER in no window.
+If ALIST has a non-nil `allow-no-window' entry, then don't display
+a window at all. This makes possible to override the default action
+and avoid displaying the buffer. It is assumed that when the caller
+specifies a non-nil `allow-no-window' then it can handle a nil value
+returned from `display-buffer' in this case."
+ (when (cdr (assq 'allow-no-window alist))
+ 'fail))
+
;;; Display + selection commands:
(defun pop-to-buffer (buffer &optional action norecord)
"Select buffer BUFFER in some window, preferably a different one.
@@ -5858,20 +7008,16 @@ at the front of the list of recently selected ones."
(defun pop-to-buffer-same-window (buffer &optional norecord)
"Select buffer BUFFER in some window, preferably the same one.
-This function behaves much like `switch-to-buffer', except it
-displays with `special-display-function' if BUFFER has a match in
-`special-display-buffer-names' or `special-display-regexps'.
-
-Unlike `pop-to-buffer', this function prefers using the selected
-window over popping up a new window or frame.
-
BUFFER may be a buffer, a string (a buffer name), or nil. If it
is a string not naming an existent buffer, create a buffer with
that name. If BUFFER is nil, choose some other buffer. Return
the buffer.
-NORECORD, if non-nil means do not put this buffer at the front of
-the list of recently selected ones."
+Optional argument NORECORD, if non-nil means do not put this
+buffer at the front of the list of recently selected ones.
+
+Unlike `pop-to-buffer', this function prefers using the selected
+window over popping up a new window or frame."
(pop-to-buffer buffer display-buffer--same-window-action norecord))
(defun read-buffer-to-switch (prompt)
@@ -5930,6 +7076,33 @@ the selected window or never appeared in it before, or if
:group 'windows
:version "24.3")
+(defcustom switch-to-buffer-in-dedicated-window nil
+ "Allow switching to buffer in strongly dedicated windows.
+If non-nil, allow `switch-to-buffer' to proceed when called
+interactively and the selected window is strongly dedicated to
+its buffer.
+
+The following values are recognized:
+
+nil - disallow switching; signal an error
+
+prompt - prompt user whether to allow switching
+
+pop - perform `pop-to-buffer' instead
+
+t - undedicate selected window and switch
+
+When called non-interactively, `switch-to-buffer' always signals
+an error when the selected window is dedicated to its buffer and
+FORCE-SAME-WINDOW is non-nil."
+ :type '(choice
+ (const :tag "Disallow" nil)
+ (const :tag "Prompt" prompt)
+ (const :tag "Pop" pop)
+ (const :tag "Allow" t))
+ :group 'windows
+ :version "25.1")
+
(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
"Display buffer BUFFER-OR-NAME in the selected window.
@@ -5937,10 +7110,12 @@ WARNING: This is NOT the way to work on another buffer temporarily
within a Lisp program! Use `set-buffer' instead. That avoids
messing with the window-buffer correspondences.
-If the selected window cannot display the specified
-buffer (e.g. if it is a minibuffer window or strongly dedicated
-to another buffer), call `pop-to-buffer' to select the buffer in
-another window.
+If the selected window cannot display the specified buffer
+because it is a minibuffer window or strongly dedicated to
+another buffer, call `pop-to-buffer' to select the buffer in
+another window. In interactive use, if the selected window is
+strongly dedicated to its buffer, the value of the option
+`switch-to-buffer-in-dedicated-window' specifies how to proceed.
If called interactively, read the buffer name using the
minibuffer. The variable `confirm-nonexistent-file-or-buffer'
@@ -5957,8 +7132,9 @@ at the front of the buffer list, and do not make the window
displaying it the most recently selected one.
If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
-must be displayed in the selected window; if that is impossible,
-signal an error rather than calling `pop-to-buffer'.
+must be displayed in the selected window when called
+non-interactively; if that is impossible, signal an error rather
+than calling `pop-to-buffer'.
The option `switch-to-buffer-preserve-window-point' can be used
to make the buffer appear at its last position in the selected
@@ -5966,7 +7142,25 @@ window.
Return the buffer switched to."
(interactive
- (list (read-buffer-to-switch "Switch to buffer: ") nil 'force-same-window))
+ (let ((force-same-window
+ (cond
+ ((window-minibuffer-p) nil)
+ ((not (eq (window-dedicated-p) t)) 'force-same-window)
+ ((pcase switch-to-buffer-in-dedicated-window
+ (`nil (user-error
+ "Cannot switch buffers in a dedicated window"))
+ (`prompt
+ (if (y-or-n-p
+ (format "Window is dedicated to %s; undedicate it"
+ (window-buffer)))
+ (progn
+ (set-window-dedicated-p nil nil)
+ 'force-same-window)
+ (user-error
+ "Cannot switch buffers in a dedicated window")))
+ (`pop nil)
+ (_ (set-window-dedicated-p nil nil) 'force-same-window))))))
+ (list (read-buffer-to-switch "Switch to buffer: ") nil force-same-window)))
(let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
(cond
;; Don't call set-window-buffer if it's not needed since it
@@ -6127,211 +7321,502 @@ WINDOW must be a live window and defaults to the selected one."
(eobp)
window))))
-;;; Resizing buffers to fit their contents exactly.
+;;; Resizing windows and frames to fit their contents exactly.
+(defcustom fit-window-to-buffer-horizontally nil
+ "Non-nil means `fit-window-to-buffer' can resize windows horizontally.
+If this is nil, `fit-window-to-buffer' never resizes windows
+horizontally. If this is `only', it can resize windows
+horizontally only. Any other value means `fit-window-to-buffer'
+can resize windows in both dimensions."
+ :type 'boolean
+ :version "24.4"
+ :group 'help)
+
+;; `fit-frame-to-buffer' eventually wants to know the real frame sizes
+;; counting title bar and outer borders.
(defcustom fit-frame-to-buffer nil
- "Non-nil means `fit-window-to-buffer' can resize frames.
-A frame can be resized if and only if its root window is a live
-window. The height of the root window is subject to the values
-of `fit-frame-to-buffer-max-height' and `window-min-height'."
+ "Non-nil means `fit-window-to-buffer' can fit a frame to its buffer.
+A frame is fit if and only if its root window is a live window
+and this option is non-nil. If this is `horizontally', frames
+are resized horizontally only. If this is `vertically', frames
+are resized vertically only. Any other non-nil value means
+frames can be resized in both dimensions."
:type 'boolean
- :version "24.3"
+ :version "24.4"
:group 'help)
-(defcustom fit-frame-to-buffer-bottom-margin 4
- "Bottom margin for the command `fit-frame-to-buffer'.
-This is the number of lines that function leaves free at the bottom of
-the display, in order to not obscure any system task bar or panel.
-If you do not have one (or if it is vertical) you might want to
-reduce this. If it is thicker, you might want to increase this."
- ;; If you set this too small, fit-frame-to-buffer can shift the
- ;; frame up to avoid the panel.
- :type 'integer
- :version "24.3"
- :group 'windows)
+(defcustom fit-frame-to-buffer-margins '(nil nil nil nil)
+ "Margins around frame for `fit-frame-to-buffer'.
+This specifies the numbers of pixels to be left free on the left,
+above, on the right, and below a frame fitted to its buffer. Set
+this to avoid obscuring other desktop objects like the taskbar.
+The default is nil for each side, which means to not add margins.
+
+The value specified here can be overridden for a specific frame
+by that frame's `fit-frame-to-buffer-margins' parameter, if
+present. See also `fit-frame-to-buffer-sizes'."
+ :version "24.4"
+ :type '(list
+ (choice
+ :tag "Left"
+ :value nil
+ :format "%[LeftMargin%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Pixels" :size 5))
+ (choice
+ :tag "Top"
+ :value nil
+ :format "%[TopMargin%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Pixels" :size 5))
+ (choice
+ :tag "Right"
+ :value nil
+ :format "%[RightMargin%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Pixels" :size 5))
+ (choice
+ :tag "Bottom"
+ :value nil
+ :format "%[BottomMargin%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Pixels" :size 5)))
+ :group 'help)
-(defun fit-frame-to-buffer (&optional frame max-height min-height)
- "Adjust height of FRAME to display its buffer contents exactly.
-FRAME can be any live frame and defaults to the selected one.
+(defcustom fit-frame-to-buffer-sizes '(nil nil nil nil)
+ "Size boundaries of frame for `fit-frame-to-buffer'.
+This list specifies the total maximum and minimum lines and
+maximum and minimum columns of the root window of any frame that
+shall be fit to its buffer. If any of these values is non-nil,
+it overrides the corresponding argument of `fit-frame-to-buffer'.
+
+On window systems where the menubar can wrap, fitting a frame to
+its buffer may swallow the last line(s). Specifying an
+appropriate minimum width value here can avoid such wrapping.
+
+See also `fit-frame-to-buffer-margins'."
+ :version "24.4"
+ :type '(list
+ (choice
+ :tag "Maximum Height"
+ :value nil
+ :format "%[MaxHeight%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Lines" :size 5))
+ (choice
+ :tag "Minimum Height"
+ :value nil
+ :format "%[MinHeight%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Lines" :size 5))
+ (choice
+ :tag "Maximum Width"
+ :value nil
+ :format "%[MaxWidth%] %v "
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Columns" :size 5))
+ (choice
+ :tag "Minimum Width"
+ :value nil
+ :format "%[MinWidth%] %v\n"
+ (const :tag "None" :format "%t" nil)
+ (integer :tag "Columns" :size 5)))
+ :group 'help)
+
+(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
+
+(defun window--sanitize-margin (margin left right)
+ "Return MARGIN if it's a number between LEFT and RIGHT."
+ (when (and (numberp margin)
+ (<= left (- right margin)) (<= margin right))
+ margin))
+
+(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
-Optional argument MAX-HEIGHT specifies the maximum height of FRAME.
-It defaults to the height of the display below the current
-top line of FRAME, minus `fit-frame-to-buffer-bottom-margin'.
-Optional argument MIN-HEIGHT specifies the minimum height of FRAME.
-The default corresponds to `window-min-height'."
+(defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width only)
+ "Adjust size of FRAME to display the contents of its buffer exactly.
+FRAME can be any live frame and defaults to the selected one.
+Fit only if FRAME's root window is live. MAX-HEIGHT, MIN-HEIGHT,
+MAX-WIDTH and MIN-WIDTH specify bounds on the new total size of
+FRAME's root window. MIN-HEIGHT and MIN-WIDTH default to the values of
+`window-min-height' and `window-min-width' respectively.
+
+If the optional argument ONLY is `vertically', resize the frame
+vertically only. If ONLY is `horizontally', resize the frame
+horizontally only.
+
+The new position and size of FRAME can be additionally determined
+by customizing the options `fit-frame-to-buffer-sizes' and
+`fit-frame-to-buffer-margins' or the corresponding parameters of
+FRAME."
(interactive)
+ (unless (and (fboundp 'x-display-pixel-height)
+ ;; We need the respective sizes now.
+ (fboundp 'display-monitor-attributes-list))
+ (user-error "Cannot resize frame in non-graphic Emacs"))
(setq frame (window-normalize-frame frame))
- (let* ((root (frame-root-window frame))
- (frame-min-height
- (+ (- (frame-height frame) (window-total-size root))
- window-min-height))
- (frame-top (frame-parameter frame 'top))
- (top (if (consp frame-top)
- (funcall (car frame-top) (cadr frame-top))
- frame-top))
- (frame-max-height
- (- (/ (- (x-display-pixel-height frame) top)
- (frame-char-height frame))
- fit-frame-to-buffer-bottom-margin))
- (compensate 0)
- delta)
- (when (and (window-live-p root) (not (window-size-fixed-p root)))
- (with-selected-window root
- (cond
- ((not max-height)
- (setq max-height frame-max-height))
- ((numberp max-height)
- (setq max-height (min max-height frame-max-height)))
- (t
- (error "%s is an invalid maximum height" max-height)))
+ (when (window-live-p (frame-root-window frame))
+ (with-selected-window (frame-root-window frame)
+ (let* ((window (frame-root-window frame))
+ (char-width (frame-char-width))
+ (char-height (frame-char-height))
+ (monitor-attributes (car (display-monitor-attributes-list
+ (frame-parameter frame 'display))))
+ (geometry (cdr (assq 'geometry monitor-attributes)))
+ (display-width (- (nth 2 geometry) (nth 0 geometry)))
+ (display-height (- (nth 3 geometry) (nth 1 geometry)))
+ (workarea (cdr (assq 'workarea monitor-attributes)))
+ ;; Handle margins.
+ (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
+ fit-frame-to-buffer-margins))
+ (left-margin (if (nth 0 margins)
+ (or (window--sanitize-margin
+ (nth 0 margins) 0 display-width)
+ 0)
+ (nth 0 workarea)))
+ (top-margin (if (nth 1 margins)
+ (or (window--sanitize-margin
+ (nth 1 margins) 0 display-height)
+ 0)
+ (nth 1 workarea)))
+ (workarea-width (nth 2 workarea))
+ (right-margin (if (nth 2 margins)
+ (- display-width
+ (or (window--sanitize-margin
+ (nth 2 margins) left-margin display-width)
+ 0))
+ (nth 2 workarea)))
+ (workarea-height (nth 3 workarea))
+ (bottom-margin (if (nth 3 margins)
+ (- display-height
+ (or (window--sanitize-margin
+ (nth 3 margins) top-margin display-height)
+ 0))
+ (nth 3 workarea)))
+ ;; The pixel width of FRAME (which does not include the
+ ;; window manager's decorations).
+ (frame-width (frame-pixel-width))
+ ;; The pixel width of the body of FRAME's root window.
+ (window-body-width (window-body-width nil t))
+ ;; The difference in pixels between total and body width of
+ ;; FRAME's window.
+ (window-extra-width (- (window-pixel-width) window-body-width))
+ ;; The difference in pixels between the frame's pixel width
+ ;; and the window's body width. This is the space we can't
+ ;; use for fitting.
+ (extra-width (- frame-width window-body-width))
+ ;; The maximum width we can use for fitting.
+ (fit-width (- workarea-width extra-width))
+ ;; The pixel position of FRAME's left border. We usually
+ ;; try to leave this alone.
+ (left
+ (let ((left (frame-parameter nil 'left)))
+ (if (consp left)
+ (funcall (car left) (cadr left))
+ left)))
+ ;; The pixel height of FRAME (which does not include title
+ ;; line, decorations, and sometimes neither the menu nor
+ ;; the toolbar).
+ (frame-height (frame-pixel-height))
+ ;; The pixel height of FRAME's root window (we don't care
+ ;; about the window's body height since the return value of
+ ;; `window-text-pixel-size' includes header and mode line).
+ (window-height (window-pixel-height))
+ ;; The difference in pixels between the frame's pixel
+ ;; height and the window's height.
+ (extra-height (- frame-height window-height))
+ ;; When tool-bar-mode is enabled and we just created a new
+ ;; frame, reserve lines for toolbar resizing. Needed
+ ;; because for reasons unknown to me Emacs (1) reserves one
+ ;; line for the toolbar when making the initial frame and
+ ;; toolbars are enabled, and (2) later adds the remaining
+ ;; lines needed. Our code runs IN BETWEEN (1) and (2).
+ ;; YMMV when you're on a system that behaves differently.
+ (toolbar-extra-height
+ (let ((quit-restore (window-parameter window 'quit-restore))
+ ;; This may have to change when we allow arbitrary
+ ;; pixel height toolbars.
+ (lines (tool-bar-height)))
+ (* char-height
+ (if (and quit-restore (eq (car quit-restore) 'frame)
+ (not (zerop lines)))
+ (1- lines)
+ 0))))
+ ;; The pixel position of FRAME's top border.
+ (top
+ (let ((top (frame-parameter nil 'top)))
+ (if (consp top)
+ (funcall (car top) (cadr top))
+ top)))
+ ;; Sanitize minimum and maximum sizes.
+ (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
+ fit-frame-to-buffer-sizes))
+ (max-height
+ (cond
+ ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
+ ((numberp max-height) (* max-height char-height))
+ (t display-height)))
+ (min-height
+ (cond
+ ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
+ ((numberp min-height) (* min-height char-height))
+ (t (* window-min-height char-height))))
+ (max-width
+ (cond
+ ((numberp (nth 2 sizes))
+ (- (* (nth 2 sizes) char-width) window-extra-width))
+ ((numberp max-width)
+ (- (* max-width char-width) window-extra-width))
+ (t display-width)))
+ (min-width
+ (cond
+ ((numberp (nth 3 sizes))
+ (- (* (nth 3 sizes) char-width) window-extra-width))
+ ((numberp min-width)
+ (- (* min-width char-width) window-extra-width))
+ (t (* window-min-width char-width))))
+ ;; Note: Currently, for a new frame the sizes of the header
+ ;; and mode line may be estimated incorrectly
+ (value (window-text-pixel-size
+ nil t t workarea-width workarea-height t))
+ (width (+ (car value) (window-right-divider-width)))
+ (height
+ (+ (cdr value)
+ (window-bottom-divider-width)
+ (window-scroll-bar-height))))
+ ;; Don't change height or width when the window's size is fixed
+ ;; in either direction or ONLY forbids it.
(cond
- ((not min-height)
- (setq min-height frame-min-height))
- ((numberp min-height)
- (setq min-height (min min-height frame-min-height)))
- (t
- (error "%s is an invalid minimum height" min-height)))
- ;; When tool-bar-mode is enabled and we have just created a new
- ;; frame, reserve lines for toolbar resizing. This is needed
- ;; because for reasons unknown to me Emacs (1) reserves one line
- ;; for the toolbar when making the initial frame and toolbars
- ;; are enabled, and (2) later adds the remaining lines needed.
- ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
- ;; system that behaves differently.
- (let ((quit-restore (window-parameter root 'quit-restore))
- (lines (tool-bar-lines-needed frame)))
- (when (and quit-restore (eq (car quit-restore) 'frame)
- (not (zerop lines)))
- (setq compensate (1- lines))))
- (message "%s" compensate)
- (setq delta
- ;; Always count a final newline - we don't do any
- ;; post-processing, so let's play safe.
- (+ (count-screen-lines nil nil t)
- (- (window-body-size))
- compensate)))
- ;; Move away from final newline.
- (when (and (eobp) (bolp) (not (bobp)))
- (set-window-point root (line-beginning-position 0)))
- (set-window-start root (point-min))
- (set-window-vscroll root 0)
- (condition-case nil
- (set-frame-height
- frame
- (min (max (+ (frame-height frame) delta)
- min-height)
- max-height))
- (error (setq delta nil))))
- delta))
-
-(defun fit-window-to-buffer (&optional window max-height min-height)
- "Adjust height of WINDOW to display its buffer's contents exactly.
+ ((or (eq window-size-fixed 'width) (eq only 'vertically))
+ (setq width nil))
+ ((or (eq window-size-fixed 'height) (eq only 'horizontally))
+ (setq height nil)))
+ ;; Fit width to constraints.
+ (when width
+ (unless frame-resize-pixelwise
+ ;; Round to character sizes.
+ (setq width (* (/ (+ width char-width -1) char-width)
+ char-width)))
+ ;; Fit to maximum and minimum widths.
+ (setq width (max (min width max-width) min-width))
+ ;; Add extra width.
+ (setq width (+ width extra-width))
+ ;; Preserve margins.
+ (let ((right (+ left width)))
+ (cond
+ ((> right right-margin)
+ ;; Move frame to left (we don't know its real width).
+ (setq left (max left-margin (- left (- right right-margin)))))
+ ((< left left-margin)
+ ;; Move frame to right.
+ (setq left left-margin)))))
+ ;; Fit height to constraints.
+ (when height
+ (unless frame-resize-pixelwise
+ (setq height (* (/ (+ height char-height -1) char-height)
+ char-height)))
+ ;; Fit to maximum and minimum heights.
+ (setq height (max (min height max-height) min-height))
+ ;; Add extra height.
+ (setq height (+ height extra-height))
+ ;; Preserve margins.
+ (let ((bottom (+ top height)))
+ (cond
+ ((> bottom bottom-margin)
+ ;; Move frame up (we don't know its real height).
+ (setq top (max top-margin (- top (- bottom bottom-margin)))))
+ ((< top top-margin)
+ ;; Move frame down.
+ (setq top top-margin)))))
+ ;; Apply changes.
+ (set-frame-position frame left top)
+ ;; Clumsily try to translate our calculations to what
+ ;; `set-frame-size' wants.
+ (when width
+ (setq width (- (+ (frame-text-width) width)
+ extra-width window-body-width)))
+ (when height
+ (setq height (- (+ (frame-text-height) height)
+ extra-height window-height)))
+ (set-frame-size
+ frame
+ (if width
+ (if frame-resize-pixelwise
+ width
+ (/ width char-width))
+ (frame-text-width))
+ (if height
+ (if frame-resize-pixelwise
+ height
+ (/ height char-height))
+ (frame-text-height))
+ frame-resize-pixelwise)))))
+
+(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size)
+ "Adjust size of WINDOW to display its buffer's contents exactly.
WINDOW must be a live window and defaults to the selected one.
-Optional argument MAX-HEIGHT specifies the maximum height of
-WINDOW and defaults to the height of WINDOW's frame. Optional
-argument MIN-HEIGHT specifies the minimum height of WINDOW and
-defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT
-are specified in lines and include the mode line and header line,
-if any.
-
-If WINDOW is a full height window, then if the option
-`fit-frame-to-buffer' is non-nil, this calls the function
-`fit-frame-to-buffer' to adjust the frame height.
-
-Return the number of lines by which WINDOW was enlarged or
-shrunk. If an error occurs during resizing, return nil but don't
-signal an error.
+If WINDOW is part of a vertical combination, adjust WINDOW's
+height. The new height is calculated from the actual height of
+the accessible portion of its buffer. The optional argument
+MAX-HEIGHT specifies a maximum height and defaults to the height
+of WINDOW's frame. The optional argument MIN-HEIGHT specifies a
+minimum height and defaults to `window-min-height'. Both
+MAX-HEIGHT and MIN-HEIGHT are specified in lines and include mode
+and header line and a bottom divider, if any.
+
+If WINDOW is part of a horizontal combination and the value of
+the option `fit-window-to-buffer-horizontally' is non-nil, adjust
+WINDOW's width. The new width of WINDOW is calculated from the
+maximum length of its buffer's lines that follow the current
+start position of WINDOW. The optional argument MAX-WIDTH
+specifies a maximum width and defaults to the width of WINDOW's
+frame. The optional argument MIN-WIDTH specifies a minimum width
+and defaults to `window-min-width'. Both MAX-WIDTH and MIN-WIDTH
+are specified in columns and include fringes, margins, a
+scrollbar and a vertical divider, if any.
+
+If the optional argument `preserve-size' is non-nil, preserve the
+size of WINDOW (see `window-preserve-size').
+
+Fit pixelwise if the option `window-resize-pixelwise' is non-nil.
+If WINDOW is its frame's root window and the option
+`fit-frame-to-buffer' is non-nil, call `fit-frame-to-buffer' to
+adjust the frame's size.
Note that even if this function makes WINDOW large enough to show
-_all_ lines of its buffer you might not see the first lines when
-WINDOW was scrolled."
+_all_ parts of its buffer you might not see the first part when
+WINDOW was scrolled. If WINDOW is resized horizontally, you will
+not see the top of its buffer unless WINDOW starts at its minimum
+accessible position."
(interactive)
(setq window (window-normalize-window window t))
- (cond
- ((window-size-fixed-p window))
- ((window-full-height-p window)
- (when fit-frame-to-buffer
- (fit-frame-to-buffer (window-frame window))))
- (t
+ (if (eq window (frame-root-window window))
+ (when fit-frame-to-buffer
+ ;; Fit WINDOW's frame to buffer.
+ (fit-frame-to-buffer
+ (window-frame window)
+ max-height min-height max-width min-width
+ (and (memq fit-frame-to-buffer '(vertically horizontally))
+ fit-frame-to-buffer)))
(with-selected-window window
- (let* ((height (window-total-size))
+ (let* ((pixelwise window-resize-pixelwise)
+ (char-height (frame-char-height))
+ (char-width (frame-char-width))
+ (total-height (window-size window nil pixelwise))
+ (body-height (window-body-height window pixelwise))
+ (body-width (window-body-width window pixelwise))
(min-height
- ;; Adjust MIN-HEIGHT.
+ ;; Sanitize MIN-HEIGHT.
(if (numberp min-height)
;; Can't get smaller than `window-safe-min-height'.
- (max min-height window-safe-min-height)
+ (max (if pixelwise
+ (* char-height min-height)
+ min-height)
+ (if pixelwise
+ (window-safe-min-pixel-height window)
+ window-safe-min-height))
;; Preserve header and mode line if present.
- (window-min-size nil nil t)))
+ (max (if pixelwise
+ (* char-height window-min-height)
+ window-min-height)
+ (window-min-size window nil window pixelwise))))
(max-height
- ;; Adjust MAX-HEIGHT.
+ ;; Sanitize MAX-HEIGHT.
(if (numberp max-height)
- ;; Can't get larger than height of frame.
- (min max-height
- (window-total-size (frame-root-window window)))
- ;; Don't delete other windows.
- (+ height (window-max-delta nil nil window))))
- ;; Make `desired-height' the height necessary to show
- ;; all of WINDOW's buffer, constrained by MIN-HEIGHT
- ;; and MAX-HEIGHT.
- (desired-height
- (max
- (min
- (+ (count-screen-lines)
- ;; For non-minibuffers count the mode line, if any.
- (if (and (not (window-minibuffer-p window))
- mode-line-format)
- 1
- 0)
- ;; Count the header line, if any.
- (if header-line-format 1 0))
- max-height)
- min-height))
- (desired-delta
- (- desired-height (window-total-size window)))
- (delta
- (if (> desired-delta 0)
- (min desired-delta
- (window-max-delta window nil window))
- (max desired-delta
- (- (window-min-delta window nil window))))))
- (condition-case nil
- (if (zerop delta)
- ;; Return zero if DELTA became zero in the process.
- 0
- ;; Don't try to redisplay with the cursor at the end on its
- ;; own line--that would force a scroll and spoil things.
- (when (and (eobp) (bolp) (not (bobp)))
- ;; It's silly to put `point' at the end of the previous
- ;; line and so maybe force horizontal scrolling.
- (set-window-point window (line-beginning-position 0)))
- ;; Call `window-resize' with OVERRIDE argument equal WINDOW.
- (window-resize window delta nil window)
- ;; Check if the last line is surely fully visible. If
- ;; not, enlarge the window.
- (let ((end (save-excursion
- (goto-char (point-max))
- (when (and (bolp) (not (bobp)))
- ;; Don't include final newline.
- (backward-char 1))
- (when truncate-lines
- ;; If line-wrapping is turned off, test the
- ;; beginning of the last line for
- ;; visibility instead of the end, as the
- ;; end of the line could be invisible by
- ;; virtue of extending past the edge of the
- ;; window.
- (forward-line 0))
- (point))))
- (set-window-vscroll window 0)
- ;; This loop might in some rare pathological cases raise
- ;; an error - another reason for the `condition-case'.
- (while (and (< desired-height max-height)
- (= desired-height (window-total-size))
- (not (pos-visible-in-window-p end)))
- (window-resize window 1 nil window)
- (setq desired-height (1+ desired-height)))))
- (error (setq delta nil)))
- delta)))))
+ (min
+ (+ total-height
+ (window-max-delta
+ window nil window nil nil nil pixelwise))
+ (if pixelwise
+ (* char-height max-height)
+ max-height))
+ (+ total-height (window-max-delta
+ window nil window nil nil nil pixelwise))))
+ height)
+ (cond
+ ;; If WINDOW is vertically combined, try to resize it
+ ;; vertically.
+ ((and (not (eq fit-window-to-buffer-horizontally 'only))
+ (not (window-size-fixed-p window 'preserved))
+ (window-combined-p))
+ ;; Vertically we always want to fit the entire buffer.
+ ;; WINDOW'S height can't get larger than its frame's pixel
+ ;; height. Its width remains fixed.
+ (setq height (+ (cdr (window-text-pixel-size
+ nil nil t nil (frame-pixel-height) t))
+ (window-scroll-bar-height window)
+ (window-bottom-divider-width)))
+ ;; Round height.
+ (unless pixelwise
+ (setq height (/ (+ height char-height -1) char-height)))
+ (unless (= height total-height)
+ (window-preserve-size window)
+ (window-resize-no-error
+ window
+ (- (max min-height (min max-height height)) total-height)
+ nil window pixelwise)
+ (when preserve-size
+ (window-preserve-size window nil t))))
+ ;; If WINDOW is horizontally combined, try to resize it
+ ;; horizontally.
+ ((and fit-window-to-buffer-horizontally
+ (not (window-size-fixed-p window t 'preserved))
+ (window-combined-p nil t))
+ (let* ((total-width (window-size window t pixelwise))
+ (min-width
+ ;; Sanitize MIN-WIDTH.
+ (if (numberp min-width)
+ ;; Can't get smaller than `window-safe-min-width'.
+ (max (if pixelwise
+ (* char-width min-width)
+ min-width)
+ (if pixelwise
+ (window-safe-min-pixel-width)
+ window-safe-min-width))
+ ;; Preserve fringes, margins, scrollbars if present.
+ (max (if pixelwise
+ (* char-width window-min-width)
+ window-min-width)
+ (window-min-size nil nil window pixelwise))))
+ (max-width
+ ;; Sanitize MAX-WIDTH.
+ (if (numberp max-width)
+ (min (+ total-width
+ (window-max-delta
+ window t window nil nil nil pixelwise))
+ (if pixelwise
+ (* char-width max-width)
+ max-width))
+ (+ total-width (window-max-delta
+ window t window nil nil nil pixelwise))))
+ ;; When fitting horizontally, assume that WINDOW's
+ ;; start position remains unaltered. WINDOW can't get
+ ;; wider than its frame's pixel width, its height
+ ;; remains unaltered.
+ (width (+ (car (window-text-pixel-size
+ nil (window-start) (point-max)
+ (frame-pixel-width)
+ ;; Add one char-height to assure that
+ ;; we're on the safe side. This
+ ;; overshoots when the first line below
+ ;; the bottom is wider than the window.
+ (* body-height
+ (if pixelwise 1 char-height))))
+ (window-right-divider-width))))
+ (unless pixelwise
+ (setq width (/ (+ width char-width -1) char-width)))
+ (unless (= width body-width)
+ (window-preserve-size window t)
+ (window-resize-no-error
+ window
+ (- (max min-width
+ (min max-width
+ (+ total-width (- width body-width))))
+ total-width)
+ t window pixelwise)
+ (when preserve-size
+ (window-preserve-size window t t))))))))))
(defun window-safely-shrinkable-p (&optional window)
"Return t if WINDOW can be shrunk without shrinking other windows.
@@ -6361,7 +7846,7 @@ Return non-nil if the window was shrunk, nil otherwise."
;; should be taken care of by `fit-window-to-buffer'.
(when (and (window-combined-p window)
(pos-visible-in-window-p (point-min) window))
- (fit-window-to-buffer window (window-total-size window))))
+ (fit-window-to-buffer window (window-total-height window))))
(defun kill-buffer-and-window ()
"Kill the current buffer and delete the selected window."
@@ -6386,7 +7871,8 @@ Return non-nil if the window was shrunk, nil otherwise."
(defvar recenter-last-op nil
"Indicates the last recenter operation performed.
-Possible values: `top', `middle', `bottom', integer or float numbers.")
+Possible values: `top', `middle', `bottom', integer or float numbers.
+It can also be nil, which means the first value in `recenter-positions'.")
(defcustom recenter-positions '(middle top bottom)
"Cycling order for `recenter-top-bottom'.
@@ -6625,6 +8111,9 @@ With arg N, put point N/10 of the way from the true end."
(defvar mouse-autoselect-window-timer nil
"Timer used by delayed window autoselection.")
+(defvar mouse-autoselect-window-position-1 nil
+ "First mouse position recorded by delayed window autoselection.")
+
(defvar mouse-autoselect-window-position nil
"Last mouse position recorded by delayed window autoselection.")
@@ -6649,6 +8138,7 @@ Optional argument FORCE means cancel unconditionally."
(memq (nth 4 (event-end last-input-event))
'(handle end-scroll)))))
(setq mouse-autoselect-window-state nil)
+ (setq mouse-autoselect-window-position-1 nil)
(when (timerp mouse-autoselect-window-timer)
(cancel-timer mouse-autoselect-window-timer))
(remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
@@ -6681,7 +8171,7 @@ is active. This function is run by `mouse-autoselect-window-timer'."
(window-at (cadr mouse-position) (cddr mouse-position)
(car mouse-position)))))
(cond
- ((or (menu-or-popup-active-p)
+ ((or (and (fboundp 'menu-or-popup-active-p) (menu-or-popup-active-p))
(and window
(let ((coords (coordinates-in-window-p
(cdr mouse-position) window)))
@@ -6690,21 +8180,32 @@ is active. This function is run by `mouse-autoselect-window-timer'."
;; A menu / popup dialog is active or the mouse is not on the
;; text region of WINDOW: Suspend autoselection temporarily.
(mouse-autoselect-window-start mouse-position nil t))
- ((eq mouse-autoselect-window-state 'suspend)
+ ((or (eq mouse-autoselect-window-state 'suspend)
+ ;; When the mouse is at its first recorded position, restart
+ ;; delayed autoselection. This works around a scenario with
+ ;; two two-window frames with identical dimensions: select the
+ ;; first window of the first frame, switch to the second
+ ;; frame, move the mouse to its second window, minimize the
+ ;; second frame. Now the second window of the first frame
+ ;; gets selected although the mouse never really "moved" into
+ ;; that window.
+ (and (numberp mouse-autoselect-window)
+ (equal (mouse-position) mouse-autoselect-window-position-1)))
;; Delayed autoselection was temporarily suspended, reenable it.
(mouse-autoselect-window-start mouse-position))
((and window (not (eq window (selected-window)))
(or (not (numberp mouse-autoselect-window))
- (and (> mouse-autoselect-window 0)
- ;; If `mouse-autoselect-window' is positive, select
- ;; window if the window is the same as before.
+ (and (>= mouse-autoselect-window 0)
+ ;; If `mouse-autoselect-window' is non-negative,
+ ;; select window if it's the same as before.
(eq window mouse-autoselect-window-window))
- ;; Otherwise select window if the mouse is at the same
- ;; position as before. Observe that the first test after
- ;; starting autoselection usually fails since the value of
- ;; `mouse-autoselect-window-position' recorded there is the
- ;; position where the mouse has entered the new window and
- ;; not necessarily where the mouse has stopped moving.
+ ;; Otherwise select window iff the mouse is at the same
+ ;; position as before. Observe that the first test
+ ;; after starting autoselection usually fails since the
+ ;; value of `mouse-autoselect-window-position' recorded
+ ;; there is the position where the mouse has entered the
+ ;; new window and not necessarily where the mouse has
+ ;; stopped moving.
(equal mouse-position mouse-autoselect-window-position))
;; The minibuffer is a candidate window if it's active.
(or (not (window-minibuffer-p window))
@@ -6734,7 +8235,7 @@ is active. This function is run by `mouse-autoselect-window-timer'."
(defun handle-select-window (event)
"Handle select-window events."
- (interactive "e")
+ (interactive "^e")
(let ((window (posn-window (event-start event))))
(unless (or (not (window-live-p window))
;; Don't switch if we're currently in the minibuffer.
@@ -6748,14 +8249,14 @@ is active. This function is run by `mouse-autoselect-window-timer'."
(not (minibuffer-window-active-p window)))
;; Don't switch when autoselection shall be delayed.
(and (numberp mouse-autoselect-window)
- (not (zerop mouse-autoselect-window))
(not (eq mouse-autoselect-window-state 'select))
- (progn
+ (let ((position (mouse-position)))
;; Cancel any delayed autoselection.
(mouse-autoselect-window-cancel t)
;; Start delayed autoselection from current mouse
;; position and window.
- (mouse-autoselect-window-start (mouse-position) window)
+ (setq mouse-autoselect-window-position-1 position)
+ (mouse-autoselect-window-start position window)
;; Executing a command cancels delayed autoselection.
(add-hook
'pre-command-hook 'mouse-autoselect-window-cancel))))
@@ -6781,7 +8282,107 @@ Otherwise, consult the value of `truncate-partial-width-windows'
(window-buffer window))))
(if (integerp t-p-w-w)
(< (window-width window) t-p-w-w)
- t-p-w-w))))
+ t-p-w-w))))
+
+
+;; Automatically inform subprocesses of changes to window size.
+
+(defcustom window-adjust-process-window-size-function
+ 'window-adjust-process-window-size-smallest
+ "Control how Emacs chooses inferior process window sizes.
+Emacs uses this function to tell processes the space they have
+available for displaying their output. After each window
+configuration change, Emacs calls the value of
+`window-adjust-process-window-size-function' for each process
+with a buffer being displayed in at least one window.
+This function is responsible for combining the sizes of the
+displayed windows and returning a cons (WIDTH . HEIGHT)
+describing the width and height with which Emacs will call
+`set-process-window-size' for that process. If the function
+returns nil, Emacs does not call `set-process-window-size'.
+
+This function is called with the process buffer as the current
+buffer and with two arguments: the process and a list of windows
+displaying process. Modes can make this variable buffer-local;
+additionally, the `adjust-window-size-function' process property
+overrides the global or buffer-local value of
+`window-adjust-process-window-size-function'."
+ :type '(choice
+ (const :tag "Minimum area of any window"
+ window-adjust-process-window-size-smallest)
+ (const :tag "Maximum area of any window"
+ window-adjust-process-window-size-largest)
+ (const :tag "Do not adjust process window sizes" ignore)
+ function)
+ :group 'windows
+ :version "25.1")
+
+(defun window-adjust-process-window-size (reducer process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. REDUCER is
+a two-argument function used to combine the widths and heights of
+the given windows."
+ (when windows
+ (let ((width (window-body-width (car windows)))
+ (height (window-body-height (car windows))))
+ (dolist (window (cdr windows))
+ (setf width (funcall reducer width (window-body-width window)))
+ (setf height (funcall reducer height (window-body-height window))))
+ (cons width height))))
+
+(defun window-adjust-process-window-size-smallest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+smallest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'min process windows))
+
+(defun window-adjust-process-window-size-largest (process windows)
+ "Adjust the process window size of PROCESS.
+WINDOWS is a list of windows associated with PROCESS. Choose the
+largest area available for displaying PROCESS's output."
+ (window-adjust-process-window-size #'max process windows))
+
+(defun window--process-window-list ()
+ "Return an alist mapping processes to associated windows.
+A window is associated with a process if that window is
+displaying that processes's buffer."
+ (let ((processes (process-list))
+ (process-windows nil))
+ (walk-windows
+ (lambda (window)
+ (let ((buffer (window-buffer window))
+ (iter processes))
+ (while (let ((process (car iter)))
+ (if (and (process-live-p process)
+ (eq buffer (process-buffer process)))
+ (let ((procwin (assq process process-windows)))
+ ;; Add this window to the list of windows
+ ;; displaying process.
+ (if procwin
+ (push window (cdr procwin))
+ (push (list process window) process-windows))
+ ;; We found our process for this window, so
+ ;; stop iterating over the process list.
+ nil)
+ (setf iter (cdr iter)))))))
+ 1 t)
+ process-windows))
+
+(defun window--adjust-process-windows ()
+ "Update process window sizes to match the current window configuration."
+ (dolist (procwin (window--process-window-list))
+ (let ((process (car procwin)))
+ (with-demoted-errors "Error adjusting window size: %S"
+ (with-current-buffer (process-buffer process)
+ (let ((size (funcall
+ (or (process-get process 'adjust-window-size-function)
+ window-adjust-process-window-size-function)
+ process (cdr procwin))))
+ (when size
+ (set-process-window-size process (cdr size) (car size)))))))))
+
+(add-hook 'window-configuration-change-hook 'window--adjust-process-windows)
+
;; Some of these are in tutorial--default-keys, so update that if you
;; change these.
diff --git a/lisp/winner.el b/lisp/winner.el
index e81052f8499..3767b9f1f69 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,6 +1,6 @@
;;; winner.el --- Restore old window configurations
-;; Copyright (C) 1997-1998, 2001-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2015 Free Software Foundation, Inc.
;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
;; Created: 27 Feb 1997
@@ -112,10 +112,7 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Save current configuration.
;; (Called below by `winner-save-old-configurations').
(defun winner-remember ()
- (let ((entry (assq (selected-frame) winner-currents)))
- (if entry (setcdr entry (winner-conf))
- (push (cons (selected-frame) (winner-conf))
- winner-currents))))
+ (setf (alist-get (selected-frame) winner-currents) (winner-conf)))
;; Consult `winner-currents'.
(defun winner-configuration (&optional frame)
@@ -180,6 +177,12 @@ You may want to include buffer names such as *Help*, *Apropos*,
;; Called whenever the window configuration changes
;; (a `window-configuration-change-hook').
(defun winner-change-fun ()
+
+ ;; Cull dead frames.
+ (setq winner-modified-list
+ (cl-loop for frame in winner-modified-list
+ if (frame-live-p frame) collect frame))
+
(unless (or (memq (selected-frame) winner-modified-list)
(/= 0 (minibuffer-depth)))
(push (selected-frame) winner-modified-list)))
@@ -418,7 +421,7 @@ In other words, \"undo\" changes in window configuration."
(ring-ref winner-pending-undo-ring 0)))
(unless (eq (selected-window) (minibuffer-window))
(message "Winner undid undo")))
- (t (error "Previous command was not a `winner-undo'"))))
+ (t (user-error "Previous command was not a `winner-undo'"))))
(provide 'winner)
;;; winner.el ends here
diff --git a/lisp/woman.el b/lisp/woman.el
index b1be2d67b62..81319fa6a9f 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1,9 +1,9 @@
;;; woman.el --- browse UN*X manual pages `wo (without) man'
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Francis J. Wright <F.J.Wright@qmul.ac.uk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, unix
;; Adapted-By: Eli Zaretskii <eliz@gnu.org>
;; Version: 0.551
@@ -161,7 +161,7 @@
;; The WoMan menu provides an option to make a contents menu for the
;; current man page (using imenu). Alternatively, if you set the
-;; variable `woman-imenu' to `t' then WoMan will do it automatically
+;; variable `woman-imenu' to t then WoMan will do it automatically
;; for every man page. The menu title is the value of the variable
;; `woman-imenu-title', which is "CONTENTS" by default. By default,
;; the menu shows manual sections and subsections, but you can change
@@ -179,7 +179,7 @@
;; Howard Melman made (essentially) the following suggestions, which
;; are slightly different from the expression that I currently use.
;; You may prefer one of Howard's suggestions, which I think assume
-;; that `case-fold-search' is `t' (which it is by default):
+;; that `case-fold-search' is t (which it is by default):
;; (setq woman-imenu-generic-expression
;; '((nil "^\\( \\)?\\([A-Z][A-Z ]+[A-Z]\\)[ \t]*$" 2)))
@@ -217,7 +217,7 @@
;; This is modeled on the byte-compiler. It logs all files formatted
;; by WoMan, and if WoMan finds anything that it cannot handle then it
;; writes a warning to this buffer. If the variable `woman-show-log'
-;; is non-nil (by default it is `nil') then WoMan automatically
+;; is non-nil (by default it is nil) then WoMan automatically
;; displays this buffer. Many WoMan warnings can be completely
;; ignored, because they are reporting the fact that WoMan has ignored
;; requests that it is correct to ignore. In some future version this
@@ -228,8 +228,8 @@
;; Uninterpreted ?roff requests can optionally be left in the
;; formatted buffer to indicate precisely where they occur by
-;; resetting the variable `woman-ignore' to `nil' (by default it is
-;; `t').
+;; resetting the variable `woman-ignore' to nil (by default it is
+;; t).
;; Automatic initiation of woman decoding
@@ -278,7 +278,7 @@
;; CASE-DEPENDENCE OF FILENAMES. By default, WoMan ignores case in
;; file pathnames only when it seems appropriate. MS-Windows users
;; who want complete case independence should set the NTEmacs variable
-;; `w32-downcase-file-names' to `t' and use all lower case when
+;; `w32-downcase-file-names' to t and use all lower case when
;; setting WoMan file paths.
;; (1) INCOMPATIBLE CHANGE! WoMan no longer uses a persistent topic
@@ -414,18 +414,12 @@
(substring arg 0 (match-end 1))
arg))))
+(require 'cl-lib)
+
(eval-when-compile ; to avoid compiler warnings
(require 'dired)
- (require 'cl-lib)
(require 'apropos))
-(defun woman-mapcan (fn x)
- "Return concatenated list of FN applied to successive `car' elements of X.
-FN must return a list, cons or nil. Useful for splicing into a list."
- ;; Based on the Standard Lisp function MAPCAN but with args swapped!
- ;; More concise implementation than the recursive one. -- dak
- (apply #'nconc (mapcar fn x)))
-
(defun woman-parse-colon-path (paths)
"Explode search path string PATHS into a list of directory names.
Allow Cygwin colon-separated search paths on Microsoft platforms.
@@ -440,7 +434,7 @@ As a special case, if PATHS is nil then replace it by calling
(mapcar 'woman-Cyg-to-Win (woman-parse-man.conf)))
((string-match-p ";" paths)
;; Assume DOS-style path-list...
- (woman-mapcan ; splice list into list
+ (cl-mapcan ; splice list into list
(lambda (x)
(if x
(list x)
@@ -451,14 +445,14 @@ As a special case, if PATHS is nil then replace it by calling
(list paths))
(t
;; Assume UNIX/Cygwin-style path-list...
- (woman-mapcan ; splice list into list
+ (cl-mapcan ; splice list into list
(lambda (x)
(mapcar 'woman-Cyg-to-Win
(if x (list x) (woman-parse-man.conf))))
(let ((path-separator ":"))
(parse-colon-path paths)))))
;; Assume host-default-style path-list...
- (woman-mapcan ; splice list into list
+ (cl-mapcan ; splice list into list
(lambda (x) (if x (list x) (woman-parse-man.conf)))
(parse-colon-path (or paths "")))))
@@ -495,6 +489,8 @@ As a special case, if PATHS is nil then replace it by calling
(defgroup woman nil
"Browse UNIX manual pages `wo (without) man'."
:tag "WoMan"
+ :link '(custom-manual "(woman) Top")
+ :link '(emacs-commentary-link :tag "Commentary" "woman.el")
:group 'help)
(defcustom woman-show-log nil
@@ -790,7 +786,7 @@ without interactive confirmation, if it exists as a topic."
(defvar woman-file-regexp nil
"Regexp used to select (possibly compressed) man source files, e.g.
-\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\|xz\\)\\)?\\'\".
+\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\|xz\\)\\)?\\\\='\".
Built automatically from the customizable user options
`woman-uncompressed-file-regexp' and `woman-file-compression-regexp'.")
@@ -820,7 +816,7 @@ becoming more common in the GNU world. For example, the man pages
in the ncurses package include `toe.1m', `form.3x', etc.
Note: an optional compression regexp will be appended, so this regexp
-MUST NOT end with any kind of string terminator such as $ or \\'."
+MUST NOT end with any kind of string terminator such as $ or \\\\='."
:type 'regexp
:set 'set-woman-file-regexp
:group 'woman-interface)
@@ -830,8 +826,8 @@ MUST NOT end with any kind of string terminator such as $ or \\'."
"Do not change this unless you are sure you know what you are doing!
Regexp used to match compressed man file extensions for which
decompressors are available and handled by auto-compression mode,
-e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\|xz\\\\)\\\\'\" for `gzip', `bzip2', or `xz'.
-Should begin with \\. and end with \\' and MUST NOT be optional."
+e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\|xz\\\\)\\\\\\='\" for `gzip', `bzip2', or `xz'.
+Should begin with \\. and end with \\\\=' and MUST NOT be optional."
;; Should be compatible with car of
;; `jka-compr-file-name-handler-entry', but that is unduly
;; complicated, includes an inappropriate extension (.tgz) and is
@@ -949,7 +945,7 @@ or different fonts."
(defun woman-default-faces ()
"Set foreground colors of italic and bold faces to their default values."
- (declare (obsolete choose-completion-guess-base-position "23.2"))
+ (declare (obsolete "customize the woman-* faces instead." "24.4"))
(interactive)
(face-spec-set 'woman-italic (face-user-default-spec 'woman-italic))
(face-spec-set 'woman-bold (face-user-default-spec 'woman-bold)))
@@ -957,7 +953,7 @@ or different fonts."
(defun woman-monochrome-faces ()
"Set foreground colors of italic and bold faces to that of the default face.
This is usually either black or white."
- (declare (obsolete choose-completion-guess-base-position "23.2"))
+ (declare (obsolete "customize the woman-* faces instead." "24.4"))
(interactive)
(set-face-foreground 'woman-italic 'unspecified)
(set-face-foreground 'woman-bold 'unspecified))
@@ -1655,7 +1651,7 @@ Do not call directly!"
(setq woman-frame (make-frame)))))
(set-buffer (get-buffer-create bufname))
(condition-case nil
- (switch-to-buffer (current-buffer))
+ (display-buffer (current-buffer))
(error (pop-to-buffer (current-buffer))))
(buffer-disable-undo)
(setq buffer-read-only nil)
@@ -2065,14 +2061,14 @@ alist in `woman-buffer-alist' and return nil."
(if (zerop woman-buffer-number)
(let ((buffer (get-buffer (cdr (car woman-buffer-alist)))))
(if buffer
- (switch-to-buffer buffer)
+ (display-buffer buffer)
;; Delete alist element:
(setq woman-buffer-alist (cdr woman-buffer-alist))
nil))
(let* ((prev-ptr (nthcdr (1- woman-buffer-number) woman-buffer-alist))
(buffer (get-buffer (cdr (car (cdr prev-ptr))))))
(if buffer
- (switch-to-buffer buffer)
+ (display-buffer buffer)
;; Delete alist element:
(setcdr prev-ptr (cdr (cdr prev-ptr)))
(if (>= woman-buffer-number (length woman-buffer-alist))
@@ -2300,7 +2296,7 @@ Currently set only from '\" t in the first line of the source file.")
;; Process \k escapes BEFORE changing tab width (?):
(goto-char from)
- (woman-mark-horizonal-position)
+ (woman-mark-horizontal-position)
;; Set buffer-local variables:
(setq fill-column woman-fill-column
@@ -2720,7 +2716,7 @@ If DELETE is non-nil then delete from point."
(defsubst woman-unescape (macro)
"Replace escape sequences in the body of MACRO.
-Replaces || by |, but | by \, where | denotes the internal escape."
+Replaces || by |, but | by \\, where | denotes the internal escape."
(let (start)
(while (setq start (string-match woman-unescape-regex macro start))
(setq macro
@@ -2842,7 +2838,7 @@ special characters."
(defun woman-strings (&optional to)
"Process ?roff string requests and escape sequences up to buffer position TO.
Strings are defined/updated by `.ds xx string' requests and
-interpolated by `\*x' and `\*(xx' escapes."
+interpolated by `\\*x' and `\\*(xx' escapes."
;; Add support for .as and .rm?
(while
;; Find .ds requests and \* escapes:
@@ -3452,7 +3448,7 @@ Format paragraphs upto TO. Supports special chars.
Each element has the form (KEY VALUE . INC) -- inc may be nil.
Also bound locally in `woman2-roff-buffer'.")
-(defun woman-mark-horizonal-position ()
+(defun woman-mark-horizontal-position ()
"\\kx -- Store current horizontal position in INPUT LINE in register x."
(while (re-search-forward "\\\\k\\(.\\)" nil t)
(goto-char (match-beginning 0))
@@ -3553,7 +3549,7 @@ The expression may be an argument in quotes."
(if (> (woman-parse-numeric-value) 0) 1 0))
)))
))
-; (if (looking-at "[ \t\nRC\)\"]") ; R, C are tab types
+; (if (looking-at "[ \t\nRC)\"]") ; R, C are tab types
; ()
; (WoMan-warn "Unimplemented numerical operator `%c' in %s"
; (following-char)
@@ -3587,7 +3583,7 @@ expression in parentheses. Leaves point after the value."
;; string-to-number returns 0 if number not parsed.
(string-to-number (match-string 0)))
((looking-at "\\\\n\\([-+]\\)?\\(?:\
-\\[\\([^]]+\\)\\]\\|\(\\(..\\)\\|\\(.\\)\\)")
+\\[\\([^]]+\\)\\]\\|(\\(..\\)\\|\\(.\\)\\)")
;; interpolate number register, maybe auto-incremented
(let* ((pm (match-string-no-properties 1))
(name (or (match-string-no-properties 2)
@@ -3723,7 +3719,7 @@ expression in parentheses. Leaves point after the value."
"Find and return start of next control line.
PAT, if non-nil, specifies an additional component of the control
line regexp to search for, which is appended to the default
-regexp, \"\\(\\\\c\\)?\\n[.']\"."
+regexp, \"\\(\\\\c\\)?\\n[.\\=']\"."
(let ((pattern (concat "\\(\\\\c\\)?\n[.']" pat))
to)
(save-excursion
@@ -3765,7 +3761,7 @@ Round to whole lines, default 1 line. Format paragraphs upto TO.
(defun woman2-TH (to)
".TH n c x v m -- Begin a man page. Format paragraphs upto TO.
-n is the name of the page in chapter c\; x is extra commentary\;
+n is the name of the page in chapter c; x is extra commentary;
v alters page foot left; m alters page head center.
\(Should set prevailing indent and tabs to 5.)"
(woman-forward-arg 'unquote 'concat)
@@ -3985,7 +3981,7 @@ Optional argument NUMERIC, if non-nil, means the argument is numeric."
(goto-char from)))
(defun woman-horizontal-line ()
- "\\l'Nc' -- Draw a horizontal line of length N using character c, default _."
+ "\\l\\='Nc\\=' -- Draw a horizontal line of length N using character c, default _."
(delete-char -1)
(delete-char 1)
(looking-at "\\(.\\)\\(.*\\)\\1")
@@ -4353,7 +4349,7 @@ Format paragraphs upto TO."
(defun woman2-ta (to)
".ta Nt ... -- Set tabs, left type, unless t=R(right), C(centered).
-\(Breaks, but should not.) The tab stops are separated by spaces\;
+\(Breaks, but should not.) The tab stops are separated by spaces;
a value preceded by + represents an increment to the previous stop value.
Format paragraphs upto TO."
(setq tab-stop-list nil)
@@ -4552,11 +4548,11 @@ Format paragraphs upto TO."
(defun WoMan-log (format &rest args)
"Log a message out of FORMAT control string and optional ARGS."
- (WoMan-log-1 (apply 'format format args)))
+ (WoMan-log-1 (apply #'format-message format args)))
(defun WoMan-warn (format &rest args)
"Log a warning message out of FORMAT control string and optional ARGS."
- (setq format (apply 'format format args))
+ (setq format (apply #'format-message format args))
(WoMan-log-1 (concat "** " format)))
;; request is not used dynamically by any callees.
@@ -4631,9 +4627,4 @@ logging the message."
(provide 'woman)
-
-;; Local Variables:
-;; coding: utf-8
-;; End:
-
;;; woman.el ends here
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 43e9f376d08..8ec5dfc65c0 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1,9 +1,9 @@
-;;; x-dnd.el --- drag and drop support for X -*- coding: utf-8 -*-
+;;; x-dnd.el --- drag and drop support for X
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2015 Free Software Foundation, Inc.
;; Author: Jan Djärv <jan.h.d@swipnet.se>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: window, drag, drop
;; Package: emacs
@@ -217,10 +217,10 @@ WINDOW is the window where the drop happened. ACTION is ignored.
DATA is the moz-url, which is formatted as two strings separated by \\r\\n.
The first string is the URL, the second string is the title of that URL.
DATA is encoded in utf-16. Decode the URL and call `x-dnd-handle-uri-list'."
- ;; Mozilla and applications based on it (Galeon for example) uses
- ;; text/unicode, but it is impossible to tell if it is le or be. Use what
- ;; the machine Emacs runs on use. This loses if dropping between machines
- ;; with different endian, but it is the best we can do.
+ ;; Mozilla and applications based on it use text/unicode, but it is
+ ;; impossible to tell if it is le or be. Use what the machine Emacs
+ ;; runs on uses. This loses if dropping between machines
+ ;; with different endian-ness, but it is the best we can do.
(let* ((coding (if (eq (byteorder) ?B) 'utf-16be 'utf-16le))
(string (decode-coding-string data coding))
(strings (split-string string "[\r\n]" t))
diff --git a/lisp/xml.el b/lisp/xml.el
index b62065eb48f..f5a9a3f8f0b 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -1,6 +1,6 @@
;;; xml.el --- XML parser
-;; Copyright (C) 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2015 Free Software Foundation, Inc.
;; Author: Emmanuel Briot <briot@gnat.com>
;; Maintainer: Mark A. Hershberger <mah@everybody.org>
@@ -326,8 +326,8 @@ URIs, and expanded names will be returned as a cons
If PARSE-NS is an alist, it will be used as the mapping from
namespace to URIs instead.
-If it is the symbol 'symbol-qnames, expanded names will be
-returned as a plain symbol 'namespace:foo instead of a cons.
+If it is the symbol `symbol-qnames', expanded names will be
+returned as a plain symbol `namespace:foo' instead of a cons.
Both features can be combined by providing a cons cell
@@ -356,8 +356,8 @@ URIs, and expanded names will be returned as a cons
If PARSE-NS is an alist, it will be used as the mapping from
namespace to URIs instead.
-If it is the symbol 'symbol-qnames, expanded names will be
-returned as a plain symbol 'namespace:foo instead of a cons.
+If it is the symbol `symbol-qnames', expanded names will be
+returned as a plain symbol `namespace:foo' instead of a cons.
Both features can be combined by providing a cons cell
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 745bca7a2be..2bb71549564 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -1,6 +1,6 @@
;;; xt-mouse.el --- support the mouse when emacs run in an xterm
-;; Copyright (C) 1994, 2000-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 2000-2015 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: mouse, terminals
@@ -42,14 +42,6 @@
(defvar xterm-mouse-debug-buffer nil)
-(defvar xterm-mouse-last)
-
-;; Mouse events symbols must have an 'event-kind property with
-;; the value 'mouse-click.
-(dolist (event-type '(mouse-1 mouse-2 mouse-3
- M-down-mouse-1 M-down-mouse-2 M-down-mouse-3))
- (put event-type 'event-kind 'mouse-click))
-
(defun xterm-mouse-translate (_event)
"Read a click and release event from XTerm."
(xterm-mouse-translate-1))
@@ -63,58 +55,50 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(defun xterm-mouse-translate-1 (&optional extension)
(save-excursion
- (save-window-excursion
- (deactivate-mark)
- (let* ((xterm-mouse-last nil)
- (down (xterm-mouse-event extension))
- (down-command (nth 0 down))
- (down-data (nth 1 down))
- (down-where (nth 1 down-data))
- (down-binding (key-binding (if (symbolp down-where)
- (vector down-where down-command)
- (vector down-command))))
- (is-click (string-match "^mouse" (symbol-name (car down)))))
-
- ;; Retrieve the expected preface for the up-event.
- (unless is-click
- (unless (cond ((null extension)
- (and (eq (read-event) ?\e)
- (eq (read-event) ?\[)
- (eq (read-event) ?M)))
- ((eq extension 1006)
- (and (eq (read-event) ?\e)
- (eq (read-event) ?\[)
- (eq (read-event) ?<))))
- (error "Unexpected escape sequence from XTerm")))
-
- ;; Process the up-event.
- (let* ((click (if is-click down (xterm-mouse-event extension)))
- (click-data (nth 1 click))
- (click-where (nth 1 click-data)))
- (if (memq down-binding '(nil ignore))
- (if (and (symbolp click-where)
- (consp click-where))
- (vector (list click-where click-data) click)
- (vector click))
- (setq unread-command-events
- (append (if (eq down-where click-where)
- (list click)
- (list
- ;; Cheat `mouse-drag-region' with move event.
- (list 'mouse-movement click-data)
- ;; Generate a drag event.
- (if (symbolp down-where)
- 0
- (list (intern (format "drag-mouse-%d"
- (1+ xterm-mouse-last)))
- down-data click-data))))
- unread-command-events))
- (if xterm-mouse-debug-buffer
- (print unread-command-events xterm-mouse-debug-buffer))
- (if (and (symbolp down-where)
- (consp down-where))
- (vector (list down-where down-data) down)
- (vector down))))))))
+ (let* ((event (xterm-mouse-event extension))
+ (ev-command (nth 0 event))
+ (ev-data (nth 1 event))
+ (ev-where (nth 1 ev-data))
+ (vec (vector event))
+ (is-move (eq 'mouse-movement ev-command))
+ (is-down (string-match "down-" (symbol-name ev-command))))
+
+ ;; Mouse events symbols must have an 'event-kind property with
+ ;; the value 'mouse-click.
+ (when ev-command (put ev-command 'event-kind 'mouse-click))
+
+ (cond
+ ((null event) nil) ;Unknown/bogus byte sequence!
+ (is-down
+ (setf (terminal-parameter nil 'xterm-mouse-last-down) event)
+ vec)
+ (is-move vec)
+ (t
+ (let* ((down (terminal-parameter nil 'xterm-mouse-last-down))
+ (down-data (nth 1 down))
+ (down-where (nth 1 down-data)))
+ (setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
+ (cond
+ ((null down)
+ ;; This is an "up-only" event. Pretend there was an up-event
+ ;; right before and keep the up-event for later.
+ (push event unread-command-events)
+ (vector (cons (intern (replace-regexp-in-string
+ "\\`\\([ACMHSs]-\\)*" "\\&down-"
+ (symbol-name ev-command) t))
+ (cdr event))))
+ ((equal ev-where down-where) vec)
+ (t
+ (let ((drag (if (symbolp ev-where)
+ 0 ;FIXME: Why?!?
+ (list (intern (replace-regexp-in-string
+ "\\`\\([ACMHSs]-\\)*" "\\&drag-"
+ (symbol-name ev-command) t))
+ down-data ev-data))))
+ (if (null track-mouse)
+ (vector drag)
+ (push drag unread-command-events)
+ (vector (list 'mouse-movement ev-data))))))))))))
;; These two variables have been converted to terminal parameters.
;;
@@ -150,104 +134,159 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(fdiff (- f (* 1.0 maxwrap dbig))))
(+ (truncate fdiff) (* maxwrap dbig))))))
-;; Normal terminal mouse click reporting: expect three bytes, of the
-;; form <BUTTON+32> <X+32> <Y+32>. Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1000 ()
- (list (let ((code (- (read-event) 32)))
- (intern
- ;; For buttons > 3, the release-event looks differently
- ;; (see xc/programs/xterm/button.c, function EditorButton),
- ;; and come in a release-event only, no down-event.
- (cond ((>= code 64)
- (format "mouse-%d" (- code 60)))
- ((memq code '(8 9 10))
- (setq xterm-mouse-last code)
- (format "M-down-mouse-%d" (- code 7)))
- ((= code 11)
- (format "M-mouse-%d" (- xterm-mouse-last 7)))
- ((= code 3)
- ;; For buttons > 5 xterm only reports a
- ;; button-release event. Avoid error by mapping
- ;; them all to mouse-1.
- (format "mouse-%d" (+ 1 (or xterm-mouse-last 0))))
- (t
- (setq xterm-mouse-last code)
- (format "down-mouse-%d" (+ 1 code))))))
- ;; x and y coordinates
- (- (read-event) 33)
- (- (read-event) 33)))
-
-;; XTerm's 1006-mode terminal mouse click reporting has the form
-;; <BUTTON> ; <X> ; <Y> <M or m>, where the button and ordinates are
-;; in encoded (decimal) form. Return a list (EVENT-TYPE X Y).
-(defun xterm-mouse--read-event-sequence-1006 ()
- (let (button-bytes x-bytes y-bytes c)
- (while (not (eq (setq c (read-event)) ?\;))
- (push c button-bytes))
- (while (not (eq (setq c (read-event)) ?\;))
- (push c x-bytes))
- (while (not (memq (setq c (read-event)) '(?m ?M)))
- (push c y-bytes))
- (list (let* ((code (string-to-number
- (apply 'string (nreverse button-bytes))))
- (wheel (>= code 64))
- (down (and (not wheel)
- (eq c ?M))))
- (intern (format "%s%smouse-%d"
- (cond (wheel "")
- ((< code 4) "")
- ((< code 8) "S-")
- ((< code 12) "M-")
- ((< code 16) "M-S-")
- ((< code 20) "C-")
- ((< code 24) "C-S-")
- ((< code 28) "C-M-")
- ((< code 32) "C-M-S-")
- (t
- (error "Unexpected escape sequence from XTerm")))
- (if down "down-" "")
- (if wheel
- (- code 60)
- (1+ (setq xterm-mouse-last (mod code 4)))))))
- (1- (string-to-number (apply 'string (nreverse x-bytes))))
- (1- (string-to-number (apply 'string (nreverse y-bytes)))))))
+(defun xterm-mouse--read-utf8-char (&optional prompt seconds)
+ "Read an utf-8 encoded character from the current terminal.
+This function reads and returns an utf-8 encoded character of
+command input. If the user generates an event which is not a
+character (i.e., a mouse click or function key event), read-char
+signals an error.
+
+The returned event may come directly from the user, or from a
+keyboard macro. It is not decoded by the keyboard's input coding
+system and always treated with an utf-8 input encoding.
+
+The optional arguments PROMPT and SECONDS work like in
+`read-event'."
+ (let ((tmp (keyboard-coding-system)))
+ (set-keyboard-coding-system 'utf-8)
+ (prog1 (read-event prompt t seconds)
+ (set-keyboard-coding-system tmp))))
+
+;; In default mode, each numeric parameter of XTerm's mouse report is
+;; a single char, possibly encoded as utf-8. The actual numeric
+;; parameter then is obtained by subtracting 32 from the character
+;; code. In extended mode the parameters are returned as decimal
+;; string delimited either by semicolons or for the last parameter by
+;; one of the characters "m" or "M". If the last character is a "m",
+;; then the mouse event was a button release, else it was a button
+;; press or a mouse motion. Return value is a cons cell with
+;; (NEXT-NUMERIC-PARAMETER . LAST-CHAR)
+(defun xterm-mouse--read-number-from-terminal (extension)
+ (let (c)
+ (if extension
+ (let ((n 0))
+ (while (progn
+ (setq c (read-char))
+ (<= ?0 c ?9))
+ (setq n (+ (* 10 n) c (- ?0))))
+ (cons n c))
+ (cons (- (setq c (xterm-mouse--read-utf8-char)) 32) c))))
+
+;; XTerm reports mouse events as
+;; <EVENT-CODE> <X> <Y> in default mode, and
+;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
+;; The macro read-number-from-terminal takes care of reading
+;; the response parameters appropriately. The EVENT-CODE differs
+;; slightly between default and extended mode.
+;; Return a list (EVENT-TYPE-SYMBOL X Y).
+(defun xterm-mouse--read-event-sequence (&optional extension)
+ (pcase-let*
+ ((`(,code . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,x . ,_) (xterm-mouse--read-number-from-terminal extension))
+ (`(,y . ,c) (xterm-mouse--read-number-from-terminal extension))
+ (wheel (/= (logand code 64) 0))
+ (move (/= (logand code 32) 0))
+ (ctrl (/= (logand code 16) 0))
+ (meta (/= (logand code 8) 0))
+ (shift (/= (logand code 4) 0))
+ (down (and (not wheel)
+ (not move)
+ (if extension
+ (eq c ?M)
+ (/= (logand code 3) 3))))
+ (btn (cond
+ ((or extension down wheel)
+ (+ (logand code 3) (if wheel 4 1)))
+ ;; The default mouse protocol does not report the button
+ ;; number in release events: extract the button number
+ ;; from last button-down event.
+ ((terminal-parameter nil 'xterm-mouse-last-down)
+ (string-to-number
+ (substring
+ (symbol-name
+ (car (terminal-parameter nil 'xterm-mouse-last-down)))
+ -1)))
+ ;; Spurious release event without previous button-down
+ ;; event: assume, that the last button was button 1.
+ (t 1)))
+ (sym (if move 'mouse-movement
+ (intern (concat (if ctrl "C-" "")
+ (if meta "M-" "")
+ (if shift "S-" "")
+ (if down "down-" "")
+ "mouse-"
+ (number-to-string btn))))))
+ (list sym (1- x) (1- y))))
+
+(defun xterm-mouse--set-click-count (event click-count)
+ (setcdr (cdr event) (list click-count))
+ (let ((name (symbol-name (car event))))
+ (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name)
+ (setcar event
+ (intern (concat (match-string 1 name)
+ (if (= click-count 2)
+ "double-" "triple-")
+ (match-string 2 name)))))))
(defun xterm-mouse-event (&optional extension)
"Convert XTerm mouse event to Emacs mouse event.
EXTENSION, if non-nil, means to use an extension to the usual
terminal mouse protocol; we currently support the value 1006,
which is the \"1006\" extension implemented in Xterm >= 277."
- (let* ((click (cond ((null extension)
- (xterm-mouse--read-event-sequence-1000))
- ((eq extension 1006)
- (xterm-mouse--read-event-sequence-1006))
- (t
- (error "Unsupported XTerm mouse protocol"))))
- (type (nth 0 click))
- (x (nth 1 click))
- (y (nth 2 click))
- ;; Emulate timestamp information. This is accurate enough
- ;; for default value of mouse-1-click-follows-link (450msec).
- (timestamp (xterm-mouse-truncate-wrap
- (* 1000
- (- (float-time)
- (or xt-mouse-epoch
- (setq xt-mouse-epoch (float-time)))))))
- (w (window-at x y))
- (ltrb (window-edges w))
- (left (nth 0 ltrb))
- (top (nth 1 ltrb)))
- (set-terminal-parameter nil 'xterm-mouse-x x)
- (set-terminal-parameter nil 'xterm-mouse-y y)
- (setq
- last-input-event
- (list type
- (let ((event (if w
- (posn-at-x-y (- x left) (- y top) w t)
- (append (list nil 'menu-bar)
- (nthcdr 2 (posn-at-x-y x y))))))
- (setcar (nthcdr 3 event) timestamp)
- event)))))
+ (let ((click (cond ((memq extension '(1006 nil))
+ (xterm-mouse--read-event-sequence extension))
+ (t
+ (error "Unsupported XTerm mouse protocol")))))
+ (when click
+ (let* ((type (nth 0 click))
+ (x (nth 1 click))
+ (y (nth 2 click))
+ ;; Emulate timestamp information. This is accurate enough
+ ;; for default value of mouse-1-click-follows-link (450msec).
+ (timestamp (xterm-mouse-truncate-wrap
+ (* 1000
+ (- (float-time)
+ (or xt-mouse-epoch
+ (setq xt-mouse-epoch (float-time)))))))
+ (w (window-at x y))
+ (ltrb (window-edges w))
+ (left (nth 0 ltrb))
+ (top (nth 1 ltrb))
+ (posn (if w
+ (posn-at-x-y (- x left) (- y top) w t)
+ (append (list nil 'menu-bar)
+ (nthcdr 2 (posn-at-x-y x y)))))
+ (event (list type posn)))
+ (setcar (nthcdr 3 posn) timestamp)
+
+ ;; Try to handle double/triple clicks.
+ (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click))
+ (last-type (nth 0 last-click))
+ (last-name (symbol-name last-type))
+ (last-time (nth 1 last-click))
+ (click-count (nth 2 last-click))
+ (this-time (float-time))
+ (name (symbol-name type)))
+ (cond
+ ((not (string-match "down-" name))
+ ;; For up events, make the up side match the down side.
+ (setq this-time last-time)
+ (when (and click-count (> click-count 1)
+ (string-match "down-" last-name)
+ (equal name (replace-match "" t t last-name)))
+ (xterm-mouse--set-click-count event click-count)))
+ ((not last-time) nil)
+ ((and (> double-click-time (* 1000 (- this-time last-time)))
+ (equal last-name (replace-match "" t t name)))
+ (setq click-count (1+ click-count))
+ (xterm-mouse--set-click-count event click-count))
+ (t (setq click-count 1)))
+ (set-terminal-parameter nil 'xterm-mouse-last-click
+ (list type this-time click-count)))
+
+ (set-terminal-parameter nil 'xterm-mouse-x x)
+ (set-terminal-parameter nil 'xterm-mouse-y y)
+ (setq last-input-event event)))))
;;;###autoload
(define-minor-mode xterm-mouse-mode
@@ -263,69 +302,102 @@ single clicks are supported. When turned on, the normal xterm
mouse functionality for such clicks is still available by holding
down the SHIFT key while pressing the mouse button."
:global t :group 'mouse
- (let ((do-hook (if xterm-mouse-mode 'add-hook 'remove-hook)))
- (funcall do-hook 'terminal-init-xterm-hook
- 'turn-on-xterm-mouse-tracking-on-terminal)
- (funcall do-hook 'delete-terminal-functions
- 'turn-off-xterm-mouse-tracking-on-terminal)
- (funcall do-hook 'suspend-tty-functions
- 'turn-off-xterm-mouse-tracking-on-terminal)
- (funcall do-hook 'resume-tty-functions
- 'turn-on-xterm-mouse-tracking-on-terminal)
- (funcall do-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
- (funcall do-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
- (funcall do-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking))
+ (funcall (if xterm-mouse-mode 'add-hook 'remove-hook)
+ 'terminal-init-xterm-hook
+ 'turn-on-xterm-mouse-tracking-on-terminal)
(if xterm-mouse-mode
;; Turn it on
(progn
(setq mouse-position-function #'xterm-mouse-position-function)
- (turn-on-xterm-mouse-tracking))
+ (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list)))
;; Turn it off
- (turn-off-xterm-mouse-tracking 'force)
+ (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list))
(setq mouse-position-function nil)))
-(defun turn-on-xterm-mouse-tracking ()
- "Enable Emacs mouse tracking in xterm."
- (dolist (terminal (terminal-list))
- (turn-on-xterm-mouse-tracking-on-terminal terminal)))
+(defconst xterm-mouse-tracking-enable-sequence
+ "\e[?1000h\e[?1002h\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
+escape sequences are understood by modern xterms:
+
+\"\\e[?1000h\" \"Basic mouse mode\": Enables reports for mouse
+ clicks. There is a limit to the maximum row/column
+ 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[?1005h\" \"UTF-8 coordinate extension\": Enables an extension
+ to the basic mouse mode, which uses UTF-8
+ characters to overcome the 223 row/column limit. This
+ extension may conflict with non UTF-8 applications or
+ non UTF-8 locales.
-(defun turn-off-xterm-mouse-tracking (&optional _force)
- "Disable Emacs mouse tracking in xterm."
- (dolist (terminal (terminal-list))
- (turn-off-xterm-mouse-tracking-on-terminal terminal)))
+\"\\e[?1006h\" \"SGR coordinate extension\": Enables a newer
+ alternative extension to the basic mouse mode, which
+ overcomes the 223 row/column limit without the
+ drawbacks of the UTF-8 coordinate extension.
+
+The two extension modes are mutually exclusive, where the last
+given escape sequence takes precedence over the former.")
+
+(defconst xterm-mouse-tracking-disable-sequence
+ "\e[?1006l\e[?1005l\e[?1002l\e[?1000l"
+ "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.")
(defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal)
"Enable xterm mouse tracking on TERMINAL."
(when (and xterm-mouse-mode (eq t (terminal-live-p terminal))
;; Avoid the initial terminal which is not a termcap device.
- ;; FIXME: is there more elegant way to detect the initial terminal?
+ ;; FIXME: is there more elegant way to detect the initial
+ ;; terminal?
(not (string= (terminal-name terminal) "initial_terminal")))
(unless (terminal-parameter terminal 'xterm-mouse-mode)
;; Simulate selecting a terminal by selecting one of its frames
+ ;; so that we can set the terminal-local `input-decode-map'.
(with-selected-frame (car (frames-on-display-list terminal))
(define-key input-decode-map "\e[M" 'xterm-mouse-translate)
(define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended))
- (set-terminal-parameter terminal 'xterm-mouse-mode t))
- (send-string-to-terminal "\e[?1000h" terminal)
- ;; Request extended mouse support, if available (xterm >= 277).
- (send-string-to-terminal "\e[?1006h" terminal)))
+ (condition-case err
+ (send-string-to-terminal xterm-mouse-tracking-enable-sequence
+ terminal)
+ ;; FIXME: This should use a dedicated error signal.
+ (error (if (equal (cadr err) "Terminal is currently suspended")
+ nil ;The sequence will be sent upon resume.
+ (signal (car err) (cdr err)))))
+ (push xterm-mouse-tracking-enable-sequence
+ (terminal-parameter nil 'tty-mode-set-strings))
+ (push xterm-mouse-tracking-disable-sequence
+ (terminal-parameter nil 'tty-mode-reset-strings))
+ (set-terminal-parameter terminal 'xterm-mouse-mode t))))
(defun turn-off-xterm-mouse-tracking-on-terminal (terminal)
"Disable xterm mouse tracking on TERMINAL."
;; Only send the disable command to those terminals to which we've already
;; sent the enable command.
(when (and (terminal-parameter terminal 'xterm-mouse-mode)
- (eq t (terminal-live-p terminal))
- ;; Avoid the initial terminal which is not a termcap device.
- ;; FIXME: is there more elegant way to detect the initial terminal?
- (not (string= (terminal-name terminal) "initial_terminal")))
+ (eq t (terminal-live-p terminal)))
;; We could remove the key-binding and unset the `xterm-mouse-mode'
;; terminal parameter, but it seems less harmful to send this escape
;; command too many times (or to catch an unintended key sequence), than
;; to send it too few times (or to fail to let xterm-mouse events
;; pass by untranslated).
- (send-string-to-terminal "\e[?1000l" terminal)
- (send-string-to-terminal "\e[?1006l" terminal)))
+ (condition-case err
+ (send-string-to-terminal xterm-mouse-tracking-disable-sequence
+ terminal)
+ ;; FIXME: This should use a dedicated error signal.
+ (error (if (equal (cadr err) "Terminal is currently suspended")
+ nil
+ (signal (car err) (cdr err)))))
+ (setf (terminal-parameter nil 'tty-mode-set-strings)
+ (remq xterm-mouse-tracking-enable-sequence
+ (terminal-parameter nil 'tty-mode-set-strings)))
+ (setf (terminal-parameter nil 'tty-mode-reset-strings)
+ (remq xterm-mouse-tracking-disable-sequence
+ (terminal-parameter nil 'tty-mode-reset-strings)))
+ (set-terminal-parameter terminal 'xterm-mouse-mode nil)))
(provide 'xt-mouse)